From 906c73145a47eddf3fe52c930d405e1648d25595 Mon Sep 17 00:00:00 2001 From: =?utf8?q?St=C3=A9phane=20Glondu?= Date: Fri, 4 Sep 2020 07:33:22 +0100 Subject: [PATCH] Import ocaml_4.11.1.orig.tar.xz [dgit import orig ocaml_4.11.1.orig.tar.xz] --- .depend | 6428 +++ .depend.menhir | 11 + .gitattributes | 253 + .gitignore | 270 + .gitmodules | 3 + .mailmap | 129 + .ocp-indent | 2 + .travis.yml | 55 + BOOTSTRAP.adoc | 62 + CONTRIBUTING.md | 472 + Changes | 10185 ++++ HACKING.adoc | 402 + INSTALL.adoc | 161 + LICENSE | 203 + Makefile | 1106 + Makefile.best_binaries | 46 + Makefile.common.in | 82 + Makefile.config.in | 288 + Makefile.dev | 48 + Makefile.menhir | 163 + Makefile.tools | 108 + News | 180 + README.adoc | 138 + README.win32.adoc | 384 + VERSION | 4 + aclocal.m4 | 274 + appveyor.yml | 51 + asmcomp/CSEgen.ml | 368 + asmcomp/CSEgen.mli | 38 + asmcomp/afl_instrument.ml | 110 + asmcomp/afl_instrument.mli | 21 + asmcomp/amd64/CSE.ml | 41 + asmcomp/amd64/NOTES.md | 21 + asmcomp/amd64/arch.ml | 142 + asmcomp/amd64/emit.mlp | 1182 + asmcomp/amd64/proc.ml | 400 + asmcomp/amd64/reload.ml | 128 + asmcomp/amd64/scheduling.ml | 21 + asmcomp/amd64/selection.ml | 288 + asmcomp/arm/CSE.ml | 40 + asmcomp/arm/NOTES.md | 20 + asmcomp/arm/arch.ml | 266 + asmcomp/arm/emit.mlp | 1085 + asmcomp/arm/proc.ml | 363 + asmcomp/arm/reload.ml | 57 + asmcomp/arm/scheduling.ml | 80 + asmcomp/arm/selection.ml | 320 + asmcomp/arm64/CSE.ml | 40 + asmcomp/arm64/NOTES.md | 12 + asmcomp/arm64/arch.ml | 172 + asmcomp/arm64/emit.mlp | 1042 + asmcomp/arm64/proc.ml | 270 + asmcomp/arm64/reload.ml | 19 + asmcomp/arm64/scheduling.ml | 21 + asmcomp/arm64/selection.ml | 255 + asmcomp/asmgen.ml | 206 + asmcomp/asmgen.mli | 48 + asmcomp/asmlibrarian.ml | 85 + asmcomp/asmlibrarian.mli | 28 + asmcomp/asmlink.ml | 470 + asmcomp/asmlink.mli | 45 + asmcomp/asmpackager.ml | 304 + asmcomp/asmpackager.mli | 37 + asmcomp/branch_relaxation.ml | 143 + asmcomp/branch_relaxation.mli | 29 + asmcomp/branch_relaxation_intf.ml | 76 + asmcomp/cmm.ml | 323 + asmcomp/cmm.mli | 237 + asmcomp/cmm_helpers.ml | 2792 + asmcomp/cmm_helpers.mli | 652 + asmcomp/cmmgen.ml | 1468 + asmcomp/cmmgen.mli | 22 + asmcomp/cmmgen_state.ml | 85 + asmcomp/cmmgen_state.mli | 45 + asmcomp/coloring.ml | 220 + asmcomp/coloring.mli | 18 + asmcomp/comballoc.ml | 103 + asmcomp/comballoc.mli | 18 + asmcomp/deadcode.ml | 148 + asmcomp/deadcode.mli | 19 + asmcomp/debug/available_regs.ml | 351 + asmcomp/debug/available_regs.mli | 18 + asmcomp/debug/compute_ranges.ml | 515 + asmcomp/debug/compute_ranges.mli | 28 + asmcomp/debug/compute_ranges_intf.ml | 274 + asmcomp/debug/reg_availability_set.ml | 111 + asmcomp/debug/reg_availability_set.mli | 37 + asmcomp/debug/reg_with_debug_info.ml | 200 + asmcomp/debug/reg_with_debug_info.mli | 112 + asmcomp/dune | 44 + asmcomp/emit.mli | 21 + asmcomp/emitaux.ml | 372 + asmcomp/emitaux.mli | 81 + asmcomp/i386/CSE.ml | 50 + asmcomp/i386/NOTES.md | 23 + asmcomp/i386/arch.ml | 166 + asmcomp/i386/emit.mlp | 1063 + asmcomp/i386/proc.ml | 260 + asmcomp/i386/reload.ml | 86 + asmcomp/i386/scheduling.ml | 23 + asmcomp/i386/selection.ml | 328 + asmcomp/interf.ml | 196 + asmcomp/interf.mli | 19 + asmcomp/interval.ml | 185 + asmcomp/interval.mli | 38 + asmcomp/linear.ml | 92 + asmcomp/linear.mli | 62 + asmcomp/linearize.ml | 340 + asmcomp/linearize.mli | 17 + asmcomp/linscan.ml | 201 + asmcomp/linscan.mli | 19 + asmcomp/liveness.ml | 161 + asmcomp/liveness.mli | 20 + asmcomp/mach.ml | 207 + asmcomp/mach.mli | 141 + asmcomp/power/CSE.ml | 40 + asmcomp/power/NOTES.md | 26 + asmcomp/power/arch.ml | 125 + asmcomp/power/emit.mlp | 1230 + asmcomp/power/proc.ml | 369 + asmcomp/power/reload.ml | 19 + asmcomp/power/scheduling.ml | 64 + asmcomp/power/selection.ml | 94 + asmcomp/printcmm.ml | 296 + asmcomp/printcmm.mli | 30 + asmcomp/printlinear.ml | 87 + asmcomp/printlinear.mli | 22 + asmcomp/printmach.ml | 282 + asmcomp/printmach.mli | 31 + asmcomp/proc.mli | 86 + asmcomp/reg.ml | 225 + asmcomp/reg.mli | 74 + asmcomp/reload.mli | 18 + asmcomp/reloadgen.ml | 136 + asmcomp/reloadgen.mli | 27 + asmcomp/riscv/CSE.ml | 39 + asmcomp/riscv/NOTES.md | 18 + asmcomp/riscv/arch.ml | 87 + asmcomp/riscv/emit.mlp | 686 + asmcomp/riscv/proc.ml | 337 + asmcomp/riscv/reload.ml | 19 + asmcomp/riscv/scheduling.ml | 22 + asmcomp/riscv/selection.ml | 75 + asmcomp/s390x/CSE.ml | 42 + asmcomp/s390x/NOTES.md | 16 + asmcomp/s390x/arch.ml | 91 + asmcomp/s390x/emit.mlp | 795 + asmcomp/s390x/proc.ml | 243 + asmcomp/s390x/reload.ml | 50 + asmcomp/s390x/scheduling.ml | 63 + asmcomp/s390x/selection.ml | 120 + asmcomp/schedgen.ml | 406 + asmcomp/schedgen.mli | 49 + asmcomp/scheduling.mli | 18 + asmcomp/selectgen.ml | 1306 + asmcomp/selectgen.mli | 189 + asmcomp/selection.mli | 19 + asmcomp/spacetime_profiling.ml | 480 + asmcomp/spacetime_profiling.mli | 17 + asmcomp/spill.ml | 437 + asmcomp/spill.mli | 20 + asmcomp/split.ml | 225 + asmcomp/split.mli | 20 + asmcomp/strmatch.ml | 397 + asmcomp/strmatch.mli | 32 + asmcomp/x86_ast.mli | 219 + asmcomp/x86_dsl.ml | 199 + asmcomp/x86_dsl.mli | 192 + asmcomp/x86_gas.ml | 311 + asmcomp/x86_gas.mli | 18 + asmcomp/x86_masm.ml | 261 + asmcomp/x86_masm.mli | 18 + asmcomp/x86_proc.ml | 274 + asmcomp/x86_proc.mli | 89 + boot/menhir/menhirLib.ml | 3517 ++ boot/menhir/menhirLib.mli | 1705 + boot/menhir/parser.ml | 46765 ++++++++++++++++ boot/menhir/parser.mli | 200 + boot/ocamlc | Bin 0 -> 2754789 bytes boot/ocamllex | Bin 0 -> 340174 bytes build-aux/ax_func_which_gethostbyname_r.m4 | 308 + build-aux/ax_pthread.m4 | 485 + build-aux/compile | 347 + build-aux/config.guess | 1480 + build-aux/config.sub | 1801 + build-aux/install-sh | 508 + build-aux/libtool.m4 | 8387 +++ build-aux/ltmain.sh | 11346 ++++ build-aux/ltoptions.m4 | 437 + build-aux/ltsugar.m4 | 124 + build-aux/ltversion.m4 | 23 + build-aux/lt~obsolete.m4 | 99 + build-aux/missing | 215 + bytecomp/bytegen.ml | 1107 + bytecomp/bytegen.mli | 26 + bytecomp/bytelibrarian.ml | 135 + bytecomp/bytelibrarian.mli | 37 + bytecomp/bytelink.ml | 774 + bytecomp/bytelink.mli | 43 + bytecomp/bytepackager.ml | 331 + bytecomp/bytepackager.mli | 32 + bytecomp/bytesections.ml | 101 + bytecomp/bytesections.mli | 57 + bytecomp/dll.ml | 167 + bytecomp/dll.mli | 66 + bytecomp/dune | 20 + bytecomp/emitcode.ml | 468 + bytecomp/emitcode.mli | 51 + bytecomp/instruct.ml | 114 + bytecomp/instruct.mli | 130 + bytecomp/meta.ml | 29 + bytecomp/meta.mli | 31 + bytecomp/printinstr.ml | 117 + bytecomp/printinstr.mli | 23 + bytecomp/symtable.ml | 424 + bytecomp/symtable.mli | 69 + compilerlibs/Makefile.compilerlibs | 335 + configure | 19230 +++++++ configure.ac | 1937 + debugger/.depend | 647 + debugger/Makefile | 95 + debugger/breakpoints.ml | 209 + debugger/breakpoints.mli | 60 + debugger/checkpoints.ml | 90 + debugger/checkpoints.mli | 60 + debugger/command_line.ml | 1241 + debugger/command_line.mli | 23 + debugger/debugcom.ml | 359 + debugger/debugcom.mli | 124 + debugger/debugger_config.ml | 90 + debugger/debugger_config.mli | 41 + debugger/debugger_lexer.mli | 22 + debugger/debugger_lexer.mll | 104 + debugger/debugger_parser.mly | 260 + debugger/dune | 27 + debugger/eval.ml | 218 + debugger/eval.mli | 41 + debugger/events.ml | 53 + debugger/events.mli | 35 + debugger/exec.ml | 54 + debugger/exec.mli | 20 + debugger/frames.ml | 130 + debugger/frames.mli | 55 + debugger/history.ml | 44 + debugger/history.mli | 21 + debugger/input_handling.ml | 108 + debugger/input_handling.mli | 61 + debugger/int64ops.ml | 27 + debugger/int64ops.mli | 27 + debugger/loadprinter.ml | 175 + debugger/loadprinter.mli | 37 + debugger/main.ml | 249 + debugger/parameters.ml | 46 + debugger/parameters.mli | 35 + debugger/parser_aux.mli | 30 + debugger/pattern_matching.ml | 254 + debugger/pattern_matching.mli | 23 + debugger/pos.ml | 26 + debugger/pos.mli | 16 + debugger/primitives.ml | 127 + debugger/primitives.mli | 67 + debugger/printval.ml | 105 + debugger/printval.mli | 34 + debugger/program_loading.ml | 190 + debugger/program_loading.mli | 35 + debugger/program_management.ml | 161 + debugger/program_management.mli | 28 + debugger/question.ml | 48 + debugger/question.mli | 17 + debugger/show_information.ml | 121 + debugger/show_information.mli | 27 + debugger/show_source.ml | 94 + debugger/show_source.mli | 26 + debugger/source.ml | 191 + debugger/source.mli | 62 + debugger/symbols.ml | 257 + debugger/symbols.mli | 71 + debugger/time_travel.ml | 681 + debugger/time_travel.mli | 38 + debugger/trap_barrier.ml | 42 + debugger/trap_barrier.mli | 28 + debugger/unix_tools.ml | 145 + debugger/unix_tools.mli | 35 + driver/compenv.ml | 679 + driver/compenv.mli | 78 + driver/compile.ml | 63 + driver/compile.mli | 35 + driver/compile_common.ml | 126 + driver/compile_common.mli | 92 + driver/compmisc.ml | 87 + driver/compmisc.mli | 23 + driver/errors.ml | 19 + driver/errors.mli | 19 + driver/main.ml | 116 + driver/main.mli | 18 + driver/main_args.ml | 1986 + driver/main_args.mli | 284 + driver/makedepend.ml | 661 + driver/makedepend.mli | 19 + driver/optcompile.ml | 96 + driver/optcompile.mli | 40 + driver/opterrors.ml | 19 + driver/opterrors.mli | 18 + driver/optmain.ml | 139 + driver/optmain.mli | 18 + driver/pparse.ml | 230 + driver/pparse.mli | 66 + dune | 222 + dune-project | 2 + file_formats/cmi_format.ml | 118 + file_formats/cmi_format.mli | 51 + file_formats/cmo_format.mli | 68 + file_formats/cmt_format.ml | 194 + file_formats/cmt_format.mli | 123 + file_formats/cmx_format.mli | 58 + file_formats/cmxs_format.mli | 35 + lambda/.ocamlformat | 5 + lambda/.ocamlformat-enable | 1 + lambda/debuginfo.ml | 230 + lambda/debuginfo.mli | 85 + lambda/dune | 21 + lambda/generate_runtimedef.sh | 24 + lambda/lambda.ml | 896 + lambda/lambda.mli | 435 + lambda/matching.ml | 3793 ++ lambda/matching.mli | 54 + lambda/printlambda.ml | 667 + lambda/printlambda.mli | 32 + lambda/runtimedef.mli | 19 + lambda/simplif.ml | 879 + lambda/simplif.mli | 44 + lambda/switch.ml | 878 + lambda/switch.mli | 130 + lambda/translattribute.ml | 333 + lambda/translattribute.mli | 76 + lambda/translclass.ml | 966 + lambda/translclass.mli | 30 + lambda/translcore.ml | 1140 + lambda/translcore.mli | 58 + lambda/translmod.ml | 1686 + lambda/translmod.mli | 63 + lambda/translobj.ml | 199 + lambda/translobj.mli | 33 + lambda/translprim.ml | 823 + lambda/translprim.mli | 54 + lex/.depend | 118 + lex/Makefile | 86 + lex/common.ml | 174 + lex/common.mli | 31 + lex/compact.ml | 232 + lex/compact.mli | 34 + lex/cset.ml | 97 + lex/cset.mli | 34 + lex/lexer.mli | 23 + lex/lexer.mll | 361 + lex/lexgen.ml | 1185 + lex/lexgen.mli | 60 + lex/main.ml | 126 + lex/output.ml | 157 + lex/output.mli | 27 + lex/outputbis.ml | 385 + lex/outputbis.mli | 23 + lex/parser.mly | 202 + lex/syntax.ml | 49 + lex/syntax.mli | 46 + lex/table.ml | 59 + lex/table.mli | 34 + man/Makefile | 30 + man/ocaml.m | 344 + man/ocamlc.m | 1073 + man/ocamlcp.m | 142 + man/ocamldebug.m | 124 + man/ocamldep.m | 196 + man/ocamldoc.m | 477 + man/ocamllex.m | 101 + man/ocamlmktop.m | 97 + man/ocamlopt.m | 779 + man/ocamlprof.m | 87 + man/ocamlrun.m | 276 + man/ocamlyacc.m | 112 + manual/LICENSE-for-the-manual | 36 + manual/Makefile | 42 + manual/README.md | 274 + manual/manual/.gitignore | 8 + manual/manual/Makefile | 172 + manual/manual/allfiles.etex | 107 + manual/manual/anchored_book.hva | 30 + manual/manual/biblio.etex | 240 + manual/manual/cmds/.gitignore | 3 + manual/manual/cmds/Makefile | 52 + manual/manual/cmds/afl-fuzz.etex | 73 + manual/manual/cmds/browser.etex | 6 + manual/manual/cmds/comp.etex | 525 + manual/manual/cmds/debugger.etex | 704 + manual/manual/cmds/flambda.etex | 1344 + manual/manual/cmds/instrumented-runtime.etex | 315 + manual/manual/cmds/intf-c.etex | 2802 + manual/manual/cmds/lexyacc.etex | 727 + manual/manual/cmds/native.etex | 252 + manual/manual/cmds/ocamlbuild.etex | 5 + manual/manual/cmds/ocamldep.etex | 216 + manual/manual/cmds/ocamldoc.etex | 1126 + manual/manual/cmds/profil.etex | 146 + manual/manual/cmds/runtime.etex | 310 + manual/manual/cmds/spacetime-chapter.etex | 125 + manual/manual/cmds/top.etex | 455 + manual/manual/cmds/unified-options.etex | 814 + manual/manual/foreword.etex | 79 + manual/manual/htmlman/.gitignore | 10 + manual/manual/htmlman/contents_motif.gif | Bin 0 -> 316 bytes .../fonts/fira-sans-v8-latin-regular.eot | Bin 0 -> 24643 bytes .../fonts/fira-sans-v8-latin-regular.svg | 330 + .../fonts/fira-sans-v8-latin-regular.ttf | Bin 0 -> 54032 bytes .../fonts/fira-sans-v8-latin-regular.woff | Bin 0 -> 25472 bytes .../fonts/fira-sans-v8-latin-regular.woff2 | Bin 0 -> 21016 bytes manual/manual/htmlman/libgraph.gif | Bin 0 -> 2149 bytes manual/manual/htmlman/next_motif.gif | Bin 0 -> 317 bytes manual/manual/htmlman/previous_motif.gif | Bin 0 -> 317 bytes manual/manual/index.tex | 20 + manual/manual/infoman/.gitignore | 5 + manual/manual/library/.gitignore | 7 + manual/manual/library/Makefile | 78 + manual/manual/library/builtin.etex | 283 + manual/manual/library/compiler_libs.mld | 9 + manual/manual/library/compilerlibs.etex | 59 + manual/manual/library/core.etex | 38 + manual/manual/library/libbigarray.etex | 36 + manual/manual/library/libdynlink.etex | 32 + manual/manual/library/libgraph.etex | 18 + manual/manual/library/libnum.etex | 13 + manual/manual/library/libstr.etex | 32 + manual/manual/library/libthreads.etex | 56 + manual/manual/library/libunix.etex | 99 + manual/manual/library/stdlib-blurb.etex | 219 + manual/manual/macros.hva | 295 + manual/manual/macros.tex | 255 + manual/manual/manual.hva | 3 + manual/manual/manual.inf | 152 + manual/manual/manual.info.header | 4 + manual/manual/manual.tex | 131 + manual/manual/refman/.gitignore | 2 + manual/manual/refman/Makefile | 35 + manual/manual/refman/classes.etex | 526 + manual/manual/refman/compunit.etex | 41 + manual/manual/refman/const.etex | 36 + manual/manual/refman/expr.etex | 1017 + manual/manual/refman/exten.etex | 2757 + manual/manual/refman/lex.etex | 324 + manual/manual/refman/modtypes.etex | 302 + manual/manual/refman/modules.etex | 237 + manual/manual/refman/names.etex | 150 + manual/manual/refman/patterns.etex | 245 + manual/manual/refman/refman.etex | 47 + manual/manual/refman/typedecl.etex | 227 + manual/manual/refman/types.etex | 241 + manual/manual/refman/values.etex | 96 + manual/manual/style.css | 80 + manual/manual/texstuff/.gitignore | 13 + manual/manual/textman/.gitignore | 5 + manual/manual/tutorials/.gitignore | 2 + manual/manual/tutorials/Makefile | 32 + manual/manual/tutorials/advexamples.etex | 636 + manual/manual/tutorials/coreexamples.etex | 978 + manual/manual/tutorials/lablexamples.etex | 488 + manual/manual/tutorials/moduleexamples.etex | 385 + manual/manual/tutorials/objectexamples.etex | 1230 + manual/manual/tutorials/polymorphism.etex | 475 + manual/styles/altindex.sty | 39 + manual/styles/doc.tfm | Bin 0 -> 772 bytes manual/styles/docbf.tfm | Bin 0 -> 772 bytes manual/styles/docit.tfm | Bin 0 -> 772 bytes manual/styles/docmi.tfm | Bin 0 -> 772 bytes manual/styles/docrm.tfm | Bin 0 -> 772 bytes manual/styles/doctt.tfm | Bin 0 -> 772 bytes manual/styles/fullpage.sty | 2 + manual/styles/html.sty | 222 + manual/styles/isolatin.sty | 174 + manual/styles/multicols.sty | 176 + manual/styles/multind.sty | 65 + manual/styles/ocamldoc.hva | 18 + manual/styles/ocamldoc.sty | 75 + manual/styles/scroll.sty | 5 + manual/styles/syntaxdef.hva | 157 + manual/styles/syntaxdef.sty | 26 + manual/styles/syntaxdeftxt.sty | 22 + manual/tests/.gitignore | 1 + manual/tests/Makefile | 56 + manual/tests/README.md | 9 + manual/tests/check-stdlib-modules | 23 + manual/tests/cross_reference_checker.ml | 243 + manual/tools/.gitignore | 11 + manual/tools/Makefile | 30 + manual/tools/fix_index.sh | 51 + manual/tools/htmltransf.mll | 117 + manual/tools/texquote2.ml | 137 + manual/tools/transf.mll | 107 + manual/tools/transfmain.ml | 8 + middle_end/backend_intf.mli | 47 + middle_end/backend_var.ml | 89 + middle_end/backend_var.mli | 54 + middle_end/clambda.ml | 206 + middle_end/clambda.mli | 156 + middle_end/clambda_primitives.ml | 156 + middle_end/clambda_primitives.mli | 159 + middle_end/closure/closure.ml | 1502 + middle_end/closure/closure.mli | 24 + middle_end/closure/closure_middle_end.ml | 58 + middle_end/closure/closure_middle_end.mli | 22 + middle_end/compilation_unit.ml | 78 + middle_end/compilation_unit.mli | 34 + middle_end/compilenv.ml | 457 + middle_end/compilenv.mli | 157 + middle_end/convert_primitives.ml | 156 + middle_end/convert_primitives.mli | 17 + middle_end/flambda/alias_analysis.ml | 168 + middle_end/flambda/alias_analysis.mli | 63 + middle_end/flambda/allocated_const.ml | 86 + middle_end/flambda/allocated_const.mli | 38 + .../flambda/augment_specialised_args.ml | 762 + .../flambda/augment_specialised_args.mli | 65 + .../flambda/base_types/closure_element.ml | 26 + .../flambda/base_types/closure_element.mli | 32 + middle_end/flambda/base_types/closure_id.ml | 20 + middle_end/flambda/base_types/closure_id.mli | 27 + .../flambda/base_types/closure_origin.ml | 22 + .../flambda/base_types/closure_origin.mli | 21 + middle_end/flambda/base_types/export_id.ml | 29 + middle_end/flambda/base_types/export_id.mli | 28 + middle_end/flambda/base_types/id_types.ml | 93 + middle_end/flambda/base_types/id_types.mli | 54 + .../flambda/base_types/mutable_variable.ml | 22 + .../flambda/base_types/mutable_variable.mli | 47 + .../flambda/base_types/set_of_closures_id.ml | 29 + .../flambda/base_types/set_of_closures_id.mli | 26 + .../base_types/set_of_closures_origin.ml | 23 + .../base_types/set_of_closures_origin.mli | 22 + .../flambda/base_types/static_exception.ml | 23 + .../flambda/base_types/static_exception.mli | 26 + middle_end/flambda/base_types/tag.ml | 35 + middle_end/flambda/base_types/tag.mli | 29 + .../flambda/base_types/var_within_closure.ml | 20 + .../flambda/base_types/var_within_closure.mli | 24 + middle_end/flambda/build_export_info.ml | 728 + middle_end/flambda/build_export_info.mli | 25 + middle_end/flambda/closure_conversion.ml | 737 + middle_end/flambda/closure_conversion.mli | 53 + middle_end/flambda/closure_conversion_aux.ml | 184 + middle_end/flambda/closure_conversion_aux.mli | 94 + middle_end/flambda/closure_offsets.ml | 89 + middle_end/flambda/closure_offsets.mli | 27 + middle_end/flambda/effect_analysis.ml | 58 + middle_end/flambda/effect_analysis.mli | 27 + middle_end/flambda/export_info.ml | 555 + middle_end/flambda/export_info.mli | 195 + middle_end/flambda/export_info_for_pack.ml | 231 + middle_end/flambda/export_info_for_pack.mli | 34 + middle_end/flambda/extract_projections.ml | 190 + middle_end/flambda/extract_projections.mli | 33 + .../flambda/find_recursive_functions.ml | 34 + .../flambda/find_recursive_functions.mli | 37 + middle_end/flambda/flambda.ml | 1275 + middle_end/flambda/flambda.mli | 713 + middle_end/flambda/flambda_invariants.ml | 800 + middle_end/flambda/flambda_invariants.mli | 28 + middle_end/flambda/flambda_iterators.ml | 808 + middle_end/flambda/flambda_iterators.mli | 227 + middle_end/flambda/flambda_middle_end.ml | 248 + middle_end/flambda/flambda_middle_end.mli | 27 + middle_end/flambda/flambda_to_clambda.ml | 777 + middle_end/flambda/flambda_to_clambda.mli | 41 + middle_end/flambda/flambda_utils.ml | 929 + middle_end/flambda/flambda_utils.mli | 220 + middle_end/flambda/freshening.ml | 458 + middle_end/flambda/freshening.mli | 167 + middle_end/flambda/import_approx.ml | 222 + middle_end/flambda/import_approx.mli | 34 + middle_end/flambda/inconstant_idents.ml | 502 + middle_end/flambda/inconstant_idents.mli | 36 + .../initialize_symbol_to_let_symbol.ml | 57 + .../initialize_symbol_to_let_symbol.mli | 25 + middle_end/flambda/inline_and_simplify.ml | 1702 + middle_end/flambda/inline_and_simplify.mli | 40 + middle_end/flambda/inline_and_simplify_aux.ml | 738 + .../flambda/inline_and_simplify_aux.mli | 368 + middle_end/flambda/inlining_cost.ml | 700 + middle_end/flambda/inlining_cost.mli | 142 + middle_end/flambda/inlining_decision.ml | 742 + middle_end/flambda/inlining_decision.mli | 43 + middle_end/flambda/inlining_decision_intf.mli | 49 + middle_end/flambda/inlining_stats.ml | 252 + middle_end/flambda/inlining_stats.mli | 46 + middle_end/flambda/inlining_stats_types.ml | 290 + middle_end/flambda/inlining_stats_types.mli | 89 + middle_end/flambda/inlining_transforms.ml | 668 + middle_end/flambda/inlining_transforms.mli | 105 + middle_end/flambda/invariant_params.ml | 420 + middle_end/flambda/invariant_params.mli | 57 + middle_end/flambda/lift_code.ml | 182 + middle_end/flambda/lift_code.mli | 43 + middle_end/flambda/lift_constants.ml | 1019 + middle_end/flambda/lift_constants.mli | 65 + .../flambda/lift_let_to_initialize_symbol.ml | 298 + .../flambda/lift_let_to_initialize_symbol.mli | 38 + middle_end/flambda/parameter.ml | 69 + middle_end/flambda/parameter.mli | 52 + middle_end/flambda/pass_wrapper.ml | 35 + middle_end/flambda/pass_wrapper.mli | 26 + middle_end/flambda/projection.ml | 170 + middle_end/flambda/projection.mli | 80 + middle_end/flambda/ref_to_variables.ml | 199 + middle_end/flambda/ref_to_variables.mli | 23 + .../flambda/remove_free_vars_equal_to_args.ml | 99 + .../remove_free_vars_equal_to_args.mli | 23 + middle_end/flambda/remove_unused_arguments.ml | 242 + .../flambda/remove_unused_arguments.mli | 39 + .../flambda/remove_unused_closure_vars.ml | 125 + .../flambda/remove_unused_closure_vars.mli | 26 + .../remove_unused_program_constructs.ml | 111 + .../remove_unused_program_constructs.mli | 24 + middle_end/flambda/share_constants.ml | 130 + middle_end/flambda/share_constants.mli | 22 + middle_end/flambda/simple_value_approx.ml | 1043 + middle_end/flambda/simple_value_approx.mli | 501 + .../flambda/simplify_boxed_integer_ops.ml | 118 + .../flambda/simplify_boxed_integer_ops.mli | 28 + .../simplify_boxed_integer_ops_intf.mli | 45 + middle_end/flambda/simplify_common.ml | 86 + middle_end/flambda/simplify_common.mli | 80 + middle_end/flambda/simplify_primitives.ml | 305 + middle_end/flambda/simplify_primitives.mli | 27 + .../flambda/traverse_for_exported_symbols.ml | 267 + .../flambda/traverse_for_exported_symbols.mli | 41 + middle_end/flambda/un_anf.ml | 853 + middle_end/flambda/un_anf.mli | 23 + middle_end/flambda/unbox_closures.ml | 87 + middle_end/flambda/unbox_closures.mli | 33 + .../flambda/unbox_free_vars_of_closures.ml | 170 + .../flambda/unbox_free_vars_of_closures.mli | 26 + middle_end/flambda/unbox_specialised_args.ml | 103 + middle_end/flambda/unbox_specialised_args.mli | 50 + middle_end/internal_variable_names.ml | 522 + middle_end/internal_variable_names.mli | 97 + middle_end/linkage_name.ml | 30 + middle_end/linkage_name.mli | 22 + middle_end/printclambda.ml | 272 + middle_end/printclambda.mli | 26 + middle_end/printclambda_primitives.ml | 205 + middle_end/printclambda_primitives.mli | 18 + middle_end/semantics_of_primitives.ml | 155 + middle_end/semantics_of_primitives.mli | 69 + middle_end/symbol.ml | 105 + middle_end/symbol.mli | 44 + middle_end/variable.ml | 119 + middle_end/variable.mli | 63 + ocaml-variants.opam | 28 + ocamldoc/.depend | 863 + ocamldoc/Changes.txt | 209 + ocamldoc/Makefile | 527 + ocamldoc/Makefile.docfiles | 64 + ocamldoc/dune | 25 + ocamldoc/generators/odoc_literate.ml | 215 + ocamldoc/generators/odoc_todo.ml | 235 + ocamldoc/ocamldoc.hva | 34 + ocamldoc/ocamldoc.sty | 58 + ocamldoc/odoc.ml | 133 + ocamldoc/odoc_analyse.ml | 476 + ocamldoc/odoc_analyse.mli | 33 + ocamldoc/odoc_args.ml | 387 + ocamldoc/odoc_args.mli | 53 + ocamldoc/odoc_ast.ml | 1916 + ocamldoc/odoc_ast.mli | 101 + ocamldoc/odoc_class.ml | 252 + ocamldoc/odoc_comments.ml | 262 + ocamldoc/odoc_comments.mli | 76 + ocamldoc/odoc_comments_global.ml | 51 + ocamldoc/odoc_comments_global.mli | 52 + ocamldoc/odoc_config.ml | 20 + ocamldoc/odoc_config.mli | 22 + ocamldoc/odoc_control.ml | 14 + ocamldoc/odoc_cross.ml | 1131 + ocamldoc/odoc_cross.mli | 22 + ocamldoc/odoc_dag2html.ml | 1613 + ocamldoc/odoc_dag2html.mli | 31 + ocamldoc/odoc_dep.ml | 214 + ocamldoc/odoc_dot.ml | 147 + ocamldoc/odoc_env.ml | 249 + ocamldoc/odoc_env.mli | 78 + ocamldoc/odoc_exception.ml | 33 + ocamldoc/odoc_extension.ml | 48 + ocamldoc/odoc_gen.ml | 64 + ocamldoc/odoc_gen.mli | 46 + ocamldoc/odoc_global.ml | 83 + ocamldoc/odoc_global.mli | 110 + ocamldoc/odoc_html.ml | 2947 + ocamldoc/odoc_index.html | 40 + ocamldoc/odoc_info.ml | 338 + ocamldoc/odoc_info.mli | 1097 + ocamldoc/odoc_inherit.ml | 14 + ocamldoc/odoc_latex.ml | 1333 + ocamldoc/odoc_latex_style.ml | 93 + ocamldoc/odoc_lexer.mll | 422 + ocamldoc/odoc_man.ml | 1319 + ocamldoc/odoc_merge.ml | 1086 + ocamldoc/odoc_merge.mli | 37 + ocamldoc/odoc_messages.ml | 420 + ocamldoc/odoc_misc.ml | 512 + ocamldoc/odoc_misc.mli | 126 + ocamldoc/odoc_module.ml | 571 + ocamldoc/odoc_name.ml | 244 + ocamldoc/odoc_name.mli | 82 + ocamldoc/odoc_ocamlhtml.mll | 552 + ocamldoc/odoc_parameter.ml | 125 + ocamldoc/odoc_parser.mly | 177 + ocamldoc/odoc_print.ml | 109 + ocamldoc/odoc_print.mli | 34 + ocamldoc/odoc_scan.ml | 190 + ocamldoc/odoc_search.ml | 744 + ocamldoc/odoc_search.mli | 242 + ocamldoc/odoc_see_lexer.mll | 103 + ocamldoc/odoc_sig.ml | 1880 + ocamldoc/odoc_sig.mli | 203 + ocamldoc/odoc_str.ml | 395 + ocamldoc/odoc_str.mli | 62 + ocamldoc/odoc_test.ml | 126 + ocamldoc/odoc_texi.ml | 1312 + ocamldoc/odoc_text.ml | 169 + ocamldoc/odoc_text.mli | 26 + ocamldoc/odoc_text_lexer.mll | 857 + ocamldoc/odoc_text_parser.mly | 216 + ocamldoc/odoc_to_text.ml | 608 + ocamldoc/odoc_type.ml | 73 + ocamldoc/odoc_types.ml | 143 + ocamldoc/odoc_types.mli | 142 + ocamldoc/odoc_value.ml | 140 + ocamldoc/remove_DEBUG | 23 + ocamltest/.depend | 460 + ocamltest/Makefile | 300 + ocamltest/README | 199 + ocamltest/actions.ml | 75 + ocamltest/actions.mli | 44 + ocamltest/actions_helpers.ml | 342 + ocamltest/actions_helpers.mli | 62 + ocamltest/builtin_actions.ml | 260 + ocamltest/builtin_actions.mli | 49 + ocamltest/builtin_variables.ml | 132 + ocamltest/builtin_variables.mli | 67 + ocamltest/dune | 52 + ocamltest/environments.ml | 144 + ocamltest/environments.mli | 69 + ocamltest/filecompare.ml | 199 + ocamltest/filecompare.mli | 50 + ocamltest/getocamloptdefaultflags | 26 + ocamltest/main.ml | 274 + ocamltest/main.mli | 19 + ocamltest/modifier_parser.ml | 41 + ocamltest/modifier_parser.mli | 20 + ocamltest/ocaml_actions.ml | 1431 + ocamltest/ocaml_actions.mli | 57 + ocamltest/ocaml_backends.ml | 38 + ocamltest/ocaml_backends.mli | 32 + ocamltest/ocaml_commands.ml | 45 + ocamltest/ocaml_commands.mli | 35 + ocamltest/ocaml_compilers.ml | 101 + ocamltest/ocaml_compilers.mli | 40 + ocamltest/ocaml_directories.ml | 37 + ocamltest/ocaml_directories.mli | 28 + ocamltest/ocaml_files.ml | 89 + ocamltest/ocaml_files.mli | 53 + ocamltest/ocaml_filetypes.ml | 117 + ocamltest/ocaml_filetypes.mli | 44 + ocamltest/ocaml_flags.ml | 61 + ocamltest/ocaml_flags.mli | 31 + ocamltest/ocaml_modifiers.ml | 144 + ocamltest/ocaml_modifiers.mli | 28 + ocamltest/ocaml_tests.ml | 146 + ocamltest/ocaml_tests.mli | 28 + ocamltest/ocaml_tools.ml | 71 + ocamltest/ocaml_tools.mli | 40 + ocamltest/ocaml_toplevels.ml | 70 + ocamltest/ocaml_toplevels.mli | 34 + ocamltest/ocaml_variables.ml | 291 + ocamltest/ocaml_variables.mli | 131 + ocamltest/ocamltest.org | 745 + ocamltest/ocamltest_config.ml.in | 84 + ocamltest/ocamltest_config.mli | 117 + ocamltest/ocamltest_stdlib.ml | 176 + ocamltest/ocamltest_stdlib.mli | 59 + ocamltest/ocamltest_stdlib_stubs.c | 116 + ocamltest/options.ml | 82 + ocamltest/options.mli | 30 + ocamltest/result.ml | 57 + ocamltest/result.mli | 43 + ocamltest/run.h | 44 + ocamltest/run_command.ml | 52 + ocamltest/run_command.mli | 37 + ocamltest/run_common.h | 59 + ocamltest/run_stubs.c | 108 + ocamltest/run_unix.c | 349 + ocamltest/run_win32.c | 412 + ocamltest/strace.ml | 32 + ocamltest/strace.mli | 22 + ocamltest/tests.ml | 79 + ocamltest/tests.mli | 38 + ocamltest/tsl_ast.ml | 41 + ocamltest/tsl_ast.mli | 40 + ocamltest/tsl_lexer.mli | 20 + ocamltest/tsl_lexer.mll | 128 + ocamltest/tsl_parser.mly | 87 + ocamltest/tsl_semantics.ml | 170 + ocamltest/tsl_semantics.mli | 47 + ocamltest/variables.ml | 72 + ocamltest/variables.mli | 46 + otherlibs/Makefile | 38 + otherlibs/Makefile.otherlibs.common | 140 + otherlibs/bigarray/.depend | 5 + otherlibs/bigarray/Makefile | 26 + otherlibs/bigarray/bigarray.ml | 15 + otherlibs/bigarray/bigarray.mli | 15 + otherlibs/bigarray/empty.c | 0 otherlibs/dynlink/.depend | 40 + otherlibs/dynlink/Makefile | 301 + otherlibs/dynlink/byte/dynlink.ml | 207 + otherlibs/dynlink/dune | 31 + otherlibs/dynlink/dynlink.mli | 173 + otherlibs/dynlink/dynlink_common.ml | 361 + otherlibs/dynlink/dynlink_common.mli | 35 + .../Makefile.copy-sources | 30 + otherlibs/dynlink/dynlink_platform_intf.ml | 69 + otherlibs/dynlink/dynlink_types.ml | 116 + otherlibs/dynlink/dynlink_types.mli | 49 + otherlibs/dynlink/extract_crc.ml | 86 + otherlibs/dynlink/native/dynlink.ml | 130 + otherlibs/raw_spacetime_lib/.depend | 22 + otherlibs/raw_spacetime_lib/Makefile | 33 + .../raw_spacetime_lib/raw_spacetime_lib.ml | 668 + .../raw_spacetime_lib/raw_spacetime_lib.mli | 364 + .../raw_spacetime_lib/spacetime_offline.c | 250 + otherlibs/str/.depend | 12 + otherlibs/str/Makefile | 36 + otherlibs/str/dune | 20 + otherlibs/str/str.ml | 754 + otherlibs/str/str.mli | 291 + otherlibs/str/strstubs.c | 547 + otherlibs/systhreads/.depend | 68 + otherlibs/systhreads/Makefile | 171 + otherlibs/systhreads/condition.ml | 20 + otherlibs/systhreads/condition.mli | 53 + otherlibs/systhreads/event.ml | 276 + otherlibs/systhreads/event.mli | 81 + otherlibs/systhreads/mutex.ml | 20 + otherlibs/systhreads/mutex.mli | 49 + otherlibs/systhreads/st_posix.h | 459 + otherlibs/systhreads/st_stubs.c | 979 + otherlibs/systhreads/st_win32.h | 432 + otherlibs/systhreads/thread.ml | 89 + otherlibs/systhreads/thread.mli | 133 + otherlibs/systhreads/threadUnix.ml | 65 + otherlibs/systhreads/threadUnix.mli | 96 + otherlibs/systhreads/threads.h | 68 + otherlibs/unix/.depend | 657 + otherlibs/unix/Makefile | 58 + otherlibs/unix/accept.c | 64 + otherlibs/unix/access.c | 67 + otherlibs/unix/addrofstr.c | 97 + otherlibs/unix/alarm.c | 22 + otherlibs/unix/bind.c | 41 + otherlibs/unix/channels.c | 89 + otherlibs/unix/chdir.c | 37 + otherlibs/unix/chmod.c | 39 + otherlibs/unix/chown.c | 34 + otherlibs/unix/chroot.c | 34 + otherlibs/unix/close.c | 28 + otherlibs/unix/closedir.c | 38 + otherlibs/unix/connect.c | 44 + otherlibs/unix/cst2constr.c | 26 + otherlibs/unix/cst2constr.h | 16 + otherlibs/unix/cstringv.c | 45 + otherlibs/unix/dune | 33 + otherlibs/unix/dup.c | 36 + otherlibs/unix/dup2.c | 44 + otherlibs/unix/envir.c | 68 + otherlibs/unix/errmsg.c | 28 + otherlibs/unix/execv.c | 36 + otherlibs/unix/execve.c | 39 + otherlibs/unix/execvp.c | 67 + otherlibs/unix/exit.c | 24 + otherlibs/unix/fchmod.c | 40 + otherlibs/unix/fchown.c | 38 + otherlibs/unix/fcntl.c | 58 + otherlibs/unix/fork.c | 43 + otherlibs/unix/fsync.c | 40 + otherlibs/unix/ftruncate.c | 59 + otherlibs/unix/getaddrinfo.c | 135 + otherlibs/unix/getcwd.c | 52 + otherlibs/unix/getegid.c | 22 + otherlibs/unix/geteuid.c | 22 + otherlibs/unix/getgid.c | 22 + otherlibs/unix/getgr.c | 74 + otherlibs/unix/getgroups.c | 49 + otherlibs/unix/gethost.c | 173 + otherlibs/unix/gethostname.c | 56 + otherlibs/unix/getlogin.c | 29 + otherlibs/unix/getnameinfo.c | 68 + otherlibs/unix/getpeername.c | 41 + otherlibs/unix/getpid.c | 22 + otherlibs/unix/getppid.c | 22 + otherlibs/unix/getproto.c | 69 + otherlibs/unix/getpw.c | 81 + otherlibs/unix/getserv.c | 77 + otherlibs/unix/getsockname.c | 41 + otherlibs/unix/gettimeofday.c | 38 + otherlibs/unix/getuid.c | 22 + otherlibs/unix/gmtime.c | 95 + otherlibs/unix/initgroups.c | 46 + otherlibs/unix/isatty.c | 22 + otherlibs/unix/itimer.c | 75 + otherlibs/unix/kill.c | 31 + otherlibs/unix/link.c | 58 + otherlibs/unix/listen.c | 35 + otherlibs/unix/lockf.c | 116 + otherlibs/unix/lseek.c | 66 + otherlibs/unix/mkdir.c | 36 + otherlibs/unix/mkfifo.c | 73 + otherlibs/unix/mmap.c | 207 + otherlibs/unix/mmap_ba.c | 81 + otherlibs/unix/nanosecond_stat.h | 27 + otherlibs/unix/nice.c | 34 + otherlibs/unix/open.c | 87 + otherlibs/unix/opendir.c | 45 + otherlibs/unix/pipe.c | 40 + otherlibs/unix/putenv.c | 55 + otherlibs/unix/read.c | 38 + otherlibs/unix/readdir.c | 42 + otherlibs/unix/readlink.c | 57 + otherlibs/unix/rename.c | 40 + otherlibs/unix/rewinddir.c | 42 + otherlibs/unix/rmdir.c | 37 + otherlibs/unix/select.c | 114 + otherlibs/unix/sendrecv.c | 148 + otherlibs/unix/setgid.c | 23 + otherlibs/unix/setgroups.c | 53 + otherlibs/unix/setsid.c | 31 + otherlibs/unix/setuid.c | 23 + otherlibs/unix/shutdown.c | 40 + otherlibs/unix/signals.c | 112 + otherlibs/unix/sleep.c | 76 + otherlibs/unix/socket.c | 65 + otherlibs/unix/socketaddr.c | 178 + otherlibs/unix/socketaddr.h | 62 + otherlibs/unix/socketpair.c | 56 + otherlibs/unix/sockopt.c | 301 + otherlibs/unix/stat.c | 198 + otherlibs/unix/strofaddr.c | 74 + otherlibs/unix/symlink.c | 61 + otherlibs/unix/termios.c | 387 + otherlibs/unix/time.c | 24 + otherlibs/unix/times.c | 67 + otherlibs/unix/truncate.c | 72 + otherlibs/unix/umask.c | 24 + otherlibs/unix/unix.ml | 1201 + otherlibs/unix/unix.mli | 1768 + otherlibs/unix/unixLabels.ml | 18 + otherlibs/unix/unixLabels.mli | 1499 + otherlibs/unix/unixsupport.c | 347 + otherlibs/unix/unixsupport.h | 60 + otherlibs/unix/unlink.c | 37 + otherlibs/unix/utimes.c | 94 + otherlibs/unix/wait.c | 107 + otherlibs/unix/write.c | 86 + otherlibs/win32unix/.depend | 563 + otherlibs/win32unix/Makefile | 79 + otherlibs/win32unix/accept.c | 53 + otherlibs/win32unix/bind.c | 34 + otherlibs/win32unix/channels.c | 141 + otherlibs/win32unix/close.c | 42 + otherlibs/win32unix/close_on.c | 43 + otherlibs/win32unix/connect.c | 39 + otherlibs/win32unix/createprocess.c | 155 + otherlibs/win32unix/dup.c | 35 + otherlibs/win32unix/dup2.c | 42 + otherlibs/win32unix/envir.c | 43 + otherlibs/win32unix/errmsg.c | 47 + otherlibs/win32unix/getpeername.c | 35 + otherlibs/win32unix/getpid.c | 24 + otherlibs/win32unix/getsockname.c | 32 + otherlibs/win32unix/gettimeofday.c | 40 + otherlibs/win32unix/isatty.c | 24 + otherlibs/win32unix/link.c | 64 + otherlibs/win32unix/listen.c | 27 + otherlibs/win32unix/lockf.c | 160 + otherlibs/win32unix/lseek.c | 70 + otherlibs/win32unix/mkdir.c | 34 + otherlibs/win32unix/mmap.c | 169 + otherlibs/win32unix/nonblock.c | 44 + otherlibs/win32unix/open.c | 91 + otherlibs/win32unix/pipe.c | 46 + otherlibs/win32unix/read.c | 61 + otherlibs/win32unix/readlink.c | 106 + otherlibs/win32unix/rename.c | 43 + otherlibs/win32unix/select.c | 1330 + otherlibs/win32unix/sendrecv.c | 143 + otherlibs/win32unix/shutdown.c | 32 + otherlibs/win32unix/sleep.c | 28 + otherlibs/win32unix/socket.c | 56 + otherlibs/win32unix/socketaddr.h | 58 + otherlibs/win32unix/sockopt.c | 229 + otherlibs/win32unix/startup.c | 51 + otherlibs/win32unix/stat.c | 448 + otherlibs/win32unix/symlink.c | 118 + otherlibs/win32unix/system.c | 45 + otherlibs/win32unix/times.c | 58 + otherlibs/win32unix/truncate.c | 125 + otherlibs/win32unix/unix.ml | 1212 + otherlibs/win32unix/unixsupport.c | 330 + otherlibs/win32unix/unixsupport.h | 133 + otherlibs/win32unix/utimes.c | 85 + otherlibs/win32unix/windbug.c | 32 + otherlibs/win32unix/windbug.h | 70 + otherlibs/win32unix/windir.c | 83 + otherlibs/win32unix/winlist.c | 80 + otherlibs/win32unix/winlist.h | 55 + otherlibs/win32unix/winwait.c | 81 + otherlibs/win32unix/winworker.c | 322 + otherlibs/win32unix/winworker.h | 73 + otherlibs/win32unix/write.c | 101 + parsing/CONFLICTS.md | 54 + parsing/HACKING.adoc | 76 + parsing/VIPs.md | 20 + parsing/ast_helper.ml | 642 + parsing/ast_helper.mli | 490 + parsing/ast_invariants.ml | 187 + parsing/ast_invariants.mli | 23 + parsing/ast_iterator.ml | 673 + parsing/ast_iterator.mli | 83 + parsing/ast_mapper.ml | 1068 + parsing/ast_mapper.mli | 208 + parsing/asttypes.mli | 63 + parsing/attr_helper.ml | 54 + parsing/attr_helper.mli | 41 + parsing/builtin_attributes.ml | 287 + parsing/builtin_attributes.mli | 84 + parsing/depend.ml | 588 + parsing/depend.mli | 45 + parsing/docstrings.ml | 425 + parsing/docstrings.mli | 223 + parsing/dune | 48 + parsing/lexer.mli | 64 + parsing/lexer.mll | 858 + parsing/location.ml | 943 + parsing/location.mli | 287 + parsing/longident.ml | 50 + parsing/longident.mli | 60 + parsing/parse.ml | 173 + parsing/parse.mli | 108 + parsing/parser.mly | 3761 ++ parsing/parsetree.mli | 970 + parsing/pprintast.ml | 1647 + parsing/pprintast.mli | 44 + parsing/printast.ml | 965 + parsing/printast.mli | 32 + parsing/syntaxerr.ml | 43 + parsing/syntaxerr.mli | 37 + runtime/.depend | 2433 + runtime/Makefile | 413 + runtime/afl.c | 167 + runtime/alloc.c | 274 + runtime/amd64.S | 743 + runtime/amd64nt.asm | 499 + runtime/arm.S | 445 + runtime/arm64.S | 483 + runtime/array.c | 637 + runtime/backtrace.c | 343 + runtime/backtrace_byt.c | 491 + runtime/backtrace_nat.c | 297 + runtime/bigarray.c | 1237 + runtime/callback.c | 280 + runtime/caml/address_class.h | 85 + runtime/caml/alloc.h | 85 + runtime/caml/backtrace.h | 129 + runtime/caml/backtrace_prim.h | 112 + runtime/caml/bigarray.h | 134 + runtime/caml/callback.h | 59 + runtime/caml/compact.h | 36 + runtime/caml/compare.h | 25 + runtime/caml/compatibility.h | 374 + runtime/caml/config.h | 260 + runtime/caml/custom.h | 84 + runtime/caml/debugger.h | 130 + runtime/caml/domain.h | 36 + runtime/caml/domain_state.h | 59 + runtime/caml/domain_state.tbl | 82 + runtime/caml/dune | 29 + runtime/caml/dynlink.h | 46 + runtime/caml/eventlog.h | 130 + runtime/caml/exec.h | 67 + runtime/caml/fail.h | 148 + runtime/caml/finalise.h | 36 + runtime/caml/fix_code.h | 44 + runtime/caml/freelist.h | 65 + runtime/caml/gc.h | 79 + runtime/caml/gc_ctrl.h | 58 + runtime/caml/globroots.h | 31 + runtime/caml/hash.h | 39 + runtime/caml/hooks.h | 42 + runtime/caml/instrtrace.h | 35 + runtime/caml/instruct.h | 68 + runtime/caml/interp.h | 37 + runtime/caml/intext.h | 195 + runtime/caml/io.h | 124 + runtime/caml/m.h.in | 100 + runtime/caml/major_gc.h | 98 + runtime/caml/md5.h | 47 + runtime/caml/memory.h | 620 + runtime/caml/memprof.h | 55 + runtime/caml/minor_gc.h | 134 + runtime/caml/misc.h | 463 + runtime/caml/mlvalues.h | 386 + runtime/caml/osdeps.h | 160 + runtime/caml/prims.h | 40 + runtime/caml/printexc.h | 35 + runtime/caml/reverse.h | 92 + runtime/caml/roots.h | 44 + runtime/caml/s.h.in | 271 + runtime/caml/signals.h | 99 + runtime/caml/signals_machdep.h | 74 + runtime/caml/spacetime.h | 203 + runtime/caml/stack.h | 150 + runtime/caml/stacks.h | 47 + runtime/caml/startup.h | 60 + runtime/caml/startup_aux.h | 50 + runtime/caml/sys.h | 55 + runtime/caml/ui.h | 32 + runtime/caml/weak.h | 231 + runtime/clambda_checks.c | 88 + runtime/compact.c | 581 + runtime/compare.c | 344 + runtime/custom.c | 169 + runtime/debugger.c | 599 + runtime/domain.c | 89 + runtime/dune | 58 + runtime/dynlink.c | 304 + runtime/dynlink_nat.c | 185 + runtime/eventlog.c | 396 + runtime/extern.c | 1037 + runtime/fail_byt.c | 208 + runtime/fail_nat.c | 206 + runtime/finalise.c | 446 + runtime/fix_code.c | 184 + runtime/floats.c | 1069 + runtime/freelist.c | 1858 + runtime/gc_ctrl.c | 767 + runtime/gen_domain_state32_inc.awk | 36 + runtime/gen_domain_state64_inc.awk | 33 + runtime/gen_primitives.sh | 34 + runtime/globroots.c | 313 + runtime/hash.c | 419 + runtime/i386.S | 446 + runtime/i386nt.asm | 307 + runtime/instrtrace.c | 271 + runtime/intern.c | 1114 + runtime/interp.c | 1200 + runtime/ints.c | 851 + runtime/io.c | 835 + runtime/lexing.c | 233 + runtime/main.c | 47 + runtime/major_gc.c | 936 + runtime/md5.c | 325 + runtime/memory.c | 1023 + runtime/memprof.c | 977 + runtime/meta.c | 281 + runtime/minor_gc.c | 642 + runtime/misc.c | 223 + runtime/obj.c | 407 + runtime/parsing.c | 304 + runtime/power.S | 676 + runtime/printexc.c | 162 + runtime/riscv.S | 423 + runtime/roots_byt.c | 131 + runtime/roots_nat.c | 524 + runtime/s390x.S | 355 + runtime/signals.c | 528 + runtime/signals_byt.c | 89 + runtime/signals_nat.c | 309 + runtime/signals_osdep.h | 406 + runtime/spacetime_byt.c | 38 + runtime/spacetime_nat.c | 1160 + runtime/spacetime_snapshot.c | 600 + runtime/stacks.c | 117 + runtime/startup_aux.c | 204 + runtime/startup_byt.c | 578 + runtime/startup_nat.c | 194 + runtime/str.c | 474 + runtime/sys.c | 659 + runtime/unix.c | 442 + runtime/weak.c | 583 + runtime/win32.c | 1032 + stdlib/.depend | 688 + stdlib/Compflags | 35 + stdlib/HACKING.adoc | 30 + stdlib/Makefile | 258 + stdlib/StdlibModules | 42 + stdlib/arg.ml | 407 + stdlib/arg.mli | 206 + stdlib/array.ml | 366 + stdlib/array.mli | 301 + stdlib/arrayLabels.ml | 18 + stdlib/arrayLabels.mli | 310 + stdlib/bigarray.ml | 349 + stdlib/bigarray.mli | 967 + stdlib/bool.ml | 33 + stdlib/bool.mli | 68 + stdlib/buffer.ml | 438 + stdlib/buffer.mli | 282 + stdlib/bytes.ml | 449 + stdlib/bytes.mli | 655 + stdlib/bytesLabels.ml | 18 + stdlib/bytesLabels.mli | 512 + stdlib/callback.ml | 27 + stdlib/callback.mli | 34 + stdlib/camlinternalFormat.ml | 2991 + stdlib/camlinternalFormat.mli | 120 + stdlib/camlinternalFormatBasics.ml | 690 + stdlib/camlinternalFormatBasics.mli | 327 + stdlib/camlinternalLazy.ml | 65 + stdlib/camlinternalLazy.mli | 29 + stdlib/camlinternalMod.ml | 83 + stdlib/camlinternalMod.mli | 28 + stdlib/camlinternalOO.ml | 613 + stdlib/camlinternalOO.mli | 153 + stdlib/char.ml | 74 + stdlib/char.mli | 72 + stdlib/complex.ml | 87 + stdlib/complex.mli | 86 + stdlib/digest.ml | 76 + stdlib/digest.mli | 84 + stdlib/dune | 36 + stdlib/ephemeron.ml | 686 + stdlib/ephemeron.mli | 371 + stdlib/expand_module_aliases.awk | 33 + stdlib/filename.ml | 361 + stdlib/filename.mli | 225 + stdlib/float.ml | 511 + stdlib/float.mli | 648 + stdlib/format.ml | 1463 + stdlib/format.mli | 1395 + stdlib/fun.ml | 38 + stdlib/fun.mli | 63 + stdlib/gc.ml | 159 + stdlib/gc.mli | 543 + stdlib/genlex.ml | 201 + stdlib/genlex.mli | 73 + stdlib/hashbang | 1 + stdlib/hashtbl.ml | 613 + stdlib/hashtbl.mli | 483 + stdlib/header.c | 193 + stdlib/headernt.c | 196 + stdlib/int.ml | 50 + stdlib/int.mli | 144 + stdlib/int32.ml | 101 + stdlib/int32.mli | 224 + stdlib/int64.ml | 100 + stdlib/int64.mli | 243 + stdlib/lazy.ml | 83 + stdlib/lazy.mli | 111 + stdlib/lexing.ml | 244 + stdlib/lexing.mli | 214 + stdlib/list.ml | 560 + stdlib/list.mli | 396 + stdlib/listLabels.ml | 18 + stdlib/listLabels.mli | 453 + stdlib/map.ml | 522 + stdlib/map.mli | 352 + stdlib/marshal.ml | 67 + stdlib/marshal.mli | 185 + stdlib/moreLabels.ml | 22 + stdlib/moreLabels.mli | 235 + stdlib/nativeint.ml | 90 + stdlib/nativeint.mli | 238 + stdlib/obj.ml | 160 + stdlib/obj.mli | 173 + stdlib/ocaml_operators.mld | 100 + stdlib/oo.ml | 19 + stdlib/oo.mli | 38 + stdlib/option.ml | 43 + stdlib/option.mli | 82 + stdlib/parsing.ml | 211 + stdlib/parsing.mli | 105 + stdlib/pervasives.ml | 244 + stdlib/printexc.ml | 337 + stdlib/printexc.mli | 374 + stdlib/printf.ml | 43 + stdlib/printf.mli | 194 + stdlib/queue.ml | 164 + stdlib/queue.mli | 108 + stdlib/random.ml | 277 + stdlib/random.mli | 107 + stdlib/remove_module_aliases.awk | 21 + stdlib/result.ml | 46 + stdlib/result.mli | 101 + stdlib/scanf.ml | 1558 + stdlib/scanf.mli | 559 + stdlib/seq.ml | 85 + stdlib/seq.mli | 99 + stdlib/set.ml | 608 + stdlib/set.mli | 306 + stdlib/spacetime.ml | 91 + stdlib/spacetime.mli | 99 + stdlib/stack.ml | 65 + stdlib/stack.mli | 88 + stdlib/stdLabels.ml | 24 + stdlib/stdLabels.mli | 29 + stdlib/std_exit.ml | 18 + stdlib/stdlib.ml | 618 + stdlib/stdlib.mli | 1388 + stdlib/stream.ml | 236 + stdlib/stream.mli | 111 + stdlib/string.ml | 233 + stdlib/string.mli | 345 + stdlib/stringLabels.ml | 18 + stdlib/stringLabels.mli | 312 + stdlib/sys.mli | 387 + stdlib/sys.mlp | 155 + stdlib/uchar.ml | 58 + stdlib/uchar.mli | 98 + stdlib/unit.ml | 20 + stdlib/unit.mli | 36 + stdlib/weak.ml | 372 + stdlib/weak.mli | 190 + testsuite/HACKING.adoc | 32 + testsuite/Makefile | 307 + testsuite/lib/Makefile | 52 + testsuite/lib/lib.ml | 57 + testsuite/lib/testing.ml | 96 + testsuite/lib/testing.mli | 35 + testsuite/summarize.awk | 227 + .../tests/afl-instrumentation/afltest.ml | 16 + .../tests/afl-instrumentation/afltest.run | 36 + .../tests/afl-instrumentation/harness.ml | 27 + .../afl-instrumentation/has-afl-showmap.sh | 7 + testsuite/tests/afl-instrumentation/test.ml | 80 + testsuite/tests/arch-power/exn_raise.ml | 19 + .../tests/arch-power/exn_raise.reference | 0 testsuite/tests/array-functions/test.ml | 281 + .../tests/array-functions/test.reference | 1 + .../asmcomp/0001-test.compilers.reference | 2 + testsuite/tests/asmcomp/0001-test.ml | 1 + testsuite/tests/asmcomp/bind_tuples.ml | 44 + testsuite/tests/asmcomp/compare.ml | 10 + testsuite/tests/asmcomp/compare.reference | 2 + .../tests/asmcomp/func_sections.arm.reference | 1 + testsuite/tests/asmcomp/func_sections.ml | 73 + .../tests/asmcomp/func_sections.reference | 1 + testsuite/tests/asmcomp/func_sections.run | 10 + testsuite/tests/asmcomp/is_in_static_data.c | 5 + testsuite/tests/asmcomp/is_static.ml | 39 + testsuite/tests/asmcomp/is_static_flambda.ml | 206 + .../tests/asmcomp/is_static_flambda_dep.ml | 1 + .../tests/asmcomp/lift_mutable_let_flambda.ml | 29 + testsuite/tests/asmcomp/optargs.ml | 27 + testsuite/tests/asmcomp/register_typing.ml | 24 + .../tests/asmcomp/register_typing_switch.ml | 25 + testsuite/tests/asmcomp/simple_float_const.ml | 1 + .../asmcomp/simple_float_const_opaque.ml | 1 + .../asmcomp/static_float_array_flambda.ml | 25 + .../static_float_array_flambda_opaque.ml | 29 + testsuite/tests/asmcomp/staticalloc.ml | 26 + testsuite/tests/asmcomp/unrolling_flambda.ml | 11 + testsuite/tests/asmcomp/unrolling_flambda2.ml | 24 + testsuite/tests/asmgen/arith.cmm | 227 + testsuite/tests/asmgen/catch-float.cmm | 11 + testsuite/tests/asmgen/catch-multiple.cmm | 20 + .../tests/asmgen/catch-rec-deadhandler.cmm | 17 + .../asmgen/catch-rec-deadhandler.reference | 6 + .../tests/asmgen/catch-rec-deadhandler.run | 5 + testsuite/tests/asmgen/catch-rec.cmm | 11 + testsuite/tests/asmgen/catch-try-float.cmm | 12 + testsuite/tests/asmgen/catch-try.cmm | 12 + testsuite/tests/asmgen/checkbound.cmm | 26 + .../tests/asmgen/even-odd-spill-float.cmm | 27 + testsuite/tests/asmgen/even-odd-spill.cmm | 25 + testsuite/tests/asmgen/even-odd.cmm | 14 + testsuite/tests/asmgen/fib.cmm | 26 + testsuite/tests/asmgen/integr.cmm | 39 + testsuite/tests/asmgen/main.c | 143 + testsuite/tests/asmgen/mainarith.c | 346 + testsuite/tests/asmgen/pgcd.cmm | 15 + testsuite/tests/asmgen/quicksort.cmm | 50 + testsuite/tests/asmgen/quicksort2.cmm | 56 + testsuite/tests/asmgen/soli.cmm | 116 + testsuite/tests/asmgen/tagged-fib.cmm | 25 + testsuite/tests/asmgen/tagged-integr.cmm | 51 + testsuite/tests/asmgen/tagged-quicksort.cmm | 53 + testsuite/tests/asmgen/tagged-tak.cmm | 30 + testsuite/tests/asmgen/tak.cmm | 30 + testsuite/tests/ast-invariants/test.ml | 80 + testsuite/tests/ast-invariants/test.reference | 0 testsuite/tests/backtrace/backtrace.ml | 23 + testsuite/tests/backtrace/backtrace.reference | 26 + testsuite/tests/backtrace/backtrace.run | 8 + testsuite/tests/backtrace/backtrace2.ml | 80 + .../tests/backtrace/backtrace2.reference | 58 + testsuite/tests/backtrace/backtrace3.ml | 65 + .../tests/backtrace/backtrace3.reference | 66 + .../tests/backtrace/backtrace_deprecated.ml | 44 + .../backtrace/backtrace_deprecated.reference | 27 + .../tests/backtrace/backtrace_or_exception.ml | 50 + .../backtrace_or_exception.reference | 14 + testsuite/tests/backtrace/backtrace_slots.ml | 66 + .../tests/backtrace/backtrace_slots.reference | 27 + .../backtrace/backtraces_and_finalizers.ml | 32 + .../backtraces_and_finalizers.reference | 1 + testsuite/tests/backtrace/callstack.ml | 32 + testsuite/tests/backtrace/callstack.reference | 15 + testsuite/tests/backtrace/event_after_prim.ml | 14 + .../backtrace/event_after_prim.reference | 2 + testsuite/tests/backtrace/filter-locations.sh | 2 + testsuite/tests/backtrace/inline_test.ml | 29 + .../tests/backtrace/inline_test.reference | 15 + testsuite/tests/backtrace/inline_test.run | 3 + .../tests/backtrace/inline_traversal_test.ml | 57 + .../backtrace/inline_traversal_test.reference | 5 + .../tests/backtrace/inline_traversal_test.run | 3 + testsuite/tests/backtrace/methods.ml | 28 + testsuite/tests/backtrace/methods.reference | 5 + testsuite/tests/backtrace/names.ml | 124 + testsuite/tests/backtrace/names.reference | 26 + testsuite/tests/backtrace/pr6920_why_at.ml | 17 + .../backtrace/pr6920_why_at.native.reference | 0 .../tests/backtrace/pr6920_why_at.reference | 4 + .../tests/backtrace/pr6920_why_swallow.ml | 19 + .../pr6920_why_swallow.native.reference | 0 .../backtrace/pr6920_why_swallow.reference | 4 + testsuite/tests/backtrace/raw_backtrace.ml | 64 + .../tests/backtrace/raw_backtrace.reference | 49 + testsuite/tests/basic-float/float_compare.ml | 112 + .../tests/basic-float/float_compare.reference | 50 + testsuite/tests/basic-float/float_literals.ml | 285 + testsuite/tests/basic-float/tfloat_hex.ml | 56 + .../tests/basic-float/tfloat_hex.reference | 23 + testsuite/tests/basic-float/tfloat_record.ml | 48 + .../tests/basic-float/tfloat_record.reference | 46 + .../basic-float/zero_sized_float_arrays.ml | 17 + .../zero_sized_float_arrays.reference | 0 testsuite/tests/basic-io-2/io.ml | 108 + testsuite/tests/basic-io-2/io.reference | 24 + .../tests/basic-io-2/test-file-short-lines | 10 + testsuite/tests/basic-io/wc.ml | 58 + testsuite/tests/basic-io/wc.reference | 1 + testsuite/tests/basic-manyargs/manyargs.ml | 49 + .../tests/basic-manyargs/manyargs.reference | 65 + testsuite/tests/basic-manyargs/manyargsprim.c | 40 + testsuite/tests/basic-modules/anonymous.ml | 55 + .../basic-modules/anonymous.ocamlc.reference | 23 + .../anonymous.ocamlopt.flambda.reference | 21 + .../anonymous.ocamlopt.reference | 31 + testsuite/tests/basic-modules/main.ml | 27 + testsuite/tests/basic-modules/main.mli | 0 testsuite/tests/basic-modules/main.reference | 1 + testsuite/tests/basic-modules/offset.ml | 10 + testsuite/tests/basic-modules/pr4008.ml | 6 + testsuite/tests/basic-modules/pr6726.ml | 18 + testsuite/tests/basic-modules/pr7427.ml | 7 + .../recursive_module_evaluation_errors.ml | 119 + testsuite/tests/basic-more/bounds.ml | 30 + testsuite/tests/basic-more/bounds.reference | 9 + testsuite/tests/basic-more/div_by_zero.ml | 70 + .../tests/basic-more/div_by_zero.reference | 3 + testsuite/tests/basic-more/function_in_ref.ml | 12 + .../basic-more/function_in_ref.reference | 2 + testsuite/tests/basic-more/if_in_if.ml | 47 + testsuite/tests/basic-more/if_in_if.reference | 2 + .../basic-more/morematch.compilers.reference | 60 + testsuite/tests/basic-more/morematch.ml | 1159 + .../tests/basic-more/morematch.reference | 2 + testsuite/tests/basic-more/opaque_prim.ml | 10 + .../tests/basic-more/opaque_prim.reference | 2 + testsuite/tests/basic-more/pr1271.ml | 292 + testsuite/tests/basic-more/pr1271.reference | 2 + testsuite/tests/basic-more/pr2719.ml | 21 + testsuite/tests/basic-more/pr2719.reference | 4 + testsuite/tests/basic-more/pr6216.ml | 17 + testsuite/tests/basic-more/pr6216.reference | 2 + testsuite/tests/basic-more/pr7683.ml | 10 + testsuite/tests/basic-more/pr7683.reference | 1 + .../basic-more/record_evaluation_order.ml | 92 + .../record_evaluation_order.reference | 38 + .../robustmatch.compilers.reference | 205 + testsuite/tests/basic-more/robustmatch.ml | 285 + .../tests/basic-more/robustmatch.reference | 2 + .../tests/basic-more/sequential_and_or.ml | 126 + .../basic-more/sequential_and_or.reference | 74 + .../tests/basic-more/structural_constants.ml | 227 + .../basic-more/structural_constants.reference | 2 + testsuite/tests/basic-more/tbuffer.ml | 30 + testsuite/tests/basic-more/tbuffer.reference | 2 + testsuite/tests/basic-more/testrandom.ml | 16 + .../tests/basic-more/testrandom.reference | 4 + .../tests/basic-more/top_level_patterns.ml | 11 + .../basic-more/top_level_patterns.reference | 2 + testsuite/tests/basic-more/tprintf.ml | 79 + testsuite/tests/basic-more/tprintf.reference | 2 + testsuite/tests/basic-multdef/multdef.ml | 2 + testsuite/tests/basic-multdef/multdef.mli | 3 + testsuite/tests/basic-multdef/usemultdef.ml | 5 + .../tests/basic-multdef/usemultdef.reference | 1 + testsuite/tests/basic-private/length.ml | 16 + testsuite/tests/basic-private/length.mli | 13 + testsuite/tests/basic-private/tlength.ml | 27 + .../tests/basic-private/tlength.reference | 0 testsuite/tests/basic/arrays.ml | 139 + testsuite/tests/basic/arrays.reference | 0 testsuite/tests/basic/bigints.ml | 27 + testsuite/tests/basic/bigints.reference | 10 + testsuite/tests/basic/boxedints.ml | 651 + testsuite/tests/basic/boxedints.reference | 130 + testsuite/tests/basic/camlCase.ml | 1 + testsuite/tests/basic/constprop.ml.c | 130 + testsuite/tests/basic/constprop.ml.reference | 10 + testsuite/tests/basic/divint.ml | 147 + testsuite/tests/basic/divint.reference | 37 + testsuite/tests/basic/equality.ml | 106 + testsuite/tests/basic/equality.reference | 49 + testsuite/tests/basic/eval_order_1.ml | 6 + testsuite/tests/basic/eval_order_1.reference | 1 + testsuite/tests/basic/eval_order_2.ml | 26 + testsuite/tests/basic/eval_order_2.reference | 0 testsuite/tests/basic/eval_order_3.ml | 24 + testsuite/tests/basic/eval_order_3.reference | 1 + testsuite/tests/basic/eval_order_4.ml | 19 + testsuite/tests/basic/eval_order_4.reference | 4 + testsuite/tests/basic/eval_order_6.ml | 18 + testsuite/tests/basic/eval_order_6.reference | 2 + testsuite/tests/basic/float.ml | 3 + testsuite/tests/basic/float.reference | 1 + .../tests/basic/float_physical_equality.ml | 12 + .../basic/float_physical_equality.reference | 0 testsuite/tests/basic/includestruct.ml | 109 + testsuite/tests/basic/includestruct.reference | 17 + testsuite/tests/basic/localexn.ml | 11 + testsuite/tests/basic/localexn.reference | 2 + testsuite/tests/basic/localfunction.ml | 32 + testsuite/tests/basic/localfunction.reference | 1 + testsuite/tests/basic/maps.ml | 75 + testsuite/tests/basic/maps.reference | 11 + testsuite/tests/basic/min_int.ml | 12 + testsuite/tests/basic/min_int.reference | 1 + testsuite/tests/basic/opt_variants.ml | 134 + testsuite/tests/basic/opt_variants.reference | 0 testsuite/tests/basic/patmatch.ml | 1876 + testsuite/tests/basic/patmatch.reference | 153 + testsuite/tests/basic/patmatch_incoherence.ml | 138 + testsuite/tests/basic/patmatch_split_no_or.ml | 90 + testsuite/tests/basic/pr7253.ml | 15 + testsuite/tests/basic/pr7253.reference | 4 + testsuite/tests/basic/pr7533.ml | 21 + testsuite/tests/basic/pr7533.reference | 0 testsuite/tests/basic/pr7657.ml | 15 + testsuite/tests/basic/pr7657.reference | 3 + testsuite/tests/basic/recvalues.ml | 40 + testsuite/tests/basic/recvalues.reference | 5 + testsuite/tests/basic/sets.ml | 27 + testsuite/tests/basic/sets.reference | 25 + testsuite/tests/basic/stringmatch.ml | 740 + testsuite/tests/basic/stringmatch.reference | 0 testsuite/tests/basic/switch_opts.ml | 309 + testsuite/tests/basic/switch_opts.reference | 1 + testsuite/tests/basic/tailcalls.ml | 43 + testsuite/tests/basic/tailcalls.reference | 6 + testsuite/tests/basic/trigraph.ml | 5 + testsuite/tests/basic/trigraph.reference | 1 + testsuite/tests/basic/tuple_match.ml | 56 + testsuite/tests/basic/tuple_match.reference | 17 + .../basic/unit_naming.compilers.reference | 4 + testsuite/tests/basic/unit_naming.ml | 9 + testsuite/tests/basic/zero_divided_by_n.ml | 19 + .../tests/basic/zero_divided_by_n.reference | 0 testsuite/tests/c-api/alloc_async.ml | 17 + testsuite/tests/c-api/alloc_async.reference | 5 + testsuite/tests/c-api/alloc_async_stubs.c | 54 + testsuite/tests/callback/callbackprim.c | 69 + testsuite/tests/callback/signals_alloc.ml | 31 + .../tests/callback/signals_alloc.reference | 1 + testsuite/tests/callback/tcallback.ml | 79 + testsuite/tests/callback/tcallback.reference | 8 + testsuite/tests/compatibility/main.ml | 16 + testsuite/tests/compatibility/main.reference | 1 + testsuite/tests/compatibility/stub.c | 20 + .../tests/compiler-libs/test_longident.ml | 195 + testsuite/tests/embedded/cmcaml.ml | 20 + testsuite/tests/embedded/cmcaml.reference | 4 + testsuite/tests/embedded/cmmain.c | 49 + testsuite/tests/embedded/cmstub.c | 30 + testsuite/tests/ephe-c-api/stubs.c | 325 + testsuite/tests/ephe-c-api/test.ml | 24 + testsuite/tests/ephe-c-api/test.reference | 65 + testsuite/tests/exotic-syntax/exotic.ml | 162 + .../tests/exotic-syntax/exotic.reference | 0 testsuite/tests/extension-constructor/test.ml | 24 + .../extension-constructor/test.reference | 1 + testsuite/tests/flambda/approx_meet.ml | 15 + testsuite/tests/flambda/approx_meet.reference | 1 + testsuite/tests/flambda/gpr2239.ml | 16 + testsuite/tests/flambda/gpr2239.reference | 1 + testsuite/tests/flambda/gpr998.ml | 43 + testsuite/tests/flambda/gpr998.reference | 0 testsuite/tests/flambda/specialise.ml | 59 + testsuite/tests/flambda/specialise.reference | 0 .../float_subst_boxed_number.ml | 187 + .../float-unboxing/unbox_under_assign.ml | 75 + testsuite/tests/fma/fma.ml | 496 + testsuite/tests/fma/fma.reference | 317 + .../deprecated_unsigned_printers.ml | 26 + ...precated_unsigned_printers.ocaml.reference | 6 + .../ignored_scan_counters.ml | 37 + .../ignored_scan_counters.ocaml.reference | 14 + .../legacy_incompatible_flags.ml | 24 + .../legacy_incompatible_flags.ocaml.reference | 7 + .../legacy_unfinished_modifiers.ml | 22 + ...egacy_unfinished_modifiers.ocaml.reference | 5 + testsuite/tests/formatting/errors_batch.ml | 43 + .../tests/formatting/errors_batch.reference | 10 + testsuite/tests/formatting/margins.ml | 12 + .../tests/formatting/margins.ocaml.reference | 13 + ...test_locations.dlocations.ocamlc.reference | 176 + ...ions.dlocations.ocamlopt.clambda.reference | 31 + ...ions.dlocations.ocamlopt.flambda.reference | 38 + ...t_locations.dno-locations.ocamlc.reference | 169 + ...s.dno-locations.ocamlopt.clambda.reference | 28 + ...s.dno-locations.ocamlopt.flambda.reference | 31 + testsuite/tests/formatting/test_locations.ml | 45 + .../functors/functors.compilers.reference | 56 + testsuite/tests/functors/functors.ml | 48 + testsuite/tests/gc-roots/globroots.ml | 92 + testsuite/tests/gc-roots/globroots.reference | 4 + testsuite/tests/gc-roots/globrootsprim.c | 113 + .../tests/generalized-open/accepted_batch.ml | 34 + .../generalized-open/accepted_batch.reference | 3 + .../tests/generalized-open/accepted_expect.ml | 108 + .../tests/generalized-open/clambda_optim.ml | 15 + .../tests/generalized-open/expansiveness.ml | 93 + .../funct_body.compilers.reference | 5 + .../tests/generalized-open/funct_body.ml | 47 + testsuite/tests/generalized-open/gpr1506.ml | 392 + testsuite/tests/generalized-open/shadowing.ml | 59 + testsuite/tests/instrumented-runtime/main.ml | 11 + testsuite/tests/instrumented-runtime/main.run | 35 + testsuite/tests/int64-unboxing/stubs.c | 25 + testsuite/tests/int64-unboxing/test.ml | 30 + testsuite/tests/int64-unboxing/test.reference | 0 testsuite/tests/lazy/lazy1.ml | 18 + testsuite/tests/lazy/lazy1.reference | 1 + testsuite/tests/let-syntax/let_syntax.ml | 724 + testsuite/tests/letrec-check/basic.ml | 366 + .../letrec-check/extension_constructor.ml | 25 + .../tests/letrec-check/flat_float_array.ml | 52 + .../tests/letrec-check/float_unboxing.ml | 37 + testsuite/tests/letrec-check/labels.ml | 33 + testsuite/tests/letrec-check/lazy_.ml | 23 + testsuite/tests/letrec-check/modules.ml | 105 + .../tests/letrec-check/no_flat_float_array.ml | 32 + testsuite/tests/letrec-check/objects.ml | 60 + testsuite/tests/letrec-check/pr7215.ml | 13 + .../tests/letrec-check/pr7215.ocaml.reference | 7 + testsuite/tests/letrec-check/pr7231.ml | 5 + .../tests/letrec-check/pr7231.ocaml.reference | 9 + testsuite/tests/letrec-check/pr7706.ml | 8 + .../tests/letrec-check/pr7706.ocaml.reference | 9 + testsuite/tests/letrec-check/records.ml | 31 + testsuite/tests/letrec-check/unboxed.ml | 109 + .../letrec-compilation/backreferences.ml | 20 + .../backreferences.reference | 0 testsuite/tests/letrec-compilation/class_1.ml | 7 + .../letrec-compilation/class_1.reference | 0 testsuite/tests/letrec-compilation/class_2.ml | 10 + .../letrec-compilation/class_2.reference | 2 + .../letrec-compilation/evaluation_order_1.ml | 22 + .../evaluation_order_1.reference | 3 + .../letrec-compilation/evaluation_order_2.ml | 21 + .../evaluation_order_2.reference | 3 + .../letrec-compilation/evaluation_order_3.ml | 13 + .../evaluation_order_3.reference | 6 + .../tests/letrec-compilation/float_block_1.ml | 12 + .../float_block_1.reference | 2 + .../tests/letrec-compilation/generic_array.ml | 5 + .../generic_array.reference | 0 testsuite/tests/letrec-compilation/labels.ml | 4 + .../tests/letrec-compilation/labels.reference | 0 testsuite/tests/letrec-compilation/lazy_.ml | 5 + .../tests/letrec-compilation/lazy_.reference | 1 + testsuite/tests/letrec-compilation/lists.ml | 10 + .../tests/letrec-compilation/lists.reference | 0 .../mixing_value_closures_1.ml | 10 + .../mixing_value_closures_1.reference | 0 .../mixing_value_closures_2.ml | 10 + .../mixing_value_closures_2.reference | 0 .../letrec-compilation/mutual_functions.ml | 13 + .../mutual_functions.reference | 0 testsuite/tests/letrec-compilation/nested.ml | 9 + .../tests/letrec-compilation/nested.reference | 0 testsuite/tests/letrec-compilation/pr4989.ml | 3 + .../tests/letrec-compilation/pr4989.reference | 0 testsuite/tests/letrec-compilation/pr8681.ml | 63 + .../tests/letrec-compilation/pr8681.reference | 5 + .../tests/letrec-compilation/record_with.ml | 26 + .../letrec-compilation/record_with.reference | 1 + testsuite/tests/letrec-compilation/ref.ml | 15 + .../tests/letrec-compilation/ref.reference | 0 testsuite/tests/lexing/comments.ml | 11 + .../tests/lexing/comments.ocaml.reference | 1 + testsuite/tests/lexing/escape.ml | 11 + testsuite/tests/lexing/escape.ocaml.reference | 24 + testsuite/tests/lexing/uchar_esc.ml | 37 + .../tests/lexing/uchar_esc.ocaml.reference | 35 + testsuite/tests/lib-arg/testarg.ml | 209 + testsuite/tests/lib-arg/testarg.reference | 11 + testsuite/tests/lib-arg/testerror.ml | 53 + testsuite/tests/lib-arg/testerror.reference | 65 + testsuite/tests/lib-array/test_array.ml | 57 + testsuite/tests/lib-bigarray-2/bigarrf.f | 26 + testsuite/tests/lib-bigarray-2/bigarrfml.ml | 96 + .../tests/lib-bigarray-2/bigarrfml.reference | 27 + testsuite/tests/lib-bigarray-2/bigarrfstub.c | 74 + .../tests/lib-bigarray-2/has-gfortran.sh | 12 + testsuite/tests/lib-bigarray-file/mapfile.ml | 139 + .../tests/lib-bigarray-file/mapfile.reference | 5 + testsuite/tests/lib-bigarray/bigarrays.ml | 993 + .../tests/lib-bigarray/bigarrays.reference | 77 + testsuite/tests/lib-bigarray/change_layout.ml | 147 + .../lib-bigarray/change_layout.reference | 5 + testsuite/tests/lib-bigarray/fftba.ml | 185 + testsuite/tests/lib-bigarray/fftba.reference | 13 + testsuite/tests/lib-bigarray/pr5115.ml | 15 + testsuite/tests/lib-bigarray/pr5115.reference | 2 + testsuite/tests/lib-bigarray/weak_bigarray.ml | 29 + .../lib-bigarray/weak_bigarray.reference | 3 + testsuite/tests/lib-bool/test.ml | 86 + testsuite/tests/lib-bool/test.reference | 1 + testsuite/tests/lib-buffer/test.ml | 258 + testsuite/tests/lib-buffer/test.reference | 9 + testsuite/tests/lib-bytes/binary.ml | 172 + testsuite/tests/lib-bytes/test_bytes.ml | 126 + .../tests/lib-bytes/test_bytes.reference | 2 + testsuite/tests/lib-digest/md5.ml | 240 + testsuite/tests/lib-digest/md5.reference | 1 + .../lib-dynlink-bytecode/custom.reference | 5 + testsuite/tests/lib-dynlink-bytecode/main.ml | 93 + .../tests/lib-dynlink-bytecode/main.reference | 13 + testsuite/tests/lib-dynlink-bytecode/plug1.ml | 7 + testsuite/tests/lib-dynlink-bytecode/plug2.ml | 7 + .../tests/lib-dynlink-bytecode/registry.ml | 7 + .../lib-dynlink-bytecode/static.reference | 5 + testsuite/tests/lib-dynlink-bytecode/stub1.c | 27 + testsuite/tests/lib-dynlink-bytecode/stub2.c | 28 + testsuite/tests/lib-dynlink-csharp/entry.c | 44 + .../main.bytecode.reference | 5 + testsuite/tests/lib-dynlink-csharp/main.cs | 11 + testsuite/tests/lib-dynlink-csharp/main.ml | 100 + .../lib-dynlink-csharp/main.native.reference | 5 + testsuite/tests/lib-dynlink-csharp/plugin.ml | 4 + .../test10_main.byte.reference | 12 + .../lib-dynlink-initializers/test10_main.ml | 57 + .../test10_main.native.reference | 14 + .../lib-dynlink-initializers/test10_plugin.ml | 11 + .../test1_inited_second.ml | 1 + .../lib-dynlink-initializers/test1_main.ml | 57 + .../lib-dynlink-initializers/test1_plugin.ml | 2 + .../test2_inited_first.ml | 1 + .../lib-dynlink-initializers/test2_main.ml | 50 + .../lib-dynlink-initializers/test2_plugin.ml | 2 + .../lib-dynlink-initializers/test3_main.ml | 55 + .../test3_plugin_a.ml | 1 + .../test3_plugin_b.ml | 2 + .../lib-dynlink-initializers/test4_main.ml | 60 + .../test4_plugin_a.ml | 2 + .../test4_plugin_b.ml | 1 + .../lib-dynlink-initializers/test5_main.ml | 60 + .../test5_plugin_a.ml | 4 + .../test5_plugin_b.ml | 6 + .../test5_second_plugin.ml | 2 + .../lib-dynlink-initializers/test6_main.ml | 50 + .../lib-dynlink-initializers/test6_plugin.ml | 17 + .../test6_second_plugin.ml | 2 + .../test7_interface_only.mli | 2 + .../lib-dynlink-initializers/test7_main.ml | 49 + .../lib-dynlink-initializers/test7_plugin.ml | 2 + .../lib-dynlink-initializers/test8_main.ml | 58 + .../test8_plugin_a.ml | 4 + .../test8_plugin_b.ml | 4 + .../test8_plugin_b.mli | 2 + .../lib-dynlink-initializers/test9_main.ml | 57 + .../lib-dynlink-initializers/test9_plugin.ml | 2 + .../test9_second_plugin.ml | 4 + .../test9_second_plugin.mli | 2 + testsuite/tests/lib-dynlink-native/a.ml | 5 + testsuite/tests/lib-dynlink-native/api.ml | 20 + testsuite/tests/lib-dynlink-native/b.ml | 4 + testsuite/tests/lib-dynlink-native/bug.ml | 2 + testsuite/tests/lib-dynlink-native/c.ml | 4 + .../tests/lib-dynlink-native/factorial.c | 33 + testsuite/tests/lib-dynlink-native/main.ml | 245 + .../tests/lib-dynlink-native/main.reference | 30 + .../tests/lib-dynlink-native/pack_client.ml | 2 + testsuite/tests/lib-dynlink-native/packed1.ml | 5 + .../lib-dynlink-native/packed1_client.ml | 3 + testsuite/tests/lib-dynlink-native/plugin.ml | 11 + testsuite/tests/lib-dynlink-native/plugin.mli | 1 + testsuite/tests/lib-dynlink-native/plugin2.ml | 8 + testsuite/tests/lib-dynlink-native/plugin4.ml | 3 + .../tests/lib-dynlink-native/plugin_ext.ml | 5 + .../lib-dynlink-native/plugin_high_arity.ml | 6 + .../tests/lib-dynlink-native/plugin_ref.ml | 10 + .../tests/lib-dynlink-native/plugin_simple.ml | 3 + .../tests/lib-dynlink-native/plugin_thread.ml | 15 + testsuite/tests/lib-dynlink-native/sub/api.ml | 3 + .../tests/lib-dynlink-native/sub/api.mli | 1 + .../tests/lib-dynlink-native/sub/plugin.ml | 6 + .../tests/lib-dynlink-native/sub/plugin3.ml | 2 + testsuite/tests/lib-dynlink-packed/a.ml | 1 + testsuite/tests/lib-dynlink-packed/b.ml | 1 + .../tests/lib-dynlink-packed/byte.reference | 5 + testsuite/tests/lib-dynlink-packed/loader.ml | 64 + .../tests/lib-dynlink-packed/native.reference | 5 + .../tests/lib-dynlink-pr4229/abstract.ml | 3 + .../tests/lib-dynlink-pr4229/abstract.mli | 3 + testsuite/tests/lib-dynlink-pr4229/client.ml | 1 + testsuite/tests/lib-dynlink-pr4229/main.ml | 100 + .../tests/lib-dynlink-pr4229/main.reference | 1 + testsuite/tests/lib-dynlink-pr4229/static.ml | 1 + .../tests/lib-dynlink-pr4229/sub/abstract.ml | 3 + .../tests/lib-dynlink-pr4229/sub/abstract.mli | 3 + .../lib-dynlink-pr4839/byte.plugin1.reference | 3 + .../lib-dynlink-pr4839/byte.plugin2.reference | 2 + .../lib-dynlink-pr4839/byte.plugin3.reference | 2 + .../lib-dynlink-pr4839/byte.plugin4.reference | 2 + .../tests/lib-dynlink-pr4839/host/api.ml | 3 + .../tests/lib-dynlink-pr4839/host/api.mli | 2 + .../tests/lib-dynlink-pr4839/host/host.ml | 8 + .../native.plugin1.reference | 3 + .../native.plugin2.reference | 2 + .../native.plugin3.reference | 2 + .../native.plugin4.reference | 2 + .../tests/lib-dynlink-pr4839/plugin1/api.ml | 3 + .../tests/lib-dynlink-pr4839/plugin1/api.mli | 2 + .../lib-dynlink-pr4839/plugin1/plugin.ml | 7 + .../tests/lib-dynlink-pr4839/plugin2/api.ml | 3 + .../tests/lib-dynlink-pr4839/plugin2/api.mli | 2 + .../lib-dynlink-pr4839/plugin2/plugin.ml | 7 + .../tests/lib-dynlink-pr4839/plugin3/api.ml | 3 + .../tests/lib-dynlink-pr4839/plugin3/api.mli | 2 + .../lib-dynlink-pr4839/plugin3/plugin.ml | 7 + .../tests/lib-dynlink-pr4839/plugin4/api.ml | 3 + .../tests/lib-dynlink-pr4839/plugin4/api.mli | 2 + .../lib-dynlink-pr4839/plugin4/plugin.ml | 7 + testsuite/tests/lib-dynlink-pr4839/test.ml | 261 + testsuite/tests/lib-dynlink-pr6950/b.ml | 1 + .../tests/lib-dynlink-pr6950/byte.reference | 0 testsuite/tests/lib-dynlink-pr6950/config.ml | 2 + testsuite/tests/lib-dynlink-pr6950/loader.ml | 48 + .../tests/lib-dynlink-pr6950/native.reference | 0 testsuite/tests/lib-dynlink-pr9209/dyn.ml | 63 + testsuite/tests/lib-dynlink-pr9209/lib.ml | 1 + testsuite/tests/lib-dynlink-pr9209/lib2.ml | 1 + .../tests/lib-dynlink-pr9209/main.reference | 0 testsuite/tests/lib-dynlink-pr9209/ocamltests | 1 + testsuite/tests/lib-dynlink-pr9209/test.c | 3 + testsuite/tests/lib-dynlink-private/pig.mli | 4 + .../lib-dynlink-private/plugin1/sheep.ml | 4 + .../lib-dynlink-private/plugin1/sheep.mli | 4 + .../tests/lib-dynlink-private/plugin2/cow.ml | 4 + .../tests/lib-dynlink-private/plugin2/cow.mli | 4 + .../tests/lib-dynlink-private/plugin2b/cow.ml | 4 + .../lib-dynlink-private/plugin2b/cow.mli | 4 + .../tests/lib-dynlink-private/plugin2c/cow.ml | 4 + .../lib-dynlink-private/plugin2c/cow.mli | 4 + .../tests/lib-dynlink-private/plugin3/pig.ml | 4 + .../tests/lib-dynlink-private/plugin3/pig.mli | 4 + .../lib-dynlink-private/plugin4/chicken.ml | 11 + .../lib-dynlink-private/plugin4/chicken.mli | 0 .../lib-dynlink-private/plugin5/chicken.ml | 2 + .../lib-dynlink-private/plugin5/chicken.mli | 2 + .../lib-dynlink-private/plugin6/partridge.ml | 1 + .../lib-dynlink-private/plugin6/partridge.mli | 1 + .../lib-dynlink-private/plugin6/pheasant.ml | 10 + .../lib-dynlink-private/plugin6/pheasant.mli | 0 testsuite/tests/lib-dynlink-private/sheep.ml | 4 + testsuite/tests/lib-dynlink-private/sheep.mli | 4 + testsuite/tests/lib-dynlink-private/test.ml | 272 + testsuite/tests/lib-filename/extension.ml | 17 + .../tests/lib-filename/extension.reference | 0 testsuite/tests/lib-filename/myecho.ml | 20 + testsuite/tests/lib-filename/null.ml | 8 + testsuite/tests/lib-filename/quotecommand.ml | 104 + .../tests/lib-filename/quotecommand.reference | 38 + testsuite/tests/lib-filename/suffix.ml | 27 + testsuite/tests/lib-filename/suffix.reference | 0 testsuite/tests/lib-float/test.ml | 119 + testsuite/tests/lib-float/test.reference | 1 + testsuite/tests/lib-floatarray/floatarray.ml | 528 + .../tests/lib-format/pp_print_custom_break.ml | 64 + .../pp_print_custom_break.reference | 159 + testsuite/tests/lib-format/pr6824.ml | 11 + testsuite/tests/lib-format/pr6824.reference | 6 + .../tests/lib-format/print_if_newline.ml | 26 + .../lib-format/print_if_newline.reference | 6 + testsuite/tests/lib-format/tformat.ml | 541 + testsuite/tests/lib-format/tformat.reference | 97 + testsuite/tests/lib-fun/test.ml | 52 + testsuite/tests/lib-fun/test.reference | 1 + testsuite/tests/lib-hashtbl/hfun.ml | 45 + testsuite/tests/lib-hashtbl/hfun.reference | 27 + testsuite/tests/lib-hashtbl/htbl.ml | 283 + testsuite/tests/lib-hashtbl/htbl.reference | 56 + testsuite/tests/lib-int/test.ml | 72 + testsuite/tests/lib-int/test.reference | 1 + testsuite/tests/lib-int64/issue9460.ml | 37 + testsuite/tests/lib-int64/issue9460.reference | 1 + testsuite/tests/lib-int64/test.ml | 71 + testsuite/tests/lib-int64/test.reference | 1 + testsuite/tests/lib-internalformat/test.ml | 30 + testsuite/tests/lib-list/test.ml | 94 + testsuite/tests/lib-list/test.reference | 1 + testsuite/tests/lib-marshal/intern_final.ml | 30 + .../tests/lib-marshal/intern_final.reference | 1 + testsuite/tests/lib-marshal/intext.ml | 632 + testsuite/tests/lib-marshal/intext.reference | 174 + testsuite/tests/lib-marshal/intextaux.c | 64 + .../tests/lib-marshal/marshal_bigarray.ml | 14 + .../lib-marshal/marshal_bigarray.reference | 0 testsuite/tests/lib-obj/reachable_words.ml | 40 + .../tests/lib-obj/reachable_words.reference | 1 + testsuite/tests/lib-obj/with_tag.ml | 31 + testsuite/tests/lib-obj/with_tag.reference | 1 + testsuite/tests/lib-option/test.ml | 117 + testsuite/tests/lib-option/test.reference | 1 + testsuite/tests/lib-printf/pr6534.ml | 23 + testsuite/tests/lib-printf/pr6534.reference | 14 + testsuite/tests/lib-printf/pr6938.ml | 46 + testsuite/tests/lib-printf/pr6938.reference | 31 + testsuite/tests/lib-printf/tprintf.ml | 652 + testsuite/tests/lib-printf/tprintf.reference | 101 + testsuite/tests/lib-queue/test.ml | 141 + testsuite/tests/lib-queue/test.reference | 1 + testsuite/tests/lib-random/rand.ml | 15 + testsuite/tests/lib-random/rand.reference | 1 + testsuite/tests/lib-result/test.ml | 131 + testsuite/tests/lib-result/test.reference | 1 + testsuite/tests/lib-scanf-2/tscanf2.reference | 2 + testsuite/tests/lib-scanf-2/tscanf2_io.ml | 19 + testsuite/tests/lib-scanf-2/tscanf2_master.ml | 109 + testsuite/tests/lib-scanf-2/tscanf2_worker.ml | 28 + testsuite/tests/lib-scanf/tscanf.ml | 1558 + testsuite/tests/lib-scanf/tscanf.reference | 2 + testsuite/tests/lib-seq/test.ml | 38 + testsuite/tests/lib-seq/test.reference | 1 + testsuite/tests/lib-set/testmap.ml | 253 + testsuite/tests/lib-set/testmap.reference | 0 testsuite/tests/lib-set/testset.ml | 270 + testsuite/tests/lib-set/testset.reference | 0 testsuite/tests/lib-stack/test.ml | 121 + testsuite/tests/lib-stack/test.reference | 1 + .../tests/lib-stdlabels/test_stdlabels.ml | 47 + .../lib-stdlabels/test_stdlabels.reference | 0 .../tests/lib-stdlib/pervasives_deprecated.ml | 41 + testsuite/tests/lib-str/t01.ml | 1085 + testsuite/tests/lib-str/t01.reference | 106 + .../tests/lib-stream/count_concat_bug.ml | 61 + .../lib-stream/count_concat_bug.reference | 2 + testsuite/tests/lib-stream/mpr7769.ml | 9 + testsuite/tests/lib-stream/mpr7769.reference | 1 + testsuite/tests/lib-stream/mpr7769.txt | 1 + testsuite/tests/lib-string/test_string.ml | 55 + .../tests/lib-string/test_string.reference | 0 testsuite/tests/lib-sys/immediate64.ml | 32 + testsuite/tests/lib-sys/rename.ml | 55 + testsuite/tests/lib-sys/rename.reference | 4 + testsuite/tests/lib-systhreads/testfork.ml | 40 + .../tests/lib-systhreads/testfork.reference | 6 + testsuite/tests/lib-systhreads/testpreempt.ml | 36 + .../lib-systhreads/testpreempt.reference | 3 + testsuite/tests/lib-systhreads/testyield.ml | 52 + .../tests/lib-systhreads/threadsigmask.ml | 80 + .../lib-systhreads/threadsigmask.reference | 1 + .../tests/lib-threads/backtrace_threads.ml | 27 + testsuite/tests/lib-threads/bank.ml | 36 + testsuite/tests/lib-threads/bank.reference | 2 + testsuite/tests/lib-threads/beat.ml | 28 + testsuite/tests/lib-threads/beat.reference | 1 + testsuite/tests/lib-threads/bufchan.ml | 60 + testsuite/tests/lib-threads/bufchan.reference | 3 + testsuite/tests/lib-threads/close.ml | 27 + testsuite/tests/lib-threads/close.reference | 3 + testsuite/tests/lib-threads/delayintr.ml | 61 + .../tests/lib-threads/delayintr.reference | 1 + testsuite/tests/lib-threads/delayintr.run | 5 + testsuite/tests/lib-threads/fileio.ml | 126 + testsuite/tests/lib-threads/fileio.reference | 22 + testsuite/tests/lib-threads/pr4466.ml | 77 + testsuite/tests/lib-threads/pr4466.reference | 6 + testsuite/tests/lib-threads/pr5325.ml | 56 + testsuite/tests/lib-threads/pr5325.reference | 1 + testsuite/tests/lib-threads/pr7638.ml | 19 + testsuite/tests/lib-threads/pr7638.reference | 1 + testsuite/tests/lib-threads/prodcons.ml | 71 + .../tests/lib-threads/prodcons.reference | 1 + testsuite/tests/lib-threads/prodcons2.ml | 42 + .../tests/lib-threads/prodcons2.reference | 1 + testsuite/tests/lib-threads/sieve.ml | 37 + testsuite/tests/lib-threads/sieve.reference | 50 + testsuite/tests/lib-threads/sigint.c | 55 + .../lib-threads/signal.check-program-output | 6 + testsuite/tests/lib-threads/signal.ml | 72 + testsuite/tests/lib-threads/signal.run | 5 + testsuite/tests/lib-threads/sockets.ml | 49 + testsuite/tests/lib-threads/sockets.reference | 2 + testsuite/tests/lib-threads/swapchan.ml | 35 + .../tests/lib-threads/swapchan.reference | 2 + testsuite/tests/lib-threads/swapchan.run | 1 + testsuite/tests/lib-threads/tls.ml | 35 + testsuite/tests/lib-threads/tls.reference | 5 + testsuite/tests/lib-threads/tls.run | 1 + testsuite/tests/lib-threads/torture.ml | 54 + testsuite/tests/lib-threads/torture.reference | 1 + testsuite/tests/lib-uchar/test.ml | 89 + testsuite/tests/lib-uchar/test.reference | 1 + testsuite/tests/lib-unix/common/channel_of.ml | 66 + .../lib-unix/common/channel_of.reference | 12 + testsuite/tests/lib-unix/common/cloexec.ml | 113 + .../tests/lib-unix/common/cloexec.reference | 21 + .../tests/lib-unix/common/cmdline_prog.ml | 4 + testsuite/tests/lib-unix/common/dup.ml | 12 + testsuite/tests/lib-unix/common/dup.reference | 1 + testsuite/tests/lib-unix/common/dup2.ml | 30 + .../tests/lib-unix/common/dup2.reference | 2 + .../tests/lib-unix/common/fdstatus_aux.c | 74 + .../tests/lib-unix/common/fdstatus_main.ml | 7 + .../tests/lib-unix/common/getaddrinfo.ml | 16 + testsuite/tests/lib-unix/common/pipe_eof.ml | 41 + .../tests/lib-unix/common/pipe_eof.reference | 1 + .../tests/lib-unix/common/process_pid.ml | 18 + .../lib-unix/common/process_pid.reference | 1 + .../tests/lib-unix/common/redirections.ml | 147 + .../lib-unix/common/redirections.reference | 28 + testsuite/tests/lib-unix/common/reflector.ml | 50 + testsuite/tests/lib-unix/common/rename.ml | 59 + .../tests/lib-unix/common/rename.reference | 4 + .../lib-unix/common/test_unix_cmdline.ml | 76 + .../common/test_unix_cmdline.reference | 25 + testsuite/tests/lib-unix/common/truncate.ml | 33 + .../tests/lib-unix/common/truncate.reference | 6 + testsuite/tests/lib-unix/common/utimes.ml | 35 + .../tests/lib-unix/common/utimes.reference | 2 + testsuite/tests/lib-unix/common/utimes.txt | 0 .../tests/lib-unix/common/wait_nohang.ml | 52 + .../lib-unix/common/wait_nohang.reference | 1 + testsuite/tests/lib-unix/isatty/isatty_std.ml | 16 + .../lib-unix/isatty/isatty_std.reference | 3 + testsuite/tests/lib-unix/isatty/isatty_tty.ml | 16 + .../lib-unix/isatty/isatty_tty.reference | 1 + testsuite/tests/lib-unix/unix-execvpe/exec.ml | 24 + .../lib-unix/unix-execvpe/exec.reference | 19 + .../tests/lib-unix/unix-execvpe/exec.run | 33 + .../lib-unix/unix-execvpe/has-execvpe.sh | 11 + testsuite/tests/lib-unix/unix-execvpe/script3 | 4 + .../lib-unix/unix-execvpe/subdir/nonexec | 1 + .../lib-unix/unix-execvpe/subdir/script1 | 4 + .../lib-unix/unix-execvpe/subdir/script2 | 3 + .../tests/lib-unix/unix-socket/is-linux.sh | 21 + .../tests/lib-unix/unix-socket/recvfrom.ml | 33 + .../lib-unix/unix-socket/recvfrom_linux.ml | 21 + .../unix-socket/recvfrom_linux.reference | 1 + .../lib-unix/unix-socket/recvfrom_unix.ml | 24 + .../unix-socket/recvfrom_unix.reference | 2 + testsuite/tests/lib-unix/win-env/stubs.c | 20 + testsuite/tests/lib-unix/win-env/test_env.ml | 40 + .../tests/lib-unix/win-env/test_env.reference | 3 + testsuite/tests/lib-unix/win-stat/fakeclock.c | 179 + testsuite/tests/lib-unix/win-stat/test.ml | 39 + .../tests/lib-unix/win-stat/test.reference | 6 + testsuite/tests/lib-unix/win-stat/test.run | 4 + testsuite/tests/lib-unix/win-symlink/test.ml | 29 + .../tests/lib-unix/win-symlink/test.reference | 2 + testsuite/tests/link-test/aliases.ml | 1 + testsuite/tests/link-test/external.ml | 2 + testsuite/tests/link-test/external.mli | 1 + .../tests/link-test/external_for_pack.ml | 2 + .../tests/link-test/external_for_pack.mli | 1 + testsuite/tests/link-test/submodule.ml | 2 + testsuite/tests/link-test/test.ml | 85 + testsuite/tests/link-test/test.reference | 3 + testsuite/tests/link-test/use_in_pack.ml | 1 + testsuite/tests/local-functions/tupled.ml | 11 + testsuite/tests/local-functions/tupled2.ml | 16 + testsuite/tests/locale/stubs.c | 8 + testsuite/tests/locale/test.ml | 31 + testsuite/tests/locale/test.reference | 12 + testsuite/tests/manual-intf-c/curses.ml | 13 + testsuite/tests/manual-intf-c/curses_stubs.c | 95 + testsuite/tests/manual-intf-c/prog.ml | 21 + testsuite/tests/manual-intf-c/prog2.reference | 2 + .../exhaustiveness_warnings.ml | 93 + .../no_mixing_under_guard.ml | 21 + .../no_value_clauses.ml | 15 + .../match-exception-warnings/placement.ml | 172 + .../tests/match-exception-warnings/pr7083.ml | 13 + .../match-exception-warnings/reachability.ml | 61 + testsuite/tests/match-exception/allocation.ml | 28 + .../match-exception/allocation.reference | 1 + .../match-exception/exception_propagation.ml | 20 + .../exception_propagation.reference | 1 + .../match-exception/identifier_sharing.ml | 9 + .../identifier_sharing.reference | 1 + .../tests/match-exception/match_failure.ml | 22 + .../match-exception/match_failure.reference | 1 + .../tests/match-exception/nested_handlers.ml | 48 + .../match-exception/nested_handlers.reference | 1 + .../raise_from_success_continuation.ml | 18 + .../raise_from_success_continuation.reference | 2 + testsuite/tests/match-exception/streams.ml | 40 + .../tests/match-exception/streams.reference | 1 + testsuite/tests/match-exception/tail_calls.ml | 24 + .../match-exception/tail_calls.reference | 1 + testsuite/tests/messages/precise_locations.ml | 111 + testsuite/tests/misc-kb/equations.ml | 100 + testsuite/tests/misc-kb/equations.mli | 18 + testsuite/tests/misc-kb/kb.ml | 173 + testsuite/tests/misc-kb/kb.mli | 17 + testsuite/tests/misc-kb/kbmain.ml | 71 + testsuite/tests/misc-kb/kbmain.reference | 273 + testsuite/tests/misc-kb/orderings.ml | 84 + testsuite/tests/misc-kb/orderings.mli | 17 + testsuite/tests/misc-kb/terms.ml | 121 + testsuite/tests/misc-kb/terms.mli | 17 + testsuite/tests/misc-unsafe/almabench.ml | 331 + .../tests/misc-unsafe/almabench.reference | 8 + testsuite/tests/misc-unsafe/fft.ml | 178 + testsuite/tests/misc-unsafe/fft.reference | 15 + testsuite/tests/misc-unsafe/quicksort.ml | 82 + .../tests/misc-unsafe/quicksort.reference | 2 + testsuite/tests/misc-unsafe/soli.ml | 100 + testsuite/tests/misc-unsafe/soli.reference | 50 + testsuite/tests/misc/bdd.ml | 220 + testsuite/tests/misc/bdd.reference | 1 + testsuite/tests/misc/boyer.ml | 881 + testsuite/tests/misc/boyer.reference | 1 + testsuite/tests/misc/ephetest.ml | 171 + testsuite/tests/misc/ephetest.reference | 29 + testsuite/tests/misc/ephetest2.ml | 153 + testsuite/tests/misc/ephetest2.reference | 5 + testsuite/tests/misc/ephetest3.ml | 124 + testsuite/tests/misc/ephetest3.reference | 18 + testsuite/tests/misc/exotic.ml | 59 + testsuite/tests/misc/fib.ml | 12 + testsuite/tests/misc/fib.reference | 1 + testsuite/tests/misc/finaliser.ml | 69 + testsuite/tests/misc/finaliser.reference | 0 testsuite/tests/misc/gcwords.ml | 29 + testsuite/tests/misc/gcwords.reference | 1 + testsuite/tests/misc/gpr1370.ml | 22 + testsuite/tests/misc/gpr1370.reference | 0 testsuite/tests/misc/hamming.ml | 94 + testsuite/tests/misc/hamming.reference | 100 + testsuite/tests/misc/nucleic.ml | 3226 ++ testsuite/tests/misc/nucleic.reference | 1 + testsuite/tests/misc/pr7168.ml | 80 + testsuite/tests/misc/pr7168.reference | 1 + testsuite/tests/misc/sieve.ml | 45 + testsuite/tests/misc/sieve.reference | 1 + testsuite/tests/misc/sorts.ml | 4455 ++ testsuite/tests/misc/sorts.reference | 198 + testsuite/tests/misc/takc.ml | 11 + testsuite/tests/misc/takc.reference | 1 + testsuite/tests/misc/taku.ml | 11 + testsuite/tests/misc/taku.reference | 1 + testsuite/tests/misc/weaklifetime.ml | 65 + testsuite/tests/misc/weaklifetime.reference | 0 testsuite/tests/misc/weaklifetime2.ml | 60 + testsuite/tests/misc/weaklifetime2.reference | 2 + testsuite/tests/misc/weaktest.ml | 70 + testsuite/tests/misc/weaktest.reference | 1 + testsuite/tests/no-alias-deps/a2235.ml | 1 + .../no-alias-deps/aliases.compilers.reference | 9 + testsuite/tests/no-alias-deps/aliases.ml | 21 + .../tests/no-alias-deps/aliases.reference | 15 + testsuite/tests/no-alias-deps/b.cmi.invalid | 1 + testsuite/tests/no-alias-deps/c.mli | 1 + testsuite/tests/no-alias-deps/d.mli | 1 + testsuite/tests/no-alias-deps/gpr2235.ml | 21 + testsuite/tests/no-alias-deps/lib2235.ml | 1 + testsuite/tests/no-alias-deps/lib__2235.ml | 1 + .../tests/no-alias-deps/user_of_lib2235.ml | 3 + testsuite/tests/opaque/fst/opaque_impl.ml | 2 + testsuite/tests/opaque/fst/opaque_intf.ml | 2 + testsuite/tests/opaque/fst/regular.ml | 2 + testsuite/tests/opaque/intf/opaque_impl.mli | 2 + testsuite/tests/opaque/intf/opaque_intf.mli | 2 + testsuite/tests/opaque/intf/regular.mli | 2 + testsuite/tests/opaque/snd/opaque_impl.ml | 2 + testsuite/tests/opaque/snd/opaque_intf.ml | 2 + testsuite/tests/opaque/snd/regular.ml | 2 + testsuite/tests/opaque/test.ml | 71 + .../tests/output-complete-obj/github9344.ml | 14 + .../output-complete-obj/github9344.reference | 1 + .../tests/output-complete-obj/github9344.sh | 3 + testsuite/tests/output-complete-obj/puts.c | 9 + testsuite/tests/output-complete-obj/test.ml | 33 + .../tests/output-complete-obj/test.ml_stub.c | 10 + testsuite/tests/output-complete-obj/test2.ml | 23 + .../tests/output-complete-obj/test2.reference | 2 + .../escape_error.compilers.reference | 13 + testsuite/tests/parse-errors/escape_error.ml | 12 + .../expecting.compilers.reference | 33 + testsuite/tests/parse-errors/expecting.ml | 35 + .../parse-errors/pr7847.compilers.reference | 4 + testsuite/tests/parse-errors/pr7847.ml | 10 + ...closed_class_signature.compilers.reference | 6 + .../parse-errors/unclosed_class_signature.mli | 10 + ...osed_class_simpl_expr1.compilers.reference | 6 + .../unclosed_class_simpl_expr1.ml | 9 + ...osed_class_simpl_expr2.compilers.reference | 6 + .../unclosed_class_simpl_expr2.ml | 8 + ...osed_class_simpl_expr3.compilers.reference | 6 + .../unclosed_class_simpl_expr3.ml | 8 + .../unclosed_object.compilers.reference | 6 + .../tests/parse-errors/unclosed_object.ml | 10 + ...sed_paren_module_expr1.compilers.reference | 6 + .../unclosed_paren_module_expr1.ml | 8 + ...sed_paren_module_expr2.compilers.reference | 6 + .../unclosed_paren_module_expr2.ml | 8 + ...sed_paren_module_expr3.compilers.reference | 6 + .../unclosed_paren_module_expr3.ml | 8 + ...sed_paren_module_expr4.compilers.reference | 6 + .../unclosed_paren_module_expr4.ml | 8 + ...sed_paren_module_expr5.compilers.reference | 6 + .../unclosed_paren_module_expr5.ml | 8 + ...osed_paren_module_type.compilers.reference | 6 + .../unclosed_paren_module_type.mli | 8 + .../unclosed_sig.compilers.reference | 6 + testsuite/tests/parse-errors/unclosed_sig.mli | 9 + .../unclosed_simple_expr.compilers.reference | 186 + .../parse-errors/unclosed_simple_expr.ml | 49 + ...nclosed_simple_pattern.compilers.reference | 53 + .../parse-errors/unclosed_simple_pattern.ml | 37 + .../unclosed_struct.compilers.reference | 6 + .../tests/parse-errors/unclosed_struct.ml | 9 + testsuite/tests/parsetree/source.ml | 7374 +++ testsuite/tests/parsetree/test.ml | 106 + testsuite/tests/parsetree/test.reference | 0 ...nymous_class_parameter.compilers.reference | 1 + .../parsing/anonymous_class_parameter.ml | 15 + .../arrow_ambiguity.compilers.reference | 2 + testsuite/tests/parsing/arrow_ambiguity.ml | 28 + .../parsing/attributes.compilers.reference | 207 + testsuite/tests/parsing/attributes.ml | 47 + .../broken_invariants.compilers.reference | 25 + testsuite/tests/parsing/broken_invariants.ml | 17 + testsuite/tests/parsing/change_start_loc.ml | 32 + .../tests/parsing/change_start_loc.reference | 6 + ...nstructor_declarations.compilers.reference | 4 + .../tests/parsing/constructor_declarations.ml | 25 + testsuite/tests/parsing/docstrings.ml | 670 + .../tests/parsing/extended_indexoperators.ml | 94 + .../parsing/extensions.compilers.reference | 328 + testsuite/tests/parsing/extensions.ml | 25 + .../hash_ambiguity.compilers.reference | 113 + testsuite/tests/parsing/hash_ambiguity.ml | 17 + testsuite/tests/parsing/illegal_ppx.ml | 38 + ...nd_float_with_modifier.compilers.reference | 88 + .../parsing/int_and_float_with_modifier.ml | 22 + testsuite/tests/parsing/multi_indices.ml | 170 + .../tests/parsing/pr6604.compilers.reference | 4 + testsuite/tests/parsing/pr6604.ml | 9 + .../parsing/pr6604_2.compilers.reference | 4 + testsuite/tests/parsing/pr6604_2.ml | 9 + .../parsing/pr6604_3.compilers.reference | 2 + testsuite/tests/parsing/pr6604_3.ml | 11 + .../tests/parsing/pr6865.compilers.reference | 54 + testsuite/tests/parsing/pr6865.ml | 11 + .../tests/parsing/pr7165.compilers.reference | 4 + testsuite/tests/parsing/pr7165.ml | 12 + .../quotedextensions.compilers.reference | 115 + testsuite/tests/parsing/quotedextensions.ml | 42 + testsuite/tests/parsing/reloc.ml | 25 + .../shortcut_ext_attr.compilers.reference | 988 + testsuite/tests/parsing/shortcut_ext_attr.ml | 120 + testsuite/tests/ppx-attributes/warning.ml | 51 + .../tests/ppx-attributes/warning.reference | 0 testsuite/tests/ppx-contexts/myppx.ml | 41 + .../ppx-contexts/test.compilers.reference | 22 + testsuite/tests/ppx-contexts/test.ml | 27 + .../tests/prim-bigstring/bigstring_access.ml | 121 + .../prim-bigstring/bigstring_access.reference | 6 + .../tests/prim-bigstring/string_access.ml | 108 + .../prim-bigstring/string_access.reference | 6 + testsuite/tests/prim-bswap/bswap.ml | 20 + testsuite/tests/prim-bswap/bswap.reference | 6 + testsuite/tests/prim-revapply/apply.ml | 39 + testsuite/tests/prim-revapply/apply.reference | 10 + testsuite/tests/prim-revapply/revapply.ml | 21 + .../tests/prim-revapply/revapply.reference | 5 + .../tests/printing-types/disambiguation.ml | 42 + testsuite/tests/printing-types/pr248.ml | 17 + .../printing-types/pr248.ocaml.reference | 9 + testsuite/tests/raise-counts/a.ml | 12 + testsuite/tests/raise-counts/b.ml | 1 + testsuite/tests/raise-counts/main.ml | 9 + testsuite/tests/raise-counts/main.reference | 1 + testsuite/tests/regression/gpr1623/gpr1623.ml | 15 + .../regression/gpr1623/gpr1623.reference | 0 .../regression/missing_set_of_closures/a.ml | 9 + .../regression/missing_set_of_closures/b.ml | 4 + .../regression/missing_set_of_closures/b2.ml | 2 + .../missing_set_of_closures/dir/c.ml | 2 + .../missing_set_of_closures.ml | 22 + testsuite/tests/regression/pr1580/pr1580.ml | 56 + .../tests/regression/pr1580/pr1580.reference | 18 + .../tests/regression/pr3612/custom_finalize.c | 66 + testsuite/tests/regression/pr3612/pr3612.ml | 25 + .../tests/regression/pr3612/pr3612.reference | 1 + testsuite/tests/regression/pr5233/pr5233.ml | 55 + .../tests/regression/pr5233/pr5233.reference | 2 + testsuite/tests/regression/pr5757/pr5757.ml | 7 + .../tests/regression/pr5757/pr5757.reference | 1 + testsuite/tests/regression/pr6024/pr6024.ml | 3 + .../tests/regression/pr6024/pr6024.reference | 1 + testsuite/tests/regression/pr7042/pr7042.ml | 6 + .../tests/regression/pr7042/pr7042.reference | 1 + testsuite/tests/regression/pr7426/pr7426.ml | 3 + .../tests/regression/pr7426/pr7426.reference | 0 testsuite/tests/regression/pr7718/pr7718.ml | 37 + .../tests/regression/pr7718/pr7718.reference | 1 + testsuite/tests/regression/pr7798/pr7798.ml | 57 + .../tests/regression/pr7798/pr7798.reference | 1 + testsuite/tests/regression/pr7920/pr7920.ml | 11 + .../tests/regression/pr7920/pr7920.reference | 0 testsuite/tests/regression/pr8769/fortuna.ml | 0 .../tests/regression/pr8769/nocrypto.mli | 3 + testsuite/tests/regression/pr8769/pr8769.ml | 32 + testsuite/tests/regression/pr8769/rng.ml | 1 + testsuite/tests/regression/pr9028/pr9028.ml | 10 + .../tests/regression/pr9028/pr9028.reference | 4 + testsuite/tests/regression/pr9292/pr9292.ml | 6 + testsuite/tests/regression/pr9443/pr9443.ml | 11 + .../reproducibility/cmis_on_file_system.ml | 26 + .../cmis_on_file_system_companion.mli | 0 testsuite/tests/required-external/file.ml | 7 + testsuite/tests/required-external/main.ml | 41 + .../tests/required-external/main.reference | 1 + .../tests/runtime-C-exceptions/stub_test.c | 20 + testsuite/tests/runtime-C-exceptions/test.ml | 15 + .../tests/runtime-C-exceptions/test.reference | 2 + .../has-stackoverflow-detection.sh | 8 + .../tests/runtime-errors/stackoverflow.ml | 50 + .../stackoverflow.native.reference | 8 + .../runtime-errors/stackoverflow.reference | 8 + .../tests/runtime-errors/stackoverflow.run | 16 + testsuite/tests/runtime-errors/syserror.ml | 31 + .../runtime-errors/syserror.unix.reference | 1 + .../runtime-errors/syserror.win32.reference | 1 + testsuite/tests/runtime-objects/Tests.ml | 37 + .../tests/self-contained-toplevel/foo.ml | 1 + .../self-contained-toplevel/gen_cached_cmi.ml | 7 + .../tests/self-contained-toplevel/input.ml | 1 + .../tests/self-contained-toplevel/main.ml | 40 + .../self-contained-toplevel/main.reference | 1 + testsuite/tests/shadow_include/artificial.ml | 70 + .../cannot_shadow_error.compilers.reference | 8 + .../shadow_include/cannot_shadow_error.ml | 25 + testsuite/tests/shadow_include/shadow_all.ml | 477 + .../tests/statmemprof/arrays_in_major.ml | 148 + .../statmemprof/arrays_in_major.reference | 11 + .../tests/statmemprof/arrays_in_minor.ml | 162 + .../statmemprof/arrays_in_minor.reference | 11 + .../tests/statmemprof/blocking_in_callback.ml | 69 + .../callstacks.flat-float-array.reference | 74 + testsuite/tests/statmemprof/callstacks.ml | 100 + .../callstacks.no-flat-float-array.reference | 70 + .../statmemprof/comballoc.byte.reference | 49 + testsuite/tests/statmemprof/comballoc.ml | 92 + .../tests/statmemprof/comballoc.opt.reference | 49 + .../tests/statmemprof/exception_callback.ml | 23 + .../statmemprof/exception_callback.reference | 1 + .../statmemprof/exception_callback_minor.ml | 20 + .../exception_callback_minor.reference | 1 + testsuite/tests/statmemprof/intern.ml | 173 + testsuite/tests/statmemprof/intern.reference | 10 + testsuite/tests/statmemprof/lists_in_minor.ml | 60 + .../statmemprof/lists_in_minor.reference | 8 + .../tests/statmemprof/minor_no_postpone.ml | 36 + .../statmemprof/minor_no_postpone_stub.c | 5 + .../statmemprof/thread_exit_in_callback.ml | 18 + .../thread_exit_in_callback.reference | 1 + .../thread_exit_in_callback_stub.c | 16 + testsuite/tests/tool-caml-tex/ellipses.input | 48 + testsuite/tests/tool-caml-tex/ellipses.ml | 12 + .../tests/tool-caml-tex/ellipses.reference | 48 + .../tests/tool-caml-tex/redirections.input | 10 + testsuite/tests/tool-caml-tex/redirections.ml | 17 + .../tool-caml-tex/redirections.reference | 39 + .../test.compilers.reference | 1 + testsuite/tests/tool-command-line/test.ml | 31 + .../tests/tool-command-line/unknown-file | 0 .../tests/tool-debugger/basic/debuggee.ml | 15 + .../tool-debugger/basic/debuggee.reference | 4 + .../tests/tool-debugger/basic/input_script | 5 + .../dynlink/host.debug.reference | 11 + testsuite/tests/tool-debugger/dynlink/host.ml | 35 + .../tool-debugger/dynlink/host.reference | 2 + .../tests/tool-debugger/dynlink/input_script | 5 + .../tests/tool-debugger/dynlink/plugin.ml | 4 + .../tool-debugger/find-artifacts/debuggee.ml | 25 + .../find-artifacts/debuggee.reference | 5 + .../tool-debugger/find-artifacts/in/blah.ml | 3 + .../tool-debugger/find-artifacts/in/foo.ml | 13 + .../tool-debugger/find-artifacts/input_script | 5 + .../tests/tool-debugger/no_debug_event/a.ml | 1 + .../tests/tool-debugger/no_debug_event/b.ml | 3 + .../tool-debugger/no_debug_event/input_script | 2 + .../tool-debugger/no_debug_event/noev.ml | 28 + .../no_debug_event/noev.reference | 3 + .../tests/tool-debugger/printer/debuggee.ml | 22 + .../tool-debugger/printer/debuggee.reference | 5 + .../tests/tool-debugger/printer/input_script | 7 + .../tests/tool-debugger/printer/printer.ml | 8 + .../tests/tool-expect-test/clean_typer.ml | 82 + testsuite/tests/tool-lexyacc/chars.mll | 17 + testsuite/tests/tool-lexyacc/gram_aux.ml | 32 + testsuite/tests/tool-lexyacc/grammar.mly | 110 + testsuite/tests/tool-lexyacc/input | 134 + testsuite/tests/tool-lexyacc/lexgen.ml | 256 + .../tool-lexyacc/main.compilers.reference | 1 + testsuite/tests/tool-lexyacc/main.ml | 115 + testsuite/tests/tool-lexyacc/main.reference | 312 + testsuite/tests/tool-lexyacc/mpr7760.mll | 13 + .../tests/tool-lexyacc/mpr7760.reference | 1 + testsuite/tests/tool-lexyacc/output.ml | 152 + testsuite/tests/tool-lexyacc/scan_aux.ml | 45 + testsuite/tests/tool-lexyacc/scanner.mll | 118 + testsuite/tests/tool-lexyacc/syntax.ml | 26 + .../tests/tool-ocaml-annot/check-annot.sh | 7 + testsuite/tests/tool-ocaml-annot/failure.ml | 19 + testsuite/tests/tool-ocaml-annot/success.ml | 18 + testsuite/tests/tool-ocaml-annot/typeonly.ml | 18 + testsuite/tests/tool-ocaml/t000.ml | 15 + testsuite/tests/tool-ocaml/t010-const0.ml | 16 + testsuite/tests/tool-ocaml/t010-const1.ml | 16 + testsuite/tests/tool-ocaml/t010-const2.ml | 16 + testsuite/tests/tool-ocaml/t010-const3.ml | 16 + testsuite/tests/tool-ocaml/t011-constint.ml | 16 + testsuite/tests/tool-ocaml/t020.ml | 18 + testsuite/tests/tool-ocaml/t021-pushconst1.ml | 18 + testsuite/tests/tool-ocaml/t021-pushconst2.ml | 18 + testsuite/tests/tool-ocaml/t021-pushconst3.ml | 18 + .../tests/tool-ocaml/t022-pushconstint.ml | 18 + testsuite/tests/tool-ocaml/t040-makeblock1.ml | 21 + testsuite/tests/tool-ocaml/t040-makeblock2.ml | 23 + testsuite/tests/tool-ocaml/t040-makeblock3.ml | 25 + testsuite/tests/tool-ocaml/t041-makeblock.ml | 27 + testsuite/tests/tool-ocaml/t050-getglobal.ml | 16 + .../tests/tool-ocaml/t050-pushgetglobal.ml | 18 + .../tests/tool-ocaml/t051-getglobalfield.ml | 21 + .../tool-ocaml/t051-pushgetglobalfield.ml | 23 + testsuite/tests/tool-ocaml/t060-raise.ml | 24 + testsuite/tests/tool-ocaml/t070-branch.ml | 28 + testsuite/tests/tool-ocaml/t070-branchif.ml | 28 + .../tests/tool-ocaml/t070-branchifnot.ml | 26 + testsuite/tests/tool-ocaml/t071-boolnot.ml | 27 + testsuite/tests/tool-ocaml/t080-eq.ml | 29 + testsuite/tests/tool-ocaml/t080-geint.ml | 29 + testsuite/tests/tool-ocaml/t080-gtint.ml | 28 + testsuite/tests/tool-ocaml/t080-leint.ml | 29 + testsuite/tests/tool-ocaml/t080-ltint.ml | 28 + testsuite/tests/tool-ocaml/t080-neq.ml | 28 + testsuite/tests/tool-ocaml/t090-acc0.ml | 33 + testsuite/tests/tool-ocaml/t090-acc1.ml | 35 + testsuite/tests/tool-ocaml/t090-acc2.ml | 37 + testsuite/tests/tool-ocaml/t090-acc3.ml | 39 + testsuite/tests/tool-ocaml/t090-acc4.ml | 41 + testsuite/tests/tool-ocaml/t090-acc5.ml | 43 + testsuite/tests/tool-ocaml/t090-acc6.ml | 45 + testsuite/tests/tool-ocaml/t090-acc7.ml | 47 + testsuite/tests/tool-ocaml/t091-acc.ml | 49 + testsuite/tests/tool-ocaml/t092-pushacc.ml | 46 + testsuite/tests/tool-ocaml/t092-pushacc0.ml | 30 + testsuite/tests/tool-ocaml/t092-pushacc1.ml | 32 + testsuite/tests/tool-ocaml/t092-pushacc2.ml | 34 + testsuite/tests/tool-ocaml/t092-pushacc3.ml | 36 + testsuite/tests/tool-ocaml/t092-pushacc4.ml | 38 + testsuite/tests/tool-ocaml/t092-pushacc5.ml | 40 + testsuite/tests/tool-ocaml/t092-pushacc6.ml | 42 + testsuite/tests/tool-ocaml/t092-pushacc7.ml | 44 + testsuite/tests/tool-ocaml/t093-pushacc.ml | 46 + testsuite/tests/tool-ocaml/t100-pushtrap.ml | 29 + testsuite/tests/tool-ocaml/t101-poptrap.ml | 29 + testsuite/tests/tool-ocaml/t110-addint.ml | 34 + testsuite/tests/tool-ocaml/t110-andint.ml | 30 + testsuite/tests/tool-ocaml/t110-asrint-1.ml | 30 + testsuite/tests/tool-ocaml/t110-asrint-2.ml | 30 + testsuite/tests/tool-ocaml/t110-divint-1.ml | 30 + testsuite/tests/tool-ocaml/t110-divint-2.ml | 30 + testsuite/tests/tool-ocaml/t110-divint-3.ml | 41 + testsuite/tests/tool-ocaml/t110-lslint.ml | 30 + testsuite/tests/tool-ocaml/t110-lsrint.ml | 30 + testsuite/tests/tool-ocaml/t110-modint-1.ml | 30 + testsuite/tests/tool-ocaml/t110-modint-2.ml | 42 + testsuite/tests/tool-ocaml/t110-mulint.ml | 30 + testsuite/tests/tool-ocaml/t110-negint.ml | 33 + testsuite/tests/tool-ocaml/t110-offsetint.ml | 29 + testsuite/tests/tool-ocaml/t110-orint.ml | 30 + testsuite/tests/tool-ocaml/t110-subint.ml | 34 + testsuite/tests/tool-ocaml/t110-xorint.ml | 30 + .../tests/tool-ocaml/t120-getstringchar.ml | 30 + .../tests/tool-ocaml/t121-setstringchar.ml | 39 + .../tests/tool-ocaml/t130-getvectitem.ml | 32 + testsuite/tests/tool-ocaml/t130-vectlength.ml | 31 + .../tests/tool-ocaml/t131-setvectitem.ml | 41 + testsuite/tests/tool-ocaml/t140-switch-1.ml | 40 + testsuite/tests/tool-ocaml/t140-switch-2.ml | 40 + testsuite/tests/tool-ocaml/t140-switch-3.ml | 39 + testsuite/tests/tool-ocaml/t140-switch-4.ml | 39 + testsuite/tests/tool-ocaml/t141-switch-5.ml | 46 + testsuite/tests/tool-ocaml/t141-switch-6.ml | 46 + testsuite/tests/tool-ocaml/t141-switch-7.ml | 45 + testsuite/tests/tool-ocaml/t142-switch-8.ml | 42 + testsuite/tests/tool-ocaml/t142-switch-9.ml | 42 + testsuite/tests/tool-ocaml/t142-switch-A.ml | 42 + testsuite/tests/tool-ocaml/t150-push-1.ml | 32 + testsuite/tests/tool-ocaml/t150-push-2.ml | 47 + testsuite/tests/tool-ocaml/t160-closure.ml | 27 + testsuite/tests/tool-ocaml/t161-apply1.ml | 50 + testsuite/tests/tool-ocaml/t162-return.ml | 29 + testsuite/tests/tool-ocaml/t163.ml | 31 + testsuite/tests/tool-ocaml/t164-apply2.ml | 32 + testsuite/tests/tool-ocaml/t164-apply3.ml | 33 + testsuite/tests/tool-ocaml/t165-apply.ml | 36 + testsuite/tests/tool-ocaml/t170-envacc2.ml | 45 + testsuite/tests/tool-ocaml/t170-envacc3.ml | 50 + testsuite/tests/tool-ocaml/t170-envacc4.ml | 55 + testsuite/tests/tool-ocaml/t171-envacc.ml | 60 + .../tests/tool-ocaml/t172-pushenvacc1.ml | 42 + .../tests/tool-ocaml/t172-pushenvacc2.ml | 45 + .../tests/tool-ocaml/t172-pushenvacc3.ml | 50 + .../tests/tool-ocaml/t172-pushenvacc4.ml | 55 + testsuite/tests/tool-ocaml/t173-pushenvacc.ml | 60 + testsuite/tests/tool-ocaml/t180-appterm1.ml | 43 + testsuite/tests/tool-ocaml/t180-appterm2.ml | 46 + testsuite/tests/tool-ocaml/t180-appterm3.ml | 47 + testsuite/tests/tool-ocaml/t181-appterm.ml | 48 + .../tests/tool-ocaml/t190-makefloatblock-1.ml | 25 + .../tests/tool-ocaml/t190-makefloatblock-2.ml | 26 + .../tests/tool-ocaml/t190-makefloatblock-3.ml | 27 + testsuite/tests/tool-ocaml/t191-vectlength.ml | 34 + .../tests/tool-ocaml/t192-getfloatfield-1.ml | 31 + .../tests/tool-ocaml/t192-getfloatfield-2.ml | 31 + .../tests/tool-ocaml/t193-setfloatfield-1.ml | 44 + .../tests/tool-ocaml/t193-setfloatfield-2.ml | 44 + testsuite/tests/tool-ocaml/t200-getfield0.ml | 33 + testsuite/tests/tool-ocaml/t200-getfield1.ml | 34 + testsuite/tests/tool-ocaml/t200-getfield2.ml | 35 + testsuite/tests/tool-ocaml/t200-getfield3.ml | 36 + testsuite/tests/tool-ocaml/t201-getfield.ml | 37 + testsuite/tests/tool-ocaml/t210-setfield0.ml | 44 + testsuite/tests/tool-ocaml/t210-setfield1.ml | 46 + testsuite/tests/tool-ocaml/t210-setfield2.ml | 48 + testsuite/tests/tool-ocaml/t210-setfield3.ml | 50 + testsuite/tests/tool-ocaml/t211-setfield.ml | 52 + testsuite/tests/tool-ocaml/t220-assign.ml | 35 + .../tests/tool-ocaml/t230-check_signals.ml | 36 + testsuite/tests/tool-ocaml/t240-c_call1.ml | 35 + testsuite/tests/tool-ocaml/t240-c_call2.ml | 30 + testsuite/tests/tool-ocaml/t240-c_call3.ml | 31 + testsuite/tests/tool-ocaml/t240-c_call4.ml | 40 + testsuite/tests/tool-ocaml/t240-c_call5.ml | 41 + .../tests/tool-ocaml/t250-closurerec-1.ml | 27 + .../tests/tool-ocaml/t250-closurerec-2.ml | 37 + .../tool-ocaml/t251-pushoffsetclosure0.ml | 47 + .../tool-ocaml/t251-pushoffsetclosure2.ml | 42 + .../tool-ocaml/t251-pushoffsetclosurem2.ml | 42 + .../tool-ocaml/t252-pushoffsetclosure.ml | 46 + .../tests/tool-ocaml/t253-offsetclosure0.ml | 42 + .../tests/tool-ocaml/t253-offsetclosure2.ml | 42 + .../tests/tool-ocaml/t253-offsetclosurem2.ml | 42 + .../tests/tool-ocaml/t254-offsetclosure.ml | 45 + testsuite/tests/tool-ocaml/t260-offsetref.ml | 39 + .../tests/tool-ocaml/t270-push_retaddr.ml | 44 + testsuite/tests/tool-ocaml/t300-getmethod.ml | 5893 ++ testsuite/tests/tool-ocaml/t301-object.ml | 33 + testsuite/tests/tool-ocaml/t310-alloc-1.ml | 1595 + testsuite/tests/tool-ocaml/t310-alloc-2.ml | 2321 + testsuite/tests/tool-ocaml/t320-gc-1.ml | 1597 + testsuite/tests/tool-ocaml/t320-gc-2.ml | 1597 + testsuite/tests/tool-ocaml/t320-gc-3.ml | 1597 + testsuite/tests/tool-ocaml/t330-compact-1.ml | 23 + testsuite/tests/tool-ocaml/t330-compact-2.ml | 763 + testsuite/tests/tool-ocaml/t330-compact-3.ml | 1597 + testsuite/tests/tool-ocaml/t330-compact-4.ml | 1597 + testsuite/tests/tool-ocaml/t340-weak.ml | 32 + testsuite/tests/tool-ocaml/t350-heapcheck.ml | 33 + testsuite/tests/tool-ocaml/t360-stacks-1.ml | 51 + testsuite/tests/tool-ocaml/t360-stacks-2.ml | 62 + .../compat32.compilers.reference | 6 + .../tests/tool-ocamlc-compat32/compat32.ml | 29 + .../check-error-cleanup.sh | 6 + .../tests/tool-ocamlc-error-cleanup/test.ml | 16 + testsuite/tests/tool-ocamlc-open/a.ml | 3 + testsuite/tests/tool-ocamlc-open/b.ml | 1 + ...tool-ocamlc-open-error.compilers.reference | 4 + .../tool-ocamlc-open-error.ml | 7 + .../tool-ocamlc-open/tool-ocamlc-open.ml | 10 + ...top_after_parsing_impl.compilers.reference | 36 + .../stop_after_parsing_impl.ml | 12 + ...top_after_parsing_intf.compilers.reference | 10 + .../stop_after_parsing_intf.mli | 12 + .../stop_after_scheduling.compilers.reference | 1 + .../stop_after_scheduling.ml | 14 + .../stop_after_scheduling.sh | 3 + ...stop_after_typing_impl.compilers.reference | 18 + .../stop_after_typing_impl.ml | 13 + testsuite/tests/tool-ocamldep-modalias/A.ml | 1 + testsuite/tests/tool-ocamldep-modalias/B.ml | 2 + testsuite/tests/tool-ocamldep-modalias/C.ml | 2 + testsuite/tests/tool-ocamldep-modalias/D.ml | 1 + .../tool-ocamldep-modalias/Makefile.build | 77 + .../tool-ocamldep-modalias/Makefile.build2 | 65 + .../depend.mk.reference | 27 + .../depend.mk2.reference | 22 + .../depend.mod.reference | 6 + .../depend.mod2.reference | 4 + .../depend.mod3.reference | 4 + .../tests/tool-ocamldep-modalias/lib.mli | 8 + .../tests/tool-ocamldep-modalias/lib_impl.ml | 8 + .../tests/tool-ocamldep-modalias/main.ml | 86 + .../tool-ocamldep-modalias/setup-links.sh | 2 + testsuite/tests/tool-ocamldep-shadowing/a.ml | 13 + .../tests/tool-ocamldep-shadowing/a.reference | 6 + .../tests/tool-ocamldep-shadowing/dir1/b.ml | 0 .../tests/tool-ocamldep-shadowing/dir2/b.mli | 0 .../tests/tool-ocamldep-shadowing/dir2/c.mli | 0 testsuite/tests/tool-ocamldoc-open/Readme | 12 + testsuite/tests/tool-ocamldoc-open/alias.ml | 3 + testsuite/tests/tool-ocamldoc-open/inner.ml | 2 + .../tool-ocamldoc-open/main.latex.reference | 70 + testsuite/tests/tool-ocamldoc-open/main.ml | 11 + .../main.ocamldoc.latex.reference | 3 + .../Documentation_tags.html.reference | 44 + .../tool-ocamldoc/Documentation_tags.mli | 23 + .../Extensible_variant.latex.reference | 125 + .../tests/tool-ocamldoc/Extensible_variant.ml | 29 + ...xtensible_variant.ocamldoc.latex.reference | 1 + .../Include_module_type_of.html.reference | 29 + .../Include_module_type_of.latex.reference | 96 + .../tool-ocamldoc/Include_module_type_of.mli | 21 + .../Inline_records.html.reference | 352 + .../Inline_records.latex.reference | 287 + .../Inline_records.man.reference | 238 + .../tests/tool-ocamldoc/Inline_records.mli | 54 + .../Inline_records_bis.latex.reference | 286 + .../tests/tool-ocamldoc/Inline_records_bis.ml | 52 + .../tool-ocamldoc/Item_ids.html.reference | 53 + testsuite/tests/tool-ocamldoc/Item_ids.mli | 16 + .../tool-ocamldoc/Level_0.latex.reference | 36 + testsuite/tests/tool-ocamldoc/Level_0.mli | 19 + .../tool-ocamldoc/Linebreaks.html.reference | 135 + testsuite/tests/tool-ocamldoc/Linebreaks.mli | 75 + .../tests/tool-ocamldoc/Loop.html.reference | 20 + .../tests/tool-ocamldoc/Loop.latex.reference | 36 + testsuite/tests/tool-ocamldoc/Loop.ml | 5 + .../Module_whitespace.html.reference | 24 + .../tests/tool-ocamldoc/Module_whitespace.ml | 8 + .../Module_whitespace.ocamldoc.html.reference | 2 + .../tool-ocamldoc/No_preamble.html.reference | 25 + testsuite/tests/tool-ocamldoc/No_preamble.mli | 8 + .../tool-ocamldoc/Paragraph.html.reference | 75 + testsuite/tests/tool-ocamldoc/Paragraph.mli | 54 + .../Short_description.latex.reference | 26 + .../tests/tool-ocamldoc/Short_description.txt | 8 + .../tests/tool-ocamldoc/Test.latex.reference | 74 + testsuite/tests/tool-ocamldoc/Test.mli | 33 + .../tool-ocamldoc/Variants.html.reference | 282 + .../tool-ocamldoc/Variants.latex.reference | 214 + testsuite/tests/tool-ocamldoc/Variants.mli | 51 + .../tool-ocamldoc/latex_ref.latex.reference | 27 + testsuite/tests/tool-ocamldoc/latex_ref.mli | 11 + testsuite/tests/tool-ocamldoc/odoc_test.ml | 116 + testsuite/tests/tool-ocamldoc/t01.ml | 33 + testsuite/tests/tool-ocamldoc/t01.reference | 51 + testsuite/tests/tool-ocamldoc/t02.ml | 16 + testsuite/tests/tool-ocamldoc/t02.reference | 12 + testsuite/tests/tool-ocamldoc/t03.ml | 18 + .../tool-ocamldoc/t03.ocamldoc.reference | 1 + testsuite/tests/tool-ocamldoc/t03.reference | 14 + testsuite/tests/tool-ocamldoc/t04.ml | 26 + testsuite/tests/tool-ocamldoc/t04.reference | 27 + testsuite/tests/tool-ocamldoc/t05.ml | 7 + testsuite/tests/tool-ocamldoc/t05.reference | 6 + .../tool-ocamldoc/type_Linebreaks.reference | 27 + .../tests/tool-ocamlobjinfo/has-lib-bfd.sh | 7 + testsuite/tests/tool-ocamlobjinfo/question.ml | 15 + .../tool-ocamlobjinfo/question.reference | 10 + .../stop_after_scheduling.ml | 12 + .../stop_after_scheduling.sh | 24 + .../first_arg_fail.txt | 3 + .../first_arg_fail.txt.reference | 1 + .../indirect_first_arg_fail.txt | 2 + .../indirect_first_arg_fail.txt.reference | 1 + .../indirect_last_arg_fail.txt | 2 + .../indirect_last_arg_fail.txt.reference | 1 + .../last_arg_fail.txt | 3 + .../last_arg_fail.txt.reference | 1 + .../tool-toplevel-invocation/print_args.ml | 1 + .../print_args.reference | 3 + .../tests/tool-toplevel-invocation/test.ml | 51 + .../tool-toplevel-invocation/working_arg.txt | 2 + .../working_arg.txt.reference | 3 + .../error_highlighting.compilers.reference | 74 + .../tests/tool-toplevel/error_highlighting.ml | 111 + .../tool-toplevel/error_highlighting_use1.ml | 1 + .../tool-toplevel/error_highlighting_use2.ml | 1 + .../tool-toplevel/error_highlighting_use3.ml | 4 + .../tool-toplevel/error_highlighting_use4.ml | 4 + .../exotic_lists.compilers.reference | 14 + testsuite/tests/tool-toplevel/exotic_lists.ml | 17 + .../known-bugs/broken_rec_in_show.ml | 47 + testsuite/tests/tool-toplevel/mod.ml | 1 + testsuite/tests/tool-toplevel/mod_use.ml | 9 + .../tool-toplevel/pr6468.compilers.reference | 12 + testsuite/tests/tool-toplevel/pr6468.ml | 10 + .../tool-toplevel/pr7060.compilers.reference | 15 + testsuite/tests/tool-toplevel/pr7060.ml | 10 + .../tool-toplevel/pr7751.compilers.reference | 10 + testsuite/tests/tool-toplevel/pr7751.ml | 6 + .../redefinition_hints.compilers.reference | 40 + .../tests/tool-toplevel/redefinition_hints.ml | 40 + testsuite/tests/tool-toplevel/show.ml | 106 + .../tests/tool-toplevel/show_short_paths.ml | 19 + .../tool-toplevel/strings.compilers.reference | 10 + testsuite/tests/tool-toplevel/strings.ml | 19 + .../tool-toplevel/tracing.compilers.reference | 29 + testsuite/tests/tool-toplevel/tracing.ml | 8 + .../tool-toplevel/uncaught_exceptions.ml | 45 + testsuite/tests/tool-toplevel/use_command.ml | 25 + .../array_spec.compilers.flat.reference | 65 + .../array_spec.compilers.no-flat.reference | 65 + testsuite/tests/translprim/array_spec.ml | 76 + .../comparison_table.compilers.reference | 252 + .../tests/translprim/comparison_table.ml | 246 + testsuite/tests/translprim/locs.ml | 44 + testsuite/tests/translprim/locs.reference | 11 + .../module_coercion.compilers.flat.reference | 90 + ...odule_coercion.compilers.no-flat.reference | 90 + testsuite/tests/translprim/module_coercion.ml | 51 + .../translprim/ref_spec.compilers.reference | 37 + testsuite/tests/translprim/ref_spec.ml | 61 + .../tests/typing-core-bugs/const_int_hint.ml | 152 + .../typing-core-bugs/missing_rec_hint.ml | 67 + .../typing-core-bugs/repeated_did_you_mean.ml | 22 + .../type_expected_explanation.ml | 189 + .../tests/typing-core-bugs/unit_fun_hints.ml | 73 + testsuite/tests/typing-deprecated/alerts.ml | 273 + .../tests/typing-deprecated/deprecated.ml | 627 + .../typing-extension-constructor/test.ml | 17 + .../test.ocaml.reference | 11 + testsuite/tests/typing-extensions/cast.ml | 103 + .../typing-extensions/cast.ocaml.reference | 33 + .../tests/typing-extensions/disambiguation.ml | 248 + .../tests/typing-extensions/extensions.ml | 766 + testsuite/tests/typing-extensions/msg.ml | 135 + .../typing-extensions/msg.ocaml.reference | 22 + .../tests/typing-extensions/open_types.ml | 359 + .../tests/typing-fstclassmod/fstclassmod.ml | 171 + .../typing-fstclassmod/fstclassmod.reference | 7 + testsuite/tests/typing-gadts/ambiguity.ml | 267 + testsuite/tests/typing-gadts/didier.ml | 115 + .../tests/typing-gadts/dynamic_frisch.ml | 715 + .../tests/typing-gadts/nested_equations.ml | 92 + testsuite/tests/typing-gadts/omega07.ml | 1218 + testsuite/tests/typing-gadts/or_patterns.ml | 757 + testsuite/tests/typing-gadts/pr5332.ml | 35 + testsuite/tests/typing-gadts/pr5689.ml | 112 + testsuite/tests/typing-gadts/pr5785.ml | 29 + testsuite/tests/typing-gadts/pr5848.ml | 23 + testsuite/tests/typing-gadts/pr5906.ml | 42 + testsuite/tests/typing-gadts/pr5948.ml | 59 + testsuite/tests/typing-gadts/pr5981.ml | 56 + testsuite/tests/typing-gadts/pr5985.ml | 203 + testsuite/tests/typing-gadts/pr5989.ml | 65 + testsuite/tests/typing-gadts/pr5997.ml | 55 + testsuite/tests/typing-gadts/pr6158.ml | 25 + testsuite/tests/typing-gadts/pr6163.ml | 33 + testsuite/tests/typing-gadts/pr6174.ml | 15 + testsuite/tests/typing-gadts/pr6241.ml | 36 + testsuite/tests/typing-gadts/pr6690.ml | 85 + testsuite/tests/typing-gadts/pr6817.ml | 38 + testsuite/tests/typing-gadts/pr6934.ml | 11 + testsuite/tests/typing-gadts/pr6980.ml | 31 + testsuite/tests/typing-gadts/pr6993_bad.ml | 30 + testsuite/tests/typing-gadts/pr7016.ml | 36 + testsuite/tests/typing-gadts/pr7160.ml | 26 + testsuite/tests/typing-gadts/pr7214.ml | 45 + testsuite/tests/typing-gadts/pr7222.ml | 42 + testsuite/tests/typing-gadts/pr7230.ml | 13 + testsuite/tests/typing-gadts/pr7234.ml | 32 + testsuite/tests/typing-gadts/pr7260.ml | 31 + testsuite/tests/typing-gadts/pr7269.ml | 81 + testsuite/tests/typing-gadts/pr7298.ml | 18 + testsuite/tests/typing-gadts/pr7374.ml | 57 + testsuite/tests/typing-gadts/pr7378.ml | 33 + testsuite/tests/typing-gadts/pr7381.ml | 19 + testsuite/tests/typing-gadts/pr7390.ml | 31 + testsuite/tests/typing-gadts/pr7391.ml | 95 + testsuite/tests/typing-gadts/pr7397.ml | 29 + testsuite/tests/typing-gadts/pr7421.ml | 34 + testsuite/tests/typing-gadts/pr7432.ml | 33 + testsuite/tests/typing-gadts/pr7520.ml | 13 + testsuite/tests/typing-gadts/pr7618.ml | 52 + testsuite/tests/typing-gadts/pr7747.ml | 35 + testsuite/tests/typing-gadts/pr9019.ml | 236 + testsuite/tests/typing-gadts/term-conv.ml | 222 + testsuite/tests/typing-gadts/test.ml | 1232 + .../typing-gadts/unexpected_existentials.ml | 158 + testsuite/tests/typing-gadts/unify_mb.ml | 245 + .../tests/typing-gadts/variables_in_mcomp.ml | 26 + testsuite/tests/typing-gadts/yallop_bugs.ml | 85 + testsuite/tests/typing-immediate/immediate.ml | 177 + .../typing-implicit_unpack/implicit_unpack.ml | 503 + testsuite/tests/typing-labels/mixin.ml | 157 + testsuite/tests/typing-labels/mixin.reference | 3 + testsuite/tests/typing-labels/mixin2.ml | 192 + .../tests/typing-labels/mixin2.reference | 3 + testsuite/tests/typing-labels/mixin3.ml | 186 + .../tests/typing-labels/mixin3.reference | 3 + .../typing-misc-bugs/core_array_reduced_ok.ml | 101 + .../gadt_declaration_check.ml | 19 + .../pr6303_bad.compilers.reference | 6 + .../tests/typing-misc-bugs/pr6303_bad.ml | 11 + .../pr6946_bad.compilers.reference | 5 + .../tests/typing-misc-bugs/pr6946_bad.ml | 10 + testsuite/tests/typing-misc/constraints.ml | 141 + .../typing-misc/disambiguate_principality.ml | 518 + testsuite/tests/typing-misc/empty_ppx.ml | 14 + testsuite/tests/typing-misc/empty_variant.ml | 79 + .../tests/typing-misc/enrich_typedecl.ml | 260 + .../tests/typing-misc/exotic_unifications.ml | 29 + testsuite/tests/typing-misc/external_arity.ml | 33 + testsuite/tests/typing-misc/gpr2277.ml | 54 + .../tests/typing-misc/includeclass_errors.ml | 253 + testsuite/tests/typing-misc/inside_out.ml | 123 + testsuite/tests/typing-misc/is_expansive.ml | 12 + testsuite/tests/typing-misc/labels.ml | 121 + testsuite/tests/typing-misc/mapping.ml | 4 + testsuite/tests/typing-misc/occur_check.ml | 26 + .../tests/typing-misc/pat_type_sharing.ml | 17 + testsuite/tests/typing-misc/pattern_open.ml | 249 + testsuite/tests/typing-misc/polyvars.ml | 199 + testsuite/tests/typing-misc/pr6416.ml | 414 + testsuite/tests/typing-misc/pr6634.ml | 30 + .../typing-misc/pr6939-flat-float-array.ml | 24 + .../typing-misc/pr6939-no-flat-float-array.ml | 23 + testsuite/tests/typing-misc/pr7103.ml | 49 + testsuite/tests/typing-misc/pr7228.ml | 21 + testsuite/tests/typing-misc/pr7668_bad.ml | 92 + testsuite/tests/typing-misc/pr7712.ml | 20 + testsuite/tests/typing-misc/pr7937.ml | 84 + testsuite/tests/typing-misc/pr8548.ml | 147 + testsuite/tests/typing-misc/pr8548_split.ml | 20 + testsuite/tests/typing-misc/printing.ml | 101 + testsuite/tests/typing-misc/range.ml | 16 + testsuite/tests/typing-misc/range_intf.ml | 16 + testsuite/tests/typing-misc/ranged.ml | 14 + testsuite/tests/typing-misc/ranged_intf.ml | 4 + testsuite/tests/typing-misc/records.ml | 268 + testsuite/tests/typing-misc/scope_escape.ml | 15 + ...mpty_polyvariant_error.compilers.reference | 6 + .../typecore_empty_polyvariant_error.ml | 13 + .../tests/typing-misc/typecore_errors.ml | 464 + .../typing-misc/typecore_nolabel_errors.ml | 136 + .../tests/typing-misc/typetexp_errors.ml | 33 + .../unique_names_in_unification.ml | 87 + testsuite/tests/typing-misc/variance.ml | 13 + testsuite/tests/typing-misc/variant.ml | 149 + testsuite/tests/typing-misc/wellfounded.ml | 22 + testsuite/tests/typing-missing-cmi-2/bar.mli | 1 + testsuite/tests/typing-missing-cmi-2/baz.ml | 1 + testsuite/tests/typing-missing-cmi-2/foo.mli | 1 + .../test.compilers.reference | 1 + testsuite/tests/typing-missing-cmi-2/test.ml | 15 + .../tests/typing-missing-cmi-3/middle.ml | 5 + .../tests/typing-missing-cmi-3/original.ml | 2 + testsuite/tests/typing-missing-cmi-3/user.ml | 47 + testsuite/tests/typing-missing-cmi/a.ml | 1 + testsuite/tests/typing-missing-cmi/b.ml | 1 + testsuite/tests/typing-missing-cmi/c.ml | 10 + testsuite/tests/typing-missing-cmi/main.ml | 1 + .../typing-missing-cmi/main.ml.reference | 5 + testsuite/tests/typing-missing-cmi/main_ok.ml | 1 + .../tests/typing-missing-cmi/subdir/m.ml | 4 + .../test.compilers.reference | 7 + testsuite/tests/typing-missing-cmi/test.ml | 24 + .../gatien_baron_20131019_ok.ml | 38 + .../tests/typing-modules-bugs/pr5164_ok.ml | 16 + .../tests/typing-modules-bugs/pr51_ok.ml | 25 + .../tests/typing-modules-bugs/pr5663_ok.ml | 14 + .../tests/typing-modules-bugs/pr5914_ok.ml | 25 + .../tests/typing-modules-bugs/pr6240_ok.ml | 18 + .../pr6293_bad.compilers.reference | 12 + .../tests/typing-modules-bugs/pr6293_bad.ml | 10 + .../pr6427_bad.compilers.reference | 5 + .../tests/typing-modules-bugs/pr6427_bad.ml | 28 + .../tests/typing-modules-bugs/pr6485_ok.ml | 53 + .../tests/typing-modules-bugs/pr6513_ok.ml | 35 + .../tests/typing-modules-bugs/pr6572_ok.ml | 26 + .../tests/typing-modules-bugs/pr6651_ok.ml | 20 + .../pr6752_bad.compilers.reference | 6 + .../tests/typing-modules-bugs/pr6752_bad.ml | 54 + .../tests/typing-modules-bugs/pr6752_ok.ml | 52 + .../pr6899_first_bad.compilers.reference | 5 + .../typing-modules-bugs/pr6899_first_bad.ml | 11 + .../tests/typing-modules-bugs/pr6899_ok.ml | 13 + .../pr6899_second_bad.compilers.reference | 5 + .../typing-modules-bugs/pr6899_second_bad.ml | 13 + .../tests/typing-modules-bugs/pr6944_ok.ml | 11 + .../tests/typing-modules-bugs/pr6954_ok.ml | 18 + .../tests/typing-modules-bugs/pr6981_ok.ml | 17 + .../tests/typing-modules-bugs/pr6982_ok.ml | 33 + .../tests/typing-modules-bugs/pr6985_ok.ml | 14 + .../pr6992_bad.compilers.reference | 6 + .../tests/typing-modules-bugs/pr6992_bad.ml | 23 + .../tests/typing-modules-bugs/pr7036_ok.ml | 28 + .../tests/typing-modules-bugs/pr7082_ok.ml | 14 + .../pr7112_bad.compilers.reference | 5 + .../tests/typing-modules-bugs/pr7112_bad.ml | 13 + .../tests/typing-modules-bugs/pr7112_ok.ml | 11 + .../tests/typing-modules-bugs/pr7152_ok.ml | 122 + .../tests/typing-modules-bugs/pr7182_ok.ml | 10 + .../typing-modules-bugs/pr7305_principal.ml | 36 + .../tests/typing-modules-bugs/pr7321_ok.ml | 15 + .../pr7414_2_bad.compilers.reference | 20 + .../tests/typing-modules-bugs/pr7414_2_bad.ml | 50 + .../pr7414_bad.compilers.reference | 20 + .../tests/typing-modules-bugs/pr7414_bad.ml | 63 + .../tests/typing-modules-bugs/pr7519_ok.ml | 25 + .../tests/typing-modules-bugs/pr7601_ok.ml | 30 + .../tests/typing-modules-bugs/pr7601a_ok.ml | 27 + .../pr9695_bad.compilers.reference | 4 + .../tests/typing-modules-bugs/pr9695_bad.ml | 10 + testsuite/tests/typing-modules/.gitattributes | 0 testsuite/tests/typing-modules/Test.ml | 213 + testsuite/tests/typing-modules/aliases.ml | 862 + testsuite/tests/typing-modules/anonymous.ml | 39 + .../applicative_functor_type.ml | 83 + .../extension_constructors_errors_test.ml | 44 + testsuite/tests/typing-modules/firstclass.ml | 51 + testsuite/tests/typing-modules/generative.ml | 98 + .../typing-modules/illegal_permutation.ml | 630 + .../tests/typing-modules/merge_constraint.ml | 248 + testsuite/tests/typing-modules/nondep.ml | 21 + .../typing-modules/nondep_private_abbrev.ml | 137 + .../tests/typing-modules/normalize_path.ml | 17 + testsuite/tests/typing-modules/pr5911.ml | 27 + testsuite/tests/typing-modules/pr6394.ml | 27 + testsuite/tests/typing-modules/pr7207.ml | 13 + testsuite/tests/typing-modules/pr7348.ml | 41 + testsuite/tests/typing-modules/pr7726.ml | 150 + testsuite/tests/typing-modules/pr7787.ml | 45 + testsuite/tests/typing-modules/pr7818.ml | 328 + testsuite/tests/typing-modules/pr7851.ml | 87 + testsuite/tests/typing-modules/pr8810.ml | 7 + testsuite/tests/typing-modules/pr9384.ml | 46 + testsuite/tests/typing-modules/pr9695.ml | 12 + testsuite/tests/typing-modules/printing.ml | 58 + .../typing-modules/records_errors_test.ml | 138 + testsuite/tests/typing-modules/recursive.ml | 13 + .../typing-modules/unroll_private_abbrev.ml | 80 + .../typing-modules/variants_errors_test.ml | 204 + testsuite/tests/typing-multifile/a.ml | 1 + testsuite/tests/typing-multifile/b.ml | 1 + testsuite/tests/typing-multifile/c.ml | 1 + testsuite/tests/typing-multifile/d.mli | 1 + testsuite/tests/typing-multifile/e.ml | 1 + testsuite/tests/typing-multifile/f.ml | 4 + testsuite/tests/typing-multifile/pr6372.ml | 9 + testsuite/tests/typing-multifile/pr7325.ml | 13 + testsuite/tests/typing-multifile/pr7563.ml | 5 + testsuite/tests/typing-multifile/pr9218.ml | 9 + .../pr3968_bad.compilers.reference | 49 + .../tests/typing-objects-bugs/pr3968_bad.ml | 29 + .../pr4018_bad.compilers.reference | 40 + .../tests/typing-objects-bugs/pr4018_bad.ml | 53 + .../pr4435_bad.compilers.reference | 5 + .../tests/typing-objects-bugs/pr4435_bad.ml | 19 + .../tests/typing-objects-bugs/pr4766_ok.ml | 17 + .../tests/typing-objects-bugs/pr4824_ok.ml | 17 + .../pr4824a_bad.compilers.reference | 10 + .../tests/typing-objects-bugs/pr4824a_bad.ml | 14 + .../tests/typing-objects-bugs/pr5156_ok.ml | 17 + .../pr7284_bad.compilers.reference | 6 + .../tests/typing-objects-bugs/pr7284_bad.ml | 41 + .../tests/typing-objects-bugs/pr7293_ok.ml | 18 + .../tests/typing-objects-bugs/woodyatt_ok.ml | 21 + .../typing-objects-bugs/yamagata021012_ok.ml | 200 + testsuite/tests/typing-objects/Exemples.ml | 890 + testsuite/tests/typing-objects/Tests.ml | 920 + .../tests/typing-objects/abstract_rows.ml | 26 + testsuite/tests/typing-objects/dummy.ml | 177 + testsuite/tests/typing-objects/errors.ml | 15 + .../tests/typing-objects/open_in_classes.ml | 30 + testsuite/tests/typing-objects/pr5545.ml | 38 + testsuite/tests/typing-objects/pr5619_bad.ml | 55 + testsuite/tests/typing-objects/pr5858.ml | 16 + testsuite/tests/typing-objects/pr6123_bad.ml | 35 + testsuite/tests/typing-objects/pr6383.ml | 11 + testsuite/tests/typing-objects/pr6907_bad.ml | 23 + testsuite/tests/typing-objects/pr7711_ok.ml | 15 + .../typing-objects/self_cannot_be_closed.ml | 17 + .../self_cannot_escape_pr7865.ml | 21 + .../pervasives_leitmotiv.compilers.reference | 13 + .../typing-ocamlc-i/pervasives_leitmotiv.ml | 14 + .../pr4791.compilers.reference | 12 + testsuite/tests/typing-ocamlc-i/pr4791.ml | 13 + .../pr6323.compilers.reference | 14 + testsuite/tests/typing-ocamlc-i/pr6323.ml | 17 + .../pr7402.compilers.reference | 12 + testsuite/tests/typing-ocamlc-i/pr7402.ml | 19 + .../pr7620_bad.compilers.reference | 6 + testsuite/tests/typing-ocamlc-i/pr7620_bad.ml | 11 + testsuite/tests/typing-poly-bugs/pr5322_ok.ml | 13 + testsuite/tests/typing-poly-bugs/pr5673_ok.ml | 36 + testsuite/tests/typing-poly-bugs/pr6922_ok.ml | 216 + testsuite/tests/typing-poly/error_messages.ml | 133 + testsuite/tests/typing-poly/poly.ml | 1878 + testsuite/tests/typing-poly/pr7636.ml | 37 + testsuite/tests/typing-poly/pr9603.ml | 48 + .../typing-polyvariants-bugs-2/pr3918a.mli | 1 + .../typing-polyvariants-bugs-2/pr3918b.mli | 1 + .../pr3918c.compilers.reference | 6 + .../typing-polyvariants-bugs-2/pr3918c.ml | 25 + .../typing-polyvariants-bugs/pr4775_ok.ml | 18 + .../typing-polyvariants-bugs/pr4933_ok.ml | 22 + .../typing-polyvariants-bugs/pr5057_ok.ml | 21 + .../pr5057a_bad.compilers.reference | 6 + .../typing-polyvariants-bugs/pr5057a_bad.ml | 15 + .../typing-polyvariants-bugs/pr7199_ok.ml | 20 + .../typing-polyvariants-bugs/pr7817_bad.ml | 29 + .../tests/typing-polyvariants-bugs/pr7824.ml | 78 + .../privrowsabate_ok.ml | 60 + .../pr5026_bad.compilers.reference | 5 + .../tests/typing-private-bugs/pr5026_bad.ml | 19 + .../tests/typing-private-bugs/pr5469_ok.ml | 14 + .../private.compilers.principal.reference | 124 + .../private.compilers.reference | 124 + testsuite/tests/typing-private/private.ml | 122 + testsuite/tests/typing-recmod/gpr1626.ml | 16 + testsuite/tests/typing-recmod/pr9494.ml | 38 + .../tests/typing-recmod/pr9494.reference | 1 + .../typing-recmod/t01bad.compilers.reference | 4 + testsuite/tests/typing-recmod/t01bad.ml | 10 + .../typing-recmod/t02bad.compilers.reference | 5 + testsuite/tests/typing-recmod/t02bad.ml | 11 + testsuite/tests/typing-recmod/t03ok.ml | 10 + .../typing-recmod/t04bad.compilers.reference | 5 + testsuite/tests/typing-recmod/t04bad.ml | 10 + .../typing-recmod/t05bad.compilers.reference | 5 + testsuite/tests/typing-recmod/t05bad.ml | 11 + testsuite/tests/typing-recmod/t06ok.ml | 10 + .../typing-recmod/t07bad.compilers.reference | 9 + testsuite/tests/typing-recmod/t07bad.ml | 11 + .../typing-recmod/t08bad.compilers.reference | 11 + testsuite/tests/typing-recmod/t08bad.ml | 12 + .../typing-recmod/t09bad.compilers.reference | 11 + testsuite/tests/typing-recmod/t09bad.ml | 13 + testsuite/tests/typing-recmod/t10ok.ml | 12 + .../typing-recmod/t11bad.compilers.reference | 9 + testsuite/tests/typing-recmod/t11bad.ml | 13 + .../typing-recmod/t12bad.compilers.reference | 17 + testsuite/tests/typing-recmod/t12bad.ml | 21 + testsuite/tests/typing-recmod/t13ok.ml | 12 + .../typing-recmod/t14bad.compilers.reference | 5 + testsuite/tests/typing-recmod/t14bad.ml | 25 + .../typing-recmod/t15bad.compilers.reference | 4 + testsuite/tests/typing-recmod/t15bad.ml | 11 + testsuite/tests/typing-recmod/t16ok.ml | 37 + testsuite/tests/typing-recmod/t17ok.ml | 48 + testsuite/tests/typing-recmod/t18ok.ml | 32 + testsuite/tests/typing-recmod/t20ok.ml | 37 + testsuite/tests/typing-recmod/t21ok.ml | 34 + testsuite/tests/typing-recmod/t22ok.ml | 518 + testsuite/tests/typing-recmod/t22ok.mli | 134 + testsuite/tests/typing-recordarg/recordarg.ml | 96 + .../recordarg.ocaml.reference | 58 + .../pr5343_bad.compilers.reference | 4 + .../tests/typing-rectypes-bugs/pr5343_bad.ml | 21 + .../pr6174_bad.compilers.reference | 5 + .../tests/typing-rectypes-bugs/pr6174_bad.ml | 11 + .../pr6870_bad.compilers.reference | 6 + .../tests/typing-rectypes-bugs/pr6870_bad.ml | 10 + testsuite/tests/typing-safe-linking/a.ml | 3 + .../b_bad.compilers.reference | 10 + testsuite/tests/typing-safe-linking/b_bad.ml | 18 + .../largeFile.ml | 1 + .../redefine_largefile.ml | 4 + .../redefine_largefile.reference | 1 + ...redefine_largefile_top.compilers.reference | 2 + .../redefine_largefile_top.ml | 16 + testsuite/tests/typing-short-paths/errors.ml | 36 + .../gpr1223.compilers.reference | 3 + testsuite/tests/typing-short-paths/gpr1223.ml | 9 + .../tests/typing-short-paths/gpr1223_bar.mli | 12 + .../tests/typing-short-paths/gpr1223_foo.mli | 6 + .../pr5918.compilers.reference | 5 + testsuite/tests/typing-short-paths/pr5918.ml | 12 + .../pr6836.compilers.reference | 6 + testsuite/tests/typing-short-paths/pr6836.ml | 11 + .../pr7543.compilers.reference | 14 + testsuite/tests/typing-short-paths/pr7543.ml | 14 + .../short-paths.compilers.reference | 100 + .../tests/typing-short-paths/short-paths.ml | 62 + testsuite/tests/typing-signatures/els.ml | 99 + .../typing-signatures/els.ocaml.reference | 94 + testsuite/tests/typing-signatures/pr6371.ml | 11 + .../typing-signatures/pr6371.ocaml.reference | 3 + testsuite/tests/typing-signatures/pr6672.ml | 7 + .../typing-signatures/pr6672.ocaml.reference | 9 + testsuite/tests/typing-sigsubst/mpr7852.mli | 12 + .../typing-sigsubst/sig_local_aliases.ml | 123 + ..._aliases_syntax_errors.compilers.reference | 38 + .../sig_local_aliases_syntax_errors.ml | 36 + testsuite/tests/typing-sigsubst/sigsubst.ml | 378 + .../tests/typing-sigsubst/test_functor.ml | 13 + .../test_loc_modtype_type_eq.ml | 3 + .../test_loc_modtype_type_subst.ml | 3 + .../tests/typing-sigsubst/test_loc_type_eq.ml | 1 + .../typing-sigsubst/test_loc_type_subst.ml | 1 + .../test_locations.compilers.reference | 67 + .../tests/typing-sigsubst/test_locations.ml | 26 + testsuite/tests/typing-typeparam/newtype.ml | 36 + .../typing-typeparam/newtype.ocaml.reference | 18 + testsuite/tests/typing-unboxed-types/test.ml | 377 + .../tests/typing-unboxed-types/test_flat.ml | 315 + .../typing-unboxed-types/test_no_flat.ml | 154 + testsuite/tests/typing-unboxed/test.ml | 483 + .../ambiguous_guarded_disjunction.ml | 495 + .../tests/typing-warnings/application.ml | 86 + testsuite/tests/typing-warnings/coercions.ml | 70 + .../tests/typing-warnings/exhaustiveness.ml | 371 + .../tests/typing-warnings/never_returns.ml | 37 + .../tests/typing-warnings/open_warnings.ml | 229 + testsuite/tests/typing-warnings/pr5892.ml | 24 + testsuite/tests/typing-warnings/pr6587.ml | 39 + testsuite/tests/typing-warnings/pr6872.ml | 89 + testsuite/tests/typing-warnings/pr7085.ml | 50 + testsuite/tests/typing-warnings/pr7115.ml | 53 + .../pr7261.compilers.reference | 10 + testsuite/tests/typing-warnings/pr7261.ml | 9 + .../pr7297.compilers.reference | 7 + testsuite/tests/typing-warnings/pr7297.ml | 19 + testsuite/tests/typing-warnings/pr7553.ml | 50 + testsuite/tests/typing-warnings/pr9244.ml | 55 + testsuite/tests/typing-warnings/records.ml | 672 + .../unused_functor_parameter.ml | 33 + testsuite/tests/typing-warnings/unused_rec.ml | 49 + .../tests/typing-warnings/unused_recmodule.ml | 31 + .../tests/typing-warnings/unused_types.ml | 347 + testsuite/tests/unboxed-primitive-args/README | 26 + .../tests/unboxed-primitive-args/common.ml | 286 + .../tests/unboxed-primitive-args/common.mli | 29 + .../tests/unboxed-primitive-args/gen_test.ml | 228 + .../tests/unboxed-primitive-args/test.ml | 22 + .../unboxed-primitive-args/test.reference | 0 .../unboxed-primitive-args/test_common.c | 37 + .../unboxed-primitive-args/test_common.h | 44 + testsuite/tests/unwind/README | 9 + .../tests/unwind/check-linker-version.sh | 16 + testsuite/tests/unwind/driver.ml | 23 + testsuite/tests/unwind/mylib.ml | 20 + testsuite/tests/unwind/mylib.mli | 10 + testsuite/tests/unwind/stack_walker.c | 59 + testsuite/tests/utils/edit_distance.ml | 55 + testsuite/tests/utils/edit_distance.reference | 38 + testsuite/tests/utils/magic_number.ml | 38 + testsuite/tests/utils/overflow_detection.ml | 45 + .../tests/utils/overflow_detection.reference | 149 + .../test_strongly_connected_components.ml | 38 + ...st_strongly_connected_components.reference | 2 + .../deprecated_module.compilers.reference | 8 + testsuite/tests/warnings/deprecated_module.ml | 17 + .../tests/warnings/deprecated_module.mli | 13 + ...cated_module_assigment.compilers.reference | 138 + .../warnings/deprecated_module_assigment.ml | 86 + .../deprecated_module_use.compilers.reference | 24 + .../tests/warnings/deprecated_module_use.ml | 23 + .../tests/warnings/module_without_cmx.mli | 2 + .../tests/warnings/w01.compilers.reference | 27 + testsuite/tests/warnings/w01.ml | 54 + .../tests/warnings/w03.compilers.reference | 8 + testsuite/tests/warnings/w03.ml | 24 + .../tests/warnings/w04.compilers.reference | 6 + testsuite/tests/warnings/w04.ml | 23 + .../warnings/w04_failure.compilers.reference | 21 + testsuite/tests/warnings/w04_failure.ml | 39 + .../tests/warnings/w06.compilers.reference | 8 + testsuite/tests/warnings/w06.ml | 17 + .../tests/warnings/w32.compilers.reference | 83 + testsuite/tests/warnings/w32.ml | 67 + testsuite/tests/warnings/w32.mli | 16 + .../tests/warnings/w32b.compilers.reference | 8 + testsuite/tests/warnings/w32b.ml | 13 + .../tests/warnings/w33.compilers.reference | 12 + testsuite/tests/warnings/w33.ml | 27 + .../tests/warnings/w45.compilers.reference | 13 + testsuite/tests/warnings/w45.ml | 27 + .../warnings/w47_inline.compilers.reference | 42 + testsuite/tests/warnings/w47_inline.ml | 41 + .../tests/warnings/w50.compilers.reference | 8 + testsuite/tests/warnings/w50.ml | 18 + .../tests/warnings/w51.compilers.reference | 4 + testsuite/tests/warnings/w51.ml | 15 + .../warnings/w51_bis.compilers.reference | 4 + testsuite/tests/warnings/w51_bis.ml | 16 + testsuite/tests/warnings/w52.ml | 100 + .../tests/warnings/w53.compilers.reference | 52 + testsuite/tests/warnings/w53.ml | 43 + .../tests/warnings/w54.compilers.reference | 16 + testsuite/tests/warnings/w54.ml | 19 + .../tests/warnings/w55.flambda.reference | 12 + testsuite/tests/warnings/w55.ml | 52 + testsuite/tests/warnings/w55.native.reference | 24 + testsuite/tests/warnings/w58.ml | 22 + testsuite/tests/warnings/w58.native.reference | 2 + .../tests/warnings/w59.flambda.reference | 30 + testsuite/tests/warnings/w59.ml | 65 + .../tests/warnings/w60.compilers.reference | 4 + testsuite/tests/warnings/w60.ml | 41 + testsuite/tests/warnings/w60.mli | 12 + .../win-unicode/mltest.compilers.reference | 83 + testsuite/tests/win-unicode/mltest.ml | 277 + testsuite/tools/Makefile | 100 + testsuite/tools/asmgen_amd64.S | 83 + testsuite/tools/asmgen_arm.S | 42 + testsuite/tools/asmgen_arm64.S | 58 + testsuite/tools/asmgen_i386.S | 70 + testsuite/tools/asmgen_i386nt.asm | 67 + testsuite/tools/asmgen_power.S | 200 + testsuite/tools/asmgen_riscv.S | 89 + testsuite/tools/asmgen_s390x.S | 67 + testsuite/tools/codegen_main.ml | 80 + testsuite/tools/expect_test.ml | 372 + testsuite/tools/lexcmm.mli | 25 + testsuite/tools/lexcmm.mll | 261 + testsuite/tools/parsecmm.mly | 426 + testsuite/tools/parsecmmaux.ml | 58 + testsuite/tools/parsecmmaux.mli | 31 + tools/.depend | 199 + tools/Makefile | 392 + tools/autogen | 40 + tools/caml_tex.ml | 779 + tools/check-parser-uptodate-or-warn.sh | 69 + tools/check-symbol-names | 43 + tools/check-typo | 457 + tools/check-typo-since | 37 + tools/checkstack.c | 43 + tools/ci/appveyor/appveyor_build.cmd | 136 + tools/ci/appveyor/appveyor_build.sh | 190 + tools/ci/inria/bootstrap | 245 + tools/ci/inria/dune-build | 25 + tools/ci/inria/extra-checks | 253 + tools/ci/inria/lsan-suppr.txt | 2 + tools/ci/inria/main | 252 + tools/ci/inria/other-configs | 29 + tools/ci/inria/remove-sinh-primitive.patch | 90 + tools/ci/travis/travis-ci.sh | 358 + tools/cmpbyt.ml | 87 + tools/cvt_emit.mll | 86 + tools/dumpobj.ml | 582 + tools/dune | 25 + tools/eqparsetree.ml | 792 + tools/eventlog_metadata.in | 216 + tools/gdb-macros | 321 + tools/git-dev-options.sh | 71 + tools/lintapidiff.ml | 316 + tools/magic | 11 + tools/make-package-macosx | 138 + tools/make-version-header.sh | 55 + tools/make_opcodes.mll | 50 + tools/mantis2gh_stripped.csv | 1512 + tools/markdown-add-pr-links.sh | 34 + tools/msvs-promote-path | 51 + tools/objinfo.ml | 415 + tools/objinfo_helper.c | 148 + tools/ocaml-objcopy-macosx | 54 + tools/ocamlcp.ml | 93 + tools/ocamldep.ml | 1 + tools/ocamlmklib.ml | 363 + tools/ocamlmktop.ml | 32 + tools/ocamloptp.ml | 94 + tools/ocamlprof.ml | 528 + tools/ocamlsize | 64 + tools/pre-commit-githook | 85 + tools/primreq.ml | 95 + tools/profiling.ml | 56 + tools/profiling.mli | 20 + tools/read_cmt.ml | 201 + tools/release-checklist | 594 + tools/stripdebug.ml | 57 + toplevel/dune | 98 + toplevel/expunge.ml | 79 + toplevel/genprintval.ml | 615 + toplevel/genprintval.mli | 73 + toplevel/opttopdirs.ml | 218 + toplevel/opttopdirs.mli | 34 + toplevel/opttoploop.ml | 684 + toplevel/opttoploop.mli | 153 + toplevel/opttopmain.ml | 116 + toplevel/opttopmain.mli | 18 + toplevel/opttopstart.ml | 16 + toplevel/topdirs.ml | 847 + toplevel/topdirs.mli | 37 + toplevel/toploop.ml | 649 + toplevel/toploop.mli | 177 + toplevel/topmain.ml | 121 + toplevel/topmain.mli | 18 + toplevel/topstart.ml | 16 + toplevel/trace.ml | 150 + toplevel/trace.mli | 36 + typing/HACKING.adoc | 58 + typing/TODO.md | 101 + typing/annot.mli | 24 + typing/btype.ml | 820 + typing/btype.mli | 255 + typing/cmt2annot.ml | 184 + typing/ctype.ml | 4846 ++ typing/ctype.mli | 371 + typing/datarepr.ml | 258 + typing/datarepr.mli | 49 + typing/env.ml | 3174 ++ typing/env.mli | 447 + typing/envaux.ml | 115 + typing/envaux.mli | 36 + typing/ident.ml | 358 + typing/ident.mli | 80 + typing/includeclass.ml | 116 + typing/includeclass.mli | 32 + typing/includecore.ml | 508 + typing/includecore.mli | 90 + typing/includemod.ml | 896 + typing/includemod.mli | 93 + typing/mtype.ml | 527 + typing/mtype.mli | 55 + typing/oprint.ml | 820 + typing/oprint.mli | 32 + typing/outcometree.mli | 148 + typing/parmatch.ml | 2650 + typing/parmatch.mli | 187 + typing/path.ml | 129 + typing/path.mli | 52 + typing/persistent_env.ml | 373 + typing/persistent_env.mli | 105 + typing/predef.ml | 250 + typing/predef.mli | 87 + typing/primitive.ml | 227 + typing/primitive.mli | 76 + typing/printpat.ml | 163 + typing/printpat.mli | 27 + typing/printtyp.ml | 2194 + typing/printtyp.mli | 186 + typing/printtyped.ml | 945 + typing/printtyped.mli | 23 + typing/rec_check.ml | 1258 + typing/rec_check.mli | 19 + typing/stypes.ml | 210 + typing/stypes.mli | 36 + typing/subst.ml | 555 + typing/subst.mli | 86 + typing/tast_iterator.ml | 510 + typing/tast_iterator.mli | 68 + typing/tast_mapper.ml | 744 + typing/tast_mapper.mli | 72 + typing/type_immediacy.ml | 43 + typing/type_immediacy.mli | 40 + typing/typeclass.ml | 2062 + typing/typeclass.mli | 130 + typing/typecore.ml | 5552 ++ typing/typecore.mli | 226 + typing/typedecl.ml | 1872 + typing/typedecl.mli | 106 + typing/typedecl_immediacy.ml | 71 + typing/typedecl_immediacy.mli | 27 + typing/typedecl_properties.ml | 73 + typing/typedecl_properties.mli | 55 + typing/typedecl_separability.ml | 731 + typing/typedecl_separability.mli | 132 + typing/typedecl_unboxed.ml | 57 + typing/typedecl_unboxed.mli | 25 + typing/typedecl_variance.ml | 384 + typing/typedecl_variance.mli | 62 + typing/typedtree.ml | 841 + typing/typedtree.mli | 805 + typing/typemod.ml | 2947 + typing/typemod.mli | 137 + typing/typeopt.ml | 215 + typing/typeopt.mli | 43 + typing/types.ml | 470 + typing/types.mli | 577 + typing/typetexp.ml | 813 + typing/typetexp.mli | 76 + typing/untypeast.ml | 889 + typing/untypeast.mli | 85 + utils/HACKING.adoc | 50 + utils/Makefile | 143 + utils/arg_helper.ml | 127 + utils/arg_helper.mli | 68 + utils/build_path_prefix_map.ml | 119 + utils/build_path_prefix_map.mli | 47 + utils/ccomp.ml | 226 + utils/ccomp.mli | 39 + utils/clflags.ml | 504 + utils/clflags.mli | 266 + utils/config.mli | 250 + utils/config.mlp | 242 + utils/consistbl.ml | 97 + utils/consistbl.mli | 82 + utils/domainstate.ml.c | 34 + utils/domainstate.mli.c | 22 + utils/dune | 45 + utils/identifiable.ml | 249 + utils/identifiable.mli | 113 + utils/int_replace_polymorphic_compare.ml | 8 + utils/int_replace_polymorphic_compare.mli | 8 + utils/load_path.ml | 89 + utils/load_path.mli | 67 + utils/misc.ml | 1190 + utils/misc.mli | 688 + utils/numbers.ml | 88 + utils/numbers.mli | 51 + utils/profile.ml | 335 + utils/profile.mli | 49 + utils/strongly_connected_components.ml | 200 + utils/strongly_connected_components.mli | 43 + utils/targetint.ml | 104 + utils/targetint.mli | 207 + utils/terminfo.ml | 45 + utils/terminfo.mli | 32 + utils/warnings.ml | 797 + utils/warnings.mli | 140 + yacc/Makefile | 64 + yacc/closure.c | 284 + yacc/defs.h | 364 + yacc/error.c | 309 + yacc/lalr.c | 664 + yacc/lr0.c | 621 + yacc/main.c | 442 + yacc/mkpar.c | 365 + yacc/output.c | 985 + yacc/reader.c | 1859 + yacc/skeleton.c | 60 + yacc/symtab.c | 130 + yacc/verbose.c | 349 + yacc/warshall.c | 97 + yacc/wstr.c | 60 + 3457 files changed, 621400 insertions(+) create mode 100644 .depend create mode 100644 .depend.menhir create mode 100644 .gitattributes create mode 100644 .gitignore create mode 100644 .gitmodules create mode 100644 .mailmap create mode 100644 .ocp-indent create mode 100644 .travis.yml create mode 100644 BOOTSTRAP.adoc create mode 100644 CONTRIBUTING.md create mode 100644 Changes create mode 100644 HACKING.adoc create mode 100644 INSTALL.adoc create mode 100644 LICENSE create mode 100644 Makefile create mode 100644 Makefile.best_binaries create mode 100644 Makefile.common.in create mode 100644 Makefile.config.in create mode 100644 Makefile.dev create mode 100644 Makefile.menhir create mode 100644 Makefile.tools create mode 100644 News create mode 100644 README.adoc create mode 100644 README.win32.adoc create mode 100644 VERSION create mode 100644 aclocal.m4 create mode 100644 appveyor.yml create mode 100644 asmcomp/CSEgen.ml create mode 100644 asmcomp/CSEgen.mli create mode 100644 asmcomp/afl_instrument.ml create mode 100644 asmcomp/afl_instrument.mli create mode 100644 asmcomp/amd64/CSE.ml create mode 100644 asmcomp/amd64/NOTES.md create mode 100644 asmcomp/amd64/arch.ml create mode 100644 asmcomp/amd64/emit.mlp create mode 100644 asmcomp/amd64/proc.ml create mode 100644 asmcomp/amd64/reload.ml create mode 100644 asmcomp/amd64/scheduling.ml create mode 100644 asmcomp/amd64/selection.ml create mode 100644 asmcomp/arm/CSE.ml create mode 100644 asmcomp/arm/NOTES.md create mode 100644 asmcomp/arm/arch.ml create mode 100644 asmcomp/arm/emit.mlp create mode 100644 asmcomp/arm/proc.ml create mode 100644 asmcomp/arm/reload.ml create mode 100644 asmcomp/arm/scheduling.ml create mode 100644 asmcomp/arm/selection.ml create mode 100644 asmcomp/arm64/CSE.ml create mode 100644 asmcomp/arm64/NOTES.md create mode 100644 asmcomp/arm64/arch.ml create mode 100644 asmcomp/arm64/emit.mlp create mode 100644 asmcomp/arm64/proc.ml create mode 100644 asmcomp/arm64/reload.ml create mode 100644 asmcomp/arm64/scheduling.ml create mode 100644 asmcomp/arm64/selection.ml create mode 100644 asmcomp/asmgen.ml create mode 100644 asmcomp/asmgen.mli create mode 100644 asmcomp/asmlibrarian.ml create mode 100644 asmcomp/asmlibrarian.mli create mode 100644 asmcomp/asmlink.ml create mode 100644 asmcomp/asmlink.mli create mode 100644 asmcomp/asmpackager.ml create mode 100644 asmcomp/asmpackager.mli create mode 100644 asmcomp/branch_relaxation.ml create mode 100644 asmcomp/branch_relaxation.mli create mode 100644 asmcomp/branch_relaxation_intf.ml create mode 100644 asmcomp/cmm.ml create mode 100644 asmcomp/cmm.mli create mode 100644 asmcomp/cmm_helpers.ml create mode 100644 asmcomp/cmm_helpers.mli create mode 100644 asmcomp/cmmgen.ml create mode 100644 asmcomp/cmmgen.mli create mode 100644 asmcomp/cmmgen_state.ml create mode 100644 asmcomp/cmmgen_state.mli create mode 100644 asmcomp/coloring.ml create mode 100644 asmcomp/coloring.mli create mode 100644 asmcomp/comballoc.ml create mode 100644 asmcomp/comballoc.mli create mode 100644 asmcomp/deadcode.ml create mode 100644 asmcomp/deadcode.mli create mode 100644 asmcomp/debug/available_regs.ml create mode 100644 asmcomp/debug/available_regs.mli create mode 100644 asmcomp/debug/compute_ranges.ml create mode 100644 asmcomp/debug/compute_ranges.mli create mode 100644 asmcomp/debug/compute_ranges_intf.ml create mode 100644 asmcomp/debug/reg_availability_set.ml create mode 100644 asmcomp/debug/reg_availability_set.mli create mode 100644 asmcomp/debug/reg_with_debug_info.ml create mode 100644 asmcomp/debug/reg_with_debug_info.mli create mode 100644 asmcomp/dune create mode 100644 asmcomp/emit.mli create mode 100644 asmcomp/emitaux.ml create mode 100644 asmcomp/emitaux.mli create mode 100644 asmcomp/i386/CSE.ml create mode 100644 asmcomp/i386/NOTES.md create mode 100644 asmcomp/i386/arch.ml create mode 100644 asmcomp/i386/emit.mlp create mode 100644 asmcomp/i386/proc.ml create mode 100644 asmcomp/i386/reload.ml create mode 100644 asmcomp/i386/scheduling.ml create mode 100644 asmcomp/i386/selection.ml create mode 100644 asmcomp/interf.ml create mode 100644 asmcomp/interf.mli create mode 100644 asmcomp/interval.ml create mode 100644 asmcomp/interval.mli create mode 100644 asmcomp/linear.ml create mode 100644 asmcomp/linear.mli create mode 100644 asmcomp/linearize.ml create mode 100644 asmcomp/linearize.mli create mode 100644 asmcomp/linscan.ml create mode 100644 asmcomp/linscan.mli create mode 100644 asmcomp/liveness.ml create mode 100644 asmcomp/liveness.mli create mode 100644 asmcomp/mach.ml create mode 100644 asmcomp/mach.mli create mode 100644 asmcomp/power/CSE.ml create mode 100644 asmcomp/power/NOTES.md create mode 100644 asmcomp/power/arch.ml create mode 100644 asmcomp/power/emit.mlp create mode 100644 asmcomp/power/proc.ml create mode 100644 asmcomp/power/reload.ml create mode 100644 asmcomp/power/scheduling.ml create mode 100644 asmcomp/power/selection.ml create mode 100644 asmcomp/printcmm.ml create mode 100644 asmcomp/printcmm.mli create mode 100644 asmcomp/printlinear.ml create mode 100644 asmcomp/printlinear.mli create mode 100644 asmcomp/printmach.ml create mode 100644 asmcomp/printmach.mli create mode 100644 asmcomp/proc.mli create mode 100644 asmcomp/reg.ml create mode 100644 asmcomp/reg.mli create mode 100644 asmcomp/reload.mli create mode 100644 asmcomp/reloadgen.ml create mode 100644 asmcomp/reloadgen.mli create mode 100644 asmcomp/riscv/CSE.ml create mode 100644 asmcomp/riscv/NOTES.md create mode 100644 asmcomp/riscv/arch.ml create mode 100644 asmcomp/riscv/emit.mlp create mode 100644 asmcomp/riscv/proc.ml create mode 100644 asmcomp/riscv/reload.ml create mode 100644 asmcomp/riscv/scheduling.ml create mode 100644 asmcomp/riscv/selection.ml create mode 100644 asmcomp/s390x/CSE.ml create mode 100644 asmcomp/s390x/NOTES.md create mode 100644 asmcomp/s390x/arch.ml create mode 100644 asmcomp/s390x/emit.mlp create mode 100644 asmcomp/s390x/proc.ml create mode 100644 asmcomp/s390x/reload.ml create mode 100644 asmcomp/s390x/scheduling.ml create mode 100644 asmcomp/s390x/selection.ml create mode 100644 asmcomp/schedgen.ml create mode 100644 asmcomp/schedgen.mli create mode 100644 asmcomp/scheduling.mli create mode 100644 asmcomp/selectgen.ml create mode 100644 asmcomp/selectgen.mli create mode 100644 asmcomp/selection.mli create mode 100644 asmcomp/spacetime_profiling.ml create mode 100644 asmcomp/spacetime_profiling.mli create mode 100644 asmcomp/spill.ml create mode 100644 asmcomp/spill.mli create mode 100644 asmcomp/split.ml create mode 100644 asmcomp/split.mli create mode 100644 asmcomp/strmatch.ml create mode 100644 asmcomp/strmatch.mli create mode 100644 asmcomp/x86_ast.mli create mode 100644 asmcomp/x86_dsl.ml create mode 100644 asmcomp/x86_dsl.mli create mode 100644 asmcomp/x86_gas.ml create mode 100644 asmcomp/x86_gas.mli create mode 100644 asmcomp/x86_masm.ml create mode 100644 asmcomp/x86_masm.mli create mode 100644 asmcomp/x86_proc.ml create mode 100644 asmcomp/x86_proc.mli create mode 100644 boot/menhir/menhirLib.ml create mode 100644 boot/menhir/menhirLib.mli create mode 100644 boot/menhir/parser.ml create mode 100644 boot/menhir/parser.mli create mode 100755 boot/ocamlc create mode 100755 boot/ocamllex create mode 100644 build-aux/ax_func_which_gethostbyname_r.m4 create mode 100644 build-aux/ax_pthread.m4 create mode 100755 build-aux/compile create mode 100755 build-aux/config.guess create mode 100755 build-aux/config.sub create mode 100755 build-aux/install-sh create mode 100644 build-aux/libtool.m4 create mode 100644 build-aux/ltmain.sh create mode 100644 build-aux/ltoptions.m4 create mode 100644 build-aux/ltsugar.m4 create mode 100644 build-aux/ltversion.m4 create mode 100644 build-aux/lt~obsolete.m4 create mode 100755 build-aux/missing create mode 100644 bytecomp/bytegen.ml create mode 100644 bytecomp/bytegen.mli create mode 100644 bytecomp/bytelibrarian.ml create mode 100644 bytecomp/bytelibrarian.mli create mode 100644 bytecomp/bytelink.ml create mode 100644 bytecomp/bytelink.mli create mode 100644 bytecomp/bytepackager.ml create mode 100644 bytecomp/bytepackager.mli create mode 100644 bytecomp/bytesections.ml create mode 100644 bytecomp/bytesections.mli create mode 100644 bytecomp/dll.ml create mode 100644 bytecomp/dll.mli create mode 100644 bytecomp/dune create mode 100644 bytecomp/emitcode.ml create mode 100644 bytecomp/emitcode.mli create mode 100644 bytecomp/instruct.ml create mode 100644 bytecomp/instruct.mli create mode 100644 bytecomp/meta.ml create mode 100644 bytecomp/meta.mli create mode 100644 bytecomp/printinstr.ml create mode 100644 bytecomp/printinstr.mli create mode 100644 bytecomp/symtable.ml create mode 100644 bytecomp/symtable.mli create mode 100644 compilerlibs/Makefile.compilerlibs create mode 100755 configure create mode 100644 configure.ac create mode 100644 debugger/.depend create mode 100644 debugger/Makefile create mode 100644 debugger/breakpoints.ml create mode 100644 debugger/breakpoints.mli create mode 100644 debugger/checkpoints.ml create mode 100644 debugger/checkpoints.mli create mode 100644 debugger/command_line.ml create mode 100644 debugger/command_line.mli create mode 100644 debugger/debugcom.ml create mode 100644 debugger/debugcom.mli create mode 100644 debugger/debugger_config.ml create mode 100644 debugger/debugger_config.mli create mode 100644 debugger/debugger_lexer.mli create mode 100644 debugger/debugger_lexer.mll create mode 100644 debugger/debugger_parser.mly create mode 100644 debugger/dune create mode 100644 debugger/eval.ml create mode 100644 debugger/eval.mli create mode 100644 debugger/events.ml create mode 100644 debugger/events.mli create mode 100644 debugger/exec.ml create mode 100644 debugger/exec.mli create mode 100644 debugger/frames.ml create mode 100644 debugger/frames.mli create mode 100644 debugger/history.ml create mode 100644 debugger/history.mli create mode 100644 debugger/input_handling.ml create mode 100644 debugger/input_handling.mli create mode 100644 debugger/int64ops.ml create mode 100644 debugger/int64ops.mli create mode 100644 debugger/loadprinter.ml create mode 100644 debugger/loadprinter.mli create mode 100644 debugger/main.ml create mode 100644 debugger/parameters.ml create mode 100644 debugger/parameters.mli create mode 100644 debugger/parser_aux.mli create mode 100644 debugger/pattern_matching.ml create mode 100644 debugger/pattern_matching.mli create mode 100644 debugger/pos.ml create mode 100644 debugger/pos.mli create mode 100644 debugger/primitives.ml create mode 100644 debugger/primitives.mli create mode 100644 debugger/printval.ml create mode 100644 debugger/printval.mli create mode 100644 debugger/program_loading.ml create mode 100644 debugger/program_loading.mli create mode 100644 debugger/program_management.ml create mode 100644 debugger/program_management.mli create mode 100644 debugger/question.ml create mode 100644 debugger/question.mli create mode 100644 debugger/show_information.ml create mode 100644 debugger/show_information.mli create mode 100644 debugger/show_source.ml create mode 100644 debugger/show_source.mli create mode 100644 debugger/source.ml create mode 100644 debugger/source.mli create mode 100644 debugger/symbols.ml create mode 100644 debugger/symbols.mli create mode 100644 debugger/time_travel.ml create mode 100644 debugger/time_travel.mli create mode 100644 debugger/trap_barrier.ml create mode 100644 debugger/trap_barrier.mli create mode 100644 debugger/unix_tools.ml create mode 100644 debugger/unix_tools.mli create mode 100644 driver/compenv.ml create mode 100644 driver/compenv.mli create mode 100644 driver/compile.ml create mode 100644 driver/compile.mli create mode 100644 driver/compile_common.ml create mode 100644 driver/compile_common.mli create mode 100644 driver/compmisc.ml create mode 100644 driver/compmisc.mli create mode 100644 driver/errors.ml create mode 100644 driver/errors.mli create mode 100644 driver/main.ml create mode 100644 driver/main.mli create mode 100644 driver/main_args.ml create mode 100644 driver/main_args.mli create mode 100644 driver/makedepend.ml create mode 100644 driver/makedepend.mli create mode 100644 driver/optcompile.ml create mode 100644 driver/optcompile.mli create mode 100644 driver/opterrors.ml create mode 100644 driver/opterrors.mli create mode 100644 driver/optmain.ml create mode 100644 driver/optmain.mli create mode 100644 driver/pparse.ml create mode 100644 driver/pparse.mli create mode 100644 dune create mode 100644 dune-project create mode 100644 file_formats/cmi_format.ml create mode 100644 file_formats/cmi_format.mli create mode 100644 file_formats/cmo_format.mli create mode 100644 file_formats/cmt_format.ml create mode 100644 file_formats/cmt_format.mli create mode 100644 file_formats/cmx_format.mli create mode 100644 file_formats/cmxs_format.mli create mode 100644 lambda/.ocamlformat create mode 100644 lambda/.ocamlformat-enable create mode 100644 lambda/debuginfo.ml create mode 100644 lambda/debuginfo.mli create mode 100644 lambda/dune create mode 100755 lambda/generate_runtimedef.sh create mode 100644 lambda/lambda.ml create mode 100644 lambda/lambda.mli create mode 100644 lambda/matching.ml create mode 100644 lambda/matching.mli create mode 100644 lambda/printlambda.ml create mode 100644 lambda/printlambda.mli create mode 100644 lambda/runtimedef.mli create mode 100644 lambda/simplif.ml create mode 100644 lambda/simplif.mli create mode 100644 lambda/switch.ml create mode 100644 lambda/switch.mli create mode 100644 lambda/translattribute.ml create mode 100644 lambda/translattribute.mli create mode 100644 lambda/translclass.ml create mode 100644 lambda/translclass.mli create mode 100644 lambda/translcore.ml create mode 100644 lambda/translcore.mli create mode 100644 lambda/translmod.ml create mode 100644 lambda/translmod.mli create mode 100644 lambda/translobj.ml create mode 100644 lambda/translobj.mli create mode 100644 lambda/translprim.ml create mode 100644 lambda/translprim.mli create mode 100644 lex/.depend create mode 100644 lex/Makefile create mode 100644 lex/common.ml create mode 100644 lex/common.mli create mode 100644 lex/compact.ml create mode 100644 lex/compact.mli create mode 100644 lex/cset.ml create mode 100644 lex/cset.mli create mode 100644 lex/lexer.mli create mode 100644 lex/lexer.mll create mode 100644 lex/lexgen.ml create mode 100644 lex/lexgen.mli create mode 100644 lex/main.ml create mode 100644 lex/output.ml create mode 100644 lex/output.mli create mode 100644 lex/outputbis.ml create mode 100644 lex/outputbis.mli create mode 100644 lex/parser.mly create mode 100644 lex/syntax.ml create mode 100644 lex/syntax.mli create mode 100644 lex/table.ml create mode 100644 lex/table.mli create mode 100644 man/Makefile create mode 100644 man/ocaml.m create mode 100644 man/ocamlc.m create mode 100644 man/ocamlcp.m create mode 100644 man/ocamldebug.m create mode 100644 man/ocamldep.m create mode 100644 man/ocamldoc.m create mode 100644 man/ocamllex.m create mode 100644 man/ocamlmktop.m create mode 100644 man/ocamlopt.m create mode 100644 man/ocamlprof.m create mode 100644 man/ocamlrun.m create mode 100644 man/ocamlyacc.m create mode 100644 manual/LICENSE-for-the-manual create mode 100644 manual/Makefile create mode 100644 manual/README.md create mode 100644 manual/manual/.gitignore create mode 100644 manual/manual/Makefile create mode 100644 manual/manual/allfiles.etex create mode 100644 manual/manual/anchored_book.hva create mode 100644 manual/manual/biblio.etex create mode 100644 manual/manual/cmds/.gitignore create mode 100644 manual/manual/cmds/Makefile create mode 100644 manual/manual/cmds/afl-fuzz.etex create mode 100644 manual/manual/cmds/browser.etex create mode 100644 manual/manual/cmds/comp.etex create mode 100644 manual/manual/cmds/debugger.etex create mode 100644 manual/manual/cmds/flambda.etex create mode 100644 manual/manual/cmds/instrumented-runtime.etex create mode 100644 manual/manual/cmds/intf-c.etex create mode 100644 manual/manual/cmds/lexyacc.etex create mode 100644 manual/manual/cmds/native.etex create mode 100644 manual/manual/cmds/ocamlbuild.etex create mode 100644 manual/manual/cmds/ocamldep.etex create mode 100644 manual/manual/cmds/ocamldoc.etex create mode 100644 manual/manual/cmds/profil.etex create mode 100644 manual/manual/cmds/runtime.etex create mode 100644 manual/manual/cmds/spacetime-chapter.etex create mode 100644 manual/manual/cmds/top.etex create mode 100644 manual/manual/cmds/unified-options.etex create mode 100644 manual/manual/foreword.etex create mode 100644 manual/manual/htmlman/.gitignore create mode 100644 manual/manual/htmlman/contents_motif.gif create mode 100644 manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.eot create mode 100644 manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.svg create mode 100644 manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.ttf create mode 100644 manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.woff create mode 100644 manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.woff2 create mode 100644 manual/manual/htmlman/libgraph.gif create mode 100644 manual/manual/htmlman/next_motif.gif create mode 100644 manual/manual/htmlman/previous_motif.gif create mode 100644 manual/manual/index.tex create mode 100644 manual/manual/infoman/.gitignore create mode 100644 manual/manual/library/.gitignore create mode 100644 manual/manual/library/Makefile create mode 100644 manual/manual/library/builtin.etex create mode 100644 manual/manual/library/compiler_libs.mld create mode 100644 manual/manual/library/compilerlibs.etex create mode 100644 manual/manual/library/core.etex create mode 100644 manual/manual/library/libbigarray.etex create mode 100644 manual/manual/library/libdynlink.etex create mode 100644 manual/manual/library/libgraph.etex create mode 100644 manual/manual/library/libnum.etex create mode 100644 manual/manual/library/libstr.etex create mode 100644 manual/manual/library/libthreads.etex create mode 100644 manual/manual/library/libunix.etex create mode 100644 manual/manual/library/stdlib-blurb.etex create mode 100644 manual/manual/macros.hva create mode 100644 manual/manual/macros.tex create mode 100644 manual/manual/manual.hva create mode 100644 manual/manual/manual.inf create mode 100644 manual/manual/manual.info.header create mode 100644 manual/manual/manual.tex create mode 100644 manual/manual/refman/.gitignore create mode 100644 manual/manual/refman/Makefile create mode 100644 manual/manual/refman/classes.etex create mode 100644 manual/manual/refman/compunit.etex create mode 100644 manual/manual/refman/const.etex create mode 100644 manual/manual/refman/expr.etex create mode 100644 manual/manual/refman/exten.etex create mode 100644 manual/manual/refman/lex.etex create mode 100644 manual/manual/refman/modtypes.etex create mode 100644 manual/manual/refman/modules.etex create mode 100644 manual/manual/refman/names.etex create mode 100644 manual/manual/refman/patterns.etex create mode 100644 manual/manual/refman/refman.etex create mode 100644 manual/manual/refman/typedecl.etex create mode 100644 manual/manual/refman/types.etex create mode 100644 manual/manual/refman/values.etex create mode 100644 manual/manual/style.css create mode 100644 manual/manual/texstuff/.gitignore create mode 100644 manual/manual/textman/.gitignore create mode 100644 manual/manual/tutorials/.gitignore create mode 100644 manual/manual/tutorials/Makefile create mode 100644 manual/manual/tutorials/advexamples.etex create mode 100644 manual/manual/tutorials/coreexamples.etex create mode 100644 manual/manual/tutorials/lablexamples.etex create mode 100644 manual/manual/tutorials/moduleexamples.etex create mode 100644 manual/manual/tutorials/objectexamples.etex create mode 100644 manual/manual/tutorials/polymorphism.etex create mode 100644 manual/styles/altindex.sty create mode 100644 manual/styles/doc.tfm create mode 100644 manual/styles/docbf.tfm create mode 100644 manual/styles/docit.tfm create mode 100644 manual/styles/docmi.tfm create mode 100644 manual/styles/docrm.tfm create mode 100644 manual/styles/doctt.tfm create mode 100644 manual/styles/fullpage.sty create mode 100644 manual/styles/html.sty create mode 100644 manual/styles/isolatin.sty create mode 100644 manual/styles/multicols.sty create mode 100644 manual/styles/multind.sty create mode 100644 manual/styles/ocamldoc.hva create mode 100644 manual/styles/ocamldoc.sty create mode 100644 manual/styles/scroll.sty create mode 100644 manual/styles/syntaxdef.hva create mode 100644 manual/styles/syntaxdef.sty create mode 100644 manual/styles/syntaxdeftxt.sty create mode 100644 manual/tests/.gitignore create mode 100644 manual/tests/Makefile create mode 100644 manual/tests/README.md create mode 100755 manual/tests/check-stdlib-modules create mode 100644 manual/tests/cross_reference_checker.ml create mode 100644 manual/tools/.gitignore create mode 100644 manual/tools/Makefile create mode 100755 manual/tools/fix_index.sh create mode 100644 manual/tools/htmltransf.mll create mode 100644 manual/tools/texquote2.ml create mode 100644 manual/tools/transf.mll create mode 100644 manual/tools/transfmain.ml create mode 100644 middle_end/backend_intf.mli create mode 100644 middle_end/backend_var.ml create mode 100644 middle_end/backend_var.mli create mode 100644 middle_end/clambda.ml create mode 100644 middle_end/clambda.mli create mode 100644 middle_end/clambda_primitives.ml create mode 100644 middle_end/clambda_primitives.mli create mode 100644 middle_end/closure/closure.ml create mode 100644 middle_end/closure/closure.mli create mode 100644 middle_end/closure/closure_middle_end.ml create mode 100644 middle_end/closure/closure_middle_end.mli create mode 100644 middle_end/compilation_unit.ml create mode 100644 middle_end/compilation_unit.mli create mode 100644 middle_end/compilenv.ml create mode 100644 middle_end/compilenv.mli create mode 100644 middle_end/convert_primitives.ml create mode 100644 middle_end/convert_primitives.mli create mode 100644 middle_end/flambda/alias_analysis.ml create mode 100644 middle_end/flambda/alias_analysis.mli create mode 100644 middle_end/flambda/allocated_const.ml create mode 100644 middle_end/flambda/allocated_const.mli create mode 100644 middle_end/flambda/augment_specialised_args.ml create mode 100644 middle_end/flambda/augment_specialised_args.mli create mode 100644 middle_end/flambda/base_types/closure_element.ml create mode 100644 middle_end/flambda/base_types/closure_element.mli create mode 100644 middle_end/flambda/base_types/closure_id.ml create mode 100644 middle_end/flambda/base_types/closure_id.mli create mode 100644 middle_end/flambda/base_types/closure_origin.ml create mode 100644 middle_end/flambda/base_types/closure_origin.mli create mode 100644 middle_end/flambda/base_types/export_id.ml create mode 100644 middle_end/flambda/base_types/export_id.mli create mode 100644 middle_end/flambda/base_types/id_types.ml create mode 100644 middle_end/flambda/base_types/id_types.mli create mode 100644 middle_end/flambda/base_types/mutable_variable.ml create mode 100644 middle_end/flambda/base_types/mutable_variable.mli create mode 100644 middle_end/flambda/base_types/set_of_closures_id.ml create mode 100644 middle_end/flambda/base_types/set_of_closures_id.mli create mode 100644 middle_end/flambda/base_types/set_of_closures_origin.ml create mode 100644 middle_end/flambda/base_types/set_of_closures_origin.mli create mode 100644 middle_end/flambda/base_types/static_exception.ml create mode 100644 middle_end/flambda/base_types/static_exception.mli create mode 100644 middle_end/flambda/base_types/tag.ml create mode 100644 middle_end/flambda/base_types/tag.mli create mode 100644 middle_end/flambda/base_types/var_within_closure.ml create mode 100644 middle_end/flambda/base_types/var_within_closure.mli create mode 100644 middle_end/flambda/build_export_info.ml create mode 100644 middle_end/flambda/build_export_info.mli create mode 100644 middle_end/flambda/closure_conversion.ml create mode 100644 middle_end/flambda/closure_conversion.mli create mode 100644 middle_end/flambda/closure_conversion_aux.ml create mode 100644 middle_end/flambda/closure_conversion_aux.mli create mode 100644 middle_end/flambda/closure_offsets.ml create mode 100644 middle_end/flambda/closure_offsets.mli create mode 100644 middle_end/flambda/effect_analysis.ml create mode 100644 middle_end/flambda/effect_analysis.mli create mode 100644 middle_end/flambda/export_info.ml create mode 100644 middle_end/flambda/export_info.mli create mode 100644 middle_end/flambda/export_info_for_pack.ml create mode 100644 middle_end/flambda/export_info_for_pack.mli create mode 100644 middle_end/flambda/extract_projections.ml create mode 100644 middle_end/flambda/extract_projections.mli create mode 100644 middle_end/flambda/find_recursive_functions.ml create mode 100644 middle_end/flambda/find_recursive_functions.mli create mode 100644 middle_end/flambda/flambda.ml create mode 100644 middle_end/flambda/flambda.mli create mode 100644 middle_end/flambda/flambda_invariants.ml create mode 100644 middle_end/flambda/flambda_invariants.mli create mode 100644 middle_end/flambda/flambda_iterators.ml create mode 100644 middle_end/flambda/flambda_iterators.mli create mode 100644 middle_end/flambda/flambda_middle_end.ml create mode 100644 middle_end/flambda/flambda_middle_end.mli create mode 100644 middle_end/flambda/flambda_to_clambda.ml create mode 100644 middle_end/flambda/flambda_to_clambda.mli create mode 100644 middle_end/flambda/flambda_utils.ml create mode 100644 middle_end/flambda/flambda_utils.mli create mode 100644 middle_end/flambda/freshening.ml create mode 100644 middle_end/flambda/freshening.mli create mode 100644 middle_end/flambda/import_approx.ml create mode 100644 middle_end/flambda/import_approx.mli create mode 100644 middle_end/flambda/inconstant_idents.ml create mode 100644 middle_end/flambda/inconstant_idents.mli create mode 100644 middle_end/flambda/initialize_symbol_to_let_symbol.ml create mode 100644 middle_end/flambda/initialize_symbol_to_let_symbol.mli create mode 100644 middle_end/flambda/inline_and_simplify.ml create mode 100644 middle_end/flambda/inline_and_simplify.mli create mode 100644 middle_end/flambda/inline_and_simplify_aux.ml create mode 100644 middle_end/flambda/inline_and_simplify_aux.mli create mode 100644 middle_end/flambda/inlining_cost.ml create mode 100644 middle_end/flambda/inlining_cost.mli create mode 100644 middle_end/flambda/inlining_decision.ml create mode 100644 middle_end/flambda/inlining_decision.mli create mode 100644 middle_end/flambda/inlining_decision_intf.mli create mode 100644 middle_end/flambda/inlining_stats.ml create mode 100644 middle_end/flambda/inlining_stats.mli create mode 100644 middle_end/flambda/inlining_stats_types.ml create mode 100644 middle_end/flambda/inlining_stats_types.mli create mode 100644 middle_end/flambda/inlining_transforms.ml create mode 100644 middle_end/flambda/inlining_transforms.mli create mode 100644 middle_end/flambda/invariant_params.ml create mode 100644 middle_end/flambda/invariant_params.mli create mode 100644 middle_end/flambda/lift_code.ml create mode 100644 middle_end/flambda/lift_code.mli create mode 100644 middle_end/flambda/lift_constants.ml create mode 100644 middle_end/flambda/lift_constants.mli create mode 100644 middle_end/flambda/lift_let_to_initialize_symbol.ml create mode 100644 middle_end/flambda/lift_let_to_initialize_symbol.mli create mode 100644 middle_end/flambda/parameter.ml create mode 100644 middle_end/flambda/parameter.mli create mode 100644 middle_end/flambda/pass_wrapper.ml create mode 100644 middle_end/flambda/pass_wrapper.mli create mode 100644 middle_end/flambda/projection.ml create mode 100644 middle_end/flambda/projection.mli create mode 100644 middle_end/flambda/ref_to_variables.ml create mode 100644 middle_end/flambda/ref_to_variables.mli create mode 100644 middle_end/flambda/remove_free_vars_equal_to_args.ml create mode 100644 middle_end/flambda/remove_free_vars_equal_to_args.mli create mode 100644 middle_end/flambda/remove_unused_arguments.ml create mode 100644 middle_end/flambda/remove_unused_arguments.mli create mode 100644 middle_end/flambda/remove_unused_closure_vars.ml create mode 100644 middle_end/flambda/remove_unused_closure_vars.mli create mode 100644 middle_end/flambda/remove_unused_program_constructs.ml create mode 100644 middle_end/flambda/remove_unused_program_constructs.mli create mode 100644 middle_end/flambda/share_constants.ml create mode 100644 middle_end/flambda/share_constants.mli create mode 100644 middle_end/flambda/simple_value_approx.ml create mode 100644 middle_end/flambda/simple_value_approx.mli create mode 100644 middle_end/flambda/simplify_boxed_integer_ops.ml create mode 100644 middle_end/flambda/simplify_boxed_integer_ops.mli create mode 100644 middle_end/flambda/simplify_boxed_integer_ops_intf.mli create mode 100644 middle_end/flambda/simplify_common.ml create mode 100644 middle_end/flambda/simplify_common.mli create mode 100644 middle_end/flambda/simplify_primitives.ml create mode 100644 middle_end/flambda/simplify_primitives.mli create mode 100644 middle_end/flambda/traverse_for_exported_symbols.ml create mode 100644 middle_end/flambda/traverse_for_exported_symbols.mli create mode 100644 middle_end/flambda/un_anf.ml create mode 100644 middle_end/flambda/un_anf.mli create mode 100644 middle_end/flambda/unbox_closures.ml create mode 100644 middle_end/flambda/unbox_closures.mli create mode 100644 middle_end/flambda/unbox_free_vars_of_closures.ml create mode 100644 middle_end/flambda/unbox_free_vars_of_closures.mli create mode 100644 middle_end/flambda/unbox_specialised_args.ml create mode 100644 middle_end/flambda/unbox_specialised_args.mli create mode 100644 middle_end/internal_variable_names.ml create mode 100644 middle_end/internal_variable_names.mli create mode 100644 middle_end/linkage_name.ml create mode 100644 middle_end/linkage_name.mli create mode 100644 middle_end/printclambda.ml create mode 100644 middle_end/printclambda.mli create mode 100644 middle_end/printclambda_primitives.ml create mode 100644 middle_end/printclambda_primitives.mli create mode 100644 middle_end/semantics_of_primitives.ml create mode 100644 middle_end/semantics_of_primitives.mli create mode 100644 middle_end/symbol.ml create mode 100644 middle_end/symbol.mli create mode 100644 middle_end/variable.ml create mode 100644 middle_end/variable.mli create mode 100644 ocaml-variants.opam create mode 100644 ocamldoc/.depend create mode 100644 ocamldoc/Changes.txt create mode 100644 ocamldoc/Makefile create mode 100644 ocamldoc/Makefile.docfiles create mode 100644 ocamldoc/dune create mode 100644 ocamldoc/generators/odoc_literate.ml create mode 100644 ocamldoc/generators/odoc_todo.ml create mode 100644 ocamldoc/ocamldoc.hva create mode 100644 ocamldoc/ocamldoc.sty create mode 100644 ocamldoc/odoc.ml create mode 100644 ocamldoc/odoc_analyse.ml create mode 100644 ocamldoc/odoc_analyse.mli create mode 100644 ocamldoc/odoc_args.ml create mode 100644 ocamldoc/odoc_args.mli create mode 100644 ocamldoc/odoc_ast.ml create mode 100644 ocamldoc/odoc_ast.mli create mode 100644 ocamldoc/odoc_class.ml create mode 100644 ocamldoc/odoc_comments.ml create mode 100644 ocamldoc/odoc_comments.mli create mode 100644 ocamldoc/odoc_comments_global.ml create mode 100644 ocamldoc/odoc_comments_global.mli create mode 100644 ocamldoc/odoc_config.ml create mode 100644 ocamldoc/odoc_config.mli create mode 100644 ocamldoc/odoc_control.ml create mode 100644 ocamldoc/odoc_cross.ml create mode 100644 ocamldoc/odoc_cross.mli create mode 100644 ocamldoc/odoc_dag2html.ml create mode 100644 ocamldoc/odoc_dag2html.mli create mode 100644 ocamldoc/odoc_dep.ml create mode 100644 ocamldoc/odoc_dot.ml create mode 100644 ocamldoc/odoc_env.ml create mode 100644 ocamldoc/odoc_env.mli create mode 100644 ocamldoc/odoc_exception.ml create mode 100644 ocamldoc/odoc_extension.ml create mode 100644 ocamldoc/odoc_gen.ml create mode 100644 ocamldoc/odoc_gen.mli create mode 100644 ocamldoc/odoc_global.ml create mode 100644 ocamldoc/odoc_global.mli create mode 100644 ocamldoc/odoc_html.ml create mode 100644 ocamldoc/odoc_index.html create mode 100644 ocamldoc/odoc_info.ml create mode 100644 ocamldoc/odoc_info.mli create mode 100644 ocamldoc/odoc_inherit.ml create mode 100644 ocamldoc/odoc_latex.ml create mode 100644 ocamldoc/odoc_latex_style.ml create mode 100644 ocamldoc/odoc_lexer.mll create mode 100644 ocamldoc/odoc_man.ml create mode 100644 ocamldoc/odoc_merge.ml create mode 100644 ocamldoc/odoc_merge.mli create mode 100644 ocamldoc/odoc_messages.ml create mode 100644 ocamldoc/odoc_misc.ml create mode 100644 ocamldoc/odoc_misc.mli create mode 100644 ocamldoc/odoc_module.ml create mode 100644 ocamldoc/odoc_name.ml create mode 100644 ocamldoc/odoc_name.mli create mode 100644 ocamldoc/odoc_ocamlhtml.mll create mode 100644 ocamldoc/odoc_parameter.ml create mode 100644 ocamldoc/odoc_parser.mly create mode 100644 ocamldoc/odoc_print.ml create mode 100644 ocamldoc/odoc_print.mli create mode 100644 ocamldoc/odoc_scan.ml create mode 100644 ocamldoc/odoc_search.ml create mode 100644 ocamldoc/odoc_search.mli create mode 100644 ocamldoc/odoc_see_lexer.mll create mode 100644 ocamldoc/odoc_sig.ml create mode 100644 ocamldoc/odoc_sig.mli create mode 100644 ocamldoc/odoc_str.ml create mode 100644 ocamldoc/odoc_str.mli create mode 100644 ocamldoc/odoc_test.ml create mode 100644 ocamldoc/odoc_texi.ml create mode 100644 ocamldoc/odoc_text.ml create mode 100644 ocamldoc/odoc_text.mli create mode 100644 ocamldoc/odoc_text_lexer.mll create mode 100644 ocamldoc/odoc_text_parser.mly create mode 100644 ocamldoc/odoc_to_text.ml create mode 100644 ocamldoc/odoc_type.ml create mode 100644 ocamldoc/odoc_types.ml create mode 100644 ocamldoc/odoc_types.mli create mode 100644 ocamldoc/odoc_value.ml create mode 100755 ocamldoc/remove_DEBUG create mode 100644 ocamltest/.depend create mode 100644 ocamltest/Makefile create mode 100644 ocamltest/README create mode 100644 ocamltest/actions.ml create mode 100644 ocamltest/actions.mli create mode 100644 ocamltest/actions_helpers.ml create mode 100644 ocamltest/actions_helpers.mli create mode 100644 ocamltest/builtin_actions.ml create mode 100644 ocamltest/builtin_actions.mli create mode 100644 ocamltest/builtin_variables.ml create mode 100644 ocamltest/builtin_variables.mli create mode 100644 ocamltest/dune create mode 100644 ocamltest/environments.ml create mode 100644 ocamltest/environments.mli create mode 100644 ocamltest/filecompare.ml create mode 100644 ocamltest/filecompare.mli create mode 100755 ocamltest/getocamloptdefaultflags create mode 100644 ocamltest/main.ml create mode 100644 ocamltest/main.mli create mode 100644 ocamltest/modifier_parser.ml create mode 100644 ocamltest/modifier_parser.mli create mode 100644 ocamltest/ocaml_actions.ml create mode 100644 ocamltest/ocaml_actions.mli create mode 100644 ocamltest/ocaml_backends.ml create mode 100644 ocamltest/ocaml_backends.mli create mode 100644 ocamltest/ocaml_commands.ml create mode 100644 ocamltest/ocaml_commands.mli create mode 100644 ocamltest/ocaml_compilers.ml create mode 100644 ocamltest/ocaml_compilers.mli create mode 100644 ocamltest/ocaml_directories.ml create mode 100644 ocamltest/ocaml_directories.mli create mode 100644 ocamltest/ocaml_files.ml create mode 100644 ocamltest/ocaml_files.mli create mode 100644 ocamltest/ocaml_filetypes.ml create mode 100644 ocamltest/ocaml_filetypes.mli create mode 100644 ocamltest/ocaml_flags.ml create mode 100644 ocamltest/ocaml_flags.mli create mode 100644 ocamltest/ocaml_modifiers.ml create mode 100644 ocamltest/ocaml_modifiers.mli create mode 100644 ocamltest/ocaml_tests.ml create mode 100644 ocamltest/ocaml_tests.mli create mode 100644 ocamltest/ocaml_tools.ml create mode 100644 ocamltest/ocaml_tools.mli create mode 100644 ocamltest/ocaml_toplevels.ml create mode 100644 ocamltest/ocaml_toplevels.mli create mode 100644 ocamltest/ocaml_variables.ml create mode 100644 ocamltest/ocaml_variables.mli create mode 100644 ocamltest/ocamltest.org create mode 100644 ocamltest/ocamltest_config.ml.in create mode 100644 ocamltest/ocamltest_config.mli create mode 100644 ocamltest/ocamltest_stdlib.ml create mode 100644 ocamltest/ocamltest_stdlib.mli create mode 100644 ocamltest/ocamltest_stdlib_stubs.c create mode 100644 ocamltest/options.ml create mode 100644 ocamltest/options.mli create mode 100644 ocamltest/result.ml create mode 100644 ocamltest/result.mli create mode 100644 ocamltest/run.h create mode 100644 ocamltest/run_command.ml create mode 100644 ocamltest/run_command.mli create mode 100644 ocamltest/run_common.h create mode 100644 ocamltest/run_stubs.c create mode 100644 ocamltest/run_unix.c create mode 100644 ocamltest/run_win32.c create mode 100644 ocamltest/strace.ml create mode 100644 ocamltest/strace.mli create mode 100644 ocamltest/tests.ml create mode 100644 ocamltest/tests.mli create mode 100644 ocamltest/tsl_ast.ml create mode 100644 ocamltest/tsl_ast.mli create mode 100644 ocamltest/tsl_lexer.mli create mode 100644 ocamltest/tsl_lexer.mll create mode 100644 ocamltest/tsl_parser.mly create mode 100644 ocamltest/tsl_semantics.ml create mode 100644 ocamltest/tsl_semantics.mli create mode 100644 ocamltest/variables.ml create mode 100644 ocamltest/variables.mli create mode 100644 otherlibs/Makefile create mode 100644 otherlibs/Makefile.otherlibs.common create mode 100644 otherlibs/bigarray/.depend create mode 100644 otherlibs/bigarray/Makefile create mode 100644 otherlibs/bigarray/bigarray.ml create mode 100644 otherlibs/bigarray/bigarray.mli create mode 100644 otherlibs/bigarray/empty.c create mode 100644 otherlibs/dynlink/.depend create mode 100644 otherlibs/dynlink/Makefile create mode 100644 otherlibs/dynlink/byte/dynlink.ml create mode 100644 otherlibs/dynlink/dune create mode 100644 otherlibs/dynlink/dynlink.mli create mode 100644 otherlibs/dynlink/dynlink_common.ml create mode 100644 otherlibs/dynlink/dynlink_common.mli create mode 100644 otherlibs/dynlink/dynlink_compilerlibs/Makefile.copy-sources create mode 100644 otherlibs/dynlink/dynlink_platform_intf.ml create mode 100644 otherlibs/dynlink/dynlink_types.ml create mode 100644 otherlibs/dynlink/dynlink_types.mli create mode 100644 otherlibs/dynlink/extract_crc.ml create mode 100644 otherlibs/dynlink/native/dynlink.ml create mode 100644 otherlibs/raw_spacetime_lib/.depend create mode 100644 otherlibs/raw_spacetime_lib/Makefile create mode 100644 otherlibs/raw_spacetime_lib/raw_spacetime_lib.ml create mode 100644 otherlibs/raw_spacetime_lib/raw_spacetime_lib.mli create mode 100644 otherlibs/raw_spacetime_lib/spacetime_offline.c create mode 100644 otherlibs/str/.depend create mode 100644 otherlibs/str/Makefile create mode 100644 otherlibs/str/dune create mode 100644 otherlibs/str/str.ml create mode 100644 otherlibs/str/str.mli create mode 100644 otherlibs/str/strstubs.c create mode 100644 otherlibs/systhreads/.depend create mode 100644 otherlibs/systhreads/Makefile create mode 100644 otherlibs/systhreads/condition.ml create mode 100644 otherlibs/systhreads/condition.mli create mode 100644 otherlibs/systhreads/event.ml create mode 100644 otherlibs/systhreads/event.mli create mode 100644 otherlibs/systhreads/mutex.ml create mode 100644 otherlibs/systhreads/mutex.mli create mode 100644 otherlibs/systhreads/st_posix.h create mode 100644 otherlibs/systhreads/st_stubs.c create mode 100644 otherlibs/systhreads/st_win32.h create mode 100644 otherlibs/systhreads/thread.ml create mode 100644 otherlibs/systhreads/thread.mli create mode 100644 otherlibs/systhreads/threadUnix.ml create mode 100644 otherlibs/systhreads/threadUnix.mli create mode 100644 otherlibs/systhreads/threads.h create mode 100644 otherlibs/unix/.depend create mode 100644 otherlibs/unix/Makefile create mode 100644 otherlibs/unix/accept.c create mode 100644 otherlibs/unix/access.c create mode 100644 otherlibs/unix/addrofstr.c create mode 100644 otherlibs/unix/alarm.c create mode 100644 otherlibs/unix/bind.c create mode 100644 otherlibs/unix/channels.c create mode 100644 otherlibs/unix/chdir.c create mode 100644 otherlibs/unix/chmod.c create mode 100644 otherlibs/unix/chown.c create mode 100644 otherlibs/unix/chroot.c create mode 100644 otherlibs/unix/close.c create mode 100644 otherlibs/unix/closedir.c create mode 100644 otherlibs/unix/connect.c create mode 100644 otherlibs/unix/cst2constr.c create mode 100644 otherlibs/unix/cst2constr.h create mode 100644 otherlibs/unix/cstringv.c create mode 100644 otherlibs/unix/dune create mode 100644 otherlibs/unix/dup.c create mode 100644 otherlibs/unix/dup2.c create mode 100644 otherlibs/unix/envir.c create mode 100644 otherlibs/unix/errmsg.c create mode 100644 otherlibs/unix/execv.c create mode 100644 otherlibs/unix/execve.c create mode 100644 otherlibs/unix/execvp.c create mode 100644 otherlibs/unix/exit.c create mode 100644 otherlibs/unix/fchmod.c create mode 100644 otherlibs/unix/fchown.c create mode 100644 otherlibs/unix/fcntl.c create mode 100644 otherlibs/unix/fork.c create mode 100644 otherlibs/unix/fsync.c create mode 100644 otherlibs/unix/ftruncate.c create mode 100644 otherlibs/unix/getaddrinfo.c create mode 100644 otherlibs/unix/getcwd.c create mode 100644 otherlibs/unix/getegid.c create mode 100644 otherlibs/unix/geteuid.c create mode 100644 otherlibs/unix/getgid.c create mode 100644 otherlibs/unix/getgr.c create mode 100644 otherlibs/unix/getgroups.c create mode 100644 otherlibs/unix/gethost.c create mode 100644 otherlibs/unix/gethostname.c create mode 100644 otherlibs/unix/getlogin.c create mode 100644 otherlibs/unix/getnameinfo.c create mode 100644 otherlibs/unix/getpeername.c create mode 100644 otherlibs/unix/getpid.c create mode 100644 otherlibs/unix/getppid.c create mode 100644 otherlibs/unix/getproto.c create mode 100644 otherlibs/unix/getpw.c create mode 100644 otherlibs/unix/getserv.c create mode 100644 otherlibs/unix/getsockname.c create mode 100644 otherlibs/unix/gettimeofday.c create mode 100644 otherlibs/unix/getuid.c create mode 100644 otherlibs/unix/gmtime.c create mode 100644 otherlibs/unix/initgroups.c create mode 100644 otherlibs/unix/isatty.c create mode 100644 otherlibs/unix/itimer.c create mode 100644 otherlibs/unix/kill.c create mode 100644 otherlibs/unix/link.c create mode 100644 otherlibs/unix/listen.c create mode 100644 otherlibs/unix/lockf.c create mode 100644 otherlibs/unix/lseek.c create mode 100644 otherlibs/unix/mkdir.c create mode 100644 otherlibs/unix/mkfifo.c create mode 100644 otherlibs/unix/mmap.c create mode 100644 otherlibs/unix/mmap_ba.c create mode 100644 otherlibs/unix/nanosecond_stat.h create mode 100644 otherlibs/unix/nice.c create mode 100644 otherlibs/unix/open.c create mode 100644 otherlibs/unix/opendir.c create mode 100644 otherlibs/unix/pipe.c create mode 100644 otherlibs/unix/putenv.c create mode 100644 otherlibs/unix/read.c create mode 100644 otherlibs/unix/readdir.c create mode 100644 otherlibs/unix/readlink.c create mode 100644 otherlibs/unix/rename.c create mode 100644 otherlibs/unix/rewinddir.c create mode 100644 otherlibs/unix/rmdir.c create mode 100644 otherlibs/unix/select.c create mode 100644 otherlibs/unix/sendrecv.c create mode 100644 otherlibs/unix/setgid.c create mode 100644 otherlibs/unix/setgroups.c create mode 100644 otherlibs/unix/setsid.c create mode 100644 otherlibs/unix/setuid.c create mode 100644 otherlibs/unix/shutdown.c create mode 100644 otherlibs/unix/signals.c create mode 100644 otherlibs/unix/sleep.c create mode 100644 otherlibs/unix/socket.c create mode 100644 otherlibs/unix/socketaddr.c create mode 100644 otherlibs/unix/socketaddr.h create mode 100644 otherlibs/unix/socketpair.c create mode 100644 otherlibs/unix/sockopt.c create mode 100644 otherlibs/unix/stat.c create mode 100644 otherlibs/unix/strofaddr.c create mode 100644 otherlibs/unix/symlink.c create mode 100644 otherlibs/unix/termios.c create mode 100644 otherlibs/unix/time.c create mode 100644 otherlibs/unix/times.c create mode 100644 otherlibs/unix/truncate.c create mode 100644 otherlibs/unix/umask.c create mode 100644 otherlibs/unix/unix.ml create mode 100644 otherlibs/unix/unix.mli create mode 100644 otherlibs/unix/unixLabels.ml create mode 100644 otherlibs/unix/unixLabels.mli create mode 100644 otherlibs/unix/unixsupport.c create mode 100644 otherlibs/unix/unixsupport.h create mode 100644 otherlibs/unix/unlink.c create mode 100644 otherlibs/unix/utimes.c create mode 100644 otherlibs/unix/wait.c create mode 100644 otherlibs/unix/write.c create mode 100644 otherlibs/win32unix/.depend create mode 100644 otherlibs/win32unix/Makefile create mode 100644 otherlibs/win32unix/accept.c create mode 100644 otherlibs/win32unix/bind.c create mode 100644 otherlibs/win32unix/channels.c create mode 100644 otherlibs/win32unix/close.c create mode 100644 otherlibs/win32unix/close_on.c create mode 100644 otherlibs/win32unix/connect.c create mode 100644 otherlibs/win32unix/createprocess.c create mode 100644 otherlibs/win32unix/dup.c create mode 100644 otherlibs/win32unix/dup2.c create mode 100644 otherlibs/win32unix/envir.c create mode 100644 otherlibs/win32unix/errmsg.c create mode 100644 otherlibs/win32unix/getpeername.c create mode 100644 otherlibs/win32unix/getpid.c create mode 100644 otherlibs/win32unix/getsockname.c create mode 100644 otherlibs/win32unix/gettimeofday.c create mode 100644 otherlibs/win32unix/isatty.c create mode 100644 otherlibs/win32unix/link.c create mode 100644 otherlibs/win32unix/listen.c create mode 100644 otherlibs/win32unix/lockf.c create mode 100644 otherlibs/win32unix/lseek.c create mode 100644 otherlibs/win32unix/mkdir.c create mode 100644 otherlibs/win32unix/mmap.c create mode 100644 otherlibs/win32unix/nonblock.c create mode 100644 otherlibs/win32unix/open.c create mode 100644 otherlibs/win32unix/pipe.c create mode 100644 otherlibs/win32unix/read.c create mode 100644 otherlibs/win32unix/readlink.c create mode 100644 otherlibs/win32unix/rename.c create mode 100644 otherlibs/win32unix/select.c create mode 100644 otherlibs/win32unix/sendrecv.c create mode 100644 otherlibs/win32unix/shutdown.c create mode 100644 otherlibs/win32unix/sleep.c create mode 100644 otherlibs/win32unix/socket.c create mode 100644 otherlibs/win32unix/socketaddr.h create mode 100644 otherlibs/win32unix/sockopt.c create mode 100644 otherlibs/win32unix/startup.c create mode 100644 otherlibs/win32unix/stat.c create mode 100644 otherlibs/win32unix/symlink.c create mode 100644 otherlibs/win32unix/system.c create mode 100644 otherlibs/win32unix/times.c create mode 100644 otherlibs/win32unix/truncate.c create mode 100644 otherlibs/win32unix/unix.ml create mode 100644 otherlibs/win32unix/unixsupport.c create mode 100644 otherlibs/win32unix/unixsupport.h create mode 100644 otherlibs/win32unix/utimes.c create mode 100644 otherlibs/win32unix/windbug.c create mode 100644 otherlibs/win32unix/windbug.h create mode 100644 otherlibs/win32unix/windir.c create mode 100644 otherlibs/win32unix/winlist.c create mode 100644 otherlibs/win32unix/winlist.h create mode 100644 otherlibs/win32unix/winwait.c create mode 100644 otherlibs/win32unix/winworker.c create mode 100644 otherlibs/win32unix/winworker.h create mode 100644 otherlibs/win32unix/write.c create mode 100644 parsing/CONFLICTS.md create mode 100644 parsing/HACKING.adoc create mode 100644 parsing/VIPs.md create mode 100644 parsing/ast_helper.ml create mode 100644 parsing/ast_helper.mli create mode 100644 parsing/ast_invariants.ml create mode 100644 parsing/ast_invariants.mli create mode 100644 parsing/ast_iterator.ml create mode 100644 parsing/ast_iterator.mli create mode 100644 parsing/ast_mapper.ml create mode 100644 parsing/ast_mapper.mli create mode 100644 parsing/asttypes.mli create mode 100644 parsing/attr_helper.ml create mode 100644 parsing/attr_helper.mli create mode 100644 parsing/builtin_attributes.ml create mode 100644 parsing/builtin_attributes.mli create mode 100644 parsing/depend.ml create mode 100644 parsing/depend.mli create mode 100644 parsing/docstrings.ml create mode 100644 parsing/docstrings.mli create mode 100644 parsing/dune create mode 100644 parsing/lexer.mli create mode 100644 parsing/lexer.mll create mode 100644 parsing/location.ml create mode 100644 parsing/location.mli create mode 100644 parsing/longident.ml create mode 100644 parsing/longident.mli create mode 100644 parsing/parse.ml create mode 100644 parsing/parse.mli create mode 100644 parsing/parser.mly create mode 100644 parsing/parsetree.mli create mode 100644 parsing/pprintast.ml create mode 100644 parsing/pprintast.mli create mode 100644 parsing/printast.ml create mode 100644 parsing/printast.mli create mode 100644 parsing/syntaxerr.ml create mode 100644 parsing/syntaxerr.mli create mode 100644 runtime/.depend create mode 100644 runtime/Makefile create mode 100644 runtime/afl.c create mode 100644 runtime/alloc.c create mode 100644 runtime/amd64.S create mode 100644 runtime/amd64nt.asm create mode 100644 runtime/arm.S create mode 100644 runtime/arm64.S create mode 100644 runtime/array.c create mode 100644 runtime/backtrace.c create mode 100644 runtime/backtrace_byt.c create mode 100644 runtime/backtrace_nat.c create mode 100644 runtime/bigarray.c create mode 100644 runtime/callback.c create mode 100644 runtime/caml/address_class.h create mode 100644 runtime/caml/alloc.h create mode 100644 runtime/caml/backtrace.h create mode 100644 runtime/caml/backtrace_prim.h create mode 100644 runtime/caml/bigarray.h create mode 100644 runtime/caml/callback.h create mode 100644 runtime/caml/compact.h create mode 100644 runtime/caml/compare.h create mode 100644 runtime/caml/compatibility.h create mode 100644 runtime/caml/config.h create mode 100644 runtime/caml/custom.h create mode 100644 runtime/caml/debugger.h create mode 100644 runtime/caml/domain.h create mode 100644 runtime/caml/domain_state.h create mode 100644 runtime/caml/domain_state.tbl create mode 100644 runtime/caml/dune create mode 100644 runtime/caml/dynlink.h create mode 100644 runtime/caml/eventlog.h create mode 100644 runtime/caml/exec.h create mode 100644 runtime/caml/fail.h create mode 100644 runtime/caml/finalise.h create mode 100644 runtime/caml/fix_code.h create mode 100644 runtime/caml/freelist.h create mode 100644 runtime/caml/gc.h create mode 100644 runtime/caml/gc_ctrl.h create mode 100644 runtime/caml/globroots.h create mode 100644 runtime/caml/hash.h create mode 100644 runtime/caml/hooks.h create mode 100644 runtime/caml/instrtrace.h create mode 100644 runtime/caml/instruct.h create mode 100644 runtime/caml/interp.h create mode 100644 runtime/caml/intext.h create mode 100644 runtime/caml/io.h create mode 100644 runtime/caml/m.h.in create mode 100644 runtime/caml/major_gc.h create mode 100644 runtime/caml/md5.h create mode 100644 runtime/caml/memory.h create mode 100644 runtime/caml/memprof.h create mode 100644 runtime/caml/minor_gc.h create mode 100644 runtime/caml/misc.h create mode 100644 runtime/caml/mlvalues.h create mode 100644 runtime/caml/osdeps.h create mode 100644 runtime/caml/prims.h create mode 100644 runtime/caml/printexc.h create mode 100644 runtime/caml/reverse.h create mode 100644 runtime/caml/roots.h create mode 100644 runtime/caml/s.h.in create mode 100644 runtime/caml/signals.h create mode 100644 runtime/caml/signals_machdep.h create mode 100644 runtime/caml/spacetime.h create mode 100644 runtime/caml/stack.h create mode 100644 runtime/caml/stacks.h create mode 100644 runtime/caml/startup.h create mode 100644 runtime/caml/startup_aux.h create mode 100644 runtime/caml/sys.h create mode 100644 runtime/caml/ui.h create mode 100644 runtime/caml/weak.h create mode 100644 runtime/clambda_checks.c create mode 100644 runtime/compact.c create mode 100644 runtime/compare.c create mode 100644 runtime/custom.c create mode 100644 runtime/debugger.c create mode 100644 runtime/domain.c create mode 100644 runtime/dune create mode 100644 runtime/dynlink.c create mode 100644 runtime/dynlink_nat.c create mode 100644 runtime/eventlog.c create mode 100644 runtime/extern.c create mode 100644 runtime/fail_byt.c create mode 100644 runtime/fail_nat.c create mode 100644 runtime/finalise.c create mode 100644 runtime/fix_code.c create mode 100644 runtime/floats.c create mode 100644 runtime/freelist.c create mode 100644 runtime/gc_ctrl.c create mode 100644 runtime/gen_domain_state32_inc.awk create mode 100644 runtime/gen_domain_state64_inc.awk create mode 100755 runtime/gen_primitives.sh create mode 100644 runtime/globroots.c create mode 100644 runtime/hash.c create mode 100644 runtime/i386.S create mode 100644 runtime/i386nt.asm create mode 100644 runtime/instrtrace.c create mode 100644 runtime/intern.c create mode 100644 runtime/interp.c create mode 100644 runtime/ints.c create mode 100644 runtime/io.c create mode 100644 runtime/lexing.c create mode 100644 runtime/main.c create mode 100644 runtime/major_gc.c create mode 100644 runtime/md5.c create mode 100644 runtime/memory.c create mode 100644 runtime/memprof.c create mode 100644 runtime/meta.c create mode 100644 runtime/minor_gc.c create mode 100644 runtime/misc.c create mode 100644 runtime/obj.c create mode 100644 runtime/parsing.c create mode 100644 runtime/power.S create mode 100644 runtime/printexc.c create mode 100644 runtime/riscv.S create mode 100644 runtime/roots_byt.c create mode 100644 runtime/roots_nat.c create mode 100644 runtime/s390x.S create mode 100644 runtime/signals.c create mode 100644 runtime/signals_byt.c create mode 100644 runtime/signals_nat.c create mode 100644 runtime/signals_osdep.h create mode 100644 runtime/spacetime_byt.c create mode 100644 runtime/spacetime_nat.c create mode 100644 runtime/spacetime_snapshot.c create mode 100644 runtime/stacks.c create mode 100644 runtime/startup_aux.c create mode 100644 runtime/startup_byt.c create mode 100644 runtime/startup_nat.c create mode 100644 runtime/str.c create mode 100644 runtime/sys.c create mode 100644 runtime/unix.c create mode 100644 runtime/weak.c create mode 100644 runtime/win32.c create mode 100644 stdlib/.depend create mode 100755 stdlib/Compflags create mode 100644 stdlib/HACKING.adoc create mode 100644 stdlib/Makefile create mode 100644 stdlib/StdlibModules create mode 100644 stdlib/arg.ml create mode 100644 stdlib/arg.mli create mode 100644 stdlib/array.ml create mode 100644 stdlib/array.mli create mode 100644 stdlib/arrayLabels.ml create mode 100644 stdlib/arrayLabels.mli create mode 100644 stdlib/bigarray.ml create mode 100644 stdlib/bigarray.mli create mode 100644 stdlib/bool.ml create mode 100644 stdlib/bool.mli create mode 100644 stdlib/buffer.ml create mode 100644 stdlib/buffer.mli create mode 100644 stdlib/bytes.ml create mode 100644 stdlib/bytes.mli create mode 100644 stdlib/bytesLabels.ml create mode 100644 stdlib/bytesLabels.mli create mode 100644 stdlib/callback.ml create mode 100644 stdlib/callback.mli create mode 100644 stdlib/camlinternalFormat.ml create mode 100644 stdlib/camlinternalFormat.mli create mode 100644 stdlib/camlinternalFormatBasics.ml create mode 100644 stdlib/camlinternalFormatBasics.mli create mode 100644 stdlib/camlinternalLazy.ml create mode 100644 stdlib/camlinternalLazy.mli create mode 100644 stdlib/camlinternalMod.ml create mode 100644 stdlib/camlinternalMod.mli create mode 100644 stdlib/camlinternalOO.ml create mode 100644 stdlib/camlinternalOO.mli create mode 100644 stdlib/char.ml create mode 100644 stdlib/char.mli create mode 100644 stdlib/complex.ml create mode 100644 stdlib/complex.mli create mode 100644 stdlib/digest.ml create mode 100644 stdlib/digest.mli create mode 100644 stdlib/dune create mode 100644 stdlib/ephemeron.ml create mode 100644 stdlib/ephemeron.mli create mode 100644 stdlib/expand_module_aliases.awk create mode 100644 stdlib/filename.ml create mode 100644 stdlib/filename.mli create mode 100644 stdlib/float.ml create mode 100644 stdlib/float.mli create mode 100644 stdlib/format.ml create mode 100644 stdlib/format.mli create mode 100644 stdlib/fun.ml create mode 100644 stdlib/fun.mli create mode 100644 stdlib/gc.ml create mode 100644 stdlib/gc.mli create mode 100644 stdlib/genlex.ml create mode 100644 stdlib/genlex.mli create mode 100644 stdlib/hashbang create mode 100644 stdlib/hashtbl.ml create mode 100644 stdlib/hashtbl.mli create mode 100644 stdlib/header.c create mode 100644 stdlib/headernt.c create mode 100644 stdlib/int.ml create mode 100644 stdlib/int.mli create mode 100644 stdlib/int32.ml create mode 100644 stdlib/int32.mli create mode 100644 stdlib/int64.ml create mode 100644 stdlib/int64.mli create mode 100644 stdlib/lazy.ml create mode 100644 stdlib/lazy.mli create mode 100644 stdlib/lexing.ml create mode 100644 stdlib/lexing.mli create mode 100644 stdlib/list.ml create mode 100644 stdlib/list.mli create mode 100644 stdlib/listLabels.ml create mode 100644 stdlib/listLabels.mli create mode 100644 stdlib/map.ml create mode 100644 stdlib/map.mli create mode 100644 stdlib/marshal.ml create mode 100644 stdlib/marshal.mli create mode 100644 stdlib/moreLabels.ml create mode 100644 stdlib/moreLabels.mli create mode 100644 stdlib/nativeint.ml create mode 100644 stdlib/nativeint.mli create mode 100644 stdlib/obj.ml create mode 100644 stdlib/obj.mli create mode 100644 stdlib/ocaml_operators.mld create mode 100644 stdlib/oo.ml create mode 100644 stdlib/oo.mli create mode 100644 stdlib/option.ml create mode 100644 stdlib/option.mli create mode 100644 stdlib/parsing.ml create mode 100644 stdlib/parsing.mli create mode 100644 stdlib/pervasives.ml create mode 100644 stdlib/printexc.ml create mode 100644 stdlib/printexc.mli create mode 100644 stdlib/printf.ml create mode 100644 stdlib/printf.mli create mode 100644 stdlib/queue.ml create mode 100644 stdlib/queue.mli create mode 100644 stdlib/random.ml create mode 100644 stdlib/random.mli create mode 100644 stdlib/remove_module_aliases.awk create mode 100644 stdlib/result.ml create mode 100644 stdlib/result.mli create mode 100644 stdlib/scanf.ml create mode 100644 stdlib/scanf.mli create mode 100644 stdlib/seq.ml create mode 100644 stdlib/seq.mli create mode 100644 stdlib/set.ml create mode 100644 stdlib/set.mli create mode 100644 stdlib/spacetime.ml create mode 100644 stdlib/spacetime.mli create mode 100644 stdlib/stack.ml create mode 100644 stdlib/stack.mli create mode 100644 stdlib/stdLabels.ml create mode 100644 stdlib/stdLabels.mli create mode 100644 stdlib/std_exit.ml create mode 100644 stdlib/stdlib.ml create mode 100644 stdlib/stdlib.mli create mode 100644 stdlib/stream.ml create mode 100644 stdlib/stream.mli create mode 100644 stdlib/string.ml create mode 100644 stdlib/string.mli create mode 100644 stdlib/stringLabels.ml create mode 100644 stdlib/stringLabels.mli create mode 100644 stdlib/sys.mli create mode 100644 stdlib/sys.mlp create mode 100644 stdlib/uchar.ml create mode 100644 stdlib/uchar.mli create mode 100644 stdlib/unit.ml create mode 100644 stdlib/unit.mli create mode 100644 stdlib/weak.ml create mode 100644 stdlib/weak.mli create mode 100644 testsuite/HACKING.adoc create mode 100644 testsuite/Makefile create mode 100644 testsuite/lib/Makefile create mode 100644 testsuite/lib/lib.ml create mode 100644 testsuite/lib/testing.ml create mode 100644 testsuite/lib/testing.mli create mode 100644 testsuite/summarize.awk create mode 100644 testsuite/tests/afl-instrumentation/afltest.ml create mode 100755 testsuite/tests/afl-instrumentation/afltest.run create mode 100644 testsuite/tests/afl-instrumentation/harness.ml create mode 100644 testsuite/tests/afl-instrumentation/has-afl-showmap.sh create mode 100644 testsuite/tests/afl-instrumentation/test.ml create mode 100644 testsuite/tests/arch-power/exn_raise.ml create mode 100644 testsuite/tests/arch-power/exn_raise.reference create mode 100644 testsuite/tests/array-functions/test.ml create mode 100644 testsuite/tests/array-functions/test.reference create mode 100644 testsuite/tests/asmcomp/0001-test.compilers.reference create mode 100644 testsuite/tests/asmcomp/0001-test.ml create mode 100644 testsuite/tests/asmcomp/bind_tuples.ml create mode 100644 testsuite/tests/asmcomp/compare.ml create mode 100644 testsuite/tests/asmcomp/compare.reference create mode 100644 testsuite/tests/asmcomp/func_sections.arm.reference create mode 100644 testsuite/tests/asmcomp/func_sections.ml create mode 100644 testsuite/tests/asmcomp/func_sections.reference create mode 100755 testsuite/tests/asmcomp/func_sections.run create mode 100644 testsuite/tests/asmcomp/is_in_static_data.c create mode 100644 testsuite/tests/asmcomp/is_static.ml create mode 100644 testsuite/tests/asmcomp/is_static_flambda.ml create mode 100644 testsuite/tests/asmcomp/is_static_flambda_dep.ml create mode 100644 testsuite/tests/asmcomp/lift_mutable_let_flambda.ml create mode 100644 testsuite/tests/asmcomp/optargs.ml create mode 100644 testsuite/tests/asmcomp/register_typing.ml create mode 100644 testsuite/tests/asmcomp/register_typing_switch.ml create mode 100644 testsuite/tests/asmcomp/simple_float_const.ml create mode 100644 testsuite/tests/asmcomp/simple_float_const_opaque.ml create mode 100644 testsuite/tests/asmcomp/static_float_array_flambda.ml create mode 100644 testsuite/tests/asmcomp/static_float_array_flambda_opaque.ml create mode 100644 testsuite/tests/asmcomp/staticalloc.ml create mode 100644 testsuite/tests/asmcomp/unrolling_flambda.ml create mode 100644 testsuite/tests/asmcomp/unrolling_flambda2.ml create mode 100644 testsuite/tests/asmgen/arith.cmm create mode 100644 testsuite/tests/asmgen/catch-float.cmm create mode 100644 testsuite/tests/asmgen/catch-multiple.cmm create mode 100644 testsuite/tests/asmgen/catch-rec-deadhandler.cmm create mode 100644 testsuite/tests/asmgen/catch-rec-deadhandler.reference create mode 100755 testsuite/tests/asmgen/catch-rec-deadhandler.run create mode 100644 testsuite/tests/asmgen/catch-rec.cmm create mode 100644 testsuite/tests/asmgen/catch-try-float.cmm create mode 100644 testsuite/tests/asmgen/catch-try.cmm create mode 100644 testsuite/tests/asmgen/checkbound.cmm create mode 100644 testsuite/tests/asmgen/even-odd-spill-float.cmm create mode 100644 testsuite/tests/asmgen/even-odd-spill.cmm create mode 100644 testsuite/tests/asmgen/even-odd.cmm create mode 100644 testsuite/tests/asmgen/fib.cmm create mode 100644 testsuite/tests/asmgen/integr.cmm create mode 100644 testsuite/tests/asmgen/main.c create mode 100644 testsuite/tests/asmgen/mainarith.c create mode 100644 testsuite/tests/asmgen/pgcd.cmm create mode 100644 testsuite/tests/asmgen/quicksort.cmm create mode 100644 testsuite/tests/asmgen/quicksort2.cmm create mode 100644 testsuite/tests/asmgen/soli.cmm create mode 100644 testsuite/tests/asmgen/tagged-fib.cmm create mode 100644 testsuite/tests/asmgen/tagged-integr.cmm create mode 100644 testsuite/tests/asmgen/tagged-quicksort.cmm create mode 100644 testsuite/tests/asmgen/tagged-tak.cmm create mode 100644 testsuite/tests/asmgen/tak.cmm create mode 100644 testsuite/tests/ast-invariants/test.ml create mode 100644 testsuite/tests/ast-invariants/test.reference create mode 100644 testsuite/tests/backtrace/backtrace.ml create mode 100644 testsuite/tests/backtrace/backtrace.reference create mode 100644 testsuite/tests/backtrace/backtrace.run create mode 100644 testsuite/tests/backtrace/backtrace2.ml create mode 100644 testsuite/tests/backtrace/backtrace2.reference create mode 100644 testsuite/tests/backtrace/backtrace3.ml create mode 100644 testsuite/tests/backtrace/backtrace3.reference create mode 100644 testsuite/tests/backtrace/backtrace_deprecated.ml create mode 100644 testsuite/tests/backtrace/backtrace_deprecated.reference create mode 100644 testsuite/tests/backtrace/backtrace_or_exception.ml create mode 100644 testsuite/tests/backtrace/backtrace_or_exception.reference create mode 100644 testsuite/tests/backtrace/backtrace_slots.ml create mode 100644 testsuite/tests/backtrace/backtrace_slots.reference create mode 100644 testsuite/tests/backtrace/backtraces_and_finalizers.ml create mode 100644 testsuite/tests/backtrace/backtraces_and_finalizers.reference create mode 100644 testsuite/tests/backtrace/callstack.ml create mode 100644 testsuite/tests/backtrace/callstack.reference create mode 100644 testsuite/tests/backtrace/event_after_prim.ml create mode 100644 testsuite/tests/backtrace/event_after_prim.reference create mode 100755 testsuite/tests/backtrace/filter-locations.sh create mode 100644 testsuite/tests/backtrace/inline_test.ml create mode 100644 testsuite/tests/backtrace/inline_test.reference create mode 100755 testsuite/tests/backtrace/inline_test.run create mode 100644 testsuite/tests/backtrace/inline_traversal_test.ml create mode 100644 testsuite/tests/backtrace/inline_traversal_test.reference create mode 100755 testsuite/tests/backtrace/inline_traversal_test.run create mode 100644 testsuite/tests/backtrace/methods.ml create mode 100644 testsuite/tests/backtrace/methods.reference create mode 100644 testsuite/tests/backtrace/names.ml create mode 100644 testsuite/tests/backtrace/names.reference create mode 100644 testsuite/tests/backtrace/pr6920_why_at.ml create mode 100644 testsuite/tests/backtrace/pr6920_why_at.native.reference create mode 100644 testsuite/tests/backtrace/pr6920_why_at.reference create mode 100644 testsuite/tests/backtrace/pr6920_why_swallow.ml create mode 100644 testsuite/tests/backtrace/pr6920_why_swallow.native.reference create mode 100644 testsuite/tests/backtrace/pr6920_why_swallow.reference create mode 100644 testsuite/tests/backtrace/raw_backtrace.ml create mode 100644 testsuite/tests/backtrace/raw_backtrace.reference create mode 100644 testsuite/tests/basic-float/float_compare.ml create mode 100644 testsuite/tests/basic-float/float_compare.reference create mode 100644 testsuite/tests/basic-float/float_literals.ml create mode 100644 testsuite/tests/basic-float/tfloat_hex.ml create mode 100644 testsuite/tests/basic-float/tfloat_hex.reference create mode 100644 testsuite/tests/basic-float/tfloat_record.ml create mode 100644 testsuite/tests/basic-float/tfloat_record.reference create mode 100644 testsuite/tests/basic-float/zero_sized_float_arrays.ml create mode 100644 testsuite/tests/basic-float/zero_sized_float_arrays.reference create mode 100644 testsuite/tests/basic-io-2/io.ml create mode 100644 testsuite/tests/basic-io-2/io.reference create mode 100644 testsuite/tests/basic-io-2/test-file-short-lines create mode 100644 testsuite/tests/basic-io/wc.ml create mode 100644 testsuite/tests/basic-io/wc.reference create mode 100644 testsuite/tests/basic-manyargs/manyargs.ml create mode 100644 testsuite/tests/basic-manyargs/manyargs.reference create mode 100644 testsuite/tests/basic-manyargs/manyargsprim.c create mode 100644 testsuite/tests/basic-modules/anonymous.ml create mode 100644 testsuite/tests/basic-modules/anonymous.ocamlc.reference create mode 100644 testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference create mode 100644 testsuite/tests/basic-modules/anonymous.ocamlopt.reference create mode 100644 testsuite/tests/basic-modules/main.ml create mode 100644 testsuite/tests/basic-modules/main.mli create mode 100644 testsuite/tests/basic-modules/main.reference create mode 100644 testsuite/tests/basic-modules/offset.ml create mode 100644 testsuite/tests/basic-modules/pr4008.ml create mode 100644 testsuite/tests/basic-modules/pr6726.ml create mode 100644 testsuite/tests/basic-modules/pr7427.ml create mode 100644 testsuite/tests/basic-modules/recursive_module_evaluation_errors.ml create mode 100644 testsuite/tests/basic-more/bounds.ml create mode 100644 testsuite/tests/basic-more/bounds.reference create mode 100644 testsuite/tests/basic-more/div_by_zero.ml create mode 100644 testsuite/tests/basic-more/div_by_zero.reference create mode 100644 testsuite/tests/basic-more/function_in_ref.ml create mode 100644 testsuite/tests/basic-more/function_in_ref.reference create mode 100644 testsuite/tests/basic-more/if_in_if.ml create mode 100644 testsuite/tests/basic-more/if_in_if.reference create mode 100644 testsuite/tests/basic-more/morematch.compilers.reference create mode 100644 testsuite/tests/basic-more/morematch.ml create mode 100644 testsuite/tests/basic-more/morematch.reference create mode 100644 testsuite/tests/basic-more/opaque_prim.ml create mode 100644 testsuite/tests/basic-more/opaque_prim.reference create mode 100644 testsuite/tests/basic-more/pr1271.ml create mode 100644 testsuite/tests/basic-more/pr1271.reference create mode 100644 testsuite/tests/basic-more/pr2719.ml create mode 100644 testsuite/tests/basic-more/pr2719.reference create mode 100644 testsuite/tests/basic-more/pr6216.ml create mode 100644 testsuite/tests/basic-more/pr6216.reference create mode 100644 testsuite/tests/basic-more/pr7683.ml create mode 100644 testsuite/tests/basic-more/pr7683.reference create mode 100644 testsuite/tests/basic-more/record_evaluation_order.ml create mode 100644 testsuite/tests/basic-more/record_evaluation_order.reference create mode 100644 testsuite/tests/basic-more/robustmatch.compilers.reference create mode 100644 testsuite/tests/basic-more/robustmatch.ml create mode 100644 testsuite/tests/basic-more/robustmatch.reference create mode 100644 testsuite/tests/basic-more/sequential_and_or.ml create mode 100644 testsuite/tests/basic-more/sequential_and_or.reference create mode 100644 testsuite/tests/basic-more/structural_constants.ml create mode 100644 testsuite/tests/basic-more/structural_constants.reference create mode 100644 testsuite/tests/basic-more/tbuffer.ml create mode 100644 testsuite/tests/basic-more/tbuffer.reference create mode 100644 testsuite/tests/basic-more/testrandom.ml create mode 100644 testsuite/tests/basic-more/testrandom.reference create mode 100644 testsuite/tests/basic-more/top_level_patterns.ml create mode 100644 testsuite/tests/basic-more/top_level_patterns.reference create mode 100644 testsuite/tests/basic-more/tprintf.ml create mode 100644 testsuite/tests/basic-more/tprintf.reference create mode 100644 testsuite/tests/basic-multdef/multdef.ml create mode 100644 testsuite/tests/basic-multdef/multdef.mli create mode 100644 testsuite/tests/basic-multdef/usemultdef.ml create mode 100644 testsuite/tests/basic-multdef/usemultdef.reference create mode 100644 testsuite/tests/basic-private/length.ml create mode 100644 testsuite/tests/basic-private/length.mli create mode 100644 testsuite/tests/basic-private/tlength.ml create mode 100644 testsuite/tests/basic-private/tlength.reference create mode 100644 testsuite/tests/basic/arrays.ml create mode 100644 testsuite/tests/basic/arrays.reference create mode 100644 testsuite/tests/basic/bigints.ml create mode 100644 testsuite/tests/basic/bigints.reference create mode 100644 testsuite/tests/basic/boxedints.ml create mode 100644 testsuite/tests/basic/boxedints.reference create mode 100644 testsuite/tests/basic/camlCase.ml create mode 100644 testsuite/tests/basic/constprop.ml.c create mode 100644 testsuite/tests/basic/constprop.ml.reference create mode 100644 testsuite/tests/basic/divint.ml create mode 100644 testsuite/tests/basic/divint.reference create mode 100644 testsuite/tests/basic/equality.ml create mode 100644 testsuite/tests/basic/equality.reference create mode 100644 testsuite/tests/basic/eval_order_1.ml create mode 100644 testsuite/tests/basic/eval_order_1.reference create mode 100644 testsuite/tests/basic/eval_order_2.ml create mode 100644 testsuite/tests/basic/eval_order_2.reference create mode 100644 testsuite/tests/basic/eval_order_3.ml create mode 100644 testsuite/tests/basic/eval_order_3.reference create mode 100644 testsuite/tests/basic/eval_order_4.ml create mode 100644 testsuite/tests/basic/eval_order_4.reference create mode 100644 testsuite/tests/basic/eval_order_6.ml create mode 100644 testsuite/tests/basic/eval_order_6.reference create mode 100644 testsuite/tests/basic/float.ml create mode 100644 testsuite/tests/basic/float.reference create mode 100644 testsuite/tests/basic/float_physical_equality.ml create mode 100644 testsuite/tests/basic/float_physical_equality.reference create mode 100644 testsuite/tests/basic/includestruct.ml create mode 100644 testsuite/tests/basic/includestruct.reference create mode 100644 testsuite/tests/basic/localexn.ml create mode 100644 testsuite/tests/basic/localexn.reference create mode 100644 testsuite/tests/basic/localfunction.ml create mode 100644 testsuite/tests/basic/localfunction.reference create mode 100644 testsuite/tests/basic/maps.ml create mode 100644 testsuite/tests/basic/maps.reference create mode 100644 testsuite/tests/basic/min_int.ml create mode 100644 testsuite/tests/basic/min_int.reference create mode 100644 testsuite/tests/basic/opt_variants.ml create mode 100644 testsuite/tests/basic/opt_variants.reference create mode 100644 testsuite/tests/basic/patmatch.ml create mode 100644 testsuite/tests/basic/patmatch.reference create mode 100644 testsuite/tests/basic/patmatch_incoherence.ml create mode 100644 testsuite/tests/basic/patmatch_split_no_or.ml create mode 100644 testsuite/tests/basic/pr7253.ml create mode 100644 testsuite/tests/basic/pr7253.reference create mode 100644 testsuite/tests/basic/pr7533.ml create mode 100644 testsuite/tests/basic/pr7533.reference create mode 100644 testsuite/tests/basic/pr7657.ml create mode 100644 testsuite/tests/basic/pr7657.reference create mode 100644 testsuite/tests/basic/recvalues.ml create mode 100644 testsuite/tests/basic/recvalues.reference create mode 100644 testsuite/tests/basic/sets.ml create mode 100644 testsuite/tests/basic/sets.reference create mode 100644 testsuite/tests/basic/stringmatch.ml create mode 100644 testsuite/tests/basic/stringmatch.reference create mode 100644 testsuite/tests/basic/switch_opts.ml create mode 100644 testsuite/tests/basic/switch_opts.reference create mode 100644 testsuite/tests/basic/tailcalls.ml create mode 100644 testsuite/tests/basic/tailcalls.reference create mode 100644 testsuite/tests/basic/trigraph.ml create mode 100644 testsuite/tests/basic/trigraph.reference create mode 100644 testsuite/tests/basic/tuple_match.ml create mode 100644 testsuite/tests/basic/tuple_match.reference create mode 100644 testsuite/tests/basic/unit_naming.compilers.reference create mode 100644 testsuite/tests/basic/unit_naming.ml create mode 100644 testsuite/tests/basic/zero_divided_by_n.ml create mode 100644 testsuite/tests/basic/zero_divided_by_n.reference create mode 100644 testsuite/tests/c-api/alloc_async.ml create mode 100644 testsuite/tests/c-api/alloc_async.reference create mode 100644 testsuite/tests/c-api/alloc_async_stubs.c create mode 100644 testsuite/tests/callback/callbackprim.c create mode 100644 testsuite/tests/callback/signals_alloc.ml create mode 100644 testsuite/tests/callback/signals_alloc.reference create mode 100644 testsuite/tests/callback/tcallback.ml create mode 100644 testsuite/tests/callback/tcallback.reference create mode 100644 testsuite/tests/compatibility/main.ml create mode 100644 testsuite/tests/compatibility/main.reference create mode 100644 testsuite/tests/compatibility/stub.c create mode 100644 testsuite/tests/compiler-libs/test_longident.ml create mode 100644 testsuite/tests/embedded/cmcaml.ml create mode 100644 testsuite/tests/embedded/cmcaml.reference create mode 100644 testsuite/tests/embedded/cmmain.c create mode 100644 testsuite/tests/embedded/cmstub.c create mode 100644 testsuite/tests/ephe-c-api/stubs.c create mode 100644 testsuite/tests/ephe-c-api/test.ml create mode 100644 testsuite/tests/ephe-c-api/test.reference create mode 100644 testsuite/tests/exotic-syntax/exotic.ml create mode 100644 testsuite/tests/exotic-syntax/exotic.reference create mode 100644 testsuite/tests/extension-constructor/test.ml create mode 100644 testsuite/tests/extension-constructor/test.reference create mode 100644 testsuite/tests/flambda/approx_meet.ml create mode 100644 testsuite/tests/flambda/approx_meet.reference create mode 100644 testsuite/tests/flambda/gpr2239.ml create mode 100644 testsuite/tests/flambda/gpr2239.reference create mode 100644 testsuite/tests/flambda/gpr998.ml create mode 100644 testsuite/tests/flambda/gpr998.reference create mode 100644 testsuite/tests/flambda/specialise.ml create mode 100644 testsuite/tests/flambda/specialise.reference create mode 100644 testsuite/tests/float-unboxing/float_subst_boxed_number.ml create mode 100644 testsuite/tests/float-unboxing/unbox_under_assign.ml create mode 100644 testsuite/tests/fma/fma.ml create mode 100644 testsuite/tests/fma/fma.reference create mode 100644 testsuite/tests/formats-transition/deprecated_unsigned_printers.ml create mode 100644 testsuite/tests/formats-transition/deprecated_unsigned_printers.ocaml.reference create mode 100644 testsuite/tests/formats-transition/ignored_scan_counters.ml create mode 100644 testsuite/tests/formats-transition/ignored_scan_counters.ocaml.reference create mode 100644 testsuite/tests/formats-transition/legacy_incompatible_flags.ml create mode 100644 testsuite/tests/formats-transition/legacy_incompatible_flags.ocaml.reference create mode 100644 testsuite/tests/formats-transition/legacy_unfinished_modifiers.ml create mode 100644 testsuite/tests/formats-transition/legacy_unfinished_modifiers.ocaml.reference create mode 100644 testsuite/tests/formatting/errors_batch.ml create mode 100644 testsuite/tests/formatting/errors_batch.reference create mode 100644 testsuite/tests/formatting/margins.ml create mode 100644 testsuite/tests/formatting/margins.ocaml.reference create mode 100644 testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference create mode 100644 testsuite/tests/formatting/test_locations.dlocations.ocamlopt.clambda.reference create mode 100644 testsuite/tests/formatting/test_locations.dlocations.ocamlopt.flambda.reference create mode 100644 testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference create mode 100644 testsuite/tests/formatting/test_locations.dno-locations.ocamlopt.clambda.reference create mode 100644 testsuite/tests/formatting/test_locations.dno-locations.ocamlopt.flambda.reference create mode 100644 testsuite/tests/formatting/test_locations.ml create mode 100644 testsuite/tests/functors/functors.compilers.reference create mode 100644 testsuite/tests/functors/functors.ml create mode 100644 testsuite/tests/gc-roots/globroots.ml create mode 100644 testsuite/tests/gc-roots/globroots.reference create mode 100644 testsuite/tests/gc-roots/globrootsprim.c create mode 100644 testsuite/tests/generalized-open/accepted_batch.ml create mode 100644 testsuite/tests/generalized-open/accepted_batch.reference create mode 100644 testsuite/tests/generalized-open/accepted_expect.ml create mode 100644 testsuite/tests/generalized-open/clambda_optim.ml create mode 100644 testsuite/tests/generalized-open/expansiveness.ml create mode 100644 testsuite/tests/generalized-open/funct_body.compilers.reference create mode 100644 testsuite/tests/generalized-open/funct_body.ml create mode 100644 testsuite/tests/generalized-open/gpr1506.ml create mode 100644 testsuite/tests/generalized-open/shadowing.ml create mode 100644 testsuite/tests/instrumented-runtime/main.ml create mode 100644 testsuite/tests/instrumented-runtime/main.run create mode 100644 testsuite/tests/int64-unboxing/stubs.c create mode 100644 testsuite/tests/int64-unboxing/test.ml create mode 100644 testsuite/tests/int64-unboxing/test.reference create mode 100644 testsuite/tests/lazy/lazy1.ml create mode 100644 testsuite/tests/lazy/lazy1.reference create mode 100644 testsuite/tests/let-syntax/let_syntax.ml create mode 100644 testsuite/tests/letrec-check/basic.ml create mode 100644 testsuite/tests/letrec-check/extension_constructor.ml create mode 100644 testsuite/tests/letrec-check/flat_float_array.ml create mode 100644 testsuite/tests/letrec-check/float_unboxing.ml create mode 100644 testsuite/tests/letrec-check/labels.ml create mode 100644 testsuite/tests/letrec-check/lazy_.ml create mode 100644 testsuite/tests/letrec-check/modules.ml create mode 100644 testsuite/tests/letrec-check/no_flat_float_array.ml create mode 100644 testsuite/tests/letrec-check/objects.ml create mode 100644 testsuite/tests/letrec-check/pr7215.ml create mode 100644 testsuite/tests/letrec-check/pr7215.ocaml.reference create mode 100644 testsuite/tests/letrec-check/pr7231.ml create mode 100644 testsuite/tests/letrec-check/pr7231.ocaml.reference create mode 100644 testsuite/tests/letrec-check/pr7706.ml create mode 100644 testsuite/tests/letrec-check/pr7706.ocaml.reference create mode 100644 testsuite/tests/letrec-check/records.ml create mode 100644 testsuite/tests/letrec-check/unboxed.ml create mode 100644 testsuite/tests/letrec-compilation/backreferences.ml create mode 100644 testsuite/tests/letrec-compilation/backreferences.reference create mode 100644 testsuite/tests/letrec-compilation/class_1.ml create mode 100644 testsuite/tests/letrec-compilation/class_1.reference create mode 100644 testsuite/tests/letrec-compilation/class_2.ml create mode 100644 testsuite/tests/letrec-compilation/class_2.reference create mode 100644 testsuite/tests/letrec-compilation/evaluation_order_1.ml create mode 100644 testsuite/tests/letrec-compilation/evaluation_order_1.reference create mode 100644 testsuite/tests/letrec-compilation/evaluation_order_2.ml create mode 100644 testsuite/tests/letrec-compilation/evaluation_order_2.reference create mode 100644 testsuite/tests/letrec-compilation/evaluation_order_3.ml create mode 100644 testsuite/tests/letrec-compilation/evaluation_order_3.reference create mode 100644 testsuite/tests/letrec-compilation/float_block_1.ml create mode 100644 testsuite/tests/letrec-compilation/float_block_1.reference create mode 100644 testsuite/tests/letrec-compilation/generic_array.ml create mode 100644 testsuite/tests/letrec-compilation/generic_array.reference create mode 100644 testsuite/tests/letrec-compilation/labels.ml create mode 100644 testsuite/tests/letrec-compilation/labels.reference create mode 100644 testsuite/tests/letrec-compilation/lazy_.ml create mode 100644 testsuite/tests/letrec-compilation/lazy_.reference create mode 100644 testsuite/tests/letrec-compilation/lists.ml create mode 100644 testsuite/tests/letrec-compilation/lists.reference create mode 100644 testsuite/tests/letrec-compilation/mixing_value_closures_1.ml create mode 100644 testsuite/tests/letrec-compilation/mixing_value_closures_1.reference create mode 100644 testsuite/tests/letrec-compilation/mixing_value_closures_2.ml create mode 100644 testsuite/tests/letrec-compilation/mixing_value_closures_2.reference create mode 100644 testsuite/tests/letrec-compilation/mutual_functions.ml create mode 100644 testsuite/tests/letrec-compilation/mutual_functions.reference create mode 100644 testsuite/tests/letrec-compilation/nested.ml create mode 100644 testsuite/tests/letrec-compilation/nested.reference create mode 100644 testsuite/tests/letrec-compilation/pr4989.ml create mode 100644 testsuite/tests/letrec-compilation/pr4989.reference create mode 100644 testsuite/tests/letrec-compilation/pr8681.ml create mode 100644 testsuite/tests/letrec-compilation/pr8681.reference create mode 100644 testsuite/tests/letrec-compilation/record_with.ml create mode 100644 testsuite/tests/letrec-compilation/record_with.reference create mode 100644 testsuite/tests/letrec-compilation/ref.ml create mode 100644 testsuite/tests/letrec-compilation/ref.reference create mode 100644 testsuite/tests/lexing/comments.ml create mode 100644 testsuite/tests/lexing/comments.ocaml.reference create mode 100644 testsuite/tests/lexing/escape.ml create mode 100644 testsuite/tests/lexing/escape.ocaml.reference create mode 100644 testsuite/tests/lexing/uchar_esc.ml create mode 100644 testsuite/tests/lexing/uchar_esc.ocaml.reference create mode 100644 testsuite/tests/lib-arg/testarg.ml create mode 100644 testsuite/tests/lib-arg/testarg.reference create mode 100644 testsuite/tests/lib-arg/testerror.ml create mode 100644 testsuite/tests/lib-arg/testerror.reference create mode 100644 testsuite/tests/lib-array/test_array.ml create mode 100644 testsuite/tests/lib-bigarray-2/bigarrf.f create mode 100644 testsuite/tests/lib-bigarray-2/bigarrfml.ml create mode 100644 testsuite/tests/lib-bigarray-2/bigarrfml.reference create mode 100644 testsuite/tests/lib-bigarray-2/bigarrfstub.c create mode 100644 testsuite/tests/lib-bigarray-2/has-gfortran.sh create mode 100644 testsuite/tests/lib-bigarray-file/mapfile.ml create mode 100644 testsuite/tests/lib-bigarray-file/mapfile.reference create mode 100644 testsuite/tests/lib-bigarray/bigarrays.ml create mode 100644 testsuite/tests/lib-bigarray/bigarrays.reference create mode 100644 testsuite/tests/lib-bigarray/change_layout.ml create mode 100644 testsuite/tests/lib-bigarray/change_layout.reference create mode 100644 testsuite/tests/lib-bigarray/fftba.ml create mode 100644 testsuite/tests/lib-bigarray/fftba.reference create mode 100644 testsuite/tests/lib-bigarray/pr5115.ml create mode 100644 testsuite/tests/lib-bigarray/pr5115.reference create mode 100644 testsuite/tests/lib-bigarray/weak_bigarray.ml create mode 100644 testsuite/tests/lib-bigarray/weak_bigarray.reference create mode 100644 testsuite/tests/lib-bool/test.ml create mode 100644 testsuite/tests/lib-bool/test.reference create mode 100644 testsuite/tests/lib-buffer/test.ml create mode 100644 testsuite/tests/lib-buffer/test.reference create mode 100644 testsuite/tests/lib-bytes/binary.ml create mode 100644 testsuite/tests/lib-bytes/test_bytes.ml create mode 100644 testsuite/tests/lib-bytes/test_bytes.reference create mode 100644 testsuite/tests/lib-digest/md5.ml create mode 100644 testsuite/tests/lib-digest/md5.reference create mode 100644 testsuite/tests/lib-dynlink-bytecode/custom.reference create mode 100644 testsuite/tests/lib-dynlink-bytecode/main.ml create mode 100644 testsuite/tests/lib-dynlink-bytecode/main.reference create mode 100644 testsuite/tests/lib-dynlink-bytecode/plug1.ml create mode 100644 testsuite/tests/lib-dynlink-bytecode/plug2.ml create mode 100644 testsuite/tests/lib-dynlink-bytecode/registry.ml create mode 100644 testsuite/tests/lib-dynlink-bytecode/static.reference create mode 100644 testsuite/tests/lib-dynlink-bytecode/stub1.c create mode 100644 testsuite/tests/lib-dynlink-bytecode/stub2.c create mode 100644 testsuite/tests/lib-dynlink-csharp/entry.c create mode 100644 testsuite/tests/lib-dynlink-csharp/main.bytecode.reference create mode 100644 testsuite/tests/lib-dynlink-csharp/main.cs create mode 100644 testsuite/tests/lib-dynlink-csharp/main.ml create mode 100644 testsuite/tests/lib-dynlink-csharp/main.native.reference create mode 100644 testsuite/tests/lib-dynlink-csharp/plugin.ml create mode 100755 testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference create mode 100644 testsuite/tests/lib-dynlink-initializers/test10_main.ml create mode 100755 testsuite/tests/lib-dynlink-initializers/test10_main.native.reference create mode 100644 testsuite/tests/lib-dynlink-initializers/test10_plugin.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test1_inited_second.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test1_main.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test1_plugin.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test2_inited_first.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test2_main.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test2_plugin.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test3_main.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test3_plugin_a.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test3_plugin_b.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test4_main.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test4_plugin_a.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test4_plugin_b.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test5_main.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test5_plugin_a.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test5_plugin_b.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test5_second_plugin.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test6_main.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test6_plugin.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test6_second_plugin.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test7_interface_only.mli create mode 100644 testsuite/tests/lib-dynlink-initializers/test7_main.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test7_plugin.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test8_main.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test8_plugin_a.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test8_plugin_b.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test8_plugin_b.mli create mode 100644 testsuite/tests/lib-dynlink-initializers/test9_main.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test9_plugin.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test9_second_plugin.ml create mode 100644 testsuite/tests/lib-dynlink-initializers/test9_second_plugin.mli create mode 100644 testsuite/tests/lib-dynlink-native/a.ml create mode 100644 testsuite/tests/lib-dynlink-native/api.ml create mode 100644 testsuite/tests/lib-dynlink-native/b.ml create mode 100644 testsuite/tests/lib-dynlink-native/bug.ml create mode 100644 testsuite/tests/lib-dynlink-native/c.ml create mode 100644 testsuite/tests/lib-dynlink-native/factorial.c create mode 100644 testsuite/tests/lib-dynlink-native/main.ml create mode 100644 testsuite/tests/lib-dynlink-native/main.reference create mode 100644 testsuite/tests/lib-dynlink-native/pack_client.ml create mode 100644 testsuite/tests/lib-dynlink-native/packed1.ml create mode 100644 testsuite/tests/lib-dynlink-native/packed1_client.ml create mode 100644 testsuite/tests/lib-dynlink-native/plugin.ml create mode 100644 testsuite/tests/lib-dynlink-native/plugin.mli create mode 100644 testsuite/tests/lib-dynlink-native/plugin2.ml create mode 100644 testsuite/tests/lib-dynlink-native/plugin4.ml create mode 100644 testsuite/tests/lib-dynlink-native/plugin_ext.ml create mode 100644 testsuite/tests/lib-dynlink-native/plugin_high_arity.ml create mode 100644 testsuite/tests/lib-dynlink-native/plugin_ref.ml create mode 100644 testsuite/tests/lib-dynlink-native/plugin_simple.ml create mode 100644 testsuite/tests/lib-dynlink-native/plugin_thread.ml create mode 100644 testsuite/tests/lib-dynlink-native/sub/api.ml create mode 100644 testsuite/tests/lib-dynlink-native/sub/api.mli create mode 100644 testsuite/tests/lib-dynlink-native/sub/plugin.ml create mode 100644 testsuite/tests/lib-dynlink-native/sub/plugin3.ml create mode 100644 testsuite/tests/lib-dynlink-packed/a.ml create mode 100644 testsuite/tests/lib-dynlink-packed/b.ml create mode 100644 testsuite/tests/lib-dynlink-packed/byte.reference create mode 100644 testsuite/tests/lib-dynlink-packed/loader.ml create mode 100644 testsuite/tests/lib-dynlink-packed/native.reference create mode 100644 testsuite/tests/lib-dynlink-pr4229/abstract.ml create mode 100644 testsuite/tests/lib-dynlink-pr4229/abstract.mli create mode 100644 testsuite/tests/lib-dynlink-pr4229/client.ml create mode 100644 testsuite/tests/lib-dynlink-pr4229/main.ml create mode 100644 testsuite/tests/lib-dynlink-pr4229/main.reference create mode 100644 testsuite/tests/lib-dynlink-pr4229/static.ml create mode 100644 testsuite/tests/lib-dynlink-pr4229/sub/abstract.ml create mode 100644 testsuite/tests/lib-dynlink-pr4229/sub/abstract.mli create mode 100644 testsuite/tests/lib-dynlink-pr4839/byte.plugin1.reference create mode 100644 testsuite/tests/lib-dynlink-pr4839/byte.plugin2.reference create mode 100644 testsuite/tests/lib-dynlink-pr4839/byte.plugin3.reference create mode 100644 testsuite/tests/lib-dynlink-pr4839/byte.plugin4.reference create mode 100644 testsuite/tests/lib-dynlink-pr4839/host/api.ml create mode 100644 testsuite/tests/lib-dynlink-pr4839/host/api.mli create mode 100644 testsuite/tests/lib-dynlink-pr4839/host/host.ml create mode 100644 testsuite/tests/lib-dynlink-pr4839/native.plugin1.reference create mode 100644 testsuite/tests/lib-dynlink-pr4839/native.plugin2.reference create mode 100644 testsuite/tests/lib-dynlink-pr4839/native.plugin3.reference create mode 100644 testsuite/tests/lib-dynlink-pr4839/native.plugin4.reference create mode 100644 testsuite/tests/lib-dynlink-pr4839/plugin1/api.ml create mode 100644 testsuite/tests/lib-dynlink-pr4839/plugin1/api.mli create mode 100644 testsuite/tests/lib-dynlink-pr4839/plugin1/plugin.ml create mode 100644 testsuite/tests/lib-dynlink-pr4839/plugin2/api.ml create mode 100644 testsuite/tests/lib-dynlink-pr4839/plugin2/api.mli create mode 100644 testsuite/tests/lib-dynlink-pr4839/plugin2/plugin.ml create mode 100644 testsuite/tests/lib-dynlink-pr4839/plugin3/api.ml create mode 100644 testsuite/tests/lib-dynlink-pr4839/plugin3/api.mli create mode 100644 testsuite/tests/lib-dynlink-pr4839/plugin3/plugin.ml create mode 100644 testsuite/tests/lib-dynlink-pr4839/plugin4/api.ml create mode 100644 testsuite/tests/lib-dynlink-pr4839/plugin4/api.mli create mode 100644 testsuite/tests/lib-dynlink-pr4839/plugin4/plugin.ml create mode 100644 testsuite/tests/lib-dynlink-pr4839/test.ml create mode 100644 testsuite/tests/lib-dynlink-pr6950/b.ml create mode 100644 testsuite/tests/lib-dynlink-pr6950/byte.reference create mode 100644 testsuite/tests/lib-dynlink-pr6950/config.ml create mode 100644 testsuite/tests/lib-dynlink-pr6950/loader.ml create mode 100644 testsuite/tests/lib-dynlink-pr6950/native.reference create mode 100644 testsuite/tests/lib-dynlink-pr9209/dyn.ml create mode 100644 testsuite/tests/lib-dynlink-pr9209/lib.ml create mode 100644 testsuite/tests/lib-dynlink-pr9209/lib2.ml create mode 100644 testsuite/tests/lib-dynlink-pr9209/main.reference create mode 100644 testsuite/tests/lib-dynlink-pr9209/ocamltests create mode 100644 testsuite/tests/lib-dynlink-pr9209/test.c create mode 100644 testsuite/tests/lib-dynlink-private/pig.mli create mode 100644 testsuite/tests/lib-dynlink-private/plugin1/sheep.ml create mode 100644 testsuite/tests/lib-dynlink-private/plugin1/sheep.mli create mode 100644 testsuite/tests/lib-dynlink-private/plugin2/cow.ml create mode 100644 testsuite/tests/lib-dynlink-private/plugin2/cow.mli create mode 100644 testsuite/tests/lib-dynlink-private/plugin2b/cow.ml create mode 100644 testsuite/tests/lib-dynlink-private/plugin2b/cow.mli create mode 100644 testsuite/tests/lib-dynlink-private/plugin2c/cow.ml create mode 100644 testsuite/tests/lib-dynlink-private/plugin2c/cow.mli create mode 100644 testsuite/tests/lib-dynlink-private/plugin3/pig.ml create mode 100644 testsuite/tests/lib-dynlink-private/plugin3/pig.mli create mode 100644 testsuite/tests/lib-dynlink-private/plugin4/chicken.ml create mode 100644 testsuite/tests/lib-dynlink-private/plugin4/chicken.mli create mode 100644 testsuite/tests/lib-dynlink-private/plugin5/chicken.ml create mode 100644 testsuite/tests/lib-dynlink-private/plugin5/chicken.mli create mode 100644 testsuite/tests/lib-dynlink-private/plugin6/partridge.ml create mode 100644 testsuite/tests/lib-dynlink-private/plugin6/partridge.mli create mode 100644 testsuite/tests/lib-dynlink-private/plugin6/pheasant.ml create mode 100644 testsuite/tests/lib-dynlink-private/plugin6/pheasant.mli create mode 100644 testsuite/tests/lib-dynlink-private/sheep.ml create mode 100644 testsuite/tests/lib-dynlink-private/sheep.mli create mode 100644 testsuite/tests/lib-dynlink-private/test.ml create mode 100644 testsuite/tests/lib-filename/extension.ml create mode 100644 testsuite/tests/lib-filename/extension.reference create mode 100644 testsuite/tests/lib-filename/myecho.ml create mode 100644 testsuite/tests/lib-filename/null.ml create mode 100644 testsuite/tests/lib-filename/quotecommand.ml create mode 100644 testsuite/tests/lib-filename/quotecommand.reference create mode 100644 testsuite/tests/lib-filename/suffix.ml create mode 100644 testsuite/tests/lib-filename/suffix.reference create mode 100644 testsuite/tests/lib-float/test.ml create mode 100644 testsuite/tests/lib-float/test.reference create mode 100644 testsuite/tests/lib-floatarray/floatarray.ml create mode 100644 testsuite/tests/lib-format/pp_print_custom_break.ml create mode 100644 testsuite/tests/lib-format/pp_print_custom_break.reference create mode 100644 testsuite/tests/lib-format/pr6824.ml create mode 100644 testsuite/tests/lib-format/pr6824.reference create mode 100644 testsuite/tests/lib-format/print_if_newline.ml create mode 100644 testsuite/tests/lib-format/print_if_newline.reference create mode 100644 testsuite/tests/lib-format/tformat.ml create mode 100644 testsuite/tests/lib-format/tformat.reference create mode 100644 testsuite/tests/lib-fun/test.ml create mode 100644 testsuite/tests/lib-fun/test.reference create mode 100644 testsuite/tests/lib-hashtbl/hfun.ml create mode 100644 testsuite/tests/lib-hashtbl/hfun.reference create mode 100644 testsuite/tests/lib-hashtbl/htbl.ml create mode 100644 testsuite/tests/lib-hashtbl/htbl.reference create mode 100644 testsuite/tests/lib-int/test.ml create mode 100644 testsuite/tests/lib-int/test.reference create mode 100644 testsuite/tests/lib-int64/issue9460.ml create mode 100644 testsuite/tests/lib-int64/issue9460.reference create mode 100644 testsuite/tests/lib-int64/test.ml create mode 100644 testsuite/tests/lib-int64/test.reference create mode 100644 testsuite/tests/lib-internalformat/test.ml create mode 100644 testsuite/tests/lib-list/test.ml create mode 100644 testsuite/tests/lib-list/test.reference create mode 100644 testsuite/tests/lib-marshal/intern_final.ml create mode 100644 testsuite/tests/lib-marshal/intern_final.reference create mode 100644 testsuite/tests/lib-marshal/intext.ml create mode 100644 testsuite/tests/lib-marshal/intext.reference create mode 100644 testsuite/tests/lib-marshal/intextaux.c create mode 100644 testsuite/tests/lib-marshal/marshal_bigarray.ml create mode 100644 testsuite/tests/lib-marshal/marshal_bigarray.reference create mode 100644 testsuite/tests/lib-obj/reachable_words.ml create mode 100644 testsuite/tests/lib-obj/reachable_words.reference create mode 100644 testsuite/tests/lib-obj/with_tag.ml create mode 100644 testsuite/tests/lib-obj/with_tag.reference create mode 100644 testsuite/tests/lib-option/test.ml create mode 100644 testsuite/tests/lib-option/test.reference create mode 100644 testsuite/tests/lib-printf/pr6534.ml create mode 100644 testsuite/tests/lib-printf/pr6534.reference create mode 100644 testsuite/tests/lib-printf/pr6938.ml create mode 100644 testsuite/tests/lib-printf/pr6938.reference create mode 100644 testsuite/tests/lib-printf/tprintf.ml create mode 100644 testsuite/tests/lib-printf/tprintf.reference create mode 100644 testsuite/tests/lib-queue/test.ml create mode 100644 testsuite/tests/lib-queue/test.reference create mode 100644 testsuite/tests/lib-random/rand.ml create mode 100644 testsuite/tests/lib-random/rand.reference create mode 100644 testsuite/tests/lib-result/test.ml create mode 100644 testsuite/tests/lib-result/test.reference create mode 100644 testsuite/tests/lib-scanf-2/tscanf2.reference create mode 100644 testsuite/tests/lib-scanf-2/tscanf2_io.ml create mode 100644 testsuite/tests/lib-scanf-2/tscanf2_master.ml create mode 100644 testsuite/tests/lib-scanf-2/tscanf2_worker.ml create mode 100644 testsuite/tests/lib-scanf/tscanf.ml create mode 100644 testsuite/tests/lib-scanf/tscanf.reference create mode 100644 testsuite/tests/lib-seq/test.ml create mode 100644 testsuite/tests/lib-seq/test.reference create mode 100644 testsuite/tests/lib-set/testmap.ml create mode 100644 testsuite/tests/lib-set/testmap.reference create mode 100644 testsuite/tests/lib-set/testset.ml create mode 100644 testsuite/tests/lib-set/testset.reference create mode 100644 testsuite/tests/lib-stack/test.ml create mode 100644 testsuite/tests/lib-stack/test.reference create mode 100644 testsuite/tests/lib-stdlabels/test_stdlabels.ml create mode 100644 testsuite/tests/lib-stdlabels/test_stdlabels.reference create mode 100644 testsuite/tests/lib-stdlib/pervasives_deprecated.ml create mode 100644 testsuite/tests/lib-str/t01.ml create mode 100644 testsuite/tests/lib-str/t01.reference create mode 100644 testsuite/tests/lib-stream/count_concat_bug.ml create mode 100644 testsuite/tests/lib-stream/count_concat_bug.reference create mode 100644 testsuite/tests/lib-stream/mpr7769.ml create mode 100644 testsuite/tests/lib-stream/mpr7769.reference create mode 100644 testsuite/tests/lib-stream/mpr7769.txt create mode 100644 testsuite/tests/lib-string/test_string.ml create mode 100644 testsuite/tests/lib-string/test_string.reference create mode 100644 testsuite/tests/lib-sys/immediate64.ml create mode 100644 testsuite/tests/lib-sys/rename.ml create mode 100644 testsuite/tests/lib-sys/rename.reference create mode 100644 testsuite/tests/lib-systhreads/testfork.ml create mode 100644 testsuite/tests/lib-systhreads/testfork.reference create mode 100644 testsuite/tests/lib-systhreads/testpreempt.ml create mode 100644 testsuite/tests/lib-systhreads/testpreempt.reference create mode 100644 testsuite/tests/lib-systhreads/testyield.ml create mode 100644 testsuite/tests/lib-systhreads/threadsigmask.ml create mode 100644 testsuite/tests/lib-systhreads/threadsigmask.reference create mode 100644 testsuite/tests/lib-threads/backtrace_threads.ml create mode 100644 testsuite/tests/lib-threads/bank.ml create mode 100644 testsuite/tests/lib-threads/bank.reference create mode 100644 testsuite/tests/lib-threads/beat.ml create mode 100644 testsuite/tests/lib-threads/beat.reference create mode 100644 testsuite/tests/lib-threads/bufchan.ml create mode 100644 testsuite/tests/lib-threads/bufchan.reference create mode 100644 testsuite/tests/lib-threads/close.ml create mode 100644 testsuite/tests/lib-threads/close.reference create mode 100644 testsuite/tests/lib-threads/delayintr.ml create mode 100644 testsuite/tests/lib-threads/delayintr.reference create mode 100644 testsuite/tests/lib-threads/delayintr.run create mode 100644 testsuite/tests/lib-threads/fileio.ml create mode 100644 testsuite/tests/lib-threads/fileio.reference create mode 100644 testsuite/tests/lib-threads/pr4466.ml create mode 100644 testsuite/tests/lib-threads/pr4466.reference create mode 100644 testsuite/tests/lib-threads/pr5325.ml create mode 100644 testsuite/tests/lib-threads/pr5325.reference create mode 100644 testsuite/tests/lib-threads/pr7638.ml create mode 100644 testsuite/tests/lib-threads/pr7638.reference create mode 100644 testsuite/tests/lib-threads/prodcons.ml create mode 100644 testsuite/tests/lib-threads/prodcons.reference create mode 100644 testsuite/tests/lib-threads/prodcons2.ml create mode 100644 testsuite/tests/lib-threads/prodcons2.reference create mode 100644 testsuite/tests/lib-threads/sieve.ml create mode 100644 testsuite/tests/lib-threads/sieve.reference create mode 100644 testsuite/tests/lib-threads/sigint.c create mode 100644 testsuite/tests/lib-threads/signal.check-program-output create mode 100644 testsuite/tests/lib-threads/signal.ml create mode 100644 testsuite/tests/lib-threads/signal.run create mode 100644 testsuite/tests/lib-threads/sockets.ml create mode 100644 testsuite/tests/lib-threads/sockets.reference create mode 100644 testsuite/tests/lib-threads/swapchan.ml create mode 100644 testsuite/tests/lib-threads/swapchan.reference create mode 100644 testsuite/tests/lib-threads/swapchan.run create mode 100644 testsuite/tests/lib-threads/tls.ml create mode 100644 testsuite/tests/lib-threads/tls.reference create mode 100644 testsuite/tests/lib-threads/tls.run create mode 100644 testsuite/tests/lib-threads/torture.ml create mode 100644 testsuite/tests/lib-threads/torture.reference create mode 100644 testsuite/tests/lib-uchar/test.ml create mode 100644 testsuite/tests/lib-uchar/test.reference create mode 100644 testsuite/tests/lib-unix/common/channel_of.ml create mode 100644 testsuite/tests/lib-unix/common/channel_of.reference create mode 100644 testsuite/tests/lib-unix/common/cloexec.ml create mode 100644 testsuite/tests/lib-unix/common/cloexec.reference create mode 100644 testsuite/tests/lib-unix/common/cmdline_prog.ml create mode 100644 testsuite/tests/lib-unix/common/dup.ml create mode 100644 testsuite/tests/lib-unix/common/dup.reference create mode 100644 testsuite/tests/lib-unix/common/dup2.ml create mode 100644 testsuite/tests/lib-unix/common/dup2.reference create mode 100644 testsuite/tests/lib-unix/common/fdstatus_aux.c create mode 100644 testsuite/tests/lib-unix/common/fdstatus_main.ml create mode 100644 testsuite/tests/lib-unix/common/getaddrinfo.ml create mode 100644 testsuite/tests/lib-unix/common/pipe_eof.ml create mode 100644 testsuite/tests/lib-unix/common/pipe_eof.reference create mode 100644 testsuite/tests/lib-unix/common/process_pid.ml create mode 100644 testsuite/tests/lib-unix/common/process_pid.reference create mode 100644 testsuite/tests/lib-unix/common/redirections.ml create mode 100644 testsuite/tests/lib-unix/common/redirections.reference create mode 100644 testsuite/tests/lib-unix/common/reflector.ml create mode 100644 testsuite/tests/lib-unix/common/rename.ml create mode 100644 testsuite/tests/lib-unix/common/rename.reference create mode 100644 testsuite/tests/lib-unix/common/test_unix_cmdline.ml create mode 100644 testsuite/tests/lib-unix/common/test_unix_cmdline.reference create mode 100644 testsuite/tests/lib-unix/common/truncate.ml create mode 100644 testsuite/tests/lib-unix/common/truncate.reference create mode 100644 testsuite/tests/lib-unix/common/utimes.ml create mode 100644 testsuite/tests/lib-unix/common/utimes.reference create mode 100644 testsuite/tests/lib-unix/common/utimes.txt create mode 100644 testsuite/tests/lib-unix/common/wait_nohang.ml create mode 100644 testsuite/tests/lib-unix/common/wait_nohang.reference create mode 100644 testsuite/tests/lib-unix/isatty/isatty_std.ml create mode 100644 testsuite/tests/lib-unix/isatty/isatty_std.reference create mode 100644 testsuite/tests/lib-unix/isatty/isatty_tty.ml create mode 100644 testsuite/tests/lib-unix/isatty/isatty_tty.reference create mode 100644 testsuite/tests/lib-unix/unix-execvpe/exec.ml create mode 100644 testsuite/tests/lib-unix/unix-execvpe/exec.reference create mode 100755 testsuite/tests/lib-unix/unix-execvpe/exec.run create mode 100755 testsuite/tests/lib-unix/unix-execvpe/has-execvpe.sh create mode 100755 testsuite/tests/lib-unix/unix-execvpe/script3 create mode 100644 testsuite/tests/lib-unix/unix-execvpe/subdir/nonexec create mode 100755 testsuite/tests/lib-unix/unix-execvpe/subdir/script1 create mode 100755 testsuite/tests/lib-unix/unix-execvpe/subdir/script2 create mode 100755 testsuite/tests/lib-unix/unix-socket/is-linux.sh create mode 100644 testsuite/tests/lib-unix/unix-socket/recvfrom.ml create mode 100644 testsuite/tests/lib-unix/unix-socket/recvfrom_linux.ml create mode 100644 testsuite/tests/lib-unix/unix-socket/recvfrom_linux.reference create mode 100644 testsuite/tests/lib-unix/unix-socket/recvfrom_unix.ml create mode 100644 testsuite/tests/lib-unix/unix-socket/recvfrom_unix.reference create mode 100644 testsuite/tests/lib-unix/win-env/stubs.c create mode 100644 testsuite/tests/lib-unix/win-env/test_env.ml create mode 100644 testsuite/tests/lib-unix/win-env/test_env.reference create mode 100644 testsuite/tests/lib-unix/win-stat/fakeclock.c create mode 100644 testsuite/tests/lib-unix/win-stat/test.ml create mode 100644 testsuite/tests/lib-unix/win-stat/test.reference create mode 100644 testsuite/tests/lib-unix/win-stat/test.run create mode 100644 testsuite/tests/lib-unix/win-symlink/test.ml create mode 100644 testsuite/tests/lib-unix/win-symlink/test.reference create mode 100644 testsuite/tests/link-test/aliases.ml create mode 100644 testsuite/tests/link-test/external.ml create mode 100644 testsuite/tests/link-test/external.mli create mode 100644 testsuite/tests/link-test/external_for_pack.ml create mode 100644 testsuite/tests/link-test/external_for_pack.mli create mode 100644 testsuite/tests/link-test/submodule.ml create mode 100644 testsuite/tests/link-test/test.ml create mode 100644 testsuite/tests/link-test/test.reference create mode 100644 testsuite/tests/link-test/use_in_pack.ml create mode 100644 testsuite/tests/local-functions/tupled.ml create mode 100644 testsuite/tests/local-functions/tupled2.ml create mode 100644 testsuite/tests/locale/stubs.c create mode 100644 testsuite/tests/locale/test.ml create mode 100644 testsuite/tests/locale/test.reference create mode 100644 testsuite/tests/manual-intf-c/curses.ml create mode 100644 testsuite/tests/manual-intf-c/curses_stubs.c create mode 100644 testsuite/tests/manual-intf-c/prog.ml create mode 100644 testsuite/tests/manual-intf-c/prog2.reference create mode 100644 testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml create mode 100644 testsuite/tests/match-exception-warnings/no_mixing_under_guard.ml create mode 100644 testsuite/tests/match-exception-warnings/no_value_clauses.ml create mode 100644 testsuite/tests/match-exception-warnings/placement.ml create mode 100644 testsuite/tests/match-exception-warnings/pr7083.ml create mode 100644 testsuite/tests/match-exception-warnings/reachability.ml create mode 100644 testsuite/tests/match-exception/allocation.ml create mode 100644 testsuite/tests/match-exception/allocation.reference create mode 100644 testsuite/tests/match-exception/exception_propagation.ml create mode 100644 testsuite/tests/match-exception/exception_propagation.reference create mode 100644 testsuite/tests/match-exception/identifier_sharing.ml create mode 100644 testsuite/tests/match-exception/identifier_sharing.reference create mode 100644 testsuite/tests/match-exception/match_failure.ml create mode 100644 testsuite/tests/match-exception/match_failure.reference create mode 100644 testsuite/tests/match-exception/nested_handlers.ml create mode 100644 testsuite/tests/match-exception/nested_handlers.reference create mode 100644 testsuite/tests/match-exception/raise_from_success_continuation.ml create mode 100644 testsuite/tests/match-exception/raise_from_success_continuation.reference create mode 100644 testsuite/tests/match-exception/streams.ml create mode 100644 testsuite/tests/match-exception/streams.reference create mode 100644 testsuite/tests/match-exception/tail_calls.ml create mode 100644 testsuite/tests/match-exception/tail_calls.reference create mode 100644 testsuite/tests/messages/precise_locations.ml create mode 100644 testsuite/tests/misc-kb/equations.ml create mode 100644 testsuite/tests/misc-kb/equations.mli create mode 100644 testsuite/tests/misc-kb/kb.ml create mode 100644 testsuite/tests/misc-kb/kb.mli create mode 100644 testsuite/tests/misc-kb/kbmain.ml create mode 100644 testsuite/tests/misc-kb/kbmain.reference create mode 100644 testsuite/tests/misc-kb/orderings.ml create mode 100644 testsuite/tests/misc-kb/orderings.mli create mode 100644 testsuite/tests/misc-kb/terms.ml create mode 100644 testsuite/tests/misc-kb/terms.mli create mode 100644 testsuite/tests/misc-unsafe/almabench.ml create mode 100644 testsuite/tests/misc-unsafe/almabench.reference create mode 100644 testsuite/tests/misc-unsafe/fft.ml create mode 100644 testsuite/tests/misc-unsafe/fft.reference create mode 100644 testsuite/tests/misc-unsafe/quicksort.ml create mode 100644 testsuite/tests/misc-unsafe/quicksort.reference create mode 100644 testsuite/tests/misc-unsafe/soli.ml create mode 100644 testsuite/tests/misc-unsafe/soli.reference create mode 100644 testsuite/tests/misc/bdd.ml create mode 100644 testsuite/tests/misc/bdd.reference create mode 100644 testsuite/tests/misc/boyer.ml create mode 100644 testsuite/tests/misc/boyer.reference create mode 100644 testsuite/tests/misc/ephetest.ml create mode 100644 testsuite/tests/misc/ephetest.reference create mode 100644 testsuite/tests/misc/ephetest2.ml create mode 100644 testsuite/tests/misc/ephetest2.reference create mode 100644 testsuite/tests/misc/ephetest3.ml create mode 100644 testsuite/tests/misc/ephetest3.reference create mode 100644 testsuite/tests/misc/exotic.ml create mode 100644 testsuite/tests/misc/fib.ml create mode 100644 testsuite/tests/misc/fib.reference create mode 100644 testsuite/tests/misc/finaliser.ml create mode 100644 testsuite/tests/misc/finaliser.reference create mode 100644 testsuite/tests/misc/gcwords.ml create mode 100644 testsuite/tests/misc/gcwords.reference create mode 100644 testsuite/tests/misc/gpr1370.ml create mode 100644 testsuite/tests/misc/gpr1370.reference create mode 100644 testsuite/tests/misc/hamming.ml create mode 100644 testsuite/tests/misc/hamming.reference create mode 100644 testsuite/tests/misc/nucleic.ml create mode 100644 testsuite/tests/misc/nucleic.reference create mode 100644 testsuite/tests/misc/pr7168.ml create mode 100644 testsuite/tests/misc/pr7168.reference create mode 100644 testsuite/tests/misc/sieve.ml create mode 100644 testsuite/tests/misc/sieve.reference create mode 100644 testsuite/tests/misc/sorts.ml create mode 100644 testsuite/tests/misc/sorts.reference create mode 100644 testsuite/tests/misc/takc.ml create mode 100644 testsuite/tests/misc/takc.reference create mode 100644 testsuite/tests/misc/taku.ml create mode 100644 testsuite/tests/misc/taku.reference create mode 100644 testsuite/tests/misc/weaklifetime.ml create mode 100644 testsuite/tests/misc/weaklifetime.reference create mode 100644 testsuite/tests/misc/weaklifetime2.ml create mode 100644 testsuite/tests/misc/weaklifetime2.reference create mode 100644 testsuite/tests/misc/weaktest.ml create mode 100644 testsuite/tests/misc/weaktest.reference create mode 100644 testsuite/tests/no-alias-deps/a2235.ml create mode 100644 testsuite/tests/no-alias-deps/aliases.compilers.reference create mode 100644 testsuite/tests/no-alias-deps/aliases.ml create mode 100644 testsuite/tests/no-alias-deps/aliases.reference create mode 100644 testsuite/tests/no-alias-deps/b.cmi.invalid create mode 100644 testsuite/tests/no-alias-deps/c.mli create mode 100644 testsuite/tests/no-alias-deps/d.mli create mode 100644 testsuite/tests/no-alias-deps/gpr2235.ml create mode 100644 testsuite/tests/no-alias-deps/lib2235.ml create mode 100644 testsuite/tests/no-alias-deps/lib__2235.ml create mode 100644 testsuite/tests/no-alias-deps/user_of_lib2235.ml create mode 100644 testsuite/tests/opaque/fst/opaque_impl.ml create mode 100644 testsuite/tests/opaque/fst/opaque_intf.ml create mode 100644 testsuite/tests/opaque/fst/regular.ml create mode 100644 testsuite/tests/opaque/intf/opaque_impl.mli create mode 100644 testsuite/tests/opaque/intf/opaque_intf.mli create mode 100644 testsuite/tests/opaque/intf/regular.mli create mode 100644 testsuite/tests/opaque/snd/opaque_impl.ml create mode 100644 testsuite/tests/opaque/snd/opaque_intf.ml create mode 100644 testsuite/tests/opaque/snd/regular.ml create mode 100644 testsuite/tests/opaque/test.ml create mode 100644 testsuite/tests/output-complete-obj/github9344.ml create mode 100644 testsuite/tests/output-complete-obj/github9344.reference create mode 100644 testsuite/tests/output-complete-obj/github9344.sh create mode 100644 testsuite/tests/output-complete-obj/puts.c create mode 100644 testsuite/tests/output-complete-obj/test.ml create mode 100644 testsuite/tests/output-complete-obj/test.ml_stub.c create mode 100644 testsuite/tests/output-complete-obj/test2.ml create mode 100644 testsuite/tests/output-complete-obj/test2.reference create mode 100644 testsuite/tests/parse-errors/escape_error.compilers.reference create mode 100644 testsuite/tests/parse-errors/escape_error.ml create mode 100644 testsuite/tests/parse-errors/expecting.compilers.reference create mode 100644 testsuite/tests/parse-errors/expecting.ml create mode 100644 testsuite/tests/parse-errors/pr7847.compilers.reference create mode 100644 testsuite/tests/parse-errors/pr7847.ml create mode 100644 testsuite/tests/parse-errors/unclosed_class_signature.compilers.reference create mode 100644 testsuite/tests/parse-errors/unclosed_class_signature.mli create mode 100644 testsuite/tests/parse-errors/unclosed_class_simpl_expr1.compilers.reference create mode 100644 testsuite/tests/parse-errors/unclosed_class_simpl_expr1.ml create mode 100644 testsuite/tests/parse-errors/unclosed_class_simpl_expr2.compilers.reference create mode 100644 testsuite/tests/parse-errors/unclosed_class_simpl_expr2.ml create mode 100644 testsuite/tests/parse-errors/unclosed_class_simpl_expr3.compilers.reference create mode 100644 testsuite/tests/parse-errors/unclosed_class_simpl_expr3.ml create mode 100644 testsuite/tests/parse-errors/unclosed_object.compilers.reference create mode 100644 testsuite/tests/parse-errors/unclosed_object.ml create mode 100644 testsuite/tests/parse-errors/unclosed_paren_module_expr1.compilers.reference create mode 100644 testsuite/tests/parse-errors/unclosed_paren_module_expr1.ml create mode 100644 testsuite/tests/parse-errors/unclosed_paren_module_expr2.compilers.reference create mode 100644 testsuite/tests/parse-errors/unclosed_paren_module_expr2.ml create mode 100644 testsuite/tests/parse-errors/unclosed_paren_module_expr3.compilers.reference create mode 100644 testsuite/tests/parse-errors/unclosed_paren_module_expr3.ml create mode 100644 testsuite/tests/parse-errors/unclosed_paren_module_expr4.compilers.reference create mode 100644 testsuite/tests/parse-errors/unclosed_paren_module_expr4.ml create mode 100644 testsuite/tests/parse-errors/unclosed_paren_module_expr5.compilers.reference create mode 100644 testsuite/tests/parse-errors/unclosed_paren_module_expr5.ml create mode 100644 testsuite/tests/parse-errors/unclosed_paren_module_type.compilers.reference create mode 100644 testsuite/tests/parse-errors/unclosed_paren_module_type.mli create mode 100644 testsuite/tests/parse-errors/unclosed_sig.compilers.reference create mode 100644 testsuite/tests/parse-errors/unclosed_sig.mli create mode 100644 testsuite/tests/parse-errors/unclosed_simple_expr.compilers.reference create mode 100644 testsuite/tests/parse-errors/unclosed_simple_expr.ml create mode 100644 testsuite/tests/parse-errors/unclosed_simple_pattern.compilers.reference create mode 100644 testsuite/tests/parse-errors/unclosed_simple_pattern.ml create mode 100644 testsuite/tests/parse-errors/unclosed_struct.compilers.reference create mode 100644 testsuite/tests/parse-errors/unclosed_struct.ml create mode 100644 testsuite/tests/parsetree/source.ml create mode 100644 testsuite/tests/parsetree/test.ml create mode 100644 testsuite/tests/parsetree/test.reference create mode 100644 testsuite/tests/parsing/anonymous_class_parameter.compilers.reference create mode 100644 testsuite/tests/parsing/anonymous_class_parameter.ml create mode 100644 testsuite/tests/parsing/arrow_ambiguity.compilers.reference create mode 100644 testsuite/tests/parsing/arrow_ambiguity.ml create mode 100644 testsuite/tests/parsing/attributes.compilers.reference create mode 100644 testsuite/tests/parsing/attributes.ml create mode 100644 testsuite/tests/parsing/broken_invariants.compilers.reference create mode 100644 testsuite/tests/parsing/broken_invariants.ml create mode 100644 testsuite/tests/parsing/change_start_loc.ml create mode 100644 testsuite/tests/parsing/change_start_loc.reference create mode 100644 testsuite/tests/parsing/constructor_declarations.compilers.reference create mode 100644 testsuite/tests/parsing/constructor_declarations.ml create mode 100644 testsuite/tests/parsing/docstrings.ml create mode 100644 testsuite/tests/parsing/extended_indexoperators.ml create mode 100644 testsuite/tests/parsing/extensions.compilers.reference create mode 100644 testsuite/tests/parsing/extensions.ml create mode 100644 testsuite/tests/parsing/hash_ambiguity.compilers.reference create mode 100644 testsuite/tests/parsing/hash_ambiguity.ml create mode 100644 testsuite/tests/parsing/illegal_ppx.ml create mode 100644 testsuite/tests/parsing/int_and_float_with_modifier.compilers.reference create mode 100644 testsuite/tests/parsing/int_and_float_with_modifier.ml create mode 100644 testsuite/tests/parsing/multi_indices.ml create mode 100644 testsuite/tests/parsing/pr6604.compilers.reference create mode 100644 testsuite/tests/parsing/pr6604.ml create mode 100644 testsuite/tests/parsing/pr6604_2.compilers.reference create mode 100644 testsuite/tests/parsing/pr6604_2.ml create mode 100644 testsuite/tests/parsing/pr6604_3.compilers.reference create mode 100644 testsuite/tests/parsing/pr6604_3.ml create mode 100644 testsuite/tests/parsing/pr6865.compilers.reference create mode 100644 testsuite/tests/parsing/pr6865.ml create mode 100644 testsuite/tests/parsing/pr7165.compilers.reference create mode 100644 testsuite/tests/parsing/pr7165.ml create mode 100644 testsuite/tests/parsing/quotedextensions.compilers.reference create mode 100644 testsuite/tests/parsing/quotedextensions.ml create mode 100644 testsuite/tests/parsing/reloc.ml create mode 100644 testsuite/tests/parsing/shortcut_ext_attr.compilers.reference create mode 100644 testsuite/tests/parsing/shortcut_ext_attr.ml create mode 100644 testsuite/tests/ppx-attributes/warning.ml create mode 100644 testsuite/tests/ppx-attributes/warning.reference create mode 100644 testsuite/tests/ppx-contexts/myppx.ml create mode 100644 testsuite/tests/ppx-contexts/test.compilers.reference create mode 100644 testsuite/tests/ppx-contexts/test.ml create mode 100644 testsuite/tests/prim-bigstring/bigstring_access.ml create mode 100644 testsuite/tests/prim-bigstring/bigstring_access.reference create mode 100644 testsuite/tests/prim-bigstring/string_access.ml create mode 100644 testsuite/tests/prim-bigstring/string_access.reference create mode 100644 testsuite/tests/prim-bswap/bswap.ml create mode 100644 testsuite/tests/prim-bswap/bswap.reference create mode 100644 testsuite/tests/prim-revapply/apply.ml create mode 100644 testsuite/tests/prim-revapply/apply.reference create mode 100644 testsuite/tests/prim-revapply/revapply.ml create mode 100644 testsuite/tests/prim-revapply/revapply.reference create mode 100644 testsuite/tests/printing-types/disambiguation.ml create mode 100644 testsuite/tests/printing-types/pr248.ml create mode 100644 testsuite/tests/printing-types/pr248.ocaml.reference create mode 100644 testsuite/tests/raise-counts/a.ml create mode 100644 testsuite/tests/raise-counts/b.ml create mode 100644 testsuite/tests/raise-counts/main.ml create mode 100644 testsuite/tests/raise-counts/main.reference create mode 100644 testsuite/tests/regression/gpr1623/gpr1623.ml create mode 100644 testsuite/tests/regression/gpr1623/gpr1623.reference create mode 100644 testsuite/tests/regression/missing_set_of_closures/a.ml create mode 100644 testsuite/tests/regression/missing_set_of_closures/b.ml create mode 100644 testsuite/tests/regression/missing_set_of_closures/b2.ml create mode 100644 testsuite/tests/regression/missing_set_of_closures/dir/c.ml create mode 100644 testsuite/tests/regression/missing_set_of_closures/missing_set_of_closures.ml create mode 100644 testsuite/tests/regression/pr1580/pr1580.ml create mode 100644 testsuite/tests/regression/pr1580/pr1580.reference create mode 100644 testsuite/tests/regression/pr3612/custom_finalize.c create mode 100644 testsuite/tests/regression/pr3612/pr3612.ml create mode 100644 testsuite/tests/regression/pr3612/pr3612.reference create mode 100644 testsuite/tests/regression/pr5233/pr5233.ml create mode 100644 testsuite/tests/regression/pr5233/pr5233.reference create mode 100644 testsuite/tests/regression/pr5757/pr5757.ml create mode 100644 testsuite/tests/regression/pr5757/pr5757.reference create mode 100644 testsuite/tests/regression/pr6024/pr6024.ml create mode 100644 testsuite/tests/regression/pr6024/pr6024.reference create mode 100644 testsuite/tests/regression/pr7042/pr7042.ml create mode 100644 testsuite/tests/regression/pr7042/pr7042.reference create mode 100644 testsuite/tests/regression/pr7426/pr7426.ml create mode 100644 testsuite/tests/regression/pr7426/pr7426.reference create mode 100644 testsuite/tests/regression/pr7718/pr7718.ml create mode 100644 testsuite/tests/regression/pr7718/pr7718.reference create mode 100644 testsuite/tests/regression/pr7798/pr7798.ml create mode 100644 testsuite/tests/regression/pr7798/pr7798.reference create mode 100644 testsuite/tests/regression/pr7920/pr7920.ml create mode 100644 testsuite/tests/regression/pr7920/pr7920.reference create mode 100644 testsuite/tests/regression/pr8769/fortuna.ml create mode 100644 testsuite/tests/regression/pr8769/nocrypto.mli create mode 100644 testsuite/tests/regression/pr8769/pr8769.ml create mode 100644 testsuite/tests/regression/pr8769/rng.ml create mode 100644 testsuite/tests/regression/pr9028/pr9028.ml create mode 100644 testsuite/tests/regression/pr9028/pr9028.reference create mode 100644 testsuite/tests/regression/pr9292/pr9292.ml create mode 100644 testsuite/tests/regression/pr9443/pr9443.ml create mode 100644 testsuite/tests/reproducibility/cmis_on_file_system.ml create mode 100644 testsuite/tests/reproducibility/cmis_on_file_system_companion.mli create mode 100644 testsuite/tests/required-external/file.ml create mode 100644 testsuite/tests/required-external/main.ml create mode 100644 testsuite/tests/required-external/main.reference create mode 100644 testsuite/tests/runtime-C-exceptions/stub_test.c create mode 100644 testsuite/tests/runtime-C-exceptions/test.ml create mode 100644 testsuite/tests/runtime-C-exceptions/test.reference create mode 100644 testsuite/tests/runtime-errors/has-stackoverflow-detection.sh create mode 100644 testsuite/tests/runtime-errors/stackoverflow.ml create mode 100644 testsuite/tests/runtime-errors/stackoverflow.native.reference create mode 100644 testsuite/tests/runtime-errors/stackoverflow.reference create mode 100644 testsuite/tests/runtime-errors/stackoverflow.run create mode 100644 testsuite/tests/runtime-errors/syserror.ml create mode 100644 testsuite/tests/runtime-errors/syserror.unix.reference create mode 100644 testsuite/tests/runtime-errors/syserror.win32.reference create mode 100644 testsuite/tests/runtime-objects/Tests.ml create mode 100644 testsuite/tests/self-contained-toplevel/foo.ml create mode 100644 testsuite/tests/self-contained-toplevel/gen_cached_cmi.ml create mode 100644 testsuite/tests/self-contained-toplevel/input.ml create mode 100644 testsuite/tests/self-contained-toplevel/main.ml create mode 100644 testsuite/tests/self-contained-toplevel/main.reference create mode 100644 testsuite/tests/shadow_include/artificial.ml create mode 100644 testsuite/tests/shadow_include/cannot_shadow_error.compilers.reference create mode 100644 testsuite/tests/shadow_include/cannot_shadow_error.ml create mode 100644 testsuite/tests/shadow_include/shadow_all.ml create mode 100644 testsuite/tests/statmemprof/arrays_in_major.ml create mode 100644 testsuite/tests/statmemprof/arrays_in_major.reference create mode 100644 testsuite/tests/statmemprof/arrays_in_minor.ml create mode 100644 testsuite/tests/statmemprof/arrays_in_minor.reference create mode 100644 testsuite/tests/statmemprof/blocking_in_callback.ml create mode 100644 testsuite/tests/statmemprof/callstacks.flat-float-array.reference create mode 100644 testsuite/tests/statmemprof/callstacks.ml create mode 100644 testsuite/tests/statmemprof/callstacks.no-flat-float-array.reference create mode 100644 testsuite/tests/statmemprof/comballoc.byte.reference create mode 100644 testsuite/tests/statmemprof/comballoc.ml create mode 100644 testsuite/tests/statmemprof/comballoc.opt.reference create mode 100644 testsuite/tests/statmemprof/exception_callback.ml create mode 100644 testsuite/tests/statmemprof/exception_callback.reference create mode 100644 testsuite/tests/statmemprof/exception_callback_minor.ml create mode 100644 testsuite/tests/statmemprof/exception_callback_minor.reference create mode 100644 testsuite/tests/statmemprof/intern.ml create mode 100644 testsuite/tests/statmemprof/intern.reference create mode 100644 testsuite/tests/statmemprof/lists_in_minor.ml create mode 100644 testsuite/tests/statmemprof/lists_in_minor.reference create mode 100644 testsuite/tests/statmemprof/minor_no_postpone.ml create mode 100644 testsuite/tests/statmemprof/minor_no_postpone_stub.c create mode 100644 testsuite/tests/statmemprof/thread_exit_in_callback.ml create mode 100644 testsuite/tests/statmemprof/thread_exit_in_callback.reference create mode 100644 testsuite/tests/statmemprof/thread_exit_in_callback_stub.c create mode 100644 testsuite/tests/tool-caml-tex/ellipses.input create mode 100644 testsuite/tests/tool-caml-tex/ellipses.ml create mode 100644 testsuite/tests/tool-caml-tex/ellipses.reference create mode 100644 testsuite/tests/tool-caml-tex/redirections.input create mode 100644 testsuite/tests/tool-caml-tex/redirections.ml create mode 100644 testsuite/tests/tool-caml-tex/redirections.reference create mode 100644 testsuite/tests/tool-command-line/test.compilers.reference create mode 100644 testsuite/tests/tool-command-line/test.ml create mode 100644 testsuite/tests/tool-command-line/unknown-file create mode 100644 testsuite/tests/tool-debugger/basic/debuggee.ml create mode 100644 testsuite/tests/tool-debugger/basic/debuggee.reference create mode 100644 testsuite/tests/tool-debugger/basic/input_script create mode 100644 testsuite/tests/tool-debugger/dynlink/host.debug.reference create mode 100644 testsuite/tests/tool-debugger/dynlink/host.ml create mode 100644 testsuite/tests/tool-debugger/dynlink/host.reference create mode 100644 testsuite/tests/tool-debugger/dynlink/input_script create mode 100644 testsuite/tests/tool-debugger/dynlink/plugin.ml create mode 100644 testsuite/tests/tool-debugger/find-artifacts/debuggee.ml create mode 100644 testsuite/tests/tool-debugger/find-artifacts/debuggee.reference create mode 100644 testsuite/tests/tool-debugger/find-artifacts/in/blah.ml create mode 100644 testsuite/tests/tool-debugger/find-artifacts/in/foo.ml create mode 100644 testsuite/tests/tool-debugger/find-artifacts/input_script create mode 100644 testsuite/tests/tool-debugger/no_debug_event/a.ml create mode 100644 testsuite/tests/tool-debugger/no_debug_event/b.ml create mode 100644 testsuite/tests/tool-debugger/no_debug_event/input_script create mode 100644 testsuite/tests/tool-debugger/no_debug_event/noev.ml create mode 100644 testsuite/tests/tool-debugger/no_debug_event/noev.reference create mode 100644 testsuite/tests/tool-debugger/printer/debuggee.ml create mode 100644 testsuite/tests/tool-debugger/printer/debuggee.reference create mode 100644 testsuite/tests/tool-debugger/printer/input_script create mode 100644 testsuite/tests/tool-debugger/printer/printer.ml create mode 100644 testsuite/tests/tool-expect-test/clean_typer.ml create mode 100644 testsuite/tests/tool-lexyacc/chars.mll create mode 100644 testsuite/tests/tool-lexyacc/gram_aux.ml create mode 100644 testsuite/tests/tool-lexyacc/grammar.mly create mode 100644 testsuite/tests/tool-lexyacc/input create mode 100644 testsuite/tests/tool-lexyacc/lexgen.ml create mode 100644 testsuite/tests/tool-lexyacc/main.compilers.reference create mode 100644 testsuite/tests/tool-lexyacc/main.ml create mode 100644 testsuite/tests/tool-lexyacc/main.reference create mode 100644 testsuite/tests/tool-lexyacc/mpr7760.mll create mode 100644 testsuite/tests/tool-lexyacc/mpr7760.reference create mode 100644 testsuite/tests/tool-lexyacc/output.ml create mode 100644 testsuite/tests/tool-lexyacc/scan_aux.ml create mode 100644 testsuite/tests/tool-lexyacc/scanner.mll create mode 100644 testsuite/tests/tool-lexyacc/syntax.ml create mode 100755 testsuite/tests/tool-ocaml-annot/check-annot.sh create mode 100644 testsuite/tests/tool-ocaml-annot/failure.ml create mode 100644 testsuite/tests/tool-ocaml-annot/success.ml create mode 100644 testsuite/tests/tool-ocaml-annot/typeonly.ml create mode 100644 testsuite/tests/tool-ocaml/t000.ml create mode 100644 testsuite/tests/tool-ocaml/t010-const0.ml create mode 100644 testsuite/tests/tool-ocaml/t010-const1.ml create mode 100644 testsuite/tests/tool-ocaml/t010-const2.ml create mode 100644 testsuite/tests/tool-ocaml/t010-const3.ml create mode 100644 testsuite/tests/tool-ocaml/t011-constint.ml create mode 100644 testsuite/tests/tool-ocaml/t020.ml create mode 100644 testsuite/tests/tool-ocaml/t021-pushconst1.ml create mode 100644 testsuite/tests/tool-ocaml/t021-pushconst2.ml create mode 100644 testsuite/tests/tool-ocaml/t021-pushconst3.ml create mode 100644 testsuite/tests/tool-ocaml/t022-pushconstint.ml create mode 100644 testsuite/tests/tool-ocaml/t040-makeblock1.ml create mode 100644 testsuite/tests/tool-ocaml/t040-makeblock2.ml create mode 100644 testsuite/tests/tool-ocaml/t040-makeblock3.ml create mode 100644 testsuite/tests/tool-ocaml/t041-makeblock.ml create mode 100644 testsuite/tests/tool-ocaml/t050-getglobal.ml create mode 100644 testsuite/tests/tool-ocaml/t050-pushgetglobal.ml create mode 100644 testsuite/tests/tool-ocaml/t051-getglobalfield.ml create mode 100644 testsuite/tests/tool-ocaml/t051-pushgetglobalfield.ml create mode 100644 testsuite/tests/tool-ocaml/t060-raise.ml create mode 100644 testsuite/tests/tool-ocaml/t070-branch.ml create mode 100644 testsuite/tests/tool-ocaml/t070-branchif.ml create mode 100644 testsuite/tests/tool-ocaml/t070-branchifnot.ml create mode 100644 testsuite/tests/tool-ocaml/t071-boolnot.ml create mode 100644 testsuite/tests/tool-ocaml/t080-eq.ml create mode 100644 testsuite/tests/tool-ocaml/t080-geint.ml create mode 100644 testsuite/tests/tool-ocaml/t080-gtint.ml create mode 100644 testsuite/tests/tool-ocaml/t080-leint.ml create mode 100644 testsuite/tests/tool-ocaml/t080-ltint.ml create mode 100644 testsuite/tests/tool-ocaml/t080-neq.ml create mode 100644 testsuite/tests/tool-ocaml/t090-acc0.ml create mode 100644 testsuite/tests/tool-ocaml/t090-acc1.ml create mode 100644 testsuite/tests/tool-ocaml/t090-acc2.ml create mode 100644 testsuite/tests/tool-ocaml/t090-acc3.ml create mode 100644 testsuite/tests/tool-ocaml/t090-acc4.ml create mode 100644 testsuite/tests/tool-ocaml/t090-acc5.ml create mode 100644 testsuite/tests/tool-ocaml/t090-acc6.ml create mode 100644 testsuite/tests/tool-ocaml/t090-acc7.ml create mode 100644 testsuite/tests/tool-ocaml/t091-acc.ml create mode 100644 testsuite/tests/tool-ocaml/t092-pushacc.ml create mode 100644 testsuite/tests/tool-ocaml/t092-pushacc0.ml create mode 100644 testsuite/tests/tool-ocaml/t092-pushacc1.ml create mode 100644 testsuite/tests/tool-ocaml/t092-pushacc2.ml create mode 100644 testsuite/tests/tool-ocaml/t092-pushacc3.ml create mode 100644 testsuite/tests/tool-ocaml/t092-pushacc4.ml create mode 100644 testsuite/tests/tool-ocaml/t092-pushacc5.ml create mode 100644 testsuite/tests/tool-ocaml/t092-pushacc6.ml create mode 100644 testsuite/tests/tool-ocaml/t092-pushacc7.ml create mode 100644 testsuite/tests/tool-ocaml/t093-pushacc.ml create mode 100644 testsuite/tests/tool-ocaml/t100-pushtrap.ml create mode 100644 testsuite/tests/tool-ocaml/t101-poptrap.ml create mode 100644 testsuite/tests/tool-ocaml/t110-addint.ml create mode 100644 testsuite/tests/tool-ocaml/t110-andint.ml create mode 100644 testsuite/tests/tool-ocaml/t110-asrint-1.ml create mode 100644 testsuite/tests/tool-ocaml/t110-asrint-2.ml create mode 100644 testsuite/tests/tool-ocaml/t110-divint-1.ml create mode 100644 testsuite/tests/tool-ocaml/t110-divint-2.ml create mode 100644 testsuite/tests/tool-ocaml/t110-divint-3.ml create mode 100644 testsuite/tests/tool-ocaml/t110-lslint.ml create mode 100644 testsuite/tests/tool-ocaml/t110-lsrint.ml create mode 100644 testsuite/tests/tool-ocaml/t110-modint-1.ml create mode 100644 testsuite/tests/tool-ocaml/t110-modint-2.ml create mode 100644 testsuite/tests/tool-ocaml/t110-mulint.ml create mode 100644 testsuite/tests/tool-ocaml/t110-negint.ml create mode 100644 testsuite/tests/tool-ocaml/t110-offsetint.ml create mode 100644 testsuite/tests/tool-ocaml/t110-orint.ml create mode 100644 testsuite/tests/tool-ocaml/t110-subint.ml create mode 100644 testsuite/tests/tool-ocaml/t110-xorint.ml create mode 100644 testsuite/tests/tool-ocaml/t120-getstringchar.ml create mode 100644 testsuite/tests/tool-ocaml/t121-setstringchar.ml create mode 100644 testsuite/tests/tool-ocaml/t130-getvectitem.ml create mode 100644 testsuite/tests/tool-ocaml/t130-vectlength.ml create mode 100644 testsuite/tests/tool-ocaml/t131-setvectitem.ml create mode 100644 testsuite/tests/tool-ocaml/t140-switch-1.ml create mode 100644 testsuite/tests/tool-ocaml/t140-switch-2.ml create mode 100644 testsuite/tests/tool-ocaml/t140-switch-3.ml create mode 100644 testsuite/tests/tool-ocaml/t140-switch-4.ml create mode 100644 testsuite/tests/tool-ocaml/t141-switch-5.ml create mode 100644 testsuite/tests/tool-ocaml/t141-switch-6.ml create mode 100644 testsuite/tests/tool-ocaml/t141-switch-7.ml create mode 100644 testsuite/tests/tool-ocaml/t142-switch-8.ml create mode 100644 testsuite/tests/tool-ocaml/t142-switch-9.ml create mode 100644 testsuite/tests/tool-ocaml/t142-switch-A.ml create mode 100644 testsuite/tests/tool-ocaml/t150-push-1.ml create mode 100644 testsuite/tests/tool-ocaml/t150-push-2.ml create mode 100644 testsuite/tests/tool-ocaml/t160-closure.ml create mode 100644 testsuite/tests/tool-ocaml/t161-apply1.ml create mode 100644 testsuite/tests/tool-ocaml/t162-return.ml create mode 100644 testsuite/tests/tool-ocaml/t163.ml create mode 100644 testsuite/tests/tool-ocaml/t164-apply2.ml create mode 100644 testsuite/tests/tool-ocaml/t164-apply3.ml create mode 100644 testsuite/tests/tool-ocaml/t165-apply.ml create mode 100644 testsuite/tests/tool-ocaml/t170-envacc2.ml create mode 100644 testsuite/tests/tool-ocaml/t170-envacc3.ml create mode 100644 testsuite/tests/tool-ocaml/t170-envacc4.ml create mode 100644 testsuite/tests/tool-ocaml/t171-envacc.ml create mode 100644 testsuite/tests/tool-ocaml/t172-pushenvacc1.ml create mode 100644 testsuite/tests/tool-ocaml/t172-pushenvacc2.ml create mode 100644 testsuite/tests/tool-ocaml/t172-pushenvacc3.ml create mode 100644 testsuite/tests/tool-ocaml/t172-pushenvacc4.ml create mode 100644 testsuite/tests/tool-ocaml/t173-pushenvacc.ml create mode 100644 testsuite/tests/tool-ocaml/t180-appterm1.ml create mode 100644 testsuite/tests/tool-ocaml/t180-appterm2.ml create mode 100644 testsuite/tests/tool-ocaml/t180-appterm3.ml create mode 100644 testsuite/tests/tool-ocaml/t181-appterm.ml create mode 100644 testsuite/tests/tool-ocaml/t190-makefloatblock-1.ml create mode 100644 testsuite/tests/tool-ocaml/t190-makefloatblock-2.ml create mode 100644 testsuite/tests/tool-ocaml/t190-makefloatblock-3.ml create mode 100644 testsuite/tests/tool-ocaml/t191-vectlength.ml create mode 100644 testsuite/tests/tool-ocaml/t192-getfloatfield-1.ml create mode 100644 testsuite/tests/tool-ocaml/t192-getfloatfield-2.ml create mode 100644 testsuite/tests/tool-ocaml/t193-setfloatfield-1.ml create mode 100644 testsuite/tests/tool-ocaml/t193-setfloatfield-2.ml create mode 100644 testsuite/tests/tool-ocaml/t200-getfield0.ml create mode 100644 testsuite/tests/tool-ocaml/t200-getfield1.ml create mode 100644 testsuite/tests/tool-ocaml/t200-getfield2.ml create mode 100644 testsuite/tests/tool-ocaml/t200-getfield3.ml create mode 100644 testsuite/tests/tool-ocaml/t201-getfield.ml create mode 100644 testsuite/tests/tool-ocaml/t210-setfield0.ml create mode 100644 testsuite/tests/tool-ocaml/t210-setfield1.ml create mode 100644 testsuite/tests/tool-ocaml/t210-setfield2.ml create mode 100644 testsuite/tests/tool-ocaml/t210-setfield3.ml create mode 100644 testsuite/tests/tool-ocaml/t211-setfield.ml create mode 100644 testsuite/tests/tool-ocaml/t220-assign.ml create mode 100644 testsuite/tests/tool-ocaml/t230-check_signals.ml create mode 100644 testsuite/tests/tool-ocaml/t240-c_call1.ml create mode 100644 testsuite/tests/tool-ocaml/t240-c_call2.ml create mode 100644 testsuite/tests/tool-ocaml/t240-c_call3.ml create mode 100644 testsuite/tests/tool-ocaml/t240-c_call4.ml create mode 100644 testsuite/tests/tool-ocaml/t240-c_call5.ml create mode 100644 testsuite/tests/tool-ocaml/t250-closurerec-1.ml create mode 100644 testsuite/tests/tool-ocaml/t250-closurerec-2.ml create mode 100644 testsuite/tests/tool-ocaml/t251-pushoffsetclosure0.ml create mode 100644 testsuite/tests/tool-ocaml/t251-pushoffsetclosure2.ml create mode 100644 testsuite/tests/tool-ocaml/t251-pushoffsetclosurem2.ml create mode 100644 testsuite/tests/tool-ocaml/t252-pushoffsetclosure.ml create mode 100644 testsuite/tests/tool-ocaml/t253-offsetclosure0.ml create mode 100644 testsuite/tests/tool-ocaml/t253-offsetclosure2.ml create mode 100644 testsuite/tests/tool-ocaml/t253-offsetclosurem2.ml create mode 100644 testsuite/tests/tool-ocaml/t254-offsetclosure.ml create mode 100644 testsuite/tests/tool-ocaml/t260-offsetref.ml create mode 100644 testsuite/tests/tool-ocaml/t270-push_retaddr.ml create mode 100644 testsuite/tests/tool-ocaml/t300-getmethod.ml create mode 100644 testsuite/tests/tool-ocaml/t301-object.ml create mode 100644 testsuite/tests/tool-ocaml/t310-alloc-1.ml create mode 100644 testsuite/tests/tool-ocaml/t310-alloc-2.ml create mode 100644 testsuite/tests/tool-ocaml/t320-gc-1.ml create mode 100644 testsuite/tests/tool-ocaml/t320-gc-2.ml create mode 100644 testsuite/tests/tool-ocaml/t320-gc-3.ml create mode 100644 testsuite/tests/tool-ocaml/t330-compact-1.ml create mode 100644 testsuite/tests/tool-ocaml/t330-compact-2.ml create mode 100644 testsuite/tests/tool-ocaml/t330-compact-3.ml create mode 100644 testsuite/tests/tool-ocaml/t330-compact-4.ml create mode 100644 testsuite/tests/tool-ocaml/t340-weak.ml create mode 100644 testsuite/tests/tool-ocaml/t350-heapcheck.ml create mode 100644 testsuite/tests/tool-ocaml/t360-stacks-1.ml create mode 100644 testsuite/tests/tool-ocaml/t360-stacks-2.ml create mode 100644 testsuite/tests/tool-ocamlc-compat32/compat32.compilers.reference create mode 100644 testsuite/tests/tool-ocamlc-compat32/compat32.ml create mode 100644 testsuite/tests/tool-ocamlc-error-cleanup/check-error-cleanup.sh create mode 100644 testsuite/tests/tool-ocamlc-error-cleanup/test.ml create mode 100644 testsuite/tests/tool-ocamlc-open/a.ml create mode 100644 testsuite/tests/tool-ocamlc-open/b.ml create mode 100644 testsuite/tests/tool-ocamlc-open/tool-ocamlc-open-error.compilers.reference create mode 100644 testsuite/tests/tool-ocamlc-open/tool-ocamlc-open-error.ml create mode 100644 testsuite/tests/tool-ocamlc-open/tool-ocamlc-open.ml create mode 100644 testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_impl.compilers.reference create mode 100644 testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_impl.ml create mode 100644 testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_intf.compilers.reference create mode 100644 testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_intf.mli create mode 100644 testsuite/tests/tool-ocamlc-stop-after/stop_after_scheduling.compilers.reference create mode 100644 testsuite/tests/tool-ocamlc-stop-after/stop_after_scheduling.ml create mode 100755 testsuite/tests/tool-ocamlc-stop-after/stop_after_scheduling.sh create mode 100644 testsuite/tests/tool-ocamlc-stop-after/stop_after_typing_impl.compilers.reference create mode 100644 testsuite/tests/tool-ocamlc-stop-after/stop_after_typing_impl.ml create mode 100644 testsuite/tests/tool-ocamldep-modalias/A.ml create mode 100644 testsuite/tests/tool-ocamldep-modalias/B.ml create mode 100644 testsuite/tests/tool-ocamldep-modalias/C.ml create mode 100644 testsuite/tests/tool-ocamldep-modalias/D.ml create mode 100644 testsuite/tests/tool-ocamldep-modalias/Makefile.build create mode 100644 testsuite/tests/tool-ocamldep-modalias/Makefile.build2 create mode 100644 testsuite/tests/tool-ocamldep-modalias/depend.mk.reference create mode 100644 testsuite/tests/tool-ocamldep-modalias/depend.mk2.reference create mode 100644 testsuite/tests/tool-ocamldep-modalias/depend.mod.reference create mode 100644 testsuite/tests/tool-ocamldep-modalias/depend.mod2.reference create mode 100644 testsuite/tests/tool-ocamldep-modalias/depend.mod3.reference create mode 100644 testsuite/tests/tool-ocamldep-modalias/lib.mli create mode 100644 testsuite/tests/tool-ocamldep-modalias/lib_impl.ml create mode 100644 testsuite/tests/tool-ocamldep-modalias/main.ml create mode 100644 testsuite/tests/tool-ocamldep-modalias/setup-links.sh create mode 100644 testsuite/tests/tool-ocamldep-shadowing/a.ml create mode 100644 testsuite/tests/tool-ocamldep-shadowing/a.reference create mode 100644 testsuite/tests/tool-ocamldep-shadowing/dir1/b.ml create mode 100644 testsuite/tests/tool-ocamldep-shadowing/dir2/b.mli create mode 100644 testsuite/tests/tool-ocamldep-shadowing/dir2/c.mli create mode 100644 testsuite/tests/tool-ocamldoc-open/Readme create mode 100644 testsuite/tests/tool-ocamldoc-open/alias.ml create mode 100644 testsuite/tests/tool-ocamldoc-open/inner.ml create mode 100644 testsuite/tests/tool-ocamldoc-open/main.latex.reference create mode 100644 testsuite/tests/tool-ocamldoc-open/main.ml create mode 100644 testsuite/tests/tool-ocamldoc-open/main.ocamldoc.latex.reference create mode 100644 testsuite/tests/tool-ocamldoc/Documentation_tags.html.reference create mode 100644 testsuite/tests/tool-ocamldoc/Documentation_tags.mli create mode 100644 testsuite/tests/tool-ocamldoc/Extensible_variant.latex.reference create mode 100644 testsuite/tests/tool-ocamldoc/Extensible_variant.ml create mode 100644 testsuite/tests/tool-ocamldoc/Extensible_variant.ocamldoc.latex.reference create mode 100644 testsuite/tests/tool-ocamldoc/Include_module_type_of.html.reference create mode 100644 testsuite/tests/tool-ocamldoc/Include_module_type_of.latex.reference create mode 100644 testsuite/tests/tool-ocamldoc/Include_module_type_of.mli create mode 100644 testsuite/tests/tool-ocamldoc/Inline_records.html.reference create mode 100644 testsuite/tests/tool-ocamldoc/Inline_records.latex.reference create mode 100644 testsuite/tests/tool-ocamldoc/Inline_records.man.reference create mode 100644 testsuite/tests/tool-ocamldoc/Inline_records.mli create mode 100644 testsuite/tests/tool-ocamldoc/Inline_records_bis.latex.reference create mode 100644 testsuite/tests/tool-ocamldoc/Inline_records_bis.ml create mode 100644 testsuite/tests/tool-ocamldoc/Item_ids.html.reference create mode 100644 testsuite/tests/tool-ocamldoc/Item_ids.mli create mode 100644 testsuite/tests/tool-ocamldoc/Level_0.latex.reference create mode 100644 testsuite/tests/tool-ocamldoc/Level_0.mli create mode 100644 testsuite/tests/tool-ocamldoc/Linebreaks.html.reference create mode 100644 testsuite/tests/tool-ocamldoc/Linebreaks.mli create mode 100644 testsuite/tests/tool-ocamldoc/Loop.html.reference create mode 100644 testsuite/tests/tool-ocamldoc/Loop.latex.reference create mode 100644 testsuite/tests/tool-ocamldoc/Loop.ml create mode 100644 testsuite/tests/tool-ocamldoc/Module_whitespace.html.reference create mode 100644 testsuite/tests/tool-ocamldoc/Module_whitespace.ml create mode 100644 testsuite/tests/tool-ocamldoc/Module_whitespace.ocamldoc.html.reference create mode 100644 testsuite/tests/tool-ocamldoc/No_preamble.html.reference create mode 100644 testsuite/tests/tool-ocamldoc/No_preamble.mli create mode 100644 testsuite/tests/tool-ocamldoc/Paragraph.html.reference create mode 100644 testsuite/tests/tool-ocamldoc/Paragraph.mli create mode 100644 testsuite/tests/tool-ocamldoc/Short_description.latex.reference create mode 100644 testsuite/tests/tool-ocamldoc/Short_description.txt create mode 100644 testsuite/tests/tool-ocamldoc/Test.latex.reference create mode 100644 testsuite/tests/tool-ocamldoc/Test.mli create mode 100644 testsuite/tests/tool-ocamldoc/Variants.html.reference create mode 100644 testsuite/tests/tool-ocamldoc/Variants.latex.reference create mode 100644 testsuite/tests/tool-ocamldoc/Variants.mli create mode 100644 testsuite/tests/tool-ocamldoc/latex_ref.latex.reference create mode 100644 testsuite/tests/tool-ocamldoc/latex_ref.mli create mode 100644 testsuite/tests/tool-ocamldoc/odoc_test.ml create mode 100644 testsuite/tests/tool-ocamldoc/t01.ml create mode 100644 testsuite/tests/tool-ocamldoc/t01.reference create mode 100644 testsuite/tests/tool-ocamldoc/t02.ml create mode 100644 testsuite/tests/tool-ocamldoc/t02.reference create mode 100644 testsuite/tests/tool-ocamldoc/t03.ml create mode 100644 testsuite/tests/tool-ocamldoc/t03.ocamldoc.reference create mode 100644 testsuite/tests/tool-ocamldoc/t03.reference create mode 100644 testsuite/tests/tool-ocamldoc/t04.ml create mode 100644 testsuite/tests/tool-ocamldoc/t04.reference create mode 100644 testsuite/tests/tool-ocamldoc/t05.ml create mode 100644 testsuite/tests/tool-ocamldoc/t05.reference create mode 100644 testsuite/tests/tool-ocamldoc/type_Linebreaks.reference create mode 100644 testsuite/tests/tool-ocamlobjinfo/has-lib-bfd.sh create mode 100644 testsuite/tests/tool-ocamlobjinfo/question.ml create mode 100644 testsuite/tests/tool-ocamlobjinfo/question.reference create mode 100644 testsuite/tests/tool-ocamlopt-stop-after/stop_after_scheduling.ml create mode 100755 testsuite/tests/tool-ocamlopt-stop-after/stop_after_scheduling.sh create mode 100644 testsuite/tests/tool-toplevel-invocation/first_arg_fail.txt create mode 100644 testsuite/tests/tool-toplevel-invocation/first_arg_fail.txt.reference create mode 100644 testsuite/tests/tool-toplevel-invocation/indirect_first_arg_fail.txt create mode 100644 testsuite/tests/tool-toplevel-invocation/indirect_first_arg_fail.txt.reference create mode 100644 testsuite/tests/tool-toplevel-invocation/indirect_last_arg_fail.txt create mode 100644 testsuite/tests/tool-toplevel-invocation/indirect_last_arg_fail.txt.reference create mode 100644 testsuite/tests/tool-toplevel-invocation/last_arg_fail.txt create mode 100644 testsuite/tests/tool-toplevel-invocation/last_arg_fail.txt.reference create mode 100644 testsuite/tests/tool-toplevel-invocation/print_args.ml create mode 100644 testsuite/tests/tool-toplevel-invocation/print_args.reference create mode 100644 testsuite/tests/tool-toplevel-invocation/test.ml create mode 100644 testsuite/tests/tool-toplevel-invocation/working_arg.txt create mode 100644 testsuite/tests/tool-toplevel-invocation/working_arg.txt.reference create mode 100644 testsuite/tests/tool-toplevel/error_highlighting.compilers.reference create mode 100644 testsuite/tests/tool-toplevel/error_highlighting.ml create mode 100644 testsuite/tests/tool-toplevel/error_highlighting_use1.ml create mode 100644 testsuite/tests/tool-toplevel/error_highlighting_use2.ml create mode 100644 testsuite/tests/tool-toplevel/error_highlighting_use3.ml create mode 100644 testsuite/tests/tool-toplevel/error_highlighting_use4.ml create mode 100644 testsuite/tests/tool-toplevel/exotic_lists.compilers.reference create mode 100644 testsuite/tests/tool-toplevel/exotic_lists.ml create mode 100644 testsuite/tests/tool-toplevel/known-bugs/broken_rec_in_show.ml create mode 100644 testsuite/tests/tool-toplevel/mod.ml create mode 100644 testsuite/tests/tool-toplevel/mod_use.ml create mode 100644 testsuite/tests/tool-toplevel/pr6468.compilers.reference create mode 100644 testsuite/tests/tool-toplevel/pr6468.ml create mode 100644 testsuite/tests/tool-toplevel/pr7060.compilers.reference create mode 100644 testsuite/tests/tool-toplevel/pr7060.ml create mode 100644 testsuite/tests/tool-toplevel/pr7751.compilers.reference create mode 100644 testsuite/tests/tool-toplevel/pr7751.ml create mode 100644 testsuite/tests/tool-toplevel/redefinition_hints.compilers.reference create mode 100644 testsuite/tests/tool-toplevel/redefinition_hints.ml create mode 100644 testsuite/tests/tool-toplevel/show.ml create mode 100644 testsuite/tests/tool-toplevel/show_short_paths.ml create mode 100644 testsuite/tests/tool-toplevel/strings.compilers.reference create mode 100644 testsuite/tests/tool-toplevel/strings.ml create mode 100644 testsuite/tests/tool-toplevel/tracing.compilers.reference create mode 100644 testsuite/tests/tool-toplevel/tracing.ml create mode 100644 testsuite/tests/tool-toplevel/uncaught_exceptions.ml create mode 100644 testsuite/tests/tool-toplevel/use_command.ml create mode 100644 testsuite/tests/translprim/array_spec.compilers.flat.reference create mode 100644 testsuite/tests/translprim/array_spec.compilers.no-flat.reference create mode 100644 testsuite/tests/translprim/array_spec.ml create mode 100644 testsuite/tests/translprim/comparison_table.compilers.reference create mode 100644 testsuite/tests/translprim/comparison_table.ml create mode 100644 testsuite/tests/translprim/locs.ml create mode 100644 testsuite/tests/translprim/locs.reference create mode 100644 testsuite/tests/translprim/module_coercion.compilers.flat.reference create mode 100644 testsuite/tests/translprim/module_coercion.compilers.no-flat.reference create mode 100644 testsuite/tests/translprim/module_coercion.ml create mode 100644 testsuite/tests/translprim/ref_spec.compilers.reference create mode 100644 testsuite/tests/translprim/ref_spec.ml create mode 100644 testsuite/tests/typing-core-bugs/const_int_hint.ml create mode 100644 testsuite/tests/typing-core-bugs/missing_rec_hint.ml create mode 100644 testsuite/tests/typing-core-bugs/repeated_did_you_mean.ml create mode 100644 testsuite/tests/typing-core-bugs/type_expected_explanation.ml create mode 100644 testsuite/tests/typing-core-bugs/unit_fun_hints.ml create mode 100644 testsuite/tests/typing-deprecated/alerts.ml create mode 100644 testsuite/tests/typing-deprecated/deprecated.ml create mode 100644 testsuite/tests/typing-extension-constructor/test.ml create mode 100644 testsuite/tests/typing-extension-constructor/test.ocaml.reference create mode 100644 testsuite/tests/typing-extensions/cast.ml create mode 100644 testsuite/tests/typing-extensions/cast.ocaml.reference create mode 100644 testsuite/tests/typing-extensions/disambiguation.ml create mode 100644 testsuite/tests/typing-extensions/extensions.ml create mode 100644 testsuite/tests/typing-extensions/msg.ml create mode 100644 testsuite/tests/typing-extensions/msg.ocaml.reference create mode 100644 testsuite/tests/typing-extensions/open_types.ml create mode 100644 testsuite/tests/typing-fstclassmod/fstclassmod.ml create mode 100644 testsuite/tests/typing-fstclassmod/fstclassmod.reference create mode 100644 testsuite/tests/typing-gadts/ambiguity.ml create mode 100644 testsuite/tests/typing-gadts/didier.ml create mode 100644 testsuite/tests/typing-gadts/dynamic_frisch.ml create mode 100644 testsuite/tests/typing-gadts/nested_equations.ml create mode 100644 testsuite/tests/typing-gadts/omega07.ml create mode 100644 testsuite/tests/typing-gadts/or_patterns.ml create mode 100644 testsuite/tests/typing-gadts/pr5332.ml create mode 100644 testsuite/tests/typing-gadts/pr5689.ml create mode 100644 testsuite/tests/typing-gadts/pr5785.ml create mode 100644 testsuite/tests/typing-gadts/pr5848.ml create mode 100644 testsuite/tests/typing-gadts/pr5906.ml create mode 100644 testsuite/tests/typing-gadts/pr5948.ml create mode 100644 testsuite/tests/typing-gadts/pr5981.ml create mode 100644 testsuite/tests/typing-gadts/pr5985.ml create mode 100644 testsuite/tests/typing-gadts/pr5989.ml create mode 100644 testsuite/tests/typing-gadts/pr5997.ml create mode 100644 testsuite/tests/typing-gadts/pr6158.ml create mode 100644 testsuite/tests/typing-gadts/pr6163.ml create mode 100644 testsuite/tests/typing-gadts/pr6174.ml create mode 100644 testsuite/tests/typing-gadts/pr6241.ml create mode 100644 testsuite/tests/typing-gadts/pr6690.ml create mode 100644 testsuite/tests/typing-gadts/pr6817.ml create mode 100644 testsuite/tests/typing-gadts/pr6934.ml create mode 100644 testsuite/tests/typing-gadts/pr6980.ml create mode 100644 testsuite/tests/typing-gadts/pr6993_bad.ml create mode 100644 testsuite/tests/typing-gadts/pr7016.ml create mode 100644 testsuite/tests/typing-gadts/pr7160.ml create mode 100644 testsuite/tests/typing-gadts/pr7214.ml create mode 100644 testsuite/tests/typing-gadts/pr7222.ml create mode 100644 testsuite/tests/typing-gadts/pr7230.ml create mode 100644 testsuite/tests/typing-gadts/pr7234.ml create mode 100644 testsuite/tests/typing-gadts/pr7260.ml create mode 100644 testsuite/tests/typing-gadts/pr7269.ml create mode 100644 testsuite/tests/typing-gadts/pr7298.ml create mode 100644 testsuite/tests/typing-gadts/pr7374.ml create mode 100644 testsuite/tests/typing-gadts/pr7378.ml create mode 100644 testsuite/tests/typing-gadts/pr7381.ml create mode 100644 testsuite/tests/typing-gadts/pr7390.ml create mode 100644 testsuite/tests/typing-gadts/pr7391.ml create mode 100644 testsuite/tests/typing-gadts/pr7397.ml create mode 100644 testsuite/tests/typing-gadts/pr7421.ml create mode 100644 testsuite/tests/typing-gadts/pr7432.ml create mode 100644 testsuite/tests/typing-gadts/pr7520.ml create mode 100644 testsuite/tests/typing-gadts/pr7618.ml create mode 100644 testsuite/tests/typing-gadts/pr7747.ml create mode 100644 testsuite/tests/typing-gadts/pr9019.ml create mode 100644 testsuite/tests/typing-gadts/term-conv.ml create mode 100644 testsuite/tests/typing-gadts/test.ml create mode 100644 testsuite/tests/typing-gadts/unexpected_existentials.ml create mode 100644 testsuite/tests/typing-gadts/unify_mb.ml create mode 100644 testsuite/tests/typing-gadts/variables_in_mcomp.ml create mode 100644 testsuite/tests/typing-gadts/yallop_bugs.ml create mode 100644 testsuite/tests/typing-immediate/immediate.ml create mode 100644 testsuite/tests/typing-implicit_unpack/implicit_unpack.ml create mode 100644 testsuite/tests/typing-labels/mixin.ml create mode 100644 testsuite/tests/typing-labels/mixin.reference create mode 100644 testsuite/tests/typing-labels/mixin2.ml create mode 100644 testsuite/tests/typing-labels/mixin2.reference create mode 100644 testsuite/tests/typing-labels/mixin3.ml create mode 100644 testsuite/tests/typing-labels/mixin3.reference create mode 100644 testsuite/tests/typing-misc-bugs/core_array_reduced_ok.ml create mode 100644 testsuite/tests/typing-misc-bugs/gadt_declaration_check.ml create mode 100644 testsuite/tests/typing-misc-bugs/pr6303_bad.compilers.reference create mode 100644 testsuite/tests/typing-misc-bugs/pr6303_bad.ml create mode 100644 testsuite/tests/typing-misc-bugs/pr6946_bad.compilers.reference create mode 100644 testsuite/tests/typing-misc-bugs/pr6946_bad.ml create mode 100644 testsuite/tests/typing-misc/constraints.ml create mode 100644 testsuite/tests/typing-misc/disambiguate_principality.ml create mode 100644 testsuite/tests/typing-misc/empty_ppx.ml create mode 100644 testsuite/tests/typing-misc/empty_variant.ml create mode 100644 testsuite/tests/typing-misc/enrich_typedecl.ml create mode 100644 testsuite/tests/typing-misc/exotic_unifications.ml create mode 100644 testsuite/tests/typing-misc/external_arity.ml create mode 100644 testsuite/tests/typing-misc/gpr2277.ml create mode 100644 testsuite/tests/typing-misc/includeclass_errors.ml create mode 100644 testsuite/tests/typing-misc/inside_out.ml create mode 100644 testsuite/tests/typing-misc/is_expansive.ml create mode 100644 testsuite/tests/typing-misc/labels.ml create mode 100644 testsuite/tests/typing-misc/mapping.ml create mode 100644 testsuite/tests/typing-misc/occur_check.ml create mode 100644 testsuite/tests/typing-misc/pat_type_sharing.ml create mode 100644 testsuite/tests/typing-misc/pattern_open.ml create mode 100644 testsuite/tests/typing-misc/polyvars.ml create mode 100644 testsuite/tests/typing-misc/pr6416.ml create mode 100644 testsuite/tests/typing-misc/pr6634.ml create mode 100644 testsuite/tests/typing-misc/pr6939-flat-float-array.ml create mode 100644 testsuite/tests/typing-misc/pr6939-no-flat-float-array.ml create mode 100644 testsuite/tests/typing-misc/pr7103.ml create mode 100644 testsuite/tests/typing-misc/pr7228.ml create mode 100644 testsuite/tests/typing-misc/pr7668_bad.ml create mode 100644 testsuite/tests/typing-misc/pr7712.ml create mode 100644 testsuite/tests/typing-misc/pr7937.ml create mode 100644 testsuite/tests/typing-misc/pr8548.ml create mode 100644 testsuite/tests/typing-misc/pr8548_split.ml create mode 100644 testsuite/tests/typing-misc/printing.ml create mode 100644 testsuite/tests/typing-misc/range.ml create mode 100644 testsuite/tests/typing-misc/range_intf.ml create mode 100644 testsuite/tests/typing-misc/ranged.ml create mode 100644 testsuite/tests/typing-misc/ranged_intf.ml create mode 100644 testsuite/tests/typing-misc/records.ml create mode 100644 testsuite/tests/typing-misc/scope_escape.ml create mode 100644 testsuite/tests/typing-misc/typecore_empty_polyvariant_error.compilers.reference create mode 100644 testsuite/tests/typing-misc/typecore_empty_polyvariant_error.ml create mode 100644 testsuite/tests/typing-misc/typecore_errors.ml create mode 100644 testsuite/tests/typing-misc/typecore_nolabel_errors.ml create mode 100644 testsuite/tests/typing-misc/typetexp_errors.ml create mode 100644 testsuite/tests/typing-misc/unique_names_in_unification.ml create mode 100644 testsuite/tests/typing-misc/variance.ml create mode 100644 testsuite/tests/typing-misc/variant.ml create mode 100644 testsuite/tests/typing-misc/wellfounded.ml create mode 100644 testsuite/tests/typing-missing-cmi-2/bar.mli create mode 100644 testsuite/tests/typing-missing-cmi-2/baz.ml create mode 100644 testsuite/tests/typing-missing-cmi-2/foo.mli create mode 100644 testsuite/tests/typing-missing-cmi-2/test.compilers.reference create mode 100644 testsuite/tests/typing-missing-cmi-2/test.ml create mode 100644 testsuite/tests/typing-missing-cmi-3/middle.ml create mode 100644 testsuite/tests/typing-missing-cmi-3/original.ml create mode 100644 testsuite/tests/typing-missing-cmi-3/user.ml create mode 100644 testsuite/tests/typing-missing-cmi/a.ml create mode 100644 testsuite/tests/typing-missing-cmi/b.ml create mode 100644 testsuite/tests/typing-missing-cmi/c.ml create mode 100644 testsuite/tests/typing-missing-cmi/main.ml create mode 100644 testsuite/tests/typing-missing-cmi/main.ml.reference create mode 100644 testsuite/tests/typing-missing-cmi/main_ok.ml create mode 100644 testsuite/tests/typing-missing-cmi/subdir/m.ml create mode 100644 testsuite/tests/typing-missing-cmi/test.compilers.reference create mode 100644 testsuite/tests/typing-missing-cmi/test.ml create mode 100644 testsuite/tests/typing-modules-bugs/gatien_baron_20131019_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr5164_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr51_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr5663_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr5914_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6240_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6293_bad.compilers.reference create mode 100644 testsuite/tests/typing-modules-bugs/pr6293_bad.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6427_bad.compilers.reference create mode 100644 testsuite/tests/typing-modules-bugs/pr6427_bad.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6485_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6513_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6572_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6651_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6752_bad.compilers.reference create mode 100644 testsuite/tests/typing-modules-bugs/pr6752_bad.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6752_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6899_first_bad.compilers.reference create mode 100644 testsuite/tests/typing-modules-bugs/pr6899_first_bad.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6899_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6899_second_bad.compilers.reference create mode 100644 testsuite/tests/typing-modules-bugs/pr6899_second_bad.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6944_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6954_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6981_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6982_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6985_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr6992_bad.compilers.reference create mode 100644 testsuite/tests/typing-modules-bugs/pr6992_bad.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr7036_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr7082_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr7112_bad.compilers.reference create mode 100644 testsuite/tests/typing-modules-bugs/pr7112_bad.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr7112_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr7152_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr7182_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr7305_principal.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr7321_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr7414_2_bad.compilers.reference create mode 100644 testsuite/tests/typing-modules-bugs/pr7414_2_bad.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr7414_bad.compilers.reference create mode 100644 testsuite/tests/typing-modules-bugs/pr7414_bad.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr7519_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr7601_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr7601a_ok.ml create mode 100644 testsuite/tests/typing-modules-bugs/pr9695_bad.compilers.reference create mode 100644 testsuite/tests/typing-modules-bugs/pr9695_bad.ml create mode 100644 testsuite/tests/typing-modules/.gitattributes create mode 100644 testsuite/tests/typing-modules/Test.ml create mode 100644 testsuite/tests/typing-modules/aliases.ml create mode 100644 testsuite/tests/typing-modules/anonymous.ml create mode 100644 testsuite/tests/typing-modules/applicative_functor_type.ml create mode 100644 testsuite/tests/typing-modules/extension_constructors_errors_test.ml create mode 100644 testsuite/tests/typing-modules/firstclass.ml create mode 100644 testsuite/tests/typing-modules/generative.ml create mode 100644 testsuite/tests/typing-modules/illegal_permutation.ml create mode 100644 testsuite/tests/typing-modules/merge_constraint.ml create mode 100644 testsuite/tests/typing-modules/nondep.ml create mode 100644 testsuite/tests/typing-modules/nondep_private_abbrev.ml create mode 100644 testsuite/tests/typing-modules/normalize_path.ml create mode 100644 testsuite/tests/typing-modules/pr5911.ml create mode 100644 testsuite/tests/typing-modules/pr6394.ml create mode 100644 testsuite/tests/typing-modules/pr7207.ml create mode 100644 testsuite/tests/typing-modules/pr7348.ml create mode 100644 testsuite/tests/typing-modules/pr7726.ml create mode 100644 testsuite/tests/typing-modules/pr7787.ml create mode 100644 testsuite/tests/typing-modules/pr7818.ml create mode 100644 testsuite/tests/typing-modules/pr7851.ml create mode 100644 testsuite/tests/typing-modules/pr8810.ml create mode 100644 testsuite/tests/typing-modules/pr9384.ml create mode 100644 testsuite/tests/typing-modules/pr9695.ml create mode 100644 testsuite/tests/typing-modules/printing.ml create mode 100644 testsuite/tests/typing-modules/records_errors_test.ml create mode 100644 testsuite/tests/typing-modules/recursive.ml create mode 100644 testsuite/tests/typing-modules/unroll_private_abbrev.ml create mode 100644 testsuite/tests/typing-modules/variants_errors_test.ml create mode 100644 testsuite/tests/typing-multifile/a.ml create mode 100644 testsuite/tests/typing-multifile/b.ml create mode 100644 testsuite/tests/typing-multifile/c.ml create mode 100644 testsuite/tests/typing-multifile/d.mli create mode 100644 testsuite/tests/typing-multifile/e.ml create mode 100644 testsuite/tests/typing-multifile/f.ml create mode 100644 testsuite/tests/typing-multifile/pr6372.ml create mode 100644 testsuite/tests/typing-multifile/pr7325.ml create mode 100644 testsuite/tests/typing-multifile/pr7563.ml create mode 100644 testsuite/tests/typing-multifile/pr9218.ml create mode 100644 testsuite/tests/typing-objects-bugs/pr3968_bad.compilers.reference create mode 100644 testsuite/tests/typing-objects-bugs/pr3968_bad.ml create mode 100644 testsuite/tests/typing-objects-bugs/pr4018_bad.compilers.reference create mode 100644 testsuite/tests/typing-objects-bugs/pr4018_bad.ml create mode 100644 testsuite/tests/typing-objects-bugs/pr4435_bad.compilers.reference create mode 100644 testsuite/tests/typing-objects-bugs/pr4435_bad.ml create mode 100644 testsuite/tests/typing-objects-bugs/pr4766_ok.ml create mode 100644 testsuite/tests/typing-objects-bugs/pr4824_ok.ml create mode 100644 testsuite/tests/typing-objects-bugs/pr4824a_bad.compilers.reference create mode 100644 testsuite/tests/typing-objects-bugs/pr4824a_bad.ml create mode 100644 testsuite/tests/typing-objects-bugs/pr5156_ok.ml create mode 100644 testsuite/tests/typing-objects-bugs/pr7284_bad.compilers.reference create mode 100644 testsuite/tests/typing-objects-bugs/pr7284_bad.ml create mode 100644 testsuite/tests/typing-objects-bugs/pr7293_ok.ml create mode 100644 testsuite/tests/typing-objects-bugs/woodyatt_ok.ml create mode 100644 testsuite/tests/typing-objects-bugs/yamagata021012_ok.ml create mode 100644 testsuite/tests/typing-objects/Exemples.ml create mode 100644 testsuite/tests/typing-objects/Tests.ml create mode 100644 testsuite/tests/typing-objects/abstract_rows.ml create mode 100644 testsuite/tests/typing-objects/dummy.ml create mode 100644 testsuite/tests/typing-objects/errors.ml create mode 100644 testsuite/tests/typing-objects/open_in_classes.ml create mode 100644 testsuite/tests/typing-objects/pr5545.ml create mode 100644 testsuite/tests/typing-objects/pr5619_bad.ml create mode 100644 testsuite/tests/typing-objects/pr5858.ml create mode 100644 testsuite/tests/typing-objects/pr6123_bad.ml create mode 100644 testsuite/tests/typing-objects/pr6383.ml create mode 100644 testsuite/tests/typing-objects/pr6907_bad.ml create mode 100644 testsuite/tests/typing-objects/pr7711_ok.ml create mode 100644 testsuite/tests/typing-objects/self_cannot_be_closed.ml create mode 100644 testsuite/tests/typing-objects/self_cannot_escape_pr7865.ml create mode 100644 testsuite/tests/typing-ocamlc-i/pervasives_leitmotiv.compilers.reference create mode 100644 testsuite/tests/typing-ocamlc-i/pervasives_leitmotiv.ml create mode 100644 testsuite/tests/typing-ocamlc-i/pr4791.compilers.reference create mode 100644 testsuite/tests/typing-ocamlc-i/pr4791.ml create mode 100644 testsuite/tests/typing-ocamlc-i/pr6323.compilers.reference create mode 100644 testsuite/tests/typing-ocamlc-i/pr6323.ml create mode 100644 testsuite/tests/typing-ocamlc-i/pr7402.compilers.reference create mode 100644 testsuite/tests/typing-ocamlc-i/pr7402.ml create mode 100644 testsuite/tests/typing-ocamlc-i/pr7620_bad.compilers.reference create mode 100644 testsuite/tests/typing-ocamlc-i/pr7620_bad.ml create mode 100644 testsuite/tests/typing-poly-bugs/pr5322_ok.ml create mode 100644 testsuite/tests/typing-poly-bugs/pr5673_ok.ml create mode 100644 testsuite/tests/typing-poly-bugs/pr6922_ok.ml create mode 100644 testsuite/tests/typing-poly/error_messages.ml create mode 100644 testsuite/tests/typing-poly/poly.ml create mode 100644 testsuite/tests/typing-poly/pr7636.ml create mode 100644 testsuite/tests/typing-poly/pr9603.ml create mode 100644 testsuite/tests/typing-polyvariants-bugs-2/pr3918a.mli create mode 100644 testsuite/tests/typing-polyvariants-bugs-2/pr3918b.mli create mode 100644 testsuite/tests/typing-polyvariants-bugs-2/pr3918c.compilers.reference create mode 100644 testsuite/tests/typing-polyvariants-bugs-2/pr3918c.ml create mode 100644 testsuite/tests/typing-polyvariants-bugs/pr4775_ok.ml create mode 100644 testsuite/tests/typing-polyvariants-bugs/pr4933_ok.ml create mode 100644 testsuite/tests/typing-polyvariants-bugs/pr5057_ok.ml create mode 100644 testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.compilers.reference create mode 100644 testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.ml create mode 100644 testsuite/tests/typing-polyvariants-bugs/pr7199_ok.ml create mode 100644 testsuite/tests/typing-polyvariants-bugs/pr7817_bad.ml create mode 100644 testsuite/tests/typing-polyvariants-bugs/pr7824.ml create mode 100644 testsuite/tests/typing-polyvariants-bugs/privrowsabate_ok.ml create mode 100644 testsuite/tests/typing-private-bugs/pr5026_bad.compilers.reference create mode 100644 testsuite/tests/typing-private-bugs/pr5026_bad.ml create mode 100644 testsuite/tests/typing-private-bugs/pr5469_ok.ml create mode 100644 testsuite/tests/typing-private/private.compilers.principal.reference create mode 100644 testsuite/tests/typing-private/private.compilers.reference create mode 100644 testsuite/tests/typing-private/private.ml create mode 100644 testsuite/tests/typing-recmod/gpr1626.ml create mode 100644 testsuite/tests/typing-recmod/pr9494.ml create mode 100644 testsuite/tests/typing-recmod/pr9494.reference create mode 100644 testsuite/tests/typing-recmod/t01bad.compilers.reference create mode 100644 testsuite/tests/typing-recmod/t01bad.ml create mode 100644 testsuite/tests/typing-recmod/t02bad.compilers.reference create mode 100644 testsuite/tests/typing-recmod/t02bad.ml create mode 100644 testsuite/tests/typing-recmod/t03ok.ml create mode 100644 testsuite/tests/typing-recmod/t04bad.compilers.reference create mode 100644 testsuite/tests/typing-recmod/t04bad.ml create mode 100644 testsuite/tests/typing-recmod/t05bad.compilers.reference create mode 100644 testsuite/tests/typing-recmod/t05bad.ml create mode 100644 testsuite/tests/typing-recmod/t06ok.ml create mode 100644 testsuite/tests/typing-recmod/t07bad.compilers.reference create mode 100644 testsuite/tests/typing-recmod/t07bad.ml create mode 100644 testsuite/tests/typing-recmod/t08bad.compilers.reference create mode 100644 testsuite/tests/typing-recmod/t08bad.ml create mode 100644 testsuite/tests/typing-recmod/t09bad.compilers.reference create mode 100644 testsuite/tests/typing-recmod/t09bad.ml create mode 100644 testsuite/tests/typing-recmod/t10ok.ml create mode 100644 testsuite/tests/typing-recmod/t11bad.compilers.reference create mode 100644 testsuite/tests/typing-recmod/t11bad.ml create mode 100644 testsuite/tests/typing-recmod/t12bad.compilers.reference create mode 100644 testsuite/tests/typing-recmod/t12bad.ml create mode 100644 testsuite/tests/typing-recmod/t13ok.ml create mode 100644 testsuite/tests/typing-recmod/t14bad.compilers.reference create mode 100644 testsuite/tests/typing-recmod/t14bad.ml create mode 100644 testsuite/tests/typing-recmod/t15bad.compilers.reference create mode 100644 testsuite/tests/typing-recmod/t15bad.ml create mode 100644 testsuite/tests/typing-recmod/t16ok.ml create mode 100644 testsuite/tests/typing-recmod/t17ok.ml create mode 100644 testsuite/tests/typing-recmod/t18ok.ml create mode 100644 testsuite/tests/typing-recmod/t20ok.ml create mode 100644 testsuite/tests/typing-recmod/t21ok.ml create mode 100644 testsuite/tests/typing-recmod/t22ok.ml create mode 100644 testsuite/tests/typing-recmod/t22ok.mli create mode 100644 testsuite/tests/typing-recordarg/recordarg.ml create mode 100644 testsuite/tests/typing-recordarg/recordarg.ocaml.reference create mode 100644 testsuite/tests/typing-rectypes-bugs/pr5343_bad.compilers.reference create mode 100644 testsuite/tests/typing-rectypes-bugs/pr5343_bad.ml create mode 100644 testsuite/tests/typing-rectypes-bugs/pr6174_bad.compilers.reference create mode 100644 testsuite/tests/typing-rectypes-bugs/pr6174_bad.ml create mode 100644 testsuite/tests/typing-rectypes-bugs/pr6870_bad.compilers.reference create mode 100644 testsuite/tests/typing-rectypes-bugs/pr6870_bad.ml create mode 100644 testsuite/tests/typing-safe-linking/a.ml create mode 100644 testsuite/tests/typing-safe-linking/b_bad.compilers.reference create mode 100644 testsuite/tests/typing-safe-linking/b_bad.ml create mode 100644 testsuite/tests/typing-shadowing-of-pervasives-submodules/largeFile.ml create mode 100644 testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile.ml create mode 100644 testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile.reference create mode 100644 testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile_top.compilers.reference create mode 100644 testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile_top.ml create mode 100644 testsuite/tests/typing-short-paths/errors.ml create mode 100644 testsuite/tests/typing-short-paths/gpr1223.compilers.reference create mode 100644 testsuite/tests/typing-short-paths/gpr1223.ml create mode 100644 testsuite/tests/typing-short-paths/gpr1223_bar.mli create mode 100644 testsuite/tests/typing-short-paths/gpr1223_foo.mli create mode 100644 testsuite/tests/typing-short-paths/pr5918.compilers.reference create mode 100644 testsuite/tests/typing-short-paths/pr5918.ml create mode 100644 testsuite/tests/typing-short-paths/pr6836.compilers.reference create mode 100644 testsuite/tests/typing-short-paths/pr6836.ml create mode 100644 testsuite/tests/typing-short-paths/pr7543.compilers.reference create mode 100644 testsuite/tests/typing-short-paths/pr7543.ml create mode 100644 testsuite/tests/typing-short-paths/short-paths.compilers.reference create mode 100644 testsuite/tests/typing-short-paths/short-paths.ml create mode 100644 testsuite/tests/typing-signatures/els.ml create mode 100644 testsuite/tests/typing-signatures/els.ocaml.reference create mode 100644 testsuite/tests/typing-signatures/pr6371.ml create mode 100644 testsuite/tests/typing-signatures/pr6371.ocaml.reference create mode 100644 testsuite/tests/typing-signatures/pr6672.ml create mode 100644 testsuite/tests/typing-signatures/pr6672.ocaml.reference create mode 100644 testsuite/tests/typing-sigsubst/mpr7852.mli create mode 100644 testsuite/tests/typing-sigsubst/sig_local_aliases.ml create mode 100644 testsuite/tests/typing-sigsubst/sig_local_aliases_syntax_errors.compilers.reference create mode 100644 testsuite/tests/typing-sigsubst/sig_local_aliases_syntax_errors.ml create mode 100644 testsuite/tests/typing-sigsubst/sigsubst.ml create mode 100644 testsuite/tests/typing-sigsubst/test_functor.ml create mode 100644 testsuite/tests/typing-sigsubst/test_loc_modtype_type_eq.ml create mode 100644 testsuite/tests/typing-sigsubst/test_loc_modtype_type_subst.ml create mode 100644 testsuite/tests/typing-sigsubst/test_loc_type_eq.ml create mode 100644 testsuite/tests/typing-sigsubst/test_loc_type_subst.ml create mode 100644 testsuite/tests/typing-sigsubst/test_locations.compilers.reference create mode 100644 testsuite/tests/typing-sigsubst/test_locations.ml create mode 100644 testsuite/tests/typing-typeparam/newtype.ml create mode 100644 testsuite/tests/typing-typeparam/newtype.ocaml.reference create mode 100644 testsuite/tests/typing-unboxed-types/test.ml create mode 100644 testsuite/tests/typing-unboxed-types/test_flat.ml create mode 100644 testsuite/tests/typing-unboxed-types/test_no_flat.ml create mode 100644 testsuite/tests/typing-unboxed/test.ml create mode 100644 testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml create mode 100644 testsuite/tests/typing-warnings/application.ml create mode 100644 testsuite/tests/typing-warnings/coercions.ml create mode 100644 testsuite/tests/typing-warnings/exhaustiveness.ml create mode 100644 testsuite/tests/typing-warnings/never_returns.ml create mode 100644 testsuite/tests/typing-warnings/open_warnings.ml create mode 100644 testsuite/tests/typing-warnings/pr5892.ml create mode 100644 testsuite/tests/typing-warnings/pr6587.ml create mode 100644 testsuite/tests/typing-warnings/pr6872.ml create mode 100644 testsuite/tests/typing-warnings/pr7085.ml create mode 100644 testsuite/tests/typing-warnings/pr7115.ml create mode 100644 testsuite/tests/typing-warnings/pr7261.compilers.reference create mode 100644 testsuite/tests/typing-warnings/pr7261.ml create mode 100644 testsuite/tests/typing-warnings/pr7297.compilers.reference create mode 100644 testsuite/tests/typing-warnings/pr7297.ml create mode 100644 testsuite/tests/typing-warnings/pr7553.ml create mode 100644 testsuite/tests/typing-warnings/pr9244.ml create mode 100644 testsuite/tests/typing-warnings/records.ml create mode 100644 testsuite/tests/typing-warnings/unused_functor_parameter.ml create mode 100644 testsuite/tests/typing-warnings/unused_rec.ml create mode 100644 testsuite/tests/typing-warnings/unused_recmodule.ml create mode 100644 testsuite/tests/typing-warnings/unused_types.ml create mode 100644 testsuite/tests/unboxed-primitive-args/README create mode 100644 testsuite/tests/unboxed-primitive-args/common.ml create mode 100644 testsuite/tests/unboxed-primitive-args/common.mli create mode 100644 testsuite/tests/unboxed-primitive-args/gen_test.ml create mode 100644 testsuite/tests/unboxed-primitive-args/test.ml create mode 100644 testsuite/tests/unboxed-primitive-args/test.reference create mode 100644 testsuite/tests/unboxed-primitive-args/test_common.c create mode 100644 testsuite/tests/unboxed-primitive-args/test_common.h create mode 100644 testsuite/tests/unwind/README create mode 100755 testsuite/tests/unwind/check-linker-version.sh create mode 100644 testsuite/tests/unwind/driver.ml create mode 100644 testsuite/tests/unwind/mylib.ml create mode 100644 testsuite/tests/unwind/mylib.mli create mode 100644 testsuite/tests/unwind/stack_walker.c create mode 100644 testsuite/tests/utils/edit_distance.ml create mode 100644 testsuite/tests/utils/edit_distance.reference create mode 100644 testsuite/tests/utils/magic_number.ml create mode 100644 testsuite/tests/utils/overflow_detection.ml create mode 100644 testsuite/tests/utils/overflow_detection.reference create mode 100644 testsuite/tests/utils/test_strongly_connected_components.ml create mode 100644 testsuite/tests/utils/test_strongly_connected_components.reference create mode 100644 testsuite/tests/warnings/deprecated_module.compilers.reference create mode 100644 testsuite/tests/warnings/deprecated_module.ml create mode 100644 testsuite/tests/warnings/deprecated_module.mli create mode 100644 testsuite/tests/warnings/deprecated_module_assigment.compilers.reference create mode 100644 testsuite/tests/warnings/deprecated_module_assigment.ml create mode 100644 testsuite/tests/warnings/deprecated_module_use.compilers.reference create mode 100644 testsuite/tests/warnings/deprecated_module_use.ml create mode 100644 testsuite/tests/warnings/module_without_cmx.mli create mode 100644 testsuite/tests/warnings/w01.compilers.reference create mode 100644 testsuite/tests/warnings/w01.ml create mode 100644 testsuite/tests/warnings/w03.compilers.reference create mode 100644 testsuite/tests/warnings/w03.ml create mode 100644 testsuite/tests/warnings/w04.compilers.reference create mode 100644 testsuite/tests/warnings/w04.ml create mode 100644 testsuite/tests/warnings/w04_failure.compilers.reference create mode 100644 testsuite/tests/warnings/w04_failure.ml create mode 100644 testsuite/tests/warnings/w06.compilers.reference create mode 100644 testsuite/tests/warnings/w06.ml create mode 100644 testsuite/tests/warnings/w32.compilers.reference create mode 100644 testsuite/tests/warnings/w32.ml create mode 100644 testsuite/tests/warnings/w32.mli create mode 100644 testsuite/tests/warnings/w32b.compilers.reference create mode 100644 testsuite/tests/warnings/w32b.ml create mode 100644 testsuite/tests/warnings/w33.compilers.reference create mode 100644 testsuite/tests/warnings/w33.ml create mode 100644 testsuite/tests/warnings/w45.compilers.reference create mode 100644 testsuite/tests/warnings/w45.ml create mode 100644 testsuite/tests/warnings/w47_inline.compilers.reference create mode 100644 testsuite/tests/warnings/w47_inline.ml create mode 100644 testsuite/tests/warnings/w50.compilers.reference create mode 100644 testsuite/tests/warnings/w50.ml create mode 100644 testsuite/tests/warnings/w51.compilers.reference create mode 100644 testsuite/tests/warnings/w51.ml create mode 100644 testsuite/tests/warnings/w51_bis.compilers.reference create mode 100644 testsuite/tests/warnings/w51_bis.ml create mode 100644 testsuite/tests/warnings/w52.ml create mode 100644 testsuite/tests/warnings/w53.compilers.reference create mode 100644 testsuite/tests/warnings/w53.ml create mode 100644 testsuite/tests/warnings/w54.compilers.reference create mode 100644 testsuite/tests/warnings/w54.ml create mode 100644 testsuite/tests/warnings/w55.flambda.reference create mode 100644 testsuite/tests/warnings/w55.ml create mode 100644 testsuite/tests/warnings/w55.native.reference create mode 100644 testsuite/tests/warnings/w58.ml create mode 100644 testsuite/tests/warnings/w58.native.reference create mode 100644 testsuite/tests/warnings/w59.flambda.reference create mode 100644 testsuite/tests/warnings/w59.ml create mode 100644 testsuite/tests/warnings/w60.compilers.reference create mode 100644 testsuite/tests/warnings/w60.ml create mode 100644 testsuite/tests/warnings/w60.mli create mode 100644 testsuite/tests/win-unicode/mltest.compilers.reference create mode 100644 testsuite/tests/win-unicode/mltest.ml create mode 100644 testsuite/tools/Makefile create mode 100644 testsuite/tools/asmgen_amd64.S create mode 100644 testsuite/tools/asmgen_arm.S create mode 100644 testsuite/tools/asmgen_arm64.S create mode 100644 testsuite/tools/asmgen_i386.S create mode 100644 testsuite/tools/asmgen_i386nt.asm create mode 100644 testsuite/tools/asmgen_power.S create mode 100644 testsuite/tools/asmgen_riscv.S create mode 100644 testsuite/tools/asmgen_s390x.S create mode 100644 testsuite/tools/codegen_main.ml create mode 100644 testsuite/tools/expect_test.ml create mode 100644 testsuite/tools/lexcmm.mli create mode 100644 testsuite/tools/lexcmm.mll create mode 100644 testsuite/tools/parsecmm.mly create mode 100644 testsuite/tools/parsecmmaux.ml create mode 100644 testsuite/tools/parsecmmaux.mli create mode 100644 tools/.depend create mode 100644 tools/Makefile create mode 100755 tools/autogen create mode 100644 tools/caml_tex.ml create mode 100755 tools/check-parser-uptodate-or-warn.sh create mode 100755 tools/check-symbol-names create mode 100755 tools/check-typo create mode 100755 tools/check-typo-since create mode 100644 tools/checkstack.c create mode 100644 tools/ci/appveyor/appveyor_build.cmd create mode 100644 tools/ci/appveyor/appveyor_build.sh create mode 100755 tools/ci/inria/bootstrap create mode 100755 tools/ci/inria/dune-build create mode 100755 tools/ci/inria/extra-checks create mode 100644 tools/ci/inria/lsan-suppr.txt create mode 100755 tools/ci/inria/main create mode 100755 tools/ci/inria/other-configs create mode 100644 tools/ci/inria/remove-sinh-primitive.patch create mode 100755 tools/ci/travis/travis-ci.sh create mode 100644 tools/cmpbyt.ml create mode 100644 tools/cvt_emit.mll create mode 100644 tools/dumpobj.ml create mode 100644 tools/dune create mode 100644 tools/eqparsetree.ml create mode 100644 tools/eventlog_metadata.in create mode 100644 tools/gdb-macros create mode 100755 tools/git-dev-options.sh create mode 100644 tools/lintapidiff.ml create mode 100644 tools/magic create mode 100755 tools/make-package-macosx create mode 100755 tools/make-version-header.sh create mode 100644 tools/make_opcodes.mll create mode 100644 tools/mantis2gh_stripped.csv create mode 100644 tools/markdown-add-pr-links.sh create mode 100755 tools/msvs-promote-path create mode 100644 tools/objinfo.ml create mode 100644 tools/objinfo_helper.c create mode 100755 tools/ocaml-objcopy-macosx create mode 100644 tools/ocamlcp.ml create mode 100644 tools/ocamldep.ml create mode 100644 tools/ocamlmklib.ml create mode 100644 tools/ocamlmktop.ml create mode 100644 tools/ocamloptp.ml create mode 100644 tools/ocamlprof.ml create mode 100755 tools/ocamlsize create mode 100755 tools/pre-commit-githook create mode 100644 tools/primreq.ml create mode 100644 tools/profiling.ml create mode 100644 tools/profiling.mli create mode 100644 tools/read_cmt.ml create mode 100644 tools/release-checklist create mode 100644 tools/stripdebug.ml create mode 100644 toplevel/dune create mode 100644 toplevel/expunge.ml create mode 100644 toplevel/genprintval.ml create mode 100644 toplevel/genprintval.mli create mode 100644 toplevel/opttopdirs.ml create mode 100644 toplevel/opttopdirs.mli create mode 100644 toplevel/opttoploop.ml create mode 100644 toplevel/opttoploop.mli create mode 100644 toplevel/opttopmain.ml create mode 100644 toplevel/opttopmain.mli create mode 100644 toplevel/opttopstart.ml create mode 100644 toplevel/topdirs.ml create mode 100644 toplevel/topdirs.mli create mode 100644 toplevel/toploop.ml create mode 100644 toplevel/toploop.mli create mode 100644 toplevel/topmain.ml create mode 100644 toplevel/topmain.mli create mode 100644 toplevel/topstart.ml create mode 100644 toplevel/trace.ml create mode 100644 toplevel/trace.mli create mode 100644 typing/HACKING.adoc create mode 100644 typing/TODO.md create mode 100644 typing/annot.mli create mode 100644 typing/btype.ml create mode 100644 typing/btype.mli create mode 100644 typing/cmt2annot.ml create mode 100644 typing/ctype.ml create mode 100644 typing/ctype.mli create mode 100644 typing/datarepr.ml create mode 100644 typing/datarepr.mli create mode 100644 typing/env.ml create mode 100644 typing/env.mli create mode 100644 typing/envaux.ml create mode 100644 typing/envaux.mli create mode 100644 typing/ident.ml create mode 100644 typing/ident.mli create mode 100644 typing/includeclass.ml create mode 100644 typing/includeclass.mli create mode 100644 typing/includecore.ml create mode 100644 typing/includecore.mli create mode 100644 typing/includemod.ml create mode 100644 typing/includemod.mli create mode 100644 typing/mtype.ml create mode 100644 typing/mtype.mli create mode 100644 typing/oprint.ml create mode 100644 typing/oprint.mli create mode 100644 typing/outcometree.mli create mode 100644 typing/parmatch.ml create mode 100644 typing/parmatch.mli create mode 100644 typing/path.ml create mode 100644 typing/path.mli create mode 100644 typing/persistent_env.ml create mode 100644 typing/persistent_env.mli create mode 100644 typing/predef.ml create mode 100644 typing/predef.mli create mode 100644 typing/primitive.ml create mode 100644 typing/primitive.mli create mode 100644 typing/printpat.ml create mode 100644 typing/printpat.mli create mode 100644 typing/printtyp.ml create mode 100644 typing/printtyp.mli create mode 100644 typing/printtyped.ml create mode 100644 typing/printtyped.mli create mode 100644 typing/rec_check.ml create mode 100644 typing/rec_check.mli create mode 100644 typing/stypes.ml create mode 100644 typing/stypes.mli create mode 100644 typing/subst.ml create mode 100644 typing/subst.mli create mode 100644 typing/tast_iterator.ml create mode 100644 typing/tast_iterator.mli create mode 100644 typing/tast_mapper.ml create mode 100644 typing/tast_mapper.mli create mode 100644 typing/type_immediacy.ml create mode 100644 typing/type_immediacy.mli create mode 100644 typing/typeclass.ml create mode 100644 typing/typeclass.mli create mode 100644 typing/typecore.ml create mode 100644 typing/typecore.mli create mode 100644 typing/typedecl.ml create mode 100644 typing/typedecl.mli create mode 100644 typing/typedecl_immediacy.ml create mode 100644 typing/typedecl_immediacy.mli create mode 100644 typing/typedecl_properties.ml create mode 100644 typing/typedecl_properties.mli create mode 100644 typing/typedecl_separability.ml create mode 100644 typing/typedecl_separability.mli create mode 100644 typing/typedecl_unboxed.ml create mode 100644 typing/typedecl_unboxed.mli create mode 100644 typing/typedecl_variance.ml create mode 100644 typing/typedecl_variance.mli create mode 100644 typing/typedtree.ml create mode 100644 typing/typedtree.mli create mode 100644 typing/typemod.ml create mode 100644 typing/typemod.mli create mode 100644 typing/typeopt.ml create mode 100644 typing/typeopt.mli create mode 100644 typing/types.ml create mode 100644 typing/types.mli create mode 100644 typing/typetexp.ml create mode 100644 typing/typetexp.mli create mode 100644 typing/untypeast.ml create mode 100644 typing/untypeast.mli create mode 100644 utils/HACKING.adoc create mode 100644 utils/Makefile create mode 100644 utils/arg_helper.ml create mode 100644 utils/arg_helper.mli create mode 100644 utils/build_path_prefix_map.ml create mode 100644 utils/build_path_prefix_map.mli create mode 100644 utils/ccomp.ml create mode 100644 utils/ccomp.mli create mode 100644 utils/clflags.ml create mode 100644 utils/clflags.mli create mode 100644 utils/config.mli create mode 100644 utils/config.mlp create mode 100644 utils/consistbl.ml create mode 100644 utils/consistbl.mli create mode 100644 utils/domainstate.ml.c create mode 100644 utils/domainstate.mli.c create mode 100644 utils/dune create mode 100644 utils/identifiable.ml create mode 100644 utils/identifiable.mli create mode 100644 utils/int_replace_polymorphic_compare.ml create mode 100644 utils/int_replace_polymorphic_compare.mli create mode 100644 utils/load_path.ml create mode 100644 utils/load_path.mli create mode 100644 utils/misc.ml create mode 100644 utils/misc.mli create mode 100644 utils/numbers.ml create mode 100644 utils/numbers.mli create mode 100644 utils/profile.ml create mode 100644 utils/profile.mli create mode 100644 utils/strongly_connected_components.ml create mode 100644 utils/strongly_connected_components.mli create mode 100644 utils/targetint.ml create mode 100644 utils/targetint.mli create mode 100644 utils/terminfo.ml create mode 100644 utils/terminfo.mli create mode 100644 utils/warnings.ml create mode 100644 utils/warnings.mli create mode 100644 yacc/Makefile create mode 100644 yacc/closure.c create mode 100644 yacc/defs.h create mode 100644 yacc/error.c create mode 100644 yacc/lalr.c create mode 100644 yacc/lr0.c create mode 100644 yacc/main.c create mode 100644 yacc/mkpar.c create mode 100644 yacc/output.c create mode 100644 yacc/reader.c create mode 100644 yacc/skeleton.c create mode 100644 yacc/symtab.c create mode 100644 yacc/verbose.c create mode 100644 yacc/warshall.c create mode 100644 yacc/wstr.c diff --git a/.depend b/.depend new file mode 100644 index 00000000..1c2692e1 --- /dev/null +++ b/.depend @@ -0,0 +1,6428 @@ +utils/arg_helper.cmo : \ + utils/arg_helper.cmi +utils/arg_helper.cmx : \ + utils/arg_helper.cmi +utils/arg_helper.cmi : +utils/build_path_prefix_map.cmo : \ + utils/build_path_prefix_map.cmi +utils/build_path_prefix_map.cmx : \ + utils/build_path_prefix_map.cmi +utils/build_path_prefix_map.cmi : +utils/ccomp.cmo : \ + utils/profile.cmi \ + utils/misc.cmi \ + utils/load_path.cmi \ + utils/config.cmi \ + utils/clflags.cmi \ + utils/ccomp.cmi +utils/ccomp.cmx : \ + utils/profile.cmx \ + utils/misc.cmx \ + utils/load_path.cmx \ + utils/config.cmx \ + utils/clflags.cmx \ + utils/ccomp.cmi +utils/ccomp.cmi : +utils/clflags.cmo : \ + utils/profile.cmi \ + utils/numbers.cmi \ + utils/misc.cmi \ + utils/config.cmi \ + utils/arg_helper.cmi \ + utils/clflags.cmi +utils/clflags.cmx : \ + utils/profile.cmx \ + utils/numbers.cmx \ + utils/misc.cmx \ + utils/config.cmx \ + utils/arg_helper.cmx \ + utils/clflags.cmi +utils/clflags.cmi : \ + utils/profile.cmi \ + utils/misc.cmi +utils/config.cmo : \ + utils/config.cmi +utils/config.cmx : \ + utils/config.cmi +utils/config.cmi : +utils/consistbl.cmo : \ + utils/misc.cmi \ + utils/consistbl.cmi +utils/consistbl.cmx : \ + utils/misc.cmx \ + utils/consistbl.cmi +utils/consistbl.cmi : \ + utils/misc.cmi +utils/domainstate.cmo : \ + utils/domainstate.cmi +utils/domainstate.cmx : \ + utils/domainstate.cmi +utils/domainstate.cmi : +utils/identifiable.cmo : \ + utils/misc.cmi \ + utils/identifiable.cmi +utils/identifiable.cmx : \ + utils/misc.cmx \ + utils/identifiable.cmi +utils/identifiable.cmi : +utils/int_replace_polymorphic_compare.cmo : \ + utils/int_replace_polymorphic_compare.cmi +utils/int_replace_polymorphic_compare.cmx : \ + utils/int_replace_polymorphic_compare.cmi +utils/int_replace_polymorphic_compare.cmi : +utils/load_path.cmo : \ + utils/misc.cmi \ + utils/load_path.cmi +utils/load_path.cmx : \ + utils/misc.cmx \ + utils/load_path.cmi +utils/load_path.cmi : +utils/misc.cmo : \ + utils/config.cmi \ + utils/build_path_prefix_map.cmi \ + utils/misc.cmi +utils/misc.cmx : \ + utils/config.cmx \ + utils/build_path_prefix_map.cmx \ + utils/misc.cmi +utils/misc.cmi : \ + utils/build_path_prefix_map.cmi +utils/numbers.cmo : \ + utils/misc.cmi \ + utils/identifiable.cmi \ + utils/numbers.cmi +utils/numbers.cmx : \ + utils/misc.cmx \ + utils/identifiable.cmx \ + utils/numbers.cmi +utils/numbers.cmi : \ + utils/identifiable.cmi +utils/profile.cmo : \ + utils/misc.cmi \ + utils/profile.cmi +utils/profile.cmx : \ + utils/misc.cmx \ + utils/profile.cmi +utils/profile.cmi : +utils/strongly_connected_components.cmo : \ + utils/numbers.cmi \ + utils/misc.cmi \ + utils/identifiable.cmi \ + utils/strongly_connected_components.cmi +utils/strongly_connected_components.cmx : \ + utils/numbers.cmx \ + utils/misc.cmx \ + utils/identifiable.cmx \ + utils/strongly_connected_components.cmi +utils/strongly_connected_components.cmi : \ + utils/identifiable.cmi +utils/targetint.cmo : \ + utils/misc.cmi \ + utils/targetint.cmi +utils/targetint.cmx : \ + utils/misc.cmx \ + utils/targetint.cmi +utils/targetint.cmi : +utils/terminfo.cmo : \ + utils/terminfo.cmi +utils/terminfo.cmx : \ + utils/terminfo.cmi +utils/terminfo.cmi : +utils/warnings.cmo : \ + utils/misc.cmi \ + utils/warnings.cmi +utils/warnings.cmx : \ + utils/misc.cmx \ + utils/warnings.cmi +utils/warnings.cmi : +parsing/ast_helper.cmo : \ + parsing/syntaxerr.cmi \ + parsing/parsetree.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + parsing/docstrings.cmi \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmi +parsing/ast_helper.cmx : \ + parsing/syntaxerr.cmx \ + parsing/parsetree.cmi \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + parsing/docstrings.cmx \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmi +parsing/ast_helper.cmi : \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + parsing/docstrings.cmi \ + parsing/asttypes.cmi +parsing/ast_invariants.cmo : \ + parsing/syntaxerr.cmi \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/builtin_attributes.cmi \ + parsing/asttypes.cmi \ + parsing/ast_iterator.cmi \ + parsing/ast_invariants.cmi +parsing/ast_invariants.cmx : \ + parsing/syntaxerr.cmx \ + parsing/parsetree.cmi \ + parsing/longident.cmx \ + parsing/builtin_attributes.cmx \ + parsing/asttypes.cmi \ + parsing/ast_iterator.cmx \ + parsing/ast_invariants.cmi +parsing/ast_invariants.cmi : \ + parsing/parsetree.cmi +parsing/ast_iterator.cmo : \ + parsing/parsetree.cmi \ + parsing/location.cmi \ + parsing/ast_iterator.cmi +parsing/ast_iterator.cmx : \ + parsing/parsetree.cmi \ + parsing/location.cmx \ + parsing/ast_iterator.cmi +parsing/ast_iterator.cmi : \ + parsing/parsetree.cmi \ + parsing/location.cmi +parsing/ast_mapper.cmo : \ + parsing/parsetree.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + utils/config.cmi \ + utils/clflags.cmi \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmi \ + parsing/ast_mapper.cmi +parsing/ast_mapper.cmx : \ + parsing/parsetree.cmi \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + utils/load_path.cmx \ + utils/config.cmx \ + utils/clflags.cmx \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmx \ + parsing/ast_mapper.cmi +parsing/ast_mapper.cmi : \ + parsing/parsetree.cmi \ + parsing/location.cmi +parsing/asttypes.cmi : \ + parsing/location.cmi +parsing/attr_helper.cmo : \ + parsing/parsetree.cmi \ + parsing/location.cmi \ + parsing/asttypes.cmi \ + parsing/attr_helper.cmi +parsing/attr_helper.cmx : \ + parsing/parsetree.cmi \ + parsing/location.cmx \ + parsing/asttypes.cmi \ + parsing/attr_helper.cmi +parsing/attr_helper.cmi : \ + parsing/parsetree.cmi \ + parsing/location.cmi \ + parsing/asttypes.cmi +parsing/builtin_attributes.cmo : \ + utils/warnings.cmi \ + parsing/parsetree.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + parsing/asttypes.cmi \ + parsing/builtin_attributes.cmi +parsing/builtin_attributes.cmx : \ + utils/warnings.cmx \ + parsing/parsetree.cmi \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + parsing/asttypes.cmi \ + parsing/builtin_attributes.cmi +parsing/builtin_attributes.cmi : \ + parsing/parsetree.cmi \ + utils/misc.cmi \ + parsing/location.cmi +parsing/camlinternalMenhirLib.cmo : \ + parsing/camlinternalMenhirLib.cmi +parsing/camlinternalMenhirLib.cmx : \ + parsing/camlinternalMenhirLib.cmi +parsing/camlinternalMenhirLib.cmi : +parsing/depend.cmo : \ + parsing/parsetree.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + utils/clflags.cmi \ + parsing/builtin_attributes.cmi \ + parsing/asttypes.cmi \ + parsing/depend.cmi +parsing/depend.cmx : \ + parsing/parsetree.cmi \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + utils/clflags.cmx \ + parsing/builtin_attributes.cmx \ + parsing/asttypes.cmi \ + parsing/depend.cmi +parsing/depend.cmi : \ + parsing/parsetree.cmi \ + utils/misc.cmi \ + parsing/longident.cmi +parsing/docstrings.cmo : \ + utils/warnings.cmi \ + parsing/parsetree.cmi \ + parsing/location.cmi \ + parsing/docstrings.cmi +parsing/docstrings.cmx : \ + utils/warnings.cmx \ + parsing/parsetree.cmi \ + parsing/location.cmx \ + parsing/docstrings.cmi +parsing/docstrings.cmi : \ + parsing/parsetree.cmi \ + parsing/location.cmi +parsing/lexer.cmo : \ + utils/warnings.cmi \ + parsing/parser.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + parsing/docstrings.cmi \ + parsing/lexer.cmi +parsing/lexer.cmx : \ + utils/warnings.cmx \ + parsing/parser.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + parsing/docstrings.cmx \ + parsing/lexer.cmi +parsing/lexer.cmi : \ + parsing/parser.cmi \ + parsing/location.cmi +parsing/location.cmo : \ + utils/warnings.cmi \ + utils/terminfo.cmi \ + utils/misc.cmi \ + utils/clflags.cmi \ + utils/build_path_prefix_map.cmi \ + parsing/location.cmi +parsing/location.cmx : \ + utils/warnings.cmx \ + utils/terminfo.cmx \ + utils/misc.cmx \ + utils/clflags.cmx \ + utils/build_path_prefix_map.cmx \ + parsing/location.cmi +parsing/location.cmi : \ + utils/warnings.cmi +parsing/longident.cmo : \ + utils/misc.cmi \ + parsing/longident.cmi +parsing/longident.cmx : \ + utils/misc.cmx \ + parsing/longident.cmi +parsing/longident.cmi : +parsing/parse.cmo : \ + parsing/syntaxerr.cmi \ + parsing/pprintast.cmi \ + parsing/parser.cmi \ + parsing/location.cmi \ + parsing/lexer.cmi \ + parsing/docstrings.cmi \ + parsing/parse.cmi +parsing/parse.cmx : \ + parsing/syntaxerr.cmx \ + parsing/pprintast.cmx \ + parsing/parser.cmx \ + parsing/location.cmx \ + parsing/lexer.cmx \ + parsing/docstrings.cmx \ + parsing/parse.cmi +parsing/parse.cmi : \ + parsing/parsetree.cmi \ + parsing/longident.cmi +parsing/parser.cmo : \ + parsing/syntaxerr.cmi \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + parsing/docstrings.cmi \ + utils/clflags.cmi \ + parsing/camlinternalMenhirLib.cmi \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmi \ + parsing/parser.cmi +parsing/parser.cmx : \ + parsing/syntaxerr.cmx \ + parsing/parsetree.cmi \ + parsing/longident.cmx \ + parsing/location.cmx \ + parsing/docstrings.cmx \ + utils/clflags.cmx \ + parsing/camlinternalMenhirLib.cmx \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmx \ + parsing/parser.cmi +parsing/parser.cmi : \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + parsing/docstrings.cmi \ + parsing/camlinternalMenhirLib.cmi +parsing/parsetree.cmi : \ + parsing/longident.cmi \ + parsing/location.cmi \ + parsing/asttypes.cmi +parsing/pprintast.cmo : \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmi \ + parsing/pprintast.cmi +parsing/pprintast.cmx : \ + parsing/parsetree.cmi \ + parsing/longident.cmx \ + parsing/location.cmx \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmx \ + parsing/pprintast.cmi +parsing/pprintast.cmi : \ + parsing/parsetree.cmi \ + parsing/longident.cmi +parsing/printast.cmo : \ + parsing/pprintast.cmi \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + utils/clflags.cmi \ + parsing/asttypes.cmi \ + parsing/printast.cmi +parsing/printast.cmx : \ + parsing/pprintast.cmx \ + parsing/parsetree.cmi \ + parsing/longident.cmx \ + parsing/location.cmx \ + utils/clflags.cmx \ + parsing/asttypes.cmi \ + parsing/printast.cmi +parsing/printast.cmi : \ + parsing/parsetree.cmi +parsing/syntaxerr.cmo : \ + parsing/location.cmi \ + parsing/syntaxerr.cmi +parsing/syntaxerr.cmx : \ + parsing/location.cmx \ + parsing/syntaxerr.cmi +parsing/syntaxerr.cmi : \ + parsing/location.cmi +typing/annot.cmi : \ + parsing/location.cmi +typing/btype.cmo : \ + typing/types.cmi \ + typing/path.cmi \ + typing/ident.cmi \ + parsing/asttypes.cmi \ + typing/btype.cmi +typing/btype.cmx : \ + typing/types.cmx \ + typing/path.cmx \ + typing/ident.cmx \ + parsing/asttypes.cmi \ + typing/btype.cmi +typing/btype.cmi : \ + typing/types.cmi \ + typing/path.cmi \ + parsing/asttypes.cmi +typing/cmt2annot.cmo : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/tast_iterator.cmi \ + typing/stypes.cmi \ + typing/path.cmi \ + typing/oprint.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/envaux.cmi \ + typing/env.cmi \ + file_formats/cmt_format.cmi \ + parsing/asttypes.cmi \ + typing/annot.cmi +typing/cmt2annot.cmx : \ + typing/types.cmx \ + typing/typedtree.cmx \ + typing/tast_iterator.cmx \ + typing/stypes.cmx \ + typing/path.cmx \ + typing/oprint.cmx \ + parsing/location.cmx \ + typing/ident.cmx \ + typing/envaux.cmx \ + typing/env.cmx \ + file_formats/cmt_format.cmx \ + parsing/asttypes.cmi \ + typing/annot.cmi +typing/ctype.cmo : \ + typing/types.cmi \ + typing/type_immediacy.cmi \ + typing/subst.cmi \ + typing/predef.cmi \ + typing/path.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + utils/clflags.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + typing/ctype.cmi +typing/ctype.cmx : \ + typing/types.cmx \ + typing/type_immediacy.cmx \ + typing/subst.cmx \ + typing/predef.cmx \ + typing/path.cmx \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + utils/clflags.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + typing/ctype.cmi +typing/ctype.cmi : \ + typing/types.cmi \ + typing/type_immediacy.cmi \ + typing/path.cmi \ + parsing/longident.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + parsing/asttypes.cmi +typing/datarepr.cmo : \ + typing/types.cmi \ + typing/path.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + typing/datarepr.cmi +typing/datarepr.cmx : \ + typing/types.cmx \ + typing/path.cmx \ + parsing/location.cmx \ + typing/ident.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + typing/datarepr.cmi +typing/datarepr.cmi : \ + typing/types.cmi \ + typing/path.cmi \ + typing/ident.cmi +typing/env.cmo : \ + utils/warnings.cmi \ + typing/types.cmi \ + typing/subst.cmi \ + typing/predef.cmi \ + typing/persistent_env.cmi \ + typing/path.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + typing/ident.cmi \ + typing/datarepr.cmi \ + file_formats/cmi_format.cmi \ + utils/clflags.cmi \ + parsing/builtin_attributes.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + typing/env.cmi +typing/env.cmx : \ + utils/warnings.cmx \ + typing/types.cmx \ + typing/subst.cmx \ + typing/predef.cmx \ + typing/persistent_env.cmx \ + typing/path.cmx \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + utils/load_path.cmx \ + typing/ident.cmx \ + typing/datarepr.cmx \ + file_formats/cmi_format.cmx \ + utils/clflags.cmx \ + parsing/builtin_attributes.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + typing/env.cmi +typing/env.cmi : \ + utils/warnings.cmi \ + typing/types.cmi \ + typing/subst.cmi \ + typing/path.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + typing/ident.cmi \ + file_formats/cmi_format.cmi \ + parsing/asttypes.cmi +typing/envaux.cmo : \ + typing/subst.cmi \ + typing/printtyp.cmi \ + typing/path.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + parsing/asttypes.cmi \ + typing/envaux.cmi +typing/envaux.cmx : \ + typing/subst.cmx \ + typing/printtyp.cmx \ + typing/path.cmx \ + parsing/location.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + parsing/asttypes.cmi \ + typing/envaux.cmi +typing/envaux.cmi : \ + typing/subst.cmi \ + typing/path.cmi \ + typing/env.cmi +typing/ident.cmo : \ + utils/misc.cmi \ + utils/identifiable.cmi \ + utils/clflags.cmi \ + typing/ident.cmi +typing/ident.cmx : \ + utils/misc.cmx \ + utils/identifiable.cmx \ + utils/clflags.cmx \ + typing/ident.cmi +typing/ident.cmi : \ + utils/identifiable.cmi +typing/includeclass.cmo : \ + typing/types.cmi \ + typing/printtyp.cmi \ + typing/path.cmi \ + typing/ctype.cmi \ + parsing/builtin_attributes.cmi \ + typing/includeclass.cmi +typing/includeclass.cmx : \ + typing/types.cmx \ + typing/printtyp.cmx \ + typing/path.cmx \ + typing/ctype.cmx \ + parsing/builtin_attributes.cmx \ + typing/includeclass.cmi +typing/includeclass.cmi : \ + typing/types.cmi \ + parsing/location.cmi \ + typing/env.cmi \ + typing/ctype.cmi +typing/includecore.cmo : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/type_immediacy.cmi \ + typing/printtyp.cmi \ + typing/path.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + parsing/builtin_attributes.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + typing/includecore.cmi +typing/includecore.cmx : \ + typing/types.cmx \ + typing/typedtree.cmx \ + typing/type_immediacy.cmx \ + typing/printtyp.cmx \ + typing/path.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + typing/ctype.cmx \ + parsing/builtin_attributes.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + typing/includecore.cmi +typing/includecore.cmi : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/type_immediacy.cmi \ + typing/path.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi +typing/includemod.cmo : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/subst.cmi \ + typing/printtyp.cmi \ + typing/primitive.cmi \ + typing/predef.cmi \ + typing/path.cmi \ + typing/oprint.cmi \ + typing/mtype.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + typing/includecore.cmi \ + typing/includeclass.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + file_formats/cmt_format.cmi \ + utils/clflags.cmi \ + parsing/builtin_attributes.cmi \ + typing/btype.cmi \ + typing/includemod.cmi +typing/includemod.cmx : \ + typing/types.cmx \ + typing/typedtree.cmx \ + typing/subst.cmx \ + typing/printtyp.cmx \ + typing/primitive.cmx \ + typing/predef.cmx \ + typing/path.cmx \ + typing/oprint.cmx \ + typing/mtype.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + typing/includecore.cmx \ + typing/includeclass.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + typing/ctype.cmx \ + file_formats/cmt_format.cmx \ + utils/clflags.cmx \ + parsing/builtin_attributes.cmx \ + typing/btype.cmx \ + typing/includemod.cmi +typing/includemod.cmi : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/path.cmi \ + parsing/location.cmi \ + typing/includecore.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi +typing/mtype.cmo : \ + typing/types.cmi \ + typing/subst.cmi \ + typing/path.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + utils/clflags.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + typing/mtype.cmi +typing/mtype.cmx : \ + typing/types.cmx \ + typing/subst.cmx \ + typing/path.cmx \ + parsing/location.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + typing/ctype.cmx \ + utils/clflags.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + typing/mtype.cmi +typing/mtype.cmi : \ + typing/types.cmi \ + typing/path.cmi \ + typing/ident.cmi \ + typing/env.cmi +typing/oprint.cmo : \ + parsing/pprintast.cmi \ + typing/outcometree.cmi \ + parsing/asttypes.cmi \ + typing/oprint.cmi +typing/oprint.cmx : \ + parsing/pprintast.cmx \ + typing/outcometree.cmi \ + parsing/asttypes.cmi \ + typing/oprint.cmi +typing/oprint.cmi : \ + typing/outcometree.cmi +typing/outcometree.cmi : \ + typing/type_immediacy.cmi \ + parsing/asttypes.cmi +typing/parmatch.cmo : \ + utils/warnings.cmi \ + typing/untypeast.cmi \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/tast_iterator.cmi \ + typing/subst.cmi \ + typing/printpat.cmi \ + typing/predef.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + utils/config.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmi \ + typing/parmatch.cmi +typing/parmatch.cmx : \ + utils/warnings.cmx \ + typing/untypeast.cmx \ + typing/types.cmx \ + typing/typedtree.cmx \ + typing/tast_iterator.cmx \ + typing/subst.cmx \ + typing/printpat.cmx \ + typing/predef.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + typing/ctype.cmx \ + utils/config.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmx \ + typing/parmatch.cmi +typing/parmatch.cmi : \ + typing/types.cmi \ + typing/typedtree.cmi \ + parsing/parsetree.cmi \ + parsing/location.cmi \ + typing/env.cmi \ + parsing/asttypes.cmi +typing/path.cmo : \ + typing/ident.cmi \ + typing/path.cmi +typing/path.cmx : \ + typing/ident.cmx \ + typing/path.cmi +typing/path.cmi : \ + typing/ident.cmi +typing/persistent_env.cmo : \ + utils/warnings.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + utils/consistbl.cmi \ + utils/config.cmi \ + file_formats/cmi_format.cmi \ + utils/clflags.cmi \ + typing/persistent_env.cmi +typing/persistent_env.cmx : \ + utils/warnings.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + utils/load_path.cmx \ + utils/consistbl.cmx \ + utils/config.cmx \ + file_formats/cmi_format.cmx \ + utils/clflags.cmx \ + typing/persistent_env.cmi +typing/persistent_env.cmi : \ + typing/types.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + utils/consistbl.cmi \ + file_formats/cmi_format.cmi +typing/predef.cmo : \ + typing/types.cmi \ + typing/type_immediacy.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmi \ + typing/predef.cmi +typing/predef.cmx : \ + typing/types.cmx \ + typing/type_immediacy.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + parsing/location.cmx \ + typing/ident.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmx \ + typing/predef.cmi +typing/predef.cmi : \ + typing/types.cmi \ + typing/path.cmi \ + typing/ident.cmi +typing/primitive.cmo : \ + parsing/parsetree.cmi \ + typing/outcometree.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + parsing/attr_helper.cmi \ + typing/primitive.cmi +typing/primitive.cmx : \ + parsing/parsetree.cmi \ + typing/outcometree.cmi \ + utils/misc.cmx \ + parsing/location.cmx \ + parsing/attr_helper.cmx \ + typing/primitive.cmi +typing/primitive.cmi : \ + parsing/parsetree.cmi \ + typing/outcometree.cmi \ + parsing/location.cmi +typing/printpat.cmo : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/ident.cmi \ + parsing/asttypes.cmi \ + typing/printpat.cmi +typing/printpat.cmx : \ + typing/types.cmx \ + typing/typedtree.cmx \ + typing/ident.cmx \ + parsing/asttypes.cmi \ + typing/printpat.cmi +typing/printpat.cmi : \ + typing/typedtree.cmi \ + parsing/asttypes.cmi +typing/printtyp.cmo : \ + utils/warnings.cmi \ + typing/types.cmi \ + typing/type_immediacy.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 \ + typing/env.cmi \ + typing/ctype.cmi \ + utils/clflags.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + typing/printtyp.cmi +typing/printtyp.cmx : \ + utils/warnings.cmx \ + typing/types.cmx \ + typing/type_immediacy.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 \ + 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/path.cmi \ + typing/outcometree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + parsing/asttypes.cmi +typing/printtyped.cmo : \ + typing/types.cmi \ + typing/typedtree.cmi \ + parsing/printast.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + utils/clflags.cmi \ + parsing/asttypes.cmi \ + typing/printtyped.cmi +typing/printtyped.cmx : \ + typing/types.cmx \ + typing/typedtree.cmx \ + parsing/printast.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + parsing/longident.cmx \ + parsing/location.cmx \ + typing/ident.cmx \ + utils/clflags.cmx \ + parsing/asttypes.cmi \ + typing/printtyped.cmi +typing/printtyped.cmi : \ + typing/typedtree.cmi +typing/rec_check.cmo : \ + typing/types.cmi \ + typing/typeopt.cmi \ + typing/typedtree.cmi \ + typing/primitive.cmi \ + typing/path.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + parsing/asttypes.cmi \ + typing/rec_check.cmi +typing/rec_check.cmx : \ + typing/types.cmx \ + typing/typeopt.cmx \ + typing/typedtree.cmx \ + typing/primitive.cmx \ + typing/path.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + parsing/asttypes.cmi \ + typing/rec_check.cmi +typing/rec_check.cmi : \ + typing/typedtree.cmi \ + typing/ident.cmi +typing/stypes.cmo : \ + typing/typedtree.cmi \ + typing/printtyp.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + utils/clflags.cmi \ + typing/annot.cmi \ + typing/stypes.cmi +typing/stypes.cmx : \ + typing/typedtree.cmx \ + typing/printtyp.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + utils/clflags.cmx \ + typing/annot.cmi \ + typing/stypes.cmi +typing/stypes.cmi : \ + typing/typedtree.cmi \ + parsing/location.cmi \ + typing/annot.cmi +typing/subst.cmo : \ + typing/types.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + utils/clflags.cmi \ + typing/btype.cmi \ + parsing/ast_mapper.cmi \ + typing/subst.cmi +typing/subst.cmx : \ + typing/types.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + utils/misc.cmx \ + parsing/location.cmx \ + typing/ident.cmx \ + utils/clflags.cmx \ + typing/btype.cmx \ + parsing/ast_mapper.cmx \ + typing/subst.cmi +typing/subst.cmi : \ + typing/types.cmi \ + typing/path.cmi \ + typing/ident.cmi +typing/tast_iterator.cmo : \ + typing/typedtree.cmi \ + typing/env.cmi \ + parsing/asttypes.cmi \ + typing/tast_iterator.cmi +typing/tast_iterator.cmx : \ + typing/typedtree.cmx \ + typing/env.cmx \ + parsing/asttypes.cmi \ + typing/tast_iterator.cmi +typing/tast_iterator.cmi : \ + typing/typedtree.cmi \ + typing/env.cmi \ + parsing/asttypes.cmi +typing/tast_mapper.cmo : \ + typing/typedtree.cmi \ + typing/env.cmi \ + parsing/asttypes.cmi \ + typing/tast_mapper.cmi +typing/tast_mapper.cmx : \ + typing/typedtree.cmx \ + typing/env.cmx \ + parsing/asttypes.cmi \ + typing/tast_mapper.cmi +typing/tast_mapper.cmi : \ + typing/typedtree.cmi \ + typing/env.cmi \ + parsing/asttypes.cmi +typing/type_immediacy.cmo : \ + parsing/builtin_attributes.cmi \ + typing/type_immediacy.cmi +typing/type_immediacy.cmx : \ + parsing/builtin_attributes.cmx \ + typing/type_immediacy.cmi +typing/type_immediacy.cmi : \ + parsing/parsetree.cmi +typing/typeclass.cmo : \ + utils/warnings.cmi \ + typing/typetexp.cmi \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/typedecl_variance.cmi \ + typing/typedecl.cmi \ + typing/typecore.cmi \ + typing/subst.cmi \ + typing/printtyp.cmi \ + typing/predef.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + typing/oprint.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/includeclass.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + file_formats/cmt_format.cmi \ + utils/clflags.cmi \ + parsing/builtin_attributes.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmi \ + typing/typeclass.cmi +typing/typeclass.cmx : \ + utils/warnings.cmx \ + typing/typetexp.cmx \ + typing/types.cmx \ + typing/typedtree.cmx \ + typing/typedecl_variance.cmx \ + typing/typedecl.cmx \ + typing/typecore.cmx \ + typing/subst.cmx \ + typing/printtyp.cmx \ + typing/predef.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + typing/oprint.cmx \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + typing/includeclass.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + typing/ctype.cmx \ + file_formats/cmt_format.cmx \ + utils/clflags.cmx \ + parsing/builtin_attributes.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmx \ + typing/typeclass.cmi +typing/typeclass.cmi : \ + typing/types.cmi \ + typing/typedtree.cmi \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + parsing/asttypes.cmi +typing/typecore.cmo : \ + utils/warnings.cmi \ + typing/typetexp.cmi \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/typedecl.cmi \ + typing/subst.cmi \ + typing/rec_check.cmi \ + typing/printtyp.cmi \ + typing/printpat.cmi \ + typing/primitive.cmi \ + typing/predef.cmi \ + typing/persistent_env.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + typing/parmatch.cmi \ + typing/mtype.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + file_formats/cmt_format.cmi \ + utils/clflags.cmi \ + parsing/builtin_attributes.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmi \ + typing/annot.cmi \ + typing/typecore.cmi +typing/typecore.cmx : \ + utils/warnings.cmx \ + typing/typetexp.cmx \ + typing/types.cmx \ + typing/typedtree.cmx \ + typing/typedecl.cmx \ + typing/subst.cmx \ + typing/rec_check.cmx \ + typing/printtyp.cmx \ + typing/printpat.cmx \ + typing/primitive.cmx \ + typing/predef.cmx \ + typing/persistent_env.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + typing/parmatch.cmx \ + typing/mtype.cmx \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + typing/ctype.cmx \ + file_formats/cmt_format.cmx \ + utils/clflags.cmx \ + parsing/builtin_attributes.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmx \ + typing/annot.cmi \ + typing/typecore.cmi +typing/typecore.cmi : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + parsing/asttypes.cmi \ + typing/annot.cmi +typing/typedecl.cmo : \ + utils/warnings.cmi \ + typing/typetexp.cmi \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/typedecl_variance.cmi \ + typing/typedecl_unboxed.cmi \ + typing/typedecl_separability.cmi \ + typing/typedecl_immediacy.cmi \ + typing/type_immediacy.cmi \ + typing/subst.cmi \ + typing/printtyp.cmi \ + typing/primitive.cmi \ + typing/predef.cmi \ + parsing/pprintast.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + typing/oprint.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/includecore.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + utils/config.cmi \ + utils/clflags.cmi \ + parsing/builtin_attributes.cmi \ + typing/btype.cmi \ + parsing/attr_helper.cmi \ + parsing/asttypes.cmi \ + parsing/ast_iterator.cmi \ + parsing/ast_helper.cmi \ + typing/typedecl.cmi +typing/typedecl.cmx : \ + utils/warnings.cmx \ + typing/typetexp.cmx \ + typing/types.cmx \ + typing/typedtree.cmx \ + typing/typedecl_variance.cmx \ + typing/typedecl_unboxed.cmx \ + typing/typedecl_separability.cmx \ + typing/typedecl_immediacy.cmx \ + typing/type_immediacy.cmx \ + typing/subst.cmx \ + typing/printtyp.cmx \ + typing/primitive.cmx \ + typing/predef.cmx \ + parsing/pprintast.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + typing/oprint.cmx \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + typing/includecore.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + typing/ctype.cmx \ + utils/config.cmx \ + utils/clflags.cmx \ + parsing/builtin_attributes.cmx \ + typing/btype.cmx \ + parsing/attr_helper.cmx \ + parsing/asttypes.cmi \ + parsing/ast_iterator.cmx \ + parsing/ast_helper.cmx \ + typing/typedecl.cmi +typing/typedecl.cmi : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/typedecl_variance.cmi \ + typing/typedecl_separability.cmi \ + typing/typedecl_immediacy.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/includecore.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + parsing/asttypes.cmi +typing/typedecl_immediacy.cmo : \ + typing/types.cmi \ + typing/typedecl_unboxed.cmi \ + typing/typedecl_properties.cmi \ + typing/type_immediacy.cmi \ + parsing/location.cmi \ + typing/ctype.cmi \ + typing/typedecl_immediacy.cmi +typing/typedecl_immediacy.cmx : \ + typing/types.cmx \ + typing/typedecl_unboxed.cmx \ + typing/typedecl_properties.cmx \ + typing/type_immediacy.cmx \ + parsing/location.cmx \ + typing/ctype.cmx \ + typing/typedecl_immediacy.cmi +typing/typedecl_immediacy.cmi : \ + typing/types.cmi \ + typing/typedecl_properties.cmi \ + typing/type_immediacy.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi +typing/typedecl_properties.cmo : \ + typing/types.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + parsing/builtin_attributes.cmi \ + typing/typedecl_properties.cmi +typing/typedecl_properties.cmx : \ + typing/types.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + parsing/builtin_attributes.cmx \ + typing/typedecl_properties.cmi +typing/typedecl_properties.cmi : \ + typing/types.cmi \ + typing/ident.cmi \ + typing/env.cmi +typing/typedecl_separability.cmo : \ + typing/types.cmi \ + typing/typedecl_properties.cmi \ + parsing/location.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + utils/config.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + typing/typedecl_separability.cmi +typing/typedecl_separability.cmx : \ + typing/types.cmx \ + typing/typedecl_properties.cmx \ + parsing/location.cmx \ + typing/env.cmx \ + typing/ctype.cmx \ + utils/config.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + typing/typedecl_separability.cmi +typing/typedecl_separability.cmi : \ + typing/types.cmi \ + typing/typedecl_properties.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi +typing/typedecl_unboxed.cmo : \ + typing/types.cmi \ + typing/predef.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + typing/typedecl_unboxed.cmi +typing/typedecl_unboxed.cmx : \ + typing/types.cmx \ + typing/predef.cmx \ + typing/env.cmx \ + typing/ctype.cmx \ + typing/typedecl_unboxed.cmi +typing/typedecl_unboxed.cmi : \ + typing/types.cmi \ + typing/env.cmi +typing/typedecl_variance.cmo : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/typedecl_properties.cmi \ + parsing/parsetree.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + typing/typedecl_variance.cmi +typing/typedecl_variance.cmx : \ + typing/types.cmx \ + typing/typedtree.cmx \ + typing/typedecl_properties.cmx \ + parsing/parsetree.cmi \ + parsing/location.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + typing/ctype.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + typing/typedecl_variance.cmi +typing/typedecl_variance.cmi : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/typedecl_properties.cmi \ + parsing/parsetree.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + parsing/asttypes.cmi +typing/typedtree.cmo : \ + typing/types.cmi \ + typing/primitive.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + parsing/asttypes.cmi \ + typing/typedtree.cmi +typing/typedtree.cmx : \ + typing/types.cmx \ + typing/primitive.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + parsing/longident.cmx \ + parsing/location.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + parsing/asttypes.cmi \ + typing/typedtree.cmi +typing/typedtree.cmi : \ + typing/types.cmi \ + typing/primitive.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + parsing/asttypes.cmi +typing/typemod.cmo : \ + utils/warnings.cmi \ + typing/typetexp.cmi \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/typedecl.cmi \ + typing/typecore.cmi \ + typing/typeclass.cmi \ + typing/subst.cmi \ + typing/printtyp.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + parsing/parse.cmi \ + typing/mtype.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + typing/includemod.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + utils/config.cmi \ + file_formats/cmt_format.cmi \ + typing/cmt2annot.cmo \ + file_formats/cmi_format.cmi \ + utils/clflags.cmi \ + parsing/builtin_attributes.cmi \ + typing/btype.cmi \ + parsing/attr_helper.cmi \ + parsing/asttypes.cmi \ + typing/annot.cmi \ + typing/typemod.cmi +typing/typemod.cmx : \ + utils/warnings.cmx \ + typing/typetexp.cmx \ + typing/types.cmx \ + typing/typedtree.cmx \ + typing/typedecl.cmx \ + typing/typecore.cmx \ + typing/typeclass.cmx \ + typing/subst.cmx \ + typing/printtyp.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + parsing/parse.cmx \ + typing/mtype.cmx \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + utils/load_path.cmx \ + typing/includemod.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + typing/ctype.cmx \ + utils/config.cmx \ + file_formats/cmt_format.cmx \ + typing/cmt2annot.cmx \ + file_formats/cmi_format.cmx \ + utils/clflags.cmx \ + parsing/builtin_attributes.cmx \ + typing/btype.cmx \ + parsing/attr_helper.cmx \ + parsing/asttypes.cmi \ + typing/annot.cmi \ + typing/typemod.cmi +typing/typemod.cmi : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/typedecl.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/includemod.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + file_formats/cmi_format.cmi +typing/typeopt.cmo : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/typedecl.cmi \ + typing/predef.cmi \ + typing/path.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + utils/config.cmi \ + parsing/asttypes.cmi \ + typing/typeopt.cmi +typing/typeopt.cmx : \ + typing/types.cmx \ + typing/typedtree.cmx \ + typing/typedecl.cmx \ + typing/predef.cmx \ + typing/path.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + typing/ctype.cmx \ + utils/config.cmx \ + parsing/asttypes.cmi \ + typing/typeopt.cmi +typing/typeopt.cmi : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/path.cmi \ + lambda/lambda.cmi \ + typing/env.cmi +typing/types.cmo : \ + typing/type_immediacy.cmi \ + typing/primitive.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + utils/identifiable.cmi \ + typing/ident.cmi \ + utils/config.cmi \ + parsing/asttypes.cmi \ + typing/types.cmi +typing/types.cmx : \ + typing/type_immediacy.cmx \ + typing/primitive.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + utils/identifiable.cmx \ + typing/ident.cmx \ + utils/config.cmx \ + parsing/asttypes.cmi \ + typing/types.cmi +typing/types.cmi : \ + typing/type_immediacy.cmi \ + typing/primitive.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + utils/identifiable.cmi \ + typing/ident.cmi \ + parsing/asttypes.cmi +typing/typetexp.cmo : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/printtyp.cmi \ + typing/predef.cmi \ + parsing/pprintast.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + typing/oprint.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + utils/clflags.cmi \ + parsing/builtin_attributes.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmi \ + typing/typetexp.cmi +typing/typetexp.cmx : \ + typing/types.cmx \ + typing/typedtree.cmx \ + typing/printtyp.cmx \ + typing/predef.cmx \ + parsing/pprintast.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + typing/oprint.cmx \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + typing/env.cmx \ + typing/ctype.cmx \ + utils/clflags.cmx \ + parsing/builtin_attributes.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmx \ + typing/typetexp.cmi +typing/typetexp.cmi : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + parsing/asttypes.cmi +typing/untypeast.cmo : \ + typing/typedtree.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmi \ + typing/untypeast.cmi +typing/untypeast.cmx : \ + typing/typedtree.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + parsing/longident.cmx \ + parsing/location.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmx \ + typing/untypeast.cmi +typing/untypeast.cmi : \ + typing/typedtree.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + parsing/asttypes.cmi +bytecomp/bytegen.cmo : \ + typing/types.cmi \ + lambda/switch.cmi \ + typing/subst.cmi \ + typing/primitive.cmi \ + utils/misc.cmi \ + lambda/matching.cmi \ + lambda/lambda.cmi \ + bytecomp/instruct.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + lambda/debuginfo.cmi \ + utils/config.cmi \ + utils/clflags.cmi \ + parsing/asttypes.cmi \ + bytecomp/bytegen.cmi +bytecomp/bytegen.cmx : \ + typing/types.cmx \ + lambda/switch.cmx \ + typing/subst.cmx \ + typing/primitive.cmx \ + utils/misc.cmx \ + lambda/matching.cmx \ + lambda/lambda.cmx \ + bytecomp/instruct.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + lambda/debuginfo.cmx \ + utils/config.cmx \ + utils/clflags.cmx \ + parsing/asttypes.cmi \ + bytecomp/bytegen.cmi +bytecomp/bytegen.cmi : \ + lambda/lambda.cmi \ + bytecomp/instruct.cmi +bytecomp/bytelibrarian.cmo : \ + utils/misc.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + bytecomp/emitcode.cmi \ + utils/config.cmi \ + file_formats/cmo_format.cmi \ + utils/clflags.cmi \ + bytecomp/bytelink.cmi \ + bytecomp/bytelibrarian.cmi +bytecomp/bytelibrarian.cmx : \ + utils/misc.cmx \ + parsing/location.cmx \ + utils/load_path.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/bytelink.cmo : \ + utils/warnings.cmi \ + bytecomp/symtable.cmi \ + bytecomp/opcodes.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + bytecomp/instruct.cmi \ + typing/ident.cmi \ + bytecomp/emitcode.cmi \ + bytecomp/dll.cmi \ + utils/consistbl.cmi \ + utils/config.cmi \ + file_formats/cmo_format.cmi \ + utils/clflags.cmi \ + utils/ccomp.cmi \ + bytecomp/bytesections.cmi \ + bytecomp/bytelink.cmi +bytecomp/bytelink.cmx : \ + utils/warnings.cmx \ + bytecomp/symtable.cmx \ + bytecomp/opcodes.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + utils/load_path.cmx \ + bytecomp/instruct.cmx \ + typing/ident.cmx \ + bytecomp/emitcode.cmx \ + bytecomp/dll.cmx \ + utils/consistbl.cmx \ + utils/config.cmx \ + file_formats/cmo_format.cmi \ + utils/clflags.cmx \ + utils/ccomp.cmx \ + bytecomp/bytesections.cmx \ + bytecomp/bytelink.cmi +bytecomp/bytelink.cmi : \ + bytecomp/symtable.cmi \ + utils/misc.cmi \ + file_formats/cmo_format.cmi +bytecomp/bytepackager.cmo : \ + typing/typemod.cmi \ + lambda/translmod.cmi \ + typing/subst.cmi \ + lambda/simplif.cmi \ + lambda/printlambda.cmi \ + typing/path.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + bytecomp/instruct.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + bytecomp/emitcode.cmi \ + utils/config.cmi \ + file_formats/cmo_format.cmi \ + utils/clflags.cmi \ + bytecomp/bytelink.cmi \ + bytecomp/bytegen.cmi \ + bytecomp/bytepackager.cmi +bytecomp/bytepackager.cmx : \ + typing/typemod.cmx \ + lambda/translmod.cmx \ + typing/subst.cmx \ + lambda/simplif.cmx \ + lambda/printlambda.cmx \ + typing/path.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + utils/load_path.cmx \ + bytecomp/instruct.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + bytecomp/emitcode.cmx \ + utils/config.cmx \ + file_formats/cmo_format.cmi \ + utils/clflags.cmx \ + bytecomp/bytelink.cmx \ + bytecomp/bytegen.cmx \ + bytecomp/bytepackager.cmi +bytecomp/bytepackager.cmi : \ + typing/ident.cmi \ + typing/env.cmi +bytecomp/bytesections.cmo : \ + utils/config.cmi \ + bytecomp/bytesections.cmi +bytecomp/bytesections.cmx : \ + utils/config.cmx \ + bytecomp/bytesections.cmi +bytecomp/bytesections.cmi : +bytecomp/dll.cmo : \ + utils/misc.cmi \ + utils/config.cmi \ + bytecomp/dll.cmi +bytecomp/dll.cmx : \ + utils/misc.cmx \ + utils/config.cmx \ + bytecomp/dll.cmi +bytecomp/dll.cmi : +bytecomp/emitcode.cmo : \ + lambda/translmod.cmi \ + typing/primitive.cmi \ + bytecomp/opcodes.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + bytecomp/instruct.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + utils/config.cmi \ + file_formats/cmo_format.cmi \ + utils/clflags.cmi \ + bytecomp/bytegen.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + bytecomp/emitcode.cmi +bytecomp/emitcode.cmx : \ + lambda/translmod.cmx \ + typing/primitive.cmx \ + bytecomp/opcodes.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + lambda/lambda.cmx \ + bytecomp/instruct.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + utils/config.cmx \ + file_formats/cmo_format.cmi \ + utils/clflags.cmx \ + bytecomp/bytegen.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + bytecomp/emitcode.cmi +bytecomp/emitcode.cmi : \ + utils/misc.cmi \ + bytecomp/instruct.cmi \ + typing/ident.cmi \ + file_formats/cmo_format.cmi +bytecomp/instruct.cmo : \ + typing/types.cmi \ + typing/subst.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + bytecomp/instruct.cmi +bytecomp/instruct.cmx : \ + typing/types.cmx \ + typing/subst.cmx \ + parsing/location.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + bytecomp/instruct.cmi +bytecomp/instruct.cmi : \ + typing/types.cmi \ + typing/subst.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + typing/env.cmi +bytecomp/meta.cmo : \ + bytecomp/instruct.cmi \ + bytecomp/meta.cmi +bytecomp/meta.cmx : \ + bytecomp/instruct.cmx \ + bytecomp/meta.cmi +bytecomp/meta.cmi : \ + bytecomp/instruct.cmi +bytecomp/opcodes.cmo : \ + bytecomp/opcodes.cmi +bytecomp/opcodes.cmx : \ + bytecomp/opcodes.cmi +bytecomp/opcodes.cmi : +bytecomp/printinstr.cmo : \ + lambda/printlambda.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + bytecomp/instruct.cmi \ + typing/ident.cmi \ + bytecomp/printinstr.cmi +bytecomp/printinstr.cmx : \ + lambda/printlambda.cmx \ + parsing/location.cmx \ + lambda/lambda.cmx \ + bytecomp/instruct.cmx \ + typing/ident.cmx \ + bytecomp/printinstr.cmi +bytecomp/printinstr.cmi : \ + bytecomp/instruct.cmi +bytecomp/symtable.cmo : \ + lambda/runtimedef.cmi \ + typing/predef.cmi \ + utils/misc.cmi \ + bytecomp/meta.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + bytecomp/dll.cmi \ + utils/config.cmi \ + file_formats/cmo_format.cmi \ + utils/clflags.cmi \ + bytecomp/bytesections.cmi \ + parsing/asttypes.cmi \ + bytecomp/symtable.cmi +bytecomp/symtable.cmx : \ + lambda/runtimedef.cmx \ + typing/predef.cmx \ + utils/misc.cmx \ + bytecomp/meta.cmx \ + parsing/location.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + bytecomp/dll.cmx \ + utils/config.cmx \ + file_formats/cmo_format.cmi \ + utils/clflags.cmx \ + bytecomp/bytesections.cmx \ + parsing/asttypes.cmi \ + bytecomp/symtable.cmi +bytecomp/symtable.cmi : \ + utils/misc.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + file_formats/cmo_format.cmi +asmcomp/CSE.cmo : \ + asmcomp/mach.cmi \ + asmcomp/CSEgen.cmi \ + asmcomp/arch.cmo +asmcomp/CSE.cmx : \ + asmcomp/mach.cmx \ + asmcomp/CSEgen.cmx \ + asmcomp/arch.cmx +asmcomp/CSEgen.cmo : \ + asmcomp/reg.cmi \ + asmcomp/proc.cmi \ + asmcomp/mach.cmi \ + asmcomp/cmm.cmi \ + asmcomp/CSEgen.cmi +asmcomp/CSEgen.cmx : \ + asmcomp/reg.cmx \ + asmcomp/proc.cmx \ + asmcomp/mach.cmx \ + asmcomp/cmm.cmx \ + asmcomp/CSEgen.cmi +asmcomp/CSEgen.cmi : \ + asmcomp/mach.cmi +asmcomp/afl_instrument.cmo : \ + lambda/lambda.cmi \ + asmcomp/cmm.cmi \ + utils/clflags.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi \ + asmcomp/afl_instrument.cmi +asmcomp/afl_instrument.cmx : \ + lambda/lambda.cmx \ + asmcomp/cmm.cmx \ + utils/clflags.cmx \ + middle_end/backend_var.cmx \ + parsing/asttypes.cmi \ + asmcomp/afl_instrument.cmi +asmcomp/afl_instrument.cmi : \ + lambda/debuginfo.cmi \ + asmcomp/cmm.cmi +asmcomp/arch.cmo : \ + utils/config.cmi \ + utils/clflags.cmi +asmcomp/arch.cmx : \ + utils/config.cmx \ + utils/clflags.cmx +asmcomp/asmgen.cmo : \ + lambda/translmod.cmi \ + asmcomp/split.cmi \ + asmcomp/spill.cmi \ + asmcomp/selection.cmi \ + asmcomp/scheduling.cmi \ + asmcomp/reload.cmi \ + asmcomp/reg.cmi \ + utils/profile.cmi \ + asmcomp/proc.cmi \ + asmcomp/printmach.cmi \ + asmcomp/printlinear.cmi \ + asmcomp/printcmm.cmi \ + typing/primitive.cmi \ + utils/misc.cmi \ + asmcomp/mach.cmi \ + parsing/location.cmi \ + asmcomp/liveness.cmi \ + asmcomp/linscan.cmi \ + asmcomp/linearize.cmi \ + lambda/lambda.cmi \ + asmcomp/interval.cmi \ + asmcomp/interf.cmi \ + typing/ident.cmi \ + asmcomp/emitaux.cmi \ + asmcomp/emit.cmi \ + asmcomp/deadcode.cmi \ + utils/config.cmi \ + middle_end/compilenv.cmi \ + asmcomp/comballoc.cmi \ + asmcomp/coloring.cmi \ + asmcomp/cmmgen.cmi \ + asmcomp/cmm_helpers.cmi \ + asmcomp/cmm.cmi \ + utils/clflags.cmi \ + middle_end/clambda.cmi \ + asmcomp/CSE.cmo \ + middle_end/backend_intf.cmi \ + asmcomp/debug/available_regs.cmi \ + asmcomp/asmgen.cmi +asmcomp/asmgen.cmx : \ + lambda/translmod.cmx \ + asmcomp/split.cmx \ + asmcomp/spill.cmx \ + asmcomp/selection.cmx \ + asmcomp/scheduling.cmx \ + asmcomp/reload.cmx \ + asmcomp/reg.cmx \ + utils/profile.cmx \ + asmcomp/proc.cmx \ + asmcomp/printmach.cmx \ + asmcomp/printlinear.cmx \ + asmcomp/printcmm.cmx \ + typing/primitive.cmx \ + utils/misc.cmx \ + asmcomp/mach.cmx \ + parsing/location.cmx \ + asmcomp/liveness.cmx \ + asmcomp/linscan.cmx \ + asmcomp/linearize.cmx \ + lambda/lambda.cmx \ + asmcomp/interval.cmx \ + asmcomp/interf.cmx \ + typing/ident.cmx \ + asmcomp/emitaux.cmx \ + asmcomp/emit.cmx \ + asmcomp/deadcode.cmx \ + utils/config.cmx \ + middle_end/compilenv.cmx \ + asmcomp/comballoc.cmx \ + asmcomp/coloring.cmx \ + asmcomp/cmmgen.cmx \ + asmcomp/cmm_helpers.cmx \ + asmcomp/cmm.cmx \ + utils/clflags.cmx \ + middle_end/clambda.cmx \ + asmcomp/CSE.cmx \ + middle_end/backend_intf.cmi \ + asmcomp/debug/available_regs.cmx \ + asmcomp/asmgen.cmi +asmcomp/asmgen.cmi : \ + lambda/lambda.cmi \ + asmcomp/cmm.cmi \ + middle_end/clambda.cmi \ + middle_end/backend_intf.cmi +asmcomp/asmlibrarian.cmo : \ + utils/misc.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + middle_end/flambda/export_info.cmi \ + utils/config.cmi \ + middle_end/compilenv.cmi \ + file_formats/cmx_format.cmi \ + utils/clflags.cmi \ + middle_end/clambda.cmi \ + utils/ccomp.cmi \ + asmcomp/asmlink.cmi \ + asmcomp/asmlibrarian.cmi +asmcomp/asmlibrarian.cmx : \ + utils/misc.cmx \ + parsing/location.cmx \ + utils/load_path.cmx \ + middle_end/flambda/export_info.cmx \ + utils/config.cmx \ + middle_end/compilenv.cmx \ + file_formats/cmx_format.cmi \ + utils/clflags.cmx \ + middle_end/clambda.cmx \ + utils/ccomp.cmx \ + asmcomp/asmlink.cmx \ + asmcomp/asmlibrarian.cmi +asmcomp/asmlibrarian.cmi : +asmcomp/asmlink.cmo : \ + lambda/runtimedef.cmi \ + utils/profile.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + asmcomp/emitaux.cmi \ + asmcomp/emit.cmi \ + utils/consistbl.cmi \ + utils/config.cmi \ + middle_end/compilenv.cmi \ + file_formats/cmx_format.cmi \ + asmcomp/cmm_helpers.cmi \ + asmcomp/cmm.cmi \ + utils/clflags.cmi \ + utils/ccomp.cmi \ + asmcomp/asmgen.cmi \ + asmcomp/asmlink.cmi +asmcomp/asmlink.cmx : \ + lambda/runtimedef.cmx \ + utils/profile.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + utils/load_path.cmx \ + asmcomp/emitaux.cmx \ + asmcomp/emit.cmx \ + utils/consistbl.cmx \ + utils/config.cmx \ + middle_end/compilenv.cmx \ + file_formats/cmx_format.cmi \ + asmcomp/cmm_helpers.cmx \ + asmcomp/cmm.cmx \ + utils/clflags.cmx \ + utils/ccomp.cmx \ + asmcomp/asmgen.cmx \ + asmcomp/asmlink.cmi +asmcomp/asmlink.cmi : \ + utils/misc.cmi \ + file_formats/cmx_format.cmi +asmcomp/asmpackager.cmo : \ + typing/typemod.cmi \ + lambda/translmod.cmi \ + lambda/simplif.cmi \ + utils/profile.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + middle_end/flambda/flambda_middle_end.cmi \ + middle_end/flambda/export_info_for_pack.cmi \ + middle_end/flambda/export_info.cmi \ + typing/env.cmi \ + utils/config.cmi \ + middle_end/compilenv.cmi \ + middle_end/compilation_unit.cmi \ + file_formats/cmx_format.cmi \ + middle_end/closure/closure_middle_end.cmi \ + utils/clflags.cmi \ + utils/ccomp.cmi \ + asmcomp/asmlink.cmi \ + asmcomp/asmgen.cmi \ + asmcomp/asmpackager.cmi +asmcomp/asmpackager.cmx : \ + typing/typemod.cmx \ + lambda/translmod.cmx \ + lambda/simplif.cmx \ + utils/profile.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + utils/load_path.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + middle_end/flambda/flambda_middle_end.cmx \ + middle_end/flambda/export_info_for_pack.cmx \ + middle_end/flambda/export_info.cmx \ + typing/env.cmx \ + utils/config.cmx \ + middle_end/compilenv.cmx \ + middle_end/compilation_unit.cmx \ + file_formats/cmx_format.cmi \ + middle_end/closure/closure_middle_end.cmx \ + utils/clflags.cmx \ + utils/ccomp.cmx \ + asmcomp/asmlink.cmx \ + asmcomp/asmgen.cmx \ + asmcomp/asmpackager.cmi +asmcomp/asmpackager.cmi : \ + typing/env.cmi \ + middle_end/backend_intf.cmi +asmcomp/branch_relaxation.cmo : \ + utils/misc.cmi \ + asmcomp/mach.cmi \ + asmcomp/linear.cmi \ + asmcomp/cmm.cmi \ + asmcomp/branch_relaxation_intf.cmo \ + asmcomp/branch_relaxation.cmi +asmcomp/branch_relaxation.cmx : \ + utils/misc.cmx \ + asmcomp/mach.cmx \ + asmcomp/linear.cmx \ + asmcomp/cmm.cmx \ + asmcomp/branch_relaxation_intf.cmx \ + asmcomp/branch_relaxation.cmi +asmcomp/branch_relaxation.cmi : \ + asmcomp/linear.cmi \ + asmcomp/branch_relaxation_intf.cmo +asmcomp/branch_relaxation_intf.cmo : \ + asmcomp/linear.cmi \ + lambda/debuginfo.cmi \ + asmcomp/cmm.cmi \ + asmcomp/arch.cmo +asmcomp/branch_relaxation_intf.cmx : \ + asmcomp/linear.cmx \ + lambda/debuginfo.cmx \ + asmcomp/cmm.cmx \ + asmcomp/arch.cmx +asmcomp/cmm.cmo : \ + utils/targetint.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi \ + asmcomp/cmm.cmi +asmcomp/cmm.cmx : \ + utils/targetint.cmx \ + lambda/lambda.cmx \ + lambda/debuginfo.cmx \ + middle_end/backend_var.cmx \ + parsing/asttypes.cmi \ + asmcomp/cmm.cmi +asmcomp/cmm.cmi : \ + utils/targetint.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi +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 \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + utils/config.cmi \ + middle_end/compilenv.cmi \ + file_formats/cmxs_format.cmi \ + file_formats/cmx_format.cmi \ + asmcomp/cmmgen_state.cmi \ + asmcomp/cmm.cmi \ + utils/clflags.cmi \ + middle_end/clambda_primitives.cmi \ + middle_end/clambda.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi \ + asmcomp/arch.cmo \ + asmcomp/cmm_helpers.cmi +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 \ + lambda/lambda.cmx \ + lambda/debuginfo.cmx \ + utils/config.cmx \ + middle_end/compilenv.cmx \ + file_formats/cmxs_format.cmi \ + file_formats/cmx_format.cmi \ + asmcomp/cmmgen_state.cmx \ + asmcomp/cmm.cmx \ + utils/clflags.cmx \ + middle_end/clambda_primitives.cmx \ + middle_end/clambda.cmx \ + middle_end/backend_var.cmx \ + parsing/asttypes.cmi \ + asmcomp/arch.cmx \ + asmcomp/cmm_helpers.cmi +asmcomp/cmm_helpers.cmi : \ + utils/targetint.cmi \ + typing/primitive.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + file_formats/cmx_format.cmi \ + asmcomp/cmmgen_state.cmi \ + asmcomp/cmm.cmi \ + middle_end/clambda_primitives.cmi \ + middle_end/clambda.cmi \ + parsing/asttypes.cmi +asmcomp/cmmgen.cmo : \ + typing/types.cmi \ + middle_end/printclambda_primitives.cmi \ + typing/primitive.cmi \ + utils/misc.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + utils/config.cmi \ + middle_end/compilenv.cmi \ + asmcomp/cmmgen_state.cmi \ + asmcomp/cmm_helpers.cmi \ + asmcomp/cmm.cmi \ + utils/clflags.cmi \ + middle_end/clambda_primitives.cmi \ + middle_end/clambda.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi \ + asmcomp/arch.cmo \ + asmcomp/afl_instrument.cmi \ + asmcomp/cmmgen.cmi +asmcomp/cmmgen.cmx : \ + typing/types.cmx \ + middle_end/printclambda_primitives.cmx \ + typing/primitive.cmx \ + utils/misc.cmx \ + lambda/lambda.cmx \ + lambda/debuginfo.cmx \ + utils/config.cmx \ + middle_end/compilenv.cmx \ + asmcomp/cmmgen_state.cmx \ + asmcomp/cmm_helpers.cmx \ + asmcomp/cmm.cmx \ + utils/clflags.cmx \ + middle_end/clambda_primitives.cmx \ + middle_end/clambda.cmx \ + middle_end/backend_var.cmx \ + parsing/asttypes.cmi \ + asmcomp/arch.cmx \ + asmcomp/afl_instrument.cmx \ + asmcomp/cmmgen.cmi +asmcomp/cmmgen.cmi : \ + asmcomp/cmm.cmi \ + middle_end/clambda.cmi +asmcomp/cmmgen_state.cmo : \ + utils/misc.cmi \ + middle_end/compilenv.cmi \ + asmcomp/cmm.cmi \ + middle_end/clambda.cmi \ + asmcomp/cmmgen_state.cmi +asmcomp/cmmgen_state.cmx : \ + utils/misc.cmx \ + middle_end/compilenv.cmx \ + asmcomp/cmm.cmx \ + middle_end/clambda.cmx \ + asmcomp/cmmgen_state.cmi +asmcomp/cmmgen_state.cmi : \ + utils/misc.cmi \ + asmcomp/cmm.cmi \ + middle_end/clambda.cmi +asmcomp/coloring.cmo : \ + asmcomp/reg.cmi \ + asmcomp/proc.cmi \ + asmcomp/coloring.cmi +asmcomp/coloring.cmx : \ + asmcomp/reg.cmx \ + asmcomp/proc.cmx \ + asmcomp/coloring.cmi +asmcomp/coloring.cmi : +asmcomp/comballoc.cmo : \ + asmcomp/reg.cmi \ + asmcomp/mach.cmi \ + lambda/debuginfo.cmi \ + utils/config.cmi \ + asmcomp/arch.cmo \ + asmcomp/comballoc.cmi +asmcomp/comballoc.cmx : \ + asmcomp/reg.cmx \ + asmcomp/mach.cmx \ + lambda/debuginfo.cmx \ + utils/config.cmx \ + asmcomp/arch.cmx \ + asmcomp/comballoc.cmi +asmcomp/comballoc.cmi : \ + asmcomp/mach.cmi +asmcomp/deadcode.cmo : \ + asmcomp/reg.cmi \ + asmcomp/proc.cmi \ + utils/numbers.cmi \ + asmcomp/mach.cmi \ + utils/config.cmi \ + asmcomp/cmm.cmi \ + asmcomp/deadcode.cmi +asmcomp/deadcode.cmx : \ + asmcomp/reg.cmx \ + asmcomp/proc.cmx \ + utils/numbers.cmx \ + asmcomp/mach.cmx \ + utils/config.cmx \ + asmcomp/cmm.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/emitaux.cmi \ + utils/domainstate.cmi \ + utils/config.cmi \ + middle_end/compilenv.cmi \ + asmcomp/cmm.cmi \ + utils/clflags.cmi \ + asmcomp/branch_relaxation.cmi \ + asmcomp/arch.cmo \ + 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/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/linear.cmi \ + asmcomp/cmm.cmi +asmcomp/emitaux.cmo : \ + lambda/debuginfo.cmi \ + utils/config.cmi \ + asmcomp/cmm.cmi \ + utils/clflags.cmi \ + asmcomp/arch.cmo \ + asmcomp/emitaux.cmi +asmcomp/emitaux.cmx : \ + lambda/debuginfo.cmx \ + utils/config.cmx \ + asmcomp/cmm.cmx \ + utils/clflags.cmx \ + asmcomp/arch.cmx \ + asmcomp/emitaux.cmi +asmcomp/emitaux.cmi : \ + lambda/debuginfo.cmi +asmcomp/interf.cmo : \ + asmcomp/reg.cmi \ + asmcomp/proc.cmi \ + asmcomp/mach.cmi \ + asmcomp/cmm.cmi \ + asmcomp/interf.cmi +asmcomp/interf.cmx : \ + asmcomp/reg.cmx \ + asmcomp/proc.cmx \ + asmcomp/mach.cmx \ + asmcomp/cmm.cmx \ + asmcomp/interf.cmi +asmcomp/interf.cmi : \ + asmcomp/mach.cmi +asmcomp/interval.cmo : \ + asmcomp/reg.cmi \ + asmcomp/proc.cmi \ + asmcomp/mach.cmi \ + asmcomp/interval.cmi +asmcomp/interval.cmx : \ + asmcomp/reg.cmx \ + asmcomp/proc.cmx \ + asmcomp/mach.cmx \ + asmcomp/interval.cmi +asmcomp/interval.cmi : \ + asmcomp/reg.cmi \ + asmcomp/mach.cmi +asmcomp/linear.cmo : \ + asmcomp/reg.cmi \ + asmcomp/mach.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + asmcomp/cmm.cmi \ + asmcomp/linear.cmi +asmcomp/linear.cmx : \ + asmcomp/reg.cmx \ + asmcomp/mach.cmx \ + lambda/lambda.cmx \ + lambda/debuginfo.cmx \ + asmcomp/cmm.cmx \ + asmcomp/linear.cmi +asmcomp/linear.cmi : \ + asmcomp/reg.cmi \ + asmcomp/mach.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + asmcomp/cmm.cmi +asmcomp/linearize.cmo : \ + asmcomp/reg.cmi \ + asmcomp/proc.cmi \ + utils/misc.cmi \ + asmcomp/mach.cmi \ + asmcomp/linear.cmi \ + lambda/debuginfo.cmi \ + utils/config.cmi \ + asmcomp/cmm.cmi \ + asmcomp/linearize.cmi +asmcomp/linearize.cmx : \ + asmcomp/reg.cmx \ + asmcomp/proc.cmx \ + utils/misc.cmx \ + asmcomp/mach.cmx \ + asmcomp/linear.cmx \ + lambda/debuginfo.cmx \ + utils/config.cmx \ + asmcomp/cmm.cmx \ + asmcomp/linearize.cmi +asmcomp/linearize.cmi : \ + asmcomp/mach.cmi \ + asmcomp/linear.cmi +asmcomp/linscan.cmo : \ + asmcomp/reg.cmi \ + asmcomp/proc.cmi \ + asmcomp/interval.cmi \ + asmcomp/linscan.cmi +asmcomp/linscan.cmx : \ + asmcomp/reg.cmx \ + asmcomp/proc.cmx \ + asmcomp/interval.cmx \ + asmcomp/linscan.cmi +asmcomp/linscan.cmi : +asmcomp/liveness.cmo : \ + asmcomp/reg.cmi \ + asmcomp/proc.cmi \ + asmcomp/printmach.cmi \ + utils/misc.cmi \ + asmcomp/mach.cmi \ + utils/config.cmi \ + asmcomp/cmm.cmi \ + asmcomp/liveness.cmi +asmcomp/liveness.cmx : \ + asmcomp/reg.cmx \ + asmcomp/proc.cmx \ + asmcomp/printmach.cmx \ + utils/misc.cmx \ + asmcomp/mach.cmx \ + utils/config.cmx \ + asmcomp/cmm.cmx \ + asmcomp/liveness.cmi +asmcomp/liveness.cmi : \ + asmcomp/mach.cmi +asmcomp/mach.cmo : \ + asmcomp/debug/reg_with_debug_info.cmi \ + asmcomp/debug/reg_availability_set.cmi \ + asmcomp/reg.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + asmcomp/cmm.cmi \ + middle_end/backend_var.cmi \ + asmcomp/arch.cmo \ + asmcomp/mach.cmi +asmcomp/mach.cmx : \ + asmcomp/debug/reg_with_debug_info.cmx \ + asmcomp/debug/reg_availability_set.cmx \ + asmcomp/reg.cmx \ + lambda/lambda.cmx \ + lambda/debuginfo.cmx \ + asmcomp/cmm.cmx \ + middle_end/backend_var.cmx \ + asmcomp/arch.cmx \ + asmcomp/mach.cmi +asmcomp/mach.cmi : \ + asmcomp/debug/reg_availability_set.cmi \ + asmcomp/reg.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + asmcomp/cmm.cmi \ + middle_end/backend_var.cmi \ + asmcomp/arch.cmo +asmcomp/printcmm.cmo : \ + utils/targetint.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + asmcomp/cmm.cmi \ + utils/clflags.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi \ + asmcomp/printcmm.cmi +asmcomp/printcmm.cmx : \ + utils/targetint.cmx \ + lambda/lambda.cmx \ + lambda/debuginfo.cmx \ + asmcomp/cmm.cmx \ + utils/clflags.cmx \ + middle_end/backend_var.cmx \ + parsing/asttypes.cmi \ + asmcomp/printcmm.cmi +asmcomp/printcmm.cmi : \ + lambda/debuginfo.cmi \ + asmcomp/cmm.cmi +asmcomp/printlinear.cmo : \ + asmcomp/printmach.cmi \ + asmcomp/mach.cmi \ + asmcomp/linear.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + utils/clflags.cmi \ + asmcomp/printlinear.cmi +asmcomp/printlinear.cmx : \ + asmcomp/printmach.cmx \ + asmcomp/mach.cmx \ + asmcomp/linear.cmx \ + lambda/lambda.cmx \ + lambda/debuginfo.cmx \ + utils/clflags.cmx \ + asmcomp/printlinear.cmi +asmcomp/printlinear.cmi : \ + asmcomp/linear.cmi +asmcomp/printmach.cmo : \ + asmcomp/debug/reg_availability_set.cmi \ + asmcomp/reg.cmi \ + asmcomp/proc.cmi \ + asmcomp/printcmm.cmi \ + asmcomp/mach.cmi \ + lambda/lambda.cmi \ + asmcomp/interval.cmi \ + lambda/debuginfo.cmi \ + utils/config.cmi \ + asmcomp/cmm.cmi \ + utils/clflags.cmi \ + middle_end/backend_var.cmi \ + asmcomp/arch.cmo \ + asmcomp/printmach.cmi +asmcomp/printmach.cmx : \ + asmcomp/debug/reg_availability_set.cmx \ + asmcomp/reg.cmx \ + asmcomp/proc.cmx \ + asmcomp/printcmm.cmx \ + asmcomp/mach.cmx \ + lambda/lambda.cmx \ + asmcomp/interval.cmx \ + lambda/debuginfo.cmx \ + utils/config.cmx \ + asmcomp/cmm.cmx \ + utils/clflags.cmx \ + middle_end/backend_var.cmx \ + asmcomp/arch.cmx \ + asmcomp/printmach.cmi +asmcomp/printmach.cmi : \ + asmcomp/reg.cmi \ + asmcomp/mach.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.cmo \ + 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 +asmcomp/reg.cmo : \ + asmcomp/cmm.cmi \ + middle_end/backend_var.cmi \ + asmcomp/reg.cmi +asmcomp/reg.cmx : \ + asmcomp/cmm.cmx \ + middle_end/backend_var.cmx \ + asmcomp/reg.cmi +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.cmo \ + 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 : \ + asmcomp/reg.cmi \ + utils/misc.cmi \ + asmcomp/mach.cmi \ + asmcomp/reloadgen.cmi +asmcomp/reloadgen.cmx : \ + asmcomp/reg.cmx \ + utils/misc.cmx \ + asmcomp/mach.cmx \ + asmcomp/reloadgen.cmi +asmcomp/reloadgen.cmi : \ + asmcomp/reg.cmi \ + asmcomp/mach.cmi +asmcomp/schedgen.cmo : \ + asmcomp/reg.cmi \ + asmcomp/proc.cmi \ + asmcomp/mach.cmi \ + asmcomp/linear.cmi \ + asmcomp/cmm.cmi \ + utils/clflags.cmi \ + asmcomp/arch.cmo \ + asmcomp/schedgen.cmi +asmcomp/schedgen.cmx : \ + asmcomp/reg.cmx \ + asmcomp/proc.cmx \ + asmcomp/mach.cmx \ + asmcomp/linear.cmx \ + asmcomp/cmm.cmx \ + utils/clflags.cmx \ + asmcomp/arch.cmx \ + asmcomp/schedgen.cmi +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 : \ + lambda/simplif.cmi \ + asmcomp/reg.cmi \ + asmcomp/proc.cmi \ + utils/numbers.cmi \ + utils/misc.cmi \ + asmcomp/mach.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + utils/config.cmi \ + asmcomp/cmm.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi \ + asmcomp/arch.cmo \ + asmcomp/selectgen.cmi +asmcomp/selectgen.cmx : \ + lambda/simplif.cmx \ + asmcomp/reg.cmx \ + asmcomp/proc.cmx \ + utils/numbers.cmx \ + utils/misc.cmx \ + asmcomp/mach.cmx \ + lambda/lambda.cmx \ + lambda/debuginfo.cmx \ + utils/config.cmx \ + asmcomp/cmm.cmx \ + middle_end/backend_var.cmx \ + parsing/asttypes.cmi \ + asmcomp/arch.cmx \ + asmcomp/selectgen.cmi +asmcomp/selectgen.cmi : \ + asmcomp/reg.cmi \ + asmcomp/mach.cmi \ + lambda/debuginfo.cmi \ + asmcomp/cmm.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi \ + asmcomp/arch.cmo +asmcomp/selection.cmo : \ + asmcomp/spacetime_profiling.cmi \ + asmcomp/selectgen.cmi \ + asmcomp/proc.cmi \ + asmcomp/mach.cmi \ + utils/config.cmi \ + asmcomp/cmm.cmi \ + utils/clflags.cmi \ + asmcomp/arch.cmo \ + asmcomp/selection.cmi +asmcomp/selection.cmx : \ + asmcomp/spacetime_profiling.cmx \ + asmcomp/selectgen.cmx \ + asmcomp/proc.cmx \ + asmcomp/mach.cmx \ + utils/config.cmx \ + asmcomp/cmm.cmx \ + utils/clflags.cmx \ + asmcomp/arch.cmx \ + asmcomp/selection.cmi +asmcomp/selection.cmi : \ + asmcomp/mach.cmi \ + asmcomp/cmm.cmi +asmcomp/spacetime_profiling.cmo : \ + asmcomp/selectgen.cmi \ + asmcomp/proc.cmi \ + utils/misc.cmi \ + asmcomp/mach.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + utils/config.cmi \ + asmcomp/cmm.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi \ + asmcomp/arch.cmo \ + asmcomp/spacetime_profiling.cmi +asmcomp/spacetime_profiling.cmx : \ + asmcomp/selectgen.cmx \ + asmcomp/proc.cmx \ + utils/misc.cmx \ + asmcomp/mach.cmx \ + lambda/lambda.cmx \ + lambda/debuginfo.cmx \ + utils/config.cmx \ + asmcomp/cmm.cmx \ + middle_end/backend_var.cmx \ + parsing/asttypes.cmi \ + asmcomp/arch.cmx \ + asmcomp/spacetime_profiling.cmi +asmcomp/spacetime_profiling.cmi : \ + asmcomp/selectgen.cmi +asmcomp/spill.cmo : \ + asmcomp/reg.cmi \ + asmcomp/proc.cmi \ + utils/misc.cmi \ + asmcomp/mach.cmi \ + asmcomp/cmm.cmi \ + utils/clflags.cmi \ + asmcomp/spill.cmi +asmcomp/spill.cmx : \ + asmcomp/reg.cmx \ + asmcomp/proc.cmx \ + utils/misc.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/strmatch.cmo : \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + asmcomp/cmm.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi \ + asmcomp/arch.cmo \ + 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/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 \ + utils/clflags.cmi \ + utils/ccomp.cmi \ + asmcomp/x86_proc.cmi +asmcomp/x86_proc.cmx : \ + asmcomp/x86_ast.cmi \ + utils/misc.cmx \ + utils/config.cmx \ + utils/clflags.cmx \ + utils/ccomp.cmx \ + asmcomp/x86_proc.cmi +asmcomp/x86_proc.cmi : \ + asmcomp/x86_ast.cmi +middle_end/backend_intf.cmi : \ + middle_end/symbol.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + typing/ident.cmi \ + middle_end/flambda/base_types/closure_id.cmi +middle_end/backend_var.cmo : \ + typing/path.cmi \ + typing/ident.cmi \ + lambda/debuginfo.cmi \ + utils/clflags.cmi \ + middle_end/backend_var.cmi +middle_end/backend_var.cmx : \ + typing/path.cmx \ + typing/ident.cmx \ + lambda/debuginfo.cmx \ + utils/clflags.cmx \ + middle_end/backend_var.cmi +middle_end/backend_var.cmi : \ + typing/path.cmi \ + typing/ident.cmi \ + lambda/debuginfo.cmi +middle_end/clambda.cmo : \ + typing/path.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + lambda/debuginfo.cmi \ + middle_end/clambda_primitives.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi \ + middle_end/clambda.cmi +middle_end/clambda.cmx : \ + typing/path.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + lambda/debuginfo.cmx \ + middle_end/clambda_primitives.cmx \ + middle_end/backend_var.cmx \ + parsing/asttypes.cmi \ + middle_end/clambda.cmi +middle_end/clambda.cmi : \ + typing/path.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + lambda/debuginfo.cmi \ + middle_end/clambda_primitives.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi +middle_end/clambda_primitives.cmo : \ + typing/types.cmi \ + typing/primitive.cmi \ + lambda/lambda.cmi \ + parsing/asttypes.cmi \ + middle_end/clambda_primitives.cmi +middle_end/clambda_primitives.cmx : \ + typing/types.cmx \ + typing/primitive.cmx \ + lambda/lambda.cmx \ + parsing/asttypes.cmi \ + middle_end/clambda_primitives.cmi +middle_end/clambda_primitives.cmi : \ + typing/types.cmi \ + typing/primitive.cmi \ + lambda/lambda.cmi \ + parsing/asttypes.cmi +middle_end/compilation_unit.cmo : \ + utils/misc.cmi \ + middle_end/linkage_name.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + utils/identifiable.cmi \ + typing/ident.cmi \ + middle_end/compilation_unit.cmi +middle_end/compilation_unit.cmx : \ + utils/misc.cmx \ + middle_end/linkage_name.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + utils/identifiable.cmx \ + typing/ident.cmx \ + middle_end/compilation_unit.cmi +middle_end/compilation_unit.cmi : \ + middle_end/linkage_name.cmi \ + utils/identifiable.cmi \ + typing/ident.cmi +middle_end/compilenv.cmo : \ + utils/warnings.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + typing/path.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + middle_end/linkage_name.cmi \ + typing/ident.cmi \ + middle_end/flambda/export_info.cmi \ + typing/env.cmi \ + utils/config.cmi \ + middle_end/compilation_unit.cmi \ + file_formats/cmx_format.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + utils/clflags.cmi \ + middle_end/clambda.cmi \ + middle_end/compilenv.cmi +middle_end/compilenv.cmx : \ + utils/warnings.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/simple_value_approx.cmx \ + middle_end/flambda/base_types/set_of_closures_id.cmx \ + typing/path.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + utils/load_path.cmx \ + middle_end/linkage_name.cmx \ + typing/ident.cmx \ + middle_end/flambda/export_info.cmx \ + typing/env.cmx \ + utils/config.cmx \ + middle_end/compilation_unit.cmx \ + file_formats/cmx_format.cmi \ + middle_end/flambda/base_types/closure_id.cmx \ + utils/clflags.cmx \ + middle_end/clambda.cmx \ + middle_end/compilenv.cmi +middle_end/compilenv.cmi : \ + middle_end/symbol.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + middle_end/linkage_name.cmi \ + typing/ident.cmi \ + middle_end/flambda/export_info.cmi \ + middle_end/compilation_unit.cmi \ + file_formats/cmx_format.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/clambda.cmi +middle_end/convert_primitives.cmo : \ + lambda/printlambda.cmi \ + utils/misc.cmi \ + lambda/lambda.cmi \ + middle_end/clambda_primitives.cmi \ + middle_end/convert_primitives.cmi +middle_end/convert_primitives.cmx : \ + lambda/printlambda.cmx \ + utils/misc.cmx \ + lambda/lambda.cmx \ + middle_end/clambda_primitives.cmx \ + middle_end/convert_primitives.cmi +middle_end/convert_primitives.cmi : \ + lambda/lambda.cmi \ + middle_end/clambda_primitives.cmi +middle_end/internal_variable_names.cmo : \ + parsing/location.cmi \ + lambda/lambda.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + lambda/debuginfo.cmi \ + middle_end/internal_variable_names.cmi +middle_end/internal_variable_names.cmx : \ + parsing/location.cmx \ + lambda/lambda.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + lambda/debuginfo.cmx \ + middle_end/internal_variable_names.cmi +middle_end/internal_variable_names.cmi : \ + lambda/lambda.cmi +middle_end/linkage_name.cmo : \ + utils/int_replace_polymorphic_compare.cmi \ + utils/identifiable.cmi \ + middle_end/linkage_name.cmi +middle_end/linkage_name.cmx : \ + utils/int_replace_polymorphic_compare.cmx \ + utils/identifiable.cmx \ + middle_end/linkage_name.cmi +middle_end/linkage_name.cmi : \ + utils/identifiable.cmi +middle_end/printclambda.cmo : \ + lambda/printlambda.cmi \ + middle_end/printclambda_primitives.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + middle_end/clambda.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi \ + middle_end/printclambda.cmi +middle_end/printclambda.cmx : \ + lambda/printlambda.cmx \ + middle_end/printclambda_primitives.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + middle_end/clambda.cmx \ + middle_end/backend_var.cmx \ + parsing/asttypes.cmi \ + middle_end/printclambda.cmi +middle_end/printclambda.cmi : \ + middle_end/clambda.cmi +middle_end/printclambda_primitives.cmo : \ + lambda/printlambda.cmi \ + typing/primitive.cmi \ + lambda/lambda.cmi \ + middle_end/clambda_primitives.cmi \ + parsing/asttypes.cmi \ + middle_end/printclambda_primitives.cmi +middle_end/printclambda_primitives.cmx : \ + lambda/printlambda.cmx \ + typing/primitive.cmx \ + lambda/lambda.cmx \ + middle_end/clambda_primitives.cmx \ + parsing/asttypes.cmi \ + middle_end/printclambda_primitives.cmi +middle_end/printclambda_primitives.cmi : \ + middle_end/clambda_primitives.cmi +middle_end/semantics_of_primitives.cmo : \ + middle_end/clambda_primitives.cmi \ + middle_end/semantics_of_primitives.cmi +middle_end/semantics_of_primitives.cmx : \ + middle_end/clambda_primitives.cmx \ + middle_end/semantics_of_primitives.cmi +middle_end/semantics_of_primitives.cmi : \ + middle_end/clambda_primitives.cmi +middle_end/symbol.cmo : \ + middle_end/variable.cmi \ + utils/misc.cmi \ + middle_end/linkage_name.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + utils/identifiable.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/symbol.cmi +middle_end/symbol.cmx : \ + middle_end/variable.cmx \ + utils/misc.cmx \ + middle_end/linkage_name.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + utils/identifiable.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/symbol.cmi +middle_end/symbol.cmi : \ + middle_end/variable.cmi \ + middle_end/linkage_name.cmi \ + utils/identifiable.cmi \ + middle_end/compilation_unit.cmi +middle_end/variable.cmo : \ + utils/misc.cmi \ + middle_end/internal_variable_names.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + utils/identifiable.cmi \ + typing/ident.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/variable.cmi +middle_end/variable.cmx : \ + utils/misc.cmx \ + middle_end/internal_variable_names.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + utils/identifiable.cmx \ + typing/ident.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/variable.cmi +middle_end/variable.cmi : \ + middle_end/internal_variable_names.cmi \ + utils/identifiable.cmi \ + typing/ident.cmi \ + middle_end/compilation_unit.cmi +lambda/debuginfo.cmo : \ + parsing/location.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + typing/ident.cmi \ + parsing/asttypes.cmi \ + lambda/debuginfo.cmi +lambda/debuginfo.cmx : \ + parsing/location.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + typing/ident.cmx \ + parsing/asttypes.cmi \ + lambda/debuginfo.cmi +lambda/debuginfo.cmi : \ + parsing/location.cmi \ + typing/ident.cmi \ + parsing/asttypes.cmi +lambda/lambda.cmo : \ + typing/types.cmi \ + typing/primitive.cmi \ + typing/path.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + lambda/debuginfo.cmi \ + parsing/asttypes.cmi \ + lambda/lambda.cmi +lambda/lambda.cmx : \ + typing/types.cmx \ + typing/primitive.cmx \ + typing/path.cmx \ + utils/misc.cmx \ + parsing/longident.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + lambda/debuginfo.cmx \ + parsing/asttypes.cmi \ + lambda/lambda.cmi +lambda/lambda.cmi : \ + typing/types.cmi \ + typing/primitive.cmi \ + typing/path.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + lambda/debuginfo.cmi \ + parsing/asttypes.cmi +lambda/matching.cmo : \ + typing/types.cmi \ + typing/typeopt.cmi \ + typing/typedtree.cmi \ + lambda/switch.cmi \ + typing/printpat.cmi \ + lambda/printlambda.cmi \ + typing/primitive.cmi \ + typing/predef.cmi \ + typing/parmatch.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + lambda/debuginfo.cmi \ + utils/clflags.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + lambda/matching.cmi +lambda/matching.cmx : \ + typing/types.cmx \ + typing/typeopt.cmx \ + typing/typedtree.cmx \ + lambda/switch.cmx \ + typing/printpat.cmx \ + lambda/printlambda.cmx \ + typing/primitive.cmx \ + typing/predef.cmx \ + typing/parmatch.cmx \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + lambda/debuginfo.cmx \ + utils/clflags.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + lambda/matching.cmi +lambda/matching.cmi : \ + typing/typedtree.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + lambda/debuginfo.cmi +lambda/printlambda.cmo : \ + typing/types.cmi \ + typing/printtyp.cmi \ + typing/primitive.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + lambda/debuginfo.cmi \ + utils/clflags.cmi \ + parsing/asttypes.cmi \ + lambda/printlambda.cmi +lambda/printlambda.cmx : \ + typing/types.cmx \ + typing/printtyp.cmx \ + typing/primitive.cmx \ + parsing/location.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + lambda/debuginfo.cmx \ + utils/clflags.cmx \ + parsing/asttypes.cmi \ + lambda/printlambda.cmi +lambda/printlambda.cmi : \ + typing/types.cmi \ + lambda/lambda.cmi +lambda/runtimedef.cmo : \ + lambda/runtimedef.cmi +lambda/runtimedef.cmx : \ + lambda/runtimedef.cmi +lambda/runtimedef.cmi : +lambda/simplif.cmo : \ + utils/warnings.cmi \ + typing/primitive.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + lambda/debuginfo.cmi \ + utils/clflags.cmi \ + parsing/asttypes.cmi \ + lambda/simplif.cmi +lambda/simplif.cmx : \ + utils/warnings.cmx \ + typing/primitive.cmx \ + parsing/location.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + lambda/debuginfo.cmx \ + utils/clflags.cmx \ + parsing/asttypes.cmi \ + lambda/simplif.cmi +lambda/simplif.cmi : \ + lambda/lambda.cmi \ + typing/ident.cmi +lambda/switch.cmo : \ + lambda/switch.cmi +lambda/switch.cmx : \ + lambda/switch.cmi +lambda/switch.cmi : +lambda/translattribute.cmo : \ + utils/warnings.cmi \ + typing/typedtree.cmi \ + parsing/parsetree.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + utils/config.cmi \ + lambda/translattribute.cmi +lambda/translattribute.cmx : \ + utils/warnings.cmx \ + typing/typedtree.cmx \ + parsing/parsetree.cmi \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + lambda/lambda.cmx \ + utils/config.cmx \ + lambda/translattribute.cmi +lambda/translattribute.cmi : \ + typing/typedtree.cmi \ + parsing/parsetree.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi +lambda/translclass.cmo : \ + typing/types.cmi \ + typing/typeopt.cmi \ + typing/typedtree.cmi \ + lambda/translobj.cmi \ + lambda/translcore.cmi \ + typing/path.cmi \ + lambda/matching.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + lambda/debuginfo.cmi \ + utils/clflags.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + lambda/translclass.cmi +lambda/translclass.cmx : \ + typing/types.cmx \ + typing/typeopt.cmx \ + typing/typedtree.cmx \ + lambda/translobj.cmx \ + lambda/translcore.cmx \ + typing/path.cmx \ + lambda/matching.cmx \ + parsing/location.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + lambda/debuginfo.cmx \ + utils/clflags.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + lambda/translclass.cmi +lambda/translclass.cmi : \ + typing/typedtree.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + lambda/debuginfo.cmi \ + parsing/asttypes.cmi +lambda/translcore.cmo : \ + typing/types.cmi \ + typing/typeopt.cmi \ + typing/typedtree.cmi \ + typing/typecore.cmi \ + lambda/translprim.cmi \ + lambda/translobj.cmi \ + lambda/translattribute.cmi \ + typing/printtyp.cmi \ + typing/primitive.cmi \ + typing/predef.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + typing/parmatch.cmi \ + utils/misc.cmi \ + lambda/matching.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + lambda/debuginfo.cmi \ + utils/config.cmi \ + utils/clflags.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + lambda/translcore.cmi +lambda/translcore.cmx : \ + typing/types.cmx \ + typing/typeopt.cmx \ + typing/typedtree.cmx \ + typing/typecore.cmx \ + lambda/translprim.cmx \ + lambda/translobj.cmx \ + lambda/translattribute.cmx \ + typing/printtyp.cmx \ + typing/primitive.cmx \ + typing/predef.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + typing/parmatch.cmx \ + utils/misc.cmx \ + lambda/matching.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + lambda/debuginfo.cmx \ + utils/config.cmx \ + utils/clflags.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + lambda/translcore.cmi +lambda/translcore.cmi : \ + typing/typedtree.cmi \ + typing/path.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + lambda/debuginfo.cmi \ + parsing/asttypes.cmi +lambda/translmod.cmo : \ + typing/types.cmi \ + typing/typedtree.cmi \ + lambda/translprim.cmi \ + lambda/translobj.cmi \ + lambda/translcore.cmi \ + lambda/translclass.cmi \ + lambda/translattribute.cmi \ + typing/primitive.cmi \ + typing/predef.cmi \ + typing/path.cmi \ + typing/mtype.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + lambda/debuginfo.cmi \ + typing/ctype.cmi \ + utils/clflags.cmi \ + parsing/asttypes.cmi \ + lambda/translmod.cmi +lambda/translmod.cmx : \ + typing/types.cmx \ + typing/typedtree.cmx \ + lambda/translprim.cmx \ + lambda/translobj.cmx \ + lambda/translcore.cmx \ + lambda/translclass.cmx \ + lambda/translattribute.cmx \ + typing/primitive.cmx \ + typing/predef.cmx \ + typing/path.cmx \ + typing/mtype.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + lambda/debuginfo.cmx \ + typing/ctype.cmx \ + utils/clflags.cmx \ + parsing/asttypes.cmi \ + lambda/translmod.cmi +lambda/translmod.cmi : \ + typing/typedtree.cmi \ + typing/primitive.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi +lambda/translobj.cmo : \ + typing/primitive.cmi \ + utils/misc.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + utils/config.cmi \ + utils/clflags.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + lambda/translobj.cmi +lambda/translobj.cmx : \ + typing/primitive.cmx \ + utils/misc.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + utils/config.cmx \ + utils/clflags.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + lambda/translobj.cmi +lambda/translobj.cmi : \ + lambda/lambda.cmi \ + typing/ident.cmi \ + typing/env.cmi +lambda/translprim.cmo : \ + typing/types.cmi \ + typing/typeopt.cmi \ + typing/typedtree.cmi \ + typing/primitive.cmi \ + typing/predef.cmi \ + typing/path.cmi \ + utils/misc.cmi \ + lambda/matching.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + lambda/debuginfo.cmi \ + utils/config.cmi \ + utils/clflags.cmi \ + parsing/asttypes.cmi \ + lambda/translprim.cmi +lambda/translprim.cmx : \ + typing/types.cmx \ + typing/typeopt.cmx \ + typing/typedtree.cmx \ + typing/primitive.cmx \ + typing/predef.cmx \ + typing/path.cmx \ + utils/misc.cmx \ + lambda/matching.cmx \ + parsing/location.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + lambda/debuginfo.cmx \ + utils/config.cmx \ + utils/clflags.cmx \ + parsing/asttypes.cmi \ + lambda/translprim.cmi +lambda/translprim.cmi : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/primitive.cmi \ + typing/path.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + typing/env.cmi +file_formats/cmi_format.cmo : \ + typing/types.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + utils/config.cmi \ + file_formats/cmi_format.cmi +file_formats/cmi_format.cmx : \ + typing/types.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + utils/config.cmx \ + file_formats/cmi_format.cmi +file_formats/cmi_format.cmi : \ + typing/types.cmi \ + utils/misc.cmi +file_formats/cmo_format.cmi : \ + utils/misc.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi +file_formats/cmt_format.cmo : \ + typing/types.cmi \ + typing/typedtree.cmi \ + typing/tast_mapper.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + parsing/lexer.cmi \ + typing/env.cmi \ + utils/config.cmi \ + file_formats/cmi_format.cmi \ + utils/clflags.cmi \ + file_formats/cmt_format.cmi +file_formats/cmt_format.cmx : \ + typing/types.cmx \ + typing/typedtree.cmx \ + typing/tast_mapper.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + utils/load_path.cmx \ + parsing/lexer.cmx \ + typing/env.cmx \ + utils/config.cmx \ + file_formats/cmi_format.cmx \ + utils/clflags.cmx \ + file_formats/cmt_format.cmi +file_formats/cmt_format.cmi : \ + typing/types.cmi \ + typing/typedtree.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + typing/env.cmi \ + file_formats/cmi_format.cmi +file_formats/cmx_format.cmi : \ + utils/misc.cmi \ + middle_end/flambda/export_info.cmi \ + middle_end/clambda.cmi +file_formats/cmxs_format.cmi : \ + utils/misc.cmi +middle_end/closure/closure.cmo : \ + utils/warnings.cmi \ + lambda/switch.cmi \ + lambda/simplif.cmi \ + middle_end/semantics_of_primitives.cmi \ + typing/primitive.cmi \ + utils/numbers.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + lambda/debuginfo.cmi \ + middle_end/convert_primitives.cmi \ + utils/config.cmi \ + middle_end/compilenv.cmi \ + utils/clflags.cmi \ + middle_end/clambda_primitives.cmi \ + middle_end/clambda.cmi \ + middle_end/backend_var.cmi \ + middle_end/backend_intf.cmi \ + parsing/asttypes.cmi \ + middle_end/closure/closure.cmi +middle_end/closure/closure.cmx : \ + utils/warnings.cmx \ + lambda/switch.cmx \ + lambda/simplif.cmx \ + middle_end/semantics_of_primitives.cmx \ + typing/primitive.cmx \ + utils/numbers.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + lambda/debuginfo.cmx \ + middle_end/convert_primitives.cmx \ + utils/config.cmx \ + middle_end/compilenv.cmx \ + utils/clflags.cmx \ + middle_end/clambda_primitives.cmx \ + middle_end/clambda.cmx \ + middle_end/backend_var.cmx \ + middle_end/backend_intf.cmi \ + parsing/asttypes.cmi \ + middle_end/closure/closure.cmi +middle_end/closure/closure.cmi : \ + lambda/lambda.cmi \ + middle_end/clambda.cmi \ + middle_end/backend_intf.cmi +middle_end/closure/closure_middle_end.cmo : \ + middle_end/printclambda.cmi \ + typing/path.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + middle_end/compilenv.cmi \ + middle_end/closure/closure.cmi \ + utils/clflags.cmi \ + middle_end/clambda.cmi \ + middle_end/closure/closure_middle_end.cmi +middle_end/closure/closure_middle_end.cmx : \ + middle_end/printclambda.cmx \ + typing/path.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + middle_end/compilenv.cmx \ + middle_end/closure/closure.cmx \ + utils/clflags.cmx \ + middle_end/clambda.cmx \ + middle_end/closure/closure_middle_end.cmi +middle_end/closure/closure_middle_end.cmi : \ + lambda/lambda.cmi \ + middle_end/clambda.cmi \ + middle_end/backend_intf.cmi +middle_end/flambda/alias_analysis.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + utils/misc.cmi \ + lambda/lambda.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda.cmi \ + parsing/asttypes.cmi \ + middle_end/flambda/allocated_const.cmi \ + middle_end/flambda/alias_analysis.cmi +middle_end/flambda/alias_analysis.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/flambda/base_types/tag.cmx \ + middle_end/symbol.cmx \ + utils/misc.cmx \ + lambda/lambda.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda.cmx \ + parsing/asttypes.cmi \ + middle_end/flambda/allocated_const.cmx \ + middle_end/flambda/alias_analysis.cmi +middle_end/flambda/alias_analysis.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + lambda/lambda.cmi \ + middle_end/flambda/flambda.cmi \ + parsing/asttypes.cmi \ + middle_end/flambda/allocated_const.cmi +middle_end/flambda/allocated_const.cmo : \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/allocated_const.cmi +middle_end/flambda/allocated_const.cmx : \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/allocated_const.cmi +middle_end/flambda/allocated_const.cmi : +middle_end/flambda/augment_specialised_args.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/projection.cmi \ + middle_end/flambda/pass_wrapper.cmi \ + middle_end/flambda/parameter.cmi \ + utils/misc.cmi \ + middle_end/internal_variable_names.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + utils/identifiable.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda.cmi \ + lambda/debuginfo.cmi \ + middle_end/flambda/base_types/closure_origin.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + utils/clflags.cmi \ + middle_end/backend_intf.cmi \ + middle_end/flambda/augment_specialised_args.cmi +middle_end/flambda/augment_specialised_args.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/projection.cmx \ + middle_end/flambda/pass_wrapper.cmx \ + middle_end/flambda/parameter.cmx \ + utils/misc.cmx \ + middle_end/internal_variable_names.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inlining_cost.cmx \ + middle_end/flambda/inline_and_simplify_aux.cmx \ + utils/identifiable.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda.cmx \ + lambda/debuginfo.cmx \ + middle_end/flambda/base_types/closure_origin.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + utils/clflags.cmx \ + middle_end/backend_intf.cmi \ + middle_end/flambda/augment_specialised_args.cmi +middle_end/flambda/augment_specialised_args.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/projection.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/flambda.cmi +middle_end/flambda/build_export_info.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/traverse_for_exported_symbols.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + utils/misc.cmi \ + middle_end/flambda/invariant_params.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/find_recursive_functions.cmi \ + middle_end/flambda/export_info.cmi \ + middle_end/flambda/base_types/export_id.cmi \ + middle_end/compilenv.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + utils/clflags.cmi \ + middle_end/backend_intf.cmi \ + middle_end/flambda/allocated_const.cmi \ + middle_end/flambda/build_export_info.cmi +middle_end/flambda/build_export_info.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/flambda/traverse_for_exported_symbols.cmx \ + middle_end/flambda/base_types/tag.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/simple_value_approx.cmx \ + middle_end/flambda/base_types/set_of_closures_id.cmx \ + utils/misc.cmx \ + middle_end/flambda/invariant_params.cmx \ + middle_end/flambda/inline_and_simplify_aux.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/find_recursive_functions.cmx \ + middle_end/flambda/export_info.cmx \ + middle_end/flambda/base_types/export_id.cmx \ + middle_end/compilenv.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + utils/clflags.cmx \ + middle_end/backend_intf.cmi \ + middle_end/flambda/allocated_const.cmx \ + middle_end/flambda/build_export_info.cmi +middle_end/flambda/build_export_info.cmi : \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/export_info.cmi \ + middle_end/backend_intf.cmi +middle_end/flambda/closure_conversion.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/base_types/static_exception.cmi \ + lambda/simplif.cmi \ + typing/predef.cmi \ + middle_end/flambda/parameter.cmi \ + utils/numbers.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi \ + utils/misc.cmi \ + middle_end/flambda/lift_code.cmi \ + lambda/lambda.cmi \ + middle_end/internal_variable_names.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + typing/ident.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda.cmi \ + lambda/debuginfo.cmi \ + middle_end/convert_primitives.cmi \ + utils/config.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_origin.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/flambda/closure_conversion_aux.cmi \ + utils/clflags.cmi \ + middle_end/clambda_primitives.cmi \ + middle_end/backend_intf.cmi \ + middle_end/flambda/closure_conversion.cmi +middle_end/flambda/closure_conversion.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/tag.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/base_types/static_exception.cmx \ + lambda/simplif.cmx \ + typing/predef.cmx \ + middle_end/flambda/parameter.cmx \ + utils/numbers.cmx \ + middle_end/flambda/base_types/mutable_variable.cmx \ + utils/misc.cmx \ + middle_end/flambda/lift_code.cmx \ + lambda/lambda.cmx \ + middle_end/internal_variable_names.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + typing/ident.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda.cmx \ + lambda/debuginfo.cmx \ + middle_end/convert_primitives.cmx \ + utils/config.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/closure_origin.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/flambda/closure_conversion_aux.cmx \ + utils/clflags.cmx \ + middle_end/clambda_primitives.cmx \ + middle_end/backend_intf.cmi \ + middle_end/flambda/closure_conversion.cmi +middle_end/flambda/closure_conversion.cmi : \ + lambda/lambda.cmi \ + typing/ident.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/backend_intf.cmi +middle_end/flambda/closure_conversion_aux.cmo : \ + middle_end/variable.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/base_types/static_exception.cmi \ + utils/numbers.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi \ + utils/misc.cmi \ + lambda/lambda.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + typing/ident.cmi \ + middle_end/flambda/closure_conversion_aux.cmi +middle_end/flambda/closure_conversion_aux.cmx : \ + middle_end/variable.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/base_types/static_exception.cmx \ + utils/numbers.cmx \ + middle_end/flambda/base_types/mutable_variable.cmx \ + utils/misc.cmx \ + lambda/lambda.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + typing/ident.cmx \ + middle_end/flambda/closure_conversion_aux.cmi +middle_end/flambda/closure_conversion_aux.cmi : \ + middle_end/variable.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/base_types/static_exception.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi +middle_end/flambda/closure_offsets.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + utils/misc.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/flambda/closure_offsets.cmi +middle_end/flambda/closure_offsets.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + utils/misc.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/flambda/closure_offsets.cmi +middle_end/flambda/closure_offsets.cmi : \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/base_types/closure_id.cmi +middle_end/flambda/effect_analysis.cmo : \ + middle_end/semantics_of_primitives.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/clambda_primitives.cmi \ + middle_end/flambda/effect_analysis.cmi +middle_end/flambda/effect_analysis.cmx : \ + middle_end/semantics_of_primitives.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/clambda_primitives.cmx \ + middle_end/flambda/effect_analysis.cmi +middle_end/flambda/effect_analysis.cmi : \ + middle_end/flambda/flambda.cmi +middle_end/flambda/export_info.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/base_types/export_id.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/flambda/export_info.cmi +middle_end/flambda/export_info.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/flambda/base_types/tag.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/simple_value_approx.cmx \ + middle_end/flambda/base_types/set_of_closures_id.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/base_types/export_id.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/flambda/export_info.cmi +middle_end/flambda/export_info.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/base_types/export_id.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_id.cmi +middle_end/flambda/export_info_for_pack.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/base_types/set_of_closures_origin.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/export_info.cmi \ + middle_end/flambda/base_types/export_id.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/flambda/export_info_for_pack.cmi +middle_end/flambda/export_info_for_pack.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/simple_value_approx.cmx \ + middle_end/flambda/base_types/set_of_closures_origin.cmx \ + middle_end/flambda/base_types/set_of_closures_id.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/export_info.cmx \ + middle_end/flambda/base_types/export_id.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/flambda/export_info_for_pack.cmi +middle_end/flambda/export_info_for_pack.cmi : \ + middle_end/flambda/export_info.cmi \ + middle_end/compilation_unit.cmi +middle_end/flambda/extract_projections.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/projection.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/freshening.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/flambda/extract_projections.cmi +middle_end/flambda/extract_projections.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/flambda/simple_value_approx.cmx \ + middle_end/flambda/projection.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inline_and_simplify_aux.cmx \ + middle_end/flambda/freshening.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/flambda/extract_projections.cmi +middle_end/flambda/extract_projections.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/projection.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/flambda.cmi +middle_end/flambda/find_recursive_functions.cmo : \ + middle_end/variable.cmi \ + utils/strongly_connected_components.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/backend_intf.cmi \ + middle_end/flambda/find_recursive_functions.cmi +middle_end/flambda/find_recursive_functions.cmx : \ + middle_end/variable.cmx \ + utils/strongly_connected_components.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/backend_intf.cmi \ + middle_end/flambda/find_recursive_functions.cmi +middle_end/flambda/find_recursive_functions.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/backend_intf.cmi +middle_end/flambda/flambda.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/base_types/static_exception.cmi \ + middle_end/flambda/base_types/set_of_closures_origin.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + middle_end/flambda/projection.cmi \ + lambda/printlambda.cmi \ + middle_end/printclambda_primitives.cmi \ + middle_end/flambda/parameter.cmi \ + utils/numbers.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi \ + utils/misc.cmi \ + lambda/lambda.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + utils/identifiable.cmi \ + lambda/debuginfo.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_origin.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + utils/clflags.cmi \ + middle_end/clambda_primitives.cmi \ + parsing/asttypes.cmi \ + middle_end/flambda/allocated_const.cmi \ + middle_end/flambda/flambda.cmi +middle_end/flambda/flambda.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/tag.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/base_types/static_exception.cmx \ + middle_end/flambda/base_types/set_of_closures_origin.cmx \ + middle_end/flambda/base_types/set_of_closures_id.cmx \ + middle_end/flambda/projection.cmx \ + lambda/printlambda.cmx \ + middle_end/printclambda_primitives.cmx \ + middle_end/flambda/parameter.cmx \ + utils/numbers.cmx \ + middle_end/flambda/base_types/mutable_variable.cmx \ + utils/misc.cmx \ + lambda/lambda.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + utils/identifiable.cmx \ + lambda/debuginfo.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/closure_origin.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + utils/clflags.cmx \ + middle_end/clambda_primitives.cmx \ + parsing/asttypes.cmi \ + middle_end/flambda/allocated_const.cmx \ + middle_end/flambda/flambda.cmi +middle_end/flambda/flambda.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/base_types/static_exception.cmi \ + middle_end/flambda/base_types/set_of_closures_origin.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + middle_end/flambda/projection.cmi \ + middle_end/flambda/parameter.cmi \ + utils/numbers.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi \ + lambda/lambda.cmi \ + utils/identifiable.cmi \ + lambda/debuginfo.cmi \ + middle_end/flambda/base_types/closure_origin.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/clambda_primitives.cmi \ + parsing/asttypes.cmi \ + middle_end/flambda/allocated_const.cmi +middle_end/flambda/flambda_invariants.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/base_types/static_exception.cmi \ + middle_end/flambda/base_types/set_of_closures_origin.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + middle_end/flambda/projection.cmi \ + middle_end/printclambda_primitives.cmi \ + middle_end/flambda/parameter.cmi \ + utils/numbers.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi \ + lambda/lambda.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + lambda/debuginfo.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/clambda_primitives.cmi \ + parsing/asttypes.cmi \ + middle_end/flambda/allocated_const.cmi \ + middle_end/flambda/flambda_invariants.cmi +middle_end/flambda/flambda_invariants.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/flambda/base_types/tag.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/base_types/static_exception.cmx \ + middle_end/flambda/base_types/set_of_closures_origin.cmx \ + middle_end/flambda/base_types/set_of_closures_id.cmx \ + middle_end/flambda/projection.cmx \ + middle_end/printclambda_primitives.cmx \ + middle_end/flambda/parameter.cmx \ + utils/numbers.cmx \ + middle_end/flambda/base_types/mutable_variable.cmx \ + lambda/lambda.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + lambda/debuginfo.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/clambda_primitives.cmx \ + parsing/asttypes.cmi \ + middle_end/flambda/allocated_const.cmx \ + middle_end/flambda/flambda_invariants.cmi +middle_end/flambda/flambda_invariants.cmi : \ + middle_end/flambda/flambda.cmi +middle_end/flambda/flambda_iterators.cmo : \ + middle_end/variable.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/flambda_iterators.cmi +middle_end/flambda/flambda_iterators.cmx : \ + middle_end/variable.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/flambda_iterators.cmi +middle_end/flambda/flambda_iterators.cmi : \ + middle_end/variable.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/flambda.cmi +middle_end/flambda/flambda_middle_end.cmo : \ + utils/warnings.cmi \ + middle_end/variable.cmi \ + middle_end/flambda/un_anf.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/share_constants.cmi \ + middle_end/flambda/remove_unused_program_constructs.cmi \ + middle_end/flambda/remove_unused_closure_vars.cmi \ + middle_end/flambda/ref_to_variables.cmi \ + utils/profile.cmi \ + middle_end/printclambda.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + middle_end/linkage_name.cmi \ + middle_end/flambda/lift_let_to_initialize_symbol.cmi \ + middle_end/flambda/lift_constants.cmi \ + middle_end/flambda/lift_code.cmi \ + lambda/lambda.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/inline_and_simplify.cmi \ + middle_end/flambda/initialize_symbol_to_let_symbol.cmi \ + middle_end/flambda/flambda_to_clambda.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda_invariants.cmi \ + middle_end/flambda/flambda.cmi \ + lambda/debuginfo.cmi \ + middle_end/compilenv.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/flambda/closure_conversion.cmi \ + utils/clflags.cmi \ + middle_end/clambda.cmi \ + middle_end/flambda/build_export_info.cmi \ + middle_end/backend_intf.cmi \ + middle_end/flambda/flambda_middle_end.cmi +middle_end/flambda/flambda_middle_end.cmx : \ + utils/warnings.cmx \ + middle_end/variable.cmx \ + middle_end/flambda/un_anf.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/share_constants.cmx \ + middle_end/flambda/remove_unused_program_constructs.cmx \ + middle_end/flambda/remove_unused_closure_vars.cmx \ + middle_end/flambda/ref_to_variables.cmx \ + utils/profile.cmx \ + middle_end/printclambda.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + middle_end/linkage_name.cmx \ + middle_end/flambda/lift_let_to_initialize_symbol.cmx \ + middle_end/flambda/lift_constants.cmx \ + middle_end/flambda/lift_code.cmx \ + lambda/lambda.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inlining_cost.cmx \ + middle_end/flambda/inline_and_simplify.cmx \ + middle_end/flambda/initialize_symbol_to_let_symbol.cmx \ + middle_end/flambda/flambda_to_clambda.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda_invariants.cmx \ + middle_end/flambda/flambda.cmx \ + lambda/debuginfo.cmx \ + middle_end/compilenv.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/flambda/closure_conversion.cmx \ + utils/clflags.cmx \ + middle_end/clambda.cmx \ + middle_end/flambda/build_export_info.cmx \ + middle_end/backend_intf.cmi \ + middle_end/flambda/flambda_middle_end.cmi +middle_end/flambda/flambda_middle_end.cmi : \ + lambda/lambda.cmi \ + middle_end/clambda.cmi \ + middle_end/backend_intf.cmi +middle_end/flambda/flambda_to_clambda.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/un_anf.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/base_types/static_exception.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + typing/primitive.cmi \ + middle_end/flambda/parameter.cmi \ + utils/numbers.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi \ + utils/misc.cmi \ + middle_end/linkage_name.cmi \ + lambda/lambda.cmi \ + middle_end/flambda/initialize_symbol_to_let_symbol.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/export_info.cmi \ + lambda/debuginfo.cmi \ + middle_end/compilenv.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/closure_offsets.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + utils/clflags.cmi \ + middle_end/clambda.cmi \ + middle_end/backend_var.cmi \ + middle_end/flambda/allocated_const.cmi \ + middle_end/flambda/flambda_to_clambda.cmi +middle_end/flambda/flambda_to_clambda.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/flambda/un_anf.cmx \ + middle_end/flambda/base_types/tag.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/base_types/static_exception.cmx \ + middle_end/flambda/simple_value_approx.cmx \ + middle_end/flambda/base_types/set_of_closures_id.cmx \ + typing/primitive.cmx \ + middle_end/flambda/parameter.cmx \ + utils/numbers.cmx \ + middle_end/flambda/base_types/mutable_variable.cmx \ + utils/misc.cmx \ + middle_end/linkage_name.cmx \ + lambda/lambda.cmx \ + middle_end/flambda/initialize_symbol_to_let_symbol.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/export_info.cmx \ + lambda/debuginfo.cmx \ + middle_end/compilenv.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/closure_offsets.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + utils/clflags.cmx \ + middle_end/clambda.cmx \ + middle_end/backend_var.cmx \ + middle_end/flambda/allocated_const.cmx \ + middle_end/flambda/flambda_to_clambda.cmi +middle_end/flambda/flambda_to_clambda.cmi : \ + middle_end/symbol.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/export_info.cmi \ + middle_end/clambda.cmi +middle_end/flambda/flambda_utils.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/symbol.cmi \ + lambda/switch.cmi \ + middle_end/flambda/base_types/static_exception.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + middle_end/flambda/projection.cmi \ + middle_end/flambda/parameter.cmi \ + utils/numbers.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi \ + utils/misc.cmi \ + lambda/lambda.cmi \ + middle_end/internal_variable_names.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + lambda/debuginfo.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_origin.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/clambda_primitives.cmi \ + parsing/asttypes.cmi \ + middle_end/flambda/allocated_const.cmi \ + middle_end/flambda/flambda_utils.cmi +middle_end/flambda/flambda_utils.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/symbol.cmx \ + lambda/switch.cmx \ + middle_end/flambda/base_types/static_exception.cmx \ + middle_end/flambda/base_types/set_of_closures_id.cmx \ + middle_end/flambda/projection.cmx \ + middle_end/flambda/parameter.cmx \ + utils/numbers.cmx \ + middle_end/flambda/base_types/mutable_variable.cmx \ + utils/misc.cmx \ + lambda/lambda.cmx \ + middle_end/internal_variable_names.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + lambda/debuginfo.cmx \ + middle_end/compilation_unit.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 \ + middle_end/flambda/allocated_const.cmx \ + middle_end/flambda/flambda_utils.cmi +middle_end/flambda/flambda_utils.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + lambda/switch.cmi \ + middle_end/flambda/base_types/static_exception.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + middle_end/flambda/projection.cmi \ + middle_end/flambda/parameter.cmi \ + middle_end/internal_variable_names.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/base_types/closure_id.cmi +middle_end/flambda/freshening.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/base_types/static_exception.cmi \ + middle_end/flambda/projection.cmi \ + middle_end/flambda/parameter.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi \ + utils/misc.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + utils/identifiable.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/flambda/freshening.cmi +middle_end/flambda/freshening.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/base_types/static_exception.cmx \ + middle_end/flambda/projection.cmx \ + middle_end/flambda/parameter.cmx \ + middle_end/flambda/base_types/mutable_variable.cmx \ + utils/misc.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + utils/identifiable.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/flambda/freshening.cmi +middle_end/flambda/freshening.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/base_types/static_exception.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/base_types/closure_id.cmi +middle_end/flambda/import_approx.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + utils/misc.cmi \ + middle_end/flambda/freshening.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/export_info.cmi \ + middle_end/flambda/base_types/export_id.cmi \ + middle_end/compilenv.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/flambda/import_approx.cmi +middle_end/flambda/import_approx.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/simple_value_approx.cmx \ + middle_end/flambda/base_types/set_of_closures_id.cmx \ + utils/misc.cmx \ + middle_end/flambda/freshening.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/export_info.cmx \ + middle_end/flambda/base_types/export_id.cmx \ + middle_end/compilenv.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/flambda/import_approx.cmi +middle_end/flambda/import_approx.cmi : \ + middle_end/symbol.cmi \ + middle_end/flambda/simple_value_approx.cmi +middle_end/flambda/inconstant_idents.cmo : \ + middle_end/variable.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + middle_end/flambda/parameter.cmi \ + utils/numbers.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + utils/identifiable.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/backend_intf.cmi \ + parsing/asttypes.cmi \ + middle_end/flambda/inconstant_idents.cmi +middle_end/flambda/inconstant_idents.cmx : \ + middle_end/variable.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/base_types/set_of_closures_id.cmx \ + middle_end/flambda/parameter.cmx \ + utils/numbers.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + utils/identifiable.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/backend_intf.cmi \ + parsing/asttypes.cmi \ + middle_end/flambda/inconstant_idents.cmi +middle_end/flambda/inconstant_idents.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/backend_intf.cmi +middle_end/flambda/initialize_symbol_to_let_symbol.cmo : \ + middle_end/variable.cmi \ + utils/misc.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/initialize_symbol_to_let_symbol.cmi +middle_end/flambda/initialize_symbol_to_let_symbol.cmx : \ + middle_end/variable.cmx \ + utils/misc.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/initialize_symbol_to_let_symbol.cmi +middle_end/flambda/initialize_symbol_to_let_symbol.cmi : \ + middle_end/flambda/flambda.cmi +middle_end/flambda/inline_and_simplify.cmo : \ + utils/warnings.cmi \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/unbox_specialised_args.cmi \ + middle_end/flambda/unbox_free_vars_of_closures.cmi \ + middle_end/flambda/unbox_closures.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/base_types/static_exception.cmi \ + middle_end/flambda/simplify_primitives.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/remove_unused_arguments.cmi \ + middle_end/flambda/remove_free_vars_equal_to_args.cmi \ + middle_end/flambda/projection.cmi \ + typing/predef.cmi \ + middle_end/flambda/parameter.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + middle_end/flambda/lift_code.cmi \ + lambda/lambda.cmi \ + middle_end/flambda/invariant_params.cmi \ + middle_end/internal_variable_names.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inlining_stats.cmi \ + middle_end/flambda/inlining_decision.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + typing/ident.cmi \ + middle_end/flambda/freshening.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/find_recursive_functions.cmi \ + middle_end/flambda/effect_analysis.cmi \ + lambda/debuginfo.cmi \ + utils/config.cmi \ + middle_end/flambda/base_types/closure_origin.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + utils/clflags.cmi \ + middle_end/clambda_primitives.cmi \ + middle_end/backend_intf.cmi \ + middle_end/flambda/allocated_const.cmi \ + middle_end/flambda/inline_and_simplify.cmi +middle_end/flambda/inline_and_simplify.cmx : \ + utils/warnings.cmx \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/flambda/unbox_specialised_args.cmx \ + middle_end/flambda/unbox_free_vars_of_closures.cmx \ + middle_end/flambda/unbox_closures.cmx \ + middle_end/flambda/base_types/tag.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/base_types/static_exception.cmx \ + middle_end/flambda/simplify_primitives.cmx \ + middle_end/flambda/simple_value_approx.cmx \ + middle_end/flambda/remove_unused_arguments.cmx \ + middle_end/flambda/remove_free_vars_equal_to_args.cmx \ + middle_end/flambda/projection.cmx \ + typing/predef.cmx \ + middle_end/flambda/parameter.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + middle_end/flambda/lift_code.cmx \ + lambda/lambda.cmx \ + middle_end/flambda/invariant_params.cmx \ + middle_end/internal_variable_names.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inlining_stats.cmx \ + middle_end/flambda/inlining_decision.cmx \ + middle_end/flambda/inlining_cost.cmx \ + middle_end/flambda/inline_and_simplify_aux.cmx \ + typing/ident.cmx \ + middle_end/flambda/freshening.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/find_recursive_functions.cmx \ + middle_end/flambda/effect_analysis.cmx \ + lambda/debuginfo.cmx \ + utils/config.cmx \ + middle_end/flambda/base_types/closure_origin.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + utils/clflags.cmx \ + middle_end/clambda_primitives.cmx \ + middle_end/backend_intf.cmi \ + middle_end/flambda/allocated_const.cmx \ + middle_end/flambda/inline_and_simplify.cmi +middle_end/flambda/inline_and_simplify.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/backend_intf.cmi +middle_end/flambda/inline_and_simplify_aux.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/base_types/static_exception.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/base_types/set_of_closures_origin.cmi \ + middle_end/flambda/projection.cmi \ + middle_end/flambda/parameter.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi \ + utils/misc.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inlining_stats.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/freshening.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda.cmi \ + lambda/debuginfo.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_origin.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + utils/clflags.cmi \ + middle_end/backend_intf.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi +middle_end/flambda/inline_and_simplify_aux.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/base_types/static_exception.cmx \ + middle_end/flambda/simple_value_approx.cmx \ + middle_end/flambda/base_types/set_of_closures_origin.cmx \ + middle_end/flambda/projection.cmx \ + middle_end/flambda/parameter.cmx \ + middle_end/flambda/base_types/mutable_variable.cmx \ + utils/misc.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inlining_stats.cmx \ + middle_end/flambda/inlining_cost.cmx \ + middle_end/flambda/freshening.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda.cmx \ + lambda/debuginfo.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/closure_origin.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + utils/clflags.cmx \ + middle_end/backend_intf.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi +middle_end/flambda/inline_and_simplify_aux.cmi : \ + middle_end/variable.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/base_types/static_exception.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/base_types/set_of_closures_origin.cmi \ + middle_end/flambda/projection.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi \ + middle_end/flambda/inlining_stats_types.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/freshening.cmi \ + middle_end/flambda/flambda.cmi \ + lambda/debuginfo.cmi \ + middle_end/flambda/base_types/closure_origin.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/backend_intf.cmi +middle_end/flambda/inlining_cost.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/projection.cmi \ + typing/primitive.cmi \ + utils/misc.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + utils/clflags.cmi \ + middle_end/clambda_primitives.cmi \ + middle_end/flambda/inlining_cost.cmi +middle_end/flambda/inlining_cost.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/projection.cmx \ + typing/primitive.cmx \ + utils/misc.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + utils/clflags.cmx \ + middle_end/clambda_primitives.cmx \ + middle_end/flambda/inlining_cost.cmi +middle_end/flambda/inlining_cost.cmi : \ + middle_end/flambda/projection.cmi \ + middle_end/flambda/flambda.cmi +middle_end/flambda/inlining_decision.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/parameter.cmi \ + utils/misc.cmi \ + lambda/lambda.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inlining_transforms.cmi \ + middle_end/flambda/inlining_stats_types.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + utils/clflags.cmi \ + middle_end/flambda/inlining_decision.cmi +middle_end/flambda/inlining_decision.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/flambda/simple_value_approx.cmx \ + middle_end/flambda/parameter.cmx \ + utils/misc.cmx \ + lambda/lambda.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inlining_transforms.cmx \ + middle_end/flambda/inlining_stats_types.cmx \ + middle_end/flambda/inlining_cost.cmx \ + middle_end/flambda/inline_and_simplify_aux.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + utils/clflags.cmx \ + middle_end/flambda/inlining_decision.cmi +middle_end/flambda/inlining_decision.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + lambda/lambda.cmi \ + middle_end/flambda/inlining_decision_intf.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/flambda.cmi \ + lambda/debuginfo.cmi \ + middle_end/flambda/base_types/closure_id.cmi +middle_end/flambda/inlining_decision_intf.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/flambda.cmi \ + lambda/debuginfo.cmi \ + middle_end/flambda/base_types/closure_id.cmi +middle_end/flambda/inlining_stats.cmo : \ + utils/misc.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inlining_stats_types.cmi \ + lambda/debuginfo.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + utils/clflags.cmi \ + middle_end/flambda/inlining_stats.cmi +middle_end/flambda/inlining_stats.cmx : \ + utils/misc.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inlining_stats_types.cmx \ + lambda/debuginfo.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + utils/clflags.cmx \ + middle_end/flambda/inlining_stats.cmi +middle_end/flambda/inlining_stats.cmi : \ + middle_end/flambda/inlining_stats_types.cmi \ + lambda/debuginfo.cmi \ + middle_end/flambda/base_types/closure_id.cmi +middle_end/flambda/inlining_stats_types.cmo : \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/inlining_stats_types.cmi +middle_end/flambda/inlining_stats_types.cmx : \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inlining_cost.cmx \ + middle_end/flambda/inlining_stats_types.cmi +middle_end/flambda/inlining_stats_types.cmi : \ + middle_end/flambda/inlining_cost.cmi +middle_end/flambda/inlining_transforms.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/projection.cmi \ + middle_end/flambda/parameter.cmi \ + lambda/lambda.cmi \ + middle_end/internal_variable_names.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inlining_decision_intf.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + lambda/debuginfo.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_origin.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/flambda/inlining_transforms.cmi +middle_end/flambda/inlining_transforms.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/flambda/simple_value_approx.cmx \ + middle_end/flambda/projection.cmx \ + middle_end/flambda/parameter.cmx \ + lambda/lambda.cmx \ + middle_end/internal_variable_names.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inlining_decision_intf.cmi \ + middle_end/flambda/inlining_cost.cmx \ + middle_end/flambda/inline_and_simplify_aux.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + lambda/debuginfo.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/closure_origin.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/flambda/inlining_transforms.cmi +middle_end/flambda/inlining_transforms.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + lambda/lambda.cmi \ + middle_end/flambda/inlining_decision_intf.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/flambda.cmi \ + lambda/debuginfo.cmi \ + middle_end/flambda/base_types/closure_id.cmi +middle_end/flambda/invariant_params.cmo : \ + middle_end/variable.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/parameter.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + utils/clflags.cmi \ + middle_end/backend_intf.cmi \ + middle_end/flambda/invariant_params.cmi +middle_end/flambda/invariant_params.cmx : \ + middle_end/variable.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/parameter.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + utils/clflags.cmx \ + middle_end/backend_intf.cmi \ + middle_end/flambda/invariant_params.cmi +middle_end/flambda/invariant_params.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/backend_intf.cmi +middle_end/flambda/lift_code.cmo : \ + middle_end/variable.cmi \ + utils/strongly_connected_components.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi \ + lambda/lambda.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/lift_code.cmi +middle_end/flambda/lift_code.cmx : \ + middle_end/variable.cmx \ + utils/strongly_connected_components.cmx \ + middle_end/flambda/base_types/mutable_variable.cmx \ + lambda/lambda.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/lift_code.cmi +middle_end/flambda/lift_code.cmi : \ + middle_end/variable.cmi \ + middle_end/internal_variable_names.cmi \ + middle_end/flambda/flambda.cmi +middle_end/flambda/lift_constants.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + utils/strongly_connected_components.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + utils/misc.cmi \ + middle_end/internal_variable_names.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inconstant_idents.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/backend_intf.cmi \ + parsing/asttypes.cmi \ + middle_end/flambda/allocated_const.cmi \ + middle_end/flambda/alias_analysis.cmi \ + middle_end/flambda/lift_constants.cmi +middle_end/flambda/lift_constants.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/flambda/base_types/tag.cmx \ + middle_end/symbol.cmx \ + utils/strongly_connected_components.cmx \ + middle_end/flambda/simple_value_approx.cmx \ + utils/misc.cmx \ + middle_end/internal_variable_names.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inconstant_idents.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/backend_intf.cmi \ + parsing/asttypes.cmi \ + middle_end/flambda/allocated_const.cmx \ + middle_end/flambda/alias_analysis.cmx \ + middle_end/flambda/lift_constants.cmi +middle_end/flambda/lift_constants.cmi : \ + middle_end/flambda/flambda.cmi \ + middle_end/backend_intf.cmi +middle_end/flambda/lift_let_to_initialize_symbol.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + middle_end/internal_variable_names.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda.cmi \ + lambda/debuginfo.cmi \ + parsing/asttypes.cmi \ + middle_end/flambda/lift_let_to_initialize_symbol.cmi +middle_end/flambda/lift_let_to_initialize_symbol.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/tag.cmx \ + middle_end/symbol.cmx \ + middle_end/internal_variable_names.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda.cmx \ + lambda/debuginfo.cmx \ + parsing/asttypes.cmi \ + middle_end/flambda/lift_let_to_initialize_symbol.cmi +middle_end/flambda/lift_let_to_initialize_symbol.cmi : \ + middle_end/flambda/flambda.cmi \ + middle_end/backend_intf.cmi +middle_end/flambda/parameter.cmo : \ + middle_end/variable.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + utils/identifiable.cmi \ + middle_end/flambda/parameter.cmi +middle_end/flambda/parameter.cmx : \ + middle_end/variable.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + utils/identifiable.cmx \ + middle_end/flambda/parameter.cmi +middle_end/flambda/parameter.cmi : \ + middle_end/variable.cmi \ + utils/identifiable.cmi \ + middle_end/compilation_unit.cmi +middle_end/flambda/pass_wrapper.cmo : \ + utils/int_replace_polymorphic_compare.cmi \ + utils/clflags.cmi \ + middle_end/flambda/pass_wrapper.cmi +middle_end/flambda/pass_wrapper.cmx : \ + utils/int_replace_polymorphic_compare.cmx \ + utils/clflags.cmx \ + middle_end/flambda/pass_wrapper.cmi +middle_end/flambda/pass_wrapper.cmi : +middle_end/flambda/projection.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + utils/identifiable.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/flambda/projection.cmi +middle_end/flambda/projection.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + utils/identifiable.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/flambda/projection.cmi +middle_end/flambda/projection.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + utils/identifiable.cmi \ + middle_end/flambda/base_types/closure_id.cmi +middle_end/flambda/ref_to_variables.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi \ + lambda/lambda.cmi \ + middle_end/internal_variable_names.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + parsing/asttypes.cmi \ + middle_end/flambda/ref_to_variables.cmi +middle_end/flambda/ref_to_variables.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/mutable_variable.cmx \ + lambda/lambda.cmx \ + middle_end/internal_variable_names.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + parsing/asttypes.cmi \ + middle_end/flambda/ref_to_variables.cmi +middle_end/flambda/ref_to_variables.cmi : \ + middle_end/flambda/flambda.cmi +middle_end/flambda/remove_free_vars_equal_to_args.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/pass_wrapper.cmi \ + middle_end/flambda/parameter.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/remove_free_vars_equal_to_args.cmi +middle_end/flambda/remove_free_vars_equal_to_args.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/pass_wrapper.cmx \ + middle_end/flambda/parameter.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/remove_free_vars_equal_to_args.cmi +middle_end/flambda/remove_free_vars_equal_to_args.cmi : \ + middle_end/flambda/flambda.cmi +middle_end/flambda/remove_unused_arguments.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/projection.cmi \ + middle_end/flambda/parameter.cmi \ + middle_end/flambda/invariant_params.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/find_recursive_functions.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_origin.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + utils/clflags.cmi \ + middle_end/flambda/remove_unused_arguments.cmi +middle_end/flambda/remove_unused_arguments.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/projection.cmx \ + middle_end/flambda/parameter.cmx \ + middle_end/flambda/invariant_params.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/find_recursive_functions.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/closure_origin.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + utils/clflags.cmx \ + middle_end/flambda/remove_unused_arguments.cmi +middle_end/flambda/remove_unused_arguments.cmi : \ + middle_end/flambda/flambda.cmi \ + middle_end/backend_intf.cmi +middle_end/flambda/remove_unused_closure_vars.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/parameter.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/flambda/remove_unused_closure_vars.cmi +middle_end/flambda/remove_unused_closure_vars.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/flambda/parameter.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/flambda/remove_unused_closure_vars.cmi +middle_end/flambda/remove_unused_closure_vars.cmi : \ + middle_end/flambda/flambda.cmi +middle_end/flambda/remove_unused_program_constructs.cmo : \ + middle_end/symbol.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/effect_analysis.cmi \ + middle_end/flambda/remove_unused_program_constructs.cmi +middle_end/flambda/remove_unused_program_constructs.cmx : \ + middle_end/symbol.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/effect_analysis.cmx \ + middle_end/flambda/remove_unused_program_constructs.cmi +middle_end/flambda/remove_unused_program_constructs.cmi : \ + middle_end/flambda/flambda.cmi +middle_end/flambda/share_constants.cmo : \ + middle_end/symbol.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/share_constants.cmi +middle_end/flambda/share_constants.cmx : \ + middle_end/symbol.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/share_constants.cmi +middle_end/flambda/share_constants.cmi : \ + middle_end/flambda/flambda.cmi +middle_end/flambda/simple_value_approx.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/base_types/set_of_closures_origin.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + middle_end/flambda/parameter.cmi \ + utils/misc.cmi \ + lambda/lambda.cmi \ + middle_end/internal_variable_names.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/freshening.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/base_types/export_id.cmi \ + middle_end/flambda/effect_analysis.cmi \ + lambda/debuginfo.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_origin.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/flambda/allocated_const.cmi \ + middle_end/flambda/simple_value_approx.cmi +middle_end/flambda/simple_value_approx.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/flambda/base_types/tag.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/base_types/set_of_closures_origin.cmx \ + middle_end/flambda/base_types/set_of_closures_id.cmx \ + middle_end/flambda/parameter.cmx \ + utils/misc.cmx \ + lambda/lambda.cmx \ + middle_end/internal_variable_names.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inlining_cost.cmx \ + middle_end/flambda/freshening.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/base_types/export_id.cmx \ + middle_end/flambda/effect_analysis.cmx \ + lambda/debuginfo.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/closure_origin.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/flambda/allocated_const.cmx \ + middle_end/flambda/simple_value_approx.cmi +middle_end/flambda/simple_value_approx.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/base_types/set_of_closures_origin.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + middle_end/flambda/parameter.cmi \ + lambda/lambda.cmi \ + middle_end/flambda/freshening.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/base_types/export_id.cmi \ + lambda/debuginfo.cmi \ + middle_end/flambda/base_types/closure_origin.cmi \ + middle_end/flambda/base_types/closure_id.cmi +middle_end/flambda/simplify_boxed_integer_ops.cmo : \ + middle_end/flambda/simplify_common.cmi \ + middle_end/flambda/simplify_boxed_integer_ops_intf.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + lambda/lambda.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/clambda_primitives.cmi \ + middle_end/flambda/simplify_boxed_integer_ops.cmi +middle_end/flambda/simplify_boxed_integer_ops.cmx : \ + middle_end/flambda/simplify_common.cmx \ + middle_end/flambda/simplify_boxed_integer_ops_intf.cmi \ + middle_end/flambda/simple_value_approx.cmx \ + lambda/lambda.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inlining_cost.cmx \ + middle_end/clambda_primitives.cmx \ + middle_end/flambda/simplify_boxed_integer_ops.cmi +middle_end/flambda/simplify_boxed_integer_ops.cmi : \ + middle_end/flambda/simplify_boxed_integer_ops_intf.cmi +middle_end/flambda/simplify_boxed_integer_ops_intf.cmi : \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/clambda_primitives.cmi +middle_end/flambda/simplify_common.cmo : \ + middle_end/flambda/simple_value_approx.cmi \ + lambda/lambda.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/effect_analysis.cmi \ + middle_end/flambda/simplify_common.cmi +middle_end/flambda/simplify_common.cmx : \ + middle_end/flambda/simple_value_approx.cmx \ + lambda/lambda.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inlining_cost.cmx \ + middle_end/flambda/effect_analysis.cmx \ + middle_end/flambda/simplify_common.cmi +middle_end/flambda/simplify_common.cmi : \ + middle_end/flambda/simple_value_approx.cmi \ + lambda/lambda.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/flambda.cmi +middle_end/flambda/simplify_primitives.cmo : \ + middle_end/flambda/base_types/tag.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/simplify_common.cmi \ + middle_end/flambda/simplify_boxed_integer_ops.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/semantics_of_primitives.cmi \ + utils/misc.cmi \ + lambda/lambda.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/flambda.cmi \ + utils/clflags.cmi \ + middle_end/clambda_primitives.cmi \ + parsing/asttypes.cmi \ + middle_end/flambda/simplify_primitives.cmi +middle_end/flambda/simplify_primitives.cmx : \ + middle_end/flambda/base_types/tag.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/simplify_common.cmx \ + middle_end/flambda/simplify_boxed_integer_ops.cmx \ + middle_end/flambda/simple_value_approx.cmx \ + middle_end/semantics_of_primitives.cmx \ + utils/misc.cmx \ + lambda/lambda.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inlining_cost.cmx \ + middle_end/flambda/flambda.cmx \ + utils/clflags.cmx \ + middle_end/clambda_primitives.cmx \ + parsing/asttypes.cmi \ + middle_end/flambda/simplify_primitives.cmi +middle_end/flambda/simplify_primitives.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/flambda.cmi \ + lambda/debuginfo.cmi \ + middle_end/clambda_primitives.cmi +middle_end/flambda/traverse_for_exported_symbols.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + utils/misc.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/export_info.cmi \ + middle_end/flambda/base_types/export_id.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/flambda/traverse_for_exported_symbols.cmi +middle_end/flambda/traverse_for_exported_symbols.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/symbol.cmx \ + middle_end/flambda/simple_value_approx.cmx \ + middle_end/flambda/base_types/set_of_closures_id.cmx \ + utils/misc.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/export_info.cmx \ + middle_end/flambda/base_types/export_id.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/flambda/traverse_for_exported_symbols.cmi +middle_end/flambda/traverse_for_exported_symbols.cmi : \ + middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/symbol.cmi \ + middle_end/flambda/simple_value_approx.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/export_info.cmi \ + middle_end/flambda/base_types/export_id.cmi \ + middle_end/flambda/base_types/closure_id.cmi +middle_end/flambda/un_anf.cmo : \ + middle_end/symbol.cmi \ + middle_end/semantics_of_primitives.cmi \ + middle_end/printclambda.cmi \ + utils/misc.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + utils/clflags.cmi \ + middle_end/clambda_primitives.cmi \ + middle_end/clambda.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi \ + middle_end/flambda/un_anf.cmi +middle_end/flambda/un_anf.cmx : \ + middle_end/symbol.cmx \ + middle_end/semantics_of_primitives.cmx \ + middle_end/printclambda.cmx \ + utils/misc.cmx \ + lambda/lambda.cmx \ + lambda/debuginfo.cmx \ + utils/clflags.cmx \ + middle_end/clambda_primitives.cmx \ + middle_end/clambda.cmx \ + middle_end/backend_var.cmx \ + parsing/asttypes.cmi \ + middle_end/flambda/un_anf.cmi +middle_end/flambda/un_anf.cmi : \ + middle_end/symbol.cmi \ + middle_end/clambda.cmi +middle_end/flambda/unbox_closures.cmo : \ + middle_end/variable.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + utils/clflags.cmi \ + middle_end/flambda/augment_specialised_args.cmi \ + middle_end/flambda/unbox_closures.cmi +middle_end/flambda/unbox_closures.cmx : \ + middle_end/variable.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inlining_cost.cmx \ + middle_end/flambda/inline_and_simplify_aux.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + utils/clflags.cmx \ + middle_end/flambda/augment_specialised_args.cmx \ + middle_end/flambda/unbox_closures.cmi +middle_end/flambda/unbox_closures.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/flambda.cmi +middle_end/flambda/unbox_free_vars_of_closures.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/projection.cmi \ + middle_end/flambda/pass_wrapper.cmi \ + utils/misc.cmi \ + middle_end/internal_variable_names.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/flambda_utils.cmi \ + middle_end/flambda/flambda_iterators.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/extract_projections.cmi \ + utils/clflags.cmi \ + middle_end/flambda/unbox_free_vars_of_closures.cmi +middle_end/flambda/unbox_free_vars_of_closures.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/projection.cmx \ + middle_end/flambda/pass_wrapper.cmx \ + utils/misc.cmx \ + middle_end/internal_variable_names.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inlining_cost.cmx \ + middle_end/flambda/inline_and_simplify_aux.cmx \ + middle_end/flambda/flambda_utils.cmx \ + middle_end/flambda/flambda_iterators.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/extract_projections.cmx \ + utils/clflags.cmx \ + middle_end/flambda/unbox_free_vars_of_closures.cmi +middle_end/flambda/unbox_free_vars_of_closures.cmi : \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/flambda.cmi +middle_end/flambda/unbox_specialised_args.cmo : \ + middle_end/variable.cmi \ + middle_end/flambda/projection.cmi \ + middle_end/flambda/invariant_params.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/flambda.cmi \ + middle_end/flambda/extract_projections.cmi \ + utils/clflags.cmi \ + middle_end/flambda/augment_specialised_args.cmi \ + middle_end/flambda/unbox_specialised_args.cmi +middle_end/flambda/unbox_specialised_args.cmx : \ + middle_end/variable.cmx \ + middle_end/flambda/projection.cmx \ + middle_end/flambda/invariant_params.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/inline_and_simplify_aux.cmx \ + middle_end/flambda/flambda.cmx \ + middle_end/flambda/extract_projections.cmx \ + utils/clflags.cmx \ + middle_end/flambda/augment_specialised_args.cmx \ + middle_end/flambda/unbox_specialised_args.cmi +middle_end/flambda/unbox_specialised_args.cmi : \ + middle_end/variable.cmi \ + middle_end/flambda/inlining_cost.cmi \ + middle_end/flambda/inline_and_simplify_aux.cmi \ + middle_end/flambda/flambda.cmi +middle_end/flambda/base_types/closure_element.cmo : \ + middle_end/variable.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/base_types/closure_element.cmi +middle_end/flambda/base_types/closure_element.cmx : \ + middle_end/variable.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/base_types/closure_element.cmi +middle_end/flambda/base_types/closure_element.cmi : \ + middle_end/variable.cmi \ + utils/identifiable.cmi \ + middle_end/compilation_unit.cmi +middle_end/flambda/base_types/closure_id.cmo : \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/base_types/closure_element.cmi \ + middle_end/flambda/base_types/closure_id.cmi +middle_end/flambda/base_types/closure_id.cmx : \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/base_types/closure_element.cmx \ + middle_end/flambda/base_types/closure_id.cmi +middle_end/flambda/base_types/closure_id.cmi : \ + middle_end/flambda/base_types/closure_element.cmi +middle_end/flambda/base_types/closure_origin.cmo : \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/flambda/base_types/closure_origin.cmi +middle_end/flambda/base_types/closure_origin.cmx : \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/flambda/base_types/closure_origin.cmi +middle_end/flambda/base_types/closure_origin.cmi : \ + utils/identifiable.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_id.cmi +middle_end/flambda/base_types/export_id.cmo : \ + utils/int_replace_polymorphic_compare.cmi \ + utils/identifiable.cmi \ + middle_end/flambda/base_types/id_types.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/export_id.cmi +middle_end/flambda/base_types/export_id.cmx : \ + utils/int_replace_polymorphic_compare.cmx \ + utils/identifiable.cmx \ + middle_end/flambda/base_types/id_types.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/export_id.cmi +middle_end/flambda/base_types/export_id.cmi : \ + utils/identifiable.cmi \ + middle_end/compilation_unit.cmi +middle_end/flambda/base_types/id_types.cmo : \ + utils/int_replace_polymorphic_compare.cmi \ + utils/identifiable.cmi \ + middle_end/flambda/base_types/id_types.cmi +middle_end/flambda/base_types/id_types.cmx : \ + utils/int_replace_polymorphic_compare.cmx \ + utils/identifiable.cmx \ + middle_end/flambda/base_types/id_types.cmi +middle_end/flambda/base_types/id_types.cmi : \ + utils/identifiable.cmi +middle_end/flambda/base_types/mutable_variable.cmo : \ + middle_end/variable.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi +middle_end/flambda/base_types/mutable_variable.cmx : \ + middle_end/variable.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/base_types/mutable_variable.cmi +middle_end/flambda/base_types/mutable_variable.cmi : \ + middle_end/variable.cmi \ + middle_end/internal_variable_names.cmi \ + utils/identifiable.cmi \ + typing/ident.cmi \ + middle_end/compilation_unit.cmi +middle_end/flambda/base_types/set_of_closures_id.cmo : \ + utils/int_replace_polymorphic_compare.cmi \ + utils/identifiable.cmi \ + middle_end/flambda/base_types/id_types.cmi \ + middle_end/compilation_unit.cmi \ + middle_end/flambda/base_types/set_of_closures_id.cmi +middle_end/flambda/base_types/set_of_closures_id.cmx : \ + utils/int_replace_polymorphic_compare.cmx \ + utils/identifiable.cmx \ + middle_end/flambda/base_types/id_types.cmx \ + middle_end/compilation_unit.cmx \ + middle_end/flambda/base_types/set_of_closures_id.cmi +middle_end/flambda/base_types/set_of_closures_id.cmi : \ + utils/identifiable.cmi \ + middle_end/compilation_unit.cmi +middle_end/flambda/base_types/set_of_closures_origin.cmo : \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/base_types/set_of_closures_origin.cmi +middle_end/flambda/base_types/set_of_closures_origin.cmx : \ + middle_end/flambda/base_types/set_of_closures_id.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/base_types/set_of_closures_origin.cmi +middle_end/flambda/base_types/set_of_closures_origin.cmi : \ + middle_end/flambda/base_types/set_of_closures_id.cmi \ + utils/identifiable.cmi \ + middle_end/compilation_unit.cmi +middle_end/flambda/base_types/static_exception.cmo : \ + utils/numbers.cmi \ + lambda/lambda.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/base_types/static_exception.cmi +middle_end/flambda/base_types/static_exception.cmx : \ + utils/numbers.cmx \ + lambda/lambda.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/base_types/static_exception.cmi +middle_end/flambda/base_types/static_exception.cmi : \ + utils/identifiable.cmi +middle_end/flambda/base_types/tag.cmo : \ + utils/numbers.cmi \ + utils/misc.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + utils/identifiable.cmi \ + middle_end/flambda/base_types/tag.cmi +middle_end/flambda/base_types/tag.cmx : \ + utils/numbers.cmx \ + utils/misc.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + utils/identifiable.cmx \ + middle_end/flambda/base_types/tag.cmi +middle_end/flambda/base_types/tag.cmi : \ + utils/identifiable.cmi +middle_end/flambda/base_types/var_within_closure.cmo : \ + utils/int_replace_polymorphic_compare.cmi \ + middle_end/flambda/base_types/closure_element.cmi \ + middle_end/flambda/base_types/var_within_closure.cmi +middle_end/flambda/base_types/var_within_closure.cmx : \ + utils/int_replace_polymorphic_compare.cmx \ + middle_end/flambda/base_types/closure_element.cmx \ + middle_end/flambda/base_types/var_within_closure.cmi +middle_end/flambda/base_types/var_within_closure.cmi : \ + middle_end/flambda/base_types/closure_element.cmi +asmcomp/debug/available_regs.cmo : \ + asmcomp/debug/reg_with_debug_info.cmi \ + asmcomp/debug/reg_availability_set.cmi \ + asmcomp/reg.cmi \ + asmcomp/proc.cmi \ + asmcomp/printmach.cmi \ + utils/misc.cmi \ + asmcomp/mach.cmi \ + utils/clflags.cmi \ + middle_end/backend_var.cmi \ + asmcomp/debug/available_regs.cmi +asmcomp/debug/available_regs.cmx : \ + asmcomp/debug/reg_with_debug_info.cmx \ + asmcomp/debug/reg_availability_set.cmx \ + asmcomp/reg.cmx \ + asmcomp/proc.cmx \ + asmcomp/printmach.cmx \ + utils/misc.cmx \ + asmcomp/mach.cmx \ + utils/clflags.cmx \ + middle_end/backend_var.cmx \ + asmcomp/debug/available_regs.cmi +asmcomp/debug/available_regs.cmi : \ + asmcomp/mach.cmi +asmcomp/debug/compute_ranges.cmo : \ + asmcomp/printlinear.cmi \ + utils/numbers.cmi \ + utils/misc.cmi \ + asmcomp/linear.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + asmcomp/debug/compute_ranges_intf.cmo \ + asmcomp/cmm.cmi \ + asmcomp/debug/compute_ranges.cmi +asmcomp/debug/compute_ranges.cmx : \ + asmcomp/printlinear.cmx \ + utils/numbers.cmx \ + utils/misc.cmx \ + asmcomp/linear.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + asmcomp/debug/compute_ranges_intf.cmx \ + asmcomp/cmm.cmx \ + asmcomp/debug/compute_ranges.cmi +asmcomp/debug/compute_ranges.cmi : \ + asmcomp/debug/compute_ranges_intf.cmo +asmcomp/debug/compute_ranges_intf.cmo : \ + utils/numbers.cmi \ + asmcomp/linear.cmi \ + utils/identifiable.cmi +asmcomp/debug/compute_ranges_intf.cmx : \ + utils/numbers.cmx \ + asmcomp/linear.cmx \ + utils/identifiable.cmx +asmcomp/debug/reg_availability_set.cmo : \ + asmcomp/debug/reg_with_debug_info.cmi \ + middle_end/backend_var.cmi \ + asmcomp/debug/reg_availability_set.cmi +asmcomp/debug/reg_availability_set.cmx : \ + asmcomp/debug/reg_with_debug_info.cmx \ + middle_end/backend_var.cmx \ + asmcomp/debug/reg_availability_set.cmi +asmcomp/debug/reg_availability_set.cmi : \ + asmcomp/debug/reg_with_debug_info.cmi \ + asmcomp/reg.cmi +asmcomp/debug/reg_with_debug_info.cmo : \ + asmcomp/reg.cmi \ + middle_end/backend_var.cmi \ + asmcomp/debug/reg_with_debug_info.cmi +asmcomp/debug/reg_with_debug_info.cmx : \ + asmcomp/reg.cmx \ + middle_end/backend_var.cmx \ + asmcomp/debug/reg_with_debug_info.cmi +asmcomp/debug/reg_with_debug_info.cmi : \ + asmcomp/reg.cmi \ + middle_end/backend_var.cmi +driver/compenv.cmo : \ + utils/warnings.cmi \ + utils/profile.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + utils/config.cmi \ + utils/clflags.cmi \ + utils/ccomp.cmi \ + driver/compenv.cmi +driver/compenv.cmx : \ + utils/warnings.cmx \ + utils/profile.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + utils/config.cmx \ + utils/clflags.cmx \ + utils/ccomp.cmx \ + driver/compenv.cmi +driver/compenv.cmi : +driver/compile.cmo : \ + lambda/translmod.cmi \ + lambda/simplif.cmi \ + utils/profile.cmi \ + lambda/printlambda.cmi \ + bytecomp/printinstr.cmi \ + utils/misc.cmi \ + lambda/lambda.cmi \ + bytecomp/emitcode.cmi \ + driver/compile_common.cmi \ + utils/clflags.cmi \ + bytecomp/bytegen.cmi \ + driver/compile.cmi +driver/compile.cmx : \ + lambda/translmod.cmx \ + lambda/simplif.cmx \ + utils/profile.cmx \ + lambda/printlambda.cmx \ + bytecomp/printinstr.cmx \ + utils/misc.cmx \ + lambda/lambda.cmx \ + bytecomp/emitcode.cmx \ + driver/compile_common.cmx \ + utils/clflags.cmx \ + bytecomp/bytegen.cmx \ + driver/compile.cmi +driver/compile.cmi : \ + typing/typedtree.cmi \ + bytecomp/instruct.cmi \ + typing/ident.cmi \ + driver/compile_common.cmi +driver/compile_common.cmo : \ + utils/warnings.cmi \ + typing/typemod.cmi \ + typing/typedtree.cmi \ + typing/typecore.cmi \ + utils/profile.cmi \ + typing/printtyped.cmi \ + typing/printtyp.cmi \ + parsing/printast.cmi \ + parsing/pprintast.cmi \ + driver/pparse.cmi \ + utils/misc.cmi \ + typing/includemod.cmi \ + typing/env.cmi \ + utils/config.cmi \ + driver/compmisc.cmi \ + driver/compenv.cmi \ + utils/clflags.cmi \ + parsing/builtin_attributes.cmi \ + driver/compile_common.cmi +driver/compile_common.cmx : \ + utils/warnings.cmx \ + typing/typemod.cmx \ + typing/typedtree.cmx \ + typing/typecore.cmx \ + utils/profile.cmx \ + typing/printtyped.cmx \ + typing/printtyp.cmx \ + parsing/printast.cmx \ + parsing/pprintast.cmx \ + driver/pparse.cmx \ + utils/misc.cmx \ + typing/includemod.cmx \ + typing/env.cmx \ + utils/config.cmx \ + driver/compmisc.cmx \ + driver/compenv.cmx \ + utils/clflags.cmx \ + parsing/builtin_attributes.cmx \ + driver/compile_common.cmi +driver/compile_common.cmi : \ + typing/typedtree.cmi \ + parsing/parsetree.cmi \ + typing/env.cmi +driver/compmisc.cmo : \ + utils/warnings.cmi \ + typing/types.cmi \ + typing/typemod.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + utils/config.cmi \ + driver/compenv.cmi \ + utils/clflags.cmi \ + driver/compmisc.cmi +driver/compmisc.cmx : \ + utils/warnings.cmx \ + typing/types.cmx \ + typing/typemod.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + utils/load_path.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + utils/config.cmx \ + driver/compenv.cmx \ + utils/clflags.cmx \ + driver/compmisc.cmi +driver/compmisc.cmi : \ + typing/env.cmi \ + utils/clflags.cmi +driver/errors.cmo : \ + parsing/location.cmi \ + driver/errors.cmi +driver/errors.cmx : \ + parsing/location.cmx \ + driver/errors.cmi +driver/errors.cmi : +driver/main.cmo : \ + utils/warnings.cmi \ + utils/profile.cmi \ + driver/makedepend.cmi \ + driver/main_args.cmi \ + parsing/location.cmi \ + utils/config.cmi \ + driver/compmisc.cmi \ + driver/compile.cmi \ + driver/compenv.cmi \ + utils/clflags.cmi \ + bytecomp/bytepackager.cmi \ + bytecomp/bytelink.cmi \ + bytecomp/bytelibrarian.cmi \ + driver/main.cmi +driver/main.cmx : \ + utils/warnings.cmx \ + utils/profile.cmx \ + driver/makedepend.cmx \ + driver/main_args.cmx \ + parsing/location.cmx \ + utils/config.cmx \ + driver/compmisc.cmx \ + driver/compile.cmx \ + driver/compenv.cmx \ + utils/clflags.cmx \ + bytecomp/bytepackager.cmx \ + bytecomp/bytelink.cmx \ + bytecomp/bytelibrarian.cmx \ + driver/main.cmi +driver/main.cmi : +driver/main_args.cmo : \ + utils/warnings.cmi \ + utils/profile.cmi \ + utils/misc.cmi \ + utils/config.cmi \ + driver/compenv.cmi \ + utils/clflags.cmi \ + driver/main_args.cmi +driver/main_args.cmx : \ + utils/warnings.cmx \ + utils/profile.cmx \ + utils/misc.cmx \ + utils/config.cmx \ + driver/compenv.cmx \ + utils/clflags.cmx \ + driver/main_args.cmi +driver/main_args.cmi : +driver/makedepend.cmo : \ + driver/pparse.cmi \ + parsing/parsetree.cmi \ + parsing/parser.cmi \ + parsing/parse.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + parsing/lexer.cmi \ + parsing/depend.cmi \ + utils/config.cmi \ + driver/compenv.cmi \ + utils/clflags.cmi \ + driver/makedepend.cmi +driver/makedepend.cmx : \ + driver/pparse.cmx \ + parsing/parsetree.cmi \ + parsing/parser.cmx \ + parsing/parse.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + parsing/lexer.cmx \ + parsing/depend.cmx \ + utils/config.cmx \ + driver/compenv.cmx \ + utils/clflags.cmx \ + driver/makedepend.cmi +driver/makedepend.cmi : +driver/optcompile.cmo : \ + lambda/translmod.cmi \ + lambda/simplif.cmi \ + utils/profile.cmi \ + lambda/printlambda.cmi \ + utils/misc.cmi \ + lambda/lambda.cmi \ + middle_end/flambda/flambda_middle_end.cmi \ + utils/config.cmi \ + middle_end/compilenv.cmi \ + driver/compile_common.cmi \ + middle_end/closure/closure_middle_end.cmi \ + utils/clflags.cmi \ + asmcomp/asmgen.cmi \ + driver/optcompile.cmi +driver/optcompile.cmx : \ + lambda/translmod.cmx \ + lambda/simplif.cmx \ + utils/profile.cmx \ + lambda/printlambda.cmx \ + utils/misc.cmx \ + lambda/lambda.cmx \ + middle_end/flambda/flambda_middle_end.cmx \ + utils/config.cmx \ + middle_end/compilenv.cmx \ + driver/compile_common.cmx \ + middle_end/closure/closure_middle_end.cmx \ + utils/clflags.cmx \ + asmcomp/asmgen.cmx \ + driver/optcompile.cmi +driver/optcompile.cmi : \ + typing/typedtree.cmi \ + driver/compile_common.cmi \ + middle_end/backend_intf.cmi +driver/opterrors.cmo : \ + parsing/location.cmi \ + driver/opterrors.cmi +driver/opterrors.cmx : \ + parsing/location.cmx \ + driver/opterrors.cmi +driver/opterrors.cmi : +driver/optmain.cmo : \ + utils/warnings.cmi \ + utils/profile.cmi \ + asmcomp/proc.cmi \ + driver/optcompile.cmi \ + driver/makedepend.cmi \ + driver/main_args.cmi \ + parsing/location.cmi \ + middle_end/flambda/import_approx.cmi \ + utils/config.cmi \ + driver/compmisc.cmi \ + middle_end/compilenv.cmi \ + driver/compenv.cmi \ + utils/clflags.cmi \ + middle_end/backend_intf.cmi \ + asmcomp/asmpackager.cmi \ + asmcomp/asmlink.cmi \ + asmcomp/asmlibrarian.cmi \ + asmcomp/arch.cmo \ + driver/optmain.cmi +driver/optmain.cmx : \ + utils/warnings.cmx \ + utils/profile.cmx \ + asmcomp/proc.cmx \ + driver/optcompile.cmx \ + driver/makedepend.cmx \ + driver/main_args.cmx \ + parsing/location.cmx \ + middle_end/flambda/import_approx.cmx \ + utils/config.cmx \ + driver/compmisc.cmx \ + middle_end/compilenv.cmx \ + driver/compenv.cmx \ + utils/clflags.cmx \ + middle_end/backend_intf.cmi \ + asmcomp/asmpackager.cmx \ + asmcomp/asmlink.cmx \ + asmcomp/asmlibrarian.cmx \ + asmcomp/arch.cmx \ + driver/optmain.cmi +driver/optmain.cmi : +driver/pparse.cmo : \ + utils/warnings.cmi \ + utils/profile.cmi \ + parsing/parsetree.cmi \ + parsing/parse.cmi \ + utils/misc.cmi \ + parsing/location.cmi \ + utils/config.cmi \ + utils/clflags.cmi \ + utils/ccomp.cmi \ + parsing/ast_mapper.cmi \ + parsing/ast_invariants.cmi \ + driver/pparse.cmi +driver/pparse.cmx : \ + utils/warnings.cmx \ + utils/profile.cmx \ + parsing/parsetree.cmi \ + parsing/parse.cmx \ + utils/misc.cmx \ + parsing/location.cmx \ + utils/config.cmx \ + utils/clflags.cmx \ + utils/ccomp.cmx \ + parsing/ast_mapper.cmx \ + parsing/ast_invariants.cmx \ + driver/pparse.cmi +driver/pparse.cmi : \ + parsing/parsetree.cmi +toplevel/expunge.cmo : \ + bytecomp/symtable.cmi \ + lambda/runtimedef.cmi \ + utils/misc.cmi \ + typing/ident.cmi \ + bytecomp/bytesections.cmi +toplevel/expunge.cmx : \ + bytecomp/symtable.cmx \ + lambda/runtimedef.cmx \ + utils/misc.cmx \ + typing/ident.cmx \ + bytecomp/bytesections.cmx +toplevel/genprintval.cmo : \ + typing/types.cmi \ + parsing/syntaxerr.cmi \ + typing/printtyp.cmi \ + typing/predef.cmi \ + typing/path.cmi \ + parsing/parse.cmi \ + typing/outcometree.cmi \ + typing/oprint.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/lexer.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/datarepr.cmi \ + typing/ctype.cmi \ + typing/btype.cmi \ + toplevel/genprintval.cmi +toplevel/genprintval.cmx : \ + typing/types.cmx \ + parsing/syntaxerr.cmx \ + typing/printtyp.cmx \ + typing/predef.cmx \ + typing/path.cmx \ + parsing/parse.cmx \ + typing/outcometree.cmi \ + typing/oprint.cmx \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/lexer.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + typing/datarepr.cmx \ + typing/ctype.cmx \ + typing/btype.cmx \ + toplevel/genprintval.cmi +toplevel/genprintval.cmi : \ + typing/types.cmi \ + typing/path.cmi \ + typing/outcometree.cmi \ + typing/env.cmi +toplevel/opttopdirs.cmo : \ + utils/warnings.cmi \ + typing/types.cmi \ + typing/printtyp.cmi \ + toplevel/opttoploop.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + utils/load_path.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + typing/ctype.cmi \ + utils/config.cmi \ + utils/clflags.cmi \ + asmcomp/asmlink.cmi \ + toplevel/opttopdirs.cmi +toplevel/opttopdirs.cmx : \ + utils/warnings.cmx \ + typing/types.cmx \ + typing/printtyp.cmx \ + toplevel/opttoploop.cmx \ + utils/misc.cmx \ + parsing/longident.cmx \ + utils/load_path.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + typing/ctype.cmx \ + utils/config.cmx \ + utils/clflags.cmx \ + asmcomp/asmlink.cmx \ + toplevel/opttopdirs.cmi +toplevel/opttopdirs.cmi : \ + parsing/longident.cmi +toplevel/opttoploop.cmo : \ + utils/warnings.cmi \ + typing/types.cmi \ + typing/typemod.cmi \ + typing/typedtree.cmi \ + typing/typecore.cmi \ + lambda/translmod.cmi \ + lambda/simplif.cmi \ + asmcomp/proc.cmi \ + typing/printtyped.cmi \ + typing/printtyp.cmi \ + lambda/printlambda.cmi \ + parsing/printast.cmi \ + typing/predef.cmi \ + parsing/pprintast.cmi \ + driver/pparse.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + parsing/parse.cmi \ + typing/outcometree.cmi \ + typing/oprint.cmi \ + utils/misc.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + parsing/lexer.cmi \ + lambda/lambda.cmi \ + typing/includemod.cmi \ + middle_end/flambda/import_approx.cmi \ + typing/ident.cmi \ + toplevel/genprintval.cmi \ + middle_end/flambda/flambda_middle_end.cmi \ + typing/env.cmi \ + utils/config.cmi \ + driver/compmisc.cmi \ + middle_end/compilenv.cmi \ + driver/compenv.cmi \ + middle_end/closure/closure_middle_end.cmi \ + utils/clflags.cmi \ + typing/btype.cmi \ + middle_end/backend_intf.cmi \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmi \ + asmcomp/asmlink.cmi \ + asmcomp/asmgen.cmi \ + asmcomp/arch.cmo \ + toplevel/opttoploop.cmi +toplevel/opttoploop.cmx : \ + utils/warnings.cmx \ + typing/types.cmx \ + typing/typemod.cmx \ + typing/typedtree.cmx \ + typing/typecore.cmx \ + lambda/translmod.cmx \ + lambda/simplif.cmx \ + asmcomp/proc.cmx \ + typing/printtyped.cmx \ + typing/printtyp.cmx \ + lambda/printlambda.cmx \ + parsing/printast.cmx \ + typing/predef.cmx \ + parsing/pprintast.cmx \ + driver/pparse.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + parsing/parse.cmx \ + typing/outcometree.cmi \ + typing/oprint.cmx \ + utils/misc.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + utils/load_path.cmx \ + parsing/lexer.cmx \ + lambda/lambda.cmx \ + typing/includemod.cmx \ + middle_end/flambda/import_approx.cmx \ + typing/ident.cmx \ + toplevel/genprintval.cmx \ + middle_end/flambda/flambda_middle_end.cmx \ + typing/env.cmx \ + utils/config.cmx \ + driver/compmisc.cmx \ + middle_end/compilenv.cmx \ + driver/compenv.cmx \ + middle_end/closure/closure_middle_end.cmx \ + utils/clflags.cmx \ + typing/btype.cmx \ + middle_end/backend_intf.cmi \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmx \ + asmcomp/asmlink.cmx \ + asmcomp/asmgen.cmx \ + asmcomp/arch.cmx \ + toplevel/opttoploop.cmi +toplevel/opttoploop.cmi : \ + utils/warnings.cmi \ + typing/types.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + typing/outcometree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/env.cmi +toplevel/opttopmain.cmo : \ + toplevel/opttoploop.cmi \ + toplevel/opttopdirs.cmi \ + utils/misc.cmi \ + driver/main_args.cmi \ + parsing/location.cmi \ + driver/compmisc.cmi \ + utils/clflags.cmi \ + toplevel/opttopmain.cmi +toplevel/opttopmain.cmx : \ + toplevel/opttoploop.cmx \ + toplevel/opttopdirs.cmx \ + utils/misc.cmx \ + driver/main_args.cmx \ + parsing/location.cmx \ + driver/compmisc.cmx \ + utils/clflags.cmx \ + toplevel/opttopmain.cmi +toplevel/opttopmain.cmi : +toplevel/opttopstart.cmo : \ + toplevel/opttopmain.cmi +toplevel/opttopstart.cmx : \ + toplevel/opttopmain.cmx +toplevel/topdirs.cmo : \ + utils/warnings.cmi \ + typing/types.cmi \ + toplevel/trace.cmi \ + toplevel/toploop.cmi \ + bytecomp/symtable.cmi \ + typing/printtyp.cmi \ + typing/predef.cmi \ + typing/persistent_env.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + bytecomp/opcodes.cmi \ + utils/misc.cmi \ + bytecomp/meta.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + typing/ident.cmi \ + typing/env.cmi \ + bytecomp/dll.cmi \ + typing/ctype.cmi \ + utils/config.cmi \ + file_formats/cmo_format.cmi \ + utils/clflags.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmi \ + toplevel/topdirs.cmi +toplevel/topdirs.cmx : \ + utils/warnings.cmx \ + typing/types.cmx \ + toplevel/trace.cmx \ + toplevel/toploop.cmx \ + bytecomp/symtable.cmx \ + typing/printtyp.cmx \ + typing/predef.cmx \ + typing/persistent_env.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + bytecomp/opcodes.cmx \ + utils/misc.cmx \ + bytecomp/meta.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + utils/load_path.cmx \ + typing/ident.cmx \ + typing/env.cmx \ + bytecomp/dll.cmx \ + typing/ctype.cmx \ + utils/config.cmx \ + file_formats/cmo_format.cmi \ + utils/clflags.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmx \ + toplevel/topdirs.cmi +toplevel/topdirs.cmi : \ + parsing/longident.cmi +toplevel/toploop.cmo : \ + utils/warnings.cmi \ + typing/typetexp.cmi \ + typing/types.cmi \ + typing/typemod.cmi \ + typing/typedtree.cmi \ + typing/typecore.cmi \ + lambda/translmod.cmi \ + bytecomp/symtable.cmi \ + lambda/simplif.cmi \ + typing/printtyped.cmi \ + typing/printtyp.cmi \ + lambda/printlambda.cmi \ + bytecomp/printinstr.cmi \ + parsing/printast.cmi \ + typing/predef.cmi \ + parsing/pprintast.cmi \ + driver/pparse.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + parsing/parse.cmi \ + typing/outcometree.cmi \ + typing/oprint.cmi \ + utils/misc.cmi \ + bytecomp/meta.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + utils/load_path.cmi \ + parsing/lexer.cmi \ + typing/includemod.cmi \ + typing/ident.cmi \ + toplevel/genprintval.cmi \ + typing/env.cmi \ + bytecomp/emitcode.cmi \ + bytecomp/dll.cmi \ + utils/config.cmi \ + driver/compmisc.cmi \ + driver/compenv.cmi \ + utils/clflags.cmi \ + bytecomp/bytegen.cmi \ + typing/btype.cmi \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmi \ + toplevel/toploop.cmi +toplevel/toploop.cmx : \ + utils/warnings.cmx \ + typing/typetexp.cmx \ + typing/types.cmx \ + typing/typemod.cmx \ + typing/typedtree.cmx \ + typing/typecore.cmx \ + lambda/translmod.cmx \ + bytecomp/symtable.cmx \ + lambda/simplif.cmx \ + typing/printtyped.cmx \ + typing/printtyp.cmx \ + lambda/printlambda.cmx \ + bytecomp/printinstr.cmx \ + parsing/printast.cmx \ + typing/predef.cmx \ + parsing/pprintast.cmx \ + driver/pparse.cmx \ + typing/path.cmx \ + parsing/parsetree.cmi \ + parsing/parse.cmx \ + typing/outcometree.cmi \ + typing/oprint.cmx \ + utils/misc.cmx \ + bytecomp/meta.cmx \ + parsing/longident.cmx \ + parsing/location.cmx \ + utils/load_path.cmx \ + parsing/lexer.cmx \ + typing/includemod.cmx \ + typing/ident.cmx \ + toplevel/genprintval.cmx \ + typing/env.cmx \ + bytecomp/emitcode.cmx \ + bytecomp/dll.cmx \ + utils/config.cmx \ + driver/compmisc.cmx \ + driver/compenv.cmx \ + utils/clflags.cmx \ + bytecomp/bytegen.cmx \ + typing/btype.cmx \ + parsing/asttypes.cmi \ + parsing/ast_helper.cmx \ + toplevel/toploop.cmi +toplevel/toploop.cmi : \ + utils/warnings.cmi \ + typing/types.cmi \ + typing/path.cmi \ + parsing/parsetree.cmi \ + typing/outcometree.cmi \ + parsing/longident.cmi \ + parsing/location.cmi \ + typing/env.cmi +toplevel/topmain.cmo : \ + toplevel/toploop.cmi \ + toplevel/topdirs.cmi \ + utils/misc.cmi \ + driver/main_args.cmi \ + parsing/location.cmi \ + driver/compmisc.cmi \ + driver/compenv.cmi \ + utils/clflags.cmi \ + toplevel/topmain.cmi +toplevel/topmain.cmx : \ + toplevel/toploop.cmx \ + toplevel/topdirs.cmx \ + utils/misc.cmx \ + driver/main_args.cmx \ + parsing/location.cmx \ + driver/compmisc.cmx \ + driver/compenv.cmx \ + utils/clflags.cmx \ + toplevel/topmain.cmi +toplevel/topmain.cmi : +toplevel/topstart.cmo : \ + toplevel/topmain.cmi +toplevel/topstart.cmx : \ + toplevel/topmain.cmx +toplevel/trace.cmo : \ + typing/types.cmi \ + toplevel/toploop.cmi \ + typing/printtyp.cmi \ + typing/predef.cmi \ + typing/path.cmi \ + utils/misc.cmi \ + bytecomp/meta.cmi \ + parsing/longident.cmi \ + typing/ctype.cmi \ + parsing/asttypes.cmi \ + toplevel/trace.cmi +toplevel/trace.cmx : \ + typing/types.cmx \ + toplevel/toploop.cmx \ + typing/printtyp.cmx \ + typing/predef.cmx \ + typing/path.cmx \ + utils/misc.cmx \ + bytecomp/meta.cmx \ + parsing/longident.cmx \ + typing/ctype.cmx \ + parsing/asttypes.cmi \ + toplevel/trace.cmi +toplevel/trace.cmi : \ + typing/types.cmi \ + typing/path.cmi \ + parsing/longident.cmi \ + typing/env.cmi diff --git a/.depend.menhir b/.depend.menhir new file mode 100644 index 00000000..3b9e6e09 --- /dev/null +++ b/.depend.menhir @@ -0,0 +1,11 @@ +parsing/parser.cmo : parsing/syntaxerr.cmi parsing/parsetree.cmi \ + parsing/longident.cmi parsing/location.cmi parsing/docstrings.cmi \ + utils/clflags.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \ + parsing/parser.cmi +parsing/parser.cmx : parsing/syntaxerr.cmx parsing/parsetree.cmi \ + parsing/longident.cmx parsing/location.cmx parsing/docstrings.cmx \ + utils/clflags.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \ + parsing/parser.cmi +parsing/parser.cmi : parsing/parsetree.cmi parsing/location.cmi \ + parsing/docstrings.cmi +parsing/parser.ml parsing/parser.mli: parsing/ast_helper.cmi parsing/asttypes.cmi utils/clflags.cmi parsing/docstrings.cmi parsing/location.cmi parsing/longident.cmi parsing/parsetree.cmi parsing/syntaxerr.cmi diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 00000000..200eb49c --- /dev/null +++ b/.gitattributes @@ -0,0 +1,253 @@ +#************************************************************************** +#* * +#* OCaml * +#* * +#* Damien Doligez, projet Gallium, INRIA * +#* * +#* 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. * +#* * +#************************************************************************** + +# Default behaviour, for if core.autocrlf isn't set +* text=auto + +# It is not possible to wrap lines lines in .gitattributes files +.gitattributes typo.long-line=may + +# Binary files +/boot/ocamlc binary +/boot/ocamllex binary +/boot/ocamldep binary +*.gif binary +*.png binary +*.tfm binary + +/boot/menhir/parser.ml* -diff + +# configure is declared as binary so that it doesn't get included in diffs. +# This also means it will have the correct Unix line-endings, even on Windows. +/configure binary + +# 'union' merge driver just unions textual content in case of conflict +# http://krlmlr.github.io/using-gitattributes-to-avoid-merge-conflicts/ +/.mailmap merge=union + +# We tried using 'union' for Changes and it did not work: +# instead of creating Changes conflict it would silently duplicate +# the lines involved in the conflict, which is arguably worse +#/Changes merge=union + +# No header for text files (would be too obtrusive). +*.md typo.missing-header +README* typo.missing-header +*.adoc typo.missing-header +stdlib/*.mld typo.missing-header +tools/mantis2gh_stripped.csv typo.missing-header + +*.adoc typo.long-line=may + +/.mailmap typo.long-line typo.missing-header typo.non-ascii +/.merlin typo.missing-header +/Changes typo.utf8 typo.missing-header +/News typo.utf8 typo.missing-header +/INSTALL typo.missing-header +/LICENSE typo.very-long-line typo.missing-header +# tools/ci/appveyor/appveyor_build.cmd only has missing-header because +# dra27 too lazy to update check-typo to interpret Cmd-style comments! +/tools/ci/appveyor/appveyor_build.cmd typo.very-long-line typo.missing-header typo.non-ascii +/tools/ci/appveyor/appveyor_build.sh typo.non-ascii +/tools/ci/inria/remove-sinh-primitive.patch typo.white-at-eol typo.missing-header typo.long-line +/tools/release-checklist typo.missing-header typo.very-long-line + +# ignore auto-generated .depend files +.depend typo.prune +/.depend.menhir typo.prune + +# Makefiles may contain tabs +Makefile* typo.tab=may + +asmcomp/*/emit.mlp typo.tab=may typo.long-line=may + +# The build-aux directory contains bundled files so do not check it +build-aux typo.prune + +/manual typo.prune +/manual/** typo.prune + +# configure is generated so do not check it +configure typo.prune + +ocaml-variants.opam typo.prune + +emacs/*.el typo.long-line=may +emacs/caml.el typo.long-line=may typo.missing-header +emacs/COPYING typo.prune +emacs/ocamltags.in typo.non-printing + +ocamldoc/** typo.long-line=may +ocamldoc/Changes.txt typo.missing-header +ocamldoc/ocamldoc.sty typo.missing-header +ocamldoc/odoc_index.html typo.missing-header + +otherlibs/win32unix/readlink.c typo.long-line +otherlibs/win32unix/stat.c typo.long-line +otherlibs/win32unix/symlink.c typo.long-line + +stdlib/hashbang typo.white-at-eol typo.missing-lf + +testsuite/tests/** typo.missing-header typo.long-line=may +testsuite/tests/lib-bigarray-2/bigarrf.f typo.tab +testsuite/tests/lib-unix/win-stat/fakeclock.c typo.missing-header=false +testsuite/tests/misc-unsafe/almabench.ml typo.long-line +testsuite/tests/tool-toplevel/strings.ml typo.utf8 +testsuite/tests/win-unicode/*.ml typo.utf8 +testsuite/tools/*.S typo.missing-header +testsuite/tools/*.asm typo.missing-header +testsuite/typing typo.missing-header + +# prune testsuite reference files +testsuite/tests/**/*.reference typo.prune + +# Expect tests with overly long lines of expected output +testsuite/tests/parsing/docstrings.ml typo.very-long-line + +tools/magic typo.missing-header +tools/eventlog_metadata.in typo.missing-header + +# TODO we should fix the long-line errors in yacc/*.c +/yacc/*.[ch] typo.very-long-line=may + +menhir-bench.bash typo.missing-header typo.utf8 + +# bootstrap files produced by Menhir +/boot/menhir/** typo.long-line=may typo.very-long-line=may +/boot/menhir/** typo.missing-header=may +/boot/menhir/** typo.white-at-eol=may +/boot/menhir/** typo.utf8=may + +# Line-ending specifications, for Windows interoperability +*.sh text eol=lf +*.sh.in text eol=lf +*.awk text eol=lf +*.m4 text eol=lf + +# ocamltest hooks which are used in the testsuite +*.check-program-output text eol=lf +*.run text eol=lf + +/tools/ci/appveyor/appveyor_build.cmd text eol=crlf + +configure.ac text eol=lf +build-aux/compile text eol=lf +build-aux/config.guess text eol=lf +build-aux/config.sub text eol=lf +build-aux/install text eol=lf +build-aux/missing text eol=lf +ocamldoc/remove_DEBUG text eol=lf +ocamltest/getocamloptdefaultflags text eol=lf +ocamltest/ocamltest.org typo.long-line=may typo.missing-header +stdlib/Compflags text eol=lf +stdlib/sharpbang text eol=lf +tools/autogen text eol=lf +tools/ci/inria/remove-sinh-primitive.patch text eol=lf +tools/check-typo text eol=lf +tools/ci-build text eol=lf +tools/msvs-promote-path text eol=lf +tools/gdb-macros text eol=lf +tools/magic text eol=lf +tools/make-opcodes text eol=lf +tools/make-package-macosx text eol=lf +tools/ocaml-objcopy-macosx text eol=lf +tools/ocamlmktop.tpl text eol=lf +tools/ocamlsize text eol=lf +tools/pre-commit-githook text eol=lf +tools/markdown-add-pr-links.sh text eol=lf +runtime/caml/m.h.in text eol=lf +runtime/caml/s.h.in text eol=lf +runtime/caml/compatibility.h typo.long-line=may + +# These are all Perl scripts, so may not actually require this +manual/tools/caml-tex text eol=lf +manual/tools/format-intf text eol=lf +manual/tools/htmlcut text eol=lf +manual/tools/htmltbl text eol=lf +manual/tools/htmlthread text eol=lf +manual/tools/texexpand text eol=lf + +# 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 +testsuite/tests/basic-more/morematch.ml text eol=lf +testsuite/tests/basic-more/robustmatch.ml text eol=lf +testsuite/tests/parsing/*.ml text eol=lf +testsuite/tests/docstrings/empty.ml text eol=lf +testsuite/tests/functors/functors.ml text eol=lf +testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_impl.ml text eol=lf +testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_intf.mli text eol=lf +testsuite/tests/tool-ocamlc-stop-after/stop_after_typing_impl.ml text eol=lf +testsuite/tests/tool-toplevel/error_highlighting.ml text eol=lf +testsuite/tests/tool-toplevel/error_highlighting_use4.ml text eol=lf +testsuite/tests/translprim/module_coercion.ml text eol=lf +testsuite/tests/typing-objects-bugs/pr3968_bad.ml text eol=lf +testsuite/tests/typing-ocamlc-i/pr7402.ml text eol=lf +testsuite/tests/typing-ocamlc-i/pervasives_leitmotiv.ml text eol=lf +testsuite/tests/typing-recmod/t12bad.ml text eol=lf +testsuite/tests/typing-safe-linking/b_bad.ml text eol=lf +testsuite/tests/warnings/w04.ml text eol=lf +testsuite/tests/warnings/w04_failure.ml text eol=lf +testsuite/tests/warnings/w32.ml text eol=lf + +# These are forced to \n to allow the Cygwin testsuite to pass on a +# Windows-checkout +testsuite/tests/formatting/margins.ml text eol=lf +testsuite/tests/letrec-check/pr7706.ml text eol=lf +testsuite/tests/letrec-disallowed/disallowed.ml text eol=lf +testsuite/tests/letrec-disallowed/extension_constructor.ml text eol=lf +testsuite/tests/letrec-disallowed/float_block_allowed.ml text eol=lf +testsuite/tests/letrec-disallowed/float_block_disallowed.ml text eol=lf +testsuite/tests/letrec-disallowed/generic_arrays.ml text eol=lf +testsuite/tests/letrec-disallowed/lazy_.ml text eol=lf +testsuite/tests/letrec-disallowed/module_constraints.ml text eol=lf +testsuite/tests/letrec-disallowed/unboxed.ml text eol=lf +testsuite/tests/letrec-disallowed/pr7215.ml text eol=lf +testsuite/tests/letrec-disallowed/pr7231.ml text eol=lf +testsuite/tests/letrec-disallowed/pr7706.ml text eol=lf +testsuite/tests/lexing/uchar_esc.ml text eol=lf +testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml text eol=lf +testsuite/tests/tool-toplevel/pr7060.ml text eol=lf +testsuite/tests/typing-extension-constructor/test.ml text eol=lf +testsuite/tests/typing-extensions/extensions.ml text eol=lf +testsuite/tests/typing-extensions/open_types.ml text eol=lf +testsuite/tests/typing-objects/Exemples.ml text eol=lf +testsuite/tests/typing-objects/pr5619_bad.ml text eol=lf +testsuite/tests/typing-objects/pr6123_bad.ml text eol=lf +testsuite/tests/typing-objects/pr6907_bad.ml text eol=lf +testsuite/tests/typing-objects/Tests.ml text eol=lf +testsuite/tests/typing-pattern_open/pattern_open.ml text eol=lf +testsuite/tests/typing-private/private.ml text eol=lf +testsuite/tests/typing-recordarg/recordarg.ml text eol=lf +testsuite/tests/typing-short-paths/pr5918.ml text eol=lf +testsuite/tests/typing-sigsubst/sigsubst.ml text eol=lf +testsuite/tests/typing-typeparam/newtype.ml text eol=lf +testsuite/tests/typing-unboxed/test.ml text eol=lf +testsuite/tests/typing-unboxed-types/test.ml text eol=lf +testsuite/tests/typing-unboxed-types/test_flat.ml text eol=lf +testsuite/tests/typing-unboxed-types/test_no_flat.ml text eol=lf +testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml text eol=lf +testsuite/tests/typing-warnings/application.ml text eol=lf +testsuite/tests/typing-warnings/coercions.ml text eol=lf +testsuite/tests/typing-warnings/exhaustiveness.ml text eol=lf +testsuite/tests/typing-warnings/pr6587.ml text eol=lf +testsuite/tests/typing-warnings/pr6872.ml text eol=lf +testsuite/tests/typing-warnings/pr7085.ml text eol=lf +testsuite/tests/typing-warnings/pr7115.ml text eol=lf +testsuite/tests/typing-warnings/pr7261.ml text eol=lf +testsuite/tests/typing-warnings/pr7297.ml text eol=lf +testsuite/tests/typing-warnings/pr7553.ml text eol=lf +testsuite/tests/typing-warnings/records.ml text eol=lf +testsuite/tests/typing-warnings/unused_types.ml text eol=lf diff --git a/.gitignore b/.gitignore new file mode 100644 index 00000000..ff94e3c7 --- /dev/null +++ b/.gitignore @@ -0,0 +1,270 @@ +#************************************************************************** +#* * +#* OCaml * +#* * +#* Damien Doligez, projet Gallium, INRIA * +#* * +#* 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. * +#* * +#************************************************************************** + +# general patterns + +*.o +*.a +*.so +*.obj +*.lib +*.dll +*.la +*.cm[ioxat] +*.cmx[as] +*.cmti +*.annot +*.exe +*.exe.manifest +.DS_Store +*.out +*.out.dSYM +*.swp +_ocamltest +_ocamltestd +*.odoc +.merlin +_build + +# local to root directory + +/Makefile.common +/Makefile.config +/autom4te.cache +/ocamlc +/config.cache +/ocaml-*.cache +/config.log +/config.status +/libtool +/ocamlc.opt +/expunge +/ocaml +/ocamlopt +/ocamlopt.opt +/ocamlnat + +# specific files and patterns in sub-directories + +/asmcomp/emit.ml +/asmcomp/arch.ml +/asmcomp/proc.ml +/asmcomp/selection.ml +/asmcomp/reload.ml +/asmcomp/scheduling.ml +/asmcomp/CSE.ml + +/boot/ocamlrun +/boot/camlheader +/boot/ocamlc.opt + +/bytecomp/opcodes.ml +/bytecomp/opcodes.mli + +/debugger/debugger_lexer.ml +/debugger/debugger_parser.ml +/debugger/debugger_parser.mli +/debugger/ocamldebug + +/emacs/ocamltags +/emacs/*.elc + +/lambda/runtimedef.ml + +/lex/parser.ml +/lex/parser.mli +/lex/lexer.ml +/lex/ocamllex +/lex/ocamllex.opt +/lex/parser.output + +/manual/manual/cmds/warnings-help.etex +/manual/manual/warnings-help.etex + +/ocamldoc/ocamldoc +/ocamldoc/ocamldoc.opt +/ocamldoc/odoc +/ocamldoc/odoc_crc.ml +/ocamldoc/odoc_lexer.ml +/ocamldoc/odoc_ocamlhtml.ml +/ocamldoc/odoc_parser.ml +/ocamldoc/odoc_parser.mli +/ocamldoc/odoc_see_lexer.ml +/ocamldoc/odoc_text_lexer.ml +/ocamldoc/odoc_text_parser.ml +/ocamldoc/odoc_text_parser.mli +/ocamldoc/stdlib_man +/ocamldoc/stdlib_html +/ocamldoc/stdlib_latex +/ocamldoc/stdlib_texi +/ocamldoc/*.output +/ocamldoc/test_stdlib +/ocamldoc/test_latex +/ocamldoc/test + +/ocamltest/ocamltest +/ocamltest/ocamltest.opt +/ocamltest/ocamltest_config.ml +/ocamltest/tsl_lexer.ml +/ocamltest/tsl_parser.ml +/ocamltest/tsl_parser.mli +/ocamltest/ocamltest.html + +/otherlibs/dynlink/extract_crc +/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/threads/marshal.mli +/otherlibs/threads/stdlib.mli +/otherlibs/threads/unix.mli +/otherlibs/win32unix/unixLabels.ml* +/otherlibs/win32unix/unix.mli +/otherlibs/win32unix/access.c +/otherlibs/win32unix/addrofstr.c +/otherlibs/win32unix/chdir.c +/otherlibs/win32unix/chmod.c +/otherlibs/win32unix/cst2constr.c +/otherlibs/win32unix/cstringv.c +/otherlibs/win32unix/execv.c +/otherlibs/win32unix/execve.c +/otherlibs/win32unix/execvp.c +/otherlibs/win32unix/exit.c +/otherlibs/win32unix/getaddrinfo.c +/otherlibs/win32unix/getcwd.c +/otherlibs/win32unix/gethost.c +/otherlibs/win32unix/gethostname.c +/otherlibs/win32unix/getnameinfo.c +/otherlibs/win32unix/getproto.c +/otherlibs/win32unix/getserv.c +/otherlibs/win32unix/gmtime.c +/otherlibs/win32unix/mmap_ba.c +/otherlibs/win32unix/putenv.c +/otherlibs/win32unix/rmdir.c +/otherlibs/win32unix/socketaddr.c +/otherlibs/win32unix/strofaddr.c +/otherlibs/win32unix/time.c +/otherlibs/win32unix/unlink.c +/otherlibs/win32unix/fsync.c + +/parsing/parser.ml +/parsing/parser.mli +/parsing/lexer.ml +/parsing/lexer_tmp.mll +/parsing/lexer_tmp.ml +/parsing/linenum.ml +/parsing/parser.output +/parsing/parser.automaton +/parsing/parser.conflicts +/parsing/camlinternalMenhirLib.ml +/parsing/camlinternalMenhirLib.mli + +/runtime/caml/jumptbl.h +/runtime/caml/m.h +/runtime/caml/s.h +/runtime/primitives +/runtime/primitives.new +/runtime/prims.c +/runtime/caml/opnames.h +/runtime/caml/version.h +/runtime/ocamlrun +/runtime/ocamlrund +/runtime/ocamlruni +/runtime/ld.conf +/runtime/interp.a.lst +/runtime/*.[sd]obj +/runtime/.gdb_history +/runtime/*.d.c +/runtime/*.pic.c +/runtime/domain_state32.inc +/runtime/domain_state64.inc + +/stdlib/camlheader +/stdlib/target_camlheader +/stdlib/camlheader[di] +/stdlib/target_camlheader[di] +/stdlib/camlheader_ur +/stdlib/labelled-* +/stdlib/caml +/stdlib/sys.ml + +/testsuite/**/*.result +/testsuite/**/*.opt_result +/testsuite/**/*.corrected +/testsuite/**/*.byte +/testsuite/**/*.native +/testsuite/**/program +/testsuite/**/_log* +/testsuite/failure.stamp + +/testsuite/_retries + + +/testsuite/tools/codegen +/testsuite/tools/expect_test +/testsuite/tools/lexcmm.ml +/testsuite/tools/parsecmm.ml +/testsuite/tools/parsecmm.mli + +/tools/ocamldep +/tools/ocamldep.opt +/tools/ocamldep.bak +/tools/ocamlprof +/tools/ocamlprof.opt +/tools/opnames.ml +/tools/dumpobj +/tools/dumpobj.opt +/tools/dumpapprox +/tools/ocamlobjinfo +/tools/ocamlobjinfo.opt +/tools/cvt_emit +/tools/cvt_emit.opt +/tools/cvt_emit.bak +/tools/cvt_emit.ml +/tools/ocamlcp +/tools/ocamlcp.opt +/tools/ocamloptp +/tools/ocamloptp.opt +/tools/ocamlmktop +/tools/ocamlmktop.opt +/tools/primreq +/tools/primreq.opt +/tools/ocamldumpobj +/tools/keywords +/tools/ocamlmklib +/tools/ocamlmklib.opt +/tools/ocamlmklibconfig.ml +/tools/objinfo_helper +/tools/read_cmt +/tools/read_cmt.opt +/tools/cmpbyt +/tools/cmpbyt.opt +/tools/stripdebug +/tools/stripdebug.opt +/tools/make_opcodes +/tools/make_opcodes.ml +/tools/caml-tex +/tools/eventlog_metadata + +/utils/config.ml +/utils/domainstate.ml +/utils/domainstate.mli + +/yacc/ocamlyacc +/yacc/version.h +/yacc/.gdb_history diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 00000000..dca1e0d2 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "flexdll"] + path = flexdll + url = https://github.com/alainfrisch/flexdll.git diff --git a/.mailmap b/.mailmap new file mode 100644 index 00000000..d83748cc --- /dev/null +++ b/.mailmap @@ -0,0 +1,129 @@ +# The format of this file is generally of the form +# +# for example: +# Proper Name +# +# Proper Name Commit Name +# +# See the MAPPING AUTHORS section of 'man git-shortlog' for more details. + +# Such a remapping may be useful in particular for tracking authorship +# of commits erroneously made under an obscure alias or email address. +# (Some Name , pour ne pas le citer) + + +### Normalizing information for frequent git commit authors + +Alain Frisch alainfrisch + + +Luc Maranget + + + + + + +cvs2svn +Damien Doligez Some Name +Damien Doligez doligez +Mohamed Iguernelala +Jérémie Dimino +Jeremy Yallop yallop +Nicolás Ojeda Bär + + +### Approved Approvers + +# The current policy to handle pull requests for the compiler +# distribution is to merge a PR only it has been "approved" by someone +# who is not an author of the PR and has the "approver" status, by +# either +# (1) having been given commit rights, or +# (2) being part of the list of "approvers" below. +# +# Format: +# +# Preferred Name + +Gabriel Radanne +Vincent Laviron +Jeremy Yallop + + +### Remembering naming preferences for contributors + +# The aliases below correspond to preference expressed by +# contributors on the name under which they credited, for example +# if they use an opaque nickname from github or mantis: +# +# Preferred Name nickname +# or +# Preferred Name +# Preferred Name +# to indicate a preference associated to a Mantis account. + +Florian Angeletti octachron +Gabriel Radanne Drup +Pierre Weis pierreweis +John Christopher McAlpine chrismamo1 +Runhang Li marklrh +Francis Souther FDSouthern +Simon Cruanes +Frederic Bour +David Sheets +David Allsopp +David Allsopp +Tim Cuthbertson +Grégoire Henry +Julien Moutinho +Adam Borowski +Mikhail Mandrykin +Maverick Woo +Andi McClure +Michael Grünewald +Michael O'Connor +Florian Angeletti +Kenji Tokudome +Philippe Veber +Valentin Gatien-Baron +Valentin Gatien-Baron +Stephen Dolan +Junsong Li +Junsong Li +Christophe Raffali +Christophe Raffali +Anton Bachin +Reed Wilson +David Scott +Martin Neuhäußer +Goswin von Brederlow +Thomas Leonard +Thomas Leonard +Adrien Nader +Sébastien Hinderer +Sébastien Hinderer +Gabriel Scherer +Immanuel Litzroth +Jacques Le Normand +Konstantin Romanov +Arseniy Alekseyev +Dwight Guth +Dwight Guth +Andreas Hauptmann fdopen +Andreas Hauptmann +Andreas Hauptmann +Hendrik Tews +Hugo Heuzard +Miod Vallat +Christoph Spiel +Joris Giovannangeli +Wilfred Hughes +John Skaller + +# These contributors prefer to be referred to pseudonymously +whitequark +william +tkob +ygrek +linse diff --git a/.ocp-indent b/.ocp-indent new file mode 100644 index 00000000..324a3827 --- /dev/null +++ b/.ocp-indent @@ -0,0 +1,2 @@ +match_clause=4 +strict_with=auto diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 00000000..48bbfb99 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,55 @@ +#************************************************************************** +#* * +#* OCaml * +#* * +#* Anil Madhavapeddy, OCaml Labs * +#* * +#* Copyright 2014 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. * +#* * +#************************************************************************** + +dist: xenial +language: c +git: + submodules: false +script: tools/ci/travis/travis-ci.sh +matrix: + include: + - env: CI_KIND=build XARCH=x64 CONFIG_ARG=--enable-flambda OCAMLRUNPARAM=b,v=0 + - env: CI_KIND=build XARCH=i386 CONFIG_ARG=--disable-stdlib-manpages + addons: + apt: + packages: + - gcc:i386 + - cpp:i386 + - binutils:i386 + - binutils-dev:i386 + - libx11-dev:i386 + - libc6-dev:i386 + - env: CI_KIND=build XARCH=x64 + addons: + apt: + packages: + - texlive-latex-extra + - texlive-fonts-recommended + - env: CI_KIND=build XARCH=x64 CONFIG_ARG=--disable-shared + - env: CI_KIND=build XARCH=x64 MIN_BUILD=1 + - env: CI_KIND=changes + - env: CI_KIND=manual + - env: CI_KIND=check-typo +# - env: CI_KIND=tests +# allow_failures: +# - env: CI_KIND=tests +addons: + apt: + packages: + - binutils-dev + +notifications: + email: + - ocaml-ci-notifications@inria.fr diff --git a/BOOTSTRAP.adoc b/BOOTSTRAP.adoc new file mode 100644 index 00000000..e73d01fe --- /dev/null +++ b/BOOTSTRAP.adoc @@ -0,0 +1,62 @@ += Bootstrapping the compiler + +This file explains how to bootstrap the OCaml compiler, i.e. how to +update the binaries in the link:boot/[] directory. + +A bootstrap is required for example when something changes in the +runtime system (the magic number of bytecode executables, the format of +bytecode instructions, the set of available primitives) or when the +format of OCaml compilation object files like .cmi files is modified. In +particular, given that the .cmi files contain information related to +types, modifying the way a type is represented will modify the format +of .cmi files and thus require a bootstrap. + +Here is how to perform a change that requires a bootstrap: + +1. Make sure you start with a clean source tree (e.g. check with + `git status`) + +2. Configure your source tree by running: + + ./configure + +3. Bring your system to a stable state. Concretely, this means that the + boot/ directory should contain a version of ocamlrun and all the + \*.cm* files of the standard library. This stable state can be reached + by running + + make world ++ +(Actually, running `make coldstart` should be enough but `make world` is +safer. Similarly, `make world.opt` will also bring you to such a stable +state but builds more things than actually required.) + +4. Now, and only now, edit the sources. Changes here may include adding, + removing or renaming a primitive in the runtime, changing the magic + number of bytecode executable files, changing the way types are + represented or anything else in the format of .cmi files, etc. + +5. Run: + + make coreall ++ +This will rebuild runtime/ocamlrun, ocamlc, etc. + +6. (optional) The new system can now be tested: + + echo 'let _ = print_string "Hello world!\n"' > foo.ml + ./boot/ocamlrun ./ocamlc -I ./stdlib foo.ml + ./runtime/ocamlrun a.out + +7. We now know the system works and can thus build the new boot/ + binaries: + + make bootstrap + +If you notice that this procedure fails for a given change you are +trying to implement, please report it so that the procedure can be +updated to also cope with your change. + +If you want to upstream your changes, indicate in the message of the +commit that the changes need a bootstrap. Perform the bootstrap and +commit the result of the bootstrap separately, after that commit. diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 00000000..ae670072 --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,472 @@ +# How to contribute changes + +:+1::tada: First off, thank you for taking time to contribute! :tada::+1: + +The following is a set of guidelines for proposing changes to the +OCaml distribution. These are just guidelines, not rules, use your +best judgment and feel free to propose changes to this document itself +in a pull request. + +This document assumes that you have a patch against the sources of the +compiler distribution, that you wish to submit to the OCaml +maintainers upstream. See [INSTALL.adoc](INSTALL.adoc) for details on +how to build the compiler distribution from sources. See +[HACKING.adoc](HACKING.adoc) for details on how to modify the sources. + +## Contribution + +Modifying its sources is far from the only way to contribute to the +OCaml distribution. Bug reports (in particular when they come with +a reproducible example), simple typos or clarifications in the +documentation also help, and help evaluating and integrating existing +change proposals also help. Providing good answers on the discussion +forums, or asking the good questions that highlight deficiencies in +existing documentations, also help. We currently have more +contributors willing to propose changes than contributors willing to +review other people's changes, so more eyes on the existing change +requests is a good way to increase the integration bandwidth of +external contributions. + +There are also many valuable ways to contribute to the wider OCaml +ecosystem that do not involve changes to the OCaml distribution. + +The rest of the document is concerned with the form of change +proposals against the OCaml distribution. (Code changes, but also +improvement to documentation or implementation comments, which are +valuable changes on their own.) + +## Workflow + +All changes to the OCaml distribution need to be processed through the +GitHub Pull Request (PR) system. In order to propose a change, a +contributor thus needs to have a GitHub account, fork the ocaml/ocaml +repository, create a branch for the proposal on their fork and submit +it as a Pull Request on the upstream repository. (If you are not yet +familiar with GitHub, don't worry, all these steps are actually quite +easy!) + +The current rule is that a PR needs to get an explicit approval from +one of the core maintainer in order to be merged. Reviews by +external contributors are very much appreciated. + +Since core maintainers cannot push directly without going through an +approved PR, they need to be able to apply small changes to the +contributed branches themselves. Such changes include fixing +conflicts, adjusting a Changelog entry, or applying some code changes +required by the reviewers. Contributors are thus strongly advised to +check the [**Allow edits from maintainer**]( +https://help.github.com/articles/allowing-changes-to-a-pull-request-branch-created-from-a-fork/ +) flag on their PRs in the GitHub interface. Failing to do so might +significantly delay the inclusion of an otherwise perfectly ok +contribution. + + +## Coding guidelines + +You should not leave trailing whitespace; not have line longer than 80 +columns, not use tab characters (spaces only), and not use non-ASCII +characters. These typographical rules can be checked with the script +`tools/check-typo`. + +If you are working from a Git clone, you can automate this process by +copying the file `tools/pre-commit-githook` to `.git/hooks/pre-commit`. + +Otherwise, there are no strongly enforced guidelines specific to the +compiler -- and, as a result, the style may differ in the different +parts of the compiler. The general [OCaml Programming +Guidelines](https://ocaml.org/learn/tutorials/guidelines.html) are +good to keep in mind, and otherwise we strive for good taste and local +consistency (following the code located around your change). + +If you strongly feel that a style-related change would improve quality +of the existing code (for example, giving more descriptive names to +some variables throughout a module, factoring repeated code patterns +as auxiliary functions, or adding comments to document a part of the +code that you had trouble understanding), you can have code cleanup +commits at the beginning of your patch series, or submit code cleanups +as your change proposal. Those cleanups should remain separate commits +from the functional changes in the rest of the patch series; it is +easier to review commits that are specifically marked as exactly +preserving the code semantics. + + +## Test you must. + +Whenever applicable, merge requests must come with tests +exercising the affected features: regression tests for bug fixes, +and correctness tests for new features (including corner cases and +failure cases). For regression tests, testing other aspects of the +feature (in particular, related edge cases) that are not currently +covered is a good way to catch other instances of bugs -- this did +happen several times in the past. Warnings and errors should also +be tested. + +Tests go in the sub-directories of `testsuite/tests`. Running +`make all` in `testsuite/` runs all tests (this takes +a few minutes), and you can use `make one DIR=tests/foo` to run +the tests of a specific sub-directory. There are many kind of tests +already, so the easiest way to start is to extend or copy an +existing test. + +In general, running a test produces one (or several) `.result` file, +that are compared to one (or several) `.reference` file present in the +repository; the test succeeds if they are identical. If your patch +breaks a test, diffing the `.result` and `.reference` file is a way to +see what went wrong. Some reasonable compiler changes affect the +compiler output in way that make those outputs differ (for example +slight modifications of warning or error messages may break all tests +checking warnings). If you are positive that the new `.result` file +is correct (and that the change in behavior does not endanger +backward compatibility), you can replace the old `.reference` file +with it. Finally, when adding new tests, do not forget to include your +`.reference` files (but not `.result`) in the versioned repository. + +Testing is also a way to make sure reviewers see working +(and failing) examples of the feature you fix, extend or +introduce, rather than just an abstract description of it. + + +### Run tests before sending a PR + +You should run all the tests before creating the merge request or +pushing new commits (even if Travis will also do it for you): `make +tests` (this takes a few minutes). + +Unfortunately some of the `lib-threads` test are non-deterministic +and fail once in a while (it's hard to test these well). If they +consistently break after your change, you should investigate, but if +you only see a transient failure once and your change has no reason +to affect threading, it's probably not your fault. + + +### Benchmarking + +If your contribution can impact the performance of the code generated +by the native compiler, you can use the infrastructure that the +flambda team put together to benchmark the compiler to assess the +consequences of your contribution. It has two main accessible parts: + +- The website that hosts benchmarks results, at +[http://bench.flambda.ocamlpro.com/](http://bench.flambda.ocamlpro.com/). +It exposes two ways to compare compilers: the first, under the header +`Plot a given benchmark`, allows to select a benchmark and +see graphs plotting the evolution of the performance of the different +compilers over time. The second, under `Compare two runs`, allows +to get an overview of the differences between a reference compiler +(selected using the `ref` button) and a compiler under test (using +the `tst` button). Clicking on the `Compare` button at the bottom +right of the page will create a new page containing summaries and +raw data comparing the selected runs. + +- The git repository containing the data about which benchmarks +to run, on which compilers, at [https://github.com/OCamlPro/ocamlbench-repo]( +https://github.com/OCamlPro/ocamlbench-repo). This needs to be a valid +opam 2.0 repository, and contains the benchmarks as normal packages +and the compilers as versions of the package `ocaml-variants`. +To add a compiler to the list, you must have a publicly accessible +version of your branch (if you're making a pull request again the +compiler, you should have a branch on github that was used to make +the pull request, that you can use for this purpose). +Then, you should make a pull request against `ocamlbench-repo` +that adds a repertory in the `packages/ocaml-variants` sub-folder +which contains a single `opam` file. The contents of the file +should be inspired from the other files already present, with +the main points of interest being the `url` field, which should +point to your branch, the `build` field that should be adapted +if the features that you want to benchmark depend on configure-time +options, and the `setenv` field that can be used to pass compiler +options via the `OCAMLPARAM` environment variable. +The `trunk+flambda+opt` compiler, for instance, both uses a +`configure` option and sets the `OCAMLPARAM` variable. +The folder you add has to be named `ocaml-variants.%VERSION%+%DESCR%`, +where `%VERSION%` is the version that will be used by opam to +check compatibility with the opam packages that are needed for the +benchmarks, and `%DESCR%` should be a short description of the feature +you're benchmarking (if you're making a pull request against `ocaml`, +you can use the PR number in the description, e.g. `+gpr0000`). +Once your pull request is merged, it will likely take a few hours +until the benchmark server picks up the new definition and again +up to a few hours before the results are available on the results page. + + +## Description of the proposed change + +### In the merge request interface + +The description of the merge request must contain a precise +explanation of the proposed change. + +Before going in the implementation details, you should include +a summary of the change, and a high-level description of the design +of the proposed change, with example use-cases. + +### In the patches + +If some of the explanations you provide for the merge request would +make sense as comments in the code, or documentation in the manual, +you should include them there as well. + +In-code comments help make the codebase more accessible to newcomers +(many places in the compiler could benefit from a few +extra explanations), and they are also useful to code reviewers. In +particular, any subtlety in code that cannot be made +self-explanatory should come with an explanation in comment. If you +add some non-obvious code specifically to fix a bug, include the +issue number in comments. + +Do not assume that code reviewers are all experts in the existing +codebase. If you use subtle code, add a comment, even if the same +kind of code is used somewhere else in the same module. (If this is +a common and useful domain-specific idiom that is already explained +somewhere, pointing to this explanation in your commit message is +better than adding redundant explanations.) + +### User documentation + +Changes affecting the compiler libraries should be reflected in the +documentation comments of the relevant `.mli` files. + +It is recommended to included changes to the OCaml Reference Manual +(in particular for any change in the surface language), which is now +part of the main repository (under `manual/`). + +Finally, changes in command-line options should be integrated in the +manual, but also in the man pages present in the `man/` sub-directory +of the OCaml distribution. + +### Changelog + +Any user-visible change should have a `Changes` entry: + +- in the right section (named sections if major feature, generic + "Bug fixes" and "Feature requests" otherwise) + +- using the label "`*`" if it breaks existing programs, "`-`" otherwise + +- with all relevant issue and PR numbers `#{N}`, in ascending numerical order + (separated by commas if necessary) + +- maintaining the order: the entries in each section should be sorted by + issue/PR number (the first of each entry, if more than one is available) + +- with a concise readable description of the change (possibly taken + from a commit message, but it should make sense to end-users + reading release notes) + +- crediting the people that worked on the feature. The people that + wrote the code should be credited of course, but also substantial + code reviews or design advice, and the reporter of the bug + (if applicable) or designer of the feature request (if novel). + +- following the format + + {label} {issue number(s)}: {readable description} + ({credits}) + + note that the `{credits}` should be on their own line, aligned with the + issue number for readability + (`{readable description}` can be multiline to not overflow 80 + columns, and should be aligned with the issue number as well.) + +This changelog can be included in the main commit, if the merge +request is just one patch, or as a separate commit, if it's +a patch series and no particular commit feels best suited to +receive the Changelog entry. + +(Do not under-estimate the importance of a good changelog. Users do + read the release notes, and things forgotten from the changelog + will cause pain or regrets down the line.) + + +## Clean patch series + +Clean patch series are useful, both during the review process and +for code maintenance after it has been merged. Before submitting +your request, you should rebase your patch series: + +- on top of the OCaml branch in which you want to merge + (usually `trunk`), solving any conflicts. + +- into a few well-separated, self-contained patches (github PRs + can generate gazillions of micro-changes) + +- erasing history that does not make sense after the issue is merged + (back-and-forth between different designs, etc. The PR number + allows interested people to go back to the original discussion if + needed.) + +- bisectable: the distribution should be in a good state after + the application of each patch (in particular, later commits that + fix bugs in previous commits should always be squashed into the commit + they fix) + +- with readable commit messages (this is for future developers + needing to understand a change that happened in the past). Commit + messages should not overflow 80 columns, with the following format: + + {one-liner header description (with issue number if applicable)} + {blank line} + {one or several paragraphs of explanation if needed} + +During review, you may make many other changes to the patch +series. You can rebase it on the fly (if you `git push -f` on the +branch of the pull request in your personal clone, Github will +update the pull request automatically; remember to always create +a new branch for any) or wait until the discussion has converged, +once we agree the request is ready for merging. Doing a good +rebase is grunt work that takes some time and care (use `git +log -u` to make sure the rebase patches make sense), but: + +- It is easier and faster to do for the author of the patch than + for others (if rebasing against the current trunk creates + a conflict with another change you don't understand well, feel + free to ask). + +- Maintainers are usually short on time, and asking them to do + a rebase means they have less time to review and merge other + contributions. + +- The long-term benefits of keeping a clean, bisectable history + cannot be overstated. Imagine that in three years, under the + pressure of a coming release, a contributor ends up somewhere in + the middle of your patch series, wondering if or why it is the + cause of a specific issue. Wasting his or her time then + (with a "yolo" commit message, a big ugly commit of unrelated + changes, or an un-testable intermediary state) is a sure way to + generate ill will. + +## Contributing to the standard library + +Contributions to the standard library are very welcome. There is some +widespread belief in the community than the stdlib is somehow "frozen" +and that its evolutions are mostly driven by the need of the OCaml +compiler itself. Let's be clear: this is just plain wrong. The +compiler is happy with its own local utility functions, and many +recent additions to the stdlib are not used by the compiler. + +Another common and wrong idea is that core OCaml maintainers don't +really care about the standard library. This is not true, and won't +be unless one of the "alternative standard" libraries really gains +enough "market share" in the community. + +So: please contribute! + +Obviously, the proposals 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 +internal compiler changes (optimizations, etc). + +A key property of the standard library is its stability. Backward +compatibility is not an absolute technical requirement (any addition +to/of a module can break existing code, formally), but breakage should +be limited as much as possible (and assessed, when relevant). A +corollary is that any addition creates a long-term support commitment. +For instance, once a concrete type or function is made public, +changing the exposed definition cannot be done easily. + +There is no plan to extend dramatically the functional domain covered +by the standard library. For instance, proposals to include support +for XML, JSON, or network protocols are very likely to be rejected. Such +domains are better treated by external libraries. Small additions to +existing modules are much simpler to get in, even more so (but not +necessarily) when: + + - they cannot easily be implemented externally, or when + - they facilitate communication between independent external + libraries, or when + - they fill obvious gaps. + +Of course, standard guidelines apply as well: proper documentation, +proper tests, portability (yes, also Windows!), good justification for +why the change is desirable and why it should go into stdlib. + +So: be prepared for some serious review process! But yes, yes, +contributions are welcome and appreciated. Promised. + +## Contributing optimizations + +Contributions to improve the compiler's optimization capabilities are +welcome. However, due to the potential risks involved with such +changes, we ask the following of contributors when submitting pull +requests: + + - Explain the benefits of the optimization (faster code, smaller + code, improved cache behaviour, lower power consumption, increased + compilation speed). + + - Explain when the optimization does and does not apply. + + - Explain when, if ever, the optimization may be detrimental. + + - Provide benchmark measurements to justify the expected + benefits. Measurements should ideally include experiments with + full-scale applications as well as with microbenchmarks. Which + kinds of measurements are appropriate will vary depending on the + optimization; some optimizations may have to be measured indirectly + (for example, by measuring cache misses for a code size + optimization). Measurements showing clear benefits when combined + with some other optimization/change are acceptable. + + - At least some of the measurements provided should be from + experiments on open source code. + + - If assistance is sought with benchmarking then this should be made + clear on the initial pull request submission. + + - Justify the correctness of the optimization, and discuss a testing + strategy to ensure that it does not introduce bugs. The use of + formal methods to increase confidence is encouraged. + +A major criterion in assessing whether to include an optimisation in +the compiler is the balance between the increased complexity of the +compiler code and the expected benefits of the benchmark. Contributors +are asked to bear this in mind when making submissions. + +## Contributor License Agreement + +We distinguish two kind of contributions: + +- Small changes that do not bear a specific mark of their authors + (another developer recreating the change without access to the + original patch would write an indistinguishable patch), and are thus + not protected by copyright, do not require any particular + paperwork. This is convenient for everyone, and of course does not + mean that those contributions are of lesser importance. (For example + a bugfix can be obvious once a bug is understood, reported and + reproduced, and yet invaluable for users.) + +- Larger changes that are covered by copyright. For them, we require + contributors to sign a Contributor License Agreement (CLA), which + gives [INRIA](http://www.inria.fr/en/) (Institut National de + Recherche en Informatique et en Automatique) the rights to integrate + the contribution, maintain it, evolve it, and redistribute it under + the license of its choice. This is not a copyright *assignment* + (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 + 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). + +You must understand that, by proposing a contribution for integration +in the OCaml distribution, you accept that it be considered under one +of those regimes. In particular, in all cases you give INRIA the +permission to freely re-license the OCaml distribution including the +contribution. + +This ability to re-license allows INRIA to provide members of the +[Caml Consortium](http://caml.inria.fr/consortium/) with a license on +the Caml code base that is more permissive than the public license. + +### How to sign the CLA + +If your contribution is large enough, you should sign the CLA. If you +are contributing on your own behalf, you should sign [the individual +CLA](http://caml.inria.fr/pub/docs/CLA-individual.doc). For corporate +contributions, if your employer has not already done so, they should +sign [the corporate +CLA](http://caml.inria.fr/pub/docs/CLA-corporate.doc). Review the CLA, +sign it, and send it -- scanned PDF by email, or postail mail -- to +Xavier Leroy ([contact +info](http://gallium.inria.fr/%7Exleroy/contact.html)). diff --git a/Changes b/Changes new file mode 100644 index 00000000..62e58bd5 --- /dev/null +++ b/Changes @@ -0,0 +1,10185 @@ +OCaml 4.11.1 (31 August 2020) +----------------------------- + +### Bug fixes: + +- #9856, #9857: Prevent polymorphic type annotations from generalizing + weak polymorphic variables. + (Leo White, review by Jacques Garrigue) + +- #9859, #9862: Remove an erroneous assertion when inferred function types + appear in the right hand side of an explicit :> coercion + (Florian Angeletti, review by Thomas Refis) + +OCaml 4.11.0 (19 August 2020) +--------------------------- + +(Changes that can break existing programs are marked with a "*") + +### Runtime system: + +- #9096: Print function names in backtraces. + Old output: + > Called from file "foo.ml", line 16, characters 42-53 + New output: + > Called from Foo.bar in file "foo.ml", line 16, characters 42-53 + (Stephen Dolan, review by Leo White and Mark Shinwell) + +- #9082: The instrumented runtime now records logs in the CTF format. + A new API is available in the runtime to collect runtime statistics, + replacing the previous instrumented runtime macros. + Gc.eventlog_pause and Gc.eventlog_resume were added to allow user to control + instrumentation in a running program. + See the manual for more information on how to use this instrumentation mode. + (Enguerrand Decorne and Stephen Dolan, with help and review from + David Allsopp, Sébastien Hinderer, review by Anil Madhavapeddy, + Nicolás Ojeda Bär, Shakthi Kannan, KC Sivaramakrishnan, Gabriel Scherer, + Guillaume Munch-Maccagnoni, Damien Doligez, Leo White, Daniel Bünzli + and Xavier Leroy) + +- #9230, #9362: Memprof support for native allocations. + (Jacques-Henri Jourdan and Stephen Dolan, review by Gabriel Scherer) + +- #8920, #9238, #9239, #9254, #9458: New API for statistical memory profiling + in Memprof.Gc. The new version does no longer use ephemerons and allows + registering callbacks for promotion and deallocation of memory + blocks. + The new API no longer gives the block tags to the allocation callback. + (Stephen Dolan and Jacques-Henri Jourdan, review by Damien Doligez + and Gabriel Scherer) + +- #9353: Reimplement `output_value` and the `Marshal.to_*` functions + using a hash table to detect sharing, instead of temporary in-place + modifications. This is a prerequisite for Multicore OCaml. + (Xavier Leroy and Basile Clément, review by Gabriel Scherer and + Stephen Dolan) + + +- #9119: Make [caml_stat_resize_noexc] compatible with the [realloc] + API when the old block is NULL. + (Jacques-Henri Jourdan, review by Xavier Leroy) + +- #9233: Restore the bytecode stack after an allocation. + (Stephen Dolan, review by Gabriel Scherer and Jacques-Henri Jourdan) + +- #9249: restore definition of ARCH_ALIGN_INT64 in m.h if the architecture + requires 64-bit integers to be double-word aligned (autoconf regression) + (David Allsopp, review by Sébastien Hinderer) + +- #9259: Made `Ephemeron.blit_key` and `Weak.blit` faster. They are now + linear in the size of the range being copied instead of depending on the + total sizes of the ephemerons or weak arrays involved. + (Arseniy Alekseyev, design advice by Leo White, review by François Bobot + and Damien Doligez) + +- #9279: Memprof optimisation. + (Stephen Dolan, review by Jacques-Henri Jourdan) + +- #9280: Micro-optimise allocations on amd64 to save a register. + (Stephen Dolan, review by Xavier Leroy) + +- #9426: build the Mingw ports with higher levels of GCC optimization + (Xavier Leroy, review by Sébastien Hinderer) + +* #9483: Remove accidental inclusion of in + The only release with the inclusion of stdio.h has been 4.10.0 + (Christopher Zimmermann, review by Xavier Leroy and David Allsopp) + +- #9282: Make Cconst_symbol have typ_int to fix no-naked-pointers mode. + (Stephen Dolan, review by Mark Shinwell, Xavier Leroy and Vincent Laviron) + +- #9497: Harmonise behaviour between bytecode and native code for + recursive module initialisation in one particular case (fixes #9494). + (Mark Shinwell, David Allsopp, Vincent Laviron, Xavier Leroy, + Geoff Reedy, original bug report by Arlen Cox) + +- #8791: use a variable-length encoding when marshalling bigarray dimensions, + avoiding overflow. + (Jeremy Yallop, Stephen Dolan, review by Xavier Leroy) + +### Code generation and optimizations: + +- #9441: Add RISC-V RV64G native-code backend. + (Nicolás Ojeda Bär, review by Xavier Leroy and Gabriel Scherer) + +- #9316, #9443, #9463, #9782: Use typing information from Clambda + for mutable Cmm variables. + (Stephen Dolan, review by Vincent Laviron, Guillaume Bury, Xavier Leroy, + and Gabriel Scherer; temporary bug report by Richard Jones) + +- #8637, #8805, #9247, #9296: Record debug info for each allocation. + (Stephen Dolan and Jacques-Henri Jourdan, review by Damien Doligez, + KC Sivaramakrishnan and Xavier Leroy) + + +- #9193: Make tuple matching optimisation apply to Lswitch and Lstringswitch. + (Stephen Dolan, review by Thomas Refis and Gabriel Scherer) + +- #9392: Visit registers at most once in Coloring.iter_preferred. + (Stephen Dolan, review by Pierre Chambart and Xavier Leroy) + +- #9549, #9557: Make -flarge-toc the default for PowerPC and introduce + -fsmall-toc to enable the previous behaviour. + (David Allsopp, report by Nathaniel Wesley Filardo, review by Xavier Leroy) + +### Language features + +- #8820, #9166: quoted extensions: {%foo|...|} is lighter syntax for + [%foo {||}], and {%foo bar|...|bar} for [%foo {bar|...|bar}]. + (Gabriel Radanne, Leo White, Gabriel Scherer and Pieter Goetschalckx, + request by Bikal Lem) + +- #7364, #2188, #9592, #9609: improvement of the unboxability check for types + with a single constructor. Mutually-recursive type declarations can + now contain unboxed types. This is based on the paper + https://arxiv.org/abs/1811.02300 + (Gabriel Scherer and Rodolphe Lepigre, + review by Jeremy Yallop, Damien Doligez and Frédéric Bour) + +- #1154, #1706: spellchecker hints and type-directed disambiguation + for extensible sum type constructors + (Florian Angeletti, review by Alain Frisch, Gabriel Radanne, Gabriel Scherer + and Leo White) + + +- #6673, #1132, #9617: Relax the handling of explicit polymorphic types. + This improves error messages in some polymorphic recursive definition, + and requires less polymorphic annotations in some cases of + mutually-recursive definitions involving polymorphic recursion. + (Leo White, review by Jacques Garrigue and Gabriel Scherer) + +- #9232: allow any class type paths in #-types, + For instance, "val f: #F(X).t -> unit" is now allowed. + (Florian Angeletti, review by Gabriel Scherer, suggestion by Leo White) + +### Standard library: + +- #9077: Add Seq.cons and Seq.append + (Sébastien Briais, review by Yawar Amin and Florian Angeletti) + +- #9235: Add Array.exists2 and Array.for_all2 + (Bernhard Schommer, review by Armaël Guéneau) + +- #9226: Add Seq.unfold. + (Jeremy Yallop, review by Hezekiah M. Carty, Gabriel Scherer and + Gabriel Radanne) + +- #9059: Added List.filteri function, same as List.filter but + with the index of the element. + (Léo Andrès, review by Alain Frisch) + +- #8894: Added List.fold_left_map function combining map and fold. + (Bernhard Schommer, review by Alain Frisch and github user @cfcs) + +- #9365: Set.filter_map and Map.filter_map + (Gabriel Scherer, review by Stephen Dolan and Nicolás Ojeda Bär) + + +- #9248: Add Printexc.default_uncaught_exception_handler + (Raphael Sousa Santos, review by Daniel Bünzli) + +- #8771: Lexing: add set_position and set_filename to change (fake) + the initial tracking position of the lexbuf. + (Konstantin Romanov, Miguel Lumapat, review by Gabriel Scherer, + Sébastien Hinderer, and David Allsopp) + +- #9237: `Format.pp_update_geometry ppf (fun geo -> {geo with ...})` + for formatter geometry changes that are robust to new geometry fields. + (Gabriel Scherer, review by Josh Berdine and Florian Angeletti) + +- #7110: Added Printf.ikbprintf and Printf.ibprintf + (Muskan Garg, review by Gabriel Scherer and Florian Angeletti) + +- #9266: Install pretty-printer for the exception Fun.Finally_raised. + (Guillaume Munch-Maccagnoni, review by Daniel Bünzli, Gabriel Radanne, + and Gabriel Scherer) + +### Other libraries: + +- #9106: Register printer for Unix_error in win32unix, as in unix. + (Christopher Zimmermann, review by David Allsopp) + +- #9183: Preserve exception backtrace of exceptions raised by top-level phrases + of dynlinked modules. + (Nicolás Ojeda Bär, review by Xavier Clerc and Gabriel Scherer) + +- #9320, #9550: under Windows, make sure that the Unix.exec* functions + properly quote their argument lists. + (Xavier Leroy, report by André Maroneze, review by Nicolás Ojeda Bär + and David Allsopp) + +- #9490, #9505: ensure proper rounding of file times returned by + Unix.stat, Unix.lstat, Unix.fstat. + (Xavier Leroy and Guillaume Melquiond, report by David Brown, + review by Gabriel Scherer and David Allsopp) + +### Tools: + +- #9283, #9455, #9457: add a new toplevel directive `#use_output ""` to + run a command and evaluate its output. + (Jérémie Dimino, review by David Allsopp) + + +- #6969: Argument -nocwd added to ocamldep + (Muskan Garg, review by Florian Angeletti) + +- #8676, #9594: turn debugger off in programs launched by the program + being debugged + (Xavier Leroy, report by Michael Soegtrop, review by Gabriel Scherer) + +- #9057: aid debugging the debugger by preserving backtraces of unhandled + exceptions. + (David Allsopp, review by Gabriel Scherer) + +- #9276: objinfo: cm[x]a print extra C options, objects and dlls in + the order given on the cli. Follow up to #4949. + (Daniel Bünzli, review by Gabriel Scherer) + +- #463: objinfo: better errors on object files coming + from a different (older or newer), incompatible compiler version. + (Gabriel Scherer, review by Gabriel Radanne and Damien Doligez) + +- #9181: make objinfo work on Cygwin and look for the caml_plugin_header + symbol in both the static and the dynamic symbol tables. + (Sébastien Hinderer, review by Gabriel Scherer and David Allsopp) + +* #9197: remove compatibility logic from #244 that was designed to + synchronize toplevel printing margins with Format.std_formatter, + but also resulted in unpredictable/fragile changes to formatter + margins. + Setting the margins on the desired formatters should now work. + typically on `Format.std_formatter`. + Note that there currently is no robust way to do this from the + toplevel, as applications may redirect toplevel printing. In + a compiler/toplevel driver, one should instead access + `Location.formatter_for_warnings`; it is not currently exposed + to the toplevel. + (Gabriel Scherer, review by Armaël Guéneau) + +- #9207, #9210: fix ocamlyacc to work correctly with up to 255 entry + points to the grammar. + (Andreas Abel, review by Xavier Leroy) + +- #9482, #9492: use diversions (@file) to work around OS limitations + on length of Sys.command argument. + (Xavier Leroy, report by Jérémie Dimino, review by David Allsopp) + +- #9552: restore ocamloptp build and installation + (Florian Angeletti, review by David Allsopp and Xavier Leroy) + +### Manual and documentation: + +- #9141: beginning of the ocamltest reference manual + (Sébastien Hinderer, review by Gabriel Scherer and Thomas Refis) + +- #9228: Various Map documentation improvements: add missing key argument in + the 'merge' example; clarify the relationship between input and output keys + in 'union'; note that find and find_opt return values, not bindings. + (Jeremy Yallop, review by Gabriel Scherer and Florian Angeletti) + +- #9255, #9300: reference chapter, split the expression grammar + (Florian Angeletti, report by Harrison Ainsworth, review by Gabriel Scherer) + +- #9325: documented base case for `List.for_all` and `List.exists` + (Glenn Slotte, review by Florian Angeletti) + +- #9410, #9422: replaced naive fibonacci example with gcd + (Anukriti Kumar, review by San Vu Ngoc, Florian Angeletti, Léo Andrès) + +- #9541: Add a documentation page for the instrumented runtime; + additional changes to option names in the instrumented runtime. + (Enguerrand Decorne, review by Anil Madhavapeddy, Gabriel Scherer, + Daniel Bünzli, David Allsopp, Florian Angeletti, + and Sébastien Hinderer) + +- #9610: manual, C FFI: naked pointers are deprecated, detail the + forward-compatible options for handling out-of-heap pointers. + (Xavier Leroy, review by Mark Shinwell, David Allsopp and Florian Angeletti) + +- #9618: clarify the Format documentation on the margin and maximum indentation + limit + (Florian Angeletti, review by Josh Berdine) + + +- #8644: fix formatting comment about @raise in stdlib's mli files + (Élie Brami, review by David Allsopp) + +- #9327, #9401: manual, fix infix attribute examples + (Florian Angeletti, report by David Cadé, review by Gabriel Scherer) + +- #9403: added a description for warning 67 and added a "." at the end of + warnings for consistency. + (Muskan Garg, review by Gabriel Scherer and Florian Angeletti) + +- #7708, #9580: Ensure Stdlib documentation index refers to Stdlib. + (Stephen Dolan, review by Florian Angeletti, report by Hannes Mehnert) + +### Compiler user-interface and warnings: + +- #9712: Update the version format to allow "~". + The new format is "major.minor[.patchlevel][(+|~)additional-info]", + for instance "4.12.0~beta1+flambda". + This is a documentation-only change for the 4.11 branch, the new format + will be used starting with the 4.12 branch. + (Florian Angeletti, review by Damien Doligez and Xavier Leroy) + +- #1664: make -output-complete-obj link the runtime native c libraries when + building shared libraries like `-output-obj`. + (Florian Angeletti, review by Nicolás Ojeda Bär) + +- #9349: Support [@inlined hint] attribute. + (Leo White, review by Stephen Dolan) + +- #2141: generate .annot files from cmt data; deprecate -annot. + (Nicolás Ojeda Bär, review by Alain Frisch, Gabriel Scherer and Damien + Doligez) + + +* #7678, #8631: ocamlc -c and ocamlopt -c pass same switches to the C + compiler when compiling .c files (in particular, this means ocamlopt + passes -fPIC on systems requiring it for shared library support). + (David Allsopp, report by Daniel Bünzli, review by Sébastien Hinderer) + +- #9074: reworded error message for non-regular structural types + (Florian Angeletti, review by Jacques Garrigue and Leo White, + report by Chas Emerick) + +- #8938: Extend ocamlopt option "-stop-after" to handle "scheduling" argument. + (Greta Yorsh, review by Florian Angeletti and Sébastien Hinderer) + +- #8945, #9086: Fix toplevel show directive to work with constructors + (Simon Parry, review by Gabriel Scherer, Jeremy Yallop, + Alain Frisch, Florian Angeletti) + +- #9107: improved error message for exceptions in module signature errors + (Gabriel Scherer, review by Florian Angeletti) + +- #9208: -dno-locations option to hide source locations (and debug events) + from intermediate-representation dumps (-dfoo). + (Gabriel Scherer, review by Vincent Laviron) + +- #9393: Improve recursive module usage warnings + (Leo White, review by Thomas Refis) + +- #9486: Fix configuration for the Haiku operating system + (Sylvain Kerjean, review by David Allsopp and Sébastien Hinderer) + +### Internal/compiler-libs changes: + +- #9021: expose compiler Longident.t parsers + (Florian Angeletti, review by Gabriel Scherer) + +- #9452: Add locations to docstring attributes + (Leo White, review by Gabriel Scherer) + + +- #463: a new Misc.Magic_number module for user-friendly parsing + and validation of OCaml magic numbers. + (Gabriel Scherer, review by Gabriel Radanne and Damien Doligez) + +- #1176: encourage better compatibility with older Microsoft C compilers by + using GCC's -Wdeclaration-after-statement when available. Introduce + Caml_inline to stop abuse of the inline keyword on MSVC and to help ensure + that only static inline is used in the codebase (erroneous instance in + runtime/win32.c removed). + (David Allsopp, review by Oliver Andrieu and Xavier Leroy) + +- #8934: Stop relying on location to track usage + (Thomas Refis, review by Gabriel Radanne) + +- #8970: separate value patterns (matching on values) from computation patterns + (matching on the effects of a copmutation) in the typedtree. + (Gabriel Scherer, review by Jacques Garrigue and Alain Frisch) + +- #9060: ensure that Misc.protect_refs preserves backtraces + (Gabriel Scherer, review by Guillaume Munch-Maccagnoni and David Allsopp) + +- #9078: make all compilerlibs/ available to ocamltest. + (Gabriel Scherer, review by Sébastien Hinderer) + +- #9079: typecore/parmatch: refactor ppat_of_type and refine + the use of backtracking on wildcard patterns + (Florian Angeletti, Jacques Garrigue, Gabriel Scherer, + review by Thomas Refis) + +- #9081: typedtree, make the pat_env field of pattern data immutable + (Gabriel Scherer, review by Jacques Garrigue, report by Alain Frisch) + +- #9178, #9182, #9196: refactor label-disambiguation (Typecore.NameChoice) + (Gabriel Scherer, Thomas Refis, Florian Angeletti and Jacques Garrigue, + reviewing each other without self-loops) + +- #9321, #9322, #9359, #9361, #9417, #9447: refactor the + pattern-matching compiler + (Thomas Refis and Gabriel Scherer, review by Florian Angeletti) + +- #9211, #9215, #9222: fix Makefile dependencies in + compilerlibs, dynlink, ocamltest. + (Gabriel Scherer, review by Vincent Laviron and David Allsopp) + +- #9305: Avoid polymorphic compare in Ident + (Leo White, review by Xavier Leroy and Gabriel Scherer) + +- #7927: refactor val_env met_env par_env to class_env + (Muskan Garg, review by Gabriel Scherer and Florian Angeletti) + +- #2324, #9613: Replace the caml_int_compare and caml_float_compare + (C functions) with primitives. + (Greta Yorsh, review by Stephen Dolan and Vincent Laviron) + +- #9246: Avoid rechecking functor applications + (Leo White, review by Jacques Garrigue) + +- #9402: Remove `sudo:false` from .travis.yml + (Hikaru Yoshimura) + +* #9411: forbid optional arguments reordering with -nolabels + (Thomas Refis, review by Frédéric Bour and Jacques Garrigue) + +- #9414: testsuite, ocamltest: keep test artifacts only on failure. + Use KEEP_TEST_DIR_ON_SUCCESS=1 to keep all artifacts. + (Gabriel Scherer, review by Sébastien Hinderer) + + +### Build system: + +- #9250: Add --disable-ocamltest to configure and disable building for + non-development builds. + (David Allsopp, review by Sébastien Hinderer) + +### Bug fixes: + +- #7520, #9547: Odd behaviour of refutation cases with polymorphic variants + (Jacques Garrigue, report by Leo White, reviews by Gabriel Scherer and Leo) + +- #7562, #9456: ocamlopt-generated code crashed on Alpine Linux on + ppc64le, arm, and i386. Fixed by turning PIE off for musl-based Linux + systems except amd64 (x86_64) and s390x. + (Xavier Leroy, review by Gabriel Scherer) + +- #7683, #1499: Fixes one case where the evaluation order in native-code + may not match the one in bytecode. + (Nicolás Ojeda Bär, report by Pierre Chambart, review by Gabriel Scherer) + +- #7696, #6608: Record expression deleted when all fields specified + (Jacques Garrigue, report by Jeremy Yallop) + +- #7741, #9645: Failure to report escaping type variable + (Jacques Garrigue, report by Gabriel Radanne, review by Gabriel Scherer) + +- #7817, #9546: Unsound inclusion check for polymorphic variant + (Jacques Garrigue, report by Mikhail Mandrykin, review by Gabriel Scherer) + +- #7897, #9537: Fix warning 38 for rebound extension constructors + (Leo White, review by Florian Angeletti) + +- #7917, #9426: Use GCC option -fexcess-precision=standard when available, + avoiding a problem with x87 excess precision in Float.round. + (Xavier Leroy, review by Sébastien Hinderer) + +- #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) + +- #9064: Relax the level handling when unifying row fields + (Leo White, review by Jacques Garrigue) + +- #9097: Do not emit references to dead labels introduced by #2321 (spacetime). + (Greta Yorsh, review by Mark Shinwell) + +- #9163: Treat loops properly in un_anf + (Leo White, review by Mark Shinwell, Pierre Chambart and Vincent Laviron) + +- #9189, #9281: fix a conflict with Gentoo build system + by removing an one-letter Makefile variable. + (Florian Angeletti, report by Ralph Seichter, review by David Allsopp + and Damien Doligez) + +- #9225: Do not drop bytecode debug info after C calls. + (Stephen Dolan, review by Gabriel Scherer and Jacques-Henri Jourdan) + +- #9231: Make sure a debug event (and the corresponding debug + information) is inserted after every primitive that can appear in a + collected call stack, and make sure ocamlc preserves such events + even if they are at tail position. + (Jacques-Henri Jourdan, review by Gabriel Scherer) + +- #9244: Fix some missing usage warnings + (Leo White, review by Florian Angeletti) + +- #9274, avoid reading cmi file while printing types + (Florian Angeletti, review by Gabriel Scherer) + +- #9307, #9345: reproducible env summaries for reproducible compilation + (Florian Angeletti, review by Leo White) + +- #9309, #9318: Fix exhaustivity checking with empty types + (Florian Angeletti, Stefan Muenzel and Thomas Refis, review by Gabriel Scherer + and Thomas Refis) + +- #9335: actually have --disable-stdlib-manpages not build the manpages + (implementation conflicted with #8837 which wasn't picked up in review) + (David Allsopp, review by Florian Angeletti and Sébastien Hinderer) + +- #9343: Re-enable `-short-paths` for some error messages + (Leo White, review by Florian Angeletti) + +- #9355, #9356: ocamldebug, fix a fatal error when printing values + whose type involves a functor application. + (Florian Angeletti, review by Gabriel Scherer, report by Cyril Six) + +- #9367: Make bytecode and native-code backtraces agree. + (Stephen Dolan, review by Gabriel Scherer) + +- #9375, #9477: add forgotten substitution when compiling anonymous modules + (Thomas Refis, review by Frédéric Bour, report by Andreas Hauptmann) + +- #9384, #9385: Fix copy scope bugs in substitutions + (Leo White, review by Thomas Refis, report by Nick Roberts) + +* #9388: Prohibit signature local types with constraints + (Leo White, review by Jacques Garrigue) + +- #9406, #9409: fix an error with packed module types from missing + cmis. + (Florian Angeletti, report by Thomas Leonard, review by Gabriel Radanne + and Gabriel Scherer) + +- #9415: Treat `open struct` as `include struct` in toplevel + (Leo White, review by Thomas Refis) + +- #9416: Avoid warning 58 in flambda ocamlnat + (Leo White, review by Florian Angeletti) + +- #9420: Fix memory leak when `caml_output_value_to_block` raises an exception + (Xavier Leroy, review by Guillaume Munch-Maccagnoni) + +- #9428: Fix truncated exception backtrace for C->OCaml callbacks + on Power and Z System + (Xavier Leroy, review by Nicolás Ojeda Bär) + +- #9623, #9642: fix typing environments in Typedecl.transl_with_constraint + (Gabriel Scherer, review by Jacques Garrigue and Leo White, + report by Hugo Heuzard) + +- #9695, #9702: no error when opening an alias to a missing module + (Jacques Garrigue, report and review by Gabriel Scherer) + +- #9714, #9724: Add a terminator to the `caml_domain_state` structure + to better ensure that members are correctly spaced. + (Antonin Décimo, review by David Allsopp and Xavier Leroy) + +OCaml 4.10 maintenance branch +----------------------------- + +### Runtime system: + +- #9344, #9368: Disable exception backtraces in bytecode programs + built with "-output-complete-exe". At the moment, such programs do + not embed debug information and exception backtraces where causing + them to crash. + (Jérémie Dimino, review by Nicolás Ojeda Bär) + +### Build system: + +- #9531: fix support for the BFD library on FreeBSD + (Hannes Mehnert, review by Gabriel Scherer and David Allsopp) + +### Bug fixes: + +- #9068, #9437: ocamlopt -output-complete-obj failure on FreeBSD 12 + (Xavier Leroy, report by Hannes Mehnert, review by Sébastien Hinderer) + +- #9165, #9840: Add missing -function-sections flag in Makefiles. + (Greta Yorsh, review by David Allsopp) + +- #9495: fix a bug where bytecode binaries compiled with `-output-complete-exe` + would not execute `at_exit` hooks at program termination (in particular, + output channels would not be flushed). + (Nicolás Ojeda Bär, review by David Allsopp) + +- #9714, #9724: Use the C++ alignas keyword when compiling in C++. + Fixes a bug with MSVC C++ 2015/2017. Add a terminator to the + `caml_domain_state` structure to better ensure that members are + correctly spaced. + (Antonin Décimo, review by David Allsopp and Xavier Leroy) + +- #9736, #9749: Compaction must start in a heap where all free blocks are + blue, which was not the case with the best-fit allocator. + (Damien Doligez, report and review by Leo White) + +OCaml 4.10.0 (21 February 2020) +------------------------------- + +(Changes that can break existing programs are marked with a "*") + +### Language features + +- #7757, #1726: multi-indices for extended indexing operators: + `a.%{0;1;2}` desugars to `( .%{ ;.. } ) a [|0;1;2|]` + (Florian Angeletti, review by Gabriel Radanne) + +* #1859, #9117: enforce safe (immutable) strings by removing + the -unsafe-string option by default. This can be overridden by + a configure-time option (available since 4.04 in 2016): + --disable-force-safe-string since 4.08, -no-force-safe-since + between 4.07 and 4.04. + In the force-safe-string mode (now the default), the return type of the + String_val macro in C stubs is `const char*` instead of + `char*`. This change may break C FFI code. + (Kate Deplaix) + + +- #6662, #8908: allow writing "module _ = E" to ignore module expressions + (Thomas Refis, review by Gabriel Radanne) + +### Runtime system: + +- #8809, #9292: Add a best-fit allocator for the major heap; still + experimental, it should be much better than current allocation + policies (first-fit and next-fit) for programs with large heaps, + reducing both GC cost and memory usage. + This new best-fit is not (yet) the default; set it explicitly with + OCAMLRUNPARAM="a=2" (or Gc.set from the program). You may also want + to increase the `space_overhead` parameter of the GC (a percentage, + 80 by default), for example OCAMLRUNPARAM="o=85", for optimal + speed. + (Damien Doligez, review by Stephen Dolan, Jacques-Henri Jourdan, + Xavier Leroy, Leo White) + +* #8713, #8940, #9115, #9143, #9202, #9251: + Introduce a state table in the runtime to contain the global variables. + (The Multicore runtime will have one such state for each domain.) + + This changes the status of some internal variables of the OCaml runtime; + in many cases the header file originally defining the internal variable + provides a compatibility macro with the old name, but programs + re-defining those variables by hand need to be fixed. + + (KC Sivaramakrishnan and Stephen Dolan, + compatibility hacking by David Allsopp, Florian Angeletti, Kate Deplaix, + Jacques Garrigue, Guillaume Munch-Maccagnoni and Nicolás Ojeda Bär, + review by David Allsopp, Alain Frisch, Nicolás Ojeda Bär, + Gabriel Scherer, Damien Doligez, and Guillaume Munch-Maccagnoni) + +- #8993: New C functions caml_process_pending_actions{,_exn} in + caml/signals.h, intended for executing all pending actions inside + long-running C functions (requested minor and major collections, + signal handlers, finalisers, and memprof callbacks). The function + caml_process_pending_actions_exn returns any exception arising + during their execution, allowing resources to be cleaned-up before + re-raising. + (Guillaume Munch-Maccagnoni, review by Jacques-Henri Jourdan, + Stephen Dolan, and Gabriel Scherer) + +* #8691, #8897, #9027: Allocation functions are now guaranteed not to + trigger any OCaml callback when called from C. In long-running C + functions, this can be replaced with calls to + caml_process_pending_actions at safe points. + Side effect of this change: in bytecode mode, polling for + asynchronous callbacks is performed at every minor heap allocation, + in addition to function calls and loops as in previous OCaml + releases. + (Jacques-Henri Jourdan, review by Stephen Dolan, Gabriel Scherer and + Guillaume Munch-Maccagnoni) + +* #9037: caml_check_urgent_gc is now guaranteed not to trigger any + finaliser. In long-running C functions, this can be replaced + with calls to caml_process_pending_actions at safe points. + (Guillaume Munch-Maccagnoni, review by Jacques-Henri Jourdan and + Stephen Dolan) + + +- #8619: Ensure Gc.minor_words remains accurate after a GC. + (Stephen Dolan, Xavier Leroy and David Allsopp, + review by Xavier Leroy and Gabriel Scherer) + +- #8667: Limit GC credit to 1.0 + (Leo White, review by Damien Doligez) + +- #8670: Fix stack overflow detection with systhreads + (Stephen Dolan, review by Xavier Leroy, Anil Madhavapeddy, Gabriel Scherer, + Frédéric Bour and Guillaume Munch-Maccagnoni) + +* #8711: The major GC hooks are no longer allowed to interact with the + OCaml heap. + (Jacques-Henri Jourdan, review by Damien Doligez) + +- #8630: Use abort() instead of exit(2) in caml_fatal_error, and add + the new hook caml_fatal_error_hook. + (Jacques-Henri Jourdan, review by Xavier Leroy) + +- #8641: Better call stacks when a C call is involved in byte code mode + (Jacques-Henri Jourdan, review by Xavier Leroy) + +- #8634, #8668, #8684, #9103 (originally #847): Statistical memory profiling. + In OCaml 4.10, support for allocations in the minor heap in native + mode is not available, and callbacks for promotions and + deallocations are not available. + Hence, there is not any public API for this feature yet. + (Jacques-Henri Jourdan, review by Stephen Dolan, Gabriel Scherer + and Damien Doligez) + +- #9268, #9271: Fix bytecode backtrace generation with large integers present. + (Stephen Dolan and Mark Shinwell, review by Gabriel Scherer and + Jacques-Henri Jourdan) + +### Standard library: + +- #8760: List.concat_map : ('a -> 'b list) -> 'a list -> 'b list + (Gabriel Scherer, review by Daniel Bünzli and Thomas Refis) + +- #8832: List.find_map : ('a -> 'b option) -> 'a list -> 'b option + (Gabriel Scherer, review by Jeremy Yallop, Nicolás Ojeda Bär + and Daniel Bünzli) + +- #7672, #1492: Add `Filename.quote_command` to produce properly-quoted + commands for execution by Sys.command. + (Xavier Leroy, review by David Allsopp and Damien Doligez) + +- #8971: Add `Filename.null`, the conventional name of the "null" device. + (Nicolás Ojeda Bär, review by Xavier Leroy and Alain Frisch) + +- #8651: add '%#F' modifier in printf to output OCaml float constants + in hexadecimal + (Pierre Roux, review by Gabriel Scherer and Xavier Leroy) + + +- #8657: Optimization in [Array.make] when initializing with unboxed + or young values. + (Jacques-Henri Jourdan, review by Gabriel Scherer and Stephen Dolan) + +- #8716: Optimize [Array.fill] and [Hashtbl.clear] with a new runtime primitive + (Alain Frisch, review by David Allsopp, Stephen Dolan and Damien Doligez) + +- #8530: List.sort: avoid duplicate work by chop + (Guillaume Munch-Maccagnoni, review by David Allsopp, Damien Doligez and + Gabriel Scherer) + +### Other libraries: + +- #1939, #2023: Implement Unix.truncate and Unix.ftruncate on Windows. + (Florent Monnier and Nicolás Ojeda Bär, review by David Allsopp) + +### Code generation and optimizations: + +- #8806: Add an [@@immediate64] attribute for types that are known to + be immediate only on 64 bit platforms + (Jérémie Dimino, review by Vladimir Keleshev) + +- #9028, #9032: Fix miscompilation by no longer assuming that + untag_int (tag_int x) = x in Cmmgen; the compilation of `(n lsl 1) + 1`, + for example, would be incorrect if evaluated with a large value for `n`. + (Stephen Dolan, review by Vincent Laviron and Xavier Leroy) + +- #8672: Optimise Switch code generation on booleans. + (Stephen Dolan, review by Pierre Chambart) + + +- #8990: amd64: Emit 32bit registers for Iconst_int when we can + (Xavier Clerc, Tom Kelly and Mark Shinwell, review by Xavier Leroy) + +- #2322: Add pseudo-instruction `Ladjust_trap_depth` to replace + dummy Lpushtrap generated in linearize + (Greta Yorsh and Vincent Laviron, review by Xavier Leroy) + +- #8707: Simplif: more regular treatment of Tupled and Curried functions + (Gabriel Scherer, review by Leo White and Alain Frisch) + +- #8526: Add compile-time option -function-sections in ocamlopt to emit + each function in a separate named text section on supported targets. + (Greta Yorsh, review by Pierre Chambart) + +- #2321: Eliminate dead ICatch handlers + (Greta Yorsh, review by Pierre Chambart and Vincent Laviron) + +- #8919: lift mutable lets along with immutable ones + (Leo White, review by Pierre Chambart) + +- #8909: Graph coloring register allocator: the weights put on + preference edges should not be divided by 2 in branches of + conditional constructs, because it is not good for performance + and because it leads to ignoring preference edges with 0 weight. + (Eric Stavarache, review by Xavier Leroy) + +- #9006: int32 code generation improvements + (Stephen Dolan, designed with Greta Yorsh, review by Xavier Clerc, + Xavier Leroy and Alain Frisch) + +- #9041: amd64: Avoid stall in sqrtsd by clearing destination. + (Stephen Dolan, with thanks to Andrew Hunter, Will Hasenplaugh, + Spiros Eliopoulos and Brian Nigito. Review by Xavier Leroy) + +- #2165: better unboxing heuristics for let-bound identifiers + (Alain Frisch, review by Vincent Laviron and Gabriel Scherer) + +- #8735: unbox across static handlers + (Alain Frisch, review by Vincent Laviron and Gabriel Scherer) + +### Manual and documentation: + +- #8718, #9089: syntactic highlighting for code examples in the manual + (Florian Angeletti, report by Anton Kochkov, review by Gabriel Scherer) + +- #9101: add links to section anchor before the section title, + make the name of those anchor explicits. + (Florian Angeletti, review by Daniel Bünzli, Sébastien Hinderer, + and Gabriel Scherer) + +- #9257, cautionary guidelines for using the internal runtime API + without too much updating pain. + (Florian Angeletti, review by Daniel Bünzli, Guillaume Munch-Maccagnoni + and KC Sivaramakrishnan) + + +- #8950: move local opens in pattern out of the extension chapter + (Florian Angeletti, review and suggestion by Gabriel Scherer) + +- #9088, #9097: fix operator character classes + (Florian Angeletti, review by Gabriel Scherer, + report by Clément Busschaert) + +- #9169: better documentation for the best-fit allocation policy + (Gabriel Scherer, review by Guillaume Munch-Maccagnoni + and Florian Angeletti) + +### Compiler user-interface and warnings: + +- #8833: Hint for (type) redefinitions in toplevel session + (Florian Angeletti, review by Gabriel Scherer) + +- #2127, #9185: Refactor lookup functions + Included observable changes: + - makes the location of usage warnings and alerts for constructors more + precise + - don't warn about a constructor never being used to build values when it + has been defined as private + (Leo White, Hugo Heuzard review by Thomas Refis, Florian Angeletti) + +- #8702, #8777: improved error messages for fixed row polymorphic variants + (Florian Angeletti, report by Leo White, review by Thomas Refis) + +- #8844: Printing faulty constructors, inline records fields and their types + during type mismatches. Also slightly changed other type mismatches error + output. + (Mekhrubon Turaev, review by Florian Angeletti, Leo White) + +- #8885: Warn about unused local modules + (Thomas Refis, review by Alain Frisch) + +- #8872: Add ocamlc option "-output-complete-exe" to build a self-contained + binary for bytecode programs, containing the runtime and C stubs. + (Stéphane Glondu, Nicolás Ojeda Bär, review by Jérémie Dimino and Daniel + Bünzli) + +- #8874: add tests for typechecking error messages and pack them into + pretty-printing boxes. + (Oxana Kostikova, review by Gabriel Scherer) + +- #8891: Warn about unused functor parameters + (Thomas Refis, review by Gabriel Radanne) + +- #8903: Improve errors for first-class modules + (Leo White, review by Jacques Garrigue) + +- #8914: clarify the warning on unboxable types used in external primitives (61) + (Gabriel Scherer, review by Florian Angeletti, report on the Discourse forum) + +- #9046: disable warning 30 by default + This outdated warning complained on label/constructor name conflicts + within a mutually-recursive type declarations; there is now no need + to complain thanks to type-based disambiguation. + (Gabriel Scherer) + +### Tools: + +* #6792, #8654 ocamldebug now supports programs using Dynlink. This + changes ocamldebug messages, which may break compatibility + with older emacs modes. + (whitequark and Jacques-Henri Jourdan, review by Gabriel Scherer + and Xavier Clerc) + +- #8621: Make ocamlyacc a Windows Unicode application + (David Allsopp, review by Nicolás Ojeda Bär) + +* #8834, `ocaml`: adhere to the XDG base directory specification to + locate an `.ocamlinit` file. Reads an `$XDG_CONFIG_HOME/ocaml/init.ml` + file before trying to lookup `~/.ocamlinit`. On Windows the behaviour + is unchanged. + (Daniel C. Bünzli, review by David Allsopp, Armaël Guéneau and + Nicolás Ojeda Bär) + +- #9113: ocamldoc: fix the rendering of multi-line code blocks + in the 'man' backend. + (Gabriel Scherer, review by Florian Angeletti) + +- #9127, #9130: ocamldoc: fix the formatting of closing brace in record types. + (David Allsopp, report by San Vu Ngoc) + +### Build system: + +- #8840: use ocaml{c,opt}.opt when available to build internal tools + On my machine this reduces parallel-build times from 3m30s to 2m50s. + (Gabriel Scherer, review by Xavier Leroy and Sébastien Hinderer) + +- #8650: ensure that "make" variables are defined before use; + revise generation of config/util.ml to better quote special characters + (Xavier Leroy, review by David Allsopp) + +- #8690, #8696: avoid rebuilding the world when files containing primitives + change. + (Stephen Dolan, review by Gabriel Scherer, Sébastien Hinderer and + Thomas Refis) + +- #8835: new configure option --disable-stdlib-manpages to disable building + and installation of the library manpages. + (David Allsopp, review by Florian Angeletti and Gabriel Scherer) + +- #8837: build manpages using ocamldoc.opt when available + cuts the manpages build time from 14s to 4s + (Gabriel Scherer, review by David Allsopp and Sébastien Hinderer, + report by David Allsopp) + +- #8843, #8841: fix use of off_t on 32-bit systems. + (Stephen Dolan, report by Richard Jones, review by Xavier Leroy) + +- #8947, #9134, #9302, #9311: fix/improve support for the BFD library + (Sébastien Hinderer, review by Damien Doligez and David Allsopp) + +- #8951: let make's default target build the compiler + (Sébastien Hinderer, review by David Allsopp) + +- #8995: allow developers to specify frequently-used configure options in + Git (ocaml.configure option) and a directory for host-specific, shareable + config.cache files (ocaml.configure-cache option). See HACKING.adoc for + further details. + (David Allsopp, review by Gabriel Scherer) + +- #9136: Don't propagate Cygwin-style prefix from configure to + Makefile.config on Windows ports. + (David Allsopp, review by Sébastien Hinderer) + +### Internal/compiler-libs changes: + +- #8828: Added abstractions for variants, records, constructors, fields and + extension constructor types mismatch. + (Mekhrubon Turaev, review by Florian Angeletti, Leo White and Gabriel Scherer) + +- #7927, #8527: Replace long tuples into records in typeclass.ml + (Ulugbek Abdullaev, review by David Allsopp and Gabriel Scherer) + +- #1963: split cmmgen into generic Cmm helpers and clambda transformations + (Vincent Laviron, review by Mark Shinwell) + +- #1901: Fix lexing of character literals in comments + (Pieter Goetschalckx, review by Damien Doligez) + +- #1932: Allow octal escape sequences and identifiers containing apostrophes + in ocamlyacc actions and comments. + (Pieter Goetschalckx, review by Damien Doligez) + +- #2288: Move middle end code from [Asmgen] to [Clambda_middle_end] and + [Flambda_middle_end]. Run [Un_anf] from the middle end, not [Cmmgen]. + (Mark Shinwell, review by Pierre Chambart) + +- #8692: Remove Misc.may_map and similar + (Leo White, review by Gabriel Scherer and Thomas Refis) + +- #8677: Use unsigned comparisons in amd64 and i386 emitter of Lcondbranch3. + (Greta Yorsh, review by Xavier Leroy) + +- #8766: Parmatch: introduce a type for simplified pattern heads + (Gabriel Scherer and Thomas Refis, review by Stephen Dolan and + Florian Angeletti) + +- #8774: New implementation of Env.make_copy_of_types + (Alain Frisch, review by Thomas Refis, Leo White and Jacques Garrigue) + +- #7924: Use a variant instead of an int in Bad_variance exception + (Rian Douglas, review by Gabriel Scherer) + +- #8890: in -dtimings output, show time spent in C linker clearly + (Valentin Gatien-Baron) + +- #8910, #8911: minor improvements to the printing of module types + (Gabriel Scherer, review by Florian Angeletti) + +- #8913: ocamltest: improve 'promote' implementation to take + skipped lines/bytes into account + (Gabriel Scherer, review by Sébastien Hinderer) + +- #8908: Use an option instead of a string for module names ("_" becomes None), + and a dedicated type for functor parameters: "()" maps to "Unit" (instead of + "*"). + (Thomas Refis, review by Gabriel Radanne) + +- #8928: Move contains_calls and num_stack_slots from Proc to Mach.fundecl + (Greta Yorsh, review by Florian Angeletti and Vincent Laviron) + +- #8959, #8960, #8968, #9023: minor refactorings in the typing of patterns: + + refactor the {let,pat}_bound_idents* functions + + minor bugfix in type_pat + + refactor the generic pattern-traversal functions + in Typecore and Typedtree + + restrict the use of Need_backtrack + (Gabriel Scherer and Florian Angeletti, + review by Thomas Refis and Gabriel Scherer) + +- #9030: clarify and document the parameter space of type_pat + (Gabriel Scherer and Florian Angeletti and Jacques Garrigue, + review by Florian Angeletti and Thomas Refis) + +- #8975: "ocamltests" files are no longer required or used by + "ocamltest". Instead, any text file in the testsuite directory containing a + valid "TEST" block will be automatically included in the testsuite. + (Nicolás Ojeda Bär, review by Gabriel Scherer and Sébastien Hinderer) + +- #8992: share argument implementations between executables + (Florian Angeletti, review by Gabriel Scherer) + +- #9015: fix fatal error in pprint_ast (#8789) + (Damien Doligez, review by Thomas Refis) + +### Bug fixes: + +- #5673, #7636: unused type variable causes generalization error + (Jacques Garrigue and Leo White, review by Leo White, + reports by Jean-Louis Giavitto and Christophe Raffalli) + +- #6922, #8955: Fix regression with -principal type inference for inherited + methods, allowing to compile ocamldoc with -principal + (Jacques Garrigue, review by Leo White) + +- #7925, #8611: fix error highlighting for exceptionally + long toplevel phrases + (Kyle Miller, reported by Armaël Guéneau, review by Armaël Guéneau + and Nicolás Ojeda Bär) + +- #8622: Don't generate #! headers over 127 characters. + (David Allsopp, review by Xavier Leroy and Stephen Dolan) + +- #8715: minor bugfixes in CamlinternalFormat; removes the unused + and misleading function CamlinternalFormat.string_of_formatting_gen + (Gabriel Scherer and Florian Angeletti, + review by Florian Angeletti and Gabriel Radanne) + +- #8792, #9018: Possible (latent) bug in Ctype.normalize_type + removed incrimined Btype.log_type, replaced by Btype.set_type + (Jacques Garrigue, report by Alain Frisch, review by Thomas Refis) + +- #8856, #8860: avoid stackoverflow when printing cyclic type expressions + in some error submessages. + (Florian Angeletti, report by Mekhrubon Turaev, review by Leo White) + +- #8875: fix missing newlines in the output from MSVC invocation. + (Nicolás Ojeda Bär, review by Gabriel Scherer) + +- #8921, #8924: Fix stack overflow with Flambda + (Vincent Laviron, review by Pierre Chambart and Leo White, + report by Aleksandr Kuzmenko) + +- #8892, #8895: fix the definition of Is_young when CAML_INTERNALS is not + defined. + (David Allsopp, review by Xavier Leroy) + +- #8896: deprecate addr typedef in misc.h + (David Allsopp, suggestion by Xavier Leroy) + +- #8981: Fix check for incompatible -c and -o options. + (Greta Yorsh, review by Damien Doligez) + +- #9019, #9154: Unsound exhaustivity of GADTs from incomplete unification + Also fixes bug found by Thomas Refis in #9012 + (Jacques Garrigue, report and review by Leo White, Thomas Refis) + +- #9031: Unregister Windows stack overflow handler while shutting + the runtime down. + (Dmitry Bely, review by David Allsopp) + +- #9051: fix unregistered local root in win32unix/select.c (could result in + `select` returning file_descr-like values which weren't in the original sets) + and correct initialisation of some blocks allocated with caml_alloc_small. + (David Allsopp, review by Xavier Leroy) + +- #9073, #9120: fix incorrect GC ratio multiplier when allocating custom blocks + with caml_alloc_custom_mem in runtime/custom.c + (Markus Mottl, review by Gabriel Scherer and Damien Doligez) + +- #9209, #9212: fix a development-version regression caused by #2288 + (Kate Deplaix and David Allsopp, review by Sébastien Hinderer + and Gabriel Scherer ) + +- #9218, #9269: avoid a rare wrong module name error with "-annot" and + inline records. + (Florian Angeletti, review by Gabriel Scherer, report by Kate Deplaix) + +- #9261: Fix a soundness bug in Rec_check, new in 4.10 (from #8908) + (Vincent Laviron, review by Jeremy Yallop and Gabriel Scherer) + +- #9389: returns exit_code for better user response on linking_error + (Anukriti Kumar, review by Gabriel Scherer and sliquister) + +OCaml 4.09 maintenance branch +----------------------------- + +### Build system: + +- #9383: Don't assume that AWKPATH includes . + (David Allsopp, report by Ian Zimmerman) + +OCaml 4.09.1 (16 Mars 2020) +--------------------------- + +- #8855, #8858: Links for tools not created when installing with + --disable-installing-byecode-programs (e.g. ocamldep.opt installed, but + ocamldep link not created) + (David Allsopp, report by Thomas Leonard) + +- #8953, #8954: Fix error submessages in the toplevel: do not display + dummy locations + (Armaël Guéneau, review by Gabriel Scherer) + +- #8965, #8979: Alpine build failure caused by check-parser-uptodate-or-warn.sh + (Gabriel Scherer and David Allsopp, report by Anton Kochkov) + +- #8985, #8986: fix generation of the primitives when the locale collation is + incompatible with C. + (David Allsopp, review by Nicolás Ojeda Bär, report by Sebastian Rasmussen) + +- #9050, #9076: install missing compilerlibs/ocamlmiddleend archives + (Gabriel Scherer, review by Florian Angeletti, report by Olaf Hering) + +- #9144, #9180: multiple definitions of global variables in the C runtime, + causing problems with GCC 10.0 and possibly with other C compilers + (Xavier Leroy, report by Jürgen Reuter, review by Mark Shinwell) + +- #9180: pass -fno-common option to C compiler when available, + so as to detect problematic multiple definitions of global variables + in the C runtime + (Xavier Leroy, review by Mark Shinwell) + +- #9128: Fix a bug in bytecode mode which could lead to a segmentation + fault. The bug was caused by the fact that the atom table shared a + page with some bytecode. The fix makes sure both the atom table and + the minor heap have their own pages. + (Jacques-Henri Jourdan, review by Stephen Dolan, Xavier Leroy and + Gabriel Scherer) + +OCaml 4.09.0 (19 September 2019) +-------------------------------- + +### Runtime system: + +* #1725, #2279: Deprecate Obj.set_tag and Obj.truncate + (Stephen Dolan, review by Gabriel Scherer, Damien Doligez and Xavier Leroy) + +* #2240: Constify "identifier" in struct custom_operations + (Cedric Cellier, review by Xavier Leroy) + +* #2293: Constify "caml_named_value" + (Stephen Dolan, review by Xavier Leroy) + +- #8787, #8788: avoid integer overflow in caml_output_value_to_bytes + (Jeremy Yallop, report by Marcello Seri) + + +- #2075, #7729: rename _T macro used to support Unicode in the (Windows) runtime + in order to avoid compiler warning + (Nicolás Ojeda Bär, review by Gabriel Scherer and David Allsopp) + +- #2250: Remove extra integer sign-extension in compare functions + (Stefan Muenzel, review by Xavier Leroy) + +- #8607: Remove obsolete macros for pre-2002 MSVC support + (Stephen Dolan, review by Nicolás Ojeda Bär and David Allsopp) + +- #8656: Fix a bug in [caml_modify_generational_global_root] + (Jacques-Henri Jourdan, review by Gabriel Scherer) + +### Standard library: + +- #2262: take precision (.) and flags ('+' and ' ') into account + in printf %F + (Pierre Roux, review by Gabriel Scherer) + +- #6148, #8596: optimize some buffer operations + (Damien Doligez, reports by John Whitington and Alain Frisch, + review by Jeremy Yallop and Gabriel Scherer) + +### Other libraries: + +* #2318: Delete the graphics library. This library is now available + as a separate "graphics" package in opam. Its new home is: + https://github.com/ocaml/graphics + (Jérémie Dimino, review by Nicolás Ojeda Bär, Xavier Leroy and + Sébastien Hinderer) + +* #2289: Delete the vmthreads library. This library was deprecated in 4.08.0. + (Jérémie Dimino) + +- #2112: Fix Thread.yield unfairness with busy threads yielding to each + other. + (Andrew Hunter, review by Jacques-Henri Jourdan, Spiros Eliopoulos, Stephen + Weeks, & Mark Shinwell) + +- #7903, #2306: Make Thread.delay interruptible by signals again + (Xavier Leroy, review by Jacques-Henri Jourdan and Edwin Török) + +- #2248: Unix alloc_sockaddr: Fix read of uninitialized memory for an + unbound Unix socket. Add support for receiving abstract (Linux) socket paths. + (Tim Cuthbertson, review by Sébastien Hinderer and Jérémie Dimino) + +### Compiler user-interface and warnings: + +* #2276: Remove support for compiler plugins and hooks (also adds + [Dynlink.unsafe_get_global_value]) + (Mark Shinwell, Xavier Clerc, review by Nicolás Ojeda Bär, + Florian Angeletti, David Allsopp and Xavier Leroy) + +- #2301: Hint on type error on int literal + (Jules Aguillon, review by Nicolás Ojeda Bär , Florian Angeletti, + Gabriel Scherer and Armaël Guéneau) + +* #2314: Remove support for gprof profiling. + (Mark Shinwell, review by Xavier Clerc and Stephen Dolan) + +- #2190: fix pretty printing (using Pprintast) of "lazy ..." patterns and + "fun (type t) -> ..." expressions. + (Nicolás Ojeda Bär, review by Gabriel Scherer) + +- #2277: Use newtype names as type variable names + The inferred type of (fun (type t) (x : t) -> x) + is now printed as ('t -> 't) rather than ('a -> 'a). + (Matthew Ryan) + + +- #2309: New options -with-runtime and -without-runtime in ocamlopt/ocamlc + that control the inclusion of the runtime system in the generated program. + (Lucas Pluvinage, review by Daniel Bünzli, Damien Doligez, David Allsopp + and Florian Angeletti) + +- #3819, #8546 more explanations and tests for illegal permutation + (Florian Angeletti, review by Gabriel Scherer) + +- #8537: fix the -runtime-variant option for bytecode + (Damien Doligez, review by David Allsopp) + +- #8541: Correctly print multi-lines locations + (Louis Roché, review by Gabriel Scherer) + +- #8579: Better error message for private constructors + of an extensible variant type + (Guillaume Bury, review by many fine eyes) + +### Code generation and optimizations: + +- #2278: Remove native code generation support for 32-bit Intel macOS, + iOS and other Darwin targets. + (Mark Shinwell, review by Nicolás Ojeda Bär and Xavier Leroy) + +- #8547: Optimize matches that are an affine function of the input. + (Stefan Muenzel, review by Alain Frisch, Gabriel Scherer) + + +- #1904, #7931: Add FreeBSD/aarch64 support + (Greg V, review by Sébastien Hinderer, Stephen Dolan, Damien Doligez + and Xavier Leroy) + +- #8507: Shorten symbol names of anonymous functions in Flambda mode + (the directory portions are now hidden) + (Mark Shinwell, review by Nicolás Ojeda Bär) + +- #8681, #8699, #8712: Fix code generation with nested let rec of functions. + (Stephen Dolan, Leo White, Gabriel Scherer and Pierre Chambart, + review by Gabriel Scherer, reports by Alexey Solovyev and Jonathan French) + +### Manual and documentation: + +- #7584, #8538: Document .cmt* files in the "overview" of ocaml{c,opt} + (Oxana Kostikova, rewiew by Florian Angeletti) + + +- #8757: Rename Pervasives to Stdlib in core library documentation. + (Ian Zimmerman, review by David Allsopp) + +- #8515: manual, precise constraints on reexported types + (Florian Angeletti, review by Gabriel Scherer) + +- #9327, #9401: manual, fix infix attribute examples + (Florian Angeletti, report by David Cadé, review by Gabriel Scherer) + +### Tools: + +- #2221: ocamldep will now correctly allow a .ml file in an include directory + that appears first in the search order to shadow a .mli appearing in a later + include directory. + (Nicolás Ojeda Bär, review by Florian Angeletti) + +### Internal/compiler-libs changes: + +- #1579: Add a separate types for clambda primitives + (Pierre Chambart, review by Vincent Laviron and Mark Shinwell) + +- #1965: remove loop constructors in Cmm and Mach + (Vincent Laviron) + +- #1973: fix compilation of catches with multiple handlers + (Vincent Laviron) + +- #2228, #8545: refactoring the handling of .cmi files + by moving the logic from Env to a new module Persistent_env + (Gabriel Scherer, review by Jérémie Dimino and Thomas Refis) + +- #2229: Env: remove prefix_idents cache + (Thomas Refis, review by Frédéric Bour and Gabriel Scherer) + +- #2237, #8582: Reorder linearisation of Trywith to avoid a call instruction + (Vincent Laviron and Greta Yorsh, additional review by Mark Shinwell; + fix in #8582 by Mark Shinwell, Xavier Leroy and Anil Madhavapeddy) + +- #2265: Add bytecomp/opcodes.mli + (Mark Shinwell, review by Nicolás Ojeda Bär) + +- #2268: Improve packing mechanism used for building compilerlibs modules + into the Dynlink libraries + (Mark Shinwell, Stephen Dolan, review by David Allsopp) + +- #2280: Don't make more Clambda constants after starting Cmmgen + (Mark Shinwell, review by Vincent Laviron) + +- #2281: Move some middle-end files around + (Mark Shinwell, review by Pierre Chambart and Vincent Laviron) + +- #2283: Add [is_prefix] and [find_and_chop_longest_common_prefix] to + [Misc.Stdlib.List] + (Mark Shinwell, review by Alain Frisch and Stephen Dolan) + +- #2284: Add various utility functions to [Misc] and remove functions + from [Misc.Stdlib.Option] that are now in [Stdlib.Option] + (Mark Shinwell, review by Thomas Refis) + +- #2286: Functorise [Consistbl] + (Mark Shinwell, review by Gabriel Radanne) + +- #2291: Add [Compute_ranges] pass + (Mark Shinwell, review by Vincent Laviron) + +- #2292: Add [Proc.frame_required] and [Proc.prologue_required]. + Move tail recursion label creation to [Linearize]. Correctly position + [Lprologue] relative to [Iname_for_debugger] operations. + (Mark Shinwell, review by Vincent Laviron) + +- #2308: More debugging information on [Cmm] terms + (Mark Shinwell, review by Stephen Dolan) + +- #7878, #8542: Replaced TypedtreeIter with tast_iterator + (Isaac "Izzy" Avram, review by Gabriel Scherer and Nicolás Ojeda Bär) + +- #8598: Replace "not is_nonexpansive" by "maybe_expansive". + (Thomas Refis, review by David Allsopp, Florian Angeletti, Gabriel Radanne, + Gabriel Scherer and Xavier Leroy) + +- #9275: Short circuit simple inclusion checks + (Leo White, review by Thomas Refis) + +### Compiler distribution build system: + +- #2267: merge generation of header programs, also fixing parallel build on + Cygwin. + (David Allsopp, review by Sébastien Hinderer) + +- #8514: Use boot/ocamlc.opt for building, if available. + (Stephen Dolan, review by Gabriel Scherer) + +### Bug fixes: + +- #8864, #8865: Fix native compilation of left shift by (word_size - 1) + (Vincent Laviron, report by Murilo Giacometti Rocha, review by Xavier Leroy) + +- #2296: Fix parsing of hexadecimal floats with underscores in the exponent. + (Hugo Heuzard and Xavier Leroy, review by Gabriel Scherer) + +- #8800: Fix soundness bug in extension constructor inclusion + (Leo White, review by Jacques Garrigue) + +- #8848: Fix x86 stack probe CFI information in caml_c_call and + caml_call_gc + (Tom Kelly, review by Xavier Leroy) + + +- #7156, #8594: make top level use custom printers if they are available + (Andrew Litteken, report by Martin Jambon, review by Nicolás Ojeda Bär, + Thomas Refis, Armaël Guéneau, Gabriel Scherer, David Allsopp) + +- #3249: ocamlmklib should reject .cmxa files + (Xavier Leroy) + +- #7937, #2287: fix uncaught Unify exception when looking for type + declaration + (Florian Angeletti, review by Jacques Garrigue) + +- #8610, #8613: toplevel printing, consistent deduplicated name for types + (Florian Angeletti, review by Thomas Refis and Gabriel Scherer, + reported by Xavier Clerc) + +- #8635, #8636: Fix a bad side-effect of the -allow-approx option of + ocamldep. It used to turn some errors into successes + (Jérémie Dimino) + +- #8701, #8725: Variance of constrained parameters causes principality issues + (Jacques Garrigue, report by Leo White, review by Gabriel Scherer) + +- #8777(partial): fix position information in some polymorphic variant + error messages about missing tags + (Florian Angeletti, review by Thomas Refis) + +- #8779, more cautious variance computation to avoid missing cmis + (Florian Angeletti, report by Antonio Nuno Monteiro, review by Leo White) + +- #8810: Env.lookup_module: don't allow creating loops + (Thomas Refis, report by Leo White, review by Jacques Garrigue) + +- #8862, #8871: subst: preserve scopes + (Thomas Refis, report by Leo White, review by Jacques Garrigue) + +- #8921, #8924: Fix stack overflow with Flambda + (Vincent Laviron, review by Pierre Chambart and Leo White, + report by Aleksandr Kuzmenko) + +- #8944: Fix "open struct .. end" on clambda backend + (Thomas Refis, review by Leo White, report by Damon Wang and Mark Shinwell) + +OCaml 4.08.1 (5 August 2019) +---------------------------- + +### Bug fixes: + +- #7887: ensure frame table is 8-aligned on ARM64 and PPC64 + (Xavier Leroy, report by Mark Hayden, review by Mark Shinwell + and Gabriel Scherer) + +- #8751: fix bug that could result in misaligned data section when compiling to + native-code on amd64. (observed with the mingw64 compiler) + (Nicolás Ojeda Bär, review by David Allsopp) + +- #8769, #8770: Fix assertion failure with -pack + (Leo White, review by Gabriel Scherer, report by Fabian @copy) + +- #8816, #8818: fix loading of packed modules with Dynlink (regression in + #2176). + (Leo White, report by Andre Maroneze, review by Gabriel Scherer) + +- #8830: configure script: fix tool prefix detection and Debian's armhf + detection + (Stéphane Glondu, review by David Allsopp) + +- #8843, #8841: fix use of off_t on 32-bit systems. + (Stephen Dolan, report by Richard Jones, review by Xavier Leroy) + +OCaml 4.08.0 (13 June 2019) +--------------------------- + +### Language features: + +- #1947: Introduce binding operators (let*, let+, and* etc.) + (Leo White, review by Thomas Refis) + +- #1892: Allow shadowing of items coming from an include + (Thomas Refis, review by Gabriel Radanne) + +- #2122: Introduce local substitutions in signatures: "type t := type_expr" + and "module M := Extended(Module).Path" + (Thomas Refis, with help and review from Leo White, and Alain Frisch) + +- #1804: New notion of "alerts" that generalizes the deprecated warning + [@@ocaml.alert deprecated "Please use bar instead!"] + [@@ocaml.alert unsafe "Please use safe_foo instead!"] + (Alain Frisch, review by Leo White and Damien Doligez) + +- #6422, #7083, #305, #1568: Allow `exception` under or-patterns + (Thomas Refis, with help and review from Alain Frisch, Gabriel Scherer, Jeremy + Yallop, Leo White and Luc Maranget) + + +- #1705: Allow @@attributes on exception declarations. + (Hugo Heuzard, review by Gabriel Radanne and Thomas Refis) + +- #1506, #2147, #2166, #2167: Extended `open` to arbitrary module + expression in structures and to applicative paths in signatures + (Runhang Li, review by Alain Frisch, Florian Angeletti, Jeremy Yallop, + Leo White and Thomas Refis) + +* #2106: .~ is now a reserved keyword, and is no longer available + for use in extended indexing operators + (Jeremy Yallop, review by Gabriel Scherer, Florian Angeletti, and + Damien Doligez) + +* #7841, #2041, #2235: allow modules from include directories + to shadow other ones, even in the toplevel; for a example, including + a directory that defines its own Result module will shadow the stdlib's. + (Jérémie Dimino, review by Alain Frisch and David Allsopp) + +### Type system: + +- #2110: Partial support for GADTs inside or-patterns; + The type equalities introduced by the GADT constructor are only + available inside the or-pattern; they cannot be used in the + right-hand-side of the clause, when both sides of the or-pattern + agree on it. + (Thomas Refis and Leo White, review by Jacques Garrigue) + +- #1826: allow expanding a type to a private abbreviation instead of + abstracting when removing references to an identifier. + (Thomas Refis and Leo White, review by Jacques Garrigue) + +- #1942, #2244: simplification of the static check + for recursive definitions + (Alban Reynaud and Gabriel Scherer, + review by Jeremy Yallop, Armaël Guéneau and Damien Doligez) + +### Standard library: + +- #2128: Add Fun module: `id, const, flip, negate, protect` + (protect is a "try_finally" combinator) + https://caml.inria.fr/pub/docs/manual-ocaml/libref/Fun.html + (Many fine eyes) + +- #2010: Add Bool module + https://caml.inria.fr/pub/docs/manual-ocaml/libref/Bool.html + (Many fine eyes) + +- #2011: Add Int module + https://caml.inria.fr/pub/docs/manual-ocaml/libref/Int.html + (Many fine eyes) + +- #1940: Add Option module and Format.pp_print_option + `none, some, value, get, bind, join, map, fold, iter`, etc. + https://caml.inria.fr/pub/docs/manual-ocaml/libref/Option.html + (Many fine eyes) + +- #1956: Add Result module and Format.pp_print_result + `ok, error, value, get_ok, bind, join, map, map_error`, etc. + https://caml.inria.fr/pub/docs/manual-ocaml/libref/Result.html + (Many fine eyes) + +- #1855, #2118: Add `Fun.protect ~finally` for enforcing local + invariants whether a function raises or not, similar to + `unwind-protect` in Lisp and `FINALLY` in Modula-2. It is careful + about preserving backtraces and treating exceptions in finally as + errors. + (Marcello Seri and Guillaume Munch-Maccagnoni, review by Daniel + Bünzli, Gabriel Scherer, François Bobot, Nicolás Ojeda Bär, Xavier + Clerc, Boris Yakobowski, Damien Doligez, and Xavier Leroy) + +* #1605: Deprecate Stdlib.Pervasives. Following #1010, Pervasives + is no longer needed and Stdlib should be used instead. + (Jérémie Dimino, review by Nicolás Ojeda Bär) + +- #2185: Add `List.filter_map` + (Thomas Refis, review by Alain Frisch and Gabriel Scherer) + +- #1957: Add Stack.{top_opt,pop_opt} and Queue.{peek_opt,take_opt}. + (Vladimir Keleshev, review by Nicolás Ojeda Bär and Gabriel Scherer) + +- #1182: Add new Printf formats %#d %#Ld %#ld %#nd (idem for %i and %u) for + alternative integer formatting -- inserts '_' between blocks of digits. + (ygrek, review by Gabriel Scherer) + +- #1959: Add Format.dprintf, a printing function which outputs a closure + usable with %t. + (Gabriel Radanne, request by Armaël Guéneau, + review by Florian Angeletti and Gabriel Scherer) + +- #1986, #6450: Add Set.disjoint + (Nicolás Ojeda Bär, review by Gabriel Scherer) + +- #7812, #2125: Add Filename.chop_suffix_opt + (Alain Frisch, review by Nicolás Ojeda Bär, suggestion by whitequark) + +- #1864: Extend Bytes and Buffer with functions to read/write + binary representations of numbers + (Alain Frisch and Daniel Bünzli) + +- #1458: Add unsigned operations unsigned_div, unsigned_rem, unsigned_compare + and unsigned_to_int to modules Int32, Int64, Nativeint. + (Nicolás Ojeda Bär, review by Daniel Bünzli, Alain Frisch and Max Mouratov) + +- #2002: Add Format.pp_print_custom_break, a new more general kind of break + hint that can emit non-whitespace characters. + (Vladimir Keleshev and Pierre Weis, review by Josh Berdine, Gabriel Radanne) + +- #1966: Add Format semantic tags using extensible sum types. + (Gabriel Radanne, review by Nicolás Ojeda Bär) + +- #1794: Add constants zero, one, minus_one and functions succ, + pred, is_finite, is_infinite, is_nan, is_integer, trunc, round, + next_after, sign_bit, min, max, min_max, min_num, max_num, + min_max_num to module Float. + (Christophe Troestler, review by Alain Frisch, Xavier Clerc and Daniel Bünzli) + +- #1354, #2177: Add fma support to Float module. + (Laurent Thévenoux, review by Alain Frisch, Jacques-Henri Jourdan, + Xavier Leroy) + + + +- #5072, #6655, #1876: add aliases in Stdlib for built-in types + and exceptions. + (Jeremy Yallop, reports by Pierre Letouzey and David Sheets, + review by Valentin Gatien-Baron, Gabriel Scherer and Alain Frisch) + +- #1731: Format, use raise_notrace to preserve backtraces. + (Frédéric Bour, report by Jules Villard, review by Gabriel Scherer) + +- #6701, #1185, #1803: make float_of_string and string_of_float + locale-independent. + (ygrek, review by Xavier Leroy and Damien Doligez) + +- #7795, #1782: Fix off-by-one error in Weak.create. + (KC Sivaramakrishnan, review by Gabriel Scherer and François Bobot) + +- #7235: Format, flush err_formatter at exit. + (Pierre Weis, request by Jun Furuse) + +- #1857, #7812: Remove Sort module, deprecated since 2000 and emitting + a deprecation warning since 4.02. + (whitequark) + +- #1923: Arg module sometimes misbehaved instead of rejecting invalid + -keyword=arg inputs + (Valentin Gatien-Baron, review by Gabriel Scherer) + +- #1959: Small simplification and optimization to Format.ifprintf + (Gabriel Radanne, review by Gabriel Scherer) + +- #2119: clarify the documentation of Set.diff + (Gabriel Scherer, suggestion by John Skaller) + +- #2145: Deprecate the mutability of Gc.control record fields + (Damien Doligez, review by Alain Frisch) + +- #2159, #7874: annotate {String,Bytes}.equal as being [@@noalloc]. + (Pierre-Marie Pédrot, review by Nicolás Ojeda Bär) + +- #1936: Add module Float.Array + (Damien Doligez, review by Xavier Clerc and Alain Frisch) + +- #2183: Fix segfault in Array.create_float with -no-flat-float-array + (Damien Doligez, review by Gabriel Scherer and Jeremy Yallop) + +- #1525: Make function set_max_indent respect documentation + (Pierre Weis, Richard Bonichon, review by Florian Angeletti) + +- #2202: Correct Hashtbl.MakeSeeded.{add_seq,replace_seq,of_seq} to use + functor hash function instead of default hash function. Hashtbl.Make.of_seq + shouldn't create randomized hash tables. + (David Allsopp, review by Alain Frisch) + +### Other libraries: + +- #2533, #1839, #1949: added Unix.fsync + (Francois Berenger, Nicolás Ojeda Bär, review by Daniel Bünzli, David Allsopp + and ygrek) + +- #1792, #7794: Add Unix.open_process_args{,_in,_out,_full} similar to + Unix.open_process{,_in,_out,_full}, but passing an explicit argv array. + (Nicolás Ojeda Bär, review by Jérémie Dimino, request by Volker Diels-Grabsch) + +- #1999: Add Unix.process{,_in,_out,_full}_pid to retrieve opened process's + pid. + (Romain Beauxis, review by Nicolás Ojeda Bär) + +- #2222: Set default status in waitpid when pid is zero. Otherwise, + status value is undefined. + (Romain Beauxis and Xavier Leroy, review by Stephen Dolan) + +* #2104, #2211, #4127, #7709: Fix Thread.sigmask. When + system threads are loaded, Unix.sigprocmask is now an alias for + Thread.sigmask. This changes the behavior at least on MacOS, where + Unix.sigprocmask used to change the masks of all threads. + (Jacques-Henri Jourdan, review by Jérémie Dimino) + +- #1061: Add ?follow parameter to Unix.link. This allows hardlinking + symlinks. + (Christopher Zimmermann, review by Xavier Leroy, Damien Doligez, David + Allsopp, David Sheets) + +- #2038: Deprecate vm threads. + OCaml supported both "native threads", based on pthreads, + and its own green-threads implementation, "vm threads". We are not + aware of any recent usage of "vm threads", and removing them simplifies + further maintenance. + (Jérémie Dimino) + +* #4208, #4229, #4839, #6462, #6957, #6950, #1063, #2176, + #2297: Make (nat)dynlink sound by correctly failing when + dynlinked module names clash with other modules or interfaces. + (Mark Shinwell, Leo White, Nicolás Ojeda Bär, Pierre Chambart) + +- #2263: Delete the deprecated Bigarray.*.map_file functions in + favour of `*_of_genarray (Unix.map_file ...)` functions instead. The + `Unix.map_file` function was introduced in OCaml 4.06.0 onwards. + (Jérémie Dimino, reviewed by David Allsopp and Anil Madhavapeddy) + +### Compiler user-interface and warnings: + +- #2096: Add source highlighting for errors & warnings in batch mode + (Armaël Guéneau, review by Gabriel Scherer and Jérémie Dimino) + +- #2133: [@ocaml.warn_on_literal_pattern]: now warn on literal patterns + found anywhere in a constructor's arguments. + (Jeremy Yallop, review by Gabriel Scherer) + +- #1720: Improve error reporting for missing 'rec' in let-bindings. + (Arthur Charguéraud and Armaël Guéneau, with help and advice + from Gabriel Scherer, Frédéric Bour, Xavier Clerc and Leo White) + +- #7116, #1430: new -config-var option + to get the value of a single configuration variable in scripts. + (Gabriel Scherer, review by Sébastien Hinderer and David Allsopp, + request by Adrien Nader) + +- #1733,1993,1998,2058,2094,2140: Typing error message improvements + - #1733, change the perspective of the unexpected existential error + message. + - #1993, expanded error messages for universal quantification failure + - #1998, more context for unbound type parameter error + - #2058, full explanation for unsafe cycles in recursive module + definitions (suggestion by Ivan Gotovchits) + - #2094, rewording for "constructor has no type" error + - #7565, #2140, more context for universal variable escape + in method type + (Florian Angeletti, reviews by Jacques Garrigue, Armaël Guéneau, + Gabriel Radanne, Gabriel Scherer and Jeremy Yallop) + +- #1913: new flag -dump-into-file to print debug output like -dlambda into + a file named after the file being built, instead of on stderr. + (Valentin Gatien-Baron, review by Thomas Refis) + +- #1921: in the compilation context passed to ppx extensions, + add more configuration options related to type-checking: + -rectypes, -principal, -alias-deps, -unboxed-types, -unsafe-string + (Gabriel Scherer, review by Gabriel Radanne, Xavier Clerc and Frédéric Bour) + +- #1976: Better error messages for extension constructor type mismatches + (Thomas Refis, review by Gabriel Scherer) + +- #1841, #7808: the environment variable OCAMLTOP_INCLUDE_PATH can now + specify a list of additional include directories for the ocaml toplevel. + (Nicolás Ojeda Bär, request by Daniel Bünzli, review by Daniel Bünzli and + Damien Doligez) + +- #6638, #1110: introduced a dedicated warning to report + unused "open!" statements + (Alain Frisch, report by dwang, review by and design from Leo White) + +- #1974: Trigger warning 5 in "let _ = e" and "ignore e" if e is of function + type and syntactically an application. (For the case of "ignore e" the warning + already existed, but used to be triggered even when e was not an application.) + (Nicolás Ojeda Bär, review by Alain Frisch and Jacques Garrigue) + +- #7408, #7846, #2015: Check arity of primitives. + (Hugo Heuzard, review by Nicolás Ojeda Bär) + + + +- #2091: Add a warning triggered by type declarations "type t = ()" + (Armaël Guéneau, report by linse, review by Florian Angeletti and Gabriel + Scherer) + +- #2004: Use common standard library path `lib/ocaml` for Windows, + for consistency with OSX & Linux. Previously was located at `lib`. + (Bryan Phelps, Jordan Walke, review by David Allsopp) + +- #6416, #1120: unique printed names for identifiers + (Florian Angeletti, review by Jacques Garrigue) + +- #1691: add shared_libraries to ocamlc -config exporting + SUPPORTS_SHARED_LIBRARIES from Makefile.config. + (David Allsopp, review by Gabriel Scherer and Mark Shinwell) + +- #6913, #1786: new -match-context-rows option + to control the degree of optimization in the pattern matching compiler. + (Dwight Guth, review by Gabriel Scherer and Luc Maranget) + +- #1822: keep attributes attached to pattern variables from being discarded. + (Nicolás Ojeda Bär, review by Thomas Refis) + +- #1845: new `-dcamlprimc` option to keep the generated C file containing + the information about primitives; pass `-fdebug-prefix-map` to the C compiler + when supported, for reproducible builds + (Xavier Clerc, review by Jérémie Dimino) + +- #1856, #1869: use `BUILD_PATH_PREFIX_MAP` when compiling primitives + in order to make builds reproducible if code contains uses of + `__FILE__` or `__LOC__` + (Xavier Clerc, review by Gabriel Scherer and Sébastien Hinderer) + +- #1906: the -unsafe option does not apply to marshalled ASTs passed + to the compiler directly or by a -pp preprocessor; add a proper + warning (64) instead of a simple stderr message + (Valentin Gatien-Baron) + +- #1925: Print error locations more consistently between batch mode, toplevel + and expect tests + (Armaël Guéneau, review by Thomas Refis, Gabriel Scherer and François Bobot) + +- #1930: pass the elements from `BUILD_PATH_PREFIX_MAP` to the assembler + (Xavier Clerc, review by Gabriel Scherer, Sébastien Hinderer, and + Xavier Leroy) + +- #1945, #2032: new "-stop-after [parsing|typing]" option + to stop compilation after the parsing or typing pass + (Gabriel Scherer, review by Jérémie Dimino) + +- #1953: Add locations to attributes in the parsetree. + (Hugo Heuzard, review by Gabriel Radanne) + +- #1954: Add locations to toplevel directives. + (Hugo Heuzard, review by Gabriel Radanne) + +* #1979: Remove support for TERM=norepeat when displaying errors + (Armaël Guéneau, review by Gabriel Scherer and Florian Angeletti) + +- #1960: The parser keeps previous location when relocating ast node. + (Hugo Heuzard, review by Jérémie Dimino) + +- #7864, #2109: remove duplicates from spelling suggestions. + (Nicolás Ojeda Bär, review by Armaël Guéneau) + +### Manual and documentation: + +- #7548: printf example in the tutorial part of the manual + (Kostikova Oxana, rewiew by Gabriel Scherer, Florian Angeletti, + Marcello Seri and Armaël Guéneau) + +- #7546, #2020: preambles and introduction for compiler-libs. + (Florian Angeletti, review by Daniel Bünzli, Perry E. Metzger + and Gabriel Scherer) + +- #7547, #2273: Tutorial on Lazy expressions and patterns in OCaml Manual + (Ulugbek Abdullaev, review by Florian Angeletti and Gabriel Scherer) + +- #7720, #1596, precise the documentation + of the maximum indentation limit in Format. + (Florian Angeletti, review by Richard Bonichon and Pierre Weis) + +- #7825: html manual split compilerlibs from stdlib in the html + index of modules + (Florian Angeletti, review by Perry E. Metzger and Gabriel Scherer) + +- #1209, #2008: in the Extension section, use the caml_example environment + (uses the compiler to check the example code). + This change was made possible by a lot of tooling work from Florian Angeletti: + #1702, #1765, #1863, and Gabriel Scherer's #1903. + (Gabriel Scherer, review by Florian Angeletti) + +- #1788, 1831, 2007, 2198, 2232, move language extensions to the core + chapters: + - #1788: quoted string description + - #1831: local exceptions and exception cases + - #2007: 32-bit, 64-bit and native integer literals + - #2198: lazy patterns + - #2232: short object copy notation + (Florian Angeletti, review by Xavier Clerc, Perry E. Metzger, Gabriel Scherer + and Jeremy Yallop) + +- #1863: caml-tex2, move to compiler-libs + (Florian Angeletti, review by Sébastien Hinderer and Gabriel Scherer) + +- #2105: Change verbatim to caml_example in documentation + (Maxime Flin, review by Florian Angeletti) + +- #2114: ocamldoc, improved manpages for documentation inside modules + (Florian Angeletti, review by Gabriel Scherer) + +- #2117: stdlib documentation, duplicate the operator precedence table + from the manual inside a separate "OCaml_operators" module. + (Florian Angeletti, review by Daniel Bünzli, Perry E. Metzger + and Gabriel Scherer) + +- #2187: document "exception A | pat" patterns + (Florian Angeletti, review by Perry E. Metzger and Jeremy Yallop) + +- #8508: refresh \moduleref macro + (Florian Angeletti, review by Gabriel Scherer) + +- 9410: replaced fibonacci example with gcd of coreexamples manual + (Anukriti Kumar, review by San Vu Ngoc, Florian Angeletti, Léo Andrès) + +### Code generation and optimizations: + +- #7725, #1754: improve AFL instrumentation for objects and lazy values. + (Stephen Dolan) + +- #1631: AMD64 code generator: emit shorter instruction sequences for the + sign-extension operations. + (LemonBoy, review by Alain Frisch and Xavier Leroy) + +- #7246, #2146: make a few int64 primitives use [@@unboxed] + stubs on 32bits + (Jérémie Dimino) + +- #1917: comballoc: ensure object allocation order is preserved + (Stephen Dolan) + +- #6242, #2143, #8558, #8559: Optimize some local functions. + Local functions that do not escape and whose calls all have + the same continuation are lowered into a static-catch handler. + (Alain Frisch, review by Gabriel Scherer) + +- #2082: New options [-insn-sched] and [-no-insn-sched] to control + instruction scheduling. + (Mark Shinwell, review by Damien Doligez) + +- #2239: Fix match miscompilation with flambda + (Leo White, review by Alain Frisch) + +### Runtime system: + +- #7198, #7750, #1738: add a function (caml_alloc_custom_mem) + and three GC parameters to give the user better control of the + out-of-heap memory retained by custom values; use the function to + allocate bigarrays and I/O channels. + (Damien Doligez, review by Alain Frisch) + +- #1793: add the -m and -M command-line options to ocamlrun. + Option -m prints the magic number of the bytecode executable passed + as argument, -M prints the magic number expected by ocamlrun. + (Sébastien Hinderer, review by Xavier Clerc and Damien Doligez) + +- #1867: Remove the C plugins mechanism. + (Xavier Leroy, review by David Allsopp, Damien Doligez, Sébastien Hinderer) + +- #8627: Require SSE2 for 32-bit mingw port to generate correct code + for caml_round with GCC 7.4. + (David Allsopp, review by Xavier Leroy) + +- #7676, #2144: Remove old GC heuristic + (Damien Doligez, report and review by Alain Frisch) + +* #1683: Change Marshal format to make Custom_tag objects store their + length. Old versions of OCaml will no longer be able to parse new marshalled + files containing custom blocks, but old files will still parse. + (Stephen Dolan) + +- #1723: Remove internal Meta.static_{alloc,free} primitives. + (Stephen Dolan, review by Gabriel Scherer) + +- #1895: Printexc.get_callstack would return only one frame in native + code in threads other then the initial one + (Valentin Gatien-Baron, review by Xavier Leroy) + +- #1900, #7814: avoid exporting non-prefixed identifiers in the debug + and instrumented runtimes. + (Damien Doligez, report by Gabriel Scherer) + +- #2079: Avoid page table lookup in Pervasives.compare with + no-naked-pointers + (Sam Goldman, review by Gabriel Scherer, David Allsopp, Stephen Dolan) + +- #7829, #8585: Fix pointer comparisons in freelist.c (for 32-bit platforms) + (David Allsopp and Damien Doligez) + +- #8567, #8569: on ARM64, use 32-bit loads to access caml_backtrace_active + (Xavier Leroy, review by Mark Shinwell and Greta Yorsh) + +- #8568: Fix a memory leak in mmapped bigarrays + (Damien Doligez, review by Xavier Leroy and Jérémie Dimino) + +### Tools + +- #2182: Split Emacs caml-mode as an independent project. + (Christophe Troestler, review by Gabriel Scherer) + +- #1865: support dark themes in Emacs, and clean up usage of + deprecated Emacs APIs + (Wilfred Hughes, review by Clément Pit-Claudel) + +- #1590: ocamllex-generated lexers can be instructed not to update + their lex_curr_p/lex_start_p fields, resulting in a significant + performance gain when those fields are not required. + (Alain Frisch, review by Jérémie Dimino) + +- #7843, #2013: ocamldoc, better handling of {{!label}text} in the latex + backend. + (Florian Angeletti, review by Nicolás Ojeda Bär and Gabriel Scherer) + +- #7844, #2040: Emacs, use built-in detection of comments, + fixes an imenu crash. + (Wilfred Hughes, review by Christophe Troestler) + +- #7850: Emacs, use symbol boundaries in regular expressions, + fixes an imenu crash. + (Wilfred Hughes, review by Christophe Troestler) + +- #1711: the new 'open' flag in OCAMLPARAM takes a comma-separated list of + modules to open as if they had been passed via the command line -open flag. + (Nicolás Ojeda Bär, review by Mark Shinwell) + +- #2000: ocamdoc, extended support for "include module type of ..." + (Florian Angeletti, review by Jérémie Dimino) + +- #2045: ocamlmklib now supports options -args and -args0 to provide extra + command-line arguments in a file. + (Nicolás Ojeda Bär, review by Gabriel Scherer and Daniel Bünzli) + +- #2189: change ocamldep Makefile-output to print each dependency + on a new line, for more readable diffs of versioned dependencies. + (Gabriel Scherer, review by Nicolás Ojeda Bär) + +- #2223: ocamltest: fix the "bsd" and "not-bsd" built-in actions to + recognize all BSD variants + (Damien Doligez, review by Sébastien Hinderer and David Allsopp) + +### Compiler distribution build system: + +- #1776: add -no-install-bytecode-programs and related configure options to + control (non-)installation of ".byte" executables. + (Mark Shinwell, review by Sébastien Hinderer and Gabriel Scherer) + +- #1777: add -no-install-source-artifacts and related configure options to + control installation of .cmt, .cmti, .mli and .ml files. + (Mark Shinwell, review by Nicolás Ojeda Bär and Sébastien Hinderer) + +- #1781: cleanup of the manual's build process. + (steinuil, review by Marcello Seri, Gabriel Scherer and Florian Angeletti) + +- #1797: remove the deprecated Makefile.nt files. + (Sébastien Hinderer, review by Nicolás Ojeda Bär) + +- #1805: fix the bootstrap procedure and its documentation. + (Sébastien Hinderer, Xavier Leroy and Damien Doligez; review by + Gabriel Scherer) + +- #1840: build system enhancements. + (Sébastien Hinderer, review by David Allsopp, Xavier Leroy and + Damien Doligez) + +- #1852: merge runtime directories + (Sébastien Hinderer, review by Xavier Leroy and Damien Doligez) + +- #1854: remove the no longer defined BYTECCCOMPOPTS build variable. + (Sébastien Hinderer, review by Damien Doligez) + +- #2024: stop supporting obsolete platforms: Rhapsody (old beta + version of MacOS X, BeOS, alpha*-*-linux*, mips-*-irix6*, + alpha*-*-unicos, powerpc-*-aix, *-*-solaris2*, mips*-*-irix[56]*, + i[3456]86-*-darwin[89].*, i[3456]86-*-solaris*, *-*-sunos* *-*-unicos. + (Sébastien Hinderer, review by Xavier Leroy, Damien Doligez, Gabriel + Scherer and Armaël Guéneau) + +- #2053: allow unix, vmthreads and str not to be built. + (David Allsopp, review by Sébastien Hinderer) + +* #2059: stop defining OCAML_STDLIB_DIR in s.h. + (Sébastien Hinderer, review by David Allsopp and Damien Doligez) + +* #2066: remove the standard_runtime configuration variable. + (Sébastien Hinderer, review by Xavier Leroy, Stephen Dolan and + Damien Doligez) + +* #2139: use autoconf to generate the compiler's configuration script + (Sébastien Hinderer, review by Damien Doligez and David Allsopp) + +- #2148: fix a parallel build bug involving CamlinternalLazy. + (Stephen Dolan, review by Gabriel Scherer and Nicolás Ojeda Bär) + +- #2264, #7904: the configure script now sets the Unicode handling mode + under Windows according to the value of the variable WINDOWS_UNICODE_MODE. If + WINDOWS_UNICODE_MODE is "ansi" then it is assumed to be the current code page + encoding. If WINDOWS_UNICODE_MODE is "compatible" or empty or not set at all, + then encoding is UTF-8 with code page fallback. + (Nicolás Ojeda Bär, review by Sébastien Hinderer and David Allsopp) + +- #2266: ensure Cygwin ports configure with `EXE=.exe`, or the compiler is + unable to find the camlheader files (subtle regression of #2139/2041) + (David Allsopp, report and review by Sébastien Hinderer) + +- #7919, #2311: Fix assembler detection in configure + (Sébastien Hinderer, review by David Allsopp) + +- #2295: Restore support for bytecode target XLC/AIX/Power + (Konstantin Romanov, review by Sébastien Hinderer and David Allsopp) + +- #8528: get rid of the direct call to the C preprocessor in the testsuite + (Sébastien Hinderer, review by David Allsopp) + +- #7938, #8532: Fix alignment detection for ints on 32-bits platforms + (Sébastien Hinderer, review by Xavier Leroy) + +* #8533: Remove some unused configure tests + (Stephen Dolan, review by David Allsopp and Sébastien Hinderer) + +- #2207, #8604: Add opam files to allow pinning + (Leo White, Greta Yorsh, review by Gabriel Radanne) + +- #8616: configure: use variables rather than arguments for a few options + (Sébastien Hinderer, review by David Allsopp, Gabriel Scherer and + Damien Doligez) + +- #8632: Correctly propagate flags for --with-pic in configure. + (David Allsopp, review by Sébastien Hinderer and Damien Doligez) + +- #8673: restore SpaceTime and libunwind support in configure script + (Sébastien Hinderer, review by Damien Doligez) + +### Internal/compiler-libs changes: + +- #7918, #1703, #1944, #2213, #2257: Add the module + Compile_common, which factorizes the common part in Compile and + Optcompile. This also makes the pipeline more modular. + (Gabriel Radanne, help from Gabriel Scherer and Valentin + Gatien-Baron, review by Mark Shinwell and Gabriel Radanne, + regression spotted by Clément Franchini) + +- #292: use Menhir as the parser generator for the OCaml parser. + Satellite GPRs: #1844, #1846, #1853, #1850, #1934, #2151, + #2174 + (Gabriel Scherer, Nicolás Ojeda Bär, Frédéric Bour, Thomas Refis + and François Pottier, + review by Nicolás Ojeda Bär, Leo White and David Allsopp) + +- #374: use Misc.try_finally for resource cleanup in the compiler + codebase. This should fix the problem of catch-and-reraise `try .. with` + blocks destroying backtrace information -- in the compiler. + (François Bobot, help from Gabriel Scherer and Nicolás Ojeda Bär, + review by Gabriel Scherer) + +- #1148, #1287, #1288, #1874: significant improvements + of the tools/check-typo script used over the files of the whole repository; + contributors are now expected to check that check-typo passes on their + pull requests; see CONTRIBUTING.md for more details. + (David Allsopp, review by Damien Doligez and Sébastien Hinderer) + +- #1610, #2252: Remove positions from paths + (Leo White, review by Frédéric Bour and Thomas Refis) + +- #1745: do not generalize the type of every sub-pattern, + only of variables. (preliminary work for GADTs in or-patterns) + (Thomas Refis, review by Leo White) + +- #1909: unsharing pattern types (preliminary work for GADTs in or-patterns) + (Thomas Refis, with help from Leo White, review by Jacques Garrigue) + +- #1748: do not error when instantiating polymorphic fields in patterns. + (Thomas Refis, review by Gabriel Scherer) + +- #2317: type_let: be more careful generalizing parts of the pattern + (Thomas Refis and Leo White, review by Jacques Garrigue) + +- #1746: remove unreachable error variant: Make_seltype_nongen. + (Florian Angeletti, review by Gabriel Radanne) + +- #1747: type_cases: always propagate (preliminary work + for GADTs in or-patterns) + (Thomas Refis, review by Jacques Garrigue) + +- #1811: shadow the polymorphic comparison in the middle-end + (Xavier Clerc, review by Pierre Chambart) + +- #1833: allow non-val payloads in CMM Ccatch handlers + (Simon Fowler, review by Xavier Clerc) + +- #1866: document the release process + (Damien Doligez and Gabriel Scherer, review by Sébastien Hinderer, + Perry E. Metzger, Xavier Leroy and David Allsopp) + +- #1886: move the Location.absname reference to Clflags.absname + (Armaël Guéneau, review by Jérémie Dimino) + +- #1894: generalize highlight_dumb in location.ml to handle highlighting + several locations + (Armaël Guéneau, review by Gabriel Scherer) + +- #1903: parsetree, add locations to all nodes with attributes + (Gabriel Scherer, review by Thomas Refis) + +- #1905: add check-typo-since to check the files changed + since a given git reference + (Gabriel Scherer, review by David Allsopp) + +- #1910: improve the check-typo use of .gitattributes + (Gabriel Scherer, review by David Allsopp and Damien Doligez) + +- #1938: always check ast invariants after preprocessing + (Florian Angeletti, review by Alain Frisch and Gabriel Scherer) + +- #1941: refactor the command line parsing of ocamlcp and ocamloptp + (Valentin Gatien-Baron, review by Florian Angeletti) + +- #1948: Refactor Stdlib.Format. Notably, use Stdlib.Stack and Stdlib.Queue, + and avoid exceptions for control flow. + (Vladimir Keleshev, review by Nicolás Ojeda Bär and Gabriel Scherer) + +* #1952: refactor the code responsible for displaying errors and warnings + `Location.report_error` is removed, use `Location.print_report` instead + (Armaël Guéneau, review by Thomas Refis) + +- #7835, #1980, #8548, #8586: separate scope from stamp in idents and explicitly + rescope idents when substituting signatures. + (Thomas Refis, review by Jacques Garrigue and Leo White) + +- #1996: expose Pprintast.longident to help compiler-libs users print + Longident.t values. + (Gabriel Scherer, review by Florian Angeletti and Thomas Refis) + +- #2030: makefile targets to build AST files of sources + for parser testing. See parsing/HACKING.adoc. + (Gabriel Scherer, review by Nicolás Ojeda Bär) + +* #2041: add a cache for looking up files in the load path + (Jérémie Dimino, review by Alain Frisch and David Allsopp) + +- #2047, #2269: a new type for unification traces + (Florian Angeletti, report by Leo White (#2269), + review by Thomas Refis and Gabriel Scherer) + +- #2055: Add [Linearize.Lprologue]. + (Mark Shinwell, review by Pierre Chambart) + +- #2056: Use [Backend_var] rather than [Ident] from [Clambda] onwards; + use [Backend_var.With_provenance] for variables in binding position. + (Mark Shinwell, review by Pierre Chambart) + +- #2060: "Phantom let" support for the Clambda language. + (Mark Shinwell, review by Vincent Laviron) + +- #2065: Add [Proc.destroyed_at_reloadretaddr]. + (Mark Shinwell, review by Damien Doligez) + +- #2070: "Phantom let" support for the Cmm language. + (Mark Shinwell, review by Vincent Laviron) + +- #2072: Always associate a scope to a type + (Thomas Refis, review by Jacques Garrigue and Leo White) + +- #2074: Correct naming of record field inside [Ialloc] terms. + (Mark Shinwell, review by Jérémie Dimino) + +- #2076: Add [Targetint.print]. + (Mark Shinwell) + +- #2080: Add [Proc.dwarf_register_numbers] and + [Proc.stack_ptr_dwarf_register_number]. + (Mark Shinwell, review by Bernhard Schommer) + +- #2088: Add [Clambda.usymbol_provenance]. + (Mark Shinwell, review by Damien Doligez) + +- #2152, #2517: refactorize the fixpoint to compute type-system + properties of mutually-recursive type declarations. + (Gabriel Scherer and Rodolphe Lepigre, review by Armaël Guéneau) + +- #2156: propagate more type information through Lambda and Clambda + intermediate language, as a preparation step for more future optimizations + (Pierre Chambart and Alain Frisch, cross-reviewed by themselves) + +- #2160: restore --disable-shared support and ensure testsuite runs correctly + when compiled without shared library support. + (David Allsopp, review by Damien Doligez and Sébastien Hinderer) + +* #2173: removed TypedtreeMap + (Thomas Refis, review by Gabriel Scherer) + +- #7867: Fix #mod_use raising an exception for filenames with no + extension. + (Geoff Gole) + +- #2100: Fix Unix.getaddrinfo when called on strings containing + null bytes; it would crash the GC later on. + (Armaël Guéneau, report and fix by Joe, review by Sébastien Hinderer) + +- #7847, #2019: Fix an infinite loop that could occur when the + (Menhir-generated) parser encountered a syntax error in a certain + specific state. + (François Pottier, report by Stefan Muenzel, + review by Frédéric Bour, Thomas Refis, Gabriel Scherer) + +- #1626: Do not allow recursive modules in `with module` + (Leo White, review by Gabriel Radanne) + +- #7726, #1676: Recursive modules, equi-recursive types and stack overflow + (Jacques Garrigue, report by Jeremy Yallop, review by Leo White) + +- #7723, #1698: Ensure `with module` and `with type` do not weaken + module aliases. + (Leo White, review by Gabriel Radanne and Jacques Garrigue) + +- #1719: fix Pervasives.LargeFile functions under Windows. + (Alain Frisch) + +- #1739: ensure ocamltest waits for child processes to terminate on Windows. + (David Allsopp, review by Sébastien Hinderer) + +- #7554, #1751: Lambda.subst: also update debug event environments + (Thomas Refis, review by Gabriel Scherer) + +- #7238, #1825: in Unix.in_channel_of_descr and Unix.out_channel_of_descr, + raise an error if the given file description is not suitable for + character-oriented I/O, for example if it is a block device or a + datagram socket. + (Xavier Leroy, review by Jérémie Dimino and Perry E. Metzger) + +- #7799, #1820: fix bug where Scanf.format_from_string could fail when + the argument string contained characters that require escaping. + (Gabriel Scherer and Nicolás Ojeda Bär, report by Guillaume Melquiond, review + by Gabriel Scherer) + +- #1843: ocamloptp was doing the wrong thing with option -inline-max-unroll. + (Github user @poechsel, review by Nicolás Ojeda Bär). + +- #1890: remove last use of Ctype.unroll_abbrev + (Thomas Refis, report by Leo White, review by Jacques Garrigue) + +- #1893: dev-branch only, warning 40(name not in scope) triggered spurious + warnings 49(missing cmi) with -no-alias-deps. + (Florian Angeletti, report by Valentin Gatien-Baron, + review by Gabriel Scherer) + +- #1912: Allow quoted strings, octal/unicode escape sequences and identifiers + containing apostrophes in ocamllex actions and comments. + (Pieter Goetschalckx, review by Damien Doligez) + +- #7828, #1935: correct the conditions that generate warning 61, + Unboxable_type_in_prim_decl + (Stefan Muenzel) + +- #1958: allow [module M(_:S) = struct end] syntax + (Hugo Heuzard, review by Gabriel Scherer) + +- #1970: fix order of floatting documentation comments in classes + (Hugo Heuzard, review by Nicolás Ojeda Bär) + +- #1977: [@@ocaml.warning "..."] attributes attached to type declarations are + no longer ignored. + (Nicolás Ojeda Bär, review by Gabriel Scherer) + +- #7830, #1987: fix ocamldebug crash when printing a value in the scope of + an `open` statement for which the `.cmi` is not available. + (Nicolás Ojeda Bär, report by Jocelyn Sérot, review by Gabriel Scherer) + +- #7854, #2062: fix an issue where the wrong locale may be used when using + the legacy ANSI encoding under Windows. + (Nicolás Ojeda Bär, report by Tiphaine Turpin) + +- #2083: Fix excessively aggressive float unboxing and introduce similar fix + as a preventative measure for boxed int unboxing. + (Thomas Refis, Mark Shinwell, Leo White) + +- #2130: fix printing of type variables with a quote in their name + (Alain Frisch, review by Armaël Guéneau and Gabriel Scherer, + report by Hugo Heuzard) + +- #2131: fix wrong calls to Env.normalize_path on non-module paths + (Alain Frisch, review by Jacques Garrigue) + +- #2175: Apply substitution to all modules when packing + (Leo White, review by Gabriel Scherer) + +- #2220: Remove duplicate process management code in + otherlibs/threads/unix.ml + (Romain Beauxis, review by Gabriel Scherer and Alain Frisch) + +- #2231: Env: always freshen persistent signatures before using them + (Thomas Refis and Leo White, review by Gabriel Radanne) + +- #7851, #8570: Module type of allows to transform a malformed + module type into a vicious signature, breaking soundness + (Jacques Garrigue, review by Leo White) + +- #7923, #2259: fix regression in FlexDLL bootstrapped build caused by + refactoring the root Makefile for Dune in #2093) + (David Allsopp, report by Marc Lasson) + +- #7929, #2261: Subst.signature: call cleanup_types exactly once + (Thomas Refis, review by Gabriel Scherer and Jacques Garrigue, + report by Daniel Bünzli and Jon Ludlam) + +- #8550, #8552: Soundness issue with class generalization + (Jacques Garrigue, review by Leo White and Thomas Refis, + report by Jeremy Yallop) + +OCaml 4.07.1 (4 October 2018) +----------------------------- + +### Bug fixes: + +- #7815, #1896: major GC crash with first-fit policy + (Stephen Dolan and Damien Doligez, report by Joris Giovannangeli) + +* #7818, #2051: Remove local aliases in functor argument types, + to prevent the aliasing of their target. + (Jacques Garrigue, report by mandrykin, review by Leo White) + +- #7820, #1897: Fix Array.of_seq. This function used to apply a circular + permutation of one cell to the right on the sequence. + (Thierry Martinez, review by Nicolás Ojeda Bär) + +- #7821, #1908: make sure that the compilation of extension + constructors doesn't cause the compiler to load more cmi files + (Jérémie Dimino, review by Gabriel Scherer) + +- #7824, #1914: subtype_row: filter out absent fields when row is closed + (Leo White and Thomas Refis, report by talex, review by Jacques Garrigue) + +- #1915: rec_check.ml is too permissive for certain class declarations. + (Alban Reynaud with Gabriel Scherer, review by Jeremy Yallop) + +- #7833, #1946: typecore: only 1k existential per match, not 100k + (Thomas Refis, report by Jerome Simeon, review by Jacques Garrigue) + +- #7838: -principal causes assertion failure in type checker + (Jacques Garrigue, report by Markus Mottl, review by Thomas Refis) + +OCaml 4.07.0 (10 July 2018) +--------------------------- + +(Changes that can break existing programs are marked with a "*") + +### Language features: + +- #6023, #1648: Allow type-based selection of GADT constructors. + (Thomas Refis and Leo White, review by Jacques Garrigue and Gabriel Scherer) + +- #1546: Allow empty variants. + (Runhang Li, review by Gabriel Radanne and Jacques Garrigue) + +### Standard library: + +- #4170, #1674: add the constant `Float.pi`. + (Christophe Troestler, review by Damien Doligez) + +- #6139, #1685: Move the Bigarray module to the standard library. Keep the + bigarray library as on overlay adding the deprecated map_file functions. + (Jérémie Dimino, review by Mark Shinwell) + +- #7528, #1500: add a Format.pp_set_geometry function to avoid memory + effects in set_margin and set_max_indent. + (Florian Angeletti, review by Richard Bonichon, Gabriel Radanne, + Gabiel Scherer and Pierre Weis) + +- #7690, #1528: fix the float_of_string function for hexadecimal floats + with very large values of the exponent. + (Olivier Andrieu) + +- #1002: add a new `Seq` module defining a list-of-thunks style iterator. + Also add `{to,of}_seq` to several standard modules. + (Simon Cruanes, review by Alain Frisch and François Bobot) + +* #1010: pack all standard library modules into a single module Stdlib + which is the default opened module (Stdlib itself includes Pervasives) to free + up the global namespace for other standard libraries, while still allowing any + OCaml standard library module to be referred to as Stdlib.Module). This is + implemented efficiently using module aliases (prefixing all modules with + Stdlib__, e.g. Stdlib__string). + (Jérémie Dimino, David Allsopp and Florian Angeletti, review by David Allsopp + and Gabriel Radanne) + +- #1637: String.escaped is faster and does not allocate when called with a + string that does not contain any characters needing to be escaped. + (Alain Frisch, review by Xavier Leroy and Gabriel Scherer) + +- #1638: add a Float module. + (Nicolás Ojeda Bär, review by Alain Frisch and Jeremy Yallop) + +- #1697: Tune [List.init] tailrec threshold so that it does not stack + overflow when compiled with the Js_of_ocaml backend. + (Hugo Heuzard, reviewed by Gabriel Scherer) + +### Other libraries: + +- #7745, #1629: Graphics.open_graph displays the correct window title on + Windows again (fault introduced by 4.06 Unicode changes). + (David Allsopp) + +* #1406: Unix.isatty now returns true in the native Windows ports when + passed a file descriptor connected to a Cygwin PTY. In particular, compiler + colors for the native Windows ports now work under Cygwin/MSYS2. + (Nicolás Ojeda Bär, review by Gabriel Scherer, David Allsopp, Xavier Leroy) + +- #1451: [getpwuid], [getgrgid], [getpwnam], [getgrnam] now raise Unix error + instead of returning [Not_found] when interrupted by a signal. + (Arseniy Alekseyev, review by Mark Shinwell and Xavier Leroy) + +- #1477: raw_spacetime_lib can now be used in bytecode. + (Nicolás Ojeda Bär, review by Mark Shinwell) + +- #1533: (a) The implementation of Thread.yield for system thread + now uses nanosleep(1) for enabling better preemption. + (b) Thread.delay is now an alias for Unix.sleepf. + (Jacques-Henri Jourdan, review by Xavier Leroy and David Allsopp) + +### Compiler user-interface and warnings: + +- #7663, #1694: print the whole cycle and add a reference to the manual in + the unsafe recursive module evaluation error message. + (Florian Angeletti, report by Matej Košík, review by Gabriel Scherer) + +- #1166: In OCAMLPARAM, an alternative separator can be specified as + first character (instead of comma) in the set ":|; ," + (Fabrice Le Fessant) + +- #1358: Fix usage warnings with no mli file. + (Leo White, review by Alain Frisch) + +- #1428: give a non dummy location for warning 49 (no cmi found). + (Valentin Gatien-Baron) + +- #1491: Improve error reporting for ill-typed applicative functor + types, F(M).t. + (Valentin Gatien-Baron, review by Florian Angeletti and Gabriel Radanne) + +- #1496: Refactor the code printing explanation for unification type errors, + in order to avoid duplicating pattern matches. + (Armaël Guéneau, review by Florian Angeletti and Gabriel Scherer) + +- #1505: Add specific error messages for unification errors involving + functions of type "unit -> _". + (Arthur Charguéraud and Armaël Guéneau, with help from Leo White, review by + Florian Angeletti and Gabriel Radanne) + +- #1510: Add specific explanation for unification errors caused by type + constraints propagated by keywords (such as if, while, for...). + (Armaël Guéneau and Gabriel Scherer, original design by Arthur Charguéraud, + review by Frédéric Bour, Gabriel Radanne and Alain Frisch) + +- #1515: honor the BUILD_PATH_PREFIX_MAP environment variable + to enable reproducible builds. + (Gabriel Scherer, with help from Ximin Luo, review by Damien Doligez) + +- #1534: Extend the warning printed when (*) is used, adding a hint to + suggest using ( * ) instead. + (Armaël Guéneau, with help and review from Florian Angeletti and Gabriel + Scherer) + +- #1552, #1577: do not warn about ambiguous variables in guards + (warning 57) when the ambiguous values have been filtered by + a previous clause. + (Gabriel Scherer and Thomas Refis, review by Luc Maranget) + +- #1554: warnings 52 and 57: fix reference to manual detailed explanation. + (Florian Angeletti, review by Thomas Refis and Gabriel Scherer) + +- #1618: add the -dno-unique-ids and -dunique-ids compiler flags. + (Sébastien Hinderer, review by Leo White and Damien Doligez) + +- #1649: change compilation order of toplevel definitions, so that some + warnings emitted by the bytecode compiler appear more in-order than before. + (Luc Maranget, advice and review by Damien Doligez) + +- #1806: add linscan to OCAMLPARAM options. + (Raja Boujbel) + +### Code generation and optimizations: + +- #7630, #1401: Faster compilation of large modules with Flambda. + (Pierre Chambart, report by Emilio Jesús Gallego Arias, + Pierre-Marie Pédrot and Paul Steckler, review by Gabriel Scherer + and Leo White) + +- #7630, #1455: Disable CSE for the initialization function. + (Pierre Chambart, report by Emilio Jesús Gallego Arias, + review by Gabriel Scherer and Xavier Leroy) + +- #1370: Fix code duplication in Cmmgen. + (Vincent Laviron, with help from Pierre Chambart, + reviews by Gabriel Scherer and Luc Maranget) + +- #1486: ARM 32-bit port: add support for ARMv8 in 32-bit mode, + a.k.a. AArch32. + For this platform, avoid ITE conditional instruction blocks and use + simpler IT blocks instead. + (Xavier Leroy, review by Mark Shinwell) + +- #1487: Treat negated float comparisons more directly. + (Leo White, review by Xavier Leroy) + +- #1573: emitcode: merge events after instructions reordering. + (Thomas Refis and Leo White, with help from David Allsopp, review by Frédéric + Bour) + +- #1606: Simplify the semantics of Lambda.free_variables and Lambda.subst, + including some API changes in bytecomp/lambda.mli. + (Pierre Chambart, review by Gabriel Scherer) + +- #1613: ensure that set-of-closures are processed first so that other + entries in the let-rec symbol do not get dummy approximations. + (Leo White and Xavier Clerc, review by Pierre Chambart) + +* #1617: Make string/bytes distinguishable in the bytecode. + (Hugo Heuzard, reviewed by Nicolás Ojeda Bär) + +- #1627: Reduce cmx sizes by sharing variable names (Flambda only). + (Fuyong Quah, Leo White, review by Xavier Clerc) + +- #1665: reduce the size of cmx files in classic mode by dropping the + bodies of functions that will not be inlined. + (Fuyong Quah, review by Leo White and Pierre Chambart) + +- #1666: reduce the size of cmx files in classic mode by dropping the + bodies of functions that cannot be reached from the module block. + (Fuyong Quah, review by Leo White and Pierre Chambart) + +- #1686: Turn off by default flambda invariants checks. + (Pierre Chambart) + +- #1707: Add [Closure_origin.t] to trace inlined functions to prevent + infinite loops from repeatedly inlining copies of the same function. + (Fu Yong Quah) + +- #1740: make sure startup.o is always linked in when using + "-output-complete-obj". Previously, it was always linked in only on some + platforms, making this option unusable on platforms where it wasn't. + (Jérémie Dimino, review by Sébastien Hinderer and Xavier Leroy) + +- #9349: Support [@inlined hint] attribute. + (Leo White, review by Stephen Dolan) + +### Runtime system: + +- #515 #676 #7173: Add a public C API for weak arrays and + ephemerons. Update the documentation for a 4.03 change: finalisation + functions are now run before the erasure of the corresponding + values. + (François Bobot and Jacques-Henri Jourdan, review by Mark Shinwell, + Damien Doligez and Frédéric Bour) + +- #6411, #1535: don't compile everything with -static-libgcc on mingw32, + only dllbigarray.dll and libbigarray.a. Allows the use of C++ libraries which + raise exceptions. + (David Allsopp) + +- #7100, #1476: trigger a minor GC when custom blocks accumulate + in minor heap. + (Alain Frisch, report by talex, review by Damien Doligez, Leo White, + Gabriel Scherer) + +- #1431: remove ocamlrun dependencies on curses/terminfo/termcap C library. + (Xavier Leroy, review by Daniel Bünzli) + +- #1478: The Spacetime profiler now works under Windows (but it is not yet + able to collect profiling information from C stubs). + (Nicolás Ojeda Bär, review by Xavier Leroy, Mark Shinwell) + +- #1483: fix GC freelist accounting for chunks larger than the maximum block + size. + (David Allsopp and Damien Doligez) + +- #1526: install the debug and instrumented runtimes + (lib{caml,asm}run{d,i}.a). + (Gabriel Scherer, reminded by Julia Lawall) + +- #1563: simplify implementation of LSRINT and ASRINT. + (Max Mouratov, review by Frédéric Bour) + +- #1644: remove caml_alloc_float_array from the bytecode primitives list + (it's a native code primitive). + (David Allsopp) + +- #1701: fix missing root bug in #1476. + (Mark Shinwell) + +- #1752: do not alias function arguments to sigprocmask. + (Anil Madhavapeddy) + +- #1753: avoid potential off-by-one overflow in debugger socket path length. + (Anil Madhavapeddy) + +### Tools: + +- #7643, #1377: ocamldep, fix an exponential blowup in presence of nested + structures and signatures, e.g. "include struct … include(struct … end) … end" + (Florian Angeletti, review by Gabriel Scherer, report by Christophe Raffalli) + +- #7687, #1653: deprecate -thread option, + which is equivalent to -I +threads. + (Nicolás Ojeda Bär, report by Daniel Bünzli) + +- #7710: `ocamldep -sort` should exit with nonzero code in case of + cyclic dependencies. + (Xavier Leroy, report by Mantis user baileyparker) + +- #1537: boot/ocamldep is no longer included in the source distribution; + boot/ocamlc -depend can be used in its place. + (Nicolás Ojeda Bär, review by Xavier Leroy and Damien Doligez) + +- #1585: optimize output of "ocamllex -ml". + (Alain Frisch, review by Frédéric Bour and Gabriel Scherer) + +- #1667: add command-line options -no-prompt, -no-version, -no-time, + -no-breakpoint-message and -topdirs-path to ocamldebug. + (Sébastien Hinderer, review by Damien Doligez) + +- #1695: add the -null-crc command-line option to ocamlobjinfo. + (Sébastien Hinderer, review by David Allsopp and Gabriel Scherer) + +- #1710: ocamldoc, improve the 'man' rendering of subscripts and + superscripts. + (Gabriel Scherer) + +- #1771: ocamldebug, avoid out of bound access. + (Thomas Refis) + +### Manual and documentation: + +- #7613: minor rewording of the "refutation cases" paragraph. + (Florian Angeletti, review by Jacques Garrigue) + +- #7647, #1384: emphasize ocaml.org website and forum in README. + (Yawar Amin, review by Gabriel Scherer) + +- #7698, #1545: improve wording in OCaml manual in several places, + mostly in Chapter 1. This addresses the easier changes suggested in the PR. + (Jim Fehrle, review by Florian Angeletti and David Allsopp) + +- #1540: manual, decouple verbatim and toplevel style in code examples. + (Florian Angeletti, review by Gabriel Scherer) + +- #1556: manual, add a consistency test for manual references inside + the compiler source code. + (Florian Angeletti, review by Gabriel Scherer) + +- #1647: manual, subsection on record and variant disambiguation. + (Florian Angeletti, review by Alain Frisch and Gabriel Scherer) + +- #1702: manual, add a signature mode for code examples. + (Florian Angeletti, review by Gabriel Scherer) + +- #1741: manual, improve typesetting and legibility in HTML output. + (steinuil, review by Gabriel Scherer) + +- #1757: style the html manual, changing type and layout. + (Charles Chamberlain, review by Florian Angeletti, Xavier Leroy, + Gabriel Radanne, Perry E. Metzger, and Gabriel Scherer) + +- #1765: manual, ellipsis in code examples. + (Florian Angeletti, review and suggestion by Gabriel Scherer) + +- #1767: change html manual to use relative font sizes. + (Charles Chamberlain, review by Daniel Bünzli, Perry E. Metzger, + Josh Berdine, and Gabriel Scherer) + +- #1779: integrate the Bigarray documentation into the main manual. + (Perry E. Metzger, review by Florian Angeletti and Xavier Clerc) + +### Type system: + +- #7611, #1491: reject the use of generative functors as applicative. + (Valentin Gatien-Baron) + +- #7706, #1565: in recursive value declarations, track + static size of locally-defined variables. + (Gabriel Scherer, review by Jeremy Yallop and Leo White, report by Leo White) + +- #7717, #1593: in recursive value declarations, don't treat + unboxed constructor size as statically known. + (Jeremy Yallop, report by Pierre Chambart, review by Gabriel Scherer) + +- #7767, #1712: restore legacy treatment of partially-applied + labeled functions in 'let rec' bindings. + (Jeremy Yallop, report by Ivan Gotovchits, review by Gabriel Scherer) + +* #7787, #1652, #1743: Don't remove module aliases in `module type of` + and `with module`. + The old behaviour can be obtained using the `[@remove_aliases]` attribute. + (Leo White and Thomas Refis, review by Jacques Garrigue) + +- #1468: Do not enrich type_decls with incoherent manifests. + (Thomas Refis and Leo White, review by Jacques Garrigue) + +- #1469: Use the information from [@@immediate] annotations when + computing whether a type can be [@@unboxed]. + (Damien Doligez, report by Stephan Muenzel, review by Alain Frisch) + +- #1513: Allow compilation units to shadow sub-modules of Pervasives. + For instance users can now use a largeFile.ml file in their project. + (Jérémie Dimino, review by Nicolás Ojeda Bär, Alain Frisch and Gabriel + Radanne) + +- #1516: Allow float array construction in recursive bindings + when configured with -no-flat-float-array. + (Jeremy Yallop, report by Gabriel Scherer) + +- #1583: propagate refined ty_arg to Parmatch checks. + (Thomas Refis, review by Jacques Garrigue) + +- #1609: Changes to ambivalence scope tracking. + (Thomas Refis and Leo White, review by Jacques Garrigue) + +- #1628: Treat reraise and raise_notrace as nonexpansive. + (Leo White, review by Alain Frisch) + +* #1778: Fix Soundness bug with non-generalized type variable and + local modules. This is the same bug as #7414, but using local + modules instead of non-local ones. + (Leo White, review by Jacques Garrigue) + +### Compiler distribution build system: + +- #5219, #1680, #1877: use 'install' instead of 'cp' + in install scripts. + (Gabriel Scherer, review by Sébastien Hinderer and Valentin Gatien-Baron) + +- #7679: make sure .a files are erased before calling ar rc, otherwise + leftover .a files from an earlier compilation may contain unwanted modules. + (Xavier Leroy) + +- #1571: do not perform architecture tests on 32-bit platforms, allowing + 64-bit back-ends to use 64-bit specific constructs. + (Xavier Clerc, review by Damien Doligez) + +### Internal/compiler-libs changes: + +- #7738, #1624: Asmlink.reset also resets lib_ccobjs/ccopts. + (Cedric Cellier, review by Gabriel Scherer) + +- #1488, #1560: Refreshing parmatch. + (Gabriel Scherer and Thomas Refis, review by Luc Maranget) + +- #1502: more command line options for expect tests. + (Florian Angeletti, review by Gabriel Scherer) + +- #1511: show code at error location in expect-style tests, + using new Location.show_code_at_location function. + (Gabriel Scherer and Armaël Guéneau, + review by Valentin Gatien-Baron and Damien Doligez) + +- #1519, #1532, #1570: migrate tests to ocamltest. + (Sébastien Hinderer, review by Gabriel Scherer, Valentin Gatien-Baron + and Nicolás Ojeda Bär) + +- #1520: more robust implementation of Misc.no_overflow_mul. + (Max Mouratov, review by Xavier Leroy) + +- #1557: Organise and simplify translation of primitives. + (Leo White, review by François Bobot and Nicolás Ojeda Bär) + +- #1567: register all idents relevant for reraise. + (Thomas Refis, review by Alain Frisch and Frédéric Bour) + +- #1586: testsuite: 'make promote' for ocamltest tests. + (The new "-promote" option for ocamltest is experimental + and subject to change/removal). + (Gabriel Scherer) + +- #1619: expect_test: print all the exceptions, even the unexpected ones. + (Thomas Refis, review by Jérémie Dimino) + +- #1621: expect_test: make sure to not use the installed stdlib. + (Jérémie Dimino, review by Thomas Refis) + +- #1646: add ocamldoc test to ocamltest and + migrate ocamldoc tests to ocamltest. + (Florian Angeletti, review by Sébastien Hinderer) + +- #1663: refactor flambda specialise/inlining handling. + (Leo White and Xavier Clerc, review by Pierre Chambart) + +- #1679: remove Pbittest from primitives in lambda. + (Hugo Heuzard, review by Mark Shinwell) + +* #1704: Make Ident.t abstract and immutable. + (Gabriel Radanne, review by Mark Shinwell) + +- #1699: Clean up Maps and Sets throughout the compiler. + Remove the Tbl module in favor of dedicated Maps. + (Gabriel Radanne, review by Mark Shinwell) + +### Bug fixes: + +- #4499, #1479: Use native Windows API to implement Sys.getenv, + Unix.getenv and Unix.environment under Windows. + (Nicolás Ojeda Bär, report by Alain Frisch, review by David Allsopp, Xavier + Leroy) + +- #5250, #1435: on Cygwin, when ocamlrun searches the path + for a bytecode executable file, skip directories and other + non-regular files, like other Unix variants do. + (Xavier Leroy) + +- #6394, #1425: fix fatal_error from Parmatch.get_type_path. + (Virgile Prevosto, review by David Allsopp, Thomas Refis and Jacques Garrigue) + +* #6604, #931: Only allow directives with filename and at the beginning of + the line. + (Tadeu Zagallo, report by Roberto Di Cosmo, + review by Hongbo Zhang, David Allsopp, Gabriel Scherer, Xavier Leroy) + +- #7138, #7701, #1693: Keep documentation comments + even in empty structures and signatures. + (Leo White, Florian Angeletti, report by Anton Bachin) + +- #7178, #7253, #7796, #1790: Make sure a function + registered with "at_exit" is executed only once when the program exits. + (Nicolás Ojeda Bär and Xavier Leroy, review by Max Mouratov) + +- #7391, #1620: Do not put a dummy method in object types. + (Thomas Refis, review by Jacques Garrigue) + +- #7660, #1445: Use native Windows API to implement Unix.utimes in order to + avoid unintended shifts of the argument timestamp depending on DST setting. + (Nicolás Ojeda Bär, review by David Allsopp, Xavier Leroy) + +- #7668: -principal is broken with polymorphic variants. + (Jacques Garrigue, report by Jun Furuse) + +- #7680, #1497: Incorrect interaction between Matching.for_let and + Simplif.simplify_exits. + (Alain Frisch, report and review by Vincent Laviron) + +- #7682, #1495: fix [@@unboxed] for records with 1 polymorphic field. + (Alain Frisch, report by Stéphane Graham-Lengrand, review by Gabriel Scherer) + +- #7695, #1541: Fatal error: exception Ctype.Unify(_) with field override + (Jacques Garrigue, report by Nicolás Ojeda Bär) + +- #7704, #1564: use proper variant tag in non-exhaustiveness warning. + (Jacques Garrigue, report by Thomas Refis) + +- #7711, #1581: Internal typechecker error triggered by a constraint on + self type in a class type. + (Jacques Garrigue, report and review by Florian Angeletti) + +- #7712, #1576: assertion failure with type abbreviations. + (Thomas Refis, report by Michael O'Connor, review by Jacques Garrigue) + +- #7747: Type checker can loop infinitely and consume all computer memory. + (Jacques Garrigue, report by kantian) + +- #7751, #1657: The toplevel prints some concrete types as abstract. + (Jacques Garrigue, report by Matej Kosik) + +- #7765, #1718: When unmarshaling bigarrays, protect against integer + overflows in size computations. + (Xavier Leroy, report by Maximilian Tschirschnitz, + review by Gabriel Scherer) + +- #7760, #1713: Exact selection of lexing engine, that is + correct "Segfault in ocamllex-generated code using 'shortest'". + (Luc Maranget, Frédéric Bour, report by Stephen Dolan, + review by Gabriel Scherer) + +- #7769, #1714: calls to Stream.junk could, under some conditions, be + ignored when used on streams based on input channels. + (Nicolás Ojeda Bär, report by Michael Perin, review by Gabriel Scherer) + +- #7793, #1766: the toplevel #use directive now accepts sequences of ';;' + tokens. This fixes a bug in which certain files accepted by the compiler were + rejected by ocamldep. + (Nicolás Ojeda Bär, report by Hugo Heuzard, review by Hugo Heuzard) + +- #1517: More robust handling of type variables in mcomp. + (Leo White and Thomas Refis, review by Jacques Garrigue) + +- #1530, #1574: testsuite, fix 'make parallel' and 'make one DIR=...' + to work on ocamltest-based tests. + (Runhang Li and Sébastien Hinderer, review by Gabriel Scherer) + +- #1550, #1555: Make pattern matching warnings more robust + to ill-typed columns. + (Thomas Refis, with help from Gabriel Scherer and Luc Maranget) + +- #1614: consider all bound variables when inlining, fixing a compiler + fatal error. + (Xavier Clerc, review by Pierre Chambart, Leo White) + +- #1622: fix bug in the expansion of command-line arguments under Windows + which could result in some elements of Sys.argv being truncated in some cases. + (Nicolás Ojeda Bär, review by Sébastien Hinderer) + +- #1623: Segfault on Windows 64 bits when expanding wildcards in arguments. + (Marc Lasson, review by David Allsopp, Alain Frisch, Sébastien Hinderer, + Xavier Leroy, Nicolás Ojeda Bär) + +- #1661: more precise principality warning regarding record fields + disambiguation. + (Thomas Refis, review by Leo White) + +- #1687: fix bug in the printing of short functor types "(S1 -> S2) -> S3". + (Pieter Goetschalckx, review by Gabriel Scherer) + +- #1722: Scrape types in Typeopt.maybe_pointer. + (Leo White, review by Thomas Refis) + +- #1755: ensure that a bigarray is never collected while reading complex + values. + (Xavier Clerc, Mark Shinwell and Leo White, report by Chris Hardin, + reviews by Stephen Dolan and Xavier Leroy) + +- #1764: in byterun/memory.c, struct pool_block, use C99 flexible arrays + if available. + (Xavier Leroy, review by Max Mouratov) + +- #1774: ocamlopt for ARM could generate VFP loads and stores with bad + offsets, rejected by the assembler. + (Xavier Leroy, review by Mark Shinwell) + +- #1808: handle `[@inlined]` attributes under a module constraint. + (Xavier Clerc, review by Leo White) + +- #1810: use bit-pattern comparison when meeting float approximations. + (Xavier Clerc, report by Christophe Troestler, review by Nicolás Ojeda Bär + and Gabriel Scherer) + +- #1835: Fix off-by-one errors in Weak.get_copy and Weak.blit. + (KC Sivaramakrishnan) + +- #1849: bug in runtime function generic_final_minor_update() + that could lead to crashes when Gc.finalise_last is used. + (report and fix by Yuriy Vostrikov, review by François Bobot) + + +OCaml 4.06.1 (16 Feb 2018): +--------------------------- + +### Bug fixes: + +- #7661, #1459: fix faulty compilation of patterns + using extensible variants constructors + (Luc Maranget, review by Thomas Refis and Gabriel Scherer, report + by Abdelraouf Ouadjaout and Thibault Suzanne) + +- #7702, #1553: refresh raise counts when inlining a function + (Vincent Laviron, Xavier Clerc, report by Cheng Sun) + +- #7704, #1559: Soundness issue with private rows and pattern-matching + (Jacques Garrigue, report by Jeremy Yallop, review by Thomas Refis) + +- #7705, #1558: add missing bounds check in Bigarray.Genarray.nth_dim. + (Nicolás Ojeda Bär, report by Jeremy Yallop, review by Gabriel Scherer) + +- #7713, #1587: Make pattern matching warnings more robust + to ill-typed columns; this is a backport of #1550 from 4.07+dev + (Thomas Refis, review by Gabriel Scherer, report by Andreas Hauptmann) + +- #1470: Don't commute negation with float comparison + (Leo White, review by Xavier Leroy) + +- #1538: Make pattern matching compilation more robust to ill-typed columns + (Gabriel Scherer and Thomas Refis, review by Luc Maranget) + +OCaml 4.06.0 (3 Nov 2017): +-------------------------- + +(Changes that can break existing programs are marked with a "*") + +### Language features: + +- #6271, #7529, #1249: Support "let open M in ..." + in class expressions and class type expressions. + (Alain Frisch, reviews by Thomas Refis and Jacques Garrigue) + +- #792: fix limitations of destructive substitutions, by + allowing "S with type t := type-expr", + "S with type M.t := type-expr", "S with module M.N := path" + (Valentin Gatien-Baron, review by Jacques Garrigue and Leo White) + +* #1064, #1392: extended indexing operators, add a new class of + user-defined indexing operators, obtained by adding at least + one operator character after the dot symbol to the standard indexing + operators: e,g ".%()", ".?[]", ".@{}<-": + let ( .%() ) = List.nth in [0; 1; 2].%(1) + After this change, functions or methods with an explicit polymorphic type + annotation and of which the first argument is optional now requires a space + between the dot and the question mark, + e.g. "unit>" must now be written "unit>". + (Florian Angeletti, review by Damien Doligez and Gabriel Radanne) + +- #1118: Support inherited field in object type expression + type t = < m : int > + type u = < n : int; t; k : int > + (Runhang Li, review by Jeremy Yallop, Leo White, Jacques Garrigue, + and Florian Angeletti) + +* #1232: Support Unicode character escape sequences in string + literals via the \u{X+} syntax. These escapes are substituted by the + UTF-8 encoding of the Unicode character. + (Daniel Bünzli, review by Damien Doligez, Alain Frisch, Xavier + Leroy and Leo White) + +- #1247: M.(::) construction for expressions + and patterns (plus fix printing of (::) in the toplevel) + (Florian Angeletti, review by Alain Frisch, Gabriel Scherer) + +* #1252: The default mode is now safe-string, can be overridden + at configure time or at compile time. + (See #1386 below for the configure-time options) + This breaks the code that uses the 'string' type as mutable + strings (instead of Bytes.t, introduced by 4.02 in 2014). + (Damien Doligez) + +* #1253: Private extensible variants + This change breaks code relying on the undocumented ability to export + extension constructors for abstract type in signature. Briefly, + module type S = sig + type t + type t += A + end + must now be written + module type S = sig + type t = private .. + type t += A + end + (Leo White, review by Alain Frisch) + +- #1333: turn off warning 40 by default + (Constructor or label name used out of scope) + (Leo White) + +- #1348: accept anonymous type parameters in `with` constraints: + S with type _ t = int + (Valentin Gatien-Baron, report by Jeremy Yallop) + +### Type system + +- #2642, #1225: unique names for weak type variables + # ref [];; + - : '_weak1 list ref = {contents = []} + (Florian Angeletti, review by Frédéric Bour, Jacques Garrigue, + Gabriel Radanne and Gabriel Scherer) + +* #6738, #7215, #7231, #556: Add a new check that 'let rec' + bindings are well formed. + (Jeremy Yallop, reviews by Stephen Dolan, Gabriel Scherer, Leo + White, and Damien Doligez) + +- #1142: Mark assertions nonexpansive, so that 'assert false' + can be used as a placeholder for a polymorphic function. + (Stephen Dolan) + +### Standard library: + +- #8223, #7309, #1026: Add update to maps. Allows to update a + binding in a map or create a new binding if the key had no binding + val update: key -> ('a option -> 'a option) -> 'a t -> 'a t + (Sébastien Briais, review by Daniel Bünzli, Alain Frisch and + Gabriel Scherer) + +- #7515, #1147: Arg.align now optionally uses the tab character '\t' to + separate the "unaligned" and "aligned" parts of the documentation string. If + tab is not present, then space is used as a fallback. Allows to have spaces in + the unaligned part, which is useful for Tuple options. + (Nicolás Ojeda Bär, review by Alain Frisch and Gabriel Scherer) + +* #615: Format, add symbolic formatters that output symbolic + pretty-printing items. New fields have been added to the + formatter_out_functions record, thus this change will break any code building + such record from scratch. + When building Format.formatter_out_functions values redefining the out_spaces + field, "{ fmt_out_funs with out_spaces = f; }" should be replaced by + "{ fmt_out_funs with out_spaces = f; out_indent = f; }" to maintain the old + behavior. + (Richard Bonichon and Pierre Weis, review by Alain Frisch, original request by + Spiros Eliopoulos in #506) + +* #943: Fixed the divergence of the Pervasives module between the stdlib + and threads implementations. In rare circumstances this can change the + behavior of existing applications: the implementation of Pervasives.close_out + used when compiling with thread support was inconsistent with the manual. + It will now not suppress exceptions escaping Pervasives.flush anymore. + Developers who want the old behavior should use Pervasives.close_out_noerr + instead. The stdlib implementation, used by applications not compiled + with thread support, will now only suppress Sys_error exceptions in + Pervasives.flush_all. This should allow exceedingly unlikely assertion + exceptions to escape, which could help reveal bugs in the standard library. + (Markus Mottl, review by Hezekiah M. Carty, Jérémie Dimino, Damien Doligez, + Alain Frisch, Xavier Leroy, Gabriel Scherer and Mark Shinwell) + +- #1034: List.init : int -> (int -> 'a) -> 'a list + (Richard Degenne, review by David Allsopp, Thomas Braibant, Florian + Angeletti, Gabriel Scherer, Nathan Moreau, Alain Frisch) + +- #1091 Add the Uchar.{bom,rep} constants. + (Daniel Bünzli, Alain Frisch) + +- #1091: Add Buffer.add_utf_{8,16le,16be}_uchar to encode Uchar.t + values to the corresponding UTF-X transformation formats in Buffer.t + values. + (Daniel Bünzli, review by Damien Doligez, Max Mouratov) + +- #1175: Bigarray, add a change_layout function to each Array[N] + submodules. + (Florian Angeletti) + +* #1306: In the MSVC and Mingw ports, "Sys.rename src dst" no longer fails if + file "dst" exists, but replaces it with file "src", like in the other ports. + (Xavier Leroy) + +- #1314: Format, use the optional width information + when formatting a boolean: "%8B", "%-8B" for example + (Xavier Clerc, review by Gabriel Scherer) + +- c9cc0f25138ce58e4f4e68c4219afe33e2a9d034: Resurrect tabulation boxes + in module Format. Rewrite/extend documentation of tabulation boxes. + (Pierre Weis) + +### Other libraries: + +- #7564, #1211: Allow forward slashes in the target of symbolic links + created by Unix.symlink under Windows. + (Nicolás Ojeda Bär, review by David Allsopp) + +* #7640, #1414: reimplementation of Unix.execvpe to fix issues + with the 4.05 implementation. The main issue is that the current + directory was always searched (last), even if the current directory + is not listed in the PATH. + (Xavier Leroy, report by Louis Gesbert and Arseniy Alekseyev, + review by Ivan Gotovchits) + +- #997, #1077: Deprecate Bigarray.*.map_file and add Unix.map_file as a + first step towards moving Bigarray to the stdlib + (Jérémie Dimino and Xavier Leroy) + +* #1178: remove the Num library for arbitrary-precision arithmetic. + It now lives as a separate project https://github.com/ocaml/num + with an OPAM package called "num". + (Xavier Leroy) + +- #1217: Restrict Unix.environment in privileged contexts; add + Unix.unsafe_environment. + (Jeremy Yallop, review by Mark Shinwell, Nicolás Ojeda Bär, + Damien Doligez and Hannes Mehnert) + +- #1321: Reimplement Unix.isatty on Windows. It no longer returns true for + the null device. + (David Allsopp) + +### Compiler user-interface and warnings: + +- #7361, #1248: support "ocaml.warning" in all attribute contexts, and + arrange so that "ocaml.ppwarning" is correctly scoped by surrounding + "ocaml.warning" attributes + (Alain Frisch, review by Florian Angeletti and Thomas Refis) + +- #7444, #1138: trigger deprecation warning when a "deprecated" + attribute is hidden by signature coercion + (Alain Frisch, report by bmillwood, review by Leo White) + +- #7472: ensure .cmi files are created atomically, + to avoid corruption of .cmi files produced simultaneously by a run + of ocamlc and a run of ocamlopt. + (Xavier Leroy, from a suggestion by Gerd Stolpmann) + +* #7514, #1152: add -dprofile option, similar to -dtimings but + also displays memory allocation and consumption. + The corresponding addition of a new compiler-internal + Profile module may affect some users of + compilers-libs/ocamlcommon (by creating module conflicts). + (Valentin Gatien-Baron, report by Gabriel Scherer) + +- #7620, #1317: Typecore.force_delayed_checks does not run with -i option + (Jacques Garrigue, report by Jun Furuse) + +- #7624: handle warning attributes placed on let bindings + (Xavier Clerc, report by dinosaure, review by Alain Frisch) + +- #896: "-compat-32" is now taken into account when building .cmo/.cma + (Hugo Heuzard) + +- #948: the compiler now reports warnings-as-errors by prefixing + them with "Error (warning ..):", instead of "Warning ..:" and + a trailing "Error: Some fatal warnings were triggered" message. + (Valentin Gatien-Baron, review by Alain Frisch) + +- #1032: display the output of -dtimings as a hierarchy + (Valentin Gatien-Baron, review by Gabriel Scherer) + +- #1114, #1393, #1429: refine the (ocamlc -config) information + on C compilers: the variables `{bytecode,native}_c_compiler` are deprecated + (the distinction is now mostly meaningless) in favor of a single + `c_compiler` variable combined with `ocaml{c,opt}_cflags` + and `ocaml{c,opt}_cppflags`. + (Sébastien Hinderer, Jeremy Yallop, Gabriel Scherer, review by + Adrien Nader and David Allsopp) + +* #1189: allow MSVC ports to use -l option in ocamlmklib + (David Allsopp) + +- #1332: fix ocamlc handling of "-output-complete-obj" + (François Bobot) + +- #1336: -thread and -vmthread option information is propagated to + PPX rewriters. + (Jun Furuse, review by Alain Frisch) + +### Code generation and optimizations: + +- #5324, #375: An alternative Linear Scan register allocator for + ocamlopt, activated with the -linscan command-line flag. This + allocator represents a trade-off between worse generated code + performance for higher compilation speed (especially interesting in + some cases graph coloring is necessarily quadratic). + (Marcell Fischbach and Benedikt Meurer, adapted by Nicolás Ojeda Bär, review + by Nicolás Ojeda Bär and Alain Frisch) + +- #6927, #988: On macOS, when compiling bytecode stubs, plugins, + and shared libraries through -output-obj, generate dylibs instead of + bundles. + (whitequark) + +- #7447, #995: incorrect code generation for nested recursive bindings + (Leo White and Jeremy Yallop, report by Stephen Dolan) + +- #7501, #1089: Consider arrays of length zero as constants + when using Flambda. + (Pierre Chambart, review by Mark Shinwell and Leo White) + +- #7531, #1162: Erroneous code transformation at partial applications + (Mark Shinwell) + +- #7614, #1313: Ensure that inlining does not depend on the order + of symbols (flambda) + (Leo White, Xavier Clerc, report by Alex, review by Gabriel Scherer + and Pierre Chambart) + +- #7616, #1339: don't warn on mutation of zero size blocks. + (Leo White) + +- #7631, #1355: "-linscan" option crashes ocamlopt + (Xavier Clerc, report by Paul Steckler) + +- #7642, #1411: ARM port: wrong register allocation for integer + multiply on ARMv4 and ARMv5; possible wrong register allocation for + floating-point multiply and add on VFP and for floating-point + negation and absolute value on soft FP emulation. + (Xavier Leroy, report by Stéphane Glondu and Ximin Luo, + review and additional sightings by Mark Shinwell) + +* #659: Remove support for SPARC native code generation + (Mark Shinwell) + +- #850: Optimize away some physical equality + (Pierre Chambart, review by Mark Shinwell and Leo White) + +- #856: Register availability analysis + (Mark Shinwell, Thomas Refis, review by Pierre Chambart) + +- #1143: tweaked several allocation functions in the runtime by + checking for likely conditions before unlikely ones and eliminating + some redundant checks. + (Markus Mottl, review by Alain Frisch, Xavier Leroy, Gabriel Scherer, + Mark Shinwell and Leo White) + +- #1183: compile curried functors to multi-argument functions + earlier in the compiler pipeline; correctly propagate [@@inline] + attributes on such functors; mark functor coercion veneers as + stubs. + (Mark Shinwell, review by Pierre Chambart and Leo White) + +- #1195: Merge functions based on partiality rather than + Parmatch.irrefutable. + (Leo White, review by Thomas Refis, Alain Frisch and Gabriel Scherer) + +- #1215: Improve compilation of short-circuit operators + (Leo White, review by Frédéric Bour and Mark Shinwell) + +- #1250: illegal ARM64 assembly code generated for large combined allocations + (report and initial fix by Steve Walk, review and final fix by Xavier Leroy) + +- #1271: Don't generate Ialloc instructions for closures that exceed + Max_young_wosize; instead allocate them on the major heap. (Related + to #1250.) + (Mark Shinwell) + +- #1294: Add a configure-time option to remove the dynamic float array + optimization and add a floatarray type to let the user choose when to + flatten float arrays. Note that float-only records are unchanged: they + are still optimized by unboxing their fields. + (Damien Doligez, review by Alain Frisch and Mark Shinwell) + +- #1304: Mark registers clobbered by PLT stubs as destroyed across + allocations. + (Mark Shinwell, Xavier Clerc, report and initial debugging by + Valentin Gatien-Baron) + +- #1323: make sure that frame tables are generated in the data + section and not in the read-only data section, as was the case + before in the PPC and System-Z ports. This avoids relocations in + the text segment of shared libraries and position-independent + executables generated by ocamlopt. + (Xavier Leroy, review by Mark Shinwell) + +- #1330: when generating dynamically-linkable code on AArch64, always + reference symbols (even locally-defined ones) through the GOT. + (Mark Shinwell, review by Xavier Leroy) + +### Tools: + +- #8395, #973: tools/check-symbol-names checks for globally + linked names not namespaced with caml_ + (Stephen Dolan) + +- #6928, #1103: ocamldoc, do not introduce an empty

in index.html + when no -title has been provided + (Pierre Boutillier) + +- #7048: ocamldoc, in -latex mode, don't escape Latin-1 accented letters + (Xavier Leroy, report by Hugo Herbelin) + +* #7351: ocamldoc, use semantic tags rather than
tags in the html + backend + (Florian Angeletti, request and review by Daniel Bünzli ) + +* #7352, #7353: ocamldoc, better paragraphs in html output + (Florian Angeletti, request by Daniel Bünzli) + +* #7363, #830: ocamldoc, start heading levels at {1 not {2 or {6. + This change modifies the mapping between ocamldoc heading level and + html heading level, breaking custom css style for ocamldoc. + (Florian Angeletti, request and review by Daniel Bünzli) + +* #7478, #1037: ocamldoc, do not use as a module preamble documentation + comments that occur after the first module element. This change may break + existing documentation. In particular, module preambles must now come before + any `open` statement. + (Florian Angeletti, review by David Allsopp and report by Daniel Bünzli) + +- #7521, #1159: ocamldoc, end generated latex file with a new line + (Florian Angeletti) + +- #7575, #1219: Switch compilers from -no-keep-locs + to -keep-locs by default: produced .cmi files will contain locations. + This provides better error messages. Note that, as a consequence, + .cmi digests now depend on the file path as given to the compiler. + (Daniel Bünzli) + +- #7610, #1346: caml.el (the Emacs editing mode) was cleaned up + and made compatible with Emacs 25. + (Stefan Monnier, Christophe Troestler) + +- #7635, #1383: ocamldoc, add an identifier to module + and module type elements + (Florian Angeletti, review by Yawar Amin and Gabriel Scherer) + +- #681, #1426: Introduce ocamltest, a new test driver for the + OCaml compiler testsuite + (Sébastien Hinderer, review by Damien Doligez) + +- #1012: ocamlyacc, fix parsing of raw strings and nested comments, as well + as the handling of ' characters in identifiers. + (Demi Obenour) + +- #1045: ocamldep, add a "-shared" option to generate dependencies + for native plugin files (i.e. .cmxs files) + (Florian Angeletti, suggestion by Sébastien Hinderer) + +- #1078: add a subcommand "-depend" to "ocamlc" and "ocamlopt", + to behave as ocamldep. Should be used mostly to replace "ocamldep" in the + "boot" directory to reduce its size in the future. + (Fabrice Le Fessant) + +- #1036: ocamlcmt (tools/read_cmt) is installed, converts .cmt to .annot + (Fabrice Le Fessant) + +- #1180: Add support for recording numbers of direct and indirect + calls over the lifetime of a program when using Spacetime profiling + (Mark Shinwell) + +- #1457, ocamldoc: restore label for exception in the latex backend + (omitted since 4.04.0) + (Florian Angeletti, review by Gabriel Scherer) + +### Toplevel: + +- #7570: remove unusable -plugin option from the toplevel + (Florian Angeletti) + +- #1041: -nostdlib no longer ignored by toplevel. + (David Allsopp, review by Xavier Leroy) + +- #1231: improved printing of unicode texts in the toplevel, + unless OCAMLTOP_UTF_8 is set to false. + (Florian Angeletti, review by Daniel Bünzli, Xavier Leroy and + Gabriel Scherer) + +- #1688: Fix printing of -0. + (Nicolás Ojeda Bär, review by Jérémie Dimino) + +### Runtime system: + +* #3771, #153, #1200, #1357, #1362, #1363, #1369, #1398, + #1446, #1448: Unicode support for the Windows runtime. + (ygrek, Nicolás Ojeda Bär, review by Alain Frisch, David Allsopp, Damien + Doligez) + +* #7594, #1274, #1368: String_val now returns 'const char*', not + 'char*' when -safe-string is enabled at configure time. New macro Bytes_val + for accessing bytes values. + (Jeremy Yallop, reviews by Mark Shinwell and Xavier Leroy) + +- #71: The runtime can now be shut down gracefully by means of the new + caml_shutdown and caml_startup_pooled functions. The new 'c' flag in + OCAMLRUNPARAM enables shutting the runtime properly on process exit. + (Max Mouratov, review and discussion by Damien Doligez, Gabriel Scherer, + Mark Shinwell, Thomas Braibant, Stephen Dolan, Pierre Chambart, + François Bobot, Jacques Garrigue, David Allsopp, and Alain Frisch) + +- #938, #1170, #1289: Stack overflow detection on 64-bit Windows + (Olivier Andrieu, tweaked by David Allsopp) + +- #1070, #1295: enable gcc typechecking for caml_alloc_sprintf, + caml_gc_message. Make caml_gc_message a variadic function. Fix many + caml_gc_message format strings. + (Olivier Andrieu, review and 32bit fix by David Allsopp) + +- #1073: Remove statically allocated compare stack. + (Stephen Dolan) + +- #1086: in Sys.getcwd, just fail instead of calling getwd() + if HAS_GETCWD is not set. + (Report and first fix by Sebastian Markbåge, final fix by Xavier Leroy, + review by Mark Shinwell) + +- #1269: Remove 50ms delay at exit for programs using threads + (Valentin Gatien-Baron, review by Stephen Dolan) + +* #1309: open files with O_CLOEXEC (or equivalent) in caml_sys_open, thus + unifying the semantics between Unix and Windows and also eliminating race + condition on Unix. + (David Allsopp, report by Andreas Hauptmann) + +- #1326: Enable use of CFI directives in AArch64 and ARM runtime + systems' assembly code (asmrun/arm64.S). Add CFI directives to enable + unwinding through [caml_c_call] and [caml_call_gc] with correct termination + of unwinding at [main]. + (Mark Shinwell, review by Xavier Leroy and Gabriel Scherer, with thanks + to Daniel Bünzli and Fu Yong Quah for testing) + +- #1338: Add "-g" for bytecode runtime system compilation + (Mark Shinwell) + +* #1416, #1444: switch the Windows 10 Console to UTF-8 encoding. + (David Allsopp, reviews by Nicolás Ojeda Bär and Xavier Leroy) + +### Manual and documentation: + +- #6548: remove obsolete limitation in the description of private + type abbreviations + (Florian Angeletti, suggestion by Leo White) + +- #6676, #1110: move record notation to tutorial + (Florian Angeletti, review by Gabriel Scherer) + +- #6676, #1112: move local opens to tutorial + (Florian Angeletti) + +- #6676, #1153: move overriding class definitions to reference + manual and tutorial + (Florian Angeletti) + +- #6709: document the associativity and precedence level of + pervasive operators + (Florian Angeletti, review by David Allsopp) + +- #7254, #1096: Rudimentary documentation of ocamlnat + (Mark Shinwell) + +- #7281, #1259: fix .TH macros in generated manpages + (Olaf Hering) + +- #7507: Align the description of the printf conversion + specification "%g" with the ISO C90 description. + (Florian Angeletti, suggestion by Armaël Guéneau) + +- #7551, #1194 : make the final ";;" potentially optional in + caml_example + (Florian Angeletti, review and suggestion by Gabriel Scherer) + +- #7588, #1291: make format documentation predictable + (Florian Angeletti, review by Gabriel Radanne) + +- #7604: Minor Ephemeron documentation fixes + (Miod Vallat, review by Florian Angeletti) + +- #594: New chapter on polymorphism troubles: + weakly polymorphic types, polymorphic recursion,and higher-ranked + polymorphism. + (Florian Angeletti, review by Damien Doligez, Gabriel Scherer, + and Gerd Stolpmann) + +- #1187: Minimal documentation for compiler plugins + (Florian Angeletti) + +- #1202: Fix Typos in comments as well as basic grammar errors. + (JP Rodi, review and suggestions by David Allsopp, Max Mouratov, + Florian Angeletti, Xavier Leroy, Mark Shinwell and Damien Doligez) + +- #1220: Fix "-keep-docs" option in ocamlopt manpage + (Etienne Millon) + +### Compiler distribution build system: + +- #6373, #1093: Suppress trigraph warnings from macOS assembler + (Mark Shinwell) + +- #7639, #1371: fix configure script for correct detection of + int64 alignment on Mac OS X 10.13 (High Sierra) and above; fix bug in + configure script relating to such detection. + (Mark Shinwell, report by John Whitington, review by Xavier Leroy) + +- #558: enable shared library and natdynlink support on more Linux + platforms + (Felix Janda, Mark Shinwell) + +* #1104: remove support for the NeXTStep platform + (Sébastien Hinderer) + +- #1130: enable detection of IBM XL C compiler (one need to run configure + with "-cc "). Enable shared library support for + bytecode executables on AIX/xlc (tested on AIX 7.1, XL C 12). + To enable 64-bit, run both "configure" and "make world" with OBJECT_MODE=64. + (Konstantin Romanov, Enrique Naudon) + +- #1203: speed up the manual build by using ocamldoc.opt + (Gabriel Scherer, review by Florian Angeletti) + +- #1214: harden config/Makefile against '#' characters in PREFIX + (Gabriel Scherer, review by David Allsopp and Damien Doligez) + +- #1216: move Compplugin and friends from BYTECOMP to COMP + (Leo White, review by Mark Shinwell) + +* #1242: disable C plugins loading by default + (Alexey Egorov) + +- #1275: correct configure test for Spacetime availability + (Mark Shinwell) + +- #1278: discover presence of during configure for afl runtime + (Hannes Mehnert) + +- #1386: provide configure-time options to fine-tune the safe-string + options and default settings changed by #1252. + + The previous configure option -safe-string is now + renamed -force-safe-string. + + At configure-time, -force-safe-string forces all module to use + immutable strings (this disables the per-file, compile-time + -unsafe-string option). The new default-(un)safe-string options + let you set the default choice for the per-file compile-time + option. (The new #1252 behavior corresponds to having + -default-safe-string, while 4.05 and older had + -default-unsafe-string). + + (Gabriel Scherer, review by Kate Deplaix and Damien Doligez) + +- #1409: Fix to enable NetBSD/powerpc to work. + (Håvard Eidnes) + +### Internal/compiler-libs changes: + +- #6826, #828, #834: improve compilation time for open + (Alain Frisch, review by Frédéric Bour and Jacques Garrigue) + +- #7127, #454, #1058: in toplevel, print bytes and strip + strings longer than the size specified by the "print_length" directive + (Fabrice Le Fessant, initial PR by Junsong Li) + +- #406: remove polymorphic comparison for Types.constructor_tag in compiler + (Dwight Guth, review by Gabriel Radanne, Damien Doligez, Gabriel Scherer, + Pierre Chambart, Mark Shinwell) + +- #1119: Change Set (private) type to inline records. + (Albin Coquereau) + +* #1127: move config/{m,s}.h to byterun/caml and install them. + User code should not have to include them directly since they are + included by other header files. + Previously {m,s}.h were not installed but they were substituted into + caml/config.h; they are now just #include-d by this file. This may + break some scripts relying on the (unspecified) presence of certain + #define in config.h instead of m.h and s.h -- they can be rewritten + to try to grep those files if they exist. + (Sébastien Hinderer) + +- #1281: avoid formatter flushes inside exported printers in Location + (Florian Angeletti, review by Gabriel Scherer) + +### Bug fixes: + +- #5927: Type equality broken for conjunctive polymorphic variant tags + (Jacques Garrigue, report by Leo White) + +- #6329, #1437: Introduce padding word before "data_end" symbols + to ensure page table tests work correctly on an immediately preceding + block of zero size. + (Mark Shinwell, review by Xavier Leroy) + +- #6587: only elide Pervasives from printed type paths in unambiguous context + (Florian Angeletti and Jacques Garrigue) + +- #6934: nonrec misbehaves with GADTs + (Jacques Garrigue, report by Markus Mottl) + +- #7070, #1139: Unexported values can cause non-generalisable variables + error + (Leo White) + +- #7261: Warn on type constraints in GADT declarations + (Jacques Garrigue, report by Fabrice Le Botlan) + +- #7321: Private type in signature clashes with type definition via + functor instantiation + (Jacques Garrigue, report by Markus Mottl) + +- #7372, #834: fix type-checker bug with GADT and inline records + (Alain Frisch, review by Frédéric Bour and Jacques Garrigue) + +- #7344: Inconsistent behavior with type annotations on let + (Jacques Garrigue, report by Leo White) + +- #7468: possible GC problem in caml_alloc_sprintf + (Xavier Leroy, discovery by Olivier Andrieu) + +- #7496: Fixed conjunctive polymorphic variant tags do not unify + with themselves + (Jacques Garrigue, report by Leo White) + +- #7506: pprintast ignores attributes in tails of a list + (Alain Frisch, report by Kenichi Asai and Gabriel Scherer) + +- #7513: List.compare_length_with mishandles negative numbers / overflow + (Fabrice Le Fessant, report by Jeremy Yallop) + +- #7519: Incorrect rejection of program due to faux scope escape + (Jacques Garrigue, report by Markus Mottl) + +- #7540, #1179: Fixed setting of breakpoints within packed modules + for ocamldebug + (Hugo Herbelin, review by Gabriel Scherer, Damien Doligez) + +- #7543: short-paths printtyp can fail on packed type error messages + (Florian Angeletti) + +- #7553, #1191: Prevent repeated warnings with recursive modules. + (Leo White, review by Josh Berdine and Alain Frisch) + +- #7563, #1210: code generation bug when a module alias and + an extension constructor have the same name in the same module + (Gabriel Scherer, report by Manuel Fähndrich, + review by Jacques Garrigue and Leo White) + +- #7591, #1257: on x86-64, frame table is not 8-aligned + (Xavier Leroy, report by Mantis user "voglerr", review by Gabriel Scherer) + +- #7601, #1320: It seems like a hidden non-generalized type variable + remains in some inferred signatures, which leads to strange errors + (Jacques Garrigue, report by Mandrikin) + +- #7609: use-after-free memory corruption if a program debugged + under ocamldebug calls Pervasives.flush_all + (Xavier Leroy, report by Paul Steckler, review by Gabriel Scherer) + +- #7612, #1345: afl-instrumentation bugfix for classes. + (Stephen Dolan, review by Gabriel Scherer and David Allsopp) + +- #7617, #7618, #1318: Ambiguous (mistakenly) type escaping the + scope of its equation + (Jacques Garrigue, report by Thomas Refis) + +- #7619, #1387: position of the optional last semi-column not included + in the position of the expression (same behavior as for lists) + (Christophe Raffalli, review by Gabriel Scherer) + +- #7638: in the Windows Mingw64 port, multithreaded programs compiled + to bytecode could crash when raising an exception from C code. + This looks like a Mingw64 issue, which we work around with GCC builtins. + (Xavier Leroy) + +- #7656, #1423: false 'unused type/constructor/value' alarms + in the 4.06 development version + (Alain Frisch, review by Jacques Garrigue, report by Kate Deplaix) + +- #7657, #1424: ensures correct call-by-value semantics when + eta-expanding functions to eliminate optional arguments + (Alain Frisch, report by sliquister, review by Leo White and Jacques + Garrigue) + +- #7658, #1439: Fix Spacetime runtime system compilation with + -force-safe-string + (Mark Shinwell, report by Christoph Spiel, review by Gabriel Scherer) + +- #1155: Fix a race condition with WAIT_NOHANG on Windows + (Jérémie Dimino and David Allsopp) + +- #1199: Pretty-printing formatting cleanup in pprintast + (Ethan Aubin, suggestion by Gabriel Scherer, review by David Allsopp, + Florian Angeletti, and Gabriel Scherer) + +- #1223: Fix corruption of the environment when using -short-paths + with the toplevel. + (Leo White, review by Alain Frisch) + +- #1243: Fix pprintast for #... infix operators + (Alain Frisch, report by Omar Chebib) + +- #1324: ensure that flambda warning are printed only once + (Xavier Clerc) + +- #1329: Prevent recursive polymorphic variant names + (Jacques Garrigue, fix suggested by Leo White) + +- #1308: Only treat pure patterns as inactive + (Leo White, review by Alain Frisch and Gabriel Scherer) + +- #1390: fix the [@@unboxed] type check to accept parametrized types + (Leo White, review by Damien Doligez) + +- #1407: Fix raw_spacetime_lib + (Leo White, review by Gabriel Scherer and Damien Doligez) + +OCaml 4.05.0 (13 Jul 2017): +--------------------------- + +(Changes that can break existing programs are marked with a "*") + +### Language features: + +### Code generation and optimizations: + +- #7201, #954: Correct wrong optimisation of "0 / " + and "0 mod " in the case when was a non-constant + evaluating to zero + (Mark Shinwell, review by Gabriel Scherer, Leo White and Xavier Leroy) + +- #7357, #832: Improve compilation time for toplevel + include(struct ... end : sig ... end) + (Alain Frisch, report by Hongbo Zhang, review by Jacques Garrigue) + +- #7533, #1173: Correctly perform side effects for certain + cases of "/" and "mod" + (Mark Shinwell, report by Jan Mitgaard) + +- #504: Instrumentation support for fuzzing with afl-fuzz. + (Stephen Dolan, review by Alain Frisch, Pierre Chambart, Mark + Shinwell, Gabriel Scherer and Damien Doligez) + +- #863, #1068, #1069: Optimise matches with constant + results to lookup tables. + (Stephen Dolan, review by Gabriel Scherer, Pierre Chambart, + Mark Shinwell, and bug report by Gabriel Scherer) + +- #1150: Fix typo in arm64 assembler directives + (KC Sivaramakrishnan) + +### Runtime system: + +- #2784, #953: Add caml_startup_exn + (Mark Shinwell) + +- #7423, #946: expose new exception-raising functions + `void caml_{failwith,invalid_argument}_value(value msg)` + in addition to + `void caml_{failwith,invalid_argument}(char const *msg)`. + The previous functions would not free their message argument, so + were inconvient for dynamically-allocated messages; the messages + passed to the new functions are handled by the garbage collector. + (Gabriel Scherer, review by Mark Shinwell, request by Immanuel Litzroth) + +- #7557, #1213: More security for getenv + (Damien Doligez, reports by Seth Arnold and Eric Milliken, review by + Xavier Leroy, David Allsopp, Stephen Dolan, Hannes Mehnert) + +- #795: remove 256-character limitation on Sys.executable_name + (Xavier Leroy) + +- #891: Use -fno-builtin-memcmp when building runtime with gcc. + (Leo White) + +### Type system: + +- #6608, #901: unify record types when overriding all fields + (Tadeu Zagallo and Gabriel Scherer, report by Jeremy Yallop, + review by David Allsopp, Jacques Garrigue) + +* #7414, #929: Soundness bug with non-generalized type variables and + functors. + (compatibility: some code using module-global mutable state will + fail at compile-time and is fixed by adding extra annotations; + see the Mantis and Github discussions.) + (Jacques Garrigue, report by Leo White) + +### Compiler user-interface and warnings: + +- #7050, #748 #843 #864: new `-args/-args0 ` parameters to + provide extra command-line arguments in a file -- see documentation. + User programs may implement similar options using the new `Expand` + constructor of the `Arg` module. + (Bernhard Schommer, review by Jérémie Dimino, Gabriel Scherer + and Damien Doligez, discussion with Alain Frisch and Xavier Leroy, + feature request from the Coq team) + +- #7137, #960: "-open" command line flag now accepts + a module path (not a module name) + (Arseniy Alekseyev and Leo White) + +- #7172, #970: add extra (ocamlc -config) options + int_size, word_size, ext_exe + (Gabriel Scherer, request by Daniel Bünzli) + +- #7315, #736: refine some error locations + (Gabriel Scherer and Alain Frisch, report by Matej Košík) + +- #7473, #1025: perform proper globbing for command-line arguments on + Windows + (Jonathan Protzenko) + +- #7479: make sure "ocamlc -pack" is only given .cmo and .cmi files, + and that "ocamlopt -pack" is only given .cmx and .cmi files. + (Xavier Leroy) + +- #796: allow compiler plugins to declare their own arguments. + (Fabrice Le Fessant) + +- #829: better error when opening a module aliased to a functor + (Alain Frisch) + +- #911: ocamlc/ocamlopt do not pass warnings-related options to C + compiler when called to compile third-party C source files + (Sébastien Hinderer, review by Adrien Nader and David Allsopp) + +- #915: fix -dsource (pprintast.ml) bugs + (Runhang Li, review by Alain Frisch) + +* #933: ocamlopt -p now reports an error on platforms that do not + support profiling with gprof; dummy profiling libraries are no longer + installed on such platforms. + This can be tested with ocamlopt -config + (Sébastien Hinderer) + +- #1009: "ocamlc -c -linkall" and "ocamlopt -c -linkall" can now be used + to set the "always link" flag on individual compilation units. This + controls linking with finer granularity than "-a -linkall", which sets + the "always link" flag on all units of the given library. + (Xavier Leroy) + +- #1015: add option "-plugin PLUGIN" to ocamldep too. Use compilerlibs + to build ocamldep. Add option "-depend" to ocamlc/ocamlopt to behave + as ocamldep. Remove any use of ocamldep to build the distribution. + (Fabrice Le Fessant) + +- #1027: various improvements to -dtimings, mostly including time + spent in subprocesses like preprocessors + (Valentin Gatien-Baron, review by Gabriel Scherer) + +- #1098: the compiler now takes the boolean "OCAML_COLOR" environment + variable into account if "-color" is not provided. This allows users + to override the default behaviour without modifying invocations of ocaml + manually. + (Hannes Mehnert, Guillaume Bury, + review by Daniel Bünzli, Gabriel Scherer, Damien Doligez) + +### Standard library: + +- #6975, #902: Truncate function added to stdlib Buffer module + (Dhruv Makwana, review by Alain Frisch and Gabriel Scherer) + +- #7279, #710: `Weak.get_copy` `Ephemeron.*_copy` doesn't copy + custom blocks anymore + (François Bobot, Alain Frisch, bug reported by Martin R. Neuhäußer, + review by Thomas Braibant and Damien Doligez) + +* #7500, #1081: Remove Uchar.dump + (Daniel Bünzli) + +- #760: Add a functions List.compare_lengths and + List.compare_length_with to avoid full list length computations + (Fabrice Le Fessant, review by Leo White, Josh Berdine and Gabriel Scherer) + +- #778: Arg: added option Expand that allows to expand a string + argument to a string array of new arguments + (Bernhard Schommer, review by Gabriel Scherer and Jérémie Dimino) + +- #849: Expose a Spacetime.enabled value + (Leo White) + +- #885: Option-returning variants of stdlib functions + (Alain Frisch, review by David Allsopp and Bart Jacobs) + +- #869: Add find_first, find_first_opt, find_last, find_last_opt to + maps and sets. Find the first or last binding or element + satisfying a monotonic predicate. + (Gabriel de Perthuis, with contributions from Alain Frisch, review by + Hezekiah M. Carty and Simon Cruanes, initial report by Gerd Stolpmann) + +- #875: Add missing functions to ArrayLabels, BytesLabels, + ListLabels, MoreLabels, StringLabels so they are compatible with + non-labeled counterparts. Also add missing @@ocaml.deprecated attributes + in StringLabels and BytesLabels. + (Roma Sokolov, review by Gabriel Scherer, Jacques Garrigue, + Gabriel Radanne, Alain Frisch) + +- #999: Arg, do not repeat the usage message thrice when reporting an error + (this was a regression in 4.03) + (Florian Angeletti, review by Gabriel Scherer) + +- #1042: Fix escaping of command-line arguments in + Unix.create_process{,_env} under Windows. Arguments with tabs should now + be received verbatim by the child process. + (Nicolás Ojeda Bär, Andreas Hauptmann review by Xavier Leroy) + +### Debugging and profiling: + +- #7258: ocamldebug's "install_printer" command had problems with + module aliases + (Xavier Leroy) + +- #378: Add [Printexc.raise_with_backtrace] to raise an exception using + an explicit backtrace + (François Bobot, review by Gabriel Scherer, Xavier Leroy, Damien Doligez, + Frédéric Bour) + +### Manual and documentation: + +- #6597, #1030: add forward references to language extensions + that extend non-terminal symbols in the language reference section. + (Florian Angeletti, review by Gabriel Scherer) + +- #7497, #1095: manual, enable numbering for table of contents + (Florian Angeletti, request by Daniel Bünzli) + +- #7539, #1181: manual, update dead links in ocamldoc chapter + (Florian Angeletti) + +- #633: manpage and manual documentation for the `-opaque` option + (Konstantin Romanov, Gabriel Scherer, review by Mark Shinwell) + +- #751, #925: add a HACKING.adoc file to contain various + tips and tricks for people hacking on the repository. See also + CONTRIBUTING.md for advice on sending contributions upstream. + (Gabriel Scherer and Gabriel Radanne, review by David Allsopp, + inspired by John Whitington) + +- #916: new tool lintapidiff, use it to update the manual with + @since annotations for API changes introduced between 4.00-4.05. + (Edwin Török, review by Gabriel Scherer, discussion with Alain Frisch, + David Allsopp, Sébastien Hinderer, Damien Doligez and Xavier Leroy) + +- #939: activate the caml_example environment in the language + extensions section of the manual. Convert some existing code + examples to this format. + (Florian Angeletti) + +- #1082: clarify that the use of quoted string for preprocessed + foreign quotations still requires the use of an extension node + [%foo ...] to mark non-standard interpretation. + (Gabriel Scherer, request by Matthew Wahab in #1066, + review by Florian Angeletti) + +### Other libraries: + +- #7158: Event.sync, Mutex.create, Condition.create cause too many GCs. + The fix is to no longer consider mutexes and condition variables + as rare kernel resources. + (Xavier Leroy) + +- #7264: document the different behaviors of Unix.lockf under POSIX + and under Win32. + (Xavier Leroy, report by David Allsopp) + +- #7339, #787: Support the '0 dimension' case for bigarrays + (see Bigarray documentation) + (Laurent Mazare, + review by Gabriel Scherer, Alain Frisch and Hezekiah M. Carty) + +* #7342, #797: fix Unix.read on pipes with no data left on Windows + it previously raised an EPIPE error, it now returns 0 like other OSes + (Jonathan Protzenko, review by Andreas Hauptmann and Damien Doligez) + +- #650: in the Unix library, add `?cloexec:bool` optional arguments to + functions that create file descriptors (`dup`, `dup2`, `pipe`, `socket`, + `socketpair`, `accept`). Implement these optional arguments in the + most atomic manner provided by the operating system to set (or clear) + the close-on-exec flag at the same time the file descriptor is created, + reducing the risk of race conditions with `exec` or `create_process` + calls running in other threads, and improving security. Also: add a + `O_KEEPEXEC` flag for `openfile` by symmetry with `O_CLOEXEC`. + (Xavier Leroy, review by Mark Shinwell, David Allsopp and Alain Frisch, + request by Romain Beauxis) + +- #996: correctly update caml_top_of_stack in systhreads + (Fabrice Le Fessant) + +- #997, #1077: Deprecate Bigarray.*.map_file and add Unix.map_file as a + first step towards moving Bigarray to the stdlib + (Jérémie Dimino and Xavier Leroy) + +### Toplevel: + +- #7060, #1035: Print exceptions in installed custom printers + (Tadeu Zagallo, review by David Allsopp) + +### Tools: + +- #5163: ocamlobjinfo, dump globals defined by bytecode executables + (Stéphane Glondu) + +- #7333: ocamldoc, use the first sentence of text file as + a short description in overviews. + (Florian Angeletti) + +- #848: ocamldoc, escape link targets in HTML output + (Etienne Millon, review by Gabriel Scherer, Florian Angeletti and + Daniel Bünzli) + +- #986: ocamldoc, use relative paths in error message + to solve ocamlbuild+doc usability issue (ocaml/ocamlbuild#79) + (Gabriel Scherer, review by Florian Angeletti, discussion with Daniel Bünzli) + +- #1017: ocamldoc, add an option to detect code fragments that could be + transformed into a cross-reference to a known element. + (Florian Angeletti, review and suggestion by David Allsopp) + +- clarify ocamldoc text parsing error messages + (Gabriel Scherer) + +### Compiler distribution build system: + +- #7377: remove -std=gnu99 for newer gcc versions + (Damien Doligez, report by ygrek) + +- #7452, #1228: tweak GCC options to try to avoid the + Skylake/Kaby lake bug + (Damien Doligez, review by David Allsopp, Xavier Leroy and Mark Shinwell) + +- #693: fail on unexpected errors or warnings within caml_example + environment. + (Florian Angeletti) + +- #803: new ocamllex-based tool to extract bytecode compiler + opcode information from C headers. + (Nicolás Ojeda Bär) + +- #827: install missing mli and cmti files, new make target + install-compiler-sources for installation of compiler-libs ml files + (Hendrik Tews) + +- #887: allow -with-frame-pointers if clang is used as compiler on Linux + (Bernhard Schommer) + +- #898: fix locale-dependence of primitive list order, + detected through reproducible-builds.org. + (Hannes Mehnert, review by Gabriel Scherer and Ximin Luo) + +- #907: Remove unused variable from the build system + (Sébastien Hinderer, review by whitequark, Gabriel Scherer, Adrien Nader) + +- #911: Clarify the use of C compiler related variables in the build system. + (Sébastien Hinderer, review by Adrien Nader, Alain Frisch, David Allsopp) + +- #919: use clang as preprocessor assembler if clang is used as compiler + (Bernhard Schommer) + +- #927: improve the detection of hashbang support in the configure script + (Armaël Guéneau) + +- #932: install ocaml{c,lex}->ocaml{c,lex}.byte symlink correctly + when the opt target is built but opt.opt target is not. + (whitequark, review by Gabriel Scherer) + +- #935: allow build in Android's termux + (ygrek, review by Gabriel Scherer) + +- #984: Fix compilation of compiler distribution when Spacetime + enabled + (Mark Shinwell) + +- #991: On Windows, fix installation when native compiler is not + built + (Sébastien Hinderer, review by David Allsopp) + +- #1033: merge Unix and Windows build systems in the root directory + (Sébastien Hinderer, review by Damien Doligez and Adrien Nader) + +- #1047: Make .depend files generated for C sources more portable + (Sébastien Hinderer, review by Xavier Leroy and David Allsopp) + +- #1076: Simplify ocamlyacc's build system + (Sébastien Hinderer, review by David Allsopp) + +### Compiler distribution build system: Makefile factorization + +The compiler distribution build system (the set of Makefiles used to +build the compiler distribution) traditionally had separate Makefiles +for Unix and Windows, which lead to some amount of duplication and +subtle differences and technical debt in general -- for people working +on the compiler distribution, but also cross-compilation or porting to +new systems. During the 4.05 development period, Sébastien Hinderer +worked on harmonizing the build rules and merging the two build +systems. + +* Some changes were made to the config/Makefile file which + is exported as $(ocamlc -where)/Makefile.config, and on + which some advanced users might rely. The changes are + as follows: + - a BYTERUN variable was added that points to the installed ocamlrun + - the PARTIALLD variable was removed (PACKLD is more complete) + - the always-empty DLLCCCOMPOPTS was removed + - the SHARED variable was removed; its value is "shared" or "noshared", + which duplicates the existing and more convenient + SUPPORTS_SHARED_LIBRARIES variable whose value is "true" or "false". + + Note that Makefile.config may change further in the future and relying + on it is a bit fragile. We plan to make `ocamlc -config` easier to use + for scripting purposes, and have a stable interface there. If you rely + on Makefile.config, you may want to get in touch with Sébastien Hinderer + or participate to #7116 (Allow easy retrieval of Makefile.config's values) + or #7172 (More information in ocamlc -config). + +The complete list of changes is listed below. + +- #705: update Makefile.nt so that ocamlnat compiles + for non-Cygwin Windows ports. + (Sébastien Hinderer, review by Alain Frisch) + +- #729: Make sure ocamlnat is built with a $(EXE) extension, merge + rules between Unix and Windows Makefiles + (Sébastien Hinderer, review by Alain Frisch) + +- #762: Merge build systems in the yacc/ directory. + (Sébastien Hinderer, review by David Allsopp, Alain Frisch) + +- #764: Merge build systems in the debugger/ directory. + (Sébastien Hinderer, review by Alain Frisch) + +- #785: Merge build systems in otherlibs/systhreads/ + (Sébastien Hinderer, review by Alain Frisch, David Allsopp, + testing and regression fix by Jérémie Dimino) + +- #788: Merge build systems in subdirectories of otherlibs/. + (Sébastien Hinderer, review by Alain Frisch) + +- #808, #906: Merge Unix and Windows build systems + in the ocamldoc/ directory + (Sébastien Hinderer, review by Alain Frisch) + +- #812: Merge build systems in the tools/ subdirectory + (Sébastien Hinderer, review by Alain Frisch) + +- #866: Merge build systems in the stdlib/ directory + (Sébastien Hinderer, review by David Allsopp and Adrien Nader) + +- #941: Merge Unix and Windows build systems in the asmrun/ directory + (Sébastien Hinderer, review by Mark Shinwell, Adrien Nader, + Xavier Leroy, David Allsopp, Damien Doligez) + +- #981: Merge build systems in the byterun/ directory + (Sébastien Hinderer, review by Adrien Nader) + +- #1033, #1048: Merge build systems in the root directory + (Sébastien Hinderer, review by Adrien Nader and Damien Doligez, + testing and regression fix by Andreas Hauptmann) + +### Internal/compiler-libs changes: + +- #673: distinguish initialization of block fields from mutation in lambda. + (Frédéric Bour, review by Xavier Leroy, Stephen Dolan and Mark Shinwell) + +- #744, #781: fix duplicate self-reference in imported cmi_crcs + list in .cmti files + avoid rebuilding cmi_info record when creating + .cmti files + (Alain Frisch, report by Daniel Bünzli, review by Jérémie Dimino) + +- #881: change `Outcometree.out_variant` to be more general. + `Ovar_name of out_ident * out_type list` becomes `Ovar_type of out_type`. + (Valentin Gatien-Baron, review by Leo White) + +- #908: refactor PIC-handling in the s390x backend + (Gabriel Scherer, review by Xavier Leroy and Mark Shinwell) + +### Bug fixes: + +- #5115: protect all byterun/fail.c functions against + uninitialized caml_global_data (only changes the bytecode behavior) + (Gabriel Scherer, review by Xavier Leroy) + +- #6136, #967: Fix Closure so that overapplication evaluation order + matches the bytecode compiler and Flambda. + (Mark Shinwell, report by Jeremy Yallop, review by Frédéric Bour) + +- #6550, #1094: Allow creation of empty .cmxa files on macOS + (Mark Shinwell) + +- #6594, #955: Remove "Istore_symbol" specific operation on x86-64. + This is more robust and in particular avoids assembly failures on Win64. + (Mark Shinwell, review by Xavier Leroy, testing by David Allsopp and + Olivier Andrieu) + +- #6903: Unix.execvpe doesn't change environment on Cygwin + (Xavier Leroy, report by Adrien Nader) + +- #6987: Strange error message probably caused by + universal variable escape (with polymorphic variants) + (Jacques Garrigue, report by Mikhail Mandrykin and Leo White) + +- #7216, #949: don't require double parens in Functor((val x)) + (Jacques Garrigue, review by Valentin Gatien-Baron) + +- #7331: ocamldoc, avoid infinite loop in presence of self alias, + i.e. module rec M:sig end = M + (Florian Angeletti, review Gabriel Scherer) + +- #7346, #966: Fix evaluation order problem whereby expressions could + be incorrectly re-ordered when compiling with Flambda. This also fixes one + example of evaluation order in the native code compiler not matching the + bytecode compiler (even when not using Flambda) + (Mark Shinwell, Leo White, code review by Pierre Chambart) + +- #7348: Private row variables can escape their scope + (Jacques Garrigue, report by Leo White) + +- #7407: Two not-quite-standard C idioms rejected by SUNWSPro compilers + (Xavier Leroy) + +- #7421: Soundness bug with GADTs and lazy + (Jacques Garrigue, report by Leo White) + +- #7424: Typechecker diverges on unboxed type declaration + (Jacques Garrigue, report by Stephen Dolan) + +- #7426, #965: Fix fatal error during object compilation (also + introduces new [Pfield_computed] and [Psetfield_computed] primitives) + (Mark Shinwell, report by Ulrich Singer) + +- #7427, #959: Don't delete let bodies in Cmmgen + (Mark Shinwell, report by Valentin Gatien-Baron) + +- #7432: Linking modules compiled with -labels and -nolabels is not safe + (Jacques Garrigue, report by Jeremy Yallop) + +- #7437: typing assert failure with nonrec priv + (Jacques Garrigue, report by Anil Madhavapeddy) + +- #7438: warning +34 exposes #row with private types + (Alain Frisch, report by Anil Madhavapeddy) + +- #7443, #990: spurious unused open warning with local open in patterns + (Florian Angeletti, report by Gabriel Scherer) + +- #7456, #1092: fix slow compilation on source files containing a lot + of similar debugging information location entries + (Mark Shinwell) + +- #7504: fix warning 8 with unconstrained records + (Florian Angeletti, report by John Whitington) + +- #7511, #1133: Unboxed type with unboxed argument should not be accepted + (Damien Doligez, review by Jeremy Yallop and Leo White) + +- #805, #815, #833: check for integer overflow in String.concat + (Jeremy Yallop, + review by Damien Doligez, Alain Frisch, Daniel Bünzli, Fabrice Le Fessant) + +- #881: short-paths did not apply to some polymorphic variants + (Valentin Gatien-Baron, review by Leo White) + +- #886: Fix Ctype.moregeneral's handling of row_name + (Leo White, review by Jacques Garrigue) + +- #934: check for integer overflow in Bytes.extend + (Jeremy Yallop, review by Gabriel Scherer) + +- #956: Keep possibly-effectful expressions when optimizing multiplication + by zero. + (Jeremy Yallop, review by Nicolás Ojeda Bär, Xavier Leroy and Mark Shinwell) + +- #977: Catch Out_of_range in ocamldebug's "list" command + (Yunxing Dai) + +- #983: Avoid removing effectful expressions in Closure, and + eliminate more non-effectful ones + (Alain Frisch, review by Mark Shinwell and Gabriel Scherer) + +- #987: alloc_sockaddr: don't assume a null terminator. It is not inserted + on macOS by system calls that fill in a struct sockaddr (e.g. getsockname). + (Anton Bachin) + +- #998: Do not delete unused closures in un_anf.ml. + (Leo White, review by Mark Shinwell and Pierre Chambart) + +- #1019: Fix fatal error in Flambda mode "[functions] does not map set of + closures ID" + (Pierre Chambart, code review by Mark Shinwell and Leo White) + +- #1075: Ensure that zero-sized float arrays have zero tags. + (Mark Shinwell, Leo White, review by Xavier Leroy) + +* #1088: Gc.minor_words now returns accurate numbers. + (compatibility: the .mli declaration of `Gc.minor_words` + and `Gc.get_minor_free` changed, which may break libraries + re-exporting these values.) + (Stephen Dolan, review by Pierre Chambart and Xavier Leroy) + +OCaml 4.04.2 (23 Jun 2017): +--------------------------- + +### Security fix: + +- #7557: Local privilege escalation issue with ocaml binaries. + (Damien Doligez, report by Eric Milliken, review by Xavier Leroy) + +OCaml 4.04.1 (14 Apr 2017): +--------------------------- + +### Standard library: + +- #7403, #894: fix a bug in Set.map as introduced in 4.04.0 + (Gabriel Scherer, report by Thomas Leonard) + +### Tools: + +- #7411: ocamldoc, avoid nested 
 tags in module description.
+  (Florian Angeletti, report by user 'kosik')
+
+- #7488: ocamldoc, wrong Latex output for variant types
+  with constructors without arguments.
+  (Florian Angeletti, report by Xavier Leroy)
+
+### Build system:
+
+- #7373, #1023: New flexlink target in Makefile.nt to bootstrap the
+  flexlink binary only, rather than the flexlink binary and the FlexDLL C
+  objects.
+  (David Allsopp)
+
+### Bug fixes:
+
+- #7369: Str.regexp raises "Invalid_argument: index out of bounds"
+  (Damien Doligez, report by John Whitington)
+
+- #7373, #1023: Fix ocamlmklib with bootstrapped FlexDLL. Bootstrapped
+  FlexDLL objects are now installed to a subdirectory flexdll of the Standard
+  Library which allows the compilers to pick them up explicitly and also
+  ocamlmklib to include them without unnecessarily adding the entire Standard
+  Library.
+  (David Allsopp)
+
+- #7385, #1057: fix incorrect timestamps returned by Unix.stat on Windows
+  when either TZ is set or system date is in DST.
+  (David Allsopp, report and initial fix by Nicolás Ojeda Bär, review and
+   superior implementation suggestion by Xavier Leroy)
+
+- #7405, #903: s390x: Fix address of caml_raise_exn in native dynlink
+  modules.
+  (Richard Jones, review by Xavier Leroy)
+
+- #7417, #930: ensure 16 byte stack alignment inside caml_allocN on x86-64
+  for ocaml build with WITH_FRAME_POINTERS defined
+  (Christoph Cullmann)
+
+- #7456, #1092: fix slow compilation on source files containing a lot
+  of similar debugging information location entries
+  (Mark Shinwell)
+
+- #7457: a case of double free in the systhreads library (POSIX
+  implementation).
+  (Xavier Leroy, report by Chet Murthy)
+
+- #7460, #1011: catch uncaught exception when unknown files are passed
+  as argument (regression in 4.04.0)
+  (Bernhard Schommer, review by Florian Angeletti and Gabriel Scherer,
+   report by Stephen Dolan)
+
+- #7505: Memory cannot be released after calling
+    Bigarray.Genarray.change_layout.
+  (Damien Doligez and Xavier Leroy, report by Liang Wang)
+
+- #912: Fix segfault in Unix.create_process on Windows caused by wrong header
+  configuration.
+  (David Allsopp)
+
+- #980: add dynlink options to ocamlbytecomp.cmxa to allow ocamlopt.opt
+  to load plugins. See http://github.com/OCamlPro/ocamlc-plugins for examples.
+  (Fabrice Le Fessant, review by David Allsopp)
+
+- #992: caml-types.el: Fix missing format argument, so that it can show kind
+  of call at point correctly.
+  (Chunhui He)
+
+- #1043: Allow Windows CRLF line-endings in ocamlyacc on Unix and Cygwin.
+  (David Allsopp, review by Damien Doligez and Xavier Leroy)
+
+- #1072: Fix segfault in Sys.runtime_parameters when exception backtraces
+  are enabled.
+  (Olivier Andrieu)
+
+OCaml 4.04.0 (4 Nov 2016):
+--------------------------
+
+(Changes that can break existing programs are marked with a "*")
+
+### Language features:
+
+- #7233: Support GADT equations on non-local abstract types
+  (Jacques Garrigue)
+
+- #187, #578: Local opening of modules in a pattern.
+  Syntax: "M.(p)", "M.[p]","M.[| p |]", "M.{p}"
+  (Florian Angeletti, Jacques Garrigue, review by Alain Frisch)
+
+- #301: local exception declarations "let exception ... in"
+  (Alain Frisch)
+
+- #508: Allow shortcut for extension on semicolons: ;%foo
+  (Jérémie Dimino)
+
+- #606: optimized representation for immutable records with a single
+  field, and concrete types with a single constructor with a single argument.
+  This is triggered with a [@@unboxed] attribute on the type definition.
+  Currently mutually recursive datatypes are not well supported, this
+  limitation should be lifted in the future (see #7364).
+  (Damien Doligez)
+
+### Compiler user-interface and warnings:
+
+* #6475, #464: interpret all command-line options before compiling any
+  files, changes (improves) the semantics of repeated -o options or -o
+  combined with -c see the super-detailed commit message at
+  https://github.com/ocaml/ocaml/commit/da56cf6dfdc13c09905c2e07f1d4849c8346eec8
+  (whitequark)
+
+- #7139: clarify the wording of Warning 38
+  (Unused exception or extension constructor)
+  (Gabriel Scherer)
+
+* #7147, #475: add colors when reporting errors generated by ppx rewriters.
+  Remove the `Location.errorf_prefixed` function which is no longer relevant
+  (Simon Cruanes, Jérémie Dimino)
+
+- #7169, #501: clarify the wording of Warning 8
+  (Non-exhaustivity warning for pattern matching)
+  (Florian Angeletti, review and report by Gabriel Scherer)
+
+* #591: Improve support for OCAMLPARAM: (i) do not use objects
+  files with -a, -pack, -shared; (ii) use "before" objects in the toplevel
+  (but not "after" objects); (iii) use -I dirs in the toplevel,
+  (iv) fix bug where -I dirs were ignored when using threads
+  (Marc Lasson, review by Damien Doligez and Alain Frisch)
+
+- #648: New -plugin option for ocamlc and ocamlopt, to dynamically extend
+  the compilers at runtime.
+  (Fabrice Le Fessant)
+
+- #684: Detect unused module declarations
+  (Alain Frisch)
+
+- #706: Add a settable Env.Persistent_signature.load function so
+  that cmi files can be loaded from other sources. This can be used to
+  create self-contained toplevels.
+  (Jérémie Dimino)
+
+### Standard library:
+
+- #6279, #553: implement Set.map
+  (Gabriel Scherer)
+
+- #6820, #560: Add Obj.reachable_words to compute the
+  "transitive" heap size of a value
+  (Alain Frisch, review by Mark Shinwell and Damien Doligez)
+
+- #473: Provide `Sys.backend_type` so that user can write backend-specific
+  code in some cases (for example,  code generator).
+  (Hongbo Zhang)
+
+- #589: Add a non-allocating function to recover the number of
+  allocated minor words.
+  (Pierre Chambart, review by Damien Doligez and Gabriel Scherer)
+
+- #626: String.split_on_char
+  (Alain Frisch)
+
+- #669: Filename.extension and Filename.remove_extension
+  (Alain Frisch, request by Edgar Aroutiounian, review by Daniel Bünzli
+  and Damien Doligez)
+
+- #674: support unknown Sys.os_type in Filename, defaulting to Unix
+  (Filename would previously fail at initialization time for
+   Sys.os_type values other than "Unix", "Win32" and "Cygwin";
+   mirage-os uses "xen")
+  (Anil Madhavapeddy)
+
+- #772 %string_safe_set and %string_unsafe_set are deprecated aliases
+  for %bytes_safe_set and %bytes_unsafe_set.
+  (Hongbo Zhang and Damien Doligez)
+
+### Other libraries
+
+- #4834, #592: Add a Biggarray.Genarray.change_layout function
+  to switch bigarrays between C and fortran layouts.
+  (Guillaume Hennequin, review by Florian Angeletti)
+
+### Code generation and optimizations:
+
+- #4747, #328: Optimize Hashtbl by using in-place updates of its
+  internal bucket lists.  All operations run in constant stack size
+  and are usually faster, except Hashtbl.copy which can be much
+  slower
+  (Alain Frisch)
+
+- #6217, #538: Optimize performance of record update:
+  no more performance cliff when { foo with t1 = ..; t2 = ...; ... }
+  hits 6 updated fields
+  (Olivier Nicole, review by Thomas Braibant and Pierre Chambart)
+
+- #7023, #336: Better unboxing strategy
+  (Alain Frisch, Pierre Chambart)
+
+- #7244, #840: Ocamlopt + flambda requires a lot of memory
+  to compile large array literal expressions
+  (Pierre Chambart, review by Mark Shinwell)
+
+- #7291, #780: Handle specialisation of recursive function that does
+  not always preserve the arguments
+  (Pierre Chambart, Mark Shinwell, report by Simon Cruanes)
+
+- #7328, #702: Do not eliminate boxed int divisions by zero and
+  avoid checking twice if divisor is zero with flambda.
+  (Pierre Chambart, report by Jeremy Yallop)
+
+- #427: Obj.is_block is now an inlined OCaml function instead of a
+  C external.  This should be faster.
+  (Demi Obenour)
+
+- #580: Optimize immutable float records
+  (Pierre Chambart, review by Mark Shinwell)
+
+- #602: Do not generate dummy code to force module linking
+  (Pierre Chambart, reviewed by Jacques Garrigue)
+
+- #703: Optimize some constant string operations when the "-safe-string"
+  configure time option is enabled.
+  (Pierre Chambart)
+
+- #707: Load cross module information during a meet
+  (Pierre Chambart, report by Leo White, review by Mark Shinwell)
+
+- #709: Share a few more equal switch branches
+  (Pierre Chambart, review by Gabriel Scherer)
+
+- #712: Small improvements to type-based optimizations for array
+  and lazy
+  (Alain Frisch, review by Pierre Chambart)
+
+- #714: Prevent warning 59 from triggering on Lazy of constants
+  (Pierre Chambart, review by Leo White)
+
+- #723 Sort emitted functions according to source location
+  (Pierre Chambart, review by Mark Shinwell)
+
+- Lack of type normalization lead to missing simple compilation for "lazy x"
+  (Alain Frisch)
+
+### Runtime system:
+
+- #7203, #534: Add a new primitive caml_alloc_float_array to allocate an
+  array of floats
+  (Thomas Braibant)
+
+- #7210, #562: Allows to register finalisation function that are
+  called only when a value will never be reachable anymore. The
+  drawbacks compared to the existing one is that the finalisation
+  function is not called with the value as argument. These finalisers
+  are registered with `GC.finalise_last`
+  (François Bobot reviewed by Damien Doligez and Leo White)
+
+- #247: In previous OCaml versions, inlining caused stack frames to
+  disappear from stacktraces. This made debugging harder in presence of
+  optimizations, and flambda was going to make this worse. The debugging
+  information produced by the compiler now enables the reconstruction of the
+  original backtrace. Use `Printexc.get_raw_backtrace_next_slot` to traverse
+  the list of inlined stack frames.
+  (Frédéric Bour, review by Mark Shinwell and Xavier Leroy)
+
+- #590: Do not perform compaction if the real overhead is less than expected
+  (Thomas Braibant)
+
+### Tools:
+
+- #7189: toplevel #show, follow chains of module aliases
+  (Gabriel Scherer, report by Daniel Bünzli, review by Thomas Refis)
+
+- #7248: have ocamldep interpret -open arguments in left-to-right order
+  (Gabriel Scherer, report by Anton Bachin)
+
+- #7272, #798: ocamldoc, missing line breaks in type_*.html files
+  (Florian Angeletti)
+
+- #7290: ocamldoc, improved support for inline records
+  (Florian Angeletti)
+
+- #7323, #750: ensure "ocamllex -ml" works with -safe-string
+  (Hongbo Zhang)
+
+- #7350, #806: ocamldoc, add viewport metadata to generated html pages
+  (Florian Angeletti, request by Daniel Bünzli)
+
+- #452: Make the output of ocamldep more stable
+  (Alain Frisch)
+
+- #548: empty documentation comments
+  (Florian Angeletti)
+
+- #575: Add the -no-version option to the toplevel
+  (Sébastien Hinderer)
+
+- #598: Add a --strict option to ocamlyacc treat conflicts as errors
+  (this option is now used for the compiler's parser)
+  (Jeremy Yallop)
+
+- #613: make ocamldoc use -open arguments
+  (Florian Angeletti)
+
+- #718: ocamldoc, fix order of extensible variant constructors
+  (Florian Angeletti)
+
+### Debugging and profiling:
+
+- #585: Spacetime, a new memory profiler (Mark Shinwell, Leo White)
+
+### Manual and documentation:
+
+- #7007, #7311: document the existence of OCAMLPARAM and
+  ocaml_compiler_internal_params
+  (Damien Doligez, reports by Wim Lewis and Gabriel Scherer)
+
+- #7243: warn users against using WinZip to unpack the source archive
+  (Damien Doligez, report by Shayne Fletcher)
+
+- #7245, #565: clarification to the wording and documentation
+  of Warning 52 (fragile constant pattern)
+  (Gabriel Scherer, William, Adrien Nader, Jacques Garrigue)
+
+- #PR7265, #769: Restore 4.02.3 behaviour of Unix.fstat, if the
+  file descriptor doesn't wrap a regular file (win32unix only)
+  (Andreas Hauptmann, review by David Allsopp)
+
+- #7288: flatten : Avoid confusion
+  (Damien Doligez, report by user 'tormen')
+
+- #7355: Gc.finalise and lazy values
+  (Jeremy Yallop)
+
+- #842: Document that [Store_field] must not be used to populate
+  arrays of values declared using [CAMLlocalN] (Mark Shinwell)
+
+### Compiler distribution build system:
+
+- #324: Compiler developers: Adding new C primitives to the
+  standard runtime doesn't require anymore to run `make bootstrap`
+  (François Bobot)
+
+- #384: Fix compilation using old Microsoft C Compilers not
+  supporting secure CRT functions (SDK Visual Studio 2005 compiler and
+  earlier) and standard 64-bit integer literals (Visual Studio .NET
+  2002 and earlier)
+  (David Allsopp)
+
+- #507: More sharing between Unix and Windows makefiles
+  (whitequark, review by Alain Frisch)
+
+* #512, #587: Installed `ocamlc`, `ocamlopt`, and `ocamllex` are
+  now the native-code versions of the tools, if those versions were
+  built.
+  (Demi Obenour)
+
+- #525: fix build on OpenIndiana
+  (Sergey Avseyev, review by Damien Doligez)
+
+- #687: "./configure -safe-string" to get a system where
+  "-unsafe-string" is not allowed, thus giving stronger non-local
+  guarantees about immutability of strings
+  (Alain Frisch, review by Hezekiah M. Carty)
+
+### Bug fixes:
+
+* #6505: Missed Type-error leads to a segfault upon record access.
+  (Jacques Garrigue, extra report by Stephen Dolan)
+  Proper fix required a more restrictive approach to recursive types:
+  mutually recursive types are seen as abstract types (i.e. non-contractive)
+  when checking the well-foundedness of the recursion.
+
+* #6752: Nominal types and scope escaping.
+  Revert to strict scope for non-generalizable type variables, cf. Mantis.
+  Note that this is actually stricter than the behavior before 4.03,
+  cf. #7313, meaning that you may sometimes need to add type annotations
+  to explicitly instantiate non-generalizable type variables.
+  (Jacques Garrigue, following discussion with Jeremy Yallop,
+   Nicolás Ojeda Bär and Alain Frisch)
+
+- #7112: Aliased arguments ignored for equality of module types
+  (Jacques Garrigue, report by Leo White)
+
+- #7134: compiler forcing aliases it shouldn't while reporting type errors
+  (Jacques Garrigue, report and suggestion by sliquister)
+
+- #7153: document that Unix.SOCK_SEQPACKET is not really usable.
+
+- #7165, #494: uncaught exception on invalid lexer directive
+  (Gabriel Scherer, report by KC Sivaramakrishnan using afl-fuzz)
+
+- #7257, #583: revert a 4.03 change of behavior on (Unix.sleep 0.),
+  it now calls (nano)sleep for 0 seconds as in (< 4.03) versions.
+  (Hannes Mehnert, review by Damien Doligez)
+
+- #7259 and #603: flambda does not collapse pattern matching
+  in some cases
+  (Pierre Chambart, report by Reed Wilson, review by Mark Shinwell)
+
+- #7260: GADT + subtyping compile time crash
+  (Jacques Garrigue, report by Nicolás Ojeda Bär)
+
+- #7269: Segfault from conjunctive constraints in GADT
+  (Jacques Garrigue, report by Stephen Dolan)
+
+- #7276: Support more than FD_SETSIZE sockets in Windows' emulation
+  of select
+  (David Scott, review by Alain Frisch)
+
+* #7278: Prevent private inline records from being mutated
+  (Alain Frisch, report by Pierre Chambart)
+
+- #7284: Bug in mcomp_fields leads to segfault
+  (Jacques Garrigue, report by Leo White)
+
+- #7285: Relaxed value restriction broken with principal
+  (Jacques Garrigue, report by Leo White)
+
+- #7297: -strict-sequence turns off Warning 21
+  (Jacques Garrigue, report by Valentin Gatien-Baron)
+
+- #7299: remove access to OCaml heap inside blocking section in win32unix
+  (David Allsopp, report by Andreas Hauptmann)
+
+- #7300: remove access to OCaml heap inside blocking in Unix.sleep on Windows
+  (David Allsopp)
+
+- #7305: -principal causes loop in type checker when compiling
+  (Jacques Garrigue, report by Anil Madhavapeddy, analysis by Leo White)
+
+- #7330: Missing exhaustivity check for extensible variant
+  (Jacques Garrigue, report by Elarnon *)
+
+- #7374: Contractiveness check unsound with constraints
+  (Jacques Garrigue, report by Leo White)
+
+- #7378: GADT constructors can be re-exposed with an incompatible type
+  (Jacques Garrigue, report by Alain Frisch)
+
+- #7389: Unsoundness in GADT exhaustiveness with existential variables
+  (Jacques Garrigue, report by Stephen Dolan)
+
+* #533: Thread library: fixed [Thread.wait_signal] so that it
+  converts back the signal number returned by [sigwait] to an
+  OS-independent number
+  (Jérémie Dimino)
+
+- #600: (similar to #555) ensure that register typing constraints are
+  respected at N-way join points in the control flow graph
+  (Mark Shinwell)
+
+- #672: Fix float_of_hex parser to correctly reject some invalid forms
+  (Bogdan Tătăroiu, review by Thomas Braibant and Alain Frisch)
+
+- #700: Fix maximum weak bucket size
+  (Nicolás Ojeda Bär, review by François Bobot)
+
+- #708 Allow more module aliases in strengthening (Leo White)
+
+- #713, #7301: Fix wrong code generation involving lazy values in Flambda
+  mode
+  (Mark Shinwell, review by Pierre Chambart and Alain Frisch)
+
+- #721: Fix infinite loop in flambda due to [@@specialise] annotations
+
+- #779: Building native runtime on Windows could fail when bootstrapping
+  FlexDLL if there was also a system-installed flexlink
+  (David Allsopp, report Michael Soegtrop)
+
+- #805, #815, #833: check for integer overflow in String.concat
+  (Jeremy Yallop,
+   review by Damien Doligez, Alain Frisch, Daniel Bünzli, Fabrice Le Fessant)
+
+- #810: check for integer overflow in Array.concat
+  (Jeremy Yallop)
+
+- #814: fix the Buffer.add_substring bounds check to handle overflow
+  (Jeremy Yallop)
+
+- #880: Fix [@@inline] with default parameters in flambda (Leo White)
+
+* #1353: add labels to BytesLabels.sub_string (Jacques Garrigue)
+
+### Internal/compiler-libs changes:
+
+- #7200, #539: Improve, fix, and add test for parsing/pprintast.ml
+  (Runhang Li, David Sheets, Alain Frisch)
+
+- #351: make driver/pparse.ml functions type-safe
+  (Gabriel Scherer, Dmitrii Kosarev, review by Jérémie Dimino)
+
+- #516: Improve Texp_record constructor representation, and
+  propagate updated record type information
+  (Pierre Chambart, review by Alain Frisch)
+
+- #678: Graphics.close_graph crashes 64-bit Windows ports (re-implementation
+  of #3963)
+  (David Allsopp)
+
+- #679: delay registration of docstring after the mapper is applied
+  (Hugo Heuzard, review by Leo White)
+
+- #872: don't attach (**/**) comments to any particular node
+  (Thomas Refis, review by Leo White)
+
+OCaml 4.03.0 (25 Apr 2016):
+---------------------------
+
+(Changes that can break existing programs are marked with a "*")
+
+### Language features:
+
+- #5528: inline records for constructor arguments
+  (Alain Frisch)
+
+- #6220, #6403, #6437, #6801:
+  Improved redundancy and exhaustiveness checks for GADTs.
+  Namely, the redundancy checker now checks whether the uncovered pattern
+  of the pattern is actually inhabited, exploding at most one wild card.
+  This is also done for exhaustiveness when there is only one case.
+  Additionally, one can now write unreachable cases, of the form
+  "pat -> .", which are treated by the redundancy check.
+  (Jacques Garrigue)
+
+- #6374: allow "_ t" as a short-hand for "(_, _, ..) t" for n-ary type
+  constructors
+  (Alain Frisch)
+
+- #6714: allow [@@ocaml.warning] on most structure and signature items:
+  values, modules, module types
+  (whitequark)
+
+- #6806: Syntax shortcut for putting a type annotation on a record field:
+  { f1 : typ = e } is sugar for { f1 = (e : typ) }
+  { f1 : typ } is sugar for { f1 = (f1 : typ) }
+  (Valentin Gatien-Baron, review by Jérémie Dimino)
+
+- #6806: Allow type annotations before the "->" in "fun  -> "
+  fun x y : (int * int) -> (x, y)
+  (Valentin Gatien-Baron, review by Jérémie Dimino)
+
+- #26: support for "(type a b)" as syntactic sugar for "(type a) (type b)"
+  (Gabriel Scherer)
+
+- #42: short functor type syntax: "S -> T" for "functor (_ : S) -> T"
+  (Leo White)
+
+- #88: allow field punning in object copying expressions:
+  {< x; y; >} is sugar for {< x = x; y = y; >}
+  (Jeremy Yallop)
+
+- #112: octal escape sequences for char and string literals
+  "Make it \o033[1mBOLD\o033[0m"
+  (Rafaël Bocquet, request by John Whitington)
+
+- #167: allow to annotate externals' arguments and result types so
+  they can be unboxed or untagged: [@unboxed], [@untagged]. Supports
+  untagging int and unboxing int32, int64, nativeint and float.
+  (Jérémie Dimino, Mark Shinwell)
+
+- #173: [@inline] and [@inlined] attributes (for function declarations
+  and call sites respectively) to control inlining
+  (Pierre Chambart, Mark Shinwell)
+
+- #188: accept [@@immediate] attribute on type declarations to mark types
+  that are represented at runtime by an integer
+  (Will Crichton, reviewed by Leo White)
+
+* #234: allow "[]" as a user-defined constructor. Demand parenthesis
+  around "::" when using "::" as user-defined constructor:
+  code using "| :: of ..." must change to "| (::) of ...".
+  (Runhang Li, review by Damien Doligez)
+
+- #240: replace special annotations on externals by attributes:
+  * "float" is generalized to [@@unboxed]
+  * "noalloc" becomes [@@noalloc]
+  Deprecate "float" and "noalloc".
+  (Jérémie Dimino)
+
+- #254: @ocaml.warn_on_literal_pattern attribute on constructors to
+  warn when the argument is matches against a constant pattern.  This
+  attribute is applied on predefined exception constructors which
+  carry purely informational (with no stability guarantee) messages.
+  (Alain Frisch)
+
+- #268: hexadecimal notation for floating-point literals: -0x1.ffffp+987
+  In OCaml source code, FP literals can be written using the hexadecimal
+  notation 0xp from ISO C99.
+  (Xavier Leroy)
+
+- #273: allow to get the extension slot of an extension constructor
+  by writing [%extension_constructor ]
+  (Jérémie Dimino)
+
+- #282: change short-paths penalty heuristic to assign the same cost to
+  idents containing double underscores as to idents starting with an underscore
+  (Thomas Refis, Leo White)
+
+- #6681 #326: signature items are now accepted as payloads for
+  extension and attributes, using the syntax [%foo: SIG ] or [@foo: SIG ].
+  Examples: "[%%client: val foo : int]" or "val%client foo : int".
+  (Alain Frisch and Gabriel Radanne)
+
+* #342: Allow shortcuts for extension and attributes on all keywords:
+  module%foo, class[@foo], etc.
+  The attribute in "let[@foo] .. in .." is now attached to the value binding,
+  not to the expression.
+  (Gabriel Radanne)
+
+### Compilers:
+
+* #4231, #5461: warning 31 is now fatal by default
+  (Warning 31: A module is linked twice in the same executable.)
+  This is an interim solution; double-linking of modules has dangerous
+  semantics, eg. exception constructors end up with two distinct declarations.
+  (Alain Frisch)
+
+- #4800: better compilation of tuple assignment
+  (Gabriel Scherer and Alain Frisch)
+
+- #5995: keep -for-pack into account to name exceptions;
+  -for-pack should now be used during bytecode compilation as well
+  (Alain Frisch, report by Christophe Troestler)
+
+- #6400: better error message for '_' used as an expression
+  (Alain Frisch, report by whitequark)
+
+- #6501: harden the native-code generator against certain uses of "%identity"
+  (Xavier Leroy, report by Antoine Miné)
+
+- #6636: add --version option
+  (whitequark)
+
+- #6679: fix pprintast printing of constraints in type declarations
+  (Alain Frisch, report by Jun Furuse)
+
+- #6737: fix Typedtree attributes on (fun x -> body) expressions
+  (Alain Frisch, report by Oleg Kiselyov)
+
+* #6865: remove special case for parsing "let _ = expr" in structures
+  (Jérémie Dimino, Alain Frisch)
+
+* #6438, #7059, #315: Pattern guard disables exhaustiveness check
+  (function Some x when x = 0 -> ()) will now raise warning 8 (non-exhaustive)
+  instead of warning 25 (all clauses are guarded). 25 isn't raised anymore.
+  Projects that set warning 8 as an error may fail to compile (presumably
+  this is the semantics they wanted).
+  (Alain Frisch, request by Martin Jambon and John Whitington)
+
+- #6920: fix debug information around uses of %apply or %revapply
+  (Jérémie Dimino, report by Daniel Bünzli)
+
+- #6939: Segfault with improper use of let-rec
+  (Alain Frisch)
+
+- #6943: native-code generator for POWER/PowerPC 64 bits, both in
+  big-endian (ppc64) and little-endian (ppc64le) configuration.
+  (Xavier Leroy, with inspiration from RedHat's unofficial ppc64 and ppc64le
+  ports)
+
+- #6979: better code generation in x86-32 backend for copying floats to
+  the stack
+  (Marc Lasson, review by Xavier Leroy)
+
+- #7018: fix missing identifier renaming during inlining
+  (Alain Frisch, review by Xavier Leroy)
+
+- #7022, #259: unbox float and boxed ints earlier, avoid second pass
+  (Alain Frisch)
+
+- #7026, #288: remove write barrier for polymorphic variants without
+  arguments
+  (Simon Cruanes)
+
+- #7031: new warning 57, ambiguous guarded or-patterns
+  (Luc Maranget, Gabriel Scherer, report by Martin Clochard and Claude Marché)
+
+- #7064, #316: allowing to mark compilation units and sub-modules as
+  deprecated
+  (Alain Frisch)
+
+- #7067: fix performance regression (wrt. 4.01) in the native compiler
+  for long nested structures
+  (Alain Frisch, report by Daniel Bünzli, review by Jacques Garrigue)
+
+- #7097: fix strange syntax error message around illegal packaged module
+  signature constraints
+  (Alain Frisch, report by Jun Furuse)
+
+- #7118, #7120, #408, #476: Bug fixed in stack unwinding
+  metadata generation. Was a cause of crashes in GUI programs on OS X.
+  (Bart Jacobs, review by Mark Shinwell)
+
+- #7168: Exceeding stack limit in bytecode can lead to a crash.
+  (Jacques-Henri Jourdan)
+
+- #7232: Strange Pprintast output with ppx_deriving
+  (Damien Doligez, report by Anton Bachin)
+
+- #17: some cmm optimizations of integer operations with constants
+  (Stephen Dolan, review by Pierre Chambart)
+
+- #89: improve type-specialization of unapplied primitives:
+  unapplied annotations (compare : int -> _),
+  type propagation (List.sort compare [1;2;3])
+  and propagation from module signatures now lead to specialization
+  (Frédéric Bour, review by Gabriel Scherer)
+
+- #107: Prevent more unnecessary float boxing, especially in `if` and `match`
+  (Vladimir Brankov, review by Alain Frisch)
+
+- #109: new (lazy) unboxing strategy for float and int references
+  (Vladimir Brankov, review by Alain Frisch)
+
+- #115: More precise typing of values at the C-- and Mach level.
+  (Xavier Leroy, review by Pierre Chambart)
+
+- #132: Flambda: new intermediate language and "middle-end" optimizers
+  (Pierre Chambart, Mark Shinwell, Leo White)
+
+- #212, #7226, #542: emit column position in gas assembly `.loc`
+  (Frédéric Bour, Anton Bachin)
+
+- #207: Colors in compiler messages (warnings, errors)
+  configure with -color {auto|always|never} or TERM=dumb
+  (Simon Cruanes, review by Gabriel Scherer)
+
+- #258: more precise information on PowerPC instruction sizes
+  (Pierre Chambart, Xavier Leroy)
+
+- #263: improve code generation for if-equivalents of (&&) and (||)
+  (Pierre Chambart)
+
+- #270: Make [transl_exception_constructor] generate [Immutable] blocks
+  (Mark Shinwell)
+
+- #271: Fix incorrect mutability flag when records are built using "with"
+  (Mark Shinwell)
+
+- #275: native-code generator for IBM z System running Linux.
+  In memoriam Gene Amdahl, 1922-2015.
+  (Bill O'Farrell, Tristan Amini, Xavier Leroy)
+
+- #282: relax short-paths safety check in presence of module aliases, take
+  penalty into account while building the printing map.
+  (Thomas Refis, Leo White)
+
+- #306: Instrument the compiler to debug performance regressions
+  (Pierre Chambart)
+
+- #319: add warning 58 for missing cmx files, and
+  extend -opaque option to mli files: a missing .cmx does not warn
+  if the corresponding .cmi is compiled -opaque.
+  (Leo White)
+
+- #388: OCAML_FLEXLINK environment variable allows overriding flexlink
+  command (David Allsopp)
+
+- #392: put all parsetree invariants in a new module Ast_invariants
+  (Jérémie Dimino)
+
+- #407: don't display the name of compiled .c files when calling the
+  Microsoft C Compiler (same as the assembler).
+  (David Allsopp)
+
+- #431: permit constant float arrays to be eligible for pattern match
+  branch merging
+  (Pierre Chambart)
+
+- #455: provide more debugging information to Js_of_ocaml
+  (Jérôme Vouillon)
+
+- #514, #554: Added several command-line flags to explicitly enable
+  settings that are currently the default:
+  `-alias-deps`, `-app-funct`, `-no-keep-docs`, `-no-keep-locs`,
+  `-no-principal`, `-no-rectypes`, `-no-strict-formats`
+  (Demi Obenour)
+
+- #545: use reraise to preserve backtrace on
+  `match .. with exception e -> raise e`
+  (Nicolás Ojeda Bär, review by Gabriel Scherer)
+
+### Runtime system:
+
+* #596: make string/bytes distinguishable in the underlying
+  compiler implementation; caml_fill_string and caml_create_string are
+  deprecated and will be removed in the future, please use
+  caml_fill_bytes and caml_create_bytes for migration
+  (Hongbo Zhang, review by Damien Doligez, Alain Frisch, and Hugo Heuzard)
+
+- #3612, #2429: allow allocating custom block with finalizers
+  in the minor heap.
+  (Pierre Chambart)
+
+* #6517: use ISO C99 types {,u}int{32,64}_t in preference to our homegrown
+  types {,u}int{32,64}.
+  C stubs may have to be updated as {,u}int{32,64}_t are not defined anymore.
+  (Xavier Leroy)
+
+- #6760: closures evaluated in the toplevel can now be marshalled
+  (whitequark, review by Jacques-Henri Jourdan)
+
+- #6902, #210: emit a runtime warning on stderr
+  when finalizing an I/O channel which is still open:
+    "channel opened on file '...' dies without being closed"
+  this is controlled by OCAMLRUNPARAM=W=1 or with Sys.enable_runtime_warnings.
+  The behavior of affected program is not changed,
+  but they should still be fixed.
+  (Alain Frisch, review by Damien Doligez)
+
+- Signal handling: for read-and-clear, use GCC/Clang atomic builtins
+  if available.
+  (Xavier Leroy)
+
+- #6910, #224: marshaling (output_value, input_value, et al)
+  now support marshaled data bigger than 4 Gb.
+  (Xavier Leroy)
+
+* #22: The undocumented layout of weak arrays has been changed. Finalisation
+  functions are now run before the erasure of the corresponding values.
+
+* #226: select higher levels of optimization for GCC >= 3.4 and Clang
+  when compiling the run-time system and C stub code.
+  "-std=gnu99 -O2 -fno-strict-aliasing -fwrapv" is used by default.
+  This also affects default flags for user stubs compiled with "ocamlc -c foo.c"
+  and may uncover bugs in them.
+  (Xavier Leroy)
+
+- #262: Multiple GC roots per compilation unit
+  (Pierre Chambart, Mark Shinwell, review by Damien Doligez)
+
+* #297: Several changes to improve the worst-case GC pause time.
+  Changes Gc.control and Gc.major_slice and adds functions to the Gc module.
+  (Damien Doligez, with help from François Bobot, Thomas Braibant, Leo White)
+
+- #325: Add v=0x400 flag to OCAMLRUNPARAM to display GC stats on exit
+  (Louis Gesbert, review by Alain Frisch)
+
+### Standard library:
+
+- #7848, #230: Array.map2, Array.iter2
+  (John Christopher McAlpine)
+
+- #5197, #63: Arg: allow flags such as --flag=arg as well as --flag arg
+  (Richard Jones)
+
+- #6017, #7034, #267: More efficient ifprintf implementation
+  (Jeremy Yallop, review by Gabriel Scherer)
+
+- #6296: Some documentation on the floating-point representations
+    recognized by Pervasives.float_of_string
+  (Xavier Leroy)
+
+- #6316: Scanf.scanf failure on %u formats when reading big integers
+  (Xavier Leroy, Benoît Vaugon)
+
+- #6321: guarantee that "hypot infinity nan = infinity"
+  (for conformance with ISO C99)
+  (Xavier Leroy)
+
+- #6390, #36: expose Sys.{int_size,max_wosize} for js_of_ocaml portability
+  (Hugo Heuzard)
+
+- #6449: Add Map.union
+  (Alain Frisch)
+
+* #6494: Add 'equal' functions in modules
+  Bytes, Char, Digest, Int32, Int64, Nativeint, and String
+  Users defining their own modules with signature 'module type of Int32'
+  have to extend their implementation.
+  (Romain Calascibetta)
+
+* #6524, #79: Filename: Optional ?perms argument to open_temp_file
+  May break partial applications of the function (fix by passing ?perms:None)
+  (Daniel Bünzli, review by Kate Deplaix)
+
+* #6525, #80: Add Uchar module to the standard library
+  May introduce module name conflicts with existing projects.
+  (Daniel Bünzli, review by Yoriyuki Yamagata and Damien Doligez)
+
+- #6577: improve performance of %L, %l, %n, %S, %C format specifiers
+  (Alain Frisch)
+
+- #6585: fix memory leak in win32unix/createprocess.c
+  (Alain Frisch, report by user 'aha')
+
+- #6645, #174: Guarantee that Set.add, Set.remove, Set.filter
+  return the original set if no change is required
+  (Alain Frisch, Mohamed Iguernlala)
+
+- #6649, #222: accept (int_of_string "+3")
+  (John Christopher McAlpine)
+
+- #6694, #6695, #124: deprecate functions using ISO-8859-1 character set
+  in Char, Bytes, String and provide alternatives *_acii using US-ASCII.
+  Affected functions:
+    {Char,String,Bytes}.{uppercase,lowercase},
+    {String,Bytes}.{capitalize,uncaptialize}
+  (whitequark, review by Damien Doligez)
+
+- #22: Add the Ephemeron module that implements ephemerons and weak
+  hash table
+  (François Bobot, review by Damien Doligez, Daniel Bünzli,
+  Alain Frisch, Pierre Chambart)
+
+- #164: more efficient (branchless) implementation of Pervasives.compare
+  specialized at type 'float'.
+  (Vladimir Brankov)
+
+- #175: Guarantee that Map.add, Map.remove, Map.filter
+  return the original map if no change is required.
+  (Mohamed Iguernlala)
+
+- #201: generalize types of Printf.{ifprintf,ikfprintf}
+  (Maxence Guesdon)
+
+- #216: add the missing POSIX.1-2001 signals in Sys
+  (Guillaume Bury)
+
+- #239: remove type-unsafe code from Stream
+  (Pierre Chambart, review by Gabriel Scherer and Jeremy Yallop)
+
+- #250: Check for negative start element in Array.sub
+  (Jeremy Yallop)
+
+- #265: new implementation of Queue avoiding Obj.magic
+  (Jérémie Dimino)
+
+- #268, #303: '%h' and '%H' modifiers for printf and scanf to
+  support floating-point numbers in hexadecimal notation
+  (Xavier Leroy, Benoît Vaugon)
+
+- #272: Switch classify_float to [@@unboxed]
+  (Alain Frisch)
+
+- Improve speed of classify_float by not going through fpclassify()
+  (Alain Frisch, Xavier Leroy)
+
+- #277: Switch the following externals to [@@unboxed]:
+  * {Nativeint,Int32,Int64}.{of,to}_float
+  * Int{32,64}.float_of_bits
+  * Int{32,64}.bits_of_float
+  (Jérémie Dimino)
+
+- #281: Switch the following externals to [@@unboxed]:
+  * Sys.time (and [@@noalloc])
+  * Pervasives.ldexp (and [@@noalloc])
+  * Pervasives.compare for float, nativeint, int32, int64.
+  (François Bobot)
+
+- #3622, #195: add function Stack.fold
+  (Simon Cruanes)
+
+- #329: Add exists, for_all,  mem and memq functions in Array
+  (Bernhard Schommer)
+
+- #337: Add [Hashtbl.filter_map_inplace]
+  (Alain Frisch)
+
+- #356: Add [Format.kasprintf]
+  (Jérémie Dimino, Mark Shinwell)
+
+### Type system:
+
+- #5545: Type annotations on methods cannot control the choice of abbreviation
+  (Jacques Garrigue)
+
+* #6465: allow incremental weakening of module aliases.
+  This is done by adding equations to submodules when expanding aliases.
+  In theory this may be incompatible is some corner cases defining a module
+  type through inference, but no breakage known on published code.
+  (Jacques Garrigue)
+
+- #6593: Functor application in tests/basic-modules fails after commit 15405
+  (Jacques Garrigue)
+
+### Toplevel and debugger:
+
+- #6113: Add descriptions to directives, and display them via #help
+  (Nick Giannarakis, Berke Durak, Francis Southern and Gabriel Scherer)
+
+- #6396: Warnings-as-errors not properly flushed in the toplevel
+  (Alain Frisch)
+
+- #6401: use proper error reporting for toplevel environment initialization:
+  no more Env.Error(_) at start time
+  (Gabriel Scherer, Alain Frisch)
+
+- #6468: toplevel now supports backtraces if invoked with OCAMLRUNPARAM=b
+  (whitequark and Jake Donham,
+   review by Gabriel Scherer and Jacques-Henri Jourdan)
+
+- #6906: wrong error location for unmatched paren with #use in toplevel
+  (Damien Doligez, report by Kenichi Asai)
+
+- #6935, #298: crash in debugger when load_printer is given a directory
+  (Junsong Li, review by Gabriel Scherer)
+
+- #7081: report preprocessor warnings in the toplevel
+  (Valentin Gatien-Baron, review by Jérémie Dimino)
+
+- #7098: Loss of ppx context in toplevel after an exception
+  (Alain Frisch, report by whitequark)
+
+- #7101: The toplevel does not close in_channel for libraries specified on
+  its command line
+  (Alain Frisch)
+
+- #7119: the toplevel does not respect [@@@warning]
+  (Alain Frisch, report by Gabriel Radanne)
+
+### Other libraries:
+
+* Unix library: channels created by Unix.in_channel_of_descr or
+  Unix.out_channel_of_descr no longer support text mode under Windows.
+  Calling [set_binary_mode_{in,out} chan false] on these channels
+  now causes an error.
+  (Xavier Leroy)
+
+- #4023 and #68: add Unix.sleepf (sleep with sub-second resolution)
+  (Evgenii Lepikhin and Xavier Leroy)
+
+* Protect Unix.sleep against interruptions by handled signals.
+  Before, a handled signal could cause Unix.sleep to return early.
+  Now, the sleep is restarted until the given time is elapsed.
+  (Xavier Leroy)
+
+* #6120, #462: implement Unix.symlink and Unix.readlink on
+  Windows. Unix.symlink has a new optional argument to_dir (ignored on
+  non-native Windows platforms). stat functions reimplemented to avoid
+  buggy Microsoft CRT implementations (native Windows only)
+  (David Allsopp, review by Daniel Bünzli)
+
+- #6263: add kind_size_in_bytes and size_in_bytes functions
+  to Bigarray module.
+  (Runhang Li, review by Mark Shinwell)
+
+- #6289: Unix.utimes uses the current time only if both arguments
+    are exactly 0.0.  Also, use sub-second resolution if available.
+  (Xavier Leroy, report by Christophe Troestler)
+
+- #6896: serious reimplementation of Big_int.float_of_big_int and
+  Ratio.float_of_ratio, ensuring that the result is correctly rounded.
+  (Xavier Leroy)
+
+- #6989: in Str library, make sure that all \(...\) groups are binding
+    and can be consulted with Str.matched_group.  There used to be
+    a limitation to 32 binding groups.
+  (Xavier Leroy)
+
+- #7013: spurious wake-up in the Event module
+  (Xavier Leroy)
+
+- #7024: in documentation of Str regular expressions, clarify what
+    "end of line" means for "^" and "$" regexps.
+  (Xavier Leroy, question by Fredrik Lindgren)
+
+- #7209: do not run at_exit handlers in [Unix.create_process] and
+  similar functions when the [exec] call fails in the child process
+  (Jérémie Dimino)
+
+### OCamldep:
+
+- #286: add support for module aliases
+  (Jacques Garrigue)
+
+### Manual:
+
+- #302: The OCaml reference manual is now included in the manual/
+  subdirectory of the main OCaml source repository. Contributions to
+  the manual are warmly welcome.
+  (François Bobot, review by Florian Angeletti)
+
+- #6601: replace strcpy with caml_strdup in sample code
+  (Christopher Zimmermann)
+
+- #6676: ongoing simplification of the "Language Extensions" section
+  (Alain Frisch, John Whitington)
+
+- #6898: Update win32 support documentation of the Unix library
+  (Damien Doligez, report by Daniel Bünzli)
+
+- #7092, #379: Add missing documentation for new 4.03 features
+  (Florian Angeletti)
+
+- #7094, #468, #551: add new section 8.5 to document warnings
+  The general idea is to document warnings that may require explanations.
+  Currently documented warnings are:
+  - 52: Fragile constant pattern.
+  - 57: Ambiguous or-pattern variables under guard
+  (Florian Angeletti and Gabriel Scherer)
+
+- #7109, #380: Fix bigarray documentation layout
+  (Florian Angeletti, Leo White)
+
+### Bug fixes:
+
+- #3612: memory leak in bigarray read from file
+  (Pierre Chambart, report by Gary Huber)
+
+* #4166, #6956: force linking when calling external C primitives
+  (Jacques Garrigue, reports by Markus Mottl and Christophe Troestler)
+
+* #4466, #5325: under Windows, concurrent read and write operations
+    on the same socket could block unexpectedly.  Fixed by keeping sockets
+    in asynchronous mode rather than creating them in synchronous mode.
+  (Xavier Leroy)
+
+* #4539: change exception string raised when comparing functional values
+  May break programs matching on the string argument of Invalid_argument.
+  Matching on the string argument of Invalid_argument or Failure is a
+  programming mistake: these strings may change in future versions.
+  (Nicolas Braud-Santoni, report by Eric Cooper)
+
+- #4832: Filling bigarrays may block out runtime
+  (Markus Mottl)
+
+- #5663: program rejected due to nongeneralizable type variable that
+    appears nowhere
+  (Jacques Garrigue, report by Stephen Weeks)
+
+- #5780: report more informative type names in GADTs error messages
+  (Jacques Garrigue, report by Sebastien Furic)
+
+- #5887: move the byterun/*.h headers to byterun/caml/*.h to avoid header
+    name clashes
+  (Jérôme Vouillon and Adrien Nader and whitequark)
+
+* #6081: ocaml now adds script's directory to search path, not current
+    directory
+  (Thomas Leonard and Damien Doligez)
+
+- #6108, #6802: fail cleanly if dynlink.cma or ocamltoplevel.cma
+    are loaded inside the toplevel loop.
+  (Xavier Leroy)
+
+- #6171: Confusing error message when a type escapes its scope.
+  (Jacques Garrigue and Leo White, report by John Whitington)
+
+- #6340: Incorrect handling of \r when processing "Windows" source files
+  (Damien Doligez, report by David Allsopp)
+
+- #6342: Incorrect error message when type constraints differ
+  (Alain Frisch, report by Philippe Wang)
+
+* #6521: {Bytes,Char,String}.escaped were locale-dependent
+  we now escape all non-ASCII-printable instead of a locale-dependent subset.
+  (Damien Doligez, report by Jun Furuse)
+
+- #6526: ocamllex should not warn on unescaped newline inside comments
+  (Damien Doligez, report by user 'dhekir')
+
+- #6341: ocamldoc -colorize-code adds spurious 
 tags to 
 blocks
+  (Maxence Guesdon, report by Damien Doligez)
+
+- #6560: Wrong failure message for {Int32,Int64,NativeInt}.of_string
+  It reported (Failure "int_of_string"), now "Int32.of_string" etc.
+  (Maxime Dénès and Gabriel Scherer)
+
+- #6648: show_module should indicate its elision
+  (Jacques Garrigue, report by Leo White)
+
+- #6650: Cty_constr not handled correctly by Subst
+  (Jacques Garrigue, report by Leo White)
+
+- #6651: Failing component lookup
+  (Jacques Garrigue, report by Leo White)
+
+* #6664: Crash when finalising lazy values of the wrong type.
+  (Damien Doligez)
+
+- #6672: Unused variance specification allowed in with constraint
+  (Jacques Garrigue, report by Leo White)
+
+- #6677: Allow to disable warning 39 (useless "rec") with [@ocaml.warning]
+  applied to the first value binding of the would-be "rec" declaration
+  (Alain Frisch, report by Jun Furuse)
+
+- #6744: Univars can escape through polymorphic variants (partial fix)
+  (Jacques Garrigue, report by Leo White)
+
+- #6752: Extensible variant types and scope escaping
+  A side-effect of the fix is that (ocamlc -i) sometimes reports
+  (type-sound) invalid signature, with a type used before its declaration.
+  (Jacques Garrigue, report by Maxence Guesdon)
+
+- #6762: improve warning 45 in presence of re-exported type definitions
+  (Warning 45: open statement shadows the constructor)
+  (Alain Frisch, report by Olivier Andrieu)
+
+- #6776: Failure to kill the "tick" thread, segfault when exiting the runtime
+  (Damien Doligez, report by Thomas Braibant)
+
+- #6780: Poor error message for wrong -farch and -ffpu options (ocamlopt, ARM)
+  (Xavier Leroy, report by whitequark)
+
+- #6805: Duplicated expression in case of hole in a non-failing switch.
+  (Luc Maranget)
+
+* #6808: the parsing of OCAMLRUNPARAM is too lax
+  (Damien Doligez)
+
+- #6874: Inefficient code generated for module function arguments
+  (Jacques Garrigue, report by Markus Mottl)
+
+- #6888: The list command of ocamldebug uses the wrong file
+  (Damien Doligez, report by Pierre-Marie Pédrot)
+
+- #6897: Bad error message for some pattern matching on extensible variants
+  (Alain Frisch, report by Gabriel Radanne)
+
+- #6899: Optional parameters and non generalizable type variables
+  (Thomas Refis and Leo White)
+
+- #6907: Stack overflow printing error in class declaration
+  (Jacques Garrigue, report by Ivan Gotovchits)
+
+- #6931: Incorrect error message on type error inside record construction
+  (Damien Doligez, report by Leo White)
+
+- #6938: fix regression on "%047.27{l,L,n}{d,i,x,X,o,u}"
+  (Benoît Vaugon, report by Arduino Cascella)
+
+- #6944: let module X = Path in … is not typed as a module alias
+  (Jacques Garrigue, report by Frédéric Bour)
+
+- #6945 and #227: protect Sys and Unix functions against string
+    arguments containing the null character '\000'
+  (Simon Cruanes and Xavier Leroy, report by Daniel Bünzli)
+
+- #6946: Uncaught exception with wrong type for "%ignore"
+  (Jacques Garrigue, report by Leo White)
+
+- #6954: Infinite loop in type checker with module aliases
+  (Jacques Garrigue, report by Markus Mottl)
+
+- #6972, #276: 4.02.3 regression on documentation comments in .cmt files
+  (Leo White, report by Olivier Andrieu)
+
+- #6977: String literals in comments interpret escape sequences
+  (Damien Doligez, report by Daniel Bünzli and David Sheets)
+
+- #6980: Assert failure from polymorphic variants and existentials
+  (Jacques Garrigue, report by Leo White)
+
+- #6981: Ctype.Unify(_) with associated functor arg referring to previous one
+  (Jacques Garrigue, report by Nicholas Labich)
+
+- #6982: unexpected type error when packing a module alias
+  (Jacques Garrigue, report by Valentin Gatien-Baron)
+
+- #6985: `module type of struct include Bar end exposes
+           %s#row when Bar contains private row types
+  (Jacques Garrigue, report by Nicholas Labich)
+
+- #6992: Segfault from bug in GADT/module typing
+  (Jacques Garrigue, report by Stephen Dolan)
+
+- #6993: Segfault from recursive modules violating exhaustiveness assumptions
+  (Jacques Garrigue, report by Stephen Dolan)
+
+- #6998: Typer fails reading unnecessary cmis with -no-alias-deps and -w -49
+  (Leo White, report by Valentin Gatien-Baron)
+
+- #7003: String.sub may cause segmentation fault on sizes above 2^31
+  (Damien Doligez, report by Radek Micek)
+
+- #7008: Fatal error in ocamlc with empty compilation unit name
+  (Damien Doligez, report by Cesar Kunz)
+
+- #7012: Variable name forgotten when it starts with a capital letter
+  (Jacques Garrigue, Gabriel Scherer,
+   report by Thomas Leonard and Florian Angeletti)
+
+- #7016: fix Stack overflow in GADT typing
+  Note: Equi-recursive types are considered when checking GADT pattern
+  exhaustiveness, even when -rectypes is not used.
+  (Jacques Garrigue, report by Mikhail Mandrykin)
+
+- #7030: libasmrun_shared.so fails to build on SPARC Solaris
+  (report and fix by Patrick Star)
+
+- #7036: Module alias is not taken into account when checking module
+  type compatibility (in a class type)
+  (Jacques Garrigue)
+
+- #7037: more reproducible builds, don't put temp file names into objects
+  (Xavier Leroy)
+
+- #7038: out of memory condition in caml_io_mutex_lock
+  (Xavier Leroy, report by Marc Lasson)
+
+- #7039: Unix.getsockname returns garbage for unnamed PF_UNIX sockets
+  (Xavier Leroy)
+
+- #7042 and #295: CSE optimization confuses the FP literals +0.0 and -0.0
+  (Xavier Leroy)
+
+- #7075: Fix repetitions in ocamldoc generated documentation
+  (Florian Angeletti)
+
+- #7082: Object type in recursive module's `with` annotation
+  (Jacques Garrigue and Alain Frisch, report by Nicholas Labich)
+
+- #7096: ocamldoc uses an incorrect subscript/superscript style
+  (Gabriel Scherer, report by user 'pierpa')
+
+- #7108: ocamldoc, have -html preserve custom/extended html generators
+  (Armaël Guéneau)
+
+- #7111: reject empty let bindings instead of printing incorrect syntax
+  (Jérémie Dimino)
+
+* #7113: -safe-string can break GADT compatibility check
+  bytes and string are now considered compatible even with -safe-string,
+  which may break exhaustivity for code assuming they were disjoint
+  (Jacques Garrigue, report by Jeremy Yallop)
+
+- #7115: shadowing in a branch of a GADT match breaks unused variable warning
+  (Alain Frisch, report by Valentin Gatien-Baron)
+
+- #7133, #450: generate local jump labels on OS X
+  (Bart Jacobs)
+
+- #7135: only warn about ground coercions in -principal mode
+  (Jacques Garrigue, report by Jeremy Yallop)
+
+* #7152: Typing equality involving non-generalizable type variable
+  A side-effect of the fix is that, for deeply nested non generalizable
+  type variables, having an interface file may no longer be sufficient,
+  and you may have to add a local type annotation (cf #7313)
+  (Jacques Garrigue, report by François Bobot)
+
+- #7160: Type synonym definitions can weaken gadt constructor types
+  (Jacques Garrigue, report by Mikhail Mandrykin)
+
+- #7181: Misleading error message with GADTs and polymorphic variants
+  (Jacques Garrigue, report by Pierre Chambart)
+
+- #7182: Assertion failure with recursive modules and externals
+  (Jacques Garrigue, report by Jeremy Yallop)
+
+- #7196: "let open" is not correctly pretty-printed to the left of a ';'
+  (Gabriel Scherer, report by Christophe Raffalli)
+
+- #7214: Assertion failure in Env.add_gadt_instances
+  (Jacques Garrigue, report by Stephen Dolan)
+
+- #7220: fix a memory leak when using both threads and exception backtraces
+  (Gabriel Scherer, review by François Bobot, report by Rob Hoes)
+
+- #7222: Escaped existential type
+  (Jacques Garrigue, report by Florian Angeletti)
+
+- #7230: Scrutinee discarded in match with only refutation cases
+  (Jacques Garrigue, report by Jeremy Yallop)
+
+- #7234: Compatibility check wrong for abstract type constructors
+  (Jacques Garrigue, report by Stephen Dolan)
+
+- #7324: OCaml 4.03.0 type checker dies with an assert failure when
+  given some cyclic recursive module expression
+  (Jacques Garrigue, report by jmcarthur)
+
+- #7368: Manual major GC fails to compact the heap
+  (Krzysztof Pszeniczny)
+
+- #205: Clear caml_backtrace_last_exn before registering as root
+  (report and fix by Frédéric Bour)
+
+- #220: minor -dsource error on recursive modules
+  (Hongbo Zhang)
+
+- #228: fix a dangling internal pointer in (bytecode )debug_info
+  (Gabriel Scherer and Mark Shinwell and Xavier Leroy)
+
+- #233: Make CamlinternalMod.init_mod robust to optimization
+  (Pierre Chambart, Mark Shinwell)
+
+- #249: fix a few hardcoded ar commands
+  (Daniel Bünzli)
+
+- #251: fix cross-compilation with ocamldoc enabled
+  (whitequark)
+
+- #280: Fix stdlib dependencies for .p.cmx
+  (Pierre Chambart, Mark Shinwell)
+
+- #283: Fix memory leaks in intern.c when OOM is raised
+  (Marc Lasson, review by Alain Frisch)
+
+- #22: Fix the cleaning of weak pointers. In very rare cases
+  accessing a value during the cleaning of the weak pointers could
+  result in the value being removed from one weak arrays and kept in
+  another one. That breaks the property that a value is removed from a
+  weak pointer only when it is dead and garbage collected.
+  (François Bobot, review by Damien Doligez)
+
+- #313: Prevent quadratic cases in CSE
+  (Pierre Chambart, review by Xavier Leroy)
+
+- #6795, #6996: Make ocamldep report errors passed in
+  [%ocaml.error] extension points
+  (Jérémie Dimino)
+
+- #355: make ocamlnat build again
+  (Jérémie Dimino, Thomas Refis)
+
+- #405: fix compilation under Visual Studio 2015
+  (David Allsopp)
+
+- #441: better type error location in presence of type constraints
+  (Thomas Refis, report by Arseniy Alekseyev)
+
+- #477: reallow docstrings inside object types, and inside polymorphic
+  variant and arrow types
+  (Thomas Refis)
+
+### Features wishes:
+
+- #4518, #29: change location format for reporting errors in ocamldoc
+  (Sergei Lebedev)
+
+- #4714: List.cons
+
+- #5418 (comments) : generate dependencies with $(CC) instead of gcc
+  (Damien Doligez, report by Michael Grünewald)
+
+- #6167: OCAMLPARAM support for disabling PIC generation ("pic=0")
+  (Gabor Pali)
+
+- #6367, #25: introduce Asttypes.arg_label to encode labelled arguments
+  (Frédéric Bour and Jacques Garrigue)
+
+- #6452, #140: add internal support for custom printing formats
+  (Jérémie Dimino)
+
+- #6611: remove the option wrapper on optional arguments in the syntax tree
+  (Alain Frisch, review by Damien Doligez, request by whitequark)
+
+- #6635: support M.[], M.(), M.{< >} and M.[| |]
+  (Jeremy Yallop, review by Gabriel Radanne)
+
+- #6691: install .cmt[i] files for stdlib and compiler-libs
+  (David Sheets, request by Gabriel Radanne)
+
+- #6722: compatibility with x32 architecture (x86-64 in ILP32 mode).
+  ocamlopt is not supported, but bytecode compiles cleanly.
+  (Adam Borowski and Xavier Leroy)
+
+- #6742: remove duplicate virtual_flag information from Tstr_class
+  (Gabriel Radanne and Jacques Garrigue)
+
+- #6719: improve Buffer.add_channel when not enough input is available
+  (Simon Cruanes)
+
+* #6816: reject integer and float literals directly followed by an identifier.
+  This was previously read as two separate tokens.
+  [let abc = 1 in (+) 123abc] was accepted and is now rejected.
+  (Hugo Heuzard)
+
+- #6876: improve warning 6 by listing the omitted labels.
+  (Warning 6: Label omitted in function application)
+  (Eyyüb Sari)
+
+- #6924: tiny optim to avoid some spilling of floats in x87
+  (Alain Frisch)
+
+- #111: `(f [@taillcall]) x y` warns if `f x y` is not a tail-call
+  (Simon Cruanes)
+
+- #118: ocamldep -allow-approx: fallback to a lexer-based approximation
+  (Frédéric Bour)
+
+- #137: add untypeast.ml (in open recursion style) to compiler-libs
+  (Gabriel Radanne)
+
+- #142: add a CAMLdrop macro for undoing CAMLparam*/CAMLlocal*
+  (Thomas Braibant and Damien Doligez)
+
+- #145: speeedup bigarray access by optimizing Cmmgen.bigarray_indexing
+  (Vladimir Brankov, review by Gabriel Scherer)
+
+- #147: [type 'a result = Ok of 'a | Error of 'b] in Pervasives
+  (Yaron Minsky)
+
+- #156, #279: optimize caml_frame_descriptors realloc (dynlink speedup)
+  (Pierre Chambart, Alain Frisch,
+   review by François Bobot, Xavier Leroy and Damien Doligez)
+
+- #165, #221: fix windows compilation warnings
+  (Bernhard Schommer, Gabriel Scherer, report by Alain Frisch)
+
+* #170: Parse arbitrary precision integers.
+  Accept a single [A-Za-z] as modifier for integers (generalizing 'l','L','n')
+  and floats.
+  May cause breakage (ie. ppx preprocessor) because of changes in the parsetree.
+  This changes #6816 a little bit by reading the literal [123a] as a single
+  token that can later be rewritten by a ppx preprocessor.
+  (Hugo Heuzard)
+
+- #189: Added .dylib and .so as extensions for ocamlmklib
+  (Edgar Aroutiounian, whitequark)
+
+- #191: Making gc.h and some part of memory.h public
+  (Thomas Refis)
+
+- #196: Make [Thread.id] and [Thread.self] [noalloc]
+  (Clark Gaebel)
+
+- #237: a CONTRIBUTING document
+  (François Bobot, Gabriel Scherer, review by Xavier Leroy)
+
+- #245: remove a few remaining French comments
+  (Florian Angeletti)
+
+- #252: improve build instructions in MSVC Windows README
+  (Philip Daian)
+
+- #308: add experimental support for NetBSD/arm (verified on RaspberryPi)
+  (Rich Neswold)
+
+- #335: Type error messages specifies if a type is abstract
+  because no corresponding cmi could be found.
+  (Hugo Heuzard)
+
+- #365: prevent printing just a single type variable on one side
+  of a type error clash.
+  (Hugo Heuzard)
+
+- #383: configure: define _ALL_SOURCE for build on AIX7.1
+  (tkob)
+
+- #401: automatically retry failed test directories in the testsuite
+  (David Allsopp)
+
+- #451: an optional 'parallel' target in testsuite/Makefile using the
+  GNU parallel tool to run tests in parallel.
+  (Gabriel Scherer)
+
+- #555: ensure that register typing constraints are respected at
+  join points in the control flow graph
+  (Mark Shinwell, debugging & test case by Arseniy Alekseyev and Leo White,
+    code review by Xavier Leroy)
+
+### Build system:
+
+- #388: FlexDLL added as a Git submodule and bootstrappable with the compiler
+  (David Allsopp)
+
+OCaml 4.02.3 (27 Jul 2015):
+---------------------------
+
+Bug fixes:
+- #6908: Top-level custom printing for GADTs: interface change in 4.02.2
+  (Grégoire Henry, report by Jeremy Yallop)
+- #6919: corrupted final_table
+  (ygrek)
+- #6926: Regression: ocamldoc lost unattached comment
+  (Damien Doligez, report by François Bobot)
+- #6930: Aliased result type of GADT constructor results in assertion failure
+  (Jacques Garrigue)
+
+Feature wishes:
+- #6691: install .cmt[i] files for stdlib and compiler-libs
+  (David Sheets, request by Gabriel Radanne)
+- #37: New primitive: caml_alloc_dummy_function
+  (Hugo Heuzard)
+
+OCaml 4.02.2 (17 Jun 2015):
+---------------------------
+
+(Changes that can break existing programs are marked with a "*")
+
+Language features:
+- #6583: add a new class of binary operators with the same syntactic
+  precedence as method calls; these operators start with # followed
+  by a non-empty sequence of operator symbols (for instance #+, #!?).
+  It is also possible to use '#' as part of these extra symbols
+  (for instance ##, or #+#); this is rejected by the type-checker,
+  but can be used e.g. by ppx rewriters.
+  (Alain Frisch, request by Gabriel Radanne)
+* #6016: add a "nonrec" keyword for type declarations
+  (Jérémie Dimino)
+* #6612, #152: change the precedence of attributes in type declarations
+  (Jérémie Dimino)
+
+Compilers:
+- #6600: make -short-paths faster by building the printing map
+  incrementally
+  (Jacques Garrigue)
+- #6642: replace $CAMLORIGIN in -ccopt with the path to cma or cmxa
+  (whitequark, Gabriel Scherer, review by Damien Doligez)
+- #6797: new option -output-complete-obj
+  to output an object file with included runtime and autolink libraries
+  (whitequark)
+- #6845: -no-check-prims to tell ocamlc not to check primitives in runtime
+  (Alain Frisch)
+- #149: Attach documentation comments to parse tree
+  (Leo White)
+- #159: Better locations for structure/signature items
+  (Leo White)
+
+Toplevel and debugger:
+- #5958: generalized polymorphic #install_printer
+  (Pierre Chambart and Grégoire Henry)
+
+OCamlbuild:
+- #6237: explicit "infer" tag to control or disable menhir --infer
+  (Hugo Heuzard)
+- #6625: pass -linkpkg to files built with -output-obj.
+  (whitequark)
+- #6702: explicit "linkpkg" and "dontlink(foo)" flags
+  (whitequark, Gabriel Scherer)
+- #6712: Ignore common VCS directories
+  (whitequark)
+- #6720: pass -g to C compilers when tag 'debug' is set
+  (whitequark, Gabriel Scherer)
+- #6733: add .byte.so and .native.so targets to pass
+  -output-obj -cclib -shared.
+  (whitequark)
+- #6733: "runtime_variant(X)" to pass -runtime-variant X option.
+  (whitequark)
+- #6774: new menhir-specific flags "only_tokens" and "external_tokens(Foo)"
+  (François Pottier)
+
+Libraries:
+- #6285: Add support for nanosecond precision in Unix.stat()
+  (Jérémie Dimino, report by user 'gfxmonk')
+- #6781: Add higher baud rates to Unix termios
+  (Damien Doligez, report by Berke Durak)
+- #6834: Add Obj.{first,last}_non_constant_constructor_tag
+  (Mark Shinwell, request by Gabriel Scherer)
+
+Runtime:
+- #6078: Release the runtime system when calling caml_dlopen
+  (Jérémie Dimino)
+- #6675: GC hooks
+  (Damien Doligez and Roshan James)
+
+Build system:
+- #5418 (comments) : generate dependencies with $(CC) instead of gcc
+  (Damien Doligez and Michael Grünewald)
+- #6266: Cross compilation for iOs, Android etc
+  (whitequark, review by Damien Doligez and Mark Shinwell)
+
+Installation procedure:
+- Update instructions for x86-64 PIC mode and POWER architecture builds
+  (Mark Shinwell)
+
+Bug fixes:
+- #5271: Location.prerr_warning is hard-coded to use Format.err_formatter
+  (Damien Doligez, report by Rolf Rolles)
+- #5395: OCamlbuild mishandles relative symlinks and include paths
+  (Damien Doligez, report by Didier Le Botlan)
+- #5822: wrong value of Options.ext_dll on windows
+  (Damien Doligez and Daniel Weil)
+- #5836, #6684: printing lazy values in ocamldebug may segfault
+  (Gabriel Scherer, request by the Coq team)
+- #5887: move the byterun/*.h headers to byterun/caml/*.h to avoid
+  header name clashes
+  (Jérôme Vouillon and Adrien Nader and whitequark)
+- #6281: Graphics window does not acknowledge second click (double click)
+  (Kyle Headley)
+- #6490: incorrect backtraces in gdb on AArch64.  Also fixes incorrect
+  backtraces on 32-bit ARM.
+  (Mark Shinwell)
+- #6573: extern "C" for systhreads/threads.h
+  (Mickaël Delahaye)
+- #6575: Array.init evaluates callback although it should not do so
+  (Alain Frisch, report by Gerd Stolpmann)
+- #6607: The manual doesn't mention 0x200 flag for OCAMLRUNPARAM=v
+  (Alain Frisch)
+- #6616: allow meaningful use of -use-runtime without -custom.
+  (whitequark)
+- #6617: allow android build with pthreads support (since SDK r10c)
+  (whitequark)
+- #6626: ocamlbuild on cygwin cannot find ocamlfind
+  (Gergely Szilvasy)
+- #6628: Configure script rejects legitimate arguments
+  (Michael Grünewald, Damien Doligez)
+- #6630: Failure of tests/prim-bigstring/{big,}string.ml on big-endian
+  architectures
+  (Pierre Chambart, testing by Mark Shinwell)
+- #6640: ocamlbuild: wrong "unused tag" warning on "precious"
+  (report by user 'william')
+- #6652: ocamlbuild -clean does not print a newline after output
+  (Damien Doligez, report by Andi McClure)
+- #6658: cross-compiler: version check not working on OS X
+  (Gerd Stolpmann)
+- #6665: Failure of tests/asmcomp on sparc
+  (Stéphane Glondu)
+- #6667: wrong implementation of %bswap16 on ARM64
+  (Xavier Leroy)
+- #6669: fix 4.02 regression in toplevel printing of lazy values
+  (Leo White, review by Gabriel Scherer)
+- #6671: Windows: environment variable 'TZ' affects Unix.gettimeofday
+  (Mickaël Delahaye and Damien Doligez)
+- #6680: Missing parentheses in warning about polymorphic variant value
+  (Jacques Garrigue and Gabriel Scherer, report by Philippe Veber)
+- #6686: Bug in [subst_boxed_number]
+  (Jérémie Dimino, Mark Shinwell)
+- #6690: Uncaught exception (Not_found) with (wrong) wildcard or unification
+  type variable in place of a local abstract type
+  (Jacques Garrigue, report by Mikhail Mandrykin)
+- #6693 (part two): Incorrect relocation types in x86-64 runtime system
+  (whitequark, review by Jacques-Henri Jourdan, Xavier Leroy and Mark Shinwell)
+- #6717: Pprintast does not print let-pattern attributes
+  (Gabriel Scherer, report by whitequark)
+- #6727: Printf.sprintf "%F" misbehavior
+  (Benoît Vaugon, report by Vassili Karpov)
+- #6747: ocamlobjinfo: missing symbol caml_plugin_header due to underscore
+  (Damien Doligez, Maverick Woo)
+- #6749: ocamlopt returns n for (n mod 1) instead of 0
+  (Mark Shinwell and Jérémie Dimino)
+- #6753: Num.quo_num and Num.mod_num incorrect for some negative arguments
+  (Xavier Leroy)
+- #6758: Ocamldoc "analyse_module: parsetree and typedtree don't match"
+  (Damien Doligez, report by user 'maro')
+- #6759: big_int_of_string incorrectly parses some hexa literals
+  (Damien Doligez, report by Pierre-yves Strub)
+- #6763: #show with -short-paths doesn't select shortest type paths
+  (Jacques Garrigue, report by David Sheets)
+- #6768: Typechecker overflow the stack on cyclic type
+  (Jacques Garrigue, report by user 'darktenaibre')
+- #6770: (duplicate of #6686)
+- #6772: asmrun/signals_asm.c doesn't compile on NetBSD/i386
+  (Kenji Tokudome)
+- #6775: Digest.file leaks file descriptor on error
+  (Valentin Gatien-Baron)
+- #6779: Cross-compilers cannot link bytecode using custom primitives
+  (Damien Doligez, request by whitequark)
+- #6787: Soundness bug with polymorphic variants
+  (Jacques Garrigue, with help from Leo White and Grégoire Henry,
+   report by Michael O'Connor)
+- #6790: otherlibs should be built with -g
+  (Damien Doligez, report by whitequark)
+- #6791: "%s@[", "%s@{" regression in Scanf
+  (Benoît Vaugon)
+- #6793: ocamlbuild passes nonsensical "-ocamlc ..." commands to menhir
+  (Gabriel Scherer, report by Damien Doligez)
+- #6799: include guards missing for unixsupport.h and other files
+  (Andreas Hauptmann)
+- #6810: Improve documentation of Bigarray.Genarray.map_file
+  (Mark Shinwell and Daniel Bünzli)
+- #6812: -short-paths and -no-alias-deps can create inconsistent assumptions
+  (Jacques Garrigue, report by Valentin Gatien-Baron)
+- #6817: GADT exhaustiveness breakage with modules
+  (Leo White, report by Pierre Chambart)
+- #6824: fix buffer sharing on partial application of Format.asprintf
+  (Gabriel Scherer, report by Alain Frisch)
+- #6831: Build breaks for -aspp gcc on solaris-like OSs
+  (John Tibble)
+- #6836: Assertion failure using -short-paths
+  (Jacques Garrigue, report by David Sheets)
+- #6837: Build profiling libraries on FreeBSD and NetBSD x86-64
+  (Mark Shinwell, report by Michael Grünewald)
+- #6841: Changing compilation unit name with -o breaks ocamldebug
+  (Jacques Garrigue, report by Jordan Walke)
+- #6842: export Typemod.modtype_of_package
+- #6843: record weak dependencies even when the .cmi is missing
+  (Leo White, Gabriel Scherer)
+- #6849: Inverted pattern unification error
+  (Jacques Garrigue, report by Leo White)
+- #6857: __MODULE__ doesn't give the current module with -o
+  (Jacques Garrigue, report by Valentin Gatien-Baron)
+- #6862: Exhaustiveness check wrong for class constructor arguments
+  (Jacques Garrigue)
+- #6869: Improve comment on [Hashtbl.hash_param]
+  (Mark Shinwell, report by Jun Furuse)
+- #6870: Unsoundness when -rectypes fails to detect non-contractive type
+  (Jacques Garrigue, report by Stephen Dolan)
+- #6872: Type-directed propagation fails to disambiguate variants
+  that are also exception constructors
+  (Jacques Garrigue, report by Romain Beauxis)
+- #6878: AArch64 backend generates invalid asm: conditional branch
+  out of range (Mark Shinwell, report by Richard Jones, testing by Richard
+  Jones and Xavier Leroy, code review by Xavier Leroy and Thomas Refis)
+- #6879: Wrong optimization of 1 mod n
+  (Mark Shinwell, report by Jean-Christophe Filliâtre)
+- #6884: The __CYGWIN32__ #define should be replaced with __CYGWIN__
+  (Adrien Nader)
+- #6886: -no-alias-deps allows to build self-referential compilation units
+  (Jacques Garrigue, report by Valentin Gatien-Baron)
+- #6889: ast_mapper fails to rewrite class attributes
+  (Sébastien Briais)
+- #6893: ocamlbuild:  "tag not used" warning when using (p)dep
+  (Gabriel Scherer, report by Christiano Haesbaert)
+- #143: fix getsockopt behaviour for boolean socket options
+  (Anil Madhavapeddy and Andrew Ray)
+- #190: typo in pervasives
+  (Guillaume Bury)
+- Misplaced assertion in major_gc.c for no-naked-pointers mode
+  (Stephen Dolan, Mark Shinwell)
+
+Feature wishes:
+- #6452, #140: add internal support for custom printing formats
+  (Jérémie Dimino)
+- #6641: add -g, -ocamlcflags, -ocamloptflags options to ocamlmklib
+  (whitequark)
+- #6693: also build libasmrun_shared.so and lib{asm,caml}run_pic.a
+  (whitequark, review by Mark Shinwell)
+- #6842: export Typemod.modtype_of_package
+  (Jacques Garrigue, request by Jun Furuse)
+- #139: more versatile specification of locations of .annot
+  (Christophe Troestler, review by Damien Doligez)
+- #171: allow custom warning printers / catchers
+  (Benjamin Canou, review by Damien Doligez)
+- #191: Making gc.h and some part of memory.h public
+  (Thomas Refis)
+
+OCaml 4.02.1 (14 Oct 2014):
+---------------------------
+
+(Changes that can break existing programs are marked with a "*")
+
+Standard library:
+* Add optional argument ?limit to Arg.align.
+
+Bug Fixes:
+- #4099: Bug in Makefile.nt: won't stop on error
+  (George Necula)
+- #6181: Improve MSVC build
+  (Chen Gang)
+- #6207: Configure doesn't detect features correctly on Haiku
+  (Jessica Hamilton)
+- #6466: Non-exhaustive matching warning message for open types is confusing
+  (whitequark)
+- #6529: fix quadratic-time algorithm in Consistbl.extract.
+  (Xavier Leroy, Alain Frisch, relase-worthy report by Kate Deplaix)
+- #6530: Add stack overflow handling for native code (OpenBSD i386 and amd64)
+  (Cristopher Zimmermann)
+- #6533: broken semantics of %(%) when substituted by a box
+  (Benoît Vaugon, report by Boris Yakobowski)
+- #6534: legacy support for %.10s
+  (Benoît Vaugon, Gabriel Scherer, report by Nick Chapman)
+- #6536: better documentation of flag # in format strings
+  (Damien Doligez, report by Nick Chapman)
+- #6544: Bytes and CamlinternalFormat missing from threads stdlib.cma
+  (Christopher Zimmermann)
+- #6546: -dsource omits parens for `List ((`String "A")::[]) in patterns
+  (Gabriel Scherer, report by whitequark)
+- #6547: __MODULE__ aborts the compiler if the module name cannot be inferred
+  (Jacques Garrigue, report by Kaustuv Chaudhuri)
+- #6549: Debug section is sometimes not readable when using -pack
+  (Hugo Heuzard, review by Gabriel Scherer)
+- #6553: Missing command line options for ocamldoc
+  (Maxence Guesdon)
+- #6554: fix race condition when retrieving backtraces
+  (Jérémie Dimino, Mark Shinwell).
+- #6557: String.sub throws Invalid_argument("Bytes.sub")
+  (Damien Doligez, report by Oliver Bandel)
+- #6562: Fix ocamldebug module source lookup
+  (Leo White)
+- #6563: Inclusion of packs failing to run module initializers
+  (Jacques Garrigue, report by Mark Shinwell)
+- #6564: infinite loop in Mtype.remove_aliases
+  (Jacques Garrigue, report by Mark Shinwell)
+- #6565: compilation fails with Env.Error(_)
+  (Jacques Garrigue and Mark Shinwell)
+- #6566: -short-paths and signature inclusion errors
+  (Jacques Garrigue, report by Mark Shinwell)
+- #6572: Fatal error with recursive modules
+  (Jacques Garrigue, report by Quentin Stievenart)
+- #6575: Array.init evaluates callback although it should not do so
+  (Alain Frisch, report by Gerd Stolpmann)
+- #6578: Recursive module containing alias causes Segmentation fault
+  (Jacques Garrigue)
+- #6581: Some bugs in generative functors
+  (Jacques Garrigue, report by Mark Shinwell)
+- #6584: ocamldep support for "-open M"
+  (Gabriel Scherer, review by Damien Doligez, report by Hezekiah M. Carty)
+- #6588: Code generation errors for ARM
+  (Mark Shinwell, Xavier Leroy)
+- #6590: Improve Windows (MSVC and mingw) build
+  (Chen Gang)
+- #6599: ocamlbuild: add -bin-annot when using -pack
+  (Christopher Zimmermann)
+- #6602: Fatal error when tracing a function with abstract type
+  (Jacques Garrigue, report by Hugo Herbelin)
+- ocamlbuild: add an -ocamlmklib option to change the ocamlmklib command
+  (Jérôme Vouillon)
+
+OCaml 4.02.0 (29 Aug 2014):
+---------------------------
+
+(Changes that can break existing programs are marked with a "*")
+
+Language features:
+- Attributes and extension nodes
+  (Alain Frisch)
+- Generative functors (#5905)
+  (Jacques Garrigue)
+* Module aliases
+  (Jacques Garrigue)
+* Alternative syntax for string literals {id|...|id} (can break comments)
+  (Alain Frisch)
+- Separation between read-only strings (type string) and read-write byte
+  sequences (type bytes). Activated by command-line option -safe-string.
+  (Damien Doligez)
+- #6318: Exception cases in pattern matching
+  (Jeremy Yallop, backend by Alain Frisch)
+- #5584: Extensible open datatypes
+  (Leo White)
+
+Build system for the OCaml distribution:
+- Use -bin-annot when building.
+- Use GNU make instead of portable makefiles.
+- Updated build instructions for 32-bit Mac OS X on Intel hardware.
+
+Shedding weight:
+* Removed Camlp4 from the distribution, now available as third-party software.
+* Removed Labltk from the distribution, now available as a third-party library.
+
+Type system:
+* #6235: Keep typing of pattern cases independent in principal mode
+  (i.e. information from previous cases is no longer used when typing
+  patterns; cf. '#6235' in testsuite/test/typing-warnings/records.ml)
+  (Jacques Garrigue)
+- Allow opening a first-class module or applying a generative functor
+  in the body of a generative functor. Allow it also in the body of
+  an applicative functor if no types are created
+  (Jacques Garrigue, suggestion by Leo White)
+* Module aliases are now typed in a specific way, which remembers their
+  identity. Compiled interfaces become smaller, but may depend on the
+  original modules. This also changes the signature inferred by
+  "module type of".
+  (Jacques Garrigue, feedback from Leo White, Mark Shinwell and Nick Chapman)
+- #6331: Slight change in the criterion to distinguish private
+  abbreviations and private row types: create a private abbreviation for
+  closed objects and fixed polymorphic variants.
+  (Jacques Garrigue)
+* #6333: Compare first class module types structurally rather than
+  nominally. Value subtyping allows module subtyping as long as the internal
+  representation is unchanged.
+  (Jacques Garrigue)
+
+Compilers:
+- More aggressive constant propagation, including float and
+  int32/int64/nativeint arithmetic.  Constant propagation for floats
+  can be turned off with option -no-float-const-prop, for codes that
+  change FP rounding modes at run-time.
+  (Xavier Leroy)
+- New back-end optimization pass: common subexpression elimination (CSE).
+  (Reuses results of previous computations instead of recomputing them.)
+  (Xavier Leroy)
+- New back-end optimization pass: dead code elimination.
+  (Removes arithmetic and load instructions whose results are unused.)
+  (Xavier Leroy)
+- #6269: Optimization of sequences of string patterns
+  (Benoît Vaugon and Luc Maranget)
+- Experimental native code generator for AArch64 (ARM 64 bits)
+  (Xavier Leroy)
+- #6042: Optimization of integer division and modulus by constant divisors
+  (Xavier Leroy and Phil Denys)
+- Add "-open" command line flag for opening a single module before typing
+  (Leo White, Mark Shinwell and Nick Chapman)
+* "-o" now sets module name to the output file name up to the first "."
+  (it also applies when "-o" is not given, i.e. the module name is then
+   the input file name up to the first ".")
+  (Leo White, Mark Shinwell and Nick Chapman)
+* #5779: better sharing of structured constants
+  (Alain Frisch)
+- #5817: new flag to keep locations in cmi files
+  (Alain Frisch)
+- #5854: issue warning 3 when referring to a value marked with
+  the [@@ocaml.deprecated] attribute
+  (Alain Frisch, suggestion by Pierre-Marie Pédrot)
+- #6017: a new format implementation based on GADTs
+  (Benoît Vaugon and Gabriel Scherer)
+* #6203: Constant exception constructors no longer allocate
+  (Alain Frisch)
+- #6260: avoid unnecessary boxing in let
+  (Vladimir Brankov)
+- #6345: Better compilation of optional arguments with default values
+  (Alain Frisch, review by Jacques Garrigue)
+- #6389: ocamlopt -opaque option for incremental native compilation
+  (Pierre Chambart, Gabriel Scherer)
+
+Toplevel interactive system:
+- #5377: New "#show_*" directives
+  (ygrek, Jacques Garrigue and Alain Frisch)
+
+Runtime system:
+- New configure option "-no-naked-pointers" to improve performance by
+  avoiding page table tests during block darkening and the marking phase
+  of the major GC.  In this mode, all out-of-heap pointers must point at
+  things that look like OCaml values: in particular they must have a valid
+  header.  The colour of said headers should be black.
+  (Mark Shinwell, reviews by Damien Doligez and Xavier Leroy)
+- Fixed bug in native code version of [caml_raise_with_string] that could
+  potentially lead to heap corruption.
+  (Mark Shinwell)
+* Blocks initialized by [CAMLlocal*] and [caml_alloc] are now filled with
+  [Val_unit] rather than zero.
+  (Mark Shinwell)
+- Fixed a major performance problem on large heaps (~1GB) by making heap
+  increments proportional to heap size by default
+  (Damien Doligez)
+- #4765: Structural equality treats exception specifically
+  (Alain Frisch)
+- #5009: efficient comparison/indexing of exceptions
+  (Alain Frisch, request by Markus Mottl)
+- #6075: avoid using unsafe C library functions (strcpy, strcat, sprintf)
+  (Xavier Leroy, reports from user 'jfc' and Anil Madhavapeddy)
+- An ISO C99-compliant C compiler and standard library is now assumed.
+  (Plus special exceptions for MSVC.)  In particular, emulation code for
+  64-bit integer arithmetic was removed, the C compiler must support a
+  64-bit integer type.
+  (Xavier Leroy)
+
+Standard library:
+* Add new modules Bytes and BytesLabels for mutable byte sequences.
+  (Damien Doligez)
+- #4986: add List.sort_uniq and Set.of_list
+  (Alain Frisch)
+- #5935: a faster version of "raise" which does not maintain the backtrace
+  (Alain Frisch)
+- #6146: support "Unix.kill pid Sys.sigkill" under Windows
+  (Romain Bardou and Alain Frisch)
+- #6148: speed improvement for Buffer
+  (John Whitington)
+- #6180: efficient creation of uninitialized float arrays
+  (Alain Frisch, request by Markus Mottl)
+- #6355: Improve documentation regarding finalisers and multithreading
+  (Daniel Bünzli, Mark Shinwell)
+- Trigger warning 3 for all values marked as deprecated in the documentation.
+  (Damien Doligez)
+
+OCamldoc:
+- #6257: handle full doc comments for variant constructors and
+  record fields
+  (Maxence Guesdon, request by ygrek)
+- #6274: allow doc comments on object types
+  (Thomas Refis)
+- #6310: fix ocamldoc's subscript/superscript CSS font size
+  (Anil Madhavapeddy)
+- #6425: fix generation of man pages
+  (Maxence Guesdon, report by Anil Madhavapeddy)
+
+Bug fixes:
+- #2719: wrong scheduling of bound checks within a
+  try...with Invalid_argument -> _ ...  (Xavier Leroy)
+- #4719: Sys.executable_name wrong if executable name contains dots (Windows)
+  (Alain Frisch, report by Bart Jacobs)
+- #5406 ocamlbuild: "tag 'package' does not expect a parameter"
+  (Gabriel Scherer)
+- #5598, #6165: Alterations to handling of \013 in source files
+  breaking other tools
+  (David Allsopp and Damien Doligez)
+- #5820: Fix camlp4 lexer roll back problem
+  (Hongbo Zhang)
+- #5946: CAMLprim taking (void) as argument
+  (Benoît Vaugon)
+- #6038: on x86-32, enforce 16-byte stack alignment for compatibility
+  with recent GCC and Clang.  Win32/MSVC keeps 4-byte stack alignment.
+  (Xavier Leroy)
+- #6062: Fix a 4.01 camlp4 DELETE_RULE regression caused by commit 13047
+  (Hongbo Zhang, report by Christophe Troestler)
+- #6173: Typing error message is worse than before
+  (Jacques Garrigue and John Whitington)
+- #6174: OCaml compiler loops on an example using GADTs (-rectypes case)
+  (Jacques Garrigue and Grégoire Henry, report by Chantal Keller)
+- #6175: open! was not supported by camlp4
+  (Hongbo Zhang)
+- #6184: ocamlbuild: `ocamlfind ocamldep` does not support -predicate
+  (Kate Deplaix)
+- #6194: Incorrect unused warning with first-class modules in patterns
+  (Jacques Garrigue, report by Markus Mottl and Leo White)
+- #6211: in toplevel interactive use, bad interaction between uncaught
+  exceptions and multiple bindings of the form "let x = a let y = b;;".
+  (Xavier Leroy)
+- #6216: inlining of GADT matches generates invalid assembly
+  (Xavier Leroy and Alain Frisch, report by Mark Shinwell)
+- #6232: Don't use [mktemp] on platforms where [mkstemp] is available
+  (Stéphane Glondu, Mark Shinwell)
+- #6233: out-of-bounds exceptions lose their locations on ARM, PowerPC
+  (Jacques-Henri Jourdan and Xavier Leroy,
+   report and testing by Stéphane Glondu)
+- #6235: Issue with type information flowing through a variant pattern
+  (Jacques Garrigue, report by Hongbo Zhang)
+- #6239: sometimes wrong stack alignment when raising exceptions
+           in -g mode with backtraces active
+  (Xavier Leroy, report by Yaron Minsky)
+- #6240: Fail to expand module type abbreviation during substyping
+  (Jacques Garrigue, report by Leo White)
+- #6241: Assumed inequality between paths involving functor arguments
+  (Jacques Garrigue, report by Jeremy Yallop)
+- #6243: Make "ocamlopt -g" more resistant to ill-formed locations
+  (Xavier Leroy, report by Pierre-Marie Pédrot)
+- #6262: equality of first-class modules take module aliases into account
+  (Alain Frisch and Leo White)
+- #6268: -DMODEL_$(MODEL) not passed when building asmrun/arm.p.o
+  (Peter Michael Green)
+- #6273: fix Sys.file_exists on large files (Win32)
+  (Christoph Bauer)
+- #6275: Soundness bug related to type constraints
+  (Jacques Garrigue, report by Leo White)
+- #6293: Assert_failure with invalid package type
+  (Jacques Garrigue, report by Elnatan Reisner)
+- #6300: ocamlbuild -use-ocamlfind conflicts with -ocamlc
+  (Gabriel Scherer)
+- #6302: bytecode debug information re-read from filesystem every time
+  (Jacques-Henri Jourdan)
+- #6307: Behavior of 'module type of' w.r.t. module aliases
+  (Jacques Garrigue, report by Alain Frisch)
+- #6332: Unix.open_process fails to pass empty arguments under Windows
+  (Damien Doligez, report Virgile Prevosto)
+- #6346: Build failure with latest version of xcode on OSX
+  (Jérémie Dimino)
+- #6348: Unification failure for GADT when original definition is hidden
+  (Leo White and Jacques Garrigue, report by Jeremy Yallop)
+- #6352: Automatic removal of optional arguments and sequencing
+  (Jacques Garrigue and Alain Frisch)
+- #6361: Hashtbl.hash not terminating on some lazy values w/ recursive types
+  (Xavier Leroy, report by Leo White)
+- #6383: Exception Not_found when using object type in absent module
+  (Jacques Garrigue, report by Sébastien Briais)
+- #6384: Uncaught Not_found exception with a hidden .cmi file
+  (Leo White)
+- #6385: wrong allocation of large closures by the bytecode interpreter
+  (Xavier Leroy, report by Stephen Dolan)
+- #6394: Assertion failed in Typecore.expand_path
+  (Alain Frisch and Jacques Garrigue)
+- #6405: unsound interaction of -rectypes and GADTs
+  (Jacques Garrigue, report by Gabriel Scherer and Benoît Vaugon)
+- #6408: Optional arguments given as ~?arg instead of ?arg in message
+  (Michael O'Connor)
+- #6411: missing libgcc_s_sjlj-1.dll in mingw (add -static-libgcc)
+  (Jun Furuse and Alain Frisch, Jonathan Protzenko and Adrien Nader)
+- #6436: Typos in @deprecated text in stdlib/arrayLabels.mli
+  (John Whitington)
+- #6439: Don't use the deprecated [getpagesize] function
+  (John Whitington, Mark Shinwell)
+- #6441: undetected tail-call in some mutually-recursive functions
+  (many arguments, and mutual block mixes functions and non-functions)
+  (Stefan Holdermans, review by Xavier Leroy)
+- #6443: ocaml segfault when List.fold_left is traced then executed
+  (Jacques Garrigue, report by user 'Reventlov')
+- #6451: some bugs in untypeast.ml
+  (Jun Furuse, review by Alain Frisch)
+- #6460: runtime assertion failure with large [| e1;...eN |]
+  float array expressions
+  (Leo White)
+- #6463: -dtypedtree fails on class fields
+  (Leo White)
+- #6469: invalid -dsource printing of "external _pipe = ...", "Pervasives.(!)"
+  (Gabriel Scherer and Damien Doligez, user 'ngunn')
+- #6482: ocamlbuild fails when _tags file in unhygienic directory
+  (Gabriel Scherer)
+- #6502: ocamlbuild spurious warning on "use_menhir" tag
+  (Xavier Leroy)
+- #6505: Missed Type-error leads to a segfault upon record access
+  (Jacques Garrigue, Jeremy Yallop, report by Christoph Höger)
+- #6507: crash on AArch64 resulting from incorrect setting of
+  [caml_bottom_of_stack].  (Richard Jones, Mark Shinwell)
+- #6509: add -linkall flag to ocamlcommon.cma
+  (Frédéric Bour)
+- #6513: Fatal error Ctype.Unify(_) in functor type
+- #6523: failure upon character bigarray access, and unnecessary change
+  in comparison ordering (Jeremy Yallop, Mark Shinwell)
+- bound-checking bug in caml_string_{get,set}{16,32,64}
+  (Pierre Chambart and Gabriel Scherer, report by Nicolas Trangez)
+- sometimes wrong stack alignment at out-of-bounds array access
+  (Gabriel Scherer and Xavier Leroy, report by Pierre Chambart)
+
+Features wishes:
+- #4243: make the Makefiles parallelizable
+  (Grégoire Henry and Damien Doligez)
+- #4323: have "of_string" in Num and Big_int work with binary and
+           hex representations
+  (Zoe Paraskevopoulou, review by Gabriel Scherer)
+- #4771: Clarify documentation of Dynlink.allow_only
+  (Damien Doligez, report by David Allsopp)
+- #4855: 'camlp4 -I +dir' accepted, dir is relative to 'camlp4 -where'
+  (Jun Furuse and Hongbo Zhang, report by Dmitry Grebeniuk)
+- #5201: ocamlbuild: add --norc to the bash invocation to help performances
+  (Daniel Weil)
+- #5650: Camlp4FoldGenerator doesn't handle well "abstract" types
+  (Hongbo Zhang)
+- #5808: allow simple patterns, not just identifiers, in "let p : t = ..."
+  (Alain Frisch)
+- #5851: warn when -r is disabled because no _tags file is present
+  (Gabriel Scherer)
+- #5899: a programmer-friendly access to backtrace information
+  (Jacques-Henri Jourdan and Gabriel Scherer)
+- #6000 comment 9644: add a warning for non-principal coercions to format
+  (Jacques Garrigue, report by Damien Doligez)
+- #6054: add support for M.[ foo ], M.[| foo |] etc.
+  (Kaustuv Chaudhuri)
+- #6064: GADT representation for Bigarray.kind + CAML_BA_CHAR runtime kind
+  (Jeremy Yallop, review by Gabriel Scherer)
+- #6071: Add a -noinit option to the toplevel
+  (David Sheets)
+- #6087: ocamlbuild, improve _tags parsing of escaped newlines
+  (Gabriel Scherer, request by Daniel Bünzli)
+- #6109: Typos in ocamlbuild error messages
+  (Gabriel Kerneis)
+- #6116: more efficient implementation of Digest.to_hex
+  (ygrek)
+- #6142: add cmt file support to ocamlobjinfo
+  (Anil Madhavapeddy)
+- #6166: document -ocamldoc option of ocamlbuild
+  (Xavier Clerc)
+- #6182: better message for virtual objects and class types
+  (Leo White, Stephen Dolan)
+- #6183: enhanced documentation for 'Unix.shutdown_connection'
+  (Anil Madhavapeddy, report by Jun Furuse)
+- #6187: ocamlbuild: warn when using -plugin-tag(s) without myocamlbuild.ml
+  (Kate Deplaix)
+- #6246: allow wildcard _ as for-loop index
+  (Alain Frisch, request by ygrek)
+- #6267: more information printed by "bt" command of ocamldebug
+  (Josh Watzman)
+- #6270: remove need for -I directives to ocamldebug in common case
+  (Josh Watzman, review by Xavier Clerc and Alain Frisch)
+- #6311: Improve signature mismatch error messages
+  (Alain Frisch, suggestion by Daniel Bünzli)
+- #6358: obey DESTDIR in install targets
+  (Gabriel Scherer, request by François Berenger)
+- #6388, #6424: more parsetree correctness checks for -ppx users
+  (Alain Frisch, request by whitequark and Jun Furuse)
+- #6406: Expose OCaml version in C headers
+  (whitequark and Romain Calascibetta)
+- #6446: improve "unused declaration" warnings wrt. name shadowing
+  (Alain Frisch)
+- #6495: ocamlbuild tags 'safe_string', 'unsafe_string'
+  (Anil Madhavapeddy)
+- #6497: pass context information to -ppx preprocessors
+  (whitequark, Alain Frisch)
+- ocamllex: user-definable refill action
+  (Frédéric Bour, review by Gabriel Scherer and Luc Maranget)
+- shorten syntax for functor signatures: "functor (M1:S1) (M2:S2) .. -> .."
+  (Thomas Gazagnaire and Jeremy Yallop, review by Gabriel Scherer)
+- make ocamldebug -I auto-detection work with ocamlbuild
+  (Josh Watzman)
+
+OCaml 4.01.0 (12 Sep 2013):
+---------------------------
+
+(Changes that can break existing programs are marked with a "*")
+
+Other libraries:
+- Labltk: updated to Tcl/Tk 8.6.
+
+Type system:
+- #5759: use well-disciplined type information propagation to
+  disambiguate label and constructor names
+  (Jacques Garrigue, Alain Frisch and Leo White)
+* Propagate type information towards pattern-matching, even in the presence of
+  polymorphic variants (discarding only information about possibly-present
+  constructors). As a result, matching against absent constructors is no longer
+  allowed for exact and fixed polymorphic variant types.
+  (Jacques Garrigue)
+* #6035: Reject multiple declarations of the same method or instance variable
+  in an object
+  (Alain Frisch)
+
+Compilers:
+- #5861: raise an error when multiple private keywords are used in type
+  declarations
+  (Hongbo Zhang)
+- #5634: parsetree rewriter (-ppx flag)
+  (Alain Frisch)
+- ocamldep now supports -absname
+  (Alain Frisch)
+- #5768: On "unbound identifier" errors, use spell-checking to suggest names
+  present in the environment
+  (Gabriel Scherer)
+- ocamlc has a new option -dsource to visualize the parsetree
+  (Alain Frisch, Hongbo Zhang)
+- tools/eqparsetree compares two parsetree ignoring location
+  (Hongbo Zhang)
+- ocamlopt now uses clang as assembler on OS X if available, which enables
+  CFI support for OS X.
+  (Benedikt Meurer)
+- Added a new -short-paths option, which attempts to use the shortest
+  representation for type constructors inside types, taking open modules
+  into account. This can make types much more readable if your code
+  uses lots of functors.
+  (Jacques Garrigue)
+- #5986: added flag -compat-32 to ocamlc, ensuring that the generated
+  bytecode executable can be loaded on 32-bit hosts.
+  (Xavier Leroy)
+- #5980: warning on open statements which shadow an existing
+  identifier (if it is actually used in the scope of the open); new
+  open! syntax to silence it locally
+  (Alain Frisch, thanks to a report of Daniel Bünzli)
+* warning 3 is extended to warn about other deprecated features:
+  - ISO-latin1 characters in identifiers
+  - uses of the (&) and (or) operators instead of (&&) and (||)
+  (Damien Doligez)
+- Experimental OCAMLPARAM for ocamlc and ocamlopt
+  (Fabrice Le Fessant)
+- #5571: incorrect ordinal number in error message
+  (Alain Frisch, report by John Carr)
+- #6073: add signature to Tstr_include
+  (patch by Leo White)
+
+Standard library:
+- #5899: expose a way to inspect the current call stack,
+  Printexc.get_callstack
+  (Gabriel Scherer, Jacques-Henri Jourdan, Alain Frisch)
+- #5986: new flag Marshal.Compat_32 for the serialization functions
+  (Marshal.to_*), forcing the output to be readable on 32-bit hosts.
+  (Xavier Leroy)
+- infix application operators |> and @@ in Pervasives
+  (Fabrice Le Fessant)
+- #6176: new Format.asprintf function with a %a formatter
+  compatible with Format.fprintf (unlike Format.sprintf)
+  (Pierre Weis)
+
+Other libraries:
+- #5568: add O_CLOEXEC flag to Unix.openfile, so that the returned
+  file descriptor is created in close-on-exec mode
+  (Xavier Leroy)
+
+Runtime system:
+* #6019: more efficient implementation of caml_modify() and caml_initialize().
+  The new implementations are less lenient than the old ones: now,
+  the destination pointer of caml_modify() must point within the minor or
+  major heaps, and the destination pointer of caml_initialize() must
+  point within the major heap.
+  (Xavier Leroy, from an experiment by Brian Nigito, with feedback
+  from Yaron Minsky and Gerd Stolpmann)
+
+Internals:
+- Moved debugger/envaux.ml to typing/envaux.ml to publish env_of_only_summary
+  as part of compilerlibs, to be used on bin-annot files.
+  (Fabrice Le Fessant)
+- The test suite can now be run without installing OCaml first.
+  (Damien Doligez)
+
+Bug fixes:
+- #3236: Document the fact that queues are not thread-safe
+  (Damien Doligez)
+- #3468: (part 1) Sys_error documentation
+  (Damien Doligez)
+- #3679: Warning display problems
+  (Fabrice Le Fessant)
+- #3963: Graphics.wait_next_event in Win32 hangs if window closed
+  (Damien Doligez)
+- #4079: Queue.copy is now tail-recursive
+  (patch by Christophe Papazian)
+- #4138: Documentation for Unix.mkdir
+  (Damien Doligez)
+- #4469: emacs mode: caml-set-compile-command is annoying with ocamlbuild
+  (Daniel Bünzli)
+- #4485: Graphics: Keyboard events incorrectly delivered in native code
+  (Damien Doligez, report by Sharvil Nanavati)
+- #4502: ocamlbuild now reliably excludes the build-dir from hygiene check
+  (Gabriel Scherer, report by Romain Bardou)
+- #4762: ?? is not used at all, but registered as a lexer token
+  (Alain Frisch)
+- #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)
+- #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
+  (Damien Doligez, report by Stéphane Glondu)
+- #5098: creating module values may lead to memory leaks
+  (Alain Frisch, report by Milan Stanojević)
+- #5102: ocamlbuild fails when using an unbound variable in rule dependency
+  (Xavier Clerc, report by Daniel Bünzli)
+* #5119: camlp4 now raises a specific exception when 'DELETE_RULE' fails,
+  rather than raising 'Not_found'
+  (ygrek)
+- #5121: %( %) in Format module seems to be broken
+  (Pierre Weis, first patch by Valentin Gatien-Baron, report by Khoo Yit Phang)
+- #5178: document in INSTALL how to build a 32-bit version under Linux x86-64
+  (Benjamin Monate)
+- #5212: Improve ocamlbuild error messages of _tags parser
+  (ygrek)
+- #5240: register exception printers for Unix.Unix_error and Dynlink.Error
+  (Jérémie Dimino)
+- #5300: ocamlbuild: verbose parameter should implicitly set classic display
+  (Xavier Clerc, report by Robert Jakob)
+- #5327: (Windows) Unix.select blocks if same socket listed in first and
+  third arguments
+  (David Allsopp, displaying impressive MSDN skills)
+- #5343: ocaml -rectypes is unsound wrt module subtyping (was still unsound)
+  (Jacques Garrigue)
+- #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)
+- #5551: Avoid repeated lookups for missing cmi files
+  (Alain Frisch)
+- #5552: unrecognized gcc option -no-cpp-precomp
+  (Damien Doligez, report by Markus Mottl)
+* #5580: missed opportunities for constant propagation
+  (Xavier Leroy and John Carr)
+- #5611: avoid clashes between .cmo files and output files during linking
+  (Wojciech Meyer)
+- #5662: typo in md5.c
+  (Olivier Andrieu)
+- #5673: type equality in a polymorphic field
+  (Jacques Garrigue, report by Jean-Louis Giavitto)
+- #5674: Methods call are 2 times slower with 4.00 than with 3.12
+  (Jacques Garrigue, Gabriel Scherer, report by Jean-Louis Giavitto)
+- #5694: Exception raised by type checker
+  (Jacques Garrigue, report by Markus Mottl)
+- #5695: remove warnings on sparc code emitter
+  (Fabrice Le Fessant)
+- #5697: better location for warnings on statement expressions
+  (Dan Bensen)
+- #5698: remove hardcoded limit of 200000 labels in emitaux.ml
+  (Fabrice Le Fessant, report by Marcin Sawicki)
+- #5702: bytecomp/bytelibrarian lib_sharedobjs was defined but never used
+  (Hongbo Zhang, Fabrice Le Fessant)
+- #5708: catch Failure"int_of_string" in ocamldebug
+  (Fabrice Le Fessant, report by user 'schommer')
+- #5712: (9) new option -bin-annot is not documented
+  (Damien Doligez, report by Hendrik Tews)
+- #5731: instruction scheduling forgot to account for destroyed registers
+  (Xavier Leroy, Benedikt Meurer, reported by Jeffrey Scofield)
+- #5734: improved Win32 implementation of Unix.gettimeofday
+  (David Allsopp)
+- #5735: %apply and %revapply not first class citizens
+  (Fabrice Le Fessant, reported by Jun Furuse)
+- #5738: first class module patterns not handled by ocamldep
+  (Fabrice Le Fessant, Jacques Garrigue, reported by Hongbo Zhang)
+- #5739: Printf.printf "%F" (-.nan) returns -nan
+  (Xavier Leroy, David Allsopp, reported by Samuel Mimram)
+- #5741: make pprintast.ml in compiler_libs
+  (Alain Frisch, Hongbo Zhang)
+- #5747: 'unused open' warning not given when compiling with -annot
+  (Alain Frisch, reported by Valentin Gatien-Baron)
+- #5752: missing dependencies at byte-code link with mlpack
+  (Wojciech Meyer, Nicholas Lucaroni)
+- #5763: ocamlbuild does not give correct flags when running menhir
+  (Gabriel Scherer, reported by Philippe Veber)
+- #5765: ocamllex doesn't preserve line directives
+  (Damien Doligez, reported by Martin Jambon)
+- #5770: Syntax error messages involving unclosed parens are sometimes
+  incorrect
+  (Michel Mauny)
+- #5772: problem with marshaling of mutually-recursive functions
+  (Jacques-Henri Jourdan, reported by Cédric Pasteur)
+- #5775: several bug fixes for tools/pprintast.ml
+  (Hongbo Zhang)
+- #5784: -dclambda option is ignored
+  (Pierre Chambart)
+- #5785: misbehaviour with abstracted structural type used as GADT index
+  (Jacques Garrigue, report by Jeremy Yallop)
+- #5787: Bad behavior of 'Unused ...' warnings in the toplevel
+  (Alain Frisch)
+- #5793: integer marshalling is inconsistent between architectures
+  (Xavier Clerc, report by Pierre-Marie Pédrot)
+- #5798: add ARM VFPv2 support for Raspbian (ocamlopt)
+  (Jeffrey Scofield and Anil Madhavapeddy, patch review by Benedikt Meurer)
+- #5802: Avoiding "let" as a value name
+  (Jacques Garrigue, report by Tiphaine Turpin)
+- #5805: Assert failure with warning 34 on pre-processed file
+  (Alain Frisch, report by Tiphaine Turpin)
+- #5806: ensure that backtrace tests are always run (testsuite)
+  (Xavier Clerc, report by user 'michi')
+- #5809: Generating .cmt files takes a long time, in case of type error
+  (Alain Frisch)
+- #5810: error in switch printing when using -dclambda
+  (Pierre Chambart)
+- #5811: Untypeast produces singleton tuples for constructor patterns
+  with only one argument
+  (Tiphaine Turpin)
+- #5813: GC not called when unmarshaling repeatedly in a tight loop (ocamlopt)
+  (Xavier Leroy, report by David Waern)
+- #5814: read_cmt -annot does not report internal references
+  (Alain Frisch)
+- #5815: Multiple exceptions in signatures gives an error
+  (Leo White)
+- #5816: read_cmt -annot does not work for partial .cmt files
+  (Alain Frisch)
+- #5819: segfault when using [with] on large recursive record (ocamlopt)
+  (Xavier Leroy, Damien Doligez)
+- #5821: Wrong record field is reported as duplicate
+  (Alain Frisch, report by Martin Jambon)
+- #5824: Generate more efficient code for immediate right shifts.
+  (Pierre Chambart, review by Xavier Leroy)
+- #5825: Add a toplevel primitive to use source file wrapped with the
+  corresponding module
+  (Grégoire Henry, Wojciech Meyer, caml-list discussion)
+- #5833: README.win32 can leave the wrong flexlink in the path
+  (Damien Doligez, report by William Smith)
+- #5835: nonoptional labeled arguments can be passed with '?'
+  (Jacques Garrigue, report by Elnatan Reisner)
+- #5840: improved documentation for 'Unix.lseek'
+  (Xavier Clerc, report by Matej Košík)
+- #5848: Assertion failure in type checker
+  (Jacques Garrigue, Alain Frisch, report by David Waern)
+- #5858: Assert failure during typing of class
+  (Jacques Garrigue, report by Julien Signoles)
+- #5865: assert failure when reporting undefined field label
+  (Jacques Garrigue, report by Anil Madhavapeddy)
+- #5872: Performance: Buffer.add_char is not inlined
+  (Gerd Stolpmann, Damien Doligez)
+- #5876: Uncaught exception with a typing error
+  (Alain Frisch, Gabriel Scherer, report by Julien Moutinho)
+- #5877: multiple "open" can become expensive in memory
+  (Fabrice Le Fessant and Alain Frisch)
+- #5880: 'Genlex.make_lexer' documentation mentions the wrong exception
+  (Xavier Clerc, report by Virgile Prevosto)
+- #5885: Incorrect rule for compiling C stubs when shared libraries are not
+  supported.
+  (Jérôme Vouillon)
+- #5891: ocamlbuild: support rectypes tag for mlpack
+  (Khoo Yit Phang)
+- #5892: GADT exhaustiveness check is broken
+  (Jacques Garrigue and Leo White)
+- #5906: GADT exhaustiveness check is still broken
+  (Jacques Garrigue, report by Sébastien Briais)
+- #5907: Undetected cycle during typecheck causes exceptions
+  (Jacques Garrigue, report by Pascal Zimmer)
+- #5910: Fix code generation bug for "mod 1" on ARM.
+  (Benedikt Meurer, report by user 'jteg68')
+- #5911: Signature substitutions fail in submodules
+  (Jacques Garrigue, report by Markus Mottl)
+- #5912: add configure option -no-cfi (for OSX 10.6.x with XCode 4.0.2)
+  (Damien Doligez against XCode versions, report by Thomas Gazagnaire)
+- #5914: Functor breaks with an equivalent argument signature
+  (Jacques Garrigue, report by Markus Mottl and Grégoire Henry)
+- #5920, #5957: linking failure for big bytecodes on 32bit architectures
+  (Benoît Vaugon and Chet Murthy, report by Jun Furuse and Sebastien Mondet)
+- #5928: Missing space between words in manual page for ocamlmktop
+  (Damien Doligez, report by Matej Košík)
+- #5930: ocamldep leaks temporary preprocessing files
+  (Gabriel Scherer, report by Valentin Gatien-Baron)
+- #5933: Linking is slow when there are functions with large arities
+  (Valentin Gatien-Baron, review by Gabriel Scherer)
+- #5934: integer shift by negative amount (in otherlibs/num)
+  (Xavier Leroy, report by John Regehr)
+- #5944: Bad typing performances of big variant type declaration
+  (Benoît Vaugon)
+- #5945: Mix-up of Minor_heap_min and Minor_heap_max units
+  (Benoît Vaugon)
+- #5948: GADT with polymorphic variants bug
+  (Jacques Garrigue, report by Leo White)
+- #5953: Unix.system does not handle EINTR
+  (Jérémie Dimino)
+- #5965: disallow auto-reference to a recursive module in its definition
+  (Alain Frisch, report by Arthur Windler via Gabriel Scherer)
+- #5973: Format module incorrectly parses format string
+  (Pierre Weis, report by Frédéric Bour)
+- #5974: better documentation for Str.regexp
+  (Damien Doligez, report by william)
+- #5976: crash after recovering from two stack overflows (ocamlopt on MacOS X)
+  (Xavier Leroy, report by Pierre Boutillier)
+- #5977: Build failure on raspberry pi: "input_value: integer too large"
+  (Alain Frisch, report by Sylvain Le Gall)
+- #5981: Incompatibility check assumes abstracted types are injective
+  (Jacques Garrigue, report by Jeremy Yallop)
+- #5982: caml_leave_blocking section and errno corruption
+  (Jérémie Dimino)
+- #5985: Unexpected interaction between variance and GADTs
+  (Jacques Garrigue, Jeremy Yallop and Leo White and Gabriel Scherer)
+- #5988: missing from the documentation: -impl is a valid flag for ocamlopt
+  (Damien Doligez, report by Vincent Bernardoff)
+- #5989: Assumed inequalities involving private rows
+  (Jacques Garrigue, report by Jeremy Yallop)
+- #5992: Crash when pattern-matching lazy values modifies the scrutinee
+  (Luc Maranget, Leo White)
+- #5993: Variance of private type abbreviations not checked for modules
+  (Jacques Garrigue)
+- #5997: Non-compatibility assumed for concrete types with same constructor
+  (Jacques Garrigue, report by Gabriel Scherer)
+- #6004: Type information does not flow to "inherit" parameters
+  (Jacques Garrigue, report by Alain Frisch)
+- #6005: Type unsoundness with recursive modules
+  (Jacques Garrigue, report by Jérémie Dimino and Josh Berdine)
+- #6010: Big_int.extract_big_int gives wrong results on negative arguments
+  (Xavier Leroy, report by Drake Wilson via Stéphane Glondu)
+- #6024: Format syntax for printing @ is incompatible with 3.12.1
+  (Damien Doligez, report by Boris Yakobowski)
+- #6001: Reduce the memory used by compiling Camlp4
+  (Hongbo Zhang and Gabriel Scherer, report by Henri Gouraud)
+- #6031: Camomile problem with -with-frame-pointers
+  (Fabrice Le Fessant, report by Anil Madhavapeddy)
+- #6032: better Random.self_init under Windows
+  (Alain Frisch, Xavier Leroy)
+- #6033: Matching.inline_lazy_force needs eta-expansion (command-line flags)
+  (Pierre Chambart, Xavier Leroy and Luc Maranget,
+   regression report by Gabriel Scherer)
+- #6046: testsuite picks up the wrong ocamlrun dlls
+  (Anil Madhavapeddy)
+- #6056: Using 'match' prevents generalization of values
+  (Jacques Garrigue, report by Elnatan Reisner)
+- #6058: 'ocamlbuild -use-ocamlfind -tag thread -package threads t.cma' fails
+  (Gabriel Scherer, report by Hezekiah M. Carty)
+- #6069: ocamldoc: lexing: empty token
+  (Maxence Guesdon, Grégoire Henry, report by ygrek)
+- #6072: configure does not handle FreeBSD current (i.e. 10) correctly
+  (Damien Doligez, report by Prashanth Mundkur)
+- #6074: Wrong error message for failing Condition.broadcast
+  (Markus Mottl)
+- #6084: Define caml_modify and caml_initialize as weak symbols to help
+  with Netmulticore
+  (Xavier Leroy, Gerd Stolpmann)
+- #6090: Module constraint + private type seems broken in ocaml 4.01.0
+  (Jacques Garrigue, report by Kate Deplaix)
+- #6109: Typos in ocamlbuild error messages
+  (Gabriel Kerneis)
+- #6123: Assert failure when self escapes its class
+  (Jacques Garrigue, report by whitequark)
+- #6158: Fatal error using GADTs
+  (Jacques Garrigue, report by Jeremy Yallop)
+- #6163: Assert_failure using polymorphic variants in GADTs
+  (Jacques Garrigue, report by Leo White)
+- #6164: segmentation fault on Num.power_num of 0/1
+  (Fabrice Le Fessant, report by Johannes Kanig)
+- #6210: Camlp4 location error
+  (Hongbo Zhang, report by Jun Furuse)
+
+Feature wishes:
+- #5181: Merge common floating point constants in ocamlopt
+  (Benedikt Meurer)
+- #5243: improve the ocamlbuild API documentation in signatures.mli
+  (Christophe Troestler)
+- #5546: moving a function into an internal module slows down its use
+  (Alain Frisch, report by Fabrice Le Fessant)
+- #5597: add instruction trace option 't' to OCAMLRUNPARAM
+  (Anil Madhavapeddy, Wojciech Meyer)
+- #5676: IPv6 support under Windows
+  (Jérôme Vouillon, review by Jonathan Protzenko)
+- #5721: configure -with-frame-pointers for Linux perf profiling
+  (Fabrice Le Fessant, test by Jérémie Dimino)
+- #5722: toplevel: print full module path only for first record field
+  (Jacques Garrigue, report by ygrek)
+- #5762: Add primitives for fast access to bigarray dimensions
+  (Pierre Chambart)
+- #5769: Allow propagation of Sys.big_endian in native code
+  (Pierre Chambart, stealth commit by Fabrice Le Fessant)
+- #5771: Add primitives for reading 2, 4, 8 bytes in strings and bigarrays
+  (Pierre Chambart)
+- #5774: Add bswap primitives for amd64 and arm
+  (Pierre Chambart, test by Alain Frisch)
+- #5795: Generate sqrtsd opcode instead of external call to sqrt on amd64
+  (Pierre Chambart)
+- #5827: provide a dynamic command line parsing mechanism
+  (Hongbo Zhang)
+- #5832: patch to improve "wrong file naming" error messages
+  (William Smith)
+- #5864: Add a find operation to Set
+  (François Berenger)
+- #5886: Small changes to compile for Android
+  (Jérôme Vouillon, review by Benedikt Meurer)
+- #5902: -ppx based pre-processor executables accept arguments
+  (Alain Frisch, report by Wojciech Meyer)
+- #5986: Protect against marshaling 64-bit integers in bytecode
+  (Xavier Leroy, report by Alain Frisch)
+- #6049: support for OpenBSD/macppc platform
+  (Anil Madhavapeddy, review by Benedikt Meurer)
+- #6059: add -output-obj rules for ocamlbuild
+  (Anil Madhavapeddy)
+- #6060: ocamlbuild tags 'principal', 'strict_sequence' and 'short_paths'
+  (Anil Madhavapeddy)
+- ocamlbuild tag 'no_alias_deps'
+  (Daniel Bünzli)
+
+Tools:
+- OCamlbuild now features a bin_annot tag to generate .cmt files.
+  (Jonathan Protzenko)
+- OCamlbuild now features a strict_sequence tag to trigger the
+  strict-sequence option.
+  (Jonathan Protzenko)
+- OCamlbuild now picks the non-core tools like ocamlfind and menhir from PATH
+  (Wojciech Meyer)
+- #5884: Misc minor fixes and cleanup for emacs mode
+  (Stefan Monnier)
+- #6030: Improve performance of -annot
+  (Guillaume Melquiond, Alain Frisch)
+
+
+OCaml 4.00.1 (5 Oct 2012):
+--------------------------
+
+Bug fixes:
+- #4019: better documentation of Str.matched_string
+- #5111: ocamldoc, heading tags inside spans tags is illegal in html
+- #5278: better error message when typing "make"
+- #5468: ocamlbuild should preserve order of parametric tags
+- #5563: harden Unix.select against file descriptors above FD_SETSIZE
+- #5690: "ocamldoc ... -text README" raises exception
+- #5700: crash with native-code stack backtraces under MacOS 10.8 x86-64
+- #5707: AMD64 code generator: do not use r10 and r11 for parameter passing,
+  as these registers can be destroyed by the dynamic loader
+- #5712: some documentation problems
+- #5715: configuring with -no-shared-libs breaks under cygwin
+- #5718: false positive on 'unused constructor' warning
+- #5719: ocamlyacc generates code that is not warning 33-compliant
+- #5725: ocamldoc output of preformatted code
+- #5727: emacs caml-mode indents shebang line in toplevel scripts
+- #5729: tools/untypeast.ml creates unary Pexp_tuple
+- #5731: instruction scheduling forgot to account for destroyed registers
+- #5735: %apply and %revapply not first class citizens
+- #5738: first class module patterns not handled by ocamldep
+- #5742: missing bound checks in Array.sub
+- #5744: ocamldoc error on "val virtual"
+- #5757: GC compaction bug (crash)
+- #5758: Compiler bug when matching on floats
+- #5761: Incorrect bigarray custom block size
+
+
+OCaml 4.00.0 (26 Jul 2012):
+---------------------------
+
+(Changes that can break existing programs are marked with a "*")
+
+- The official name of the language is now OCaml.
+
+Language features:
+- Added Generalized Algebraic Data Types (GADTs) to the language.
+  See chapter "Language extensions" of the reference manual for documentation.
+- It is now possible to omit type annotations when packing and unpacking
+  first-class modules. The type-checker attempts to infer it from the context.
+  Using the -principal option guarantees forward compatibility.
+- New (module M) and (module M : S) syntax in patterns, for immediate
+  unpacking of a first-class module.
+
+Compilers:
+- Revised simplification of let-alias (#5205, #5288)
+- Better reporting of compiler version mismatch in .cmi files
+* Warning 28 is now enabled by default.
+- New option -absname to use absolute paths in error messages
+- Optimize away compile-time beta-redexes, e.g. (fun x y -> e) a b.
+- Added option -bin-annot to dump the AST with type annotations.
+- Added lots of new warnings about unused variables, opens, fields,
+  constructors, etc.
+* New meaning for warning 7: it is now triggered when a method is overridden
+  with the "method" keyword.  Use "method!" to avoid the warning.
+
+Native-code compiler:
+- Optimized handling of partially-applied functions (#5287)
+- Small improvements in code generated for array bounds checks (#5345,
+  #5360).
+* New ARM backend (#5433):
+    . Supports both Linux/EABI (armel) and Linux/EABI+VFPv3 (armhf).
+    . Added support for the Thumb-2 instruction set with average code size
+      savings of 28%.
+    . Added support for position-independent code, natdynlink, profiling and
+      exception backtraces.
+- Generation of CFI information, and filename/line number debugging (with -g)
+  annotations, enabling in particular precise stack backtraces with
+  the gdb debugger. Currently supported for x86 32-bits and 64-bits only.
+  (#5487)
+- New tool: ocamloptp, the equivalent of ocamlcp for the native-code compiler.
+
+OCamldoc:
+- #5645: ocamldoc doesn't handle module/type substitution in signatures
+- #5544: improve HTML output (less formatting in html code)
+- #5522: allow referring to record fields and variant constructors
+- fix #5419 (error message in french)
+- fix #5535 (no cross ref to class after dump+load)
+* Use first class modules for custom generators, to be able to
+  load various plugins incrementally adding features to the current
+  generator
+* #5507: Use Location.t structures for locations.
+- fix: do not keep code when not told to keep code.
+
+Standard library:
+- Added float functions "hypot" and "copysign" (#3806, #4752, #5246)
+* Arg: options with empty doc strings are no longer included in the usage string
+  (#5437)
+- Array: faster implementations of "blit", "copy", "sub", "append" and "concat"
+  (#2395, #2787, #4591)
+* Hashtbl:
+    . Statistically-better generic hash function based on Murmur 3 (#5225)
+    . Fixed behavior of generic hash function w.r.t. -0.0 and NaN (#5222)
+    . Added optional "random" parameter to Hashtbl.create to randomize
+      collision patterns and improve security (#5572, CVE-2012-0839)
+    . Added "randomize" function and "R" parameter to OCAMLRUNPARAM
+      to turn randomization on by default (#5572, CVE-2012-0839)
+    . Added new functorial interface "MakeSeeded" to support randomization
+      with user-provided seeded hash functions.
+    . Install new header  for C code.
+- Filename: on-demand (lazy) initialization of the PRNG used by "temp_file".
+- Marshal: marshalling of function values (flag Marshal.Closures) now
+  also works for functions that come from dynamically-loaded modules (#5215)
+- Random:
+     . More random initialization (Random.self_init()), using /dev/urandom
+       when available (e.g. Linux, FreeBSD, MacOS X, Solaris)
+     * Faster implementation of Random.float (changes the generated sequences)
+- Format strings for formatted input/output revised to correct #5380
+    . Consistently treat %@ as a plain @ character
+    . Consistently treat %% as a plain % character
+- Scanf: width and precision for floating point numbers are now handled
+- Scanf: new function "unescaped" (#3888)
+- Set and Map: more efficient implementation of "filter" and "partition"
+- String: new function "map" (#3888)
+
+Installation procedure:
+- Compiler internals are now installed in `ocamlc -where`/compiler-libs.
+  The files available there include the .cmi interfaces for all compiler
+  modules, plus the following libraries:
+      ocamlcommon.cma/.cmxa     modules common to ocamlc, ocamlopt, ocaml
+      ocamlbytecomp.cma/.cmxa   modules for ocamlc and ocaml
+      ocamloptcomp.cma/.cmxa    modules specific to ocamlopt
+      ocamltoplevel.cma         modules specific to ocaml
+   (#8255, #4653, frequently-asked feature).
+* Some .cmi for toplevel internals that used to be installed in
+  `ocamlc -where` are now to be found in  `ocamlc -where`/compiler-libs.
+  Add "-I +compiler-libs" where needed.
+* toplevellib.cma is no longer installed because subsumed by
+  ocamlcommon.cma ocamlbytecomp.cma ocamltoplevel.cma
+- Added a configuration option (-with-debug-runtime) to compile and install
+  a debug version of the runtime system, and a compiler option
+  (-runtime-variant) to select the debug runtime.
+
+Bug Fixes:
+
+- #8109: functions of the Lazy module whose named started with 'lazy_' have
+  been deprecated, and new ones without the prefix added
+- #3571: in Bigarrays, call msync() before unmapping to commit changes
+- #4292: various documentation problems
+- #4511, #4838: local modules remove polymorphism
+* #4549: Filename.dirname is not handling multiple / on Unix
+- #4688: (Windows) special floating-point values aren't converted to strings
+  correctly
+- #4697: Unix.putenv leaks memory on failure
+- #4705: camlp4 does not allow to define types with `True or `False
+- #4746: wrong detection of stack overflows in native code under Linux
+- #4869: rare collisions between assembly labels for code and data
+- #4880: "assert" constructs now show up in the exception stack backtrace
+- #4892: Array.set could raise "out of bounds" before evaluating 3rd arg
+- #4937: camlp4 incorrectly handles optional arguments if 'option' is
+  redefined
+- #5024: camlp4r now handles underscores in irrefutable pattern matching of
+  records
+- #5064, #5485: try to ensure that 4K words of stack are available
+  before calling into C functions, raising a Stack_overflow exception
+  otherwise.  This reduces (but does not eliminate) the risk of
+  segmentation faults due to stack overflow in C code
+- #5073: wrong location for 'Unbound record field label' error
+- #5084: sub-sub-module building fails for native code compilation
+- #5120: fix the output function of Camlp4.Debug.formatter
+- #5131: compilation of custom runtime with g++ generates lots of warnings
+- #5137: caml-types-explore does not work
+- #5159: better documentation of type Lexing.position
+- #5171: Map.join does more comparisons than needed
+- #5176: emacs mode: stack overflow in regexp matcher
+- #5179: port OCaml to mingw-w64
+- #5211: updated Genlex documentation to state that camlp4 is mandatory for
+  'parser' keyword and associated notation
+- #5214: ocamlfind plugin invokes 'cut' utility
+- #5218: use $(MAKE) instead of "make" in Makefiles
+- #5224: confusing error message in non-regular type definition
+- #5231: camlp4: fix parsing of <:str_item< type t = $x$ >>
+- #5233: finaliser on weak array gives dangling pointers (crash)
+- #5238, #5277: Sys_error when getting error location
+- #5261, #5497: Ocaml source-code examples are not "copy-paste-able"
+* #5279: executable name is not initialized properly in caml_startup_code
+- #5290: added hash functions for channels, nats, mutexes, conditions
+- #5291: undetected loop in class initialization
+- #5295: OS threads: problem with caml_c_thread_unregister()
+- #5301: camlp4r and exception equal to another one with parameters
+- #5305: prevent ocamlbuild from complaining about links to _build/
+- #5306: comparing to Thread.self() raises exception at runtime
+- #5309: Queue.add is not thread/signal safe
+- #5310: Ratio.create_ratio/create_normalized_ratio have misleading names
+- #5311: better message for warning 23
+* #5312: command-line arguments @reponsefile auto-expansion feature
+  removed from the Windows OCaml runtime, to avoid conflicts with "-w @..."
+- #5313: ocamlopt -g misses optimizations
+- #5214: ocamlfind plugin invokes 'cut' utility
+- #5316: objinfo now shows ccopts/ccobjs/force_link when applicable
+- #5318: segfault on stack overflow when reading marshaled data
+- #5319: %r11 clobbered by Lswitch in Windows AMD64 native-code compilation
+- #5322: type abbreviations expanding to a universal type variable
+- #5328: under Windows, Unix.select leaves sockets in non-blocking mode
+- #5330: thread tag with '.top' and '.inferred.mli' targets
+- #5331: ocamlmktop is not always a shell script
+- #5335: Unix.environment segfaults after a call to clearenv
+- #5338: sanitize.sh has windows style end-of-lines (mingw)
+- #5344: some predefined exceptions need special printing
+- #5349: Hashtbl.replace uses new key instead of reusing old key
+- #5356: ocamlbuild handling of 'predicates' for ocamlfind
+- #5364: wrong compilation of "((val m : SIG1) : SIG2)"
+- #5370: ocamldep omits filename in syntax error message
+- #5374: camlp4 creates wrong location for type definitions
+- #5380: strange sscanf input segfault
+- #5382: EOPNOTSUPP and ENOTSUPP different on exotic platforms
+- #5383: build failure in Win32/MSVC
+- #5387: camlp4: str_item and other syntactic elements with Nils are
+  not very usable
+- #5389: compaction sometimes leaves a very large heap
+- #5393: fails to build from source on GNU/kFreeBSD because of -R link option
+- #5394: documentation for -dtypes is missing in manpage
+- #5397: Filename.temp_dir_name should be mutable
+- #5410: fix printing of class application with Camlp4
+- #5416: (Windows) Unix.(set|clear)_close_on_exec now preserves blocking mode
+- #5435: ocamlbuild does not find .opt executables on Windows
+- #5436: update object ids on unmarshaling
+- #5442: camlp4: quotation issue with strings
+- #5453: configure doesn't find X11 under Ubuntu/MultiarchSpec
+- #5461: Double linking of bytecode modules
+- #5463: Bigarray.*.map_file fail if empty array is requested
+- #5465: increase stack size of ocamlopt.opt for windows
+- #5469: private record type generated by functor loses abbreviation
+- #5475: Wrapper script for interpreted LablTk wrongly handles command line
+  parameters
+- #5476: bug in native code compilation of let rec on float arrays
+- #5477: use pkg-config to configure graphics on linux
+- #5481: update camlp4 magic numbers
+- #5482: remove bashism in test suite scripts
+- #5495: camlp4o dies on infix definition (or)
+- #5498: Unification with an empty object only checks the absence of
+  the first method
+- #5503: error when ocamlbuild is passed an absolute path as build directory
+- #5509: misclassification of statically-allocated empty array that
+  falls exactly at beginning of an otherwise unused data page.
+- #5510: ocamldep has duplicate -ml{,i}-synonym options
+- #5511: in Bigarray.reshape, unwarranted limitation on new array dimensions.
+- #5513: Int64.div causes floating point exception (ocamlopt, x86)
+- #5516: in Bigarray C stubs, use C99 flexible array types if possible
+- #5518: segfault with lazy empty array
+- #5531: Allow ocamlbuild to add ocamldoc flags through -docflag
+  and -docflags switches
+- #5538: combining -i and -annot in ocamlc
+- #5543: in Bigarray.map_file, try to avoid using lseek() when growing file
+- #5648: (probably fixed) test failures in tests/lib-threads
+- #5551: repeated calls to find_in_path degrade performance
+- #5552: Mac OS X: unrecognized gcc option "-no-cpp-precomp"
+- #5555: add Hashtbl.reset to resize the bucket table to its initial size
+- #5560: incompatible type for tuple pattern with -principal
+- #5575: Random states are not marshallable across architectures
+- #5579: camlp4: when a plugin is loaded in the toplevel,
+  Token.Filter.define_filter has no effect before the first syntax error
+- #5585: typo: "explicitely"
+- #5587: documentation: "allows to" is not correct English
+- #5593: remove C file when -output-obj fails
+- #5597: register names for instrtrace primitives in embedded bytecode
+- #5598: add backslash-space support in strings in ocamllex
+- #5603: wrong .file debug info generated by ocamlopt -g
+- #5604: fix permissions of files created by ocamlbuild itself
+- #5610: new unmarshaler (from #5318) fails to freshen object identifiers
+- #5614: add missing -linkall flag when compiling ocamldoc.opt
+- #5616: move ocamlbuild documentation to the reference manual
+- #5619: Uncaught CType.Unify exception in the compiler
+- #5620: invalid printing of type manifest (camlp4 revised syntax)
+- #5637: invalid printing of anonymous type parameters (camlp4 revised syntax)
+- #5643: issues with .cfi and .loc directives generated by ocamlopt -g
+- #5644: Stream.count broken when used with Sapp or Slazy nodes
+- #5647: Cannot use install_printer in debugger
+- #5651: printer for abstract data type (camlp4 revised syntax)
+- #5654: self pattern variable location tweak
+- #5655: ocamlbuild doesn't pass cflags when building C stubs
+- #5657: wrong error location for abbreviated record fields
+- #5659: ocamlmklib -L option breaks with MSVC
+- #5661: fixes for the test suite
+- #5668: Camlp4 produces invalid syntax for "let _ = ..."
+- #5671: initialization of compare_ext field in caml_final_custom_operations()
+- #5677: do not use "value" as identifier (genprintval.ml)
+- #5687: dynlink broken when used from "output-obj" main program (bytecode)
+- problem with printing of string literals in camlp4 (reported on caml-list)
+- emacs mode: colorization of comments and strings now works correctly
+- problem with forall and method (reported on caml-list on 2011-07-26)
+- crash when using OCAMLRUNPARAM=a=X with invalid X (reported in private)
+
+Feature wishes:
+- #2757: new option "-stdin" to make ocaml read stdin as a script
+- #3358: better error message when mixing -a and .cmxa
+- #3492: documentation: remove restriction on mixed streams
+- #7971: allow configuring LIBDIR, BINDIR, and MANDIR relative to $(PREFIX)
+- #8285: add Digest.from_hex
+- #8341: toplevel: add option to suppress continuation prompts
+- #4278: configure: option to disable "graph" library
+- #4444: new String.trim function, removing leading and trailing whistespace
+- #4549: make Filename.dirname/basename POSIX compliant
+- #4830: add option -v to expunge.ml
+- #4898: new Sys.big_endian boolean for machine endianness
+- #4963, #5467: no extern "C" into ocaml C-stub headers
+- #5199: tests are run only for bytecode if either native support is missing,
+  or a non-empty value is set to "BYTECODE_ONLY" Makefile variable
+- #5215: marshalling of dynlinked closure
+- #5236: new '%revapply' primitive with the semantics 'revapply x f = f x',
+    and '%apply' with semantics 'apply f x = f x'.
+- #5255: natdynlink detection on powerpc, hurd, sparc
+- #5295: OS threads: problem with caml_c_thread_unregister()
+- #5297: compiler now checks existence of builtin primitives
+- #5329: (Windows) more efficient Unix.select if all fd's are sockets
+- #5357: warning for useless open statements
+- #5358: first class modules don't allow "with type" declarations for types
+  in sub-modules
+- #5385: configure: emit a warning when MACOSX_DEPLOYMENT_TARGET is set
+- #5396: ocamldep: add options -sort, -all, and -one-line
+- #5397: Filename.temp_dir_name should be mutable
+- #5403: give better error message when emacs is not found in PATH
+- #5411: new directive for the toplevel: #load_rec
+- #5420: Unix.openfile share mode (Windows)
+- #5421: Unix: do not leak fds in various open_proc* functions
+- #5434: implement Unix.times in win32unix (partially)
+- #5438: new warnings for unused declarations
+- #5439: upgrade config.guess and config.sub
+- #5445 and others: better printing of types with user-provided names
+- #5454: Digest.compare is missing and md5 doc update
+- #5455: .emacs instructions, add lines to recognize ocaml scripts
+- #5456: pa_macro: replace __LOCATION__ after macro expansion; add LOCATION_OF
+- #5461: bytecode: emit warning when linking two modules with the same name
+- #5478: ocamlopt assumes ar command exists
+- #5479: Num.num_of_string may raise an exception, not reflected in the
+  documentation.
+- #5501: increase IO_BUFFER_SIZE to 64KiB
+- #5532: improve error message when bytecode file is wrong
+- #5555: add function Hashtbl.reset to resize the bucket table to
+  its initial size.
+- #5586: increase UNIX_BUFFER_SIZE to 64KiB
+- #5597: register names for instrtrace primitives in embedded bytecode
+- #5599: Add warn() tag in ocamlbuild to control -w compiler switch
+- #5628: add #remove_directory and Topdirs.remove_directory to remove
+  a directory from the load path
+- #5636: in system threads library, issue with linking of pthread_atfork
+- #5666: C includes don't provide a revision number
+- ocamldebug: ability to inspect values that contain code pointers
+- ocamldebug: new 'environment' directive to set environment variables
+  for debuggee
+- configure: add -no-camlp4 option
+
+Shedding weight:
+* Removed the obsolete native-code generators for Alpha, HPPA, IA64 and MIPS.
+* The "DBM" library (interface with Unix DBM key-value stores) is no
+  longer part of this distribution.  It now lives its own life at
+  https://forge.ocamlcore.org/projects/camldbm/
+* The "OCamlWin" toplevel user interface for MS Windows is no longer
+  part of this distribution.  It now lives its own life at
+  https://forge.ocamlcore.org/projects/ocamltopwin/
+
+Other changes:
+- Copy VERSION file to library directory when installing.
+
+
+OCaml 3.12.1 (4 Jul 2011):
+--------------------------
+
+Bug fixes:
+- #4345, #4767: problems with camlp4 printing of float values
+- #4380: ocamlbuild should not use tput on windows
+- #4487, #5164: multiple 'module type of' are incompatible
+- #4552: ocamlbuild does not create symlinks when using '.itarget' file
+- #4673, #5144: camlp4 fails on object copy syntax
+- #4702: system threads: cleanup tick thread at exit
+- #4732: camlp4 rejects polymorphic variants using keywords from macros
+- #4778: Win32/MSVC port: rare syntax error in generated MASM assembly file
+- #4794, #4959: call annotations not generated by ocamlopt
+- #4820: revised syntax pretty printer crashes with 'Stack_overflow'
+- #4928: wrong printing of classes and class types by camlp4
+- #4939: camlp4 rejects patterns of the '?x:_' form
+- #4967: ocamlbuild passes wrong switches to ocamldep through menhir
+- #4972: mkcamlp4 does not include 'dynlink.cma'
+- #5039: ocamlbuild should use '-linkpkg' only when linking programs
+- #5066: ocamldoc: add -charset option used in html generator
+- #5069: fcntl() in caml_sys_open may block, do it within blocking section
+- #5071, #5129, #5134: inconsistencies between camlp4 and camlp4* binaries
+- #5080, #5104: regression in type constructor handling by camlp4
+- #5090: bad interaction between toplevel and camlp4
+- #5095: ocamlbuild ignores some tags when building bytecode objects
+- #5100: ocamlbuild always rebuilds a 'cmxs' file
+- #5103: build and install objinfo when building with ocamlbuild
+- #5109: crash when a parser calls a lexer that calls another parser
+- #5110: invalid module name when using optional argument
+- #5115: bytecode executables produced by msvc64 port crash on 32-bit versions
+- #5117: bigarray: wrong function name without HAS_MMAP; missing include
+- #5118: Camlp4o and integer literals
+- #5122: camlp4 rejects lowercase identifiers for module types
+- #5123: shift_right_big_int returns a wrong zero
+- #5124: substitution inside a signature leads to odd printing
+- #5128: typo in 'Camlp4ListComprehension' syntax extension
+- #5136: obsolete function used in emacs mode
+- #5145: ocamldoc: missing html escapes
+- #5146: problem with spaces in multi-line string constants
+- #5149: (partial) various documentation problems
+- #5156: rare compiler crash with objects
+- #5165: ocamlbuild does not pass '-thread' option to ocamlfind
+- #5167: camlp4r loops when printing package type
+- #5172: camlp4 support for 'module type of' construct
+- #5175: in bigarray accesses, make sure bigarray expr is evaluated only once
+- #5177: Gc.compact implies Gc.full_major
+- #5182: use bytecode version of ocamldoc to generate man pages
+- #5184: under Windows, alignment issue with bigarrays mapped from files
+- #5188: double-free corruption in bytecode system threads
+- #5192: mismatch between words and bytes in interpreting max_young_wosize
+- #5202: error in documentation of atan2
+- #5209: natdynlink incorrectly detected on BSD systems
+- #5213: ocamlbuild should pass '-rectypes' to ocamldoc when needed
+- #5217: ocamlfind plugin should add '-linkpkg' for toplevel
+- #5228: document the exceptions raised by functions in 'Filename'
+- #5229: typo in build script ('TAG_LINE' vs 'TAGLINE')
+- #5230: error in documentation of Scanf.Scanning.open_in
+- #5234: option -shared reverses order of -cclib options
+- #5237: incorrect .size directives generated for x86-32 and x86-64
+- #5244: String.compare uses polymorphic compare_val (regression of #4194)
+- #5248: regression introduced while fixing #5118
+- #5252: typo in docs
+- #5258: win32unix: unix fd leak under windows
+- #5269: (tentative fix) Wrong ext_ref entries in .annot files
+- #5272: caml.el doesn't recognize downto as a keyword
+- #5276: issue with ocamlc -pack and recursively-packed modules
+- #5280: alignment constraints incorrectly autodetected on MIPS 32
+- #5281: typo in error message
+- #5308: unused variables not detected in "include (struct .. end)"
+- camlp4 revised syntax printing bug in the toplevel (reported on caml-list)
+- configure: do not define _WIN32 under cygwin
+- Hardened generic comparison in the case where two custom blocks
+  are compared and have different sets of custom operations.
+- Hardened comparison between bigarrays in the case where the two
+  bigarrays have different kinds.
+- Fixed wrong autodetection of expm1() and log1p().
+- don't add .exe suffix when installing the ocamlmktop shell script
+- ocamldoc: minor fixes related to the display of ocamldoc options
+- fixed bug with huge values in OCAMLRUNPARAM
+- mismatch between declaration and definition of caml_major_collection_slice
+
+Feature wishes:
+- #4992: added '-ml-synonym' and '-mli-synonym' options to ocamldep
+- #5065: added '-ocamldoc' option to ocamlbuild
+- #5139: added possibility to add options to ocamlbuild
+- #5158: added access to current camlp4 parsers and printers
+- #5180: improved instruction selection for float operations on amd64
+- stdlib: added a 'usage_string' function to Arg
+- allow with constraints to add a type equation to a datatype definition
+- ocamldoc: allow to merge '@before' tags like other ones
+- ocamlbuild: allow dependency on file "_oasis"
+
+Other changes:
+- Changed default minor heap size from 32k to 256k words.
+- Added new operation 'compare_ext' to custom blocks, called when
+  comparing a custom block value with an unboxed integer.
+
+
+Objective Caml 3.12.0 (2 Aug 2010):
+-----------------------------------
+
+(Changes that can break existing programs are marked with a "*"  )
+
+Language features:
+- Shorthand notation for records: in expressions and patterns,
+    { lbl } stands for { lbl = lbl } and { M.lbl } for { M.lbl = lbl }
+- Record patterns of the form { lbl = pat; _ } to mark that not all
+  labels are listed, purposefully.  (See new warning below.)
+- Explicit naming of a generic type; in an expression
+  "fun ... (type t) ... -> e", the type t is considered abstract in its
+  scope (the arguments that follow it and the body of the function),
+  and then replaced by a fresh type variable. In particular, the type
+  t can be used in contexts where a type variable is not allowed
+  (e.g. for defining an exception in a local module).
+- Explicit polymorphic types and polymorphic recursion. In let
+  definitions, one can write an explicit polymorphic type just
+  immediately the function name; the polymorphism will be enforced,
+  and recursive calls may use the polymorphism.
+  The syntax is the same as for polymorphic methods:
+    "let [rec]  : 'a1 ... 'an.  = ..."
+- First-class packages modules.
+  New kind of type expression, for packaged modules: (module PT).
+  New kind of expression, to pack a module as a first-class value:
+    (module MODEXPR : PT).
+  New kind of module expression, to unpack a first-class value as a module:
+    (val EXPR : PT).
+  PT is a package type of the form "S" or
+  "S with type t1 = ... and ... and type tn = ..." (S refers to a module type).
+- Local opening of modules in a subexpression.
+  Syntax: "let open M in e", or "M.(e)"
+- In class definitions, method and instance variable override can now
+  be made explicit, by writing "method!", "val!" or "inherit!" in place of
+  "method", "val" and "inherit". It is an error to override an
+  undefined member (or to use overriding inheritance when nothing get
+  overridden). Additionally, these constructs disactivate respectively
+  warnings 7 (method override, code 'M') and 13 (instance variable
+  override, code 'V'). Note that, by default, warning 7 is inactive
+  and warning 13 is active.
+- "Destructive" substitution in signatures.
+  By writing " with type t := " and
+  " with module M := " one replaces "t" and "M"
+  inside the signature, removing their respective fields. Among other
+  uses, this allows to merge two signatures containing identically
+  named fields.
+* While fixing #4824, also corrected a gaping hole in the type checker,
+  which allowed instantiating separately object parameters and instance
+  variables in an interface. This hole was here since the beginning of
+  ocaml, and as a result many programs using object inheritance in a non
+  trivial way will need to be corrected. You can look at lablgtk2 for an
+  example.
+
+Compilers and toplevel:
+- Warnings are now numbered and can be switched on and off individually.
+  The old system with letters referring to sets of warnings is still
+  supported.
+- New warnings:
+  + 9 (code 'R') to signal record patterns without "; _" where
+    some labels of the record type are not listed in the pattern.
+  + 28 when giving a wildcard argument to a constant constructor in
+    a pattern-matching.
+  + 29 when an end-of-line appears unescaped in a string constant.
+  + 30 when the same constructor or record field is defined twice in
+    mutually-recursive type definitions.
+* The semantics of warning 7 (code 'M', method override) have changed
+  (it now detects all overrides, not just repeated definitions inside
+  the same class body), and it is now inactive by default.
+- Better error report in case of unbound qualified identifier: if the module
+  is unbound this error is reported in the first place.
+- Added option '-strict-sequence' to force left hand part of sequence to have
+  type unit.
+- Added option '-no-app-funct' to turn applicative functors off.
+  This option can help working around mysterious type incompatibilities
+  caused by the incomplete comparison of applicative paths F(X).t.
+
+Native-code compiler:
+- AMD64: shorter and slightly more efficient code generated for
+  float comparisons.
+
+Standard library:
+- Format: new function ikfprintf analogous to ifprintf with a continuation
+  argument.
+* #4210, #4245: stricter range checking in string->integer conversion
+  functions (int_of_string, Int32.of_string, Int64.of_string,
+  Nativeint.of_string).  The decimal string corresponding to
+  max_int + 1 is no longer accepted.
+- Scanf: to prevent confusion when mixing Scanf scanning functions and direct
+  low level input, value Scanf.stdin has been added.
+* Random: changed the algorithm to produce better randomness.  Now passes the
+  DieHard tests.
+- Map: implement functions from Set that make sense for Map.
+
+Other libraries:
+* Str: letters that constitute a word now include digits 0-9 and
+  underscore _.  This changes the interpretation of '\b' (word boundary)
+  in regexps, but is more consistent with other regexp libraries. (#4874).
+
+Ocamlbuild:
+- Add support for native dynlink.
+
+New tool:
+- ocamlobjinfo: displays various information, esp. dependencies, for
+  compiled OCaml files (.cmi, .cmo, .cma, .cmx, .cmxa, .cmxs, and bytecode
+  executables).  Extends and makes more official the old objinfo tool
+  that was installed by some OCaml packages.
+
+All tools:
+- #4857: add a -vnum option to display the version number and nothing else
+
+Bug Fixes:
+- #4012: Map.map and Map.mapi do not conform to specification
+- #4478: better error messages for type definition mismatches
+- #4683: labltk script uses fixed path on windows
+- #4742: finalisation function raising an exception blocks other finalisations
+- #4775: compiler crash on crazy types (temporary fix)
+- #4824: narrowing the type of class parameters with a module specification
+- #4862: relaxed value restriction and records
+- #4884: optional arguments do not work when Some is redefined
+- #4964: parenthesized names for infix functions in annot files
+- #4970: better error message for instance variables
+- #4975: spelling mistakes
+- #4988: contravariance lost with ocamlc -i
+- #5004: problem in Buffer.add_channel with very large lengths.
+- #5008: on AMD64/MSVC port, rare float corruption during GC.
+- #5018: wrong exception raised by Dynlink.loadfile.
+- #5057: fatal typing error with local module + functor + polymorphic variant
+- Wrong type for Obj.add_offset.
+- Small problem with representation of Int32, Int64, and Nativeint constants.
+- Use RTLD_LOCAL for native dynlink in private mode.
+
+Objective Caml 3.11.2 (20 Jan 2010):
+------------------------------------
+
+Bug fixes:
+- #4151: better documentation for min and max w.r.t. NaN
+- #4421: ocamlbuild uses wrong compiler for C files
+- #4710, #4720: ocamlbuild does not use properly configuration information
+- #4750: under some Windows installations, high start-up times for Unix lib
+- #4777: problem with scanf and CRLF
+- #4783: ocamlmklib problem under Windows
+- #4810: BSD problem with socket addresses, e.g. in Unix.getnameinfo
+- #4813: issue with parsing of float literals by the GNU assembler
+- #4816: problem with modules and private types
+- #4818: missed opportunity for type-based optimization of bigarray accesses
+- #4821: check for duplicate method names in classes
+- #4823: build problem on Mac OS X
+- #4836: spurious errors raised by Unix.single_write under Windows
+- #4841, #4860, #4930: problem with ocamlopt -output-obj under Mac OS X
+- #4847: C compiler error with ocamlc -output-obj under Win64
+- #4856: ocamlbuild uses ocamlrun to execute a native plugin
+- #4867, #4760: ocamlopt -shared fails on Mac OS X 64bit
+- #4873: ocamlbuild ignores "thread" tag when building a custom toplevel
+- #4890: ocamlbuild tries to use native plugin on bytecode-only arch
+- #4896: ocamlbuild should always pass -I to tools for external libraries
+- #4900: small bug triggering automatic compaction even if max_overhead = 1M
+- #4902: bug in %.0F printf format
+- #4910: problem with format concatenation
+- #4922: ocamlbuild recompiles too many files
+- #4923: missing \xff for scanf %S
+- #4933: functors not handling private types correctly
+- #4940: problem with end-of-line in DOS text mode, tentative fix
+- #4953: problem compiling bytecode interpreter on ARM in Thumb mode.
+- #4955: compiler crash when typing recursive type expression with constraint
+- Module Printf: the simple conversion %F (without width indication) was not
+           treated properly.
+- Makefile: problem with cygwin, flexdll, and symbolic links
+- Various build problems with ocamlbuild under Windows with msvc
+
+Feature wishes:
+- #2337: (tentative implementation) make ocamldebug use #linenum annotations
+- #2464, #4477: custom exception printers
+- #3456: Obj.double_field and Obj.set_double_field functions
+- #4003: destination directory can be given to Filename.[open_]temp_file
+- #4647: Buffer.blit function
+- #4685: access to Filename.dir_sep
+- #4703: support for debugging embedded applications
+- #4723: "clear_rules" function to empty the set of ocamlbuild rules
+- #4921: configure option to help cross-compilers
+
+Objective Caml 3.11.1 (12 Jun 2009):
+------------------------------------
+
+Bug fixes:
+- #4095: ocamldebug: strange behaviour of control-C
+- #4403: ocamldebug: improved handling of packed modules
+- #4650: Str.regexp_case_fold mis-handling complemented character sets [^a]
+- #4660: Scanf.format_from_string: handling of double quote
+- #4666: Unix.exec* failure in multithread programs under MacOS X and FreeBSD
+- #4667: debugger out of sync with dynlink changes
+- #4678: random "out of memory" error with systhreads
+- #4690: issue with dynamic loading under MacOS 10.5
+- #4692: wrong error message with options -i and -pack passed to ocamlc
+- #4699: in otherlibs/dbm, fixed construction of dlldbm.so.
+- #4704: error in caml_modify_generational_global_root()
+- #4708: (ocamldoc) improved printing of infix identifiers such as "lor".
+- #4722: typo in configure script
+- #4729: documented the fact that PF_INET6 is not available on all platforms
+- #4730: incorrect typing involving abbreviation "type 'a t = 'a"
+- #4731: incorrect quoting of arguments passed to the assembler on x86-64
+- #4735: Unix.LargeFile.fstat cannot report size over 32bits on Win32
+- #4740: guard against possible processor error in
+           {Int32,Int64,Nativeint}.{div,rem}
+- #4745: type inference wrongly produced non-generalizable type variables.
+- #4749: better pipe size for win32unix
+- #4756: printf: no error reported for wrong format '%_s'
+- #4758: scanf: handling of \ by format '%S'
+- #4766: incorrect simplification of some type abbreviations.
+- #4768: printf: %F does not respect width and precision specifications
+- #4769: Format.bprintf fails to flush
+- #4775: fatal error Ctype.Unify during module type-checking (temporary fix)
+- #4776: bad interaction between exceptions and classes
+- #4780: labltk build problem under Windows.
+- #4790: under Windows, map ERROR_NO_DATA Win32 error to EPIPE Unix error.
+- #4792: bug in Big_int.big_int_of_int64 on 32-bit platforms.
+- #4796: ocamlyacc: missing NUL termination of string
+- #4804: bug in Big_int.int64_of_big_int on 32-bit platforms.
+- #4805: improving compatibility with the clang C compiler
+- #4809: issue with Unix.create_process under Win32
+- #4814: ocamlbrowser: crash when editing comments
+- #4816: module abbreviations remove 'private' type restrictions
+- #4817: Object type gives error "Unbound type parameter .."
+- Module Parsing: improved computation of locations when an ocamlyacc rule
+                  starts with an empty nonterminal
+- Type-checker: fixed wrong variance computation for private types
+- x86-32 code generator, MSVC port: wrong "fld" instruction generated.
+- ocamlbuild: incorrectly using the compile-time value of $OCAMLLIB
+- Makefile problem when configured with -no-shared-libs
+- ocamldoc: use dynamic loading in native code
+
+Other changes:
+- Improved wording of various error messages
+  (contributed by Jonathan Davies, Citrix).
+- Support for 64-bit mode in Solaris/x86 (#4670).
+
+
+Objective Caml 3.11.0 (03 Dec 2008):
+------------------------------------
+
+(Changes that can break existing programs are marked with a "*"  )
+
+Language features:
+- Addition of lazy patterns: "lazy " matches suspensions whose values,
+  after forcing, match the pattern .
+- Introduction of private abbreviation types "type t = private ",
+  for abstracting the actual manifest type in type abbreviations.
+- Subtyping is now allowed between a private abbreviation and its definition,
+  and between a polymorphic method and its monomorphic instance.
+
+Compilers:
+- The file name for a compilation unit should correspond to a valid
+  identifier (Otherwise dynamic linking and other things can fail, and
+  a warning is emitted.)
+* Revised -output-obj: the output name must now be provided; its
+  extension must be one of .o/.obj, .so/.dll, or .c for the
+  bytecode compiler. The compilers can now produce a shared library
+  (with all the needed -ccopts/-ccobjs options) directly.
+- -dtypes renamed to -annot, records (in .annot files) which function calls
+  are tail calls.
+- All compiler error messages now include a file name and location, for
+  better interaction with Emacs' compilation mode.
+- Optimized compilation of "lazy e" when the argument "e" is
+  already evaluated.
+- Optimized compilation of equality tests with a variant constant constructor.
+- The -dllib options recorded in libraries are no longer ignored when
+  -use_runtime or -use_prims is used (unless -no_auto_link is
+  explicitly used).
+- Check that at most one of -pack, -a, -shared, -c, -output-obj is
+  given on the command line.
+- Optimized compilation of private types as regular manifest types
+  (e.g. abbreviation to float, float array or record types with only
+   float fields).
+
+Native-code compiler:
+- New port: Mac OS X / Intel in 64-bit mode (configure with -cc "gcc -m64").
+- A new option "-shared" to produce a plugin that can be dynamically
+  loaded with the native version of Dynlink.
+- A new option "-nodynlink" to enable optimizations valid only for code
+  that is never dynlinked (no-op except for AMD64).
+- More aggressive unboxing of floats and boxed integers.
+- Can select which assembler and asm options to use at configuration time.
+
+Run-time system:
+- New implementation of the page table describing the heap (two-level
+  array in 32 bits, sparse hashtable in 64 bits), fixes issues with address
+  space randomization on 64-bit OS (#4448).
+- New "generational" API for registering global memory roots with the GC,
+  enables faster scanning of global roots.
+  (The functions are caml_*_generational_global_root in .)
+- New function "caml_raise_with_args" to raise an exception with several
+  arguments from C.
+- Changes in implementation of dynamic linking of C code:
+  under Win32, use Alain Frisch's flexdll implementation of the dlopen
+  API; under MacOSX, use dlopen API instead of MacOSX bundle API.
+- Programs may now choose a first-fit allocation policy instead of
+  the default next-fit.  First-fit reduces fragmentation but is
+  slightly slower in some cases.
+
+Standard library:
+- Parsing library: new function "set_trace" to programmatically turn
+  on or off the printing of a trace during parsing.
+- Printexc library: new functions "print_backtrace" and "get_backtrace"
+  to obtain a stack backtrace of the most recently raised exception.
+  New function "record_backtrace" to turn the exception backtrace mechanism
+  on or off from within a program.
+- Scanf library: fine-tuning of meta format implementation;
+  fscanf behaviour revisited: only one input buffer is allocated for any
+  given input channel;
+  the %n conversion does not count a lookahead character as read.
+
+Other libraries:
+- Dynlink: on some platforms, the Dynlink library is now available in
+  native code. The boolean Dynlink.is_native allows the program to
+  know whether it has been compiled in bytecode or in native code.
+- Bigarrays: added "unsafe_get" and "unsafe_set"
+  (non-bound-checking versions of "get" and "set").
+- Bigarrays: removed limitation "array dimension < 2^31".
+- Labltk: added support for TK 8.5.
+- Num: added conversions between big_int and int32, nativeint, int64.
+  More efficient implementation of Num.quo_num and Num.mod_num.
+- Threads: improved efficiency of mutex and condition variable operations;
+  improved interaction with Unix.fork (#4577).
+- Unix: added getsockopt_error returning type Unix.error.
+  Added support for TCP_NODELAY and IPV6_ONLY socket options.
+- Win32 Unix: "select" now supports all kinds of file descriptors.
+  Improved emulation of "lockf" (#4609).
+
+Tools:
+- ocamldebug now supported under Windows (MSVC and Mingw ports),
+  but without the replay feature.  (Contributed by Dmitry Bely
+  and Sylvain Le Gall at OCamlCore with support from Lexifi.)
+- ocamldoc: new option -no-module-constraint-filter to include functions
+  hidden by signature constraint in documentation.
+- ocamlmklib and ocamldep.opt now available under Windows ports.
+- ocamlmklib no longer supports the -implib option.
+- ocamlnat: an experimental native toplevel (not built by default).
+
+Camlp4:
+* programs linked with camlp4lib.cma now also need dynlink.cma.
+
+Bug fixes:
+- Major GC and heap compaction: fixed bug involving lazy values and
+  out-of-heap pointers.
+- #3915: updated most man pages.
+- #4261: type-checking of recursive modules
+- #4308: better stack backtraces for "spontaneous" exceptions such as
+  Stack_overflow, Out_of_memory, etc.
+- #4338: Str.global_substitute, Str.global_replace and the Str.*split*
+  functions are now tail-recursive.
+- #4503: fixed bug in classify_float on ARM.
+- #4512: type-checking of recursive modules
+- #4517: crash in ocamllex-generated lexers.
+- #4542: problem with return value of Unix.nice.
+- #4557: type-checking of recursive modules.
+- #4562: strange %n semantics in scanf.
+- #4564: add note "stack is not executable" to object files generated by
+  ocamlopt (Linux/x86, Linux/AMD64).
+- #4566: bug in Ratio.approx_ratio_fix and Num.approx_num_fix.
+- #4582: clarified the documentation of functions in the String module.
+- #4583: stack overflow in "ocamlopt -g" during closure conversion pass.
+- #4585: ocamldoc and "val virtual" declarations.
+- #4587: ocamldoc and escaped @ characters.
+- #4605: Buffer.add_substitute was sometime wrong when target string had
+           backslashes.
+- #4614: Inconsistent declaration of CamlCBCmd in LablTk library.
+
+
+Objective Caml 3.10.2 (29 Feb 2008):
+------------------------------------
+
+Bug fixes:
+- #3410 (partial) Typo in ocamldep man page
+- #3952 (partial) ocamlopt: allocation problems on ARM
+- #4339 (continued) ocamlopt: problems on HPPA
+- #4455 str.mli not installed under Windows
+- #4473 crash when accessing float array with polymorphic method
+- #4480 runtime would not compile without gcc extensions
+- #4481 wrong typing of exceptions with object arguments
+- #4490 typo in error message
+- Random crash on 32-bit when major_heap_increment >= 2^22
+- Big performance bug in Weak hashtables
+- Small bugs in the make-package-macosx script
+- Bug in typing of polymorphic variants (reported on caml-list)
+
+
+Objective Caml 3.10.1 (11 Jan 2008):
+------------------------------------
+
+Bug fixes:
+- #3830 small bugs in docs
+- #4053 compilers: improved compilation time for large variant types
+- #4174 ocamlopt: fixed ocamlopt -nopervasives
+- #4199 otherlibs: documented a small problem in Unix.utimes
+- #4280 camlp4: parsing of identifier (^)
+- #4281 camlp4: parsing of type constraint
+- #4285 runtime: cannot compile under AIX
+- #4286 ocamlbuild: cannot compile under AIX and SunOS
+- #4288 compilers: including a functor application with side effects
+- #4295 camlp4 toplevel: synchronization after an error
+- #4300 ocamlopt: crash with backtrace and illegal array access
+- #4302 camlp4: list comprehension parsing problem
+- #4304 ocamlbuild: handle -I correctly
+- #4305 stdlib: alignment of Arg.Symbol
+- #4307 camlp4: assertion failure
+- #4312 camlp4: accept "let _ : int = 1"
+- #4313 ocamlbuild: -log and missing directories
+- #4315 camlp4: constraints in classes
+- #4316 compilers: crash with recursive modules and Lazy
+- #4318 ocamldoc: installation problem with Cygwin (tentative fix)
+- #4322 ocamlopt: stack overflow under Windows
+- #4325 compilers: wrong error message for unused var
+- #4326 otherlibs: marshal Big_int on win64
+- #4327 ocamlbuild: make emacs look for .annot in _build directory
+- #4328 camlp4: stack overflow with nil nodes
+- #4331 camlp4: guards on fun expressions
+- #4332 camlp4: parsing of negative 32/64 bit numbers
+- #4336 compilers: unsafe recursive modules
+- #4337 (note) camlp4: invalid character escapes
+- #4339 ocamlopt: problems on HP-UX (tentative fix)
+- #4340 camlp4: wrong pretty-printing of optional arguments
+- #4348 ocamlopt: crash on Mac Intel
+- #4349 camlp4: bug in private type definitions
+- #4350 compilers: type errors with records and polymorphic variants
+- #4352 compilers: terminal recursion under Windows (tentative fix)
+- #4354 ocamlcp: mismatch with ocaml on polymorphic let
+- #4358 ocamlopt: float constants wrong on ARM
+- #4360 ocamldoc: string inside comment
+- #4365 toplevel: wrong pretty-printing of polymorphic variants
+- #4373 otherlibs: leaks in win32unix
+- #4374 otherlibs: threads module not initialized
+- #4375 configure: fails to build on bytecode-only architectures
+- #4377 runtime: finalisation of infix pointers
+- #4378 ocamlbuild: typo in plugin.ml
+- #4379 ocamlbuild: problem with plugins under Windows
+- #4382 compilers: typing of polymorphic record fields
+- #4383 compilers: including module with private type
+- #4385 stdlib: Int32/Int64.format are unsafe
+- #4386 otherlibs: wrong signal numbers with Unix.sigprocmask etc.
+- #4387 ocamlbuild: build directory not used properly
+- #4392 ocamldep: optional argument of class
+- #4394 otherlibs: infinite loops in Str
+- #4397 otherlibs: wrong size for flag arrays in win32unix
+- #4402 ocamldebug: doesn't work with -rectypes
+- #4410 ocamlbuild: problem with plugin and -build
+- #4411 otherlibs: crash with Unix.access under Windows
+- #4412 stdlib: marshalling broken on 64 bit architectures
+- #4413 ocamlopt: crash on AMD64 with out-of-bound access and reraise
+- #4417 camlp4: pretty-printing of unary minus
+- #4419 camlp4: problem with constraint in type class
+- #4426 compilers: problem with optional labels
+- #4427 camlp4: wrong pretty-printing of lists of functions
+- #4433 ocamlopt: fails to build on MacOSX 10.5
+- #4435 compilers: crash with objects
+- #4439 fails to build on MacOSX 10.5
+- #4441 crash when build on sparc64 linux
+- #4442 stdlib: crash with weak pointers
+- #4446 configure: fails to detect X11 on MacOSX 10.5
+- #4448 runtime: huge page table on 64-bit architectures
+- #4450 compilers: stack overflow with recursive modules
+- #4470 compilers: type-checking of recursive modules too restrictive
+- #4472 configure: autodetection of libX11.so on Fedora x86_64
+- printf: removed (partially implemented) positional specifications
+- polymorphic < and <= comparisons: some C compiler optimizations
+  were causing incorrect results when arguments are incomparable
+
+New features:
+- made configure script work on PlayStation 3
+- ARM port: brought up-to-date for Debian 4.0 (Etch)
+- many other small changes and bugfixes in camlp4, ocamlbuild, labltk,
+  emacs files
+
+
+Objective Caml 3.10.0 (18 May 2007):
+------------------------------------
+
+(Changes that can break existing programs are marked with a "*"  )
+
+Language features:
+- Added virtual instance variables in classes "val virtual v : t"
+* Changed the behaviour of instance variable overriding; the new
+  definition replaces the old one, rather than creating a new
+  variable.
+
+New tools:
+- ocamlbuild: compilation manager for OCaml applications and libraries.
+  See draft documentation at http://gallium.inria.fr/~pouillar/
+* Camlp4: heavily revised implementation, new API.
+
+New ports:
+- MacOS X PowerPC 64 bits.
+- MS Windows 64 bits (x64) using the Microsoft PSDK toolchain.
+- MS Windows 32 bits using the Visual Studio 2005 toolchain.
+
+Compilers:
+- Faster type-checking of functor applications.
+- Referencing an interface compiled with -rectypes from a module
+    not compiled with -rectypes is now an error.
+- Revised the "fragile matching" warning.
+
+Native-code compiler:
+- Print a stack backtrace on an uncaught exception.
+  (Compile and link with ocamlopt -g; execute with OCAMLRUNPARAM=b.)
+  Supported on Intel/AMD in 32 and 64 bits, PPC in 32 and 64 bits.
+- Stack overflow detection on MS Windows 32 bits (courtesy O. Andrieu).
+- Stack overflow detection on MacOS X PPC and Intel.
+- Intel/AMD 64 bits: generate position-independent code by default.
+- Fixed bug involving -for-pack and missing .cmx files (#4124).
+- Fixed bug causing duplication of literals  (#4152).
+
+Run-time system:
+- C/Caml interface functions take "char const *" arguments
+  instead of "char *" when appropriate.
+- Faster string comparisons (fast case if strings are ==).
+
+Standard library:
+- Refined typing of format strings (type format6).
+- Printf, Format: new function ifprintf that consumes its arguments
+    and prints nothing (useful to print conditionally).
+- Scanf:
+    new function format_from_string to convert a string to a format string;
+    new %r conversion to accommodate user defined scanners.
+- Filename: improved Win32 implementation of Filename.quote.
+- List: List.nth now tail-recursive.
+- Sys: added Sys.is_directory.  Some functions (e.g. Sys.command) that
+    could incorrectly raise Sys_io_blocked now raise Sys_error as intended.
+- String and Char: the function ``escaped'' now escapes all the characters
+    especially handled by the compiler's lexer (#4220).
+
+Other libraries:
+- Bigarray: mmap_file takes an optional argument specifying
+    the start position of the data in the mapped file.
+- Dynlink: now defines only two modules, Dynlink and Dynlinkaux (internal),
+    reducing risks of name conflicts with user modules.
+- Labltk under Win32: now uses Tcl/Tk 8.4 instead of 8.3 by default.
+- VM threads: improved performance of I/O operations (less polling).
+- Unix: new function Unix.isatty.
+- Unix emulation under Win32:
+    fixed incorrect error reporting in several functions (#4097);
+    better handling of channels opened on sockets (#4098);
+    fixed GC bug in Unix.system (#4112).
+
+Documentation generator (OCamldoc):
+- correctly handle '?' in value names (#4215)
+- new option -hide-warnings not to print ocamldoc warnings
+
+Lexer generator (ocamllex): improved error reporting.
+
+License: fixed a typo in the "special exception" to the LGPL.
+
+
+Objective Caml 3.09.3 (15 Sep 2006):
+------------------------------------
+
+Bug fixes:
+- ocamldoc: -using modtype constraint to filter module elements displayed
+    in doc #4016
+- ocamldoc: error in merging of top dependencies of modules #4007
+- ocamldoc: -dot-colors has no effect #3981
+- ocamdloc: missing crossref in text from intro files #4066
+- compilers: segfault with recursive modules #4008
+- compilers: infinite loop when compiling objects #4018
+- compilers: bad error message when signature mismatch #4001
+- compilers: infinite loop with -rectypes #3999
+- compilers: contravariance bug in private rows
+- compilers: unsafe cast with polymorphic exception #4002
+- native compiler: bad assembly code generated for AMD64 #4067
+- native compiler: stack alignment problems on MacOSX/i386 #4036
+- stdlib: crash in marshalling #4030
+- stdlib: crash when closing a channel twice #4039
+- stdlib: memory leak in Sys.readdir #4093
+- C interface: better definition of CAMLreturn #4068
+- otherlibs/unix: crash in gethostbyname #3043
+- tools: subtle problem with unset in makefile #4048
+- camlp4: install pa_o_fast.o #3812
+- camlp4: install more modules #3689
+
+New features:
+- ocamldoc: name resolution in cross-referencing {!name}: if name is not
+    found, then it is searched in the parent module/class, and in the parent
+    of the parent, and so on until it is found.
+- ocamldoc: new option -short-functors to use a short form to display
+    functors in html generator #4017
+- ocamlprof: added "-version" option
+
+
+
+Objective Caml 3.09.2 (14 Apr 2006):
+------------------------------------
+
+Bug fixes:
+- Makefile: problem with "make world.opt" #3954
+- compilers: problem compiling several modules with one command line #3979
+- compilers,ocamldoc: error message that Emacs cannot parse
+- compilers: crash when printing type error #3968
+- compilers: -dtypes wrong for monomorphic type variables #3894
+- compilers: wrong warning on optional arguments #3980
+- compilers: crash when wrong use of type constructor in let rec #3976
+- compilers: better wording of "statement never returns" warning #3889
+- runtime: inefficiency of signal handling #3990
+- runtime: crashes with I/O in multithread programs #3906
+- camlp4: empty file name in error messages #3886
+- camlp4: stack overflow #3948
+- otherlibs/labltk: ocamlbrowser ignores its command line options #3961
+- otherlibs/unix: Unix.times wrong under Mac OS X #3960
+- otherlibs/unix: wrong doc for execvp and execvpe #3973
+- otherlibs/win32unix: random crash in Unix.stat #3998
+- stdlib: update_mod not found under Windows #3847
+- stdlib: Filename.dirname/basename wrong on Win32 #3933
+- stdlib: incomplete documentation of Pervasives.abs #3967
+- stdlib: Printf bugs #3902, #3955
+- tools/checkstack.c: missing include
+- yacc: crash when given argument "-" #3956
+
+New features:
+- ported to MacOS X on Intel #3985
+- configure: added support for GNU Hurd #3991
+
+Objective Caml 3.09.1 (4 Jan 2006):
+-----------------------------------
+
+Bug fixes:
+- compilers: raise not_found with -principal #3855
+- compilers: assert failure in typeclass.cml #3856
+- compilers: assert failure in typing/ctype.ml #3909
+- compilers: fatal error exception Ctype.Unify #3918
+- compilers: spurious warning Y in objects #3868
+- compilers: spurious warning Z on loop index #3907
+- compilers: error message that emacs cannot parse
+- ocamlopt: problems with -for-pack/-pack #3825, #3826, #3919
+- ocamlopt: can't produce shared libraries on x86_64 #3869, #3924
+- ocamlopt: float alignment problem on SPARC #3944
+- ocamlopt: can't compile on MIPS #3936
+- runtime: missing dependence for ld.conf
+- runtime: missing dependence for .depend.nt #3880
+- runtime: memory leak in caml_register_named_value #3940
+- runtime: crash in Marshal.to_buffer #3879
+- stdlib: Sys.time giving wrong results on Mac OS X #3850
+- stdlib: Weak.get_copy causing random crashes in rare cases
+- stdlib, debugger, labltk: use TMPDIR if set #3895
+- stdlib: scanf bug on int32 and nativeint #3932
+- camlp4: mkcamlp4 option parsing problem #3941
+- camlp4: bug in pretty-printing of lazy/assert/new
+- camlp4: update the unmaintained makefile for _loc name
+- ocamldoc: several fixes see ocamldoc/Changes.txt
+- otherlibs/str: bug in long sequences of alternatives #3783
+- otherlibs/systhreads: deadlock in Windows #3910
+- tools: update dumpobj to handle new event format #3873
+- toplevel: activate warning Y in toplevel #3832
+
+New features:
+- otherlibs/labltk: browser uses menu bars instead of menu buttons
+
+Objective Caml 3.09.0 (27 Oct 2006):
+------------------------------------
+
+(Changes that can break existing programs are marked with a "*"  )
+
+Language features:
+- Introduction of private row types, for abstracting the row in object
+  and variant types.
+
+Type checking:
+- Polymorphic variants with at most one constructor [< `A of t] are no
+  longer systematically promoted to the exact type [`A of t]. This was
+  more confusing than useful, and created problems with private row
+  types.
+
+Both compilers:
+- Added warnings 'Y' and 'Z' for local variables that are bound but
+  never used.
+- Added warning for some uses non-returning functions (e.g. raise), when they
+  are passed extra arguments, or followed by extra statements.
+- Pattern matching: more prudent compilation in case of guards; fixed #3780.
+- Compilation of classes: reduction in size of generated code.
+- Compilation of "module rec" definitions: fixed a bad interaction with
+  structure coercion (to a more restrictive signature).
+
+Native-code compiler (ocamlopt):
+* Revised implementation of the -pack option (packing of several compilation
+  units into one).  The .cmx files that are to be packed with
+  "ocamlopt -pack -o P.cmx" must be compiled with "ocamlopt -for-pack P".
+  In exchange for this additional constraint, ocamlopt -pack is now
+  available on all platforms (no need for binutils).
+* Fixed wrong evaluation order for arguments to certain inlined functions.
+- Modified code generation for "let rec ... and ..." to reduce compilation
+  time (which was quadratic in the number of mutually-recursive functions).
+- x86 port: support tail-calls for functions with up to 21 arguments.
+- AMD64 port, Linux: recover from system stack overflow.
+- Sparc port: more portable handling of out-of-bound conditions
+  on systems other than Solaris.
+
+Standard library:
+- Pervasives: faster implementation of close_in, close_out.
+  set_binary_mode_{out,in} now working correctly under Cygwin.
+- Printf: better handling of partial applications of the printf functions.
+- Scanf: new function sscanf_format to read a format from a
+  string. The type of the resulting format is dynamically checked and
+  should be the type of the template format which is the second argument.
+- Scanf: no more spurious lookahead attempt when the end of file condition
+  is set and a correct token has already been read and could be returned.
+
+Other libraries:
+- System threads library: added Thread.sigmask; fixed race condition
+  in signal handling.
+- Bigarray library: fixed bug in Array3.of_array.
+- Unix library: use canonical signal numbers in results of Unix.wait*;
+  hardened Unix.establish_server against EINTR errors.
+
+Run-time system:
+- Support platforms where sizeof(void *) = 8 and sizeof(long) = 4.
+- Improved and cleaned up implementation of signal handling.
+
+Replay debugger:
+- Improved handling of locations in source code.
+
+OCamldoc:
+- extensible {foo } syntax
+- user can give .txt files on the command line, containing ocamldoc formatted
+  text, to be able to include bigger texts out of source files
+- -o option is now used by the html generator to indicate the prefix
+  of generated index files (to avoid conflict when a Index module exists
+  on case-insensitive file systems).
+
+Miscellaneous:
+- Configuration information is installed in `ocamlc -where`/Makefile.config
+  and can be used by client Makefiles or shell scripts.
+
+Objective Caml 3.08.4 (11 Aug 2005):
+------------------------------------
+
+New features:
+- configure: find X11 config in some 64-bit Linux distribs
+- ocamldoc: (**/**) can be canceled with another (**/**) #3665
+- graphics: added resize_window
+- graphics: check for invalid arguments to drawing primitives #3595
+- ocamlbrowser: use windows subsystem on mingw
+
+Bug fixes:
+- ocamlopt: code generation problem on AMD64 #3640
+- wrong code generated for some classes #3576
+- fatal error when compiling some OO code #3745
+- problem with comparison on constant constructors #3608
+- camlp4: cryptic error message #3592
+- camlp4: line numbers in multi-line antiquotations #3549
+- camlp4: problem with make depend
+- camlp4: parse error with :> #3561
+- camlp4: ident conversion problem with val/contents/contents__
+- camlp4: several small parsing problems #3688
+- ocamldebug: handling of spaces in executable file name #3736
+- emacs-mode: problem when caml-types-buffer is deleted by user #3704
+- ocamldoc: extra backslash in ocamldoc man page #3687
+- ocamldoc: improvements to HTML display #3698
+- ocamldoc: escaping of @ in info files
+- ocamldoc: escaping of . and \ in man pages #3686
+- ocamldoc: better error reporting of misplaced comments
+- graphics: fixed .depend file #3558
+- graphics: segfault with threads and graphics #3651
+- nums: several bugs: #3718, #3719, others
+- nums: inline asm problems with gcc 4.0 #3604, #3637
+- threads: problem with backtrace
+- unix: problem with getaddrinfo #3565
+- stdlib: documentation of Int32.rem and Int64.rem #3573
+- stdlib: documentation of List.rev_map2 #3685
+- stdlib: wrong order in Map.fold #3607
+- stdlib: documentation of maximum float array length #3714
+- better detection of cycles when using -rectypes
+- missing case of module equality #3738
+- better error messages for unbound type variables
+- stack overflow while printing type error message #3705
+- assert failure when typing some classes #3638
+- bug in type_approx
+- better error messages related to type variance checking
+- yacc: avoid name capture for idents of the Parsing module
+
+
+Objective Caml 3.08.3 (24 Mar 2005):
+------------------------------------
+
+New features:
+- support for ocamlopt -pack under Mac OS X (#2634, #3320)
+- ignore unknown warning options for forward and backward compatibility
+- runtime: export caml_compare_unordered (#3479)
+- camlp4: install argl.* files (#3439)
+- ocamldoc: add -man-section option
+- labltk: add the "solid" relief option (#3343)
+
+Bug fixes:
+- typing: fix unsoundness in type declaration variance inference.
+    Type parameters which are constrained must now have an explicit variant
+    annotation, otherwise they are invariant. This is not backward
+    compatible, so this might break code which either uses subtyping or
+    uses the relaxed value restriction (i.e. was not typable before 3.07)
+- typing: erroneous partial match warning for polymorphic variants (#3424)
+- runtime: handle the case of an empty command line (#3409, #3444)
+- stdlib: make Sys.executable_name an absolute path in native code (#3303)
+- runtime: fix memory leak in finalise.c
+- runtime: auto-trigger compaction even if gc is called manually (#3392)
+- stdlib: fix segfault in Obj.dup on zero-sized values (#3406)
+- camlp4: correct parsing of the $ identifier (#3310, #3469)
+- windows (MS tools): use link /lib instead of lib (#3333)
+- windows (MS tools): change default install destination
+- autoconf: better checking of SSE2 instructions (#3329, #3330)
+- graphics: make close_graph close the X display as well as the window (#3312)
+- num: fix big_int_of_string (empty string) (#3483)
+- num: fix big bug on 64-bit architecture (#3299)
+- str: better documentation of string_match and string_partial_match (#3395)
+- unix: fix file descriptor leak in Unix.accept (#3423)
+- unix: miscellaneous clean-ups
+- unix: fix documentation of Unix.tm (#3341)
+- graphics: fix problem when allocating lots of images under Windows (#3433)
+- compiler: fix error message with -pack when .cmi is missing (#3028)
+- cygwin: fix problem with compilation of camlheader (#3485)
+- stdlib: Filename.basename doesn't return an empty string any more (#3451)
+- stdlib: better documentation of Open_excl flag (#3450)
+- ocamlcp: accept -thread option (#3511)
+- ocamldep: handle spaces in file names (#3370)
+- compiler: remove spurious warning in pattern-matching on variants (#3424)
+- windows: better handling of InterpreterPath registry entry (#3334, #3432)
+
+
+Objective Caml 3.08.2 (22 Nov 2004):
+------------------------------------
+
+Bug fixes:
+- runtime: memory leak when unmarshalling big data structures (#3247)
+- camlp4: incorrect line numbers in errors (#3188)
+- emacs: xemacs-specific code, wrong call to "sit-for"
+- ocamldoc: "Lexing: empty token" (#3173)
+- unix: problem with close_process_* (#3191)
+- unix: possible coredumps (#3252)
+- stdlib: wrong order in Set.fold (#3161)
+- ocamlcp: array out of bounds in profiled programs (#3267)
+- yacc: problem with polymorphic variant types for grammar entries (#3033)
+
+Misc:
+- export  for caml_format_exception (#3080)
+- clean up caml_search_exe_in_path (maybe #3079)
+- camlp4: new function "make_lexer" for new-style locations
+- unix: added missing #includes (#3088)
+
+
+Objective Caml 3.08.1 (19 Aug 2004):
+------------------------------------
+
+Licence:
+- The emacs files are now under GPL
+- Slightly relaxed some conditions of the QPL
+
+Bug fixes:
+- ld.conf now generated at compile-time instead of install-time
+- fixed -pack on Windows XP (#2935)
+- fixed Obj.tag (#2946)
+- added support for multiple dlopen in Darwin
+- run ranlib when installing camlp4 libraries (#2944)
+- link camlp4opt with -linkall (#2949)
+- camlp4 parsing of patterns now conforms to normal parsing (#3015)
+- install camlp4 *.cmx files (#2955)
+- fixed handling of linefeed in string constants in camlp4 (#3074)
+- ocamldoc: fixed display of class parameters in HTML and LaTeX (#2994)
+- ocamldoc: fixed display of link to class page in html (#2994)
+- Windows toplevel GUI: assorted fixes (including #2932)
+
+Misc:
+- added -v option to ocamllex
+- ocamldoc: new -intf and -impl options supported (#3036)
+
+Objective Caml 3.08.0 (13 Jul 2004):
+------------------------------------
+
+(Changes that can break existing programs are marked with a "*"  )
+
+Language features:
+- Support for immediate objects, i.e. objects defined without going
+  through a class.  (Syntax is "object  end".)
+
+Type-checking:
+- When typing record construction and record patterns, can omit
+  the module qualification on all labels except one.  I.e.
+  { M.l1 = ...; l2 = ... } is interpreted as { M.l1 = ...; M.l2 = ... }
+
+Both compilers:
+- More compact compilation of classes.
+- Much more efficient handling of class definitions inside functors
+  or local modules.
+- Simpler representation for method tables. Objects can now be marshaled
+  between identical programs with the flag Marshal.Closures.
+- Improved error messages for objects and variants.
+- Improved printing of inferred module signatures (toplevel and ocamlc -i).
+  Recursion between type, class, class type and module definitions is now
+  correctly printed.
+- The -pack option now accepts compiled interfaces (.cmi files) in addition
+  to compiled implementations (.cmo or .cmx).
+* A compile-time error is signaled if an integer literal exceeds the
+  range of representable integers.
+- Fixed code generation error for "module rec" definitions.
+- The combination of options -c -o sets the name of the generated
+  .cmi / .cmo / .cmx files.
+
+Bytecode compiler:
+- Option -output-obj is now compatible with Dynlink and
+  with embedded toplevels.
+
+Native-code compiler:
+- Division and modulus by zero correctly raise exception Division_by_zero
+  (instead of causing a hardware trap).
+- Improved compilation time for the register allocation phase.
+- The float constant -0.0 was incorrectly treated as +0.0 on some processors.
+- AMD64: fixed bugs in asm glue code for GC invocation and exception raising
+  from C.
+- IA64: fixed incorrect code generated for "expr mod 1".
+- PowerPC: minor performance tweaks for the G4 and G5 processors.
+
+Standard library:
+* Revised handling of NaN floats in polymorphic comparisons.
+  The polymorphic boolean-valued comparisons (=, <, >, etc) now treat
+  NaN as uncomparable, as specified by the IEEE standard.
+  The 3-valued comparison (compare) treats NaN as equal to itself
+  and smaller than all other floats.  As a consequence, x == y
+  no longer implies x = y but still implies compare x y = 0.
+* String-to-integer conversions now fail if the result overflows
+  the range of integers representable in the result type.
+* All array and string access functions now raise
+  Invalid_argument("index out of bounds") when a bounds check fails.
+  In earlier releases, different exceptions were raised
+  in bytecode and native-code.
+- Module Buffer: new functions Buffer.sub, Buffer.nth
+- Module Int32: new functions Int32.bits_of_float, Int32.float_of_bits.
+- Module Map: new functions is_empty, compare, equal.
+- Module Set: new function split.
+* Module Gc: in-order finalisation, new function finalise_release.
+
+Other libraries:
+- The Num library: complete reimplementation of the C/asm lowest
+  layer to work around potential licensing problems.
+  Improved speed on the PowerPC and AMD64 architectures.
+- The Graphics library: improved event handling under MS Windows.
+- The Str library: fixed bug in "split" functions with nullable regexps.
+- The Unix library:
+   . Added Unix.single_write.
+   . Added support for IPv6.
+   . Bug fixes in Unix.closedir.
+   . Allow thread switching on Unix.lockf.
+
+Runtime System:
+* Name space depollution: all global C identifiers are now prefixed
+  with "caml" to avoid name clashes with other libraries.  This
+  includes the "external" primitives of the standard runtime.
+
+Ports:
+- Windows ports: many improvements in the OCamlWin toplevel application
+  (history, save inputs to file, etc).  Contributed by Christopher A. Watford.
+- Native-code compilation supported for HPPA/Linux. Contributed by Guy Martin.
+- Removed support for MacOS9.  Mac OS 9 is obsolete and the port was not
+  updated since 3.05.
+- Removed ocamlopt support for HPPA/Nextstep and Power/AIX.
+
+Ocamllex:
+- #line directives in the input file are now accepted.
+- Added character set concatenation operator "cset1 # cset2".
+
+Ocamlyacc:
+- #line directives in the input file are now accepted.
+
+Camlp4:
+* Support for new-style locations (line numbers, not just character numbers).
+- See camlp4/CHANGES and camlp4/ICHANGES for more info.
+
+
+Objective Caml 3.07 (29 Sep 2003):
+----------------------------------
+
+Language features:
+- Experimental support for recursive module definitions
+      module rec A : SIGA = StructA and B : SIGB = StructB and ...
+- Support for "private types", or more exactly concrete data types
+  with private constructors or labels.  These data types can be
+  de-structured normally in pattern matchings, but values of these
+  types cannot be constructed directly outside of their defining module.
+- Added integer literals of types int32, nativeint, int64
+  (written with an 'l', 'n' or 'L' suffix respectively).
+
+Type-checking:
+- Allow polymorphic generalization of covariant parts of expansive
+  expressions.  For instance, if f: unit -> 'a list, "let x = f ()"
+  gives "x" the generalized type forall 'a. 'a list, instead of '_a list
+  as before.
+- The typing of polymorphic variants in pattern matching has changed.
+  It is intended to be more regular, sticking to the principle of "closing
+  only the variants which would be otherwise incomplete". Two potential
+  consequences: (1) some types may be left open which were closed before,
+  and the resulting type might not match the interface anymore (expected to
+  be rare); (2) in some cases an incomplete match may be generated.
+- Lots of bug fixes in the handling of polymorphism and recursion inside
+  types.
+- Added a new "-dtypes" option to ocamlc/ocamlopt, and an emacs extension
+  "emacs/caml-types.el".  The compiler option saves inferred type information
+  to file *.annot, and the emacs extension allows the user to look at the
+  type of any subexpression in the source file.  Works even in the case
+  of a type error (all the types computed up to the error are available).
+  This new feature is also supported by ocamlbrowser.
+- Disable "method is overridden" warning when the method was explicitly
+  redefined as virtual beforehand (i.e. not through inheritance). Typing
+  and semantics are unchanged.
+
+Both compilers:
+- Added option "-dtypes" to dump detailed type information to a file.
+- The "-i" option no longer generates compiled files, it only prints
+  the inferred types.
+- The sources for the module named "Mod" can be placed either in Mod.ml or
+  in mod.ml.
+- Compilation of "let rec" on non-functional values: tightened some checks,
+  relaxed some other checks.
+- Fixed wrong code that was generated for "for i = a to max_int"
+  or "for i = a downto min_int".
+- An explicit interface Mod.mli can now be provided for the module obtained
+  by ocamlc -pack -o Mod.cmo ... or ocamlopt -pack -o Mod.cmx ...
+- Revised internal handling of source code locations, now handles
+  preprocessed code better.
+- Pattern-matching bug on float literals fixed.
+- Minor improvements on pattern-matching over variants.
+- More efficient compilation of string comparisons and the "compare" function.
+- More compact code generated for arrays of constants.
+- Fixed GC bug with mutable record fields of type "exn".
+- Added warning "E" for "fragile patterns": pattern matchings that would
+  not be flagged as partial if new constructors were added to the data type.
+
+Bytecode compiler:
+- Added option -vmthread to select the threads library with VM-level
+  scheduling.  The -thread option now selects the system threads library.
+
+Native-code compiler:
+- New port: AMD64 (Opteron).
+- Fixed instruction selection bug on expressions of the kind (raise Exn)(arg).
+- Several bug fixes in ocamlopt -pack (tracking of imported modules,
+  command line too long).
+- Signal handling bug fixed.
+- x86 port:
+    Added -ffast-math option to use inline trigo and log functions.
+    Small performance tweaks for the Pentium 4.
+    Fixed illegal "imul" instruction generated by reloading phase.
+- Sparc port:
+    Enhanced code generation for Sparc V8 (option -march=v8) and
+    Sparc V9 (option -march=v9).
+    Profiling support added for Solaris.
+- PowerPC port:
+    Keep stack 16-aligned for compatibility with C calling conventions.
+
+Toplevel interactive system:
+- Tightened interface consistency checks between .cmi files, .cm[oa] files
+  loaded by #load, and the running toplevel.
+- #trace on mutually-recursive functions was broken, works again.
+- Look for .ocamlinit file in home directory in addition to the current dir.
+
+Standard library:
+- Match_failure and Assert_failure exceptions now report
+  (file, line, column), instead of (file, starting char, ending char).
+- float_of_string, int_of_string: some ill-formed input strings were not
+    rejected.
+- Added format concatenation, string_of_format, format_of_string.
+- Module Arg: added new option handlers Set_string, Set_int, Set_float,
+    Symbol, Tuple.
+- Module Format: tag handling is now turned off by default,
+    use [Format.set_tags true] to activate.
+- Modules Lexing and Parsing: added better handling of positions
+    in source file.  Added function Lexing.flush_input.
+- Module Scanf: %n and %N formats to count characters / items read so far;
+    assorted bug fixes, %! to match end of input. New ``_'' special
+    flag to skip reresulting value.
+- Module Format: tags are not activated by default.
+- Modules Set and Map: fixed bugs causing trees to become unbalanced.
+- Module Printf: less restrictive typing of kprintf.
+- Module Random: better seeding; functions to generate random int32, int64,
+    nativeint; added support for explicit state management.
+- Module Sys: added Sys.readdir for reading the contents of a directory.
+
+Runtime system:
+- output_value/input_value: fixed bug with large blocks (>= 4 Mwords)
+  produced on a 64-bit platform and incorrectly read back on a 32-bit
+  platform.
+- Fixed memory compaction bug involving input_value.
+- Added MacOS X support for dynamic linking of C libraries.
+- Improved stack backtraces on uncaught exceptions.
+- Fixed float alignment problem on Sparc V9 with gcc 3.2.
+
+Other libraries:
+- Dynlink:
+    By default, dynamically-loaded code now has access to all
+      modules defined by the program; new functions Dynlink.allow_only
+      and Dynlink.prohibit implement access control.
+    Fixed Dynlink problem with files generated with ocamlc -pack.
+    Protect against references to modules not yet fully initialized.
+- LablTK/CamlTK: added support for TCL/TK 8.4.
+- Str: reimplemented regexp matching engine, now less buggy, faster,
+    and LGPL instead of GPL.
+- Graphics: fixed draw_rect and fill_rect bug under X11.
+- System threads and bytecode threads libraries can be both installed.
+- System threads: better implementation of Thread.exit.
+- Bytecode threads: fixed two library initialization bugs.
+- Unix: make Unix.openfile blocking to account for named pipes;
+  GC bug in Unix.*stat fixed; fixed problem with Unix.dup2 on Windows.
+
+Ocamllex:
+- Can name parts of the matched input text, e.g.
+    "0" (['0'-'7']+ as s) { ... s ... }
+
+Ocamldebug:
+- Handle programs that run for more than 2^30 steps.
+
+Emacs mode:
+- Added file caml-types.el to interactively display the type information
+  saved by option -dtypes.
+
+Win32 ports:
+- Cygwin port: recognize \ as directory separator in addition to /
+- MSVC port: ocamlopt -pack works provided GNU binutils are installed.
+- Graphics library: fixed bug in Graphics.blit_image; improved event handling.
+
+OCamldoc:
+- new ty_code field for types, to keep code of a type (with option -keep-code)
+- new ex_code field for types, to keep code of an exception
+    (with option -keep-code)
+- some fixes in html generation
+- don't overwrite existing style.css file when generating HTML
+- create the ocamldoc.sty file when generating LaTeX (if nonexistent)
+- man pages are now installed in man/man3 rather than man/mano
+- fix: empty [] in generated HTML indexes
+
+
+Objective Caml 3.06 (20 Aug 2002):
+----------------------------------
+
+Type-checking:
+- Apply value restriction to polymorphic record fields.
+
+Run-time system:
+- Fixed GC bug affecting lazy values.
+
+Both compilers:
+- Added option "-version" to print just the version number.
+- Fixed wrong dependencies in .cmi generated with the -pack option.
+
+Native-code compiler:
+- Fixed wrong return value for inline bigarray assignments.
+
+Libraries:
+- Unix.getsockopt: make sure result is a valid boolean.
+
+Tools:
+- ocamlbrowser: improved error reporting; small Win32 fixes.
+
+Windows ports:
+- Fixed two problems with the Mingw port under Cygwin 1.3.
+
+
+Objective Caml 3.05 (29 Jul 2002):
+----------------------------------
+
+Language features:
+- Support for polymorphic methods and record fields.
+- Allows _ separators in integer and float literals, e.g. 1_000_000.
+
+Type-checker:
+- New flag -principal to enforce principality of type inference.
+- Fixed subtle typing bug with higher-order functors.
+- Fixed several complexity problems; changed (again) the  behaviour of
+  simple coercions.
+- Fixed various bugs with objects and polymorphic variants.
+- Improved some error messages.
+
+Both compilers:
+- Added option "-pack" to assemble several compilation units as one unit
+  having the given units as sub-modules.
+- More precise detection of unused sub-patterns in "or" patterns.
+- Warnings for ill-formed \ escapes in string and character literals.
+- Protect against spaces and other special characters in directory names.
+- Added interface consistency check when building a .cma or .cmxa library.
+- Minor reduction in code size for class initialization code.
+- Added option "-nostdlib" to ignore standard library entirely.
+
+Bytecode compiler:
+- Fixed issue with ocamlc.opt and dynamic linking.
+
+Native-code compiler:
+- Added link-time check for multiply-defined module names.
+- Fixed GC bug related to constant constructors of polymorphic variant types.
+- Fixed compilation bug for top-level "include" statements.
+- PowerPC port: work around limited range for relative branches,
+  thus removing assembler failures on large functions.
+- IA64 port: fixed code generation bug for 3-way constructor matching.
+
+Toplevel interactive system:
+- Can load object files given on command line before starting up.
+- ocamlmktop: minimized possibility of name clashes with user-provided modules.
+
+Run-time system:
+- Minor garbage collector no longer recursive.
+- Better support for lazy data in the garbage collector.
+- Fixed issues with the heap compactor.
+- Fixed issues with finalized Caml values.
+- The type "int64" is now supported on all platforms: we use software
+  emulation if the C compiler doesn't support 64-bit integers.
+- Support for float formats that are neither big-endian nor little-endian
+  (one known example: the ARM).
+- Fixed bug in callback*_exn functions in the exception-catching case.
+- Work around gcc 2.96 bug on RedHat 7.2 and Mandrake 8.0, 8.1 among others.
+- Stub DLLs now installed in subdir stublibs/ of standard library dir.
+
+Standard library:
+- Protect against integer overflow in sub-string and sub-array bound checks.
+- New module Complex implementing arithmetic over complex numbers.
+- New module Scanf implementing format-based scanning a la scanf() in C.
+- Module Arg: added alternate entry point Arg.parse_argv.
+- Modules Char, Int32, Int64, Nativeint, String: added type "t" and function
+  "compare" so that these modules can be used directly with e.g. Set.Make.
+- Module Digest: fixed issue with Digest.file on large files (>= 1Gb);
+    added Digest.to_hex.
+- Module Filename: added Filename.open_temp_file to atomically create and
+    open the temp file; improved security of Filename.temp_file.
+- Module Genlex: allow _ as first character of an identifier.
+- Module Lazy: more efficient implementation.
+- Module Lexing: improved performances for very large tokens.
+- Module List: faster implementation of sorting functions.
+- Module Printf:
+    added %S and %C formats (quoted, escaped strings and characters);
+    added kprintf (calls user-specified continuation on formatted string).
+- Module Queue: faster implementation (courtesy of François Pottier).
+- Module Random: added Random.bool.
+- Module Stack: added Stack.is_empty.
+- Module Pervasives:
+    added sub-module LargeFile to support files larger than 1Gb
+      (file offsets are int64 rather than int);
+    opening in "append" mode automatically sets "write" mode;
+    files are now opened in close-on-exec mode;
+    string_of_float distinguishes its output from a plain integer;
+    faster implementation of input_line for long lines.
+- Module Sys:
+     added Sys.ocaml_version containing the OCaml version number;
+     added Sys.executable_name containing the (exact) path of the
+       file being executable;
+     Sys.argv.(0) is now unchanged w.r.t. what was provided as 0-th argument
+       by the shell.
+- Module Weak: added weak hash tables.
+
+Other libraries:
+- Bigarray:
+    support for bigarrays of complex numbers;
+    added functions Genarray.dims,
+      {Genarray,Array1,Array2,Array3}.{kind,layout}.
+- Dynlink: fixed bug with loading of mixed-mode Caml/C libraries.
+- LablTK:
+    now supports also the CamlTK API (no labels);
+    support for Activate and Deactivate events;
+    support for virtual events;
+    added UTF conversion;
+    export the tcl interpreter as caml value, to avoid DLL dependencies.
+- Unix:
+    added sub-module LargeFile to support files larger than 1Gb
+      (file offsets are int64 rather than int);
+    added POSIX opening flags (O_NOCTTY, O_*SYNC);
+    use reentrant functions for gethostbyname and gethostbyaddr when available;
+    fixed bug in Unix.close_process and Unix.close_process_full;
+    removed some overhead in Unix.select.
+
+Tools:
+- ocamldoc (the documentation generator) is now part of the distribution.
+- Debugger: now supports the option -I +dir.
+- ocamllex: supports the same identifiers as ocamlc; warns for
+  bad \ escapes in strings and characters.
+- ocamlbrowser:
+    recenter the module boxes when showing a cross-reference;
+    include the current directory in the ocaml path.
+
+Windows port:
+- Can now compile with Mingw (the GNU compilers without the Cygwin
+  runtime library) in addition to MSVC.
+- Toplevel GUI: wrong filenames were given to #use and #load commands;
+  read_line() was buggy for short lines (2 characters or less).
+- OCamlBrowser: now fully functional.
+- Graphics library: fixed several bugs in event handling.
+- Threads library: fixed preemption bug.
+- Unix library: better handling of the underlying differences between
+  sockets and regular file descriptors;
+  added Unix.lockf and a better Unix.rename (thanks to Tracy Camp).
+- LablTk library: fixed a bug in Fileinput
+
+
+Objective Caml 3.04 (13 Dec 2001):
+----------------------------------
+
+Type-checker:
+- Allowed coercing self to the type of the current class, avoiding
+  an obscure error message about "Self type cannot be unified..."
+
+Both compilers:
+- Use OCAMLLIB environment variable to find standard library, falls
+  back on CAMLLIB if not defined.
+- Report out-of-range ASCII escapes in character or string literals
+  such as "\256".
+
+Byte-code compiler:
+- The -use-runtime and -make-runtime flags are back by popular demand
+  (same behavior as in 3.02).
+- Dynamic loading (of the C part of mixed Caml/C libraries): arrange that
+  linking in -custom mode uses the static libraries for the C parts,
+  not the shared libraries, for maximal robustness and compatibility with
+  3.02.
+
+Native-code compiler:
+- Fixed bug in link-time consistency checking.
+
+Tools:
+- ocamlyacc: added parser debugging support (set OCAMLRUNPARAM=p to get
+  a trace of the pushdown automaton actions).
+- ocamlcp: was broken in 3.03 (Sys_error), fixed.
+
+Run-time system:
+- More work on dynamic loading of the C part of mixed Caml/C libraries.
+- On uncaught exception, flush output channels before printing exception
+  message and backtrace.
+- Corrected several errors in exception backtraces.
+
+Standard library:
+- Pervasives: integer division and modulus are now fully specified
+  on negative arguments (with round-towards-zero semantics).
+- Pervasives.float_of_string: now raises Failure on ill-formed input.
+- Pervasives: added useful float constants max_float, min_float, epsilon_float.
+- printf functions in Printf and Format: added % formats for int32, nativeint,
+  int64; "*" in width and precision specifications now supported
+  (contributed by Thorsten Ohl).
+- Added Hashtbl.copy, Stack.copy.
+- Hashtbl: revised resizing strategy to avoid quadratic behavior
+  on Hashtbl.add.
+- New module MoreLabels providing labelized versions of modules
+  Hashtbl, Map and Set.
+- Pervasives.output_value and Marshal.to_* : improved hashing strategy
+  for internal data structures, avoid excessive slowness on
+  quasi-linearly-allocated inputs.
+
+Other libraries:
+- Num: fixed bug in big integer exponentiation (Big_int.power_*).
+
+Windows port:
+- New GUI for interactive toplevel (Jacob Navia).
+- The Graphics library is now available for stand-alone executables
+  (Jacob Navia).
+- Unix library: improved reporting of system error codes.
+- Fixed error in "globbing" of * and ? patterns on command line.
+
+Emacs mode: small fixes; special color highlighting for ocamldoc comments.
+
+License: added special exception to the LGPL'ed code (libraries and
+  runtime system) allowing unrestricted linking, whether static or dynamic.
+
+
+Objective Caml 3.03 ALPHA (12 Oct 2001):
+----------------------------------------
+
+Language:
+- Removed built-in syntactic sugar for streams and stream patterns
+  [< ... >], now supported via CamlP4, which is now included in the
+  distribution.
+- Switched the default behaviour to labels mode (labels are compulsory),
+  but allows omitting labels when a function application is complete.
+  -nolabels mode is available but deprecated for programming.
+  (See also scrapelabels and addlabels tools below.)
+- Removed all labels in the standard libraries, except labltk.
+  Labelized versions are kept for ArrayLabels, ListLabels, StringLabels
+  and UnixLabels. "open StdLabels" gives access to the first three.
+- Extended polymorphic variant type syntax, allowing union types and
+  row abbreviations for both sub- and super-types. #t deprecated in types.
+- See the Upgrading file for how to adapt to all the changes above.
+
+Type-checker:
+- Fixed obscure bug in module typing causing the type-checker to loop
+  on signatures of the form
+        module type M
+        module A: sig module type T = sig module T: M end end
+        module B: A.T
+- Improved efficiency of module type-checking via lazy computation of
+  certain signature summary information.
+- An empty polymorphic variant type is now an error.
+
+Both compilers:
+- Fixed wrong code generated for "struct include M ... end" when M
+  contains one or several "external" declarations.
+
+Byte-code compiler:
+- Protect against VM stack overflow caused by module initialization code
+  with many local variables.
+- Support for dynamic loading of the C part of mixed Caml/C libraries.
+- Removed the -use-runtime and -make-runtime flags, obsoleted by dynamic
+  loading of C libraries.
+
+Native-code compiler:
+- Attempt to recover gracefully from system stack overflow.  Currently
+  works on x86 under Linux and BSD.
+- Alpha: work around "as" bug in Tru64 5.1.
+
+Toplevel environment:
+- Revised printing of inferred types and evaluation results
+  so that an external printer (e.g. Camlp4's) can be hooked in.
+
+Tools:
+- The CamlP4 pre-processor-pretty-printer is now included in the standard
+  distribution.
+- New tool ocamlmklib to help build mixed Caml/C libraries.
+- New tool scrapelabels and addlabels, to either remove (non-optional)
+  labels in interfaces, or automatically add them in the definitions.
+  They provide easy transition from classic mode ocaml 3.02 sources,
+  depending on whether you want to keep labels or not.
+- ocamldep: added -pp option to handle preprocessed source files.
+
+Run-time system:
+- Support for dynamic loading of the C part of mixed Caml/C libraries.
+  Currently works under Linux, FreeBSD, Windows, Tru64, Solaris and Irix.
+- Implemented registration of global C roots with a skip list,
+  runs much faster when there are many global C roots.
+- Autoconfiguration script: fixed wrong detection of Mac OS X; problem
+  with the Sparc, gcc 3.0, and float alignment fixed.
+
+Standard library:
+- Added Pervasives.flush_all to flush all opened output channels.
+
+Other libraries:
+- All libraries revised to allow dynamic loading of the C part.
+- Graphics under X Windows: revised event handling, should no longer lose
+    mouse events between two calls to wait_next_event(); wait_next_event()
+    now interruptible by signals.
+- Bigarrays: fixed bug in marshaling of big arrays.
+
+Windows port:
+- Fixed broken Unix.{get,set}sockopt*
+
+
+
+Objective Caml 3.02 (30 Jul 2001):
+----------------------------------
+
+Both compilers:
+- Fixed embarrassing bug in pattern-matching compilation
+  (affected or-patterns containing variable bindings).
+- More optimizations in pattern-matching compilation.
+
+Byte-code compiler:
+- Protect against VM stack overflow caused by functions with many local
+  variables.
+
+Native-code compiler:
+- Removed re-sharing of string literals, causes too many surprises with
+  in-place string modifications.
+- Corrected wrong compilation of toplevel "include" statements.
+- Fixed bug in runtime function "callbackN_exn".
+- Signal handlers receive the conventional signal number as argument
+  instead of the system signal number (same behavior as with the
+  bytecode compiler).
+- ARM port: fixed issue with immediate operand overflow in large functions.
+
+Toplevel environment:
+- User-definer printers (for #install_printer) now receive as first argument
+  the pretty-printer formatter where to print their second argument.
+  Old printers (with only one argument) still supported for backward
+  compatibility.
+
+Standard library:
+- Module Hashtbl: added Hashtbl.fold.
+
+Other libraries:
+- Dynlink: better error reporting in add_interfaces for missing .cmi files.
+- Graphics: added more drawing functions (multiple points, polygons,
+    multiple lines, splines).
+- Bytecode threads: the module Unix is now thread-safe, ThreadUnix is
+    deprecated.  Unix.exec* now resets standard descriptors to blocking mode.
+- Native threads: fixed a context-switch-during-GC problem causing
+    certain C runtime functions to fail, most notably input_value.
+- Unix.inet_addr_of_string: call inet_aton() when available so as to
+    handle correctly the address 255.255.255.255.
+- Unix: added more getsockopt and setsockopt functions to get/set
+    options that have values other than booleans.
+- Num: added documentation for the Big_int module.
+
+Tools:
+- ocamldep: fixed wrong dependency issue with nested modules.
+
+Run-time system:
+- Removed floating-point error at start-up on some non-IEEE platforms
+  (e.g. FreeBSD prior to 4.0R).
+- Stack backtrace mechanism now works for threads that terminate on
+  an uncaught exception.
+
+Auto-configuration:
+- Updated config.guess and config.sub scripts, should recognize a greater
+  number of recent platform.
+
+Windows port:
+- Fixed broken Unix.waitpid.  Unix.file_descr can now be compared or hashed.
+- Toplevel application: issue with spaces in name of stdlib directory fixed.
+
+MacOS 9 port:
+- Removed the last traces of support for 68k
+
+
+Objective Caml 3.01 (09 Mar 2001):
+----------------------------------
+
+New language features:
+- Variables are allowed in "or" patterns, e.g.
+     match l with [t] | [_;t] -> ... t ...
+- "include " to re-export all components of a
+  structure inside another structure.
+- Variance annotation on parameters of type declarations, e.g.
+    type (+'a,-'b,'c) t (covariant in 'a, contravariant in 'b, invariant in 'c)
+
+New ports:
+- Intel IA64/Itanium under Linux (including the native-code compiler).
+- Cygwin under MS Windows.  This port is an alternative to the earlier
+  Windows port of OCaml, which relied on MS compilers; the Cygwin
+  Windows port does not need MS Visual C++ nor MASM, runs faster
+  in bytecode, and has a better implementation of the Unix library,
+  but currently lacks threads and COM component support.
+
+Type-checking:
+- Relaxed "monomorphic restriction" on type constructors in a
+  mutually-recursive type definition, e.g. the following is again allowed
+    type u = C of int t | D of string t and 'a t = ...
+- Fixed name-capture bug in "include SIG" and "SIG with ..." constructs.
+- Improved implicit subtypes built by (... :> ty), closer to intuition.
+- Several bug fixes in type-checking of variants.
+- Typing of polymorphic variants is more restrictive:
+   do not allow conjunctive types inside the same pattern matching.
+   a type has either an upper bound, or all its tags are in the lower bound.
+  This may break some programs (this breaks lablgl-0.94).
+
+Both compilers:
+- Revised compilation of pattern matching.
+- Option -I + to search a subdirectory  of the standard
+  library directory (i.e. write "ocamlc -I +labltk" instead of
+  "ocamlc -I /usr/local/lib/ocaml/labltk").
+- Option -warn-error to turn warnings into errors.
+- Option -where to print the location of the standard library directory.
+- Assertions are now type-checked even if the -noassert option is given,
+  thus -noassert can no longer change the types of modules.
+
+Bytecode compiler and bytecode interpreter:
+- Print stack backtrace when a program aborts due to an uncaught exception
+  (requires compilation with -g and running with ocamlrun -b or
+   OCAMLRUNPARAM="b=1").
+
+Native-code compiler:
+- Better unboxing optimizations on the int32, int64, and nativeint types.
+- Tail recursion preserved for functions having more parameters than
+  available registers (but tail calls to other functions are still
+  turned off if parameters do not fit entirely in registers).
+- Fixed name-capture bug in function inlining.
+- Improved spilling/reloading strategy for conditionals.
+- IA32, Alpha: better alignment of branch targets.
+- Removed spurious dependency on the -lcurses library.
+
+Toplevel environment:
+- Revised handling of top-level value definitions, allows reclamation
+  of definitions that are shadowed by later definitions with the same names.
+  (E.g. "let x = ;; let x = 1;;" allows  to be reclaimed.)
+- Revised the tracing facility so that for standard library functions,
+  only calls from user code are traced, not calls from the system.
+- Added a "*" prompt when within a comment.
+
+Runtime system:
+- Fixed portability issue on bcopy() vs memmove(), affecting Linux RedHat 7.0
+  in particular.
+- Structural comparisons (=, <>, <, <=, >, >=, compare) reimplemented
+  so as to avoid overflowing the C stack.
+- Input/output functions: arrange so that reads and writes on closed
+  in_channel or out_channel raise Sys_error immediately.
+
+Standard library:
+- Module Gc: changed some counters to float in order to avoid overflow;
+    added alarms
+- Module Hashtbl: added Hashtbl.replace.
+- Module Int64: added bits_of_float, float_of_bits (access to IEEE 754
+    representation of floats).
+- Module List:  List.partition now tail-rec;
+    improved memory behavior of List.stable_sort.
+- Module Nativeint: added Nativeint.size (number of bits in a nativeint).
+- Module Obj: fixed incorrect resizing of float arrays in Obj.resize.
+- Module Pervasives: added float constants "infinity", "neg_infinity", "nan";
+    added a "classify_float" function to test a float for NaN, infinity, etc.
+- Pervasives.input_value: fixed bug affecting shared custom objects.
+- Pervasives.output_value: fixed size bug affecting "int64" values.
+- Pervasives.int_of_string, {Int32,Int64,Nativeint}.of_string:
+  fixed bug causing bad digits to be accepted without error.
+- Module Random: added get_state and set_state to checkpoint the generator.
+- Module Sys: signal handling functions are passed the system-independent
+  signal number rather than the raw system signal number whenever possible.
+- Module Weak: added Weak.get_copy.
+
+Other libraries:
+- Bigarray: added Bigarray.reshape to take a view of the elements of a
+  bigarray with different dimensions or number of dimensions;
+  fixed bug causing "get" operations to be unavailable in custom
+  toplevels including Bigarray.
+- Dynlink: raise an error instead of crashing when the loaded module
+  refers to the not-yet-initialized module performing a dynlink operation.
+- Bytecode threads: added a thread-safe version of the Marshal module;
+    fixed a rare GC bug in the thread scheduler.
+- POSIX threads: fixed compilation problem with threads.cmxa.
+- Both thread libraries: better tail-recursion in Event.sync.
+- Num library: fixed bug in square roots (Nat.sqrt_nat, Big_int.sqrt_big_int).
+
+Tools:
+- ocamldep: fixed missing dependencies on labels of record patterns and
+    record construction operations
+
+Win32 port:
+- Unix.waitpid now implements the WNOHANG option.
+
+Mac OS ports:
+- Mac OS X public beta is supported.
+- Int64.format works on Mac OS 8/9.
+
+
+Objective Caml 3.00 (25 Apr 2000):
+----------------------------------
+
+Language:
+- OCaml/OLabl merger:
+  * Support for labeled and optional arguments for functions and classes.
+  * Support for variant types (sum types compared by structure).
+  See tutorial (chapter 2 of the OCaml manual) for more information.
+- Syntactic change: "?" in stream error handlers changed to "??".
+- Added exception renaming in structures (exception E = F).
+- (OCaml 2.99/OLabl users only) Label syntax changed to preserve
+  backward compatibility with 2.0x (labeled function application
+  is f ~lbl:arg instead of f lbl:arg).  A tool is provided to help
+  convert labelized programs to OCaml 3.00.
+
+Both compilers:
+- Option -labels to select commuting label mode (labels are mandatory,
+  but labeled arguments can be passed in a different order than in
+  the definition of the function; in default mode, labels may be omitted,
+  but argument reordering is only allowed for optional arguments).
+- Libraries (.cma and .cmxa files) now "remember" C libraries given
+  at library construction time, and add them back at link time.
+  Allows linking with e.g. just unix.cma instead of
+  unix.cma -custom -cclib -lunix
+- Revised printing of error messages, now use Format.fprintf; no visible
+  difference for users, but could facilitate internationalization later.
+- Fixed bug in unboxing of records containing only floats.
+- Fixed typing bug involving applicative functors as components of modules.
+- Better error message for inconsistencies between compiled interfaces.
+
+Bytecode compiler:
+- New "modular" format for bytecode executables; no visible differences
+  for users, but will facilitate further extensions later.
+- Fixed problems in signal handling.
+
+Native-code compiler:
+- Profiling support on x86 under FreeBSD
+- Open-coding and unboxing optimizations for the new integer types
+  int32, int64, nativeint, and for bigarrays.
+- Fixed instruction selection bug with "raise" appearing in arguments
+  of strict operators, e.g. "1 + raise E".
+- Better error message when linking incomplete/incorrectly ordered set
+  of .cmx files.
+- Optimized scanning of global roots during GC, can reduce total running
+  time by up to 8% on GC-intensive programs.
+
+Interactive toplevel:
+- Better printing of exceptions, including arguments, when possible.
+- Fixed rare GC bug occurring during interpretation of scripts.
+- Added consistency checks between interfaces and implementations
+  during #load.
+
+Run-time system:
+- Added support for "custom" heap blocks (heap blocks carrying
+  C functions for finalization, comparison, hashing, serialization
+  and deserialization).
+- Support for finalisation functions written in Caml.
+
+Standard library:
+- New modules Int32, Int64, Nativeint for 32-bit, 64-bit and
+  platform-native integers
+- Module Array: added Array.sort, Array.stable_sort.
+- Module Gc: added Gc.finalise to attach Caml finalisation functions to
+  arbitrary heap-allocated data.
+- Module Hashtbl: do not bomb when resizing very large table.
+- Module Lazy: raise Lazy.Undefined when a lazy evaluation needs itself.
+- Module List: added List.sort, List.stable_sort; fixed bug in List.rev_map2.
+- Module Map: added mapi (iteration with key and data).
+- Module Set: added iterators for_all, exists, filter, partition.
+- Module Sort: still here but deprecated in favor of new sorting functions
+  in Array and List.
+- Module Stack: added Stack.top
+- Module String: fixed boundary condition on String.rindex_from
+- Added labels on function arguments where appropriate.
+
+New libraries and tools:
+- ocamlbrowser: graphical browser for OCaml sources and compiled interfaces,
+  supports cross-referencing, editing, running the toplevel.
+- LablTK: GUI toolkit based on TK, using labeled and optional arguments,
+  easier to use than CamlTK.
+- Bigarray: large, multi-dimensional numerical arrays, facilitate
+  interfacing with C/Fortran numerical code, efficient support for
+  advanced array operations such as slicing and memory-mapping of files.
+
+Other libraries:
+- Bytecode threads: timer-based preemption was broken, works back again;
+  fixed bug in Pervasives.input_line; exported Thread.yield.
+- System threads: several GC / reentrancy bugs fixed in buffered I/O
+  and Unix I/O; revised Thread.join implementation for strict POSIX
+  conformance; exported Thread.yield.
+- Graphics: added support for double buffering; added, current_x, current_y,
+  rmoveto, rlineto, and draw_rect.
+- Num: fixed bug in Num.float_of_num.
+- Str: worked around potential symbol conflicts with C standard library.
+- Dbm: fixed bug with Dbm.iter on empty database.
+
+New or updated ports:
+- Alpha/Digital Unix: lifted 256M limitation on total memory space
+  induced by -taso
+- Port to AIX 4.3 on PowerPC
+- Port to HPUX 10 on HPPA
+- Deprecated 680x0 / SunOS port
+
+Macintosh port:
+- Implemented the Unix and Thread libraries.
+- The toplevel application does not work on 68k Macintoshes; maybe
+  later if there's a demand.
+- Added a new tool, ocamlmkappli, to build an application from a
+  program written in O'Caml.
+
+
+Objective Caml 2.04 (26 Nov 1999):
+----------------------------------
+
+- C interface: corrected inconsistent change in the CAMLparam* macros.
+- Fixed internal error in ocamlc -g.
+- Fixed type-checking of "S with ...", where S is a module type name
+  abbreviating another module type name.
+- ocamldep: fixed stdout/stderr mismatch after failing on one file.
+- Random.self_init more random.
+- Windows port:
+  - Toplevel application: fixed spurious crash on exit.
+  - Native-code compiler: fixed bug in assembling certain
+    floating-point constants (masm doesn't grok 2e5, wants 2.0e5).
+
+Objective Caml 2.03 (19 Nov 1999):
+----------------------------------
+
+New ports:
+- Ported to BeOS / Intel x86 (bytecode and native-code).
+- BSD / Intel x86 port now supports both a.out and ELF binary formats.
+- Added support for {Net,Open}BSD / Alpha.
+- Revamped Rhapsody port, now works on MacOS X server.
+
+Syntax:
+- Warning for "(*)" and "*)" outside comment.
+- Removed "#line LINENO", too ambiguous with a method invocation;
+  the equivalent "# LINENO" is still supported.
+
+Typing:
+- When an incomplete pattern-matching is detected, report also a
+  value or value template that is not covered by the cases of
+  the pattern-matching.
+- Several bugs in class type matching and in type error reporting fixed.
+- Added an option -rectypes to support general recursive types,
+  not just those involving object types.
+
+Bytecode compiler:
+- Minor cleanups in the bytecode emitter.
+- Do not remove "let x = y" bindings in -g mode; makes it easier to
+  debug the code.
+
+Native-code compiler:
+- Fixed bug in grouping of allocations performed in the same basic block.
+- Fixed bug in constant propagation involving expressions containing
+  side-effects.
+- Fixed incorrect code generation for "for" loops whose upper bound is
+  a reference assigned inside the loop.
+- MIPS code generator: work around a bug in the IRIX 6 assembler.
+
+Toplevel:
+- Fixed incorrect redirection of standard formatter to stderr
+  while executing toplevel scripts.
+
+Standard library:
+- Added List.rev_map, List.rev_map2.
+- Documentation of List functions now says which functions are
+  tail-rec, and how much stack space is needed for non-tailrec functions.
+- Wrong type for Printf.bprintf fixed.
+- Fixed weird behavior of Printf.sprintf and Printf.bprintf in case of
+  partial applications.
+- Added Random.self_init, which initializes the PRNG from the system date.
+- Sort.array: serious bugs fixed.
+- Stream.count: fixed incorrect behavior with ocamlopt.
+
+Run-time system and external interface:
+- Fixed weird behavior of signal handlers w.r.t. signal masks and exceptions
+  raised from the signal handler.
+- Fixed bug in the callback*_exn() functions.
+
+Debugger:
+- Fixed wrong printing of float record fields and elements of float arrays.
+- Supports identifiers starting with '_'.
+
+Profiler:
+- Handles .mli files, so ocamlcp can be used to replace ocamlc (e.g. in a
+  makefile).
+- Now works on programs that use stream expressions and stream parsers.
+
+Other libraries:
+- Graphics: under X11, treat all mouse buttons equally; fixed problem
+  with current font reverting to the default font when the graphics
+  window is resized.
+- Str: fixed reentrancy bugs in Str.replace and Str.full_split.
+- Bytecode threads: set standard I/O descriptors to non-blocking mode.
+- OS threads: revised implementation of Thread.wait_signal.
+- All threads: added Event.wrap_abort, Event.choose [].
+- Unix.localtime, Unix.gmtime: check for errors.
+- Unix.create_process: now supports arbitrary redirections of std descriptors.
+- Added Unix.open_process_full.
+- Implemented Unix.chmod under Windows.
+- Big_int.square_big_int now gives the proper sign to its result.
+
+Others:
+- ocamldep: don't stop at first error, skip to next file.
+- Emacs mode: updated with Garrigue and Zimmerman's snapshot of 1999/10/18.
+- configure script: added -prefix option.
+- Windows toplevel application: fixed problem with graphics library
+  not loading properly.
+
+
+Objective Caml 2.02 (04 Mar 1999):
+----------------------------------
+
+* Type system:
+  - Check that all components of a signature have unique names.
+  - Fixed bug in signature matching involving a type component and
+    a module component, both sharing an abstract type.
+  - Bug involving recursive classes constrained by a class type fixed.
+  - Fixed bugs in printing class types and in printing unification errors.
+
+* Compilation:
+  - Changed compilation scheme for "{r with lbl = e}" when r has many fields
+    so as to avoid code size explosion.
+
+* Native-code compiler:
+  - Better constant propagation in boolean expressions and in conditionals.
+  - Removal of unused arguments during function inlining.
+  - Eliminated redundant tagging/untagging in bit shifts.
+  - Static allocation of closures for functions without free variables,
+    reduces the size of initialization code.
+  - Revised compilation scheme for definitions at top level of compilation
+    units, so that top level functions have no free variables.
+  - Coalesced multiple allocations of heap blocks inside one expression
+    (e.g. x :: y :: z allocates the two conses in one step).
+  - Ix86: better handling of large integer constants in instruction selection.
+  - MIPS: fixed wrong asm generated for String.length "literal".
+
+* Standard library:
+  - Added the "ignore" primitive function, which just throws away its
+    argument and returns "()".  It allows to write
+    "ignore(f x); y" if "f x" doesn't have type unit and you don't
+    want the warning caused by "f x; y".
+  - Added the "Buffer" module (extensible string buffers).
+  - Module Format: added formatting to buffers and to strings.
+  - Added "mem" functions (membership test) to Hashtbl and Map.
+  - Module List: added find, filter, partition.
+    Renamed remove and removeq to remove_assoc and remove_assq.
+  - Module Marshal: fixed bug in marshaling functions when passed functional
+    values defined by mutual recursion with other functions.
+  - Module Printf: added Printf.bprintf (print to extensible buffer);
+    added %i format as synonymous for %d (as per the docs).
+  - Module Sort: added Sort.array (Quicksort).
+
+* Runtime system:
+  - New callback functions for callbacks with arbitrary many arguments
+    and for catching Caml exceptions escaping from a callback.
+
+* The ocamldep dependency generator: now performs full parsing of the
+    sources, taking into account the scope of module bindings.
+
+* The ocamlyacc parser generator: fixed sentinel error causing wrong
+    tables to be generated in some cases.
+
+* The str library:
+  - Added split_delim, full_split as variants of split that control
+    more precisely what happens to delimiters.
+  - Added replace_matched for separate matching and replacement operations.
+
+* The graphics library:
+  - Bypass color lookup for 16 bpp and 32 bpp direct-color displays.
+  - Larger color cache.
+
+* The thread library:
+  - Bytecode threads: more clever use of non-blocking I/O, makes I/O
+    operations faster.
+  - POSIX threads: gcc-ism removed, should now compile on any ANSI C compiler.
+  - Both: avoid memory leak in the Event module when a communication
+    offer is never selected.
+
+* The Unix library:
+  - Fixed inversion of ctime and mtime in Unix.stat, Unix.fstat, Unix.lstat.
+  - Unix.establish_connection: properly reclaim socket if connect fails.
+
+* The DBM library: no longer crashes when calling Dbm.close twice.
+
+* Emacs mode:
+  - Updated with Garrigue and Zimmerman's latest version.
+  - Now include an "ocamltags" script for using etags on OCaml sources.
+
+* Win32 port:
+  - Fixed end-of-line bug in ocamlcp causing problems with generated sources.
+
+
+Objective Caml 2.01 (09 Dec 1998):
+----------------------------------
+
+* Typing:
+  - Added warning for expressions of the form "a; b" where a does not have
+    type "unit"; catches silly mistake such as
+    "record.lbl = newval; ..." instead of "record.lbl <- newval; ...".
+  - Typing bug in "let module" fixed.
+
+* Compilation:
+  - Fixed bug in compilation of recursive and mutually recursive classes.
+  - Option -w to turn specific warnings on/off.
+  - Option -cc to choose the C compiler used with ocamlc -custom and ocamlopt.
+
+* Bytecode compiler and bytecode interpreter:
+  - Intel x86: removed asm declaration causing "fixed or forbidden register
+    spilled" error with egcs and gcc 2.8 (but not with gcc 2.7, go figure).
+  - Revised handling of debugging information, allows faster linking with -g.
+
+* Native-code compiler:
+  - Fixed bugs in integer constant propagation.
+  - Out-of-bound accesses in array and strings now raise an Invalid_argument
+    exception (like the bytecode system) instead of stopping the program.
+  - Corrected scheduling of bound checks.
+  - Port to the StrongARM under Linux (e.g. Corel Netwinder).
+  - I386: fixed bug in profiled code (ocamlopt -p).
+  - Mips: switched to -n32 model under IRIX; dropped the Ultrix port.
+  - Sparc: simplified the addressing modes, allows for better scheduling.
+  - Fixed calling convention bug for Pervasives.modf.
+
+* Toplevel:
+  - #trace works again.
+  - ocamlmktop: use matching ocamlc, not any ocamlc from the search path.
+
+* Memory management:
+  - Fixed bug in heap expansion that could cause the GC to loop.
+
+* C interface:
+  - New macros CAMLparam... and CAMLlocal... to simplify the handling
+    of local roots in C code.
+  - Simplified procedure for allocating and filling Caml blocks from C.
+  - Declaration of string_length in .
+
+* Standard library:
+  - Module Format: added {get,set}_all_formatter_output_functions,
+    formatter_of_out_channel, and the control sequence @ in printf.
+  - Module List: added mem_assoc, mem_assq, remove, removeq.
+  - Module Pervasives: added float_of_int (synonymous for float),
+    int_of_float (truncate), int_of_char (Char.code), char_of_int (Char.chr),
+    bool_of_string.
+  - Module String: added contains, contains_from, rcontains_from.
+
+* Unix library:
+  - Unix.lockf: added F_RLOCK, F_TRLOCK; use POSIX locks whenever available.
+  - Unix.tc{get,set}attr: added non-standard speeds 57600, 115200, 230400.
+  - Unix.chroot: added.
+
+* Threads:
+  - Bytecode threads: improved speed of I/O scheduling.
+  - Native threads: fixed a bug involving signals and exceptions
+    generated from C.
+
+* The "str" library:
+  - Added Str.string_partial_match.
+  - Bumped size of internal stack.
+
+* ocamlyacc: emit correct '# lineno' directive for prelude part of .mly file.
+
+* Emacs editing mode: updated with Jacques Garrigue's newest code.
+
+* Windows port:
+  - Added support for the "-cclib -lfoo" option (instead of
+     -cclib /full/path/libfoo.lib as before).
+  - Threads: fixed a bug at initialization time.
+
+* Macintosh port: source code for Macintosh application merged in.
+
+
+Objective Caml 2.00 (19 Aug 1998):
+----------------------------------
+
+* Language:
+  - New class language.  See http://caml.inria.fr/ocaml/refman/
+    for a tutorial (chapter 2) and for the reference manual (section 4.9).
+  - Local module definitions "let module X =  in ".
+  - Record copying with update "{r with lbl1 = expr1; ...}".
+  - Array patterns "[|pat1; ...;patN|]" in pattern-matchings.
+  - New reserved keywords: "object", "initializer".
+  - No longer reserved: "closed", "protected".
+
+* Bytecode compiler:
+  - Use the same compact memory representations for float arrays, float
+    records and recursive closures as the native-code compiler.
+  - More type-dependent optimizations.
+  - Added the -use_runtime and -make_runtime flags to build separately
+    and reuse afterwards custom runtime systems
+    (inspired by Fabrice Le Fessant's patch).
+
+* Native-code compiler:
+  - Cross-module constant propagation of integer constants.
+  - More type-dependent optimizations.
+  - More compact code generated for "let rec" over data structures.
+  - Better code generated for "for" loops (test at bottom of code).
+  - More aggressive scheduling of stores.
+  - Added -p option for time profiling with gprof
+    (fully supported on Intel x86/Linux and Alpha/Digital Unix only)
+    (inspired by Aleksey Nogin's patch).
+  - A case of bad spilling with high register pressure fixed.
+  - Fixed GC bug when GC called from C without active Caml code.
+  - Alpha: $gp handling revised to follow Alpha's standard conventions,
+    allow running "atom" and "pixie" on ocamlopt-generated binaries.
+  - Intel x86: use movzbl and movsbl systematically to load 8-bit and 16-bit
+    quantities, no more hacks with partial registers (better for the
+    Pentium Pro, worse for the Pentium).
+  - PowerPC: more aggressive scheduling of return address reloading.
+  - Sparc: scheduling bug related to register pairs fixed.
+
+* Runtime system:
+  - Better printing of uncaught exceptions (print a fully qualified
+    name whenever possible).
+
+* New ports:
+  - Cray T3E (bytecode only) (in collaboration with CEA).
+  - PowerMac under Rhapsody.
+  - SparcStations under Linux.
+
+* Standard library:
+  - Added set_binary_mode_in and set_binary_mode_out in Pervasives
+    to toggle open channels between text and binary modes.
+  - output_value and input_value check that the given channel is in
+    binary mode.
+  - input_value no longer fails on very large marshalled data (> 16 Mbytes).
+  - Module Arg: added option Rest.
+  - Module Filename: temp_file no longer loops if temp dir doesn't exist.
+  - Module List: added rev_append (tail-rec alternative to @).
+  - Module Set: tell the truth about "elements" returning a sorted list;
+    added min_elt, max_elt, singleton.
+  - Module Sys: added Sys.time for simple measuring of CPU time.
+
+* ocamllex:
+  - Check for overflow when generating the tables for the automaton.
+  - Error messages in generated .ml file now point to .mll source.
+  - Added "let  = " to name regular expressions
+    (inspired by Christian Lindig's patch).
+
+* ocamlyacc:
+  - Better error recovery in presence of EOF tokens.
+  - Error messages in generated .ml file now point to .mly source.
+  - Generated .ml file now type-safe even without the generated .mli file.
+
+* The Unix library:
+  - Use float instead of int to represent Unix times (number of seconds
+    from the epoch).  This fixes a year 2005 problem on 32-bit platforms.
+    Functions affected: stat, lstat, fstat, time, gmtime, localtime,
+    mktime, utimes.
+  - Added putenv.
+  - Better handling of "unknown" error codes (EUNKNOWNERR).
+  - Fixed endianness bug in getservbyport.
+  - win32unix (the Win32 implementation of the Unix library) now has
+    the same interface as the unix implementation, this allows exchange
+    of compiled .cmo and .cmi files between Unix and Win32.
+
+* The thread libraries:
+  - Bytecode threads: bug with escaping exceptions fixed.
+  - System threads (POSIX, Win32): malloc/free bug fixed; signal bug fixed.
+  - Both: added Thread.wait_signal to wait synchronously for signals.
+
+* The graph library: bigger color cache.
+
+* The str library: added Str.quote, Str.regexp_string,
+  Str.regexp_string_case_fold.
+
+* Emacs mode:
+  - Fixed bug with paragraph fill.
+  - Fixed bug with next-error under Emacs 20.
+
+
+Objective Caml 1.07 (11 Dec 1997):
+----------------------------------
+
+* Native-code compiler:
+  - Revised interface between generated code and GC, fixes serious GC
+    problems with signals and native threads.
+  - Added "-thread" option for compatibility with ocamlc.
+
+* Debugger: correctly print instance variables of objects.
+
+* Run-time system: ported to OpenBSD.
+
+* Standard library: fixed wrong interface for Marshal.to_buffer and
+  Obj.unmarshal.
+
+* Num library: added Intel x86 optimized asm code (courtesy of
+  Bernard Serpette).
+
+* Thread libraries:
+  - Native threads: fixed GC bugs and installation procedure.
+  - Bytecode threads: fixed problem with "Marshal" module.
+  - Both: added Event.always.
+
+* MS Windows port: better handling of long command lines in Sys.command
+
+Objective Caml 1.06 (18 Nov 1997):
+----------------------------------
+
+* Language:
+  - Added two new keywords: "assert" (check assertion) and "lazy"
+    (delay evaluation).
+  - Allow identifiers to start with "_" (such identifiers are treated
+    as lowercase idents).
+
+* Objects:
+  - Added "protected" methods (visible only from subclasses, can be hidden
+    in class type declared in module signature).
+  - Objects can be compared using generic comparison functions.
+  - Fixed compilation of partial application of object constructors.
+
+* Type system:
+  - Occur-check now more strict (all recursions must traverse an object).
+  - A few bugs fixed.
+
+* Run-time system:
+  - A heap compactor was implemented, so long-running programs can now
+    fight fragmentation.
+  - The meaning of the "space_overhead" parameter has changed.
+  - The macros Push_roots and Pop_roots are superseded by Begin_roots* and
+    End_roots.
+  - Bytecode executable includes list of primitives used, avoids crashes
+    on version mismatch.
+  - Reduced startup overhead for marshalling, much faster marshalling of
+    small objects.
+  - New exception Stack_overflow distinct from Out_of_memory.
+  - Maximum stack size configurable.
+  - I/O revised for compatibility with compactor and with native threads.
+  - All C code ANSIfied (new-style function declarations, etc).
+  - Threaded code work on all 64-bit processors, not just Alpha/Digital Unix.
+  - Better printing of uncaught exceptions.
+
+* Both compilers:
+  - Parsing: more detailed reporting of syntax errors (e.g. shows
+    unmatched opening parenthesis on missing closing parenthesis).
+  - Check consistency between interfaces (.cmi).
+  - Revised rules for determining dependencies between modules.
+  - Options "-verbose" for printing calls to C compiler, "-noassert"
+    for turning assertion checks off.
+
+* Native-code compiler:
+  - Machine-dependent parts rewritten using inheritance instead of
+    parameterized modules.
+  - GC bug in value let rec fixed.
+  - Port to Linux/Alpha.
+  - Sparc: cleaned up use of %g registers, now compatible with Solaris threads.
+
+* Top-level interactive system:
+  - Can execute Caml script files given on command line.
+  - Reads commands from ./.ocamlinit on startup.
+  - Now thread-compatible.
+
+* Standard library:
+  - New library module: Lazy (delayed computations).
+  - New library module: Marshal.  Allows marshalling to strings and
+    transmission of closures between identical programs (SPMD parallelism).
+  - Filename: "is_absolute" is superseded by "is_implicit" and "is_relative".
+    To adapt old programs, change "is_absolute x" to "not (is_implicit x)"
+    (but the new "is_relative" is NOT the opposite of the old "is_absolute").
+  - Array, Hashtbl, List, Map, Queue, Set, Stack, Stream:
+    the "iter" functions now take as argument a unit-returning function.
+  - Format: added "printf" interface to the formatter (see the documentation).
+    Revised behaviour of simple boxes: no more than one new line is output
+    when consecutive break hints should lead to multiple line breaks.
+  - Stream: revised implementation, renamed Parse_failure to Failure and
+    Parse_error to Error (don't you love gratuitous changes?).
+  - String: added index, rindex, index_from, rindex_from.
+  - Array: added mapi, iteri, fold_left, fold_right, init.
+  - Added Map.map, Set.subset, Printexc.to_string.
+
+* ocamllex: lexers generated by ocamllex can now handle all characters,
+  including '\000'.
+
+* ocamlyacc: fixed bug with function closures returned by parser rules.
+
+* Debugger:
+  - Revised generation of events.
+  - Break on function entrance.
+  - New commands start/previous.
+  - The command loadprinter now try to recursively load required
+    modules.
+  - Numerous small fixes.
+
+* External libraries:
+  - systhreads: can now use POSIX threads; POSIX and Win32 threads are
+    now supported by the native-code compiler.
+  - dbm and graph: work in native code.
+  - num: fixed bug in Nat.nat_of_string.
+  - str: fixed deallocation bug with case folding.
+  - win32unix: use Win32 handles instead of (buggy) VC++ emulation of Unix
+    file handles; added gettimeofday.
+
+* Emacs editing mode and debugger interface updated to July '97 version.
+
+Objective Caml 1.05 (21 Mar 1997):
+----------------------------------
+
+* Typing: fixed several bugs causing spurious type errors.
+
+* Native-code compiler: fixed instruction selection bug causing GC to
+see ill-formed pointers; fixed callbacks to support invocation from a
+main program in C.
+
+* Standard library: fixed String.lowercase; Weak now resists integers.
+
+* Toplevel: multiple phrases without intermediate ";;" now really supported;
+fixed value printing problems where the wrong printer was selected.
+
+* Debugger: fixed printing problem with local references; revised
+handling of checkpoints; various other small fixes.
+
+* Macintosh port: fixed signed division problem in bytecomp/emitcode.ml
+
+Objective Caml 1.04 (11 Mar 1997):
+----------------------------------
+
+* Replay debugger ported from Caml Light; added debugger support in
+  compiler (option -g) and runtime system. Debugger is alpha-quality
+  and needs testing.
+
+* Parsing:
+  - Support for "# linenum" directives.
+  - At toplevel, allow several phrases without intermediate ";;".
+
+* Typing:
+  - Allow constraints on datatype parameters, e.g.
+    type 'a foo = ... constraint 'a = 'b * 'c.
+  - Fixed bug in signature matching in presence of free type variables '_a.
+  - Extensive cleanup of internals of type inference.
+
+* Native-code compilation:
+  - Inlining of small functions at point of call (fairly conservative).
+  - MIPS code generator ported to SGI IRIX 6.
+  - Better code generated for large integer constants.
+  - Check for urgent GC when allocating large objects in major heap.
+  - PowerPC port: better scheduling, reduced TOC consumption.
+  - HPPA port: handle long conditional branches gracefully,
+    several span-dependent bugs fixed.
+
+* Standard library:
+  - More floating-point functions (all ANSI C float functions now available).
+  - Hashtbl: added functorial interface (allow providing own equality
+    and hash functions); rehash when resizing, avoid memory leak on
+    Hashtbl.remove.
+  - Added Char.uppercase, Char.lowercase, String.uppercase, String.lowercase,
+    String.capitalize, String.uncapitalize.
+  - New module Weak for manipulating weak pointers.
+  - New module Callback for registering closures and exceptions to be
+    used from C.
+
+* Foreign interface:
+  - Better support for callbacks (C calling Caml), exception raising
+    from C, and main() in C. Added function to remove a global root.
+  - Option -output-obj to package Caml code as a C library.
+
+* Thread library: fixed bug in timed_read and timed_write operations;
+  Lexing.from_function and Lexing.from_channel now reentrant.
+
+* Unix interface: renamed EACCESS to EACCES (the POSIX name); added setsid;
+  fixed bug in inet_addr_of_string for 64-bit platforms.
+
+* Ocamlyacc: default error function no longer prevents error recovery.
+
+* Ocamllex: fixed reentrancy problem w.r.t. exceptions during refill;
+  fixed output problem (\r\r\n) under Win32.
+
+* Macintosh port:
+  - The makefiles are provided for compiling and installing O'Caml on
+    a Macintosh with MPW 3.4.1.
+  - An application with the toplevel in a window is forthcoming.
+
+* Windows NT/95 port: updated toplevel GUI to that of Caml Light 0.73.
+
+* Emacs editing mode and debugger interface included in distribution.
+
+
+Objective Caml 1.03 (29 Oct 1996):
+----------------------------------
+
+* Typing:
+  - bug with type names escaping their scope via unification with
+    non-generalized type variables '_a completely fixed;
+  - fixed bug in occur check : it was too restrictive;
+  - fixed bug of coercion operators;
+  - check that no two types of the same name are generated in a module
+    (there was no check for classes);
+  - "#install_printer" works again;
+  - fixed bug in printing of subtyping errors;
+  - in class interfaces, construct "method m" (without type) change
+    the status of method m from abstract to concrete;
+  - in a recursive definition of class interfaces, a class can now
+    inherit from a previous class;
+  - typing of a method make use of an eventual previously given type
+    of this method, yielding clearer type errors.
+
+* Compilation (ocamlc and ocamlopt):
+  - fixed bug in compilation of classes.
+
+* Native-code compilation:
+  - optimization of functions taking tuples of arguments;
+  - code emitter for the Motorola 680x0 processors (retrocomputing week);
+  - Alpha/OSF1: generate frame descriptors, avoids crashes when e.g.
+    exp() or log() cause a domain error; fixed bug with
+    String.length "literal";
+  - Sparc, Mips, HPPA: removed marking of scanned stack frames
+    (benefits do not outweigh cost).
+
+* Standard library:
+  - Arg.parse now prints documentation for command-line options;
+  - I/O buffers (types in_channel and out_channel) now heap-allocated,
+    avoids crashing when closing a channel several times;
+  - Overflow bug in compare() fixed;
+  - GC bug in raising Sys_error from I/O functions fixed;
+  - Parsing.symbol_start works even for epsilon productions.
+
+* Foreign interface: main() in C now working, fixed bug in library
+  order at link time.
+
+* Thread library: guard against calling thread functions before Thread.create.
+
+* Unix library: fixed getsockopt, setsockopt, open_process_{in,out}.
+
+* Perl-free, cpp-free, cholesterol-free installation procedure.
+
+
+Objective Caml 1.02 (27 Sep 1996):
+----------------------------------
+
+* Typing:
+  - fixed bug with type names escaping their scope via unification
+    with non-generalized type variables '_a;
+  - keep #class abbreviations longer;
+  - faster checking of well-formed abbreviation definitions;
+  - stricter checking of "with" constraints over signatures (arity
+    mismatch, overriding of an already manifest type).
+
+* Compilation (ocamlc and ocamlopt):
+  - fixed bug in compilation of recursive classes;
+  - [|...|] and let...rec... allowed inside definitions of recursive
+    data structures;
+
+* Bytecode compilation: fixed overflow in linker for programs with
+  more than 65535 globals and constants.
+
+* Native-code compilation:
+  - ocamlopt ported to HPPA under HP/UX, Intel x86 under Solaris 2,
+    PowerMacintosh under MkLinux;
+  - fixed two bugs related to floating-point arrays (one with "t array"
+    where t is an abstract type implemented as float, one with
+    comparison between two float arrays on 32 bit platforms);
+  - fixed reloading/spilling problem causing non-termination of
+    register allocation;
+  - fixed bugs in handling of () causing loss of tail recursion;
+  - fixed reloading bug in indirect calls.
+
+* Windows NT/95 port:
+  - complete port of the threads library (Pascal Cuoq);
+  - partial port of the Unix library (Pascal Cuoq);
+  - expansion of *, ? and @ on the command line.
+
+* Standard library:
+  - bug in in List.exists2 fixed;
+  - bug in "Random.int n" for very large n on 64-bit machines fixed;
+  - module Format: added a "general purpose" type of box (open_box);
+    can output on several formatters at the same time.
+
+* The "threads" library:
+  - implementation on top of native threads available for Win32 and
+    POSIX 1003.1c;
+  - added -thread option to select a thread-safe version of the
+    standard library, the ThreadIO module is no longer needed.
+
+* The "graph" library: avoid invalid pixmaps when doing
+  open_graph/close_graph several times.
+
+* The "dynlink" library: support for "private" (no re-export) dynamic loading.
+
+* ocamlyacc: skip '...' character literals correctly.
+
+* C interface: C code linked with O'Caml code can provide its own main()
+  and call caml_main() later.
+
+
+Objective Caml 1.01 (12 Jun 1996):
+----------------------------------
+
+* Typing: better report of type incompatibilities;
+  non-generalizable type variables in a struct...end no longer flagged
+  immediately as an error;
+  name clashes during "open" avoided.
+
+* Fixed bug in output_value where identical data structures
+  could have different external representations; this bug caused wrong
+  "inconsistent assumptions" errors when checking compatibility of
+  interfaces at link-time.
+
+* Standard library: fixed bug in Array.blit on overlapping array sections
+
+* Unmarshaling from strings now working.
+
+* ocamlc, ocamlopt: new flags -intf and -impl to force compilation as
+  an implementation/an interface, regardless of file extension;
+  overflow bug on wide-range integer pattern-matchings fixed.
+
+* ocamlc: fixed bytecode generation bug causing problems with compilation
+  units defining more than 256 values
+
+* ocamlopt, all platforms:
+  fixed GC bug in "let rec" over data structures;
+  link startup file first, fixes "undefined symbol" errors with some
+  libraries.
+
+* ocamlopt, Intel x86:
+  more efficient calling sequence for calling C functions;
+  floating-point wars, chapter 5: don't use float stack for holding
+  float pseudo-registers, stack-allocating them is just as efficient.
+
+* ocamlopt, Alpha and Intel x86: more compact calling sequence for garbage
+  collection.
+
+* ocamllex: generated automata no longer use callbacks for refilling
+  the input buffer (works better with threads); character literals
+  correctly skipped inside actions.
+
+* ocamldep: "-I" directories now searched in the right order
+
+* Thread library: incompatibilities with callbacks, signals, and
+  dynamic linking removed; scheduling bug with Thread.wait fixed.
+
+* New "dbm" library, interfaces with NDBM.
+
+* Object-oriented extensions:
+    instance variables can now be omitted in class types;
+    some error messages have been made clearer;
+    several bugs fixes.
+
+Objective Caml 1.00 (9 May 1996):
+---------------------------------
+
+* Merge of Jérôme Vouillon and Didier Rémy's object-oriented
+extensions.
+
+* All libraries: all "new" functions renamed to "create" because "new"
+is now a reserved keyword.
+
+* Compilation of "or" patterns (pat1 | pat2) completely revised to
+avoid code size explosion.
+
+* Compiler support for preprocessing source files (-pp flag).
+
+* Library construction: flag -linkall to force linking of all units in
+a library.
+
+* Native-code compiler: port to the Sparc under NetBSD.
+
+* Toplevel: fixed bug when tracing several times the same function
+under different names.
+
+* New format for marshaling arbitrary data structures, allows
+marshaling to/from strings.
+
+* Standard library: new module Genlex (configurable lexer for streams)
+
+* Thread library: much better support for I/O and blocking system calls.
+
+* Graphics library: faster reclamation of unused pixmaps.
+
+* Unix library: new functions {set,clear}_nonblock, {set,clear}_close_on_exec,
+{set,get}itimer, inet_addr_any, {get,set}sockopt.
+
+* Dynlink library: added support for linking libraries (.cma files).
+
+Caml Special Light 1.15 (15 Mar 1996):
+--------------------------------------
+
+* Caml Special Light now runs under Windows NT and 95. Many thanks to
+Kevin Gallo (Microsoft Research) who contributed his initial port.
+
+* csllex now generates tables for a table-driven automaton.
+The resulting lexers are smaller and run faster.
+
+* Completely automatic configuration script.
+
+* Typing: more stringent checking of module type definitions against
+manifest module type specifications.
+
+* Toplevel: recursive definitions of values now working.
+
+* Native-code compiler, all platforms:
+        toplevel "let"s with refutable patterns now working;
+        fixed bug in assignment to float record fields;
+        direct support for floating-point negation and absolute value.
+
+* Native-code compiler, x86: fixed bug with tail calls (with more than
+4 arguments) from a function with a one-word stack frame.
+
+* Native-code compiler, Sparc: problem with -compact fixed.
+
+* Thread library: support for non-blocking writes; scheduler revised.
+
+* Unix library: bug in gethostbyaddr fixed; bounds checking for read,
+write, etc.
+
+Caml Special Light 1.14 (8 Feb 1996):
+-------------------------------------
+
+* cslopt ported to the PowerPC/RS6000 architecture. Better support for
+AIX in the bytecode system as well.
+
+* cslopt, all platforms: fixed bug in live range splitting around catch/exit.
+
+* cslopt for the Intel (floating-point wars, chapter 4):
+implemented Ershov's algorithm to minimize floating-point stack usage;
+out-of-order pops fixed.
+
+* Several bug fixes in callbacks and signals.
+
+Caml Special Light 1.13 (4 Jan 1996):
+-------------------------------------
+
+* Pattern-matching compilation revised to factor out accesses inside
+matched structures.
+
+* Callbacks and signals now supported in cslopt.
+Signals are only detected at allocation points, though.
+Added callback functions with 2 and 3 arguments.
+
+* More explicit error messages when a native-code program aborts due
+to array or string bound violations.
+
+* In patterns, "C _" allowed even if the constructor C has several arguments.
+
+* && and || allowed as alternate syntax for & and or.
+
+* cslopt for the Intel: code generation for floating-point
+operations entirely redone for the third time (a pox on whomever at
+Intel decided to organize the floating-point registers as a stack).
+
+* cslopt for the Sparc: don't use Sparc V8 smul and sdiv instructions,
+emulation on V7 processors is abysmal.
+
+Caml Special Light 1.12 (30 Nov 1995):
+--------------------------------------
+
+* Fixed an embarrassing bug with references to floats.
+
+Caml Special Light 1.11 (29 Nov 1995):
+--------------------------------------
+
+* Streams and stream parsers a la Caml Light are back (thanks to
+Daniel de Rauglaudre).
+
+* User-level concurrent threads, with low-level shared memory primitives
+(locks and conditions) as well as channel-based communication primitives
+with first-class synchronous events, in the style of Reppy's CML.
+
+* The native-code compiler has been ported to the HP PA-RISC processor
+running under NextStep (sorry, no HPUX, its linker keeps dumping
+core on me).
+
+* References not captured in a function are optimized into variables.
+
+* Fixed several bugs related to exceptions.
+
+* Floats behave a little more as specified in the IEEE standard
+(believe it or not, but x < y is not the negation of x >= y).
+
+* Lower memory consumption for the native-code compiler.
+
+Caml Special Light 1.10 (07 Nov 1995):
+--------------------------------------
+
+* Many bug fixes (too many to list here).
+
+* Module language: introduction of a "with module" notation over
+signatures for concise sharing of all type components of a signature;
+better support for concrete types in signatures.
+
+* Native-code compiler: the Intel 386 version has been ported to
+NextStep and FreeBSD, and generates better code (especially for
+floats)
+
+* Tools and libraries: the Caml Light profiler and library for
+arbitrary-precision arithmetic have been ported (thanks to John
+Malecki and Victor Manuel Gulias Fernandez); better docs for the Unix
+and regexp libraries.
+
+Caml Special Light 1.07 (20 Sep 1995):
+--------------------------------------
+
+* Syntax: optional ;; allowed in compilation units and structures
+(back by popular demand)
+
+* cslopt:
+generic handling of float arrays fixed
+direct function application when the function expr is not a path fixed
+compilation of "let rec" over values fixed
+multiple definitions of a value name in a module correctly handled
+no calls to ranlib in Solaris
+
+* csltop: #trace now working
+
+* Standard library: added List.memq; documentation of Array fixed.
+
+Caml Special Light 1.06 (12 Sep 1995):
+--------------------------------------
+
+* First public release.
diff --git a/HACKING.adoc b/HACKING.adoc
new file mode 100644
index 00000000..101f3f57
--- /dev/null
+++ b/HACKING.adoc
@@ -0,0 +1,402 @@
+= Hacking the compiler :camel:
+
+This document is a work-in-progress attempt to provide useful
+information for people willing to inspect or modify the compiler
+distribution's codebase. Feel free to improve it by sending change
+proposals for it.
+
+If you already have a patch that you would like to contribute to the
+official distribution, please see link:CONTRIBUTING.md[].
+
+=== Your first compiler modification
+
+1. Create a new git branch to store your changes.
++
+----
+git checkout -b my-modification
+----
+
+2. Consult link:INSTALL.adoc[] for build instructions. Here is the gist of it:
++
+----
+./configure
+make
+----
+
+3. Try the newly built compiler binaries `ocamlc`, `ocamlopt` or their
+`.opt` version. To try the toplevel, use:
++
+----
+make runtop
+----
+
+4. Hack frenetically and keep rebuilding.
+
+5. Run the testsuite from time to time.
++
+----
+make tests
+----
+
+6. Install in a new opam switch to try things out. With `opam` v2, create a local
+opam switch with the compiler installed from the current source directory:
++
+----
+opam switch create . --empty
+opam install .
+----
+
+7. You did it, Well done! Consult link:CONTRIBUTING.md[] to send your contribution upstream.
+
+See our <> for various helpful details,
+for example on how to automatically <> from a compiler branch.
+
+=== What to do
+
+There is always a lot of potential tasks, both for old and
+newcomers. Here are various potential projects:
+
+* http://caml.inria.fr/mantis/view_all_bug_page.php[The OCaml
+  bugtracker] contains reported bugs and feature requests. Some
+  changes that should be accessible to newcomers are marked with the
+  tag link:++http://caml.inria.fr/mantis/search.php?
+project_id=1&sticky_issues=1&sortby=last_updated&dir=DESC&highlight_changed=24&hide_status_id=90&tag_string=junior_job++[
+  junior_job].
+
+* The
+  https://github.com/ocamllabs/compiler-hacking/wiki/Things-to-work-on[OCaml
+  Labs compiler-hacking wiki] contains various ideas of changes to
+  propose, some easy, some requiring a fair amount of work.
+
+* Documentation improvements are always much appreciated, either in
+  the various `.mli` files or in the official manual
+  (See link:manual/README.md[]). If you invest effort in understanding
+  a part of the codebase, submitting a pull request that adds
+  clarifying comments can be an excellent contribution to help you,
+  next time, and other code readers.
+
+* The https://github.com/ocaml/ocaml[github project] contains a lot of
+  pull requests, many of them being in dire need of a review -- we
+  have more people willing to contribute changes than to review
+  someone else's change. Picking one of them, trying to understand the
+  code (looking at the code around it) and asking questions about what
+  you don't understand or what feels odd is super-useful. It helps the
+  contribution process, and it is also an excellent way to get to know
+  various parts of the compiler from the angle of a specific aspect or
+  feature.
++
+Again, reviewing small or medium-sized pull requests is accessible to
+anyone with OCaml programming experience, and helps maintainers and
+other contributors. If you also submit pull requests yourself, a good
+discipline is to review at least as many pull requests as you submit.
+
+== Structure of the compiler
+
+The compiler codebase can be intimidating at first sight. Here are
+a few pointers to get started.
+
+=== Compilation pipeline
+
+==== The driver -- link:driver/[]
+
+The driver contains the "main" function of the compilers that drive
+compilation. It parses the command-line arguments and composes the
+required compiler passes by calling functions from the various parts
+of the compiler described below.
+
+==== Parsing -- link:parsing/[]
+
+Parses source files and produces an Abstract Syntax Tree (AST)
+(link:parsing/parsetree.mli[] has lot of helpful comments). See
+link:parsing/HACKING.adoc[].
+
+The logic for Camlp4 and Ppx preprocessing is not in link:parsing/[],
+but in link:driver/[], see link:driver/pparse.mli[] and
+link:driver/pparse.ml[].
+
+==== Typing -- link:typing/[]
+
+Type-checks the AST and produces a typed representation of the program
+(link:typing/typedtree.mli[] has some helpful comments). See
+link:typing/HACKING.adoc[].
+
+==== The bytecode compiler -- link:bytecomp/[]
+
+==== The native compiler -- link:middle_end/[] and link:asmcomp/[]
+
+=== Runtime system
+
+=== Libraries
+
+link:stdlib/[]:: The standard library. Each file is largely
+independent and should not need further knowledge.
+
+link:otherlibs/[]:: External libraries such as `unix`, `threads`,
+`dynlink`, `str` and `bigarray`.
+
+Instructions for building the full reference manual are provided in
+link:manual/README.md[]. However, if you only modify the documentation
+comments in `.mli` files in the compiler codebase, you can observe the
+result by running
+
+----
+make html_doc
+----
+
+and then opening link:./ocamldoc/stdlib_html/index.html[] in a web browser.
+
+=== Tools
+
+link:lex/[]:: The `ocamllex` lexer generator.
+
+link:yacc/[]:: The `ocamlyacc` parser generator. We do not recommend
+using it for user projects in need of a parser generator. Please
+consider using and contributing to
+link:http://gallium.inria.fr/~fpottier/menhir/[menhir] instead, which
+has tons of extra features, lets you write more readable grammars, and
+has excellent documentation.
+
+=== Complete file listing
+
+  BOOTSTRAP.adoc::        instructions for bootstrapping
+  Changes::               what's new with each release
+  CONTRIBUTING.md::       how to contribute to OCaml
+  HACKING.adoc::          this file
+  INSTALL.adoc::          instructions for installation
+  LICENSE::               license and copyright notice
+  Makefile::              main Makefile
+  Makefile.common::       common Makefile definitions
+  Makefile.tools::        used by manual/ and testsuite/ Makefiles
+  README.adoc::           general information on the compiler distribution
+  README.win32.adoc::     general information on the Windows ports of OCaml
+  VERSION::               version string
+  asmcomp/::              native-code compiler and linker
+  boot/::                 bootstrap compiler
+  build-aux/:             autotools support scripts
+  bytecomp/::             bytecode compiler and linker
+  compilerlibs/::         the OCaml compiler as a library
+  configure::             configure script
+  configure.ac:           autoconf input file
+  debugger/::             source-level replay debugger
+  driver/::               driver code for the compilers
+  flexdll/::              git submodule -- see link:README.win32.adoc[]
+  lex/::                  lexer generator
+  man/::                  man pages
+  manual/::               system to generate the manual
+  middle_end/::           the flambda optimisation phase
+  ocamldoc/::             documentation generator
+  ocamltest/::            test driver
+  otherlibs/::            several additional libraries
+  parsing/::              syntax analysis -- see link:parsing/HACKING.adoc[]
+  runtime/::              bytecode interpreter and runtime systems
+  stdlib/::               standard library
+  testsuite/::            tests -- see link:testsuite/HACKING.adoc[]
+  tools/::                various utilities
+  toplevel/::             interactive system
+  typing/::               typechecking -- see link:typing/HACKING.adoc[]
+  utils/::                utility libraries
+  yacc/::                 parser generator
+
+== Development tips and tricks
+
+=== Keep merge commits when merging and cherry-picking Github PRs
+
+Having the Github PR number show up in the git log is very useful for
+later triaging. We recently disabled the "Rebase and merge" button,
+precisely because it does not produce a merge commit.
+
+When you cherry-pick a PR in another branch, please cherry-pick this
+merge-style commit rather than individual commits, whenever
+possible. (Picking a merge commit typically requires the `-m 1`
+option.) You should also use the `-x` option to include the hash of
+the original commit in the commit message.
+
+----
+git cherry-pick -x -m 1 
+----
+
+=== Testing with `opam`
+
+To test a particular branch `branch` of a public git repository
+`$REPO` of the compiler in an `opam` v2 switch issue:
+
+----
+opam switch create ocaml-branch --empty
+# Replace $VERSION by the trunk version
+opam pin add ocaml-variants.$VERSION+branch git+https://$REPO#branch
+----
+
+=== Useful Makefile targets
+
+Besides the targets listed in link:INSTALL.adoc[] for build and
+installation, the following targets may be of use:
+
+`make runtop` :: builds and runs the ocaml toplevel of the distribution
+                          (optionally uses `rlwrap` for readline+history support)
+`make natruntop`:: builds and runs the native ocaml toplevel (experimental)
+
+`make partialclean`:: Clean the OCaml files but keep the compiled C files.
+
+`make depend`:: Regenerate the `.depend` file. Should be used each time new dependencies are added between files.
+
+`make -C testsuite parallel`:: see link:testsuite/HACKING.adoc[]
+
+Additionally, there are some developer specific targets in link:Makefile.dev[].
+These targets are automatically available when working in a Git clone of the
+repository, but are not available from a tarball.
+
+=== Automatic configure options
+
+If you have options to `configure` which you always (or at least frequently)
+use, it's possible to store them in Git, and `configure` will automatically add
+them. For example, you may wish to avoid building the debug runtime by default
+while developing, in which case you can issue
+`git config --global ocaml.configure '--disable-debug-runtime'`. The `configure`
+script will alert you that it has picked up this option and added it _before_
+any options you specified for `configure`.
+
+Options are added before those passed on the command line, so it's possible to
+override them, for example `./configure --enable-debug-runtime` will build the
+debug runtime, since the enable flag appears after the disable flag. You can
+also use the full power of Git's `config` command and have options specific to
+particular clone or worktree.
+
+=== Speeding up configure
+
+`configure` includes the standard `-C` option which caches various test results
+in the file `config.cache` and can use those results to avoid running tests in
+subsequent invocations. This mechanism works fine, except that it is easy to
+clean the cache by mistake (e.g. with `git clean -dfX`). The cache is also
+host-specific which means the file has to be deleted if you run `configure` with
+a new `--host` value (this is quite common on Windows, where `configure` is
+also quite slow to run).
+
+You can elect to have host-specific cache files by issuing
+`git config --global ocaml.configure-cache .`. The `configure` script will now
+automatically create `ocaml-host.cache` (e.g. `ocaml-x86_64-pc-windows.cache`,
+or `ocaml-default.cache`). If you work with multiple worktrees, you can share
+these cache files by issuing `git config --global ocaml.configure-cache ..`. The
+directory is interpreted _relative_ to the `configure` script.
+
+=== Bootstrapping
+
+The OCaml compiler is bootstrapped. This means that
+previously-compiled bytecode versions of the compiler and lexer are
+included in the repository under the
+link:boot/[] directory. These bytecode images are used once the
+bytecode runtime (which is written in C) has been built to compile the
+standard library and then to build a fresh compiler. Details can be
+found in link:BOOTSTRAP.adoc[].
+
+=== Speeding up builds
+
+Once you've built a natively-compiled `ocamlc.opt`, you can use it to
+speed up future builds by copying it to `boot`:
+
+----
+cp ocamlc.opt boot/
+----
+
+If `boot/ocamlc` changes (e.g. because you ran `make bootstrap`), then
+the build will revert to the slower bytecode-compiled `ocamlc` until
+you do the above step again.
+
+=== Continuous integration
+
+==== Github's CI: Travis and AppVeyor
+
+The script that is run on Travis continuous integration servers is
+link:tools/ci/travis/travis-ci.sh[]; its configuration can be found as
+a Travis configuration file in link:.travis.yml[].
+
+For example, if you want to reproduce the default build on your
+machine, you can use the configuration values and run command taken from
+link:.travis.yml[]:
+
+----
+CI_KIND=build XARCH=x64 bash -ex tools/ci/travis/travis-ci.sh
+----
+
+The scripts support two other kinds of tests (values of the
+`CI_KIND` variable) which both inspect the patch submitted as part of
+a pull request. `tests` checks that the testsuite has been modified
+(hopefully, improved) by the patch, and `changes` checks that the
+link:Changes[] file has been modified (hopefully to add a new entry).
+
+These tests rely on the `$TRAVIS_COMMIT_RANGE` variable which you can
+set explicitly to reproduce them locally.
+
+The `changes` check can be disabled by including "(no change
+entry needed)" in one of your commit messages -- but in general all
+patches submitted should come with a Changes entry; see the guidelines
+in link:CONTRIBUTING.md[].
+
+==== INRIA's Continuous Integration (CI)
+
+INRIA provides a Jenkins continuous integration service that OCaml
+uses, see link:https://ci.inria.fr/ocaml/[]. It provides a wider
+architecture support (MSVC and MinGW, a zsystems s390x machine, and
+various MacOS versions) than the Travis/AppVeyor testing on github,
+but only runs on commits to the trunk or release branches, not on every
+PR.
+
+You do not need to be an INRIA employee to open an account on this
+jenkins service; anyone can create an account there to access build
+logs and manually restart builds. If you
+would like to do this but have trouble doing it, please email
+ocaml-ci-admin@inria.fr.
+
+To be notified by email of build failures, you can subscribe to the
+ocaml-ci-notifications@inria.fr mailing list by visiting
+https://sympa.inria.fr/sympa/info/ocaml-ci-notifications[its web page.]
+
+==== Running INRIA's CI on a publicly available git branch
+
+If you have suspicions that your changes may fail on exotic architectures
+(they touch the build system or the backend code generator,
+for example) and would like to get wider testing than github's CI
+provides, it is possible to manually start INRIA's CI on arbitrary git
+branches even before opening a pull request as follows:
+
+1. Make sure you have an account on Inria's CI as described before.
+
+2. Make sure you have been added to the ocaml project.
+
+3. Prepare a branch with the code you'd like to test, say "mybranch". It
+is probably a good idea to make sure your branch is based on the latest
+trunk.
+
+4. Make your branch publicly available. For instance, you can fork
+OCaml's GitHub repository and then push "mybranch" to your fork.
+
+5. Visit https://ci.inria.fr/ocaml/job/precheck and log in. Click on
+"Build with parameters".
+
+6. Fill in the REPO_URL and BRANCH fields as appropriate and run the build.
+
+7. You should receive a bunch of e-mails with the build logs for each
+slave and each tested configuration (with and without flambda) attached.
+
+==== Changing what the CI does
+
+INRIA's CI "main" and "precheck" jobs run the script
+tools/ci-build. In particular, when running the CI on a publicly
+available branch via the "precheck" job as explained in the previous
+section, you can edit this script to change what the CI will test.
+
+For instance, parallel builds are only tested for the "trunk"
+branch. In order to use "precheck" to test parallel build on a custom
+branch, add this at the beginning of tools/ci-build:
+
+----
+OCAML_JOBS=10
+----
+
+=== The `caml-commits` mailing list
+
+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.]
+
+Happy Hacking!
diff --git a/INSTALL.adoc b/INSTALL.adoc
new file mode 100644
index 00000000..9d63aaf5
--- /dev/null
+++ b/INSTALL.adoc
@@ -0,0 +1,161 @@
+= Installing OCaml from sources on a Unix(-like) machine =
+
+== Prerequisites
+
+* The GNU C Compiler (gcc) is recommended, as the bytecode interpreter takes
+  advantage of GCC-specific features to enhance performance. gcc is the standard
+  compiler under Linux, OS X, and many other systems.
+
+* If you do not have write access to `/tmp`, you should set the environment
+  variable `TMPDIR` to the name of some other temporary directory.
+
+* Under HP/UX, the GNU C Compiler (gcc), the GNU Assembler (gas), and GNU Make
+  are all *required*.  The vendor-provided compiler, assembler and make tools
+  have major problems.
+
+* Under Cygwin, the `gcc-core` and `make` packages are required.  `flexdll` is
+  necessary for shared library support.  `libX11-devel` is necessary for graph
+  library support and `libintl-devel` is necessary for the `ocamlobjinfo` tool
+  to be able to process `.cmxs` files.  `diffutils` is necessary to run the test
+  suite.
+
+== Configuration
+
+From the top directory, do:
+
+        ./configure
++
+This generates the three configuration files `Makefile.config`,
+`runtime/caml/m.h` and `runtime/caml/s.h`.
++
+The `configure` script accepts options that can be discovered by running:
+
+        ./configure --help
++
+Some options or variables like (LDFLAGS) may not be taken into account
+by the OCaml build system at the moment. Please report an issue if you
+discover such a variable or option and this causes troubles to you.
++
+Examples:
+
+* Standard installation in `/usr/{bin,lib,man}` instead of `/usr/local`:
+    ./configure --prefix=/usr
+
+
+* On a Linux x86-64 host, to build a 32-bit version of OCaml:
+
+    ./configure --build=x86_64-pc-linux-gnu --host=i386-linux \
+                CC='gcc -m32' AS='as --32' ASPP='gcc -m32 -c' \
+                PARTIALLD='ld -r -melf_i386'
+
+* For AIX 7.x with the IBM compiler `xlc`:
+
+    ./configure CC=xlc
++
+By default, build is 32-bit. For 64-bit build, please set environment variable `OBJECT_MODE=64`
+  for _both_ `configure` and `make world` phases. Note, if this variable is set for only one phase,
+  your build will break (`ocamlrun` segfaults).
++
+If something goes wrong during the automatic configuration, or if the generated
+files cause errors later on, then look at the template files:
+
+        Makefile.config.in
+        Makefile.common.in
+        runtime/caml/m.h.in
+        runtime/caml/s.h.in
++
+for guidance on how to edit the generated files by hand.
+
+== Building the compiler
+
+From the top directory, do:
+
+        make
+
+This builds the OCaml compiler for the first time.  This phase is
+fairly verbose; consider redirecting the output to a file:
+
+        make > make.log 2>&1     # in sh
+        make >& make.log         # in csh
+
+== (Optional) Running the testsuite
+
+To be sure everything works well, you can run the test suite
+   that comes with the compiler. To do so, do:
+
+        make tests
+
+== Installing the compiler
+
+You can now install the OCaml system. This will create the following commands
+   (in the binary directory selected during autoconfiguration):
++
+[width="70%",frame="topbot",cols="25%,75%"]
+|===============================================================================
+| `ocamlc`     | the batch bytecode compiler
+| `ocamlopt`   | the batch native-code compiler (if supported)
+| `ocamlrun`   | the runtime system for the bytecode compiler
+| `ocamlyacc`  | the parser generator
+| `ocamllex`   | the lexer generator
+| `ocaml`      | the interactive, toplevel-based system
+| `ocamlmktop` | a tool to make toplevel systems that integrate user-defined C
+                 primitives and OCaml code
+| `ocamldebug` | the source-level replay debugger
+| `ocamldep`   | generator of "make" dependencies for OCaml sources
+| `ocamldoc`   | the documentation generator
+| `ocamlprof`  | the execution count profiler
+| `ocamlcp`    | the bytecode compiler in profiling mode
+|===============================================================================
++
+From the top directory, become superuser and do:
+
+        make install
+
+Installation is complete. Time to clean up. From the toplevel directory,
+   do:
+
+        make clean
+
+After installation, do *not* strip the `ocamldebug` executables.
+   This is a mixed-mode executable (containing both compiled C
+   code and OCaml bytecode) and stripping erases the bytecode!  Other
+   executables such as `ocamlrun` can safely be stripped.
+
+== If something goes wrong
+
+Read the "common problems" and "machine-specific hints" section at the end of
+this file.
+
+Check the files `m.h` and `s.h` in `runtime/caml/`.
+Wrong endianness or alignment constraints in `machine.h` will
+immediately crash the bytecode interpreter.
+
+If you get a "segmentation violation" signal, check the limits on the stack size
+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
+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`).
+
+You can also use the debug version of the runtime system which is
+normally built and installed by default. Run the bytecode program
+that causes troubles with `ocamlrund` rather than with `ocamlrun`.
+This version of the runtime system contains lots of assertions
+and sanity checks that could help you pinpoint the problem.
+
+== Common problems
+
+* The Makefiles assume that make executes commands by calling `/bin/sh`. They
+  won't work if `/bin/csh` is called instead.  You may have to unset the `SHELL`
+  environment variable, or set it to `/bin/sh`.
+
+* On some systems, localization causes build problems.  You should try to set
+  the C locale (`export LC_ALL=C`) before compiling if you have strange errors
+  while compiling OCaml.
+
+* On HP 9000/700 machines under HP/UX 9, some versions of `cc` are unable to
+  compile correctly the runtime system (wrong code is generated for `(x - y)`
+  where `x` is a pointer and `y` an integer). Fix: use `gcc`.
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 00000000..3666ebe1
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,203 @@
+In the following, "the OCaml Core System" refers to all files marked
+"Copyright INRIA" in this distribution.
+
+The OCaml Core System is distributed under the terms of the
+GNU Lesser General Public License (LGPL) version 2.1 (included below).
+
+As a special exception to the GNU Lesser General Public License, you
+may link, statically or dynamically, a "work that uses the OCaml Core
+System" with a publicly distributed version of the OCaml Core System
+to produce an executable file containing portions of the OCaml Core
+System, and distribute that executable file under terms of your
+choice, without any of the additional requirements listed in clause 6
+of the GNU Lesser General Public License.  By "a publicly distributed
+version of the OCaml Core System", we mean either the unmodified OCaml
+Core System as distributed by INRIA, or a modified version of the
+OCaml Core System that is distributed under the conditions defined in
+clause 2 of the GNU Lesser General Public License.  This exception
+does not however invalidate any other reasons why the executable file
+might be covered by the GNU Lesser General Public License.
+
+----------------------------------------------------------------------
+
+GNU LESSER GENERAL PUBLIC LICENSE
+
+Version 2.1, February 1999
+
+Copyright (C) 1991, 1999 Free Software Foundation, Inc.
+51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+Everyone is permitted to copy and distribute verbatim copies
+of this license document, but changing it is not allowed.
+
+[This is the first released version of the Lesser GPL.  It also counts
+ as the successor of the GNU Library Public License, version 2, hence
+ the version number 2.1.]
+
+Preamble
+
+The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users.
+
+This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below.
+
+When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things.
+
+To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it.
+
+For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights.
+
+We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library.
+
+To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others.
+
+Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license.
+
+Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs.
+
+When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library.
+
+We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances.
+
+For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License.
+
+In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system.
+
+Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library.
+
+The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run.
+
+TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you".
+
+A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables.
+
+The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".)
+
+"Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library.
+
+Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does.
+
+1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library.
+
+You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee.
+
+2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions:
+
+    a) The modified work must itself be a software library.
+    b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change.
+    c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License.
+    d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful.
+
+    (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License.
+
+3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices.
+
+Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy.
+
+This option is useful when you wish to copy part of the code of the Library into a program that is not a library.
+
+4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange.
+
+If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code.
+
+5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License.
+
+However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables.
+
+When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law.
+
+If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.)
+
+Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself.
+
+6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications.
+
+You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things:
+
+    a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.)
+    b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with.
+    c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution.
+    d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place.
+    e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy.
+
+For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable.
+
+It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute.
+
+7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things:
+
+    a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above.
+    b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work.
+
+8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance.
+
+9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it.
+
+10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License.
+
+11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice.
+
+This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License.
+
+12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License.
+
+13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation.
+
+14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally.
+
+NO WARRANTY
+
+15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+END OF TERMS AND CONDITIONS
+
+How to Apply These Terms to Your New Libraries
+
+If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License).
+
+To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found.
+
+one line to give the library's name and an idea of what it does.
+Copyright (C) year  name of author
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+
+Also add information on how to contact you by electronic and paper mail.
+
+You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names:
+
+Yoyodyne, Inc., hereby disclaims all copyright interest in
+the library `Frob' (a library for tweaking knobs) written
+by James Random Hacker.
+
+signature of Ty Coon, 1 April 1990
+Ty Coon, President of Vice
+
+That's all there is to it!
+
+--------------------------------------------------
diff --git a/Makefile b/Makefile
new file mode 100644
index 00000000..2984178a
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,1106 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# The main Makefile
+
+ROOTDIR = .
+
+# The configure and *clean targets can all be run without running ./configure
+# first.
+# If no goals were specified (i.e. `make`), add defaultentry (since it requires
+# ./configure to be run)
+CAN_BE_UNCONFIGURED := $(strip \
+  $(filter-out partialclean clean distclean configure, \
+	$(if $(MAKECMDGOALS),$(MAKECMDGOALS),defaultentry)))
+
+ifeq "$(CAN_BE_UNCONFIGURED)" ""
+-include Makefile.config
+-include Makefile.common
+else
+include Makefile.config
+include Makefile.common
+endif
+
+.PHONY: defaultentry
+ifeq "$(NATIVE_COMPILER)" "true"
+defaultentry: world.opt
+else
+defaultentry: world
+endif
+
+MKDIR=mkdir -p
+ifeq "$(UNIX_OR_WIN32)" "win32"
+LN = cp
+else
+LN = ln -sf
+endif
+
+include stdlib/StdlibModules
+
+CAMLC=$(BOOT_OCAMLC) -g -nostdlib -I boot -use-prims runtime/primitives
+CAMLOPT=$(CAMLRUN) ./ocamlopt -g -nostdlib -I stdlib -I otherlibs/dynlink
+ARCHES=amd64 i386 arm arm64 power s390x riscv
+INCLUDES=-I utils -I parsing -I typing -I bytecomp -I file_formats \
+        -I lambda -I middle_end -I middle_end/closure \
+        -I middle_end/flambda -I middle_end/flambda/base_types \
+        -I asmcomp -I asmcomp/debug \
+        -I driver -I toplevel
+
+COMPFLAGS=-strict-sequence -principal -absname -w +a-4-9-40-41-42-44-45-48-66 \
+	  -warn-error A \
+          -bin-annot -safe-string -strict-formats $(INCLUDES)
+LINKFLAGS=
+
+ifeq "$(strip $(NATDYNLINKOPTS))" ""
+OCAML_NATDYNLINKOPTS=
+else
+OCAML_NATDYNLINKOPTS = -ccopt "$(NATDYNLINKOPTS)"
+endif
+
+YACCFLAGS=-v --strict
+CAMLLEX=$(CAMLRUN) boot/ocamllex
+CAMLDEP=$(CAMLRUN) boot/ocamlc -depend
+DEPFLAGS=-slash
+DEPINCLUDES=$(INCLUDES)
+
+OCAMLDOC_OPT=$(WITH_OCAMLDOC:=.opt)
+OCAMLTEST_OPT=$(WITH_OCAMLTEST:=.opt)
+
+BYTESTART=driver/main.cmo
+
+OPTSTART=driver/optmain.cmo
+
+TOPLEVELSTART=toplevel/topstart.cmo
+
+OPTTOPLEVELSTART=toplevel/opttopstart.cmo
+
+PERVASIVES=$(STDLIB_MODULES) outcometree topdirs toploop
+
+LIBFILES=stdlib.cma std_exit.cmo *.cmi camlheader
+
+COMPLIBDIR=$(LIBDIR)/compiler-libs
+
+TOPINCLUDES=$(addprefix -I otherlibs/,$(filter-out %threads,$(OTHERLIBRARIES)))
+RUNTOP=./runtime/ocamlrun ./ocaml \
+  -nostdlib -I stdlib \
+  -noinit $(TOPFLAGS) $(TOPINCLUDES)
+NATRUNTOP=./ocamlnat$(EXE) \
+  -nostdlib -I stdlib \
+  -noinit $(TOPFLAGS) $(TOPINCLUDES)
+ifeq "$(UNIX_OR_WIN32)" "unix"
+EXTRAPATH=
+else
+EXTRAPATH = PATH="otherlibs/win32unix:$(PATH)"
+endif
+
+BOOT_FLEXLINK_CMD=
+
+ifeq "$(UNIX_OR_WIN32)" "win32"
+FLEXDLL_SUBMODULE_PRESENT := $(wildcard flexdll/Makefile)
+ifeq "$(FLEXDLL_SUBMODULE_PRESENT)" ""
+  BOOT_FLEXLINK_CMD =
+else
+  BOOT_FLEXLINK_CMD = FLEXLINK_CMD="../boot/ocamlrun ../flexdll/flexlink.exe"
+endif
+else
+endif
+
+# targets for the compilerlibs/*.{cma,cmxa} archives
+include compilerlibs/Makefile.compilerlibs
+
+# The configuration file
+
+utils/config.ml: utils/config.mlp Makefile.config utils/Makefile
+	$(MAKE) -C utils config.ml
+
+.PHONY: reconfigure
+reconfigure:
+	ac_read_git_config=true ./configure $(CONFIGURE_ARGS)
+
+utils/domainstate.ml: utils/domainstate.ml.c runtime/caml/domain_state.tbl
+	$(CPP) -I runtime/caml $< > $@
+
+utils/domainstate.mli: utils/domainstate.mli.c runtime/caml/domain_state.tbl
+	$(CPP) -I runtime/caml $< > $@
+
+configure: configure.ac aclocal.m4 VERSION tools/autogen
+	tools/autogen
+
+.PHONY: partialclean
+partialclean::
+	rm -f utils/config.ml utils/domainstate.ml utils/domainstate.mli
+
+.PHONY: beforedepend
+beforedepend:: utils/config.ml utils/domainstate.ml utils/domainstate.mli
+
+# Start up the system from the distribution compiler
+.PHONY: coldstart
+coldstart:
+	$(MAKE) -C runtime $(BOOT_FLEXLINK_CMD) all
+	cp runtime/ocamlrun$(EXE) boot/ocamlrun$(EXE)
+	$(MAKE) -C stdlib $(BOOT_FLEXLINK_CMD) \
+	  CAMLC='$$(BOOT_OCAMLC) -use-prims ../runtime/primitives' all
+	cd stdlib; cp $(LIBFILES) ../boot
+	cd boot; $(LN) ../runtime/libcamlrun.$(A) .
+
+# Recompile the core system using the bootstrap compiler
+.PHONY: coreall
+coreall: runtime
+	$(MAKE) ocamlc
+	$(MAKE) ocamllex ocamltools library
+
+# Build the core system: the minimum needed to make depend and bootstrap
+.PHONY: core
+core:
+	$(MAKE) coldstart
+	$(MAKE) coreall
+
+# Check if fixpoint reached
+.PHONY: compare
+compare:
+	@if $(CAMLRUN) tools/cmpbyt boot/ocamlc ocamlc \
+         && $(CAMLRUN) tools/cmpbyt boot/ocamllex lex/ocamllex; \
+	then echo "Fixpoint reached, bootstrap succeeded."; \
+	else \
+	  echo "Fixpoint not reached, try one more bootstrapping cycle."; \
+	  exit 1; \
+	fi
+
+# Promote a compiler
+
+PROMOTE ?= cp
+
+.PHONY: promote-common
+promote-common:
+	$(PROMOTE) ocamlc boot/ocamlc
+	$(PROMOTE) lex/ocamllex boot/ocamllex
+	cd stdlib; cp $(LIBFILES) ../boot
+
+# Promote the newly compiled system to the rank of cross compiler
+# (Runs on the old runtime, produces code for the new runtime)
+.PHONY: promote-cross
+promote-cross: promote-common
+
+# Promote the newly compiled system to the rank of bootstrap compiler
+# (Runs on the new runtime, produces code for the new runtime)
+.PHONY: promote
+promote: PROMOTE = $(CAMLRUN) tools/stripdebug
+promote: promote-common
+	cp runtime/ocamlrun$(EXE) boot/ocamlrun$(EXE)
+
+# Compile the native-code compiler
+.PHONY: opt-core
+opt-core: runtimeopt
+	$(MAKE) ocamlopt
+	$(MAKE) libraryopt
+
+.PHONY: opt
+opt: checknative
+	$(MAKE) runtimeopt
+	$(MAKE) ocamlopt
+	$(MAKE) libraryopt
+	$(MAKE) otherlibrariesopt ocamltoolsopt
+
+# Native-code versions of the tools
+.PHONY: opt.opt
+opt.opt: checknative
+	$(MAKE) checkstack
+	$(MAKE) runtime
+	$(MAKE) core
+	$(MAKE) ocaml
+	$(MAKE) opt-core
+	$(MAKE) ocamlc.opt
+	$(MAKE) otherlibraries $(WITH_DEBUGGER) $(WITH_OCAMLDOC) \
+	  $(WITH_OCAMLTEST)
+	$(MAKE) ocamlopt.opt
+	$(MAKE) otherlibrariesopt
+	$(MAKE) ocamllex.opt ocamltoolsopt ocamltoolsopt.opt $(OCAMLDOC_OPT) \
+	  $(OCAMLTEST_OPT)
+ifeq "$(WITH_OCAMLDOC)-$(STDLIB_MANPAGES)" "ocamldoc-true"
+	$(MAKE) manpages
+endif
+
+# Core bootstrapping cycle
+.PHONY: coreboot
+coreboot:
+# Promote the new compiler but keep the old runtime
+# This compiler runs on boot/ocamlrun and produces bytecode for
+# runtime/ocamlrun
+	$(MAKE) promote-cross
+# Rebuild ocamlc and ocamllex (run on runtime/ocamlrun)
+	$(MAKE) partialclean
+	$(MAKE) ocamlc ocamllex ocamltools
+# Rebuild the library (using runtime/ocamlrun ./ocamlc)
+	$(MAKE) library-cross
+# Promote the new compiler and the new runtime
+	$(MAKE) CAMLRUN=runtime/ocamlrun promote
+# Rebuild the core system
+	$(MAKE) partialclean
+	$(MAKE) core
+# Check if fixpoint reached
+	$(MAKE) compare
+
+# Recompile the system using the bootstrap compiler
+
+.PHONY: all
+all: coreall
+	$(MAKE) ocaml
+	$(MAKE) otherlibraries $(WITH_DEBUGGER) $(WITH_OCAMLDOC) \
+         $(WITH_OCAMLTEST)
+ifeq "$(WITH_OCAMLDOC)-$(STDLIB_MANPAGES)" "ocamldoc-true"
+	$(MAKE) manpages
+endif
+
+# Bootstrap and rebuild the whole system.
+# The compilation of ocaml will fail if the runtime has changed.
+# Never mind, just do make bootstrap to reach fixpoint again.
+.PHONY: bootstrap
+bootstrap: coreboot
+	$(MAKE) all
+
+# Compile everything the first time
+
+.PHONY: world
+world: coldstart
+	$(MAKE) all
+
+# Compile also native code compiler and libraries, fast
+.PHONY: world.opt
+world.opt: checknative
+	$(MAKE) coldstart
+	$(MAKE) opt.opt
+
+# FlexDLL sources missing error messages
+# Different git mechanism displayed depending on whether this source tree came
+# from a git clone or a source tarball.
+
+flexdll/Makefile:
+	@echo In order to bootstrap FlexDLL, you need to place the sources in
+	@echo flexdll.
+	@echo This can either be done by downloading a source tarball from
+	@echo \  http://alain.frisch.fr/flexdll.html
+	@if [ -d .git ]; then \
+	  echo or by checking out the flexdll submodule with; \
+	  echo \  git submodule update --init; \
+	else \
+	  echo or by cloning the git repository; \
+	  echo \  git clone https://github.com/alainfrisch/flexdll.git; \
+	fi
+	@false
+
+.PHONY: flexdll
+flexdll: flexdll/Makefile flexlink
+	$(MAKE) -C flexdll \
+	     OCAML_CONFIG_FILE=../Makefile.config \
+             MSVC_DETECT=0 CHAINS=$(FLEXDLL_CHAIN) NATDYNLINK=false support
+
+# Bootstrapping flexlink - leaves a bytecode image of flexlink.exe in flexdll/
+.PHONY: flexlink
+flexlink: flexdll/Makefile
+	$(MAKE) -C runtime BOOTSTRAPPING_FLEXLINK=yes ocamlrun$(EXE)
+	cp runtime/ocamlrun$(EXE) boot/ocamlrun$(EXE)
+	$(MAKE) -C stdlib COMPILER=../boot/ocamlc \
+	                  $(filter-out *.cmi,$(LIBFILES))
+	cd stdlib && cp $(LIBFILES) ../boot/
+	$(MAKE) -C flexdll MSVC_DETECT=0 OCAML_CONFIG_FILE=../Makefile.config \
+	  CHAINS=$(FLEXDLL_CHAIN) NATDYNLINK=false \
+	  OCAMLOPT="../boot/ocamlrun ../boot/ocamlc -nostdlib -I ../boot" \
+	  flexlink.exe
+	$(MAKE) -C runtime clean
+	$(MAKE) partialclean
+
+.PHONY: flexlink.opt
+flexlink.opt:
+	cd flexdll && \
+	mv flexlink.exe flexlink && \
+	($(MAKE) OCAML_FLEXLINK="../boot/ocamlrun ./flexlink" MSVC_DETECT=0 \
+	           OCAML_CONFIG_FILE=../Makefile.config \
+	           OCAMLOPT="../ocamlopt.opt -nostdlib -I ../stdlib" \
+	           flexlink.exe || \
+	 (mv flexlink flexlink.exe && false)) && \
+	mv flexlink.exe flexlink.opt && \
+	mv flexlink flexlink.exe
+
+INSTALL_COMPLIBDIR=$(DESTDIR)$(COMPLIBDIR)
+INSTALL_FLEXDLLDIR=$(INSTALL_LIBDIR)/flexdll
+
+.PHONY: install-flexdll
+install-flexdll:
+	$(INSTALL_PROG) flexdll/flexlink.exe "$(INSTALL_BINDIR)/flexlink$(EXE)"
+ifneq "$(filter-out mingw,$(TOOLCHAIN))" ""
+	$(INSTALL_DATA) flexdll/default$(filter-out _i386,_$(ARCH)).manifest \
+    "$(INSTALL_BINDIR)/"
+endif
+	if test -n "$(wildcard flexdll/flexdll_*.$(O))" ; then \
+	  $(MKDIR) "$(INSTALL_FLEXDLLDIR)" ; \
+	  $(INSTALL_DATA) flexdll/flexdll_*.$(O) "$(INSTALL_FLEXDLLDIR)" ; \
+	fi
+
+# Installation
+.PHONY: install
+install:
+	$(MKDIR) "$(INSTALL_BINDIR)"
+	$(MKDIR) "$(INSTALL_LIBDIR)"
+	$(MKDIR) "$(INSTALL_STUBLIBDIR)"
+	$(MKDIR) "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	  VERSION \
+	  "$(INSTALL_LIBDIR)"
+	$(MAKE) -C runtime install
+	$(INSTALL_PROG) ocaml "$(INSTALL_BINDIR)/ocaml$(EXE)"
+ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
+	$(INSTALL_PROG) ocamlc "$(INSTALL_BINDIR)/ocamlc.byte$(EXE)"
+endif
+	$(MAKE) -C stdlib install
+ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
+	$(INSTALL_PROG) lex/ocamllex "$(INSTALL_BINDIR)/ocamllex.byte$(EXE)"
+endif
+	$(INSTALL_PROG) yacc/ocamlyacc$(EXE) "$(INSTALL_BINDIR)/ocamlyacc$(EXE)"
+	$(INSTALL_DATA) \
+	   utils/*.cmi \
+	   parsing/*.cmi \
+	   typing/*.cmi \
+	   bytecomp/*.cmi \
+	   file_formats/*.cmi \
+	   lambda/*.cmi \
+	   driver/*.cmi \
+	   toplevel/*.cmi \
+	   "$(INSTALL_COMPLIBDIR)"
+ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
+	$(INSTALL_DATA) \
+	   utils/*.cmt utils/*.cmti utils/*.mli \
+	   parsing/*.cmt parsing/*.cmti parsing/*.mli \
+	   typing/*.cmt typing/*.cmti typing/*.mli \
+	   file_formats/*.cmt file_formats/*.cmti file_formats/*.mli \
+	   lambda/*.cmt lambda/*.cmti lambda/*.mli \
+	   bytecomp/*.cmt bytecomp/*.cmti bytecomp/*.mli \
+	   driver/*.cmt driver/*.cmti driver/*.mli \
+	   toplevel/*.cmt toplevel/*.cmti toplevel/*.mli \
+	   "$(INSTALL_COMPLIBDIR)"
+endif
+	$(INSTALL_DATA) \
+	  compilerlibs/*.cma \
+	  "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	   $(BYTESTART) $(TOPLEVELSTART) \
+	   "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_PROG) expunge "$(INSTALL_LIBDIR)/expunge$(EXE)"
+	$(INSTALL_DATA) \
+	   toplevel/topdirs.cmi \
+	   "$(INSTALL_LIBDIR)"
+ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
+	$(INSTALL_DATA) \
+	   toplevel/topdirs.cmt toplevel/topdirs.cmti \
+           toplevel/topdirs.mli \
+	   "$(INSTALL_LIBDIR)"
+endif
+	$(MAKE) -C tools install
+ifeq "$(UNIX_OR_WIN32)" "unix" # Install manual pages only on Unix
+	$(MKDIR) "$(INSTALL_MANDIR)/man$(PROGRAMS_MAN_SECTION)"
+	-$(MAKE) -C man install
+endif
+	for i in $(OTHERLIBRARIES); do \
+	  $(MAKE) -C otherlibs/$$i install || exit $$?; \
+	done
+# Transitional: findlib 1.7.3 is confused if leftover num.cm? files remain
+# from an previous installation of OCaml before otherlibs/num was removed.
+	rm -f "$(INSTALL_LIBDIR)"/num.cm?
+# End transitional
+ifneq "$(WITH_OCAMLDOC)" ""
+	$(MAKE) -C ocamldoc install
+endif
+	if test -n "$(WITH_DEBUGGER)"; then \
+	  $(MAKE) -C debugger install; \
+	fi
+ifeq "$(UNIX_OR_WIN32)" "win32"
+	if test -n "$(FLEXDLL_SUBMODULE_PRESENT)"; then \
+	  $(MAKE) install-flexdll; \
+	fi
+endif
+	$(INSTALL_DATA) Makefile.config "$(INSTALL_LIBDIR)/Makefile.config"
+ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
+	if test -f ocamlopt; then $(MAKE) installopt; else \
+	   cd "$(INSTALL_BINDIR)"; \
+	   $(LN) ocamlc.byte$(EXE) ocamlc$(EXE); \
+	   $(LN) ocamllex.byte$(EXE) ocamllex$(EXE); \
+	fi
+else
+	if test -f ocamlopt; then $(MAKE) installopt; fi
+endif
+
+# Installation of the native-code compiler
+.PHONY: installopt
+installopt:
+	$(MAKE) -C runtime installopt
+ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
+	$(INSTALL_PROG) ocamlopt "$(INSTALL_BINDIR)/ocamlopt.byte$(EXE)"
+endif
+	$(MAKE) -C stdlib installopt
+	$(INSTALL_DATA) \
+	    middle_end/*.cmi \
+	    "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	    middle_end/closure/*.cmi \
+	    "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	    middle_end/flambda/*.cmi \
+	    "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	    middle_end/flambda/base_types/*.cmi \
+	    "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	    asmcomp/*.cmi \
+	    "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	    asmcomp/debug/*.cmi \
+	    "$(INSTALL_COMPLIBDIR)"
+ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
+	$(INSTALL_DATA) \
+	    middle_end/*.cmt middle_end/*.cmti \
+	    middle_end/*.mli \
+	    "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	    middle_end/closure/*.cmt middle_end/closure/*.cmti \
+	    middle_end/closure/*.mli \
+	    "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	    middle_end/flambda/*.cmt middle_end/flambda/*.cmti \
+	    middle_end/flambda/*.mli \
+	    "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	    middle_end/flambda/base_types/*.cmt \
+            middle_end/flambda/base_types/*.cmti \
+	    middle_end/flambda/base_types/*.mli \
+	    "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	    asmcomp/*.cmt asmcomp/*.cmti \
+	    asmcomp/*.mli \
+	    "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	    asmcomp/debug/*.cmt asmcomp/debug/*.cmti \
+	    asmcomp/debug/*.mli \
+	    "$(INSTALL_COMPLIBDIR)"
+endif
+	$(INSTALL_DATA) \
+	    $(OPTSTART) \
+	    "$(INSTALL_COMPLIBDIR)"
+ifneq "$(WITH_OCAMLDOC)" ""
+	$(MAKE) -C ocamldoc installopt
+endif
+	for i in $(OTHERLIBRARIES); do \
+	  $(MAKE) -C otherlibs/$$i installopt || exit $$?; \
+	done
+ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
+	if test -f ocamlopt.opt ; then $(MAKE) installoptopt; else \
+	   cd "$(INSTALL_BINDIR)"; \
+	   $(LN) ocamlc.byte$(EXE) ocamlc$(EXE); \
+	   $(LN) ocamlopt.byte$(EXE) ocamlopt$(EXE); \
+	   $(LN) ocamllex.byte$(EXE) ocamllex$(EXE); \
+	fi
+else
+	if test -f ocamlopt.opt ; then $(MAKE) installoptopt; fi
+endif
+	$(MAKE) -C tools installopt
+	if test -f ocamlopt.opt -a -f flexdll/flexlink.opt ; then \
+	  $(INSTALL_PROG) \
+	    flexdll/flexlink.opt "$(INSTALL_BINDIR)/flexlink$(EXE)" ; \
+	fi
+
+.PHONY: installoptopt
+installoptopt:
+	$(INSTALL_PROG) ocamlc.opt "$(INSTALL_BINDIR)/ocamlc.opt$(EXE)"
+	$(INSTALL_PROG) ocamlopt.opt "$(INSTALL_BINDIR)/ocamlopt.opt$(EXE)"
+	$(INSTALL_PROG) \
+	  lex/ocamllex.opt "$(INSTALL_BINDIR)/ocamllex.opt$(EXE)"
+	cd "$(INSTALL_BINDIR)"; \
+	   $(LN) ocamlc.opt$(EXE) ocamlc$(EXE); \
+	   $(LN) ocamlopt.opt$(EXE) ocamlopt$(EXE); \
+	   $(LN) ocamllex.opt$(EXE) ocamllex$(EXE)
+	$(INSTALL_DATA) \
+	   utils/*.cmx parsing/*.cmx typing/*.cmx bytecomp/*.cmx \
+	   file_formats/*.cmx \
+	   lambda/*.cmx \
+	   driver/*.cmx asmcomp/*.cmx middle_end/*.cmx \
+           middle_end/closure/*.cmx \
+           middle_end/flambda/*.cmx \
+           middle_end/flambda/base_types/*.cmx \
+	   asmcomp/debug/*.cmx \
+          "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	   compilerlibs/*.cmxa compilerlibs/*.$(A) \
+	   "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	   $(BYTESTART:.cmo=.cmx) $(BYTESTART:.cmo=.$(O)) \
+	   $(OPTSTART:.cmo=.cmx) $(OPTSTART:.cmo=.$(O)) \
+	   "$(INSTALL_COMPLIBDIR)"
+	if test -f ocamlnat$(EXE) ; then \
+	  $(INSTALL_PROG) \
+	    ocamlnat$(EXE) "$(INSTALL_BINDIR)/ocamlnat$(EXE)"; \
+	  $(INSTALL_DATA) \
+	     toplevel/opttopdirs.cmi \
+	     "$(INSTALL_LIBDIR)"; \
+	  $(INSTALL_DATA) \
+	     $(OPTTOPLEVELSTART:.cmo=.cmx) $(OPTTOPLEVELSTART:.cmo=.$(O)) \
+	     "$(INSTALL_COMPLIBDIR)"; \
+	fi
+	cd "$(INSTALL_COMPLIBDIR)" && \
+	   $(RANLIB) ocamlcommon.$(A) ocamlbytecomp.$(A) ocamloptcomp.$(A)
+
+# Installation of the *.ml sources of compiler-libs
+.PHONY: install-compiler-sources
+install-compiler-sources:
+ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
+	$(INSTALL_DATA) \
+	   utils/*.ml parsing/*.ml typing/*.ml bytecomp/*.ml driver/*.ml \
+           file_formats/*.ml \
+           lambda/*.ml \
+	   toplevel/*.ml middle_end/*.ml middle_end/closure/*.ml \
+     middle_end/flambda/*.ml middle_end/flambda/base_types/*.ml \
+	   asmcomp/*.ml \
+	   asmcmp/debug/*.ml \
+	   "$(INSTALL_COMPLIBDIR)"
+endif
+
+# Run all tests
+
+.PHONY: tests
+tests:
+	$(MAKE) -C testsuite all
+
+# Make clean in the test suite
+
+.PHONY: clean
+clean::
+	$(MAKE) -C testsuite clean
+
+# Build the manual latex files from the etex source files
+# (see manual/README.md)
+.PHONY: manual-pregen
+manual-pregen: opt.opt
+	cd manual; $(MAKE) clean && $(MAKE) pregen-etex
+
+# The clean target
+clean:: partialclean
+
+# The bytecode compiler
+
+ocamlc: compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma $(BYTESTART)
+	$(CAMLC) $(LINKFLAGS) -compat-32 -o $@ $^
+
+partialclean::
+	rm -rf ocamlc
+
+# The native-code compiler
+
+ocamlopt: compilerlibs/ocamlcommon.cma compilerlibs/ocamloptcomp.cma \
+          $(OPTSTART)
+	$(CAMLC) $(LINKFLAGS) -o $@ $^
+
+partialclean::
+	rm -f ocamlopt
+
+# The toplevel
+
+ocaml_dependencies := \
+  compilerlibs/ocamlcommon.cma \
+  compilerlibs/ocamlbytecomp.cma \
+  compilerlibs/ocamltoplevel.cma $(TOPLEVELSTART)
+
+.INTERMEDIATE: ocaml.tmp
+ocaml.tmp: $(ocaml_dependencies)
+	$(CAMLC) $(LINKFLAGS) -linkall -o $@ $^
+
+ocaml: expunge ocaml.tmp
+	- $(CAMLRUN) $^ $@ $(PERVASIVES)
+
+partialclean::
+	rm -f ocaml
+
+.PHONY: runtop
+runtop:
+	$(MAKE) coldstart
+	$(MAKE) ocamlc
+	$(MAKE) otherlibraries
+	$(MAKE) ocaml
+	@rlwrap --help 2>/dev/null && $(EXTRAPATH) rlwrap $(RUNTOP) ||\
+	  $(EXTRAPATH) $(RUNTOP)
+
+.PHONY: natruntop
+natruntop:
+	$(MAKE) core
+	$(MAKE) opt
+	$(MAKE) ocamlnat
+	@rlwrap --help 2>/dev/null && $(EXTRAPATH) rlwrap $(NATRUNTOP) ||\
+	  $(EXTRAPATH) $(NATRUNTOP)
+
+# Native dynlink
+
+otherlibs/dynlink/dynlink.cmxa: otherlibs/dynlink/native/dynlink.ml
+	$(MAKE) -C otherlibs/dynlink allopt
+
+# The lexer
+
+parsing/lexer.ml: parsing/lexer.mll
+	$(CAMLLEX) $(OCAMLLEX_FLAGS) $<
+
+partialclean::
+	rm -f parsing/lexer.ml
+
+beforedepend:: parsing/lexer.ml
+
+# The bytecode compiler compiled with the native-code compiler
+
+ocamlc.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlbytecomp.cmxa \
+            $(BYTESTART:.cmo=.cmx)
+	$(CAMLOPT_CMD) $(LINKFLAGS) -o $@ $^ -cclib "$(BYTECCLIBS)"
+
+partialclean::
+	rm -f ocamlc.opt
+
+# The native-code compiler compiled with itself
+
+ocamlopt.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \
+              $(OPTSTART:.cmo=.cmx)
+	$(CAMLOPT_CMD) $(LINKFLAGS) -o $@ $^
+
+partialclean::
+	rm -f ocamlopt.opt
+
+# The predefined exceptions and primitives
+
+runtime/primitives:
+	$(MAKE) -C runtime primitives
+
+lambda/runtimedef.ml: lambda/generate_runtimedef.sh runtime/caml/fail.h \
+    runtime/primitives
+	$^ > $@
+
+partialclean::
+	rm -f lambda/runtimedef.ml
+
+beforedepend:: lambda/runtimedef.ml
+
+# Choose the right machine-dependent files
+
+asmcomp/arch.ml: asmcomp/$(ARCH)/arch.ml
+	cd asmcomp; $(LN) $(ARCH)/arch.ml .
+
+asmcomp/proc.ml: asmcomp/$(ARCH)/proc.ml
+	cd asmcomp; $(LN) $(ARCH)/proc.ml .
+
+asmcomp/selection.ml: asmcomp/$(ARCH)/selection.ml
+	cd asmcomp; $(LN) $(ARCH)/selection.ml .
+
+asmcomp/CSE.ml: asmcomp/$(ARCH)/CSE.ml
+	cd asmcomp; $(LN) $(ARCH)/CSE.ml .
+
+asmcomp/reload.ml: asmcomp/$(ARCH)/reload.ml
+	cd asmcomp; $(LN) $(ARCH)/reload.ml .
+
+asmcomp/scheduling.ml: asmcomp/$(ARCH)/scheduling.ml
+	cd asmcomp; $(LN) $(ARCH)/scheduling.ml .
+
+# Preprocess the code emitters
+
+asmcomp/emit.ml: asmcomp/$(ARCH)/emit.mlp tools/cvt_emit
+	echo \# 1 \"$(ARCH)/emit.mlp\" > $@
+	$(CAMLRUN) tools/cvt_emit < $< >> $@ \
+	|| { rm -f $@; exit 2; }
+
+partialclean::
+	rm -f asmcomp/emit.ml
+
+beforedepend:: asmcomp/emit.ml
+
+tools/cvt_emit: tools/cvt_emit.mll
+	$(MAKE) -C tools cvt_emit
+
+# The "expunge" utility
+
+expunge: compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma \
+         toplevel/expunge.cmo
+	$(CAMLC) $(LINKFLAGS) -o $@ $^
+
+partialclean::
+	rm -f expunge
+
+# The runtime system for the bytecode compiler
+
+.PHONY: runtime
+runtime: stdlib/libcamlrun.$(A)
+
+.PHONY: makeruntime
+makeruntime:
+	$(MAKE) -C runtime $(BOOT_FLEXLINK_CMD) all
+runtime/libcamlrun.$(A): makeruntime ;
+stdlib/libcamlrun.$(A): runtime/libcamlrun.$(A)
+	cd stdlib; $(LN) ../runtime/libcamlrun.$(A) .
+clean::
+	$(MAKE) -C runtime clean
+	rm -f stdlib/libcamlrun.a stdlib/libcamlrun.lib
+
+otherlibs_all := bigarray dynlink raw_spacetime_lib \
+  str systhreads unix win32unix
+subdirs := debugger lex ocamldoc ocamltest runtime stdlib tools \
+  $(addprefix otherlibs/, $(otherlibs_all)) \
+
+.PHONY: alldepend
+ifeq "$(TOOLCHAIN)" "msvc"
+alldepend:
+	$(error Dependencies cannot be regenerated using the MSVC ports)
+else
+alldepend: depend
+	for dir in $(subdirs); do \
+	  $(MAKE) -C $$dir depend || exit; \
+	done
+endif
+
+# The runtime system for the native-code compiler
+
+.PHONY: runtimeopt
+runtimeopt: stdlib/libasmrun.$(A)
+
+.PHONY: makeruntimeopt
+makeruntimeopt:
+	$(MAKE) -C runtime $(BOOT_FLEXLINK_CMD) allopt
+runtime/libasmrun.$(A): makeruntimeopt ;
+stdlib/libasmrun.$(A): runtime/libasmrun.$(A)
+	cp $< $@
+clean::
+	rm -f stdlib/libasmrun.a stdlib/libasmrun.lib
+
+# The standard library
+
+.PHONY: library
+library: ocamlc
+	$(MAKE) -C stdlib $(BOOT_FLEXLINK_CMD) all
+
+.PHONY: library-cross
+library-cross:
+	$(MAKE) -C stdlib $(BOOT_FLEXLINK_CMD) CAMLRUN=../runtime/ocamlrun all
+
+.PHONY: libraryopt
+libraryopt:
+	$(MAKE) -C stdlib $(BOOT_FLEXLINK_CMD) allopt
+
+partialclean::
+	$(MAKE) -C stdlib clean
+
+# The lexer and parser generators
+
+.PHONY: ocamllex
+ocamllex: ocamlyacc
+	$(MAKE) -C lex all
+
+.PHONY: ocamllex.opt
+ocamllex.opt: ocamlopt
+	$(MAKE) -C lex allopt
+
+partialclean::
+	$(MAKE) -C lex clean
+
+.PHONY: ocamlyacc
+ocamlyacc:
+	$(MAKE) -C yacc $(BOOT_FLEXLINK_CMD) all
+
+clean::
+	$(MAKE) -C yacc clean
+
+# The Menhir-generated parser
+
+# In order to avoid a build-time dependency on Menhir,
+# we store the result of the parser generator (which
+# are OCaml source files) and Menhir's runtime libraries
+# (that the parser files rely on) in boot/.
+
+# The rules below do not depend on Menhir being available,
+# they just build the parser from boot/.
+
+# See Makefile.menhir for the rules to rebuild the parser and update
+# boot/, which require Menhir. The targets in Makefile.menhir
+# (also included here for convenience) must be used after any
+# modification of parser.mly.
+include Makefile.menhir
+
+# To avoid module-name conflicts with compiler-lib users that link
+# with their code with their own MenhirLib module (possibly with
+# a different Menhir version), we rename MenhirLib into
+# CamlinternalMenhirlib -- and replace the module occurrences in the
+# generated parser.ml.
+
+parsing/camlinternalMenhirLib.ml: boot/menhir/menhirLib.ml
+	cp $< $@
+parsing/camlinternalMenhirLib.mli: boot/menhir/menhirLib.mli
+	echo '[@@@ocaml.warning "-67"]' > $@
+	cat $< >> $@
+
+# Copy parsing/parser.ml from boot/
+
+parsing/parser.ml: boot/menhir/parser.ml parsing/parser.mly \
+  tools/check-parser-uptodate-or-warn.sh
+	@-tools/check-parser-uptodate-or-warn.sh
+	sed "s/MenhirLib/CamlinternalMenhirLib/g" $< > $@
+parsing/parser.mli: boot/menhir/parser.mli
+	sed "s/MenhirLib/CamlinternalMenhirLib/g" $< > $@
+
+beforedepend:: parsing/camlinternalMenhirLib.ml \
+  parsing/camlinternalMenhirLib.mli \
+	parsing/parser.ml parsing/parser.mli
+
+partialclean:: partialclean-menhir
+
+
+# OCamldoc
+
+.PHONY: ocamldoc
+ocamldoc: ocamlc ocamlyacc ocamllex otherlibraries
+	$(MAKE) -C ocamldoc all
+
+.PHONY: ocamldoc.opt
+ocamldoc.opt: ocamlc.opt ocamlyacc ocamllex
+	$(MAKE) -C ocamldoc opt.opt
+
+# OCamltest
+ocamltest: ocamlc ocamlyacc ocamllex
+	$(MAKE) -C ocamltest all
+
+ocamltest.opt: ocamlc.opt ocamlyacc ocamllex
+	$(MAKE) -C ocamltest allopt
+
+partialclean::
+	$(MAKE) -C ocamltest clean
+
+# Documentation
+
+.PHONY: html_doc
+html_doc: ocamldoc
+	$(MAKE) -C ocamldoc $@
+	@echo "documentation is in ./ocamldoc/stdlib_html/"
+
+.PHONY: manpages
+manpages:
+	$(MAKE) -C ocamldoc $@
+
+partialclean::
+	$(MAKE) -C ocamldoc clean
+
+# The extra libraries
+
+.PHONY: otherlibraries
+otherlibraries: ocamltools
+	$(MAKE) -C otherlibs all
+
+.PHONY: otherlibrariesopt
+otherlibrariesopt:
+	$(MAKE) -C otherlibs allopt
+
+partialclean::
+	$(MAKE) -C otherlibs partialclean
+
+clean::
+	$(MAKE) -C otherlibs clean
+
+# The replay debugger
+
+.PHONY: ocamldebugger
+ocamldebugger: ocamlc ocamlyacc ocamllex otherlibraries
+	$(MAKE) -C debugger all
+
+partialclean::
+	$(MAKE) -C debugger clean
+
+# Check that the native-code compiler is supported
+.PHONY: checknative
+checknative:
+ifeq "$(ARCH)" "none"
+checknative:
+	$(error The native-code compiler is not supported on this platform)
+else
+	@
+endif
+
+# Check that the stack limit is reasonable (Unix-only)
+.PHONY: checkstack
+checkstack:
+ifeq "$(UNIX_OR_WIN32)" "unix"
+	if $(MKEXE) $(OUTPUTEXE)tools/checkstack$(EXE) tools/checkstack.c; \
+	  then tools/checkstack$(EXE); \
+	fi
+	rm -f tools/checkstack$(EXE)
+else
+	@
+endif
+
+# Lint @since and @deprecated annotations
+
+VERSIONS=$(shell git tag|grep '^[0-9]*.[0-9]*.[0-9]*$$'|grep -v '^[12].')
+.PHONY: lintapidiff
+lintapidiff:
+	$(MAKE) -C tools lintapidiff.opt
+	git ls-files -- 'otherlibs/*/*.mli' 'stdlib/*.mli' |\
+	    grep -Ev internal\|obj\|spacetime\|stdLabels\|moreLabels |\
+	    tools/lintapidiff.opt $(VERSIONS)
+
+# Tools
+
+.PHONY: ocamltools
+ocamltools: ocamlc ocamllex compilerlibs/ocamlmiddleend.cma
+	$(MAKE) -C tools all
+
+.PHONY: ocamltoolsopt
+ocamltoolsopt: ocamlopt
+	$(MAKE) -C tools opt
+
+.PHONY: ocamltoolsopt.opt
+ocamltoolsopt.opt: ocamlc.opt ocamllex.opt compilerlibs/ocamlmiddleend.cmxa
+	$(MAKE) -C tools opt.opt
+
+partialclean::
+	$(MAKE) -C tools clean
+
+## Test compilation of backend-specific parts
+
+partialclean::
+	rm -f $(ARCH_SPECIFIC)
+
+beforedepend:: $(ARCH_SPECIFIC)
+
+# This rule provides a quick way to check that machine-dependent
+# files compiles fine for a foreign architecture (passed as ARCH=xxx).
+
+.PHONY: check_arch
+check_arch:
+	@echo "========= CHECKING asmcomp/$(ARCH) =============="
+	@rm -f $(ARCH_SPECIFIC) asmcomp/emit.ml asmcomp/*.cm*
+	@$(MAKE) compilerlibs/ocamloptcomp.cma \
+	            >/dev/null
+	@rm -f $(ARCH_SPECIFIC) asmcomp/emit.ml asmcomp/*.cm*
+
+.PHONY: check_all_arches
+check_all_arches:
+ifeq ($(ARCH64),true)
+	@STATUS=0; \
+	 for i in $(ARCHES); do \
+	   $(MAKE) --no-print-directory check_arch ARCH=$$i || STATUS=1; \
+	 done; \
+	 exit $$STATUS
+else
+	 @echo "Architecture tests are disabled on 32-bit platforms."
+endif
+
+# The native toplevel
+
+# When the native toplevel executable has an extension (e.g. ".exe"),
+# provide a phony 'ocamlnat' synonym
+
+ifneq ($(EXE),)
+.PHONY: ocamlnat
+ocamlnat: ocamlnat$(EXE)
+endif
+
+ocamlnat$(EXE): compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \
+    compilerlibs/ocamlbytecomp.cmxa \
+    otherlibs/dynlink/dynlink.cmxa \
+    compilerlibs/ocamlopttoplevel.cmxa \
+    $(OPTTOPLEVELSTART:.cmo=.cmx)
+	$(CAMLOPT_CMD) $(LINKFLAGS) -linkall -o $@ $^
+
+partialclean::
+	rm -f ocamlnat ocamlnat.exe
+
+toplevel/opttoploop.cmx: otherlibs/dynlink/dynlink.cmxa
+
+# The numeric opcodes
+
+bytecomp/opcodes.ml: runtime/caml/instruct.h tools/make_opcodes
+	runtime/ocamlrun tools/make_opcodes -opcodes < $< > $@
+
+bytecomp/opcodes.mli: bytecomp/opcodes.ml
+	$(CAMLC) -i $< > $@
+
+tools/make_opcodes: tools/make_opcodes.mll
+	$(MAKE) -C tools make_opcodes
+
+partialclean::
+	rm -f bytecomp/opcodes.ml
+	rm -f bytecomp/opcodes.mli
+
+beforedepend:: bytecomp/opcodes.ml bytecomp/opcodes.mli
+
+ifneq "$(wildcard .git)" ""
+include Makefile.dev
+endif
+
+# Default rules
+
+.SUFFIXES: .ml .mli .cmo .cmi .cmx
+
+.ml.cmo:
+	$(CAMLC) $(COMPFLAGS) -c $<
+
+.mli.cmi:
+	$(CAMLC) $(COMPFLAGS) -c $<
+
+.ml.cmx:
+	$(CAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) -c $<
+
+partialclean::
+	for d in utils parsing typing bytecomp asmcomp middle_end file_formats \
+           lambda middle_end/closure middle_end/flambda \
+           middle_end/flambda/base_types asmcomp/debug \
+           driver toplevel tools; do \
+	  rm -f $$d/*.cm[ioxt] $$d/*.cmti $$d/*.annot $$d/*.s $$d/*.asm \
+	    $$d/*.o $$d/*.obj $$d/*.so $$d/*.dll; \
+	done
+
+.PHONY: depend
+depend: beforedepend
+	(for d in utils parsing typing bytecomp asmcomp middle_end \
+         lambda file_formats middle_end/closure middle_end/flambda \
+         middle_end/flambda/base_types asmcomp/debug \
+         driver toplevel; \
+         do $(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) $$d/*.mli $$d/*.ml || exit; \
+         done) > .depend
+
+.PHONY: distclean
+distclean: clean
+	rm -f boot/ocamlrun boot/ocamlrun boot/ocamlrun.exe boot/camlheader \
+	boot/*.cm* boot/libcamlrun.a boot/libcamlrun.lib boot/ocamlc.opt
+	rm -f Makefile.config Makefile.common runtime/caml/m.h runtime/caml/s.h
+	rm -rf autom4te.cache
+	rm -f config.log config.status libtool
+	rm -f tools/eventlog_metadata
+	rm -f tools/*.bak
+	rm -f ocaml ocamlc
+	rm -f testsuite/_log*
+
+include .depend
+
+
+ifneq "$(strip $(CAN_BE_UNCONFIGURED))" ""
+Makefile.config Makefile.common: config.status
+
+config.status:
+	@echo "Please refer to the installation instructions:"
+	@echo "- In file INSTALL for Unix systems."
+	@echo "- In file README.win32.adoc for Windows systems."
+	@echo "On Unix systems, if you've just unpacked the distribution,"
+	@echo "something like"
+	@echo "	./configure"
+	@echo "	make"
+	@echo "	make install"
+	@echo "should work."
+	@false
+endif
diff --git a/Makefile.best_binaries b/Makefile.best_binaries
new file mode 100644
index 00000000..d9f4ec7b
--- /dev/null
+++ b/Makefile.best_binaries
@@ -0,0 +1,46 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Gabriel Scherer, projet Parsifal, INRIA Saclay              *
+#*                                                                        *
+#*   Copyright 2019 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 Makefile should be included.
+
+# It expects:
+# - Makefile.common to be included as well
+# - a ROOTDIR variable pointing to the repository root
+#   relative to the including Makefile
+
+# It exports definitions of BEST_OCAML{C,OPT,LEX,DEP} commands that
+# run to either the bytecode binary built in the repository or the
+# native binary, if available. Note that they never use the boot/
+# versions: we assume that ocamlc, ocamlopt, etc. have been run first.
+
+check_not_stale = \
+  $(if $(shell test $(ROOTDIR)/$1 -nt $(ROOTDIR)/$2 && echo stale), \
+    $(info Warning: we are not using the native binary $2 \
+because it is older than the bytecode binary $1; \
+you should silence this warning by either removing $2 \
+or rebuilding it (or `touch`-ing it) if you want it used.), \
+    ok)
+
+choose_best = $(strip $(if \
+   $(and $(wildcard $(ROOTDIR)/$1.opt),$(strip \
+      $(call check_not_stale,$1,$1.opt))), \
+    $(ROOTDIR)/$1.opt, \
+    $(CAMLRUN) $(ROOTDIR)/$1))
+
+BEST_OCAMLC := $(call choose_best,ocamlc)
+BEST_OCAMLOPT := $(call choose_best,ocamlopt)
+BEST_OCAMLLEX := $(call choose_best,lex/ocamllex)
+
+BEST_OCAMLDEP := $(BEST_OCAMLC) -depend
diff --git a/Makefile.common.in b/Makefile.common.in
new file mode 100644
index 00000000..4087e4ba
--- /dev/null
+++ b/Makefile.common.in
@@ -0,0 +1,82 @@
+# @configure_input@
+
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Gabriel Scherer, projet Parsifal, INRIA Saclay              *
+#*                                                                        *
+#*   Copyright 2018 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 makefile contains common definitions and rules shared by
+# other Makefiles
+# We assume that Makefile.config has already been included
+
+INSTALL ?= @INSTALL@
+INSTALL_DATA ?= $(INSTALL) -m u=rw,g=rw,o=r
+INSTALL_PROG ?= $(INSTALL) -m u=rwx,g=rwx,o=rx
+
+# note: these are defined by lazy expansions
+# as some parts of the makefiles change BINDIR, etc.
+# and expect INSTALL_BINDIR, etc. to stay in synch
+# (see `shellquote` in tools/Makefile)
+DESTDIR ?=
+INSTALL_BINDIR = $(DESTDIR)$(BINDIR)
+INSTALL_LIBDIR = $(DESTDIR)$(LIBDIR)
+INSTALL_STUBLIBDIR = $(DESTDIR)$(STUBLIBDIR)
+INSTALL_MANDIR = $(DESTDIR)$(MANDIR)
+
+ifeq "$(UNIX_OR_WIN32)" "win32"
+FLEXDLL_SUBMODULE_PRESENT := $(wildcard $(ROOTDIR)/flexdll/Makefile)
+else
+FLEXDLL_SUBMODULE_PRESENT =
+endif
+
+# Use boot/ocamlc.opt if available
+CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
+ifeq (0,$(shell \
+  test $(ROOTDIR)/boot/ocamlc.opt -nt $(ROOTDIR)/boot/ocamlc; \
+  echo $$?))
+  BOOT_OCAMLC = $(ROOTDIR)/boot/ocamlc.opt
+else
+  BOOT_OCAMLC = $(CAMLRUN) $(ROOTDIR)/boot/ocamlc
+endif
+
+ifeq "$(FLEXDLL_SUBMODULE_PRESENT)" ""
+  FLEXLINK_ENV =
+  CAMLOPT_CMD = $(CAMLOPT)
+  OCAMLOPT_CMD = $(OCAMLOPT)
+  MKLIB_CMD = $(MKLIB)
+  ocamlc_cmd = $(ocamlc)
+  ocamlopt_cmd = $(ocamlopt)
+else
+  FLEXLINK_ENV = \
+    OCAML_FLEXLINK="$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/flexdll/flexlink.exe"
+  CAMLOPT_CMD = $(FLEXLINK_ENV) $(CAMLOPT)
+  OCAMLOPT_CMD = $(FLEXLINK_ENV) $(OCAMLOPT)
+  MKLIB_CMD = $(FLEXLINK_ENV) $(MKLIB)
+  ocamlc_cmd = $(FLEXLINK_ENV) $(ocamlc)
+  ocamlopt_cmd = $(FLEXLINK_ENV) $(ocamlopt)
+endif
+
+OPTCOMPFLAGS=
+ifeq "$(FUNCTION_SECTIONS)" "true"
+OPTCOMPFLAGS += -function-sections
+endif
+# By default, request ocamllex to be quiet
+OCAMLLEX_FLAGS ?= -q
+
+# The rule to compile C files
+
+# This rule is similar to GNU make's implicit rule, except that it is more
+# general (it supports both .o and .obj)
+
+%.$(O): %.c
+	$(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $<
diff --git a/Makefile.config.in b/Makefile.config.in
new file mode 100644
index 00000000..fe9b2331
--- /dev/null
+++ b/Makefile.config.in
@@ -0,0 +1,288 @@
+# @configure_input@
+
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# The configuration Makefile
+
+## The EMPTY variable, used in other definitions
+EMPTY=
+
+## Arguments passed to the configure script
+
+CONFIGURE_ARGS=@CONFIGURE_ARGS@
+
+## Top build directory
+
+TOP_BUILDDIR = @top_builddir@
+
+## Installation directories
+
+prefix=@prefix@
+
+exec_prefix=@exec_prefix@
+
+### Where to install the binaries
+BINDIR=@bindir@
+
+datarootdir=@datarootdir@
+
+### Where to install the standard library
+LIBDIR=@libdir@
+
+### Where to install the stub code for the standard library
+STUBLIBDIR=@libdir@/stublibs
+
+### Where to install the man pages
+# Man pages for commands go in $(MANDIR)/man$(PROGRAMS_MAN_SECTION)
+# Man pages for the library go in $(MANDIR)/man/man$(LIBRARIES_MAN_SECTION)
+MANDIR=@mandir@
+PROGRAMS_MAN_SECTION=@programs_man_section@
+LIBRARIES_MAN_SECTION=@libraries_man_section@
+
+### Do #! scripts work on your system?
+### Beware: on some systems (e.g. SunOS 4), this will work only if
+### the string "#!$(BINDIR)/ocamlrun" is less than 32 characters long.
+### In doubt, set HASHBANGSCRIPTS to false.
+SHEBANGSCRIPTS=@shebangscripts@
+LONG_SHEBANG=@long_shebang@
+# For compatibility
+HASHBANGSCRIPTS:=$(SHEBANGSCRIPTS)
+
+### Path to the libtool script
+LIBTOOL = $(TOP_BUILDDIR)/libtool
+
+### Which C compiler to use
+TOOLPREF=@ac_tool_prefix@
+CC=@CC@
+
+CC_HAS_DEBUG_PREFIX_MAP=@cc_has_debug_prefix_map@
+AS_HAS_DEBUG_PREFIX_MAP=@as_has_debug_prefix_map@
+
+### Additional link-time options
+# To support dynamic loading of shared libraries (they need to look at
+# our own symbols):
+OC_LDFLAGS=@oc_ldflags@
+
+### How to invoke the C preprocessor through the C compiler
+CPP=@CPP@
+
+### How to invoke ranlib
+RANLIB=@RANLIB@
+RANLIBCMD=@RANLIBCMD@
+
+### How to invoke ar
+ARCMD=@AR@
+
+### Extension of object files
+O=@OBJEXT@
+EXT_OBJ=.@OBJEXT@
+
+### How to tell the C compiler to output an object file
+OUTPUTOBJ=@outputobj@
+
+### Extension of static libraries
+A=@libext@
+EXT_LIB=.@libext@
+
+### Extension of assembler files
+S=@S@
+EXT_ASM=.@S@
+
+### Extension for shared libraries
+SO=@SO@
+EXT_DLL=.@SO@
+
+SHAREDLIB_CFLAGS=@sharedlib_cflags@
+
+# Compile-time option to $(CC) to add a directory to be searched
+# at run-time for shared libraries
+RPATH=@rpath@
+
+############# Configuration for the native-code compiler
+
+### Whether the native compiler has been enabled or not
+NATIVE_COMPILER=@native_compiler@
+
+### Name of architecture for the native-code compiler
+### Currently supported:
+###
+### i386        Intel Pentium PCs under Linux, *BSD*, NextStep
+### power       Macintosh under Mac OS X and Linux
+### arm         ARM under Linux
+###
+### Set ARCH=none if your machine is not supported
+ARCH=@arch@
+
+# Whether the architecture has 64 bits
+ARCH64=@arch64@
+
+# Endianess for this architecture
+ENDIANNESS=@endianness@
+
+### Name of architecture model for the native-code compiler.
+### Some architectures come in several slightly different flavors
+### that share a common code generator. This variable tailors the
+### behavior of the code generator to the particular flavor used.
+### Currently needed only if ARCH=power; leave MODEL=default for
+### other architectures.
+### If ARCH=power: set MODEL=ppc
+### For other architectures: leave MODEL=default
+###
+MODEL=@model@
+
+### Name of operating system family for the native-code compiler.
+SYSTEM=@system@
+
+### Command and flags to use for assembling ocamlopt-generated code
+ASM=@AS@
+
+### Command and flags to use for assembling .S files (often with preprocessing)
+ASPP=@ASPP@
+
+### Set to "true" to install ".byte" executables (ocamlc.byte, etc.)
+INSTALL_BYTECODE_PROGRAMS=@install_bytecode_programs@
+
+############# Configuration for the contributed libraries
+
+### Which libraries to compile and install
+# Currently available:
+#       bigarray          Large, multidimensional numerical arrays
+#                           (legacy support: this library is now part of the
+#                            Standard Library)
+#       dynlink           Dynamic linking (bytecode and native)
+#       (win32)unix       Unix system calls
+#       str               Regular expressions and high-level string processing
+#       raw_spacetime_lib Parsing of spacetime traces
+#       systhreads        Same as threads, requires POSIX threads
+OTHERLIBRARIES=@otherlibraries@
+
+### Link-time options to ocamlc or ocamlopt for linking with POSIX threads
+# Needed for the "systhreads" package
+PTHREAD_LINK=@pthread_link@
+PTHREAD_CAML_LINK=$(addprefix -cclib ,$(PTHREAD_LINK))
+
+UNIX_OR_WIN32=@unix_or_win32@
+UNIXLIB=@unixlib@
+BFD_CPPFLAGS=@bfd_cppflags@
+BFD_LDFLAGS=@bfd_ldflags@
+BFD_LDLIBS=@bfd_ldlibs@
+INSTALL_SOURCE_ARTIFACTS=@install_source_artifacts@
+
+OC_CFLAGS=@oc_cflags@
+OC_CPPFLAGS=@oc_cppflags@
+OCAMLC_CFLAGS=@ocamlc_cflags@
+
+OCAMLC_CPPFLAGS=@ocamlc_cppflags@
+BYTECCLIBS=@bytecclibs@
+EXE=@exeext@
+OUTPUTEXE=@outputexe@
+SUPPORTS_SHARED_LIBRARIES=@supports_shared_libraries@
+MKSHAREDLIBRPATH=@mksharedlibrpath@
+DYNLINKOPTS=@DLLIBS@
+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@
+NATIVECCLIBS=@nativecclibs@
+SYSTHREAD_SUPPORT=@systhread_support@
+PACKLD=@PACKLD@
+IFLEXDIR=@iflexdir@
+EXTRALIBS=@extralibs@
+CCOMPTYPE=@ccomptype@
+TOOLCHAIN=@toolchain@
+CMXS=@cmxs@
+
+# On Windows, MKDLL, MKEXE and MKMAINDLL must ultimately be equivalent to
+#   $(FLEXLINK_CMD) $(FLEXLINK_FLAGS) [-exe|-maindll]
+# or OCAML_FLEXLINK overriding will not work (see utils/config.mlp)
+
+MKEXE=@mkexe@
+MKDLL=@mksharedlib@
+MKMAINDLL=@mkmaindll@
+
+MKEXEDEBUGFLAG=@mkexedebugflag@
+RUNTIMED=@debug_runtime@
+RUNTIMEI=@instrumented_runtime@
+WITH_DEBUGGER=@with_debugger@
+WITH_CAMLTEX=@with_camltex@
+WITH_OCAMLDOC=@ocamldoc@
+WITH_OCAMLTEST=@ocamltest@
+ASM_CFI_SUPPORTED=@asm_cfi_supported@
+WITH_FRAME_POINTERS=@frame_pointers@
+WITH_SPACETIME=@spacetime@
+ENABLE_CALL_COUNTS=@call_counts@
+WITH_PROFINFO=@profinfo@
+PROFINFO_WIDTH=@profinfo_width@
+LIBUNWIND_AVAILABLE=@libunwind_available@
+LIBUNWIND_INCLUDE_FLAGS=@libunwind_include_flags@
+LIBUNWIND_LINK_FLAGS=@libunwind_link_flags@
+WITH_FPIC=@fpic@
+TARGET=@target@
+HOST=@host@
+FLAMBDA=@flambda@
+WITH_FLAMBDA_INVARIANTS=@flambda_invariants@
+FORCE_SAFE_STRING=@force_safe_string@
+DEFAULT_SAFE_STRING=@default_safe_string@
+WINDOWS_UNICODE=@windows_unicode@
+AFL_INSTRUMENT=@afl@
+MAX_TESTSUITE_DIR_RETRIES=@max_testsuite_dir_retries@
+FLAT_FLOAT_ARRAY=@flat_float_array@
+FUNCTION_SECTIONS=@function_sections@
+AWK=@AWK@
+STDLIB_MANPAGES=@stdlib_manpages@
+
+
+### Native command to build ocamlrun.exe
+
+ifeq "$(TOOLCHAIN)" "msvc"
+  MERGEMANIFESTEXE=test ! -f $(1).manifest \
+          || mt -nologo -outputresource:$(1) -manifest $(1).manifest \
+          && rm -f $(1).manifest
+  MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(OUTPUTEXE)$(1) $(2) \
+    /link /subsystem:console $(OC_LDFLAGS) && ($(MERGEMANIFESTEXE))
+else
+  MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(OC_LDFLAGS) $(OUTPUTEXE)$(1) $(2)
+endif # ifeq "$(TOOLCHAIN)" "msvc"
+
+# The following variables were defined only in the Windows-specific makefiles.
+# They were not defined by the configure script used on Unix systems,
+# so we also make sure to provide them only under Windows
+# User code should absolutely not rely on their presence because
+# in the future their definition may be moved to a more private part of
+# the compiler's build system
+ifeq "$(UNIX_OR_WIN32)" "win32"
+  OTOPDIR=$(WINTOPDIR)
+  CTOPDIR=$(WINTOPDIR)
+  CYGPATH=cygpath -m
+  DIFF=/usr/bin/diff -q --strip-trailing-cr
+  FIND=/usr/bin/find
+  SORT=/usr/bin/sort
+  SET_LD_PATH=PATH="$(PATH):$(LD_PATH)"
+  FLEXLINK_CMD=flexlink
+  MKEXE_ANSI=$(FLEXLINK) -exe
+  FLEXDLL_CHAIN=@flexdll_chain@
+  # FLEXLINK_FLAGS must be safe to insert in an OCaml string
+  #   (see ocamlmklibconfig.ml in tools/Makefile)
+  FLEXLINK_FLAGS=@flexlink_flags@
+  FLEXLINK=$(FLEXLINK_CMD) $(FLEXLINK_FLAGS)
+else # ifeq "$(UNIX_OR_WIN32)" "win32"
+  # On Unix, make sure FLEXLINK is defined but empty
+  FLEXLINK =
+endif # ifeq "$(UNIX_OR_WIN32)" "win32"
diff --git a/Makefile.dev b/Makefile.dev
new file mode 100644
index 00000000..90a69dec
--- /dev/null
+++ b/Makefile.dev
@@ -0,0 +1,48 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Gabriel Scherer, projet Parsifal, INRIA Saclay              *
+#*                                                                        *
+#*   Copyright 2018 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.          *
+#*                                                                        *
+#**************************************************************************
+
+# Developer-only rules, included in Makefile when a Git repository is detected.
+
+# Testing the parser -- see parsing/HACKING.adoc
+
+SOURCE_FILES=$(shell git ls-files '*.ml' '*.mli' | grep -v boot/menhir/parser)
+
+AST_FILES=$(addsuffix .ast,$(SOURCE_FILES))
+
+build-all-asts:
+# Recursive invocation ensures that `git ls-files` is not executed on every
+# invocation of make
+	@$(MAKE) --no-print-directory $(AST_FILES)
+
+CAMLC_DPARSETREE := \
+	$(CAMLRUN) ./ocamlc -nostdlib -nopervasives \
+	  -stop-after parsing -dparsetree
+
+%.ml.ast: %.ml ocamlc
+	$(CAMLC_DPARSETREE) $< 2> $@ || exit 0
+# `|| exit 0` : some source files will fail to parse
+# (for example, they are meant as toplevel scripts
+# rather than source files, or are parse-error tests),
+# we ignore the failure in that case
+
+%.mli.ast: %.mli ocamlc
+	$(CAMLC_DPARSETREE) $< 2> $@ || exit 0
+
+.PHONY: list-all-asts
+list-all-asts:
+	@for f in $(AST_FILES); do echo "'$$f'"; done
+
+partialclean::
+	@rm -f $(AST_FILES)
diff --git a/Makefile.menhir b/Makefile.menhir
new file mode 100644
index 00000000..c2068d23
--- /dev/null
+++ b/Makefile.menhir
@@ -0,0 +1,163 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Gabriel Scherer, projet Parsifal, INRIA Saclay              *
+#*                                                                        *
+#*   Copyright 2018 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.          *
+#*                                                                        *
+#**************************************************************************
+
+# The rules in this Makefile use Menhir to rebuild the OCaml compiler
+# parser. They are included in the main Makefile, so should be invoked
+# directly, for example 'make promote-menhir'. They must be called
+# after any modification to parsing/parser.mly, for the modification
+# to affect the parser linked in the produced compiler:
+#
+# - promote-menhir builds the parser from parser.mly and stores it in
+#   the boot/ directory, so that future builds of the compiler use the
+#   updated result. Use it to make permanent changes to the compiler
+#   parser.
+#
+# - demote-menhir undoes the effect of promote-menhir. The files in
+#   the boot/ directory that are affected by promote-menhir and are
+#   under version control are restored to their normal state (HEAD).
+#
+# - test-menhir builds the parser from parser.mly without storing it
+#   in the boot/ directory, and only checks that the generated parser
+#   builds correctly. Use it to quickly check if a parser.mly change
+#   breaks the build. If you want to test a compiler produced with
+#   the new parser, you must use promote-menhir instead.
+#   (Using this rule requires a partial compiler build as obtained
+#    by 'make core' or 'make world'.)
+#
+# - clean-menhir removes the files generated by Menhir from parsing/,
+#   keeping only the reference sources for the grammar.
+#
+# - depend-menhir updates the dependency information for the
+#   Menhir-generated parser, which is versioned in the OCaml repository
+#   like all other .depend files. It should be used when the dependencies
+#   (of the OCaml code in the grammar semantic actions) change.
+
+MENHIR ?= menhir
+
+## Unused tokens
+
+# tokens COMMENT, DOCSTRING and EOL are produced by special lexer
+# modes used by other consumers than the parser.
+
+# GREATERBRACKET ">]" was added by the parser by symmetry with "[<"
+# (which is used in polymorphic variant), but is not currently used by
+# the grammar.
+
+unused_tokens := COMMENT DOCSTRING EOL GREATERRBRACKET
+
+## Menhir compilation flags
+
+MENHIRFLAGS := --explain --dump --ocamlc "$(CAMLC) $(COMPFLAGS)" --infer \
+	--lalr --strict --table -lg 1 -la 1 \
+        $(addprefix --unused-token ,$(unused_tokens)) --fixed-exception
+
+## promote-menhir
+
+.PHONY: promote-menhir
+promote-menhir: parsing/parser.mly
+	@ $(MAKE) import-menhirLib
+	$(MENHIR) $(MENHIRFLAGS) parsing/parser.mly
+# The generated parser.ml may contain lexer directives containing
+# the absolute path to Menhir's standard library on the promoter's machine.
+# This is benign but will generate pointless churn if another developer
+# rebuilds the same grammar (from the same Menhir version).
+	@ for f in $(addprefix parser.,ml mli) ; do \
+	  sed \
+	    's,^#\(.*\)"[^"]*/menhir/standard.mly",#\1"menhir/standard.mly",g' \
+	    parsing/$$f \
+	    > boot/menhir/$$f; \
+	  rm parsing/$$f; \
+	done
+
+# The import-menhirLib invocation in promote-menhir ensures that each
+# update of the boot/ parser is paired with an update of the imported
+# menhirLib; otherwise it would be easy to generate a parser and keep
+# an incompatible version of menhirLib, which would fail at
+# compile-time.
+
+.PHONY: import-menhirLib
+import-menhirLib:
+	@ mkdir -p boot/menhir
+	@ cp \
+           $(addprefix `$(MENHIR) --suggest-menhirLib`/menhirLib.,ml mli) \
+           boot/menhir
+
+
+## demote-menhir
+
+DEMOTE:=menhirLib.ml menhirLib.mli parser.ml parser.mli
+
+.PHONY: demote-menhir
+demote-menhir:
+	git checkout HEAD -- $(addprefix boot/menhir/,$(DEMOTE))
+
+## test-menhir
+
+# This rule assumes that the `parsing/` sources and its dependencies
+# have already been compiled; 'make core' suffices to be in that
+# state. We don't make 'core' an explicit dependency, as building
+# 'test-menhir' repeatedly would rebuild the compiler each time
+# (parser.ml has changed), without actually taking the changes from
+# parser.mly into account ('core' uses the parser from boot/).
+
+# The test-menhir target does not read or write the boot directory,
+# it directly builds the parser in parsing/. In particular, it must
+# duplicate the MenhirLib->CamlinternalMenhirlib renaming usually
+# performed by the parsing/parser.ml import rule in the main
+# Makefile.
+.PHONY: test-menhir
+test-menhir: parsing/parser.mly
+	$(MENHIR) $(MENHIRFLAGS) parsing/parser.mly
+	for f in $(addprefix parsing/parser.,ml mli) ; do \
+	  cat $$f | sed "s/MenhirLib/CamlinternalMenhirLib/g" > $$f.tmp && \
+	  mv $$f.tmp $$f ; \
+	done
+	$(MAKE) parsing/parser.cmo
+
+
+## clean-menhir
+
+partialclean-menhir::
+	rm -f \
+	  $(addprefix parsing/parser.,ml mli) \
+	  $(addprefix parsing/camlinternalMenhirLib.,ml mli)
+
+clean-menhir: partialclean-menhir
+
+
+## depend-menhir
+
+.PHONY: depend-menhir
+depend-menhir:
+	$(MENHIR) --depend --ocamldep "$(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES)" \
+          parsing/parser.mly > .depend.menhir
+# this rule depends on the variables CAMLDEP, DEPFLAGS, DEPINCLUDES
+# defined in Makefile, so it can only be invoked from the main Makefile
+
+include .depend.menhir
+
+## interpret-menhir
+
+# This rule runs Menhir in interactive mode.
+# The user can enter sentences, such as:
+#   implementation: TYPE LIDENT EQUAL LIDENT EOF
+# and see how Menhir interprets them.
+
+interpret-menhir:
+	@ echo "Please wait, I am building the LALR automaton..."
+	@ $(MENHIR) $(MENHIRFLAGS) parsing/parser.mly \
+	    --interpret \
+	    --interpret-show-cst \
+	    --trace \
diff --git a/Makefile.tools b/Makefile.tools
new file mode 100644
index 00000000..49f4d2f6
--- /dev/null
+++ b/Makefile.tools
@@ -0,0 +1,108 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                 Xavier Clerc, SED, INRIA Rocquencourt                  *
+#*                                                                        *
+#*   Copyright 2010 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# This makefile provides variables for using the in-tree compiler,
+# interpreter, lexer and other associated tools. It is intended to be
+# included within other makefiles.
+# See manual/tools/Makefile and manual/manual/tutorials/Makefile as examples.
+# Note that these makefile should define the $(TOPDIR) variable on their
+# own.
+
+WINTOPDIR=`cygpath -m "$(TOPDIR)"`
+
+# TOPDIR is the root directory of the OCaml sources, in Unix syntax.
+# WINTOPDIR is the same directory, in Windows syntax.
+
+OTOPDIR=$(TOPDIR)
+CTOPDIR=$(TOPDIR)
+CYGPATH=echo
+DIFF=diff -q
+SORT=sort
+SET_LD_PATH=CAML_LD_LIBRARY_PATH="$(LD_PATH)"
+
+# The variables above may be overridden by .../Makefile.config
+# OTOPDIR is either TOPDIR or WINTOPDIR, whichever is appropriate for
+#   arguments given to the OCaml compiler.
+# CTOPDIR is either TOPDIR or WINTOPDIR, whichever is appropriate for
+#   arguments given to the C and Fortran compilers.
+# CYGPATH is the command that translates unix-style file names into
+#   whichever syntax is appropriate for arguments of OCaml programs.
+# DIFF is a "diff -q" command that ignores trailing CRs under Windows.
+# SORT is the Unix "sort" command. Usually a simple command, but may be an
+#   absolute name if the Windows "sort" command is in the PATH.
+# SET_LD_PATH is a command prefix that sets the path for dynamic libraries
+#   (CAML_LD_LIBRARY_PATH for Unix, PATH for Windows) using the LD_PATH shell
+#   variable. Note that for Windows we add Unix-syntax directory names in
+#   PATH, and Cygwin will translate it to Windows syntax.
+
+-include $(TOPDIR)/Makefile.config
+
+# Make sure USE_RUNTIME is defined
+USE_RUNTIME ?=
+
+ifneq ($(USE_RUNTIME),)
+#Check USE_RUNTIME value
+ifeq ($(findstring $(USE_RUNTIME),d i),)
+$(error If set, USE_RUNTIME must be equal to "d" (debug runtime) \
+        or "i" (instrumented runtime))
+endif
+
+RUNTIME_VARIANT=-I $(OTOPDIR)/runtime \
+                -runtime-variant $(USE_RUNTIME)
+export OCAMLRUNPARAM?=v=0
+endif
+
+OCAMLRUN=$(TOPDIR)/runtime/ocamlrun$(USE_RUNTIME)$(EXE)
+
+OCFLAGS=-nostdlib -I $(OTOPDIR)/stdlib $(COMPFLAGS)
+OCOPTFLAGS=
+
+ifeq ($(SUPPORTS_SHARED_LIBRARIES),false)
+  CUSTOM = -custom
+else
+  CUSTOM =
+endif
+
+OCAML=$(OCAMLRUN) $(OTOPDIR)/ocaml $(OCFLAGS) -noinit
+ifeq "$(FLEXLINK)" ""
+  FLEXLINK_PREFIX=
+else
+  ifeq "$(wildcard $(TOPDIR)/flexdll/Makefile)" ""
+    FLEXLINK_PREFIX=
+  else
+    EMPTY=
+    FLEXLINK_PREFIX=OCAML_FLEXLINK="$(WINTOPDIR)/boot/ocamlrun \
+	                            $(WINTOPDIR)/flexdll/flexlink.exe" $(EMPTY)
+  endif
+endif
+OCAMLC=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlc $(CUSTOM) $(OCFLAGS) \
+       $(RUNTIME_VARIANT)
+OCAMLOPT=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlopt $(OCFLAGS) \
+         $(RUNTIME_VARIANT)
+OCAMLDOC=$(OCAMLRUN) $(OTOPDIR)/ocamldoc/ocamldoc
+OCAMLLEX=$(OCAMLRUN) $(OTOPDIR)/lex/ocamllex
+OCAMLMKLIB=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/tools/ocamlmklib \
+           -ocamlc "$(OTOPDIR)/runtime/ocamlrun$(USE_RUNTIME)$(EXE) \
+                    $(OTOPDIR)/ocamlc $(OCFLAGS) $(RUNTIME_VARIANT)" \
+           -ocamlopt "$(OTOPDIR)/runtime/ocamlrun$(USE_RUNTIME)$(EXE) \
+                      $(OTOPDIR)/ocamlopt $(OCFLAGS) $(RUNTIME_VARIANT)"
+OCAMLYACC=$(TOPDIR)/yacc/ocamlyacc$(EXE)
+DUMPOBJ=$(OCAMLRUN) $(OTOPDIR)/tools/dumpobj
+OBJINFO=$(OCAMLRUN) $(OTOPDIR)/tools/ocamlobjinfo
+
+#FORTRAN_COMPILER=
+#FORTRAN_LIBRARY=
+
+UNIXLIBVAR=`case "$(OTHERLIBRARIES)" in *win32unix*) echo win32;; esac`
diff --git a/News b/News
new file mode 100644
index 00000000..79f3f72f
--- /dev/null
+++ b/News
@@ -0,0 +1,180 @@
+OCaml 4.07.1 (4 October 2018)
+-----------------------------
+
+This release consists mostly of bug fixes. The most salient bugs were
+
+- MPR#7820, GPR#1897: a bug in Array.of_seq (new in 4.07)
+  (Thierry Martinez, review by Nicolás Ojeda Bär)
+
+- MPR#7815, GPR#1896: crash in the major GC with the first-fit policy
+  (Stephen Dolan and Damien Doligez, report by Joris Giovannangeli)
+
+- MPR#7821, GPR#1908: the compiler loads more cmi, which breaks some builds
+  (Jérémie Dimino, review by Gabriel Scherer)
+
+- MPR#7833, GPR#1946: typechecking failure (regression) on large GADT matchings
+  (Thomas Refis, report by Jerome Simeon, review by Jacques Garrigue)
+
+See the detailed list of fixes at (Changes#4.07.1).
+
+
+OCaml 4.07.0 (10 July 2018):
+----------------------------
+
+Some highlights of this release are:
+
+-   The way the standard library modules are organized internally has
+    changed (GPR#1010, by Jérémie Dimino):
+
+    1. the `List` module (for example) is now named `Stdlib__list`
+    2. a new Stdlib module contains a series of aliases
+    such as `module List = Stdlib__list`
+    3. the `Stdlib` module is implicitly opened when type-checking OCaml
+    programs (as `Pervasives` previously was), so that `Stdlib.List` can be
+    accessed as just `List`, as before.
+
+    This should be invisible to most users, although it is possible that
+    some tools show the `Stdlib.` or `Stdlib__` prefixes in
+    messages. (You might want to report these situations as usability
+    bugs.) The change prevents standard library modules from conflicting
+    with end-user filenames (please avoid `stdlib.ml` and the
+    `Stdlib__` prefix); we may introduce new standard library modules in
+    the future with less fear of breaking user code. In particular,
+    `Float` (GPR#1638, by Nicolás Ojeda Bär) and `Seq` (GPR#1002, by
+    Simon Cruanes) modules have now been added to the standard library.
+
+-   The error messages caused by various typing errors have been improved
+    to be easier to understand, in particular for beginners.
+    (GPR#1505, GPR#1510, by Arthur Charguéreau and Armaël Guéneau)
+
+    For example,
+
+        # while 1 do () done;;
+                ^
+        Error: This expression has type int but
+               an expression was expected of type bool
+
+    now adds the extra explanation
+
+        because it is in the condition of a while-loop
+
+-   Effort has been made to reduce the compilation time of flambda
+    programs, and the size of the produced `.cmx` files when using
+    the -Oclassic optimisation level.
+    (GPR#1401, GPR#1455, GPR#1627, GPR#1665, by Pierre Chambart, Xavier
+    Clerc, Fuyong Quah, and Leo White)
+
+-   The HTML manual has benefited from various style improvements
+    and should look visually nicer than previous editions.
+    (GPR#1741, GPR#1757, GPR#1767 by Charles Chamberlain and steinuil)
+
+    The new version of the manual can be consulted at
+    ; see the
+    previous version for comparison at
+    .
+
+-   Since 4.01, it is possible to select a variant constructor or
+    record field from a sub-module that is not opened in the current
+    scope, if type information is available at the point of use. This
+    now also works for GADT constructors.
+    (GPR#1648, by Thomas Refis and Leo White)
+
+-   The GC should handle the accumulation of custom blocks in the minor
+    heap better; this solves some memory-usage issues observed by code
+    which allocates a lot of small custom blocks, typically small bigarrays
+    (GPR#1476, by Alain Frsich)
+
+See also the detailed list of changes: (Changes#4.07.0).
+
+
+OCaml 4.06.1 (16 Feb 2018):
+---------------------------
+
+This release consists mostly of bug fixes. The most salient bugs were
+
+-   An incorrect compilation of pattern-matching in presence of
+    extensible variant constructors (such as exceptions), that had been
+    present for a long time.
+    (GPR#1459, GPR#1538, by Luc Maranget, Thomas Refis and Gabriel Scherer)
+
+-   An optimization of `not (x = y)` into `x <> y`, introduced in
+    4.06.0, is incorrect on floating-point numbers in the `nan`
+    case. (GPR#1470, by Leo White)
+
+See the detailed list of fixes at (Changes#4.06.1).
+
+
+OCaml 4.06.0 (3 Nov 2017):
+--------------------------
+
+-   Strings (type `string`) are now immutable by default. In-place
+    modification must use the type `bytes` of byte sequences, which is
+    distinct from `string`.  This corresponds to the `-safe-string`
+    compile-time option, which was introduced in OCaml 4.02 in 2014, and
+    which is now the default.
+    (GPR#1252, by Damien Doligez)
+
+-   Object types can now extend a previously-defined object type,
+    as in ``.
+    (GPR#1118, by Runhang Li)
+
+-   Destructive substitution over module signatures can now express more
+    substitutions, such as `S with type M.t := type-expr` and `S with
+    module M.N := path`.
+    (GPR#792, by Valentin Gatien-Baron)
+
+-   Users can now define operators that look like array indexing,
+    e.g. `let ( .%() ) = List.nth in [0; 1; 2].%(1)`
+    (GPR#1064, GPR#1392, by Florian Angeletti)
+
+-   New escape `\u{XXXX}` in string literals, denoting the UTF-8
+    encoding of the Unicode code point `XXXX`.
+    (GPR#1232, by Daniel Bünzli)
+
+-   Full Unicode support was added to the Windows runtime system.  In
+    particular, file names can now contain Unicode characters.
+    (GPR#153, GPR#1200, GPR#1357, GPR#1362, GPR#1363, GPR#1369, GPR#1398,
+    GPR#1446, GPR#1448, by ygrek and Nicolás Ojeda Bär)
+
+-   An alternate register allocator based on linear scan can be selected
+    with `ocamlopt -linscan`.  It reduces compilation time compared with
+    the default register allocator.
+    (GPR#375, Marcell Fischbach and Benedikt Meurer)
+
+-   The Num library for arbitrary-precision integer and rational
+    arithmetic is no longer part of the core distribution and can be
+    found as a separate OPAM package.
+
+See the detailed list of changes: (Changes#4.06.0).
+
+
+OCaml 4.05.0 (13 Jul 2017):
+---------------------------
+
+Some highlights include:
+
+-   Instrumentation support for fuzzing with afl-fuzz.
+    (GPR#504, by Stephen Dolan)
+
+-   The compilers now accept new `-args/-args0 ` command-line
+    parameters to provide extra command-line arguments in a file.  User
+    programs may implement similar options using the new `Expand`
+    constructor of the `Arg` module.
+    (GPR#748, GPR#843, GPR#864, by Bernhard Schommer)
+
+-   Many functions of the standard library that raise an exception now
+    have an option-returning variable suffixed by `_opt` Typical
+    examples of the new functions include:
+
+        int_of_string_opt: string -> int option
+        List.nth_opt: 'a list -> int -> 'a option
+        Hashtbl.find_opt : ('a, 'b) t -> 'a -> 'b option
+
+    (GPR#885, by Alain Frisch)
+
+-   The security of the runtime system is now hardened by using `secure_getenv`
+    to access environment variables whenever its possible, to avoid unplanned
+    privilege-escalation when running setuid binaries.
+    (GPR#1213, by Damien Doligez)
+
+See the detailed list of changes: (Changes#4.05.0).
diff --git a/README.adoc b/README.adoc
new file mode 100644
index 00000000..4365c2f1
--- /dev/null
+++ b/README.adoc
@@ -0,0 +1,138 @@
+|=====
+| Branch `trunk` | Branch `4.10` | Branch `4.09` | Branch  `4.08`  | Branch  `4.07`  | Branch `4.06` | Branch `4.05`
+
+| image:https://travis-ci.org/ocaml/ocaml.svg?branch=trunk["TravisCI Build Status (trunk branch)",
+     link="https://travis-ci.org/ocaml/ocaml"]
+  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://travis-ci.org/ocaml/ocaml.svg?branch=4.10["TravisCI Build Status (4.10 branch)",
+     link="https://travis-ci.org/ocaml/ocaml"]
+  image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.10&svg=true["AppVeyor Build Status (4.10 branch)",
+     link="https://ci.appveyor.com/project/avsm/ocaml"]
+| image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.09["TravisCI Build Status (4.09 branch)",
+     link="https://travis-ci.org/ocaml/ocaml"]
+  image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.09&svg=true["AppVeyor Build Status (4.09 branch)",
+     link="https://ci.appveyor.com/project/avsm/ocaml"]
+| image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.08["TravisCI Build Status (4.08 branch)",
+     link="https://travis-ci.org/ocaml/ocaml"]
+  image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.08&svg=true["AppVeyor Build Status (4.08 branch)",
+     link="https://ci.appveyor.com/project/avsm/ocaml"]
+| image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.07["TravisCI Build Status (4.07 branch)",
+     link="https://travis-ci.org/ocaml/ocaml"]
+  image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.07&svg=true["AppVeyor Build Status (4.07 branch)",
+     link="https://ci.appveyor.com/project/avsm/ocaml"]
+| image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.06["TravisCI Build Status (4.06 branch)",
+     link="https://travis-ci.org/ocaml/ocaml"]
+  image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.06&svg=true["AppVeyor Build Status (4.06 branch)",
+     link="https://ci.appveyor.com/project/avsm/ocaml"]
+| image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.05["TravisCI Build Status (4.05 branch)",
+     link="https://travis-ci.org/ocaml/ocaml"]
+  image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.05&svg=true["AppVeyor Build Status (4.05 branch)",
+     link="https://ci.appveyor.com/project/avsm/ocaml"]
+|=====
+
+= README =
+
+== Overview
+
+OCaml is an implementation of the ML language, based on the Caml Light
+dialect extended with a complete class-based object system and a powerful
+module system in the style of Standard ML.
+
+OCaml comprises two compilers. One generates bytecode which is then
+interpreted by a C program. This compiler runs quickly, generates compact
+code with moderate memory requirements, and is portable to essentially any
+32 or 64 bit Unix platform. Performance of generated programs is quite good
+for a bytecoded implementation.  This compiler can be used either as a
+standalone, batch-oriented compiler that produces standalone programs, or as
+an interactive, toplevel-based system.
+
+The other compiler generates high-performance native code for a number of
+processors. Compilation takes longer and generates bigger code, but the
+generated programs deliver excellent performance, while retaining the
+moderate memory requirements of the bytecode compiler. The native-code
+compiler currently runs on the following platforms:
+
+|====
+|                |  Tier 1 (actively maintained)   | Tier 2 (maintained when possible)
+
+| x86 64 bits    | Linux, macOS, Windows, FreeBSD  |  NetBSD, OpenBSD
+| x86 32 bits    | Linux, Windows                  |  FreeBSD, NetBSD, OpenBSD
+| ARM 64 bits    | Linux                           |  FreeBSD
+| ARM 32 bits    | Linux                           |  FreeBSD, NetBSD, OpenBSD
+| Power 64 bits  | Linux                           |
+| Power 32 bits  |                                 |  Linux
+| RISC-V 64 bits | Linux                           |
+| IBM Z (s390x)  | Linux                           |
+|====
+
+Other operating systems for the processors above have not been tested, but
+the compiler may work under other operating systems with little work.
+
+
+== Copyright
+
+All files marked "Copyright INRIA" in this distribution are copyright 1996,
+1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019
+Institut National de Recherche en Informatique et en Automatique (INRIA)
+and distributed under the conditions stated in file LICENSE.
+
+== Installation
+
+See the file link:INSTALL.adoc[] for installation instructions on
+machines running Unix, Linux, OS X and Cygwin.  For native Microsoft
+Windows, see link:README.win32.adoc[].
+
+== Documentation
+
+The OCaml manual is distributed in HTML, PDF, and Emacs
+Info files.  It is available at
+
+https://ocaml.org/releases/latest/manual.html
+
+== Availability
+
+The complete OCaml distribution can be accessed at
+
+https://ocaml.org/docs/install.html
+
+== Keeping in Touch with the Caml Community
+
+The OCaml mailing list is the longest-running forum for OCaml users.
+You can email it at
+
+mailto:caml-list@inria.fr[]
+
+You can subscribe and access list archives via the Web interface at
+
+https://sympa.inria.fr/sympa/subscribe/caml-list
+
+An alternative archive of the mailing list is also available at
+
+https://inbox.ocaml.org/
+
+You can also access a newer discussion forum at
+
+https://discuss.ocaml.org/
+
+There also exist other mailing lists, chat channels, and various other forums
+around the internet for getting in touch with the OCaml and ML family language
+community. These can be accessed at
+
+https://ocaml.org/community/
+
+In particular, the IRC channel `#ocaml` on https://freenode.net/[Freenode] has a
+long history and welcomes questions.
+
+== Bug Reports and User Feedback
+
+Please report bugs using the issue tracker at
+https://github.com/ocaml/ocaml/issues
+
+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).
+
+For information on contributing to OCaml, see link:HACKING.adoc[] and
+link:CONTRIBUTING.md[].
diff --git a/README.win32.adoc b/README.win32.adoc
new file mode 100644
index 00000000..d6da9138
--- /dev/null
+++ b/README.win32.adoc
@@ -0,0 +1,384 @@
+= Release notes for the Microsoft Windows ports of OCaml =
+:toc: macro
+
+There are no fewer than three ports of OCaml for Microsoft Windows, each
+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])
+
+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 native-code generation             | Microsoft Visual C++   | Cygwin           | Cygwin
+4+^| Features
+| Speed of bytecode interpreter          | 70%                    | 100%             | 100%
+| Replay debugger                        | yes <>       | yes <> | yes
+| The Unix library                       | partial                | partial          | full
+| The Threads library                    | yes                    | yes              | yes
+| Restrictions on generated executables? | none                   | none             | yes <>
+|=====
+
+[[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
+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
+any programs linked with it to be distributed under a compatible licence. Since
+version 2.5.2, the Cygwin DLL is distributed under the LGPLv3 with a static
+linking exception meaning that, like executables generated by Microsoft Visual
+C++ or the Mingw-w64 compilers, generated executables may be distributed under
+terms of your choosing.
+
+[[tb2]]
+(**):: The debugger is supported but the "replay" functions are not enabled.
+Other functions are available (step, goto, run...).
+
+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 XP 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.
+
+toc::[]
+
+== PREREQUISITES
+
+All the Windows ports require a Unix-like build environment.  Although other
+methods are available, the officially supported environment for doing this is
+32-bit (x86) Cygwin.
+
+Only the `make` Cygwin package is required. `diffutils` is required if you wish
+to be able to run the test suite.
+
+Unless you are also compiling the Cygwin port of OCaml, you should not install
+the `gcc-core` or `flexdll` packages. If you do, care may be required to ensure
+that a particular build is using the correct installation of `flexlink`.
+
+[[bmflex]]
+In addition to Cygwin, FlexDLL must also be installed, which is available from
+https://github.com/alainfrisch/flexdll. A binary distribution is available;
+instructions on how to build FlexDLL from sources, including how to bootstrap
+FlexDLL and OCaml are given <>.  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 build ocaml using the flexdll target.
+
+The base bytecode system (ocamlc, ocaml, ocamllex, ocamlyacc, ...) of all three
+ports runs without any additional tools.
+
+== Microsoft Visual C/C++ Ports
+
+=== REQUIREMENTS
+
+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 <>).
+
+Any edition (including Express/Community editions) of Microsoft Visual Studio
+2005 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.
+
+|=====
+|                    | `cl` Version | Express                 | SDK/Build Tools
+| Visual Studio 2005 | 14.00.x.x    | 32-bit only <> |
+| 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
+|=====
+
+[[vs1]]
+(*):: Visual C++ 2005 Express Edition does not provide an assembler; this can be
+      downloaded separately from
+      https://www.microsoft.com/en-gb/download/details.aspx?id=12654
+
+=== COMPILATION FROM THE SOURCES
+
+The command-line tools must be compiled from the Unix source distribution
+(`ocaml-X.YY.Z.tar.gz`), which also contains the files modified for Windows.
+(Note: you should use cygwin's `tar` command to unpack this archive. If you
+use WinZip, you will need to deselect "TAR file smart CR/LF conversion" in
+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 2005-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 2005-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 and 2017 make the shortcuts even clearer by including the full name of the
+architecture.
+
+The Build Tools for Visual Studio 2015 and 2017 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.
+
+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.00.23506 for x86
+  ...
+
+You then need to start Cygwin from this Command Prompt.  Assuming you have
+installed it to its default location of `C:\cygwin`, simply run:
+
+  C:\cygwin\bin\mintty -
+
+(note the space and hyphen at the end of the command).
+
+This should open a terminal window and start bash.  You should be able to run
+`cl` from this.  You can now change to the top-level directory of the directory
+of the OCaml distribution.
+
+The Microsoft Linker is provided by a command called `link` which unfortunately
+conflicts with a Cygwin command of the same name.  It is therefore necessary to
+ensure that the directory containing the Microsoft C/C++ Compiler appears at
+the beginning of `PATH`, before Cygwin's `/usr/bin`.  You can automate this from
+the top-level of the OCaml distribution by running:
+
+  eval $(tools/msvs-promote-path)
+
+If you forget to do this, `make` will fail relatively
+quickly as it will be unable to link `ocamlrun`.
+
+Now run:
+
+        ./configure --build=i686-pc-cygwin --host=i686-pc-windows
+
+for 32-bit, or:
+
+        ./configure --build=x86_64-unknown-cygwin --host=x86_64-pc-windows
+
+for 64-bit.
+
+Finally, use `make` to build the system, e.g.
+
+        make
+        make install
+
+After installing, it is not necessary to keep the Cygwin installation (although
+you may require it to build additional third party libraries and tools).  You
+will need to use `ocamlopt` (or `ocamlc -custom`) from the same Visual Studio or
+Windows SDK Command Prompt as you compiled OCaml from, or `ocamlopt` will not
+be able to find `cl`.
+
+If you wish to use `ocamlopt` from Cygwin's bash on a regular basis, you may
+like to copy the `tools/msvs-promote-path` script and add the `eval` line to
+your `~/.bashrc` file.
+
+* The Microsoft Visual C/C++ compiler does not implement "computed gotos", and
+  therefore generates inefficient code for `runtime/interp.c`.  Consequently,
+  the performance of bytecode programs is about 2/3 of that obtained under
+  Unix/GCC,  Cygwin or Mingw-w64 on similar hardware.
+
+* Libraries available in this port: `bigarray`, `dynlink`, `num`,
+  `str`, `threads`, and large parts of `unix`.
+
+* The replay debugger is partially supported (no reverse execution).
+
+=== CREDITS
+
+The initial port of Caml Special Light (the ancestor of OCaml) to Windows NT
+was done by Kevin Gallo at Microsoft Research, who kindly contributed his
+changes to the OCaml project.
+
+== Mingw-w64 Ports
+
+=== REQUIREMENTS
+
+The native-code compiler (`ocamlopt`) and static linking of OCaml bytecode with
+C code (`ocamlc -custom`) require the appropriate Mingw-w64 gcc and the
+`flexlink` tool (see <>). Mingw-w64 gcc is provided by the
+`mingw64-i686-gcc-core` package for 32-bit and the `mingw64-x86_64-gcc-core`
+package for 64-bit.
+
+  - Do not try to use the Cygwin version of flexdll for 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.
+
+=== COMPILATION FROM THE SOURCES
+
+The command-line tools must be compiled from the Unix source distribution
+(`ocaml-X.YY.Z.tar.gz`), which also contains the files modified for Windows.
+(Note: you should use cygwin's `tar` command to unpack this archive. If you
+use WinZip, you will need to deselect "TAR file smart CR/LF conversion" in
+the WinZip Options Window.)
+
+Now run:
+
+        ./configure --build=i686-pc-cygwin --host=i686-w64-mingw32
+
+for 32-bit, or:
+
+        ./configure --build=x86_64-unknown-cygwin --host=x86_64-w64-mingw32
+
+for 64-bit.
+
+Finally, use `make` to build the system, e.g.
+
+        make
+        make install
+
+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`.
+
+* Libraries available in this port: `bigarray`, `dynlink`, `num`,
+  `str`, `threads`, and large parts of `unix`.
+
+* The replay debugger is partially supported (no reverse execution).
+
+[[seflexdll]]
+== FlexDLL
+Although the core of FlexDLL is necessarily written in C, the `flexlink` program
+is, naturally, written in OCaml.  This creates a circular dependency if you wish
+to build entirely from sources.  Since OCaml 4.03 and FlexDLL 0.35, it is now
+possible to bootstrap the two programs simultaneously.  The process is identical
+for both ports.  If you choose to compile this way, it is not necessary to
+install FlexDLL separately -- indeed, if you do install FlexDLL separately, you
+may need to be careful to ensure that `ocamlopt` picks up the correct `flexlink`
+in your `PATH`.
+
+You must place the FlexDLL sources for Version 0.35 or later in the directory
+`flexdll/` at the top-level directory of the OCaml distribution.  This can be
+done in one of three ways:
+
+ * Extracting the sources from a tarball from
+   https://github.com/alainfrisch/flexdll/releases
+ * Cloning the git repository by running:
++
+  git clone https://github.com/alainfrisch/flexdll.git
+
+ * If you are compiling from a git clone of the OCaml repository, instead of
+   using a sources tarball, you can run:
++
+  git submodule update --init
+
+OCaml is then compiled as normal for the port you require, except that before
+building the compiler itself, you must compile `flexdll`, i.e.:
+
+  make flexdll
+  make
+  make flexlink.opt
+  make install
+
+ * You should ignore the error messages that say ocamlopt was not found.
+ * `make install` will install FlexDLL by placing `flexlink.exe`
+   (and the default manifest file for the Microsoft port) in `bin/` and the
+   FlexDLL object files in `lib/`.
+ * If you don't include `make flexlink.opt`, `flexlink.exe` will be a
+   bytecode program.  `make install` always installs the "best"
+   `flexlink.exe` (i.e. there is never a `flexlink.opt.exe` installed).
+ * If you have populated `flexdll/`, you *must* run
+   `make flexdll`.  If you wish to revert to using an externally
+   installed FlexDLL, you must erase the contents of `flexdll/` before
+   compiling.
+
+== Unicode support
+
+Prior to version 4.06, all filenames on the OCaml side were assumed
+to be encoded using the current 8-bit code page of the system.  Some
+Unicode filenames could thus not be represented.  Since version 4.06,
+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.
+
+Technically, both modes use the Windows "wide" API, where filenames
+and other strings are made of 16-bit entities, usually interpreted as
+UTF-16 encoded strings.
+
+Some more details about the two modes:
+
+ * Unicode mode: OCaml strings are interpreted as being UTF-8 encoded
+   and translated to UTF-16 when calling Windows; strings returned by
+   Windows are interpreted as UTF-16 and translated to UTF-8 on their
+   way back to OCaml.  Additionally, an OCaml string which is not
+   valid UTF-8 will be interpreted as being in the current 8-bit code
+   page.  This fallback works well in practice, since the chances of
+   non-ASCII string encoded in the a 8-bit code page to be a valid
+   UTF-8 string are tiny.  This means that filenames
+   obtained from e.g. a 8-bit UI or database layer would continue to
+   work fine.  Application written for the legacy mode or older
+   versions of OCaml might still break if strings returned by
+   Windows (e.g. for `Sys.readdir`) are sent to components expecting
+   strings encoded in the current code page.
+
+ * Legacy mode: this mode emulates closely the behavior of OCaml <
+   4.06 and is thus the safest choice in terms of backward
+   compatibility.  In this mode, OCaml programs can only work with
+   filenames that can be encoded in the current code page, and the
+   same applies to ocaml tools themselves (ocamlc, ocamlopt, etc).
+
+The legacy mode will be deprecated and then removed in future versions
+of OCaml.  Users are thus strongly encouraged to use the Unicode mode
+and adapt their existing code bases accordingly.
+
+Note: in order for ocaml tools to support Unicode pathnames, it is
+necessary to use a version of FlexDLL which has itself been compiled
+with OCaml >= 4.06 in Unicode mode.  This is the case for binary distributions
+of FlexDLL starting from version 0.37 and above.
+
+== Trademarks
+
+Microsoft, Visual C++, Visual Studio and Windows are registered trademarks of
+Microsoft Corporation in the United States and/or other countries.
diff --git a/VERSION b/VERSION
new file mode 100644
index 00000000..ec07a3e6
--- /dev/null
+++ b/VERSION
@@ -0,0 +1,4 @@
+4.11.1
+
+# The version string is the first line of this file.
+# It must be in the format described in stdlib/sys.mli
diff --git a/aclocal.m4 b/aclocal.m4
new file mode 100644
index 00000000..5ac1b729
--- /dev/null
+++ b/aclocal.m4
@@ -0,0 +1,274 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Sebastien Hinderer, projet Gallium, INRIA Paris             *
+#*                                                                        *
+#*   Copyright 2018 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 processed by autoconf.
+# It contains macro definitions specific to the OCaml package.
+# Every macro defined here should have its name prefixed with OCAML_.
+
+# libtool macros
+
+# Since the project does not use automake, the libtool macro files
+# need to be manually included
+m4_include([build-aux/libtool.m4])
+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])
+
+# Macros from the autoconf macro archive
+m4_include([build-aux/ax_func_which_gethostbyname_r.m4])
+m4_include([build-aux/ax_pthread.m4])
+
+# The following macro figures out which C compiler is used.
+# It does so by checking for compiler-specific predefined macros.
+# A list of such macros can be found at
+# https://sourceforge.net/p/predef/wiki/Compilers/
+AC_DEFUN([OCAML_CC_VENDOR], [
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_PROG_CPP])
+  AC_MSG_CHECKING([C compiler vendor])
+  AC_PREPROC_IFELSE(
+    [AC_LANG_SOURCE([
+#if defined(_MSC_VER)
+msvc _MSC_VER
+#elif defined(__INTEL_COMPILER)
+icc __INTEL_COMPILER
+#elif defined(__clang_major__) && defined(__clang_minor__)
+clang __clang_major__ __clang_minor__
+#elif defined(__GNUC__) && defined(__GNUC_MINOR__)
+gcc __GNUC__ __GNUC_MINOR__
+#elif defined(__xlc__) && defined(__xlC__)
+xlc __xlC__ __xlC_ver__
+#else
+unknown
+#endif]
+    )],
+    [AC_CACHE_VAL([ocaml_cv_cc_vendor],
+      [ocaml_cv_cc_vendor=`grep ['^[a-z]'] conftest.i | tr -s ' ' '-'`])],
+    [AC_MSG_FAILURE([unexpected preprocessor failure])])
+  AC_MSG_RESULT([$ocaml_cv_cc_vendor])
+])
+
+AC_DEFUN([OCAML_SIGNAL_HANDLERS_SEMANTICS], [
+  AC_MSG_NOTICE([checking semantics of signal handlers])
+  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_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_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"
+])
+
+# Save C compiler related variables
+AC_DEFUN([OCAML_CC_SAVE_VARIABLES], [
+  saved_CC="$CC"
+  saved_CFLAGS="$CFLAGS"
+  saved_CPPFLAGS="$CPPFLAGS"
+  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
+])
+
+# Restore the C compiler related variables
+AC_DEFUN([OCAML_CC_RESTORE_VARIABLES], [
+  # 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"
+])
+
+AC_DEFUN([OCAML_AS_HAS_DEBUG_PREFIX_MAP], [
+  AC_MSG_CHECKING([whether the assembler supports --debug-prefix-map])
+
+  OCAML_CC_SAVE_VARIABLES
+
+  # Modify C-compiler variables to use the assembler
+  CC="$AS"
+  CFLAGS="--debug-prefix-map old=new -o conftest.$ac_objext"
+  CPPFLAGS=""
+  ac_ext="S"
+  ac_compile='$CC $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+
+  AC_COMPILE_IFELSE(
+    [AC_LANG_SOURCE([
+camlPervasives__loop_1128:
+        .file   1       "pervasives.ml"
+        .loc    1       193
+    ])],
+    [as_has_debug_prefix_map=true
+    AC_MSG_RESULT([yes])],
+    [ashas_debug_prefix_map=false
+    AC_MSG_RESULT([no])])
+
+  OCAML_CC_RESTORE_VARIABLES
+])
+
+AC_DEFUN([OCAML_AS_HAS_CFI_DIRECTIVES], [
+  AC_MSG_CHECKING([whether the assembler supports CFI directives])
+
+  AS_IF([test x"$enable_cfi" = "xno"],
+    [AC_MSG_RESULT([disabled])],
+    [OCAML_CC_SAVE_VARIABLES
+
+    # Modify C-compiler variables to use the assembler
+    CC="$ASPP"
+    CFLAGS="-o conftest.$ac_objext"
+    CPPFLAGS=""
+    ac_ext="S"
+    ac_compile='$CC $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+
+    AC_COMPILE_IFELSE(
+      [AC_LANG_SOURCE([
+camlPervasives__loop_1128:
+        .file   1       "pervasives.ml"
+        .loc    1       193
+        .cfi_startproc
+        .cfi_adjust_cfa_offset 8
+        .cfi_endproc
+      ])],
+      [aspp_ok=true],
+      [aspp_ok=false])
+
+    AS_IF([test "$AS" = "$ASPP"],
+      [as_ok="$aspp_ok"],
+      [CC="$AS"
+      ac_compile='$CC $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+      AC_COMPILE_IFELSE(
+        [AC_LANG_SOURCE([
+camlPervasives__loop_1128:
+        .file   1       "pervasives.ml"
+        .loc    1       193
+        .cfi_startproc
+        .cfi_adjust_cfa_offset 8
+        .cfi_endproc
+        ])],
+        [as_ok=true],
+        [as_ok=false])])
+
+    OCAML_CC_RESTORE_VARIABLES
+
+    AS_IF([$aspp_ok && $as_ok],
+      [asm_cfi_supported=true
+      AC_DEFINE([ASM_CFI_SUPPORTED])
+      AC_MSG_RESULT([yes])],
+      [AS_IF([test x"$enable_cfi" = "xyes"],
+        [AC_MSG_RESULT([requested but not available
+        AC_MSG_ERROR([exiting])])],
+        [asm_cfi_supported=false
+        AC_MSG_RESULT([no])])])
+  ])])
+
+AC_DEFUN([OCAML_MMAP_SUPPORTS_HUGE_PAGES], [
+  AC_MSG_CHECKING([whether mmap supports huge pages])
+  AC_RUN_IFELSE(
+    [AC_LANG_SOURCE([[
+#include 
+#include 
+#include 
+
+#define huge_page_size (4 * 1024 * 1024)
+
+/* Test for the possible availability of huge pages. Answer yes
+   if the OS knows about huge pages, even if they are not available
+   on the build machine at configure time, because (on Linux) huge
+   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;
+  block = mmap (NULL, huge_page_size, PROT_READ | PROT_WRITE,
+                MAP_PRIVATE | MAP_ANONYMOUS | MAP_HUGETLB,
+                -1, 0);
+  if (block == MAP_FAILED){
+    block = mmap (NULL, huge_page_size, PROT_READ | PROT_WRITE,
+                  MAP_PRIVATE | MAP_ANONYMOUS,
+                  -1, 0);
+  }
+  if (block == MAP_FAILED){
+    perror ("mmap");
+    return 3;
+  }
+  /*printf ("block = %p\n", block);*/
+  p = (char *) block;
+  for (i = 0; i < huge_page_size; i += 4096){
+    p[i] = (char) i;
+  }
+  return 0;
+}
+    ]])],
+    [AC_DEFINE([HAS_HUGE_PAGES])
+    AC_DEFINE_UNQUOTED([HUGE_PAGE_SIZE], [(4 * 1024 * 1024)])
+    AC_MSG_RESULT([yes])],
+    [AC_MSG_RESULT([no])],
+    [AC_MSG_RESULT([no assumed])])
+])
+
+AC_DEFUN([OCAML_CHECK_LIBUNWIND], [
+  SAVED_CFLAGS="$CFLAGS"
+  SAVED_LDFLAGS="$LDFLAGS"
+  CFLAGS="$CFLAGS $libunwind_include_flags"
+  LDFLAGS="$LDFLAGS $libunwind_link_flags"
+  AC_CHECK_HEADER([libunwind.h],
+    [AC_DEFINE([HAS_LIBUNWIND])
+    libunwind_available=true],
+    [libunwind_available=false])
+  LDFLAGS="$SAVED_LDFLAGS"
+  CFLAGS="$SAVED_CFLAGS"
+])
diff --git a/appveyor.yml b/appveyor.yml
new file mode 100644
index 00000000..e87600b5
--- /dev/null
+++ b/appveyor.yml
@@ -0,0 +1,51 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                         Christophe Troestler                           *
+#*                                                                        *
+#*   Copyright 2015 Christophe Troestler                                  *
+#*                                                                        *
+#*   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.          *
+#*                                                                        *
+#**************************************************************************
+
+# Compile the 64 bits version
+platform:
+  - x64
+
+image: Visual Studio 2015
+
+# Do a shallow clone of the repo to speed up the build
+clone_depth: 1
+
+environment:
+  global:
+    CYG_ROOT: C:/cygwin64
+    CYG_MIRROR: http://mirrors.kernel.org/sourceware/cygwin/
+    CYG_CACHE: C:/cygwin64/var/cache/setup
+    FLEXDLL_VERSION: 0.38
+    OCAMLRUNPARAM: v=0,b
+  matrix:
+    - PORT: mingw32
+    - PORT: msvc64
+
+matrix:
+  fast_finish: true
+
+cache:
+  - C:\cygwin64\var\cache\setup
+  - C:\projects\cache
+
+install:
+# This is a hangover from monitoring effects of MPR#7452
+  - wmic cpu get name
+  - call "%APPVEYOR_BUILD_FOLDER%\tools\ci\appveyor\appveyor_build.cmd" install
+
+build_script:
+  - call "%APPVEYOR_BUILD_FOLDER%\tools\ci\appveyor\appveyor_build.cmd" build
+
+test_script:
+  - call "%APPVEYOR_BUILD_FOLDER%\tools\ci\appveyor\appveyor_build.cmd" test
diff --git a/asmcomp/CSEgen.ml b/asmcomp/CSEgen.ml
new file mode 100644
index 00000000..d71198ad
--- /dev/null
+++ b/asmcomp/CSEgen.ml
@@ -0,0 +1,368 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Common subexpression elimination by value numbering over extended
+   basic blocks. *)
+
+open Mach
+
+type valnum = int
+
+(* Classification of operations *)
+
+type op_class =
+  | Op_pure           (* pure arithmetic, produce one or several result *)
+  | Op_checkbound     (* checkbound-style: no result, can raise an exn *)
+  | Op_load           (* memory load *)
+  | Op_store of bool  (* memory store, false = init, true = assign *)
+  | Op_other   (* anything else that does not allocate nor store in memory *)
+
+(* We maintain sets of equations of the form
+       valnums = operation(valnums)
+   plus a mapping from registers to valnums (value numbers). *)
+
+type rhs = operation * valnum array
+
+module Equations = struct
+  module Rhs_map =
+    Map.Make(struct type t = rhs let compare = Stdlib.compare end)
+
+  type 'a t =
+    { load_equations : 'a Rhs_map.t;
+      other_equations : 'a Rhs_map.t }
+
+  let empty =
+    { load_equations = Rhs_map.empty;
+      other_equations = Rhs_map.empty }
+
+  let add op_class op v m =
+    match op_class with
+    | Op_load ->
+      { m with load_equations = Rhs_map.add op v m.load_equations }
+    | _ ->
+      { m with other_equations = Rhs_map.add op v m.other_equations }
+
+  let find op_class op m =
+    match op_class with
+    | Op_load ->
+      Rhs_map.find op m.load_equations
+    | _ ->
+      Rhs_map.find op m.other_equations
+
+  let remove_loads m =
+    { load_equations = Rhs_map.empty;
+      other_equations = m.other_equations }
+end
+
+type numbering =
+  { num_next: int;                      (* next fresh value number *)
+    num_eqs: valnum array Equations.t;  (* mapping rhs -> valnums *)
+    num_reg: valnum Reg.Map.t }         (* mapping register -> valnum *)
+
+let empty_numbering =
+  { num_next = 0; num_eqs = Equations.empty; num_reg = Reg.Map.empty }
+
+(** Generate a fresh value number [v] and associate it to register [r].
+  Returns a pair [(n',v)] with the updated value numbering [n']. *)
+
+let fresh_valnum_reg n r =
+  let v = n.num_next in
+  ({n with num_next = v + 1; num_reg = Reg.Map.add r v n.num_reg}, v)
+
+(* Same, for a set of registers [rs]. *)
+
+let array_fold_transf (f: numbering -> 'a -> numbering * 'b) n (a: 'a array)
+                      : numbering * 'b array =
+  match Array.length a with
+  | 0 -> (n, [||])
+  | 1 -> let (n', b) = f n a.(0) in (n', [|b|])
+  | l -> let b = Array.make l 0 and n = ref n in
+         for i = 0 to l - 1 do
+           let (n', x) = f !n a.(i) in
+           b.(i) <- x; n := n'
+         done;
+         (!n, b)
+
+let fresh_valnum_regs n rs =
+  array_fold_transf fresh_valnum_reg n rs
+
+(** [valnum_reg n r] returns the value number for the contents of
+  register [r].  If none exists, a fresh value number is returned
+  and associated with register [r].  The possibly updated numbering
+  is also returned.  [valnum_regs] is similar, but for an array of
+  registers. *)
+
+let valnum_reg n r =
+  try
+    (n, Reg.Map.find r n.num_reg)
+  with Not_found ->
+    fresh_valnum_reg n r
+
+let valnum_regs n rs =
+  array_fold_transf valnum_reg n rs
+
+(* Look up the set of equations for an equation with the given rhs.
+   Return [Some res] if there is one, where [res] is the lhs. *)
+
+let find_equation op_class n rhs =
+  try
+    Some(Equations.find op_class rhs n.num_eqs)
+  with Not_found ->
+    None
+
+(* Find a register containing the given value number. *)
+
+let find_reg_containing n v =
+  Reg.Map.fold (fun r v' res -> if v' = v then Some r else res)
+               n.num_reg None
+
+(* Find a set of registers containing the given value numbers. *)
+
+let find_regs_containing n vs =
+  match Array.length vs with
+  | 0 -> Some [||]
+  | 1 -> begin match find_reg_containing n vs.(0) with
+         | None -> None
+         | Some r -> Some [|r|]
+         end
+  | l -> let rs = Array.make l Reg.dummy in
+         begin try
+           for i = 0 to l - 1 do
+             match find_reg_containing n vs.(i) with
+             | None -> raise Exit
+             | Some r -> rs.(i) <- r
+           done;
+           Some rs
+         with Exit ->
+           None
+         end
+
+(* Associate the given value number to the given result register,
+   without adding new equations. *)
+
+let set_known_reg n r v =
+  { n with num_reg = Reg.Map.add r v n.num_reg }
+
+(* Associate the given value numbers to the given result registers,
+   without adding new equations. *)
+
+let array_fold2 f n a1 a2 =
+  let l = Array.length a1 in
+  assert (l = Array.length a2);
+  let n = ref n in
+  for i = 0 to l - 1 do n := f !n a1.(i) a2.(i) done;
+  !n
+
+let set_known_regs n rs vs =
+  array_fold2 set_known_reg n rs vs
+
+(* Record the effect of a move: no new equations, but the result reg
+   maps to the same value number as the argument reg. *)
+
+let set_move n src dst =
+  let (n1, v) = valnum_reg n src in
+  { n1 with num_reg = Reg.Map.add dst v n1.num_reg }
+
+(* Record the equation [fresh valnums = rhs] and associate the given
+   result registers [rs] to [fresh valnums]. *)
+
+let set_fresh_regs n rs rhs op_class =
+  let (n1, vs) = fresh_valnum_regs n rs in
+  { n1 with num_eqs = Equations.add op_class rhs vs n.num_eqs }
+
+(* Forget everything we know about the given result registers,
+   which are receiving unpredictable values at run-time. *)
+
+let set_unknown_regs n rs =
+  { n with num_reg = Array.fold_right Reg.Map.remove rs n.num_reg }
+
+(* Keep only the equations satisfying the given predicate. *)
+
+let remove_load_numbering n =
+  { n with num_eqs = Equations.remove_loads n.num_eqs }
+
+(* Forget everything we know about registers of type [Addr]. *)
+
+let kill_addr_regs n =
+  { n with num_reg =
+              Reg.Map.filter (fun r _n -> r.Reg.typ <> Cmm.Addr) n.num_reg }
+
+(* Prepend a set of moves before [i] to assign [srcs] to [dsts].  *)
+
+let insert_single_move i src dst = instr_cons (Iop Imove) [|src|] [|dst|] i
+
+let insert_move srcs dsts i =
+  match Array.length srcs with
+  | 0 -> i
+  | 1 -> instr_cons (Iop Imove) srcs dsts i
+  | _ -> (* Parallel move: first copy srcs into tmps one by one,
+            then copy tmps into dsts one by one *)
+         let tmps = Reg.createv_like srcs in
+         let i1 = array_fold2 insert_single_move i tmps dsts in
+         array_fold2 insert_single_move i1 srcs tmps
+
+class cse_generic = object (self)
+
+(* Default classification of operations.  Can be overridden in
+   processor-specific files to classify specific operations better. *)
+
+method class_of_operation op =
+  match op with
+  | Imove | Ispill | Ireload -> assert false   (* treated specially *)
+  | Iconst_int _ | Iconst_float _ | Iconst_symbol _ -> Op_pure
+  | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+  | Iextcall _ -> assert false                 (* treated specially *)
+  | Istackoffset _ -> Op_other
+  | Iload(_,_) -> Op_load
+  | Istore(_,_,asg) -> Op_store asg
+  | Ialloc _ -> assert false                   (* treated specially *)
+  | Iintop(Icheckbound _) -> Op_checkbound
+  | Iintop _ -> Op_pure
+  | Iintop_imm(Icheckbound _, _) -> Op_checkbound
+  | Iintop_imm(_, _) -> Op_pure
+  | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
+  | Ifloatofint | Iintoffloat -> Op_pure
+  | Ispecific _ -> Op_other
+  | Iname_for_debugger _ -> Op_pure
+
+(* Operations that are so cheap that it isn't worth factoring them. *)
+
+method is_cheap_operation op =
+  match op with
+  | Iconst_int _ -> true
+  | _ -> false
+
+(* Forget all equations involving memory loads.  Performed after a
+   non-initializing store *)
+
+method private kill_loads n =
+  remove_load_numbering n
+
+(* Perform CSE on the given instruction [i] and its successors.
+   [n] is the value numbering current at the beginning of [i]. *)
+
+method private cse n i =
+  match i.desc with
+  | Iend | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _)
+  | Iexit _ | Iraise _ ->
+      i
+  | Iop (Imove | Ispill | Ireload) ->
+      (* For moves, we associate the same value number to the result reg
+         as to the argument reg. *)
+      let n1 = set_move n i.arg.(0) i.res.(0) in
+      {i with next = self#cse n1 i.next}
+  | Iop (Icall_ind _ | Icall_imm _ | Iextcall _) ->
+      (* For function calls, we should at least forget:
+         - equations involving memory loads, since the callee can
+           perform arbitrary memory stores;
+         - equations involving arithmetic operations that can
+           produce [Addr]-typed derived pointers into the heap
+           (see below for Ialloc);
+         - mappings from hardware registers to value numbers,
+           since the callee does not preserve these registers.
+         That doesn't leave much usable information: checkbounds
+         could be kept, but won't be usable for CSE as one of their
+         arguments is always a memory load.  For simplicity, we
+         just forget everything. *)
+      {i with next = self#cse empty_numbering i.next}
+  | Iop (Ialloc _) ->
+      (* For allocations, we must avoid extending the live range of a
+         pseudoregister across the allocation if this pseudoreg
+         is a derived heap pointer (a pointer into the heap that does
+         not point to the beginning of a Caml block).  PR#6484 is an
+         example of this situation.  Such pseudoregs have type [Addr].
+         Pseudoregs with types other than [Addr] can be kept.
+         Moreover, allocation can trigger the asynchronous execution
+         of arbitrary Caml code (finalizer, signal handler, context
+         switch), which can contain non-initializing stores.
+         Hence, all equations over loads must be removed. *)
+       let n1 = kill_addr_regs (self#kill_loads n) in
+       let n2 = set_unknown_regs n1 i.res in
+       {i with next = self#cse n2 i.next}
+  | Iop op ->
+      begin match self#class_of_operation op with
+      | (Op_pure | Op_checkbound | Op_load) as op_class ->
+          let (n1, varg) = valnum_regs n i.arg in
+          let n2 = set_unknown_regs n1 (Proc.destroyed_at_oper i.desc) in
+          begin match find_equation op_class n1 (op, varg) with
+          | Some vres ->
+              (* This operation was computed earlier. *)
+              (* Are there registers that hold the results computed earlier? *)
+              begin match find_regs_containing n1 vres with
+              | Some res when (not (self#is_cheap_operation op))
+                           && (not (Proc.regs_are_volatile res)) ->
+                  (* We can replace res <- op args with r <- move res,
+                     provided res are stable (non-volatile) registers.
+                     If the operation is very cheap to compute, e.g.
+                     an integer constant, don't bother. *)
+                  let n3 = set_known_regs n1 i.res vres in
+                  (* This is n1 above and not n2 because the move
+                     does not destroy any regs *)
+                  insert_move res i.res (self#cse n3 i.next)
+              | _ ->
+                  (* We already computed the operation but lost its
+                     results.  Associate the result registers to
+                     the result valnums of the previous operation. *)
+                  let n3 = set_known_regs n2 i.res vres in
+                  {i with next = self#cse n3 i.next}
+              end
+          | None ->
+              (* This operation produces a result we haven't seen earlier. *)
+              let n3 = set_fresh_regs n2 i.res (op, varg) op_class in
+              {i with next = self#cse n3 i.next}
+          end
+      | Op_store false | Op_other ->
+          (* An initializing store or an "other" operation do not invalidate
+             any equations, but we do not know anything about the results. *)
+         let n1 = set_unknown_regs n (Proc.destroyed_at_oper i.desc) in
+         let n2 = set_unknown_regs n1 i.res in
+         {i with next = self#cse n2 i.next}
+      | Op_store true ->
+          (* A non-initializing store can invalidate
+             anything we know about prior loads. *)
+         let n1 = set_unknown_regs n (Proc.destroyed_at_oper i.desc) in
+         let n2 = set_unknown_regs n1 i.res in
+         let n3 = self#kill_loads n2 in
+         {i with next = self#cse n3 i.next}
+      end
+  (* For control structures, we set the numbering to empty at every
+     join point, but propagate the current numbering across fork points. *)
+  | Iifthenelse(test, ifso, ifnot) ->
+     let n1 = set_unknown_regs n (Proc.destroyed_at_oper i.desc) in
+      {i with desc = Iifthenelse(test, self#cse n1 ifso, self#cse n1 ifnot);
+              next = self#cse empty_numbering i.next}
+  | Iswitch(index, cases) ->
+     let n1 = set_unknown_regs n (Proc.destroyed_at_oper i.desc) in
+      {i with desc = Iswitch(index, Array.map (self#cse n1) cases);
+              next = self#cse empty_numbering i.next}
+  | Icatch(rec_flag, handlers, body) ->
+      let aux (nfail, handler) =
+        nfail, self#cse empty_numbering handler
+      in
+      {i with desc = Icatch(rec_flag, List.map aux handlers, self#cse n body);
+              next = self#cse empty_numbering i.next}
+  | Itrywith(body, handler) ->
+      {i with desc = Itrywith(self#cse n body,
+                              self#cse empty_numbering handler);
+              next = self#cse empty_numbering i.next}
+
+method fundecl f =
+  (* CSE can trigger bad register allocation behaviors, see MPR#7630 *)
+  if List.mem Cmm.No_CSE f.fun_codegen_options then
+    f
+  else
+    {f with fun_body = self#cse empty_numbering f.fun_body }
+
+end
diff --git a/asmcomp/CSEgen.mli b/asmcomp/CSEgen.mli
new file mode 100644
index 00000000..c80e7b4c
--- /dev/null
+++ b/asmcomp/CSEgen.mli
@@ -0,0 +1,38 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Common subexpression elimination by value numbering over extended
+   basic blocks. *)
+
+type op_class =
+  | Op_pure     (* pure, produce one result *)
+  | Op_checkbound     (* checkbound-style: no result, can raise an exn *)
+  | Op_load           (* memory load *)
+  | Op_store of bool  (* memory store, false = init, true = assign *)
+  | Op_other   (* anything else that does not allocate nor store in memory *)
+
+class cse_generic : object
+  (* The following methods can be overridden to handle processor-specific
+     operations. *)
+
+  method class_of_operation: Mach.operation -> op_class
+
+  method is_cheap_operation: Mach.operation -> bool
+    (* Operations that are so cheap that it isn't worth factoring them. *)
+
+  (* The following method is the entry point and should not be overridden *)
+  method fundecl: Mach.fundecl -> Mach.fundecl
+
+end
diff --git a/asmcomp/afl_instrument.ml b/asmcomp/afl_instrument.ml
new file mode 100644
index 00000000..7d4b90d2
--- /dev/null
+++ b/asmcomp/afl_instrument.ml
@@ -0,0 +1,110 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Insert instrumentation for afl-fuzz *)
+
+open Lambda
+open Cmm
+
+module V = Backend_var
+module VP = Backend_var.With_provenance
+
+let afl_area_ptr dbg = Cconst_symbol ("caml_afl_area_ptr", dbg)
+let afl_prev_loc dbg = Cconst_symbol ("caml_afl_prev_loc", dbg)
+let afl_map_size = 1 lsl 16
+
+let rec with_afl_logging b dbg =
+  if !Clflags.afl_inst_ratio < 100 &&
+    Random.int 100 >= !Clflags.afl_inst_ratio then instrument b else
+  let instrumentation =
+    (* The instrumentation that afl-fuzz requires is:
+
+         cur_location = ;
+         shared_mem[cur_location ^ prev_location]++;
+         prev_location = cur_location >> 1;
+
+       See http://lcamtuf.coredump.cx/afl/technical_details.txt or
+       docs/technical_details.txt in afl-fuzz source for for a full
+       description of what's going on. *)
+    let cur_location = Random.int afl_map_size in
+    let cur_pos = V.create_local "pos" in
+    let afl_area = V.create_local "shared_mem" in
+    let op oper args = Cop (oper, args, dbg) in
+    Clet(VP.create afl_area,
+      op (Cload (Word_int, Asttypes.Mutable)) [afl_area_ptr dbg],
+      Clet(VP.create cur_pos, op Cxor [op (Cload (Word_int, Asttypes.Mutable))
+        [afl_prev_loc dbg]; Cconst_int (cur_location, dbg)],
+      Csequence(
+        op (Cstore(Byte_unsigned, Assignment))
+          [op Cadda [Cvar afl_area; Cvar cur_pos];
+            op Cadda [op (Cload (Byte_unsigned, Asttypes.Mutable))
+                        [op Cadda [Cvar afl_area; Cvar cur_pos]];
+                      Cconst_int (1, dbg)]],
+        op (Cstore(Word_int, Assignment))
+          [afl_prev_loc dbg; Cconst_int (cur_location lsr 1, dbg)]))) in
+  Csequence(instrumentation, instrument b)
+
+and instrument = function
+  (* these cases add logging, as they may be targets of conditional branches *)
+  | Cifthenelse (cond, t_dbg, t, f_dbg, f, dbg) ->
+     Cifthenelse (instrument cond, t_dbg, with_afl_logging t t_dbg,
+       f_dbg, with_afl_logging f f_dbg, dbg)
+  | Ctrywith (e, ex, handler, dbg) ->
+     Ctrywith (instrument e, ex, with_afl_logging handler dbg, dbg)
+  | Cswitch (e, cases, handlers, dbg) ->
+     let handlers =
+       Array.map (fun (handler, handler_dbg) ->
+           let handler = with_afl_logging handler handler_dbg in
+           handler, handler_dbg)
+         handlers
+     in
+     Cswitch (instrument e, cases, handlers, dbg)
+
+  (* these cases add no logging, but instrument subexpressions *)
+  | Clet (v, e, body) -> Clet (v, instrument e, instrument body)
+  | Clet_mut (v, k, e, body) ->
+    Clet_mut (v, k, instrument e, instrument body)
+  | Cphantom_let (v, defining_expr, body) ->
+    Cphantom_let (v, defining_expr, instrument body)
+  | Cassign (v, e) -> Cassign (v, instrument e)
+  | Ctuple es -> Ctuple (List.map instrument es)
+  | Cop (op, es, dbg) -> Cop (op, List.map instrument es, dbg)
+  | Csequence (e1, e2) -> Csequence (instrument e1, instrument e2)
+  | Ccatch (isrec, cases, body) ->
+     let cases =
+       List.map (fun (nfail, ids, e, dbg) -> nfail, ids, instrument e, dbg)
+         cases
+     in
+     Ccatch (isrec, cases, instrument body)
+  | Cexit (ex, args) -> Cexit (ex, List.map instrument args)
+
+  (* these are base cases and have no logging *)
+  | Cconst_int _ | Cconst_natint _ | Cconst_float _
+  | Cconst_symbol _ | Cconst_pointer _ | Cconst_natpointer _
+  | Cblockheader _ | Cvar _ as c -> c
+
+let instrument_function c dbg =
+  with_afl_logging c dbg
+
+let instrument_initialiser c dbg =
+  (* Each instrumented module calls caml_setup_afl at
+     initialisation, which is a no-op on the second and subsequent
+     calls *)
+  with_afl_logging
+    (Csequence
+       (Cop (Cextcall ("caml_setup_afl", typ_int, false, None),
+             [Cconst_int (0, dbg ())],
+             dbg ()),
+        c))
+    (dbg ())
diff --git a/asmcomp/afl_instrument.mli b/asmcomp/afl_instrument.mli
new file mode 100644
index 00000000..c98cbcd1
--- /dev/null
+++ b/asmcomp/afl_instrument.mli
@@ -0,0 +1,21 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Instrumentation for afl-fuzz. *)
+
+val instrument_function : Cmm.expression -> Debuginfo.t -> Cmm.expression
+val instrument_initialiser
+   : Cmm.expression
+  -> (unit -> Debuginfo.t)
+  -> Cmm.expression
diff --git a/asmcomp/amd64/CSE.ml b/asmcomp/amd64/CSE.ml
new file mode 100644
index 00000000..60503d69
--- /dev/null
+++ b/asmcomp/amd64/CSE.ml
@@ -0,0 +1,41 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* CSE for the AMD64 *)
+
+open Arch
+open Mach
+open CSEgen
+
+class cse = object
+
+inherit cse_generic as super
+
+method! class_of_operation op =
+  match op with
+  | Ispecific spec ->
+    begin match spec with
+    | Ilea _ | Isextend32 | Izextend32 -> Op_pure
+    | Istore_int(_, _, is_asg) -> Op_store is_asg
+    | Ioffset_loc(_, _) -> Op_store true
+    | Ifloatarithmem _ | Ifloatsqrtf _ -> Op_load
+    | Ibswap _ | Isqrtf -> super#class_of_operation op
+    end
+  | _ -> super#class_of_operation op
+
+end
+
+let fundecl f =
+  (new cse)#fundecl f
diff --git a/asmcomp/amd64/NOTES.md b/asmcomp/amd64/NOTES.md
new file mode 100644
index 00000000..b0adc698
--- /dev/null
+++ b/asmcomp/amd64/NOTES.md
@@ -0,0 +1,21 @@
+# Supported platforms
+
+Intel and AMD x86 processors in 64-bit mode, a.k.a `x86_64`.
+
+Floating-point architecture: SSE2, supported by all x86_64 processors.
+
+Operating systems: Linux, BSD, MacOS X, MS Windows.
+
+Debian architecture name: `amd64`
+
+# Reference documents
+
+* Instruction set architecture:
+  any Intel or AMD manual less than 10 years old.
+* ELF application binary interface:
+  _System V Application Binary Interface,
+   AMD64 Architecture Processor Supplement_
+* MacOS X application binary interface:
+  _OS X ABI Function Call Guide: x86-64 Function Calling Conventions_
+* Windows 64 application binary interface:
+  _x64 Software Conventions_ from MSDN
diff --git a/asmcomp/amd64/arch.ml b/asmcomp/amd64/arch.ml
new file mode 100644
index 00000000..effe32ed
--- /dev/null
+++ b/asmcomp/amd64/arch.ml
@@ -0,0 +1,142 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2000 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Machine-specific command-line options *)
+
+let command_line_options =
+  [ "-fPIC", Arg.Set Clflags.pic_code,
+      " Generate position-independent machine code (default)";
+    "-fno-PIC", Arg.Clear Clflags.pic_code,
+      " Generate position-dependent machine code" ]
+
+(* Specific operations for the AMD64 processor *)
+
+open Format
+
+type addressing_mode =
+    Ibased of string * int              (* symbol + displ *)
+  | Iindexed of int                     (* reg + displ *)
+  | Iindexed2 of int                    (* reg + reg + displ *)
+  | Iscaled of int * int                (* reg * scale + displ *)
+  | Iindexed2scaled of int * int        (* reg + reg * scale + displ *)
+
+type specific_operation =
+    Ilea of addressing_mode             (* "lea" gives scaled adds *)
+  | Istore_int of nativeint * addressing_mode * bool
+                                        (* Store an integer constant *)
+  | Ioffset_loc of int * addressing_mode (* Add a constant to a location *)
+  | Ifloatarithmem of float_operation * addressing_mode
+                                       (* Float arith operation with memory *)
+  | Ibswap of int                      (* endianness conversion *)
+  | Isqrtf                             (* Float square root *)
+  | Ifloatsqrtf of addressing_mode     (* Float square root from memory *)
+  | Isextend32                         (* 32 to 64 bit conversion with sign
+                                          extension *)
+  | Izextend32                         (* 32 to 64 bit conversion with zero
+                                          extension *)
+
+and float_operation =
+    Ifloatadd | Ifloatsub | Ifloatmul | Ifloatdiv
+
+let spacetime_node_hole_pointer_is_live_before _specific_op = false
+
+(* Sizes, endianness *)
+
+let big_endian = false
+
+let size_addr = 8
+let size_int = 8
+let size_float = 8
+
+let allow_unaligned_access = true
+
+(* Behavior of division *)
+
+let division_crashes_on_overflow = true
+
+(* Operations on addressing modes *)
+
+let identity_addressing = Iindexed 0
+
+let offset_addressing addr delta =
+  match addr with
+    Ibased(s, n) -> Ibased(s, n + delta)
+  | Iindexed n -> Iindexed(n + delta)
+  | Iindexed2 n -> Iindexed2(n + 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 =
+  match addr with
+  | Ibased(s, 0) ->
+      fprintf ppf "\"%s\"" s
+  | Ibased(s, n) ->
+      fprintf ppf "\"%s\" + %i" s n
+  | Iindexed n ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a%s" printreg arg.(0) idx
+  | Iindexed2 n ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a + %a%s" printreg arg.(0) printreg arg.(1) idx
+  | Iscaled(scale, n) ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a  * %i%s" printreg arg.(0) scale idx
+  | Iindexed2scaled(scale, n) ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a + %a * %i%s" printreg arg.(0) printreg arg.(1) scale idx
+
+let print_specific_operation printreg op ppf arg =
+  match op with
+  | Ilea addr -> print_addressing printreg addr ppf arg
+  | Istore_int(n, addr, is_assign) ->
+      fprintf ppf "[%a] := %nd %s"
+         (print_addressing printreg addr) arg n
+         (if is_assign then "(assign)" else "(init)")
+  | Ioffset_loc(n, addr) ->
+      fprintf ppf "[%a] +:= %i" (print_addressing printreg addr) arg n
+  | Isqrtf ->
+      fprintf ppf "sqrtf %a" printreg arg.(0)
+  | Ifloatsqrtf addr ->
+     fprintf ppf "sqrtf float64[%a]"
+             (print_addressing printreg addr) [|arg.(0)|]
+  | Ifloatarithmem(op, addr) ->
+      let op_name = function
+      | Ifloatadd -> "+f"
+      | Ifloatsub -> "-f"
+      | Ifloatmul -> "*f"
+      | Ifloatdiv -> "/f" in
+      fprintf ppf "%a %s float64[%a]" printreg arg.(0) (op_name op)
+                   (print_addressing printreg addr)
+                   (Array.sub arg 1 (Array.length arg - 1))
+  | Ibswap i ->
+      fprintf ppf "bswap_%i %a" i printreg arg.(0)
+  | Isextend32 ->
+      fprintf ppf "sextend32 %a" printreg arg.(0)
+  | Izextend32 ->
+      fprintf ppf "zextend32 %a" printreg arg.(0)
+
+let win64 =
+  match Config.system with
+  | "win64" | "mingw64" | "cygwin" -> true
+  | _                   -> false
diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
new file mode 100644
index 00000000..d9c5eb6e
--- /dev/null
+++ b/asmcomp/amd64/emit.mlp
@@ -0,0 +1,1182 @@
+# 2 "asmcomp/amd64/emit.mlp"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Emission of Intel x86_64 assembly code *)
+
+open Cmm
+open Arch
+open Proc
+open Reg
+open Mach
+open Linear
+open Emitaux
+
+open X86_ast
+open X86_proc
+open X86_dsl
+module String = Misc.Stdlib.String
+module Int = Numbers.Int
+
+(* [Branch_relaxation] is not used in this file, but is required by
+   emit.mlp files for certain other targets; the reference here ensures
+   that when releases are being prepared the .depend files are correct
+   for all targets. *)
+[@@@ocaml.warning "-66"]
+open! Branch_relaxation
+
+let _label s = D.label ~typ:QWORD s
+
+(* Override proc.ml *)
+
+let int_reg_name =
+  [| RAX; RBX; RDI; RSI; RDX; RCX; R8; R9;
+     R12; R13; R10; R11; RBP; |]
+
+let float_reg_name = Array.init 16 (fun i -> XMM i)
+
+let register_name r =
+  if r < 100 then Reg64 (int_reg_name.(r))
+  else Regf (float_reg_name.(r - 100))
+
+(* CFI directives *)
+
+let cfi_startproc () =
+  if Config.asm_cfi_supported then D.cfi_startproc ()
+
+let cfi_endproc () =
+  if Config.asm_cfi_supported then D.cfi_endproc ()
+
+let cfi_adjust_cfa_offset n =
+  if Config.asm_cfi_supported then D.cfi_adjust_cfa_offset n
+
+let emit_debug_info dbg =
+  emit_debug_info_gen dbg D.file D.loc
+
+let fp = Config.with_frame_pointers
+
+(* Tradeoff between code size and code speed *)
+
+let fastcode_flag = ref true
+
+(* Layout of the stack frame *)
+let stack_offset = ref 0
+
+let num_stack_slots = Array.make Proc.num_register_classes 0
+
+let prologue_required = ref false
+
+let frame_required = ref false
+
+let frame_size () =                     (* includes return address *)
+  if !frame_required then begin
+    let sz =
+      (!stack_offset + 8 * (num_stack_slots.(0) + num_stack_slots.(1)) + 8
+       + (if fp then 8 else 0))
+    in Misc.align sz 16
+  end else
+    !stack_offset + 8
+
+let slot_offset loc cl =
+  match loc with
+  | Incoming n -> frame_size() + n
+  | Local n ->
+      if cl = 0
+      then !stack_offset + n * 8
+      else !stack_offset + (num_stack_slots.(0) + n) * 8
+  | Outgoing n -> n
+
+(* Symbols *)
+
+let symbol_prefix = if system = S_macosx then "_" else ""
+
+let emit_symbol s = string_of_symbol symbol_prefix s
+
+(* Record symbols used and defined - at the end generate extern for those
+   used but not defined *)
+
+let symbols_defined = ref String.Set.empty
+let symbols_used = ref String.Set.empty
+
+let add_def_symbol s = symbols_defined := String.Set.add s !symbols_defined
+let add_used_symbol s = symbols_used := String.Set.add s !symbols_used
+
+let imp_table = Hashtbl.create 16
+
+let reset_imp_table () = Hashtbl.clear imp_table
+
+let get_imp_symbol s =
+  match Hashtbl.find imp_table s with
+  | exception Not_found ->
+      let imps = "__caml_imp_" ^ s in
+      Hashtbl.add imp_table s imps;
+      imps
+  | imps -> imps
+
+let emit_imp_table () =
+  let f s imps =
+    _label (emit_symbol imps);
+    D.qword (ConstLabel (emit_symbol s))
+  in
+  D.data();
+  D.comment "relocation table start";
+  D.align 8;
+  Hashtbl.iter f imp_table;
+  D.comment "relocation table end"
+
+let mem__imp s =
+  let imp_s = get_imp_symbol s in
+  mem64_rip QWORD (emit_symbol imp_s)
+
+let rel_plt s =
+  if windows && !Clflags.dlcode then mem__imp s
+  else
+    sym (if use_plt then emit_symbol s ^ "@PLT" else emit_symbol s)
+
+let emit_call s = I.call (rel_plt s)
+
+let emit_jump s = I.jmp (rel_plt s)
+
+let load_symbol_addr s arg =
+  if !Clflags.dlcode then
+    if windows then begin
+      (* I.mov (mem__imp s) arg (\* mov __caml_imp_foo(%rip), ... *\) *)
+      I.mov (sym (emit_symbol s)) arg (* movabsq $foo, ... *)
+    end else I.mov (mem64_rip QWORD (emit_symbol s ^ "@GOTPCREL")) arg
+  else if !Clflags.pic_code then
+    I.lea (mem64_rip NONE (emit_symbol s)) arg
+  else
+    I.mov (sym (emit_symbol s)) arg
+
+let domain_field f =
+  mem64 QWORD (Domainstate.idx_of_field f * 8) R14
+
+(* Output a label *)
+
+let emit_label lbl =
+  match system with
+  | S_macosx | S_win64 -> "L" ^ Int.to_string lbl
+  | _ -> ".L" ^ Int.to_string lbl
+
+let label s = sym (emit_label s)
+
+(* For Spacetime, keep track of code labels that have been emitted.  *)
+let used_labels = ref Int.Set.empty
+
+let mark_used lbl =
+  if Config.spacetime && not (Int.Set.mem lbl !used_labels) then begin
+    used_labels := Int.Set.add lbl !used_labels
+  end
+
+let def_label ?typ s =
+  mark_used s;
+  D.label ?typ (emit_label s)
+
+let emit_Llabel fallthrough lbl =
+  if not fallthrough && !fastcode_flag then D.align 4;
+  def_label lbl
+
+(* Output a pseudo-register *)
+
+let reg = function
+  | { loc = Reg.Reg r } -> register_name r
+  | { loc = Stack s; typ = Float } as r ->
+      let ofs = slot_offset s (register_class r) in
+      mem64 REAL8 ofs RSP
+  | { loc = Stack s } as r ->
+      let ofs = slot_offset s (register_class r) in
+      mem64 QWORD ofs RSP
+  | { loc = Unknown } ->
+      assert false
+
+let reg64 = function
+  | { loc = Reg.Reg r } -> int_reg_name.(r)
+  | _ -> assert false
+
+
+let res i n = reg i.res.(n)
+
+let arg i n = reg i.arg.(n)
+
+(* Output a reference to the lower 8, 16 or 32 bits of a register *)
+
+let reg_low_8_name  = Array.map (fun r -> Reg8L r) int_reg_name
+let reg_low_16_name = Array.map (fun r -> Reg16 r) int_reg_name
+let reg_low_32_name = Array.map (fun r -> Reg32 r) int_reg_name
+
+let emit_subreg tbl typ r =
+  match r.loc with
+  | Reg.Reg r when r < 13 -> tbl.(r)
+  | Stack s -> mem64 typ (slot_offset s (register_class r)) RSP
+  | _ -> assert false
+
+let arg8 i n = emit_subreg reg_low_8_name BYTE i.arg.(n)
+let arg16 i n = emit_subreg reg_low_16_name WORD i.arg.(n)
+let arg32 i n = emit_subreg reg_low_32_name DWORD i.arg.(n)
+let arg64 i n = reg64 i.arg.(n)
+
+let res16 i n = emit_subreg reg_low_16_name WORD i.res.(n)
+let res32 i n = emit_subreg reg_low_32_name DWORD i.res.(n)
+
+(* Output an addressing mode *)
+
+let addressing addr typ i n =
+  match addr with
+  | Ibased(s, ofs) ->
+      add_used_symbol s;
+      mem64_rip typ (emit_symbol s) ~ofs
+  | Iindexed d ->
+      mem64 typ d (arg64 i n)
+  | Iindexed2 d ->
+      mem64 typ ~base:(arg64 i n) d (arg64 i (n+1))
+  | Iscaled(2, d) ->
+      mem64 typ ~base:(arg64 i n) d (arg64 i n)
+  | Iscaled(scale, d) ->
+      mem64 typ ~scale d (arg64 i n)
+  | Iindexed2scaled(scale, d) ->
+      mem64 typ ~scale ~base:(arg64 i n) d (arg64 i (n+1))
+
+(* Record live pointers at call points -- see Emitaux *)
+
+let record_frame_label ?label live dbg =
+  let lbl =
+    match label with
+    | None -> new_label()
+    | Some label -> label
+  in
+  let live_offset = ref [] in
+  Reg.Set.iter
+    (function
+      | {typ = Val; loc = Reg r} ->
+          live_offset := ((r lsl 1) + 1) :: !live_offset
+      | {typ = Val; loc = Stack s} as reg ->
+          live_offset := slot_offset s (register_class reg) :: !live_offset
+      | {typ = Addr} as r ->
+          Misc.fatal_error ("bad GC root " ^ Reg.name r)
+      | _ -> ()
+    )
+    live;
+  record_frame_descr ~label:lbl ~frame_size:(frame_size())
+    ~live_offset:!live_offset dbg;
+  lbl
+
+let record_frame ?label live dbg =
+  let lbl = record_frame_label ?label live dbg in
+  def_label lbl
+
+(* Spacetime instrumentation *)
+
+let spacetime_before_uninstrumented_call ~node_ptr ~index =
+  (* At the moment, [node_ptr] is pointing at the node for the current
+     OCaml function.  Get hold of the node itself and move the pointer
+     forwards, saving it into the distinguished register.  This is used
+     for instrumentation of function calls (e.g. caml_call_gc and bounds
+     check failures) not inserted until this stage of the compiler
+     pipeline. *)
+  I.mov node_ptr (reg Proc.loc_spacetime_node_hole);
+  assert (index >= 2);
+  I.add (int (index * 8)) (reg Proc.loc_spacetime_node_hole)
+
+(* Record calls to the GC -- we've moved them out of the way *)
+
+type gc_call =
+  { gc_lbl: label;                      (* Entry label *)
+    gc_return_lbl: label;               (* Where to branch after GC *)
+    gc_frame: label;                    (* Label of frame descriptor *)
+    gc_spacetime : (X86_ast.arg * int) option;
+    (* Spacetime node hole pointer and index *)
+  }
+
+let call_gc_sites = ref ([] : gc_call list)
+
+let emit_call_gc gc =
+  def_label gc.gc_lbl;
+  begin match gc.gc_spacetime with
+  | None -> assert (not Config.spacetime)
+  | Some (node_ptr, index) ->
+    assert Config.spacetime;
+    spacetime_before_uninstrumented_call ~node_ptr ~index
+  end;
+  emit_call "caml_call_gc";
+  def_label gc.gc_frame;
+  I.jmp (label gc.gc_return_lbl)
+
+(* Record calls to caml_ml_array_bound_error.
+   In -g mode, or when using Spacetime profiling, we maintain one call to
+   caml_ml_array_bound_error per bound check site.  Without -g, we can share
+   a single call. *)
+
+type bound_error_call =
+  { bd_lbl: label;                      (* Entry label *)
+    bd_frame: label;                    (* Label of frame descriptor *)
+    bd_spacetime : (X86_ast.arg * int) option;
+    (* As for [gc_call]. *)
+  }
+
+let bound_error_sites = ref ([] : bound_error_call list)
+let bound_error_call = ref 0
+
+let bound_error_label ?label dbg ~spacetime =
+  if !Clflags.debug || Config.spacetime then begin
+    let lbl_bound_error = new_label() in
+    let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
+    bound_error_sites :=
+      { bd_lbl = lbl_bound_error; bd_frame = lbl_frame;
+        bd_spacetime = spacetime; } :: !bound_error_sites;
+    lbl_bound_error
+  end else begin
+    if !bound_error_call = 0 then bound_error_call := new_label();
+    !bound_error_call
+  end
+
+let emit_call_bound_error bd =
+  def_label bd.bd_lbl;
+  begin match bd.bd_spacetime with
+  | None -> ()
+  | Some (node_ptr, index) ->
+    spacetime_before_uninstrumented_call ~node_ptr ~index
+  end;
+  emit_call "caml_ml_array_bound_error";
+  def_label bd.bd_frame
+
+let emit_call_bound_errors () =
+  List.iter emit_call_bound_error !bound_error_sites;
+  if !bound_error_call > 0 then begin
+    def_label !bound_error_call;
+    emit_call "caml_ml_array_bound_error"
+  end
+
+(* Names for instructions *)
+
+let instr_for_intop = function
+  | Iadd -> I.add
+  | Isub -> I.sub
+  | Imul -> (fun arg1 arg2 -> I.imul arg1 (Some arg2))
+  | Iand -> I.and_
+  | Ior -> I.or_
+  | Ixor -> I.xor
+  | Ilsl -> I.sal
+  | Ilsr -> I.shr
+  | Iasr -> I.sar
+  | _ -> assert false
+
+let instr_for_floatop = function
+  | Iaddf -> I.addsd
+  | Isubf -> I.subsd
+  | Imulf -> I.mulsd
+  | Idivf -> I.divsd
+  | _ -> assert false
+
+let instr_for_floatarithmem = function
+  | Ifloatadd -> I.addsd
+  | Ifloatsub -> I.subsd
+  | Ifloatmul -> I.mulsd
+  | Ifloatdiv -> I.divsd
+
+let cond = function
+  | Isigned Ceq   -> E   | Isigned Cne   -> NE
+  | Isigned Cle   -> LE  | Isigned Cgt   -> G
+  | Isigned Clt   -> L   | Isigned Cge   -> GE
+  | Iunsigned Ceq -> E   | Iunsigned Cne -> NE
+  | Iunsigned Cle -> BE  | Iunsigned Cgt -> A
+  | Iunsigned Clt -> B   | Iunsigned Cge -> AE
+
+(* Output an = 0 or <> 0 test. *)
+
+let output_test_zero arg =
+  match arg.loc with
+  | Reg.Reg _ -> I.test (reg arg) (reg arg)
+  | _  -> I.cmp (int 0) (reg arg)
+
+(* Output a floating-point compare and branch *)
+
+let emit_float_test cmp i lbl =
+  (* Effect of comisd on flags and conditional branches:
+                     ZF PF CF  cond. branches taken
+        unordered     1  1  1  je, jb, jbe, jp
+        >             0  0  0  jne, jae, ja
+        <             0  0  1  jne, jbe, jb
+        =             1  0  0  je, jae, jbe.
+     If FP traps are on (they are off by default),
+     comisd traps on QNaN and SNaN but ucomisd traps on SNaN only.
+  *)
+  match cmp with
+  | CFeq ->
+      let next = new_label() in
+      I.ucomisd (arg i 1) (arg i 0);
+      I.jp (label next);          (* skip if unordered *)
+      I.je lbl;                   (* branch taken if x=y *)
+      def_label next
+  | CFneq ->
+      I.ucomisd (arg i 1) (arg i 0);
+      I.jp lbl;                   (* branch taken if unordered *)
+      I.jne lbl                   (* branch taken if xy *)
+  | CFlt ->
+      I.comisd (arg i 0) (arg i 1);
+      I.ja lbl                    (* branch taken if y>x i.e. x
+      I.comisd (arg i 0) (arg i 1);
+      I.jbe lbl                   (* taken if unordered or y<=x i.e. !(x
+      I.comisd (arg i 0) (arg i 1);(* swap compare *)
+      I.jae lbl                    (* branch taken if y>=x i.e. x<=y *)
+  | CFnle ->
+      I.comisd (arg i 0) (arg i 1);(* swap compare *)
+      I.jb lbl                     (* taken if unordered or y
+      I.comisd (arg i 1) (arg i 0);
+      I.ja lbl                     (* branch taken if x>y *)
+  | CFngt ->
+      I.comisd (arg i 1) (arg i 0);
+      I.jbe lbl                    (* taken if unordered or x<=y i.e. !(x>y) *)
+  | CFge ->
+      I.comisd (arg i 1) (arg i 0);(* swap compare *)
+      I.jae lbl                    (* branch taken if x>=y *)
+  | CFnge ->
+      I.comisd (arg i 1) (arg i 0);(* swap compare *)
+      I.jb lbl                     (* taken if unordered or x=y) *)
+
+(* Deallocate the stack frame before a return or tail call *)
+
+let output_epilogue f =
+  if !frame_required then begin
+    let n = frame_size() - 8 - (if fp then 8 else 0) in
+    if n <> 0
+    then begin
+      I.add (int n) rsp;
+      cfi_adjust_cfa_offset (-n);
+    end;
+    if fp then I.pop rbp;
+    f ();
+    (* reset CFA back cause function body may continue *)
+    if n <> 0
+    then cfi_adjust_cfa_offset n
+  end
+  else
+    f ()
+
+(* Floating-point constants *)
+
+let float_constants = ref ([] : (int64 * int) list)
+
+let add_float_constant cst =
+  try
+    List.assoc cst !float_constants
+  with Not_found ->
+    let lbl = new_label() in
+    float_constants := (cst, lbl) :: !float_constants;
+    lbl
+
+let emit_float_constant f lbl =
+  _label (emit_label lbl);
+  D.qword (Const f)
+
+let emit_global_label s =
+  let lbl = Compilenv.make_symbol (Some s) in
+  add_def_symbol lbl;
+  let lbl = emit_symbol lbl in
+  D.global lbl;
+  _label lbl
+
+(* Output .text section directive, or named .text.caml. if enabled and
+   supported on the target system. *)
+
+let emit_named_text_section func_name =
+  if !Clflags.function_sections then
+    begin match system with
+    | S_macosx
+    (* Names of section segments in macosx are restricted to 16 characters,
+       but function names are often longer, especially anonymous functions. *)
+    | S_win64 | S_mingw64 | S_cygwin
+    (* Win systems provide named text sections, but configure on these
+       systems does not support function sections. *)
+      ->  assert false
+    | _ -> D.section
+             [ ".text.caml."^(emit_symbol func_name) ]
+             (Some "ax")
+             ["@progbits"]
+    end
+  else D.text ()
+
+(* Output the assembly code for an instruction *)
+
+(* Name of current function *)
+let function_name = ref ""
+(* Entry point for tail recursive calls *)
+let tailrec_entry_point = ref 0
+
+(* Emit an instruction *)
+let emit_instr fallthrough i =
+  emit_debug_info i.dbg;
+  match i.desc with
+  | Lend -> ()
+  | Lprologue ->
+    assert (!prologue_required);
+    if fp then begin
+      I.push rbp;
+      cfi_adjust_cfa_offset 8;
+      I.mov rsp rbp;
+    end;
+    if !frame_required then begin
+      let n = frame_size() - 8 - (if fp then 8 else 0) in
+      if n <> 0
+      then begin
+        I.sub (int n) rsp;
+        cfi_adjust_cfa_offset n;
+      end;
+    end
+  | Lop(Imove | Ispill | Ireload) ->
+      let src = i.arg.(0) and dst = i.res.(0) in
+      if src.loc <> dst.loc then
+        begin match src.typ, src.loc, dst.loc with
+        | Float, Reg.Reg _, Reg.Reg _ -> I.movapd (reg src) (reg dst)
+        | Float, _, _ -> I.movsd (reg src) (reg dst)
+        | _ -> I.mov (reg src) (reg dst)
+        end
+  | Lop(Iconst_int n) ->
+      if n = 0n then begin
+        match i.res.(0).loc with
+        | Reg _ ->
+          (* Clearing the bottom half also clears the top half (except for
+             64-bit-only registers where the behaviour is as if the operands
+             were 64 bit). *)
+          I.xor (res32 i 0) (res32 i 0)
+        | _ ->
+          I.mov (int 0) (res i 0)
+      end else if n > 0n && n <= 0xFFFF_FFFFn then begin
+        match i.res.(0).loc with
+        | Reg _ ->
+          (* Similarly, setting only the bottom half clears the top half. *)
+          I.mov (nat n) (res32 i 0)
+        | _ ->
+          I.mov (nat n) (res i 0)
+      end else
+        I.mov (nat n) (res i 0)
+  | Lop(Iconst_float f) ->
+      begin match f with
+      | 0x0000_0000_0000_0000L ->       (* +0.0 *)
+          I.xorpd (res i 0) (res i 0)
+      | _ ->
+          let lbl = add_float_constant f in
+          I.movsd (mem64_rip NONE (emit_label lbl)) (res i 0)
+      end
+  | Lop(Iconst_symbol s) ->
+      add_used_symbol s;
+      load_symbol_addr s (res i 0)
+  | Lop(Icall_ind { label_after; }) ->
+      I.call (arg i 0);
+      record_frame i.live (Dbg_other i.dbg) ~label:label_after
+  | Lop(Icall_imm { func; label_after; }) ->
+      add_used_symbol func;
+      emit_call func;
+      record_frame i.live (Dbg_other i.dbg) ~label:label_after
+  | Lop(Itailcall_ind { label_after; }) ->
+      output_epilogue begin fun () ->
+        I.jmp (arg i 0);
+        if Config.spacetime then begin
+          record_frame Reg.Set.empty (Dbg_other i.dbg) ~label:label_after
+        end
+      end
+  | Lop(Itailcall_imm { func; label_after; }) ->
+      begin
+        if func = !function_name then
+          I.jmp (label !tailrec_entry_point)
+        else begin
+          output_epilogue begin fun () ->
+            add_used_symbol func;
+            emit_jump func
+          end
+        end
+      end;
+      if Config.spacetime then begin
+        record_frame Reg.Set.empty (Dbg_other i.dbg) ~label:label_after
+      end
+  | Lop(Iextcall { func; alloc; label_after; }) ->
+      add_used_symbol func;
+      if alloc then begin
+        load_symbol_addr func rax;
+        emit_call "caml_c_call";
+        record_frame i.live (Dbg_other i.dbg) ~label:label_after;
+        if system <> S_win64 then begin
+          (* TODO: investigate why such a diff.
+             This comes from:
+            http://caml.inria.fr/cgi-bin/viewvc.cgi?view=revision&revision=12664
+
+             If we do the same for Win64, we probably need to change
+             amd64nt.asm accordingly.
+          *)
+          I.mov (domain_field Domainstate.Domain_young_ptr) r15
+        end
+      end else begin
+        emit_call func;
+        if Config.spacetime then begin
+          record_frame Reg.Set.empty (Dbg_other i.dbg) ~label:label_after
+        end
+      end
+  | Lop(Istackoffset n) ->
+      if n < 0
+      then I.add (int (-n)) rsp
+      else if n > 0
+      then I.sub (int n) rsp;
+      if n <> 0
+      then cfi_adjust_cfa_offset n;
+      stack_offset := !stack_offset + n
+  | Lop(Iload(chunk, addr)) ->
+      let dest = res i 0 in
+      begin match chunk with
+      | Word_int | Word_val ->
+          I.mov (addressing addr QWORD i 0) dest
+      | Byte_unsigned ->
+          I.movzx (addressing addr BYTE i 0) dest
+      | Byte_signed ->
+          I.movsx (addressing addr BYTE i 0) dest
+      | Sixteen_unsigned ->
+          I.movzx (addressing addr WORD i 0) dest
+      | Sixteen_signed ->
+          I.movsx (addressing addr WORD i 0) dest;
+      | Thirtytwo_unsigned ->
+          I.mov (addressing addr DWORD i 0) (res32 i 0)
+      | Thirtytwo_signed ->
+          I.movsxd (addressing addr DWORD i 0) dest
+      | Single ->
+          I.cvtss2sd (addressing addr REAL4 i 0) dest
+      | Double | Double_u ->
+          I.movsd (addressing addr REAL8 i 0) dest
+      end
+  | Lop(Istore(chunk, addr, _)) ->
+      begin match chunk with
+      | Word_int | Word_val ->
+          I.mov (arg i 0) (addressing addr QWORD i 1)
+      | Byte_unsigned | Byte_signed ->
+          I.mov (arg8 i 0) (addressing addr BYTE i 1)
+      | Sixteen_unsigned | Sixteen_signed ->
+          I.mov (arg16 i 0) (addressing addr WORD i 1)
+      | Thirtytwo_signed | Thirtytwo_unsigned ->
+          I.mov (arg32 i 0) (addressing addr DWORD i 1)
+      | Single ->
+          I.cvtsd2ss (arg i 0) xmm15;
+          I.movss xmm15 (addressing addr REAL4 i 1)
+      | Double | Double_u ->
+          I.movsd (arg i 0) (addressing addr REAL8 i 1)
+      end
+  | Lop(Ialloc { bytes = n; label_after_call_gc; spacetime_index; dbginfo }) ->
+      assert (n <= (Config.max_young_wosize + 1) * Arch.size_addr);
+      if !fastcode_flag then begin
+        I.sub (int n) r15;
+        I.cmp (domain_field Domainstate.Domain_young_limit) r15;
+        let lbl_call_gc = new_label() in
+        let lbl_frame =
+          record_frame_label ?label:label_after_call_gc i.live (Dbg_alloc dbginfo)
+        in
+        I.jb (label lbl_call_gc);
+        let lbl_after_alloc = new_label() in
+        def_label lbl_after_alloc;
+        I.lea (mem64 NONE 8 R15) (res i 0);
+        let gc_spacetime =
+          if not Config.spacetime then None
+          else Some (arg i 0, spacetime_index)
+        in
+        call_gc_sites :=
+          { gc_lbl = lbl_call_gc;
+            gc_return_lbl = lbl_after_alloc;
+            gc_frame = lbl_frame;
+            gc_spacetime; } :: !call_gc_sites
+      end else begin
+        if Config.spacetime then begin
+          spacetime_before_uninstrumented_call ~node_ptr:(arg i 0)
+            ~index:spacetime_index;
+        end;
+        begin match n with
+        | 16 -> emit_call "caml_alloc1"
+        | 24 -> emit_call "caml_alloc2"
+        | 32 -> emit_call "caml_alloc3"
+        | _  ->
+            I.sub (int n) r15;
+            emit_call "caml_allocN"
+        end;
+        let label =
+          record_frame_label ?label:label_after_call_gc i.live
+            (Dbg_alloc dbginfo)
+        in
+        def_label label;
+        I.lea (mem64 NONE 8 R15) (res i 0)
+      end
+  | Lop(Iintop(Icomp cmp)) ->
+      I.cmp (arg i 1) (arg i 0);
+      I.set (cond cmp) al;
+      I.movzx al (res i 0)
+  | Lop(Iintop_imm(Icomp cmp, n)) ->
+      I.cmp (int n) (arg i 0);
+      I.set (cond cmp) al;
+      I.movzx al (res i 0)
+  | Lop(Iintop (Icheckbound { label_after_error; spacetime_index; } )) ->
+      let spacetime =
+        if not Config.spacetime then None
+        else Some (arg i 2, spacetime_index)
+      in
+      let lbl = bound_error_label ?label:label_after_error i.dbg ~spacetime in
+      I.cmp (arg i 1) (arg i 0);
+      I.jbe (label lbl)
+  | Lop(Iintop_imm(Icheckbound { label_after_error; spacetime_index; }, n)) ->
+      let spacetime =
+        if not Config.spacetime then None
+        else Some (arg i 1, spacetime_index)
+      in
+      let lbl = bound_error_label ?label:label_after_error i.dbg ~spacetime in
+      I.cmp (int n) (arg i 0);
+      I.jbe (label lbl)
+  | Lop(Iintop(Idiv | Imod)) ->
+      I.cqo ();
+      I.idiv (arg i 1)
+  | Lop(Iintop(Ilsl | Ilsr | Iasr as op)) ->
+      (* We have i.arg.(0) = i.res.(0) and i.arg.(1) = %rcx *)
+      instr_for_intop op cl (res i 0)
+  | Lop(Iintop Imulh) ->
+      I.imul (arg i 1) None
+  | Lop(Iintop op) ->
+      (* We have i.arg.(0) = i.res.(0) *)
+      instr_for_intop op (arg i 1) (res i 0)
+  | Lop(Iintop_imm(Iadd, n)) when i.arg.(0).loc <> i.res.(0).loc ->
+      I.lea (mem64 NONE n (arg64 i 0)) (res i 0)
+  | Lop(Iintop_imm(Iadd, 1) | Iintop_imm(Isub, -1)) ->
+      I.inc (res i 0)
+  | Lop(Iintop_imm(Iadd, -1) | Iintop_imm(Isub, 1)) ->
+      I.dec (res i 0)
+  | Lop(Iintop_imm(op, n)) ->
+      (* We have i.arg.(0) = i.res.(0) *)
+      instr_for_intop op (int n) (res i 0)
+  | Lop(Inegf) ->
+      I.xorpd (mem64_rip OWORD (emit_symbol "caml_negf_mask")) (res i 0)
+  | Lop(Iabsf) ->
+      I.andpd (mem64_rip OWORD (emit_symbol "caml_absf_mask")) (res i 0)
+  | Lop(Iaddf | Isubf | Imulf | Idivf as floatop) ->
+      instr_for_floatop floatop (arg i 1) (res i 0)
+  | Lop(Ifloatofint) ->
+      I.cvtsi2sd  (arg i 0)  (res i 0)
+  | Lop(Iintoffloat) ->
+      I.cvttsd2si (arg i 0) (res i 0)
+  | Lop(Ispecific(Ilea addr)) ->
+      I.lea (addressing addr NONE i 0) (res i 0)
+  | Lop(Ispecific(Istore_int(n, addr, _))) ->
+      I.mov (nat n) (addressing addr QWORD i 0)
+  | Lop(Ispecific(Ioffset_loc(n, addr))) ->
+      I.add (int n) (addressing addr QWORD i 0)
+  | Lop(Ispecific(Ifloatarithmem(op, addr))) ->
+      instr_for_floatarithmem op (addressing addr REAL8 i 1) (res i 0)
+  | Lop(Ispecific(Ibswap 16)) ->
+      I.xchg ah al;
+      I.movzx (res16 i 0) (res i 0)
+  | Lop(Ispecific(Ibswap 32)) ->
+      I.bswap (res32 i 0);
+      I.movsxd (res32 i 0) (res i 0)
+  | Lop(Ispecific(Ibswap 64)) ->
+      I.bswap (res i 0)
+  | Lop(Ispecific(Ibswap _)) ->
+      assert false
+  | Lop(Ispecific Isqrtf) ->
+      if arg i 0 <> res i 0 then
+        I.xorpd (res i 0) (res i 0); (* avoid partial register stall *)
+      I.sqrtsd (arg i 0) (res i 0)
+  | Lop(Ispecific(Ifloatsqrtf addr)) ->
+      I.xorpd (res i 0) (res i 0); (* avoid partial register stall *)
+      I.sqrtsd (addressing addr REAL8 i 0) (res i 0)
+  | Lop(Ispecific(Isextend32)) ->
+      I.movsxd (arg32 i 0) (res i 0)
+  | Lop(Ispecific(Izextend32)) ->
+      I.mov (arg32 i 0) (res32 i 0)
+  | Lop (Iname_for_debugger _) -> ()
+  | Lreloadretaddr ->
+      ()
+  | Lreturn ->
+      output_epilogue begin fun () ->
+        I.ret ()
+      end
+  | Llabel lbl ->
+      emit_Llabel fallthrough lbl
+  | Lbranch lbl ->
+      I.jmp (label lbl)
+  | Lcondbranch(tst, lbl) ->
+      let lbl = label lbl in
+      begin match tst with
+      | Itruetest ->
+          output_test_zero i.arg.(0);
+          I.jne lbl
+      | Ifalsetest ->
+          output_test_zero i.arg.(0);
+          I.je lbl
+      | Iinttest cmp ->
+          I.cmp (arg i 1) (arg i 0);
+          I.j (cond cmp) lbl
+      | Iinttest_imm((Isigned Ceq | Isigned Cne |
+                      Iunsigned Ceq | Iunsigned Cne) as cmp, 0) ->
+          output_test_zero i.arg.(0);
+          I.j (cond cmp) lbl
+      | Iinttest_imm(cmp, n) ->
+          I.cmp (int n) (arg i 0);
+          I.j (cond cmp) lbl
+      | Ifloattest cmp ->
+          emit_float_test cmp i lbl
+      | Ioddtest ->
+          I.test (int 1) (arg8 i 0);
+          I.jne lbl
+      | Ieventest ->
+          I.test (int 1) (arg8 i 0);
+          I.je lbl
+      end
+  | Lcondbranch3(lbl0, lbl1, lbl2) ->
+      I.cmp (int 1) (arg i 0);
+      begin match lbl0 with
+      | None -> ()
+      | Some lbl -> I.jb (label lbl)
+      end;
+      begin match lbl1 with
+      | None -> ()
+      | Some lbl -> I.je (label lbl)
+      end;
+      begin match lbl2 with
+      | None -> ()
+      | Some lbl -> I.ja (label lbl)
+      end
+  | Lswitch jumptbl ->
+      let lbl = emit_label (new_label()) in
+      (* rax and rdx are clobbered by the Lswitch,
+         meaning that no variable that is live across the Lswitch
+         is assigned to rax or rdx.  However, the argument to Lswitch
+         can still be assigned to one of these two registers, so
+         we must be careful not to clobber it before use. *)
+      let (tmp1, tmp2) =
+        if i.arg.(0).loc = Reg 0 (* rax *)
+        then (phys_reg 4 (*rdx*), phys_reg 0 (*rax*))
+        else (phys_reg 0 (*rax*), phys_reg 4 (*rdx*)) in
+
+      I.lea (mem64_rip NONE lbl) (reg tmp1);
+      I.movsxd (mem64 DWORD 0 (arg64 i 0) ~scale:4 ~base:(reg64 tmp1))
+               (reg tmp2);
+      I.add (reg tmp2) (reg tmp1);
+      I.jmp (reg tmp1);
+
+      begin match system with
+      | S_mingw64 | S_cygwin -> D.section [".rdata"] (Some "dr") []
+      | S_macosx | S_win64 -> () (* with LLVM/OS X and MASM, use the text segment *)
+      | _ -> D.section [".rodata"] None []
+      end;
+      D.align 4;
+      _label lbl;
+      for i = 0 to Array.length jumptbl - 1 do
+        D.long (ConstSub (ConstLabel(emit_label jumptbl.(i)),
+                         ConstLabel lbl))
+      done;
+      emit_named_text_section !function_name
+  | Lentertrap ->
+      ()
+  | Ladjust_trap_depth { delta_traps; } ->
+      (* each trap occupies 16 bytes on the stack *)
+      let delta = 16 * delta_traps in
+      cfi_adjust_cfa_offset delta;
+      stack_offset := !stack_offset + delta
+  | Lpushtrap { lbl_handler; } ->
+      let load_label_addr s arg =
+        if !Clflags.pic_code then
+          I.lea (mem64_rip NONE (emit_label s)) arg
+        else
+          I.mov (sym (emit_label s)) arg
+      in
+      load_label_addr lbl_handler r11;
+      I.push r11;
+      cfi_adjust_cfa_offset 8;
+      I.push (domain_field Domainstate.Domain_exception_pointer);
+      cfi_adjust_cfa_offset 8;
+      I.mov rsp (domain_field Domainstate.Domain_exception_pointer);
+      stack_offset := !stack_offset + 16;
+  | Lpoptrap ->
+      I.pop (domain_field Domainstate.Domain_exception_pointer);
+      cfi_adjust_cfa_offset (-8);
+      I.add (int 8) rsp;
+      cfi_adjust_cfa_offset (-8);
+      stack_offset := !stack_offset - 16
+  | Lraise k ->
+      (* No Spacetime instrumentation is required for [caml_raise_exn] and
+         [caml_reraise_exn].  The only function called that might affect the
+         trie is [caml_stash_backtrace], and it does not. *)
+      begin match k with
+      | Lambda.Raise_regular ->
+          I.mov (int 0) (domain_field Domainstate.Domain_backtrace_pos);
+          emit_call "caml_raise_exn";
+          record_frame Reg.Set.empty (Dbg_raise i.dbg)
+      | Lambda.Raise_reraise ->
+          emit_call "caml_raise_exn";
+          record_frame Reg.Set.empty (Dbg_raise i.dbg)
+      | Lambda.Raise_notrace ->
+          I.mov (domain_field Domainstate.Domain_exception_pointer) rsp;
+          I.pop (domain_field Domainstate.Domain_exception_pointer);
+          I.pop r11;
+          I.jmp r11
+      end
+
+let rec emit_all fallthrough i =
+  match i.desc with
+  | Lend -> ()
+  | _ ->
+      emit_instr fallthrough i;
+      emit_all (Linear.has_fallthrough i.desc) i.next
+
+let all_functions = ref []
+
+(* Emission of a function declaration *)
+
+let fundecl fundecl =
+  function_name := fundecl.fun_name;
+  fastcode_flag := fundecl.fun_fast;
+  tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
+  stack_offset := 0;
+  call_gc_sites := [];
+  bound_error_sites := [];
+  bound_error_call := 0;
+  for i = 0 to Proc.num_register_classes - 1 do
+    num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
+  done;
+  prologue_required := fundecl.fun_prologue_required;
+  frame_required := fundecl.fun_frame_required;
+  all_functions := fundecl :: !all_functions;
+  emit_named_text_section !function_name;
+  D.align 16;
+  add_def_symbol fundecl.fun_name;
+  if system = S_macosx
+  && not !Clflags.output_c_object
+  && is_generic_function fundecl.fun_name
+  then (* PR#4690 *)
+    D.private_extern (emit_symbol fundecl.fun_name)
+  else
+    D.global (emit_symbol fundecl.fun_name);
+  D.label (emit_symbol fundecl.fun_name);
+  emit_debug_info fundecl.fun_dbg;
+  cfi_startproc ();
+  emit_all true fundecl.fun_body;
+  List.iter emit_call_gc !call_gc_sites;
+  emit_call_bound_errors ();
+  if !frame_required then begin
+    let n = frame_size() - 8 - (if fp then 8 else 0) in
+    if n <> 0
+    then begin
+      cfi_adjust_cfa_offset (-n);
+    end;
+  end;
+  cfi_endproc ();
+  begin match system with
+  | S_gnu | S_linux ->
+      D.type_ (emit_symbol fundecl.fun_name) "@function";
+      D.size (emit_symbol fundecl.fun_name)
+        (ConstSub (
+            ConstThis,
+            ConstLabel (emit_symbol fundecl.fun_name)))
+  | _ -> ()
+  end
+
+(* Emission of data *)
+
+let emit_item = function
+  | Cglobal_symbol s -> D.global (emit_symbol s)
+  | Cdefine_symbol s -> add_def_symbol s; _label (emit_symbol s)
+  | Cint8 n -> D.byte (const n)
+  | Cint16 n -> D.word (const n)
+  | Cint32 n -> D.long (const_nat n)
+  | Cint n -> D.qword (const_nat n)
+  | Csingle f -> D.long  (Const (Int64.of_int32 (Int32.bits_of_float f)))
+  | Cdouble f -> D.qword (Const (Int64.bits_of_float f))
+  | Csymbol_address s -> add_used_symbol s; D.qword (ConstLabel (emit_symbol s))
+  | Cstring s -> D.bytes s
+  | Cskip n -> if n > 0 then D.space n
+  | Calign n -> D.align n
+
+let data l =
+  D.data ();
+  D.align 8;
+  List.iter emit_item l
+
+(* Beginning / end of an assembly file *)
+
+let begin_assembly() =
+  X86_proc.reset_asm_code ();
+  reset_debug_info();                   (* PR#5603 *)
+  reset_imp_table();
+  float_constants := [];
+  all_functions := [];
+  used_labels := Int.Set.empty;
+  if system = S_win64 then begin
+    D.extrn "caml_call_gc" NEAR;
+    D.extrn "caml_c_call" NEAR;
+    D.extrn "caml_allocN" NEAR;
+    D.extrn "caml_alloc1" NEAR;
+    D.extrn "caml_alloc2" NEAR;
+    D.extrn "caml_alloc3" NEAR;
+    D.extrn "caml_ml_array_bound_error" NEAR;
+    D.extrn "caml_raise_exn" NEAR;
+  end;
+
+
+  if !Clflags.dlcode || Arch.win64 then begin
+    (* from amd64.S; could emit these constants on demand *)
+    begin match system with
+    | S_macosx -> D.section ["__TEXT";"__literal16"] None ["16byte_literals"]
+    | S_mingw64 | S_cygwin -> D.section [".rdata"] (Some "dr") []
+    | S_win64 -> D.data ()
+    | _ -> D.section [".rodata.cst8"] (Some "a") ["@progbits"]
+    end;
+    D.align 16;
+    _label (emit_symbol "caml_negf_mask");
+    D.qword (Const 0x8000000000000000L);
+    D.qword (Const 0L);
+    D.align 16;
+    _label (emit_symbol "caml_absf_mask");
+    D.qword (Const 0x7FFFFFFFFFFFFFFFL);
+    D.qword (Const 0xFFFFFFFFFFFFFFFFL);
+  end;
+
+  D.data ();
+  emit_global_label "data_begin";
+
+  emit_named_text_section (Compilenv.make_symbol (Some "code_begin"));
+  emit_global_label "code_begin";
+  if system = S_macosx then I.nop (); (* PR#4690 *)
+  ()
+
+let emit_spacetime_shapes () =
+  D.data ();
+  D.align 8;
+  emit_global_label "spacetime_shapes";
+  List.iter (fun fundecl ->
+      (* CR-someday mshinwell: some of this should be platform independent *)
+      begin match fundecl.fun_spacetime_shape with
+      | None -> ()
+      | Some shape ->
+        (* Instrumentation that refers to dead code may have been eliminated. *)
+        match List.filter (fun (_, l) -> Int.Set.mem l !used_labels) shape with
+        | [] -> ()
+        | shape ->
+          let funsym = emit_symbol fundecl.fun_name in
+          D.comment ("Shape for " ^ funsym ^ ":");
+          D.qword (ConstLabel funsym);
+          List.iter (fun (part_of_shape, label) ->
+            let tag =
+              match part_of_shape with
+              | Direct_call_point _ -> 1
+              | Indirect_call_point -> 2
+              | Allocation_point -> 3
+            in
+            D.qword (Const (Int64.of_int tag));
+            D.qword (ConstLabel (emit_label label));
+            begin match part_of_shape with
+            | Direct_call_point { callee; } ->
+              D.qword (ConstLabel (emit_symbol callee))
+            | Indirect_call_point -> ()
+            | Allocation_point -> ()
+            end)
+            shape;
+          D.qword (Const 0L)
+      end)
+    !all_functions;
+  D.qword (Const 0L);
+  D.comment "End of Spacetime shapes."
+
+let end_assembly() =
+  if !float_constants <> [] then begin
+    begin match system with
+    | S_macosx -> D.section ["__TEXT";"__literal8"] None ["8byte_literals"]
+    | S_mingw64 | S_cygwin -> D.section [".rdata"] (Some "dr") []
+    | S_win64 -> D.data ()
+    | _ -> D.section [".rodata.cst8"] (Some "a") ["@progbits"]
+    end;
+    List.iter (fun (cst,lbl) -> emit_float_constant cst lbl) !float_constants
+  end;
+
+  emit_named_text_section (Compilenv.make_symbol (Some "code_end"));
+  if system = S_macosx then I.nop ();
+  (* suppress "ld warning: atom sorting error" *)
+
+  emit_global_label "code_end";
+
+  emit_imp_table();
+
+  D.data ();
+  D.qword (const 0);  (* PR#6329 *)
+  emit_global_label "data_end";
+  D.qword (const 0);
+
+  D.align 8;                            (* PR#7591 *)
+  emit_global_label "frametable";
+
+  let setcnt = ref 0 in
+  emit_frames
+    { efa_code_label = (fun l -> D.qword (ConstLabel (emit_label l)));
+      efa_data_label = (fun l -> D.qword (ConstLabel (emit_label l)));
+      efa_8 = (fun n -> D.byte (const n));
+      efa_16 = (fun n -> D.word (const n));
+      efa_32 = (fun n -> D.long (const_32 n));
+      efa_word = (fun n -> D.qword (const n));
+      efa_align = D.align;
+      efa_label_rel =
+        (fun lbl ofs ->
+           let c =
+             ConstAdd (
+               ConstSub(ConstLabel(emit_label lbl), ConstThis),
+               const_32 ofs
+             ) in
+           if system = S_macosx then begin
+             incr setcnt;
+             let s = Printf.sprintf "L$set$%d" !setcnt in
+             D.setvar (s, c);
+             D.long (ConstLabel s)
+           end else
+             D.long c
+        );
+      efa_def_label = (fun l -> _label (emit_label l));
+      efa_string = (fun s -> D.bytes (s ^ "\000"))
+    };
+
+  if system = S_linux then begin
+    let frametable = emit_symbol (Compilenv.make_symbol (Some "frametable")) in
+    D.size frametable (ConstSub (ConstThis, ConstLabel frametable))
+  end;
+
+  if Config.spacetime then begin
+    emit_spacetime_shapes ()
+  end;
+
+  if system = S_linux then
+    (* Mark stack as non-executable, PR#4564 *)
+    D.section [".note.GNU-stack"] (Some "") [ "%progbits" ];
+
+  if system = S_win64 then begin
+    D.comment "External functions";
+    String.Set.iter
+      (fun s ->
+         if not (String.Set.mem s !symbols_defined) then
+           D.extrn (emit_symbol s) NEAR)
+      !symbols_used;
+    symbols_used := String.Set.empty;
+    symbols_defined := String.Set.empty;
+  end;
+
+  let asm =
+    if !Emitaux.create_asm_file then
+      Some
+        (
+         (if X86_proc.masm then X86_masm.generate_asm
+          else X86_gas.generate_asm) !Emitaux.output_channel
+        )
+    else
+      None
+  in
+  X86_proc.generate_code asm
diff --git a/asmcomp/amd64/proc.ml b/asmcomp/amd64/proc.ml
new file mode 100644
index 00000000..05b9633d
--- /dev/null
+++ b/asmcomp/amd64/proc.ml
@@ -0,0 +1,400 @@
+# 2 "asmcomp/amd64/proc.ml"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2000 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Description of the AMD64 processor *)
+
+open Misc
+open Arch
+open Cmm
+open Reg
+open Mach
+
+let fp = Config.with_frame_pointers
+
+(* Which ABI to use *)
+
+let win64 = Arch.win64
+
+(* Registers available for register allocation *)
+
+(* Register map:
+    rax         0
+    rbx         1
+    rdi         2
+    rsi         3
+    rdx         4
+    rcx         5
+    r8          6
+    r9          7
+    r12         8
+    r13         9
+    r10         10
+    r11         11
+    rbp         12
+    r14         domain state pointer
+    r15         allocation pointer
+
+  xmm0 - xmm15  100 - 115  *)
+
+(* Conventions:
+     rax - r13: OCaml function arguments
+     rax: OCaml and C function results
+     xmm0 - xmm9: OCaml function arguments
+     xmm0: OCaml and C function results
+   Under Unix:
+     rdi, rsi, rdx, rcx, r8, r9: C function arguments
+     xmm0 - xmm7: C function arguments
+     rbx, rbp, r12-r15 are preserved by C
+     xmm registers are not preserved by C
+   Under Win64:
+     rcx, rdx, r8, r9: C function arguments
+     xmm0 - xmm3: C function arguments
+     rbx, rbp, rsi, rdi r12-r15 are preserved by C
+     xmm6-xmm15 are preserved by C
+   Note (PR#5707, GPR#1304): PLT stubs (used for dynamic resolution of symbols
+     on Unix-like platforms) may clobber any register except those used for:
+       1. C parameter passing;
+       2. C return values;
+       3. C callee-saved registers.
+     This translates to the set { r10, r11 }.  These registers hence cannot
+     be used for OCaml parameter passing and must also be marked as
+     destroyed across [Ialloc] (otherwise a call to caml_call_gc@PLT might
+     clobber these two registers before the assembly stub saves them into
+     the GC regs block).
+*)
+
+let max_arguments_for_tailcalls = 10
+
+let int_reg_name =
+  match Config.ccomp_type with
+  | "msvc" ->
+      [| "rax"; "rbx"; "rdi"; "rsi"; "rdx"; "rcx"; "r8"; "r9";
+         "r12"; "r13"; "r10"; "r11"; "rbp" |]
+  | _ ->
+      [| "%rax"; "%rbx"; "%rdi"; "%rsi"; "%rdx"; "%rcx"; "%r8"; "%r9";
+         "%r12"; "%r13"; "%r10"; "%r11"; "%rbp" |]
+
+let float_reg_name =
+  match Config.ccomp_type with
+  | "msvc" ->
+      [| "xmm0"; "xmm1"; "xmm2"; "xmm3"; "xmm4"; "xmm5"; "xmm6"; "xmm7";
+         "xmm8"; "xmm9"; "xmm10"; "xmm11";
+         "xmm12"; "xmm13"; "xmm14"; "xmm15" |]
+  | _ ->
+      [| "%xmm0"; "%xmm1"; "%xmm2"; "%xmm3"; "%xmm4"; "%xmm5"; "%xmm6"; "%xmm7";
+         "%xmm8"; "%xmm9"; "%xmm10"; "%xmm11";
+         "%xmm12"; "%xmm13"; "%xmm14"; "%xmm15" |]
+
+let num_register_classes = 2
+
+let register_class r =
+  match r.typ with
+  | Val | Int | Addr -> 0
+  | Float -> 1
+
+let num_available_registers = [| 13; 16 |]
+
+let first_available_register = [| 0; 100 |]
+
+let register_name r =
+  if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100)
+
+(* Pack registers starting at %rax so as to reduce the number of REX
+   prefixes and thus improve code density *)
+let rotate_registers = false
+
+(* Representation of hard registers by pseudo-registers *)
+
+let hard_int_reg =
+  let v = Array.make 13 Reg.dummy in
+  for i = 0 to 12 do v.(i) <- Reg.at_location Int (Reg i) done;
+  v
+
+let hard_float_reg =
+  let v = Array.make 16 Reg.dummy in
+  for i = 0 to 15 do v.(i) <- Reg.at_location Float (Reg (100 + i)) done;
+  v
+
+let all_phys_regs =
+  Array.append hard_int_reg hard_float_reg
+
+let phys_reg n =
+  if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
+
+let rax = phys_reg 0
+let rdx = phys_reg 4
+let r10 = phys_reg 10
+let r11 = phys_reg 11
+let r13 = phys_reg 9
+let rbp = phys_reg 12
+let rxmm15 = phys_reg 115
+
+let destroyed_by_plt_stub =
+  if not X86_proc.use_plt then [| |] else [| r10; r11 |]
+
+let num_destroyed_by_plt_stub = Array.length destroyed_by_plt_stub
+
+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 calling_conventions first_int last_int first_float last_float make_stack
+                        arg =
+  let loc = Array.make (Array.length arg) Reg.dummy in
+  let int = ref first_int in
+  let float = ref first_float in
+  let ofs = ref 0 in
+  for i = 0 to Array.length arg - 1 do
+    match arg.(i).typ with
+    | Val | Int | Addr as ty ->
+        if !int <= last_int then begin
+          loc.(i) <- phys_reg !int;
+          incr int
+        end else begin
+          loc.(i) <- stack_slot (make_stack !ofs) ty;
+          ofs := !ofs + size_int
+        end;
+        assert (not (Reg.Set.mem loc.(i) destroyed_by_plt_stub_set))
+    | Float ->
+        if !float <= last_float then begin
+          loc.(i) <- phys_reg !float;
+          incr float
+        end else begin
+          loc.(i) <- stack_slot (make_stack !ofs) Float;
+          ofs := !ofs + size_float
+        end
+  done;
+  (loc, Misc.align !ofs 16)  (* keep stack 16-aligned *)
+
+let incoming ofs = Incoming ofs
+let outgoing ofs = Outgoing ofs
+let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
+
+let max_int_args_in_regs () =
+  if Config.spacetime then 9 else 10
+
+let loc_arguments arg =
+  calling_conventions 0 ((max_int_args_in_regs ()) - 1) 100 109 outgoing arg
+let loc_parameters arg =
+  let (loc, _ofs) =
+    calling_conventions 0 ((max_int_args_in_regs ()) - 1) 100 109 incoming arg
+  in
+  loc
+let loc_results res =
+  let (loc, _ofs) = calling_conventions 0 0 100 100 not_supported res in loc
+
+let loc_spacetime_node_hole = r13
+
+(* C calling conventions under Unix:
+     first integer args in rdi, rsi, rdx, rcx, r8, r9
+     first float args in xmm0 ... xmm7
+     remaining args on stack
+     return value in rax or xmm0.
+  C calling conventions under Win64:
+     first integer args in rcx, rdx, r8, r9
+     first float args in xmm0 ... xmm3
+     each integer arg consumes a float reg, and conversely
+     remaining args on stack
+     always 32 bytes reserved at bottom of stack.
+     Return value in rax or xmm0. *)
+
+let loc_external_results res =
+  let (loc, _ofs) = calling_conventions 0 0 100 100 not_supported res in loc
+
+let unix_loc_external_arguments arg =
+  calling_conventions 2 7 100 107 outgoing arg
+
+let win64_int_external_arguments =
+  [| 5 (*rcx*); 4 (*rdx*); 6 (*r8*); 7 (*r9*) |]
+let win64_float_external_arguments =
+  [| 100 (*xmm0*); 101 (*xmm1*); 102 (*xmm2*); 103 (*xmm3*) |]
+
+let win64_loc_external_arguments arg =
+  let loc = Array.make (Array.length arg) Reg.dummy in
+  let reg = ref 0
+  and ofs = ref 32 in
+  for i = 0 to Array.length arg - 1 do
+    match arg.(i).typ with
+    | Val | Int | Addr as ty ->
+        if !reg < 4 then begin
+          loc.(i) <- phys_reg win64_int_external_arguments.(!reg);
+          incr reg
+        end else begin
+          loc.(i) <- stack_slot (Outgoing !ofs) ty;
+          ofs := !ofs + size_int
+        end
+    | Float ->
+        if !reg < 4 then begin
+          loc.(i) <- phys_reg win64_float_external_arguments.(!reg);
+          incr reg
+        end else begin
+          loc.(i) <- stack_slot (Outgoing !ofs) Float;
+          ofs := !ofs + size_float
+        end
+  done;
+  (loc, Misc.align !ofs 16)  (* keep stack 16-aligned *)
+
+let loc_external_arguments arg =
+  let arg =
+    Array.map (fun regs -> assert (Array.length regs = 1); regs.(0)) arg
+  in
+  let loc, alignment =
+    if win64 then win64_loc_external_arguments arg
+    else unix_loc_external_arguments arg
+  in
+  Array.map (fun reg -> [|reg|]) loc, alignment
+
+let loc_exn_bucket = rax
+
+(** See "System V Application Binary Interface, AMD64 Architecture Processor
+    Supplement" (www.x86-64.org/documentation/abi.pdf) page 57, fig. 3.36. *)
+let int_dwarf_reg_numbers =
+  [| 0; 3; 5; 4; 1; 2; 8; 9; 12; 13; 10; 11; 6 |]
+
+let float_dwarf_reg_numbers =
+  [| 17; 18; 19; 20; 21; 22; 23; 24; 25; 26; 27; 28; 29; 30; 31; 32 |]
+
+let dwarf_register_numbers ~reg_class =
+  match reg_class with
+  | 0 -> int_dwarf_reg_numbers
+  | 1 -> float_dwarf_reg_numbers
+  | _ -> Misc.fatal_errorf "Bad register class %d" reg_class
+
+let stack_ptr_dwarf_register_number = 7
+
+(* Volatile registers: none *)
+
+let regs_are_volatile _rs = false
+
+(* Registers destroyed by operations *)
+
+let destroyed_at_c_call =
+  if win64 then
+    (* Win64: rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15 preserved *)
+    Array.of_list(List.map phys_reg
+      [0;4;5;6;7;10;11;
+       100;101;102;103;104;105])
+  else
+    (* Unix: rbp, rbx, r12-r15 preserved *)
+    Array.of_list(List.map phys_reg
+      [0;2;3;4;5;6;7;10;11;
+       100;101;102;103;104;105;106;107;
+       108;109;110;111;112;113;114;115])
+
+let destroyed_by_spacetime_at_alloc =
+  if Config.spacetime then
+    [| loc_spacetime_node_hole |]
+  else
+    [| |]
+
+let destroyed_at_alloc =
+  let regs =
+    if X86_proc.use_plt then
+      destroyed_by_plt_stub
+    else
+      [| r11 |]
+  in
+  Array.concat [regs; destroyed_by_spacetime_at_alloc]
+
+let destroyed_at_oper = function
+    Iop(Icall_ind _ | Icall_imm _ | Iextcall { alloc = true; }) ->
+    all_phys_regs
+  | Iop(Iextcall { alloc = false; }) -> destroyed_at_c_call
+  | Iop(Iintop(Idiv | Imod)) | Iop(Iintop_imm((Idiv | Imod), _))
+        -> [| rax; rdx |]
+  | Iop(Istore(Single, _, _)) -> [| rxmm15 |]
+  | Iop(Ialloc _) -> destroyed_at_alloc
+  | Iop(Iintop(Imulh | Icomp _) | Iintop_imm((Icomp _), _))
+        -> [| rax |]
+  | Iop (Iintop (Icheckbound _)) when Config.spacetime ->
+      [| loc_spacetime_node_hole |]
+  | Iop (Iintop_imm(Icheckbound _, _)) when Config.spacetime ->
+      [| loc_spacetime_node_hole |]
+  | Iswitch(_, _) -> [| rax; rdx |]
+  | Itrywith _ -> [| r11 |]
+  | _ ->
+    if fp then
+(* prevent any use of the frame pointer ! *)
+      [| rbp |]
+    else
+      [||]
+
+
+let destroyed_at_raise = all_phys_regs
+
+let destroyed_at_reloadretaddr = [| |]
+
+(* Maximal register pressure *)
+
+
+let safe_register_pressure = function
+    Iextcall _ -> if win64 then if fp then 7 else 8 else 0
+  | _ -> if fp then 10 else 11
+
+let max_register_pressure = function
+    Iextcall _ ->
+      if win64 then
+        if fp then [| 7; 10 |]  else [| 8; 10 |]
+        else
+        if fp then [| 3; 0 |] else  [| 4; 0 |]
+  | Iintop(Idiv | Imod) | Iintop_imm((Idiv | Imod), _) ->
+    if fp then [| 10; 16 |] else [| 11; 16 |]
+  | Ialloc _ ->
+    if fp then [| 11 - num_destroyed_by_plt_stub; 16 |]
+    else [| 12 - num_destroyed_by_plt_stub; 16 |]
+  | Iintop(Icomp _) | Iintop_imm((Icomp _), _) ->
+    if fp then [| 11; 16 |] else [| 12; 16 |]
+  | Istore(Single, _, _) ->
+    if fp then [| 12; 15 |] else [| 13; 15 |]
+  | _ -> if fp then [| 12; 16 |] else [| 13; 16 |]
+
+(* Pure operations (without any side effect besides updating their result
+   registers). *)
+
+let op_is_pure = function
+  | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
+  | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false
+  | Ispecific(Ilea _|Isextend32|Izextend32) -> true
+  | Ispecific _ -> false
+  | _ -> true
+
+(* Layout of the stack frame *)
+
+let frame_required fd =
+  fp || fd.fun_contains_calls ||
+  fd.fun_num_stack_slots.(0) > 0 || fd.fun_num_stack_slots.(1) > 0
+
+let prologue_required fd =
+  frame_required fd
+
+(* Calling the assembler *)
+
+let assemble_file infile outfile =
+  X86_proc.assemble_file infile outfile
+
+let init () =
+  if fp then begin
+    num_available_registers.(0) <- 12
+  end else
+    num_available_registers.(0) <- 13
diff --git a/asmcomp/amd64/reload.ml b/asmcomp/amd64/reload.ml
new file mode 100644
index 00000000..16819c09
--- /dev/null
+++ b/asmcomp/amd64/reload.ml
@@ -0,0 +1,128 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2000 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Cmm
+open Reg
+open Mach
+
+(* Reloading for the AMD64 *)
+
+(* Summary of instruction set constraints:
+   "S" means either stack or register, "R" means register only.
+   Operation                    Res     Arg1    Arg2
+     Imove                      R       S
+                             or S       R
+     Iconst_int                 S if 32-bit signed, R otherwise
+     Iconst_float               R
+     Iconst_symbol (not PIC)    S
+     Iconst_symbol (PIC)        R
+     Icall_ind                          R
+     Itailcall_ind                      R
+     Iload                      R       R       R
+     Istore                             R       R
+     Iintop(Icomp)              R       R       S
+                            or  S       S       R
+     Iintop(Imul|Idiv|Imod)     R       R       S
+     Iintop(Imulh)              R       R       S
+     Iintop(shift)              S       S       R
+     Iintop(others)             R       R       S
+                            or  S       S       R
+     Iintop_imm(Iadd, n)/lea    R       R
+     Iintop_imm(others)         S       S
+     Inegf...Idivf              R       R       S
+     Ifloatofint                R       S
+     Iintoffloat                R       S
+     Ispecific(Ilea)            R       R       R
+     Ispecific(Ifloatarithmem)  R       R       R
+
+   Conditional branches:
+     Iinttest                           S       R
+                                    or  R       S
+     Ifloattest                         R       S    (or  S R if swapped test)
+     other tests                        S
+*)
+
+let stackp r =
+  match r.loc with
+    Stack _ -> true
+  | _ -> false
+
+class reload = object (self)
+
+inherit Reloadgen.reload_generic as super
+
+method! reload_operation op arg res =
+  match op with
+  | Iintop(Iadd|Isub|Iand|Ior|Ixor|Icomp _|Icheckbound _) ->
+      (* One of the two arguments can reside in the stack, but not both *)
+      if stackp arg.(0) && stackp arg.(1)
+      then ([|arg.(0); self#makereg arg.(1)|], res)
+      else (arg, res)
+  | Iintop_imm(Iadd, _) when arg.(0).loc <> res.(0).loc ->
+      (* This add will be turned into a lea; args and results must be
+         in registers *)
+      super#reload_operation op arg res
+  | Iintop(Imulh | Idiv | Imod | Ilsl | Ilsr | Iasr)
+  | Iintop_imm(_, _) ->
+      (* The argument(s) and results can be either in register or on stack *)
+      (* Note: Imulh, Idiv, Imod: arg(0) and res(0) already forced in regs
+               Ilsl, Ilsr, Iasr: arg(1) already forced in regs *)
+      (arg, res)
+  | Iintop(Imul) | Iaddf | Isubf | Imulf | Idivf ->
+      (* First argument (= result) must be in register, second arg
+         can reside in the stack *)
+      if stackp arg.(0)
+      then (let r = self#makereg arg.(0) in ([|r; arg.(1)|], [|r|]))
+      else (arg, res)
+  | Ifloatofint | Iintoffloat ->
+      (* Result must be in register, but argument can be on stack *)
+      (arg, (if stackp res.(0) then [| self#makereg res.(0) |] else res))
+  | Iconst_int n ->
+      if n <= 0x7FFFFFFFn && n >= -0x80000000n
+      then (arg, res)
+      else super#reload_operation op arg res
+  | Iconst_symbol _ ->
+      if !Clflags.pic_code || !Clflags.dlcode || Arch.win64
+      then super#reload_operation op arg res
+      else (arg, res)
+  | _ -> (* Other operations: all args and results in registers *)
+      super#reload_operation op arg res
+
+method! reload_test tst arg =
+  match tst with
+    Iinttest _ ->
+      (* One of the two arguments can reside on stack *)
+      if stackp arg.(0) && stackp arg.(1)
+      then [| self#makereg arg.(0); arg.(1) |]
+      else arg
+  | Ifloattest (CFlt | CFnlt | CFle | CFnle) ->
+      (* Cf. emit.mlp: we swap arguments in this case *)
+      (* First argument can be on stack, second must be in register *)
+      if stackp arg.(1)
+      then [| arg.(0); self#makereg arg.(1) |]
+      else arg
+  | Ifloattest (CFeq | CFneq | CFgt | CFngt | CFge | CFnge) ->
+      (* Second argument can be on stack, first must be in register *)
+      if stackp arg.(0)
+      then [| self#makereg arg.(0); arg.(1) |]
+      else arg
+  | _ ->
+      (* The argument(s) can be either in register or on stack *)
+      arg
+
+end
+
+let fundecl f num_stack_slots =
+  (new reload)#fundecl f num_stack_slots
diff --git a/asmcomp/amd64/scheduling.ml b/asmcomp/amd64/scheduling.ml
new file mode 100644
index 00000000..2c4b072b
--- /dev/null
+++ b/asmcomp/amd64/scheduling.ml
@@ -0,0 +1,21 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2000 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open! Schedgen (* to create a dependency *)
+
+(* Scheduling is turned off because the processor schedules dynamically
+   much better than what we could do. *)
+
+let fundecl f = f
diff --git a/asmcomp/amd64/selection.ml b/asmcomp/amd64/selection.ml
new file mode 100644
index 00000000..bd7871cf
--- /dev/null
+++ b/asmcomp/amd64/selection.ml
@@ -0,0 +1,288 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2000 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Instruction selection for the AMD64 *)
+
+open Arch
+open Proc
+open Cmm
+open Mach
+
+(* Auxiliary for recognizing addressing modes *)
+
+type addressing_expr =
+    Asymbol of string
+  | Alinear of expression
+  | Aadd of expression * expression
+  | Ascale of expression * int
+  | Ascaledadd of expression * expression * int
+
+let rec select_addr exp =
+  match exp with
+    Cconst_symbol (s, _) when not !Clflags.dlcode ->
+      (Asymbol s, 0)
+  | Cop((Caddi | Caddv | Cadda), [arg; Cconst_int (m, _)], _) ->
+      let (a, n) = select_addr arg in (a, n + m)
+  | Cop(Csubi, [arg; Cconst_int (m, _)], _) ->
+      let (a, n) = select_addr arg in (a, n - m)
+  | Cop((Caddi | Caddv | Cadda), [Cconst_int (m, _); arg], _) ->
+      let (a, n) = select_addr arg in (a, n + m)
+  | Cop(Clsl, [arg; Cconst_int((1|2|3 as shift), _)], _) ->
+      begin match select_addr arg with
+        (Alinear e, n) -> (Ascale(e, 1 lsl shift), n lsl shift)
+      | _ -> (Alinear exp, 0)
+      end
+  | Cop(Cmuli, [arg; Cconst_int((2|4|8 as mult), _)], _) ->
+      begin match select_addr arg with
+        (Alinear e, n) -> (Ascale(e, mult), n * mult)
+      | _ -> (Alinear exp, 0)
+      end
+  | Cop(Cmuli, [Cconst_int((2|4|8 as mult), _); arg], _) ->
+      begin match select_addr arg with
+        (Alinear e, n) -> (Ascale(e, mult), n * mult)
+      | _ -> (Alinear exp, 0)
+      end
+  | Cop((Caddi | Caddv | Cadda), [arg1; arg2], _) ->
+      begin match (select_addr arg1, select_addr arg2) with
+          ((Alinear e1, n1), (Alinear e2, n2)) ->
+              (Aadd(e1, e2), n1 + n2)
+        | ((Alinear e1, n1), (Ascale(e2, scale), n2)) ->
+              (Ascaledadd(e1, e2, scale), n1 + n2)
+        | ((Ascale(e1, scale), n1), (Alinear e2, n2)) ->
+              (Ascaledadd(e2, e1, scale), n1 + n2)
+        | (_, (Ascale(e2, scale), n2)) ->
+              (Ascaledadd(arg1, e2, scale), n2)
+        | ((Ascale(e1, scale), n1), _) ->
+              (Ascaledadd(arg2, e1, scale), n1)
+        | _ ->
+              (Aadd(arg1, arg2), 0)
+      end
+  | arg ->
+      (Alinear arg, 0)
+
+(* Special constraints on operand and result registers *)
+
+exception Use_default
+
+let rax = phys_reg 0
+let rcx = phys_reg 5
+let rdx = phys_reg 4
+
+let pseudoregs_for_operation op arg res =
+  match op with
+  (* Two-address binary operations: arg.(0) and res.(0) must be the same *)
+    Iintop(Iadd|Isub|Imul|Iand|Ior|Ixor) | Iaddf|Isubf|Imulf|Idivf ->
+      ([|res.(0); arg.(1)|], res)
+  (* One-address unary operations: arg.(0) and res.(0) must be the same *)
+  | Iintop_imm((Iadd|Isub|Imul|Iand|Ior|Ixor|Ilsl|Ilsr|Iasr), _)
+  | Iabsf | Inegf
+  | Ispecific(Ibswap (32|64)) ->
+      (res, res)
+  (* For xchg, args must be a register allowing access to high 8 bit register
+     (rax, rbx, rcx or rdx). Keep it simple, just force the argument in rax. *)
+  | Ispecific(Ibswap 16) ->
+      ([| rax |], [| rax |])
+  (* For imulq, first arg must be in rax, rax is clobbered, and result is in
+     rdx. *)
+  | Iintop(Imulh) ->
+      ([| rax; arg.(1) |], [| rdx |])
+  | Ispecific(Ifloatarithmem(_,_)) ->
+      let arg' = Array.copy arg in
+      arg'.(0) <- res.(0);
+      (arg', res)
+  (* For shifts with variable shift count, second arg must be in rcx *)
+  | Iintop(Ilsl|Ilsr|Iasr) ->
+      ([|res.(0); rcx|], res)
+  (* For div and mod, first arg must be in rax, rdx is clobbered,
+     and result is in rax or rdx respectively.
+     Keep it simple, just force second argument in rcx. *)
+  | Iintop(Idiv) ->
+      ([| rax; rcx |], [| rax |])
+  | Iintop(Imod) ->
+      ([| rax; rcx |], [| rdx |])
+  (* Other instructions are regular *)
+  | _ -> raise Use_default
+
+(* If you update [inline_ops], you may need to update [is_simple_expr] and/or
+   [effects_of], below. *)
+let inline_ops =
+  [ "sqrt"; "caml_bswap16_direct"; "caml_int32_direct_bswap";
+    "caml_int64_direct_bswap"; "caml_nativeint_direct_bswap" ]
+
+(* The selector class *)
+
+class selector = object (self)
+
+inherit Spacetime_profiling.instruction_selection as super
+
+method is_immediate n = n <= 0x7FFF_FFFF && n >= (-1-0x7FFF_FFFF)
+  (* -1-.... : hack so that this can be compiled on 32-bit
+     (cf 'make check_all_arches') *)
+
+method is_immediate_natint n = n <= 0x7FFFFFFFn && n >= -0x80000000n
+
+method! is_simple_expr e =
+  match e with
+  | Cop(Cextcall (fn, _, _, _), args, _)
+    when List.mem fn inline_ops ->
+      (* inlined ops are simple if their arguments are *)
+      List.for_all self#is_simple_expr args
+  | _ ->
+      super#is_simple_expr e
+
+method! effects_of e =
+  match e with
+  | Cop(Cextcall(fn, _, _, _), args, _)
+    when List.mem fn inline_ops ->
+      Selectgen.Effect_and_coeffect.join_list_map args self#effects_of
+  | _ ->
+      super#effects_of e
+
+method select_addressing _chunk exp =
+  let (a, d) = select_addr exp in
+  (* PR#4625: displacement must be a signed 32-bit immediate *)
+  if not (self # is_immediate d)
+  then (Iindexed 0, exp)
+  else match a with
+    | Asymbol s ->
+        (Ibased(s, d), Ctuple [])
+    | Alinear e ->
+        (Iindexed d, e)
+    | Aadd(e1, e2) ->
+        (Iindexed2 d, Ctuple[e1; e2])
+    | Ascale(e, scale) ->
+        (Iscaled(scale, d), e)
+    | Ascaledadd(e1, e2, scale) ->
+        (Iindexed2scaled(scale, d), Ctuple[e1; e2])
+
+method! select_store is_assign addr exp =
+  match exp with
+    Cconst_int (n, _dbg) when self#is_immediate n ->
+      (Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
+  | (Cconst_natint (n, _dbg)) when self#is_immediate_natint n ->
+      (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
+  | (Cblockheader(n, _dbg))
+      when self#is_immediate_natint n && not Config.spacetime ->
+      (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
+  | Cconst_pointer (n, _dbg) when self#is_immediate n ->
+      (Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
+  | Cconst_natpointer (n, _dbg) when self#is_immediate_natint n ->
+      (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
+  | _ ->
+      super#select_store is_assign addr exp
+
+method! select_operation op args dbg =
+  match op with
+  (* Recognize the LEA instruction *)
+    Caddi | Caddv | Cadda | Csubi ->
+      begin match self#select_addressing Word_int (Cop(op, args, dbg)) with
+        (Iindexed _, _)
+      | (Iindexed2 0, _) -> super#select_operation op args dbg
+      | (addr, arg) -> (Ispecific(Ilea addr), [arg])
+      end
+  (* Recognize float arithmetic with memory. *)
+  | Caddf ->
+      self#select_floatarith true Iaddf Ifloatadd args
+  | Csubf ->
+      self#select_floatarith false Isubf Ifloatsub args
+  | Cmulf ->
+      self#select_floatarith true Imulf Ifloatmul args
+  | Cdivf ->
+      self#select_floatarith false Idivf Ifloatdiv args
+  | Cextcall("sqrt", _, false, _) ->
+     begin match args with
+       [Cop(Cload ((Double|Double_u as chunk), _), [loc], _dbg)] ->
+         let (addr, arg) = self#select_addressing chunk loc in
+         (Ispecific(Ifloatsqrtf addr), [arg])
+     | [arg] ->
+         (Ispecific Isqrtf, [arg])
+     | _ ->
+         assert false
+     end
+  (* Recognize store instructions *)
+  | Cstore ((Word_int|Word_val as chunk), _init) ->
+      begin match args with
+        [loc; Cop(Caddi, [Cop(Cload _, [loc'], _); Cconst_int (n, _dbg)], _)]
+        when loc = loc' && self#is_immediate n ->
+          let (addr, arg) = self#select_addressing chunk loc in
+          (Ispecific(Ioffset_loc(n, addr)), [arg])
+      | _ ->
+          super#select_operation op args dbg
+      end
+  | Cextcall("caml_bswap16_direct", _, _, _) ->
+      (Ispecific (Ibswap 16), args)
+  | Cextcall("caml_int32_direct_bswap", _, _, _) ->
+      (Ispecific (Ibswap 32), args)
+  | Cextcall("caml_int64_direct_bswap", _, _, _)
+  | Cextcall("caml_nativeint_direct_bswap", _, _, _) ->
+      (Ispecific (Ibswap 64), args)
+  (* AMD64 does not support immediate operands for multiply high signed *)
+  | Cmulhi ->
+      (Iintop Imulh, args)
+  | Casr ->
+      begin match args with
+        (* Recognize sign extension *)
+        [Cop(Clsl, [k; Cconst_int (32, _)], _); Cconst_int (32, _)] ->
+          (Ispecific Isextend32, [k])
+        | _ -> super#select_operation op args dbg
+      end
+  (* Recognize zero extension *)
+  | Cand ->
+    begin match args with
+    | [arg; Cconst_int (0xffff_ffff, _)]
+    | [arg; Cconst_natint (0xffff_ffffn, _)]
+    | [Cconst_int (0xffff_ffff, _); arg]
+    | [Cconst_natint (0xffff_ffffn, _); arg] ->
+      Ispecific Izextend32, [arg]
+    | _ -> super#select_operation op args dbg
+    end
+  | _ -> super#select_operation op args dbg
+
+(* Recognize float arithmetic with mem *)
+
+method select_floatarith commutative regular_op mem_op args =
+  match args with
+    [arg1; Cop(Cload ((Double|Double_u as chunk), _), [loc2], _)] ->
+      let (addr, arg2) = self#select_addressing chunk loc2 in
+      (Ispecific(Ifloatarithmem(mem_op, addr)),
+                 [arg1; arg2])
+  | [Cop(Cload ((Double|Double_u as chunk), _), [loc1], _); arg2]
+        when commutative ->
+      let (addr, arg1) = self#select_addressing chunk loc1 in
+      (Ispecific(Ifloatarithmem(mem_op, addr)),
+                 [arg2; arg1])
+  | [arg1; arg2] ->
+      (regular_op, [arg1; arg2])
+  | _ ->
+      assert false
+
+method! mark_c_tailcall =
+  contains_calls := true
+
+(* Deal with register constraints *)
+
+method! insert_op_debug env op dbg rs rd =
+  try
+    let (rsrc, rdst) = pseudoregs_for_operation op rs rd in
+    self#insert_moves env rs rsrc;
+    self#insert_debug env (Iop op) dbg rsrc rdst;
+    self#insert_moves env rdst rd;
+    rd
+  with Use_default ->
+    super#insert_op_debug env op dbg rs rd
+
+end
+
+let fundecl f = (new selector)#emit_fundecl f
diff --git a/asmcomp/arm/CSE.ml b/asmcomp/arm/CSE.ml
new file mode 100644
index 00000000..2269cbec
--- /dev/null
+++ b/asmcomp/arm/CSE.ml
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* CSE for ARM *)
+
+open Arch
+open Mach
+open CSEgen
+
+class cse = object
+
+inherit cse_generic as super
+
+method! class_of_operation op =
+  match op with
+  | Ispecific(Ishiftcheckbound _) -> Op_checkbound
+  | Ispecific _ -> Op_pure
+  | _ -> super#class_of_operation op
+
+method! is_cheap_operation op =
+  match op with
+  | Iconst_int n -> n <= 255n && n >= 0n
+  | _ -> false
+
+end
+
+let fundecl f =
+  (new cse)#fundecl f
diff --git a/asmcomp/arm/NOTES.md b/asmcomp/arm/NOTES.md
new file mode 100644
index 00000000..7a8ae671
--- /dev/null
+++ b/asmcomp/arm/NOTES.md
@@ -0,0 +1,20 @@
+# Supported platforms
+
+A great many variants of the ARM 32-bit architecture:
+* Architecture versions: v4, v5, v5te, v6, v6t2, v7.
+  ARMv7 is the standard nowadays.
+* Instruction encoding: classic ARM or Thumb or Thumb-2.
+* Floating-point: software emulation, VFPv2, VFPv3-d16, VFP-v3.
+* ABI: the standard EABI (with floats passed in integer registers)
+  or the EABI-HF variant (with floats passed in VFP registers).
+
+Debian architecture names: `armel` and `armhf`.
+
+# Reference documents
+
+* Instruction set architecture:
+  _ARM Architecture Reference Manual, ARMv7-A and ARMv7-R edition_.
+  Alternatively:
+  _ARM Architecture Reference Manual, ARMv8_, restricted to the AArch32 subset.
+* Application binary interface:
+  _Procedure Call Standard for the ARM Architecture_
diff --git a/asmcomp/arm/arch.ml b/asmcomp/arm/arch.ml
new file mode 100644
index 00000000..becfff38
--- /dev/null
+++ b/asmcomp/arm/arch.ml
@@ -0,0 +1,266 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                 Benedikt Meurer, University of Siegen                  *)
+(*                                                                        *)
+(*   Copyright 1998 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2012 Benedikt Meurer.                                      *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Specific operations for the ARM processor *)
+
+open Format
+
+type abi = EABI | EABI_HF
+type arch = ARMv4 | ARMv5 | ARMv5TE | ARMv6 | ARMv6T2 | ARMv7 | ARMv8
+type fpu = Soft | VFPv2 | VFPv3_D16 | VFPv3
+
+let abi =
+  match Config.system with
+    "linux_eabi" | "freebsd" -> EABI
+  | "linux_eabihf" | "netbsd" -> EABI_HF
+  | _ -> assert false
+
+let string_of_arch = function
+    ARMv4   -> "armv4"
+  | ARMv5   -> "armv5"
+  | ARMv5TE -> "armv5te"
+  | ARMv6   -> "armv6"
+  | ARMv6T2 -> "armv6t2"
+  | ARMv7   -> "armv7"
+  | ARMv8   -> "armv8"
+
+let string_of_fpu = function
+    Soft      -> "soft"
+  | VFPv2     -> "vfpv2"
+  | VFPv3_D16 -> "vfpv3-d16"
+  | VFPv3     -> "vfpv3"
+
+(* Machine-specific command-line options *)
+
+let (arch, fpu, thumb) =
+  let (def_arch, def_fpu, def_thumb) =
+    begin match abi, Config.model with
+    (* Defaults for architecture, FPU and Thumb *)
+      EABI, "armv5"    -> ARMv5,   Soft,      false
+    | EABI, "armv5te"  -> ARMv5TE, Soft,      false
+    | EABI, "armv6"    -> ARMv6,   Soft,      false
+    | EABI, "armv6t2"  -> ARMv6T2, Soft,      false
+    | EABI, "armv7"    -> ARMv7,   Soft,      false
+    | EABI, "armv8"    -> ARMv8,   Soft,      false
+    | EABI, _          -> ARMv4,   Soft,      false
+    | EABI_HF, "armv6" -> ARMv6,   VFPv2,     false
+    | EABI_HF, "armv8" -> ARMv8,   VFPv3,     true
+    | EABI_HF, _       -> ARMv7,   VFPv3_D16, true
+    end in
+  (ref def_arch, ref def_fpu, ref def_thumb)
+
+let farch spec =
+  arch := begin match spec with
+             "armv4" when abi <> EABI_HF   -> ARMv4
+           | "armv5" when abi <> EABI_HF   -> ARMv5
+           | "armv5te" when abi <> EABI_HF -> ARMv5TE
+           | "armv6"                       -> ARMv6
+           | "armv6t2"                     -> ARMv6T2
+           | "armv7"                       -> ARMv7
+           | "armv8"                       -> ARMv8
+           | spec -> raise (Arg.Bad ("wrong '-farch' option: " ^ spec))
+  end
+
+let ffpu spec =
+  fpu := begin match spec with
+            "soft" when abi <> EABI_HF     -> Soft
+          | "vfpv2" when abi = EABI_HF     -> VFPv2
+          | "vfpv3-d16" when abi = EABI_HF -> VFPv3_D16
+          | "vfpv3" when abi = EABI_HF     -> VFPv3
+          | spec -> raise (Arg.Bad ("wrong '-ffpu' option: " ^ spec))
+  end
+
+let command_line_options =
+  [ "-farch", Arg.String farch,
+      "  Select the ARM target architecture"
+      ^ " (default: " ^ (string_of_arch !arch) ^ ")";
+    "-ffpu", Arg.String ffpu,
+      "  Select the floating-point hardware"
+      ^ " (default: " ^ (string_of_fpu !fpu) ^ ")";
+    "-fPIC", Arg.Set Clflags.pic_code,
+      " Generate position-independent machine code";
+    "-fno-PIC", Arg.Clear Clflags.pic_code,
+      " Generate position-dependent machine code";
+    "-fthumb", Arg.Set thumb,
+      " Enable Thumb/Thumb-2 code generation"
+      ^ (if !thumb then " (default)" else "");
+    "-fno-thumb", Arg.Clear thumb,
+      " Disable Thumb/Thumb-2 code generation"
+      ^ (if not !thumb then " (default" else "")]
+
+(* Addressing modes *)
+
+type addressing_mode =
+    Iindexed of int                     (* reg + displ *)
+
+(* We do not support the reg + shifted reg addressing mode, because
+   what we really need is reg + shifted reg + displ,
+   and this is decomposed in two instructions (reg + shifted reg -> tmp,
+   then addressing tmp + displ). *)
+
+(* Specific operations *)
+
+type specific_operation =
+    Ishiftarith of arith_operation * shift_operation * int
+  | Ishiftcheckbound of shift_operation * int
+  | Irevsubimm of int
+  | Imulhadd      (* multiply high and add *)
+  | Imuladd       (* multiply and add *)
+  | Imulsub       (* multiply and subtract *)
+  | Inegmulf      (* floating-point negate and multiply *)
+  | Imuladdf      (* floating-point multiply and add *)
+  | Inegmuladdf   (* floating-point negate, multiply and add *)
+  | Imulsubf      (* floating-point multiply and subtract *)
+  | Inegmulsubf   (* floating-point negate, multiply and subtract *)
+  | Isqrtf        (* floating-point square root *)
+  | Ibswap of int (* endianness conversion *)
+
+and arith_operation =
+    Ishiftadd
+  | Ishiftsub
+  | Ishiftsubrev
+  | Ishiftand
+  | Ishiftor
+  | Ishiftxor
+
+and shift_operation =
+    Ishiftlogicalleft
+  | Ishiftlogicalright
+  | Ishiftarithmeticright
+
+let spacetime_node_hole_pointer_is_live_before _specific_op = false
+
+(* Sizes, endianness *)
+
+let big_endian = false
+
+let size_addr = 4
+let size_int = 4
+let size_float = 8
+
+let allow_unaligned_access = false
+
+(* Behavior of division *)
+
+let division_crashes_on_overflow = false
+
+(* Operations on addressing modes *)
+
+let identity_addressing = Iindexed 0
+
+let offset_addressing (Iindexed n) delta = Iindexed(n + delta)
+
+let num_args_addressing (Iindexed _) = 1
+
+(* Printing operations and addressing modes *)
+
+let print_addressing printreg addr ppf arg =
+  match addr with
+  | Iindexed n ->
+      printreg ppf arg.(0);
+      if n <> 0 then fprintf ppf " + %i" n
+
+let shiftop_name = function
+  | Ishiftlogicalleft -> "<<"
+  | Ishiftlogicalright -> ">>u"
+  | Ishiftarithmeticright -> ">>s"
+
+let print_specific_operation printreg op ppf arg =
+  match op with
+    Ishiftarith(op, shiftop, amount) ->
+      let (op1_name, op2_name) = match op with
+          Ishiftadd -> ("", "+")
+        | Ishiftsub -> ("", "-")
+        | Ishiftsubrev -> ("-", "+")
+        | Ishiftand -> ("", "&")
+        | Ishiftor -> ("", "|")
+        | Ishiftxor -> ("", "^") in
+      fprintf ppf "%s%a %s (%a %s %i)"
+        op1_name
+        printreg arg.(0)
+        op2_name
+        printreg arg.(1)
+        (shiftop_name shiftop)
+        amount
+  | Ishiftcheckbound(shiftop, amount) ->
+      fprintf ppf "check (%a %s %i) > %a"
+        printreg arg.(0)
+        (shiftop_name shiftop)
+        amount
+        printreg arg.(1)
+  | Irevsubimm n ->
+      fprintf ppf "%i %s %a" n "-" printreg arg.(0)
+  | Imulhadd ->
+      fprintf ppf "%a *h %a) + %a"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Imuladd ->
+      fprintf ppf "(%a * %a) + %a"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Imulsub ->
+      fprintf ppf "-(%a * %a) + %a"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Inegmulf ->
+      fprintf ppf "-f (%a *f %a)"
+        printreg arg.(0)
+        printreg arg.(1)
+  | Imuladdf ->
+      fprintf ppf "%a +f (%a *f %a)"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Inegmuladdf ->
+      fprintf ppf "%a -f (%a *f %a)"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Imulsubf ->
+      fprintf ppf "(-f %a) +f (%a *f %a)"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Inegmulsubf ->
+      fprintf ppf "(-f %a) -f (%a *f %a)"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Isqrtf ->
+      fprintf ppf "sqrtf %a"
+        printreg arg.(0)
+  | Ibswap n ->
+      fprintf ppf "bswap%i %a" n
+        printreg arg.(0)
+
+(* Recognize immediate operands *)
+
+(* Immediate operands are 8-bit immediate values, zero-extended,
+   and rotated right by 0 ... 30 bits.
+   In Thumb/Thumb-2 mode we utilize 26 ... 30. *)
+
+let is_immediate n =
+  let n = ref n in
+  let s = ref 0 in
+  let m = if !thumb then 24 else 30 in
+  while (!s <= m && Int32.logand !n 0xffl <> !n) do
+    n := Int32.logor (Int32.shift_right_logical !n 2) (Int32.shift_left !n 30);
+    s := !s + 2
+  done;
+  !s <= m
diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp
new file mode 100644
index 00000000..b880319b
--- /dev/null
+++ b/asmcomp/arm/emit.mlp
@@ -0,0 +1,1085 @@
+#2 "asmcomp/arm/emit.mlp"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                 Benedikt Meurer, University of Siegen                  *)
+(*                                                                        *)
+(*   Copyright 1998 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2012 Benedikt Meurer.                                      *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Emission of ARM assembly code *)
+
+open Misc
+open Cmm
+open Arch
+open Proc
+open Reg
+open Mach
+open Linear
+open Emitaux
+
+(* Tradeoff between code size and code speed *)
+
+let fastcode_flag = ref true
+
+(* Output a label *)
+
+let emit_label lbl =
+  emit_string ".L"; emit_int lbl
+
+(* Symbols *)
+
+let emit_symbol s =
+  Emitaux.emit_symbol '$' s
+
+let emit_call s =
+  if !Clflags.dlcode || !Clflags.pic_code
+  then `bl	{emit_symbol s}(PLT)`
+  else `bl	{emit_symbol s}`
+
+let emit_jump s =
+  if !Clflags.dlcode || !Clflags.pic_code
+  then `b	{emit_symbol s}(PLT)`
+  else `b	{emit_symbol s}`
+
+(* Output a pseudo-register *)
+
+let emit_reg = function
+    {loc = Reg r} -> emit_string (register_name r)
+  | _ -> fatal_error "Emit_arm.emit_reg"
+
+(* Layout of the stack frame *)
+
+let stack_offset = ref 0
+
+let num_stack_slots = Array.make Proc.num_register_classes 0
+
+let prologue_required = ref false
+
+let contains_calls = ref false
+
+let frame_size () =
+  let sz =
+    !stack_offset +
+    4 * num_stack_slots.(0) +
+    8 * num_stack_slots.(1) +
+    8 * num_stack_slots.(2) +
+    (if !contains_calls then 4 else 0)
+  in Misc.align sz 8
+
+let slot_offset loc cl =
+  match loc with
+    Incoming n ->
+      assert (n >= 0);
+      frame_size() + n
+  | Local n ->
+      if cl = 0
+      then !stack_offset + n * 4
+      else !stack_offset + num_stack_slots.(0) * 4 + n * 8
+  | Outgoing n ->
+      assert (n >= 0);
+      n
+
+(* Output a stack reference *)
+
+let emit_stack r =
+  match r.loc with
+  | Stack s ->
+      let ofs = slot_offset s (register_class r) in `[sp, #{emit_int ofs}]`
+  | _ -> fatal_error "Emit_arm.emit_stack"
+
+(* Output an addressing mode *)
+
+let emit_addressing addr r n =
+  match addr with
+    Iindexed ofs ->
+      `[{emit_reg r.(n)}, #{emit_int ofs}]`
+
+(* Record live pointers at call points *)
+
+let record_frame_label ?label live dbg =
+  let lbl =
+    match label with
+    | None -> new_label()
+    | Some label -> label
+  in
+  let live_offset = ref [] in
+  Reg.Set.iter
+    (function
+      | {typ = Val; loc = Reg r} ->
+          live_offset := ((r lsl 1) + 1) :: !live_offset
+      | {typ = Val; loc = Stack s} as reg ->
+          live_offset := slot_offset s (register_class reg) :: !live_offset
+      | {typ = Addr} as r ->
+          Misc.fatal_error ("bad GC root " ^ Reg.name r)
+      | _ -> ())
+    live;
+  record_frame_descr ~label:lbl ~frame_size:(frame_size())
+    ~live_offset:!live_offset dbg;
+  lbl
+
+let record_frame ?label live dbg =
+  let lbl = record_frame_label ?label live dbg in `{emit_label lbl}:`
+
+(* Record calls to the GC -- we've moved them out of the way *)
+
+type gc_call =
+  { gc_lbl: label;                      (* Entry label *)
+    gc_return_lbl: label;               (* Where to branch after GC *)
+    gc_frame_lbl: label }               (* Label of frame descriptor *)
+
+let call_gc_sites = ref ([] : gc_call list)
+
+let emit_call_gc gc =
+  `{emit_label gc.gc_lbl}:	{emit_call "caml_call_gc"}\n`;
+  `{emit_label gc.gc_frame_lbl}:	b	{emit_label gc.gc_return_lbl}\n`
+
+(* Record calls to caml_ml_array_bound_error.
+   In debug mode, we maintain one call to caml_ml_array_bound_error
+   per bound check site. Otherwise, we can share a single call. *)
+
+type bound_error_call =
+  { bd_lbl: label;                    (* Entry label *)
+    bd_frame_lbl: label }             (* Label of frame descriptor *)
+
+let bound_error_sites = ref ([] : bound_error_call list)
+
+let bound_error_label ?label dbg =
+  if !Clflags.debug || !bound_error_sites = [] then begin
+    let lbl_bound_error = new_label() in
+    let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
+    bound_error_sites :=
+      { bd_lbl = lbl_bound_error;
+        bd_frame_lbl = lbl_frame } :: !bound_error_sites;
+    lbl_bound_error
+  end else begin
+    let bd = List.hd !bound_error_sites in bd.bd_lbl
+  end
+
+let emit_call_bound_error bd =
+  `{emit_label bd.bd_lbl}:	{emit_call "caml_ml_array_bound_error"}\n`;
+  `{emit_label bd.bd_frame_lbl}:\n`
+
+(* Negate a comparison *)
+
+let negate_integer_comparison = function
+  | Isigned cmp   -> Isigned(negate_integer_comparison cmp)
+  | Iunsigned cmp -> Iunsigned(negate_integer_comparison cmp)
+
+(* Names of various instructions *)
+
+let name_for_comparison = function
+    Isigned Ceq -> "eq" | Isigned Cne -> "ne" | Isigned Cle -> "le"
+  | Isigned Cge -> "ge" | Isigned Clt -> "lt" | Isigned Cgt -> "gt"
+  | Iunsigned Ceq -> "eq" | Iunsigned Cne -> "ne" | Iunsigned Cle -> "ls"
+  | Iunsigned Cge -> "cs" | Iunsigned Clt -> "cc" | Iunsigned Cgt -> "hi"
+
+let name_for_int_operation = function
+  (* Use adds,subs,... to enable 16-bit T1 encoding *)
+    Iadd  -> "adds"
+  | Isub  -> "subs"
+  | Imul  -> "mul"
+  | Imulh -> "smmul"
+  | Iand  -> "ands"
+  | Ior   -> "orrs"
+  | Ixor  -> "eors"
+  | Ilsl  -> "lsls"
+  | Ilsr  -> "lsrs"
+  | Iasr  -> "asrs"
+  | _ -> assert false
+
+let name_for_shift_operation = function
+    Ishiftlogicalleft -> "lsl"
+  | Ishiftlogicalright -> "lsr"
+  | Ishiftarithmeticright -> "asr"
+
+(* General functional to decompose a non-immediate integer constant
+   into 8-bit chunks shifted left 0 ... 30 bits. *)
+
+let decompose_intconst n fn =
+  let i = ref n in
+  let shift = ref 0 in
+  let ninstr = ref 0 in
+  while !i <> 0l do
+    if Int32.logand (Int32.shift_right !i !shift) 3l = 0l then
+      shift := !shift + 2
+    else begin
+      let bits = Int32.logand !i (Int32.shift_left 0xffl !shift) in
+      i := Int32.sub !i bits;
+      shift := !shift + 8;
+      incr ninstr;
+      fn bits
+    end
+  done;
+  !ninstr
+
+(* Load an integer constant into a register *)
+
+let emit_intconst dst n =
+  let nr = Int32.lognot n in
+  if is_immediate n then begin
+    (* Use movs here to enable 16-bit T1 encoding *)
+    `	movs	{emit_reg dst}, #{emit_int32 n}\n`; 1
+  end else if is_immediate nr then begin
+    `	mvn	{emit_reg dst}, #{emit_int32 nr}\n`; 1
+  end else if !arch > ARMv6 then begin
+    let nl = Int32.logand 0xffffl n in
+    let nh = Int32.logand 0xffffl (Int32.shift_right_logical n 16) in
+    if nh = 0l then begin
+      `	movw	{emit_reg dst}, #{emit_int32 nl}\n`; 1
+    end else if Int32.logand nl 0xffl = nl then begin
+      `	movs	{emit_reg dst}, #{emit_int32 nl}\n`;
+      `	movt	{emit_reg dst}, #{emit_int32 nh}\n`; 2
+    end else begin
+      `	movw	{emit_reg dst}, #{emit_int32 nl}\n`;
+      `	movt	{emit_reg dst}, #{emit_int32 nh}\n`; 2
+    end
+  end else begin
+    let first = ref true in
+    decompose_intconst n
+      (fun bits ->
+        if !first
+        (* Use movs,adds here to enable 16-bit T1 encoding *)
+        then `	movs	{emit_reg dst}, #{emit_int32 bits} @ {emit_int32 n}\n`
+        else `	adds	{emit_reg dst}, {emit_reg dst}, #{emit_int32 bits}\n`;
+        first := false)
+  end
+
+(* Adjust sp (up or down) by the given byte amount *)
+
+let emit_stack_adjustment n =
+  if n = 0 then 0 else begin
+    let instr = if n < 0 then "sub" else "add" in
+    let ninstr = decompose_intconst (Int32.of_int (abs n))
+                   (fun bits ->
+                     `	{emit_string instr}	sp, sp, #{emit_int32 bits}\n`) in
+    cfi_adjust_cfa_offset (-n);
+    ninstr
+  end
+
+(* Deallocate the stack frame before a return or tail call *)
+
+let output_epilogue f =
+  let n = frame_size() in
+  if n > 0 then begin
+    let ninstr = emit_stack_adjustment n in
+    let ninstr = ninstr + f () in
+    (* reset CFA back cause function body may continue *)
+    cfi_adjust_cfa_offset n;
+    ninstr
+  end else
+    f ()
+
+(* Name of current function *)
+let function_name = ref ""
+(* Entry point for tail recursive calls *)
+let tailrec_entry_point = ref 0
+(* Pending floating-point literals *)
+let float_literals = ref ([] : (int64 * label) list)
+(* Pending relative references to the global offset table *)
+let gotrel_literals = ref ([] : (label * label) list)
+(* Pending symbol literals *)
+let symbol_literals = ref ([] : (string * label) list)
+(* Total space (in words) occupied by pending literals *)
+let size_literals = ref 0
+
+(* Pending offset computations : {lbl; dst; src;} --> lbl: .word dst-(src+N) *)
+type offset_computation =
+  { lbl : label;
+    dst : label;
+    src : label;
+  }
+let offset_literals = ref ([] : offset_computation list)
+
+(* Label a floating-point literal *)
+let float_literal f =
+  try
+    List.assoc f !float_literals
+  with Not_found ->
+    let lbl = new_label() in
+    size_literals := !size_literals + 2;
+    float_literals := (f, lbl) :: !float_literals;
+    lbl
+
+(* Label a GOTREL literal *)
+let gotrel_literal l =
+  let lbl = new_label() in
+  size_literals := !size_literals + 1;
+  gotrel_literals := (l, lbl) :: !gotrel_literals;
+  lbl
+
+(* Label a symbol literal *)
+let symbol_literal s =
+  try
+    List.assoc s !symbol_literals
+  with Not_found ->
+    let lbl = new_label() in
+    size_literals := !size_literals + 1;
+    symbol_literals := (s, lbl) :: !symbol_literals;
+    lbl
+
+(* Add an offset computation *)
+let offset_literal dst src =
+  let lbl = new_label() in
+  size_literals := !size_literals + 1;
+  offset_literals := { lbl; dst; src; } :: !offset_literals;
+  lbl
+
+(* Emit all pending literals *)
+let emit_literals() =
+  if !float_literals <> [] then begin
+    `	.align	3\n`;
+    List.iter
+      (fun (f, lbl) ->
+        `{emit_label lbl}:`; emit_float64_split_directive ".long" f)
+      !float_literals;
+    float_literals := []
+  end;
+  if !symbol_literals <> [] then begin
+    let offset = if !thumb then 4 else 8 in
+    let suffix = if !Clflags.pic_code then "(GOT)" else "" in
+    `	.align	2\n`;
+    List.iter
+      (fun (l, lbl) ->
+        `{emit_label lbl}:	.word	_GLOBAL_OFFSET_TABLE_-({emit_label l}+{emit_int offset})\n`)
+      !gotrel_literals;
+    List.iter
+      (fun (s, lbl) ->
+        `{emit_label lbl}:	.word	{emit_symbol s}{emit_string suffix}\n`)
+      !symbol_literals;
+    gotrel_literals := [];
+    symbol_literals := []
+  end;
+  if !offset_literals <> [] then begin
+    (* Additions using the pc register read a value 4 or 8 bytes greater than
+       the instruction's address, depending on the Thumb setting.  However in
+       Thumb mode we must follow interworking conventions and ensure that the
+       bottom bit of the pc value is set when reloaded from the trap frame.
+       Hence "3" not "4". *)
+    let offset = if !thumb then 3 else 8 in
+    `	.align	2\n`;
+    List.iter
+      (fun { lbl; dst; src; } ->
+         `{emit_label lbl}:	.word	{emit_label dst}-({emit_label src}+{emit_int offset})\n`)
+      !offset_literals;
+    offset_literals := []
+  end;
+  size_literals := 0
+
+(* Emit code to load the address of a symbol *)
+
+let emit_load_symbol_addr dst s =
+  if !Clflags.pic_code then begin
+    let lbl_pic = new_label() in
+    let lbl_got = gotrel_literal lbl_pic in
+    let lbl_sym = symbol_literal s in
+    (* Both r3 and r12 are marked as clobbered in PIC mode (cf. proc.ml),
+       so use r12 as temporary scratch register unless the destination is
+       r12, then we use r3 instead. *)
+    let tmp = if dst.loc = Reg 8 (*r12*)
+              then phys_reg 3 (*r3*)
+              else phys_reg 8 (*r12*) in
+    `	ldr	{emit_reg tmp}, {emit_label lbl_got}\n`;
+    `	ldr	{emit_reg dst}, {emit_label lbl_sym}\n`;
+    `{emit_label lbl_pic}:	add	{emit_reg tmp}, pc, {emit_reg tmp}\n`;
+    `	ldr	{emit_reg dst}, [{emit_reg tmp}, {emit_reg dst}] @ {emit_symbol s}\n`;
+    4
+  end else if !arch > ARMv6 && not !Clflags.dlcode && !fastcode_flag then begin
+    `	movw	{emit_reg dst}, #:lower16:{emit_symbol s}\n`;
+    `	movt	{emit_reg dst}, #:upper16:{emit_symbol s}\n`;
+    2
+  end else begin
+    let lbl = symbol_literal s in
+    `	ldr	{emit_reg dst}, {emit_label lbl} @ {emit_symbol s}\n`;
+    1
+  end
+
+(* Emit instructions that set [rd] to 1 if integer condition [cmp] holds
+   and set [rd] to 0 otherwise. *)
+
+let emit_set_condition cmp rd =
+  let compthen = name_for_comparison cmp in
+  let compelse = name_for_comparison (negate_integer_comparison cmp) in
+  if !arch < ARMv8 || not !thumb then begin
+    `	ite	{emit_string compthen}\n`;
+    `	mov{emit_string	compthen}	{emit_reg rd}, #1\n`;
+    `	mov{emit_string compelse}	{emit_reg rd}, #0\n`;
+    3
+  end else begin
+    (* T32 mode in ARMv8 deprecates general ITE blocks
+       and favors IT blocks containing only one 16-bit instruction.
+       mov , # is 16 bits if  is R0...R7
+                                   and  fits in 8 bits. *)
+    let temp =
+      match rd.loc with
+      | Reg r when r < 8 -> rd  (* can assign rd directly *)
+      | _ -> phys_reg 3  (* use r3 as temporary *) in
+    `	it	{emit_string compthen}\n`;
+    `	mov{emit_string	compthen}	{emit_reg temp}, #1\n`;
+    `	it	{emit_string compelse}\n`;
+    `	mov{emit_string compelse}	{emit_reg temp}, #0\n`;
+    if temp.loc = rd.loc then 4 else begin
+      `	movs	{emit_reg rd}, {emit_reg temp}\n`; 5
+    end
+  end
+
+(* Emit code to load the address of a label in the lr register *)
+let emit_load_handler_address handler =
+  (* PIC code *)
+  let lbl_src = new_label() in
+  let lbl_offset = offset_literal handler lbl_src in
+  `	ldr	lr, {emit_label lbl_offset}\n`;
+  `{emit_label lbl_src}:\n`;
+  `	add	lr, pc, lr\n`;
+  2
+
+
+(* Output .text section directive, or named .text.caml. 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`
+
+(* Output the assembly code for an instruction *)
+
+let emit_instr i =
+    emit_debug_info i.dbg;
+    match i.desc with
+    | Lend -> 0
+    | Lprologue ->
+      assert (!prologue_required);
+      let n = frame_size() in
+      let num_instrs =
+        if n > 0 then begin
+          let num_instrs = emit_stack_adjustment (-n) in
+          if !contains_calls then begin
+            cfi_offset ~reg:14 (* lr *) ~offset:(-4);
+            `	str	lr, [sp, #{emit_int(n - 4)}]\n`;
+            num_instrs + 1
+          end else begin
+            num_instrs
+          end
+        end else begin
+          0
+        end
+      in
+      `{emit_label !tailrec_entry_point}:\n`;
+      num_instrs
+    | Lop(Imove | Ispill | Ireload) ->
+        let src = i.arg.(0) and dst = i.res.(0) in
+        if src.loc = dst.loc then 0 else begin
+          begin match (src, dst) with
+            {loc = Reg _; typ = Float}, {loc = Reg _} ->
+              `	fcpyd	{emit_reg dst}, {emit_reg src}\n`
+          | {loc = Reg _}, {loc = Reg _} ->
+              `	mov	{emit_reg dst}, {emit_reg src}\n`
+          | {loc = Reg _; typ = Float}, _ ->
+              `	fstd	{emit_reg src}, {emit_stack dst}\n`
+          | {loc = Reg _}, _ ->
+              `	str	{emit_reg src}, {emit_stack dst}\n`
+          | {typ = Float}, _ ->
+              `	fldd	{emit_reg dst}, {emit_stack src}\n`
+          | _ ->
+              `	ldr	{emit_reg dst}, {emit_stack src}\n`
+          end; 1
+        end
+    | Lop(Iconst_int n) ->
+        emit_intconst i.res.(0) (Nativeint.to_int32 n)
+    | Lop(Iconst_float f) when !fpu = Soft ->
+        let high_bits = Int64.to_int32 (Int64.shift_right_logical f 32)
+        and low_bits = Int64.to_int32 f in
+        if is_immediate low_bits || is_immediate high_bits then begin
+          let ninstr_low = emit_intconst i.res.(0) low_bits
+          and ninstr_high = emit_intconst i.res.(1) high_bits in
+          ninstr_low + ninstr_high
+        end else begin
+          let lbl = float_literal f in
+          `	ldr	{emit_reg i.res.(0)}, {emit_label lbl}\n`;
+          `	ldr	{emit_reg i.res.(1)}, {emit_label lbl} + 4\n`;
+          2
+        end
+    | Lop(Iconst_float f) when !fpu = VFPv2 ->
+        let lbl = float_literal f in
+        `	fldd	{emit_reg i.res.(0)}, {emit_label lbl}\n`;
+        1
+    | Lop(Iconst_float f) ->
+        let encode imm =
+          let sg = Int64.to_int (Int64.shift_right_logical imm 63) in
+          let ex = Int64.to_int (Int64.shift_right_logical imm 52) in
+          let ex = (ex land 0x7ff) - 1023 in
+          let mn = Int64.logand imm 0xfffffffffffffL in
+          if Int64.logand mn 0xffffffffffffL <> 0L || ex < -3 || ex > 4
+          then
+            None
+          else begin
+            let mn = Int64.to_int (Int64.shift_right_logical mn 48) in
+            if mn land 0x0f <> mn then
+              None
+            else
+              let ex = ((ex + 3) land 0x07) lxor 0x04 in
+              Some((sg lsl 7) lor (ex lsl 4) lor mn)
+          end in
+        begin match encode f with
+          None ->
+            let lbl = float_literal f in
+            `	fldd	{emit_reg i.res.(0)}, {emit_label lbl}\n`
+        | Some imm8 ->
+            `	fconstd	{emit_reg i.res.(0)}, #{emit_int imm8}\n`
+        end; 1
+    | Lop(Iconst_symbol s) ->
+        emit_load_symbol_addr i.res.(0) s
+    | Lop(Icall_ind { label_after; }) ->
+        if !arch >= ARMv5 then begin
+          `	blx	{emit_reg i.arg.(0)}\n`;
+          `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`; 1
+        end else begin
+          `	mov	lr, pc\n`;
+          `	bx	{emit_reg i.arg.(0)}\n`;
+          `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`; 2
+        end
+    | Lop(Icall_imm { func; label_after; }) ->
+        `	{emit_call func}\n`;
+        `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`; 1
+    | Lop(Itailcall_ind { label_after = _; }) ->
+        output_epilogue begin fun () ->
+          if !contains_calls then
+            `	ldr	lr, [sp, #{emit_int (-4)}]\n`;
+          `	bx	{emit_reg i.arg.(0)}\n`; 2
+        end
+    | Lop(Itailcall_imm { func; label_after = _; }) ->
+        if func = !function_name then begin
+          `	b	{emit_label !tailrec_entry_point}\n`; 1
+        end else begin
+          output_epilogue begin fun () ->
+            if !contains_calls then
+              `	ldr	lr, [sp, #{emit_int (-4)}]\n`;
+            `	{emit_jump func}\n`; 2
+          end
+        end
+    | Lop(Iextcall { func; alloc = false; }) ->
+        `	{emit_call func}\n`; 1
+    | Lop(Iextcall { func; alloc = true; label_after; }) ->
+        let ninstr = emit_load_symbol_addr (phys_reg 7 (* r7 *)) func in
+        `	{emit_call "caml_c_call"}\n`;
+        `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`;
+        1 + ninstr
+    | Lop(Istackoffset n) ->
+        assert (n mod 8 = 0);
+        let ninstr = emit_stack_adjustment (-n) in
+        stack_offset := !stack_offset + n;
+        ninstr
+    | Lop(Iload(Single, addr)) when !fpu >= VFPv2 ->
+        `	flds	s14, {emit_addressing addr i.arg 0}\n`;
+        `	fcvtds	{emit_reg i.res.(0)}, s14\n`; 2
+    | Lop(Iload((Double | Double_u), addr)) when !fpu = Soft ->
+        (* Use LDM or LDRD if possible *)
+        begin match i.res.(0), i.res.(1), addr with
+          {loc = Reg rt}, {loc = Reg rt2}, Iindexed 0
+          when rt < rt2 ->
+            `	ldm	{emit_reg i.arg.(0)}, \{{emit_reg i.res.(0)}, {emit_reg i.res.(1)}}\n`; 1
+        | {loc = Reg rt}, {loc = Reg rt2}, addr
+          when !arch >= ARMv5TE && rt mod 2 == 0 && rt2 = rt + 1 ->
+            `	ldrd	{emit_reg i.res.(0)}, {emit_reg i.res.(1)}, {emit_addressing addr i.arg 0}\n`; 1
+        | _ ->
+            let addr' = offset_addressing addr 4 in
+            if i.res.(0).loc <> i.arg.(0).loc then begin
+              `	ldr	{emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`;
+              `	ldr	{emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n`
+            end else begin
+              `	ldr	{emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n`;
+              `	ldr	{emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`
+            end; 2
+        end
+    | Lop(Iload(size, addr)) ->
+        let r = i.res.(0) in
+        let instr =
+          match size with
+            Byte_unsigned -> "ldrb"
+          | Byte_signed -> "ldrsb"
+          | Sixteen_unsigned -> "ldrh"
+          | Sixteen_signed -> "ldrsh"
+          | Double
+          | Double_u -> "fldd"
+          | _ (* 32-bit quantities *) -> "ldr" in
+        `	{emit_string instr}	{emit_reg r}, {emit_addressing addr i.arg 0}\n`; 1
+    | Lop(Istore(Single, addr, _)) when !fpu >= VFPv2 ->
+        `	fcvtsd	s14, {emit_reg i.arg.(0)}\n`;
+        `	fsts	s14, {emit_addressing addr i.arg 1}\n`; 2
+    | Lop(Istore((Double | Double_u), addr, _)) when !fpu = Soft ->
+        (* Use STM or STRD if possible *)
+        begin match i.arg.(0), i.arg.(1), addr with
+          {loc = Reg rt}, {loc = Reg rt2}, Iindexed 0
+          when rt < rt2 ->
+            `	stm	{emit_reg i.arg.(2)}, \{{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}}\n`; 1
+        | {loc = Reg rt}, {loc = Reg rt2}, addr
+          when !arch >= ARMv5TE && rt mod 2 == 0 && rt2 = rt + 1 ->
+            `	strd	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_addressing addr i.arg 2}\n`; 1
+        | _ ->
+            let addr' = offset_addressing addr 4 in
+            `	str	{emit_reg i.arg.(0)}, {emit_addressing addr i.arg 2}\n`;
+            `	str	{emit_reg i.arg.(1)}, {emit_addressing addr' i.arg 2}\n`; 2
+        end
+    | Lop(Istore(size, addr, _)) ->
+        let r = i.arg.(0) in
+        let instr =
+          match size with
+            Byte_unsigned
+          | Byte_signed -> "strb"
+          | Sixteen_unsigned
+          | Sixteen_signed -> "strh"
+          | Double
+          | Double_u -> "fstd"
+          | _ (* 32-bit quantities *) -> "str" in
+        `	{emit_string instr}	{emit_reg r}, {emit_addressing addr i.arg 1}\n`; 1
+    | Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
+        let lbl_frame =
+          record_frame_label i.live (Dbg_alloc dbginfo) ?label:label_after_call_gc
+        in
+        if !fastcode_flag then begin
+          let ninstr = decompose_intconst
+                         (Int32.of_int n)
+                         (fun i ->
+                           `   sub     alloc_ptr, alloc_ptr, #{emit_int32 i}\n`) in
+          let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
+          `	ldr	{emit_reg i.res.(0)}, [domain_state_ptr, {emit_int offset}]\n`;
+          `     cmp     alloc_ptr, {emit_reg i.res.(0)}\n`;
+          let lbl_call_gc = new_label() in
+          `     bcc     {emit_label lbl_call_gc}\n`;
+          let lbl_after_alloc = new_label() in
+          `{emit_label lbl_after_alloc}:`;
+          `     add     {emit_reg i.res.(0)}, alloc_ptr, #4\n`;
+          call_gc_sites :=
+            { gc_lbl = lbl_call_gc;
+              gc_return_lbl = lbl_after_alloc;
+              gc_frame_lbl = lbl_frame } :: !call_gc_sites;
+          4 + ninstr
+        end else begin
+          let ninstr =
+            begin match n with
+               8 -> `	{emit_call "caml_alloc1"}\n`; 1
+            | 12 -> `	{emit_call "caml_alloc2"}\n`; 1
+            | 16 -> `	{emit_call "caml_alloc3"}\n`; 1
+            |  _ -> let ninstr = emit_intconst (phys_reg 7) (Int32.of_int n) in
+                    `	{emit_call "caml_allocN"}\n`; 1 + ninstr
+            end in
+          `{emit_label lbl_frame}:	add	{emit_reg i.res.(0)}, alloc_ptr, #4\n`;
+          1 + ninstr
+        end
+    | Lop(Iintop(Icomp cmp)) ->
+        `	cmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+        1 + emit_set_condition cmp i.res.(0)
+    | Lop(Iintop_imm(Icomp cmp, n)) ->
+        `	cmp	{emit_reg i.arg.(0)}, #{emit_int n}\n`;
+        1 + emit_set_condition cmp i.res.(0)
+    | Lop(Iintop (Icheckbound { label_after_error; } )) ->
+        let lbl = bound_error_label ?label:label_after_error i.dbg in
+        `	cmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+        `	bls	{emit_label lbl}\n`; 2
+    | Lop(Iintop_imm(Icheckbound { label_after_error; }, n)) ->
+        let lbl = bound_error_label ?label:label_after_error i.dbg in
+        `	cmp	{emit_reg i.arg.(0)}, #{emit_int n}\n`;
+        `	bls	{emit_label lbl}\n`; 2
+    | Lop(Ispecific(Ishiftcheckbound(shiftop, n))) ->
+        let lbl = bound_error_label i.dbg in
+        let op = name_for_shift_operation shiftop in
+        `	cmp	{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, {emit_string op} #{emit_int n}\n`;
+        `	bcs	{emit_label lbl}\n`; 2
+    | Lop(Iintop Imulh) when !arch < ARMv6 ->
+        `	smull	r12, {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; 1
+    | Lop(Ispecific Imulhadd) ->
+        `	smmla	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`; 1
+    | Lop(Iintop op) ->
+        let instr = name_for_int_operation op in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; 1
+    | Lop(Iintop_imm(op, n)) ->
+        let instr = name_for_int_operation op in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1
+    | Lop(Iabsf | Inegf as op) when !fpu = Soft ->
+        assert (i.res.(0).loc = i.arg.(0).loc);
+        let instr = (match op with
+                       Iabsf -> "bic"
+                     | Inegf -> "eor"
+                     | _     -> assert false) in
+        `	{emit_string instr}	{emit_reg i.res.(1)}, {emit_reg i.arg.(1)}, #0x80000000\n`; 1
+    | Lop(Iabsf | Inegf | Ispecific Isqrtf as op) ->
+        let instr = (match op with
+                       Iabsf            -> "fabsd"
+                     | Inegf            -> "fnegd"
+                     | Ispecific Isqrtf -> "fsqrtd"
+                     | _                -> assert false) in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`; 1
+    | Lop(Ifloatofint) ->
+        `	fmsr	s14, {emit_reg i.arg.(0)}\n`;
+        `	fsitod	{emit_reg i.res.(0)}, s14\n`; 2
+    | Lop(Iintoffloat) ->
+        `	ftosizd	s14, {emit_reg i.arg.(0)}\n`;
+        `	fmrs	{emit_reg i.res.(0)}, s14\n`; 2
+    | Lop(Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf as op) ->
+        let instr = (match op with
+                       Iaddf              -> "faddd"
+                     | Isubf              -> "fsubd"
+                     | Imulf              -> "fmuld"
+                     | Idivf              -> "fdivd"
+                     | Ispecific Inegmulf -> "fnmuld"
+                     | _                  -> assert false) in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+        1
+    | Lop(Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf as op)) ->
+        assert (i.res.(0).loc = i.arg.(0).loc);
+        let instr = (match op with
+                       Imuladdf    -> "fmacd"
+                     | Inegmuladdf -> "fnmacd"
+                     | Imulsubf    -> "fmscd"
+                     | Inegmulsubf -> "fnmscd"
+                     | _ -> assert false) in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`;
+        1
+    | Lop(Ispecific(Ishiftarith(op, shiftop, n))) ->
+        let instr = (match op with
+                       Ishiftadd    -> "add"
+                     | Ishiftsub    -> "sub"
+                     | Ishiftsubrev -> "rsb"
+                     | Ishiftand    -> "and"
+                     | Ishiftor     -> "orr"
+                     | Ishiftxor    -> "eor") in
+        let op = name_for_shift_operation shiftop in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, \
+                                        {emit_reg i.arg.(1)}, {emit_string op} #{emit_int n}\n`; 1
+    | Lop(Ispecific(Irevsubimm n)) ->
+        `	rsb	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1
+    | Lop(Ispecific(Imuladd | Imulsub as op)) ->
+        let instr = (match op with
+                       Imuladd -> "mla"
+                     | Imulsub -> "mls"
+                     | _ -> assert false) in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`; 1
+    | Lop(Ispecific(Ibswap size)) ->
+        begin match size with
+          16 ->
+            `	rev16	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`;
+            `	movt	{emit_reg i.res.(0)}, #0\n`; 2
+        | 32 ->
+            `	rev	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`; 1
+        | _ ->
+            assert false
+        end
+    | Lop (Iname_for_debugger _) -> 0
+    | Lreloadretaddr ->
+        let n = frame_size() in
+        `	ldr	lr, [sp, #{emit_int(n-4)}]\n`; 1
+    | Lreturn ->
+        output_epilogue begin fun () ->
+          `	bx	lr\n`; 1
+        end
+    | Llabel lbl ->
+        `{emit_label lbl}:\n`; 0
+    | Lbranch lbl ->
+        `	b	{emit_label lbl}\n`; 1
+    | Lcondbranch(tst, lbl) ->
+        begin match tst with
+          Itruetest ->
+            `	cmp	{emit_reg i.arg.(0)}, #0\n`;
+            `	bne	{emit_label lbl}\n`; 2
+        | Ifalsetest ->
+            `	cmp	{emit_reg i.arg.(0)}, #0\n`;
+            `	beq	{emit_label lbl}\n`; 2
+        | Iinttest cmp ->
+            `	cmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+            let comp = name_for_comparison cmp in
+            `	b{emit_string comp}	{emit_label lbl}\n`; 2
+        | Iinttest_imm(cmp, n) ->
+            `	cmp	{emit_reg i.arg.(0)}, #{emit_int n}\n`;
+            let comp = name_for_comparison cmp in
+            `	b{emit_string comp}	{emit_label lbl}\n`; 2
+        | Ifloattest cmp ->
+            let comp =
+              match cmp with
+              | CFeq -> "eq"
+              | CFneq -> "ne"
+              | CFlt -> "cc"
+              | CFnlt -> "cs"
+              | CFle -> "ls"
+              | CFnle -> "hi"
+              | CFgt -> "gt"
+              | CFngt -> "le"
+              | CFge -> "ge"
+              | CFnge -> "lt"
+            in
+            `	fcmpd	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+            `	fmstat\n`;
+            `	b{emit_string comp}	{emit_label lbl}\n`; 3
+        | Ioddtest ->
+            `	tst	{emit_reg i.arg.(0)}, #1\n`;
+            `	bne	{emit_label lbl}\n`; 2
+        | Ieventest ->
+            `	tst	{emit_reg i.arg.(0)}, #1\n`;
+            `	beq	{emit_label lbl}\n`; 2
+        end
+    | Lcondbranch3(lbl0, lbl1, lbl2) ->
+        `	cmp	{emit_reg i.arg.(0)}, #1\n`;
+        begin match lbl0 with
+          None -> ()
+        | Some lbl -> `	blt	{emit_label lbl}\n`
+        end;
+        begin match lbl1 with
+          None -> ()
+        | Some lbl -> `	beq	{emit_label lbl}\n`
+        end;
+        begin match lbl2 with
+          None -> ()
+        | Some lbl -> `	bgt	{emit_label lbl}\n`
+        end;
+        4
+    | Lswitch jumptbl ->
+        if !arch > ARMv6 && !thumb then begin
+          (* The Thumb-2 TBH instruction supports only forward branches,
+             so we need to generate appropriate trampolines for all labels
+             that appear before this switch instruction (PR#5623) *)
+          let tramtbl = Array.copy jumptbl in
+          `	tbh	[pc, {emit_reg i.arg.(0)}, lsl #1]\n`;
+          for j = 0 to Array.length tramtbl - 1 do
+            let rec label i =
+              match i.desc with
+                Lend -> new_label()
+              | Llabel lbl when lbl = tramtbl.(j) -> lbl
+              | _ -> label i.next in
+            tramtbl.(j) <- label i.next;
+            `	.short	({emit_label tramtbl.(j)}-.)/2+{emit_int j}\n`
+          done;
+          let sz = ref (1 + (Array.length jumptbl + 1) / 2) in
+          (* Generate the necessary trampolines *)
+          for j = 0 to Array.length tramtbl - 1 do
+            if tramtbl.(j) <> jumptbl.(j) then begin
+              `{emit_label tramtbl.(j)}:	b	{emit_label jumptbl.(j)}\n`;
+              incr sz
+            end
+          done;
+          !sz
+        end else if not !Clflags.pic_code then begin
+          `	ldr	pc, [pc, {emit_reg i.arg.(0)}, lsl #2]\n`;
+          `	nop\n`;
+          for j = 0 to Array.length jumptbl - 1 do
+            `	.word	{emit_label jumptbl.(j)}\n`
+          done;
+          2 + Array.length jumptbl
+        end else begin
+          (* Slightly slower, but position-independent *)
+          `	add	pc, pc, {emit_reg i.arg.(0)}, lsl #2\n`;
+          `	nop\n`;
+          for j = 0 to Array.length jumptbl - 1 do
+            `	b	{emit_label jumptbl.(j)}\n`
+          done;
+          2 + Array.length jumptbl
+        end
+    | Lentertrap ->
+        0
+    | Ladjust_trap_depth { delta_traps } ->
+        (* each trap occupies 8 bytes on the stack *)
+        let delta = 8 * delta_traps in
+        cfi_adjust_cfa_offset delta;
+        stack_offset := !stack_offset + delta; 0
+    | Lpushtrap { lbl_handler; } ->
+        let s = emit_load_handler_address lbl_handler in
+        stack_offset := !stack_offset + 8;
+        `	push	\{trap_ptr, lr}\n`;
+        cfi_adjust_cfa_offset 8;
+        `	mov	trap_ptr, sp\n`; s + 2
+    | Lpoptrap ->
+        `	pop	\{trap_ptr, lr}\n`;
+        cfi_adjust_cfa_offset (-8);
+        stack_offset := !stack_offset - 8; 1
+    | Lraise k ->
+        begin match k with
+        | Lambda.Raise_regular ->
+          let offset = Domainstate.(idx_of_field Domain_backtrace_pos) * 8 in
+          `	mov	r12, #0\n`;
+          `	str	r12, [domain_state_ptr, {emit_int offset}]\n`;
+          `	{emit_call "caml_raise_exn"}\n`;
+          `{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`; 3
+        | Lambda.Raise_reraise ->
+          `	{emit_call "caml_raise_exn"}\n`;
+          `{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`; 1
+        | Lambda.Raise_notrace ->
+          `	mov	sp, trap_ptr\n`;
+          `	pop	\{trap_ptr, pc}\n`; 2
+        end
+
+(* Upper bound on the size of the code sequence for a Linear instruction,
+   in 32-bit words. *)
+
+let max_instruction_size i =
+  match i.desc with
+  | Lswitch jumptbl ->
+      if !arch > ARMv6 && !thumb
+      then 1 + (Array.length jumptbl + 1) / 2 + Array.length jumptbl
+      else 2 + Array.length jumptbl
+  | _ ->
+      8   (* conservative upper bound; the true upper bound is probably 5 *)
+
+(* Emission of an instruction sequence *)
+
+let rec emit_all ninstr fallthrough i =
+  (* ninstr = number of 32-bit code words emitted since last constant island *)
+  (* fallthrough is true if previous instruction can fall through *)
+  if i.desc = Lend then () else begin
+    (* Make sure literals not yet emitted remain addressable,
+       or emit them in a new constant island. *)
+    (* fldd can address up to +/-1KB, ldr can address up to +/-4KB *)
+    let limit = (if !fpu >= VFPv2 && !float_literals <> []
+                 then 127
+                 else 511) in
+    let limit = limit - !size_literals - max_instruction_size i in
+    let ninstr' =
+      if ninstr >= limit - 64 && not fallthrough then begin
+        emit_literals();
+        0
+      end else if !size_literals != 0 && ninstr >= limit then begin
+        let lbl = new_label() in
+        `	b	{emit_label lbl}\n`;
+        emit_literals();
+        `{emit_label lbl}:\n`;
+        0
+      end else
+        ninstr in
+    let n = emit_instr i in
+    emit_all (ninstr' + n) (has_fallthrough i.desc) i.next
+  end
+
+(* Emission of a function declaration *)
+
+let fundecl fundecl =
+  function_name := fundecl.fun_name;
+  fastcode_flag := fundecl.fun_fast;
+  tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
+  float_literals := [];
+  gotrel_literals := [];
+  symbol_literals := [];
+  stack_offset := 0;
+  call_gc_sites := [];
+  bound_error_sites := [];
+  for i = 0 to Proc.num_register_classes - 1 do
+    num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
+  done;
+  contains_calls := fundecl.fun_contains_calls;
+  prologue_required := fundecl.fun_prologue_required;
+  emit_named_text_section !function_name;
+  `	.align	2\n`;
+  `	.globl	{emit_symbol fundecl.fun_name}\n`;
+  if !arch > ARMv6 && !thumb then
+    `	.thumb\n`
+  else
+    `	.arm\n`;
+  `	.type	{emit_symbol fundecl.fun_name}, %function\n`;
+  `{emit_symbol fundecl.fun_name}:\n`;
+  emit_debug_info fundecl.fun_dbg;
+  cfi_startproc();
+  emit_all 0 true fundecl.fun_body;
+  emit_literals();
+  List.iter emit_call_gc !call_gc_sites;
+  List.iter emit_call_bound_error !bound_error_sites;
+  cfi_endproc();
+  `	.type	{emit_symbol fundecl.fun_name}, %function\n`;
+  `	.size	{emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`
+
+(* Emission of data *)
+
+let emit_item = function
+    Cglobal_symbol s -> `	.globl	{emit_symbol s}\n`;
+  | Cdefine_symbol s -> `{emit_symbol s}:\n`
+  | Cint8 n -> `	.byte	{emit_int n}\n`
+  | Cint16 n -> `	.short	{emit_int n}\n`
+  | Cint32 n -> `	.long	{emit_int32 (Nativeint.to_int32 n)}\n`
+  | Cint n -> `	.long	{emit_int32 (Nativeint.to_int32 n)}\n`
+  | Csingle f -> emit_float32_directive ".long" (Int32.bits_of_float f)
+  | Cdouble f -> emit_float64_split_directive ".long" (Int64.bits_of_float f)
+  | Csymbol_address s -> `	.word	{emit_symbol s}\n`
+  | Cstring s -> emit_string_directive "	.ascii  " s
+  | Cskip n -> if n > 0 then `	.space	{emit_int n}\n`
+  | Calign n -> `	.align	{emit_int(Misc.log2 n)}\n`
+
+let data l =
+  `	.data\n`;
+  List.iter emit_item l
+
+(* Beginning / end of an assembly file *)
+
+let begin_assembly() =
+  reset_debug_info();
+  `	.file	\"\"\n`;  (* PR#7037 *)
+  `	.syntax	unified\n`;
+  begin match !arch with
+  | ARMv4   -> `	.arch	armv4t\n`
+  | ARMv5   -> `	.arch	armv5t\n`
+  | ARMv5TE -> `	.arch	armv5te\n`
+  | ARMv6   -> `	.arch	armv6\n`
+  | ARMv6T2 -> `	.arch	armv6t2\n`
+  | ARMv7   -> `	.arch	armv7-a\n`
+  | ARMv8   -> `	.arch	armv8-a\n`
+  end;
+  begin match !fpu with
+    Soft      -> `	.fpu	softvfp\n`
+  | VFPv2     -> `	.fpu	vfpv2\n`
+  | VFPv3_D16 -> `	.fpu	vfpv3-d16\n`
+  | VFPv3     -> `	.fpu	vfpv3\n`
+  end;
+  `trap_ptr	.req	r8\n`;
+  `alloc_ptr	.req	r10\n`;
+  `domain_state_ptr	.req	r11\n`;
+  let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
+  `	.data\n`;
+  `	.globl	{emit_symbol lbl_begin}\n`;
+  `{emit_symbol lbl_begin}:\n`;
+  let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
+  emit_named_text_section lbl_begin;
+  `	.globl	{emit_symbol lbl_begin}\n`;
+  `{emit_symbol lbl_begin}:\n`
+
+let end_assembly () =
+  let lbl_end = Compilenv.make_symbol (Some "code_end") in
+  emit_named_text_section lbl_end;
+  `	.globl	{emit_symbol lbl_end}\n`;
+  `{emit_symbol lbl_end}:\n`;
+  let lbl_end = Compilenv.make_symbol (Some "data_end") in
+  `	.data\n`;
+  `	.long 0\n`;  (* PR#6329 *)
+  `	.globl	{emit_symbol lbl_end}\n`;
+  `{emit_symbol lbl_end}:\n`;
+  `	.long	0\n`;
+  let lbl = Compilenv.make_symbol (Some "frametable") in
+  `	.globl	{emit_symbol lbl}\n`;
+  `{emit_symbol lbl}:\n`;
+  emit_frames
+    { efa_code_label = (fun lbl ->
+                       `	.type	{emit_label lbl}, %function\n`;
+                       `	.word	{emit_label lbl}\n`);
+      efa_data_label = (fun lbl ->
+                       `	.type	{emit_label lbl}, %object\n`;
+                       `	.word	{emit_label lbl}\n`);
+      efa_8 = (fun n -> `	.byte	{emit_int n}\n`);
+      efa_16 = (fun n -> `	.short	{emit_int n}\n`);
+      efa_32 = (fun n -> `	.long	{emit_int32 n}\n`);
+      efa_word = (fun n -> `	.word	{emit_int n}\n`);
+      efa_align = (fun n -> `	.align	{emit_int(Misc.log2 n)}\n`);
+      efa_label_rel = (fun lbl ofs ->
+                           `	.word	{emit_label lbl} - . + {emit_int32 ofs}\n`);
+      efa_def_label = (fun lbl -> `{emit_label lbl}:\n`);
+      efa_string = (fun s -> emit_string_directive "	.asciz	" s) };
+  `	.type	{emit_symbol lbl}, %object\n`;
+  `	.size	{emit_symbol lbl}, .-{emit_symbol lbl}\n`;
+  begin match Config.system with
+    "linux_eabihf" | "linux_eabi" | "netbsd" ->
+      (* Mark stack as non-executable *)
+      `	.section	.note.GNU-stack,\"\",%progbits\n`
+  | _ -> ()
+  end
diff --git a/asmcomp/arm/proc.ml b/asmcomp/arm/proc.ml
new file mode 100644
index 00000000..9ac9cf13
--- /dev/null
+++ b/asmcomp/arm/proc.ml
@@ -0,0 +1,363 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                 Benedikt Meurer, University of Siegen                  *)
+(*                                                                        *)
+(*   Copyright 1998 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2012 Benedikt Meurer.                                      *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Description of the ARM processor *)
+
+open Misc
+open Cmm
+open Reg
+open Arch
+open Mach
+
+(* Instruction selection *)
+
+let word_addressed = false
+
+(* Registers available for register allocation *)
+
+(* Integer register map:
+    r0 - r3               general purpose (not preserved)
+    r4 - r7               general purpose (preserved)
+    r8                    trap pointer (preserved)
+    r9                    platform register, usually reserved
+    r10                   allocation pointer (preserved)
+    r11                   domain state pointer (preserved)
+    r12                   intra-procedural scratch register (not preserved)
+    r13                   stack pointer
+    r14                   return address
+    r15                   program counter
+   Floating-point register map (VFPv{2,3}):
+    d0 - d7               general purpose (not preserved)
+    d8 - d15              general purpose (preserved)
+    d16 - d31             general purpose (not preserved), VFPv3 only
+*)
+
+let int_reg_name =
+  [| "r0"; "r1"; "r2"; "r3"; "r4"; "r5"; "r6"; "r7"; "r12" |]
+
+let float_reg_name =
+  [| "d0";  "d1";  "d2";  "d3";  "d4";  "d5";  "d6";  "d7";
+     "d8";  "d9";  "d10"; "d11"; "d12"; "d13"; "d14"; "d15";
+     "d16"; "d17"; "d18"; "d19"; "d20"; "d21"; "d22"; "d23";
+     "d24"; "d25"; "d26"; "d27"; "d28"; "d29"; "d30"; "d31" |]
+
+(* We have three register classes:
+    0 for integer registers
+    1 for VFPv2 and VFPv3-D16
+    2 for VFPv3
+   This way we can choose between VFPv2/VFPv3-D16 and VFPv3
+   at (ocamlopt) runtime using command line switches.
+*)
+
+let num_register_classes = 3
+
+let register_class r =
+  match (r.typ, !fpu) with
+  | (Val | Int | Addr), _  -> 0
+  | Float, VFPv2         -> 1
+  | Float, VFPv3_D16     -> 1
+  | Float, _             -> 2
+
+let num_available_registers =
+  [| 9; 16; 32 |]
+
+let first_available_register =
+  [| 0; 100; 100 |]
+
+let register_name r =
+  if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100)
+
+let rotate_registers = true
+
+(* Representation of hard registers by pseudo-registers *)
+
+let hard_int_reg =
+  let v = Array.make 9 Reg.dummy in
+  for i = 0 to 8 do
+    v.(i) <- Reg.at_location Int (Reg i)
+  done;
+  v
+
+let hard_float_reg =
+  let v = Array.make 32 Reg.dummy in
+  for i = 0 to 31 do
+    v.(i) <- Reg.at_location Float (Reg(100 + i))
+  done;
+  v
+
+let all_phys_regs =
+  Array.append hard_int_reg hard_float_reg
+
+let phys_reg n =
+  if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
+
+let stack_slot slot ty =
+  Reg.at_location ty (Stack slot)
+
+let loc_spacetime_node_hole = Reg.dummy  (* Spacetime unsupported *)
+
+(* Calling conventions *)
+
+let calling_conventions first_int last_int first_float last_float make_stack
+      arg =
+  let loc = Array.make (Array.length arg) [| Reg.dummy |] in
+  let int = ref first_int in
+  let float = ref first_float in
+  let ofs = ref 0 in
+  for i = 0 to Array.length arg - 1 do
+    match arg.(i) with
+    | [| arg |] ->
+      begin match arg.typ with
+      | Val | Int | Addr as ty ->
+          if !int <= last_int then begin
+            loc.(i) <- [| phys_reg !int |];
+            incr int
+          end else begin
+            loc.(i) <- [| stack_slot (make_stack !ofs) ty |];
+            ofs := !ofs + size_int
+          end
+      | Float ->
+          assert (abi = EABI_HF);
+          assert (!fpu >= VFPv2);
+          if !float <= last_float then begin
+            loc.(i) <- [| phys_reg !float |];
+            incr float
+          end else begin
+            ofs := Misc.align !ofs size_float;
+            loc.(i) <- [| stack_slot (make_stack !ofs) Float |];
+            ofs := !ofs + size_float
+          end
+      end
+    | [| arg1; arg2 |] ->
+      (* Passing of 64-bit quantities to external functions. *)
+      begin match arg1.typ, arg2.typ with
+      | Int, Int ->
+          (* 64-bit quantities split across two registers must either be in a
+             consecutive pair of registers where the lowest numbered is an
+             even-numbered register; or in a stack slot that is 8-byte
+             aligned. *)
+          int := Misc.align !int 2;
+          if !int <= last_int - 1 then begin
+            let reg_lower = phys_reg !int in
+            let reg_upper = phys_reg (1 + !int) in
+            loc.(i) <- [| reg_lower; reg_upper |];
+            int := !int + 2
+          end else begin
+            let size_int64 = size_int * 2 in
+            ofs := Misc.align !ofs size_int64;
+            let stack_lower = stack_slot (make_stack !ofs) Int in
+            let stack_upper = stack_slot (make_stack (size_int + !ofs)) Int in
+            loc.(i) <- [| stack_lower; stack_upper |];
+            ofs := !ofs + size_int64
+          end
+      | _, _ ->
+        let f = function Int -> "I" | Addr -> "A" | Val -> "V" | Float -> "F" in
+        fatal_error (Printf.sprintf "Proc.calling_conventions: bad register \
+            type(s) for multi-register argument: %s, %s"
+          (f arg1.typ) (f arg2.typ))
+      end
+    | _ ->
+      fatal_error "Proc.calling_conventions: bad number of registers for \
+        multi-register argument"
+  done;
+  (loc, Misc.align !ofs 8)  (* keep stack 8-aligned *)
+
+let incoming ofs = Incoming ofs
+let outgoing ofs = Outgoing ofs
+let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
+
+(* OCaml calling convention:
+     first integer args in r0...r7
+     first float args in d0...d15 (EABI+VFP)
+     remaining args on stack.
+   Return values in r0...r7 or d0...d15. *)
+
+let max_arguments_for_tailcalls = 8
+
+let single_regs arg = Array.map (fun arg -> [| arg |]) arg
+let ensure_single_regs res =
+  Array.map (function
+      | [| res |] -> res
+      | _ -> failwith "Proc.ensure_single_regs")
+    res
+
+let loc_arguments arg =
+  let (loc, alignment) =
+    calling_conventions 0 7 100 115 outgoing (single_regs arg)
+  in
+  ensure_single_regs loc, alignment
+let loc_parameters arg =
+  let (loc, _) = calling_conventions 0 7 100 115 incoming (single_regs arg) in
+  ensure_single_regs loc
+let loc_results res =
+  let (loc, _) =
+    calling_conventions 0 7 100 115 not_supported (single_regs res)
+  in
+  ensure_single_regs loc
+
+(* C calling convention:
+     first integer args in r0...r3
+     first float args in d0...d7 (EABI+VFP)
+     remaining args on stack.
+   Return values in r0...r1 or d0. *)
+
+let loc_external_arguments arg =
+  calling_conventions 0 3 100 107 outgoing arg
+let loc_external_results res =
+  let (loc, _) =
+    calling_conventions 0 1 100 100 not_supported (single_regs res)
+  in
+  ensure_single_regs loc
+
+let loc_exn_bucket = phys_reg 0
+
+(* See "DWARF for the ARM architecture" available from developer.arm.com. *)
+
+let int_dwarf_reg_numbers =
+  [| 0; 1; 2; 3; 4; 5; 6; 7; 12 |]
+
+let float_dwarf_reg_numbers_legacy =
+  [| 64; 65; 66; 67; 68; 69; 70; 71;
+     72; 73; 74; 75; 76; 77; 78; 79;
+     80; 81; 82; 83; 84; 85; 86; 87;
+     88; 89; 90; 91; 92; 93; 94; 95;
+  |]
+
+let float_dwarf_reg_numbers =
+  [| 256; 257; 258; 259; 260; 261; 262; 263;
+     264; 265; 266; 267; 268; 269; 270; 271;
+     272; 273; 274; 275; 276; 277; 278; 279;
+     280; 281; 282; 283; 284; 285; 286; 287;
+  |]
+
+let dwarf_register_numbers ~reg_class =
+  match reg_class with
+  | 0 -> int_dwarf_reg_numbers
+  | 1 ->
+    (* Section 3.1 note 4 says that the "new" VFPv3 register numberings
+       (as per [float_dwarf_reg_numbers]) should be used for VFPv2 as well.
+       However we believe that for <= ARMv6 we should use the legacy VFPv2
+       numberings. *)
+    if !arch <= ARMv6 then float_dwarf_reg_numbers_legacy
+    else float_dwarf_reg_numbers
+  | 2 -> float_dwarf_reg_numbers
+  | _ -> Misc.fatal_errorf "Bad register class %d" reg_class
+
+let stack_ptr_dwarf_register_number = 13
+
+(* Volatile registers: none *)
+
+let regs_are_volatile _rs = false
+
+(* Registers destroyed by operations *)
+
+let destroyed_at_alloc =            (* r0-r6, d0-d15 preserved *)
+  Array.of_list (List.map
+                   phys_reg
+                   [7;8;
+                    116;117;118;119;120;121;122;123;
+                    124;125;126;127;128;129;130;131])
+
+let destroyed_at_c_call =
+  Array.of_list (List.map
+                   phys_reg
+                   (match abi with
+                      EABI ->       (* r4-r7 preserved *)
+                        [0;1;2;3;8;
+                         100;101;102;103;104;105;106;107;
+                         108;109;110;111;112;113;114;115;
+                         116;117;118;119;120;121;122;123;
+                         124;125;126;127;128;129;130;131]
+                    | EABI_HF ->    (* r4-r7, d8-d15 preserved *)
+                        [0;1;2;3;8;
+                         100;101;102;103;104;105;106;107;
+                         116;117;118;119;120;121;122;123;
+                         124;125;126;127;128;129;130;131]))
+
+let destroyed_at_oper = function
+    Iop(Icall_ind _ | Icall_imm _)
+  | Iop(Iextcall { alloc = true; _ }) ->
+      all_phys_regs
+  | Iop(Iextcall { alloc = false; _}) ->
+      destroyed_at_c_call
+  | Iop(Ialloc _) ->
+      destroyed_at_alloc
+  | Iop(Iconst_symbol _) when !Clflags.pic_code ->
+      [| phys_reg 3; phys_reg 8 |]  (* r3 and r12 destroyed *)
+  | Iop(Iintop Imulh) when !arch < ARMv6 ->
+      [| phys_reg 8 |]              (* r12 destroyed *)
+  | Iop(Iintop (Icomp _) | Iintop_imm(Icomp _, _))
+    when !arch >= ARMv8 && !thumb ->
+      [| phys_reg 3 |]  (* r3 destroyed *)
+  | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _, _)) ->
+      [| phys_reg 107 |]            (* d7 (s14-s15) destroyed *)
+  | _ -> [||]
+
+let destroyed_at_raise = all_phys_regs
+
+(* lr is destroyed at [Lreloadretaddr], but lr is not used for register
+   allocation, and thus does not need to (and indeed cannot) occur here. *)
+let destroyed_at_reloadretaddr = [| |]
+
+(* Maximal register pressure *)
+
+let safe_register_pressure = function
+    Iextcall _ -> if abi = EABI then 0 else 4
+  | Ialloc _ -> if abi = EABI then 0 else 7
+  | Iconst_symbol _ when !Clflags.pic_code -> 7
+  | Iintop Imulh when !arch < ARMv6 -> 8
+  | _ -> 9
+
+let max_register_pressure = function
+    Iextcall _ -> if abi = EABI then [| 4; 0; 0 |] else [| 4; 8; 8 |]
+  | Ialloc _ -> if abi = EABI then [| 7; 0; 0 |] else [| 7; 8; 8 |]
+  | Iconst_symbol _ when !Clflags.pic_code -> [| 7; 16; 32 |]
+  | Iintoffloat | Ifloatofint
+  | Iload(Single, _) | Istore(Single, _, _) -> [| 9; 15; 31 |]
+  | Iintop Imulh when !arch < ARMv6 -> [| 8; 16; 32 |]
+  | _ -> [| 9; 16; 32 |]
+
+(* Pure operations (without any side effect besides updating their result
+   registers). *)
+
+let op_is_pure = function
+  | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
+  | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _)
+  | Ispecific(Ishiftcheckbound _) -> false
+  | _ -> true
+
+(* Layout of the stack *)
+
+let frame_required fd =
+  let num_stack_slots = fd.fun_num_stack_slots in
+  fd.fun_contains_calls
+    || num_stack_slots.(0) > 0
+    || num_stack_slots.(1) > 0
+    || num_stack_slots.(2) > 0
+
+let prologue_required fd =
+  frame_required fd
+
+(* Calling the assembler *)
+
+let assemble_file infile outfile =
+  Ccomp.command (Config.asm ^ " " ^
+                 (String.concat " " (Misc.debug_prefix_map_flags ())) ^
+                 " -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile)
+
+
+let init () = ()
diff --git a/asmcomp/arm/reload.ml b/asmcomp/arm/reload.ml
new file mode 100644
index 00000000..301ec112
--- /dev/null
+++ b/asmcomp/arm/reload.ml
@@ -0,0 +1,57 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1998 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Arch
+open Mach
+
+(* Reloading for the ARM *)
+
+class reload = object
+
+inherit Reloadgen.reload_generic as super
+
+method! reload_operation op arg res =
+  let ((arg', res') as argres') = super#reload_operation op arg res in
+  match op with
+  | Iintop Imul | Ispecific Imuladd ->
+      (* On ARM v4 and v5, module [Selection] adds a second, dummy
+         result to multiplication instructions (mul and muladd).  This
+         second result is the same pseudoregister as the first
+         argument to the multiplication.  As shown in MPR#7642,
+         reloading must maintain this invariant.  Otherwise, the second
+         result and the first argument can end up in different registers,
+         and the second result can be used later, even though
+         it is not initialized. *)
+      if Array.length res' >= 2 then res'.(1) <- arg'.(0);
+      argres'
+  | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) ->
+      (* VFP float multiply-add instructions are "two-address" in the
+         sense that they must have [arg.(0) = res.(0)].
+         Preserve this invariant. *)
+      (arg', [|arg'.(0)|])
+  | Iabsf | Inegf when !fpu = Soft ->
+      (* Soft FP neg and abs also have a "two-address" constraint of sorts.
+         64-bit floats are represented by pairs of 32-bit integers,
+         hence there are two arguments and two results.
+         The code emitter assumes [arg.(0) = res.(0)] but supports
+         [arg.(1)] and [res.(1)] being in different registers. *)
+      res'.(0) <- arg'.(0);
+      argres'
+  | _ ->
+      argres'
+end
+
+let fundecl f num_stack_slots =
+  (new reload)#fundecl f num_stack_slots
diff --git a/asmcomp/arm/scheduling.ml b/asmcomp/arm/scheduling.ml
new file mode 100644
index 00000000..4039eaac
--- /dev/null
+++ b/asmcomp/arm/scheduling.ml
@@ -0,0 +1,80 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                 Benedikt Meurer, University of Siegen                  *)
+(*                                                                        *)
+(*   Copyright 1998 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2012 Benedikt Meurer.                                      *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Arch
+open Mach
+
+(* Instruction scheduling for the ARM *)
+
+class scheduler = object
+
+inherit Schedgen.scheduler_generic as super
+
+(* Scheduling -- based roughly on the ARM11 (ARMv6) *)
+
+method oper_latency = function
+  (* Loads have a latency of two cycles in general *)
+    Iconst_symbol _
+  | Iconst_float _
+  | Iload(_, _)
+  | Ireload
+  | Ifloatofint       (* mcr/mrc count as memory access *)
+  | Iintoffloat -> 2
+  (* Multiplys have a latency of two cycles *)
+  | Iintop (Imul | Imulh)
+  | Ispecific(Imuladd | Imulsub | Imulhadd) -> 2
+  (* VFP instructions *)
+  | Iaddf
+  | Isubf
+  | Idivf
+  | Imulf | Ispecific Inegmulf
+  | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf)
+  | Ispecific Isqrtf
+  | Inegf | Iabsf when !fpu >= VFPv2 -> 2
+  (* Everything else *)
+  | _ -> 1
+
+method! is_checkbound = function
+    Ispecific(Ishiftcheckbound _) -> true
+  | op -> super#is_checkbound op
+
+(* Issue cycles. Rough approximations *)
+
+method oper_issue_cycles = function
+    Ialloc _ -> 4
+  | Iintop(Ilsl | Ilsr | Iasr) -> 2
+  | Iintop(Icomp _)
+  | Iintop_imm(Icomp _, _) -> 3
+  | Iintop(Icheckbound _)
+  | Iintop_imm(Icheckbound _, _) -> 2
+  | Ispecific(Ishiftcheckbound _) -> 3
+  | Iintop(Imul | Imulh)
+  | Ispecific(Imuladd | Imulsub | Imulhadd) -> 2
+  (* VFP instructions *)
+  | Iaddf
+  | Isubf -> 7
+  | Imulf
+  | Ispecific Inegmulf -> 9
+  | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) -> 17
+  | Idivf
+  | Ispecific Isqrtf -> 27
+  | Inegf | Iabsf | Iconst_float _ when !fpu >= VFPv2 -> 4
+  (* Everything else *)
+  | _ -> 1
+
+end
+
+let fundecl f = (new scheduler)#schedule_fundecl f
diff --git a/asmcomp/arm/selection.ml b/asmcomp/arm/selection.ml
new file mode 100644
index 00000000..f43c13d9
--- /dev/null
+++ b/asmcomp/arm/selection.ml
@@ -0,0 +1,320 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                 Benedikt Meurer, University of Siegen                  *)
+(*                                                                        *)
+(*   Copyright 1998 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2012 Benedikt Meurer.                                      *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Instruction selection for the ARM processor *)
+
+open Arch
+open Proc
+open Cmm
+open Mach
+
+let is_offset chunk n =
+  match chunk with
+  (* VFPv{2,3} load/store have -1020 to 1020.  Offset must be multiple of 4 *)
+  | Single | Double | Double_u
+    when !fpu >= VFPv2 ->
+      n >= -1020 && n <= 1020 && n mod 4 = 0
+  (* ARM load/store byte/word have -4095 to 4095 *)
+  | Byte_unsigned | Byte_signed
+  | Thirtytwo_unsigned | Thirtytwo_signed
+  | Word_int | Word_val | Single
+    when not !thumb ->
+      n >= -4095 && n <= 4095
+  (* Thumb-2 load/store have -255 to 4095 *)
+  | _ when !arch > ARMv6 && !thumb ->
+      n >= -255 && n <= 4095
+  (* Everything else has -255 to 255 *)
+  | _ ->
+      n >= -255 && n <= 255
+
+let select_shiftop = function
+    Clsl -> Ishiftlogicalleft
+  | Clsr -> Ishiftlogicalright
+  | Casr -> Ishiftarithmeticright
+  | __-> assert false
+
+(* Special constraints on operand and result registers *)
+
+exception Use_default
+
+let r1 = phys_reg 1
+let r6 = phys_reg 6
+let r7 = phys_reg 7
+
+let pseudoregs_for_operation op arg res =
+  match op with
+  (* For mul rd,rm,rs and mla rd,rm,rs,ra (pre-ARMv6) the registers rm
+     and rd must be different. We deal with this by pretending that rm
+     is also a result of the mul / mla operation. *)
+    Iintop Imul | Ispecific Imuladd when !arch < ARMv6 ->
+      (arg, [| res.(0); arg.(0) |])
+  (* For smull rdlo,rdhi,rn,rm (pre-ARMv6) the registers rdlo, rdhi and rn
+     must be different.  Also, rdlo (whose contents we discard) is always
+     forced to be r12 in proc.ml, which means that neither rdhi and rn can
+     be r12.  To keep things simple, we force both of those two to specific
+     hard regs: rdhi in r6 and rn in r7. *)
+  | Iintop Imulh when !arch < ARMv6 ->
+      ([| r7; arg.(1) |], [| r6 |])
+  (* Soft-float Iabsf and Inegf: arg.(0) and res.(0) must be the same *)
+  | Iabsf | Inegf when !fpu = Soft ->
+      ([|res.(0); arg.(1)|], res)
+  (* VFPv{2,3} Imuladdf...Inegmulsubf: arg.(0) and res.(0) must be the same *)
+  | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) ->
+      let arg' = Array.copy arg in
+      arg'.(0) <- res.(0);
+      (arg', res)
+  (* We use __aeabi_idivmod for Cmodi only, and hence we care only
+     for the remainder in r1, so fix up the destination register. *)
+  | Iextcall { func = "__aeabi_idivmod"; alloc = false; } ->
+      (arg, [|r1|])
+  (* Other instructions are regular *)
+  | _ -> raise Use_default
+
+(* Instruction selection *)
+class selector = object(self)
+
+inherit Selectgen.selector_generic as super
+
+method! regs_for tyv =
+  Reg.createv (if !fpu = Soft then begin
+                 (* Expand floats into pairs of integer registers *)
+                 (* CR mshinwell: we need to check this in conjunction with
+                    the unboxed external functionality *)
+                 let rec expand = function
+                   [] -> []
+                 | Float :: tyl -> Int :: Int :: expand tyl
+                 | ty :: tyl -> ty :: expand tyl in
+                 Array.of_list (expand (Array.to_list tyv))
+               end else begin
+                 tyv
+               end)
+
+method is_immediate n =
+  is_immediate (Int32.of_int n)
+
+method! is_simple_expr = function
+  (* inlined floating-point ops are simple if their arguments are *)
+  | Cop(Cextcall("sqrt", _, _, _), args, _) when !fpu >= VFPv2 ->
+      List.for_all self#is_simple_expr args
+  (* inlined byte-swap ops are simple if their arguments are *)
+  | Cop(Cextcall("caml_bswap16_direct", _, _, _), args, _)
+    when !arch >= ARMv6T2 ->
+      List.for_all self#is_simple_expr args
+  | Cop(Cextcall("caml_int32_direct_bswap",_,_,_), args, _)
+    when !arch >= ARMv6 ->
+      List.for_all self#is_simple_expr args
+  | e -> super#is_simple_expr e
+
+method! effects_of e =
+  match e with
+  | Cop(Cextcall("sqrt", _, _, _), args, _) when !fpu >= VFPv2 ->
+      Selectgen.Effect_and_coeffect.join_list_map args self#effects_of
+  | Cop(Cextcall("caml_bswap16_direct", _, _, _), args, _)
+    when !arch >= ARMv6T2 ->
+      Selectgen.Effect_and_coeffect.join_list_map args self#effects_of
+  | Cop(Cextcall("caml_int32_direct_bswap",_,_,_), args, _)
+    when !arch >= ARMv6 ->
+      Selectgen.Effect_and_coeffect.join_list_map args self#effects_of
+  | e -> super#effects_of e
+
+method select_addressing chunk = function
+  | Cop((Cadda | Caddv), [arg; Cconst_int (n, _)], _)
+    when is_offset chunk n ->
+      (Iindexed n, arg)
+  | Cop((Cadda | Caddv as op),
+      [arg1; Cop(Caddi, [arg2; Cconst_int (n, _)], _)], dbg)
+    when is_offset chunk n ->
+      (Iindexed n, Cop(op, [arg1; arg2], dbg))
+  | arg ->
+      (Iindexed 0, arg)
+
+method select_shift_arith op dbg arithop arithrevop args =
+  match args with
+    [arg1; Cop(Clsl | Clsr | Casr as op, [arg2; Cconst_int (n, _)], _)]
+    when n > 0 && n < 32 ->
+      (Ispecific(Ishiftarith(arithop, select_shiftop op, n)), [arg1; arg2])
+  | [Cop(Clsl | Clsr | Casr as op, [arg1; Cconst_int (n, _)], _); arg2]
+    when n > 0 && n < 32 ->
+      (Ispecific(Ishiftarith(arithrevop, select_shiftop op, n)), [arg2; arg1])
+  | args ->
+      begin match super#select_operation op args dbg with
+      (* Recognize multiply high and add *)
+        (Iintop Iadd, [Cop(Cmulhi, args, _); arg3])
+      | (Iintop Iadd, [arg3; Cop(Cmulhi, args, _)]) as op_args
+        when !arch >= ARMv6 ->
+          begin match self#select_operation Cmulhi args dbg with
+            (Iintop Imulh, [arg1; arg2]) ->
+              (Ispecific Imulhadd, [arg1; arg2; arg3])
+          | _ -> op_args
+          end
+      (* Recognize multiply and add *)
+      | (Iintop Iadd, [Cop(Cmuli, args, _); arg3])
+      | (Iintop Iadd, [arg3; Cop(Cmuli, args, _)]) as op_args ->
+          begin match self#select_operation Cmuli args dbg with
+            (Iintop Imul, [arg1; arg2]) ->
+              (Ispecific Imuladd, [arg1; arg2; arg3])
+          | _ -> op_args
+          end
+      (* Recognize multiply and subtract *)
+      | (Iintop Isub, [arg3; Cop(Cmuli, args, _)]) as op_args
+        when !arch > ARMv6 ->
+          begin match self#select_operation Cmuli args dbg with
+            (Iintop Imul, [arg1; arg2]) ->
+              (Ispecific Imulsub, [arg1; arg2; arg3])
+          | _ -> op_args
+          end
+      | op_args -> op_args
+      end
+
+method private iextcall (func, alloc) =
+  Iextcall { func; alloc; label_after = Cmm.new_label (); }
+
+method! select_operation op args dbg =
+  match (op, args) with
+  (* Recognize special shift arithmetic *)
+    ((Caddv | Cadda | Caddi), [arg; Cconst_int (n, _)])
+    when n < 0 && self#is_immediate (-n) ->
+      (Iintop_imm(Isub, -n), [arg])
+  | ((Caddv | Cadda | Caddi as op), args) ->
+      self#select_shift_arith op dbg Ishiftadd Ishiftadd args
+  | (Csubi, [arg; Cconst_int (n, _)])
+    when n < 0 && self#is_immediate (-n) ->
+      (Iintop_imm(Iadd, -n), [arg])
+  | (Csubi, [Cconst_int (n, _); arg])
+    when self#is_immediate n ->
+      (Ispecific(Irevsubimm n), [arg])
+  | (Csubi as op, args) ->
+      self#select_shift_arith op dbg Ishiftsub Ishiftsubrev args
+  | (Cand as op, args) ->
+      self#select_shift_arith op dbg Ishiftand Ishiftand args
+  | (Cor as op, args) ->
+      self#select_shift_arith op dbg Ishiftor Ishiftor args
+  | (Cxor as op, args) ->
+      self#select_shift_arith op dbg Ishiftxor Ishiftxor args
+  | (Ccheckbound,
+      [Cop(Clsl | Clsr | Casr as op, [arg1; Cconst_int (n, _)], _); arg2])
+    when n > 0 && n < 32 ->
+      (Ispecific(Ishiftcheckbound(select_shiftop op, n)), [arg1; arg2])
+  (* ARM does not support immediate operands for multiplication *)
+  | (Cmuli, args) ->
+      (Iintop Imul, args)
+  | (Cmulhi, args) ->
+      (Iintop Imulh, args)
+  (* Turn integer division/modulus into runtime ABI calls *)
+  | (Cdivi, args) ->
+      (self#iextcall("__aeabi_idiv", false), args)
+  | (Cmodi, args) ->
+      (* See above for fix up of return register *)
+      (self#iextcall("__aeabi_idivmod", false), args)
+  (* Recognize 16-bit bswap instruction (ARMv6T2 because we need movt) *)
+  | (Cextcall("caml_bswap16_direct", _, _, _), args) when !arch >= ARMv6T2 ->
+      (Ispecific(Ibswap 16), args)
+  (* Recognize 32-bit bswap instructions (ARMv6 and above) *)
+  | (Cextcall("caml_int32_direct_bswap", _, _, _), args)
+    when !arch >= ARMv6 ->
+      (Ispecific(Ibswap 32), args)
+  (* Turn floating-point operations into runtime ABI calls for softfp *)
+  | (op, args) when !fpu = Soft -> self#select_operation_softfp op args dbg
+  (* Select operations for VFPv{2,3} *)
+  | (op, args) -> self#select_operation_vfpv3 op args dbg
+
+method private select_operation_softfp op args dbg =
+  match (op, args) with
+  (* Turn floating-point operations into runtime ABI calls *)
+  | (Caddf, args) -> (self#iextcall("__aeabi_dadd", false), args)
+  | (Csubf, args) -> (self#iextcall("__aeabi_dsub", false), args)
+  | (Cmulf, args) -> (self#iextcall("__aeabi_dmul", false), args)
+  | (Cdivf, args) -> (self#iextcall("__aeabi_ddiv", false), args)
+  | (Cfloatofint, args) -> (self#iextcall("__aeabi_i2d", false), args)
+  | (Cintoffloat, args) -> (self#iextcall("__aeabi_d2iz", false), args)
+  | (Ccmpf comp, args) ->
+      let comp, func =
+        match comp with
+        | CFeq -> Cne, "__aeabi_dcmpeq"
+        | CFneq -> Ceq, "__aeabi_dcmpeq"
+        | CFlt -> Cne, "__aeabi_dcmplt"
+        | CFnlt -> Ceq, "__aeabi_dcmplt"
+        | CFle -> Cne, "__aeabi_dcmple"
+        | CFnle -> Ceq, "__aeabi_dcmple"
+        | CFgt -> Cne, "__aeabi_dcmpgt"
+        | CFngt -> Ceq, "__aeabi_dcmpgt"
+        | CFge -> Cne, "__aeabi_dcmpge"
+        | CFnge -> Ceq, "__aeabi_dcmpge"
+      in
+      (Iintop_imm(Icomp(Iunsigned comp), 0),
+       [Cop(Cextcall(func, typ_int, false, None), args, dbg)])
+  (* Add coercions around loads and stores of 32-bit floats *)
+  | (Cload (Single, mut), args) ->
+      (self#iextcall("__aeabi_f2d", false),
+        [Cop(Cload (Word_int, mut), args, dbg)])
+  | (Cstore (Single, init), [arg1; arg2]) ->
+      let arg2' =
+        Cop(Cextcall("__aeabi_d2f", typ_int, false, None), [arg2], dbg) in
+      self#select_operation (Cstore (Word_int, init)) [arg1; arg2'] dbg
+  (* Other operations are regular *)
+  | (op, args) -> super#select_operation op args dbg
+
+method private select_operation_vfpv3 op args dbg =
+  match (op, args) with
+  (* Recognize floating-point negate and multiply *)
+    (Cnegf, [Cop(Cmulf, args, _)]) ->
+      (Ispecific Inegmulf, args)
+  (* Recognize floating-point multiply and add *)
+  | (Caddf, [arg; Cop(Cmulf, args, _)])
+  | (Caddf, [Cop(Cmulf, args, _); arg]) ->
+      (Ispecific Imuladdf, arg :: args)
+  (* Recognize floating-point negate, multiply and subtract *)
+  | (Csubf, [Cop(Cnegf, [arg], _); Cop(Cmulf, args, _)])
+  | (Csubf, [Cop(Cnegf, [Cop(Cmulf, args, _)], _); arg]) ->
+      (Ispecific Inegmulsubf, arg :: args)
+  (* Recognize floating-point negate, multiply and add *)
+  | (Csubf, [arg; Cop(Cmulf, args, _)]) ->
+      (Ispecific Inegmuladdf, arg :: args)
+  (* Recognize multiply and subtract *)
+  | (Csubf, [Cop(Cmulf, args, _); arg]) ->
+      (Ispecific Imulsubf, arg :: args)
+  (* Recognize floating-point square root *)
+  | (Cextcall("sqrt", _, false, _), args) ->
+      (Ispecific Isqrtf, args)
+  (* Other operations are regular *)
+  | (op, args) -> super#select_operation op args dbg
+
+method! select_condition = function
+  (* Turn floating-point comparisons into runtime ABI calls *)
+    Cop(Ccmpf _ as op, args, dbg) when !fpu = Soft ->
+      begin match self#select_operation_softfp op args dbg with
+        (Iintop_imm(Icomp(Iunsigned Ceq), 0), [arg]) -> (Ifalsetest, arg)
+      | (Iintop_imm(Icomp(Iunsigned Cne), 0), [arg]) -> (Itruetest, arg)
+      | _ -> assert false
+      end
+  | expr ->
+      super#select_condition expr
+
+(* Deal with some register constraints *)
+
+method! insert_op_debug env op dbg rs rd =
+  try
+    let (rsrc, rdst) = pseudoregs_for_operation op rs rd in
+    self#insert_moves env rs rsrc;
+    self#insert_debug env (Iop op) dbg rsrc rdst;
+    self#insert_moves env rdst rd;
+    rd
+  with Use_default ->
+    super#insert_op_debug env op dbg rs rd
+
+end
+
+let fundecl f = (new selector)#emit_fundecl f
diff --git a/asmcomp/arm64/CSE.ml b/asmcomp/arm64/CSE.ml
new file mode 100644
index 00000000..b97f9227
--- /dev/null
+++ b/asmcomp/arm64/CSE.ml
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* CSE for ARM64 *)
+
+open Arch
+open Mach
+open CSEgen
+
+class cse = object
+
+inherit cse_generic as super
+
+method! class_of_operation op =
+  match op with
+  | Ispecific(Ishiftcheckbound _) -> Op_checkbound
+  | Ispecific _ -> Op_pure
+  | _ -> super#class_of_operation op
+
+method! is_cheap_operation op =
+  match op with
+  | Iconst_int n -> n <= 65535n && n >= 0n
+  | _ -> false
+
+end
+
+let fundecl f =
+  (new cse)#fundecl f
diff --git a/asmcomp/arm64/NOTES.md b/asmcomp/arm64/NOTES.md
new file mode 100644
index 00000000..e2134eb1
--- /dev/null
+++ b/asmcomp/arm64/NOTES.md
@@ -0,0 +1,12 @@
+# Supported platforms
+
+ARMv8 in 64-bit mode (AArch64).
+
+Debian architecture name: `arm64`.
+
+# Reference documents
+
+* Instruction set architecture:
+  _ARM Architecture Reference Manual, ARMv8_, restricted to the AArch64 subset.
+* Application binary interface:
+  _Procedure Call Standard for the ARM 64-bit Architecture (AArch64)_
diff --git a/asmcomp/arm64/arch.ml b/asmcomp/arm64/arch.ml
new file mode 100644
index 00000000..9cf923c6
--- /dev/null
+++ b/asmcomp/arm64/arch.ml
@@ -0,0 +1,172 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                 Benedikt Meurer, University of Siegen                  *)
+(*                                                                        *)
+(*   Copyright 2013 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2012 Benedikt Meurer.                                      *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Specific operations for the ARM processor, 64-bit mode *)
+
+open Format
+
+let command_line_options = []
+
+(* Addressing modes *)
+
+type addressing_mode =
+  | Iindexed of int                     (* reg + displ *)
+  | Ibased of string * int              (* global var + displ *)
+
+(* We do not support the reg + shifted reg addressing mode, because
+   what we really need is reg + shifted reg + displ,
+   and this is decomposed in two instructions (reg + shifted reg -> tmp,
+   then addressing tmp + displ). *)
+
+(* Specific operations *)
+
+type cmm_label = int
+  (* Do not introduce a dependency to Cmm *)
+
+type specific_operation =
+  | Ifar_alloc of { bytes : int; label_after_call_gc : cmm_label option;
+                    dbginfo : Debuginfo.alloc_dbginfo }
+  | Ifar_intop_checkbound of { label_after_error : cmm_label option; }
+  | Ifar_intop_imm_checkbound of
+      { bound : int; label_after_error : cmm_label option; }
+  | Ishiftarith of arith_operation * int
+  | Ishiftcheckbound of { shift : int; label_after_error : cmm_label option; }
+  | Ifar_shiftcheckbound of
+      { shift : int; label_after_error : cmm_label option; }
+  | Imuladd       (* multiply and add *)
+  | Imulsub       (* multiply and subtract *)
+  | Inegmulf      (* floating-point negate and multiply *)
+  | Imuladdf      (* floating-point multiply and add *)
+  | Inegmuladdf   (* floating-point negate, multiply and add *)
+  | Imulsubf      (* floating-point multiply and subtract *)
+  | Inegmulsubf   (* floating-point negate, multiply and subtract *)
+  | Isqrtf        (* floating-point square root *)
+  | Ibswap of int (* endianness conversion *)
+
+and arith_operation =
+    Ishiftadd
+  | Ishiftsub
+
+let spacetime_node_hole_pointer_is_live_before = function
+  | Ifar_alloc _ | Ifar_intop_checkbound _ | Ifar_intop_imm_checkbound _
+  | Ishiftarith _ | Ishiftcheckbound _ | Ifar_shiftcheckbound _ -> false
+  | Imuladd | Imulsub | Inegmulf | Imuladdf | Inegmuladdf | Imulsubf
+  | Inegmulsubf | Isqrtf | Ibswap _ -> false
+
+(* Sizes, endianness *)
+
+let big_endian = false
+
+let size_addr = 8
+let size_int = 8
+let size_float = 8
+
+let allow_unaligned_access = false
+
+(* Behavior of division *)
+
+let division_crashes_on_overflow = false
+
+(* Operations on addressing modes *)
+
+let identity_addressing = Iindexed 0
+
+let offset_addressing addr delta =
+  match addr with
+  | 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 =
+  match addr with
+  | Iindexed n ->
+      printreg ppf arg.(0);
+      if n <> 0 then fprintf ppf " + %i" n
+  | Ibased(s, 0) ->
+      fprintf ppf "\"%s\"" s
+  | Ibased(s, n) ->
+      fprintf ppf "\"%s\" + %i" s n
+
+let print_specific_operation printreg op ppf arg =
+  match op with
+  | Ifar_alloc { bytes; label_after_call_gc = _; } ->
+    fprintf ppf "(far) alloc %i" bytes
+  | Ifar_intop_checkbound _ ->
+    fprintf ppf "%a (far) check > %a" printreg arg.(0) printreg arg.(1)
+  | Ifar_intop_imm_checkbound { bound; _ } ->
+    fprintf ppf "%a (far) check > %i" printreg arg.(0) bound
+  | Ishiftarith(op, shift) ->
+      let op_name = function
+      | Ishiftadd -> "+"
+      | Ishiftsub -> "-" in
+      let shift_mark =
+       if shift >= 0
+       then sprintf "<< %i" shift
+       else sprintf ">> %i" (-shift) in
+      fprintf ppf "%a %s %a %s"
+       printreg arg.(0) (op_name op) printreg arg.(1) shift_mark
+  | Ishiftcheckbound { shift; _ } ->
+      fprintf ppf "check %a >> %i > %a" printreg arg.(0) shift
+        printreg arg.(1)
+  | Ifar_shiftcheckbound { shift; _ } ->
+      fprintf ppf
+        "(far) check %a >> %i > %a" printreg arg.(0) shift printreg arg.(1)
+  | Imuladd ->
+      fprintf ppf "(%a * %a) + %a"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Imulsub ->
+      fprintf ppf "-(%a * %a) + %a"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Inegmulf ->
+      fprintf ppf "-f (%a *f %a)"
+        printreg arg.(0)
+        printreg arg.(1)
+  | Imuladdf ->
+      fprintf ppf "%a +f (%a *f %a)"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Inegmuladdf ->
+      fprintf ppf "(-f %a) -f (%a *f %a)"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Imulsubf ->
+      fprintf ppf "%a -f (%a *f %a)"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Inegmulsubf ->
+      fprintf ppf "(-f %a) +f (%a *f %a)"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Isqrtf ->
+      fprintf ppf "sqrtf %a"
+        printreg arg.(0)
+  | Ibswap n ->
+      fprintf ppf "bswap%i %a" n
+        printreg arg.(0)
diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp
new file mode 100644
index 00000000..cddfc08a
--- /dev/null
+++ b/asmcomp/arm64/emit.mlp
@@ -0,0 +1,1042 @@
+#2 "asmcomp/arm64/emit.mlp"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                 Benedikt Meurer, University of Siegen                  *)
+(*                                                                        *)
+(*   Copyright 2013 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2012 Benedikt Meurer.                                      *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Emission of ARM assembly code, 64-bit mode *)
+
+open Misc
+open Cmm
+open Arch
+open Proc
+open Reg
+open Mach
+open Linear
+open Emitaux
+
+(* Tradeoff between code size and code speed *)
+
+let fastcode_flag = ref true
+
+(* Names for special regs *)
+
+let reg_domain_state_ptr = phys_reg 22
+let reg_trap_ptr = phys_reg 23
+let reg_alloc_ptr = phys_reg 24
+let reg_alloc_limit = phys_reg 25
+let reg_tmp1 = phys_reg 26
+let reg_x15 = phys_reg 15
+
+(* Output a label *)
+
+let emit_label lbl =
+  emit_string ".L"; emit_int lbl
+
+(* Symbols *)
+
+let emit_symbol s =
+  Emitaux.emit_symbol '$' s
+
+(* Output a pseudo-register *)
+
+let emit_reg = function
+    {loc = Reg r} -> emit_string (register_name r)
+  | _ -> fatal_error "Emit.emit_reg"
+
+(* Likewise, but with the 32-bit name of the register *)
+
+let int_reg_name_w =
+  [| "w0";  "w1";  "w2";  "w3";  "w4";  "w5";  "w6";  "w7";
+     "w8";  "w9";  "w10"; "w11"; "w12"; "w13"; "w14"; "w15";
+     "w19"; "w20"; "w21"; "w22"; "w23"; "w24"; "w25";
+     "w26"; "w27"; "w28"; "w16"; "w17" |]
+
+let emit_wreg = function
+    {loc = Reg r} -> emit_string int_reg_name_w.(r)
+  | _ -> fatal_error "Emit.emit_wreg"
+
+(* Layout of the stack frame *)
+
+let stack_offset = ref 0
+
+let num_stack_slots = Array.make Proc.num_register_classes 0
+
+let prologue_required = ref false
+
+let contains_calls = ref false
+
+let frame_size () =
+  let sz =
+    !stack_offset +
+    8 * num_stack_slots.(0) +
+    8 * num_stack_slots.(1) +
+    (if !contains_calls then 8 else 0)
+  in Misc.align sz 16
+
+let slot_offset loc cl =
+  match loc with
+    Incoming n ->
+      assert (n >= 0);
+      frame_size() + n
+  | Local n ->
+      !stack_offset +
+      (if cl = 0
+       then n * 8
+       else num_stack_slots.(0) * 8 + n * 8)
+  | Outgoing n ->
+      assert (n >= 0);
+      n
+
+(* Output a stack reference *)
+
+let emit_stack r =
+  match r.loc with
+  | Stack s ->
+      let ofs = slot_offset s (register_class r) in `[sp, #{emit_int ofs}]`
+  | _ -> fatal_error "Emit.emit_stack"
+
+(* Output an addressing mode *)
+
+let emit_symbol_offset s ofs =
+  emit_symbol s;
+  if ofs > 0 then `+{emit_int ofs}`
+  else if ofs < 0 then `-{emit_int (-ofs)}`
+  else ()
+
+let emit_addressing addr r =
+  match addr with
+  | Iindexed ofs ->
+      `[{emit_reg r}, #{emit_int ofs}]`
+  | Ibased(s, ofs) ->
+      assert (not !Clflags.dlcode);  (* see selection.ml *)
+      `[{emit_reg r}, #:lo12:{emit_symbol_offset s ofs}]`
+
+(* Record live pointers at call points *)
+
+let record_frame_label ?label live dbg =
+  let lbl =
+    match label with
+    | None -> new_label()
+    | Some label -> label
+  in
+  let live_offset = ref [] in
+  Reg.Set.iter
+    (function
+      | {typ = Val; loc = Reg r} ->
+          live_offset := ((r lsl 1) + 1) :: !live_offset
+      | {typ = Val; loc = Stack s} as reg ->
+          live_offset := slot_offset s (register_class reg) :: !live_offset
+      | {typ = Addr} as r ->
+          Misc.fatal_error ("bad GC root " ^ Reg.name r)
+      | _ -> ())
+    live;
+  record_frame_descr ~label:lbl ~frame_size:(frame_size())
+    ~live_offset:!live_offset dbg;
+  lbl
+
+let record_frame ?label live dbg =
+  let lbl = record_frame_label ?label live dbg in `{emit_label lbl}:`
+
+(* Record calls to the GC -- we've moved them out of the way *)
+
+type gc_call =
+  { gc_lbl: label;                      (* Entry label *)
+    gc_return_lbl: label;               (* Where to branch after GC *)
+    gc_frame_lbl: label }               (* Label of frame descriptor *)
+
+let call_gc_sites = ref ([] : gc_call list)
+
+let emit_call_gc gc =
+  `{emit_label gc.gc_lbl}:	bl	{emit_symbol "caml_call_gc"}\n`;
+  `{emit_label gc.gc_frame_lbl}:	b	{emit_label gc.gc_return_lbl}\n`
+
+(* Record calls to caml_ml_array_bound_error.
+   In debug mode, we maintain one call to caml_ml_array_bound_error
+   per bound check site. Otherwise, we can share a single call. *)
+
+type bound_error_call =
+  { bd_lbl: label;                    (* Entry label *)
+    bd_frame_lbl: label }             (* Label of frame descriptor *)
+
+let bound_error_sites = ref ([] : bound_error_call list)
+
+let bound_error_label ?label dbg =
+  if !Clflags.debug || !bound_error_sites = [] then begin
+    let lbl_bound_error = new_label() in
+    let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
+    bound_error_sites :=
+      { bd_lbl = lbl_bound_error;
+        bd_frame_lbl = lbl_frame } :: !bound_error_sites;
+    lbl_bound_error
+  end else begin
+    let bd = List.hd !bound_error_sites in bd.bd_lbl
+  end
+
+let emit_call_bound_error bd =
+  `{emit_label bd.bd_lbl}:	bl	{emit_symbol "caml_ml_array_bound_error"}\n`;
+  `{emit_label bd.bd_frame_lbl}:\n`
+
+(* Names of various instructions *)
+
+let name_for_comparison = function
+  | Isigned Ceq -> "eq" | Isigned Cne -> "ne" | Isigned Cle -> "le"
+  | Isigned Cge -> "ge" | Isigned Clt -> "lt" | Isigned Cgt -> "gt"
+  | Iunsigned Ceq -> "eq" | Iunsigned Cne -> "ne" | Iunsigned Cle -> "ls"
+  | Iunsigned Cge -> "cs" | Iunsigned Clt -> "cc" | Iunsigned Cgt -> "hi"
+
+let name_for_int_operation = function
+  | Iadd -> "add"
+  | Isub -> "sub"
+  | Imul -> "mul"
+  | Idiv -> "sdiv"
+  | Iand -> "and"
+  | Ior  -> "orr"
+  | Ixor -> "eor"
+  | Ilsl -> "lsl"
+  | Ilsr -> "lsr"
+  | Iasr -> "asr"
+  | _ -> assert false
+
+(* Load an integer constant into a register *)
+
+let emit_intconst dst n =
+  let rec emit_pos first shift =
+    if shift < 0 then begin
+      if first then `	mov	{emit_reg dst}, xzr\n`
+    end else begin
+      let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in
+      if s = 0n then emit_pos first (shift - 16) else begin
+        if first then
+          `	movz	{emit_reg dst}, #{emit_nativeint s}, lsl #{emit_int shift}\n`
+        else
+           `	movk	{emit_reg dst}, #{emit_nativeint s}, lsl #{emit_int shift}\n`;
+        emit_pos false (shift - 16)
+      end
+    end
+  and emit_neg first shift =
+    if shift < 0 then begin
+      if first then `	movn	{emit_reg dst}, #0\n`
+    end else begin
+      let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in
+      if s = 0xFFFFn then emit_neg first (shift - 16) else begin
+        if first then
+          `	movn	{emit_reg dst}, #{emit_nativeint (Nativeint.logxor s 0xFFFFn)}, lsl #{emit_int shift}\n`
+        else
+           `	movk	{emit_reg dst}, #{emit_nativeint s}, lsl #{emit_int shift}\n`;
+        emit_neg false (shift - 16)
+      end
+    end
+  in
+    if n < 0n then emit_neg true 48 else emit_pos true 48
+
+let num_instructions_for_intconst n =
+  let num_instructions = ref 0 in
+  let rec count_pos first shift =
+    if shift < 0 then begin
+      if first then incr num_instructions
+    end else begin
+      let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in
+      if s = 0n then count_pos first (shift - 16) else begin
+        incr num_instructions;
+        count_pos false (shift - 16)
+      end
+    end
+  and count_neg first shift =
+    if shift < 0 then begin
+      if first then incr num_instructions
+    end else begin
+      let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in
+      if s = 0xFFFFn then count_neg first (shift - 16) else begin
+        incr num_instructions;
+        count_neg false (shift - 16)
+      end
+    end
+  in
+  if n < 0n then count_neg true 48 else count_pos true 48;
+  !num_instructions
+
+(* Recognize float constants appropriate for FMOV dst, #fpimm instruction:
+   "a normalized binary floating point encoding with 1 sign bit, 4
+    bits of fraction and a 3-bit exponent" *)
+
+let is_immediate_float bits =
+  let exp = (Int64.(to_int (shift_right_logical bits 52)) land 0x7FF) - 1023 in
+  let mant = Int64.logand bits 0xF_FFFF_FFFF_FFFFL in
+  exp >= -3 && exp <= 4 && Int64.logand mant 0xF_0000_0000_0000L = mant
+
+(* Adjust sp (up or down) by the given byte amount *)
+
+let emit_stack_adjustment n =
+  let instr = if n < 0 then "sub" else "add" in
+  let m = abs n in
+  assert (m < 0x1_000_000);
+  let ml = m land 0xFFF and mh = m land 0xFFF_000 in
+  if mh <> 0 then `	{emit_string instr}	sp, sp, #{emit_int mh}\n`;
+  if ml <> 0 then `	{emit_string instr}	sp, sp, #{emit_int ml}\n`;
+  if n <> 0 then cfi_adjust_cfa_offset (-n)
+
+(* Deallocate the stack frame and reload the return address
+   before a return or tail call *)
+
+let output_epilogue f =
+  let n = frame_size() in
+  if !contains_calls then
+    `	ldr	x30, [sp, #{emit_int (n-8)}]\n`;
+  if n > 0 then
+    emit_stack_adjustment n;
+  f();
+  (* reset CFA back because function body may continue *)
+  if n > 0 then cfi_adjust_cfa_offset n
+
+(* Name of current function *)
+let function_name = ref ""
+(* Entry point for tail recursive calls *)
+let tailrec_entry_point = ref 0
+(* Pending floating-point literals *)
+let float_literals = ref ([] : (int64 * label) list)
+
+(* Label a floating-point literal *)
+let float_literal f =
+  try
+    List.assoc f !float_literals
+  with Not_found ->
+    let lbl = new_label() in
+    float_literals := (f, lbl) :: !float_literals;
+    lbl
+
+(* Emit all pending literals *)
+let emit_literals() =
+  if !float_literals <> [] then begin
+    `	.align	3\n`;
+    List.iter
+      (fun (f, lbl) ->
+        `{emit_label lbl}:`; emit_float64_directive ".quad" f)
+      !float_literals;
+    float_literals := []
+  end
+
+(* Emit code to load the address of a symbol *)
+
+let emit_load_symbol_addr dst s =
+  if not !Clflags.dlcode then begin
+    `	adrp	{emit_reg dst}, {emit_symbol s}\n`;
+    `	add	{emit_reg dst}, {emit_reg dst}, #:lo12:{emit_symbol s}\n`
+  end else begin
+    `	adrp	{emit_reg dst}, :got:{emit_symbol s}\n`;
+    `	ldr	{emit_reg dst}, [{emit_reg dst}, #:got_lo12:{emit_symbol s}]\n`
+  end
+
+(* The following functions are used for calculating the sizes of the
+   call GC and bounds check points emitted out-of-line from the function
+   body.  See branch_relaxation.mli. *)
+
+let num_call_gc_and_check_bound_points instr =
+  let rec loop instr ((call_gc, check_bound) as totals) =
+    match instr.desc with
+    | Lend -> totals
+    | Lop (Ialloc _) when !fastcode_flag ->
+      loop instr.next (call_gc + 1, check_bound)
+    | Lop (Iintop Icheckbound _)
+    | Lop (Iintop_imm (Icheckbound _, _))
+    | Lop (Ispecific (Ishiftcheckbound _)) ->
+      let check_bound =
+        (* When not in debug mode, there is at most one check-bound point. *)
+        if not !Clflags.debug then 1
+        else check_bound + 1
+      in
+      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_intop_checkbound _)
+    | Lop (Ispecific (Ifar_intop_imm_checkbound _))
+    | Lop (Ispecific (Ifar_shiftcheckbound _)) -> assert false
+    | _ -> loop instr.next totals
+  in
+  loop instr (0, 0)
+
+let max_out_of_line_code_offset ~num_call_gc ~num_check_bound =
+  if num_call_gc < 1 && num_check_bound < 1 then 0
+  else begin
+    let size_of_call_gc = 2 in
+    let size_of_check_bound = 1 in
+    let size_of_last_thing =
+      (* Call-GC points come before check-bound points. *)
+      if num_check_bound >= 1 then size_of_check_bound else size_of_call_gc
+    in
+    let total_size =
+      size_of_call_gc*num_call_gc + size_of_check_bound*num_check_bound
+    in
+    let max_offset = total_size - size_of_last_thing in
+    assert (max_offset >= 0);
+    max_offset
+  end
+
+module BR = Branch_relaxation.Make (struct
+  (* CR-someday mshinwell: B and BL have +/- 128Mb ranges; for the moment we
+     assume we will never exceed this.  It would seem to be most likely to
+     occur for branches between functions; in this case, the linker should be
+     able to insert veneers anyway.  (See section 4.6.7 of the document
+     "ELF for the ARM 64-bit architecture (AArch64)".) *)
+
+  type distance = int
+
+  module Cond_branch = struct
+    type t = TB | CB | Bcc
+
+    let all = [TB; CB; Bcc]
+
+    (* AArch64 instructions are 32 bits wide, so [distance] in this module
+       means units of 32-bit words. *)
+    let max_displacement = function
+      | TB -> 32 * 1024 / 4  (* +/- 32Kb *)
+      | CB | Bcc -> 1 * 1024 * 1024 / 4  (* +/- 1Mb *)
+
+    let classify_instr = function
+      | Lop (Ialloc _)
+      | Lop (Iintop Icheckbound _)
+      | Lop (Iintop_imm (Icheckbound _, _))
+      | Lop (Ispecific (Ishiftcheckbound _)) -> Some Bcc
+      (* The various "far" variants in [specific_operation] don't need to
+         return [Some] here, since their code sequences never contain any
+         conditional branches that might need relaxing. *)
+      | Lcondbranch (Itruetest, _)
+      | Lcondbranch (Ifalsetest, _) -> Some CB
+      | Lcondbranch (Iinttest _, _)
+      | Lcondbranch (Iinttest_imm _, _)
+      | Lcondbranch (Ifloattest _, _) -> Some Bcc
+      | Lcondbranch (Ioddtest, _)
+      | Lcondbranch (Ieventest, _) -> Some TB
+      | Lcondbranch3 _ -> Some Bcc
+      | _ -> None
+  end
+
+  let offset_pc_at_branch = 0
+
+  let prologue_size () =
+    (if frame_size () > 0 then 2 else 0)
+      + (if !contains_calls then 1 else 0)
+
+  let epilogue_size () =
+    if !contains_calls then 3 else 2
+
+  let instr_size = function
+    | Lend -> 0
+    | Lprologue -> prologue_size ()
+    | Lop (Imove | Ispill | Ireload) -> 1
+    | Lop (Iconst_int n) ->
+      num_instructions_for_intconst n
+    | Lop (Iconst_float _) -> 2
+    | Lop (Iconst_symbol _) -> 2
+    | Lop (Icall_ind _) -> 1
+    | Lop (Icall_imm _) -> 1
+    | Lop (Itailcall_ind _) -> epilogue_size ()
+    | Lop (Itailcall_imm { func; _ }) ->
+      if func = !function_name then 1 else epilogue_size ()
+    | Lop (Iextcall { alloc = false; }) -> 1
+    | Lop (Iextcall { alloc = true; }) -> 3
+    | Lop (Istackoffset _) -> 2
+    | Lop (Iload (size, addr)) | Lop (Istore (size, addr, _)) ->
+      let based = match addr with Iindexed _ -> 0 | Ibased _ -> 1 in
+      based + begin match size with Single -> 2 | _ -> 1 end
+    | Lop (Ialloc {bytes = num_bytes}) when !fastcode_flag ->
+      if num_bytes <= 0xFFF then 4 else 5
+    | Lop (Ispecific (Ifar_alloc {bytes = num_bytes})) when !fastcode_flag ->
+      if num_bytes <= 0xFFF then 5 else 6
+    | Lop (Ialloc { bytes = num_bytes; _ })
+    | Lop (Ispecific (Ifar_alloc { bytes = num_bytes; _ })) ->
+      begin match num_bytes with
+      | 16 | 24 | 32 -> 1
+      | _ -> 1 + num_instructions_for_intconst (Nativeint.of_int num_bytes)
+      end
+    | Lop (Iintop (Icomp _)) -> 2
+    | Lop (Iintop_imm (Icomp _, _)) -> 2
+    | Lop (Iintop (Icheckbound _)) -> 2
+    | Lop (Ispecific (Ifar_intop_checkbound _)) -> 3
+    | Lop (Iintop_imm (Icheckbound _, _)) -> 2
+    | Lop (Ispecific (Ifar_intop_imm_checkbound _)) -> 3
+    | Lop (Ispecific (Ishiftcheckbound _)) -> 2
+    | Lop (Ispecific (Ifar_shiftcheckbound _)) -> 3
+    | Lop (Iintop Imod) -> 2
+    | Lop (Iintop Imulh) -> 1
+    | Lop (Iintop _) -> 1
+    | Lop (Iintop_imm _) -> 1
+    | Lop (Ifloatofint | Iintoffloat | Iabsf | Inegf | Ispecific Isqrtf) -> 1
+    | Lop (Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf) -> 1
+    | Lop (Ispecific (Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf)) -> 1
+    | Lop (Ispecific (Ishiftarith _)) -> 1
+    | Lop (Ispecific (Imuladd | Imulsub)) -> 1
+    | Lop (Ispecific (Ibswap 16)) -> 2
+    | Lop (Ispecific (Ibswap _)) -> 1
+    | Lop (Iname_for_debugger _) -> 0
+    | Lreloadretaddr -> 0
+    | Lreturn -> epilogue_size ()
+    | Llabel _ -> 0
+    | Lbranch _ -> 1
+    | Lcondbranch (tst, _) ->
+      begin match tst with
+      | Itruetest -> 1
+      | Ifalsetest -> 1
+      | Iinttest _ -> 2
+      | Iinttest_imm _ -> 2
+      | Ifloattest _ -> 2
+      | Ioddtest -> 1
+      | Ieventest -> 1
+      end
+    | Lcondbranch3 (lbl0, lbl1, lbl2) ->
+      1 + begin match lbl0 with None -> 0 | Some _ -> 1 end
+        + begin match lbl1 with None -> 0 | Some _ -> 1 end
+        + begin match lbl2 with None -> 0 | Some _ -> 1 end
+    | Lswitch jumptbl -> 3 + Array.length jumptbl
+    | Lentertrap -> 0
+    | Ladjust_trap_depth _ -> 0
+    | Lpushtrap _ -> 4
+    | Lpoptrap -> 1
+    | Lraise k ->
+      begin match k with
+      | Lambda.Raise_regular -> 2
+      | Lambda.Raise_reraise -> 1
+      | Lambda.Raise_notrace -> 4
+      end
+
+  let relax_allocation ~num_bytes ~label_after_call_gc ~dbginfo =
+    Lop (Ispecific (Ifar_alloc { bytes = num_bytes; label_after_call_gc; dbginfo }))
+
+  let relax_intop_checkbound ~label_after_error =
+    Lop (Ispecific (Ifar_intop_checkbound { label_after_error; }))
+
+  let relax_intop_imm_checkbound ~bound ~label_after_error =
+    Lop (Ispecific (Ifar_intop_imm_checkbound { bound; label_after_error; }))
+
+  let relax_specific_op = function
+    | Ishiftcheckbound { shift; label_after_error; } ->
+      Lop (Ispecific (Ifar_shiftcheckbound { shift; label_after_error; }))
+    | _ -> assert false
+end)
+
+(* Output the assembly code for allocation. *)
+
+let assembly_code_for_allocation ~label_after_call_gc i ~n ~far ~dbginfo =
+  let lbl_frame =
+    record_frame_label ?label:label_after_call_gc i.live (Dbg_alloc dbginfo)
+  in
+  if !fastcode_flag then begin
+    let lbl_after_alloc = new_label() in
+    let lbl_call_gc = new_label() in
+    (* n is at most Max_young_whsize * 8, i.e. currently 0x808,
+       so it is reasonable to assume n < 0x1_000.  This makes
+       the generated code simpler. *)
+    assert (16 <= n && n < 0x1_000 && n land 0x7 = 0);
+    `	sub	{emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int n}\n`;
+    `	cmp	{emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_limit}\n`;
+    if not far then begin
+      `	b.lo	{emit_label lbl_call_gc}\n`
+    end else begin
+      let lbl = new_label () in
+      `	b.cs	{emit_label lbl}\n`;
+      `	b	{emit_label lbl_call_gc}\n`;
+      `{emit_label lbl}:\n`
+    end;
+    `{emit_label lbl_after_alloc}:`;
+    `	add	{emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`;
+    call_gc_sites :=
+      { gc_lbl = lbl_call_gc;
+        gc_return_lbl = lbl_after_alloc;
+        gc_frame_lbl = lbl_frame } :: !call_gc_sites
+  end else begin
+    begin match n with
+    | 16 -> `	bl	{emit_symbol "caml_alloc1"}\n`
+    | 24 -> `	bl	{emit_symbol "caml_alloc2"}\n`
+    | 32 -> `	bl	{emit_symbol "caml_alloc3"}\n`
+    | _  -> emit_intconst reg_x15 (Nativeint.of_int n);
+            `	bl	{emit_symbol "caml_allocN"}\n`
+    end;
+    `{emit_label lbl_frame}:	add	{emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`
+  end
+
+(* Output .text section directive, or named .text.caml. 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`
+
+(* Output the assembly code for an instruction *)
+
+let emit_instr i =
+    emit_debug_info i.dbg;
+    match i.desc with
+    | Lend -> ()
+    | Lprologue ->
+      assert (!prologue_required);
+      let n = frame_size() in
+      if n > 0 then
+        emit_stack_adjustment (-n);
+      if !contains_calls then begin
+        cfi_offset ~reg:30 (* return address *) ~offset:(-8);
+        `	str	x30, [sp, #{emit_int (n-8)}]\n`
+      end
+    | Lop(Imove | Ispill | Ireload) ->
+        let src = i.arg.(0) and dst = i.res.(0) in
+        if src.loc <> dst.loc then begin
+          match (src, dst) with
+          | {loc = Reg _; typ = Float}, {loc = Reg _} ->
+              `	fmov	{emit_reg dst}, {emit_reg src}\n`
+          | {loc = Reg _}, {loc = Reg _} ->
+              `	mov	{emit_reg dst}, {emit_reg src}\n`
+          | {loc = Reg _}, {loc = Stack _} ->
+              `	str	{emit_reg src}, {emit_stack dst}\n`
+          | {loc = Stack _}, {loc = Reg _} ->
+              `	ldr	{emit_reg dst}, {emit_stack src}\n`
+          | _ ->
+              assert false
+        end
+    | Lop(Iconst_int n) ->
+        emit_intconst i.res.(0) n
+    | Lop(Iconst_float f) ->
+        if f = 0L then
+          `	fmov	{emit_reg i.res.(0)}, xzr\n`
+        else if is_immediate_float f then
+          `	fmov	{emit_reg i.res.(0)}, #{emit_printf "%.7f" (Int64.float_of_bits f)}\n`
+        else begin
+          let lbl = float_literal f in
+          `	adrp	{emit_reg reg_tmp1}, {emit_label lbl}\n`;
+          `	ldr	{emit_reg i.res.(0)}, [{emit_reg reg_tmp1}, #:lo12:{emit_label lbl}]\n`
+        end
+    | Lop(Iconst_symbol s) ->
+        emit_load_symbol_addr i.res.(0) s
+    | Lop(Icall_ind { label_after; }) ->
+        `	blr	{emit_reg i.arg.(0)}\n`;
+        `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
+    | Lop(Icall_imm { func; label_after; }) ->
+        `	bl	{emit_symbol func}\n`;
+        `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
+    | Lop(Itailcall_ind { label_after = _; }) ->
+        output_epilogue (fun () -> `	br	{emit_reg i.arg.(0)}\n`)
+    | Lop(Itailcall_imm { func; label_after = _; }) ->
+        if func = !function_name then
+          `	b	{emit_label !tailrec_entry_point}\n`
+        else
+          output_epilogue (fun () -> `	b	{emit_symbol func}\n`)
+    | Lop(Iextcall { func; alloc = false; label_after = _; }) ->
+        `	bl	{emit_symbol func}\n`
+    | Lop(Iextcall { func; alloc = true; label_after; }) ->
+        emit_load_symbol_addr reg_x15 func;
+        `	bl	{emit_symbol "caml_c_call"}\n`;
+        `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
+    | Lop(Istackoffset n) ->
+        assert (n mod 16 = 0);
+        emit_stack_adjustment (-n);
+        stack_offset := !stack_offset + n
+    | Lop(Iload(size, addr)) ->
+        let dst = i.res.(0) in
+        let base =
+          match addr with
+          | Iindexed _ -> i.arg.(0)
+          | Ibased(s, ofs) ->
+              assert (not !Clflags.dlcode);  (* see selection.ml *)
+              `	adrp	{emit_reg reg_tmp1}, {emit_symbol_offset s ofs}\n`;
+              reg_tmp1 in
+        begin match size with
+        | Byte_unsigned ->
+            `	ldrb	{emit_wreg dst}, {emit_addressing addr base}\n`
+        | Byte_signed ->
+            `	ldrsb	{emit_reg dst}, {emit_addressing addr base}\n`
+        | Sixteen_unsigned ->
+            `	ldrh	{emit_wreg dst}, {emit_addressing addr base}\n`
+        | Sixteen_signed ->
+            `	ldrsh	{emit_reg dst}, {emit_addressing addr base}\n`
+        | Thirtytwo_unsigned ->
+            `	ldr	{emit_wreg dst}, {emit_addressing addr base}\n`
+        | Thirtytwo_signed ->
+            `	ldrsw	{emit_reg dst}, {emit_addressing addr base}\n`
+        | Single ->
+            `	ldr	s7, {emit_addressing addr base}\n`;
+            `	fcvt	{emit_reg dst}, s7\n`
+        | Word_int | Word_val | Double | Double_u ->
+            `	ldr	{emit_reg dst}, {emit_addressing addr base}\n`
+        end
+    | Lop(Istore(size, addr, _)) ->
+        let src = i.arg.(0) in
+        let base =
+          match addr with
+          | Iindexed _ -> i.arg.(1)
+          | Ibased(s, ofs) ->
+              assert (not !Clflags.dlcode);
+              `	adrp	{emit_reg reg_tmp1}, {emit_symbol_offset s ofs}\n`;
+              reg_tmp1 in
+        begin match size with
+        | Byte_unsigned | Byte_signed ->
+            `	strb	{emit_wreg src}, {emit_addressing addr base}\n`
+        | Sixteen_unsigned | Sixteen_signed ->
+            `	strh	{emit_wreg src}, {emit_addressing addr base}\n`
+        | Thirtytwo_unsigned | Thirtytwo_signed ->
+            `	str	{emit_wreg src}, {emit_addressing addr base}\n`
+        | Single ->
+            `	fcvt	s7, {emit_reg src}\n`;
+            `	str	s7, {emit_addressing addr base}\n`;
+        | Word_int | Word_val | Double | Double_u ->
+            `	str	{emit_reg src}, {emit_addressing addr base}\n`
+        end
+    | Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
+        assembly_code_for_allocation i ~n ~far:false ~label_after_call_gc ~dbginfo
+    | Lop(Ispecific (Ifar_alloc { bytes = n; label_after_call_gc; dbginfo })) ->
+        assembly_code_for_allocation i ~n ~far:true ~label_after_call_gc ~dbginfo
+    | Lop(Iintop(Icomp cmp)) ->
+        `	cmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+        `	cset	{emit_reg i.res.(0)}, {emit_string (name_for_comparison cmp)}\n`
+    | Lop(Iintop_imm(Icomp cmp, n)) ->
+        `	cmp	{emit_reg i.arg.(0)}, #{emit_int n}\n`;
+        `	cset	{emit_reg i.res.(0)}, {emit_string (name_for_comparison cmp)}\n`
+    | Lop(Iintop (Icheckbound { label_after_error; })) ->
+        let lbl = bound_error_label i.dbg ?label:label_after_error in
+        `	cmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+        `	b.ls	{emit_label lbl}\n`
+    | Lop(Ispecific Ifar_intop_checkbound { label_after_error; }) ->
+        let lbl = bound_error_label i.dbg ?label:label_after_error in
+        let lbl2 = new_label () in
+        `	cmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+        `	b.hi	{emit_label lbl2}\n`;
+        `	b	{emit_label lbl}\n`;
+        `{emit_label lbl2}:\n`;
+    | Lop(Iintop_imm(Icheckbound { label_after_error; }, n)) ->
+        let lbl = bound_error_label i.dbg ?label:label_after_error in
+        `	cmp	{emit_reg i.arg.(0)}, #{emit_int n}\n`;
+        `	b.ls	{emit_label lbl}\n`
+    | Lop(Ispecific(
+          Ifar_intop_imm_checkbound { bound; label_after_error; })) ->
+        let lbl = bound_error_label i.dbg ?label:label_after_error in
+        let lbl2 = new_label () in
+        `	cmp	{emit_reg i.arg.(0)}, #{emit_int bound}\n`;
+        `	b.hi	{emit_label lbl2}\n`;
+        `	b	{emit_label lbl}\n`;
+        `{emit_label lbl2}:\n`;
+    | Lop(Ispecific(Ishiftcheckbound { shift; label_after_error; })) ->
+        let lbl = bound_error_label i.dbg ?label:label_after_error 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; label_after_error; })) ->
+        let lbl = bound_error_label i.dbg ?label:label_after_error in
+        let lbl2 = new_label () in
+        `	cmp	{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`;
+        `	b.lo	{emit_label lbl2}\n`;
+        `	b	{emit_label lbl}\n`;
+        `{emit_label lbl2}:\n`;
+    | Lop(Iintop Imod) ->
+        `	sdiv	{emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+        `	msub	{emit_reg i.res.(0)}, {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
+    | Lop(Iintop Imulh) ->
+        `	smulh	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
+    | Lop(Iintop op) ->
+        let instr = name_for_int_operation op in
+        `	{emit_string instr}     {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
+    | Lop(Iintop_imm(op, n)) ->
+        let instr = name_for_int_operation op in
+        `	{emit_string instr}     {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`
+    | Lop(Ifloatofint | Iintoffloat | Iabsf | Inegf | Ispecific Isqrtf as op) ->
+        let instr = (match op with
+                     | Ifloatofint      -> "scvtf"
+                     | Iintoffloat      -> "fcvtzs"
+                     | Iabsf            -> "fabs"
+                     | Inegf            -> "fneg"
+                     | Ispecific Isqrtf -> "fsqrt"
+                     | _                -> assert false) in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
+    | Lop(Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf as op) ->
+        let instr = (match op with
+                     | Iaddf              -> "fadd"
+                     | Isubf              -> "fsub"
+                     | Imulf              -> "fmul"
+                     | Idivf              -> "fdiv"
+                     | Ispecific Inegmulf -> "fnmul"
+                     | _                  -> assert false) in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
+    | Lop(Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf as op)) ->
+        let instr = (match op with
+                     | Imuladdf    -> "fmadd"
+                     | Inegmuladdf -> "fnmadd"
+                     | Imulsubf    -> "fmsub"
+                     | Inegmulsubf -> "fnmsub"
+                     | _ -> assert false) in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}, {emit_reg i.arg.(0)}\n`
+    | Lop(Ispecific(Ishiftarith(op, shift))) ->
+        let instr = (match op with
+                       Ishiftadd    -> "add"
+                     | Ishiftsub    -> "sub") in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}`;
+        if shift >= 0
+        then `, lsl #{emit_int shift}\n`
+        else `, asr #{emit_int (-shift)}\n`
+    | Lop(Ispecific(Imuladd | Imulsub as op)) ->
+        let instr = (match op with
+                       Imuladd -> "madd"
+                     | Imulsub -> "msub"
+                     | _ -> assert false) in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`
+    | Lop(Ispecific(Ibswap size)) ->
+        begin match size with
+        | 16 ->
+            `	rev16	{emit_wreg i.res.(0)}, {emit_wreg i.arg.(0)}\n`;
+            `	ubfm	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, #0, #15\n`
+        | 32 ->
+            `	rev	{emit_wreg i.res.(0)}, {emit_wreg i.arg.(0)}\n`
+        | 64 ->
+            `	rev	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
+        | _ ->
+            assert false
+        end
+    | Lop (Iname_for_debugger _) -> ()
+    | Lreloadretaddr ->
+        ()
+    | Lreturn ->
+        output_epilogue (fun () -> `	ret\n`)
+    | Llabel lbl ->
+        `{emit_label lbl}:\n`
+    | Lbranch lbl ->
+        `	b	{emit_label lbl}\n`
+    | Lcondbranch(tst, lbl) ->
+        begin match tst with
+        | Itruetest ->
+            `	cbnz	{emit_reg i.arg.(0)}, {emit_label lbl}\n`
+        | Ifalsetest ->
+            `	cbz	{emit_reg i.arg.(0)}, {emit_label lbl}\n`
+        | Iinttest cmp ->
+            `	cmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+            let comp = name_for_comparison cmp in
+            `	b.{emit_string comp}	{emit_label lbl}\n`
+        | Iinttest_imm(cmp, n) ->
+            `	cmp	{emit_reg i.arg.(0)}, #{emit_int n}\n`;
+            let comp = name_for_comparison cmp in
+            `	b.{emit_string comp}	{emit_label lbl}\n`
+        | Ifloattest cmp ->
+            let comp =
+              match cmp with
+              | CFeq -> "eq"
+              | CFneq -> "ne"
+              | CFlt -> "cc"
+              | CFnlt -> "cs"
+              | CFle -> "ls"
+              | CFnle -> "hi"
+              | CFgt -> "gt"
+              | CFngt -> "le"
+              | CFge -> "ge"
+              | CFnge -> "lt"
+            in
+            `	fcmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+            `	b.{emit_string comp}	{emit_label lbl}\n`
+        | Ioddtest ->
+            `	tbnz	{emit_reg i.arg.(0)}, #0, {emit_label lbl}\n`
+        | Ieventest ->
+            `	tbz	{emit_reg i.arg.(0)}, #0, {emit_label lbl}\n`
+        end
+    | Lcondbranch3(lbl0, lbl1, lbl2) ->
+        `	cmp	{emit_reg i.arg.(0)}, #1\n`;
+        begin match lbl0 with
+          None -> ()
+        | Some lbl -> `	b.lt	{emit_label lbl}\n`
+        end;
+        begin match lbl1 with
+          None -> ()
+        | Some lbl -> `	b.eq	{emit_label lbl}\n`
+        end;
+        begin match lbl2 with
+          None -> ()
+        | Some lbl -> `	b.gt	{emit_label lbl}\n`
+        end
+    | Lswitch jumptbl ->
+        let lbltbl = new_label() in
+        `	adr	{emit_reg reg_tmp1}, {emit_label lbltbl}\n`;
+        `	add	{emit_reg reg_tmp1}, {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, lsl #2\n`;
+        `	br	{emit_reg reg_tmp1}\n`;
+        `{emit_label lbltbl}:`;
+        for j = 0 to Array.length jumptbl - 1 do
+            `	b	{emit_label jumptbl.(j)}\n`
+        done
+(* Alternative:
+        let lbltbl = new_label() in
+        `	adr	{emit_reg reg_tmp1}, {emit_label lbltbl}\n`;
+        `	ldr	{emit_wreg reg_tmp2}, [{emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, lsl #2]\n`;
+        `	add	{emit_reg reg_tmp1}, {emit_wreg reg_tmp2}, sxtb\n`;
+        `	br	{emit_reg reg_tmp1}\n`;
+        `{emit_label lbltbl}:\n`;
+        for j = 0 to Array.length jumptbl - 1 do
+            `	.word	{emit_label jumptbl.(j)} - {emit_label lbltbl}\n`
+        done
+*)
+    | Lentertrap ->
+        ()
+    | Ladjust_trap_depth { delta_traps } ->
+        (* each trap occupies 16 bytes on the stack *)
+        let delta = 16 * delta_traps in
+        cfi_adjust_cfa_offset delta;
+        stack_offset := !stack_offset + delta
+    | Lpushtrap { lbl_handler; } ->
+        `	adr	{emit_reg reg_tmp1}, {emit_label lbl_handler}\n`;
+        stack_offset := !stack_offset + 16;
+        `	str	{emit_reg reg_trap_ptr}, [sp, -16]!\n`;
+        `	str	{emit_reg reg_tmp1}, [sp, #8]\n`;
+        cfi_adjust_cfa_offset 16;
+        `	mov	{emit_reg reg_trap_ptr}, sp\n`
+    | Lpoptrap ->
+        `	ldr	{emit_reg reg_trap_ptr}, [sp], 16\n`;
+        cfi_adjust_cfa_offset (-16);
+        stack_offset := !stack_offset - 16
+    | Lraise k ->
+        begin match k with
+        | Lambda.Raise_regular ->
+          let offset = Domainstate.(idx_of_field Domain_backtrace_pos) * 8 in
+          `	str	xzr, [{emit_reg reg_domain_state_ptr}, {emit_int offset}]\n`;
+          `	bl	{emit_symbol "caml_raise_exn"}\n`;
+          `{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`
+        | Lambda.Raise_reraise ->
+          `	bl	{emit_symbol "caml_raise_exn"}\n`;
+          `{record_frame 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`;
+          `	br	{emit_reg reg_tmp1}\n`
+        end
+
+(* Emission of an instruction sequence *)
+
+let rec emit_all i =
+  if i.desc = Lend then () else (emit_instr i; emit_all i.next)
+
+(* Emission of a function declaration *)
+
+let fundecl fundecl =
+  function_name := fundecl.fun_name;
+  fastcode_flag := fundecl.fun_fast;
+  tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
+  float_literals := [];
+  stack_offset := 0;
+  call_gc_sites := [];
+  bound_error_sites := [];
+    for i = 0 to Proc.num_register_classes - 1 do
+    num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
+  done;
+  prologue_required := fundecl.fun_prologue_required;
+  contains_calls := fundecl.fun_contains_calls;
+  emit_named_text_section !function_name;
+  `	.align	3\n`;
+  `	.globl	{emit_symbol fundecl.fun_name}\n`;
+  `	.type	{emit_symbol fundecl.fun_name}, %function\n`;
+  `{emit_symbol fundecl.fun_name}:\n`;
+  emit_debug_info fundecl.fun_dbg;
+  cfi_startproc();
+  let num_call_gc, num_check_bound =
+    num_call_gc_and_check_bound_points fundecl.fun_body
+  in
+  let max_out_of_line_code_offset =
+    max_out_of_line_code_offset ~num_call_gc
+      ~num_check_bound
+  in
+  BR.relax fundecl.fun_body ~max_out_of_line_code_offset;
+  emit_all fundecl.fun_body;
+  List.iter emit_call_gc !call_gc_sites;
+  List.iter emit_call_bound_error !bound_error_sites;
+  assert (List.length !call_gc_sites = num_call_gc);
+  assert (List.length !bound_error_sites = num_check_bound);
+  cfi_endproc();
+  `	.type	{emit_symbol fundecl.fun_name}, %function\n`;
+  `	.size	{emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`;
+  emit_literals()
+
+(* Emission of data *)
+
+let emit_item = function
+  | Cglobal_symbol s -> `	.globl	{emit_symbol s}\n`;
+  | Cdefine_symbol s ->
+    if !Clflags.dlcode then begin
+      (* GOT relocations against non-global symbols don't seem to work
+         properly: GOT entries are not created for the symbols and the
+         relocations evaluate to random other GOT entries.  For the moment
+         force all symbols to be global. *)
+      `	.globl	{emit_symbol s}\n`;
+    end;
+    `{emit_symbol s}:\n`
+  | Cint8 n -> `	.byte	{emit_int n}\n`
+  | Cint16 n -> `	.short	{emit_int n}\n`
+  | Cint32 n -> `	.long	{emit_nativeint n}\n`
+  | Cint n -> `	.quad	{emit_nativeint n}\n`
+  | Csingle f -> emit_float32_directive ".long" (Int32.bits_of_float f)
+  | Cdouble f -> emit_float64_directive ".quad" (Int64.bits_of_float f)
+  | Csymbol_address s -> `	.quad	{emit_symbol s}\n`
+  | Cstring s -> emit_string_directive "	.ascii  " s
+  | Cskip n -> if n > 0 then `	.space	{emit_int n}\n`
+  | Calign n -> `	.align	{emit_int(Misc.log2 n)}\n`
+
+let data l =
+  `	.data\n`;
+  `	.align 3\n`;
+  List.iter emit_item l
+
+(* Beginning / end of an assembly file *)
+
+let begin_assembly() =
+  reset_debug_info();
+  `	.file	\"\"\n`;  (* PR#7037 *)
+  let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
+  `	.data\n`;
+  `	.globl	{emit_symbol lbl_begin}\n`;
+  `{emit_symbol lbl_begin}:\n`;
+  let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
+  emit_named_text_section lbl_begin;
+  `	.globl	{emit_symbol lbl_begin}\n`;
+  `{emit_symbol lbl_begin}:\n`
+
+let end_assembly () =
+  let lbl_end = Compilenv.make_symbol (Some "code_end") in
+  emit_named_text_section lbl_end;
+  `	.globl	{emit_symbol lbl_end}\n`;
+  `{emit_symbol lbl_end}:\n`;
+  let lbl_end = Compilenv.make_symbol (Some "data_end") in
+  `	.data\n`;
+  `	.quad	0\n`;  (* PR#6329 *)
+  `	.globl	{emit_symbol lbl_end}\n`;
+  `{emit_symbol lbl_end}:\n`;
+  `	.quad	0\n`;
+  `	.align	3\n`;  (* #7887 *)
+  let lbl = Compilenv.make_symbol (Some "frametable") in
+  `	.globl	{emit_symbol lbl}\n`;
+  `{emit_symbol lbl}:\n`;
+  emit_frames
+    { efa_code_label = (fun lbl ->
+                       `	.type	{emit_label lbl}, %function\n`;
+                       `	.quad	{emit_label lbl}\n`);
+      efa_data_label = (fun lbl ->
+                       `	.type	{emit_label lbl}, %object\n`;
+                       `	.quad	{emit_label lbl}\n`);
+      efa_8 = (fun n -> `	.byte	{emit_int n}\n`);
+      efa_16 = (fun n -> `	.short	{emit_int n}\n`);
+      efa_32 = (fun n -> `	.long	{emit_int32 n}\n`);
+      efa_word = (fun n -> `	.quad	{emit_int n}\n`);
+      efa_align = (fun n -> `	.align	{emit_int(Misc.log2 n)}\n`);
+      efa_label_rel = (fun lbl ofs ->
+                           `	.long	{emit_label lbl} - . + {emit_int32 ofs}\n`);
+      efa_def_label = (fun lbl -> `{emit_label lbl}:\n`);
+      efa_string = (fun s -> emit_string_directive "	.asciz	" s) };
+  `	.type	{emit_symbol lbl}, %object\n`;
+  `	.size	{emit_symbol lbl}, .-{emit_symbol lbl}\n`;
+  begin match Config.system with
+  | "linux" ->
+      (* Mark stack as non-executable *)
+      `	.section	.note.GNU-stack,\"\",%progbits\n`
+  | _ -> ()
+  end
diff --git a/asmcomp/arm64/proc.ml b/asmcomp/arm64/proc.ml
new file mode 100644
index 00000000..ff0b785d
--- /dev/null
+++ b/asmcomp/arm64/proc.ml
@@ -0,0 +1,270 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                 Benedikt Meurer, University of Siegen                  *)
+(*                                                                        *)
+(*   Copyright 2013 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2012 Benedikt Meurer.                                      *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Description of the ARM processor in 64-bit mode *)
+
+open Misc
+open Cmm
+open Reg
+open Arch
+open Mach
+
+(* Instruction selection *)
+
+let word_addressed = false
+
+(* Registers available for register allocation *)
+
+(* Integer register map:
+    x0 - x15              general purpose (caller-save)
+    x16, x17              temporaries (used by call veeners)
+    x18                   platform register (reserved)
+    x19 - x24             general purpose (callee-save)
+    x25                   domain state pointer
+    x26                   trap pointer
+    x27                   alloc pointer
+    x28                   alloc limit
+    x29                   frame pointer
+    x30                   return address
+    sp / xzr              stack pointer / zero register
+   Floating-point register map:
+    d0 - d7               general purpose (caller-save)
+    d8 - d15              general purpose (callee-save)
+    d16 - d31             general purpose (caller-save)
+*)
+
+let int_reg_name =
+  [| "x0";  "x1";  "x2";  "x3";  "x4";  "x5";  "x6";  "x7";
+     "x8";  "x9";  "x10"; "x11"; "x12"; "x13"; "x14"; "x15";
+     "x19"; "x20"; "x21"; "x22"; "x23"; "x24";
+     "x25"; "x26"; "x27"; "x28"; "x16"; "x17" |]
+
+let float_reg_name =
+  [| "d0";  "d1";  "d2";  "d3";  "d4";  "d5";  "d6";  "d7";
+     "d8";  "d9";  "d10"; "d11"; "d12"; "d13"; "d14"; "d15";
+     "d16"; "d17"; "d18"; "d19"; "d20"; "d21"; "d22"; "d23";
+     "d24"; "d25"; "d26"; "d27"; "d28"; "d29"; "d30"; "d31" |]
+
+let num_register_classes = 2
+
+let register_class r =
+  match r.typ with
+  | Val | Int | Addr  -> 0
+  | Float -> 1
+
+let num_available_registers =
+  [| 22; 32 |] (* first 22 int regs allocatable; all float regs allocatable *)
+
+let first_available_register =
+  [| 0; 100 |]
+
+let register_name r =
+  if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100)
+
+let rotate_registers = true
+
+(* Representation of hard registers by pseudo-registers *)
+
+let hard_int_reg =
+  let v = Array.make 28 Reg.dummy in
+  for i = 0 to 27 do
+    v.(i) <- Reg.at_location Int (Reg i)
+  done;
+  v
+
+let hard_float_reg =
+  let v = Array.make 32 Reg.dummy in
+  for i = 0 to 31 do
+    v.(i) <- Reg.at_location Float (Reg(100 + i))
+  done;
+  v
+
+let all_phys_regs =
+  Array.append hard_int_reg hard_float_reg
+
+let phys_reg n =
+  if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
+
+let reg_x15 = phys_reg 15
+let reg_d7 = phys_reg 107
+
+let stack_slot slot ty =
+  Reg.at_location ty (Stack slot)
+
+let loc_spacetime_node_hole = Reg.dummy  (* Spacetime unsupported *)
+
+(* Calling conventions *)
+
+let calling_conventions
+    first_int last_int first_float last_float make_stack arg =
+  let loc = Array.make (Array.length arg) Reg.dummy in
+  let int = ref first_int in
+  let float = ref first_float in
+  let ofs = ref 0 in
+  for i = 0 to Array.length arg - 1 do
+    match arg.(i).typ with
+    | Val | Int | Addr as ty ->
+        if !int <= last_int then begin
+          loc.(i) <- phys_reg !int;
+          incr int
+        end else begin
+          loc.(i) <- stack_slot (make_stack !ofs) ty;
+          ofs := !ofs + size_int
+        end
+    | Float ->
+        if !float <= last_float then begin
+          loc.(i) <- phys_reg !float;
+          incr float
+        end else begin
+          loc.(i) <- stack_slot (make_stack !ofs) Float;
+          ofs := !ofs + size_float
+        end
+  done;
+  (loc, Misc.align !ofs 16)  (* keep stack 16-aligned *)
+
+let incoming ofs = Incoming ofs
+let outgoing ofs = Outgoing ofs
+let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
+
+(* OCaml calling convention:
+     first integer args in r0...r15
+     first float args in d0...d15
+     remaining args on stack.
+   Return values in r0...r15 or d0...d15. *)
+
+let max_arguments_for_tailcalls = 16
+
+let loc_arguments arg =
+  calling_conventions 0 15 100 115 outgoing arg
+let loc_parameters arg =
+  let (loc, _) = calling_conventions 0 15 100 115 incoming arg in loc
+let loc_results res =
+  let (loc, _) = calling_conventions 0 15 100 115 not_supported res in loc
+
+(* C calling convention:
+     first integer args in r0...r7
+     first float args in d0...d7
+     remaining args on stack.
+   Return values in r0...r1 or d0. *)
+
+let loc_external_arguments arg =
+  let arg =
+    Array.map (fun regs -> assert (Array.length regs = 1); regs.(0)) arg
+  in
+  let loc, alignment = calling_conventions 0 7 100 107 outgoing arg in
+  Array.map (fun reg -> [|reg|]) loc, alignment
+let loc_external_results res =
+  let (loc, _) = calling_conventions 0 1 100 100 not_supported res in loc
+
+let loc_exn_bucket = phys_reg 0
+
+(* See "DWARF for the ARM 64-bit architecture (AArch64)" available from
+   developer.arm.com. *)
+
+let int_dwarf_reg_numbers =
+  [| 0; 1; 2; 3; 4; 5; 6; 7;
+     8; 9; 10; 11; 12; 13; 14; 15;
+     19; 20; 21; 22; 23; 24;
+     25; 26; 27; 28; 16; 17;
+  |]
+
+let float_dwarf_reg_numbers =
+  [| 64; 65; 66; 67; 68; 69; 70; 71;
+     72; 73; 74; 75; 76; 77; 78; 79;
+     80; 81; 82; 83; 84; 85; 86; 87;
+     88; 89; 90; 91; 92; 93; 94; 95;
+  |]
+
+let dwarf_register_numbers ~reg_class =
+  match reg_class with
+  | 0 -> int_dwarf_reg_numbers
+  | 1 -> float_dwarf_reg_numbers
+  | _ -> Misc.fatal_errorf "Bad register class %d" reg_class
+
+let stack_ptr_dwarf_register_number = 31
+
+(* Volatile registers: none *)
+
+let regs_are_volatile _rs = false
+
+(* Registers destroyed by operations *)
+
+let destroyed_at_c_call =
+  (* x19-x28, d8-d15 preserved *)
+  Array.of_list (List.map phys_reg
+    [0;1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;
+     100;101;102;103;104;105;106;107;
+     116;117;118;119;120;121;122;123;
+     124;125;126;127;128;129;130;131])
+
+let destroyed_at_oper = function
+  | Iop(Icall_ind _ | Icall_imm _) | Iop(Iextcall { alloc = true; }) ->
+      all_phys_regs
+  | Iop(Iextcall { alloc = false; }) ->
+      destroyed_at_c_call
+  | Iop(Ialloc _) ->
+      [| reg_x15 |]
+  | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _, _)) ->
+      [| reg_d7 |]            (* d7 / s7 destroyed *)
+  | _ -> [||]
+
+let destroyed_at_raise = all_phys_regs
+
+let destroyed_at_reloadretaddr = [| |]
+
+(* Maximal register pressure *)
+
+let safe_register_pressure = function
+  | Iextcall _ -> 8
+  | Ialloc _ -> 24
+  | _ -> 25
+
+let max_register_pressure = function
+  | Iextcall _ -> [| 10; 8 |]
+  | Ialloc _ -> [| 24; 32 |]
+  | Iintoffloat | Ifloatofint
+  | Iload(Single, _) | Istore(Single, _, _) -> [| 25; 31 |]
+  | _ -> [| 25; 32 |]
+
+(* Pure operations (without any side effect besides updating their result
+   registers). *)
+
+let op_is_pure = function
+  | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
+  | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _)
+  | Ispecific(Ishiftcheckbound _) -> false
+  | _ -> true
+
+(* Layout of the stack *)
+let frame_required fd =
+  fd.fun_contains_calls
+    || fd.fun_num_stack_slots.(0) > 0
+    || fd.fun_num_stack_slots.(1) > 0
+
+let prologue_required fd =
+  frame_required fd
+
+(* Calling the assembler *)
+
+let assemble_file infile outfile =
+  Ccomp.command (Config.asm ^ " " ^
+                 (String.concat " " (Misc.debug_prefix_map_flags ())) ^
+                 " -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile)
+
+
+let init () = ()
diff --git a/asmcomp/arm64/reload.ml b/asmcomp/arm64/reload.ml
new file mode 100644
index 00000000..0c342b64
--- /dev/null
+++ b/asmcomp/arm64/reload.ml
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2013 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Reloading for the ARM 64 bits *)
+
+let fundecl f num_stack_slots =
+  (new Reloadgen.reload_generic)#fundecl f num_stack_slots
diff --git a/asmcomp/arm64/scheduling.ml b/asmcomp/arm64/scheduling.ml
new file mode 100644
index 00000000..86a3c616
--- /dev/null
+++ b/asmcomp/arm64/scheduling.ml
@@ -0,0 +1,21 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2013 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open! Schedgen (* to create a dependency *)
+
+(* Scheduling is turned off because the processor schedules dynamically
+   much better than what we could do. *)
+
+let fundecl f = f
diff --git a/asmcomp/arm64/selection.ml b/asmcomp/arm64/selection.ml
new file mode 100644
index 00000000..90166141
--- /dev/null
+++ b/asmcomp/arm64/selection.ml
@@ -0,0 +1,255 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                 Benedikt Meurer, University of Siegen                  *)
+(*                                                                        *)
+(*   Copyright 2013 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2012 Benedikt Meurer.                                      *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Instruction selection for the ARM processor *)
+
+open Arch
+open Cmm
+open Mach
+
+let is_offset chunk n =
+   (n >= -256 && n <= 255)               (* 9 bits signed unscaled *)
+|| (n >= 0 &&
+    match chunk with     (* 12 bits unsigned, scaled by chunk size *)
+    | Byte_unsigned | Byte_signed ->
+        n < 0x1000
+    | Sixteen_unsigned | Sixteen_signed ->
+        n land 1 = 0 && n lsr 1 < 0x1000
+    | Thirtytwo_unsigned | Thirtytwo_signed | Single ->
+        n land 3 = 0 && n lsr 2 < 0x1000
+    | Word_int | Word_val | Double | Double_u ->
+        n land 7 = 0 && n lsr 3 < 0x1000)
+
+(* An automaton to recognize ( 0+1+0* | 1+0+1* )
+
+               0          1          0
+              / \        / \        / \
+              \ /        \ /        \ /
+        -0--> [1] --1--> [2] --0--> [3]
+       /
+     [0]
+       \
+        -1--> [4] --0--> [5] --1--> [6]
+              / \        / \        / \
+              \ /        \ /        \ /
+               1          0          1
+
+The accepting states are 2, 3, 5 and 6. *)
+
+let auto_table = [|   (* accepting?, next on 0, next on 1 *)
+  (* state 0 *) (false, 1, 4);
+  (* state 1 *) (false, 1, 2);
+  (* state 2 *) (true,  3, 2);
+  (* state 3 *) (true,  3, 7);
+  (* state 4 *) (false, 5, 4);
+  (* state 5 *) (true,  5, 6);
+  (* state 6 *) (true,  7, 6);
+  (* state 7 *) (false, 7, 7)   (* error state *)
+|]
+
+let rec run_automata nbits state input =
+  let (acc, next0, next1) = auto_table.(state) in
+  if nbits <= 0
+  then acc
+  else run_automata (nbits - 1)
+                    (if input land 1 = 0 then next0 else next1)
+                    (input asr 1)
+
+(* We are very conservative wrt what ARM64 supports: we don't support
+   repetitions of a 000111000 or 1110000111 pattern, just a single
+   pattern of this kind. *)
+
+let is_logical_immediate n =
+  n <> 0 && n <> -1 && run_automata 64 0 n
+
+(* If you update [inline_ops], you may need to update [is_simple_expr] and/or
+   [effects_of], below. *)
+let inline_ops =
+  [ "sqrt"; "caml_bswap16_direct"; "caml_int32_direct_bswap";
+    "caml_int64_direct_bswap"; "caml_nativeint_direct_bswap" ]
+
+let use_direct_addressing _symb =
+  not !Clflags.dlcode
+
+(* Instruction selection *)
+
+class selector = object(self)
+
+inherit Selectgen.selector_generic as super
+
+method is_immediate n =
+  let mn = -n in
+  n land 0xFFF = n || n land 0xFFF_000 = n
+  || mn land 0xFFF = mn || mn land 0xFFF_000 = mn
+
+method! is_simple_expr = function
+  (* inlined floating-point ops are simple if their arguments are *)
+  | Cop(Cextcall (fn, _, _, _), args, _) when List.mem fn inline_ops ->
+      List.for_all self#is_simple_expr args
+  | e -> super#is_simple_expr e
+
+method! effects_of e =
+  match e with
+  | Cop(Cextcall (fn, _, _, _), args, _) when List.mem fn inline_ops ->
+      Selectgen.Effect_and_coeffect.join_list_map args self#effects_of
+  | e -> super#effects_of e
+
+method select_addressing chunk = function
+  | Cop((Caddv | Cadda), [Cconst_symbol (s, _); Cconst_int (n, _)], _)
+    when use_direct_addressing s ->
+      (Ibased(s, n), Ctuple [])
+  | Cop((Caddv | Cadda), [arg; Cconst_int (n, _)], _)
+    when is_offset chunk n ->
+      (Iindexed n, arg)
+  | Cop((Caddv | Cadda as op),
+      [arg1; Cop(Caddi, [arg2; Cconst_int (n, _)], _)], dbg)
+    when is_offset chunk n ->
+      (Iindexed n, Cop(op, [arg1; arg2], dbg))
+  | Cconst_symbol (s, _)
+    when use_direct_addressing s ->
+      (Ibased(s, 0), Ctuple [])
+  | arg ->
+      (Iindexed 0, arg)
+
+method! select_operation op args dbg =
+  match op with
+  (* Integer addition *)
+  | Caddi | Caddv | Cadda ->
+      begin match args with
+      (* Add immediate *)
+      | [arg; Cconst_int (n, _)] when self#is_immediate n ->
+          ((if n >= 0 then Iintop_imm(Iadd, n) else Iintop_imm(Isub, -n)),
+           [arg])
+      | [Cconst_int (n, _); arg] when self#is_immediate n ->
+          ((if n >= 0 then Iintop_imm(Iadd, n) else Iintop_imm(Isub, -n)),
+           [arg])
+      (* Shift-add *)
+      | [arg1; Cop(Clsl, [arg2; Cconst_int (n, _)], _)] when n > 0 && n < 64 ->
+          (Ispecific(Ishiftarith(Ishiftadd, n)), [arg1; arg2])
+      | [arg1; Cop(Casr, [arg2; Cconst_int (n, _)], _)] when n > 0 && n < 64 ->
+          (Ispecific(Ishiftarith(Ishiftadd, -n)), [arg1; arg2])
+      | [Cop(Clsl, [arg1; Cconst_int (n, _)], _); arg2] when n > 0 && n < 64 ->
+          (Ispecific(Ishiftarith(Ishiftadd, n)), [arg2; arg1])
+      | [Cop(Casr, [arg1; Cconst_int (n, _)], _); arg2] when n > 0 && n < 64 ->
+          (Ispecific(Ishiftarith(Ishiftadd, -n)), [arg2; arg1])
+      (* Multiply-add *)
+      | [arg1; Cop(Cmuli, args2, dbg)] | [Cop(Cmuli, args2, dbg); arg1] ->
+          begin match self#select_operation Cmuli args2 dbg with
+          | (Iintop_imm(Ilsl, l), [arg3]) ->
+              (Ispecific(Ishiftarith(Ishiftadd, l)), [arg1; arg3])
+          | (Iintop Imul, [arg3; arg4]) ->
+              (Ispecific Imuladd, [arg3; arg4; arg1])
+          | _ ->
+              super#select_operation op args dbg
+          end
+      | _ ->
+          super#select_operation op args dbg
+      end
+  (* Integer subtraction *)
+  | Csubi ->
+      begin match args with
+      (* Sub immediate *)
+      | [arg; Cconst_int (n, _)] when self#is_immediate n ->
+          ((if n >= 0 then Iintop_imm(Isub, n) else Iintop_imm(Iadd, -n)),
+           [arg])
+      (* Shift-sub *)
+      | [arg1; Cop(Clsl, [arg2; Cconst_int (n, _)], _)] when n > 0 && n < 64 ->
+          (Ispecific(Ishiftarith(Ishiftsub, n)), [arg1; arg2])
+      | [arg1; Cop(Casr, [arg2; Cconst_int (n, _)], _)] when n > 0 && n < 64 ->
+          (Ispecific(Ishiftarith(Ishiftsub, -n)), [arg1; arg2])
+      (* Multiply-sub *)
+      | [arg1; Cop(Cmuli, args2, dbg)] ->
+          begin match self#select_operation Cmuli args2 dbg with
+          | (Iintop_imm(Ilsl, l), [arg3]) ->
+              (Ispecific(Ishiftarith(Ishiftsub, l)), [arg1; arg3])
+          | (Iintop Imul, [arg3; arg4]) ->
+              (Ispecific Imulsub, [arg3; arg4; arg1])
+          | _ ->
+              super#select_operation op args dbg
+          end
+      | _ ->
+          super#select_operation op args dbg
+      end
+  (* Checkbounds *)
+  | Ccheckbound ->
+      begin match args with
+      | [Cop(Clsr, [arg1; Cconst_int (n, _)], _); arg2] when n > 0 && n < 64 ->
+          (Ispecific(Ishiftcheckbound { shift = n; label_after_error = None; }),
+            [arg1; arg2])
+      | _ ->
+          super#select_operation op args dbg
+      end
+  (* Integer multiplication *)
+  (* ARM does not support immediate operands for multiplication *)
+  | Cmuli ->
+      (Iintop Imul, args)
+  | Cmulhi ->
+      (Iintop Imulh, args)
+  (* Bitwise logical operations have a different range of immediate
+     operands than the other instructions *)
+  | Cand -> self#select_logical Iand args
+  | Cor -> self#select_logical Ior args
+  | Cxor -> self#select_logical Ixor args
+  (* Recognize floating-point negate and multiply *)
+  | Cnegf ->
+      begin match args with
+      | [Cop(Cmulf, args, _)] -> (Ispecific Inegmulf, args)
+      | _ -> super#select_operation op args dbg
+      end
+  (* Recognize floating-point multiply and add/sub *)
+  | Caddf ->
+      begin match args with
+      | [arg; Cop(Cmulf, args, _)] | [Cop(Cmulf, args, _); arg] ->
+          (Ispecific Imuladdf, arg :: args)
+      | _ ->
+          super#select_operation op args dbg
+      end
+  | Csubf ->
+      begin match args with
+      | [arg; Cop(Cmulf, args, _)] ->
+          (Ispecific Imulsubf, arg :: args)
+      | [Cop(Cmulf, args, _); arg] ->
+          (Ispecific Inegmulsubf, arg :: args)
+      | _ ->
+          super#select_operation op args dbg
+      end
+  (* Recognize floating-point square root *)
+  | Cextcall("sqrt", _, _, _) ->
+      (Ispecific Isqrtf, args)
+  (* Recognize bswap instructions *)
+  | Cextcall("caml_bswap16_direct", _, _, _) ->
+      (Ispecific(Ibswap 16), args)
+  | Cextcall("caml_int32_direct_bswap", _, _, _) ->
+      (Ispecific(Ibswap 32), args)
+  | Cextcall(("caml_int64_direct_bswap"|"caml_nativeint_direct_bswap"),
+              _, _, _) ->
+      (Ispecific (Ibswap 64), args)
+  (* Other operations are regular *)
+  | _ ->
+      super#select_operation op args dbg
+
+method select_logical op = function
+  | [arg; Cconst_int (n, _)] when is_logical_immediate n ->
+      (Iintop_imm(op, n), [arg])
+  | [Cconst_int (n, _); arg] when is_logical_immediate n ->
+      (Iintop_imm(op, n), [arg])
+  | args ->
+      (Iintop op, args)
+
+end
+
+let fundecl f = (new selector)#emit_fundecl f
diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml
new file mode 100644
index 00000000..a6468b6c
--- /dev/null
+++ b/asmcomp/asmgen.ml
@@ -0,0 +1,206 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* From lambda to assembly code *)
+
+[@@@ocaml.warning "+a-4-9-40-41-42"]
+
+open Format
+open Config
+open Clflags
+open Misc
+open Cmm
+
+type error = Assembler_error of string
+
+exception Error of error
+
+let liveness phrase = Liveness.fundecl phrase; phrase
+
+let dump_if ppf flag message phrase =
+  if !flag then Printmach.phase message ppf phrase
+
+let pass_dump_if ppf flag message phrase =
+  dump_if ppf flag message phrase; phrase
+
+let pass_dump_linear_if ppf flag message phrase =
+  if !flag then fprintf ppf "*** %s@.%a@." message Printlinear.fundecl phrase;
+  phrase
+
+let should_emit () =
+  not (should_stop_after Compiler_pass.Scheduling)
+
+let if_emit_do f x = if should_emit () then f x else ()
+let emit_begin_assembly = if_emit_do Emit.begin_assembly
+let emit_end_assembly = if_emit_do Emit.end_assembly
+let emit_data = if_emit_do Emit.data
+let emit_fundecl =
+  if_emit_do
+    (Profile.record ~accumulate:true "emit" Emit.fundecl)
+
+let rec regalloc ~ppf_dump round fd =
+  if round > 50 then
+    fatal_error(fd.Mach.fun_name ^
+                ": function too complex, cannot complete register allocation");
+  dump_if ppf_dump dump_live "Liveness analysis" fd;
+  let num_stack_slots =
+    if !use_linscan then begin
+      (* Linear Scan *)
+      Interval.build_intervals fd;
+      if !dump_interval then Printmach.intervals ppf_dump ();
+      Linscan.allocate_registers()
+    end else begin
+      (* Graph Coloring *)
+      Interf.build_graph fd;
+      if !dump_interf then Printmach.interferences ppf_dump ();
+      if !dump_prefer then Printmach.preferences ppf_dump ();
+      Coloring.allocate_registers()
+    end
+  in
+  dump_if ppf_dump dump_regalloc "After register allocation" fd;
+  let (newfd, redo_regalloc) = Reload.fundecl fd num_stack_slots in
+  dump_if ppf_dump dump_reload "After insertion of reloading code" newfd;
+  if redo_regalloc then begin
+    Reg.reinit(); Liveness.fundecl newfd; regalloc ~ppf_dump (round + 1) newfd
+  end else newfd
+
+let (++) x f = f x
+
+let compile_fundecl ~ppf_dump fd_cmm =
+  Proc.init ();
+  Reg.reset();
+  fd_cmm
+  ++ Profile.record ~accumulate:true "selection" Selection.fundecl
+  ++ pass_dump_if ppf_dump dump_selection "After instruction selection"
+  ++ Profile.record ~accumulate:true "comballoc" Comballoc.fundecl
+  ++ pass_dump_if ppf_dump dump_combine "After allocation combining"
+  ++ Profile.record ~accumulate:true "cse" CSE.fundecl
+  ++ pass_dump_if ppf_dump dump_cse "After CSE"
+  ++ Profile.record ~accumulate:true "liveness" liveness
+  ++ Profile.record ~accumulate:true "deadcode" Deadcode.fundecl
+  ++ pass_dump_if ppf_dump dump_live "Liveness analysis"
+  ++ Profile.record ~accumulate:true "spill" Spill.fundecl
+  ++ Profile.record ~accumulate:true "liveness" liveness
+  ++ pass_dump_if ppf_dump dump_spill "After spilling"
+  ++ Profile.record ~accumulate:true "split" Split.fundecl
+  ++ pass_dump_if ppf_dump dump_split "After live range splitting"
+  ++ Profile.record ~accumulate:true "liveness" liveness
+  ++ Profile.record ~accumulate:true "regalloc" (regalloc ~ppf_dump 1)
+  ++ Profile.record ~accumulate:true "available_regs" Available_regs.fundecl
+  ++ Profile.record ~accumulate:true "linearize" Linearize.fundecl
+  ++ pass_dump_linear_if ppf_dump dump_linear "Linearized code"
+  ++ Profile.record ~accumulate:true "scheduling" Scheduling.fundecl
+  ++ pass_dump_linear_if ppf_dump dump_scheduling "After instruction scheduling"
+  ++ emit_fundecl
+
+let compile_phrase ~ppf_dump p =
+  if !dump_cmm then fprintf ppf_dump "%a@." Printcmm.phrase p;
+  match p with
+  | Cfunction fd -> compile_fundecl ~ppf_dump fd
+  | Cdata dl -> emit_data dl
+
+
+(* For the native toplevel: generates generic functions unless
+   they are already available in the process *)
+let compile_genfuns ~ppf_dump f =
+  List.iter
+    (function
+       | (Cfunction {fun_name = name}) as ph when f name ->
+           compile_phrase ~ppf_dump ph
+       | _ -> ())
+    (Cmm_helpers.generic_functions true [Compilenv.current_unit_infos ()])
+
+let compile_unit asm_filename keep_asm
+      obj_filename gen =
+  let create_asm = should_emit () &&
+                   (keep_asm || not !Emitaux.binary_backend_available) in
+  Emitaux.create_asm_file := create_asm;
+  Misc.try_finally
+    ~exceptionally:(fun () -> remove_file obj_filename)
+    (fun () ->
+       if create_asm then Emitaux.output_channel := open_out asm_filename;
+       Misc.try_finally gen
+         ~always:(fun () ->
+             if create_asm then close_out !Emitaux.output_channel)
+         ~exceptionally:(fun () ->
+             if create_asm && not keep_asm then remove_file asm_filename);
+       if should_emit () then begin
+         let assemble_result =
+           Profile.record "assemble"
+             (Proc.assemble_file asm_filename) obj_filename
+         in
+         if assemble_result <> 0
+         then raise(Error(Assembler_error asm_filename));
+       end;
+       if create_asm && not keep_asm then remove_file asm_filename
+    )
+
+let end_gen_implementation ?toplevel ~ppf_dump
+    (clambda : Clambda.with_constants) =
+  emit_begin_assembly ();
+  clambda
+  ++ Profile.record "cmm" Cmmgen.compunit
+  ++ Profile.record "compile_phrases" (List.iter (compile_phrase ~ppf_dump))
+  ++ (fun () -> ());
+  (match toplevel with None -> () | Some f -> compile_genfuns ~ppf_dump f);
+  (* We add explicit references to external primitive symbols.  This
+     is to ensure that the object files that define these symbols,
+     when part of a C library, won't be discarded by the linker.
+     This is important if a module that uses such a symbol is later
+     dynlinked. *)
+  compile_phrase ~ppf_dump
+    (Cmm_helpers.reference_symbols
+       (List.filter_map (fun prim ->
+           if not (Primitive.native_name_is_external prim) then None
+           else Some (Primitive.native_name prim))
+          !Translmod.primitive_declarations));
+  emit_end_assembly ()
+
+type middle_end =
+     backend:(module Backend_intf.S)
+  -> filename:string
+  -> prefixname:string
+  -> ppf_dump:Format.formatter
+  -> Lambda.program
+  -> Clambda.with_constants
+
+let compile_implementation ?toplevel ~backend ~filename ~prefixname ~middle_end
+      ~ppf_dump (program : Lambda.program) =
+  let asmfile =
+    if !keep_asm_file || !Emitaux.binary_backend_available
+    then prefixname ^ ext_asm
+    else Filename.temp_file "camlasm" ext_asm
+  in
+  compile_unit asmfile !keep_asm_file (prefixname ^ ext_obj)
+    (fun () ->
+      Ident.Set.iter Compilenv.require_global program.required_globals;
+      let clambda_with_constants =
+        middle_end ~backend ~filename ~prefixname ~ppf_dump program
+      in
+      end_gen_implementation ?toplevel ~ppf_dump clambda_with_constants)
+
+(* Error report *)
+
+let report_error ppf = function
+  | Assembler_error file ->
+      fprintf ppf "Assembler error, input left in file %a"
+        Location.print_filename file
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )
diff --git a/asmcomp/asmgen.mli b/asmcomp/asmgen.mli
new file mode 100644
index 00000000..afbdefd6
--- /dev/null
+++ b/asmcomp/asmgen.mli
@@ -0,0 +1,48 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** From Lambda to assembly code *)
+
+(** The type of converters from Lambda to Clambda. *)
+type middle_end =
+     backend:(module Backend_intf.S)
+  -> filename:string
+  -> prefixname:string
+  -> ppf_dump:Format.formatter
+  -> Lambda.program
+  -> Clambda.with_constants
+
+(** Compile an implementation from Lambda using the given middle end. *)
+val compile_implementation
+   : ?toplevel:(string -> bool)
+  -> backend:(module Backend_intf.S)
+  -> filename:string
+  -> prefixname:string
+  -> middle_end:middle_end
+  -> ppf_dump:Format.formatter
+  -> Lambda.program
+  -> unit
+
+val compile_phrase :
+    ppf_dump:Format.formatter -> Cmm.phrase -> unit
+
+type error = Assembler_error of string
+exception Error of error
+val report_error: Format.formatter -> error -> unit
+
+
+val compile_unit:
+  string(*asm file*) -> bool(*keep asm*) ->
+  string(*obj file*) -> (unit -> unit) -> unit
diff --git a/asmcomp/asmlibrarian.ml b/asmcomp/asmlibrarian.ml
new file mode 100644
index 00000000..ba1d06b2
--- /dev/null
+++ b/asmcomp/asmlibrarian.ml
@@ -0,0 +1,85 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Build libraries of .cmx files *)
+
+open Misc
+open Config
+open Cmx_format
+
+type error =
+    File_not_found of string
+  | Archiver_error of string
+
+exception Error of error
+
+let default_ui_export_info =
+  if Config.flambda then
+    Cmx_format.Flambda Export_info.empty
+  else
+    Cmx_format.Clambda Clambda.Value_unknown
+
+let read_info name =
+  let filename =
+    try
+      Load_path.find name
+    with Not_found ->
+      raise(Error(File_not_found name)) in
+  let (info, crc) = Compilenv.read_unit_info filename in
+  info.ui_force_link <- info.ui_force_link || !Clflags.link_everything;
+  (* There is no need to keep the approximation in the .cmxa file,
+     since the compiler will go looking directly for .cmx files.
+     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))
+
+let create_archive file_list lib_name =
+  let archive_name = Filename.remove_extension lib_name ^ ext_lib in
+  let outchan = open_out_bin lib_name in
+  Misc.try_finally
+    ~always:(fun () -> close_out outchan)
+    ~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) ->
+            Asmlink.check_consistency file_name unit crc)
+         file_list descr_list;
+       let infos =
+         { lib_units = descr_list;
+           lib_ccobjs = !Clflags.ccobjs;
+           lib_ccopts = !Clflags.all_ccopts } in
+       output_value outchan infos;
+       if Ccomp.create_archive archive_name objfile_list <> 0
+       then raise(Error(Archiver_error archive_name));
+    )
+
+open Format
+
+let report_error ppf = function
+  | File_not_found name ->
+      fprintf ppf "Cannot find file %s" name
+  | Archiver_error name ->
+      fprintf ppf "Error while creating the library %s" name
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )
diff --git a/asmcomp/asmlibrarian.mli b/asmcomp/asmlibrarian.mli
new file mode 100644
index 00000000..4d66827c
--- /dev/null
+++ b/asmcomp/asmlibrarian.mli
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* 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
+
+exception Error of error
+
+val report_error: formatter -> error -> unit
diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml
new file mode 100644
index 00000000..6236b1ca
--- /dev/null
+++ b/asmcomp/asmlink.ml
@@ -0,0 +1,470 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Link a set of .cmx/.o files and produce an executable *)
+
+open Misc
+open Config
+open Cmx_format
+open Compilenv
+
+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
+
+exception Error of error
+
+(* Consistency check between interfaces and implementations *)
+
+module Cmi_consistbl = Consistbl.Make (Misc.Stdlib.String)
+let crc_interfaces = Cmi_consistbl.create ()
+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
+    List.iter
+      (fun (name, crco) ->
+        interfaces := name :: !interfaces;
+        match crco with
+          None -> ()
+        | Some crc ->
+            if name = unit.ui_name
+            then Cmi_consistbl.set crc_interfaces name crc file_name
+            else Cmi_consistbl.check crc_interfaces name crc file_name)
+      unit.ui_imports_cmi
+  with Cmi_consistbl.Inconsistency {
+      unit_name = name;
+      inconsistent_source = user;
+      original_source = auth;
+    } ->
+    raise(Error(Inconsistent_interface(name, user, auth)))
+  end;
+  begin try
+    List.iter
+      (fun (name, crco) ->
+        implementations := name :: !implementations;
+        match crco with
+            None ->
+              if List.mem name !cmx_required then
+                raise(Error(Missing_cmx(file_name, name)))
+          | Some crc ->
+              Cmx_consistbl.check crc_implementations name crc file_name)
+      unit.ui_imports_cmx
+  with Cmx_consistbl.Inconsistency {
+      unit_name = name;
+      inconsistent_source = user;
+      original_source = auth;
+    } ->
+    raise(Error(Inconsistent_implementation(name, user, auth)))
+  end;
+  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;
+  implementations := unit.ui_name :: !implementations;
+  Cmx_consistbl.set 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
+
+let extract_crc_interfaces () =
+  Cmi_consistbl.extract !interfaces crc_interfaces
+let extract_crc_implementations () =
+  Cmx_consistbl.extract !implementations crc_implementations
+
+(* Add C objects and options and "custom" info from a library descriptor.
+   See bytecomp/bytelink.ml for comments on the order of C objects. *)
+
+let lib_ccobjs = ref []
+let lib_ccopts = ref []
+
+let add_ccobjs origin l =
+  if not !Clflags.no_auto_link then begin
+    lib_ccobjs := l.lib_ccobjs @ !lib_ccobjs;
+    let replace_origin =
+      Misc.replace_substring ~before:"$CAMLORIGIN" ~after:origin
+    in
+    lib_ccopts := List.map replace_origin l.lib_ccopts @ !lib_ccopts
+  end
+
+let runtime_lib () =
+  let libname = "libasmrun" ^ !Clflags.runtime_variant ^ ext_lib in
+  try
+    if !Clflags.nopervasives || not !Clflags.with_runtime then []
+    else [ Load_path.find libname ]
+  with Not_found ->
+    raise(Error(File_not_found libname))
+
+let object_file_name name =
+  let file_name =
+    try
+      Load_path.find name
+    with Not_found ->
+      fatal_errorf "Asmlink.object_file_name: %s not found" name in
+  if Filename.check_suffix file_name ".cmx" then
+    Filename.chop_suffix file_name ".cmx" ^ ext_obj
+  else if Filename.check_suffix file_name ".cmxa" then
+    Filename.chop_suffix file_name ".cmxa" ^ ext_lib
+  else
+    fatal_error "Asmlink.object_file_name: bad ext"
+
+(* 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
+
+let read_file obj_name =
+  let file_name =
+    try
+      Load_path.find obj_name
+    with Not_found ->
+      raise(Error(File_not_found obj_name)) in
+  if Filename.check_suffix file_name ".cmx" then begin
+    (* This is a .cmx file. It must be linked in any case.
+       Read the infos to see which modules it requires. *)
+    let (info, crc) = read_unit_info file_name in
+    Unit (file_name,info,crc)
+  end
+  else if Filename.check_suffix file_name ".cmxa" then begin
+    let infos =
+      try read_library_info file_name
+      with Compilenv.Error(Not_a_unit_info _) ->
+        raise(Error(Not_an_object_file file_name))
+    in
+    Library (file_name,infos)
+  end
+  else raise(Error(Not_an_object_file file_name))
+
+let scan_file obj_name (tolink, objfiles) = match read_file obj_name 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;
+      ((info, file_name, crc) :: tolink, obj_name :: objfiles)
+  | Library (file_name,infos) ->
+      (* This is an archive file. Each unit contained in it will be linked
+         in only if needed. *)
+      add_ccobjs (Filename.dirname file_name) infos;
+      let tolink =
+        List.fold_right
+          (fun (info, crc) reqd ->
+             if info.ui_force_link
+               || !Clflags.link_everything
+               || is_required 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;
+               (info, file_name, crc) :: reqd
+             end else
+               reqd)
+          infos.lib_units tolink
+      and objfiles =
+        if Config.ccomp_type = "msvc"
+        && infos.lib_units = []
+        && not (Sys.file_exists (object_file_name obj_name)) then
+          (* MSVC doesn't support empty .lib files, so there shouldn't be one
+             if the .cmxa contains no units. The file_exists check is added to
+             be ultra-defensive for the case where a user has manually added
+             things to the .lib file *)
+          objfiles
+        else
+          obj_name :: objfiles
+      in (tolink, objfiles)
+
+(* Second pass: generate the startup file and link it with everything else *)
+
+let force_linking_of_startup ~ppf_dump =
+  Asmgen.compile_phrase ~ppf_dump
+    (Cmm.Cdata ([Cmm.Csymbol_address "caml_startup"]))
+
+let make_globals_map units_list ~crc_interfaces =
+  let crc_interfaces = String.Tbl.of_seq (List.to_seq crc_interfaces) in
+  let defined =
+    List.map (fun (unit, _, impl_crc) ->
+        let intf_crc = String.Tbl.find crc_interfaces unit.ui_name in
+        String.Tbl.remove crc_interfaces unit.ui_name;
+        (unit.ui_name, intf_crc, Some impl_crc, unit.ui_defines))
+      units_list
+  in
+  String.Tbl.fold (fun name intf acc ->
+      (name, intf, None, []) :: acc)
+    crc_interfaces defined
+
+let make_startup_file ~ppf_dump units_list ~crc_interfaces =
+  let compile_phrase p = Asmgen.compile_phrase ~ppf_dump p in
+  Location.input_name := "caml_startup"; (* set name of "current" input *)
+  Compilenv.reset "_startup";
+  (* set the name of the "current" compunit *)
+  Emit.begin_assembly ();
+  let name_list =
+    List.flatten (List.map (fun (info,_,_) -> info.ui_defines) units_list) in
+  compile_phrase (Cmm_helpers.entry_point name_list);
+  let units = List.map (fun (info,_,_) -> info) units_list in
+  List.iter compile_phrase (Cmm_helpers.generic_functions false units);
+  Array.iteri
+    (fun i name -> compile_phrase (Cmm_helpers.predef_exception i name))
+    Runtimedef.builtin_exceptions;
+  compile_phrase (Cmm_helpers.global_table name_list);
+  let globals_map = make_globals_map units_list ~crc_interfaces in
+  compile_phrase (Cmm_helpers.globals_map globals_map);
+  compile_phrase(Cmm_helpers.data_segment_table ("_startup" :: name_list));
+  if !Clflags.function_sections then
+    compile_phrase
+      (Cmm_helpers.code_segment_table("_hot" :: "_startup" :: name_list))
+  else
+    compile_phrase(Cmm_helpers.code_segment_table("_startup" :: name_list));
+  let all_names = "_startup" :: "_system" :: name_list in
+  compile_phrase (Cmm_helpers.frame_table all_names);
+  if Config.spacetime then begin
+    compile_phrase (Cmm_helpers.spacetime_shapes all_names);
+  end;
+  if !Clflags.output_complete_object then
+    force_linking_of_startup ~ppf_dump;
+  Emit.end_assembly ()
+
+let make_shared_startup_file ~ppf_dump units =
+  let compile_phrase p = Asmgen.compile_phrase ~ppf_dump p in
+  Location.input_name := "caml_startup";
+  Compilenv.reset "_shared_startup";
+  Emit.begin_assembly ();
+  List.iter compile_phrase
+    (Cmm_helpers.generic_functions true (List.map fst units));
+  compile_phrase (Cmm_helpers.plugin_header units);
+  compile_phrase
+    (Cmm_helpers.global_table
+       (List.map (fun (ui,_) -> ui.ui_symbol) units));
+  if !Clflags.output_complete_object then
+    force_linking_of_startup ~ppf_dump;
+  (* this is to force a reference to all units, otherwise the linker
+     might drop some of them (in case of libraries) *)
+  Emit.end_assembly ()
+
+let call_linker_shared file_list output_name =
+  let exitcode = Ccomp.call_linker Ccomp.Dll output_name file_list "" in
+  if not (exitcode = 0)
+  then raise(Error(Linking_error exitcode))
+
+let link_shared ~ppf_dump objfiles output_name =
+  Profile.record_call output_name (fun () ->
+    let units_tolink, objfiles =
+      List.fold_right scan_file objfiles ([], [])
+    in
+    List.iter
+      (fun (info, file_name, crc) -> check_consistency file_name info crc)
+      units_tolink;
+    Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs;
+    Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts;
+    let objfiles = List.rev_map object_file_name objfiles @
+      (List.rev !Clflags.ccobjs) in
+
+    let startup =
+      if !Clflags.keep_startup_file || !Emitaux.binary_backend_available
+      then output_name ^ ".startup" ^ ext_asm
+      else Filename.temp_file "camlstartup" ext_asm in
+    let startup_obj = output_name ^ ".startup" ^ ext_obj in
+    Asmgen.compile_unit
+      startup !Clflags.keep_startup_file startup_obj
+      (fun () ->
+         make_shared_startup_file ~ppf_dump
+           (List.map (fun (ui,_,crc) -> (ui,crc)) units_tolink)
+      );
+    call_linker_shared (startup_obj :: objfiles) output_name;
+    remove_file startup_obj
+  )
+
+let call_linker file_list startup_file output_name =
+  let main_dll = !Clflags.output_c_object
+                 && Filename.check_suffix output_name Config.ext_dll
+  and main_obj_runtime = !Clflags.output_complete_object
+  in
+  let files = startup_file :: (List.rev file_list) in
+  let libunwind =
+    if not Config.spacetime then []
+    else if not Config.libunwind_available then []
+    else String.split_on_char ' ' Config.libunwind_link_flags
+  in
+  let files, c_lib =
+    if (not !Clflags.output_c_object) || main_dll || main_obj_runtime then
+      files @ (List.rev !Clflags.ccobjs) @ runtime_lib () @ libunwind,
+      (if !Clflags.nopervasives || (main_obj_runtime && not main_dll)
+       then "" else Config.native_c_libraries)
+    else
+      files, ""
+  in
+  let mode =
+    if main_dll then Ccomp.MainDll
+    else if !Clflags.output_c_object then Ccomp.Partial
+    else Ccomp.Exe
+  in
+  let exitcode = Ccomp.call_linker mode output_name files c_lib in
+  if not (exitcode = 0)
+  then raise(Error(Linking_error exitcode))
+
+(* Main entry point *)
+
+let link ~ppf_dump objfiles output_name =
+  Profile.record_call output_name (fun () ->
+    let stdlib = "stdlib.cmxa" in
+    let stdexit = "std_exit.cmx" in
+    let objfiles =
+      if !Clflags.nopervasives then objfiles
+      else if !Clflags.output_c_object then stdlib :: objfiles
+      else stdlib :: (objfiles @ [stdexit]) in
+    let units_tolink, objfiles =
+      List.fold_right scan_file objfiles ([], [])
+    in
+    Array.iter remove_required Runtimedef.builtin_exceptions;
+    begin match extract_missing_globals() with
+      [] -> ()
+    | mg -> raise(Error(Missing_implementations mg))
+    end;
+    List.iter
+      (fun (info, file_name, crc) -> check_consistency file_name info crc)
+      units_tolink;
+    let crc_interfaces = extract_crc_interfaces () in
+    Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs;
+    Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts;
+                                                 (* put user's opts first *)
+    let startup =
+      if !Clflags.keep_startup_file || !Emitaux.binary_backend_available
+      then output_name ^ ".startup" ^ ext_asm
+      else Filename.temp_file "camlstartup" ext_asm in
+    let startup_obj = Filename.temp_file "camlstartup" ext_obj in
+    Asmgen.compile_unit
+      startup !Clflags.keep_startup_file startup_obj
+      (fun () -> make_startup_file ~ppf_dump units_tolink ~crc_interfaces);
+    Misc.try_finally
+      (fun () ->
+         call_linker (List.map object_file_name objfiles)
+           startup_obj output_name)
+      ~always:(fun () -> remove_file startup_obj)
+  )
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+  | File_not_found name ->
+      fprintf ppf "Cannot find file %s" name
+  | Not_an_object_file name ->
+      fprintf ppf "The file %a is not a compilation unit description"
+        Location.print_filename name
+  | Missing_implementations l ->
+     let print_references ppf = function
+       | [] -> ()
+       | r1 :: rl ->
+           fprintf ppf "%s" r1;
+           List.iter (fun r -> fprintf ppf ",@ %s" r) rl in
+      let print_modules ppf =
+        List.iter
+         (fun (md, rq) ->
+            fprintf ppf "@ @[%s referenced from %a@]" md
+            print_references rq) in
+      fprintf ppf
+       "@[No implementations provided for the following modules:%a@]"
+       print_modules l
+  | Inconsistent_interface(intf, file1, file2) ->
+      fprintf ppf
+       "@[Files %a@ and %a@ make inconsistent assumptions \
+              over interface %s@]"
+       Location.print_filename file1
+       Location.print_filename file2
+       intf
+  | Inconsistent_implementation(intf, file1, file2) ->
+      fprintf ppf
+       "@[Files %a@ and %a@ make inconsistent assumptions \
+              over implementation %s@]"
+       Location.print_filename file1
+       Location.print_filename file2
+       intf
+  | Assembler_error file ->
+      fprintf ppf "Error while assembling %a" Location.print_filename file
+  | Linking_error exitcode ->
+      fprintf ppf "Error during linking (exit code %d)" exitcode
+  | Multiple_definition(modname, file1, file2) ->
+      fprintf ppf
+        "@[Files %a@ and %a@ both define a module named %s@]"
+        Location.print_filename file1
+        Location.print_filename file2
+        modname
+  | Missing_cmx(filename, name) ->
+      fprintf ppf
+        "@[File %a@ was compiled without access@ \
+         to the .cmx file@ for module %s,@ \
+         which was produced by `ocamlopt -for-pack'.@ \
+         Please recompile %a@ with the correct `-I' option@ \
+         so that %s.cmx@ is found.@]"
+        Location.print_filename filename name
+        Location.print_filename  filename
+        name
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )
+
+let reset () =
+  Cmi_consistbl.clear crc_interfaces;
+  Cmx_consistbl.clear crc_implementations;
+  implementations_defined := [];
+  cmx_required := [];
+  interfaces := [];
+  implementations := [];
+  lib_ccobjs := [];
+  lib_ccopts := []
diff --git a/asmcomp/asmlink.mli b/asmcomp/asmlink.mli
new file mode 100644
index 00000000..6ee91ffb
--- /dev/null
+++ b/asmcomp/asmlink.mli
@@ -0,0 +1,45 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Link a set of .cmx/.o files and produce an executable or a plugin *)
+
+open Misc
+open Format
+
+val link: ppf_dump:formatter -> string list -> string -> unit
+
+val link_shared: ppf_dump:formatter -> string list -> string -> unit
+
+val call_linker_shared: string list -> string -> unit
+
+val reset : unit -> unit
+val check_consistency: filepath -> Cmx_format.unit_infos -> Digest.t -> unit
+val extract_crc_interfaces: unit -> crcs
+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
+
+exception Error of error
+
+val report_error: formatter -> error -> unit
diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml
new file mode 100644
index 00000000..604fac5e
--- /dev/null
+++ b/asmcomp/asmpackager.ml
@@ -0,0 +1,304 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* "Package" a set of .cmx/.o files into one .cmx/.o file having the
+   original compilation units as sub-modules. *)
+
+open Misc
+open Cmx_format
+
+type error =
+    Illegal_renaming of string * string * string
+  | Forward_reference of string * string
+  | Wrong_for_pack of string * string
+  | Linking_error
+  | Assembler_error of string
+  | File_not_found of string
+
+
+exception Error of error
+
+(* Read the unit information from a .cmx file. *)
+
+type pack_member_kind = PM_intf | PM_impl of unit_infos
+
+type pack_member =
+  { pm_file: string;
+    pm_name: string;
+    pm_kind: pack_member_kind }
+
+let read_member_info pack_path file = (
+  let name =
+    String.capitalize_ascii(Filename.basename(chop_extensions file)) in
+  let kind =
+    if Filename.check_suffix file ".cmi" then
+      PM_intf
+    else begin
+      let (info, crc) = Compilenv.read_unit_info file in
+      if info.ui_name <> name
+      then raise(Error(Illegal_renaming(name, file, info.ui_name)));
+      if info.ui_symbol <>
+         (Compilenv.current_unit_infos()).ui_symbol ^ "__" ^ info.ui_name
+      then raise(Error(Wrong_for_pack(file, pack_path)));
+      Asmlink.check_consistency file info crc;
+      Compilenv.cache_unit_info info;
+      PM_impl info
+    end in
+  { pm_file = file; pm_name = name; pm_kind = kind }
+)
+
+(* Check absence of forward references *)
+
+let check_units members =
+  let rec check forbidden = function
+    [] -> ()
+  | mb :: tl ->
+      begin match mb.pm_kind with
+      | PM_intf -> ()
+      | PM_impl infos ->
+          List.iter
+            (fun (unit, _) ->
+              if List.mem unit forbidden
+              then raise(Error(Forward_reference(mb.pm_file, unit))))
+            infos.ui_imports_cmx
+      end;
+      check (list_remove mb.pm_name forbidden) tl in
+  check (List.map (fun mb -> mb.pm_name) members) members
+
+(* Make the .o file for the package *)
+
+let make_package_object ~ppf_dump members targetobj targetname coercion
+      ~backend =
+  Profile.record_call (Printf.sprintf "pack(%s)" targetname) (fun () ->
+    let objtemp =
+      if !Clflags.keep_asm_file
+      then Filename.remove_extension targetobj ^ ".pack" ^ Config.ext_obj
+      else
+        (* Put the full name of the module in the temporary file name
+           to avoid collisions with MSVC's link /lib in case of successive
+           packs *)
+        Filename.temp_file (Compilenv.make_symbol (Some "")) Config.ext_obj in
+    let components =
+      List.map
+        (fun m ->
+          match m.pm_kind with
+          | PM_intf -> None
+          | PM_impl _ -> Some(Ident.create_persistent m.pm_name))
+        members in
+    let module_ident = Ident.create_persistent targetname in
+    let prefixname = Filename.remove_extension objtemp in
+    let required_globals = Ident.Set.empty in
+    let program, middle_end =
+      if Config.flambda then
+        let main_module_block_size, code =
+          Translmod.transl_package_flambda components coercion
+        in
+        let code = Simplif.simplify_lambda code in
+        let program =
+          { Lambda.
+            code;
+            main_module_block_size;
+            module_ident;
+            required_globals;
+          }
+        in
+        program, Flambda_middle_end.lambda_to_clambda
+      else
+        let main_module_block_size, code =
+          Translmod.transl_store_package components
+            (Ident.create_persistent targetname) coercion
+        in
+        let code = Simplif.simplify_lambda code in
+        let program =
+          { Lambda.
+            code;
+            main_module_block_size;
+            module_ident;
+            required_globals;
+          }
+        in
+        program, Closure_middle_end.lambda_to_clambda
+    in
+    Asmgen.compile_implementation ~backend
+      ~filename:targetname
+      ~prefixname
+      ~middle_end
+      ~ppf_dump
+      program;
+    let objfiles =
+      List.map
+        (fun m -> Filename.remove_extension m.pm_file ^ Config.ext_obj)
+        (List.filter (fun m -> m.pm_kind <> PM_intf) members) in
+    let exitcode =
+      Ccomp.call_linker Ccomp.Partial targetobj (objtemp :: objfiles) ""
+    in
+    remove_file objtemp;
+    if not (exitcode = 0) then raise(Error Linking_error)
+  )
+
+(* Make the .cmx file for the package *)
+
+let get_export_info ui =
+  assert(Config.flambda);
+  match ui.ui_export_info with
+  | Clambda _ -> assert false
+  | Flambda info -> info
+
+let get_approx ui =
+  assert(not Config.flambda);
+  match ui.ui_export_info with
+  | Flambda _ -> assert false
+  | Clambda info -> info
+
+let build_package_cmx members cmxfile =
+  let unit_names =
+    List.map (fun m -> m.pm_name) members in
+  let filter lst =
+    List.filter (fun (name, _crc) -> not (List.mem name unit_names)) lst in
+  let union lst =
+    List.fold_left
+      (List.fold_left
+          (fun accu n -> if List.mem n accu then accu else n :: accu))
+      [] lst in
+  let units =
+    List.fold_right
+      (fun m accu ->
+        match m.pm_kind with PM_intf -> accu | PM_impl info -> info :: accu)
+      members [] in
+  let pack_units =
+    List.fold_left
+      (fun set info ->
+         let unit_id = Compilenv.unit_id_from_name info.ui_name in
+         Compilation_unit.Set.add
+           (Compilenv.unit_for_global unit_id) set)
+      Compilation_unit.Set.empty units in
+  let units =
+    if Config.flambda then
+      List.map (fun info ->
+          { info with
+            ui_export_info =
+              Flambda
+                (Export_info_for_pack.import_for_pack ~pack_units
+                   ~pack:(Compilenv.current_unit ())
+                   (get_export_info info)) })
+        units
+    else
+      units
+  in
+  let ui = Compilenv.current_unit_infos() in
+  let ui_export_info =
+    if Config.flambda then
+      let ui_export_info =
+        List.fold_left (fun acc info ->
+            Export_info.merge acc (get_export_info info))
+          (Export_info_for_pack.import_for_pack ~pack_units
+             ~pack:(Compilenv.current_unit ())
+             (get_export_info ui))
+          units
+      in
+      Flambda ui_export_info
+    else
+      Clambda (get_approx ui)
+  in
+  Export_info_for_pack.clear_import_state ();
+  let pkg_infos =
+    { ui_name = ui.ui_name;
+      ui_symbol = ui.ui_symbol;
+      ui_defines =
+          List.flatten (List.map (fun info -> info.ui_defines) units) @
+          [ui.ui_symbol];
+      ui_imports_cmi =
+          (ui.ui_name, Some (Env.crc_of_unit ui.ui_name)) ::
+          filter(Asmlink.extract_crc_interfaces());
+      ui_imports_cmx =
+          filter(Asmlink.extract_crc_implementations());
+      ui_curry_fun =
+          union(List.map (fun info -> info.ui_curry_fun) units);
+      ui_apply_fun =
+          union(List.map (fun info -> info.ui_apply_fun) units);
+      ui_send_fun =
+          union(List.map (fun info -> info.ui_send_fun) units);
+      ui_force_link =
+          List.exists (fun info -> info.ui_force_link) units;
+      ui_export_info;
+    } in
+  Compilenv.write_unit_info pkg_infos cmxfile
+
+(* Make the .cmx and the .o for the package *)
+
+let package_object_files ~ppf_dump files targetcmx
+                         targetobj targetname coercion ~backend =
+  let pack_path =
+    match !Clflags.for_package with
+    | None -> targetname
+    | Some p -> p ^ "." ^ targetname in
+  let members = map_left_right (read_member_info pack_path) files in
+  check_units members;
+  make_package_object ~ppf_dump members targetobj targetname coercion ~backend;
+  build_package_cmx members targetcmx
+
+(* The entry point *)
+
+let package_files ~ppf_dump initial_env files targetcmx ~backend =
+  let files =
+    List.map
+      (fun f ->
+        try Load_path.find f
+        with Not_found -> raise(Error(File_not_found f)))
+      files in
+  let prefix = chop_extensions targetcmx in
+  let targetcmi = prefix ^ ".cmi" in
+  let targetobj = Filename.remove_extension targetcmx ^ Config.ext_obj in
+  let targetname = String.capitalize_ascii(Filename.basename prefix) in
+  (* Set the name of the current "input" *)
+  Location.input_name := targetcmx;
+  (* Set the name of the current compunit *)
+  Compilenv.reset ?packname:!Clflags.for_package targetname;
+  Misc.try_finally (fun () ->
+      let coercion =
+        Typemod.package_units initial_env files targetcmi targetname in
+      package_object_files ~ppf_dump files targetcmx targetobj targetname
+        coercion ~backend
+    )
+    ~exceptionally:(fun () -> remove_file targetcmx; remove_file targetobj)
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+    Illegal_renaming(name, file, id) ->
+      fprintf ppf "Wrong file naming: %a@ contains the code for\
+                   @ %s when %s was expected"
+        Location.print_filename file name id
+  | Forward_reference(file, ident) ->
+      fprintf ppf "Forward reference to %s in file %a" ident
+        Location.print_filename file
+  | Wrong_for_pack(file, path) ->
+      fprintf ppf "File %a@ was not compiled with the `-for-pack %s' option"
+              Location.print_filename file path
+  | File_not_found file ->
+      fprintf ppf "File %s not found" file
+  | Assembler_error file ->
+      fprintf ppf "Error while assembling %s" file
+  | Linking_error ->
+      fprintf ppf "Error during partial linking"
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )
diff --git a/asmcomp/asmpackager.mli b/asmcomp/asmpackager.mli
new file mode 100644
index 00000000..3ea21425
--- /dev/null
+++ b/asmcomp/asmpackager.mli
@@ -0,0 +1,37 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* "Package" a set of .cmx/.o files into one .cmx/.o file having the
+   original compilation units as sub-modules. *)
+
+val package_files
+   : ppf_dump:Format.formatter
+  -> Env.t
+  -> string list
+  -> string
+  -> backend:(module Backend_intf.S)
+  -> unit
+
+type error =
+    Illegal_renaming of string * string * string
+  | Forward_reference of string * string
+  | Wrong_for_pack of string * string
+  | Linking_error
+  | Assembler_error of string
+  | File_not_found of string
+
+exception Error of error
+
+val report_error: Format.formatter -> error -> unit
diff --git a/asmcomp/branch_relaxation.ml b/asmcomp/branch_relaxation.ml
new file mode 100644
index 00000000..74b749ea
--- /dev/null
+++ b/asmcomp/branch_relaxation.ml
@@ -0,0 +1,143 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                    Mark Shinwell, Jane Street Europe                   *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Mach
+open Linear
+
+module Make (T : Branch_relaxation_intf.S) = struct
+  let label_map code =
+    let map = Hashtbl.create 37 in
+    let rec fill_map pc instr =
+      match instr.desc with
+      | Lend -> (pc, map)
+      | Llabel lbl -> Hashtbl.add map lbl pc; fill_map pc instr.next
+      | op -> fill_map (pc + T.instr_size op) instr.next
+    in
+    fill_map 0 code
+
+  let branch_overflows map pc_branch lbl_dest max_branch_offset =
+    let pc_dest = Hashtbl.find map lbl_dest in
+    let delta = pc_dest - (pc_branch + T.offset_pc_at_branch) in
+    delta <= -max_branch_offset || delta >= max_branch_offset
+
+  let opt_branch_overflows map pc_branch opt_lbl_dest max_branch_offset =
+    match opt_lbl_dest with
+    | None -> false
+    | Some lbl_dest ->
+      branch_overflows map pc_branch lbl_dest max_branch_offset
+
+  let instr_overflows ~code_size ~max_out_of_line_code_offset instr map pc =
+    match T.Cond_branch.classify_instr instr.desc with
+    | None -> false
+    | Some branch ->
+      let max_branch_offset =
+        (* Remember to cut some slack for multi-word instructions (in the
+           [Linear] sense of the word) where the branch can be anywhere in
+           the middle.  12 words of slack is plenty. *)
+        T.Cond_branch.max_displacement branch - 12
+      in
+      match instr.desc with
+      | Lop (Ialloc _)
+      | Lop (Iintop (Icheckbound _))
+      | Lop (Iintop_imm (Icheckbound _, _))
+      | Lop (Ispecific _) ->
+        (* We assume that any branches eligible for relaxation generated
+           by these instructions only branch forward.  We further assume
+           that any of these may branch to an out-of-line code block. *)
+        code_size + max_out_of_line_code_offset - pc >= max_branch_offset
+      | Lcondbranch (_, lbl) ->
+        branch_overflows map pc lbl max_branch_offset
+      | Lcondbranch3 (lbl0, lbl1, lbl2) ->
+        opt_branch_overflows map pc lbl0 max_branch_offset
+          || opt_branch_overflows map pc lbl1 max_branch_offset
+          || opt_branch_overflows map pc lbl2 max_branch_offset
+      | _ ->
+        Misc.fatal_error "Unsupported instruction for branch relaxation"
+
+  let fixup_branches ~code_size ~max_out_of_line_code_offset map code =
+    let expand_optbranch lbl n arg next =
+      match lbl with
+      | None -> next
+      | Some l ->
+        instr_cons (Lcondbranch (Iinttest_imm (Isigned Cmm.Ceq, n), l))
+          arg [||] next
+    in
+    let rec fixup did_fix pc instr =
+      match instr.desc with
+      | Lend -> did_fix
+      | _ ->
+        let overflows =
+          instr_overflows ~code_size ~max_out_of_line_code_offset instr map pc
+        in
+        if not overflows then
+          fixup did_fix (pc + T.instr_size instr.desc) instr.next
+        else
+          match instr.desc with
+          | Lop (Ialloc { bytes = num_bytes; label_after_call_gc; dbginfo }) ->
+            instr.desc <- T.relax_allocation ~num_bytes
+                            ~dbginfo ~label_after_call_gc;
+            fixup true (pc + T.instr_size instr.desc) instr.next
+          | Lop (Iintop (Icheckbound { label_after_error; })) ->
+            instr.desc <- T.relax_intop_checkbound ~label_after_error;
+            fixup true (pc + T.instr_size instr.desc) instr.next
+          | Lop (Iintop_imm (Icheckbound { label_after_error; }, bound)) ->
+            instr.desc
+              <- T.relax_intop_imm_checkbound ~bound ~label_after_error;
+            fixup true (pc + T.instr_size instr.desc) instr.next
+          | Lop (Ispecific specific) ->
+            instr.desc <- T.relax_specific_op specific;
+            fixup true (pc + T.instr_size instr.desc) instr.next
+          | Lcondbranch (test, lbl) ->
+            let lbl2 = Cmm.new_label() in
+            let cont =
+              instr_cons (Lbranch lbl) [||] [||]
+                (instr_cons (Llabel lbl2) [||] [||] instr.next)
+            in
+            instr.desc <- Lcondbranch (invert_test test, lbl2);
+            instr.next <- cont;
+            fixup true (pc + T.instr_size instr.desc) instr.next
+          | Lcondbranch3 (lbl0, lbl1, lbl2) ->
+            let cont =
+              expand_optbranch lbl0 0 instr.arg
+                (expand_optbranch lbl1 1 instr.arg
+                  (expand_optbranch lbl2 2 instr.arg instr.next))
+            in
+            instr.desc <- cont.desc;
+            instr.next <- cont.next;
+            fixup true pc instr
+          | _ ->
+            (* Any other instruction has already been rejected in
+               [instr_overflows] above.
+               We can *never* get here. *)
+            assert false
+    in
+    fixup false 0 code
+
+  (* Iterate branch expansion till all conditional branches are OK *)
+
+  let rec relax code ~max_out_of_line_code_offset =
+    let min_of_max_branch_offsets =
+      List.fold_left (fun min_of_max_branch_offsets branch ->
+          min min_of_max_branch_offsets
+            (T.Cond_branch.max_displacement branch))
+        max_int T.Cond_branch.all
+    in
+    let (code_size, map) = label_map code in
+    if code_size >= min_of_max_branch_offsets
+        && fixup_branches ~code_size ~max_out_of_line_code_offset map code
+    then relax code ~max_out_of_line_code_offset
+    else ()
+end
diff --git a/asmcomp/branch_relaxation.mli b/asmcomp/branch_relaxation.mli
new file mode 100644
index 00000000..7d540198
--- /dev/null
+++ b/asmcomp/branch_relaxation.mli
@@ -0,0 +1,29 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                    Mark Shinwell, Jane Street Europe                   *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Fix up conditional branches that exceed hardware-allowed ranges. *)
+
+module Make (T : Branch_relaxation_intf.S) : sig
+  val relax
+     : Linear.instruction
+    (* [max_offset_of_out_of_line_code] specifies the furthest distance,
+       measured from the first address immediately after the last instruction
+       of the function, that may be branched to from within the function in
+       order to execute "out of line" code blocks such as call GC and
+       bounds check points. *)
+    -> max_out_of_line_code_offset:T.distance
+    -> unit
+end
diff --git a/asmcomp/branch_relaxation_intf.ml b/asmcomp/branch_relaxation_intf.ml
new file mode 100644
index 00000000..b7a7271f
--- /dev/null
+++ b/asmcomp/branch_relaxation_intf.ml
@@ -0,0 +1,76 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                    Mark Shinwell, Jane Street Europe                   *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+module type S = sig
+  (* The distance between two instructions, in arbitrary units (typically
+     the natural word size of instructions). *)
+  type distance = int
+
+  module Cond_branch : sig
+    (* The various types of conditional branches for a given target that
+       may require relaxation. *)
+    type t
+
+    (* All values of type [t] that the emitter may produce. *)
+    val all : t list
+
+    (* If [max_displacement branch] is [n] then [branch] is assumed to
+       reach any address in the range [pc - n, pc + n] (inclusive), after
+       the [pc] of the branch has been adjusted by [offset_pc_at_branch]
+       (see below). *)
+    val max_displacement : t -> distance
+
+    (* Which variety of conditional branch may be produced by the emitter for a
+       given instruction description.  For the moment we assume that only one
+       such variety per instruction description is needed.
+
+       N.B. The only instructions supported are the following:
+                - Lop (Ialloc _)
+                - Lop (Iintop Icheckbound)
+                - Lop (Iintop_imm (Icheckbound, _))
+                - Lop (Ispecific _)
+                - Lcondbranch (_, _)
+                - Lcondbranch3 (_, _, _)
+       [classify_instr] is expected to return [None] when called on any
+       instruction not in this list. *)
+    val classify_instr : Linear.instruction_desc -> t option
+  end
+
+  (* The value to be added to the program counter (in [distance] units)
+     when it is at a branch instruction, prior to calculating the distance
+     to a branch target. *)
+  val offset_pc_at_branch : distance
+
+  (* The maximum size of a given instruction. *)
+  val instr_size : Linear.instruction_desc -> distance
+
+  (* Insertion of target-specific code to relax operations that cannot be
+     relaxed generically.  It is assumed that these rewrites do not change
+     the size of out-of-line code (cf. branch_relaxation.mli). *)
+  val relax_allocation
+     : num_bytes:int
+    -> label_after_call_gc:Cmm.label option
+    -> dbginfo:Debuginfo.alloc_dbginfo
+    -> Linear.instruction_desc
+  val relax_intop_checkbound
+     : label_after_error:Cmm.label option
+    -> Linear.instruction_desc
+  val relax_intop_imm_checkbound
+     : bound:int
+    -> label_after_error:Cmm.label option
+    -> Linear.instruction_desc
+  val relax_specific_op : Arch.specific_operation -> Linear.instruction_desc
+end
diff --git a/asmcomp/cmm.ml b/asmcomp/cmm.ml
new file mode 100644
index 00000000..e9fcbd9b
--- /dev/null
+++ b/asmcomp/cmm.ml
@@ -0,0 +1,323 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type machtype_component =
+  | Val
+  | Addr
+  | Int
+  | Float
+
+type machtype = machtype_component array
+
+let typ_void = ([||] : machtype_component array)
+let typ_val = [|Val|]
+let typ_addr = [|Addr|]
+let typ_int = [|Int|]
+let typ_float = [|Float|]
+
+(** [machtype_component]s are partially ordered as follows:
+
+      Addr     Float
+       ^
+       |
+      Val
+       ^
+       |
+      Int
+
+  In particular, [Addr] must be above [Val], to ensure that if there is
+  a join point between a code path yielding [Addr] and one yielding [Val]
+  then the result is treated as a derived pointer into the heap (i.e. [Addr]).
+  (Such a result may not be live across any call site or a fatal compiler
+  error will result.)
+*)
+
+let lub_component comp1 comp2 =
+  match comp1, comp2 with
+  | Int, Int -> Int
+  | Int, Val -> Val
+  | Int, Addr -> Addr
+  | Val, Int -> Val
+  | Val, Val -> Val
+  | Val, Addr -> Addr
+  | Addr, Int -> Addr
+  | Addr, Addr -> Addr
+  | Addr, Val -> Addr
+  | Float, Float -> Float
+  | (Int | Addr | Val), Float
+  | Float, (Int | Addr | Val) ->
+    (* Float unboxing code must be sure to avoid this case. *)
+    assert false
+
+let ge_component comp1 comp2 =
+  match comp1, comp2 with
+  | Int, Int -> true
+  | Int, Addr -> false
+  | Int, Val -> false
+  | Val, Int -> true
+  | Val, Val -> true
+  | Val, Addr -> false
+  | Addr, Int -> true
+  | Addr, Addr -> true
+  | Addr, Val -> true
+  | Float, Float -> true
+  | (Int | Addr | Val), Float
+  | Float, (Int | Addr | Val) ->
+    assert false
+
+type integer_comparison = Lambda.integer_comparison =
+  | Ceq | Cne | Clt | Cgt | Cle | Cge
+
+let negate_integer_comparison = Lambda.negate_integer_comparison
+
+let swap_integer_comparison = Lambda.swap_integer_comparison
+
+(* With floats [not (x < y)] is not the same as [x >= y] due to NaNs,
+   so we provide additional comparisons to represent the negations.*)
+type float_comparison = Lambda.float_comparison =
+  | CFeq | CFneq | CFlt | CFnlt | CFgt | CFngt | CFle | CFnle | CFge | CFnge
+
+let negate_float_comparison = Lambda.negate_float_comparison
+
+let swap_float_comparison = Lambda.swap_float_comparison
+type label = int
+
+let label_counter = ref 99
+
+let new_label() = incr label_counter; !label_counter
+
+type rec_flag = Nonrecursive | Recursive
+
+type phantom_defining_expr =
+  | Cphantom_const_int of Targetint.t
+  | Cphantom_const_symbol of string
+  | Cphantom_var of Backend_var.t
+  | Cphantom_offset_var of { var : Backend_var.t; offset_in_words : int; }
+  | Cphantom_read_field of { var : Backend_var.t; field : int; }
+  | Cphantom_read_symbol_field of { sym : string; field : int; }
+  | Cphantom_block of { tag : int; fields : Backend_var.t list; }
+
+type memory_chunk =
+    Byte_unsigned
+  | Byte_signed
+  | Sixteen_unsigned
+  | Sixteen_signed
+  | Thirtytwo_unsigned
+  | Thirtytwo_signed
+  | Word_int
+  | Word_val
+  | Single
+  | Double
+  | Double_u
+
+and operation =
+    Capply of machtype
+  | Cextcall of string * machtype * bool * label option
+    (** If specified, the given label will be placed immediately after the
+        call (at the same place as any frame descriptor would reference). *)
+  | Cload of memory_chunk * Asttypes.mutable_flag
+  | Calloc
+  | Cstore of memory_chunk * Lambda.initialization_or_assignment
+  | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
+  | Cand | Cor | Cxor | Clsl | Clsr | Casr
+  | Ccmpi of integer_comparison
+  | Caddv | Cadda
+  | Ccmpa of integer_comparison
+  | Cnegf | Cabsf
+  | Caddf | Csubf | Cmulf | Cdivf
+  | Cfloatofint | Cintoffloat
+  | Ccmpf of float_comparison
+  | Craise of Lambda.raise_kind
+  | Ccheckbound
+
+type expression =
+    Cconst_int of int * Debuginfo.t
+  | Cconst_natint of nativeint * Debuginfo.t
+  | Cconst_float of float * Debuginfo.t
+  | Cconst_symbol of string * Debuginfo.t
+  | Cconst_pointer of int * Debuginfo.t
+  | Cconst_natpointer of nativeint * Debuginfo.t
+  | Cblockheader of nativeint * Debuginfo.t
+  | Cvar of Backend_var.t
+  | Clet of Backend_var.With_provenance.t * expression * expression
+  | Clet_mut of Backend_var.With_provenance.t * machtype
+                * expression * expression
+  | Cphantom_let of Backend_var.With_provenance.t
+      * phantom_defining_expr option * expression
+  | Cassign of Backend_var.t * expression
+  | Ctuple of expression list
+  | Cop of operation * expression list * Debuginfo.t
+  | Csequence of expression * expression
+  | Cifthenelse of expression * Debuginfo.t * expression
+      * Debuginfo.t * expression * Debuginfo.t
+  | Cswitch of expression * int array * (expression * Debuginfo.t) array
+      * Debuginfo.t
+  | Ccatch of
+      rec_flag
+        * (int * (Backend_var.With_provenance.t * machtype) list
+          * expression * Debuginfo.t) list
+        * expression
+  | Cexit of int * expression list
+  | Ctrywith of expression * Backend_var.With_provenance.t * expression
+      * Debuginfo.t
+
+type codegen_option =
+  | Reduce_code_size
+  | No_CSE
+
+type fundecl =
+  { fun_name: string;
+    fun_args: (Backend_var.With_provenance.t * machtype) list;
+    fun_body: expression;
+    fun_codegen_options : codegen_option list;
+    fun_dbg : Debuginfo.t;
+  }
+
+type data_item =
+    Cdefine_symbol of string
+  | Cglobal_symbol of string
+  | Cint8 of int
+  | Cint16 of int
+  | Cint32 of nativeint
+  | Cint of nativeint
+  | Csingle of float
+  | Cdouble of float
+  | Csymbol_address of string
+  | Cstring of string
+  | Cskip of int
+  | Calign of int
+
+type phrase =
+    Cfunction of fundecl
+  | Cdata of data_item list
+
+let ccatch (i, ids, e1, e2, dbg) =
+  Ccatch(Nonrecursive, [i, ids, e2, dbg], e1)
+
+let reset () =
+  label_counter := 99
+
+let iter_shallow_tail f = function
+  | Clet(_, _, body) | Cphantom_let (_, _, body) | Clet_mut(_, _, _, body) ->
+      f body;
+      true
+  | Cifthenelse(_cond, _ifso_dbg, ifso, _ifnot_dbg, ifnot, _dbg) ->
+      f ifso;
+      f ifnot;
+      true
+  | Csequence(_e1, e2) ->
+      f e2;
+      true
+  | Cswitch(_e, _tbl, el, _dbg') ->
+      Array.iter (fun (e, _dbg) -> f e) el;
+      true
+  | Ccatch(_rec_flag, handlers, body) ->
+      List.iter (fun (_, _, h, _dbg) -> f h) handlers;
+      f body;
+      true
+  | Ctrywith(e1, _id, e2, _dbg) ->
+      f e1;
+      f e2;
+      true
+  | Cexit _ | Cop (Craise _, _, _) ->
+      true
+  | Cconst_int _
+  | Cconst_natint _
+  | Cconst_float _
+  | Cconst_symbol _
+  | Cconst_pointer _
+  | Cconst_natpointer _
+  | Cblockheader _
+  | Cvar _
+  | Cassign _
+  | Ctuple _
+  | Cop _ ->
+      false
+
+let rec map_tail f = function
+  | Clet(id, exp, body) ->
+      Clet(id, exp, map_tail f body)
+  | Clet_mut(id, kind, exp, body) ->
+      Clet_mut(id, kind, exp, map_tail f body)
+  | Cphantom_let(id, exp, body) ->
+      Cphantom_let (id, exp, map_tail f body)
+  | Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) ->
+      Cifthenelse
+        (
+          cond,
+          ifso_dbg, map_tail f ifso,
+          ifnot_dbg, map_tail f ifnot,
+          dbg
+        )
+  | Csequence(e1, e2) ->
+      Csequence(e1, map_tail f e2)
+  | Cswitch(e, tbl, el, dbg') ->
+      Cswitch(e, tbl, Array.map (fun (e, dbg) -> map_tail f e, dbg) el, dbg')
+  | Ccatch(rec_flag, handlers, body) ->
+      let map_h (n, ids, handler, dbg) = (n, ids, map_tail f handler, dbg) in
+      Ccatch(rec_flag, List.map map_h handlers, map_tail f body)
+  | Ctrywith(e1, id, e2, dbg) ->
+      Ctrywith(map_tail f e1, id, map_tail f e2, dbg)
+  | Cexit _ | Cop (Craise _, _, _) as cmm ->
+      cmm
+  | Cconst_int _
+  | Cconst_natint _
+  | Cconst_float _
+  | Cconst_symbol _
+  | Cconst_pointer _
+  | Cconst_natpointer _
+  | Cblockheader _
+  | Cvar _
+  | Cassign _
+  | Ctuple _
+  | Cop _ as c ->
+      f c
+
+let map_shallow f = function
+  | Clet (id, e1, e2) ->
+      Clet (id, f e1, f e2)
+  | Clet_mut (id, kind, e1, e2) ->
+      Clet_mut (id, kind, f e1, f e2)
+  | Cphantom_let (id, de, e) ->
+      Cphantom_let (id, de, f e)
+  | Cassign (id, e) ->
+      Cassign (id, f e)
+  | Ctuple el ->
+      Ctuple (List.map f el)
+  | Cop (op, el, dbg) ->
+      Cop (op, List.map f el, dbg)
+  | Csequence (e1, e2) ->
+      Csequence (f e1, f e2)
+  | Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) ->
+      Cifthenelse(f cond, ifso_dbg, f ifso, ifnot_dbg, f ifnot, dbg)
+  | Cswitch (e, ia, ea, dbg) ->
+      Cswitch (e, ia, Array.map (fun (e, dbg) -> f e, dbg) ea, dbg)
+  | Ccatch (rf, hl, body) ->
+      let map_h (n, ids, handler, dbg) = (n, ids, f handler, dbg) in
+      Ccatch (rf, List.map map_h hl, f body)
+  | Cexit (n, el) ->
+      Cexit (n, List.map f el)
+  | Ctrywith (e1, id, e2, dbg) ->
+      Ctrywith (f e1, id, f e2, dbg)
+  | Cconst_int _
+  | Cconst_natint _
+  | Cconst_float _
+  | Cconst_symbol _
+  | Cconst_pointer _
+  | Cconst_natpointer _
+  | Cblockheader _
+  | Cvar _
+    as c ->
+      c
diff --git a/asmcomp/cmm.mli b/asmcomp/cmm.mli
new file mode 100644
index 00000000..ad8d804e
--- /dev/null
+++ b/asmcomp/cmm.mli
@@ -0,0 +1,237 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Second intermediate language (machine independent) *)
+
+type machtype_component =
+  | Val
+  | Addr
+  | Int
+  | Float
+
+(* - [Val] denotes a valid OCaml value: either a pointer to the beginning
+     of a heap block, an infix pointer if it is preceded by the correct
+     infix header, or a 2n+1 encoded integer.
+   - [Int] is for integers (not necessarily 2n+1 encoded) and for
+     pointers outside the heap.
+   - [Addr] denotes pointers that are neither [Val] nor [Int], i.e.
+     pointers into the heap that point in the middle of a heap block.
+     Such derived pointers are produced by e.g. array indexing.
+   - [Float] is for unboxed floating-point numbers.
+
+The purpose of these types is twofold.  First, they guide register
+allocation: type [Float] goes in FP registers, the other types go
+into integer registers.  Second, they determine how local variables are
+tracked by the GC:
+   - Variables of type [Val] are GC roots.  If they are pointers, the
+     GC will not deallocate the addressed heap block, and will update
+     the local variable if the heap block moves.
+   - Variables of type [Int] and [Float] are ignored by the GC.
+     The GC does not change their values.
+   - Variables of type [Addr] must never be live across an allocation
+     point or function call.  They cannot be given as roots to the GC
+     because they don't point after a well-formed block header of the
+     kind that the GC needs.  However, the GC may move the block pointed
+     into, invalidating the value of the [Addr] variable.
+*)
+
+type machtype = machtype_component array
+
+val typ_void: machtype
+val typ_val: machtype
+val typ_addr: machtype
+val typ_int: machtype
+val typ_float: machtype
+
+(** Least upper bound of two [machtype_component]s. *)
+val lub_component
+   : machtype_component
+  -> machtype_component
+  -> machtype_component
+
+(** Returns [true] iff the first supplied [machtype_component] is greater than
+    or equal to the second under the relation used by [lub_component]. *)
+val ge_component
+   : machtype_component
+  -> machtype_component
+  -> bool
+
+type integer_comparison = Lambda.integer_comparison =
+  | Ceq | Cne | Clt | Cgt | Cle | Cge
+
+val negate_integer_comparison: integer_comparison -> integer_comparison
+val swap_integer_comparison: integer_comparison -> integer_comparison
+
+type float_comparison = Lambda.float_comparison =
+  | CFeq | CFneq | CFlt | CFnlt | CFgt | CFngt | CFle | CFnle | CFge | CFnge
+
+val negate_float_comparison: float_comparison -> float_comparison
+val swap_float_comparison: float_comparison -> float_comparison
+
+type label = int
+val new_label: unit -> label
+
+type rec_flag = Nonrecursive | Recursive
+
+type phantom_defining_expr =
+  (* CR-soon mshinwell: Convert this to [Targetint.OCaml.t] (or whatever the
+     representation of "target-width OCaml integers of type [int]"
+     becomes when merged). *)
+  | Cphantom_const_int of Targetint.t
+  (** The phantom-let-bound variable is a constant integer.
+      The argument must be the tagged representation of an integer within
+      the range of type [int] on the target.  (Analogously to [Cconst_int].) *)
+  | Cphantom_const_symbol of string
+  (** The phantom-let-bound variable is an alias for a symbol. *)
+  | Cphantom_var of Backend_var.t
+  (** The phantom-let-bound variable is an alias for another variable.  The
+      aliased variable must not be a bound by a phantom let. *)
+  | Cphantom_offset_var of { var : Backend_var.t; offset_in_words : int; }
+  (** The phantom-let-bound-variable's value is defined by adding the given
+      number of words to the pointer contained in the given identifier. *)
+  | Cphantom_read_field of { var : Backend_var.t; field : int; }
+  (** The phantom-let-bound-variable's value is found by adding the given
+      number of words to the pointer contained in the given identifier, then
+      dereferencing. *)
+  | Cphantom_read_symbol_field of { sym : string; field : int; }
+  (** As for [Uphantom_read_var_field], but with the pointer specified by
+      a symbol. *)
+  | Cphantom_block of { tag : int; fields : Backend_var.t list; }
+  (** The phantom-let-bound variable points at a block with the given
+      structure. *)
+
+type memory_chunk =
+    Byte_unsigned
+  | Byte_signed
+  | Sixteen_unsigned
+  | Sixteen_signed
+  | Thirtytwo_unsigned
+  | Thirtytwo_signed
+  | Word_int                           (* integer or pointer outside heap *)
+  | Word_val                           (* pointer inside heap or encoded int *)
+  | Single
+  | Double                             (* 64-bit-aligned 64-bit float *)
+  | Double_u                           (* word-aligned 64-bit float *)
+
+and operation =
+    Capply of machtype
+  | Cextcall of string * machtype * bool * label option
+  | Cload of memory_chunk * Asttypes.mutable_flag
+  | Calloc
+  | Cstore of memory_chunk * Lambda.initialization_or_assignment
+  | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
+  | Cand | Cor | Cxor | Clsl | Clsr | Casr
+  | Ccmpi of integer_comparison
+  | Caddv (* pointer addition that produces a [Val] (well-formed Caml value) *)
+  | Cadda (* pointer addition that produces a [Addr] (derived heap pointer) *)
+  | Ccmpa of integer_comparison
+  | Cnegf | Cabsf
+  | Caddf | Csubf | Cmulf | Cdivf
+  | Cfloatofint | Cintoffloat
+  | Ccmpf of float_comparison
+  | Craise of Lambda.raise_kind
+  | Ccheckbound (* Takes two arguments : first the bound to check against,
+                   then the index.
+                   It results in a bounds error if the index is greater than
+                   or equal to the bound. *)
+
+(** Every basic block should have a corresponding [Debuginfo.t] for its
+    beginning. *)
+and expression =
+    Cconst_int of int * Debuginfo.t
+  | Cconst_natint of nativeint * Debuginfo.t
+  | Cconst_float of float * Debuginfo.t
+  | Cconst_symbol of string * Debuginfo.t
+  | Cconst_pointer of int * Debuginfo.t
+  | Cconst_natpointer of nativeint * Debuginfo.t
+  | Cblockheader of nativeint * Debuginfo.t
+  | Cvar of Backend_var.t
+  | Clet of Backend_var.With_provenance.t * expression * expression
+  | Clet_mut of Backend_var.With_provenance.t * machtype
+                * expression * expression
+  | Cphantom_let of Backend_var.With_provenance.t
+      * phantom_defining_expr option * expression
+  (* Cassign must refer to a variable bound by Clet_mut *)
+  | Cassign of Backend_var.t * expression
+  | Ctuple of expression list
+  | Cop of operation * expression list * Debuginfo.t
+  | Csequence of expression * expression
+  | Cifthenelse of expression * Debuginfo.t * expression
+      * Debuginfo.t * expression * Debuginfo.t
+  | Cswitch of expression * int array * (expression * Debuginfo.t) array
+      * Debuginfo.t
+  | Ccatch of
+      rec_flag
+        * (int * (Backend_var.With_provenance.t * machtype) list
+          * expression * Debuginfo.t) list
+        * expression
+  | Cexit of int * expression list
+  | Ctrywith of expression * Backend_var.With_provenance.t * expression
+      * Debuginfo.t
+
+type codegen_option =
+  | Reduce_code_size
+  | No_CSE
+
+type fundecl =
+  { fun_name: string;
+    fun_args: (Backend_var.With_provenance.t * machtype) list;
+    fun_body: expression;
+    fun_codegen_options : codegen_option list;
+    fun_dbg : Debuginfo.t;
+  }
+
+type data_item =
+    Cdefine_symbol of string
+  | Cglobal_symbol of string
+  | Cint8 of int
+  | Cint16 of int
+  | Cint32 of nativeint
+  | Cint of nativeint
+  | Csingle of float
+  | Cdouble of float
+  | Csymbol_address of string
+  | Cstring of string
+  | Cskip of int
+  | Calign of int
+
+type phrase =
+    Cfunction of fundecl
+  | Cdata of data_item list
+
+val ccatch :
+     int * (Backend_var.With_provenance.t * machtype) list
+       * expression * expression * Debuginfo.t
+  -> expression
+
+val reset : unit -> unit
+
+val iter_shallow_tail: (expression -> unit) -> expression -> bool
+  (** Either apply the callback to all immediate sub-expressions that
+      can produce the final result for the expression and return
+      [true], or do nothing and return [false].  Note that the notion
+      of "tail" sub-expression used here does not match the one used
+      to trigger tail calls; in particular, try...with handlers are
+      considered to be in tail position (because their result become
+      the final result for the expression).  *)
+
+val map_tail: (expression -> expression) -> expression -> expression
+  (** Apply the transformation to an expression, trying to push it
+      to all inner sub-expressions that can produce the final result.
+      Same disclaimer as for [iter_shallow_tail] about the notion
+      of "tail" sub-expression. *)
+
+val map_shallow: (expression -> expression) -> expression -> expression
+  (** Apply the transformation to each immediate sub-expression. *)
diff --git a/asmcomp/cmm_helpers.ml b/asmcomp/cmm_helpers.ml
new file mode 100644
index 00000000..ff4b794e
--- /dev/null
+++ b/asmcomp/cmm_helpers.ml
@@ -0,0 +1,2792 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-40-41-42-44-45"]
+
+module V = Backend_var
+module VP = Backend_var.With_provenance
+open Cmm
+open Arch
+
+(* Local binding of complex expressions *)
+
+let bind name arg fn =
+  match arg with
+    Cvar _ | Cconst_int _ | Cconst_natint _ | Cconst_symbol _
+  | Cconst_pointer _ | Cconst_natpointer _
+  | Cblockheader _ -> fn arg
+  | _ -> let id = V.create_local name in Clet(VP.create id, arg, fn (Cvar id))
+
+let bind_load name arg fn =
+  match arg with
+  | Cop(Cload _, [Cvar _], _) -> fn arg
+  | _ -> bind name arg fn
+
+let bind_nonvar name arg fn =
+  match arg with
+    Cconst_int _ | Cconst_natint _ | Cconst_symbol _
+  | Cconst_pointer _ | Cconst_natpointer _
+  | Cblockheader _ -> fn arg
+  | _ -> let id = V.create_local name in Clet(VP.create id, arg, fn (Cvar id))
+
+let caml_black = Nativeint.shift_left (Nativeint.of_int 3) 8
+    (* cf. runtime/caml/gc.h *)
+
+(* Block headers. Meaning of the tag field: see stdlib/obj.ml *)
+
+let floatarray_tag dbg = Cconst_int (Obj.double_array_tag, dbg)
+
+let block_header tag sz =
+  Nativeint.add (Nativeint.shift_left (Nativeint.of_int sz) 10)
+                (Nativeint.of_int tag)
+(* Static data corresponding to "value"s must be marked black in case we are
+   in no-naked-pointers mode.  See [caml_darken] and the code below that emits
+   structured constants and static module definitions. *)
+let black_block_header tag sz = Nativeint.logor (block_header tag sz) caml_black
+let white_closure_header sz = block_header Obj.closure_tag sz
+let black_closure_header sz = black_block_header Obj.closure_tag sz
+let infix_header ofs = block_header Obj.infix_tag ofs
+let float_header = block_header Obj.double_tag (size_float / size_addr)
+let floatarray_header len =
+  (* Zero-sized float arrays have tag zero for consistency with
+     [caml_alloc_float_array]. *)
+  assert (len >= 0);
+  if len = 0 then block_header 0 0
+  else block_header Obj.double_array_tag (len * size_float / size_addr)
+let string_header len =
+      block_header Obj.string_tag ((len + size_addr) / size_addr)
+let boxedint32_header = block_header Obj.custom_tag 2
+let boxedint64_header = block_header Obj.custom_tag (1 + 8 / size_addr)
+let boxedintnat_header = block_header Obj.custom_tag 2
+let caml_nativeint_ops = "caml_nativeint_ops"
+let caml_int32_ops = "caml_int32_ops"
+let caml_int64_ops = "caml_int64_ops"
+
+
+let alloc_float_header dbg = Cblockheader (float_header, dbg)
+let alloc_floatarray_header len dbg = Cblockheader (floatarray_header len, dbg)
+let alloc_closure_header sz dbg = Cblockheader (white_closure_header sz, dbg)
+let alloc_infix_header ofs dbg = Cblockheader (infix_header ofs, dbg)
+let alloc_boxedint32_header dbg = Cblockheader (boxedint32_header, dbg)
+let alloc_boxedint64_header dbg = Cblockheader (boxedint64_header, dbg)
+let alloc_boxedintnat_header dbg = Cblockheader (boxedintnat_header, dbg)
+
+(* Integers *)
+
+let max_repr_int = max_int asr 1
+let min_repr_int = min_int asr 1
+
+let int_const dbg n =
+  if n <= max_repr_int && n >= min_repr_int
+  then Cconst_int((n lsl 1) + 1, dbg)
+  else Cconst_natint
+          (Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n, dbg)
+
+let natint_const_untagged dbg n =
+  if n > Nativeint.of_int max_int
+  || n < Nativeint.of_int min_int
+  then Cconst_natint (n,dbg)
+  else Cconst_int (Nativeint.to_int n, dbg)
+
+let cint_const n =
+  Cint(Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n)
+
+let targetint_const n =
+  Targetint.add (Targetint.shift_left (Targetint.of_int n) 1)
+    Targetint.one
+
+let add_no_overflow n x c dbg =
+  let d = n + x in
+  if d = 0 then c else Cop(Caddi, [c; Cconst_int (d, dbg)], dbg)
+
+let rec add_const c n dbg =
+  if n = 0 then c
+  else match c with
+  | Cconst_int (x, _) when Misc.no_overflow_add x n -> Cconst_int (x + n, dbg)
+  | Cop(Caddi, [Cconst_int (x, _); c], _)
+    when Misc.no_overflow_add n x ->
+      add_no_overflow n x c dbg
+  | Cop(Caddi, [c; Cconst_int (x, _)], _)
+    when Misc.no_overflow_add n x ->
+      add_no_overflow n x c dbg
+  | Cop(Csubi, [Cconst_int (x, _); c], _) when Misc.no_overflow_add n x ->
+      Cop(Csubi, [Cconst_int (n + x, dbg); c], dbg)
+  | Cop(Csubi, [c; Cconst_int (x, _)], _) when Misc.no_overflow_sub n x ->
+      add_const c (n - x) dbg
+  | c -> Cop(Caddi, [c; Cconst_int (n, dbg)], dbg)
+
+let incr_int c dbg = add_const c 1 dbg
+let decr_int c dbg = add_const c (-1) dbg
+
+let rec add_int c1 c2 dbg =
+  match (c1, c2) with
+  | (Cconst_int (n, _), c) | (c, Cconst_int (n, _)) ->
+      add_const c n dbg
+  | (Cop(Caddi, [c1; Cconst_int (n1, _)], _), c2) ->
+      add_const (add_int c1 c2 dbg) n1 dbg
+  | (c1, Cop(Caddi, [c2; Cconst_int (n2, _)], _)) ->
+      add_const (add_int c1 c2 dbg) n2 dbg
+  | (_, _) ->
+      Cop(Caddi, [c1; c2], dbg)
+
+let rec sub_int c1 c2 dbg =
+  match (c1, c2) with
+  | (c1, Cconst_int (n2, _)) when n2 <> min_int ->
+      add_const c1 (-n2) dbg
+  | (c1, Cop(Caddi, [c2; Cconst_int (n2, _)], _)) when n2 <> min_int ->
+      add_const (sub_int c1 c2 dbg) (-n2) dbg
+  | (Cop(Caddi, [c1; Cconst_int (n1, _)], _), c2) ->
+      add_const (sub_int c1 c2 dbg) n1 dbg
+  | (c1, c2) ->
+      Cop(Csubi, [c1; c2], dbg)
+
+let rec lsl_int c1 c2 dbg =
+  match (c1, c2) with
+  | (Cop(Clsl, [c; Cconst_int (n1, _)], _), Cconst_int (n2, _))
+    when n1 > 0 && n2 > 0 && n1 + n2 < size_int * 8 ->
+      Cop(Clsl, [c; Cconst_int (n1 + n2, dbg)], dbg)
+  | (Cop(Caddi, [c1; Cconst_int (n1, _)], _), Cconst_int (n2, _))
+    when Misc.no_overflow_lsl n1 n2 ->
+      add_const (lsl_int c1 c2 dbg) (n1 lsl n2) dbg
+  | (_, _) ->
+      Cop(Clsl, [c1; c2], dbg)
+
+let is_power2 n = n = 1 lsl Misc.log2 n
+
+and mult_power2 c n dbg = lsl_int c (Cconst_int (Misc.log2 n, dbg)) dbg
+
+let rec mul_int c1 c2 dbg =
+  match (c1, c2) with
+  | (c, Cconst_int (0, _)) | (Cconst_int (0, _), c) ->
+      Csequence (c, Cconst_int (0, dbg))
+  | (c, Cconst_int (1, _)) | (Cconst_int (1, _), c) ->
+      c
+  | (c, Cconst_int(-1, _)) | (Cconst_int(-1, _), c) ->
+      sub_int (Cconst_int (0, dbg)) c dbg
+  | (c, Cconst_int (n, _)) when is_power2 n -> mult_power2 c n dbg
+  | (Cconst_int (n, _), c) when is_power2 n -> mult_power2 c n dbg
+  | (Cop(Caddi, [c; Cconst_int (n, _)], _), Cconst_int (k, _)) |
+    (Cconst_int (k, _), Cop(Caddi, [c; Cconst_int (n, _)], _))
+    when Misc.no_overflow_mul n k ->
+      add_const (mul_int c (Cconst_int (k, dbg)) dbg) (n * k) dbg
+  | (c1, c2) ->
+      Cop(Cmuli, [c1; c2], dbg)
+
+
+let ignore_low_bit_int = function
+    Cop(Caddi,
+        [(Cop(Clsl, [_; Cconst_int (n, _)], _) as c); Cconst_int (1, _)], _)
+      when n > 0
+      -> c
+  | Cop(Cor, [c; Cconst_int (1, _)], _) -> c
+  | c -> c
+
+(* removes the 1-bit sign-extension left by untag_int (tag_int c) *)
+let ignore_high_bit_int = function
+    Cop(Casr,
+        [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], _) -> c
+  | c -> c
+
+let lsr_int c1 c2 dbg =
+  match c2 with
+    Cconst_int (0, _) ->
+      c1
+  | Cconst_int (n, _) when n > 0 ->
+      Cop(Clsr, [ignore_low_bit_int c1; c2], dbg)
+  | _ ->
+      Cop(Clsr, [c1; c2], dbg)
+
+let asr_int c1 c2 dbg =
+  match c2 with
+    Cconst_int (0, _) ->
+      c1
+  | Cconst_int (n, _) when n > 0 ->
+      Cop(Casr, [ignore_low_bit_int c1; c2], dbg)
+  | _ ->
+      Cop(Casr, [c1; c2], dbg)
+
+let tag_int i dbg =
+  match i with
+    Cconst_int (n, _) ->
+      int_const dbg n
+  | Cop(Casr, [c; Cconst_int (n, _)], _) when n > 0 ->
+      Cop(Cor,
+        [asr_int c (Cconst_int (n - 1, dbg)) dbg; Cconst_int (1, dbg)],
+        dbg)
+  | c ->
+      incr_int (lsl_int c (Cconst_int (1, dbg)) dbg) dbg
+
+let untag_int i dbg =
+  match i with
+    Cconst_int (n, _) -> Cconst_int(n asr 1, dbg)
+  | Cop(Cor, [Cop(Casr, [c; Cconst_int (n, _)], _); Cconst_int (1, _)], _)
+    when n > 0 && n < size_int * 8 ->
+      Cop(Casr, [c; Cconst_int (n+1, dbg)], dbg)
+  | Cop(Cor, [Cop(Clsr, [c; Cconst_int (n, _)], _); Cconst_int (1, _)], _)
+    when n > 0 && n < size_int * 8 ->
+      Cop(Clsr, [c; Cconst_int (n+1, dbg)], dbg)
+  | c -> asr_int c (Cconst_int (1, dbg)) dbg
+
+let mk_if_then_else dbg cond ifso_dbg ifso ifnot_dbg ifnot =
+  match cond with
+  | Cconst_int (0, _) -> ifnot
+  | Cconst_int (1, _) -> ifso
+  | _ ->
+    Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg)
+
+let mk_not dbg cmm =
+  match cmm with
+  | Cop(Caddi,
+        [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], dbg') ->
+    begin
+      match c with
+      | Cop(Ccmpi cmp, [c1; c2], dbg'') ->
+          tag_int
+            (Cop(Ccmpi (negate_integer_comparison cmp), [c1; c2], dbg'')) dbg'
+      | Cop(Ccmpa cmp, [c1; c2], dbg'') ->
+          tag_int
+            (Cop(Ccmpa (negate_integer_comparison cmp), [c1; c2], dbg'')) dbg'
+      | Cop(Ccmpf cmp, [c1; c2], dbg'') ->
+          tag_int
+            (Cop(Ccmpf (negate_float_comparison cmp), [c1; c2], dbg'')) dbg'
+      | _ ->
+        (* 0 -> 3, 1 -> 1 *)
+        Cop(Csubi,
+            [Cconst_int (3, dbg); Cop(Clsl, [c; Cconst_int (1, dbg)], dbg)],
+            dbg)
+    end
+  | Cconst_int (3, _) -> Cconst_int (1, dbg)
+  | Cconst_int (1, _) -> Cconst_int (3, dbg)
+  | c ->
+      (* 1 -> 3, 3 -> 1 *)
+      Cop(Csubi, [Cconst_int (4, dbg); c], dbg)
+
+let mk_compare_ints dbg a1 a2 =
+  match (a1,a2) with
+  | Cconst_int (c1, _), Cconst_int (c2, _) ->
+     int_const dbg (Int.compare c1 c2)
+  | Cconst_natint (c1, _), Cconst_natint (c2, _) ->
+     int_const dbg (Nativeint.compare c1 c2)
+  | Cconst_int (c1, _), Cconst_natint (c2, _) ->
+     int_const dbg Nativeint.(compare (of_int c1) c2)
+  | Cconst_natint (c1, _), Cconst_int (c2, _) ->
+     int_const dbg Nativeint.(compare c1 (of_int c2))
+  | a1, a2 -> begin
+      bind "int_cmp" a1 (fun a1 ->
+        bind "int_cmp" a2 (fun a2 ->
+          let op1 = Cop(Ccmpi(Cgt), [a1; a2], dbg) in
+          let op2 = Cop(Ccmpi(Clt), [a1; a2], dbg) in
+          tag_int(sub_int op1 op2 dbg) dbg))
+    end
+
+let mk_compare_floats dbg a1 a2 =
+  bind "float_cmp" a1 (fun a1 ->
+    bind "float_cmp" a2 (fun a2 ->
+      let op1 = Cop(Ccmpf(CFgt), [a1; a2], dbg) in
+      let op2 = Cop(Ccmpf(CFlt), [a1; a2], dbg) in
+      let op3 = Cop(Ccmpf(CFeq), [a1; a1], dbg) in
+      let op4 = Cop(Ccmpf(CFeq), [a2; a2], dbg) in
+      (* If both operands a1 and a2 are not NaN, then op3 = op4 = 1,
+         and the result is op1 - op2.
+         If at least one of the operands is NaN,
+         then op1 = op2 = 0, and the result is op3 - op4,
+         which orders NaN before other values.
+         To detect if the operand is NaN, we use the property:
+         for all x, NaN is not equal to x, even if x is NaN.
+         Therefore, op3 is 0 if and only if a1 is NaN,
+         and op4 is 0 if and only if a2 is NaN.
+         See also caml_float_compare_unboxed in runtime/floats.c  *)
+      tag_int (add_int (sub_int op1 op2 dbg) (sub_int op3 op4 dbg) dbg) dbg))
+
+let create_loop body dbg =
+  let cont = Lambda.next_raise_count () in
+  let call_cont = Cexit (cont, []) in
+  let body = Csequence (body, call_cont) in
+  Ccatch (Recursive, [cont, [], body, dbg], call_cont)
+
+(* Turning integer divisions into multiply-high then shift.
+   The [division_parameters] function is used in module Emit for
+   those target platforms that support this optimization. *)
+
+(* Unsigned comparison between native integers. *)
+
+let ucompare x y = Nativeint.(compare (add x min_int) (add y min_int))
+
+(* Unsigned division and modulus at type nativeint.
+   Algorithm: Hacker's Delight section 9.3 *)
+
+let udivmod n d = Nativeint.(
+  if d < 0n then
+    if ucompare n d < 0 then (0n, n) else (1n, sub n d)
+  else begin
+    let q = shift_left (div (shift_right_logical n 1) d) 1 in
+    let r = sub n (mul q d) in
+    if ucompare r d >= 0 then (succ q, sub r d) else (q, r)
+  end)
+
+(* Compute division parameters.
+   Algorithm: Hacker's Delight chapter 10, fig 10-1. *)
+
+let divimm_parameters d = Nativeint.(
+  assert (d > 0n);
+  let twopsm1 = min_int in (* 2^31 for 32-bit archs, 2^63 for 64-bit archs *)
+  let nc = sub (pred twopsm1) (snd (udivmod twopsm1 d)) in
+  let rec loop p (q1, r1) (q2, r2) =
+    let p = p + 1 in
+    let q1 = shift_left q1 1 and r1 = shift_left r1 1 in
+    let (q1, r1) =
+      if ucompare r1 nc >= 0 then (succ q1, sub r1 nc) else (q1, r1) in
+    let q2 = shift_left q2 1 and r2 = shift_left r2 1 in
+    let (q2, r2) =
+      if ucompare r2 d >= 0 then (succ q2, sub r2 d) else (q2, r2) in
+    let delta = sub d r2 in
+    if ucompare q1 delta < 0 || (q1 = delta && r1 = 0n)
+    then loop p (q1, r1) (q2, r2)
+    else (succ q2, p - size)
+  in loop (size - 1) (udivmod twopsm1 nc) (udivmod twopsm1 d))
+
+(* The result [(m, p)] of [divimm_parameters d] satisfies the following
+   inequality:
+
+      2^(wordsize + p) < m * d <= 2^(wordsize + p) + 2^(p + 1)    (i)
+
+   from which it follows that
+
+      floor(n / d) = floor(n * m / 2^(wordsize+p))
+                              if 0 <= n < 2^(wordsize-1)
+      ceil(n / d) = floor(n * m / 2^(wordsize+p)) + 1
+                              if -2^(wordsize-1) <= n < 0
+
+   The correctness condition (i) above can be checked by the code below.
+   It was exhaustively tested for values of d from 2 to 10^9 in the
+   wordsize = 64 case.
+
+let add2 (xh, xl) (yh, yl) =
+  let zl = add xl yl and zh = add xh yh in
+  ((if ucompare zl xl < 0 then succ zh else zh), zl)
+
+let shl2 (xh, xl) n =
+  assert (0 < n && n < size + size);
+  if n < size
+  then (logor (shift_left xh n) (shift_right_logical xl (size - n)),
+        shift_left xl n)
+  else (shift_left xl (n - size), 0n)
+
+let mul2 x y =
+  let halfsize = size / 2 in
+  let halfmask = pred (shift_left 1n halfsize) in
+  let xl = logand x halfmask and xh = shift_right_logical x halfsize in
+  let yl = logand y halfmask and yh = shift_right_logical y halfsize in
+  add2 (mul xh yh, 0n)
+    (add2 (shl2 (0n, mul xl yh) halfsize)
+       (add2 (shl2 (0n, mul xh yl) halfsize)
+          (0n, mul xl yl)))
+
+let ucompare2 (xh, xl) (yh, yl) =
+  let c = ucompare xh yh in if c = 0 then ucompare xl yl else c
+
+let validate d m p =
+  let md = mul2 m d in
+  let one2 = (0n, 1n) in
+  let twoszp = shl2 one2 (size + p) in
+  let twop1 = shl2 one2 (p + 1) in
+  ucompare2 twoszp md < 0 && ucompare2 md (add2 twoszp twop1) <= 0
+*)
+
+let raise_symbol dbg symb =
+  Cop(Craise Lambda.Raise_regular, [Cconst_symbol (symb, dbg)], dbg)
+
+let rec div_int c1 c2 is_safe dbg =
+  match (c1, c2) with
+    (c1, Cconst_int (0, _)) ->
+      Csequence(c1, raise_symbol dbg "caml_exn_Division_by_zero")
+  | (c1, Cconst_int (1, _)) ->
+      c1
+  | (Cconst_int (n1, _), Cconst_int (n2, _)) ->
+      Cconst_int (n1 / n2, dbg)
+  | (c1, Cconst_int (n, _)) when n <> min_int ->
+      let l = Misc.log2 n in
+      if n = 1 lsl l then
+        (* Algorithm:
+              t = shift-right-signed(c1, l - 1)
+              t = shift-right(t, W - l)
+              t = c1 + t
+              res = shift-right-signed(c1 + t, l)
+        *)
+        Cop(Casr, [bind "dividend" c1 (fun c1 ->
+                     let t = asr_int c1 (Cconst_int (l - 1, dbg)) dbg in
+                     let t =
+                       lsr_int t (Cconst_int (Nativeint.size - l, dbg)) dbg
+                     in
+                     add_int c1 t dbg);
+                   Cconst_int (l, dbg)], dbg)
+      else if n < 0 then
+        sub_int (Cconst_int (0, dbg))
+          (div_int c1 (Cconst_int (-n, dbg)) is_safe dbg)
+          dbg
+      else begin
+        let (m, p) = divimm_parameters (Nativeint.of_int n) in
+        (* Algorithm:
+              t = multiply-high-signed(c1, m)
+              if m < 0, t = t + c1
+              if p > 0, t = shift-right-signed(t, p)
+              res = t + sign-bit(c1)
+        *)
+        bind "dividend" c1 (fun c1 ->
+          let t = Cop(Cmulhi, [c1; Cconst_natint (m, dbg)], dbg) in
+          let t = if m < 0n then Cop(Caddi, [t; c1], dbg) else t in
+          let t =
+            if p > 0 then Cop(Casr, [t; Cconst_int (p, dbg)], dbg) else t
+          in
+          add_int t (lsr_int c1 (Cconst_int (Nativeint.size - 1, dbg)) dbg) dbg)
+      end
+  | (c1, c2) when !Clflags.unsafe || is_safe = Lambda.Unsafe ->
+      Cop(Cdivi, [c1; c2], dbg)
+  | (c1, c2) ->
+      bind "divisor" c2 (fun c2 ->
+        bind "dividend" c1 (fun c1 ->
+          Cifthenelse(c2,
+                      dbg,
+                      Cop(Cdivi, [c1; c2], dbg),
+                      dbg,
+                      raise_symbol dbg "caml_exn_Division_by_zero",
+                      dbg)))
+
+let mod_int c1 c2 is_safe dbg =
+  match (c1, c2) with
+    (c1, Cconst_int (0, _)) ->
+      Csequence(c1, raise_symbol dbg "caml_exn_Division_by_zero")
+  | (c1, Cconst_int ((1 | (-1)), _)) ->
+      Csequence(c1, Cconst_int (0, dbg))
+  | (Cconst_int (n1, _), Cconst_int (n2, _)) ->
+      Cconst_int (n1 mod n2, dbg)
+  | (c1, (Cconst_int (n, _) as c2)) when n <> min_int ->
+      let l = Misc.log2 n in
+      if n = 1 lsl l then
+        (* Algorithm:
+              t = shift-right-signed(c1, l - 1)
+              t = shift-right(t, W - l)
+              t = c1 + t
+              t = bit-and(t, -n)
+              res = c1 - t
+         *)
+        bind "dividend" c1 (fun c1 ->
+          let t = asr_int c1 (Cconst_int (l - 1, dbg)) dbg in
+          let t = lsr_int t (Cconst_int (Nativeint.size - l, dbg)) dbg in
+          let t = add_int c1 t dbg in
+          let t = Cop(Cand, [t; Cconst_int (-n, dbg)], dbg) in
+          sub_int c1 t dbg)
+      else
+        bind "dividend" c1 (fun c1 ->
+          sub_int c1 (mul_int (div_int c1 c2 is_safe dbg) c2 dbg) dbg)
+  | (c1, c2) when !Clflags.unsafe || is_safe = Lambda.Unsafe ->
+      (* Flambda already generates that test *)
+      Cop(Cmodi, [c1; c2], dbg)
+  | (c1, c2) ->
+      bind "divisor" c2 (fun c2 ->
+        bind "dividend" c1 (fun c1 ->
+          Cifthenelse(c2,
+                      dbg,
+                      Cop(Cmodi, [c1; c2], dbg),
+                      dbg,
+                      raise_symbol dbg "caml_exn_Division_by_zero",
+                      dbg)))
+
+(* Division or modulo on boxed integers.  The overflow case min_int / -1
+   can occur, in which case we force x / -1 = -x and x mod -1 = 0. (PR#5513). *)
+
+let is_different_from x = function
+    Cconst_int (n, _) -> n <> x
+  | Cconst_natint (n, _) -> n <> Nativeint.of_int x
+  | _ -> false
+
+let safe_divmod_bi mkop is_safe mkm1 c1 c2 bi dbg =
+  bind "dividend" c1 (fun c1 ->
+  bind "divisor" c2 (fun c2 ->
+    let c = mkop c1 c2 is_safe dbg in
+    if Arch.division_crashes_on_overflow
+    && (size_int = 4 || bi <> Primitive.Pint32)
+    && not (is_different_from (-1) c2)
+    then
+      Cifthenelse(Cop(Ccmpi Cne, [c2; Cconst_int (-1, dbg)], dbg),
+        dbg, c,
+        dbg, mkm1 c1 dbg,
+        dbg)
+    else
+      c))
+
+let safe_div_bi is_safe =
+  safe_divmod_bi div_int is_safe
+    (fun c1 dbg -> Cop(Csubi, [Cconst_int (0, dbg); c1], dbg))
+
+let safe_mod_bi is_safe =
+  safe_divmod_bi mod_int is_safe (fun _ dbg -> Cconst_int (0, dbg))
+
+(* Bool *)
+
+let test_bool dbg cmm =
+  match cmm with
+  | Cop(Caddi, [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], _) ->
+      c
+  | Cconst_int (n, dbg) ->
+      if n = 1 then
+        Cconst_int (0, dbg)
+      else
+        Cconst_int (1, dbg)
+  | c -> Cop(Ccmpi Cne, [c; Cconst_int (1, dbg)], dbg)
+
+(* Float *)
+
+let box_float dbg c = Cop(Calloc, [alloc_float_header dbg; c], dbg)
+
+let unbox_float dbg =
+  map_tail
+    (function
+      | Cop(Calloc, [Cblockheader (hdr, _); c], _)
+        when Nativeint.equal hdr float_header ->
+          c
+      | Cconst_symbol (s, _dbg) as cmm ->
+          begin match Cmmgen_state.structured_constant_of_sym s with
+          | Some (Uconst_float x) ->
+              Cconst_float (x, dbg) (* or keep _dbg? *)
+          | _ ->
+              Cop(Cload (Double_u, Immutable), [cmm], dbg)
+          end
+      | cmm -> Cop(Cload (Double_u, Immutable), [cmm], dbg)
+    )
+
+(* Complex *)
+
+let box_complex dbg c_re c_im =
+  Cop(Calloc, [alloc_floatarray_header 2 dbg; c_re; c_im], dbg)
+
+let complex_re c dbg = Cop(Cload (Double_u, Immutable), [c], dbg)
+let complex_im c dbg = Cop(Cload (Double_u, Immutable),
+                        [Cop(Cadda, [c; Cconst_int (size_float, dbg)], dbg)],
+                        dbg)
+
+(* Unit *)
+
+let return_unit dbg c = Csequence(c, Cconst_pointer (1, dbg))
+
+let rec remove_unit = function
+    Cconst_pointer (1, _) -> Ctuple []
+  | Csequence(c, Cconst_pointer (1, _)) -> c
+  | Csequence(c1, c2) ->
+      Csequence(c1, remove_unit c2)
+  | Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) ->
+      Cifthenelse(cond,
+        ifso_dbg, remove_unit ifso,
+        ifnot_dbg,
+        remove_unit ifnot, dbg)
+  | Cswitch(sel, index, cases, dbg) ->
+      Cswitch(sel, index,
+        Array.map (fun (case, dbg) -> remove_unit case, dbg) cases,
+        dbg)
+  | Ccatch(rec_flag, handlers, body) ->
+      let map_h (n, ids, handler, dbg) = (n, ids, remove_unit handler, dbg) in
+      Ccatch(rec_flag, List.map map_h handlers, remove_unit body)
+  | Ctrywith(body, exn, handler, dbg) ->
+      Ctrywith(remove_unit body, exn, remove_unit handler, dbg)
+  | Clet(id, c1, c2) ->
+      Clet(id, c1, remove_unit c2)
+  | Cop(Capply _mty, args, dbg) ->
+      Cop(Capply typ_void, args, dbg)
+  | Cop(Cextcall(proc, _mty, alloc, label_after), args, dbg) ->
+      Cop(Cextcall(proc, typ_void, alloc, label_after), args, dbg)
+  | Cexit (_,_) as c -> c
+  | Ctuple [] as c -> c
+  | c -> Csequence(c, Ctuple [])
+
+(* Access to block fields *)
+
+let field_address ptr n dbg =
+  if n = 0
+  then ptr
+  else Cop(Cadda, [ptr; Cconst_int(n * size_addr, dbg)], dbg)
+
+let get_field_gen mut ptr n dbg =
+  Cop(Cload (Word_val, mut), [field_address ptr n dbg], dbg)
+
+let set_field ptr n newval init dbg =
+  Cop(Cstore (Word_val, init), [field_address ptr n dbg; newval], dbg)
+
+let non_profinfo_mask =
+  if Config.profinfo
+  then (1 lsl (64 - Config.profinfo_width)) - 1
+  else 0 (* [non_profinfo_mask] is unused in this case *)
+
+let get_header ptr dbg =
+  (* We cannot deem this as [Immutable] due to the presence of [Obj.truncate]
+     and [Obj.set_tag]. *)
+  Cop(Cload (Word_int, Mutable),
+    [Cop(Cadda, [ptr; Cconst_int(-size_int, dbg)], dbg)], dbg)
+
+let get_header_without_profinfo ptr dbg =
+  if Config.profinfo then
+    Cop(Cand, [get_header ptr dbg; Cconst_int (non_profinfo_mask, dbg)], dbg)
+  else
+    get_header ptr dbg
+
+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(Cload (Byte_unsigned, Mutable),
+        [Cop(Cadda, [ptr; Cconst_int(tag_offset, dbg)], dbg)], dbg)
+
+let get_size ptr dbg =
+  Cop(Clsr, [get_header_without_profinfo ptr dbg; Cconst_int (10, dbg)], dbg)
+
+(* Array indexing *)
+
+let log2_size_addr = Misc.log2 size_addr
+let log2_size_float = Misc.log2 size_float
+
+let wordsize_shift = 9
+let numfloat_shift = 9 + log2_size_float - log2_size_addr
+
+let is_addr_array_hdr hdr dbg =
+  Cop(Ccmpi Cne,
+    [Cop(Cand, [hdr; Cconst_int (255, dbg)], dbg); floatarray_tag dbg],
+    dbg)
+
+let is_addr_array_ptr ptr dbg =
+  Cop(Ccmpi Cne, [get_tag ptr dbg; floatarray_tag dbg], dbg)
+
+let addr_array_length_shifted hdr dbg =
+  Cop(Clsr, [hdr; Cconst_int (wordsize_shift, dbg)], dbg)
+let float_array_length_shifted hdr dbg =
+  Cop(Clsr, [hdr; Cconst_int (numfloat_shift, dbg)], dbg)
+
+let lsl_const c n dbg =
+  if n = 0 then c
+  else Cop(Clsl, [c; Cconst_int (n, dbg)], dbg)
+
+(* Produces a pointer to the element of the array [ptr] on the position [ofs]
+   with the given element [log2size] log2 element size. [ofs] is given as a
+   tagged int expression.
+   The optional ?typ argument is the C-- type of the result.
+   By default, it is Addr, meaning we are constructing a derived pointer
+   into the heap.  If we know the pointer is outside the heap
+   (this is the case for bigarray indexing), we give type Int instead. *)
+
+let array_indexing ?typ log2size ptr ofs dbg =
+  let add =
+    match typ with
+    | None | Some Addr -> Cadda
+    | Some Int -> Caddi
+    | _ -> assert false in
+  match ofs with
+  | Cconst_int (n, _) ->
+      let i = n asr 1 in
+      if i = 0 then ptr
+      else Cop(add, [ptr; Cconst_int(i lsl log2size, dbg)], dbg)
+  | Cop(Caddi,
+        [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], dbg') ->
+      Cop(add, [ptr; lsl_const c log2size dbg], dbg')
+  | Cop(Caddi, [c; Cconst_int (n, _)], dbg') when log2size = 0 ->
+      Cop(add,
+        [Cop(add, [ptr; untag_int c dbg], dbg); Cconst_int (n asr 1, dbg)],
+        dbg')
+  | Cop(Caddi, [c; Cconst_int (n, _)], _) ->
+      Cop(add, [Cop(add, [ptr; lsl_const c (log2size - 1) dbg], dbg);
+                    Cconst_int((n-1) lsl (log2size - 1), dbg)], dbg)
+  | _ when log2size = 0 ->
+      Cop(add, [ptr; untag_int ofs dbg], dbg)
+  | _ ->
+      Cop(add, [Cop(add, [ptr; lsl_const ofs (log2size - 1) dbg], dbg);
+                    Cconst_int((-1) lsl (log2size - 1), dbg)], dbg)
+
+let addr_array_ref arr ofs dbg =
+  Cop(Cload (Word_val, Mutable),
+    [array_indexing log2_size_addr arr ofs dbg], dbg)
+let int_array_ref arr ofs dbg =
+  Cop(Cload (Word_int, Mutable),
+    [array_indexing log2_size_addr arr ofs dbg], dbg)
+let unboxed_float_array_ref arr ofs dbg =
+  Cop(Cload (Double_u, Mutable),
+    [array_indexing log2_size_float arr ofs dbg], dbg)
+let float_array_ref arr ofs dbg =
+  box_float dbg (unboxed_float_array_ref arr ofs dbg)
+
+let addr_array_set arr ofs newval dbg =
+  Cop(Cextcall("caml_modify", typ_void, false, None),
+      [array_indexing log2_size_addr arr ofs dbg; newval], dbg)
+let addr_array_initialize arr ofs newval dbg =
+  Cop(Cextcall("caml_initialize", typ_void, false, None),
+      [array_indexing log2_size_addr arr ofs dbg; newval], dbg)
+let int_array_set arr ofs newval dbg =
+  Cop(Cstore (Word_int, Lambda.Assignment),
+    [array_indexing log2_size_addr arr ofs dbg; newval], dbg)
+let float_array_set arr ofs newval dbg =
+  Cop(Cstore (Double_u, Lambda.Assignment),
+    [array_indexing log2_size_float arr ofs dbg; newval], dbg)
+
+(* String length *)
+
+(* Length of string block *)
+
+let string_length exp dbg =
+  bind "str" exp (fun str ->
+    let tmp_var = V.create_local "tmp" in
+    Clet(VP.create tmp_var,
+         Cop(Csubi,
+             [Cop(Clsl,
+                   [get_size str dbg;
+                     Cconst_int (log2_size_addr, dbg)],
+                   dbg);
+              Cconst_int (1, dbg)],
+             dbg),
+         Cop(Csubi,
+             [Cvar tmp_var;
+               Cop(Cload (Byte_unsigned, Mutable),
+                     [Cop(Cadda, [str; Cvar tmp_var], dbg)], dbg)], dbg)))
+
+let bigstring_length ba dbg =
+  Cop(Cload (Word_int, Mutable), [field_address ba 5 dbg], dbg)
+
+(* Message sending *)
+
+let lookup_tag obj tag dbg =
+  bind "tag" tag (fun tag ->
+    Cop(Cextcall("caml_get_public_method", typ_val, false, None),
+        [obj; tag],
+        dbg))
+
+let lookup_label obj lab dbg =
+  bind "lab" lab (fun lab ->
+    let table = Cop (Cload (Word_val, Mutable), [obj], dbg) in
+    addr_array_ref table lab dbg)
+
+let call_cached_method obj tag cache pos args dbg =
+  let arity = List.length args in
+  let cache = array_indexing log2_size_addr cache pos dbg in
+  Compilenv.need_send_fun arity;
+  Cop(Capply typ_val,
+      Cconst_symbol("caml_send" ^ Int.to_string arity, dbg) ::
+        obj :: tag :: cache :: args,
+      dbg)
+
+(* Allocation *)
+
+let make_alloc_generic set_fn dbg tag wordsize args =
+  if wordsize <= Config.max_young_wosize then
+    Cop(Calloc, Cblockheader(block_header tag wordsize, dbg) :: args, dbg)
+  else begin
+    let id = V.create_local "*alloc*" in
+    let rec fill_fields idx = function
+      [] -> Cvar id
+    | e1::el -> Csequence(set_fn (Cvar id) (Cconst_int (idx, dbg)) e1 dbg,
+                          fill_fields (idx + 2) el) in
+    Clet(VP.create id,
+         Cop(Cextcall("caml_alloc", typ_val, true, None),
+                 [Cconst_int (wordsize, dbg); Cconst_int (tag, dbg)], dbg),
+         fill_fields 1 args)
+  end
+
+let make_alloc dbg tag args =
+  let addr_array_init arr ofs newval dbg =
+    Cop(Cextcall("caml_initialize", typ_void, false, None),
+        [array_indexing log2_size_addr arr ofs dbg; newval], dbg)
+  in
+  make_alloc_generic addr_array_init dbg tag (List.length args) args
+
+let make_float_alloc dbg tag args =
+  make_alloc_generic float_array_set dbg tag
+                     (List.length args * size_float / size_addr) args
+
+(* Bounds checking *)
+
+let make_checkbound dbg = function
+  | [Cop(Clsr, [a1; Cconst_int (n, _)], _); Cconst_int (m, _)]
+    when (m lsl n) > n ->
+      Cop(Ccheckbound, [a1; Cconst_int(m lsl n + 1 lsl n - 1, dbg)], dbg)
+  | args ->
+      Cop(Ccheckbound, args, dbg)
+
+(* Record application and currying functions *)
+
+let apply_function_sym n =
+  Compilenv.need_apply_fun n; "caml_apply" ^ Int.to_string n
+let curry_function_sym n =
+  Compilenv.need_curry_fun n;
+  if n >= 0
+  then "caml_curry" ^ Int.to_string n
+  else "caml_tuplify" ^ Int.to_string (-n)
+
+(* Big arrays *)
+
+let bigarray_elt_size : Lambda.bigarray_kind -> int = function
+    Pbigarray_unknown -> assert false
+  | Pbigarray_float32 -> 4
+  | Pbigarray_float64 -> 8
+  | Pbigarray_sint8 -> 1
+  | Pbigarray_uint8 -> 1
+  | Pbigarray_sint16 -> 2
+  | Pbigarray_uint16 -> 2
+  | Pbigarray_int32 -> 4
+  | Pbigarray_int64 -> 8
+  | Pbigarray_caml_int -> size_int
+  | Pbigarray_native_int -> size_int
+  | Pbigarray_complex32 -> 8
+  | Pbigarray_complex64 -> 16
+
+(* Produces a pointer to the element of the bigarray [b] on the position
+   [args].  [args] is given as a list of tagged int expressions, one per array
+   dimension. *)
+let bigarray_indexing unsafe elt_kind layout b args dbg =
+  let check_ba_bound bound idx v =
+    Csequence(make_checkbound dbg [bound;idx], v) in
+  (* Validates the given multidimensional offset against the array bounds and
+     transforms it into a one dimensional offset.  The offsets are expressions
+     evaluating to tagged int. *)
+  let rec ba_indexing dim_ofs delta_ofs = function
+    [] -> assert false
+  | [arg] ->
+      if unsafe then arg
+      else
+        bind "idx" arg (fun idx ->
+          (* Load the untagged int bound for the given dimension *)
+          let bound =
+            Cop(Cload (Word_int, Mutable),
+                [field_address b dim_ofs dbg], dbg)
+          in
+          let idxn = untag_int idx dbg in
+          check_ba_bound bound idxn idx)
+  | arg1 :: argl ->
+      (* The remainder of the list is transformed into a one dimensional offset
+         *)
+      let rem = ba_indexing (dim_ofs + delta_ofs) delta_ofs argl in
+      (* Load the untagged int bound for the given dimension *)
+      let bound =
+        Cop(Cload (Word_int, Mutable),
+            [field_address b dim_ofs dbg], dbg)
+      in
+      if unsafe then add_int (mul_int (decr_int rem dbg) bound dbg) arg1 dbg
+      else
+        bind "idx" arg1 (fun idx ->
+          bind "bound" bound (fun bound ->
+            let idxn = untag_int idx dbg in
+            (* [offset = rem * (tag_int bound) + idx] *)
+            let offset =
+              add_int (mul_int (decr_int rem dbg) bound dbg) idx dbg
+            in
+            check_ba_bound bound idxn offset)) in
+  (* The offset as an expression evaluating to int *)
+  let offset =
+    match (layout : Lambda.bigarray_layout) with
+      Pbigarray_unknown_layout ->
+        assert false
+    | Pbigarray_c_layout ->
+        ba_indexing (4 + List.length args) (-1) (List.rev args)
+    | Pbigarray_fortran_layout ->
+        ba_indexing 5 1
+          (List.map (fun idx -> sub_int idx (Cconst_int (2, dbg)) dbg) args)
+  and elt_size =
+    bigarray_elt_size elt_kind in
+  (* [array_indexing] can simplify the given expressions *)
+  array_indexing ~typ:Addr (Misc.log2 elt_size)
+                 (Cop(Cload (Word_int, Mutable),
+                    [field_address b 1 dbg], dbg)) offset dbg
+
+let bigarray_word_kind : Lambda.bigarray_kind -> memory_chunk = function
+    Pbigarray_unknown -> assert false
+  | Pbigarray_float32 -> Single
+  | Pbigarray_float64 -> Double
+  | Pbigarray_sint8 -> Byte_signed
+  | Pbigarray_uint8 -> Byte_unsigned
+  | Pbigarray_sint16 -> Sixteen_signed
+  | Pbigarray_uint16 -> Sixteen_unsigned
+  | Pbigarray_int32 -> Thirtytwo_signed
+  | Pbigarray_int64 -> Word_int
+  | Pbigarray_caml_int -> Word_int
+  | Pbigarray_native_int -> Word_int
+  | Pbigarray_complex32 -> Single
+  | Pbigarray_complex64 -> Double
+
+let bigarray_get unsafe elt_kind layout b args dbg =
+  bind "ba" b (fun b ->
+    match (elt_kind : Lambda.bigarray_kind) with
+      Pbigarray_complex32 | Pbigarray_complex64 ->
+        let kind = bigarray_word_kind elt_kind in
+        let sz = bigarray_elt_size elt_kind / 2 in
+        bind "addr"
+          (bigarray_indexing unsafe elt_kind layout b args dbg) (fun addr ->
+            bind "reval"
+              (Cop(Cload (kind, Mutable), [addr], dbg)) (fun reval ->
+                bind "imval"
+                  (Cop(Cload (kind, Mutable),
+                       [Cop(Cadda, [addr; Cconst_int (sz, dbg)], dbg)], dbg))
+                  (fun imval -> box_complex dbg reval imval)))
+    | _ ->
+        Cop(Cload (bigarray_word_kind elt_kind, Mutable),
+            [bigarray_indexing unsafe elt_kind layout b args dbg],
+            dbg))
+
+let bigarray_set unsafe elt_kind layout b args newval dbg =
+  bind "ba" b (fun b ->
+    match (elt_kind : Lambda.bigarray_kind) with
+      Pbigarray_complex32 | Pbigarray_complex64 ->
+        let kind = bigarray_word_kind elt_kind in
+        let sz = bigarray_elt_size elt_kind / 2 in
+        bind "newval" newval (fun newv ->
+        bind "addr" (bigarray_indexing unsafe elt_kind layout b args dbg)
+          (fun addr ->
+          Csequence(
+            Cop(Cstore (kind, Assignment), [addr; complex_re newv dbg], dbg),
+            Cop(Cstore (kind, Assignment),
+                [Cop(Cadda, [addr; Cconst_int (sz, dbg)], dbg);
+                 complex_im newv dbg],
+                dbg))))
+    | _ ->
+        Cop(Cstore (bigarray_word_kind elt_kind, Assignment),
+            [bigarray_indexing unsafe elt_kind layout b args dbg; newval],
+            dbg))
+
+(* the three functions below assume either 32-bit or 64-bit words *)
+let () = assert (size_int = 4 || size_int = 8)
+
+(* low_32 x is a value which agrees with x on at least the low 32 bits *)
+let rec low_32 dbg = function
+  | x when size_int = 4 -> x
+    (* Ignore sign and zero extensions, which do not affect the low bits *)
+  | Cop(Casr, [Cop(Clsl, [x; Cconst_int (32, _)], _);
+               Cconst_int (32, _)], _)
+  | Cop(Cand, [x; Cconst_natint (0xFFFFFFFFn, _)], _) ->
+    low_32 dbg x
+  | Clet(id, e, body) ->
+    Clet(id, e, low_32 dbg body)
+  | x -> x
+
+(* sign_extend_32 sign-extends values from 32 bits to the word size.
+   (if the word size is 32, this is a no-op) *)
+let sign_extend_32 dbg e =
+  if size_int = 4 then e else
+    Cop(Casr, [Cop(Clsl, [low_32 dbg e; Cconst_int(32, dbg)], dbg);
+               Cconst_int(32, dbg)], dbg)
+
+(* zero_extend_32 zero-extends values from 32 bits to the word size.
+   (if the word size is 32, this is a no-op) *)
+let zero_extend_32 dbg e =
+  if size_int = 4 then e else
+    Cop(Cand, [low_32 dbg e; Cconst_natint(0xFFFFFFFFn, dbg)], dbg)
+
+(* Boxed integers *)
+
+let operations_boxed_int (bi : Primitive.boxed_integer) =
+  match bi with
+    Pnativeint -> caml_nativeint_ops
+  | Pint32 -> caml_int32_ops
+  | Pint64 -> caml_int64_ops
+
+let alloc_header_boxed_int (bi : Primitive.boxed_integer) =
+  match bi with
+    Pnativeint -> alloc_boxedintnat_header
+  | Pint32 -> alloc_boxedint32_header
+  | Pint64 -> alloc_boxedint64_header
+
+let box_int_gen dbg (bi : Primitive.boxed_integer) arg =
+  let arg' =
+    if bi = Primitive.Pint32 && size_int = 8 then
+      if big_endian
+      then Cop(Clsl, [arg; Cconst_int (32, dbg)], dbg)
+      else sign_extend_32 dbg arg
+    else arg
+  in
+  Cop(Calloc, [alloc_header_boxed_int bi dbg;
+               Cconst_symbol(operations_boxed_int bi, dbg);
+               arg'], dbg)
+
+let split_int64_for_32bit_target arg dbg =
+  bind "split_int64" arg (fun arg ->
+    let first = Cop (Cadda, [Cconst_int (size_int, dbg); arg], dbg) in
+    let second = Cop (Cadda, [Cconst_int (2 * size_int, dbg); arg], dbg) in
+    Ctuple [Cop (Cload (Thirtytwo_unsigned, Mutable), [first], dbg);
+            Cop (Cload (Thirtytwo_unsigned, Mutable), [second], dbg)])
+
+let alloc_matches_boxed_int bi ~hdr ~ops =
+  match (bi : Primitive.boxed_integer), hdr, ops with
+  | Pnativeint, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) ->
+      Nativeint.equal hdr boxedintnat_header
+        && String.equal sym caml_nativeint_ops
+  | Pint32, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) ->
+      Nativeint.equal hdr boxedint32_header
+        && String.equal sym caml_int32_ops
+  | Pint64, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) ->
+      Nativeint.equal hdr boxedint64_header
+        && String.equal sym caml_int64_ops
+  | (Pnativeint | Pint32 | Pint64), _, _ -> false
+
+let unbox_int dbg bi =
+  let default arg =
+    if size_int = 4 && bi = Primitive.Pint64 then
+      split_int64_for_32bit_target arg dbg
+    else
+      Cop(
+        Cload((if bi = Primitive.Pint32 then Thirtytwo_signed else Word_int),
+              Immutable),
+        [Cop(Cadda, [arg; Cconst_int (size_addr, dbg)], dbg)], dbg)
+  in
+  map_tail
+    (function
+      | Cop(Calloc,
+            [hdr; ops;
+             Cop(Clsl, [contents; Cconst_int (32, _)], _dbg')], _dbg)
+        when bi = Primitive.Pint32 && size_int = 8 && big_endian
+             && alloc_matches_boxed_int bi ~hdr ~ops ->
+          (* Force sign-extension of low 32 bits *)
+          sign_extend_32 dbg contents
+      | Cop(Calloc,
+            [hdr; ops; contents], _dbg)
+        when bi = Primitive.Pint32 && size_int = 8 && not big_endian
+             && alloc_matches_boxed_int bi ~hdr ~ops ->
+          (* Force sign-extension of low 32 bits *)
+          sign_extend_32 dbg contents
+      | Cop(Calloc, [hdr; ops; contents], _dbg)
+        when alloc_matches_boxed_int bi ~hdr ~ops ->
+          contents
+      | Cconst_symbol (s, _dbg) as cmm ->
+          begin match Cmmgen_state.structured_constant_of_sym s, bi with
+          | Some (Uconst_nativeint n), Primitive.Pnativeint ->
+              Cconst_natint (n, dbg)
+          | Some (Uconst_int32 n), Primitive.Pint32 ->
+              Cconst_natint (Nativeint.of_int32 n, dbg)
+          | Some (Uconst_int64 n), Primitive.Pint64 ->
+              if size_int = 8 then
+                Cconst_natint (Int64.to_nativeint n, dbg)
+              else
+                let low = Int64.to_nativeint n in
+                let high =
+                  Int64.to_nativeint (Int64.shift_right_logical n 32)
+                in
+                if big_endian then
+                  Ctuple [Cconst_natint (high, dbg); Cconst_natint (low, dbg)]
+                else
+                  Ctuple [Cconst_natint (low, dbg); Cconst_natint (high, dbg)]
+          | _ ->
+              default cmm
+          end
+      | cmm ->
+          default cmm
+    )
+
+let make_unsigned_int bi arg dbg =
+  if bi = Primitive.Pint32 && size_int = 8
+  then zero_extend_32 dbg arg
+  else arg
+
+let unaligned_load_16 ptr idx dbg =
+  if Arch.allow_unaligned_access
+  then Cop(Cload (Sixteen_unsigned, Mutable), [add_int ptr idx dbg], dbg)
+  else
+    let cconst_int i = Cconst_int (i, dbg) in
+    let v1 = Cop(Cload (Byte_unsigned, Mutable), [add_int ptr idx dbg], dbg) in
+    let v2 = Cop(Cload (Byte_unsigned, Mutable),
+                 [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg) in
+    let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in
+    Cop(Cor, [lsl_int b1 (cconst_int 8) dbg; b2], dbg)
+
+let unaligned_set_16 ptr idx newval dbg =
+  if Arch.allow_unaligned_access
+  then
+    Cop(Cstore (Sixteen_unsigned, Assignment),
+      [add_int ptr idx dbg; newval], dbg)
+  else
+    let cconst_int i = Cconst_int (i, dbg) in
+    let v1 =
+      Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg);
+        cconst_int 0xFF], dbg)
+    in
+    let v2 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in
+    let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in
+    Csequence(
+        Cop(Cstore (Byte_unsigned, Assignment), [add_int ptr idx dbg; b1], dbg),
+        Cop(Cstore (Byte_unsigned, Assignment),
+            [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2], dbg))
+
+let unaligned_load_32 ptr idx dbg =
+  if Arch.allow_unaligned_access
+  then Cop(Cload (Thirtytwo_unsigned, Mutable), [add_int ptr idx dbg], dbg)
+  else
+    let cconst_int i = Cconst_int (i, dbg) in
+    let v1 = Cop(Cload (Byte_unsigned, Mutable), [add_int ptr idx dbg], dbg) in
+    let v2 = Cop(Cload (Byte_unsigned, Mutable),
+                 [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg)
+    in
+    let v3 = Cop(Cload (Byte_unsigned, Mutable),
+                 [add_int (add_int ptr idx dbg) (cconst_int 2) dbg], dbg)
+    in
+    let v4 = Cop(Cload (Byte_unsigned, Mutable),
+                 [add_int (add_int ptr idx dbg) (cconst_int 3) dbg], dbg)
+    in
+    let b1, b2, b3, b4 =
+      if Arch.big_endian
+      then v1, v2, v3, v4
+      else v4, v3, v2, v1 in
+    Cop(Cor,
+      [Cop(Cor, [lsl_int b1 (cconst_int 24) dbg;
+         lsl_int b2 (cconst_int 16) dbg], dbg);
+       Cop(Cor, [lsl_int b3 (cconst_int 8) dbg; b4], dbg)],
+      dbg)
+
+let unaligned_set_32 ptr idx newval dbg =
+  if Arch.allow_unaligned_access
+  then
+    Cop(Cstore (Thirtytwo_unsigned, Assignment), [add_int ptr idx dbg; newval],
+      dbg)
+  else
+    let cconst_int i = Cconst_int (i, dbg) in
+    let v1 =
+      Cop(Cand, [Cop(Clsr, [newval; cconst_int 24], dbg); cconst_int 0xFF], dbg)
+    in
+    let v2 =
+      Cop(Cand, [Cop(Clsr, [newval; cconst_int 16], dbg); cconst_int 0xFF], dbg)
+    in
+    let v3 =
+      Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg); cconst_int 0xFF], dbg)
+    in
+    let v4 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in
+    let b1, b2, b3, b4 =
+      if Arch.big_endian
+      then v1, v2, v3, v4
+      else v4, v3, v2, v1 in
+    Csequence(
+        Csequence(
+            Cop(Cstore (Byte_unsigned, Assignment),
+                [add_int ptr idx dbg; b1], dbg),
+            Cop(Cstore (Byte_unsigned, Assignment),
+                [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2],
+                dbg)),
+        Csequence(
+            Cop(Cstore (Byte_unsigned, Assignment),
+                [add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3],
+                dbg),
+            Cop(Cstore (Byte_unsigned, Assignment),
+                [add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4],
+                dbg)))
+
+let unaligned_load_64 ptr idx dbg =
+  assert(size_int = 8);
+  if Arch.allow_unaligned_access
+  then Cop(Cload (Word_int, Mutable), [add_int ptr idx dbg], dbg)
+  else
+    let cconst_int i = Cconst_int (i, dbg) in
+    let v1 = Cop(Cload (Byte_unsigned, Mutable), [add_int ptr idx dbg], dbg) in
+    let v2 = Cop(Cload (Byte_unsigned, Mutable),
+                 [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg) in
+    let v3 = Cop(Cload (Byte_unsigned, Mutable),
+                 [add_int (add_int ptr idx dbg) (cconst_int 2) dbg], dbg) in
+    let v4 = Cop(Cload (Byte_unsigned, Mutable),
+                 [add_int (add_int ptr idx dbg) (cconst_int 3) dbg], dbg) in
+    let v5 = Cop(Cload (Byte_unsigned, Mutable),
+                 [add_int (add_int ptr idx dbg) (cconst_int 4) dbg], dbg) in
+    let v6 = Cop(Cload (Byte_unsigned, Mutable),
+                 [add_int (add_int ptr idx dbg) (cconst_int 5) dbg], dbg) in
+    let v7 = Cop(Cload (Byte_unsigned, Mutable),
+                 [add_int (add_int ptr idx dbg) (cconst_int 6) dbg], dbg) in
+    let v8 = Cop(Cload (Byte_unsigned, Mutable),
+                 [add_int (add_int ptr idx dbg) (cconst_int 7) dbg], dbg) in
+    let b1, b2, b3, b4, b5, b6, b7, b8 =
+      if Arch.big_endian
+      then v1, v2, v3, v4, v5, v6, v7, v8
+      else v8, v7, v6, v5, v4, v3, v2, v1 in
+    Cop(Cor,
+        [Cop(Cor,
+             [Cop(Cor, [lsl_int b1 (cconst_int (8*7)) dbg;
+                        lsl_int b2 (cconst_int (8*6)) dbg], dbg);
+              Cop(Cor, [lsl_int b3 (cconst_int (8*5)) dbg;
+                        lsl_int b4 (cconst_int (8*4)) dbg], dbg)],
+             dbg);
+         Cop(Cor,
+             [Cop(Cor, [lsl_int b5 (cconst_int (8*3)) dbg;
+                        lsl_int b6 (cconst_int (8*2)) dbg], dbg);
+              Cop(Cor, [lsl_int b7 (cconst_int 8) dbg;
+                        b8], dbg)],
+             dbg)], dbg)
+
+let unaligned_set_64 ptr idx newval dbg =
+  assert(size_int = 8);
+  if Arch.allow_unaligned_access
+  then Cop(Cstore (Word_int, Assignment), [add_int ptr idx dbg; newval], dbg)
+  else
+    let cconst_int i = Cconst_int (i, dbg) in
+    let v1 =
+      Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*7)], dbg); cconst_int 0xFF],
+        dbg)
+    in
+    let v2 =
+      Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*6)], dbg); cconst_int 0xFF],
+        dbg)
+    in
+    let v3 =
+      Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*5)], dbg); cconst_int 0xFF],
+        dbg)
+    in
+    let v4 =
+      Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*4)], dbg); cconst_int 0xFF],
+        dbg)
+    in
+    let v5 =
+      Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*3)], dbg); cconst_int 0xFF],
+        dbg)
+    in
+    let v6 =
+      Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*2)], dbg); cconst_int 0xFF],
+        dbg)
+    in
+    let v7 =
+      Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg); cconst_int 0xFF],
+        dbg)
+    in
+    let v8 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in
+    let b1, b2, b3, b4, b5, b6, b7, b8 =
+      if Arch.big_endian
+      then v1, v2, v3, v4, v5, v6, v7, v8
+      else v8, v7, v6, v5, v4, v3, v2, v1 in
+    Csequence(
+        Csequence(
+            Csequence(
+                Cop(Cstore (Byte_unsigned, Assignment),
+                    [add_int ptr idx dbg; b1],
+                    dbg),
+                Cop(Cstore (Byte_unsigned, Assignment),
+                    [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2],
+                    dbg)),
+            Csequence(
+                Cop(Cstore (Byte_unsigned, Assignment),
+                    [add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3],
+                    dbg),
+                Cop(Cstore (Byte_unsigned, Assignment),
+                    [add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4],
+                    dbg))),
+        Csequence(
+            Csequence(
+                Cop(Cstore (Byte_unsigned, Assignment),
+                    [add_int (add_int ptr idx dbg) (cconst_int 4) dbg; b5],
+                    dbg),
+                Cop(Cstore (Byte_unsigned, Assignment),
+                    [add_int (add_int ptr idx dbg) (cconst_int 5) dbg; b6],
+                    dbg)),
+            Csequence(
+                Cop(Cstore (Byte_unsigned, Assignment),
+                    [add_int (add_int ptr idx dbg) (cconst_int 6) dbg; b7],
+                    dbg),
+                Cop(Cstore (Byte_unsigned, Assignment),
+                    [add_int (add_int ptr idx dbg) (cconst_int 7) dbg; b8],
+                    dbg))))
+
+let max_or_zero a dbg =
+  bind "size" a (fun a ->
+    (* equivalent to
+       Cifthenelse(Cop(Ccmpi Cle, [a; cconst_int 0]), cconst_int 0, a)
+
+       if a is positive, sign is 0 hence sign_negation is full of 1
+                         so sign_negation&a = a
+       if a is negative, sign is full of 1 hence sign_negation is 0
+                         so sign_negation&a = 0 *)
+    let sign = Cop(Casr, [a; Cconst_int (size_int * 8 - 1, dbg)], dbg) in
+    let sign_negation = Cop(Cxor, [sign; Cconst_int (-1, dbg)], dbg) in
+    Cop(Cand, [sign_negation; a], dbg))
+
+let check_bound safety access_size dbg length a2 k =
+  match (safety : Lambda.is_safe) with
+  | Unsafe -> k
+  | Safe ->
+      let offset =
+        match (access_size : Clambda_primitives.memory_access_size) with
+        | Sixteen -> 1
+        | Thirty_two -> 3
+        | Sixty_four -> 7
+      in
+      let a1 =
+        sub_int length (Cconst_int (offset, dbg)) dbg
+      in
+      Csequence(make_checkbound dbg [max_or_zero a1 dbg; a2], k)
+
+let unaligned_set size ptr idx newval dbg =
+  match (size : Clambda_primitives.memory_access_size) with
+  | Sixteen -> unaligned_set_16 ptr idx newval dbg
+  | Thirty_two -> unaligned_set_32 ptr idx newval dbg
+  | Sixty_four -> unaligned_set_64 ptr idx newval dbg
+
+let unaligned_load size ptr idx dbg =
+  match (size : Clambda_primitives.memory_access_size) with
+  | Sixteen -> unaligned_load_16 ptr idx dbg
+  | Thirty_two -> unaligned_load_32 ptr idx dbg
+  | Sixty_four -> unaligned_load_64 ptr idx dbg
+
+let box_sized size dbg exp =
+  match (size : Clambda_primitives.memory_access_size) with
+  | Sixteen -> tag_int exp dbg
+  | Thirty_two -> box_int_gen dbg Pint32 exp
+  | Sixty_four -> box_int_gen dbg Pint64 exp
+
+(* Simplification of some primitives into C calls *)
+
+let default_prim name =
+  Primitive.simple ~name ~arity:0(*ignored*) ~alloc:true
+
+
+let int64_native_prim name arity ~alloc =
+  let u64 = Primitive.Unboxed_integer Primitive.Pint64 in
+  let rec make_args = function 0 -> [] | n -> u64 :: make_args (n - 1) in
+  Primitive.make ~name ~native_name:(name ^ "_native")
+    ~alloc
+    ~native_repr_args:(make_args arity)
+    ~native_repr_res:u64
+
+let simplif_primitive_32bits :
+  Clambda_primitives.primitive -> Clambda_primitives.primitive = function
+    Pbintofint Pint64 -> Pccall (default_prim "caml_int64_of_int")
+  | Pintofbint Pint64 -> Pccall (default_prim "caml_int64_to_int")
+  | Pcvtbint(Pint32, Pint64) -> Pccall (default_prim "caml_int64_of_int32")
+  | Pcvtbint(Pint64, Pint32) -> Pccall (default_prim "caml_int64_to_int32")
+  | Pcvtbint(Pnativeint, Pint64) ->
+      Pccall (default_prim "caml_int64_of_nativeint")
+  | Pcvtbint(Pint64, Pnativeint) ->
+      Pccall (default_prim "caml_int64_to_nativeint")
+  | Pnegbint Pint64 -> Pccall (int64_native_prim "caml_int64_neg" 1
+                                 ~alloc:false)
+  | Paddbint Pint64 -> Pccall (int64_native_prim "caml_int64_add" 2
+                                 ~alloc:false)
+  | Psubbint Pint64 -> Pccall (int64_native_prim "caml_int64_sub" 2
+                                 ~alloc:false)
+  | Pmulbint Pint64 -> Pccall (int64_native_prim "caml_int64_mul" 2
+                                 ~alloc:false)
+  | Pdivbint {size=Pint64} -> Pccall (int64_native_prim "caml_int64_div" 2
+                                        ~alloc:true)
+  | Pmodbint {size=Pint64} -> Pccall (int64_native_prim "caml_int64_mod" 2
+                                        ~alloc:true)
+  | Pandbint Pint64 -> Pccall (int64_native_prim "caml_int64_and" 2
+                                 ~alloc:false)
+  | Porbint Pint64 ->  Pccall (int64_native_prim "caml_int64_or" 2
+                                 ~alloc:false)
+  | Pxorbint Pint64 -> Pccall (int64_native_prim "caml_int64_xor" 2
+                                 ~alloc:false)
+  | Plslbint Pint64 -> Pccall (default_prim "caml_int64_shift_left")
+  | Plsrbint Pint64 -> Pccall (default_prim "caml_int64_shift_right_unsigned")
+  | Pasrbint Pint64 -> Pccall (default_prim "caml_int64_shift_right")
+  | Pbintcomp(Pint64, Lambda.Ceq) -> Pccall (default_prim "caml_equal")
+  | Pbintcomp(Pint64, Lambda.Cne) -> Pccall (default_prim "caml_notequal")
+  | Pbintcomp(Pint64, Lambda.Clt) -> Pccall (default_prim "caml_lessthan")
+  | Pbintcomp(Pint64, Lambda.Cgt) -> Pccall (default_prim "caml_greaterthan")
+  | Pbintcomp(Pint64, Lambda.Cle) -> Pccall (default_prim "caml_lessequal")
+  | Pbintcomp(Pint64, Lambda.Cge) -> Pccall (default_prim "caml_greaterequal")
+  | Pcompare_bints Pint64 -> Pccall (default_prim "caml_int64_compare")
+  | Pbigarrayref(_unsafe, n, Pbigarray_int64, _layout) ->
+      Pccall (default_prim ("caml_ba_get_" ^ Int.to_string n))
+  | Pbigarrayset(_unsafe, n, Pbigarray_int64, _layout) ->
+      Pccall (default_prim ("caml_ba_set_" ^ Int.to_string n))
+  | Pstring_load(Sixty_four, _) -> Pccall (default_prim "caml_string_get64")
+  | Pbytes_load(Sixty_four, _) -> Pccall (default_prim "caml_bytes_get64")
+  | Pbytes_set(Sixty_four, _) -> Pccall (default_prim "caml_bytes_set64")
+  | Pbigstring_load(Sixty_four,_) -> Pccall (default_prim "caml_ba_uint8_get64")
+  | Pbigstring_set(Sixty_four,_) -> Pccall (default_prim "caml_ba_uint8_set64")
+  | Pbbswap Pint64 -> Pccall (default_prim "caml_int64_bswap")
+  | p -> p
+
+let simplif_primitive p : Clambda_primitives.primitive =
+  match (p : Clambda_primitives.primitive) with
+  | Pduprecord _ ->
+      Pccall (default_prim "caml_obj_dup")
+  | Pbigarrayref(_unsafe, n, Pbigarray_unknown, _layout) ->
+      Pccall (default_prim ("caml_ba_get_" ^ string_of_int n))
+  | Pbigarrayset(_unsafe, n, Pbigarray_unknown, _layout) ->
+      Pccall (default_prim ("caml_ba_set_" ^ string_of_int n))
+  | Pbigarrayref(_unsafe, n, _kind, Pbigarray_unknown_layout) ->
+      Pccall (default_prim ("caml_ba_get_" ^ string_of_int n))
+  | Pbigarrayset(_unsafe, n, _kind, Pbigarray_unknown_layout) ->
+      Pccall (default_prim ("caml_ba_set_" ^ string_of_int n))
+  | p ->
+      if size_int = 8 then p else simplif_primitive_32bits p
+
+(* Build switchers both for constants and blocks *)
+
+let transl_isout h arg dbg = tag_int (Cop(Ccmpa Clt, [h ; arg], dbg)) dbg
+
+(* Build an actual switch (ie jump table) *)
+
+let make_switch arg cases actions dbg =
+  let extract_uconstant =
+    function
+    (* Constant integers loaded from a table should end in 1,
+       so that Cload never produces untagged integers *)
+    | Cconst_int     (n, _), _dbg
+    | Cconst_pointer (n, _), _dbg when (n land 1) = 1 ->
+        Some (Cint (Nativeint.of_int n))
+    | Cconst_natint     (n, _), _dbg
+    | Cconst_natpointer (n, _), _dbg
+      when Nativeint.(to_int (logand n one) = 1) ->
+        Some (Cint n)
+    | Cconst_symbol (s,_), _dbg ->
+        Some (Csymbol_address s)
+    | _ -> None
+  in
+  let extract_affine ~cases ~const_actions =
+    let length = Array.length cases in
+    if length >= 2
+    then begin
+      match const_actions.(cases.(0)), const_actions.(cases.(1)) with
+      | Cint v0, Cint v1 ->
+          let slope = Nativeint.sub v1 v0 in
+          let check i = function
+            | Cint v -> v = Nativeint.(add (mul (of_int i) slope) v0)
+            | _ -> false
+          in
+          if Misc.Stdlib.Array.for_alli
+              (fun i idx -> check i const_actions.(idx)) cases
+          then Some (v0, slope)
+          else None
+      | _, _ ->
+          None
+    end
+    else None
+  in
+  let make_table_lookup ~cases ~const_actions arg dbg =
+    let table = Compilenv.new_const_symbol () in
+    Cmmgen_state.add_constant table (Const_table (Local,
+        Array.to_list (Array.map (fun act ->
+          const_actions.(act)) cases)));
+    addr_array_ref (Cconst_symbol (table, dbg)) (tag_int arg dbg) dbg
+  in
+  let make_affine_computation ~offset ~slope arg dbg =
+    (* In case the resulting integers are an affine function of the index, we
+       don't emit a table, and just compute the result directly *)
+    add_int
+      (mul_int arg (natint_const_untagged dbg slope) dbg)
+      (natint_const_untagged dbg offset)
+      dbg
+  in
+  match Misc.Stdlib.Array.all_somes (Array.map extract_uconstant actions) with
+  | None ->
+      Cswitch (arg,cases,actions,dbg)
+  | Some const_actions ->
+      match extract_affine ~cases ~const_actions with
+      | Some (offset, slope) ->
+          make_affine_computation ~offset ~slope arg dbg
+      | None -> make_table_lookup ~cases ~const_actions arg dbg
+
+module SArgBlocks =
+struct
+  type primitive = operation
+
+  let eqint = Ccmpi Ceq
+  let neint = Ccmpi Cne
+  let leint = Ccmpi Cle
+  let ltint = Ccmpi Clt
+  let geint = Ccmpi Cge
+  let gtint = Ccmpi Cgt
+
+  type act = expression
+  type loc = Debuginfo.t
+
+  (* CR mshinwell: GPR#2294 will fix the Debuginfo here *)
+
+  let make_const i =  Cconst_int (i, Debuginfo.none)
+  let make_prim p args = Cop (p,args, Debuginfo.none)
+  let make_offset arg n = add_const arg n Debuginfo.none
+  let make_isout h arg = Cop (Ccmpa Clt, [h ; arg], Debuginfo.none)
+  let make_isin h arg = Cop (Ccmpa Cge, [h ; arg], Debuginfo.none)
+  let make_if cond ifso ifnot =
+    Cifthenelse (cond, Debuginfo.none, ifso, Debuginfo.none, ifnot,
+      Debuginfo.none)
+  let make_switch dbg arg cases actions =
+    let actions = Array.map (fun expr -> expr, dbg) actions in
+    make_switch arg cases actions dbg
+  let bind arg body = bind "switcher" arg body
+
+  let make_catch handler = match handler with
+  | Cexit (i,[]) -> i,fun e -> e
+  | _ ->
+      let dbg = Debuginfo.none in
+      let i = Lambda.next_raise_count () in
+(*
+      Printf.eprintf  "SHARE CMM: %i\n" i ;
+      Printcmm.expression Format.str_formatter handler ;
+      Printf.eprintf "%s\n" (Format.flush_str_formatter ()) ;
+*)
+      i,
+      (fun body -> match body with
+      | Cexit (j,_) ->
+          if i=j then handler
+          else body
+      | _ ->  ccatch (i,[],body,handler, dbg))
+
+  let make_exit i = Cexit (i,[])
+
+end
+
+(* cmm store, as sharing as normally been detected in previous
+   phases, we only share exits *)
+(* Some specific patterns can lead to switches where several cases
+   point to the same action, but this action is not an exit (see GPR#1370).
+   The addition of the index in the action array as context allows to
+   share them correctly without duplication. *)
+module StoreExpForSwitch =
+  Switch.CtxStore
+    (struct
+      type t = expression
+      type key = int option * int
+      type context = int
+      let make_key index expr =
+        let continuation =
+          match expr with
+          | Cexit (i,[]) -> Some i
+          | _ -> None
+        in
+        Some (continuation, index)
+      let compare_key (cont, index) (cont', index') =
+        match cont, cont' with
+        | Some i, Some i' when i = i' -> 0
+        | _, _ -> Stdlib.compare index index'
+    end)
+
+(* For string switches, we can use a generic store *)
+module StoreExp =
+  Switch.Store
+    (struct
+      type t = expression
+      type key = int
+      let make_key = function
+        | Cexit (i,[]) -> Some i
+        | _ -> None
+      let compare_key = Stdlib.compare
+    end)
+
+module SwitcherBlocks = Switch.Make(SArgBlocks)
+
+(* Int switcher, arg in [low..high],
+   cases is list of individual cases, and is sorted by first component *)
+
+let transl_int_switch dbg arg low high cases default = match cases with
+| [] -> assert false
+| _::_ ->
+    let store = StoreExp.mk_store () in
+    assert (store.Switch.act_store () default = 0) ;
+    let cases =
+      List.map
+        (fun (i,act) -> i,store.Switch.act_store () act)
+        cases in
+    let rec inters plow phigh pact = function
+      | [] ->
+          if phigh = high then [plow,phigh,pact]
+          else [(plow,phigh,pact); (phigh+1,high,0) ]
+      | (i,act)::rem ->
+          if i = phigh+1 then
+            if pact = act then
+              inters plow i pact rem
+            else
+              (plow,phigh,pact)::inters i i act rem
+          else (* insert default *)
+            if pact = 0 then
+              if act = 0 then
+                inters plow i 0 rem
+              else
+                (plow,i-1,pact)::
+                inters i i act rem
+            else (* pact <> 0 *)
+              (plow,phigh,pact)::
+              begin
+                if act = 0 then inters (phigh+1) i 0 rem
+                else (phigh+1,i-1,0)::inters i i act rem
+              end in
+    let inters = match cases with
+    | [] -> assert false
+    | (k0,act0)::rem ->
+        if k0 = low then inters k0 k0 act0 rem
+        else inters low (k0-1) 0 cases in
+    bind "switcher" arg
+      (fun a ->
+        SwitcherBlocks.zyva
+          dbg
+          (low,high)
+          a
+          (Array.of_list inters) store)
+
+
+let transl_switch_clambda loc arg index cases =
+  let store = StoreExpForSwitch.mk_store () in
+  let index =
+    Array.map
+      (fun j -> store.Switch.act_store j cases.(j))
+      index in
+  let n_index = Array.length index in
+  let inters = ref []
+  and this_high = ref (n_index-1)
+  and this_low = ref (n_index-1)
+  and this_act = ref index.(n_index-1) in
+  for i = n_index-2 downto 0 do
+    let act = index.(i) in
+    if act = !this_act then
+      decr this_low
+    else begin
+      inters := (!this_low, !this_high, !this_act) :: !inters ;
+      this_high := i ;
+      this_low := i ;
+      this_act := act
+    end
+  done ;
+  inters := (0, !this_high, !this_act) :: !inters ;
+  match !inters with
+  | [_] -> cases.(0)
+  | inters ->
+      bind "switcher" arg
+        (fun a ->
+           SwitcherBlocks.zyva
+             loc
+             (0,n_index-1)
+             a
+             (Array.of_list inters) store)
+
+let strmatch_compile =
+  let module S =
+    Strmatch.Make
+      (struct
+        let string_block_length ptr = get_size ptr Debuginfo.none
+        let transl_switch = transl_int_switch
+      end) in
+  S.compile
+
+let ptr_offset ptr offset dbg =
+  if offset = 0
+  then ptr
+  else Cop(Caddv, [ptr; Cconst_int(offset * size_addr, dbg)], dbg)
+
+let direct_apply lbl args dbg =
+  Cop(Capply typ_val, Cconst_symbol (lbl, dbg) :: args, dbg)
+
+let generic_apply mut clos args dbg =
+  match args with
+  | [arg] ->
+      bind "fun" clos (fun clos ->
+        Cop(Capply typ_val, [get_field_gen mut clos 0 dbg; arg; clos],
+          dbg))
+  | _ ->
+      let arity = List.length args in
+      let cargs =
+        Cconst_symbol(apply_function_sym arity, dbg) :: args @ [clos]
+      in
+      Cop(Capply typ_val, cargs, dbg)
+
+let send kind met obj args dbg =
+  let call_met obj args clos =
+    (* met is never a simple expression, so it never gets turned into an
+       Immutable load *)
+    generic_apply Asttypes.Mutable clos (obj :: args) dbg
+  in
+  bind "obj" obj (fun obj ->
+      match (kind : Lambda.meth_kind), args with
+        Self, _ ->
+          bind "met" (lookup_label obj met dbg)
+            (call_met obj args)
+      | Cached, cache :: pos :: args ->
+          call_cached_method obj met cache pos args dbg
+      | _ ->
+          bind "met" (lookup_tag obj met dbg)
+            (call_met obj args))
+
+(*
+CAMLprim value caml_cache_public_method (value meths, value tag, value *cache)
+{
+  int li = 3, hi = Field(meths,0), mi;
+  while (li < hi) { // no need to check the 1st time
+    mi = ((li+hi) >> 1) | 1;
+    if (tag < Field(meths,mi)) hi = mi-2;
+    else li = mi;
+  }
+  *cache = (li-3)*sizeof(value)+1;
+  return Field (meths, li-1);
+}
+*)
+
+let cache_public_method meths tag cache dbg =
+  let raise_num = Lambda.next_raise_count () in
+  let cconst_int i = Cconst_int (i, dbg) in
+  let li = V.create_local "*li*" and hi = V.create_local "*hi*"
+  and mi = V.create_local "*mi*" and tagged = V.create_local "*tagged*" in
+  Clet_mut (
+  VP.create li, typ_int, cconst_int 3,
+  Clet_mut (
+  VP.create hi, typ_int, Cop(Cload (Word_int, Mutable), [meths], dbg),
+  Csequence(
+  ccatch
+    (raise_num, [],
+     create_loop
+       (Clet(
+        VP.create mi,
+        Cop(Cor,
+            [Cop(Clsr, [Cop(Caddi, [Cvar li; Cvar hi], dbg); cconst_int 1],
+               dbg);
+             cconst_int 1],
+            dbg),
+        Csequence(
+        Cifthenelse
+          (Cop (Ccmpi Clt,
+                [tag;
+                 Cop(Cload (Word_int, Mutable),
+                     [Cop(Cadda,
+                          [meths; lsl_const (Cvar mi) log2_size_addr dbg],
+                          dbg)],
+                     dbg)], dbg),
+           dbg, Cassign(hi, Cop(Csubi, [Cvar mi; cconst_int 2], dbg)),
+           dbg, Cassign(li, Cvar mi),
+           dbg),
+        Cifthenelse
+          (Cop(Ccmpi Cge, [Cvar li; Cvar hi], dbg),
+           dbg, Cexit (raise_num, []),
+           dbg, Ctuple [],
+           dbg))))
+       dbg,
+     Ctuple [],
+     dbg),
+  Clet (
+    VP.create tagged,
+      Cop(Caddi, [lsl_const (Cvar li) log2_size_addr dbg;
+        cconst_int(1 - 3 * size_addr)], dbg),
+    Csequence(Cop (Cstore (Word_int, Assignment), [cache; Cvar tagged], dbg),
+              Cvar tagged)))))
+
+(* CR mshinwell: These will be filled in by later pull requests. *)
+let placeholder_dbg () = Debuginfo.none
+let placeholder_fun_dbg ~human_name:_ = Debuginfo.none
+
+(* Generate an application function:
+     (defun caml_applyN (a1 ... aN clos)
+       (if (= clos.arity N)
+         (app clos.direct a1 ... aN clos)
+         (let (clos1 (app clos.code a1 clos)
+               clos2 (app clos1.code a2 clos)
+               ...
+               closN-1 (app closN-2.code aN-1 closN-2))
+           (app closN-1.code aN closN-1))))
+*)
+
+let apply_function_body arity =
+  let dbg = placeholder_dbg in
+  let arg = Array.make arity (V.create_local "arg") in
+  for i = 1 to arity - 1 do arg.(i) <- V.create_local "arg" done;
+  let clos = V.create_local "clos" in
+  let rec app_fun clos n =
+    if n = arity-1 then
+      Cop(Capply typ_val,
+          [get_field_gen Asttypes.Mutable (Cvar clos) 0 (dbg ());
+           Cvar arg.(n);
+           Cvar clos],
+          dbg ())
+    else begin
+      let newclos = V.create_local "clos" in
+      Clet(VP.create newclos,
+           Cop(Capply typ_val,
+               [get_field_gen Asttypes.Mutable (Cvar clos) 0 (dbg ());
+                Cvar arg.(n); Cvar clos], dbg ()),
+           app_fun newclos (n+1))
+    end in
+  let args = Array.to_list arg in
+  let all_args = args @ [clos] in
+  (args, clos,
+   if arity = 1 then app_fun clos 0 else
+   Cifthenelse(
+   Cop(Ccmpi Ceq, [get_field_gen Asttypes.Mutable (Cvar clos) 1 (dbg ());
+                   int_const (dbg ()) arity], dbg ()),
+   dbg (),
+   Cop(Capply typ_val,
+       get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ())
+       :: List.map (fun s -> Cvar s) all_args,
+       dbg ()),
+   dbg (),
+   app_fun clos 0,
+   dbg ()))
+
+let send_function arity =
+  let dbg = placeholder_dbg in
+  let cconst_int i = Cconst_int (i, dbg ()) in
+  let (args, clos', body) = apply_function_body (1+arity) in
+  let cache = V.create_local "cache"
+  and obj = List.hd args
+  and tag = V.create_local "tag" in
+  let clos =
+    let cache = Cvar cache and obj = Cvar obj and tag = Cvar tag in
+    let meths = V.create_local "meths" and cached = V.create_local "cached" in
+    let real = V.create_local "real" in
+    let mask = get_field_gen Asttypes.Mutable (Cvar meths) 1 (dbg ()) in
+    let cached_pos = Cvar cached in
+    let tag_pos = Cop(Cadda, [Cop (Cadda, [cached_pos; Cvar meths], dbg ());
+                              cconst_int(3*size_addr-1)], dbg ()) in
+    let tag' = Cop(Cload (Word_int, Mutable), [tag_pos], dbg ()) in
+    Clet (
+    VP.create meths, Cop(Cload (Word_val, Mutable), [obj], dbg ()),
+    Clet (
+    VP.create cached,
+      Cop(Cand, [Cop(Cload (Word_int, Mutable), [cache], dbg ()); mask],
+          dbg ()),
+    Clet (
+    VP.create real,
+    Cifthenelse(Cop(Ccmpa Cne, [tag'; tag], dbg ()),
+                dbg (),
+                cache_public_method (Cvar meths) tag cache (dbg ()),
+                dbg (),
+                cached_pos,
+                dbg ()),
+    Cop(Cload (Word_val, Mutable),
+      [Cop(Cadda, [Cop (Cadda, [Cvar real; Cvar meths], dbg ());
+       cconst_int(2*size_addr-1)], dbg ())], dbg ()))))
+
+  in
+  let body = Clet(VP.create clos', clos, body) in
+  let cache = cache in
+  let fun_name = "caml_send" ^ Int.to_string arity in
+  let fun_args =
+    [obj, typ_val; tag, typ_int; cache, typ_val]
+    @ List.map (fun id -> (id, typ_val)) (List.tl args) in
+  let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
+  Cfunction
+   {fun_name;
+    fun_args = List.map (fun (arg, ty) -> VP.create arg, ty) fun_args;
+    fun_body = body;
+    fun_codegen_options = [];
+    fun_dbg;
+   }
+
+let apply_function arity =
+  let (args, clos, body) = apply_function_body arity in
+  let all_args = args @ [clos] in
+  let fun_name = "caml_apply" ^ Int.to_string arity in
+  let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
+  Cfunction
+   {fun_name;
+    fun_args = List.map (fun arg -> (VP.create arg, typ_val)) all_args;
+    fun_body = body;
+    fun_codegen_options = [];
+    fun_dbg;
+   }
+
+(* Generate tuplifying functions:
+      (defun caml_tuplifyN (arg clos)
+        (app clos.direct #0(arg) ... #N-1(arg) clos)) *)
+
+let tuplify_function arity =
+  let dbg = placeholder_dbg in
+  let arg = V.create_local "arg" in
+  let clos = V.create_local "clos" in
+  let rec access_components i =
+    if i >= arity
+    then []
+    else get_field_gen Asttypes.Mutable (Cvar arg) i (dbg ())
+         :: access_components(i+1)
+  in
+  let fun_name = "caml_tuplify" ^ Int.to_string arity in
+  let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
+  Cfunction
+   {fun_name;
+    fun_args = [VP.create arg, typ_val; VP.create clos, typ_val];
+    fun_body =
+      Cop(Capply typ_val,
+          get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ())
+          :: access_components 0 @ [Cvar clos],
+          (dbg ()));
+    fun_codegen_options = [];
+    fun_dbg;
+   }
+
+(* Generate currying functions:
+      (defun caml_curryN (arg clos)
+         (alloc HDR caml_curryN_1  caml_curry_N_1_app arg clos))
+      (defun caml_curryN_1 (arg clos)
+         (alloc HDR caml_curryN_2  caml_curry_N_2_app arg clos))
+      ...
+      (defun caml_curryN_N-1 (arg clos)
+         (let (closN-2 clos.vars[1]
+               closN-3 closN-2.vars[1]
+               ...
+               clos1 clos2.vars[1]
+               clos clos1.vars[1])
+           (app clos.direct
+                clos1.vars[0] ... closN-2.vars[0] clos.vars[0] arg clos)))
+
+    Special "shortcut" functions are also generated to handle the
+    case where a partially applied function is applied to all remaining
+    arguments in one go.  For instance:
+      (defun caml_curry_N_1_app (arg2 ... argN clos)
+        (let clos' clos.vars[1]
+           (app clos'.direct clos.vars[0] arg2 ... argN clos')))
+
+    Those shortcuts may lead to a quadratic number of application
+    primitives being generated in the worst case, which resulted in
+    linking time blowup in practice (PR#5933), so we only generate and
+    use them when below a fixed arity 'max_arity_optimized'.
+*)
+
+let max_arity_optimized = 15
+let final_curry_function arity =
+  let dbg = placeholder_dbg in
+  let last_arg = V.create_local "arg" in
+  let last_clos = V.create_local "clos" in
+  let rec curry_fun args clos n =
+    if n = 0 then
+      Cop(Capply typ_val,
+          get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ()) ::
+            args @ [Cvar last_arg; Cvar clos],
+          dbg ())
+    else
+      if n = arity - 1 || arity > max_arity_optimized then
+        begin
+      let newclos = V.create_local "clos" in
+      Clet(VP.create newclos,
+           get_field_gen Asttypes.Mutable (Cvar clos) 3 (dbg ()),
+           curry_fun (get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ())
+                      :: args)
+             newclos (n-1))
+        end else
+        begin
+          let newclos = V.create_local "clos" in
+          Clet(VP.create newclos,
+               get_field_gen Asttypes.Mutable (Cvar clos) 4 (dbg ()),
+               curry_fun
+                 (get_field_gen Asttypes.Mutable (Cvar clos) 3 (dbg ()) :: args)
+                 newclos (n-1))
+    end in
+  let fun_name =
+    "caml_curry" ^ Int.to_string arity ^ "_" ^ Int.to_string (arity-1)
+  in
+  let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
+  Cfunction
+   {fun_name;
+    fun_args = [VP.create last_arg, typ_val; VP.create last_clos, typ_val];
+    fun_body = curry_fun [] last_clos (arity-1);
+    fun_codegen_options = [];
+    fun_dbg;
+   }
+
+let rec intermediate_curry_functions arity num =
+  let dbg = placeholder_dbg in
+  if num = arity - 1 then
+    [final_curry_function arity]
+  else begin
+    let name1 = "caml_curry" ^ Int.to_string arity in
+    let name2 = if num = 0 then name1 else name1 ^ "_" ^ Int.to_string num in
+    let arg = V.create_local "arg" and clos = V.create_local "clos" in
+    let fun_dbg = placeholder_fun_dbg ~human_name:name2 in
+    Cfunction
+     {fun_name = name2;
+      fun_args = [VP.create arg, typ_val; VP.create clos, typ_val];
+      fun_body =
+         if arity - num > 2 && arity <= max_arity_optimized then
+           Cop(Calloc,
+               [alloc_closure_header 5 (dbg ());
+                Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1), dbg ());
+                int_const (dbg ()) (arity - num - 1);
+                Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1) ^ "_app",
+                  dbg ());
+                Cvar arg; Cvar clos],
+               dbg ())
+         else
+           Cop(Calloc,
+                [alloc_closure_header 4 (dbg ());
+                 Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1), dbg ());
+                 int_const (dbg ()) 1; Cvar arg; Cvar clos],
+                dbg ());
+      fun_codegen_options = [];
+      fun_dbg;
+     }
+    ::
+      (if arity <= max_arity_optimized && arity - num > 2 then
+          let rec iter i =
+            if i <= arity then
+              let arg = V.create_local (Printf.sprintf "arg%d" i) in
+              (arg, typ_val) :: iter (i+1)
+            else []
+          in
+          let direct_args = iter (num+2) in
+          let rec iter i args clos =
+            if i = 0 then
+              Cop(Capply typ_val,
+                  (get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ()))
+                  :: args @ [Cvar clos],
+                  dbg ())
+            else
+              let newclos = V.create_local "clos" in
+              Clet(VP.create newclos,
+                   get_field_gen Asttypes.Mutable (Cvar clos) 4 (dbg ()),
+                   iter (i-1)
+                     (get_field_gen Asttypes.Mutable (Cvar clos) 3 (dbg ())
+                      :: args)
+                     newclos)
+          in
+          let fun_args =
+            List.map (fun (arg, ty) -> VP.create arg, ty)
+              (direct_args @ [clos, typ_val])
+          in
+          let fun_name = name1 ^ "_" ^ Int.to_string (num+1) ^ "_app" in
+          let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
+          let cf =
+            Cfunction
+              {fun_name;
+               fun_args;
+               fun_body = iter (num+1)
+                  (List.map (fun (arg,_) -> Cvar arg) direct_args) clos;
+               fun_codegen_options = [];
+               fun_dbg;
+              }
+          in
+          cf :: intermediate_curry_functions arity (num+1)
+       else
+          intermediate_curry_functions arity (num+1))
+  end
+
+let curry_function arity =
+  assert(arity <> 0);
+  (* Functions with arity = 0 does not have a curry_function *)
+  if arity > 0
+  then intermediate_curry_functions arity 0
+  else [tuplify_function (-arity)]
+
+module Int = Numbers.Int
+
+let default_apply = Int.Set.add 2 (Int.Set.add 3 Int.Set.empty)
+  (* These apply funs are always present in the main program because
+     the run-time system needs them (cf. runtime/.S) . *)
+
+let generic_functions shared units =
+  let (apply,send,curry) =
+    List.fold_left
+      (fun (apply,send,curry) (ui : Cmx_format.unit_infos) ->
+         List.fold_right Int.Set.add ui.ui_apply_fun apply,
+         List.fold_right Int.Set.add ui.ui_send_fun send,
+         List.fold_right Int.Set.add ui.ui_curry_fun curry)
+      (Int.Set.empty,Int.Set.empty,Int.Set.empty)
+      units in
+  let apply = if shared then apply else Int.Set.union apply default_apply in
+  let accu = Int.Set.fold (fun n accu -> apply_function n :: accu) apply [] in
+  let accu = Int.Set.fold (fun n accu -> send_function n :: accu) send accu in
+  Int.Set.fold (fun n accu -> curry_function n @ accu) curry accu
+
+(* Primitives *)
+
+type unary_primitive = expression -> Debuginfo.t -> expression
+
+let floatfield n ptr dbg =
+  Cop(Cload (Double_u, Mutable),
+      [if n = 0 then ptr
+       else Cop(Cadda, [ptr; Cconst_int(n * size_float, dbg)], dbg)],
+      dbg)
+
+let int_as_pointer arg dbg =
+  Cop(Caddi, [arg; Cconst_int (-1, dbg)], dbg)
+  (* always a pointer outside the heap *)
+
+let raise_prim raise_kind arg dbg =
+  if !Clflags.debug then
+    Cop (Craise raise_kind, [arg], dbg)
+  else
+    Cop (Craise Lambda.Raise_notrace, [arg], dbg)
+
+let negint arg dbg =
+  Cop(Csubi, [Cconst_int (2, dbg); arg], dbg)
+
+(* [offsetint] moved down to reuse add_int_caml *)
+
+let offsetref n arg dbg =
+  return_unit dbg
+    (bind "ref" arg (fun arg ->
+         Cop(Cstore (Word_int, Assignment),
+             [arg;
+              add_const (Cop(Cload (Word_int, Mutable), [arg], dbg))
+                (n lsl 1) dbg],
+             dbg)))
+
+let arraylength kind arg dbg =
+  let hdr = get_header_without_profinfo arg dbg in
+  match (kind : Lambda.array_kind) with
+    Pgenarray ->
+      let len =
+        if wordsize_shift = numfloat_shift then
+          Cop(Clsr, [hdr; Cconst_int (wordsize_shift, dbg)], dbg)
+        else
+          bind "header" hdr (fun hdr ->
+              Cifthenelse(is_addr_array_hdr hdr dbg,
+                          dbg,
+                          Cop(Clsr,
+                            [hdr; Cconst_int (wordsize_shift, dbg)], dbg),
+                          dbg,
+                          Cop(Clsr,
+                            [hdr; Cconst_int (numfloat_shift, dbg)], dbg),
+                          dbg))
+      in
+      Cop(Cor, [len; Cconst_int (1, dbg)], dbg)
+  | Paddrarray | Pintarray ->
+      Cop(Cor, [addr_array_length_shifted hdr dbg; Cconst_int (1, dbg)], dbg)
+  | Pfloatarray ->
+      Cop(Cor, [float_array_length_shifted hdr dbg; Cconst_int (1, dbg)], dbg)
+
+let bbswap bi arg dbg =
+  let prim = match (bi : Primitive.boxed_integer) with
+    | Pnativeint -> "nativeint"
+    | Pint32 -> "int32"
+    | Pint64 -> "int64"
+  in
+  Cop(Cextcall(Printf.sprintf "caml_%s_direct_bswap" prim,
+               typ_int, false, None),
+      [arg],
+      dbg)
+
+let bswap16 arg dbg =
+  (Cop(Cextcall("caml_bswap16_direct", typ_int, false, None),
+       [arg],
+       dbg))
+
+type binary_primitive = expression -> expression -> Debuginfo.t -> expression
+
+(* let pfield_computed = addr_array_ref *)
+
+(* Helper for compilation of initialization and assignment operations *)
+
+type assignment_kind = Caml_modify | Caml_initialize | Simple
+
+let assignment_kind
+    (ptr: Lambda.immediate_or_pointer)
+    (init: Lambda.initialization_or_assignment) =
+  match init, ptr with
+  | Assignment, Pointer -> Caml_modify
+  | Heap_initialization, Pointer -> Caml_initialize
+  | Assignment, Immediate
+  | Heap_initialization, Immediate
+  | Root_initialization, (Immediate | Pointer) -> Simple
+
+let setfield n ptr init arg1 arg2 dbg =
+  match assignment_kind ptr init with
+  | Caml_modify ->
+      return_unit dbg (Cop(Cextcall("caml_modify", typ_void, false, None),
+                      [field_address arg1 n dbg;
+                       arg2],
+                      dbg))
+  | Caml_initialize ->
+      return_unit dbg (Cop(Cextcall("caml_initialize", typ_void, false, None),
+                      [field_address arg1 n dbg;
+                       arg2],
+                      dbg))
+  | Simple ->
+      return_unit dbg (set_field arg1 n arg2 init dbg)
+
+let setfloatfield n init arg1 arg2 dbg =
+  return_unit dbg (
+    Cop(Cstore (Double_u, init),
+        [if n = 0 then arg1
+         else Cop(Cadda, [arg1; Cconst_int(n * size_float, dbg)], dbg);
+         arg2], dbg))
+
+let add_int_caml arg1 arg2 dbg =
+  decr_int (add_int arg1 arg2 dbg) dbg
+
+(* Unary primitive delayed to reuse add_int_caml *)
+let offsetint n arg dbg =
+  if Misc.no_overflow_lsl n 1 then
+    add_const arg (n lsl 1) dbg
+  else
+    add_int_caml arg (int_const dbg n) dbg
+
+let sub_int_caml arg1 arg2 dbg =
+  incr_int (sub_int arg1 arg2 dbg) dbg
+
+let mul_int_caml arg1 arg2 dbg =
+  (* decrementing the non-constant part helps when the multiplication is
+     followed by an addition;
+     for example, using this trick compiles (100 * a + 7) into
+       (+ ( * a 100) -85)
+     rather than
+       (+ ( * 200 (>>s a 1)) 15)
+  *)
+  match arg1, arg2 with
+  | Cconst_int _ as c1, c2 ->
+      incr_int (mul_int (untag_int c1 dbg) (decr_int c2 dbg) dbg) dbg
+  | c1, c2 ->
+      incr_int (mul_int (decr_int c1 dbg) (untag_int c2 dbg) dbg) dbg
+
+let div_int_caml is_safe arg1 arg2 dbg =
+  tag_int(div_int (untag_int arg1 dbg)
+            (untag_int arg2 dbg) is_safe dbg) dbg
+
+let mod_int_caml is_safe arg1 arg2 dbg =
+  tag_int(mod_int (untag_int arg1 dbg)
+            (untag_int arg2 dbg) is_safe dbg) dbg
+
+let and_int_caml arg1 arg2 dbg =
+  Cop(Cand, [arg1; arg2], dbg)
+
+let or_int_caml arg1 arg2 dbg =
+  Cop(Cor, [arg1; arg2], dbg)
+
+let xor_int_caml arg1 arg2 dbg =
+  Cop(Cor, [Cop(Cxor, [ignore_low_bit_int arg1;
+                       ignore_low_bit_int arg2], dbg);
+            Cconst_int (1, dbg)], dbg)
+
+let lsl_int_caml arg1 arg2 dbg =
+  incr_int(lsl_int (decr_int arg1 dbg)
+             (untag_int arg2 dbg) dbg) dbg
+
+let lsr_int_caml arg1 arg2 dbg =
+  Cop(Cor, [lsr_int arg1 (untag_int arg2 dbg) dbg;
+            Cconst_int (1, dbg)], dbg)
+
+let asr_int_caml arg1 arg2 dbg =
+  Cop(Cor, [asr_int arg1 (untag_int arg2 dbg) dbg;
+            Cconst_int (1, dbg)], dbg)
+
+let int_comp_caml cmp arg1 arg2 dbg =
+  tag_int(Cop(Ccmpi cmp,
+              [arg1; arg2], dbg)) dbg
+
+let stringref_unsafe arg1 arg2 dbg =
+  tag_int(Cop(Cload (Byte_unsigned, Mutable),
+              [add_int arg1 (untag_int arg2 dbg) dbg],
+              dbg)) dbg
+
+let stringref_safe arg1 arg2 dbg =
+  tag_int
+    (bind "str" arg1 (fun str ->
+      bind "index" (untag_int arg2 dbg) (fun idx ->
+        Csequence(
+          make_checkbound dbg [string_length str dbg; idx],
+          Cop(Cload (Byte_unsigned, Mutable),
+            [add_int str idx dbg], dbg))))) dbg
+
+let string_load size unsafe arg1 arg2 dbg =
+  box_sized size dbg
+    (bind "str" arg1 (fun str ->
+     bind "index" (untag_int arg2 dbg) (fun idx ->
+       check_bound unsafe size dbg
+          (string_length str dbg)
+          idx (unaligned_load size str idx dbg))))
+
+let bigstring_load size unsafe arg1 arg2 dbg =
+  box_sized size dbg
+   (bind "ba" arg1 (fun ba ->
+    bind "index" (untag_int arg2 dbg) (fun idx ->
+    bind "ba_data"
+     (Cop(Cload (Word_int, Mutable), [field_address ba 1 dbg], dbg))
+     (fun ba_data ->
+        check_bound unsafe size dbg
+          (bigstring_length ba dbg)
+          idx
+          (unaligned_load size ba_data idx dbg)))))
+
+let arrayref_unsafe kind arg1 arg2 dbg =
+  match (kind : Lambda.array_kind) with
+  | Pgenarray ->
+      bind "arr" arg1 (fun arr ->
+        bind "index" arg2 (fun idx ->
+          Cifthenelse(is_addr_array_ptr arr dbg,
+                      dbg,
+                      addr_array_ref arr idx dbg,
+                      dbg,
+                      float_array_ref arr idx dbg,
+                      dbg)))
+  | Paddrarray ->
+      addr_array_ref arg1 arg2 dbg
+  | Pintarray ->
+      (* CR mshinwell: for int/addr_array_ref move "dbg" to first arg *)
+      int_array_ref arg1 arg2 dbg
+  | Pfloatarray ->
+      float_array_ref arg1 arg2 dbg
+
+let arrayref_safe kind arg1 arg2 dbg =
+  match (kind : Lambda.array_kind) with
+  | Pgenarray ->
+      bind "index" arg2 (fun idx ->
+      bind "arr" arg1 (fun arr ->
+      bind "header" (get_header_without_profinfo arr dbg) (fun hdr ->
+        if wordsize_shift = numfloat_shift then
+          Csequence(
+            make_checkbound dbg [addr_array_length_shifted hdr dbg; idx],
+            Cifthenelse(is_addr_array_hdr hdr dbg,
+                        dbg,
+                        addr_array_ref arr idx dbg,
+                        dbg,
+                        float_array_ref arr idx dbg,
+                        dbg))
+        else
+          Cifthenelse(is_addr_array_hdr hdr dbg,
+            dbg,
+            Csequence(
+              make_checkbound dbg [addr_array_length_shifted hdr dbg; idx],
+              addr_array_ref arr idx dbg),
+            dbg,
+            Csequence(
+              make_checkbound dbg [float_array_length_shifted hdr dbg; idx],
+              float_array_ref arr idx dbg),
+            dbg))))
+      | Paddrarray ->
+          bind "index" arg2 (fun idx ->
+          bind "arr" arg1 (fun arr ->
+            Csequence(
+              make_checkbound dbg [
+                addr_array_length_shifted
+                  (get_header_without_profinfo arr dbg) dbg; idx],
+              addr_array_ref arr idx dbg)))
+      | Pintarray ->
+          bind "index" arg2 (fun idx ->
+          bind "arr" arg1 (fun arr ->
+            Csequence(
+              make_checkbound dbg [
+                addr_array_length_shifted
+                  (get_header_without_profinfo arr dbg) dbg; idx],
+              int_array_ref arr idx dbg)))
+      | Pfloatarray ->
+          box_float dbg (
+            bind "index" arg2 (fun idx ->
+            bind "arr" arg1 (fun arr ->
+              Csequence(
+                make_checkbound dbg [
+                  float_array_length_shifted
+                    (get_header_without_profinfo arr dbg) dbg;
+                  idx],
+                unboxed_float_array_ref arr idx dbg))))
+
+type ternary_primitive =
+  expression -> expression -> expression -> Debuginfo.t -> expression
+
+let setfield_computed ptr init arg1 arg2 arg3 dbg =
+  match assignment_kind ptr init with
+  | Caml_modify ->
+      return_unit dbg (addr_array_set arg1 arg2 arg3 dbg)
+  | Caml_initialize ->
+      return_unit dbg (addr_array_initialize arg1 arg2 arg3 dbg)
+  | Simple ->
+      return_unit dbg (int_array_set arg1 arg2 arg3 dbg)
+
+let bytesset_unsafe arg1 arg2 arg3 dbg =
+      return_unit dbg (Cop(Cstore (Byte_unsigned, Assignment),
+                      [add_int arg1 (untag_int arg2 dbg) dbg;
+                       ignore_high_bit_int (untag_int arg3 dbg)], dbg))
+
+let bytesset_safe arg1 arg2 arg3 dbg =
+  return_unit dbg
+    (bind "str" arg1 (fun str ->
+      bind "index" (untag_int arg2 dbg) (fun idx ->
+        Csequence(
+          make_checkbound dbg [string_length str dbg; idx],
+          Cop(Cstore (Byte_unsigned, Assignment),
+              [add_int str idx dbg;
+               ignore_high_bit_int (untag_int arg3 dbg)],
+              dbg)))))
+
+let arrayset_unsafe kind arg1 arg2 arg3 dbg =
+  return_unit dbg (match (kind: Lambda.array_kind) with
+  | Pgenarray ->
+      bind "newval" arg3 (fun newval ->
+        bind "index" arg2 (fun index ->
+          bind "arr" arg1 (fun arr ->
+            Cifthenelse(is_addr_array_ptr arr dbg,
+                        dbg,
+                        addr_array_set arr index newval dbg,
+                        dbg,
+                        float_array_set arr index (unbox_float dbg newval)
+                          dbg,
+                        dbg))))
+  | Paddrarray ->
+      addr_array_set arg1 arg2 arg3 dbg
+  | Pintarray ->
+      int_array_set arg1 arg2 arg3 dbg
+  | Pfloatarray ->
+      float_array_set arg1 arg2 arg3 dbg
+  )
+
+let arrayset_safe kind arg1 arg2 arg3 dbg =
+  return_unit dbg (match (kind: Lambda.array_kind) with
+  | Pgenarray ->
+      bind "newval" arg3 (fun newval ->
+      bind "index" arg2 (fun idx ->
+      bind "arr" arg1 (fun arr ->
+      bind "header" (get_header_without_profinfo arr dbg) (fun hdr ->
+        if wordsize_shift = numfloat_shift then
+          Csequence(
+            make_checkbound dbg [addr_array_length_shifted hdr dbg; idx],
+            Cifthenelse(is_addr_array_hdr hdr dbg,
+                        dbg,
+                        addr_array_set arr idx newval dbg,
+                        dbg,
+                        float_array_set arr idx
+                          (unbox_float dbg newval)
+                          dbg,
+                        dbg))
+        else
+          Cifthenelse(
+            is_addr_array_hdr hdr dbg,
+            dbg,
+            Csequence(
+              make_checkbound dbg [addr_array_length_shifted hdr dbg; idx],
+              addr_array_set arr idx newval dbg),
+            dbg,
+            Csequence(
+              make_checkbound dbg [float_array_length_shifted hdr dbg; idx],
+              float_array_set arr idx
+                (unbox_float dbg newval) dbg),
+            dbg)))))
+  | Paddrarray ->
+      bind "newval" arg3 (fun newval ->
+      bind "index" arg2 (fun idx ->
+      bind "arr" arg1 (fun arr ->
+        Csequence(
+          make_checkbound dbg [
+            addr_array_length_shifted
+              (get_header_without_profinfo arr dbg) dbg;
+            idx],
+          addr_array_set arr idx newval dbg))))
+  | Pintarray ->
+      bind "newval" arg3 (fun newval ->
+      bind "index" arg2 (fun idx ->
+      bind "arr" arg1 (fun arr ->
+        Csequence(
+          make_checkbound dbg [
+            addr_array_length_shifted
+              (get_header_without_profinfo arr dbg) dbg;
+            idx],
+          int_array_set arr idx newval dbg))))
+  | Pfloatarray ->
+      bind_load "newval" arg3 (fun newval ->
+      bind "index" arg2 (fun idx ->
+      bind "arr" arg1 (fun arr ->
+        Csequence(
+          make_checkbound dbg [
+            float_array_length_shifted
+              (get_header_without_profinfo arr dbg) dbg;
+            idx],
+          float_array_set arr idx newval dbg))))
+  )
+
+let bytes_set size unsafe arg1 arg2 arg3 dbg =
+  return_unit dbg
+   (bind "str" arg1 (fun str ->
+    bind "index" (untag_int arg2 dbg) (fun idx ->
+    bind "newval" arg3 (fun newval ->
+      check_bound unsafe size dbg (string_length str dbg)
+                  idx (unaligned_set size str idx newval dbg)))))
+
+let bigstring_set size unsafe arg1 arg2 arg3 dbg =
+  return_unit dbg
+   (bind "ba" arg1 (fun ba ->
+    bind "index" (untag_int arg2 dbg) (fun idx ->
+    bind "newval" arg3 (fun newval ->
+    bind "ba_data"
+         (Cop(Cload (Word_int, Mutable), [field_address ba 1 dbg], dbg))
+         (fun ba_data ->
+            check_bound unsafe size dbg (bigstring_length ba dbg)
+              idx (unaligned_set size ba_data idx newval dbg))))))
+
+(* Symbols *)
+
+let cdefine_symbol (symb, (global: Cmmgen_state.is_global)) =
+  match global with
+  | Global -> [Cglobal_symbol symb; Cdefine_symbol symb]
+  | Local -> [Cdefine_symbol symb]
+
+let emit_block symb white_header cont =
+  (* Headers for structured constants must be marked black in case we
+     are in no-naked-pointers mode.  See [caml_darken]. *)
+  let black_header = Nativeint.logor white_header caml_black in
+  Cint black_header :: cdefine_symbol symb @ cont
+
+let emit_string_constant_fields s cont =
+  let n = size_int - 1 - (String.length s) mod size_int in
+  Cstring s :: Cskip n :: Cint8 n :: cont
+
+let emit_boxed_int32_constant_fields n cont =
+  let n = Nativeint.of_int32 n in
+  if size_int = 8 then
+    Csymbol_address caml_int32_ops :: Cint32 n :: Cint32 0n :: cont
+  else
+    Csymbol_address caml_int32_ops :: Cint n :: cont
+
+let emit_boxed_int64_constant_fields n cont =
+  let lo = Int64.to_nativeint n in
+  if size_int = 8 then
+    Csymbol_address caml_int64_ops :: Cint lo :: cont
+  else begin
+    let hi = Int64.to_nativeint (Int64.shift_right n 32) in
+    if big_endian then
+      Csymbol_address caml_int64_ops :: Cint hi :: Cint lo :: cont
+    else
+      Csymbol_address caml_int64_ops :: Cint lo :: Cint hi :: cont
+  end
+
+let emit_boxed_nativeint_constant_fields n cont =
+  Csymbol_address caml_nativeint_ops :: Cint n :: cont
+
+let emit_float_constant symb f cont =
+  emit_block symb float_header (Cdouble f :: cont)
+
+let emit_string_constant symb s cont =
+  emit_block symb (string_header (String.length s))
+    (emit_string_constant_fields s cont)
+
+let emit_int32_constant symb n cont =
+  emit_block symb boxedint32_header
+    (emit_boxed_int32_constant_fields n cont)
+
+let emit_int64_constant symb n cont =
+  emit_block symb boxedint64_header
+    (emit_boxed_int64_constant_fields n cont)
+
+let emit_nativeint_constant symb n cont =
+  emit_block symb boxedintnat_header
+    (emit_boxed_nativeint_constant_fields n cont)
+
+let emit_float_array_constant symb fields cont =
+  emit_block symb (floatarray_header (List.length fields))
+    (Misc.map_end (fun f -> Cdouble f) fields cont)
+
+(* Generate the entry point *)
+
+let entry_point namelist =
+  let dbg = placeholder_dbg in
+  let cconst_int i = Cconst_int (i, dbg ()) in
+  let cconst_symbol sym = Cconst_symbol (sym, dbg ()) in
+  let incr_global_inited () =
+    Cop(Cstore (Word_int, Assignment),
+        [cconst_symbol "caml_globals_inited";
+         Cop(Caddi, [Cop(Cload (Word_int, Mutable),
+                       [cconst_symbol "caml_globals_inited"], dbg ());
+                     cconst_int 1], dbg ())], dbg ()) in
+  let body =
+    List.fold_right
+      (fun name next ->
+        let entry_sym = Compilenv.make_symbol ~unitname:name (Some "entry") in
+        Csequence(Cop(Capply typ_void,
+                         [cconst_symbol entry_sym], dbg ()),
+                  Csequence(incr_global_inited (), next)))
+      namelist (cconst_int 1) in
+  let fun_name = "caml_program" in
+  let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
+  Cfunction {fun_name;
+             fun_args = [];
+             fun_body = body;
+             fun_codegen_options = [Reduce_code_size];
+             fun_dbg;
+            }
+
+(* Generate the table of globals *)
+
+let cint_zero = Cint 0n
+
+let global_table namelist =
+  let mksym name =
+    Csymbol_address (Compilenv.make_symbol ~unitname:name (Some "gc_roots"))
+  in
+  Cdata(Cglobal_symbol "caml_globals" ::
+        Cdefine_symbol "caml_globals" ::
+        List.map mksym namelist @
+        [cint_zero])
+
+let reference_symbols namelist =
+  let mksym name = Csymbol_address name in
+  Cdata(List.map mksym namelist)
+
+let global_data name v =
+  Cdata(emit_string_constant (name, Global)
+          (Marshal.to_string v []) [])
+
+let globals_map v = global_data "caml_globals_map" v
+
+(* Generate the master table of frame descriptors *)
+
+let frame_table namelist =
+  let mksym name =
+    Csymbol_address (Compilenv.make_symbol ~unitname:name (Some "frametable"))
+  in
+  Cdata(Cglobal_symbol "caml_frametable" ::
+        Cdefine_symbol "caml_frametable" ::
+        List.map mksym namelist
+        @ [cint_zero])
+
+(* Generate the master table of Spacetime shapes *)
+
+let spacetime_shapes namelist =
+  let mksym name =
+    Csymbol_address (
+      Compilenv.make_symbol ~unitname:name (Some "spacetime_shapes"))
+  in
+  Cdata(Cglobal_symbol "caml_spacetime_shapes" ::
+        Cdefine_symbol "caml_spacetime_shapes" ::
+        List.map mksym namelist
+        @ [cint_zero])
+
+(* Generate the table of module data and code segments *)
+
+let segment_table namelist symbol begname endname =
+  let addsyms name lst =
+    Csymbol_address (Compilenv.make_symbol ~unitname:name (Some begname)) ::
+    Csymbol_address (Compilenv.make_symbol ~unitname:name (Some endname)) ::
+    lst
+  in
+  Cdata(Cglobal_symbol symbol ::
+        Cdefine_symbol symbol ::
+        List.fold_right addsyms namelist [cint_zero])
+
+let data_segment_table namelist =
+  segment_table namelist "caml_data_segments" "data_begin" "data_end"
+
+let code_segment_table namelist =
+  segment_table namelist "caml_code_segments" "code_begin" "code_end"
+
+(* Initialize a predefined exception *)
+
+let predef_exception i name =
+  let name_sym = Compilenv.new_const_symbol () in
+  let data_items =
+    emit_string_constant (name_sym, Local) name []
+  in
+  let exn_sym = "caml_exn_" ^ name in
+  let tag = Obj.object_tag in
+  let size = 2 in
+  let fields =
+    (Csymbol_address name_sym)
+      :: (cint_const (-i - 1))
+      :: data_items
+  in
+  let data_items =
+    emit_block (exn_sym, Global) (block_header tag size) fields
+  in
+  Cdata data_items
+
+(* Header for a plugin *)
+
+let plugin_header units =
+  let mk ((ui : Cmx_format.unit_infos),crc) : Cmxs_format.dynunit =
+    { dynu_name = ui.ui_name;
+      dynu_crc = crc;
+      dynu_imports_cmi = ui.ui_imports_cmi;
+      dynu_imports_cmx = ui.ui_imports_cmx;
+      dynu_defines = ui.ui_defines
+    } in
+  global_data "caml_plugin_header"
+    ({ dynu_magic = Config.cmxs_magic_number;
+       dynu_units = List.map mk units }
+     : Cmxs_format.dynheader)
+
+(* To compile "let rec" over values *)
+
+let fundecls_size fundecls =
+  let sz = ref (-1) in
+  List.iter
+    (fun (f : Clambda.ufunction) ->
+       let indirect_call_code_pointer_size =
+         match f.arity with
+         | 0 | 1 -> 0
+           (* arity 1 does not need an indirect call handler.
+              arity 0 cannot be indirect called *)
+         | _ -> 1
+           (* For other arities there is an indirect call handler.
+              if arity >= 2 it is caml_curry...
+              if arity < 0 it is caml_tuplify... *)
+       in
+       sz := !sz + 1 + 2 + indirect_call_code_pointer_size)
+    fundecls;
+  !sz
+
+(* Emit constant closures *)
+
+let emit_constant_closure ((_, global_symb) as symb) fundecls clos_vars cont =
+  let closure_symbol (f : Clambda.ufunction) =
+    if Config.flambda then
+      cdefine_symbol (f.label ^ "_closure", global_symb)
+    else
+      []
+  in
+  match (fundecls : Clambda.ufunction list) with
+    [] ->
+      (* This should probably not happen: dead code has normally been
+         eliminated and a closure cannot be accessed without going through
+         a [Project_closure], which depends on the function. *)
+      assert (clos_vars = []);
+      cdefine_symbol symb @ clos_vars @ cont
+  | f1 :: remainder ->
+      let rec emit_others pos = function
+          [] -> clos_vars @ cont
+      | (f2 : Clambda.ufunction) :: rem ->
+          if f2.arity = 1 || f2.arity = 0 then
+            Cint(infix_header pos) ::
+            (closure_symbol f2) @
+            Csymbol_address f2.label ::
+            cint_const f2.arity ::
+            emit_others (pos + 3) rem
+          else
+            Cint(infix_header pos) ::
+            (closure_symbol f2) @
+            Csymbol_address(curry_function_sym f2.arity) ::
+            cint_const f2.arity ::
+            Csymbol_address f2.label ::
+            emit_others (pos + 4) rem in
+      Cint(black_closure_header (fundecls_size fundecls
+                                 + List.length clos_vars)) ::
+      cdefine_symbol symb @
+      (closure_symbol f1) @
+      if f1.arity = 1 || f1.arity = 0 then
+        Csymbol_address f1.label ::
+        cint_const f1.arity ::
+        emit_others 3 remainder
+      else
+        Csymbol_address(curry_function_sym f1.arity) ::
+        cint_const f1.arity ::
+        Csymbol_address f1.label ::
+        emit_others 4 remainder
+
+(* Build the NULL terminated array of gc roots *)
+
+let emit_gc_roots_table ~symbols cont =
+  let table_symbol = Compilenv.make_symbol (Some "gc_roots") in
+  Cdata(Cglobal_symbol table_symbol ::
+        Cdefine_symbol table_symbol ::
+        List.map (fun s -> Csymbol_address s) symbols @
+        [Cint 0n])
+  :: cont
+
+(* Build preallocated blocks (used for Flambda [Initialize_symbol]
+   constructs, and Clambda global module) *)
+
+let preallocate_block cont { Clambda.symbol; exported; tag; fields } =
+  let space =
+    (* These words will be registered as roots and as such must contain
+       valid values, in case we are in no-naked-pointers mode.  Likewise
+       the block header must be black, below (see [caml_darken]), since
+       the overall record may be referenced. *)
+    List.map (fun field ->
+        match field with
+        | None ->
+            Cint (Nativeint.of_int 1 (* Val_unit *))
+        | Some (Clambda.Uconst_field_int n) ->
+            cint_const n
+        | Some (Clambda.Uconst_field_ref label) ->
+            Csymbol_address label)
+      fields
+  in
+  let global = Cmmgen_state.(if exported then Global else Local) in
+  let symb = (symbol, global) in
+  let data =
+    emit_block symb (block_header tag (List.length fields)) space
+  in
+  Cdata data :: cont
+
+let emit_preallocated_blocks preallocated_blocks cont =
+  let symbols =
+    List.map (fun ({ Clambda.symbol }:Clambda.preallocated_block) -> symbol)
+      preallocated_blocks
+  in
+  let c1 = emit_gc_roots_table ~symbols cont in
+  List.fold_left preallocate_block c1 preallocated_blocks
diff --git a/asmcomp/cmm_helpers.mli b/asmcomp/cmm_helpers.mli
new file mode 100644
index 00000000..c1ace961
--- /dev/null
+++ b/asmcomp/cmm_helpers.mli
@@ -0,0 +1,652 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Cmm
+
+(** [bind name arg fn] is equivalent to [let name = arg in fn name],
+    or simply [fn arg] if [arg] is simple enough *)
+val bind :
+  string -> expression -> (expression -> expression) -> expression
+
+(** Same as [bind], but also treats loads from a variable as simple *)
+val bind_load :
+  string -> expression -> (expression -> expression) -> expression
+
+(** Same as [bind], but does not treat variables as simple *)
+val bind_nonvar :
+  string -> expression -> (expression -> expression) -> expression
+
+(** Headers *)
+
+(** A null header with GC bits set to black *)
+val caml_black : nativeint
+
+(** A constant equal to the tag for float arrays *)
+val floatarray_tag : Debuginfo.t -> expression
+
+(** [block_header tag size] creates a header with tag [tag] for a
+    block of size [size] *)
+val block_header : int -> int -> nativeint
+
+(** Same as block_header, but with GC bits set to black *)
+val black_block_header : int -> int -> nativeint
+
+(** Closure headers of the given size *)
+val white_closure_header : int -> nativeint
+val black_closure_header : int -> nativeint
+
+(** Infix header at the given offset *)
+val infix_header : int -> nativeint
+
+(** Header for a boxed float value *)
+val float_header : nativeint
+
+(** Header for an unboxed float array of the given size *)
+val floatarray_header : int -> nativeint
+
+(** Header for a string (or bytes) of the given length *)
+val string_header : int -> nativeint
+
+(** Boxed integer headers *)
+val boxedint32_header : nativeint
+val boxedint64_header : nativeint
+val boxedintnat_header : nativeint
+
+(** Wrappers *)
+val alloc_float_header : Debuginfo.t -> expression
+val alloc_floatarray_header : int -> Debuginfo.t -> expression
+val alloc_closure_header : int -> Debuginfo.t -> expression
+val alloc_infix_header : int -> Debuginfo.t -> expression
+val alloc_boxedint32_header : Debuginfo.t -> expression
+val alloc_boxedint64_header : Debuginfo.t -> expression
+val alloc_boxedintnat_header : Debuginfo.t -> expression
+
+(** Integers *)
+
+(** Minimal/maximal OCaml integer values whose backend representation fits
+    in a regular OCaml integer *)
+val max_repr_int : int
+val min_repr_int : int
+
+(** Make an integer constant from the given integer (tags the integer) *)
+val int_const : Debuginfo.t -> int -> expression
+val cint_const : int -> data_item
+val targetint_const : int -> Targetint.t
+
+(** Make a Cmm constant holding the given nativeint value.
+    Uses [Cconst_int] instead of [Cconst_nativeint] when possible
+    to preserve peephole optimisations. *)
+val natint_const_untagged : Debuginfo.t -> Nativeint.t -> expression
+
+(** Add an integer to the given expression *)
+val add_const : expression -> int -> Debuginfo.t -> expression
+
+(** Increment/decrement of integers *)
+val incr_int : expression -> Debuginfo.t -> expression
+val decr_int : expression -> Debuginfo.t -> expression
+
+(** Simplify the given expression knowing its last bit will be
+    irrelevant *)
+val ignore_low_bit_int : expression -> expression
+
+(** Simplify the given expression knowing its first bit will be
+    irrelevant *)
+val ignore_high_bit_int : expression -> expression
+
+(** Arithmetical operations on integers *)
+val add_int : expression -> expression -> Debuginfo.t -> expression
+val sub_int : expression -> expression -> Debuginfo.t -> expression
+val lsl_int : expression -> expression -> Debuginfo.t -> expression
+val mul_int : expression -> expression -> Debuginfo.t -> expression
+val lsr_int : expression -> expression -> Debuginfo.t -> expression
+val asr_int : expression -> expression -> Debuginfo.t -> expression
+val div_int :
+  expression -> expression -> Lambda.is_safe -> Debuginfo.t -> expression
+val mod_int :
+  expression -> expression -> Lambda.is_safe -> Debuginfo.t -> expression
+
+(** Integer tagging. [tag_int x = (x lsl 1) + 1] *)
+val tag_int : expression -> Debuginfo.t -> expression
+
+(** Integer untagging. [untag_int x = (x asr 1)] *)
+val untag_int : expression -> Debuginfo.t -> expression
+
+(** Specific division operations for boxed integers *)
+val safe_div_bi :
+  Lambda.is_safe ->
+  expression ->
+  expression ->
+  Primitive.boxed_integer ->
+  Debuginfo.t ->
+  expression
+val safe_mod_bi :
+  Lambda.is_safe ->
+  expression ->
+  expression ->
+  Primitive.boxed_integer ->
+  Debuginfo.t ->
+  expression
+
+(** If-Then-Else expression
+    [mk_if_then_else dbg cond ifso_dbg ifso ifnot_dbg ifnot] associates
+    [dbg] to the global if-then-else expression, [ifso_dbg] to the
+    then branch [ifso], and [ifnot_dbg] to the else branch [ifnot] *)
+val mk_if_then_else :
+  Debuginfo.t ->
+  expression ->
+  Debuginfo.t -> expression ->
+  Debuginfo.t -> expression ->
+  expression
+
+(** Boolean negation *)
+val mk_not : Debuginfo.t -> expression -> expression
+
+(** Integer and float comparison that returns int not bool *)
+val mk_compare_ints : Debuginfo.t -> expression -> expression -> expression
+val mk_compare_floats : Debuginfo.t -> expression -> expression -> expression
+
+(** Loop construction (while true do expr done).
+    Used to be represented as Cloop. *)
+val create_loop : expression -> Debuginfo.t -> expression
+
+(** Exception raising *)
+val raise_symbol : Debuginfo.t -> string -> expression
+
+(** Convert a tagged integer into a raw integer with boolean meaning *)
+val test_bool : Debuginfo.t -> expression -> expression
+
+(** Float boxing and unboxing *)
+val box_float : Debuginfo.t -> expression -> expression
+val unbox_float : Debuginfo.t -> expression -> expression
+
+(** Complex number creation and access *)
+val box_complex : Debuginfo.t -> expression -> expression -> expression
+val complex_re : expression -> Debuginfo.t -> expression
+val complex_im : expression -> Debuginfo.t -> expression
+
+(** Make the given expression return a unit value *)
+val return_unit : Debuginfo.t -> expression -> expression
+
+(** Remove a trailing unit return if any *)
+val remove_unit : expression -> expression
+
+(** Blocks *)
+
+(** [field_address ptr n dbg] returns an expression for the address of the
+    [n]th field of the block pointed to by [ptr] *)
+val field_address : expression -> int -> Debuginfo.t -> expression
+
+(** [get_field_gen mut ptr n dbg] returns an expression for the access to the
+    [n]th field of the block pointed to by [ptr] *)
+val get_field_gen :
+  Asttypes.mutable_flag -> expression -> int -> Debuginfo.t -> expression
+
+(** [set_field ptr n newval init dbg] returns an expression for setting the
+    [n]th field of the block pointed to by [ptr] to [newval] *)
+val set_field :
+  expression -> int -> expression -> Lambda.initialization_or_assignment ->
+  Debuginfo.t -> expression
+
+(** Load a block's header *)
+val get_header : expression -> Debuginfo.t -> expression
+
+(** Same as [get_header], but also set all profiling bits of the header
+    are to 0 (if profiling is enabled) *)
+val get_header_without_profinfo : expression -> Debuginfo.t -> expression
+
+(** Load a block's tag *)
+val get_tag : expression -> Debuginfo.t -> expression
+
+(** Load a block's size *)
+val get_size : expression -> Debuginfo.t -> expression
+
+(** Arrays *)
+
+val wordsize_shift : int
+val numfloat_shift : int
+
+(** Check whether the given array is an array of regular OCaml values
+    (as opposed to unboxed floats), from its header or pointer *)
+val is_addr_array_hdr : expression -> Debuginfo.t -> expression
+val is_addr_array_ptr : expression -> Debuginfo.t -> expression
+
+(** Get the length of an array from its header
+    Shifts by one bit less than necessary, keeping one of the GC colour bits,
+    to save an operation when returning the length as a caml integer or when
+    comparing it to a caml integer.
+    Assumes the header does not have any profiling info
+    (as returned by get_header_without_profinfo) *)
+val addr_array_length_shifted : expression -> Debuginfo.t -> expression
+val float_array_length_shifted : expression -> Debuginfo.t -> expression
+
+(** For [array_indexing ?typ log2size ptr ofs dbg] :
+    Produces a pointer to the element of the array [ptr] on the position [ofs]
+    with the given element [log2size] log2 element size. [ofs] is given as a
+    tagged int expression.
+    The optional ?typ argument is the C-- type of the result.
+    By default, it is Addr, meaning we are constructing a derived pointer
+    into the heap.  If we know the pointer is outside the heap
+    (this is the case for bigarray indexing), we give type Int instead. *)
+val array_indexing :
+  ?typ:machtype_component -> int -> expression -> expression -> Debuginfo.t ->
+  expression
+
+(** Array loads and stores
+    [unboxed_float_array_ref] and [float_array_ref] differ in the
+    boxing of the result; [float_array_set] takes an unboxed float *)
+val addr_array_ref : expression -> expression -> Debuginfo.t -> expression
+val int_array_ref : expression -> expression -> Debuginfo.t -> expression
+val unboxed_float_array_ref :
+  expression -> expression -> Debuginfo.t -> expression
+val float_array_ref : expression -> expression -> Debuginfo.t -> expression
+val addr_array_set :
+  expression -> expression -> expression -> Debuginfo.t -> expression
+val addr_array_initialize :
+  expression -> expression -> expression -> Debuginfo.t -> expression
+val int_array_set :
+  expression -> expression -> expression -> Debuginfo.t -> expression
+val float_array_set :
+  expression -> expression -> expression -> Debuginfo.t -> expression
+
+(** Strings *)
+
+val string_length : expression -> Debuginfo.t -> expression
+val bigstring_length : expression -> Debuginfo.t -> expression
+
+(** Objects *)
+
+(** Lookup a method by its hash, using [caml_get_public_method]
+    Arguments :
+    - obj : the object from which to lookup
+    - tag : the hash of the method name, as a tagged integer *)
+val lookup_tag : expression -> expression -> Debuginfo.t -> expression
+
+(** Lookup a method by its offset in the method table
+    Arguments :
+    - obj : the object from which to lookup
+    - lab : the position of the required method in the object's
+    method array, as a tagged integer *)
+val lookup_label : expression -> expression -> Debuginfo.t -> expression
+
+(** Lookup and call a method using the method cache
+    Arguments :
+    - obj : the object from which to lookup
+    - tag : the hash of the method name, as a tagged integer
+    - cache : the method cache array
+    - pos : the position of the cache entry in the cache array
+    - args : the additional arguments to the method call *)
+val call_cached_method :
+  expression -> expression -> expression -> expression -> expression list ->
+  Debuginfo.t -> expression
+
+(** Allocations *)
+
+(** Allocate a block of regular values with the given tag *)
+val make_alloc : Debuginfo.t -> int -> expression list -> expression
+
+(** Allocate a block of unboxed floats with the given tag *)
+val make_float_alloc : Debuginfo.t -> int -> expression list -> expression
+
+(** Bounds checking *)
+
+(** Generate a [Ccheckbound] term *)
+val make_checkbound : Debuginfo.t -> expression list -> expression
+
+(** [check_bound safety access_size dbg length a2 k] prefixes expression [k]
+    with a check that reading [access_size] bits starting at position [a2]
+    in a string/bytes value of length [length] is within bounds, unless
+    [safety] is [Unsafe]. *)
+val check_bound :
+  Lambda.is_safe -> Clambda_primitives.memory_access_size -> Debuginfo.t ->
+  expression -> expression -> expression ->
+  expression
+
+(** Generic application functions *)
+
+(** Get the symbol for the generic application with [n] arguments, and
+    ensure its presence in the set of defined symbols *)
+val apply_function_sym : int -> string
+
+(** If [n] is positive, get the symbol for the generic currying wrapper with
+    [n] arguments, and ensure its presence in the set of defined symbols.
+    Otherwise, do the same for the generic tuple wrapper with [-n] arguments. *)
+val curry_function_sym : int -> string
+
+(** Bigarrays *)
+
+(** [bigarray_get unsafe kind layout b args dbg]
+    - unsafe : if true, do not insert bound checks
+    - kind : see [Lambda.bigarray_kind]
+    - layout : see [Lambda.bigarray_layout]
+    - b : the bigarray to load from
+    - args : a list of tagged integer expressions, corresponding to the
+    indices in the respective dimensions
+    - dbg : debugging information *)
+val bigarray_get :
+  bool -> Lambda.bigarray_kind -> Lambda.bigarray_layout ->
+  expression -> expression list -> Debuginfo.t ->
+  expression
+
+(** [bigarray_set unsafe kind layout b args newval dbg]
+    Same as [bigarray_get], with [newval] the value being assigned *)
+val bigarray_set :
+  bool -> Lambda.bigarray_kind -> Lambda.bigarray_layout ->
+  expression -> expression list -> expression -> Debuginfo.t ->
+  expression
+
+(** Operations on 32-bit integers *)
+
+(** [low_32 _ x] is a value which agrees with x on at least the low 32 bits *)
+val low_32 : Debuginfo.t -> expression -> expression
+
+(** Sign extend from 32 bits to the word size *)
+val sign_extend_32 : Debuginfo.t -> expression -> expression
+
+(** Zero extend from 32 bits to the word size *)
+val zero_extend_32 : Debuginfo.t -> expression -> expression
+
+(** Boxed numbers *)
+
+(** Global symbols for the ops field of boxed integers *)
+val caml_nativeint_ops : string
+val caml_int32_ops : string
+val caml_int64_ops : string
+
+(** Box a given integer, without sharing of constants *)
+val box_int_gen :
+  Debuginfo.t -> Primitive.boxed_integer -> expression -> expression
+
+(** Unbox a given boxed integer *)
+val unbox_int :
+  Debuginfo.t -> Primitive.boxed_integer -> expression -> expression
+
+(** Used to prepare 32-bit integers on 64-bit platforms for a lsr operation *)
+val make_unsigned_int :
+  Primitive.boxed_integer -> expression -> Debuginfo.t -> expression
+
+val unaligned_load_16 : expression -> expression -> Debuginfo.t -> expression
+val unaligned_set_16 :
+  expression -> expression -> expression -> Debuginfo.t -> expression
+val unaligned_load_32 : expression -> expression -> Debuginfo.t -> expression
+val unaligned_set_32 :
+  expression -> expression -> expression -> Debuginfo.t -> expression
+val unaligned_load_64 : expression -> expression -> Debuginfo.t -> expression
+val unaligned_set_64 :
+  expression -> expression -> expression -> Debuginfo.t -> expression
+
+(** Raw memory accesses *)
+
+(** [unaligned_set size ptr idx newval dbg] *)
+val unaligned_set :
+  Clambda_primitives.memory_access_size ->
+  expression -> expression -> expression -> Debuginfo.t -> expression
+
+(** [unaligned_load size ptr idx dbg] *)
+val unaligned_load :
+  Clambda_primitives.memory_access_size ->
+  expression -> expression -> Debuginfo.t -> expression
+
+(** [box_sized size dbg exp] *)
+val box_sized :
+  Clambda_primitives.memory_access_size ->
+  Debuginfo.t -> expression -> expression
+
+(** Primitives *)
+
+val simplif_primitive :
+  Clambda_primitives.primitive -> Clambda_primitives.primitive
+
+type unary_primitive = expression -> Debuginfo.t -> expression
+
+(** Return the n-th field of a float array (or float-only record), as an
+    unboxed float *)
+val floatfield : int -> unary_primitive
+
+(** Int_as_pointer primitive *)
+val int_as_pointer : unary_primitive
+
+(** Raise primitive *)
+val raise_prim : Lambda.raise_kind -> unary_primitive
+
+(** Unary negation of an OCaml integer *)
+val negint : unary_primitive
+
+(** Add a constant number to an OCaml integer *)
+val offsetint : int -> unary_primitive
+
+(** Add a constant number to an OCaml integer reference *)
+val offsetref : int -> unary_primitive
+
+(** Return the length of the array argument, as an OCaml integer *)
+val arraylength : Lambda.array_kind -> unary_primitive
+
+(** Byte swap primitive
+    Operates on Cmm integers (unboxed values) *)
+val bbswap : Primitive.boxed_integer -> unary_primitive
+
+(** 16-bit byte swap primitive
+    Operates on Cmm integers (untagged integers) *)
+val bswap16 : unary_primitive
+
+type binary_primitive = expression -> expression -> Debuginfo.t -> expression
+
+type assignment_kind = Caml_modify | Caml_initialize | Simple
+
+(** [setfield offset value_is_ptr init ptr value dbg] *)
+val setfield :
+  int -> Lambda.immediate_or_pointer -> Lambda.initialization_or_assignment ->
+  binary_primitive
+
+(** [setfloatfield offset init ptr value dbg]
+    [value] is expected to be an unboxed floating point number *)
+val setfloatfield :
+  int -> Lambda.initialization_or_assignment -> binary_primitive
+
+(** Operations on OCaml integers *)
+val add_int_caml : binary_primitive
+val sub_int_caml : binary_primitive
+val mul_int_caml : binary_primitive
+val div_int_caml : Lambda.is_safe -> binary_primitive
+val mod_int_caml : Lambda.is_safe -> binary_primitive
+val and_int_caml : binary_primitive
+val or_int_caml : binary_primitive
+val xor_int_caml : binary_primitive
+val lsl_int_caml : binary_primitive
+val lsr_int_caml : binary_primitive
+val asr_int_caml : binary_primitive
+val int_comp_caml : Lambda.integer_comparison -> binary_primitive
+
+(** Strings, Bytes and Bigstrings *)
+
+(** Regular string/bytes access. Args: string/bytes, index *)
+val stringref_unsafe : binary_primitive
+val stringref_safe : binary_primitive
+
+(** Load by chunk from string/bytes, bigstring. Args: string, index *)
+val string_load :
+  Clambda_primitives.memory_access_size -> Lambda.is_safe -> binary_primitive
+val bigstring_load :
+  Clambda_primitives.memory_access_size -> Lambda.is_safe -> binary_primitive
+
+(** Arrays *)
+
+(** Array access. Args: array, index *)
+val arrayref_unsafe : Lambda.array_kind -> binary_primitive
+val arrayref_safe : Lambda.array_kind -> binary_primitive
+
+type ternary_primitive =
+  expression -> expression -> expression -> Debuginfo.t -> expression
+
+(** Same as setfield, except the offset is one of the arguments.
+    Args: pointer (structure/array/...), index, value *)
+val setfield_computed :
+  Lambda.immediate_or_pointer -> Lambda.initialization_or_assignment ->
+  ternary_primitive
+
+(** Set the byte at the given offset to the given value.
+    Args: bytes, index, value *)
+val bytesset_unsafe : ternary_primitive
+val bytesset_safe : ternary_primitive
+
+(** Set the element at the given index in the given array to the given value.
+    WARNING: if [kind] is [Pfloatarray], then [value] is expected to be an
+    _unboxed_ float. Otherwise, it is expected to be a regular caml value,
+    including in the case where the array contains floats.
+    Args: array, index, value *)
+val arrayset_unsafe : Lambda.array_kind -> ternary_primitive
+val arrayset_safe : Lambda.array_kind -> ternary_primitive
+
+(** Set a chunk of data in the given bytes or bigstring structure.
+    See also [string_load] and [bigstring_load].
+    Note: [value] is expected to be an unboxed number of the given size.
+    Args: pointer, index, value *)
+val bytes_set :
+  Clambda_primitives.memory_access_size -> Lambda.is_safe -> ternary_primitive
+val bigstring_set :
+  Clambda_primitives.memory_access_size -> Lambda.is_safe -> ternary_primitive
+
+(** Switch *)
+
+(** [transl_isout h arg dbg] *)
+val transl_isout : expression -> expression -> Debuginfo.t -> expression
+
+(** [make_switch arg cases actions dbg] : Generate a Cswitch construct,
+    or optimize as a static table lookup when possible. *)
+val make_switch :
+  expression -> int array -> (expression * Debuginfo.t) array -> Debuginfo.t ->
+  expression
+
+(** [transl_int_switch loc arg low high cases default] *)
+val transl_int_switch :
+  Debuginfo.t -> expression -> int -> int ->
+  (int * expression) list -> expression -> expression
+
+(** [transl_switch_clambda loc arg index cases] *)
+val transl_switch_clambda :
+  Debuginfo.t -> expression -> int array -> expression array -> expression
+
+(** [strmatch_compile dbg arg default cases] *)
+val strmatch_compile :
+  Debuginfo.t -> expression -> expression option ->
+  (string * expression) list -> expression
+
+(** Closures and function applications *)
+
+(** Adds a constant offset to a pointer (for infix access) *)
+val ptr_offset : expression -> int -> Debuginfo.t -> expression
+
+(** Direct application of a function via a symbol *)
+val direct_apply : string -> expression list -> Debuginfo.t -> expression
+
+(** Generic application of a function to one or several arguments.
+    The mutable_flag argument annotates the loading of the code pointer
+    from the closure. The Cmmgen code uses a mutable load by
+    default, with a special case when the load is from (the first function of)
+    the currently defined closure. *)
+val generic_apply :
+  Asttypes.mutable_flag ->
+  expression -> expression list -> Debuginfo.t -> expression
+
+(** Method call : [send kind met obj args dbg]
+    - [met] is a method identifier, which can be a hashed variant or an index
+    in [obj]'s method table, depending on [kind]
+    - [obj] is the object whose method is being called
+    - [args] is the extra arguments to the method call (Note: I'm not aware
+    of any way for the frontend to generate any arguments other than the
+    cache and cache position) *)
+val send :
+  Lambda.meth_kind -> expression -> expression -> expression list ->
+  Debuginfo.t -> expression
+
+(** Generic Cmm fragments *)
+
+(** Generate generic functions *)
+val generic_functions : bool -> Cmx_format.unit_infos list -> Cmm.phrase list
+
+val placeholder_dbg : unit -> Debuginfo.t
+val placeholder_fun_dbg : human_name:string -> Debuginfo.t
+
+(** Entry point *)
+val entry_point : string list -> phrase
+
+(** Generate the caml_globals table *)
+val global_table: string list -> phrase
+
+(** Add references to the given symbols *)
+val reference_symbols: string list -> phrase
+
+(** Generate the caml_globals_map structure, as a marshalled string constant *)
+val globals_map:
+  (string * Digest.t option * Digest.t option * string list) list -> phrase
+
+(** Generate the caml_frametable table, referencing the frametables
+    from the given compilation units *)
+val frame_table: string list -> phrase
+
+(** Generate the caml_spacetime_shapes table, referencing the spacetime shapes
+    from the given compilation units *)
+val spacetime_shapes: string list -> phrase
+
+(** Generate the tables for data and code positions respectively of the given
+    compilation units *)
+val data_segment_table: string list -> phrase
+val code_segment_table: string list -> phrase
+
+(** Generate data for a predefined exception *)
+val predef_exception: int -> string -> phrase
+
+val plugin_header: (Cmx_format.unit_infos * Digest.t) list -> phrase
+
+(** Emit constant symbols *)
+
+(** Produce the data_item list corresponding to a symbol definition *)
+val cdefine_symbol : (string * Cmmgen_state.is_global) -> data_item list
+
+(** [emit_block symb white_header cont] prepends to [cont] the header and symbol
+    for the block.
+    [cont] must already contain the fields of the block (and may contain
+    additional data items afterwards). *)
+val emit_block :
+  (string * Cmmgen_state.is_global) -> nativeint -> data_item list ->
+  data_item list
+
+(** Emit specific kinds of constant blocks as data items *)
+val emit_float_constant :
+  (string * Cmmgen_state.is_global) -> float -> data_item list ->
+  data_item list
+val emit_string_constant :
+  (string * Cmmgen_state.is_global) -> string -> data_item list ->
+  data_item list
+val emit_int32_constant :
+  (string * Cmmgen_state.is_global) -> int32 -> data_item list ->
+  data_item list
+val emit_int64_constant :
+  (string * Cmmgen_state.is_global) -> int64 -> data_item list ->
+  data_item list
+val emit_nativeint_constant :
+  (string * Cmmgen_state.is_global) -> nativeint -> data_item list ->
+  data_item list
+val emit_float_array_constant :
+  (string * Cmmgen_state.is_global) -> float list -> data_item list ->
+  data_item list
+
+val fundecls_size : Clambda.ufunction list -> int
+
+val emit_constant_closure :
+  (string * Cmmgen_state.is_global) -> Clambda.ufunction list ->
+  data_item list -> data_item list -> data_item list
+
+val emit_preallocated_blocks :
+  Clambda.preallocated_block list -> phrase list -> phrase list
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
new file mode 100644
index 00000000..8515e3d6
--- /dev/null
+++ b/asmcomp/cmmgen.ml
@@ -0,0 +1,1468 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Translation from closed lambda to C-- *)
+
+[@@@ocaml.warning "-40"]
+
+open Misc
+open Arch
+open Asttypes
+open Primitive
+open Types
+open Lambda
+open Clambda
+open Clambda_primitives
+open Cmm
+
+module String = Misc.Stdlib.String
+module IntMap = Map.Make(Int)
+module V = Backend_var
+module VP = Backend_var.With_provenance
+open Cmm_helpers
+
+(* Environments used for translation to Cmm. *)
+
+type boxed_number =
+  | Boxed_float of Debuginfo.t
+  | Boxed_integer of boxed_integer * Debuginfo.t
+
+type env = {
+  unboxed_ids : (V.t * boxed_number) V.tbl;
+  notify_catch : (Cmm.expression list -> unit) IntMap.t;
+  environment_param : V.t option;
+}
+
+(* notify_catch associates to each catch handler a callback
+   which will be passed the list of arguments of each
+   staticfail instruction pointing to that handler. This
+   allows transl_catch to observe concrete arguments passed to each
+   handler parameter and decide whether to unbox them accordingly.
+
+   Other ways to achieve the same result would be to either (1) traverse
+   the body of the catch block after translation (this would be costly
+   and could easily lead to quadratric behavior) or (2) return
+   a description of arguments passed to each catch handler as an extra
+   value to be threaded through all transl_* functions (this would be
+   quite heavy, and probably less efficient that the callback approach).
+*)
+
+
+let empty_env =
+  {
+    unboxed_ids = V.empty;
+    notify_catch = IntMap.empty;
+    environment_param = None;
+  }
+
+let create_env ~environment_param =
+  { empty_env with
+    environment_param;
+  }
+
+let is_unboxed_id id env =
+  try Some (V.find_same id env.unboxed_ids)
+  with Not_found -> None
+
+let add_unboxed_id id unboxed_id bn env =
+  { env with
+    unboxed_ids = V.add id (unboxed_id, bn) env.unboxed_ids;
+  }
+
+let add_notify_catch n f env =
+  { env with
+    notify_catch = IntMap.add n f env.notify_catch
+  }
+
+let notify_catch i env l =
+  match IntMap.find_opt i env.notify_catch with
+  | Some f -> f l
+  | None -> ()
+
+(* Description of the "then" and "else" continuations in [transl_if]. If
+   the "then" continuation is true and the "else" continuation is false then
+   we can use the condition directly as the result. Similarly, if the "then"
+   continuation is false and the "else" continuation is true then we can use
+   the negation of the condition directly as the result. *)
+type then_else =
+  | Then_true_else_false
+  | Then_false_else_true
+  | Unknown
+
+let invert_then_else = function
+  | Then_true_else_false -> Then_false_else_true
+  | Then_false_else_true -> Then_true_else_false
+  | Unknown -> Unknown
+
+let mut_from_env env ptr =
+  match env.environment_param with
+  | None -> Mutable
+  | Some environment_param ->
+    match ptr with
+    | Cvar ptr ->
+      (* Loads from the current function's closure are immutable. *)
+      if V.same environment_param ptr then Immutable
+      else Mutable
+    | _ -> Mutable
+
+let get_field env ptr n dbg =
+  let mut = mut_from_env env ptr in
+  get_field_gen mut ptr n dbg
+
+type rhs_kind =
+  | RHS_block of int
+  | RHS_infix of { blocksize : int; offset : int }
+  | RHS_floatblock of int
+  | RHS_nonrec
+;;
+
+let rec expr_size env = function
+  | Uvar id ->
+      begin try V.find_same id env with Not_found -> RHS_nonrec end
+  | Uclosure(fundecls, clos_vars) ->
+      RHS_block (fundecls_size fundecls + List.length clos_vars)
+  | Ulet(_str, _kind, id, exp, body) ->
+      expr_size (V.add (VP.var id) (expr_size env exp) env) body
+  | Uletrec(bindings, body) ->
+      let env =
+        List.fold_right
+          (fun (id, exp) env -> V.add (VP.var id) (expr_size env exp) env)
+          bindings env
+      in
+      expr_size env body
+  | Uprim(Pmakeblock _, args, _) ->
+      RHS_block (List.length args)
+  | Uprim(Pmakearray((Paddrarray | Pintarray), _), args, _) ->
+      RHS_block (List.length args)
+  | Uprim(Pmakearray(Pfloatarray, _), args, _) ->
+      RHS_floatblock (List.length args)
+  | Uprim(Pmakearray(Pgenarray, _), _, _) ->
+     (* Pgenarray is excluded from recursive bindings by the
+        check in Translcore.check_recursive_lambda *)
+     RHS_nonrec
+  | Uprim (Pduprecord ((Record_regular | Record_inlined _), sz), _, _) ->
+      RHS_block sz
+  | Uprim (Pduprecord (Record_unboxed _, _), _, _) ->
+      assert false
+  | Uprim (Pduprecord (Record_extension _, sz), _, _) ->
+      RHS_block (sz + 1)
+  | Uprim (Pduprecord (Record_float, sz), _, _) ->
+      RHS_floatblock sz
+  | Uprim (Pccall { prim_name; _ }, closure::_, _)
+        when prim_name = "caml_check_value_is_closure" ->
+      (* Used for "-clambda-checks". *)
+      expr_size env closure
+  | Usequence(_exp, exp') ->
+      expr_size env exp'
+  | Uoffset (exp, offset) ->
+      (match expr_size env exp with
+      | RHS_block blocksize -> RHS_infix { blocksize; offset }
+      | RHS_nonrec -> RHS_nonrec
+      | _ -> assert false)
+  | _ -> RHS_nonrec
+
+(* Translate structured constants to Cmm data items *)
+
+let transl_constant dbg = function
+  | Uconst_int n ->
+      int_const dbg n
+  | Uconst_ptr n ->
+      if n <= max_repr_int && n >= min_repr_int
+      then Cconst_pointer((n lsl 1) + 1, dbg)
+      else Cconst_natpointer
+              (Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n,
+               dbg)
+  | Uconst_ref (label, _) ->
+      Cconst_symbol (label, dbg)
+
+let emit_constant cst cont =
+  match cst with
+  | Uconst_int n | Uconst_ptr n ->
+      cint_const n
+      :: cont
+  | Uconst_ref (sym, _) ->
+      Csymbol_address sym :: cont
+
+let emit_structured_constant ((_sym, is_global) as symb) cst cont =
+  match cst with
+  | Uconst_float s ->
+      emit_float_constant symb s cont
+  | Uconst_string s ->
+      emit_string_constant symb s cont
+  | Uconst_int32 n ->
+      emit_int32_constant symb n cont
+  | Uconst_int64 n ->
+      emit_int64_constant symb n cont
+  | Uconst_nativeint n ->
+      emit_nativeint_constant symb n cont
+  | Uconst_block (tag, csts) ->
+      let cont = List.fold_right emit_constant csts cont in
+      emit_block symb (block_header tag (List.length csts)) cont
+  | Uconst_float_array fields ->
+      emit_float_array_constant symb fields cont
+  | Uconst_closure(fundecls, lbl, fv) ->
+      Cmmgen_state.add_constant lbl (Const_closure (is_global, fundecls, fv));
+      List.iter (fun f -> Cmmgen_state.add_function f) fundecls;
+      cont
+
+(* Boxed integers *)
+
+let box_int_constant sym bi n =
+  match bi with
+    Pnativeint ->
+      emit_nativeint_constant (sym, Local) n []
+  | Pint32 ->
+      let n = Nativeint.to_int32 n in
+      emit_int32_constant (sym, Local) n []
+  | Pint64 ->
+      let n = Int64.of_nativeint n in
+      emit_int64_constant (sym, Local) n []
+
+let box_int dbg bi arg =
+  match arg with
+  | Cconst_int (n, _) ->
+      let sym = Compilenv.new_const_symbol () in
+      let data_items = box_int_constant sym bi (Nativeint.of_int n) in
+      Cmmgen_state.add_data_items data_items;
+      Cconst_symbol (sym, dbg)
+  | Cconst_natint (n, _) ->
+      let sym = Compilenv.new_const_symbol () in
+      let data_items = box_int_constant sym bi n in
+      Cmmgen_state.add_data_items data_items;
+      Cconst_symbol (sym, dbg)
+  | _ ->
+      box_int_gen dbg bi arg
+
+(* Boxed numbers *)
+
+let typ_of_boxed_number = function
+  | Boxed_float _ -> Cmm.typ_float
+  | Boxed_integer (Pint64, _) when size_int = 4 -> [|Int;Int|]
+  | Boxed_integer _ -> Cmm.typ_int
+
+let equal_unboxed_integer ui1 ui2 =
+  match ui1, ui2 with
+  | Pnativeint, Pnativeint -> true
+  | Pint32, Pint32 -> true
+  | Pint64, Pint64 -> true
+  | _, _ -> false
+
+let equal_boxed_number bn1 bn2 =
+  match bn1, bn2 with
+  | Boxed_float _, Boxed_float _ -> true
+  | Boxed_integer(ui1, _), Boxed_integer(ui2, _) ->
+    equal_unboxed_integer ui1 ui2
+  | _, _ -> false
+
+let box_number bn arg =
+  match bn with
+  | Boxed_float dbg -> box_float dbg arg
+  | Boxed_integer (bi, dbg) -> box_int dbg bi arg
+
+(* Returns the unboxed representation of a boxed float or integer.
+   For Pint32 on 64-bit archs, the high 32 bits of the result are undefined. *)
+let unbox_number dbg bn arg =
+  match bn with
+  | Boxed_float dbg ->
+    unbox_float dbg arg
+  | Boxed_integer (Pint32, _) ->
+    low_32 dbg (unbox_int dbg Pint32 arg)
+  | Boxed_integer (bi, _) ->
+    unbox_int dbg bi arg
+
+(* Auxiliary functions for optimizing "let" of boxed numbers (floats and
+   boxed integers *)
+
+type unboxed_number_kind =
+    No_unboxing
+  | Boxed of boxed_number * bool (* true: boxed form available at no cost *)
+  | No_result (* expression never returns a result *)
+
+(* Given unboxed_number_kind from two branches of the code, returns the
+   resulting unboxed_number_kind.
+
+   If [strict=false], one knows that the type of the expression
+   is an unboxable number, and we decide to return an unboxed value
+   if this indeed eliminates at least one allocation.
+
+   If [strict=true], we need to ensure that all possible branches
+   return an unboxable number (of the same kind).  This could not
+   be the case in presence of GADTs.
+*)
+let join_unboxed_number_kind ~strict k1 k2 =
+  match k1, k2 with
+  | Boxed (b1, c1), Boxed (b2, c2) when equal_boxed_number b1 b2 ->
+      Boxed (b1, c1 && c2)
+  | No_result, k | k, No_result ->
+        k (* if a branch never returns, it is safe to unbox it *)
+  | No_unboxing, k | k, No_unboxing when not strict ->
+      k
+  | _, _ -> No_unboxing
+
+let is_unboxed_number_cmm ~strict cmm =
+  let r = ref No_result in
+  let notify k =
+    r := join_unboxed_number_kind ~strict !r k
+  in
+  let rec aux = function
+    | Cop(Calloc, [Cblockheader (hdr, _); _], dbg)
+      when Nativeint.equal hdr float_header ->
+        notify (Boxed (Boxed_float dbg, false))
+    | Cop(Calloc, [Cblockheader (hdr, _); Cconst_symbol (ops, _); _], dbg) ->
+        if Nativeint.equal hdr boxedintnat_header
+        && String.equal ops caml_nativeint_ops
+        then
+          notify (Boxed (Boxed_integer (Pnativeint, dbg), false))
+        else
+        if Nativeint.equal hdr boxedint32_header
+        && String.equal ops caml_int32_ops
+        then
+          notify (Boxed (Boxed_integer (Pint32, dbg), false))
+        else
+        if Nativeint.equal hdr boxedint64_header
+        && String.equal ops caml_int64_ops
+        then
+          notify (Boxed (Boxed_integer (Pint64, dbg), false))
+        else
+          notify No_unboxing
+    | Cconst_symbol (s, _) ->
+        begin match Cmmgen_state.structured_constant_of_sym s with
+        | Some (Uconst_float _) ->
+            notify (Boxed (Boxed_float Debuginfo.none, true))
+        | Some (Uconst_nativeint _) ->
+            notify (Boxed (Boxed_integer (Pnativeint, Debuginfo.none), true))
+        | Some (Uconst_int32 _) ->
+            notify (Boxed (Boxed_integer (Pint32, Debuginfo.none), true))
+        | Some (Uconst_int64 _) ->
+            notify (Boxed (Boxed_integer (Pint64, Debuginfo.none), true))
+        | _ ->
+            notify No_unboxing
+        end
+    | l ->
+        if not (Cmm.iter_shallow_tail aux l) then
+          notify No_unboxing
+  in
+  aux cmm;
+  !r
+
+(* Translate an expression *)
+
+let rec transl env e =
+  match e with
+    Uvar id ->
+      begin match is_unboxed_id id env with
+      | None -> Cvar id
+      | Some (unboxed_id, bn) -> box_number bn (Cvar unboxed_id)
+      end
+  | Uconst sc ->
+      transl_constant Debuginfo.none sc
+  | Uclosure(fundecls, []) ->
+      let sym = Compilenv.new_const_symbol() in
+      Cmmgen_state.add_constant sym (Const_closure (Local, fundecls, []));
+      List.iter (fun f -> Cmmgen_state.add_function f) fundecls;
+      let dbg =
+        match fundecls with
+        | [] -> Debuginfo.none
+        | fundecl::_ -> fundecl.dbg
+      in
+      Cconst_symbol (sym, dbg)
+  | Uclosure(fundecls, clos_vars) ->
+      let rec transl_fundecls pos = function
+          [] ->
+            List.map (transl env) clos_vars
+        | f :: rem ->
+            Cmmgen_state.add_function f;
+            let dbg = f.dbg in
+            let without_header =
+              if f.arity = 1 || f.arity = 0 then
+                Cconst_symbol (f.label, dbg) ::
+                int_const dbg f.arity ::
+                transl_fundecls (pos + 3) rem
+              else
+                Cconst_symbol (curry_function_sym f.arity, dbg) ::
+                int_const dbg f.arity ::
+                Cconst_symbol (f.label, dbg) ::
+                transl_fundecls (pos + 4) rem
+            in
+            if pos = 0 then without_header
+            else (alloc_infix_header pos f.dbg) :: without_header
+      in
+      let dbg =
+        match fundecls with
+        | [] -> Debuginfo.none
+        | fundecl::_ -> fundecl.dbg
+      in
+      make_alloc dbg Obj.closure_tag (transl_fundecls 0 fundecls)
+  | Uoffset(arg, offset) ->
+      (* produces a valid Caml value, pointing just after an infix header *)
+      let ptr = transl env arg in
+      let dbg = Debuginfo.none in
+      ptr_offset ptr offset dbg
+  | Udirect_apply(lbl, args, dbg) ->
+      let args = List.map (transl env) args in
+      direct_apply lbl args dbg
+  | Ugeneric_apply(clos, args, dbg) ->
+      let clos = transl env clos in
+      let args = List.map (transl env) args in
+      generic_apply (mut_from_env env clos) clos args dbg
+  | Usend(kind, met, obj, args, dbg) ->
+      let met = transl env met in
+      let obj = transl env obj in
+      let args = List.map (transl env) args in
+      send kind met obj args dbg
+  | Ulet(str, kind, id, exp, body) ->
+      transl_let env str kind id exp body
+  | Uphantom_let (var, defining_expr, body) ->
+      let defining_expr =
+        match defining_expr with
+        | None -> None
+        | Some defining_expr ->
+          let defining_expr =
+            match defining_expr with
+            | Uphantom_const (Uconst_ref (sym, _defining_expr)) ->
+              Cphantom_const_symbol sym
+            | Uphantom_read_symbol_field { sym; field; } ->
+              Cphantom_read_symbol_field { sym; field; }
+            | Uphantom_const (Uconst_int i) | Uphantom_const (Uconst_ptr i) ->
+              Cphantom_const_int (targetint_const i)
+            | Uphantom_var var -> Cphantom_var var
+            | Uphantom_read_field { var; field; } ->
+              Cphantom_read_field { var; field; }
+            | Uphantom_offset_var { var; offset_in_words; } ->
+              Cphantom_offset_var { var; offset_in_words; }
+            | Uphantom_block { tag; fields; } ->
+              Cphantom_block { tag; fields; }
+          in
+          Some defining_expr
+      in
+      Cphantom_let (var, defining_expr, transl env body)
+  | Uletrec(bindings, body) ->
+      transl_letrec env bindings (transl env body)
+
+  (* Primitives *)
+  | Uprim(prim, args, dbg) ->
+      begin match (simplif_primitive prim, args) with
+      | (Pread_symbol sym, []) ->
+          Cconst_symbol (sym, dbg)
+      | (Pmakeblock _, []) ->
+          assert false
+      | (Pmakeblock(tag, _mut, _kind), args) ->
+          make_alloc dbg tag (List.map (transl env) args)
+      | (Pccall prim, args) ->
+          transl_ccall env prim args dbg
+      | (Pduparray (kind, _), [Uprim (Pmakearray (kind', _), args, _dbg)]) ->
+          (* We arrive here in two cases:
+             1. When using Closure, all the time.
+             2. When using Flambda, if a float array longer than
+             [Translcore.use_dup_for_constant_arrays_bigger_than] turns out
+             to be non-constant.
+             If for some reason Flambda fails to lift a constant array we
+             could in theory also end up here.
+             Note that [kind] above is unconstrained, but with the current
+             state of [Translcore], we will in fact only get here with
+             [Pfloatarray]s. *)
+          assert (kind = kind');
+          transl_make_array dbg env kind args
+      | (Pduparray _, [arg]) ->
+          let prim_obj_dup =
+            Primitive.simple ~name:"caml_obj_dup" ~arity:1 ~alloc:true
+          in
+          transl_ccall env prim_obj_dup [arg] dbg
+      | (Pmakearray _, []) ->
+          Misc.fatal_error "Pmakearray is not allowed for an empty array"
+      | (Pmakearray (kind, _), args) -> transl_make_array dbg env kind args
+      | (Pbigarrayref(unsafe, _num_dims, elt_kind, layout), arg1 :: argl) ->
+          let elt =
+            bigarray_get unsafe elt_kind layout
+              (transl env arg1) (List.map (transl env) argl) dbg in
+          begin match elt_kind with
+            Pbigarray_float32 | Pbigarray_float64 -> box_float dbg elt
+          | Pbigarray_complex32 | Pbigarray_complex64 -> elt
+          | Pbigarray_int32 -> box_int dbg Pint32 elt
+          | Pbigarray_int64 -> box_int dbg Pint64 elt
+          | Pbigarray_native_int -> box_int dbg Pnativeint elt
+          | Pbigarray_caml_int -> tag_int elt dbg
+          | Pbigarray_sint8 | Pbigarray_uint8
+          | Pbigarray_sint16 | Pbigarray_uint16 -> tag_int elt dbg
+          | Pbigarray_unknown -> assert false
+          end
+      | (Pbigarrayset(unsafe, _num_dims, elt_kind, layout), arg1 :: argl) ->
+          let (argidx, argnewval) = split_last argl in
+          return_unit dbg (bigarray_set unsafe elt_kind layout
+            (transl env arg1)
+            (List.map (transl env) argidx)
+            (match elt_kind with
+              Pbigarray_float32 | Pbigarray_float64 ->
+                transl_unbox_float dbg env argnewval
+            | Pbigarray_complex32 | Pbigarray_complex64 -> transl env argnewval
+            | Pbigarray_int32 -> transl_unbox_int dbg env Pint32 argnewval
+            | Pbigarray_int64 -> transl_unbox_int dbg env Pint64 argnewval
+            | Pbigarray_native_int ->
+                transl_unbox_int dbg env Pnativeint argnewval
+            | Pbigarray_caml_int ->
+                untag_int (transl env argnewval) dbg
+            | Pbigarray_sint8 | Pbigarray_uint8
+            | Pbigarray_sint16 | Pbigarray_uint16 ->
+                ignore_high_bit_int (untag_int (transl env argnewval) dbg)
+            | Pbigarray_unknown -> assert false)
+            dbg)
+      | (Pbigarraydim(n), [b]) ->
+          let dim_ofs = 4 + n in
+          tag_int (Cop(Cload (Word_int, Mutable),
+            [field_address (transl env b) dim_ofs dbg],
+            dbg)) dbg
+      | (p, [arg]) ->
+          transl_prim_1 env p arg dbg
+      | (p, [arg1; arg2]) ->
+          transl_prim_2 env p arg1 arg2 dbg
+      | (p, [arg1; arg2; arg3]) ->
+          transl_prim_3 env p arg1 arg2 arg3 dbg
+      | (Pread_symbol _, _::_::_::_::_)
+      | (Pbigarrayset (_, _, _, _), [])
+      | (Pbigarrayref (_, _, _, _), [])
+      | ((Pbigarraydim _ | Pduparray (_, _)), ([] | _::_::_::_::_))
+        ->
+          fatal_error "Cmmgen.transl:prim, wrong arity"
+      | ((Pfield_computed|Psequand
+         | Psequor | Pnot | Pnegint | Paddint | Psubint
+         | Pmulint | Pandint | Porint | Pxorint | Plslint
+         | Plsrint | Pasrint | Pintoffloat | Pfloatofint
+         | Pnegfloat | Pabsfloat | Paddfloat | Psubfloat
+         | Pmulfloat | Pdivfloat | Pstringlength | Pstringrefu
+         | Pstringrefs | Pbyteslength | Pbytesrefu | Pbytessetu
+         | Pbytesrefs | Pbytessets | Pisint | Pisout
+         | Pbswap16 | Pint_as_pointer | Popaque | Pfield _
+         | Psetfield (_, _, _) | Psetfield_computed (_, _)
+         | Pfloatfield _ | Psetfloatfield (_, _) | Pduprecord (_, _)
+         | Praise _ | Pdivint _ | Pmodint _ | Pintcomp _ | Poffsetint _
+         | Pcompare_ints | Pcompare_floats | Pcompare_bints _
+         | Poffsetref _ | Pfloatcomp _ | Parraylength _
+         | Parrayrefu _ | Parraysetu _ | Parrayrefs _ | Parraysets _
+         | Pbintofint _ | Pintofbint _ | Pcvtbint (_, _) | Pnegbint _
+         | Paddbint _ | Psubbint _ | Pmulbint _ | Pdivbint _ | Pmodbint _
+         | Pandbint _ | Porbint _ | Pxorbint _ | Plslbint _ | Plsrbint _
+         | Pasrbint _ | Pbintcomp (_, _) | Pstring_load _ | Pbytes_load _
+         | Pbytes_set _ | Pbigstring_load _ | Pbigstring_set _
+         | Pbbswap _), _)
+        ->
+          fatal_error "Cmmgen.transl:prim"
+      end
+
+  (* Control structures *)
+  | Uswitch(arg, s, dbg) ->
+      (* As in the bytecode interpreter, only matching against constants
+         can be checked *)
+      if Array.length s.us_index_blocks = 0 then
+        make_switch
+          (untag_int (transl env arg) dbg)
+          s.us_index_consts
+          (Array.map (fun expr -> transl env expr, dbg) s.us_actions_consts)
+          dbg
+      else if Array.length s.us_index_consts = 0 then
+        bind "switch" (transl env arg) (fun arg ->
+          transl_switch dbg env (get_tag arg dbg)
+            s.us_index_blocks s.us_actions_blocks)
+      else
+        bind "switch" (transl env arg) (fun arg ->
+          Cifthenelse(
+          Cop(Cand, [arg; Cconst_int (1, dbg)], dbg),
+          dbg,
+          transl_switch dbg env
+            (untag_int arg dbg) s.us_index_consts s.us_actions_consts,
+          dbg,
+          transl_switch dbg env
+            (get_tag arg dbg) s.us_index_blocks s.us_actions_blocks,
+          dbg))
+  | Ustringswitch(arg,sw,d) ->
+      let dbg = Debuginfo.none in
+      bind "switch" (transl env arg)
+        (fun arg ->
+          strmatch_compile dbg arg (Option.map (transl env) d)
+            (List.map (fun (s,act) -> s,transl env act) sw))
+  | Ustaticfail (nfail, args) ->
+      let cargs = List.map (transl env) args in
+      notify_catch nfail env cargs;
+      Cexit (nfail, cargs)
+  | Ucatch(nfail, [], body, handler) ->
+      let dbg = Debuginfo.none in
+      make_catch nfail (transl env body) (transl env handler) dbg
+  | Ucatch(nfail, ids, body, handler) ->
+      let dbg = Debuginfo.none in
+      transl_catch env nfail ids body handler dbg
+  | Utrywith(body, exn, handler) ->
+      let dbg = Debuginfo.none in
+      Ctrywith(transl env body, exn, transl env handler, dbg)
+  | Uifthenelse(cond, ifso, ifnot) ->
+      let ifso_dbg = Debuginfo.none in
+      let ifnot_dbg = Debuginfo.none in
+      let dbg = Debuginfo.none in
+      transl_if env Unknown dbg cond
+        ifso_dbg (transl env ifso) ifnot_dbg (transl env ifnot)
+  | Usequence(exp1, exp2) ->
+      Csequence(remove_unit(transl env exp1), transl env exp2)
+  | Uwhile(cond, body) ->
+      let dbg = Debuginfo.none in
+      let raise_num = next_raise_count () in
+      return_unit dbg
+        (ccatch
+           (raise_num, [],
+            create_loop(transl_if env Unknown dbg cond
+                    dbg (remove_unit(transl env body))
+                    dbg (Cexit (raise_num,[])))
+              dbg,
+            Ctuple [],
+            dbg))
+  | Ufor(id, low, high, dir, body) ->
+      let dbg = Debuginfo.none in
+      let tst = match dir with Upto -> Cgt   | Downto -> Clt in
+      let inc = match dir with Upto -> Caddi | Downto -> Csubi in
+      let raise_num = next_raise_count () in
+      let id_prev = VP.create (V.create_local "*id_prev*") in
+      return_unit dbg
+        (Clet_mut
+           (id, typ_int, transl env low,
+            bind_nonvar "bound" (transl env high) (fun high ->
+              ccatch
+                (raise_num, [],
+                 Cifthenelse
+                   (Cop(Ccmpi tst, [Cvar (VP.var id); high], dbg),
+                    dbg,
+                    Cexit (raise_num, []),
+                    dbg,
+                    create_loop
+                      (Csequence
+                         (remove_unit(transl env body),
+                         Clet(id_prev, Cvar (VP.var id),
+                          Csequence
+                            (Cassign(VP.var id,
+                               Cop(inc, [Cvar (VP.var id); Cconst_int (2, dbg)],
+                                 dbg)),
+                             Cifthenelse
+                               (Cop(Ccmpi Ceq, [Cvar (VP.var id_prev); high],
+                                  dbg),
+                                dbg, Cexit (raise_num,[]),
+                                dbg, Ctuple [],
+                                dbg)))))
+                      dbg,
+                   dbg),
+                 Ctuple [],
+                 dbg))))
+  | Uassign(id, exp) ->
+      let dbg = Debuginfo.none in
+      let cexp = transl env exp in
+      begin match is_unboxed_id id env with
+      | None ->
+          return_unit dbg (Cassign(id, cexp))
+      | Some (unboxed_id, bn) ->
+          return_unit dbg (Cassign(unboxed_id, unbox_number dbg bn cexp))
+      end
+  | Uunreachable ->
+      let dbg = Debuginfo.none in
+      Cop(Cload (Word_int, Mutable), [Cconst_int (0, dbg)], dbg)
+
+and transl_catch env nfail ids body handler dbg =
+  let ids = List.map (fun (id, kind) -> (id, kind, ref No_result)) ids in
+  (* Translate the body, and while doing so, collect the "unboxing type" for
+     each argument.  *)
+  let report args =
+    List.iter2
+      (fun (_id, kind, u) c ->
+         let strict =
+           match kind with
+           | Pfloatval | Pboxedintval _ -> false
+           | Pintval | Pgenval -> true
+         in
+         u := join_unboxed_number_kind ~strict !u
+             (is_unboxed_number_cmm ~strict c)
+      )
+      ids args
+  in
+  let env_body = add_notify_catch nfail report env in
+  let body = transl env_body body in
+  let new_env, rewrite, ids =
+    List.fold_right
+      (fun (id, _kind, u) (env, rewrite, ids) ->
+         match !u with
+         | No_unboxing | Boxed (_, true) | No_result ->
+             env,
+             (fun x -> x) :: rewrite,
+             (id, Cmm.typ_val) :: ids
+         | Boxed (bn, false) ->
+             let unboxed_id = V.create_local (VP.name id) in
+             add_unboxed_id (VP.var id) unboxed_id bn env,
+             (unbox_number Debuginfo.none bn) :: rewrite,
+             (VP.create unboxed_id, typ_of_boxed_number bn) :: ids
+      )
+      ids (env, [], [])
+  in
+  if env == new_env then
+    (* No unboxing *)
+    ccatch (nfail, ids, body, transl env handler, dbg)
+  else
+    (* allocate new "nfail" to catch errors more easily *)
+    let new_nfail = next_raise_count () in
+    let body =
+      (* Rewrite the body to unbox the call sites *)
+      let rec aux e =
+        match Cmm.map_shallow aux e with
+        | Cexit (n, el) when n = nfail ->
+            Cexit (new_nfail, List.map2 (fun f e -> f e) rewrite el)
+        | c -> c
+      in
+      aux body
+    in
+    ccatch (new_nfail, ids, body, transl new_env handler, dbg)
+
+and transl_make_array dbg env kind args =
+  match kind with
+  | Pgenarray ->
+      Cop(Cextcall("caml_make_array", typ_val, true, None),
+          [make_alloc dbg 0 (List.map (transl env) args)], dbg)
+  | Paddrarray | Pintarray ->
+      make_alloc dbg 0 (List.map (transl env) args)
+  | Pfloatarray ->
+      make_float_alloc dbg Obj.double_array_tag
+                      (List.map (transl_unbox_float dbg env) args)
+
+and transl_ccall env prim args dbg =
+  let transl_arg native_repr arg =
+    match native_repr with
+    | Same_as_ocaml_repr -> transl env arg
+    | Unboxed_float -> transl_unbox_float dbg env arg
+    | Unboxed_integer bi -> transl_unbox_int dbg env bi arg
+    | Untagged_int -> untag_int (transl env arg) dbg
+  in
+  let rec transl_args native_repr_args args =
+    match native_repr_args, args with
+    | [], args ->
+        (* We don't require the two lists to be of the same length as
+           [default_prim] always sets the arity to [0]. *)
+        List.map (transl env) args
+    | _, [] -> assert false
+    | native_repr :: native_repr_args, arg :: args ->
+        transl_arg native_repr arg :: transl_args native_repr_args args
+  in
+  let typ_res, wrap_result =
+    match prim.prim_native_repr_res with
+    | Same_as_ocaml_repr -> (typ_val, fun x -> x)
+    | Unboxed_float -> (typ_float, box_float dbg)
+    | Unboxed_integer Pint64 when size_int = 4 ->
+        ([|Int; Int|], box_int dbg Pint64)
+    | Unboxed_integer bi -> (typ_int, box_int dbg bi)
+    | Untagged_int -> (typ_int, (fun i -> tag_int i dbg))
+  in
+  let args = transl_args prim.prim_native_repr_args args in
+  wrap_result
+    (Cop(Cextcall(Primitive.native_name prim,
+                  typ_res, prim.prim_alloc, None), args, dbg))
+
+and transl_prim_1 env p arg dbg =
+  match p with
+  (* Generic operations *)
+    Popaque ->
+      transl env arg
+  (* Heap operations *)
+  | Pfield n ->
+      get_field env (transl env arg) n dbg
+  | Pfloatfield n ->
+      let ptr = transl env arg in
+      box_float dbg (floatfield n ptr dbg)
+  | Pint_as_pointer ->
+      int_as_pointer (transl env arg) dbg
+  (* Exceptions *)
+  | Praise rkind ->
+      raise_prim rkind (transl env arg) dbg
+  (* Integer operations *)
+  | Pnegint ->
+      negint (transl env arg) dbg
+  | Poffsetint n ->
+      offsetint n (transl env arg) dbg
+  | Poffsetref n ->
+      offsetref n (transl env arg) dbg
+  (* Floating-point operations *)
+  | Pfloatofint ->
+      box_float dbg (Cop(Cfloatofint, [untag_int(transl env arg) dbg], dbg))
+  | Pintoffloat ->
+     tag_int(Cop(Cintoffloat, [transl_unbox_float dbg env arg], dbg)) dbg
+  | Pnegfloat ->
+      box_float dbg (Cop(Cnegf, [transl_unbox_float dbg env arg], dbg))
+  | Pabsfloat ->
+      box_float dbg (Cop(Cabsf, [transl_unbox_float dbg env arg], dbg))
+  (* String operations *)
+  | Pstringlength | Pbyteslength ->
+      tag_int(string_length (transl env arg) dbg) dbg
+  (* Array operations *)
+  | Parraylength kind ->
+      arraylength kind (transl env arg) dbg
+  (* Boolean operations *)
+  | Pnot ->
+      transl_if env Then_false_else_true
+        dbg arg
+        dbg (Cconst_pointer (1, dbg))
+        dbg (Cconst_pointer (3, dbg))
+  (* Test integer/block *)
+  | Pisint ->
+      tag_int(Cop(Cand, [transl env arg; Cconst_int (1, dbg)], dbg)) dbg
+  (* Boxed integers *)
+  | Pbintofint bi ->
+      box_int dbg bi (untag_int (transl env arg) dbg)
+  | Pintofbint bi ->
+      tag_int (transl_unbox_int dbg env bi arg) dbg
+  | Pcvtbint(bi1, bi2) ->
+      box_int dbg bi2 (transl_unbox_int dbg env bi1 arg)
+  | Pnegbint bi ->
+      box_int dbg bi
+        (Cop(Csubi, [Cconst_int (0, dbg); transl_unbox_int dbg env bi arg],
+          dbg))
+  | Pbbswap bi ->
+      box_int dbg bi (bbswap bi (transl_unbox_int dbg env bi arg) dbg)
+  | Pbswap16 ->
+      tag_int (bswap16 (ignore_high_bit_int (untag_int
+        (transl env arg) dbg)) dbg) dbg
+  | (Pfield_computed | Psequand | Psequor
+    | Paddint | Psubint | Pmulint | Pandint
+    | Porint | Pxorint | Plslint | Plsrint | Pasrint
+    | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
+    | Pstringrefu | Pstringrefs | Pbytesrefu | Pbytessetu
+    | Pbytesrefs | Pbytessets | Pisout | Pread_symbol _
+    | Pmakeblock (_, _, _) | Psetfield (_, _, _) | Psetfield_computed (_, _)
+    | Psetfloatfield (_, _) | Pduprecord (_, _) | Pccall _ | Pdivint _
+    | Pmodint _ | Pintcomp _ | Pfloatcomp _ | Pmakearray (_, _)
+    | Pcompare_ints | Pcompare_floats | Pcompare_bints _
+    | Pduparray (_, _) | Parrayrefu _ | Parraysetu _
+    | Parrayrefs _ | Parraysets _ | Paddbint _ | Psubbint _ | Pmulbint _
+    | Pdivbint _ | Pmodbint _ | Pandbint _ | Porbint _ | Pxorbint _
+    | Plslbint _ | Plsrbint _ | Pasrbint _ | Pbintcomp (_, _)
+    | Pbigarrayref (_, _, _, _) | Pbigarrayset (_, _, _, _)
+    | Pbigarraydim _ | Pstring_load _ | Pbytes_load _ | Pbytes_set _
+    | Pbigstring_load _ | Pbigstring_set _)
+    ->
+      fatal_errorf "Cmmgen.transl_prim_1: %a"
+        Printclambda_primitives.primitive p
+
+and transl_prim_2 env p arg1 arg2 dbg =
+  match p with
+  (* Heap operations *)
+  | Pfield_computed ->
+      addr_array_ref (transl env arg1) (transl env arg2) dbg
+  | Psetfield(n, ptr, init) ->
+      setfield n ptr init (transl env arg1) (transl env arg2) dbg
+  | Psetfloatfield (n, init) ->
+      let ptr = transl env arg1 in
+      let float_val = transl_unbox_float dbg env arg2 in
+      setfloatfield n init ptr float_val dbg
+
+  (* Boolean operations *)
+  | Psequand ->
+      let dbg' = Debuginfo.none in
+      transl_sequand env Then_true_else_false
+        dbg arg1
+        dbg' arg2
+        dbg (Cconst_pointer (3, dbg))
+        dbg' (Cconst_pointer (1, dbg))
+      (* let id = V.create_local "res1" in
+      Clet(id, transl env arg1,
+           Cifthenelse(test_bool dbg (Cvar id), transl env arg2, Cvar id)) *)
+  | Psequor ->
+      let dbg' = Debuginfo.none in
+      transl_sequor env Then_true_else_false
+        dbg arg1
+        dbg' arg2
+        dbg (Cconst_pointer (3, dbg))
+        dbg' (Cconst_pointer (1, dbg))
+  (* Integer operations *)
+  | Paddint ->
+      add_int_caml (transl env arg1) (transl env arg2) dbg
+  | Psubint ->
+      sub_int_caml (transl env arg1) (transl env arg2) dbg
+  | Pmulint ->
+      mul_int_caml (transl env arg1) (transl env arg2) dbg
+  | Pdivint is_safe ->
+      div_int_caml is_safe (transl env arg1) (transl env arg2) dbg
+  | Pmodint is_safe ->
+      mod_int_caml is_safe (transl env arg1) (transl env arg2) dbg
+  | Pandint ->
+      and_int_caml (transl env arg1) (transl env arg2) dbg
+  | Porint ->
+      or_int_caml (transl env arg1) (transl env arg2) dbg
+  | Pxorint ->
+      xor_int_caml (transl env arg1) (transl env arg2) dbg
+  | Plslint ->
+      lsl_int_caml (transl env arg1) (transl env arg2) dbg
+  | Plsrint ->
+      lsr_int_caml (transl env arg1) (transl env arg2) dbg
+  | Pasrint ->
+      asr_int_caml (transl env arg1) (transl env arg2) dbg
+  | Pintcomp cmp ->
+      int_comp_caml cmp (transl env arg1) (transl env arg2) dbg
+  | Pcompare_ints ->
+      (* Compare directly on tagged ints *)
+      mk_compare_ints dbg (transl env arg1) (transl env arg2)
+  | Pcompare_bints bi ->
+      let a1 = transl_unbox_int dbg env bi arg1 in
+      let a2 = transl_unbox_int dbg env bi arg2 in
+      mk_compare_ints dbg a1 a2
+  | Pcompare_floats ->
+      let a1 = transl_unbox_float dbg env arg1 in
+      let a2 = transl_unbox_float dbg env arg2 in
+      mk_compare_floats dbg a1 a2
+  | Pisout ->
+      transl_isout (transl env arg1) (transl env arg2) dbg
+  (* Float operations *)
+  | Paddfloat ->
+      box_float dbg (Cop(Caddf,
+                    [transl_unbox_float dbg env arg1;
+                     transl_unbox_float dbg env arg2],
+                    dbg))
+  | Psubfloat ->
+      box_float dbg (Cop(Csubf,
+                    [transl_unbox_float dbg env arg1;
+                     transl_unbox_float dbg env arg2],
+                    dbg))
+  | Pmulfloat ->
+      box_float dbg (Cop(Cmulf,
+                    [transl_unbox_float dbg env arg1;
+                     transl_unbox_float dbg env arg2],
+                    dbg))
+  | Pdivfloat ->
+      box_float dbg (Cop(Cdivf,
+                    [transl_unbox_float dbg env arg1;
+                     transl_unbox_float dbg env arg2],
+                    dbg))
+  | Pfloatcomp cmp ->
+      tag_int(Cop(Ccmpf cmp,
+                  [transl_unbox_float dbg env arg1;
+                   transl_unbox_float dbg env arg2],
+                  dbg)) dbg
+
+  (* String operations *)
+  | Pstringrefu | Pbytesrefu ->
+      stringref_unsafe (transl env arg1) (transl env arg2) dbg
+  | Pstringrefs | Pbytesrefs ->
+      stringref_safe (transl env arg1) (transl env arg2) dbg
+  | Pstring_load(size, unsafe) | Pbytes_load(size, unsafe) ->
+      string_load size unsafe (transl env arg1) (transl env arg2) dbg
+  | Pbigstring_load(size, unsafe) ->
+      bigstring_load size unsafe (transl env arg1) (transl env arg2) dbg
+
+  (* Array operations *)
+  | Parrayrefu kind ->
+      arrayref_unsafe kind (transl env arg1) (transl env arg2) dbg
+  | Parrayrefs kind ->
+      arrayref_safe kind (transl env arg1) (transl env arg2) dbg
+
+  (* Boxed integers *)
+  | Paddbint bi ->
+      box_int dbg bi (Cop(Caddi,
+                      [transl_unbox_int_low dbg env bi arg1;
+                       transl_unbox_int_low dbg env bi arg2], dbg))
+  | Psubbint bi ->
+      box_int dbg bi (Cop(Csubi,
+                      [transl_unbox_int_low dbg env bi arg1;
+                       transl_unbox_int_low dbg env bi arg2], dbg))
+  | Pmulbint bi ->
+      box_int dbg bi (Cop(Cmuli,
+                      [transl_unbox_int_low dbg env bi arg1;
+                       transl_unbox_int_low dbg env bi arg2], dbg))
+  | Pdivbint { size = bi; is_safe } ->
+      box_int dbg bi (safe_div_bi is_safe
+                      (transl_unbox_int dbg env bi arg1)
+                      (transl_unbox_int dbg env bi arg2)
+                      bi dbg)
+  | Pmodbint { size = bi; is_safe } ->
+      box_int dbg bi (safe_mod_bi is_safe
+                      (transl_unbox_int dbg env bi arg1)
+                      (transl_unbox_int dbg env bi arg2)
+                      bi dbg)
+  | Pandbint bi ->
+      box_int dbg bi (Cop(Cand,
+                     [transl_unbox_int_low dbg env bi arg1;
+                      transl_unbox_int_low dbg env bi arg2], dbg))
+  | Porbint bi ->
+      box_int dbg bi (Cop(Cor,
+                     [transl_unbox_int_low dbg env bi arg1;
+                      transl_unbox_int_low dbg env bi arg2], dbg))
+  | Pxorbint bi ->
+      box_int dbg bi (Cop(Cxor,
+                     [transl_unbox_int_low dbg env bi arg1;
+                      transl_unbox_int_low dbg env bi arg2], dbg))
+  | Plslbint bi ->
+      box_int dbg bi (Cop(Clsl,
+                     [transl_unbox_int_low dbg env bi arg1;
+                      untag_int(transl env arg2) dbg], dbg))
+  | Plsrbint bi ->
+      box_int dbg bi (Cop(Clsr,
+                     [make_unsigned_int bi (transl_unbox_int dbg env bi arg1)
+                                        dbg;
+                      untag_int(transl env arg2) dbg], dbg))
+  | Pasrbint bi ->
+      box_int dbg bi (Cop(Casr,
+                     [transl_unbox_int dbg env bi arg1;
+                      untag_int(transl env arg2) dbg], dbg))
+  | Pbintcomp(bi, cmp) ->
+      tag_int (Cop(Ccmpi cmp,
+                     [transl_unbox_int dbg env bi arg1;
+                      transl_unbox_int dbg env bi arg2], dbg)) dbg
+  | Pnot | Pnegint | Pintoffloat | Pfloatofint | Pnegfloat
+  | Pabsfloat | Pstringlength | Pbyteslength | Pbytessetu | Pbytessets
+  | Pisint | Pbswap16 | Pint_as_pointer | Popaque | Pread_symbol _
+  | Pmakeblock (_, _, _) | Pfield _ | Psetfield_computed (_, _) | Pfloatfield _
+  | Pduprecord (_, _) | Pccall _ | Praise _ | Poffsetint _ | Poffsetref _
+  | Pmakearray (_, _) | Pduparray (_, _) | Parraylength _ | Parraysetu _
+  | Parraysets _ | Pbintofint _ | Pintofbint _ | Pcvtbint (_, _)
+  | Pnegbint _ | Pbigarrayref (_, _, _, _) | Pbigarrayset (_, _, _, _)
+  | Pbigarraydim _ | Pbytes_set _ | Pbigstring_set _ | Pbbswap _
+    ->
+      fatal_errorf "Cmmgen.transl_prim_2: %a"
+        Printclambda_primitives.primitive p
+
+and transl_prim_3 env p arg1 arg2 arg3 dbg =
+  match p with
+  (* Heap operations *)
+  | Psetfield_computed(ptr, init) ->
+      setfield_computed ptr init
+        (transl env arg1) (transl env arg2) (transl env arg3) dbg
+  (* String operations *)
+  | Pbytessetu ->
+      bytesset_unsafe
+        (transl env arg1) (transl env arg2) (transl env arg3) dbg
+  | Pbytessets ->
+      bytesset_safe
+        (transl env arg1) (transl env arg2) (transl env arg3) dbg
+
+  (* Array operations *)
+  | Parraysetu kind ->
+      let newval =
+        match kind with
+        | Pfloatarray -> transl_unbox_float dbg env arg3
+        | _ -> transl env arg3
+      in
+      arrayset_unsafe kind (transl env arg1) (transl env arg2) newval dbg
+  | Parraysets kind ->
+      let newval =
+        match kind with
+        | Pfloatarray -> transl_unbox_float dbg env arg3
+        | _ -> transl env arg3
+      in
+      arrayset_safe kind (transl env arg1) (transl env arg2) newval dbg
+
+  | Pbytes_set(size, unsafe) ->
+      bytes_set size unsafe (transl env arg1) (transl env arg2)
+        (transl_unbox_sized size dbg env arg3) dbg
+
+  | Pbigstring_set(size, unsafe) ->
+      bigstring_set size unsafe (transl env arg1) (transl env arg2)
+        (transl_unbox_sized size dbg env arg3) dbg
+
+  | Pfield_computed | Psequand | Psequor | Pnot | Pnegint | Paddint
+  | Psubint | Pmulint | Pandint | Porint | Pxorint | Plslint | Plsrint | Pasrint
+  | Pintoffloat | Pfloatofint | Pnegfloat | Pabsfloat | Paddfloat | Psubfloat
+  | Pmulfloat | Pdivfloat | Pstringlength | Pstringrefu | Pstringrefs
+  | Pbyteslength | Pbytesrefu | Pbytesrefs | Pisint | Pisout
+  | Pbswap16 | Pint_as_pointer | Popaque | Pread_symbol _ | Pmakeblock (_, _, _)
+  | Pfield _ | Psetfield (_, _, _) | Pfloatfield _ | Psetfloatfield (_, _)
+  | Pduprecord (_, _) | Pccall _ | Praise _ | Pdivint _ | Pmodint _ | Pintcomp _
+  | Pcompare_ints | Pcompare_floats | Pcompare_bints _
+  | Poffsetint _ | Poffsetref _ | Pfloatcomp _ | Pmakearray (_, _)
+  | Pduparray (_, _) | Parraylength _ | Parrayrefu _ | Parrayrefs _
+  | Pbintofint _ | Pintofbint _ | Pcvtbint (_, _) | Pnegbint _ | Paddbint _
+  | Psubbint _ | Pmulbint _ | Pdivbint _ | Pmodbint _ | Pandbint _ | Porbint _
+  | Pxorbint _ | Plslbint _ | Plsrbint _ | Pasrbint _ | Pbintcomp (_, _)
+  | Pbigarrayref (_, _, _, _) | Pbigarrayset (_, _, _, _) | Pbigarraydim _
+  | Pstring_load _ | Pbytes_load _ | Pbigstring_load _ | Pbbswap _
+    ->
+      fatal_errorf "Cmmgen.transl_prim_3: %a"
+        Printclambda_primitives.primitive p
+
+and transl_unbox_float dbg env exp =
+  unbox_float dbg (transl env exp)
+
+and transl_unbox_int dbg env bi exp =
+  unbox_int dbg bi (transl env exp)
+
+(* transl_unbox_int, but may return garbage in upper bits *)
+and transl_unbox_int_low dbg env bi e =
+  let e = transl_unbox_int dbg env bi e in
+  if bi = Pint32 then low_32 dbg e else e
+
+and transl_unbox_sized size dbg env exp =
+  match size with
+  | Sixteen ->
+     ignore_high_bit_int (untag_int (transl env exp) dbg)
+  | Thirty_two -> transl_unbox_int dbg env Pint32 exp
+  | Sixty_four -> transl_unbox_int dbg env Pint64 exp
+
+and transl_let env str kind id exp body =
+  let dbg = Debuginfo.none in
+  let cexp = transl env exp in
+  let unboxing =
+    (* If [id] is a mutable variable (introduced to eliminate a local
+       reference) and it contains a type of unboxable numbers, then
+       force unboxing.  Indeed, if not boxed, each assignment to the variable
+       might require some boxing, but such local references are often
+       used in loops and we really want to avoid repeated boxing. *)
+    match str, kind with
+    | Mutable, Pfloatval ->
+        Boxed (Boxed_float dbg, false)
+    | Mutable, Pboxedintval bi ->
+        Boxed (Boxed_integer (bi, dbg), false)
+    | _, (Pfloatval | Pboxedintval _) ->
+        (* 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
+    | _, 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
+    | _, Pintval ->
+        No_unboxing
+  in
+  match unboxing with
+  | No_unboxing | Boxed (_, true) | No_result ->
+      (* N.B. [body] must still be traversed even if [exp] will never return:
+         there may be constant closures inside that need lifting out. *)
+      begin match str, kind with
+      | Immutable, _ -> Clet(id, cexp, transl env body)
+      | Mutable, Pintval -> Clet_mut(id, typ_int, cexp, transl env body)
+      | Mutable, _ -> Clet_mut(id, typ_val, cexp, transl env body)
+      end
+  | Boxed (boxed_number, false) ->
+      let unboxed_id = V.create_local (VP.name id) in
+      let v = VP.create unboxed_id in
+      let cexp = unbox_number dbg boxed_number cexp in
+      let body =
+        transl (add_unboxed_id (VP.var id) unboxed_id boxed_number env) body in
+      begin match str, boxed_number with
+      | Immutable, _ -> Clet (v, cexp, body)
+      | Mutable, bn -> Clet_mut (v, typ_of_boxed_number bn, cexp, body)
+      end
+
+and make_catch ncatch body handler dbg = match body with
+| Cexit (nexit,[]) when nexit=ncatch -> handler
+| _ ->  ccatch (ncatch, [], body, handler, dbg)
+
+and is_shareable_cont exp =
+  match exp with
+  | Cexit (_,[]) -> true
+  | _ -> false
+
+and make_shareable_cont dbg mk exp =
+  if is_shareable_cont exp then mk exp
+  else begin
+    let nfail = next_raise_count () in
+    make_catch
+      nfail
+      (mk (Cexit (nfail,[])))
+      exp
+      dbg
+  end
+
+and transl_if env (approx : then_else)
+      (dbg : Debuginfo.t) cond
+      (then_dbg : Debuginfo.t) then_
+      (else_dbg : Debuginfo.t) else_ =
+  match cond with
+  | Uconst (Uconst_ptr 0) -> else_
+  | Uconst (Uconst_ptr 1) -> then_
+  | Uifthenelse (arg1, arg2, Uconst (Uconst_ptr 0)) ->
+      (* CR mshinwell: These Debuginfos will flow through from Clambda *)
+      let inner_dbg = Debuginfo.none in
+      let ifso_dbg = Debuginfo.none in
+      transl_sequand env approx
+        inner_dbg arg1
+        ifso_dbg arg2
+        then_dbg then_
+        else_dbg else_
+  | Uprim (Psequand, [arg1; arg2], inner_dbg) ->
+      transl_sequand env approx
+        inner_dbg arg1
+        inner_dbg arg2
+        then_dbg then_
+        else_dbg else_
+  | Uifthenelse (arg1, Uconst (Uconst_ptr 1), arg2) ->
+      let inner_dbg = Debuginfo.none in
+      let ifnot_dbg = Debuginfo.none in
+      transl_sequor env approx
+        inner_dbg arg1
+        ifnot_dbg arg2
+        then_dbg then_
+        else_dbg else_
+  | Uprim (Psequor, [arg1; arg2], inner_dbg) ->
+      transl_sequor env approx
+        inner_dbg arg1
+        inner_dbg arg2
+        then_dbg then_
+        else_dbg else_
+  | Uprim (Pnot, [arg], _dbg) ->
+      transl_if env (invert_then_else approx)
+        dbg arg
+        else_dbg else_
+        then_dbg then_
+  | Uifthenelse (Uconst (Uconst_ptr 1), ifso, _) ->
+      let ifso_dbg = Debuginfo.none in
+      transl_if env approx
+        ifso_dbg ifso
+        then_dbg then_
+        else_dbg else_
+  | Uifthenelse (Uconst (Uconst_ptr 0), _, ifnot) ->
+      let ifnot_dbg = Debuginfo.none in
+      transl_if env approx
+        ifnot_dbg ifnot
+        then_dbg then_
+        else_dbg else_
+  | Uifthenelse (cond, ifso, ifnot) ->
+      let inner_dbg = Debuginfo.none in
+      let ifso_dbg = Debuginfo.none in
+      let ifnot_dbg = Debuginfo.none in
+      make_shareable_cont then_dbg
+        (fun shareable_then ->
+           make_shareable_cont else_dbg
+             (fun shareable_else ->
+                mk_if_then_else
+                  inner_dbg (test_bool inner_dbg (transl env cond))
+                  ifso_dbg (transl_if env approx
+                    ifso_dbg ifso
+                    then_dbg shareable_then
+                    else_dbg shareable_else)
+                  ifnot_dbg (transl_if env approx
+                    ifnot_dbg ifnot
+                    then_dbg shareable_then
+                    else_dbg shareable_else))
+             else_)
+        then_
+  | _ -> begin
+      match approx with
+      | Then_true_else_false ->
+          transl env cond
+      | Then_false_else_true ->
+          mk_not dbg (transl env cond)
+      | Unknown ->
+          mk_if_then_else
+            dbg (test_bool dbg (transl env cond))
+            then_dbg then_
+            else_dbg else_
+    end
+
+and transl_sequand env (approx : then_else)
+      (arg1_dbg : Debuginfo.t) arg1
+      (arg2_dbg : Debuginfo.t) arg2
+      (then_dbg : Debuginfo.t) then_
+      (else_dbg : Debuginfo.t) else_ =
+  make_shareable_cont else_dbg
+    (fun shareable_else ->
+       transl_if env Unknown
+         arg1_dbg arg1
+         arg2_dbg (transl_if env approx
+           arg2_dbg arg2
+           then_dbg then_
+           else_dbg shareable_else)
+         else_dbg shareable_else)
+    else_
+
+and transl_sequor env (approx : then_else)
+      (arg1_dbg : Debuginfo.t) arg1
+      (arg2_dbg : Debuginfo.t) arg2
+      (then_dbg : Debuginfo.t) then_
+      (else_dbg : Debuginfo.t) else_ =
+  make_shareable_cont then_dbg
+    (fun shareable_then ->
+       transl_if env Unknown
+         arg1_dbg arg1
+         then_dbg shareable_then
+         arg2_dbg (transl_if env approx
+           arg2_dbg arg2
+           then_dbg shareable_then
+           else_dbg else_))
+    then_
+
+(* This assumes that [arg] can be safely discarded if it is not used. *)
+and transl_switch dbg env arg index cases = match Array.length cases with
+| 0 -> fatal_error "Cmmgen.transl_switch"
+| 1 -> transl env cases.(0)
+| _ ->
+    let cases = Array.map (transl env) cases in
+    transl_switch_clambda dbg arg index cases
+
+and transl_letrec env bindings cont =
+  let dbg = Debuginfo.none in
+  let bsz =
+    List.map (fun (id, exp) -> (id, exp, expr_size V.empty exp))
+      bindings
+  in
+  let op_alloc prim args =
+    Cop(Cextcall(prim, typ_val, true, None), args, dbg) in
+  let rec init_blocks = function
+    | [] -> fill_nonrec bsz
+    | (id, _exp, RHS_block sz) :: rem ->
+        Clet(id, op_alloc "caml_alloc_dummy" [int_const dbg sz],
+          init_blocks rem)
+    | (id, _exp, RHS_infix { blocksize; offset}) :: rem ->
+        Clet(id, op_alloc "caml_alloc_dummy_infix"
+             [int_const dbg blocksize; int_const dbg offset],
+             init_blocks rem)
+    | (id, _exp, RHS_floatblock sz) :: rem ->
+        Clet(id, op_alloc "caml_alloc_dummy_float" [int_const dbg sz],
+          init_blocks rem)
+    | (id, _exp, RHS_nonrec) :: rem ->
+        Clet (id, Cconst_int (1, dbg), init_blocks rem)
+  and fill_nonrec = function
+    | [] -> fill_blocks bsz
+    | (_id, _exp,
+       (RHS_block _ | RHS_infix _ | RHS_floatblock _)) :: rem ->
+        fill_nonrec rem
+    | (id, exp, RHS_nonrec) :: rem ->
+        Clet(id, transl env exp, fill_nonrec rem)
+  and fill_blocks = function
+    | [] -> cont
+    | (id, exp, (RHS_block _ | RHS_infix _ | RHS_floatblock _)) :: rem ->
+        let op =
+          Cop(Cextcall("caml_update_dummy", typ_void, false, None),
+              [Cvar (VP.var id); transl env exp], dbg) in
+        Csequence(op, fill_blocks rem)
+    | (_id, _exp, RHS_nonrec) :: rem ->
+        fill_blocks rem
+  in init_blocks bsz
+
+(* Translate a function definition *)
+
+let transl_function f =
+  let body = f.body in
+  let cmm_body =
+    let env = create_env ~environment_param:f.env in
+    if !Clflags.afl_instrument then
+      Afl_instrument.instrument_function (transl env body) f.dbg
+    else
+      transl env body in
+  let fun_codegen_options =
+    if !Clflags.optimize_for_speed then
+      []
+    else
+      [ Reduce_code_size ]
+  in
+  Cfunction {fun_name = f.label;
+             fun_args = List.map (fun (id, _) -> (id, typ_val)) f.params;
+             fun_body = cmm_body;
+             fun_codegen_options;
+             fun_dbg  = f.dbg}
+
+(* Translate all function definitions *)
+
+let rec transl_all_functions already_translated cont =
+  match Cmmgen_state.next_function () with
+  | None -> cont, already_translated
+  | Some f ->
+    let sym = f.label in
+    if String.Set.mem sym already_translated then
+      transl_all_functions already_translated cont
+    else begin
+      transl_all_functions
+        (String.Set.add sym already_translated)
+        ((f.dbg, transl_function f) :: cont)
+    end
+
+(* Emit constant blocks *)
+
+let emit_constant_table symb elems =
+  cdefine_symbol symb @
+  elems
+
+(* Emit all structured constants *)
+
+let transl_clambda_constants (constants : Clambda.preallocated_constant list)
+      cont =
+  let c = ref cont in
+  let emit_clambda_constant symbol global cst =
+     let cst = emit_structured_constant (symbol, global) cst [] in
+     c := (Cdata cst) :: !c
+  in
+  List.iter
+    (fun { symbol; exported; definition = cst; provenance = _; } ->
+       let global : Cmmgen_state.is_global =
+         if exported then Global else Local
+       in
+       emit_clambda_constant symbol global cst)
+    constants;
+  !c
+
+let emit_cmm_data_items_for_constants cont =
+  let c = ref cont in
+  String.Map.iter (fun symbol (cst : Cmmgen_state.constant) ->
+      match cst with
+      | Const_closure (global, fundecls, clos_vars) ->
+          let cmm =
+            emit_constant_closure (symbol, global) fundecls
+              (List.fold_right emit_constant clos_vars []) []
+          in
+          c := (Cdata cmm) :: !c
+      | Const_table (global, elems) ->
+          c := (Cdata (emit_constant_table (symbol, global) elems)) :: !c)
+    (Cmmgen_state.get_and_clear_constants ());
+  Cdata (Cmmgen_state.get_and_clear_data_items ()) :: !c
+
+let transl_all_functions cont =
+  let rec aux already_translated cont translated_functions =
+    if Cmmgen_state.no_more_functions ()
+    then cont, translated_functions
+    else
+      let translated_functions, already_translated =
+        transl_all_functions already_translated translated_functions
+      in
+      aux already_translated cont translated_functions
+  in
+  let cont, translated_functions =
+    aux String.Set.empty cont []
+  in
+  let translated_functions =
+    (* Sort functions according to source position *)
+    List.map snd
+      (List.sort (fun (dbg1, _) (dbg2, _) ->
+           Debuginfo.compare dbg1 dbg2) translated_functions)
+  in
+  translated_functions @ cont
+
+(* Translate a compilation unit *)
+
+let compunit (ulam, preallocated_blocks, constants) =
+  assert (Cmmgen_state.no_more_functions ());
+  let dbg = Debuginfo.none in
+  Cmmgen_state.set_structured_constants constants;
+  let init_code =
+    if !Clflags.afl_instrument then
+      Afl_instrument.instrument_initialiser (transl empty_env ulam)
+        (fun () -> dbg)
+    else
+      transl empty_env ulam in
+  let c1 = [Cfunction {fun_name = Compilenv.make_symbol (Some "entry");
+                       fun_args = [];
+                       fun_body = init_code;
+                       (* This function is often large and run only once.
+                          Compilation time matter more than runtime.
+                          See MPR#7630 *)
+                       fun_codegen_options =
+                         if Config.flambda then [
+                           Reduce_code_size;
+                           No_CSE;
+                         ]
+                         else [ Reduce_code_size ];
+                       fun_dbg  = Debuginfo.none }] in
+  let c2 = transl_clambda_constants constants c1 in
+  let c3 = transl_all_functions c2 in
+  Cmmgen_state.set_structured_constants [];
+  let c4 = emit_preallocated_blocks preallocated_blocks c3 in
+  emit_cmm_data_items_for_constants c4
diff --git a/asmcomp/cmmgen.mli b/asmcomp/cmmgen.mli
new file mode 100644
index 00000000..a954a284
--- /dev/null
+++ b/asmcomp/cmmgen.mli
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Translation from closed lambda to C-- *)
+
+val compunit
+   : Clambda.ulambda
+    * Clambda.preallocated_block list
+    * Clambda.preallocated_constant list
+  -> Cmm.phrase list
diff --git a/asmcomp/cmmgen_state.ml b/asmcomp/cmmgen_state.ml
new file mode 100644
index 00000000..595aba4d
--- /dev/null
+++ b/asmcomp/cmmgen_state.ml
@@ -0,0 +1,85 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                     Mark Shinwell, Jane Street Europe                  *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+module S = Misc.Stdlib.String
+
+type is_global = Global | Local
+
+type constant =
+  | Const_closure of is_global * Clambda.ufunction list * Clambda.uconstant list
+  | Const_table of is_global * Cmm.data_item list
+
+type t = {
+  mutable constants : constant S.Map.t;
+  mutable data_items : Cmm.data_item list list;
+  structured_constants : (string,  Clambda.ustructured_constant) Hashtbl.t;
+  functions : Clambda.ufunction Queue.t;
+}
+
+let empty = {
+  constants = S.Map.empty;
+  data_items = [];
+  functions = Queue.create ();
+  structured_constants = Hashtbl.create 16;
+}
+
+let state = empty
+
+let add_constant sym cst =
+  state.constants <- S.Map.add sym cst state.constants
+
+let add_data_items items =
+  state.data_items <- items :: state.data_items
+
+let add_function func =
+  Queue.add func state.functions
+
+let get_and_clear_constants () =
+  let constants = state.constants in
+  state.constants <- S.Map.empty;
+  constants
+
+let get_and_clear_data_items () =
+  let data_items = List.concat (List.rev state.data_items) in
+  state.data_items <- [];
+  data_items
+
+let next_function () =
+  match Queue.take state.functions with
+  | exception Queue.Empty -> None
+  | func -> Some func
+
+let no_more_functions () =
+  Queue.is_empty state.functions
+
+let set_structured_constants l =
+  Hashtbl.clear state.structured_constants;
+  List.iter
+    (fun (c : Clambda.preallocated_constant) ->
+       Hashtbl.add state.structured_constants c.symbol c.definition
+    )
+    l
+
+let get_structured_constant s =
+  Hashtbl.find_opt state.structured_constants s
+
+let structured_constant_of_sym s =
+  match Compilenv.structured_constant_of_symbol s with
+  | None -> get_structured_constant s
+  | Some _ as r -> r
diff --git a/asmcomp/cmmgen_state.mli b/asmcomp/cmmgen_state.mli
new file mode 100644
index 00000000..306f55d5
--- /dev/null
+++ b/asmcomp/cmmgen_state.mli
@@ -0,0 +1,45 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                     Mark Shinwell, Jane Street Europe                  *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Mutable state used by [Cmmgen]. *)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+type is_global = Global | Local
+
+type constant =
+  | Const_closure of is_global * Clambda.ufunction list * Clambda.uconstant list
+  | Const_table of is_global * Cmm.data_item list
+
+val add_constant : Misc.Stdlib.String.t -> constant -> unit
+
+val add_data_items : Cmm.data_item list -> unit
+
+val add_function : Clambda.ufunction -> unit
+
+val get_and_clear_constants : unit -> constant Misc.Stdlib.String.Map.t
+
+val get_and_clear_data_items : unit -> Cmm.data_item list
+
+val next_function : unit -> Clambda.ufunction option
+
+val no_more_functions : unit -> bool
+
+val set_structured_constants : Clambda.preallocated_constant list -> unit
+
+(* Also looks up using Compilenv.structured_constant_of_symbol *)
+val structured_constant_of_sym : string -> Clambda.ustructured_constant option
diff --git a/asmcomp/coloring.ml b/asmcomp/coloring.ml
new file mode 100644
index 00000000..897da20d
--- /dev/null
+++ b/asmcomp/coloring.ml
@@ -0,0 +1,220 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Register allocation by coloring of the interference graph *)
+
+module OrderedRegSet =
+  Set.Make(struct
+    type t = Reg.t
+    let compare r1 r2 =
+      let open Reg in
+      let c1 = r1.spill_cost and d1 = r1.degree in
+      let c2 = r2.spill_cost and d2 = r2.degree in
+      let n = c2 * d1 - c1 * d2 in
+      if n <> 0 then n else
+        let n = c2 - c1 in
+        if n <> 0 then n else
+          let n = d1 - d2 in
+          if n <> 0 then n else r1.stamp - r2.stamp
+  end)
+
+open Reg
+
+let allocate_registers() =
+
+  (* Constrained regs with degree >= number of available registers,
+     sorted by spill cost (highest first).
+     The spill cost measure is [r.spill_cost / r.degree].
+     [r.spill_cost] estimates the number of accesses to [r]. *)
+  let constrained = ref OrderedRegSet.empty in
+
+  (* Unconstrained regs with degree < number of available registers *)
+  let unconstrained = ref [] in
+
+  (* Reset the stack slot counts *)
+  let num_stack_slots = Array.make Proc.num_register_classes 0 in
+
+  (* Preallocate the spilled registers in the stack.
+     Split the remaining registers into constrained and unconstrained. *)
+  let remove_reg reg =
+    let cl = Proc.register_class reg in
+    if reg.spill then begin
+      (* Preallocate the registers in the stack *)
+      let nslots = num_stack_slots.(cl) in
+      let conflict = Array.make nslots false in
+      List.iter
+        (fun r ->
+          match r.loc with
+            Stack(Local n) ->
+              if Proc.register_class r = cl then conflict.(n) <- true
+          | _ -> ())
+        reg.interf;
+      let slot = ref 0 in
+      while !slot < nslots && conflict.(!slot) do incr slot done;
+      reg.loc <- Stack(Local !slot);
+      if !slot >= nslots then num_stack_slots.(cl) <- !slot + 1
+    end else if reg.degree < Proc.num_available_registers.(cl) then
+      unconstrained := reg :: !unconstrained
+    else begin
+      constrained := OrderedRegSet.add reg !constrained
+    end in
+
+  (* Iterate over all registers preferred by the given register (transitive) *)
+  let iter_preferred f reg =
+    let rec walk r w =
+      if not (Reg.is_visited r) then begin
+        Reg.mark_visited r;
+        f r w;
+        List.iter (fun (r1, w1) -> walk r1 (min w w1)) r.prefer
+      end in
+    List.iter (fun (r, w) -> walk r w) reg.prefer;
+    Reg.clear_visited_marks () in
+
+  (* Where to start the search for a suitable register.
+     Used to introduce some "randomness" in the choice between registers
+     with equal scores. This offers more opportunities for scheduling. *)
+  let start_register = Array.make Proc.num_register_classes 0 in
+
+  (* Assign a location to a register, the best we can. *)
+  let assign_location reg =
+    let cl = Proc.register_class reg in
+    let first_reg = Proc.first_available_register.(cl) in
+    let num_regs = Proc.num_available_registers.(cl) in
+    let score = Array.make num_regs 0 in
+    let best_score = ref (-1000000) and best_reg = ref (-1) in
+    let start = start_register.(cl) in
+    if num_regs <> 0 then begin
+      (* Favor the registers that have been assigned to pseudoregs for which
+         we have a preference. If these pseudoregs have not been assigned
+         already, avoid the registers with which they conflict. *)
+      iter_preferred
+        (fun r w ->
+          match r.loc with
+            Reg n -> let n = n - first_reg in
+                     if n < num_regs then
+                       score.(n) <- score.(n) + w
+          | Unknown ->
+              List.iter
+                (fun neighbour ->
+                  match neighbour.loc with
+                    Reg n -> let n = n - first_reg in
+                             if n < num_regs then
+                               score.(n) <- score.(n) - w
+                  | _ -> ())
+                r.interf
+          | _ -> ())
+        reg;
+      List.iter
+        (fun neighbour ->
+          (* Prohibit the registers that have been assigned
+             to our neighbours *)
+          begin match neighbour.loc with
+            Reg n -> let n = n - first_reg in
+                     if n < num_regs then
+                       score.(n) <- (-1000000)
+          | _ -> ()
+          end;
+          (* Avoid the registers that have been assigned to pseudoregs
+             for which our neighbours have a preference *)
+          iter_preferred
+            (fun r w ->
+              match r.loc with
+                Reg n -> let n = n - first_reg in
+                         if n < num_regs then
+                           score.(n) <- score.(n) - (w-1)
+                         (* w-1 to break the symmetry when two conflicting regs
+                            have the same preference for a third reg. *)
+              | _ -> ())
+            neighbour)
+        reg.interf;
+      (* Pick the register with the best score *)
+      for n = start to num_regs - 1 do
+        if score.(n) > !best_score then begin
+          best_score := score.(n);
+          best_reg := n
+        end
+      done;
+      for n = 0 to start - 1 do
+        if score.(n) > !best_score then begin
+          best_score := score.(n);
+          best_reg := n
+        end
+      done
+    end;
+    (* Found a register? *)
+    if !best_reg >= 0 then begin
+      reg.loc <- Reg(first_reg + !best_reg);
+      if Proc.rotate_registers then
+        start_register.(cl) <- (let start = start + 1 in
+                                if start >= num_regs then 0 else start)
+    end else begin
+      (* Sorry, we must put the pseudoreg in a stack location *)
+      let nslots = num_stack_slots.(cl) in
+      let score = Array.make nslots 0 in
+      (* Compute the scores as for registers *)
+      List.iter
+        (fun (r, w) ->
+          match r.loc with
+            Stack(Local n) -> score.(n) <- score.(n) + w
+          | Unknown ->
+              List.iter
+                (fun neighbour ->
+                  match neighbour.loc with
+                    Stack(Local n) -> score.(n) <- score.(n) - w
+                  | _ -> ())
+                r.interf
+          | _ -> ())
+        reg.prefer;
+      List.iter
+        (fun neighbour ->
+          begin match neighbour.loc with
+              Stack(Local n) -> score.(n) <- (-1000000)
+          | _ -> ()
+          end;
+          List.iter
+            (fun (r, w) ->
+              match r.loc with
+                Stack(Local n) -> score.(n) <- score.(n) - w
+              | _ -> ())
+            neighbour.prefer)
+        reg.interf;
+      (* Pick the location with the best score *)
+      let best_score = ref (-1000000) and best_slot = ref (-1) in
+      for n = 0 to nslots - 1 do
+        if score.(n) > !best_score then begin
+          best_score := score.(n);
+          best_slot := n
+        end
+      done;
+      (* Found one? *)
+      if !best_slot >= 0 then
+        reg.loc <- Stack(Local !best_slot)
+      else begin
+        (* Allocate a new stack slot *)
+        reg.loc <- Stack(Local nslots);
+        num_stack_slots.(cl) <- nslots + 1
+      end
+    end;
+    (* Cancel the preferences of this register so that they don't influence
+       transitively the allocation of registers that prefer this reg. *)
+    reg.prefer <- [] in
+
+  (* First pass: preallocate spill registers and split remaining regs
+     Second pass: assign locations to constrained regs
+     Third pass: assign locations to unconstrained regs *)
+  List.iter remove_reg (Reg.all_registers());
+  OrderedRegSet.iter assign_location !constrained;
+  List.iter assign_location !unconstrained;
+  num_stack_slots
diff --git a/asmcomp/coloring.mli b/asmcomp/coloring.mli
new file mode 100644
index 00000000..83439b90
--- /dev/null
+++ b/asmcomp/coloring.mli
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Register allocation by coloring of the interference graph *)
+
+val allocate_registers: unit -> int array
diff --git a/asmcomp/comballoc.ml b/asmcomp/comballoc.ml
new file mode 100644
index 00000000..6d7e536e
--- /dev/null
+++ b/asmcomp/comballoc.ml
@@ -0,0 +1,103 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1999 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Combine heap allocations occurring in the same basic block *)
+
+open Mach
+
+type pending_alloc =
+  { reg: Reg.t;         (* register holding the result of the last allocation *)
+    dbginfos: Debuginfo.alloc_dbginfo;   (* debug info for each pending alloc *)
+    totalsz: int }                    (* amount to be allocated in this block *)
+
+type allocation_state =
+    No_alloc
+  | Pending_alloc of pending_alloc
+
+let rec combine i allocstate =
+  match i.desc with
+    Iend | Ireturn | Iexit _ | Iraise _ ->
+      (i, allocstate)
+  | Iop(Ialloc { bytes = sz; dbginfo; _ }) ->
+      assert (List.length dbginfo = 1);
+      begin match allocstate with
+      | Pending_alloc {reg; dbginfos; totalsz}
+          when totalsz + sz <= (Config.max_young_wosize + 1) * Arch.size_addr ->
+          let (next, state) =
+           combine i.next
+             (Pending_alloc { reg = i.res.(0);
+                              dbginfos = dbginfo @ dbginfos;
+                              totalsz = totalsz + sz }) in
+         (instr_cons_debug (Iop(Iintop_imm(Iadd, -sz)))
+            [| reg |] i.res i.dbg next,
+           state)
+      | No_alloc | Pending_alloc _ ->
+         let (next, state) =
+           combine i.next
+             (Pending_alloc { reg = i.res.(0);
+                              dbginfos = dbginfo;
+                              totalsz = sz }) in
+         let totalsz, dbginfo =
+           match state with
+           | No_alloc -> assert false
+           | Pending_alloc { totalsz; dbginfos; _ } -> totalsz, dbginfos in
+         let next =
+           let offset = totalsz - sz in
+           if offset = 0 then next
+           else instr_cons_debug (Iop(Iintop_imm(Iadd, offset))) i.res
+                i.res i.dbg next
+         in
+         (instr_cons_debug (Iop(Ialloc {bytes = totalsz; spacetime_index = 0;
+                                        dbginfo; label_after_call_gc = None; }))
+          i.arg i.res i.dbg next, allocstate)
+      end
+  | Iop(Icall_ind _ | Icall_imm _ | Iextcall _ |
+        Itailcall_ind _ | Itailcall_imm _) ->
+      let newnext = combine_restart i.next in
+      (instr_cons_debug i.desc i.arg i.res i.dbg newnext,
+       allocstate)
+  | Iop _ ->
+      let (newnext, s') = combine i.next allocstate in
+      (instr_cons_debug i.desc i.arg i.res i.dbg newnext, s')
+  | Iifthenelse(test, ifso, ifnot) ->
+      let newifso = combine_restart ifso in
+      let newifnot = combine_restart ifnot in
+      let newnext = combine_restart i.next in
+      (instr_cons (Iifthenelse(test, newifso, newifnot)) i.arg i.res newnext,
+       allocstate)
+  | Iswitch(table, cases) ->
+      let newcases = Array.map combine_restart cases in
+      let newnext = combine_restart i.next in
+      (instr_cons (Iswitch(table, newcases)) i.arg i.res newnext,
+       allocstate)
+  | Icatch(rec_flag, handlers, body) ->
+      let (newbody, s') = combine body allocstate in
+      let newhandlers =
+        List.map (fun (io, handler) -> io, combine_restart handler) handlers in
+      let newnext = combine_restart i.next in
+      (instr_cons (Icatch(rec_flag, newhandlers, newbody))
+         i.arg i.res newnext, s')
+  | Itrywith(body, handler) ->
+      let (newbody, s') = combine body allocstate in
+      let newhandler = combine_restart handler in
+      let newnext = combine_restart i.next in
+      (instr_cons (Itrywith(newbody, newhandler)) i.arg i.res newnext, s')
+
+and combine_restart i =
+  let (newi, _) = combine i No_alloc in newi
+
+let fundecl f =
+  if Config.spacetime then f
+  else {f with fun_body = combine_restart f.fun_body}
diff --git a/asmcomp/comballoc.mli b/asmcomp/comballoc.mli
new file mode 100644
index 00000000..19d8fdee
--- /dev/null
+++ b/asmcomp/comballoc.mli
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1999 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Combine heap allocations occurring in the same basic block *)
+
+val fundecl: Mach.fundecl -> Mach.fundecl
diff --git a/asmcomp/deadcode.ml b/asmcomp/deadcode.ml
new file mode 100644
index 00000000..2550639d
--- /dev/null
+++ b/asmcomp/deadcode.ml
@@ -0,0 +1,148 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Dead code elimination: remove pure instructions whose results are
+   not used. *)
+
+open Mach
+
+module Int = Numbers.Int
+
+type d = {
+  i : instruction;   (* optimized instruction *)
+  regs : Reg.Set.t;  (* a set of registers live "before" instruction [i] *)
+  exits : Int.Set.t;  (* indexes of Iexit instructions "live before" [i] *)
+}
+
+let append a b =
+  let rec append a b =
+    match a.desc with
+    | Iend -> b
+    | _ -> { a with next = append a.next b }
+  in
+  match b.desc with
+  | Iend -> a
+  | _ -> append a b
+
+let rec deadcode i =
+  let arg =
+    if Config.spacetime
+      && Mach.spacetime_node_hole_pointer_is_live_before i
+    then Array.append i.arg [| Proc.loc_spacetime_node_hole |]
+    else i.arg
+  in
+  match i.desc with
+  | Iend | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) | Iraise _ ->
+      let regs = Reg.add_set_array i.live arg in
+      { i; regs; exits = Int.Set.empty; }
+  | Iop op ->
+      let s = deadcode i.next in
+      if Proc.op_is_pure op                     (* no side effects *)
+      && Reg.disjoint_set_array s.regs i.res   (* results are not used after *)
+      && not (Proc.regs_are_volatile arg)      (* no stack-like hard reg *)
+      && not (Proc.regs_are_volatile i.res)    (*            is involved *)
+      then begin
+        assert (Array.length i.res > 0);  (* sanity check *)
+        s
+      end else begin
+        { i = {i with next = s.i};
+          regs = Reg.add_set_array i.live arg;
+          exits = s.exits;
+        }
+      end
+  | Iifthenelse(test, ifso, ifnot) ->
+      let ifso' = deadcode ifso in
+      let ifnot' = deadcode ifnot in
+      let s = deadcode i.next in
+      { i = {i with desc = Iifthenelse(test, ifso'.i, ifnot'.i); next = s.i};
+        regs = Reg.add_set_array i.live arg;
+        exits = Int.Set.union s.exits
+                  (Int.Set.union ifso'.exits ifnot'.exits);
+      }
+  | Iswitch(index, cases) ->
+      let dc = Array.map deadcode cases in
+      let cases' = Array.map (fun c -> c.i) dc in
+      let s = deadcode i.next in
+      { i = {i with desc = Iswitch(index, cases'); next = s.i};
+        regs = Reg.add_set_array i.live arg;
+        exits = Array.fold_left
+                  (fun acc c -> Int.Set.union acc c.exits) s.exits dc;
+      }
+  | Icatch(rec_flag, handlers, body) ->
+    let body' = deadcode body in
+    let s = deadcode i.next in
+    let handlers' = Int.Map.map deadcode (Int.Map.of_list handlers) in
+    (* Previous passes guarantee that indexes of handlers are unique
+       across the entire function and Iexit instructions refer
+       to the correctly scoped handlers.
+       We do not rely on it here, for safety. *)
+    let rec add_live nfail (live_exits, used_handlers) =
+      if Int.Set.mem nfail live_exits then
+        (live_exits, used_handlers)
+      else
+        let live_exits = Int.Set.add nfail live_exits in
+        match Int.Map.find_opt nfail handlers' with
+        | None -> (live_exits, used_handlers)
+        | Some handler ->
+          let used_handlers = (nfail, handler) :: used_handlers in
+          match rec_flag with
+          | Cmm.Nonrecursive -> (live_exits, used_handlers)
+          | Cmm.Recursive ->
+            Int.Set.fold add_live handler.exits (live_exits, used_handlers)
+    in
+    let live_exits, used_handlers =
+      Int.Set.fold add_live body'.exits (Int.Set.empty, [])
+    in
+    (* Remove exits that are going out of scope. *)
+    let used_handler_indexes = Int.Set.of_list (List.map fst used_handlers) in
+    let live_exits = Int.Set.diff live_exits used_handler_indexes in
+    (* For non-recursive catch, live exits referenced in handlers are free. *)
+    let live_exits =
+      match rec_flag with
+      | Cmm.Recursive -> live_exits
+      | Cmm.Nonrecursive ->
+        List.fold_left (fun exits (_,h) -> Int.Set.union h.exits exits)
+          live_exits
+          used_handlers
+    in
+    let exits = Int.Set.union s.exits live_exits in
+    begin match used_handlers with
+    | [] -> (* Simplify catch without handlers *)
+      { i = append body'.i s.i;
+        regs = body'.regs;
+        exits;
+      }
+    | _ ->
+      let handlers = List.map (fun (n,h) -> (n,h.i)) used_handlers in
+      { i = { i with desc = Icatch(rec_flag, handlers, body'.i); next = s.i };
+        regs = i.live;
+        exits;
+      }
+    end
+  | Iexit nfail ->
+      { i;  regs = i.live; exits = Int.Set.singleton nfail; }
+  | Itrywith(body, handler) ->
+      let body' = deadcode body in
+      let handler' = deadcode handler in
+      let s = deadcode i.next in
+      { i = {i with desc = Itrywith(body'.i, handler'.i); next = s.i};
+        regs = i.live;
+        exits = Int.Set.union s.exits
+                  (Int.Set.union body'.exits handler'.exits);
+      }
+
+let fundecl f =
+  let new_body = deadcode f.fun_body in
+  {f with fun_body = new_body.i}
diff --git a/asmcomp/deadcode.mli b/asmcomp/deadcode.mli
new file mode 100644
index 00000000..c566cfbd
--- /dev/null
+++ b/asmcomp/deadcode.mli
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Dead code elimination: remove pure instructions whose results are
+   not used. *)
+
+val fundecl: Mach.fundecl -> Mach.fundecl
diff --git a/asmcomp/debug/available_regs.ml b/asmcomp/debug/available_regs.ml
new file mode 100644
index 00000000..6ca2544b
--- /dev/null
+++ b/asmcomp/debug/available_regs.ml
@@ -0,0 +1,351 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*            Mark Shinwell and Thomas Refis, Jane Street Europe          *)
+(*                                                                        *)
+(*   Copyright 2013--2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+module M = Mach
+module R = Reg
+module RAS = Reg_availability_set
+module RD = Reg_with_debug_info
+module V = Backend_var
+
+(* This pass treats [avail_at_exit] like a "result" structure whereas the
+   equivalent in [Liveness] is like an "environment".  (Which means we need
+   to be careful not to throw away information about further-out catch
+   handlers collected in [avail_at_exit].) *)
+let avail_at_exit = Hashtbl.create 42
+let avail_at_raise = ref RAS.Unreachable
+
+let augment_availability_at_raise avail =
+  avail_at_raise := RAS.inter avail !avail_at_raise
+
+let check_invariants (instr : M.instruction) ~(avail_before : RAS.t) =
+  match avail_before with
+  | Unreachable -> ()
+  | Ok avail_before ->
+    (* Every register that is live across an instruction should also be
+       available before the instruction. *)
+    if not (R.Set.subset instr.live (RD.Set.forget_debug_info avail_before))
+    then begin
+      Misc.fatal_errorf "Live registers not a subset of available registers: \
+          live={%a} avail_before=%a missing={%a} insn=%a"
+        Printmach.regset instr.live
+        (RAS.print ~print_reg:Printmach.reg)
+        (RAS.Ok avail_before)
+        Printmach.regset (R.Set.diff instr.live
+          (RD.Set.forget_debug_info avail_before))
+        Printmach.instr ({ instr with M. next = M.end_instr (); })
+    end;
+    (* Every register that is an input to an instruction should be
+       available. *)
+    let args = R.set_of_array instr.arg in
+    let avail_before_fdi = RD.Set.forget_debug_info avail_before in
+    if not (R.Set.subset args avail_before_fdi) then begin
+      Misc.fatal_errorf "Instruction has unavailable input register(s): \
+          avail_before=%a avail_before_fdi={%a} inputs={%a} insn=%a"
+        (RAS.print ~print_reg:Printmach.reg) (RAS.Ok avail_before)
+        Printmach.regset avail_before_fdi
+        Printmach.regset args
+        Printmach.instr ({ instr with M. next = M.end_instr (); })
+    end
+
+(* [available_regs ~instr ~avail_before] calculates, given the registers
+   "available before" an instruction [instr], the registers that are available
+   both "across" and immediately after [instr].  This is a forwards dataflow
+   analysis.
+
+   "available before" can be thought of, at the assembly level, as the set of
+   registers available when the program counter is equal to the address of the
+   particular instruction under consideration (that is to say, immediately
+   prior to the instruction being executed).  Inputs to that instruction are
+   available at this point even if the instruction will clobber them.  Results
+   from the previous instruction are also available at this point.
+
+   "available across" is the registers available during the execution of
+   some particular instruction.  These are the registers "available before"
+   minus registers that may be clobbered or otherwise invalidated by the
+   instruction.  (The notion of "available across" is only useful for [Iop]
+   instructions.  Recall that some of these may expand into multiple
+   machine instructions including clobbers, e.g. for [Ialloc].)
+
+   The [available_before] and [available_across] fields of each instruction
+   is updated by this function.
+*)
+let rec available_regs (instr : M.instruction)
+      ~(avail_before : RAS.t) : RAS.t =
+  check_invariants instr ~avail_before;
+  instr.available_before <- avail_before;
+  let avail_across, avail_after =
+    let ok set = RAS.Ok set in
+    let unreachable = RAS.Unreachable in
+    match avail_before with
+    | Unreachable -> None, unreachable
+    | Ok avail_before ->
+      match instr.desc with
+      | Iend -> None, ok avail_before
+      | Ireturn -> None, unreachable
+      | Iop (Itailcall_ind _) | Iop (Itailcall_imm _) ->
+        Some (ok Reg_with_debug_info.Set.empty), unreachable
+      | Iop (Iname_for_debugger { ident; which_parameter; provenance;
+          is_assignment; }) ->
+        (* First forget about any existing debug info to do with [ident]
+           if the naming corresponds to an assignment operation. *)
+        let forgetting_ident =
+          if not is_assignment then
+            avail_before
+          else
+            RD.Set.map (fun reg ->
+                match RD.debug_info reg with
+                | None -> reg
+                | Some debug_info ->
+                  if V.same
+                    (RD.Debug_info.holds_value_of debug_info) ident
+                  then RD.clear_debug_info reg
+                  else reg)
+              avail_before
+        in
+        let avail_after = ref forgetting_ident in
+        let num_parts_of_value = Array.length instr.arg in
+        (* Add debug info about [ident], but only for registers that are known
+           to be available. *)
+        for part_of_value = 0 to num_parts_of_value - 1 do
+          let reg = instr.arg.(part_of_value) in
+          if RD.Set.mem_reg forgetting_ident reg then begin
+            let regd =
+              RD.create ~reg
+                ~holds_value_of:ident
+                ~part_of_value
+                ~num_parts_of_value
+                ~which_parameter
+                ~provenance
+            in
+            avail_after := RD.Set.add regd (RD.Set.filter_reg !avail_after reg)
+          end
+        done;
+        Some (ok avail_before), ok !avail_after
+      | Iop (Imove | Ireload | Ispill) ->
+        (* Moves are special: they enable us to propagate names.
+           No-op moves need to be handled specially---in this case, we may
+           learn that a given hard register holds the value of multiple
+           pseudoregisters (all of which have the same value).  This makes us
+           match up properly with [Liveness]. *)
+        let move_to_same_location =
+          let move_to_same_location = ref true in
+          for i = 0 to Array.length instr.arg - 1 do
+            let arg = instr.arg.(i) in
+            let res = instr.res.(i) in
+            (* Note that the register classes must be the same, so we don't
+                need to check that. *)
+            if arg.loc <> res.loc then begin
+              move_to_same_location := false
+            end
+          done;
+          !move_to_same_location
+        in
+        let made_unavailable =
+          if move_to_same_location then
+            RD.Set.empty
+          else
+            RD.Set.made_unavailable_by_clobber avail_before
+              ~regs_clobbered:instr.res
+              ~register_class:Proc.register_class
+        in
+        let results =
+          Array.map2 (fun arg_reg result_reg ->
+              match RD.Set.find_reg_exn avail_before arg_reg with
+              | exception Not_found ->
+                assert false  (* see second invariant in [check_invariants] *)
+              | arg_reg ->
+                RD.create_copying_debug_info ~reg:result_reg
+                  ~debug_info_from:arg_reg)
+            instr.arg instr.res
+        in
+        let avail_across = RD.Set.diff avail_before made_unavailable in
+        let avail_after = RD.Set.union avail_across (RD.Set.of_array results) in
+        Some (ok avail_across), ok avail_after
+      | Iop op ->
+        (* We split the calculation of registers that become unavailable after
+           a call into two parts.  First: anything that the target marks as
+           destroyed by the operation, combined with any registers that will
+           be clobbered by the operation writing out its results. *)
+        let made_unavailable_1 =
+          let regs_clobbered =
+            Array.append (Proc.destroyed_at_oper instr.desc) instr.res
+          in
+          RD.Set.made_unavailable_by_clobber avail_before ~regs_clobbered
+            ~register_class:Proc.register_class
+        in
+        (* Second: the cases of (a) allocations and (b) OCaml to OCaml function
+           calls.  In these cases, since the GC may run, registers always
+           become unavailable unless:
+           (a) they are "live across" the instruction; and/or
+           (b) they hold immediates and are assigned to the stack.
+           For the moment we assume that [Ispecific] instructions do not
+           run the GC. *)
+        (* CR-someday mshinwell: Consider factoring this out from here and
+           [Available_ranges.Make_ranges.end_pos_offset]. *)
+        let made_unavailable_2 =
+          match op with
+          | Icall_ind _ | Icall_imm _ | Ialloc _ ->
+            RD.Set.filter (fun reg ->
+                let holds_immediate = RD.holds_non_pointer reg in
+                let on_stack = RD.assigned_to_stack reg in
+                let live_across = Reg.Set.mem (RD.reg reg) instr.live in
+                let remains_available =
+                  live_across
+                    || (holds_immediate && on_stack)
+                in
+                not remains_available)
+              avail_before
+          | _ -> RD.Set.empty
+        in
+        let made_unavailable =
+          RD.Set.union made_unavailable_1 made_unavailable_2
+        in
+        let avail_across = RD.Set.diff avail_before made_unavailable in
+        if M.operation_can_raise op then begin
+          augment_availability_at_raise (ok avail_across)
+        end;
+        let avail_after =
+          RD.Set.union
+            (RD.Set.without_debug_info (Reg.set_of_array instr.res))
+            avail_across
+        in
+        Some (ok avail_across), ok avail_after
+      | Iifthenelse (_, ifso, ifnot) -> join [ifso; ifnot] ~avail_before
+      | Iswitch (_, cases) -> join (Array.to_list cases) ~avail_before
+      | Icatch (recursive, handlers, body) ->
+        List.iter (fun (nfail, _handler) ->
+            (* In case there are nested [Icatch] expressions with the same
+               handler numbers, we rely on the [Hashtbl] shadowing
+               semantics. *)
+            Hashtbl.add avail_at_exit nfail unreachable)
+          handlers;
+        let avail_after_body =
+          available_regs body ~avail_before:(ok avail_before)
+        in
+        (* CR-someday mshinwell: Consider potential efficiency speedups
+           (see suggestions from @chambart on GPR#856). *)
+        let aux (nfail, handler) (nfail', avail_at_top_of_handler) =
+          assert (nfail = nfail');
+          available_regs handler ~avail_before:avail_at_top_of_handler
+        in
+        let aux_equal (nfail, avail_before_handler)
+              (nfail', avail_before_handler') =
+          assert (nfail = nfail');
+          RAS.equal avail_before_handler avail_before_handler'
+        in
+        let rec fixpoint avail_at_top_of_handlers =
+          let avail_after_handlers =
+            List.map2 aux handlers avail_at_top_of_handlers
+          in
+          let avail_at_top_of_handlers' =
+            List.map (fun (nfail, _handler) ->
+                match Hashtbl.find avail_at_exit nfail with
+                | exception Not_found -> assert false  (* see above *)
+                | avail_at_top_of_handler -> nfail, avail_at_top_of_handler)
+              handlers
+          in
+          match recursive with
+          | Nonrecursive -> avail_after_handlers
+          | Recursive ->
+            if List.for_all2 aux_equal avail_at_top_of_handlers
+              avail_at_top_of_handlers'
+            then avail_after_handlers
+            else fixpoint avail_at_top_of_handlers'
+        in
+        let init_avail_at_top_of_handlers =
+          List.map (fun (nfail, _handler) ->
+              match Hashtbl.find avail_at_exit nfail with
+              | exception Not_found -> assert false  (* see above *)
+              | avail_at_top_of_handler -> nfail, avail_at_top_of_handler)
+            handlers
+        in
+        let avail_after_handlers = fixpoint init_avail_at_top_of_handlers in
+        List.iter (fun (nfail, _handler) ->
+            Hashtbl.remove avail_at_exit nfail)
+          handlers;
+        let avail_after =
+          List.fold_left (fun avail_at_join avail_after_handler ->
+              RAS.inter avail_at_join avail_after_handler)
+            avail_after_body
+            avail_after_handlers
+        in
+        None, avail_after
+      | Iexit nfail ->
+        let avail_before = ok avail_before in
+        let avail_at_top_of_handler =
+          match Hashtbl.find avail_at_exit nfail with
+          | exception Not_found ->  (* also see top of [Icatch] clause above *)
+            Misc.fatal_errorf "Iexit %d not in scope of Icatch" nfail
+          | avail_at_top_of_handler -> avail_at_top_of_handler
+        in
+        let avail_at_top_of_handler =
+          RAS.inter avail_at_top_of_handler avail_before
+        in
+        Hashtbl.replace avail_at_exit nfail avail_at_top_of_handler;
+        None, unreachable
+      | Itrywith (body, handler) ->
+        let saved_avail_at_raise = !avail_at_raise in
+        avail_at_raise := unreachable;
+        let avail_before = ok avail_before in
+        let after_body = available_regs body ~avail_before in
+        let avail_before_handler =
+          match !avail_at_raise with
+          | Unreachable -> unreachable
+          | Ok avail_at_raise ->
+            let without_exn_bucket =
+              RD.Set.filter_reg avail_at_raise Proc.loc_exn_bucket
+            in
+            let with_anonymous_exn_bucket =
+              RD.Set.add (RD.create_without_debug_info ~reg:Proc.loc_exn_bucket)
+                without_exn_bucket
+            in
+            ok with_anonymous_exn_bucket
+        in
+        avail_at_raise := saved_avail_at_raise;
+        let avail_after =
+          RAS.inter after_body
+            (available_regs handler ~avail_before:avail_before_handler)
+        in
+        None, avail_after
+      | Iraise _ ->
+        let avail_before = ok avail_before in
+        augment_availability_at_raise avail_before;
+        None, unreachable
+  in
+  instr.available_across <- avail_across;
+  match instr.desc with
+  | Iend -> avail_after
+  | _ -> available_regs instr.next ~avail_before:avail_after
+
+and join branches ~avail_before =
+  let avail_before = RAS.Ok avail_before in
+  let avails = List.map (available_regs ~avail_before) branches in
+  let avail_after =
+    match avails with
+    | [] -> avail_before
+    | avail::avails -> List.fold_left RAS.inter avail avails
+  in
+  None, avail_after
+
+let fundecl (f : M.fundecl) =
+  if !Clflags.debug && !Clflags.debug_runavail then begin
+    assert (Hashtbl.length avail_at_exit = 0);
+    avail_at_raise := RAS.Unreachable;
+    let fun_args = R.set_of_array f.fun_args in
+    let avail_before = RAS.Ok (RD.Set.without_debug_info fun_args) in
+    ignore ((available_regs f.fun_body ~avail_before) : RAS.t);
+  end;
+  f
diff --git a/asmcomp/debug/available_regs.mli b/asmcomp/debug/available_regs.mli
new file mode 100644
index 00000000..d065d388
--- /dev/null
+++ b/asmcomp/debug/available_regs.mli
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*            Mark Shinwell and Thomas Refis, Jane Street Europe          *)
+(*                                                                        *)
+(*   Copyright 2013--2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Available registers analysis used to determine which variables may be
+    shown in the debugger. *)
+
+val fundecl : Mach.fundecl -> Mach.fundecl
diff --git a/asmcomp/debug/compute_ranges.ml b/asmcomp/debug/compute_ranges.ml
new file mode 100644
index 00000000..7d40194d
--- /dev/null
+++ b/asmcomp/debug/compute_ranges.ml
@@ -0,0 +1,515 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                  Mark Shinwell, Jane Street Europe                     *)
+(*                                                                        *)
+(*   Copyright 2014--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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+open! Int_replace_polymorphic_compare
+
+module L = Linear
+
+module Make (S : Compute_ranges_intf.S_functor) = struct
+  module Subrange_state = S.Subrange_state
+  module Subrange_info = S.Subrange_info
+  module Range_info = S.Range_info
+
+  let rewrite_label env label =
+    match Numbers.Int.Map.find label env with
+    | exception Not_found -> label
+    | label -> label
+
+  module Subrange = struct
+    (* CR-soon mshinwell: Check that function epilogues, including returns
+       in the middle of functions, work ok in the debugger. *)
+    type t = {
+      start_pos : L.label;
+      start_pos_offset : int;
+      end_pos : L.label;
+      end_pos_offset : int;
+      subrange_info : Subrange_info.t;
+    }
+
+    let create ~(start_insn : L.instruction)
+          ~start_pos ~start_pos_offset
+          ~end_pos ~end_pos_offset
+          ~subrange_info =
+      match start_insn.desc with
+      | Llabel _ ->
+        { start_pos;
+          start_pos_offset;
+          end_pos;
+          end_pos_offset;
+          subrange_info;
+        }
+      | _ ->
+        Misc.fatal_errorf "Subrange.create: bad [start_insn]: %a"
+          Printlinear.instr start_insn
+
+    let start_pos t = t.start_pos
+    let start_pos_offset t = t.start_pos_offset
+    let end_pos t = t.end_pos
+    let end_pos_offset t = t.end_pos_offset
+    let info t = t.subrange_info
+
+    let rewrite_labels t ~env =
+      let start_pos = rewrite_label env t.start_pos in
+      let end_pos = rewrite_label env t.end_pos in
+      if start_pos = end_pos
+        && t.start_pos_offset = 0
+        && t.end_pos_offset = 0
+      then None
+      else
+        Some {
+          t with
+          start_pos;
+          end_pos;
+        }
+  end
+
+  module Range = struct
+    type t = {
+      mutable subranges : Subrange.t list;
+      mutable min_pos_and_offset : (L.label * int) option;
+      range_info : Range_info.t;
+    }
+
+    let create range_info =
+      { subranges = [];
+        min_pos_and_offset = None;
+        range_info;
+      }
+
+    let info t = t.range_info
+
+    let add_subrange t ~subrange =
+      let start_pos = Subrange.start_pos subrange in
+      let start_pos_offset = Subrange.start_pos_offset subrange in
+      begin match t.min_pos_and_offset with
+      | None -> t.min_pos_and_offset <- Some (start_pos, start_pos_offset)
+      | Some (min_pos, min_pos_offset) ->
+        (* This may seem dubious, but is correct by virtue of the way label
+           counters are allocated sequentially and the fact that, below,
+           we go through the code from lowest (code) address to highest.  As
+           such the label with the highest integer value should be the one with
+           the highest address, and vice-versa.  (Note that we also exploit the
+           ordering when constructing DWARF-4 location lists, to ensure that
+           they are sorted in increasing program counter order by start
+           address.) *)
+        let c = compare start_pos min_pos in
+        if c < 0
+          || (c = 0 && start_pos_offset < min_pos_offset)
+        then begin
+          t.min_pos_and_offset <- Some (start_pos, start_pos_offset)
+        end
+      end;
+      t.subranges <- subrange::t.subranges
+
+    let estimate_lowest_address t =
+      (* See assumption described in compute_ranges_intf.ml. *)
+      t.min_pos_and_offset
+
+    let fold t ~init ~f =
+      List.fold_left f init t.subranges
+
+    let no_subranges t =
+      match t.subranges with
+      | [] -> true
+      | _ -> false
+
+    let rewrite_labels_and_remove_empty_subranges t ~env =
+      let subranges =
+        List.filter_map (fun subrange ->
+            Subrange.rewrite_labels subrange ~env)
+          t.subranges
+      in
+      match subranges with
+      | [] ->
+        { t with
+          subranges;
+          min_pos_and_offset = None;
+        }
+      | subranges ->
+        let min_pos_and_offset =
+          Option.map
+            (fun (label, offset) -> rewrite_label env label, offset)
+            t.min_pos_and_offset
+        in
+        { t with
+          subranges;
+          min_pos_and_offset;
+        }
+  end
+
+  type t = {
+    ranges : Range.t S.Index.Tbl.t;
+  }
+
+  module KM = S.Key.Map
+  module KS = S.Key.Set
+
+  (* Whilst this pass is not DWARF-specific, the output of this pass uses
+     the conventions of the DWARF specification (e.g. DWARF-4 spec.
+     section 2.6.2, page 30) in the sense that starting addresses of ranges
+     are treated as inclusive and ending addresses as exclusive.
+
+     Imagine that, for a given [key], the program counter (PC) is exactly at the
+     start of [insn]; that instruction has not yet been executed.  Assume
+     a immediately-previous instruction exists called [prev_insn].  Intuitively,
+     this function calculates which available subranges are to start and stop at
+     that point, but these notions are subtle.
+
+     There are eight cases, referenced in the code below.
+
+     1. First four cases: [key] is currently unavailable, i.e. it is not a
+     member of (roughly speaking) [S.available_across prev_insn].
+
+     (a) [key] is not in [S.available_before insn] and neither is it in
+         [S.available_across insn].  There is nothing to do.
+
+     (b) [key] is not in [S.available_before insn] but it is in
+         [S.available_across insn].  A new range is created with the starting
+         position being one byte after the first machine instruction of [insn]
+         and left open.
+
+         It might seem like this case 1 (b) is impossible, likewise for 2 (b)
+         below, since "available across" should always be a subset of
+         "available before".  However this does not hold in general: see the
+         comment in available_ranges_vars.ml.
+
+     (c) [key] is in [S.available_before insn] but it is not in
+         [S.available_across insn].  A new range is created with the starting
+         position being the first machine instruction of [insn] and the ending
+         position being the next machine address after that.
+
+     (d) [key] is in [S.available_before insn] and it is also in
+         [S.available_across insn]. A new range is created with the starting
+         position being the first machine instruction of [insn] and left open.
+
+     2. Second four cases: [key] is already available, i.e. a member of
+     [S.available_across prev_insn].
+
+     (a) [key] is not in [S.available_before insn] and neither is it in
+         [S.available_across insn].  The range endpoint is given as the address
+         of the first machine instruction of [insn].  Since endpoint bounds are
+         exclusive (see above) then [key] will not be shown as available when
+         the debugger is standing on [insn].
+
+     (b) [key] is not in [S.available_before insn] but it is in
+         [S.available_across insn].  The range endpoint is given as the address
+         of the first machine instruction of [insn]; and a new range is opened
+         in the same way as for case 1 (b), above.
+
+     (c) [key] is in [S.available_before insn] but it is not in
+         [S.available_across insn]. This will only happen when calculating
+         variables' available ranges for operation (i.e. [Lop]) instructions
+         (for example calls or allocations). To give a good user experience it
+         is necessary to show availability when the debugger is standing on the
+         very first instruction of the operation but not thereafter. As such we
+         terminate the range one byte beyond the first machine instruction of
+         [insn].
+
+     (d) [key] is in [S.available_before insn] and it is also in
+         it is in [S.available_across insn].  The existing range remains open.
+  *)
+
+  type action =
+    | Open_one_byte_subrange
+    | Open_subrange
+    | Open_subrange_one_byte_after
+    | Close_subrange
+    | Close_subrange_one_byte_after
+
+  (* CR mshinwell: Move to [Clflags] *)
+  let check_invariants = ref true
+
+  let actions_at_instruction ~(insn : L.instruction)
+        ~(prev_insn : L.instruction option) =
+    let available_before = S.available_before insn in
+    let available_across = S.available_across insn in
+    let opt_available_across_prev_insn =
+      match prev_insn with
+      | None -> KS.empty
+      | Some prev_insn -> S.available_across prev_insn
+    in
+    let case_1b =
+      KS.diff available_across
+        (KS.union opt_available_across_prev_insn available_before)
+    in
+    let case_1c =
+      KS.diff available_before
+        (KS.union opt_available_across_prev_insn available_across)
+    in
+    let case_1d =
+      KS.diff (KS.inter available_before available_across)
+        opt_available_across_prev_insn
+    in
+    let case_2a =
+      KS.diff opt_available_across_prev_insn
+        (KS.union available_before available_across)
+    in
+    let case_2b =
+      KS.inter opt_available_across_prev_insn
+        (KS.diff available_across available_before)
+    in
+    let case_2c =
+      KS.diff
+        (KS.inter opt_available_across_prev_insn available_before)
+        available_across
+    in
+    let handle case action result =
+      (* We use [K.all_parents] here to circumvent a potential performance
+         problem.  In the case of lexical blocks, there may be long chains
+         of blocks and their parents, yet the innermost block determines the
+         rest of the chain.  As such [S] (which comes from
+         lexical_block_ranges.ml) only needs to use the innermost blocks in
+         the "available before" sets, keeping things fast---but we still
+         populate ranges for all parent blocks, thus avoiding any
+         post-processing, by using [K.all_parents] here. *)
+      KS.fold (fun key result ->
+          List.fold_left (fun result key ->
+              (key, action) :: result)
+            result
+            (key :: (S.Key.all_parents key)))
+        case
+        result
+    in
+    let actions =
+      (* Ranges must be closed before they are opened---otherwise, when a
+         variable moves between registers at a range boundary, we might end up
+         with no open range for that variable.  Note that the pipeline below
+         constructs the [actions] list in reverse order---later functions in
+         the pipeline produce actions nearer the head of the list. *)
+      []
+      |> handle case_1b Open_subrange_one_byte_after
+      |> handle case_1c Open_one_byte_subrange
+      |> handle case_1d Open_subrange
+      |> handle case_2a Close_subrange
+      |> handle case_2b Open_subrange_one_byte_after
+      |> handle case_2b Close_subrange
+      |> handle case_2c Close_subrange_one_byte_after
+    in
+    let must_restart =
+      if S.must_restart_ranges_upon_any_change ()
+         && match actions with
+            | [] -> false
+            | _::_ -> true
+      then
+        KS.inter opt_available_across_prev_insn available_before
+      else
+        KS.empty
+    in
+    actions, must_restart
+
+  let rec process_instruction t (fundecl : L.fundecl)
+        ~(first_insn : L.instruction) ~(insn : L.instruction)
+        ~(prev_insn : L.instruction option)
+        ~currently_open_subranges ~subrange_state =
+    let used_label = ref None in
+    let get_label () =
+      match !used_label with
+      | Some label_and_insn -> label_and_insn
+      | None ->
+        (* Note that we can't reuse an existing label in the code since we rely
+           on the ordering of range-related labels. *)
+        let label = Cmm.new_label () in
+        let label_insn : L.instruction =
+          { desc = Llabel label;
+            next = insn;
+            arg = [| |];
+            res = [| |];
+            dbg = insn.dbg;
+            live = insn.live;
+          }
+        in
+        used_label := Some (label, label_insn);
+        label, label_insn
+    in
+    let open_subrange key ~start_pos_offset ~currently_open_subranges =
+      (* If the range is later discarded, the inserted label may actually be
+         useless, but this doesn't matter.  It does not generate any code. *)
+      let label, label_insn = get_label () in
+      KM.add key (label, start_pos_offset, label_insn) currently_open_subranges
+    in
+    let close_subrange key ~end_pos_offset ~currently_open_subranges =
+      match KM.find key currently_open_subranges with
+      | exception Not_found ->
+        Misc.fatal_errorf "No subrange is open for key %a"
+          S.Key.print key
+      | start_pos, start_pos_offset, start_insn ->
+        let currently_open_subranges = KM.remove key currently_open_subranges in
+        match Range_info.create fundecl key ~start_insn with
+        | None -> currently_open_subranges
+        | Some (index, range_info) ->
+          let range =
+            match S.Index.Tbl.find t.ranges index with
+            | range -> range
+            | exception Not_found ->
+              let range = Range.create range_info in
+              S.Index.Tbl.add t.ranges index range;
+              range
+          in
+          let label, _label_insn = get_label () in
+          let subrange_info = Subrange_info.create key subrange_state in
+          let subrange =
+            Subrange.create ~start_insn
+              ~start_pos ~start_pos_offset
+              ~end_pos:label ~end_pos_offset
+              ~subrange_info
+          in
+          Range.add_subrange range ~subrange;
+          currently_open_subranges
+    in
+    let actions, must_restart = actions_at_instruction ~insn ~prev_insn in
+    (* Restart ranges if needed *)
+    let currently_open_subranges =
+      KS.fold (fun key currently_open_subranges ->
+          let currently_open_subranges =
+            close_subrange key ~end_pos_offset:0 ~currently_open_subranges
+          in
+          open_subrange key ~start_pos_offset:0 ~currently_open_subranges)
+        must_restart
+        currently_open_subranges
+    in
+    (* Apply actions *)
+    let currently_open_subranges =
+      List.fold_left (fun currently_open_subranges (key, (action : action)) ->
+          match action with
+          | Open_one_byte_subrange ->
+            let currently_open_subranges =
+              open_subrange key ~start_pos_offset:0 ~currently_open_subranges
+            in
+            close_subrange key ~end_pos_offset:1 ~currently_open_subranges
+          | Open_subrange ->
+            open_subrange key ~start_pos_offset:0 ~currently_open_subranges
+          | Open_subrange_one_byte_after ->
+            open_subrange key ~start_pos_offset:1 ~currently_open_subranges
+          | Close_subrange ->
+            close_subrange key ~end_pos_offset:0 ~currently_open_subranges
+          | Close_subrange_one_byte_after ->
+            close_subrange key ~end_pos_offset:1 ~currently_open_subranges)
+        currently_open_subranges
+        actions
+    in
+    (* Close all subranges if at last instruction *)
+    let currently_open_subranges =
+      match insn.desc with
+      | Lend ->
+        let currently_open_subranges =
+          KM.fold (fun key _ currently_open_subranges ->
+              close_subrange key ~end_pos_offset:0 ~currently_open_subranges)
+            currently_open_subranges
+            currently_open_subranges
+        in
+        assert (KM.is_empty currently_open_subranges);
+        currently_open_subranges
+      | _ -> currently_open_subranges
+    in
+    let first_insn =
+      match !used_label with
+      | None -> first_insn
+      | Some (_label, label_insn) ->
+        assert (label_insn.L.next == insn);
+        (* (Note that by virtue of [Lprologue], we can insert labels prior to
+           the first assembly instruction of the function.) *)
+        begin match prev_insn with
+        | None ->
+          (* The label becomes the new first instruction. *)
+          label_insn
+        | Some prev_insn ->
+          assert (prev_insn.L.next == insn);
+          prev_insn.next <- label_insn;
+          first_insn
+        end
+    in
+    if !check_invariants then begin
+      let currently_open_subranges =
+        KS.of_list (
+          List.map (fun (key, _datum) -> key)
+            (KM.bindings currently_open_subranges))
+      in
+      let should_be_open = S.available_across insn in
+      let not_open_but_should_be =
+        KS.diff should_be_open currently_open_subranges
+      in
+      if not (KS.is_empty not_open_but_should_be) then begin
+        Misc.fatal_errorf "%s: ranges for %a are not open across the following \
+            instruction:\n%a\navailable_across:@ %a\n\
+            currently_open_subranges: %a"
+          fundecl.fun_name
+          KS.print not_open_but_should_be
+          Printlinear.instr { insn with L.next = L.end_instr; }
+          KS.print should_be_open
+          KS.print currently_open_subranges
+      end
+    end;
+    match insn.desc with
+    | Lend -> first_insn
+    | Lprologue | Lop _ | Lreloadretaddr | Lreturn | Llabel _
+    | Lbranch _ | Lcondbranch _ | Lcondbranch3 _ | Lswitch _
+    | Lentertrap | Lpushtrap _ | Lpoptrap | Ladjust_trap_depth _
+    | Lraise _ ->
+      let subrange_state =
+        Subrange_state.advance_over_instruction subrange_state insn
+      in
+      process_instruction t fundecl ~first_insn ~insn:insn.next
+        ~prev_insn:(Some insn) ~currently_open_subranges ~subrange_state
+
+  let process_instructions t fundecl ~first_insn =
+    let subrange_state = Subrange_state.create () in
+    process_instruction t fundecl ~first_insn ~insn:first_insn
+      ~prev_insn:None ~currently_open_subranges:KM.empty ~subrange_state
+
+  let all_indexes t =
+    S.Index.Set.of_list (List.map fst (S.Index.Tbl.to_list t.ranges))
+
+  let empty =
+    { ranges = S.Index.Tbl.create 1;
+    }
+
+  let create (fundecl : L.fundecl) =
+    let t =
+      { ranges = S.Index.Tbl.create 42;
+      }
+    in
+    let first_insn =
+      process_instructions t fundecl ~first_insn:fundecl.fun_body
+    in
+    let fundecl : L.fundecl =
+      { fundecl with fun_body = first_insn; }
+    in
+    t, fundecl
+
+  let iter t ~f =
+    S.Index.Tbl.iter (fun index range -> f index range)
+      t.ranges
+
+  let fold t ~init ~f =
+    S.Index.Tbl.fold (fun index range acc -> f acc index range)
+      t.ranges
+      init
+
+  let find t index = S.Index.Tbl.find t.ranges index
+
+  let rewrite_labels_and_remove_empty_subranges_and_ranges t ~env =
+    let ranges = S.Index.Tbl.create 42 in
+    S.Index.Tbl.iter (fun index range ->
+        let range =
+          Range.rewrite_labels_and_remove_empty_subranges range ~env
+        in
+        if not (Range.no_subranges range) then begin
+          S.Index.Tbl.add ranges index range
+        end)
+      t.ranges;
+    { ranges;
+    }
+end
diff --git a/asmcomp/debug/compute_ranges.mli b/asmcomp/debug/compute_ranges.mli
new file mode 100644
index 00000000..695529f3
--- /dev/null
+++ b/asmcomp/debug/compute_ranges.mli
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                  Mark Shinwell, Jane Street Europe                     *)
+(*                                                                        *)
+(*   Copyright 2014--2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Coalescing of per-instruction information into possibly-discontiguous
+    regions of code delimited by labels.  This is used for collating
+    register availability and lexical block scoping information into a
+    concise form. *)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+module Make (S : Compute_ranges_intf.S_functor)
+  : Compute_ranges_intf.S
+      with module Index := S.Index
+      with module Key := S.Key
+      with module Subrange_state := S.Subrange_state
+      with module Subrange_info := S.Subrange_info
+      with module Range_info := S.Range_info
diff --git a/asmcomp/debug/compute_ranges_intf.ml b/asmcomp/debug/compute_ranges_intf.ml
new file mode 100644
index 00000000..1fb4bdb6
--- /dev/null
+++ b/asmcomp/debug/compute_ranges_intf.ml
@@ -0,0 +1,274 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                  Mark Shinwell, Jane Street Europe                     *)
+(*                                                                        *)
+(*   Copyright 2014--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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+(** This file defines types that are used to specify the interface of
+    [Compute_ranges].  The description of [Compute_ranges] is:
+
+      "Coalescing of per-instruction information into possibly-discontiguous
+       regions of code delimited by labels. This is used for collating register
+       availability and lexical block scoping information into a concise form."
+
+    [Compute_ranges] defines a functor, whose argument has type [S_functor], and
+    whose result has type [S]. Both [S_functor] and [S] are defined here.
+
+    It is suggested that those unfamiliar with this module start by reading
+    the documentation on module type [S], below.
+*)
+
+module L = Linear
+
+(** The type of caller-defined contextual state associated with subranges.
+    This may be used to track information throughout the range-computing
+    process. *)
+module type S_subrange_state = sig
+  type t
+
+  val create : unit -> t
+  val advance_over_instruction : t -> L.instruction -> t
+end
+
+(** The type of caller-defined information associated with subranges. *)
+module type S_subrange_info = sig
+  type t
+  type key
+  type subrange_state
+
+  val create : key -> subrange_state -> t
+end
+
+(** The type of caller-defined information associated with ranges. *)
+module type S_range_info = sig
+  type t
+  type key
+  type index
+
+  val create
+     : L.fundecl
+    -> key
+    -> start_insn:L.instruction
+    -> (index * t) option
+end
+
+(** This module type specifies what the caller has to provide in order to
+    instantiate a module to compute ranges. *)
+module type S_functor = sig
+  (** The module [Index] is used to filter and group the generated subranges.
+      Inclusion of a computed subrange in the result is conditional upon the
+      existence of an index that can be associated to it. To give a concrete
+      example, the keys associated to ranges might be pseudoregisters, and the
+      indexes variable names (c.f. [Available_ranges_vars]). Every register that
+      is not known to hold the value of some variable is dropped from the
+      result.
+
+      As the name suggests, values of type [Index.t] also serve as indices for
+      accessing ranges in the result. The result may actually contain no
+      reference to keys (only [Subrange_info.t] may reliably contain it), and
+      subranges with different keys will be coalesced into a single range if all
+      their keys are associated to the same index. *)
+  module Index : Identifiable.S
+
+  (** The module [Key] corresponds to the identifiers that define the ranges in
+      [Linear] instructions. Each instruction should have two sets of keys,
+      [available_before] and [available_across], with accessor functions of
+      these names being provided to retrieve them. The notion of "availability"
+      is not prescribed. The availability sets are used to compute subranges
+      associated to each key. *)
+  module Key : sig
+    (** The type of identifiers that define ranges. *)
+    type t
+
+    module Set : sig
+      include Set.S with type elt = t
+      val print : Format.formatter -> t -> unit
+    end
+
+    module Map : Map.S with type key = t
+
+    (** Print a representation (typically sexp) of the given key to the given
+        formatter. *)
+    val print : Format.formatter -> t -> unit
+
+    (** In some situations, for performance reasons, an "available" set may only
+        contain a subset of all keys that need to be tracked. For example, when
+        using a notion of availability that describes which lexical block a
+        given instruction lies in, using a standard notion of nested lexical
+        blocks, the innermost lexical block uniquely determines the chain of its
+        parents. (This is exploited in [Lexical_block_ranges].) The
+        [all_parents] function must return, given an "available" [key], all
+        those other keys that are also available and uniquely determined by
+        [key]. *)
+    val all_parents : t -> t list
+  end
+
+  (** The module [Range_info] is used to store additional information on a range
+      that is associated to a range at its creation and can be retrieved from
+      the result. The association between keys and indices is also done here:
+      [Range_info.create] serves both as a map between keys and indices; and
+      also as the creator of the [Range_info.t] structure. When several
+      subranges are contained in a single range, the associated [Range_info.t]
+      will correspond to the first closed subrange. *)
+  module Range_info : S_range_info
+    with type key := Key.t
+    with type index := Index.t
+
+  (** The module [Subrange_state] describes information that needs to be
+      propagated and passed to [Subrange_info.create]. The state that will be
+      used for subrange creation is the state at the end of the subrange, not at
+      the beginning. *)
+  module Subrange_state : S_subrange_state
+
+  (** The module [Subrange_info] has a similar purpose to [Range_info], but for
+      subranges. Its distinguishing property is that it can store information
+      about its context using the additional [subrange_state] parameter of its
+      [create] function. *)
+  module Subrange_info : S_subrange_info
+    with type key := Key.t
+    with type subrange_state := Subrange_state.t
+
+  (** How to retrieve from an instruction those keys that are available
+      immediately before the instruction starts executing. *)
+  val available_before : L.instruction -> Key.Set.t
+
+  (** How to retrieve from an instruction those keys that are available
+      between the points at which the instruction reads its arguments and
+      writes its results. *)
+  val available_across : L.instruction -> Key.Set.t
+
+  (** This [must_restart_ranges_upon_any_change] boolean exists because some
+      consumers of the range information may require that two subranges are
+      disjoint rather than including one in another. When this function returns
+      [true], whenever a subrange is opened or closed, all other overlapping
+      subranges will be split in two at the same point. *)
+  val must_restart_ranges_upon_any_change : unit -> bool
+end
+
+(** This module type is the result type of the [Compute_ranges.Make] functor.
+
+    The _ranges_ being computed are composed of contiguous _subranges_ delimited
+    by two labels (of type [Linear.label]). These labels will be added by
+    this pass to the code being inspected, which is why the [create] function in
+    the result of the functor returns not only the ranges but also the updated
+    function with the labels added. The [start_pos_offset] and [end_pos_offset]
+    components of the subranges are there to allow a distinction between ranges
+    starting (or ending) right at the start of the corresponding instruction
+    (offset of zero), and ranges starting or ending one byte after the actual
+    instruction (offset of one). *)
+module type S = sig
+  (** Corresponds to [Index] in the [S_functor] module type. *)
+  module Index : Identifiable.S
+
+  (** Corresponds to [Key] in the [S_functor] module type. *)
+  module Key : sig
+    type t
+    module Set : Set.S with type elt = t
+    module Map : Map.S with type key = t
+  end
+
+  (** Corresponds to [Subrange_state] in the [S_functor] module type. *)
+  module Subrange_state : S_subrange_state
+
+  (** Corresponds to [Subrange_info] in the [S_functor] module type. *)
+  module Subrange_info : S_subrange_info
+    with type key := Key.t
+    with type subrange_state := Subrange_state.t
+
+  (** Corresponds to [Range_info] in the [S_functor] module type. *)
+  module Range_info : S_range_info
+    with type key := Key.t
+    with type index := Index.t
+
+  module Subrange : sig
+    (** The type of subranges.  Each subrange is a contiguous region of
+        code delimited by labels. *)
+    type t
+
+    (** The caller's information about the subrange. *)
+    val info : t -> Subrange_info.t
+
+    (** The label at the start of the range. *)
+    val start_pos : t -> Linear.label
+
+    (** How many bytes from the label at [start_pos] the range actually
+        commences.  If this value is zero, then the first byte of the range
+        has the address of the label given by [start_pos]. *)
+    val start_pos_offset : t -> int
+
+    (** The label at the end of the range. *)
+    val end_pos : t -> Linear.label
+
+    (** Like [start_pos_offset], but analogously for the end of the range. (The
+        sense is not inverted; a positive [end_pos_offset] means the range ends
+        at an address higher than the address of the [end_pos], just like a
+        positive [start_pos_offset] means the range starts at an address higher
+        than the [start_pos]. *)
+    val end_pos_offset : t -> int
+  end
+
+  module Range : sig
+    (** The type of ranges.  Each range is a list of subranges, so a
+        possibly-discontiguous region of code. *)
+    type t
+
+    (** The caller's information about the range. *)
+    val info : t -> Range_info.t
+
+    (** Estimate the pair of ([start_pos], [start_pos_offset]) (c.f. [Subrange],
+        above) found amongst the given ranges that yields the lowest machine
+        address. The assumption is made that no [start_pos_offset] or
+        [end_pos_offset] will cause the corresponding extremity of a range to
+        cross an extremity of any other range. (This should be satisfied in
+        typical uses because the offsets are typically zero or one.) If there
+        are no ranges supplied then [None] is returned. *)
+    val estimate_lowest_address : t -> (Linear.label * int) option
+
+    (** Fold over all subranges within the given range. *)
+    val fold
+       : t
+      -> init:'a
+      -> f:('a -> Subrange.t -> 'a)
+      -> 'a
+  end
+
+  (** The type holding information on computed ranges. *)
+  type t
+
+  (** A value of type [t] that holds no range information. *)
+  val empty : t
+
+  (** Compute ranges for the code in the given linearized function
+      declaration, returning the ranges as a value of type [t] and the
+      rewritten code that must go forward for emission. *)
+  val create : Linear.fundecl -> t * Linear.fundecl
+
+  (** Iterate through ranges.  Each range is associated with an index. *)
+  val iter : t -> f:(Index.t -> Range.t -> unit) -> unit
+
+  (** Like [iter], but a fold. *)
+  val fold : t -> init:'a -> f:('a -> Index.t -> Range.t -> 'a) -> 'a
+
+  (** Find the range for the given index, or raise an exception. *)
+  val find : t -> Index.t -> Range.t
+
+  (** All indexes for which the given value of type [t] contains ranges. *)
+  val all_indexes : t -> Index.Set.t
+
+  (** An internal function used by [Coalesce_labels].
+      The [env] should come from [Coalesce_labels.fundecl]. *)
+  val rewrite_labels_and_remove_empty_subranges_and_ranges
+     : t
+    -> env:int Numbers.Int.Map.t
+    -> t
+end
diff --git a/asmcomp/debug/reg_availability_set.ml b/asmcomp/debug/reg_availability_set.ml
new file mode 100644
index 00000000..fbff598d
--- /dev/null
+++ b/asmcomp/debug/reg_availability_set.ml
@@ -0,0 +1,111 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                  Mark Shinwell, Jane Street Europe                     *)
+(*                                                                        *)
+(*   Copyright 2016--2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+module RD = Reg_with_debug_info
+module V = Backend_var
+
+type t =
+  | Ok of RD.Set.t
+  | Unreachable
+
+let inter regs1 regs2 =
+  match regs1, regs2 with
+  | Unreachable, _ -> regs2
+  | _, Unreachable -> regs1
+  | Ok avail1, Ok avail2 ->
+    let result =
+      RD.Set.fold (fun reg1 result ->
+          match RD.Set.find_reg_exn avail2 (RD.reg reg1) with
+          | exception Not_found -> result
+          | reg2 ->
+            let debug_info1 = RD.debug_info reg1 in
+            let debug_info2 = RD.debug_info reg2 in
+            let debug_info =
+              match debug_info1, debug_info2 with
+              | None, None -> None
+              (* Example for this next case: the value of a mutable variable x
+                 is copied into another variable y; then there is a conditional
+                 where on one branch x is assigned and on the other branch it
+                 is not.  This means that on the former branch we have
+                 forgotten about y holding the value of x; but we have not on
+                 the latter.  At the join point we must have forgotten the
+                 information. *)
+              | None, Some _ | Some _, None -> None
+              | Some debug_info1, Some debug_info2 ->
+                if RD.Debug_info.compare debug_info1 debug_info2 = 0 then
+                  Some debug_info1
+                else
+                  None
+            in
+            let reg =
+              RD.create_with_debug_info ~reg:(RD.reg reg1)
+                ~debug_info
+            in
+            RD.Set.add reg result)
+        avail1
+        RD.Set.empty
+    in
+    Ok result
+
+let equal t1 t2 =
+  match t1, t2 with
+  | Unreachable, Unreachable -> true
+  | Unreachable, Ok _ | Ok _, Unreachable -> false
+  | Ok regs1, Ok regs2 -> RD.Set.equal regs1 regs2
+
+let canonicalise availability =
+  match availability with
+  | Unreachable -> Unreachable
+  | Ok availability ->
+    let regs_by_ident = V.Tbl.create 42 in
+    RD.Set.iter (fun reg ->
+        match RD.debug_info reg with
+        | None -> ()
+        | Some debug_info ->
+          let name = RD.Debug_info.holds_value_of debug_info in
+          if not (V.persistent name) then begin
+            match V.Tbl.find regs_by_ident name with
+            | exception Not_found -> V.Tbl.add regs_by_ident name reg
+            | (reg' : RD.t) ->
+              (* We prefer registers that are assigned to the stack since
+                 they probably give longer available ranges (less likely to
+                 be clobbered). *)
+              match RD.location reg, RD.location reg' with
+              | Reg _, Stack _
+              | Reg _, Reg _
+              | Stack _, Stack _
+              | _, Unknown
+              | Unknown, _ -> ()
+              | Stack _, Reg _ ->
+                V.Tbl.remove regs_by_ident name;
+                V.Tbl.add regs_by_ident name reg
+          end)
+      availability;
+    let result =
+      V.Tbl.fold (fun _ident reg availability ->
+          RD.Set.add reg availability)
+        regs_by_ident
+        RD.Set.empty
+    in
+    Ok result
+
+let print ~print_reg ppf = function
+  | Unreachable -> Format.fprintf ppf ""
+  | Ok availability ->
+    Format.fprintf ppf "{%a}"
+      (Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ")
+        (Reg_with_debug_info.print ~print_reg))
+      (RD.Set.elements availability)
diff --git a/asmcomp/debug/reg_availability_set.mli b/asmcomp/debug/reg_availability_set.mli
new file mode 100644
index 00000000..ba24a02f
--- /dev/null
+++ b/asmcomp/debug/reg_availability_set.mli
@@ -0,0 +1,37 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                  Mark Shinwell, Jane Street Europe                     *)
+(*                                                                        *)
+(*   Copyright 2016--2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Register availability sets. *)
+
+type t =
+  | Ok of Reg_with_debug_info.Set.t
+  | Unreachable
+
+val inter : t -> t -> t
+(** Intersection of availabilities. *)
+
+val canonicalise : t -> t
+(** Return a subset of the given availability set which contains no registers
+    that are not associated with debug info (and holding values of
+    non-persistent identifiers); and where no two registers share the same
+    location. *)
+
+val equal : t -> t -> bool
+
+val print
+   : print_reg:(Format.formatter -> Reg.t -> unit)
+  -> Format.formatter
+  -> t
+  -> unit
+(** For debugging purposes only. *)
diff --git a/asmcomp/debug/reg_with_debug_info.ml b/asmcomp/debug/reg_with_debug_info.ml
new file mode 100644
index 00000000..3dd0ce0c
--- /dev/null
+++ b/asmcomp/debug/reg_with_debug_info.ml
@@ -0,0 +1,200 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                  Mark Shinwell, Jane Street Europe                     *)
+(*                                                                        *)
+(*   Copyright 2016--2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+module V = Backend_var
+
+module Debug_info = struct
+  type t = {
+    holds_value_of : V.t;
+    part_of_value : int;
+    num_parts_of_value : int;
+    which_parameter : int option;
+    provenance : unit option;
+  }
+
+  let compare t1 t2 =
+    let c = V.compare t1.holds_value_of t2.holds_value_of in
+    if c <> 0 then c
+    else
+      Stdlib.compare
+        (t1.part_of_value, t1.num_parts_of_value, t1.which_parameter)
+        (t2.part_of_value, t2.num_parts_of_value, t2.which_parameter)
+
+  let holds_value_of t = t.holds_value_of
+  let part_of_value t = t.part_of_value
+  let num_parts_of_value t = t.num_parts_of_value
+  let which_parameter t = t.which_parameter
+  let provenance t = t.provenance
+
+  let print ppf t =
+    Format.fprintf ppf "%a" V.print t.holds_value_of;
+    if not (t.part_of_value = 0 && t.num_parts_of_value = 1) then begin
+      Format.fprintf ppf "(%d/%d)" t.part_of_value t.num_parts_of_value
+    end;
+    begin match t.which_parameter with
+    | None -> ()
+    | Some index -> Format.fprintf ppf "[P%d]" index
+    end
+end
+
+module T = struct
+  type t = {
+    reg : Reg.t;
+    debug_info : Debug_info.t option;
+  }
+
+  module Order = struct
+    type t = Reg.t
+    let compare (t1 : t) (t2 : t) = t1.stamp - t2.stamp
+  end
+
+  let compare t1 t2 =
+    Order.compare t1.reg t2.reg
+end
+
+include T
+
+type reg_with_debug_info = t
+
+let create ~reg ~holds_value_of ~part_of_value ~num_parts_of_value
+      ~which_parameter ~provenance =
+  assert (num_parts_of_value >= 1);
+  assert (part_of_value >= 0 && part_of_value < num_parts_of_value);
+  assert (match which_parameter with None -> true | Some index -> index >= 0);
+  let debug_info : Debug_info.t =
+    { holds_value_of;
+      part_of_value;
+      num_parts_of_value;
+      which_parameter;
+      provenance;
+    }
+  in
+  { reg;
+    debug_info = Some debug_info;
+  }
+
+let create_with_debug_info ~reg ~debug_info =
+  { reg;
+    debug_info;
+  }
+
+let create_without_debug_info ~reg =
+  { reg;
+    debug_info = None;
+  }
+
+let create_copying_debug_info ~reg ~debug_info_from =
+  { reg;
+    debug_info = debug_info_from.debug_info;
+  }
+
+let reg t = t.reg
+let location t = t.reg.loc
+
+let holds_pointer t =
+  match t.reg.typ with
+  | Addr | Val -> true
+  | Int | Float -> false
+
+let holds_non_pointer t = not (holds_pointer t)
+
+let assigned_to_stack t =
+  match t.reg.loc with
+  | Stack _ -> true
+  | Reg _ | Unknown -> false
+
+let regs_at_same_location (reg1 : Reg.t) (reg2 : Reg.t) ~register_class =
+  (* We need to check the register classes too: two locations both saying
+     "stack offset N" might actually be different physical locations, for
+     example if one is of class "Int" and another "Float" on amd64.
+     [register_class] will be [Proc.register_class], but cannot be here,
+     due to a circular dependency. *)
+  reg1.loc = reg2.loc
+    && register_class reg1 = register_class reg2
+
+let at_same_location t (reg : Reg.t) ~register_class =
+  regs_at_same_location t.reg reg ~register_class
+
+let debug_info t = t.debug_info
+
+let clear_debug_info t =
+  { t with debug_info = None; }
+
+module Order_distinguishing_names_and_locations = struct
+  type nonrec t = t
+
+  let compare t1 t2 =
+    match t1.debug_info, t2.debug_info with
+    | None, None -> 0
+    | None, Some _ -> -1
+    | Some _, None -> 1
+    | Some di1, Some di2 ->
+      let c = V.compare di1.holds_value_of di2.holds_value_of in
+      if c <> 0 then c
+      else Stdlib.compare t1.reg.loc t2.reg.loc
+end
+
+module Set_distinguishing_names_and_locations =
+  Set.Make (Order_distinguishing_names_and_locations)
+
+module Map_distinguishing_names_and_locations =
+  Map.Make (Order_distinguishing_names_and_locations)
+
+module Set = struct
+  include Set.Make (T)
+
+  let of_array elts =
+    of_list (Array.to_list elts)
+
+  let forget_debug_info t =
+    fold (fun t acc -> Reg.Set.add (reg t) acc) t Reg.Set.empty
+
+  let without_debug_info regs =
+    Reg.Set.fold (fun reg acc -> add (create_without_debug_info ~reg) acc)
+      regs
+      empty
+
+  let made_unavailable_by_clobber t ~regs_clobbered ~register_class =
+    Reg.Set.fold (fun reg acc ->
+        let made_unavailable =
+          filter (fun reg' ->
+              regs_at_same_location reg'.reg reg ~register_class)
+            t
+        in
+        union made_unavailable acc)
+      (Reg.set_of_array regs_clobbered)
+      (* ~init:*)empty
+
+  let mem_reg t (reg : Reg.t) =
+    exists (fun t -> t.reg.stamp = reg.stamp) t
+
+  let filter_reg t (reg : Reg.t) =
+    filter (fun t -> t.reg.stamp <> reg.stamp) t
+
+  (* CR-someday mshinwell: Well, it looks like we should have used a map.
+     mshinwell: Also see @chambart's suggestion on GPR#856. *)
+  let find_reg_exn t (reg : Reg.t) =
+    match elements (filter (fun t -> t.reg.stamp = reg.stamp) t) with
+    | [] -> raise Not_found
+    | [reg] -> reg
+    | _ -> assert false
+end
+
+let print ~print_reg ppf t =
+  match t.debug_info with
+  | None -> Format.fprintf ppf "%a" print_reg t.reg
+  | Some debug_info ->
+    Format.fprintf ppf "%a(%a)" print_reg t.reg Debug_info.print debug_info
diff --git a/asmcomp/debug/reg_with_debug_info.mli b/asmcomp/debug/reg_with_debug_info.mli
new file mode 100644
index 00000000..b989bdeb
--- /dev/null
+++ b/asmcomp/debug/reg_with_debug_info.mli
@@ -0,0 +1,112 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                  Mark Shinwell, Jane Street Europe                     *)
+(*                                                                        *)
+(*   Copyright 2016--2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Registers equipped with information used for generating debugging
+    information. *)
+
+module Debug_info : sig
+  type t
+
+  val compare : t -> t -> int
+
+  val holds_value_of : t -> Backend_var.t
+  (** The identifier that the register holds (part of) the value of. *)
+
+  val part_of_value : t -> int
+  val num_parts_of_value : t -> int
+
+  val which_parameter : t -> int option
+  (** If the register corresponds to a function parameter, the value returned
+      is the zero-based index of said parameter; otherwise it is [None]. *)
+
+  val provenance : t -> unit option
+end
+
+type t
+
+type reg_with_debug_info = t
+
+val create
+   : reg:Reg.t
+  -> holds_value_of:Backend_var.t
+  -> part_of_value:int
+  -> num_parts_of_value:int
+  -> which_parameter:int option
+  -> provenance:unit option
+  -> t
+
+val create_with_debug_info : reg:Reg.t -> debug_info:Debug_info.t option -> t
+
+val create_without_debug_info : reg:Reg.t -> t
+
+val create_copying_debug_info : reg:Reg.t -> debug_info_from:t -> t
+
+val reg : t -> Reg.t
+val location : t -> Reg.location
+val debug_info : t -> Debug_info.t option
+
+val at_same_location : t -> Reg.t -> register_class:(Reg.t -> int) -> bool
+(** [at_same_location t reg] holds iff the register [t] corresponds to
+    the same (physical or pseudoregister) location as the register [reg],
+    which is not equipped with debugging information.
+    [register_class] should be [Proc.register_class].
+*)
+
+val holds_pointer : t -> bool
+val holds_non_pointer : t -> bool
+
+val assigned_to_stack : t -> bool
+(** [assigned_to_stack t] holds iff the location of [t] is a hard stack
+    slot. *)
+
+val clear_debug_info : t -> t
+
+module Set_distinguishing_names_and_locations
+  : Set.S with type elt = t
+
+module Map_distinguishing_names_and_locations
+  : Map.S with type key = t
+
+module Set : sig
+  include Set.S with type elt = t
+
+  val of_array : reg_with_debug_info array -> t
+
+  val mem_reg : t -> Reg.t -> bool
+
+  val find_reg_exn : t -> Reg.t -> reg_with_debug_info
+
+  val filter_reg : t -> Reg.t -> t
+
+  val forget_debug_info : t -> Reg.Set.t
+
+  val without_debug_info : Reg.Set.t -> t
+
+  val made_unavailable_by_clobber
+     : t
+    -> regs_clobbered:Reg.t array
+    -> register_class:(Reg.t -> int)
+    -> t
+  (** [made_unavailable_by_clobber t ~regs_clobbered ~register_class] returns
+      the largest subset of [t] whose locations do not overlap with any
+      registers in [regs_clobbered].  (Think of [t] as a set of available
+      registers.)
+      [register_class] should always be [Proc.register_class]. *)
+end
+
+val print
+   : print_reg:(Format.formatter -> Reg.t -> unit)
+  -> Format.formatter
+  -> t
+  -> unit
diff --git a/asmcomp/dune b/asmcomp/dune
new file mode 100644
index 00000000..a208b56e
--- /dev/null
+++ b/asmcomp/dune
@@ -0,0 +1,44 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+(rule
+ (targets arch.ml CSE.ml proc.ml reload.ml scheduling.ml selection.ml)
+ (mode    fallback)
+ (deps    (:conf ../Makefile.config)
+          (glob_files amd64/*.ml)
+          (glob_files arm/*.ml)
+          (glob_files arm64/*.ml)
+          (glob_files i386/*.ml)
+          (glob_files power/*.ml)
+          (glob_files s390x/*.ml))
+ (action  (bash "cp `grep '^ARCH=' %{conf} | cut -d'=' -f2`/*.ml .")))
+
+(rule
+ (targets emit.ml)
+ (mode    fallback)
+ (deps    (:conf ../Makefile.config)
+          amd64/emit.mlp
+          arm/emit.mlp
+          arm64/emit.mlp
+          i386/emit.mlp
+          power/emit.mlp
+          s390x/emit.mlp)
+ (action
+   (progn
+     (with-stdout-to contains-input-name
+       (bash "echo `grep '^ARCH=' %{conf} | cut -d'=' -f2`/emit.mlp"))
+     (with-stdout-to %{targets}
+       (progn
+         (bash "echo \\# 1 \\\"`cat contains-input-name`\\\"")
+         (bash "%{dep:../tools/cvt_emit.exe} < `cat contains-input-name`"))))))
diff --git a/asmcomp/emit.mli b/asmcomp/emit.mli
new file mode 100644
index 00000000..ad7ede8d
--- /dev/null
+++ b/asmcomp/emit.mli
@@ -0,0 +1,21 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Generation of assembly code *)
+
+val fundecl: Linear.fundecl -> unit
+val data: Cmm.data_item list -> unit
+val begin_assembly: unit -> unit
+val end_assembly: unit -> unit
diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml
new file mode 100644
index 00000000..9a1e6214
--- /dev/null
+++ b/asmcomp/emitaux.ml
@@ -0,0 +1,372 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Common functions for emitting assembly code *)
+
+let output_channel = ref stdout
+
+let emit_string s = output_string !output_channel s
+
+let emit_int n = output_string !output_channel (Int.to_string n)
+
+let emit_char c = output_char !output_channel c
+
+let emit_nativeint n = output_string !output_channel (Nativeint.to_string n)
+
+let emit_printf fmt =
+  Printf.fprintf !output_channel fmt
+
+let emit_int32 n = emit_printf "0x%lx" n
+
+let emit_symbol esc s =
+  for i = 0 to String.length s - 1 do
+    let c = s.[i] in
+    match c with
+      'A'..'Z' | 'a'..'z' | '0'..'9' | '_' ->
+        output_char !output_channel c
+    | _ ->
+        Printf.fprintf !output_channel "%c%02x" esc (Char.code c)
+  done
+
+let emit_string_literal s =
+  let last_was_escape = ref false in
+  emit_string "\"";
+  for i = 0 to String.length s - 1 do
+    let c = s.[i] in
+    if c >= '0' && c <= '9' then
+      if !last_was_escape
+      then Printf.fprintf !output_channel "\\%o" (Char.code c)
+      else output_char !output_channel c
+    else if c >= ' ' && c <= '~' && c <> '"' (* '"' *) && c <> '\\' then begin
+      output_char !output_channel c;
+      last_was_escape := false
+    end else begin
+      Printf.fprintf !output_channel "\\%o" (Char.code c);
+      last_was_escape := true
+    end
+  done;
+  emit_string "\""
+
+let emit_string_directive directive s =
+  let l = String.length s in
+  if l = 0 then ()
+  else if l < 80 then begin
+    emit_string directive;
+    emit_string_literal s;
+    emit_char '\n'
+  end else begin
+    let i = ref 0 in
+    while !i < l do
+      let n = min (l - !i) 80 in
+      emit_string directive;
+      emit_string_literal (String.sub s !i n);
+      emit_char '\n';
+      i := !i + n
+    done
+  end
+
+let emit_bytes_directive directive s =
+   let pos = ref 0 in
+   for i = 0 to String.length s - 1 do
+     if !pos = 0
+     then emit_string directive
+     else emit_char ',';
+     emit_int(Char.code s.[i]);
+     incr pos;
+     if !pos >= 16 then begin emit_char '\n'; pos := 0 end
+   done;
+   if !pos > 0 then emit_char '\n'
+
+let emit_float64_directive directive x =
+  emit_printf "\t%s\t0x%Lx\n" directive x
+
+let emit_float64_split_directive directive x =
+  let lo = Int64.logand x 0xFFFF_FFFFL
+  and hi = Int64.shift_right_logical x 32 in
+  emit_printf "\t%s\t0x%Lx, 0x%Lx\n"
+    directive
+    (if Arch.big_endian then hi else lo)
+    (if Arch.big_endian then lo else hi)
+
+let emit_float32_directive directive x =
+  emit_printf "\t%s\t0x%lx\n" directive x
+
+(* Record live pointers at call points *)
+
+type frame_debuginfo =
+  | Dbg_alloc of Debuginfo.alloc_dbginfo
+  | Dbg_raise of Debuginfo.t
+  | Dbg_other of Debuginfo.t
+
+type frame_descr =
+  { fd_lbl: int;                        (* Return address *)
+    fd_frame_size: int;                 (* Size of stack frame *)
+    fd_live_offset: int list;           (* Offsets/regs of live addresses *)
+    fd_debuginfo: frame_debuginfo }     (* Location, if any *)
+
+let frame_descriptors = ref([] : frame_descr list)
+
+let record_frame_descr ~label ~frame_size ~live_offset debuginfo =
+  frame_descriptors :=
+    { fd_lbl = label;
+      fd_frame_size = frame_size;
+      fd_live_offset = List.sort_uniq (-) live_offset;
+      fd_debuginfo = debuginfo } :: !frame_descriptors
+
+type emit_frame_actions =
+  { efa_code_label: int -> unit;
+    efa_data_label: int -> unit;
+    efa_8: int -> unit;
+    efa_16: int -> unit;
+    efa_32: int32 -> unit;
+    efa_word: int -> unit;
+    efa_align: int -> unit;
+    efa_label_rel: int -> int32 -> unit;
+    efa_def_label: int -> unit;
+    efa_string: string -> unit }
+
+let emit_frames a =
+  let filenames = Hashtbl.create 7 in
+  let label_filename name =
+    try
+      Hashtbl.find filenames name
+    with Not_found ->
+      let lbl = Cmm.new_label () in
+      Hashtbl.add filenames name lbl;
+      lbl
+  in
+  let defnames = Hashtbl.create 7 in
+  let label_defname filename defname =
+    try
+      snd (Hashtbl.find defnames (filename, defname))
+    with Not_found ->
+      let file_lbl = label_filename filename in
+      let def_lbl = Cmm.new_label () in
+      Hashtbl.add defnames (filename, defname) (file_lbl, def_lbl);
+      def_lbl
+  in
+  let module Label_table =
+    Hashtbl.Make (struct
+      type t = bool * Debuginfo.t
+
+      let equal ((rs1 : bool), dbg1) (rs2, dbg2) =
+        rs1 = rs2 && Debuginfo.compare dbg1 dbg2 = 0
+
+      let hash (rs, dbg) =
+        Hashtbl.hash (rs, Debuginfo.hash dbg)
+    end)
+  in
+  let debuginfos = Label_table.create 7 in
+  let label_debuginfos rs dbg =
+    let rdbg = List.rev dbg in
+    let key = (rs, rdbg) in
+    try Label_table.find debuginfos key
+    with Not_found ->
+      let lbl = Cmm.new_label () in
+      Label_table.add debuginfos key lbl;
+      lbl
+  in
+  let emit_frame fd =
+    assert (fd.fd_frame_size land 3 = 0);
+    let flags =
+      match fd.fd_debuginfo with
+      | Dbg_other d | Dbg_raise d ->
+        if Debuginfo.is_none d then 0 else 1
+      | Dbg_alloc dbgs ->
+        if !Clflags.debug && not Config.spacetime &&
+           List.exists (fun d ->
+             not (Debuginfo.is_none d.Debuginfo.alloc_dbg)) dbgs
+        then 3 else 2
+    in
+    a.efa_code_label fd.fd_lbl;
+    a.efa_16 (fd.fd_frame_size + flags);
+    a.efa_16 (List.length fd.fd_live_offset);
+    List.iter a.efa_16 fd.fd_live_offset;
+    begin match fd.fd_debuginfo with
+    | _ when flags = 0 ->
+      ()
+    | Dbg_other dbg ->
+      a.efa_align 4;
+      a.efa_label_rel (label_debuginfos false dbg) Int32.zero
+    | Dbg_raise dbg ->
+      a.efa_align 4;
+      a.efa_label_rel (label_debuginfos true dbg) Int32.zero
+    | Dbg_alloc dbg ->
+      assert (List.length dbg < 256);
+      a.efa_8 (List.length dbg);
+      List.iter (fun Debuginfo.{alloc_words;_} ->
+        (* Possible allocations range between 2 and 257 *)
+        assert (2 <= alloc_words &&
+                alloc_words - 1 <= Config.max_young_wosize &&
+                Config.max_young_wosize <= 256);
+        a.efa_8 (alloc_words - 2)) dbg;
+      if flags = 3 then begin
+        a.efa_align 4;
+        List.iter (fun Debuginfo.{alloc_dbg; _} ->
+          if Debuginfo.is_none alloc_dbg then
+            a.efa_32 Int32.zero
+          else
+            a.efa_label_rel (label_debuginfos false alloc_dbg) Int32.zero) dbg
+      end
+    end;
+    a.efa_align Arch.size_addr
+  in
+  let emit_filename name lbl =
+    a.efa_def_label lbl;
+    a.efa_string name
+  in
+  let emit_defname (_filename, defname) (file_lbl, lbl) =
+    (* These must be 32-bit aligned, both because they contain a
+       32-bit value, and because emit_debuginfo assumes the low 2 bits
+       of their addresses are 0. *)
+    a.efa_align 4;
+    a.efa_def_label lbl;
+    a.efa_label_rel file_lbl 0l;
+    a.efa_string defname
+  in
+  let pack_info fd_raise d has_next =
+    let line = min 0xFFFFF d.Debuginfo.dinfo_line
+    and char_start = min 0xFF d.Debuginfo.dinfo_char_start
+    and char_end = min 0x3FF d.Debuginfo.dinfo_char_end
+    and kind = if fd_raise then 1 else 0
+    and has_next = if has_next then 1 else 0 in
+    Int64.(add (shift_left (of_int line) 44)
+             (add (shift_left (of_int char_start) 36)
+                (add (shift_left (of_int char_end) 26)
+                   (add (shift_left (of_int kind) 1)
+                      (of_int has_next)))))
+  in
+  let emit_debuginfo (rs, rdbg) lbl =
+    (* Due to inlined functions, a single debuginfo may have multiple locations.
+       These are represented sequentially in memory (innermost frame first),
+       with the low bit of the packed debuginfo being 0 on the last entry. *)
+    a.efa_align 4;
+    a.efa_def_label lbl;
+    let rec emit rs d rest =
+      let open Debuginfo in
+      let info = pack_info rs d (rest <> []) in
+      let defname = Scoped_location.string_of_scopes d.dinfo_scopes in
+      a.efa_label_rel
+        (label_defname d.dinfo_file defname)
+        (Int64.to_int32 info);
+      a.efa_32 (Int64.to_int32 (Int64.shift_right info 32));
+      match rest with
+      | [] -> ()
+      | d :: rest -> emit false d rest in
+    match rdbg with
+    | [] -> assert false
+    | d :: rest -> emit rs d rest in
+  a.efa_word (List.length !frame_descriptors);
+  List.iter emit_frame !frame_descriptors;
+  Label_table.iter emit_debuginfo debuginfos;
+  Hashtbl.iter emit_filename filenames;
+  Hashtbl.iter emit_defname defnames;
+  a.efa_align Arch.size_addr;
+  frame_descriptors := []
+
+(* Detection of functions that can be duplicated between a DLL and
+   the main program (PR#4690) *)
+
+let isprefix s1 s2 =
+  String.length s1 <= String.length s2
+  && String.sub s2 0 (String.length s1) = s1
+
+let is_generic_function name =
+  List.exists
+    (fun p -> isprefix p name)
+    ["caml_apply"; "caml_curry"; "caml_send"; "caml_tuplify"]
+
+(* CFI directives *)
+
+let is_cfi_enabled () =
+  Config.asm_cfi_supported
+
+let cfi_startproc () =
+  if is_cfi_enabled () then
+    emit_string "\t.cfi_startproc\n"
+
+let cfi_endproc () =
+  if is_cfi_enabled () then
+    emit_string "\t.cfi_endproc\n"
+
+let cfi_adjust_cfa_offset n =
+  if is_cfi_enabled () then
+  begin
+    emit_string "\t.cfi_adjust_cfa_offset\t"; emit_int n; emit_string "\n";
+  end
+
+let cfi_offset ~reg ~offset =
+  if is_cfi_enabled () then begin
+    emit_string "\t.cfi_offset ";
+    emit_int reg;
+    emit_string ", ";
+    emit_int offset;
+    emit_string "\n"
+  end
+
+(* Emit debug information *)
+
+(* This assoc list is expected to be very short *)
+let file_pos_nums =
+  (ref [] : (string * int) list ref)
+
+(* Number of files *)
+let file_pos_num_cnt = ref 1
+
+(* Reset debug state at beginning of asm file *)
+let reset_debug_info () =
+  file_pos_nums := [];
+  file_pos_num_cnt := 1
+
+(* We only display .file if the file has not been seen before. We
+   display .loc for every instruction. *)
+let emit_debug_info_gen dbg file_emitter loc_emitter =
+  if is_cfi_enabled () &&
+    (!Clflags.debug || Config.with_frame_pointers) then begin
+    match List.rev dbg with
+    | [] -> ()
+    | { Debuginfo.dinfo_line = line;
+        dinfo_char_start = col;
+        dinfo_file = file_name; } :: _ ->
+      if line > 0 then begin (* PR#6243 *)
+        let file_num =
+          try List.assoc file_name !file_pos_nums
+          with Not_found ->
+            let file_num = !file_pos_num_cnt in
+            incr file_pos_num_cnt;
+            file_emitter ~file_num ~file_name;
+            file_pos_nums := (file_name,file_num) :: !file_pos_nums;
+            file_num in
+        loc_emitter ~file_num ~line ~col;
+      end
+  end
+
+let emit_debug_info dbg =
+  emit_debug_info_gen dbg (fun ~file_num ~file_name ->
+      emit_string "\t.file\t";
+      emit_int file_num; emit_char '\t';
+      emit_string_literal file_name; emit_char '\n';
+    )
+    (fun ~file_num ~line ~col:_ ->
+       emit_string "\t.loc\t";
+       emit_int file_num; emit_char '\t';
+       emit_int line; emit_char '\n')
+
+let reset () =
+  reset_debug_info ();
+  frame_descriptors := []
+
+let binary_backend_available = ref false
+let create_asm_file = ref true
diff --git a/asmcomp/emitaux.mli b/asmcomp/emitaux.mli
new file mode 100644
index 00000000..2b4867d0
--- /dev/null
+++ b/asmcomp/emitaux.mli
@@ -0,0 +1,81 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Common functions for emitting assembly code *)
+
+val output_channel: out_channel ref
+val emit_string: string -> unit
+val emit_int: int -> unit
+val emit_nativeint: nativeint -> unit
+val emit_int32: int32 -> unit
+val emit_symbol: char -> string -> unit
+val emit_printf: ('a, out_channel, unit) format -> 'a
+val emit_char: char -> unit
+val emit_string_literal: string -> unit
+val emit_string_directive: string -> string -> unit
+val emit_bytes_directive: string -> string -> unit
+val emit_float64_directive: string -> int64 -> unit
+val emit_float64_split_directive: string -> int64 -> unit
+val emit_float32_directive: string -> int32 -> unit
+
+val reset : unit -> unit
+val reset_debug_info: unit -> unit
+val emit_debug_info: Debuginfo.t -> unit
+val emit_debug_info_gen :
+  Debuginfo.t ->
+  (file_num:int -> file_name:string -> unit) ->
+  (file_num:int -> line:int -> col:int -> unit) -> unit
+
+type frame_debuginfo =
+  | Dbg_alloc of Debuginfo.alloc_dbginfo
+  | Dbg_raise of Debuginfo.t
+  | Dbg_other of Debuginfo.t
+
+val record_frame_descr :
+  label:int ->              (* Return address *)
+  frame_size:int ->         (* Size of stack frame *)
+  live_offset:int list ->   (* Offsets/regs of live addresses *)
+  frame_debuginfo ->        (* Location, if any *)
+  unit
+
+type emit_frame_actions =
+  { efa_code_label: int -> unit;
+    efa_data_label: int -> unit;
+    efa_8: int -> unit;
+    efa_16: int -> unit;
+    efa_32: int32 -> unit;
+    efa_word: int -> unit;
+    efa_align: int -> unit;
+    efa_label_rel: int -> int32 -> unit;
+    efa_def_label: int -> unit;
+    efa_string: string -> unit }
+
+val emit_frames: emit_frame_actions -> unit
+
+val is_generic_function: string -> bool
+
+val cfi_startproc : unit -> unit
+val cfi_endproc : unit -> unit
+val cfi_adjust_cfa_offset : int -> unit
+val cfi_offset : reg:int -> offset:int -> unit
+
+
+val binary_backend_available: bool ref
+    (** Is a binary backend available.  If yes, we don't need
+        to generate the textual assembly file (unless the user
+        request it with -S). *)
+
+val create_asm_file: bool ref
+    (** Are we actually generating the textual assembly file? *)
diff --git a/asmcomp/i386/CSE.ml b/asmcomp/i386/CSE.ml
new file mode 100644
index 00000000..6ef8fec6
--- /dev/null
+++ b/asmcomp/i386/CSE.ml
@@ -0,0 +1,50 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* CSE for the i386 *)
+
+open Cmm
+open Arch
+open Mach
+open CSEgen
+
+class cse = object
+
+inherit cse_generic as super
+
+method! class_of_operation op =
+  match op with
+  (* Operations that affect the floating-point stack cannot be factored *)
+  | Iconst_float _ | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
+  | Iintoffloat | Ifloatofint
+  | Iload((Single | Double | Double_u), _) -> Op_other
+  (* Specific ops *)
+  | Ispecific(Ilea _) -> Op_pure
+  | Ispecific(Istore_int(_, _, is_asg)) -> Op_store is_asg
+  | Ispecific(Istore_symbol(_, _, is_asg)) -> Op_store is_asg
+  | Ispecific(Ioffset_loc(_, _)) -> Op_store true
+  | Ispecific _ -> Op_other
+  | _ -> super#class_of_operation op
+
+method! is_cheap_operation op =
+  match op with
+  | Iconst_int _ -> true
+  | Iconst_symbol _ -> true
+  | _ -> false
+
+end
+
+let fundecl f =
+  (new cse)#fundecl f
diff --git a/asmcomp/i386/NOTES.md b/asmcomp/i386/NOTES.md
new file mode 100644
index 00000000..69567cbd
--- /dev/null
+++ b/asmcomp/i386/NOTES.md
@@ -0,0 +1,23 @@
+# Supported platforms
+
+Intel and AMD x86 processors in 32-bit mode.
+The baseline is the 80486, also known as `i486`.
+(Debian's baseline is now the Pentium 1.)
+
+In OCaml versions 3.09.2 to 4.08, MacOS was supported by this port.  Support
+was removed in OCaml 4.09.
+
+Floating-point architecture: x87.
+(SSE2 not available in Debian's baseline.)
+
+Operating systems: Linux, BSD, MS Windows.
+
+Debian architecture name: `i386`
+
+# Reference documents
+
+* Instruction set architecture:
+  any Intel or AMD manual of the last 20 years.
+* ELF application binary interface:
+  _System V Application Binary Interface,
+   Intel386 Architecture Processor Supplement_
diff --git a/asmcomp/i386/arch.ml b/asmcomp/i386/arch.ml
new file mode 100644
index 00000000..ba76a825
--- /dev/null
+++ b/asmcomp/i386/arch.ml
@@ -0,0 +1,166 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Machine-specific command-line options *)
+
+let fast_math = ref false
+
+let command_line_options =
+  [ "-ffast-math", Arg.Set fast_math,
+      " Inline trigonometric and exponential functions" ]
+
+(* Specific operations for the Intel 386 processor *)
+
+open Format
+
+type addressing_mode =
+    Ibased of string * int              (* symbol + displ *)
+  | Iindexed of int                     (* reg + displ *)
+  | Iindexed2 of int                    (* reg + reg + displ *)
+  | Iscaled of int * int                (* reg * scale + displ *)
+  | Iindexed2scaled of int * int        (* reg + reg * scale + displ *)
+
+type specific_operation =
+    Ilea of addressing_mode             (* Lea gives scaled adds *)
+  | Istore_int of nativeint * addressing_mode * bool
+                                        (* Store an integer constant *)
+  | Istore_symbol of string * addressing_mode * bool (* Store a symbol *)
+  | Ioffset_loc of int * addressing_mode (* Add a constant to a location *)
+  | Ipush                               (* Push regs on stack *)
+  | Ipush_int of nativeint              (* Push an integer constant *)
+  | Ipush_symbol of string              (* Push a symbol *)
+  | Ipush_load of addressing_mode       (* Load a scalar and push *)
+  | Ipush_load_float of addressing_mode (* Load a float and push *)
+  | Isubfrev | Idivfrev                 (* Reversed float sub and div *)
+  | Ifloatarithmem of bool * float_operation * addressing_mode
+                                        (* Float arith operation with memory *)
+                                        (* bool: true=64 bits, false=32 *)
+  | Ifloatspecial of string
+
+and float_operation =
+    Ifloatadd | Ifloatsub | Ifloatsubrev | Ifloatmul | Ifloatdiv | Ifloatdivrev
+
+let spacetime_node_hole_pointer_is_live_before _specific_op = false
+
+(* Sizes, endianness *)
+
+let big_endian = false
+
+let size_addr = 4
+let size_int = 4
+let size_float = 8
+
+let allow_unaligned_access = true
+
+(* Behavior of division *)
+
+let division_crashes_on_overflow = true
+
+(* Operations on addressing modes *)
+
+let identity_addressing = Iindexed 0
+
+let offset_addressing addr delta =
+  match addr with
+    Ibased(s, n) -> Ibased(s, n + delta)
+  | Iindexed n -> Iindexed(n + delta)
+  | Iindexed2 n -> Iindexed2(n + 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 =
+  match addr with
+  | Ibased(s, 0) ->
+      fprintf ppf "\"%s\"" s
+  | Ibased(s, n) ->
+      fprintf ppf "\"%s\" + %i" s n
+  | Iindexed n ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a%s" printreg arg.(0) idx
+  | Iindexed2 n ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a + %a%s" printreg arg.(0) printreg arg.(1) idx
+  | Iscaled(scale, n) ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a  * %i%s" printreg arg.(0) scale idx
+  | Iindexed2scaled(scale, n) ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a + %a * %i%s" printreg arg.(0) printreg arg.(1) scale idx
+
+let print_specific_operation printreg op ppf arg =
+  match op with
+  | Ilea addr -> print_addressing printreg addr ppf arg
+  | Istore_int(n, addr, is_assign) ->
+      fprintf ppf "[%a] := %nd %s"
+         (print_addressing printreg addr) arg n
+         (if is_assign then "(assign)" else "(init)")
+  | Istore_symbol(lbl, addr, is_assign) ->
+      fprintf ppf "[%a] := \"%s\" %s"
+         (print_addressing printreg addr) arg lbl
+         (if is_assign then "(assign)" else "(init)")
+  | Ioffset_loc(n, addr) ->
+      fprintf ppf "[%a] +:= %i" (print_addressing printreg addr) arg n
+  | Ipush ->
+      fprintf ppf "push ";
+      for i = 0 to Array.length arg - 1 do
+        if i > 0 then fprintf ppf ", ";
+        printreg ppf arg.(i)
+      done
+  | Ipush_int n ->
+      fprintf ppf "push %s" (Nativeint.to_string n)
+  | Ipush_symbol s ->
+      fprintf ppf "push \"%s\"" s
+  | Ipush_load addr ->
+      fprintf ppf "push [%a]" (print_addressing printreg addr) arg
+  | Ipush_load_float addr ->
+      fprintf ppf "pushfloat [%a]" (print_addressing printreg addr) arg
+  | Isubfrev ->
+      fprintf ppf "%a -f(rev) %a" printreg arg.(0) printreg arg.(1)
+  | Idivfrev ->
+      fprintf ppf "%a /f(rev) %a" printreg arg.(0) printreg arg.(1)
+  | Ifloatarithmem(double, op, addr) ->
+      let op_name = function
+      | Ifloatadd -> "+f"
+      | Ifloatsub -> "-f"
+      | Ifloatsubrev -> "-f(rev)"
+      | Ifloatmul -> "*f"
+      | Ifloatdiv -> "/f"
+      | Ifloatdivrev -> "/f(rev)" in
+      let long = if double then "float64" else "float32" in
+      fprintf ppf "%a %s %s[%a]" printreg arg.(0) (op_name op) long
+       (print_addressing printreg addr) (Array.sub arg 1 (Array.length arg - 1))
+  | Ifloatspecial name ->
+      fprintf ppf "%s " name;
+      for i = 0 to Array.length arg - 1 do
+        if i > 0 then fprintf ppf ", ";
+        printreg ppf arg.(i)
+      done
+
+(* Stack alignment constraints *)
+
+let stack_alignment =
+  match Config.system with
+  | "win32" -> 4     (* MSVC *)
+  | _ -> 16
+  (* PR#6038: GCC and Clang seem to require 16-byte alignment nowadays *)
diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp
new file mode 100644
index 00000000..1bad19f9
--- /dev/null
+++ b/asmcomp/i386/emit.mlp
@@ -0,0 +1,1063 @@
+#2 "asmcomp/i386/emit.mlp"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Emission of Intel 386 assembly code *)
+
+open Misc
+open Cmm
+open Arch
+open Proc
+open Reg
+open Mach
+open Linear
+open Emitaux
+module String = Misc.Stdlib.String
+
+open X86_ast
+open X86_proc
+open X86_dsl
+
+let _label s = D.label ~typ:DWORD s
+
+let mem_sym typ ?(ofs = 0) sym =
+  mem32 typ ~scale:0 ?base:None ~sym ofs RAX (*ignored since scale=0*)
+
+(* CFI directives *)
+
+let cfi_startproc () =
+  if Config.asm_cfi_supported then D.cfi_startproc ()
+
+let cfi_endproc () =
+  if Config.asm_cfi_supported then D.cfi_endproc ()
+
+let cfi_adjust_cfa_offset n =
+  if Config.asm_cfi_supported then D.cfi_adjust_cfa_offset n
+
+let emit_debug_info dbg =
+  emit_debug_info_gen dbg D.file D.loc
+
+(* Tradeoff between code size and code speed *)
+
+let fastcode_flag = ref true
+
+let stack_offset = ref 0
+
+(* Layout of the stack frame *)
+let num_stack_slots = Array.make Proc.num_register_classes 0
+
+let prologue_required = ref false
+
+let frame_size () =                     (* includes return address *)
+  let sz =
+    !stack_offset + 4 * num_stack_slots.(0) + 8 * num_stack_slots.(1) + 4
+  in Misc.align sz stack_alignment
+
+let slot_offset loc cl =
+  match loc with
+  | Incoming n ->
+      assert (n >= 0);
+      frame_size() + n
+  | Local n ->
+      if cl = 0
+      then !stack_offset + n * 4
+      else !stack_offset + num_stack_slots.(0) * 4 + n * 8
+  | Outgoing n ->
+      assert (n >= 0);
+      n
+
+(* Record symbols used and defined - at the end generate extern for those
+   used but not defined *)
+
+let symbols_defined = ref String.Set.empty
+let symbols_used = ref String.Set.empty
+
+let add_def_symbol s = symbols_defined := String.Set.add s !symbols_defined
+let add_used_symbol s = symbols_used := String.Set.add s !symbols_used
+
+let trap_frame_size = Misc.align 8 stack_alignment
+
+(* Prefixing of symbols with "_" *)
+
+let symbol_prefix =
+  match system with
+  | S_linux_elf -> ""
+  | S_bsd_elf -> ""
+  | S_solaris -> ""
+  | S_beos -> ""
+  | S_gnu -> ""
+  | _ -> "_" (* win32 & others *)
+
+let emit_symbol s = string_of_symbol symbol_prefix s
+
+let immsym s = sym (emit_symbol s)
+
+let emit_call s = I.call (immsym s)
+
+(* Output a label *)
+
+let label_prefix =
+  match system with
+  | S_linux_elf -> ".L"
+  | S_bsd_elf -> ".L"
+  | S_solaris -> ".L"
+  | S_beos -> ".L"
+  | S_gnu -> ".L"
+  | _ -> "L"
+
+let emit_label lbl =
+  Printf.sprintf "%s%d" label_prefix lbl
+
+let label s = sym (emit_label s)
+
+let def_label s = D.label (emit_label s)
+
+let emit_Llabel fallthrough lbl =
+  if not fallthrough && !fastcode_flag then D.align 16 ;
+  def_label lbl
+
+(* Output a pseudo-register *)
+
+let int_reg_name =  [| RAX; RBX; RCX; RDX; RSI; RDI; RBP  |]
+
+let float_reg_name = [| TOS |]
+
+let register_name r =
+  if r < 100 then Reg32 (int_reg_name.(r))
+  else Regf (float_reg_name.(r - 100))
+
+let sym32 ?ofs s = mem_sym ?ofs DWORD (emit_symbol s)
+
+let domain_field f r =
+  mem32 DWORD (Domainstate.idx_of_field f * 8) r
+
+let load_domain_state r =
+  I.mov (sym32 "Caml_state") r
+
+let reg = function
+  | { loc = Reg r } -> register_name r
+  | { loc = Stack(Incoming n | Outgoing n) } when n < 0 ->
+      sym32 "caml_extra_params" ~ofs:(n + 64)
+  | { loc = Stack s; typ = Float } as r ->
+      let ofs = slot_offset s (register_class r) in
+      mem32 REAL8 ofs RSP
+  | { loc = Stack s } as r ->
+      let ofs = slot_offset s (register_class r) in
+      mem32 DWORD ofs RSP
+  | { loc = Unknown } ->
+      fatal_error "Emit_i386.reg"
+
+(* Output a reference to the lower 8 bits or lower 16 bits of a register *)
+
+let reg_low_8_name  = Array.map (fun r -> Reg8L r) int_reg_name
+let reg_low_16_name = Array.map (fun r -> Reg16 r) int_reg_name
+
+let reg8 r =
+  match r.loc with
+  | Reg r when r < 4 -> reg_low_8_name.(r)
+  | _ -> fatal_error "Emit_i386.reg8"
+
+let reg16 r =
+  match r.loc with
+  | Reg r when r < 7 -> reg_low_16_name.(r)
+  | _ -> fatal_error "Emit_i386.reg16"
+
+let reg32 = function
+  | { loc = Reg.Reg r } -> int_reg_name.(r)
+  | _ -> assert false
+
+let arg32 i n = reg32 i.arg.(n)
+
+(* Output an addressing mode *)
+
+let addressing addr typ i n =
+  match addr with
+  | Ibased(s, ofs) ->
+      add_used_symbol s;
+      mem_sym typ (emit_symbol s) ~ofs
+  | Iindexed d ->
+      mem32 typ d (arg32 i n)
+  | Iindexed2 d ->
+      mem32 typ ~base:(arg32 i n) d (arg32 i (n+1))
+  | Iscaled(2, d) ->
+      mem32 typ ~base:(arg32 i n) d (arg32 i n)
+  | Iscaled(scale, d) ->
+      mem32 typ ~scale d (arg32 i n)
+  | Iindexed2scaled(scale, d) ->
+      mem32 typ ~scale ~base:(arg32 i n) d (arg32 i (n+1))
+
+(* Record live pointers at call points *)
+
+let record_frame_label ?label live dbg =
+  let lbl =
+    match label with
+    | None -> new_label()
+    | Some label -> label
+  in
+  let live_offset = ref [] in
+  Reg.Set.iter
+    (function
+      | {typ = Val; loc = Reg r} ->
+          live_offset := ((r lsl 1) + 1) :: !live_offset
+      | {typ = Val; loc = Stack s} as reg ->
+          live_offset := slot_offset s (register_class reg) :: !live_offset
+      | {typ = Addr} as r ->
+          Misc.fatal_error ("bad GC root " ^ Reg.name r)
+      | _ -> ())
+    live;
+  record_frame_descr ~label:lbl ~frame_size:(frame_size())
+    ~live_offset:!live_offset dbg;
+  lbl
+
+let record_frame ?label live dbg =
+  let lbl = record_frame_label ?label live dbg in
+  def_label lbl
+
+(* Record calls to the GC -- we've moved them out of the way *)
+
+type gc_call =
+  { gc_lbl: label;                      (* Entry label *)
+    gc_return_lbl: label;               (* Where to branch after GC *)
+    gc_frame: label }                   (* Label of frame descriptor *)
+
+let call_gc_sites = ref ([] : gc_call list)
+
+let emit_call_gc gc =
+  def_label gc.gc_lbl;
+  emit_call "caml_call_gc";
+  def_label gc.gc_frame;
+  I.jmp (label gc.gc_return_lbl)
+
+(* Record calls to caml_ml_array_bound_error.
+   In -g mode, we maintain one call to caml_ml_array_bound_error
+   per bound check site.  Without -g, we can share a single call. *)
+
+type bound_error_call =
+  { bd_lbl: label;                      (* Entry label *)
+    bd_frame: label }                   (* Label of frame descriptor *)
+
+let bound_error_sites = ref ([] : bound_error_call list)
+let bound_error_call = ref 0
+
+let bound_error_label ?label dbg =
+  if !Clflags.debug then begin
+    let lbl_bound_error = new_label() in
+    let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
+    bound_error_sites :=
+      { bd_lbl = lbl_bound_error; bd_frame = lbl_frame } :: !bound_error_sites;
+    lbl_bound_error
+  end else begin
+    if !bound_error_call = 0 then bound_error_call := new_label();
+    !bound_error_call
+  end
+
+let emit_call_bound_error bd =
+  def_label bd.bd_lbl;
+  emit_call "caml_ml_array_bound_error";
+  def_label bd.bd_frame
+
+let emit_call_bound_errors () =
+  List.iter emit_call_bound_error !bound_error_sites;
+  if !bound_error_call > 0 then begin
+    def_label !bound_error_call;
+    emit_call "caml_ml_array_bound_error"
+  end
+
+(* Names for instructions *)
+
+let instr_for_intop = function
+  | Iadd -> I.add
+  | Isub -> I.sub
+  | Imul -> (fun arg1 arg2 ->  I.imul arg1 (Some arg2))
+  | Iand -> I.and_
+  | Ior -> I.or_
+  | Ixor -> I.xor
+  | Ilsl -> I.sal
+  | Ilsr -> I.shr
+  | Iasr -> I.sar
+  | _ -> fatal_error "Emit_i386: instr_for_intop"
+
+let unary_instr_for_floatop = function
+  | Inegf -> I.fchs ()
+  | Iabsf -> I.fabs ()
+  | _ -> fatal_error "Emit_i386: unary_instr_for_floatop"
+
+let instr_for_floatop = function
+  | Iaddf -> I.fadd
+  | Isubf -> I.fsub
+  | Imulf -> I.fmul
+  | Idivf -> I.fdiv
+  | Ispecific Isubfrev -> I.fsubr
+  | Ispecific Idivfrev -> I.fdivr
+  | _ -> fatal_error "Emit_i386: instr_for_floatop"
+
+let instr_for_floatop_reversed = function
+  | Iaddf -> I.fadd
+  | Isubf -> I.fsubr
+  | Imulf -> I.fmul
+  | Idivf -> I.fdivr
+  | Ispecific Isubfrev -> I.fsub
+  | Ispecific Idivfrev -> I.fdiv
+  | _ -> fatal_error "Emit_i386: instr_for_floatop_reversed"
+
+
+let instr_for_floatop_reversed_pop = function
+  | Iaddf -> I.faddp
+  | Isubf -> I.fsubrp
+  | Imulf -> I.fmulp
+  | Idivf -> I.fdivrp
+  | Ispecific Isubfrev -> I.fsubp
+  | Ispecific Idivfrev -> I.fdivp
+  | _ -> fatal_error "Emit_i386: instr_for_floatop_reversed_pop"
+
+let instr_for_floatarithmem = function
+  | Ifloatadd -> I.fadd
+  | Ifloatsub -> I.fsub
+  | Ifloatsubrev -> I.fsubr
+  | Ifloatmul -> I.fmul
+  | Ifloatdiv -> I.fdiv
+  | Ifloatdivrev -> I.fdivr
+
+let cond = function
+  | Isigned Ceq   -> E   | Isigned Cne   -> NE
+  | Isigned Cle   -> LE  | Isigned Cgt   -> G
+  | Isigned Clt   -> L   | Isigned Cge   -> GE
+  | Iunsigned Ceq -> E   | Iunsigned Cne -> NE
+  | Iunsigned Cle -> BE  | Iunsigned Cgt -> A
+  | Iunsigned Clt -> B   | Iunsigned Cge -> AE
+
+(* Output an = 0 or <> 0 test. *)
+
+let output_test_zero arg =
+  match arg.loc with
+  | Reg.Reg _ -> I.test (reg arg) (reg arg)
+  | _  -> I.cmp (int 0) (reg arg)
+
+(* Deallocate the stack frame before a return or tail call *)
+
+let output_epilogue f =
+  let n = frame_size() - 4 in
+  if n > 0 then
+    begin
+      I.add (int n) esp;
+      cfi_adjust_cfa_offset (-n);
+      f ();
+      (* reset CFA back cause function body may continue *)
+      cfi_adjust_cfa_offset n
+    end
+  else
+    f ()
+
+(* Determine if the given register is the top of the floating-point stack *)
+
+let is_tos = function { loc = Reg _; typ = Float } -> true | _ -> false
+
+(* Emit the code for a floating-point comparison *)
+
+let emit_float_test cmp arg lbl =
+  let actual_cmp =
+    match (is_tos arg.(0), is_tos arg.(1)) with
+    | (true, true) ->
+        (* both args on top of FP stack *)
+        I.fcompp ();
+        cmp
+    | (true, false) ->
+        (* first arg on top of FP stack *)
+        I.fcomp (reg arg.(1));
+        cmp
+    | (false, true) ->
+        (* second arg on top of FP stack *)
+        I.fcomp (reg arg.(0));
+        Cmm.swap_float_comparison cmp
+    | (false, false) ->
+        I.fld     (reg arg.(0));
+        I.fcomp   (reg arg.(1));
+        cmp
+  in
+  I.fnstsw ax;
+  match actual_cmp with
+  | CFeq ->
+      I.and_ (int 69) ah;
+      I.cmp (int 64) ah;
+      I.je lbl
+  | CFneq ->
+      I.and_ (int 68) ah;
+      I.xor (int 64) ah;
+      I.jne lbl
+  | CFle ->
+      I.and_ (int 69) ah;
+      I.dec ah;
+      I.cmp (int 64) ah;
+      I.jb lbl
+  | CFnle ->
+      I.and_ (int 69) ah;
+      I.dec ah;
+      I.cmp (int 64) ah;
+      I.jae lbl
+  | CFge ->
+      I.and_ (int 5) ah;
+      I.je lbl
+  | CFnge ->
+      I.and_ (int 5) ah;
+      I.jne lbl
+  | CFlt ->
+      I.and_ (int 69) ah;
+      I.cmp (int 1) ah;
+      I.je lbl
+  | CFnlt ->
+      I.and_ (int 69) ah;
+      I.cmp (int 1) ah;
+      I.jne lbl
+  | CFgt ->
+      I.and_ (int 69) ah;
+      I.je lbl
+  | CFngt ->
+      I.and_ (int 69) ah;
+      I.jne lbl
+
+(* Emit a Ifloatspecial instruction *)
+
+let emit_floatspecial = function
+  | "atan"  -> I.fld1 (); I.fpatan ()
+  | "atan2" -> I.fpatan ()
+  | "cos"   -> I.fcos ()
+  | "log"   -> I.fldln2 (); I.fxch st1; I.fyl2x ()
+  | "log10" -> I.fldlg2 (); I.fxch st1; I.fyl2x ()
+  | "sin"   -> I.fsin ()
+  | "sqrt"  -> I.fsqrt ()
+  | "tan"   -> I.fptan (); I.fstp st0
+  | _ -> assert false
+
+(* Floating-point constants *)
+
+let float_constants = ref ([] : (int64 * int) list)
+
+let add_float_constant cst =
+  try
+    List.assoc cst !float_constants
+  with
+    Not_found ->
+      let lbl = new_label() in
+      float_constants := (cst, lbl) :: !float_constants;
+      lbl
+
+let emit_float64_split_directive x =
+  let lo = Int64.logand x 0xFFFF_FFFFL
+  and hi = Int64.shift_right_logical x 32 in
+  D.long (Const (if Arch.big_endian then hi else lo));
+  D.long (Const (if Arch.big_endian then lo else hi))
+
+let emit_float_constant cst lbl =
+  _label (emit_label lbl);
+  emit_float64_split_directive cst
+
+let emit_global_label s =
+  let lbl = Compilenv.make_symbol (Some s) in
+  add_def_symbol lbl;
+  let lbl = emit_symbol lbl in
+  D.global lbl;
+  _label lbl
+
+(* Output .text section directive, or named .text.caml. if enabled. *)
+
+let emit_named_text_section func_name =
+  if !Clflags.function_sections then
+    begin match system with
+    | S_macosx | S_mingw | S_cygwin | S_win32 -> D.text ()
+    | _ -> D.section [ ".text.caml."^(emit_symbol func_name) ]
+             (Some "ax") ["@progbits"]
+    end
+  else D.text ()
+
+(* Output the assembly code for an instruction *)
+
+(* Name of current function *)
+let function_name = ref ""
+(* Entry point for tail recursive calls *)
+let tailrec_entry_point = ref 0
+
+let emit_instr fallthrough i =
+  emit_debug_info i.dbg;
+  match i.desc with
+  | Lend -> ()
+  | Lprologue ->
+    assert (!prologue_required);
+    let n = frame_size() - 4 in
+    if n > 0 then  begin
+      I.sub (int n) esp;
+      cfi_adjust_cfa_offset n;
+    end;
+  | Lop(Imove | Ispill | Ireload) ->
+      let src = i.arg.(0) and dst = i.res.(0) in
+      if src.loc <> dst.loc then begin
+        if src.typ = Float then
+          if is_tos src then
+            I.fstp (reg dst)
+          else if is_tos dst then
+            I.fld (reg src)
+          else begin
+            I.fld (reg src);
+            I.fstp (reg dst)
+          end
+        else
+          I.mov (reg src) (reg dst)
+      end
+  | Lop(Iconst_int n) ->
+      if n = 0n then begin
+        match i.res.(0).loc with
+        | Reg _ -> I.xor (reg i.res.(0)) (reg i.res.(0))
+        | _     -> I.mov (int 0) (reg i.res.(0))
+      end else
+        I.mov (nat n) (reg i.res.(0))
+  | Lop(Iconst_float f) ->
+      begin match f with
+      | 0x0000_0000_0000_0000L ->       (* +0.0 *)
+          I.fldz ()
+      | 0x8000_0000_0000_0000L ->       (* -0.0 *)
+          I.fldz (); I.fchs ()
+      | 0x3FF0_0000_0000_0000L ->       (*  1.0 *)
+          I.fld1 ()
+      | 0xBFF0_0000_0000_0000L ->       (* -1.0 *)
+          I.fld1 (); I.fchs ()
+      | _ ->
+          let lbl = add_float_constant f in
+          I.fld (mem_sym REAL8 (emit_label lbl))
+      end
+  | Lop(Iconst_symbol s) ->
+      add_used_symbol s;
+      I.mov (immsym s) (reg i.res.(0))
+  | Lop(Icall_ind { label_after; }) ->
+      I.call (reg i.arg.(0));
+      record_frame i.live (Dbg_other i.dbg) ~label:label_after
+  | Lop(Icall_imm { func; label_after; }) ->
+      add_used_symbol func;
+      emit_call func;
+      record_frame i.live (Dbg_other i.dbg) ~label:label_after
+  | Lop(Itailcall_ind { label_after = _; }) ->
+      output_epilogue begin fun () ->
+        I.jmp (reg i.arg.(0))
+      end
+  | Lop(Itailcall_imm { func; label_after = _; }) ->
+      if func = !function_name then
+        I.jmp (label !tailrec_entry_point)
+      else begin
+        output_epilogue begin fun () ->
+          add_used_symbol func;
+          I.jmp (immsym func)
+        end
+      end
+  | Lop(Iextcall { func; alloc; label_after; }) ->
+      add_used_symbol func;
+      if alloc then begin
+        I.mov (immsym func) eax;
+        emit_call "caml_c_call";
+        record_frame i.live (Dbg_other i.dbg) ~label:label_after
+      end else begin
+        emit_call func
+      end
+  | Lop(Istackoffset n) ->
+      if n < 0
+      then I.add (int (-n)) esp
+      else I.sub (int n) esp;
+      cfi_adjust_cfa_offset n;
+      stack_offset := !stack_offset + n
+  | Lop(Iload(chunk, addr)) ->
+      let dest = i.res.(0) in
+      begin match chunk with
+      | Word_int | Word_val | Thirtytwo_signed | Thirtytwo_unsigned ->
+          I.mov (addressing addr DWORD i 0) (reg dest)
+      | Byte_unsigned ->
+          I.movzx (addressing addr BYTE i 0) (reg dest)
+      | Byte_signed ->
+          I.movsx (addressing addr BYTE i 0) (reg dest)
+      | Sixteen_unsigned ->
+          I.movzx (addressing addr WORD i 0) (reg dest)
+      | Sixteen_signed ->
+          I.movsx (addressing addr WORD i 0) (reg dest)
+      | Single ->
+          I.fld (addressing addr REAL4 i 0)
+      | Double | Double_u ->
+          I.fld (addressing addr REAL8 i 0)
+      end
+  | Lop(Istore(chunk, addr, _)) ->
+      begin match chunk with
+      | Word_int | Word_val | Thirtytwo_signed | Thirtytwo_unsigned ->
+          I.mov (reg i.arg.(0)) (addressing addr DWORD i 1)
+      | Byte_unsigned | Byte_signed ->
+          I.mov (reg8 i.arg.(0)) (addressing addr BYTE i 1)
+      | Sixteen_unsigned | Sixteen_signed ->
+          I.mov (reg16 i.arg.(0)) (addressing addr WORD i 1)
+      | Single ->
+          if is_tos i.arg.(0) then
+            I.fstp (addressing addr REAL4 i 1)
+          else begin
+            I.fld (reg i.arg.(0));
+            I.fstp (addressing addr REAL4 i 1)
+          end
+      | Double | Double_u ->
+          if is_tos i.arg.(0) then
+            I.fstp (addressing addr REAL8 i 1)
+          else begin
+            I.fld (reg i.arg.(0));
+            I.fstp (addressing addr REAL8 i 1)
+          end
+      end
+  | Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
+      if !fastcode_flag then begin
+        load_domain_state ebx;
+        I.mov (domain_field Domain_young_ptr RBX) eax;
+        I.sub (int n) eax;
+        I.mov eax (domain_field Domain_young_ptr RBX);
+        I.cmp (domain_field Domain_young_limit RBX) eax;
+        let lbl_call_gc = new_label() in
+        let lbl_frame =
+          record_frame_label ?label:label_after_call_gc
+            i.live (Dbg_alloc dbginfo) in
+        I.jb (label lbl_call_gc);
+        let lbl_after_alloc = new_label() in
+        def_label lbl_after_alloc;
+        I.lea (mem32 NONE 4 RAX) (reg i.res.(0));
+        call_gc_sites :=
+          { gc_lbl = lbl_call_gc;
+            gc_return_lbl = lbl_after_alloc;
+            gc_frame = lbl_frame } :: !call_gc_sites
+      end else begin
+        begin match n with
+          8  -> emit_call "caml_alloc1"
+        | 12 -> emit_call "caml_alloc2"
+        | 16 -> emit_call "caml_alloc3"
+        | _  ->
+            I.mov (int n) eax;
+            emit_call "caml_allocN"
+        end;
+        let label =
+          record_frame_label ?label:label_after_call_gc
+            i.live (Dbg_alloc dbginfo)
+        in
+        def_label label;
+        I.lea (mem32 NONE 4 RAX) (reg i.res.(0))
+      end
+  | Lop(Iintop(Icomp cmp)) ->
+      I.cmp (reg i.arg.(1)) (reg i.arg.(0));
+      I.set (cond cmp) al;
+      I.movzx al (reg i.res.(0));
+  | Lop(Iintop_imm(Icomp cmp, n)) ->
+      I.cmp (int n) (reg i.arg.(0));
+      I.set (cond cmp) al;
+      I.movzx al (reg i.res.(0))
+  | Lop(Iintop (Icheckbound { label_after_error; } )) ->
+      let lbl = bound_error_label ?label:label_after_error i.dbg in
+      I.cmp (reg i.arg.(1)) (reg i.arg.(0));
+      I.jbe (label lbl)
+  | Lop(Iintop_imm(Icheckbound { label_after_error; }, n)) ->
+      let lbl = bound_error_label ?label:label_after_error i.dbg in
+      I.cmp (int n) (reg i.arg.(0));
+      I.jbe (label lbl)
+  | Lop(Iintop(Idiv | Imod)) ->
+      I.cdq ();
+      I.idiv (reg i.arg.(1))
+  | Lop(Iintop(Ilsl | Ilsr | Iasr as op)) ->
+      (* We have i.arg.(0) = i.res.(0) and i.arg.(1) = %ecx *)
+      instr_for_intop op cl (reg i.res.(0))
+  | Lop(Iintop Imulh) ->
+      I.imul (reg i.arg.(1)) None
+  | Lop(Iintop op) ->
+      (* We have i.arg.(0) = i.res.(0) *)
+      instr_for_intop op (reg i.arg.(1)) (reg i.res.(0))
+  | Lop(Iintop_imm(Iadd, n)) when i.arg.(0).loc <> i.res.(0).loc ->
+      I.lea (mem32 NONE n (reg32 i.arg.(0))) (reg i.res.(0))
+  | Lop(Iintop_imm(Iadd, 1) | Iintop_imm(Isub, -1)) ->
+      I.inc (reg i.res.(0))
+  | Lop(Iintop_imm(Iadd, -1) | Iintop_imm(Isub, 1)) ->
+      I.dec (reg i.res.(0))
+  | Lop(Iintop_imm(op, n)) ->
+      (* We have i.arg.(0) = i.res.(0) *)
+      instr_for_intop op (int n) (reg i.res.(0))
+  | Lop(Inegf | Iabsf as floatop) ->
+      if not (is_tos i.arg.(0)) then
+        I.fld (reg i.arg.(0));
+      unary_instr_for_floatop floatop
+  | Lop(Iaddf | Isubf | Imulf | Idivf | Ispecific(Isubfrev | Idivfrev)
+        as floatop) ->
+      begin match (is_tos i.arg.(0), is_tos i.arg.(1)) with
+        (true, true) ->
+          (* both operands on top of FP stack *)
+          instr_for_floatop_reversed_pop floatop st0 st1
+      | (true, false) ->
+          (* first operand on stack *)
+          instr_for_floatop floatop (reg i.arg.(1))
+      | (false, true) ->
+          (* second operand on stack *)
+          instr_for_floatop_reversed floatop (reg i.arg.(0))
+      | (false, false) ->
+          (* both operands in memory *)
+          I.fld (reg i.arg.(0));
+          instr_for_floatop floatop (reg i.arg.(1))
+      end
+  | Lop(Ifloatofint) ->
+      begin match i.arg.(0).loc with
+      | Stack _ ->
+          I.fild (reg i.arg.(0))
+      | _ ->
+          I.push (reg i.arg.(0));
+          I.fild (mem32 DWORD 0 RSP);
+          I.add (int 4) esp
+      end
+  | Lop(Iintoffloat) ->
+      if not (is_tos i.arg.(0)) then
+        I.fld (reg i.arg.(0));
+      stack_offset := !stack_offset - 8;
+      I.sub (int 8) esp;
+      cfi_adjust_cfa_offset 8;
+      I.fnstcw (mem32 NONE 4 RSP);
+      I.mov (mem32 WORD 4 RSP) ax;
+      I.mov (int 12) ah;
+      I.mov ax (mem32 WORD 0 RSP);
+      I.fldcw (mem32 NONE 0 RSP);
+      begin match i.res.(0).loc with
+      | Stack _ ->
+          I.fistp (reg i.res.(0))
+      | _ ->
+          I.fistp (mem32 DWORD 0 RSP);
+          I.mov (mem32 DWORD 0 RSP) (reg i.res.(0))
+      end;
+      I.fldcw (mem32 NONE 4 RSP);
+      I.add (int 8) esp;
+      cfi_adjust_cfa_offset (-8);
+      stack_offset := !stack_offset + 8
+  | Lop(Ispecific(Ilea addr)) ->
+      I.lea (addressing addr DWORD i 0) (reg i.res.(0))
+  | Lop(Ispecific(Istore_int(n, addr, _))) ->
+      I.mov (nat n) (addressing addr DWORD i 0)
+  | Lop(Ispecific(Istore_symbol(s, addr, _))) ->
+      add_used_symbol s;
+      I.mov (immsym s) (addressing addr DWORD i 0)
+  | Lop(Ispecific(Ioffset_loc(n, addr))) ->
+      I.add (int n) (addressing addr DWORD i 0)
+  | Lop(Ispecific(Ipush)) ->
+      (* Push arguments in reverse order *)
+      for n = Array.length i.arg - 1 downto 0 do
+        let r = i.arg.(n) in
+        match r with
+          {loc = Reg _; typ = Float} ->
+            I.sub (int 8) esp;
+            cfi_adjust_cfa_offset 8;
+            I.fstp (mem32 REAL8 0 RSP);
+            stack_offset := !stack_offset + 8
+        | {loc = Stack sl; typ = Float} ->
+            let ofs = slot_offset sl 1 in
+            (* Use x87 stack to move from stack to stack,
+               instead of two 32-bit push instructions,
+               which could kill performance on modern CPUs (see #6979).
+            *)
+            I.fld (mem32 REAL8 ofs RSP);
+            I.sub (int 8) esp;
+            cfi_adjust_cfa_offset 8;
+            I.fstp (mem32 REAL8 0 RSP);
+            stack_offset := !stack_offset + 8
+        | _ ->
+            I.push (reg r);
+            cfi_adjust_cfa_offset 4;
+            stack_offset := !stack_offset + 4
+      done
+  | Lop(Ispecific(Ipush_int n)) ->
+      I.push (nat n);
+      cfi_adjust_cfa_offset 4;
+      stack_offset := !stack_offset + 4
+  | Lop(Ispecific(Ipush_symbol s)) ->
+      add_used_symbol s;
+      I.push (immsym s);
+      cfi_adjust_cfa_offset 4;
+      stack_offset := !stack_offset + 4
+  | Lop(Ispecific(Ipush_load addr)) ->
+      I.push (addressing addr DWORD i 0);
+      cfi_adjust_cfa_offset 4;
+      stack_offset := !stack_offset + 4
+  | Lop(Ispecific(Ipush_load_float addr)) ->
+      I.push (addressing (offset_addressing addr 4) DWORD i 0);
+      I.push (addressing addr DWORD i 0);
+      cfi_adjust_cfa_offset 8;
+      stack_offset := !stack_offset + 8
+  | Lop(Ispecific(Ifloatarithmem(double, op, addr))) ->
+      if not (is_tos i.arg.(0)) then
+        I.fld (reg i.arg.(0));
+      instr_for_floatarithmem op
+          (addressing addr
+             (if double then REAL8 else REAL4) i 1)
+  | Lop(Ispecific(Ifloatspecial s)) ->
+      (* Push args on float stack if necessary *)
+      for k = 0 to Array.length i.arg - 1 do
+        if not (is_tos i.arg.(k)) then I.fld (reg i.arg.(k))
+      done;
+      (* Fix-up for binary instrs whose args were swapped *)
+      if Array.length i.arg = 2 && is_tos i.arg.(1) then
+        I.fxch st1;
+      emit_floatspecial s
+  | Lop (Iname_for_debugger _) -> ()
+  | Lreloadretaddr ->
+      ()
+  | Lreturn ->
+      output_epilogue begin fun () ->
+        I.ret ()
+      end
+  | Llabel lbl ->
+      emit_Llabel fallthrough lbl
+  | Lbranch lbl ->
+      I.jmp (label lbl)
+  | Lcondbranch(tst, lbl) ->
+      let lbl = label lbl in
+      begin match tst with
+      | Itruetest ->
+          output_test_zero i.arg.(0);
+          I.jne lbl;
+      | Ifalsetest ->
+          output_test_zero i.arg.(0);
+          I.je lbl
+      | Iinttest cmp ->
+          I.cmp (reg i.arg.(1)) (reg i.arg.(0));
+          I.j (cond cmp) lbl
+      | Iinttest_imm((Isigned Ceq | Isigned Cne |
+                      Iunsigned Ceq | Iunsigned Cne) as cmp, 0) ->
+          output_test_zero i.arg.(0);
+          I.j (cond cmp) lbl
+      | Iinttest_imm(cmp, n) ->
+          I.cmp (int n) (reg i.arg.(0));
+          I.j (cond cmp) lbl
+      | Ifloattest cmp ->
+          emit_float_test cmp i.arg lbl
+      | Ioddtest ->
+          I.test (int 1) (reg i.arg.(0));
+          I.jne lbl
+      | Ieventest ->
+          I.test (int 1) (reg i.arg.(0));
+          I.je lbl
+      end
+  | Lcondbranch3(lbl0, lbl1, lbl2) ->
+      I.cmp (int 1) (reg i.arg.(0));
+      begin match lbl0 with
+        None -> ()
+      | Some lbl -> I.jb (label lbl)
+      end;
+      begin match lbl1 with
+        None -> ()
+      | Some lbl -> I.je (label lbl)
+      end;
+      begin match lbl2 with
+        None -> ()
+      | Some lbl -> I.ja (label lbl)
+      end
+  | Lswitch jumptbl ->
+      let lbl = new_label() in
+      I.jmp (mem32 NONE 0 (reg32 i.arg.(0)) ~scale:4 ~sym:(emit_label lbl));
+      D.data ();
+      _label (emit_label lbl);
+      for i = 0 to Array.length jumptbl - 1 do
+        D.long (ConstLabel (emit_label jumptbl.(i)))
+      done;
+      emit_named_text_section !function_name
+  | Lentertrap ->
+      ()
+  | Ladjust_trap_depth { delta_traps } ->
+      let delta = trap_frame_size * delta_traps in
+      cfi_adjust_cfa_offset delta;
+      stack_offset := !stack_offset + delta
+  | Lpushtrap { lbl_handler; } ->
+      I.push (label lbl_handler);
+      if trap_frame_size > 8 then
+        I.sub (int (trap_frame_size - 8)) esp;
+      load_domain_state edx;
+      I.push (domain_field Domain_exception_pointer RDX);
+      cfi_adjust_cfa_offset trap_frame_size;
+      I.mov esp (domain_field Domain_exception_pointer RDX);
+      stack_offset := !stack_offset + trap_frame_size
+  | Lpoptrap ->
+      I.mov edx (mem32 DWORD 4 RSP);
+      load_domain_state edx;
+      I.pop (domain_field Domain_exception_pointer RDX);
+      I.pop edx;
+      if trap_frame_size > 8 then
+        I.add (int (trap_frame_size - 8)) esp;
+      cfi_adjust_cfa_offset (-trap_frame_size);
+      stack_offset := !stack_offset - trap_frame_size
+  | Lraise k  ->
+      begin match k with
+      | Lambda.Raise_regular ->
+          load_domain_state ebx;
+          I.mov (int 0) (domain_field Domain_backtrace_pos RBX);
+          emit_call "caml_raise_exn";
+          record_frame Reg.Set.empty (Dbg_raise i.dbg)
+      | Lambda.Raise_reraise ->
+          emit_call "caml_raise_exn";
+          record_frame Reg.Set.empty (Dbg_raise i.dbg)
+      | Lambda.Raise_notrace ->
+          load_domain_state ebx;
+          I.mov (domain_field Domain_exception_pointer RBX) esp;
+          I.pop (domain_field Domain_exception_pointer RBX);
+          if trap_frame_size > 8 then
+            I.add (int (trap_frame_size - 8)) esp;
+          I.pop ebx;
+          I.jmp ebx
+      end
+
+let rec emit_all fallthrough i =
+  match i.desc with
+  |  Lend -> ()
+  | _ ->
+      emit_instr fallthrough i;
+      emit_all
+        (system = S_win32 || Linear.has_fallthrough i.desc)
+        i.next
+
+(* Emission of a function declaration *)
+
+let fundecl fundecl =
+  function_name := fundecl.fun_name;
+  fastcode_flag := fundecl.fun_fast;
+  tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
+  stack_offset := 0;
+  call_gc_sites := [];
+  bound_error_sites := [];
+  bound_error_call := 0;
+  for i = 0 to Proc.num_register_classes - 1 do
+    num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
+  done;
+  prologue_required := fundecl.fun_prologue_required;
+  emit_named_text_section !function_name;
+  add_def_symbol fundecl.fun_name;
+  D.align (if system = S_win32 then 4 else 16);
+  D.global (emit_symbol fundecl.fun_name);
+  D.label (emit_symbol fundecl.fun_name);
+  emit_debug_info fundecl.fun_dbg;
+  cfi_startproc ();
+  emit_all true fundecl.fun_body;
+  List.iter emit_call_gc !call_gc_sites;
+  emit_call_bound_errors ();
+  cfi_endproc ();
+  begin match system with
+  | S_linux_elf | S_bsd_elf | S_gnu ->
+      D.type_ (emit_symbol fundecl.fun_name) "@function";
+      D.size (emit_symbol fundecl.fun_name)
+        (ConstSub (
+            ConstThis,
+            ConstLabel (emit_symbol fundecl.fun_name)))
+  | _ -> ()
+  end
+
+
+(* Emission of data *)
+
+let emit_item = function
+  | Cglobal_symbol s -> D.global (emit_symbol s)
+  | Cdefine_symbol s -> add_def_symbol s; _label (emit_symbol s)
+  | Cint8 n -> D.byte (const n)
+  | Cint16 n -> D.word (const n)
+  | Cint32 n -> D.long (const_nat n)
+  | Cint n -> D.long (const_nat n)
+  | Csingle f -> D.long (Const (Int64.of_int32 (Int32.bits_of_float f)))
+  | Cdouble f -> emit_float64_split_directive (Int64.bits_of_float f)
+  | Csymbol_address s -> add_used_symbol s; D.long (ConstLabel (emit_symbol s))
+  | Cstring s -> D.bytes s
+  | Cskip n -> if n > 0 then D.space n
+  | Calign n -> D.align n
+
+let data l =
+  D.data ();
+  List.iter emit_item l
+
+(* Beginning / end of an assembly file *)
+
+let begin_assembly() =
+  X86_proc.reset_asm_code ();
+  reset_debug_info();                   (* PR#5603 *)
+  float_constants := [];
+  if system = S_win32 then begin
+    D.mode386 ();
+    D.model "FLAT";
+    D.extrn "_caml_extra_params" DWORD;
+    D.extrn "_caml_call_gc" PROC;
+    D.extrn "_caml_c_call" PROC;
+    D.extrn "_caml_allocN" PROC;
+    D.extrn "_caml_alloc1" PROC;
+    D.extrn "_caml_alloc2" PROC;
+    D.extrn "_caml_alloc3" PROC;
+    D.extrn "_caml_ml_array_bound_error" PROC;
+    D.extrn "_caml_raise_exn" PROC;
+    D.extrn "_Caml_state" DWORD;
+  end;
+
+  D.data ();
+  emit_global_label "data_begin";
+  emit_named_text_section (Compilenv.make_symbol (Some "code_begin"));
+  emit_global_label "code_begin"
+
+let end_assembly() =
+  if !float_constants <> [] then begin
+    D.data ();
+    List.iter (fun (cst,lbl) -> emit_float_constant cst lbl) !float_constants
+  end;
+
+  emit_named_text_section (Compilenv.make_symbol (Some "code_end"));
+  emit_global_label "code_end";
+
+  D.data ();
+  D.long (const 0);  (* PR#6329 *)
+  emit_global_label "data_end";
+  D.long (const 0);
+
+  emit_global_label "frametable";
+
+  emit_frames
+    { efa_code_label = (fun l -> D.long (ConstLabel (emit_label l)));
+      efa_data_label = (fun l -> D.long (ConstLabel (emit_label l)));
+      efa_8 = (fun n -> D.byte (const n));
+      efa_16 = (fun n -> D.word (const n));
+      efa_32 = (fun n -> D.long (const_32 n));
+      efa_word = (fun n -> D.long (const n));
+      efa_align = D.align;
+      efa_label_rel = (fun lbl ofs ->
+          D.long (ConstAdd (
+              ConstSub(ConstLabel(emit_label lbl),
+                       ConstThis),
+              const_32 ofs)));
+      efa_def_label = (fun l -> _label (emit_label l));
+      efa_string = (fun s -> D.bytes (s ^ "\000"))
+    };
+
+  if system = S_linux_elf then
+    (* Mark stack as non-executable, PR#4564 *)
+    D.section [".note.GNU-stack"] (Some "") ["%progbits"];
+
+  if system = S_win32 then begin
+    D.comment "External functions";
+    String.Set.iter
+      (fun s ->
+         if not (String.Set.mem s !symbols_defined) then
+           D.extrn (emit_symbol s) PROC)
+      !symbols_used;
+    symbols_used := String.Set.empty;
+    symbols_defined := String.Set.empty;
+  end;
+
+  let asm =
+    if !Emitaux.create_asm_file then
+      Some
+        (
+         (if X86_proc.masm then X86_masm.generate_asm
+          else X86_gas.generate_asm) !Emitaux.output_channel
+        )
+    else
+      None
+  in
+  X86_proc.generate_code asm
diff --git a/asmcomp/i386/proc.ml b/asmcomp/i386/proc.ml
new file mode 100644
index 00000000..e3e114a6
--- /dev/null
+++ b/asmcomp/i386/proc.ml
@@ -0,0 +1,260 @@
+# 2 "asmcomp/i386/proc.ml"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Description of the Intel 386 processor *)
+
+open Misc
+open Arch
+open Cmm
+open Reg
+open Mach
+
+(* Which asm conventions to use *)
+let masm =
+  match Config.ccomp_type with
+  | "msvc" -> true
+  | _      -> false
+
+(* Registers available for register allocation *)
+
+(* Register map:
+    eax         0               eax - edi: function arguments and results
+    ebx         1               eax: C function results
+    ecx         2               ebx, esi, edi, ebp: preserved by C
+    edx         3
+    esi         4
+    edi         5
+    ebp         6
+
+    tos         100             top of floating-point stack. *)
+
+let int_reg_name =
+  if masm then
+    [| "eax"; "ebx"; "ecx"; "edx"; "esi"; "edi"; "ebp" |]
+  else
+    [| "%eax"; "%ebx"; "%ecx"; "%edx"; "%esi"; "%edi"; "%ebp" |]
+
+let float_reg_name =
+  if masm then
+    [| "tos" |]
+  else
+    [| "%tos" |]
+
+let num_register_classes = 2
+
+let register_class r =
+  match r.typ with
+  | Val | Int | Addr -> 0
+  | Float -> 1
+
+let num_available_registers = [| 7; 0 |]
+
+let first_available_register = [| 0; 100 |]
+
+let register_name r =
+  if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100)
+
+(* There is little scheduling, and some operations are more compact
+   when their argument is %eax. *)
+
+let rotate_registers = false
+
+(* Representation of hard registers by pseudo-registers *)
+
+let hard_int_reg =
+  let v = Array.make 7 Reg.dummy in
+  for i = 0 to 6 do v.(i) <- Reg.at_location Int (Reg i) done;
+  v
+
+let hard_float_reg = [| Reg.at_location Float (Reg 100) |]
+
+let all_phys_regs =
+  Array.append hard_int_reg hard_float_reg
+
+let phys_reg n =
+  if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
+
+let eax = phys_reg 0
+let ebx = phys_reg 1
+let ecx = phys_reg 2
+let edx = phys_reg 3
+
+let stack_slot slot ty =
+  Reg.at_location ty (Stack slot)
+
+let loc_spacetime_node_hole = Reg.dummy  (* Spacetime unsupported *)
+
+(* Instruction selection *)
+
+let word_addressed = false
+
+(* Calling conventions *)
+
+(* To supplement the processor's meagre supply of registers, we also
+   use some global memory locations to pass arguments beyond the 6th.
+   These globals are denoted by Incoming and Outgoing stack locations
+   with negative offsets, starting at -64.
+   Unlike arguments passed on stack, arguments passed in globals
+   do not prevent tail-call elimination.  The caller stores arguments
+   in these globals immediately before the call, and the first thing the
+   callee does is copy them to registers or stack locations.
+   Neither GC nor thread context switches can occur between these two
+   times. *)
+
+let calling_conventions first_int last_int first_float last_float make_stack
+                        arg =
+  let loc = Array.make (Array.length arg) Reg.dummy in
+  let int = ref first_int in
+  let float = ref first_float in
+  let ofs = ref (-64) in
+  for i = 0 to Array.length arg - 1 do
+    match arg.(i).typ with
+      Val | Int | Addr as ty ->
+        if !int <= last_int then begin
+          loc.(i) <- phys_reg !int;
+          incr int
+        end else begin
+          loc.(i) <- stack_slot (make_stack !ofs) ty;
+          ofs := !ofs + size_int
+        end
+    | Float ->
+        if !float <= last_float then begin
+          loc.(i) <- phys_reg !float;
+          incr float
+        end else begin
+          loc.(i) <- stack_slot (make_stack !ofs) Float;
+          ofs := !ofs + size_float
+        end
+  done;
+  (loc, Misc.align (max 0 !ofs) stack_alignment)
+
+let incoming ofs = Incoming ofs
+let outgoing ofs = Outgoing ofs
+let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
+
+(* Six arguments in integer registers plus eight in global memory. *)
+let max_arguments_for_tailcalls = 14
+
+let loc_arguments arg =
+  calling_conventions 0 5 100 99 outgoing arg
+let loc_parameters arg =
+  let (loc, _ofs) = calling_conventions 0 5 100 99 incoming arg in loc
+let loc_results res =
+  let (loc, _ofs) = calling_conventions 0 5 100 100 not_supported res in loc
+let loc_external_arguments _arg =
+  fatal_error "Proc.loc_external_arguments"
+let loc_external_results res =
+  match res with
+  | [|{typ=Int};{typ=Int}|] -> [|eax; edx|]
+  | _ ->
+      let (loc, _ofs) = calling_conventions 0 0 100 100 not_supported res in loc
+
+let loc_exn_bucket = eax
+
+(* See "System V Application Binary Interface Intel386 Architecture
+   Processor Supplement Version 1.0"
+   (https://www.uclibc.org/docs/psABI-i386.pdf) *)
+
+let int_dwarf_reg_numbers = [| 0; 3; 1; 2; 6; 7; 5 |]
+
+let float_dwarf_reg_numbers = [| |]
+
+let dwarf_register_numbers ~reg_class =
+  match reg_class with
+  | 0 -> int_dwarf_reg_numbers
+  | 1 -> float_dwarf_reg_numbers
+  | _ -> Misc.fatal_errorf "Bad register class %d" reg_class
+
+let stack_ptr_dwarf_register_number = 4
+
+(* Volatile registers: the x87 top of FP stack is *)
+
+let reg_is_volatile = function
+  | { typ = Float; loc = Reg _ } -> true
+  | _ -> false
+
+let regs_are_volatile rs =
+  try
+    for i = 0 to Array.length rs - 1 do
+      if reg_is_volatile rs.(i) then raise Exit
+    done;
+    false
+  with Exit ->
+    true
+
+(* Registers destroyed by operations *)
+
+let destroyed_at_c_call =               (* ebx, esi, edi, ebp preserved *)
+  [|eax; ecx; edx|]
+
+let destroyed_at_oper = function
+    Iop(Icall_ind _ | Icall_imm _ | Iextcall { alloc = true; _}) ->
+    all_phys_regs
+  | Iop(Iextcall { alloc = false; }) -> destroyed_at_c_call
+  | Iop(Iintop(Idiv | Imod)) -> [| eax; edx |]
+  | Iop(Ialloc _) -> [| eax; ebx |]
+  | Iop(Iintop Imulh) -> [| eax |]
+  | Iop(Iintop(Icomp _) | Iintop_imm(Icomp _, _)) -> [| eax |]
+  | Iop(Iintoffloat) -> [| eax |]
+  | Iifthenelse(Ifloattest _, _, _) -> [| eax |]
+  | Itrywith _ -> [| edx |]
+  | _ -> [||]
+
+let destroyed_at_raise = all_phys_regs
+
+let destroyed_at_reloadretaddr = [| |]
+
+(* Maximal register pressure *)
+
+let safe_register_pressure _op = 4
+
+let max_register_pressure = function
+    Iextcall _ -> [| 4; max_int |]
+  | Iintop(Idiv | Imod) -> [| 5; max_int |]
+  | Ialloc _ | Iintop(Icomp _) | Iintop_imm(Icomp _, _) |
+    Iintoffloat -> [| 6; max_int |]
+  | _ -> [|7; max_int |]
+
+(* Pure operations (without any side effect besides updating their result
+   registers).  *)
+
+let op_is_pure = function
+  | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
+  | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false
+  | Ispecific(Ilea _) -> true
+  | Ispecific _ -> false
+  | _ -> true
+
+(* Layout of the stack frame *)
+
+let frame_required fd =
+  let frame_size_at_top_of_function =
+    (* cf. [frame_size] in emit.mlp. *)
+    Misc.align (4*fd.fun_num_stack_slots.(0) + 8*fd.fun_num_stack_slots.(1) + 4)
+      stack_alignment
+  in
+  frame_size_at_top_of_function > 4
+
+let prologue_required fd =
+  frame_required fd
+
+(* Calling the assembler *)
+
+let assemble_file infile outfile =
+  X86_proc.assemble_file infile outfile
+
+let init () = ()
diff --git a/asmcomp/i386/reload.ml b/asmcomp/i386/reload.ml
new file mode 100644
index 00000000..a95e67c6
--- /dev/null
+++ b/asmcomp/i386/reload.ml
@@ -0,0 +1,86 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Cmm
+open Arch
+open Reg
+open Mach
+
+(* Reloading for the Intel x86 *)
+
+let stackp r =
+  match r.loc with
+    Stack _ -> true
+  | _ -> false
+
+class reload = object (self)
+
+inherit Reloadgen.reload_generic as super
+
+method! makereg r =
+  match r.typ with
+    Float -> r
+  | _ -> super#makereg r
+
+(* By overriding makereg, we make sure that pseudoregs of type float
+   will never be reloaded. Hence there is no need to make special cases for
+   floating-point operations. *)
+
+method! reload_operation op arg res =
+  match op with
+    Iintop(Iadd|Isub|Iand|Ior|Ixor|Icomp _|Icheckbound _) ->
+      (* One of the two arguments can reside in the stack *)
+      if stackp arg.(0) && stackp arg.(1)
+      then ([|arg.(0); self#makereg arg.(1)|], res)
+      else (arg, res)
+  | Iintop(Imul) ->
+      (* First argument (and destination) must be in register,
+         second arg can reside in stack *)
+      if stackp arg.(0)
+      then let r = self#makereg arg.(0) in ([|r; arg.(1)|], [|r|])
+      else (arg, res)
+  | Iintop_imm(Iadd, _) when arg.(0).loc <> res.(0).loc ->
+      (* This add will be turned into a lea; args and results must be
+         in registers *)
+      super#reload_operation op arg res
+  | Iintop_imm(Imul, _) ->
+      (* First argument and destination must be in register *)
+      if stackp arg.(0)
+      then let r = self#makereg arg.(0) in ([|r|], [|r|])
+      else (arg, res)
+  | Iintop(Imulh | Ilsl | Ilsr | Iasr) | Iintop_imm(_, _)
+  | Ifloatofint | Iintoffloat | Ispecific(Ipush) ->
+      (* The argument(s) can be either in register or on stack *)
+      (* Note: Imulh: arg(0 and res(0) already forced in regs
+               Ilsl, Ilsr, Iasr: arg(1) already forced in regs *)
+      (arg, res)
+  | _ -> (* Other operations: all args and results in registers *)
+      super#reload_operation op arg res
+
+method! reload_test tst arg =
+  match tst with
+    Iinttest _ ->
+      (* One of the two arguments can reside on stack *)
+      if stackp arg.(0) && stackp arg.(1)
+      then [| self#makereg arg.(0); arg.(1) |]
+      else arg
+  | _ ->
+      (* The argument(s) can be either in register or on stack *)
+      arg
+
+end
+
+let fundecl f num_stack_slots =
+  (new reload)#fundecl f num_stack_slots
diff --git a/asmcomp/i386/scheduling.ml b/asmcomp/i386/scheduling.ml
new file mode 100644
index 00000000..c6c9a324
--- /dev/null
+++ b/asmcomp/i386/scheduling.ml
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open! Schedgen (* to create a dependency *)
+
+(* Scheduling is turned off because our model does not fit the 486
+   nor the Pentium very well. In particular, it messes up with the
+   float reg stack. The Pentiums Pro / II / III / etc schedule
+   at run-time much better than what we could do. *)
+
+let fundecl f = f
diff --git a/asmcomp/i386/selection.ml b/asmcomp/i386/selection.ml
new file mode 100644
index 00000000..59b5e2e2
--- /dev/null
+++ b/asmcomp/i386/selection.ml
@@ -0,0 +1,328 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Instruction selection for the Intel x86 *)
+
+open Misc
+open Arch
+open Proc
+open Cmm
+open Mach
+
+(* Auxiliary for recognizing addressing modes *)
+
+type addressing_expr =
+    Asymbol of string
+  | Alinear of expression
+  | Aadd of expression * expression
+  | Ascale of expression * int
+  | Ascaledadd of expression * expression * int
+
+let rec select_addr exp =
+  match exp with
+    Cconst_symbol (s, _) ->
+      (Asymbol s, 0)
+  | Cop((Caddi | Caddv | Cadda), [arg; Cconst_int (m, _)], _) ->
+      let (a, n) = select_addr arg in (a, n + m)
+  | Cop(Csubi, [arg; Cconst_int (m, _)], _) ->
+      let (a, n) = select_addr arg in (a, n - m)
+  | Cop((Caddi | Caddv | Cadda), [Cconst_int (m, _); arg], _) ->
+      let (a, n) = select_addr arg in (a, n + m)
+  | Cop(Clsl, [arg; Cconst_int ((1|2|3 as shift), _)], _) ->
+      begin match select_addr arg with
+        (Alinear e, n) -> (Ascale(e, 1 lsl shift), n lsl shift)
+      | _ -> (Alinear exp, 0)
+      end
+  | Cop(Cmuli, [arg; Cconst_int ((2|4|8 as mult), _)], _) ->
+      begin match select_addr arg with
+        (Alinear e, n) -> (Ascale(e, mult), n * mult)
+      | _ -> (Alinear exp, 0)
+      end
+  | Cop(Cmuli, [Cconst_int ((2|4|8 as mult), _); arg], _) ->
+      begin match select_addr arg with
+        (Alinear e, n) -> (Ascale(e, mult), n * mult)
+      | _ -> (Alinear exp, 0)
+      end
+  | Cop((Caddi | Cadda | Caddv), [arg1; arg2], _) ->
+      begin match (select_addr arg1, select_addr arg2) with
+          ((Alinear e1, n1), (Alinear e2, n2)) ->
+              (Aadd(e1, e2), n1 + n2)
+        | ((Alinear e1, n1), (Ascale(e2, scale), n2)) ->
+              (Ascaledadd(e1, e2, scale), n1 + n2)
+        | ((Ascale(e1, scale), n1), (Alinear e2, n2)) ->
+              (Ascaledadd(e2, e1, scale), n1 + n2)
+        | (_, (Ascale(e2, scale), n2)) ->
+              (Ascaledadd(arg1, e2, scale), n2)
+        | ((Ascale(e1, scale), n1), _) ->
+              (Ascaledadd(arg2, e1, scale), n1)
+        | _ ->
+              (Aadd(arg1, arg2), 0)
+      end
+  | arg ->
+      (Alinear arg, 0)
+
+(* C functions to be turned into Ifloatspecial instructions if -ffast-math.
+   If you update this list, you may need to update [is_simple_expr] and/or
+   [effects_of], below. *)
+let inline_float_ops =
+  ["atan"; "atan2"; "cos"; "log"; "log10"; "sin"; "sqrt"; "tan"]
+
+(* Estimate number of float temporaries needed to evaluate expression
+   (Ershov's algorithm) *)
+
+let rec float_needs = function
+    Cop((Cnegf | Cabsf), [arg], _) ->
+      float_needs arg
+  | Cop((Caddf | Csubf | Cmulf | Cdivf), [arg1; arg2], _) ->
+      let n1 = float_needs arg1 in
+      let n2 = float_needs arg2 in
+      if n1 = n2 then 1 + n1 else if n1 > n2 then n1 else n2
+  | Cop(Cextcall(fn, _ty_res, _alloc, _label), args, _dbg)
+    when !fast_math && List.mem fn inline_float_ops ->
+      begin match args with
+        [arg] -> float_needs arg
+      | [arg1; arg2] -> max (float_needs arg2 + 1) (float_needs arg1)
+      | _ -> assert false
+      end
+  | _ ->
+      1
+
+(* Special constraints on operand and result registers *)
+
+exception Use_default
+
+let eax = phys_reg 0
+let ecx = phys_reg 2
+let edx = phys_reg 3
+let tos = phys_reg 100
+
+let pseudoregs_for_operation op arg res =
+  match op with
+  (* Two-address binary operations *)
+    Iintop(Iadd|Isub|Imul|Iand|Ior|Ixor) ->
+      ([|res.(0); arg.(1)|], res, false)
+  (* Two-address unary operations *)
+  | Iintop_imm((Iadd|Isub|Imul|Iand|Ior|Ixor|Ilsl|Ilsr|Iasr), _) ->
+      (res, res, false)
+  (* For imull, first arg must be in eax, eax is clobbered, and result is in
+     edx. *)
+  | Iintop(Imulh) ->
+      ([| eax; arg.(1) |], [| edx |], true)
+  (* For shifts with variable shift count, second arg must be in ecx *)
+  | Iintop(Ilsl|Ilsr|Iasr) ->
+      ([|res.(0); ecx|], res, false)
+  (* For div and mod, first arg must be in eax, edx is clobbered,
+     and result is in eax or edx respectively.
+     Keep it simple, just force second argument in ecx. *)
+  | Iintop(Idiv) ->
+      ([| eax; ecx |], [| eax |], true)
+  | Iintop(Imod) ->
+      ([| eax; ecx |], [| edx |], true)
+  (* For floating-point operations and floating-point loads,
+     the result is always left at the top of the floating-point stack *)
+  | Iconst_float _ | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
+  | Ifloatofint | Iload((Single | Double | Double_u), _)
+  | Ispecific(Isubfrev | Idivfrev | Ifloatarithmem _ | Ifloatspecial _) ->
+      (arg, [| tos |], false)           (* don't move it immediately *)
+  (* For storing a byte, the argument must be in eax...edx.
+     (But for a short, any reg will do!)
+     Keep it simple, just force the argument to be in edx. *)
+  | Istore((Byte_unsigned | Byte_signed), _, _) ->
+      let newarg = Array.copy arg in
+      newarg.(0) <- edx;
+      (newarg, res, false)
+  (* Other instructions are regular *)
+  | _ -> raise Use_default
+
+let chunk_double = function
+    Single -> false
+  | Double -> true
+  | Double_u -> true
+  | _ -> assert false
+
+(* The selector class *)
+
+class selector = object (self)
+
+inherit Selectgen.selector_generic as super
+
+method is_immediate (_n : int) = true
+
+method! is_simple_expr e =
+  match e with
+  | Cop(Cextcall(fn, _, _alloc, _), args, _)
+    when !fast_math && List.mem fn inline_float_ops ->
+      (* inlined float ops are simple if their arguments are *)
+      List.for_all self#is_simple_expr args
+  | _ ->
+      super#is_simple_expr e
+
+method! effects_of e =
+  match e with
+  | Cop(Cextcall(fn, _, _, _), args, _)
+    when !fast_math && List.mem fn inline_float_ops ->
+      Selectgen.Effect_and_coeffect.join_list_map args self#effects_of
+  | _ ->
+      super#effects_of e
+
+method select_addressing _chunk exp =
+  match select_addr exp with
+    (Asymbol s, d) ->
+      (Ibased(s, d), Ctuple [])
+  | (Alinear e, d) ->
+      (Iindexed d, e)
+  | (Aadd(e1, e2), d) ->
+      (Iindexed2 d, Ctuple[e1; e2])
+  | (Ascale(e, scale), d) ->
+      (Iscaled(scale, d), e)
+  | (Ascaledadd(e1, e2, scale), d) ->
+      (Iindexed2scaled(scale, d), Ctuple[e1; e2])
+
+method! select_store is_assign addr exp =
+  match exp with
+    Cconst_int (n, _) ->
+      (Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
+  | (Cconst_natint (n, _) | Cblockheader (n, _)) ->
+      (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
+  | Cconst_pointer (n, _) ->
+      (Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
+  | Cconst_natpointer (n, _) ->
+      (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
+  | Cconst_symbol (s, _) ->
+      (Ispecific(Istore_symbol(s, addr, is_assign)), Ctuple [])
+  | _ ->
+      super#select_store is_assign addr exp
+
+method! select_operation op args dbg =
+  match op with
+  (* Recognize the LEA instruction *)
+    Caddi | Caddv | Cadda | Csubi ->
+      begin match self#select_addressing Word_int (Cop(op, args, dbg)) with
+        (Iindexed _, _)
+      | (Iindexed2 0, _) -> super#select_operation op args dbg
+      | (addr, arg) -> (Ispecific(Ilea addr), [arg])
+      end
+  (* Recognize float arithmetic with memory.
+     In passing, apply Ershov's algorithm to reduce stack usage *)
+  | Caddf ->
+      self#select_floatarith Iaddf Iaddf Ifloatadd Ifloatadd args
+  | Csubf ->
+      self#select_floatarith Isubf (Ispecific Isubfrev) Ifloatsub Ifloatsubrev
+                             args
+  | Cmulf ->
+      self#select_floatarith Imulf Imulf Ifloatmul Ifloatmul args
+  | Cdivf ->
+      self#select_floatarith Idivf (Ispecific Idivfrev) Ifloatdiv Ifloatdivrev
+                             args
+  (* Recognize store instructions *)
+  | Cstore ((Word_int | Word_val) as chunk, _) ->
+      begin match args with
+        [loc; Cop(Caddi, [Cop(Cload _, [loc'], _); Cconst_int (n, _)], _)]
+        when loc = loc' ->
+          let (addr, arg) = self#select_addressing chunk loc in
+          (Ispecific(Ioffset_loc(n, addr)), [arg])
+      | _ ->
+          super#select_operation op args dbg
+      end
+  (* Recognize inlined floating point operations *)
+  | Cextcall(fn, _ty_res, false, _label)
+    when !fast_math && List.mem fn inline_float_ops ->
+      (Ispecific(Ifloatspecial fn), args)
+  (* i386 does not support immediate operands for multiply high signed *)
+  | Cmulhi ->
+      (Iintop Imulh, args)
+  (* Default *)
+  | _ -> super#select_operation op args dbg
+
+(* Recognize float arithmetic with mem *)
+
+method select_floatarith regular_op reversed_op mem_op mem_rev_op args =
+  match args with
+    [arg1; Cop(Cload (chunk, _), [loc2], _)] ->
+      let (addr, arg2) = self#select_addressing chunk loc2 in
+      (Ispecific(Ifloatarithmem(chunk_double chunk, mem_op, addr)),
+                 [arg1; arg2])
+  | [Cop(Cload (chunk, _), [loc1], _); arg2] ->
+      let (addr, arg1) = self#select_addressing chunk loc1 in
+      (Ispecific(Ifloatarithmem(chunk_double chunk, mem_rev_op, addr)),
+                 [arg2; arg1])
+  | [arg1; arg2] ->
+      (* Evaluate bigger subexpression first to minimize stack usage.
+         Because of right-to-left evaluation, rightmost arg is evaluated
+         first *)
+      if float_needs arg1 <= float_needs arg2
+      then (regular_op, [arg1; arg2])
+      else (reversed_op, [arg2; arg1])
+  | _ ->
+      fatal_error "Proc_i386: select_floatarith"
+
+(* Deal with register constraints *)
+
+method! insert_op_debug env op dbg rs rd =
+  try
+    let (rsrc, rdst, move_res) = pseudoregs_for_operation op rs rd in
+    self#insert_moves env rs rsrc;
+    self#insert_debug env (Iop op) dbg rsrc rdst;
+    if move_res then begin
+      self#insert_moves env rdst rd;
+      rd
+    end else
+      rdst
+  with Use_default ->
+    super#insert_op_debug env op dbg rs rd
+
+(* Selection of push instructions for external calls *)
+
+method select_push exp =
+  match exp with
+    Cconst_int (n, _) -> (Ispecific(Ipush_int(Nativeint.of_int n)), Ctuple [])
+  | Cconst_natint (n, _) -> (Ispecific(Ipush_int n), Ctuple [])
+  | Cconst_pointer (n, _) ->
+      (Ispecific(Ipush_int(Nativeint.of_int n)), Ctuple [])
+  | Cconst_natpointer (n, _) -> (Ispecific(Ipush_int n), Ctuple [])
+  | Cconst_symbol (s, _) -> (Ispecific(Ipush_symbol s), Ctuple [])
+  | Cop(Cload ((Word_int | Word_val as chunk), _), [loc], _) ->
+      let (addr, arg) = self#select_addressing chunk loc in
+      (Ispecific(Ipush_load addr), arg)
+  | Cop(Cload (Double_u, _), [loc], _) ->
+      let (addr, arg) = self#select_addressing Double_u loc in
+      (Ispecific(Ipush_load_float addr), arg)
+  | _ -> (Ispecific(Ipush), exp)
+
+method! mark_c_tailcall =
+  contains_calls := true
+
+method! emit_extcall_args env args =
+  let rec size_pushes = function
+  | [] -> 0
+  | e :: el -> Selectgen.size_expr env e + size_pushes el in
+  let sz1 = size_pushes args in
+  let sz2 = Misc.align sz1 stack_alignment in
+  let rec emit_pushes = function
+  | [] ->
+      if sz2 > sz1 then
+        self#insert env (Iop (Istackoffset (sz2 - sz1))) [||] [||]
+  | e :: el ->
+      emit_pushes el;
+      let (op, arg) = self#select_push e in
+      match self#emit_expr env arg with
+      | None -> ()
+      | Some r -> self#insert env (Iop op) r [||] in
+  emit_pushes args;
+  ([||], sz2)
+
+end
+
+let fundecl f = (new selector)#emit_fundecl f
diff --git a/asmcomp/interf.ml b/asmcomp/interf.ml
new file mode 100644
index 00000000..8c848849
--- /dev/null
+++ b/asmcomp/interf.ml
@@ -0,0 +1,196 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Construction of the interference graph.
+   Annotate pseudoregs with interference lists and preference lists. *)
+
+module IntPairSet =
+  Set.Make(struct
+    type t = int * int
+    let compare ((a1,b1) : t) (a2,b2) =
+      match compare a1 a2 with
+        | 0 -> compare b1 b2
+        | c -> c
+  end)
+
+open Reg
+open Mach
+
+let build_graph fundecl =
+
+  (* The interference graph is represented in two ways:
+     - by adjacency lists for each register
+     - by a sparse bit matrix (a set of pairs of register stamps) *)
+
+  let mat = ref IntPairSet.empty in
+
+  (* Record an interference between two registers *)
+  let add_interf ri rj =
+    if Proc.register_class ri = Proc.register_class rj then begin
+      let i = ri.stamp and j = rj.stamp in
+      if i <> j then begin
+        let p = if i < j then (i, j) else (j, i) in
+        if not(IntPairSet.mem p !mat) then begin
+          mat := IntPairSet.add p !mat;
+          if ri.loc = Unknown then begin
+            ri.interf <- rj :: ri.interf;
+            if not rj.spill then ri.degree <- ri.degree + 1
+          end;
+          if rj.loc = Unknown then begin
+            rj.interf <- ri :: rj.interf;
+            if not ri.spill then rj.degree <- rj.degree + 1
+          end
+        end
+      end
+    end in
+
+  (* Record interferences between a register array and a set of registers *)
+  let add_interf_set v s =
+    for i = 0 to Array.length v - 1 do
+      let r1 = v.(i) in
+      Reg.Set.iter (add_interf r1) s
+    done in
+
+  (* Record interferences between elements of an array *)
+  let add_interf_self v =
+    for i = 0 to Array.length v - 2 do
+      let ri = v.(i) in
+      for j = i+1 to Array.length v - 1 do
+        add_interf ri v.(j)
+      done
+    done in
+
+  (* Record interferences between the destination of a move and a set
+     of live registers. Since the destination is equal to the source,
+     do not add an interference between them if the source is still live
+     afterwards. *)
+  let add_interf_move src dst s =
+    Reg.Set.iter (fun r -> if r.stamp <> src.stamp then add_interf dst r) s in
+
+  (* Compute interferences *)
+
+  let rec interf i =
+    let destroyed = Proc.destroyed_at_oper i.desc in
+    if Array.length destroyed > 0 then add_interf_set destroyed i.live;
+    match i.desc with
+      Iend -> ()
+    | Ireturn -> ()
+    | Iop(Imove | Ispill | Ireload) ->
+        add_interf_move i.arg.(0) i.res.(0) i.live;
+        interf i.next
+    | Iop(Itailcall_ind _) -> ()
+    | Iop(Itailcall_imm _) -> ()
+    | Iop _ ->
+        add_interf_set i.res i.live;
+        add_interf_self i.res;
+        interf i.next
+    | Iifthenelse(_tst, ifso, ifnot) ->
+        interf ifso;
+        interf ifnot;
+        interf i.next
+    | Iswitch(_index, cases) ->
+        for i = 0 to Array.length cases - 1 do
+          interf cases.(i)
+        done;
+        interf i.next
+    | Icatch(_rec_flag, handlers, body) ->
+        interf body;
+        List.iter (fun (_, handler) -> interf handler) handlers;
+        interf i.next
+    | Iexit _ ->
+        ()
+    | Itrywith(body, handler) ->
+        add_interf_set Proc.destroyed_at_raise handler.live;
+        interf body; interf handler; interf i.next
+    | Iraise _ -> () in
+
+  (* Add a preference from one reg to another.
+     Do not add anything if the two registers conflict,
+     or if the source register already has a location,
+     or if the two registers belong to different classes.
+     (The last case can occur e.g. on Sparc when passing
+      float arguments in integer registers, PR#6227.) *)
+
+  let add_pref weight r1 r2 =
+    let i = r1.stamp and j = r2.stamp in
+    if i <> j
+    && r1.loc = Unknown
+    && Proc.register_class r1 = Proc.register_class r2
+    && (let p = if i < j then (i, j) else (j, i) in
+        not (IntPairSet.mem p !mat))
+    then r1.prefer <- (r2, weight) :: r1.prefer
+  in
+
+  (* Add a mutual preference between two regs *)
+  let add_mutual_pref weight r1 r2 =
+    add_pref weight r1 r2; add_pref weight r2 r1 in
+
+  (* Update the spill cost of the registers involved in an operation *)
+
+  let add_spill_cost cost arg =
+    for i = 0 to Array.length arg - 1 do
+      let r = arg.(i) in r.spill_cost <- r.spill_cost + cost
+    done in
+
+  (* Compute preferences and spill costs *)
+
+  let rec prefer weight i =
+    assert (weight > 0);
+    add_spill_cost weight i.arg;
+    add_spill_cost weight i.res;
+    match i.desc with
+      Iend -> ()
+    | Ireturn -> ()
+    | Iop(Imove) ->
+        add_mutual_pref weight i.arg.(0) i.res.(0);
+        prefer weight i.next
+    | Iop(Ispill) ->
+        add_pref (weight / 4) i.arg.(0) i.res.(0);
+        prefer weight i.next
+    | Iop(Ireload) ->
+        add_pref (weight / 4) i.res.(0) i.arg.(0);
+        prefer weight i.next
+    | Iop(Itailcall_ind _) -> ()
+    | Iop(Itailcall_imm _) -> ()
+    | Iop _ ->
+        prefer weight i.next
+    | Iifthenelse(_tst, ifso, ifnot) ->
+        prefer weight ifso;
+        prefer weight ifnot;
+        prefer weight i.next
+    | Iswitch(_index, cases) ->
+        for i = 0 to Array.length cases - 1 do
+          prefer weight cases.(i)
+        done;
+        prefer weight i.next
+    | Icatch(rec_flag, handlers, body) ->
+        prefer weight body;
+        let weight_h =
+          match rec_flag with
+          | Cmm.Recursive ->
+              (* Avoid overflow of weight and spill_cost *)
+              if weight < 1000 then 8 * weight else weight
+          | Cmm.Nonrecursive ->
+              weight in
+        List.iter (fun (_nfail, handler) -> prefer weight_h handler) handlers;
+        prefer weight i.next
+    | Iexit _ ->
+        ()
+    | Itrywith(body, handler) ->
+        prefer weight body; prefer weight handler; prefer weight i.next
+    | Iraise _ -> ()
+  in
+
+  interf fundecl.fun_body; prefer 8 fundecl.fun_body
diff --git a/asmcomp/interf.mli b/asmcomp/interf.mli
new file mode 100644
index 00000000..13549a1d
--- /dev/null
+++ b/asmcomp/interf.mli
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Construction of the interference graph.
+   Annotate pseudoregs with interference lists and preference lists. *)
+
+val build_graph: Mach.fundecl -> unit
diff --git a/asmcomp/interval.ml b/asmcomp/interval.ml
new file mode 100644
index 00000000..956ac4f7
--- /dev/null
+++ b/asmcomp/interval.ml
@@ -0,0 +1,185 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                    Marcell Fischbach, University of Siegen             *)
+(*                     Benedikt Meurer, University of Siegen              *)
+(*                                                                        *)
+(*   Copyright 2011 Lehrstuhl für Compilerbau und Softwareanalyse,        *)
+(*     Universität Siegen.                                                *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Live intervals for the linear scan register allocator. *)
+
+open Mach
+open Reg
+
+type range =
+  {
+    mutable rbegin: int;
+    mutable rend: int;
+  }
+
+type t =
+  {
+    mutable reg: Reg.t;
+    mutable ibegin: int;
+    mutable iend: int;
+    mutable ranges: range list;
+  }
+
+type kind =
+    Result
+  | Argument
+  | Live
+
+let interval_list = ref ([] : t list)
+let fixed_interval_list = ref ([] : t list)
+let all_intervals() = !interval_list
+let all_fixed_intervals() = !fixed_interval_list
+
+(* Check if two intervals overlap *)
+
+let overlap i0 i1 =
+  let rec overlap_ranges rl0 rl1 =
+    match rl0, rl1 with
+      r0 :: rl0', r1 :: rl1' ->
+        if r0.rend >= r1.rbegin && r1.rend >= r0.rbegin then true
+        else if r0.rend < r1.rend then overlap_ranges rl0' rl1
+        else if r0.rend > r1.rend then overlap_ranges rl0 rl1'
+        else overlap_ranges rl0' rl1'
+    | _ -> false in
+  overlap_ranges i0.ranges i1.ranges
+
+let is_live i pos =
+  let rec is_live_in_ranges = function
+    [] -> false
+  | r :: rl -> if pos < r.rbegin then false
+               else if pos <= r.rend then true
+               else is_live_in_ranges rl in
+  is_live_in_ranges i.ranges
+
+let remove_expired_ranges i pos =
+  let rec filter = function
+    [] -> []
+  | r :: rl' as rl -> if pos < r.rend then rl
+               else filter rl' in
+  i.ranges <- filter i.ranges
+
+let update_interval_position intervals pos kind reg =
+  let i = intervals.(reg.stamp) in
+  let on = pos lsl 1 in
+  let off = on + 1 in
+  let rbegin = (match kind with Result -> off | _ -> on) in
+  let rend = (match kind with Argument -> on | _ -> off) in
+  if i.iend = 0 then begin
+    i.ibegin <- rbegin;
+    i.reg <- reg;
+    i.ranges <- [{rbegin = rbegin; rend = rend}]
+  end else begin
+    let r = List.hd i.ranges in
+    let ridx = r.rend asr 1 in
+    if pos - ridx <= 1 then
+      r.rend <- rend
+    else
+      i.ranges <- {rbegin = rbegin; rend = rend} :: i.ranges
+  end;
+  i.iend <- rend
+
+let update_interval_position_by_array intervals regs pos kind =
+  Array.iter (update_interval_position intervals pos kind) regs
+
+let update_interval_position_by_set intervals regs pos kind =
+  Set.iter (update_interval_position intervals pos kind) regs
+
+let update_interval_position_by_instr intervals instr pos =
+  update_interval_position_by_array intervals instr.arg pos Argument;
+  update_interval_position_by_array intervals instr.res pos Result;
+  update_interval_position_by_set intervals instr.live pos Live
+
+let insert_destroyed_at_oper intervals instr pos =
+  let destroyed = Proc.destroyed_at_oper instr.desc in
+  if Array.length destroyed > 0 then
+    update_interval_position_by_array intervals destroyed pos Result
+
+let insert_destroyed_at_raise intervals pos =
+  let destroyed = Proc.destroyed_at_raise in
+  if Array.length destroyed > 0 then
+    update_interval_position_by_array intervals destroyed pos Result
+
+(* Build all intervals.
+   The intervals will be expanded by one step at the start and end
+   of a basic block. *)
+
+let build_intervals fd =
+  let intervals = Array.init
+                    (Reg.num_registers())
+                    (fun _ -> {
+                      reg = Reg.dummy;
+                      ibegin = 0;
+                      iend = 0;
+                      ranges = []; }) in
+  let pos = ref 0 in
+  let rec walk_instruction i =
+    incr pos;
+    update_interval_position_by_instr intervals i !pos;
+    begin match i.desc with
+      Iend -> ()
+    | Iop(Icall_ind _ | Icall_imm _ | Iextcall{alloc = true; _}
+          | Itailcall_ind _ | Itailcall_imm _) ->
+        walk_instruction i.next
+    | Iop _ ->
+        insert_destroyed_at_oper intervals i !pos;
+        walk_instruction i.next
+    | Ireturn ->
+        insert_destroyed_at_oper intervals i !pos;
+        walk_instruction i.next
+    | Iifthenelse(_, ifso, ifnot) ->
+        insert_destroyed_at_oper intervals i !pos;
+        walk_instruction ifso;
+        walk_instruction ifnot;
+        walk_instruction i.next
+    | Iswitch(_, cases) ->
+        insert_destroyed_at_oper intervals i !pos;
+        Array.iter walk_instruction cases;
+        walk_instruction i.next
+    | Icatch(_, handlers, body) ->
+        insert_destroyed_at_oper intervals i !pos;
+        List.iter (fun (_, i) -> walk_instruction i) handlers;
+        walk_instruction body;
+        walk_instruction i.next
+    | Iexit _ ->
+        insert_destroyed_at_oper intervals i !pos;
+        walk_instruction i.next
+    | Itrywith(body, handler) ->
+        insert_destroyed_at_oper intervals i !pos;
+        walk_instruction body;
+        insert_destroyed_at_raise intervals !pos;
+        walk_instruction handler;
+        walk_instruction i.next
+    | Iraise _ ->
+        walk_instruction i.next
+    end in
+  walk_instruction fd.fun_body;
+  (* Generate the interval and fixed interval lists *)
+  interval_list := [];
+  fixed_interval_list := [];
+  Array.iter
+    (fun i ->
+      if i.iend != 0 then begin
+        i.ranges <- List.rev i.ranges;
+        begin match i.reg.loc with
+          Reg _ ->
+            fixed_interval_list := i :: !fixed_interval_list
+        | _ ->
+            interval_list := i :: !interval_list
+        end
+      end)
+    intervals;
+  (* Sort the intervals according to their start position *)
+  interval_list := List.sort (fun i0 i1 -> i0.ibegin - i1.ibegin) !interval_list
diff --git a/asmcomp/interval.mli b/asmcomp/interval.mli
new file mode 100644
index 00000000..2b42bf30
--- /dev/null
+++ b/asmcomp/interval.mli
@@ -0,0 +1,38 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                    Marcell Fischbach, University of Siegen             *)
+(*                     Benedikt Meurer, University of Siegen              *)
+(*                                                                        *)
+(*   Copyright 2011 Lehrstuhl für Compilerbau und Softwareanalyse,        *)
+(*     Universität Siegen.                                                *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Live intervals for the linear scan register allocator. *)
+
+type range =
+  {
+    mutable rbegin: int;
+    mutable rend: int;
+  }
+
+type t =
+  {
+    mutable reg: Reg.t;
+    mutable ibegin: int;
+    mutable iend: int;
+    mutable ranges: range list;
+  }
+
+val all_intervals: unit -> t list
+val all_fixed_intervals: unit -> t list
+val overlap: t -> t -> bool
+val is_live: t -> int -> bool
+val remove_expired_ranges: t -> int -> unit
+val build_intervals: Mach.fundecl -> unit
diff --git a/asmcomp/linear.ml b/asmcomp/linear.ml
new file mode 100644
index 00000000..37cf9200
--- /dev/null
+++ b/asmcomp/linear.ml
@@ -0,0 +1,92 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+open Mach
+
+(* Transformation of Mach code into a list of pseudo-instructions. *)
+type label = Cmm.label
+
+type instruction =
+  { mutable desc: instruction_desc;
+    mutable next: instruction;
+    arg: Reg.t array;
+    res: Reg.t array;
+    dbg: Debuginfo.t;
+    live: Reg.Set.t }
+
+and instruction_desc =
+  | Lprologue
+  | Lend
+  | Lop of Mach.operation
+  | Lreloadretaddr
+  | Lreturn
+  | Llabel of label
+  | Lbranch of label
+  | Lcondbranch of Mach.test * label
+  | Lcondbranch3 of label option * label option * label option
+  | Lswitch of label array
+  | Lentertrap
+  | Ladjust_trap_depth of { delta_traps : int; }
+  | Lpushtrap of { lbl_handler : label; }
+  | Lpoptrap
+  | Lraise of Lambda.raise_kind
+
+let has_fallthrough = function
+  | Lreturn | Lbranch _ | Lswitch _ | Lraise _
+  | Lop Itailcall_ind _ | Lop (Itailcall_imm _) -> false
+  | _ -> true
+
+type fundecl =
+  { fun_name: string;
+    fun_body: instruction;
+    fun_fast: bool;
+    fun_dbg : Debuginfo.t;
+    fun_spacetime_shape : Mach.spacetime_shape option;
+    fun_tailrec_entry_point_label : label;
+    fun_contains_calls: bool;
+    fun_num_stack_slots: int array;
+    fun_frame_required: bool;
+    fun_prologue_required: bool;
+  }
+
+(* Invert a test *)
+
+let invert_integer_test = function
+    Isigned cmp -> Isigned(Cmm.negate_integer_comparison cmp)
+  | Iunsigned cmp -> Iunsigned(Cmm.negate_integer_comparison cmp)
+
+let invert_test = function
+    Itruetest -> Ifalsetest
+  | Ifalsetest -> Itruetest
+  | Iinttest(cmp) -> Iinttest(invert_integer_test cmp)
+  | Iinttest_imm(cmp, n) -> Iinttest_imm(invert_integer_test cmp, n)
+  | Ifloattest(cmp) -> Ifloattest(Cmm.negate_float_comparison cmp)
+  | Ieventest -> Ioddtest
+  | Ioddtest -> Ieventest
+
+(* The "end" instruction *)
+
+let rec end_instr =
+  { desc = Lend;
+    next = end_instr;
+    arg = [||];
+    res = [||];
+    dbg = Debuginfo.none;
+    live = Reg.Set.empty }
+
+(* Cons an instruction (live, debug empty) *)
+
+let instr_cons d a r n =
+  { desc = d; next = n; arg = a; res = r;
+    dbg = Debuginfo.none; live = Reg.Set.empty }
diff --git a/asmcomp/linear.mli b/asmcomp/linear.mli
new file mode 100644
index 00000000..2d1ce943
--- /dev/null
+++ b/asmcomp/linear.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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Transformation of Mach code into a list of pseudo-instructions. *)
+
+type label = Cmm.label
+
+type instruction =
+  { mutable desc: instruction_desc;
+    mutable next: instruction;
+    arg: Reg.t array;
+    res: Reg.t array;
+    dbg: Debuginfo.t;
+    live: Reg.Set.t }
+
+and instruction_desc =
+  | Lprologue
+  | Lend
+  | Lop of Mach.operation
+  | Lreloadretaddr
+  | Lreturn
+  | Llabel of label
+  | Lbranch of label
+  | Lcondbranch of Mach.test * label
+  | Lcondbranch3 of label option * label option * label option
+  | Lswitch of label array
+  | Lentertrap
+  | Ladjust_trap_depth of { delta_traps : int; }
+  | Lpushtrap of { lbl_handler : label; }
+  | Lpoptrap
+  | Lraise of Lambda.raise_kind
+
+val has_fallthrough :  instruction_desc -> bool
+val end_instr: instruction
+val instr_cons:
+  instruction_desc -> Reg.t array -> Reg.t array -> instruction -> instruction
+val invert_test: Mach.test -> Mach.test
+
+type fundecl =
+  { fun_name: string;
+    fun_body: instruction;
+    fun_fast: bool;
+    fun_dbg : Debuginfo.t;
+    fun_spacetime_shape : Mach.spacetime_shape option;
+    fun_tailrec_entry_point_label : label;
+    fun_contains_calls: bool;
+    fun_num_stack_slots: int array;
+    fun_frame_required: bool;
+    fun_prologue_required: bool;
+  }
diff --git a/asmcomp/linearize.ml b/asmcomp/linearize.ml
new file mode 100644
index 00000000..31b992a4
--- /dev/null
+++ b/asmcomp/linearize.ml
@@ -0,0 +1,340 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Transformation of Mach code into a list of pseudo-instructions. *)
+open Linear
+
+(* Cons a simple instruction (arg, res, live empty) *)
+
+let cons_instr d n =
+  { desc = d; next = n; arg = [||]; res = [||];
+    dbg = Debuginfo.none; live = Reg.Set.empty }
+
+(* Build an instruction with arg, res, dbg, live taken from
+   the given Mach.instruction *)
+
+let copy_instr d i n =
+  { desc = d; next = n;
+    arg = i.Mach.arg; res = i.Mach.res;
+    dbg = i.Mach.dbg; live = i.Mach.live }
+
+(*
+   Label the beginning of the given instruction sequence.
+   - If the sequence starts with a branch, jump over it.
+   - If the sequence is the end, (tail call position), just do nothing
+*)
+
+let get_label n = match n.desc with
+    Lbranch lbl -> (lbl, n)
+  | Llabel lbl -> (lbl, n)
+  | Lend -> (-1, n)
+  | _ -> let lbl = Cmm.new_label() in (lbl, cons_instr (Llabel lbl) n)
+
+(* Check the fallthrough label *)
+let check_label n = match n.desc with
+  | Lbranch lbl -> lbl
+  | Llabel lbl -> lbl
+  | _ -> -1
+
+
+(* Add pseudo-instruction Ladjust_trap_depth in front of a continuation
+   to notify assembler generation about updates to the stack as a result
+   of differences in exception trap depths.
+   The argument delta is the number of trap frames (not bytes). *)
+
+let rec adjust_trap_depth delta_traps next =
+  (* Simplify by merging and eliminating Ladjust_trap_depth instructions
+     whenever possible. *)
+  match next.desc with
+  | Ladjust_trap_depth { delta_traps = k } ->
+    adjust_trap_depth (delta_traps + k) next.next
+  | _ ->
+    if delta_traps = 0 then next
+    else cons_instr (Ladjust_trap_depth { delta_traps }) next
+
+(* Discard all instructions up to the next label.
+   This function is to be called before adding a non-terminating
+   instruction. *)
+
+let rec discard_dead_code n =
+  let adjust trap_depth =
+    adjust_trap_depth trap_depth (discard_dead_code n.next)
+  in
+  match n.desc with
+    Lend -> n
+  | Llabel _ -> n
+    (* Do not discard Lpoptrap/Lpushtrap/Ladjust_trap_depth
+       or Istackoffset instructions, as this may cause a stack imbalance
+       later during assembler generation. Replace them
+       with pseudo-instruction Ladjust_trap_depth with the corresponding
+       stack offset and eliminate dead instructions after them. *)
+  | Lpoptrap -> adjust (-1)
+  | Lpushtrap _ -> adjust (+1)
+  | Ladjust_trap_depth { delta_traps } -> adjust delta_traps
+  | Lop(Istackoffset _) ->
+    (* This dead instruction cannot be replaced by Ladjust_trap_depth,
+       because the units don't match: the argument of Istackoffset is in bytes,
+       whereas the argument of Ladjust_trap_depth is in trap frames,
+       and the size of trap frames is machine-dependant and therefore not
+       available here.  *)
+    { n with next = discard_dead_code n.next; }
+  | _ -> discard_dead_code n.next
+
+(*
+   Add a branch in front of a continuation.
+   Discard dead code in the continuation.
+   Does not insert anything if we're just falling through
+   or if we jump to dead code after the end of function (lbl=-1)
+*)
+
+let add_branch lbl n =
+  if lbl >= 0 then
+    let n1 = discard_dead_code n in
+    match n1.desc with
+    | Llabel lbl1 when lbl1 = lbl -> n1
+    | _ -> cons_instr (Lbranch lbl) n1
+  else
+    discard_dead_code n
+
+let try_depth = ref 0
+
+(* Association list: exit handler -> (handler label, try-nesting factor) *)
+
+let exit_label = ref []
+
+let find_exit_label_try_depth k =
+  try
+    List.assoc k !exit_label
+  with
+  | Not_found -> Misc.fatal_error "Linearize.find_exit_label"
+
+let find_exit_label k =
+  let (label, t) = find_exit_label_try_depth k in
+  assert(t = !try_depth);
+  label
+
+let is_next_catch n = match !exit_label with
+| (n0,(_,t))::_  when n0=n && t = !try_depth -> true
+| _ -> false
+
+let local_exit k =
+  snd (find_exit_label_try_depth k) = !try_depth
+
+(* Linearize an instruction [i]: add it in front of the continuation [n] *)
+let linear i n contains_calls =
+  let rec linear i n =
+    match i.Mach.desc with
+      Iend -> n
+    | Iop(Itailcall_ind _ | Itailcall_imm _ as op) ->
+        if not Config.spacetime then
+          copy_instr (Lop op) i (discard_dead_code n)
+        else
+          copy_instr (Lop op) i (linear i.Mach.next n)
+    | Iop(Imove | Ireload | Ispill)
+      when i.Mach.arg.(0).loc = i.Mach.res.(0).loc ->
+        linear i.Mach.next n
+    | Iop op ->
+        copy_instr (Lop op) i (linear i.Mach.next n)
+    | Ireturn ->
+        let n1 = copy_instr Lreturn i (discard_dead_code n) in
+        if contains_calls
+        then cons_instr Lreloadretaddr n1
+        else n1
+    | Iifthenelse(test, ifso, ifnot) ->
+        let n1 = linear i.Mach.next n in
+        begin match (ifso.Mach.desc, ifnot.Mach.desc, n1.desc) with
+          Iend, _, Lbranch lbl ->
+            copy_instr (Lcondbranch(test, lbl)) i (linear ifnot n1)
+        | _, Iend, Lbranch lbl ->
+            copy_instr (Lcondbranch(invert_test test, lbl)) i (linear ifso n1)
+        | Iexit nfail1, Iexit nfail2, _
+              when is_next_catch nfail1 && local_exit nfail2 ->
+            let lbl2 = find_exit_label nfail2 in
+            copy_instr
+              (Lcondbranch (invert_test test, lbl2)) i (linear ifso n1)
+        | Iexit nfail, _, _ when local_exit nfail ->
+            let n2 = linear ifnot n1
+            and lbl = find_exit_label nfail in
+            copy_instr (Lcondbranch(test, lbl)) i n2
+        | _,  Iexit nfail, _ when local_exit nfail ->
+            let n2 = linear ifso n1 in
+            let lbl = find_exit_label nfail in
+            copy_instr (Lcondbranch(invert_test test, lbl)) i n2
+        | Iend, _, _ ->
+            let (lbl_end, n2) = get_label n1 in
+            copy_instr (Lcondbranch(test, lbl_end)) i (linear ifnot n2)
+        | _,  Iend, _ ->
+            let (lbl_end, n2) = get_label n1 in
+            copy_instr (Lcondbranch(invert_test test, lbl_end)) i
+                       (linear ifso n2)
+        | _, _, _ ->
+          (* Should attempt branch prediction here *)
+            let (lbl_end, n2) = get_label n1 in
+            let (lbl_else, nelse) = get_label (linear ifnot n2) in
+            copy_instr (Lcondbranch(invert_test test, lbl_else)) i
+              (linear ifso (add_branch lbl_end nelse))
+        end
+    | Iswitch(index, cases) ->
+        let lbl_cases = Array.make (Array.length cases) 0 in
+        let (lbl_end, n1) = get_label(linear i.Mach.next n) in
+        let n2 = ref (discard_dead_code n1) in
+        for i = Array.length cases - 1 downto 0 do
+          let (lbl_case, ncase) =
+                  get_label(linear cases.(i) (add_branch lbl_end !n2)) in
+          lbl_cases.(i) <- lbl_case;
+          n2 := discard_dead_code ncase
+        done;
+        (* Switches with 1 and 2 branches have been eliminated earlier.
+           Here, we do something for switches with 3 branches. *)
+        if Array.length index = 3 then begin
+          let fallthrough_lbl = check_label !n2 in
+          let find_label n =
+            let lbl = lbl_cases.(index.(n)) in
+            if lbl = fallthrough_lbl then None else Some lbl in
+          copy_instr (Lcondbranch3(find_label 0, find_label 1, find_label 2))
+                     i !n2
+        end else
+          copy_instr (Lswitch(Array.map (fun n -> lbl_cases.(n)) index)) i !n2
+    | Icatch(_rec_flag, handlers, body) ->
+        let (lbl_end, n1) = get_label(linear i.Mach.next n) in
+        (* CR mshinwell for pchambart:
+           1. rename "io"
+           2. Make sure the test cases cover the "Iend" cases too *)
+        let labels_at_entry_to_handlers = List.map (fun (_nfail, handler) ->
+            match handler.Mach.desc with
+            | Iend -> lbl_end
+            | _ -> Cmm.new_label ())
+            handlers in
+        let exit_label_add = List.map2
+            (fun (nfail, _) lbl -> (nfail, (lbl, !try_depth)))
+            handlers labels_at_entry_to_handlers in
+        let previous_exit_label = !exit_label in
+        exit_label := exit_label_add @ !exit_label;
+        let n2 = List.fold_left2 (fun n (_nfail, handler) lbl_handler ->
+            match handler.Mach.desc with
+            | Iend -> n
+            | _ -> cons_instr (Llabel lbl_handler)
+                     (linear handler (add_branch lbl_end n)))
+            n1 handlers labels_at_entry_to_handlers
+        in
+        let n3 = linear body (add_branch lbl_end n2) in
+        exit_label := previous_exit_label;
+        n3
+    | Iexit nfail ->
+        let lbl, t = find_exit_label_try_depth nfail in
+        assert (i.Mach.next.desc = Mach.Iend);
+        let delta_traps = !try_depth - t in
+        let n1 = adjust_trap_depth delta_traps n in
+        let rec loop i tt =
+          if t = tt then i
+          else loop (cons_instr Lpoptrap i) (tt - 1)
+        in
+        loop (add_branch lbl n1) !try_depth
+    | Itrywith(body, handler) ->
+        let (lbl_join, n1) = get_label (linear i.Mach.next n) in
+        let (lbl_handler, n2) =
+          get_label (cons_instr Lentertrap (linear handler n1))
+        in
+        incr try_depth;
+        assert (i.Mach.arg = [| |] || Config.spacetime);
+        let n3 = cons_instr (Lpushtrap { lbl_handler; })
+                   (linear body
+                      (cons_instr
+                         Lpoptrap
+                         (add_branch lbl_join n2))) in
+        decr try_depth;
+        n3
+
+    | Iraise k ->
+        copy_instr (Lraise k) i (discard_dead_code n)
+  in linear i n
+
+let add_prologue first_insn prologue_required =
+  (* The prologue needs to come after any [Iname_for_debugger] operations that
+     refer to parameters.  (Such operations always come in a contiguous
+     block, cf. [Selectgen].) *)
+  let rec skip_naming_ops (insn : instruction) : label * instruction =
+    match insn.desc with
+    | Lop (Iname_for_debugger _) ->
+      let tailrec_entry_point_label, next = skip_naming_ops insn.next in
+      tailrec_entry_point_label, { insn with next; }
+    | _ ->
+      let tailrec_entry_point_label = Cmm.new_label () in
+      let tailrec_entry_point =
+        { desc = Llabel tailrec_entry_point_label;
+          next = insn;
+          arg = [| |];
+          res = [| |];
+          dbg = insn.dbg;
+          live = insn.live;
+        }
+      in
+      (* We expect [Lprologue] to expand to at least one instruction---as such,
+         if no prologue is required, we avoid adding the instruction here.
+         The reason is subtle: an empty expansion of [Lprologue] can cause
+         two labels, one either side of the [Lprologue], to point at the same
+         location.  This means that we lose the property (cf. [Coalesce_labels])
+         that we can check if two labels point at the same location by
+         comparing them for equality.  This causes trouble when the function
+         whose prologue is in question lands at the top of the object file
+         and we are emitting DWARF debugging information:
+           foo_code_begin:
+           foo:
+           .L1:
+           ; empty prologue
+           .L2:
+           ...
+         If we were to emit a location list entry from L1...L2, not realising
+         that they point at the same location, then the beginning and ending
+         points of the range would be both equal to each other and (relative to
+         "foo_code_begin") equal to zero.  This appears to confuse objdump,
+         which seemingly misinterprets the entry as an end-of-list entry
+         (which is encoded with two zero words), then complaining about a
+         "hole in location list" (as it ignores any remaining list entries
+         after the misinterpreted entry). *)
+      if prologue_required then
+        let prologue =
+          { desc = Lprologue;
+            next = tailrec_entry_point;
+            arg = [| |];
+            res = [| |];
+            dbg = tailrec_entry_point.dbg;
+            live = Reg.Set.empty;  (* will not be used *)
+          }
+        in
+        tailrec_entry_point_label, prologue
+      else
+        tailrec_entry_point_label, tailrec_entry_point
+  in
+  skip_naming_ops first_insn
+
+let fundecl f =
+  let fun_prologue_required = Proc.prologue_required f in
+  let contains_calls = f.Mach.fun_contains_calls in
+  let fun_tailrec_entry_point_label, fun_body =
+    add_prologue (linear f.Mach.fun_body end_instr contains_calls)
+      fun_prologue_required
+  in
+  { fun_name = f.Mach.fun_name;
+    fun_body;
+    fun_fast = not (List.mem Cmm.Reduce_code_size f.Mach.fun_codegen_options);
+    fun_dbg  = f.Mach.fun_dbg;
+    fun_spacetime_shape = f.Mach.fun_spacetime_shape;
+    fun_tailrec_entry_point_label;
+    fun_contains_calls = contains_calls;
+    fun_num_stack_slots = f.Mach.fun_num_stack_slots;
+    fun_frame_required = Proc.frame_required f;
+    fun_prologue_required;
+  }
diff --git a/asmcomp/linearize.mli b/asmcomp/linearize.mli
new file mode 100644
index 00000000..080b304b
--- /dev/null
+++ b/asmcomp/linearize.mli
@@ -0,0 +1,17 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Transformation of Mach code into a list of pseudo-instructions. *)
+val fundecl: Mach.fundecl -> Linear.fundecl
diff --git a/asmcomp/linscan.ml b/asmcomp/linscan.ml
new file mode 100644
index 00000000..21416be2
--- /dev/null
+++ b/asmcomp/linscan.ml
@@ -0,0 +1,201 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                    Marcell Fischbach, University of Siegen             *)
+(*                     Benedikt Meurer, University of Siegen              *)
+(*                                                                        *)
+(*   Copyright 2011 Lehrstuhl für Compilerbau und Softwareanalyse,        *)
+(*     Universität Siegen.                                                *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Linear scan register allocation. *)
+
+open Interval
+open Reg
+
+(* Live intervals per register class *)
+
+type class_intervals =
+  {
+    mutable ci_fixed: Interval.t list;
+    mutable ci_active: Interval.t list;
+    mutable ci_inactive: Interval.t list;
+  }
+
+let active = Array.init Proc.num_register_classes (fun _ -> {
+  ci_fixed = [];
+  ci_active = [];
+  ci_inactive = []
+})
+
+(* Insert interval into list sorted by end position *)
+
+let rec insert_interval_sorted i = function
+    [] -> [i]
+  | j :: _ as il when j.iend <= i.iend -> i :: il
+  | j :: il -> j :: insert_interval_sorted i il
+
+let rec release_expired_fixed pos = function
+    i :: il when i.iend >= pos ->
+      Interval.remove_expired_ranges i pos;
+      i :: release_expired_fixed pos il
+  | _ -> []
+
+let rec release_expired_active ci pos = function
+    i :: il when i.iend >= pos ->
+      Interval.remove_expired_ranges i pos;
+      if Interval.is_live i pos then
+        i :: release_expired_active ci pos il
+      else begin
+        ci.ci_inactive <- insert_interval_sorted i ci.ci_inactive;
+        release_expired_active ci pos il
+      end
+  | _ -> []
+
+let rec release_expired_inactive ci pos = function
+    i :: il when i.iend >= pos ->
+      Interval.remove_expired_ranges i pos;
+      if not (Interval.is_live i pos) then
+        i :: release_expired_inactive ci pos il
+      else begin
+        ci.ci_active <- insert_interval_sorted i ci.ci_active;
+        release_expired_inactive ci pos il
+      end
+  | _ -> []
+
+(* Allocate a new stack slot to the interval. *)
+
+let allocate_stack_slot num_stack_slots i =
+  let cl = Proc.register_class i.reg in
+  let ss = num_stack_slots.(cl) in
+  num_stack_slots.(cl) <- succ ss;
+  i.reg.loc <- Stack(Local ss);
+  i.reg.spill <- true
+
+(* Find a register for the given interval and assigns this register.
+   The interval is added to active. Raises Not_found if no free registers
+   left. *)
+
+let allocate_free_register num_stack_slots i =
+  begin match i.reg.loc, i.reg.spill with
+    Unknown, true ->
+      (* Allocate a stack slot for the already spilled interval *)
+      allocate_stack_slot num_stack_slots i
+  | Unknown, _ ->
+      (* We need to allocate a register to this interval somehow *)
+      let cl = Proc.register_class i.reg in
+      begin match Proc.num_available_registers.(cl) with
+        0 ->
+          (* There are no registers available for this class *)
+          raise Not_found
+      | rn ->
+          let ci = active.(cl) in
+          let r0 = Proc.first_available_register.(cl) in
+          (* Create register mask for this class
+             note: if frame pointers are enabled then some registers may have
+                   indexes that are off-bounds; we hence protect write accesses
+                   below (given that the assign function will not consider such
+                   registers) *)
+          let regmask = Array.make rn true in
+          (* Remove all assigned registers from the register mask *)
+          List.iter
+            (function
+              {reg = {loc = Reg r}} ->
+                if r - r0 < rn then regmask.(r - r0) <- false
+            | _ -> ())
+            ci.ci_active;
+          (* Remove all overlapping registers from the register mask *)
+          let remove_bound_overlapping = function
+              {reg = {loc = Reg r}} as j ->
+                if (r - r0 < rn) && regmask.(r - r0)
+                   && Interval.overlap j i then
+                regmask.(r - r0) <- false
+            | _ -> () in
+          List.iter remove_bound_overlapping ci.ci_inactive;
+          List.iter remove_bound_overlapping ci.ci_fixed;
+          (* Assign the first free register (if any) *)
+          let rec assign r =
+            if r = rn then
+              raise Not_found
+            else if regmask.(r) then begin
+              (* Assign the free register and insert the
+                 current interval into the active list *)
+              i.reg.loc <- Reg (r0 + r);
+              i.reg.spill <- false;
+              ci.ci_active <- insert_interval_sorted i ci.ci_active
+            end else
+              assign (succ r) in
+          assign 0
+      end
+  | _ -> ()
+  end
+
+let allocate_blocked_register num_stack_slots i =
+  let cl = Proc.register_class i.reg in
+  let ci = active.(cl) in
+  match ci.ci_active with
+  | ilast :: il when
+      ilast.iend > i.iend &&
+      (* Last interval in active is the last interval, so spill it. *)
+      let chk r = r.reg.loc = ilast.reg.loc && Interval.overlap r i in
+      (* But only if its physical register is admissible for the current
+         interval. *)
+      not (List.exists chk ci.ci_fixed || List.exists chk ci.ci_inactive)
+    ->
+      begin match ilast.reg.loc with Reg _ -> () | _ -> assert false end;
+      (* Use register from last interval for current interval *)
+      i.reg.loc <- ilast.reg.loc;
+      (* Remove the last interval from active and insert the current *)
+      ci.ci_active <- insert_interval_sorted i il;
+      (* Now get a new stack slot for the spilled register *)
+      allocate_stack_slot num_stack_slots ilast
+  | _ ->
+      (* Either the current interval is last and we have to spill it,
+         or there are no registers at all in the register class (i.e.
+         floating point class on i386). *)
+      allocate_stack_slot num_stack_slots i
+
+let walk_interval num_stack_slots i =
+  let pos = i.ibegin land (lnot 0x01) in
+  (* Release all intervals that have been expired at the current position *)
+  Array.iter
+    (fun ci ->
+      ci.ci_fixed <- release_expired_fixed pos ci.ci_fixed;
+      ci.ci_active <- release_expired_active ci pos ci.ci_active;
+      ci.ci_inactive <- release_expired_inactive ci pos ci.ci_inactive)
+    active;
+  try
+    (* Allocate free register (if any) *)
+    allocate_free_register num_stack_slots i
+  with
+    Not_found ->
+      (* No free register, need to decide which interval to spill *)
+      allocate_blocked_register num_stack_slots i
+
+let allocate_registers() =
+  (* Initialize the stack slots and interval lists *)
+  for cl = 0 to Proc.num_register_classes - 1 do
+    (* Start with empty interval lists *)
+    active.(cl) <- {
+      ci_fixed = [];
+      ci_active = [];
+      ci_inactive = []
+    };
+  done;
+  (* Reset the stack slot counts *)
+  let num_stack_slots = Array.make Proc.num_register_classes 0 in
+  (* Add all fixed intervals (sorted by end position) *)
+  List.iter
+    (fun i ->
+      let ci = active.(Proc.register_class i.reg) in
+      ci.ci_fixed <- insert_interval_sorted i ci.ci_fixed)
+    (Interval.all_fixed_intervals());
+  (* Walk all the intervals within the list *)
+  List.iter (walk_interval num_stack_slots) (Interval.all_intervals());
+  num_stack_slots
diff --git a/asmcomp/linscan.mli b/asmcomp/linscan.mli
new file mode 100644
index 00000000..650e4139
--- /dev/null
+++ b/asmcomp/linscan.mli
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                    Marcell Fischbach, University of Siegen             *)
+(*                     Benedikt Meurer, University of Siegen              *)
+(*                                                                        *)
+(*   Copyright 2011 Lehrstuhl für Compilerbau und Softwareanalyse,        *)
+(*     Universität Siegen.                                                *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Linear scan register allocation. *)
+
+val allocate_registers: unit -> int array
diff --git a/asmcomp/liveness.ml b/asmcomp/liveness.ml
new file mode 100644
index 00000000..2da5b160
--- /dev/null
+++ b/asmcomp/liveness.ml
@@ -0,0 +1,161 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Liveness analysis.
+   Annotate mach code with the set of regs live at each point. *)
+
+open Mach
+
+let live_at_exit = ref []
+
+let find_live_at_exit k =
+  try
+    List.assoc k !live_at_exit
+  with
+  | Not_found -> Misc.fatal_error "Liveness.find_live_at_exit"
+
+let live_at_raise = ref Reg.Set.empty
+
+let rec live i finally =
+  (* finally is the set of registers live after execution of the
+     instruction sequence.
+     The result of the function is the set of registers live just
+     before the instruction sequence.
+     The instruction i is annotated by the set of registers live across
+     the instruction. *)
+  let arg =
+    if Config.spacetime
+      && Mach.spacetime_node_hole_pointer_is_live_before i
+    then Array.append i.arg [| Proc.loc_spacetime_node_hole |]
+    else i.arg
+  in
+  match i.desc with
+    Iend ->
+      i.live <- finally;
+      finally
+  | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) ->
+      i.live <- Reg.Set.empty; (* no regs are live across *)
+      Reg.set_of_array arg
+  | Iop op ->
+      let after = live i.next finally in
+      if Proc.op_is_pure op                    (* no side effects *)
+      && Reg.disjoint_set_array after i.res    (* results are not used after *)
+      && not (Proc.regs_are_volatile arg)      (* no stack-like hard reg *)
+      && not (Proc.regs_are_volatile i.res)    (*            is involved *)
+      then begin
+        (* This operation is dead code.  Ignore its arguments. *)
+        i.live <- after;
+        after
+      end else begin
+        let across_after = Reg.diff_set_array after i.res in
+        let across =
+          match op with
+          | Icall_ind _ | Icall_imm _ | Iextcall _ | Ialloc _
+          | Iintop (Icheckbound _) | Iintop_imm(Icheckbound _, _) ->
+              (* The function call may raise an exception, branching to the
+                 nearest enclosing try ... with. Similarly for bounds checks
+                 and allocation (for the latter: finalizers may throw
+                 exceptions, as may signal handlers).
+                 Hence, everything that must be live at the beginning of
+                 the exception handler must also be live across this instr. *)
+               Reg.Set.union across_after !live_at_raise
+           | _ ->
+               across_after in
+        i.live <- across;
+        Reg.add_set_array across arg
+      end
+  | Iifthenelse(_test, ifso, ifnot) ->
+      let at_join = live i.next finally in
+      let at_fork = Reg.Set.union (live ifso at_join) (live ifnot at_join) in
+      i.live <- at_fork;
+      Reg.add_set_array at_fork arg
+  | Iswitch(_index, cases) ->
+      let at_join = live i.next finally in
+      let at_fork = ref Reg.Set.empty in
+      for i = 0 to Array.length cases - 1 do
+        at_fork := Reg.Set.union !at_fork (live cases.(i) at_join)
+      done;
+      i.live <- !at_fork;
+      Reg.add_set_array !at_fork arg
+  | Icatch(rec_flag, handlers, body) ->
+      let at_join = live i.next finally in
+      let aux (nfail,handler) (nfail', before_handler) =
+        assert(nfail = nfail');
+        let before_handler' = live handler at_join in
+        nfail, Reg.Set.union before_handler before_handler'
+      in
+      let aux_equal (nfail, before_handler) (nfail', before_handler') =
+        assert(nfail = nfail');
+        Reg.Set.equal before_handler before_handler'
+      in
+      let live_at_exit_before = !live_at_exit in
+      let rec fixpoint before_handlers =
+        live_at_exit := before_handlers @ !live_at_exit;
+        let before_handlers' = List.map2 aux handlers before_handlers in
+        live_at_exit := live_at_exit_before;
+        match rec_flag with
+        | Cmm.Nonrecursive ->
+            before_handlers'
+        | Cmm.Recursive ->
+            if List.for_all2 aux_equal before_handlers before_handlers'
+            then before_handlers'
+            else fixpoint before_handlers'
+      in
+      let init_state =
+        List.map (fun (nfail, _handler) -> nfail, Reg.Set.empty) handlers
+      in
+      let before_handler = fixpoint init_state in
+      (* We could use handler.live instead of Reg.Set.empty as the initial
+         value but we would need to clean the live field before doing the
+         analysis (to remove remnants of previous passes). *)
+      live_at_exit := before_handler @ !live_at_exit;
+      let before_body = live body at_join in
+      live_at_exit := live_at_exit_before;
+      i.live <- before_body;
+      before_body
+  | Iexit nfail ->
+      let this_live = find_live_at_exit nfail in
+      i.live <- this_live ;
+      this_live
+  | Itrywith(body, handler) ->
+      let at_join = live i.next finally in
+      let before_handler = live handler at_join in
+      let saved_live_at_raise = !live_at_raise in
+      live_at_raise := Reg.Set.remove Proc.loc_exn_bucket before_handler;
+      let before_body = live body at_join in
+      live_at_raise := saved_live_at_raise;
+      i.live <- before_body;
+      before_body
+  | Iraise _ ->
+      i.live <- !live_at_raise;
+      Reg.add_set_array !live_at_raise arg
+
+let reset () =
+  live_at_raise := Reg.Set.empty;
+  live_at_exit := []
+
+let fundecl f =
+  let initially_live = live f.fun_body Reg.Set.empty in
+  (* Sanity check: only function parameters (and the Spacetime node hole
+     register, if profiling) can be live at entrypoint *)
+  let wrong_live = Reg.Set.diff initially_live (Reg.set_of_array f.fun_args) in
+  let wrong_live =
+    if not Config.spacetime then wrong_live
+    else Reg.Set.remove Proc.loc_spacetime_node_hole wrong_live
+  in
+  if not (Reg.Set.is_empty wrong_live) then begin
+    Misc.fatal_errorf "@[Liveness.fundecl:@\n%a@]"
+      Printmach.regset wrong_live
+  end
diff --git a/asmcomp/liveness.mli b/asmcomp/liveness.mli
new file mode 100644
index 00000000..37f5c170
--- /dev/null
+++ b/asmcomp/liveness.mli
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Liveness analysis.
+   Annotate mach code with the set of regs live at each point. *)
+
+val reset : unit -> unit
+val fundecl: Mach.fundecl -> unit
diff --git a/asmcomp/mach.ml b/asmcomp/mach.ml
new file mode 100644
index 00000000..8518e9da
--- /dev/null
+++ b/asmcomp/mach.ml
@@ -0,0 +1,207 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Representation of machine code by sequences of pseudoinstructions *)
+
+type label = Cmm.label
+
+type integer_comparison =
+    Isigned of Cmm.integer_comparison
+  | Iunsigned of Cmm.integer_comparison
+
+type integer_operation =
+    Iadd | Isub | Imul | Imulh | Idiv | Imod
+  | Iand | Ior | Ixor | Ilsl | Ilsr | Iasr
+  | Icomp of integer_comparison
+  | Icheckbound of { label_after_error : label option;
+        spacetime_index : int; }
+
+type float_comparison = Cmm.float_comparison
+
+type test =
+    Itruetest
+  | Ifalsetest
+  | Iinttest of integer_comparison
+  | Iinttest_imm of integer_comparison * int
+  | Ifloattest of float_comparison
+  | Ioddtest
+  | Ieventest
+
+type operation =
+    Imove
+  | Ispill
+  | Ireload
+  | Iconst_int of nativeint
+  | Iconst_float of int64
+  | Iconst_symbol of string
+  | Icall_ind of { label_after : label; }
+  | Icall_imm of { func : string; label_after : label; }
+  | Itailcall_ind of { label_after : label; }
+  | Itailcall_imm of { func : string; label_after : label; }
+  | Iextcall of { func : string; alloc : bool; label_after : label; }
+  | Istackoffset of int
+  | Iload of Cmm.memory_chunk * Arch.addressing_mode
+  | Istore of Cmm.memory_chunk * Arch.addressing_mode * bool
+  | Ialloc of { bytes : int; label_after_call_gc : label option;
+      dbginfo : Debuginfo.alloc_dbginfo; spacetime_index : int; }
+  | Iintop of integer_operation
+  | Iintop_imm of integer_operation * int
+  | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
+  | Ifloatofint | Iintoffloat
+  | Ispecific of Arch.specific_operation
+  | Iname_for_debugger of { ident : Backend_var.t; which_parameter : int option;
+      provenance : unit option; is_assignment : bool; }
+
+type instruction =
+  { desc: instruction_desc;
+    next: instruction;
+    arg: Reg.t array;
+    res: Reg.t array;
+    dbg: Debuginfo.t;
+    mutable live: Reg.Set.t;
+    mutable available_before: Reg_availability_set.t;
+    mutable available_across: Reg_availability_set.t option;
+  }
+
+and instruction_desc =
+    Iend
+  | Iop of operation
+  | Ireturn
+  | Iifthenelse of test * instruction * instruction
+  | Iswitch of int array * instruction array
+  | Icatch of Cmm.rec_flag * (int * instruction) list * instruction
+  | Iexit of int
+  | Itrywith of instruction * instruction
+  | Iraise of Lambda.raise_kind
+
+type spacetime_part_of_shape =
+  | Direct_call_point of { callee : string; }
+  | Indirect_call_point
+  | Allocation_point
+
+type spacetime_shape = (spacetime_part_of_shape * Cmm.label) list
+
+type fundecl =
+  { fun_name: string;
+    fun_args: Reg.t array;
+    fun_body: instruction;
+    fun_codegen_options : Cmm.codegen_option list;
+    fun_dbg : Debuginfo.t;
+    fun_spacetime_shape : spacetime_shape option;
+    fun_num_stack_slots: int array;
+    fun_contains_calls: bool;
+  }
+
+let rec dummy_instr =
+  { desc = Iend;
+    next = dummy_instr;
+    arg = [||];
+    res = [||];
+    dbg = Debuginfo.none;
+    live = Reg.Set.empty;
+    available_before = Reg_availability_set.Ok Reg_with_debug_info.Set.empty;
+    available_across = None;
+  }
+
+let end_instr () =
+  { desc = Iend;
+    next = dummy_instr;
+    arg = [||];
+    res = [||];
+    dbg = Debuginfo.none;
+    live = Reg.Set.empty;
+    available_before = Reg_availability_set.Ok Reg_with_debug_info.Set.empty;
+    available_across = None;
+  }
+
+let instr_cons d a r n =
+  { desc = d; next = n; arg = a; res = r;
+    dbg = Debuginfo.none; live = Reg.Set.empty;
+    available_before = Reg_availability_set.Ok Reg_with_debug_info.Set.empty;
+    available_across = None;
+  }
+
+let instr_cons_debug d a r dbg n =
+  { desc = d; next = n; arg = a; res = r; dbg = dbg; live = Reg.Set.empty;
+    available_before = Reg_availability_set.Ok Reg_with_debug_info.Set.empty;
+    available_across = None;
+  }
+
+let rec instr_iter f i =
+  match i.desc with
+    Iend -> ()
+  | _ ->
+      f i;
+      match i.desc with
+        Iend -> ()
+      | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) -> ()
+      | Iifthenelse(_tst, ifso, ifnot) ->
+          instr_iter f ifso; instr_iter f ifnot; instr_iter f i.next
+      | Iswitch(_index, cases) ->
+          for i = 0 to Array.length cases - 1 do
+            instr_iter f cases.(i)
+          done;
+          instr_iter f i.next
+      | Icatch(_, handlers, body) ->
+          instr_iter f body;
+          List.iter (fun (_n, handler) -> instr_iter f handler) handlers;
+          instr_iter f i.next
+      | Iexit _ -> ()
+      | Itrywith(body, handler) ->
+          instr_iter f body; instr_iter f handler; instr_iter f i.next
+      | Iraise _ -> ()
+      | _ ->
+          instr_iter f i.next
+
+let spacetime_node_hole_pointer_is_live_before insn =
+  match insn.desc with
+  | Iop op ->
+    begin match op with
+    | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _ -> true
+    | Iextcall { alloc; } -> alloc
+    | Ialloc _ ->
+      (* Allocations are special: the call to [caml_call_gc] requires some
+         instrumentation code immediately prior, but this is not inserted until
+         the emitter (since the call is not visible prior to that in any IR).
+         As such, none of the Mach / Linearize analyses will ever see that
+         we use the node hole pointer for these, and we do not need to say
+         that it is live at such points. *)
+      false
+    | Iintop op | Iintop_imm (op, _) ->
+      begin match op with
+      | Icheckbound _
+        (* [Icheckbound] doesn't need to return [true] for the same reason as
+           [Ialloc]. *)
+      | Iadd | Isub | Imul | Imulh | Idiv | Imod
+      | Iand | Ior | Ixor | Ilsl | Ilsr | Iasr
+      | Icomp _ -> false
+      end
+    | Ispecific specific_op ->
+      Arch.spacetime_node_hole_pointer_is_live_before specific_op
+    | Imove | Ispill | Ireload | Iconst_int _ | Iconst_float _
+    | Iconst_symbol _ | Istackoffset _ | Iload _ | Istore _
+    | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
+    | Ifloatofint | Iintoffloat
+    | Iname_for_debugger _ -> false
+    end
+  | Iend | Ireturn | Iifthenelse _ | Iswitch _ | Icatch _
+  | Iexit _ | Itrywith _ | Iraise _ -> false
+
+let operation_can_raise op =
+  match op with
+  | Icall_ind _ | Icall_imm _ | Iextcall _
+  | Iintop (Icheckbound _) | Iintop_imm (Icheckbound _, _)
+  | Ialloc _ -> true
+  | _ -> false
diff --git a/asmcomp/mach.mli b/asmcomp/mach.mli
new file mode 100644
index 00000000..1141d57d
--- /dev/null
+++ b/asmcomp/mach.mli
@@ -0,0 +1,141 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Representation of machine code by sequences of pseudoinstructions *)
+
+(** N.B. Backends vary in their treatment of call gc and checkbound
+    points.  If the positioning of any labels associated with these is
+    important for some new feature in the compiler, the relevant backends'
+    behaviour should be checked. *)
+type label = Cmm.label
+
+type integer_comparison =
+    Isigned of Cmm.integer_comparison
+  | Iunsigned of Cmm.integer_comparison
+
+type integer_operation =
+    Iadd | Isub | Imul | Imulh | Idiv | Imod
+  | Iand | Ior | Ixor | Ilsl | Ilsr | Iasr
+  | Icomp of integer_comparison
+  | Icheckbound of { label_after_error : label option;
+        spacetime_index : int; }
+    (** For Spacetime only, [Icheckbound] operations take two arguments, the
+        second being the pointer to the trie node for the current function
+        (and the first being as per non-Spacetime mode). *)
+
+type float_comparison = Cmm.float_comparison
+
+type test =
+    Itruetest
+  | Ifalsetest
+  | Iinttest of integer_comparison
+  | Iinttest_imm of integer_comparison * int
+  | Ifloattest of float_comparison
+  | Ioddtest
+  | Ieventest
+
+type operation =
+    Imove
+  | Ispill
+  | Ireload
+  | Iconst_int of nativeint
+  | Iconst_float of int64
+  | Iconst_symbol of string
+  | Icall_ind of { label_after : label; }
+  | Icall_imm of { func : string; label_after : label; }
+  | Itailcall_ind of { label_after : label; }
+  | Itailcall_imm of { func : string; label_after : label; }
+  | Iextcall of { func : string; alloc : bool; label_after : label; }
+  | Istackoffset of int
+  | Iload of Cmm.memory_chunk * Arch.addressing_mode
+  | Istore of Cmm.memory_chunk * Arch.addressing_mode * bool
+                                 (* false = initialization, true = assignment *)
+  | Ialloc of { bytes : int; label_after_call_gc : label option;
+      dbginfo : Debuginfo.alloc_dbginfo; spacetime_index : int; }
+    (** For Spacetime only, Ialloc instructions take one argument, being the
+        pointer to the trie node for the current function. *)
+  | Iintop of integer_operation
+  | Iintop_imm of integer_operation * int
+  | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
+  | Ifloatofint | Iintoffloat
+  | Ispecific of Arch.specific_operation
+  | Iname_for_debugger of { ident : Backend_var.t; which_parameter : int option;
+      provenance : unit option; is_assignment : bool; }
+    (** [Iname_for_debugger] has the following semantics:
+        (a) The argument register(s) is/are deemed to contain the value of the
+            given identifier.
+        (b) If [is_assignment] is [true], any information about other [Reg.t]s
+            that have been previously deemed to hold the value of that
+            identifier is forgotten. *)
+
+type instruction =
+  { desc: instruction_desc;
+    next: instruction;
+    arg: Reg.t array;
+    res: Reg.t array;
+    dbg: Debuginfo.t;
+    mutable live: Reg.Set.t;
+    mutable available_before: Reg_availability_set.t;
+    mutable available_across: Reg_availability_set.t option;
+  }
+
+and instruction_desc =
+    Iend
+  | Iop of operation
+  | Ireturn
+  | Iifthenelse of test * instruction * instruction
+  | Iswitch of int array * instruction array
+  | Icatch of Cmm.rec_flag * (int * instruction) list * instruction
+  | Iexit of int
+  | Itrywith of instruction * instruction
+  | Iraise of Lambda.raise_kind
+
+type spacetime_part_of_shape =
+  | Direct_call_point of { callee : string; (* the symbol *) }
+  | Indirect_call_point
+  | Allocation_point
+
+(** A description of the layout of a Spacetime profiling node associated with
+    a given function.  Each call and allocation point instrumented within
+    the function is marked with a label in the code and assigned a place
+    within the node.  This information is stored within the executable and
+    extracted when the user saves a profile.  The aim is to minimise runtime
+    memory usage within the nodes and increase performance. *)
+type spacetime_shape = (spacetime_part_of_shape * Cmm.label) list
+
+type fundecl =
+  { fun_name: string;
+    fun_args: Reg.t array;
+    fun_body: instruction;
+    fun_codegen_options : Cmm.codegen_option list;
+    fun_dbg : Debuginfo.t;
+    fun_spacetime_shape : spacetime_shape option;
+    fun_num_stack_slots: int array;
+    fun_contains_calls: bool;
+  }
+
+val dummy_instr: instruction
+val end_instr: unit -> instruction
+val instr_cons:
+      instruction_desc -> Reg.t array -> Reg.t array -> instruction ->
+        instruction
+val instr_cons_debug:
+      instruction_desc -> Reg.t array -> Reg.t array -> Debuginfo.t ->
+        instruction -> instruction
+val instr_iter: (instruction -> unit) -> instruction -> unit
+
+val spacetime_node_hole_pointer_is_live_before : instruction -> bool
+
+val operation_can_raise : operation -> bool
diff --git a/asmcomp/power/CSE.ml b/asmcomp/power/CSE.ml
new file mode 100644
index 00000000..b8454ffd
--- /dev/null
+++ b/asmcomp/power/CSE.ml
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* CSE for the PowerPC *)
+
+open Arch
+open Mach
+open CSEgen
+
+class cse = object
+
+inherit cse_generic as super
+
+method! class_of_operation op =
+  match op with
+  | Ispecific(Imultaddf | Imultsubf) -> Op_pure
+  | Ispecific(Ialloc_far _) -> Op_other
+  | _ -> super#class_of_operation op
+
+method! is_cheap_operation op =
+  match op with
+  | Iconst_int n -> n <= 32767n && n >= -32768n
+  | _ -> false
+
+end
+
+let fundecl f =
+  (new cse)#fundecl f
diff --git a/asmcomp/power/NOTES.md b/asmcomp/power/NOTES.md
new file mode 100644
index 00000000..d54c0869
--- /dev/null
+++ b/asmcomp/power/NOTES.md
@@ -0,0 +1,26 @@
+# Supported platforms
+
+IBM POWER and Freescale (nee Motorola) PowerPC processors, in three flavors:
+* 32 bits, ELF ABI: Debian's `powerpc`
+* 64 bits big-endian, ELF ABI v1: Debian's `powerpc`
+* 64 bits little-endian, ELF ABI v2: Debian's `ppc64el`
+
+No longer supported: AIX and MacOS X.
+
+# Reference documents
+
+* Instruction set architecture:
+  _PowerPC User Instruction Set Architecture_,
+  book 1 of _PowerPC Architecture Book_
+  (http://www.ibm.com/developerworks/systems/library/es-archguide-v2.html).
+* ELF ABI 32 bits:
+  _System V Application Binary Interface, PowerPC Processor Supplement_
+* ELF ABI 64 bits version 1:
+  _64-bit PowerPC ELF Application Binary Interface Supplement_
+  (http://refspecs.linuxfoundation.org/ELF/ppc64/PPC-elf64abi.html)
+* ELF ABI 64 bits version 2:
+   _Power Architecture 64-bit ELF V2 ABI Specification,
+    OpenPOWER ABI for Linux Supplement_
+  (http://openpowerfoundation.org/technical/technical-resources/technical-specifications/)
+* _The PowerPC Compiler Writer's Guide_, Warthman Associates, 1996.
+  (PDF available from various sources on the Web.)
diff --git a/asmcomp/power/arch.ml b/asmcomp/power/arch.ml
new file mode 100644
index 00000000..07bf8dbf
--- /dev/null
+++ b/asmcomp/power/arch.ml
@@ -0,0 +1,125 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Specific operations for the PowerPC processor *)
+
+open Format
+
+let ppc64 =
+  match Config.model with
+  | "ppc" -> false
+  | "ppc64" | "ppc64le" -> true
+  | _ -> assert false
+
+type abi = ELF32 | ELF64v1 | ELF64v2
+
+let abi =
+  match Config.model with
+  | "ppc" -> ELF32
+  | "ppc64" -> ELF64v1
+  | "ppc64le" -> ELF64v2
+  | _ -> assert false
+
+(* Machine-specific command-line options *)
+
+let big_toc = ref true
+
+let command_line_options = [
+  "-flarge-toc", Arg.Set big_toc,
+     " Support TOC (table of contents) greater than 64 kbytes (default)";
+  "-fsmall-toc", Arg.Clear big_toc,
+     " TOC (table of contents) is limited to 64 kbytes"
+]
+
+(* Specific operations *)
+
+type specific_operation =
+    Imultaddf                           (* multiply and add *)
+  | Imultsubf                           (* multiply and subtract *)
+  | Ialloc_far of                       (* allocation in large functions *)
+      { bytes : int; label_after_call_gc : int (*Cmm.label*) option;
+        dbginfo : Debuginfo.alloc_dbginfo }
+
+(* note: we avoid introducing a dependency to Cmm since this dep
+   is not detected when "make depend" is run under amd64 *)
+
+let spacetime_node_hole_pointer_is_live_before = function
+  | Imultaddf | Imultsubf -> false
+  | Ialloc_far _ -> true
+
+(* Addressing modes *)
+
+type addressing_mode =
+    Ibased of string * int              (* symbol + displ *)
+  | Iindexed of int                     (* reg + displ *)
+  | Iindexed2                           (* reg + reg *)
+
+(* Sizes, endianness *)
+
+let big_endian =
+  match Config.model with
+  | "ppc" -> true
+  | "ppc64" -> true
+  | "ppc64le" -> false
+  | _ -> assert false
+
+let size_addr = if ppc64 then 8 else 4
+let size_int = size_addr
+let size_float = 8
+
+let allow_unaligned_access = true
+
+(* Behavior of division *)
+
+let division_crashes_on_overflow = true
+
+(* Operations on addressing modes *)
+
+let identity_addressing = Iindexed 0
+
+let offset_addressing addr delta =
+  match addr with
+    Ibased(s, n) -> Ibased(s, n + 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 =
+  match addr with
+  | Ibased(s, n) ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "\"%s\"%s" s idx
+  | Iindexed n ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a%s" printreg arg.(0) idx
+  | Iindexed2 ->
+      fprintf ppf "%a + %a" printreg arg.(0) printreg arg.(1)
+
+let print_specific_operation printreg op ppf arg =
+  match op with
+  | Imultaddf ->
+      fprintf ppf "%a *f %a +f %a"
+        printreg arg.(0) printreg arg.(1) printreg arg.(2)
+  | Imultsubf ->
+      fprintf ppf "%a *f %a -f %a"
+        printreg arg.(0) printreg arg.(1) printreg arg.(2)
+  | Ialloc_far { bytes; _ } ->
+      fprintf ppf "alloc_far %d" bytes
diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp
new file mode 100644
index 00000000..5a28f556
--- /dev/null
+++ b/asmcomp/power/emit.mlp
@@ -0,0 +1,1230 @@
+#2 "asmcomp/power/emit.mlp"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Emission of PowerPC assembly code *)
+
+open Cmm
+open Arch
+open Proc
+open Reg
+open Mach
+open Linear
+open Emitaux
+
+(* Reserved space at bottom of stack *)
+
+let reserved_stack_space =
+  match abi with
+  | ELF32 -> 0
+  | ELF64v1 -> 48
+  | ELF64v2 -> 32
+
+(* Layout of the stack.  The stack is kept 16-aligned. *)
+
+let stack_offset = ref 0
+
+let num_stack_slots = Array.make Proc.num_register_classes 0
+
+let prologue_required = ref false
+
+let contains_calls = ref false
+
+let frame_size () =
+  let size =
+    reserved_stack_space +
+    !stack_offset +                     (* Trap frame, outgoing parameters *)
+    size_int * num_stack_slots.(0) +    (* Local int variables *)
+    size_float * num_stack_slots.(1) +  (* Local float variables *)
+    (if !contains_calls && abi = ELF32 then size_int else 0) in
+                                        (* The return address *)
+  Misc.align size 16
+
+let slot_offset loc cls =
+  match loc with
+    Local n ->
+      reserved_stack_space + !stack_offset +
+      (if cls = 0 then num_stack_slots.(1) * size_float + n * size_int
+                  else n * size_float)
+  | Incoming n -> frame_size() + reserved_stack_space + n
+  | Outgoing n -> reserved_stack_space + n
+
+let retaddr_offset () =
+  match abi with
+  | ELF32 -> frame_size() - size_addr
+  | ELF64v1 | ELF64v2 -> frame_size() + 16
+
+let toc_save_offset () =
+  match abi with
+  | ELF32 -> assert false
+  | ELF64v1 | ELF64v2 -> frame_size() + 8
+
+let (trap_size, trap_handler_offset, trap_previous_offset) =
+  match abi with
+  | ELF32 -> (16, 0, 4)
+  | ELF64v1 -> (32, 56, 64)
+  | ELF64v2 -> (32, 40, 48)
+
+(* Output a symbol *)
+
+let emit_symbol s = Emitaux.emit_symbol '.' s
+
+(* Output a label *)
+
+let label_prefix = ".L"
+
+let emit_label lbl =
+  emit_string label_prefix; emit_int lbl
+
+(* Section switching *)
+
+let code_space =
+  "	.section \".text\"\n"
+
+let function_descr_space =
+  match abi with
+  | ELF32 -> code_space
+  | ELF64v1 -> "	.section \".opd\",\"aw\"\n"
+  | ELF64v2 -> code_space
+
+let data_space =
+  "	.section \".data\"\n"
+
+let rodata_space =
+  "	.section \".rodata\"\n"
+
+let toc_space =
+  " .section \".toc\",\"aw\"\n"
+
+(* Names of instructions that differ in 32 and 64-bit modes *)
+
+let lg = if ppc64 then "ld" else "lwz"
+let stg = if ppc64 then "std" else "stw"
+let lwa = if ppc64 then "lwa" else "lwz"
+let cmpg = if ppc64 then "cmpd" else "cmpw"
+let cmplg = if ppc64 then "cmpld" else "cmplw"
+let datag = if ppc64 then ".quad" else ".long"
+let mullg = if ppc64 then "mulld" else "mullw"
+let divg = if ppc64 then "divd" else "divw"
+let tglle = if ppc64 then "tdlle" else "twlle"
+
+(* Output a processor register *)
+
+let emit_gpr = emit_int
+
+(* Output a pseudo-register *)
+
+let emit_reg r =
+  match r.loc with
+  | Reg r -> emit_string (register_name r)
+  | _ -> Misc.fatal_error "Emit.emit_reg"
+
+(* Output a stack reference *)
+
+let emit_stack r =
+  match r.loc with
+  | Stack s ->
+      let ofs = slot_offset s (register_class r) in `{emit_int ofs}(1)`
+  | _ -> Misc.fatal_error "Emit.emit_stack"
+
+(* Output the name of a symbol plus an optional offset *)
+
+let emit_symbol_offset (s, d) =
+  emit_symbol s;
+  if d > 0 then `+`;
+  if d <> 0 then emit_int d
+
+(* Split a 32-bit integer constants in two 16-bit halves *)
+
+let low_high_u n = (n land 0xFFFF, n asr 16)
+  (* unsigned low half, for use with "ori" *)
+
+let native_low_high_u n =
+  (Nativeint.(to_int (logand n 0xFFFFn)),
+   Nativeint.(to_int (shift_right n 16)))
+  (* unsigned low half, for use with "ori" *)
+
+let low_high_s n =
+  let lo = ((n + 0x8000) land 0xFFFF) - 0x8000 in
+  (lo, (n - lo) asr 16)
+  (* signed low half, for use with "addi" *)
+
+let native_low_high_s n =
+  let lo = Nativeint.(sub (logand (add n 0x8000n) 0xFFFFn) 0x8000n) in
+  (Nativeint.to_int lo,
+   Nativeint.(to_int (shift_right (sub n lo) 16)))
+  (* signed low half, for use with "addi" *)
+
+let is_immediate n =
+  n <= 32767 && n >= -32768
+
+let is_native_immediate n =
+  n <= 32767n && n >= -32768n
+
+(* Record TOC entries *)
+
+type tocentry =
+  | TocSym of string
+  | TocLabel of int
+  | TocInt of nativeint
+  | TocFloat of int64
+
+let tocref_entries : (tocentry, label) Hashtbl.t = Hashtbl.create 64
+
+let emit_tocentry = function
+  | TocSym s -> emit_symbol s
+  | TocInt i -> emit_nativeint i
+  | TocFloat f -> emit_printf "0x%Lx # %.12g" f (Int64.float_of_bits f)
+  | TocLabel lbl -> emit_label lbl
+
+let label_for_tocref entry =
+  try
+    Hashtbl.find tocref_entries entry
+  with Not_found ->
+    let lbl = new_label() in
+    Hashtbl.add tocref_entries entry lbl;
+    lbl
+
+let emit_toctable () =
+  Hashtbl.iter
+    (fun entry lbl ->
+      `{emit_label lbl}:	.quad	{emit_tocentry entry}\n`)
+    tocref_entries
+
+(* Emit a load from a TOC entry.
+
+   The [dest] should not be r0, since [dest] is used as the index register for a
+   ld instruction, but r0 reads as zero when used as an index register.
+*)
+let emit_tocload emit_dest dest entry =
+  let lbl = label_for_tocref entry in
+  if !big_toc || !Clflags.for_package <> None then begin
+    `	addis	{emit_dest dest}, 2, {emit_label lbl}@toc@ha\n`;
+    `	ld	{emit_dest dest}, {emit_label lbl}@toc@l({emit_dest dest}) # {emit_tocentry entry}\n`
+  end else begin
+    `	ld	{emit_dest dest}, {emit_label lbl}@toc(2) # {emit_tocentry entry}\n`
+  end
+
+(* Output a "upper 16 bits" or "lower 16 bits" operator. *)
+
+let emit_upper emit_fun arg =
+  emit_fun arg; emit_string "@ha"
+
+let emit_lower emit_fun arg =
+  emit_fun arg; emit_string "@l"
+
+(* Output a load or store operation *)
+
+let valid_offset instr ofs =
+  ofs land 3 = 0 || (instr <> "ld" && instr <> "std" && instr <> "lwa")
+
+let emit_load_store instr addressing_mode addr n arg =
+  match addressing_mode with
+  | Ibased(s, d) ->
+      begin match abi with
+      | ELF32 ->
+        `	addis	11, 0, {emit_upper emit_symbol_offset (s,d)}\n`;
+        `	{emit_string instr}	{emit_reg arg}, {emit_lower emit_symbol_offset (s,d)}(11)\n`
+      | ELF64v1 | ELF64v2 ->
+        emit_tocload emit_gpr 11 (TocSym s);
+        let (lo, hi) = low_high_s d in
+        if hi <> 0 then
+          `	addis	11, 11, {emit_int hi}\n`;
+        `	{emit_string instr}	{emit_reg arg}, {emit_int lo}(11)\n`
+      end
+  | Iindexed ofs ->
+      if is_immediate ofs && valid_offset instr ofs then
+        `	{emit_string instr}	{emit_reg arg}, {emit_int ofs}({emit_reg addr.(n)})\n`
+      else begin
+        let (lo, hi) = low_high_u ofs in
+        `	addis	0, 0, {emit_int hi}\n`;
+        if lo <> 0 then
+          `	ori	0, 0, {emit_int lo}\n`;
+        `	{emit_string instr}x	{emit_reg arg}, {emit_reg addr.(n)}, 0\n`
+      end
+  | Iindexed2 ->
+      `	{emit_string instr}x	{emit_reg arg}, {emit_reg addr.(n)}, {emit_reg addr.(n+1)}\n`
+
+(* After a comparison, extract the result as 0 or 1 *)
+
+let emit_set_comp cmp res =
+  `	mfcr	0\n`;
+  let bitnum =
+    match cmp with
+      Ceq | Cne -> 2
+    | Cgt | Cle -> 1
+    | Clt | Cge -> 0 in
+`	rlwinm	{emit_reg res}, 0, {emit_int(bitnum+1)}, 31, 31\n`;
+  begin match cmp with
+    Cne | Cle | Cge -> `	xori	{emit_reg res}, {emit_reg res}, 1\n`
+  | _ -> ()
+  end
+
+(* Free the stack frame *)
+
+let emit_free_frame () =
+  let n = frame_size() in
+  if n > 0 then
+    `	addi	1, 1, {emit_int n}\n`
+
+(* Emit a "bl" instruction to a given symbol *)
+
+let emit_call s =
+  match abi with
+  | ELF32 when !Clflags.dlcode || !Clflags.pic_code ->
+    `	bl	{emit_symbol s}@plt\n`
+  | _ ->
+    `	bl	{emit_symbol s}\n`
+
+(* Add a nop after a "bl" call for ELF64 *)
+
+let emit_call_nop () =
+  match abi with
+  | ELF32 -> ()
+  | ELF64v1 | ELF64v2 -> `	nop	\n`
+
+(* Reload the TOC register r2 from the value saved on the stack *)
+
+let emit_reload_toc () =
+  `	ld	2, {emit_int (toc_save_offset())}(1)\n`
+
+(* Adjust stack_offset and emit corresponding CFI directive *)
+
+let adjust_stack_offset delta =
+  stack_offset := !stack_offset + delta;
+  cfi_adjust_cfa_offset delta
+
+(* Record live pointers at call points *)
+
+let record_frame ?label live dbg =
+  let lbl =
+    match label with
+    | None -> new_label()
+    | Some label -> label
+  in
+  let live_offset = ref [] in
+  Reg.Set.iter
+    (function
+      | {typ = Val; loc = Reg r} ->
+          live_offset := ((r lsl 1) + 1) :: !live_offset
+      | {typ = Val; loc = Stack s} as reg ->
+          live_offset := slot_offset s (register_class reg) :: !live_offset
+      | {typ = Addr} as r ->
+          Misc.fatal_error ("bad GC root " ^ Reg.name r)
+      | _ -> ())
+    live;
+  record_frame_descr ~label:lbl ~frame_size:(frame_size())
+    ~live_offset:!live_offset dbg;
+  `{emit_label lbl}:\n`
+
+(* Record floating-point literals (for PPC32) *)
+
+let float_literals = ref ([] : (int64 * int) list)
+
+(* Record jump tables (for PPC64).  In order to reduce the size of the TOC,
+   we concatenate all jumptables and emit them at the end of the compilation
+   unit. *)
+
+let jumptables = ref ([] : label list)  (* in reverse order *)
+let jumptables_lbl = ref (-1)
+
+(* Names for conditional branches after comparisons *)
+
+let branch_for_comparison = function
+    Ceq -> "beq" | Cne -> "bne"
+  | Cle -> "ble" | Cgt -> "bgt"
+  | Cge -> "bge" | Clt -> "blt"
+
+let name_for_int_comparison = function
+    Isigned cmp -> (cmpg, branch_for_comparison cmp)
+  | Iunsigned cmp -> (cmplg, branch_for_comparison cmp)
+
+(* Names for various instructions *)
+
+let name_for_intop = function
+    Iadd  -> "add"
+  | Imul  -> if ppc64 then "mulld" else "mullw"
+  | Imulh -> if ppc64 then "mulhd" else "mulhw"
+  | Idiv  -> if ppc64 then "divd" else "divw"
+  | Iand  -> "and"
+  | Ior   -> "or"
+  | Ixor  -> "xor"
+  | Ilsl  -> if ppc64 then "sld" else "slw"
+  | Ilsr  -> if ppc64 then "srd" else "srw"
+  | Iasr  -> if ppc64 then "srad" else "sraw"
+  | _ -> Misc.fatal_error "Emit.Intop"
+
+let name_for_intop_imm = function
+    Iadd -> "addi"
+  | Imul -> "mulli"
+  | Iand -> "andi."
+  | Ior  -> "ori"
+  | Ixor -> "xori"
+  | Ilsl -> if ppc64 then "sldi" else "slwi"
+  | Ilsr -> if ppc64 then "srdi" else "srwi"
+  | Iasr -> if ppc64 then "sradi" else "srawi"
+  | _ -> Misc.fatal_error "Emit.Intop_imm"
+
+let name_for_floatop1 = function
+    Inegf -> "fneg"
+  | Iabsf -> "fabs"
+  | _ -> Misc.fatal_error "Emit.Iopf1"
+
+let name_for_floatop2 = function
+    Iaddf -> "fadd"
+  | Isubf -> "fsub"
+  | Imulf -> "fmul"
+  | Idivf -> "fdiv"
+  | _ -> Misc.fatal_error "Emit.Iopf2"
+
+let name_for_specific = function
+    Imultaddf -> "fmadd"
+  | Imultsubf -> "fmsub"
+  | _ -> Misc.fatal_error "Emit.Ispecific"
+
+(* Name of current function *)
+let function_name = ref ""
+(* Entry point for tail recursive calls *)
+let tailrec_entry_point = ref 0
+(* Label of glue code for calling the GC *)
+let call_gc_label = ref 0
+
+(* Relaxation of branches that exceed the span of a relative branch. *)
+
+module BR = Branch_relaxation.Make (struct
+  type distance = int
+
+  module Cond_branch = struct
+    type t = Branch
+
+    let all = [Branch]
+
+    let max_displacement = function
+      (* 14-bit signed offset in words. *)
+      | Branch -> 8192
+
+    let classify_instr = function
+      | Lop (Ialloc _)
+      (* [Ialloc_far] does not need to be here, since its code sequence
+         never involves any conditional branches that might need relaxing. *)
+      | Lcondbranch _
+      | Lcondbranch3 _ -> Some Branch
+      | _ -> None
+  end
+
+  let offset_pc_at_branch = 1
+
+  let size =
+    match abi with
+    | ELF32 -> (fun a _ _ -> a)
+    | ELF64v1 -> (fun _ b _ -> b)
+    | ELF64v2 -> (fun _ _ c -> c)
+
+  let profiling_prologue_size () =
+    match abi with
+    | ELF32 -> 5
+    | ELF64v1 | ELF64v2 -> 6
+
+  let prologue_size () =
+    profiling_prologue_size ()
+      + (if frame_size () > 0 then 1 else 0)
+      + (if !contains_calls then
+           2 +
+             match abi with
+             | ELF32 -> 0
+             | ELF64v1 | ELF64v2 -> 1
+         else 0)
+
+  let tocload_size() =
+    if !big_toc || !Clflags.for_package <> None then 2 else 1
+
+  let load_store_size = function
+    | Ibased(_s, d) ->
+        if abi = ELF32 then 2 else begin
+          let (_lo, hi) = low_high_s d in
+          tocload_size() + (if hi = 0 then 1 else 2)
+        end
+    | Iindexed ofs -> if is_immediate ofs then 1 else 3
+    | Iindexed2 -> 1
+
+  let instr_size = function
+    | Lend -> 0
+    | Lprologue -> prologue_size ()
+    | Lop(Imove | Ispill | Ireload) -> 1
+    | Lop(Iconst_int n) ->
+      if is_native_immediate n then 1
+      else if (let (_lo, hi) = native_low_high_s n in
+               hi >= -0x8000 && hi <= 0x7FFF) then 2
+      else if (let (_lo, hi) = native_low_high_u n in
+               hi >= -0x8000 && hi <= 0x7FFF) then 2
+      else tocload_size()
+    | Lop(Iconst_float _) -> if abi = ELF32 then 2 else tocload_size()
+    | Lop(Iconst_symbol _) -> if abi = ELF32 then 2 else tocload_size()
+    | Lop(Icall_ind _) -> size 2 5 4
+    | Lop(Icall_imm _) -> size 1 3 3
+    | Lop(Itailcall_ind _) -> size 5 7 6
+    | Lop(Itailcall_imm { func; _ }) ->
+        if func = !function_name
+        then 1
+        else size 4 (7 + tocload_size()) (6 + tocload_size())
+    | Lop(Iextcall { alloc = true; _ }) ->
+      size 3 (2 + tocload_size()) (2 + tocload_size())
+    | Lop(Iextcall { alloc = false; _}) -> size 1 2 2
+    | Lop(Istackoffset _) -> 1
+    | Lop(Iload(chunk, addr)) ->
+      if chunk = Byte_signed
+      then load_store_size addr + 1
+      else load_store_size addr
+    | Lop(Istore(_chunk, addr, _)) -> load_store_size addr
+    | Lop(Ialloc _) -> 4
+    | Lop(Ispecific(Ialloc_far _)) -> 5
+    | Lop(Iintop Imod) -> 3
+    | Lop(Iintop(Icomp _)) -> 4
+    | Lop(Iintop _) -> 1
+    | Lop(Iintop_imm(Icomp _, _)) -> 4
+    | Lop(Iintop_imm _) -> 1
+    | Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf) -> 1
+    | Lop(Ifloatofint) -> 9
+    | Lop(Iintoffloat) -> 4
+    | Lop(Ispecific _) -> 1
+    | Lop (Iname_for_debugger _) -> 0
+    | Lreloadretaddr -> 2
+    | Lreturn -> 2
+    | Llabel _ -> 0
+    | Lbranch _ -> 1
+    | Lcondbranch _ -> 2
+    | Lcondbranch3(lbl0, lbl1, lbl2) ->
+      1 + (if lbl0 = None then 0 else 1)
+        + (if lbl1 = None then 0 else 1)
+        + (if lbl2 = None then 0 else 1)
+    | Lswitch _ -> size 7 (5 + tocload_size()) (5 + tocload_size())
+    | Lentertrap -> size 0 (tocload_size()) (tocload_size())
+    | Ladjust_trap_depth _ -> 0
+    | Lpushtrap _ -> size 5 (4 + tocload_size()) (4 + tocload_size())
+    | Lpoptrap -> 2
+    | Lraise _ -> 6
+
+  let relax_allocation ~num_bytes:bytes ~label_after_call_gc ~dbginfo =
+    Lop (Ispecific (Ialloc_far { bytes; label_after_call_gc; dbginfo }))
+
+  (* [classify_addr], above, never identifies these instructions as needing
+     relaxing.  As such, these functions should never be called. *)
+  let relax_specific_op _ = assert false
+  let relax_intop_checkbound ~label_after_error:_ = assert false
+  let relax_intop_imm_checkbound ~bound:_ ~label_after_error:_ = assert false
+end)
+
+(* Output the assembly code for an instruction *)
+
+let emit_instr i =
+    emit_debug_info i.dbg;
+    match i.desc with
+    | Lend -> ()
+    | Lprologue ->
+      assert (!prologue_required);
+      let n = frame_size() in
+      if n > 0 then begin
+        `	addi	1, 1, {emit_int(-n)}\n`;
+        cfi_adjust_cfa_offset n
+      end;
+      if !contains_calls then begin
+        let ra = retaddr_offset() in
+        `	mflr	0\n`;
+        `	{emit_string stg}	0, {emit_int ra}(1)\n`;
+        cfi_offset ~reg: 65 (* LR *) ~offset: (ra - n);
+        match abi with
+        | ELF32 -> ()
+        | ELF64v1 | ELF64v2 ->
+          `	std	2, {emit_int(toc_save_offset())}(1)\n`
+      end
+    | Lop(Imove | Ispill | Ireload) ->
+        let src = i.arg.(0) and dst = i.res.(0) in
+        if src.loc <> dst.loc then begin
+           match (src, dst) with
+           |  {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Reg _} ->
+                `	mr	{emit_reg dst}, {emit_reg src}\n`
+            | {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} ->
+                `	fmr	{emit_reg dst}, {emit_reg src}\n`
+            | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack _} ->
+                `	{emit_string stg}	{emit_reg src}, {emit_stack dst}\n`
+            | {loc = Reg _; typ = Float}, {loc = Stack _} ->
+                `	stfd	{emit_reg src}, {emit_stack dst}\n`
+            | {loc = Stack _; typ = (Val | Int | Addr)}, {loc = Reg _} ->
+                `	{emit_string lg}	{emit_reg dst}, {emit_stack src}\n`
+            | {loc = Stack _; typ = Float}, {loc = Reg _} ->
+                `	lfd	{emit_reg dst}, {emit_stack src}\n`
+            | (_, _) ->
+                Misc.fatal_error "Emit: Imove"
+        end
+    | Lop(Iconst_int n) ->
+        if is_native_immediate n then
+          `	li	{emit_reg i.res.(0)}, {emit_nativeint n}\n`
+        else begin
+        (* Try a signed decomposition first, because the sequence
+           addis/addi is eligible for instruction fusion. *)
+        let (lo, hi) = native_low_high_s n in
+        if hi >= -0x8000 && hi <= 0x7FFF then begin
+          `	addis	{emit_reg i.res.(0)}, 0, {emit_int hi}\n`;
+          if lo <> 0 then
+          `	addi	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, {emit_int lo}\n`
+        end else begin
+        (* Now try an unsigned decomposition *)
+        let (lo, hi) = native_low_high_u n in
+        if hi >= -0x8000 && hi <= 0x7FFF then begin
+          `	addis	{emit_reg i.res.(0)}, 0, {emit_int hi}\n`;
+          if lo <> 0 then
+          `	ori	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, {emit_int lo}\n`
+        end else begin
+          match abi with
+          | ELF32 -> assert false
+          | ELF64v1 | ELF64v2 ->
+              emit_tocload emit_reg i.res.(0) (TocInt n)
+        end end end
+    | Lop(Iconst_float f) ->
+        begin match abi with
+        | ELF32 ->
+          let lbl = new_label() in
+          float_literals := (f, lbl) :: !float_literals;
+          `	addis	11, 0, {emit_upper emit_label lbl}\n`;
+          `	lfd	{emit_reg i.res.(0)}, {emit_lower emit_label lbl}(11)\n`
+        | ELF64v1 | ELF64v2 ->
+          let entry = TocFloat f in
+          let lbl = label_for_tocref entry in
+          if !big_toc || !Clflags.for_package <> None then begin
+            `	addis	11, 2, {emit_label lbl}@toc@ha\n`;
+            `	lfd	{emit_reg i.res.(0)}, {emit_label lbl}@toc@l(11) # {emit_tocentry entry}\n`
+          end else begin
+            `	lfd	{emit_reg i.res.(0)}, {emit_label lbl}@toc(2) # {emit_tocentry entry}\n`
+          end
+        end
+    | Lop(Iconst_symbol s) ->
+        begin match abi with
+        | ELF32 ->
+          `	addis	{emit_reg i.res.(0)}, 0, {emit_upper emit_symbol s}\n`;
+          `	addi	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, {emit_lower emit_symbol s}\n`
+        | ELF64v1 | ELF64v2 ->
+          emit_tocload emit_reg i.res.(0) (TocSym s)
+        end
+    | Lop(Icall_ind { label_after; }) ->
+        begin match abi with
+        | ELF32 ->
+          `	mtctr	{emit_reg i.arg.(0)}\n`;
+          `	bctrl\n`;
+          record_frame i.live (Dbg_other i.dbg) ~label:label_after
+        | ELF64v1 ->
+          `	ld	0, 0({emit_reg i.arg.(0)})\n`;  (* code pointer *)
+          `	mtctr	0\n`;
+          `	ld	2, 8({emit_reg i.arg.(0)})\n`;  (* TOC for callee *)
+          `	bctrl\n`;
+          record_frame i.live (Dbg_other i.dbg) ~label:label_after;
+          emit_reload_toc()
+        | ELF64v2 ->
+          `	mtctr	{emit_reg i.arg.(0)}\n`;
+          `	mr	12, {emit_reg i.arg.(0)}\n`;  (* addr of fn in r12 *)
+          `	bctrl\n`;
+          record_frame i.live (Dbg_other i.dbg) ~label:label_after;
+          emit_reload_toc()
+        end
+    | Lop(Icall_imm { func; label_after; }) ->
+        begin match abi with
+        | ELF32 ->
+            emit_call func;
+            record_frame i.live (Dbg_other i.dbg) ~label:label_after
+        | ELF64v1 | ELF64v2 ->
+        (* For PPC64, we cannot just emit a "bl s; nop" sequence, because
+           of the following scenario:
+              - current function f1 calls f2 that has the same TOC
+              - f2 tailcalls f3 that has a different TOC
+           Because f1 and f2 have the same TOC, the linker inserted no
+           code in f1 to save and restore r2 around the call to f2.
+           Because f2 tailcalls f3, r2 will not be restored to f2's TOC
+           when f3 returns.  So, we're back into f1, with the wrong TOC in r2.
+           We have two options:
+             1- Turn the call into an indirect call, like we do for
+                Itailcall_imm.  Cost: 6 instructions.
+             2- Follow the "bl" with an instruction to restore r2
+                explicitly.  If the called function has a different TOC,
+                this instruction is redundant with those inserted
+                by the linker, but this is harmless.
+                Cost: 3 instructions if same TOC, 7 if different TOC.
+           Let's try option 2. *)
+            emit_call func;
+            record_frame i.live (Dbg_other i.dbg) ~label:label_after;
+            `	nop\n`;
+            emit_reload_toc()
+        end
+    | Lop(Itailcall_ind { label_after = _; }) ->
+        begin match abi with
+        | ELF32 ->
+          `	mtctr	{emit_reg i.arg.(0)}\n`
+        | ELF64v1 ->
+          `	ld	0, 0({emit_reg i.arg.(0)})\n`;  (* code pointer *)
+          `	mtctr	0\n`;
+          `	ld	2, 8({emit_reg i.arg.(0)})\n`   (* TOC for callee *)
+        | ELF64v2 ->
+          `	mtctr	{emit_reg i.arg.(0)}\n`;
+          `	mr	12, {emit_reg i.arg.(0)}\n`   (* addr of fn in r12 *)
+        end;
+        if !contains_calls then begin
+          `	{emit_string lg}	11, {emit_int(retaddr_offset())}(1)\n`;
+          `	mtlr	11\n`
+        end;
+        emit_free_frame();
+        `	bctr\n`
+    | Lop(Itailcall_imm { func; label_after = _; }) ->
+        if func = !function_name then
+          `	b	{emit_label !tailrec_entry_point}\n`
+        else begin
+          begin match abi with
+          | ELF32 ->
+            ()
+          | ELF64v1 ->
+            emit_tocload emit_gpr 11 (TocSym func);
+            `	ld	0, 0(11)\n`;  (* code pointer *)
+            `	mtctr	0\n`;
+            `	ld	2, 8(11)\n`   (* TOC for callee *)
+          | ELF64v2 ->
+            emit_tocload emit_gpr 12 (TocSym func); (* addr of fn must be in r12 *)
+            `	mtctr	12\n`
+          end;
+          if !contains_calls then begin
+            `	{emit_string lg}	11, {emit_int(retaddr_offset())}(1)\n`;
+            `	mtlr	11\n`
+          end;
+          emit_free_frame();
+          begin match abi with
+          | ELF32 ->
+            `	b	{emit_symbol func}\n`
+          | ELF64v1 | ELF64v2 ->
+            `	bctr\n`
+          end
+        end
+    | Lop(Iextcall { func; alloc; }) ->
+        if not alloc then begin
+          emit_call func;
+          emit_call_nop()
+        end else begin
+          match abi with
+          | ELF32 ->
+            `	addis	25, 0, {emit_upper emit_symbol func}\n`;
+            `	addi	25, 25, {emit_lower emit_symbol func}\n`;
+            emit_call "caml_c_call";
+            record_frame i.live (Dbg_other i.dbg)
+          | ELF64v1 | ELF64v2 ->
+            emit_tocload emit_gpr 25 (TocSym func);
+            emit_call "caml_c_call";
+            record_frame i.live (Dbg_other i.dbg);
+            `	nop\n`
+        end
+    | Lop(Istackoffset n) ->
+        `	addi	1, 1, {emit_int (-n)}\n`;
+        adjust_stack_offset n
+    | Lop(Iload(chunk, addr)) ->
+        let loadinstr =
+          match chunk with
+          | Byte_unsigned -> "lbz"
+          | Byte_signed -> "lbz"
+          | Sixteen_unsigned -> "lhz"
+          | Sixteen_signed -> "lha"
+          | Thirtytwo_unsigned -> "lwz"
+          | Thirtytwo_signed -> if ppc64 then "lwa" else "lwz"
+	  | Word_int | Word_val -> lg
+          | Single -> "lfs"
+          | Double | Double_u -> "lfd" in
+        emit_load_store loadinstr addr i.arg 0 i.res.(0);
+        if chunk = Byte_signed then
+          `	extsb	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
+    | Lop(Istore(chunk, addr, _)) ->
+        let storeinstr =
+          match chunk with
+          | Byte_unsigned | Byte_signed -> "stb"
+          | Sixteen_unsigned | Sixteen_signed -> "sth"
+	  | Thirtytwo_unsigned | Thirtytwo_signed -> "stw"
+	  | Word_int | Word_val -> stg
+          | Single -> "stfs"
+          | Double | Double_u -> "stfd" in
+        emit_load_store storeinstr addr i.arg 1 i.arg.(0)
+    | Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
+        if !call_gc_label = 0 then begin
+          match label_after_call_gc with
+          | None -> call_gc_label := new_label ()
+          | Some label -> call_gc_label := label
+        end;
+        `	addi    31, 31, {emit_int(-n)}\n`;
+        `	{emit_string cmplg}	31, 30\n`;
+        `	bltl	{emit_label !call_gc_label}\n`;
+        record_frame i.live (Dbg_alloc dbginfo);
+        `	addi	{emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`;
+    | Lop(Ispecific(Ialloc_far { bytes = n; label_after_call_gc; dbginfo })) ->
+        if !call_gc_label = 0 then begin
+          match label_after_call_gc with
+          | None -> call_gc_label := new_label ()
+          | Some label -> call_gc_label := label
+        end;
+        let lbl = new_label() in
+        `	addi    31, 31, {emit_int(-n)}\n`;
+        `	{emit_string cmplg}	31, 30\n`;
+        `	bge	{emit_label lbl}\n`;
+        `	bl	{emit_label !call_gc_label}\n`;
+        record_frame i.live (Dbg_alloc dbginfo);
+        `{emit_label lbl}:	addi	{emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`
+    | Lop(Iintop Isub) ->               (* subfc has swapped arguments *)
+        `	subfc	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
+    | Lop(Iintop Imod) ->
+        `	{emit_string divg}	0, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+        `	{emit_string mullg}	0, 0, {emit_reg i.arg.(1)}\n`;
+        `	subfc	{emit_reg i.res.(0)}, 0, {emit_reg i.arg.(0)}\n`
+    | Lop(Iintop(Icomp cmp)) ->
+        begin match cmp with
+          Isigned c ->
+            `	{emit_string cmpg}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+            emit_set_comp c i.res.(0)
+        | Iunsigned c ->
+            `	{emit_string cmplg}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+            emit_set_comp c i.res.(0)
+        end
+    | Lop(Iintop (Icheckbound { label_after_error; })) ->
+        if !Clflags.debug then
+          record_frame Reg.Set.empty (Dbg_other i.dbg) ?label:label_after_error;
+        `	{emit_string tglle}   {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
+    | Lop(Iintop op) ->
+        let instr = name_for_intop op in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
+    | Lop(Iintop_imm(Isub, n)) ->
+        `	addi	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int(-n)}\n`
+    | Lop(Iintop_imm(Icomp cmp, n)) ->
+        begin match cmp with
+          Isigned c ->
+            `	{emit_string cmpg}i	{emit_reg i.arg.(0)}, {emit_int n}\n`;
+            emit_set_comp c i.res.(0)
+        | Iunsigned c ->
+            `	{emit_string cmplg}i	{emit_reg i.arg.(0)}, {emit_int n}\n`;
+            emit_set_comp c i.res.(0)
+        end
+    | Lop(Iintop_imm(Icheckbound { label_after_error; }, n)) ->
+        if !Clflags.debug then
+          record_frame Reg.Set.empty (Dbg_other i.dbg) ?label:label_after_error;
+        `	{emit_string tglle}i   {emit_reg i.arg.(0)}, {emit_int n}\n`
+    | Lop(Iintop_imm(op, n)) ->
+        let instr = name_for_intop_imm op in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n`
+    | Lop(Inegf | Iabsf as op) ->
+        let instr = name_for_floatop1 op in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
+    | Lop(Iaddf | Isubf | Imulf | Idivf as op) ->
+        let instr = name_for_floatop2 op in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
+    | Lop(Ifloatofint) ->
+	if ppc64 then begin
+          (* Can use protected zone (288 bytes below r1 *)
+	  `	std	{emit_reg i.arg.(0)}, -16(1)\n`;
+          `	lfd	{emit_reg i.res.(0)}, -16(1)\n`;
+          `	fcfid	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
+	end else begin
+          let lbl = new_label() in
+          float_literals := (0x4330000080000000L, lbl) :: !float_literals;
+          `	addis	11, 0, {emit_upper emit_label lbl}\n`;
+          `	lfd	0, {emit_lower emit_label lbl}(11)\n`;
+          `	lis	0, 0x4330\n`;
+          `	stwu	0, -16(1)\n`;
+          `	xoris	0, {emit_reg i.arg.(0)}, 0x8000\n`;
+          `	stw	0, 4(1)\n`;
+          `	lfd	{emit_reg i.res.(0)}, 0(1)\n`;
+          `	addi	1, 1, 16\n`;
+          `	fsub	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 0\n`
+	end
+    | Lop(Iintoffloat) ->
+        if ppc64 then begin
+          (* Can use protected zone (288 bytes below r1 *)
+          `	fctidz	0, {emit_reg i.arg.(0)}\n`;
+          `	stfd	0, -16(1)\n`;
+          `	ld	{emit_reg i.res.(0)}, -16(1)\n`
+        end else begin
+          `	fctiwz	0, {emit_reg i.arg.(0)}\n`;
+          `	stfdu	0, -16(1)\n`;
+          `	lwz	{emit_reg i.res.(0)}, 4(1)\n`;
+          `	addi	1, 1, 16\n`
+        end
+    | Lop(Ispecific sop) ->
+        let instr = name_for_specific sop in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`
+    | Lop (Iname_for_debugger _) -> ()
+    | Lreloadretaddr ->
+        `	{emit_string lg}	11, {emit_int(retaddr_offset())}(1)\n`;
+        `	mtlr	11\n`
+    | Lreturn ->
+        emit_free_frame();
+        `	blr\n`
+    | Llabel lbl ->
+        `{emit_label lbl}:\n`
+    | Lbranch lbl ->
+        `	b	{emit_label lbl}\n`
+    | Lcondbranch(tst, lbl) ->
+        begin match tst with
+          Itruetest ->
+            `	{emit_string cmpg}i	{emit_reg i.arg.(0)}, 0\n`;
+            `	bne	{emit_label lbl}\n`
+        | Ifalsetest ->
+            `	{emit_string cmpg}i	{emit_reg i.arg.(0)}, 0\n`;
+            `	beq	{emit_label lbl}\n`
+        | Iinttest cmp ->
+            let (comp, branch) = name_for_int_comparison cmp in
+            `	{emit_string comp}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+            `	{emit_string branch}	{emit_label lbl}\n`
+        | Iinttest_imm(cmp, n) ->
+            let (comp, branch) = name_for_int_comparison cmp in
+            `	{emit_string comp}i	{emit_reg i.arg.(0)}, {emit_int n}\n`;
+            `	{emit_string branch}	{emit_label lbl}\n`
+        | Ifloattest cmp -> begin
+            `	fcmpu	0, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+            (* bit 0 = lt, bit 1 = gt, bit 2 = eq *)
+            let bitnum =
+              match cmp with
+              | CFeq | CFneq -> 2
+              | CFle | CFnle ->
+                `	cror	3, 0, 2\n`; (* lt or eq *)
+                3
+              | CFgt | CFngt -> 1
+              | CFge | CFnge ->
+                `	cror	3, 1, 2\n`; (* gt or eq *)
+                3
+              | CFlt | CFnlt -> 0
+            in
+            match cmp with
+            | CFneq | CFngt | CFnge | CFnlt | CFnle ->
+               `	bf	{emit_int bitnum}, {emit_label lbl}\n`
+            | CFeq | CFgt | CFge | CFlt | CFle ->
+               `	bt	{emit_int bitnum}, {emit_label lbl}\n`
+          end
+        | Ioddtest ->
+            `	andi.	0, {emit_reg i.arg.(0)}, 1\n`;
+            `	bne	{emit_label lbl}\n`
+        | Ieventest ->
+            `	andi.	0, {emit_reg i.arg.(0)}, 1\n`;
+            `	beq	{emit_label lbl}\n`
+        end
+    | Lcondbranch3(lbl0, lbl1, lbl2) ->
+        `	{emit_string cmpg}i	{emit_reg i.arg.(0)}, 1\n`;
+        begin match lbl0 with
+          None -> ()
+        | Some lbl -> `	blt	{emit_label lbl}\n`
+        end;
+        begin match lbl1 with
+          None -> ()
+        | Some lbl -> `	beq	{emit_label lbl}\n`
+        end;
+        begin match lbl2 with
+          None -> ()
+        | Some lbl -> `	bgt	{emit_label lbl}\n`
+        end
+    | Lswitch jumptbl ->
+        let lbl = new_label() in
+        if ppc64 then begin
+          if !jumptables_lbl < 0 then jumptables_lbl := lbl;
+          let start = List.length !jumptables in
+          let (start_lo, start_hi) = low_high_s start in
+          emit_tocload emit_gpr 11 (TocLabel !jumptables_lbl);
+          `	addi	12, {emit_reg i.arg.(0)}, {emit_int start_lo}\n`;
+          if start_hi <> 0 then
+            `	addis	12, 12, {emit_int start_hi}\n`;
+          `	sldi	12, 12, 2\n`
+        end else begin
+          `	addis	11, 0, {emit_upper emit_label lbl}\n`;
+          `	addi	11, 11, {emit_lower emit_label lbl}\n`;
+          `	slwi	12, {emit_reg i.arg.(0)}, 2\n`
+        end;
+        `	{emit_string lwa}x	0, 11, 12\n`;
+        `	add	0, 11, 0\n`;
+        `	mtctr	0\n`;
+        `	bctr\n`;
+        if ppc64 then begin
+          jumptables := List.rev_append (Array.to_list jumptbl) !jumptables
+        end else begin
+          emit_string rodata_space;
+          `{emit_label lbl}:`;
+          for i = 0 to Array.length jumptbl - 1 do
+            `	.long	{emit_label jumptbl.(i)} - {emit_label lbl}\n`
+          done;
+          emit_string code_space
+        end
+    | Lentertrap ->
+        begin match abi with
+        | ELF32 -> ()
+        | ELF64v1 | ELF64v2 -> emit_reload_toc()
+        end
+    | Ladjust_trap_depth { delta_traps } ->
+        adjust_stack_offset (trap_size * delta_traps)
+    | Lpushtrap { lbl_handler; } ->
+        begin match abi with
+        | ELF32 ->
+          `	addis	11, 0, {emit_upper emit_label lbl_handler}\n`;
+          `	addi	11, 11, {emit_lower emit_label lbl_handler}\n`;
+          `	stwu    11, -16(1)\n`;
+          adjust_stack_offset 16;
+          `	stw	29, 4(1)\n`;
+          `	mr	29, 1\n`
+        | ELF64v1 | ELF64v2 ->
+          `	addi	1, 1, {emit_int (-trap_size)}\n`;
+          adjust_stack_offset trap_size;
+          `	std	29, {emit_int trap_previous_offset}(1)\n`;
+          emit_tocload emit_gpr 29 (TocLabel lbl_handler);
+          `	std     29, {emit_int trap_handler_offset}(1)\n`;
+          `	mr	29, 1\n`
+          end
+    | Lpoptrap ->
+        `	{emit_string lg}	29, {emit_int trap_previous_offset}(1)\n`;
+        `	addi	1, 1, {emit_int trap_size}\n`;
+        adjust_stack_offset (-trap_size)
+    | Lraise k ->
+        begin match k with
+        | Lambda.Raise_regular ->
+            `	li	0, 0\n`;
+            let backtrace_pos =
+              Domainstate.(idx_of_field Domain_backtrace_pos)
+            in
+            begin match abi with
+            | ELF32 -> `	stw	0, {emit_int (backtrace_pos * 8)}(28)\n`
+            | _ -> `	std	0, {emit_int (backtrace_pos * 8)}(28)\n`
+            end;
+            emit_call "caml_raise_exn";
+            record_frame Reg.Set.empty (Dbg_raise i.dbg);
+            emit_call_nop()
+        | Lambda.Raise_reraise ->
+            emit_call "caml_raise_exn";
+            record_frame Reg.Set.empty (Dbg_raise i.dbg);
+            emit_call_nop()
+        | Lambda.Raise_notrace ->
+            `	{emit_string lg}	0, {emit_int trap_handler_offset}(29)\n`;
+            `	mr	1, 29\n`;
+            `	mtctr   0\n`;
+            `	{emit_string lg}	29, {emit_int trap_previous_offset}(1)\n`;
+            `	addi	1, 1, {emit_int trap_size}\n`;
+            `	bctr\n`
+        end
+
+(* Emit a sequence of instructions *)
+
+let rec emit_all i =
+  match i.desc with
+  | Lend -> ()
+  |  _   -> emit_instr i; emit_all i.next
+
+(* Emission of a function declaration *)
+
+let fundecl fundecl =
+  function_name := fundecl.fun_name;
+  tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
+  stack_offset := 0;
+  call_gc_label := 0;
+  float_literals := [];
+  jumptables := []; jumptables_lbl := -1;
+  for i = 0 to Proc.num_register_classes - 1 do
+    num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
+  done;
+  prologue_required := fundecl.fun_prologue_required;
+  contains_calls := fundecl.fun_contains_calls;
+  begin match abi with
+  | ELF32 ->
+    emit_string code_space;
+    `	.globl	{emit_symbol fundecl.fun_name}\n`;
+    `	.type	{emit_symbol fundecl.fun_name}, @function\n`;
+    `	.align	2\n`;
+    `{emit_symbol fundecl.fun_name}:\n`
+  | ELF64v1 ->
+    emit_string function_descr_space;
+    `	.align 3\n`;
+    `	.globl	{emit_symbol fundecl.fun_name}\n`;
+    `	.type   {emit_symbol fundecl.fun_name}, @function\n`;
+    `{emit_symbol fundecl.fun_name}:\n`;
+    `	.quad .L.{emit_symbol fundecl.fun_name}, .TOC.@tocbase\n`;
+    emit_string code_space;
+    `	.align  2\n`;
+    `.L.{emit_symbol fundecl.fun_name}:\n`
+  | ELF64v2 ->
+    emit_string code_space;
+    `	.globl	{emit_symbol fundecl.fun_name}\n`;
+    `	.type	{emit_symbol fundecl.fun_name}, @function\n`;
+    `	.align	2\n`;
+    `{emit_symbol fundecl.fun_name}:\n`;
+    `0:	addis	2, 12, (.TOC. - 0b)@ha\n`;
+    `	addi	2, 2, (.TOC. - 0b)@l\n`;
+    `	.localentry {emit_symbol fundecl.fun_name}, . - 0b\n`
+  end;
+  emit_debug_info fundecl.fun_dbg;
+  cfi_startproc();
+  (* On this target, there is at most one "out of line" code block per
+     function: a single "call GC" point.  It comes immediately after the
+     function's body. *)
+  BR.relax fundecl.fun_body ~max_out_of_line_code_offset:0;
+  emit_all fundecl.fun_body;
+  (* Emit the glue code to call the GC *)
+  if !call_gc_label > 0 then begin
+    `{emit_label !call_gc_label}:\n`;
+    match abi with
+    | ELF32 ->
+      `	b	{emit_symbol "caml_call_gc"}\n`
+    | ELF64v1 ->
+      `	std	2, 40(1)\n`;
+             (* save our TOC, will be restored by caml_call_gc *)
+      emit_tocload emit_gpr 11 (TocSym "caml_call_gc");
+      `	ld	0, 0(11)\n`;
+      `	mtctr	0\n`;
+      `	ld	2, 8(11)\n`;
+      `	bctr\n`
+    | ELF64v2 ->
+      `	std	2, 24(1)\n`;
+             (* save our TOC, will be restored by caml_call_gc *)
+      emit_tocload emit_gpr 12 (TocSym "caml_call_gc");
+      `	mtctr	12\n`;
+      `	bctr\n`
+  end;
+  cfi_endproc();
+  begin match abi with
+  | ELF32 | ELF64v2 ->
+    `	.size	{emit_symbol fundecl.fun_name}, . - {emit_symbol fundecl.fun_name}\n`
+  | ELF64v1 ->
+    `	.size	{emit_symbol fundecl.fun_name}, . - .L.{emit_symbol fundecl.fun_name}\n`
+  end;
+  (* Emit the numeric literals *)
+  if !float_literals <> [] then begin
+    emit_string rodata_space;
+    `	.align	3\n`;
+    List.iter
+      (fun (f, lbl) ->
+        `{emit_label lbl}:`;
+        emit_float64_split_directive ".long" f)
+      !float_literals
+  end;
+  (* Emit the jump tables *)
+  if !jumptables <> [] then begin
+    emit_string rodata_space;
+    `	.align	2\n`;
+    `{emit_label !jumptables_lbl}:`;
+    List.iter
+      (fun  lbl ->
+          `	.long	{emit_label lbl} - {emit_label !jumptables_lbl}\n`)
+      (List.rev !jumptables)
+  end
+
+(* Emission of data *)
+
+let declare_global_data s =
+  `	.globl	{emit_symbol s}\n`;
+  `	.type	{emit_symbol s}, @object\n`
+
+let emit_item = function
+    Cglobal_symbol s ->
+      declare_global_data s
+  | Cdefine_symbol s ->
+      `{emit_symbol s}:\n`;
+  | Cint8 n ->
+      `	.byte	{emit_int n}\n`
+  | Cint16 n ->
+      `	.short	{emit_int n}\n`
+  | Cint32 n ->
+      `	.long	{emit_nativeint n}\n`
+  | Cint n ->
+      `	{emit_string datag}	{emit_nativeint n}\n`
+  | Csingle f ->
+      emit_float32_directive ".long" (Int32.bits_of_float f)
+  | Cdouble f ->
+      if ppc64
+      then emit_float64_directive ".quad" (Int64.bits_of_float f)
+      else emit_float64_split_directive ".long" (Int64.bits_of_float f)
+  | Csymbol_address s ->
+      `	{emit_string datag}	{emit_symbol s}\n`
+  | Cstring s ->
+      emit_bytes_directive "	.byte	" s
+  | Cskip n ->
+      if n > 0 then `	.space	{emit_int n}\n`
+  | Calign n ->
+      `	.align	{emit_int (Misc.log2 n)}\n`
+
+let data l =
+  emit_string data_space;
+  `	.align  {emit_int (if ppc64 then 3 else 2)}\n`;
+  List.iter emit_item l
+
+(* Beginning / end of an assembly file *)
+
+let begin_assembly() =
+  reset_debug_info();
+  `	.file	\"\"\n`;  (* PR#7037 *)
+  begin match abi with
+  | ELF64v2 -> `	.abiversion 2\n`
+  | _ -> ()
+  end;
+  Hashtbl.clear tocref_entries;
+  (* Emit the beginning of the segments *)
+  let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
+  emit_string data_space;
+  declare_global_data lbl_begin;
+  `{emit_symbol lbl_begin}:\n`;
+  let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
+  emit_string function_descr_space;
+  (* For the ELF64v1 ABI, we must make sure that the .opd and .data
+     sections are in different pages.  .opd comes after .data,
+     so aligning .opd is enough.  To save space, we do it only
+     for the startup file, not for every OCaml compilation unit. *)
+  let c = Compilenv.current_unit_name() in
+  if abi = ELF64v1 && (c = "_startup" || c = "_shared_startup") then begin
+    `	.p2align	12\n`
+  end;
+  declare_global_data lbl_begin;
+  `{emit_symbol lbl_begin}:\n`
+
+let end_assembly() =
+  (* Emit the end of the segments *)
+  emit_string function_descr_space;
+  let lbl_end = Compilenv.make_symbol (Some "code_end") in
+  declare_global_data lbl_end;
+  `{emit_symbol lbl_end}:\n`;
+  if abi <> ELF64v1 then `	.long	0\n`;
+  emit_string data_space;
+  let lbl_end = Compilenv.make_symbol (Some "data_end") in
+  declare_global_data lbl_end;
+  `	{emit_string datag}	0\n`;  (* PR#6329 *)
+  `{emit_symbol lbl_end}:\n`;
+  `	{emit_string datag}	0\n`;
+  (* Emit the frame descriptors *)
+  emit_string data_space;  (* not rodata_space because it contains relocations *)
+  if ppc64 then `	.align  3\n`;   (* #7887 *)
+  let lbl = Compilenv.make_symbol (Some "frametable") in
+  declare_global_data lbl;
+  `{emit_symbol lbl}:\n`;
+  emit_frames
+    { efa_code_label =
+         (fun l -> `	{emit_string datag}	{emit_label l}\n`);
+      efa_data_label =
+         (fun l -> `	{emit_string datag}	{emit_label l}\n`);
+      efa_8 = (fun n -> `	.byte	{emit_int n}\n`);
+      efa_16 = (fun n -> `	.short	{emit_int n}\n`);
+      efa_32 = (fun n -> `	.long	{emit_int32 n}\n`);
+      efa_word = (fun n -> `	{emit_string datag}	{emit_int n}\n`);
+      efa_align = (fun n -> `	.balign	{emit_int n}\n`);
+      efa_label_rel = (fun lbl ofs ->
+                           `	.long	({emit_label lbl} - .) + {emit_int32 ofs}\n`);
+      efa_def_label = (fun l -> `{emit_label l}:\n`);
+      efa_string = (fun s -> emit_bytes_directive "	.byte	" (s ^ "\000"))
+     };
+  (* Emit the TOC entries *)
+  begin match abi with
+  | ELF32 -> ()
+  | ELF64v1 | ELF64v2 ->
+      emit_string toc_space;
+      emit_toctable();
+      Hashtbl.clear tocref_entries
+  end;
+  `	.section .note.GNU-stack,\"\",%progbits\n`
diff --git a/asmcomp/power/proc.ml b/asmcomp/power/proc.ml
new file mode 100644
index 00000000..3bcd12fc
--- /dev/null
+++ b/asmcomp/power/proc.ml
@@ -0,0 +1,369 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Description of the Power PC *)
+
+open Misc
+open Cmm
+open Reg
+open Arch
+open Mach
+
+(* Instruction selection *)
+
+let word_addressed = false
+
+(* Registers available for register allocation *)
+
+(* Integer register map:
+    0                   temporary, null register for some operations
+    1                   stack pointer
+    2                   pointer to table of contents
+    3 - 10              function arguments and results
+    11 - 12             temporaries
+    13                  pointer to small data area
+    14 - 27             general purpose, preserved by C
+    28                  domain state pointer
+    29                  trap pointer
+    30                  allocation limit
+    31                  allocation pointer
+  Floating-point register map:
+    0                   temporary
+    1 - 13              function arguments and results
+    14 - 31             general purpose, preserved by C
+*)
+
+let int_reg_name =
+  [| "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10";
+     "14"; "15"; "16"; "17"; "18"; "19"; "20"; "21";
+     "22"; "23"; "24"; "25"; "26"; "27" |]
+
+let float_reg_name =
+  [| "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8";
+     "9"; "10"; "11"; "12"; "13"; "14"; "15"; "16";
+     "17"; "18"; "19"; "20"; "21"; "22"; "23"; "24";
+     "25"; "26"; "27"; "28"; "29"; "30"; "31" |]
+
+let num_register_classes = 2
+
+let register_class r =
+  match r.typ with
+  | Val | Int | Addr -> 0
+  | Float -> 1
+
+let num_available_registers = [| 22; 31 |]
+
+let first_available_register = [| 0; 100 |]
+
+let register_name r =
+  if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100)
+
+let rotate_registers = true
+
+(* Representation of hard registers by pseudo-registers *)
+
+let hard_int_reg =
+  let v = Array.make 22 Reg.dummy in
+  for i = 0 to 21 do v.(i) <- Reg.at_location Int (Reg i) done; v
+
+let hard_float_reg =
+  let v = Array.make 31 Reg.dummy in
+  for i = 0 to 30 do v.(i) <- Reg.at_location Float (Reg(100 + i)) done; v
+
+let all_phys_regs =
+  Array.append hard_int_reg hard_float_reg
+
+let phys_reg n =
+  if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
+
+let stack_slot slot ty =
+  Reg.at_location ty (Stack slot)
+
+let loc_spacetime_node_hole = Reg.dummy  (* Spacetime unsupported *)
+
+(* Calling conventions *)
+
+let calling_conventions
+    first_int last_int first_float last_float
+    make_stack stack_ofs reg_use_stack arg =
+  let loc = Array.make (Array.length arg) [| Reg.dummy |] in
+  let int = ref first_int in
+  let float = ref first_float in
+  let ofs = ref stack_ofs in
+  for i = 0 to Array.length arg - 1 do
+    match arg.(i) with
+    | [| arg |] ->
+      begin match arg.typ with
+      | Val | Int | Addr as ty ->
+          if !int <= last_int then begin
+            loc.(i) <- [| phys_reg !int |];
+            incr int;
+            if reg_use_stack then ofs := !ofs + size_int
+          end else begin
+            loc.(i) <- [| stack_slot (make_stack !ofs) ty |];
+            ofs := !ofs + size_int
+          end
+      | Float ->
+          if !float <= last_float then begin
+            loc.(i) <- [| phys_reg !float |];
+            incr float;
+            (* On 64-bit platforms, passing a float in a float register
+               reserves a normal register as well *)
+            if size_int = 8 then incr int;
+            if reg_use_stack then ofs := !ofs + size_float
+          end else begin
+            ofs := Misc.align !ofs size_float;
+            loc.(i) <- [| stack_slot (make_stack !ofs) Float |];
+            ofs := !ofs + size_float
+          end
+      end
+    | [| arg1; arg2 |] ->
+      (* Passing of 64-bit quantities to external functions
+         on 32-bit platform. *)
+      assert (size_int = 4);
+      begin match arg1.typ, arg2.typ with
+      | Int, Int ->
+          (* 64-bit quantities split across two registers must either be in a
+             consecutive pair of registers where the lowest numbered is an
+             even-numbered register; or in a stack slot that is 8-byte
+             aligned. *)
+          int := Misc.align !int 2;
+          if !int <= last_int - 1 then begin
+            let reg_lower = phys_reg !int in
+            let reg_upper = phys_reg (!int + 1) in
+            loc.(i) <- [| reg_lower; reg_upper |];
+            int := !int + 2
+          end else begin
+            let size_int64 = 8 in
+            ofs := Misc.align !ofs size_int64;
+            let ofs_lower = !ofs in
+            let ofs_upper = !ofs + size_int in
+            let stack_lower = stack_slot (make_stack ofs_lower) Int in
+            let stack_upper = stack_slot (make_stack ofs_upper) Int in
+            loc.(i) <- [| stack_lower; stack_upper |];
+            ofs := !ofs + size_int64
+          end
+      | _, _ ->
+        let f = function Int -> "I" | Addr -> "A" | Val -> "V" | Float -> "F" in
+        fatal_error (Printf.sprintf "Proc.calling_conventions: bad register \
+            type(s) for multi-register argument: %s, %s"
+          (f arg1.typ) (f arg2.typ))
+      end
+    | _ ->
+      fatal_error "Proc.calling_conventions: bad number of registers for \
+                   multi-register argument"
+  done;
+  (loc, Misc.align !ofs 16)
+  (* Keep stack 16-aligned. *)
+
+let incoming ofs = Incoming ofs
+let outgoing ofs = Outgoing ofs
+let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
+
+let single_regs arg = Array.map (fun arg -> [| arg |]) arg
+let ensure_single_regs res =
+  Array.map (function
+      | [| res |] -> res
+      | _ -> failwith "Proc.ensure_single_regs")
+    res
+
+let max_arguments_for_tailcalls = 8
+
+let loc_arguments arg =
+  let (loc, ofs) =
+    calling_conventions 0 7 100 112 outgoing 0 false (single_regs arg)
+  in
+  (ensure_single_regs loc, ofs)
+let loc_parameters arg =
+  let (loc, _ofs) =
+    calling_conventions 0 7 100 112 incoming 0 false (single_regs arg)
+  in
+  ensure_single_regs loc
+let loc_results res =
+  let (loc, _ofs) =
+    calling_conventions 0 7 100 112 not_supported 0 false (single_regs res)
+  in
+  ensure_single_regs loc
+
+(* C calling conventions for ELF32:
+     use GPR 3-10 and FPR 1-8 just like ML calling conventions.
+     Using a float register does not affect the int registers.
+     Always reserve 8 bytes at bottom of stack, plus whatever is needed
+     to hold the overflow arguments.
+   C calling conventions for ELF64v1:
+     Use GPR 3-10 for the first integer arguments.
+     Use FPR 1-13 for the first float arguments.
+     Always reserve stack space for all arguments, even when passed in
+     registers.
+     Always reserve at least 8 words (64 bytes) for the arguments.
+     Always reserve 48 bytes at bottom of stack, plus whatever is needed
+     to hold the arguments.
+     The reserved 48 bytes are automatically added in emit.mlp
+     and need not appear here.
+   C calling conventions for ELF64v2:
+     Use GPR 3-10 for the first integer arguments.
+     Use FPR 1-13 for the first float arguments.
+     If all arguments fit in registers, don't reserve stack space.
+     Otherwise, reserve stack space for all arguments.
+     Always reserve 32 bytes at bottom of stack, plus whatever is needed
+     to hold the arguments.
+     The reserved 32 bytes are automatically added in emit.mlp
+     and need not appear here.
+*)
+
+let loc_external_arguments =
+  match abi with
+  | ELF32 ->
+      calling_conventions 0 7 100 107 outgoing 8 false
+  | ELF64v1 ->
+      fun args ->
+      let (loc, ofs) =
+        calling_conventions 0 7 100 112 outgoing 0 true args in
+      (loc, max ofs 64)
+  | ELF64v2 ->
+      fun args ->
+      let (loc, ofs) =
+        calling_conventions 0 7 100 112 outgoing 0 true args in
+      if Array.fold_left
+           (fun stk r ->
+              assert (Array.length r = 1);
+              match r.(0).loc with
+              | Stack _ -> true
+              | _ -> stk)
+           false loc
+      then (loc, ofs)
+      else (loc, 0)
+
+(* Results are in GPR 3 and FPR 1 *)
+
+let loc_external_results res =
+  let (loc, _ofs) =
+    calling_conventions 0 1 100 100 not_supported 0 false (single_regs res)
+  in
+  ensure_single_regs loc
+
+(* Exceptions are in GPR 3 *)
+
+let loc_exn_bucket = phys_reg 0
+
+(* For ELF32 see:
+   "System V Application Binary Interface PowerPC Processor Supplement"
+   http://refspecs.linux-foundation.org/elf/elfspec_ppc.pdf
+
+   For ELF64v1 see:
+   "64-bit PowerPC ELF Application Binary Interface Supplement 1.9"
+   http://refspecs.linuxfoundation.org/ELF/ppc64/PPC-elf64abi.html
+
+   For ELF64v2 see:
+   "64-Bit ELF V2 ABI Specification -- Power Architecture"
+   http://openpowerfoundation.org/wp-content/uploads/resources/leabi/
+     content/dbdoclet.50655239___RefHeading___Toc377640569.html
+
+   All of these specifications seem to agree on the numberings we need.
+*)
+
+let int_dwarf_reg_numbers =
+  [| 3; 4; 5; 6; 7; 8; 9; 10;
+     14; 15; 16; 17; 18; 19; 20; 21;
+     22; 23; 24; 25; 26; 27;
+  |]
+
+let float_dwarf_reg_numbers =
+  [| 33; 34; 35; 36; 37; 38; 39;
+     40; 41; 42; 43; 44; 45; 46; 47;
+     48; 49; 50; 51; 52; 53; 54; 55;
+     56; 57; 58; 59; 60; 61; 62; 63;
+  |]
+
+let dwarf_register_numbers ~reg_class =
+  match reg_class with
+  | 0 -> int_dwarf_reg_numbers
+  | 1 -> float_dwarf_reg_numbers
+  | _ -> Misc.fatal_errorf "Bad register class %d" reg_class
+
+let stack_ptr_dwarf_register_number = 1
+
+(* Volatile registers: none *)
+
+let regs_are_volatile _rs = false
+
+(* Registers destroyed by operations *)
+
+let destroyed_at_c_call =
+  Array.of_list(List.map phys_reg
+    [0; 1; 2; 3; 4; 5; 6; 7;
+     100; 101; 102; 103; 104; 105; 106; 107; 108; 109; 110; 111; 112])
+
+let destroyed_at_oper = function
+    Iop(Icall_ind _ | Icall_imm _ | Iextcall { alloc = true; _ }) ->
+    all_phys_regs
+  | Iop(Iextcall { alloc = false; _ }) -> destroyed_at_c_call
+  | _ -> [||]
+
+let destroyed_at_raise = all_phys_regs
+
+let destroyed_at_reloadretaddr = [| phys_reg 11 |]
+
+(* Maximal register pressure *)
+
+let safe_register_pressure = function
+    Iextcall _ -> 14
+  | _ -> 22
+
+let max_register_pressure = function
+    Iextcall _ -> [| 14; 18 |]
+  | _ -> [| 22; 30 |]
+
+(* Pure operations (without any side effect besides updating their result
+   registers). *)
+
+let op_is_pure = function
+  | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
+  | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false
+  | Ispecific(Imultaddf | Imultsubf) -> true
+  | Ispecific _ -> false
+  | _ -> true
+
+(* Layout of the stack *)
+
+(* See [reserved_stack_space] in emit.mlp. *)
+let reserved_stack_space_required () =
+  match abi with
+  | ELF32 -> false
+  | ELF64v1 | ELF64v2 -> true
+
+let frame_required fd =
+  let is_elf32 =
+    match abi with
+    | ELF32 -> true
+    | ELF64v1 | ELF64v2 -> false
+  in
+  reserved_stack_space_required ()
+    || fd.fun_num_stack_slots.(0) > 0
+    || fd.fun_num_stack_slots.(1) > 0
+    || (fd.fun_contains_calls && is_elf32)
+
+let prologue_required fd =
+  frame_required fd
+
+(* Calling the assembler *)
+
+let assemble_file infile outfile =
+  Ccomp.command (Config.asm ^ " " ^
+                 (String.concat " " (Misc.debug_prefix_map_flags ())) ^
+                 " -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile)
+
+let init () = ()
diff --git a/asmcomp/power/reload.ml b/asmcomp/power/reload.ml
new file mode 100644
index 00000000..21ace08c
--- /dev/null
+++ b/asmcomp/power/reload.ml
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Reloading for the PowerPC *)
+
+let fundecl f num_stack_slots =
+  (new Reloadgen.reload_generic)#fundecl f num_stack_slots
diff --git a/asmcomp/power/scheduling.ml b/asmcomp/power/scheduling.ml
new file mode 100644
index 00000000..dcbfca79
--- /dev/null
+++ b/asmcomp/power/scheduling.ml
@@ -0,0 +1,64 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Instruction scheduling for the Power PC *)
+
+open Arch
+open Mach
+
+class scheduler = object
+
+inherit Schedgen.scheduler_generic
+
+(* Latencies (in cycles). Based roughly on the "common model". *)
+
+method oper_latency = function
+    Ireload -> 2
+  | Iload(_, _) -> 2
+  | Iconst_float _ -> 2 (* turned into a load *)
+  | Iconst_symbol _ -> 1
+  | Iintop(Imul | Imulh) -> 9
+  | Iintop_imm(Imul, _) -> 5
+  | Iintop(Idiv | Imod) -> 36
+  | Iaddf | Isubf -> 4
+  | Imulf -> 5
+  | Idivf -> 33
+  | Ispecific(Imultaddf | Imultsubf) -> 5
+  | _ -> 1
+
+method! reload_retaddr_latency = 12
+  (* If we can have that many cycles between the reloadretaddr and the
+     return, we can expect that the blr branch will be completely folded. *)
+
+(* Issue cycles.  Rough approximations. *)
+
+method oper_issue_cycles = function
+    Iconst_float _ | Iconst_symbol _ -> 2
+  | Iload(_, Ibased(_, _)) -> 2
+  | Istore(_, Ibased(_, _), _) -> 2
+  | Ialloc _ -> 4
+  | Iintop(Imod) -> 40 (* assuming full stall *)
+  | Iintop(Icomp _) -> 4
+  | Iintop_imm(Icomp _, _) -> 4
+  | Ifloatofint -> 9
+  | Iintoffloat -> 4
+  | _ -> 1
+
+method! reload_retaddr_issue_cycles = 3
+  (* load then stalling mtlr *)
+
+end
+
+let fundecl f = (new scheduler)#schedule_fundecl f
diff --git a/asmcomp/power/selection.ml b/asmcomp/power/selection.ml
new file mode 100644
index 00000000..6e97feba
--- /dev/null
+++ b/asmcomp/power/selection.ml
@@ -0,0 +1,94 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Instruction selection for the Power PC processor *)
+
+open Cmm
+open Arch
+open Mach
+
+(* Recognition of addressing modes *)
+
+type addressing_expr =
+    Asymbol of string
+  | Alinear of expression
+  | Aadd of expression * expression
+
+let rec select_addr = function
+    Cconst_symbol (s, _) ->
+      (Asymbol s, 0, Debuginfo.none)
+  | Cop((Caddi | Caddv | Cadda), [arg; Cconst_int (m, _)], dbg) ->
+      let (a, n, _) = select_addr arg in (a, n + m, dbg)
+  | Cop((Caddi | Caddv | Cadda), [Cconst_int (m, _); arg], dbg) ->
+      let (a, n, _) = select_addr arg in (a, n + m, dbg)
+  | Cop((Caddi | Caddv | Cadda), [arg1; arg2], dbg) ->
+      begin match (select_addr arg1, select_addr arg2) with
+          ((Alinear e1, n1, _), (Alinear e2, n2, _)) ->
+              (Aadd(e1, e2), n1 + n2, dbg)
+        | _ ->
+              (Aadd(arg1, arg2), 0, dbg)
+      end
+  | exp ->
+      (Alinear exp, 0, Debuginfo.none)
+
+(* Instruction selection *)
+
+class selector = object (self)
+
+inherit Selectgen.selector_generic as super
+
+method is_immediate n = (n <= 32767) && (n >= -32768)
+
+method select_addressing _chunk exp =
+  match select_addr exp with
+    (Asymbol s, d, _dbg) ->
+      (Ibased(s, d), Ctuple [])
+  | (Alinear e, d, _dbg) ->
+      (Iindexed d, e)
+  | (Aadd(e1, e2), d, dbg) ->
+      if d = 0
+      then (Iindexed2, Ctuple[e1; e2])
+      else (Iindexed d, Cop(Cadda, [e1; e2], dbg))
+
+method! select_operation op args dbg =
+  match (op, args) with
+  (* PowerPC does not support immediate operands for multiply high *)
+    (Cmulhi, _) -> (Iintop Imulh, args)
+  (* The and, or and xor instructions have a different range of immediate
+     operands than the other instructions *)
+  | (Cand, _) -> self#select_logical Iand args
+  | (Cor, _) -> self#select_logical Ior args
+  | (Cxor, _) -> self#select_logical Ixor args
+  (* Recognize mult-add and mult-sub instructions *)
+  | (Caddf, [Cop(Cmulf, [arg1; arg2], _); arg3]) ->
+      (Ispecific Imultaddf, [arg1; arg2; arg3])
+  | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2], _)]) ->
+      (Ispecific Imultaddf, [arg1; arg2; arg3])
+  | (Csubf, [Cop(Cmulf, [arg1; arg2], _); arg3]) ->
+      (Ispecific Imultsubf, [arg1; arg2; arg3])
+  | _ ->
+      super#select_operation op args dbg
+
+method select_logical op = function
+    [arg; Cconst_int (n, _)] when n >= 0 && n <= 0xFFFF ->
+      (Iintop_imm(op, n), [arg])
+  | [Cconst_int (n, _); arg] when n >= 0 && n <= 0xFFFF ->
+      (Iintop_imm(op, n), [arg])
+  | args ->
+      (Iintop op, args)
+
+end
+
+let fundecl f = (new selector)#emit_fundecl f
diff --git a/asmcomp/printcmm.ml b/asmcomp/printcmm.ml
new file mode 100644
index 00000000..377f9c2d
--- /dev/null
+++ b/asmcomp/printcmm.ml
@@ -0,0 +1,296 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Pretty-printing of C-- code *)
+
+open Format
+open Cmm
+
+module V = Backend_var
+module VP = Backend_var.With_provenance
+
+let rec_flag ppf = function
+  | Nonrecursive -> ()
+  | Recursive -> fprintf ppf " rec"
+
+let machtype_component ppf = function
+  | Val -> fprintf ppf "val"
+  | Addr -> fprintf ppf "addr"
+  | Int -> fprintf ppf "int"
+  | Float -> fprintf ppf "float"
+
+let machtype ppf mty =
+  match Array.length mty with
+  | 0 -> fprintf ppf "unit"
+  | n -> machtype_component ppf mty.(0);
+         for i = 1 to n-1 do
+           fprintf ppf "*%a" machtype_component mty.(i)
+         done
+
+let integer_comparison = function
+  | Ceq -> "=="
+  | Cne -> "!="
+  | Clt -> "<"
+  | Cle -> "<="
+  | Cgt -> ">"
+  | Cge -> ">="
+
+let float_comparison = function
+  | CFeq -> "=="
+  | CFneq -> "!="
+  | CFlt -> "<"
+  | CFnlt -> "!<"
+  | CFle -> "<="
+  | CFnle -> "!<="
+  | CFgt -> ">"
+  | CFngt -> "!>"
+  | CFge -> ">="
+  | CFnge -> "!>="
+
+let chunk = function
+  | Byte_unsigned -> "unsigned int8"
+  | Byte_signed -> "signed int8"
+  | Sixteen_unsigned -> "unsigned int16"
+  | Sixteen_signed -> "signed int16"
+  | Thirtytwo_unsigned -> "unsigned int32"
+  | Thirtytwo_signed -> "signed int32"
+  | Word_int -> "int"
+  | Word_val -> "val"
+  | Single -> "float32"
+  | Double -> "float64"
+  | Double_u -> "float64u"
+
+let phantom_defining_expr ppf defining_expr =
+  match defining_expr with
+  | Cphantom_const_int i -> Targetint.print ppf i
+  | Cphantom_const_symbol sym -> Format.pp_print_string ppf sym
+  | Cphantom_var var -> V.print ppf var
+  | Cphantom_offset_var { var; offset_in_words; } ->
+    Format.fprintf ppf "%a+(%d)" V.print var offset_in_words
+  | Cphantom_read_field { var; field; } ->
+    Format.fprintf ppf "%a[%d]" V.print var field
+  | Cphantom_read_symbol_field { sym; field; } ->
+    Format.fprintf ppf "%s[%d]" sym field
+  | Cphantom_block { tag; fields; } ->
+    Format.fprintf ppf "[%d: " tag;
+    List.iter (fun field ->
+        Format.fprintf ppf "%a; " V.print field)
+      fields;
+    Format.fprintf ppf "]"
+
+let phantom_defining_expr_opt ppf defining_expr =
+  match defining_expr with
+  | None -> Format.pp_print_string ppf "()"
+  | Some defining_expr -> phantom_defining_expr ppf defining_expr
+
+let location d =
+  if not !Clflags.locations then ""
+  else Debuginfo.to_string d
+
+let operation d = function
+  | Capply _ty -> "app" ^ location d
+  | Cextcall(lbl, _ty, _alloc, _) ->
+      Printf.sprintf "extcall \"%s\"%s" lbl (location d)
+  | Cload (c, Asttypes.Immutable) -> Printf.sprintf "load %s" (chunk c)
+  | Cload (c, Asttypes.Mutable) -> Printf.sprintf "load_mut %s" (chunk c)
+  | Calloc -> "alloc" ^ location d
+  | Cstore (c, init) ->
+    let init =
+      match init with
+      | Lambda.Heap_initialization -> "(heap-init)"
+      | Lambda.Root_initialization -> "(root-init)"
+      | Lambda.Assignment -> ""
+    in
+    Printf.sprintf "store %s%s" (chunk c) init
+  | Caddi -> "+"
+  | Csubi -> "-"
+  | Cmuli -> "*"
+  | Cmulhi -> "*h"
+  | Cdivi -> "/"
+  | Cmodi -> "mod"
+  | Cand -> "and"
+  | Cor -> "or"
+  | Cxor -> "xor"
+  | Clsl -> "<<"
+  | Clsr -> ">>u"
+  | Casr -> ">>s"
+  | Ccmpi c -> integer_comparison c
+  | Caddv -> "+v"
+  | Cadda -> "+a"
+  | Ccmpa c -> Printf.sprintf "%sa" (integer_comparison c)
+  | Cnegf -> "~f"
+  | Cabsf -> "absf"
+  | Caddf -> "+f"
+  | Csubf -> "-f"
+  | Cmulf -> "*f"
+  | Cdivf -> "/f"
+  | Cfloatofint -> "floatofint"
+  | Cintoffloat -> "intoffloat"
+  | Ccmpf c -> Printf.sprintf "%sf" (float_comparison c)
+  | Craise k -> Lambda.raise_kind k ^ location d
+  | Ccheckbound -> "checkbound" ^ location d
+
+let rec expr ppf = function
+  | Cconst_int (n, _dbg) -> fprintf ppf "%i" n
+  | Cconst_natint (n, _dbg) ->
+    fprintf ppf "%s" (Nativeint.to_string n)
+  | Cblockheader(n, d) ->
+    fprintf ppf "block-hdr(%s)%s"
+      (Nativeint.to_string n) (location d)
+  | Cconst_float (n, _dbg) -> fprintf ppf "%F" n
+  | Cconst_symbol (s, _dbg) -> fprintf ppf "\"%s\"" s
+  | Cconst_pointer (n, _dbg) -> fprintf ppf "%ia" n
+  | Cconst_natpointer (n, _dbg) -> fprintf ppf "%sa" (Nativeint.to_string n)
+  | Cvar id -> V.print ppf id
+  | Clet(id, def, (Clet(_, _, _) as body)) ->
+      let print_binding id ppf def =
+        fprintf ppf "@[<2>%a@ %a@]"
+          VP.print id expr def in
+      let rec in_part ppf = function
+        | Clet(id, def, body) ->
+            fprintf ppf "@ %a" (print_binding id) def;
+            in_part ppf body
+        | exp -> exp in
+      fprintf ppf "@[<2>(let@ @[<1>(%a" (print_binding id) def;
+      let exp = in_part ppf body in
+      fprintf ppf ")@]@ %a)@]" sequence exp
+  | Clet(id, def, body) ->
+     fprintf ppf
+      "@[<2>(let@ @[<2>%a@ %a@]@ %a)@]"
+      VP.print id expr def sequence body
+  | Clet_mut(id, kind, def, body) ->
+    fprintf ppf
+      "@[<2>(let_mut@ @[<2>%a: %a@ %a@]@ %a)@]"
+      VP.print id machtype kind expr def sequence body
+  | Cphantom_let(var, def, (Cphantom_let(_, _, _) as body)) ->
+      let print_binding var ppf def =
+        fprintf ppf "@[<2>%a@ %a@]" VP.print var
+          phantom_defining_expr_opt def
+      in
+      let rec in_part ppf = function
+        | Cphantom_let(var, def, body) ->
+            fprintf ppf "@ %a" (print_binding var) def;
+            in_part ppf body
+        | exp -> exp in
+      fprintf ppf "@[<2>(let?@ @[<1>(%a" (print_binding var) def;
+      let exp = in_part ppf body in
+      fprintf ppf ")@]@ %a)@]" sequence exp
+  | Cphantom_let(var, def, body) ->
+    fprintf ppf
+      "@[<2>(let?@ @[<2>%a@ %a@]@ %a)@]"
+      VP.print var
+      phantom_defining_expr_opt def
+      sequence body
+  | Cassign(id, exp) ->
+      fprintf ppf "@[<2>(assign @[<2>%a@ %a@])@]" V.print id expr exp
+  | Ctuple el ->
+      let tuple ppf el =
+       let first = ref true in
+       List.iter
+        (fun e ->
+          if !first then first := false else fprintf ppf "@ ";
+          expr ppf e)
+        el in
+      fprintf ppf "@[<1>[%a]@]" tuple el
+  | Cop(op, el, dbg) ->
+      fprintf ppf "@[<2>(%s" (operation dbg op);
+      List.iter (fun e -> fprintf ppf "@ %a" expr e) el;
+      begin match op with
+      | Capply mty -> fprintf ppf "@ %a" machtype mty
+      | Cextcall(_, mty, _, _) -> fprintf ppf "@ %a" machtype mty
+      | _ -> ()
+      end;
+      fprintf ppf ")@]"
+  | Csequence(e1, e2) ->
+      fprintf ppf "@[<2>(seq@ %a@ %a)@]" sequence e1 sequence e2
+  | Cifthenelse(e1, _e2_dbg, e2, _e3_dbg, e3, _dbg) ->
+      fprintf ppf "@[<2>(if@ %a@ %a@ %a)@]" expr e1 expr e2 expr e3
+  | Cswitch(e1, index, cases, _dbg) ->
+      let print_case i ppf =
+        for j = 0 to Array.length index - 1 do
+          if index.(j) = i then fprintf ppf "case %i:" j
+        done in
+      let print_cases ppf =
+       for i = 0 to Array.length cases - 1 do
+        fprintf ppf "@ @[<2>%t@ %a@]" (print_case i) sequence (fst cases.(i))
+       done in
+      fprintf ppf "@[@[<2>(switch@ %a@ @]%t)@]" expr e1 print_cases
+  | Ccatch(flag, handlers, e1) ->
+      let print_handler ppf (i, ids, e2, _dbg) =
+        fprintf ppf "(%d%a)@ %a"
+          i
+          (fun ppf ids ->
+             List.iter
+               (fun (id, ty) ->
+                 fprintf ppf "@ %a: %a"
+                   VP.print id machtype ty)
+               ids) ids
+          sequence e2
+      in
+      let print_handlers ppf l =
+        List.iter (print_handler ppf) l
+      in
+      fprintf ppf
+        "@[<2>(catch%a@ %a@;<1 -2>with%a)@]"
+        rec_flag flag
+        sequence e1
+        print_handlers handlers
+  | Cexit (i, el) ->
+      fprintf ppf "@[<2>(exit %d" i;
+      List.iter (fun e -> fprintf ppf "@ %a" expr e) el;
+      fprintf ppf ")@]"
+  | Ctrywith(e1, id, e2, _dbg) ->
+      fprintf ppf "@[<2>(try@ %a@;<1 -2>with@ %a@ %a)@]"
+             sequence e1 VP.print id sequence e2
+
+and sequence ppf = function
+  | Csequence(e1, e2) -> fprintf ppf "%a@ %a" sequence e1 sequence e2
+  | e -> expression ppf e
+
+and expression ppf e = fprintf ppf "%a" expr e
+
+let fundecl ppf f =
+  let print_cases ppf cases =
+    let first = ref true in
+    List.iter
+     (fun (id, ty) ->
+       if !first then first := false else fprintf ppf "@ ";
+       fprintf ppf "%a: %a" VP.print id machtype ty)
+     cases in
+  fprintf ppf "@[<1>(function%s %s@;<1 4>@[<1>(%a)@]@ @[%a@])@]@."
+         (location f.fun_dbg) f.fun_name
+         print_cases f.fun_args sequence f.fun_body
+
+let data_item ppf = function
+  | Cdefine_symbol s -> fprintf ppf "\"%s\":" s
+  | Cglobal_symbol s -> fprintf ppf "global \"%s\"" s
+  | Cint8 n -> fprintf ppf "byte %i" n
+  | Cint16 n -> fprintf ppf "int16 %i" n
+  | Cint32 n -> fprintf ppf "int32 %s" (Nativeint.to_string n)
+  | Cint n -> fprintf ppf "int %s" (Nativeint.to_string n)
+  | Csingle f -> fprintf ppf "single %F" f
+  | Cdouble f -> fprintf ppf "double %F" f
+  | Csymbol_address s -> fprintf ppf "addr \"%s\"" s
+  | Cstring s -> fprintf ppf "string \"%s\"" s
+  | Cskip n -> fprintf ppf "skip %i" n
+  | Calign n -> fprintf ppf "align %i" n
+
+let data ppf dl =
+  let items ppf = List.iter (fun d -> fprintf ppf "@ %a" data_item d) dl in
+  fprintf ppf "@[(data%t)@]" items
+
+let phrase ppf = function
+  | Cfunction f -> fundecl ppf f
+  | Cdata dl -> data ppf dl
diff --git a/asmcomp/printcmm.mli b/asmcomp/printcmm.mli
new file mode 100644
index 00000000..462239ac
--- /dev/null
+++ b/asmcomp/printcmm.mli
@@ -0,0 +1,30 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Pretty-printing of C-- code *)
+
+open Format
+
+val rec_flag : formatter -> Cmm.rec_flag -> unit
+val machtype_component : formatter -> Cmm.machtype_component -> unit
+val machtype : formatter -> Cmm.machtype_component array -> unit
+val integer_comparison : Cmm.integer_comparison -> string
+val float_comparison : Cmm.float_comparison -> string
+val chunk : Cmm.memory_chunk -> string
+val operation : Debuginfo.t -> Cmm.operation -> string
+val expression : formatter -> Cmm.expression -> unit
+val fundecl : formatter -> Cmm.fundecl -> unit
+val data : formatter -> Cmm.data_item list -> unit
+val phrase : formatter -> Cmm.phrase -> unit
diff --git a/asmcomp/printlinear.ml b/asmcomp/printlinear.ml
new file mode 100644
index 00000000..916d2a1a
--- /dev/null
+++ b/asmcomp/printlinear.ml
@@ -0,0 +1,87 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Pretty-printing of linearized machine code *)
+
+open Format
+open Mach
+open Printmach
+open Linear
+
+let label ppf l =
+  Format.fprintf ppf "L%i" l
+
+let instr ppf i =
+  begin match i.desc with
+  | Lend -> ()
+  | Lprologue ->
+      fprintf ppf "prologue"
+  | Lop op ->
+      begin match op with
+      | Ialloc _ | Icall_ind _ | Icall_imm _ | Iextcall _ ->
+          fprintf ppf "@[<1>{%a}@]@," regsetaddr i.live
+      | _ -> ()
+      end;
+      operation op i.arg ppf i.res
+  | Lreloadretaddr ->
+      fprintf ppf "reload retaddr"
+  | Lreturn ->
+      fprintf ppf "return %a" regs i.arg
+  | Llabel lbl ->
+      fprintf ppf "%a:" label lbl
+  | Lbranch lbl ->
+      fprintf ppf "goto %a" label lbl
+  | Lcondbranch(tst, lbl) ->
+      fprintf ppf "if %a goto %a" (test tst) i.arg label lbl
+  | Lcondbranch3(lbl0, lbl1, lbl2) ->
+      fprintf ppf "switch3 %a" reg i.arg.(0);
+      let case n = function
+      | None -> ()
+      | Some lbl ->
+         fprintf ppf "@,case %i: goto %a" n label lbl in
+      case 0 lbl0; case 1 lbl1; case 2 lbl2;
+      fprintf ppf "@,endswitch"
+  | Lswitch lblv ->
+      fprintf ppf "switch %a" reg i.arg.(0);
+      for i = 0 to Array.length lblv - 1 do
+       fprintf ppf "case %i: goto %a" i label lblv.(i)
+      done;
+      fprintf ppf "@,endswitch"
+  | Lentertrap ->
+      fprintf ppf "enter trap"
+  | Ladjust_trap_depth { delta_traps } ->
+      fprintf ppf "adjust trap depth by %d traps" delta_traps
+  | Lpushtrap { lbl_handler; } ->
+      fprintf ppf "push trap %a" label lbl_handler
+  | Lpoptrap ->
+      fprintf ppf "pop trap"
+  | Lraise k ->
+      fprintf ppf "%s %a" (Lambda.raise_kind k) reg i.arg.(0)
+  end;
+  if not (Debuginfo.is_none i.dbg) && !Clflags.locations then
+    fprintf ppf " %s" (Debuginfo.to_string i.dbg)
+
+let rec all_instr ppf i =
+  match i.desc with
+  | Lend -> ()
+  | _ -> fprintf ppf "%a@,%a" instr i all_instr i.next
+
+let fundecl ppf f =
+  let dbg =
+    if Debuginfo.is_none f.fun_dbg || not !Clflags.locations then
+      ""
+    else
+      " " ^ Debuginfo.to_string f.fun_dbg in
+  fprintf ppf "@[%s:%s@,%a@]" f.fun_name dbg all_instr f.fun_body
diff --git a/asmcomp/printlinear.mli b/asmcomp/printlinear.mli
new file mode 100644
index 00000000..fdf36024
--- /dev/null
+++ b/asmcomp/printlinear.mli
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Pretty-printing of linearized machine code *)
+
+open Format
+open Linear
+
+val instr: formatter -> instruction -> unit
+val fundecl: formatter -> fundecl -> unit
diff --git a/asmcomp/printmach.ml b/asmcomp/printmach.ml
new file mode 100644
index 00000000..39128955
--- /dev/null
+++ b/asmcomp/printmach.ml
@@ -0,0 +1,282 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Pretty-printing of pseudo machine code *)
+
+open Format
+open Cmm
+open Reg
+open Mach
+open Interval
+
+module V = Backend_var
+
+let reg ppf r =
+  if not (Reg.anonymous r) then
+    fprintf ppf "%s" (Reg.name r)
+  else
+    fprintf ppf "%s"
+      (match r.typ with Val -> "V" | Addr -> "A" | Int -> "I" | Float -> "F");
+  fprintf ppf "/%i" r.stamp;
+  begin match r.loc with
+  | Unknown -> ()
+  | Reg r ->
+      fprintf ppf "[%s]" (Proc.register_name r)
+  | Stack(Local s) ->
+      fprintf ppf "[s%i]" s
+  | Stack(Incoming s) ->
+      fprintf ppf "[si%i]" s
+  | Stack(Outgoing s) ->
+      fprintf ppf "[so%i]" s
+  end
+
+let regs ppf v =
+  match Array.length v with
+  | 0 -> ()
+  | 1 -> reg ppf v.(0)
+  | n -> reg ppf v.(0);
+         for i = 1 to n-1 do fprintf ppf " %a" reg v.(i) done
+
+let regset ppf s =
+  let first = ref true in
+  Reg.Set.iter
+    (fun r ->
+      if !first then begin first := false; fprintf ppf "%a" reg r end
+      else fprintf ppf "@ %a" reg r)
+    s
+
+let regsetaddr ppf s =
+  let first = ref true in
+  Reg.Set.iter
+    (fun r ->
+      if !first then begin first := false; fprintf ppf "%a" reg r end
+      else fprintf ppf "@ %a" reg r;
+      match r.typ with
+      | Val -> fprintf ppf "*"
+      | Addr -> fprintf ppf "!"
+      | _ -> ())
+    s
+
+let intcomp = function
+  | Isigned c -> Printf.sprintf " %ss " (Printcmm.integer_comparison c)
+  | Iunsigned c -> Printf.sprintf " %su " (Printcmm.integer_comparison c)
+
+let floatcomp c =
+    Printf.sprintf " %sf " (Printcmm.float_comparison c)
+
+let intop = function
+  | Iadd -> " + "
+  | Isub -> " - "
+  | Imul -> " * "
+  | Imulh -> " *h "
+  | Idiv -> " div "
+  | Imod -> " mod "
+  | Iand -> " & "
+  | Ior ->  " | "
+  | Ixor -> " ^ "
+  | Ilsl -> " << "
+  | Ilsr -> " >>u "
+  | Iasr -> " >>s "
+  | Icomp cmp -> intcomp cmp
+  | Icheckbound { label_after_error; spacetime_index; } ->
+    if not Config.spacetime then " check > "
+    else
+      Printf.sprintf "check[lbl=%s,index=%d] > "
+        begin
+          match label_after_error with
+          | None -> ""
+          | Some lbl -> Int.to_string lbl
+        end
+        spacetime_index
+
+let test tst ppf arg =
+  match tst with
+  | Itruetest -> reg ppf arg.(0)
+  | Ifalsetest -> fprintf ppf "not %a" reg arg.(0)
+  | Iinttest cmp -> fprintf ppf "%a%s%a" reg arg.(0) (intcomp cmp) reg arg.(1)
+  | Iinttest_imm(cmp, n) -> fprintf ppf "%a%s%i" reg arg.(0) (intcomp cmp) n
+  | Ifloattest cmp ->
+      fprintf ppf "%a%s%a"
+       reg arg.(0) (floatcomp cmp) reg arg.(1)
+  | Ieventest -> fprintf ppf "%a & 1 == 0" reg arg.(0)
+  | Ioddtest -> fprintf ppf "%a & 1 == 1" reg arg.(0)
+
+let operation op arg ppf res =
+  if Array.length res > 0 then fprintf ppf "%a := " regs res;
+  match op with
+  | Imove -> regs ppf arg
+  | Ispill -> fprintf ppf "%a (spill)" regs arg
+  | Ireload -> fprintf ppf "%a (reload)" regs arg
+  | Iconst_int n -> fprintf ppf "%s" (Nativeint.to_string n)
+  | Iconst_float f -> fprintf ppf "%F" (Int64.float_of_bits f)
+  | Iconst_symbol s -> fprintf ppf "\"%s\"" s
+  | Icall_ind _ -> fprintf ppf "call %a" regs arg
+  | Icall_imm { func; _ } -> fprintf ppf "call \"%s\" %a" func regs arg
+  | Itailcall_ind _ -> fprintf ppf "tailcall %a" regs arg
+  | Itailcall_imm { func; } -> fprintf ppf "tailcall \"%s\" %a" func regs arg
+  | Iextcall { func; alloc; _ } ->
+      fprintf ppf "extcall \"%s\" %a%s" func regs arg
+      (if alloc then "" else " (noalloc)")
+  | Istackoffset n ->
+      fprintf ppf "offset stack %i" n
+  | Iload(chunk, addr) ->
+      fprintf ppf "%s[%a]"
+       (Printcmm.chunk chunk) (Arch.print_addressing reg addr) arg
+  | Istore(chunk, addr, is_assign) ->
+      fprintf ppf "%s[%a] := %a %s"
+       (Printcmm.chunk chunk)
+       (Arch.print_addressing reg addr)
+       (Array.sub arg 1 (Array.length arg - 1))
+       reg arg.(0)
+       (if is_assign then "(assign)" else "(init)")
+  | Ialloc { bytes = n; _ } ->
+    fprintf ppf "alloc %i" n;
+    if Config.spacetime then begin
+      fprintf ppf "(spacetime node = %a)" reg arg.(0)
+    end
+  | Iintop(op) -> fprintf ppf "%a%s%a" reg arg.(0) (intop op) reg arg.(1)
+  | Iintop_imm(op, n) -> fprintf ppf "%a%s%i" reg arg.(0) (intop op) n
+  | Inegf -> fprintf ppf "-f %a" reg arg.(0)
+  | Iabsf -> fprintf ppf "absf %a" reg arg.(0)
+  | Iaddf -> fprintf ppf "%a +f %a" reg arg.(0) reg arg.(1)
+  | Isubf -> fprintf ppf "%a -f %a" reg arg.(0) reg arg.(1)
+  | Imulf -> fprintf ppf "%a *f %a" reg arg.(0) reg arg.(1)
+  | Idivf -> fprintf ppf "%a /f %a" reg arg.(0) reg arg.(1)
+  | Ifloatofint -> fprintf ppf "floatofint %a" reg arg.(0)
+  | Iintoffloat -> fprintf ppf "intoffloat %a" reg arg.(0)
+  | Iname_for_debugger { ident; which_parameter; } ->
+    fprintf ppf "name_for_debugger %a%s=%a"
+      V.print ident
+      (match which_parameter with
+        | None -> ""
+        | Some index -> sprintf "[P%d]" index)
+      reg arg.(0)
+  | Ispecific op ->
+      Arch.print_specific_operation reg op ppf arg
+
+let rec instr ppf i =
+  if !Clflags.dump_live then begin
+    fprintf ppf "@[<1>{%a" regsetaddr i.live;
+    if Array.length i.arg > 0 then fprintf ppf "@ +@ %a" regs i.arg;
+    fprintf ppf "}@]@,";
+    if !Clflags.dump_avail then begin
+      let module RAS = Reg_availability_set in
+      fprintf ppf "@[<1>AB={%a}" (RAS.print ~print_reg:reg) i.available_before;
+      begin match i.available_across with
+      | None -> ()
+      | Some available_across ->
+        fprintf ppf ",AA={%a}" (RAS.print ~print_reg:reg) available_across
+      end;
+      fprintf ppf "@]@,"
+    end
+  end;
+  begin match i.desc with
+  | Iend -> ()
+  | Iop op ->
+      operation op i.arg ppf i.res
+  | Ireturn ->
+      fprintf ppf "return %a" regs i.arg
+  | Iifthenelse(tst, ifso, ifnot) ->
+      fprintf ppf "@[if %a then@,%a" (test tst) i.arg instr ifso;
+      begin match ifnot.desc with
+      | Iend -> ()
+      | _ -> fprintf ppf "@;<0 -2>else@,%a" instr ifnot
+      end;
+      fprintf ppf "@;<0 -2>endif@]"
+  | Iswitch(index, cases) ->
+      fprintf ppf "switch %a" reg i.arg.(0);
+      for i = 0 to Array.length cases - 1 do
+        fprintf ppf "@,@[@[";
+        for j = 0 to Array.length index - 1 do
+          if index.(j) = i then fprintf ppf "case %i:@," j
+        done;
+        fprintf ppf "@]@,%a@]" instr cases.(i)
+      done;
+      fprintf ppf "@,endswitch"
+  | Icatch(flag, handlers, body) ->
+      fprintf ppf "@[catch%a@,%a@;<0 -2>with"
+        Printcmm.rec_flag flag instr body;
+      let h (nfail, handler) =
+        fprintf ppf "(%d)@,%a@;" nfail instr handler in
+      let rec aux = function
+        | [] -> ()
+        | [v] -> h v
+        | v :: t ->
+            h v;
+            fprintf ppf "@ and";
+            aux t
+      in
+      aux handlers;
+      fprintf ppf "@;<0 -2>endcatch@]"
+  | Iexit i ->
+      fprintf ppf "exit(%d)" i
+  | Itrywith(body, handler) ->
+      fprintf ppf "@[try@,%a@;<0 -2>with@,%a@;<0 -2>endtry@]"
+             instr body instr handler
+  | Iraise k ->
+      fprintf ppf "%s %a" (Lambda.raise_kind k) reg i.arg.(0)
+  end;
+  if not (Debuginfo.is_none i.dbg) && !Clflags.locations then
+    fprintf ppf "%s" (Debuginfo.to_string i.dbg);
+  begin match i.next.desc with
+    Iend -> ()
+  | _ -> fprintf ppf "@,%a" instr i.next
+  end
+
+let fundecl ppf f =
+  let dbg =
+    if Debuginfo.is_none f.fun_dbg || not !Clflags.locations then
+      ""
+    else
+      " " ^ Debuginfo.to_string f.fun_dbg in
+  fprintf ppf "@[%s(%a)%s@,%a@]"
+    f.fun_name regs f.fun_args dbg instr f.fun_body
+
+let phase msg ppf f =
+  fprintf ppf "*** %s@.%a@." msg fundecl f
+
+let interference ppf r =
+  let interf ppf =
+   List.iter
+    (fun r -> fprintf ppf "@ %a" reg r)
+    r.interf in
+  fprintf ppf "@[<2>%a:%t@]@." reg r interf
+
+let interferences ppf () =
+  fprintf ppf "*** Interferences@.";
+  List.iter (interference ppf) (Reg.all_registers())
+
+let interval ppf i =
+  let interv ppf =
+    List.iter
+      (fun r -> fprintf ppf "@ [%d;%d]" r.rbegin r.rend)
+      i.ranges in
+  fprintf ppf "@[<2>%a:%t@]@." reg i.reg interv
+
+let intervals ppf () =
+  fprintf ppf "*** Intervals@.";
+  List.iter (interval ppf) (Interval.all_fixed_intervals());
+  List.iter (interval ppf) (Interval.all_intervals())
+
+let preference ppf r =
+  let prefs ppf =
+    List.iter
+      (fun (r, w) -> fprintf ppf "@ %a weight %i" reg r w)
+      r.prefer in
+  fprintf ppf "@[<2>%a: %t@]@." reg r prefs
+
+let preferences ppf () =
+  fprintf ppf "*** Preferences@.";
+  List.iter (preference ppf) (Reg.all_registers())
diff --git a/asmcomp/printmach.mli b/asmcomp/printmach.mli
new file mode 100644
index 00000000..0cad0776
--- /dev/null
+++ b/asmcomp/printmach.mli
@@ -0,0 +1,31 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Pretty-printing of pseudo machine code *)
+
+open Format
+
+val reg: formatter -> Reg.t -> unit
+val regs: formatter -> Reg.t array -> unit
+val regset: formatter -> Reg.Set.t -> unit
+val regsetaddr: formatter -> Reg.Set.t -> unit
+val operation: Mach.operation -> Reg.t array -> formatter -> Reg.t array -> unit
+val test: Mach.test -> formatter -> Reg.t array -> unit
+val instr: formatter -> Mach.instruction -> unit
+val fundecl: formatter -> Mach.fundecl -> unit
+val phase: string -> formatter -> Mach.fundecl -> unit
+val interferences: formatter -> unit -> unit
+val intervals: formatter -> unit -> unit
+val preferences: formatter -> unit -> unit
diff --git a/asmcomp/proc.mli b/asmcomp/proc.mli
new file mode 100644
index 00000000..91b15de4
--- /dev/null
+++ b/asmcomp/proc.mli
@@ -0,0 +1,86 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Processor descriptions *)
+
+(* Instruction selection *)
+val word_addressed: bool
+
+(* Registers available for register allocation *)
+val num_register_classes: int
+val register_class: Reg.t -> int
+val num_available_registers: int array
+val first_available_register: int array
+val register_name: int -> string
+val phys_reg: int -> Reg.t
+val rotate_registers: bool
+
+(* Calling conventions *)
+val loc_arguments: Reg.t array -> Reg.t array * int
+val loc_results: Reg.t array -> Reg.t array
+val loc_parameters: Reg.t array -> Reg.t array
+(* For argument number [n] split across multiple registers, the target-specific
+   implementation of [loc_external_arguments] must return [regs] such that
+   [regs.(n).(0)] is to hold the part of the value at the lowest address.
+   (All that matters for the input to [loc_external_arguments] is the pattern
+   of lengths and register types of the various supplied arrays.) *)
+val loc_external_arguments: Reg.t array array -> Reg.t array array * int
+val loc_external_results: Reg.t array -> Reg.t array
+val loc_exn_bucket: Reg.t
+val loc_spacetime_node_hole: Reg.t
+
+(* The maximum number of arguments of an OCaml to OCaml function call for
+   which it is guaranteed there will be no arguments passed on the stack.
+   (Above this limit, tail call optimization may be disabled.)
+   N.B. The values for this parameter in the backends currently assume
+   that no unboxed floats are passed using the OCaml calling conventions.
+*)
+val max_arguments_for_tailcalls : int
+
+(* Maximal register pressures for pre-spilling *)
+val safe_register_pressure: Mach.operation -> int
+val max_register_pressure: Mach.operation -> int array
+
+(* Registers destroyed by operations *)
+val destroyed_at_oper: Mach.instruction_desc -> Reg.t array
+val destroyed_at_raise: Reg.t array
+val destroyed_at_reloadretaddr : Reg.t array
+
+(* Volatile registers: those that change value when read *)
+val regs_are_volatile: Reg.t array -> bool
+
+(* Pure operations *)
+val op_is_pure: Mach.operation -> bool
+
+(* Info for laying out the stack frame *)
+val frame_required : Mach.fundecl -> bool
+
+(* Function prologues *)
+val prologue_required : Mach.fundecl -> bool
+
+(** For a given register class, the DWARF register numbering for that class.
+    Given an allocated register with location [Reg n] and class [reg_class], the
+    returned array contains the corresponding DWARF register number at index
+    [n - first_available_register.(reg_class)]. *)
+val dwarf_register_numbers : reg_class:int -> int array
+
+(** The DWARF register number corresponding to the stack pointer. *)
+val stack_ptr_dwarf_register_number : int
+
+(* Calling the assembler *)
+val assemble_file: string -> string -> int
+
+(* Called before translating a fundecl. *)
+val init : unit -> unit
diff --git a/asmcomp/reg.ml b/asmcomp/reg.ml
new file mode 100644
index 00000000..145545d9
--- /dev/null
+++ b/asmcomp/reg.ml
@@ -0,0 +1,225 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Cmm
+
+module V = Backend_var
+
+module Raw_name = struct
+  type t =
+    | Anon
+    | R
+    | Var of V.t
+
+  let create_from_var var = Var var
+
+  let to_string t =
+    match t with
+    | Anon -> None
+    | R -> Some "R"
+    | Var var ->
+      let name = V.name var in
+      if String.length name <= 0 then None else Some name
+end
+
+type t =
+  { mutable raw_name: Raw_name.t;
+    stamp: int;
+    typ: Cmm.machtype_component;
+    mutable loc: location;
+    mutable spill: bool;
+    mutable part: int option;
+    mutable interf: t list;
+    mutable prefer: (t * int) list;
+    mutable degree: int;
+    mutable spill_cost: int;
+    mutable visited: int }
+
+and location =
+    Unknown
+  | Reg of int
+  | Stack of stack_location
+
+and stack_location =
+    Local of int
+  | Incoming of int
+  | Outgoing of int
+
+type reg = t
+
+let dummy =
+  { raw_name = Raw_name.Anon; stamp = 0; typ = Int; loc = Unknown;
+    spill = false; interf = []; prefer = []; degree = 0; spill_cost = 0;
+    visited = 0; part = None;
+  }
+
+let currstamp = ref 0
+let reg_list = ref([] : t list)
+let hw_reg_list = ref ([] : t list)
+
+let visit_generation = ref 1
+
+(* Any visited value not equal to !visit_generation counts as "unvisited" *)
+let unvisited = 0
+
+let mark_visited r =
+  r.visited <- !visit_generation
+
+let is_visited r =
+  r.visited = !visit_generation
+
+let clear_visited_marks () =
+  incr visit_generation
+
+
+let create ty =
+  let r = { raw_name = Raw_name.Anon; stamp = !currstamp; typ = ty;
+            loc = Unknown; spill = false; interf = []; prefer = []; degree = 0;
+            spill_cost = 0; visited = unvisited; part = None; } in
+  reg_list := r :: !reg_list;
+  incr currstamp;
+  r
+
+let createv tyv =
+  let n = Array.length tyv in
+  let rv = Array.make n dummy in
+  for i = 0 to n-1 do rv.(i) <- create tyv.(i) done;
+  rv
+
+let createv_like rv =
+  let n = Array.length rv in
+  let rv' = Array.make n dummy in
+  for i = 0 to n-1 do rv'.(i) <- create rv.(i).typ done;
+  rv'
+
+let clone r =
+  let nr = create r.typ in
+  nr.raw_name <- r.raw_name;
+  nr
+
+let at_location ty loc =
+  let r = { raw_name = Raw_name.R; stamp = !currstamp; typ = ty; loc;
+            spill = false; interf = []; prefer = []; degree = 0;
+            spill_cost = 0; visited = unvisited; part = None; } in
+  hw_reg_list := r :: !hw_reg_list;
+  incr currstamp;
+  r
+
+let anonymous t =
+  match Raw_name.to_string t.raw_name with
+  | None -> true
+  | Some _raw_name -> false
+
+let name t =
+  match Raw_name.to_string t.raw_name with
+  | None -> ""
+  | Some raw_name ->
+    let with_spilled =
+      if t.spill then
+        "spilled-" ^ raw_name
+      else
+        raw_name
+    in
+    match t.part with
+    | None -> with_spilled
+    | Some part -> with_spilled ^ "#" ^ Int.to_string part
+
+let first_virtual_reg_stamp = ref (-1)
+
+let reset() =
+  (* When reset() is called for the first time, the current stamp reflects
+     all hard pseudo-registers that have been allocated by Proc, so
+     remember it and use it as the base stamp for allocating
+     soft pseudo-registers *)
+  if !first_virtual_reg_stamp = -1 then begin
+    first_virtual_reg_stamp := !currstamp;
+    assert (!reg_list = []) (* Only hard regs created before now *)
+  end;
+  currstamp := !first_virtual_reg_stamp;
+  reg_list := [];
+  visit_generation := 1;
+  !hw_reg_list |> List.iter (fun r ->
+    r.visited <- unvisited)
+
+let all_registers() = !reg_list
+let num_registers() = !currstamp
+
+let reinit_reg r =
+  r.loc <- Unknown;
+  r.interf <- [];
+  r.prefer <- [];
+  r.degree <- 0;
+  (* Preserve the very high spill costs introduced by the reloading pass *)
+  if r.spill_cost >= 100000
+  then r.spill_cost <- 100000
+  else r.spill_cost <- 0
+
+let reinit() =
+  List.iter reinit_reg !reg_list
+
+module RegOrder =
+  struct
+    type t = reg
+    let compare r1 r2 = r1.stamp - r2.stamp
+  end
+
+module Set = Set.Make(RegOrder)
+module Map = Map.Make(RegOrder)
+
+let add_set_array s v =
+  match Array.length v with
+    0 -> s
+  | 1 -> Set.add v.(0) s
+  | n -> let rec add_all i =
+           if i >= n then s else Set.add v.(i) (add_all(i+1))
+         in add_all 0
+
+let diff_set_array s v =
+  match Array.length v with
+    0 -> s
+  | 1 -> Set.remove v.(0) s
+  | n -> let rec remove_all i =
+           if i >= n then s else Set.remove v.(i) (remove_all(i+1))
+         in remove_all 0
+
+let inter_set_array s v =
+  match Array.length v with
+    0 -> Set.empty
+  | 1 -> if Set.mem v.(0) s
+         then Set.add v.(0) Set.empty
+         else Set.empty
+  | n -> let rec inter_all i =
+           if i >= n then Set.empty
+           else if Set.mem v.(i) s then Set.add v.(i) (inter_all(i+1))
+           else inter_all(i+1)
+         in inter_all 0
+
+let disjoint_set_array s v =
+  match Array.length v with
+    0 -> true
+  | 1 -> not (Set.mem v.(0) s)
+  | n -> let rec disjoint_all i =
+           if i >= n then true
+           else if Set.mem v.(i) s then false
+           else disjoint_all (i+1)
+         in disjoint_all 0
+
+let set_of_array v =
+  match Array.length v with
+    0 -> Set.empty
+  | 1 -> Set.add v.(0) Set.empty
+  | n -> let rec add_all i =
+           if i >= n then Set.empty else Set.add v.(i) (add_all(i+1))
+         in add_all 0
diff --git a/asmcomp/reg.mli b/asmcomp/reg.mli
new file mode 100644
index 00000000..8e40f431
--- /dev/null
+++ b/asmcomp/reg.mli
@@ -0,0 +1,74 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Pseudo-registers *)
+
+module Raw_name : sig
+  type t
+  val create_from_var : Backend_var.t -> t
+end
+
+type t =
+  { mutable raw_name: Raw_name.t;       (* Name *)
+    stamp: int;                         (* Unique stamp *)
+    typ: Cmm.machtype_component;        (* Type of contents *)
+    mutable loc: location;              (* Actual location *)
+    mutable spill: bool;                (* "true" to force stack allocation  *)
+    mutable part: int option;           (* Zero-based index of part of value *)
+    mutable interf: t list;             (* Other regs live simultaneously *)
+    mutable prefer: (t * int) list;     (* Preferences for other regs *)
+    mutable degree: int;                (* Number of other regs live sim. *)
+    mutable spill_cost: int;            (* Estimate of spilling cost *)
+    mutable visited: int }              (* For graph walks *)
+
+and location =
+    Unknown
+  | Reg of int
+  | Stack of stack_location
+
+and stack_location =
+    Local of int
+  | Incoming of int
+  | Outgoing of int
+
+val dummy: t
+val create: Cmm.machtype_component -> t
+val createv: Cmm.machtype -> t array
+val createv_like: t array -> t array
+val clone: t -> t
+val at_location: Cmm.machtype_component -> location -> t
+
+val anonymous : t -> bool
+
+(* Name for printing *)
+val name : t -> string
+
+module Set: Set.S with type elt = t
+module Map: Map.S with type key = t
+
+val add_set_array: Set.t -> t array -> Set.t
+val diff_set_array: Set.t -> t array -> Set.t
+val inter_set_array: Set.t -> t array -> Set.t
+val disjoint_set_array: Set.t -> t array -> bool
+val set_of_array: t array -> Set.t
+
+val reset: unit -> unit
+val all_registers: unit -> t list
+val num_registers: unit -> int
+val reinit: unit -> unit
+
+val mark_visited : t -> unit
+val is_visited : t -> bool
+val clear_visited_marks : unit -> unit
diff --git a/asmcomp/reload.mli b/asmcomp/reload.mli
new file mode 100644
index 00000000..5d9e35e3
--- /dev/null
+++ b/asmcomp/reload.mli
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Insert load/stores for pseudoregs that got assigned to stack locations. *)
+
+val fundecl: Mach.fundecl -> int array -> Mach.fundecl * bool
diff --git a/asmcomp/reloadgen.ml b/asmcomp/reloadgen.ml
new file mode 100644
index 00000000..bea7bafa
--- /dev/null
+++ b/asmcomp/reloadgen.ml
@@ -0,0 +1,136 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Insert load/stores for pseudoregs that got assigned to stack locations. *)
+
+open Misc
+open Reg
+open Mach
+
+let insert_move src dst next =
+  if src.loc = dst.loc
+  then next
+  else instr_cons (Iop Imove) [|src|] [|dst|] next
+
+let insert_moves src dst next =
+  let rec insmoves i =
+    if i >= Array.length src
+    then next
+    else insert_move src.(i) dst.(i) (insmoves (i+1))
+  in insmoves 0
+
+class reload_generic = object (self)
+
+val mutable redo_regalloc = false
+
+method makereg r =
+  match r.loc with
+    Unknown -> fatal_error "Reload.makereg"
+  | Reg _ -> r
+  | Stack _ ->
+      redo_regalloc <- true;
+      let newr = Reg.clone r in
+      (* Strongly discourage spilling this register *)
+      newr.spill_cost <- 100000;
+      newr
+
+method private makeregs rv =
+  let n = Array.length rv in
+  let newv = Array.make n Reg.dummy in
+  for i = 0 to n-1 do newv.(i) <- self#makereg rv.(i) done;
+  newv
+
+method private makereg1 rv =
+  let newv = Array.copy rv in
+  newv.(0) <- self#makereg rv.(0);
+  newv
+
+method reload_operation op arg res =
+  (* By default, assume that arguments and results must reside
+     in hardware registers. For moves, allow one arg or one
+     res to be stack-allocated, but do something for
+     stack-to-stack moves *)
+  match op with
+    Imove | Ireload | Ispill ->
+      begin match arg.(0), res.(0) with
+        {loc = Stack s1}, {loc = Stack s2} when s1 <> s2 ->
+          ([| self#makereg arg.(0) |], res)
+      | _ ->
+          (arg, res)
+      end
+  | _ ->
+      (self#makeregs arg, self#makeregs res)
+
+method reload_test _tst args =
+  self#makeregs args
+
+method private reload i =
+  match i.desc with
+    (* For function calls, returns, etc: the arguments and results are
+       already at the correct position (e.g. on stack for some arguments).
+       However, something needs to be done for the function pointer in
+       indirect calls. *)
+    Iend | Ireturn | Iop(Itailcall_imm _) | Iraise _ -> i
+  | Iop(Itailcall_ind _) ->
+      let newarg = self#makereg1 i.arg in
+      insert_moves i.arg newarg
+        {i with arg = newarg}
+  | Iop(Icall_imm _ | Iextcall _) ->
+      {i with next = self#reload i.next}
+  | Iop(Icall_ind _) ->
+      let newarg = self#makereg1 i.arg in
+      insert_moves i.arg newarg
+        {i with arg = newarg; next = self#reload i.next}
+  | Iop op ->
+      let (newarg, newres) = self#reload_operation op i.arg i.res in
+      insert_moves i.arg newarg
+        {i with arg = newarg; res = newres; next =
+          (insert_moves newres i.res
+            (self#reload i.next))}
+  | Iifthenelse(tst, ifso, ifnot) ->
+      let newarg = self#reload_test tst i.arg in
+      insert_moves i.arg newarg
+        (instr_cons
+          (Iifthenelse(tst, self#reload ifso, self#reload ifnot)) newarg [||]
+          (self#reload i.next))
+  | Iswitch(index, cases) ->
+      let newarg = self#makeregs i.arg in
+      insert_moves i.arg newarg
+        (instr_cons (Iswitch(index, Array.map (self#reload) cases)) newarg [||]
+          (self#reload i.next))
+  | Icatch(rec_flag, handlers, body) ->
+      let new_handlers = List.map
+          (fun (nfail, handler) -> nfail, self#reload handler)
+          handlers in
+      instr_cons
+        (Icatch(rec_flag, new_handlers, self#reload body)) [||] [||]
+        (self#reload i.next)
+  | Iexit i ->
+      instr_cons (Iexit i) [||] [||] dummy_instr
+  | Itrywith(body, handler) ->
+      instr_cons (Itrywith(self#reload body, self#reload handler)) [||] [||]
+        (self#reload i.next)
+
+method fundecl f num_stack_slots =
+  redo_regalloc <- false;
+  let new_body = self#reload f.fun_body in
+  ({fun_name = f.fun_name; fun_args = f.fun_args;
+    fun_body = new_body; fun_codegen_options = f.fun_codegen_options;
+    fun_dbg  = f.fun_dbg; fun_spacetime_shape = f.fun_spacetime_shape;
+    fun_contains_calls = f.fun_contains_calls;
+    fun_num_stack_slots = Array.copy num_stack_slots;
+   },
+   redo_regalloc)
+end
diff --git a/asmcomp/reloadgen.mli b/asmcomp/reloadgen.mli
new file mode 100644
index 00000000..638082f0
--- /dev/null
+++ b/asmcomp/reloadgen.mli
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+class reload_generic : object
+  method reload_operation :
+    Mach.operation -> Reg.t array -> Reg.t array -> Reg.t array * Reg.t array
+  method reload_test : Mach.test -> Reg.t array -> Reg.t array
+    (* Can be overridden to reflect instructions that can operate
+       directly on stack locations *)
+  method makereg : Reg.t -> Reg.t
+    (* Can be overridden to avoid creating new registers of some class
+       (i.e. if all "registers" of that class are actually on stack) *)
+  method fundecl : Mach.fundecl -> int array -> Mach.fundecl * bool
+    (* The entry point *)
+end
diff --git a/asmcomp/riscv/CSE.ml b/asmcomp/riscv/CSE.ml
new file mode 100644
index 00000000..6aed1c07
--- /dev/null
+++ b/asmcomp/riscv/CSE.ml
@@ -0,0 +1,39 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Nicolas Ojeda Bar                  *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* CSE for the RISC-V *)
+
+open Arch
+open Mach
+open CSEgen
+
+class cse = object (_self)
+
+inherit cse_generic as super
+
+method! class_of_operation op =
+  match op with
+  | Ispecific(Imultaddf _ | Imultsubf _) -> Op_pure
+  | _ -> super#class_of_operation op
+
+method! is_cheap_operation op =
+  match op with
+  | Iconst_int n -> n <= 0x7FFn && n >= -0x800n
+  | _ -> false
+
+end
+
+let fundecl f =
+  (new cse)#fundecl f
diff --git a/asmcomp/riscv/NOTES.md b/asmcomp/riscv/NOTES.md
new file mode 100644
index 00000000..3b00d08e
--- /dev/null
+++ b/asmcomp/riscv/NOTES.md
@@ -0,0 +1,18 @@
+# Supported platforms
+
+RISC-V in 64-bit mode, general variant, a.k.a `RV64G`.
+
+Debian architecture name: `riscv64`
+
+# Reference documents
+
+* Instruction set specification:
+  - https://riscv.org/specifications/isa-spec-pdf/
+  - https://rv8.io/isa
+
+* ELF ABI specification:
+  - https://github.com/riscv/riscv-elf-psabi-doc/blob/master/riscv-elf.md
+
+* Assembly language manual
+  - https://github.com/riscv/riscv-asm-manual/blob/master/riscv-asm.md
+  - https://rv8.io/asm
diff --git a/asmcomp/riscv/arch.ml b/asmcomp/riscv/arch.ml
new file mode 100644
index 00000000..c6ade527
--- /dev/null
+++ b/asmcomp/riscv/arch.ml
@@ -0,0 +1,87 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Nicolas Ojeda Bar                  *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Specific operations for the RISC-V processor *)
+
+open Format
+
+(* Machine-specific command-line options *)
+
+let command_line_options = []
+
+(* Specific operations *)
+
+type specific_operation =
+  | Imultaddf of bool        (* multiply, optionally negate, and add *)
+  | Imultsubf of bool        (* multiply, optionally negate, and subtract *)
+
+let spacetime_node_hole_pointer_is_live_before = function
+  | Imultaddf _ | Imultsubf _ -> false
+
+(* Addressing modes *)
+
+type addressing_mode =
+  | Iindexed of int                     (* reg + displ *)
+
+let is_immediate n =
+  (n <= 0x7FF) && (n >= -0x800)
+
+(* Sizes, endianness *)
+
+let big_endian = false
+
+let size_addr = 8
+let size_int = size_addr
+let size_float = 8
+
+let allow_unaligned_access = false
+
+(* Behavior of division *)
+
+let division_crashes_on_overflow = false
+
+(* Operations on addressing modes *)
+
+let identity_addressing = Iindexed 0
+
+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 =
+  match addr with
+  | Iindexed n ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a%s" printreg arg.(0) idx
+
+let print_specific_operation printreg op ppf arg =
+  match op with
+  | Imultaddf false ->
+      fprintf ppf "%a *f %a +f %a"
+        printreg arg.(0) printreg arg.(1) printreg arg.(2)
+  | Imultaddf true ->
+      fprintf ppf "-f (%a *f %a +f %a)"
+        printreg arg.(0) printreg arg.(1) printreg arg.(2)
+  | Imultsubf false ->
+      fprintf ppf "%a *f %a -f %a"
+        printreg arg.(0) printreg arg.(1) printreg arg.(2)
+  | Imultsubf true ->
+      fprintf ppf "-f (%a *f %a -f %a)"
+        printreg arg.(0) printreg arg.(1) printreg arg.(2)
diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp
new file mode 100644
index 00000000..dbfdc2d4
--- /dev/null
+++ b/asmcomp/riscv/emit.mlp
@@ -0,0 +1,686 @@
+# 2 "asmcomp/riscv/emit.mlp"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Nicolas Ojeda Bar                  *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Emission of RISC-V assembly code *)
+
+open Cmm
+open Arch
+open Proc
+open Reg
+open Mach
+open Linear
+open Emitaux
+
+(* Layout of the stack.  The stack is kept 16-aligned. *)
+
+let stack_offset = ref 0
+
+let num_stack_slots = Array.make Proc.num_register_classes 0
+
+let prologue_required = ref false
+
+let contains_calls = ref false
+
+let frame_size () =
+  let size =
+    !stack_offset +                     (* Trap frame, outgoing parameters *)
+    size_int * num_stack_slots.(0) +    (* Local int variables *)
+    size_float * num_stack_slots.(1) +  (* Local float variables *)
+    (if !contains_calls then size_addr else 0) in (* The return address *)
+  Misc.align size 16
+
+let slot_offset loc cls =
+  match loc with
+  | Local n ->
+      if cls = 0
+      then !stack_offset + num_stack_slots.(1) * size_float + n * size_int
+      else !stack_offset + n * size_float
+  | Incoming n -> frame_size() + n
+  | Outgoing n -> n
+
+(* Output a symbol *)
+
+let emit_symbol s =
+  emit_symbol '$' s
+
+let emit_jump op s =
+  if !Clflags.dlcode || !Clflags.pic_code
+  then `{emit_string op}	{emit_symbol s}@plt`
+  else `{emit_string op}	{emit_symbol s}`
+
+let emit_call = emit_jump "call"
+let emit_tail = emit_jump "tail"
+
+(* Output a label *)
+
+let emit_label lbl =
+  emit_string ".L"; emit_int lbl
+
+(* Section switching *)
+
+let data_space =
+  ".section .data"
+
+let code_space =
+  ".section .text"
+
+let rodata_space =
+  ".section .rodata"
+
+(* Names for special regs *)
+
+let reg_tmp = phys_reg 22
+let reg_t2 = phys_reg 16
+let reg_domain_state_ptr = phys_reg 23
+let reg_trap = phys_reg 24
+let reg_alloc_ptr = phys_reg 25
+let reg_alloc_lim = phys_reg 26
+
+(* Output a pseudo-register *)
+
+let reg_name = function
+  | {loc = Reg r} -> register_name r
+  | _ -> Misc.fatal_error "Emit.reg_name"
+
+let emit_reg r =
+  emit_string (reg_name r)
+
+(* Adjust sp by the given byte amount *)
+
+let emit_stack_adjustment = function
+  | 0 -> ()
+  | n when is_immediate n ->
+      `	addi	sp, sp, {emit_int n}\n`
+  | n ->
+      `	li	{emit_reg reg_tmp}, {emit_int n}\n`;
+      `	add	sp, sp, {emit_reg reg_tmp}\n`
+
+let emit_mem_op op src ofs =
+  if is_immediate ofs then
+    `	{emit_string op}	{emit_string src}, {emit_int ofs}(sp)\n`
+  else begin
+    `	li	{emit_reg reg_tmp}, {emit_int ofs}\n`;
+    `	add	{emit_reg reg_tmp}, sp, {emit_reg reg_tmp}\n`;
+    `	{emit_string op}	{emit_string src}, 0({emit_reg reg_tmp})\n`
+  end
+
+let emit_store src ofs =
+  emit_mem_op "sd" src ofs
+
+let emit_load dst ofs =
+  emit_mem_op "ld" dst ofs
+
+let reload_ra n =
+  emit_load "ra" (n - size_addr)
+
+let store_ra n =
+  emit_store "ra" (n - size_addr)
+
+let emit_store src ofs =
+  emit_store (reg_name src) ofs
+
+let emit_load dst ofs =
+  emit_load (reg_name dst) ofs
+
+let emit_float_load dst ofs =
+  emit_mem_op "fld" (reg_name dst) ofs
+
+let emit_float_store src ofs =
+  emit_mem_op "fsd" (reg_name src) ofs
+
+(* Record live pointers at call points *)
+
+let record_frame_label ?label live dbg =
+  let lbl =
+    match label with
+    | None -> new_label()
+    | Some label -> label
+  in
+  let live_offset = ref [] in
+  Reg.Set.iter
+    (function
+        {typ = Val; loc = Reg r} ->
+          live_offset := (r lsl 1) + 1 :: !live_offset
+      | {typ = Val; loc = Stack s} as reg ->
+          live_offset := slot_offset s (register_class reg) :: !live_offset
+      | {typ = Addr} as r ->
+          Misc.fatal_error ("bad GC root " ^ Reg.name r)
+      | _ -> ()
+    )
+    live;
+  record_frame_descr ~label:lbl ~frame_size:(frame_size())
+    ~live_offset:!live_offset dbg;
+  lbl
+
+let record_frame ?label live dbg =
+  let lbl = record_frame_label ?label live dbg in
+  `{emit_label lbl}:\n`
+
+(* Record calls to the GC -- we've moved them out of the way *)
+
+type gc_call =
+  { gc_lbl: label;                      (* Entry label *)
+    gc_return_lbl: label;               (* Where to branch after GC *)
+    gc_frame_lbl: label }               (* Label of frame descriptor *)
+
+let call_gc_sites = ref ([] : gc_call list)
+
+let emit_call_gc gc =
+  `{emit_label gc.gc_lbl}:\n`;
+  `	{emit_call "caml_call_gc"}\n`;
+  `{emit_label gc.gc_frame_lbl}:\n`;
+  `	j	{emit_label gc.gc_return_lbl}\n`
+
+(* Record calls to caml_ml_array_bound_error.
+   In debug mode, we maintain one call to caml_ml_array_bound_error
+   per bound check site.  Otherwise, we can share a single call. *)
+
+type bound_error_call =
+  { bd_lbl: label;                      (* Entry label *)
+    bd_frame_lbl: label }               (* Label of frame descriptor *)
+
+let bound_error_sites = ref ([] : bound_error_call list)
+
+let bound_error_label ?label dbg =
+  if !Clflags.debug || !bound_error_sites = [] then begin
+    let lbl_bound_error = new_label() in
+    let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
+    bound_error_sites :=
+      { bd_lbl = lbl_bound_error;
+        bd_frame_lbl = lbl_frame } :: !bound_error_sites;
+    lbl_bound_error
+  end else
+    let bd = List.hd !bound_error_sites in
+    bd.bd_lbl
+
+let emit_call_bound_error bd =
+  `{emit_label bd.bd_lbl}:\n`;
+  `	{emit_call "caml_ml_array_bound_error"}\n`;
+  `{emit_label bd.bd_frame_lbl}:\n`
+
+(* Record floating-point literals *)
+
+let float_literals = ref ([] : (int64 * int) list)
+
+(* Names for various instructions *)
+
+let name_for_intop = function
+  | Iadd  -> "add"
+  | Isub  -> "sub"
+  | Imul  -> "mul"
+  | Imulh -> "mulh"
+  | Idiv  -> "div"
+  | Iand  -> "and"
+  | Ior   -> "or"
+  | Ixor  -> "xor"
+  | Ilsl  -> "sll"
+  | Ilsr  -> "srl"
+  | Iasr  -> "sra"
+  | Imod  -> "rem"
+  | _ -> Misc.fatal_error "Emit.Intop"
+
+let name_for_intop_imm = function
+  | Iadd -> "addi"
+  | Iand -> "andi"
+  | Ior  -> "ori"
+  | Ixor -> "xori"
+  | Ilsl -> "slli"
+  | Ilsr -> "srli"
+  | Iasr -> "srai"
+  | _ -> Misc.fatal_error "Emit.Intop_imm"
+
+let name_for_floatop1 = function
+  | Inegf -> "fneg.d"
+  | Iabsf -> "fabs.d"
+  | _ -> Misc.fatal_error "Emit.Iopf1"
+
+let name_for_floatop2 = function
+  | Iaddf -> "fadd.d"
+  | Isubf -> "fsub.d"
+  | Imulf -> "fmul.d"
+  | Idivf -> "fdiv.d"
+  | _ -> Misc.fatal_error "Emit.Iopf2"
+
+let name_for_specific = function
+  | Imultaddf false -> "fmadd.d"
+  | Imultaddf true  -> "fnmadd.d"
+  | Imultsubf false -> "fmsub.d"
+  | Imultsubf true  -> "fnmsub.d"
+
+(* Name of current function *)
+let function_name = ref ""
+
+(* Entry point for tail recursive calls *)
+let tailrec_entry_point = ref 0
+
+(* Output the assembly code for an instruction *)
+
+let emit_instr i =
+  emit_debug_info i.dbg;
+  match i.desc with
+    Lend -> ()
+  | Lprologue ->
+      assert (!prologue_required);
+      let n = frame_size() in
+      emit_stack_adjustment (-n);
+      if !contains_calls then store_ra n
+  | Lop(Imove | Ispill | Ireload) ->
+      let src = i.arg.(0) and dst = i.res.(0) in
+      if src.loc <> dst.loc then begin
+        match (src, dst) with
+        | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Reg _} ->
+            `	mv      {emit_reg dst}, {emit_reg src}\n`
+        | {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} ->
+            `	fmv.d   {emit_reg dst}, {emit_reg src}\n`
+        | {loc = Reg _; typ = Float}, {loc = Reg _; typ = (Val | Int | Addr)} ->
+            `	fmv.x.d {emit_reg dst}, {emit_reg src}\n`
+        | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack s} ->
+            let ofs = slot_offset s (register_class dst) in
+            emit_store src ofs
+        | {loc = Reg _; typ = Float}, {loc = Stack s} ->
+            let ofs = slot_offset s (register_class dst) in
+            emit_float_store src ofs
+        | {loc = Stack s; typ = (Val | Int | Addr)}, {loc = Reg _} ->
+            let ofs = slot_offset s (register_class src) in
+            emit_load dst ofs
+        | {loc = Stack s; typ = Float}, {loc = Reg _} ->
+            let ofs = slot_offset s (register_class src) in
+            emit_float_load dst ofs
+        | {loc = Stack _}, {loc = Stack _}
+        | {loc = Unknown}, _ | _, {loc = Unknown} ->
+            Misc.fatal_error "Emit: Imove"
+      end
+  | Lop(Iconst_int n) ->
+      `	li	{emit_reg i.res.(0)}, {emit_nativeint n}\n`
+  | Lop(Iconst_float f) ->
+      let lbl = new_label() in
+      float_literals := (f, lbl) :: !float_literals;
+      `	fld	{emit_reg i.res.(0)}, {emit_label lbl}, {emit_reg reg_tmp}\n`
+  | Lop(Iconst_symbol s) ->
+      `	la	{emit_reg i.res.(0)}, {emit_symbol s}\n`
+  | Lop(Icall_ind {label_after = label}) ->
+      `	jalr	{emit_reg i.arg.(0)}\n`;
+      record_frame ~label i.live (Dbg_other i.dbg)
+  | Lop(Icall_imm {func; label_after = label}) ->
+      `	{emit_call func}\n`;
+      record_frame ~label i.live (Dbg_other i.dbg)
+  | Lop(Itailcall_ind {label_after = _}) ->
+      let n = frame_size() in
+      if !contains_calls then reload_ra n;
+      emit_stack_adjustment n;
+      `	jr	{emit_reg i.arg.(0)}\n`
+  | Lop(Itailcall_imm {func; label_after = _}) ->
+      if func = !function_name then begin
+        `	j	{emit_label !tailrec_entry_point}\n`
+      end else begin
+        let n = frame_size() in
+        if !contains_calls then reload_ra n;
+        emit_stack_adjustment n;
+        `	{emit_tail func}\n`
+      end
+  | Lop(Iextcall{func; alloc = true; label_after = label}) ->
+      `	la	{emit_reg reg_t2}, {emit_symbol func}\n`;
+      `	{emit_call "caml_c_call"}\n`;
+      record_frame ~label i.live (Dbg_other i.dbg)
+  | Lop(Iextcall{func; alloc = false; label_after = _}) ->
+      `	{emit_call func}\n`
+  | Lop(Istackoffset n) ->
+      assert (n mod 16 = 0);
+      emit_stack_adjustment (-n);
+      stack_offset := !stack_offset + n
+  | Lop(Iload(Single, Iindexed ofs)) ->
+      `	flw	{emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`;
+      `	fcvt.d.s	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
+  | Lop(Iload(chunk, Iindexed ofs)) ->
+      let instr =
+        match chunk with
+        | Byte_unsigned -> "lbu"
+        | Byte_signed -> "lb"
+        | Sixteen_unsigned -> "lhu"
+        | Sixteen_signed -> "lh"
+        | Thirtytwo_unsigned -> "lwu"
+        | Thirtytwo_signed -> "lw"
+        | Word_int | Word_val -> "ld"
+        | Single -> assert false
+        | Double | Double_u -> "fld"
+      in
+      `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`
+  | Lop(Istore(Single, Iindexed ofs, _)) ->
+      (* ft0 is marked as destroyed for this operation *)
+      `	fcvt.s.d	ft0, {emit_reg i.arg.(0)}\n`;
+      `	fsw	ft0, {emit_int ofs}({emit_reg i.arg.(1)})\n`
+  | Lop(Istore(chunk, Iindexed ofs, _)) ->
+      let instr =
+        match chunk with
+        | Byte_unsigned | Byte_signed -> "sb"
+        | Sixteen_unsigned | Sixteen_signed -> "sh"
+        | Thirtytwo_unsigned | Thirtytwo_signed -> "sw"
+        | Word_int | Word_val -> "sd"
+        | Single -> assert false
+        | Double | Double_u -> "fsd"
+      in
+      `	{emit_string instr}	{emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n`
+  | Lop(Ialloc {bytes; label_after_call_gc = label; dbginfo}) ->
+      let lbl_frame_lbl = record_frame_label ?label i.live (Dbg_alloc dbginfo) in
+      let lbl_after_alloc = new_label () in
+      let lbl_call_gc = new_label () in
+      let n = -bytes in
+      if is_immediate n then
+        `	addi	{emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, {emit_int n}\n`
+      else begin
+        `	li	{emit_reg reg_tmp}, {emit_int n}\n`;
+        `	add	{emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}\n`
+      end;
+      `	bltu	{emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_lim}, {emit_label lbl_call_gc}\n`;
+      `{emit_label lbl_after_alloc}:\n`;
+      `	addi	{emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, {emit_int size_addr}\n`;
+      call_gc_sites :=
+        { gc_lbl = lbl_call_gc;
+          gc_return_lbl = lbl_after_alloc;
+          gc_frame_lbl = lbl_frame_lbl } :: !call_gc_sites
+  | Lop(Iintop(Icomp cmp)) ->
+      begin match cmp with
+      | Isigned Clt ->
+          `	slt	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
+      | Isigned Cge ->
+          `	slt	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+          `	xori	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
+      | Isigned Cgt ->
+          `	slt	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
+      | Isigned Cle ->
+          `	slt	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
+          `	xori	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
+      | Isigned Ceq | Iunsigned Ceq ->
+          `	sub	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+          `	seqz	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
+      | Isigned Cne | Iunsigned Cne ->
+          `	sub	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+          `	snez	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
+      | Iunsigned Clt ->
+          `	sltu	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
+      | Iunsigned Cge ->
+          `	sltu	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+          `	xori	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
+      | Iunsigned Cgt ->
+          `	sltu	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
+      | Iunsigned Cle ->
+          `	sltu	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
+          `	xori	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
+      end
+  | Lop(Iintop (Icheckbound {label_after_error = label; _})) ->
+      let lbl = bound_error_label ?label i.dbg in
+      `	bleu	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n`
+  | Lop(Iintop op) ->
+      let instr = name_for_intop op in
+      `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
+  | Lop(Iintop_imm(Isub, n)) ->
+      `	addi	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int(-n)}\n`
+  | Lop(Iintop_imm(Icomp _, _)) ->
+      Misc.fatal_error "Emit.emit_instr (Iintop_imm (Icomp _, _))"
+  | Lop(Iintop_imm(Icheckbound {label_after_error = label; _}, n)) ->
+      let lbl = bound_error_label ?label i.dbg in
+      `	li	{emit_reg reg_tmp}, {emit_int n}\n`;
+      `	bleu	{emit_reg i.arg.(0)}, {emit_reg reg_tmp}, {emit_label lbl}\n`
+  | Lop(Iintop_imm(op, n)) ->
+      let instr = name_for_intop_imm op in
+      `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n`
+  | Lop(Inegf | Iabsf as op) ->
+      let instr = name_for_floatop1 op in
+      `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
+  | Lop(Iaddf | Isubf | Imulf | Idivf as op) ->
+      let instr = name_for_floatop2 op in
+      `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
+  | Lop(Ifloatofint) ->
+      `	fcvt.d.l	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
+  | Lop(Iintoffloat) ->
+      `	fcvt.l.d	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, rtz\n`
+  | Lop(Ispecific sop) ->
+      let instr = name_for_specific sop in
+      `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`
+  | Lop (Iname_for_debugger _) ->
+      ()
+  | Lreloadretaddr ->
+      let n = frame_size () in
+      reload_ra n
+  | Lreturn ->
+      let n = frame_size() in
+      emit_stack_adjustment n;
+      `	ret\n`
+  | Llabel lbl ->
+      `{emit_label lbl}:\n`
+  | Lbranch lbl ->
+      `	j	{emit_label lbl}\n`
+  | Lcondbranch(tst, lbl) ->
+      begin match tst with
+      | Itruetest ->
+          `	bnez	{emit_reg i.arg.(0)}, {emit_label lbl}\n`
+      | Ifalsetest ->
+          `	beqz	{emit_reg i.arg.(0)}, {emit_label lbl}\n`
+      | Iinttest cmp ->
+          let name = match cmp with
+            | Iunsigned Ceq | Isigned Ceq -> "beq"
+            | Iunsigned Cne | Isigned Cne -> "bne"
+            | Iunsigned Cle -> "bleu" | Isigned Cle -> "ble"
+            | Iunsigned Cge -> "bgeu" | Isigned Cge -> "bge"
+            | Iunsigned Clt -> "bltu" | Isigned Clt -> "blt"
+            | Iunsigned Cgt -> "bgtu" | Isigned Cgt -> "bgt"
+          in
+          `	{emit_string name}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n`
+      | Iinttest_imm _ ->
+          Misc.fatal_error "Emit.emit_instr (Iinttest_imm _)"
+      | Ifloattest cmp ->
+          let branch =
+            match cmp with
+            | CFneq | CFnlt | CFngt | CFnle | CFnge -> "beqz"
+            | CFeq | CFlt | CFgt | CFle | CFge -> "bnez"
+          in
+          begin match cmp with
+          | CFeq | CFneq -> `	feq.d	{emit_reg reg_tmp}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
+          | CFlt | CFnlt -> `	flt.d	{emit_reg reg_tmp}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
+          | CFgt | CFngt -> `	flt.d	{emit_reg reg_tmp}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
+          | CFle | CFnle -> `	fle.d	{emit_reg reg_tmp}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
+          | CFge | CFnge -> `	fle.d	{emit_reg reg_tmp}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
+          end;
+          `	{emit_string branch}	{emit_reg reg_tmp}, {emit_label lbl}\n`
+      | Ioddtest ->
+          `	andi	{emit_reg reg_tmp}, {emit_reg i.arg.(0)}, 1\n`;
+          `	bnez	{emit_reg reg_tmp}, {emit_label lbl}\n`
+      | Ieventest ->
+          `	andi	{emit_reg reg_tmp}, {emit_reg i.arg.(0)}, 1\n`;
+          `	beqz	{emit_reg reg_tmp}, {emit_label lbl}\n`
+      end
+  | Lcondbranch3(lbl0, lbl1, lbl2) ->
+      `	addi	{emit_reg reg_tmp}, {emit_reg i.arg.(0)}, -1\n`;
+      begin match lbl0 with
+      | None -> ()
+      | Some lbl -> `	bltz	{emit_reg reg_tmp}, {emit_label lbl}\n`
+      end;
+      begin match lbl1 with
+      | None -> ()
+      | Some lbl -> `	beqz	{emit_reg reg_tmp}, {emit_label lbl}\n`
+      end;
+      begin match lbl2 with
+      | None -> ()
+      | Some lbl -> `	bgtz	{emit_reg reg_tmp}, {emit_label lbl}\n`
+      end
+  | Lswitch jumptbl ->
+      (* t0 is marked as destroyed for this operation *)
+      let lbl = new_label() in
+      `	la	{emit_reg reg_tmp}, {emit_label lbl}\n`;
+      `	slli	t0, {emit_reg i.arg.(0)}, 2\n`;
+      `	add	{emit_reg reg_tmp}, {emit_reg reg_tmp}, t0\n`;
+      `	jr	{emit_reg reg_tmp}\n`;
+      `{emit_label lbl}:\n`;
+      for i = 0 to Array.length jumptbl - 1 do
+        `	j	{emit_label jumptbl.(i)}\n`
+      done
+  | Lentertrap ->
+      ()
+  | Ladjust_trap_depth { delta_traps } ->
+      (* each trap occupes 16 bytes on the stack *)
+      let delta = 16 * delta_traps in
+      stack_offset := !stack_offset + delta
+  | Lpushtrap {lbl_handler} ->
+      `	la	{emit_reg reg_tmp}, {emit_label lbl_handler}\n`;
+      `	addi	sp, sp, -16\n`;
+      stack_offset := !stack_offset + 16;
+      emit_store reg_tmp size_addr;
+      emit_store reg_trap 0;
+      `	mv	{emit_reg reg_trap}, sp\n`
+  | Lpoptrap ->
+      emit_load reg_trap 0;
+      `	addi	sp, sp, 16\n`;
+      stack_offset := !stack_offset - 16
+  | Lraise k ->
+      begin match k with
+      | Lambda.Raise_regular ->
+          let offset = Domainstate.(idx_of_field Domain_backtrace_pos) * 8 in
+          `	sd zero, {emit_int offset}({emit_reg reg_domain_state_ptr})\n`;
+          `	{emit_call "caml_raise_exn"}\n`;
+          record_frame Reg.Set.empty (Dbg_raise i.dbg)
+      | Lambda.Raise_reraise ->
+          `	{emit_call "caml_raise_exn"}\n`;
+          record_frame Reg.Set.empty (Dbg_raise i.dbg)
+      | Lambda.Raise_notrace ->
+          `	mv	sp, {emit_reg reg_trap}\n`;
+	  emit_load reg_tmp size_addr;
+	  emit_load reg_trap 0;
+          `	addi	sp, sp, 16\n`;
+          `	jr	{emit_reg reg_tmp}\n`
+      end
+
+(* Emit a sequence of instructions *)
+
+let rec emit_all = function
+  | {desc = Lend} -> () | i -> emit_instr i; emit_all i.next
+
+(* Emission of a function declaration *)
+
+let fundecl fundecl =
+  function_name := fundecl.fun_name;
+  tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
+  stack_offset := 0;
+  call_gc_sites := [];
+  bound_error_sites := [];
+  for i = 0 to Proc.num_register_classes - 1 do
+    num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
+  done;
+  prologue_required := fundecl.fun_prologue_required;
+  contains_calls := fundecl.fun_contains_calls;
+  float_literals := [];
+  `	.globl	{emit_symbol fundecl.fun_name}\n`;
+  `	.type	{emit_symbol fundecl.fun_name}, @function\n`;
+  `	{emit_string code_space}\n`;
+  `	.align	2\n`;
+  `{emit_symbol fundecl.fun_name}:\n`;
+  emit_debug_info fundecl.fun_dbg;
+  emit_all fundecl.fun_body;
+  List.iter emit_call_gc !call_gc_sites;
+  List.iter emit_call_bound_error !bound_error_sites;
+  `	.size	{emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`;
+  (* Emit the float literals *)
+  if !float_literals <> [] then begin
+    `	{emit_string rodata_space}\n`;
+    `	.align	3\n`;
+    List.iter
+      (fun (f, lbl) ->
+        `{emit_label lbl}:\n`;
+        emit_float64_directive ".quad" f)
+      !float_literals;
+  end
+
+(* Emission of data *)
+
+let declare_global_data s =
+  `	.globl	{emit_symbol s}\n`;
+  `	.type	{emit_symbol s}, @object\n`
+
+let emit_item = function
+  | Cglobal_symbol s ->
+      declare_global_data s
+  | Cdefine_symbol s ->
+      `{emit_symbol s}:\n`;
+  | Cint8 n ->
+      `	.byte	{emit_int n}\n`
+  | Cint16 n ->
+      `	.short	{emit_int n}\n`
+  | Cint32 n ->
+      `	.long	{emit_nativeint n}\n`
+  | Cint n ->
+      `	.quad	{emit_nativeint n}\n`
+  | Csingle f ->
+      emit_float32_directive ".long" (Int32.bits_of_float f)
+  | Cdouble f ->
+      emit_float64_directive ".quad" (Int64.bits_of_float f)
+  | Csymbol_address s ->
+      `	.quad	{emit_symbol s}\n`
+  | Cstring s ->
+      emit_bytes_directive "	.byte	" s
+  | Cskip n ->
+      if n > 0 then `	.space	{emit_int n}\n`
+  | Calign n ->
+      `	.align	{emit_int (Misc.log2 n)}\n`
+
+let data l =
+  `	{emit_string data_space}\n`;
+  List.iter emit_item l
+
+(* Beginning / end of an assembly file *)
+
+let begin_assembly() =
+  if !Clflags.dlcode || !Clflags.pic_code then `	.option pic\n`;
+  `	.file \"\"\n`; (* PR#7073 *)
+  reset_debug_info ();
+  (* Emit the beginning of the segments *)
+  let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
+  `	{emit_string data_space}\n`;
+  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`;
+  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
+  declare_global_data lbl_end;
+  `{emit_symbol lbl_end}:\n`;
+  `	.long	0\n`;
+  `	{emit_string data_space}\n`;
+  let lbl_end = Compilenv.make_symbol (Some "data_end") in
+  declare_global_data lbl_end;
+  `	.quad	0\n`; (* PR#6329 *)
+  `{emit_symbol lbl_end}:\n`;
+  `	.quad	0\n`;
+  (* Emit the frame descriptors *)
+  `	{emit_string rodata_space}\n`;
+  let lbl = Compilenv.make_symbol (Some "frametable") in
+  declare_global_data lbl;
+  `{emit_symbol lbl}:\n`;
+  emit_frames
+    { efa_code_label = (fun l -> `	.quad	{emit_label l}\n`);
+      efa_data_label = (fun l -> `	.quad	{emit_label l}\n`);
+      efa_8 = (fun n -> `	.byte	{emit_int n}\n`);
+      efa_16 = (fun n -> `	.short	{emit_int n}\n`);
+      efa_32 = (fun n -> `	.long	{emit_int32 n}\n`);
+      efa_word = (fun n -> `	.quad	{emit_int n}\n`);
+      efa_align = (fun n -> `	.align	{emit_int (Misc.log2 n)}\n`);
+      efa_label_rel = (fun lbl ofs ->
+                           `	.long	({emit_label lbl} - .) + {emit_int32 ofs}\n`);
+      efa_def_label = (fun l -> `{emit_label l}:\n`);
+      efa_string = (fun s -> emit_bytes_directive "	.byte	" (s ^ "\000"))
+     }
diff --git a/asmcomp/riscv/proc.ml b/asmcomp/riscv/proc.ml
new file mode 100644
index 00000000..4c7b5861
--- /dev/null
+++ b/asmcomp/riscv/proc.ml
@@ -0,0 +1,337 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Nicolas Ojeda Bar                  *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Description of the RISC-V *)
+
+open Misc
+open Cmm
+open Reg
+open Arch
+open Mach
+
+(* Instruction selection *)
+
+let word_addressed = false
+
+(* Registers available for register allocation *)
+
+(* Integer register map
+   --------------------
+
+    zero                   always zero
+    ra                     return address
+    sp, gp, tp             stack pointer, global pointer, thread pointer
+    a0-a7        0-7       arguments/results
+    s2-s9        8-15      arguments/results (preserved by C)
+    t2-t6        16-20     temporary
+    t0-t1        21-22     temporary (used by code generator)
+    s0           23        domain pointer (preserved by C)
+    s1           24        trap pointer (preserved by C)
+    s10          25        allocation pointer (preserved by C)
+    s11          26        allocation limit (preserved by C)
+
+  Floating-point register map
+  ---------------------------
+
+    ft0-ft7    100-107     temporary
+    fs0-fs1    108-109     general purpose (preserved by C)
+    fa0-fa7    110-117     arguments/results
+    fs2-fs9    118-125     arguments/results (preserved by C)
+    fs10-fs11  126-127     general purpose (preserved by C)
+    ft8-ft11   128-131     temporary
+
+  Additional notes
+  ----------------
+
+    - t0-t1 are used by the assembler and code generator, so
+      not available for register allocation.
+
+    - t0-t6 may be used by PLT stubs, so should not be used to pass
+      arguments and may be clobbered by [Ialloc] in the presence of dynamic
+      linking.
+*)
+
+let int_reg_name =
+  [| "a0"; "a1"; "a2"; "a3"; "a4"; "a5"; "a6"; "a7";
+     "s2"; "s3"; "s4"; "s5"; "s6"; "s7"; "s8"; "s9";
+     "t2"; "t3"; "t4"; "t5"; "t6";
+     "t0"; "t1";
+     "s0"; "s1"; "s10"; "s11" |]
+
+let float_reg_name =
+  [| "ft0"; "ft1"; "ft2"; "ft3"; "ft4"; "ft5"; "ft6"; "ft7";
+     "fs0"; "fs1";
+     "fa0"; "fa1"; "fa2"; "fa3"; "fa4"; "fa5"; "fa6"; "fa7";
+     "fs2"; "fs3"; "fs4"; "fs5"; "fs6"; "fs7"; "fs8"; "fs9"; "fs10"; "fs11";
+     "ft8"; "ft9"; "ft10"; "ft11" |]
+
+let num_register_classes = 2
+
+let register_class r =
+  match r.typ with
+  | Val | Int | Addr -> 0
+  | Float -> 1
+
+let num_available_registers = [| 22; 32 |]
+
+let first_available_register = [| 0; 100 |]
+
+let register_name r =
+  if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100)
+
+let rotate_registers = true
+
+(* Representation of hard registers by pseudo-registers *)
+
+let hard_int_reg =
+  let v = Array.make 27 Reg.dummy in
+  for i = 0 to 26 do
+    v.(i) <- Reg.at_location Int (Reg i)
+  done;
+  v
+
+let hard_float_reg =
+  let v = Array.make 32 Reg.dummy in
+  for i = 0 to 31 do
+    v.(i) <- Reg.at_location Float (Reg(100 + i))
+  done;
+  v
+
+let all_phys_regs =
+  Array.append hard_int_reg hard_float_reg
+
+let phys_reg n =
+  if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
+
+let stack_slot slot ty =
+  Reg.at_location ty (Stack slot)
+
+(* Calling conventions *)
+
+let calling_conventions
+    first_int last_int first_float last_float make_stack arg =
+  let loc = Array.make (Array.length arg) Reg.dummy in
+  let int = ref first_int in
+  let float = ref first_float in
+  let ofs = ref 0 in
+  for i = 0 to Array.length arg - 1 do
+    match arg.(i).typ with
+    | Val | Int | Addr as ty ->
+        if !int <= last_int then begin
+          loc.(i) <- phys_reg !int;
+          incr int
+        end else begin
+          loc.(i) <- stack_slot (make_stack !ofs) ty;
+          ofs := !ofs + size_int
+        end
+    | Float ->
+        if !float <= last_float then begin
+          loc.(i) <- phys_reg !float;
+          incr float
+        end else begin
+          loc.(i) <- stack_slot (make_stack !ofs) Float;
+          ofs := !ofs + size_float
+        end
+  done;
+  (loc, Misc.align !ofs 16) (* Keep stack 16-aligned. *)
+
+let incoming ofs = Incoming ofs
+let outgoing ofs = Outgoing ofs
+let not_supported _ = fatal_error "Proc.loc_results: cannot call"
+
+let max_arguments_for_tailcalls = 16
+
+let loc_spacetime_node_hole = Reg.dummy  (* Spacetime unsupported *)
+
+(* OCaml calling convention:
+     first integer args in a0 .. a7, s2 .. s9
+     first float args in fa0 .. fa7, fs2 .. fs9
+     remaining args on stack.
+   Return values in a0 .. a7, s2 .. s9 or fa0 .. fa7, fs2 .. fs9. *)
+
+let single_regs arg = Array.map (fun arg -> [| arg |]) arg
+let ensure_single_regs res =
+  Array.map (function
+      | [| res |] -> res
+      | _ -> failwith "proc.ensure_single_regs"
+    ) res
+
+let loc_arguments arg =
+  calling_conventions 0 15 110 125 outgoing arg
+
+let loc_parameters arg =
+  let (loc, _ofs) =
+    calling_conventions 0 15 110 125 incoming arg
+  in
+  loc
+
+let loc_results res =
+  let (loc, _ofs) =
+    calling_conventions 0 15 110 125 not_supported res
+  in
+  loc
+
+(* C calling convention:
+     first integer args in a0 .. a7
+     first float args in fa0 .. fa7
+     remaining args on stack.
+   A FP argument can be passed in an integer register if all FP registers
+   are exhausted but integer registers remain.
+   Return values in a0 .. a1 or fa0 .. fa1. *)
+
+let external_calling_conventions
+    first_int last_int first_float last_float make_stack arg =
+  let loc = Array.make (Array.length arg) [| Reg.dummy |] in
+  let int = ref first_int in
+  let float = ref first_float in
+  let ofs = ref 0 in
+  for i = 0 to Array.length arg - 1 do
+    match arg.(i) with
+    | [| arg |] ->
+        begin match arg.typ with
+        | Val | Int | Addr as ty ->
+            if !int <= last_int then begin
+              loc.(i) <- [| phys_reg !int |];
+              incr int
+            end else begin
+              loc.(i) <- [| stack_slot (make_stack !ofs) ty |];
+              ofs := !ofs + size_int
+            end
+        | Float ->
+            if !float <= last_float then begin
+              loc.(i) <- [| phys_reg !float |];
+              incr float
+            end else if !int <= last_int then begin
+              loc.(i) <- [| phys_reg !int |];
+              incr int
+            end else begin
+              loc.(i) <- [| stack_slot (make_stack !ofs) Float |];
+              ofs := !ofs + size_float
+            end
+        end
+    | _ ->
+        fatal_error "Proc.calling_conventions: bad number of register for \
+                     multi-register argument"
+  done;
+  (loc, Misc.align !ofs 16) (* Keep stack 16-aligned. *)
+
+let loc_external_arguments arg =
+  external_calling_conventions 0 7 110 117 outgoing arg
+
+let loc_external_results res =
+  let (loc, _ofs) =
+    external_calling_conventions 0 1 110 111 not_supported (single_regs res)
+  in
+  ensure_single_regs loc
+
+(* Exceptions are in a0 *)
+
+let loc_exn_bucket = phys_reg 0
+
+(* Volatile registers: none *)
+
+let regs_are_volatile _ = false
+
+(* Registers destroyed by operations *)
+
+let destroyed_at_c_call =
+  (* s0-s11 and fs0-fs11 are callee-save *)
+  Array.of_list(List.map phys_reg
+    [0; 1; 2; 3; 4; 5; 6; 7; 16; 17; 18; 19; 20; 21;
+     100; 101; 102; 103; 104; 105; 106; 107; 110; 111; 112; 113; 114; 115; 116;
+     117; 128; 129; 130; 131])
+
+let destroyed_at_alloc =
+  (* t0-t3 are used for PLT stubs *)
+  if !Clflags.dlcode then Array.map phys_reg [|16; 17; 18; 19; 20; 21|]
+  else [| |]
+
+let destroyed_at_oper = function
+  | Iop(Icall_ind _ | Icall_imm _ | Iextcall{alloc = true; _}) -> all_phys_regs
+  | Iop(Iextcall{alloc = false; _}) -> destroyed_at_c_call
+  | Iop(Ialloc _) -> destroyed_at_alloc
+  | Iop(Istore(Single, _, _)) -> [| phys_reg 100 |]
+  | Iswitch _ -> [| phys_reg 21 |]
+  | _ -> [||]
+
+let destroyed_at_raise = all_phys_regs
+
+let destroyed_at_reloadretaddr = [| |]
+
+(* Maximal register pressure *)
+
+let safe_register_pressure = function
+  | Iextcall _ -> 15
+  | _ -> 22
+
+let max_register_pressure = function
+  | Iextcall _ -> [| 15; 18 |]
+  | _ -> [| 22; 30 |]
+
+(* Pure operations (without any side effect besides updating their result
+   registers). *)
+
+let op_is_pure = function
+  | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
+  | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false
+  | Ispecific(Imultaddf _ | Imultsubf _) -> true
+  | _ -> true
+
+(* Layout of the stack *)
+
+let frame_required fd =
+  fd.fun_contains_calls
+  || fd.fun_num_stack_slots.(0) > 0
+  || fd.fun_num_stack_slots.(1) > 0
+
+let prologue_required fd =
+  frame_required fd
+
+(* See
+   https://github.com/riscv/riscv-elf-psabi-doc/blob/master/riscv-elf.md *)
+
+let int_dwarf_reg_numbers =
+  [| 10; 11; 12; 13; 14; 15; 16; 17;
+     18; 19; 20; 21; 22; 23; 24; 25;
+     7; 28; 29; 30; 31;
+     5; 6;
+     8; 9; 26; 27;
+  |]
+
+let float_dwarf_reg_numbers =
+  [| 32; 33; 34; 35; 36; 37; 38; 39;
+     40; 41;
+     42; 43; 44; 45; 46; 47; 48; 49;
+     50; 51; 52; 53; 54; 55; 56; 57;
+     58; 59;
+     60; 61; 62; 63;
+  |]
+
+let dwarf_register_numbers ~reg_class =
+  match reg_class with
+  | 0 -> int_dwarf_reg_numbers
+  | 1 -> float_dwarf_reg_numbers
+  | _ -> Misc.fatal_errorf "Bad register class %d" reg_class
+
+let stack_ptr_dwarf_register_number = 2
+
+(* Calling the assembler *)
+
+let assemble_file infile outfile =
+  Ccomp.command
+    (Config.asm ^ " -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile)
+
+let init () = ()
diff --git a/asmcomp/riscv/reload.ml b/asmcomp/riscv/reload.ml
new file mode 100644
index 00000000..be18cbd7
--- /dev/null
+++ b/asmcomp/riscv/reload.ml
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Nicolas Ojeda Bar                  *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Reloading for the RISC-V *)
+
+let fundecl f =
+  (new Reloadgen.reload_generic)#fundecl f
diff --git a/asmcomp/riscv/scheduling.ml b/asmcomp/riscv/scheduling.ml
new file mode 100644
index 00000000..e56b723c
--- /dev/null
+++ b/asmcomp/riscv/scheduling.ml
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Nicolas Ojeda Bar                  *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Instruction scheduling for the RISC-V *)
+
+open! Schedgen (* to create a dependency *)
+
+(* Scheduling is turned off. *)
+
+let fundecl f = f
diff --git a/asmcomp/riscv/selection.ml b/asmcomp/riscv/selection.ml
new file mode 100644
index 00000000..87d3355d
--- /dev/null
+++ b/asmcomp/riscv/selection.ml
@@ -0,0 +1,75 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Nicolas Ojeda Bar                  *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Instruction selection for the RISC-V processor *)
+
+open Cmm
+open Arch
+open Mach
+
+(* Instruction selection *)
+
+class selector = object (self)
+
+inherit Selectgen.selector_generic as super
+
+method is_immediate n = is_immediate n
+
+method select_addressing _ = function
+  | Cop(Cadda, [arg; Cconst_int (n, _)], _) when self#is_immediate n ->
+      (Iindexed n, arg)
+  | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int (n, _)], _)], dbg)
+    when self#is_immediate n ->
+      (Iindexed n, Cop(Caddi, [arg1; arg2], dbg))
+  | arg ->
+      (Iindexed 0, arg)
+
+method! select_operation op args dbg =
+  match (op, args) with
+  (* Recognize (neg-)mult-add and (neg-)mult-sub instructions *)
+  | (Caddf, [Cop(Cmulf, [arg1; arg2], _); arg3])
+  | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2], _)]) ->
+      (Ispecific (Imultaddf false), [arg1; arg2; arg3])
+  | (Csubf, [Cop(Cmulf, [arg1; arg2], _); arg3]) ->
+      (Ispecific (Imultsubf false), [arg1; arg2; arg3])
+  | (Cnegf, [Cop(Csubf, [Cop(Cmulf, [arg1; arg2], _); arg3], _)]) ->
+      (Ispecific (Imultsubf true), [arg1; arg2; arg3])
+  | (Cnegf, [Cop(Caddf, [Cop(Cmulf, [arg1; arg2], _); arg3], _)]) ->
+      (Ispecific (Imultaddf true), [arg1; arg2; arg3])
+  (* RISC-V does not support immediate operands for comparison operators *)
+  | (Ccmpi comp, args) -> (Iintop(Icomp (Isigned comp)), args)
+  | (Ccmpa comp, args) -> (Iintop(Icomp (Iunsigned comp)), args)
+  (* RISC-V does not support immediate operands for multiply/multiply high *)
+  | (Cmuli, _) -> (Iintop Imul, args)
+  | (Cmulhi, _) -> (Iintop Imulh, args)
+  | _ ->
+      super#select_operation op args dbg
+
+(* Instruction selection for conditionals *)
+
+method! select_condition = function
+    Cop(Ccmpi cmp, args, _) ->
+      (Iinttest(Isigned cmp), Ctuple args)
+  | Cop(Ccmpa cmp, args, _) ->
+      (Iinttest(Iunsigned cmp), Ctuple args)
+  | Cop(Ccmpf cmp, args, _) ->
+      (Ifloattest cmp, Ctuple args)
+  | Cop(Cand, [arg; Cconst_int (1, _)], _) ->
+      (Ioddtest, arg)
+  | arg ->
+      (Itruetest, arg)
+end
+
+let fundecl f = (new selector)#emit_fundecl f
diff --git a/asmcomp/s390x/CSE.ml b/asmcomp/s390x/CSE.ml
new file mode 100644
index 00000000..360a4f13
--- /dev/null
+++ b/asmcomp/s390x/CSE.ml
@@ -0,0 +1,42 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt            *)
+(*                          Bill O'Farrell, IBM                           *)
+(*                                                                        *)
+(*   Copyright 2015 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2015 IBM (Bill O'Farrell with help from Tristan Amini).    *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* CSE for the Z Processor *)
+
+open Arch
+open Mach
+open CSEgen
+
+class cse = object
+
+inherit cse_generic as super
+
+method! class_of_operation op =
+  match op with
+  | Ispecific(Imultaddf | Imultsubf) -> Op_pure
+  | _ -> super#class_of_operation op
+
+method! is_cheap_operation op =
+  match op with
+  | Iconst_int n ->
+      n >= -0x8000_0000n && n <= 0x7FFF_FFFFn
+  | _ -> false
+
+end
+
+let fundecl f =
+  (new cse)#fundecl f
diff --git a/asmcomp/s390x/NOTES.md b/asmcomp/s390x/NOTES.md
new file mode 100644
index 00000000..679e77f2
--- /dev/null
+++ b/asmcomp/s390x/NOTES.md
@@ -0,0 +1,16 @@
+# Supported platforms
+
+IBM z Systems version 10 and up, in 64-bit flat addressing mode,
+running Linux (Debian architecture: `s390x`).
+
+# Reference documents
+
+* Instruction set architecture:
+   _z/Architecture Principles of Operation_,
+   SA22-7832-07, eight edition (Feb 2009).
+   This is the version that corresponds to z10.
+   Newer versions of this manual include additional instructions
+   that are not in z10.
+* ELF ABI:
+   _zSeries ELF Application Binary Interface Supplement_
+   (http://refspecs.linuxfoundation.org/ELF/zSeries/index.html)
diff --git a/asmcomp/s390x/arch.ml b/asmcomp/s390x/arch.ml
new file mode 100644
index 00000000..84d52d64
--- /dev/null
+++ b/asmcomp/s390x/arch.ml
@@ -0,0 +1,91 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt            *)
+(*                          Bill O'Farrell, IBM                           *)
+(*                                                                        *)
+(*   Copyright 2015 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2015 IBM (Bill O'Farrell with help from Tristan Amini).    *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Specific operations for the Z processor *)
+
+open Format
+
+(* Machine-specific command-line options *)
+
+let pic_code = ref true
+
+let command_line_options =
+  [ "-fPIC", Arg.Set pic_code,
+      " Generate position-independent machine code (default)";
+    "-fno-PIC", Arg.Clear pic_code,
+      " Generate position-dependent machine code" ]
+
+(* Specific operations *)
+
+type specific_operation =
+    Imultaddf                           (* multiply and add *)
+  | Imultsubf                           (* multiply and subtract *)
+
+let spacetime_node_hole_pointer_is_live_before _specific_op = false
+
+(* Addressing modes *)
+
+type addressing_mode =
+  | Iindexed of int                     (* reg + displ *)
+  | Iindexed2 of int                    (* reg + reg + displ *)
+
+(* Sizes, endianness *)
+
+let big_endian = true
+
+let size_addr = 8
+let size_int = size_addr
+let size_float = 8
+
+let allow_unaligned_access = false
+
+(* Behavior of division *)
+
+let division_crashes_on_overflow = true
+
+(* Operations on addressing modes *)
+
+let identity_addressing = Iindexed 0
+
+let offset_addressing addr delta =
+  match addr with
+  | 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 =
+  match addr with
+  | Iindexed n ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a%s" printreg arg.(0) idx
+  | Iindexed2 n ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a + %a%s" printreg arg.(0) printreg arg.(1) idx
+
+let print_specific_operation printreg op ppf arg =
+  match op with
+  | Imultaddf ->
+      fprintf ppf "%a *f %a +f %a"
+        printreg arg.(0) printreg arg.(1) printreg arg.(2)
+  | Imultsubf ->
+      fprintf ppf "%a *f %a -f %a"
+        printreg arg.(0) printreg arg.(1) printreg arg.(2)
diff --git a/asmcomp/s390x/emit.mlp b/asmcomp/s390x/emit.mlp
new file mode 100644
index 00000000..419c43f3
--- /dev/null
+++ b/asmcomp/s390x/emit.mlp
@@ -0,0 +1,795 @@
+#2 "asmcomp/s390x/emit.mlp"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Emission of Linux on Z 64-bit assembly code *)
+
+open Misc
+open Cmm
+open Arch
+open Proc
+open Reg
+open Mach
+open Linear
+open Emitaux
+
+(* Layout of the stack.  The stack is kept 8-aligned. *)
+
+let stack_offset = ref 0
+
+let num_stack_slots = Array.make Proc.num_register_classes 0
+
+let prologue_required = ref false
+
+let contains_calls = ref false
+
+let frame_size () =
+  let size =
+    !stack_offset +                     (* Trap frame, outgoing parameters *)
+    size_int * num_stack_slots.(0) +    (* Local int variables *)
+    size_float * num_stack_slots.(1) +  (* Local float variables *)
+    (if !contains_calls then size_addr else 0) in (* The return address *)
+  Misc.align size 8
+
+let slot_offset loc cls =
+  match loc with
+    Local n ->
+      if cls = 0
+      then !stack_offset + num_stack_slots.(1) * size_float + n * size_int
+      else !stack_offset + n * size_float
+  | Incoming n -> frame_size() + n
+  | Outgoing n -> n
+
+(* Output a symbol *)
+
+let emit_symbol s = Emitaux.emit_symbol '.' s
+
+(* Output function call *)
+
+let emit_call s =
+  if !pic_code then
+   `	brasl	%r14, {emit_symbol s}@PLT\n`
+  else
+   `	brasl	%r14, {emit_symbol s}\n`
+
+(* Output a label *)
+
+let label_prefix = ".L"
+
+let emit_label lbl =
+  emit_string label_prefix; emit_int lbl
+
+(* Section switching *)
+
+let data_space = "	.section \".data\"\n"
+
+let code_space = "	.section \".text\"\n"
+
+let rodata_space = "	.section \".rodata\"\n"
+
+(* Output a pseudo-register *)
+
+let emit_reg r =
+  match r.loc with
+  | Reg r -> emit_string (register_name r)
+  | _ -> fatal_error "Emit.emit_reg"
+
+
+(* Special registers *)
+
+let check_phys_reg reg_idx name =
+  let reg = phys_reg reg_idx in
+  assert (register_name reg_idx = name);
+  reg
+
+let reg_f15 = check_phys_reg 115 "%f15"
+let reg_r7 = check_phys_reg 5 "%r7"
+
+(* Output a stack reference *)
+
+let emit_stack r =
+  match r.loc with
+    Stack s ->
+      let ofs = slot_offset s (register_class r) in `{emit_int ofs}(%r15)`
+  | _ -> fatal_error "Emit.emit_stack"
+
+
+(* Output a load of the address of a global symbol *)
+
+let emit_load_symbol_addr reg s =
+  if !pic_code then
+  `	lgrl	{emit_reg reg}, {emit_symbol s}@GOTENT\n`
+  else
+  `	larl	{emit_reg reg}, {emit_symbol s}\n`
+
+(* Output a load or store operation *)
+
+let emit_load_store instr addressing_mode addr n arg =
+  match addressing_mode with
+  | Iindexed ofs ->
+      `	{emit_string instr}	{emit_reg arg}, {emit_int ofs}({emit_reg addr.(n)})\n`
+  | Iindexed2 ofs ->
+      `	{emit_string instr}	{emit_reg arg}, {emit_int ofs}({emit_reg addr.(n)},{emit_reg addr.(n+1)})\n`
+
+(* Adjust the stack pointer down by N.
+   Choose the shortest instruction possible for the value of N. *)
+
+let emit_stack_adjust n =
+  let n = -n in
+  if n = 0 then ()
+  else if n >= 0 && n < 4096 then
+    `	la	%r15, {emit_int n}(%r15)\n`
+  else if n >= -0x80000 && n < 0x80000 then
+    `	lay	%r15, {emit_int n}(%r15)\n`
+  else
+    `	agfi	%r15, {emit_int n}\n`
+
+(* Emit a 'add immediate' *)
+
+let emit_addimm res arg n =
+  if n >= 0 && n < 4096 then
+    `	la	{emit_reg res}, {emit_int n}({emit_reg arg})\n`
+  else if n >= -0x80000 && n < 0x80000 then
+    `	lay	{emit_reg res}, {emit_int n}({emit_reg arg})\n`
+  else begin
+    if arg.loc <> res.loc then
+      `	lgr	{emit_reg res}, {emit_reg arg}\n`;
+    `	agfi	{emit_reg res}, {emit_int n}\n`
+  end
+
+(* After a comparison, extract the result as 0 or 1 *)
+(* The locgr instruction is not available in the z10 architecture,
+   so this code is currently unused. *)
+(*
+let emit_set_comp cmp res =
+    `	lghi	%r1, 1\n`;
+    `	lghi	{emit_reg res}, 0\n`;
+  begin match cmp with
+      Ceq -> `	locgre	{emit_reg res}, %r1\n`
+    | Cne -> `	locgrne	{emit_reg res}, %r1\n`
+    | Cgt -> `	locgrh	{emit_reg res}, %r1\n`
+    | Cle -> `	locgrnh	{emit_reg res}, %r1\n`
+    | Clt -> `	locgrl	{emit_reg res}, %r1\n`
+    | Cge -> `	locgrnl	{emit_reg res}, %r1\n`
+  end
+*)
+
+(* Record live pointers at call points *)
+
+let record_frame_label ?label live dbg =
+  let lbl =
+    match label with
+    | None -> new_label()
+    | Some label -> label
+  in
+  let live_offset = ref [] in
+  Reg.Set.iter
+    (function
+      | {typ = Val; loc = Reg r} ->
+          live_offset := (r lsl 1) + 1 :: !live_offset
+      | {typ = Val; loc = Stack s} as reg ->
+          live_offset := slot_offset s (register_class reg) :: !live_offset
+      | {typ = Addr} as r ->
+          Misc.fatal_error ("bad GC root " ^ Reg.name r)
+      | _ -> ())
+    live;
+  record_frame_descr ~label:lbl ~frame_size:(frame_size())
+    ~live_offset:!live_offset dbg;
+  lbl
+
+let record_frame ?label live dbg =
+  let lbl = record_frame_label ?label live dbg in
+  `{emit_label lbl}:`
+
+(* Record calls to caml_call_gc, emitted out of line. *)
+
+type gc_call =
+  { gc_lbl: label;                      (* Entry label *)
+    gc_return_lbl: label;               (* Where to branch after GC *)
+    gc_frame_lbl: label }               (* Label of frame descriptor *)
+
+let call_gc_sites = ref ([] : gc_call list)
+
+let emit_call_gc gc =
+  `{emit_label gc.gc_lbl}:`; emit_call "caml_call_gc";
+  `{emit_label gc.gc_frame_lbl}:	brcl	15, {emit_label gc.gc_return_lbl}\n`
+
+(* Record calls to caml_ml_array_bound_error, emitted out of line. *)
+
+type bound_error_call =
+  { bd_lbl: label;                      (* Entry label *)
+    bd_frame: label }                   (* Label of frame descriptor *)
+
+let bound_error_sites = ref ([] : bound_error_call list)
+let bound_error_call = ref 0
+
+let bound_error_label ?label dbg =
+  if !Clflags.debug then begin
+    let lbl_bound_error = new_label() in
+    let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
+    bound_error_sites :=
+     { bd_lbl = lbl_bound_error; bd_frame = lbl_frame } :: !bound_error_sites;
+   lbl_bound_error
+ end else begin
+   if !bound_error_call = 0 then bound_error_call := new_label();
+   !bound_error_call
+ end
+
+let emit_call_bound_error bd =
+  `{emit_label bd.bd_lbl}:`; emit_call "caml_ml_array_bound_error";
+  `{emit_label bd.bd_frame}:\n`
+
+let emit_call_bound_errors () =
+  List.iter emit_call_bound_error !bound_error_sites;
+  if !bound_error_call > 0 then begin
+    `{emit_label !bound_error_call}:`; emit_call "caml_ml_array_bound_error";
+  end
+
+(* Record floating-point and large integer literals *)
+
+let float_literals = ref ([] : (int64 * int) list)
+let int_literals = ref ([] : (nativeint * int) list)
+
+(* Masks for conditional branches after comparisons *)
+
+(* bit 0 = eq, bit 1 = lt, bit 2 = gt, bit 3 = overflow*)
+let branch_for_comparison = function
+  | Ceq -> 0b1000 | Cne -> 0b0111 (* BRNEL is 0111 rather than 0110 *)
+  | Cle -> 0b1100 | Cgt -> 0b0010
+  | Cge -> 0b1010 | Clt -> 0b0100
+
+let name_for_int_comparison = function
+    Isigned cmp -> ("cgr", branch_for_comparison cmp)
+  | Iunsigned cmp -> ("clgr", branch_for_comparison cmp)
+
+let name_for_int_comparison_imm = function
+    Isigned cmp -> ("cgfi", branch_for_comparison cmp)
+  | Iunsigned cmp -> ("clgfi", branch_for_comparison cmp)
+
+(* bit 0 = eq, bit 1 = lt, bit 2 = gt, bit 3 = unordered*)
+let branch_for_float_comparison = function
+  | CFeq  -> 0b1000
+  | CFneq -> 0b0111
+
+  | CFle  -> 0b1100
+  | CFnle -> 0b0011
+
+  | CFgt  -> 0b0010
+  | CFngt -> 0b1101
+
+  | CFge  -> 0b1010
+  | CFnge -> 0b0101
+
+  | CFlt  -> 0b0100
+  | CFnlt -> 0b1011
+
+(* Names for various instructions *)
+
+let name_for_intop = function
+    Iadd  -> "agr"
+  | Isub  -> "sgr"
+  | Imul  -> "msgr"
+  | Iand  -> "ngr"
+  | Ior   -> "ogr"
+  | Ixor  -> "xgr"
+  | _ -> Misc.fatal_error "Emit.Intop"
+
+let name_for_floatop1 = function
+    Inegf -> "lcdbr"
+  | Iabsf -> "lpdbr"
+  | _ -> Misc.fatal_error "Emit.Iopf1"
+
+let name_for_floatop2 = function
+    Iaddf -> "adbr"
+  | Isubf -> "sdbr"
+  | Imulf -> "mdbr"
+  | Idivf -> "ddbr"
+  | _ -> Misc.fatal_error "Emit.Iopf2"
+
+let name_for_specific = function
+    Imultaddf -> "madbr"
+  | Imultsubf -> "msdbr"
+
+(* Name of current function *)
+let function_name = ref ""
+(* Entry point for tail recursive calls *)
+let tailrec_entry_point = ref 0
+
+(* Output the assembly code for an instruction *)
+
+let emit_instr i =
+    emit_debug_info i.dbg;
+    match i.desc with
+      Lend -> ()
+    | Lprologue ->
+      assert (!prologue_required);
+      let n = frame_size() in
+      emit_stack_adjust n;
+      if !contains_calls then
+        `	stg	%r14, {emit_int(n - size_addr)}(%r15)\n`
+    | Lop(Imove | Ispill | Ireload) ->
+        let src = i.arg.(0) and dst = i.res.(0) in
+        if src.loc <> dst.loc then begin
+           match (src, dst) with
+              {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Reg _} ->
+                `	lgr	{emit_reg dst}, {emit_reg src}\n`
+            | {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} ->
+                `	ldr	{emit_reg dst}, {emit_reg src}\n`
+            | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack _} ->
+                `	stg	{emit_reg src}, {emit_stack dst}\n`
+            | {loc = Reg _; typ = Float}, {loc = Stack _} ->
+                `	std	{emit_reg src}, {emit_stack dst}\n`
+            | {loc = Stack _; typ = (Val | Int | Addr)}, {loc = Reg _} ->
+                `	lg	{emit_reg dst}, {emit_stack src}\n`
+            | {loc = Stack _; typ = Float}, {loc = Reg _} ->
+                `	ldy	{emit_reg dst}, {emit_stack src}\n`
+            | (_, _) ->
+                fatal_error "Emit: Imove"
+        end
+    | Lop(Iconst_int n) ->
+        if n >= -0x8000n && n <= 0x7FFFn then begin
+          `	lghi	{emit_reg i.res.(0)}, {emit_nativeint n}\n`;
+        end else if n >= -0x8000_0000n && n <= 0x7FFF_FFFFn then begin
+          `	lgfi	{emit_reg i.res.(0)}, {emit_nativeint n}\n`;
+        end else begin
+          let lbl = new_label() in
+          int_literals := (n, lbl) :: !int_literals;
+          `	lgrl	{emit_reg i.res.(0)}, {emit_label lbl}\n`;
+          end
+    | Lop(Iconst_float f) ->
+        let lbl = new_label() in
+        float_literals := (f, lbl) :: !float_literals;
+        `	larl	%r1, {emit_label lbl}\n`;
+        `	ld	{emit_reg i.res.(0)}, 0(%r1)\n`
+     | Lop(Iconst_symbol s) ->
+        emit_load_symbol_addr i.res.(0) s
+    | Lop(Icall_ind { label_after; }) ->
+        `	basr	%r14, {emit_reg i.arg.(0)}\n`;
+        `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
+
+    | Lop(Icall_imm { func; label_after; }) ->
+        emit_call func;
+        `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
+    | Lop(Itailcall_ind { label_after = _; }) ->
+        let n = frame_size() in
+        if !contains_calls then
+          `	lg	%r14, {emit_int(n - size_addr)}(%r15)\n`;
+        emit_stack_adjust (-n);
+        `	br	{emit_reg i.arg.(0)}\n`
+    | Lop(Itailcall_imm { func; label_after = _; }) ->
+        if func = !function_name then
+          `	brcl	15, {emit_label !tailrec_entry_point}\n`
+        else begin
+          let n = frame_size() in
+          if !contains_calls then
+            `	lg	%r14, {emit_int(n - size_addr)}(%r15)\n`;
+          emit_stack_adjust (-n);
+          if !pic_code then
+            `	brcl	15, {emit_symbol func}@PLT\n`
+          else
+            `	brcl	15, {emit_symbol func}\n`
+        end
+
+     | Lop(Iextcall { func; alloc; label_after; }) ->
+        if not alloc then emit_call func
+        else begin
+          emit_load_symbol_addr reg_r7 func;
+          emit_call "caml_c_call";
+          `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
+        end
+
+     | Lop(Istackoffset n) ->
+        emit_stack_adjust n;
+        stack_offset := !stack_offset + n
+
+     | Lop(Iload(chunk, addr)) ->
+        let loadinstr =
+          match chunk with
+            Byte_unsigned -> "llgc"
+          | Byte_signed -> "lgb"
+          | Sixteen_unsigned -> "llgh"
+          | Sixteen_signed -> "lgh"
+          | Thirtytwo_unsigned -> "llgf"
+          | Thirtytwo_signed -> "lgf"
+          | Word_int | Word_val -> "lg"
+          | Single -> "ley"
+          | Double | Double_u -> "ldy" in
+        emit_load_store loadinstr addr i.arg 0 i.res.(0);
+        if chunk = Single then
+          `	ldebr	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
+
+    | Lop(Istore(Single, addr, _)) ->
+        `	ledbr	%f15, {emit_reg i.arg.(0)}\n`;
+        emit_load_store "stey" addr i.arg 1 reg_f15
+    | Lop(Istore(chunk, addr, _)) ->
+        let storeinstr =
+          match chunk with
+            Byte_unsigned | Byte_signed -> "stcy"
+          | Sixteen_unsigned | Sixteen_signed -> "sthy"
+          | Thirtytwo_unsigned | Thirtytwo_signed -> "sty"
+          | Word_int | Word_val -> "stg"
+          | Single -> assert false
+          | Double | Double_u -> "stdy" in
+        emit_load_store storeinstr addr i.arg 1 i.arg.(0)
+
+    | Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
+        let lbl_after_alloc = new_label() in
+        let lbl_call_gc = new_label() in
+        let lbl_frame =
+          record_frame_label i.live (Dbg_alloc dbginfo) ?label:label_after_call_gc
+        in
+        call_gc_sites :=
+          { gc_lbl = lbl_call_gc;
+            gc_return_lbl = lbl_after_alloc;
+            gc_frame_lbl = lbl_frame } :: !call_gc_sites;
+        `	lay     %r11, {emit_int(-n)}(%r11)\n`;
+        let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
+        `	clg	%r11, {emit_int offset}(%r10)\n`;
+        `	brcl    4, {emit_label lbl_call_gc}\n`;  (* less than *)
+        `{emit_label lbl_after_alloc}:`;
+        `	la      {emit_reg i.res.(0)}, 8(%r11)\n`
+
+    | Lop(Iintop Imulh) ->
+       (* Hacker's Delight section 8.3:
+            mul-high-signed(a, b) = mul-high-unsigned(a, b)
+                                    - a  if b < 0
+                                    - b  if a < 0
+          or, without branches,
+            mul-high-signed(a, b) = mul-high-unsigned(a, b)
+                                    - (a & (b >>s 63))
+                                    - (b & (a >>s 63))
+       *)
+       `	lgr	%r1, {emit_reg i.arg.(0)}\n`;
+       `	mlgr	%r0, {emit_reg i.arg.(1)}\n`;
+         (* r0:r1 is 128-bit unsigned product; r0 is the high bits *)
+       `	srag	%r1, {emit_reg i.arg.(0)}, 63\n`;
+       `	ngr	%r1, {emit_reg i.arg.(1)}\n`;
+       `	sgr	%r0, %r1\n`;
+       `	srag	%r1, {emit_reg i.arg.(1)}, 63\n`;
+       `	ngr	%r1, {emit_reg i.arg.(0)}\n`;
+       `	sgr	%r0, %r1\n`;
+       `	lgr	{emit_reg i.res.(0)}, %r0\n`
+    | Lop(Iintop Imod) ->
+        `	lgr	%r1, {emit_reg i.arg.(0)}\n`;
+        `	dsgr	%r0, {emit_reg i.arg.(1)}\n`;
+        `	lgr	{emit_reg i.res.(0)}, %r0\n`
+    | Lop(Iintop Idiv) ->
+        `	lgr	%r1, {emit_reg i.arg.(0)}\n`;
+        `	dsgr	%r0, {emit_reg i.arg.(1)}\n`;
+        `	lgr	{emit_reg i.res.(0)}, %r1\n`
+    | Lop(Iintop Ilsl) ->
+        `	sllg	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, 0({emit_reg i.arg.(1)})\n`
+    | Lop(Iintop Ilsr) ->
+        `	srlg	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, 0({emit_reg i.arg.(1)})\n`
+    | Lop(Iintop Iasr) ->
+        `	srag	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, 0({emit_reg i.arg.(1)})\n`
+    | Lop(Iintop(Icomp cmp)) ->
+        let lbl = new_label() in
+        let (comp, mask) = name_for_int_comparison cmp in
+        `	{emit_string comp}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+        `	lghi	{emit_reg i.res.(0)}, 1\n`;
+        `	brc	{emit_int mask}, {emit_label lbl}\n`;
+        `	lghi	{emit_reg i.res.(0)}, 0\n`;
+        `{emit_label lbl}:\n`
+    | Lop(Iintop (Icheckbound { label_after_error; })) ->
+        let lbl = bound_error_label i.dbg ?label:label_after_error in
+        `	clgr	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+        `	brcl	12, {emit_label lbl}\n`  (* branch if unsigned le *)
+    | Lop(Iintop op) ->
+        assert (i.arg.(0).loc = i.res.(0).loc);
+        let instr = name_for_intop op in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}\n`
+    | Lop(Iintop_imm(Iadd, n)) ->
+        emit_addimm i.res.(0) i.arg.(0) n
+    | Lop(Iintop_imm(Isub, n)) ->
+        emit_addimm i.res.(0) i.arg.(0) (-n)
+    | Lop(Iintop_imm(Icomp cmp, n)) ->
+        let lbl = new_label() in
+        let (comp, mask) = name_for_int_comparison_imm cmp in
+        `	{emit_string comp}	{emit_reg i.arg.(0)}, {emit_int n}\n`;
+        `	lghi	{emit_reg i.res.(0)}, 1\n`;
+        `	brc	{emit_int mask}, {emit_label lbl}\n`;
+        `	lghi	{emit_reg i.res.(0)}, 0\n`;
+        `{emit_label lbl}:\n`
+    | Lop(Iintop_imm(Icheckbound { label_after_error; }, n)) ->
+       let lbl = bound_error_label i.dbg ?label:label_after_error in
+       if n >= 0 then begin
+        `	clgfi	{emit_reg i.arg.(0)}, {emit_int n}\n`;
+        `	brcl	12, {emit_label lbl}\n`  (* branch if unsigned le *)
+       end else begin
+        `	brcl	15, {emit_label lbl}\n`  (* branch always *)
+       end
+    | Lop(Iintop_imm(Ilsl, n)) ->
+        `	sllg	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)},{emit_int n}(%r0)\n`
+    | Lop(Iintop_imm(Ilsr, n)) ->
+        `	srlg	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)},{emit_int n}(%r0)\n`
+    | Lop(Iintop_imm(Iasr, n)) ->
+        `	srag	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)},{emit_int n}(%r0)\n`
+    | Lop(Iintop_imm(Iand, n)) ->
+        assert (i.arg.(0).loc = i.res.(0).loc);
+        `	nilf	{emit_reg i.res.(0)}, {emit_int (n land (1 lsl 32 - 1)(*0xFFFF_FFFF*))}\n`
+    | Lop(Iintop_imm(Ior, n)) ->
+        assert (i.arg.(0).loc = i.res.(0).loc);
+        `	oilf	{emit_reg i.res.(0)}, {emit_int n}\n`
+    | Lop(Iintop_imm(Ixor, n)) ->
+        assert (i.arg.(0).loc = i.res.(0).loc);
+        `	xilf	{emit_reg i.res.(0)}, {emit_int n}\n`
+    | Lop(Iintop_imm(Imul, n)) ->
+        assert (i.arg.(0).loc = i.res.(0).loc);
+          `	msgfi	{emit_reg i.res.(0)}, {emit_int n}\n`
+    | Lop(Iintop_imm((Imulh | Idiv | Imod), _)) ->
+        assert false
+    | Lop(Inegf | Iabsf as op) ->
+        let instr = name_for_floatop1 op in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
+    | Lop(Iaddf | Isubf | Imulf | Idivf as op) ->
+        assert (i.arg.(0).loc = i.res.(0).loc);
+        let instr = name_for_floatop2 op in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}\n`;
+    | Lop(Ifloatofint) ->
+          `	cdgbr	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
+    | Lop(Iintoffloat) ->
+        (* rounding method #5 = round toward 0 *)
+        `	cgdbr	{emit_reg i.res.(0)}, 5, {emit_reg i.arg.(0)}\n`
+    | Lop(Ispecific sop) ->
+        assert (i.arg.(2).loc = i.res.(0).loc);
+        let instr = name_for_specific sop in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
+    | Lop (Iname_for_debugger _) -> ()
+    | Lreloadretaddr ->
+        let n = frame_size() in
+        `	lg	%r14, {emit_int(n - size_addr)}(%r15)\n`
+    | Lreturn ->
+        let n = frame_size() in
+        emit_stack_adjust (-n);
+        `	br	%r14\n`
+    | Llabel lbl ->
+        `{emit_label lbl}:\n`
+    | Lbranch lbl ->
+        `	brcl	15,{emit_label lbl}\n`
+    | Lcondbranch(tst, lbl) ->
+        begin match tst with
+          Itruetest ->
+            `	cgfi	{emit_reg i.arg.(0)}, 0\n`;
+            `	brcl	7, {emit_label lbl}\n`
+        | Ifalsetest ->
+            `	cgfi	{emit_reg i.arg.(0)}, 0\n`;
+            `	brcl	8, {emit_label lbl}\n`
+        | Iinttest cmp ->
+            let (comp, mask) = name_for_int_comparison cmp in
+            `	{emit_string comp}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+            `	brcl	{emit_int mask}, {emit_label lbl}\n`
+        | Iinttest_imm(cmp, n) ->
+            let (comp, mask) = name_for_int_comparison_imm cmp in
+            `	{emit_string comp}	{emit_reg i.arg.(0)}, {emit_int n}\n`;
+            `	brcl	{emit_int mask}, {emit_label lbl}\n`
+        | Ifloattest cmp ->
+            `	cdbr	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+            let mask = branch_for_float_comparison cmp in
+            `	brcl	{emit_int mask}, {emit_label lbl}\n`
+        | Ioddtest ->
+            `	tmll	{emit_reg i.arg.(0)}, 1\n`;
+            `	brcl	1, {emit_label lbl}\n`
+        | Ieventest ->
+            `	tmll	{emit_reg i.arg.(0)}, 1\n`;
+            `	brcl	8, {emit_label lbl}\n`
+        end
+    | Lcondbranch3(lbl0, lbl1, lbl2) ->
+        `	cgfi	{emit_reg i.arg.(0)}, 1\n`;
+        begin match lbl0 with
+          None -> ()
+        | Some lbl -> `	brcl	4, {emit_label lbl}\n`
+        end;
+        begin match lbl1 with
+          None -> ()
+        | Some lbl -> `	brcl	8, {emit_label lbl}\n`
+        end;
+        begin match lbl2 with
+          None -> ()
+        | Some lbl -> `	brcl	2, {emit_label lbl}\n`
+        end
+    | Lswitch jumptbl ->
+        let lbl = new_label() in
+        `	larl	%r0, {emit_label lbl}\n`;
+        `	sllg	%r1, {emit_reg i.arg.(0)}, 2(%r0)\n`;
+        `	agr	%r1, %r0\n`;
+        `	lgf	%r1, 0(%r1)\n`;
+        `	agr	%r1, %r0\n`;
+        `	br	%r1\n`;
+        emit_string rodata_space;
+        `	.align	8\n`;
+        `{emit_label lbl}:`;
+        for i = 0 to Array.length jumptbl - 1 do
+          `	.long	{emit_label jumptbl.(i)} - {emit_label lbl}\n`
+        done;
+        emit_string code_space
+    | Lentertrap ->
+        ()
+    | Ladjust_trap_depth { delta_traps } ->
+        (* each trap occupies 16 bytes on the stack *)
+        let delta = 16 * delta_traps in
+        emit_stack_adjust delta;
+        stack_offset := !stack_offset + delta
+    | Lpushtrap { lbl_handler; } ->
+        stack_offset := !stack_offset + 16;
+        emit_stack_adjust 16;
+        `	larl	%r14, {emit_label lbl_handler}\n`;
+        `	stg	%r14, 0(%r15)\n`;
+        `	stg	%r13, {emit_int size_addr}(%r15)\n`;
+        `	lgr	%r13, %r15\n`
+    | Lpoptrap ->
+        `	lg	%r13, {emit_int size_addr}(%r15)\n`;
+        emit_stack_adjust (-16);
+        stack_offset := !stack_offset - 16
+    | Lraise k ->
+        begin match k with
+        | Lambda.Raise_regular->
+          let offset = Domainstate.(idx_of_field Domain_backtrace_pos) * 8 in
+          `	lghi	%r1, 0\n`;
+          `	stg	%r1, {emit_int offset}(%r10)\n`;
+          emit_call "caml_raise_exn";
+          `{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`
+        | Lambda.Raise_reraise ->
+          emit_call "caml_raise_exn";
+          `{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`
+        | Lambda.Raise_notrace ->
+          `	lg	%r1, 0(%r13)\n`;
+          `	lgr	%r15, %r13\n`;
+          `	lg	%r13, {emit_int size_addr}(%r15)\n`;
+          emit_stack_adjust (-16);
+          `	br	%r1\n`
+        end
+
+
+(* Emit a sequence of instructions *)
+
+let rec emit_all i =
+  match i with
+    {desc = Lend} -> ()
+  | _ ->
+      emit_instr i;
+      emit_all i.next
+
+(* Emission of a function declaration *)
+
+let fundecl fundecl =
+  function_name := fundecl.fun_name;
+  tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
+  stack_offset := 0;
+  call_gc_sites := [];
+  bound_error_sites := [];
+  bound_error_call := 0;
+  float_literals := [];
+  int_literals := [];
+  for i = 0 to Proc.num_register_classes - 1 do
+    num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
+  done;
+  prologue_required := fundecl.fun_prologue_required;
+  contains_calls := fundecl.fun_contains_calls;
+  `	.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;
+  `	.align	8\n`;
+  `{emit_symbol fundecl.fun_name}:\n`;
+  emit_all fundecl.fun_body;
+  (* Emit the glue code to call the GC *)
+  List.iter emit_call_gc !call_gc_sites;
+  (* Emit the glue code to handle bound errors *)
+  emit_call_bound_errors();
+  (* Emit the numeric literals *)
+  if !float_literals <> [] || !int_literals <> [] then begin
+    emit_string rodata_space;
+    `	.align	8\n`;
+    List.iter
+      (fun (f, lbl) ->
+        `{emit_label lbl}:`;
+        emit_float64_directive ".quad" f)
+      !float_literals;
+    List.iter
+      (fun (n, lbl) ->
+        `{emit_label lbl}:	.quad	{emit_nativeint n}\n`)
+      !int_literals
+  end
+
+(* Emission of data *)
+
+let declare_global_data s =
+  `	.globl	{emit_symbol s}\n`;
+  `	.type	{emit_symbol s}, @object\n`
+
+let emit_item = function
+    Cglobal_symbol s ->
+      declare_global_data s
+  | Cdefine_symbol s ->
+      `{emit_symbol s}:\n`;
+  | Cint8 n ->
+      `	.byte	{emit_int n}\n`
+  | Cint16 n ->
+      `	.short	{emit_int n}\n`
+  | Cint32 n ->
+      `	.long	{emit_nativeint n}\n`
+  | Cint n ->
+      `	.quad	{emit_nativeint n}\n`
+  | Csingle f ->
+      emit_float32_directive ".long" (Int32.bits_of_float f)
+  | Cdouble f ->
+      emit_float64_directive ".quad" (Int64.bits_of_float f)
+  | Csymbol_address s ->
+      `	.quad	{emit_symbol s}\n`
+  | Cstring s ->
+      emit_bytes_directive "	.byte	" s
+  | Cskip n ->
+      if n > 0 then `	.space	{emit_int n}\n`
+  | Calign n ->
+      if n < 8 then `	.align	8\n`
+               else `	.align	{emit_int n}\n`
+
+let data l =
+  emit_string data_space;
+  `	.align	8\n`;
+  List.iter emit_item l
+
+(* Beginning / end of an assembly file *)
+
+let begin_assembly() =
+  reset_debug_info();
+  `	.file	\"\"\n`;  (* PR#7037 *)
+  (* Emit the beginning of the segments *)
+  let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
+  emit_string data_space;
+  `	.align	8\n`;
+  declare_global_data lbl_begin;
+  `{emit_symbol lbl_begin}:\n`;
+  let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
+  emit_string code_space;
+  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
+  declare_global_data lbl_end;
+  `{emit_symbol lbl_end}:\n`;
+  `	.long	0\n`;
+  emit_string data_space;
+  `	.align	8\n`;
+  let lbl_end = Compilenv.make_symbol (Some "data_end") in
+  declare_global_data lbl_end;
+  `	.quad	0\n`;  (* PR#6329 *)
+  `{emit_symbol lbl_end}:\n`;
+  `	.quad	0\n`;
+  (* Emit the frame descriptors *)
+  emit_string data_space;  (* not rodata because relocations inside *)
+  `	.align	8\n`;
+  let lbl = Compilenv.make_symbol (Some "frametable") in
+  declare_global_data lbl;
+  `{emit_symbol lbl}:\n`;
+  emit_frames
+    { efa_code_label = (fun l -> `	.quad	{emit_label l}\n`);
+      efa_data_label = (fun l -> `	.quad	{emit_label l}\n`);
+      efa_8 = (fun n -> `	.byte	{emit_int n}\n`);
+      efa_16 = (fun n -> `	.short	{emit_int n}\n`);
+      efa_32 = (fun n -> `	.long	{emit_int32 n}\n`);
+      efa_word = (fun n -> `	.quad	{emit_int n}\n`);
+      efa_align = (fun n -> `	.align	{emit_int n}\n`);
+      efa_label_rel = (fun lbl ofs ->
+                           `	.long	({emit_label lbl} - .) + {emit_int32 ofs}\n`);
+      efa_def_label = (fun l -> `{emit_label l}:\n`);
+      efa_string = (fun s -> emit_bytes_directive "	.byte	" (s ^ "\000"))
+     };
+   (* Mark stack as non-executable *)
+   `	.section .note.GNU-stack,\"\",%progbits\n`
diff --git a/asmcomp/s390x/proc.ml b/asmcomp/s390x/proc.ml
new file mode 100644
index 00000000..9f0dff21
--- /dev/null
+++ b/asmcomp/s390x/proc.ml
@@ -0,0 +1,243 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt            *)
+(*                          Bill O'Farrell, IBM                           *)
+(*                                                                        *)
+(*   Copyright 2015 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2015 IBM (Bill O'Farrell with help from Tristan Amini).    *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Description of the Z Processor *)
+
+open Misc
+open Cmm
+open Reg
+open Arch
+open Mach
+
+(* Instruction selection *)
+
+let word_addressed = false
+
+(* Registers available for register allocation *)
+
+(* Integer register map:
+    0                   temporary, null register for some operations (volatile)
+    1                   temporary (volatile)
+    2 - 5               function arguments and results (volatile)
+    6                   function arguments and results (preserved by C)
+    7 - 9               general purpose, preserved by C
+    10                  domain state pointer (preserved by C)
+    11                  allocation pointer (preserved by C)
+    12                  general purpose  (preserved by C)
+    13                  trap pointer (preserved by C)
+    14                  return address (volatile)
+    15                  stack pointer (preserved by C)
+  Floating-point register map:
+    0, 2, 4, 6          function arguments and results (volatile)
+    1, 3, 5, 7          general purpose (volatile)
+    8 - 14              general purpose, preserved by C
+    15                  temporary, preserved by C
+
+Note: integer register r12 is used as GOT pointer by some C compilers.
+The code generated by OCaml does not need a GOT pointer, using PC-relative
+addressing instead for accessing the GOT.  This frees r12 as a
+general-purpose register. *)
+
+let int_reg_name =
+    [| "%r2"; "%r3"; "%r4"; "%r5"; "%r6"; "%r7"; "%r8"; "%r9"; "%r12" |]
+
+let float_reg_name =
+    [| "%f0"; "%f2"; "%f4"; "%f6"; "%f1"; "%f3"; "%f5"; "%f7";
+       "%f8"; "%f9"; "%f10"; "%f11"; "%f12"; "%f13"; "%f14"; "%f15" |]
+
+let num_register_classes = 2
+
+let register_class r =
+  match r.typ with
+  | Val | Int | Addr -> 0
+  | Float -> 1
+
+let num_available_registers = [| 9; 15 |]
+
+let first_available_register = [| 0; 100 |]
+
+let register_name r =
+  if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100)
+
+let rotate_registers = true
+
+(* Representation of hard registers by pseudo-registers *)
+
+let hard_int_reg =
+  let v = Array.make 9 Reg.dummy in
+  for i = 0 to 8 do v.(i) <- Reg.at_location Int (Reg i) done; v
+
+let hard_float_reg =
+  let v = Array.make 16 Reg.dummy in
+  for i = 0 to 15 do v.(i) <- Reg.at_location Float (Reg(100 + i)) done; v
+
+let all_phys_regs =
+  Array.append hard_int_reg hard_float_reg
+
+let phys_reg n =
+  if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
+
+let stack_slot slot ty =
+  Reg.at_location ty (Stack slot)
+
+let loc_spacetime_node_hole = Reg.dummy  (* Spacetime unsupported *)
+
+(* Calling conventions *)
+
+let calling_conventions
+    first_int last_int first_float last_float make_stack stack_ofs arg =
+  let loc = Array.make (Array.length arg) Reg.dummy in
+  let int = ref first_int in
+  let float = ref first_float in
+  let ofs = ref stack_ofs in
+  for i = 0 to Array.length arg - 1 do
+    match arg.(i).typ with
+    | Val | Int | Addr as ty ->
+        if !int <= last_int then begin
+          loc.(i) <- phys_reg !int;
+          incr int
+        end else begin
+          loc.(i) <- stack_slot (make_stack !ofs) ty;
+          ofs := !ofs + size_int
+        end
+    | Float ->
+        if !float <= last_float then begin
+          loc.(i) <- phys_reg !float;
+          incr float
+        end else begin
+          loc.(i) <- stack_slot (make_stack !ofs) Float;
+          ofs := !ofs + size_float
+        end
+  done;
+  (loc, Misc.align !ofs 16)
+  (* Keep stack 16-aligned. *)
+
+let incoming ofs = Incoming ofs
+let outgoing ofs = Outgoing ofs
+let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
+
+let max_arguments_for_tailcalls = 5
+
+let loc_arguments arg =
+  calling_conventions 0 4 100 103 outgoing 0 arg
+let loc_parameters arg =
+  let (loc, _ofs) = calling_conventions 0 4 100 103 incoming 0 arg in loc
+let loc_results res =
+  let (loc, _ofs) = calling_conventions 0 4 100 103 not_supported 0 res in loc
+
+(*   C calling conventions under SVR4:
+     use GPR 2-6 and FPR 0,2,4,6 just like ML calling conventions.
+     Using a float register does not affect the int registers.
+     Always reserve 160 bytes at bottom of stack, plus whatever is needed
+     to hold the overflow arguments. *)
+
+let loc_external_arguments arg =
+  let arg =
+    Array.map (fun regs -> assert (Array.length regs = 1); regs.(0)) arg in
+  let (loc, ofs) =
+    calling_conventions 0 4 100 103 outgoing 160 arg in
+  (Array.map (fun reg -> [|reg|]) loc, ofs)
+
+(* Results are in GPR 2 and FPR 0 *)
+
+let loc_external_results res =
+  let (loc, _ofs) = calling_conventions 0 0 100 100 not_supported 0 res in loc
+
+(* Exceptions are in GPR 2 *)
+
+let loc_exn_bucket = phys_reg 0
+
+(* See "S/390 ELF Application Binary Interface Supplement"
+   (http://refspecs.linuxfoundation.org/ELF/zSeries/lzsabi0_s390/x1542.html)
+*)
+
+let int_dwarf_reg_numbers = [| 2; 3; 4; 5; 6; 7; 8; 9; 12; |]
+
+let float_dwarf_reg_numbers =
+  [| 16; 17; 18; 19; 20; 21; 22; 23;
+     24; 28; 25; 29; 26; 30; 27; 31;
+  |]
+
+let dwarf_register_numbers ~reg_class =
+  match reg_class with
+  | 0 -> int_dwarf_reg_numbers
+  | 1 -> float_dwarf_reg_numbers
+  | _ -> Misc.fatal_errorf "Bad register class %d" reg_class
+
+let stack_ptr_dwarf_register_number = 15
+
+(* Volatile registers: none *)
+
+let regs_are_volatile _rs = false
+
+(* Registers destroyed by operations *)
+
+let destroyed_at_c_call =
+  Array.of_list(List.map phys_reg
+    [0; 1; 2; 3; 4;
+     100; 101; 102; 103; 104; 105; 106; 107])
+
+let destroyed_at_oper = function
+    Iop(Icall_ind _ | Icall_imm _ | Iextcall { alloc = true; _ }) ->
+    all_phys_regs
+  | Iop(Iextcall { alloc = false; _ }) -> destroyed_at_c_call
+  | _ -> [||]
+
+let destroyed_at_raise = all_phys_regs
+
+(* %r14 is destroyed at [Lreloadretaddr], but %r14 is not used for register
+   allocation, and thus does not need to (and indeed cannot) occur here. *)
+let destroyed_at_reloadretaddr = [| |]
+
+(* Maximal register pressure *)
+
+let safe_register_pressure = function
+    Iextcall _ -> 4
+  | _ -> 9
+
+let max_register_pressure = function
+    Iextcall _ -> [| 4; 7 |]
+  | _ -> [| 9; 15 |]
+
+(* Pure operations (without any side effect besides updating their result
+   registers). *)
+
+let op_is_pure = function
+  | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
+  | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false
+  | Ispecific(Imultaddf | Imultsubf) -> true
+  | _ -> true
+
+(* Layout of the stack *)
+
+let frame_required fd =
+  fd.fun_contains_calls
+    || fd.fun_num_stack_slots.(0) > 0
+    || fd.fun_num_stack_slots.(1) > 0
+
+let prologue_required fd =
+  frame_required fd
+
+(* Calling the assembler *)
+
+let assemble_file infile outfile =
+  Ccomp.command (Config.asm ^ " " ^
+                 (String.concat " " (Misc.debug_prefix_map_flags ())) ^
+                 " -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile)
+
+let init () = ()
diff --git a/asmcomp/s390x/reload.ml b/asmcomp/s390x/reload.ml
new file mode 100644
index 00000000..46d1daa7
--- /dev/null
+++ b/asmcomp/s390x/reload.ml
@@ -0,0 +1,50 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Reloading for the Z Processor *)
+
+open Arch
+open Mach
+
+class reload = object (self)
+
+inherit Reloadgen.reload_generic as super
+
+(* For 2-address instructions, reloading must make sure that the
+   temporary result register is the same as the appropriate
+   argument register. *)
+
+method! reload_operation op arg res =
+  match op with
+  (* Two-address binary operations: arg.(0) and res.(0) must be the same *)
+  | Iintop(Iadd|Isub|Imul|Iand|Ior|Ixor)  | Iaddf|Isubf|Imulf|Idivf ->
+      let res = self#makereg res.(0) in
+      ([|res; self#makereg arg.(1)|], [|res|])
+  (* Three-address ternary operations: arg.(2) and res.(0) must be the same *)
+  | Ispecific(Imultaddf|Imultsubf) ->
+      let res = self#makereg res.(0) in
+      ([|self#makereg arg.(0); self#makereg arg.(1); res|], [|res|])
+  (* One-address unary operations: arg.(0) and res.(0) must be the same *)
+  |  Iintop_imm((Imul|Iand|Ior|Ixor), _) ->
+      let res = self#makereg res.(0) in
+      ([|res|], [|res|])
+  (* Other instructions are regular *)
+  | _ ->
+      super#reload_operation op arg res
+
+end
+
+let fundecl f num_stack_slots =
+  (new reload)#fundecl f num_stack_slots
diff --git a/asmcomp/s390x/scheduling.ml b/asmcomp/s390x/scheduling.ml
new file mode 100644
index 00000000..a766d6a3
--- /dev/null
+++ b/asmcomp/s390x/scheduling.ml
@@ -0,0 +1,63 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt            *)
+(*                          Bill O'Farrell, IBM                           *)
+(*                                                                        *)
+(*   Copyright 2015 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2015 IBM (Bill O'Farrell with help from Tristan Amini).    *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Instruction scheduling for the Z processor *)
+
+open Arch
+open Mach
+
+(* The z10 processor is in-order, dual-issue.  It could benefit from some
+   basic-block scheduling, although precise latency information
+   is not available.
+   The z196 and later are out-of-order processors.  Basic-block
+   scheduling probably makes no difference. *)
+
+class scheduler = object
+
+inherit Schedgen.scheduler_generic
+
+(* Latencies (in cycles). Wild guesses.  We multiply all latencies by 2
+   to favor dual-issue. *)
+
+method oper_latency = function
+    Ireload -> 4
+  | Iload(_, _) -> 4
+  | Iconst_float _ -> 4 (* turned into a load *)
+  | Iintop(Imul) -> 10
+  | Iintop_imm(Imul, _) -> 10
+  | Iaddf | Isubf | Imulf -> 8
+  | Idivf -> 40
+  | Ispecific(Imultaddf | Imultsubf) -> 8
+  | _ -> 2
+
+method! reload_retaddr_latency = 4
+
+(* Issue cycles.  Rough approximations. *)
+
+method oper_issue_cycles = function
+  | Ialloc _ -> 4
+  | Iintop(Imulh) -> 15
+  | Iintop(Idiv|Imod) -> 20
+  | Iintop(Icomp _) -> 4
+  | Iintop_imm(Icomp _, _) -> 4
+  | _ -> 1
+
+method! reload_retaddr_issue_cycles = 1
+
+end
+
+let fundecl f = (new scheduler)#schedule_fundecl f
diff --git a/asmcomp/s390x/selection.ml b/asmcomp/s390x/selection.ml
new file mode 100644
index 00000000..760719b5
--- /dev/null
+++ b/asmcomp/s390x/selection.ml
@@ -0,0 +1,120 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt            *)
+(*                          Bill O'Farrell, IBM                           *)
+(*                                                                        *)
+(*   Copyright 2015 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2015 IBM (Bill O'Farrell with help from Tristan Amini).    *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Instruction selection for the Z processor *)
+
+open Cmm
+open Arch
+open Mach
+
+(* Recognition of addressing modes *)
+
+exception Use_default
+
+type addressing_expr =
+  | Alinear of expression
+  | Aadd of expression * expression
+
+let rec select_addr = function
+  | Cop((Caddi | Cadda | Caddv), [arg; Cconst_int (m, _)], _) ->
+      let (a, n) = select_addr arg in (a, n + m)
+  | Cop((Caddi | Cadda | Caddv), [Cconst_int (m, _); arg], _) ->
+      let (a, n) = select_addr arg in (a, n + m)
+  | Cop((Caddi | Cadda | Caddv), [arg1; arg2], _) ->
+      begin match (select_addr arg1, select_addr arg2) with
+          ((Alinear e1, n1), (Alinear e2, n2)) ->
+              (Aadd(e1, e2), n1 + n2)
+        | _ ->
+              (Aadd(arg1, arg2), 0)
+      end
+  | exp ->
+      (Alinear exp, 0)
+
+(* Instruction selection *)
+
+let pseudoregs_for_operation op arg res =
+  match op with
+  (* Two-address binary operations: arg.(0) and res.(0) must be the same *)
+  | Iintop(Iadd|Isub|Imul|Iand|Ior|Ixor)  | Iaddf|Isubf|Imulf|Idivf ->
+      ([|res.(0); arg.(1)|], res)
+  | Ispecific _ ->
+    ( [| arg.(0); arg.(1); res.(0) |], [| res.(0) |])
+  (* One-address unary operations: arg.(0) and res.(0) must be the same *)
+  |  Iintop_imm((Imul|Iand|Ior|Ixor), _) -> (res, res)
+  (* Other instructions are regular *)
+  | _ -> raise Use_default
+
+class selector = object (self)
+
+inherit Selectgen.selector_generic as super
+
+method is_immediate n = n <= 0x7FFF_FFFF && n >= (-1-0x7FFF_FFFF)
+  (* -1-.... : hack so that this can be compiled on 32-bit
+     (cf 'make check_all_arches') *)
+
+method select_addressing _chunk exp =
+  let (a, d) = select_addr exp in
+  (* 20-bit signed displacement *)
+  if d < 0x80000 && d >= -0x80000 then begin
+    match a with
+    | Alinear e -> (Iindexed d, e)
+    | Aadd(e1, e2) -> (Iindexed2 d, Ctuple [e1; e2])
+  end else
+    (Iindexed 0, exp)
+
+method! select_operation op args dbg =
+  match (op, args) with
+  (* Z does not support immediate operands for multiply high *)
+    (Cmulhi, _) -> (Iintop Imulh, args)
+  (* The and, or and xor instructions have a different range of immediate
+     operands than the other instructions *)
+  | (Cand, _) ->
+      self#select_logical Iand (-1 lsl 32 (*0x1_0000_0000*)) (-1) args
+  | (Cor, _) -> self#select_logical Ior 0 (1 lsl 32 - 1 (*0xFFFF_FFFF*)) args
+  | (Cxor, _) -> self#select_logical Ixor  0 (1 lsl 32 - 1 (*0xFFFF_FFFF*)) args
+  (* Recognize mult-add and mult-sub instructions *)
+  | (Caddf, [Cop(Cmulf, [arg1; arg2], _); arg3]) ->
+      (Ispecific Imultaddf, [arg1; arg2; arg3])
+  | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2], _)]) ->
+      (Ispecific Imultaddf, [arg1; arg2; arg3])
+  | (Csubf, [Cop(Cmulf, [arg1; arg2], _); arg3]) ->
+      (Ispecific Imultsubf, [arg1; arg2; arg3])
+  | _ ->
+      super#select_operation op args dbg
+
+method select_logical op lo hi = function
+    [arg; Cconst_int (n, _)] when n >= lo && n <= hi ->
+      (Iintop_imm(op, n), [arg])
+  | [Cconst_int (n, _); arg] when n >= lo && n <= hi ->
+      (Iintop_imm(op, n), [arg])
+  | args ->
+      (Iintop op, args)
+
+
+method! insert_op_debug env op dbg rs rd =
+  try
+    let (rsrc, rdst) = pseudoregs_for_operation op rs rd in
+    self#insert_moves env rs rsrc;
+    self#insert_debug env (Iop op) dbg rsrc rdst;
+    self#insert_moves env rdst rd;
+    rd
+  with Use_default ->
+    super#insert_op_debug env op dbg rs rd
+
+end
+
+let fundecl f = (new selector)#emit_fundecl f
diff --git a/asmcomp/schedgen.ml b/asmcomp/schedgen.ml
new file mode 100644
index 00000000..966dbbec
--- /dev/null
+++ b/asmcomp/schedgen.ml
@@ -0,0 +1,406 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Instruction scheduling *)
+
+open Reg
+open Mach
+open Linear
+
+(* Representation of the code DAG. *)
+
+type code_dag_node =
+  { instr: instruction;                 (* The instruction *)
+    delay: int;           (* How many cycles before result is available *)
+    mutable sons: (code_dag_node * int) list;
+                                        (* Instructions that depend on it *)
+    mutable date: int;                  (* Start date *)
+    mutable length: int;                (* Length of longest path to result *)
+    mutable ancestors: int;             (* Number of ancestors *)
+    mutable emitted_ancestors: int }    (* Number of emitted ancestors *)
+
+let dummy_node =
+  { instr = end_instr; delay = 0; sons = []; date = 0;
+    length = -1; ancestors = 0; emitted_ancestors = 0 }
+
+(* The code dag itself is represented by two tables from registers to nodes:
+   - "results" maps registers to the instructions that produced them;
+   - "uses" maps registers to the instructions that use them.
+   In addition:
+   - code_stores contains the latest store nodes emitted so far
+   - code_loads contains all load nodes emitted since the last store
+   - code_checkbounds contains the latest checkbound node not matched
+     by a subsequent load or store. *)
+
+let code_results = (Hashtbl.create 31 : (location, code_dag_node) Hashtbl.t)
+let code_uses = (Hashtbl.create 31 : (location, code_dag_node) Hashtbl.t)
+let code_stores = ref ([] : code_dag_node list)
+let code_loads = ref ([] : code_dag_node list)
+let code_checkbounds = ref ([] : code_dag_node list)
+
+let clear_code_dag () =
+  Hashtbl.clear code_results;
+  Hashtbl.clear code_uses;
+  code_stores := [];
+  code_loads := [];
+  code_checkbounds := []
+
+(* Add an edge to the code DAG *)
+
+let add_edge ancestor son delay =
+  ancestor.sons <- (son, delay) :: ancestor.sons;
+  son.ancestors <- son.ancestors + 1
+
+let add_edge_after son ancestor = add_edge ancestor son 0
+
+(* Add edges from all instructions that define a pseudoregister [arg] being used
+   as argument to node [node] (RAW dependencies *)
+
+let add_RAW_dependencies node arg =
+  try
+    let ancestor = Hashtbl.find code_results arg.loc in
+    add_edge ancestor node ancestor.delay
+  with Not_found ->
+    ()
+
+(* Add edges from all instructions that use a pseudoregister [res] that is
+   defined by node [node] (WAR dependencies). *)
+
+let add_WAR_dependencies node res =
+  let ancestors = Hashtbl.find_all code_uses res.loc in
+  List.iter (add_edge_after node) ancestors
+
+(* Add edges from all instructions that have already defined a pseudoregister
+   [res] that is defined by node [node] (WAW dependencies). *)
+
+let add_WAW_dependencies node res =
+  try
+    let ancestor = Hashtbl.find code_results res.loc in
+    add_edge ancestor node 0
+  with Not_found ->
+    ()
+
+(* Compute length of longest path to a result.
+   For leafs of the DAG, see whether their result is used in the instruction
+   immediately following the basic block (a "critical" output). *)
+
+let is_critical critical_outputs results =
+  try
+    for i = 0 to Array.length results - 1 do
+      let r = results.(i).loc in
+      for j = 0 to Array.length critical_outputs - 1 do
+        if critical_outputs.(j).loc = r then raise Exit
+      done
+    done;
+    false
+  with Exit ->
+    true
+
+let rec longest_path critical_outputs node =
+  if node.length < 0 then begin
+    match node.sons with
+      [] ->
+        node.length <-
+          if is_critical critical_outputs node.instr.res
+          || node.instr.desc = Lreloadretaddr (* always critical *)
+          then node.delay
+          else 0
+    | sons ->
+        node.length <-
+          List.fold_left
+            (fun len (son, delay) ->
+              max len (longest_path critical_outputs son + delay))
+            0 sons
+  end;
+  node.length
+
+(* Remove an instruction from the ready queue *)
+
+let rec remove_instr node = function
+    [] -> []
+  | instr :: rem ->
+      if instr == node then rem else instr :: remove_instr node rem
+
+(* We treat Lreloadretaddr as a word-sized load *)
+
+let some_load = (Iload(Cmm.Word_int, Arch.identity_addressing))
+
+(* The generic scheduler *)
+
+class virtual scheduler_generic = object (self)
+
+val mutable trywith_nesting = 0
+
+(* Determine whether an operation ends a basic block or not.
+   Can be overridden for some processors to signal specific instructions
+   that terminate a basic block. *)
+
+method oper_in_basic_block = function
+    Icall_ind _ -> false
+  | Icall_imm _ -> false
+  | Itailcall_ind _ -> false
+  | Itailcall_imm _ -> false
+  | Iextcall _ -> false
+  | Istackoffset _ -> false
+  | Ialloc _ -> false
+  | _ -> true
+
+(* Determine whether an instruction ends a basic block or not *)
+
+(* PR#2719: it is generally incorrect to schedule checkbound instructions
+   within a try ... with Invalid_argument _ -> ...
+   Hence, a checkbound instruction within a try...with block ends the
+   current basic block. *)
+
+method private instr_in_basic_block instr try_nesting =
+  match instr.desc with
+    Lop op ->
+      self#oper_in_basic_block op &&
+      not (try_nesting > 0 && self#is_checkbound op)
+  | Lreloadretaddr -> true
+  | _ -> false
+
+(* Determine whether an operation is a memory store or a memory load.
+   Can be overridden for some processors to signal specific
+   load or store instructions (e.g. on the I386). *)
+
+method is_store = function
+    Istore(_, _, _) -> true
+  | _ -> false
+
+method is_load = function
+    Iload(_, _) -> true
+  | _ -> false
+
+method is_checkbound = function
+    Iintop (Icheckbound _) -> true
+  | Iintop_imm(Icheckbound _, _) -> true
+  | _ -> false
+
+method private instr_is_store instr =
+  match instr.desc with
+    Lop op -> self#is_store op
+  | _ -> false
+
+method private instr_is_load instr =
+  match instr.desc with
+    Lop op -> self#is_load op
+  | _ -> false
+
+method private instr_is_checkbound instr =
+  match instr.desc with
+    Lop op -> self#is_checkbound op
+  | _ -> false
+
+(* Estimate the latency of an operation. *)
+
+method virtual oper_latency : Mach.operation -> int
+
+(* Estimate the latency of a Lreloadretaddr operation. *)
+
+method reload_retaddr_latency = self#oper_latency some_load
+
+(* Estimate the delay needed to evaluate an instruction *)
+
+method private instr_latency instr =
+  match instr.desc with
+    Lop op -> self#oper_latency op
+  | Lreloadretaddr -> self#reload_retaddr_latency
+  | _ -> assert false
+
+(* Estimate the number of cycles consumed by emitting an operation. *)
+
+method virtual oper_issue_cycles : Mach.operation -> int
+
+(* Estimate the number of cycles consumed by emitting a Lreloadretaddr. *)
+
+method reload_retaddr_issue_cycles = self#oper_issue_cycles some_load
+
+(* Estimate the number of cycles consumed by emitting an instruction. *)
+
+method private instr_issue_cycles instr =
+  match instr.desc with
+    Lop op -> self#oper_issue_cycles op
+  | Lreloadretaddr -> self#reload_retaddr_issue_cycles
+  | _ -> assert false
+
+(* Pseudoregisters destroyed by an instruction *)
+
+method private destroyed_by_instr instr =
+  match instr.desc with
+  | Lop op -> Proc.destroyed_at_oper (Iop op)
+  | Lreloadretaddr -> [||]
+  | _ -> assert false
+
+(* Add an instruction to the code dag *)
+
+method private add_instruction ready_queue instr =
+  let delay = self#instr_latency instr in
+  let destroyed = self#destroyed_by_instr instr in
+  let node =
+    { instr = instr;
+      delay = delay;
+      sons = [];
+      date = 0;
+      length = -1;
+      ancestors = 0;
+      emitted_ancestors = 0 } in
+  (* Add edges from all instructions that define one of the registers used
+     (RAW dependencies) *)
+  Array.iter (add_RAW_dependencies node) instr.arg;
+  (* Also add edges from all instructions that use one of the result regs
+     of this instruction, or a reg destroyed by this instruction
+     (WAR dependencies). *)
+  Array.iter (add_WAR_dependencies node) instr.res;
+  Array.iter (add_WAR_dependencies node) destroyed;   (* PR#5731 *)
+  (* Also add edges from all instructions that have already defined one
+     of the results of this instruction, or a reg destroyed by
+     this instruction (WAW dependencies). *)
+  Array.iter (add_WAW_dependencies node) instr.res;
+  Array.iter (add_WAW_dependencies node) destroyed;   (* PR#5731 *)
+  (* If this is a load, add edges from the most recent store viewed so
+     far (if any) and remember the load.  Also add edges from the most
+     recent checkbound and forget that checkbound. *)
+  if self#instr_is_load instr then begin
+    List.iter (add_edge_after node) !code_stores;
+    code_loads := node :: !code_loads;
+    List.iter (add_edge_after node) !code_checkbounds;
+    code_checkbounds := []
+  end
+  (* If this is a store, add edges from the most recent store,
+     as well as all loads viewed since then, and also the most recent
+     checkbound. Remember the store,
+     discarding the previous stores, loads and checkbounds. *)
+  else if self#instr_is_store instr then begin
+    List.iter (add_edge_after node) !code_stores;
+    List.iter (add_edge_after node) !code_loads;
+    List.iter (add_edge_after node) !code_checkbounds;
+    code_stores := [node];
+    code_loads := [];
+    code_checkbounds := []
+  end
+  else if self#instr_is_checkbound instr then begin
+    code_checkbounds := [node]
+  end;
+  (* Remember the registers used and produced by this instruction *)
+  for i = 0 to Array.length instr.res - 1 do
+    Hashtbl.add code_results instr.res.(i).loc node
+  done;
+  for i = 0 to Array.length destroyed - 1 do
+    Hashtbl.add code_results destroyed.(i).loc node  (* PR#5731 *)
+  done;
+  for i = 0 to Array.length instr.arg - 1 do
+    Hashtbl.add code_uses instr.arg.(i).loc node
+  done;
+  (* If this is a root instruction (all arguments already computed),
+     add it to the ready queue *)
+  if node.ancestors = 0 then node :: ready_queue else ready_queue
+
+(* Given a list of instructions and a date, choose one or several
+   that are ready to be computed (start date <= current date)
+   and that we can emit in one cycle.  Favor instructions with
+   maximal distance to result.  If we can't find any, return None.
+   This does not take multiple issues into account, though. *)
+
+method private ready_instruction date queue =
+  let rec extract best = function
+    [] ->
+      if best == dummy_node then None else Some best
+  | instr :: rem ->
+      let new_best =
+        if instr.date <= date && instr.length > best.length
+        then instr else best in
+      extract new_best rem in
+  extract dummy_node queue
+
+(* Schedule a basic block, adding its instructions in front of the given
+   instruction sequence *)
+
+method private reschedule ready_queue date cont =
+  if ready_queue = [] then cont else begin
+    match self#ready_instruction date ready_queue with
+      None ->
+        self#reschedule ready_queue (date + 1) cont
+    | Some node ->
+        (* Remove node from queue *)
+        let new_queue = ref (remove_instr node ready_queue) in
+        (* Update the start date and number of ancestors emitted of
+           all descendants of this node. Enter those that become ready
+           in the queue. *)
+        let issue_cycles = self#instr_issue_cycles node.instr in
+        List.iter
+          (fun (son, delay) ->
+            let completion_date = date + issue_cycles + delay - 1 in
+            if son.date < completion_date then son.date <- completion_date;
+            son.emitted_ancestors <- son.emitted_ancestors + 1;
+            if son.emitted_ancestors = son.ancestors then
+              new_queue := son :: !new_queue)
+          node.sons;
+        { node.instr with next =
+            self#reschedule !new_queue (date + issue_cycles) cont }
+  end
+
+(* Entry point *)
+(* Don't bother to schedule for initialization code and the like. *)
+
+method schedule_fundecl f =
+
+  let rec schedule i try_nesting =
+    match i.desc with
+    | Lend -> i
+    | Lpushtrap { lbl_handler = _; }
+      -> { i with next = schedule i.next (try_nesting + 1) }
+    | Lpoptrap -> { i with next = schedule i.next (try_nesting - 1) }
+    | _ ->
+        if self#instr_in_basic_block i try_nesting then begin
+          clear_code_dag();
+          schedule_block [] i try_nesting
+        end else
+          { i with next = schedule i.next try_nesting }
+
+  and schedule_block ready_queue i try_nesting =
+    if self#instr_in_basic_block i try_nesting then
+      schedule_block (self#add_instruction ready_queue i) i.next try_nesting
+    else begin
+      let critical_outputs =
+        match i.desc with
+          Lop(Icall_ind _ | Itailcall_ind _) -> [| i.arg.(0) |]
+        | Lop(Icall_imm _ | Itailcall_imm _ | Iextcall _) -> [||]
+        | Lreturn -> [||]
+        | _ -> i.arg in
+      List.iter (fun x -> ignore (longest_path critical_outputs x)) ready_queue;
+      self#reschedule ready_queue 0 (schedule i try_nesting)
+    end in
+
+  if f.fun_fast && !Clflags.insn_sched then begin
+    let new_body = schedule f.fun_body 0 in
+    clear_code_dag();
+    { fun_name = f.fun_name;
+      fun_body = new_body;
+      fun_fast = f.fun_fast;
+      fun_dbg  = f.fun_dbg;
+      fun_spacetime_shape = f.fun_spacetime_shape;
+      fun_tailrec_entry_point_label = f.fun_tailrec_entry_point_label;
+      fun_contains_calls = f.fun_contains_calls;
+      fun_num_stack_slots = f.fun_num_stack_slots;
+      fun_frame_required = f.fun_frame_required;
+      fun_prologue_required = f.fun_prologue_required;
+    }
+  end else
+    f
+
+end
+
+let reset () = clear_code_dag ()
diff --git a/asmcomp/schedgen.mli b/asmcomp/schedgen.mli
new file mode 100644
index 00000000..bc3f798d
--- /dev/null
+++ b/asmcomp/schedgen.mli
@@ -0,0 +1,49 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Instruction scheduling *)
+
+type code_dag_node =
+  { instr: Linear.instruction;
+    delay: int;
+    mutable sons: (code_dag_node * int) list;
+    mutable date: int;
+    mutable length: int;
+    mutable ancestors: int;
+    mutable emitted_ancestors: int }
+
+class virtual scheduler_generic : object
+  (* Can be overridden by processor description *)
+  method virtual oper_issue_cycles : Mach.operation -> int
+      (* Number of cycles needed to issue the given operation *)
+  method virtual oper_latency : Mach.operation -> int
+      (* Number of cycles needed to complete the given operation *)
+  method reload_retaddr_issue_cycles : int
+      (* Number of cycles needed to issue a Lreloadretaddr operation *)
+  method reload_retaddr_latency : int
+      (* Number of cycles needed to complete a Lreloadretaddr operation *)
+  method oper_in_basic_block : Mach.operation -> bool
+      (* Says whether the given operation terminates a basic block *)
+  method is_store : Mach.operation -> bool
+      (* Says whether the given operation is a memory store *)
+  method is_load : Mach.operation -> bool
+      (* Says whether the given operation is a memory load *)
+  method is_checkbound : Mach.operation -> bool
+      (* Says whether the given operation is a checkbound *)
+  (* Entry point *)
+  method schedule_fundecl : Linear.fundecl -> Linear.fundecl
+end
+
+val reset : unit -> unit
diff --git a/asmcomp/scheduling.mli b/asmcomp/scheduling.mli
new file mode 100644
index 00000000..9f734780
--- /dev/null
+++ b/asmcomp/scheduling.mli
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Instruction scheduling *)
+
+val fundecl: Linear.fundecl -> Linear.fundecl
diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml
new file mode 100644
index 00000000..20d070dc
--- /dev/null
+++ b/asmcomp/selectgen.ml
@@ -0,0 +1,1306 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Selection of pseudo-instructions, assignment of pseudo-registers,
+   sequentialization. *)
+
+open Cmm
+open Reg
+open Mach
+
+module Int = Numbers.Int
+module V = Backend_var
+module VP = Backend_var.With_provenance
+
+type environment =
+  { vars : (Reg.t array
+            * Backend_var.Provenance.t option
+            * Asttypes.mutable_flag) V.Map.t;
+    static_exceptions : Reg.t array list Int.Map.t;
+    (** Which registers must be populated when jumping to the given
+        handler. *)
+  }
+
+let env_add ?(mut=Asttypes.Immutable) var regs env =
+  let provenance = VP.provenance var in
+  let var = VP.var var in
+  { env with vars = V.Map.add var (regs, provenance, mut) env.vars }
+
+let env_add_static_exception id v env =
+  { env with static_exceptions = Int.Map.add id v env.static_exceptions }
+
+let env_find id env =
+  let regs, _provenance, _mut = V.Map.find id env.vars in
+  regs
+
+let env_find_mut id env =
+  let regs, _provenance, mut = V.Map.find id env.vars in
+  begin match mut with
+  | Asttypes.Mutable -> ()
+  | Asttypes.Immutable ->
+    Misc.fatal_error "Selectgen.env_find_mut: not mutable"
+  end;
+  regs
+
+let env_find_static_exception id env =
+  Int.Map.find id env.static_exceptions
+
+let env_empty = {
+  vars = V.Map.empty;
+  static_exceptions = Int.Map.empty;
+}
+
+(* Infer the type of the result of an operation *)
+
+let oper_result_type = function
+    Capply ty -> ty
+  | Cextcall(_s, ty, _alloc, _) -> ty
+  | Cload (c, _) ->
+      begin match c with
+      | Word_val -> typ_val
+      | Single | Double | Double_u -> typ_float
+      | _ -> typ_int
+      end
+  | Calloc -> typ_val
+  | Cstore (_c, _) -> typ_void
+  | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi |
+    Cand | Cor | Cxor | Clsl | Clsr | Casr |
+    Ccmpi _ | Ccmpa _ | Ccmpf _ -> typ_int
+  | Caddv -> typ_val
+  | Cadda -> typ_addr
+  | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf -> typ_float
+  | Cfloatofint -> typ_float
+  | Cintoffloat -> typ_int
+  | Craise _ -> typ_void
+  | Ccheckbound -> typ_void
+
+(* Infer the size in bytes of the result of an expression whose evaluation
+   may be deferred (cf. [emit_parts]). *)
+
+let size_component = function
+  | Val | Addr -> Arch.size_addr
+  | Int -> Arch.size_int
+  | Float -> Arch.size_float
+
+let size_machtype mty =
+  let size = ref 0 in
+  for i = 0 to Array.length mty - 1 do
+    size := !size + size_component mty.(i)
+  done;
+  !size
+
+let size_expr (env:environment) exp =
+  let rec size localenv = function
+      Cconst_int _ | Cconst_natint _ -> Arch.size_int
+    | Cconst_symbol _ | Cconst_pointer _ | Cconst_natpointer _ ->
+        Arch.size_addr
+    | Cconst_float _ -> Arch.size_float
+    | Cblockheader _ -> Arch.size_int
+    | Cvar id ->
+        begin try
+          V.Map.find id localenv
+        with Not_found ->
+        try
+          let regs = env_find id env in
+          size_machtype (Array.map (fun r -> r.typ) regs)
+        with Not_found ->
+          Misc.fatal_error("Selection.size_expr: unbound var " ^
+                           V.unique_name id)
+        end
+    | Ctuple el ->
+        List.fold_right (fun e sz -> size localenv e + sz) el 0
+    | Cop(op, _, _) ->
+        size_machtype(oper_result_type op)
+    | Clet(id, arg, body) ->
+        size (V.Map.add (VP.var id) (size localenv arg) localenv) body
+    | Csequence(_e1, e2) ->
+        size localenv e2
+    | _ ->
+        Misc.fatal_error "Selection.size_expr"
+  in size V.Map.empty exp
+
+(* Swap the two arguments of an integer comparison *)
+
+let swap_intcomp = function
+    Isigned cmp -> Isigned(swap_integer_comparison cmp)
+  | Iunsigned cmp -> Iunsigned(swap_integer_comparison cmp)
+
+(* Naming of registers *)
+
+let all_regs_anonymous rv =
+  try
+    for i = 0 to Array.length rv - 1 do
+      if not (Reg.anonymous rv.(i)) then raise Exit
+    done;
+    true
+  with Exit ->
+    false
+
+let name_regs id rv =
+  let id = VP.var id in
+  if Array.length rv = 1 then
+    rv.(0).raw_name <- Raw_name.create_from_var id
+  else
+    for i = 0 to Array.length rv - 1 do
+      rv.(i).raw_name <- Raw_name.create_from_var id;
+      rv.(i).part <- Some i
+    done
+
+(* "Join" two instruction sequences, making sure they return their results
+   in the same registers. *)
+
+let join env opt_r1 seq1 opt_r2 seq2 =
+  match (opt_r1, opt_r2) with
+    (None, _) -> opt_r2
+  | (_, None) -> opt_r1
+  | (Some r1, Some r2) ->
+      let l1 = Array.length r1 in
+      assert (l1 = Array.length r2);
+      let r = Array.make l1 Reg.dummy in
+      for i = 0 to l1-1 do
+        if Reg.anonymous r1.(i)
+          && Cmm.ge_component r1.(i).typ r2.(i).typ
+        then begin
+          r.(i) <- r1.(i);
+          seq2#insert_move env r2.(i) r1.(i)
+        end else if Reg.anonymous r2.(i)
+          && Cmm.ge_component r2.(i).typ r1.(i).typ
+        then begin
+          r.(i) <- r2.(i);
+          seq1#insert_move env r1.(i) r2.(i)
+        end else begin
+          let typ = Cmm.lub_component r1.(i).typ r2.(i).typ in
+          r.(i) <- Reg.create typ;
+          seq1#insert_move env r1.(i) r.(i);
+          seq2#insert_move env r2.(i) r.(i)
+        end
+      done;
+      Some r
+
+(* Same, for N branches *)
+
+let join_array env rs =
+  let some_res = ref None in
+  for i = 0 to Array.length rs - 1 do
+    let (r, _) = rs.(i) in
+    match r with
+    | None -> ()
+    | Some r ->
+      match !some_res with
+      | None -> some_res := Some (r, Array.map (fun r -> r.typ) r)
+      | Some (r', types) ->
+        let types =
+          Array.map2 (fun r typ -> Cmm.lub_component r.typ typ) r types
+        in
+        some_res := Some (r', types)
+  done;
+  match !some_res with
+    None -> None
+  | Some (template, types) ->
+      let size_res = Array.length template in
+      let res = Array.make size_res Reg.dummy in
+      for i = 0 to size_res - 1 do
+        res.(i) <- Reg.create types.(i)
+      done;
+      for i = 0 to Array.length rs - 1 do
+        let (r, s) = rs.(i) in
+        match r with
+          None -> ()
+        | Some r -> s#insert_moves env r res
+      done;
+      Some res
+
+(* Name of function being compiled *)
+let current_function_name = ref ""
+
+module Effect = struct
+  type t =
+    | None
+    | Raise
+    | Arbitrary
+
+  let join t1 t2 =
+    match t1, t2 with
+    | None, t2 -> t2
+    | t1, None -> t1
+    | Raise, Raise -> Raise
+    | Arbitrary, _ | _, Arbitrary -> Arbitrary
+
+  let pure = function
+    | None -> true
+    | Raise | Arbitrary -> false
+end
+
+module Coeffect = struct
+  type t =
+    | None
+    | Read_mutable
+    | Arbitrary
+
+  let join t1 t2 =
+    match t1, t2 with
+    | None, t2 -> t2
+    | t1, None -> t1
+    | Read_mutable, Read_mutable -> Read_mutable
+    | Arbitrary, _ | _, Arbitrary -> Arbitrary
+
+  let copure = function
+    | None -> true
+    | Read_mutable | Arbitrary -> false
+end
+
+module Effect_and_coeffect : sig
+  type t
+
+  val none : t
+  val arbitrary : t
+
+  val effect : t -> Effect.t
+  val coeffect : t -> Coeffect.t
+
+  val pure_and_copure : t -> bool
+
+  val effect_only : Effect.t -> t
+  val coeffect_only : Coeffect.t -> t
+
+  val join : t -> t -> t
+  val join_list_map : 'a list -> ('a -> t) -> t
+end = struct
+  type t = Effect.t * Coeffect.t
+
+  let none = Effect.None, Coeffect.None
+  let arbitrary = Effect.Arbitrary, Coeffect.Arbitrary
+
+  let effect (e, _ce) = e
+  let coeffect (_e, ce) = ce
+
+  let pure_and_copure (e, ce) = Effect.pure e && Coeffect.copure ce
+
+  let effect_only e = e, Coeffect.None
+  let coeffect_only ce = Effect.None, ce
+
+  let join (e1, ce1) (e2, ce2) =
+    Effect.join e1 e2, Coeffect.join ce1 ce2
+
+  let join_list_map xs f =
+    match xs with
+    | [] -> none
+    | x::xs -> List.fold_left (fun acc x -> join acc (f x)) (f x) xs
+end
+
+(* The default instruction selection class *)
+
+class virtual selector_generic = object (self)
+
+(* A syntactic criterion used in addition to judgements about (co)effects as
+   to whether the evaluation of a given expression may be deferred by
+   [emit_parts].  This criterion is a property of the instruction selection
+   algorithm in this file rather than a property of the Cmm language.
+*)
+method is_simple_expr = function
+    Cconst_int _ -> true
+  | Cconst_natint _ -> true
+  | Cconst_float _ -> true
+  | Cconst_symbol _ -> true
+  | Cconst_pointer _ -> true
+  | Cconst_natpointer _ -> true
+  | Cblockheader _ -> true
+  | Cvar _ -> true
+  | Ctuple el -> List.for_all self#is_simple_expr el
+  | Clet(_id, arg, body) | Clet_mut(_id, _, arg, body) ->
+    self#is_simple_expr arg && self#is_simple_expr body
+  | Cphantom_let(_var, _defining_expr, body) -> self#is_simple_expr body
+  | Csequence(e1, e2) -> self#is_simple_expr e1 && self#is_simple_expr e2
+  | Cop(op, args, _) ->
+      begin match op with
+        (* The following may have side effects *)
+      | Capply _ | Cextcall _ | Calloc | Cstore _ | Craise _ -> 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
+      | Cabsf | Caddf | Csubf | Cmulf | Cdivf | Cfloatofint | Cintoffloat
+      | Ccmpf _ | Ccheckbound -> List.for_all self#is_simple_expr args
+      end
+  | Cassign _ | Cifthenelse _ | Cswitch _ | Ccatch _ | Cexit _
+  | Ctrywith _ -> false
+
+(* Analyses the effects and coeffects of an expression.  This is used across
+   a whole list of expressions with a view to determining which expressions
+   may have their evaluation deferred.  The result of this function, modulo
+   target-specific judgements if the [effects_of] method is overridden, is a
+   property of the Cmm language rather than anything particular about the
+   instruction selection algorithm in this file.
+
+   In the case of e.g. an OCaml function call, the arguments whose evaluation
+   cannot be deferred (cf. [emit_parts], below) are computed in right-to-left
+   order first with their results going into temporaries, then the block is
+   allocated, then the remaining arguments are evaluated before being
+   combined with the temporaries. *)
+method effects_of exp =
+  let module EC = Effect_and_coeffect in
+  match exp with
+  | Cconst_int _ | Cconst_natint _ | Cconst_float _ | Cconst_symbol _
+  | Cconst_pointer _ | Cconst_natpointer _ | Cblockheader _
+  | Cvar _ -> EC.none
+  | Ctuple el -> EC.join_list_map el self#effects_of
+  | Clet (_id, arg, body) | Clet_mut (_id, _, arg, body) ->
+    EC.join (self#effects_of arg) (self#effects_of body)
+  | Cphantom_let (_var, _defining_expr, body) -> self#effects_of body
+  | Csequence (e1, e2) ->
+    EC.join (self#effects_of e1) (self#effects_of e2)
+  | Cifthenelse (cond, _ifso_dbg, ifso, _ifnot_dbg, ifnot, _dbg) ->
+    EC.join (self#effects_of cond)
+      (EC.join (self#effects_of ifso) (self#effects_of ifnot))
+  | Cop (op, args, _) ->
+    let from_op =
+      match op with
+      | Capply _ | Cextcall _ -> EC.arbitrary
+      | Calloc -> EC.none
+      | Cstore _ -> EC.effect_only Effect.Arbitrary
+      | Craise _ | Ccheckbound -> EC.effect_only Effect.Raise
+      | Cload (_, Asttypes.Immutable) -> EC.none
+      | Cload (_, Asttypes.Mutable) -> EC.coeffect_only Coeffect.Read_mutable
+      | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi | Cand | Cor | Cxor
+      | Clsl | Clsr | Casr | Ccmpi _ | Caddv | Cadda | Ccmpa _ | Cnegf | Cabsf
+      | Caddf | Csubf | Cmulf | Cdivf | Cfloatofint | Cintoffloat | Ccmpf _ ->
+        EC.none
+    in
+    EC.join from_op (EC.join_list_map args self#effects_of)
+  | Cassign _ | Cswitch _ | Ccatch _ | Cexit _ | Ctrywith _ ->
+    EC.arbitrary
+
+(* Says whether an integer constant is a suitable immediate argument *)
+
+method virtual is_immediate : int -> bool
+
+(* Selection of addressing modes *)
+
+method virtual select_addressing :
+  Cmm.memory_chunk -> Cmm.expression -> Arch.addressing_mode * Cmm.expression
+
+(* Default instruction selection for stores (of words) *)
+
+method select_store is_assign addr arg =
+  (Istore(Word_val, addr, is_assign), arg)
+
+(* call marking methods, documented in selectgen.mli *)
+val contains_calls = ref false
+
+method mark_call =
+  contains_calls := true
+
+method mark_tailcall = ()
+
+method mark_c_tailcall = ()
+
+method mark_instr = function
+  | Iop (Icall_ind _ | Icall_imm _ | Iextcall _) ->
+      self#mark_call
+  | Iop (Itailcall_ind _ | Itailcall_imm _) ->
+      self#mark_tailcall
+  | Iop (Ialloc _) ->
+      self#mark_call (* caml_alloc*, caml_garbage_collection *)
+  | Iop (Iintop (Icheckbound _) | Iintop_imm(Icheckbound _, _)) ->
+      self#mark_c_tailcall (* caml_ml_array_bound_error *)
+  | Iraise raise_kind ->
+    begin match raise_kind with
+      | Lambda.Raise_notrace -> ()
+      | Lambda.Raise_regular
+      | Lambda.Raise_reraise ->
+          (* PR#6239 *)
+          (* caml_stash_backtrace; we #mark_call rather than
+             #mark_c_tailcall to get a good stack backtrace *)
+          self#mark_call
+    end
+  | Itrywith _ ->
+    self#mark_call
+  | _ -> ()
+
+(* Default instruction selection for operators *)
+
+method select_allocation bytes =
+  Ialloc { bytes; label_after_call_gc = None;
+           dbginfo = []; spacetime_index = 0; }
+method select_allocation_args _env = [| |]
+
+method select_checkbound () =
+  Icheckbound { spacetime_index = 0; label_after_error = None; }
+method select_checkbound_extra_args () = []
+
+method select_operation op args _dbg =
+  match (op, args) with
+  | (Capply _, Cconst_symbol (func, _dbg) :: rem) ->
+    let label_after = Cmm.new_label () in
+    (Icall_imm { func; label_after; }, rem)
+  | (Capply _, _) ->
+    let label_after = Cmm.new_label () in
+    (Icall_ind { label_after; }, args)
+  | (Cextcall(func, _ty, alloc, label_after), _) ->
+    let label_after =
+      match label_after with
+      | None -> Cmm.new_label ()
+      | Some label_after -> label_after
+    in
+    Iextcall { func; alloc; label_after; }, args
+  | (Cload (chunk, _mut), [arg]) ->
+      let (addr, eloc) = self#select_addressing chunk arg in
+      (Iload(chunk, addr), [eloc])
+  | (Cstore (chunk, init), [arg1; arg2]) ->
+      let (addr, eloc) = self#select_addressing chunk arg1 in
+      let is_assign =
+        match init with
+        | Lambda.Root_initialization -> false
+        | Lambda.Heap_initialization -> false
+        | Lambda.Assignment -> true
+      in
+      if chunk = Word_int || chunk = Word_val then begin
+        let (op, newarg2) = self#select_store is_assign addr arg2 in
+        (op, [newarg2; eloc])
+      end else begin
+        (Istore(chunk, addr, is_assign), [arg2; eloc])
+        (* Inversion addr/datum in Istore *)
+      end
+  | (Calloc, _) -> (self#select_allocation 0), args
+  | (Caddi, _) -> self#select_arith_comm Iadd args
+  | (Csubi, _) -> self#select_arith Isub args
+  | (Cmuli, _) -> self#select_arith_comm Imul args
+  | (Cmulhi, _) -> self#select_arith_comm Imulh args
+  | (Cdivi, _) -> (Iintop Idiv, args)
+  | (Cmodi, _) -> (Iintop Imod, args)
+  | (Cand, _) -> self#select_arith_comm Iand args
+  | (Cor, _) -> self#select_arith_comm Ior args
+  | (Cxor, _) -> self#select_arith_comm Ixor args
+  | (Clsl, _) -> self#select_shift Ilsl args
+  | (Clsr, _) -> self#select_shift Ilsr args
+  | (Casr, _) -> self#select_shift Iasr args
+  | (Ccmpi comp, _) -> self#select_arith_comp (Isigned comp) args
+  | (Caddv, _) -> self#select_arith_comm Iadd args
+  | (Cadda, _) -> self#select_arith_comm Iadd args
+  | (Ccmpa comp, _) -> self#select_arith_comp (Iunsigned comp) args
+  | (Cnegf, _) -> (Inegf, args)
+  | (Cabsf, _) -> (Iabsf, args)
+  | (Caddf, _) -> (Iaddf, args)
+  | (Csubf, _) -> (Isubf, args)
+  | (Cmulf, _) -> (Imulf, args)
+  | (Cdivf, _) -> (Idivf, args)
+  | (Cfloatofint, _) -> (Ifloatofint, args)
+  | (Cintoffloat, _) -> (Iintoffloat, args)
+  | (Ccheckbound, _) ->
+    let extra_args = self#select_checkbound_extra_args () in
+    let op = self#select_checkbound () in
+    self#select_arith op (args @ extra_args)
+  | _ -> Misc.fatal_error "Selection.select_oper"
+
+method private select_arith_comm op = function
+    [arg; Cconst_int (n, _)] when self#is_immediate n ->
+      (Iintop_imm(op, n), [arg])
+  | [arg; Cconst_pointer (n, _)] when self#is_immediate n ->
+      (Iintop_imm(op, n), [arg])
+  | [Cconst_int (n, _); arg] when self#is_immediate n ->
+      (Iintop_imm(op, n), [arg])
+  | [Cconst_pointer (n, _); arg] when self#is_immediate n ->
+      (Iintop_imm(op, n), [arg])
+  | args ->
+      (Iintop op, args)
+
+method private select_arith op = function
+    [arg; Cconst_int (n, _)] when self#is_immediate n ->
+      (Iintop_imm(op, n), [arg])
+  | [arg; Cconst_pointer (n, _)] when self#is_immediate n ->
+      (Iintop_imm(op, n), [arg])
+  | args ->
+      (Iintop op, args)
+
+method private select_shift op = function
+    [arg; Cconst_int (n, _)] when n >= 0 && n < Arch.size_int * 8 ->
+      (Iintop_imm(op, n), [arg])
+  | args ->
+      (Iintop op, args)
+
+method private select_arith_comp cmp = function
+    [arg; Cconst_int (n, _)] when self#is_immediate n ->
+      (Iintop_imm(Icomp cmp, n), [arg])
+  | [arg; Cconst_pointer (n, _)] when self#is_immediate n ->
+      (Iintop_imm(Icomp cmp, n), [arg])
+  | [Cconst_int (n, _); arg] when self#is_immediate n ->
+      (Iintop_imm(Icomp(swap_intcomp cmp), n), [arg])
+  | [Cconst_pointer (n, _); arg] when self#is_immediate n ->
+      (Iintop_imm(Icomp(swap_intcomp cmp), n), [arg])
+  | args ->
+      (Iintop(Icomp cmp), args)
+
+(* Instruction selection for conditionals *)
+
+method select_condition = function
+    Cop(Ccmpi cmp, [arg1; Cconst_int (n, _)], _) when self#is_immediate n ->
+      (Iinttest_imm(Isigned cmp, n), arg1)
+  | Cop(Ccmpi cmp, [Cconst_int (n, _); arg2], _) when self#is_immediate n ->
+      (Iinttest_imm(Isigned(swap_integer_comparison cmp), n), arg2)
+  | Cop(Ccmpi cmp, [arg1; Cconst_pointer (n, _)], _) when self#is_immediate n ->
+      (Iinttest_imm(Isigned cmp, n), arg1)
+  | Cop(Ccmpi cmp, [Cconst_pointer (n, _); arg2], _) when self#is_immediate n ->
+      (Iinttest_imm(Isigned(swap_integer_comparison cmp), n), arg2)
+  | Cop(Ccmpi cmp, args, _) ->
+      (Iinttest(Isigned cmp), Ctuple args)
+  | Cop(Ccmpa cmp, [arg1; Cconst_pointer (n, _)], _) when self#is_immediate n ->
+      (Iinttest_imm(Iunsigned cmp, n), arg1)
+  | Cop(Ccmpa cmp, [arg1; Cconst_int (n, _)], _) when self#is_immediate n ->
+      (Iinttest_imm(Iunsigned cmp, n), arg1)
+  | Cop(Ccmpa cmp, [Cconst_pointer (n, _); arg2], _) when self#is_immediate n ->
+      (Iinttest_imm(Iunsigned(swap_integer_comparison cmp), n), arg2)
+  | Cop(Ccmpa cmp, [Cconst_int (n, _); arg2], _) when self#is_immediate n ->
+      (Iinttest_imm(Iunsigned(swap_integer_comparison cmp), n), arg2)
+  | Cop(Ccmpa cmp, args, _) ->
+      (Iinttest(Iunsigned cmp), Ctuple args)
+  | Cop(Ccmpf cmp, args, _) ->
+      (Ifloattest cmp, Ctuple args)
+  | Cop(Cand, [arg; Cconst_int (1, _)], _) ->
+      (Ioddtest, arg)
+  | arg ->
+      (Itruetest, arg)
+
+(* Return an array of fresh registers of the given type.
+   Normally implemented as Reg.createv, but some
+   ports (e.g. Arm) can override this definition to store float values
+   in pairs of integer registers. *)
+
+method regs_for tys = Reg.createv tys
+
+(* Buffering of instruction sequences *)
+
+val mutable instr_seq = dummy_instr
+
+method insert_debug _env desc dbg arg res =
+  instr_seq <- instr_cons_debug desc arg res dbg instr_seq
+
+method insert _env desc arg res =
+  instr_seq <- instr_cons desc arg res instr_seq
+
+method extract_core ~end_instr =
+  let rec extract res i =
+    if i == dummy_instr
+    then res
+    else extract {i with next = res} i.next in
+  extract end_instr instr_seq
+
+method extract =
+  self#extract_core ~end_instr:(end_instr ())
+
+(* Insert a sequence of moves from one pseudoreg set to another. *)
+
+method insert_move env src dst =
+  if src.stamp <> dst.stamp then
+    self#insert env (Iop Imove) [|src|] [|dst|]
+
+method insert_moves env src dst =
+  for i = 0 to min (Array.length src) (Array.length dst) - 1 do
+    self#insert_move env src.(i) dst.(i)
+  done
+
+(* Insert moves and stack offsets for function arguments and results *)
+
+method insert_move_args env arg loc stacksize =
+  if stacksize <> 0 then begin
+    self#insert env (Iop(Istackoffset stacksize)) [||] [||]
+  end;
+  self#insert_moves env arg loc
+
+method insert_move_results env loc res stacksize =
+  if stacksize <> 0 then begin
+    self#insert env (Iop(Istackoffset(-stacksize))) [||] [||]
+  end;
+  self#insert_moves env loc res
+
+(* Add an Iop opcode. Can be overridden by processor description
+   to insert moves before and after the operation, i.e. for two-address
+   instructions, or instructions using dedicated registers. *)
+
+method insert_op_debug env op dbg rs rd =
+  self#insert_debug env (Iop op) dbg rs rd;
+  rd
+
+method insert_op env op rs rd =
+  self#insert_op_debug env op Debuginfo.none rs rd
+
+method emit_blockheader env n _dbg =
+  let r = self#regs_for typ_int in
+  Some(self#insert_op env (Iconst_int n) [||] r)
+
+method about_to_emit_call _env _insn _arg _dbg = None
+
+(* Prior to a function call, update the Spacetime node hole pointer hard
+   register. *)
+
+method private maybe_emit_spacetime_move env ~spacetime_reg =
+  Option.iter (fun reg ->
+      self#insert_moves env reg [| Proc.loc_spacetime_node_hole |])
+    spacetime_reg
+
+(* Add the instructions for the given expression
+   at the end of the self sequence *)
+
+method emit_expr (env:environment) exp =
+  match exp with
+    Cconst_int (n, _dbg) ->
+      let r = self#regs_for typ_int in
+      Some(self#insert_op env (Iconst_int(Nativeint.of_int n)) [||] r)
+  | Cconst_natint (n, _dbg) ->
+      let r = self#regs_for typ_int in
+      Some(self#insert_op env (Iconst_int n) [||] r)
+  | Cconst_float (n, _dbg) ->
+      let r = self#regs_for typ_float in
+      Some(self#insert_op env (Iconst_float (Int64.bits_of_float n)) [||] r)
+  | Cconst_symbol (n, _dbg) ->
+      (* Cconst_symbol _ evaluates to a statically-allocated address, so its
+         value fits in a typ_int register and is never changed by the GC.
+
+         Some Cconst_symbols point to statically-allocated blocks, some of
+         which may point to heap values. However, any such blocks will be
+         registered in the compilation unit's global roots structure, so
+         adding this register to the frame table would be redundant *)
+      let r = self#regs_for typ_int in
+      Some(self#insert_op env (Iconst_symbol n) [||] r)
+  | Cconst_pointer (n, _dbg) ->
+      let r = self#regs_for typ_int in
+      Some(self#insert_op env (Iconst_int(Nativeint.of_int n)) [||] r)
+  | Cconst_natpointer (n, _dbg) ->
+      let r = self#regs_for typ_int in
+      Some(self#insert_op env (Iconst_int n) [||] r)
+  | Cblockheader(n, dbg) ->
+      self#emit_blockheader env n dbg
+  | Cvar v ->
+      begin try
+        Some(env_find v env)
+      with Not_found ->
+        Misc.fatal_error("Selection.emit_expr: unbound var " ^ V.unique_name v)
+      end
+  | Clet(v, e1, e2) ->
+      begin match self#emit_expr env e1 with
+        None -> None
+      | Some r1 -> self#emit_expr (self#bind_let env v r1) e2
+      end
+  | Clet_mut(v, k, e1, e2) ->
+      begin match self#emit_expr env e1 with
+        None -> None
+      | Some r1 -> self#emit_expr (self#bind_let_mut env v k r1) e2
+      end
+  | Cphantom_let (_var, _defining_expr, body) ->
+      self#emit_expr env body
+  | Cassign(v, e1) ->
+      let rv =
+        try
+          env_find_mut v env
+        with Not_found ->
+          Misc.fatal_error ("Selection.emit_expr: unbound var " ^ V.name v) in
+      begin match self#emit_expr env e1 with
+        None -> None
+      | Some r1 ->
+          self#insert_moves env r1 rv; Some [||]
+      end
+  | Ctuple [] ->
+      Some [||]
+  | Ctuple exp_list ->
+      begin match self#emit_parts_list env exp_list with
+        None -> None
+      | Some(simple_list, ext_env) ->
+          Some(self#emit_tuple ext_env simple_list)
+      end
+  | Cop(Craise k, [arg], dbg) ->
+      begin match self#emit_expr env arg with
+        None -> None
+      | Some r1 ->
+          let rd = [|Proc.loc_exn_bucket|] in
+          self#insert env (Iop Imove) r1 rd;
+          self#insert_debug env  (Iraise k) dbg rd [||];
+          None
+      end
+  | Cop(Ccmpf _, _, dbg) ->
+      self#emit_expr env
+        (Cifthenelse (exp,
+          dbg, Cconst_int (1, dbg),
+          dbg, Cconst_int (0, dbg),
+          dbg))
+  | Cop(op, args, dbg) ->
+      begin match self#emit_parts_list env args with
+        None -> None
+      | Some(simple_args, env) ->
+          let ty = oper_result_type op in
+          let (new_op, new_args) = self#select_operation op simple_args dbg in
+          match new_op with
+            Icall_ind _ ->
+              let r1 = self#emit_tuple env new_args in
+              let rarg = Array.sub r1 1 (Array.length r1 - 1) in
+              let rd = self#regs_for ty in
+              let (loc_arg, stack_ofs) = Proc.loc_arguments rarg in
+              let loc_res = Proc.loc_results rd in
+              let spacetime_reg =
+                self#about_to_emit_call env (Iop new_op) [| r1.(0) |] dbg
+              in
+              self#insert_move_args env rarg loc_arg stack_ofs;
+              self#maybe_emit_spacetime_move env ~spacetime_reg;
+              self#insert_debug env (Iop new_op) dbg
+                          (Array.append [|r1.(0)|] loc_arg) loc_res;
+              self#insert_move_results env loc_res rd stack_ofs;
+              Some rd
+          | Icall_imm _ ->
+              let r1 = self#emit_tuple env new_args in
+              let rd = self#regs_for ty in
+              let (loc_arg, stack_ofs) = Proc.loc_arguments r1 in
+              let loc_res = Proc.loc_results rd in
+              let spacetime_reg =
+                self#about_to_emit_call env (Iop new_op) [| |] dbg
+              in
+              self#insert_move_args env r1 loc_arg stack_ofs;
+              self#maybe_emit_spacetime_move env ~spacetime_reg;
+              self#insert_debug env (Iop new_op) dbg loc_arg loc_res;
+              self#insert_move_results env loc_res rd stack_ofs;
+              Some rd
+          | Iextcall _ ->
+              let spacetime_reg =
+                self#about_to_emit_call env (Iop new_op) [| |] dbg
+              in
+              let (loc_arg, stack_ofs) = self#emit_extcall_args env new_args in
+              self#maybe_emit_spacetime_move env ~spacetime_reg;
+              let rd = self#regs_for ty in
+              let loc_res =
+                self#insert_op_debug env new_op dbg
+                  loc_arg (Proc.loc_external_results rd) in
+              self#insert_move_results env loc_res rd stack_ofs;
+              Some rd
+          | Ialloc { bytes = _; spacetime_index; label_after_call_gc; } ->
+              let rd = self#regs_for typ_val in
+              let bytes = size_expr env (Ctuple new_args) in
+              assert (bytes mod Arch.size_addr = 0);
+              let alloc_words = bytes / Arch.size_addr in
+              let op =
+                Ialloc { bytes; spacetime_index; label_after_call_gc;
+                         dbginfo = [{alloc_words; alloc_dbg = dbg}] }
+              in
+              let args = self#select_allocation_args env in
+              self#insert_debug env (Iop op) dbg args rd;
+              self#emit_stores env new_args rd;
+              Some rd
+          | op ->
+              let r1 = self#emit_tuple env new_args in
+              let rd = self#regs_for ty in
+              Some (self#insert_op_debug env op dbg r1 rd)
+      end
+  | Csequence(e1, e2) ->
+      begin match self#emit_expr env e1 with
+        None -> None
+      | Some _ -> self#emit_expr env e2
+      end
+  | Cifthenelse(econd, _ifso_dbg, eif, _ifnot_dbg, eelse, _dbg) ->
+      let (cond, earg) = self#select_condition econd in
+      begin match self#emit_expr env earg with
+        None -> None
+      | Some rarg ->
+          let (rif, sif) = self#emit_sequence env eif in
+          let (relse, selse) = self#emit_sequence env eelse in
+          let r = join env rif sif relse selse in
+          self#insert env (Iifthenelse(cond, sif#extract, selse#extract))
+                      rarg [||];
+          r
+      end
+  | Cswitch(esel, index, ecases, _dbg) ->
+      begin match self#emit_expr env esel with
+        None -> None
+      | Some rsel ->
+          let rscases =
+            Array.map (fun (case, _dbg) -> self#emit_sequence env case) ecases
+          in
+          let r = join_array env rscases in
+          self#insert env (Iswitch(index,
+                                   Array.map (fun (_, s) -> s#extract) rscases))
+                      rsel [||];
+          r
+      end
+  | Ccatch(_, [], e1) ->
+      self#emit_expr env e1
+  | Ccatch(rec_flag, handlers, body) ->
+      let handlers =
+        List.map (fun (nfail, ids, e2, dbg) ->
+            let rs =
+              List.map
+                (fun (id, typ) ->
+                  let r = self#regs_for typ in name_regs id r; r)
+                ids in
+            (nfail, ids, rs, e2, dbg))
+          handlers
+      in
+      let env =
+        (* Since the handlers may be recursive, and called from the body,
+           the same environment is used for translating both the handlers and
+           the body. *)
+        List.fold_left (fun env (nfail, _ids, rs, _e2, _dbg) ->
+            env_add_static_exception nfail rs env)
+          env handlers
+      in
+      let (r_body, s_body) = self#emit_sequence env body in
+      let translate_one_handler (nfail, ids, rs, e2, _dbg) =
+        assert(List.length ids = List.length rs);
+        let new_env =
+          List.fold_left (fun env ((id, _typ), r) -> env_add id r env)
+            env (List.combine ids rs)
+        in
+        let (r, s) = self#emit_sequence new_env e2 in
+        (nfail, (r, s))
+      in
+      let l = List.map translate_one_handler handlers in
+      let a = Array.of_list ((r_body, s_body) :: List.map snd l) in
+      let r = join_array env a in
+      let aux (nfail, (_r, s)) = (nfail, s#extract) in
+      self#insert env (Icatch (rec_flag, List.map aux l, s_body#extract))
+        [||] [||];
+      r
+  | Cexit (nfail,args) ->
+      begin match self#emit_parts_list env args with
+        None -> None
+      | Some (simple_list, ext_env) ->
+          let src = self#emit_tuple ext_env simple_list in
+          let dest_args =
+            try env_find_static_exception nfail env
+            with Not_found ->
+              Misc.fatal_error ("Selection.emit_expr: unbound label "^
+                                Stdlib.Int.to_string nfail)
+          in
+          (* Intermediate registers to handle cases where some
+             registers from src are present in dest *)
+          let tmp_regs = Reg.createv_like src in
+          (* Ccatch registers must not contain out of heap pointers *)
+          Array.iter (fun reg -> assert(reg.typ <> Addr)) src;
+          self#insert_moves env src tmp_regs ;
+          self#insert_moves env tmp_regs (Array.concat dest_args) ;
+          self#insert env (Iexit nfail) [||] [||];
+          None
+      end
+  | Ctrywith(e1, v, e2, _dbg) ->
+      let (r1, s1) = self#emit_sequence env e1 in
+      let rv = self#regs_for typ_val in
+      let (r2, s2) = self#emit_sequence (env_add v rv env) e2 in
+      let r = join env r1 s1 r2 s2 in
+      self#insert env
+        (Itrywith(s1#extract,
+                  instr_cons (Iop Imove) [|Proc.loc_exn_bucket|] rv
+                             (s2#extract)))
+        [||] [||];
+      r
+
+method private emit_sequence (env:environment) exp =
+  let s = {< instr_seq = dummy_instr >} in
+  let r = s#emit_expr env exp in
+  (r, s)
+
+method private bind_let (env:environment) v r1 =
+  if all_regs_anonymous r1 then begin
+    name_regs v r1;
+    env_add v r1 env
+  end else begin
+    let rv = Reg.createv_like r1 in
+    name_regs v rv;
+    self#insert_moves env r1 rv;
+    env_add v rv env
+  end
+
+method private bind_let_mut (env:environment) v k r1 =
+  let rv = self#regs_for k in
+  name_regs v rv;
+  self#insert_moves env r1 rv;
+  env_add ~mut:Mutable v rv env
+
+(* The following two functions, [emit_parts] and [emit_parts_list], force
+   right-to-left evaluation order as required by the Flambda [Un_anf] pass
+   (and to be consistent with the bytecode compiler). *)
+
+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
+    | Effect.Arbitrary | Effect.Raise ->
+      (* Preserve the ordering of effectful expressions by evaluating them
+         early (in the correct order) and assigning their results to
+         temporaries.  We can avoid this in just one case: if we know that
+         every [exp'] in the original expression list (cf. [emit_parts_list])
+         to be evaluated after [exp] cannot possibly affect the result of
+         [exp] or depend on the result of [exp], then [exp] may be deferred.
+         (Checking purity here is not enough: we need to check copurity too
+         to avoid e.g. moving mutable reads earlier than the raising of
+         an exception.) *)
+      EC.pure_and_copure effects_after
+    | Effect.None ->
+      match EC.coeffect ec with
+      | Coeffect.None ->
+        (* Pure expressions may be moved. *)
+        true
+      | Coeffect.Read_mutable -> begin
+        (* Read-mutable expressions may only be deferred if evaluation of
+           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
+        | 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
+        | Effect.None -> true
+        | Effect.Arbitrary | Effect.Raise -> false
+      end
+  in
+  (* Even though some expressions may look like they can be deferred from
+     the (co)effect analysis, it may be forbidden to move them. *)
+  if may_defer_evaluation && self#is_simple_expr exp then
+    Some (exp, env)
+  else begin
+    match self#emit_expr env exp with
+      None -> None
+    | Some r ->
+        if Array.length r = 0 then
+          Some (Ctuple [], env)
+        else begin
+          (* The normal case *)
+          let id = V.create_local "bind" in
+          if all_regs_anonymous r then
+            (* r is an anonymous, unshared register; use it directly *)
+            Some (Cvar id, env_add (VP.create id) r env)
+          else begin
+            (* Introduce a fresh temp to hold the result *)
+            let tmp = Reg.createv_like r in
+            self#insert_moves env r tmp;
+            Some (Cvar id, env_add (VP.create id) tmp env)
+          end
+        end
+  end
+
+method private emit_parts_list (env:environment) exp_list =
+  let module EC = Effect_and_coeffect in
+  let exp_list_right_to_left, _effect =
+    (* Annotate each expression with the (co)effects that happen after it
+       when the original expression list is evaluated from right to left.
+       The resulting expression list has the rightmost expression first. *)
+    List.fold_left (fun (exp_list, effects_after) exp ->
+        let exp_effect = self#effects_of exp in
+        (exp, effects_after)::exp_list, EC.join exp_effect effects_after)
+      ([], EC.none)
+      exp_list
+  in
+  List.fold_left (fun results_and_env (exp, effects_after) ->
+      match results_and_env with
+      | None -> None
+      | Some (result, env) ->
+          match self#emit_parts env exp ~effects_after with
+          | None -> None
+          | Some (exp_result, env) -> Some (exp_result :: result, env))
+    (Some ([], env))
+    exp_list_right_to_left
+
+method private emit_tuple_not_flattened env exp_list =
+  let rec emit_list = function
+    [] -> []
+  | exp :: rem ->
+      (* Again, force right-to-left evaluation *)
+      let loc_rem = emit_list rem in
+      match self#emit_expr env exp with
+        None -> assert false  (* should have been caught in emit_parts *)
+      | Some loc_exp -> loc_exp :: loc_rem
+  in
+  emit_list exp_list
+
+method private emit_tuple env exp_list =
+  Array.concat (self#emit_tuple_not_flattened env exp_list)
+
+method emit_extcall_args env args =
+  let args = self#emit_tuple_not_flattened env args in
+  let arg_hard_regs, stack_ofs =
+    Proc.loc_external_arguments (Array.of_list args)
+  in
+  (* Flattening [args] and [arg_hard_regs] causes parts of values split
+     across multiple registers to line up correctly, by virtue of the
+     semantics of [split_int64_for_32bit_target] in cmmgen.ml, and the
+     required semantics of [loc_external_arguments] (see proc.mli). *)
+  let args = Array.concat args in
+  let arg_hard_regs = Array.concat (Array.to_list arg_hard_regs) in
+  self#insert_move_args env args arg_hard_regs stack_ofs;
+  arg_hard_regs, stack_ofs
+
+method emit_stores env data regs_addr =
+  let a =
+    ref (Arch.offset_addressing Arch.identity_addressing (-Arch.size_int)) in
+  List.iter
+    (fun e ->
+      let (op, arg) = self#select_store false !a e in
+      match self#emit_expr env arg with
+        None -> assert false
+      | Some regs ->
+          match op with
+            Istore(_, _, _) ->
+              for i = 0 to Array.length regs - 1 do
+                let r = regs.(i) in
+                let kind = if r.typ = Float then Double_u else Word_val in
+                self#insert env
+                            (Iop(Istore(kind, !a, false)))
+                            (Array.append [|r|] regs_addr) [||];
+                a := Arch.offset_addressing !a (size_component r.typ)
+              done
+          | _ ->
+              self#insert env (Iop op) (Array.append regs regs_addr) [||];
+              a := Arch.offset_addressing !a (size_expr env e))
+    data
+
+(* Same, but in tail position *)
+
+method private emit_return (env:environment) exp =
+  match self#emit_expr env exp with
+    None -> ()
+  | Some r ->
+      let loc = Proc.loc_results r in
+      self#insert_moves env r loc;
+      self#insert env Ireturn loc [||]
+
+method emit_tail (env:environment) exp =
+  match exp with
+    Clet(v, e1, e2) ->
+      begin match self#emit_expr env e1 with
+        None -> ()
+      | Some r1 -> self#emit_tail (self#bind_let env v r1) e2
+      end
+  | Clet_mut (v, k, e1, e2) ->
+     begin match self#emit_expr env e1 with
+       None -> ()
+     | Some r1 -> self#emit_tail (self#bind_let_mut env v k r1) e2
+     end
+  | Cphantom_let (_var, _defining_expr, body) ->
+      self#emit_tail env body
+  | Cop((Capply ty) as op, args, dbg) ->
+      begin match self#emit_parts_list env args with
+        None -> ()
+      | Some(simple_args, env) ->
+          let (new_op, new_args) = self#select_operation op simple_args dbg in
+          match new_op with
+            Icall_ind { label_after; } ->
+              let r1 = self#emit_tuple env new_args in
+              let rarg = Array.sub r1 1 (Array.length r1 - 1) in
+              let (loc_arg, stack_ofs) = Proc.loc_arguments rarg in
+              if stack_ofs = 0 then begin
+                let call = Iop (Itailcall_ind { label_after; }) in
+                let spacetime_reg =
+                  self#about_to_emit_call env call [| r1.(0) |] dbg
+                in
+                self#insert_moves env rarg loc_arg;
+                self#maybe_emit_spacetime_move env ~spacetime_reg;
+                self#insert_debug env call dbg
+                            (Array.append [|r1.(0)|] loc_arg) [||];
+              end else begin
+                let rd = self#regs_for ty in
+                let loc_res = Proc.loc_results rd in
+                let spacetime_reg =
+                  self#about_to_emit_call env (Iop new_op) [| r1.(0) |] dbg
+                in
+                self#insert_move_args env rarg loc_arg stack_ofs;
+                self#maybe_emit_spacetime_move env ~spacetime_reg;
+                self#insert_debug env (Iop new_op) dbg
+                            (Array.append [|r1.(0)|] loc_arg) loc_res;
+                self#insert env (Iop(Istackoffset(-stack_ofs))) [||] [||];
+                self#insert env Ireturn loc_res [||]
+              end
+          | Icall_imm { func; label_after; } ->
+              let r1 = self#emit_tuple env new_args in
+              let (loc_arg, stack_ofs) = Proc.loc_arguments r1 in
+              if stack_ofs = 0 then begin
+                let call = Iop (Itailcall_imm { func; label_after; }) in
+                let spacetime_reg =
+                  self#about_to_emit_call env call [| |] dbg
+                in
+                self#insert_moves env r1 loc_arg;
+                self#maybe_emit_spacetime_move env ~spacetime_reg;
+                self#insert_debug env call dbg loc_arg [||];
+              end else if func = !current_function_name then begin
+                let call = Iop (Itailcall_imm { func; label_after; }) in
+                let loc_arg' = Proc.loc_parameters r1 in
+                let spacetime_reg =
+                  self#about_to_emit_call env call [| |] dbg
+                in
+                self#insert_moves env r1 loc_arg';
+                self#maybe_emit_spacetime_move env ~spacetime_reg;
+                self#insert_debug env call dbg loc_arg' [||];
+              end else begin
+                let rd = self#regs_for ty in
+                let loc_res = Proc.loc_results rd in
+                let spacetime_reg =
+                  self#about_to_emit_call env (Iop new_op) [| |] dbg
+                in
+                self#insert_move_args env r1 loc_arg stack_ofs;
+                self#maybe_emit_spacetime_move env ~spacetime_reg;
+                self#insert_debug env (Iop new_op) dbg loc_arg loc_res;
+                self#insert env (Iop(Istackoffset(-stack_ofs))) [||] [||];
+                self#insert env Ireturn loc_res [||]
+              end
+          | _ -> Misc.fatal_error "Selection.emit_tail"
+      end
+  | Csequence(e1, e2) ->
+      begin match self#emit_expr env e1 with
+        None -> ()
+      | Some _ -> self#emit_tail env e2
+      end
+  | Cifthenelse(econd, _ifso_dbg, eif, _ifnot_dbg, eelse, _dbg) ->
+      let (cond, earg) = self#select_condition econd in
+      begin match self#emit_expr env earg with
+        None -> ()
+      | Some rarg ->
+          self#insert env
+                      (Iifthenelse(cond, self#emit_tail_sequence env eif,
+                                         self#emit_tail_sequence env eelse))
+                      rarg [||]
+      end
+  | Cswitch(esel, index, ecases, _dbg) ->
+      begin match self#emit_expr env esel with
+        None -> ()
+      | Some rsel ->
+          let cases =
+            Array.map (fun (case, _dbg) -> self#emit_tail_sequence env case)
+              ecases
+          in
+          self#insert env (Iswitch (index, cases)) rsel [||]
+      end
+  | Ccatch(_, [], e1) ->
+      self#emit_tail env e1
+  | Ccatch(rec_flag, handlers, e1) ->
+      let handlers =
+        List.map (fun (nfail, ids, e2, dbg) ->
+            let rs =
+              List.map
+                (fun (id, typ) ->
+                  let r = self#regs_for typ in name_regs id r; r)
+                ids in
+            (nfail, ids, rs, e2, dbg))
+          handlers in
+      let env =
+        List.fold_left (fun env (nfail, _ids, rs, _e2, _dbg) ->
+            env_add_static_exception nfail rs env)
+          env handlers in
+      let s_body = self#emit_tail_sequence env e1 in
+      let aux (nfail, ids, rs, e2, _dbg) =
+        assert(List.length ids = List.length rs);
+        let new_env =
+          List.fold_left
+            (fun env ((id, _typ),r) -> env_add id r env)
+            env (List.combine ids rs) in
+        nfail, self#emit_tail_sequence new_env e2
+      in
+      self#insert env (Icatch(rec_flag, List.map aux handlers, s_body))
+        [||] [||]
+  | Ctrywith(e1, v, e2, _dbg) ->
+      let (opt_r1, s1) = self#emit_sequence env e1 in
+      let rv = self#regs_for typ_val in
+      let s2 = self#emit_tail_sequence (env_add v rv env) e2 in
+      self#insert env
+        (Itrywith(s1#extract,
+                  instr_cons (Iop Imove) [|Proc.loc_exn_bucket|] rv s2))
+        [||] [||];
+      begin match opt_r1 with
+        None -> ()
+      | Some r1 ->
+          let loc = Proc.loc_results r1 in
+          self#insert_moves env r1 loc;
+          self#insert env Ireturn loc [||]
+      end
+  | Cop _
+  | Cconst_int _ | Cconst_natint _ | Cconst_float _ | Cconst_symbol _
+  | Cconst_pointer _ | Cconst_natpointer _ | Cblockheader _
+  | Cvar _
+  | Cassign _
+  | Ctuple _
+  | Cexit _ ->
+    self#emit_return env exp
+
+method private emit_tail_sequence env exp =
+  let s = {< instr_seq = dummy_instr >} in
+  s#emit_tail env exp;
+  s#extract
+
+(* Insertion of the function prologue *)
+
+method insert_prologue _f ~loc_arg ~rarg ~spacetime_node_hole:_ ~env =
+  self#insert_moves env loc_arg rarg;
+  None
+
+(* Sequentialization of a function definition *)
+
+method initial_env () = env_empty
+
+method emit_fundecl f =
+  current_function_name := f.Cmm.fun_name;
+  let rargs =
+    List.map
+      (fun (id, ty) -> let r = self#regs_for ty in name_regs id r; r)
+      f.Cmm.fun_args in
+  let rarg = Array.concat rargs in
+  let loc_arg = Proc.loc_parameters rarg in
+  (* To make it easier to add the Spacetime instrumentation code, we
+     first emit the body and extract the resulting instruction sequence;
+     then we emit the prologue followed by any Spacetime instrumentation.  The
+     sequence resulting from extracting the latter (prologue + instrumentation)
+     together is then simply prepended to the body. *)
+  let env =
+    List.fold_right2
+      (fun (id, _ty) r env -> env_add id r env)
+      f.Cmm.fun_args rargs (self#initial_env ()) in
+  let spacetime_node_hole, env =
+    if not Config.spacetime then None, env
+    else begin
+      let reg = self#regs_for typ_int in
+      let node_hole = V.create_local "spacetime_node_hole" in
+      Some (node_hole, reg), env_add (VP.create node_hole) reg env
+    end
+  in
+  self#emit_tail env f.Cmm.fun_body;
+  let body = self#extract in
+  instr_seq <- dummy_instr;
+  let fun_spacetime_shape =
+    self#insert_prologue f ~loc_arg ~rarg ~spacetime_node_hole ~env
+  in
+  let body = self#extract_core ~end_instr:body in
+  instr_iter (fun instr -> self#mark_instr instr.Mach.desc) body;
+  { fun_name = f.Cmm.fun_name;
+    fun_args = loc_arg;
+    fun_body = body;
+    fun_codegen_options = f.Cmm.fun_codegen_options;
+    fun_dbg  = f.Cmm.fun_dbg;
+    fun_spacetime_shape;
+    fun_num_stack_slots = Array.make Proc.num_register_classes 0;
+    fun_contains_calls = !contains_calls;
+  }
+
+end
+
+(* Tail call criterion (estimated).  Assumes:
+- all arguments are of type "int" (always the case for OCaml function calls)
+- one extra argument representing the closure environment (conservative).
+*)
+
+let is_tail_call nargs =
+  assert (Reg.dummy.typ = Int);
+  let args = Array.make (nargs + 1) Reg.dummy in
+  let (_loc_arg, stack_ofs) = Proc.loc_arguments args in
+  stack_ofs = 0
+
+let _ =
+  Simplif.is_tail_native_heuristic := is_tail_call
+
+let reset () =
+  current_function_name := ""
diff --git a/asmcomp/selectgen.mli b/asmcomp/selectgen.mli
new file mode 100644
index 00000000..96474564
--- /dev/null
+++ b/asmcomp/selectgen.mli
@@ -0,0 +1,189 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Selection of pseudo-instructions, assignment of pseudo-registers,
+   sequentialization. *)
+
+type environment
+
+val env_add
+   : ?mut:Asttypes.mutable_flag
+  -> Backend_var.With_provenance.t
+  -> Reg.t array
+  -> environment
+  -> environment
+
+val env_find : Backend_var.t -> environment -> Reg.t array
+
+val size_expr : environment -> Cmm.expression -> int
+
+module Effect : sig
+  type t =
+    | None
+    | Raise
+    | Arbitrary
+end
+
+module Coeffect : sig
+  type t =
+    | None
+    | Read_mutable
+    | Arbitrary
+end
+
+module Effect_and_coeffect : sig
+  type t
+
+  val none : t
+  val arbitrary : t
+
+  val effect : t -> Effect.t
+  val coeffect : t -> Coeffect.t
+
+  val effect_only : Effect.t -> t
+  val coeffect_only : Coeffect.t -> t
+
+  val join : t -> t -> t
+  val join_list_map : 'a list -> ('a -> t) -> t
+end
+
+class virtual selector_generic : object
+  (* The following methods must or can be overridden by the processor
+     description *)
+  method virtual is_immediate : int -> bool
+    (* Must be defined to indicate whether a constant is a suitable
+       immediate operand to arithmetic instructions *)
+  method virtual select_addressing :
+    Cmm.memory_chunk -> Cmm.expression -> Arch.addressing_mode * Cmm.expression
+    (* Must be defined to select addressing modes *)
+  method is_simple_expr: Cmm.expression -> bool
+  method effects_of : Cmm.expression -> Effect_and_coeffect.t
+    (* Can be overridden to reflect special extcalls known to be pure *)
+  method select_operation :
+    Cmm.operation ->
+    Cmm.expression list ->
+    Debuginfo.t ->
+    Mach.operation * Cmm.expression list
+    (* Can be overridden to deal with special arithmetic instructions *)
+  method select_condition : Cmm.expression -> Mach.test * Cmm.expression
+    (* Can be overridden to deal with special test instructions *)
+  method select_store :
+    bool -> Arch.addressing_mode -> Cmm.expression ->
+                                         Mach.operation * Cmm.expression
+    (* Can be overridden to deal with special store constant instructions *)
+  method regs_for : Cmm.machtype -> Reg.t array
+    (* Return an array of fresh registers of the given type.
+       Default implementation is like Reg.createv.
+       Can be overridden if float values are stored as pairs of
+       integer registers. *)
+  method insert_op :
+    environment -> Mach.operation -> Reg.t array -> Reg.t array -> Reg.t array
+    (* Can be overridden to deal with 2-address instructions
+       or instructions with hardwired input/output registers *)
+  method insert_op_debug :
+    environment -> Mach.operation -> Debuginfo.t -> Reg.t array
+      -> Reg.t array -> Reg.t array
+    (* Can be overridden to deal with 2-address instructions
+       or instructions with hardwired input/output registers *)
+  method emit_extcall_args :
+    environment -> Cmm.expression list -> Reg.t array * int
+    (* Can be overridden to deal with stack-based calling conventions *)
+  method emit_stores :
+    environment -> Cmm.expression list -> Reg.t array -> unit
+    (* Fill a freshly allocated block.  Can be overridden for architectures
+       that do not provide Arch.offset_addressing. *)
+
+  method mark_call : unit
+  (* informs the code emitter that the current function is non-leaf:
+     it may perform a (non-tail) call; by default, sets
+     [contains_calls := true] *)
+
+  method mark_tailcall : unit
+  (* informs the code emitter that the current function may end with
+     a tail-call; by default, does nothing *)
+
+  method mark_c_tailcall : unit
+  (* informs the code emitter that the current function may call
+     a C function that never returns; by default, does nothing.
+
+     It is unnecessary to save the stack pointer in this situation
+     (which is the main purpose of tracking leaf functions) but some
+     architectures still need to ensure that the stack is properly
+     aligned when the C function is called. This is achieved by
+     overloading this method to set [contains_calls := true] *)
+
+  method mark_instr : Mach.instruction_desc -> unit
+  (* dispatches on instructions to call one of the marking function
+     above; overloading this is useful if Ispecific instructions need
+     marking *)
+
+  (* The following method is the entry point and should not be overridden
+     (except by [Spacetime_profiling]). *)
+  method emit_fundecl : Cmm.fundecl -> Mach.fundecl
+
+  (* The following methods should not be overridden.  They cannot be
+     declared "private" in the current implementation because they
+     are not always applied to "self", but ideally they should be private. *)
+  method extract : Mach.instruction
+  method extract_core : end_instr:Mach.instruction -> Mach.instruction
+  method insert :
+    environment -> Mach.instruction_desc -> Reg.t array -> Reg.t array -> unit
+  method insert_debug :
+    environment -> Mach.instruction_desc -> Debuginfo.t ->
+      Reg.t array -> Reg.t array -> unit
+  method insert_move : environment -> Reg.t -> Reg.t -> unit
+  method insert_move_args :
+    environment -> Reg.t array -> Reg.t array -> int -> unit
+  method insert_move_results :
+    environment -> Reg.t array -> Reg.t array -> int -> unit
+  method insert_moves : environment -> Reg.t array -> Reg.t array -> unit
+  method emit_expr :
+    environment -> Cmm.expression -> Reg.t array option
+  method emit_tail : environment -> Cmm.expression -> unit
+
+  (* Only for the use of [Spacetime_profiling]. *)
+  method select_allocation : int -> Mach.operation
+  method select_allocation_args : environment -> Reg.t array
+  method select_checkbound : unit -> Mach.integer_operation
+  method select_checkbound_extra_args : unit -> Cmm.expression list
+  method emit_blockheader
+     : environment
+    -> nativeint
+    -> Debuginfo.t
+    -> Reg.t array option
+  method about_to_emit_call
+     : environment
+    -> Mach.instruction_desc
+    -> Reg.t array
+    -> Debuginfo.t
+    -> Reg.t array option
+  method initial_env : unit -> environment
+  method insert_prologue
+     : Cmm.fundecl
+    -> loc_arg:Reg.t array
+    -> rarg:Reg.t array
+    -> spacetime_node_hole:(Backend_var.t * Reg.t array) option
+    -> env:environment
+    -> Mach.spacetime_shape option
+
+  val mutable instr_seq : Mach.instruction
+
+  (* [contains_calls] is declared as a reference instance variable,
+     instead of a mutable boolean instance variable,
+     because the traversal uses functional object copies. *)
+  val contains_calls : bool ref
+end
+
+val reset : unit -> unit
diff --git a/asmcomp/selection.mli b/asmcomp/selection.mli
new file mode 100644
index 00000000..3c055fe0
--- /dev/null
+++ b/asmcomp/selection.mli
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Selection of pseudo-instructions, assignment of pseudo-registers,
+   sequentialization. *)
+
+val fundecl: Cmm.fundecl -> Mach.fundecl
diff --git a/asmcomp/spacetime_profiling.ml b/asmcomp/spacetime_profiling.ml
new file mode 100644
index 00000000..62e182ab
--- /dev/null
+++ b/asmcomp/spacetime_profiling.ml
@@ -0,0 +1,480 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2015--2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+module V = Backend_var
+module VP = Backend_var.With_provenance
+
+let node_num_header_words = 2 (* [Node_num_header_words] in the runtime. *)
+let index_within_node = ref node_num_header_words
+(* The [lazy]s are to ensure that we don't create [V.t]s at toplevel
+   when not using Spacetime profiling.  (This could cause stamps to differ
+   between bytecode and native .cmis when no .mli is present, e.g.
+   arch.ml.) *)
+let spacetime_node = ref (lazy (Cmm.Cvar (V.create_local "dummy")))
+let spacetime_node_ident = ref (lazy (V.create_local "dummy"))
+let current_function_label = ref None
+let direct_tail_call_point_indexes = ref []
+
+let reverse_shape = ref ([] : Mach.spacetime_shape)
+
+(* CR-someday mshinwell: This code could be updated to use [placeholder_dbg] as
+   in [Cmmgen]. *)
+let cconst_int i = Cmm.Cconst_int (i, Debuginfo.none)
+let cconst_natint i = Cmm.Cconst_natint (i, Debuginfo.none)
+let cconst_symbol s = Cmm.Cconst_symbol (s, Debuginfo.none)
+
+let something_was_instrumented () =
+  !index_within_node > node_num_header_words
+
+let next_index_within_node ~part_of_shape ~label =
+  let index = !index_within_node in
+  begin match part_of_shape with
+  | Mach.Direct_call_point _ ->
+    incr index_within_node;
+    if Config.enable_call_counts then begin
+      incr index_within_node
+    end
+  | Mach.Indirect_call_point ->
+    incr index_within_node
+  | Mach.Allocation_point ->
+    incr index_within_node;
+    incr index_within_node;
+    incr index_within_node
+  end;
+  reverse_shape := (part_of_shape, label) :: !reverse_shape;
+  index
+
+let reset ~spacetime_node_ident:ident ~function_label =
+  index_within_node := node_num_header_words;
+  spacetime_node := lazy (Cmm.Cvar ident);
+  spacetime_node_ident := lazy ident;
+  direct_tail_call_point_indexes := [];
+  current_function_label := Some function_label;
+  reverse_shape := []
+
+let code_for_function_prologue ~function_name ~fun_dbg:dbg ~node_hole =
+  let node = V.create_local "node" in
+  let new_node = V.create_local "new_node" in
+  let must_allocate_node = V.create_local "must_allocate_node" in
+  let is_new_node = V.create_local "is_new_node" in
+  let no_tail_calls = List.length !direct_tail_call_point_indexes < 1 in
+  let open Cmm in
+  let initialize_direct_tail_call_points_and_return_node =
+    let new_node_encoded = V.create_local "new_node_encoded" in
+    (* The callee node pointers within direct tail call points must initially
+       point back at the start of the current node and be marked as per
+       [Encode_tail_caller_node] in the runtime. *)
+    let indexes = !direct_tail_call_point_indexes in
+    let body =
+      List.fold_left (fun init_code index ->
+          (* Cf. [Direct_callee_node] in the runtime. *)
+          let offset_in_bytes = index * Arch.size_addr in
+          Csequence (
+            Cop (Cstore (Word_int, Lambda.Assignment),
+              [Cop (Caddi, [Cvar new_node; cconst_int offset_in_bytes], dbg);
+               Cvar new_node_encoded], dbg),
+            init_code))
+        (Cvar new_node)
+        indexes
+    in
+    match indexes with
+    | [] -> body
+    | _ ->
+      Clet (VP.create new_node_encoded,
+        (* Cf. [Encode_tail_caller_node] in the runtime. *)
+        Cop (Cor, [Cvar new_node; cconst_int 1], dbg),
+        body)
+  in
+  let pc = V.create_local "pc" in
+  Clet (VP.create node,
+    Cop (Cload (Word_int, Asttypes.Mutable), [Cvar node_hole], dbg),
+      Clet (VP.create must_allocate_node,
+        Cop (Cand, [Cvar node; cconst_int 1], dbg),
+        Cifthenelse (
+          Cop (Ccmpi Cne, [Cvar must_allocate_node; cconst_int 1], dbg),
+          dbg,
+          Cvar node,
+          dbg,
+          Clet (VP.create is_new_node,
+            Clet (VP.create pc, cconst_symbol function_name,
+              Cop (Cextcall ("caml_spacetime_allocate_node",
+                  [| Int |], false, None),
+                [cconst_int (1 (* header *) + !index_within_node);
+                Cvar pc;
+                Cvar node_hole;
+                ],
+                dbg)),
+              Clet (VP.create new_node,
+                Cop (Cload (Word_int, Asttypes.Mutable), [Cvar node_hole], dbg),
+                if no_tail_calls then Cvar new_node
+                else
+                  Cifthenelse (
+                    Cop (Ccmpi Ceq, [Cvar is_new_node; cconst_int 0], dbg),
+                    dbg,
+                    Cvar new_node,
+                    dbg,
+                    initialize_direct_tail_call_points_and_return_node,
+                    dbg))),
+          dbg)))
+
+let code_for_blockheader ~value's_header ~node ~dbg =
+  let num_words = Nativeint.shift_right_logical value's_header 10 in
+  let existing_profinfo = V.create_local "existing_profinfo" in
+  let existing_count = V.create_local "existing_count" in
+  let profinfo = V.create_local "profinfo" in
+  let address_of_profinfo = V.create_local "address_of_profinfo" in
+  let label = Cmm.new_label () in
+  let index_within_node =
+    next_index_within_node ~part_of_shape:Mach.Allocation_point ~label
+  in
+  let offset_into_node = Arch.size_addr * index_within_node in
+  let open Cmm in
+  let generate_new_profinfo =
+    (* This will generate a static branch to a function that should usually
+       be in the cache, which hopefully gives a good code size/performance
+       balance.
+       The "Some label" is important: it provides the link between the shape
+       table, the allocation point, and the frame descriptor table---enabling
+       the latter table to be used for resolving a program counter at such
+       a point to a location.
+    *)
+    Cop (Cextcall ("caml_spacetime_generate_profinfo", [| Int |],
+        false, Some label),
+      [Cvar address_of_profinfo;
+       cconst_int (index_within_node + 1)],
+      dbg)
+  in
+  (* Check if we have already allocated a profinfo value for this allocation
+     point with the current backtrace.  If so, use that value; if not,
+     allocate a new one. *)
+  Clet (VP.create address_of_profinfo,
+    Cop (Caddi, [
+      Cvar node;
+      cconst_int offset_into_node;
+    ], dbg),
+    Clet (VP.create existing_profinfo,
+        Cop (Cload (Word_int, Asttypes.Mutable), [Cvar address_of_profinfo],
+          dbg),
+      Clet (VP.create profinfo,
+        Cifthenelse (
+          Cop (Ccmpi Cne, [Cvar existing_profinfo; cconst_int 1 (* () *)], dbg),
+          dbg,
+          Cvar existing_profinfo,
+          dbg,
+          generate_new_profinfo,
+          dbg),
+        Clet (VP.create existing_count,
+          Cop (Cload (Word_int, Asttypes.Mutable), [
+            Cop (Caddi,
+              [Cvar address_of_profinfo; cconst_int Arch.size_addr], dbg)
+          ], dbg),
+          Csequence (
+            Cop (Cstore (Word_int, Lambda.Assignment),
+              [Cop (Caddi,
+                [Cvar address_of_profinfo; cconst_int Arch.size_addr], dbg);
+                Cop (Caddi, [
+                  Cvar existing_count;
+                  (* N.B. "*2" since the count is an OCaml integer.
+                     The "1 +" is to count the value's header. *)
+                  cconst_int (2 * (1 + Nativeint.to_int num_words));
+                ], dbg);
+              ], dbg),
+            (* [profinfo] looks like a black [Infix_tag] header.  Instead of
+               having to mask [profinfo] before ORing it with the desired
+               header, we can use an XOR trick, to keep code size down. *)
+            let value's_header =
+              Nativeint.logxor value's_header
+                (Nativeint.logor
+                  ((Nativeint.logor (Nativeint.of_int Obj.infix_tag)
+                    (Nativeint.shift_left 3n (* <- Caml_black *) 8)))
+                  (Nativeint.shift_left
+                    (* The following is the [Infix_offset_val], in words. *)
+                    (Nativeint.of_int (index_within_node + 1)) 10))
+            in
+            Cop (Cxor, [Cvar profinfo; cconst_natint value's_header], dbg))))))
+
+type callee =
+  | Direct of string
+  | Indirect of Cmm.expression
+
+let code_for_call ~node ~callee ~is_tail ~label dbg =
+  (* We treat self recursive calls as tail calls to avoid blow-ups in the
+     graph. *)
+  let is_self_recursive_call =
+    match callee with
+    | Direct callee ->
+      begin match !current_function_label with
+      | None -> Misc.fatal_error "[current_function_label] not set"
+      | Some label -> String.equal callee label
+      end
+    | Indirect _ -> false
+  in
+  let is_tail = is_tail || is_self_recursive_call in
+  let index_within_node =
+    match callee with
+    | Direct callee ->
+      next_index_within_node
+        ~part_of_shape:(Mach.Direct_call_point { callee; })
+        ~label
+    | Indirect _ ->
+      next_index_within_node ~part_of_shape:Mach.Indirect_call_point ~label
+  in
+  begin match callee with
+    (* If this is a direct tail call point, we need to note down its index,
+       so the correct initialization code can be emitted in the prologue. *)
+    | Direct _ when is_tail ->
+      direct_tail_call_point_indexes :=
+        index_within_node::!direct_tail_call_point_indexes
+    | Direct _ | Indirect _ -> ()
+  end;
+  let place_within_node = V.create_local "place_within_node" in
+  let open Cmm in
+  Clet (VP.create place_within_node,
+    Cop (Caddi, [node; cconst_int (index_within_node * Arch.size_addr)], dbg),
+    (* The following code returns the address that is to be moved into the
+       (hard) node hole pointer register immediately before the call.
+       (That move is inserted in [Selectgen].) *)
+    match callee with
+    | Direct _callee ->
+      if Config.enable_call_counts then begin
+        let count_addr = V.create_local "call_count_addr" in
+        let count = V.create_local "call_count" in
+        Clet (VP.create count_addr,
+          Cop (Caddi, [Cvar place_within_node; cconst_int Arch.size_addr], dbg),
+          Clet (VP.create count,
+            Cop (Cload (Word_int, Asttypes.Mutable), [Cvar count_addr], dbg),
+            Csequence (
+              Cop (Cstore (Word_int, Lambda.Assignment),
+                (* Adding 2 really means adding 1; the count is encoded
+                   as an OCaml integer. *)
+                [Cvar count_addr; Cop (Caddi, [Cvar count; cconst_int 2], dbg)],
+                dbg),
+              Cvar place_within_node)))
+      end else begin
+        Cvar place_within_node
+      end
+    | Indirect callee ->
+      let caller_node =
+        if is_tail then node
+        else cconst_int 1  (* [Val_unit] *)
+      in
+      Cop (Cextcall ("caml_spacetime_indirect_node_hole_ptr",
+          [| Int |], false, None),
+        [callee; Cvar place_within_node; caller_node],
+        dbg))
+
+class virtual instruction_selection = object (self)
+  inherit Selectgen.selector_generic as super
+
+  (* [disable_instrumentation] ensures that we don't try to instrument the
+     instrumentation... *)
+  val mutable disable_instrumentation = false
+
+  method private instrument_direct_call ~env ~func ~is_tail ~label_after dbg =
+    let instrumentation =
+      code_for_call
+        ~node:(Lazy.force !spacetime_node)
+        ~callee:(Direct func)
+        ~is_tail
+        ~label:label_after
+        dbg
+    in
+    match self#emit_expr env instrumentation with
+    | None -> assert false
+    | Some reg -> Some reg
+
+  method private instrument_indirect_call ~env ~callee ~is_tail
+      ~label_after dbg =
+    (* [callee] is a pseudoregister, so we have to bind it in the environment
+       and reference the variable to which it is bound. *)
+    let callee_ident = V.create_local "callee" in
+    let env = Selectgen.env_add (VP.create callee_ident) [| callee |] env in
+    let instrumentation =
+      code_for_call
+        ~node:(Lazy.force !spacetime_node)
+        ~callee:(Indirect (Cmm.Cvar callee_ident))
+        ~is_tail
+        ~label:label_after
+        dbg
+    in
+    match self#emit_expr env instrumentation with
+    | None -> assert false
+    | Some reg -> Some reg
+
+  method private can_instrument () =
+    Config.spacetime && not disable_instrumentation
+
+  method! about_to_emit_call env desc arg dbg =
+    if not (self#can_instrument ()) then None
+    else
+      let module M = Mach in
+      match desc with
+      | M.Iop (M.Icall_imm { func; label_after; }) ->
+        assert (Array.length arg = 0);
+        self#instrument_direct_call ~env ~func ~is_tail:false ~label_after dbg
+      | M.Iop (M.Icall_ind { label_after; }) ->
+        assert (Array.length arg = 1);
+        self#instrument_indirect_call ~env ~callee:arg.(0)
+          ~is_tail:false ~label_after dbg
+      | M.Iop (M.Itailcall_imm { func; label_after; }) ->
+        assert (Array.length arg = 0);
+        self#instrument_direct_call ~env ~func ~is_tail:true ~label_after dbg
+      | M.Iop (M.Itailcall_ind { label_after; }) ->
+        assert (Array.length arg = 1);
+        self#instrument_indirect_call ~env ~callee:arg.(0)
+          ~is_tail:true ~label_after dbg
+      | M.Iop (M.Iextcall { func; alloc = true; label_after; }) ->
+        (* N.B. No need to instrument "noalloc" external calls. *)
+        assert (Array.length arg = 0);
+        self#instrument_direct_call ~env ~func ~is_tail:false ~label_after dbg
+      | _ -> None
+
+  method private instrument_blockheader ~env ~value's_header ~dbg =
+    let instrumentation =
+      code_for_blockheader
+        ~node:(Lazy.force !spacetime_node_ident)
+        ~value's_header ~dbg
+    in
+    self#emit_expr env instrumentation
+
+  method private emit_prologue f ~node_hole ~env =
+    (* We don't need the prologue unless we inserted some instrumentation.
+       This corresponds to adding the prologue if the function contains one
+       or more call or allocation points. *)
+    if something_was_instrumented () then begin
+      let prologue_cmm =
+        code_for_function_prologue ~function_name:f.Cmm.fun_name ~node_hole
+          ~fun_dbg:f.Cmm.fun_dbg
+      in
+      disable_instrumentation <- true;
+      let node_temp_reg =
+        match self#emit_expr env prologue_cmm with
+        | None ->
+          Misc.fatal_error "Spacetime prologue instruction \
+              selection did not yield a destination register"
+        | Some node_temp_reg -> node_temp_reg
+      in
+      disable_instrumentation <- false;
+      let node = Lazy.force !spacetime_node_ident in
+      let node_reg = Selectgen.env_find node env in
+      self#insert_moves env node_temp_reg node_reg
+    end
+
+  method! emit_blockheader env n dbg =
+    if self#can_instrument () then begin
+      disable_instrumentation <- true;
+      let result = self#instrument_blockheader ~env ~value's_header:n ~dbg in
+      disable_instrumentation <- false;
+      result
+    end else begin
+      super#emit_blockheader env n dbg
+    end
+
+  method! select_allocation bytes =
+    if self#can_instrument () then begin
+      (* Leave space for a direct call point.  We cannot easily insert any
+         instrumentation code, so the fields are filled in instead by
+         [caml_spacetime_caml_garbage_collection]. *)
+      let label = Cmm.new_label () in
+      let index =
+        next_index_within_node
+          ~part_of_shape:(Mach.Direct_call_point { callee = "caml_call_gc"; })
+          ~label
+      in
+      Mach.Ialloc {
+        bytes;
+        dbginfo = [];
+        label_after_call_gc = Some label;
+        spacetime_index = index;
+      }
+    end else begin
+      super#select_allocation bytes
+    end
+
+  method! select_allocation_args env =
+    if self#can_instrument () then begin
+      let regs = Selectgen.env_find (Lazy.force !spacetime_node_ident) env in
+      match regs with
+      | [| reg |] -> [| reg |]
+      | _ -> failwith "Expected one register only for spacetime_node_ident"
+    end else begin
+      super#select_allocation_args env
+    end
+
+  method! select_checkbound () =
+    (* This follows [select_allocation], above. *)
+    if self#can_instrument () then begin
+      let label = Cmm.new_label () in
+      let index =
+        next_index_within_node
+          ~part_of_shape:(
+            Mach.Direct_call_point { callee = "caml_ml_array_bound_error"; })
+          ~label
+      in
+      Mach.Icheckbound {
+        label_after_error = Some label;
+        spacetime_index = index;
+      }
+    end else begin
+      super#select_checkbound ()
+    end
+
+  method! select_checkbound_extra_args () =
+    if self#can_instrument () then begin
+      (* This follows [select_allocation_args], above. *)
+      [Cmm.Cvar (Lazy.force !spacetime_node_ident)]
+    end else begin
+      super#select_checkbound_extra_args ()
+    end
+
+  method! initial_env () =
+    let env = super#initial_env () in
+    if Config.spacetime then
+      Selectgen.env_add (VP.create (Lazy.force !spacetime_node_ident))
+        (self#regs_for Cmm.typ_int) env
+    else
+      env
+
+  method! emit_fundecl f =
+    if Config.spacetime then begin
+      disable_instrumentation <- false;
+      let node = V.create_local "spacetime_node" in
+      reset ~spacetime_node_ident:node ~function_label:f.Cmm.fun_name
+    end;
+    super#emit_fundecl f
+
+  method! insert_prologue f ~loc_arg ~rarg ~spacetime_node_hole ~env =
+    let fun_spacetime_shape =
+      super#insert_prologue f ~loc_arg ~rarg ~spacetime_node_hole ~env
+    in
+    (* CR-soon mshinwell: add check to make sure the node size doesn't exceed
+       the chunk size of the allocator *)
+    if not Config.spacetime then fun_spacetime_shape
+    else begin
+      let node_hole, node_hole_reg =
+        match spacetime_node_hole with
+        | None -> assert false
+        | Some (node_hole, reg) -> node_hole, reg
+      in
+      self#insert_moves env [| Proc.loc_spacetime_node_hole |] node_hole_reg;
+      self#emit_prologue f ~node_hole ~env;
+      match !reverse_shape with
+      | [] -> None
+      (* N.B. We do not reverse the shape list, since the function that
+         reconstructs it (caml_spacetime_shape_table) reverses it again. *)
+      | reverse_shape -> Some reverse_shape
+    end
+end
diff --git a/asmcomp/spacetime_profiling.mli b/asmcomp/spacetime_profiling.mli
new file mode 100644
index 00000000..16c69148
--- /dev/null
+++ b/asmcomp/spacetime_profiling.mli
@@ -0,0 +1,17 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2015--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Insertion of instrumentation code for Spacetime profiling. *)
+
+class virtual instruction_selection : Selectgen.selector_generic
diff --git a/asmcomp/spill.ml b/asmcomp/spill.ml
new file mode 100644
index 00000000..da739f97
--- /dev/null
+++ b/asmcomp/spill.ml
@@ -0,0 +1,437 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Insertion of moves to suggest possible spilling / reloading points
+   before register allocation. *)
+
+open Reg
+open Mach
+
+(* We say that a register is "destroyed" if it is live across a construct
+   that potentially destroys all physical registers: function calls or
+   try...with constructs.
+
+   The "destroyed" registers must therefore reside in the stack during
+   these instructions.. We will insert spills (stores) just after they
+   are defined, and reloads just before their first use following a
+   "destroying" construct.
+
+   Instructions with more live registers than actual registers also
+   "destroy" registers: we mark as "destroyed" the registers live
+   across the instruction that haven't been used for the longest time.
+   These registers will be spilled and reloaded as described above. *)
+
+(* Association of spill registers to registers *)
+
+let spill_env = ref (Reg.Map.empty : Reg.t Reg.Map.t)
+
+let spill_reg r =
+  try
+    Reg.Map.find r !spill_env
+  with Not_found ->
+    let spill_r = Reg.create r.typ in
+    spill_r.spill <- true;
+    if not (Reg.anonymous r) then spill_r.raw_name <- r.raw_name;
+    spill_env := Reg.Map.add r spill_r !spill_env;
+    spill_r
+
+(* Record the position of last use of registers *)
+
+let use_date = ref (Reg.Map.empty : int Reg.Map.t)
+let current_date = ref 0
+
+let record_use regv =
+  for i = 0 to Array.length regv - 1 do
+    let r = regv.(i) in
+    let prev_date = try Reg.Map.find r !use_date with Not_found -> 0 in
+    if !current_date > prev_date then
+      use_date := Reg.Map.add r !current_date !use_date
+  done
+
+(* Check if the register pressure overflows the maximum pressure allowed
+   at that point. If so, spill enough registers to lower the pressure. *)
+
+let add_superpressure_regs op live_regs res_regs spilled =
+  let max_pressure = Proc.max_register_pressure op in
+  let regs = Reg.add_set_array live_regs res_regs in
+  (* Compute the pressure in each register class *)
+  let pressure = Array.make Proc.num_register_classes 0 in
+  Reg.Set.iter
+    (fun r ->
+      if Reg.Set.mem r spilled then () else begin
+        match r.loc with
+          Stack _ -> ()
+        | _ -> let c = Proc.register_class r in
+               pressure.(c) <- pressure.(c) + 1
+      end)
+    regs;
+  (* Check if pressure is exceeded for each class. *)
+  let rec check_pressure cl spilled =
+    if cl >= Proc.num_register_classes then
+      spilled
+    else if pressure.(cl) <= max_pressure.(cl) then
+      check_pressure (cl+1) spilled
+    else begin
+      (* Find the least recently used, unspilled, unallocated, live register
+         in the class *)
+      let lru_date = ref 1000000 and lru_reg = ref Reg.dummy in
+      Reg.Set.iter
+        (fun r ->
+          if Proc.register_class r = cl &&
+             not (Reg.Set.mem r spilled) &&
+             r.loc = Unknown
+          then begin
+            try
+              let d = Reg.Map.find r !use_date in
+              if d < !lru_date then begin
+                lru_date := d;
+                lru_reg := r
+              end
+            with Not_found ->                 (* Should not happen *)
+              ()
+          end)
+        live_regs;
+      if !lru_reg != Reg.dummy then begin
+        pressure.(cl) <- pressure.(cl) - 1;
+        check_pressure cl (Reg.Set.add !lru_reg spilled)
+      end else
+        (* Couldn't find any spillable register, give up for this class *)
+        check_pressure (cl+1) spilled
+    end in
+  check_pressure 0 spilled
+
+(* A-list recording what is destroyed at if-then-else points. *)
+
+let destroyed_at_fork = ref ([] : (instruction * Reg.Set.t) list)
+
+(* First pass: insert reload instructions based on an approximation of
+   what is destroyed at pressure points. *)
+
+let add_reloads regset i =
+  Reg.Set.fold
+    (fun r i -> instr_cons (Iop Ireload) [|spill_reg r|] [|r|] i)
+    regset i
+
+let reload_at_exit = ref []
+
+let find_reload_at_exit k =
+  try
+    List.assoc k !reload_at_exit
+  with
+  | Not_found -> Misc.fatal_error "Spill.find_reload_at_exit"
+
+let rec reload i before =
+  incr current_date;
+  record_use i.arg;
+  record_use i.res;
+  match i.desc with
+    Iend ->
+      (i, before)
+  | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) ->
+      (add_reloads (Reg.inter_set_array before i.arg) i,
+       Reg.Set.empty)
+  | Iop(Icall_ind _ | Icall_imm _ | Iextcall { alloc = true; }) ->
+      (* All regs live across must be spilled *)
+      let (new_next, finally) = reload i.next i.live in
+      (add_reloads (Reg.inter_set_array before i.arg)
+                   (instr_cons_debug i.desc i.arg i.res i.dbg new_next),
+       finally)
+  | Iop op ->
+      let new_before =
+        (* Quick check to see if the register pressure is below the maximum *)
+        if !Clflags.use_linscan ||
+           (Reg.Set.cardinal i.live + Array.length i.res <=
+            Proc.safe_register_pressure op)
+        then before
+        else add_superpressure_regs op i.live i.res before in
+      let after =
+        Reg.diff_set_array (Reg.diff_set_array new_before i.arg) i.res in
+      let (new_next, finally) = reload i.next after in
+      (add_reloads (Reg.inter_set_array new_before i.arg)
+                   (instr_cons_debug i.desc i.arg i.res i.dbg new_next),
+       finally)
+  | Iifthenelse(test, ifso, ifnot) ->
+      let at_fork = Reg.diff_set_array before i.arg in
+      let date_fork = !current_date in
+      let (new_ifso, after_ifso) = reload ifso at_fork in
+      let date_ifso = !current_date in
+      current_date := date_fork;
+      let (new_ifnot, after_ifnot) = reload ifnot at_fork in
+      current_date := max date_ifso !current_date;
+      let (new_next, finally) =
+        reload i.next (Reg.Set.union after_ifso after_ifnot) in
+      let new_i =
+        instr_cons (Iifthenelse(test, new_ifso, new_ifnot))
+        i.arg i.res new_next in
+      destroyed_at_fork := (new_i, at_fork) :: !destroyed_at_fork;
+      (add_reloads (Reg.inter_set_array before i.arg) new_i,
+       finally)
+  | Iswitch(index, cases) ->
+      let at_fork = Reg.diff_set_array before i.arg in
+      let date_fork = !current_date in
+      let date_join = ref 0 in
+      let after_cases = ref Reg.Set.empty in
+      let new_cases =
+        Array.map
+          (fun c ->
+            current_date := date_fork;
+            let (new_c, after_c) = reload c at_fork in
+            after_cases := Reg.Set.union !after_cases after_c;
+            date_join := max !date_join !current_date;
+            new_c)
+          cases in
+      current_date := !date_join;
+      let (new_next, finally) = reload i.next !after_cases in
+      (add_reloads (Reg.inter_set_array before i.arg)
+                   (instr_cons (Iswitch(index, new_cases))
+                               i.arg i.res new_next),
+       finally)
+  | Icatch(rec_flag, handlers, body) ->
+      let new_sets = List.map
+          (fun (nfail, _) -> nfail, ref Reg.Set.empty) handlers in
+      let previous_reload_at_exit = !reload_at_exit in
+      reload_at_exit := new_sets @ !reload_at_exit ;
+      let (new_body, after_body) = reload body before in
+      let rec fixpoint () =
+        let at_exits = List.map (fun (nfail, set) -> (nfail, !set)) new_sets in
+        let res =
+          List.map2 (fun (nfail', handler) (nfail, at_exit) ->
+              assert(nfail = nfail');
+              reload handler at_exit) handlers at_exits in
+        match rec_flag with
+        | Cmm.Nonrecursive ->
+            res
+        | Cmm.Recursive ->
+            let equal = List.for_all2 (fun (nfail', at_exit) (nfail, new_set) ->
+                assert(nfail = nfail');
+                Reg.Set.equal at_exit !new_set)
+                at_exits new_sets in
+            if equal
+            then res
+            else fixpoint ()
+      in
+      let res = fixpoint () in
+      reload_at_exit := previous_reload_at_exit;
+      let union = List.fold_left
+          (fun acc (_, after_handler) -> Reg.Set.union acc after_handler)
+          after_body res in
+      let (new_next, finally) = reload i.next union in
+      let new_handlers = List.map2
+          (fun (nfail, _) (new_handler, _) -> nfail, new_handler)
+          handlers res in
+      (instr_cons
+         (Icatch(rec_flag, new_handlers, new_body)) i.arg i.res new_next,
+       finally)
+  | Iexit nfail ->
+      let set = find_reload_at_exit nfail in
+      set := Reg.Set.union !set before;
+      (i, Reg.Set.empty)
+  | Itrywith(body, handler) ->
+      let (new_body, after_body) = reload body before in
+      (* All registers live at the beginning of the handler are destroyed,
+         except the exception bucket *)
+      let before_handler =
+        Reg.Set.remove Proc.loc_exn_bucket
+                       (Reg.add_set_array handler.live handler.arg) in
+      let (new_handler, after_handler) = reload handler before_handler in
+      let (new_next, finally) =
+        reload i.next (Reg.Set.union after_body after_handler) in
+      (instr_cons (Itrywith(new_body, new_handler)) i.arg i.res new_next,
+       finally)
+  | Iraise _ ->
+      (add_reloads (Reg.inter_set_array before i.arg) i, Reg.Set.empty)
+
+(* Second pass: add spill instructions based on what we've decided to reload.
+   That is, any register that may be reloaded in the future must be spilled
+   just after its definition. *)
+
+(*
+   As an optimization, if a register needs to be spilled in one branch of
+   a conditional but not in the other, then we spill it late on entrance
+   in the branch that needs it spilled.
+   NB: This strategy is turned off in loops, as it may prevent a spill from
+   being lifted up all the way out of the loop.
+   NB again: This strategy is also off in switch arms
+   as it generates many useless spills inside switch arms
+   NB ter: is it the same thing for catch bodies ?
+*)
+
+(* CR mshinwell for pchambart: Try to test the new algorithms for dealing
+   with Icatch. *)
+
+let spill_at_exit = ref []
+let find_spill_at_exit k =
+  try
+    let used, set = List.assoc k !spill_at_exit in
+    used := true;
+    set
+  with
+  | Not_found -> Misc.fatal_error "Spill.find_spill_at_exit"
+
+let spill_at_raise = ref Reg.Set.empty
+let inside_loop = ref false
+and inside_arm = ref false
+and inside_catch = ref false
+
+let add_spills regset i =
+  Reg.Set.fold
+    (fun r i -> instr_cons (Iop Ispill) [|r|] [|spill_reg r|] i)
+    regset i
+
+let rec spill i finally =
+  match i.desc with
+    Iend ->
+      (i, finally)
+  | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) ->
+      (i, Reg.Set.empty)
+  | Iop Ireload ->
+      let (new_next, after) = spill i.next finally in
+      let before1 = Reg.diff_set_array after i.res in
+      (instr_cons i.desc i.arg i.res new_next,
+       Reg.add_set_array before1 i.res)
+  | Iop _ ->
+      let (new_next, after) = spill i.next finally in
+      let before1 = Reg.diff_set_array after i.res in
+      let before =
+        match i.desc with
+          Iop Icall_ind _ | Iop(Icall_imm _) | Iop(Iextcall _) | Iop(Ialloc _)
+        | Iop(Iintop (Icheckbound _)) | Iop(Iintop_imm((Icheckbound _), _)) ->
+            Reg.Set.union before1 !spill_at_raise
+        | _ ->
+            before1 in
+      (instr_cons_debug i.desc i.arg i.res i.dbg
+                  (add_spills (Reg.inter_set_array after i.res) new_next),
+       before)
+  | Iifthenelse(test, ifso, ifnot) ->
+      let (new_next, at_join) = spill i.next finally in
+      let (new_ifso, before_ifso) = spill ifso at_join in
+      let (new_ifnot, before_ifnot) = spill ifnot at_join in
+      if
+        !inside_loop || !inside_arm || !inside_catch
+      then
+        (instr_cons (Iifthenelse(test, new_ifso, new_ifnot))
+                     i.arg i.res new_next,
+         Reg.Set.union before_ifso before_ifnot)
+      else begin
+        let destroyed = List.assq i !destroyed_at_fork in
+        let spill_ifso_branch =
+          Reg.Set.diff (Reg.Set.diff before_ifso before_ifnot) destroyed
+        and spill_ifnot_branch =
+          Reg.Set.diff (Reg.Set.diff before_ifnot before_ifso) destroyed in
+        (instr_cons
+            (Iifthenelse(test, add_spills spill_ifso_branch new_ifso,
+                               add_spills spill_ifnot_branch new_ifnot))
+            i.arg i.res new_next,
+         Reg.Set.diff (Reg.Set.diff (Reg.Set.union before_ifso before_ifnot)
+                                    spill_ifso_branch)
+                       spill_ifnot_branch)
+      end
+  | Iswitch(index, cases) ->
+      let (new_next, at_join) = spill i.next finally in
+      let saved_inside_arm = !inside_arm in
+      inside_arm := true ;
+      let before = ref Reg.Set.empty in
+      let new_cases =
+        Array.map
+          (fun c ->
+            let (new_c, before_c) = spill c at_join in
+            before := Reg.Set.union !before before_c;
+            new_c)
+          cases in
+      inside_arm := saved_inside_arm ;
+      (instr_cons (Iswitch(index, new_cases)) i.arg i.res new_next,
+       !before)
+  | Icatch(rec_flag, handlers, body) ->
+      let (new_next, at_join) = spill i.next finally in
+      let saved_inside_catch = !inside_catch in
+      inside_catch := true ;
+      let previous_spill_at_exit = !spill_at_exit in
+      let spill_at_exit_add at_exits = List.map2
+          (fun (nfail,_) at_exit -> nfail, (ref false, at_exit))
+          handlers at_exits
+      in
+      let rec fixpoint at_exits =
+        let spill_at_exit_add = spill_at_exit_add at_exits in
+        spill_at_exit := spill_at_exit_add @ !spill_at_exit;
+        let res =
+          List.map (fun (_, handler) -> spill handler at_join) handlers
+        in
+        spill_at_exit := previous_spill_at_exit;
+        match rec_flag with
+        | Cmm.Nonrecursive ->
+            res
+        | Cmm.Recursive ->
+            let equal =
+              List.for_all2
+                (fun (_new_handler, new_at_exit) (_, (used, at_exit)) ->
+                   Reg.Set.equal at_exit new_at_exit || not !used)
+                res spill_at_exit_add in
+            if equal
+            then res
+            else fixpoint (List.map snd res)
+      in
+      let res = fixpoint (List.map (fun _ -> Reg.Set.empty) handlers) in
+      inside_catch := saved_inside_catch ;
+      let spill_at_exit_add = spill_at_exit_add (List.map snd res) in
+      spill_at_exit := spill_at_exit_add @ !spill_at_exit;
+      let (new_body, before) = spill body at_join in
+      spill_at_exit := previous_spill_at_exit;
+      let new_handlers = List.map2
+          (fun (nfail, _) (handler, _) -> nfail, handler)
+          handlers res in
+      (instr_cons (Icatch(rec_flag, new_handlers, new_body))
+         i.arg i.res new_next,
+       before)
+  | Iexit nfail ->
+      (i, find_spill_at_exit nfail)
+  | Itrywith(body, handler) ->
+      let (new_next, at_join) = spill i.next finally in
+      let (new_handler, before_handler) = spill handler at_join in
+      let saved_spill_at_raise = !spill_at_raise in
+      spill_at_raise := before_handler;
+      let (new_body, before_body) = spill body at_join in
+      spill_at_raise := saved_spill_at_raise;
+      (instr_cons (Itrywith(new_body, new_handler)) i.arg i.res new_next,
+       before_body)
+  | Iraise _ ->
+      (i, !spill_at_raise)
+
+(* Entry point *)
+
+let reset () =
+  spill_env := Reg.Map.empty;
+  use_date := Reg.Map.empty;
+  current_date := 0;
+  destroyed_at_fork := []
+
+let fundecl f =
+  reset ();
+
+  let (body1, _) = reload f.fun_body Reg.Set.empty in
+  let (body2, tospill_at_entry) = spill body1 Reg.Set.empty in
+  let new_body =
+    add_spills (Reg.inter_set_array tospill_at_entry f.fun_args) body2 in
+  spill_env := Reg.Map.empty;
+  use_date := Reg.Map.empty;
+  destroyed_at_fork := [];
+  { fun_name = f.fun_name;
+    fun_args = f.fun_args;
+    fun_body = new_body;
+    fun_codegen_options = f.fun_codegen_options;
+    fun_dbg  = f.fun_dbg;
+    fun_spacetime_shape = f.fun_spacetime_shape;
+    fun_num_stack_slots = f.fun_num_stack_slots;
+    fun_contains_calls = f.fun_contains_calls;
+  }
diff --git a/asmcomp/spill.mli b/asmcomp/spill.mli
new file mode 100644
index 00000000..cb1917e4
--- /dev/null
+++ b/asmcomp/spill.mli
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Insertion of moves to suggest possible spilling / reloading points
+   before register allocation. *)
+
+val fundecl: Mach.fundecl -> Mach.fundecl
+val reset : unit -> unit
diff --git a/asmcomp/split.ml b/asmcomp/split.ml
new file mode 100644
index 00000000..87c9c71f
--- /dev/null
+++ b/asmcomp/split.ml
@@ -0,0 +1,225 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Renaming of registers at reload points to split live ranges. *)
+
+open Reg
+open Mach
+
+(* Substitutions are represented by register maps *)
+
+type subst = Reg.t Reg.Map.t
+
+let subst_reg r (sub : subst) =
+  try
+    Reg.Map.find r sub
+  with Not_found ->
+    r
+
+let subst_regs rv sub =
+  match sub with
+    None -> rv
+  | Some s ->
+      let n = Array.length rv in
+      let nv = Array.make n Reg.dummy in
+      for i = 0 to n-1 do nv.(i) <- subst_reg rv.(i) s done;
+      nv
+
+(* We maintain equivalence classes of registers using a standard
+   union-find algorithm *)
+
+let equiv_classes = ref (Reg.Map.empty : Reg.t Reg.Map.t)
+
+let rec repres_reg r =
+  try
+    repres_reg(Reg.Map.find r !equiv_classes)
+  with Not_found ->
+    r
+
+let repres_regs rv =
+  let n = Array.length rv in
+  for i = 0 to n-1 do rv.(i) <- repres_reg rv.(i) done
+
+(* Identify two registers.
+   The second register is chosen as canonical representative. *)
+
+let identify r1 r2 =
+  let repres1 = repres_reg r1 in
+  let repres2 = repres_reg r2 in
+  if repres1.stamp = repres2.stamp then () else begin
+    equiv_classes := Reg.Map.add repres1 repres2 !equiv_classes
+  end
+
+(* Identify the image of a register by two substitutions.
+   Be careful to use the original register as canonical representative
+   in case it does not belong to the domain of one of the substitutions. *)
+
+let identify_sub sub1 sub2 reg =
+  try
+    let r1 = Reg.Map.find reg sub1 in
+    try
+      let r2 = Reg.Map.find reg sub2 in
+      identify r1 r2
+    with Not_found ->
+      identify r1 reg
+  with Not_found ->
+    try
+      let r2 = Reg.Map.find reg sub2 in
+      identify r2 reg
+    with Not_found ->
+      ()
+
+(* Identify registers so that the two substitutions agree on the
+   registers live before the given instruction. *)
+
+let merge_substs sub1 sub2 i =
+  match (sub1, sub2) with
+    (None, None) -> None
+  | (Some _, None) -> sub1
+  | (None, Some _) -> sub2
+  | (Some s1, Some s2) ->
+      Reg.Set.iter (identify_sub s1 s2) (Reg.add_set_array i.live i.arg);
+      sub1
+
+(* Same, for N substitutions *)
+
+let merge_subst_array subv instr =
+  let rec find_one_subst i =
+    if i >= Array.length subv then None else begin
+      match subv.(i) with
+        None -> find_one_subst (i+1)
+      | Some si as sub ->
+          for j = i+1 to Array.length subv - 1 do
+            match subv.(j) with
+              None -> ()
+            | Some sj ->
+                Reg.Set.iter (identify_sub si sj)
+                             (Reg.add_set_array instr.live instr.arg)
+          done;
+          sub
+    end in
+  find_one_subst 0
+
+(* First pass: rename registers at reload points *)
+
+let exit_subst = ref []
+
+let find_exit_subst k =
+  try
+    List.assoc k !exit_subst with
+  | Not_found -> Misc.fatal_error "Split.find_exit_subst"
+
+let rec rename i sub =
+  match i.desc with
+    Iend ->
+      (i, sub)
+  | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) ->
+      (instr_cons_debug i.desc (subst_regs i.arg sub) [||] i.dbg i.next,
+       None)
+  | Iop Ireload when i.res.(0).loc = Unknown ->
+      begin match sub with
+        None -> rename i.next sub
+      | Some s ->
+          let oldr = i.res.(0) in
+          let newr = Reg.clone i.res.(0) in
+          let (new_next, sub_next) =
+            rename i.next (Some(Reg.Map.add oldr newr s)) in
+          (instr_cons i.desc i.arg [|newr|] new_next,
+           sub_next)
+      end
+  | Iop _ ->
+      let (new_next, sub_next) = rename i.next sub in
+      (instr_cons_debug i.desc (subst_regs i.arg sub) (subst_regs i.res sub)
+                        i.dbg new_next,
+       sub_next)
+  | Iifthenelse(tst, ifso, ifnot) ->
+      let (new_ifso, sub_ifso) = rename ifso sub in
+      let (new_ifnot, sub_ifnot) = rename ifnot sub in
+      let (new_next, sub_next) =
+        rename i.next (merge_substs sub_ifso sub_ifnot i.next) in
+      (instr_cons (Iifthenelse(tst, new_ifso, new_ifnot))
+                  (subst_regs i.arg sub) [||] new_next,
+       sub_next)
+  | Iswitch(index, cases) ->
+      let new_sub_cases = Array.map (fun c -> rename c sub) cases in
+      let sub_merge =
+        merge_subst_array (Array.map (fun (_n, s) -> s) new_sub_cases) i.next in
+      let (new_next, sub_next) = rename i.next sub_merge in
+      (instr_cons (Iswitch(index, Array.map (fun (n, _s) -> n) new_sub_cases))
+                  (subst_regs i.arg sub) [||] new_next,
+       sub_next)
+  | Icatch(rec_flag, handlers, body) ->
+      let new_subst = List.map (fun (nfail, _) -> nfail, ref None)
+          handlers in
+      let previous_exit_subst = !exit_subst in
+      exit_subst := new_subst @ !exit_subst;
+      let (new_body, sub_body) = rename body sub in
+      let res =
+        List.map2 (fun (_, handler) (_, new_subst) -> rename handler !new_subst)
+          handlers new_subst in
+      exit_subst := previous_exit_subst;
+      let merged_subst =
+        List.fold_left (fun acc (_, sub_handler) ->
+            merge_substs acc sub_handler i.next)
+          sub_body res in
+      let (new_next, sub_next) = rename i.next merged_subst in
+      let new_handlers = List.map2 (fun (nfail, _) (handler, _) ->
+          (nfail, handler)) handlers res in
+      (instr_cons
+         (Icatch(rec_flag, new_handlers, new_body)) [||] [||] new_next,
+       sub_next)
+  | Iexit nfail ->
+      let r = find_exit_subst nfail in
+      r := merge_substs !r sub i;
+      (i, None)
+  | Itrywith(body, handler) ->
+      let (new_body, sub_body) = rename body sub in
+      let (new_handler, sub_handler) = rename handler sub in
+      let (new_next, sub_next) =
+        rename i.next (merge_substs sub_body sub_handler i.next) in
+      (instr_cons (Itrywith(new_body, new_handler)) [||] [||] new_next,
+       sub_next)
+  | Iraise k ->
+      (instr_cons_debug (Iraise k) (subst_regs i.arg sub) [||] i.dbg i.next,
+       None)
+
+(* Second pass: replace registers by their final representatives *)
+
+let set_repres i =
+  instr_iter (fun i -> repres_regs i.arg; repres_regs i.res) i
+
+(* Entry point *)
+
+let reset () =
+  equiv_classes := Reg.Map.empty;
+  exit_subst := []
+
+let fundecl f =
+  reset ();
+
+  let new_args = Array.copy f.fun_args in
+  let (new_body, _sub_body) = rename f.fun_body (Some Reg.Map.empty) in
+  repres_regs new_args;
+  set_repres new_body;
+  equiv_classes := Reg.Map.empty;
+  { fun_name = f.fun_name;
+    fun_args = new_args;
+    fun_body = new_body;
+    fun_codegen_options = f.fun_codegen_options;
+    fun_dbg  = f.fun_dbg;
+    fun_spacetime_shape = f.fun_spacetime_shape;
+    fun_num_stack_slots = f.fun_num_stack_slots;
+    fun_contains_calls = f.fun_contains_calls;
+  }
diff --git a/asmcomp/split.mli b/asmcomp/split.mli
new file mode 100644
index 00000000..ed1dea54
--- /dev/null
+++ b/asmcomp/split.mli
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Renaming of registers at reload points to split live ranges. *)
+
+val fundecl: Mach.fundecl -> Mach.fundecl
+
+val reset : unit -> unit
diff --git a/asmcomp/strmatch.ml b/asmcomp/strmatch.ml
new file mode 100644
index 00000000..d71a5136
--- /dev/null
+++ b/asmcomp/strmatch.ml
@@ -0,0 +1,397 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Translation of string matching from closed lambda to C-- *)
+
+open Lambda
+open Cmm
+
+module V = Backend_var
+module VP = Backend_var.With_provenance
+
+module type I = sig
+  val string_block_length : Cmm.expression -> Cmm.expression
+  val transl_switch :
+      Debuginfo.t -> Cmm.expression -> int -> int ->
+        (int * Cmm.expression) list -> Cmm.expression ->
+          Cmm.expression
+end
+
+module Make(I:I) = struct
+
+(* Debug *)
+
+  let dbg = false
+
+  let mask =
+    let open Nativeint in
+    sub (shift_left one 8) one
+
+  let pat_as_string p =
+    let rec digits k n p =
+      if n <= 0 then k
+      else
+        let d = Nativeint.to_int (Nativeint.logand mask p) in
+        let d = Char.escaped (Char.chr d) in
+        digits (d::k) (n-1) (Nativeint.shift_right_logical p  8) in
+    let ds = digits [] Arch.size_addr p in
+    let ds =
+      if Arch.big_endian then ds else List.rev ds in
+    String.concat "" ds
+
+  let do_pp_cases chan cases =
+    List.iter
+      (fun (ps,_) ->
+        Printf.fprintf chan "  [%s]\n"
+          (String.concat "; " (List.map pat_as_string ps)))
+      cases
+
+  let pp_cases chan tag cases =
+    Printf.eprintf "%s:\n" tag ;
+    do_pp_cases chan cases
+
+  let pp_match chan tag idxs cases =
+    Printf.eprintf
+      "%s: idx=[%s]\n" tag
+      (String.concat "; " (List.map Int.to_string idxs)) ;
+    do_pp_cases chan cases
+
+(* Utilities *)
+
+  let gen_cell_id () = V.create_local "cell"
+  let gen_size_id () = V.create_local "size"
+
+  let mk_let_cell id str ind body =
+    let dbg = Debuginfo.none in
+    let cell =
+      Cop(Cload (Word_int, Asttypes.Mutable),
+        [Cop(Cadda,[str;Cconst_int(Arch.size_int*ind, dbg)], dbg)],
+        dbg) in
+    Clet(id, cell, body)
+
+  let mk_let_size id str body =
+    let size = I.string_block_length str in
+    Clet(id, size, body)
+
+  let mk_cmp_gen cmp_op id nat ifso ifnot =
+    let dbg = Debuginfo.none in
+    let test =
+      Cop (Ccmpi cmp_op, [ Cvar id; Cconst_natpointer (nat, dbg) ], dbg)
+    in
+    Cifthenelse (test, dbg, ifso, dbg, ifnot, dbg)
+
+  let mk_lt = mk_cmp_gen Clt
+  let mk_eq = mk_cmp_gen Ceq
+
+  module IntArg =
+    struct
+      type t = int
+      let compare (x:int) (y:int) =
+        if x < y then -1
+        else if x > y then 1
+        else 0
+    end
+
+  let interval m0 n =
+    let rec do_rec m =
+      if m >= n then []
+      else m::do_rec (m+1) in
+    do_rec m0
+
+
+(*****************************************************)
+(* Compile strings to a lists of words [native ints] *)
+(*****************************************************)
+
+  let pat_of_string str =
+    let len = String.length str in
+    let n = len / Arch.size_addr + 1 in
+    let get_byte i =
+      if i < len then int_of_char str.[i]
+      else if i < n * Arch.size_addr - 1 then 0
+      else n * Arch.size_addr - 1 - len in
+    let mk_word ind =
+      let w = ref 0n in
+      let imin = ind * Arch.size_addr
+      and imax = (ind + 1) * Arch.size_addr - 1 in
+      if Arch.big_endian then
+        for i = imin to imax do
+          w := Nativeint.logor (Nativeint.shift_left !w 8)
+              (Nativeint.of_int (get_byte i));
+        done
+      else
+        for i = imax downto imin do
+          w := Nativeint.logor (Nativeint.shift_left !w 8)
+              (Nativeint.of_int (get_byte i));
+        done;
+      !w in
+    let rec mk_words ind  =
+      if ind >= n then []
+      else mk_word ind::mk_words (ind+1) in
+    mk_words 0
+
+(*****************************)
+(* Discriminating heuristics *)
+(*****************************)
+
+  module IntSet = Set.Make(IntArg)
+  module NativeSet = Set.Make(Nativeint)
+
+  let rec add_one sets ps = match sets,ps with
+  | [],[] -> []
+  | set::sets,p::ps ->
+      let sets = add_one sets ps in
+      NativeSet.add p set::sets
+  | _,_ -> assert false
+
+  let count_arities cases = match cases with
+  | [] -> assert false
+  | (ps,_)::_ ->
+      let sets =
+        List.fold_left
+          (fun sets (ps,_) -> add_one sets ps)
+          (List.map (fun _ -> NativeSet.empty) ps) cases in
+      List.map NativeSet.cardinal sets
+
+  let count_arities_first cases =
+    let set =
+      List.fold_left
+        (fun set case -> match case with
+        | (p::_,_) -> NativeSet.add p set
+        | _ -> assert false)
+        NativeSet.empty cases in
+    NativeSet.cardinal set
+
+  let count_arities_length cases =
+    let set =
+      List.fold_left
+        (fun set (ps,_) -> IntSet.add (List.length ps) set)
+        IntSet.empty cases in
+    IntSet.cardinal set
+
+  let best_col =
+    let rec do_rec kbest best k = function
+      | [] -> kbest
+      | x::xs ->
+          if x < best then
+            do_rec k x (k+1) xs
+          else
+            do_rec kbest best (k+1) xs in
+    let smallest = do_rec (-1) max_int 0 in
+    fun cases ->
+      let ars = count_arities cases in
+      smallest ars
+
+  let swap_list =
+    let rec do_rec k xs = match xs with
+    | [] -> assert false
+    | x::xs ->
+        if k <= 0 then [],x,xs
+        else
+          let xs,mid,ys = do_rec (k-1) xs in
+          x::xs,mid,ys in
+    fun k xs ->
+      let xs,x,ys = do_rec  k xs in
+      x::xs @ ys
+
+  let swap k idxs cases =
+    if k = 0 then idxs,cases
+    else
+      let idxs = swap_list k idxs
+      and cases =
+        List.map
+          (fun (ps,act) -> swap_list k ps,act)
+          cases in
+      if dbg then begin
+        pp_match stderr "SWAP" idxs cases
+      end ;
+      idxs,cases
+
+  let best_first idxs cases = match idxs with
+  | []|[_] -> idxs,cases (* optimisation: one column only *)
+  | _ ->
+      let k = best_col cases in
+      swap k idxs cases
+
+(************************************)
+(* Divide according to first column *)
+(************************************)
+
+  module Divide(O:Set.OrderedType) = struct
+
+    module OMap = Map.Make(O)
+
+    let divide cases =
+      let env =
+        List.fold_left
+          (fun env (p,psact) ->
+            let old =
+              try OMap.find p env
+              with Not_found -> [] in
+            OMap.add p ((psact)::old) env)
+          OMap.empty cases in
+      let r =  OMap.fold (fun key v k -> (key,v)::k) env [] in
+      List.rev r (* Now sorted *)
+  end
+
+(***************)
+(* Compilation *)
+(***************)
+
+(* Group by cell *)
+
+    module DivideNative = Divide(Nativeint)
+
+    let by_cell cases =
+      DivideNative.divide
+        (List.map
+           (fun case -> match case with
+           | (p::ps),act -> p,(ps,act)
+           | [],_ -> assert false)
+           cases)
+
+(* Split into two halves *)
+
+    let rec do_split idx env = match env with
+    | [] -> assert false
+    | (midkey,_ as x)::rem ->
+        if idx <= 0 then [],midkey,env
+        else
+          let lt,midkey,ge = do_split (idx-1) rem in
+          x::lt,midkey,ge
+
+    let split_env len env = do_split (len/2) env
+
+(* Switch according to one cell *)
+
+(*
+  Emit the switch, here as a comparison tree.
+  Argument compile_rec is to be called to compile the rest of patterns,
+  as match_on_cell can be called in two different contexts :
+  from do_compile_pats and top_compile below.
+ *)
+    let match_oncell compile_rec str default idx env =
+      let id = gen_cell_id () in
+      let rec comp_rec env =
+        let len = List.length env in
+        if len <= 3 then
+          List.fold_right
+            (fun (key,cases) ifnot ->
+              mk_eq id key
+                (compile_rec str default cases)
+              ifnot)
+            env default
+        else
+          let lt,midkey,ge = split_env len env in
+          mk_lt id midkey (comp_rec lt) (comp_rec ge) in
+      mk_let_cell (VP.create id) str idx (comp_rec env)
+
+(*
+  Recursive 'list of cells' compile function:
+  - choose the matched cell and switch on it
+  - notice: patterns (and idx) all have the same length
+ *)
+
+    let rec do_compile_pats idxs str default cases =
+      if dbg then begin
+        pp_match stderr "COMPILE" idxs cases
+      end ;
+      match idxs with
+      | [] ->
+          begin match cases with
+          | [] -> default
+          | (_,e)::_ -> e
+          end
+      | _::_ ->
+          let idxs,cases = best_first idxs cases in
+          begin match idxs with
+          | [] -> assert false
+          | idx::idxs ->
+              match_oncell
+                (do_compile_pats idxs) str default idx (by_cell cases)
+          end
+
+
+(* Group by size *)
+
+    module DivideInt = Divide(IntArg)
+
+
+    let by_size cases =
+      DivideInt.divide
+        (List.map
+           (fun (ps,_ as case) -> List.length ps,case)
+           cases)
+(*
+  Switch according to pattern size
+  Argument from_ind is the starting index, it can be zero
+  or one (when the switch on the cell 0 has already been performed.
+  In that latter case pattern len is string length-1 and is corrected.
+ *)
+
+    let compile_by_size dbg from_ind str default cases =
+      let size_cases =
+        List.map
+          (fun (len,cases) ->
+            let len = len+from_ind in
+            let act =
+              do_compile_pats
+                (interval from_ind len)
+                str default  cases in
+            (len,act))
+          (by_size cases) in
+      let id = gen_size_id () in
+      let switch = I.transl_switch dbg (Cvar id) 1 max_int size_cases default in
+      mk_let_size (VP.create id) str switch
+
+(*
+  Compilation entry point: we choose to switch
+  either on size or on first cell, using the
+  'least discriminant' heuristics.
+ *)
+    let top_compile debuginfo str default cases =
+      let a_len = count_arities_length cases
+      and a_fst = count_arities_first cases in
+      if a_len <= a_fst then begin
+        if dbg then pp_cases stderr "SIZE" cases ;
+        compile_by_size debuginfo 0 str default cases
+      end else begin
+        if dbg then pp_cases stderr "FIRST COL" cases ;
+        let compile_size_rest str default cases =
+          compile_by_size debuginfo 1 str default cases in
+        match_oncell compile_size_rest str default 0 (by_cell cases)
+      end
+
+(* Module entry point *)
+
+    let catch dbg arg k = match arg with
+    | Cexit (_e,[]) ->  k arg
+    | _ ->
+        let e =  next_raise_count () in
+        ccatch (e,[],k (Cexit (e,[])),arg,dbg)
+
+    let compile dbg str default cases =
+(* We do not attempt to really optimise default=None *)
+      let cases,default = match cases,default with
+      | (_,e)::cases,None
+      | cases,Some e -> cases,e
+      | [],None -> assert false in
+      let cases =
+        List.rev_map
+          (fun (s,act) -> pat_of_string s,act)
+          cases in
+      catch dbg default (fun default -> top_compile dbg str default cases)
+
+  end
diff --git a/asmcomp/strmatch.mli b/asmcomp/strmatch.mli
new file mode 100644
index 00000000..69f29896
--- /dev/null
+++ b/asmcomp/strmatch.mli
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Translation of string matching from closed lambda to C-- *)
+
+module type I = sig
+  val string_block_length : Cmm.expression -> Cmm.expression
+  val transl_switch :
+      Debuginfo.t -> Cmm.expression -> int -> int ->
+        (int * Cmm.expression) list -> Cmm.expression ->
+          Cmm.expression
+end
+
+module Make(_:I) : sig
+  (* Compile stringswitch (arg,cases,d)
+     Note: cases should not contain string duplicates *)
+  val compile : Debuginfo.t -> Cmm.expression (* arg *)
+    -> Cmm.expression option (* d *) ->
+    (string * Cmm.expression) list (* cases *)-> Cmm.expression
+end
diff --git a/asmcomp/x86_ast.mli b/asmcomp/x86_ast.mli
new file mode 100644
index 00000000..96d87beb
--- /dev/null
+++ b/asmcomp/x86_ast.mli
@@ -0,0 +1,219 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          Fabrice Le Fessant, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Structured representation of Intel assembly language (32 and 64 bit). *)
+
+type condition =
+  | L | GE     (* signed comparisons: less/greater *)
+  | LE | G
+  | B | AE     (* unsigned comparisons: below/above *)
+  | BE | A
+  | E | NE     (* equal *)
+  | O | NO     (* overflow *)
+  | S | NS     (* sign *)
+  | P | NP     (* parity *)
+
+type rounding =
+  | RoundUp
+  | RoundDown
+  | RoundNearest
+  | RoundTruncate
+
+type constant =
+  | Const of int64
+  | ConstThis
+  | ConstLabel of string
+  | ConstAdd of constant * constant
+  | ConstSub of constant * constant
+
+(* data_type is used mainly on memory addressing to specify
+   the size of the addressed memory chunk.  It is directly
+   used by the MASM emitter and indirectly by the GAS emitter
+   to infer the instruction suffix. *)
+
+type data_type =
+  | NONE
+  | REAL4 | REAL8 (* floating point values *)
+  | BYTE | WORD | DWORD | QWORD | OWORD (* integer values *)
+  | NEAR | PROC
+
+type reg64 =
+  | RAX | RBX | RCX | RDX | RSP | RBP | RSI | RDI
+  | R8 | R9 | R10 | R11 | R12 | R13 | R14 | R15
+
+type reg8h =
+  | AH | BH | CH | DH
+
+
+type registerf = XMM of int | TOS | ST of int
+
+type arch = X64 | X86
+
+type addr =
+  {
+    arch: arch;
+    typ: data_type;
+    idx: reg64;
+    scale: int;
+    base: reg64 option;
+    sym: string option;
+    displ: int;
+  }
+  (** Addressing modes:
+      displ + sym + base + idx * scale
+      (if scale = 0, idx is ignored and base must be None)
+  *)
+
+type arg =
+  | Imm of int64
+  (** Operand is an immediate constant integer *)
+
+  | Sym of  string
+  (** Address of a symbol (absolute address except for call/jmp target
+      where it is interpreted as a relative displacement *)
+
+  | Reg8L of reg64
+  | Reg8H of reg8h
+  | Reg16 of reg64
+  | Reg32 of reg64
+  | Reg64 of reg64
+  | Regf of registerf
+
+  | Mem of addr
+  | Mem64_RIP of data_type * string * int
+
+type instruction =
+  | ADD of arg * arg
+  | ADDSD of arg * arg
+  | AND of arg * arg
+  | ANDPD of arg * arg
+  | BSWAP of arg
+  | CALL of arg
+  | CDQ
+  | CMOV of condition * arg * arg
+  | CMP of arg * arg
+  | COMISD of arg * arg
+  | CQO
+  | CVTSD2SI of arg * arg
+  | CVTSD2SS of arg * arg
+  | CVTSI2SD of arg * arg
+  | CVTSS2SD of arg * arg
+  | CVTTSD2SI of arg * arg
+  | DEC of arg
+  | DIVSD of arg * arg
+  | FABS
+  | FADD of arg
+  | FADDP of arg * arg
+  | FCHS
+  | FCOMP of arg
+  | FCOMPP
+  | FCOS
+  | FDIV of arg
+  | FDIVP of arg * arg
+  | FDIVR of arg
+  | FDIVRP of arg * arg
+  | FILD of arg
+  | FISTP of arg
+  | FLD of arg
+  | FLD1
+  | FLDCW of arg
+  | FLDLG2
+  | FLDLN2
+  | FLDZ
+  | FMUL of arg
+  | FMULP of arg * arg
+  | FNSTCW of arg
+  | FNSTSW of arg
+  | FPATAN
+  | FPTAN
+  | FSIN
+  | FSQRT
+  | FSTP of arg
+  | FSUB of arg
+  | FSUBP of arg * arg
+  | FSUBR of arg
+  | FSUBRP of arg * arg
+  | FXCH of arg
+  | FYL2X
+  | HLT
+  | IDIV of arg
+  | IMUL of arg * arg option
+  | INC of arg
+  | J of condition * arg
+  | JMP of arg
+  | LEA of arg * arg
+  | LEAVE
+  | MOV of arg * arg
+  | MOVAPD of arg * arg
+  | MOVLPD of arg * arg
+  | MOVSD of arg * arg
+  | MOVSS of arg * arg
+  | MOVSX of arg * arg
+  | MOVSXD of arg * arg
+  | MOVZX of arg * arg
+  | MULSD of arg * arg
+  | NEG of arg
+  | NOP
+  | OR of arg * arg
+  | POP of arg
+  | PUSH of arg
+  | RET
+  | ROUNDSD of rounding * arg * arg
+  | SAL of arg * arg
+  | SAR of arg * arg
+  | SET of condition * arg
+  | SHR of arg * arg
+  | SQRTSD of arg * arg
+  | SUB of arg * arg
+  | SUBSD of arg * arg
+  | TEST of arg * arg
+  | UCOMISD of arg * arg
+  | XCHG of arg * arg
+  | XOR of arg * arg
+  | XORPD of arg * arg
+
+type asm_line =
+  | Ins of instruction
+
+  | Align of bool * int
+  | Byte of constant
+  | Bytes of string
+  | Comment of string
+  | Global of string
+  | Long of constant
+  | NewLabel of string * data_type
+  | Quad of constant
+  | Section of string list * string option * string list
+  | Space of int
+  | Word of constant
+
+  (* masm only (the gas emitter will fail on them) *)
+  | External of string * data_type
+  | Mode386
+  | Model of string
+
+  (* gas only (the masm emitter will fail on them) *)
+  | Cfi_adjust_cfa_offset of int
+  | Cfi_endproc
+  | Cfi_startproc
+  | File of int * string (* (file_num, file_name) *)
+  | Indirect_symbol of string
+  | Loc of int * int * int (* (file_num, line, col) *)
+  | Private_extern of string
+  | Set of string * constant
+  | Size of string * constant
+  | Type of string * string
+
+type asm_program = asm_line list
diff --git a/asmcomp/x86_dsl.ml b/asmcomp/x86_dsl.ml
new file mode 100644
index 00000000..e647f66c
--- /dev/null
+++ b/asmcomp/x86_dsl.ml
@@ -0,0 +1,199 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*         Fabrice Le Fessant, projet Gallium, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Helpers for Intel code generators *)
+
+(* The DSL* modules expose functions to emit x86/x86_64 instructions
+   using a syntax close to AT&T (in particular, arguments are reversed compared
+   to the official Intel syntax).
+
+   Some notes:
+
+     - Unary floating point instructions such as fadd/fmul/fstp/fld/etc.
+       come with a single version supporting both the single and double
+       precision instructions.  (As with Intel syntax.)
+
+     - A legacy bug in GAS:
+   https://sourceware.org/binutils/docs-2.22/as/i386_002dBugs.html#i386_002dBugs
+       is not replicated here.  It is managed by X86_gas.
+*)
+
+
+open X86_ast
+open X86_proc
+
+let sym s = Sym s
+
+let nat n = Imm (Int64.of_nativeint n)
+let int n = Imm (Int64.of_int n)
+
+let const_32 n = Const (Int64.of_int32 n)
+let const_nat n = Const (Int64.of_nativeint n)
+let const n = Const (Int64.of_int n)
+
+let al  = Reg8L RAX
+let ah  = Reg8H AH
+let cl  = Reg8L RCX
+let ax  = Reg16 RAX
+let rax = Reg64 RAX
+let r10 = Reg64 R10
+let r11 = Reg64 R11
+let r13 = Reg64 R13
+let r14 = Reg64 R14
+let r15 = Reg64 R15
+let rsp = Reg64 RSP
+let rbp = Reg64 RBP
+let xmm15 = Regf (XMM 15)
+let eax = Reg32 RAX
+let ebx = Reg32 RBX
+let ecx = Reg32 RCX
+let edx = Reg32 RDX
+let ebp = Reg32 RBP
+let esp = Reg32 RSP
+let st0 = Regf (ST 0)
+let st1 = Regf (ST 1)
+
+let mem32 typ ?(scale = 1) ?base ?sym displ idx =
+  assert(scale >= 0);
+  Mem {arch = X86; typ; idx; scale; base; sym; displ}
+
+let mem64 typ ?(scale = 1) ?base ?sym displ idx =
+  assert(scale > 0);
+  Mem {arch = X64; typ; idx; scale; base; sym; displ}
+
+let mem64_rip typ ?(ofs = 0) s =
+  Mem64_RIP (typ, s, ofs)
+
+module D = struct
+  let section segment flags args = directive (Section (segment, flags, args))
+  let align n = directive (Align (false, n))
+  let byte n = directive (Byte n)
+  let bytes s = directive (Bytes s)
+  let cfi_adjust_cfa_offset n = directive (Cfi_adjust_cfa_offset n)
+  let cfi_endproc () = directive Cfi_endproc
+  let cfi_startproc () = directive Cfi_startproc
+  let comment s = directive (Comment s)
+  let data () = section [ ".data" ] None []
+  let extrn s ptr = directive (External (s, ptr))
+  let file ~file_num ~file_name = directive (File (file_num, file_name))
+  let global s = directive (Global s)
+  let indirect_symbol s = directive (Indirect_symbol s)
+  let label ?(typ = NONE) s = directive (NewLabel (s, typ))
+  let loc ~file_num ~line ~col = directive (Loc (file_num, line, col))
+  let long cst = directive (Long cst)
+  let mode386 () = directive Mode386
+  let model name = directive (Model name)
+  let private_extern s = directive (Private_extern s)
+  let qword cst = directive (Quad cst)
+  let setvar (x, y) = directive (Set (x, y))
+  let size name cst = directive (Size (name, cst))
+  let space n = directive (Space n)
+  let text () = section [ ".text" ] None []
+  let type_ name typ = directive (Type (name, typ))
+  let word cst = directive (Word cst)
+end
+
+module I = struct
+  let add x y = emit (ADD (x, y))
+  let addsd x y = emit (ADDSD (x, y))
+  let and_ x y= emit (AND (x, y))
+  let andpd x y = emit (ANDPD (x, y))
+  let bswap x = emit (BSWAP x)
+  let call x = emit (CALL x)
+  let cdq () = emit CDQ
+  let cmp x y = emit (CMP (x, y))
+  let comisd x y = emit (COMISD (x, y))
+  let cqo () = emit CQO
+  let cvtsd2ss x y = emit (CVTSD2SS (x, y))
+  let cvtsi2sd x y = emit (CVTSI2SD (x, y))
+  let cvtss2sd x y = emit (CVTSS2SD (x, y))
+  let cvttsd2si x y = emit (CVTTSD2SI (x, y))
+  let dec x = emit (DEC x)
+  let divsd x y = emit (DIVSD (x, y))
+  let fabs () = emit FABS
+  let fadd x = emit (FADD x)
+  let faddp x y = emit (FADDP (x, y))
+  let fchs () = emit FCHS
+  let fcomp x = emit (FCOMP x)
+  let fcompp () = emit FCOMPP
+  let fcos () = emit FCOS
+  let fdiv x = emit (FDIV x)
+  let fdivp x y = emit (FDIVP (x, y))
+  let fdivr x = emit (FDIVR x)
+  let fdivrp x y = emit (FDIVRP (x, y))
+  let fild x = emit (FILD x)
+  let fistp x = emit (FISTP x)
+  let fld x = emit (FLD x)
+  let fld1 () = emit FLD1
+  let fldcw x = emit (FLDCW x)
+  let fldlg2 () = emit FLDLG2
+  let fldln2 () = emit FLDLN2
+  let fldz () = emit FLDZ
+  let fmul x = emit (FMUL x)
+  let fmulp x y = emit (FMULP (x, y))
+  let fnstcw x = emit (FNSTCW x)
+  let fnstsw x = emit (FNSTSW x)
+  let fpatan () = emit FPATAN
+  let fptan () = emit FPTAN
+  let fsin () = emit FSIN
+  let fsqrt () = emit FSQRT
+  let fstp x = emit (FSTP x)
+  let fsub x = emit (FSUB x)
+  let fsubp x y = emit (FSUBP (x, y))
+  let fsubr x = emit (FSUBR x)
+  let fsubrp x y = emit (FSUBRP (x, y))
+  let fxch x = emit (FXCH x)
+  let fyl2x () = emit FYL2X
+  let hlt () = emit HLT
+  let idiv x = emit (IDIV x)
+  let imul x y = emit (IMUL (x, y))
+  let inc x = emit (INC x)
+  let j cond x = emit (J (cond, x))
+  let ja = j A
+  let jae = j AE
+  let jb = j B
+  let jbe = j BE
+  let je = j E
+  let jg = j G
+  let jmp x = emit (JMP x)
+  let jne = j NE
+  let jp = j P
+  let lea x y = emit (LEA (x, y))
+  let mov x y = emit (MOV (x, y))
+  let movapd x y = emit (MOVAPD (x, y))
+  let movsd x y = emit (MOVSD (x, y))
+  let movss x y = emit (MOVSS (x, y))
+  let movsx x y = emit (MOVSX (x, y))
+  let movsxd x y = emit (MOVSXD  (x, y))
+  let movzx x y = emit (MOVZX (x, y))
+  let mulsd x y = emit (MULSD (x, y))
+  let nop () = emit NOP
+  let or_ x y = emit (OR (x, y))
+  let pop x = emit (POP x)
+  let push x = emit (PUSH x)
+  let ret () = emit RET
+  let sal x y = emit (SAL (x, y))
+  let sar x y = emit (SAR (x, y))
+  let set cond x = emit (SET (cond, x))
+  let shr x y = emit (SHR (x, y))
+  let sqrtsd x y = emit (SQRTSD (x, y))
+  let sub x y = emit (SUB (x, y))
+  let subsd  x y = emit (SUBSD (x, y))
+  let test x y= emit (TEST (x, y))
+  let ucomisd x y = emit (UCOMISD (x, y))
+  let xchg x y = emit (XCHG (x, y))
+  let xor x y= emit (XOR (x, y))
+  let xorpd x y = emit (XORPD (x, y))
+end
diff --git a/asmcomp/x86_dsl.mli b/asmcomp/x86_dsl.mli
new file mode 100644
index 00000000..080331fc
--- /dev/null
+++ b/asmcomp/x86_dsl.mli
@@ -0,0 +1,192 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*         Fabrice Le Fessant, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Helpers for Intel code generators *)
+
+(* The DSL* modules expose functions to emit x86/x86_64 instructions
+   using a syntax close to the official Intel syntax, except that
+   source and destination operands are reversed as in the AT&T
+   syntax:
+
+     mov src dst
+*)
+
+
+open X86_ast
+
+val sym: string -> arg
+val nat: nativeint -> arg
+val int: int -> arg
+val const_32: int32 -> constant
+val const_nat: nativeint -> constant
+val const: int -> constant
+val al: arg
+val ah: arg
+val cl: arg
+val ax: arg
+val rax: arg
+val r10: arg
+val r11: arg
+val r13: arg
+val r14: arg
+val r15: arg
+val rsp: arg
+val rbp: arg
+val xmm15: arg
+val eax: arg
+val ebx: arg
+val ecx: arg
+val edx: arg
+val ebp: arg
+val esp: arg
+val st0: arg
+val st1: arg
+
+val mem32:
+  data_type -> ?scale:int -> ?base:reg64 -> ?sym:string ->
+  int -> reg64 -> arg
+
+val mem64:
+  data_type -> ?scale:int -> ?base:reg64 -> ?sym:string ->
+  int -> reg64 -> arg
+
+val mem64_rip: data_type -> ?ofs:int -> string -> arg
+
+
+module D : sig
+  (** Directives *)
+
+  val align: int -> unit
+  val byte: constant -> unit
+  val bytes: string -> unit
+  val cfi_adjust_cfa_offset: int -> unit
+  val cfi_endproc: unit -> unit
+  val cfi_startproc: unit -> unit
+  val comment: string -> unit
+  val data: unit -> unit
+  val extrn: string -> data_type -> unit
+  val file: file_num:int -> file_name:string -> unit
+  val global: string -> unit
+  val indirect_symbol: string -> unit
+  val label: ?typ:data_type -> string -> unit
+  val loc: file_num:int -> line:int -> col:int -> unit
+  val long: constant -> unit
+  val mode386: unit -> unit
+  val model: string -> unit
+  val private_extern: string -> unit
+  val qword: constant -> unit
+  val section: string list -> string option -> string list -> unit
+  val setvar: string * constant -> unit
+  val size: string -> constant -> unit
+  val space: int -> unit
+  val text: unit -> unit
+  val type_: string -> string -> unit
+  val word: constant -> unit
+end
+
+module I : sig
+  (* Instructions *)
+
+  val add: arg -> arg -> unit
+  val addsd: arg -> arg -> unit
+  val and_: arg -> arg -> unit
+  val andpd: arg -> arg -> unit
+  val bswap: arg -> unit
+  val call: arg -> unit
+  val cdq: unit -> unit
+  val cmp: arg -> arg -> unit
+  val comisd: arg -> arg -> unit
+  val cqo: unit -> unit
+  val cvtsd2ss: arg -> arg -> unit
+  val cvtsi2sd: arg -> arg -> unit
+  val cvtss2sd: arg -> arg -> unit
+  val cvttsd2si: arg -> arg -> unit
+  val dec: arg -> unit
+  val divsd: arg -> arg -> unit
+  val fabs: unit -> unit
+  val fadd: arg -> unit
+  val faddp: arg -> arg -> unit
+  val fchs: unit -> unit
+  val fcomp: arg -> unit
+  val fcompp: unit -> unit
+  val fcos: unit -> unit
+  val fdiv: arg -> unit
+  val fdivp: arg -> arg -> unit
+  val fdivr: arg -> unit
+  val fdivrp: arg -> arg -> unit
+  val fild: arg -> unit
+  val fistp: arg -> unit
+  val fld1: unit -> unit
+  val fld: arg -> unit
+  val fldcw: arg -> unit
+  val fldlg2: unit -> unit
+  val fldln2: unit -> unit
+  val fldz: unit -> unit
+  val fmul: arg -> unit
+  val fmulp: arg -> arg -> unit
+  val fnstcw: arg -> unit
+  val fnstsw: arg -> unit
+  val fpatan: unit -> unit
+  val fptan: unit -> unit
+  val fsin: unit -> unit
+  val fsqrt: unit -> unit
+  val fstp: arg -> unit
+  val fsub: arg -> unit
+  val fsubp: arg -> arg -> unit
+  val fsubr: arg -> unit
+  val fsubrp: arg -> arg -> unit
+  val fxch: arg -> unit
+  val fyl2x: unit -> unit
+  val hlt: unit -> unit
+  val idiv: arg -> unit
+  val imul: arg -> arg option -> unit
+  val inc: arg -> unit
+  val j: condition -> arg -> unit
+  val ja: arg -> unit
+  val jae: arg -> unit
+  val jb: arg -> unit
+  val jbe: arg -> unit
+  val je: arg -> unit
+  val jg: arg -> unit
+  val jmp: arg -> unit
+  val jne: arg -> unit
+  val jp: arg -> unit
+  val lea: arg -> arg -> unit
+  val mov: arg -> arg -> unit
+  val movapd: arg -> arg -> unit
+  val movsd: arg -> arg -> unit
+  val movss: arg -> arg -> unit
+  val movsx: arg -> arg -> unit
+  val movsxd: arg -> arg -> unit
+  val movzx: arg -> arg -> unit
+  val mulsd: arg -> arg -> unit
+  val nop: unit -> unit
+  val or_: arg -> arg -> unit
+  val pop: arg -> unit
+  val push: arg -> unit
+  val ret: unit -> unit
+  val sal: arg -> arg -> unit
+  val sar: arg -> arg -> unit
+  val set: condition -> arg -> unit
+  val shr: arg -> arg -> unit
+  val sqrtsd: arg -> arg -> unit
+  val sub: arg -> arg -> unit
+  val subsd: arg -> arg -> unit
+  val test: arg -> arg -> unit
+  val ucomisd: arg -> arg -> unit
+  val xchg: arg -> arg -> unit
+  val xor: arg -> arg -> unit
+  val xorpd: arg -> arg -> unit
+end
diff --git a/asmcomp/x86_gas.ml b/asmcomp/x86_gas.ml
new file mode 100644
index 00000000..6d2363a7
--- /dev/null
+++ b/asmcomp/x86_gas.ml
@@ -0,0 +1,311 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*         Fabrice Le Fessant, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open X86_ast
+open X86_proc
+
+let bprintf = Printf.bprintf
+
+let print_reg b f r =
+  Buffer.add_char b '%';
+  Buffer.add_string b (f r)
+
+let opt_displ b displ =
+  if displ = 0 then ()
+  else if displ > 0 then bprintf b "+%d" displ
+  else bprintf b "%d" displ
+
+let arg_mem b {arch; typ=_; idx; scale; base; sym; displ} =
+  let string_of_register =
+    match arch with
+    | X86 -> string_of_reg32
+    | X64 -> string_of_reg64
+  in
+  begin match sym with
+  | None ->
+      if displ <> 0 || scale = 0 then
+        Buffer.add_string b (Int.to_string displ)
+  | Some s ->
+      Buffer.add_string b s;
+      opt_displ b displ
+  end;
+  if scale <> 0 then begin
+    Buffer.add_char b '(';
+    begin match base with
+    | None -> ()
+    | Some base -> print_reg b string_of_register base
+    end;
+    if base != None || scale <> 1 then Buffer.add_char b ',';
+    print_reg b string_of_register idx;
+    if scale <> 1 then bprintf b ",%s" (Int.to_string scale);
+    Buffer.add_char b ')'
+  end
+
+let arg b = function
+  | Sym x -> Buffer.add_char b '$'; Buffer.add_string b x
+  | Imm x -> bprintf b "$%Ld" x
+  | Reg8L x -> print_reg b string_of_reg8l x
+  | Reg8H x -> print_reg b string_of_reg8h x
+  | Reg16 x -> print_reg b string_of_reg16 x
+  | Reg32 x -> print_reg b string_of_reg32 x
+  | Reg64 x -> print_reg b string_of_reg64 x
+  | Regf x  -> print_reg b string_of_registerf x
+  | Mem addr -> arg_mem b addr
+  | Mem64_RIP (_, s, displ) -> bprintf b "%s%a(%%rip)" s opt_displ displ
+
+let rec cst b = function
+  | ConstLabel _ | Const _ | ConstThis as c -> scst b c
+  | ConstAdd (c1, c2) -> bprintf b "%a + %a" scst c1 scst c2
+  | ConstSub (c1, c2) -> bprintf b "%a - %a" scst c1 scst c2
+
+and scst b = function
+  | ConstThis -> Buffer.add_string b "."
+  | ConstLabel l -> Buffer.add_string b l
+  | Const n when n <= 0x7FFF_FFFFL && n >= -0x8000_0000L ->
+      Buffer.add_string b (Int64.to_string n)
+  | Const n -> bprintf b "0x%Lx" n
+  | ConstAdd (c1, c2) -> bprintf b "(%a + %a)" scst c1 scst c2
+  | ConstSub (c1, c2) -> bprintf b "(%a - %a)" scst c1 scst c2
+
+let typeof = function
+  | Mem {typ; _} | Mem64_RIP (typ, _, _) -> typ
+  | Reg8L _ | Reg8H _ -> BYTE
+  | Reg16 _ -> WORD
+  | Reg32 _ -> DWORD
+  | Reg64 _ -> QWORD
+  | Imm _ | Sym _ -> NONE
+  | Regf _ -> assert false
+
+let suf arg =
+  match typeof arg with
+  | BYTE -> "b"
+  | WORD -> "w"
+  | DWORD | REAL8 -> "l"
+  | QWORD -> "q"
+  | REAL4 -> "s"
+  | NONE -> ""
+  | OWORD | NEAR | PROC -> assert false
+
+let i0 b s = bprintf b "\t%s" s
+let i1 b s x = bprintf b "\t%s\t%a" s arg x
+let i1_s b s x = bprintf b "\t%s%s\t%a" s (suf x) arg x
+let i2 b s x y = bprintf b "\t%s\t%a, %a" s arg x arg y
+let i2_s b s x y = bprintf b "\t%s%s\t%a, %a" s (suf y) arg x arg y
+let i2_ss b s x y = bprintf b "\t%s%s%s\t%a, %a" s (suf x) (suf y) arg x arg y
+
+let i1_call_jmp b s = function
+  (* this is the encoding of jump labels: don't use * *)
+  | Mem {arch=X86; idx=_;   scale=0; base=None; sym=Some _; _} as x ->
+      i1 b s x
+  | Reg32 _ | Reg64 _ | Mem _  | Mem64_RIP _ as x ->
+      bprintf b "\t%s\t*%a" s arg x
+  | Sym x -> bprintf b "\t%s\t%s" s x
+  | _ -> assert false
+
+let print_instr b = function
+  | ADD (arg1, arg2) -> i2_s b "add" arg1 arg2
+  | ADDSD (arg1, arg2) -> i2 b "addsd" arg1 arg2
+  | AND (arg1, arg2) -> i2_s b "and" arg1 arg2
+  | ANDPD (arg1, arg2) -> i2 b "andpd" arg1 arg2
+  | BSWAP arg -> i1 b "bswap" arg
+  | CALL arg  -> i1_call_jmp b "call" arg
+  | CDQ -> i0 b "cltd"
+  | CMOV (c, arg1, arg2) -> i2 b ("cmov" ^ string_of_condition c) arg1 arg2
+  | CMP (arg1, arg2) -> i2_s b "cmp" arg1 arg2
+  | COMISD (arg1, arg2) -> i2 b "comisd" arg1 arg2
+  | CQO ->  i0 b "cqto"
+  | CVTSD2SI (arg1, arg2) -> i2 b "cvtsd2si" arg1 arg2
+  | CVTSD2SS (arg1, arg2) -> i2 b "cvtsd2ss" arg1 arg2
+  | CVTSI2SD (arg1, arg2) -> i2 b ("cvtsi2sd" ^ suf arg1) arg1 arg2
+  | CVTSS2SD (arg1, arg2) -> i2 b "cvtss2sd" arg1 arg2
+  | CVTTSD2SI (arg1, arg2) -> i2_s b "cvttsd2si" arg1 arg2
+  | DEC arg -> i1_s b "dec" arg
+  | DIVSD (arg1, arg2) -> i2 b "divsd" arg1 arg2
+  | FABS -> i0 b "fabs"
+  | FADD arg -> i1_s b "fadd" arg
+  | FADDP (arg1, arg2)  -> i2 b "faddp" arg1 arg2
+  | FCHS -> i0 b "fchs"
+  | FCOMP arg -> i1_s b "fcomp" arg
+  | FCOMPP -> i0 b "fcompp"
+  | FCOS -> i0 b "fcos"
+  | FDIV arg -> i1_s b "fdiv" arg
+  | FDIVP (Regf (ST 0), arg2)  -> i2 b "fdivrp" (Regf (ST 0)) arg2 (* bug *)
+  | FDIVP (arg1, arg2)  -> i2 b "fdivp" arg1 arg2
+  | FDIVR arg -> i1_s b "fdivr" arg
+  | FDIVRP (Regf (ST 0), arg2)  -> i2 b "fdivp" (Regf (ST 0)) arg2 (* bug *)
+  | FDIVRP (arg1, arg2)  -> i2 b "fdivrp" arg1 arg2
+  | FILD arg -> i1_s b "fild" arg
+  | FISTP arg -> i1_s b "fistp" arg
+  | FLD (Mem {typ=REAL4; _} as arg) -> i1 b "flds" arg
+  | FLD arg -> i1 b "fldl" arg
+  | FLD1 -> i0 b "fld1"
+  | FLDCW arg -> i1 b "fldcw" arg
+  | FLDLG2 -> i0 b "fldlg2"
+  | FLDLN2 -> i0 b "fldln2"
+  | FLDZ -> i0 b "fldz"
+  | FMUL arg -> i1_s b "fmul" arg
+  | FMULP (arg1, arg2)  -> i2 b "fmulp" arg1 arg2
+  | FNSTCW arg -> i1 b "fnstcw" arg
+  | FNSTSW arg -> i1 b "fnstsw" arg
+  | FPATAN -> i0 b "fpatan"
+  | FPTAN -> i0 b "fptan"
+  | FSIN -> i0 b "fsin"
+  | FSQRT -> i0 b "fsqrt"
+  | FSTP (Mem {typ=REAL4; _} as arg) -> i1 b "fstps" arg
+  | FSTP arg -> i1 b "fstpl" arg
+  | FSUB arg -> i1_s b "fsub" arg
+  | FSUBP (Regf (ST 0), arg2)  -> i2 b "fsubrp" (Regf (ST 0)) arg2 (* bug *)
+  | FSUBP (arg1, arg2)  -> i2 b "fsubp" arg1 arg2
+  | FSUBR arg -> i1_s b "fsubr" arg
+  | FSUBRP (Regf (ST 0), arg2) -> i2 b "fsubp" (Regf (ST 0)) arg2 (* bug *)
+  | FSUBRP (arg1, arg2)  -> i2 b "fsubrp" arg1 arg2
+  | FXCH arg -> i1 b "fxch" arg
+  | FYL2X -> i0 b "fyl2x"
+  | HLT -> i0 b "hlt"
+  | IDIV arg -> i1_s b "idiv" arg
+  | IMUL (arg, None) -> i1_s b "imul" arg
+  | IMUL (arg1, Some arg2) -> i2_s b "imul" arg1 arg2
+  | INC arg -> i1_s b "inc" arg
+  | J (c, arg) -> i1_call_jmp b ("j" ^ string_of_condition c) arg
+  | JMP arg -> i1_call_jmp b "jmp" arg
+  | LEA (arg1, arg2) -> i2_s b "lea" arg1 arg2
+  | LEAVE -> i0 b "leave"
+  | MOV ((Imm n as arg1), (Reg64 _ as arg2))
+    when not (n <= 0x7FFF_FFFFL && n >= -0x8000_0000L) ->
+      i2 b "movabsq" arg1 arg2
+  | MOV ((Sym _ as arg1), (Reg64 _ as arg2)) when windows ->
+      i2 b "movabsq" arg1 arg2
+  | MOV (arg1, arg2) -> i2_s b "mov" arg1 arg2
+  | MOVAPD (arg1, arg2) -> i2 b "movapd" arg1 arg2
+  | MOVLPD (arg1, arg2) -> i2 b "movlpd" arg1 arg2
+  | MOVSD (arg1, arg2) -> i2 b "movsd" arg1 arg2
+  | MOVSS (arg1, arg2) -> i2 b "movss" arg1 arg2
+  | MOVSX (arg1, arg2) -> i2_ss b "movs" arg1 arg2
+  | MOVSXD (arg1, arg2) -> i2 b "movslq" arg1 arg2
+  | MOVZX (arg1, arg2) -> i2_ss b "movz" arg1 arg2
+  | MULSD (arg1, arg2) -> i2 b "mulsd" arg1 arg2
+  | NEG arg -> i1 b "neg" arg
+  | NOP -> i0 b "nop"
+  | OR (arg1, arg2) -> i2_s b "or" arg1 arg2
+  | POP  arg -> i1_s b "pop" arg
+  | PUSH arg -> i1_s b "push" arg
+  | RET ->  i0 b "ret"
+  | ROUNDSD (r, arg1, arg2) -> i2 b (string_of_rounding r) arg1 arg2
+  | SAL (arg1, arg2) -> i2_s b "sal" arg1 arg2
+  | SAR (arg1, arg2) -> i2_s b "sar" arg1 arg2
+  | SET (c, arg) -> i1 b ("set" ^ string_of_condition c) arg
+  | SHR (arg1, arg2) -> i2_s b "shr" arg1 arg2
+  | SQRTSD (arg1, arg2) -> i2 b "sqrtsd" arg1 arg2
+  | SUB (arg1, arg2) -> i2_s b "sub" arg1 arg2
+  | SUBSD (arg1, arg2) -> i2 b "subsd" arg1 arg2
+  | TEST (arg1, arg2) -> i2_s b "test" arg1 arg2
+  | UCOMISD (arg1, arg2) -> i2 b "ucomisd" arg1 arg2
+  | XCHG (arg1, arg2) -> i2 b "xchg" arg1 arg2
+  | XOR (arg1, arg2) -> i2_s b "xor" arg1 arg2
+  | XORPD (arg1, arg2) -> i2 b "xorpd" arg1 arg2
+
+(* bug:
+   https://sourceware.org/binutils/docs-2.22/as/i386_002dBugs.html#i386_002dBugs
+
+   The AT&T syntax has a bug for fsub/fdiv/fsubr/fdivr instructions when
+   the source register is %st and the destination is %st(i).  In those
+   case, AT&T use fsub (resp. fsubr) in place of fsubr (resp. fsub),
+   and idem for fdiv/fdivr.
+
+   Concretely, AT&T syntax interpretation of:
+
+      fsub  %st, %st(3)
+
+   should normally be:
+
+      %st(3) := %st(3) - %st
+
+   but it should actually be interpreted as:
+
+      %st(3) := %st - %st(3)
+
+   which means the FSUBR instruction should be used.
+*)
+
+
+let print_line b = function
+  | Ins instr -> print_instr b instr
+
+  | Align (_data,n) ->
+      (* MacOSX assembler interprets the integer n as a 2^n alignment *)
+      let n = if system = S_macosx then Misc.log2 n else n in
+      bprintf b "\t.align\t%d" n
+  | Byte n -> bprintf b "\t.byte\t%a" cst n
+  | Bytes s ->
+      if system = S_solaris then buf_bytes_directive b ".byte" s
+      else bprintf b "\t.ascii\t\"%s\"" (string_of_string_literal s)
+  | Comment s -> bprintf b "\t\t\t\t/* %s */" s
+  | Global s -> bprintf b "\t.globl\t%s" s;
+  | Long n -> bprintf b "\t.long\t%a" cst n
+  | NewLabel (s, _) -> bprintf b "%s:" s
+  | Quad n -> bprintf b "\t.quad\t%a" cst n
+  | Section ([".data" ], _, _) -> bprintf b "\t.data"
+  | Section ([".text" ], _, _) -> bprintf b "\t.text"
+  | Section (name, flags, args) ->
+      bprintf b "\t.section %s" (String.concat "," name);
+      begin match flags with
+      | None -> ()
+      | Some flags -> bprintf b ",%S" flags
+      end;
+      begin match args with
+      | [] -> ()
+      | _ -> bprintf b ",%s" (String.concat "," args)
+      end
+  | Space n ->
+      if system = S_solaris then bprintf b "\t.zero\t%d" n
+      else bprintf b "\t.space\t%d" n
+  | Word n ->
+      if system = S_solaris then bprintf b "\t.value\t%a" cst n
+      else bprintf b "\t.word\t%a" cst n
+
+  (* gas only *)
+  | Cfi_adjust_cfa_offset n -> bprintf b "\t.cfi_adjust_cfa_offset %d" n
+  | Cfi_endproc -> bprintf b "\t.cfi_endproc"
+  | Cfi_startproc -> bprintf b "\t.cfi_startproc"
+  | File (file_num, file_name) ->
+      bprintf b "\t.file\t%d\t\"%s\""
+        file_num (X86_proc.string_of_string_literal file_name)
+  | Indirect_symbol s -> bprintf b "\t.indirect_symbol %s" s
+  | Loc (file_num, line, col) ->
+      (* PR#7726: Location.none uses column -1, breaks LLVM assembler *)
+      if col >= 0 then bprintf b "\t.loc\t%d\t%d\t%d" file_num line col
+      else bprintf b "\t.loc\t%d\t%d" file_num line
+  | Private_extern s -> bprintf b "\t.private_extern %s" s
+  | Set (arg1, arg2) -> bprintf b "\t.set %s, %a" arg1 cst arg2
+  | Size (s, c) -> bprintf b "\t.size %s,%a" s cst c
+  | Type (s, typ) -> bprintf b "\t.type %s,%s" s typ
+
+  (* masm only *)
+  | External _
+  | Mode386
+  | Model _
+    -> assert false
+
+let generate_asm oc lines =
+  let b = Buffer.create 10000 in
+  output_string oc "\t.file \"\"\n"; (* PR#7037 *)
+  List.iter
+    (fun i ->
+       Buffer.clear b;
+       print_line b i;
+       Buffer.add_char b '\n';
+       Buffer.output_buffer oc b;
+    )
+    lines
diff --git a/asmcomp/x86_gas.mli b/asmcomp/x86_gas.mli
new file mode 100644
index 00000000..3c3a4aee
--- /dev/null
+++ b/asmcomp/x86_gas.mli
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*         Fabrice Le Fessant, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Emit assembly instructions for gas. *)
+
+val generate_asm: out_channel -> X86_ast.asm_line list -> unit
diff --git a/asmcomp/x86_masm.ml b/asmcomp/x86_masm.ml
new file mode 100644
index 00000000..eb010b8b
--- /dev/null
+++ b/asmcomp/x86_masm.ml
@@ -0,0 +1,261 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*         Fabrice Le Fessant, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open X86_ast
+open X86_proc
+
+let bprintf = Printf.bprintf
+
+let string_of_datatype = function
+  | QWORD -> "QWORD"
+  | OWORD -> "OWORD"
+  | NONE -> assert false
+  | REAL4 -> "REAL4"
+  | REAL8 -> "REAL8"
+  | BYTE -> "BYTE"
+  | WORD -> "WORD"
+  | DWORD -> "DWORD"
+  | NEAR -> "NEAR"
+  | PROC -> "PROC"
+
+
+let string_of_datatype_ptr = function
+  | QWORD -> "QWORD PTR "
+  | OWORD -> "OWORD PTR "
+  | NONE -> ""
+  | REAL4 -> "REAL4 PTR "
+  | REAL8 -> "REAL8 PTR "
+  | BYTE -> "BYTE PTR "
+  | WORD -> "WORD PTR "
+  | DWORD -> "DWORD PTR "
+  | NEAR -> "NEAR PTR "
+  | PROC -> "PROC PTR "
+
+let arg_mem b {arch; typ; idx; scale; base; sym; displ} =
+  let string_of_register =
+    match arch with
+    | X86 -> string_of_reg32
+    | X64 -> string_of_reg64
+  in
+  Buffer.add_string b (string_of_datatype_ptr typ);
+  Buffer.add_char b '[';
+  begin match sym with
+  | None -> ()
+  | Some s -> Buffer.add_string b s
+  end;
+  if scale <> 0 then begin
+    if sym <> None then Buffer.add_char b '+';
+    Buffer.add_string b (string_of_register idx);
+    if scale <> 1 then bprintf b "*%d" scale;
+  end;
+  begin match base with
+  | None -> ()
+  | Some r ->
+      assert(scale > 0);
+      Buffer.add_char b '+';
+      Buffer.add_string b (string_of_register r);
+  end;
+  begin if displ > 0 then bprintf b "+%d" displ
+    else if displ < 0 then bprintf b "%d" displ
+  end;
+  Buffer.add_char b ']'
+
+let arg b = function
+  | Sym s -> bprintf b "OFFSET %s" s
+  | Imm n when n <= 0x7FFF_FFFFL && n >= -0x8000_0000L -> bprintf b "%Ld" n
+  | Imm int -> bprintf b "0%LxH" int (* force ml64 to use mov reg, imm64 *)
+  | Reg8L x -> Buffer.add_string b (string_of_reg8l x)
+  | Reg8H x -> Buffer.add_string b (string_of_reg8h x)
+  | Reg16 x -> Buffer.add_string b (string_of_reg16 x)
+  | Reg32 x -> Buffer.add_string b (string_of_reg32 x)
+  | Reg64 x -> Buffer.add_string b (string_of_reg64 x)
+  | Regf x -> Buffer.add_string b (string_of_registerf x)
+
+  (* We don't need to specify RIP on Win64, since EXTERN will provide
+     the list of external symbols that need this addressing mode, and
+     MASM will automatically use RIP addressing when needed. *)
+  | Mem64_RIP (typ, s, displ) ->
+      bprintf b "%s%s" (string_of_datatype_ptr typ) s;
+      if displ > 0 then bprintf b "+%d" displ
+      else if displ < 0 then bprintf b "%d" displ
+  | Mem addr -> arg_mem b addr
+
+let rec cst b = function
+  | ConstLabel _ | Const _ | ConstThis as c -> scst b c
+  | ConstAdd (c1, c2) -> bprintf b "%a + %a" scst c1 scst c2
+  | ConstSub (c1, c2) -> bprintf b "%a - %a" scst c1 scst c2
+
+and scst b = function
+  | ConstThis -> Buffer.add_string b "THIS BYTE"
+  | ConstLabel l -> Buffer.add_string b l
+  | Const n when n <= 0x7FFF_FFFFL && n >= -0x8000_0000L ->
+      Buffer.add_string b (Int64.to_string n)
+  | Const n -> bprintf b "0%LxH" n
+  | ConstAdd (c1, c2) -> bprintf b "(%a + %a)" scst c1 scst c2
+  | ConstSub (c1, c2) -> bprintf b "(%a - %a)" scst c1 scst c2
+
+let i0 b s = bprintf b "\t%s" s
+let i1 b s x = bprintf b "\t%s\t%a" s arg x
+let i2 b s x y = bprintf b "\t%s\t%a, %a" s arg y arg x
+
+let i1_call_jmp b s = function
+  | Sym x -> bprintf b "\t%s\t%s" s x
+  | x -> i1 b s x
+
+let print_instr b = function
+  | ADD (arg1, arg2) -> i2 b "add" arg1 arg2
+  | ADDSD (arg1, arg2) -> i2 b "addsd" arg1 arg2
+  | AND (arg1, arg2) -> i2 b "and" arg1 arg2
+  | ANDPD (arg1, arg2) -> i2 b "andpd" arg1 arg2
+  | BSWAP arg -> i1 b "bswap" arg
+  | CALL arg  -> i1_call_jmp b "call" arg
+  | CDQ -> i0 b "cdq"
+  | CMOV (c, arg1, arg2) -> i2 b ("cmov" ^ string_of_condition c) arg1 arg2
+  | CMP (arg1, arg2) -> i2 b "cmp" arg1 arg2
+  | COMISD (arg1, arg2) -> i2 b "comisd" arg1 arg2
+  | CQO -> i0 b "cqo"
+  | CVTSD2SI (arg1, arg2) -> i2 b "cvtsd2si" arg1 arg2
+  | CVTSD2SS (arg1, arg2) -> i2 b "cvtsd2ss" arg1 arg2
+  | CVTSI2SD (arg1, arg2) -> i2 b "cvtsi2sd" arg1 arg2
+  | CVTSS2SD (arg1, arg2) -> i2 b "cvtss2sd" arg1 arg2
+  | CVTTSD2SI (arg1, arg2) -> i2 b "cvttsd2si" arg1 arg2
+  | DEC arg -> i1 b "dec" arg
+  | DIVSD (arg1, arg2) -> i2 b "divsd" arg1 arg2
+  | FABS -> i0 b "fabs"
+  | FADD arg -> i1 b "fadd" arg
+  | FADDP (arg1, arg2)  -> i2 b "faddp" arg1 arg2
+  | FCHS -> i0 b "fchs"
+  | FCOMP arg -> i1 b "fcomp" arg
+  | FCOMPP -> i0 b "fcompp"
+  | FCOS -> i0 b "fcos"
+  | FDIV arg -> i1 b "fdiv" arg
+  | FDIVP (arg1, arg2)  -> i2 b "fdivp" arg1 arg2
+  | FDIVR arg -> i1 b "fdivr" arg
+  | FDIVRP (arg1, arg2)  -> i2 b "fdivrp" arg1 arg2
+  | FILD arg -> i1 b "fild" arg
+  | FISTP arg -> i1 b "fistp" arg
+  | FLD arg -> i1 b "fld" arg
+  | FLD1 -> i0 b "fld1"
+  | FLDCW arg -> i1 b "fldcw" arg
+  | FLDLG2 -> i0 b "fldlg2"
+  | FLDLN2 -> i0 b "fldln2"
+  | FLDZ -> i0 b "fldz"
+  | FMUL arg -> i1 b "fmul" arg
+  | FMULP (arg1, arg2)  -> i2 b "fmulp" arg1 arg2
+  | FNSTCW arg -> i1 b "fnstcw" arg
+  | FNSTSW arg -> i1 b "fnstsw" arg
+  | FPATAN -> i0 b "fpatan"
+  | FPTAN -> i0 b "fptan"
+  | FSIN -> i0 b "fsin"
+  | FSQRT -> i0 b "fsqrt"
+  | FSTP arg -> i1 b "fstp" arg
+  | FSUB arg -> i1 b "fsub" arg
+  | FSUBP (arg1, arg2)  -> i2 b "fsubp" arg1 arg2
+  | FSUBR arg -> i1 b "fsubr" arg
+  | FSUBRP (arg1, arg2)  -> i2 b "fsubrp" arg1 arg2
+  | FXCH arg -> i1 b "fxch" arg
+  | FYL2X -> i0 b "fyl2x"
+  | HLT -> assert false
+  | IDIV arg -> i1 b "idiv" arg
+  | IMUL (arg, None) -> i1 b "imul" arg
+  | IMUL (arg1, Some arg2) -> i2 b "imul" arg1 arg2
+  | INC arg -> i1 b "inc" arg
+  | J (c, arg) -> i1_call_jmp b ("j" ^ string_of_condition c) arg
+  | JMP arg -> i1_call_jmp b "jmp" arg
+  | LEA (arg1, arg2) -> i2 b "lea" arg1 arg2
+  | LEAVE -> i0 b "leave"
+  | MOV (Imm n as arg1, Reg64 r) when
+      n >= 0x8000_0000L && n <= 0xFFFF_FFFFL ->
+      (* Work-around a bug in ml64.  Use a mov to the corresponding
+         32-bit lower register when the constant fits in 32-bit.
+         The associated higher 32-bit register will be zeroed. *)
+      i2 b "mov" arg1 (Reg32 r)
+  | MOV (arg1, arg2) -> i2 b "mov" arg1 arg2
+  | MOVAPD (arg1, arg2) -> i2 b "movapd" arg1 arg2
+  | MOVLPD (arg1, arg2) -> i2 b "movlpd" arg1 arg2
+  | MOVSD (arg1, arg2) -> i2 b "movsd" arg1 arg2
+  | MOVSS (arg1, arg2) -> i2 b "movss" arg1 arg2
+  | MOVSX (arg1, arg2) -> i2 b "movsx" arg1 arg2
+  | MOVSXD (arg1, arg2) -> i2 b "movsxd" arg1 arg2
+  | MOVZX (arg1, arg2) -> i2 b "movzx" arg1 arg2
+  | MULSD (arg1, arg2) -> i2 b "mulsd" arg1 arg2
+  | NEG arg -> i1 b "neg" arg
+  | NOP -> i0 b "nop"
+  | OR (arg1, arg2) -> i2 b "or" arg1 arg2
+  | POP arg -> i1 b "pop" arg
+  | PUSH arg -> i1 b "push" arg
+  | RET -> i0 b "ret"
+  | ROUNDSD (r, arg1, arg2) -> i2 b (string_of_rounding r) arg1 arg2
+  | SAL (arg1, arg2) -> i2 b "sal" arg1 arg2
+  | SAR (arg1, arg2) -> i2 b "sar" arg1 arg2
+  | SET (c, arg) -> i1 b ("set" ^ string_of_condition c) arg
+  | SHR (arg1, arg2) -> i2 b "shr" arg1 arg2
+  | SQRTSD (arg1, arg2) -> i2 b "sqrtsd" arg1 arg2
+  | SUB (arg1, arg2) -> i2 b "sub" arg1 arg2
+  | SUBSD (arg1, arg2) -> i2 b "subsd" arg1 arg2
+  | TEST (arg1, arg2) -> i2 b "test" arg1 arg2
+  | UCOMISD (arg1, arg2) -> i2 b "ucomisd" arg1 arg2
+  | XCHG (arg1, arg2) -> i2 b "xchg" arg1 arg2
+  | XOR (arg1, arg2) -> i2 b "xor" arg1 arg2
+  | XORPD (arg1, arg2) -> i2 b "xorpd" arg1 arg2
+
+
+let print_line b = function
+  | Ins instr -> print_instr b instr
+
+  | Align (_data,n) -> bprintf b "\tALIGN\t%d" n
+  | Byte n -> bprintf b "\tBYTE\t%a" cst n
+  | Bytes s -> buf_bytes_directive b "BYTE" s
+  | Comment s -> bprintf b " ; %s " s
+  | Global s -> bprintf b "\tPUBLIC\t%s" s
+  | Long n -> bprintf b "\tDWORD\t%a" cst n
+  | NewLabel (s, NONE) -> bprintf b "%s:" s
+  | NewLabel (s, ptr) -> bprintf b "%s LABEL %s" s (string_of_datatype ptr)
+  | Quad n -> bprintf b "\tQWORD\t%a" cst n
+  | Section ([".data"], None, []) -> bprintf b "\t.DATA"
+  | Section ([".text"], None, []) -> bprintf b "\t.CODE"
+  | Section _ -> assert false
+  | Space n -> bprintf b "\tBYTE\t%d DUP (?)" n
+  | Word n -> bprintf b "\tWORD\t%a" cst n
+
+  (* windows only *)
+  | External (s, ptr) -> bprintf b "\tEXTRN\t%s: %s" s (string_of_datatype ptr)
+  | Mode386 -> bprintf b "\t.386"
+  | Model name -> bprintf b "\t.MODEL %s" name (* name = FLAT *)
+
+  (* gas only *)
+  | Cfi_adjust_cfa_offset _
+  | Cfi_endproc
+  | Cfi_startproc
+  | File _
+  | Indirect_symbol _
+  | Loc _
+  | Private_extern _
+  | Set _
+  | Size _
+  | Type _
+    -> assert false
+
+let generate_asm oc lines =
+  let b = Buffer.create 10000 in
+  List.iter
+    (fun i ->
+       Buffer.clear b;
+       print_line b i;
+       Buffer.add_char b '\n';
+       Buffer.output_buffer oc b
+    )
+    lines;
+  output_string oc "\tEND\n"
diff --git a/asmcomp/x86_masm.mli b/asmcomp/x86_masm.mli
new file mode 100644
index 00000000..9027fe67
--- /dev/null
+++ b/asmcomp/x86_masm.mli
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*         Fabrice Le Fessant, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Emit assembly instructions for MASM (Intel syntax). *)
+
+val generate_asm: out_channel -> X86_ast.asm_line list -> unit
diff --git a/asmcomp/x86_proc.ml b/asmcomp/x86_proc.ml
new file mode 100644
index 00000000..99ddd398
--- /dev/null
+++ b/asmcomp/x86_proc.ml
@@ -0,0 +1,274 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          Fabrice Le Fessant, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open X86_ast
+
+type system =
+  (* 32 bits and 64 bits *)
+  | S_macosx
+  | S_gnu
+  | S_cygwin
+
+  (* 32 bits only *)
+  | S_solaris
+  | S_win32
+  | S_linux_elf
+  | S_bsd_elf
+  | S_beos
+  | S_mingw
+
+  (* 64 bits only *)
+  | S_win64
+  | S_linux
+  | S_mingw64
+
+  | S_unknown
+
+
+let system = match Config.system with
+  | "macosx" -> S_macosx
+  | "solaris" -> S_solaris
+  | "win32" -> S_win32
+  | "linux_elf" -> S_linux_elf
+  | "bsd_elf" -> S_bsd_elf
+  | "beos" -> S_beos
+  | "gnu" -> S_gnu
+  | "cygwin" -> S_cygwin
+  | "mingw" -> S_mingw
+  | "mingw64" -> S_mingw64
+  | "win64" -> S_win64
+  | "linux" -> S_linux
+
+  | _ -> S_unknown
+
+let windows =
+  match system with
+  | S_mingw64 | S_cygwin | S_win64 -> true
+  | _ -> false
+
+let string_of_string_literal s =
+  let b = Buffer.create (String.length s + 2) in
+  let last_was_escape = ref false in
+  for i = 0 to String.length s - 1 do
+    let c = s.[i] in
+    if c >= '0' && c <= '9' then
+      if !last_was_escape
+      then Printf.bprintf b "\\%o" (Char.code c)
+      else Buffer.add_char b c
+    else if c >= ' ' && c <= '~' && c <> '"' (* '"' *) && c <> '\\' then begin
+      Buffer.add_char b c;
+      last_was_escape := false
+    end else begin
+      Printf.bprintf b "\\%o" (Char.code c);
+      last_was_escape := true
+    end
+  done;
+  Buffer.contents b
+
+let string_of_symbol prefix s =
+  let spec = ref false in
+  for i = 0 to String.length s - 1 do
+    match String.unsafe_get s i with
+    | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' -> ()
+    | _ -> spec := true;
+  done;
+  if not !spec then if prefix = "" then s else prefix ^ s
+  else
+    let b = Buffer.create (String.length s + 10) in
+    Buffer.add_string b prefix;
+    String.iter
+      (function
+        | ('A'..'Z' | 'a'..'z' | '0'..'9' | '_') as c -> Buffer.add_char b c
+        | c -> Printf.bprintf b "$%02x" (Char.code c)
+      )
+      s;
+    Buffer.contents b
+
+let buf_bytes_directive b directive s =
+  let pos = ref 0 in
+  for i = 0 to String.length s - 1 do
+    if !pos = 0
+    then begin
+      if i > 0 then Buffer.add_char b '\n';
+      Buffer.add_char b '\t';
+      Buffer.add_string b directive;
+      Buffer.add_char b '\t';
+    end
+    else Buffer.add_char b ',';
+    Printf.bprintf b "%d" (Char.code s.[i]);
+    incr pos;
+    if !pos >= 16 then begin pos := 0 end
+  done
+
+let string_of_reg64 = function
+  | RAX -> "rax"
+  | RBX -> "rbx"
+  | RDI -> "rdi"
+  | RSI -> "rsi"
+  | RDX -> "rdx"
+  | RCX -> "rcx"
+  | RBP -> "rbp"
+  | RSP -> "rsp"
+  | R8  -> "r8"
+  | R9  -> "r9"
+  | R10 -> "r10"
+  | R11 -> "r11"
+  | R12 -> "r12"
+  | R13 -> "r13"
+  | R14 -> "r14"
+  | R15 -> "r15"
+
+let string_of_reg8l = function
+  | RAX -> "al"
+  | RBX -> "bl"
+  | RCX -> "cl"
+  | RDX -> "dl"
+  | RSP -> "spl"
+  | RBP -> "bpl"
+  | RSI -> "sil"
+  | RDI -> "dil"
+  | R8  -> "r8b"
+  | R9  -> "r9b"
+  | R10 -> "r10b"
+  | R11 -> "r11b"
+  | R12 -> "r12b"
+  | R13 -> "r13b"
+  | R14 -> "r14b"
+  | R15 -> "r15b"
+
+let string_of_reg8h = function
+  | AH -> "ah"
+  | BH -> "bh"
+  | CH -> "ch"
+  | DH -> "dh"
+
+let string_of_reg16 = function
+  | RAX -> "ax"
+  | RBX -> "bx"
+  | RCX -> "cx"
+  | RDX -> "dx"
+  | RSP -> "sp"
+  | RBP -> "bp"
+  | RSI -> "si"
+  | RDI -> "di"
+  | R8  -> "r8w"
+  | R9  -> "r9w"
+  | R10 -> "r10w"
+  | R11 -> "r11w"
+  | R12 -> "r12w"
+  | R13 -> "r13w"
+  | R14 -> "r14w"
+  | R15 -> "r15w"
+
+let string_of_reg32 = function
+  | RAX -> "eax"
+  | RBX -> "ebx"
+  | RCX -> "ecx"
+  | RDX -> "edx"
+  | RSP -> "esp"
+  | RBP -> "ebp"
+  | RSI -> "esi"
+  | RDI -> "edi"
+  | R8  -> "r8d"
+  | R9  -> "r9d"
+  | R10 -> "r10d"
+  | R11 -> "r11d"
+  | R12 -> "r12d"
+  | R13 -> "r13d"
+  | R14 -> "r14d"
+  | R15 -> "r15d"
+
+let string_of_registerf = function
+  | XMM n -> Printf.sprintf "xmm%d" n
+  | TOS -> Printf.sprintf "tos"
+  | ST n -> Printf.sprintf "st(%d)" n
+
+let string_of_condition = function
+  | E -> "e"
+  | AE -> "ae"
+  | A -> "a"
+  | GE -> "ge"
+  | G -> "g"
+  | NE -> "ne"
+  | B -> "b"
+  | BE -> "be"
+  | L -> "l"
+  | LE -> "le"
+  | NP -> "np"
+  | P -> "p"
+  | NS -> "ns"
+  | S -> "s"
+  | NO -> "no"
+  | O -> "o"
+
+let string_of_rounding = function
+  | RoundDown -> "roundsd.down"
+  | RoundUp -> "roundsd.up"
+  | RoundTruncate -> "roundsd.trunc"
+  | RoundNearest -> "roundsd.near"
+
+let internal_assembler = ref None
+let register_internal_assembler f = internal_assembler := Some f
+
+(* Which asm conventions to use *)
+let masm =
+  match system with
+  | S_win32 | S_win64 -> true
+  | _ -> false
+
+let use_plt =
+  match system with
+  | S_macosx | S_mingw64 | S_cygwin | S_win64 -> false
+  | _ -> !Clflags.dlcode
+
+(* Shall we use an external assembler command ?
+   If [binary_content] contains some data, we can directly
+   save it. Otherwise, we have to ask an external command.
+*)
+let binary_content = ref None
+
+let compile infile outfile =
+  if masm then
+    Ccomp.command (Config.asm ^
+                   Filename.quote outfile ^ " " ^ Filename.quote infile ^
+                   (if !Clflags.verbose then "" else ">NUL"))
+  else
+    Ccomp.command (Config.asm ^ " " ^
+                   (String.concat " " (Misc.debug_prefix_map_flags ())) ^
+                   " -o " ^ Filename.quote outfile ^ " " ^
+                   Filename.quote infile)
+
+let assemble_file infile outfile =
+  match !binary_content with
+  | None -> compile infile outfile
+  | Some content -> content outfile; binary_content := None; 0
+
+let asm_code = ref []
+
+let directive dir = asm_code := dir :: !asm_code
+let emit ins = directive (Ins ins)
+
+let reset_asm_code () = asm_code := []
+
+let generate_code asm =
+  let instrs = List.rev !asm_code in
+  begin match asm with
+  | Some f -> f instrs
+  | None -> ()
+  end;
+  begin match !internal_assembler with
+  | Some f -> binary_content := Some (f instrs)
+  | None -> binary_content := None
+  end
diff --git a/asmcomp/x86_proc.mli b/asmcomp/x86_proc.mli
new file mode 100644
index 00000000..c7f20bc9
--- /dev/null
+++ b/asmcomp/x86_proc.mli
@@ -0,0 +1,89 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          Fabrice Le Fessant, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(** Definitions shared between the 32 and 64 bit Intel backends. *)
+
+open X86_ast
+
+(** Helpers for textual emitters *)
+
+val string_of_reg8l: reg64 -> string
+val string_of_reg8h: reg8h -> string
+val string_of_reg16: reg64 -> string
+val string_of_reg32: reg64 -> string
+val string_of_reg64: reg64 -> string
+val string_of_registerf: registerf -> string
+val string_of_string_literal: string -> string
+val string_of_condition: condition -> string
+val string_of_symbol: (*prefix*) string -> string -> string
+val string_of_rounding: rounding -> string
+val buf_bytes_directive:
+  Buffer.t -> (*directive*) string -> (*data*)string -> unit
+
+
+(** Buffer of assembly code *)
+
+val emit: instruction -> unit
+val directive: asm_line -> unit
+val reset_asm_code: unit -> unit
+
+(** Code emission *)
+
+val generate_code: (X86_ast.asm_line list -> unit) option -> unit
+  (** Post-process the stream of instructions.  Dump it (using
+      the provided syntax emitter) in a file (if provided) and
+      compile it with an internal assembler (if registered
+      through [register_internal_assembler]). *)
+
+val assemble_file: (*infile*) string -> (*outfile*) string -> (*retcode*) int
+(** Generate an object file corresponding to the last call to
+    [generate_code].  An internal assembler is used if available (and
+    the input file is ignored). Otherwise, the source asm file with an
+    external assembler. *)
+
+(** System detection *)
+
+type system =
+  (* 32 bits and 64 bits *)
+  | S_macosx
+  | S_gnu
+  | S_cygwin
+
+  (* 32 bits only *)
+  | S_solaris
+  | S_win32
+  | S_linux_elf
+  | S_bsd_elf
+  | S_beos
+  | S_mingw
+
+  (* 64 bits only *)
+  | S_win64
+  | S_linux
+  | S_mingw64
+
+  | S_unknown
+
+val system: system
+val masm: bool
+val windows:bool
+
+(** Whether calls need to go via the PLT. *)
+val use_plt : bool
+
+(** Support for plumbing a binary code emitter *)
+
+val register_internal_assembler: (asm_program -> string -> unit) -> unit
diff --git a/boot/menhir/menhirLib.ml b/boot/menhir/menhirLib.ml
new file mode 100644
index 00000000..8e1dc20f
--- /dev/null
+++ b/boot/menhir/menhirLib.ml
@@ -0,0 +1,3517 @@
+module General = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* --------------------------------------------------------------------------- *)
+
+(* Lists. *)
+
+let rec take n xs =
+  match n, xs with
+  | 0, _
+  | _, [] ->
+      []
+  | _, (x :: xs as input) ->
+     let xs' = take (n - 1) xs in
+     if xs == xs' then
+       input
+     else
+       x :: xs'
+
+let rec drop n xs =
+  match n, xs with
+  | 0, _ ->
+      xs
+  | _, [] ->
+      []
+  | _, _ :: xs ->
+      drop (n - 1) xs
+
+let rec uniq1 cmp x ys =
+  match ys with
+  | [] ->
+      []
+  | y :: ys ->
+      if cmp x y = 0 then
+        uniq1 compare x ys
+      else
+        y :: uniq1 cmp y ys
+
+let uniq cmp xs =
+  match xs with
+  | [] ->
+      []
+  | x :: xs ->
+      x :: uniq1 cmp x xs
+
+let weed cmp xs =
+  uniq cmp (List.sort cmp xs)
+
+(* --------------------------------------------------------------------------- *)
+
+(* Streams. *)
+
+type 'a stream =
+    'a head Lazy.t
+
+and 'a head =
+  | Nil
+  | Cons of 'a * 'a stream
+
+(* The length of a stream. *)
+
+let rec length xs =
+  match Lazy.force xs with
+  | Nil ->
+      0
+  | Cons (_, xs) ->
+      1 + length xs
+
+(* Folding over a stream. *)
+
+let rec foldr f xs accu =
+  match Lazy.force xs with
+  | Nil ->
+      accu
+  | Cons (x, xs) ->
+      f x (foldr f xs accu)
+
+end
+module Convert = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* An ocamlyacc-style, or Menhir-style, parser requires access to
+   the lexer, which must be parameterized with a lexing buffer, and
+   to the lexing buffer itself, where it reads position information. *)
+
+(* This traditional API is convenient when used with ocamllex, but
+   inelegant when used with other lexer generators. *)
+
+type ('token, 'semantic_value) traditional =
+    (Lexing.lexbuf -> 'token) -> Lexing.lexbuf -> 'semantic_value
+
+(* This revised API is independent of any lexer generator. Here, the
+   parser only requires access to the lexer, and the lexer takes no
+   parameters. The tokens returned by the lexer may contain position
+   information. *)
+
+type ('token, 'semantic_value) revised =
+    (unit -> 'token) -> 'semantic_value
+
+(* --------------------------------------------------------------------------- *)
+
+(* Converting a traditional parser, produced by ocamlyacc or Menhir,
+   into a revised parser. *)
+
+(* A token of the revised lexer is essentially a triple of a token
+   of the traditional lexer (or raw token), a start position, and
+   and end position. The three [get] functions are accessors. *)
+
+(* We do not require the type ['token] to actually be a triple type.
+   This enables complex applications where it is a record type with
+   more than three fields. It also enables simple applications where
+   positions are of no interest, so ['token] is just ['raw_token]
+   and [get_startp] and [get_endp] return dummy positions. *)
+
+let traditional2revised
+  (get_raw_token : 'token -> 'raw_token)
+  (get_startp    : 'token -> Lexing.position)
+  (get_endp      : 'token -> Lexing.position)
+  (parser : ('raw_token, 'semantic_value) traditional)
+: ('token, 'semantic_value) revised =
+
+  (* Accept a revised lexer. *)
+
+  fun (lexer : unit -> 'token) ->
+
+    (* Create a dummy lexing buffer. *)
+
+    let lexbuf : Lexing.lexbuf =
+      Lexing.from_string ""
+    in
+
+    (* Wrap the revised lexer as a traditional lexer. A traditional
+       lexer returns a raw token and updates the fields of the lexing
+       buffer with new positions, which will be read by the parser. *)
+
+    let lexer (lexbuf : Lexing.lexbuf) : 'raw_token =
+      let token : 'token = lexer() in
+      lexbuf.Lexing.lex_start_p <- get_startp token;
+      lexbuf.Lexing.lex_curr_p <- get_endp token;
+      get_raw_token token
+    in
+
+    (* Invoke the traditional parser. *)
+
+    parser lexer lexbuf
+
+(* --------------------------------------------------------------------------- *)
+
+(* Converting a revised parser back to a traditional parser. *)
+
+let revised2traditional
+  (make_token : 'raw_token -> Lexing.position -> Lexing.position -> 'token)
+  (parser : ('token, 'semantic_value) revised)
+: ('raw_token, 'semantic_value) traditional =
+
+  (* Accept a traditional lexer and a lexing buffer. *)
+
+  fun (lexer : Lexing.lexbuf -> 'raw_token) (lexbuf : Lexing.lexbuf) ->
+
+    (* Wrap the traditional lexer as a revised lexer. *)
+
+    let lexer () : 'token =
+      let token : 'raw_token = lexer lexbuf in
+      make_token token lexbuf.Lexing.lex_start_p lexbuf.Lexing.lex_curr_p
+    in
+
+    (* Invoke the revised parser. *)
+
+    parser lexer
+
+(* --------------------------------------------------------------------------- *)
+
+(* Simplified versions of the above, where concrete triples are used. *)
+
+module Simplified = struct
+
+  let traditional2revised parser =
+    traditional2revised
+      (fun (token, _, _)  -> token)
+      (fun (_, startp, _) -> startp)
+      (fun (_, _, endp)   -> endp)
+      parser
+
+  let revised2traditional parser =
+    revised2traditional
+      (fun token startp endp -> (token, startp, endp))
+      parser
+
+end
+end
+module IncrementalEngine = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+type position = Lexing.position
+
+open General
+
+(* This signature describes the incremental LR engine. *)
+
+(* In this mode, the user controls the lexer, and the parser suspends
+   itself when it needs to read a new token. *)
+
+module type INCREMENTAL_ENGINE = sig
+
+  type token
+
+  (* A value of type [production] is (an index for) a production. The start
+     productions (which do not exist in an \mly file, but are constructed by
+     Menhir internally) are not part of this type. *)
+
+  type production
+
+  (* The type ['a checkpoint] represents an intermediate or final state of the
+     parser. An intermediate checkpoint is a suspension: it records the parser's
+     current state, and allows parsing to be resumed. The parameter ['a] is
+     the type of the semantic value that will eventually be produced if the
+     parser succeeds. *)
+
+  (* [Accepted] and [Rejected] are final checkpoints. [Accepted] carries a
+     semantic value. *)
+
+  (* [InputNeeded] is an intermediate checkpoint. It means that the parser wishes
+     to read one token before continuing. *)
+
+  (* [Shifting] is an intermediate checkpoint. It means that the parser is taking
+     a shift transition. It exposes the state of the parser before and after
+     the transition. The Boolean parameter tells whether the parser intends to
+     request a new token after this transition. (It always does, except when
+     it is about to accept.) *)
+
+  (* [AboutToReduce] is an intermediate checkpoint. It means that the parser is
+     about to perform a reduction step. It exposes the parser's current
+     state as well as the production that is about to be reduced. *)
+
+  (* [HandlingError] is an intermediate checkpoint. It means that the parser has
+     detected an error and is currently handling it, in several steps. *)
+
+  (* A value of type ['a env] represents a configuration of the automaton:
+     current state, stack, lookahead token, etc. The parameter ['a] is the
+     type of the semantic value that will eventually be produced if the parser
+     succeeds. *)
+
+  (* In normal operation, the parser works with checkpoints: see the functions
+     [offer] and [resume]. However, it is also possible to work directly with
+     environments (see the functions [pop], [force_reduction], and [feed]) and
+     to reconstruct a checkpoint out of an environment (see [input_needed]).
+     This is considered advanced functionality; its purpose is to allow error
+     recovery strategies to be programmed by the user. *)
+
+  type 'a env
+
+  type 'a checkpoint = private
+    | InputNeeded of 'a env
+    | Shifting of 'a env * 'a env * bool
+    | AboutToReduce of 'a env * production
+    | HandlingError of 'a env
+    | Accepted of 'a
+    | Rejected
+
+  (* [offer] allows the user to resume the parser after it has suspended
+     itself with a checkpoint of the form [InputNeeded env]. [offer] expects the
+     old checkpoint as well as a new token and produces a new checkpoint. It does not
+     raise any exception. *)
+
+  val offer:
+    'a checkpoint ->
+    token * position * position ->
+    '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 new
+     checkpoint. It does not raise any exception. *)
+
+  val resume:
+    'a checkpoint ->
+    'a checkpoint
+
+  (* A token supplier is a function of no arguments which delivers a new token
+     (together with its start and end positions) every time it is called. *)
+
+  type supplier =
+    unit -> token * position * position
+
+  (* A pair of a lexer and a lexing buffer can be easily turned into a supplier. *)
+
+  val lexer_lexbuf_to_supplier:
+    (Lexing.lexbuf -> token) ->
+    Lexing.lexbuf ->
+    supplier
+
+  (* The functions [offer] and [resume] are sufficient to write a parser loop.
+     One can imagine many variations (which is why we expose these functions
+     in the first place!). Here, we expose a few variations of the main loop,
+     ready for use. *)
+
+  (* [loop supplier checkpoint] begins parsing from [checkpoint], reading
+     tokens from [supplier]. It continues parsing until it reaches a
+     checkpoint of the form [Accepted v] or [Rejected]. In the former case, it
+     returns [v]. In the latter case, it raises the exception [Error]. *)
+
+  val loop: supplier -> 'a checkpoint -> 'a
+
+  (* [loop_handle succeed fail supplier checkpoint] begins parsing from
+     [checkpoint], reading tokens from [supplier]. It continues parsing until
+     it reaches a checkpoint of the form [Accepted v] or [HandlingError env]
+     (or [Rejected], but that should not happen, as [HandlingError _] will be
+     observed first). In the former case, it calls [succeed v]. In the latter
+     case, it calls [fail] with this checkpoint. It cannot raise [Error].
+
+     This means that Menhir's traditional error-handling procedure (which pops
+     the stack until a state that can act on the [error] token is found) does
+     not get a chance to run. Instead, the user can implement her own error
+     handling code, in the [fail] continuation. *)
+
+  val loop_handle:
+    ('a -> 'answer) ->
+    ('a checkpoint -> 'answer) ->
+    supplier -> 'a checkpoint -> 'answer
+
+  (* [loop_handle_undo] is analogous to [loop_handle], except it passes a pair
+     of checkpoints to the failure continuation.
+
+     The first (and oldest) checkpoint is the last [InputNeeded] checkpoint that
+     was encountered before the error was detected. The second (and newest)
+     checkpoint is where the error was detected, as in [loop_handle]. Going back
+     to the first checkpoint can be thought of as undoing any reductions that
+     were performed after seeing the problematic token. (These reductions must
+     be default reductions or spurious reductions.)
+
+     [loop_handle_undo] must initially be applied to an [InputNeeded] checkpoint.
+     The parser's initial checkpoints satisfy this constraint. *)
+
+  val loop_handle_undo:
+    ('a -> 'answer) ->
+    ('a checkpoint -> 'a checkpoint -> 'answer) ->
+    supplier -> 'a checkpoint -> 'answer
+
+  (* [shifts checkpoint] assumes that [checkpoint] has been obtained by
+     submitting a token to the parser. It runs the parser from [checkpoint],
+     through an arbitrary number of reductions, until the parser either
+     accepts this token (i.e., shifts) or rejects it (i.e., signals an error).
+     If the parser decides to shift, then [Some env] is returned, where [env]
+     is the parser's state just before shifting. Otherwise, [None] is
+     returned. *)
+
+  (* It is desirable that the semantic actions be side-effect free, or that
+     their side-effects be harmless (replayable). *)
+
+  val shifts: 'a checkpoint -> 'a env option
+
+  (* The function [acceptable] allows testing, after an error has been
+     detected, which tokens would have been accepted at this point. It is
+     implemented using [shifts]. Its argument should be an [InputNeeded]
+     checkpoint. *)
+
+  (* For completeness, one must undo any spurious reductions before carrying out
+     this test -- that is, one must apply [acceptable] to the FIRST checkpoint
+     that is passed by [loop_handle_undo] to its failure continuation. *)
+
+  (* This test causes some semantic actions to be run! The semantic actions
+     should be side-effect free, or their side-effects should be harmless. *)
+
+  (* The position [pos] is used as the start and end positions of the
+     hypothetical token, and may be picked up by the semantic actions. We
+     suggest using the position where the error was detected. *)
+
+  val acceptable: 'a checkpoint -> token -> position -> bool
+
+  (* The abstract type ['a lr1state] describes the non-initial states of the
+     LR(1) automaton. The index ['a] represents the type of the semantic value
+     associated with this state's incoming symbol. *)
+
+  type 'a lr1state
+
+  (* The states of the LR(1) automaton are numbered (from 0 and up). *)
+
+  val number: _ lr1state -> int
+
+  (* Productions are numbered. *)
+
+  (* [find_production i] requires the index [i] to be valid. Use with care. *)
+
+  val production_index: production -> int
+  val find_production: int -> production
+
+  (* An element is a pair of a non-initial state [s] and a semantic value [v]
+     associated with the incoming symbol of this state. The idea is, the value
+     [v] was pushed onto the stack just before the state [s] was entered. Thus,
+     for some type ['a], the state [s] has type ['a lr1state] and the value [v]
+     has type ['a]. In other words, the type [element] is an existential type. *)
+
+  type element =
+    | Element: 'a lr1state * 'a * position * position -> element
+
+  (* The parser's stack is (or, more precisely, can be viewed as) a stream of
+     elements. The type [stream] is defined by the module [General]. *)
+
+  (* As of 2017/03/31, the types [stream] and [stack] and the function [stack]
+     are DEPRECATED. They might be removed in the future. An alternative way
+     of inspecting the stack is via the functions [top] and [pop]. *)
+
+  type stack = (* DEPRECATED *)
+    element stream
+
+  (* This is the parser's stack, a stream of elements. This stream is empty if
+     the parser is in an initial state; otherwise, it is non-empty.  The LR(1)
+     automaton's current state is the one found in the top element of the
+     stack. *)
+
+  val stack: 'a env -> stack (* DEPRECATED *)
+
+  (* [top env] returns the parser's top stack element. The state contained in
+     this stack element is the current state of the automaton. If the stack is
+     empty, [None] is returned. In that case, the current state of the
+     automaton must be an initial state. *)
+
+  val top: 'a env -> element option
+
+  (* [pop_many i env] pops [i] cells off the automaton's stack. This is done
+     via [i] successive invocations of [pop]. Thus, [pop_many 1] is [pop]. The
+     index [i] must be nonnegative. The time complexity is O(i). *)
+
+  val pop_many: int -> 'a env -> 'a env option
+
+  (* [get i env] returns the parser's [i]-th stack element. The index [i] is
+     0-based: thus, [get 0] is [top]. If [i] is greater than or equal to the
+     number of elements in the stack, [None] is returned. The time complexity
+     is O(i). *)
+
+  val get: int -> 'a env -> element option
+
+  (* [current_state_number env] is (the integer number of) the automaton's
+     current state. This works even if the automaton's stack is empty, in
+     which case the current state is an initial state. This number can be
+     passed as an argument to a [message] function generated by [menhir
+     --compile-errors]. *)
+
+  val current_state_number: 'a env -> int
+
+  (* [equal env1 env2] tells whether the parser configurations [env1] and
+     [env2] are equal in the sense that the automaton's current state is the
+     same in [env1] and [env2] and the stack is *physically* the same in
+     [env1] and [env2]. If [equal env1 env2] is [true], then the sequence of
+     the stack elements, as observed via [pop] and [top], must be the same in
+     [env1] and [env2]. Also, if [equal env1 env2] holds, then the checkpoints
+     [input_needed env1] and [input_needed env2] must be equivalent. The
+     function [equal] has time complexity O(1). *)
+
+  val equal: 'a env -> 'a env -> bool
+
+  (* These are the start and end positions of the current lookahead token. If
+     invoked in an initial state, this function returns a pair of twice the
+     initial position. *)
+
+  val positions: 'a env -> position * position
+
+  (* When applied to an environment taken from a checkpoint of the form
+     [AboutToReduce (env, prod)], the function [env_has_default_reduction]
+     tells whether the reduction that is about to take place is a default
+     reduction. *)
+
+  val env_has_default_reduction: 'a env -> bool
+
+  (* [state_has_default_reduction s] tells whether the state [s] has a default
+     reduction. This includes the case where [s] is an accepting state. *)
+
+  val state_has_default_reduction: _ lr1state -> bool
+
+  (* [pop env] returns a new environment, where the parser's top stack cell
+     has been popped off. (If the stack is empty, [None] is returned.) This
+     amounts to pretending that the (terminal or nonterminal) symbol that
+     corresponds to this stack cell has not been read. *)
+
+  val pop: 'a env -> 'a env option
+
+  (* [force_reduction prod env] should be called only if in the state [env]
+     the parser is capable of reducing the production [prod]. If this
+     condition is satisfied, then this production is reduced, which means that
+     its semantic action is executed (this can have side effects!) and the
+     automaton makes a goto (nonterminal) transition. If this condition is not
+     satisfied, [Invalid_argument _] is raised. *)
+
+  val force_reduction: production -> 'a env -> 'a env
+
+  (* [input_needed env] returns [InputNeeded env]. That is, out of an [env]
+     that might have been obtained via a series of calls to the functions
+     [pop], [force_reduction], [feed], etc., it produces a checkpoint, which
+     can be used to resume normal parsing, by supplying this checkpoint as an
+     argument to [offer]. *)
+
+  (* This function should be used with some care. It could "mess up the
+     lookahead" in the sense that it allows parsing to resume in an arbitrary
+     state [s] with an arbitrary lookahead symbol [t], even though Menhir's
+     reachability analysis (menhir --list-errors) might well think that it is
+     impossible to reach this particular configuration. If one is using
+     Menhir's new error reporting facility, this could cause the parser to
+     reach an error state for which no error message has been prepared. *)
+
+  val input_needed: 'a env -> 'a checkpoint
+
+end
+
+(* This signature is a fragment of the inspection API that is made available
+   to the user when [--inspection] is used. This fragment contains type
+   definitions for symbols. *)
+
+module type SYMBOLS = sig
+
+  (* The type ['a terminal] represents a terminal symbol. The type ['a
+     nonterminal] represents a nonterminal symbol. In both cases, the index
+     ['a] represents the type of the semantic values associated with this
+     symbol. The concrete definitions of these types are generated. *)
+
+  type 'a terminal
+  type 'a nonterminal
+
+  (* The type ['a symbol] represents a terminal or nonterminal symbol. It is
+     the disjoint union of the types ['a terminal] and ['a nonterminal]. *)
+
+  type 'a symbol =
+    | T : 'a terminal -> 'a symbol
+    | N : 'a nonterminal -> 'a symbol
+
+  (* The type [xsymbol] is an existentially quantified version of the type
+     ['a symbol]. This type is useful in situations where the index ['a]
+     is not statically known. *)
+
+  type xsymbol =
+    | X : 'a symbol -> xsymbol
+
+end
+
+(* This signature describes the inspection API that is made available to the
+   user when [--inspection] is used. *)
+
+module type INSPECTION = sig
+
+  (* The types of symbols are described above. *)
+
+  include SYMBOLS
+
+  (* The type ['a lr1state] is meant to be the same as in [INCREMENTAL_ENGINE]. *)
+
+  type 'a lr1state
+
+  (* The type [production] is meant to be the same as in [INCREMENTAL_ENGINE].
+     It represents a production of the grammar. A production can be examined
+     via the functions [lhs] and [rhs] below. *)
+
+  type production
+
+  (* An LR(0) item is a pair of a production [prod] and a valid index [i] into
+     this production. That is, if the length of [rhs prod] is [n], then [i] is
+     comprised between 0 and [n], inclusive. *)
+
+  type item =
+      production * int
+
+  (* Ordering functions. *)
+
+  val compare_terminals: _ terminal -> _ terminal -> int
+  val compare_nonterminals: _ nonterminal -> _ nonterminal -> int
+  val compare_symbols: xsymbol -> xsymbol -> int
+  val compare_productions: production -> production -> int
+  val compare_items: item -> item -> int
+
+  (* [incoming_symbol s] is the incoming symbol of the state [s], that is,
+     the symbol that the parser must recognize before (has recognized when)
+     it enters the state [s]. This function gives access to the semantic
+     value [v] stored in a stack element [Element (s, v, _, _)]. Indeed,
+     by case analysis on the symbol [incoming_symbol s], one discovers the
+     type ['a] of the value [v]. *)
+
+  val incoming_symbol: 'a lr1state -> 'a symbol
+
+  (* [items s] is the set of the LR(0) items in the LR(0) core of the LR(1)
+     state [s]. This set is not epsilon-closed. This set is presented as a
+     list, in an arbitrary order. *)
+
+  val items: _ lr1state -> item list
+
+  (* [lhs prod] is the left-hand side of the production [prod]. This is
+     always a non-terminal symbol. *)
+
+  val lhs: production -> xsymbol
+
+  (* [rhs prod] is the right-hand side of the production [prod]. This is
+     a (possibly empty) sequence of (terminal or nonterminal) symbols. *)
+
+  val rhs: production -> xsymbol list
+
+  (* [nullable nt] tells whether the non-terminal symbol [nt] is nullable.
+     That is, it is true if and only if this symbol produces the empty
+     word [epsilon]. *)
+
+  val nullable: _ nonterminal -> bool
+
+  (* [first nt t] tells whether the FIRST set of the nonterminal symbol [nt]
+     contains the terminal symbol [t]. That is, it is true if and only if
+     [nt] produces a word that begins with [t]. *)
+
+  val first: _ nonterminal -> _ terminal -> bool
+
+  (* [xfirst] is analogous to [first], but expects a first argument of type
+     [xsymbol] instead of [_ terminal]. *)
+
+  val xfirst: xsymbol -> _ terminal -> bool
+
+  (* [foreach_terminal] enumerates the terminal symbols, including [error].
+     [foreach_terminal_but_error] enumerates the terminal symbols, excluding
+     [error]. *)
+
+  val foreach_terminal:           (xsymbol -> 'a -> 'a) -> 'a -> 'a
+  val foreach_terminal_but_error: (xsymbol -> 'a -> 'a) -> 'a -> 'a
+
+  (* The type [env] is meant to be the same as in [INCREMENTAL_ENGINE]. *)
+
+  type 'a env
+
+  (* [feed symbol startp semv endp env] causes the parser to consume the
+     (terminal or nonterminal) symbol [symbol], accompanied with the semantic
+     value [semv] and with the start and end positions [startp] and [endp].
+     Thus, the automaton makes a transition, and reaches a new state. The
+     stack grows by one cell. This operation is permitted only if the current
+     state (as determined by [env]) has an outgoing transition labeled with
+     [symbol]. Otherwise, [Invalid_argument _] is raised. *)
+
+  val feed: 'a symbol -> position -> 'a -> position -> 'b env -> 'b env
+
+end
+
+(* This signature combines the incremental API and the inspection API. *)
+
+module type EVERYTHING = sig
+
+  include INCREMENTAL_ENGINE
+
+  include INSPECTION
+    with type 'a lr1state := 'a lr1state
+    with type production := production
+    with type 'a env := 'a env
+
+end
+end
+module EngineTypes = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* This file defines several types and module types that are used in the
+   specification of module [Engine]. *)
+
+(* --------------------------------------------------------------------------- *)
+
+(* It would be nice if we could keep the structure of stacks and environments
+   hidden. However, stacks and environments must be accessible to semantic
+   actions, so the following data structure definitions must be public. *)
+
+(* --------------------------------------------------------------------------- *)
+
+(* A stack is a linked list of cells. A sentinel cell -- which is its own
+   successor -- is used to mark the bottom of the stack. The sentinel cell
+   itself is not significant -- it contains dummy values. *)
+
+type ('state, 'semantic_value) stack = {
+
+  (* The state that we should go back to if we pop this stack cell. *)
+
+  (* This convention means that the state contained in the top stack cell is
+     not the current state [env.current]. It also means that the state found
+     within the sentinel is a dummy -- it is never consulted. This convention
+     is the same as that adopted by the code-based back-end. *)
+
+  state: 'state;
+
+  (* The semantic value associated with the chunk of input that this cell
+     represents. *)
+
+  semv: 'semantic_value;
+
+  (* The start and end positions of the chunk of input that this cell
+     represents. *)
+
+  startp: Lexing.position;
+  endp: Lexing.position;
+
+  (* The next cell down in the stack. If this is a self-pointer, then this
+     cell is the sentinel, and the stack is conceptually empty. *)
+
+  next: ('state, 'semantic_value) stack;
+
+}
+
+(* --------------------------------------------------------------------------- *)
+
+(* A parsing environment contains all of the parser's state (except for the
+   current program point). *)
+
+type ('state, 'semantic_value, 'token) env = {
+
+  (* If this flag is true, then the first component of [env.triple] should
+     be ignored, as it has been logically overwritten with the [error]
+     pseudo-token. *)
+
+  error: bool;
+
+  (* The last token that was obtained from the lexer, together with its start
+     and end positions. Warning: before the first call to the lexer has taken
+     place, a dummy (and possibly invalid) token is stored here. *)
+
+  triple: 'token * Lexing.position * Lexing.position;
+
+  (* The stack. In [CodeBackend], it is passed around on its own,
+     whereas, here, it is accessed via the environment. *)
+
+  stack: ('state, 'semantic_value) stack;
+
+  (* The current state. In [CodeBackend], it is passed around on its
+     own, whereas, here, it is accessed via the environment. *)
+
+  current: 'state;
+
+}
+
+(* --------------------------------------------------------------------------- *)
+
+(* This signature describes the parameters that must be supplied to the LR
+   engine. *)
+
+module type TABLE = sig
+
+  (* The type of automaton states. *)
+
+  type state
+
+  (* States are numbered. *)
+
+  val number: state -> int
+
+  (* The type of tokens. These can be thought of as real tokens, that is,
+     tokens returned by the lexer. They carry a semantic value. This type
+     does not include the [error] pseudo-token. *)
+
+  type token
+
+  (* The type of terminal symbols. These can be thought of as integer codes.
+     They do not carry a semantic value. This type does include the [error]
+     pseudo-token. *)
+
+  type terminal
+
+  (* The type of nonterminal symbols. *)
+
+  type nonterminal
+
+  (* The type of semantic values. *)
+
+  type semantic_value
+
+  (* A token is conceptually a pair of a (non-[error]) terminal symbol and
+     a semantic value. The following two functions are the pair projections. *)
+
+  val token2terminal: token -> terminal
+  val token2value: token -> semantic_value
+
+  (* Even though the [error] pseudo-token is not a real token, it is a
+     terminal symbol. Furthermore, for regularity, it must have a semantic
+     value. *)
+
+  val error_terminal: terminal
+  val error_value: semantic_value
+
+  (* [foreach_terminal] allows iterating over all terminal symbols. *)
+
+  val foreach_terminal: (terminal -> 'a -> 'a) -> 'a -> 'a
+
+  (* The type of productions. *)
+
+  type production
+
+  val production_index: production -> int
+  val find_production: int -> production
+
+  (* If a state [s] has a default reduction on production [prod], then, upon
+     entering [s], the automaton should reduce [prod] without consulting the
+     lookahead token. The following function allows determining which states
+     have default reductions. *)
+
+  (* Instead of returning a value of a sum type -- either [DefRed prod], or
+     [NoDefRed] -- it accepts two continuations, and invokes just one of
+     them. This mechanism allows avoiding a memory allocation. *)
+
+  val default_reduction:
+    state ->
+    ('env -> production -> 'answer) ->
+    ('env -> 'answer) ->
+    'env -> 'answer
+
+  (* An LR automaton can normally take three kinds of actions: shift, reduce,
+     or fail. (Acceptance is a particular case of reduction: it consists in
+     reducing a start production.) *)
+
+  (* There are two variants of the shift action. [shift/discard s] instructs
+     the automaton to discard the current token, request a new one from the
+     lexer, and move to state [s]. [shift/nodiscard s] instructs it to move to
+     state [s] without requesting a new token. This instruction should be used
+     when [s] has a default reduction on [#]. See [CodeBackend.gettoken] for
+     details. *)
+
+  (* This is the automaton's action table. It maps a pair of a state and a
+     terminal symbol to an action. *)
+
+  (* Instead of returning a value of a sum type -- one of shift/discard,
+     shift/nodiscard, reduce, or fail -- this function accepts three
+     continuations, and invokes just one them. This mechanism allows avoiding
+     a memory allocation. *)
+
+  (* In summary, the parameters to [action] are as follows:
+
+     - the first two parameters, a state and a terminal symbol, are used to
+       look up the action table;
+
+     - the next parameter is the semantic value associated with the above
+       terminal symbol; it is not used, only passed along to the shift
+       continuation, as explained below;
+
+     - the shift continuation expects an environment; a flag that tells
+       whether to discard the current token; the terminal symbol that
+       is being shifted; its semantic value; and the target state of
+       the transition;
+
+     - the reduce continuation expects an environment and a production;
+
+     - the fail continuation expects an environment;
+
+     - the last parameter is the environment; it is not used, only passed
+       along to the selected continuation. *)
+
+  val action:
+    state ->
+    terminal ->
+    semantic_value ->
+    ('env -> bool -> terminal -> semantic_value -> state -> 'answer) ->
+    ('env -> production -> 'answer) ->
+    ('env -> 'answer) ->
+    'env -> 'answer
+
+  (* 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. *)
+
+  (* The function [goto_nt] can be applied to [s] and [nt] ONLY if the state
+     [s] has an outgoing transition labeled [nt]. Otherwise, its result is
+     undefined. Similarly, the call [goto_prod prod s] is permitted ONLY if
+     the state [s] has an outgoing transition labeled with the nonterminal
+     symbol [lhs prod]. The function [maybe_goto_nt] involves an additional
+     dynamic check and CAN be called even if there is no outgoing transition. *)
+
+  val       goto_nt  : state -> nonterminal -> state
+  val       goto_prod: state -> production  -> state
+  val maybe_goto_nt:   state -> nonterminal -> state option
+
+  (* [is_start prod] tells whether the production [prod] is a start production. *)
+
+  val is_start: production -> bool
+
+  (* By convention, a semantic action is responsible for:
+
+     1. fetching whatever semantic values and positions it needs off the stack;
+
+     2. popping an appropriate number of cells off the stack, as dictated
+        by the length of the right-hand side of the production;
+
+     3. computing a new semantic value, as well as new start and end positions;
+
+     4. pushing a new stack cell, which contains the three values
+        computed in step 3;
+
+     5. returning the new stack computed in steps 2 and 4.
+
+     Point 1 is essentially forced upon us: if semantic values were fetched
+     off the stack by this interpreter, then the calling convention for
+     semantic actions would be variadic: not all semantic actions would have
+     the same number of arguments. The rest follows rather naturally. *)
+
+  (* Semantic actions are allowed to raise [Error]. *)
+
+  exception Error
+
+  type semantic_action =
+      (state, semantic_value, token) env -> (state, semantic_value) stack
+
+  val semantic_action: production -> semantic_action
+
+  (* [may_reduce state prod] tests whether the state [state] is capable of
+     reducing the production [prod]. This function is currently costly and
+     is not used by the core LR engine. It is used in the implementation
+     of certain functions, such as [force_reduction], which allow the engine
+     to be driven programmatically. *)
+
+  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 () to 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  / Accepting *)
+
+    val reduce_or_accept: production -> unit
+
+    (* Lookahead token is now  (-) *)
+
+    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  *)
+
+    val handling_error: state -> unit
+
+  end
+
+end
+
+(* --------------------------------------------------------------------------- *)
+
+(* This signature describes the monolithic (traditional) LR engine. *)
+
+(* In this interface, the parser controls the lexer. *)
+
+module type MONOLITHIC_ENGINE = sig
+
+  type state
+
+  type token
+
+  type semantic_value
+
+  (* An entry point to the engine requires a start state, a lexer, and a lexing
+     buffer. It either succeeds and produces a semantic value, or fails and
+     raises [Error]. *)
+
+  exception Error
+
+  val entry:
+    state ->
+    (Lexing.lexbuf -> token) ->
+    Lexing.lexbuf ->
+    semantic_value
+
+end
+
+(* --------------------------------------------------------------------------- *)
+
+(* The following signatures describe the incremental LR engine. *)
+
+(* First, see [INCREMENTAL_ENGINE] in the file [IncrementalEngine.ml]. *)
+
+(* The [start] function is set apart because we do not wish to publish
+   it as part of the generated [parser.mli] file. Instead, the table
+   back-end will publish specialized versions of it, with a suitable
+   type cast. *)
+
+module type INCREMENTAL_ENGINE_START = sig
+
+  (* [start] is an entry point. It requires a start state and a start position
+     and begins the parsing process. If the lexer is based on an OCaml lexing
+     buffer, the start position should be [lexbuf.lex_curr_p]. [start] produces
+     a checkpoint, which usually will be an [InputNeeded] checkpoint. (It could
+     be [Accepted] if this starting state accepts only the empty word. It could
+     be [Rejected] if this starting state accepts no word at all.) It does not
+     raise any exception. *)
+
+  (* [start s pos] should really produce a checkpoint of type ['a checkpoint],
+     for a fixed ['a] that depends on the state [s]. We cannot express this, so
+     we use [semantic_value checkpoint], which is safe. The table back-end uses
+     [Obj.magic] to produce safe specialized versions of [start]. *)
+
+  type state
+  type semantic_value
+  type 'a checkpoint
+
+  val start:
+    state ->
+    Lexing.position ->
+    semantic_value checkpoint
+
+end
+
+(* --------------------------------------------------------------------------- *)
+
+(* This signature describes the LR engine, which combines the monolithic
+   and incremental interfaces. *)
+
+module type ENGINE = sig
+
+  include MONOLITHIC_ENGINE
+
+  include IncrementalEngine.INCREMENTAL_ENGINE
+    with type token := token
+     and type 'a lr1state = state (* useful for us; hidden from the end user *)
+
+  include INCREMENTAL_ENGINE_START
+    with type state := state
+     and type semantic_value := semantic_value
+     and type 'a checkpoint := 'a checkpoint
+
+end
+end
+module Engine = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+type position = Lexing.position
+open EngineTypes
+
+(* The LR parsing engine. *)
+
+(* This module is used:
+
+   - at compile time, if so requested by the user, via the --interpret options;
+   - at run time, in the table-based back-end. *)
+
+module Make (T : TABLE) = struct
+
+  (* This propagates type and exception definitions. The functions [number],
+     [production_index], [find_production], too, are defined by this [include]
+     declaration. *)
+
+  include T
+
+  type 'a env =
+      (state, semantic_value, token) EngineTypes.env
+
+  (* ------------------------------------------------------------------------ *)
+
+  (* The type [checkpoint] represents an intermediate or final result of the
+     parser. See [EngineTypes]. *)
+
+  (* The type [checkpoint] is presented to the user as a private type (see
+     [IncrementalEngine]). This prevents the user from manufacturing
+     checkpoints (i.e., continuations) that do not make sense. (Such
+     continuations could potentially violate the LR invariant and lead to
+     crashes.) *)
+
+  (* 2017/03/29 Although [checkpoint] is a private type, we now expose a
+     constructor function, [input_needed]. This function allows manufacturing
+     a checkpoint out of an environment. For this reason, the type [env] must
+     also be parameterized with ['a]. *)
+
+  type 'a checkpoint =
+    | InputNeeded of 'a env
+    | Shifting of 'a env * 'a env * bool
+    | AboutToReduce of 'a env * production
+    | HandlingError of 'a env
+    | Accepted of 'a
+    | Rejected
+
+  (* ------------------------------------------------------------------------ *)
+
+  (* In the code-based back-end, the [run] function is sometimes responsible
+     for pushing a new cell on the stack. This is motivated by code sharing
+     concerns. In this interpreter, there is no such concern; [run]'s caller
+     is always responsible for updating the stack. *)
+
+  (* In the code-based back-end, there is a [run] function for each state
+     [s]. This function can behave in two slightly different ways, depending
+     on when it is invoked, or (equivalently) depending on [s].
+
+     If [run] is invoked after shifting a terminal symbol (or, equivalently,
+     if [s] has a terminal incoming symbol), then [run] discards a token,
+     unless [s] has a default reduction on [#]. (Indeed, in that case,
+     requesting the next token might drive the lexer off the end of the input
+     stream.)
+
+     If, on the other hand, [run] is invoked after performing a goto
+     transition, or invoked directly by an entry point, then there is nothing
+     to discard.
+
+     These two cases are reflected in [CodeBackend.gettoken].
+
+     Here, the code is structured in a slightly different way. It is up to the
+     caller of [run] to indicate whether to discard a token, via the parameter
+     [please_discard]. This flag is set when [s] is being entered by shifting
+     a terminal symbol and [s] does not have a default reduction on [#]. *)
+
+  (* 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]. *)
+
+  let rec run env please_discard : semantic_value checkpoint =
+
+    (* Log the fact that we just entered this state. *)
+
+    if log then
+      Log.state env.current;
+
+    (* If [please_discard] is set, we discard the current lookahead token and
+       fetch the next one. In order to request a token from the user, we
+       return an [InputNeeded] continuation, which, when invoked by the user,
+       will take us to [discard]. If [please_discard] is not set, we skip this
+       step and jump directly to [check_for_default_reduction]. *)
+
+    if please_discard then
+      InputNeeded env
+    else
+      check_for_default_reduction env
+
+  (* [discard env triple] stores [triple] into [env], overwriting the previous
+     token. It is invoked by [offer], which itself is invoked by the user in
+     response to an [InputNeeded] checkpoint. *)
+
+  and discard env triple =
+    if log then begin
+      let (token, startp, endp) = triple in
+      Log.lookahead_token (T.token2terminal token) startp endp
+    end;
+    let env = { env with error = false; triple } in
+    check_for_default_reduction env
+
+  and check_for_default_reduction env =
+
+    (* Examine what situation we are in. This case analysis is analogous to
+       that performed in [CodeBackend.gettoken], in the sub-case where we do
+       not have a terminal incoming symbol. *)
+
+    T.default_reduction
+      env.current
+      announce_reduce       (* there is a default reduction; perform it *)
+      check_for_error_token (* there is none; continue below *)
+      env
+
+  and check_for_error_token env =
+
+    (* There is no default reduction. Consult the current lookahead token
+       so as to determine which action should be taken. *)
+
+    (* Peeking at the first input token, without taking it off the input
+       stream, is done by reading [env.triple]. We are careful to first
+       check [env.error]. *)
+
+    (* Note that, if [please_discard] was true, then we have just called
+       [discard], so the lookahead token cannot be [error]. *)
+
+    (* Returning [HandlingError env] is equivalent to calling [error env]
+       directly, except it allows the user to regain control. *)
+
+    if env.error then begin
+      if log then
+        Log.resuming_error_handling();
+      HandlingError env
+    end
+    else
+      let (token, _, _) = env.triple in
+
+      (* We consult the two-dimensional action table, indexed by the
+         current state and the current lookahead token, in order to
+         determine which action should be taken. *)
+
+      T.action
+        env.current                    (* determines a row *)
+        (T.token2terminal token)       (* determines a column *)
+        (T.token2value token)
+        shift                          (* shift continuation *)
+        announce_reduce                (* reduce continuation *)
+        initiate                       (* failure continuation *)
+        env
+
+  (* ------------------------------------------------------------------------ *)
+
+  (* This function takes care of shift transitions along a terminal symbol.
+     (Goto transitions are taken care of within [reduce] below.) The symbol
+     can be either an actual token or the [error] pseudo-token. *)
+
+  (* Here, the lookahead token CAN be [error]. *)
+
+  and shift env
+      (please_discard : bool)
+      (terminal : terminal)
+      (value : semantic_value)
+      (s' : state) =
+
+    (* Log the transition. *)
+
+    if log then
+      Log.shift terminal s';
+
+    (* Push a new cell onto the stack, containing the identity of the
+       state that we are leaving. *)
+
+    let (_, startp, endp) = env.triple in
+    let stack = {
+      state = env.current;
+      semv = value;
+      startp;
+      endp;
+      next = env.stack;
+    } in
+
+    (* Switch to state [s']. *)
+
+    let new_env = { env with stack; current = s' } in
+
+    (* Expose the transition to the user. (In principle, we have a choice
+       between exposing the transition before we take it, after we take
+       it, or at some point in between. This affects the number and type
+       of the parameters carried by [Shifting]. Here, we choose to expose
+       the transition after we take it; this allows [Shifting] to carry
+       only three parameters, whose meaning is simple.) *)
+
+    Shifting (env, new_env, please_discard)
+
+  (* ------------------------------------------------------------------------ *)
+
+  (* The function [announce_reduce] stops the parser and returns a checkpoint
+     which allows the parser to be resumed by calling [reduce]. *)
+
+  (* Only ordinary productions are exposed to the user. Start productions
+     are not exposed to the user. Reducing a start production simply leads
+     to the successful termination of the parser. *)
+
+  and announce_reduce env (prod : production) =
+    if T.is_start prod then
+      accept env prod
+    else
+      AboutToReduce (env, prod)
+
+  (* The function [reduce] takes care of reductions. It is invoked by
+     [resume] after an [AboutToReduce] event has been produced. *)
+
+  (* Here, the lookahead token CAN be [error]. *)
+
+  (* The production [prod] CANNOT be a start production. *)
+
+  and reduce env (prod : production) =
+
+    (* Log a reduction event. *)
+
+    if log then
+      Log.reduce_or_accept prod;
+
+    (* 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,
+       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. *)
+
+    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. *)
+
+        (* 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
+
+  and accept env prod =
+    (* Log an accept event. *)
+    if log then
+      Log.reduce_or_accept prod;
+    (* Extract the semantic value out of the stack. *)
+    let v = env.stack.semv in
+    (* Finish. *)
+    Accepted v
+
+  (* ------------------------------------------------------------------------ *)
+
+  (* The following functions deal with errors. *)
+
+  (* [initiate] initiates or resumes error handling. *)
+
+  (* Here, the lookahead token CAN be [error]. *)
+
+  and initiate env =
+    if log then
+      Log.initiating_error_handling();
+    let env = { env with error = true } in
+    HandlingError env
+
+  (* [error] handles errors. *)
+
+  and error env =
+    assert env.error;
+
+    (* Consult the column associated with the [error] pseudo-token in the
+       action table. *)
+
+    T.action
+      env.current                    (* determines a row *)
+      T.error_terminal               (* determines a column *)
+      T.error_value
+      error_shift                    (* shift continuation *)
+      error_reduce                   (* reduce continuation *)
+      error_fail                     (* failure continuation *)
+      env
+
+  and error_shift env please_discard terminal value s' =
+
+    (* Here, [terminal] is [T.error_terminal],
+       and [value] is [T.error_value]. *)
+
+    assert (terminal = T.error_terminal && value = T.error_value);
+
+    (* This state is capable of shifting the [error] token. *)
+
+    if log then
+      Log.handling_error env.current;
+    shift env please_discard terminal value s'
+
+  and error_reduce env prod =
+
+    (* This state is capable of performing a reduction on [error]. *)
+
+    if log then
+      Log.handling_error env.current;
+    reduce env prod
+      (* Intentionally calling [reduce] instead of [announce_reduce].
+         It does not seem very useful, and it could be confusing, to
+         expose the reduction steps taken during error handling. *)
+
+  and error_fail env =
+
+    (* This state is unable to handle errors. Attempt to pop a stack
+       cell. *)
+
+    let cell = env.stack in
+    let next = cell.next in
+    if next == cell then
+
+      (* The stack is empty. Die. *)
+
+      Rejected
+
+    else begin
+
+      (* The stack is nonempty. Pop a cell, updating the current state
+         with that found in the popped cell, and try again. *)
+
+      let env = { env with
+        stack = next;
+        current = cell.state
+      } in
+      HandlingError env
+
+    end
+
+  (* End of the nest of tail recursive functions. *)
+
+  (* ------------------------------------------------------------------------ *)
+  (* ------------------------------------------------------------------------ *)
+
+  (* The incremental interface. See [EngineTypes]. *)
+
+  (* [start s] begins the parsing process. *)
+
+  let start (s : state) (initial : position) : semantic_value checkpoint =
+
+    (* Build an empty stack. This is a dummy cell, which is its own successor.
+       Its [next] field WILL be accessed by [error_fail] if an error occurs and
+       is propagated all the way until the stack is empty. Its [endp] field WILL
+       be accessed (by a semantic action) if an epsilon production is reduced
+       when the stack is empty. *)
+
+    let rec empty = {
+      state = s;                          (* dummy *)
+      semv = T.error_value;               (* dummy *)
+      startp = initial;                   (* dummy *)
+      endp = initial;
+      next = empty;
+    } in
+
+    (* Build an initial environment. *)
+
+    (* Unfortunately, there is no type-safe way of constructing a
+       dummy token. Tokens carry semantic values, which in general
+       we cannot manufacture. This instance of [Obj.magic] could
+       be avoided by adopting a different representation (e.g., no
+       [env.error] field, and an option in the first component of
+       [env.triple]), but I like this representation better. *)
+
+    let dummy_token = Obj.magic () in
+    let env = {
+      error = false;
+      triple = (dummy_token, initial, initial); (* dummy *)
+      stack = empty;
+      current = s;
+    } in
+
+    (* Begin parsing. *)
+
+    (* The parameter [please_discard] here is [true], which means we know
+       that we must read at least one token. This claim relies on the fact
+       that we have ruled out the two special cases where a start symbol
+       recognizes the empty language or the singleton language {epsilon}. *)
+
+    run env true
+
+  (* [offer checkpoint triple] is invoked by the user in response to a
+     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. *)
+
+  (* In reality, [offer] and [resume] accept an argument of type
+     [semantic_value checkpoint] and produce a checkpoint of the same type.
+     The choice of [semantic_value] is forced by the fact that this is the
+     parameter of the checkpoint [Accepted]. *)
+
+  (* We change this as follows. *)
+
+  (* We change the argument and result type of [offer] and [resume] from
+     [semantic_value checkpoint] to ['a checkpoint]. This is safe, in this
+     case, because we give the user access to values of type [t checkpoint]
+     only if [t] is indeed the type of the eventual semantic value for this
+     run. (More precisely, by examining the signatures [INCREMENTAL_ENGINE]
+     and [INCREMENTAL_ENGINE_START], one finds that the user can build a value
+     of type ['a checkpoint] only if ['a] is [semantic_value]. The table
+     back-end goes further than this and produces versions of [start] composed
+     with a suitable cast, which give the user access to a value of type
+     [t checkpoint] where [t] is the type of the start symbol.) *)
+
+  let offer : 'a . 'a checkpoint ->
+                   token * position * position ->
+                   'a checkpoint
+  = function
+    | InputNeeded env ->
+        Obj.magic discard env
+    | _ ->
+        invalid_arg "offer expects InputNeeded"
+
+  let resume : 'a . 'a checkpoint -> 'a checkpoint = function
+    | HandlingError env ->
+        Obj.magic error env
+    | Shifting (_, env, please_discard) ->
+        Obj.magic run env please_discard
+    | AboutToReduce (env, prod) ->
+        Obj.magic reduce env prod
+    | _ ->
+        invalid_arg "resume expects HandlingError | Shifting | AboutToReduce"
+
+  (* ------------------------------------------------------------------------ *)
+  (* ------------------------------------------------------------------------ *)
+
+  (* The traditional interface. See [EngineTypes]. *)
+
+  (* ------------------------------------------------------------------------ *)
+
+  (* Wrapping a lexer and lexbuf as a token supplier. *)
+
+  type supplier =
+    unit -> token * position * position
+
+  let lexer_lexbuf_to_supplier
+      (lexer : Lexing.lexbuf -> token)
+      (lexbuf : Lexing.lexbuf)
+  : supplier =
+    fun () ->
+      let token = lexer lexbuf in
+      let startp = lexbuf.Lexing.lex_start_p
+      and endp = lexbuf.Lexing.lex_curr_p in
+      token, startp, endp
+
+  (* ------------------------------------------------------------------------ *)
+
+  (* The main loop repeatedly handles intermediate checkpoints, until a final
+     checkpoint is obtained. This allows implementing the monolithic interface
+     ([entry]) in terms of the incremental interface ([start], [offer],
+     [handle], [reduce]). *)
+
+  (* By convention, acceptance is reported by returning a semantic value,
+     whereas rejection is reported by raising [Error]. *)
+
+  (* [loop] is polymorphic in ['a]. No cheating is involved in achieving this.
+     All of the cheating resides in the types assigned to [offer] and [handle]
+     above. *)
+
+  let rec loop : 'a . supplier -> 'a checkpoint -> 'a =
+    fun read checkpoint ->
+    match checkpoint with
+    | InputNeeded _ ->
+        (* The parser needs a token. Request one from the lexer,
+           and offer it to the parser, which will produce a new
+           checkpoint. Then, repeat. *)
+        let triple = read() in
+        let checkpoint = offer checkpoint triple in
+        loop read checkpoint
+    | Shifting _
+    | AboutToReduce _
+    | HandlingError _ ->
+        (* The parser has suspended itself, but does not need
+           new input. Just resume the parser. Then, repeat. *)
+        let checkpoint = resume checkpoint in
+        loop read checkpoint
+    | Accepted v ->
+        (* The parser has succeeded and produced a semantic value.
+           Return this semantic value to the user. *)
+        v
+    | Rejected ->
+        (* The parser rejects this input. Raise an exception. *)
+        raise Error
+
+  let entry (s : state) lexer lexbuf : semantic_value =
+    let initial = lexbuf.Lexing.lex_curr_p in
+    loop (lexer_lexbuf_to_supplier lexer lexbuf) (start s initial)
+
+  (* ------------------------------------------------------------------------ *)
+
+  (* [loop_handle] stops if it encounters an error, and at this point, invokes
+     its failure continuation, without letting Menhir do its own traditional
+     error-handling (which involves popping the stack, etc.). *)
+
+  let rec loop_handle succeed fail read checkpoint =
+    match checkpoint with
+    | InputNeeded _ ->
+        let triple = read() in
+        let checkpoint = offer checkpoint triple in
+        loop_handle succeed fail read checkpoint
+    | Shifting _
+    | AboutToReduce _ ->
+        let checkpoint = resume checkpoint in
+        loop_handle succeed fail read checkpoint
+    | HandlingError _
+    | Rejected ->
+        (* The parser has detected an error. Invoke the failure continuation. *)
+        fail checkpoint
+    | Accepted v ->
+        (* The parser has succeeded and produced a semantic value. Invoke the
+           success continuation. *)
+        succeed v
+
+  (* ------------------------------------------------------------------------ *)
+
+  (* [loop_handle_undo] is analogous to [loop_handle], except it passes a pair
+     of checkpoints to the failure continuation.
+
+     The first (and oldest) checkpoint is the last [InputNeeded] checkpoint
+     that was encountered before the error was detected. The second (and
+     newest) checkpoint is where the error was detected, as in [loop_handle].
+     Going back to the first checkpoint can be thought of as undoing any
+     reductions that were performed after seeing the problematic token. (These
+     reductions must be default reductions or spurious reductions.) *)
+
+  let rec loop_handle_undo succeed fail read (inputneeded, checkpoint) =
+    match checkpoint with
+    | InputNeeded _ ->
+        (* Update the last recorded [InputNeeded] checkpoint. *)
+        let inputneeded = checkpoint in
+        let triple = read() in
+        let checkpoint = offer checkpoint triple in
+        loop_handle_undo succeed fail read (inputneeded, checkpoint)
+    | Shifting _
+    | AboutToReduce _ ->
+        let checkpoint = resume checkpoint in
+        loop_handle_undo succeed fail read (inputneeded, checkpoint)
+    | HandlingError _
+    | Rejected ->
+        fail inputneeded checkpoint
+    | Accepted v ->
+        succeed v
+
+  (* For simplicity, we publish a version of [loop_handle_undo] that takes a
+     single checkpoint as an argument, instead of a pair of checkpoints. We
+     check that the argument is [InputNeeded _], and duplicate it. *)
+
+  (* The parser cannot accept or reject before it asks for the very first
+     character of input. (Indeed, we statically reject a symbol that
+     generates the empty language or the singleton language {epsilon}.)
+     So, the [start] checkpoint must match [InputNeeded _]. Hence, it is
+     permitted to call [loop_handle_undo] with a [start] checkpoint. *)
+
+  let loop_handle_undo succeed fail read checkpoint =
+    assert (match checkpoint with InputNeeded _ -> true | _ -> false);
+    loop_handle_undo succeed fail read (checkpoint, checkpoint)
+
+  (* ------------------------------------------------------------------------ *)
+
+  let rec shifts checkpoint =
+    match checkpoint with
+    | Shifting (env, _, _) ->
+        (* The parser is about to shift, which means it is willing to
+           consume the terminal symbol that we have fed it. Return the
+           state just before this transition. *)
+        Some env
+    | AboutToReduce _ ->
+        (* The parser wishes to reduce. Just follow. *)
+        shifts (resume checkpoint)
+    | HandlingError _ ->
+        (* The parser fails, which means it rejects the terminal symbol
+           that we have fed it. *)
+        None
+    | InputNeeded _
+    | Accepted _
+    | Rejected ->
+        (* None of these cases can arise. Indeed, after a token is submitted
+           to it, the parser must shift, reduce, or signal an error, before
+           it can request another token or terminate. *)
+        assert false
+
+  let acceptable checkpoint token pos =
+    let triple = (token, pos, pos) in
+    let checkpoint = offer checkpoint triple in
+    match shifts checkpoint with
+    | None      -> false
+    | Some _env -> true
+
+  (* ------------------------------------------------------------------------ *)
+
+  (* The type ['a lr1state] describes the (non-initial) states of the LR(1)
+     automaton. The index ['a] represents the type of the semantic value
+     associated with the state's incoming symbol. *)
+
+  (* The type ['a lr1state] is defined as an alias for [state], which itself
+     is usually defined as [int] (see [TableInterpreter]). So, ['a lr1state]
+     is technically a phantom type, but should really be thought of as a GADT
+     whose data constructors happen to be represented as integers. It is
+     presented to the user as an abstract type (see [IncrementalEngine]). *)
+
+  type 'a lr1state =
+      state
+
+  (* ------------------------------------------------------------------------ *)
+
+  (* Stack inspection. *)
+
+  (* We offer a read-only view of the parser's state as a stream of elements.
+     Each element contains a pair of a (non-initial) state and a semantic
+     value associated with (the incoming symbol of) this state. Note that the
+     type [element] is an existential type. *)
+
+  (* As of 2017/03/31, the type [stack] and the function [stack] are DEPRECATED.
+     If desired, they could now be implemented outside Menhir, by relying on
+     the functions [top] and [pop]. *)
+
+  type element =
+    | Element: 'a lr1state * 'a * position * position -> element
+
+  open General
+
+  type stack =
+    element stream
+
+  (* If [current] is the current state and [cell] is the top stack cell,
+     then [stack cell current] is a view of the parser's state as a stream
+     of elements. *)
+
+  let rec stack cell current : element stream =
+    lazy (
+      (* The stack is empty iff the top stack cell is its own successor. In
+         that case, the current state [current] should be an initial state
+         (which has no incoming symbol).
+         We do not allow the user to inspect this state. *)
+      let next = cell.next in
+      if next == cell then
+        Nil
+      else
+        (* Construct an element containing the current state [current] as well
+           as the semantic value contained in the top stack cell. This semantic
+           value is associated with the incoming symbol of this state, so it
+           makes sense to pair them together. The state has type ['a state] and
+           the semantic value has type ['a], for some type ['a]. Here, the OCaml
+           type-checker thinks ['a] is [semantic_value] and considers this code
+           well-typed. Outside, we will use magic to provide the user with a way
+           of inspecting states and recovering the value of ['a]. *)
+        let element = Element (
+          current,
+          cell.semv,
+          cell.startp,
+          cell.endp
+        ) in
+        Cons (element, stack next cell.state)
+    )
+
+  let stack env : element stream =
+    stack env.stack env.current
+
+  (* As explained above, the function [top] allows access to the top stack
+     element only if the stack is nonempty, i.e., only if the current state
+     is not an initial state. *)
+
+  let top env : element option =
+    let cell = env.stack in
+    let next = cell.next in
+    if next == cell then
+      None
+    else
+      Some (Element (env.current, cell.semv, cell.startp, cell.endp))
+
+  (* [equal] compares the stacks for physical equality, and compares the
+     current states via their numbers (this seems cleaner than using OCaml's
+     polymorphic equality). *)
+
+  (* The two fields that are not compared by [equal], namely [error] and
+     [triple], are overwritten by the function [discard], which handles
+     [InputNeeded] checkpoints. Thus, if [equal env1 env2] holds, then the
+     checkpoints [input_needed env1] and [input_needed env2] are
+     equivalent: they lead the parser to behave in the same way. *)
+
+  let equal env1 env2 =
+    env1.stack == env2.stack &&
+    number env1.current = number env2.current
+
+  let current_state_number env =
+    number env.current
+
+  (* ------------------------------------------------------------------------ *)
+
+  (* Access to the position of the lookahead token. *)
+
+  let positions { triple = (_, startp, endp); _ } =
+    startp, endp
+
+  (* ------------------------------------------------------------------------ *)
+
+  (* Access to information about default reductions. *)
+
+  (* This can be a function of states, or a function of environments.
+     We offer both. *)
+
+  (* Instead of a Boolean result, we could return a [production option].
+     However, we would have to explicitly test whether [prod] is a start
+     production, and in that case, return [None], I suppose. Indeed, we
+     have decided not to expose the start productions. *)
+
+  let state_has_default_reduction (state : _ lr1state) : bool =
+    T.default_reduction state
+      (fun _env _prod -> true)
+      (fun _env -> false)
+      ()
+
+  let env_has_default_reduction env =
+    state_has_default_reduction env.current
+
+  (* ------------------------------------------------------------------------ *)
+
+  (* The following functions work at the level of environments (as opposed to
+     checkpoints). The function [pop] causes the automaton to go back into the
+     past, pretending that the last input symbol has never been read. The
+     function [force_reduction] causes the automaton to re-interpret the past,
+     by recognizing the right-hand side of a production and reducing this
+     production. The function [feed] causes the automaton to progress into the
+     future by pretending that a (terminal or nonterminal) symbol has been
+     read. *)
+
+  (* The function [feed] would ideally be defined here. However, for this
+     function to be type-safe, the GADT ['a symbol] is needed. For this
+     reason, we move its definition to [InspectionTableInterpreter], where
+     the inspection API is available. *)
+
+  (* [pop] pops one stack cell. It cannot go wrong. *)
+
+  let pop (env : 'a env) : 'a env option =
+    let cell = env.stack in
+    let next = cell.next in
+    if next == cell then
+      (* The stack is empty. *)
+      None
+    else
+      (* The stack is nonempty. Pop off one cell. *)
+      Some { env with stack = next; current = cell.state }
+
+  (* [force_reduction] is analogous to [reduce], except that it does not
+     continue by calling [run env] or [initiate env]. Instead, it returns
+     [env] to the user. *)
+
+  (* [force_reduction] is dangerous insofar as it executes a semantic action.
+     This semantic action could have side effects: nontermination, state,
+     exceptions, input/output, etc. *)
+
+  let force_reduction prod (env : 'a env) : 'a env =
+    (* Check if this reduction is permitted. This check is REALLY important.
+       The stack must have the correct shape: that is, it must be sufficiently
+       high, and must contain semantic values of appropriate types, otherwise
+       the semantic action will crash and burn. *)
+    (* We currently check whether the current state is WILLING to reduce this
+       production (i.e., there is a reduction action in the action table row
+       associated with this state), whereas it would be more liberal to check
+       whether this state is CAPABLE of reducing this production (i.e., the
+       stack has an appropriate shape). We currently have no means of
+       performing such a check. *)
+    if not (T.may_reduce env.current prod) then
+      invalid_arg "force_reduction: this reduction is not permitted in this state"
+    else begin
+      (* We do not expose the start productions to the user, so this cannot be
+         a start production. Hence, it has a semantic action. *)
+      assert (not (T.is_start prod));
+      (* Invoke the semantic action. *)
+      let stack = T.semantic_action prod env in
+      (* Perform a goto transition. *)
+      let current = T.goto_prod stack.state prod in
+      { env with stack; current }
+    end
+
+  (* The environment manipulation functions -- [pop] and [force_reduction]
+     above, plus [feed] -- manipulate the automaton's stack and current state,
+     but do not affect the automaton's lookahead symbol. When the function
+     [input_needed] is used to go back from an environment to a checkpoint
+     (and therefore, resume normal parsing), the lookahead symbol is clobbered
+     anyway, since the only action that the user can take is to call [offer].
+     So far, so good. One problem, though, is that this call to [offer] may
+     well place the automaton in a configuration of a state [s] and a
+     lookahead symbol [t] that is normally unreachable. Also, perhaps the
+     state [s] is a state where an input symbol normally is never demanded, so
+     this [InputNeeded] checkpoint is fishy. There does not seem to be a deep
+     problem here, but, when programming an error recovery strategy, one
+     should pay some attention to this issue. Ideally, perhaps, one should use
+     [input_needed] only in a state [s] where an input symbol is normally
+     demanded, that is, a state [s] whose incoming symbol is a terminal symbol
+     and which does not have a default reduction on [#]. *)
+
+  let input_needed (env : 'a env) : 'a checkpoint =
+    InputNeeded env
+
+  (* The following functions are compositions of [top] and [pop]. *)
+
+  let rec pop_many i env =
+    if i = 0 then
+      Some env
+    else match pop env with
+    | None ->
+        None
+    | Some env ->
+        pop_many (i - 1) env
+
+  let get i env =
+    match pop_many i env with
+    | None ->
+        None
+    | Some env ->
+        top env
+
+end
+end
+module ErrorReports = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* -------------------------------------------------------------------------- *)
+
+(* A two-place buffer stores zero, one, or two elements. *)
+
+type 'a content =
+| Zero
+| One of 'a
+| Two of 'a * (* most recent: *) 'a
+
+type 'a buffer =
+  'a content ref
+
+(* [update buffer x] pushes [x] into [buffer], causing the buffer to slide. *)
+
+let update buffer x =
+  buffer :=
+    match !buffer, x with
+    | Zero, _ ->
+        One x
+    | One x1, x2
+    | Two (_, x1), x2 ->
+        Two (x1, x2)
+
+(* [show f buffer] prints the contents of the buffer. The function [f] is
+   used to print an element. *)
+
+let show f buffer : string =
+  match !buffer with
+  | Zero ->
+      (* The buffer cannot be empty. If we have read no tokens,
+         we cannot have detected a syntax error. *)
+      assert false
+  | One invalid ->
+      (* It is unlikely, but possible, that we have read just one token. *)
+      Printf.sprintf "before '%s'" (f invalid)
+  | Two (valid, invalid) ->
+      (* In the most likely case, we have read two tokens. *)
+      Printf.sprintf "after '%s' and before '%s'" (f valid) (f invalid)
+
+(* [last buffer] returns the last element of the buffer (that is, the invalid
+   token). *)
+
+let last buffer =
+  match !buffer with
+  | Zero ->
+      (* The buffer cannot be empty. If we have read no tokens,
+         we cannot have detected a syntax error. *)
+      assert false
+  | One invalid
+  | Two (_, invalid) ->
+      invalid
+
+(* [wrap buffer lexer] *)
+
+open Lexing
+
+let wrap lexer =
+  let buffer = ref Zero in
+  buffer,
+  fun lexbuf ->
+    let token = lexer lexbuf in
+    update buffer (lexbuf.lex_start_p, lexbuf.lex_curr_p);
+    token
+
+(* -------------------------------------------------------------------------- *)
+end
+module Printers = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+module Make
+  (I : IncrementalEngine.EVERYTHING)
+  (User : sig
+    val print: string -> unit
+    val print_symbol: I.xsymbol -> unit
+    val print_element: (I.element -> unit) option
+  end)
+= struct
+
+  let arrow = " -> "
+  let dot = "."
+  let space = " "
+  let newline = "\n"
+
+  open User
+  open I
+
+  (* Printing a list of symbols. An optional dot is printed at offset
+     [i] into the list [symbols], if this offset lies between [0] and
+     the length of the list (included). *)
+
+  let rec print_symbols i symbols =
+    if i = 0 then begin
+      print dot;
+      print space;
+      print_symbols (-1) symbols
+    end
+    else begin
+      match symbols with
+      | [] ->
+          ()
+      | symbol :: symbols ->
+          print_symbol symbol;
+          print space;
+          print_symbols (i - 1) symbols
+    end
+
+  (* Printing an element as a symbol. *)
+
+  let print_element_as_symbol element =
+    match element with
+    | Element (s, _, _, _) ->
+        print_symbol (X (incoming_symbol s))
+
+  (* Some of the functions that follow need an element printer. They use
+     [print_element] if provided by the user; otherwise they use
+     [print_element_as_symbol]. *)
+
+  let print_element =
+    match print_element with
+    | Some print_element ->
+        print_element
+    | None ->
+        print_element_as_symbol
+
+  (* Printing a stack as a list of symbols. Stack bottom on the left,
+     stack top on the right. *)
+
+  let rec print_stack env =
+    match top env, pop env with
+    | Some element, Some env ->
+        print_stack env;
+        print space;
+        print_element element
+    | _, _ ->
+        ()
+
+  let print_stack env =
+    print_stack env;
+    print newline
+
+  (* Printing an item. *)
+
+  let print_item (prod, i) =
+    print_symbol (lhs prod);
+    print arrow;
+    print_symbols i (rhs prod);
+    print newline
+
+  (* Printing a list of symbols (public version). *)
+
+  let print_symbols symbols =
+    print_symbols (-1) symbols
+
+  (* Printing a production (without a dot). *)
+
+  let print_production prod =
+    print_item (prod, -1)
+
+  (* Printing the current LR(1) state. *)
+
+  let print_current_state env =
+    print "Current LR(1) state: ";
+    match top env with
+    | None ->
+        print ""; (* TEMPORARY unsatisfactory *)
+        print newline
+    | Some (Element (current, _, _, _)) ->
+        print (string_of_int (number current));
+        print newline;
+        List.iter print_item (items current)
+
+  let print_env env =
+    print_stack env;
+    print_current_state env;
+    print newline
+
+end
+end
+module InfiniteArray = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(** This module implements infinite arrays, that is, arrays that grow
+    transparently upon demand. *)
+
+type 'a t = {
+    default: 'a;
+    mutable table: 'a array;
+    mutable extent: int; (* the index of the greatest [set] ever, plus one *)
+  }
+
+let default_size =
+  16384 (* must be non-zero *)
+
+let make x = {
+  default = x;
+  table = Array.make default_size x;
+  extent = 0;
+}
+
+let rec new_length length i =
+  if i < length then
+    length
+  else
+    new_length (2 * length) i
+
+let ensure a i =
+  assert (0 <= i);
+  let table = a.table in
+  let length = Array.length table in
+  if i >= length then begin
+    let table' = Array.make (new_length (2 * length) i) a.default in
+    Array.blit table 0 table' 0 length;
+    a.table <- table'
+  end
+
+let get a i =
+  ensure a i;
+  Array.unsafe_get a.table (i)
+
+let set a i x =
+  ensure a i;
+  Array.unsafe_set a.table (i) x;
+  if a.extent <= i then
+    a.extent <- i + 1
+
+let extent a =
+  a.extent
+
+let domain a =
+  Array.sub a.table 0 a.extent
+
+end
+module PackedIntArray = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* A packed integer array is represented as a pair of an integer [k] and
+   a string [s]. The integer [k] is the number of bits per integer that we
+   use. The string [s] is just an array of bits, which is read in 8-bit
+   chunks. *)
+
+(* The ocaml programming language treats string literals and array literals
+   in slightly different ways: the former are statically allocated, while
+   the latter are dynamically allocated. (This is rather arbitrary.) In the
+   context of Menhir's table-based back-end, where compact, immutable
+   integer arrays are needed, ocaml strings are preferable to ocaml arrays. *)
+
+type t =
+  int * string
+
+(* The magnitude [k] of an integer [v] is the number of bits required
+   to represent [v]. It is rounded up to the nearest power of two, so
+   that [k] divides [Sys.word_size]. *)
+
+let magnitude (v : int) =
+  if v < 0 then
+    Sys.word_size
+  else
+    let rec check k max = (* [max] equals [2^k] *)
+      if (max <= 0) || (v < max) then
+        k
+          (* if [max] just overflew, then [v] requires a full ocaml
+             integer, and [k] is the number of bits in an ocaml integer
+             plus one, that is, [Sys.word_size]. *)
+      else
+        check (2 * k) (max * max)
+    in
+    check 1 2
+
+(* [pack a] turns an array of integers into a packed integer array. *)
+
+(* Because the sign bit is the most significant bit, the magnitude of
+   any negative number is the word size. In other words, [pack] does
+   not achieve any space savings as soon as [a] contains any negative
+   numbers, even if they are ``small''. *)
+
+let pack (a : int array) : t =
+
+  let m = Array.length a in
+
+  (* Compute the maximum magnitude of the array elements. This tells
+     us how many bits per element we are going to use. *)
+
+  let k =
+    Array.fold_left (fun k v ->
+      max k (magnitude v)
+    ) 1 a
+  in
+
+  (* Because access to ocaml strings is performed on an 8-bit basis,
+     two cases arise. If [k] is less than 8, then we can pack multiple
+     array entries into a single character. If [k] is greater than 8,
+     then we must use multiple characters to represent a single array
+     entry. *)
+
+  if k <= 8 then begin
+
+    (* [w] is the number of array entries that we pack in a character. *)
+
+    assert (8 mod k = 0);
+    let w = 8 / k in
+
+    (* [n] is the length of the string that we allocate. *)
+
+    let n =
+      if m mod w = 0 then
+        m / w
+      else
+        m / w + 1
+    in
+
+    let s =
+      Bytes.create n
+    in
+
+    (* Define a reader for the source array. The reader might run off
+       the end if [w] does not divide [m]. *)
+
+    let i = ref 0 in
+    let next () =
+      let ii = !i in
+      if ii = m then
+        0 (* ran off the end, pad with zeroes *)
+      else
+        let v = a.(ii) in
+        i := ii + 1;
+        v
+    in
+
+    (* Fill up the string. *)
+
+    for j = 0 to n - 1 do
+      let c = ref 0 in
+      for _x = 1 to w do
+        c := (!c lsl k) lor next()
+      done;
+      Bytes.set s j (Char.chr !c)
+    done;
+
+    (* Done. *)
+
+    k, Bytes.unsafe_to_string s
+
+  end
+  else begin (* k > 8 *)
+
+    (* [w] is the number of characters that we use to encode an array entry. *)
+
+    assert (k mod 8 = 0);
+    let w = k / 8 in
+
+    (* [n] is the length of the string that we allocate. *)
+
+    let n =
+      m * w
+    in
+
+    let s =
+      Bytes.create n
+    in
+
+    (* Fill up the string. *)
+
+    for i = 0 to m - 1 do
+      let v = ref a.(i) in
+      for x = 1 to w do
+        Bytes.set s ((i + 1) * w - x) (Char.chr (!v land 255));
+        v := !v lsr 8
+      done
+    done;
+
+    (* Done. *)
+
+    k, Bytes.unsafe_to_string s
+
+  end
+
+(* Access to a string. *)
+
+let read (s : string) (i : int) : int =
+  Char.code (String.unsafe_get s i)
+
+(* [get1 t i] returns the integer stored in the packed array [t] at index [i].
+   It assumes (and does not check) that the array's bit width is [1]. The
+   parameter [t] is just a string. *)
+
+let get1 (s : string) (i : int) : int =
+  let c = read s (i lsr 3) in
+  let c = c lsr ((lnot i) land 0b111) in
+  let c = c land 0b1 in
+  c
+
+(* [get t i] returns the integer stored in the packed array [t] at index [i]. *)
+
+(* Together, [pack] and [get] satisfy the following property: if the index [i]
+   is within bounds, then [get (pack a) i] equals [a.(i)]. *)
+
+let get ((k, s) : t) (i : int) : int =
+  match k with
+  | 1 ->
+      get1 s i
+  | 2 ->
+      let c = read s (i lsr 2) in
+      let c = c lsr (2 * ((lnot i) land 0b11)) in
+      let c = c land 0b11 in
+      c
+  | 4 ->
+      let c = read s (i lsr 1) in
+      let c = c lsr (4 * ((lnot i) land 0b1)) in
+      let c = c land 0b1111 in
+      c
+  | 8 ->
+      read s i
+  | 16 ->
+      let j = 2 * i in
+      (read s j) lsl 8 + read s (j + 1)
+  | _ ->
+      assert (k = 32); (* 64 bits unlikely, not supported *)
+      let j = 4 * i in
+      (((read s j lsl 8) + read s (j + 1)) lsl 8 + read s (j + 2)) lsl 8 + read s (j + 3)
+
+(* [unflatten1 (n, data) i j] accesses the two-dimensional bitmap
+   represented by [(n, data)] at indices [i] and [j]. The integer
+   [n] is the width of the bitmap; the string [data] is the second
+   component of the packed array obtained by encoding the table as
+   a one-dimensional array. *)
+
+let unflatten1 (n, data) i j =
+   get1 data (n * i + j)
+
+end
+module RowDisplacement = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* This module compresses a two-dimensional table, where some values
+   are considered insignificant, via row displacement. *)
+
+(* This idea reportedly appears in Aho and Ullman's ``Principles
+   of Compiler Design'' (1977). It is evaluated in Tarjan and Yao's
+   ``Storing a Sparse Table'' (1979) and in Dencker, Dürre, and Heuft's
+   ``Optimization of Parser Tables for Portable Compilers'' (1984). *)
+
+(* A compressed table is represented as a pair of arrays. The
+   displacement array is an array of offsets into the data array. *)
+
+type 'a table =
+    int array * (* displacement *)
+     'a array   (* data *)
+
+(* In a natural version of this algorithm, displacements would be greater
+   than (or equal to) [-n]. However, in the particular setting of Menhir,
+   both arrays are intended to be compressed with [PackedIntArray], which
+   does not efficiently support negative numbers. For this reason, we are
+   careful not to produce negative displacements. *)
+
+(* In order to avoid producing negative displacements, we simply use the
+   least significant bit as the sign bit. This is implemented by [encode]
+   and [decode] below. *)
+
+(* One could also think, say, of adding [n] to every displacement, so as
+   to ensure that all displacements are nonnegative. This would work, but
+   would require [n] to be published, for use by the decoder. *)
+
+let encode (displacement : int) : int =
+  if displacement >= 0 then
+    displacement lsl 1
+  else
+    (-displacement) lsl 1 + 1
+
+let decode (displacement : int) : int =
+  if displacement land 1 = 0 then
+    displacement lsr 1
+  else
+    -(displacement lsr 1)
+
+(* It is reasonable to assume that, as matrices grow large, their
+   density becomes low, i.e., they have many insignificant entries.
+   As a result, it is important to work with a sparse data structure
+   for rows. We internally represent a row as a list of its
+   significant entries, where each entry is a pair of a [j] index and
+   an element. *)
+
+type 'a row =
+    (int * 'a) list
+
+(* [compress equal insignificant dummy m n t] turns the two-dimensional table
+   [t] into a compressed table. The parameter [equal] is equality of data
+   values. The parameter [wildcard] tells which data values are insignificant,
+   and can thus be overwritten with other values. The parameter [dummy] is
+   used to fill holes in the data array. [m] and [n] are the integer
+   dimensions of the table [t]. *)
+
+let compress
+    (equal : 'a -> 'a -> bool)
+    (insignificant : 'a -> bool)
+    (dummy : 'a)
+    (m : int) (n : int)
+    (t : 'a array array)
+    : 'a table =
+
+  (* Be defensive. *)
+
+  assert (Array.length t = m);
+  assert begin
+    for i = 0 to m - 1 do
+      assert (Array.length t.(i) = n)
+    done;
+    true
+  end;
+
+  (* This turns a row-as-array into a row-as-sparse-list. The row is
+     accompanied by its index [i] and by its rank (the number of its
+     significant entries, that is, the length of the row-as-a-list. *)
+
+  let sparse (i : int) (line : 'a array) : int * int * 'a row (* index, rank, row *) =
+
+    let rec loop (j : int) (rank : int) (row : 'a row) =
+      if j < 0 then
+        i, rank, row
+      else
+        let x = line.(j) in
+        if insignificant x then
+          loop (j - 1) rank row
+        else
+          loop (j - 1) (1 + rank) ((j, x) :: row)
+    in
+
+    loop (n - 1) 0 []
+
+  in
+
+  (* Construct an array of all rows, together with their index and rank. *)
+
+  let rows : (int * int * 'a row) array = (* index, rank, row *)
+    Array.mapi sparse t
+  in
+
+  (* Sort this array by decreasing rank. This does not have any impact
+     on correctness, but reportedly improves compression. The
+     intuitive idea is that rows with few significant elements are
+     easy to fit, so they should be inserted last, after the problem
+     has become quite constrained by fitting the heavier rows. This
+     heuristic is attributed to Ziegler. *)
+
+  Array.fast_sort (fun (_, rank1, _) (_, rank2, _) ->
+    compare rank2 rank1
+  ) rows;
+
+  (* Allocate a one-dimensional array of displacements. *)
+
+  let displacement : int array =
+    Array.make m 0
+  in
+
+  (* Allocate a one-dimensional, infinite array of values. Indices
+     into this array are written [k]. *)
+
+  let data : 'a InfiniteArray.t =
+    InfiniteArray.make dummy
+  in
+
+  (* Determine whether [row] fits at offset [k] within the current [data]
+     array, up to extension of this array. *)
+
+  (* Note that this check always succeeds when [k] equals the length of
+     the [data] array. Indeed, the loop is then skipped. This property
+     guarantees the termination of the recursive function [fit] below. *)
+
+  let fits k (row : 'a row) : bool =
+
+    let d = InfiniteArray.extent data in
+
+    let rec loop = function
+      | [] ->
+          true
+      | (j, x) :: row ->
+
+          (* [x] is a significant element. *)
+
+          (* By hypothesis, [k + j] is nonnegative. If it is greater than or
+             equal to the current length of the data array, stop -- the row
+             fits. *)
+
+          assert (k + j >= 0);
+
+          if k + j >= d then
+            true
+
+          (* We now know that [k + j] is within bounds of the data
+             array. Check whether it is compatible with the element [y] found
+             there. If it is, continue. If it isn't, stop -- the row does not
+             fit. *)
+
+          else
+            let y = InfiniteArray.get data (k + j) in
+            if insignificant y || equal x y then
+              loop row
+            else
+              false
+
+    in
+    loop row
+
+  in
+
+  (* Find the leftmost position where a row fits. *)
+
+  (* If the leftmost significant element in this row is at offset [j],
+     then we can hope to fit as far left as [-j] -- so this element
+     lands at offset [0] in the data array. *)
+
+  (* Note that displacements may be negative. This means that, for
+     insignificant elements, accesses to the data array could fail: they could
+     be out of bounds, either towards the left or towards the right. This is
+     not a problem, as long as [get] is invoked only at significant
+     elements. *)
+
+  let rec fit k row : int =
+    if fits k row then
+      k
+    else
+      fit (k + 1) row
+  in
+
+  let fit row =
+    match row with
+    | [] ->
+        0 (* irrelevant *)
+    | (j, _) :: _ ->
+        fit (-j) row
+  in
+
+  (* Write [row] at (compatible) offset [k]. *)
+
+  let rec write k = function
+    | [] ->
+        ()
+    | (j, x) :: row ->
+        InfiniteArray.set data (k + j) x;
+        write k row
+  in
+
+  (* Iterate over the sorted array of rows. Fit and write each row at
+     the leftmost compatible offset. Update the displacement table. *)
+
+  Array.iter (fun (i, _, row) ->
+    let k = fit row in (* if [row] has leading insignificant elements, then [k] can be negative *)
+    write k row;
+    displacement.(i) <- encode k
+  ) rows;
+
+  (* Return the compressed tables. *)
+
+  displacement, InfiniteArray.domain data
+
+(* [get ct i j] returns the value found at indices [i] and [j] in the
+   compressed table [ct]. This function call is permitted only if the
+   value found at indices [i] and [j] in the original table is
+   significant -- otherwise, it could fail abruptly. *)
+
+(* Together, [compress] and [get] have the property that, if the value
+   found at indices [i] and [j] in an uncompressed table [t] is
+   significant, then [get (compress t) i j] is equal to that value. *)
+
+let get (displacement, data) i j =
+  assert (0 <= i && i < Array.length displacement);
+  let k = decode displacement.(i) in
+  assert (0 <= k + j && k + j < Array.length data);
+    (* failure of this assertion indicates an attempt to access an
+       insignificant element that happens to be mapped out of the bounds
+       of the [data] array. *)
+  data.(k + j)
+
+(* [getget] is a variant of [get] which only requires read access,
+   via accessors, to the two components of the table. *)
+
+let getget get_displacement get_data (displacement, data) i j =
+  let k = decode (get_displacement displacement i) in
+  get_data data (k + j)
+end
+module LinearizedArray = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* The [entry] array contains offsets into the [data] array. It has [n+1]
+   elements if the original (unencoded) array has [n] elements. The value
+   of [entry.(n)] is the length of the [data] array. This convention is
+   natural and allows avoiding a special case. *)
+
+type 'a t =
+  (* data: *)   'a array *
+  (* entry: *) int array
+
+let make (a : 'a array array) : 'a t =
+  let n = Array.length a in
+  (* Build the entry array. *)
+  let size = ref 0 in
+  let entry = Array.init (n + 1) (fun i ->
+    let s = !size in
+    if i < n then
+      size := s + Array.length a.(i);
+    s
+  ) in
+  assert (entry.(n) = !size);
+  (* Build the data array. *)
+  let i = ref 0
+  and j = ref 0 in
+  let data = Array.init !size (fun _ ->
+    while !j = Array.length a.(!i) do
+      i := !i + 1;
+      j := 0;
+    done;
+    let x = a.(!i).(!j) in
+    j := !j + 1;
+    x
+  ) in
+  data, entry
+
+let length ((_, entry) : 'a t) : int =
+  Array.length entry
+
+let row_length ((_, entry) : 'a t) i : int =
+  entry.(i + 1) - entry.(i)
+
+let row_length_via get_entry i =
+  get_entry (i + 1) - get_entry i
+
+let read ((data, entry) as la : 'a t) i j : 'a =
+  assert (0 <= j && j < row_length la i);
+  data.(entry.(i) + j)
+
+let read_via get_data get_entry i j =
+  assert (0 <= j && j < row_length_via get_entry i);
+  get_data (get_entry i + j)
+
+let write ((data, entry) as la : 'a t) i j (v : 'a) : unit =
+  assert (0 <= j && j < row_length la i);
+  data.(entry.(i) + j) <- v
+
+let rec read_interval_via get_data i j =
+  if i = j then
+    []
+  else
+    get_data i :: read_interval_via get_data (i + 1) j
+
+let read_row_via get_data get_entry i =
+  read_interval_via get_data (get_entry i) (get_entry (i + 1))
+
+let read_row ((data, entry) : 'a t) i : 'a list =
+  read_row_via (Array.get data) (Array.get entry) i
+
+end
+module TableFormat = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* This signature defines the format of the parse tables. It is used as
+   an argument to [TableInterpreter.Make]. *)
+
+module type TABLES = sig
+
+  (* This is the parser's type of tokens. *)
+
+  type token
+
+  (* This maps a token to its internal (generation-time) integer code. *)
+
+  val token2terminal: token -> int
+
+  (* This is the integer code for the error pseudo-token. *)
+
+  val error_terminal: int
+
+  (* This maps a token to its semantic value. *)
+
+  val token2value: token -> Obj.t
+
+  (* Traditionally, an LR automaton is described by two tables, namely, an
+     action table and a goto table. See, for instance, the Dragon book.
+
+     The action table is a two-dimensional matrix that maps a state and a
+     lookahead token to an action. An action is one of: shift to a certain
+     state, reduce a certain production, accept, or fail.
+
+     The goto table is a two-dimensional matrix that maps a state and a
+     non-terminal symbol to either a state or undefined. By construction, this
+     table is sparse: its undefined entries are never looked up. A compression
+     technique is free to overlap them with other entries.
+
+     In Menhir, things are slightly different. If a state has a default
+     reduction on token [#], then that reduction must be performed without
+     consulting the lookahead token. As a result, we must first determine
+     whether that is the case, before we can obtain a lookahead token and use it
+     as an index in the action table.
+
+     Thus, Menhir's tables are as follows.
+
+     A one-dimensional default reduction table maps a state to either ``no
+     default reduction'' (encoded as: 0) or ``by default, reduce prod''
+     (encoded as: 1 + prod). The action table is looked up only when there
+     is no default reduction. *)
+
+  val default_reduction: PackedIntArray.t
+
+  (* Menhir follows Dencker, Dürre and Heuft, who point out that, although the
+     action table is not sparse by nature (i.e., the error entries are
+     significant), it can be made sparse by first factoring out a binary error
+     matrix, then replacing the error entries in the action table with undefined
+     entries. Thus:
+
+     A two-dimensional error bitmap maps a state and a terminal to either
+     ``fail'' (encoded as: 0) or ``do not fail'' (encoded as: 1). The action
+     table, which is now sparse, is looked up only in the latter case. *)
+
+  (* The error bitmap is flattened into a one-dimensional table; its width is
+     recorded so as to allow indexing. The table is then compressed via
+     [PackedIntArray]. The bit width of the resulting packed array must be
+     [1], so it is not explicitly recorded. *)
+
+  (* The error bitmap does not contain a column for the [#] pseudo-terminal.
+     Thus, its width is [Terminal.n - 1]. We exploit the fact that the integer
+     code assigned to [#] is greatest: the fact that the right-most column
+     in the bitmap is missing does not affect the code for accessing it. *)
+
+  val error: int (* width of the bitmap *) * string (* second component of [PackedIntArray.t] *)
+
+  (* A two-dimensional action table maps a state and a terminal to one of
+     ``shift to state s and discard the current token'' (encoded as: s | 10),
+     ``shift to state s without discarding the current token'' (encoded as: s |
+     11), or ``reduce prod'' (encoded as: prod | 01). *)
+
+  (* The action table is first compressed via [RowDisplacement], then packed
+     via [PackedIntArray]. *)
+
+  (* Like the error bitmap, the action table does not contain a column for the
+     [#] pseudo-terminal. *)
+
+  val action: PackedIntArray.t * PackedIntArray.t
+
+  (* A one-dimensional lhs table maps a production to its left-hand side (a
+     non-terminal symbol). *)
+
+  val lhs: PackedIntArray.t
+
+  (* A two-dimensional goto table maps a state and a non-terminal symbol to
+     either undefined (encoded as: 0) or a new state s (encoded as: 1 + s). *)
+
+  (* The goto table is first compressed via [RowDisplacement], then packed
+     via [PackedIntArray]. *)
+
+  val goto: PackedIntArray.t * PackedIntArray.t
+
+  (* The number of start productions. A production [prod] is a start
+     production if and only if [prod < start] holds. This is also the
+     number of start symbols. A nonterminal symbol [nt] is a start
+     symbol if and only if [nt < start] holds. *)
+
+  val start: int
+
+  (* A one-dimensional semantic action table maps productions to semantic
+     actions. The calling convention for semantic actions is described in
+     [EngineTypes]. This table contains ONLY NON-START PRODUCTIONS, so the
+     indexing is off by [start]. Be careful. *)
+
+  val semantic_action: ((int, Obj.t, token) EngineTypes.env ->
+                        (int, Obj.t)        EngineTypes.stack) array
+
+  (* The parser defines its own [Error] exception. This exception can be
+     raised by semantic actions and caught by the engine, and raised by the
+     engine towards the final user. *)
+
+  exception Error
+
+  (* The parser indicates whether to generate a trace. Generating a
+     trace requires two extra tables, which respectively map a
+     terminal symbol and a production to a string. *)
+
+  val trace: (string array * string array) option
+
+end
+end
+module InspectionTableFormat = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* This signature defines the format of the tables that are produced (in
+   addition to the tables described in [TableFormat]) when the command line
+   switch [--inspection] is enabled. It is used as an argument to
+   [InspectionTableInterpreter.Make]. *)
+
+module type TABLES = sig
+
+  (* The types of symbols. *)
+
+  include IncrementalEngine.SYMBOLS
+
+  (* The type ['a lr1state] describes an LR(1) state. The generated parser defines
+     it internally as [int]. *)
+
+  type 'a lr1state
+
+  (* Some of the tables that follow use encodings of (terminal and
+     nonterminal) symbols as integers. So, we need functions that
+     map the integer encoding of a symbol to its algebraic encoding. *)
+
+  val    terminal: int -> xsymbol
+  val nonterminal: int -> xsymbol
+
+  (* The left-hand side of every production already appears in the
+     signature [TableFormat.TABLES], so we need not repeat it here. *)
+
+  (* The right-hand side of every production. This a linearized array
+     of arrays of integers, whose [data] and [entry] components have
+     been packed. The encoding of symbols as integers in described in
+     [TableBackend]. *)
+
+  val rhs: PackedIntArray.t * PackedIntArray.t
+
+  (* A mapping of every (non-initial) state to its LR(0) core. *)
+
+  val lr0_core: PackedIntArray.t
+
+  (* A mapping of every LR(0) state to its set of LR(0) items. Each item is
+     represented in its packed form (see [Item]) as an integer. Thus the
+     mapping is an array of arrays of integers, which is linearized and
+     packed, like [rhs]. *)
+
+  val lr0_items: PackedIntArray.t * PackedIntArray.t
+
+  (* A mapping of every LR(0) state to its incoming symbol, if it has one. *)
+
+  val lr0_incoming: PackedIntArray.t
+
+  (* A table that tells which non-terminal symbols are nullable. *)
+
+  val nullable: string
+    (* This is a packed int array of bit width 1. It can be read
+       using [PackedIntArray.get1]. *)
+
+  (* A two-table dimensional table, indexed by a nonterminal symbol and
+     by a terminal symbol (other than [#]), encodes the FIRST sets. *)
+
+  val first: int (* width of the bitmap *) * string (* second component of [PackedIntArray.t] *)
+
+end
+
+end
+module InspectionTableInterpreter = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* -------------------------------------------------------------------------- *)
+
+(* The type functor. *)
+
+module Symbols (T : sig
+
+  type 'a terminal
+  type 'a nonterminal
+
+end) = struct
+
+  open T
+
+  (* This should be the only place in the whole library (and generator!)
+     where these types are defined. *)
+
+  type 'a symbol =
+    | T : 'a terminal -> 'a symbol
+    | N : 'a nonterminal -> 'a symbol
+
+  type xsymbol =
+    | X : 'a symbol -> xsymbol
+
+end
+
+(* -------------------------------------------------------------------------- *)
+
+(* The code functor. *)
+
+module Make
+  (TT : TableFormat.TABLES)
+  (IT : InspectionTableFormat.TABLES
+        with type 'a lr1state = int)
+  (ET : EngineTypes.TABLE
+        with type terminal = int
+         and type nonterminal = int
+         and type semantic_value = Obj.t)
+  (E : sig
+     type 'a env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env
+   end)
+= struct
+
+  (* Including [IT] is an easy way of inheriting the definitions of the types
+     [symbol] and [xsymbol]. *)
+
+  include IT
+
+  (* This auxiliary function decodes a packed linearized array, as created by
+     [TableBackend.linearize_and_marshal1]. Here, we read a row all at once. *)
+
+  let read_packed_linearized
+    (data, entry : PackedIntArray.t * PackedIntArray.t) (i : int) : int list
+  =
+    LinearizedArray.read_row_via
+      (PackedIntArray.get data)
+      (PackedIntArray.get entry)
+      i
+
+  (* This auxiliary function decodes a symbol. The encoding was done by
+     [encode_symbol] or [encode_symbol_option] in the table back-end. *)
+
+  let decode_symbol (symbol : int) : IT.xsymbol =
+    (* If [symbol] is 0, then we have no symbol. This could mean e.g.
+       that the function [incoming_symbol] has been applied to an
+       initial state. In principle, this cannot happen. *)
+    assert (symbol > 0);
+    (* The low-order bit distinguishes terminal and nonterminal symbols. *)
+    let kind = symbol land 1 in
+    let symbol = symbol lsr 1 in
+    if kind = 0 then
+      IT.terminal (symbol - 1)
+    else
+      IT.nonterminal symbol
+
+  (* These auxiliary functions convert a symbol to its integer code. For speed
+     and for convenience, we use an unsafe type cast. This relies on the fact
+     that the data constructors of the [terminal] and [nonterminal] GADTs are
+     declared in an order that reflects their internal code. In the case of
+     nonterminal symbols, we add [start] to account for the presence of the
+     start symbols. *)
+
+  let n2i (nt : 'a IT.nonterminal) : int =
+    let answer = TT.start + Obj.magic nt in
+    (* For safety, check that the above cast produced a correct result. *)
+    assert (IT.nonterminal answer = X (N nt));
+    answer
+
+  let t2i (t : 'a IT.terminal) : int =
+    let answer = Obj.magic t in
+    (* For safety, check that the above cast produced a correct result. *)
+    assert (IT.terminal answer = X (T t));
+    answer
+
+  (* Ordering functions. *)
+
+  let compare_terminals t1 t2 =
+    (* Subtraction is safe because overflow is impossible. *)
+    t2i t1 - t2i t2
+
+  let compare_nonterminals nt1 nt2 =
+    (* Subtraction is safe because overflow is impossible. *)
+    n2i nt1 - n2i nt2
+
+  let compare_symbols symbol1 symbol2 =
+    match symbol1, symbol2 with
+    | X (T _), X (N _) ->
+        -1
+    | X (N _), X (T _) ->
+        1
+    | X (T t1), X (T t2) ->
+        compare_terminals t1 t2
+    | X (N nt1), X (N nt2) ->
+        compare_nonterminals nt1 nt2
+
+  let compare_productions prod1 prod2 =
+    (* Subtraction is safe because overflow is impossible. *)
+    prod1 - prod2
+
+  let compare_items (prod1, index1) (prod2, index2) =
+    let c = compare_productions prod1 prod2 in
+    (* Subtraction is safe because overflow is impossible. *)
+    if c <> 0 then c else index1 - index2
+
+  (* The function [incoming_symbol] goes through the tables [IT.lr0_core] and
+     [IT.lr0_incoming]. This yields a representation of type [xsymbol], out of
+     which we strip the [X] quantifier, so as to get a naked symbol. This last
+     step is ill-typed and potentially dangerous. It is safe only because this
+     function is used at type ['a lr1state -> 'a symbol], which forces an
+     appropriate choice of ['a]. *)
+
+  let incoming_symbol (s : 'a IT.lr1state) : 'a IT.symbol =
+    let core = PackedIntArray.get IT.lr0_core s in
+    let symbol = decode_symbol (PackedIntArray.get IT.lr0_incoming core) in
+    match symbol with
+    | IT.X symbol ->
+        Obj.magic symbol
+
+  (* The function [lhs] reads the table [TT.lhs] and uses [IT.nonterminal]
+     to decode the symbol. *)
+
+  let lhs prod =
+    IT.nonterminal (PackedIntArray.get TT.lhs prod)
+
+  (* The function [rhs] reads the table [IT.rhs] and uses [decode_symbol]
+     to decode the symbol. *)
+
+  let rhs prod =
+    List.map decode_symbol (read_packed_linearized IT.rhs prod)
+
+  (* The function [items] maps the LR(1) state [s] to its LR(0) core,
+     then uses [core] as an index into the table [IT.lr0_items]. The
+     items are then decoded by the function [export] below, which is
+     essentially a copy of [Item.export]. *)
+
+  type item =
+      int * int
+
+  let export t : item =
+    (t lsr 7, t mod 128)
+
+  let items s =
+    (* Map [s] to its LR(0) core. *)
+    let core = PackedIntArray.get IT.lr0_core s in
+    (* Now use [core] to look up the table [IT.lr0_items]. *)
+    List.map export (read_packed_linearized IT.lr0_items core)
+
+  (* The function [nullable] maps the nonterminal symbol [nt] to its
+     integer code, which it uses to look up the array [IT.nullable].
+     This yields 0 or 1, which we map back to a Boolean result. *)
+
+  let decode_bool i =
+    assert (i = 0 || i = 1);
+    i = 1
+
+  let nullable nt =
+    decode_bool (PackedIntArray.get1 IT.nullable (n2i nt))
+
+  (* The function [first] maps the symbols [nt] and [t] to their integer
+     codes, which it uses to look up the matrix [IT.first]. *)
+
+  let first nt t =
+    decode_bool (PackedIntArray.unflatten1 IT.first (n2i nt) (t2i t))
+
+  let xfirst symbol t =
+    match symbol with
+    | X (T t') ->
+        compare_terminals t t' = 0
+    | X (N nt) ->
+        first nt t
+
+  (* The function [foreach_terminal] exploits the fact that the
+     first component of [TT.error] is [Terminal.n - 1], i.e., the
+     number of terminal symbols, including [error] but not [#]. *)
+
+  let rec foldij i j f accu =
+    if i = j then
+      accu
+    else
+      foldij (i + 1) j f (f i accu)
+
+  let foreach_terminal f accu =
+    let n, _ = TT.error in
+    foldij 0 n (fun i accu ->
+      f (IT.terminal i) accu
+    ) accu
+
+  let foreach_terminal_but_error f accu =
+    let n, _ = TT.error in
+    foldij 0 n (fun i accu ->
+      if i = TT.error_terminal then
+        accu
+      else
+        f (IT.terminal i) accu
+    ) accu
+
+  (* ------------------------------------------------------------------------ *)
+
+  (* The following is the implementation of the function [feed]. This function
+     is logically part of the LR engine, so it would be nice if it were placed
+     in the module [Engine], but it must be placed here because, to ensure
+     type safety, its arguments must be a symbol of type ['a symbol] and a
+     semantic value of type ['a]. The type ['a symbol] is not available in
+     [Engine]. It is available here. *)
+
+  open EngineTypes
+  open ET
+  open E
+
+  (* [feed] fails if the current state does not have an outgoing transition
+     labeled with the desired symbol. This check is carried out at runtime. *)
+
+  let feed_failure () =
+    invalid_arg "feed: outgoing transition does not exist"
+
+  (* Feeding a nonterminal symbol [nt]. Here, [nt] has type [nonterminal],
+     which is a synonym for [int], and [semv] has type [semantic_value],
+     which is a synonym for [Obj.t]. This type is unsafe, because pushing
+     a semantic value of arbitrary type into the stack can later cause a
+     semantic action to crash and burn. The function [feed] is given a safe
+     type below. *)
+
+  let feed_nonterminal
+        (nt : nonterminal) startp (semv : semantic_value) endp (env : 'b env)
+      : 'b env
+  =
+    (* Check if the source state has an outgoing transition labeled [nt].
+       This is done by consulting the [goto] table. *)
+    let source = env.current in
+    match ET.maybe_goto_nt source nt with
+    | None ->
+        feed_failure()
+    | Some target ->
+        (* Push a new cell onto the stack, containing the identity of the state
+           that we are leaving. The semantic value [semv] and positions [startp]
+           and [endp] contained in the new cell are provided by the caller. *)
+        let stack = { state = source; semv; startp; endp; next = env.stack } in
+        (* Move to the target state. *)
+        { env with stack; current = target }
+
+  let reduce   _env _prod = feed_failure()
+  let initiate _env       = feed_failure()
+
+  let feed_terminal
+        (terminal : terminal) startp (semv : semantic_value) endp (env : 'b env)
+      : 'b env
+  =
+    (* Check if the source state has an outgoing transition labeled [terminal].
+       This is done by consulting the [action] table. *)
+    let source = env.current in
+    ET.action source terminal semv
+      (fun env _please_discard _terminal semv target ->
+        (* There is indeed a transition toward the state [target].
+           Push a new cell onto the stack and move to the target state. *)
+        let stack = { state = source; semv; startp; endp; next = env.stack } in
+        { env with stack; current = target }
+      ) reduce initiate env
+
+  (* The type assigned to [feed] ensures that the type of the semantic value
+     [semv] is appropriate: it must be the semantic-value type of the symbol
+     [symbol]. *)
+
+  let feed (symbol : 'a symbol) startp (semv : 'a) endp env =
+    let semv : semantic_value = Obj.repr semv in
+    match symbol with
+    | N nt ->
+        feed_nonterminal (n2i nt) startp semv endp env
+    | T terminal ->
+        feed_terminal (t2i terminal) startp semv endp env
+
+end
+end
+module TableInterpreter = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+module MakeEngineTable (T : TableFormat.TABLES) = struct
+
+  type state =
+      int
+
+  let number s = s
+
+  type token =
+      T.token
+
+  type terminal =
+      int
+
+  type nonterminal =
+      int
+
+  type semantic_value =
+      Obj.t
+
+  let token2terminal =
+    T.token2terminal
+
+  let token2value =
+    T.token2value
+
+  let error_terminal =
+    T.error_terminal
+
+  let error_value =
+    Obj.repr ()
+
+  (* The function [foreach_terminal] exploits the fact that the
+     first component of [T.error] is [Terminal.n - 1], i.e., the
+     number of terminal symbols, including [error] but not [#]. *)
+
+  (* There is similar code in [InspectionTableInterpreter]. The
+     code there contains an additional conversion of the type
+     [terminal] to the type [xsymbol]. *)
+
+  let rec foldij i j f accu =
+    if i = j then
+      accu
+    else
+      foldij (i + 1) j f (f i accu)
+
+  let foreach_terminal f accu =
+    let n, _ = T.error in
+    foldij 0 n (fun i accu ->
+      f i accu
+    ) accu
+
+  type production =
+      int
+
+  (* In principle, only non-start productions are exposed to the user,
+     at type [production] or at type [int]. This is checked dynamically. *)
+  let non_start_production i =
+    assert (T.start <= i && i - T.start < Array.length T.semantic_action)
+
+  let production_index i =
+    non_start_production i;
+    i
+
+  let find_production i =
+    non_start_production i;
+    i
+
+  let default_reduction state defred nodefred env =
+    let code = PackedIntArray.get T.default_reduction state in
+    if code = 0 then
+      nodefred env
+    else
+      defred env (code - 1)
+
+  let is_start prod =
+    prod < T.start
+
+  (* This auxiliary function helps access a compressed, two-dimensional
+     matrix, like the action and goto tables. *)
+
+  let unmarshal2 table i j =
+    RowDisplacement.getget
+      PackedIntArray.get
+      PackedIntArray.get
+      table
+      i j
+
+  let action state terminal value shift reduce fail env =
+    match PackedIntArray.unflatten1 T.error state terminal with
+    | 1 ->
+        let action = unmarshal2 T.action state terminal in
+        let opcode = action land 0b11
+        and param = action lsr 2 in
+        if opcode >= 0b10 then
+          (* 0b10 : shift/discard *)
+          (* 0b11 : shift/nodiscard *)
+          let please_discard = (opcode = 0b10) in
+          shift env please_discard terminal value param
+        else
+          (* 0b01 : reduce *)
+          (* 0b00 : cannot happen *)
+          reduce env param
+    | c ->
+        assert (c = 0);
+        fail env
+
+  let goto_nt state nt =
+    let code = unmarshal2 T.goto state nt in
+    (* code = 1 + state *)
+    code - 1
+
+  let goto_prod state prod =
+    goto_nt state (PackedIntArray.get T.lhs prod)
+
+  let maybe_goto_nt state nt =
+    let code = unmarshal2 T.goto state nt in
+    (* If [code] is 0, there is no outgoing transition.
+       If [code] is [1 + state], there is a transition towards [state]. *)
+    assert (0 <= code);
+    if code = 0 then None else Some (code - 1)
+
+  exception Error =
+        T.Error
+
+  type semantic_action =
+      (state, semantic_value, token) EngineTypes.env ->
+      (state, semantic_value)        EngineTypes.stack
+
+  let semantic_action prod =
+    (* Indexing into the array [T.semantic_action] is off by [T.start],
+       because the start productions do not have entries in this array. *)
+    T.semantic_action.(prod - T.start)
+
+  (* [may_reduce state prod] tests whether the state [state] is capable of
+     reducing the production [prod]. This information could be determined
+     in constant time if we were willing to create a bitmap for it, but
+     that would take up a lot of space. Instead, we obtain this information
+     by iterating over a line in the action table. This is costly, but this
+     function is not normally used by the LR engine anyway; it is supposed
+     to be used only by programmers who wish to develop error recovery
+     strategies. *)
+
+  (* In the future, if desired, we could memoize this function, so as
+     to pay the cost in (memory) space only if and where this function
+     is actually used. We could also replace [foreach_terminal] with a
+     function [exists_terminal] which stops as soon as the accumulator
+     is [true]. *)
+
+  let may_reduce state prod =
+    (* Test if there is a default reduction of [prod]. *)
+    default_reduction state
+      (fun () prod' -> prod = prod')
+      (fun () ->
+        (* If not, then for each terminal [t], ... *)
+        foreach_terminal (fun t accu ->
+          accu ||
+          (* ... test if there is a reduction of [prod] on [t]. *)
+          action state t ()
+            (* shift:  *) (fun () _ _ () _ -> false)
+            (* reduce: *) (fun () prod' -> prod = prod')
+            (* fail:   *) (fun () -> false)
+            ()
+        ) false
+      )
+      ()
+
+  (* If [T.trace] is [None], then the logging functions do nothing. *)
+
+  let log =
+    match T.trace with Some _ -> true | None -> false
+
+  module Log = struct
+
+    open Printf
+
+    let state state =
+      match T.trace with
+      | Some _ ->
+          fprintf stderr "State %d:\n%!" state
+      | None ->
+          ()
+
+    let shift terminal state =
+      match T.trace with
+      | Some (terminals, _) ->
+          fprintf stderr "Shifting (%s) to state %d\n%!" terminals.(terminal) state
+      | None ->
+          ()
+
+    let reduce_or_accept prod =
+      match T.trace with
+      | Some (_, productions) ->
+          fprintf stderr "%s\n%!" productions.(prod)
+      | None ->
+          ()
+
+    let lookahead_token token startp endp =
+      match T.trace with
+      | Some (terminals, _) ->
+          fprintf stderr "Lookahead token is now %s (%d-%d)\n%!"
+            terminals.(token)
+            startp.Lexing.pos_cnum
+            endp.Lexing.pos_cnum
+      | None ->
+          ()
+
+    let initiating_error_handling () =
+      match T.trace with
+      | Some _ ->
+          fprintf stderr "Initiating error handling\n%!"
+      | None ->
+          ()
+
+    let resuming_error_handling () =
+      match T.trace with
+      | Some _ ->
+          fprintf stderr "Resuming error handling\n%!"
+      | None ->
+          ()
+
+    let handling_error state =
+      match T.trace with
+      | Some _ ->
+          fprintf stderr "Handling error in state %d\n%!" state
+      | None ->
+          ()
+
+  end
+
+end
+end
+module StaticVersion = struct
+let require_20190924 = ()
+end
diff --git a/boot/menhir/menhirLib.mli b/boot/menhir/menhirLib.mli
new file mode 100644
index 00000000..fa523f59
--- /dev/null
+++ b/boot/menhir/menhirLib.mli
@@ -0,0 +1,1705 @@
+module General : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* This module offers general-purpose functions on lists and streams. *)
+
+(* As of 2017/03/31, this module is DEPRECATED. It might be removed in
+   the future. *)
+
+(* --------------------------------------------------------------------------- *)
+
+(* Lists. *)
+
+(* [take n xs] returns the [n] first elements of the list [xs]. It is
+   acceptable  for the list [xs] to have length less than [n], in
+   which case [xs] itself is returned. *)
+
+val take: int -> 'a list -> 'a list
+
+(* [drop n xs] returns the list [xs], deprived of its [n] first elements.
+   It is acceptable for the list [xs] to have length less than [n], in
+   which case an empty list is returned. *)
+
+val drop: int -> 'a list -> 'a list
+
+(* [uniq cmp xs] assumes that the list [xs] is sorted according to the
+   ordering [cmp] and returns the list [xs] deprived of any duplicate
+   elements. *)
+
+val uniq: ('a -> 'a -> int) -> 'a list -> 'a list
+
+(* [weed cmp xs] returns the list [xs] deprived of any duplicate elements. *)
+
+val weed: ('a -> 'a -> int) -> 'a list -> 'a list
+
+(* --------------------------------------------------------------------------- *)
+
+(* A stream is a list whose elements are produced on demand. *)
+
+type 'a stream =
+    'a head Lazy.t
+
+and 'a head =
+  | Nil
+  | Cons of 'a * 'a stream
+
+(* The length of a stream. *)
+
+val length: 'a stream -> int
+
+(* Folding over a stream. *)
+
+val foldr: ('a -> 'b -> 'b) -> 'a stream -> 'b -> 'b
+end
+module Convert : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* An ocamlyacc-style, or Menhir-style, parser requires access to
+   the lexer, which must be parameterized with a lexing buffer, and
+   to the lexing buffer itself, where it reads position information. *)
+
+(* This traditional API is convenient when used with ocamllex, but
+   inelegant when used with other lexer generators. *)
+
+type ('token, 'semantic_value) traditional =
+    (Lexing.lexbuf -> 'token) -> Lexing.lexbuf -> 'semantic_value
+
+(* This revised API is independent of any lexer generator. Here, the
+   parser only requires access to the lexer, and the lexer takes no
+   parameters. The tokens returned by the lexer may contain position
+   information. *)
+
+type ('token, 'semantic_value) revised =
+    (unit -> 'token) -> 'semantic_value
+
+(* --------------------------------------------------------------------------- *)
+
+(* Converting a traditional parser, produced by ocamlyacc or Menhir,
+   into a revised parser. *)
+
+(* A token of the revised lexer is essentially a triple of a token
+   of the traditional lexer (or raw token), a start position, and
+   and end position. The three [get] functions are accessors. *)
+
+(* We do not require the type ['token] to actually be a triple type.
+   This enables complex applications where it is a record type with
+   more than three fields. It also enables simple applications where
+   positions are of no interest, so ['token] is just ['raw_token]
+   and [get_startp] and [get_endp] return dummy positions. *)
+
+val traditional2revised:
+  ('token -> 'raw_token) ->
+  ('token -> Lexing.position) ->
+  ('token -> Lexing.position) ->
+  ('raw_token, 'semantic_value) traditional ->
+  ('token, 'semantic_value) revised
+
+(* --------------------------------------------------------------------------- *)
+
+(* Converting a revised parser back to a traditional parser. *)
+
+val revised2traditional:
+  ('raw_token -> Lexing.position -> Lexing.position -> 'token) ->
+  ('token, 'semantic_value) revised ->
+  ('raw_token, 'semantic_value) traditional
+
+(* --------------------------------------------------------------------------- *)
+
+(* Simplified versions of the above, where concrete triples are used. *)
+
+module Simplified : sig
+
+  val traditional2revised:
+    ('token, 'semantic_value) traditional ->
+    ('token * Lexing.position * Lexing.position, 'semantic_value) revised
+
+  val revised2traditional:
+    ('token * Lexing.position * Lexing.position, 'semantic_value) revised ->
+    ('token, 'semantic_value) traditional
+
+end
+end
+module IncrementalEngine : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+type position = Lexing.position
+
+open General
+
+(* This signature describes the incremental LR engine. *)
+
+(* In this mode, the user controls the lexer, and the parser suspends
+   itself when it needs to read a new token. *)
+
+module type INCREMENTAL_ENGINE = sig
+
+  type token
+
+  (* A value of type [production] is (an index for) a production. The start
+     productions (which do not exist in an \mly file, but are constructed by
+     Menhir internally) are not part of this type. *)
+
+  type production
+
+  (* The type ['a checkpoint] represents an intermediate or final state of the
+     parser. An intermediate checkpoint is a suspension: it records the parser's
+     current state, and allows parsing to be resumed. The parameter ['a] is
+     the type of the semantic value that will eventually be produced if the
+     parser succeeds. *)
+
+  (* [Accepted] and [Rejected] are final checkpoints. [Accepted] carries a
+     semantic value. *)
+
+  (* [InputNeeded] is an intermediate checkpoint. It means that the parser wishes
+     to read one token before continuing. *)
+
+  (* [Shifting] is an intermediate checkpoint. It means that the parser is taking
+     a shift transition. It exposes the state of the parser before and after
+     the transition. The Boolean parameter tells whether the parser intends to
+     request a new token after this transition. (It always does, except when
+     it is about to accept.) *)
+
+  (* [AboutToReduce] is an intermediate checkpoint. It means that the parser is
+     about to perform a reduction step. It exposes the parser's current
+     state as well as the production that is about to be reduced. *)
+
+  (* [HandlingError] is an intermediate checkpoint. It means that the parser has
+     detected an error and is currently handling it, in several steps. *)
+
+  (* A value of type ['a env] represents a configuration of the automaton:
+     current state, stack, lookahead token, etc. The parameter ['a] is the
+     type of the semantic value that will eventually be produced if the parser
+     succeeds. *)
+
+  (* In normal operation, the parser works with checkpoints: see the functions
+     [offer] and [resume]. However, it is also possible to work directly with
+     environments (see the functions [pop], [force_reduction], and [feed]) and
+     to reconstruct a checkpoint out of an environment (see [input_needed]).
+     This is considered advanced functionality; its purpose is to allow error
+     recovery strategies to be programmed by the user. *)
+
+  type 'a env
+
+  type 'a checkpoint = private
+    | InputNeeded of 'a env
+    | Shifting of 'a env * 'a env * bool
+    | AboutToReduce of 'a env * production
+    | HandlingError of 'a env
+    | Accepted of 'a
+    | Rejected
+
+  (* [offer] allows the user to resume the parser after it has suspended
+     itself with a checkpoint of the form [InputNeeded env]. [offer] expects the
+     old checkpoint as well as a new token and produces a new checkpoint. It does not
+     raise any exception. *)
+
+  val offer:
+    'a checkpoint ->
+    token * position * position ->
+    '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 new
+     checkpoint. It does not raise any exception. *)
+
+  val resume:
+    'a checkpoint ->
+    'a checkpoint
+
+  (* A token supplier is a function of no arguments which delivers a new token
+     (together with its start and end positions) every time it is called. *)
+
+  type supplier =
+    unit -> token * position * position
+
+  (* A pair of a lexer and a lexing buffer can be easily turned into a supplier. *)
+
+  val lexer_lexbuf_to_supplier:
+    (Lexing.lexbuf -> token) ->
+    Lexing.lexbuf ->
+    supplier
+
+  (* The functions [offer] and [resume] are sufficient to write a parser loop.
+     One can imagine many variations (which is why we expose these functions
+     in the first place!). Here, we expose a few variations of the main loop,
+     ready for use. *)
+
+  (* [loop supplier checkpoint] begins parsing from [checkpoint], reading
+     tokens from [supplier]. It continues parsing until it reaches a
+     checkpoint of the form [Accepted v] or [Rejected]. In the former case, it
+     returns [v]. In the latter case, it raises the exception [Error]. *)
+
+  val loop: supplier -> 'a checkpoint -> 'a
+
+  (* [loop_handle succeed fail supplier checkpoint] begins parsing from
+     [checkpoint], reading tokens from [supplier]. It continues parsing until
+     it reaches a checkpoint of the form [Accepted v] or [HandlingError env]
+     (or [Rejected], but that should not happen, as [HandlingError _] will be
+     observed first). In the former case, it calls [succeed v]. In the latter
+     case, it calls [fail] with this checkpoint. It cannot raise [Error].
+
+     This means that Menhir's traditional error-handling procedure (which pops
+     the stack until a state that can act on the [error] token is found) does
+     not get a chance to run. Instead, the user can implement her own error
+     handling code, in the [fail] continuation. *)
+
+  val loop_handle:
+    ('a -> 'answer) ->
+    ('a checkpoint -> 'answer) ->
+    supplier -> 'a checkpoint -> 'answer
+
+  (* [loop_handle_undo] is analogous to [loop_handle], except it passes a pair
+     of checkpoints to the failure continuation.
+
+     The first (and oldest) checkpoint is the last [InputNeeded] checkpoint that
+     was encountered before the error was detected. The second (and newest)
+     checkpoint is where the error was detected, as in [loop_handle]. Going back
+     to the first checkpoint can be thought of as undoing any reductions that
+     were performed after seeing the problematic token. (These reductions must
+     be default reductions or spurious reductions.)
+
+     [loop_handle_undo] must initially be applied to an [InputNeeded] checkpoint.
+     The parser's initial checkpoints satisfy this constraint. *)
+
+  val loop_handle_undo:
+    ('a -> 'answer) ->
+    ('a checkpoint -> 'a checkpoint -> 'answer) ->
+    supplier -> 'a checkpoint -> 'answer
+
+  (* [shifts checkpoint] assumes that [checkpoint] has been obtained by
+     submitting a token to the parser. It runs the parser from [checkpoint],
+     through an arbitrary number of reductions, until the parser either
+     accepts this token (i.e., shifts) or rejects it (i.e., signals an error).
+     If the parser decides to shift, then [Some env] is returned, where [env]
+     is the parser's state just before shifting. Otherwise, [None] is
+     returned. *)
+
+  (* It is desirable that the semantic actions be side-effect free, or that
+     their side-effects be harmless (replayable). *)
+
+  val shifts: 'a checkpoint -> 'a env option
+
+  (* The function [acceptable] allows testing, after an error has been
+     detected, which tokens would have been accepted at this point. It is
+     implemented using [shifts]. Its argument should be an [InputNeeded]
+     checkpoint. *)
+
+  (* For completeness, one must undo any spurious reductions before carrying out
+     this test -- that is, one must apply [acceptable] to the FIRST checkpoint
+     that is passed by [loop_handle_undo] to its failure continuation. *)
+
+  (* This test causes some semantic actions to be run! The semantic actions
+     should be side-effect free, or their side-effects should be harmless. *)
+
+  (* The position [pos] is used as the start and end positions of the
+     hypothetical token, and may be picked up by the semantic actions. We
+     suggest using the position where the error was detected. *)
+
+  val acceptable: 'a checkpoint -> token -> position -> bool
+
+  (* The abstract type ['a lr1state] describes the non-initial states of the
+     LR(1) automaton. The index ['a] represents the type of the semantic value
+     associated with this state's incoming symbol. *)
+
+  type 'a lr1state
+
+  (* The states of the LR(1) automaton are numbered (from 0 and up). *)
+
+  val number: _ lr1state -> int
+
+  (* Productions are numbered. *)
+
+  (* [find_production i] requires the index [i] to be valid. Use with care. *)
+
+  val production_index: production -> int
+  val find_production: int -> production
+
+  (* An element is a pair of a non-initial state [s] and a semantic value [v]
+     associated with the incoming symbol of this state. The idea is, the value
+     [v] was pushed onto the stack just before the state [s] was entered. Thus,
+     for some type ['a], the state [s] has type ['a lr1state] and the value [v]
+     has type ['a]. In other words, the type [element] is an existential type. *)
+
+  type element =
+    | Element: 'a lr1state * 'a * position * position -> element
+
+  (* The parser's stack is (or, more precisely, can be viewed as) a stream of
+     elements. The type [stream] is defined by the module [General]. *)
+
+  (* As of 2017/03/31, the types [stream] and [stack] and the function [stack]
+     are DEPRECATED. They might be removed in the future. An alternative way
+     of inspecting the stack is via the functions [top] and [pop]. *)
+
+  type stack = (* DEPRECATED *)
+    element stream
+
+  (* This is the parser's stack, a stream of elements. This stream is empty if
+     the parser is in an initial state; otherwise, it is non-empty.  The LR(1)
+     automaton's current state is the one found in the top element of the
+     stack. *)
+
+  val stack: 'a env -> stack (* DEPRECATED *)
+
+  (* [top env] returns the parser's top stack element. The state contained in
+     this stack element is the current state of the automaton. If the stack is
+     empty, [None] is returned. In that case, the current state of the
+     automaton must be an initial state. *)
+
+  val top: 'a env -> element option
+
+  (* [pop_many i env] pops [i] cells off the automaton's stack. This is done
+     via [i] successive invocations of [pop]. Thus, [pop_many 1] is [pop]. The
+     index [i] must be nonnegative. The time complexity is O(i). *)
+
+  val pop_many: int -> 'a env -> 'a env option
+
+  (* [get i env] returns the parser's [i]-th stack element. The index [i] is
+     0-based: thus, [get 0] is [top]. If [i] is greater than or equal to the
+     number of elements in the stack, [None] is returned. The time complexity
+     is O(i). *)
+
+  val get: int -> 'a env -> element option
+
+  (* [current_state_number env] is (the integer number of) the automaton's
+     current state. This works even if the automaton's stack is empty, in
+     which case the current state is an initial state. This number can be
+     passed as an argument to a [message] function generated by [menhir
+     --compile-errors]. *)
+
+  val current_state_number: 'a env -> int
+
+  (* [equal env1 env2] tells whether the parser configurations [env1] and
+     [env2] are equal in the sense that the automaton's current state is the
+     same in [env1] and [env2] and the stack is *physically* the same in
+     [env1] and [env2]. If [equal env1 env2] is [true], then the sequence of
+     the stack elements, as observed via [pop] and [top], must be the same in
+     [env1] and [env2]. Also, if [equal env1 env2] holds, then the checkpoints
+     [input_needed env1] and [input_needed env2] must be equivalent. The
+     function [equal] has time complexity O(1). *)
+
+  val equal: 'a env -> 'a env -> bool
+
+  (* These are the start and end positions of the current lookahead token. If
+     invoked in an initial state, this function returns a pair of twice the
+     initial position. *)
+
+  val positions: 'a env -> position * position
+
+  (* When applied to an environment taken from a checkpoint of the form
+     [AboutToReduce (env, prod)], the function [env_has_default_reduction]
+     tells whether the reduction that is about to take place is a default
+     reduction. *)
+
+  val env_has_default_reduction: 'a env -> bool
+
+  (* [state_has_default_reduction s] tells whether the state [s] has a default
+     reduction. This includes the case where [s] is an accepting state. *)
+
+  val state_has_default_reduction: _ lr1state -> bool
+
+  (* [pop env] returns a new environment, where the parser's top stack cell
+     has been popped off. (If the stack is empty, [None] is returned.) This
+     amounts to pretending that the (terminal or nonterminal) symbol that
+     corresponds to this stack cell has not been read. *)
+
+  val pop: 'a env -> 'a env option
+
+  (* [force_reduction prod env] should be called only if in the state [env]
+     the parser is capable of reducing the production [prod]. If this
+     condition is satisfied, then this production is reduced, which means that
+     its semantic action is executed (this can have side effects!) and the
+     automaton makes a goto (nonterminal) transition. If this condition is not
+     satisfied, [Invalid_argument _] is raised. *)
+
+  val force_reduction: production -> 'a env -> 'a env
+
+  (* [input_needed env] returns [InputNeeded env]. That is, out of an [env]
+     that might have been obtained via a series of calls to the functions
+     [pop], [force_reduction], [feed], etc., it produces a checkpoint, which
+     can be used to resume normal parsing, by supplying this checkpoint as an
+     argument to [offer]. *)
+
+  (* This function should be used with some care. It could "mess up the
+     lookahead" in the sense that it allows parsing to resume in an arbitrary
+     state [s] with an arbitrary lookahead symbol [t], even though Menhir's
+     reachability analysis (menhir --list-errors) might well think that it is
+     impossible to reach this particular configuration. If one is using
+     Menhir's new error reporting facility, this could cause the parser to
+     reach an error state for which no error message has been prepared. *)
+
+  val input_needed: 'a env -> 'a checkpoint
+
+end
+
+(* This signature is a fragment of the inspection API that is made available
+   to the user when [--inspection] is used. This fragment contains type
+   definitions for symbols. *)
+
+module type SYMBOLS = sig
+
+  (* The type ['a terminal] represents a terminal symbol. The type ['a
+     nonterminal] represents a nonterminal symbol. In both cases, the index
+     ['a] represents the type of the semantic values associated with this
+     symbol. The concrete definitions of these types are generated. *)
+
+  type 'a terminal
+  type 'a nonterminal
+
+  (* The type ['a symbol] represents a terminal or nonterminal symbol. It is
+     the disjoint union of the types ['a terminal] and ['a nonterminal]. *)
+
+  type 'a symbol =
+    | T : 'a terminal -> 'a symbol
+    | N : 'a nonterminal -> 'a symbol
+
+  (* The type [xsymbol] is an existentially quantified version of the type
+     ['a symbol]. This type is useful in situations where the index ['a]
+     is not statically known. *)
+
+  type xsymbol =
+    | X : 'a symbol -> xsymbol
+
+end
+
+(* This signature describes the inspection API that is made available to the
+   user when [--inspection] is used. *)
+
+module type INSPECTION = sig
+
+  (* The types of symbols are described above. *)
+
+  include SYMBOLS
+
+  (* The type ['a lr1state] is meant to be the same as in [INCREMENTAL_ENGINE]. *)
+
+  type 'a lr1state
+
+  (* The type [production] is meant to be the same as in [INCREMENTAL_ENGINE].
+     It represents a production of the grammar. A production can be examined
+     via the functions [lhs] and [rhs] below. *)
+
+  type production
+
+  (* An LR(0) item is a pair of a production [prod] and a valid index [i] into
+     this production. That is, if the length of [rhs prod] is [n], then [i] is
+     comprised between 0 and [n], inclusive. *)
+
+  type item =
+      production * int
+
+  (* Ordering functions. *)
+
+  val compare_terminals: _ terminal -> _ terminal -> int
+  val compare_nonterminals: _ nonterminal -> _ nonterminal -> int
+  val compare_symbols: xsymbol -> xsymbol -> int
+  val compare_productions: production -> production -> int
+  val compare_items: item -> item -> int
+
+  (* [incoming_symbol s] is the incoming symbol of the state [s], that is,
+     the symbol that the parser must recognize before (has recognized when)
+     it enters the state [s]. This function gives access to the semantic
+     value [v] stored in a stack element [Element (s, v, _, _)]. Indeed,
+     by case analysis on the symbol [incoming_symbol s], one discovers the
+     type ['a] of the value [v]. *)
+
+  val incoming_symbol: 'a lr1state -> 'a symbol
+
+  (* [items s] is the set of the LR(0) items in the LR(0) core of the LR(1)
+     state [s]. This set is not epsilon-closed. This set is presented as a
+     list, in an arbitrary order. *)
+
+  val items: _ lr1state -> item list
+
+  (* [lhs prod] is the left-hand side of the production [prod]. This is
+     always a non-terminal symbol. *)
+
+  val lhs: production -> xsymbol
+
+  (* [rhs prod] is the right-hand side of the production [prod]. This is
+     a (possibly empty) sequence of (terminal or nonterminal) symbols. *)
+
+  val rhs: production -> xsymbol list
+
+  (* [nullable nt] tells whether the non-terminal symbol [nt] is nullable.
+     That is, it is true if and only if this symbol produces the empty
+     word [epsilon]. *)
+
+  val nullable: _ nonterminal -> bool
+
+  (* [first nt t] tells whether the FIRST set of the nonterminal symbol [nt]
+     contains the terminal symbol [t]. That is, it is true if and only if
+     [nt] produces a word that begins with [t]. *)
+
+  val first: _ nonterminal -> _ terminal -> bool
+
+  (* [xfirst] is analogous to [first], but expects a first argument of type
+     [xsymbol] instead of [_ terminal]. *)
+
+  val xfirst: xsymbol -> _ terminal -> bool
+
+  (* [foreach_terminal] enumerates the terminal symbols, including [error].
+     [foreach_terminal_but_error] enumerates the terminal symbols, excluding
+     [error]. *)
+
+  val foreach_terminal:           (xsymbol -> 'a -> 'a) -> 'a -> 'a
+  val foreach_terminal_but_error: (xsymbol -> 'a -> 'a) -> 'a -> 'a
+
+  (* The type [env] is meant to be the same as in [INCREMENTAL_ENGINE]. *)
+
+  type 'a env
+
+  (* [feed symbol startp semv endp env] causes the parser to consume the
+     (terminal or nonterminal) symbol [symbol], accompanied with the semantic
+     value [semv] and with the start and end positions [startp] and [endp].
+     Thus, the automaton makes a transition, and reaches a new state. The
+     stack grows by one cell. This operation is permitted only if the current
+     state (as determined by [env]) has an outgoing transition labeled with
+     [symbol]. Otherwise, [Invalid_argument _] is raised. *)
+
+  val feed: 'a symbol -> position -> 'a -> position -> 'b env -> 'b env
+
+end
+
+(* This signature combines the incremental API and the inspection API. *)
+
+module type EVERYTHING = sig
+
+  include INCREMENTAL_ENGINE
+
+  include INSPECTION
+    with type 'a lr1state := 'a lr1state
+    with type production := production
+    with type 'a env := 'a env
+
+end
+end
+module EngineTypes : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* This file defines several types and module types that are used in the
+   specification of module [Engine]. *)
+
+(* --------------------------------------------------------------------------- *)
+
+(* It would be nice if we could keep the structure of stacks and environments
+   hidden. However, stacks and environments must be accessible to semantic
+   actions, so the following data structure definitions must be public. *)
+
+(* --------------------------------------------------------------------------- *)
+
+(* A stack is a linked list of cells. A sentinel cell -- which is its own
+   successor -- is used to mark the bottom of the stack. The sentinel cell
+   itself is not significant -- it contains dummy values. *)
+
+type ('state, 'semantic_value) stack = {
+
+  (* The state that we should go back to if we pop this stack cell. *)
+
+  (* This convention means that the state contained in the top stack cell is
+     not the current state [env.current]. It also means that the state found
+     within the sentinel is a dummy -- it is never consulted. This convention
+     is the same as that adopted by the code-based back-end. *)
+
+  state: 'state;
+
+  (* The semantic value associated with the chunk of input that this cell
+     represents. *)
+
+  semv: 'semantic_value;
+
+  (* The start and end positions of the chunk of input that this cell
+     represents. *)
+
+  startp: Lexing.position;
+  endp: Lexing.position;
+
+  (* The next cell down in the stack. If this is a self-pointer, then this
+     cell is the sentinel, and the stack is conceptually empty. *)
+
+  next: ('state, 'semantic_value) stack;
+
+}
+
+(* --------------------------------------------------------------------------- *)
+
+(* A parsing environment contains all of the parser's state (except for the
+   current program point). *)
+
+type ('state, 'semantic_value, 'token) env = {
+
+  (* If this flag is true, then the first component of [env.triple] should
+     be ignored, as it has been logically overwritten with the [error]
+     pseudo-token. *)
+
+  error: bool;
+
+  (* The last token that was obtained from the lexer, together with its start
+     and end positions. Warning: before the first call to the lexer has taken
+     place, a dummy (and possibly invalid) token is stored here. *)
+
+  triple: 'token * Lexing.position * Lexing.position;
+
+  (* The stack. In [CodeBackend], it is passed around on its own,
+     whereas, here, it is accessed via the environment. *)
+
+  stack: ('state, 'semantic_value) stack;
+
+  (* The current state. In [CodeBackend], it is passed around on its
+     own, whereas, here, it is accessed via the environment. *)
+
+  current: 'state;
+
+}
+
+(* --------------------------------------------------------------------------- *)
+
+(* This signature describes the parameters that must be supplied to the LR
+   engine. *)
+
+module type TABLE = sig
+
+  (* The type of automaton states. *)
+
+  type state
+
+  (* States are numbered. *)
+
+  val number: state -> int
+
+  (* The type of tokens. These can be thought of as real tokens, that is,
+     tokens returned by the lexer. They carry a semantic value. This type
+     does not include the [error] pseudo-token. *)
+
+  type token
+
+  (* The type of terminal symbols. These can be thought of as integer codes.
+     They do not carry a semantic value. This type does include the [error]
+     pseudo-token. *)
+
+  type terminal
+
+  (* The type of nonterminal symbols. *)
+
+  type nonterminal
+
+  (* The type of semantic values. *)
+
+  type semantic_value
+
+  (* A token is conceptually a pair of a (non-[error]) terminal symbol and
+     a semantic value. The following two functions are the pair projections. *)
+
+  val token2terminal: token -> terminal
+  val token2value: token -> semantic_value
+
+  (* Even though the [error] pseudo-token is not a real token, it is a
+     terminal symbol. Furthermore, for regularity, it must have a semantic
+     value. *)
+
+  val error_terminal: terminal
+  val error_value: semantic_value
+
+  (* [foreach_terminal] allows iterating over all terminal symbols. *)
+
+  val foreach_terminal: (terminal -> 'a -> 'a) -> 'a -> 'a
+
+  (* The type of productions. *)
+
+  type production
+
+  val production_index: production -> int
+  val find_production: int -> production
+
+  (* If a state [s] has a default reduction on production [prod], then, upon
+     entering [s], the automaton should reduce [prod] without consulting the
+     lookahead token. The following function allows determining which states
+     have default reductions. *)
+
+  (* Instead of returning a value of a sum type -- either [DefRed prod], or
+     [NoDefRed] -- it accepts two continuations, and invokes just one of
+     them. This mechanism allows avoiding a memory allocation. *)
+
+  val default_reduction:
+    state ->
+    ('env -> production -> 'answer) ->
+    ('env -> 'answer) ->
+    'env -> 'answer
+
+  (* An LR automaton can normally take three kinds of actions: shift, reduce,
+     or fail. (Acceptance is a particular case of reduction: it consists in
+     reducing a start production.) *)
+
+  (* There are two variants of the shift action. [shift/discard s] instructs
+     the automaton to discard the current token, request a new one from the
+     lexer, and move to state [s]. [shift/nodiscard s] instructs it to move to
+     state [s] without requesting a new token. This instruction should be used
+     when [s] has a default reduction on [#]. See [CodeBackend.gettoken] for
+     details. *)
+
+  (* This is the automaton's action table. It maps a pair of a state and a
+     terminal symbol to an action. *)
+
+  (* Instead of returning a value of a sum type -- one of shift/discard,
+     shift/nodiscard, reduce, or fail -- this function accepts three
+     continuations, and invokes just one them. This mechanism allows avoiding
+     a memory allocation. *)
+
+  (* In summary, the parameters to [action] are as follows:
+
+     - the first two parameters, a state and a terminal symbol, are used to
+       look up the action table;
+
+     - the next parameter is the semantic value associated with the above
+       terminal symbol; it is not used, only passed along to the shift
+       continuation, as explained below;
+
+     - the shift continuation expects an environment; a flag that tells
+       whether to discard the current token; the terminal symbol that
+       is being shifted; its semantic value; and the target state of
+       the transition;
+
+     - the reduce continuation expects an environment and a production;
+
+     - the fail continuation expects an environment;
+
+     - the last parameter is the environment; it is not used, only passed
+       along to the selected continuation. *)
+
+  val action:
+    state ->
+    terminal ->
+    semantic_value ->
+    ('env -> bool -> terminal -> semantic_value -> state -> 'answer) ->
+    ('env -> production -> 'answer) ->
+    ('env -> 'answer) ->
+    'env -> 'answer
+
+  (* 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. *)
+
+  (* The function [goto_nt] can be applied to [s] and [nt] ONLY if the state
+     [s] has an outgoing transition labeled [nt]. Otherwise, its result is
+     undefined. Similarly, the call [goto_prod prod s] is permitted ONLY if
+     the state [s] has an outgoing transition labeled with the nonterminal
+     symbol [lhs prod]. The function [maybe_goto_nt] involves an additional
+     dynamic check and CAN be called even if there is no outgoing transition. *)
+
+  val       goto_nt  : state -> nonterminal -> state
+  val       goto_prod: state -> production  -> state
+  val maybe_goto_nt:   state -> nonterminal -> state option
+
+  (* [is_start prod] tells whether the production [prod] is a start production. *)
+
+  val is_start: production -> bool
+
+  (* By convention, a semantic action is responsible for:
+
+     1. fetching whatever semantic values and positions it needs off the stack;
+
+     2. popping an appropriate number of cells off the stack, as dictated
+        by the length of the right-hand side of the production;
+
+     3. computing a new semantic value, as well as new start and end positions;
+
+     4. pushing a new stack cell, which contains the three values
+        computed in step 3;
+
+     5. returning the new stack computed in steps 2 and 4.
+
+     Point 1 is essentially forced upon us: if semantic values were fetched
+     off the stack by this interpreter, then the calling convention for
+     semantic actions would be variadic: not all semantic actions would have
+     the same number of arguments. The rest follows rather naturally. *)
+
+  (* Semantic actions are allowed to raise [Error]. *)
+
+  exception Error
+
+  type semantic_action =
+      (state, semantic_value, token) env -> (state, semantic_value) stack
+
+  val semantic_action: production -> semantic_action
+
+  (* [may_reduce state prod] tests whether the state [state] is capable of
+     reducing the production [prod]. This function is currently costly and
+     is not used by the core LR engine. It is used in the implementation
+     of certain functions, such as [force_reduction], which allow the engine
+     to be driven programmatically. *)
+
+  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 () to 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  / Accepting *)
+
+    val reduce_or_accept: production -> unit
+
+    (* Lookahead token is now  (-) *)
+
+    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  *)
+
+    val handling_error: state -> unit
+
+  end
+
+end
+
+(* --------------------------------------------------------------------------- *)
+
+(* This signature describes the monolithic (traditional) LR engine. *)
+
+(* In this interface, the parser controls the lexer. *)
+
+module type MONOLITHIC_ENGINE = sig
+
+  type state
+
+  type token
+
+  type semantic_value
+
+  (* An entry point to the engine requires a start state, a lexer, and a lexing
+     buffer. It either succeeds and produces a semantic value, or fails and
+     raises [Error]. *)
+
+  exception Error
+
+  val entry:
+    state ->
+    (Lexing.lexbuf -> token) ->
+    Lexing.lexbuf ->
+    semantic_value
+
+end
+
+(* --------------------------------------------------------------------------- *)
+
+(* The following signatures describe the incremental LR engine. *)
+
+(* First, see [INCREMENTAL_ENGINE] in the file [IncrementalEngine.ml]. *)
+
+(* The [start] function is set apart because we do not wish to publish
+   it as part of the generated [parser.mli] file. Instead, the table
+   back-end will publish specialized versions of it, with a suitable
+   type cast. *)
+
+module type INCREMENTAL_ENGINE_START = sig
+
+  (* [start] is an entry point. It requires a start state and a start position
+     and begins the parsing process. If the lexer is based on an OCaml lexing
+     buffer, the start position should be [lexbuf.lex_curr_p]. [start] produces
+     a checkpoint, which usually will be an [InputNeeded] checkpoint. (It could
+     be [Accepted] if this starting state accepts only the empty word. It could
+     be [Rejected] if this starting state accepts no word at all.) It does not
+     raise any exception. *)
+
+  (* [start s pos] should really produce a checkpoint of type ['a checkpoint],
+     for a fixed ['a] that depends on the state [s]. We cannot express this, so
+     we use [semantic_value checkpoint], which is safe. The table back-end uses
+     [Obj.magic] to produce safe specialized versions of [start]. *)
+
+  type state
+  type semantic_value
+  type 'a checkpoint
+
+  val start:
+    state ->
+    Lexing.position ->
+    semantic_value checkpoint
+
+end
+
+(* --------------------------------------------------------------------------- *)
+
+(* This signature describes the LR engine, which combines the monolithic
+   and incremental interfaces. *)
+
+module type ENGINE = sig
+
+  include MONOLITHIC_ENGINE
+
+  include IncrementalEngine.INCREMENTAL_ENGINE
+    with type token := token
+     and type 'a lr1state = state (* useful for us; hidden from the end user *)
+
+  include INCREMENTAL_ENGINE_START
+    with type state := state
+     and type semantic_value := semantic_value
+     and type 'a checkpoint := 'a checkpoint
+
+end
+end
+module Engine : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+open EngineTypes
+
+(* The LR parsing engine. *)
+
+module Make (T : TABLE)
+: ENGINE
+  with type state = T.state
+   and type token = T.token
+   and type semantic_value = T.semantic_value
+   and type production = T.production
+   and type 'a env = (T.state, T.semantic_value, T.token) EngineTypes.env
+
+(* We would prefer not to expose the definition of the type [env].
+   However, it must be exposed because some of the code in the
+   inspection API needs access to the engine's internals; see
+   [InspectionTableInterpreter]. Everything would be simpler if
+   --inspection was always ON, but that would lead to bigger parse
+   tables for everybody. *)
+end
+module ErrorReports : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* -------------------------------------------------------------------------- *)
+
+(* The following functions help keep track of the start and end positions of
+   the last two tokens in a two-place buffer. This is used to nicely display
+   where a syntax error took place. *)
+
+type 'a buffer
+
+(* [wrap lexer] returns a pair of a new (initially empty) buffer and a lexer
+   which internally relies on [lexer] and updates [buffer] on the fly whenever
+   a token is demanded. *)
+
+open Lexing
+
+val wrap:
+  (lexbuf -> 'token) ->
+  (position * position) buffer * (lexbuf -> 'token)
+
+(* [show f buffer] prints the contents of the buffer, producing a string that
+   is typically of the form "after '%s' and before '%s'". The function [f] is
+   used to print an element. The buffer MUST be nonempty. *)
+
+val show: ('a -> string) -> 'a buffer -> string
+
+(* [last buffer] returns the last element of the buffer. The buffer MUST be
+   nonempty. *)
+
+val last: 'a buffer -> 'a
+
+(* -------------------------------------------------------------------------- *)
+end
+module Printers : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* This module is part of MenhirLib. *)
+
+module Make
+
+  (I : IncrementalEngine.EVERYTHING)
+
+  (User : sig
+
+    (* [print s] is supposed to send the string [s] to some output channel. *)
+
+    val print: string -> unit
+
+    (* [print_symbol s] is supposed to print a representation of the symbol [s]. *)
+
+    val print_symbol: I.xsymbol -> unit
+
+    (* [print_element e] is supposed to print a representation of the element [e].
+       This function is optional; if it is not provided, [print_element_as_symbol]
+       (defined below) is used instead. *)
+
+    val print_element: (I.element -> unit) option
+
+  end)
+
+: sig
+
+  open I
+
+  (* Printing a list of symbols. *)
+
+  val print_symbols: xsymbol list -> unit
+
+  (* Printing an element as a symbol. This prints just the symbol
+     that this element represents; nothing more. *)
+
+  val print_element_as_symbol: element -> unit
+
+  (* Printing a stack as a list of elements. This function needs an element
+     printer. It uses [print_element] if provided by the user; otherwise
+     it uses [print_element_as_symbol]. (Ending with a newline.) *)
+
+  val print_stack: 'a env -> unit
+
+  (* Printing an item. (Ending with a newline.) *)
+
+  val print_item: item -> unit
+
+  (* Printing a production. (Ending with a newline.) *)
+
+  val print_production: production -> unit
+
+  (* Printing the current LR(1) state. The current state is first displayed
+     as a number; then the list of its LR(0) items is printed. (Ending with
+     a newline.) *)
+
+  val print_current_state: 'a env -> unit
+
+  (* Printing a summary of the stack and current state. This function just
+     calls [print_stack] and [print_current_state] in succession. *)
+
+  val print_env: 'a env -> unit
+
+end
+end
+module InfiniteArray : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(** This module implements infinite arrays. **)
+type 'a t
+
+(** [make x] creates an infinite array, where every slot contains [x]. **)
+val make: 'a -> 'a t
+
+(** [get a i] returns the element contained at offset [i] in the array [a].
+   Slots are numbered 0 and up. **)
+val get: 'a t -> int -> 'a
+
+(** [set a i x] sets the element contained at offset [i] in the array
+    [a] to [x]. Slots are numbered 0 and up. **)
+val set: 'a t -> int -> 'a -> unit
+
+(** [extent a] is the length of an initial segment of the array [a]
+    that is sufficiently large to contain all [set] operations ever
+    performed. In other words, all elements beyond that segment have
+    the default value. *)
+val extent: 'a t -> int
+
+(** [domain a] is a fresh copy of an initial segment of the array [a]
+    whose length is [extent a]. *)
+val domain: 'a t -> 'a array
+end
+module PackedIntArray : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* A packed integer array is represented as a pair of an integer [k] and
+   a string [s]. The integer [k] is the number of bits per integer that we
+   use. The string [s] is just an array of bits, which is read in 8-bit
+   chunks. *)
+
+(* The ocaml programming language treats string literals and array literals
+   in slightly different ways: the former are statically allocated, while
+   the latter are dynamically allocated. (This is rather arbitrary.) In the
+   context of Menhir's table-based back-end, where compact, immutable
+   integer arrays are needed, ocaml strings are preferable to ocaml arrays. *)
+
+type t =
+  int * string
+
+(* [pack a] turns an array of integers into a packed integer array. *)
+
+(* Because the sign bit is the most significant bit, the magnitude of
+   any negative number is the word size. In other words, [pack] does
+   not achieve any space savings as soon as [a] contains any negative
+   numbers, even if they are ``small''. *)
+
+val pack: int array -> t
+
+(* [get t i] returns the integer stored in the packed array [t] at index [i]. *)
+
+(* Together, [pack] and [get] satisfy the following property: if the index [i]
+   is within bounds, then [get (pack a) i] equals [a.(i)]. *)
+
+val get: t -> int -> int
+
+(* [get1 t i] returns the integer stored in the packed array [t] at index [i].
+   It assumes (and does not check) that the array's bit width is [1]. The
+   parameter [t] is just a string. *)
+
+val get1: string -> int -> int
+
+(* [unflatten1 (n, data) i j] accesses the two-dimensional bitmap
+   represented by [(n, data)] at indices [i] and [j]. The integer
+   [n] is the width of the bitmap; the string [data] is the second
+   component of the packed array obtained by encoding the table as
+   a one-dimensional array. *)
+
+val unflatten1: int * string -> int -> int -> int
+
+end
+module RowDisplacement : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* This module compresses a two-dimensional table, where some values
+   are considered insignificant, via row displacement. *)
+
+(* A compressed table is represented as a pair of arrays. The
+   displacement array is an array of offsets into the data array. *)
+
+type 'a table =
+    int array * (* displacement *)
+     'a array   (* data *)
+
+(* [compress equal insignificant dummy m n t] turns the two-dimensional table
+   [t] into a compressed table. The parameter [equal] is equality of data
+   values. The parameter [wildcard] tells which data values are insignificant,
+   and can thus be overwritten with other values. The parameter [dummy] is
+   used to fill holes in the data array. [m] and [n] are the integer
+   dimensions of the table [t]. *)
+
+val compress:
+  ('a -> 'a -> bool) ->
+  ('a -> bool) ->
+  'a ->
+  int -> int ->
+  'a array array ->
+  'a table
+
+(* [get ct i j] returns the value found at indices [i] and [j] in the
+   compressed table [ct]. This function call is permitted only if the
+   value found at indices [i] and [j] in the original table is
+   significant -- otherwise, it could fail abruptly. *)
+
+(* Together, [compress] and [get] have the property that, if the value
+   found at indices [i] and [j] in an uncompressed table [t] is
+   significant, then [get (compress t) i j] is equal to that value. *)
+
+val get:
+  'a table ->
+  int -> int ->
+  'a
+
+(* [getget] is a variant of [get] which only requires read access,
+   via accessors, to the two components of the table. *)
+
+val getget:
+  ('displacement -> int -> int) ->
+  ('data -> int -> 'a) ->
+  'displacement * 'data ->
+  int -> int ->
+  'a
+
+end
+module LinearizedArray : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* An array of arrays (of possibly different lengths!) can be ``linearized'',
+   i.e., encoded as a data array (by concatenating all of the little arrays)
+   and an entry array (which contains offsets into the data array). *)
+
+type 'a t =
+  (* data: *)   'a array *
+  (* entry: *) int array
+
+(* [make a] turns the array of arrays [a] into a linearized array. *)
+
+val make: 'a array array -> 'a t
+
+(* [read la i j] reads the linearized array [la] at indices [i] and [j].
+   Thus, [read (make a) i j] is equivalent to [a.(i).(j)]. *)
+
+val read: 'a t -> int -> int -> 'a
+
+(* [write la i j v] writes the value [v] into the linearized array [la]
+   at indices [i] and [j]. *)
+
+val write: 'a t -> int -> int -> 'a -> unit
+
+(* [length la] is the number of rows of the array [la]. Thus, [length (make
+   a)] is equivalent to [Array.length a]. *)
+
+val length: 'a t -> int
+
+(* [row_length la i] is the length of the row at index [i] in the linearized
+   array [la]. Thus, [row_length (make a) i] is equivalent to [Array.length
+   a.(i)]. *)
+
+val row_length: 'a t -> int -> int
+
+(* [read_row la i] reads the row at index [i], producing a list. Thus,
+   [read_row (make a) i] is equivalent to [Array.to_list a.(i)]. *)
+
+val read_row: 'a t -> int -> 'a list
+
+(* The following variants read the linearized array via accessors
+   [get_data : int -> 'a] and [get_entry : int -> int]. *)
+
+val row_length_via:
+  (* get_entry: *) (int -> int) ->
+  (* i: *)         int ->
+                   int
+
+val read_via:
+  (* get_data: *)  (int -> 'a) ->
+  (* get_entry: *) (int -> int) ->
+  (* i: *)         int ->
+  (* j: *)         int ->
+                   'a
+
+val read_row_via:
+  (* get_data: *)  (int -> 'a) ->
+  (* get_entry: *) (int -> int) ->
+  (* i: *)         int ->
+                   'a list
+
+end
+module TableFormat : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* This signature defines the format of the parse tables. It is used as
+   an argument to [TableInterpreter.Make]. *)
+
+module type TABLES = sig
+
+  (* This is the parser's type of tokens. *)
+
+  type token
+
+  (* This maps a token to its internal (generation-time) integer code. *)
+
+  val token2terminal: token -> int
+
+  (* This is the integer code for the error pseudo-token. *)
+
+  val error_terminal: int
+
+  (* This maps a token to its semantic value. *)
+
+  val token2value: token -> Obj.t
+
+  (* Traditionally, an LR automaton is described by two tables, namely, an
+     action table and a goto table. See, for instance, the Dragon book.
+
+     The action table is a two-dimensional matrix that maps a state and a
+     lookahead token to an action. An action is one of: shift to a certain
+     state, reduce a certain production, accept, or fail.
+
+     The goto table is a two-dimensional matrix that maps a state and a
+     non-terminal symbol to either a state or undefined. By construction, this
+     table is sparse: its undefined entries are never looked up. A compression
+     technique is free to overlap them with other entries.
+
+     In Menhir, things are slightly different. If a state has a default
+     reduction on token [#], then that reduction must be performed without
+     consulting the lookahead token. As a result, we must first determine
+     whether that is the case, before we can obtain a lookahead token and use it
+     as an index in the action table.
+
+     Thus, Menhir's tables are as follows.
+
+     A one-dimensional default reduction table maps a state to either ``no
+     default reduction'' (encoded as: 0) or ``by default, reduce prod''
+     (encoded as: 1 + prod). The action table is looked up only when there
+     is no default reduction. *)
+
+  val default_reduction: PackedIntArray.t
+
+  (* Menhir follows Dencker, Dürre and Heuft, who point out that, although the
+     action table is not sparse by nature (i.e., the error entries are
+     significant), it can be made sparse by first factoring out a binary error
+     matrix, then replacing the error entries in the action table with undefined
+     entries. Thus:
+
+     A two-dimensional error bitmap maps a state and a terminal to either
+     ``fail'' (encoded as: 0) or ``do not fail'' (encoded as: 1). The action
+     table, which is now sparse, is looked up only in the latter case. *)
+
+  (* The error bitmap is flattened into a one-dimensional table; its width is
+     recorded so as to allow indexing. The table is then compressed via
+     [PackedIntArray]. The bit width of the resulting packed array must be
+     [1], so it is not explicitly recorded. *)
+
+  (* The error bitmap does not contain a column for the [#] pseudo-terminal.
+     Thus, its width is [Terminal.n - 1]. We exploit the fact that the integer
+     code assigned to [#] is greatest: the fact that the right-most column
+     in the bitmap is missing does not affect the code for accessing it. *)
+
+  val error: int (* width of the bitmap *) * string (* second component of [PackedIntArray.t] *)
+
+  (* A two-dimensional action table maps a state and a terminal to one of
+     ``shift to state s and discard the current token'' (encoded as: s | 10),
+     ``shift to state s without discarding the current token'' (encoded as: s |
+     11), or ``reduce prod'' (encoded as: prod | 01). *)
+
+  (* The action table is first compressed via [RowDisplacement], then packed
+     via [PackedIntArray]. *)
+
+  (* Like the error bitmap, the action table does not contain a column for the
+     [#] pseudo-terminal. *)
+
+  val action: PackedIntArray.t * PackedIntArray.t
+
+  (* A one-dimensional lhs table maps a production to its left-hand side (a
+     non-terminal symbol). *)
+
+  val lhs: PackedIntArray.t
+
+  (* A two-dimensional goto table maps a state and a non-terminal symbol to
+     either undefined (encoded as: 0) or a new state s (encoded as: 1 + s). *)
+
+  (* The goto table is first compressed via [RowDisplacement], then packed
+     via [PackedIntArray]. *)
+
+  val goto: PackedIntArray.t * PackedIntArray.t
+
+  (* The number of start productions. A production [prod] is a start
+     production if and only if [prod < start] holds. This is also the
+     number of start symbols. A nonterminal symbol [nt] is a start
+     symbol if and only if [nt < start] holds. *)
+
+  val start: int
+
+  (* A one-dimensional semantic action table maps productions to semantic
+     actions. The calling convention for semantic actions is described in
+     [EngineTypes]. This table contains ONLY NON-START PRODUCTIONS, so the
+     indexing is off by [start]. Be careful. *)
+
+  val semantic_action: ((int, Obj.t, token) EngineTypes.env ->
+                        (int, Obj.t)        EngineTypes.stack) array
+
+  (* The parser defines its own [Error] exception. This exception can be
+     raised by semantic actions and caught by the engine, and raised by the
+     engine towards the final user. *)
+
+  exception Error
+
+  (* The parser indicates whether to generate a trace. Generating a
+     trace requires two extra tables, which respectively map a
+     terminal symbol and a production to a string. *)
+
+  val trace: (string array * string array) option
+
+end
+end
+module InspectionTableFormat : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* This signature defines the format of the tables that are produced (in
+   addition to the tables described in [TableFormat]) when the command line
+   switch [--inspection] is enabled. It is used as an argument to
+   [InspectionTableInterpreter.Make]. *)
+
+module type TABLES = sig
+
+  (* The types of symbols. *)
+
+  include IncrementalEngine.SYMBOLS
+
+  (* The type ['a lr1state] describes an LR(1) state. The generated parser defines
+     it internally as [int]. *)
+
+  type 'a lr1state
+
+  (* Some of the tables that follow use encodings of (terminal and
+     nonterminal) symbols as integers. So, we need functions that
+     map the integer encoding of a symbol to its algebraic encoding. *)
+
+  val    terminal: int -> xsymbol
+  val nonterminal: int -> xsymbol
+
+  (* The left-hand side of every production already appears in the
+     signature [TableFormat.TABLES], so we need not repeat it here. *)
+
+  (* The right-hand side of every production. This a linearized array
+     of arrays of integers, whose [data] and [entry] components have
+     been packed. The encoding of symbols as integers in described in
+     [TableBackend]. *)
+
+  val rhs: PackedIntArray.t * PackedIntArray.t
+
+  (* A mapping of every (non-initial) state to its LR(0) core. *)
+
+  val lr0_core: PackedIntArray.t
+
+  (* A mapping of every LR(0) state to its set of LR(0) items. Each item is
+     represented in its packed form (see [Item]) as an integer. Thus the
+     mapping is an array of arrays of integers, which is linearized and
+     packed, like [rhs]. *)
+
+  val lr0_items: PackedIntArray.t * PackedIntArray.t
+
+  (* A mapping of every LR(0) state to its incoming symbol, if it has one. *)
+
+  val lr0_incoming: PackedIntArray.t
+
+  (* A table that tells which non-terminal symbols are nullable. *)
+
+  val nullable: string
+    (* This is a packed int array of bit width 1. It can be read
+       using [PackedIntArray.get1]. *)
+
+  (* A two-table dimensional table, indexed by a nonterminal symbol and
+     by a terminal symbol (other than [#]), encodes the FIRST sets. *)
+
+  val first: int (* width of the bitmap *) * string (* second component of [PackedIntArray.t] *)
+
+end
+
+end
+module InspectionTableInterpreter : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* This functor is invoked inside the generated parser, in [--table] mode. It
+   produces no code! It simply constructs the types [symbol] and [xsymbol] on
+   top of the generated types [terminal] and [nonterminal]. *)
+
+module Symbols (T : sig
+
+  type 'a terminal
+  type 'a nonterminal
+
+end)
+
+: IncrementalEngine.SYMBOLS
+  with type 'a terminal := 'a T.terminal
+   and type 'a nonterminal := 'a T.nonterminal
+
+(* This functor is invoked inside the generated parser, in [--table] mode. It
+   constructs the inspection API on top of the inspection tables described in
+   [InspectionTableFormat]. *)
+
+module Make
+  (TT : TableFormat.TABLES)
+  (IT : InspectionTableFormat.TABLES
+        with type 'a lr1state = int)
+  (ET : EngineTypes.TABLE
+        with type terminal = int
+         and type nonterminal = int
+         and type semantic_value = Obj.t)
+  (E : sig
+     type 'a env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env
+   end)
+
+: IncrementalEngine.INSPECTION
+  with type 'a terminal := 'a IT.terminal
+   and type 'a nonterminal := 'a IT.nonterminal
+   and type 'a lr1state := 'a IT.lr1state
+   and type production := int
+   and type 'a env := 'a E.env
+end
+module TableInterpreter : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   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.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* This module provides a thin decoding layer for the generated tables, thus
+   providing an API that is suitable for use by [Engine.Make]. It is part of
+   [MenhirLib]. *)
+
+(* The exception [Error] is declared within the generated parser. This is
+   preferable to pre-declaring it here, as it ensures that each parser gets
+   its own, distinct [Error] exception. This is consistent with the code-based
+   back-end. *)
+
+(* This functor is invoked by the generated parser. *)
+
+module MakeEngineTable
+  (T : TableFormat.TABLES)
+: EngineTypes.TABLE
+    with type state = int
+     and type token = T.token
+     and type semantic_value = Obj.t
+     and type production = int
+     and type terminal = int
+     and type nonterminal = int
+end
+module StaticVersion : sig
+val require_20190924 : unit
+end
diff --git a/boot/menhir/parser.ml b/boot/menhir/parser.ml
new file mode 100644
index 00000000..a4a9fc6a
--- /dev/null
+++ b/boot/menhir/parser.ml
@@ -0,0 +1,46765 @@
+
+(* This generated code requires the following version of MenhirLib: *)
+
+let () =
+  MenhirLib.StaticVersion.require_20190924
+
+module MenhirBasics = struct
+  
+  exception Error = Parsing.Parse_error
+  
+  type token = 
+    | WITH
+    | WHILE
+    | WHEN
+    | VIRTUAL
+    | VAL
+    | UNDERSCORE
+    | UIDENT of (
+# 697 "parsing/parser.mly"
+       (string)
+# 22 "parsing/parser.ml"
+  )
+    | TYPE
+    | TRY
+    | TRUE
+    | TO
+    | TILDE
+    | THEN
+    | STRUCT
+    | STRING of (
+# 685 "parsing/parser.mly"
+       (string * Location.t * string option)
+# 34 "parsing/parser.ml"
+  )
+    | STAR
+    | SIG
+    | SEMISEMI
+    | SEMI
+    | RPAREN
+    | REC
+    | RBRACKET
+    | RBRACE
+    | QUOTED_STRING_ITEM of (
+# 689 "parsing/parser.mly"
+  (string * Location.t * string * Location.t * string option)
+# 47 "parsing/parser.ml"
+  )
+    | QUOTED_STRING_EXPR of (
+# 687 "parsing/parser.mly"
+  (string * Location.t * string * Location.t * string option)
+# 52 "parsing/parser.ml"
+  )
+    | QUOTE
+    | QUESTION
+    | PRIVATE
+    | PREFIXOP of (
+# 671 "parsing/parser.mly"
+       (string)
+# 60 "parsing/parser.ml"
+  )
+    | PLUSEQ
+    | PLUSDOT
+    | PLUS
+    | PERCENT
+    | OR
+    | OPTLABEL of (
+# 664 "parsing/parser.mly"
+       (string)
+# 70 "parsing/parser.ml"
+  )
+    | OPEN
+    | OF
+    | OBJECT
+    | NONREC
+    | NEW
+    | MUTABLE
+    | MODULE
+    | MINUSGREATER
+    | MINUSDOT
+    | MINUS
+    | METHOD
+    | MATCH
+    | LPAREN
+    | LIDENT of (
+# 647 "parsing/parser.mly"
+       (string)
+# 88 "parsing/parser.ml"
+  )
+    | LETOP of (
+# 629 "parsing/parser.mly"
+       (string)
+# 93 "parsing/parser.ml"
+  )
+    | LET
+    | LESSMINUS
+    | LESS
+    | LBRACKETPERCENTPERCENT
+    | LBRACKETPERCENT
+    | LBRACKETLESS
+    | LBRACKETGREATER
+    | LBRACKETBAR
+    | LBRACKETATATAT
+    | LBRACKETATAT
+    | LBRACKETAT
+    | LBRACKET
+    | LBRACELESS
+    | LBRACE
+    | LAZY
+    | LABEL of (
+# 634 "parsing/parser.mly"
+       (string)
+# 113 "parsing/parser.ml"
+  )
+    | INT of (
+# 633 "parsing/parser.mly"
+       (string * char option)
+# 118 "parsing/parser.ml"
+  )
+    | INITIALIZER
+    | INHERIT
+    | INFIXOP4 of (
+# 627 "parsing/parser.mly"
+       (string)
+# 125 "parsing/parser.ml"
+  )
+    | INFIXOP3 of (
+# 626 "parsing/parser.mly"
+       (string)
+# 130 "parsing/parser.ml"
+  )
+    | INFIXOP2 of (
+# 625 "parsing/parser.mly"
+       (string)
+# 135 "parsing/parser.ml"
+  )
+    | INFIXOP1 of (
+# 624 "parsing/parser.mly"
+       (string)
+# 140 "parsing/parser.ml"
+  )
+    | INFIXOP0 of (
+# 623 "parsing/parser.mly"
+       (string)
+# 145 "parsing/parser.ml"
+  )
+    | INCLUDE
+    | IN
+    | IF
+    | HASHOP of (
+# 682 "parsing/parser.mly"
+       (string)
+# 153 "parsing/parser.ml"
+  )
+    | HASH
+    | GREATERRBRACKET
+    | GREATERRBRACE
+    | GREATER
+    | FUNCTOR
+    | FUNCTION
+    | FUN
+    | FOR
+    | FLOAT of (
+# 612 "parsing/parser.mly"
+       (string * char option)
+# 166 "parsing/parser.ml"
+  )
+    | FALSE
+    | EXTERNAL
+    | EXCEPTION
+    | EQUAL
+    | EOL
+    | EOF
+    | END
+    | ELSE
+    | DOWNTO
+    | DOTOP of (
+# 628 "parsing/parser.mly"
+       (string)
+# 180 "parsing/parser.ml"
+  )
+    | DOTDOT
+    | DOT
+    | DONE
+    | DOCSTRING of (
+# 705 "parsing/parser.mly"
+       (Docstrings.docstring)
+# 188 "parsing/parser.ml"
+  )
+    | DO
+    | CONSTRAINT
+    | COMMENT of (
+# 704 "parsing/parser.mly"
+       (string * Location.t)
+# 195 "parsing/parser.ml"
+  )
+    | COMMA
+    | COLONGREATER
+    | COLONEQUAL
+    | COLONCOLON
+    | COLON
+    | CLASS
+    | CHAR of (
+# 592 "parsing/parser.mly"
+       (char)
+# 206 "parsing/parser.ml"
+  )
+    | BEGIN
+    | BARRBRACKET
+    | BARBAR
+    | BAR
+    | BANG
+    | BACKQUOTE
+    | ASSERT
+    | AS
+    | ANDOP of (
+# 630 "parsing/parser.mly"
+       (string)
+# 219 "parsing/parser.ml"
+  )
+    | AND
+    | AMPERSAND
+    | AMPERAMPER
+  
+end
+
+include MenhirBasics
+
+let _eRR =
+  MenhirBasics.Error
+
+# 18 "parsing/parser.mly"
+  
+
+open Asttypes
+open Longident
+open Parsetree
+open Ast_helper
+open Docstrings
+open Docstrings.WithMenhir
+
+let mkloc = Location.mkloc
+let mknoloc = Location.mknoloc
+
+let make_loc (startpos, endpos) = {
+  Location.loc_start = startpos;
+  Location.loc_end = endpos;
+  Location.loc_ghost = false;
+}
+
+let ghost_loc (startpos, endpos) = {
+  Location.loc_start = startpos;
+  Location.loc_end = endpos;
+  Location.loc_ghost = true;
+}
+
+let mktyp ~loc d = Typ.mk ~loc:(make_loc loc) d
+let mkpat ~loc d = Pat.mk ~loc:(make_loc loc) d
+let mkexp ~loc d = Exp.mk ~loc:(make_loc loc) d
+let mkmty ~loc ?attrs d = Mty.mk ~loc:(make_loc loc) ?attrs d
+let mksig ~loc d = Sig.mk ~loc:(make_loc loc) d
+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 pstr_typext (te, ext) =
+  (Pstr_typext te, ext)
+let pstr_primitive (vd, ext) =
+  (Pstr_primitive vd, ext)
+let pstr_type ((nr, ext), tys) =
+  (Pstr_type (nr, tys), ext)
+let pstr_exception (te, ext) =
+  (Pstr_exception te, ext)
+let pstr_include (body, ext) =
+  (Pstr_include body, ext)
+let pstr_recmodule (ext, bindings) =
+  (Pstr_recmodule bindings, ext)
+
+let psig_typext (te, ext) =
+  (Psig_typext te, ext)
+let psig_value (vd, ext) =
+  (Psig_value vd, ext)
+let psig_type ((nr, ext), tys) =
+  (Psig_type (nr, tys), ext)
+let psig_typesubst ((nr, ext), tys) =
+  assert (nr = Recursive); (* see [no_nonrec_flag] *)
+  (Psig_typesubst tys, ext)
+let psig_exception (te, ext) =
+  (Psig_exception te, ext)
+let psig_include (body, ext) =
+  (Psig_include body, ext)
+
+let mkctf ~loc ?attrs ?docs d =
+  Ctf.mk ~loc:(make_loc loc) ?attrs ?docs d
+let mkcf ~loc ?attrs ?docs d =
+  Cf.mk ~loc:(make_loc loc) ?attrs ?docs d
+
+let mkrhs rhs loc = mkloc rhs (make_loc loc)
+let ghrhs rhs loc = mkloc rhs (ghost_loc loc)
+
+let push_loc x acc =
+  if x.Location.loc_ghost
+  then acc
+  else x :: acc
+
+let reloc_pat ~loc x =
+  { x with ppat_loc = make_loc loc;
+           ppat_loc_stack = push_loc x.ppat_loc x.ppat_loc_stack };;
+let reloc_exp ~loc x =
+  { x with pexp_loc = make_loc loc;
+           pexp_loc_stack = push_loc x.pexp_loc x.pexp_loc_stack };;
+let reloc_typ ~loc x =
+  { x with ptyp_loc = make_loc loc;
+           ptyp_loc_stack = push_loc x.ptyp_loc x.ptyp_loc_stack };;
+
+let mkexpvar ~loc (name : string) =
+  mkexp ~loc (Pexp_ident(mkrhs (Lident name) loc))
+
+let mkoperator =
+  mkexpvar
+
+let mkpatvar ~loc name =
+  mkpat ~loc (Ppat_var (mkrhs name loc))
+
+(*
+  Ghost expressions and patterns:
+  expressions and patterns that do not appear explicitly in the
+  source file they have the loc_ghost flag set to true.
+  Then the profiler will not try to instrument them and the
+  -annot option will not try to display their type.
+
+  Every grammar rule that generates an element with a location must
+  make at most one non-ghost element, the topmost one.
+
+  How to tell whether your location must be ghost:
+  A location corresponds to a range of characters in the source file.
+  If the location contains a piece of code that is syntactically
+  valid (according to the documentation), and corresponds to the
+  AST node, then the location must be real; in all other cases,
+  it must be ghost.
+*)
+let ghexp ~loc d = Exp.mk ~loc:(ghost_loc loc) d
+let ghpat ~loc d = Pat.mk ~loc:(ghost_loc loc) d
+let ghtyp ~loc d = Typ.mk ~loc:(ghost_loc loc) d
+let ghloc ~loc d = { txt = d; loc = ghost_loc loc }
+let ghstr ~loc d = Str.mk ~loc:(ghost_loc loc) d
+let ghsig ~loc d = Sig.mk ~loc:(ghost_loc loc) d
+
+let mkinfix arg1 op arg2 =
+  Pexp_apply(op, [Nolabel, arg1; Nolabel, arg2])
+
+let neg_string f =
+  if String.length f > 0 && f.[0] = '-'
+  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))
+  | _ ->
+      Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
+
+let mkuplus ~oploc name arg =
+  let desc = arg.pexp_desc in
+  match name, desc with
+  | "+", Pexp_constant(Pconst_integer _)
+  | ("+" | "+."), Pexp_constant(Pconst_float _) -> desc
+  | _ ->
+      Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
+
+(* TODO define an abstraction boundary between locations-as-pairs
+   and locations-as-Location.t; it should be clear when we move from
+   one world to the other *)
+
+let mkexp_cons_desc consloc args =
+  Pexp_construct(mkrhs (Lident "::") consloc, Some args)
+let mkexp_cons ~loc consloc args =
+  mkexp ~loc (mkexp_cons_desc consloc args)
+
+let mkpat_cons_desc consloc args =
+  Ppat_construct(mkrhs (Lident "::") consloc, Some args)
+let mkpat_cons ~loc consloc args =
+  mkpat ~loc (mkpat_cons_desc consloc args)
+
+let ghexp_cons_desc consloc args =
+  Pexp_construct(ghrhs (Lident "::") consloc, Some args)
+let ghpat_cons_desc consloc args =
+  Ppat_construct(ghrhs (Lident "::") consloc, Some args)
+
+let rec mktailexp nilloc = let open Location in function
+    [] ->
+      let nil = ghloc ~loc:nilloc (Lident "[]") in
+      Pexp_construct (nil, None), nilloc
+  | e1 :: el ->
+      let exp_el, el_loc = mktailexp nilloc el in
+      let loc = (e1.pexp_loc.loc_start, snd el_loc) in
+      let arg = ghexp ~loc (Pexp_tuple [e1; ghexp ~loc:el_loc exp_el]) in
+      ghexp_cons_desc loc arg, loc
+
+let rec mktailpat nilloc = let open Location in function
+    [] ->
+      let nil = ghloc ~loc:nilloc (Lident "[]") in
+      Ppat_construct (nil, None), nilloc
+  | p1 :: pl ->
+      let pat_pl, el_loc = mktailpat nilloc pl in
+      let loc = (p1.ppat_loc.loc_start, snd el_loc) in
+      let arg = ghpat ~loc (Ppat_tuple [p1; ghpat ~loc:el_loc pat_pl]) in
+      ghpat_cons_desc loc arg, loc
+
+let mkstrexp e attrs =
+  { pstr_desc = Pstr_eval (e, attrs); pstr_loc = e.pexp_loc }
+
+let mkexp_constraint ~loc e (t1, t2) =
+  match t1, t2 with
+  | Some t, None -> ghexp ~loc (Pexp_constraint(e, t))
+  | _, Some t -> ghexp ~loc (Pexp_coerce(e, t1, t))
+  | None, None -> assert false
+
+let mkexp_opt_constraint ~loc e = function
+  | None -> e
+  | Some constraint_ -> mkexp_constraint ~loc e constraint_
+
+let mkpat_opt_constraint ~loc p = function
+  | None -> p
+  | Some typ -> mkpat ~loc (Ppat_constraint(p, typ))
+
+let syntax_error () =
+  raise Syntaxerr.Escape_error
+
+let unclosed opening_name opening_loc closing_name closing_loc =
+  raise(Syntaxerr.Error(Syntaxerr.Unclosed(make_loc opening_loc, opening_name,
+                                           make_loc closing_loc, closing_name)))
+
+let expecting loc nonterm =
+    raise Syntaxerr.(Error(Expecting(make_loc loc, nonterm)))
+
+let not_expecting loc nonterm =
+    raise Syntaxerr.(Error(Not_expecting(make_loc loc, nonterm)))
+
+let dotop ~left ~right ~assign ~ext ~multi =
+  let assign = if assign then "<-" else "" in
+  let mid = if multi then ";.." else "" in
+  String.concat "" ["."; ext; left; mid; right; assign]
+let paren = "(",")"
+let brace = "{", "}"
+let bracket = "[", "]"
+let lident x =  Lident x
+let ldot x y = Ldot(x,y)
+let dotop_fun ~loc dotop =
+  (* We could use ghexp here, but sticking to mkexp for parser.mly
+     compatibility. TODO improve parser.mly *)
+  mkexp ~loc (Pexp_ident (ghloc ~loc dotop))
+
+let array_function ~loc str name =
+  ghloc ~loc (Ldot(Lident str,
+                   (if !Clflags.unsafe then "unsafe_" ^ name else name)))
+
+let array_get_fun ~loc =
+  ghexp ~loc (Pexp_ident(array_function ~loc "Array" "get"))
+let string_get_fun ~loc =
+  ghexp ~loc (Pexp_ident(array_function ~loc "String" "get"))
+
+let array_set_fun ~loc =
+  ghexp ~loc (Pexp_ident(array_function ~loc "Array" "set"))
+let string_set_fun ~loc =
+  ghexp ~loc (Pexp_ident(array_function ~loc "String" "set"))
+
+let multi_indices ~loc = function
+  | [a] -> false, a
+  | l -> true, mkexp ~loc (Pexp_array l)
+
+let index_get ~loc get_fun array index =
+  let args = [Nolabel, array; Nolabel, index] in
+   mkexp ~loc (Pexp_apply(get_fun, args))
+
+let index_set ~loc set_fun array index value =
+  let args = [Nolabel, array; Nolabel, index; Nolabel, value] in
+   mkexp ~loc (Pexp_apply(set_fun, args))
+
+let array_get ~loc = index_get ~loc (array_get_fun ~loc)
+let string_get ~loc = index_get ~loc (string_get_fun ~loc)
+let dotop_get ~loc path (left,right) ext array index =
+  let multi, index = multi_indices ~loc index in
+  index_get ~loc
+    (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:false))
+    array index
+
+let array_set ~loc = index_set ~loc (array_set_fun ~loc)
+let string_set ~loc = index_set ~loc (string_set_fun ~loc)
+let dotop_set ~loc path (left,right) ext array index value=
+  let multi, index = multi_indices ~loc index in
+  index_set ~loc
+    (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:true))
+    array index value
+
+
+let bigarray_function ~loc str name =
+  ghloc ~loc (Ldot(Ldot(Lident "Bigarray", str), name))
+
+let bigarray_untuplify = function
+    { pexp_desc = Pexp_tuple explist; pexp_loc = _ } -> explist
+  | exp -> [exp]
+
+let bigarray_get ~loc arr arg =
+  let mkexp, ghexp = mkexp ~loc, ghexp ~loc in
+  let bigarray_function = bigarray_function ~loc in
+  let get = if !Clflags.unsafe then "unsafe_get" else "get" in
+  match bigarray_untuplify arg with
+    [c1] ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" get)),
+                       [Nolabel, arr; Nolabel, c1]))
+  | [c1;c2] ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" get)),
+                       [Nolabel, arr; Nolabel, c1; Nolabel, c2]))
+  | [c1;c2;c3] ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" get)),
+                       [Nolabel, arr; Nolabel, c1; Nolabel, c2; Nolabel, c3]))
+  | coords ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "get")),
+                       [Nolabel, arr; Nolabel, ghexp(Pexp_array coords)]))
+
+let bigarray_set ~loc arr arg newval =
+  let mkexp, ghexp = mkexp ~loc, ghexp ~loc in
+  let bigarray_function = bigarray_function ~loc in
+  let set = if !Clflags.unsafe then "unsafe_set" else "set" in
+  match bigarray_untuplify arg with
+    [c1] ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" set)),
+                       [Nolabel, arr; Nolabel, c1; Nolabel, newval]))
+  | [c1;c2] ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" set)),
+                       [Nolabel, arr; Nolabel, c1;
+                        Nolabel, c2; Nolabel, newval]))
+  | [c1;c2;c3] ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" set)),
+                       [Nolabel, arr; Nolabel, c1;
+                        Nolabel, c2; Nolabel, c3; Nolabel, newval]))
+  | coords ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "set")),
+                       [Nolabel, arr;
+                        Nolabel, ghexp(Pexp_array coords);
+                        Nolabel, newval]))
+
+let lapply ~loc p1 p2 =
+  if !Clflags.applicative_functors
+  then Lapply(p1, p2)
+  else raise (Syntaxerr.Error(
+                  Syntaxerr.Applicative_path (make_loc loc)))
+
+let exp_of_longident ~loc lid =
+  mkexp ~loc (Pexp_ident {lid with txt = Lident(Longident.last lid.txt)})
+
+(* [loc_map] could be [Location.map]. *)
+let loc_map (f : 'a -> 'b) (x : 'a Location.loc) : 'b Location.loc =
+  { x with txt = f x.txt }
+
+let loc_last (id : Longident.t Location.loc) : string Location.loc =
+  loc_map Longident.last id
+
+let loc_lident (id : string Location.loc) : Longident.t Location.loc =
+  loc_map (fun x -> Lident x) id
+
+let exp_of_label ~loc lbl =
+  mkexp ~loc (Pexp_ident (loc_lident lbl))
+
+let pat_of_label ~loc lbl =
+  mkpat ~loc (Ppat_var (loc_last lbl))
+
+let mk_newtypes ~loc newtypes exp =
+  let mkexp = mkexp ~loc in
+  List.fold_right (fun newtype exp -> mkexp (Pexp_newtype (newtype, exp)))
+    newtypes exp
+
+let wrap_type_annotation ~loc newtypes core_type body =
+  let mkexp, ghtyp = mkexp ~loc, ghtyp ~loc in
+  let mk_newtypes = mk_newtypes ~loc in
+  let exp = mkexp(Pexp_constraint(body,core_type)) in
+  let exp = mk_newtypes newtypes exp in
+  (exp, ghtyp(Ptyp_poly(newtypes, Typ.varify_constructors newtypes core_type)))
+
+let wrap_exp_attrs ~loc body (ext, attrs) =
+  let ghexp = ghexp ~loc in
+  (* todo: keep exact location for the entire attribute *)
+  let body = {body with pexp_attributes = attrs @ body.pexp_attributes} in
+  match ext with
+  | None -> body
+  | Some id -> ghexp(Pexp_extension (id, PStr [mkstrexp body []]))
+
+let mkexp_attrs ~loc d attrs =
+  wrap_exp_attrs ~loc (mkexp ~loc d) attrs
+
+let wrap_typ_attrs ~loc typ (ext, attrs) =
+  (* todo: keep exact location for the entire attribute *)
+  let typ = {typ with ptyp_attributes = attrs @ typ.ptyp_attributes} in
+  match ext with
+  | None -> typ
+  | Some id -> ghtyp ~loc (Ptyp_extension (id, PTyp typ))
+
+let wrap_pat_attrs ~loc pat (ext, attrs) =
+  (* todo: keep exact location for the entire attribute *)
+  let pat = {pat with ppat_attributes = attrs @ pat.ppat_attributes} in
+  match ext with
+  | None -> pat
+  | Some id -> ghpat ~loc (Ppat_extension (id, PPat (pat, None)))
+
+let mkpat_attrs ~loc d attrs =
+  wrap_pat_attrs ~loc (mkpat ~loc d) attrs
+
+let wrap_class_attrs ~loc:_ body attrs =
+  {body with pcl_attributes = attrs @ body.pcl_attributes}
+let wrap_mod_attrs ~loc:_ attrs body =
+  {body with pmod_attributes = attrs @ body.pmod_attributes}
+let wrap_mty_attrs ~loc:_ attrs body =
+  {body with pmty_attributes = attrs @ body.pmty_attributes}
+
+let wrap_str_ext ~loc body ext =
+  match ext with
+  | None -> body
+  | Some id -> ghstr ~loc (Pstr_extension ((id, PStr [body]), []))
+
+let wrap_mkstr_ext ~loc (item, ext) =
+  wrap_str_ext ~loc (mkstr ~loc item) ext
+
+let wrap_sig_ext ~loc body ext =
+  match ext with
+  | None -> body
+  | Some id -> ghsig ~loc (Psig_extension ((id, PSig [body]), []))
+
+let wrap_mksig_ext ~loc (item, ext) =
+  wrap_sig_ext ~loc (mksig ~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
+  (exp_id, PStr [mkstrexp e []])
+
+let text_str pos = Str.text (rhs_text pos)
+let text_sig pos = Sig.text (rhs_text pos)
+let text_cstr pos = Cf.text (rhs_text pos)
+let text_csig pos = Ctf.text (rhs_text pos)
+let text_def pos = [Ptop_def (Str.text (rhs_text pos))]
+
+let extra_text startpos endpos text items =
+  match items with
+  | [] ->
+      let post = rhs_post_text endpos in
+      let post_extras = rhs_post_extra_text endpos in
+      text post @ text post_extras
+  | _ :: _ ->
+      let pre_extras = rhs_pre_extra_text startpos in
+      let post_extras = rhs_post_extra_text endpos in
+        text pre_extras @ items @ text post_extras
+
+let extra_str p1 p2 items = extra_text p1 p2 Str.text items
+let extra_sig p1 p2 items = extra_text p1 p2 Sig.text items
+let extra_cstr p1 p2 items = extra_text p1 p2 Cf.text items
+let extra_csig p1 p2 items = extra_text p1 p2 Ctf.text  items
+let extra_def p1 p2 items =
+  extra_text p1 p2 (fun txt -> [Ptop_def (Str.text txt)]) items
+
+let extra_rhs_core_type ct ~pos =
+  let docs = rhs_info pos in
+  { ct with ptyp_attributes = add_info_attrs docs ct.ptyp_attributes }
+
+type let_binding =
+  { lb_pattern: pattern;
+    lb_expression: expression;
+    lb_attributes: attributes;
+    lb_docs: docs Lazy.t;
+    lb_text: text Lazy.t;
+    lb_loc: Location.t; }
+
+type let_bindings =
+  { lbs_bindings: let_binding list;
+    lbs_rec: rec_flag;
+    lbs_extension: string Asttypes.loc option;
+    lbs_loc: Location.t }
+
+let mklb first ~loc (p, e) attrs =
+  {
+    lb_pattern = p;
+    lb_expression = e;
+    lb_attributes = attrs;
+    lb_docs = symbol_docs_lazy loc;
+    lb_text = (if first then empty_text_lazy
+               else symbol_text_lazy (fst loc));
+    lb_loc = make_loc loc;
+  }
+
+let mklbs ~loc ext rf lb =
+  {
+    lbs_bindings = [lb];
+    lbs_rec = rf;
+    lbs_extension = ext ;
+    lbs_loc = make_loc loc;
+  }
+
+let addlb lbs lb =
+  { lbs with lbs_bindings = lb :: lbs.lbs_bindings }
+
+let val_of_let_bindings ~loc lbs =
+  let bindings =
+    List.map
+      (fun lb ->
+         Vb.mk ~loc:lb.lb_loc ~attrs:lb.lb_attributes
+           ~docs:(Lazy.force lb.lb_docs)
+           ~text:(Lazy.force lb.lb_text)
+           lb.lb_pattern lb.lb_expression)
+      lbs.lbs_bindings
+  in
+  let str = mkstr ~loc (Pstr_value(lbs.lbs_rec, List.rev bindings)) in
+  match lbs.lbs_extension with
+  | None -> str
+  | Some id -> ghstr ~loc (Pstr_extension((id, PStr [str]), []))
+
+let expr_of_let_bindings ~loc lbs body =
+  let bindings =
+    List.map
+      (fun lb ->
+         Vb.mk ~loc:lb.lb_loc ~attrs:lb.lb_attributes
+           lb.lb_pattern lb.lb_expression)
+      lbs.lbs_bindings
+  in
+    mkexp_attrs ~loc (Pexp_let(lbs.lbs_rec, List.rev bindings, body))
+      (lbs.lbs_extension, [])
+
+let class_of_let_bindings ~loc lbs body =
+  let bindings =
+    List.map
+      (fun lb ->
+         Vb.mk ~loc:lb.lb_loc ~attrs:lb.lb_attributes
+           lb.lb_pattern lb.lb_expression)
+      lbs.lbs_bindings
+  in
+    (* Our use of let_bindings(no_ext) guarantees the following: *)
+    assert (lbs.lbs_extension = None);
+    mkclass ~loc (Pcl_let (lbs.lbs_rec, List.rev bindings, body))
+
+(* 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. *)
+let package_type_of_module_type pmty =
+  let err loc s =
+    raise (Syntaxerr.Error (Syntaxerr.Invalid_package_type (loc, s)))
+  in
+  let map_cstr = function
+    | Pwith_type (lid, ptyp) ->
+        let loc = ptyp.ptype_loc in
+        if ptyp.ptype_params <> [] then
+          err loc "parametrized types are not supported";
+        if ptyp.ptype_cstrs <> [] then
+          err loc "constrained types are not supported";
+        if ptyp.ptype_private <> Public then
+          err loc "private types are not supported";
+
+        (* restrictions below are checked by the 'with_constraint' rule *)
+        assert (ptyp.ptype_kind = Ptype_abstract);
+        assert (ptyp.ptype_attributes = []);
+        let ty =
+          match ptyp.ptype_manifest with
+          | Some ty -> ty
+          | None -> assert false
+        in
+        (lid, ty)
+    | _ ->
+        err pmty.pmty_loc "only 'with type t =' constraints are supported"
+  in
+  match pmty with
+  | {pmty_desc = Pmty_ident lid} -> (lid, [])
+  | {pmty_desc = Pmty_with({pmty_desc = Pmty_ident lid}, cstrs)} ->
+      (lid, List.map map_cstr cstrs)
+  | _ ->
+      err pmty.pmty_loc
+        "only module type identifier and 'with type' constraints are supported"
+
+let mk_directive_arg ~loc k =
+  { pdira_desc = k;
+    pdira_loc = make_loc loc;
+  }
+
+let mk_directive ~loc name arg =
+  Ptop_dir {
+      pdir_name = name;
+      pdir_arg = arg;
+      pdir_loc = make_loc loc;
+    }
+
+
+# 793 "parsing/parser.ml"
+
+module Tables = struct
+  
+  include MenhirBasics
+  
+  let token2terminal : token -> int =
+    fun _tok ->
+      match _tok with
+      | AMPERAMPER ->
+          123
+      | AMPERSAND ->
+          122
+      | AND ->
+          121
+      | ANDOP _ ->
+          120
+      | AS ->
+          119
+      | ASSERT ->
+          118
+      | BACKQUOTE ->
+          117
+      | BANG ->
+          116
+      | BAR ->
+          115
+      | BARBAR ->
+          114
+      | BARRBRACKET ->
+          113
+      | BEGIN ->
+          112
+      | CHAR _ ->
+          111
+      | CLASS ->
+          110
+      | COLON ->
+          109
+      | COLONCOLON ->
+          108
+      | COLONEQUAL ->
+          107
+      | COLONGREATER ->
+          106
+      | COMMA ->
+          105
+      | COMMENT _ ->
+          104
+      | CONSTRAINT ->
+          103
+      | DO ->
+          102
+      | DOCSTRING _ ->
+          101
+      | DONE ->
+          100
+      | DOT ->
+          99
+      | DOTDOT ->
+          98
+      | DOTOP _ ->
+          97
+      | DOWNTO ->
+          96
+      | ELSE ->
+          95
+      | END ->
+          94
+      | EOF ->
+          93
+      | EOL ->
+          92
+      | EQUAL ->
+          91
+      | EXCEPTION ->
+          90
+      | EXTERNAL ->
+          89
+      | FALSE ->
+          88
+      | FLOAT _ ->
+          87
+      | FOR ->
+          86
+      | FUN ->
+          85
+      | FUNCTION ->
+          84
+      | FUNCTOR ->
+          83
+      | GREATER ->
+          82
+      | GREATERRBRACE ->
+          81
+      | GREATERRBRACKET ->
+          80
+      | HASH ->
+          79
+      | HASHOP _ ->
+          78
+      | IF ->
+          77
+      | IN ->
+          76
+      | INCLUDE ->
+          75
+      | INFIXOP0 _ ->
+          74
+      | INFIXOP1 _ ->
+          73
+      | INFIXOP2 _ ->
+          72
+      | INFIXOP3 _ ->
+          71
+      | INFIXOP4 _ ->
+          70
+      | INHERIT ->
+          69
+      | INITIALIZER ->
+          68
+      | INT _ ->
+          67
+      | LABEL _ ->
+          66
+      | LAZY ->
+          65
+      | LBRACE ->
+          64
+      | LBRACELESS ->
+          63
+      | LBRACKET ->
+          62
+      | LBRACKETAT ->
+          61
+      | LBRACKETATAT ->
+          60
+      | LBRACKETATATAT ->
+          59
+      | LBRACKETBAR ->
+          58
+      | LBRACKETGREATER ->
+          57
+      | LBRACKETLESS ->
+          56
+      | LBRACKETPERCENT ->
+          55
+      | LBRACKETPERCENTPERCENT ->
+          54
+      | LESS ->
+          53
+      | LESSMINUS ->
+          52
+      | LET ->
+          51
+      | LETOP _ ->
+          50
+      | LIDENT _ ->
+          49
+      | LPAREN ->
+          48
+      | MATCH ->
+          47
+      | METHOD ->
+          46
+      | MINUS ->
+          45
+      | MINUSDOT ->
+          44
+      | MINUSGREATER ->
+          43
+      | MODULE ->
+          42
+      | MUTABLE ->
+          41
+      | NEW ->
+          40
+      | NONREC ->
+          39
+      | OBJECT ->
+          38
+      | OF ->
+          37
+      | OPEN ->
+          36
+      | OPTLABEL _ ->
+          35
+      | OR ->
+          34
+      | PERCENT ->
+          33
+      | PLUS ->
+          32
+      | PLUSDOT ->
+          31
+      | PLUSEQ ->
+          30
+      | PREFIXOP _ ->
+          29
+      | PRIVATE ->
+          28
+      | QUESTION ->
+          27
+      | QUOTE ->
+          26
+      | QUOTED_STRING_EXPR _ ->
+          25
+      | QUOTED_STRING_ITEM _ ->
+          24
+      | RBRACE ->
+          23
+      | RBRACKET ->
+          22
+      | REC ->
+          21
+      | RPAREN ->
+          20
+      | SEMI ->
+          19
+      | SEMISEMI ->
+          18
+      | SIG ->
+          17
+      | STAR ->
+          16
+      | STRING _ ->
+          15
+      | STRUCT ->
+          14
+      | THEN ->
+          13
+      | TILDE ->
+          12
+      | TO ->
+          11
+      | TRUE ->
+          10
+      | TRY ->
+          9
+      | TYPE ->
+          8
+      | UIDENT _ ->
+          7
+      | UNDERSCORE ->
+          6
+      | VAL ->
+          5
+      | VIRTUAL ->
+          4
+      | WHEN ->
+          3
+      | WHILE ->
+          2
+      | WITH ->
+          1
+  
+  and error_terminal =
+    0
+  
+  and token2value : token -> Obj.t =
+    fun _tok ->
+      match _tok with
+      | AMPERAMPER ->
+          Obj.repr ()
+      | AMPERSAND ->
+          Obj.repr ()
+      | AND ->
+          Obj.repr ()
+      | ANDOP _v ->
+          Obj.repr _v
+      | AS ->
+          Obj.repr ()
+      | ASSERT ->
+          Obj.repr ()
+      | BACKQUOTE ->
+          Obj.repr ()
+      | BANG ->
+          Obj.repr ()
+      | BAR ->
+          Obj.repr ()
+      | BARBAR ->
+          Obj.repr ()
+      | BARRBRACKET ->
+          Obj.repr ()
+      | BEGIN ->
+          Obj.repr ()
+      | CHAR _v ->
+          Obj.repr _v
+      | CLASS ->
+          Obj.repr ()
+      | COLON ->
+          Obj.repr ()
+      | COLONCOLON ->
+          Obj.repr ()
+      | COLONEQUAL ->
+          Obj.repr ()
+      | COLONGREATER ->
+          Obj.repr ()
+      | COMMA ->
+          Obj.repr ()
+      | COMMENT _v ->
+          Obj.repr _v
+      | CONSTRAINT ->
+          Obj.repr ()
+      | DO ->
+          Obj.repr ()
+      | DOCSTRING _v ->
+          Obj.repr _v
+      | DONE ->
+          Obj.repr ()
+      | DOT ->
+          Obj.repr ()
+      | DOTDOT ->
+          Obj.repr ()
+      | DOTOP _v ->
+          Obj.repr _v
+      | DOWNTO ->
+          Obj.repr ()
+      | ELSE ->
+          Obj.repr ()
+      | END ->
+          Obj.repr ()
+      | EOF ->
+          Obj.repr ()
+      | EOL ->
+          Obj.repr ()
+      | EQUAL ->
+          Obj.repr ()
+      | EXCEPTION ->
+          Obj.repr ()
+      | EXTERNAL ->
+          Obj.repr ()
+      | FALSE ->
+          Obj.repr ()
+      | FLOAT _v ->
+          Obj.repr _v
+      | FOR ->
+          Obj.repr ()
+      | FUN ->
+          Obj.repr ()
+      | FUNCTION ->
+          Obj.repr ()
+      | FUNCTOR ->
+          Obj.repr ()
+      | GREATER ->
+          Obj.repr ()
+      | GREATERRBRACE ->
+          Obj.repr ()
+      | GREATERRBRACKET ->
+          Obj.repr ()
+      | HASH ->
+          Obj.repr ()
+      | HASHOP _v ->
+          Obj.repr _v
+      | IF ->
+          Obj.repr ()
+      | IN ->
+          Obj.repr ()
+      | INCLUDE ->
+          Obj.repr ()
+      | INFIXOP0 _v ->
+          Obj.repr _v
+      | INFIXOP1 _v ->
+          Obj.repr _v
+      | INFIXOP2 _v ->
+          Obj.repr _v
+      | INFIXOP3 _v ->
+          Obj.repr _v
+      | INFIXOP4 _v ->
+          Obj.repr _v
+      | INHERIT ->
+          Obj.repr ()
+      | INITIALIZER ->
+          Obj.repr ()
+      | INT _v ->
+          Obj.repr _v
+      | LABEL _v ->
+          Obj.repr _v
+      | LAZY ->
+          Obj.repr ()
+      | LBRACE ->
+          Obj.repr ()
+      | LBRACELESS ->
+          Obj.repr ()
+      | LBRACKET ->
+          Obj.repr ()
+      | LBRACKETAT ->
+          Obj.repr ()
+      | LBRACKETATAT ->
+          Obj.repr ()
+      | LBRACKETATATAT ->
+          Obj.repr ()
+      | LBRACKETBAR ->
+          Obj.repr ()
+      | LBRACKETGREATER ->
+          Obj.repr ()
+      | LBRACKETLESS ->
+          Obj.repr ()
+      | LBRACKETPERCENT ->
+          Obj.repr ()
+      | LBRACKETPERCENTPERCENT ->
+          Obj.repr ()
+      | LESS ->
+          Obj.repr ()
+      | LESSMINUS ->
+          Obj.repr ()
+      | LET ->
+          Obj.repr ()
+      | LETOP _v ->
+          Obj.repr _v
+      | LIDENT _v ->
+          Obj.repr _v
+      | LPAREN ->
+          Obj.repr ()
+      | MATCH ->
+          Obj.repr ()
+      | METHOD ->
+          Obj.repr ()
+      | MINUS ->
+          Obj.repr ()
+      | MINUSDOT ->
+          Obj.repr ()
+      | MINUSGREATER ->
+          Obj.repr ()
+      | MODULE ->
+          Obj.repr ()
+      | MUTABLE ->
+          Obj.repr ()
+      | NEW ->
+          Obj.repr ()
+      | NONREC ->
+          Obj.repr ()
+      | OBJECT ->
+          Obj.repr ()
+      | OF ->
+          Obj.repr ()
+      | OPEN ->
+          Obj.repr ()
+      | OPTLABEL _v ->
+          Obj.repr _v
+      | OR ->
+          Obj.repr ()
+      | PERCENT ->
+          Obj.repr ()
+      | PLUS ->
+          Obj.repr ()
+      | PLUSDOT ->
+          Obj.repr ()
+      | PLUSEQ ->
+          Obj.repr ()
+      | PREFIXOP _v ->
+          Obj.repr _v
+      | PRIVATE ->
+          Obj.repr ()
+      | QUESTION ->
+          Obj.repr ()
+      | QUOTE ->
+          Obj.repr ()
+      | QUOTED_STRING_EXPR _v ->
+          Obj.repr _v
+      | QUOTED_STRING_ITEM _v ->
+          Obj.repr _v
+      | RBRACE ->
+          Obj.repr ()
+      | RBRACKET ->
+          Obj.repr ()
+      | REC ->
+          Obj.repr ()
+      | RPAREN ->
+          Obj.repr ()
+      | SEMI ->
+          Obj.repr ()
+      | SEMISEMI ->
+          Obj.repr ()
+      | SIG ->
+          Obj.repr ()
+      | STAR ->
+          Obj.repr ()
+      | STRING _v ->
+          Obj.repr _v
+      | STRUCT ->
+          Obj.repr ()
+      | THEN ->
+          Obj.repr ()
+      | TILDE ->
+          Obj.repr ()
+      | TO ->
+          Obj.repr ()
+      | TRUE ->
+          Obj.repr ()
+      | TRY ->
+          Obj.repr ()
+      | TYPE ->
+          Obj.repr ()
+      | UIDENT _v ->
+          Obj.repr _v
+      | UNDERSCORE ->
+          Obj.repr ()
+      | VAL ->
+          Obj.repr ()
+      | VIRTUAL ->
+          Obj.repr ()
+      | WHEN ->
+          Obj.repr ()
+      | WHILE ->
+          Obj.repr ()
+      | WITH ->
+          Obj.repr ()
+  
+  and default_reduction =
+    (16, "\000\000\000\000\000\000\002\247\002\246\002\245\002\244\002\243\002\198\002\242\002\241\002\240\002\239\002\238\002\237\002\236\002\235\002\234\002\233\002\232\002\231\002\230\002\229\002\228\002\227\002\226\002\225\002\224\002\197\002\223\002\222\002\221\002\220\002\219\002\218\002\217\002\216\002\215\002\214\002\213\002\212\002\211\002\210\002\209\002\208\002\207\002\206\002\205\002\204\002\203\002\202\002\201\002\200\002\199\000\000\000\000\000*\000\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0035\001\168\001\147\001\165\001\164\001\163\001\169\001\173\000\000\0036\001\167\001\166\001\148\001\171\001\162\001\161\001\160\001\159\001\158\001\156\001\172\001\170\000\000\000\000\000\000\000\220\000\000\000\000\001\151\000\000\000\000\000\000\001\153\000\000\000\000\000\000\001\155\001\177\001\174\001\157\001\149\001\175\001\176\000\000\0034\0033\0037\000\000\000\000\000\024\001B\000\188\000\000\000\216\000\217\000\023\000\000\000\000\001\199\001\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003/\000\000\0030\000\000\000\000\003-\000\000\003,\003(\0022\000\000\003+\000\000\0023\000\000\000\000\000\000\000\000\000j\000\000\000\000\000h\000\000\000\000\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\184\001N\000\000\000\000\000\000\000\000\000\000\000\000\002\029\000\000\000\000\000\000\000\000\000\000\000\000\000e\000\000\000\000\000\000\000\000\001L\000\000\000\000\001O\001M\001U\000A\002\134\000\000\001\018\000\000\000\000\000\000\000\015\000\014\000\000\000\000\000\000\000\000\002\179\000\000\002e\002f\000\000\002c\002d\000\000\000\000\000\000\000\000\000\000\001e\001d\000\000\002\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\223\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\016\003\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000g\000\000\000\231\000\000\002h\002g\000\000\000\000\000\000\001\181\000\000\000\000\000%\000\000\000\000\000\000\000\000\000\000\001T\000\000\001S\000\000\001C\001R\000\000\001A\000b\000\030\000\000\000\000\001|\000\025\000\000\000\000\000\000\000\000\003'\000(\000\000\000\000\000\031\000\026\000\000\000\000\000\000\000\201\000\000\000\000\000\000\000\203\002<\002.\000\000\000\"\000\000\002/\000\000\000\000\001\178\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\017\003\017\000\000\003\018\000\000\000y\000\000\000\000\000!\000\000\000\000\000\000\000#\000\000\000$\000\000\000&\000\000\000\000\000'\002$\002#\000\000\000\000\000\000\000\000\000\000\000\000\000c\000\000\002\184\000f\000i\000d\002\173\0038\002\174\001\239\002\176\000\000\000\000\002\181\002b\002\183\000\000\000\000\000\000\002\190\002\187\000\000\000\000\000\000\001\236\001\222\000\000\000\000\000\000\000\000\001\226\000\000\001\221\000\000\001\238\002\196\000\000\001\237\000q\001\229\000\000\000o\000\000\002\189\002\188\000\000\001\232\000\000\000\000\001\228\000\000\000\000\001\224\001\223\000\000\002\186\000\000\002j\002i\000\000\000\000\002F\002\185\002\182\000\000\000\000\000\000\000\000\001\183\001-\001.\002l\000\000\002m\002k\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\241\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\204\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001o\000\000\000\000\000\000\000\000\000\000\000\000\003M\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\002,\000\000\000\000\002-\000\000\000\000\001n\000\000\000\000\000\000\001K\001t\001J\001r\002 \002\031\000\000\001m\001l\000\000\000\205\000\000\000\000\001^\000\000\000\000\001b\000\000\001\203\001\202\000\000\000\000\001\201\001\200\001a\001_\000\000\001c\000\000\000\000\000\000\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\138\001P\002\143\002\141\000\000\000\000\000\000\002\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\172\000\000\002\171\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\250\000\000\000\000\000\000\000\000\000\000\000\000\000\239\001\249\000\240\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\234\000\000\000\235\000\000\000\000\000\000\002\151\000\000\000\000\000\000\002r\002q\000\000\000\000\000\000\000\000\0039\002\153\002\140\002\139\000\000\000\000\000\169\000\000\000\000\000\000\000\000\000\000\000\183\000\000\000\000\000\000\000\168\000\000\000\000\000\000\002M\002L\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\243\000\000\002\250\000\000\003$\000\000\000\000\003#\000\000\000\000\000\000\000\000\000\000\000\195\000\194\000\244\000\000\002\251\002\252\000\000\000\000\000p\000\000\002\191\002\175\000\000\002\194\000\000\002\193\002\192\000\000\000\000\000\000\000\000\000\000\000\000\000\248\000\000\000\000\002&\000\000\000\000\000\000\000\247\000\000\000\000\000\246\000\245\000\000\000\000\000\000\000\000\000\250\000\000\000\000\000\249\000\000\001\235\000\000\000\000\001\246\000\000\000\000\001\248\000\000\000\000\001\244\001\243\001\241\001\242\000\000\000\000\000\000\000\000\000\000\001\024\000\018\000\252\000\000\000\000\000\000\002t\002s\000\000\000\000\002\130\002\129\000\000\000\000\000\000\000\000\002~\002}\000\000\000\000\002@\000\000\000\000\002|\002{\000\000\000\000\002\128\002\127\002\147\000\000\000\000\000\000\000\000\000\000\002x\000\000\000\000\000\000\000\000\000\000\002v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\"\002!\000\167\000\000\002w\000\000\000\000\002u\000\000\000\000\002y\000\000\000z\000{\000\000\000\000\000\000\000\000\000\138\000\196\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\000\000\000\198\000\199\000\131\000\000\000\130\000\000\000\000\0010\000\000\0011\001/\002(\000\000\000\000\002)\002'\000\000\000\000\000\000\000\000\000\000\001\003\000\000\000\000\001\004\000\000\000\000\000\170\000\000\001\006\001\005\000\000\000\000\002\155\002\148\000\000\002\164\000\000\002\165\002\163\000\000\002\169\000\000\002\170\002\168\000\000\000\000\002\150\002\149\000\000\000\000\000\000\002\016\000\000\001\197\000\000\000\000\000\000\002I\002\015\000\000\002\159\002\158\000\000\000\000\000\000\001Q\000\000\002\132\000\000\002\133\002\131\000\000\002\157\002\156\000\000\000\000\000\000\002C\002\146\000\000\002\145\002\144\000\000\002\167\002\166\000\128\000\000\000\000\000\000\000\000\000\127\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000}\000\000\001X\000\000\000\000\000\000\000k\000\000\000\000\000l\000\000\000\000\000\000\000\000\001v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\225\000\000\000\000\000u\000\000\000\228\000\226\000\000\000\000\000\000\000\207\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000~\000m\000\000\000\000\002\014\000\000\000\000\000\251\001\195\000\000\000\237\000\238\001\002\000\000\000\000\000\000\000\000\000\000\001\210\001\204\000\000\001\209\000\000\001\207\000\000\001\208\000\000\001\205\000\000\000\000\001\206\000\000\001\144\000\000\000\000\000\000\001\143\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\014\003\t\000\000\000\000\003\b\000\000\000\000\000\000\000\000\000\000\001\255\000\000\000\000\000\000\000\000\000\000\000\000\003\014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\128\000\000\002\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\249\000\000\000\000\002N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\146\000\000\000\000\000\000\001\145\000\000\000\000\000\000\000\000\000\000\001g\000\000\001f\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\002\\\000\000\000\000\000\000\002Z\000\000\000\000\000\000\002Y\000\000\001Z\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\003A\000\000\000\000\000\000\000\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000E\000\000\000\000\000\000\000\000\001{\000\000\001z\000\000\000\000\000\000\000\000\000H\000\000\000\000\000\000\002\012\000\000\002\011\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000N\000\000\000\000\000\000\000O\000M\000\000\000R\000\000\000\000\000\000\000\000\000\000\000G\000\000\000\000\000\000\000\000\000\000\000\000\000J\000\000\000Q\000P\000\000\000K\000L\000\000\001!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\012\000a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000^\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\n\002`\002R\000\000\002X\002S\002^\002]\002[\001\027\000\000\002P\000\000\000\000\000\000\000\000\000\000\002\029\000\000\000\000\001\020\002T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\139\001\135\000\000\000\000\000\000\000\210\000\000\000\000\002\019\002\029\000\000\000\000\001\022\002\017\002\018\000\000\000\000\000\000\000\000\000\000\001\142\001\138\001\134\000\000\000\000\000\211\000\000\000\000\001\141\001\137\001\133\001\131\002U\002Q\002a\001\026\001\252\002O\000\000\000\000\000\000\000\000\000\000\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\000\000\003>\000\000\0006\000\000\000\000\003D\000\000\003C\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003;\000\000\000\000\003=\000\000\000\000\000\000\002\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001?\000\000\000\000\001=\001;\000\000\0007\000\000\000\000\003G\000\000\003F\000\000\000\000\000\000\0019\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\000\000\000\000\001<\001:\000\000\000\000\000\000\0009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\254\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\0003\000\000\000\000\000W\000\000\0001\000\255\000\000\000@\000-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\253\000\000\000V\000U\000\000\000\000\000[\000Z\000\000\000\000\001\185\000\000\0005\000\000\000\000\000\000\0004\000\000\000\000\000\000\0008\000\000\000Y\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\b\003\012\003\003\000\000\000\000\003\007\002\248\003\002\003\011\003\n\001\031\000\000\000\000\003\000\000\000\003\004\003\001\003\r\001\251\000\000\000\000\002\254\000\000\000\191\002\253\000\000\000\000\000\222\000\000\000\000\001\030\001\029\000\000\001\\\001[\000\000\000\000\002\195\002\178\000\000\000B\000\000\000\000\000C\000\000\000\000\000\142\000\141\002\162\000\000\002\161\002\160\002\142\000\000\000\000\000\000\000\000\002\135\000\000\002\137\000\000\002\136\000\000\002o\002n\000\000\002p\000\000\000\000\000\134\000\000\000\000\002\004\000\215\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\189\000\000\003\006\002\024\002\025\002\020\002\022\002\021\002\023\000\000\000\000\000\000\000\190\000\000\000\000\002\029\000\000\000\214\000\000\000\000\000\000\000\000\003\005\000\000\000\187\000\000\000\000\000\000\000\000\0018\0012\000\000\000\000\0013\000\029\000\000\000\028\000\000\000\000\000\202\000\000\000\000\000\000\000 \000\027\000\000\000\000\000\000\000\021\000\000\000\000\000\000\000\000\001\140\001\136\000\000\001\132\003&\000\000\002\029\000\000\000\213\000\000\000\000\000\000\000\000\002W\002\028\002\026\002\027\000\000\000\000\000\000\002\029\000\000\000\212\000\000\000\000\000\000\000\000\002V\000\000\001i\001h\000\000\000\022\000\000\003?\000\000\000+\000\000\000\000\000\000\000\000\000\137\000\000\000\218\000\001\000\000\000\000\000\221\000\002\000\000\000\000\000\000\001E\001F\000\003\000\000\000\000\000\000\000\000\001H\001I\001G\000\019\001D\000\020\000\000\001\211\000\000\000\004\000\000\001\212\000\000\000\005\000\000\001\213\000\000\000\000\001\214\000\006\000\000\000\007\000\000\001\215\000\000\000\b\000\000\001\216\000\000\000\t\000\000\001\217\000\000\000\000\001\218\000\n\000\000\000\000\001\219\000\011\000\000\000\000\000\000\000\000\000\000\003\025\003\020\003\021\003\024\003\022\000\000\003\029\000\012\000\000\003\028\000\000\001%\000\000\000\000\003\026\000\000\003\027\000\000\000\000\000\000\000\000\001)\001*\000\000\000\000\001(\001'\000\r\000\000\000\000\000\000\0032\000\000\0031")
+  
+  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\021\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\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\000\000\000\000\000\000\000\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@@@ \193\004\000\000\016\000\000\000\000\000\016\004\004\000\002\012\016@\000\001\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007a\002 \004\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\000\000\000\000\000\000\0000\000\002\b\016L\000@\000\000\000\000\000\000\000\003\000\000 \129\004\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\003\000\000 \128\004\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\000\000 \128\004\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\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\004\000\000\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\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\132\128\"\128\012 \146\028\000\017\000f\017\006\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003 \000p\016\000\197\194\128\001\000\128 \000\016\0000\000\135\001\002\012\\ \000\016\000\000\000\128\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`\022a\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\003\000\000`\000\000\197\194\000\001 \000 \000\000\000\016\001\000\000\000\004\000\000\000\018\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\133\000\145\160\000\018B\028\012\001 \018\017 \001\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\000\000\000\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\002\012\016L\000@\000\000\000\000\000\000\000\003\000\000 \129\004\192\004\000\000\000\000\000\000\000\0000\000\002\b\016L\000\000\000\000\000\000\000\000\000\003\000\000 \128\004\192\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\000G\223d@\130\2545\000\004\193\193\2388\176(4'\225\"\213\138\173\2433\208\020\015\224\000\007\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\016\004@\b\012\0189\000\000\024\000\000\024\192\001\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\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\016\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\254\183\127\217\190\255\127\255\193\211\254b\0169\228\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n6\024\132~*\223R=>b\249\004\001\154\235\129!\bD\000\128\193#\144\000\001\128\000\001\140\0026\016\004X(\223\018=\000@\248\000\000\028\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@\002\130\020\012\000\000\002\001\000\000\b@\000\b\000\000(!@\192\000\000 \016\000\000\132\000\000\128\000\002\130\016\012\000\000\002\001\000\000\0002\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\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\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\b2\024\132~\002\206R->2\027\004\001\146\203\128\000\b\000\000\000\000\000\016\000\001\000\000\000\000\b0\000\000\004\000\000\000@\000\000\000\000\000\000\000\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\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\001\000@@\000 \193\000\000\000\016\000\000\000\000\000\b\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\016 \004\000\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\n~\018\012X\170\2233}\001@\254 \0008\224\167\225 \197\138\173\2433\208\020\015\226\000\003\142\n~\018,X\170\2233=\001@\254`\0008\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016 \004\004\000\b\016@\000\001\000\000\000\000\128\001\002\000@@\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\000\129\000\000\000\016\000\000\000\000\000P \004\000\000\b\016\000\000\001\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\000\000\000\000\000\000\000\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\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\b\000L\018-\000\016\024\000\000\016@\003!\000@\128\004\193\"\208\001\001\160\000\001D\0002\016$\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\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\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\128\000\017\000\000\000\000\000\000\000\000\016\000\004\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\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'\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\000p\016\000\197\194\000\001\000\000\000\000\020\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\016\000\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\000\000\000\128\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\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\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\003\000\000p\016\000\197\194\000\001\000\000\000\000\004\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\196\128;\128\b2\018\028\012\017 v\001b\017`0\000\007\001\000\012\\ \000\016\000\000\000\000\000\196\128\187\128\b2\018\028\012\017 v\001b\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\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`\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\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\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\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`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\016\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\004\000\000\004\000\000 \000\000\000\016\0000\000\007\001\000\012\\ \000\016\000\000\000\000\002\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\016 0\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\002\000\000\000\001\018\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\002\000\000\000\000\004\000\000 \000\000\000\017 \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\016\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 \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\001\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\004\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\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\002\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\002\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\128\000\017\000\000\000\000\004\000\000\000\016\000\000\000\b\000\001\016\000\000\000\000\000\000\000\001\000\000\000\000\003!\000@\128\004\193\"\208\001\001\160\000\001\004\0002\016\004\012\000L\018i\000\016\024\000\000\016@\003!\000@\128\004\193&\144\001\001\128\000\001\004\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\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\018k\000\016\025B\006\213P\000\001\000\000\128\004\000\000\016\000\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\000\000\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&\240\001\001\180\016mU\000\016\000\000\000\000\b\002(\000\000\000\000\000\000\000\131!\b@\128\004\193\"\208\001\001\160\000\t\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\000\000\000\000\000\000\000\000\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\0002\016\004\b\000L\018-\000\016\026\000\000\016@\144\000\027\000\000\016\000\004\000\000\000\020\000LQ\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\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\000\000\000\000\000\000\000\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\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\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\128\000\b\000\000\000\000\004\000\000\000\000\000H\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@\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\b\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\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\004\000\000\000\000\000H\017\b\000\001\016\000\000\000\000\000\000\000\000\000\000\000\000\131\000\001\000\000\000@\000\000\000\000\000\000\000\000\b\000\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\0002\144\005\t\000L\018k\000\016\025\000\004\209P\000\000\000\000\000\000\192\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\b\000\000\000\000\000\000\000\000\016\000\004\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\016\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\192\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\b\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\003!\004@\200$\193&\208\001\001\160\000\001\004\000\016 \004\004\000\b\016@\000\001\000\000\000\000\128\001\002\000@@\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\000\129\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\0000\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\001\000@@\000 \193\000\000\000\016\000\000\000\000\000\016\004\004\000\002\012\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\000\000\000\000\000\016\128\000\000\000\000\000\000\000\000\000\016\004\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\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\0000\000\002\b\000L\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\003\000\000x\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\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \020\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 \020\196\128*\128\b0\018\028\000\017\000v\001\"\000@0\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\196\128*\128\b0\018\028\000\017\000v\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\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\001\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\196\128*\128\b0\146\028\000\017\000v\016\"\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\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\004\000\000\000\000\000\000\000\000\000\196\128*\128\b0\146\028\000\017\000v\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\012\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\002\b@\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\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@\b\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!\000D@\128\193'\144\000\001\128\000\001\140\000\018\016\004@\b\012\018y\000\000\024\000\000\024\192\001!\000D\000\128\193#\144\000\001\128\000\001\140\000\018\016\004@\b\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\248\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@@\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\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\000@@\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\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\144\005\t\001L\018+\000\016\024\000\000P@#a\000E\130\141\241#\208\004\015\128\000\001\142\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!\000D@\128\193'\144\000\001\128\000\001\140\000\018\016\004@\b\012\018y\000\000\024\000\000\024\192\001!\000D\000\128\193#\144\000\001\128\000\001\140\012IK\184>\131\225a\192\255\182\007}\183\231\015\001!\000D\000\128\193#\144\000\001\128\000\001\140\012[\219\189\127\139\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#a\000E\130\141\241#\208\004\015\128\000\001\142\012[\219\189\127\139\237s\251\255\182\031}\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\001!\000D\000\128\193#\144\000\001\128\000\001\140\012[\219\189\127\139\237s\251\255\182\031}\183\255\223\000\000\000\000\000\000@\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\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\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012[\219\189\127\139\237s\251\255\182\031}\183\255\207\196\148\187\131\232>\022\028\015\251`w\219~p\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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#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\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\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\248\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\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\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\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\0002\144\005\t\000L\018k\000\016\025\000\006\209P\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\0002\144\005\t\000L\018+\000\016\025\000\002P@\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#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\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\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\0002\144\005\t\000L\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\128\000\b\000\000\000\000\000\016\000\001\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\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\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\b8\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\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\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\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\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\132\128\"\128\b \018\024\000\025\000f\000\002\000HH\002(\000\130!!\128\193\144\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\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#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\b\016>\000\192@@>\002\001\000\005\130\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\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\000\000\000\000\000\000\000\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\004\004\003\224 \016\000X`:6\016\180X(\223\018=\000@\248\000\000\028\224\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\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\000\000\000\000\001!\000D\000\128\193#\144\000\001\128\000\001\140\012[\219\189\127\139\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\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\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\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\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\128\000\145\003\224\012\004\004\003\224 \016\000X 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\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\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\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\129\003\224\012\004\004\003\224 \016\000X <[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\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\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\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\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\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\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\252[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\197\189\187\215\248\190\215?\191\251a\247\219\127\253\252[\219\189\127\139\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\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\0026\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#a\000E\130\141\241#\208\004\015\128\000\001\142\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\001\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#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#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\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\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\0002\144\005\t\001L\018+\000\016\024\000\000P@\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\000\016\000\000\000\001\004\000\000\000\016\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)\000P\144\020\193\"\176\001\001\128\000\005\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\003)\000P\144\020\193\"\176\001\001\128\000\005\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\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\000\000\000\0026\016\004X(\223\018=\000@\248\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\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\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\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\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\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\000\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\000\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\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\000\b\000\001\016\000\000\000\000\000\000\000\000\000\000\000\000\129\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\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\003\000\000P\000\000\000\016\000\000\000\000\012\0028\000\000\000\000\000\000\000\192\000\017\000\000\000\000\000\000\003\000\016P$\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\251`w\219~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\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\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\128\000\145\003\224\012\004\004\003\224`\016\000X 8\000\001\000\000\000\000\000\000\000\004\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\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\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\001\002\000@\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\b\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\000\000\000\0000\000\000\004\000\000\000@\000\000\000\000\000\000\000\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\128\000\000\000\000\016\000\004\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@\016\004\004\000\002\012\016\000\000\001\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\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\196\148\187\131\232>\022\028\015\249`w\139~p\244\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\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\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\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\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\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\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\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\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\000\000\000\000\000@\000\000\001\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\018(\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!\128\001\016\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 \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\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\000\000\000\000\000\000\b\000\000\000\000\001\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\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\000\000\000\000\000\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 \193\000\000\000\016\000\000\000\000\012H\002(\000\131\000!\192\001\000\006`\000 \004\132\128\"\128\b \002\016\000\016\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\000\000\000\000\000\000\000\000@\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002(\000\131\000!\192\001\000\006`\000 \004\132\128\"\128\b \002\016\000\016\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\b\000\000\000\000\001\000\000@\000\001\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\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\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\004\004\002\012\016@\000\001\000\000\000\000\000\001\000@@\000 \193\004\000\000\016\000\000\000\000\000\016\004\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\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\bH\002(\000\194\000!\192\001\000\006`\000`\000\b\128\000\000@\000@\006\000\000\000\000\000\000\000\000\128\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\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\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\004\000 \005\016 \000\000\000\000\000\000\000\132\000\000\128\000\002\130\020\004\000\000\002\001\000\000\b@\000\b\000\000(!\000@\000\000 \016\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\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\b\000\000\000\000@@\004\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@\000\000 \016\000\000\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\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\016\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\018\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\b\000\000 !\192\192\000\001 \016\000\000\001\000\000@\002\000Q\006\000\000\000\000\000\000\000\000\016\000\004\000 \005\016 \000\000\000\000\000\000\000\000\000\000\000\b\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 \005\016 \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\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\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000@\000\000\000\000\004\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\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!!\192A\016\007`\016 \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\000\000\000\000\000\000\000\000\000\000\000\b\000\000\016\000\000\000\016\000\004\000 \005\016 \000\000\000\000\000\000\000\132\128*\128\b\"\018\028\004\017\000v\001\002\000H@\000\b\000\000 !\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\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\b@\000\b\000\000 !\192\192\000\000 \016\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\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\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\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\028\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\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\004\000 \005\016 \000\000\000\000\000\000\000\132\128\"\128\b \018\028\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\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\133\128\170\128\b0B\028\000\017\000v\000\006\000@0\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\003\000\000p\016\000\197\194\000\001\000\000\000\000\020\000\000\000 \000\000\000\000@\000\000\000\000\004\001\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\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\bX\n\168\000\131\004!\192\001\016\007`\000 \004\133\128\170\128\b0B\028\000\017\000v\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\128\b \002\028\000\016\000v\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!\128\001\000\006`\000 \004\132\128\"\128\b \002\016\000\016\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\000\000\000@\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\bH\002(\000\130\000!\128\001\000\006`\000 \004\132\128\"\128\b \002\016\000\016\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 \002\016\000\016\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000\000\000\000\000\000\000 \000\002\b\000L\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\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\000\000\000\000\000\000\000 \000\002\b\000L\000\000\000\000\000\000\000\000\000\000\000\000\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\138-3\251\193\016\030`\016x\212\133\169*\212\024\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\016\000\025\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\bH\002(\000\130\001!\128\001\000\006`\000 \000\132\128\"\128\b \018\016\000\016\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\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\128*\128\b0\146\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\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\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\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\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\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\129\002\000@@\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\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\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\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\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\004\004\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\bH\002(\000\130\001!\192\001\016\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\000\003 \000x\016\000\197\194\128\001\000\128 \000\016\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\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\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\bH\002( \130\000!\128\001\000\007`\017 \004\003 \000x\016\000\197\194\128\001\000\128 \000\016\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\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\000!\128\001\000\006`\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\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 \018\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\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#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#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\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\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\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\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")
+  
+  and start =
+    13
+  
+  and action =
+    ((16, "C\170P\226Ff\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021HFf\000\000\000\000\020XFfC\170\020\182\000-\000[\\(\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\238\006\168\000\218\000\000\003\188\t|\000\000\001\208\003\232\nt\000\000\000\244\004\198\011l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\220\000\000\000\000\000\000\0046T\016\000\000\000\000\000\000\005.\000\000\000\000\000\000\005\022\005\b\000\000\000\000T\016H\254\020X\021\178^\128\020X\\\142Mj\020XB\146\000\000B\146\000\000\027\158\004\246\000\000\005.\000\000\000\000\000\000\002J\000\000\027\158\000\000\006&v\246]\160d\194\000\000\132l\134\028\000\000LP_\014\000\000X\\\026\206K\200\005.p\026FfC\170\000\000\000\000Mj\020XF\138B\146\007\012v\246\000\000\128\178FfC\170P\226\020X\000\000\000\000\016x\025\186\001N\b\198\000\000\002\138\b\252\000\000\000\000\000\000\000\000\000\000\020X\000\000A\206i\164C\170\000\000\000\000P\206\020XZ\024W\200\000\000\004\002\000\000\000\000\005\242\000\000\000\000H\166\004\002\024\138\003\130\0020\000\000\000\000\003\172\000\000\021\178\006f\006\154\020X\028\254\020XC\170C\170\000\000P\212P\148\020X\028\254E\166\020X\000\000\000\000\000\000P\226\020X\000\000\000\248\000\000W\200y\188zJ\000\000\b\198\000\000\n\"\000\000\000\000C,T\016\134h\000\000h\142\134h\000\000h\142h\142\000b\006:\0008\000\000\020\190\000\000\006\220\000\000\000\000\t\014\000\000\000\000\000\000h\142\005.\000\000\000\000V\222T\016T\132_\014\000\000\000\000N*\000b\000\000\000\000_\014\007\026T\016\000\000O _\014P\022\000\000\000\000\000\000\n\198\000\000h\142\000\000\001\000\1310\000\000T\016\005\216T\016\000\000\022\\\b&\005.\000\000\000\000\023\224\000\000\006\208\000\000Y\128\011\190\000\000\007\128h\142\011\230\000\000\012\182\000\000\007\200\000\000\000\000\004\184\000\000\000\000\000\000\021  4W\200P\206\020XW\200\000\000\000b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000M:\027v\000\000\000\000\000\000\001\244&\174t<\000\000\000\000P\206\020XW\200\000\000\000\000{hW\200\136.zJ\000\000\136v\000\000W\200\000\000\000\000X\180\000\000\000\000\000\000\b\162\000\000\022\168\000\000\000\000z\214\000\000\136\208{\030\000\000\137\018\t\002\000\000\000\000z\214\000\000\004\024\000\000\000\000DHt\200\000\000\000\000\000\000Bn\023|\019\252\023\176\000\000\000\000\000\000\000\000\004\250\000\000\000\000Z\204\b\164\t`\000\017T\016\002\204\n\204\000\000\000\000\t\246\t`\007X\000\000i\186P\234P\148\020X\028\254\000-\000\018\0020\000\000\n>\021\178\021\178\000-\000\018\000\018\021\178\000\000jL\0050B\146\b\198\000\236\137`\000\000T\016ebT\016_ f\002T\016\000\144T\016f\156\000\000\000\000\020d\0008_\192\b\130\0008`\024\000\000j\230\0050\000\000\021\178k\128\000\000\007\196\t\190`\184\000\000\000\000\000\000\000\000\000\000\000\000\001B\000\000\000\000\003\144\000\000\007|\028\254\000\000\\\192E\166\000\000\031\138\000\000\000\000\021\178\002\152\000\000\000\000\000\000\000\000[\132\000\000\001\200\000\000UP\001\130\005\"\000\000\0226V\170P\226\020XG,P\226\020X\016x\016x\000\000\000\000\000\000\000\000\001\240\024&B\188\000\000Q\150RJP\212\020X\028\254\007h\021\178\000\000\004*\000\000R\254S\178{\182I\190T\016\002\128\000\000P\226\020X\000\000u\016\020Xy\188W\200E\186\000\000P\226\020Xw\\\004~\000\000W\200A\012T\016\003x\007X\012<\000\000\000\000\000\000H\166\003\138\003\138\000\000\012Bp\156\000\000P\206\020XW\200\025R\000\000P\226\020X\016x\0226\016x\002\232\023\240\000\000\000\000\016x\012\014\000\000\r\000\000\000\016x\003\224\rX\000\000'\166\000\000\b\196\000\000\000\000\026\022\000\000\017p\023.\000\000\000\000\000\000\000\000\005\226\000\000\000\000\027\014\000\000\028\006\000\000\028\254\000\000\018h\024&\000\000\000\000\000\000Ff\000\000\000\000\000\000\000\000\029\246\000\000\030\238\000\000\031\230\000\000 \222\000\000!\214\000\000\"\206\000\000#\198\000\000$\190\000\000%\182\000\000&\174\000\000'\166\000\000(\158\000\000)\150\000\000*\142\000\000+\134\000\000,~\000\000-v\000\000.n\000\000/f\000\0000^\020XW\200ZJI\146\003\138\014 l\012W\200\000\000\000\000\000\000h\142\000\000\028\018\134\028\000\000\026\"T\016\029\220\r\164\000\000\000\000\000\000\000\000l\012\000\000\000\000\005\242\014V\000\000I\128\000\000\000\000\135\176\000\000\007:\000\000\000\000K\200\003\138\r\202T\016\t\148\000\000\000\000\b\188\005.\000\000T\016\n@\000\000\000\000\r\252\000\000\000\000\000\000JjT\016\nP\000\000\000\000\030*\000\000\000\000{\254\000\000\031\"|\138\000\000 \026|\210\000\000!\018\t\250\000\000\000\000\000\000\000\000\"\nW\200#\002p\234p\234\000\000\000\000\000\0001V\000\000\007\204\000\000\000\000\000\000q\140\000\000\000\000\002\138\023\248\000\000\t*\000\000\000\000]bKl\000\000\000\000\t\188\000\000\000\000\000\000\n\128\000\000\000\000\000\000\016x\004\216\024\232\000\000\t`\000\000\005\208\000\0002N\000\000\n\180\000\000\006\200\000\0003F\000\000\014\204\007\192\000\0004>lt\000\000(\158\000\000\t\218\b\184\000\00056\000\000\011\150\t\176\000\0006.\000\000q\150\n\168\000\0007&\t\234\025\016\000\000\n\210\011\160\000\0008\030\000\000\011\216\012\152\000\0009\022\000\000\r\n\r\144\000\000:\014\014\136\000\000;\006\015\128\019`\000\000\000\000\000\000\011\026\000\000\000\000\012\186\000\000\000\000\015n\000\000\012*\000\000\000\000\000\000\014\222\000\000\015\004\000\000\000\000J~\003\138\015\192p\156_\014\000b\000\000\000\000p\156\000\000\000\000\000\000p\156\000\000\015\156\000\000\000\000\000\000\000\000\000\000\000\000;\254W\200\000\000\000\000\015\232\000\000<\246\000\000=\238\000\000#\250\000\000\000\000\n\184\000\000\000\000W\200\000\000\000\000}j\011\202\000\000\000\000G,\000\000\011\238\000\000\000\000V\020\000\000\rh\000\000\000\000\001\130\011\254\000\000\000\000\0226\022\028\b\198\000\000A\214\000\000!,\025\160\021\220\000\000\000\000\r\150\000\000\000\000\001\238\025\030V\180\000\000\025\030\000\000\012\246\000\000\000\000\r\172\000\000\000\000g>\b\n\004H\000\000\000\000\r@\000\000\000\000\r\200\000\000\000\000\000\000\020X\028\254\005\168\000\000\000\000\023Z\003\130\0020\003\136\028\254w\228\021\178\001B\028\254xb\015\144\000\000\000\000\003\136\000\000H\232\019\248\021\204\000\000\t\144\016\002\000\000\016\000\000V_\014\006\196\000\000\015\232\015vK\200\r(T\016\030\128\0204\014\n\004\248\000\000\031x\016N\000\000\006\196\000\000\000\000\016^_\014aX\000\000g\144_\014\016*_\014m\012a\248\001N\015\236\000\000\000\000\000\000\020X\128\252\000\000W\200p\234\000\000\000\000\016b\000\000\000\000\000\000>\230\016\146y\188?\222h<\000\000\000\000HJ\000\000\005\128\000\000L\136\000\000\022\222\000\000\021\178\006\026\000\000\128\178\000\000\020X\028\254\128\178\000\000\025D\025\186\001N\005.\130\144\021\178}\248p\234\000\000\005r\b\176\0020\003\136p\234\132\224\003\130\0020\003\136p\234\132\224\000\000\000\000\003\136p\234\000\000FfC\170W\200\027B\000\000\000\000FfC\170P\148\020X\028\254\128\178\000\000\020\182\000-\000[\015\200T\016\012\142\016\146\131P\000\000p\234\000\000H\232\019\248\021\204x\186\023\228\t\236~,\b\130\015\234\020Xp\234\000\000\020Xp\234\000\000h\142ff\019\134\002\222\001N\0008N\234\000\000\001N\0008N\234\000\000\025D\005r\t\168\0212\012\180\000\000N\234\000\000\0020\015\234\021\178p\234\134\222\003\130\0020\015\236\021\178p\234\134\222\000\000\000\000\b`\000\000O\224\000\000\021\178\131\132N\234\000\000\b`\000\000H\254\020X\021\178p\234\000\000H\232\019\248\021\204rFC\186\026\222\019\170\002\142\000\000\r\216\027\158\000\017\000\000\016h\016 \024\196\020XT\184T\016\0118\000\000W\150\001N\005\204\011\246\000\000\011\228\000\000\016~\016\014T\016O(\000\000\0032\004\212\r\200\000\000\r6\000\000\016\136\016 K\200\r\206T\016K\182O(\000\000UP\020X\024\196\016\202\n$\001N\000\000\r\200\024\196T\016\012~\000b\000\000T\016\007\152\t,\000\000\000\000mf\000\000\000\000\r\228\024\196m\228O(\000\000\020XT\016\r(T\016V\\O(\000\000\014<\000\000\000\000O(\000\000\000\000W\150\000\000p\234\132\238\019\170\002\142\r\216\016\182\016h\024\196p\234\132\238\000\000\000\000\019\170\002\142\r\216\016\190\016HM\252LZ_\014\016\206M\252h\142\020\184\016\218M\252_\014\016\230M\252n\132o\004\000\000\129\140\000\000\000\000p\234\134\236\019\170\002\142\r\216\016\224\016nM\252p\234\134\236\000\000\000\000\000\000ff\000\000\000\000\000\000\000\000\000\000\000\000N\234\000\000\133\128\020\026A\228\017\002v\246\000\000\128\178\133\128\000\000\000\000\1358\020\026A\228\017\004\016\158]\160\135\176\006\196\017H\000\000\000\000o\130rF\020X\000\000~\200\021\204\000\000\000\000\128\178\1358\000\000\000\000\000\000y6DlD\228\006\196\017J\000\000\000\000\000\000rF\020X\000\000\006\196\017N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014`C\186\019\170\002\142\r\216\017 r\182\023\204\020XZ\024j\190\020(\001N\006\196\017*\nt\000\000\000\000\016\220\000\000\000\000a\152\000\000\b\022\014\132\000\000\r\212\000\000\0178\016\202T\016d\240\017F\n\158\000\000\000\000\017\004\000\000\000\000\020F\0032\014\210\000\000\017Zs8\137\172\003\138\016\248T\016\014r\000\000\000\000\017\012\000\000\000\000\000\000a\152\000\000\0070\014\234\000\000\014\204\000\000\017l\016\250K\200\000\000\017vs\186\137\248\003\138\017\026T\016\015\024\000\000\000\000\017,\000\000\000\000\000\000\020X\000\000a\152\000\000\020z\020X\023\204\023\204u\168Ff\020X\128\252W\200\021\162\000\000\012\020\001N\000\000\014\012\023\204T\016\014n\b\198\000\000\020XW\200r\182\023\204\014\154\023\204\000\000D\142Et\000\000bR\000\000\000\000b\238\000\000\000\000c\138\000\000\014\192\023\204d&\128\252W\200\021\162\000\000\000\"\000\000\000\000M\252\r\026\000\000\000\000d.\017\144\000\000a\152\000\000\023\204d.a\152\000\000\020XT\016a\152\000\000\015\136\000\000\000\000a\152\000\000\000\000j\190\000\000\129\192M\252\017T\023\204\130\\r\182\000\000p\234\133\142\019\170\002\142\r\216\017\174r\182p\234\133\142\000\000\000\000\000\000\135\248P\206\000\000\000\000\000\000\000\000\000\000\000\000\132\022p\234\000\000\133\128\000\000\000\000\000\000\000\000p\234\135\248\000\000\017\234\000\000\000\000\132\022\017\236\000\000p\234\135\248\000\000\000\000\015\222\000\000\000\000i4\0032\000\000\000\000DH\000\000T\016\015\242\000\000j\190\015\240\000\000\000\000\000\000\014\192\000\000\000\000\000\000P\212\020X\028\254\006\178\000\000Mt\000\000\007p\000\000\000*\000\000\000\000\017\242\000\000\018\026y\188\000\000@\214\017\252\000\000\000\000\017\248\026R\028B\021\204v0\023\228\020X\000\000\128\178\000\000\000\000\000\000\000\000\000\000\000\000\000\000v8\023\228\020X\000\000\015\"v\246\000\000\128\178\000\000\017\254\026R\028B\128\178\000\000\018\020\000\000\000\238\t\214\020X`\226\000\000\000\000\028\190y\242\000\000\000\000\017\184\000\000\018\bT\016\000\000\r\234\011\174\000b\000\000\000\000T\016\004R\006B\000\000T\016\012\018\006\196\018>\000\000\000\000\127\"\000\000\000\000]\160\000\000\128\178\000\000\0182\026R\029:N\234\000\000\000\000\000\000\000\000\015h\127\188]\160\000\000\128\178\000\000\0184\026R\029:N\234\000\000\016 \000\000\000\000\b\n\000\000p\234\000\000\018H\000\000\000\000\017\174\000\000\017\188\000\000\017\208\000\000\000\000\\\142\017\216\000\000\000\000%\182\\(\018t\000\000\000\000\000\000\014\242\011D]\232\018x\000\000\000\000\000\000\000\000\000\000\000\000\017\248\000\000\023\228\000\000\017\250\000\000T\016\000\000\014\250\000\000\000\000\017\252\000\000\000\000\0008\000\000\003\210\000\000\000\000\000\000\001\214\000\000\015\196\000\000\018\000\000\000W\200\022\168\000\000\000\000\012<\018\012\000\000\000\000\018\006\r$G,\005.\128:\000\000\000\000\000\000\000\000\000\000YL\000\000\000\000\018\172\000\000\138<\000\000\015\192\018\180\000\000\018\182\000\000G\224G\224[\190[\190\000\000\000\000p\234[\190\000\000\000\000\000\000p\234[\190\0180\000\000\018H\000\000"), (16, "\t)\t)\000\006\001\002\001\190\t)\002\158\002\162\t)\002\206\002f\t)\003\145\t)\018\130\002\218\t)\023\130\t)\t)\t)\025*\t)\t)\t)\001\210\004A\004A\004*\002\222\t)\003\"\003&\t\214\t)\001\206\t)\023\134\003*\000\238\002\226\025.\t)\t)\003\186\003\190\t)\003\194\003\022\003\206\003\214\006\186\006\246\t)\t)\002\150\001\206\006\214\003\030\t)\t)\t)\007\254\b\002\b\014\b\"\001*\005Z\t)\t)\t)\t)\t)\t)\t)\t)\t)\b\150\000\238\t)\015~\t)\t)\003\145\b\162\b\186\t\014\005f\005j\t)\t)\t)\r\162\t)\t)\t)\t)\002N\002~\r\210\t)\006\150\t)\t)\0035\t)\t)\t)\t)\t)\t)\005n\b\022\t)\t)\t)\b.\004V\t\"\0035\t)\t)\t)\t)\012\217\012\217\023\138\n\178\004~\012\217\n\190\012\217\012\217\000\238\012\217\012\217\012\217\012\217\004A\012\217\012\217\001f\012\217\012\217\012\217\003i\012\217\012\217\012\217\012\217\004A\012\217\015\222\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\007\162\007\002\0076\012\217\004\198\012\217\012\217\012\217\012\217\012\217\004A\012\217\012\217\004A\012\217\003\210\012\217\012\217\012\217\000\238\007\166\012\217\012\217\012\217\012\217\012\217\012\217\012\217\000\238\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\004A\012\217\012\217\007n\012\217\012\217\001j\004A\007\018\004A\012\217\012\217\012\217\012\217\012\217\004A\012\217\012\217\012\217\012\217\012\217\000\238\012\217\012\217\007\026\012\217\012\217\000\238\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\b\006\004A\012\217\012\217\012\217\012\217\001\181\001\181\001\181\001f\015>\001\181\003i\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\014\234\001\181\007\194\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\003j\003n\001\181\000\238\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\006\218\001\181\001\181\001\181\007\250\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\002J\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\027\159\001\181\001\181\018r\007\222\007\002\007R\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\014\174\bF\001\181\005\158\001\181\001\181\007\226\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\182\001\181\001\181\001\181\001\181\001\181\n]\n]\002\225\007n\012\253\n]\003\149\n]\n]\000\238\n]\n]\n]\n]\001\186\n]\n]\012\253\n]\n]\n]\000\238\n]\n]\n]\n]\002N\n]\000\n\n]\n]\n]\n]\n]\n]\n]\n]\024\194\007\002\b\146\n]\004A\n]\n]\n]\n]\n]\000\238\n]\n]\012\006\n]\002\246\n]\n]\n]\002\225\024\198\n]\n]\n]\n]\n]\n]\n]\004A\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\003\149\n]\n]\007n\n]\n]\004A\004A\007\002\004A\n]\n]\n]\n]\n]\004\001\n]\n]\n]\n]\t:\000\238\tj\n]\005\241\n]\n]\007\174\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\003v\n]\n]\n]\n]\n]\003\173\003\173\001r\007n\006\214\003\173\b\250\003\173\003\173\000\238\003\173\003\173\003\173\003\173\000\238\003\173\003\173\006\137\003\173\003\173\003\173\000\238\003\173\003\173\003\173\003\173\001\130\003\173\006>\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\006\137\007\002\004\001\003\173\004&\003\173\003\173\003\173\003\173\003\173\015.\003\173\003\173\006B\003\173\t\005\003\173\003\173\003\173\005\241\bv\003\173\003\173\003\173\003\173\003\173\003\173\003\173\0156\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\b\213\t2\tb\007n\003\173\003\173\003z\003B\b\202\027\143\003\173\003\173\003\173\003\173\003\173\0046\003\173\003\173\003\173\003\173\t:\000\238\tj\003\173\b\006\003\173\003\173\003F\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\000\238\003\173\003\173\003\173\003\173\003\173\003\161\003\161\018\222\b\206\b\234\003\161\0056\003\161\003\161\t\005\003\161\003\161\003\161\003\161\001\146\003\161\003\161\006~\003\161\003\161\003\161\0022\003\161\003\161\003\161\003\161\018\230\003\161\001\198\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\006\237\b\213\004A\003\161\0026\003\161\003\161\003\161\003\161\003\161\b\029\003\161\003\161\001\218\003\161\007\006\003\161\003\161\003\161\006\237\004A\003\161\003\161\003\161\003\161\003\161\003\161\003\161\004A\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\000\238\t2\tb\001\234\003\161\003\161\004A\004A\007\002\007B\003\161\003\161\003\161\003\161\003\161\001\222\003\161\003\161\003\161\003\161\t:\004A\tj\003\161\004V\003\161\003\161\016Z\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\006\237\003\161\003\161\003\161\003\161\003\161\t\217\t\217\018\178\007n\b\n\t\217\006\130\t\217\t\217\001\238\t\217\t\217\t\217\t\217\000\238\t\217\t\217\006\149\t\217\t\217\t\217\000\238\t\217\t\217\t\217\t\217\004A\t\217\007\194\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\006\149\007\002\018\186\t\217\000\238\t\217\t\217\t\217\t\217\t\217\005\217\t\217\t\217\001\206\t\217\012f\t\217\t\217\t\217\015\022\016v\t\217\t\217\t\217\t\217\t\217\t\217\t\217\000\238\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\0262\t\217\t\217\007n\t\217\t\217\003\130\003N\t\162\004A\t\217\t\217\t\217\t\217\t\217\002Z\t\217\t\217\t\217\t\217\t\217\000\238\t\217\t\217\004&\t\217\t\217\003R\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\000\238\004A\t\217\t\217\t\217\t\217\t\209\t\209\004\214\001f\003i\t\209\n\134\t\209\t\209\025\018\t\209\t\209\t\209\t\209\003\134\t\209\t\209\004:\t\209\t\209\t\209\003\137\t\209\t\209\t\209\t\209\b\241\t\209\004B\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\007\194\0266\015\134\t\209\001\206\t\209\t\209\t\209\t\209\t\209\005\209\t\209\t\209\000\238\t\209\012~\t\209\t\209\t\209\022f\011\022\t\209\t\209\t\209\t\209\t\209\t\209\t\209\000\238\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\011\026\t\209\t\209\022n\t\209\t\209\002\186\004\146\007\002\b\241\t\209\t\209\t\209\t\209\t\209\007\005\t\209\t\209\t\209\t\209\t\209\025\022\t\209\t\209\b\021\t\209\t\209\025\"\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\000\238\b\241\t\209\t\209\t\209\t\209\t\225\t\225\b\193\007n\007\194\t\225\011\234\t\225\t\225\007\182\t\225\t\225\t\225\t\225\006\214\t\225\t\225\000\238\t\225\t\225\t\225\000\238\t\225\t\225\t\225\t\225\005*\t\225\011\238\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\001\007\002\006\182\t\225\000\238\t\225\t\225\t\225\t\225\t\225\021\218\t\225\t\225\004&\t\225\012\146\t\225\t\225\t\225\014\226\026\198\t\225\t\225\t\225\t\225\t\225\t\225\t\225\bj\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\004\230\t\225\t\225\007n\t\225\t\225\005\018\021\226\b\193\005.\t\225\t\225\t\225\t\225\t\225\005\209\t\225\t\225\t\225\t\225\t\225\000\238\t\225\t\225\007~\t\225\t\225\002\250\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\001\004\186\t\225\t\225\t\225\t\225\t\193\t\193\003j\003n\006\214\t\193\tv\t\193\t\193\005\254\t\193\t\193\t\193\t\193\002\162\t\193\t\193\016\190\t\193\t\193\t\193\017v\t\193\t\193\t\193\t\193\tz\t\193\011>\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\006*\006\142\006\166\t\193\002\250\t\193\t\193\t\193\t\193\t\193\018\026\t\193\t\193\004:\t\193\012\178\t\193\t\193\t\193\002\238\012\018\t\193\t\193\t\193\t\193\t\193\t\193\t\193\018&\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\012\022\t\193\t\193\b\189\t\193\t\193\002\254\012^\001\002\001\190\t\193\t\193\t\193\t\193\t\193\004F\t\193\t\193\t\193\t\193\t\193\006U\t\193\t\193\011F\t\193\t\193\012b\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\006U\000\238\t\193\t\193\t\193\t\193\t\201\t\201\003j\017\206\002r\t\201\012.\t\201\t\201\006\146\t\201\t\201\t\201\t\201\007\130\t\201\t\201\017\226\t\201\t\201\t\201\tv\t\201\t\201\t\201\t\201\001v\t\201\0122\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\011\174\025\222\b\189\t\201\012\174\t\201\t\201\t\201\t\201\t\201\000\238\t\201\t\201\002r\t\201\012\198\t\201\t\201\t\201\001\222\003\242\t\201\t\201\t\201\t\201\t\201\t\201\t\201\004A\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\0112\t\201\t\201\003\246\t\201\t\201\006\174\016*\001\002\001\190\t\201\t\201\t\201\t\201\t\201\015n\t\201\t\201\t\201\t\201\t\201\006]\t\201\t\201\004\213\t\201\t\201\012>\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\006]\000\238\t\201\t\201\t\201\t\201\n\001\n\001\012\230\012B\002\246\n\001\012v\n\001\n\001\000\238\n\001\n\001\n\001\n\001\n\246\n\001\n\001\000\238\n\001\n\001\n\001\012\018\n\001\n\001\n\001\n\001\001\134\n\001\012z\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\004\182\006\162\011N\n\001\012\242\n\001\n\001\n\001\n\001\n\001\011r\n\001\n\001\019\"\n\001\012\218\n\001\n\001\n\001\006\226\012^\n\001\n\001\n\001\n\001\n\001\n\001\n\001\021\186\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\rJ\n\001\n\001\n\178\n\001\n\001\n\190\014\022\007\130\022\002\n\001\n\001\n\001\n\001\n\001\018\162\n\001\n\001\n\001\n\001\n\001\006e\n\001\n\001\n\178\n\001\n\001\n\190\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\006e\011\234\n\001\n\001\n\001\n\001\t\241\t\241\027*\001\222\014\030\t\241\004\186\t\241\t\241\000\238\t\241\t\241\t\241\t\241\001\206\t\241\t\241\012\194\t\241\t\241\t\241\0142\t\241\t\241\t\241\t\241\001\150\t\241\012.\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\005\n\018\190\014F\t\241\0146\t\241\t\241\t\241\t\241\t\241\014j\t\241\t\241\r\006\t\241\012\246\t\241\t\241\t\241\002~\005\026\t\241\t\241\t\241\t\241\t\241\t\241\t\241\004A\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\b\217\t\241\t\241\rj\t\241\t\241\005\221\018\182\002\162\026\026\t\241\t\241\t\241\t\241\t\241\005\225\t\241\t\241\t\241\t\241\t\241\b\230\t\241\t\241\t\006\t\241\t\241\tN\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\000\238\000\238\t\241\t\241\t\241\t\241\t\233\t\233\001\002\001\190\014n\t\233\b\237\t\233\t\233\019:\t\233\t\233\t\233\t\233\017\214\t\233\t\233\012v\t\233\t\233\t\233\001\206\t\233\t\233\t\233\t\233\004\186\t\233\014J\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\005\"\b\217\rV\t\233\rn\t\233\t\233\t\233\t\233\t\233\014\198\t\233\t\233\022\250\t\233\r\n\t\233\t\233\t\233\000\238\012>\t\233\t\233\t\233\t\233\t\233\t\233\t\233\023\146\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\002\250\t\233\t\233\r\026\t\233\t\233\018\234\014\242\023\150\017B\t\233\t\233\t\233\t\233\t\233\019B\t\233\t\233\t\233\t\233\t\233\011>\t\233\t\233\tV\t\233\t\233\014Z\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\001\002\001\190\t\233\t\233\t\233\t\233\t\249\t\249\014^\014\162\b!\t\249\004\186\t\249\t\249\000\238\t\249\t\249\t\249\t\249\014\210\t\249\t\249\014\202\t\249\t\249\t\249\tf\t\249\t\249\t\249\t\249\014\166\t\249\014\254\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\014\214\021\230\019\130\t\249\014\246\t\249\t\249\t\249\t\249\t\249\015\154\t\249\t\249\015\002\t\249\r\030\t\249\t\249\t\249\018\226\011>\t\249\t\249\t\249\t\249\t\249\t\249\t\249\026\022\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\b%\t\249\t\249\015\170\t\249\t\249\005\213\003}\002\253\019\150\t\249\t\249\t\249\t\249\t\249\n\158\t\249\t\249\t\249\t\249\t\249\018z\t\249\t\249\n\214\t\249\t\249\019.\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\019f\n\250\t\249\t\249\t\249\t\249\nI\nI\007\241\007R\011*\nI\018\254\nI\nI\023\018\nI\nI\nI\nI\023\006\nI\nI\007R\nI\nI\nI\011Z\nI\nI\nI\nI\026&\nI\024\246\nI\nI\nI\nI\nI\nI\nI\nI\007R\022r\021\222\nI\000\238\nI\nI\nI\nI\nI\r\005\nI\nI\000\238\nI\r*\nI\nI\nI\019\154\012\142\nI\nI\nI\nI\nI\nI\nI\022\"\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\022j\nI\nI\022B\nI\nI\b\025\001\206\023.\b\021\nI\nI\nI\nI\nI\019B\nI\nI\nI\nI\nI\r\017\nI\nI\004&\nI\nI\023f\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\000\238\001\206\nI\nI\nI\nI\003\157\003\157\025\170\007R\023\210\003\157\n\134\003\157\003\157\000\238\003\157\003\157\003\157\003\157\rb\003\157\003\157\024\250\003\157\003\157\003\157\rz\003\157\003\157\003\157\003\157\027o\003\157\027&\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\026\142\r\130\022\162\003\157\002\006\003\157\003\157\003\157\003\157\003\157\024\178\003\157\003\157\004Y\003\157\r\150\003\157\003\157\003\157\024\230\r\198\003\157\003\157\003\157\003\157\003\157\003\157\003\157\r\242\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\024\218\t2\tb\026\186\003\157\003\157\001\222\015J\015r\003\226\003\157\003\157\003\157\003\157\003\157\002\198\003\157\003\157\003\157\003\157\t:\023\214\tj\003\157\015\142\003\157\003\157\015\146\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\000\238\003\157\003\157\003\157\003\157\003\157\001\237\001\237\015\186\015\206\015\230\001\237\015\250\002\162\001\237\016&\002f\001\237\tJ\001\237\016:\002\218\001\237\024\182\001\237\001\237\001\237\017:\001\237\001\237\001\237\001\210\024\234\tR\017F\002\222\001\237\001\237\001\237\001\237\001\237\tZ\001\237\005\250\017\234\018\002\002\226\018\138\001\237\001\237\001\237\001\237\001\237\018\142\003\022\001\190\026\190\001\237\018\198\001\237\001\237\002\150\018\202\018\242\003\030\001\237\001\237\001\237\007\254\b\002\b\014\018\246\012J\005Z\001\237\001\237\001\237\001\237\001\237\001\237\001\237\001\237\001\237\019\030\t2\tb\019\202\001\237\001\237\019\206\019\242\019\246\020\006\005f\005j\001\237\001\237\001\237\020\022\001\237\001\237\001\237\001\237\012R\020\"\012\162\001\237\020V\001\237\001\237\020Z\001\237\001\237\001\237\001\237\001\237\001\237\005n\b\022\001\237\001\237\001\237\b.\004V\020\166\020\206\001\237\001\237\001\237\001\237\n1\n1\020\210\020\226\0212\n1\021R\002\162\n1\021\146\002f\n1\n1\n1\021\182\002\218\n1\021\198\n1\n1\n1\021\238\n1\n1\n1\001\210\021\242\n1\021\254\002\222\n1\n1\n1\n1\n1\n1\n1\022\014\022*\022:\002\226\022N\n1\n1\n1\n1\n1\022z\003\022\001\190\022~\n1\022\138\n1\n1\002\150\022\154\022\174\003\030\n1\n1\n1\007\254\b\002\b\014\023\162\n1\005Z\n1\n1\n1\n1\n1\n1\n1\n1\n1\023\250\n1\n1\024\"\n1\n1\024\138\024\154\0256\025>\005f\005j\n1\n1\n1\025N\n1\n1\n1\n1\n1\025Z\n1\n1\025\190\n1\n1\025\210\n1\n1\n1\n1\n1\n1\005n\b\022\n1\n1\n1\b.\004V\026\002\026\n\n1\n1\n1\n1\n-\n-\026F\026n\026\166\n-\026\214\002\162\n-\026\226\002f\n-\n-\n-\026\234\002\218\n-\026\243\n-\n-\n-\027\003\n-\n-\n-\001\210\027\022\n-\0272\002\222\n-\n-\n-\n-\n-\n-\n-\027O\027_\027{\002\226\027\175\n-\n-\n-\n-\n-\027\203\003\022\001\190\027\214\n-\028\011\n-\n-\002\150\028\031\028'\003\030\n-\n-\n-\007\254\b\002\b\014\028c\n-\005Z\n-\n-\n-\n-\n-\n-\n-\n-\n-\028k\n-\n-\000\000\n-\n-\000\000\000\000\000\000\000\000\005f\005j\n-\n-\n-\000\000\n-\n-\n-\n-\n-\000\000\n-\n-\000\000\n-\n-\000\000\n-\n-\n-\n-\n-\n-\005n\b\022\n-\n-\n-\b.\004V\000\000\000\000\n-\n-\n-\n-\0029\0029\000\000\000\000\000\000\0029\000\000\002\162\0029\000\000\002f\0029\tJ\0029\000\000\002\218\0029\000\000\0029\0029\0029\000\000\0029\0029\0029\001\210\002\225\tR\000\000\002\222\0029\0029\0029\0029\0029\tZ\0029\000\000\000\000\000\000\002\226\004A\0029\0029\0029\0029\0029\000\000\003\022\001\190\000\000\0029\000\n\0029\0029\002\150\000\000\000\000\003\030\0029\0029\0029\007\254\b\002\b\014\000\000\012J\005Z\0029\0029\0029\0029\0029\0029\0029\0029\0029\000\000\004\173\0029\002\225\0029\0029\004A\006f\002\162\004A\005f\005j\0029\0029\0029\000\000\0029\0029\0029\0029\000\000\000\238\004A\0029\004\173\0029\0029\004A\0029\0029\0029\0029\0029\0029\005n\b\022\0029\0029\0029\b.\004V\000\000\004A\0029\0029\0029\0029\004A\004A\004A\002\238\004A\004A\004A\004A\004A\004A\004A\017\158\004A\000\238\004A\004A\000\000\004A\004A\004A\000\000\004A\004A\004A\004A\004A\004A\004A\004A\004A\000\238\004A\004A\000\000\000\000\004A\004A\000\238\004A\004A\004A\004A\004A\000\238\004A\004A\004A\004A\004A\004A\004A\004A\000\238\004A\004A\004A\004A\004A\004A\004A\004A\000\238\004A\004A\004A\004A\004A\004A\004A\004A\b\189\0042\004A\000\000\000\000\004A\004A\004A\000\238\004A\000\n\000\000\004A\004A\004A\004A\004A\004A\004A\004A\004A\000\000\021\170\004A\004A\002\225\002\225\007J\004A\004&\006\233\000\000\004A\004A\000\000\007R\000\000\022\026\002\225\000\238\004A\004A\004A\007V\000\000\004A\004A\004A\004A\006\233\000\161\004A\000\161\006\233\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\000\161\022\206\000\161\000\161\000\000\000\161\000\161\000\000\000\000\000\161\000\161\000\000\000\161\000\161\000\161\000\161\000\000\000\161\0046\000\161\000\161\b\189\000\000\000\161\000\161\005\141\000\161\000\161\000\161\000\238\000\161\b\241\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\bn\000\161\000\161\000\000\000\000\000\161\000\161\002\006\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\002\n\006\233\000\000\015f\t\029\000\161\002f\000\161\001\210\000\161\005\141\002\162\000\000\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\000\000\000\000\000\161\003~\017\210\t\029\005\141\000\222\000\000\006\230\001\222\000\161\000\000\002\198\000\000\014z\002\150\000\161\000\161\000\161\000\161\000\000\015j\000\161\000\161\000\161\000\161\002)\002)\004Y\000\000\002\238\002)\000\000\002\162\002)\015v\002f\002)\001b\002)\000\000\002\218\002)\006\234\002)\002)\002)\000\000\002)\002)\002)\001\210\001z\000\000\001\138\002\222\002)\002)\002)\002)\002)\005j\002)\000\000\000\000\000\000\002\226\b\169\002)\002)\002)\002)\002)\004Y\003\022\b\018\000\000\002)\000\000\002)\002)\002\150\000\000\006\006\003\030\002)\002)\002)\007\254\b\002\b\014\t2\tb\005Z\002)\002)\002)\002)\002)\002)\002)\002)\002)\006\n\t2\tb\b\169\002)\002)\000\000\t:\007\002\tj\005f\005j\002)\002)\002)\000\000\002)\002)\002)\002)\t:\000\000\tj\002)\b\169\002)\002)\016j\002)\002)\002)\002)\002)\002)\005n\b\022\002)\002)\002)\b.\004V\000\238\000\000\002)\002)\002)\002)\002E\002E\000\000\007n\000\000\002E\000\000\000\000\002E\000\000\b\169\002E\000\000\002E\004\226\000\000\002E\b\169\002E\002E\002E\000\238\002E\002E\002E\000\000\027\187\000\000\002\225\002\225\002E\002E\002E\002E\002E\000\000\002E\000\000\006\014\004\169\000\000\005\206\002E\002E\002E\002E\002E\000\000\006\026\000\000\000\000\002E\006&\002E\002E\000\n\000\000\000\000\006b\002E\002E\002E\004\169\000\000\000\000\006\213\016n\000\000\002E\002E\002E\002E\002E\002E\002E\002E\002E\000\000\t2\tb\000\000\002E\002E\002\225\006j\000\000\002\162\000\000\006\213\002E\002E\002E\000\000\002E\002E\002E\002E\t:\002\162\tj\002E\002f\002E\002E\001\210\002E\002E\002E\002E\002E\002E\b\165\000\000\002E\002E\002E\000\000\021\154\000\000\000\000\002E\002E\002E\002E\002A\002A\000\000\022\214\002\238\002A\022\218\002\250\002A\000\000\002\150\002A\000\000\002A\000\000\017j\002A\023\n\002A\002A\002A\t>\002A\002A\002A\012\n\b\165\000\000\000\000\015v\002A\002A\002A\002A\002A\rN\002A\rZ\000\000\012&\023\026\0126\002A\002A\002A\002A\002A\b\165\bJ\001\190\001*\002A\000\000\002A\002A\005j\002\225\002\225\014:\002A\002A\002A\014N\014b\014r\000\000\000\000\000\000\002A\002A\002A\002A\002A\002A\002A\002A\002A\000\000\t2\tb\b\165\002A\002A\000\n\004\226\000\000\001\206\b\165\000\000\002A\002A\002A\000\000\002A\002A\002A\002A\t:\000\000\tj\002A\000\000\002A\002A\001\210\002A\002A\002A\002A\002A\002A\002\225\000\000\002A\002A\002A\000\000\018\146\000\000\000\000\002A\002A\002A\002A\002-\002-\000\000\000\000\002~\002-\019\026\002\250\002-\000\000\002\150\002-\000\000\002-\000\000\000\000\002-\0192\002-\002-\002-\012V\002-\002-\002-\002\225\002\225\016\150\000\000\000\000\002-\002-\002-\002-\002-\012n\002-\012\134\000\000\000\000\002\225\012\234\002-\002-\002-\002-\002-\000\000\bJ\014\178\000\000\002-\000\n\002-\002-\012\254\000\000\r\018\014:\002-\002-\002-\014N\014b\014r\t\025\000\000\000\000\002-\002-\002-\002-\002-\002-\002-\002-\002-\000\000\t2\tb\002\225\002-\002-\000\000\014\146\002\225\000\000\000\238\t\025\002-\002-\002-\000\000\002-\002-\002-\002-\t:\000\000\tj\002-\000\000\002-\002-\000\000\002-\002-\002-\002-\002-\002-\000\n\000\000\002-\002-\002-\000\000\t\030\000\000\000\000\002-\002-\002-\002-\002=\002=\000\000\002\225\000\000\002=\012}\006\014\002=\000\000\005\206\002=\000\000\002=\000\000\002\225\002=\006\026\002=\002=\002=\006&\002=\002=\002=\012}\012}\000\000\000\000\012}\002=\002=\002=\002=\002=\000\000\002=\b\021\000\000\000\000\b\021\000\000\002=\002=\002=\002=\002=\000\000\000\000\000\000\000\000\002=\000\000\002=\002=\000\000\000\000\000\000\022\"\002=\002=\002=\000\000\000\000\000\000\000\000\000\000\000\238\002=\002=\002=\002=\002=\002=\002=\002=\002=\000\000\b\021\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\b\021\002=\002=\002=\002=\012}\000\000\004\253\002=\000\000\002=\002=\002\225\t\130\002=\002=\002=\002=\002=\004\253\n\202\002=\002=\002=\000\000\000\000\b\021\000\000\002=\002=\002=\002=\t%\t%\000\000\000\000\000\000\t%\000\000\000\000\t%\000\n\000\000\t%\000\000\t%\000\000\000\000\t\174\004\253\t%\t\210\t%\b\021\t%\t%\t%\002\225\000\000\000\000\000\000\017\006\t\230\t\254\n\006\t\238\n\014\000\000\t%\002\225\002\225\000\000\000\000\000\000\t%\t%\n\022\n\030\t%\004\253\007\245\000\000\004\253\t%\000\000\n&\t%\000\000\000\000\000\000\000\000\t%\t%\000\238\000\000\000\000\000\000\000\000\000\000\002\218\t%\t%\t\182\t\246\n.\n6\nF\t%\t%\002\138\012\181\t%\000\000\t%\nN\000\000\003>\000\000\000\000\000\238\000\000\t%\t%\nV\000\000\t%\t%\t%\t%\003J\012\181\000\000\t%\000\000\t%\t%\002\030\nv\t%\n~\n>\t%\t%\000\000\000\000\t%\n^\t%\000\000\002&\000\000\005Z\t%\t%\nf\nn\002q\002q\000\000\000\000\000\000\002q\012\133\006\014\002q\000\000\005\206\002q\000\000\002q\000\000\005f\002q\006\026\002q\002q\002q\006&\002q\002q\002q\012\133\012\133\000\000\000\000\012\133\002q\002q\002q\002q\002q\000\000\002q\015f\000\000\005n\002f\000\000\002q\002q\002q\002q\002q\000\000\000\000\000\000\000\000\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\002q\002q\002q\000\000\000\000\000\000\000\000\000\000\000\238\002q\002q\t\182\002q\002q\002q\002q\002q\002q\000\000\015j\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\000\000\000\000\002q\002q\002q\015v\002q\002q\002q\002q\012\133\000\000\001\206\002q\000\000\002q\002q\000\000\002q\002q\002q\002q\002q\002q\025\242\000\000\002q\002q\002q\000\000\000\000\005j\000\000\002q\002q\002q\002q\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002\162\002Y\000\000\000\000\002Y\000\000\002Y\003\142\000\000\002Y\002~\002Y\002Y\002Y\025b\002Y\002Y\002Y\001\210\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\000\000\002Y\015f\000\000\000\000\002f\000\000\002Y\002Y\002Y\002Y\002Y\004~\003\174\000\000\004\217\002Y\000\000\002Y\002Y\002\150\000\000\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\t\182\002Y\002Y\002Y\002Y\002Y\002Y\000\000\015j\002Y\000\000\002Y\002Y\006\206\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\015v\002Y\002Y\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\002Y\002Y\002Y\002Y\002Y\002Y\012\129\000\000\002Y\002Y\002Y\000\000\000\000\005j\000\000\002Y\002Y\002Y\002Y\002e\002e\000\000\000\000\000\000\002e\012\129\012\129\002e\000\000\012\129\002e\000\000\002e\000\000\000\000\t\174\000\000\002e\002e\002e\020\254\002e\002e\002e\000\000\000\000\000\000\000\000\000\000\002e\002e\002e\t\238\002e\000\000\002e\000\000\000\000\000\000\000\000\000\000\002e\002e\002e\002e\002e\000\000\000\238\000\000\000\000\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\002e\002e\002e\000\000\000\000\000\000\000\000\000\000\000\000\002e\002e\t\182\t\246\002e\002e\002e\002e\002e\000\000\012\129\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\000\238\b\t\002e\002e\002e\b\t\002e\002e\002e\002e\000\000\000\000\000\000\002e\000\000\002e\002e\000\000\002e\002e\002e\002e\002e\002e\000\000\000\000\002e\002e\002e\000\000\011~\000\000\000\000\002e\002e\002e\002e\002u\002u\000\000\000\000\000\000\002u\b\t\011\134\002u\000\000\011\146\002u\000\000\002u\000\000\000\000\002u\011\158\002u\002u\002u\011\170\002u\002u\002u\000\000\000\000\b\t\000\000\000\000\002u\002u\002u\002u\002u\000\000\002u\000\000\000\000\000\000\000\000\000\000\002u\002u\002u\002u\002u\000\000\000\000\000\000\000\000\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\002u\002u\002u\000\000\000\000\004\226\000\000\000\000\000\000\002u\002u\t\182\002u\002u\002u\002u\002u\002u\000\000\007\206\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\000\238\b\005\002u\002u\002u\b\005\002u\002u\002u\002u\000\000\007\210\000\000\002u\000\000\002u\002u\000\000\002u\002u\002u\002u\002u\002u\000\000\000\000\002u\002u\002u\000\000\007\165\000\000\000\000\002u\002u\002u\002u\002U\002U\007\194\000\000\000\000\002U\b\005\007\165\002U\000\000\005\206\002U\000\000\002U\000\000\000\238\002U\007\165\002U\002U\002U\007\165\002U\002U\002U\000\000\000\000\b\005\000\000\000\000\002U\002U\002U\002U\002U\000\000\002U\000\000\000\000\006\253\000\000\000\000\002U\002U\002U\002U\002U\000\000\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\000\000\000\000\006\253\002U\002U\002U\006\253\007\214\004\226\000\000\000\000\000\000\002U\002U\t\182\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\000\000\002U\002U\000\000\000\000\000\000\000\000\007\189\000\000\002U\002U\002U\000\000\002U\002U\002U\002U\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\002U\002U\000\000\007\189\000\000\000\000\002U\002U\002U\002U\002a\002a\000\000\000\000\000\000\002a\005J\007\189\002a\000\000\005\206\002a\000\000\002a\000\000\000\000\t\174\007\189\002a\002a\002a\007\189\002a\002a\002a\000\000\000\000\000\000\000\000\000\000\002a\002a\002a\t\238\002a\000\000\002a\000\000\000\000\006\237\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\006\237\002a\002a\002a\006\237\000\000\000\000\000\000\000\000\000\000\002a\002a\t\182\t\246\002a\002a\002a\002a\002a\000\000\000\000\002a\000\000\002a\002a\000\000\000\000\000\000\000\000\000\238\000\000\002a\002a\002a\000\000\002a\002a\002a\002a\000\000\000\000\000\000\002a\000\000\002a\002a\000\000\002a\002a\002a\002a\002a\002a\000\000\000\000\002a\002a\002a\000\000\007\217\000\000\000\000\002a\002a\002a\002a\002]\002]\000\000\000\000\000\000\002]\b\n\006\014\002]\000\000\005\206\002]\000\000\002]\000\000\000\000\t\174\007\217\002]\002]\002]\007\217\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\t\238\002]\000\000\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\002]\002]\000\000\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\t\182\t\246\002]\002]\002]\002]\002]\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\007\209\000\000\002]\002]\002]\000\000\002]\002]\002]\002]\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\002]\002]\002]\002]\002]\002]\000\000\000\000\002]\002]\002]\000\000\007\209\000\000\000\000\002]\002]\002]\002]\002\133\002\133\000\000\000\000\000\000\002\133\000\000\011\194\002\133\000\000\007\209\002\133\000\000\002\133\000\000\000\000\t\174\007\209\002\133\002\133\002\133\007\209\002\133\002\133\002\133\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\n\014\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002\133\002\133\n\022\n\030\002\133\000\000\000\000\000\000\000\000\002\133\000\000\n&\002\133\000\000\000\000\000\000\000\000\002\133\002\133\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\t\182\t\246\n.\n6\nF\002\133\002\133\000\000\000\000\002\133\000\000\002\133\nN\000\000\000\000\000\000\000\000\000\238\000\000\002\133\002\133\nV\000\000\002\133\002\133\002\133\002\133\000\000\000\000\000\000\002\133\000\000\002\133\002\133\000\000\002\133\002\133\002\133\n>\002\133\002\133\000\000\000\000\002\133\n^\002\133\000\000\007\161\000\000\000\000\002\133\002\133\nf\nn\002m\002m\000\000\000\000\000\000\002m\000\000\007\161\002m\000\000\005\206\002m\000\000\002m\000\000\000\000\t\174\007\161\002m\002m\002m\007\161\002m\002m\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\t\238\002m\000\000\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\002m\002m\000\000\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\t\182\t\246\002m\002m\002m\002m\002m\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\000\238\000\000\002m\002m\002m\000\000\002m\002m\002m\002m\000\000\000\000\000\000\002m\000\000\002m\002m\000\000\002m\002m\002m\002m\002m\002m\000\000\000\000\002m\002m\002m\000\000\014\n\000\000\000\000\002m\002m\002m\002m\002i\002i\000\000\000\000\000\000\002i\000\000\011\134\002i\000\000\011\146\002i\000\000\002i\000\000\000\000\t\174\011\158\002i\002i\002i\011\170\002i\002i\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\t\238\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\t\182\t\246\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\002i\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002}\002}\000\000\000\000\000\000\002}\000\000\002\006\002}\000\000\002f\002}\000\000\002}\000\000\000\000\t\174\000\000\002}\002}\002}\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\002}\000\000\002}\000\000\000\000\000\000\000\000\000\000\002}\002}\n\022\n\030\002}\000\000\027\014\001\222\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\002}\002}\000\238\015v\000\000\000\000\000\000\000\000\000\000\002}\002}\t\182\t\246\n.\n6\002}\002}\002}\000\000\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\000\000\005j\002}\002}\002}\000\000\002}\002}\002}\002}\000\000\000\000\000\000\002}\000\000\002}\002}\000\000\002}\002}\002}\n>\002}\002}\000\000\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\002}\002}\002}\002}\002Q\002Q\000\000\000\000\000\000\002Q\000\000\002\250\002Q\000\000\000\000\002Q\000\000\002Q\000\000\000\000\t\174\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\t\238\002Q\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\002Q\002Q\000\000\005\162\000\000\000\000\002Q\000\000\002Q\002Q\000\000\000\000\000\000\003\218\002Q\002Q\002Q\0062\000\000\003\230\000\000\000\000\000\000\002Q\002Q\t\182\t\246\002Q\002Q\002Q\002Q\002Q\000\000\000\000\002Q\000\000\002Q\002Q\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\002Q\000\000\000\000\000\000\002Q\000\000\002Q\002Q\000\000\002Q\002Q\002Q\002Q\002Q\002Q\000\000\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\002Q\002Q\002Q\002Q\002M\002M\000\000\000\000\000\000\002M\000\000\002\162\002M\000\000\000\000\002M\000\000\002M\000\000\000\000\t\174\000\000\002M\002M\002M\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\002M\000\000\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\n\022\n\030\002M\000\000\tn\002\238\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\000\238\011\226\000\000\011\242\000\000\000\000\000\000\002M\002M\t\182\t\246\n.\n6\002M\002M\002M\000\000\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\002M\002M\002M\002M\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\002M\002M\002M\n>\002M\002M\000\000\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002\169\002\169\000\000\000\000\000\000\002\169\000\000\002\162\002\169\000\000\000\000\002\169\000\000\002\169\000\000\000\000\t\174\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\t\230\t\254\n\006\t\238\002\169\000\000\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\n\022\n\030\002\169\000\000\012\166\002\238\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\012\186\000\000\012\206\000\000\000\000\000\000\002\169\002\169\t\182\t\246\n.\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\002\169\002\169\002\169\n>\002\169\002\169\000\000\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\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\t\174\000\000\002I\002I\002I\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\002I\000\000\002I\000\000\000\000\000\000\000\000\000\000\002I\002I\n\022\n\030\002I\000\000\000\000\000\000\000\000\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\002I\002I\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\t\182\t\246\n.\n6\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\n>\002I\002I\000\000\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\002I\002I\002I\002I\002\129\002\129\000\000\000\000\000\000\002\129\000\000\000\000\002\129\000\000\000\000\002\129\000\000\002\129\000\000\000\000\t\174\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\002\129\000\000\002\129\000\000\000\000\000\000\000\000\000\000\002\129\002\129\n\022\n\030\002\129\000\000\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\t\182\t\246\n.\n6\002\129\002\129\002\129\000\000\000\000\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\002\129\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\002\129\002\129\002\129\n>\002\129\002\129\000\000\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\002\129\002\129\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\t\174\000\000\002y\002y\002y\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\002y\000\000\002y\000\000\000\000\000\000\000\000\000\000\002y\002y\n\022\n\030\002y\000\000\000\000\000\000\000\000\002y\000\000\002y\002y\000\000\000\000\000\000\000\000\002y\002y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\t\182\t\246\n.\n6\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\002y\002y\002y\n>\002y\002y\000\000\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\002y\002y\002y\002y\002\137\002\137\000\000\000\000\000\000\002\137\000\000\000\000\002\137\000\000\000\000\002\137\000\000\002\137\000\000\000\000\t\174\000\000\002\137\002\137\002\137\000\000\002\137\002\137\002\137\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\n\014\000\000\002\137\000\000\000\000\000\000\000\000\000\000\002\137\002\137\n\022\n\030\002\137\000\000\000\000\000\000\000\000\002\137\000\000\n&\002\137\000\000\000\000\000\000\000\000\002\137\002\137\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\t\182\t\246\n.\n6\nF\002\137\002\137\000\000\000\000\002\137\000\000\002\137\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\nV\000\000\002\137\002\137\002\137\002\137\000\000\000\000\000\000\002\137\000\000\002\137\002\137\000\000\002\137\002\137\002\137\n>\002\137\002\137\000\000\000\000\002\137\n^\002\137\000\000\000\000\000\000\000\000\002\137\002\137\nf\nn\002\141\002\141\000\000\000\000\000\000\002\141\000\000\000\000\002\141\000\000\000\000\002\141\000\000\002\141\000\000\000\000\t\174\000\000\002\141\002\141\002\141\000\000\002\141\002\141\002\141\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\002\141\000\000\002\141\000\000\000\000\000\000\000\000\000\000\002\141\002\141\n\022\n\030\002\141\000\000\000\000\000\000\000\000\002\141\000\000\n&\002\141\000\000\000\000\000\000\000\000\002\141\002\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\t\182\t\246\n.\n6\nF\002\141\002\141\000\000\000\000\002\141\000\000\002\141\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\nV\000\000\002\141\002\141\002\141\002\141\000\000\000\000\000\000\002\141\000\000\002\141\002\141\000\000\002\141\002\141\002\141\n>\002\141\002\141\000\000\000\000\002\141\002\141\002\141\000\000\000\000\000\000\000\000\002\141\002\141\nf\nn\002\145\002\145\000\000\000\000\000\000\002\145\000\000\000\000\002\145\000\000\000\000\002\145\000\000\002\145\000\000\000\000\t\174\000\000\002\145\002\145\002\145\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\002\145\000\000\002\145\000\000\000\000\000\000\000\000\000\000\002\145\002\145\n\022\n\030\002\145\000\000\000\000\000\000\000\000\002\145\000\000\n&\002\145\000\000\000\000\000\000\000\000\002\145\002\145\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\t\182\t\246\n.\n6\nF\002\145\002\145\000\000\000\000\002\145\000\000\002\145\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\nV\000\000\002\145\002\145\002\145\002\145\000\000\000\000\000\000\002\145\000\000\002\145\002\145\000\000\002\145\002\145\002\145\n>\002\145\002\145\000\000\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\002\145\002\145\nf\nn\b\225\b\225\000\000\000\000\000\000\b\225\000\000\000\000\b\225\000\000\000\000\b\225\000\000\b\225\000\000\000\000\t\174\000\000\b\225\b\225\b\225\000\000\b\225\b\225\b\225\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\n\014\000\000\b\225\000\000\000\000\000\000\000\000\000\000\b\225\b\225\n\022\n\030\b\225\000\000\000\000\000\000\000\000\b\225\000\000\n&\b\225\000\000\000\000\000\000\000\000\b\225\b\225\000\238\000\000\000\000\000\000\000\000\000\000\000\000\b\225\b\225\t\182\t\246\n.\n6\nF\b\225\b\225\000\000\000\000\b\225\000\000\b\225\nN\000\000\000\000\000\000\000\000\000\000\000\000\b\225\b\225\nV\000\000\b\225\b\225\b\225\b\225\000\000\000\000\000\000\b\225\000\000\b\225\b\225\000\000\b\225\b\225\b\225\n>\b\225\b\225\000\000\000\000\b\225\n^\b\225\000\000\000\000\000\000\000\000\b\225\b\225\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\149\000\000\000\000\000\000\000\000\000\000\002\149\002\149\n\022\n\030\002\149\000\000\000\000\000\000\000\000\002\149\000\000\n&\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\t\182\t\246\n.\n6\nF\002\149\002\149\000\000\000\000\002\149\000\000\002\149\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\nV\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\nv\002\149\n~\n>\002\149\002\149\000\000\000\000\002\149\n^\002\149\000\000\000\000\000\000\000\000\002\149\002\149\nf\nn\b\221\b\221\000\000\000\000\000\000\b\221\000\000\000\000\b\221\000\000\000\000\b\221\000\000\b\221\000\000\000\000\t\174\000\000\b\221\b\221\b\221\000\000\b\221\b\221\b\221\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\n\014\000\000\b\221\000\000\000\000\000\000\000\000\000\000\b\221\b\221\n\022\n\030\b\221\000\000\000\000\000\000\000\000\b\221\000\000\n&\b\221\000\000\000\000\000\000\000\000\b\221\b\221\000\238\000\000\000\000\000\000\000\000\000\000\000\000\b\221\b\221\t\182\t\246\n.\n6\nF\b\221\b\221\000\000\000\000\b\221\000\000\b\221\nN\000\000\000\000\000\000\000\000\000\000\000\000\b\221\b\221\nV\000\000\b\221\b\221\b\221\b\221\000\000\000\000\000\000\b\221\000\000\b\221\b\221\000\000\b\221\b\221\b\221\n>\b\221\b\221\000\000\000\000\b\221\n^\b\221\000\000\000\000\000\000\000\000\b\221\b\221\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\n\022\n\030\002\197\000\000\000\000\000\000\000\000\002\197\000\000\n&\002\197\000\000\000\000\000\000\000\000\002\197\002\197\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\t\182\t\246\n.\n6\nF\002\197\002\197\000\000\000\000\002\197\000\000\002\197\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\nV\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\nv\002\197\n~\n>\002\197\002\197\000\000\000\000\002\197\n^\002\197\000\000\000\000\000\000\000\000\002\197\002\197\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n\022\n\030\002\193\000\000\000\000\000\000\000\000\002\193\000\000\n&\002\193\000\000\000\000\000\000\000\000\002\193\002\193\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\t\182\t\246\n.\n6\nF\002\193\002\193\000\000\000\000\002\193\000\000\002\193\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\nV\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\nv\002\193\n~\n>\002\193\002\193\000\000\000\000\002\193\n^\002\193\000\000\000\000\000\000\000\000\002\193\002\193\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\201\000\000\000\000\000\000\000\000\000\000\002\201\002\201\n\022\n\030\002\201\000\000\000\000\000\000\000\000\002\201\000\000\n&\002\201\000\000\000\000\000\000\000\000\002\201\002\201\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\t\182\t\246\n.\n6\nF\002\201\002\201\000\000\000\000\002\201\000\000\002\201\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\nV\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\nv\002\201\n~\n>\002\201\002\201\000\000\000\000\002\201\n^\002\201\000\000\000\000\000\000\000\000\002\201\002\201\nf\nn\002\181\002\181\000\000\000\000\000\000\002\181\000\000\000\000\002\181\000\000\000\000\002\181\000\000\002\181\000\000\000\000\t\174\000\000\002\181\002\181\002\181\000\000\002\181\002\181\002\181\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\n\014\000\000\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\n\022\n\030\002\181\000\000\000\000\000\000\000\000\002\181\000\000\n&\002\181\000\000\000\000\000\000\000\000\002\181\002\181\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\t\182\t\246\n.\n6\nF\002\181\002\181\000\000\000\000\002\181\000\000\002\181\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\nV\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\nv\002\181\n~\n>\002\181\002\181\000\000\000\000\002\181\n^\002\181\000\000\000\000\000\000\000\000\002\181\002\181\nf\nn\002\185\002\185\000\000\000\000\000\000\002\185\000\000\000\000\002\185\000\000\000\000\002\185\000\000\002\185\000\000\000\000\t\174\000\000\002\185\002\185\002\185\000\000\002\185\002\185\002\185\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\n\014\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n\022\n\030\002\185\000\000\000\000\000\000\000\000\002\185\000\000\n&\002\185\000\000\000\000\000\000\000\000\002\185\002\185\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\t\182\t\246\n.\n6\nF\002\185\002\185\000\000\000\000\002\185\000\000\002\185\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\nV\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\nv\002\185\n~\n>\002\185\002\185\000\000\000\000\002\185\n^\002\185\000\000\000\000\000\000\000\000\002\185\002\185\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\n\022\n\030\002\189\000\000\000\000\000\000\000\000\002\189\000\000\n&\002\189\000\000\000\000\000\000\000\000\002\189\002\189\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\t\182\t\246\n.\n6\nF\002\189\002\189\000\000\000\000\002\189\000\000\002\189\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\nV\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\nv\002\189\n~\n>\002\189\002\189\000\000\000\000\002\189\n^\002\189\000\000\000\000\000\000\000\000\002\189\002\189\nf\nn\002\209\002\209\000\000\000\000\000\000\002\209\000\000\000\000\002\209\000\000\000\000\002\209\000\000\002\209\000\000\000\000\t\174\000\000\002\209\002\209\002\209\000\000\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\n\014\000\000\002\209\000\000\000\000\000\000\000\000\000\000\002\209\002\209\n\022\n\030\002\209\000\000\000\000\000\000\000\000\002\209\000\000\n&\002\209\000\000\000\000\000\000\000\000\002\209\002\209\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\209\002\209\t\182\t\246\n.\n6\nF\002\209\002\209\000\000\000\000\002\209\000\000\002\209\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\209\002\209\nV\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\nv\002\209\n~\n>\002\209\002\209\000\000\000\000\002\209\n^\002\209\000\000\000\000\000\000\000\000\002\209\002\209\nf\nn\002\205\002\205\000\000\000\000\000\000\002\205\000\000\000\000\002\205\000\000\000\000\002\205\000\000\002\205\000\000\000\000\t\174\000\000\002\205\002\205\002\205\000\000\002\205\002\205\002\205\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\n\014\000\000\002\205\000\000\000\000\000\000\000\000\000\000\002\205\002\205\n\022\n\030\002\205\000\000\000\000\000\000\000\000\002\205\000\000\n&\002\205\000\000\000\000\000\000\000\000\002\205\002\205\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\t\182\t\246\n.\n6\nF\002\205\002\205\000\000\000\000\002\205\000\000\002\205\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\nV\000\000\002\205\002\205\002\205\002\205\000\000\000\000\000\000\002\205\000\000\002\205\002\205\000\000\nv\002\205\n~\n>\002\205\002\205\000\000\000\000\002\205\n^\002\205\000\000\000\000\000\000\000\000\002\205\002\205\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\213\000\000\000\000\000\000\000\000\000\000\002\213\002\213\n\022\n\030\002\213\000\000\000\000\000\000\000\000\002\213\000\000\n&\002\213\000\000\000\000\000\000\000\000\002\213\002\213\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\t\182\t\246\n.\n6\nF\002\213\002\213\000\000\000\000\002\213\000\000\002\213\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\nV\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\nv\002\213\n~\n>\002\213\002\213\000\000\000\000\002\213\n^\002\213\000\000\000\000\000\000\000\000\002\213\002\213\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n\022\n\030\002\177\000\000\000\000\000\000\000\000\002\177\000\000\n&\002\177\000\000\000\000\000\000\000\000\002\177\002\177\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\t\182\t\246\n.\n6\nF\002\177\002\177\000\000\000\000\002\177\000\000\002\177\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\nV\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\nv\002\177\n~\n>\002\177\002\177\000\000\000\000\002\177\n^\002\177\000\000\000\000\000\000\000\000\002\177\002\177\nf\nn\002\001\002\001\000\000\000\000\000\000\002\001\000\000\000\000\002\001\000\000\000\000\002\001\000\000\002\001\000\000\000\000\002\001\000\000\002\001\002\001\002\001\000\000\002\001\002\001\002\001\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\000\000\002\001\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\000\000\002\001\000\000\002\001\002\001\000\000\000\000\000\000\000\000\002\001\002\001\002\001\000\000\000\000\000\000\000\000\000\000\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\000\002\001\002\001\000\000\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\000\000\002\001\002\001\002\001\002\001\000\000\000\000\000\000\002\001\000\000\002\001\002\001\000\000\002\001\002\001\002\001\002\001\002\001\002\001\000\000\000\000\002\001\002\001\r\226\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\029\002\029\000\000\000\000\000\000\002\029\000\000\000\000\002\029\000\000\000\000\002\029\000\000\002\029\000\000\000\000\t\174\000\000\002\029\002\029\002\029\000\000\002\029\002\029\002\029\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\n\014\000\000\002\029\000\000\000\000\000\000\000\000\000\000\002\029\002\029\n\022\n\030\002\029\000\000\000\000\000\000\000\000\002\029\000\000\n&\002\029\000\000\000\000\000\000\000\000\002\029\002\029\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\029\002\029\t\182\t\246\n.\n6\nF\002\029\002\029\000\000\000\000\002\029\000\000\002\029\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\029\002\029\nV\000\000\002\029\002\029\r\250\002\029\000\000\000\000\000\000\002\029\000\000\002\029\002\029\000\000\nv\002\029\n~\n>\002\029\002\029\000\000\000\000\002\029\n^\002\029\000\000\000\000\000\000\000\000\002\029\002\029\nf\nn\002\025\002\025\000\000\000\000\000\000\002\025\000\000\000\000\002\025\000\000\000\000\002\025\000\000\002\025\000\000\000\000\t\174\000\000\002\025\002\025\002\025\000\000\002\025\002\025\002\025\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\n\014\000\000\002\025\000\000\000\000\000\000\000\000\000\000\002\025\002\025\n\022\n\030\002\025\000\000\000\000\000\000\000\000\002\025\000\000\n&\002\025\000\000\000\000\000\000\000\000\002\025\002\025\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\025\002\025\t\182\t\246\n.\n6\nF\002\025\002\025\000\000\000\000\002\025\000\000\002\025\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\025\002\025\nV\000\000\002\025\002\025\002\025\002\025\000\000\000\000\000\000\002\025\000\000\002\025\002\025\000\000\nv\002\025\n~\n>\002\025\002\025\000\000\000\000\002\025\n^\002\025\000\000\000\000\000\000\000\000\002\025\002\025\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\n\022\n\030\002\173\000\000\000\000\000\000\000\000\002\173\000\000\n&\002\173\000\000\000\000\000\000\000\000\002\173\002\173\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\t\182\t\246\n.\n6\nF\002\173\002\173\000\000\000\000\002\173\000\000\002\173\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\nV\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\nv\002\173\n~\n>\002\173\002\173\000\000\000\000\002\173\n^\002\173\000\000\000\000\000\000\000\000\002\173\002\173\nf\nn\002\r\002\r\000\000\000\000\000\000\002\r\000\000\000\000\002\r\000\000\000\000\002\r\000\000\002\r\000\000\000\000\002\r\000\000\002\r\002\r\002\r\000\000\002\r\002\r\002\r\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\r\000\000\002\r\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\r\000\000\000\000\000\000\000\000\002\r\000\000\002\r\002\r\000\000\000\000\000\000\000\000\002\r\002\r\002\r\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\r\002\r\002\r\002\r\002\r\000\000\000\000\002\r\000\000\002\r\002\r\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\000\000\002\r\002\r\002\r\002\r\000\000\000\000\000\000\002\r\000\000\002\r\002\r\000\000\002\r\002\r\002\r\002\r\002\r\002\r\000\000\000\000\002\r\002\r\r\226\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\017\002\017\000\000\000\000\000\000\002\017\000\000\000\000\002\017\000\000\000\000\002\017\000\000\002\017\000\000\000\000\002\017\000\000\002\017\002\017\002\017\000\000\002\017\002\017\002\017\000\000\000\000\000\000\000\000\000\000\002\017\002\017\002\017\002\017\002\017\000\000\002\017\000\000\000\000\000\000\000\000\000\000\002\017\002\017\002\017\002\017\002\017\003\253\000\000\000\000\000\000\002\017\000\000\002\017\002\017\000\000\000\000\000\000\000\000\002\017\002\017\002\017\000\000\000\000\000\000\000\000\000\000\000\000\002\017\002\017\002\017\002\017\002\017\002\017\002\017\002\017\002\017\000\000\000\000\002\017\000\000\002\017\002\017\000\000\000\000\000\000\000\000\000\000\000\238\002\017\002\017\002\017\000\000\002\017\002\017\002\017\002\017\000\000\000\000\000\000\002\017\000\000\002\017\002\017\000\000\002\017\002\017\002\017\002\017\002\017\002\017\000\000\000\000\002\017\002\017\r\226\000\000\000\000\003\253\000\000\002\017\002\017\002\017\002\017\001\006\000\000\000\006\000\000\007\r\000\000\002\158\002\162\006\014\002\206\002f\005\206\b\214\000\000\000\000\002\218\001\n\012\181\006\026\000\000\002r\000\000\006&\007\r\000\000\001\210\000\000\007\r\000\000\003\026\001\018\bR\bV\001\030\001\"\000\000\000\000\012\181\003*\000\000\002\226\000\000\025\002\002\030\bz\b~\000\000\003\194\003\022\003\206\b\130\006\186\000\000\001:\000\000\002\150\002&\000\000\003\030\002*\012\161\000\000\007\254\b\002\b\014\b\"\000\000\005Z\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\b\150\001R\000\000\007\001\000\000\001V\000\000\b\162\b\186\t\014\005f\005j\000\000\000\000\001Z\000\000\000\000\000\000\007\r\000\000\001^\000\000\007\001\000\000\000\000\000\000\007\001\012\181\012\161\000\000\001\154\n\246\000\000\n\178\005n\b\022\n\190\001\158\000\000\014*\004V\t\"\001\006\001\166\000\006\001\170\001\174\012\181\002\158\002\162\000\000\002\206\002f\002\030\000\000\000\000\000\000\002\218\001\n\000\000\002\"\000\000\bN\000\000\000\238\000\000\002&\001\210\000\000\002*\012\161\003\026\001\018\bR\bV\001\030\001\"\000\000\000\000\000\000\003*\000\000\002\226\000\000\bZ\000\000\bz\b~\000\000\003\194\003\022\003\206\b\130\006\186\000\000\001:\000\000\002\150\006\229\000\000\003\030\000\000\000\000\000\000\007\254\b\002\b\014\b\"\006\014\005Z\000\000\005\206\001>\001B\001F\001J\001N\006\229\006\026\b\150\001R\006\229\006&\000\000\001V\000\000\b\162\b\186\t\014\005f\005j\000\000\000\000\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\005\250\000\000\000\000\005n\b\022\000\000\001\158\000\000\014*\004V\t\"\004m\001\166\000\006\001\170\001\174\000\246\002\158\002\162\002\166\002\206\002f\000\000\002\225\000\000\000\000\002\218\018f\000\000\003\150\000\000\000\000\000\000\004m\000\000\003\154\001\210\000\000\016\254\006\229\002\222\000\000\003\"\003&\000\000\000\000\000\000\003\158\000\000\003*\000\000\002\226\000\n\016\146\000\000\003\186\003\190\003\254\003\194\003\022\003\206\003\214\006\186\000\000\000\000\016\246\002\150\000\000\002\225\003\030\017\014\000\000\000\000\007\254\b\002\b\014\b\"\000\000\005Z\000\000\002\225\002\225\000\000\000\000\000\000\000\000\017\022\000\000\b\150\000\000\t\r\000\000\000\000\000\000\000\000\b\162\b\186\t\014\005f\005j\017*\017V\000\000\000\000\004m\004m\000\000\000\000\000\000\006J\024\206\000\000\t\r\000\000\000\000\015f\000\000\000\000\002f\000\000\017\146\021~\005n\b\022\024\238\000\173\000\000\b.\004V\t\"\000\173\000\000\002\162\000\173\000\000\002f\021&\tJ\000\000\000\000\002\218\000\000\000\000\000\173\000\000\000\173\000\000\000\173\000\000\000\173\001\210\000\238\tR\000\000\002\222\000\000\015j\000\000\000\000\000\000\tZ\000\173\000\000\000\000\000\000\002\226\000\000\000\173\000\000\000\000\015v\000\173\021J\003\022\001\190\015f\000\173\000\000\002f\000\173\002\150\000\000\000\000\003\030\000\173\000\173\000\173\007\254\b\002\b\014\000\000\012J\005Z\000\173\000\173\006\014\005j\000\000\005\206\024\210\000\173\000\000\000\000\t\r\000\173\006\026\021V\000\000\000\000\006&\000\000\000\000\005f\005j\000\173\000\173\015j\000\000\000\173\000\173\000\000\000\000\000\000\020\234\000\000\000\000\000\000\000\000\000\173\000\000\015v\000\000\021*\000\000\000\173\000\173\005n\b\022\000\000\000\000\000\197\b.\004V\000\000\000\173\000\197\000\173\002\162\000\197\000\000\002f\000\000\tJ\000\000\000\000\002\218\005j\000\000\000\197\000\000\000\197\000\000\000\197\000\000\000\197\001\210\0216\tR\000\000\002\222\003\178\000\000\002\162\000\000\000\000\tZ\000\197\000\000\b\182\003\142\002\226\000\000\000\197\020\234\000\000\007\198\000\197\000\000\003\022\001\190\001\210\000\197\000\000\000\000\000\197\002\150\000\000\000\000\003\030\000\197\000\197\000\197\007\254\b\002\b\014\000\000\012J\005Z\000\197\000\197\000\000\000\000\000\000\003\174\000\000\000\197\000\000\000\000\r\206\000\197\002\150\000\000\000\000\000\000\000\000\000\000\000\000\005f\005j\000\197\000\197\000\000\000\000\000\197\000\197\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\197\000\000\000\000\000\000\000\000\006\206\000\197\000\197\005n\b\022\000\000\000\000\000\000\b.\004V\000\000\000\197\000\000\000\197\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>\000\000\006\014\000\000\000B\005\206\000\000\012\181\012\161\000\000\000\000\000F\006\026\000\000\000\000\000\000\006&\000J\000\000\000N\000R\000V\000Z\000^\000b\000f\000\000\012\181\000\000\000j\000n\000\000\000r\002\030\000v\000\000\000\000\000\000\000\000\000\000\002\178\000\000\000\000\000\000\000\000\000\000\002&\000\000\000z\002*\012\161\000~\000\130\000\000\000\000\000\000\000\000\000\000\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\000\000\000\000\000\174\000\178\000\182\000\000\000\000\000\000\000\186\000\006\000\190\000\194\000\246\002\158\002\162\002\166\002\206\002f\000\198\000\000\000\202\000\000\002\218\000\000\000\000\004\141\000\206\000\210\000\000\000\214\000\000\003\154\001\210\000\000\000\000\000\000\002\222\000\000\003\"\003&\000\000\000\000\000\000\003\158\000\000\003*\000\000\002\226\000\000\016\146\000\000\003\186\003\190\000\000\003\194\003\022\003\206\003\214\006\186\000\000\000\000\016\246\002\150\000\000\000\000\003\030\017\014\000\000\000\000\007\254\b\002\b\014\b\"\000\000\005Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\022\000\000\b\150\000\000\027\222\000\000\000\000\000\000\000\000\b\162\b\186\t\014\005f\005j\017*\017V\000\000\000\006\027\255\014\190\000\246\002\158\002\162\002\166\002\206\002f\000\000\000\000\000\000\000\000\002\218\000\000\000\000\028.\000\000\021~\005n\b\022\014>\003\154\001\210\b.\004V\t\"\002\222\000\000\003\"\003&\000\000\000\000\000\000\003\158\000\000\003*\000\000\002\226\000\000\016\146\000\000\003\186\003\190\000\000\003\194\003\022\003\206\003\214\006\186\000\000\016R\016\246\002\150\000\000\000\000\003\030\017\014\002\006\000\000\007\254\b\002\b\014\b\"\000\000\005Z\000\000\000\000\002\n\000\000\000\000\000\000\000\000\017\022\000\000\b\150\001\210\027\222\000\000\000\000\000\000\000\000\b\162\b\186\t\014\005f\005j\017*\017V\000\000\000\000\004\149\000\000\003~\000\000\000\000\000\000\001\006\000\000\006\230\001\222\000\000\000\000\003:\002\162\b\246\002\150\002f\021~\005n\b\022\000\000\002\218\001\n\b.\004V\t\"\002r\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003Z\001\030\001\"\000\000\000\000\006\234\000\000\000\000\002\225\000\000\003^\002\225\001.\n\242\000\000\000\000\003V\001\190\0016\002\225\000\000\001:\000\000\002\150\000\000\000\000\003\218\000\000\000\000\002\225\003\222\000\000\003\230\005N\000\n\005Z\000\000\002\225\001>\001B\001F\001J\001N\000\000\000\000\000\n\001R\005^\000\000\002\225\001V\000\000\000\000\000\000\002\225\005f\005j\000\000\005\174\001Z\002\225\002\225\002\225\002\225\000\000\001^\000\000\002\225\000\000\000\000\000\000\000\000\000\000\002\225\000\000\001\154\n\246\011\002\000\000\005n\000\000\000\000\001\158\000\000\001\162\004V\001\006\000\000\001\166\002\225\001\170\001\174\003:\002\162\n\150\002\225\002f\011\006\000\000\000\000\000\000\002\218\001\n\000\000\000\000\000\000\002r\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003Z\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003^\000\000\001.\n\242\000\000\000\000\003V\001\190\0016\000\000\000\238\001:\000\000\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005^\000\000\000\000\001V\007\173\000\000\000\000\000\000\005f\005j\000\000\005\174\001Z\000\000\000\000\000\000\000\000\006\014\001^\000\000\005\206\011\n\000\000\000\000\000\000\000\000\000\000\006\026\001\154\n\246\000\000\006&\005n\000\000\007\173\001\158\000\000\001\162\004V\001\006\000\000\001\166\000\000\001\170\001\174\003:\002\162\r\142\007\173\002f\000\000\007\173\b\138\000\000\002\218\001\n\000\000\000\000\007\173\002r\000\000\000\000\007\173\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003Z\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003^\000\000\001.\n\242\000\000\000\000\003V\001\190\0016\n\181\000\000\001:\000\000\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005^\000\000\n\181\001V\000\000\000\000\000\000\000\000\005f\005j\000\000\005\174\001Z\000\000\000\000\000\000\n\181\000\000\001^\n\181\011j\000\000\000\000\000\000\000\000\000\000\n\181\000\000\001\154\n\246\n\181\000\000\005n\000\000\000\000\001\158\000\000\001\162\004V\000\000\b\249\001\166\000\006\001\170\001\174\000\000\002\158\002\162\000\000\002\206\002f\000\000\000\000\000\000\000\000\002\218\000\000\000\000\000\000\000\000\b\249\000\000\b\249\b\249\000\000\001\210\000\000\000\000\000\000\002\222\000\000\003\"\003&\000\000\000\000\000\000\000\000\b\001\003*\000\000\002\226\000\000\b\001\000\000\003\186\003\190\n\194\003\194\003\022\003\206\003\214\006\186\001\202\001\206\011\"\002\150\000\000\000\000\003\030\000\000\000\000\b\001\007\254\b\002\b\014\b\"\000\000\005Z\000\000\000\000\000\000\001\210\002\142\001\230\000\000\000\000\000\000\b\150\000\000\000\000\000\000\001\242\000\000\b\001\b\162\b\186\t\014\005f\005j\000\000\000\000\b\001\000\000\000\000\001\246\002v\b\001\b\001\000\238\002\130\000\000\002\150\004\002\004\014\000\000\b\001\b\001\000\000\004\026\000\000\000\000\005n\b\022\b\249\004\253\004\253\b.\004V\t\"\004\253\000\000\004\253\004\253\000\000\004\253\004\030\004\253\004\253\b\001\000\000\004\253\b\001\004\253\004\253\004\253\004\253\004\253\004\253\004\253\004\253\b\001\004\253\016b\004\253\000\000\000\000\000\000\000\000\000\000\002\006\004\253\000\000\000\000\000\000\000\000\004\253\004\253\004\253\000\000\002\n\004\253\004\253\004\253\004\253\000\000\004\253\000\000\001\210\004\253\000\000\000\000\000\000\000\000\004\253\004\253\004\253\000\000\000\000\004\253\004\253\004\253\000\000\004\253\004\253\003~\000\000\000\000\000\000\000\000\004\253\006\230\001\222\000\000\004\253\004\253\000\000\004\253\002\150\004\253\000\000\000\000\000\000\000\000\004\253\004\253\004\253\000\000\004\253\004\253\004\253\004\253\000\000\004\253\004\253\000\000\000\000\000\000\004\253\000\000\004\253\004\253\000\000\000\000\002z\004\253\006\234\000\000\000\000\019\254\004\253\000\000\n\205\000\000\004\253\n\205\004\253\004\253\n\205\n\205\000\000\004\253\n\205\000\000\n\205\000\000\000\000\n\205\000\000\000\000\000\000\n\205\n\205\000\000\n\205\n\205\000\000\n\205\000\000\n\205\000\000\025\026\002\225\002\225\n\205\000\000\000\000\n\205\002\006\000\000\000\000\000\000\000\000\000\000\000\000\n\205\000\000\n\205\002\n\000\000\n\205\n\205\002\225\000\000\000\000\000\000\001\210\n\205\002\225\000\n\n\205\000\000\000\000\n\205\n\205\002\225\n\205\000\000\n\205\n\205\000\000\002\225\000\000\003~\002\225\002\225\000\000\000\000\000\000\006\230\001\222\n\205\000\000\000\000\000\000\000\000\002\150\002\225\000\000\n\205\n\205\000\000\000\000\n\205\000\000\n\205\000\000\000\000\000\000\000\000\005\138\000\000\000\000\000\000\000\000\001\202\001\206\n\205\n\205\000\000\n\205\n\205\000\000\n\205\006\234\n\205\000\000\n\205\000\000\n\205\000\000\n\205\b\229\b\229\001\210\001\214\001\230\b\229\000\000\001\206\b\229\000\000\000\000\000\000\001\242\000\000\000\000\018\146\b\229\000\000\b\229\b\229\b\229\000\000\b\229\b\229\b\229\001\246\019\250\000\000\019\026\000\000\002\130\000\000\002\150\004\002\004\014\000\000\b\229\000\000\000\000\020\n\000\000\000\000\b\229\b\229\000\000\000\000\b\229\000\000\000\000\002~\000\000\b\229\000\000\000\000\b\229\000\000\004\030\000\000\000\000\b\229\b\229\b\229\000\000\000\000\000\000\000\000\000\000\000\000\b\229\b\229\000\000\000\000\000\000\000\000\000\000\b\229\000\000\000\000\000\000\004~\000\000\000\000\b\229\000\000\000\000\000\000\000\000\000\000\000\000\b\229\b\229\b\229\000\000\b\229\b\229\000\000\004Y\000\000\000\000\000\000\000\000\004Y\000\000\b\229\004Y\b\229\b\229\000\000\000\000\000\000\b\229\000\000\000\000\000\000\004Y\b\229\000\000\000\000\004Y\b\229\004Y\b\229\b\229\012u\012u\000\000\000\000\004Y\012u\000\000\001\206\012u\004Y\000\000\000\000\000\000\000\000\000\000\004Y\004\158\000\000\012u\012u\012u\004&\012u\012u\012u\000\000\000\000\004Y\004Y\000\000\000\000\000\000\004Y\002\198\000\000\000\000\012u\000\000\000\000\000\000\000\000\000\000\012u\012u\000\000\000\000\012u\000\000\004Y\002~\004Y\012u\000\000\000\000\012u\000\000\000\000\000\000\004Y\012u\012u\012u\004Y\004Y\002\198\000\238\004Y\004Y\012u\012u\000\000\000\000\0046\004Y\000\000\012u\000\000\000\000\000\000\004~\000\000\000\000\012u\004Y\000\000\000\000\000\000\000\000\020\254\012u\012u\012u\000\000\012u\012u\000\000\004Y\000\000\004Y\000\000\000\000\004Y\000\000\012u\004Y\012u\012u\004Y\000\000\000\000\012u\000\000\000\000\000\000\004Y\012u\000\000\000\000\004Y\012u\004Y\012u\012u\b\233\b\233\000\000\000\000\000\000\b\233\000\000\001\206\b\233\004Y\000\000\000\000\000\000\000\000\000\000\004Y\b\233\000\000\b\233\b\233\b\233\000\000\b\233\b\233\b\233\000\000\000\000\004Y\000\000\000\000\000\000\000\000\004Y\002\198\000\000\000\000\b\233\000\000\000\000\000\000\000\000\000\000\b\233\b\233\000\000\000\000\b\233\000\000\004Y\002~\000\000\b\233\000\000\000\000\b\233\000\000\000\000\000\000\000\000\b\233\b\233\b\233\004Y\004Y\000\000\000\000\004Y\004Y\b\233\b\233\002\225\000\000\007R\000\000\000\000\b\233\000\000\002\225\000\000\004~\000\000\000\000\b\233\004Y\000\000\000\000\000\000\000\000\002\225\b\233\b\233\b\233\002\225\b\233\b\233\001*\000\n\002\225\002\225\002\225\000\000\000\000\002\225\b\233\002\225\b\233\b\233\002\225\002\225\002\225\b\233\002\225\002\225\002\225\002\225\b\233\002\225\002\225\002\225\b\233\002\225\b\233\b\233\000\000\002\225\000\n\000\000\002\225\000\n\002\225\000\000\002\225\000\000\002\225\002\225\000\n\000\000\002\225\002\225\000\n\002\225\002\225\002\225\002\225\000\000\000\000\002\225\002\225\000\000\002\225\002\225\002\225\002\225\002\225\002\225\000\000\002\225\002\225\000\000\002\225\002\225\002\225\000\000\002\225\002\225\002\225\002\225\002\225\002\225\002\225\000\000\002\225\000\000\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\002\225\002\225\002\225\002\225\002\225\000\000\006\141\000\000\0009\002\225\002\225\000\000\0009\0009\000\000\0009\0009\002\225\000\000\000\000\000\000\0009\000\000\002\225\000\000\003\162\006\141\002\225\002\225\000\000\000\000\0009\002\225\002\225\002\225\0009\006\194\0009\0009\000\000\000\000\000\000\000\000\000\000\0009\000\000\0009\000\000\000\000\000\000\0009\0009\000\000\0009\0009\0009\0009\0009\000\000\000\000\000\000\0009\000\000\000\000\0009\000\000\000\000\000\000\0009\0009\0009\0009\000\000\0009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0009\000\000\000\000\000\000\000\000\000\000\000\000\0009\0009\0009\0009\0009\000\000\006\137\000\000\0005\000\000\000\000\000\000\0005\0005\000\000\0005\0005\000\000\000\000\000\000\000\000\0005\000\000\000\000\000\000\000\000\006\137\0009\0009\000\000\000\000\0005\0009\0009\0009\0005\000\000\0005\0005\000\000\000\000\000\000\000\000\000\000\0005\000\000\0005\000\000\000\000\000\000\0005\0005\000\000\0005\0005\0005\0005\0005\000\000\000\000\000\000\0005\000\000\000\000\0005\000\000\000\000\000\000\0005\0005\0005\0005\000\000\0005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0005\000\000\000\000\000\000\000\000\000\000\000\000\0005\0005\0005\0005\0005\000\000\006\153\000\000\012=\000\000\000\000\000\000\012=\012=\000\000\012=\012=\000\000\000\000\000\000\000\000\012=\000\000\000\000\000\000\000\000\006\153\0005\0005\000\000\000\000\012=\0005\0005\0005\012=\000\000\012=\012=\000\000\000\000\000\000\000\000\000\000\012=\000\000\012=\000\000\000\000\000\000\012=\012=\000\000\012=\012=\012=\012=\012=\000\000\000\000\000\000\012=\000\000\000\000\012=\000\000\000\000\000\000\012=\012=\012=\012=\000\000\012=\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\012=\012=\012=\012=\012=\000\000\006\149\000\000\0129\000\000\000\000\000\000\0129\0129\000\000\0129\0129\000\000\000\000\000\000\000\000\0129\000\000\000\000\000\000\000\000\006\149\012=\012=\000\000\000\000\0129\012=\012=\012=\0129\000\000\0129\0129\000\000\000\000\000\000\000\000\000\000\0129\000\000\0129\000\000\000\000\000\000\0129\0129\000\000\0129\0129\0129\0129\0129\000\000\001\202\001\206\0129\000\000\000\000\0129\000\000\000\000\000\000\0129\0129\0129\0129\000\000\0129\000\000\000\000\000\000\000\000\001\210\001\214\001\230\000\000\000\000\0129\000\000\000\000\000\000\000\000\001\242\000\000\0129\0129\0129\0129\0129\001\250\000\000\000\000\000\000\000\000\000\000\001\246\002v\000\000\000\000\000\000\002\130\000\000\002\150\004\002\004\014\012y\012y\000\000\000\000\004\026\012y\0129\0129\012y\000\000\000\000\0129\0129\0129\000\000\000\000\004n\000\000\012y\012y\012y\004\030\012y\012y\012y\000\000\001\021\000\000\000\000\000\000\000\000\001\021\000\000\000\000\000\000\000\000\012y\000\000\000\000\000\000\000\000\000\000\012y\012y\000\000\000\000\012y\000\000\000\000\000\000\001\021\012y\000\000\000\000\012y\000\000\000\000\000\000\000\000\012y\012y\012y\000\000\000\000\000\000\000\000\000\000\000\000\012y\012y\000\000\000\000\001\021\000\000\018\154\012y\000\000\000\000\000\000\012y\001\021\000\000\012y\000\000\000\000\001\021\000\000\000\000\000\000\012y\012y\012y\000\000\012y\012y\001\021\000\000\000\000\000\000\000\000\000\000\000\000\007\253\012y\000\006\012y\012y\007\253\002\158\002\162\012y\002\206\002f\000\000\000\000\012y\000\000\002\218\000\000\012y\001\021\012y\012y\000\000\003\226\000\000\007\253\001\210\000\000\001\021\000\000\002\222\000\000\003\"\003&\000\000\000\000\000\000\000\000\000\000\003*\000\000\002\226\000\000\000\000\000\000\003\186\003\190\007\253\003\194\003\022\003\206\003\214\006\186\000\000\000\000\007\253\002\150\000\000\000\000\003\030\007\253\007\253\000\238\007\254\b\002\b\014\b\"\000\000\005Z\007\253\007\253\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\150\000\000\000\000\000\000\000\000\000\000\000\000\b\162\b\186\t\014\005f\005j\000\000\000\000\007\253\000\000\000\000\007\253\000\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\007\253\002\158\002\162\000\000\002\206\002f\000\000\000\000\005n\b\022\002\218\000\000\000\000\b.\004V\t\"\000\000\014R\000\000\000\000\001\210\000\000\000\000\000\000\002\222\000\000\003\"\003&\000\000\000\000\000\000\001\197\000\000\003*\000\000\002\226\001\197\000\000\000\000\003\186\003\190\000\000\003\194\003\022\003\206\003\214\006\186\000\000\000\000\000\000\002\150\000\000\000\000\003\030\000\000\001\197\000\000\007\254\b\002\b\014\b\"\000\000\005Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005-\012\217\b\150\000\000\000\000\0051\012\217\001\197\000\000\b\162\b\186\t\014\005f\005j\000\000\001\197\000\000\000\000\000\000\005-\001\197\001\197\000\238\005-\0051\000\000\003\029\003\029\0051\001\197\001\197\003\029\000\000\000\000\003\029\000\000\005n\b\022\000\000\000\000\000\000\b.\004V\t\"\003\029\003\029\003\029\000\000\003\029\003\029\003\029\000\000\000\000\000\000\000\000\001\197\000\000\000\000\000\000\000\000\000\000\000\000\003\029\000\000\001\197\000\000\000\000\000\000\003\029\004f\000\000\000\000\003\029\000\000\000\000\000\000\000\000\003\029\012\217\012\217\003\029\000\000\000\000\012\217\012\217\003\029\003\029\003\029\000\000\000\000\000\000\005-\000\000\000\000\003\029\003\029\0051\012\217\000\000\012\217\000\000\003\029\012\217\000\000\012\217\003\029\005-\000\000\003\029\005-\000\000\0051\000\000\000\000\0051\003\029\003\029\003\029\004}\003\029\003\029\000\000\000\000\018\170\000\000\000\000\000\000\000\000\000\000\003\029\000\000\003\029\003\029\000\000\000\000\000\000\003\029\000\000\000\000\000\000\000\000\003\029\003\154\n\217\000\000\003\029\n\217\003\029\003\029\003:\002\162\000\000\000\000\002f\000\000\006\138\000\000\000\000\002\218\000\000\000\000\000\000\n\217\n\217\018\214\n\217\n\217\000\000\001\210\000\000\006\170\000\000\016\246\000\000\000\000\003>\000\000\017\014\b\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\217\019\018\003J\000\000\000\000\003V\001\190\000\000\000\000\000\000\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\n\217\003\222\000\000\003\230\005N\n\162\005Z\000\000\004}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019v\005^\001\202\001\206\000\000\000\000\000\000\000\000\000\000\005f\005j\000\000\005\174\n\217\000\000\n\217\000\000\000\000\000\000\000\000\000\000\001\210\001\214\000\000\000\000\000\000\000\000\n\217\000\000\000\000\n\217\n\217\000\000\005n\000\000\n\217\000\000\n\217\000\000\004V\n\213\n\217\000\000\n\213\001\246\002\134\003:\002\162\000\000\002\130\002f\002\150\004\002\004\014\000\000\002\218\000\000\000\000\004\026\n\213\n\213\000\000\n\213\n\213\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003>\000\000\000\000\004\030\000\000\000\000\025\250\000\000\000\000\000\000\000\000\n\213\000\000\003J\000\000\000\000\003V\001\190\000\000\000\000\000\000\000\000\025\230\002\150\000\000\000\000\003\218\000\000\000\000\n\213\003\222\000\000\003\230\005N\000\000\005Z\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\012Y\000\000\000\000\012Y\000\000\000\000\005f\005j\000\000\005\174\n\213\000\000\n\213\012Y\000\000\000\000\000\000\000\000\000\000\012Y\000\000\001\221\001\221\000\000\n\213\000\000\001\221\n\213\n\213\001\221\005n\012Y\n\213\000\000\n\213\000\000\004V\012Y\n\213\001\221\001\221\001\221\000\000\001\221\001\221\001\221\012Y\000\000\000\000\012Y\000\000\000\000\000\000\000\000\012Y\000\000\000\000\001\221\000\000\000\000\000\000\000\000\000\000\001\221\001\221\000\000\000\000\001\221\000\000\000\000\012Y\000\000\001\221\000\000\012Y\001\221\000\000\000\000\000\000\000\000\001\221\001\221\001\221\000\000\012Y\012Y\000\000\000\000\012Y\001\221\001\221\000\000\000\000\000\000\027\214\000\000\001\221\001\r\000\000\000\000\001\221\000\000\001\r\001\221\000\000\012Y\000\000\000\000\000\000\000\000\001\221\001\221\001\221\000\000\001\221\001\221\000\000\000\000\000\000\000\000\000\000\001\r\000\000\000\000\001\221\000\000\001\221\001\221\003:\002\162\000\000\001\221\002f\000\000\006\138\000\000\001\221\002\218\000\000\000\000\004\226\000\000\001\221\001\r\000\000\0036\000\000\001\210\000\000\006\170\000\000\001\r\000\000\000\000\003>\000\000\001\r\b\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\r\001\r\003J\000\000\000\000\n\146\001\190\000\000\000\000\000\000\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\n\177\003\222\000\000\003\230\000\000\n\162\005Z\000\000\001\r\000\000\003:\002\162\000\000\000\000\002f\000\000\006\138\001\r\005^\002\218\000\000\000\000\000\000\000\000\000\000\000\000\005f\005j\000\000\001\210\n\170\006\170\000\000\000\000\000\000\000\000\003>\000\000\000\000\b\198\000\000\000\000\000\000\000\000\n\177\n\178\000\000\n\177\011\030\003J\005n\000\000\n\146\001\190\n\177\000\000\004V\000\000\n\177\002\150\000\000\000\000\003\218\000\000\000\000\n\177\003\222\000\000\003\230\000\000\n\162\005Z\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\000\000\000\000\000\005f\005j\000\000\000\000\n\170\005}\005}\000\000\000\000\000\000\005}\000\000\000\000\005}\000\000\000\000\000\000\000\000\n\177\000\000\000\000\n\177\n\177\005}\005n\005}\000\000\005}\n\177\005}\004V\000\000\n\177\000\000\000\000\000\000\000\000\000\000\000\000\000\246\000\000\005}\002\166\000\000\000\000\000\000\000\000\005}\005}\000\000\000\000\000\000\028.\005}\000\000\000\000\005}\000\000\003\154\005}\000\000\000\000\000\000\000\000\005}\005}\005}\000\000\000\000\000\000\003\158\000\000\000\000\000\000\000\000\000\000\016\146\000\000\000\000\000\000\005}\005}\000\000\000\000\005}\024>\000\000\001\006\016\246\000\000\000\000\000\000\000\000\017\014\005}\005}\005}\000\000\005}\005}\000\000\000\000\000\000\001\n\007R\000\000\000\000\002r\000\000\017\022\000\000\005}\000\000\027\222\005}\005}\001\014\001\018\001\022\001\026\001\030\001\"\000\000\017*\017V\000\000\005}\004\149\000\000\001&\000\000\001.\0012\000\000\000\000\000\000\000\000\0016\004a\000\000\001:\000\000\000\000\000\246\021~\000\000\002\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\150\001>\001B\001F\001J\001N\003\154\005q\005q\001R\000\000\000\000\005q\001V\000\000\005q\000\000\000\000\017\154\000\000\000\000\000\000\001Z\000\000\017\194\005q\000\000\005q\001^\005q\000\000\005q\000\000\000\000\000\000\000\000\016\246\000\000\001\154\027\018\000\000\017\014\000\000\005q\000\000\001\158\000\000\001\162\000\000\005q\005q\001\166\000\000\001\170\001\174\007\194\000\000\018>\005q\000\000\000\000\005q\000\000\000\000\000\000\000\000\005q\005q\000\238\000\000\000\000\017*\018R\000\000\000\000\004a\004a\000\000\000\000\000\000\000\000\000\000\005q\005q\000\000\000\000\005q\000\000\b\245\000\000\000\000\000\000\018b\000\000\000\000\000\000\005q\005q\005q\000\000\005q\005q\000\000\000\000\t\174\000\000\000\000\012\030\b\245\000\000\b\245\b\245\000\000\005q\000\000\000\000\005q\005q\t\230\t\254\n\006\t\238\n\014\000\000\000\000\001\202\002b\000\000\005q\002f\000\000\000\000\n\022\n\030\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n&\000\000\000\000\001\210\001\214\001\230\002j\000\000\000\238\000\000\000\000\000\000\000\000\001\242\001\006\000\000\000\000\t\182\t\246\n.\n6\nF\000\000\000\000\000\000\000\000\002n\002v\000\000\nN\001\n\002\130\000\000\002\150\004\002\004\014\000\000\000\000\nV\000\000\020\214\000\000\020\218\001\014\001\018\001\022\001\026\001\030\001\"\000\000\000\000\000\000\nv\000\000\n~\n>\001&\004\030\001.\0012\b\245\n^\000\000\000\000\0016\000\000\005j\001:\000\000\nf\nn\000\000\000\000\000\000\000\000\000\000\020\230\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\001B\001F\001J\001N\000\000\003]\003]\001R\020\234\000\000\003]\001V\000\000\003]\000\000\000\000\000\000\000\000\000\000\000\000\001Z\000\000\000\000\003]\000\000\003]\001^\003]\000\000\003]\000\000\000\000\000\000\000\000\000\000\000\000\001\154\027.\000\000\000\000\000\000\003]\000\000\001\158\000\000\001\162\000\000\003]\003]\001\166\000\000\001\170\001\174\005\005\000\000\000\000\003]\000\000\000\000\003]\000\000\000\000\000\000\000\000\003]\003]\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\003]\000\000\001\202\001\206\003]\bq\bq\000\000\000\000\000\000\bq\000\000\000\000\bq\003]\003]\003]\000\000\003]\003]\000\000\001\210\001\214\bq\005\005\bq\000\000\bq\000\000\bq\000\000\003]\000\000\000\000\000\000\003]\000\000\000\000\000\000\000\000\000\000\bq\000\000\000\000\001\246\002~\003]\bq\bq\002\130\000\000\002\150\004\002\004\014\000\000\000\000\bq\000\000\004\026\bq\015\130\000\000\000\000\000\000\bq\bq\bq\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\030\000\000\000\000\000\000\000\000\bq\000\000\000\000\000\000\bq\r%\r%\000\000\000\000\000\000\r%\000\000\000\000\r%\bq\bq\bq\000\000\bq\bq\000\000\000\000\000\000\r%\000\000\r%\000\000\r%\bq\r%\000\000\bq\000\000\000\000\000\000\bq\000\000\000\000\000\000\000\000\000\000\r%\000\000\000\000\004\226\000\000\bq\r%\r%\r)\r)\000\000\000\000\004&\r)\000\000\r%\r)\000\000\r%\000\000\000\000\000\000\000\000\r%\r%\r%\r)\000\000\r)\000\000\r)\000\000\r)\000\000\000\000\000\000\000\000\000\000\000\000\r%\000\000\000\000\000\000\r%\r)\000\000\000\000\000\000\000\000\000\000\r)\r)\000\000\r%\r%\r%\004&\r%\r%\r)\000\000\000\000\r)\0046\000\000\000\000\000\000\r)\r)\r)\r%\000\000\000\000\000\000\r%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r)\000\000\r%\000\000\r)\003]\003]\000\000\000\000\000\000\003]\000\000\000\000\003]\r)\r)\r)\000\000\r)\r)\000\000\000\000\000\000\003]\0046\003]\000\000\003]\000\000\003]\000\000\r)\001\202\001\206\000\000\r)\000\000\000\000\000\000\000\000\000\000\003]\000\000\000\000\000\000\000\000\r)\003]\003]\000\000\000\000\001\210\001\214\005\t\000\000\000\000\003]\000\000\000\000\003]\000\000\000\000\000\000\000\000\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\246\002\134\000\000\000\000\000\000\002\130\003]\002\150\004\002\004\014\003]\001\205\000\000\000\000\004\026\000\000\001\205\000\000\001\206\001\205\003]\003]\003]\000\000\003]\003]\000\000\b\209\000\000\001\205\005\t\004\030\000\000\001\205\004\205\001\205\000\000\003]\000\000\000\000\000\000\003]\000\000\004Y\000\000\000\000\000\000\001\205\004Y\000\000\025\230\000\000\003]\001\205\001\205\000\000\000\000\000\000\000\000\000\000\002~\000\000\001\205\000\000\000\000\001\205\000\000\004Y\000\000\000\000\001\205\001\205\001\205\000\000\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\205\001\205\000\000\004Y\004~\003A\000\000\000\000\000\000\000\000\003A\004Y\001\206\003A\001\205\001\205\004Y\002\198\001\205\001\205\000\000\b\205\000\000\003A\000\000\004Y\004Y\003A\001\205\003A\000\000\000\000\000\000\000\000\000\000\001\205\000\000\000\000\000\000\000\000\001\205\003A\000\000\000\000\000\000\000\000\001\205\003A\001\201\000\000\000\181\004Y\000\000\000\000\002~\000\181\003A\000\000\000\181\003A\004Y\000\000\000\000\000\000\003A\003A\003A\000\000\000\181\000\000\000\181\000\000\000\181\000\000\000\181\000\000\000\000\000\000\000\000\000\000\003A\003A\000\000\000\000\004~\000\000\000\181\000\000\000\000\000\000\000\000\000\000\000\181\000\000\003A\003A\000\181\000\000\003A\003A\000\000\000\181\000\000\000\000\000\181\000\000\000\000\000\000\003A\000\181\000\181\000\238\000\000\000\000\000\000\003A\000\000\000\000\000\181\000\181\003A\000\000\000\000\000\000\000\000\000\181\003A\000\000\000\249\000\181\000\000\000\000\000\000\000\249\000\000\000\000\000\249\000\000\000\000\000\181\000\181\000\000\000\000\000\181\000\181\000\000\000\249\000\000\000\249\000\000\000\249\000\000\000\249\000\181\000\000\000\000\000\000\000\000\000\000\000\181\000\181\000\000\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\181\000\249\000\181\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\249\000\249\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\249\000\249\000\000\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\189\000\249\000\000\000\000\000\000\000\189\000\000\000\000\000\189\000\000\000\000\000\249\000\249\000\000\000\000\000\249\000\249\000\000\000\189\000\000\000\189\000\000\000\189\000\000\000\189\000\249\000\000\000\000\000\000\000\000\000\000\000\249\000\249\000\000\000\000\000\000\000\189\000\000\000\000\000\000\000\000\000\249\000\189\000\249\000\000\000\000\000\189\000\000\000\000\000\000\000\000\000\189\000\000\000\000\000\189\000\000\000\000\000\000\000\000\000\189\000\189\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\189\000\189\000\000\000\000\000\000\000\000\000\000\000\189\000\000\000\000\000\185\000\189\000\000\000\000\006\221\000\185\000\000\000\000\000\185\006\221\000\000\000\189\000\189\000\000\000\000\000\189\000\189\000\000\000\185\000\000\000\185\000\000\000\185\000\000\000\185\000\189\000\000\000\000\006\221\000\000\000\000\000\189\000\189\000\000\000\000\000\000\000\185\000\000\000\000\000\000\000\000\000\189\000\185\000\189\000\000\000\000\000\185\000\000\000\000\000\000\006\221\000\185\000\000\000\000\000\185\000\000\000\000\000\000\006\221\000\185\000\185\000\238\000\000\006\221\006\221\000\238\000\000\000\000\000\185\000\185\000\000\000\000\006\221\006\221\000\000\000\185\000\000\000\000\001\169\000\185\000\000\000\000\000\000\001\169\000\000\000\000\001\169\000\000\000\000\000\185\000\185\000\000\000\000\000\185\000\185\000\000\001\169\000\000\006\221\000\000\001\169\012\229\001\169\000\185\000\000\000\000\012\229\006\221\000\000\000\185\000\185\000\000\000\000\000\000\001\169\001\169\000\000\000\000\000\000\000\185\001\169\000\185\000\000\023\158\000\000\012\229\005\005\000\000\000\000\001\169\000\000\000\000\001\169\000\000\000\000\000\000\000\000\001\169\001\169\001\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\229\000\000\000\000\000\000\000\000\000\000\001\169\000\000\012\229\000\000\001\169\r!\r!\012\229\012\229\000\238\r!\000\000\000\000\r!\001\169\001\169\012\229\012\229\001\169\001\169\000\000\000\000\000\000\r!\005\005\r!\000\000\r!\001\169\r!\000\000\000\000\000\000\000\000\001\169\001\169\000\000\000\000\000\000\000\000\001\169\r!\012\229\000\000\000\000\000\000\001\169\r!\r!\000\000\000\000\012\229\000\000\000\000\000\000\000\000\r!\000\000\000\000\r!\000\000\000\000\000\000\000\000\r!\r!\r!\000\000\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\r!\r\029\r\029\000\000\000\000\000\000\r\029\000\000\000\000\r\029\r!\r!\r!\000\000\r!\r!\000\000\000\000\000\000\r\029\000\000\r\029\000\000\r\029\000\000\r\029\000\000\r!\000\000\000\000\000\000\r!\000\000\000\000\000\000\000\000\000\000\r\029\000\000\000\000\004\226\000\000\r!\r\029\r\029\000\000\000\000\000\000\000\000\000\000\000\000\004a\r\029\000\000\000\000\r\029\000\246\000\000\000\000\002\018\r\029\r\029\r\029\000\000\000\000\000\000\000\000\000\000\000\000\017\150\000\000\000\000\000\000\004a\000\000\003\154\r\029\000\000\bu\bu\r\029\000\000\000\000\bu\000\000\000\000\bu\017\154\000\000\000\000\r\029\r\029\r\029\017\194\r\029\r\029\bu\000\000\bu\000\000\bu\000\000\bu\000\000\007.\016\246\000\000\r\029\000\000\000\000\017\014\r\029\000\000\000\000\bu\000\000\000\000\000\000\000\000\000\000\bu\bu\r\029\000\000\000\000\000\000\018>\000\000\000\000\bu\000\000\000\000\bu\000\000\000\000\000\000\000\000\bu\bu\000\238\017*\018R\000\000\000\000\004a\004a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bu\000\000\000\000\000\000\bu\000\000\006\241\000\000\018b\000\000\000\000\000\000\000\000\000\000\bu\bu\bu\000\000\bu\bu\000\000\000\000\t\174\000\000\000\000\006\241\000\000\000\000\bu\006\241\000\000\bu\000\000\000\000\000\000\bu\t\230\t\254\n\006\t\238\n\014\000\000\000\000\000\000\000\000\000\000\bu\001\201\000\000\000\000\n\022\n\030\001\201\000\000\001\206\001\201\000\000\000\000\000\000\n&\000\000\000\000\000\000\b\205\000\000\001\201\000\000\000\238\000\000\001\201\000\000\001\201\000\000\000\000\000\000\000\000\t\182\t\246\n.\n6\nF\000\000\000\000\001\201\000\000\000\000\000\000\006\241\nN\001\201\000\000\000\000\000\000\000\000\000\000\000\000\002~\nV\001\201\000\000\000\000\001\201\000\000\000\000\000\000\000\000\001\201\001\201\001\201\000\000\000\000\nv\000\000\n~\n>\000\000\000\000\000\000\000\000\000\000\n^\000\000\001\201\001\201\000\000\000\000\004~\000\000\nf\nn\000\000\000\000\000\000\016F\000\000\000\000\001\201\001\201\000\000\000\000\001\201\001\201\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\174\001\201\000\000\000\000\016J\000\000\000\000\000\000\001\201\000\000\000\000\000\000\000\000\001\201\t\230\t\254\n\006\t\238\n\014\001\201\000\000\000\000\000\000\000\000\000\000\n\182\000\000\000\000\n\022\n\030\000\246\001\202\001\206\002\018\000\000\000\000\000\000\n&\000\000\000\000\000\000\000\000\000\000\017\150\000\000\000\238\000\000\004a\000\000\003\154\001\210\001\214\001\230\000\000\t\182\t\246\n.\n6\nF\000\000\001\242\017\154\000\000\000\000\000\000\000\000\nN\017\194\000\000\000\000\000\000\000\000\000\000\001\246\002v\nV\000\000\000\000\002\130\016\246\002\150\004\002\004\014\000\000\017\014\000\000\000\000\004\026\000\000\nv\016N\n~\n>\016^\000\000\000\000\000\000\000\000\n^\000\000\018>\000\000\000\000\000\000\004\030\000\000\nf\nn\005\169\005\169\000\000\000\000\000\000\005\169\017*\018R\005\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\169\000\000\005\169\000\000\005\169\000\000\005\169\000\000\000\000\018b\000\000\000\000\000\000\000\000\004R\000\000\004V\000\000\005\169\000\000\000\000\000\000\000\000\000\000\005\169\005\169\000\000\000\000\000\000\000\000\007\194\000\000\000\000\005\169\000\000\000\000\005\169\000\000\006I\000\000\000\000\005\169\005\169\000\238\000\000\002\162\000\000\000\000\002f\000\000\000\000\000\000\000\000\002\218\000\000\002\225\002\225\005\169\006I\002\225\000\000\005\169\000\000\001\210\002\225\000\000\000\000\002\222\000\000\000\000\002\225\005\169\005\169\005\169\002\225\005\169\005\169\000\000\002\226\000\000\000\000\002\225\000\n\000\000\000\000\006\190\003\022\001\190\005\169\000\000\000\000\015\030\005\169\002\150\002\225\000\000\003\030\002\225\002\225\000\000\007\254\b\002\b\014\005\169\002\225\005Z\000\000\002\225\000\000\000\000\002\225\002\225\000\000\002\225\002\225\000\000\002\225\000\000\000\000\000\000\000\000\000\000\005\165\007\002\000\000\005f\005j\005\165\002\225\000\000\005\165\000\000\000\000\000\000\000\000\000\000\002\225\002\225\000\000\015Z\005\165\000\000\005\165\000\000\005\165\000\000\005\165\000\000\000\000\005n\b\022\000\000\000\000\000\000\b.\004V\000\000\000\000\005\165\000\000\002\225\000\000\000\000\000\000\005\165\007n\002\225\000\000\000\000\000\000\000\000\000\000\000\000\005\165\000\000\000\000\005\165\000\000\000\000\004\133\000\000\005\165\005\165\000\238\021\166\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\165\000\000\005\193\005\193\005\165\000\000\003\154\005\193\000\000\000\000\005\193\000\000\000\000\000\000\005\165\005\165\005\165\000\000\005\165\005\165\005\193\000\000\005\193\000\000\005\193\000\000\005\193\000\000\022\022\000\000\000\000\005\165\000\000\000\000\000\000\005\165\016\246\000\000\005\193\000\000\000\000\017\014\000\000\000\000\005\193\005\193\005\165\000\000\000\000\000\000\022\186\022\202\000\000\005\193\000\000\000\000\005\193\000\000\000\000\000\000\000\000\005\193\005\193\005\193\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\133\005\193\000\000\005\189\007\002\005\193\000\000\000\000\005\189\023\190\000\000\005\189\000\000\000\000\000\000\005\193\005\193\005\193\000\000\005\193\005\193\005\189\000\000\005\189\000\000\005\189\000\000\005\189\000\000\000\000\000\000\000\000\005\193\000\000\000\000\000\000\005\193\000\000\000\000\005\189\000\000\000\000\000\000\000\000\000\000\005\189\007n\007f\000\000\000\000\000\000\000\000\000\000\000\000\005\189\000\000\000\000\005\189\000\000\000\000\000\000\000\000\005\189\005\189\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\005\189\003:\002\162\000\000\005\189\002f\000\000\006\138\000\000\000\000\002\218\000\000\000\000\000\000\005\189\005\189\005\189\000\000\005\189\005\189\001\210\000\000\006\170\000\000\000\000\000\000\000\000\003>\000\000\000\000\b\198\005\189\000\000\000\000\000\000\005\189\000\000\000\000\000\000\000\000\003J\000\000\000\000\n\146\001\190\000\000\005\189\012\158\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\000\000\n\162\005Z\t\174\000\000\000\000\012\030\000\000\000\000\000\000\b\245\000\000\000\000\000\000\005^\000\000\000\000\t\230\t\254\n\006\t\238\n\014\005f\005j\000\000\000\000\n\170\000\000\000\000\000\000\000\000\n\022\n\030\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n&\n\178\000\000\000\000\n\190\000\000\005n\000\000\000\238\000\000\000\000\000\000\004V\000\000\000\000\000\000\000\000\t\182\t\246\n.\n6\nF\000\000\003=\000\000\000\000\000\000\000\000\003=\nN\001\206\003=\000\000\000\000\000\000\000\000\000\000\000\000\nV\000\000\000\000\003=\000\000\000\000\000\000\003=\000\000\003=\000\000\000\000\000\000\000\000\nv\000\000\n~\n>\000\000\000\000\000\000\003=\000\000\n^\000\000\000\000\000\000\003=\000\000\000\000\001M\nf\nn\000\000\002~\001M\003=\000\000\001M\003=\000\000\000\000\000\000\000\000\003=\003=\003=\000\000\001M\000\000\001M\000\000\001M\000\000\001M\000\000\000\000\000\000\000\000\000\000\003=\003=\000\000\000\000\004~\000\000\001M\000\000\000\000\000\000\000\000\000\000\001M\000\000\003=\003=\001M\000\000\003=\003=\000\000\001M\000\000\000\000\001M\000\000\000\000\000\000\003=\001M\001M\000\238\000\000\001I\000\000\003=\000\000\000\000\001I\001M\003=\001I\000\000\000\000\000\000\001M\003=\000\000\000\000\001M\000\000\001I\000\000\001I\000\000\001I\000\000\001I\000\000\001M\001M\001M\000\000\001M\001M\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\001M\000\000\001I\000\000\000\000\000\000\001I\001M\000\000\000\000\000\000\001I\000\000\000\000\001I\000\000\000\000\000\000\001M\001I\001I\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\001I\001\133\000\000\000\000\000\000\000\000\001\133\000\000\012\153\001\133\001I\001I\001I\000\000\001I\001I\000\000\012\153\000\000\001\133\000\000\001\133\000\000\001\133\001I\001\133\000\000\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\000\000\000\000\001\133\000\000\000\000\000\000\000\000\001I\001\133\012\153\000\000\000\000\000\000\000\000\000\000\012\153\000\000\000\000\000\000\000\000\001\133\000\000\000\000\000\000\000\000\001\133\001\133\001\133\000\000\000\000\0019\000\000\000\000\000\000\000\000\0019\000\000\000\157\0019\000\000\000\000\001\133\000\000\000\000\000\000\012\153\000\157\000\000\0019\000\000\0019\000\000\0019\000\000\0019\001\133\001\133\001\133\000\000\001\133\001\133\000\000\000\000\000\000\000\000\000\000\0019\000\000\000\000\000\000\000\000\000\000\0019\000\157\000\000\000\000\001\133\000\000\000\000\000\157\000\000\000\000\000\000\000\000\0019\000\000\000\000\001\133\000\000\0019\0019\0019\000\000\001\213\000\000\000\000\000\000\000\000\001\213\000\000\015f\001\213\000\000\002f\000\000\0019\000\000\000\000\000\000\000\157\000\000\001\213\000\000\000\000\000\000\001\213\000\000\001\213\000\000\0019\0019\0019\000\000\0019\0019\000\000\000\000\000\000\000\000\001\213\000\000\000\000\000\000\000\000\000\000\001\213\000\000\000\000\000\000\000\000\0019\015j\000\000\000\000\001\213\000\000\000\000\001\213\000\000\000\000\000\000\0019\001\213\001\213\000\000\015v\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\213\000Y\000\000\000\000\001\213\000\000\000Y\000\000\000Y\000\000\000\000\000\000\000\000\005j\001\213\001\213\000\000\000Y\001\213\001\213\000Y\000\000\000\000\000\000\000Y\000Y\000\000\b\145\001\213\000\000\000\000\000\000\000\000\000\000\000\000\001\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000Y\000\000\001\213\000Y\000\000\000\000\000Y\000\000\000\000\000\000\000\000\000Y\000\000\000\000\000\000\000\000\000Y\000Y\000Y\000\000\000\000\000\000\000\000\000\000\000\000\000Y\000Y\000\000\003:\002\162\000\000\000\000\002f\000\000\006\138\000\000\000Y\002\218\000\000\000Y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\210\000Y\006\170\000\000\000Y\000\000\000\000\003>\000\000\b\145\b\198\000\000\000\000\000Y\004Y\007\002\000Y\000\000\t\n\004Y\003J\000\000\004Y\r\138\001\190\000\000\000\000\000\000\000\000\000Y\002\150\000\000\004Y\003\218\000\000\000\000\004Y\003\222\004Y\003\230\000\000\n\162\005Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004Y\000\000\000\000\000\000\005^\000\000\004Y\007n\000\000\000\000\004Y\000\000\005f\005j\000\000\004Y\000\000\000\000\004Y\000\000\000\000\000\000\000\000\004Y\002\198\000\238\000\000\000\000\000\000\000\000\000\000\000\000\004Y\004Y\r\154\000\000\005n\000\000\000\000\004Y\004Y\000\000\004V\004Y\000\000\011\250\000\000\000\000\000\000\000\000\011\250\000\000\000\000\004Y\004Y\000\000\000\000\004Y\004Y\000\000\000\000\t\174\000\000\000\000\000\000\000\000\t\174\004Y\011\254\000\000\000\000\000\000\000\000\012\214\004Y\t\230\t\254\n\006\t\238\n\014\t\230\t\254\n\006\t\238\n\014\004Y\000\000\000\000\000\000\n\022\n\030\000\000\000\000\000\000\n\022\n\030\000\000\000\000\n&\000\000\000\000\000\000\000\000\n&\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\238\000\000\000\000\000\000\t\182\t\246\n.\n6\nF\t\182\t\246\n.\n6\nF\000\000\000\000\nN\000\000\000\000\000\000\000\000\nN\000\000\000\000\000\000\nV\000\000\0035\000\000\000\000\nV\000\000\0035\000\000\000\000\0035\000\000\000\000\000\000\nv\000\000\n~\n>\000\000\nv\0035\n~\n>\n^\0035\000\000\0035\000\000\n^\000\000\000\000\nf\nn\000\000\000\000\000\000\nf\nn\0035\015~\000\000\000\000\000\000\000\000\0035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0035\000\000\000\000\0035\000\000\000\000\000\000\000\000\0035\0035\0035\003:\002\162\000\000\000\000\002f\000\000\006\138\000\000\000\000\002\218\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\000\000\001\210\000\000\006\170\000\000\000\000\000\000\000\000\003>\0035\0035\b\198\000\000\0035\0035\000\000\000\000\000\000\000\000\023&\000\000\003J\000\000\0035\003V\001\190\000\000\000\000\000\000\015\222\0035\002\150\000\000\000\000\003\218\0035\000\000\000\000\003\222\000\000\003\230\0035\n\162\005Z\000\000\000\000\000\000\003:\002\162\000\000\000\000\002f\000\000\006\138\000\000\005^\002\218\000\000\000\000\000\000\000\000\000\000\000\000\005f\005j\000\000\001\210\021\150\006\170\000\000\000\000\000\000\000\000\003>\000\000\000\000\b\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\023\242\003J\005n\000\000\n\146\001\190\000\000\000\000\004V\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\000\000\n\162\005Z\000\000\000\000\000\000\003:\002\162\000\000\000\000\002f\000\000\006\138\000\000\005^\002\218\000\000\000\000\000\000\000\000\000\000\000\000\005f\005j\000\000\001\210\n\170\006\170\000\000\000\000\000\000\000\000\003>\000\000\000\000\b\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022.\003J\005n\000\000\n\146\001\190\000\000\000\000\004V\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005\166\n\162\005Z\000\000\000\000\000\000\003:\002\162\000\000\000\000\002f\000\000\000\000\000\000\005^\002\218\000\000\000\000\000\000\000\000\005\170\000\000\005f\005j\000\000\001\210\n\170\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\022\142\003J\005n\000\000\003V\001\190\000\000\000\000\004V\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\t\017\000\000\000\000\000\000\000\000\000\000\003:\002\162\000\000\005^\002f\000\000\000\000\000\000\000\000\002\218\000\000\005f\005j\000\000\005\174\000\000\t\017\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003>\000\000\000\000\000\000\000\000\000\000\005\250\000\000\000\000\005n\002\225\002\225\000\000\003J\002\225\004V\003V\001\190\000\000\002\225\000\000\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\002\225\003\222\000\000\003\230\005N\000\000\005Z\002\225\000\n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\000\000\002\225\000\000\000\000\002\225\002\225\000\000\005f\005j\000\000\005\174\002\225\000\000\000\000\002\225\000\000\000\000\002\225\002\225\000\000\002\225\002\225\000\000\002\225\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005n\000\000\t\017\000\000\002\225\000\000\004V\004A\004A\000\000\000\000\004A\002\225\002\225\000\000\002\225\004A\000\000\000\000\000\000\000\000\000\000\004A\000\000\000\000\000\000\004A\000\000\000\000\000\000\000\000\000\000\000\000\004A\022\222\000\000\002\225\022\246\000\000\000\000\002\225\000\000\002\225\000\000\000\000\000\000\004A\000\000\000\000\004A\004A\000\000\000\000\000\000\000\000\000\000\004A\000\000\000\000\004A\000\000\000\000\000\238\004A\000\000\004A\004A\000\000\004A\0035\000\000\000\000\000\000\0035\0035\000\000\000\000\0035\0035\000\000\004A\0035\000\000\000\000\000\000\000\000\000\000\0035\004A\004A\000\000\0035\000\000\0035\000\000\0035\000\000\0035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0035\015~\000\000\000\000\0035\015~\0035\004A\000\000\000\000\0035\000\000\000\000\004A\000\000\0035\000\000\000\000\0035\0035\000\000\000\000\0035\0035\0035\0035\000\000\0035\0035\0035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\000\000\000\000\000\000\000\000\000\000\0035\0035\025j\000\000\0035\0035\025\154\000\000\0035\0035\012\145\000\000\000\000\000\000\000\000\012\145\000\000\000\000\012\145\000\000\015\222\0035\000\000\000\000\015\222\0035\0035\000\000\012\145\000\000\0035\000\000\012\145\000\000\012\145\000\000\000\000\000\000\000\000\000\000\004\253\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\012\145\000\000\000\000\003:\002\162\012\145\012\145\002f\000\000\006\138\000\000\000\000\002\218\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\145\001\210\000\000\006\170\012\145\000\000\000\000\000\000\003>\000\000\000\000\b\198\000\000\000\000\012\145\012\145\002^\000\000\012\145\012\145\000\000\003J\000\000\000\000\b\242\001\190\000\000\000\000\012\145\000\000\000\000\002\150\026Z\000\000\003\218\012\145\000\000\000\000\003\222\000\000\003\230\000\000\n\162\005Z\005U\000\000\012\145\000\000\000\000\005U\000\000\000\000\005U\000\000\000\000\005^\000\000\000\000\000\000\000\000\000\000\000\000\005U\005f\005j\000\000\005U\000\000\005U\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005U\000\000\000\000\000\000\000\000\000\000\005U\005n\000\000\000\000\000\000\000\000\007\194\004V\000\000\005U\000\000\000\000\005U\000\000\000\000\000\000\000\000\005U\005U\000\238\000\000\005Y\000\000\000\000\000\000\000\000\005Y\000\000\000\000\005Y\000\000\000\000\000\000\005U\005U\000\000\000\000\005U\000\000\005Y\000\000\000\000\000\000\005Y\000\000\005Y\000\000\005U\005U\000\000\000\000\005U\005U\000\000\000\000\000\000\000\000\005Y\000\000\000\000\000\000\000\000\000\000\005Y\000\000\0035\000\000\000\000\005U\007\194\0035\000\000\005Y\0035\000\000\005Y\000\000\000\000\000\000\005U\005Y\005Y\000\238\0035\000\000\000\000\000\000\0035\000\000\0035\000\000\000\000\000\000\000\000\000\000\000\000\005Y\005Y\000\000\000\000\005Y\0035\015~\000\000\000\000\000\000\000\000\0035\000\000\000\000\005Y\005Y\000\000\000\000\005Y\005Y\0035\000\000\000\000\0035\000\000\000\000\000\000\000\000\0035\0035\0035\006\001\000\000\000\000\000\000\005Y\006\001\000\000\000\000\006\001\000\000\000\000\000\000\000\000\0035\000\000\005Y\000\000\0035\006\001\000\000\000\000\000\000\006\001\000\000\006\001\000\000\000\000\0035\0035\017f\000\000\0035\0035\000\000\000\000\000\000\006\001\000\000\000\000\000\000\000\000\000\000\006\001\000\000\000\000\000\000\000\000\015\222\0035\000\000\000\000\006\001\000\000\000\000\006\001\000\000\000\000\000\000\000\000\006\001\006\001\000\238\000\000\000\000\000\000\000\000\000\000\025B\000\000\000\000\000\000\000\000\000\000\003:\002\162\006\001\000\000\002f\000\000\006\001\000\000\000\000\002\218\000\000\000\000\000\000\000\000\000\000\000\000\006\001\006\001\021\"\001\210\006\001\006\001\000\000\000\000\000\000\000\000\003>\001\202\001\206\000\000\006\001\000\000\000\000\000\000\000\000\000\000\000\000\006\001\000\000\003J\000\000\000\000\003V\001\190\000\000\000\000\001\210\001\214\006\001\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\000\000\005\210\000\000\000\000\000\000\001\246\002\134\003:\002\162\005^\002\130\002f\002\150\004\002\004\014\000\000\002\218\005f\005j\004\026\005\174\000\000\000\000\003\226\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003>\000\000\000\000\004\030\000\000\000\000\004\209\000\000\005n\000\000\006v\000\000\b\174\003J\004V\000\000\003V\001\190\000\000\000\000\000\000\000\000\025\230\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\006\018\000\000\000\000\000\000\000\000\000\000\003:\002\162\000\000\005^\002f\000\000\000\000\000\000\000\000\002\218\000\000\005f\005j\000\000\005\174\000\000\0066\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003>\000\000\000\000\000\000\006\030\000\000\000\000\000\000\000\000\005n\003:\002\162\000\000\003J\002f\004V\003V\001\190\000\000\002\218\000\000\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\001\210\003\222\000\000\003\230\005N\000\000\005Z\003>\000\000\000\000\000\000\000\000\007\129\000\000\000\000\007\129\000\000\000\000\005^\000\000\003J\000\000\000\000\003V\001\190\000\000\005f\005j\000\000\005\174\002\150\007\129\007\129\003\218\007\129\007\129\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005n\006M\000\000\000\000\005^\007\129\004V\003:\002\162\000\000\000\000\002f\005f\005j\000\000\005\174\002\218\000\000\000\000\000\000\000\000\006M\000\000\007\129\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003>\000\000\000\000\005n\011\138\000\000\000\000\000\000\000\000\004V\003:\002\162\000\000\003J\002f\000\000\003V\001\190\000\000\002\218\007\129\000\000\007\129\002\150\000\000\000\000\003\218\000\000\000\000\001\210\003\222\000\000\003\230\005N\005\198\005Z\003>\007\129\007\129\000\000\000\000\000\000\007\129\000\000\007\129\000\000\000\000\005^\007\129\003J\000\000\000\000\003V\001\190\000\000\005f\005j\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\011\150\000\000\000\000\000\000\000\000\005n\003:\002\162\000\000\005^\002f\004V\000\000\000\000\000\000\002\218\000\000\005f\005j\000\000\005\174\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003>\000\000\000\000\000\000\011\162\000\000\000\000\000\000\000\000\005n\003:\002\162\000\000\003J\002f\004V\003V\001\190\000\000\002\218\000\000\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\001\210\003\222\000\000\003\230\005N\000\000\005Z\003>\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\000\000\003J\000\000\000\000\003V\001\190\000\000\005f\005j\000\000\005\174\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005n\006q\000\000\000\000\005^\000\000\004V\000\000\002\162\000\000\000\000\002f\005f\005j\000\000\005\174\002\218\000\000\000\000\000\000\000\000\006q\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\002\222\000\000\000\000\000\000\000\000\000\000\005n\000\000\000\000\000\000\000\000\002\226\004V\000\000\000\000\000\000\000\000\000\000\000\000\003\022\001\190\000\000\000\000\000\000\000\000\000\000\002\150\000\000\000\000\003\030\000\000\000\000\000\000\007\254\b\002\b\014\000\000\000\000\005Z\000\000\000\000\000\000\006\249\007\002\000\000\000\000\000\000\006\249\000\000\000\000\006\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005f\005j\006\249\000\000\000\000\000\000\006\249\000\000\006\249\000\000\001\181\000\000\000\000\000\000\000\000\001\181\000\000\000\000\001\181\000\000\006\249\000\000\000\000\000\000\005n\b\022\006\249\007n\001\181\b.\004V\000\000\001\181\000\000\001\181\006\249\000\000\000\000\006\249\000\000\000\000\000\000\000\000\006\249\006\249\000\238\001\181\000\000\000\000\000\000\000\000\000\000\001\181\000\000\000\000\000\000\000\000\000\000\000\000\006\249\000\000\001\181\000\000\006\249\001\181\000\000\000\000\000\000\000\000\001\181\001\181\001\181\000\000\006\249\006\249\000\000\000\000\006\249\006\249\000\000\000\000\000\000\000\000\000\000\000\000\001\181\000\000\000\000\001\217\001\181\000\000\000\000\000\000\001\217\006\249\000\000\001\217\000\000\000\000\001\181\001\181\000\000\000\000\001\181\001\181\000\000\001\217\000\000\000\000\017r\001\217\000\000\001\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\181\000\000\000\000\000\000\001\217\001\181\000\000\000\000\000\000\000\000\001\217\000\000\000\000\006\005\000\000\000\000\000\000\000\000\006\005\001\217\000\000\006\005\001\217\000\000\000\000\000\000\000\000\001\217\001\217\000\000\000\000\006\005\000\000\000\000\000\000\006\005\000\000\006\005\000\000\000\000\000\000\000\000\000\000\001\217\000\000\000\000\000\000\001\217\000\000\006\005\000\000\000\000\000\000\000\000\000\000\006\005\000\000\001\217\001\217\000\000\000\000\001\217\001\217\000\000\006\005\000\000\000\000\006\005\000\000\000\000\000\000\001\217\006\005\006\005\000\238\000\000\000\000\000\000\001\217\000\000\000\000\000\000\000\000\020\254\000\000\000\000\000\000\000\000\006\005\001\217\012\145\000\000\006\005\000\000\000\000\012\145\000\000\000\000\012\145\000\000\000\000\000\000\006\005\006\005\000\000\000\000\006\005\006\005\012\145\000\000\000\000\000\000\012\145\000\000\012\145\000\000\006\005\000\000\000\000\000\000\004\253\000\000\000\000\006\005\000\000\000\000\012\145\000\000\000\000\000\000\000\000\000\000\012\145\000\000\006\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\000\000\000\000\012\145\012\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012I\000\000\002\162\012I\000\000\027\230\000\000\012\145\000\000\000\000\027\234\000\000\000\000\012I\000\000\000\000\000\000\000\000\000\000\012I\000\000\012\145\012\145\002^\000\000\012\145\012\145\000\000\000\000\000\000\000\000\012I\000\000\000\000\000\000\012\145\000\000\012I\000\000\026\146\000\000\000\000\012\145\001\002\001\190\000\000\012I\000\000\000\000\012I\000\000\000\000\000\000\012\145\012I\004Y\000\000\000\000\000\000\000\000\004Y\000\000\027\238\004Y\000\000\000\000\000\000\000\000\000\000\000\000\012I\000\000\000\000\004Y\012I\000\000\000\000\004Y\000\000\004Y\000\000\000\000\000\000\027\242\012I\012I\000\000\000\000\012I\000\000\000\000\004Y\000\000\000\000\000\000\000\000\000\000\004Y\b1\b1\000\000\000\000\b1\007\194\000\000\012I\004Y\b1\000\000\004Y\000\000\000\000\000\000\016\014\004Y\002\198\000\238\b1\000\000\000\000\000\000\000\000\000\000\000\000\b1\000\000\000\000\000\000\000\000\000\000\004Y\000\000\000\000\000\000\004Y\000\000\000\000\b1\000\000\000\000\b1\b1\000\000\000\000\004Y\004Y\000\000\b1\004Y\004Y\b1\000\000\000\000\000\000\b1\000\000\b1\b1\007.\b1\000\000\000\000\000\000\000\000\001q\004Y\000\000\000\000\000\000\001q\025b\b1\001q\000\000\000\000\000\000\004Y\000\000\000\000\b1\b1\000\000\001q\000\000\001q\000\000\001q\000\000\001q\000\000\000\237\000\000\000\000\000\000\000\000\000\237\000\000\000\000\000\237\000\000\001q\000\000\000\000\b1\000\000\000\000\001q\000\000\000\237\b1\000\000\000\000\000\237\000\000\000\237\000\000\000\000\000\000\001q\000\000\000\000\000\000\000\000\001q\001q\000\238\000\237\000\000\000\000\000\000\000\000\000\000\000\237\000\000\000\000\000\000\000\000\000\000\000\000\001q\000\000\000\237\000\000\000\000\000\237\000\000\000\000\000\000\000\000\000\237\000\237\000\238\000\000\001q\001q\001q\000\000\001q\001q\000\000\000\000\000\000\000\000\000\000\000\000\000\237\000\000\000\000\000\241\000\237\000\000\000\000\000\000\000\241\001q\000\000\000\241\000\000\000\000\000\237\000\237\000\000\000\000\000\237\000\237\001q\000\241\000\000\000\000\000\000\000\241\000\000\000\241\000\000\006\245\000\000\000\000\000\000\000\000\006\245\000\237\000\000\006\245\000\000\000\241\000\000\000\000\000\000\000\000\000\000\000\241\000\237\006\245\000\000\000\000\000\000\006\245\000\000\006\245\000\241\000\000\000\000\000\241\000\000\000\000\000\000\000\000\000\241\000\241\000\238\006\245\000\000\000\000\000\000\000\000\000\000\006\245\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\000\006\245\000\000\000\241\006\245\000\000\000\000\000\000\000\000\006\245\006\245\000\000\000\000\000\241\000\241\000\000\000\000\000\241\000\241\000\000\000\000\000\000\000\000\000\000\000\000\006\245\000\000\000\000\000\000\006\245\000\000\000\000\000\000\000\000\000\241\000\000\006\201\006\201\000\000\006\245\006\245\016\166\000\000\006\245\006\245\000\241\005\249\000\000\000\000\000\000\000\000\005\249\000\000\000\000\005\249\006\201\006\201\006\201\000\000\000\000\006\245\017F\000\000\000\000\005\249\006\201\000\000\000\000\005\249\000\000\005\249\000\000\005a\007\002\000\000\000\000\000\000\005a\006\201\006\201\005a\000\000\005\249\006\201\000\000\006\201\006\201\006\201\005\249\000\000\005a\000\000\006\201\000\000\005a\000\000\005a\005\249\000\000\000\000\005\249\000\000\000\000\000\000\000\000\005\249\005\249\000\000\005a\006\201\000\000\000\000\000\000\000\000\005a\007n\000\000\000\000\000\000\000\000\000\000\005\249\000\000\000\000\000\000\005\249\005a\000\000\000\000\000\000\000\000\005a\005a\000\238\000\000\005\249\005\249\000\000\000\000\005\249\005\249\000\000\000\000\000\000\000\000\011\249\000\000\005a\000\000\000\000\011\249\000\000\004\202\011\249\000\000\000\000\005\249\000\000\000\000\000\000\000\000\005a\005a\011\249\000\000\005a\005a\011\249\000\000\011\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\249\005a\000\000\000\000\000\000\000\000\011\249\000\000\000\000\000\000\000\000\000\000\000\000\001\202\002b\011\249\000\000\002f\011\249\000\000\000\000\000\000\000\000\011\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\210\001\214\001\230\000\000\000\000\000\000\000\000\011\249\t\162\000\000\001\242\011\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\249\011\249\002n\002v\011\249\011\249\000\000\002\130\000\000\002\150\004\002\004\014\0041\000\000\000\000\000\000\020\214\0041\026>\004)\0041\011\249\000\000\000\000\004)\000\000\000\000\004)\000\000\000\000\0041\000\000\n\134\004\030\0041\000\000\0041\004)\000\000\000\000\000\000\004)\005j\004)\000\000\000\000\000\000\000\000\0041\000\000\000\000\000\000\026J\000\000\0041\004)\000\000\000\000\000\000\000\000\000\000\004)\000\000\0041\000\000\000\000\0041\000\000\000\000\020\234\004)\0041\000\000\004)\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\0041\000\000\000\000\000\000\0041\004I\000\000\004)\000\000\000\000\004I\004)\004\025\004I\0041\0041\000\000\004\025\0041\0041\004\025\004)\004)\004I\000\000\004)\004)\004I\000\000\004I\004\025\000\000\000\000\000\000\004\025\0041\004\025\000\000\000\000\000\000\000\000\004I\004)\000\000\000\000\000\000\016\206\004I\004\025\000\000\000\000\000\000\000\000\019\186\004\025\000\000\004I\000\000\000\000\004I\000\000\000\000\000\000\004\025\004I\000\000\004\025\000\000\000\000\000\000\000\000\004\025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004I\000\000\000\000\n\194\004I\000\000\000\000\004\025\000\000\001\202\001\206\004\025\000\000\000\000\004I\004I\000\000\000\000\004I\004I\000\000\004\025\004\025\002r\000\000\004\025\004\025\000\000\001\210\001\214\001\230\000\000\000\000\000\000\000\000\004I\000\000\000\000\001\242\000\000\000\000\000\000\004\025\000\000\000\000\001\250\020\154\006\205\006\205\000\000\000\000\001\246\002v\024\018\000\000\000\000\002\130\000\000\002\150\004\002\004\014\000\000\000\000\004\018\000\000\004\026\006\205\006\205\006\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\205\000\000\000\000\000\000\000\000\000\000\004\030\000\000\000\000\000\000\000\000\000\000\000\000\006\205\006\205\000\000\000\000\000\000\006\205\000\000\006\205\006\205\006\205\000\000\0049\000\000\000\000\006\205\000\000\0049\000\000\004!\0049\000\000\000\000\015n\004!\000\000\000\000\004!\000\000\000\000\0049\000\000\006\205\000\000\0049\000\000\0049\004!\000\000\000\000\000\000\004!\000\000\004!\000\000\000\000\000\000\000\000\0049\000\000\000\000\000\000\000\000\000\000\0049\004!\000\000\004Q\000\000\000\000\000\000\004!\004Q\000\000\000\000\004Q\0049\000\000\004\006\000\000\006\205\0049\000\000\004!\000\000\004Q\000\000\000\000\004!\004Q\000\000\004Q\000\000\000\000\000\000\000\000\000\000\0049\000\000\000\000\000\000\000\000\000\000\004Q\004!\000\000\000\000\000\000\000\000\004Q\000\000\0049\0049\000\000\000\000\0049\0049\000\000\004!\004!\000\000\004Q\004!\004!\000\000\000\000\004Q\011\014\000\000\000\000\000\000\000\000\0049\001\202\001\206\000\000\000\000\000\000\000\000\004!\000\000\000\000\004Q\017\246\000\000\000\000\000\000\000\000\000\000\003\226\020F\000\000\001\210\001\214\001\230\000\000\004Q\004Q\000\000\000\000\004Q\004Q\001\242\004m\000\000\000\000\000\000\000\000\000\246\000\000\000\000\002\166\000\000\000\000\000\000\001\246\002v\004Q\000\000\000\000\002\130\003\150\002\150\004\002\004\014\004m\000\000\003\154\020\194\004\026\007\149\000\000\000\000\007\149\000\000\000\000\000\000\000\000\000\000\003\158\000\000\000\000\000\000\000\000\000\000\016\146\004\030\000\000\000\000\007\149\007\149\000\000\007\149\007\149\024>\000\000\000\000\016\246\000\000\000\000\000\000\000\000\017\014\000\000\000\000\000\000\007m\000\000\000\000\007m\000\000\000\000\000\000\007\149\000\000\000\000\000\000\000\000\017\022\000\000\000\000\000\000\004R\000\000\004V\007m\007m\000\000\007m\007m\000\000\000\238\017*\017V\000\000\000\000\004m\004m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007m\000\000\007\153\000\000\021~\007\153\000\000\000\000\000\000\000\000\000\000\000\000\007\149\000\000\007\149\000\000\000\000\000\000\007m\000\000\000\000\007\153\007\153\000\000\007\153\007\153\007\149\000\000\000\000\005\206\007\149\000\000\000\000\000\000\007\149\007\137\007\149\000\000\007\137\000\000\007\149\000\000\000\000\000\000\000\000\007\153\000\000\000\000\007m\000\000\007m\000\000\000\000\000\000\007\137\007\137\000\000\007\137\007\137\000\000\000\000\000\000\007m\000\238\000\000\005\206\007m\000\000\000\000\000\000\007m\000\000\007m\000\000\000\000\000\000\007m\000\000\007\137\000\000\r-\r-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\153\000\000\007\153\000\238\000\000\000\000\r-\r-\r-\007\022\000\000\000\000\000\000\000\000\007\153\000\000\r-\005\206\007\153\000\000\000\000\000\000\007\153\000\000\007\153\001\202\001\206\0222\007\153\r-\r-\000\000\000\000\007\137\r-\007\137\r-\r-\r-\000\000\000\000\000\000\000\000\r-\001\210\002\142\001\230\006\014\000\000\000\000\005\206\007\137\000\000\000\000\001\242\007\137\000\000\007\137\000\000\000\000\r-\007\137\000\000\001\202\001\206\022\146\000\000\001\246\002v\000\000\000\000\000\000\002\130\000\000\002\150\004\002\004\014\000\000\000\000\000\000\000\000\004\026\001\210\002\142\001\230\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\242\000\000\000\000\000\000\000\246\000\000\004\030\002\166\000\000\000\000\000\000\000\000\000\000\001\246\002v\000\000\000\000\004\141\002\130\000\000\002\150\004\002\004\014\003\154\000\000\000\000\000\000\004\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\158\000\000\000\000\000\000\000\000\000\000\016\146\000\000\000\000\004\030\000\000\000\000\000\000\000\000\000\000\024>\000\000\000\000\016\246\000\000\000\000\000\000\000\000\017\014\000\000\000\000\000\000\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\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\017*\017V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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~"))
+  
+  and lhs =
+    (8, "\012\011\n\t\b\007\006\005\004\003\002\001\000\216\216\215\215\214\213\213\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\211\211\210\209\209\209\209\209\209\209\209\208\208\208\208\208\208\208\208\207\207\207\206\206\205\204\204\204\203\203\202\202\202\202\202\202\201\201\201\201\201\201\201\201\200\200\200\200\200\200\200\200\199\199\199\199\198\197\196\196\196\196\195\195\195\195\194\194\194\193\193\193\193\192\191\191\191\190\190\189\189\188\188\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\186\186\185\185\184\183\182\181\181\180\180\179\179\179\179\178\178\178\178\177\177\176\176\176\176\175\174\173\173\172\172\171\171\170\169\169\168\167\167\166\165\164\164\164\163\163\162\161\161\161\161\161\160\160\160\160\160\160\160\160\159\159\159\159\159\159\158\158\157\157\157\156\156\155\155\155\154\154\153\153\152\152\151\151\150\150\149\149\148\148\147\147\146\146\145\145\144\144\144\143\143\143\143\142\142\141\141\140\140\139\139\139\139\139\138\138\138\138\137\137\137\136\136\136\136\136\136\136\135\135\135\135\135\135\135\134\134\133\133\132\132\132\132\132\132\131\131\130\130\129\129\128\128\127\127\127~}}}||{{{{{{{{{zzyyxxxxxxxxxxxwvuutttttsrrqqppppppppppppppoonnmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmllkkjjiihhggffeeddccbbaaaaaaaaaaa`_^]\\[ZYXWWWWWWWWWWVVVUUUTTTTSSSSSSSSSRRQQQQQPPOONMLLKKKKKJJIIHHHGGGGGGFFFEEDDCCBBAA@@@??>>==<<;;::9988776655544433322211110/..................-----,,,,,,,+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++**))))))))))))))))))))))(((((((((((((((((((((((((((((((((((((((((((((((((((''&&&%%$$$$$$$$$$$$$$$$##\"\"!!!!!!!    \031\031\030\030\030\030\030\029\029\028\027\026\026\026\025\025\024\024\024\023\023\022\022\022\022\021\021\020\019\019\019\019\019\018\017\017\016\016\016\015\015\015\014\014\014\014\r\r")
+  
+  and goto =
+    ((16, "\000%\000\193\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\001\012\000\000\000\000\000\129\001\152\000\030\0003\000#\000\004\000\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000b\000\000\000\000\000\000\000\000\000\000\000t\000\000\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\000\000=2\000\000\000\000\000\000\000\254\000\000\000\000\000\000\000\000\000\000\000\000\000\000'\238\001T\001>\000\223\000\000\001B9\220\001\236\001\218\000:\000\000\001x\000\000\000\182\003\156\000\000\002\150\000\000\000\000\000\000\000\000\000\000\001\022\000\000\000\218\003\202\bf\000\000\000\000\011\018'\238\000\000\000\000\001\254\000\000\000\027\000\000:~\002\184\000\000\001\156\001r\000\000\000\000\002\172\002\142\002\208\003b\001\226\003\202\004\142\000f\001\194\0022\003\216\002\152\011b\000\000\005(\003\244\003\188\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004r\000\000\t>\005(\011\194\000\000\000\000\004.\005d\004\0301\236\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\148\000\000\004\168\005l\005@\000\000\000\000\000\000\000\000\000\173\000\000\000\000\005\144\000\167\006\018\006(\007\214\000\000\0050\005H\006*\000Q\004\228\006L \232\000\000\000\000\005X\006\254\011\204\000\000!\b\001\244!\026\"V\000\000\003B\000\000\000\000\000\000\000\000\006\018=F\006\020\000\000\001\012\0064\000\000\004P6\150\000\131\000\000\001\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002:\005\190\000\000\000\000\000\000\000\192\000\000\tD\000\000\000\000\002\164\000o\000\000\000\000\003\248\000\000\006n\000\000\002\164\t\148\002\164\000\000\000\000\000\000\000\000\000\0007 \000\000\007\"\006@\000\000=\168\007N\030`\000\000\000\000\000\000\0062\000\000\000\000\000\000\000\000\006F\000\000\000\000\000\000\000\000\000\0002L\000\000\000\000\000\000\000\000\000\000\000\000\001\158\007N\000\000\000\000\000\000\006F\007\1342\146\006\224\007p\015\214\000\000\003\014\000\000\000\000\000\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\0122\160\000\000\000\000\007\030\b\0042\214\000\000\000\000\000\00038\007\0143\152\000\000\007\014\000\0003\164\007\014\000\0003\228\007\014\000\000\007\014\000\000\000\000\007\014\000\000\000\0004J\000\000\007\0144\138\000\000\007\014\002|\000\000\000\000\"V\000\000\000\000\000\000\000\000\007\014\"z\000\000\000\000\000\000\007\014\000\000\006F\007\246\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\016\000\000\007\136\000\000=\132\006F\000\000\000\000\000\000\000\000\b\b\b\184\012$\b\026\b\030\b@\b\028\005\014\b`\0001\t\006\000\000\000\000\000\029\005\136\b\160\001\172\b\200\bL\000\000\000\145\004\138\005\180\007\136\n\"\000\000\000\000C\158\000\000C\224\t\212\000\000=\198\006F>@\006F\000\000\003\"\000\000\003x\000\000\000\000\003\220\000\000\000\000\000\000\nt\000\000\n\030\000\145\000\000\000\000\t>\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\145\000\000\000\000\000\145\000\000\b\200\007\014\000\000\002\182\004\228\000\000\002\182\000\000\000\000\n\206\000\145\000\000\000\000\000\000\000\000\000\000\000\000\002\182\012\132\rL\n4\t\218\"\152\000n\000\000\t\130\b\182\r\158\t\234\b\228\025X1N\000\000\000\000\000\000\000\000\000\000\0032\t\188\000\000\000\000\000\000\t\250\b\244\007V\002\182\011\240\000\000\000\145\000\000\000\000\000\000\001\244\000\000>T\006F\r\166\n\018\t\030\r\254\n \t0\014\180\"\186\007\014\015\024\n\"\t89\190\n\244\000\000#\002\007\014>x\006F\n\238\000\000\000\000\000\000\000\000\007\148\011&\011L\000\000\000\000\b\176\015 \n\208\t>4\172\007\014\015t\n\222\tF6(\000\000>\172\000\000\000\000\015|\"\244\018\\\000\000\000\000\000\000\000\000>\208\000\000\000\000\000\000\007\172\016B\000\000\000\000\000\000\000\000#^>\222\000\000\000\000\000\000\000\000\000\000\n\170\016\150\000\000\n\180$\"\n\180$,\n\180\000\000?\026\000\000$\128\n\180\016\234\004\152\016\244\000\000\000\000$\136\n\180%\022\n\180%\030\n\180%\250\n\180&\002\n\180&\026\n\180&\152\n\180&\246\n\180&\254\n\180'\140\n\180'\148\n\180'\232\n\180(v\n\180(\128\n\180)\014\n\180)^\n\180)h\n\180)\246\n\180*F\n\180*\212\n\180\t\170*\2484\232\007\148\011x\000\000+8;l\000\000\017N\000\000?,\000\000\006F;\166\000\000\006F?P\006F\000\000\017\184\000\000\000\000\000\000+\\\000\000\000\000\000\000\000\000\000\000\007\014\000\000\000\000?\210\000\000\006F\000\000\000\000;\166\011\136\000\000@6\006F\018\018\000\000\000\000\011\"\000\000@H\006F\018\160\000\000\000\000\018\196\000\000\000\000\000\000@Z\006F\019\028\000\000\n\252\019\132\000\0005J\000\000\007\0145\142\000\000\007\0145\176\000\000\007\014\003d\000\000\000\000\000\000\000\000\000\0005\240\007\014\004\222\005\022\000\000\000\000\000\000\n\180\019\222\000\000\000\000\000\000+\150\n\180\000\000\000\000\000\000\000\000\0206\000\000\000\000\000\000\n\180\020D\000\000\020\158\000\000\000\000\000\000\021\004\000\000\000\000\000\000\000\000@\146\000\000\000\000\021^\000\000\000\000\000\000,H\n\180\021l\000\000\000\000\000\000,\138\n\180\021\196\000\000\000\000,\176\n\180\n\180\000\000\007\228\022\030\000\000\000\000-\b\n\180\022l\000\000\000\000-(\n\180-v\n\180\000\000.\004\n\180\000\000\000\000\022\250\000\000\000\000.\152\n\180\023,\000\000\000\000.\200\n\180\023\\\000\000\000\000.\232\n\180\000\000/\000\n\180\000\000;\138\000\000\000\000\n\180\000\000\000\000\023\142\000\000\000\000\023\192\000\000\000\000\011D\000\000\000\000\024\028\000\000\024$\000\000\000\000\000\000\007\148\011\226\000\0007\022\n<\002\164\025\004\000\0007r\000\000\000\000\000\0007\194\000\000\000\000\025$\000\000\025\146\000\000\000\000\000\000\000\000/\n\000\000\000\000\000\000/f\n\1800r\n\180\000\000\n\252\025\156\000\000\000\000\025\236\000\0000T\000\000\000\0001N\000\000\000\000\000\000\026\134\000\000\000\000\000\000\000\000\026\144\000\000\000\000\000\000\000\000\012\152\000\000\000\000\000\000\003\154\000\000\000<\000\000\000;\000\000\0128\000\000\004\144\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\180\000\000\012\164\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\184\007\232\002\182\027T\000\000\011\166\t\224\012*\001\144\t\136\002\182\r@\000\145\t\176\002\182\000\000\027x\000\000\004\142\000\000\011\194\t\238\004X\000\000\000\000\000\000\000\000\000\000\011\218\001.\000\146\000\000\000\000\000\000;\222\000\000C\240\000\000\t\246\000\000\n\016\000\000\000\000\000\000\000\000\002\158\000\000\000\000\000\000\011*\002\164\000\000\002\164\001\178\000\000\rv\002\164\002\164\n\024\000\000\027\186\000\000\000\000\n8\012\172\000\0000\180\005$\000\000\000\000\000\000\000\000\000\000\000\000\n\180\000\000\028\180\000\000\n\180\000\000\000\000\014\242\000\000\000\145\000\000\016H\000\000\000\145\000\000\017\012\000\145\000\000\003Z\000\000\n<\n\022\005`\000\000\011\226\011\234\nV\012\024\012\164\017T\000\145\006\012\000\000\nZ\012\134\012\188\005\024\006\184\012\150\n\130\r\014\006\146\b\132\012\228\000\000\000\000\007\188\b\148\000\000\004\168\002\2426N\007\014\028\028\000\000\007X\003\178\012\158\n\154\011^\005\224\000\000\012\168\n\158\006\200\000\000@\172\006F\rZ\r\132\000\000\t:\000\000\012\244\n\166\006>\r2\003V\000\000\000\000\000\000\000\000\n\216\tZ\000\000\n\222\tl\000\000\bb\0164\rF\rP\n\228\006\216\t\172\000\000\n\230\007\138\n\018\000\000\rR\n\238\r\220\000\000\t\028\000\000\n\132\000\000\r\252\000\000\018\024\000\145\r\216\011\002\014\022\000\000\018\202\0056\r\236\000\000\000\000\003j\006\160\011$\000\000\019\228\000\145\011F\000\000\004\022\000\000\r\210\011\016\0212\006\154\000\000\r\222\011>\007\176\r2\r\230\r\240\011L\015F\000\000\014\000\001\200\000\000\000\000\000\000\000\000\000\171\011X\r\226@\190\006F\000\000\002\200\011\142\014\148\000\000\000\000\000\000\000\000\000\000\000\000A\000\006\164\000\000\011\182\014\246\000\000\000\000\000\000\000\000\000\000\000\000\006\174\000\000A\030\006F\011\226\000\000\006F\011\218\000\184\000\000\011\230\011\232\007\024\000\000\001\004\004L\000\000\002\190\000\000A\"\006F\006F\000\000\000\000\007\b\000\000\b\252\000\000\001\186\007\b\007\b\000\000\011\236;\204\006FA\152\006F\012\b\000\000\000\000\000\000\000\000\012\014\000\000\000\000\007N\000\000\007l\014`\011\240\015p\014*\000\000\000\000\001\196\b|\014h\000\000\000\000\011\250\015\128\014@\000\000\000\000\029\018\000\000\012\222\000\000!(6H\006F\000\000,N\018\132\000\000A\252\000\000\000\000\000\000\007\b\000\000\000\000\012:\014|\012\000\015\144\014J\000\000\000\000B\014\012\144\014\140\000\000\000\000\000\000<:\000\000\000\000\000\000\000\000\000\000\000\000\012\146\000\000\014\152\012\020\006\162\000\000\015\134\015>\012\180\014\166\000\000\000\000\014\170\012>\b*\000\000\000\000\tl6\150\005|\000\000\000\000\000\000\bL\014p\012p\000\000\014z\bL\000\000\015V\012\188\014\196\000\000\000\000\000\000\006F\003v\004(\005\180\000\000\000\000\000\000\000\000\014\138\012t\000\000\006\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006F\014z\012\128\015\208\014\138\000\0007\224\000\237\012\146\014^\003\156\000\019\012\150\015\016\000\000\015\200\028\130\000\000\000\000\029J\000\000\012\208\000\000\nL\000\000\000\000\000\000\000\000\000\000\000\000B\018\006F\000\000\015\204\029l\000\000\000\000\030\002\000\000\000\245\012\156\015r\000\000\000\0007\250:\020\015(\000\000B0\006F\0302\000\000\000\000\030T\000\000\000\000\r0\000\000\000\\\000\000\000\000\000\000\000\000\000\000\000\000:\204\000\000\000\0008\188:\208\015*\000\000BP\006F\030\234\000\000\000\000\031\028\000\000\000\000\012\184\031<\r<\000\000\012\190\012\198\002\016\002\208\012\200\t&\012\214\015|0\214\r\\\000\000\r\016\r2\tf\000\000\004*\002\026\006\026\001\152\001\252\001U\001'\000\193\000\140\001A\0053\001\208\006\028\001\149\001\t\002e\004\236\002k\000m\006\019\001\016\001\029\001<\002q\001x\001}\002g\001\253\006\029\000\189\005\028\004o\000\193\000\251\004\238\001g\001m\001\016\000\193\001V\001\024\004\232\001\024\001\025\000\196\001\025\002s\003\001\001\239\004\215\000\193\000\251\001w\006\020\004<\001\024\004\234\002b\005\029\005]\005\030\006\021\000\196\001\253\001\156\001\196\001\168\001\027\002\017\001\027\002d\000\193\001]\001^\003\197\0039\004\235\001\252\000\193\000\251\000\193\001\t\0069\003\018\000\196\006+\005?\001\016\001\019\005\031\004E\001\t\001_\002\185\001z\001a\001b\001\016\001\029\004\215\006%\000\196\001{\002\244\001}\001e\003\213\002\244\005\247\006\024\001#\003J\001#\001n\006\026\002\244\002\244\004\152\004\001\001\191\003\227\001\192\005 \005\249\006\028\001\179\006\150\002e\001\223\002k\001\173\005!\001\227\005\"\001\016\002q\001\253\001}\002g\001\t\006\029\001\t\002\r\002\014\001^\001\016\001\029\001\016\001\029\005\250\0007\006\136\002\244\001\024\001\t\004\t\005^\002Q\002s\001\181\001\016\001\029\004\002\006~\003\195\002R\001f\006\145\003\240\003\242\004\246\006J\001\228\001\024\0048\000\196\001\025\001g\002`\005$\000\193\001\178\004=\006s\005&\0050\001\229\000\196\005F\005G\0017\001\188\0017\001\024\005Z\005<\004\001\001\030\002\244\001\030\001\027\005_\002\b\005H\005X\002\r\002\014\001^\005P\004\001\005[\003k\001\030\006`\002\244\004\217\001\184\005?\000\193\006\180\002Q\000\196\006a\002\244\001'\002\011\001'\001A\002R\001A\003n\000m\004w\002\025\003\140\004\215\001z\002b\001\016\006|\001\230\002`\001\024\001#\001\150\001\025\001}\001e\002\017\001\201\002d\000\193\001\t\000\196\002(\002\244\001\239\005B\001\016\001\029\002\r\002\014\001^\002+\000\196\004U\001\203\0021\005\193\001\027\002F\000\193\001\t\005{\002K\002Q\001\239\001\024\001\016\001\029\002h\004a\003\205\002R\001@\001\252\005?\000\196\000\193\006\222\004d\001\219\001\t\001\226\000m\000\196\002`\003\188\001\016\001\029\002b\001\024\003\209\003\184\001\025\001\252\002\244\002e\000\193\002k\001\030\002\017\001#\002d\000\193\002q\000\196\001}\002g\005F\005G\005\185\004l\0017\002\163\000\196\006\152\001\239\001\027\000\196\001\030\003\196\000\196\006\224\005H\005X\000\196\001\031\002s\005P\004\001\001\t\002\007\002h\001\253\005?\005\217\001\016\001\029\000\193\001\030\003\202\001\191\004#\001\221\002b\001\252\001'\003\217\000\193\001A\001\223\003\234\002\244\001\253\001\227\002\017\001\016\002d\000\193\002e\001#\002k\004p\005\127\003\236\001\t\001)\002q\003\254\001}\002g\001\016\001\029\001\024\006\166\000\196\001\025\005F\005G\006Z\004\001\0017\000\196\002\n\004\003\001\024\004\"\002h\001\030\001\t\002s\002\024\005H\005X\001\228\001\016\001\029\005P\004\001\004(\001\027\004/\000\196\002'\001\253\002\r\002\014\001^\001\229\000\196\002*\0020\002<\000\196\002e\001'\002k\005?\001A\004x\002Q\0045\002q\001\030\001}\002g\000\196\0029\002R\001\191\000\196\001\247\002\244\004H\006O\004M\005F\005G\001\223\004X\0017\002`\001\227\001#\001\016\002s\000\196\001\030\000\196\002\244\003h\005H\005X\002\r\002\014\001^\005P\004\001\002\r\002\014\001^\000\196\000\189\000\196\004`\000\193\000\194\004c\002Q\002A\004j\004n\001\t\002Q\001'\004s\002R\001A\001\016\001\029\001\239\002R\001\228\000\196\001\t\004\127\006=\004\014\002@\002`\001\016\001\029\004\146\005\203\002`\000\196\001\229\000\196\002E\004\137\002b\000\196\002\r\002\014\001^\002J\004I\002\247\002p\001\252\002\167\002\017\000\193\002d\000\193\004\151\004\141\002Q\002\202\005F\005G\005\205\004\156\0017\002\209\002R\000\196\002\244\004\166\000\196\001\030\004\b\000\196\000\196\006\148\006\149\005\206\000\196\002`\005P\004\001\005\208\001\030\002h\002\238\005\219\002\244\000\196\002b\002\244\002\r\002\014\001^\002b\000\196\004\172\001\239\001'\003]\002\017\001A\002d\000\193\003e\002\017\002Q\002d\000\193\001\253\003\245\002e\002\244\002k\002R\001\191\004\183\002\029\000\196\002q\003\194\001}\002g\006D\001\223\000\196\001\252\002`\001\227\000\193\001\016\000\196\002h\003\154\004\198\004\195\003\164\002h\002b\003\186\004\216\004\202\002s\004\223\001\024\004\240\003\201\005\001\003\203\002\017\004\250\002d\000\193\005\019\004\228\002\244\002\244\004\233\000\196\002e\003\216\003\007\003\253\005(\002e\004\005\002k\002q\001\228\001}\002g\001\027\002q\002\244\001}\002g\004.\002\244\000\196\005\017\004'\002h\001\229\006\014\0052\001\253\002b\002\244\004)\004,\002s\002\r\002\014\001^\004;\002s\000\196\002\017\007\r\002d\000\193\007\014\000\196\000\196\006\017\000\196\002Q\000\196\002e\005>\002k\005R\000\196\006\018\002R\000\196\002q\005b\001}\002g\001\024\0041\005\025\005%\003\191\000\196\005h\002`\005l\002h\004:\005\136\002\r\002\014\001^\002\244\002\r\002\014\001^\002s\005-\002\244\006\019\001\t\005D\005\176\000\196\002Q\005\236\001\016\001\029\002Q\005\181\005\220\005u\002R\002e\002\244\002k\002R\005\186\003\177\0046\002\244\002q\003\129\001}\002g\002`\0049\004G\000\196\002`\000\196\000\189\004L\006\020\000\193\000\194\000\196\002\r\002\014\001^\001\191\006\021\003\207\002b\002s\000\196\005\216\000\196\004T\001\223\000\196\002\244\002Q\001\227\002\017\001\016\002d\000\193\001\030\005\152\002R\007\016\005\203\005\192\000\196\005\178\003|\000\196\002\244\004S\004W\000\196\000\196\002`\005\200\005\241\001\t\006\006\006C\000\196\006\023\005\189\001\016\001\029\002b\001'\002h\005\223\002b\006\024\005\205\004b\002\244\001\228\006\026\002\017\002\244\002d\000\193\002\017\002\244\002d\000\193\002\244\006\028\005\206\002\244\001\229\000\196\002\244\005\208\004m\006]\002e\005\237\003\007\004i\004r\005\235\002\244\006\029\002q\004\134\001}\002g\000\196\006i\002h\006w\001]\001^\002h\002b\002\244\001\030\005\239\000\196\000\196\004z\000\196\000\196\006y\002\244\002\017\002s\002d\000\193\004\133\002\244\001_\001o\004\128\001a\001b\002e\002\244\002k\004\132\002e\005\243\002k\003\251\002q\005\248\001}\002g\002q\006\004\001}\002g\006\011\002\244\003x\006\025\000\196\002h\006 \002\244\002\r\002\014\001^\004\145\002\r\002\014\001^\002s\006)\004\150\000\196\002s\000\196\004\249\001p\002Q\001q\002-\004\155\002Q\004\158\004\162\006n\002R\002e\000\196\002k\002R\004\170\003q\004\177\006\154\002q\003b\001}\002g\002`\006\168\004\188\004\248\002`\004\241\004\242\004\247\007\007\001x\002\r\002\014\001^\004\251\002\r\002\014\001^\004\252\005\027\002s\001g\005\020\005\021\000\193\007\018\002Q\005\026\005/\005+\002Q\007\023\003{\005,\002R\005.\005Y\005=\002R\000\189\003Z\005A\000\193\000\194\001\191\005C\004\022\002`\003R\005E\005Q\002`\005a\001\223\005c\005d\005i\001\227\005m\001\016\002b\001]\001^\005q\002b\005\131\005\138\005\142\005\166\005\187\005\203\002\017\005\211\002d\000\193\002\017\005\221\002d\000\193\006\r\001z\001_\001`\006\007\001a\001b\006\b\006\012\001{\006\027\001}\001e\006B\006M\006X\006l\006m\001\228\005\205\006q\006\153\006\157\006\167\002h\006\171\005\028\002b\002h\006\249\000\000\002b\001\229\000\000\005\206\002\r\002\014\001^\002\017\005\208\002d\000\193\002\017\006\000\002d\000\193\000\000\000\000\000\000\000\000\002Q\002e\000\000\002k\005\029\002e\005\030\002k\002R\002q\000\000\001}\002g\002q\002]\001}\002g\000\000\000\000\000\000\002h\002`\000\000\000\000\002h\000\000\001f\002\r\002\014\001^\000\000\000\000\002s\000\000\000\000\005\031\002s\001g\000\000\000\000\000\193\000\000\002Q\000\000\000\000\000\000\000\000\002e\000\000\002k\002R\002e\000\000\003\007\000\000\002q\002j\001}\002g\002q\000\000\001}\002g\002`\000\000\000\000\000\000\000\000\005 \002\r\002\014\001^\000\000\000\000\002\r\002\014\001^\005!\002s\005\"\002b\000\000\002s\000\000\002Q\000\000\001\191\000\000\004\026\002Q\000\000\002\017\002R\002d\000\193\001\223\001z\002R\002y\001\227\000\000\001\016\005\\\002x\001\150\002`\001}\001e\000\000\000\000\002`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\014\001^\002b\002h\000\000\005$\000\000\000\000\000\000\000\000\005&\0050\000\000\002\017\002Q\002d\000\193\000\000\000\000\001\228\005Z\000\000\002R\000\000\000\000\000\000\000\000\000\000\002\172\000\000\002e\000\000\002k\001\229\000\000\002`\005[\000\000\002q\000\000\001}\002g\000\000\000\000\002b\002h\000\000\000\000\000\000\002b\000\000\000\000\002\r\002\014\001^\002\017\000\000\002d\000\193\000\000\002\017\002s\002d\000\193\001\191\000\000\004\029\002Q\000\000\000\000\000\000\000\000\002e\001\223\002k\002R\000\000\001\227\000\000\001\016\002q\002\183\001}\002g\000\000\000\000\000\000\002h\002`\000\000\000\000\000\000\002h\000\000\002b\000\000\000\000\002\r\002\014\001^\001\191\000\000\004+\002s\000\000\002\017\000\000\002d\000\193\001\223\000\000\000\000\002Q\001\227\002e\001\016\002k\001\228\000\000\002e\002R\002k\002q\000\000\001}\002g\002\206\002q\000\000\001}\002g\001\229\000\000\002`\002\r\002\014\001^\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002s\000\000\002b\000\000\000\000\002s\000\000\000\000\001\228\000\000\000\000\000\000\003M\002\017\000\000\002d\000\193\001\024\000\000\002e\005\b\002k\001\229\002\r\002\014\001^\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\000\000\000\000\003N\000\000\002Q\000\000\000\000\002\r\002\014\001^\001\027\002h\002R\002b\000\000\000\000\002s\000\000\002\213\001\191\000\000\004|\002Q\000\000\002\017\002`\002d\000\193\001\223\000\000\002R\000\000\001\227\000\000\001\016\000\000\002\216\000\000\002e\000\000\002k\006\014\000\000\002`\000\000\000\000\002q\000\000\001}\002g\002\016\002\r\002\014\001^\000\000\000\000\002h\000\000\000\000\006\015\000\000\002\017\006\017\002d\000\193\000\000\002Q\000\000\000\000\002s\000\000\006\018\001\228\000\000\002R\000\000\000\000\000\000\000\000\000\000\002\222\000\000\001\t\002e\002b\002k\001\229\002`\001\016\001\029\000\000\002q\000\000\001}\002g\002\017\003P\002d\000\193\000\000\006\019\000\000\002b\002\r\002\014\001^\000\000\000\000\001\191\000\000\004\130\000\000\000\000\002\017\002s\002d\000\193\001\223\002Q\000\000\002e\001\227\000\000\001\016\000\000\000\000\002R\002h\002f\000\000\001}\002g\002\225\000\000\006\020\000\000\000\000\000\000\000\000\002`\001\030\000\000\006\021\000\000\000\000\002h\002b\000\000\002\r\002\014\001^\000\000\000\000\000\000\002e\000\000\002k\002\017\000\000\002d\000\193\001\228\002q\002Q\001}\002g\006\022\001'\000\000\000\000\000\000\002R\002e\000\000\002k\001\229\000\000\002\250\000\000\000\000\002q\006\023\001}\002g\002`\002s\000\000\000\000\000\000\002h\006\024\000\000\002\r\002\014\001^\006\026\000\000\000\000\002b\002\r\002\014\001^\000\000\002s\000\000\006\028\000\000\002Q\000\000\002\017\000\000\002d\000\193\000\000\002Q\002R\002e\000\000\002k\000\000\000\000\006\029\002R\000\000\002q\003\004\001}\002g\002`\000\000\000\000\000\000\003\t\000\000\000\000\002`\000\000\002\r\002\014\001^\000\000\002h\000\000\002b\002\r\002\014\001^\002s\000\000\001\191\000\000\004\139\000\000\000\000\002\017\000\000\002d\000\193\001\223\002Q\003M\000\000\001\227\000\000\001\016\000\000\000\000\002R\002e\000\000\002k\000\000\000\000\000\000\000\000\000\000\002q\003\011\001}\002g\002`\000\000\000\000\000\000\005\207\000\000\002h\002b\000\000\000\000\000\000\000\000\000\000\000\000\002b\002\r\002\014\001^\002\017\002s\002d\000\193\001\228\000\000\000\000\002\017\000\000\002d\000\193\000\000\002Q\000\000\000\000\002e\000\000\002k\001\229\000\000\002R\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\003\015\000\000\002h\002`\002\016\000\000\000\000\000\000\000\000\002h\000\000\002b\002\r\002\014\001^\002\017\002s\002d\000\193\002\r\002\014\001^\002\017\000\000\002d\000\193\000\000\002Q\000\000\002e\000\000\003\007\000\000\000\000\002Q\002R\002e\002q\003\007\001}\002g\000\000\002R\000\000\002q\003\023\001}\002g\002`\000\000\003P\000\000\003\029\000\000\002h\002`\000\000\000\000\000\000\000\000\002s\000\000\002b\002\r\002\014\001^\000\000\002s\000\000\000\000\000\000\000\000\000\000\002\017\002e\002d\000\193\000\000\002Q\000\000\000\000\002e\002f\003\007\001}\002g\002R\000\000\001\191\002q\004\147\001}\002g\000\000\000\000\000\000\003#\001\223\000\000\002`\000\000\001\227\000\000\001\016\000\000\002h\000\000\002b\002\r\002\014\001^\000\000\002s\000\000\002b\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\002Q\000\000\002\017\000\000\002d\000\193\000\000\000\000\002R\002e\000\000\003\007\000\000\000\000\003+\000\000\000\000\002q\001\228\001}\002g\002`\000\000\000\000\002\r\002\014\001^\002h\000\000\000\000\000\000\000\000\001\229\000\000\002h\002b\000\000\000\000\000\000\002Q\002s\000\000\000\000\000\000\000\000\000\000\002\017\002R\002d\000\193\000\000\000\000\000\000\0030\002e\000\000\003\007\000\000\000\000\000\000\002`\002e\002q\003\007\001}\002g\000\000\000\000\000\000\002q\000\000\001}\002g\001\191\000\000\006H\000\000\000\000\002h\000\000\002b\000\000\001\223\000\000\000\000\002s\001\227\000\000\001\016\000\000\000\000\002\017\002s\002d\000\193\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\003'\000\000\000\000\002Q\000\000\000\000\002q\000\000\001}\002g\000\000\002R\002b\002\r\002\014\001^\002h\000\000\000\000\001\228\000\000\003<\000\000\002\017\002`\002d\000\193\000\000\002Q\002s\000\000\000\000\000\000\001\229\000\000\000\000\002R\002\r\002\014\001^\000\000\000\000\000\000\002e\000\000\002k\003A\000\000\000\000\002`\000\000\002q\002Q\001}\002g\002h\000\000\000\000\000\000\000\000\002R\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\003F\000\000\000\000\002`\002s\000\000\000\000\002Q\000\000\000\000\000\000\000\000\002e\002b\002k\002R\000\000\002\r\002\014\001^\002q\000\000\001}\002g\002\017\003U\002d\000\193\002`\000\000\000\000\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002b\000\000\002R\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\002\017\003X\002d\000\193\002`\000\000\000\000\002h\000\000\000\000\000\000\000\000\000\000\002b\002\r\002\014\001^\000\000\002\r\002\014\001^\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\002Q\000\000\000\000\002h\002Q\002e\000\000\003\007\002R\002b\000\000\000\000\002R\002q\003^\001}\002g\000\000\003`\000\000\002\017\002`\002d\000\193\000\000\002`\000\000\002h\000\000\000\000\002e\000\000\003\007\000\000\002b\000\000\002s\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\002h\000\000\002e\000\000\003\007\000\000\000\000\000\000\000\000\002s\002q\000\000\001}\002g\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\002e\002b\003\007\000\000\000\000\002b\002s\000\000\002q\000\000\001}\002g\002\017\000\000\002d\000\193\002\017\000\000\002d\000\193\000\000\000\000\002\r\002\014\001^\002e\000\000\003'\000\000\000\000\000\000\002s\000\000\002q\000\000\001}\002g\002Q\002\r\002\014\001^\000\000\000\000\000\000\002h\002R\000\000\000\000\002h\000\000\000\000\003j\000\000\002Q\000\000\000\000\002s\000\000\002`\000\000\000\000\002R\000\000\000\000\002\r\002\014\001^\003s\000\000\000\000\000\000\002e\000\000\002k\002`\002e\000\000\002k\000\000\002q\000\000\001}\002g\002q\000\000\001}\002g\003\175\000\000\000\000\000\000\000\000\000\000\002\r\002\014\001^\000\000\000\000\002\r\002\014\001^\000\000\002s\000\000\000\000\000\000\002s\000\000\002Q\000\000\000\000\000\000\000\000\002Q\000\000\000\000\002R\002b\000\000\000\000\000\000\002R\003v\000\000\000\000\000\000\000\000\003\132\002\017\002`\002d\000\193\000\000\002b\002`\000\000\000\000\000\000\002\r\002\014\001^\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002\016\002h\002R\000\000\000\000\000\000\000\000\000\000\003\135\000\000\000\000\002\017\000\000\002d\000\193\002`\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\002b\002k\000\000\000\000\000\000\002b\000\000\002q\000\000\001}\002g\002\017\000\000\002d\000\193\002e\002\017\002k\002d\000\193\000\000\000\000\000\000\002q\000\000\001}\002g\002\r\002\014\001^\002s\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\000\000\002e\002Q\002h\000\000\002b\002s\002Q\002h\002f\002R\001}\002g\000\000\000\000\002R\002\017\000\000\002d\000\193\003\145\000\000\000\000\002`\000\000\003\150\000\000\000\000\002`\000\000\002e\000\000\002k\000\000\000\000\002e\000\000\002k\002q\000\000\001}\002g\000\000\002q\000\000\001}\002g\000\000\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\002s\000\000\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\002k\000\000\000\000\000\000\006\014\002b\002q\000\000\001}\002g\002b\000\000\000\000\002\r\002\014\001^\002\017\000\000\002d\000\193\000\000\002\017\006\015\002d\000\193\006\017\000\000\000\000\002Q\002s\000\000\002\r\002\014\001^\006\018\000\000\002R\000\000\000\000\000\000\000\000\000\000\003\199\000\000\000\000\000\000\002Q\000\000\002h\002`\000\000\000\000\000\000\002h\002R\000\000\000\000\000\000\000\000\000\000\003\212\000\000\000\000\006\019\002\r\002\014\001^\002`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\003\007\000\000\002Q\002e\000\000\003\007\002q\000\000\001}\002g\002R\002q\000\000\001}\002g\000\000\004\000\000\000\000\000\000\000\006\020\000\000\000\000\002`\000\000\000\000\000\000\000\000\006\021\002s\000\000\002b\000\000\000\000\002s\000\000\002\r\002\014\001^\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\002b\000\000\002Q\006!\000\000\000\000\000\000\000\000\000\000\000\000\002R\002\017\000\000\002d\000\193\000\000\004C\000\000\006\023\000\000\000\000\000\000\000\000\002`\000\000\002h\000\000\006\024\000\000\000\000\000\000\000\000\006\026\002b\000\000\000\000\000\000\000\000\002\r\002\014\001^\000\000\006\028\002h\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\002e\002Q\002k\000\000\000\000\000\000\006\029\000\000\002q\002R\001}\002g\001]\001^\000\000\005p\000\000\000\000\002e\000\000\002k\000\000\002`\000\000\002h\000\000\002q\000\000\001}\002g\002b\002s\001_\001o\000\000\001a\001b\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\002s\000\000\002e\000\000\002k\000\000\004\016\000\000\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\001\024\000\000\000\000\005\005\000\000\000\000\000\000\002h\000\000\001p\000\000\001q\002-\000\000\000\000\002b\002s\000\000\000\000\000\000\002\r\002\014\001^\000\000\000\000\000\000\002\017\001\027\002d\000\193\000\000\000\000\000\000\000\000\002e\002Q\002k\002\r\002\014\001^\001x\000\000\002q\002R\001}\002g\000\000\000\000\000\000\005s\000\000\001g\002Q\000\000\000\193\000\000\002`\000\000\002h\000\000\002R\000\000\003{\000\000\000\000\002s\005\130\000\000\000\000\000\000\005\007\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\002e\000\000\002k\000\000\000\000\000\000\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\001\t\000\000\000\000\000\000\000\000\000\000\001\016\005\n\000\000\000\000\000\000\001z\000\000\002\r\002\014\001^\002b\002s\000\000\001{\000\000\001}\001e\000\000\000\000\000\000\000\000\002\017\002Q\002d\000\193\000\000\000\000\002b\000\000\000\000\002R\002\r\002\014\001^\000\000\000\000\005\133\000\000\002\017\000\000\002d\000\193\000\000\002`\000\000\000\000\002Q\000\000\002\r\002\014\001^\000\000\005\011\002h\002R\000\000\000\000\000\000\000\000\000\000\005\146\000\000\001\024\002Q\004\213\001\025\005\016\002`\005\r\000\000\002h\002R\000\000\000\000\000\000\000\000\000\000\005\149\000\000\001'\002e\000\000\002k\000\000\002`\000\000\000\000\000\000\002q\001\027\001}\002g\000\000\000\000\000\000\000\000\000\000\002e\000\000\002k\000\000\000\000\002b\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\002s\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\014\001^\002b\000\000\002s\000\000\000\000\000\000\001#\000\000\000\000\000\000\000\000\002\017\002Q\002d\000\193\000\000\000\000\002b\000\000\002h\002R\000\000\002\r\002\014\001^\000\000\005\170\000\000\002\017\000\000\002d\000\193\000\000\002`\000\000\001\t\000\000\002Q\002\r\002\014\001^\001\016\001\029\002h\000\000\002R\002e\000\000\002k\000\000\000\000\005\173\000\000\002Q\002q\000\000\001}\002g\002`\000\000\002h\002R\000\000\000\000\000\000\000\000\000\000\005\177\000\000\000\000\002e\000\000\002k\000\000\002`\000\000\000\000\002s\002q\000\000\001}\002g\000\000\000\000\000\000\000\000\0017\002e\000\000\002k\000\000\006\014\002b\001\030\000\000\002q\000\000\001}\002g\000\000\000\000\002s\000\000\002\017\000\000\002d\000\193\000\000\000\000\006\015\000\000\000\000\006\017\000\000\000\000\000\000\000\000\002b\002s\000\000\001'\006\018\000\000\0018\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\002b\000\000\002h\000\000\000\000\002\r\002\014\001^\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\000\000\006\019\000\000\000\000\002Q\000\000\000\000\000\000\001]\001^\000\000\002h\002R\002e\000\000\002k\000\000\000\000\006\184\000\000\000\000\002q\000\000\001}\002g\002`\000\000\002h\001_\001o\000\000\001a\001b\000\000\000\000\006\020\000\000\000\000\002e\000\000\002k\000\000\000\000\006\021\002s\000\000\002q\000\000\001}\002g\000\000\006R\000\000\000\000\002e\000\000\002k\000\000\000\000\000\000\000\000\000\000\002q\000\000\001}\002g\000\000\006*\000\000\002s\000\000\001p\000\000\001q\002-\000\000\000\000\000\000\002\r\002\014\001^\000\000\006\023\000\000\002b\002s\000\000\000\000\000\000\000\000\000\000\006\024\000\000\002Q\000\000\002\017\006\026\002d\000\193\000\000\000\000\002R\001x\002\r\002\014\001^\006\028\006\186\000\000\000\000\000\000\000\000\000\000\001g\002`\000\000\000\193\000\000\002Q\002\r\002\014\001^\006\029\000\000\003{\000\000\002R\002h\000\000\001]\001^\000\000\000\000\000\000\002Q\000\000\000\000\000\000\000\000\002`\000\000\000\000\002R\001\024\000\000\000\000\005\005\000\000\000\000\001_\001o\000\000\001a\001b\002e\002`\002k\000\000\000\000\001\159\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\000\000\001\027\000\000\001z\002b\000\000\000\000\000\000\000\000\000\000\000\000\001{\000\000\001}\001e\002\017\002s\002d\000\193\000\000\000\000\000\000\000\000\001p\000\000\001q\001\146\000\000\000\000\002b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\005\007\002b\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\001x\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\000\000\001g\000\000\000\000\000\193\000\000\000\000\000\000\002h\001\t\002e\000\000\002k\000\000\000\000\001\016\005\n\000\000\002q\000\000\001}\002g\000\000\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\004\017\000\000\000\000\000\000\002s\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\000\000\002e\000\000\004\r\001]\001^\000\000\000\000\000\000\002q\001z\001}\002g\000\000\000\000\000\000\002s\005\011\001{\000\000\001}\001e\001]\001^\001_\001o\000\000\001a\001b\004\213\000\000\005\015\002s\005\r\001\143\000\000\002\r\002\014\001^\000\000\000\000\000\000\001_\001o\001'\001a\001b\000\000\000\000\000\000\000\000\002Q\001\148\000\000\001]\001^\000\000\000\000\000\000\002R\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001p\000\000\001q\001\146\000\000\002`\000\000\001_\001o\000\000\001a\001b\000\000\000\000\000\000\002\r\002\014\001^\001p\000\000\001q\001\146\000\000\001]\001^\000\000\000\000\000\000\000\000\000\000\002Q\001x\000\000\000\000\000\000\000\000\000\000\000\000\002R\000\000\000\000\000\000\001g\001_\001o\000\193\001a\001b\000\000\001x\001p\002`\001q\002-\000\000\000\000\000\000\000\000\000\000\000\000\001g\000\000\000\000\000\193\002b\000\000\000\000\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\000\000\001x\000\000\002Q\000\000\000\000\001p\000\000\001q\0025\000\000\002R\001g\000\000\000\000\000\193\000\000\000\000\000\000\000\000\000\000\001z\000\000\003w\002`\000\000\000\000\002h\000\000\001{\002b\001}\001e\000\000\000\000\000\000\000\000\001x\000\000\001z\000\000\002\017\000\000\002d\000\193\000\000\000\000\001{\001g\001}\001e\000\193\000\000\000\000\002e\000\000\003\183\000\000\000\000\000\000\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\000\000\000\000\001z\000\000\002h\000\000\000\000\000\000\000\000\0028\001{\000\000\001}\001e\002b\000\000\002s\002\r\002\014\001^\000\000\000\000\002\r\002\014\001^\002\017\000\000\002d\000\193\000\000\000\000\002e\002Q\003Q\000\000\000\000\000\000\002Q\001z\002q\002R\001}\002g\000\000\000\000\002R\001{\000\000\001}\001e\000\000\000\000\000\000\002`\000\000\000\000\000\000\002h\002`\000\000\000\000\000\000\002s\000\000\002\r\002\014\001^\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002Q\000\000\000\000\000\000\002Q\002e\000\000\002\248\002R\000\000\000\000\000\000\002R\002q\000\000\001}\002g\000\000\000\000\000\000\000\000\002`\000\000\000\000\000\000\002`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002b\000\000\000\000\002s\000\000\002b\000\000\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\014\001^\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002h\000\000\000\000\002Q\002b\002h\000\000\002R\002b\000\000\000\000\002R\000\000\000\000\000\000\002\017\000\000\002d\000\193\002\017\002`\002d\000\193\000\000\002`\000\000\000\000\002e\000\000\002m\000\000\000\000\002e\000\000\002o\002q\000\000\001}\002g\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\002h\000\000\000\000\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\002t\000\000\002e\002b\002{\000\000\002q\002b\001}\002g\002q\000\000\001}\002g\002\017\000\000\002d\000\193\002\017\000\000\002d\000\193\002\r\002\014\001^\000\000\002\r\002\014\001^\002s\000\000\000\000\000\000\002s\000\000\000\000\000\000\002Q\002\r\002\014\001^\002Q\000\000\000\000\000\000\002R\002h\000\000\000\000\002R\002h\000\000\000\000\002Q\000\000\000\000\000\000\000\000\002`\000\000\000\000\002R\002`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\002`\002}\000\000\002e\000\000\002\127\000\000\002q\000\000\001}\002g\002q\000\000\001}\002g\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\r\002\014\001^\002s\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002b\000\000\000\000\000\000\002b\000\000\000\000\002R\000\000\000\000\000\000\002\017\000\000\002d\000\193\002\017\002b\002d\000\193\000\000\002`\000\000\000\000\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\002\r\002\014\001^\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\002h\000\000\000\000\002Q\002h\000\000\000\000\002Q\000\000\000\000\000\000\002R\000\000\000\000\000\000\002R\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002`\000\000\000\000\002e\002`\002\129\000\000\002e\000\000\002\131\000\000\002q\002b\001}\002g\002q\000\000\001}\002g\002e\000\000\002\133\000\000\002\017\000\000\002d\000\193\002q\000\000\001}\002g\000\000\000\000\000\000\002s\000\000\000\000\000\000\002s\002\r\002\014\001^\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\002s\000\000\000\000\000\000\002Q\002h\000\000\000\000\002Q\002b\000\000\000\000\002R\002b\000\000\000\000\002R\000\000\000\000\000\000\002\017\000\000\002d\000\193\002\017\002`\002d\000\193\000\000\002`\000\000\000\000\002e\000\000\002\135\002\r\002\014\001^\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\001\024\000\000\000\000\001\025\002Q\000\000\002h\000\000\000\000\000\000\002h\000\000\002R\000\000\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002`\000\000\001\027\000\000\006\133\000\000\000\000\000\000\002e\000\000\002\137\000\000\002e\002b\002\139\000\000\002q\002b\001}\002g\002q\000\000\001}\002g\002\017\000\000\002d\000\193\002\017\000\000\002d\000\193\000\000\000\000\000\000\002\r\002\014\001^\000\000\002s\002\r\002\014\001^\002s\000\000\001#\000\000\000\000\000\000\000\000\002Q\000\000\000\000\000\000\000\000\002Q\002h\000\000\002R\002b\002h\000\000\000\000\002R\000\000\000\000\000\000\000\000\000\000\000\000\002\017\002`\002d\000\193\001\t\000\000\002`\000\000\000\000\000\000\001\016\001\029\000\000\002e\000\000\002\141\000\000\002e\000\000\002\143\000\000\002q\000\000\001}\002g\002q\000\000\001}\002g\000\000\000\000\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\014\001^\002s\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\000\000\0017\002Q\000\000\000\000\002e\002b\002\145\001\030\000\000\002R\002b\006\140\002q\000\000\001}\002g\002\017\000\000\002d\000\193\000\000\002\017\002`\002d\000\193\000\000\002\r\002\014\001^\000\000\000\000\002\r\002\014\001^\001'\002s\000\000\001A\000\000\000\000\000\000\002Q\000\000\000\000\000\000\000\000\002Q\000\000\002h\002R\000\000\000\000\000\000\002h\002R\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002`\000\000\000\000\000\000\000\000\002`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\002\147\000\000\000\000\002e\002b\002\149\002q\000\000\001}\002g\000\000\002q\000\000\001}\002g\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\014\001^\000\000\002s\000\000\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\002Q\000\000\000\000\000\000\002b\000\000\000\000\002h\002R\002b\000\000\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\002\017\002`\002d\000\193\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\002\151\000\000\000\000\000\000\002Q\000\000\002q\000\000\001}\002g\000\000\002h\002R\000\000\000\000\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002`\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\002\153\000\000\000\000\002e\002b\002\155\002q\000\000\001}\002g\000\000\002q\000\000\001}\002g\002\017\000\000\002d\000\193\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\002s\002Q\000\000\000\000\000\000\002\164\001^\000\000\000\000\002R\002b\000\000\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\017\002`\002d\000\193\002\218\001o\000\000\001a\001b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001]\001^\000\000\002e\000\000\002\157\000\000\000\000\000\000\002\181\000\000\002q\000\000\001}\002g\000\000\002h\002\184\001]\001^\001_\002\185\000\000\001a\001b\000\000\000\000\002\181\000\000\000\000\002\223\002\239\002\240\000\000\002s\002\184\000\000\000\000\001_\002\185\000\000\001a\001b\002e\002b\002\159\002\r\002\014\001^\000\000\000\000\002q\000\000\001}\002g\002\017\000\000\002d\000\193\000\000\006\014\002Q\001x\000\000\000\000\000\000\000\000\000\000\000\000\002R\000\000\000\000\000\000\001g\002s\007\r\000\193\000\000\007\014\000\000\000\000\006\017\002`\000\000\000\000\000\000\000\000\002h\000\000\000\000\006\018\000\000\000\000\000\000\001f\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001g\002\243\000\000\000\193\000\000\000\000\000\000\001f\000\000\002e\000\000\002\161\000\000\000\000\006\019\000\000\000\000\002q\001g\001}\002g\000\193\000\000\000\000\000\000\000\000\000\000\001z\000\000\000\000\002\r\002\014\001^\000\000\002\186\001{\002b\001}\001e\000\000\002s\001\024\000\000\000\000\005\005\002Q\000\000\002\017\006\020\002d\000\193\000\000\002\186\002R\002\188\000\000\006\021\000\000\000\000\001z\000\000\000\000\000\000\002\r\002\014\001^\002`\001\150\001\027\001}\001e\000\000\002\187\000\000\000\000\000\000\007\015\001z\002Q\002h\000\000\000\000\002\r\002\014\001^\001\150\002R\001}\001e\000\000\000\000\000\000\000\000\000\000\000\000\006\023\000\000\002Q\000\000\002`\000\000\000\000\000\000\000\000\006\024\002R\002e\000\000\002\254\006\026\000\000\005\007\000\000\000\000\002q\000\000\001}\002g\002`\006\028\000\000\000\000\000\000\000\000\000\000\002b\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\000\000\006\029\002\017\002s\002d\000\193\001\t\002Q\002\r\002\014\001^\000\000\001\016\005\n\000\000\002R\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002b\000\000\000\000\000\000\002`\000\000\000\000\002R\000\000\000\000\002h\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\002b\002`\000\000\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\002e\002Q\003\027\005\011\000\000\000\000\002h\000\000\002q\002R\001}\002g\000\000\000\000\000\000\004\213\000\000\005\014\000\000\005\r\000\000\000\000\002`\000\000\000\000\002h\002b\000\000\000\000\000\000\001'\002s\000\000\002e\000\000\003!\000\000\002\017\005\028\002d\000\193\002q\002b\001}\002g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\002\017\003&\002d\000\193\002\r\002\014\001^\002q\000\000\001}\002g\002s\000\000\005\029\006\192\005\030\002h\000\000\000\000\002Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002R\002b\000\000\002s\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\002\017\002`\002d\000\193\002e\005\031\003.\000\000\000\000\000\000\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\000\000\002e\000\000\0033\000\000\000\000\000\000\000\000\000\000\002q\000\000\001}\002g\002h\000\000\000\000\002s\000\000\000\000\005 \002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\005!\000\000\005\"\000\000\002s\000\000\000\000\002Q\000\000\000\000\000\000\000\000\002e\002b\0035\002R\002\r\002\014\001^\000\000\002q\000\000\001}\002g\002\017\005^\002d\000\193\002`\000\000\000\000\002Q\002\r\002\014\001^\000\000\000\000\001\024\000\000\002R\001\025\000\000\000\000\002s\002\r\002\014\001^\002Q\005$\006\194\001]\001^\002`\005&\0050\002R\002h\000\000\000\000\002Q\000\000\000\000\000\000\005Z\001\027\000\000\000\000\002R\002`\000\000\001_\001o\000\000\001a\001b\000\000\000\000\000\000\000\000\005[\002`\000\000\000\000\002e\000\000\0038\000\000\002b\000\000\000\000\000\000\002q\000\000\001}\002g\002\r\002\014\001^\002\017\000\000\002d\000\193\000\000\000\000\000\000\006\014\000\000\001#\000\000\000\000\002Q\002b\000\000\001p\002s\001q\002-\000\000\002R\000\000\007\r\000\000\002\017\007\014\002d\000\193\006\017\002b\000\000\000\000\002h\002`\000\000\000\000\000\000\006\018\001\t\000\000\002\017\002b\002d\000\193\001\016\001\029\001x\000\000\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\002h\001g\000\000\002e\000\193\003?\000\000\000\000\000\000\000\000\006\019\002q\003z\001}\002g\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\002h\003D\000\000\000\000\000\000\006\132\002s\002q\002b\001}\002g\000\000\001\030\000\000\000\000\002e\006\020\003I\000\000\002\017\000\000\002d\000\193\002q\006\021\001}\002g\002e\000\000\003L\002s\000\000\001z\002\164\001^\002q\000\000\001}\002g\001'\001{\000\000\001}\001e\007\019\000\000\002s\002\r\002\014\001^\000\000\002h\000\000\002\218\001o\000\000\001a\001b\002s\000\000\000\000\000\000\002Q\006\023\000\000\000\000\000\000\000\000\000\000\000\000\002R\000\000\006\024\000\000\000\000\000\000\000\000\006\026\002e\000\000\003~\002\164\001^\002`\000\000\000\000\002q\006\028\001}\002g\000\000\000\000\000\000\000\000\000\000\002\223\002\239\002\240\002\164\001^\000\000\002\218\001o\006\029\001a\001b\000\000\000\000\000\000\002s\002\164\001^\000\000\000\000\000\000\000\000\001]\001^\002\218\001o\000\000\001a\001b\000\000\000\000\000\000\000\000\001x\000\000\000\000\002\218\001o\000\000\001a\001b\000\000\001_\001o\001g\001a\001b\000\193\002b\002\223\002\239\002\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\002\r\002\014\001^\002\223\002\239\002\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\137\002\223\002\239\002\240\001x\000\000\000\000\000\000\001p\002\015\001q\006\238\000\000\006\240\002h\001g\000\000\000\000\000\193\000\000\000\000\001x\000\000\000\000\000\000\000\000\001z\000\000\000\000\000\000\000\000\000\000\001g\001x\001{\000\193\001}\001e\000\000\001x\000\000\002e\000\000\003\128\001g\000\000\000\000\000\193\004\006\002q\001g\001}\002g\000\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\188\001]\001^\000\000\000\000\000\000\000\000\002s\000\000\001z\000\000\000\000\005\222\000\000\000\000\000\000\002\016\001{\000\000\001}\001e\001_\001o\000\000\001a\001b\001z\002\017\000\000\002d\000\193\000\000\000\000\000\000\001{\000\000\001}\001e\001z\000\000\000\000\000\000\000\000\000\000\001z\000\000\001{\001\024\001}\001e\001\025\000\000\001{\001+\001}\001e\001\024\000\000\000\000\001\025\000\000\000\000\001+\000\000\001p\000\000\001q\0063\000\000\000\000\000\000\000\000\000\000\001,\001\027\000\000\000\000\000\000\000\000\000\000\001-\000\000\001,\001\027\001]\001^\002e\000\000\000\000\001F\000\000\001]\001^\000\000\002f\001x\001}\002g\000\000\000\000\000\000\000\000\000\000\000\000\001_\001o\001g\001a\001b\000\193\000\000\001_\001o\000\000\001a\001b\000\000\001#\001]\001^\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\0011\000\000\000\000\000\000\001_\001o\000\000\001a\001b\0011\000\000\000\000\001\t\001p\000\000\001q\001\151\000\000\001\016\001\029\001p\001\t\001q\001\129\000\000\000\000\000\000\001\016\001\029\000\000\000\000\001z\000\000\001]\001^\000\000\000\000\000\000\000\000\001{\000\000\001}\001e\000\000\001x\000\000\000\000\001p\000\000\001q\001~\001x\000\000\001_\001o\001g\001a\001b\000\193\000\000\000\000\000\000\001g\0017\000\000\000\193\000\000\000\000\000\000\000\000\001\030\000\000\0017\000\000\001?\000\000\000\000\000\000\001x\001\030\000\000\001]\001^\001?\000\000\000\000\000\000\001]\001^\001g\000\000\000\000\000\193\000\000\000\000\000\000\001p\001'\001q\001s\001A\001_\001o\000\000\001a\001b\001'\001_\001o\001A\001a\001b\000\000\000\000\001z\000\000\000\000\000\000\000\000\001]\001^\001z\001{\000\000\001}\001e\000\000\001x\000\000\001{\000\000\001}\001e\000\000\000\000\000\000\000\000\000\000\001g\001_\001o\000\193\001a\001b\001p\000\000\001q\001v\001z\000\000\001p\000\000\001q\001y\000\000\000\000\001{\000\000\001}\001e\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\001x\000\000\000\000\000\000\000\000\000\000\001x\001p\000\000\001q\001|\001g\000\000\000\000\000\193\001_\001o\001g\001a\001b\000\193\000\000\001z\000\000\000\000\000\000\000\000\001]\001^\000\000\001{\000\000\001}\001e\000\000\000\000\000\000\000\000\001x\000\000\000\000\000\000\000\000\000\000\001]\001^\000\000\001_\001o\001g\001a\001b\000\193\000\000\000\000\000\000\000\000\000\000\001p\000\000\001q\001\134\000\000\000\000\001_\001o\000\000\001a\001b\000\000\001z\000\000\000\000\000\000\001]\001^\001z\000\000\001{\000\000\001}\001e\000\000\002\214\001{\000\000\001}\001e\000\000\001x\001p\002\217\001q\001\137\001_\002\185\000\000\001a\001b\000\000\001g\000\000\000\000\000\193\000\000\000\000\000\000\001p\001z\001q\002G\000\000\000\000\000\000\000\000\000\000\001{\000\000\001}\001e\000\000\001x\000\000\001]\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001g\000\000\000\000\000\193\000\000\000\000\001x\000\000\000\000\000\000\000\000\001_\001o\000\000\001a\001b\000\000\001g\000\000\000\000\000\193\000\000\000\000\000\000\000\000\001]\001^\001z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001{\001f\001}\001e\000\000\000\000\000\000\001]\001^\000\000\001_\001o\001g\001a\001b\000\193\000\000\000\000\000\000\001p\000\000\001q\002\228\000\000\001z\000\000\000\000\001_\001o\000\000\001a\001b\001{\000\000\001}\001e\000\000\000\000\000\000\001]\001^\001z\000\000\000\000\000\000\000\000\002\186\000\000\000\000\001{\001x\001}\001e\001p\000\000\001q\002\231\000\000\000\000\001_\001o\001g\001a\001b\000\193\000\000\002\r\002\014\001^\000\000\001p\001z\001q\002\234\000\000\000\000\000\000\000\000\000\000\001\150\000\000\001}\001e\000\000\001x\000\000\001]\001^\000\000\002L\001\024\000\000\000\000\001\025\000\000\001g\001B\000\000\000\193\000\000\000\000\001x\001p\000\000\001q\002\242\001_\001o\000\000\001a\001b\000\000\001g\000\000\000\000\000\193\001D\001\027\000\000\000\000\001z\000\000\004\206\000\000\000\000\000\000\000\000\000\000\001{\001\024\001}\001e\001\025\001x\000\000\001B\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001g\000\000\000\000\000\193\000\000\001p\000\000\001q\004A\000\000\001z\001D\001\027\000\000\000\000\000\000\001#\002\016\001{\000\000\001}\001e\000\000\000\000\000\000\000\000\000\000\001z\002\017\000\000\002d\000\193\000\000\0011\000\000\001{\001x\001}\001e\000\000\000\000\000\000\001]\001^\000\000\001\t\000\000\001g\000\000\000\000\000\193\001\016\001\029\000\000\001\024\001#\000\000\001\025\000\000\001z\001+\000\000\001_\002\185\000\000\001a\001b\001{\000\000\001}\001e\000\000\0011\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0010\001\027\000\000\000\000\001\t\000\000\000\000\002e\001]\001^\001\016\001\029\000\000\000\000\000\000\002f\0017\001}\002g\000\000\000\000\000\000\000\000\001\030\000\000\000\000\001z\005\004\001_\002\185\000\000\001a\001b\000\000\001{\000\000\001}\001e\000\000\000\000\000\000\000\000\000\000\000\000\001#\000\000\000\000\000\000\001]\001^\001'\000\000\000\000\001A\000\000\0017\001f\000\000\000\000\000\000\000\000\0011\001\030\001]\001^\000\000\001?\001g\001_\002\185\000\193\001a\001b\001\t\000\000\000\000\001]\001^\000\000\001\016\001\029\000\000\000\000\001_\002\185\000\000\001a\001b\000\000\001'\000\000\000\000\001A\005\150\000\000\000\000\001_\002\185\000\000\001a\001b\003k\001f\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001g\000\000\000\000\000\193\000\000\000\000\000\000\003m\000\000\000\000\000\000\0017\000\000\001z\000\000\000\000\000\000\000\000\001\030\000\000\000\000\001\150\001?\001}\001e\000\000\000\000\000\000\000\000\001f\000\000\000\000\000\000\000\000\003k\000\000\000\000\000\000\000\000\000\000\001g\000\000\000\000\000\193\001f\001'\000\000\000\000\001A\000\000\000\000\000\000\000\000\003l\000\000\001g\000\000\001f\000\193\001z\001]\001^\000\000\000\000\000\000\000\000\000\000\001\150\001g\001}\001e\000\193\000\000\000\000\003k\000\000\000\000\005\174\000\000\000\000\001_\002\185\000\000\001a\001b\000\000\000\000\000\000\000\000\006\001\000\000\000\000\000\000\003p\000\000\000\000\000\000\001]\001^\001z\000\000\000\000\002\186\000\000\000\000\000\000\000\000\001\150\000\000\001}\001e\000\000\000\000\000\000\001z\000\000\000\000\001_\002\185\000\000\001a\001b\001\150\000\000\001}\001e\000\000\001z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\150\006\003\001}\001e\001]\001^\000\000\000\000\000\000\000\000\000\000\001]\001^\000\000\000\000\000\000\001]\001^\000\000\001f\000\000\000\000\000\000\000\000\001_\002\185\000\000\001a\001b\000\000\001g\001_\002\185\000\193\001a\001b\001_\002\185\000\000\001a\001b\000\000\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]\001^\001f\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\186\000\000\005\028\001g\000\000\000\000\000\193\000\000\000\000\000\000\001_\002\185\000\000\001a\001b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001z\000\000\000\000\000\000\000\000\005\029\006\174\005\030\001\150\001f\001}\001e\005\201\000\000\000\000\001\024\001f\000\000\001\025\000\000\001g\001f\000\000\000\193\000\000\000\000\000\000\001g\000\000\000\000\000\193\000\000\001g\000\000\000\000\000\193\005\031\001z\000\000\000\000\000\000\000\000\001\027\000\000\000\000\001\150\000\000\001}\001e\000\000\000\000\000\000\004\191\000\000\005\201\000\000\000\000\000\000\005\214\001f\000\000\006\001\000\000\000\000\000\000\000\000\006\001\005\147\001\024\005 \001g\001\025\000\000\000\193\000\000\000\000\000\000\000\000\005!\001z\005\"\000\000\000\000\000\000\000\000\001#\001z\001\150\000\000\001}\001e\001z\000\000\000\000\001\150\001\027\001}\001e\000\000\001\150\005\213\001}\001e\005^\003o\003\230\000\000\001\024\006\002\001\024\001\025\000\000\001\025\006\n\001\t\000\000\000\000\000\000\000\000\006v\001\016\001\029\000\000\000\000\000\000\000\000\005$\000\000\000\000\001z\000\000\005&\0050\006\014\001\027\000\000\001\027\001\150\001#\001}\001e\005Z\000\000\000\000\004\191\000\000\004\191\000\000\007\r\000\000\000\000\007\014\000\000\000\000\006\017\000\000\000\000\005[\000\000\005\161\000\000\005\171\000\000\006\018\000\000\0017\000\000\001\t\000\000\000\000\000\000\000\000\001\030\001\016\001\029\000\000\004\196\001#\000\000\001#\001]\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\019\000\000\002\r\002\014\001^\000\000\000\000\001'\001_\002\170\001A\001a\001b\000\000\001\t\000\000\001\t\000\000\000\000\000\000\001\016\001\029\001\016\001\029\001\024\003M\0017\001\025\000\000\000\000\000\000\000\000\000\000\001\030\006\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\021\001\024\000\000\000\000\001\025\000\000\000\000\000\000\000\000\001\027\001\024\000\000\000\000\001\025\000\000\000\000\000\000\000\000\001'\002\207\007\024\003\237\000\000\0017\000\000\0017\000\000\000\000\001\027\000\000\001\030\000\000\001\030\000\000\004\196\000\000\004\196\001\027\000\000\006\023\001f\000\000\000\000\000\000\000\000\000\000\005\028\003\230\006\024\000\000\000\000\001g\001#\006\026\000\193\002\016\000\000\001'\000\000\001'\001A\003\233\001A\006\028\000\000\000\000\002\017\000\000\002d\000\193\000\000\001#\001\024\000\000\005\029\001\025\005\030\000\000\000\000\006\029\001#\001\t\000\000\000\000\000\000\000\000\000\000\001\016\001\029\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\027\001\t\003O\000\000\000\000\005\196\005\031\001\016\001\029\000\000\001\t\001z\000\000\000\000\000\000\001\024\001\016\001\029\001\025\001\150\000\000\001}\001e\000\000\000\000\000\000\002e\001\024\000\000\000\000\001\025\000\000\000\000\0017\002f\000\000\001}\002g\000\000\005 \001\030\000\000\001\027\001#\002\178\000\000\000\000\000\000\005!\000\000\005\"\000\000\0017\000\000\001\027\000\000\000\000\000\000\000\000\001\030\000\000\0017\000\000\004\224\000\000\000\000\004\227\001'\001\030\006\014\001A\000\000\001\t\005#\000\000\000\000\000\000\000\000\001\016\001\029\000\000\001\024\000\000\000\000\001\025\001#\001'\007\004\000\000\001A\006\017\001\024\000\000\006\218\001\025\001'\005$\001#\003\237\006\018\000\000\005&\0050\000\000\000\000\000\000\000\000\000\000\001\027\000\000\000\000\005Z\000\000\000\000\001\t\000\000\000\000\000\000\001\027\000\000\001\016\001\029\001\024\0017\000\000\001\025\001\t\005[\006\019\000\000\001\030\000\000\001\016\001\029\004\211\000\000\000\000\000\000\000\000\000\000\001\024\000\000\000\000\001\025\000\000\000\000\000\000\000\000\000\000\001\027\000\000\001#\000\000\000\000\000\000\001\024\000\000\001'\001\025\000\000\001A\001#\006\020\000\000\000\000\0017\000\000\001\027\000\000\000\000\006\021\000\000\001\030\000\000\000\000\0015\004\224\0017\000\000\005\242\001\t\000\000\001\027\000\000\001\030\000\000\001\016\001\029\006\219\000\000\001\t\007\005\001#\000\000\000\000\000\000\001\016\001\029\000\000\001'\000\000\000\000\001A\000\000\000\000\000\000\000\000\000\000\000\000\006\023\001#\001'\000\000\000\000\001A\000\000\001\024\000\000\006\024\001\025\000\000\001\t\000\000\006\026\000\000\001#\001\024\001\016\001\029\001\025\000\000\0017\000\000\006\028\000\000\000\000\000\000\000\000\001\030\001\t\000\000\0017\006\179\001\027\001\024\001\016\001\029\001\025\001\030\006\029\000\000\000\000\001Q\001\027\001\t\000\000\000\000\000\000\000\000\000\000\001\016\001\029\002\r\002\014\001^\001'\000\000\000\000\001A\000\000\000\000\001\027\0017\000\000\000\000\001'\000\000\000\000\001A\001\030\002\r\002\014\001^\001\167\000\000\002N\001#\002\r\002\014\001^\0017\000\000\000\000\000\000\000\000\000\000\001#\001\030\000\000\000\000\000\000\000\000\000\000\002X\000\000\0017\001'\000\000\000\000\001A\002c\000\000\001\030\000\000\001#\001\t\001\205\002\r\002\014\001^\000\000\001\016\001\029\000\000\001'\001\t\000\000\001=\000\000\000\000\000\000\001\016\001\029\000\000\001\024\000\000\000\000\001\025\000\000\001'\002r\000\000\001A\001\t\000\000\000\000\000\000\000\000\000\000\001\016\001\029\000\000\001\024\000\000\000\000\001\025\000\000\002\016\000\000\000\000\000\000\001\027\000\000\000\000\000\000\000\000\0017\000\000\002\017\000\000\002d\000\193\000\000\001\030\000\000\002\016\0017\001\207\000\000\001\027\000\000\000\000\002\016\001\030\000\000\000\000\002\017\002$\002d\000\193\000\000\000\000\000\000\002\017\0017\002d\000\193\000\000\000\000\000\000\001'\001\030\000\000\001A\001#\0027\000\000\000\000\000\000\000\000\001'\000\000\002\016\001A\000\000\000\000\000\000\001\024\000\000\000\000\001\025\000\000\001#\002\017\000\000\002d\000\193\002e\001'\000\000\000\000\001A\000\000\001\t\000\000\002f\000\000\001}\002g\001\016\001\029\000\000\000\000\000\000\001\027\002e\000\000\000\000\000\000\000\000\000\000\001\t\002e\002f\000\000\001}\002g\001\016\001\029\000\000\002f\000\000\001}\002g\000\000\000\000\000\000\001\024\000\000\000\000\001\025\000\000\000\000\000\000\000\000\000\000\001\024\000\000\000\000\001\025\000\000\000\000\002e\000\000\0017\001\024\000\000\001#\001\025\000\000\002f\001\030\001}\002g\001\027\002\175\000\000\000\000\000\000\000\000\000\000\000\000\0017\001\027\000\000\002\r\002\014\001^\000\000\001\030\000\000\000\000\001\027\002\180\000\000\000\000\001\t\000\000\001'\000\000\000\000\001A\001\016\001\029\000\000\000\000\001\024\000\000\003\020\001\025\000\000\000\000\000\000\000\000\000\000\001\024\001'\001#\001\025\001A\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\001\027\000\000\001#\000\000\000\000\000\000\000\000\000\000\000\000\001\027\000\000\000\000\000\000\001\t\0017\001\024\000\000\000\000\001\025\001\016\001\029\001\030\001\t\000\000\000\000\002\197\000\000\000\000\001\016\001\029\001\024\001\t\001\024\001\025\000\000\001\025\000\000\001\016\001\029\000\000\000\000\000\000\001\027\001#\000\000\000\000\000\000\002\016\001'\000\000\000\000\001A\001#\000\000\000\000\000\000\000\000\001\027\002\017\001\027\002d\000\193\000\000\000\000\0017\000\000\000\000\000\000\000\000\000\000\000\000\001\030\001\t\0017\000\000\002\204\000\000\000\000\001\016\001\029\001\030\001\t\0017\000\000\002\211\001#\000\000\001\016\001\029\001\030\000\000\001\024\000\000\002\220\001\025\000\000\000\000\000\000\001'\000\000\001#\001A\001#\000\000\000\000\000\000\000\000\001'\000\000\000\000\001A\000\000\000\000\000\000\001\t\000\000\001'\002e\001\027\001A\001\016\001\029\000\000\0017\000\000\002f\000\000\001}\002g\001\t\001\030\001\t\0017\000\000\004P\001\016\001\029\001\016\001\029\001\030\000\000\001\024\000\000\004\168\005\005\000\000\000\000\000\000\000\000\000\000\001\024\000\000\001\024\005\005\000\000\001\025\000\000\001'\000\000\000\000\001A\001#\000\000\000\000\000\000\0017\001'\001\024\001\027\001A\001\025\000\000\001\030\000\000\000\000\000\000\004\180\001\027\000\000\001\027\0017\000\000\0017\001\024\000\000\000\000\001\025\001\030\000\000\001\030\001\t\004\193\000\000\004\210\001\027\000\000\001\016\001\029\001\024\001'\001\024\001\025\001A\005\005\000\000\000\000\000\000\000\000\000\000\000\000\001\027\005\007\000\000\000\000\001'\000\000\001'\001A\000\000\001A\005\007\000\000\001#\000\000\000\000\001\027\000\000\001\027\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001#\000\000\000\000\001\t\0017\000\000\000\000\000\000\000\000\001\016\005\n\001\030\001\t\000\000\001\t\004\226\001#\000\000\001\016\005\n\001\016\001\029\001\024\000\000\000\000\005\005\000\000\000\000\000\000\001\t\000\000\001#\000\000\005\007\000\000\001\016\001\029\000\000\001'\000\000\000\000\001A\000\000\000\000\000\000\001\t\000\000\000\000\000\000\001\027\000\000\001\016\001\029\000\000\001\024\000\000\000\000\001\025\000\000\000\000\001\t\005\011\001\t\000\000\000\000\0017\001\016\001\029\001\016\005\n\005\011\001\024\001\030\004\213\001\025\005\012\005~\005\r\000\000\000\000\0017\001\027\004\213\000\000\005\024\000\000\005\r\001\030\001'\000\000\000\000\005\144\005\007\000\000\000\000\000\000\0017\001'\001\027\001'\000\000\000\000\001A\001\030\000\000\000\000\000\000\005\168\000\000\000\000\000\000\0017\000\000\001\024\001'\000\000\001\025\001A\001\030\000\000\005\011\001\t\0066\000\000\001#\000\000\000\000\001\016\005\n\000\000\001'\000\000\004\213\001A\005\228\000\000\005\r\000\000\000\000\000\000\001\027\001#\000\000\000\000\000\000\001'\001\024\001'\001A\001\025\000\000\000\000\000\000\001\t\001\024\000\000\000\000\001\025\000\000\001\016\001\029\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\t\000\000\000\000\001\027\000\000\000\000\001\016\001\029\000\000\005\011\000\000\001\027\000\000\001#\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\213\000\000\005\254\000\000\005\r\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0017\000\000\001'\000\000\000\000\000\000\000\000\001\030\001\t\000\000\000\000\006\139\001#\000\000\001\016\001\029\000\000\0017\000\000\000\000\001#\000\000\000\000\000\000\001\030\000\000\000\000\000\000\006\143\000\000\000\000\000\000\000\000\000\000\001'\000\000\000\000\001A\000\000\000\000\000\000\001\t\000\000\000\000\000\000\000\000\000\000\001\016\001\029\001\t\000\000\001'\000\000\000\000\001A\001\016\001\029\000\000\000\000\0017\000\000\000\000\000\000\000\000\000\000\000\000\001\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\0017\001'\000\000\000\000\001\200\000\000\000\000\001\030\0017\000\000\000\000\000\000\000\000\000\000\000\000\001\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\001'\000\000\000\000\001\202\000\000\000\000\000\000\000\000\001'\000\000\000\000\003\232"))
+  
+  and semantic_action =
+    [|
+      (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 : unit = 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) = 
+# 3641 "parsing/parser.mly"
+                                                ( "+" )
+# 1338 "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 : unit = 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) = 
+# 3642 "parsing/parser.mly"
+                                                ( "+." )
+# 1363 "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) = 
+# 3198 "parsing/parser.mly"
+      ( _1 )
+# 1388 "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 = tyvar;
+          MenhirLib.EngineTypes.startp = _startpos_tyvar_;
+          MenhirLib.EngineTypes.endp = _endpos_tyvar_;
+          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 = ty;
+                MenhirLib.EngineTypes.startp = _startpos_ty_;
+                MenhirLib.EngineTypes.endp = _endpos_ty_;
+                MenhirLib.EngineTypes.next = _menhir_stack;
+              };
+            };
+          };
+        } = _menhir_stack in
+        let tyvar : (Asttypes.label) = Obj.magic tyvar in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let ty : (Parsetree.core_type) = Obj.magic ty in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_ty_ in
+        let _endpos = _endpos_tyvar_ in
+        let _v : (Parsetree.core_type) = let _1 =
+          let _1 = 
+# 3201 "parsing/parser.mly"
+        ( Ptyp_alias(ty, tyvar) )
+# 1435 "parsing/parser.ml"
+           in
+          let (_endpos__1_, _startpos__1_) = (_endpos_tyvar_, _startpos_ty_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 1444 "parsing/parser.ml"
+          
+        in
+        
+# 3203 "parsing/parser.mly"
+    ( _1 )
+# 1450 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = body;
+            MenhirLib.EngineTypes.startp = _startpos_body_;
+            MenhirLib.EngineTypes.endp = _endpos_body_;
+            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.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 _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in
+        let _1_inlined1 : (Parsetree.attributes) = 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 : (let_binding) = let attrs2 =
+          let _1 = _1_inlined2 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 1498 "parsing/parser.ml"
+          
+        in
+        let _endpos_attrs2_ = _endpos__1_inlined2_ in
+        let attrs1 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 1507 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_attrs2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2478 "parsing/parser.mly"
+    (
+      let attrs = attrs1 @ attrs2 in
+      mklb ~loc:_sloc false body attrs
+    )
+# 1519 "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 : (Longident.t) = 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) = 
+# 3528 "parsing/parser.mly"
+      ( _1 )
+# 1544 "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 : (Asttypes.label) = 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) = 
+# 3529 "parsing/parser.mly"
+                                 ( Lident _1 )
+# 1569 "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 = _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 : (Parsetree.core_type) = 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.core_type) = 
+# 3259 "parsing/parser.mly"
+      ( _2 )
+# 1608 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            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.next = {
+                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 = _;
+                  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 _5 : unit = Obj.magic _5 in
+        let _1_inlined3 : (Parsetree.module_type) = Obj.magic _1_inlined3 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 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 : (Parsetree.core_type) = let _4 =
+          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+          let _1 =
+            let _1 = 
+# 3320 "parsing/parser.mly"
+      ( Ptyp_package (package_type_of_module_type _1) )
+# 1671 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 1679 "parsing/parser.ml"
+            
+          in
+          
+# 3321 "parsing/parser.mly"
+      ( _1 )
+# 1685 "parsing/parser.ml"
+          
+        in
+        let _3 =
+          let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 1695 "parsing/parser.ml"
+            
+          in
+          
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 1701 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3261 "parsing/parser.mly"
+      ( wrap_typ_attrs ~loc:_sloc (reloc_typ ~loc:_sloc _4) _3 )
+# 1710 "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 = _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 _2 : (Asttypes.label) = 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.core_type) = let _1 =
+          let _1 = 
+# 3264 "parsing/parser.mly"
+        ( Ptyp_var _2 )
+# 1743 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 1752 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 1758 "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 : unit = 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) = let _1 =
+          let _1 = 
+# 3266 "parsing/parser.mly"
+        ( Ptyp_any )
+# 1784 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 1792 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 1798 "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 : (Longident.t) = 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) = let _1 =
+          let _1 =
+            let tid =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 1829 "parsing/parser.ml"
+              
+            in
+            let tys = 
+# 3311 "parsing/parser.mly"
+      ( [] )
+# 1835 "parsing/parser.ml"
+             in
+            
+# 3269 "parsing/parser.mly"
+        ( Ptyp_constr(tid, tys) )
+# 1840 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 1849 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 1855 "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 = _1;
+          MenhirLib.EngineTypes.startp = _startpos__1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = ty;
+            MenhirLib.EngineTypes.startp = _startpos_ty_;
+            MenhirLib.EngineTypes.endp = _endpos_ty_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let _1 : (Longident.t) = Obj.magic _1 in
+        let ty : (Parsetree.core_type) = Obj.magic ty in
+        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 _1 =
+            let tid =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 1893 "parsing/parser.ml"
+              
+            in
+            let tys = 
+# 3313 "parsing/parser.mly"
+      ( [ty] )
+# 1899 "parsing/parser.ml"
+             in
+            
+# 3269 "parsing/parser.mly"
+        ( Ptyp_constr(tid, tys) )
+# 1904 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 1914 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 1920 "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 = _1_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+          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 = 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 _1_inlined1 : (Longident.t) = Obj.magic _1_inlined1 in
+        let _3 : unit = Obj.magic _3 in
+        let xs : (Parsetree.core_type list) = Obj.magic xs 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 : (Parsetree.core_type) = let _1 =
+          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
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 1973 "parsing/parser.ml"
+              
+            in
+            let tys =
+              let tys =
+                let xs = 
+# 253 ""
+    ( List.rev xs )
+# 1981 "parsing/parser.ml"
+                 in
+                
+# 975 "parsing/parser.mly"
+    ( xs )
+# 1986 "parsing/parser.ml"
+                
+              in
+              
+# 3315 "parsing/parser.mly"
+      ( tys )
+# 1992 "parsing/parser.ml"
+              
+            in
+            
+# 3269 "parsing/parser.mly"
+        ( Ptyp_constr(tid, tys) )
+# 1998 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2008 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 2014 "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 = _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 : (Parsetree.object_field list * Asttypes.closed_flag) = 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.core_type) = let _1 =
+          let _1 = 
+# 3271 "parsing/parser.mly"
+        ( let (f, c) = _2 in Ptyp_object (f, c) )
+# 2054 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2063 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 2069 "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 = _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 _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__2_ in
+        let _v : (Parsetree.core_type) = let _1 =
+          let _1 = 
+# 3273 "parsing/parser.mly"
+        ( Ptyp_object ([], Closed) )
+# 2102 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2111 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 2117 "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 = _1;
+          MenhirLib.EngineTypes.startp = _startpos__1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = _2;
+            MenhirLib.EngineTypes.startp = _startpos__2_;
+            MenhirLib.EngineTypes.endp = _endpos__2_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let _1 : (Longident.t) = Obj.magic _1 in
+        let _2 : unit = Obj.magic _2 in
+        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 _1 =
+            let cid =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 2155 "parsing/parser.ml"
+              
+            in
+            let tys = 
+# 3311 "parsing/parser.mly"
+      ( [] )
+# 2161 "parsing/parser.ml"
+             in
+            
+# 3277 "parsing/parser.mly"
+        ( Ptyp_class(cid, tys) )
+# 2166 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2176 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 2182 "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 = _1;
+          MenhirLib.EngineTypes.startp = _startpos__1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_;
+          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 = ty;
+              MenhirLib.EngineTypes.startp = _startpos_ty_;
+              MenhirLib.EngineTypes.endp = _endpos_ty_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _1 : (Longident.t) = Obj.magic _1 in
+        let _2 : unit = Obj.magic _2 in
+        let ty : (Parsetree.core_type) = Obj.magic ty in
+        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 _1 =
+            let cid =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 2227 "parsing/parser.ml"
+              
+            in
+            let tys = 
+# 3313 "parsing/parser.mly"
+      ( [ty] )
+# 2233 "parsing/parser.ml"
+             in
+            
+# 3277 "parsing/parser.mly"
+        ( Ptyp_class(cid, tys) )
+# 2238 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2248 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 2254 "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 = _1_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+          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 = _;
+              MenhirLib.EngineTypes.semv = _3;
+              MenhirLib.EngineTypes.startp = _startpos__3_;
+              MenhirLib.EngineTypes.endp = _endpos__3_;
+              MenhirLib.EngineTypes.next = {
+                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 _1_inlined1 : (Longident.t) = Obj.magic _1_inlined1 in
+        let _2 : unit = Obj.magic _2 in
+        let _3 : unit = Obj.magic _3 in
+        let xs : (Parsetree.core_type list) = Obj.magic xs 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 : (Parsetree.core_type) = let _1 =
+          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
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 2314 "parsing/parser.ml"
+              
+            in
+            let tys =
+              let tys =
+                let xs = 
+# 253 ""
+    ( List.rev xs )
+# 2322 "parsing/parser.ml"
+                 in
+                
+# 975 "parsing/parser.mly"
+    ( xs )
+# 2327 "parsing/parser.ml"
+                
+              in
+              
+# 3315 "parsing/parser.mly"
+      ( tys )
+# 2333 "parsing/parser.ml"
+              
+            in
+            
+# 3277 "parsing/parser.mly"
+        ( Ptyp_class(cid, tys) )
+# 2339 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2349 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 2355 "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 = _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 : (Parsetree.row_field) = 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.core_type) = let _1 =
+          let _1 = 
+# 3280 "parsing/parser.mly"
+        ( Ptyp_variant([_2], Closed, None) )
+# 2395 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2404 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 2410 "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 = xs;
+            MenhirLib.EngineTypes.startp = _startpos_xs_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_;
+            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 : unit = Obj.magic _4 in
+        let xs : (Parsetree.row_field list) = Obj.magic xs 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.core_type) = let _1 =
+          let _1 =
+            let _3 =
+              let _1 =
+                let xs = 
+# 253 ""
+    ( List.rev xs )
+# 2460 "parsing/parser.ml"
+                 in
+                
+# 947 "parsing/parser.mly"
+    ( xs )
+# 2465 "parsing/parser.ml"
+                
+              in
+              
+# 3325 "parsing/parser.mly"
+    ( _1 )
+# 2471 "parsing/parser.ml"
+              
+            in
+            
+# 3282 "parsing/parser.mly"
+        ( Ptyp_variant(_3, Closed, None) )
+# 2477 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2487 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 2493 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = xs;
+            MenhirLib.EngineTypes.startp = _startpos_xs_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_;
+            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 _5 : unit = Obj.magic _5 in
+        let xs : (Parsetree.row_field list) = Obj.magic xs in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (Parsetree.row_field) = 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 : (Parsetree.core_type) = let _1 =
+          let _1 =
+            let _4 =
+              let _1 =
+                let xs = 
+# 253 ""
+    ( List.rev xs )
+# 2550 "parsing/parser.ml"
+                 in
+                
+# 947 "parsing/parser.mly"
+    ( xs )
+# 2555 "parsing/parser.ml"
+                
+              in
+              
+# 3325 "parsing/parser.mly"
+    ( _1 )
+# 2561 "parsing/parser.ml"
+              
+            in
+            
+# 3284 "parsing/parser.mly"
+        ( Ptyp_variant(_2 :: _4, Closed, None) )
+# 2567 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2577 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 2583 "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 = xs;
+            MenhirLib.EngineTypes.startp = _startpos_xs_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_;
+            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 : unit = Obj.magic _4 in
+        let xs : (Parsetree.row_field list) = Obj.magic xs in
+        let _2 : (unit option) = 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.core_type) = let _1 =
+          let _1 =
+            let _3 =
+              let _1 =
+                let xs = 
+# 253 ""
+    ( List.rev xs )
+# 2633 "parsing/parser.ml"
+                 in
+                
+# 947 "parsing/parser.mly"
+    ( xs )
+# 2638 "parsing/parser.ml"
+                
+              in
+              
+# 3325 "parsing/parser.mly"
+    ( _1 )
+# 2644 "parsing/parser.ml"
+              
+            in
+            
+# 3286 "parsing/parser.mly"
+        ( Ptyp_variant(_3, Open, None) )
+# 2650 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2660 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 2666 "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 = _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 _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__2_ in
+        let _v : (Parsetree.core_type) = let _1 =
+          let _1 = 
+# 3288 "parsing/parser.mly"
+        ( Ptyp_variant([], Open, None) )
+# 2699 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2708 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 2714 "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 = xs;
+            MenhirLib.EngineTypes.startp = _startpos_xs_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_;
+            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 : unit = Obj.magic _4 in
+        let xs : (Parsetree.row_field list) = Obj.magic xs in
+        let _2 : (unit option) = 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.core_type) = let _1 =
+          let _1 =
+            let _3 =
+              let _1 =
+                let xs = 
+# 253 ""
+    ( List.rev xs )
+# 2764 "parsing/parser.ml"
+                 in
+                
+# 947 "parsing/parser.mly"
+    ( xs )
+# 2769 "parsing/parser.ml"
+                
+              in
+              
+# 3325 "parsing/parser.mly"
+    ( _1 )
+# 2775 "parsing/parser.ml"
+              
+            in
+            
+# 3290 "parsing/parser.mly"
+        ( Ptyp_variant(_3, Closed, Some []) )
+# 2781 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2791 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 2797 "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 = _6;
+          MenhirLib.EngineTypes.startp = _startpos__6_;
+          MenhirLib.EngineTypes.endp = _endpos__6_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = xs_inlined1;
+            MenhirLib.EngineTypes.startp = _startpos_xs_inlined1_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_inlined1_;
+            MenhirLib.EngineTypes.next = {
+              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 = xs;
+                MenhirLib.EngineTypes.startp = _startpos_xs_;
+                MenhirLib.EngineTypes.endp = _endpos_xs_;
+                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 _6 : unit = Obj.magic _6 in
+        let xs_inlined1 : (Asttypes.label list) = Obj.magic xs_inlined1 in
+        let _4 : unit = Obj.magic _4 in
+        let xs : (Parsetree.row_field list) = Obj.magic xs in
+        let _2 : (unit option) = 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__6_ in
+        let _v : (Parsetree.core_type) = let _1 =
+          let _1 =
+            let _5 =
+              let xs = xs_inlined1 in
+              let _1 =
+                let xs = 
+# 253 ""
+    ( List.rev xs )
+# 2862 "parsing/parser.ml"
+                 in
+                
+# 915 "parsing/parser.mly"
+    ( xs )
+# 2867 "parsing/parser.ml"
+                
+              in
+              
+# 3353 "parsing/parser.mly"
+    ( _1 )
+# 2873 "parsing/parser.ml"
+              
+            in
+            let _3 =
+              let _1 =
+                let xs = 
+# 253 ""
+    ( List.rev xs )
+# 2881 "parsing/parser.ml"
+                 in
+                
+# 947 "parsing/parser.mly"
+    ( xs )
+# 2886 "parsing/parser.ml"
+                
+              in
+              
+# 3325 "parsing/parser.mly"
+    ( _1 )
+# 2892 "parsing/parser.ml"
+              
+            in
+            
+# 3292 "parsing/parser.mly"
+        ( Ptyp_variant(_3, Closed, Some _5) )
+# 2898 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2908 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 2914 "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.extension) = 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) = let _1 =
+          let _1 = 
+# 3294 "parsing/parser.mly"
+        ( Ptyp_extension _1 )
+# 2940 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2948 "parsing/parser.ml"
+          
+        in
+        
+# 3296 "parsing/parser.mly"
+  ( _1 )
+# 2954 "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 : (string) = 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) = let _1 =
+          let _1 = 
+# 3708 "parsing/parser.mly"
+                     ( _1 )
+# 2980 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 843 "parsing/parser.mly"
+    ( mkloc _1 (make_loc _sloc) )
+# 2988 "parsing/parser.ml"
+          
+        in
+        
+# 3710 "parsing/parser.mly"
+    ( _1 )
+# 2994 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (string Asttypes.loc) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (string) = 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 Asttypes.loc) = let _1 =
+          let _1 = 
+# 3709 "parsing/parser.mly"
+                                 ( _1 ^ "." ^ _3.txt )
+# 3034 "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
+          
+# 843 "parsing/parser.mly"
+    ( mkloc _1 (make_loc _sloc) )
+# 3043 "parsing/parser.ml"
+          
+        in
+        
+# 3710 "parsing/parser.mly"
+    ( _1 )
+# 3049 "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 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.payload) = Obj.magic _3 in
+        let _2 : (string Asttypes.loc) = 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.attribute) = let _endpos = _endpos__4_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3714 "parsing/parser.mly"
+    ( Attr.mk ~loc:(make_loc _sloc) _2 _3 )
+# 3098 "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.class_expr) = 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.class_expr) = 
+# 1762 "parsing/parser.mly"
+      ( _1 )
+# 3123 "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 = _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 : (Parsetree.class_expr) = Obj.magic _3 in
+        let _1_inlined1 : (Parsetree.attributes) = 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.class_expr) = let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 3164 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__3_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1764 "parsing/parser.mly"
+      ( wrap_class_attrs ~loc:_sloc _3 _2 )
+# 3173 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (Parsetree.class_expr) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (let_bindings) = 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.class_expr) = let _endpos = _endpos__3_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1766 "parsing/parser.mly"
+      ( class_of_let_bindings ~loc:_sloc _1 _3 )
+# 3215 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            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.next = {
+                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 = _;
+                  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 _7 : (Parsetree.class_expr) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _1_inlined2 : (Longident.t) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 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__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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 3280 "parsing/parser.ml"
+          
+        in
+        let _4 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 3288 "parsing/parser.ml"
+          
+        in
+        let _endpos__4_ = _endpos__1_inlined1_ in
+        let _3 = 
+# 3633 "parsing/parser.mly"
+                                                ( Fresh )
+# 3295 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__7_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1768 "parsing/parser.mly"
+      ( let loc = (_startpos__2_, _endpos__4_) in
+        let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
+        mkclass ~loc:_sloc ~attrs:_4 (Pcl_open(od, _7)) )
+# 3305 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _1_inlined3;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+              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.next = {
+                  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 = _;
+                    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 _7 : (Parsetree.class_expr) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : unit = Obj.magic _1_inlined1 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__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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 3377 "parsing/parser.ml"
+          
+        in
+        let _4 =
+          let _1 = _1_inlined2 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 3385 "parsing/parser.ml"
+          
+        in
+        let _endpos__4_ = _endpos__1_inlined2_ in
+        let _3 =
+          let _1 = _1_inlined1 in
+          
+# 3634 "parsing/parser.mly"
+                                                ( Override )
+# 3394 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__7_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1768 "parsing/parser.mly"
+      ( let loc = (_startpos__2_, _endpos__4_) in
+        let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
+        mkclass ~loc:_sloc ~attrs:_4 (Pcl_open(od, _7)) )
+# 3405 "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 = _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 _2 : (Parsetree.attribute) = Obj.magic _2 in
+        let _1 : (Parsetree.class_expr) = 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.class_expr) = 
+# 1772 "parsing/parser.mly"
+      ( Cl.attr _1 _2 )
+# 3437 "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 : ((Asttypes.arg_label * Parsetree.expression) list) = Obj.magic xs in
+        let _1 : (Parsetree.class_expr) = 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_expr) = let _1 =
+          let _1 =
+            let _2 =
+              let xs = 
+# 253 ""
+    ( List.rev xs )
+# 3472 "parsing/parser.ml"
+               in
+              
+# 915 "parsing/parser.mly"
+    ( xs )
+# 3477 "parsing/parser.ml"
+              
+            in
+            
+# 1775 "parsing/parser.mly"
+        ( Pcl_apply(_1, _2) )
+# 3483 "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
+          
+# 866 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc _1 )
+# 3493 "parsing/parser.ml"
+          
+        in
+        
+# 1778 "parsing/parser.mly"
+      ( _1 )
+# 3499 "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.extension) = 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.class_expr) = let _1 =
+          let _1 = 
+# 1777 "parsing/parser.mly"
+        ( Pcl_extension _1 )
+# 3525 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 866 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc _1 )
+# 3533 "parsing/parser.ml"
+          
+        in
+        
+# 1778 "parsing/parser.mly"
+      ( _1 )
+# 3539 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = self;
+            MenhirLib.EngineTypes.startp = _startpos_self_;
+            MenhirLib.EngineTypes.endp = _endpos_self_;
+            MenhirLib.EngineTypes.next = {
+              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 = _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 _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let self : (string Asttypes.loc option) = Obj.magic self in
+        let _4 : (Parsetree.class_expr) = Obj.magic _4 in
+        let _1_inlined1 : (Parsetree.attributes) = 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.class_field) = let _6 =
+          let _1 = _1_inlined2 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 3594 "parsing/parser.ml"
+          
+        in
+        let _endpos__6_ = _endpos__1_inlined2_ in
+        let _3 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 3603 "parsing/parser.ml"
+          
+        in
+        let _2 = 
+# 3633 "parsing/parser.mly"
+                                                ( Fresh )
+# 3609 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__6_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1827 "parsing/parser.mly"
+      ( let docs = symbol_docs _sloc in
+        mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs )
+# 3618 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = self;
+            MenhirLib.EngineTypes.startp = _startpos_self_;
+            MenhirLib.EngineTypes.endp = _endpos_self_;
+            MenhirLib.EngineTypes.next = {
+              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 = _1_inlined2;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+                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.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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let self : (string Asttypes.loc option) = Obj.magic self in
+        let _4 : (Parsetree.class_expr) = Obj.magic _4 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : unit = 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_inlined3_ in
+        let _v : (Parsetree.class_field) = let _6 =
+          let _1 = _1_inlined3 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 3680 "parsing/parser.ml"
+          
+        in
+        let _endpos__6_ = _endpos__1_inlined3_ in
+        let _3 =
+          let _1 = _1_inlined2 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 3689 "parsing/parser.ml"
+          
+        in
+        let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3634 "parsing/parser.mly"
+                                                ( Override )
+# 3697 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__6_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1827 "parsing/parser.mly"
+      ( let docs = symbol_docs _sloc in
+        mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs )
+# 3707 "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 = _1_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+          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 _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let _2 : ((Asttypes.label Asttypes.loc * Asttypes.mutable_flag *
+   Parsetree.class_field_kind) *
+  Parsetree.attributes) = 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__1_inlined1_ in
+        let _v : (Parsetree.class_field) = let _3 =
+          let _1 = _1_inlined1 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 3750 "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
+        
+# 1830 "parsing/parser.mly"
+      ( let v, attrs = _2 in
+        let docs = symbol_docs _sloc in
+        mkcf ~loc:_sloc (Pcf_val v) ~attrs:(attrs@_3) ~docs )
+# 3762 "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 = _1_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+          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 _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let _2 : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
+   Parsetree.class_field_kind) *
+  Parsetree.attributes) = 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__1_inlined1_ in
+        let _v : (Parsetree.class_field) = let _3 =
+          let _1 = _1_inlined1 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 3805 "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
+        
+# 1834 "parsing/parser.mly"
+      ( let meth, attrs = _2 in
+        let docs = symbol_docs _sloc in
+        mkcf ~loc:_sloc (Pcf_method meth) ~attrs:(attrs@_3) ~docs )
+# 3817 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          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 = _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 _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _3 : (Parsetree.core_type * Parsetree.core_type) = Obj.magic _3 in
+        let _1_inlined1 : (Parsetree.attributes) = 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.class_field) = let _4 =
+          let _1 = _1_inlined2 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 3865 "parsing/parser.ml"
+          
+        in
+        let _endpos__4_ = _endpos__1_inlined2_ in
+        let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 3874 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__4_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1838 "parsing/parser.mly"
+      ( let docs = symbol_docs _sloc in
+        mkcf ~loc:_sloc (Pcf_constraint _3) ~attrs:(_2@_4) ~docs )
+# 3884 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          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 = _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 _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _3 : (Parsetree.expression) = Obj.magic _3 in
+        let _1_inlined1 : (Parsetree.attributes) = 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.class_field) = let _4 =
+          let _1 = _1_inlined2 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 3932 "parsing/parser.ml"
+          
+        in
+        let _endpos__4_ = _endpos__1_inlined2_ in
+        let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 3941 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__4_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1841 "parsing/parser.mly"
+      ( let docs = symbol_docs _sloc in
+        mkcf ~loc:_sloc (Pcf_initializer _3) ~attrs:(_2@_4) ~docs )
+# 3951 "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 = _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 _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let _1 : (Parsetree.extension) = 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.class_field) = let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 3985 "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
+        
+# 1844 "parsing/parser.mly"
+      ( let docs = symbol_docs _sloc in
+        mkcf ~loc:_sloc (Pcf_extension _1) ~attrs:_2 ~docs )
+# 3996 "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.attribute) = 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.class_field) = let _1 =
+          let _1 = 
+# 1847 "parsing/parser.mly"
+      ( Pcf_attribute _1 )
+# 4022 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 864 "parsing/parser.mly"
+    ( mkcf ~loc:_sloc _1 )
+# 4030 "parsing/parser.ml"
+          
+        in
+        
+# 1848 "parsing/parser.mly"
+      ( _1 )
+# 4036 "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 = _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 _2 : (Parsetree.class_expr) = 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.class_expr) = 
+# 1742 "parsing/parser.mly"
+      ( _2 )
+# 4068 "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.class_expr) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (Parsetree.class_type) = 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.class_expr) = let _1 =
+          let _1 = 
+# 1745 "parsing/parser.mly"
+        ( Pcl_constraint(_4, _2) )
+# 4115 "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
+          
+# 866 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc _1 )
+# 4124 "parsing/parser.ml"
+          
+        in
+        
+# 1748 "parsing/parser.mly"
+      ( _1 )
+# 4130 "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 = _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 _2 : (Parsetree.class_expr) = Obj.magic _2 in
+        let _1 : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = 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.class_expr) = let _1 =
+          let _1 = 
+# 1747 "parsing/parser.mly"
+      ( let (l,o,p) = _1 in Pcl_fun(l, o, p, _2) )
+# 4163 "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
+          
+# 866 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc _1 )
+# 4172 "parsing/parser.ml"
+          
+        in
+        
+# 1748 "parsing/parser.mly"
+      ( _1 )
+# 4178 "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 = e;
+          MenhirLib.EngineTypes.startp = _startpos_e_;
+          MenhirLib.EngineTypes.endp = _endpos_e_;
+          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 e : (Parsetree.class_expr) = Obj.magic e in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = 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.class_expr) = let _1 =
+          let _1 = 
+# 1803 "parsing/parser.mly"
+      ( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) )
+# 4218 "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
+          
+# 866 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc _1 )
+# 4227 "parsing/parser.ml"
+          
+        in
+        
+# 1804 "parsing/parser.mly"
+    ( _1 )
+# 4233 "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 = 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.class_expr) = Obj.magic e in
+        let _1 : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = 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.class_expr) = let _1 =
+          let _1 = 
+# 1803 "parsing/parser.mly"
+      ( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) )
+# 4266 "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
+          
+# 866 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc _1 )
+# 4275 "parsing/parser.ml"
+          
+        in
+        
+# 1804 "parsing/parser.mly"
+    ( _1 )
+# 4281 "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 : (Longident.t) = 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) = 
+# 3519 "parsing/parser.mly"
+                                      ( _1 )
+# 4306 "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 = _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 : (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 _endpos = _endpos__3_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1812 "parsing/parser.mly"
+      ( reloc_pat ~loc:_sloc _2 )
+# 4348 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.core_type) = 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__5_ in
+        let _v : (Parsetree.pattern) = let _1 =
+          let _1 = 
+# 1814 "parsing/parser.mly"
+      ( Ppat_constraint(_2, _4) )
+# 4402 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 4411 "parsing/parser.ml"
+          
+        in
+        
+# 1815 "parsing/parser.mly"
+      ( _1 )
+# 4417 "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.pattern) = let _endpos = _endpos__0_ in
+        let _symbolstartpos = _endpos in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1817 "parsing/parser.mly"
+      ( ghpat ~loc:_sloc Ppat_any )
+# 4438 "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 = _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 : (Parsetree.core_type) = 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.core_type) = 
+# 1942 "parsing/parser.mly"
+      ( _2 )
+# 4477 "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.core_type) = let _1 =
+          let _1 = 
+# 1943 "parsing/parser.mly"
+                      ( Ptyp_any )
+# 4496 "parsing/parser.ml"
+           in
+          let _endpos__1_ = _endpos__0_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _endpos in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 4505 "parsing/parser.ml"
+          
+        in
+        
+# 1944 "parsing/parser.mly"
+      ( _1 )
+# 4511 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          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 = _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 _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _3 : (Parsetree.class_type) = Obj.magic _3 in
+        let _1_inlined1 : (Parsetree.attributes) = 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.class_type_field) = let _4 =
+          let _1 = _1_inlined2 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 4559 "parsing/parser.ml"
+          
+        in
+        let _endpos__4_ = _endpos__1_inlined2_ in
+        let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 4568 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__4_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1952 "parsing/parser.mly"
+      ( let docs = symbol_docs _sloc in
+        mkctf ~loc:_sloc (Pctf_inherit _3) ~attrs:(_2@_4) ~docs )
+# 4578 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = ty;
+            MenhirLib.EngineTypes.startp = _startpos_ty_;
+            MenhirLib.EngineTypes.endp = _endpos_ty_;
+            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 = _1_inlined2;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = flags;
+                  MenhirLib.EngineTypes.startp = _startpos_flags_;
+                  MenhirLib.EngineTypes.endp = _endpos_flags_;
+                  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.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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let ty : (Parsetree.core_type) = Obj.magic ty in
+        let _3 : unit = Obj.magic _3 in
+        let _1_inlined2 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 4638 "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
+        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_inlined3_ in
+        let _v : (Parsetree.class_type_field) = let _4 =
+          let _1 = _1_inlined3 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 4651 "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 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 4661 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 4669 "parsing/parser.ml"
+            
+          in
+          
+# 1977 "parsing/parser.mly"
+  (
+    let mut, virt = flags in
+    label, mut, virt, ty
+  )
+# 4678 "parsing/parser.ml"
+          
+        in
+        let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 4686 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__4_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1955 "parsing/parser.mly"
+      ( let docs = symbol_docs _sloc in
+        mkctf ~loc:_sloc (Pctf_val _3) ~attrs:(_2@_4) ~docs )
+# 4696 "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 = _1_inlined4;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined4_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined4_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              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.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 = _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 _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
+        let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined2 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 4756 "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
+        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_inlined4_ in
+        let _v : (Parsetree.class_type_field) = let _7 =
+          let _1 = _1_inlined4 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 4769 "parsing/parser.ml"
+          
+        in
+        let _endpos__7_ = _endpos__1_inlined4_ in
+        let _6 =
+          let _1 = _1_inlined3 in
+          
+# 3164 "parsing/parser.mly"
+    ( _1 )
+# 4778 "parsing/parser.ml"
+          
+        in
+        let _4 =
+          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+          let _1 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 4786 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 4794 "parsing/parser.ml"
+          
+        in
+        let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 4802 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__7_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1959 "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 )
+# 4813 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          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 = _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 _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _3 : (Parsetree.core_type * Parsetree.core_type) = Obj.magic _3 in
+        let _1_inlined1 : (Parsetree.attributes) = 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.class_type_field) = let _4 =
+          let _1 = _1_inlined2 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 4861 "parsing/parser.ml"
+          
+        in
+        let _endpos__4_ = _endpos__1_inlined2_ in
+        let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 4870 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__4_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1963 "parsing/parser.mly"
+      ( let docs = symbol_docs _sloc in
+        mkctf ~loc:_sloc (Pctf_constraint _3) ~attrs:(_2@_4) ~docs )
+# 4880 "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 = _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 _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let _1 : (Parsetree.extension) = 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.class_type_field) = let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 4914 "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
+        
+# 1966 "parsing/parser.mly"
+      ( let docs = symbol_docs _sloc in
+        mkctf ~loc:_sloc (Pctf_extension _1) ~attrs:_2 ~docs )
+# 4925 "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.attribute) = 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.class_type_field) = let _1 =
+          let _1 = 
+# 1969 "parsing/parser.mly"
+      ( Pctf_attribute _1 )
+# 4951 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 862 "parsing/parser.mly"
+    ( mkctf ~loc:_sloc _1 )
+# 4959 "parsing/parser.ml"
+          
+        in
+        
+# 1970 "parsing/parser.mly"
+      ( _1 )
+# 4965 "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 : (Longident.t) = 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.class_type) = let _1 =
+          let _1 =
+            let cid =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 4996 "parsing/parser.ml"
+              
+            in
+            let tys =
+              let tys = 
+# 1928 "parsing/parser.mly"
+      ( [] )
+# 5003 "parsing/parser.ml"
+               in
+              
+# 1934 "parsing/parser.mly"
+    ( tys )
+# 5008 "parsing/parser.ml"
+              
+            in
+            
+# 1911 "parsing/parser.mly"
+        ( Pcty_constr (cid, tys) )
+# 5014 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 860 "parsing/parser.mly"
+    ( mkcty ~loc:_sloc _1 )
+# 5023 "parsing/parser.ml"
+          
+        in
+        
+# 1914 "parsing/parser.mly"
+      ( _1 )
+# 5029 "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 = _1_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+          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 = 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 _1_inlined1 : (Longident.t) = Obj.magic _1_inlined1 in
+        let _3 : unit = Obj.magic _3 in
+        let xs : (Parsetree.core_type list) = Obj.magic xs 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 : (Parsetree.class_type) = let _1 =
+          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
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 5082 "parsing/parser.ml"
+              
+            in
+            let tys =
+              let tys =
+                let params =
+                  let xs = 
+# 253 ""
+    ( List.rev xs )
+# 5091 "parsing/parser.ml"
+                   in
+                  
+# 947 "parsing/parser.mly"
+    ( xs )
+# 5096 "parsing/parser.ml"
+                  
+                in
+                
+# 1930 "parsing/parser.mly"
+      ( params )
+# 5102 "parsing/parser.ml"
+                
+              in
+              
+# 1934 "parsing/parser.mly"
+    ( tys )
+# 5108 "parsing/parser.ml"
+              
+            in
+            
+# 1911 "parsing/parser.mly"
+        ( Pcty_constr (cid, tys) )
+# 5114 "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
+          
+# 860 "parsing/parser.mly"
+    ( mkcty ~loc:_sloc _1 )
+# 5124 "parsing/parser.ml"
+          
+        in
+        
+# 1914 "parsing/parser.mly"
+      ( _1 )
+# 5130 "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.extension) = 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.class_type) = let _1 =
+          let _1 = 
+# 1913 "parsing/parser.mly"
+        ( Pcty_extension _1 )
+# 5156 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 860 "parsing/parser.mly"
+    ( mkcty ~loc:_sloc _1 )
+# 5164 "parsing/parser.ml"
+          
+        in
+        
+# 1914 "parsing/parser.mly"
+      ( _1 )
+# 5170 "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 = xss;
+            MenhirLib.EngineTypes.startp = _startpos_xss_;
+            MenhirLib.EngineTypes.endp = _endpos_xss_;
+            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.next = {
+                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 _4 : unit = Obj.magic _4 in
+        let xss : (Parsetree.class_type_field list list) = Obj.magic xss in
+        let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (Parsetree.attributes) = 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__4_ in
+        let _v : (Parsetree.class_type) = let _3 =
+          let _1 = _1_inlined2 in
+          let _2 =
+            let _1 =
+              let _1 = 
+# 260 ""
+    ( List.flatten xss )
+# 5227 "parsing/parser.ml"
+               in
+              
+# 1948 "parsing/parser.mly"
+    ( _1 )
+# 5232 "parsing/parser.ml"
+              
+            in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+            let _endpos = _endpos__1_ in
+            let _startpos = _startpos__1_ in
+            
+# 808 "parsing/parser.mly"
+                               ( extra_csig _startpos _endpos _1 )
+# 5241 "parsing/parser.ml"
+            
+          in
+          
+# 1938 "parsing/parser.mly"
+      ( Csig.mk _1 _2 )
+# 5247 "parsing/parser.ml"
+          
+        in
+        let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 5255 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__4_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1916 "parsing/parser.mly"
+      ( mkcty ~loc:_sloc ~attrs:_2 (Pcty_signature _3) )
+# 5264 "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 = xss;
+            MenhirLib.EngineTypes.startp = _startpos_xss_;
+            MenhirLib.EngineTypes.endp = _endpos_xss_;
+            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.next = {
+                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 _4 : unit = Obj.magic _4 in
+        let xss : (Parsetree.class_type_field list list) = Obj.magic xss in
+        let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (Parsetree.attributes) = 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__4_ in
+        let _v : (Parsetree.class_type) = let _3 =
+          let _1 = _1_inlined2 in
+          let _2 =
+            let _1 =
+              let _1 = 
+# 260 ""
+    ( List.flatten xss )
+# 5321 "parsing/parser.ml"
+               in
+              
+# 1948 "parsing/parser.mly"
+    ( _1 )
+# 5326 "parsing/parser.ml"
+              
+            in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+            let _endpos = _endpos__1_ in
+            let _startpos = _startpos__1_ in
+            
+# 808 "parsing/parser.mly"
+                               ( extra_csig _startpos _endpos _1 )
+# 5335 "parsing/parser.ml"
+            
+          in
+          
+# 1938 "parsing/parser.mly"
+      ( Csig.mk _1 _2 )
+# 5341 "parsing/parser.ml"
+          
+        in
+        let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 5349 "parsing/parser.ml"
+          
+        in
+        let _loc__4_ = (_startpos__4_, _endpos__4_) in
+        let _loc__1_ = (_startpos__1_, _endpos__1_) in
+        
+# 1918 "parsing/parser.mly"
+      ( unclosed "object" _loc__1_ "end" _loc__4_ )
+# 5357 "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 = _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 _2 : (Parsetree.attribute) = Obj.magic _2 in
+        let _1 : (Parsetree.class_type) = 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.class_type) = 
+# 1920 "parsing/parser.mly"
+      ( Cty.attr _1 _2 )
+# 5389 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            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.next = {
+                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 = _;
+                  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 _7 : (Parsetree.class_type) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _1_inlined2 : (Longident.t) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 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__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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 5454 "parsing/parser.ml"
+          
+        in
+        let _4 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 5462 "parsing/parser.ml"
+          
+        in
+        let _endpos__4_ = _endpos__1_inlined1_ in
+        let _3 = 
+# 3633 "parsing/parser.mly"
+                                                ( Fresh )
+# 5469 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__7_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1922 "parsing/parser.mly"
+      ( let loc = (_startpos__2_, _endpos__4_) in
+        let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
+        mkcty ~loc:_sloc ~attrs:_4 (Pcty_open(od, _7)) )
+# 5479 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _1_inlined3;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+              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.next = {
+                  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 = _;
+                    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 _7 : (Parsetree.class_type) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : unit = Obj.magic _1_inlined1 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__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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 5551 "parsing/parser.ml"
+          
+        in
+        let _4 =
+          let _1 = _1_inlined2 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 5559 "parsing/parser.ml"
+          
+        in
+        let _endpos__4_ = _endpos__1_inlined2_ in
+        let _3 =
+          let _1 = _1_inlined1 in
+          
+# 3634 "parsing/parser.mly"
+                                                ( Override )
+# 5568 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__7_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1922 "parsing/parser.mly"
+      ( let loc = (_startpos__2_, _endpos__4_) in
+        let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
+        mkcty ~loc:_sloc ~attrs:_4 (Pcty_open(od, _7)) )
+# 5579 "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 = _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 : (Parsetree.class_expr) = 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.class_expr) = 
+# 1782 "parsing/parser.mly"
+      ( _2 )
+# 5618 "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 = _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 : (Parsetree.class_expr) = 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.class_expr) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
+        let _loc__1_ = (_startpos__1_, _endpos__1_) in
+        
+# 1784 "parsing/parser.mly"
+      ( unclosed "(" _loc__1_ ")" _loc__3_ )
+# 5659 "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 : (Longident.t) = 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.class_expr) = let _1 =
+          let _1 =
+            let cid =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 5690 "parsing/parser.ml"
+              
+            in
+            let tys =
+              let tys = 
+# 1928 "parsing/parser.mly"
+      ( [] )
+# 5697 "parsing/parser.ml"
+               in
+              
+# 1934 "parsing/parser.mly"
+    ( tys )
+# 5702 "parsing/parser.ml"
+              
+            in
+            
+# 1787 "parsing/parser.mly"
+        ( Pcl_constr(cid, tys) )
+# 5708 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 866 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc _1 )
+# 5717 "parsing/parser.ml"
+          
+        in
+        
+# 1794 "parsing/parser.mly"
+      ( _1 )
+# 5723 "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 = _1_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+          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 = 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 _1_inlined1 : (Longident.t) = Obj.magic _1_inlined1 in
+        let _3 : unit = Obj.magic _3 in
+        let xs : (Parsetree.core_type list) = Obj.magic xs 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 : (Parsetree.class_expr) = let _1 =
+          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
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 5776 "parsing/parser.ml"
+              
+            in
+            let tys =
+              let tys =
+                let params =
+                  let xs = 
+# 253 ""
+    ( List.rev xs )
+# 5785 "parsing/parser.ml"
+                   in
+                  
+# 947 "parsing/parser.mly"
+    ( xs )
+# 5790 "parsing/parser.ml"
+                  
+                in
+                
+# 1930 "parsing/parser.mly"
+      ( params )
+# 5796 "parsing/parser.ml"
+                
+              in
+              
+# 1934 "parsing/parser.mly"
+    ( tys )
+# 5802 "parsing/parser.ml"
+              
+            in
+            
+# 1787 "parsing/parser.mly"
+        ( Pcl_constr(cid, tys) )
+# 5808 "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
+          
+# 866 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc _1 )
+# 5818 "parsing/parser.ml"
+          
+        in
+        
+# 1794 "parsing/parser.mly"
+      ( _1 )
+# 5824 "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 = xss;
+            MenhirLib.EngineTypes.startp = _startpos_xss_;
+            MenhirLib.EngineTypes.endp = _endpos_xss_;
+            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.next = {
+                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 _4 : unit = Obj.magic _4 in
+        let xss : (Parsetree.class_field list list) = Obj.magic xss in
+        let _1_inlined2 : (Parsetree.pattern) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (Parsetree.attributes) = 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__4_ in
+        let _v : (Parsetree.class_expr) = let _1 =
+          let _1 =
+            let _3 =
+              let _1 = _1_inlined2 in
+              let _2 =
+                let _1 =
+                  let _1 = 
+# 260 ""
+    ( List.flatten xss )
+# 5883 "parsing/parser.ml"
+                   in
+                  
+# 1821 "parsing/parser.mly"
+    ( _1 )
+# 5888 "parsing/parser.ml"
+                  
+                in
+                let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+                let _endpos = _endpos__1_ in
+                let _startpos = _startpos__1_ in
+                
+# 807 "parsing/parser.mly"
+                               ( extra_cstr _startpos _endpos _1 )
+# 5897 "parsing/parser.ml"
+                
+              in
+              
+# 1808 "parsing/parser.mly"
+       ( Cstr.mk _1 _2 )
+# 5903 "parsing/parser.ml"
+              
+            in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 5911 "parsing/parser.ml"
+              
+            in
+            let _loc__4_ = (_startpos__4_, _endpos__4_) in
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            
+# 1789 "parsing/parser.mly"
+        ( unclosed "object" _loc__1_ "end" _loc__4_ )
+# 5919 "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
+          
+# 866 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc _1 )
+# 5929 "parsing/parser.ml"
+          
+        in
+        
+# 1794 "parsing/parser.mly"
+      ( _1 )
+# 5935 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.class_type) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (Parsetree.class_expr) = 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 : (Parsetree.class_expr) = let _1 =
+          let _1 = 
+# 1791 "parsing/parser.mly"
+        ( Pcl_constraint(_2, _4) )
+# 5989 "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
+          
+# 866 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc _1 )
+# 5998 "parsing/parser.ml"
+          
+        in
+        
+# 1794 "parsing/parser.mly"
+      ( _1 )
+# 6004 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.class_type) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (Parsetree.class_expr) = 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 : (Parsetree.class_expr) = let _1 =
+          let _1 =
+            let _loc__5_ = (_startpos__5_, _endpos__5_) in
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            
+# 1793 "parsing/parser.mly"
+        ( unclosed "(" _loc__1_ ")" _loc__5_ )
+# 6061 "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
+          
+# 866 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc _1 )
+# 6071 "parsing/parser.ml"
+          
+        in
+        
+# 1794 "parsing/parser.mly"
+      ( _1 )
+# 6077 "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 = xss;
+            MenhirLib.EngineTypes.startp = _startpos_xss_;
+            MenhirLib.EngineTypes.endp = _endpos_xss_;
+            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.next = {
+                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 _4 : unit = Obj.magic _4 in
+        let xss : (Parsetree.class_field list list) = Obj.magic xss in
+        let _1_inlined2 : (Parsetree.pattern) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (Parsetree.attributes) = 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__4_ in
+        let _v : (Parsetree.class_expr) = let _3 =
+          let _1 = _1_inlined2 in
+          let _2 =
+            let _1 =
+              let _1 = 
+# 260 ""
+    ( List.flatten xss )
+# 6134 "parsing/parser.ml"
+               in
+              
+# 1821 "parsing/parser.mly"
+    ( _1 )
+# 6139 "parsing/parser.ml"
+              
+            in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+            let _endpos = _endpos__1_ in
+            let _startpos = _startpos__1_ in
+            
+# 807 "parsing/parser.mly"
+                               ( extra_cstr _startpos _endpos _1 )
+# 6148 "parsing/parser.ml"
+            
+          in
+          
+# 1808 "parsing/parser.mly"
+       ( Cstr.mk _1 _2 )
+# 6154 "parsing/parser.ml"
+          
+        in
+        let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 6162 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__4_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1796 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc ~attrs:_2 (Pcl_structure _3) )
+# 6171 "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.class_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.class_type) = 
+# 1899 "parsing/parser.mly"
+      ( _1 )
+# 6196 "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 = codomain;
+          MenhirLib.EngineTypes.startp = _startpos_codomain_;
+          MenhirLib.EngineTypes.endp = _endpos_codomain_;
+          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 = domain;
+              MenhirLib.EngineTypes.startp = _startpos_domain_;
+              MenhirLib.EngineTypes.endp = _endpos_domain_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _menhir_s;
+                MenhirLib.EngineTypes.semv = label;
+                MenhirLib.EngineTypes.startp = _startpos_label_;
+                MenhirLib.EngineTypes.endp = _endpos_label_;
+                MenhirLib.EngineTypes.next = _menhir_stack;
+              };
+            };
+          };
+        } = _menhir_stack in
+        let codomain : (Parsetree.class_type) = Obj.magic codomain in
+        let _3 : unit = Obj.magic _3 in
+        let domain : (Parsetree.core_type) = Obj.magic domain in
+        let label : (string) = 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 _1 =
+            let label = 
+# 3227 "parsing/parser.mly"
+      ( Optional label )
+# 6244 "parsing/parser.ml"
+             in
+            
+# 1905 "parsing/parser.mly"
+        ( Pcty_arrow(label, domain, codomain) )
+# 6249 "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
+          
+# 860 "parsing/parser.mly"
+    ( mkcty ~loc:_sloc _1 )
+# 6259 "parsing/parser.ml"
+          
+        in
+        
+# 1906 "parsing/parser.mly"
+      ( _1 )
+# 6265 "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 = codomain;
+          MenhirLib.EngineTypes.startp = _startpos_codomain_;
+          MenhirLib.EngineTypes.endp = _endpos_codomain_;
+          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 = domain;
+              MenhirLib.EngineTypes.startp = _startpos_domain_;
+              MenhirLib.EngineTypes.endp = _endpos_domain_;
+              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 = label;
+                  MenhirLib.EngineTypes.startp = _startpos_label_;
+                  MenhirLib.EngineTypes.endp = _endpos_label_;
+                  MenhirLib.EngineTypes.next = _menhir_stack;
+                };
+              };
+            };
+          };
+        } = _menhir_stack in
+        let codomain : (Parsetree.class_type) = Obj.magic codomain in
+        let _3 : unit = Obj.magic _3 in
+        let domain : (Parsetree.core_type) = Obj.magic domain in
+        let _2 : unit = Obj.magic _2 in
+        let label : (
+# 647 "parsing/parser.mly"
+       (string)
+# 6314 "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 _1 =
+            let label = 
+# 3229 "parsing/parser.mly"
+      ( Labelled label )
+# 6324 "parsing/parser.ml"
+             in
+            
+# 1905 "parsing/parser.mly"
+        ( Pcty_arrow(label, domain, codomain) )
+# 6329 "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
+          
+# 860 "parsing/parser.mly"
+    ( mkcty ~loc:_sloc _1 )
+# 6339 "parsing/parser.ml"
+          
+        in
+        
+# 1906 "parsing/parser.mly"
+      ( _1 )
+# 6345 "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 = codomain;
+          MenhirLib.EngineTypes.startp = _startpos_codomain_;
+          MenhirLib.EngineTypes.endp = _endpos_codomain_;
+          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 = _menhir_s;
+              MenhirLib.EngineTypes.semv = domain;
+              MenhirLib.EngineTypes.startp = _startpos_domain_;
+              MenhirLib.EngineTypes.endp = _endpos_domain_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let codomain : (Parsetree.class_type) = Obj.magic codomain in
+        let _3 : unit = Obj.magic _3 in
+        let domain : (Parsetree.core_type) = Obj.magic domain in
+        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 _1 =
+            let label = 
+# 3231 "parsing/parser.mly"
+      ( Nolabel )
+# 6386 "parsing/parser.ml"
+             in
+            
+# 1905 "parsing/parser.mly"
+        ( Pcty_arrow(label, domain, codomain) )
+# 6391 "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
+          
+# 860 "parsing/parser.mly"
+    ( mkcty ~loc:_sloc _1 )
+# 6401 "parsing/parser.ml"
+          
+        in
+        
+# 1906 "parsing/parser.mly"
+      ( _1 )
+# 6407 "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 = bs;
+          MenhirLib.EngineTypes.startp = _startpos_bs_;
+          MenhirLib.EngineTypes.endp = _endpos_bs_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = csig;
+              MenhirLib.EngineTypes.startp = _startpos_csig_;
+              MenhirLib.EngineTypes.endp = _endpos_csig_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _8;
+                MenhirLib.EngineTypes.startp = _startpos__8_;
+                MenhirLib.EngineTypes.endp = _endpos__8_;
+                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.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = params;
+                    MenhirLib.EngineTypes.startp = _startpos_params_;
+                    MenhirLib.EngineTypes.endp = _endpos_params_;
+                    MenhirLib.EngineTypes.next = {
+                      MenhirLib.EngineTypes.state = _;
+                      MenhirLib.EngineTypes.semv = virt;
+                      MenhirLib.EngineTypes.startp = _startpos_virt_;
+                      MenhirLib.EngineTypes.endp = _endpos_virt_;
+                      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.next = {
+                          MenhirLib.EngineTypes.state = _;
+                          MenhirLib.EngineTypes.semv = ext;
+                          MenhirLib.EngineTypes.startp = _startpos_ext_;
+                          MenhirLib.EngineTypes.endp = _endpos_ext_;
+                          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 bs : (Parsetree.class_type_declaration list) = Obj.magic bs in
+        let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let csig : (Parsetree.class_type) = Obj.magic csig in
+        let _8 : unit = Obj.magic _8 in
+        let _1_inlined2 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 6492 "parsing/parser.ml"
+        ) = Obj.magic _1_inlined2 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let virt : (Asttypes.virtual_flag) = Obj.magic virt in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext 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_bs_ in
+        let _v : (string Asttypes.loc option * Parsetree.class_type_declaration list) = let _1 =
+          let a =
+            let attrs2 =
+              let _1 = _1_inlined3 in
+              
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 6510 "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
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 6522 "parsing/parser.ml"
+              
+            in
+            let attrs1 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 6530 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos_attrs2_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2044 "parsing/parser.mly"
+    (
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc _sloc in
+      let docs = symbol_docs _sloc in
+      ext,
+      Ci.mk id csig ~virt ~params ~attrs ~loc ~docs
+    )
+# 6545 "parsing/parser.ml"
+            
+          in
+          
+# 1044 "parsing/parser.mly"
+    ( let (x, b) = a in x, b :: bs )
+# 6551 "parsing/parser.ml"
+          
+        in
+        
+# 2032 "parsing/parser.mly"
+    ( _1 )
+# 6557 "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 : (Longident.t) = 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) = 
+# 3516 "parsing/parser.mly"
+                                           ( _1 )
+# 6582 "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 : (
+# 633 "parsing/parser.mly"
+       (string * char option)
+# 6603 "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) = 
+# 3399 "parsing/parser.mly"
+                 ( let (n, m) = _1 in Pconst_integer (n, m) )
+# 6611 "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 : (
+# 592 "parsing/parser.mly"
+       (char)
+# 6632 "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) = 
+# 3400 "parsing/parser.mly"
+                 ( Pconst_char _1 )
+# 6640 "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 : (
+# 685 "parsing/parser.mly"
+       (string * Location.t * string option)
+# 6661 "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) = 
+# 3401 "parsing/parser.mly"
+                 ( let (s, strloc, d) = _1 in Pconst_string (s, strloc, d) )
+# 6669 "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 : (
+# 612 "parsing/parser.mly"
+       (string * char option)
+# 6690 "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) = 
+# 3402 "parsing/parser.mly"
+                 ( let (f, m) = _1 in Pconst_float (f, m) )
+# 6698 "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 = _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 _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__2_ in
+        let _v : (Asttypes.label) = 
+# 3473 "parsing/parser.mly"
+                                                ( "[]" )
+# 6730 "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 = _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 _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__2_ in
+        let _v : (Asttypes.label) = 
+# 3474 "parsing/parser.mly"
+                                                ( "()" )
+# 6762 "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 : unit = 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) = 
+# 3475 "parsing/parser.mly"
+                                                ( "false" )
+# 6787 "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 : unit = 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) = 
+# 3476 "parsing/parser.mly"
+                                                ( "true" )
+# 6812 "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 : (
+# 697 "parsing/parser.mly"
+       (string)
+# 6833 "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) = 
+# 3479 "parsing/parser.mly"
+                                                ( _1 )
+# 6841 "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 = _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 : 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 : (Asttypes.label) = let _1 = 
+# 3470 "parsing/parser.mly"
+                                                ( "::" )
+# 6880 "parsing/parser.ml"
+         in
+        
+# 3480 "parsing/parser.mly"
+                                                ( _1 )
+# 6885 "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 : (Asttypes.label) = 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) = 
+# 3481 "parsing/parser.mly"
+                                                ( _1 )
+# 6910 "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 : (Longident.t) = 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) = 
+# 3484 "parsing/parser.mly"
+                                         ( _1 )
+# 6935 "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_inlined1;
+            MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+            MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
+            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.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 : unit = Obj.magic _3 in
+        let _2_inlined1 : unit = Obj.magic _2_inlined1 in
+        let _1_inlined1 : unit = Obj.magic _1_inlined1 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Longident.t) = let _3 =
+          let (_2, _1) = (_2_inlined1, _1_inlined1) in
+          
+# 3470 "parsing/parser.mly"
+                                                ( "::" )
+# 6990 "parsing/parser.ml"
+          
+        in
+        
+# 3485 "parsing/parser.mly"
+                                         ( Ldot(_1,_3) )
+# 6996 "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 = _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 : 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 : (Longident.t) = let _1 = 
+# 3470 "parsing/parser.mly"
+                                                ( "::" )
+# 7035 "parsing/parser.ml"
+         in
+        
+# 3486 "parsing/parser.mly"
+                                         ( Lident _1 )
+# 7040 "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 : (Asttypes.label) = 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) = 
+# 3487 "parsing/parser.mly"
+                                         ( Lident _1 )
+# 7065 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              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 _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__3_ in
+        let _v : (Parsetree.core_type * Parsetree.core_type) = 
+# 1988 "parsing/parser.mly"
+    ( _1, _3 )
+# 7104 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : (Parsetree.core_type) = 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 : (Parsetree.constructor_arguments) = let tys =
+          let xs =
+            let xs = 
+# 931 "parsing/parser.mly"
+    ( [ x ] )
+# 7131 "parsing/parser.ml"
+             in
+            
+# 253 ""
+    ( List.rev xs )
+# 7136 "parsing/parser.ml"
+            
+          in
+          
+# 951 "parsing/parser.mly"
+    ( xs )
+# 7142 "parsing/parser.ml"
+          
+        in
+        
+# 3034 "parsing/parser.mly"
+      ( Pcstr_tuple tys )
+# 7148 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.core_type) = Obj.magic x in
+        let _2 : unit = Obj.magic _2 in
+        let xs : (Parsetree.core_type list) = Obj.magic xs in
+        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 = 
+# 935 "parsing/parser.mly"
+    ( x :: xs )
+# 7189 "parsing/parser.ml"
+             in
+            
+# 253 ""
+    ( List.rev xs )
+# 7194 "parsing/parser.ml"
+            
+          in
+          
+# 951 "parsing/parser.mly"
+    ( xs )
+# 7200 "parsing/parser.ml"
+          
+        in
+        
+# 3034 "parsing/parser.mly"
+      ( Pcstr_tuple tys )
+# 7206 "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 = _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 : (Parsetree.label_declaration list) = 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.constructor_arguments) = 
+# 3036 "parsing/parser.mly"
+      ( Pcstr_record _2 )
+# 7245 "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 : unit = 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.constructor_declaration list) = 
+# 2955 "parsing/parser.mly"
+      ( [] )
+# 7270 "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 = xs;
+          MenhirLib.EngineTypes.startp = _startpos_xs_;
+          MenhirLib.EngineTypes.endp = _endpos_xs_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let xs : (Parsetree.constructor_declaration list) = Obj.magic xs in
+        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 = 
+# 1036 "parsing/parser.mly"
+    ( List.rev xs )
+# 7295 "parsing/parser.ml"
+         in
+        
+# 2957 "parsing/parser.mly"
+      ( cs )
+# 7300 "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) = let _1 = 
+# 3189 "parsing/parser.mly"
+    ( _1 )
+# 7325 "parsing/parser.ml"
+         in
+        
+# 3179 "parsing/parser.mly"
+      ( _1 )
+# 7330 "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 = _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 _2 : (Parsetree.attribute) = Obj.magic _2 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__2_ in
+        let _v : (Parsetree.core_type) = 
+# 3181 "parsing/parser.mly"
+      ( Typ.attr _1 _2 )
+# 7362 "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 : unit = 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.direction_flag) = 
+# 3578 "parsing/parser.mly"
+                                                ( Upto )
+# 7387 "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 : unit = 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.direction_flag) = 
+# 3579 "parsing/parser.mly"
+                                                ( Downto )
+# 7412 "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.expression) = 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.expression) = 
+# 2135 "parsing/parser.mly"
+      ( _1 )
+# 7437 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _1_inlined3;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+                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.next = {
+                    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 = _;
+                      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 _7 : (Parsetree.expression) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _5 : (Parsetree.module_expr) = Obj.magic _5 in
+        let _1_inlined3 : (string option) = Obj.magic _1_inlined3 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 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__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
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 7517 "parsing/parser.ml"
+            
+          in
+          let _3 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 7527 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 7533 "parsing/parser.ml"
+            
+          in
+          
+# 2183 "parsing/parser.mly"
+      ( Pexp_letmodule(_4, _5, _7), _3 )
+# 7539 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 7550 "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 = _6;
+          MenhirLib.EngineTypes.startp = _startpos__6_;
+          MenhirLib.EngineTypes.endp = _endpos__6_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _5;
+            MenhirLib.EngineTypes.startp = _startpos__5_;
+            MenhirLib.EngineTypes.endp = _endpos__5_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _1_inlined4;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined4_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined4_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _2_inlined1;
+                MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+                MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = _1_inlined3;
+                  MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+                  MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+                  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.next = {
+                      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 = _;
+                        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 _6 : (Parsetree.expression) = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
+        let _2_inlined1 : (Parsetree.constructor_arguments * Parsetree.core_type option) = Obj.magic _2_inlined1 in
+        let _1_inlined3 : (Asttypes.label) = Obj.magic _1_inlined3 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 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__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
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 7636 "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
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 7647 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos__3_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 3019 "parsing/parser.mly"
+      ( let args, res = _2 in
+        Te.decl _1 ~args ?res ~attrs:_3 ~loc:(make_loc _sloc) )
+# 7657 "parsing/parser.ml"
+            
+          in
+          let _3 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 7667 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 7673 "parsing/parser.ml"
+            
+          in
+          
+# 2185 "parsing/parser.mly"
+      ( Pexp_letexception(_4, _6), _3 )
+# 7679 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 7690 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              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.next = {
+                  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 = _;
+                    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 _7 : (Parsetree.expression) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _5 : (Parsetree.module_expr) = Obj.magic _5 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 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__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
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 7762 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 7768 "parsing/parser.ml"
+            
+          in
+          let _3 = 
+# 3633 "parsing/parser.mly"
+                                                ( Fresh )
+# 7774 "parsing/parser.ml"
+           in
+          
+# 2187 "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 )
+# 7781 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 7792 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _1_inlined3;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+                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.next = {
+                    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 = _;
+                      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 _7 : (Parsetree.expression) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _5 : (Parsetree.module_expr) = Obj.magic _5 in
+        let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let _1_inlined2 : (string Asttypes.loc option) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : unit = Obj.magic _1_inlined1 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__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
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 7871 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 7877 "parsing/parser.ml"
+            
+          in
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 3634 "parsing/parser.mly"
+                                                ( Override )
+# 7885 "parsing/parser.ml"
+            
+          in
+          
+# 2187 "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 )
+# 7893 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 7904 "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 = _;
+            MenhirLib.EngineTypes.semv = _1_inlined2;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+            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.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.case list) = Obj.magic xs 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_xs_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _3 =
+            let xs =
+              let xs = 
+# 253 ""
+    ( List.rev xs )
+# 7953 "parsing/parser.ml"
+               in
+              
+# 1008 "parsing/parser.mly"
+    ( xs )
+# 7958 "parsing/parser.ml"
+              
+            in
+            
+# 2519 "parsing/parser.mly"
+    ( xs )
+# 7964 "parsing/parser.ml"
+            
+          in
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 7974 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 7980 "parsing/parser.ml"
+            
+          in
+          
+# 2191 "parsing/parser.mly"
+      ( Pexp_function _3, _2 )
+# 7986 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 7997 "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 = _1_inlined2;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+              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.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.expression) = Obj.magic _4 in
+        let _3 : (Asttypes.arg_label * Parsetree.expression option * 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__4_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 8055 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 8061 "parsing/parser.ml"
+            
+          in
+          
+# 2193 "parsing/parser.mly"
+      ( let (l,o,p) = _3 in
+        Pexp_fun(l, o, p, _4), _2 )
+# 8068 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 8079 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = xs;
+              MenhirLib.EngineTypes.startp = _startpos_xs_;
+              MenhirLib.EngineTypes.endp = _endpos_xs_;
+              MenhirLib.EngineTypes.next = {
+                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 = _1_inlined2;
+                    MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+                    MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+                    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.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 _7 : (Parsetree.expression) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let xs : (string Asttypes.loc list) = Obj.magic xs in
+        let _4 : unit = Obj.magic _4 in
+        let _3 : unit = 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__7_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _5 = 
+# 2414 "parsing/parser.mly"
+    ( xs )
+# 8154 "parsing/parser.ml"
+           in
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 8163 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 8169 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__7_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2196 "parsing/parser.mly"
+      ( (mk_newtypes ~loc:_sloc _5 _7).pexp_desc, _2 )
+# 8178 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 8189 "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 = _;
+            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 = _1_inlined2;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+                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.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.case list) = Obj.magic xs in
+        let _4 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.expression) = 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_xs_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _5 =
+            let xs =
+              let xs = 
+# 253 ""
+    ( List.rev xs )
+# 8252 "parsing/parser.ml"
+               in
+              
+# 1008 "parsing/parser.mly"
+    ( xs )
+# 8257 "parsing/parser.ml"
+              
+            in
+            
+# 2519 "parsing/parser.mly"
+    ( xs )
+# 8263 "parsing/parser.ml"
+            
+          in
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 8273 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 8279 "parsing/parser.ml"
+            
+          in
+          
+# 2198 "parsing/parser.mly"
+      ( Pexp_match(_3, _5), _2 )
+# 8285 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 8296 "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 = _;
+            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 = _1_inlined2;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+                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.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.case list) = Obj.magic xs in
+        let _4 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.expression) = 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_xs_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _5 =
+            let xs =
+              let xs = 
+# 253 ""
+    ( List.rev xs )
+# 8359 "parsing/parser.ml"
+               in
+              
+# 1008 "parsing/parser.mly"
+    ( xs )
+# 8364 "parsing/parser.ml"
+              
+            in
+            
+# 2519 "parsing/parser.mly"
+    ( xs )
+# 8370 "parsing/parser.ml"
+            
+          in
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 8380 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 8386 "parsing/parser.ml"
+            
+          in
+          
+# 2200 "parsing/parser.mly"
+      ( Pexp_try(_3, _5), _2 )
+# 8392 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 8403 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 = _1_inlined2;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+                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.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 _5 : unit = Obj.magic _5 in
+        let _4 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.expression) = 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__5_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 8468 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 8474 "parsing/parser.ml"
+            
+          in
+          
+# 2202 "parsing/parser.mly"
+      ( syntax_error() )
+# 8480 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 8491 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                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 = _1_inlined2;
+                    MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+                    MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+                    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.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 _7 : (Parsetree.expression) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _5 : (Parsetree.expression) = Obj.magic _5 in
+        let _4 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.expression) = 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__7_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 8570 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 8576 "parsing/parser.ml"
+            
+          in
+          
+# 2204 "parsing/parser.mly"
+      ( Pexp_ifthenelse(_3, _5, Some _7), _2 )
+# 8582 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 8593 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 = _1_inlined2;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+                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.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 _5 : (Parsetree.expression) = Obj.magic _5 in
+        let _4 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.expression) = 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__5_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 8658 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 8664 "parsing/parser.ml"
+            
+          in
+          
+# 2206 "parsing/parser.mly"
+      ( Pexp_ifthenelse(_3, _5, None), _2 )
+# 8670 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 8681 "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 = _6;
+          MenhirLib.EngineTypes.startp = _startpos__6_;
+          MenhirLib.EngineTypes.endp = _endpos__6_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _5;
+            MenhirLib.EngineTypes.startp = _startpos__5_;
+            MenhirLib.EngineTypes.endp = _endpos__5_;
+            MenhirLib.EngineTypes.next = {
+              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 = _1_inlined2;
+                  MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+                  MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+                  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.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 _6 : unit = Obj.magic _6 in
+        let _5 : (Parsetree.expression) = Obj.magic _5 in
+        let _4 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.expression) = 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__6_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 8753 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 8759 "parsing/parser.ml"
+            
+          in
+          
+# 2208 "parsing/parser.mly"
+      ( Pexp_while(_3, _5), _2 )
+# 8765 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 8776 "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 = _10;
+          MenhirLib.EngineTypes.startp = _startpos__10_;
+          MenhirLib.EngineTypes.endp = _endpos__10_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _9;
+            MenhirLib.EngineTypes.startp = _startpos__9_;
+            MenhirLib.EngineTypes.endp = _endpos__9_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _8;
+              MenhirLib.EngineTypes.startp = _startpos__8_;
+              MenhirLib.EngineTypes.endp = _endpos__8_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _7;
+                MenhirLib.EngineTypes.startp = _startpos__7_;
+                MenhirLib.EngineTypes.endp = _endpos__7_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = _6;
+                  MenhirLib.EngineTypes.startp = _startpos__6_;
+                  MenhirLib.EngineTypes.endp = _endpos__6_;
+                  MenhirLib.EngineTypes.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = _5;
+                    MenhirLib.EngineTypes.startp = _startpos__5_;
+                    MenhirLib.EngineTypes.endp = _endpos__5_;
+                    MenhirLib.EngineTypes.next = {
+                      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 = _1_inlined2;
+                          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+                          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+                          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.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 _10 : unit = Obj.magic _10 in
+        let _9 : (Parsetree.expression) = Obj.magic _9 in
+        let _8 : unit = Obj.magic _8 in
+        let _7 : (Parsetree.expression) = Obj.magic _7 in
+        let _6 : (Asttypes.direction_flag) = Obj.magic _6 in
+        let _5 : (Parsetree.expression) = Obj.magic _5 in
+        let _4 : unit = Obj.magic _4 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__10_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 8876 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 8882 "parsing/parser.ml"
+            
+          in
+          
+# 2211 "parsing/parser.mly"
+      ( Pexp_for(_3, _5, _7, _6, _9), _2 )
+# 8888 "parsing/parser.ml"
+          
+        in
+        let _endpos__1_ = _endpos__10_ in
+        let _endpos = _endpos__1_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 8899 "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 = _1_inlined2;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+            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.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.expression) = 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.expression) = let _1 =
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 8950 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 8956 "parsing/parser.ml"
+            
+          in
+          
+# 2213 "parsing/parser.mly"
+      ( Pexp_assert _3, _2 )
+# 8962 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 8973 "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 = _1_inlined2;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+            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.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.expression) = 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.expression) = let _1 =
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 9024 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 9030 "parsing/parser.ml"
+            
+          in
+          
+# 2215 "parsing/parser.mly"
+      ( Pexp_lazy _3, _2 )
+# 9036 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 9047 "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 = xss;
+            MenhirLib.EngineTypes.startp = _startpos_xss_;
+            MenhirLib.EngineTypes.endp = _endpos_xss_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _1_inlined3;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+              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.next = {
+                  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 _4 : unit = Obj.magic _4 in
+        let xss : (Parsetree.class_field list list) = Obj.magic xss in
+        let _1_inlined3 : (Parsetree.pattern) = Obj.magic _1_inlined3 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__4_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _3 =
+            let _1 = _1_inlined3 in
+            let _2 =
+              let _1 =
+                let _1 = 
+# 260 ""
+    ( List.flatten xss )
+# 9112 "parsing/parser.ml"
+                 in
+                
+# 1821 "parsing/parser.mly"
+    ( _1 )
+# 9117 "parsing/parser.ml"
+                
+              in
+              let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+              let _endpos = _endpos__1_ in
+              let _startpos = _startpos__1_ in
+              
+# 807 "parsing/parser.mly"
+                               ( extra_cstr _startpos _endpos _1 )
+# 9126 "parsing/parser.ml"
+              
+            in
+            
+# 1808 "parsing/parser.mly"
+       ( Cstr.mk _1 _2 )
+# 9132 "parsing/parser.ml"
+            
+          in
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 9142 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 9148 "parsing/parser.ml"
+            
+          in
+          
+# 2217 "parsing/parser.mly"
+      ( Pexp_object _3, _2 )
+# 9154 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 9165 "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 = xss;
+            MenhirLib.EngineTypes.startp = _startpos_xss_;
+            MenhirLib.EngineTypes.endp = _endpos_xss_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _1_inlined3;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+              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.next = {
+                  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 _4 : unit = Obj.magic _4 in
+        let xss : (Parsetree.class_field list list) = Obj.magic xss in
+        let _1_inlined3 : (Parsetree.pattern) = Obj.magic _1_inlined3 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__4_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _3 =
+            let _1 = _1_inlined3 in
+            let _2 =
+              let _1 =
+                let _1 = 
+# 260 ""
+    ( List.flatten xss )
+# 9230 "parsing/parser.ml"
+                 in
+                
+# 1821 "parsing/parser.mly"
+    ( _1 )
+# 9235 "parsing/parser.ml"
+                
+              in
+              let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+              let _endpos = _endpos__1_ in
+              let _startpos = _startpos__1_ in
+              
+# 807 "parsing/parser.mly"
+                               ( extra_cstr _startpos _endpos _1 )
+# 9244 "parsing/parser.ml"
+              
+            in
+            
+# 1808 "parsing/parser.mly"
+       ( Cstr.mk _1 _2 )
+# 9250 "parsing/parser.ml"
+            
+          in
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 9260 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 9266 "parsing/parser.ml"
+            
+          in
+          let _loc__4_ = (_startpos__4_, _endpos__4_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          
+# 2219 "parsing/parser.mly"
+      ( unclosed "object" _loc__1_ "end" _loc__4_ )
+# 9274 "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
+        
+# 2137 "parsing/parser.mly"
+      ( let desc, attrs = _1 in
+        mkexp_attrs ~loc:_sloc desc attrs )
+# 9285 "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 : ((Asttypes.arg_label * Parsetree.expression) list) = Obj.magic xs 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_xs_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let _2 =
+              let xs = 
+# 253 ""
+    ( List.rev xs )
+# 9320 "parsing/parser.ml"
+               in
+              
+# 915 "parsing/parser.mly"
+    ( xs )
+# 9325 "parsing/parser.ml"
+              
+            in
+            
+# 2223 "parsing/parser.mly"
+      ( Pexp_apply(_1, _2) )
+# 9331 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 9341 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 9347 "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 = xs;
+          MenhirLib.EngineTypes.startp = _startpos_xs_;
+          MenhirLib.EngineTypes.endp = _endpos_xs_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let xs : (Parsetree.expression list) = Obj.magic xs in
+        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 _1 =
+            let _1 =
+              let es =
+                let xs = 
+# 253 ""
+    ( List.rev xs )
+# 9376 "parsing/parser.ml"
+                 in
+                
+# 975 "parsing/parser.mly"
+    ( xs )
+# 9381 "parsing/parser.ml"
+                
+              in
+              
+# 2546 "parsing/parser.mly"
+    ( es )
+# 9387 "parsing/parser.ml"
+              
+            in
+            
+# 2225 "parsing/parser.mly"
+      ( Pexp_tuple(_1) )
+# 9393 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 9403 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 9409 "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 = _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 _2 : (Parsetree.expression) = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 _1 =
+            let _1 =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 9447 "parsing/parser.ml"
+              
+            in
+            
+# 2227 "parsing/parser.mly"
+      ( Pexp_construct(_1, Some _2) )
+# 9453 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 9463 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 9469 "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 = _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 _2 : (Parsetree.expression) = Obj.magic _2 in
+        let _1 : (Asttypes.label) = 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 _1 = 
+# 2229 "parsing/parser.mly"
+      ( Pexp_variant(_1, Some _2) )
+# 9502 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 9511 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 9517 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = op;
+            MenhirLib.EngineTypes.startp = _startpos_op_;
+            MenhirLib.EngineTypes.endp = _endpos_op_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let op : (
+# 623 "parsing/parser.mly"
+       (string)
+# 9551 "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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3443 "parsing/parser.mly"
+                  ( op )
+# 9563 "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
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 9572 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 9578 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 9588 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 9594 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = op;
+            MenhirLib.EngineTypes.startp = _startpos_op_;
+            MenhirLib.EngineTypes.endp = _endpos_op_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let op : (
+# 624 "parsing/parser.mly"
+       (string)
+# 9628 "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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3444 "parsing/parser.mly"
+                  ( op )
+# 9640 "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
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 9649 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 9655 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 9665 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 9671 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = op;
+            MenhirLib.EngineTypes.startp = _startpos_op_;
+            MenhirLib.EngineTypes.endp = _endpos_op_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let op : (
+# 625 "parsing/parser.mly"
+       (string)
+# 9705 "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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3445 "parsing/parser.mly"
+                  ( op )
+# 9717 "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
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 9726 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 9732 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 9742 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 9748 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = op;
+            MenhirLib.EngineTypes.startp = _startpos_op_;
+            MenhirLib.EngineTypes.endp = _endpos_op_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let op : (
+# 626 "parsing/parser.mly"
+       (string)
+# 9782 "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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3446 "parsing/parser.mly"
+                  ( op )
+# 9794 "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
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 9803 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 9809 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 9819 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 9825 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = op;
+            MenhirLib.EngineTypes.startp = _startpos_op_;
+            MenhirLib.EngineTypes.endp = _endpos_op_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let op : (
+# 627 "parsing/parser.mly"
+       (string)
+# 9859 "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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3447 "parsing/parser.mly"
+                  ( op )
+# 9871 "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
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 9880 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 9886 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 9896 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 9902 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let _1 : unit = Obj.magic _1 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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3448 "parsing/parser.mly"
+                   ("+")
+# 9944 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 9952 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 9958 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 9968 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 9974 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let _1 : unit = Obj.magic _1 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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3449 "parsing/parser.mly"
+                  ("+.")
+# 10016 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 10024 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 10030 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 10040 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 10046 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let _1 : unit = Obj.magic _1 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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3450 "parsing/parser.mly"
+                  ("+=")
+# 10088 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 10096 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 10102 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 10112 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 10118 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let _1 : unit = Obj.magic _1 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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3451 "parsing/parser.mly"
+                   ("-")
+# 10160 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 10168 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 10174 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 10184 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 10190 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let _1 : unit = Obj.magic _1 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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3452 "parsing/parser.mly"
+                  ("-.")
+# 10232 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 10240 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 10246 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 10256 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 10262 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let _1 : unit = Obj.magic _1 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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3453 "parsing/parser.mly"
+                   ("*")
+# 10304 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 10312 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 10318 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 10328 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 10334 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let _1 : unit = Obj.magic _1 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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3454 "parsing/parser.mly"
+                   ("%")
+# 10376 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 10384 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 10390 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 10400 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 10406 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let _1 : unit = Obj.magic _1 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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3455 "parsing/parser.mly"
+                   ("=")
+# 10448 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 10456 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 10462 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 10472 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 10478 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let _1 : unit = Obj.magic _1 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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3456 "parsing/parser.mly"
+                   ("<")
+# 10520 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 10528 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 10534 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 10544 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 10550 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let _1 : unit = Obj.magic _1 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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3457 "parsing/parser.mly"
+                   (">")
+# 10592 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 10600 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 10606 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 10616 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 10622 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let _1 : unit = Obj.magic _1 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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3458 "parsing/parser.mly"
+                  ("or")
+# 10664 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 10672 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 10678 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 10688 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 10694 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let _1 : unit = Obj.magic _1 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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3459 "parsing/parser.mly"
+                  ("||")
+# 10736 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 10744 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 10750 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 10760 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 10766 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let _1 : unit = Obj.magic _1 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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3460 "parsing/parser.mly"
+                   ("&")
+# 10808 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 10816 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 10822 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 10832 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 10838 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let _1 : unit = Obj.magic _1 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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3461 "parsing/parser.mly"
+                  ("&&")
+# 10880 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 10888 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 10894 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 10904 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 10910 "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 = e2;
+          MenhirLib.EngineTypes.startp = _startpos_e2_;
+          MenhirLib.EngineTypes.endp = _endpos_e2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e1;
+              MenhirLib.EngineTypes.startp = _startpos_e1_;
+              MenhirLib.EngineTypes.endp = _endpos_e1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let e2 : (Parsetree.expression) = Obj.magic e2 in
+        let _1 : unit = Obj.magic _1 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_e2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 =
+            let op =
+              let _1 = 
+# 3462 "parsing/parser.mly"
+                  (":=")
+# 10952 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 10960 "parsing/parser.ml"
+              
+            in
+            
+# 2231 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 10966 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 10976 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 10982 "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 = _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 _2 : (Parsetree.expression) = Obj.magic _2 in
+        let _1 : (string) = 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 _1 =
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            
+# 2233 "parsing/parser.mly"
+      ( mkuminus ~oploc:_loc__1_ _1 _2 )
+# 11017 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 11027 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 11033 "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 = _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 _2 : (Parsetree.expression) = Obj.magic _2 in
+        let _1 : (string) = 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 _1 =
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            
+# 2235 "parsing/parser.mly"
+      ( mkuplus ~oploc:_loc__1_ _1 _2 )
+# 11068 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 11078 "parsing/parser.ml"
+          
+        in
+        
+# 2140 "parsing/parser.mly"
+      ( _1 )
+# 11084 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (Parsetree.expression) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (let_bindings) = 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 _endpos = _endpos__3_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2142 "parsing/parser.mly"
+      ( expr_of_let_bindings ~loc:_sloc _1 _3 )
+# 11126 "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 = body;
+          MenhirLib.EngineTypes.startp = _startpos_body_;
+          MenhirLib.EngineTypes.endp = _endpos_body_;
+          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 = bindings;
+              MenhirLib.EngineTypes.startp = _startpos_bindings_;
+              MenhirLib.EngineTypes.endp = _endpos_bindings_;
+              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 body : (Parsetree.expression) = Obj.magic body in
+        let _3 : unit = Obj.magic _3 in
+        let bindings : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = Obj.magic bindings in
+        let _1 : (
+# 629 "parsing/parser.mly"
+       (string)
+# 11168 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 11180 "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
+        
+# 2144 "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}) )
+# 11194 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (Parsetree.expression) = Obj.magic _3 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__3_ in
+        let _v : (Parsetree.expression) = let _endpos = _endpos__3_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _loc__2_ = (_startpos__2_, _endpos__2_) in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2150 "parsing/parser.mly"
+      ( mkexp_cons ~loc:_sloc _loc__2_ (ghexp ~loc:_sloc (Pexp_tuple[_1;_3])) )
+# 11237 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (Parsetree.expression) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 11272 "parsing/parser.ml"
+        ) = 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 _1 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 11281 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 11289 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__3_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2152 "parsing/parser.mly"
+      ( mkexp ~loc:_sloc (Pexp_setinstvar(_1, _3)) )
+# 11298 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 = _1_inlined1;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+              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 _5 : (Parsetree.expression) = Obj.magic _5 in
+        let _4 : unit = Obj.magic _4 in
+        let _1_inlined1 : (Longident.t) = 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__5_ in
+        let _v : (Parsetree.expression) = 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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 11356 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2154 "parsing/parser.mly"
+      ( mkexp ~loc:_sloc (Pexp_setfield(_1, _3, _5)) )
+# 11365 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                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 _7 : (Parsetree.expression) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 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__7_ in
+        let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2156 "parsing/parser.mly"
+      ( array_set ~loc:_sloc _1 _4 _7 )
+# 11435 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                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 _7 : (Parsetree.expression) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 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__7_ in
+        let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2158 "parsing/parser.mly"
+      ( string_set ~loc:_sloc _1 _4 _7 )
+# 11505 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                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 _7 : (Parsetree.expression) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 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__7_ in
+        let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2160 "parsing/parser.mly"
+      ( bigarray_set ~loc:_sloc _1 _4 _7 )
+# 11575 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = es;
+                MenhirLib.EngineTypes.startp = _startpos_es_;
+                MenhirLib.EngineTypes.endp = _endpos_es_;
+                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 _7 : (Parsetree.expression) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 11637 "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__7_ in
+        let _v : (Parsetree.expression) = let _4 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 11646 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__7_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2162 "parsing/parser.mly"
+      ( dotop_set ~loc:_sloc lident bracket _2 _1 _4 _7 )
+# 11654 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = es;
+                MenhirLib.EngineTypes.startp = _startpos_es_;
+                MenhirLib.EngineTypes.endp = _endpos_es_;
+                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 _7 : (Parsetree.expression) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 11716 "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__7_ in
+        let _v : (Parsetree.expression) = let _4 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 11725 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__7_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2164 "parsing/parser.mly"
+      ( dotop_set ~loc:_sloc lident paren _2 _1 _4 _7 )
+# 11733 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = es;
+                MenhirLib.EngineTypes.startp = _startpos_es_;
+                MenhirLib.EngineTypes.endp = _endpos_es_;
+                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 _7 : (Parsetree.expression) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 11795 "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__7_ in
+        let _v : (Parsetree.expression) = let _4 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 11804 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__7_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2166 "parsing/parser.mly"
+      ( dotop_set ~loc:_sloc lident brace _2 _1 _4 _7 )
+# 11812 "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 = _9;
+          MenhirLib.EngineTypes.startp = _startpos__9_;
+          MenhirLib.EngineTypes.endp = _endpos__9_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _8;
+            MenhirLib.EngineTypes.startp = _startpos__8_;
+            MenhirLib.EngineTypes.endp = _endpos__8_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _7;
+              MenhirLib.EngineTypes.startp = _startpos__7_;
+              MenhirLib.EngineTypes.endp = _endpos__7_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = es;
+                MenhirLib.EngineTypes.startp = _startpos_es_;
+                MenhirLib.EngineTypes.endp = _endpos_es_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = _5;
+                  MenhirLib.EngineTypes.startp = _startpos__5_;
+                  MenhirLib.EngineTypes.endp = _endpos__5_;
+                  MenhirLib.EngineTypes.next = {
+                    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 _9 : (Parsetree.expression) = Obj.magic _9 in
+        let _8 : unit = Obj.magic _8 in
+        let _7 : unit = Obj.magic _7 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 11886 "parsing/parser.ml"
+        ) = Obj.magic _4 in
+        let _3 : (Longident.t) = Obj.magic _3 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__9_ in
+        let _v : (Parsetree.expression) = let _6 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 11897 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__9_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2169 "parsing/parser.mly"
+      ( dotop_set ~loc:_sloc (ldot _3) bracket _4 _1 _6 _9 )
+# 11905 "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 = _9;
+          MenhirLib.EngineTypes.startp = _startpos__9_;
+          MenhirLib.EngineTypes.endp = _endpos__9_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _8;
+            MenhirLib.EngineTypes.startp = _startpos__8_;
+            MenhirLib.EngineTypes.endp = _endpos__8_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _7;
+              MenhirLib.EngineTypes.startp = _startpos__7_;
+              MenhirLib.EngineTypes.endp = _endpos__7_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = es;
+                MenhirLib.EngineTypes.startp = _startpos_es_;
+                MenhirLib.EngineTypes.endp = _endpos_es_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = _5;
+                  MenhirLib.EngineTypes.startp = _startpos__5_;
+                  MenhirLib.EngineTypes.endp = _endpos__5_;
+                  MenhirLib.EngineTypes.next = {
+                    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 _9 : (Parsetree.expression) = Obj.magic _9 in
+        let _8 : unit = Obj.magic _8 in
+        let _7 : unit = Obj.magic _7 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 11979 "parsing/parser.ml"
+        ) = Obj.magic _4 in
+        let _3 : (Longident.t) = Obj.magic _3 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__9_ in
+        let _v : (Parsetree.expression) = let _6 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 11990 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__9_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2172 "parsing/parser.mly"
+      ( dotop_set ~loc:_sloc (ldot _3) paren _4 _1 _6 _9  )
+# 11998 "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 = _9;
+          MenhirLib.EngineTypes.startp = _startpos__9_;
+          MenhirLib.EngineTypes.endp = _endpos__9_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _8;
+            MenhirLib.EngineTypes.startp = _startpos__8_;
+            MenhirLib.EngineTypes.endp = _endpos__8_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _7;
+              MenhirLib.EngineTypes.startp = _startpos__7_;
+              MenhirLib.EngineTypes.endp = _endpos__7_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = es;
+                MenhirLib.EngineTypes.startp = _startpos_es_;
+                MenhirLib.EngineTypes.endp = _endpos_es_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = _5;
+                  MenhirLib.EngineTypes.startp = _startpos__5_;
+                  MenhirLib.EngineTypes.endp = _endpos__5_;
+                  MenhirLib.EngineTypes.next = {
+                    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 _9 : (Parsetree.expression) = Obj.magic _9 in
+        let _8 : unit = Obj.magic _8 in
+        let _7 : unit = Obj.magic _7 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 12072 "parsing/parser.ml"
+        ) = Obj.magic _4 in
+        let _3 : (Longident.t) = Obj.magic _3 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__9_ in
+        let _v : (Parsetree.expression) = let _6 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 12083 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__9_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2175 "parsing/parser.mly"
+      ( dotop_set ~loc:_sloc (ldot _3) brace _4 _1 _6 _9 )
+# 12091 "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 = _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 _2 : (Parsetree.attribute) = 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__2_ in
+        let _v : (Parsetree.expression) = 
+# 2177 "parsing/parser.mly"
+      ( Exp.attr _1 _2 )
+# 12123 "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 : unit = 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.expression) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
+        
+# 2179 "parsing/parser.mly"
+     ( not_expecting _loc__1_ "wildcard \"_\"" )
+# 12149 "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 : (string Asttypes.loc option) = 
+# 3734 "parsing/parser.mly"
+                    ( None )
+# 12167 "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 = _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 _2 : (string Asttypes.loc) = 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 : (string Asttypes.loc option) = 
+# 3735 "parsing/parser.mly"
+                    ( Some _2 )
+# 12199 "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 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.payload) = Obj.magic _3 in
+        let _2 : (string Asttypes.loc) = 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.extension) = 
+# 3745 "parsing/parser.mly"
+                                             ( (_2, _3) )
+# 12245 "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 : (
+# 687 "parsing/parser.mly"
+  (string * Location.t * string * Location.t * string option)
+# 12266 "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
+        
+# 3747 "parsing/parser.mly"
+    ( mk_quotedext ~loc:_sloc _1 )
+# 12277 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          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.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 = _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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let _1_inlined2 : (Longident.t) = Obj.magic _1_inlined2 in
+        let _3 : unit = Obj.magic _3 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_inlined3_ in
+        let _v : (Parsetree.extension_constructor) = let attrs =
+          let _1 = _1_inlined3 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 12332 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 12344 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 12355 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_attrs_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3103 "parsing/parser.mly"
+      ( let info = symbol_info _endpos in
+        Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info )
+# 12365 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          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.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _3;
+              MenhirLib.EngineTypes.startp = _startpos__3_;
+              MenhirLib.EngineTypes.endp = _endpos__3_;
+              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 _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (Longident.t) = Obj.magic _1_inlined1 in
+        let _3 : unit = Obj.magic _3 in
+        let _1 : (Asttypes.label) = 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.extension_constructor) = let attrs =
+          let _1 = _1_inlined2 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 12413 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 12425 "parsing/parser.ml"
+          
+        in
+        let cid =
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 12435 "parsing/parser.ml"
+          
+        in
+        let _startpos_cid_ = _startpos__1_ in
+        let _1 = 
+# 3554 "parsing/parser.mly"
+    ( () )
+# 12442 "parsing/parser.ml"
+         in
+        let _endpos = _endpos_attrs_ in
+        let _symbolstartpos = _startpos_cid_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3103 "parsing/parser.mly"
+      ( let info = symbol_info _endpos in
+        Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info )
+# 12451 "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 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.payload) = Obj.magic _3 in
+        let _2 : (string Asttypes.loc) = 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.attribute) = let _endpos = _endpos__4_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3722 "parsing/parser.mly"
+    ( mark_symbol_docs _sloc;
+      Attr.mk ~loc:(make_loc _sloc) _2 _3 )
+# 12501 "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.core_type * Asttypes.variance) list) = let params = 
+# 1928 "parsing/parser.mly"
+      ( [] )
+# 12519 "parsing/parser.ml"
+         in
+        
+# 1753 "parsing/parser.mly"
+    ( params )
+# 12524 "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 = 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 _3 : unit = Obj.magic _3 in
+        let xs : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic xs 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.core_type * Asttypes.variance) list) = let params =
+          let params =
+            let xs = 
+# 253 ""
+    ( List.rev xs )
+# 12565 "parsing/parser.ml"
+             in
+            
+# 947 "parsing/parser.mly"
+    ( xs )
+# 12570 "parsing/parser.ml"
+            
+          in
+          
+# 1930 "parsing/parser.mly"
+      ( params )
+# 12576 "parsing/parser.ml"
+          
+        in
+        
+# 1753 "parsing/parser.mly"
+    ( params )
+# 12582 "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.expression) = 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.expression) = 
+# 2505 "parsing/parser.mly"
+      ( _1 )
+# 12607 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (Parsetree.expression) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Parsetree.core_type option * Parsetree.core_type option) = 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 _endpos = _endpos__3_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2507 "parsing/parser.mly"
+      ( mkexp_constraint ~loc:_sloc _3 _1 )
+# 12649 "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 = _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 _2 : (Parsetree.expression) = 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.expression) = 
+# 2531 "parsing/parser.mly"
+      ( _2 )
+# 12681 "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.expression) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (Parsetree.core_type) = 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.expression) = let _1 =
+          let _1 = 
+# 2533 "parsing/parser.mly"
+      ( Pexp_constraint (_4, _2) )
+# 12728 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 12737 "parsing/parser.ml"
+          
+        in
+        
+# 2534 "parsing/parser.mly"
+      ( _1 )
+# 12743 "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 = _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 _2 : (Parsetree.expression) = Obj.magic _2 in
+        let _1 : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = 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 _endpos = _endpos__2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2537 "parsing/parser.mly"
+      (
+       let (l,o,p) = _1 in
+       ghexp ~loc:_sloc (Pexp_fun(l, o, p, _2))
+      )
+# 12781 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 = xs;
+              MenhirLib.EngineTypes.startp = _startpos_xs_;
+              MenhirLib.EngineTypes.endp = _endpos_xs_;
+              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 _5 : (Parsetree.expression) = Obj.magic _5 in
+        let _4 : unit = Obj.magic _4 in
+        let xs : (string Asttypes.loc list) = Obj.magic xs 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 : (Parsetree.expression) = let _3 = 
+# 2414 "parsing/parser.mly"
+    ( xs )
+# 12834 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2542 "parsing/parser.mly"
+      ( mk_newtypes ~loc:_sloc _3 _5 )
+# 12842 "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 = ty;
+          MenhirLib.EngineTypes.startp = _startpos_ty_;
+          MenhirLib.EngineTypes.endp = _endpos_ty_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let ty : (Parsetree.core_type) = Obj.magic ty in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_ty_ in
+        let _endpos = _endpos_ty_ in
+        let _v : (Parsetree.core_type) = 
+# 3215 "parsing/parser.mly"
+      ( ty )
+# 12867 "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 = codomain;
+          MenhirLib.EngineTypes.startp = _startpos_codomain_;
+          MenhirLib.EngineTypes.endp = _endpos_codomain_;
+          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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _menhir_s;
+                MenhirLib.EngineTypes.semv = label;
+                MenhirLib.EngineTypes.startp = _startpos_label_;
+                MenhirLib.EngineTypes.endp = _endpos_label_;
+                MenhirLib.EngineTypes.next = _menhir_stack;
+              };
+            };
+          };
+        } = _menhir_stack in
+        let codomain : (Parsetree.core_type) = Obj.magic codomain in
+        let _3 : unit = Obj.magic _3 in
+        let _1 : (Parsetree.core_type) = Obj.magic _1 in
+        let label : (string) = 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 _1 =
+            let domain = 
+# 811 "parsing/parser.mly"
+                              ( extra_rhs_core_type _1 ~pos:_endpos__1_ )
+# 12915 "parsing/parser.ml"
+             in
+            let label = 
+# 3227 "parsing/parser.mly"
+      ( Optional label )
+# 12920 "parsing/parser.ml"
+             in
+            
+# 3221 "parsing/parser.mly"
+        ( Ptyp_arrow(label, domain, codomain) )
+# 12925 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 12935 "parsing/parser.ml"
+          
+        in
+        
+# 3223 "parsing/parser.mly"
+    ( _1 )
+# 12941 "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 = codomain;
+          MenhirLib.EngineTypes.startp = _startpos_codomain_;
+          MenhirLib.EngineTypes.endp = _endpos_codomain_;
+          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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              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 = label;
+                  MenhirLib.EngineTypes.startp = _startpos_label_;
+                  MenhirLib.EngineTypes.endp = _endpos_label_;
+                  MenhirLib.EngineTypes.next = _menhir_stack;
+                };
+              };
+            };
+          };
+        } = _menhir_stack in
+        let codomain : (Parsetree.core_type) = Obj.magic codomain in
+        let _3 : unit = Obj.magic _3 in
+        let _1 : (Parsetree.core_type) = Obj.magic _1 in
+        let _2 : unit = Obj.magic _2 in
+        let label : (
+# 647 "parsing/parser.mly"
+       (string)
+# 12990 "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 _1 =
+            let domain = 
+# 811 "parsing/parser.mly"
+                              ( extra_rhs_core_type _1 ~pos:_endpos__1_ )
+# 13000 "parsing/parser.ml"
+             in
+            let label = 
+# 3229 "parsing/parser.mly"
+      ( Labelled label )
+# 13005 "parsing/parser.ml"
+             in
+            
+# 3221 "parsing/parser.mly"
+        ( Ptyp_arrow(label, domain, codomain) )
+# 13010 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 13020 "parsing/parser.ml"
+          
+        in
+        
+# 3223 "parsing/parser.mly"
+    ( _1 )
+# 13026 "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 = codomain;
+          MenhirLib.EngineTypes.startp = _startpos_codomain_;
+          MenhirLib.EngineTypes.endp = _endpos_codomain_;
+          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 = _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 codomain : (Parsetree.core_type) = Obj.magic codomain in
+        let _3 : unit = Obj.magic _3 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_codomain_ in
+        let _v : (Parsetree.core_type) = let _1 =
+          let _1 =
+            let domain = 
+# 811 "parsing/parser.mly"
+                              ( extra_rhs_core_type _1 ~pos:_endpos__1_ )
+# 13067 "parsing/parser.ml"
+             in
+            let label = 
+# 3231 "parsing/parser.mly"
+      ( Nolabel )
+# 13072 "parsing/parser.ml"
+             in
+            
+# 3221 "parsing/parser.mly"
+        ( Ptyp_arrow(label, domain, codomain) )
+# 13077 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 13087 "parsing/parser.ml"
+          
+        in
+        
+# 3223 "parsing/parser.mly"
+    ( _1 )
+# 13093 "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 = _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 _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__2_ in
+        let _v : (Parsetree.functor_parameter) = 
+# 1186 "parsing/parser.mly"
+      ( Unit )
+# 13125 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 = _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.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 _5 : unit = Obj.magic _5 in
+        let mty : (Parsetree.module_type) = Obj.magic mty in
+        let _3 : unit = Obj.magic _3 in
+        let _1_inlined1 : (string 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__5_ in
+        let _v : (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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 13183 "parsing/parser.ml"
+          
+        in
+        
+# 1189 "parsing/parser.mly"
+      ( Named (x, mty) )
+# 13189 "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.constructor_arguments * Parsetree.core_type option) = 
+# 3023 "parsing/parser.mly"
+                                  ( (Pcstr_tuple [],None) )
+# 13207 "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 = _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 _2 : (Parsetree.constructor_arguments) = 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.constructor_arguments * Parsetree.core_type option) = 
+# 3024 "parsing/parser.mly"
+                                  ( (_2,None) )
+# 13239 "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.core_type) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (Parsetree.constructor_arguments) = 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.constructor_arguments * Parsetree.core_type option) = 
+# 3026 "parsing/parser.mly"
+                                  ( (_2,Some _4) )
+# 13285 "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 = _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 _2 : (Parsetree.core_type) = 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.constructor_arguments * Parsetree.core_type option) = 
+# 3028 "parsing/parser.mly"
+                                  ( (Pcstr_tuple [],Some _2) )
+# 13317 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = args_res;
+            MenhirLib.EngineTypes.startp = _startpos_args_res_;
+            MenhirLib.EngineTypes.endp = _endpos_args_res_;
+            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.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 _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let args_res : (Parsetree.constructor_arguments * Parsetree.core_type option) = Obj.magic args_res 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 : (Ast_helper.str * Parsetree.constructor_arguments *
+  Parsetree.core_type option * Parsetree.attributes * Location.t *
+  Docstrings.info) = let attrs =
+          let _1 = _1_inlined2 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 13367 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 13379 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_attrs_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2971 "parsing/parser.mly"
+    (
+      let args, res = args_res in
+      let info = symbol_info _endpos in
+      let loc = make_loc _sloc in
+      cid, args, res, attrs, loc, info
+    )
+# 13393 "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 = _1_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = args_res;
+            MenhirLib.EngineTypes.startp = _startpos_args_res_;
+            MenhirLib.EngineTypes.endp = _endpos_args_res_;
+            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 _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let args_res : (Parsetree.constructor_arguments * Parsetree.core_type option) = Obj.magic args_res in
+        let _1 : (Asttypes.label) = 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 : (Ast_helper.str * Parsetree.constructor_arguments *
+  Parsetree.core_type option * Parsetree.attributes * Location.t *
+  Docstrings.info) = let attrs =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 13436 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 13447 "parsing/parser.ml"
+          
+        in
+        let _startpos_cid_ = _startpos__1_ in
+        let _1 = 
+# 3554 "parsing/parser.mly"
+    ( () )
+# 13454 "parsing/parser.ml"
+         in
+        let _endpos = _endpos_attrs_ in
+        let _symbolstartpos = _startpos_cid_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2971 "parsing/parser.mly"
+    (
+      let args, res = args_res in
+      let info = symbol_info _endpos in
+      let loc = make_loc _sloc in
+      cid, args, res, attrs, loc, info
+    )
+# 13467 "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 = _1_inlined4;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined4_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined4_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = xs;
+            MenhirLib.EngineTypes.startp = _startpos_xs_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_;
+            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 = _;
+                MenhirLib.EngineTypes.semv = _1_inlined3;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+                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.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = params;
+                    MenhirLib.EngineTypes.startp = _startpos_params_;
+                    MenhirLib.EngineTypes.endp = _endpos_params_;
+                    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.next = {
+                        MenhirLib.EngineTypes.state = _;
+                        MenhirLib.EngineTypes.semv = ext;
+                        MenhirLib.EngineTypes.startp = _startpos_ext_;
+                        MenhirLib.EngineTypes.endp = _endpos_ext_;
+                        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 _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
+        let xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs in
+        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 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 13540 "parsing/parser.ml"
+        ) = Obj.magic _1_inlined2 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext 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_inlined4_ in
+        let _v : ((Asttypes.rec_flag * string Asttypes.loc option) *
+  Parsetree.type_declaration) = let attrs2 =
+          let _1 = _1_inlined4 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 13555 "parsing/parser.ml"
+          
+        in
+        let _endpos_attrs2_ = _endpos__1_inlined4_ in
+        let cstrs =
+          let _1 =
+            let xs = 
+# 253 ""
+    ( List.rev xs )
+# 13564 "parsing/parser.ml"
+             in
+            
+# 897 "parsing/parser.mly"
+    ( xs )
+# 13569 "parsing/parser.ml"
+            
+          in
+          
+# 2887 "parsing/parser.mly"
+    ( _1 )
+# 13575 "parsing/parser.ml"
+          
+        in
+        let kind_priv_manifest =
+          let _1 = _1_inlined3 in
+          
+# 2922 "parsing/parser.mly"
+      ( _2 )
+# 13583 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 13594 "parsing/parser.ml"
+          
+        in
+        let flag = 
+# 3574 "parsing/parser.mly"
+                ( Recursive )
+# 13600 "parsing/parser.ml"
+         in
+        let attrs1 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 13607 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_attrs2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2859 "parsing/parser.mly"
+    (
+      let (kind, priv, manifest) = kind_priv_manifest in
+      let docs = symbol_docs _sloc in
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc _sloc in
+      (flag, ext),
+      Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
+    )
+# 13623 "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 = _1_inlined5;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined5_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = xs;
+            MenhirLib.EngineTypes.startp = _startpos_xs_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_;
+            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 = _;
+                MenhirLib.EngineTypes.semv = _1_inlined4;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined4_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined4_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = _1_inlined3;
+                  MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+                  MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+                  MenhirLib.EngineTypes.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = params;
+                    MenhirLib.EngineTypes.startp = _startpos_params_;
+                    MenhirLib.EngineTypes.endp = _endpos_params_;
+                    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.next = {
+                        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 = _;
+                          MenhirLib.EngineTypes.semv = ext;
+                          MenhirLib.EngineTypes.startp = _startpos_ext_;
+                          MenhirLib.EngineTypes.endp = _endpos_ext_;
+                          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 _1_inlined5 : (Parsetree.attributes) = Obj.magic _1_inlined5 in
+        let xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs in
+        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 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 13702 "parsing/parser.ml"
+        ) = Obj.magic _1_inlined3 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let _1_inlined2 : unit = 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
+        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_inlined5_ in
+        let _v : ((Asttypes.rec_flag * string Asttypes.loc option) *
+  Parsetree.type_declaration) = let attrs2 =
+          let _1 = _1_inlined5 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 13718 "parsing/parser.ml"
+          
+        in
+        let _endpos_attrs2_ = _endpos__1_inlined5_ in
+        let cstrs =
+          let _1 =
+            let xs = 
+# 253 ""
+    ( List.rev xs )
+# 13727 "parsing/parser.ml"
+             in
+            
+# 897 "parsing/parser.mly"
+    ( xs )
+# 13732 "parsing/parser.ml"
+            
+          in
+          
+# 2887 "parsing/parser.mly"
+    ( _1 )
+# 13738 "parsing/parser.ml"
+          
+        in
+        let kind_priv_manifest =
+          let _1 = _1_inlined4 in
+          
+# 2922 "parsing/parser.mly"
+      ( _2 )
+# 13746 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 13757 "parsing/parser.ml"
+          
+        in
+        let flag =
+          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+          let _endpos = _endpos__1_ in
+          let _startpos = _startpos__1_ in
+          let _loc = (_startpos, _endpos) in
+          
+# 3575 "parsing/parser.mly"
+                ( not_expecting _loc "nonrec flag" )
+# 13768 "parsing/parser.ml"
+          
+        in
+        let attrs1 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 13776 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_attrs2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2859 "parsing/parser.mly"
+    (
+      let (kind, priv, manifest) = kind_priv_manifest in
+      let docs = symbol_docs _sloc in
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc _sloc in
+      (flag, ext),
+      Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
+    )
+# 13792 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = xs;
+            MenhirLib.EngineTypes.startp = _startpos_xs_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = kind_priv_manifest;
+              MenhirLib.EngineTypes.startp = _startpos_kind_priv_manifest_;
+              MenhirLib.EngineTypes.endp = _endpos_kind_priv_manifest_;
+              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.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = params;
+                  MenhirLib.EngineTypes.startp = _startpos_params_;
+                  MenhirLib.EngineTypes.endp = _endpos_params_;
+                  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.next = {
+                      MenhirLib.EngineTypes.state = _;
+                      MenhirLib.EngineTypes.semv = ext;
+                      MenhirLib.EngineTypes.startp = _startpos_ext_;
+                      MenhirLib.EngineTypes.endp = _endpos_ext_;
+                      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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        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 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 13858 "parsing/parser.ml"
+        ) = Obj.magic _1_inlined2 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext 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_inlined3_ in
+        let _v : ((Asttypes.rec_flag * string Asttypes.loc option) *
+  Parsetree.type_declaration) = let attrs2 =
+          let _1 = _1_inlined3 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 13873 "parsing/parser.ml"
+          
+        in
+        let _endpos_attrs2_ = _endpos__1_inlined3_ in
+        let cstrs =
+          let _1 =
+            let xs = 
+# 253 ""
+    ( List.rev xs )
+# 13882 "parsing/parser.ml"
+             in
+            
+# 897 "parsing/parser.mly"
+    ( xs )
+# 13887 "parsing/parser.ml"
+            
+          in
+          
+# 2887 "parsing/parser.mly"
+    ( _1 )
+# 13893 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 13904 "parsing/parser.ml"
+          
+        in
+        let flag = 
+# 3570 "parsing/parser.mly"
+                                                ( Recursive )
+# 13910 "parsing/parser.ml"
+         in
+        let attrs1 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 13917 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_attrs2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2859 "parsing/parser.mly"
+    (
+      let (kind, priv, manifest) = kind_priv_manifest in
+      let docs = symbol_docs _sloc in
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc _sloc in
+      (flag, ext),
+      Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
+    )
+# 13933 "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 = _1_inlined4;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined4_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined4_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = xs;
+            MenhirLib.EngineTypes.startp = _startpos_xs_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = kind_priv_manifest;
+              MenhirLib.EngineTypes.startp = _startpos_kind_priv_manifest_;
+              MenhirLib.EngineTypes.endp = _endpos_kind_priv_manifest_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _1_inlined3;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = params;
+                  MenhirLib.EngineTypes.startp = _startpos_params_;
+                  MenhirLib.EngineTypes.endp = _endpos_params_;
+                  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.next = {
+                      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 = _;
+                        MenhirLib.EngineTypes.semv = ext;
+                        MenhirLib.EngineTypes.startp = _startpos_ext_;
+                        MenhirLib.EngineTypes.endp = _endpos_ext_;
+                        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 _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
+        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 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 14005 "parsing/parser.ml"
+        ) = Obj.magic _1_inlined3 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let _1_inlined2 : unit = 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
+        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_inlined4_ in
+        let _v : ((Asttypes.rec_flag * string Asttypes.loc option) *
+  Parsetree.type_declaration) = let attrs2 =
+          let _1 = _1_inlined4 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 14021 "parsing/parser.ml"
+          
+        in
+        let _endpos_attrs2_ = _endpos__1_inlined4_ in
+        let cstrs =
+          let _1 =
+            let xs = 
+# 253 ""
+    ( List.rev xs )
+# 14030 "parsing/parser.ml"
+             in
+            
+# 897 "parsing/parser.mly"
+    ( xs )
+# 14035 "parsing/parser.ml"
+            
+          in
+          
+# 2887 "parsing/parser.mly"
+    ( _1 )
+# 14041 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 14052 "parsing/parser.ml"
+          
+        in
+        let flag =
+          let _1 = _1_inlined2 in
+          
+# 3571 "parsing/parser.mly"
+                                                ( Nonrecursive )
+# 14060 "parsing/parser.ml"
+          
+        in
+        let attrs1 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 14068 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_attrs2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2859 "parsing/parser.mly"
+    (
+      let (kind, priv, manifest) = kind_priv_manifest in
+      let docs = symbol_docs _sloc in
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc _sloc in
+      (flag, ext),
+      Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
+    )
+# 14084 "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 : (
+# 697 "parsing/parser.mly"
+       (string)
+# 14105 "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) = 
+# 3415 "parsing/parser.mly"
+                              ( _1 )
+# 14113 "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 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 14134 "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) = 
+# 3416 "parsing/parser.mly"
+                              ( _1 )
+# 14142 "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 = _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 _2 : unit = Obj.magic _2 in
+        let _1 : (Parsetree.structure) = 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 : (
+# 777 "parsing/parser.mly"
+      (Parsetree.structure)
+# 14174 "parsing/parser.ml"
+        ) = 
+# 1068 "parsing/parser.mly"
+    ( _1 )
+# 14178 "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 : (string) = 
+# 3465 "parsing/parser.mly"
+  ( "" )
+# 14196 "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 = _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 _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__2_ in
+        let _v : (string) = 
+# 3466 "parsing/parser.mly"
+              ( ";.." )
+# 14228 "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 = _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 _2 : unit = Obj.magic _2 in
+        let _1 : (Parsetree.signature) = 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 : (
+# 779 "parsing/parser.mly"
+      (Parsetree.signature)
+# 14260 "parsing/parser.ml"
+        ) = 
+# 1074 "parsing/parser.mly"
+    ( _1 )
+# 14264 "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 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.payload) = Obj.magic _3 in
+        let _2 : (string Asttypes.loc) = 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.extension) = 
+# 3750 "parsing/parser.mly"
+                                                    ( (_2, _3) )
+# 14310 "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 : (
+# 689 "parsing/parser.mly"
+  (string * Location.t * string * Location.t * string option)
+# 14331 "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
+        
+# 3752 "parsing/parser.mly"
+    ( mk_quotedext ~loc:_sloc _1 )
+# 14342 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          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.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 = _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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
+        let _3 : unit = Obj.magic _3 in
+        let _1_inlined1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 14390 "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
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 14401 "parsing/parser.ml"
+          
+        in
+        let _endpos__5_ = _endpos__1_inlined3_ in
+        let _4 =
+          let _1 = _1_inlined2 in
+          
+# 3168 "parsing/parser.mly"
+    ( _1 )
+# 14410 "parsing/parser.ml"
+          
+        in
+        let _2 =
+          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+          let _1 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 14418 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 14426 "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
+        
+# 3045 "parsing/parser.mly"
+      ( let info = symbol_info _endpos in
+        Type.field _2 _4 ~mut:_1 ~attrs:_5 ~loc:(make_loc _sloc) ~info )
+# 14440 "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 = _1_inlined4;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined4_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined4_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _1_inlined3;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+              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.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 = _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 _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
+        let _6 : unit = Obj.magic _6 in
+        let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
+        let _3 : unit = Obj.magic _3 in
+        let _1_inlined1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 14502 "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
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 14513 "parsing/parser.ml"
+          
+        in
+        let _endpos__7_ = _endpos__1_inlined4_ in
+        let _5 =
+          let _1 = _1_inlined3 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 14522 "parsing/parser.ml"
+          
+        in
+        let _endpos__5_ = _endpos__1_inlined3_ in
+        let _4 =
+          let _1 = _1_inlined2 in
+          
+# 3168 "parsing/parser.mly"
+    ( _1 )
+# 14531 "parsing/parser.ml"
+          
+        in
+        let _2 =
+          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+          let _1 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 14539 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 14547 "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
+        
+# 3050 "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 )
+# 14565 "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.label_declaration) = 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.label_declaration list) = 
+# 3039 "parsing/parser.mly"
+                                                ( [_1] )
+# 14590 "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.label_declaration) = 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.label_declaration list) = 
+# 3040 "parsing/parser.mly"
+                                                ( [_1] )
+# 14615 "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 = _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 _2 : (Parsetree.label_declaration list) = Obj.magic _2 in
+        let _1 : (Parsetree.label_declaration) = 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.label_declaration list) = 
+# 3041 "parsing/parser.mly"
+                                                ( _1 :: _2 )
+# 14647 "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 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 14668 "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 _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 14681 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2123 "parsing/parser.mly"
+      ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
+# 14690 "parsing/parser.ml"
+          
+        in
+        
+# 2115 "parsing/parser.mly"
+      ( x )
+# 14696 "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 = cty;
+          MenhirLib.EngineTypes.startp = _startpos_cty_;
+          MenhirLib.EngineTypes.endp = _endpos_cty_;
+          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 cty : (Parsetree.core_type) = Obj.magic cty in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 14731 "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 _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 14744 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2123 "parsing/parser.mly"
+      ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
+# 14753 "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
+        
+# 2117 "parsing/parser.mly"
+      ( let lab, pat = x in
+        lab,
+        mkpat ~loc:_sloc (Ppat_constraint (pat, cty)) )
+# 14765 "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 : (Longident.t) = 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) = 
+# 3497 "parsing/parser.mly"
+                                        ( _1 )
+# 14790 "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.expression) = 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.arg_label * Parsetree.expression) = 
+# 2400 "parsing/parser.mly"
+      ( (Nolabel, _1) )
+# 14815 "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 = _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 _2 : (Parsetree.expression) = Obj.magic _2 in
+        let _1 : (
+# 634 "parsing/parser.mly"
+       (string)
+# 14843 "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) = 
+# 2402 "parsing/parser.mly"
+      ( (Labelled _1, _2) )
+# 14851 "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 = label;
+          MenhirLib.EngineTypes.startp = _startpos_label_;
+          MenhirLib.EngineTypes.endp = _endpos_label_;
+          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 label : (
+# 647 "parsing/parser.mly"
+       (string)
+# 14878 "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
+        
+# 2404 "parsing/parser.mly"
+      ( let loc = _loc_label_ in
+        (Labelled label, mkexpvar ~loc label) )
+# 14889 "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 = label;
+          MenhirLib.EngineTypes.startp = _startpos_label_;
+          MenhirLib.EngineTypes.endp = _endpos_label_;
+          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 label : (
+# 647 "parsing/parser.mly"
+       (string)
+# 14916 "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
+        
+# 2407 "parsing/parser.mly"
+      ( let loc = _loc_label_ in
+        (Optional label, mkexpvar ~loc label) )
+# 14927 "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 = _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 _2 : (Parsetree.expression) = Obj.magic _2 in
+        let _1 : (
+# 664 "parsing/parser.mly"
+       (string)
+# 14955 "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) = 
+# 2410 "parsing/parser.mly"
+      ( (Optional _1, _2) )
+# 14963 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          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.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 _5 : unit = Obj.magic _5 in
+        let _1_inlined1 : (Parsetree.expression option) = Obj.magic _1_inlined1 in
+        let _3 : (string * Parsetree.pattern) = 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__5_ in
+        let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _4 =
+          let _1 = _1_inlined1 in
+          
+# 2111 "parsing/parser.mly"
+    ( _1 )
+# 15018 "parsing/parser.ml"
+          
+        in
+        
+# 2085 "parsing/parser.mly"
+      ( (Optional (fst _3), _4, snd _3) )
+# 15024 "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 = _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 _1_inlined1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 15051 "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 _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 15066 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2123 "parsing/parser.mly"
+      ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
+# 15075 "parsing/parser.ml"
+          
+        in
+        
+# 2087 "parsing/parser.mly"
+      ( (Optional (fst _2), None, snd _2) )
+# 15081 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          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.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 _5 : unit = Obj.magic _5 in
+        let _1_inlined1 : (Parsetree.expression option) = Obj.magic _1_inlined1 in
+        let _3 : (Parsetree.pattern) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (
+# 664 "parsing/parser.mly"
+       (string)
+# 15130 "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
+          
+# 2111 "parsing/parser.mly"
+    ( _1 )
+# 15140 "parsing/parser.ml"
+          
+        in
+        
+# 2089 "parsing/parser.mly"
+      ( (Optional _1, _4, _3) )
+# 15146 "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 = _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 _2 : (Parsetree.pattern) = Obj.magic _2 in
+        let _1 : (
+# 664 "parsing/parser.mly"
+       (string)
+# 15174 "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) = 
+# 2091 "parsing/parser.mly"
+      ( (Optional _1, None, _2) )
+# 15182 "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 : unit = Obj.magic _4 in
+        let _3 : (string * Parsetree.pattern) = 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 : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = 
+# 2093 "parsing/parser.mly"
+      ( (Labelled (fst _3), None, snd _3) )
+# 15228 "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 = _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 _1_inlined1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 15255 "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 _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 15270 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2123 "parsing/parser.mly"
+      ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
+# 15279 "parsing/parser.ml"
+          
+        in
+        
+# 2095 "parsing/parser.mly"
+      ( (Labelled (fst _2), None, snd _2) )
+# 15285 "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 = _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 _2 : (Parsetree.pattern) = Obj.magic _2 in
+        let _1 : (
+# 634 "parsing/parser.mly"
+       (string)
+# 15313 "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) = 
+# 2097 "parsing/parser.mly"
+      ( (Labelled _1, None, _2) )
+# 15321 "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.pattern) = 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.arg_label * Parsetree.expression option * Parsetree.pattern) = 
+# 2099 "parsing/parser.mly"
+      ( (Nolabel, None, _1) )
+# 15346 "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 = _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 _2 : (Parsetree.expression) = Obj.magic _2 in
+        let _1 : (Asttypes.label) = 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.pattern * Parsetree.expression) = let _1 =
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2417 "parsing/parser.mly"
+              ( mkpatvar ~loc:_sloc _1 )
+# 15382 "parsing/parser.ml"
+          
+        in
+        
+# 2421 "parsing/parser.mly"
+      ( (_1, _2) )
+# 15388 "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.expression) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (Parsetree.core_type option * Parsetree.core_type option) = Obj.magic _2 in
+        let _1 : (Asttypes.label) = 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.pattern * Parsetree.expression) = let _1 =
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2417 "parsing/parser.mly"
+              ( mkpatvar ~loc:_sloc _1 )
+# 15438 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__4_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2423 "parsing/parser.mly"
+      ( let v = _1 in (* PR#7344 *)
+        let t =
+          match _2 with
+            Some t, None -> t
+          | _, Some t -> t
+          | _ -> assert false
+        in
+        let loc = Location.(t.ptyp_loc.loc_start, t.ptyp_loc.loc_end) in
+        let typ = ghtyp ~loc (Ptyp_poly([],t)) in
+        let patloc = (_startpos__1_, _endpos__2_) in
+        (ghpat ~loc:patloc (Ppat_constraint(v, typ)),
+         mkexp_constraint ~loc:_sloc _4 _2) )
+# 15458 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                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 = xs;
+                  MenhirLib.EngineTypes.startp = _startpos_xs_;
+                  MenhirLib.EngineTypes.endp = _endpos_xs_;
+                  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 _7 : (Parsetree.expression) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _5 : (Parsetree.core_type) = Obj.magic _5 in
+        let _4 : unit = Obj.magic _4 in
+        let xs : (Asttypes.label Asttypes.loc list) = Obj.magic xs in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Asttypes.label) = 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 : (Parsetree.pattern * Parsetree.expression) = let _3 =
+          let _1 =
+            let xs = 
+# 253 ""
+    ( List.rev xs )
+# 15527 "parsing/parser.ml"
+             in
+            
+# 915 "parsing/parser.mly"
+    ( xs )
+# 15532 "parsing/parser.ml"
+            
+          in
+          
+# 3150 "parsing/parser.mly"
+    ( _1 )
+# 15538 "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
+          
+# 2417 "parsing/parser.mly"
+              ( mkpatvar ~loc:_sloc _1 )
+# 15549 "parsing/parser.ml"
+          
+        in
+        
+# 2439 "parsing/parser.mly"
+      ( let typloc = (_startpos__3_, _endpos__5_) in
+        let patloc = (_startpos__1_, _endpos__5_) in
+        (ghpat ~loc:patloc
+           (Ppat_constraint(_1, ghtyp ~loc:typloc (Ptyp_poly(_3,_5)))),
+         _7) )
+# 15559 "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 = _8;
+          MenhirLib.EngineTypes.startp = _startpos__8_;
+          MenhirLib.EngineTypes.endp = _endpos__8_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _7;
+            MenhirLib.EngineTypes.startp = _startpos__7_;
+            MenhirLib.EngineTypes.endp = _endpos__7_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _6;
+              MenhirLib.EngineTypes.startp = _startpos__6_;
+              MenhirLib.EngineTypes.endp = _endpos__6_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _5;
+                MenhirLib.EngineTypes.startp = _startpos__5_;
+                MenhirLib.EngineTypes.endp = _endpos__5_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = xs;
+                  MenhirLib.EngineTypes.startp = _startpos_xs_;
+                  MenhirLib.EngineTypes.endp = _endpos_xs_;
+                  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 _8 : (Parsetree.expression) = Obj.magic _8 in
+        let _7 : unit = Obj.magic _7 in
+        let _6 : (Parsetree.core_type) = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let xs : (string Asttypes.loc list) = Obj.magic xs in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Asttypes.label) = 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 : (Parsetree.pattern * Parsetree.expression) = let _4 = 
+# 2414 "parsing/parser.mly"
+    ( xs )
+# 15633 "parsing/parser.ml"
+         in
+        let _1 =
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2417 "parsing/parser.mly"
+              ( mkpatvar ~loc:_sloc _1 )
+# 15642 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__8_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2445 "parsing/parser.mly"
+      ( let exp, poly =
+          wrap_type_annotation ~loc:_sloc _4 _6 _8 in
+        let loc = (_startpos__1_, _endpos__6_) in
+        (ghpat ~loc (Ppat_constraint(_1, poly)), exp) )
+# 15654 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (Parsetree.expression) = 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 * Parsetree.expression) = 
+# 2450 "parsing/parser.mly"
+      ( (_1, _3) )
+# 15693 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : (Parsetree.expression) = Obj.magic _5 in
+        let _4 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.core_type) = 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__5_ in
+        let _v : (Parsetree.pattern * Parsetree.expression) = 
+# 2452 "parsing/parser.mly"
+      ( let loc = (_startpos__1_, _endpos__3_) in
+        (ghpat ~loc (Ppat_constraint(_1, _3)), _5) )
+# 15747 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = body;
+            MenhirLib.EngineTypes.startp = _startpos_body_;
+            MenhirLib.EngineTypes.endp = _endpos_body_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = rec_flag;
+              MenhirLib.EngineTypes.startp = _startpos_rec_flag_;
+              MenhirLib.EngineTypes.endp = _endpos_rec_flag_;
+              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.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = ext;
+                  MenhirLib.EngineTypes.startp = _startpos_ext_;
+                  MenhirLib.EngineTypes.endp = _endpos_ext_;
+                  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 _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in
+        let rec_flag : (Asttypes.rec_flag) = Obj.magic rec_flag in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext 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 : (let_bindings) = let _1 =
+          let attrs2 =
+            let _1 = _1_inlined2 in
+            
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 15810 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined2_ in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 15819 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2468 "parsing/parser.mly"
+    (
+      let attrs = attrs1 @ attrs2 in
+      mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs)
+    )
+# 15831 "parsing/parser.ml"
+          
+        in
+        
+# 2458 "parsing/parser.mly"
+                                                ( _1 )
+# 15837 "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 = _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 _2 : (let_binding) = Obj.magic _2 in
+        let _1 : (let_bindings) = 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 : (let_bindings) = 
+# 2459 "parsing/parser.mly"
+                                                ( addlb _1 _2 )
+# 15869 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = body;
+            MenhirLib.EngineTypes.startp = _startpos_body_;
+            MenhirLib.EngineTypes.endp = _endpos_body_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = rec_flag;
+              MenhirLib.EngineTypes.startp = _startpos_rec_flag_;
+              MenhirLib.EngineTypes.endp = _endpos_rec_flag_;
+              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.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 _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in
+        let rec_flag : (Asttypes.rec_flag) = Obj.magic rec_flag in
+        let _1_inlined1 : (Parsetree.attributes) = 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 : (let_bindings) = let _1 =
+          let attrs2 =
+            let _1 = _1_inlined2 in
+            
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 15925 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined2_ in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 15934 "parsing/parser.ml"
+            
+          in
+          let ext = 
+# 3738 "parsing/parser.mly"
+                    ( None )
+# 15940 "parsing/parser.ml"
+           in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2468 "parsing/parser.mly"
+    (
+      let attrs = attrs1 @ attrs2 in
+      mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs)
+    )
+# 15951 "parsing/parser.ml"
+          
+        in
+        
+# 2458 "parsing/parser.mly"
+                                                ( _1 )
+# 15957 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = body;
+            MenhirLib.EngineTypes.startp = _startpos_body_;
+            MenhirLib.EngineTypes.endp = _endpos_body_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = rec_flag;
+              MenhirLib.EngineTypes.startp = _startpos_rec_flag_;
+              MenhirLib.EngineTypes.endp = _endpos_rec_flag_;
+              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.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = _2;
+                  MenhirLib.EngineTypes.startp = _startpos__2_;
+                  MenhirLib.EngineTypes.endp = _endpos__2_;
+                  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.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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in
+        let rec_flag : (Asttypes.rec_flag) = Obj.magic rec_flag in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _2 : (string Asttypes.loc) = Obj.magic _2 in
+        let _1_inlined1 : unit = 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_inlined3_ in
+        let _v : (let_bindings) = let _1 =
+          let attrs2 =
+            let _1 = _1_inlined3 in
+            
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 16027 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined3_ in
+          let attrs1 =
+            let _1 = _1_inlined2 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 16036 "parsing/parser.ml"
+            
+          in
+          let ext =
+            let (_startpos__1_, _1) = (_startpos__1_inlined1_, _1_inlined1) in
+            let _endpos = _endpos__2_ in
+            let _startpos = _startpos__1_ in
+            let _loc = (_startpos, _endpos) in
+            
+# 3739 "parsing/parser.mly"
+                    ( not_expecting _loc "extension" )
+# 16047 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2468 "parsing/parser.mly"
+    (
+      let attrs = attrs1 @ attrs2 in
+      mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs)
+    )
+# 16059 "parsing/parser.ml"
+          
+        in
+        
+# 2458 "parsing/parser.mly"
+                                                ( _1 )
+# 16065 "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 = _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 _2 : (let_binding) = Obj.magic _2 in
+        let _1 : (let_bindings) = 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 : (let_bindings) = 
+# 2459 "parsing/parser.mly"
+                                                ( addlb _1 _2 )
+# 16097 "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.pattern) = 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) = 
+# 2127 "parsing/parser.mly"
+      ( _1 )
+# 16122 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              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 _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 _1 = 
+# 2129 "parsing/parser.mly"
+      ( Ppat_constraint(_1, _3) )
+# 16162 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 16171 "parsing/parser.ml"
+          
+        in
+        
+# 2130 "parsing/parser.mly"
+      ( _1 )
+# 16177 "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 = exp;
+          MenhirLib.EngineTypes.startp = _startpos_exp_;
+          MenhirLib.EngineTypes.endp = _endpos_exp_;
+          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 exp : (Parsetree.expression) = Obj.magic exp in
+        let _1 : (Asttypes.label) = Obj.magic _1 in
+        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
+          
+# 2417 "parsing/parser.mly"
+              ( mkpatvar ~loc:_sloc _1 )
+# 16213 "parsing/parser.ml"
+          
+        in
+        
+# 2485 "parsing/parser.mly"
+      ( (pat, exp) )
+# 16219 "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 = exp;
+          MenhirLib.EngineTypes.startp = _startpos_exp_;
+          MenhirLib.EngineTypes.endp = _endpos_exp_;
+          MenhirLib.EngineTypes.next = {
+            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 = typ;
+              MenhirLib.EngineTypes.startp = _startpos_typ_;
+              MenhirLib.EngineTypes.endp = _endpos_typ_;
+              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 = pat;
+                  MenhirLib.EngineTypes.startp = _startpos_pat_;
+                  MenhirLib.EngineTypes.endp = _endpos_pat_;
+                  MenhirLib.EngineTypes.next = _menhir_stack;
+                };
+              };
+            };
+          };
+        } = _menhir_stack in
+        let exp : (Parsetree.expression) = Obj.magic exp in
+        let _4 : unit = Obj.magic _4 in
+        let typ : (Parsetree.core_type) = Obj.magic typ in
+        let _2 : unit = Obj.magic _2 in
+        let pat : (Parsetree.pattern) = Obj.magic pat in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_pat_ in
+        let _endpos = _endpos_exp_ in
+        let _v : (Parsetree.pattern * Parsetree.expression) = 
+# 2487 "parsing/parser.mly"
+      ( let loc = (_startpos_pat_, _endpos_typ_) in
+        (ghpat ~loc (Ppat_constraint(pat, typ)), exp) )
+# 16273 "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 = exp;
+          MenhirLib.EngineTypes.startp = _startpos_exp_;
+          MenhirLib.EngineTypes.endp = _endpos_exp_;
+          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 = pat;
+              MenhirLib.EngineTypes.startp = _startpos_pat_;
+              MenhirLib.EngineTypes.endp = _endpos_pat_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let exp : (Parsetree.expression) = Obj.magic exp in
+        let _2 : unit = Obj.magic _2 in
+        let pat : (Parsetree.pattern) = Obj.magic pat in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_pat_ in
+        let _endpos = _endpos_exp_ in
+        let _v : (Parsetree.pattern * Parsetree.expression) = 
+# 2490 "parsing/parser.mly"
+      ( (pat, exp) )
+# 16312 "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 = body;
+          MenhirLib.EngineTypes.startp = _startpos_body_;
+          MenhirLib.EngineTypes.endp = _endpos_body_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_body_ in
+        let _endpos = _endpos_body_ in
+        let _v : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = 
+# 2494 "parsing/parser.mly"
+      ( let let_pat, let_exp = body in
+        let_pat, let_exp, [] )
+# 16338 "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 = body;
+          MenhirLib.EngineTypes.startp = _startpos_body_;
+          MenhirLib.EngineTypes.endp = _endpos_body_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = bindings;
+              MenhirLib.EngineTypes.startp = _startpos_bindings_;
+              MenhirLib.EngineTypes.endp = _endpos_bindings_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in
+        let _1 : (
+# 630 "parsing/parser.mly"
+       (string)
+# 16372 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 16385 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_body_ in
+        let _symbolstartpos = _startpos_bindings_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2497 "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 )
+# 16398 "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_declaration list) = 
+# 211 ""
+    ( [] )
+# 16416 "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 = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = body;
+              MenhirLib.EngineTypes.startp = _startpos_body_;
+              MenhirLib.EngineTypes.endp = _endpos_body_;
+              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.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = params;
+                  MenhirLib.EngineTypes.startp = _startpos_params_;
+                  MenhirLib.EngineTypes.endp = _endpos_params_;
+                  MenhirLib.EngineTypes.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = virt;
+                    MenhirLib.EngineTypes.startp = _startpos_virt_;
+                    MenhirLib.EngineTypes.endp = _endpos_virt_;
+                    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.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_declaration list) = Obj.magic xs in
+        let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let body : (Parsetree.class_expr) = Obj.magic body in
+        let _1_inlined2 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 16482 "parsing/parser.ml"
+        ) = Obj.magic _1_inlined2 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let virt : (Asttypes.virtual_flag) = Obj.magic virt in
+        let _1_inlined1 : (Parsetree.attributes) = 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_xs_ in
+        let _v : (Parsetree.class_declaration list) = let x =
+          let attrs2 =
+            let _1 = _1_inlined3 in
+            
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 16497 "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
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 16509 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 16517 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 1731 "parsing/parser.mly"
+  (
+    let attrs = attrs1 @ attrs2 in
+    let loc = make_loc _sloc in
+    let docs = symbol_docs _sloc in
+    let text = symbol_text _symbolstartpos in
+    Ci.mk id body ~virt ~params ~attrs ~loc ~text ~docs
+  )
+# 16532 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 16538 "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_description list) = 
+# 211 ""
+    ( [] )
+# 16556 "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 = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = cty;
+              MenhirLib.EngineTypes.startp = _startpos_cty_;
+              MenhirLib.EngineTypes.endp = _endpos_cty_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _6;
+                MenhirLib.EngineTypes.startp = _startpos__6_;
+                MenhirLib.EngineTypes.endp = _endpos__6_;
+                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.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = params;
+                    MenhirLib.EngineTypes.startp = _startpos_params_;
+                    MenhirLib.EngineTypes.endp = _endpos_params_;
+                    MenhirLib.EngineTypes.next = {
+                      MenhirLib.EngineTypes.state = _;
+                      MenhirLib.EngineTypes.semv = virt;
+                      MenhirLib.EngineTypes.startp = _startpos_virt_;
+                      MenhirLib.EngineTypes.endp = _endpos_virt_;
+                      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.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_description list) = Obj.magic xs in
+        let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let cty : (Parsetree.class_type) = Obj.magic cty in
+        let _6 : unit = Obj.magic _6 in
+        let _1_inlined2 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 16629 "parsing/parser.ml"
+        ) = Obj.magic _1_inlined2 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let virt : (Asttypes.virtual_flag) = Obj.magic virt in
+        let _1_inlined1 : (Parsetree.attributes) = 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_xs_ in
+        let _v : (Parsetree.class_description list) = let x =
+          let attrs2 =
+            let _1 = _1_inlined3 in
+            
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 16644 "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
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 16656 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 16664 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2022 "parsing/parser.mly"
+    (
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc _sloc in
+      let docs = symbol_docs _sloc in
+      let text = symbol_text _symbolstartpos in
+      Ci.mk id cty ~virt ~params ~attrs ~loc ~text ~docs
+    )
+# 16679 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 16685 "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_declaration list) = 
+# 211 ""
+    ( [] )
+# 16703 "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 = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = csig;
+              MenhirLib.EngineTypes.startp = _startpos_csig_;
+              MenhirLib.EngineTypes.endp = _endpos_csig_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _6;
+                MenhirLib.EngineTypes.startp = _startpos__6_;
+                MenhirLib.EngineTypes.endp = _endpos__6_;
+                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.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = params;
+                    MenhirLib.EngineTypes.startp = _startpos_params_;
+                    MenhirLib.EngineTypes.endp = _endpos_params_;
+                    MenhirLib.EngineTypes.next = {
+                      MenhirLib.EngineTypes.state = _;
+                      MenhirLib.EngineTypes.semv = virt;
+                      MenhirLib.EngineTypes.startp = _startpos_virt_;
+                      MenhirLib.EngineTypes.endp = _endpos_virt_;
+                      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.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_declaration list) = Obj.magic xs in
+        let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let csig : (Parsetree.class_type) = Obj.magic csig in
+        let _6 : unit = Obj.magic _6 in
+        let _1_inlined2 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 16776 "parsing/parser.ml"
+        ) = Obj.magic _1_inlined2 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let virt : (Asttypes.virtual_flag) = Obj.magic virt in
+        let _1_inlined1 : (Parsetree.attributes) = 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_xs_ in
+        let _v : (Parsetree.class_type_declaration list) = let x =
+          let attrs2 =
+            let _1 = _1_inlined3 in
+            
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 16791 "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
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 16803 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 16811 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2061 "parsing/parser.mly"
+    (
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc _sloc in
+      let docs = symbol_docs _sloc in
+      let text = symbol_text _symbolstartpos in
+      Ci.mk id csig ~virt ~params ~attrs ~loc ~text ~docs
+    )
+# 16826 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 16832 "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.module_binding list) = 
+# 211 ""
+    ( [] )
+# 16850 "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 = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = body;
+              MenhirLib.EngineTypes.startp = _startpos_body_;
+              MenhirLib.EngineTypes.endp = _endpos_body_;
+              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.next = {
+                  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 xs : (Parsetree.module_binding list) = Obj.magic xs in
+        let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let body : (Parsetree.module_expr) = Obj.magic body in
+        let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (Parsetree.attributes) = 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_xs_ in
+        let _v : (Parsetree.module_binding list) = let x =
+          let attrs2 =
+            let _1 = _1_inlined3 in
+            
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 16913 "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
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 16925 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 16933 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 1413 "parsing/parser.mly"
+  (
+    let loc = make_loc _sloc in
+    let attrs = attrs1 @ attrs2 in
+    let docs = symbol_docs _sloc in
+    let text = symbol_text _symbolstartpos in
+    Mb.mk name body ~attrs ~loc ~text ~docs
+  )
+# 16948 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 16954 "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.module_declaration list) = 
+# 211 ""
+    ( [] )
+# 16972 "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 = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              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 = _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.next = {
+                    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 xs : (Parsetree.module_declaration list) = Obj.magic xs in
+        let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let mty : (Parsetree.module_type) = Obj.magic mty in
+        let _4 : unit = Obj.magic _4 in
+        let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (Parsetree.attributes) = 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_xs_ in
+        let _v : (Parsetree.module_declaration list) = let x =
+          let attrs2 =
+            let _1 = _1_inlined3 in
+            
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 17042 "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
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 17054 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 17062 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 1689 "parsing/parser.mly"
+  (
+    let attrs = attrs1 @ attrs2 in
+    let docs = symbol_docs _sloc in
+    let loc = make_loc _sloc in
+    let text = symbol_text _symbolstartpos in
+    Md.mk name mty ~attrs ~loc ~text ~docs
+  )
+# 17077 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 17083 "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.attributes) = 
+# 211 ""
+    ( [] )
+# 17101 "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 = x;
+            MenhirLib.EngineTypes.startp = _startpos_x_;
+            MenhirLib.EngineTypes.endp = _endpos_x_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let xs : (Parsetree.attributes) = Obj.magic xs in
+        let x : (Parsetree.attribute) = Obj.magic x in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_x_ in
+        let _endpos = _endpos_xs_ in
+        let _v : (Parsetree.attributes) = 
+# 213 ""
+    ( x :: xs )
+# 17133 "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.type_declaration list) = 
+# 211 ""
+    ( [] )
+# 17151 "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 = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = xs_inlined1;
+              MenhirLib.EngineTypes.startp = _startpos_xs_inlined1_;
+              MenhirLib.EngineTypes.endp = _endpos_xs_inlined1_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = kind_priv_manifest;
+                MenhirLib.EngineTypes.startp = _startpos_kind_priv_manifest_;
+                MenhirLib.EngineTypes.endp = _endpos_kind_priv_manifest_;
+                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.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = params;
+                    MenhirLib.EngineTypes.startp = _startpos_params_;
+                    MenhirLib.EngineTypes.endp = _endpos_params_;
+                    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.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.type_declaration list) = Obj.magic xs in
+        let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        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 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 17218 "parsing/parser.ml"
+        ) = Obj.magic _1_inlined2 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let _1_inlined1 : (Parsetree.attributes) = 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_xs_ in
+        let _v : (Parsetree.type_declaration list) = let x =
+          let xs = xs_inlined1 in
+          let attrs2 =
+            let _1 = _1_inlined3 in
+            
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 17233 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined3_ in
+          let cstrs =
+            let _1 =
+              let xs = 
+# 253 ""
+    ( List.rev xs )
+# 17242 "parsing/parser.ml"
+               in
+              
+# 897 "parsing/parser.mly"
+    ( xs )
+# 17247 "parsing/parser.ml"
+              
+            in
+            
+# 2887 "parsing/parser.mly"
+    ( _1 )
+# 17253 "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
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 17264 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 17272 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2876 "parsing/parser.mly"
+    (
+      let (kind, priv, manifest) = kind_priv_manifest in
+      let docs = symbol_docs _sloc in
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc _sloc in
+      let text = symbol_text _symbolstartpos in
+      Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text
+    )
+# 17288 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 17294 "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.type_declaration list) = 
+# 211 ""
+    ( [] )
+# 17312 "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 = _;
+            MenhirLib.EngineTypes.semv = _1_inlined4;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined4_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined4_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = xs_inlined1;
+              MenhirLib.EngineTypes.startp = _startpos_xs_inlined1_;
+              MenhirLib.EngineTypes.endp = _endpos_xs_inlined1_;
+              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 = _;
+                  MenhirLib.EngineTypes.semv = _1_inlined3;
+                  MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+                  MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+                  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.next = {
+                      MenhirLib.EngineTypes.state = _;
+                      MenhirLib.EngineTypes.semv = params;
+                      MenhirLib.EngineTypes.startp = _startpos_params_;
+                      MenhirLib.EngineTypes.endp = _endpos_params_;
+                      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.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.type_declaration list) = Obj.magic xs in
+        let _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
+        let xs_inlined1 : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs_inlined1 in
+        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 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 17386 "parsing/parser.ml"
+        ) = Obj.magic _1_inlined2 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let _1_inlined1 : (Parsetree.attributes) = 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_xs_ in
+        let _v : (Parsetree.type_declaration list) = let x =
+          let xs = xs_inlined1 in
+          let attrs2 =
+            let _1 = _1_inlined4 in
+            
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 17401 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined4_ in
+          let cstrs =
+            let _1 =
+              let xs = 
+# 253 ""
+    ( List.rev xs )
+# 17410 "parsing/parser.ml"
+               in
+              
+# 897 "parsing/parser.mly"
+    ( xs )
+# 17415 "parsing/parser.ml"
+              
+            in
+            
+# 2887 "parsing/parser.mly"
+    ( _1 )
+# 17421 "parsing/parser.ml"
+            
+          in
+          let kind_priv_manifest =
+            let _1 = _1_inlined3 in
+            
+# 2922 "parsing/parser.mly"
+      ( _2 )
+# 17429 "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
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 17440 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 17448 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2876 "parsing/parser.mly"
+    (
+      let (kind, priv, manifest) = kind_priv_manifest in
+      let docs = symbol_docs _sloc in
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc _sloc in
+      let text = symbol_text _symbolstartpos in
+      Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text
+    )
+# 17464 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 17470 "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.attributes) = 
+# 211 ""
+    ( [] )
+# 17488 "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 = x;
+            MenhirLib.EngineTypes.startp = _startpos_x_;
+            MenhirLib.EngineTypes.endp = _endpos_x_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let xs : (Parsetree.attributes) = Obj.magic xs in
+        let x : (Parsetree.attribute) = Obj.magic x in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_x_ in
+        let _endpos = _endpos_xs_ in
+        let _v : (Parsetree.attributes) = 
+# 213 ""
+    ( x :: xs )
+# 17520 "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.signature_item list list) = 
+# 211 ""
+    ( [] )
+# 17538 "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.signature_item list list) = Obj.magic xs 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_xs_ in
+        let _v : (Parsetree.signature_item list list) = let x =
+          let _1 =
+            let _startpos = _startpos__1_ in
+            
+# 823 "parsing/parser.mly"
+  ( text_sig _startpos )
+# 17573 "parsing/parser.ml"
+            
+          in
+          
+# 1551 "parsing/parser.mly"
+      ( _1 )
+# 17579 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 17585 "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.signature_item list list) = Obj.magic xs in
+        let _1 : (Parsetree.signature_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 : (Parsetree.signature_item list list) = let x =
+          let _1 =
+            let _startpos = _startpos__1_ in
+            
+# 821 "parsing/parser.mly"
+  ( text_sig _startpos @ [_1] )
+# 17620 "parsing/parser.ml"
+            
+          in
+          
+# 1551 "parsing/parser.mly"
+      ( _1 )
+# 17626 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 17632 "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.structure_item list list) = 
+# 211 ""
+    ( [] )
+# 17650 "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.structure_item list list) = Obj.magic xs 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_xs_ in
+        let _v : (Parsetree.structure_item list list) = let x =
+          let _1 =
+            let ys =
+              let items = 
+# 883 "parsing/parser.mly"
+    ( [] )
+# 17685 "parsing/parser.ml"
+               in
+              
+# 1297 "parsing/parser.mly"
+    ( items )
+# 17690 "parsing/parser.ml"
+              
+            in
+            let xs =
+              let _startpos = _startpos__1_ in
+              
+# 819 "parsing/parser.mly"
+  ( text_str _startpos )
+# 17698 "parsing/parser.ml"
+              
+            in
+            
+# 267 ""
+    ( xs @ ys )
+# 17704 "parsing/parser.ml"
+            
+          in
+          
+# 1313 "parsing/parser.mly"
+      ( _1 )
+# 17710 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 17716 "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 = _;
+            MenhirLib.EngineTypes.semv = _1_inlined1;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+            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 xs : (Parsetree.structure_item list list) = Obj.magic xs in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 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_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 _1 =
+                      let attrs = 
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 17770 "parsing/parser.ml"
+                       in
+                      
+# 1304 "parsing/parser.mly"
+    ( mkstrexp e attrs )
+# 17775 "parsing/parser.ml"
+                      
+                    in
+                    let _startpos__1_ = _startpos_e_ in
+                    let _startpos = _startpos__1_ in
+                    
+# 817 "parsing/parser.mly"
+  ( text_str _startpos @ [_1] )
+# 17783 "parsing/parser.ml"
+                    
+                  in
+                  let _startpos__1_ = _startpos_e_ in
+                  let _endpos = _endpos__1_ in
+                  let _startpos = _startpos__1_ in
+                  
+# 836 "parsing/parser.mly"
+  ( mark_rhs_docs _startpos _endpos;
+    _1 )
+# 17793 "parsing/parser.ml"
+                  
+                in
+                
+# 885 "parsing/parser.mly"
+    ( x )
+# 17799 "parsing/parser.ml"
+                
+              in
+              
+# 1297 "parsing/parser.mly"
+    ( items )
+# 17805 "parsing/parser.ml"
+              
+            in
+            let xs =
+              let _startpos = _startpos__1_ in
+              
+# 819 "parsing/parser.mly"
+  ( text_str _startpos )
+# 17813 "parsing/parser.ml"
+              
+            in
+            
+# 267 ""
+    ( xs @ ys )
+# 17819 "parsing/parser.ml"
+            
+          in
+          
+# 1313 "parsing/parser.mly"
+      ( _1 )
+# 17825 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 17831 "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.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 : (Parsetree.structure_item list list) = let x =
+          let _1 =
+            let _startpos = _startpos__1_ in
+            
+# 817 "parsing/parser.mly"
+  ( text_str _startpos @ [_1] )
+# 17866 "parsing/parser.ml"
+            
+          in
+          
+# 1313 "parsing/parser.mly"
+      ( _1 )
+# 17872 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 17878 "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 ""
+    ( [] )
+# 17896 "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
+          
+# 831 "parsing/parser.mly"
+  ( text_csig _startpos @ [_1] )
+# 17930 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 17936 "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_field list list) = 
+# 211 ""
+    ( [] )
+# 17954 "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_field list list) = Obj.magic xs in
+        let _1 : (Parsetree.class_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_field list list) = let x =
+          let _startpos = _startpos__1_ in
+          
+# 829 "parsing/parser.mly"
+  ( text_cstr _startpos @ [_1] )
+# 17988 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 17994 "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.structure_item list list) = 
+# 211 ""
+    ( [] )
+# 18012 "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.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 : (Parsetree.structure_item list list) = let x =
+          let _startpos = _startpos__1_ in
+          
+# 817 "parsing/parser.mly"
+  ( text_str _startpos @ [_1] )
+# 18046 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 18052 "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.toplevel_phrase list list) = 
+# 211 ""
+    ( [] )
+# 18070 "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.toplevel_phrase list list) = Obj.magic xs 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_xs_ in
+        let _v : (Parsetree.toplevel_phrase list list) = let x =
+          let _1 =
+            let x =
+              let _1 = 
+# 883 "parsing/parser.mly"
+    ( [] )
+# 18105 "parsing/parser.ml"
+               in
+              
+# 1113 "parsing/parser.mly"
+    ( _1 )
+# 18110 "parsing/parser.ml"
+              
+            in
+            
+# 183 ""
+    ( x )
+# 18116 "parsing/parser.ml"
+            
+          in
+          
+# 1125 "parsing/parser.mly"
+      ( _1 )
+# 18122 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 18128 "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 = _;
+            MenhirLib.EngineTypes.semv = _1_inlined1;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+            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 xs : (Parsetree.toplevel_phrase list list) = Obj.magic xs in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 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_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 _1 =
+                      let attrs = 
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 18182 "parsing/parser.ml"
+                       in
+                      
+# 1304 "parsing/parser.mly"
+    ( mkstrexp e attrs )
+# 18187 "parsing/parser.ml"
+                      
+                    in
+                    
+# 827 "parsing/parser.mly"
+  ( Ptop_def [_1] )
+# 18193 "parsing/parser.ml"
+                    
+                  in
+                  let _startpos__1_ = _startpos_e_ in
+                  let _startpos = _startpos__1_ in
+                  
+# 825 "parsing/parser.mly"
+  ( text_def _startpos @ [_1] )
+# 18201 "parsing/parser.ml"
+                  
+                in
+                
+# 885 "parsing/parser.mly"
+    ( x )
+# 18207 "parsing/parser.ml"
+                
+              in
+              
+# 1113 "parsing/parser.mly"
+    ( _1 )
+# 18213 "parsing/parser.ml"
+              
+            in
+            
+# 183 ""
+    ( x )
+# 18219 "parsing/parser.ml"
+            
+          in
+          
+# 1125 "parsing/parser.mly"
+      ( _1 )
+# 18225 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 18231 "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.toplevel_phrase 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 : (Parsetree.toplevel_phrase list list) = let x =
+          let _1 =
+            let _1 = 
+# 827 "parsing/parser.mly"
+  ( Ptop_def [_1] )
+# 18265 "parsing/parser.ml"
+             in
+            let _startpos = _startpos__1_ in
+            
+# 825 "parsing/parser.mly"
+  ( text_def _startpos @ [_1] )
+# 18271 "parsing/parser.ml"
+            
+          in
+          
+# 1125 "parsing/parser.mly"
+      ( _1 )
+# 18277 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 18283 "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.toplevel_phrase list list) = Obj.magic xs in
+        let _1 : (Parsetree.toplevel_phrase) = 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.toplevel_phrase list list) = let x =
+          let _1 =
+            let _1 =
+              let _endpos = _endpos__1_ in
+              let _startpos = _startpos__1_ in
+              
+# 836 "parsing/parser.mly"
+  ( mark_rhs_docs _startpos _endpos;
+    _1 )
+# 18321 "parsing/parser.ml"
+              
+            in
+            let _startpos = _startpos__1_ in
+            
+# 825 "parsing/parser.mly"
+  ( text_def _startpos @ [_1] )
+# 18328 "parsing/parser.ml"
+            
+          in
+          
+# 1125 "parsing/parser.mly"
+      ( _1 )
+# 18334 "parsing/parser.ml"
+          
+        in
+        
+# 213 ""
+    ( x :: xs )
+# 18340 "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 = opat;
+          MenhirLib.EngineTypes.startp = _startpos_opat_;
+          MenhirLib.EngineTypes.endp = _endpos_opat_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = octy;
+            MenhirLib.EngineTypes.startp = _startpos_octy_;
+            MenhirLib.EngineTypes.endp = _endpos_octy_;
+            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 opat : (Parsetree.pattern option) = Obj.magic opat in
+        let octy : (Parsetree.core_type option) = Obj.magic octy in
+        let _1 : (Longident.t) = Obj.magic _1 in
+        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 ""
+    ( None )
+# 18379 "parsing/parser.ml"
+         in
+        let x =
+          let label =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 18389 "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
+          
+# 2765 "parsing/parser.mly"
+    ( let pat =
+        match opat with
+        | None ->
+            (* No pattern; this is a pun. Desugar it. *)
+            pat_of_label ~loc:_sloc label
+        | Some pat ->
+            pat
+      in
+      label, mkpat_opt_constraint ~loc:_sloc pat octy
+    )
+# 18408 "parsing/parser.ml"
+          
+        in
+        
+# 1052 "parsing/parser.mly"
+    ( [x], None )
+# 18414 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = opat;
+            MenhirLib.EngineTypes.startp = _startpos_opat_;
+            MenhirLib.EngineTypes.endp = _endpos_opat_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = octy;
+              MenhirLib.EngineTypes.startp = _startpos_octy_;
+              MenhirLib.EngineTypes.endp = _endpos_octy_;
+              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 x : unit = Obj.magic x in
+        let opat : (Parsetree.pattern option) = Obj.magic opat in
+        let octy : (Parsetree.core_type option) = Obj.magic octy in
+        let _1 : (Longident.t) = 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 : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let _2 = 
+# 126 ""
+    ( Some x )
+# 18460 "parsing/parser.ml"
+         in
+        let x =
+          let label =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 18470 "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
+          
+# 2765 "parsing/parser.mly"
+    ( let pat =
+        match opat with
+        | None ->
+            (* No pattern; this is a pun. Desugar it. *)
+            pat_of_label ~loc:_sloc label
+        | Some pat ->
+            pat
+      in
+      label, mkpat_opt_constraint ~loc:_sloc pat octy
+    )
+# 18489 "parsing/parser.ml"
+          
+        in
+        
+# 1052 "parsing/parser.mly"
+    ( [x], None )
+# 18495 "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 = y;
+            MenhirLib.EngineTypes.startp = _startpos_y_;
+            MenhirLib.EngineTypes.endp = _endpos_y_;
+            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 = _;
+                MenhirLib.EngineTypes.semv = opat;
+                MenhirLib.EngineTypes.startp = _startpos_opat_;
+                MenhirLib.EngineTypes.endp = _endpos_opat_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = octy;
+                  MenhirLib.EngineTypes.startp = _startpos_octy_;
+                  MenhirLib.EngineTypes.endp = _endpos_octy_;
+                  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 : (unit option) = Obj.magic _4 in
+        let y : unit = Obj.magic y in
+        let _2 : unit = Obj.magic _2 in
+        let opat : (Parsetree.pattern option) = Obj.magic opat in
+        let octy : (Parsetree.core_type option) = Obj.magic octy in
+        let _1 : (Longident.t) = 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 : ((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
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 18560 "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
+          
+# 2765 "parsing/parser.mly"
+    ( let pat =
+        match opat with
+        | None ->
+            (* No pattern; this is a pun. Desugar it. *)
+            pat_of_label ~loc:_sloc label
+        | Some pat ->
+            pat
+      in
+      label, mkpat_opt_constraint ~loc:_sloc pat octy
+    )
+# 18579 "parsing/parser.ml"
+          
+        in
+        
+# 1054 "parsing/parser.mly"
+    ( [x], Some y )
+# 18585 "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 = tail;
+          MenhirLib.EngineTypes.startp = _startpos_tail_;
+          MenhirLib.EngineTypes.endp = _endpos_tail_;
+          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 = _;
+              MenhirLib.EngineTypes.semv = opat;
+              MenhirLib.EngineTypes.startp = _startpos_opat_;
+              MenhirLib.EngineTypes.endp = _endpos_opat_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = octy;
+                MenhirLib.EngineTypes.startp = _startpos_octy_;
+                MenhirLib.EngineTypes.endp = _endpos_octy_;
+                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 tail : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = Obj.magic tail in
+        let _2 : unit = Obj.magic _2 in
+        let opat : (Parsetree.pattern option) = Obj.magic opat in
+        let octy : (Parsetree.core_type option) = Obj.magic octy in
+        let _1 : (Longident.t) = 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 : ((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
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 18643 "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
+          
+# 2765 "parsing/parser.mly"
+    ( let pat =
+        match opat with
+        | None ->
+            (* No pattern; this is a pun. Desugar it. *)
+            pat_of_label ~loc:_sloc label
+        | Some pat ->
+            pat
+      in
+      label, mkpat_opt_constraint ~loc:_sloc pat octy
+    )
+# 18662 "parsing/parser.ml"
+          
+        in
+        
+# 1058 "parsing/parser.mly"
+    ( let xs, y = tail in
+      x :: xs, y )
+# 18669 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (Parsetree.expression) = 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.case) = 
+# 2523 "parsing/parser.mly"
+      ( Exp.case _1 _3 )
+# 18708 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : (Parsetree.expression) = Obj.magic _5 in
+        let _4 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.expression) = 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__5_ in
+        let _v : (Parsetree.case) = 
+# 2525 "parsing/parser.mly"
+      ( Exp.case _1 ~guard:_3 _5 )
+# 18761 "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 = _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 _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
+        
+# 2527 "parsing/parser.mly"
+      ( Exp.case _1 (Exp.unreachable ~loc:(make_loc _loc__3_) ()) )
+# 18801 "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 = tail;
+          MenhirLib.EngineTypes.startp = _startpos_tail_;
+          MenhirLib.EngineTypes.endp = _endpos_tail_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              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.next = {
+                  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 = _;
+                    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 tail : (Parsetree.object_field list * Asttypes.closed_flag) = Obj.magic tail in
+        let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 18864 "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
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 18875 "parsing/parser.ml"
+            
+          in
+          let _endpos__6_ = _endpos__1_inlined3_ in
+          let _4 =
+            let _1 = _1_inlined2 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 18884 "parsing/parser.ml"
+            
+          in
+          let _endpos__4_ = _endpos__1_inlined2_ in
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 3168 "parsing/parser.mly"
+    ( _1 )
+# 18893 "parsing/parser.ml"
+            
+          in
+          let _1 =
+            let _1 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 18900 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 18908 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__6_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 3378 "parsing/parser.mly"
+    ( let info =
+        match rhs_info _endpos__4_ with
+        | Some _ as info_before_semi -> info_before_semi
+        | None -> symbol_info _endpos
+      in
+      let attrs = add_info_attrs info (_4 @ _6) in
+      Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
+# 18923 "parsing/parser.ml"
+          
+        in
+        
+# 3359 "parsing/parser.mly"
+      ( let (f, c) = tail in (head :: f, c) )
+# 18929 "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 = tail;
+          MenhirLib.EngineTypes.startp = _startpos_tail_;
+          MenhirLib.EngineTypes.endp = _endpos_tail_;
+          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 = ty;
+              MenhirLib.EngineTypes.startp = _startpos_ty_;
+              MenhirLib.EngineTypes.endp = _endpos_ty_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let tail : (Parsetree.object_field list * Asttypes.closed_flag) = Obj.magic tail in
+        let _2 : unit = Obj.magic _2 in
+        let ty : (Parsetree.core_type) = Obj.magic ty in
+        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
+          
+# 3389 "parsing/parser.mly"
+    ( Of.inherit_ ~loc:(make_loc _sloc) ty )
+# 18972 "parsing/parser.ml"
+          
+        in
+        
+# 3359 "parsing/parser.mly"
+      ( let (f, c) = tail in (head :: f, c) )
+# 18978 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _5;
+            MenhirLib.EngineTypes.startp = _startpos__5_;
+            MenhirLib.EngineTypes.endp = _endpos__5_;
+            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.next = {
+                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 = _;
+                  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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 19034 "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
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 19045 "parsing/parser.ml"
+            
+          in
+          let _endpos__6_ = _endpos__1_inlined3_ in
+          let _4 =
+            let _1 = _1_inlined2 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 19054 "parsing/parser.ml"
+            
+          in
+          let _endpos__4_ = _endpos__1_inlined2_ in
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 3168 "parsing/parser.mly"
+    ( _1 )
+# 19063 "parsing/parser.ml"
+            
+          in
+          let _1 =
+            let _1 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 19070 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 19078 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__6_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 3378 "parsing/parser.mly"
+    ( let info =
+        match rhs_info _endpos__4_ with
+        | Some _ as info_before_semi -> info_before_semi
+        | None -> symbol_info _endpos
+      in
+      let attrs = add_info_attrs info (_4 @ _6) in
+      Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
+# 19093 "parsing/parser.ml"
+          
+        in
+        
+# 3362 "parsing/parser.mly"
+      ( [head], Closed )
+# 19099 "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 = _2;
+          MenhirLib.EngineTypes.startp = _startpos__2_;
+          MenhirLib.EngineTypes.endp = _endpos__2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = ty;
+            MenhirLib.EngineTypes.startp = _startpos_ty_;
+            MenhirLib.EngineTypes.endp = _endpos_ty_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let _2 : unit = Obj.magic _2 in
+        let ty : (Parsetree.core_type) = Obj.magic ty in
+        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
+          
+# 3389 "parsing/parser.mly"
+    ( Of.inherit_ ~loc:(make_loc _sloc) ty )
+# 19135 "parsing/parser.ml"
+          
+        in
+        
+# 3362 "parsing/parser.mly"
+      ( [head], Closed )
+# 19141 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          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.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 _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 19183 "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
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 19194 "parsing/parser.ml"
+            
+          in
+          let _endpos__4_ = _endpos__1_inlined2_ in
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 3168 "parsing/parser.mly"
+    ( _1 )
+# 19203 "parsing/parser.ml"
+            
+          in
+          let _1 =
+            let _1 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 19210 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 19218 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 3371 "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 )
+# 19229 "parsing/parser.ml"
+          
+        in
+        
+# 3365 "parsing/parser.mly"
+      ( [head], Closed )
+# 19235 "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 = ty;
+          MenhirLib.EngineTypes.startp = _startpos_ty_;
+          MenhirLib.EngineTypes.endp = _endpos_ty_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let ty : (Parsetree.core_type) = Obj.magic ty in
+        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
+          
+# 3389 "parsing/parser.mly"
+    ( Of.inherit_ ~loc:(make_loc _sloc) ty )
+# 19264 "parsing/parser.ml"
+          
+        in
+        
+# 3365 "parsing/parser.mly"
+      ( [head], Closed )
+# 19270 "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 : unit = 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.object_field list * Asttypes.closed_flag) = 
+# 3367 "parsing/parser.mly"
+      ( [], Open )
+# 19295 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _5;
+            MenhirLib.EngineTypes.startp = _startpos__5_;
+            MenhirLib.EngineTypes.endp = _endpos__5_;
+            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.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = private_;
+                MenhirLib.EngineTypes.startp = _startpos_private__;
+                MenhirLib.EngineTypes.endp = _endpos_private__;
+                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 _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 19342 "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
+          
+# 3164 "parsing/parser.mly"
+    ( _1 )
+# 19356 "parsing/parser.ml"
+          
+        in
+        let label =
+          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+          let _1 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 19364 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 19372 "parsing/parser.ml"
+          
+        in
+        let attrs = 
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 19378 "parsing/parser.ml"
+         in
+        let _1 = 
+# 3630 "parsing/parser.mly"
+                                                ( Fresh )
+# 19383 "parsing/parser.ml"
+         in
+        
+# 1869 "parsing/parser.mly"
+      ( (label, private_, Cfk_virtual ty), attrs )
+# 19388 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          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.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _3;
+              MenhirLib.EngineTypes.startp = _startpos__3_;
+              MenhirLib.EngineTypes.endp = _endpos__3_;
+              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 _5 : (Parsetree.expression) = Obj.magic _5 in
+        let _1_inlined1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 19428 "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 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 19442 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 19450 "parsing/parser.ml"
+          
+        in
+        let _2 = 
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 19456 "parsing/parser.ml"
+         in
+        let _1 = 
+# 3633 "parsing/parser.mly"
+                                                ( Fresh )
+# 19461 "parsing/parser.ml"
+         in
+        
+# 1871 "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 )
+# 19469 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          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.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 = _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 _5 : (Parsetree.expression) = Obj.magic _5 in
+        let _1_inlined2 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 19515 "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
+        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.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 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 19530 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 19538 "parsing/parser.ml"
+          
+        in
+        let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 19546 "parsing/parser.ml"
+          
+        in
+        let _1 = 
+# 3634 "parsing/parser.mly"
+                                                ( Override )
+# 19552 "parsing/parser.ml"
+         in
+        
+# 1871 "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 )
+# 19560 "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 = _8;
+          MenhirLib.EngineTypes.startp = _startpos__8_;
+          MenhirLib.EngineTypes.endp = _endpos__8_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _7;
+            MenhirLib.EngineTypes.startp = _startpos__7_;
+            MenhirLib.EngineTypes.endp = _endpos__7_;
+            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.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _5;
+                MenhirLib.EngineTypes.startp = _startpos__5_;
+                MenhirLib.EngineTypes.endp = _endpos__5_;
+                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.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = _3;
+                    MenhirLib.EngineTypes.startp = _startpos__3_;
+                    MenhirLib.EngineTypes.endp = _endpos__3_;
+                    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 _8 : (Parsetree.expression) = Obj.magic _8 in
+        let _7 : unit = Obj.magic _7 in
+        let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 19621 "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
+          
+# 3164 "parsing/parser.mly"
+    ( _1 )
+# 19635 "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 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 19644 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 19652 "parsing/parser.ml"
+          
+        in
+        let _2 = 
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 19658 "parsing/parser.ml"
+         in
+        let _1 = 
+# 3633 "parsing/parser.mly"
+                                                ( Fresh )
+# 19663 "parsing/parser.ml"
+         in
+        
+# 1877 "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 )
+# 19671 "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 = _8;
+          MenhirLib.EngineTypes.startp = _startpos__8_;
+          MenhirLib.EngineTypes.endp = _endpos__8_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _7;
+            MenhirLib.EngineTypes.startp = _startpos__7_;
+            MenhirLib.EngineTypes.endp = _endpos__7_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _1_inlined3;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _5;
+                MenhirLib.EngineTypes.startp = _startpos__5_;
+                MenhirLib.EngineTypes.endp = _endpos__5_;
+                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.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 = _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 _8 : (Parsetree.expression) = Obj.magic _8 in
+        let _7 : unit = Obj.magic _7 in
+        let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined2 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 19738 "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
+        let _1 : unit = 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_inlined3 in
+          
+# 3164 "parsing/parser.mly"
+    ( _1 )
+# 19753 "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 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 19762 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 19770 "parsing/parser.ml"
+          
+        in
+        let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 19778 "parsing/parser.ml"
+          
+        in
+        let _1 = 
+# 3634 "parsing/parser.mly"
+                                                ( Override )
+# 19784 "parsing/parser.ml"
+         in
+        
+# 1877 "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 )
+# 19792 "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 = _11;
+          MenhirLib.EngineTypes.startp = _startpos__11_;
+          MenhirLib.EngineTypes.endp = _endpos__11_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _10;
+            MenhirLib.EngineTypes.startp = _startpos__10_;
+            MenhirLib.EngineTypes.endp = _endpos__10_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _9;
+              MenhirLib.EngineTypes.startp = _startpos__9_;
+              MenhirLib.EngineTypes.endp = _endpos__9_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _8;
+                MenhirLib.EngineTypes.startp = _startpos__8_;
+                MenhirLib.EngineTypes.endp = _endpos__8_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = xs;
+                  MenhirLib.EngineTypes.startp = _startpos_xs_;
+                  MenhirLib.EngineTypes.endp = _endpos_xs_;
+                  MenhirLib.EngineTypes.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = _6;
+                    MenhirLib.EngineTypes.startp = _startpos__6_;
+                    MenhirLib.EngineTypes.endp = _endpos__6_;
+                    MenhirLib.EngineTypes.next = {
+                      MenhirLib.EngineTypes.state = _;
+                      MenhirLib.EngineTypes.semv = _5;
+                      MenhirLib.EngineTypes.startp = _startpos__5_;
+                      MenhirLib.EngineTypes.endp = _endpos__5_;
+                      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.next = {
+                          MenhirLib.EngineTypes.state = _;
+                          MenhirLib.EngineTypes.semv = _3;
+                          MenhirLib.EngineTypes.startp = _startpos__3_;
+                          MenhirLib.EngineTypes.endp = _endpos__3_;
+                          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 _11 : (Parsetree.expression) = Obj.magic _11 in
+        let _10 : unit = Obj.magic _10 in
+        let _9 : (Parsetree.core_type) = Obj.magic _9 in
+        let _8 : unit = Obj.magic _8 in
+        let xs : (string Asttypes.loc list) = Obj.magic xs in
+        let _6 : unit = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 19874 "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 = 
+# 2414 "parsing/parser.mly"
+    ( xs )
+# 19886 "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 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 19894 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 19902 "parsing/parser.ml"
+          
+        in
+        let _startpos__4_ = _startpos__1_inlined1_ in
+        let _2 = 
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 19909 "parsing/parser.ml"
+         in
+        let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
+        let _1 = 
+# 3633 "parsing/parser.mly"
+                                                ( Fresh )
+# 19915 "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_
+          else
+            if _startpos__3_ != _endpos__3_ then
+              _startpos__3_
+            else
+              _startpos__4_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1883 "parsing/parser.mly"
+      ( let poly_exp_loc = (_startpos__7_, _endpos__11_) in
+        let poly_exp =
+          let exp, poly =
+            (* it seems odd to use the global ~loc here while poly_exp_loc
+               is tighter, but this is what ocamlyacc does;
+               TODO improve parser.mly *)
+            wrap_type_annotation ~loc:_sloc _7 _9 _11 in
+          ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in
+        (_4, _3,
+        Cfk_concrete (_1, poly_exp)), _2 )
+# 19942 "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 = _11;
+          MenhirLib.EngineTypes.startp = _startpos__11_;
+          MenhirLib.EngineTypes.endp = _endpos__11_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _10;
+            MenhirLib.EngineTypes.startp = _startpos__10_;
+            MenhirLib.EngineTypes.endp = _endpos__10_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _9;
+              MenhirLib.EngineTypes.startp = _startpos__9_;
+              MenhirLib.EngineTypes.endp = _endpos__9_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _8;
+                MenhirLib.EngineTypes.startp = _startpos__8_;
+                MenhirLib.EngineTypes.endp = _endpos__8_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = xs;
+                  MenhirLib.EngineTypes.startp = _startpos_xs_;
+                  MenhirLib.EngineTypes.endp = _endpos_xs_;
+                  MenhirLib.EngineTypes.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = _6;
+                    MenhirLib.EngineTypes.startp = _startpos__6_;
+                    MenhirLib.EngineTypes.endp = _endpos__6_;
+                    MenhirLib.EngineTypes.next = {
+                      MenhirLib.EngineTypes.state = _;
+                      MenhirLib.EngineTypes.semv = _5;
+                      MenhirLib.EngineTypes.startp = _startpos__5_;
+                      MenhirLib.EngineTypes.endp = _endpos__5_;
+                      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.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 = _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 _11 : (Parsetree.expression) = Obj.magic _11 in
+        let _10 : unit = Obj.magic _10 in
+        let _9 : (Parsetree.core_type) = Obj.magic _9 in
+        let _8 : unit = Obj.magic _8 in
+        let xs : (string Asttypes.loc list) = Obj.magic xs in
+        let _6 : unit = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined2 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 20030 "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
+        let _1 : unit = 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 = 
+# 2414 "parsing/parser.mly"
+    ( xs )
+# 20043 "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 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 20051 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 20059 "parsing/parser.ml"
+          
+        in
+        let _startpos__4_ = _startpos__1_inlined2_ in
+        let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 20068 "parsing/parser.ml"
+          
+        in
+        let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
+        let _1 = 
+# 3634 "parsing/parser.mly"
+                                                ( Override )
+# 20075 "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_
+          else
+            if _startpos__3_ != _endpos__3_ then
+              _startpos__3_
+            else
+              _startpos__4_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1883 "parsing/parser.mly"
+      ( let poly_exp_loc = (_startpos__7_, _endpos__11_) in
+        let poly_exp =
+          let exp, poly =
+            (* it seems odd to use the global ~loc here while poly_exp_loc
+               is tighter, but this is what ocamlyacc does;
+               TODO improve parser.mly *)
+            wrap_type_annotation ~loc:_sloc _7 _9 _11 in
+          ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in
+        (_4, _3,
+        Cfk_concrete (_1, poly_exp)), _2 )
+# 20101 "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 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 20122 "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) = 
+# 3490 "parsing/parser.mly"
+                      ( Lident _1 )
+# 20130 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 20163 "parsing/parser.ml"
+        ) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Longident.t) = 
+# 3491 "parsing/parser.mly"
+                      ( Ldot(_1,_3) )
+# 20173 "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 : (
+# 697 "parsing/parser.mly"
+       (string)
+# 20194 "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) = 
+# 3490 "parsing/parser.mly"
+                      ( Lident _1 )
+# 20202 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (
+# 697 "parsing/parser.mly"
+       (string)
+# 20235 "parsing/parser.ml"
+        ) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Longident.t) = 
+# 3491 "parsing/parser.mly"
+                      ( Ldot(_1,_3) )
+# 20245 "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 : (Asttypes.label) = 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) = let _1 = 
+# 3527 "parsing/parser.mly"
+                                                  ( _1 )
+# 20270 "parsing/parser.ml"
+         in
+        
+# 3490 "parsing/parser.mly"
+                      ( Lident _1 )
+# 20275 "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 = _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 : 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 : (Longident.t) = let _1 =
+          let _1 = 
+# 3470 "parsing/parser.mly"
+                                                ( "::" )
+# 20315 "parsing/parser.ml"
+           in
+          
+# 3527 "parsing/parser.mly"
+                                                  ( _1 )
+# 20320 "parsing/parser.ml"
+          
+        in
+        
+# 3490 "parsing/parser.mly"
+                      ( Lident _1 )
+# 20326 "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 : (Asttypes.label) = 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) = let _1 = 
+# 3527 "parsing/parser.mly"
+                                                  ( _1 )
+# 20351 "parsing/parser.ml"
+         in
+        
+# 3490 "parsing/parser.mly"
+                      ( Lident _1 )
+# 20356 "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 = _1_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+          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 _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Longident.t) = let _3 =
+          let _1 = _1_inlined1 in
+          
+# 3527 "parsing/parser.mly"
+                                                  ( _1 )
+# 20397 "parsing/parser.ml"
+          
+        in
+        
+# 3491 "parsing/parser.mly"
+                      ( Ldot(_1,_3) )
+# 20403 "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_inlined1;
+            MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+            MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
+            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.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 : unit = Obj.magic _3 in
+        let _2_inlined1 : unit = Obj.magic _2_inlined1 in
+        let _1_inlined1 : unit = Obj.magic _1_inlined1 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Longident.t) = let _3 =
+          let (_2, _1) = (_2_inlined1, _1_inlined1) in
+          let _1 = 
+# 3470 "parsing/parser.mly"
+                                                ( "::" )
+# 20458 "parsing/parser.ml"
+           in
+          
+# 3527 "parsing/parser.mly"
+                                                  ( _1 )
+# 20463 "parsing/parser.ml"
+          
+        in
+        
+# 3491 "parsing/parser.mly"
+                      ( Ldot(_1,_3) )
+# 20469 "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 = _1_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+          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 _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Longident.t) = let _3 =
+          let _1 = _1_inlined1 in
+          
+# 3527 "parsing/parser.mly"
+                                                  ( _1 )
+# 20510 "parsing/parser.ml"
+          
+        in
+        
+# 3491 "parsing/parser.mly"
+                      ( Ldot(_1,_3) )
+# 20516 "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 : (Asttypes.label) = 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) = 
+# 3490 "parsing/parser.mly"
+                      ( Lident _1 )
+# 20541 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (Asttypes.label) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Longident.t) = 
+# 3491 "parsing/parser.mly"
+                      ( Ldot(_1,_3) )
+# 20580 "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 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 20601 "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) = 
+# 3490 "parsing/parser.mly"
+                      ( Lident _1 )
+# 20609 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 20642 "parsing/parser.ml"
+        ) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Longident.t) = 
+# 3491 "parsing/parser.mly"
+                      ( Ldot(_1,_3) )
+# 20652 "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 : (
+# 697 "parsing/parser.mly"
+       (string)
+# 20673 "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) = 
+# 3490 "parsing/parser.mly"
+                      ( Lident _1 )
+# 20681 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (
+# 697 "parsing/parser.mly"
+       (string)
+# 20714 "parsing/parser.ml"
+        ) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Longident.t) = 
+# 3491 "parsing/parser.mly"
+                      ( Ldot(_1,_3) )
+# 20724 "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 : (Asttypes.label) = 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) = 
+# 3490 "parsing/parser.mly"
+                      ( Lident _1 )
+# 20749 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (Asttypes.label) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Longident.t) = 
+# 3491 "parsing/parser.mly"
+                      ( Ldot(_1,_3) )
+# 20788 "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 : (Longident.t) = 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) = 
+# 3506 "parsing/parser.mly"
+                                            ( _1 )
+# 20813 "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 : unit = Obj.magic _4 in
+        let _3 : (Longident.t) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Longident.t) = let _endpos = _endpos__4_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3508 "parsing/parser.mly"
+      ( lapply ~loc:_sloc _1 _3 )
+# 20862 "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 = _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 : (Longident.t) = 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 : (Longident.t) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
+        
+# 3510 "parsing/parser.mly"
+      ( expecting _loc__3_ "module path" )
+# 20902 "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 : (Longident.t) = 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) = 
+# 3503 "parsing/parser.mly"
+                                         ( _1 )
+# 20927 "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 = me;
+          MenhirLib.EngineTypes.startp = _startpos_me_;
+          MenhirLib.EngineTypes.endp = _endpos_me_;
+          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 me : (Parsetree.module_expr) = Obj.magic me 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_me_ in
+        let _v : (Parsetree.module_expr) = 
+# 1373 "parsing/parser.mly"
+      ( me )
+# 20959 "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 = me;
+          MenhirLib.EngineTypes.startp = _startpos_me_;
+          MenhirLib.EngineTypes.endp = _endpos_me_;
+          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 = mty;
+              MenhirLib.EngineTypes.startp = _startpos_mty_;
+              MenhirLib.EngineTypes.endp = _endpos_mty_;
+              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 me : (Parsetree.module_expr) = Obj.magic me in
+        let _3 : unit = Obj.magic _3 in
+        let mty : (Parsetree.module_type) = Obj.magic mty 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_me_ in
+        let _v : (Parsetree.module_expr) = let _1 =
+          let _1 = 
+# 1376 "parsing/parser.mly"
+        ( Pmod_constraint(me, mty) )
+# 21006 "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
+          
+# 856 "parsing/parser.mly"
+    ( mkmod ~loc:_sloc _1 )
+# 21015 "parsing/parser.ml"
+          
+        in
+        
+# 1379 "parsing/parser.mly"
+    ( _1 )
+# 21021 "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 = body;
+          MenhirLib.EngineTypes.startp = _startpos_body_;
+          MenhirLib.EngineTypes.endp = _endpos_body_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = arg;
+            MenhirLib.EngineTypes.startp = _startpos_arg_;
+            MenhirLib.EngineTypes.endp = _endpos_arg_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let body : (Parsetree.module_expr) = Obj.magic body in
+        let arg : (Parsetree.functor_parameter) = Obj.magic arg in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_arg_ in
+        let _endpos = _endpos_body_ in
+        let _v : (Parsetree.module_expr) = let _1 =
+          let _1 = 
+# 1378 "parsing/parser.mly"
+        ( Pmod_functor(arg, body) )
+# 21054 "parsing/parser.ml"
+           in
+          let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 856 "parsing/parser.mly"
+    ( mkmod ~loc:_sloc _1 )
+# 21063 "parsing/parser.ml"
+          
+        in
+        
+# 1379 "parsing/parser.mly"
+    ( _1 )
+# 21069 "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 = mty;
+          MenhirLib.EngineTypes.startp = _startpos_mty_;
+          MenhirLib.EngineTypes.endp = _endpos_mty_;
+          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 _1 : unit = Obj.magic _1 in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos__1_ in
+        let _endpos = _endpos_mty_ in
+        let _v : (Parsetree.module_type) = 
+# 1616 "parsing/parser.mly"
+      ( mty )
+# 21101 "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 = body;
+          MenhirLib.EngineTypes.startp = _startpos_body_;
+          MenhirLib.EngineTypes.endp = _endpos_body_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = arg;
+            MenhirLib.EngineTypes.startp = _startpos_arg_;
+            MenhirLib.EngineTypes.endp = _endpos_arg_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let body : (Parsetree.module_type) = Obj.magic body in
+        let arg : (Parsetree.functor_parameter) = Obj.magic arg in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_arg_ in
+        let _endpos = _endpos_body_ in
+        let _v : (Parsetree.module_type) = let _1 =
+          let _1 = 
+# 1619 "parsing/parser.mly"
+        ( Pmty_functor(arg, body) )
+# 21134 "parsing/parser.ml"
+           in
+          let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 858 "parsing/parser.mly"
+    ( mkmty ~loc:_sloc _1 )
+# 21143 "parsing/parser.ml"
+          
+        in
+        
+# 1621 "parsing/parser.mly"
+    ( _1 )
+# 21149 "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 = s;
+            MenhirLib.EngineTypes.startp = _startpos_s_;
+            MenhirLib.EngineTypes.endp = _endpos_s_;
+            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.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 : unit = Obj.magic _4 in
+        let s : (Parsetree.structure) = Obj.magic s in
+        let _1_inlined1 : (Parsetree.attributes) = 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__4_ in
+        let _v : (Parsetree.module_expr) = let attrs =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 21197 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__4_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1212 "parsing/parser.mly"
+      ( mkmod ~loc:_sloc ~attrs (Pmod_structure s) )
+# 21206 "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 = _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 _4 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.structure) = Obj.magic _3 in
+        let _1_inlined1 : (Parsetree.attributes) = 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__4_ in
+        let _v : (Parsetree.module_expr) = let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 21254 "parsing/parser.ml"
+          
+        in
+        let _loc__4_ = (_startpos__4_, _endpos__4_) in
+        let _loc__1_ = (_startpos__1_, _endpos__1_) in
+        
+# 1214 "parsing/parser.mly"
+      ( unclosed "struct" _loc__1_ "end" _loc__4_ )
+# 21262 "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 = me;
+          MenhirLib.EngineTypes.startp = _startpos_me_;
+          MenhirLib.EngineTypes.endp = _endpos_me_;
+          MenhirLib.EngineTypes.next = {
+            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 = _1_inlined2;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+              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.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 me : (Parsetree.module_expr) = Obj.magic me in
+        let _4 : unit = Obj.magic _4 in
+        let _1_inlined2 : (Parsetree.functor_parameter list) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (Parsetree.attributes) = 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_me_ in
+        let _v : (Parsetree.module_expr) = let args =
+          let _1 = _1_inlined2 in
+          
+# 1178 "parsing/parser.mly"
+    ( _1 )
+# 21317 "parsing/parser.ml"
+          
+        in
+        let attrs =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 21325 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_me_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1216 "parsing/parser.mly"
+      ( wrap_mod_attrs ~loc:_sloc attrs (
+          List.fold_left (fun acc arg ->
+            mkmod ~loc:_sloc (Pmod_functor (arg, acc))
+          ) me args
+        ) )
+# 21338 "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 = me;
+          MenhirLib.EngineTypes.startp = _startpos_me_;
+          MenhirLib.EngineTypes.endp = _endpos_me_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let me : (Parsetree.module_expr) = Obj.magic me in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_me_ in
+        let _endpos = _endpos_me_ in
+        let _v : (Parsetree.module_expr) = 
+# 1222 "parsing/parser.mly"
+      ( me )
+# 21363 "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 = attr;
+          MenhirLib.EngineTypes.startp = _startpos_attr_;
+          MenhirLib.EngineTypes.endp = _endpos_attr_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = me;
+            MenhirLib.EngineTypes.startp = _startpos_me_;
+            MenhirLib.EngineTypes.endp = _endpos_me_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let attr : (Parsetree.attribute) = Obj.magic attr in
+        let me : (Parsetree.module_expr) = Obj.magic me in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_me_ in
+        let _endpos = _endpos_attr_ in
+        let _v : (Parsetree.module_expr) = 
+# 1224 "parsing/parser.mly"
+      ( Mod.attr me attr )
+# 21395 "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 : (Longident.t) = 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.module_expr) = let _1 =
+          let _1 =
+            let x =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 21426 "parsing/parser.ml"
+              
+            in
+            
+# 1228 "parsing/parser.mly"
+        ( Pmod_ident x )
+# 21432 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 856 "parsing/parser.mly"
+    ( mkmod ~loc:_sloc _1 )
+# 21441 "parsing/parser.ml"
+          
+        in
+        
+# 1240 "parsing/parser.mly"
+    ( _1 )
+# 21447 "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 = me2;
+          MenhirLib.EngineTypes.startp = _startpos_me2_;
+          MenhirLib.EngineTypes.endp = _endpos_me2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = me1;
+            MenhirLib.EngineTypes.startp = _startpos_me1_;
+            MenhirLib.EngineTypes.endp = _endpos_me1_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let me2 : (Parsetree.module_expr) = Obj.magic me2 in
+        let me1 : (Parsetree.module_expr) = Obj.magic me1 in
+        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 = 
+# 1231 "parsing/parser.mly"
+        ( Pmod_apply(me1, me2) )
+# 21480 "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
+          
+# 856 "parsing/parser.mly"
+    ( mkmod ~loc:_sloc _1 )
+# 21489 "parsing/parser.ml"
+          
+        in
+        
+# 1240 "parsing/parser.mly"
+    ( _1 )
+# 21495 "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 = me1;
+              MenhirLib.EngineTypes.startp = _startpos_me1_;
+              MenhirLib.EngineTypes.endp = _endpos_me1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let me1 : (Parsetree.module_expr) = Obj.magic me1 in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_me1_ in
+        let _endpos = _endpos__3_ in
+        let _v : (Parsetree.module_expr) = let _1 =
+          let _1 =
+            let _endpos = _endpos__3_ in
+            let _symbolstartpos = _startpos_me1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1234 "parsing/parser.mly"
+        ( (* TODO review mkmod location *)
+          Pmod_apply(me1, mkmod ~loc:_sloc (Pmod_structure [])) )
+# 21540 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_me1_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 856 "parsing/parser.mly"
+    ( mkmod ~loc:_sloc _1 )
+# 21550 "parsing/parser.ml"
+          
+        in
+        
+# 1240 "parsing/parser.mly"
+    ( _1 )
+# 21556 "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 = ex;
+          MenhirLib.EngineTypes.startp = _startpos_ex_;
+          MenhirLib.EngineTypes.endp = _endpos_ex_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let ex : (Parsetree.extension) = Obj.magic ex in
+        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 = 
+# 1238 "parsing/parser.mly"
+        ( Pmod_extension ex )
+# 21582 "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
+          
+# 856 "parsing/parser.mly"
+    ( mkmod ~loc:_sloc _1 )
+# 21591 "parsing/parser.ml"
+          
+        in
+        
+# 1240 "parsing/parser.mly"
+    ( _1 )
+# 21597 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : (
+# 697 "parsing/parser.mly"
+       (string)
+# 21618 "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) = 
+# 1195 "parsing/parser.mly"
+      ( Some x )
+# 21626 "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 : unit = 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 option) = 
+# 1198 "parsing/parser.mly"
+      ( None )
+# 21651 "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 = _1_inlined4;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined4_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined4_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              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.next = {
+                  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 = _;
+                    MenhirLib.EngineTypes.semv = ext;
+                    MenhirLib.EngineTypes.startp = _startpos_ext_;
+                    MenhirLib.EngineTypes.endp = _endpos_ext_;
+                    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 _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
+        let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined2 : (
+# 697 "parsing/parser.mly"
+       (string)
+# 21711 "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
+        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_inlined4_ in
+        let _v : (Parsetree.module_substitution * string Asttypes.loc option) = let attrs2 =
+          let _1 = _1_inlined4 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 21724 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 21736 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 21747 "parsing/parser.ml"
+          
+        in
+        let attrs1 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 21755 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_attrs2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1651 "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
+  )
+# 21769 "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 = _6;
+          MenhirLib.EngineTypes.startp = _startpos__6_;
+          MenhirLib.EngineTypes.endp = _endpos__6_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _5;
+            MenhirLib.EngineTypes.startp = _startpos__5_;
+            MenhirLib.EngineTypes.endp = _endpos__5_;
+            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.next = {
+                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 = _;
+                  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 _6 : unit = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined2 : (
+# 697 "parsing/parser.mly"
+       (string)
+# 21822 "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
+        let _1 : unit = 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 : (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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 21838 "parsing/parser.ml"
+          
+        in
+        let _3 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 21846 "parsing/parser.ml"
+          
+        in
+        let _loc__6_ = (_startpos__6_, _endpos__6_) in
+        
+# 1658 "parsing/parser.mly"
+    ( expecting _loc__6_ "module path" )
+# 21853 "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 = s;
+            MenhirLib.EngineTypes.startp = _startpos_s_;
+            MenhirLib.EngineTypes.endp = _endpos_s_;
+            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.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 : unit = Obj.magic _4 in
+        let s : (Parsetree.signature) = Obj.magic s in
+        let _1_inlined1 : (Parsetree.attributes) = 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__4_ in
+        let _v : (Parsetree.module_type) = let attrs =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 21901 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__4_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1504 "parsing/parser.mly"
+      ( mkmty ~loc:_sloc ~attrs (Pmty_signature s) )
+# 21910 "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 = _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 _4 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.signature) = Obj.magic _3 in
+        let _1_inlined1 : (Parsetree.attributes) = 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__4_ in
+        let _v : (Parsetree.module_type) = let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 21958 "parsing/parser.ml"
+          
+        in
+        let _loc__4_ = (_startpos__4_, _endpos__4_) in
+        let _loc__1_ = (_startpos__1_, _endpos__1_) in
+        
+# 1506 "parsing/parser.mly"
+      ( unclosed "sig" _loc__1_ "end" _loc__4_ )
+# 21966 "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 = mty;
+          MenhirLib.EngineTypes.startp = _startpos_mty_;
+          MenhirLib.EngineTypes.endp = _endpos_mty_;
+          MenhirLib.EngineTypes.next = {
+            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 = _1_inlined2;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+              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.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 _4 : unit = Obj.magic _4 in
+        let _1_inlined2 : (Parsetree.functor_parameter list) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (Parsetree.attributes) = 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_mty_ in
+        let _v : (Parsetree.module_type) = let args =
+          let _1 = _1_inlined2 in
+          
+# 1178 "parsing/parser.mly"
+    ( _1 )
+# 22021 "parsing/parser.ml"
+          
+        in
+        let attrs =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 22029 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_mty_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1510 "parsing/parser.mly"
+      ( wrap_mty_attrs ~loc:_sloc attrs (
+          List.fold_left (fun acc arg ->
+            mkmty ~loc:_sloc (Pmty_functor (arg, acc))
+          ) mty args
+        ) )
+# 22042 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          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.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 _5 : (Parsetree.module_expr) = Obj.magic _5 in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 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__5_ in
+        let _v : (Parsetree.module_type) = let _4 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 22097 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1516 "parsing/parser.mly"
+      ( mkmty ~loc:_sloc ~attrs:_4 (Pmty_typeof _5) )
+# 22106 "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 = _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 : (Parsetree.module_type) = 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.module_type) = 
+# 1518 "parsing/parser.mly"
+      ( _2 )
+# 22145 "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 = _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 : (Parsetree.module_type) = 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.module_type) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
+        let _loc__1_ = (_startpos__1_, _endpos__1_) in
+        
+# 1520 "parsing/parser.mly"
+      ( unclosed "(" _loc__1_ ")" _loc__3_ )
+# 22186 "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 = _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 _2 : (Parsetree.attribute) = Obj.magic _2 in
+        let _1 : (Parsetree.module_type) = 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.module_type) = 
+# 1522 "parsing/parser.mly"
+      ( Mty.attr _1 _2 )
+# 22218 "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 : (Longident.t) = 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.module_type) = let _1 =
+          let _1 =
+            let _1 =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 22249 "parsing/parser.ml"
+              
+            in
+            
+# 1525 "parsing/parser.mly"
+        ( Pmty_ident _1 )
+# 22255 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 858 "parsing/parser.mly"
+    ( mkmty ~loc:_sloc _1 )
+# 22264 "parsing/parser.ml"
+          
+        in
+        
+# 1536 "parsing/parser.mly"
+    ( _1 )
+# 22270 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (Parsetree.module_type) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Parsetree.module_type) = 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.module_type) = let _1 =
+          let _1 = 
+# 1528 "parsing/parser.mly"
+        ( Pmty_functor(Named (mknoloc None, _1), _3) )
+# 22310 "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
+          
+# 858 "parsing/parser.mly"
+    ( mkmty ~loc:_sloc _1 )
+# 22319 "parsing/parser.ml"
+          
+        in
+        
+# 1536 "parsing/parser.mly"
+    ( _1 )
+# 22325 "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 = _;
+            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 xs : (Parsetree.with_constraint list) = Obj.magic xs in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Parsetree.module_type) = 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.module_type) = let _1 =
+          let _1 =
+            let _3 =
+              let xs = 
+# 253 ""
+    ( List.rev xs )
+# 22367 "parsing/parser.ml"
+               in
+              
+# 947 "parsing/parser.mly"
+    ( xs )
+# 22372 "parsing/parser.ml"
+              
+            in
+            
+# 1530 "parsing/parser.mly"
+        ( Pmty_with(_1, _3) )
+# 22378 "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
+          
+# 858 "parsing/parser.mly"
+    ( mkmty ~loc:_sloc _1 )
+# 22388 "parsing/parser.ml"
+          
+        in
+        
+# 1536 "parsing/parser.mly"
+    ( _1 )
+# 22394 "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.extension) = 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.module_type) = let _1 =
+          let _1 = 
+# 1534 "parsing/parser.mly"
+        ( Pmty_extension _1 )
+# 22420 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 858 "parsing/parser.mly"
+    ( mkmty ~loc:_sloc _1 )
+# 22428 "parsing/parser.ml"
+          
+        in
+        
+# 1536 "parsing/parser.mly"
+    ( _1 )
+# 22434 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = typ;
+            MenhirLib.EngineTypes.startp = _startpos_typ_;
+            MenhirLib.EngineTypes.endp = _endpos_typ_;
+            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.next = {
+                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 = _;
+                  MenhirLib.EngineTypes.semv = ext;
+                  MenhirLib.EngineTypes.startp = _startpos_ext_;
+                  MenhirLib.EngineTypes.endp = _endpos_ext_;
+                  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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let typ : (Parsetree.module_type option) = Obj.magic typ in
+        let _1_inlined2 : (Asttypes.label) = 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
+        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__1_inlined3_ in
+        let _v : (Parsetree.module_type_declaration * string Asttypes.loc option) = let attrs2 =
+          let _1 = _1_inlined3 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 22503 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 22515 "parsing/parser.ml"
+          
+        in
+        let attrs1 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 22523 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_attrs2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1450 "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
+  )
+# 22537 "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 : (Longident.t) = 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) = 
+# 3513 "parsing/parser.mly"
+                                          ( _1 )
+# 22562 "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 : (Asttypes.mutable_flag) = 
+# 3590 "parsing/parser.mly"
+                                                ( Immutable )
+# 22580 "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 : unit = 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.mutable_flag) = 
+# 3591 "parsing/parser.mly"
+                                                ( Mutable )
+# 22605 "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 : (Asttypes.mutable_flag * Asttypes.virtual_flag) = 
+# 3599 "parsing/parser.mly"
+      ( Immutable, Concrete )
+# 22623 "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 : unit = 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.mutable_flag * Asttypes.virtual_flag) = 
+# 3601 "parsing/parser.mly"
+      ( Mutable, Concrete )
+# 22648 "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 : unit = 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.mutable_flag * Asttypes.virtual_flag) = 
+# 3603 "parsing/parser.mly"
+      ( Immutable, Virtual )
+# 22673 "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 = _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 _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__2_ in
+        let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = 
+# 3606 "parsing/parser.mly"
+      ( Mutable, Virtual )
+# 22705 "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 = _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 _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__2_ in
+        let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = 
+# 3606 "parsing/parser.mly"
+      ( Mutable, Virtual )
+# 22737 "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 = _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 _2 : (Asttypes.label) = 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 : (Asttypes.label) = 
+# 3563 "parsing/parser.mly"
+                                                ( _2 )
+# 22769 "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 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 22790 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 22802 "parsing/parser.ml"
+          
+        in
+        
+# 221 ""
+    ( [ x ] )
+# 22808 "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 : (string Asttypes.loc list) = Obj.magic xs in
+        let _1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 22836 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 22848 "parsing/parser.ml"
+          
+        in
+        
+# 223 ""
+    ( x :: xs )
+# 22854 "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 = s;
+          MenhirLib.EngineTypes.startp = _startpos_s_;
+          MenhirLib.EngineTypes.endp = _endpos_s_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let s : (
+# 685 "parsing/parser.mly"
+       (string * Location.t * string option)
+# 22875 "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 = 
+# 3559 "parsing/parser.mly"
+    ( let body, _, _ = s in body )
+# 22883 "parsing/parser.ml"
+         in
+        
+# 221 ""
+    ( [ x ] )
+# 22888 "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 = s;
+            MenhirLib.EngineTypes.startp = _startpos_s_;
+            MenhirLib.EngineTypes.endp = _endpos_s_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let xs : (string list) = Obj.magic xs in
+        let s : (
+# 685 "parsing/parser.mly"
+       (string * Location.t * string option)
+# 22916 "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 = 
+# 3559 "parsing/parser.mly"
+    ( let body, _, _ = s in body )
+# 22924 "parsing/parser.ml"
+         in
+        
+# 223 ""
+    ( x :: xs )
+# 22929 "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 = ty;
+          MenhirLib.EngineTypes.startp = _startpos_ty_;
+          MenhirLib.EngineTypes.endp = _endpos_ty_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let ty : (Parsetree.core_type) = Obj.magic ty in
+        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 = 
+# 3586 "parsing/parser.mly"
+                                                ( Public )
+# 22954 "parsing/parser.ml"
+         in
+        
+# 2896 "parsing/parser.mly"
+      ( (Ptype_abstract, priv, Some ty) )
+# 22959 "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 = ty;
+          MenhirLib.EngineTypes.startp = _startpos_ty_;
+          MenhirLib.EngineTypes.endp = _endpos_ty_;
+          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 ty : (Parsetree.core_type) = Obj.magic ty 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_ty_ in
+        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
+# 3587 "parsing/parser.mly"
+                                                ( Private )
+# 22991 "parsing/parser.ml"
+         in
+        
+# 2896 "parsing/parser.mly"
+      ( (Ptype_abstract, priv, Some ty) )
+# 22996 "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 = cs;
+          MenhirLib.EngineTypes.startp = _startpos_cs_;
+          MenhirLib.EngineTypes.endp = _endpos_cs_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let cs : (Parsetree.constructor_declaration list) = Obj.magic cs in
+        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 = 
+# 3586 "parsing/parser.mly"
+                                                ( Public )
+# 23021 "parsing/parser.ml"
+         in
+        let oty =
+          let _1 = 
+# 124 ""
+    ( None )
+# 23027 "parsing/parser.ml"
+           in
+          
+# 2912 "parsing/parser.mly"
+    ( _1 )
+# 23032 "parsing/parser.ml"
+          
+        in
+        
+# 2900 "parsing/parser.mly"
+      ( (Ptype_variant cs, priv, oty) )
+# 23038 "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 = cs;
+          MenhirLib.EngineTypes.startp = _startpos_cs_;
+          MenhirLib.EngineTypes.endp = _endpos_cs_;
+          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 cs : (Parsetree.constructor_declaration list) = Obj.magic cs 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_cs_ in
+        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
+# 3587 "parsing/parser.mly"
+                                                ( Private )
+# 23070 "parsing/parser.ml"
+         in
+        let oty =
+          let _1 = 
+# 124 ""
+    ( None )
+# 23076 "parsing/parser.ml"
+           in
+          
+# 2912 "parsing/parser.mly"
+    ( _1 )
+# 23081 "parsing/parser.ml"
+          
+        in
+        
+# 2900 "parsing/parser.mly"
+      ( (Ptype_variant cs, priv, oty) )
+# 23087 "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 = cs;
+          MenhirLib.EngineTypes.startp = _startpos_cs_;
+          MenhirLib.EngineTypes.endp = _endpos_cs_;
+          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 = x;
+              MenhirLib.EngineTypes.startp = _startpos_x_;
+              MenhirLib.EngineTypes.endp = _endpos_x_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let cs : (Parsetree.constructor_declaration list) = Obj.magic cs in
+        let _2 : unit = Obj.magic _2 in
+        let x : (Parsetree.core_type) = Obj.magic x in
+        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 = 
+# 3586 "parsing/parser.mly"
+                                                ( Public )
+# 23126 "parsing/parser.ml"
+         in
+        let oty =
+          let _1 =
+            let x = 
+# 191 ""
+    ( x )
+# 23133 "parsing/parser.ml"
+             in
+            
+# 126 ""
+    ( Some x )
+# 23138 "parsing/parser.ml"
+            
+          in
+          
+# 2912 "parsing/parser.mly"
+    ( _1 )
+# 23144 "parsing/parser.ml"
+          
+        in
+        
+# 2900 "parsing/parser.mly"
+      ( (Ptype_variant cs, priv, oty) )
+# 23150 "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 = cs;
+          MenhirLib.EngineTypes.startp = _startpos_cs_;
+          MenhirLib.EngineTypes.endp = _endpos_cs_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            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 = x;
+                MenhirLib.EngineTypes.startp = _startpos_x_;
+                MenhirLib.EngineTypes.endp = _endpos_x_;
+                MenhirLib.EngineTypes.next = _menhir_stack;
+              };
+            };
+          };
+        } = _menhir_stack in
+        let cs : (Parsetree.constructor_declaration list) = Obj.magic cs in
+        let _1 : unit = Obj.magic _1 in
+        let _2 : unit = Obj.magic _2 in
+        let x : (Parsetree.core_type) = Obj.magic x in
+        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 = 
+# 3587 "parsing/parser.mly"
+                                                ( Private )
+# 23196 "parsing/parser.ml"
+         in
+        let oty =
+          let _1 =
+            let x = 
+# 191 ""
+    ( x )
+# 23203 "parsing/parser.ml"
+             in
+            
+# 126 ""
+    ( Some x )
+# 23208 "parsing/parser.ml"
+            
+          in
+          
+# 2912 "parsing/parser.mly"
+    ( _1 )
+# 23214 "parsing/parser.ml"
+          
+        in
+        
+# 2900 "parsing/parser.mly"
+      ( (Ptype_variant cs, priv, oty) )
+# 23220 "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 = _3;
+          MenhirLib.EngineTypes.startp = _startpos__3_;
+          MenhirLib.EngineTypes.endp = _endpos__3_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let _3 : unit = Obj.magic _3 in
+        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 = 
+# 3586 "parsing/parser.mly"
+                                                ( Public )
+# 23245 "parsing/parser.ml"
+         in
+        let oty =
+          let _1 = 
+# 124 ""
+    ( None )
+# 23251 "parsing/parser.ml"
+           in
+          
+# 2912 "parsing/parser.mly"
+    ( _1 )
+# 23256 "parsing/parser.ml"
+          
+        in
+        
+# 2904 "parsing/parser.mly"
+      ( (Ptype_open, priv, oty) )
+# 23262 "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 = _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 _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.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
+# 3587 "parsing/parser.mly"
+                                                ( Private )
+# 23294 "parsing/parser.ml"
+         in
+        let oty =
+          let _1 = 
+# 124 ""
+    ( None )
+# 23300 "parsing/parser.ml"
+           in
+          
+# 2912 "parsing/parser.mly"
+    ( _1 )
+# 23305 "parsing/parser.ml"
+          
+        in
+        
+# 2904 "parsing/parser.mly"
+      ( (Ptype_open, priv, oty) )
+# 23311 "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 = x;
+              MenhirLib.EngineTypes.startp = _startpos_x_;
+              MenhirLib.EngineTypes.endp = _endpos_x_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let x : (Parsetree.core_type) = Obj.magic x in
+        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 = 
+# 3586 "parsing/parser.mly"
+                                                ( Public )
+# 23350 "parsing/parser.ml"
+         in
+        let oty =
+          let _1 =
+            let x = 
+# 191 ""
+    ( x )
+# 23357 "parsing/parser.ml"
+             in
+            
+# 126 ""
+    ( Some x )
+# 23362 "parsing/parser.ml"
+            
+          in
+          
+# 2912 "parsing/parser.mly"
+    ( _1 )
+# 23368 "parsing/parser.ml"
+          
+        in
+        
+# 2904 "parsing/parser.mly"
+      ( (Ptype_open, priv, oty) )
+# 23374 "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 = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            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 = x;
+                MenhirLib.EngineTypes.startp = _startpos_x_;
+                MenhirLib.EngineTypes.endp = _endpos_x_;
+                MenhirLib.EngineTypes.next = _menhir_stack;
+              };
+            };
+          };
+        } = _menhir_stack in
+        let _3 : unit = Obj.magic _3 in
+        let _1 : unit = Obj.magic _1 in
+        let _2 : unit = Obj.magic _2 in
+        let x : (Parsetree.core_type) = Obj.magic x in
+        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 = 
+# 3587 "parsing/parser.mly"
+                                                ( Private )
+# 23420 "parsing/parser.ml"
+         in
+        let oty =
+          let _1 =
+            let x = 
+# 191 ""
+    ( x )
+# 23427 "parsing/parser.ml"
+             in
+            
+# 126 ""
+    ( Some x )
+# 23432 "parsing/parser.ml"
+            
+          in
+          
+# 2912 "parsing/parser.mly"
+    ( _1 )
+# 23438 "parsing/parser.ml"
+          
+        in
+        
+# 2904 "parsing/parser.mly"
+      ( (Ptype_open, priv, oty) )
+# 23444 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = ls;
+            MenhirLib.EngineTypes.startp = _startpos_ls_;
+            MenhirLib.EngineTypes.endp = _endpos_ls_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = _3;
+              MenhirLib.EngineTypes.startp = _startpos__3_;
+              MenhirLib.EngineTypes.endp = _endpos__3_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _5 : unit = Obj.magic _5 in
+        let ls : (Parsetree.label_declaration list) = Obj.magic ls in
+        let _3 : unit = Obj.magic _3 in
+        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 = 
+# 3586 "parsing/parser.mly"
+                                                ( Public )
+# 23483 "parsing/parser.ml"
+         in
+        let oty =
+          let _1 = 
+# 124 ""
+    ( None )
+# 23489 "parsing/parser.ml"
+           in
+          
+# 2912 "parsing/parser.mly"
+    ( _1 )
+# 23494 "parsing/parser.ml"
+          
+        in
+        
+# 2908 "parsing/parser.mly"
+      ( (Ptype_record ls, priv, oty) )
+# 23500 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = ls;
+            MenhirLib.EngineTypes.startp = _startpos_ls_;
+            MenhirLib.EngineTypes.endp = _endpos_ls_;
+            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 = _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 _5 : unit = Obj.magic _5 in
+        let ls : (Parsetree.label_declaration list) = Obj.magic ls in
+        let _3 : unit = Obj.magic _3 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 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
+# 3587 "parsing/parser.mly"
+                                                ( Private )
+# 23546 "parsing/parser.ml"
+         in
+        let oty =
+          let _1 = 
+# 124 ""
+    ( None )
+# 23552 "parsing/parser.ml"
+           in
+          
+# 2912 "parsing/parser.mly"
+    ( _1 )
+# 23557 "parsing/parser.ml"
+          
+        in
+        
+# 2908 "parsing/parser.mly"
+      ( (Ptype_record ls, priv, oty) )
+# 23563 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = ls;
+            MenhirLib.EngineTypes.startp = _startpos_ls_;
+            MenhirLib.EngineTypes.endp = _endpos_ls_;
+            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 = x;
+                  MenhirLib.EngineTypes.startp = _startpos_x_;
+                  MenhirLib.EngineTypes.endp = _endpos_x_;
+                  MenhirLib.EngineTypes.next = _menhir_stack;
+                };
+              };
+            };
+          };
+        } = _menhir_stack in
+        let _5 : unit = Obj.magic _5 in
+        let ls : (Parsetree.label_declaration list) = Obj.magic ls in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let x : (Parsetree.core_type) = Obj.magic x in
+        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 = 
+# 3586 "parsing/parser.mly"
+                                                ( Public )
+# 23616 "parsing/parser.ml"
+         in
+        let oty =
+          let _1 =
+            let x = 
+# 191 ""
+    ( x )
+# 23623 "parsing/parser.ml"
+             in
+            
+# 126 ""
+    ( Some x )
+# 23628 "parsing/parser.ml"
+            
+          in
+          
+# 2912 "parsing/parser.mly"
+    ( _1 )
+# 23634 "parsing/parser.ml"
+          
+        in
+        
+# 2908 "parsing/parser.mly"
+      ( (Ptype_record ls, priv, oty) )
+# 23640 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = ls;
+            MenhirLib.EngineTypes.startp = _startpos_ls_;
+            MenhirLib.EngineTypes.endp = _endpos_ls_;
+            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 = _1;
+                MenhirLib.EngineTypes.startp = _startpos__1_;
+                MenhirLib.EngineTypes.endp = _endpos__1_;
+                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 = x;
+                    MenhirLib.EngineTypes.startp = _startpos_x_;
+                    MenhirLib.EngineTypes.endp = _endpos_x_;
+                    MenhirLib.EngineTypes.next = _menhir_stack;
+                  };
+                };
+              };
+            };
+          };
+        } = _menhir_stack in
+        let _5 : unit = Obj.magic _5 in
+        let ls : (Parsetree.label_declaration list) = Obj.magic ls in
+        let _3 : unit = Obj.magic _3 in
+        let _1 : unit = Obj.magic _1 in
+        let _2 : unit = Obj.magic _2 in
+        let x : (Parsetree.core_type) = Obj.magic x in
+        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 = 
+# 3587 "parsing/parser.mly"
+                                                ( Private )
+# 23700 "parsing/parser.ml"
+         in
+        let oty =
+          let _1 =
+            let x = 
+# 191 ""
+    ( x )
+# 23707 "parsing/parser.ml"
+             in
+            
+# 126 ""
+    ( Some x )
+# 23712 "parsing/parser.ml"
+            
+          in
+          
+# 2912 "parsing/parser.mly"
+    ( _1 )
+# 23718 "parsing/parser.ml"
+          
+        in
+        
+# 2908 "parsing/parser.mly"
+      ( (Ptype_record ls, priv, oty) )
+# 23724 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = me;
+            MenhirLib.EngineTypes.startp = _startpos_me_;
+            MenhirLib.EngineTypes.endp = _endpos_me_;
+            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.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = ext;
+                MenhirLib.EngineTypes.startp = _startpos_ext_;
+                MenhirLib.EngineTypes.endp = _endpos_ext_;
+                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 _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let me : (Parsetree.module_expr) = Obj.magic me in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext 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.open_declaration * string Asttypes.loc option) = let attrs2 =
+          let _1 = _1_inlined2 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 23779 "parsing/parser.ml"
+          
+        in
+        let _endpos_attrs2_ = _endpos__1_inlined2_ in
+        let attrs1 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 23788 "parsing/parser.ml"
+          
+        in
+        let override = 
+# 3633 "parsing/parser.mly"
+                                                ( Fresh )
+# 23794 "parsing/parser.ml"
+         in
+        let _endpos = _endpos_attrs2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1469 "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
+  )
+# 23807 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = me;
+            MenhirLib.EngineTypes.startp = _startpos_me_;
+            MenhirLib.EngineTypes.endp = _endpos_me_;
+            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.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = ext;
+                MenhirLib.EngineTypes.startp = _startpos_ext_;
+                MenhirLib.EngineTypes.endp = _endpos_ext_;
+                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.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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let me : (Parsetree.module_expr) = Obj.magic me in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext in
+        let _1_inlined1 : unit = 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_inlined3_ in
+        let _v : (Parsetree.open_declaration * string Asttypes.loc option) = let attrs2 =
+          let _1 = _1_inlined3 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 23869 "parsing/parser.ml"
+          
+        in
+        let _endpos_attrs2_ = _endpos__1_inlined3_ in
+        let attrs1 =
+          let _1 = _1_inlined2 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 23878 "parsing/parser.ml"
+          
+        in
+        let override =
+          let _1 = _1_inlined1 in
+          
+# 3634 "parsing/parser.mly"
+                                                ( Override )
+# 23886 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_attrs2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1469 "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
+  )
+# 23900 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          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.next = {
+              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 = _;
+                MenhirLib.EngineTypes.semv = ext;
+                MenhirLib.EngineTypes.startp = _startpos_ext_;
+                MenhirLib.EngineTypes.endp = _endpos_ext_;
+                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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let _1_inlined2 : (Longident.t) = 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
+        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_inlined3_ in
+        let _v : (Parsetree.open_description * string Asttypes.loc option) = let attrs2 =
+          let _1 = _1_inlined3 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 23955 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 23967 "parsing/parser.ml"
+          
+        in
+        let attrs1 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 23975 "parsing/parser.ml"
+          
+        in
+        let override = 
+# 3633 "parsing/parser.mly"
+                                                ( Fresh )
+# 23981 "parsing/parser.ml"
+         in
+        let _endpos = _endpos_attrs2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1484 "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
+  )
+# 23994 "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 = _1_inlined4;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined4_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined4_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            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.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = ext;
+                MenhirLib.EngineTypes.startp = _startpos_ext_;
+                MenhirLib.EngineTypes.endp = _endpos_ext_;
+                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.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 _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
+        let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext in
+        let _1_inlined1 : unit = 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_inlined4_ in
+        let _v : (Parsetree.open_description * string Asttypes.loc option) = let attrs2 =
+          let _1 = _1_inlined4 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 24056 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 24068 "parsing/parser.ml"
+          
+        in
+        let attrs1 =
+          let _1 = _1_inlined2 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 24076 "parsing/parser.ml"
+          
+        in
+        let override =
+          let _1 = _1_inlined1 in
+          
+# 3634 "parsing/parser.mly"
+                                                ( Override )
+# 24084 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_attrs2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1484 "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
+  )
+# 24098 "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 : (
+# 671 "parsing/parser.mly"
+       (string)
+# 24119 "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) = 
+# 3429 "parsing/parser.mly"
+                                                ( _1 )
+# 24127 "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 : (
+# 629 "parsing/parser.mly"
+       (string)
+# 24148 "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) = 
+# 3430 "parsing/parser.mly"
+                                                ( _1 )
+# 24156 "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 : (
+# 630 "parsing/parser.mly"
+       (string)
+# 24177 "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) = 
+# 3431 "parsing/parser.mly"
+                                                ( _1 )
+# 24185 "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 : unit = Obj.magic _4 in
+        let _3 : (string) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 24227 "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) = 
+# 3432 "parsing/parser.mly"
+                                                ( "."^ _1 ^"(" ^ _3 ^ ")" )
+# 24235 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : unit = Obj.magic _4 in
+        let _3 : (string) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 24284 "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) = 
+# 3433 "parsing/parser.mly"
+                                                ( "."^ _1 ^ "(" ^ _3 ^ ")<-" )
+# 24292 "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 : unit = Obj.magic _4 in
+        let _3 : (string) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 24334 "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) = 
+# 3434 "parsing/parser.mly"
+                                                ( "."^ _1 ^"[" ^ _3 ^ "]" )
+# 24342 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : unit = Obj.magic _4 in
+        let _3 : (string) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 24391 "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) = 
+# 3435 "parsing/parser.mly"
+                                                ( "."^ _1 ^ "[" ^ _3 ^ "]<-" )
+# 24399 "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 : unit = Obj.magic _4 in
+        let _3 : (string) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 24441 "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) = 
+# 3436 "parsing/parser.mly"
+                                                ( "."^ _1 ^"{" ^ _3 ^ "}" )
+# 24449 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : unit = Obj.magic _4 in
+        let _3 : (string) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 24498 "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) = 
+# 3437 "parsing/parser.mly"
+                                                ( "."^ _1 ^ "{" ^ _3 ^ "}<-" )
+# 24506 "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 : (
+# 682 "parsing/parser.mly"
+       (string)
+# 24527 "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) = 
+# 3438 "parsing/parser.mly"
+                                                ( _1 )
+# 24535 "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 : unit = 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) = 
+# 3439 "parsing/parser.mly"
+                                                ( "!" )
+# 24560 "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 = op;
+          MenhirLib.EngineTypes.startp = _startpos_op_;
+          MenhirLib.EngineTypes.endp = _endpos_op_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let op : (
+# 623 "parsing/parser.mly"
+       (string)
+# 24581 "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 = 
+# 3443 "parsing/parser.mly"
+                  ( op )
+# 24589 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 24594 "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 = op;
+          MenhirLib.EngineTypes.startp = _startpos_op_;
+          MenhirLib.EngineTypes.endp = _endpos_op_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let op : (
+# 624 "parsing/parser.mly"
+       (string)
+# 24615 "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 = 
+# 3444 "parsing/parser.mly"
+                  ( op )
+# 24623 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 24628 "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 = op;
+          MenhirLib.EngineTypes.startp = _startpos_op_;
+          MenhirLib.EngineTypes.endp = _endpos_op_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let op : (
+# 625 "parsing/parser.mly"
+       (string)
+# 24649 "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 = 
+# 3445 "parsing/parser.mly"
+                  ( op )
+# 24657 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 24662 "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 = op;
+          MenhirLib.EngineTypes.startp = _startpos_op_;
+          MenhirLib.EngineTypes.endp = _endpos_op_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let op : (
+# 626 "parsing/parser.mly"
+       (string)
+# 24683 "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 = 
+# 3446 "parsing/parser.mly"
+                  ( op )
+# 24691 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 24696 "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 = op;
+          MenhirLib.EngineTypes.startp = _startpos_op_;
+          MenhirLib.EngineTypes.endp = _endpos_op_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let op : (
+# 627 "parsing/parser.mly"
+       (string)
+# 24717 "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 = 
+# 3447 "parsing/parser.mly"
+                  ( op )
+# 24725 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 24730 "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 : unit = 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) = let _1 = 
+# 3448 "parsing/parser.mly"
+                   ("+")
+# 24755 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 24760 "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 : unit = 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) = let _1 = 
+# 3449 "parsing/parser.mly"
+                  ("+.")
+# 24785 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 24790 "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 : unit = 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) = let _1 = 
+# 3450 "parsing/parser.mly"
+                  ("+=")
+# 24815 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 24820 "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 : unit = 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) = let _1 = 
+# 3451 "parsing/parser.mly"
+                   ("-")
+# 24845 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 24850 "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 : unit = 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) = let _1 = 
+# 3452 "parsing/parser.mly"
+                  ("-.")
+# 24875 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 24880 "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 : unit = 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) = let _1 = 
+# 3453 "parsing/parser.mly"
+                   ("*")
+# 24905 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 24910 "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 : unit = 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) = let _1 = 
+# 3454 "parsing/parser.mly"
+                   ("%")
+# 24935 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 24940 "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 : unit = 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) = let _1 = 
+# 3455 "parsing/parser.mly"
+                   ("=")
+# 24965 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 24970 "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 : unit = 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) = let _1 = 
+# 3456 "parsing/parser.mly"
+                   ("<")
+# 24995 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 25000 "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 : unit = 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) = let _1 = 
+# 3457 "parsing/parser.mly"
+                   (">")
+# 25025 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 25030 "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 : unit = 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) = let _1 = 
+# 3458 "parsing/parser.mly"
+                  ("or")
+# 25055 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 25060 "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 : unit = 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) = let _1 = 
+# 3459 "parsing/parser.mly"
+                  ("||")
+# 25085 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 25090 "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 : unit = 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) = let _1 = 
+# 3460 "parsing/parser.mly"
+                   ("&")
+# 25115 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 25120 "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 : unit = 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) = let _1 = 
+# 3461 "parsing/parser.mly"
+                  ("&&")
+# 25145 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 25150 "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 : unit = 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) = let _1 = 
+# 3462 "parsing/parser.mly"
+                  (":=")
+# 25175 "parsing/parser.ml"
+         in
+        
+# 3440 "parsing/parser.mly"
+                                                ( _1 )
+# 25180 "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 : unit = 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 : (bool) = 
+# 3344 "parsing/parser.mly"
+                                                ( true )
+# 25205 "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 : (bool) = 
+# 3345 "parsing/parser.mly"
+                                                ( false )
+# 25223 "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 : (unit option) = 
+# 114 ""
+    ( None )
+# 25241 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : unit = 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 : (unit option) = 
+# 116 ""
+    ( Some x )
+# 25266 "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 : (unit option) = 
+# 114 ""
+    ( None )
+# 25284 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : unit = 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 : (unit option) = 
+# 116 ""
+    ( Some x )
+# 25309 "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 : (string Asttypes.loc option) = 
+# 114 ""
+    ( None )
+# 25327 "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 = _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 _1_inlined1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 25354 "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 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
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 25369 "parsing/parser.ml"
+            
+          in
+          
+# 183 ""
+    ( x )
+# 25375 "parsing/parser.ml"
+          
+        in
+        
+# 116 ""
+    ( Some x )
+# 25381 "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.core_type option) = 
+# 114 ""
+    ( None )
+# 25399 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.core_type) = Obj.magic x 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_x_ in
+        let _v : (Parsetree.core_type option) = let x = 
+# 183 ""
+    ( x )
+# 25431 "parsing/parser.ml"
+         in
+        
+# 116 ""
+    ( Some x )
+# 25436 "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.expression option) = 
+# 114 ""
+    ( None )
+# 25454 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.expression) = Obj.magic x 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_x_ in
+        let _v : (Parsetree.expression option) = let x = 
+# 183 ""
+    ( x )
+# 25486 "parsing/parser.ml"
+         in
+        
+# 116 ""
+    ( Some x )
+# 25491 "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.module_type option) = 
+# 114 ""
+    ( None )
+# 25509 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.module_type) = Obj.magic x 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_x_ in
+        let _v : (Parsetree.module_type option) = let x = 
+# 183 ""
+    ( x )
+# 25541 "parsing/parser.ml"
+         in
+        
+# 116 ""
+    ( Some x )
+# 25546 "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.pattern option) = 
+# 114 ""
+    ( None )
+# 25564 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.pattern) = Obj.magic x 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_x_ in
+        let _v : (Parsetree.pattern option) = let x = 
+# 183 ""
+    ( x )
+# 25596 "parsing/parser.ml"
+         in
+        
+# 116 ""
+    ( Some x )
+# 25601 "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.expression option) = 
+# 114 ""
+    ( None )
+# 25619 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.expression) = Obj.magic x 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_x_ in
+        let _v : (Parsetree.expression option) = let x = 
+# 183 ""
+    ( x )
+# 25651 "parsing/parser.ml"
+         in
+        
+# 116 ""
+    ( Some x )
+# 25656 "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.core_type option * Parsetree.core_type option) option) = 
+# 114 ""
+    ( None )
+# 25674 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : (Parsetree.core_type option * Parsetree.core_type option) = 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 : ((Parsetree.core_type option * Parsetree.core_type option) option) = 
+# 116 ""
+    ( Some x )
+# 25699 "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 : (
+# 664 "parsing/parser.mly"
+       (string)
+# 25720 "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) = 
+# 3645 "parsing/parser.mly"
+                                                ( _1 )
+# 25728 "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 = _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 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 25762 "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) = 
+# 3646 "parsing/parser.mly"
+                                                ( _2 )
+# 25771 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 = _3;
+              MenhirLib.EngineTypes.startp = _startpos__3_;
+              MenhirLib.EngineTypes.endp = _endpos__3_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = me;
+                MenhirLib.EngineTypes.startp = _startpos_me_;
+                MenhirLib.EngineTypes.endp = _endpos_me_;
+                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 _5 : unit = Obj.magic _5 in
+        let mty : (Parsetree.module_type) = Obj.magic mty in
+        let _3 : unit = Obj.magic _3 in
+        let me : (Parsetree.module_expr) = Obj.magic me 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 : (Parsetree.module_expr) = let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1249 "parsing/parser.mly"
+      ( mkmod ~loc:_sloc (Pmod_constraint(me, mty)) )
+# 25827 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.module_type) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (Parsetree.module_expr) = 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 : (Parsetree.module_expr) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
+        let _loc__1_ = (_startpos__1_, _endpos__1_) in
+        
+# 1251 "parsing/parser.mly"
+      ( unclosed "(" _loc__1_ ")" _loc__5_ )
+# 25882 "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 = me;
+            MenhirLib.EngineTypes.startp = _startpos_me_;
+            MenhirLib.EngineTypes.endp = _endpos_me_;
+            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 me : (Parsetree.module_expr) = Obj.magic me 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.module_expr) = 
+# 1254 "parsing/parser.mly"
+      ( me (* TODO consider reloc *) )
+# 25921 "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 = _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 : (Parsetree.module_expr) = 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.module_expr) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
+        let _loc__1_ = (_startpos__1_, _endpos__1_) in
+        
+# 1256 "parsing/parser.mly"
+      ( unclosed "(" _loc__1_ ")" _loc__3_ )
+# 25962 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          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 = _;
+              MenhirLib.EngineTypes.semv = _1_inlined1;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+              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 _5 : unit = Obj.magic _5 in
+        let e : (Parsetree.expression) = Obj.magic e in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 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 : (Parsetree.module_expr) = let e = 
+# 1273 "parsing/parser.mly"
+      ( e )
+# 26015 "parsing/parser.ml"
+         in
+        let attrs =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 26022 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1260 "parsing/parser.mly"
+      ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
+# 26031 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          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.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _2_inlined1;
+              MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+              MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
+              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 = _;
+                  MenhirLib.EngineTypes.semv = _1_inlined1;
+                  MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+                  MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+                  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 _5 : unit = Obj.magic _5 in
+        let _1_inlined2 : (Parsetree.module_type) = Obj.magic _1_inlined2 in
+        let _2_inlined1 : unit = Obj.magic _2_inlined1 in
+        let e : (Parsetree.expression) = Obj.magic e in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 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 : (Parsetree.module_expr) = let e =
+          let (_endpos__1_, _startpos__1_, _1, _2) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2, _2_inlined1) in
+          let ty =
+            let _1 =
+              let _1 = 
+# 3320 "parsing/parser.mly"
+      ( Ptyp_package (package_type_of_module_type _1) )
+# 26102 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 26110 "parsing/parser.ml"
+              
+            in
+            
+# 3321 "parsing/parser.mly"
+      ( _1 )
+# 26116 "parsing/parser.ml"
+            
+          in
+          let _endpos_ty_ = _endpos__1_ in
+          let _endpos = _endpos_ty_ in
+          let _startpos = _startpos_e_ in
+          let _loc = (_startpos, _endpos) in
+          
+# 1275 "parsing/parser.mly"
+      ( ghexp ~loc:_loc (Pexp_constraint (e, ty)) )
+# 26126 "parsing/parser.ml"
+          
+        in
+        let attrs =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 26134 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1260 "parsing/parser.mly"
+      ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
+# 26143 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              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 = _1_inlined2;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = _2_inlined1;
+                  MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+                  MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
+                  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 = _;
+                      MenhirLib.EngineTypes.semv = _1_inlined1;
+                      MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+                      MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+                      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 _5 : unit = Obj.magic _5 in
+        let _1_inlined3 : (Parsetree.module_type) = Obj.magic _1_inlined3 in
+        let _4 : unit = Obj.magic _4 in
+        let _1_inlined2 : (Parsetree.module_type) = Obj.magic _1_inlined2 in
+        let _2_inlined1 : unit = Obj.magic _2_inlined1 in
+        let e : (Parsetree.expression) = Obj.magic e in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 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 : (Parsetree.module_expr) = let e =
+          let (_endpos__1_inlined1_, _startpos__1_inlined1_, _endpos__1_, _startpos__1_, _1_inlined1, _1, _2) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined3, _1_inlined2, _2_inlined1) in
+          let ty2 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _1 =
+              let _1 = 
+# 3320 "parsing/parser.mly"
+      ( Ptyp_package (package_type_of_module_type _1) )
+# 26229 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 26237 "parsing/parser.ml"
+              
+            in
+            
+# 3321 "parsing/parser.mly"
+      ( _1 )
+# 26243 "parsing/parser.ml"
+            
+          in
+          let _endpos_ty2_ = _endpos__1_inlined1_ in
+          let ty1 =
+            let _1 =
+              let _1 = 
+# 3320 "parsing/parser.mly"
+      ( Ptyp_package (package_type_of_module_type _1) )
+# 26252 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 26260 "parsing/parser.ml"
+              
+            in
+            
+# 3321 "parsing/parser.mly"
+      ( _1 )
+# 26266 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_ty2_ in
+          let _startpos = _startpos_e_ in
+          let _loc = (_startpos, _endpos) in
+          
+# 1277 "parsing/parser.mly"
+      ( ghexp ~loc:_loc (Pexp_coerce (e, Some ty1, ty2)) )
+# 26275 "parsing/parser.ml"
+          
+        in
+        let attrs =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 26283 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1260 "parsing/parser.mly"
+      ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
+# 26292 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          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.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _2_inlined1;
+              MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+              MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
+              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 = _;
+                  MenhirLib.EngineTypes.semv = _1_inlined1;
+                  MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+                  MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+                  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 _5 : unit = Obj.magic _5 in
+        let _1_inlined2 : (Parsetree.module_type) = Obj.magic _1_inlined2 in
+        let _2_inlined1 : unit = Obj.magic _2_inlined1 in
+        let e : (Parsetree.expression) = Obj.magic e in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 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 : (Parsetree.module_expr) = let e =
+          let (_endpos__1_, _startpos__1_, _1, _2) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2, _2_inlined1) in
+          let ty2 =
+            let _1 =
+              let _1 = 
+# 3320 "parsing/parser.mly"
+      ( Ptyp_package (package_type_of_module_type _1) )
+# 26363 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 26371 "parsing/parser.ml"
+              
+            in
+            
+# 3321 "parsing/parser.mly"
+      ( _1 )
+# 26377 "parsing/parser.ml"
+            
+          in
+          let _endpos_ty2_ = _endpos__1_ in
+          let _endpos = _endpos_ty2_ in
+          let _startpos = _startpos_e_ in
+          let _loc = (_startpos, _endpos) in
+          
+# 1279 "parsing/parser.mly"
+      ( ghexp ~loc:_loc (Pexp_coerce (e, None, ty2)) )
+# 26387 "parsing/parser.ml"
+          
+        in
+        let attrs =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 26395 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1260 "parsing/parser.mly"
+      ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
+# 26404 "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 = _6;
+          MenhirLib.EngineTypes.startp = _startpos__6_;
+          MenhirLib.EngineTypes.endp = _endpos__6_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _5;
+            MenhirLib.EngineTypes.startp = _startpos__5_;
+            MenhirLib.EngineTypes.endp = _endpos__5_;
+            MenhirLib.EngineTypes.next = {
+              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 = _1_inlined1;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+                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 _6 : unit = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression) = Obj.magic _4 in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 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__6_ in
+        let _v : (Parsetree.module_expr) = let _3 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 26466 "parsing/parser.ml"
+          
+        in
+        let _loc__6_ = (_startpos__6_, _endpos__6_) in
+        let _loc__1_ = (_startpos__1_, _endpos__1_) in
+        
+# 1262 "parsing/parser.mly"
+      ( unclosed "(" _loc__1_ ")" _loc__6_ )
+# 26474 "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 = _6;
+          MenhirLib.EngineTypes.startp = _startpos__6_;
+          MenhirLib.EngineTypes.endp = _endpos__6_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _5;
+            MenhirLib.EngineTypes.startp = _startpos__5_;
+            MenhirLib.EngineTypes.endp = _endpos__5_;
+            MenhirLib.EngineTypes.next = {
+              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 = _1_inlined1;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+                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 _6 : unit = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression) = Obj.magic _4 in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 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__6_ in
+        let _v : (Parsetree.module_expr) = let _3 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 26536 "parsing/parser.ml"
+          
+        in
+        let _loc__6_ = (_startpos__6_, _endpos__6_) in
+        let _loc__1_ = (_startpos__1_, _endpos__1_) in
+        
+# 1264 "parsing/parser.mly"
+      ( unclosed "(" _loc__1_ ")" _loc__6_ )
+# 26544 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 = _1_inlined1;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+              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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression) = Obj.magic _4 in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 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 : (Parsetree.module_expr) = let _3 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 26599 "parsing/parser.ml"
+          
+        in
+        let _loc__5_ = (_startpos__5_, _endpos__5_) in
+        let _loc__1_ = (_startpos__1_, _endpos__1_) in
+        
+# 1266 "parsing/parser.mly"
+      ( unclosed "(" _loc__1_ ")" _loc__5_ )
+# 26607 "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 = _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 _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (
+# 801 "parsing/parser.mly"
+      (Longident.t)
+# 26639 "parsing/parser.ml"
+        ) = 
+# 1170 "parsing/parser.mly"
+    ( _1 )
+# 26643 "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 = _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 _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (
+# 791 "parsing/parser.mly"
+      (Longident.t)
+# 26675 "parsing/parser.ml"
+        ) = 
+# 1155 "parsing/parser.mly"
+    ( _1 )
+# 26679 "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 = _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 _2 : unit = Obj.magic _2 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__2_ in
+        let _v : (
+# 785 "parsing/parser.mly"
+      (Parsetree.core_type)
+# 26711 "parsing/parser.ml"
+        ) = 
+# 1130 "parsing/parser.mly"
+    ( _1 )
+# 26715 "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 = _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 _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__2_ in
+        let _v : (
+# 787 "parsing/parser.mly"
+      (Parsetree.expression)
+# 26747 "parsing/parser.ml"
+        ) = 
+# 1135 "parsing/parser.mly"
+    ( _1 )
+# 26751 "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 = _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 _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (
+# 797 "parsing/parser.mly"
+      (Longident.t)
+# 26783 "parsing/parser.ml"
+        ) = 
+# 1160 "parsing/parser.mly"
+    ( _1 )
+# 26787 "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 = _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 _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (
+# 799 "parsing/parser.mly"
+      (Longident.t)
+# 26819 "parsing/parser.ml"
+        ) = 
+# 1165 "parsing/parser.mly"
+    ( _1 )
+# 26823 "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 = _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 _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (
+# 795 "parsing/parser.mly"
+      (Longident.t)
+# 26855 "parsing/parser.ml"
+        ) = 
+# 1145 "parsing/parser.mly"
+    ( _1 )
+# 26859 "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 = _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 _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__2_ in
+        let _v : (
+# 789 "parsing/parser.mly"
+      (Parsetree.pattern)
+# 26891 "parsing/parser.ml"
+        ) = 
+# 1140 "parsing/parser.mly"
+    ( _1 )
+# 26895 "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 = _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 _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (
+# 793 "parsing/parser.mly"
+      (Longident.t)
+# 26927 "parsing/parser.ml"
+        ) = 
+# 1150 "parsing/parser.mly"
+    ( _1 )
+# 26931 "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 = _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 : (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
+          
+# 2631 "parsing/parser.mly"
+      ( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) )
+# 26975 "parsing/parser.ml"
+          
+        in
+        
+# 2619 "parsing/parser.mly"
+      ( _1 )
+# 26981 "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 = _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 _2 : (Parsetree.attribute) = 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__2_ in
+        let _v : (Parsetree.pattern) = let _1 = 
+# 2633 "parsing/parser.mly"
+      ( Pat.attr _1 _2 )
+# 27013 "parsing/parser.ml"
+         in
+        
+# 2619 "parsing/parser.mly"
+      ( _1 )
+# 27018 "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.pattern) = 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 = 
+# 2635 "parsing/parser.mly"
+      ( _1 )
+# 27043 "parsing/parser.ml"
+         in
+        
+# 2619 "parsing/parser.mly"
+      ( _1 )
+# 27048 "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 = _1_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+          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 _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 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__1_inlined1_ in
+        let _v : (Parsetree.pattern) = let _1 =
+          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
+                
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 27095 "parsing/parser.ml"
+                
+              in
+              
+# 2638 "parsing/parser.mly"
+        ( Ppat_alias(_1, _3) )
+# 27101 "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
+            
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 27111 "parsing/parser.ml"
+            
+          in
+          
+# 2649 "parsing/parser.mly"
+    ( _1 )
+# 27117 "parsing/parser.ml"
+          
+        in
+        
+# 2619 "parsing/parser.mly"
+      ( _1 )
+# 27123 "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 = _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 _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
+              
+# 2640 "parsing/parser.mly"
+        ( expecting _loc__3_ "identifier" )
+# 27166 "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
+            
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 27176 "parsing/parser.ml"
+            
+          in
+          
+# 2649 "parsing/parser.mly"
+    ( _1 )
+# 27182 "parsing/parser.ml"
+          
+        in
+        
+# 2619 "parsing/parser.mly"
+      ( _1 )
+# 27188 "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.pattern list) = 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 _1 =
+            let _1 = 
+# 2642 "parsing/parser.mly"
+        ( Ppat_tuple(List.rev _1) )
+# 27215 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 27223 "parsing/parser.ml"
+            
+          in
+          
+# 2649 "parsing/parser.mly"
+    ( _1 )
+# 27229 "parsing/parser.ml"
+          
+        in
+        
+# 2619 "parsing/parser.mly"
+      ( _1 )
+# 27235 "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 = _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 _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
+              
+# 2644 "parsing/parser.mly"
+        ( expecting _loc__3_ "pattern" )
+# 27278 "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
+            
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 27288 "parsing/parser.ml"
+            
+          in
+          
+# 2649 "parsing/parser.mly"
+    ( _1 )
+# 27294 "parsing/parser.ml"
+          
+        in
+        
+# 2619 "parsing/parser.mly"
+      ( _1 )
+# 27300 "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 = _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 : (Parsetree.pattern) = let _1 =
+          let _1 =
+            let _1 = 
+# 2646 "parsing/parser.mly"
+        ( Ppat_or(_1, _3) )
+# 27341 "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
+            
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 27350 "parsing/parser.ml"
+            
+          in
+          
+# 2649 "parsing/parser.mly"
+    ( _1 )
+# 27356 "parsing/parser.ml"
+          
+        in
+        
+# 2619 "parsing/parser.mly"
+      ( _1 )
+# 27362 "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 = _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 _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
+              
+# 2648 "parsing/parser.mly"
+        ( expecting _loc__3_ "pattern" )
+# 27405 "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
+            
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 27415 "parsing/parser.ml"
+            
+          in
+          
+# 2649 "parsing/parser.mly"
+    ( _1 )
+# 27421 "parsing/parser.ml"
+          
+        in
+        
+# 2619 "parsing/parser.mly"
+      ( _1 )
+# 27427 "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 = _1_inlined2;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+            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.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 _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 _2 =
+          let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 27477 "parsing/parser.ml"
+            
+          in
+          
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 27483 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__3_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2621 "parsing/parser.mly"
+      ( mkpat_attrs ~loc:_sloc (Ppat_exception _3) _2)
+# 27492 "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 = _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 list) = 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 list) = 
+# 2745 "parsing/parser.mly"
+                                                ( _3 :: _1 )
+# 27531 "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 = _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 : (Parsetree.pattern list) = 
+# 2746 "parsing/parser.mly"
+                                                ( [_3; _1] )
+# 27570 "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 = _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 _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
+        
+# 2747 "parsing/parser.mly"
+                                                ( expecting _loc__3_ "pattern" )
+# 27610 "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 = _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 list) = 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 list) = 
+# 2745 "parsing/parser.mly"
+                                                ( _3 :: _1 )
+# 27649 "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 = _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 : (Parsetree.pattern list) = 
+# 2746 "parsing/parser.mly"
+                                                ( [_3; _1] )
+# 27688 "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 = _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 _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
+        
+# 2747 "parsing/parser.mly"
+                                                ( expecting _loc__3_ "pattern" )
+# 27728 "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.pattern) = 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) = 
+# 2654 "parsing/parser.mly"
+      ( _1 )
+# 27753 "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 = _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 _2 : (Parsetree.pattern) = Obj.magic _2 in
+        let _1 : (Longident.t) = 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.pattern) = let _1 =
+          let _1 =
+            let _1 =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 27791 "parsing/parser.ml"
+              
+            in
+            
+# 2657 "parsing/parser.mly"
+        ( Ppat_construct(_1, Some _2) )
+# 27797 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 27807 "parsing/parser.ml"
+          
+        in
+        
+# 2660 "parsing/parser.mly"
+      ( _1 )
+# 27813 "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 = _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 _2 : (Parsetree.pattern) = Obj.magic _2 in
+        let _1 : (Asttypes.label) = 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.pattern) = let _1 =
+          let _1 = 
+# 2659 "parsing/parser.mly"
+        ( Ppat_variant(_1, Some _2) )
+# 27846 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 27855 "parsing/parser.ml"
+          
+        in
+        
+# 2660 "parsing/parser.mly"
+      ( _1 )
+# 27861 "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 = _1_inlined2;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+            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.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 _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 _2 =
+          let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 27911 "parsing/parser.ml"
+            
+          in
+          
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 27917 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__3_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2662 "parsing/parser.mly"
+      ( mkpat_attrs ~loc:_sloc (Ppat_lazy _3) _2)
+# 27926 "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 = _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 : (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
+          
+# 2631 "parsing/parser.mly"
+      ( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) )
+# 27970 "parsing/parser.ml"
+          
+        in
+        
+# 2626 "parsing/parser.mly"
+      ( _1 )
+# 27976 "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 = _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 _2 : (Parsetree.attribute) = 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__2_ in
+        let _v : (Parsetree.pattern) = let _1 = 
+# 2633 "parsing/parser.mly"
+      ( Pat.attr _1 _2 )
+# 28008 "parsing/parser.ml"
+         in
+        
+# 2626 "parsing/parser.mly"
+      ( _1 )
+# 28013 "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.pattern) = 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 = 
+# 2635 "parsing/parser.mly"
+      ( _1 )
+# 28038 "parsing/parser.ml"
+         in
+        
+# 2626 "parsing/parser.mly"
+      ( _1 )
+# 28043 "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 = _1_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+          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 _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 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__1_inlined1_ in
+        let _v : (Parsetree.pattern) = let _1 =
+          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
+                
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 28090 "parsing/parser.ml"
+                
+              in
+              
+# 2638 "parsing/parser.mly"
+        ( Ppat_alias(_1, _3) )
+# 28096 "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
+            
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 28106 "parsing/parser.ml"
+            
+          in
+          
+# 2649 "parsing/parser.mly"
+    ( _1 )
+# 28112 "parsing/parser.ml"
+          
+        in
+        
+# 2626 "parsing/parser.mly"
+      ( _1 )
+# 28118 "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 = _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 _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
+              
+# 2640 "parsing/parser.mly"
+        ( expecting _loc__3_ "identifier" )
+# 28161 "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
+            
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 28171 "parsing/parser.ml"
+            
+          in
+          
+# 2649 "parsing/parser.mly"
+    ( _1 )
+# 28177 "parsing/parser.ml"
+          
+        in
+        
+# 2626 "parsing/parser.mly"
+      ( _1 )
+# 28183 "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.pattern list) = 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 _1 =
+            let _1 = 
+# 2642 "parsing/parser.mly"
+        ( Ppat_tuple(List.rev _1) )
+# 28210 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 28218 "parsing/parser.ml"
+            
+          in
+          
+# 2649 "parsing/parser.mly"
+    ( _1 )
+# 28224 "parsing/parser.ml"
+          
+        in
+        
+# 2626 "parsing/parser.mly"
+      ( _1 )
+# 28230 "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 = _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 _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
+              
+# 2644 "parsing/parser.mly"
+        ( expecting _loc__3_ "pattern" )
+# 28273 "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
+            
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 28283 "parsing/parser.ml"
+            
+          in
+          
+# 2649 "parsing/parser.mly"
+    ( _1 )
+# 28289 "parsing/parser.ml"
+          
+        in
+        
+# 2626 "parsing/parser.mly"
+      ( _1 )
+# 28295 "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 = _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 : (Parsetree.pattern) = let _1 =
+          let _1 =
+            let _1 = 
+# 2646 "parsing/parser.mly"
+        ( Ppat_or(_1, _3) )
+# 28336 "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
+            
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 28345 "parsing/parser.ml"
+            
+          in
+          
+# 2649 "parsing/parser.mly"
+    ( _1 )
+# 28351 "parsing/parser.ml"
+          
+        in
+        
+# 2626 "parsing/parser.mly"
+      ( _1 )
+# 28357 "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 = _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 _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
+              
+# 2648 "parsing/parser.mly"
+        ( expecting _loc__3_ "pattern" )
+# 28400 "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
+            
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 28410 "parsing/parser.ml"
+            
+          in
+          
+# 2649 "parsing/parser.mly"
+    ( _1 )
+# 28416 "parsing/parser.ml"
+          
+        in
+        
+# 2626 "parsing/parser.mly"
+      ( _1 )
+# 28422 "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 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 28443 "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 _1 =
+            let _1 =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 28457 "parsing/parser.ml"
+              
+            in
+            
+# 2104 "parsing/parser.mly"
+                        ( Ppat_var _1 )
+# 28463 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 28472 "parsing/parser.ml"
+          
+        in
+        
+# 2106 "parsing/parser.mly"
+    ( _1 )
+# 28478 "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 : unit = 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 _1 = 
+# 2105 "parsing/parser.mly"
+                        ( Ppat_any )
+# 28504 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 28512 "parsing/parser.ml"
+          
+        in
+        
+# 2106 "parsing/parser.mly"
+    ( _1 )
+# 28518 "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.structure) = 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.payload) = 
+# 3755 "parsing/parser.mly"
+              ( PStr _1 )
+# 28543 "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 = _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 _2 : (Parsetree.signature) = 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.payload) = 
+# 3756 "parsing/parser.mly"
+                    ( PSig _2 )
+# 28575 "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 = _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 _2 : (Parsetree.core_type) = 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.payload) = 
+# 3757 "parsing/parser.mly"
+                    ( PTyp _2 )
+# 28607 "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 = _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 _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__2_ in
+        let _v : (Parsetree.payload) = 
+# 3758 "parsing/parser.mly"
+                     ( PPat (_2, None) )
+# 28639 "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.expression) = 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__4_ in
+        let _v : (Parsetree.payload) = 
+# 3759 "parsing/parser.mly"
+                                   ( PPat (_2, Some _4) )
+# 28685 "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) = 
+# 3158 "parsing/parser.mly"
+    ( _1 )
+# 28710 "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 ""
+    ( List.rev xs )
+# 28753 "parsing/parser.ml"
+                 in
+                
+# 915 "parsing/parser.mly"
+    ( xs )
+# 28758 "parsing/parser.ml"
+                
+              in
+              
+# 3150 "parsing/parser.mly"
+    ( _1 )
+# 28764 "parsing/parser.ml"
+              
+            in
+            
+# 3154 "parsing/parser.mly"
+    ( Ptyp_poly(_1, _3) )
+# 28770 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 28780 "parsing/parser.ml"
+          
+        in
+        
+# 3160 "parsing/parser.mly"
+    ( _1 )
+# 28786 "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) = let _1 = 
+# 3189 "parsing/parser.mly"
+    ( _1 )
+# 28811 "parsing/parser.ml"
+         in
+        
+# 3158 "parsing/parser.mly"
+    ( _1 )
+# 28816 "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 = _1;
+          MenhirLib.EngineTypes.startp = _startpos__1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_;
+          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 _1 : (Parsetree.core_type) = Obj.magic _1 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__1_ in
+        let _v : (Parsetree.core_type) = let _1 =
+          let _1 =
+            let _3 = 
+# 3189 "parsing/parser.mly"
+    ( _1 )
+# 28857 "parsing/parser.ml"
+             in
+            let _1 =
+              let _1 =
+                let xs = 
+# 253 ""
+    ( List.rev xs )
+# 28864 "parsing/parser.ml"
+                 in
+                
+# 915 "parsing/parser.mly"
+    ( xs )
+# 28869 "parsing/parser.ml"
+                
+              in
+              
+# 3150 "parsing/parser.mly"
+    ( _1 )
+# 28875 "parsing/parser.ml"
+              
+            in
+            
+# 3154 "parsing/parser.mly"
+    ( Ptyp_poly(_1, _3) )
+# 28881 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 28891 "parsing/parser.ml"
+          
+        in
+        
+# 3160 "parsing/parser.mly"
+    ( _1 )
+# 28897 "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 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.payload) = Obj.magic _3 in
+        let _2 : (string Asttypes.loc) = 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.attribute) = let _endpos = _endpos__4_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3718 "parsing/parser.mly"
+    ( Attr.mk ~loc:(make_loc _sloc) _2 _3 )
+# 28946 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = prim;
+            MenhirLib.EngineTypes.startp = _startpos_prim_;
+            MenhirLib.EngineTypes.endp = _endpos_prim_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _7;
+              MenhirLib.EngineTypes.startp = _startpos__7_;
+              MenhirLib.EngineTypes.endp = _endpos__7_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = ty;
+                MenhirLib.EngineTypes.startp = _startpos_ty_;
+                MenhirLib.EngineTypes.endp = _endpos_ty_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = _5;
+                  MenhirLib.EngineTypes.startp = _startpos__5_;
+                  MenhirLib.EngineTypes.endp = _endpos__5_;
+                  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.next = {
+                      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 = _;
+                        MenhirLib.EngineTypes.semv = ext;
+                        MenhirLib.EngineTypes.startp = _startpos_ext_;
+                        MenhirLib.EngineTypes.endp = _endpos_ext_;
+                        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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let prim : (string list) = Obj.magic prim in
+        let _7 : unit = Obj.magic _7 in
+        let ty : (Parsetree.core_type) = Obj.magic ty in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined2 : (Asttypes.label) = 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
+        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_inlined3_ in
+        let _v : (Parsetree.value_description * string Asttypes.loc option) = let attrs2 =
+          let _1 = _1_inlined3 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 29029 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 29041 "parsing/parser.ml"
+          
+        in
+        let attrs1 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 29049 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_attrs2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2806 "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 )
+# 29062 "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 : (Asttypes.private_flag) = let _1 = 
+# 3586 "parsing/parser.mly"
+                                                ( Public )
+# 29080 "parsing/parser.ml"
+         in
+        
+# 3583 "parsing/parser.mly"
+    ( _1 )
+# 29085 "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 : unit = 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.private_flag) = let _1 = 
+# 3587 "parsing/parser.mly"
+                                                ( Private )
+# 29110 "parsing/parser.ml"
+         in
+        
+# 3583 "parsing/parser.mly"
+    ( _1 )
+# 29115 "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 : (Asttypes.private_flag * Asttypes.virtual_flag) = 
+# 3609 "parsing/parser.mly"
+                 ( Public, Concrete )
+# 29133 "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 : unit = 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.private_flag * Asttypes.virtual_flag) = 
+# 3610 "parsing/parser.mly"
+            ( Private, Concrete )
+# 29158 "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 : unit = 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.private_flag * Asttypes.virtual_flag) = 
+# 3611 "parsing/parser.mly"
+            ( Public, Virtual )
+# 29183 "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 = _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 _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__2_ in
+        let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = 
+# 3612 "parsing/parser.mly"
+                    ( Private, Virtual )
+# 29215 "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 = _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 _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__2_ in
+        let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = 
+# 3613 "parsing/parser.mly"
+                    ( Private, Virtual )
+# 29247 "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 : (Asttypes.rec_flag) = 
+# 3566 "parsing/parser.mly"
+                                                ( Nonrecursive )
+# 29265 "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 : unit = 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.rec_flag) = 
+# 3567 "parsing/parser.mly"
+                                                ( Recursive )
+# 29290 "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 = fields;
+          MenhirLib.EngineTypes.startp = _startpos_fields_;
+          MenhirLib.EngineTypes.endp = _endpos_fields_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let fields : ((Longident.t Asttypes.loc * Parsetree.expression) list) = Obj.magic fields in
+        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 ""
+    ( None )
+# 29316 "parsing/parser.ml"
+         in
+        
+# 2551 "parsing/parser.mly"
+    ( eo, fields )
+# 29321 "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 = fields;
+          MenhirLib.EngineTypes.startp = _startpos_fields_;
+          MenhirLib.EngineTypes.endp = _endpos_fields_;
+          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 = x;
+              MenhirLib.EngineTypes.startp = _startpos_x_;
+              MenhirLib.EngineTypes.endp = _endpos_x_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let fields : ((Longident.t Asttypes.loc * Parsetree.expression) list) = Obj.magic fields in
+        let _2 : unit = Obj.magic _2 in
+        let x : (Parsetree.expression) = Obj.magic x in
+        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 ""
+    ( x )
+# 29362 "parsing/parser.ml"
+           in
+          
+# 126 ""
+    ( Some x )
+# 29367 "parsing/parser.ml"
+          
+        in
+        
+# 2551 "parsing/parser.mly"
+    ( eo, fields )
+# 29373 "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 = d;
+          MenhirLib.EngineTypes.startp = _startpos_d_;
+          MenhirLib.EngineTypes.endp = _endpos_d_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let d : (Ast_helper.str * Parsetree.constructor_arguments *
+  Parsetree.core_type option * Parsetree.attributes * Location.t *
+  Docstrings.info) = Obj.magic d in
+        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 = 
+# 2980 "parsing/parser.mly"
+    (
+      let cid, args, res, attrs, loc, info = d in
+      Type.constructor cid ~args ?res ~attrs ~loc ~info
+    )
+# 29403 "parsing/parser.ml"
+         in
+        
+# 1025 "parsing/parser.mly"
+      ( [x] )
+# 29408 "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 = d;
+          MenhirLib.EngineTypes.startp = _startpos_d_;
+          MenhirLib.EngineTypes.endp = _endpos_d_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let d : (Ast_helper.str * Parsetree.constructor_arguments *
+  Parsetree.core_type option * Parsetree.attributes * Location.t *
+  Docstrings.info) = Obj.magic d in
+        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 = 
+# 2980 "parsing/parser.mly"
+    (
+      let cid, args, res, attrs, loc, info = d in
+      Type.constructor cid ~args ?res ~attrs ~loc ~info
+    )
+# 29438 "parsing/parser.ml"
+         in
+        
+# 1028 "parsing/parser.mly"
+      ( [x] )
+# 29443 "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 = d;
+          MenhirLib.EngineTypes.startp = _startpos_d_;
+          MenhirLib.EngineTypes.endp = _endpos_d_;
+          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 d : (Ast_helper.str * Parsetree.constructor_arguments *
+  Parsetree.core_type option * Parsetree.attributes * Location.t *
+  Docstrings.info) = Obj.magic d in
+        let xs : (Parsetree.constructor_declaration list) = Obj.magic xs in
+        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 = 
+# 2980 "parsing/parser.mly"
+    (
+      let cid, args, res, attrs, loc, info = d in
+      Type.constructor cid ~args ?res ~attrs ~loc ~info
+    )
+# 29480 "parsing/parser.ml"
+         in
+        
+# 1032 "parsing/parser.mly"
+      ( x :: xs )
+# 29485 "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 = d;
+          MenhirLib.EngineTypes.startp = _startpos_d_;
+          MenhirLib.EngineTypes.endp = _endpos_d_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let d : (Ast_helper.str * Parsetree.constructor_arguments *
+  Parsetree.core_type option * Parsetree.attributes * Location.t *
+  Docstrings.info) = Obj.magic d in
+        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 = 
+# 3092 "parsing/parser.mly"
+    (
+      let cid, args, res, attrs, loc, info = d in
+      Te.decl cid ~args ?res ~attrs ~loc ~info
+    )
+# 29516 "parsing/parser.ml"
+           in
+          
+# 3086 "parsing/parser.mly"
+      ( _1 )
+# 29521 "parsing/parser.ml"
+          
+        in
+        
+# 1025 "parsing/parser.mly"
+      ( [x] )
+# 29527 "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.extension_constructor) = 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_constructor list) = let x = 
+# 3088 "parsing/parser.mly"
+      ( _1 )
+# 29552 "parsing/parser.ml"
+         in
+        
+# 1025 "parsing/parser.mly"
+      ( [x] )
+# 29557 "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 = d;
+          MenhirLib.EngineTypes.startp = _startpos_d_;
+          MenhirLib.EngineTypes.endp = _endpos_d_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let d : (Ast_helper.str * Parsetree.constructor_arguments *
+  Parsetree.core_type option * Parsetree.attributes * Location.t *
+  Docstrings.info) = Obj.magic d in
+        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 = 
+# 3092 "parsing/parser.mly"
+    (
+      let cid, args, res, attrs, loc, info = d in
+      Te.decl cid ~args ?res ~attrs ~loc ~info
+    )
+# 29588 "parsing/parser.ml"
+           in
+          
+# 3086 "parsing/parser.mly"
+      ( _1 )
+# 29593 "parsing/parser.ml"
+          
+        in
+        
+# 1028 "parsing/parser.mly"
+      ( [x] )
+# 29599 "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.extension_constructor) = 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_constructor list) = let x = 
+# 3088 "parsing/parser.mly"
+      ( _1 )
+# 29624 "parsing/parser.ml"
+         in
+        
+# 1028 "parsing/parser.mly"
+      ( [x] )
+# 29629 "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 = d;
+          MenhirLib.EngineTypes.startp = _startpos_d_;
+          MenhirLib.EngineTypes.endp = _endpos_d_;
+          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 d : (Ast_helper.str * Parsetree.constructor_arguments *
+  Parsetree.core_type option * Parsetree.attributes * Location.t *
+  Docstrings.info) = Obj.magic d in
+        let xs : (Parsetree.extension_constructor list) = Obj.magic xs in
+        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 = 
+# 3092 "parsing/parser.mly"
+    (
+      let cid, args, res, attrs, loc, info = d in
+      Te.decl cid ~args ?res ~attrs ~loc ~info
+    )
+# 29667 "parsing/parser.ml"
+           in
+          
+# 3086 "parsing/parser.mly"
+      ( _1 )
+# 29672 "parsing/parser.ml"
+          
+        in
+        
+# 1032 "parsing/parser.mly"
+      ( x :: xs )
+# 29678 "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 = _1;
+          MenhirLib.EngineTypes.startp = _startpos__1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_;
+          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 _1 : (Parsetree.extension_constructor) = Obj.magic _1 in
+        let xs : (Parsetree.extension_constructor list) = Obj.magic xs in
+        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 = 
+# 3088 "parsing/parser.mly"
+      ( _1 )
+# 29710 "parsing/parser.ml"
+         in
+        
+# 1032 "parsing/parser.mly"
+      ( x :: xs )
+# 29715 "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 = d;
+          MenhirLib.EngineTypes.startp = _startpos_d_;
+          MenhirLib.EngineTypes.endp = _endpos_d_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let d : (Ast_helper.str * Parsetree.constructor_arguments *
+  Parsetree.core_type option * Parsetree.attributes * Location.t *
+  Docstrings.info) = Obj.magic d in
+        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 = 
+# 3092 "parsing/parser.mly"
+    (
+      let cid, args, res, attrs, loc, info = d in
+      Te.decl cid ~args ?res ~attrs ~loc ~info
+    )
+# 29745 "parsing/parser.ml"
+         in
+        
+# 1025 "parsing/parser.mly"
+      ( [x] )
+# 29750 "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 = d;
+          MenhirLib.EngineTypes.startp = _startpos_d_;
+          MenhirLib.EngineTypes.endp = _endpos_d_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let d : (Ast_helper.str * Parsetree.constructor_arguments *
+  Parsetree.core_type option * Parsetree.attributes * Location.t *
+  Docstrings.info) = Obj.magic d in
+        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 = 
+# 3092 "parsing/parser.mly"
+    (
+      let cid, args, res, attrs, loc, info = d in
+      Te.decl cid ~args ?res ~attrs ~loc ~info
+    )
+# 29780 "parsing/parser.ml"
+         in
+        
+# 1028 "parsing/parser.mly"
+      ( [x] )
+# 29785 "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 = d;
+          MenhirLib.EngineTypes.startp = _startpos_d_;
+          MenhirLib.EngineTypes.endp = _endpos_d_;
+          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 d : (Ast_helper.str * Parsetree.constructor_arguments *
+  Parsetree.core_type option * Parsetree.attributes * Location.t *
+  Docstrings.info) = Obj.magic d in
+        let xs : (Parsetree.extension_constructor list) = Obj.magic xs in
+        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 = 
+# 3092 "parsing/parser.mly"
+    (
+      let cid, args, res, attrs, loc, info = d in
+      Te.decl cid ~args ?res ~attrs ~loc ~info
+    )
+# 29822 "parsing/parser.ml"
+         in
+        
+# 1032 "parsing/parser.mly"
+      ( x :: xs )
+# 29827 "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.core_type * Parsetree.core_type * Ast_helper.loc) list) = 
+# 891 "parsing/parser.mly"
+    ( [] )
+# 29845 "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 = _;
+              MenhirLib.EngineTypes.semv = _1_inlined1;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _1;
+                MenhirLib.EngineTypes.startp = _startpos__1_;
+                MenhirLib.EngineTypes.endp = _endpos__1_;
+                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 _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
+        let _1 : unit = Obj.magic _1 in
+        let xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.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 * Parsetree.core_type * Ast_helper.loc) list) = let x =
+          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
+            
+# 1984 "parsing/parser.mly"
+    ( _1, _3, make_loc _sloc )
+# 29904 "parsing/parser.ml"
+            
+          in
+          
+# 183 ""
+    ( x )
+# 29910 "parsing/parser.ml"
+          
+        in
+        
+# 893 "parsing/parser.mly"
+    ( x :: xs )
+# 29916 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : (Parsetree.functor_parameter) = 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 : (Parsetree.functor_parameter list) = 
+# 905 "parsing/parser.mly"
+    ( [ x ] )
+# 29941 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.functor_parameter) = Obj.magic x in
+        let xs : (Parsetree.functor_parameter list) = Obj.magic xs in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_xs_ in
+        let _endpos = _endpos_x_ in
+        let _v : (Parsetree.functor_parameter list) = 
+# 907 "parsing/parser.mly"
+    ( x :: xs )
+# 29973 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : (Asttypes.arg_label * Parsetree.expression) = 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 : ((Asttypes.arg_label * Parsetree.expression) list) = 
+# 905 "parsing/parser.mly"
+    ( [ x ] )
+# 29998 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Asttypes.arg_label * Parsetree.expression) = Obj.magic x in
+        let xs : ((Asttypes.arg_label * Parsetree.expression) list) = Obj.magic xs in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_xs_ in
+        let _endpos = _endpos_x_ in
+        let _v : ((Asttypes.arg_label * Parsetree.expression) list) = 
+# 907 "parsing/parser.mly"
+    ( x :: xs )
+# 30030 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : (Asttypes.label) = 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 : (Asttypes.label list) = 
+# 905 "parsing/parser.mly"
+    ( [ x ] )
+# 30055 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Asttypes.label) = Obj.magic x in
+        let xs : (Asttypes.label list) = Obj.magic xs in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_xs_ in
+        let _endpos = _endpos_x_ in
+        let _v : (Asttypes.label list) = 
+# 907 "parsing/parser.mly"
+    ( x :: xs )
+# 30087 "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 = _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 _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_inlined1_ in
+        let _v : (Asttypes.label Asttypes.loc list) = let x =
+          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
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 30125 "parsing/parser.ml"
+            
+          in
+          
+# 3146 "parsing/parser.mly"
+    ( _2 )
+# 30131 "parsing/parser.ml"
+          
+        in
+        
+# 905 "parsing/parser.mly"
+    ( [ x ] )
+# 30137 "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 = _1_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            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 _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 in
+        let _1 : unit = Obj.magic _1 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__1_inlined1_ in
+        let _v : (Asttypes.label Asttypes.loc list) = let x =
+          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
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 30182 "parsing/parser.ml"
+            
+          in
+          
+# 3146 "parsing/parser.mly"
+    ( _2 )
+# 30188 "parsing/parser.ml"
+          
+        in
+        
+# 907 "parsing/parser.mly"
+    ( x :: xs )
+# 30194 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : (Parsetree.case) = 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 : (Parsetree.case list) = let _1 = 
+# 124 ""
+    ( None )
+# 30219 "parsing/parser.ml"
+         in
+        
+# 996 "parsing/parser.mly"
+    ( [x] )
+# 30224 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = x_inlined1;
+            MenhirLib.EngineTypes.startp = _startpos_x_inlined1_;
+            MenhirLib.EngineTypes.endp = _endpos_x_inlined1_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let x : (Parsetree.case) = Obj.magic x in
+        let x_inlined1 : unit = Obj.magic x_inlined1 in
+        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
+          
+# 126 ""
+    ( Some x )
+# 30258 "parsing/parser.ml"
+          
+        in
+        
+# 996 "parsing/parser.mly"
+    ( [x] )
+# 30264 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.case) = Obj.magic x in
+        let _2 : unit = Obj.magic _2 in
+        let xs : (Parsetree.case list) = Obj.magic xs in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_xs_ in
+        let _endpos = _endpos_x_ in
+        let _v : (Parsetree.case list) = 
+# 1000 "parsing/parser.mly"
+    ( x :: xs )
+# 30303 "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 list) = let xs =
+          let x = 
+# 3189 "parsing/parser.mly"
+    ( _1 )
+# 30329 "parsing/parser.ml"
+           in
+          
+# 931 "parsing/parser.mly"
+    ( [ x ] )
+# 30334 "parsing/parser.ml"
+          
+        in
+        
+# 939 "parsing/parser.mly"
+    ( xs )
+# 30340 "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 = _1;
+          MenhirLib.EngineTypes.startp = _startpos__1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_;
+          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 _1 : (Parsetree.core_type) = Obj.magic _1 in
+        let _2 : unit = Obj.magic _2 in
+        let xs : (Parsetree.core_type list) = Obj.magic xs in
+        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 = 
+# 3189 "parsing/parser.mly"
+    ( _1 )
+# 30380 "parsing/parser.ml"
+           in
+          
+# 935 "parsing/parser.mly"
+    ( x :: xs )
+# 30385 "parsing/parser.ml"
+          
+        in
+        
+# 939 "parsing/parser.mly"
+    ( xs )
+# 30391 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : (Parsetree.with_constraint) = 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 : (Parsetree.with_constraint list) = let xs = 
+# 931 "parsing/parser.mly"
+    ( [ x ] )
+# 30416 "parsing/parser.ml"
+         in
+        
+# 939 "parsing/parser.mly"
+    ( xs )
+# 30421 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.with_constraint) = Obj.magic x in
+        let _2 : unit = Obj.magic _2 in
+        let xs : (Parsetree.with_constraint list) = Obj.magic xs in
+        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 = 
+# 935 "parsing/parser.mly"
+    ( x :: xs )
+# 30460 "parsing/parser.ml"
+         in
+        
+# 939 "parsing/parser.mly"
+    ( xs )
+# 30465 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : (Parsetree.row_field) = 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 : (Parsetree.row_field list) = let xs = 
+# 931 "parsing/parser.mly"
+    ( [ x ] )
+# 30490 "parsing/parser.ml"
+         in
+        
+# 939 "parsing/parser.mly"
+    ( xs )
+# 30495 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.row_field) = Obj.magic x in
+        let _2 : unit = Obj.magic _2 in
+        let xs : (Parsetree.row_field list) = Obj.magic xs in
+        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 = 
+# 935 "parsing/parser.mly"
+    ( x :: xs )
+# 30534 "parsing/parser.ml"
+         in
+        
+# 939 "parsing/parser.mly"
+    ( xs )
+# 30539 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : (Parsetree.core_type) = 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 : (Parsetree.core_type list) = let xs = 
+# 931 "parsing/parser.mly"
+    ( [ x ] )
+# 30564 "parsing/parser.ml"
+         in
+        
+# 939 "parsing/parser.mly"
+    ( xs )
+# 30569 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.core_type) = Obj.magic x in
+        let _2 : unit = Obj.magic _2 in
+        let xs : (Parsetree.core_type list) = Obj.magic xs in
+        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 = 
+# 935 "parsing/parser.mly"
+    ( x :: xs )
+# 30608 "parsing/parser.ml"
+         in
+        
+# 939 "parsing/parser.mly"
+    ( xs )
+# 30613 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : (Parsetree.core_type * Asttypes.variance) = 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 : ((Parsetree.core_type * Asttypes.variance) list) = let xs = 
+# 931 "parsing/parser.mly"
+    ( [ x ] )
+# 30638 "parsing/parser.ml"
+         in
+        
+# 939 "parsing/parser.mly"
+    ( xs )
+# 30643 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.core_type * Asttypes.variance) = Obj.magic x in
+        let _2 : unit = Obj.magic _2 in
+        let xs : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic xs in
+        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) list) = let xs = 
+# 935 "parsing/parser.mly"
+    ( x :: xs )
+# 30682 "parsing/parser.ml"
+         in
+        
+# 939 "parsing/parser.mly"
+    ( xs )
+# 30687 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : (Parsetree.core_type) = 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 : (Parsetree.core_type list) = let xs = 
+# 931 "parsing/parser.mly"
+    ( [ x ] )
+# 30712 "parsing/parser.ml"
+         in
+        
+# 939 "parsing/parser.mly"
+    ( xs )
+# 30717 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.core_type) = Obj.magic x in
+        let _2 : unit = Obj.magic _2 in
+        let xs : (Parsetree.core_type list) = Obj.magic xs in
+        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 = 
+# 935 "parsing/parser.mly"
+    ( x :: xs )
+# 30756 "parsing/parser.ml"
+         in
+        
+# 939 "parsing/parser.mly"
+    ( xs )
+# 30761 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.core_type) = Obj.magic x in
+        let _2 : unit = Obj.magic _2 in
+        let xs : (Parsetree.core_type list) = Obj.magic xs in
+        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) = 
+# 962 "parsing/parser.mly"
+    ( x :: xs )
+# 30800 "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 = x2;
+          MenhirLib.EngineTypes.startp = _startpos_x2_;
+          MenhirLib.EngineTypes.endp = _endpos_x2_;
+          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 = x1;
+              MenhirLib.EngineTypes.startp = _startpos_x1_;
+              MenhirLib.EngineTypes.endp = _endpos_x1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let x2 : (Parsetree.core_type) = Obj.magic x2 in
+        let _2 : unit = Obj.magic _2 in
+        let x1 : (Parsetree.core_type) = Obj.magic x1 in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_x1_ in
+        let _endpos = _endpos_x2_ in
+        let _v : (Parsetree.core_type list) = 
+# 966 "parsing/parser.mly"
+    ( [ x2; x1 ] )
+# 30839 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.expression) = Obj.magic x in
+        let _2 : unit = Obj.magic _2 in
+        let xs : (Parsetree.expression list) = Obj.magic xs in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_xs_ in
+        let _endpos = _endpos_x_ in
+        let _v : (Parsetree.expression list) = 
+# 962 "parsing/parser.mly"
+    ( x :: xs )
+# 30878 "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 = x2;
+          MenhirLib.EngineTypes.startp = _startpos_x2_;
+          MenhirLib.EngineTypes.endp = _endpos_x2_;
+          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 = x1;
+              MenhirLib.EngineTypes.startp = _startpos_x1_;
+              MenhirLib.EngineTypes.endp = _endpos_x1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let x2 : (Parsetree.expression) = Obj.magic x2 in
+        let _2 : unit = Obj.magic _2 in
+        let x1 : (Parsetree.expression) = Obj.magic x1 in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_x1_ in
+        let _endpos = _endpos_x2_ in
+        let _v : (Parsetree.expression list) = 
+# 966 "parsing/parser.mly"
+    ( [ x2; x1 ] )
+# 30917 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          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 x : (Parsetree.core_type) = Obj.magic x in
+        let _2 : unit = Obj.magic _2 in
+        let xs : (Parsetree.core_type list) = Obj.magic xs in
+        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) = 
+# 962 "parsing/parser.mly"
+    ( x :: xs )
+# 30956 "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 = x2;
+          MenhirLib.EngineTypes.startp = _startpos_x2_;
+          MenhirLib.EngineTypes.endp = _endpos_x2_;
+          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 = x1;
+              MenhirLib.EngineTypes.startp = _startpos_x1_;
+              MenhirLib.EngineTypes.endp = _endpos_x1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let x2 : (Parsetree.core_type) = Obj.magic x2 in
+        let _2 : unit = Obj.magic _2 in
+        let x1 : (Parsetree.core_type) = Obj.magic x1 in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_x1_ in
+        let _endpos = _endpos_x2_ in
+        let _v : (Parsetree.core_type list) = 
+# 966 "parsing/parser.mly"
+    ( [ x2; x1 ] )
+# 30995 "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.row_field) = 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.row_field) = 
+# 3329 "parsing/parser.mly"
+      ( _1 )
+# 31020 "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.row_field) = let _endpos = _endpos__1_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3331 "parsing/parser.mly"
+      ( Rf.inherit_ ~loc:(make_loc _sloc) _1 )
+# 31048 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : (Parsetree.expression) = 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 : (Parsetree.expression list) = let _2 = 
+# 124 ""
+    ( None )
+# 31073 "parsing/parser.ml"
+         in
+        
+# 983 "parsing/parser.mly"
+    ( [x] )
+# 31078 "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 = x_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos_x_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos_x_inlined1_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = x;
+            MenhirLib.EngineTypes.startp = _startpos_x_;
+            MenhirLib.EngineTypes.endp = _endpos_x_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let x_inlined1 : unit = Obj.magic x_inlined1 in
+        let x : (Parsetree.expression) = Obj.magic x in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_x_ in
+        let _endpos = _endpos_x_inlined1_ in
+        let _v : (Parsetree.expression list) = let _2 =
+          let x = x_inlined1 in
+          
+# 126 ""
+    ( Some x )
+# 31112 "parsing/parser.ml"
+          
+        in
+        
+# 983 "parsing/parser.mly"
+    ( [x] )
+# 31118 "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 = _;
+            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 = x;
+              MenhirLib.EngineTypes.startp = _startpos_x_;
+              MenhirLib.EngineTypes.endp = _endpos_x_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let xs : (Parsetree.expression list) = Obj.magic xs in
+        let _2 : unit = Obj.magic _2 in
+        let x : (Parsetree.expression) = Obj.magic x in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_x_ in
+        let _endpos = _endpos_xs_ in
+        let _v : (Parsetree.expression list) = 
+# 987 "parsing/parser.mly"
+    ( x :: xs )
+# 31157 "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 = oe;
+          MenhirLib.EngineTypes.startp = _startpos_oe_;
+          MenhirLib.EngineTypes.endp = _endpos_oe_;
+          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 oe : (Parsetree.expression option) = Obj.magic oe in
+        let _1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 31185 "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 ""
+    ( None )
+# 31193 "parsing/parser.ml"
+         in
+        let x =
+          let label =
+            let _1 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 31200 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 31208 "parsing/parser.ml"
+            
+          in
+          let _startpos_label_ = _startpos__1_ in
+          let _endpos = _endpos_oe_ in
+          let _symbolstartpos = _startpos_label_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2574 "parsing/parser.mly"
+      ( let e =
+          match oe with
+          | None ->
+              (* No expression; this is a pun. Desugar it. *)
+              exp_of_label ~loc:_sloc label
+          | Some e ->
+              e
+        in
+        label, e )
+# 31226 "parsing/parser.ml"
+          
+        in
+        
+# 983 "parsing/parser.mly"
+    ( [x] )
+# 31232 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = oe;
+            MenhirLib.EngineTypes.startp = _startpos_oe_;
+            MenhirLib.EngineTypes.endp = _endpos_oe_;
+            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 x : unit = Obj.magic x in
+        let oe : (Parsetree.expression option) = Obj.magic oe in
+        let _1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 31267 "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 = 
+# 126 ""
+    ( Some x )
+# 31275 "parsing/parser.ml"
+         in
+        let x =
+          let label =
+            let _1 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 31282 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 31290 "parsing/parser.ml"
+            
+          in
+          let _startpos_label_ = _startpos__1_ in
+          let _endpos = _endpos_oe_ in
+          let _symbolstartpos = _startpos_label_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2574 "parsing/parser.mly"
+      ( let e =
+          match oe with
+          | None ->
+              (* No expression; this is a pun. Desugar it. *)
+              exp_of_label ~loc:_sloc label
+          | Some e ->
+              e
+        in
+        label, e )
+# 31308 "parsing/parser.ml"
+          
+        in
+        
+# 983 "parsing/parser.mly"
+    ( [x] )
+# 31314 "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 = _;
+            MenhirLib.EngineTypes.semv = _2;
+            MenhirLib.EngineTypes.startp = _startpos__2_;
+            MenhirLib.EngineTypes.endp = _endpos__2_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = oe;
+              MenhirLib.EngineTypes.startp = _startpos_oe_;
+              MenhirLib.EngineTypes.endp = _endpos_oe_;
+              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 : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = Obj.magic xs in
+        let _2 : unit = Obj.magic _2 in
+        let oe : (Parsetree.expression option) = Obj.magic oe in
+        let _1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 31356 "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 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 31366 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 31374 "parsing/parser.ml"
+            
+          in
+          let _startpos_label_ = _startpos__1_ in
+          let _endpos = _endpos_oe_ in
+          let _symbolstartpos = _startpos_label_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2574 "parsing/parser.mly"
+      ( let e =
+          match oe with
+          | None ->
+              (* No expression; this is a pun. Desugar it. *)
+              exp_of_label ~loc:_sloc label
+          | Some e ->
+              e
+        in
+        label, e )
+# 31392 "parsing/parser.ml"
+          
+        in
+        
+# 987 "parsing/parser.mly"
+    ( x :: xs )
+# 31398 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let x : (Parsetree.pattern) = 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 : (Parsetree.pattern list) = let _2 = 
+# 124 ""
+    ( None )
+# 31423 "parsing/parser.ml"
+         in
+        
+# 983 "parsing/parser.mly"
+    ( [x] )
+# 31428 "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 = x_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos_x_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos_x_inlined1_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = x;
+            MenhirLib.EngineTypes.startp = _startpos_x_;
+            MenhirLib.EngineTypes.endp = _endpos_x_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let x_inlined1 : unit = Obj.magic x_inlined1 in
+        let x : (Parsetree.pattern) = Obj.magic x in
+        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
+          
+# 126 ""
+    ( Some x )
+# 31462 "parsing/parser.ml"
+          
+        in
+        
+# 983 "parsing/parser.mly"
+    ( [x] )
+# 31468 "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 = _;
+            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 = x;
+              MenhirLib.EngineTypes.startp = _startpos_x_;
+              MenhirLib.EngineTypes.endp = _endpos_x_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let xs : (Parsetree.pattern list) = Obj.magic xs in
+        let _2 : unit = Obj.magic _2 in
+        let x : (Parsetree.pattern) = Obj.magic x in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_x_ in
+        let _endpos = _endpos_xs_ in
+        let _v : (Parsetree.pattern list) = 
+# 987 "parsing/parser.mly"
+    ( x :: xs )
+# 31507 "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 = eo;
+          MenhirLib.EngineTypes.startp = _startpos_eo_;
+          MenhirLib.EngineTypes.endp = _endpos_eo_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = c;
+            MenhirLib.EngineTypes.startp = _startpos_c_;
+            MenhirLib.EngineTypes.endp = _endpos_c_;
+            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 eo : (Parsetree.expression option) = Obj.magic eo in
+        let c : ((Parsetree.core_type option * Parsetree.core_type option) option) = Obj.magic c in
+        let _1 : (Longident.t) = Obj.magic _1 in
+        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 ""
+    ( None )
+# 31546 "parsing/parser.ml"
+         in
+        let x =
+          let label =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 31556 "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
+          
+# 2557 "parsing/parser.mly"
+      ( let e =
+          match eo with
+          | None ->
+              (* No pattern; this is a pun. Desugar it. *)
+              exp_of_longident ~loc:_sloc label
+          | Some e ->
+              e
+        in
+        label, mkexp_opt_constraint ~loc:_sloc e c )
+# 31574 "parsing/parser.ml"
+          
+        in
+        
+# 983 "parsing/parser.mly"
+    ( [x] )
+# 31580 "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 = x;
+          MenhirLib.EngineTypes.startp = _startpos_x_;
+          MenhirLib.EngineTypes.endp = _endpos_x_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = eo;
+            MenhirLib.EngineTypes.startp = _startpos_eo_;
+            MenhirLib.EngineTypes.endp = _endpos_eo_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = c;
+              MenhirLib.EngineTypes.startp = _startpos_c_;
+              MenhirLib.EngineTypes.endp = _endpos_c_;
+              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 x : unit = Obj.magic x in
+        let eo : (Parsetree.expression option) = Obj.magic eo in
+        let c : ((Parsetree.core_type option * Parsetree.core_type option) option) = Obj.magic c in
+        let _1 : (Longident.t) = 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 : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 = 
+# 126 ""
+    ( Some x )
+# 31626 "parsing/parser.ml"
+         in
+        let x =
+          let label =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 31636 "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
+          
+# 2557 "parsing/parser.mly"
+      ( let e =
+          match eo with
+          | None ->
+              (* No pattern; this is a pun. Desugar it. *)
+              exp_of_longident ~loc:_sloc label
+          | Some e ->
+              e
+        in
+        label, mkexp_opt_constraint ~loc:_sloc e c )
+# 31654 "parsing/parser.ml"
+          
+        in
+        
+# 983 "parsing/parser.mly"
+    ( [x] )
+# 31660 "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 = _;
+            MenhirLib.EngineTypes.semv = _2;
+            MenhirLib.EngineTypes.startp = _startpos__2_;
+            MenhirLib.EngineTypes.endp = _endpos__2_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = eo;
+              MenhirLib.EngineTypes.startp = _startpos_eo_;
+              MenhirLib.EngineTypes.endp = _endpos_eo_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = c;
+                MenhirLib.EngineTypes.startp = _startpos_c_;
+                MenhirLib.EngineTypes.endp = _endpos_c_;
+                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 : ((Longident.t Asttypes.loc * Parsetree.expression) list) = Obj.magic xs in
+        let _2 : unit = Obj.magic _2 in
+        let eo : (Parsetree.expression option) = Obj.magic eo in
+        let c : ((Parsetree.core_type option * Parsetree.core_type option) option) = Obj.magic c in
+        let _1 : (Longident.t) = 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 : ((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
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 31718 "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
+          
+# 2557 "parsing/parser.mly"
+      ( let e =
+          match eo with
+          | None ->
+              (* No pattern; this is a pun. Desugar it. *)
+              exp_of_longident ~loc:_sloc label
+          | Some e ->
+              e
+        in
+        label, mkexp_opt_constraint ~loc:_sloc e c )
+# 31736 "parsing/parser.ml"
+          
+        in
+        
+# 987 "parsing/parser.mly"
+    ( x :: xs )
+# 31742 "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.expression) = 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.expression) = 
+# 2073 "parsing/parser.mly"
+                                  ( _1 )
+# 31767 "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 = _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 _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__2_ in
+        let _v : (Parsetree.expression) = 
+# 2074 "parsing/parser.mly"
+                                  ( _1 )
+# 31799 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (Parsetree.expression) = Obj.magic _3 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__3_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 = 
+# 2076 "parsing/parser.mly"
+    ( Pexp_sequence(_1, _3) )
+# 31839 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 31848 "parsing/parser.ml"
+          
+        in
+        
+# 2077 "parsing/parser.mly"
+    ( _1 )
+# 31854 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : (Parsetree.expression) = Obj.magic _5 in
+        let _4 : (string Asttypes.loc) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 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__5_ in
+        let _v : (Parsetree.expression) = let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2079 "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)) )
+# 31912 "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 = _1_inlined4;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined4_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined4_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = args_res;
+              MenhirLib.EngineTypes.startp = _startpos_args_res_;
+              MenhirLib.EngineTypes.endp = _endpos_args_res_;
+              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.next = {
+                  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 = _;
+                    MenhirLib.EngineTypes.semv = ext;
+                    MenhirLib.EngineTypes.startp = _startpos_ext_;
+                    MenhirLib.EngineTypes.endp = _endpos_ext_;
+                    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 _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
+        let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let args_res : (Parsetree.constructor_arguments * Parsetree.core_type option) = Obj.magic args_res in
+        let _1_inlined2 : (Asttypes.label) = 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
+        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_inlined4_ in
+        let _v : (Parsetree.type_exception * string Asttypes.loc option) = let attrs =
+          let _1 = _1_inlined4 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 31981 "parsing/parser.ml"
+          
+        in
+        let _endpos_attrs_ = _endpos__1_inlined4_ in
+        let attrs2 =
+          let _1 = _1_inlined3 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 31990 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 32001 "parsing/parser.ml"
+          
+        in
+        let attrs1 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 32009 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_attrs_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3010 "parsing/parser.mly"
+    ( let args, res = args_res in
+      let loc = make_loc _sloc in
+      let docs = symbol_docs _sloc in
+      Te.mk_exception ~attrs
+        (Te.decl id ~args ?res ~attrs:(attrs1 @ attrs2) ~loc ~docs)
+      , ext )
+# 32023 "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 = xss;
+          MenhirLib.EngineTypes.startp = _startpos_xss_;
+          MenhirLib.EngineTypes.endp = _endpos_xss_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let xss : (Parsetree.signature_item list list) = Obj.magic xss in
+        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 ""
+    ( List.flatten xss )
+# 32049 "parsing/parser.ml"
+           in
+          let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+          let _endpos = _endpos__1_ in
+          let _startpos = _startpos__1_ in
+          
+# 806 "parsing/parser.mly"
+                              ( extra_sig _startpos _endpos _1 )
+# 32057 "parsing/parser.ml"
+          
+        in
+        
+# 1542 "parsing/parser.mly"
+    ( _1 )
+# 32063 "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 = _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 _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let _1 : (Parsetree.extension) = 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.signature_item) = let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 32097 "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
+        
+# 1557 "parsing/parser.mly"
+      ( let docs = symbol_docs _sloc in
+        mksig ~loc:_sloc (Psig_extension (_1, (add_docs_attrs docs _2))) )
+# 32108 "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.attribute) = 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.signature_item) = let _1 =
+          let _1 = 
+# 1561 "parsing/parser.mly"
+        ( Psig_attribute _1 )
+# 32134 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 854 "parsing/parser.mly"
+    ( mksig ~loc:_sloc _1 )
+# 32142 "parsing/parser.ml"
+          
+        in
+        
+# 1563 "parsing/parser.mly"
+    ( _1 )
+# 32148 "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.value_description * string Asttypes.loc option) = 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.signature_item) = let _1 =
+          let _1 = 
+# 1566 "parsing/parser.mly"
+        ( psig_value _1 )
+# 32174 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 32182 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 32188 "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.value_description * string Asttypes.loc option) = 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.signature_item) = let _1 =
+          let _1 = 
+# 1568 "parsing/parser.mly"
+        ( psig_value _1 )
+# 32214 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 32222 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 32228 "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 = bs;
+          MenhirLib.EngineTypes.startp = _startpos_bs_;
+          MenhirLib.EngineTypes.endp = _endpos_bs_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = a;
+            MenhirLib.EngineTypes.startp = _startpos_a_;
+            MenhirLib.EngineTypes.endp = _endpos_a_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let bs : (Parsetree.type_declaration list) = Obj.magic bs in
+        let a : ((Asttypes.rec_flag * string Asttypes.loc option) *
+  Parsetree.type_declaration) = Obj.magic a in
+        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 _1 =
+            let _1 =
+              let _1 =
+                let _1 = 
+# 1044 "parsing/parser.mly"
+    ( let (x, b) = a in x, b :: bs )
+# 32265 "parsing/parser.ml"
+                 in
+                
+# 2842 "parsing/parser.mly"
+  ( _1 )
+# 32270 "parsing/parser.ml"
+                
+              in
+              
+# 2825 "parsing/parser.mly"
+    ( _1 )
+# 32276 "parsing/parser.ml"
+              
+            in
+            
+# 1570 "parsing/parser.mly"
+        ( psig_type _1 )
+# 32282 "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
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 32292 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 32298 "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 = bs;
+          MenhirLib.EngineTypes.startp = _startpos_bs_;
+          MenhirLib.EngineTypes.endp = _endpos_bs_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = a;
+            MenhirLib.EngineTypes.startp = _startpos_a_;
+            MenhirLib.EngineTypes.endp = _endpos_a_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let bs : (Parsetree.type_declaration list) = Obj.magic bs in
+        let a : ((Asttypes.rec_flag * string Asttypes.loc option) *
+  Parsetree.type_declaration) = Obj.magic a in
+        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 _1 =
+            let _1 =
+              let _1 =
+                let _1 = 
+# 1044 "parsing/parser.mly"
+    ( let (x, b) = a in x, b :: bs )
+# 32335 "parsing/parser.ml"
+                 in
+                
+# 2842 "parsing/parser.mly"
+  ( _1 )
+# 32340 "parsing/parser.ml"
+                
+              in
+              
+# 2830 "parsing/parser.mly"
+    ( _1 )
+# 32346 "parsing/parser.ml"
+              
+            in
+            
+# 1572 "parsing/parser.mly"
+        ( psig_typesubst _1 )
+# 32352 "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
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 32362 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 32368 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = xs;
+            MenhirLib.EngineTypes.startp = _startpos_xs_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = priv;
+              MenhirLib.EngineTypes.startp = _startpos_priv_;
+              MenhirLib.EngineTypes.endp = _endpos_priv_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _7;
+                MenhirLib.EngineTypes.startp = _startpos__7_;
+                MenhirLib.EngineTypes.endp = _endpos__7_;
+                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.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = params;
+                    MenhirLib.EngineTypes.startp = _startpos_params_;
+                    MenhirLib.EngineTypes.endp = _endpos_params_;
+                    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.next = {
+                        MenhirLib.EngineTypes.state = _;
+                        MenhirLib.EngineTypes.semv = ext;
+                        MenhirLib.EngineTypes.startp = _startpos_ext_;
+                        MenhirLib.EngineTypes.endp = _endpos_ext_;
+                        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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let xs : (Parsetree.extension_constructor list) = Obj.magic xs in
+        let priv : (Asttypes.private_flag) = Obj.magic priv in
+        let _7 : unit = Obj.magic _7 in
+        let _1_inlined2 : (Longident.t) = Obj.magic _1_inlined2 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext 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_inlined3_ in
+        let _v : (Parsetree.signature_item) = let _1 =
+          let _1 =
+            let _1 =
+              let _1 =
+                let attrs2 =
+                  let _1 = _1_inlined3 in
+                  
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 32455 "parsing/parser.ml"
+                  
+                in
+                let _endpos_attrs2_ = _endpos__1_inlined3_ in
+                let cs = 
+# 1036 "parsing/parser.mly"
+    ( List.rev xs )
+# 32462 "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
+                  
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 32472 "parsing/parser.ml"
+                  
+                in
+                let _4 = 
+# 3574 "parsing/parser.mly"
+                ( Recursive )
+# 32478 "parsing/parser.ml"
+                 in
+                let attrs1 =
+                  let _1 = _1_inlined1 in
+                  
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 32485 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos_attrs2_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 3079 "parsing/parser.mly"
+    ( let docs = symbol_docs _sloc in
+      let attrs = attrs1 @ attrs2 in
+      Te.mk tid cs ~params ~priv ~attrs ~docs,
+      ext )
+# 32497 "parsing/parser.ml"
+                
+              in
+              
+# 3066 "parsing/parser.mly"
+    ( _1 )
+# 32503 "parsing/parser.ml"
+              
+            in
+            
+# 1574 "parsing/parser.mly"
+        ( psig_typext _1 )
+# 32509 "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
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 32519 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 32525 "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 = _1_inlined4;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined4_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined4_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = xs;
+            MenhirLib.EngineTypes.startp = _startpos_xs_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = priv;
+              MenhirLib.EngineTypes.startp = _startpos_priv_;
+              MenhirLib.EngineTypes.endp = _endpos_priv_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _7;
+                MenhirLib.EngineTypes.startp = _startpos__7_;
+                MenhirLib.EngineTypes.endp = _endpos__7_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = _1_inlined3;
+                  MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+                  MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+                  MenhirLib.EngineTypes.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = params;
+                    MenhirLib.EngineTypes.startp = _startpos_params_;
+                    MenhirLib.EngineTypes.endp = _endpos_params_;
+                    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.next = {
+                        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 = _;
+                          MenhirLib.EngineTypes.semv = ext;
+                          MenhirLib.EngineTypes.startp = _startpos_ext_;
+                          MenhirLib.EngineTypes.endp = _endpos_ext_;
+                          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 _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
+        let xs : (Parsetree.extension_constructor list) = Obj.magic xs in
+        let priv : (Asttypes.private_flag) = Obj.magic priv in
+        let _7 : unit = Obj.magic _7 in
+        let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let _1_inlined2 : unit = 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
+        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_inlined4_ in
+        let _v : (Parsetree.signature_item) = let _1 =
+          let _1 =
+            let _1 =
+              let _1 =
+                let attrs2 =
+                  let _1 = _1_inlined4 in
+                  
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 32619 "parsing/parser.ml"
+                  
+                in
+                let _endpos_attrs2_ = _endpos__1_inlined4_ in
+                let cs = 
+# 1036 "parsing/parser.mly"
+    ( List.rev xs )
+# 32626 "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
+                  
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 32636 "parsing/parser.ml"
+                  
+                in
+                let _4 =
+                  let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+                  let _endpos = _endpos__1_ in
+                  let _startpos = _startpos__1_ in
+                  let _loc = (_startpos, _endpos) in
+                  
+# 3575 "parsing/parser.mly"
+                ( not_expecting _loc "nonrec flag" )
+# 32647 "parsing/parser.ml"
+                  
+                in
+                let attrs1 =
+                  let _1 = _1_inlined1 in
+                  
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 32655 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos_attrs2_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 3079 "parsing/parser.mly"
+    ( let docs = symbol_docs _sloc in
+      let attrs = attrs1 @ attrs2 in
+      Te.mk tid cs ~params ~priv ~attrs ~docs,
+      ext )
+# 32667 "parsing/parser.ml"
+                
+              in
+              
+# 3066 "parsing/parser.mly"
+    ( _1 )
+# 32673 "parsing/parser.ml"
+              
+            in
+            
+# 1574 "parsing/parser.mly"
+        ( psig_typext _1 )
+# 32679 "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
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 32689 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 32695 "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.type_exception * string Asttypes.loc option) = 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.signature_item) = let _1 =
+          let _1 = 
+# 1576 "parsing/parser.mly"
+        ( psig_exception _1 )
+# 32721 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 32729 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 32735 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = body;
+            MenhirLib.EngineTypes.startp = _startpos_body_;
+            MenhirLib.EngineTypes.endp = _endpos_body_;
+            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.next = {
+                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 = _;
+                  MenhirLib.EngineTypes.semv = ext;
+                  MenhirLib.EngineTypes.startp = _startpos_ext_;
+                  MenhirLib.EngineTypes.endp = _endpos_ext_;
+                  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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let body : (Parsetree.module_type) = Obj.magic body in
+        let _1_inlined2 : (string option) = 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
+        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_inlined3_ in
+        let _v : (Parsetree.signature_item) = let _1 =
+          let _1 =
+            let _1 =
+              let attrs2 =
+                let _1 = _1_inlined3 in
+                
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 32800 "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
+                
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 32812 "parsing/parser.ml"
+                
+              in
+              let attrs1 =
+                let _1 = _1_inlined1 in
+                
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 32820 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos_attrs2_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1605 "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
+  )
+# 32834 "parsing/parser.ml"
+              
+            in
+            
+# 1578 "parsing/parser.mly"
+        ( let (body, ext) = _1 in (Psig_module body, ext) )
+# 32840 "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
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 32850 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 32856 "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 = _1_inlined4;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined4_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined4_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              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.next = {
+                  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 = _;
+                    MenhirLib.EngineTypes.semv = ext;
+                    MenhirLib.EngineTypes.startp = _startpos_ext_;
+                    MenhirLib.EngineTypes.endp = _endpos_ext_;
+                    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 _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
+        let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined2 : (string option) = 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
+        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_inlined4_ in
+        let _v : (Parsetree.signature_item) = let _1 =
+          let _1 =
+            let _1 =
+              let attrs2 =
+                let _1 = _1_inlined4 in
+                
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 32928 "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
+                  
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 32941 "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
+                
+# 1641 "parsing/parser.mly"
+    ( Mty.alias ~loc:(make_loc _sloc) id )
+# 32951 "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
+                
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 32962 "parsing/parser.ml"
+                
+              in
+              let attrs1 =
+                let _1 = _1_inlined1 in
+                
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 32970 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos_attrs2_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1632 "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
+  )
+# 32984 "parsing/parser.ml"
+              
+            in
+            
+# 1580 "parsing/parser.mly"
+        ( let (body, ext) = _1 in (Psig_module body, ext) )
+# 32990 "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
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 33000 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 33006 "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.module_substitution * string Asttypes.loc option) = 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.signature_item) = let _1 =
+          let _1 = 
+# 1582 "parsing/parser.mly"
+        ( let (body, ext) = _1 in (Psig_modsubst body, ext) )
+# 33032 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 33040 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 33046 "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 = bs;
+          MenhirLib.EngineTypes.startp = _startpos_bs_;
+          MenhirLib.EngineTypes.endp = _endpos_bs_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              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 = _6;
+                MenhirLib.EngineTypes.startp = _startpos__6_;
+                MenhirLib.EngineTypes.endp = _endpos__6_;
+                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.next = {
+                    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 = _1_inlined1;
+                      MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+                      MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+                      MenhirLib.EngineTypes.next = {
+                        MenhirLib.EngineTypes.state = _;
+                        MenhirLib.EngineTypes.semv = ext;
+                        MenhirLib.EngineTypes.startp = _startpos_ext_;
+                        MenhirLib.EngineTypes.endp = _endpos_ext_;
+                        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 bs : (Parsetree.module_declaration list) = Obj.magic bs in
+        let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let mty : (Parsetree.module_type) = Obj.magic mty in
+        let _6 : unit = Obj.magic _6 in
+        let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in
+        let _4 : unit = Obj.magic _4 in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext 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_bs_ in
+        let _v : (Parsetree.signature_item) = let _1 =
+          let _1 =
+            let _1 =
+              let _1 =
+                let a =
+                  let attrs2 =
+                    let _1 = _1_inlined3 in
+                    
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 33134 "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
+                    
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 33146 "parsing/parser.ml"
+                    
+                  in
+                  let attrs1 =
+                    let _1 = _1_inlined1 in
+                    
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 33154 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos_attrs2_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 1675 "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
+  )
+# 33168 "parsing/parser.ml"
+                  
+                in
+                
+# 1044 "parsing/parser.mly"
+    ( let (x, b) = a in x, b :: bs )
+# 33174 "parsing/parser.ml"
+                
+              in
+              
+# 1664 "parsing/parser.mly"
+    ( _1 )
+# 33180 "parsing/parser.ml"
+              
+            in
+            
+# 1584 "parsing/parser.mly"
+        ( let (ext, l) = _1 in (Psig_recmodule l, ext) )
+# 33186 "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
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 33196 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 33202 "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.module_type_declaration * string Asttypes.loc option) = 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.signature_item) = let _1 =
+          let _1 = 
+# 1586 "parsing/parser.mly"
+        ( let (body, ext) = _1 in (Psig_modtype body, ext) )
+# 33228 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 33236 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 33242 "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.open_description * string Asttypes.loc option) = 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.signature_item) = let _1 =
+          let _1 = 
+# 1588 "parsing/parser.mly"
+        ( let (body, ext) = _1 in (Psig_open body, ext) )
+# 33268 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 33276 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 33282 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = thing;
+            MenhirLib.EngineTypes.startp = _startpos_thing_;
+            MenhirLib.EngineTypes.endp = _endpos_thing_;
+            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.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = ext;
+                MenhirLib.EngineTypes.startp = _startpos_ext_;
+                MenhirLib.EngineTypes.endp = _endpos_ext_;
+                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 _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let thing : (Parsetree.module_type) = Obj.magic thing in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext 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.signature_item) = let _1 =
+          let _1 =
+            let _1 =
+              let attrs2 =
+                let _1 = _1_inlined2 in
+                
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 33340 "parsing/parser.ml"
+                
+              in
+              let _endpos_attrs2_ = _endpos__1_inlined2_ in
+              let attrs1 =
+                let _1 = _1_inlined1 in
+                
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 33349 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos_attrs2_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1434 "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
+  )
+# 33363 "parsing/parser.ml"
+              
+            in
+            
+# 1590 "parsing/parser.mly"
+        ( psig_include _1 )
+# 33369 "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
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 33379 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 33385 "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 = bs;
+          MenhirLib.EngineTypes.startp = _startpos_bs_;
+          MenhirLib.EngineTypes.endp = _endpos_bs_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = cty;
+              MenhirLib.EngineTypes.startp = _startpos_cty_;
+              MenhirLib.EngineTypes.endp = _endpos_cty_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _7;
+                MenhirLib.EngineTypes.startp = _startpos__7_;
+                MenhirLib.EngineTypes.endp = _endpos__7_;
+                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.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = params;
+                    MenhirLib.EngineTypes.startp = _startpos_params_;
+                    MenhirLib.EngineTypes.endp = _endpos_params_;
+                    MenhirLib.EngineTypes.next = {
+                      MenhirLib.EngineTypes.state = _;
+                      MenhirLib.EngineTypes.semv = virt;
+                      MenhirLib.EngineTypes.startp = _startpos_virt_;
+                      MenhirLib.EngineTypes.endp = _endpos_virt_;
+                      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.next = {
+                          MenhirLib.EngineTypes.state = _;
+                          MenhirLib.EngineTypes.semv = ext;
+                          MenhirLib.EngineTypes.startp = _startpos_ext_;
+                          MenhirLib.EngineTypes.endp = _endpos_ext_;
+                          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 bs : (Parsetree.class_description list) = Obj.magic bs in
+        let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let cty : (Parsetree.class_type) = Obj.magic cty in
+        let _7 : unit = Obj.magic _7 in
+        let _1_inlined2 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 33464 "parsing/parser.ml"
+        ) = Obj.magic _1_inlined2 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let virt : (Asttypes.virtual_flag) = Obj.magic virt in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext 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_bs_ in
+        let _v : (Parsetree.signature_item) = let _1 =
+          let _1 =
+            let _1 =
+              let _1 =
+                let a =
+                  let attrs2 =
+                    let _1 = _1_inlined3 in
+                    
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 33484 "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
+                    
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 33496 "parsing/parser.ml"
+                    
+                  in
+                  let attrs1 =
+                    let _1 = _1_inlined1 in
+                    
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 33504 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos_attrs2_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 2005 "parsing/parser.mly"
+    (
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc _sloc in
+      let docs = symbol_docs _sloc in
+      ext,
+      Ci.mk id cty ~virt ~params ~attrs ~loc ~docs
+    )
+# 33519 "parsing/parser.ml"
+                  
+                in
+                
+# 1044 "parsing/parser.mly"
+    ( let (x, b) = a in x, b :: bs )
+# 33525 "parsing/parser.ml"
+                
+              in
+              
+# 1993 "parsing/parser.mly"
+    ( _1 )
+# 33531 "parsing/parser.ml"
+              
+            in
+            
+# 1592 "parsing/parser.mly"
+        ( let (ext, l) = _1 in (Psig_class l, ext) )
+# 33537 "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
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 33547 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 33553 "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 : (string Asttypes.loc option * Parsetree.class_type_declaration list) = 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.signature_item) = let _1 =
+          let _1 = 
+# 1594 "parsing/parser.mly"
+        ( let (ext, l) = _1 in (Psig_class_type l, ext) )
+# 33579 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 871 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 33587 "parsing/parser.ml"
+          
+        in
+        
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 33593 "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.constant) = 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) = 
+# 3405 "parsing/parser.mly"
+                 ( _1 )
+# 33618 "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 = _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 _2 : (
+# 633 "parsing/parser.mly"
+       (string * char option)
+# 33645 "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) = 
+# 3406 "parsing/parser.mly"
+                 ( let (n, m) = _2 in Pconst_integer("-" ^ n, m) )
+# 33654 "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 = _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 _2 : (
+# 612 "parsing/parser.mly"
+       (string * char option)
+# 33681 "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) = 
+# 3407 "parsing/parser.mly"
+                 ( let (f, m) = _2 in Pconst_float("-" ^ f, m) )
+# 33690 "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 = _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 _2 : (
+# 633 "parsing/parser.mly"
+       (string * char option)
+# 33717 "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) = 
+# 3408 "parsing/parser.mly"
+                 ( let (n, m) = _2 in Pconst_integer (n, m) )
+# 33726 "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 = _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 _2 : (
+# 612 "parsing/parser.mly"
+       (string * char option)
+# 33753 "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) = 
+# 3409 "parsing/parser.mly"
+                 ( let (f, m) = _2 in Pconst_float(f, m) )
+# 33762 "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 = _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 _1_inlined1 : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit 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 _2 =
+              let _1 = _1_inlined1 in
+              
+# 2757 "parsing/parser.mly"
+    ( let fields, closed = _1 in
+      let closed = match closed with Some () -> Open | None -> Closed in
+      fields, closed )
+# 33807 "parsing/parser.ml"
+              
+            in
+            
+# 2728 "parsing/parser.mly"
+      ( let (fields, closed) = _2 in
+        Ppat_record(fields, closed) )
+# 33814 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 33824 "parsing/parser.ml"
+          
+        in
+        
+# 2742 "parsing/parser.mly"
+    ( _1 )
+# 33830 "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 = _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 _1_inlined1 : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit 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 _2 =
+              let _1 = _1_inlined1 in
+              
+# 2757 "parsing/parser.mly"
+    ( let fields, closed = _1 in
+      let closed = match closed with Some () -> Open | None -> Closed in
+      fields, closed )
+# 33875 "parsing/parser.ml"
+              
+            in
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            
+# 2731 "parsing/parser.mly"
+      ( unclosed "{" _loc__1_ "}" _loc__3_ )
+# 33883 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 33893 "parsing/parser.ml"
+          
+        in
+        
+# 2742 "parsing/parser.mly"
+    ( _1 )
+# 33899 "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 = ps;
+            MenhirLib.EngineTypes.startp = _startpos_ps_;
+            MenhirLib.EngineTypes.endp = _endpos_ps_;
+            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 ps : (Parsetree.pattern list) = Obj.magic ps 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 _2 = 
+# 2751 "parsing/parser.mly"
+    ( ps )
+# 33940 "parsing/parser.ml"
+             in
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            
+# 2733 "parsing/parser.mly"
+      ( fst (mktailpat _loc__3_ _2) )
+# 33946 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 33956 "parsing/parser.ml"
+          
+        in
+        
+# 2742 "parsing/parser.mly"
+    ( _1 )
+# 33962 "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 = ps;
+            MenhirLib.EngineTypes.startp = _startpos_ps_;
+            MenhirLib.EngineTypes.endp = _endpos_ps_;
+            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 ps : (Parsetree.pattern list) = Obj.magic ps 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 _2 = 
+# 2751 "parsing/parser.mly"
+    ( ps )
+# 34003 "parsing/parser.ml"
+             in
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            
+# 2735 "parsing/parser.mly"
+      ( unclosed "[" _loc__1_ "]" _loc__3_ )
+# 34010 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 34020 "parsing/parser.ml"
+          
+        in
+        
+# 2742 "parsing/parser.mly"
+    ( _1 )
+# 34026 "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 = ps;
+            MenhirLib.EngineTypes.startp = _startpos_ps_;
+            MenhirLib.EngineTypes.endp = _endpos_ps_;
+            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 ps : (Parsetree.pattern list) = Obj.magic ps 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 _2 = 
+# 2751 "parsing/parser.mly"
+    ( ps )
+# 34067 "parsing/parser.ml"
+             in
+            
+# 2737 "parsing/parser.mly"
+      ( Ppat_array _2 )
+# 34072 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 34082 "parsing/parser.ml"
+          
+        in
+        
+# 2742 "parsing/parser.mly"
+    ( _1 )
+# 34088 "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 = _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 _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__2_ in
+        let _v : (Parsetree.pattern) = let _1 =
+          let _1 = 
+# 2739 "parsing/parser.mly"
+      ( Ppat_array [] )
+# 34121 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 34130 "parsing/parser.ml"
+          
+        in
+        
+# 2742 "parsing/parser.mly"
+    ( _1 )
+# 34136 "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 = ps;
+            MenhirLib.EngineTypes.startp = _startpos_ps_;
+            MenhirLib.EngineTypes.endp = _endpos_ps_;
+            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 ps : (Parsetree.pattern list) = Obj.magic ps 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 _2 = 
+# 2751 "parsing/parser.mly"
+    ( ps )
+# 34177 "parsing/parser.ml"
+             in
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            
+# 2741 "parsing/parser.mly"
+      ( unclosed "[|" _loc__1_ "|]" _loc__3_ )
+# 34184 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 34194 "parsing/parser.ml"
+          
+        in
+        
+# 2742 "parsing/parser.mly"
+    ( _1 )
+# 34200 "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 = _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 : (Parsetree.expression) = 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.expression) = let _endpos = _endpos__3_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2240 "parsing/parser.mly"
+      ( reloc_exp ~loc:_sloc _2 )
+# 34242 "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 = _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 : (Parsetree.expression) = 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.expression) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
+        let _loc__1_ = (_startpos__1_, _endpos__1_) in
+        
+# 2242 "parsing/parser.mly"
+      ( unclosed "(" _loc__1_ ")" _loc__3_ )
+# 34283 "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 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.core_type option * Parsetree.core_type option) = Obj.magic _3 in
+        let _2 : (Parsetree.expression) = 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.expression) = let _endpos = _endpos__4_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2244 "parsing/parser.mly"
+      ( mkexp_constraint ~loc:_sloc _2 _3 )
+# 34332 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 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__5_ in
+        let _v : (Parsetree.expression) = let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2246 "parsing/parser.mly"
+      ( array_get ~loc:_sloc _1 _4 )
+# 34388 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 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__5_ in
+        let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
+        let _loc__3_ = (_startpos__3_, _endpos__3_) in
+        
+# 2248 "parsing/parser.mly"
+      ( unclosed "(" _loc__3_ ")" _loc__5_ )
+# 34443 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 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__5_ in
+        let _v : (Parsetree.expression) = let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2250 "parsing/parser.mly"
+      ( string_get ~loc:_sloc _1 _4 )
+# 34499 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 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__5_ in
+        let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
+        let _loc__3_ = (_startpos__3_, _endpos__3_) in
+        
+# 2252 "parsing/parser.mly"
+      ( unclosed "[" _loc__3_ "]" _loc__5_ )
+# 34554 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            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 _5 : unit = Obj.magic _5 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 34602 "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__5_ in
+        let _v : (Parsetree.expression) = let _4 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 34611 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2254 "parsing/parser.mly"
+      ( dotop_get ~loc:_sloc lident bracket _2 _1 _4 )
+# 34619 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            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 _5 : unit = Obj.magic _5 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 34667 "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__5_ in
+        let _v : (Parsetree.expression) = let _4 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 34676 "parsing/parser.ml"
+         in
+        let _loc__5_ = (_startpos__5_, _endpos__5_) in
+        let _loc__3_ = (_startpos__3_, _endpos__3_) in
+        
+# 2256 "parsing/parser.mly"
+      ( unclosed "[" _loc__3_ "]" _loc__5_ )
+# 34683 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            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 _5 : unit = Obj.magic _5 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 34731 "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__5_ in
+        let _v : (Parsetree.expression) = let _4 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 34740 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2258 "parsing/parser.mly"
+      ( dotop_get ~loc:_sloc lident paren _2 _1 _4  )
+# 34748 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            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 _5 : unit = Obj.magic _5 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 34796 "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__5_ in
+        let _v : (Parsetree.expression) = let _4 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 34805 "parsing/parser.ml"
+         in
+        let _loc__5_ = (_startpos__5_, _endpos__5_) in
+        let _loc__3_ = (_startpos__3_, _endpos__3_) in
+        
+# 2260 "parsing/parser.mly"
+      ( unclosed "(" _loc__3_ ")" _loc__5_ )
+# 34812 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            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 _5 : unit = Obj.magic _5 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 34860 "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__5_ in
+        let _v : (Parsetree.expression) = let _4 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 34869 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2262 "parsing/parser.mly"
+      ( dotop_get ~loc:_sloc lident brace _2 _1 _4 )
+# 34877 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 34925 "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__5_ in
+        let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
+        let _loc__3_ = (_startpos__3_, _endpos__3_) in
+        
+# 2264 "parsing/parser.mly"
+      ( unclosed "{" _loc__3_ "}" _loc__5_ )
+# 34936 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                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 _7 : unit = Obj.magic _7 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 34996 "parsing/parser.ml"
+        ) = Obj.magic _4 in
+        let _3 : (Longident.t) = Obj.magic _3 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__7_ in
+        let _v : (Parsetree.expression) = let _6 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 35007 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__7_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2266 "parsing/parser.mly"
+      ( dotop_get ~loc:_sloc (ldot _3) bracket _4 _1 _6  )
+# 35015 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                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 _7 : unit = Obj.magic _7 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 35075 "parsing/parser.ml"
+        ) = Obj.magic _4 in
+        let _3 : (Longident.t) = Obj.magic _3 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__7_ in
+        let _v : (Parsetree.expression) = let _6 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 35086 "parsing/parser.ml"
+         in
+        let _loc__7_ = (_startpos__7_, _endpos__7_) in
+        let _loc__5_ = (_startpos__5_, _endpos__5_) in
+        
+# 2269 "parsing/parser.mly"
+      ( unclosed "[" _loc__5_ "]" _loc__7_ )
+# 35093 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                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 _7 : unit = Obj.magic _7 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 35153 "parsing/parser.ml"
+        ) = Obj.magic _4 in
+        let _3 : (Longident.t) = Obj.magic _3 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__7_ in
+        let _v : (Parsetree.expression) = let _6 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 35164 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__7_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2271 "parsing/parser.mly"
+      ( dotop_get ~loc:_sloc (ldot _3) paren _4 _1 _6 )
+# 35172 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                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 _7 : unit = Obj.magic _7 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 35232 "parsing/parser.ml"
+        ) = Obj.magic _4 in
+        let _3 : (Longident.t) = Obj.magic _3 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__7_ in
+        let _v : (Parsetree.expression) = let _6 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 35243 "parsing/parser.ml"
+         in
+        let _loc__7_ = (_startpos__7_, _endpos__7_) in
+        let _loc__5_ = (_startpos__5_, _endpos__5_) in
+        
+# 2274 "parsing/parser.mly"
+      ( unclosed "(" _loc__5_ ")" _loc__7_ )
+# 35250 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                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 _7 : unit = Obj.magic _7 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 35310 "parsing/parser.ml"
+        ) = Obj.magic _4 in
+        let _3 : (Longident.t) = Obj.magic _3 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__7_ in
+        let _v : (Parsetree.expression) = let _6 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 35321 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__7_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2276 "parsing/parser.mly"
+      ( dotop_get ~loc:_sloc (ldot _3) brace _4 _1 _6  )
+# 35329 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                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 _7 : unit = Obj.magic _7 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (
+# 628 "parsing/parser.mly"
+       (string)
+# 35389 "parsing/parser.ml"
+        ) = Obj.magic _4 in
+        let _3 : (Longident.t) = Obj.magic _3 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__7_ in
+        let _v : (Parsetree.expression) = let _6 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 35400 "parsing/parser.ml"
+         in
+        let _loc__7_ = (_startpos__7_, _endpos__7_) in
+        let _loc__5_ = (_startpos__5_, _endpos__5_) in
+        
+# 2279 "parsing/parser.mly"
+      ( unclosed "{" _loc__5_ "}" _loc__7_ )
+# 35407 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 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__5_ in
+        let _v : (Parsetree.expression) = let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2281 "parsing/parser.mly"
+      ( bigarray_get ~loc:_sloc _1 _4 )
+# 35463 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 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__5_ in
+        let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
+        let _loc__3_ = (_startpos__3_, _endpos__3_) in
+        
+# 2283 "parsing/parser.mly"
+      ( unclosed "{" _loc__3_ "}" _loc__5_ )
+# 35518 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          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 = _;
+              MenhirLib.EngineTypes.semv = _1_inlined1;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = ext;
+                MenhirLib.EngineTypes.startp = _startpos_ext_;
+                MenhirLib.EngineTypes.endp = _endpos_ext_;
+                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 _5 : unit = Obj.magic _5 in
+        let e : (Parsetree.expression) = Obj.magic e in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext 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 : (Parsetree.expression) = let _1 =
+          let attrs =
+            let _1 = _1_inlined1 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 35574 "parsing/parser.ml"
+            
+          in
+          
+# 2292 "parsing/parser.mly"
+      ( e.pexp_desc, (ext, attrs @ e.pexp_attributes) )
+# 35580 "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
+        
+# 2285 "parsing/parser.mly"
+    ( let desc, attrs = _1 in
+      mkexp_attrs ~loc:_sloc desc attrs )
+# 35591 "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 = _1_inlined2;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+            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.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 _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.expression) = let _1 =
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 35642 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 35648 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__3_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2294 "parsing/parser.mly"
+      ( Pexp_construct (mkloc (Lident "()") (make_loc _sloc), None), _2 )
+# 35657 "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
+        
+# 2285 "parsing/parser.mly"
+    ( let desc, attrs = _1 in
+      mkexp_attrs ~loc:_sloc desc attrs )
+# 35668 "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 = _1_inlined2;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+              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.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 : unit = Obj.magic _4 in
+        let _3 : (Parsetree.expression) = 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__4_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 35726 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 35732 "parsing/parser.ml"
+            
+          in
+          let _loc__4_ = (_startpos__4_, _endpos__4_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          
+# 2296 "parsing/parser.mly"
+      ( unclosed "begin" _loc__1_ "end" _loc__4_ )
+# 35740 "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
+        
+# 2285 "parsing/parser.mly"
+    ( let desc, attrs = _1 in
+      mkexp_attrs ~loc:_sloc desc attrs )
+# 35751 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          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.next = {
+              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 _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 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__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
+            
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 35803 "parsing/parser.ml"
+            
+          in
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 35813 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 35819 "parsing/parser.ml"
+            
+          in
+          
+# 2298 "parsing/parser.mly"
+      ( Pexp_new(_3), _2 )
+# 35825 "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
+        
+# 2285 "parsing/parser.mly"
+    ( let desc, attrs = _1 in
+      mkexp_attrs ~loc:_sloc desc attrs )
+# 35836 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 = _1_inlined2;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+              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.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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.module_expr) = Obj.magic _4 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 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 : (Parsetree.expression) = let _1 =
+          let _3 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 35901 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 35907 "parsing/parser.ml"
+            
+          in
+          
+# 2300 "parsing/parser.mly"
+      ( Pexp_pack _4, _3 )
+# 35913 "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
+        
+# 2285 "parsing/parser.mly"
+    ( let desc, attrs = _1 in
+      mkexp_attrs ~loc:_sloc desc attrs )
+# 35924 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                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 = _1_inlined2;
+                  MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+                  MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+                  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.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 _7 : unit = Obj.magic _7 in
+        let _1_inlined3 : (Parsetree.module_type) = Obj.magic _1_inlined3 in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.module_expr) = Obj.magic _4 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 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__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 _1 =
+              let _1 = 
+# 3320 "parsing/parser.mly"
+      ( Ptyp_package (package_type_of_module_type _1) )
+# 36002 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 36010 "parsing/parser.ml"
+              
+            in
+            
+# 3321 "parsing/parser.mly"
+      ( _1 )
+# 36016 "parsing/parser.ml"
+            
+          in
+          let _3 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 36026 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 36032 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__7_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 2302 "parsing/parser.mly"
+      ( Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _4), _6), _3 )
+# 36041 "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
+        
+# 2285 "parsing/parser.mly"
+    ( let desc, attrs = _1 in
+      mkexp_attrs ~loc:_sloc desc attrs )
+# 36052 "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 = _6;
+          MenhirLib.EngineTypes.startp = _startpos__6_;
+          MenhirLib.EngineTypes.endp = _endpos__6_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _5;
+            MenhirLib.EngineTypes.startp = _startpos__5_;
+            MenhirLib.EngineTypes.endp = _endpos__5_;
+            MenhirLib.EngineTypes.next = {
+              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 = _1_inlined2;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+                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.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 _6 : unit = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.module_expr) = Obj.magic _4 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 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__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
+              
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 36124 "parsing/parser.ml"
+              
+            in
+            
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 36130 "parsing/parser.ml"
+            
+          in
+          let _loc__6_ = (_startpos__6_, _endpos__6_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          
+# 2304 "parsing/parser.mly"
+      ( unclosed "(" _loc__1_ ")" _loc__6_ )
+# 36138 "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
+        
+# 2285 "parsing/parser.mly"
+    ( let desc, attrs = _1 in
+      mkexp_attrs ~loc:_sloc desc attrs )
+# 36149 "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 : (Longident.t) = 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.expression) = let _1 =
+          let _1 =
+            let _1 =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 36180 "parsing/parser.ml"
+              
+            in
+            
+# 2308 "parsing/parser.mly"
+      ( Pexp_ident (_1) )
+# 36186 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 36195 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 36201 "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.constant) = 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.expression) = let _1 =
+          let _1 = 
+# 2310 "parsing/parser.mly"
+      ( Pexp_constant _1 )
+# 36227 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 36235 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 36241 "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 : (Longident.t) = 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.expression) = let _1 =
+          let _1 =
+            let _1 =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 36272 "parsing/parser.ml"
+              
+            in
+            
+# 2312 "parsing/parser.mly"
+      ( Pexp_construct(_1, None) )
+# 36278 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 36287 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 36293 "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 : (Asttypes.label) = 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.expression) = let _1 =
+          let _1 = 
+# 2314 "parsing/parser.mly"
+      ( Pexp_variant(_1, None) )
+# 36319 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 36327 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 36333 "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 = _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 _2 : (Parsetree.expression) = Obj.magic _2 in
+        let _1 : (
+# 671 "parsing/parser.mly"
+       (string)
+# 36361 "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 _1 =
+            let _1 =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 36375 "parsing/parser.ml"
+              
+            in
+            
+# 2316 "parsing/parser.mly"
+      ( Pexp_apply(_1, [Nolabel,_2]) )
+# 36381 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 36391 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 36397 "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 = _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 _2 : (Parsetree.expression) = 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.expression) = let _1 =
+          let _1 =
+            let _1 =
+              let _1 = 
+# 2317 "parsing/parser.mly"
+            ("!")
+# 36432 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 36440 "parsing/parser.ml"
+              
+            in
+            
+# 2318 "parsing/parser.mly"
+      ( Pexp_apply(_1, [Nolabel,_2]) )
+# 36446 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 36456 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 36462 "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 = 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 _3 : unit = Obj.magic _3 in
+        let xs : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = Obj.magic xs 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.expression) = let _1 =
+          let _1 =
+            let _2 = 
+# 2569 "parsing/parser.mly"
+    ( xs )
+# 36503 "parsing/parser.ml"
+             in
+            
+# 2320 "parsing/parser.mly"
+      ( Pexp_override _2 )
+# 36508 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 36518 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 36524 "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 = 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 _3 : unit = Obj.magic _3 in
+        let xs : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = Obj.magic xs 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.expression) = let _1 =
+          let _1 =
+            let _2 = 
+# 2569 "parsing/parser.mly"
+    ( xs )
+# 36565 "parsing/parser.ml"
+             in
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            
+# 2322 "parsing/parser.mly"
+      ( unclosed "{<" _loc__1_ ">}" _loc__3_ )
+# 36572 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 36582 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 36588 "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 = _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 _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__2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 = 
+# 2324 "parsing/parser.mly"
+      ( Pexp_override [] )
+# 36621 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 36630 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 36636 "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 = _1_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+          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 _1_inlined1 : (Longident.t) = 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 _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
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 36682 "parsing/parser.ml"
+              
+            in
+            
+# 2326 "parsing/parser.mly"
+      ( Pexp_field(_1, _3) )
+# 36688 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 36698 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 36704 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Parsetree.expression) = let _1 =
+          let _1 =
+            let od =
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 36764 "parsing/parser.ml"
+                
+              in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 1493 "parsing/parser.mly"
+  ( let loc = make_loc _loc__1_ in
+    let me = Mod.ident ~loc _1 in
+    Opn.mk ~loc me )
+# 36773 "parsing/parser.ml"
+              
+            in
+            
+# 2328 "parsing/parser.mly"
+      ( Pexp_open(od, _4) )
+# 36779 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 36789 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 36795 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = xs;
+            MenhirLib.EngineTypes.startp = _startpos_xs_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_;
+            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 _5 : unit = Obj.magic _5 in
+        let xs : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = Obj.magic xs in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Parsetree.expression) = let _1 =
+          let _1 =
+            let _4 = 
+# 2569 "parsing/parser.mly"
+    ( xs )
+# 36850 "parsing/parser.ml"
+             in
+            let od =
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 36860 "parsing/parser.ml"
+                
+              in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 1493 "parsing/parser.mly"
+  ( let loc = make_loc _loc__1_ in
+    let me = Mod.ident ~loc _1 in
+    Opn.mk ~loc me )
+# 36869 "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
+            
+# 2330 "parsing/parser.mly"
+      ( (* TODO: review the location of Pexp_override *)
+        Pexp_open(od, mkexp ~loc:_sloc (Pexp_override _4)) )
+# 36880 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 36890 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 36896 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = xs;
+            MenhirLib.EngineTypes.startp = _startpos_xs_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_;
+            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 _5 : unit = Obj.magic _5 in
+        let xs : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = Obj.magic xs in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Parsetree.expression) = let _1 =
+          let _1 =
+            let _4 = 
+# 2569 "parsing/parser.mly"
+    ( xs )
+# 36951 "parsing/parser.ml"
+             in
+            let _loc__5_ = (_startpos__5_, _endpos__5_) in
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            
+# 2333 "parsing/parser.mly"
+      ( unclosed "{<" _loc__3_ ">}" _loc__5_ )
+# 36958 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 36968 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 36974 "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 = _1_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+          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 _1_inlined1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 37007 "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 _1 =
+            let _3 =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+              let _1 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 37021 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 37029 "parsing/parser.ml"
+              
+            in
+            
+# 2335 "parsing/parser.mly"
+      ( Pexp_send(_1, _3) )
+# 37035 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 37045 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 37051 "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 = _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 : (Parsetree.expression) = Obj.magic _3 in
+        let _1_inlined1 : (
+# 682 "parsing/parser.mly"
+       (string)
+# 37085 "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 _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
+              
+# 840 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 37101 "parsing/parser.ml"
+              
+            in
+            
+# 2337 "parsing/parser.mly"
+      ( mkinfix _1 _2 _3 )
+# 37107 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 37117 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 37123 "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.extension) = 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.expression) = let _1 =
+          let _1 = 
+# 2339 "parsing/parser.mly"
+      ( Pexp_extension _1 )
+# 37149 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 37157 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 37163 "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 = _2_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
+          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.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 _2_inlined1 : unit = Obj.magic _2_inlined1 in
+        let _1_inlined1 : unit = Obj.magic _1_inlined1 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = Obj.magic _1 in
+        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 _1 =
+            let _3 =
+              let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
+              let _1 = 
+# 2340 "parsing/parser.mly"
+                                                    (Lident "()")
+# 37213 "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
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 37222 "parsing/parser.ml"
+              
+            in
+            let _endpos__3_ = _endpos__2_inlined1_ in
+            let od =
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 37234 "parsing/parser.ml"
+                
+              in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 1493 "parsing/parser.mly"
+  ( let loc = make_loc _loc__1_ in
+    let me = Mod.ident ~loc _1 in
+    Opn.mk ~loc me )
+# 37243 "parsing/parser.ml"
+              
+            in
+            let _startpos_od_ = _startpos__1_ in
+            let _endpos = _endpos__3_ in
+            let _symbolstartpos = _startpos_od_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2341 "parsing/parser.mly"
+      ( (* TODO: review the location of Pexp_construct *)
+        Pexp_open(od, mkexp ~loc:_sloc (Pexp_construct(_3, None))) )
+# 37254 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 37264 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 37270 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Parsetree.expression) = let _1 =
+          let _1 =
+            let _loc__5_ = (_startpos__5_, _endpos__5_) in
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            
+# 2344 "parsing/parser.mly"
+      ( unclosed "(" _loc__3_ ")" _loc__5_ )
+# 37327 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 37337 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 37343 "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 = _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 : (Parsetree.expression option *
+  (Longident.t Asttypes.loc * Parsetree.expression) list) = 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.expression) = let _1 =
+          let _1 = 
+# 2346 "parsing/parser.mly"
+      ( let (exten, fields) = _2 in
+        Pexp_record(fields, exten) )
+# 37385 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 37394 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 37400 "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 = _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 : (Parsetree.expression option *
+  (Longident.t Asttypes.loc * Parsetree.expression) list) = 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.expression) = let _1 =
+          let _1 =
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            
+# 2349 "parsing/parser.mly"
+      ( unclosed "{" _loc__1_ "}" _loc__3_ )
+# 37444 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 37454 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 37460 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression option *
+  (Longident.t Asttypes.loc * Parsetree.expression) list) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Parsetree.expression) = let _1 =
+          let _1 =
+            let od =
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 37521 "parsing/parser.ml"
+                
+              in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 1493 "parsing/parser.mly"
+  ( let loc = make_loc _loc__1_ in
+    let me = Mod.ident ~loc _1 in
+    Opn.mk ~loc me )
+# 37530 "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
+            
+# 2351 "parsing/parser.mly"
+      ( let (exten, fields) = _4 in
+        (* TODO: review the location of Pexp_construct *)
+        Pexp_open(od, mkexp ~loc:_sloc (Pexp_record(fields, exten))) )
+# 37542 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 37552 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 37558 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.expression option *
+  (Longident.t Asttypes.loc * Parsetree.expression) list) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Parsetree.expression) = let _1 =
+          let _1 =
+            let _loc__5_ = (_startpos__5_, _endpos__5_) in
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            
+# 2355 "parsing/parser.mly"
+      ( unclosed "{" _loc__3_ "}" _loc__5_ )
+# 37616 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 37626 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 37632 "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 = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            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 es : (Parsetree.expression list) = Obj.magic es 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.expression) = let _1 =
+          let _1 =
+            let _2 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 37673 "parsing/parser.ml"
+             in
+            
+# 2357 "parsing/parser.mly"
+      ( Pexp_array(_2) )
+# 37678 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 37688 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 37694 "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 = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            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 es : (Parsetree.expression list) = Obj.magic es 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.expression) = let _1 =
+          let _1 =
+            let _2 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 37735 "parsing/parser.ml"
+             in
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            
+# 2359 "parsing/parser.mly"
+      ( unclosed "[|" _loc__1_ "|]" _loc__3_ )
+# 37742 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 37752 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 37758 "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 = _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 _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__2_ in
+        let _v : (Parsetree.expression) = let _1 =
+          let _1 = 
+# 2361 "parsing/parser.mly"
+      ( Pexp_array [] )
+# 37791 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 37800 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 37806 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            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 _5 : unit = Obj.magic _5 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Parsetree.expression) = let _1 =
+          let _1 =
+            let _4 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 37861 "parsing/parser.ml"
+             in
+            let od =
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 37871 "parsing/parser.ml"
+                
+              in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 1493 "parsing/parser.mly"
+  ( let loc = make_loc _loc__1_ in
+    let me = Mod.ident ~loc _1 in
+    Opn.mk ~loc me )
+# 37880 "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
+            
+# 2363 "parsing/parser.mly"
+      ( (* TODO: review the location of Pexp_array *)
+        Pexp_open(od, mkexp ~loc:_sloc (Pexp_array(_4))) )
+# 37891 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 37901 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 37907 "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 : unit = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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.expression) = let _1 =
+          let _1 =
+            let od =
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 37960 "parsing/parser.ml"
+                
+              in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 1493 "parsing/parser.mly"
+  ( let loc = make_loc _loc__1_ in
+    let me = Mod.ident ~loc _1 in
+    Opn.mk ~loc me )
+# 37969 "parsing/parser.ml"
+              
+            in
+            let _startpos_od_ = _startpos__1_ in
+            let _endpos = _endpos__4_ in
+            let _symbolstartpos = _startpos_od_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2366 "parsing/parser.mly"
+      ( (* TODO: review the location of Pexp_array *)
+        Pexp_open(od, mkexp ~loc:_sloc (Pexp_array [])) )
+# 37980 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 37990 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 37996 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            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 _5 : unit = Obj.magic _5 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Parsetree.expression) = let _1 =
+          let _1 =
+            let _4 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 38051 "parsing/parser.ml"
+             in
+            let _loc__5_ = (_startpos__5_, _endpos__5_) in
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            
+# 2370 "parsing/parser.mly"
+      ( unclosed "[|" _loc__3_ "|]" _loc__5_ )
+# 38058 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 38068 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 38074 "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 = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            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 es : (Parsetree.expression list) = Obj.magic es 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.expression) = let _1 =
+          let _1 =
+            let _2 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 38115 "parsing/parser.ml"
+             in
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            
+# 2372 "parsing/parser.mly"
+      ( fst (mktailexp _loc__3_ _2) )
+# 38121 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 38131 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 38137 "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 = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            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 es : (Parsetree.expression list) = Obj.magic es 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.expression) = let _1 =
+          let _1 =
+            let _2 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 38178 "parsing/parser.ml"
+             in
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            
+# 2374 "parsing/parser.mly"
+      ( unclosed "[" _loc__1_ "]" _loc__3_ )
+# 38185 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 38195 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 38201 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            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 _5 : unit = Obj.magic _5 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Parsetree.expression) = let _1 =
+          let _1 =
+            let _4 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 38256 "parsing/parser.ml"
+             in
+            let od =
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 38266 "parsing/parser.ml"
+                
+              in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 1493 "parsing/parser.mly"
+  ( let loc = make_loc _loc__1_ in
+    let me = Mod.ident ~loc _1 in
+    Opn.mk ~loc me )
+# 38275 "parsing/parser.ml"
+              
+            in
+            let _startpos_od_ = _startpos__1_ in
+            let _endpos = _endpos__5_ in
+            let _symbolstartpos = _startpos_od_ in
+            let _loc__5_ = (_startpos__5_, _endpos__5_) in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2376 "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:_sloc tail_exp in
+        Pexp_open(od, list_exp) )
+# 38290 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 38300 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 38306 "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 = _2_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
+          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.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 _2_inlined1 : unit = Obj.magic _2_inlined1 in
+        let _1_inlined1 : unit = Obj.magic _1_inlined1 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = Obj.magic _1 in
+        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 _1 =
+            let _3 =
+              let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
+              let _1 = 
+# 2381 "parsing/parser.mly"
+                                                        (Lident "[]")
+# 38356 "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
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 38365 "parsing/parser.ml"
+              
+            in
+            let _endpos__3_ = _endpos__2_inlined1_ in
+            let od =
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 38377 "parsing/parser.ml"
+                
+              in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 1493 "parsing/parser.mly"
+  ( let loc = make_loc _loc__1_ in
+    let me = Mod.ident ~loc _1 in
+    Opn.mk ~loc me )
+# 38386 "parsing/parser.ml"
+              
+            in
+            let _startpos_od_ = _startpos__1_ in
+            let _endpos = _endpos__3_ in
+            let _symbolstartpos = _startpos_od_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2382 "parsing/parser.mly"
+      ( (* TODO: review the location of Pexp_construct *)
+        Pexp_open(od, mkexp ~loc:_sloc (Pexp_construct(_3, None))) )
+# 38397 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 38407 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 38413 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = es;
+            MenhirLib.EngineTypes.startp = _startpos_es_;
+            MenhirLib.EngineTypes.endp = _endpos_es_;
+            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 _5 : unit = Obj.magic _5 in
+        let es : (Parsetree.expression list) = Obj.magic es in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Parsetree.expression) = let _1 =
+          let _1 =
+            let _4 = 
+# 2586 "parsing/parser.mly"
+    ( es )
+# 38468 "parsing/parser.ml"
+             in
+            let _loc__5_ = (_startpos__5_, _endpos__5_) in
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            
+# 2386 "parsing/parser.mly"
+      ( unclosed "[" _loc__3_ "]" _loc__5_ )
+# 38475 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 38485 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 38491 "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 = _9;
+          MenhirLib.EngineTypes.startp = _startpos__9_;
+          MenhirLib.EngineTypes.endp = _endpos__9_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _7;
+              MenhirLib.EngineTypes.startp = _startpos__7_;
+              MenhirLib.EngineTypes.endp = _endpos__7_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _6;
+                MenhirLib.EngineTypes.startp = _startpos__6_;
+                MenhirLib.EngineTypes.endp = _endpos__6_;
+                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.next = {
+                    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 = _;
+                      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 _9 : unit = Obj.magic _9 in
+        let _1_inlined3 : (Parsetree.module_type) = Obj.magic _1_inlined3 in
+        let _7 : unit = Obj.magic _7 in
+        let _6 : (Parsetree.module_expr) = Obj.magic _6 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 : unit = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = Obj.magic _1 in
+        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 _1 =
+            let _8 =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+              let _1 =
+                let _1 = 
+# 3320 "parsing/parser.mly"
+      ( Ptyp_package (package_type_of_module_type _1) )
+# 38584 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 38592 "parsing/parser.ml"
+                
+              in
+              
+# 3321 "parsing/parser.mly"
+      ( _1 )
+# 38598 "parsing/parser.ml"
+              
+            in
+            let _5 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 38608 "parsing/parser.ml"
+                
+              in
+              
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 38614 "parsing/parser.ml"
+              
+            in
+            let od =
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 38625 "parsing/parser.ml"
+                
+              in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 1493 "parsing/parser.mly"
+  ( let loc = make_loc _loc__1_ in
+    let me = Mod.ident ~loc _1 in
+    Opn.mk ~loc me )
+# 38634 "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
+            
+# 2389 "parsing/parser.mly"
+      ( (* TODO: review the location of Pexp_constraint *)
+        let modexp =
+          mkexp_attrs ~loc:_sloc
+            (Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _6), _8)) _5 in
+        Pexp_open(od, modexp) )
+# 38648 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 38658 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 38664 "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 = _8;
+          MenhirLib.EngineTypes.startp = _startpos__8_;
+          MenhirLib.EngineTypes.endp = _endpos__8_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _7;
+            MenhirLib.EngineTypes.startp = _startpos__7_;
+            MenhirLib.EngineTypes.endp = _endpos__7_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _6;
+              MenhirLib.EngineTypes.startp = _startpos__6_;
+              MenhirLib.EngineTypes.endp = _endpos__6_;
+              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.next = {
+                  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 = _;
+                    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 _8 : unit = Obj.magic _8 in
+        let _7 : unit = Obj.magic _7 in
+        let _6 : (Parsetree.module_expr) = Obj.magic _6 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 : unit = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Parsetree.expression) = let _1 =
+          let _1 =
+            let _5 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 38751 "parsing/parser.ml"
+                
+              in
+              
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 38757 "parsing/parser.ml"
+              
+            in
+            let _loc__8_ = (_startpos__8_, _endpos__8_) in
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            
+# 2396 "parsing/parser.mly"
+      ( unclosed "(" _loc__3_ ")" _loc__8_ )
+# 38765 "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
+          
+# 846 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 38775 "parsing/parser.ml"
+          
+        in
+        
+# 2288 "parsing/parser.mly"
+      ( _1 )
+# 38781 "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 : (Asttypes.label) = 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 _1 =
+            let _1 =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 38812 "parsing/parser.ml"
+              
+            in
+            
+# 2666 "parsing/parser.mly"
+      ( Ppat_var (_1) )
+# 38818 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 38827 "parsing/parser.ml"
+          
+        in
+        
+# 2667 "parsing/parser.mly"
+      ( _1 )
+# 38833 "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.pattern) = 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) = 
+# 2668 "parsing/parser.mly"
+                             ( _1 )
+# 38858 "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 = _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 : (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 _endpos = _endpos__3_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2673 "parsing/parser.mly"
+      ( reloc_pat ~loc:_sloc _2 )
+# 38900 "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.pattern) = 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) = 
+# 2675 "parsing/parser.mly"
+      ( _1 )
+# 38925 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            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.next = {
+                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 = _;
+                  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 _5 : unit = Obj.magic _5 in
+        let _1_inlined3 : (string option) = Obj.magic _1_inlined3 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 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 : (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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 38990 "parsing/parser.ml"
+          
+        in
+        let _3 =
+          let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 39000 "parsing/parser.ml"
+            
+          in
+          
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 39006 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2677 "parsing/parser.mly"
+      ( mkpat_attrs ~loc:_sloc (Ppat_unpack _4) _3 )
+# 39015 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined4;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined4_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined4_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _1_inlined3;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+                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.next = {
+                    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 = _;
+                      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 _7 : unit = Obj.magic _7 in
+        let _1_inlined4 : (Parsetree.module_type) = Obj.magic _1_inlined4 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined3 : (string option) = Obj.magic _1_inlined3 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 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__7_ in
+        let _v : (Parsetree.pattern) = let _6 =
+          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined4_, _startpos__1_inlined4_, _1_inlined4) in
+          let _1 =
+            let _1 = 
+# 3320 "parsing/parser.mly"
+      ( Ptyp_package (package_type_of_module_type _1) )
+# 39092 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 39100 "parsing/parser.ml"
+            
+          in
+          
+# 3321 "parsing/parser.mly"
+      ( _1 )
+# 39106 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 39117 "parsing/parser.ml"
+          
+        in
+        let _3 =
+          let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 39127 "parsing/parser.ml"
+            
+          in
+          
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 39133 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__7_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2679 "parsing/parser.mly"
+      ( mkpat_attrs ~loc:_sloc
+          (Ppat_constraint(mkpat ~loc:_sloc (Ppat_unpack _4), _6))
+          _3 )
+# 39144 "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 : unit = 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 _1 = 
+# 2687 "parsing/parser.mly"
+      ( Ppat_any )
+# 39170 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 39178 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 39184 "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.constant) = 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 _1 = 
+# 2689 "parsing/parser.mly"
+      ( Ppat_constant _1 )
+# 39210 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 39218 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 39224 "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 = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (Parsetree.constant) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Parsetree.constant) = 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 = 
+# 2691 "parsing/parser.mly"
+      ( Ppat_interval (_1, _3) )
+# 39264 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 39273 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 39279 "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 : (Longident.t) = 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 _1 =
+            let _1 =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 39310 "parsing/parser.ml"
+              
+            in
+            
+# 2693 "parsing/parser.mly"
+      ( Ppat_construct(_1, None) )
+# 39316 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 39325 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 39331 "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 : (Asttypes.label) = 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 _1 = 
+# 2695 "parsing/parser.mly"
+      ( Ppat_variant(_1, None) )
+# 39357 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 39365 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 39371 "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 = _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 _1_inlined1 : (Longident.t) = 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 : (Parsetree.pattern) = let _1 =
+          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
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 39410 "parsing/parser.ml"
+              
+            in
+            
+# 2697 "parsing/parser.mly"
+      ( Ppat_type (_2) )
+# 39416 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 39426 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 39432 "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 = _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 : (Longident.t) = 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 _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 39477 "parsing/parser.ml"
+              
+            in
+            
+# 2699 "parsing/parser.mly"
+      ( Ppat_open(_1, _3) )
+# 39483 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 39493 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 39499 "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 = _2_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
+          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.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 _2_inlined1 : unit = Obj.magic _2_inlined1 in
+        let _1_inlined1 : unit = Obj.magic _1_inlined1 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = Obj.magic _1 in
+        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 _1 =
+            let _3 =
+              let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
+              let _1 = 
+# 2700 "parsing/parser.mly"
+                                                     (Lident "[]")
+# 39549 "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
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 39558 "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
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 39569 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos__3_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2701 "parsing/parser.mly"
+    ( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
+# 39578 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 39588 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 39594 "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 = _2_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
+          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.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 _2_inlined1 : unit = Obj.magic _2_inlined1 in
+        let _1_inlined1 : unit = Obj.magic _1_inlined1 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = Obj.magic _1 in
+        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 _1 =
+            let _3 =
+              let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
+              let _1 = 
+# 2702 "parsing/parser.mly"
+                                                 (Lident "()")
+# 39644 "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
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 39653 "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
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 39664 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos__3_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2703 "parsing/parser.mly"
+    ( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
+# 39673 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 39683 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 39689 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.pattern) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Parsetree.pattern) = let _1 =
+          let _1 =
+            let _1 =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 39748 "parsing/parser.ml"
+              
+            in
+            
+# 2705 "parsing/parser.mly"
+      ( Ppat_open (_1, _4) )
+# 39754 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 39764 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 39770 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.pattern) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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 : (Parsetree.pattern) = let _1 =
+          let _1 =
+            let _loc__5_ = (_startpos__5_, _endpos__5_) in
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            
+# 2707 "parsing/parser.mly"
+      ( unclosed "(" _loc__3_ ")" _loc__5_  )
+# 39827 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 39837 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 39843 "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 : unit = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Longident.t) = 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.pattern) = let _1 =
+          let _1 =
+            let _loc__4_ = (_startpos__4_, _endpos__4_) in
+            
+# 2709 "parsing/parser.mly"
+      ( expecting _loc__4_ "pattern" )
+# 39892 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 39902 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 39908 "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 = _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 : (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 _1 =
+          let _1 =
+            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            
+# 2711 "parsing/parser.mly"
+      ( unclosed "(" _loc__1_ ")" _loc__3_ )
+# 39951 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 39961 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 39967 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.core_type) = 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__5_ in
+        let _v : (Parsetree.pattern) = let _1 =
+          let _1 = 
+# 2713 "parsing/parser.mly"
+      ( Ppat_constraint(_2, _4) )
+# 40021 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 40030 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 40036 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 _5 : unit = Obj.magic _5 in
+        let _4 : (Parsetree.core_type) = 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__5_ in
+        let _v : (Parsetree.pattern) = let _1 =
+          let _1 =
+            let _loc__5_ = (_startpos__5_, _endpos__5_) in
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            
+# 2715 "parsing/parser.mly"
+      ( unclosed "(" _loc__1_ ")" _loc__5_ )
+# 40093 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 40103 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 40109 "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 : unit = 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__4_ in
+        let _v : (Parsetree.pattern) = let _1 =
+          let _1 =
+            let _loc__4_ = (_startpos__4_, _endpos__4_) in
+            
+# 2717 "parsing/parser.mly"
+      ( expecting _loc__4_ "type" )
+# 40158 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 40168 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 40174 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              MenhirLib.EngineTypes.next = {
+                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 = _1_inlined2;
+                  MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+                  MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+                  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.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 _7 : unit = Obj.magic _7 in
+        let _1_inlined3 : (Parsetree.module_type) = Obj.magic _1_inlined3 in
+        let _5 : unit = Obj.magic _5 in
+        let _4 : (string option) = Obj.magic _4 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 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__7_ in
+        let _v : (Parsetree.pattern) = let _1 =
+          let _1 =
+            let _6 =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+              let _1 =
+                let _1 = 
+# 3320 "parsing/parser.mly"
+      ( Ptyp_package (package_type_of_module_type _1) )
+# 40253 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 40261 "parsing/parser.ml"
+                
+              in
+              
+# 3321 "parsing/parser.mly"
+      ( _1 )
+# 40267 "parsing/parser.ml"
+              
+            in
+            let _3 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 40277 "parsing/parser.ml"
+                
+              in
+              
+# 3742 "parsing/parser.mly"
+                    ( _1, _2 )
+# 40283 "parsing/parser.ml"
+              
+            in
+            let _loc__7_ = (_startpos__7_, _endpos__7_) in
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            
+# 2720 "parsing/parser.mly"
+      ( unclosed "(" _loc__1_ ")" _loc__7_ )
+# 40291 "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
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 40301 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 40307 "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.extension) = 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 _1 = 
+# 2722 "parsing/parser.mly"
+      ( Ppat_extension _1 )
+# 40333 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 848 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 40341 "parsing/parser.ml"
+          
+        in
+        
+# 2683 "parsing/parser.mly"
+      ( _1 )
+# 40347 "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 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 40368 "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) = 
+# 3652 "parsing/parser.mly"
+           ( _1 )
+# 40376 "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 : (
+# 697 "parsing/parser.mly"
+       (string)
+# 40397 "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) = 
+# 3653 "parsing/parser.mly"
+           ( _1 )
+# 40405 "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 : unit = 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) = 
+# 3654 "parsing/parser.mly"
+        ( "and" )
+# 40430 "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 : unit = 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) = 
+# 3655 "parsing/parser.mly"
+       ( "as" )
+# 40455 "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 : unit = 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) = 
+# 3656 "parsing/parser.mly"
+           ( "assert" )
+# 40480 "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 : unit = 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) = 
+# 3657 "parsing/parser.mly"
+          ( "begin" )
+# 40505 "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 : unit = 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) = 
+# 3658 "parsing/parser.mly"
+          ( "class" )
+# 40530 "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 : unit = 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) = 
+# 3659 "parsing/parser.mly"
+               ( "constraint" )
+# 40555 "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 : unit = 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) = 
+# 3660 "parsing/parser.mly"
+       ( "do" )
+# 40580 "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 : unit = 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) = 
+# 3661 "parsing/parser.mly"
+         ( "done" )
+# 40605 "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 : unit = 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) = 
+# 3662 "parsing/parser.mly"
+           ( "downto" )
+# 40630 "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 : unit = 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) = 
+# 3663 "parsing/parser.mly"
+         ( "else" )
+# 40655 "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 : unit = 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) = 
+# 3664 "parsing/parser.mly"
+        ( "end" )
+# 40680 "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 : unit = 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) = 
+# 3665 "parsing/parser.mly"
+              ( "exception" )
+# 40705 "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 : unit = 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) = 
+# 3666 "parsing/parser.mly"
+             ( "external" )
+# 40730 "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 : unit = 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) = 
+# 3667 "parsing/parser.mly"
+          ( "false" )
+# 40755 "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 : unit = 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) = 
+# 3668 "parsing/parser.mly"
+        ( "for" )
+# 40780 "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 : unit = 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) = 
+# 3669 "parsing/parser.mly"
+        ( "fun" )
+# 40805 "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 : unit = 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) = 
+# 3670 "parsing/parser.mly"
+             ( "function" )
+# 40830 "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 : unit = 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) = 
+# 3671 "parsing/parser.mly"
+            ( "functor" )
+# 40855 "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 : unit = 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) = 
+# 3672 "parsing/parser.mly"
+       ( "if" )
+# 40880 "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 : unit = 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) = 
+# 3673 "parsing/parser.mly"
+       ( "in" )
+# 40905 "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 : unit = 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) = 
+# 3674 "parsing/parser.mly"
+            ( "include" )
+# 40930 "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 : unit = 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) = 
+# 3675 "parsing/parser.mly"
+            ( "inherit" )
+# 40955 "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 : unit = 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) = 
+# 3676 "parsing/parser.mly"
+                ( "initializer" )
+# 40980 "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 : unit = 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) = 
+# 3677 "parsing/parser.mly"
+         ( "lazy" )
+# 41005 "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 : unit = 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) = 
+# 3678 "parsing/parser.mly"
+        ( "let" )
+# 41030 "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 : unit = 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) = 
+# 3679 "parsing/parser.mly"
+          ( "match" )
+# 41055 "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 : unit = 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) = 
+# 3680 "parsing/parser.mly"
+           ( "method" )
+# 41080 "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 : unit = 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) = 
+# 3681 "parsing/parser.mly"
+           ( "module" )
+# 41105 "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 : unit = 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) = 
+# 3682 "parsing/parser.mly"
+            ( "mutable" )
+# 41130 "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 : unit = 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) = 
+# 3683 "parsing/parser.mly"
+        ( "new" )
+# 41155 "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 : unit = 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) = 
+# 3684 "parsing/parser.mly"
+           ( "nonrec" )
+# 41180 "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 : unit = 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) = 
+# 3685 "parsing/parser.mly"
+           ( "object" )
+# 41205 "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 : unit = 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) = 
+# 3686 "parsing/parser.mly"
+       ( "of" )
+# 41230 "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 : unit = 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) = 
+# 3687 "parsing/parser.mly"
+         ( "open" )
+# 41255 "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 : unit = 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) = 
+# 3688 "parsing/parser.mly"
+       ( "or" )
+# 41280 "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 : unit = 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) = 
+# 3689 "parsing/parser.mly"
+            ( "private" )
+# 41305 "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 : unit = 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) = 
+# 3690 "parsing/parser.mly"
+        ( "rec" )
+# 41330 "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 : unit = 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) = 
+# 3691 "parsing/parser.mly"
+        ( "sig" )
+# 41355 "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 : unit = 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) = 
+# 3692 "parsing/parser.mly"
+           ( "struct" )
+# 41380 "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 : unit = 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) = 
+# 3693 "parsing/parser.mly"
+         ( "then" )
+# 41405 "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 : unit = 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) = 
+# 3694 "parsing/parser.mly"
+       ( "to" )
+# 41430 "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 : unit = 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) = 
+# 3695 "parsing/parser.mly"
+         ( "true" )
+# 41455 "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 : unit = 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) = 
+# 3696 "parsing/parser.mly"
+        ( "try" )
+# 41480 "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 : unit = 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) = 
+# 3697 "parsing/parser.mly"
+         ( "type" )
+# 41505 "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 : unit = 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) = 
+# 3698 "parsing/parser.mly"
+        ( "val" )
+# 41530 "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 : unit = 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) = 
+# 3699 "parsing/parser.mly"
+            ( "virtual" )
+# 41555 "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 : unit = 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) = 
+# 3700 "parsing/parser.mly"
+         ( "when" )
+# 41580 "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 : unit = 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) = 
+# 3701 "parsing/parser.mly"
+          ( "while" )
+# 41605 "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 : unit = 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) = 
+# 3702 "parsing/parser.mly"
+         ( "with" )
+# 41630 "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.type_exception * string Asttypes.loc option) = 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.type_exception * string Asttypes.loc option) = 
+# 2987 "parsing/parser.mly"
+    ( _1 )
+# 41655 "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 = _1_inlined5;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined5_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined5_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined4;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined4_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined4_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _1_inlined3;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _5;
+                MenhirLib.EngineTypes.startp = _startpos__5_;
+                MenhirLib.EngineTypes.endp = _endpos__5_;
+                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.next = {
+                    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 = _;
+                      MenhirLib.EngineTypes.semv = ext;
+                      MenhirLib.EngineTypes.startp = _startpos_ext_;
+                      MenhirLib.EngineTypes.endp = _endpos_ext_;
+                      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 _1_inlined5 : (Parsetree.attributes) = Obj.magic _1_inlined5 in
+        let _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
+        let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined2 : (Asttypes.label) = 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
+        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_inlined5_ in
+        let _v : (Parsetree.type_exception * string Asttypes.loc option) = let attrs =
+          let _1 = _1_inlined5 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 41731 "parsing/parser.ml"
+          
+        in
+        let _endpos_attrs_ = _endpos__1_inlined5_ in
+        let attrs2 =
+          let _1 = _1_inlined4 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 41740 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 41751 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 41762 "parsing/parser.ml"
+          
+        in
+        let attrs1 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 41770 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_attrs_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2996 "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 )
+# 41783 "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 = _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 _2 : (Parsetree.expression) = 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.expression) = 
+# 2511 "parsing/parser.mly"
+      ( _2 )
+# 41815 "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 = _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 _2 : (Parsetree.expression) = Obj.magic _2 in
+        let _1 : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = 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 _endpos = _endpos__2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2513 "parsing/parser.mly"
+      ( let (l, o, p) = _1 in ghexp ~loc:_sloc (Pexp_fun(l, o, p, _2)) )
+# 41850 "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 = _5;
+          MenhirLib.EngineTypes.startp = _startpos__5_;
+          MenhirLib.EngineTypes.endp = _endpos__5_;
+          MenhirLib.EngineTypes.next = {
+            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 = xs;
+              MenhirLib.EngineTypes.startp = _startpos_xs_;
+              MenhirLib.EngineTypes.endp = _endpos_xs_;
+              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 _5 : (Parsetree.expression) = Obj.magic _5 in
+        let _4 : unit = Obj.magic _4 in
+        let xs : (string Asttypes.loc list) = Obj.magic xs 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 : (Parsetree.expression) = let _3 = 
+# 2414 "parsing/parser.mly"
+    ( xs )
+# 41903 "parsing/parser.ml"
+         in
+        let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2515 "parsing/parser.mly"
+      ( mk_newtypes ~loc:_sloc _3 _5 )
+# 41911 "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 = xss;
+          MenhirLib.EngineTypes.startp = _startpos_xss_;
+          MenhirLib.EngineTypes.endp = _endpos_xss_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let xss : (Parsetree.structure_item list list) = Obj.magic xss in
+        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 _1 =
+            let ys = 
+# 260 ""
+    ( List.flatten xss )
+# 41938 "parsing/parser.ml"
+             in
+            let xs =
+              let items = 
+# 883 "parsing/parser.mly"
+    ( [] )
+# 41944 "parsing/parser.ml"
+               in
+              
+# 1297 "parsing/parser.mly"
+    ( items )
+# 41949 "parsing/parser.ml"
+              
+            in
+            
+# 267 ""
+    ( xs @ ys )
+# 41955 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+          let _endpos = _endpos__1_ in
+          let _startpos = _startpos__1_ in
+          
+# 805 "parsing/parser.mly"
+                              ( extra_str _startpos _endpos _1 )
+# 41964 "parsing/parser.ml"
+          
+        in
+        
+# 1290 "parsing/parser.mly"
+  ( _1 )
+# 41970 "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 = xss;
+          MenhirLib.EngineTypes.startp = _startpos_xss_;
+          MenhirLib.EngineTypes.endp = _endpos_xss_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e;
+              MenhirLib.EngineTypes.startp = _startpos_e_;
+              MenhirLib.EngineTypes.endp = _endpos_e_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let xss : (Parsetree.structure_item list list) = Obj.magic xss in
+        let _1 : (Parsetree.attributes) = Obj.magic _1 in
+        let e : (Parsetree.expression) = Obj.magic e in
+        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 _1 =
+            let ys = 
+# 260 ""
+    ( List.flatten xss )
+# 42011 "parsing/parser.ml"
+             in
+            let xs =
+              let items =
+                let x =
+                  let _1 =
+                    let _1 =
+                      let attrs = 
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 42021 "parsing/parser.ml"
+                       in
+                      
+# 1304 "parsing/parser.mly"
+    ( mkstrexp e attrs )
+# 42026 "parsing/parser.ml"
+                      
+                    in
+                    let _startpos__1_ = _startpos_e_ in
+                    let _startpos = _startpos__1_ in
+                    
+# 817 "parsing/parser.mly"
+  ( text_str _startpos @ [_1] )
+# 42034 "parsing/parser.ml"
+                    
+                  in
+                  let _startpos__1_ = _startpos_e_ in
+                  let _endpos = _endpos__1_ in
+                  let _startpos = _startpos__1_ in
+                  
+# 836 "parsing/parser.mly"
+  ( mark_rhs_docs _startpos _endpos;
+    _1 )
+# 42044 "parsing/parser.ml"
+                  
+                in
+                
+# 885 "parsing/parser.mly"
+    ( x )
+# 42050 "parsing/parser.ml"
+                
+              in
+              
+# 1297 "parsing/parser.mly"
+    ( items )
+# 42056 "parsing/parser.ml"
+              
+            in
+            
+# 267 ""
+    ( xs @ ys )
+# 42062 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
+          let _endpos = _endpos__1_ in
+          let _startpos = _startpos__1_ in
+          
+# 805 "parsing/parser.mly"
+                              ( extra_str _startpos _endpos _1 )
+# 42071 "parsing/parser.ml"
+          
+        in
+        
+# 1290 "parsing/parser.mly"
+  ( _1 )
+# 42077 "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 : (let_bindings) = 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.structure_item) = let _endpos = _endpos__1_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1319 "parsing/parser.mly"
+      ( val_of_let_bindings ~loc:_sloc _1 )
+# 42105 "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 = _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 _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let _1 : (Parsetree.extension) = 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.structure_item) = let _1 =
+          let _1 =
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 42141 "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
+            
+# 1322 "parsing/parser.mly"
+        ( let docs = symbol_docs _sloc in
+          Pstr_extension (_1, add_docs_attrs docs _2) )
+# 42152 "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
+          
+# 852 "parsing/parser.mly"
+    ( mkstr ~loc:_sloc _1 )
+# 42162 "parsing/parser.ml"
+          
+        in
+        
+# 1353 "parsing/parser.mly"
+    ( _1 )
+# 42168 "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.attribute) = 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.structure_item) = let _1 =
+          let _1 = 
+# 1325 "parsing/parser.mly"
+        ( Pstr_attribute _1 )
+# 42194 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 852 "parsing/parser.mly"
+    ( mkstr ~loc:_sloc _1 )
+# 42202 "parsing/parser.ml"
+          
+        in
+        
+# 1353 "parsing/parser.mly"
+    ( _1 )
+# 42208 "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.value_description * string Asttypes.loc option) = 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.structure_item) = let _1 =
+          let _1 = 
+# 1329 "parsing/parser.mly"
+        ( pstr_primitive _1 )
+# 42234 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 869 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 42242 "parsing/parser.ml"
+          
+        in
+        
+# 1353 "parsing/parser.mly"
+    ( _1 )
+# 42248 "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.value_description * string Asttypes.loc option) = 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.structure_item) = let _1 =
+          let _1 = 
+# 1331 "parsing/parser.mly"
+        ( pstr_primitive _1 )
+# 42274 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 869 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 42282 "parsing/parser.ml"
+          
+        in
+        
+# 1353 "parsing/parser.mly"
+    ( _1 )
+# 42288 "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 = bs;
+          MenhirLib.EngineTypes.startp = _startpos_bs_;
+          MenhirLib.EngineTypes.endp = _endpos_bs_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = a;
+            MenhirLib.EngineTypes.startp = _startpos_a_;
+            MenhirLib.EngineTypes.endp = _endpos_a_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let bs : (Parsetree.type_declaration list) = Obj.magic bs in
+        let a : ((Asttypes.rec_flag * string Asttypes.loc option) *
+  Parsetree.type_declaration) = Obj.magic a in
+        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 _1 =
+            let _1 =
+              let _1 =
+                let _1 = 
+# 1044 "parsing/parser.mly"
+    ( let (x, b) = a in x, b :: bs )
+# 42325 "parsing/parser.ml"
+                 in
+                
+# 2842 "parsing/parser.mly"
+  ( _1 )
+# 42330 "parsing/parser.ml"
+                
+              in
+              
+# 2825 "parsing/parser.mly"
+    ( _1 )
+# 42336 "parsing/parser.ml"
+              
+            in
+            
+# 1333 "parsing/parser.mly"
+        ( pstr_type _1 )
+# 42342 "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
+          
+# 869 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 42352 "parsing/parser.ml"
+          
+        in
+        
+# 1353 "parsing/parser.mly"
+    ( _1 )
+# 42358 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = xs;
+            MenhirLib.EngineTypes.startp = _startpos_xs_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = priv;
+              MenhirLib.EngineTypes.startp = _startpos_priv_;
+              MenhirLib.EngineTypes.endp = _endpos_priv_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _7;
+                MenhirLib.EngineTypes.startp = _startpos__7_;
+                MenhirLib.EngineTypes.endp = _endpos__7_;
+                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.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = params;
+                    MenhirLib.EngineTypes.startp = _startpos_params_;
+                    MenhirLib.EngineTypes.endp = _endpos_params_;
+                    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.next = {
+                        MenhirLib.EngineTypes.state = _;
+                        MenhirLib.EngineTypes.semv = ext;
+                        MenhirLib.EngineTypes.startp = _startpos_ext_;
+                        MenhirLib.EngineTypes.endp = _endpos_ext_;
+                        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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let xs : (Parsetree.extension_constructor list) = Obj.magic xs in
+        let priv : (Asttypes.private_flag) = Obj.magic priv in
+        let _7 : unit = Obj.magic _7 in
+        let _1_inlined2 : (Longident.t) = Obj.magic _1_inlined2 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext 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_inlined3_ in
+        let _v : (Parsetree.structure_item) = let _1 =
+          let _1 =
+            let _1 =
+              let _1 =
+                let attrs2 =
+                  let _1 = _1_inlined3 in
+                  
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 42445 "parsing/parser.ml"
+                  
+                in
+                let _endpos_attrs2_ = _endpos__1_inlined3_ in
+                let cs = 
+# 1036 "parsing/parser.mly"
+    ( List.rev xs )
+# 42452 "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
+                  
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 42462 "parsing/parser.ml"
+                  
+                in
+                let _4 = 
+# 3574 "parsing/parser.mly"
+                ( Recursive )
+# 42468 "parsing/parser.ml"
+                 in
+                let attrs1 =
+                  let _1 = _1_inlined1 in
+                  
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 42475 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos_attrs2_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 3079 "parsing/parser.mly"
+    ( let docs = symbol_docs _sloc in
+      let attrs = attrs1 @ attrs2 in
+      Te.mk tid cs ~params ~priv ~attrs ~docs,
+      ext )
+# 42487 "parsing/parser.ml"
+                
+              in
+              
+# 3062 "parsing/parser.mly"
+    ( _1 )
+# 42493 "parsing/parser.ml"
+              
+            in
+            
+# 1335 "parsing/parser.mly"
+        ( pstr_typext _1 )
+# 42499 "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
+          
+# 869 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 42509 "parsing/parser.ml"
+          
+        in
+        
+# 1353 "parsing/parser.mly"
+    ( _1 )
+# 42515 "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 = _1_inlined4;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined4_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined4_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = xs;
+            MenhirLib.EngineTypes.startp = _startpos_xs_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = priv;
+              MenhirLib.EngineTypes.startp = _startpos_priv_;
+              MenhirLib.EngineTypes.endp = _endpos_priv_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _7;
+                MenhirLib.EngineTypes.startp = _startpos__7_;
+                MenhirLib.EngineTypes.endp = _endpos__7_;
+                MenhirLib.EngineTypes.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = _1_inlined3;
+                  MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+                  MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+                  MenhirLib.EngineTypes.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = params;
+                    MenhirLib.EngineTypes.startp = _startpos_params_;
+                    MenhirLib.EngineTypes.endp = _endpos_params_;
+                    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.next = {
+                        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 = _;
+                          MenhirLib.EngineTypes.semv = ext;
+                          MenhirLib.EngineTypes.startp = _startpos_ext_;
+                          MenhirLib.EngineTypes.endp = _endpos_ext_;
+                          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 _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
+        let xs : (Parsetree.extension_constructor list) = Obj.magic xs in
+        let priv : (Asttypes.private_flag) = Obj.magic priv in
+        let _7 : unit = Obj.magic _7 in
+        let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let _1_inlined2 : unit = 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
+        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_inlined4_ in
+        let _v : (Parsetree.structure_item) = let _1 =
+          let _1 =
+            let _1 =
+              let _1 =
+                let attrs2 =
+                  let _1 = _1_inlined4 in
+                  
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 42609 "parsing/parser.ml"
+                  
+                in
+                let _endpos_attrs2_ = _endpos__1_inlined4_ in
+                let cs = 
+# 1036 "parsing/parser.mly"
+    ( List.rev xs )
+# 42616 "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
+                  
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 42626 "parsing/parser.ml"
+                  
+                in
+                let _4 =
+                  let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+                  let _endpos = _endpos__1_ in
+                  let _startpos = _startpos__1_ in
+                  let _loc = (_startpos, _endpos) in
+                  
+# 3575 "parsing/parser.mly"
+                ( not_expecting _loc "nonrec flag" )
+# 42637 "parsing/parser.ml"
+                  
+                in
+                let attrs1 =
+                  let _1 = _1_inlined1 in
+                  
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 42645 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos_attrs2_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 3079 "parsing/parser.mly"
+    ( let docs = symbol_docs _sloc in
+      let attrs = attrs1 @ attrs2 in
+      Te.mk tid cs ~params ~priv ~attrs ~docs,
+      ext )
+# 42657 "parsing/parser.ml"
+                
+              in
+              
+# 3062 "parsing/parser.mly"
+    ( _1 )
+# 42663 "parsing/parser.ml"
+              
+            in
+            
+# 1335 "parsing/parser.mly"
+        ( pstr_typext _1 )
+# 42669 "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
+          
+# 869 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 42679 "parsing/parser.ml"
+          
+        in
+        
+# 1353 "parsing/parser.mly"
+    ( _1 )
+# 42685 "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.type_exception * string Asttypes.loc option) = 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.structure_item) = let _1 =
+          let _1 = 
+# 1337 "parsing/parser.mly"
+        ( pstr_exception _1 )
+# 42711 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 869 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 42719 "parsing/parser.ml"
+          
+        in
+        
+# 1353 "parsing/parser.mly"
+    ( _1 )
+# 42725 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = body;
+            MenhirLib.EngineTypes.startp = _startpos_body_;
+            MenhirLib.EngineTypes.endp = _endpos_body_;
+            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.next = {
+                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 = _;
+                  MenhirLib.EngineTypes.semv = ext;
+                  MenhirLib.EngineTypes.startp = _startpos_ext_;
+                  MenhirLib.EngineTypes.endp = _endpos_ext_;
+                  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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let body : (Parsetree.module_expr) = Obj.magic body in
+        let _1_inlined2 : (string option) = 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
+        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_inlined3_ in
+        let _v : (Parsetree.structure_item) = let _1 =
+          let _1 =
+            let _1 =
+              let attrs2 =
+                let _1 = _1_inlined3 in
+                
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 42790 "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
+                
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 42802 "parsing/parser.ml"
+                
+              in
+              let attrs1 =
+                let _1 = _1_inlined1 in
+                
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 42810 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos_attrs2_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1363 "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 )
+# 42823 "parsing/parser.ml"
+              
+            in
+            
+# 1339 "parsing/parser.mly"
+        ( _1 )
+# 42829 "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
+          
+# 869 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 42839 "parsing/parser.ml"
+          
+        in
+        
+# 1353 "parsing/parser.mly"
+    ( _1 )
+# 42845 "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 = bs;
+          MenhirLib.EngineTypes.startp = _startpos_bs_;
+          MenhirLib.EngineTypes.endp = _endpos_bs_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = body;
+              MenhirLib.EngineTypes.startp = _startpos_body_;
+              MenhirLib.EngineTypes.endp = _endpos_body_;
+              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.next = {
+                  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 = _1_inlined1;
+                    MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+                    MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+                    MenhirLib.EngineTypes.next = {
+                      MenhirLib.EngineTypes.state = _;
+                      MenhirLib.EngineTypes.semv = ext;
+                      MenhirLib.EngineTypes.startp = _startpos_ext_;
+                      MenhirLib.EngineTypes.endp = _endpos_ext_;
+                      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 bs : (Parsetree.module_binding list) = Obj.magic bs in
+        let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let body : (Parsetree.module_expr) = Obj.magic body in
+        let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in
+        let _4 : unit = Obj.magic _4 in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext 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_bs_ in
+        let _v : (Parsetree.structure_item) = let _1 =
+          let _1 =
+            let _1 =
+              let _1 =
+                let a =
+                  let attrs2 =
+                    let _1 = _1_inlined3 in
+                    
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 42926 "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
+                    
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 42938 "parsing/parser.ml"
+                    
+                  in
+                  let attrs1 =
+                    let _1 = _1_inlined1 in
+                    
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 42946 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos_attrs2_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 1397 "parsing/parser.mly"
+  (
+    let loc = make_loc _sloc in
+    let attrs = attrs1 @ attrs2 in
+    let docs = symbol_docs _sloc in
+    ext,
+    Mb.mk name body ~attrs ~loc ~docs
+  )
+# 42961 "parsing/parser.ml"
+                  
+                in
+                
+# 1044 "parsing/parser.mly"
+    ( let (x, b) = a in x, b :: bs )
+# 42967 "parsing/parser.ml"
+                
+              in
+              
+# 1385 "parsing/parser.mly"
+    ( _1 )
+# 42973 "parsing/parser.ml"
+              
+            in
+            
+# 1341 "parsing/parser.mly"
+        ( pstr_recmodule _1 )
+# 42979 "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
+          
+# 869 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 42989 "parsing/parser.ml"
+          
+        in
+        
+# 1353 "parsing/parser.mly"
+    ( _1 )
+# 42995 "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.module_type_declaration * string Asttypes.loc option) = 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.structure_item) = let _1 =
+          let _1 = 
+# 1343 "parsing/parser.mly"
+        ( let (body, ext) = _1 in (Pstr_modtype body, ext) )
+# 43021 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 869 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 43029 "parsing/parser.ml"
+          
+        in
+        
+# 1353 "parsing/parser.mly"
+    ( _1 )
+# 43035 "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.open_declaration * string Asttypes.loc option) = 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.structure_item) = let _1 =
+          let _1 = 
+# 1345 "parsing/parser.mly"
+        ( let (body, ext) = _1 in (Pstr_open body, ext) )
+# 43061 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 869 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 43069 "parsing/parser.ml"
+          
+        in
+        
+# 1353 "parsing/parser.mly"
+    ( _1 )
+# 43075 "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 = bs;
+          MenhirLib.EngineTypes.startp = _startpos_bs_;
+          MenhirLib.EngineTypes.endp = _endpos_bs_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1_inlined3;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = body;
+              MenhirLib.EngineTypes.startp = _startpos_body_;
+              MenhirLib.EngineTypes.endp = _endpos_body_;
+              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.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = params;
+                  MenhirLib.EngineTypes.startp = _startpos_params_;
+                  MenhirLib.EngineTypes.endp = _endpos_params_;
+                  MenhirLib.EngineTypes.next = {
+                    MenhirLib.EngineTypes.state = _;
+                    MenhirLib.EngineTypes.semv = virt;
+                    MenhirLib.EngineTypes.startp = _startpos_virt_;
+                    MenhirLib.EngineTypes.endp = _endpos_virt_;
+                    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.next = {
+                        MenhirLib.EngineTypes.state = _;
+                        MenhirLib.EngineTypes.semv = ext;
+                        MenhirLib.EngineTypes.startp = _startpos_ext_;
+                        MenhirLib.EngineTypes.endp = _endpos_ext_;
+                        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 bs : (Parsetree.class_declaration list) = Obj.magic bs in
+        let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let body : (Parsetree.class_expr) = Obj.magic body in
+        let _1_inlined2 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 43147 "parsing/parser.ml"
+        ) = Obj.magic _1_inlined2 in
+        let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+        let virt : (Asttypes.virtual_flag) = Obj.magic virt in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext 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_bs_ in
+        let _v : (Parsetree.structure_item) = let _1 =
+          let _1 =
+            let _1 =
+              let _1 =
+                let a =
+                  let attrs2 =
+                    let _1 = _1_inlined3 in
+                    
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 43167 "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
+                    
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 43179 "parsing/parser.ml"
+                    
+                  in
+                  let attrs1 =
+                    let _1 = _1_inlined1 in
+                    
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 43187 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos_attrs2_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 1715 "parsing/parser.mly"
+  (
+    let attrs = attrs1 @ attrs2 in
+    let loc = make_loc _sloc in
+    let docs = symbol_docs _sloc in
+    ext,
+    Ci.mk id body ~virt ~params ~attrs ~loc ~docs
+  )
+# 43202 "parsing/parser.ml"
+                  
+                in
+                
+# 1044 "parsing/parser.mly"
+    ( let (x, b) = a in x, b :: bs )
+# 43208 "parsing/parser.ml"
+                
+              in
+              
+# 1704 "parsing/parser.mly"
+    ( _1 )
+# 43214 "parsing/parser.ml"
+              
+            in
+            
+# 1347 "parsing/parser.mly"
+        ( let (ext, l) = _1 in (Pstr_class l, ext) )
+# 43220 "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
+          
+# 869 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 43230 "parsing/parser.ml"
+          
+        in
+        
+# 1353 "parsing/parser.mly"
+    ( _1 )
+# 43236 "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 : (string Asttypes.loc option * Parsetree.class_type_declaration list) = 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.structure_item) = let _1 =
+          let _1 = 
+# 1349 "parsing/parser.mly"
+        ( let (ext, l) = _1 in (Pstr_class_type l, ext) )
+# 43262 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 869 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 43270 "parsing/parser.ml"
+          
+        in
+        
+# 1353 "parsing/parser.mly"
+    ( _1 )
+# 43276 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = thing;
+            MenhirLib.EngineTypes.startp = _startpos_thing_;
+            MenhirLib.EngineTypes.endp = _endpos_thing_;
+            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.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = ext;
+                MenhirLib.EngineTypes.startp = _startpos_ext_;
+                MenhirLib.EngineTypes.endp = _endpos_ext_;
+                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 _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let thing : (Parsetree.module_expr) = Obj.magic thing in
+        let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let ext : (string Asttypes.loc option) = Obj.magic ext 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.structure_item) = let _1 =
+          let _1 =
+            let _1 =
+              let attrs2 =
+                let _1 = _1_inlined2 in
+                
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 43334 "parsing/parser.ml"
+                
+              in
+              let _endpos_attrs2_ = _endpos__1_inlined2_ in
+              let attrs1 =
+                let _1 = _1_inlined1 in
+                
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 43343 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos_attrs2_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1434 "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
+  )
+# 43357 "parsing/parser.ml"
+              
+            in
+            
+# 1351 "parsing/parser.mly"
+        ( pstr_include _1 )
+# 43363 "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
+          
+# 869 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 43373 "parsing/parser.ml"
+          
+        in
+        
+# 1353 "parsing/parser.mly"
+    ( _1 )
+# 43379 "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 : unit = 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) = 
+# 3637 "parsing/parser.mly"
+                                                ( "-" )
+# 43404 "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 : unit = 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) = 
+# 3638 "parsing/parser.mly"
+                                                ( "-." )
+# 43429 "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 = _1_inlined1;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = xs;
+            MenhirLib.EngineTypes.startp = _startpos_xs_;
+            MenhirLib.EngineTypes.endp = _endpos_xs_;
+            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 _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let xs : (Parsetree.core_type list) = Obj.magic xs in
+        let _3 : (bool) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Asttypes.label) = 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.row_field) = let _5 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 43484 "parsing/parser.ml"
+          
+        in
+        let _endpos__5_ = _endpos__1_inlined1_ in
+        let _4 =
+          let _1 =
+            let xs = 
+# 253 ""
+    ( List.rev xs )
+# 43493 "parsing/parser.ml"
+             in
+            
+# 947 "parsing/parser.mly"
+    ( xs )
+# 43498 "parsing/parser.ml"
+            
+          in
+          
+# 3349 "parsing/parser.mly"
+    ( _1 )
+# 43504 "parsing/parser.ml"
+          
+        in
+        let _1 =
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 43514 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3335 "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 )
+# 43525 "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 = _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 _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+        let _1 : (Asttypes.label) = 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.row_field) = let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 43559 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 43570 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3339 "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 [] )
+# 43581 "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 = _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 _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_inlined1_ in
+        let _v : (Parsetree.toplevel_phrase) = let arg = 
+# 124 ""
+    ( None )
+# 43613 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 43624 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_arg_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3537 "parsing/parser.mly"
+    ( mk_directive ~loc:_sloc dir arg )
+# 43633 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          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.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 _1_inlined2 : (
+# 685 "parsing/parser.mly"
+       (string * Location.t * string option)
+# 43666 "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 = 
+# 3541 "parsing/parser.mly"
+                  ( let (s, _, _) = _1 in Pdir_string s )
+# 43679 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 874 "parsing/parser.mly"
+    ( mk_directive_arg ~loc:_sloc _1 )
+# 43687 "parsing/parser.ml"
+            
+          in
+          
+# 126 ""
+    ( Some x )
+# 43693 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 43705 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_arg_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3537 "parsing/parser.mly"
+    ( mk_directive ~loc:_sloc dir arg )
+# 43714 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          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.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 _1_inlined2 : (
+# 633 "parsing/parser.mly"
+       (string * char option)
+# 43747 "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 = 
+# 3542 "parsing/parser.mly"
+                  ( let (n, m) = _1 in Pdir_int (n ,m) )
+# 43760 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 874 "parsing/parser.mly"
+    ( mk_directive_arg ~loc:_sloc _1 )
+# 43768 "parsing/parser.ml"
+            
+          in
+          
+# 126 ""
+    ( Some x )
+# 43774 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 43786 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_arg_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3537 "parsing/parser.mly"
+    ( mk_directive ~loc:_sloc dir arg )
+# 43795 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          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.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 _1_inlined2 : (Longident.t) = 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 = 
+# 3543 "parsing/parser.mly"
+                  ( Pdir_ident _1 )
+# 43837 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 874 "parsing/parser.mly"
+    ( mk_directive_arg ~loc:_sloc _1 )
+# 43845 "parsing/parser.ml"
+            
+          in
+          
+# 126 ""
+    ( Some x )
+# 43851 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 43863 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_arg_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3537 "parsing/parser.mly"
+    ( mk_directive ~loc:_sloc dir arg )
+# 43872 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          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.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 _1_inlined2 : (Longident.t) = 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 = 
+# 3544 "parsing/parser.mly"
+                  ( Pdir_ident _1 )
+# 43914 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 874 "parsing/parser.mly"
+    ( mk_directive_arg ~loc:_sloc _1 )
+# 43922 "parsing/parser.ml"
+            
+          in
+          
+# 126 ""
+    ( Some x )
+# 43928 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 43940 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_arg_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3537 "parsing/parser.mly"
+    ( mk_directive ~loc:_sloc dir arg )
+# 43949 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          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.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 _1_inlined2 : unit = 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 = 
+# 3545 "parsing/parser.mly"
+                  ( Pdir_bool false )
+# 43991 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 874 "parsing/parser.mly"
+    ( mk_directive_arg ~loc:_sloc _1 )
+# 43999 "parsing/parser.ml"
+            
+          in
+          
+# 126 ""
+    ( Some x )
+# 44005 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 44017 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_arg_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3537 "parsing/parser.mly"
+    ( mk_directive ~loc:_sloc dir arg )
+# 44026 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          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.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 _1_inlined2 : unit = 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 = 
+# 3546 "parsing/parser.mly"
+                  ( Pdir_bool true )
+# 44068 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 874 "parsing/parser.mly"
+    ( mk_directive_arg ~loc:_sloc _1 )
+# 44076 "parsing/parser.ml"
+            
+          in
+          
+# 126 ""
+    ( Some x )
+# 44082 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 44094 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_arg_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3537 "parsing/parser.mly"
+    ( mk_directive ~loc:_sloc dir arg )
+# 44103 "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 = _2;
+          MenhirLib.EngineTypes.startp = _startpos__2_;
+          MenhirLib.EngineTypes.endp = _endpos__2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = e;
+              MenhirLib.EngineTypes.startp = _startpos_e_;
+              MenhirLib.EngineTypes.endp = _endpos_e_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Parsetree.attributes) = Obj.magic _1 in
+        let e : (Parsetree.expression) = Obj.magic e in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_e_ in
+        let _endpos = _endpos__2_ in
+        let _v : (
+# 781 "parsing/parser.mly"
+      (Parsetree.toplevel_phrase)
+# 44142 "parsing/parser.ml"
+        ) = let _1 =
+          let _1 =
+            let _1 =
+              let attrs = 
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 44149 "parsing/parser.ml"
+               in
+              
+# 1304 "parsing/parser.mly"
+    ( mkstrexp e attrs )
+# 44154 "parsing/parser.ml"
+              
+            in
+            let _startpos__1_ = _startpos_e_ in
+            let _startpos = _startpos__1_ in
+            
+# 817 "parsing/parser.mly"
+  ( text_str _startpos @ [_1] )
+# 44162 "parsing/parser.ml"
+            
+          in
+          let _startpos__1_ = _startpos_e_ in
+          let _endpos = _endpos__1_ in
+          let _startpos = _startpos__1_ in
+          
+# 805 "parsing/parser.mly"
+                              ( extra_str _startpos _endpos _1 )
+# 44171 "parsing/parser.ml"
+          
+        in
+        
+# 1082 "parsing/parser.mly"
+    ( Ptop_def _1 )
+# 44177 "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 = _2;
+          MenhirLib.EngineTypes.startp = _startpos__2_;
+          MenhirLib.EngineTypes.endp = _endpos__2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = xss;
+            MenhirLib.EngineTypes.startp = _startpos_xss_;
+            MenhirLib.EngineTypes.endp = _endpos_xss_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let _2 : unit = Obj.magic _2 in
+        let xss : (Parsetree.structure_item list list) = Obj.magic xss in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_xss_ in
+        let _endpos = _endpos__2_ in
+        let _v : (
+# 781 "parsing/parser.mly"
+      (Parsetree.toplevel_phrase)
+# 44209 "parsing/parser.ml"
+        ) = let _1 =
+          let _1 = 
+# 260 ""
+    ( List.flatten xss )
+# 44214 "parsing/parser.ml"
+           in
+          let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+          let _endpos = _endpos__1_ in
+          let _startpos = _startpos__1_ in
+          
+# 805 "parsing/parser.mly"
+                              ( extra_str _startpos _endpos _1 )
+# 44222 "parsing/parser.ml"
+          
+        in
+        
+# 1086 "parsing/parser.mly"
+    ( Ptop_def _1 )
+# 44228 "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 = _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 _2 : unit = Obj.magic _2 in
+        let _1 : (Parsetree.toplevel_phrase) = 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 : (
+# 781 "parsing/parser.mly"
+      (Parsetree.toplevel_phrase)
+# 44260 "parsing/parser.ml"
+        ) = 
+# 1090 "parsing/parser.mly"
+    ( _1 )
+# 44264 "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 : unit = 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 : (
+# 781 "parsing/parser.mly"
+      (Parsetree.toplevel_phrase)
+# 44289 "parsing/parser.ml"
+        ) = 
+# 1093 "parsing/parser.mly"
+    ( raise End_of_file )
+# 44293 "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 = ty;
+          MenhirLib.EngineTypes.startp = _startpos_ty_;
+          MenhirLib.EngineTypes.endp = _endpos_ty_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let ty : (Parsetree.core_type) = Obj.magic ty in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_ty_ in
+        let _endpos = _endpos_ty_ in
+        let _v : (Parsetree.core_type) = 
+# 3241 "parsing/parser.mly"
+      ( ty )
+# 44318 "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 = xs;
+          MenhirLib.EngineTypes.startp = _startpos_xs_;
+          MenhirLib.EngineTypes.endp = _endpos_xs_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let xs : (Parsetree.core_type list) = Obj.magic xs in
+        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 _1 =
+            let tys =
+              let xs = 
+# 253 ""
+    ( List.rev xs )
+# 44346 "parsing/parser.ml"
+               in
+              
+# 975 "parsing/parser.mly"
+    ( xs )
+# 44351 "parsing/parser.ml"
+              
+            in
+            
+# 3244 "parsing/parser.mly"
+        ( Ptyp_tuple tys )
+# 44357 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 44367 "parsing/parser.ml"
+          
+        in
+        
+# 3246 "parsing/parser.mly"
+    ( _1 )
+# 44373 "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 = _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 _2 : (Parsetree.core_type) = 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.core_type option * Parsetree.core_type option) = 
+# 2589 "parsing/parser.mly"
+                                                ( (Some _2, None) )
+# 44405 "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.core_type) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (Parsetree.core_type) = 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.core_type option * Parsetree.core_type option) = 
+# 2590 "parsing/parser.mly"
+                                                ( (Some _2, Some _4) )
+# 44451 "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 = _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 _2 : (Parsetree.core_type) = 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.core_type option * Parsetree.core_type option) = 
+# 2591 "parsing/parser.mly"
+                                                ( (None, Some _2) )
+# 44483 "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 = _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 _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__2_ in
+        let _v : (Parsetree.core_type option * Parsetree.core_type option) = 
+# 2592 "parsing/parser.mly"
+                                                ( syntax_error() )
+# 44515 "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 = _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 _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__2_ in
+        let _v : (Parsetree.core_type option * Parsetree.core_type option) = 
+# 2593 "parsing/parser.mly"
+                                                ( syntax_error() )
+# 44547 "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.type_kind * Asttypes.private_flag * Parsetree.core_type option) = 
+# 2916 "parsing/parser.mly"
+      ( (Ptype_abstract, Public, None) )
+# 44565 "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 = _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 _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = 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.type_kind * Asttypes.private_flag * Parsetree.core_type option) = 
+# 2918 "parsing/parser.mly"
+      ( _2 )
+# 44597 "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 : (Longident.t) = 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) = 
+# 3500 "parsing/parser.mly"
+                                             ( _1 )
+# 44622 "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 = _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 _2 : (Parsetree.core_type) = Obj.magic _2 in
+        let _1 : (Asttypes.variance) = 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.core_type * Asttypes.variance) = 
+# 2933 "parsing/parser.mly"
+                                       ( _2, _1 )
+# 44654 "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.core_type * Asttypes.variance) list) = 
+# 2926 "parsing/parser.mly"
+      ( [] )
+# 44672 "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 = p;
+          MenhirLib.EngineTypes.startp = _startpos_p_;
+          MenhirLib.EngineTypes.endp = _endpos_p_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let p : (Parsetree.core_type * Asttypes.variance) = Obj.magic p in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_p_ in
+        let _endpos = _endpos_p_ in
+        let _v : ((Parsetree.core_type * Asttypes.variance) list) = 
+# 2928 "parsing/parser.mly"
+      ( [p] )
+# 44697 "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 = 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 _3 : unit = Obj.magic _3 in
+        let xs : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic xs 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.core_type * Asttypes.variance) list) = let ps =
+          let xs = 
+# 253 ""
+    ( List.rev xs )
+# 44737 "parsing/parser.ml"
+           in
+          
+# 947 "parsing/parser.mly"
+    ( xs )
+# 44742 "parsing/parser.ml"
+          
+        in
+        
+# 2930 "parsing/parser.mly"
+      ( ps )
+# 44748 "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 = tyvar;
+          MenhirLib.EngineTypes.startp = _startpos_tyvar_;
+          MenhirLib.EngineTypes.endp = _endpos_tyvar_;
+          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 tyvar : (Asttypes.label) = Obj.magic tyvar 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_tyvar_ in
+        let _v : (Parsetree.core_type) = let _1 =
+          let _1 = 
+# 2938 "parsing/parser.mly"
+      ( Ptyp_var tyvar )
+# 44781 "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
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 44790 "parsing/parser.ml"
+          
+        in
+        
+# 2941 "parsing/parser.mly"
+    ( _1 )
+# 44796 "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 : unit = 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) = let _1 =
+          let _1 = 
+# 2940 "parsing/parser.mly"
+      ( Ptyp_any )
+# 44822 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 850 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 44830 "parsing/parser.ml"
+          
+        in
+        
+# 2941 "parsing/parser.mly"
+    ( _1 )
+# 44836 "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 : (Asttypes.variance) = 
+# 2945 "parsing/parser.mly"
+                                                ( Invariant )
+# 44854 "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 : unit = 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) = 
+# 2946 "parsing/parser.mly"
+                                                ( Covariant )
+# 44879 "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 : unit = 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) = 
+# 2947 "parsing/parser.mly"
+                                                ( Contravariant )
+# 44904 "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 = _2;
+          MenhirLib.EngineTypes.startp = _startpos__2_;
+          MenhirLib.EngineTypes.endp = _endpos__2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = xss;
+            MenhirLib.EngineTypes.startp = _startpos_xss_;
+            MenhirLib.EngineTypes.endp = _endpos_xss_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let _2 : unit = Obj.magic _2 in
+        let xss : (Parsetree.toplevel_phrase list list) = Obj.magic xss in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_xss_ in
+        let _endpos = _endpos__2_ in
+        let _v : (
+# 783 "parsing/parser.mly"
+      (Parsetree.toplevel_phrase list)
+# 44936 "parsing/parser.ml"
+        ) = let _1 =
+          let _1 =
+            let ys = 
+# 260 ""
+    ( List.flatten xss )
+# 44942 "parsing/parser.ml"
+             in
+            let xs =
+              let _1 = 
+# 883 "parsing/parser.mly"
+    ( [] )
+# 44948 "parsing/parser.ml"
+               in
+              
+# 1113 "parsing/parser.mly"
+    ( _1 )
+# 44953 "parsing/parser.ml"
+              
+            in
+            
+# 267 ""
+    ( xs @ ys )
+# 44959 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+          let _endpos = _endpos__1_ in
+          let _startpos = _startpos__1_ in
+          
+# 809 "parsing/parser.mly"
+                              ( extra_def _startpos _endpos _1 )
+# 44968 "parsing/parser.ml"
+          
+        in
+        
+# 1106 "parsing/parser.mly"
+    ( _1 )
+# 44974 "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 = _2;
+          MenhirLib.EngineTypes.startp = _startpos__2_;
+          MenhirLib.EngineTypes.endp = _endpos__2_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = xss;
+            MenhirLib.EngineTypes.startp = _startpos_xss_;
+            MenhirLib.EngineTypes.endp = _endpos_xss_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _menhir_s;
+                MenhirLib.EngineTypes.semv = e;
+                MenhirLib.EngineTypes.startp = _startpos_e_;
+                MenhirLib.EngineTypes.endp = _endpos_e_;
+                MenhirLib.EngineTypes.next = _menhir_stack;
+              };
+            };
+          };
+        } = _menhir_stack in
+        let _2 : unit = Obj.magic _2 in
+        let xss : (Parsetree.toplevel_phrase list list) = Obj.magic xss in
+        let _1 : (Parsetree.attributes) = Obj.magic _1 in
+        let e : (Parsetree.expression) = Obj.magic e in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_e_ in
+        let _endpos = _endpos__2_ in
+        let _v : (
+# 783 "parsing/parser.mly"
+      (Parsetree.toplevel_phrase list)
+# 45020 "parsing/parser.ml"
+        ) = let _1 =
+          let _1 =
+            let ys = 
+# 260 ""
+    ( List.flatten xss )
+# 45026 "parsing/parser.ml"
+             in
+            let xs =
+              let _1 =
+                let x =
+                  let _1 =
+                    let _1 =
+                      let attrs = 
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 45036 "parsing/parser.ml"
+                       in
+                      
+# 1304 "parsing/parser.mly"
+    ( mkstrexp e attrs )
+# 45041 "parsing/parser.ml"
+                      
+                    in
+                    
+# 827 "parsing/parser.mly"
+  ( Ptop_def [_1] )
+# 45047 "parsing/parser.ml"
+                    
+                  in
+                  let _startpos__1_ = _startpos_e_ in
+                  let _startpos = _startpos__1_ in
+                  
+# 825 "parsing/parser.mly"
+  ( text_def _startpos @ [_1] )
+# 45055 "parsing/parser.ml"
+                  
+                in
+                
+# 885 "parsing/parser.mly"
+    ( x )
+# 45061 "parsing/parser.ml"
+                
+              in
+              
+# 1113 "parsing/parser.mly"
+    ( _1 )
+# 45067 "parsing/parser.ml"
+              
+            in
+            
+# 267 ""
+    ( xs @ ys )
+# 45073 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
+          let _endpos = _endpos__1_ in
+          let _startpos = _startpos__1_ in
+          
+# 809 "parsing/parser.mly"
+                              ( extra_def _startpos _endpos _1 )
+# 45082 "parsing/parser.ml"
+          
+        in
+        
+# 1106 "parsing/parser.mly"
+    ( _1 )
+# 45088 "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 = _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 : (Asttypes.label) = 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 : (Asttypes.label) = 
+# 3419 "parsing/parser.mly"
+                              ( _2 )
+# 45127 "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 = _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 : (Asttypes.label) = 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 : (Asttypes.label) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
+        let _loc__1_ = (_startpos__1_, _endpos__1_) in
+        
+# 3420 "parsing/parser.mly"
+                              ( unclosed "(" _loc__1_ ")" _loc__3_ )
+# 45168 "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 = _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 _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__2_ in
+        let _v : (Asttypes.label) = let _loc__2_ = (_startpos__2_, _endpos__2_) in
+        
+# 3421 "parsing/parser.mly"
+                              ( expecting _loc__2_ "operator" )
+# 45201 "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 = _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 : 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 : (Asttypes.label) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
+        
+# 3422 "parsing/parser.mly"
+                              ( expecting _loc__3_ "module-expr" )
+# 45241 "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 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 45262 "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) = 
+# 3425 "parsing/parser.mly"
+                              ( _1 )
+# 45270 "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 : (Asttypes.label) = 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) = 
+# 3426 "parsing/parser.mly"
+                              ( _1 )
+# 45295 "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 : (Longident.t) = 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) = 
+# 3494 "parsing/parser.mly"
+                                           ( _1 )
+# 45320 "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 = ty;
+          MenhirLib.EngineTypes.startp = _startpos_ty_;
+          MenhirLib.EngineTypes.endp = _endpos_ty_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _5;
+            MenhirLib.EngineTypes.startp = _startpos__5_;
+            MenhirLib.EngineTypes.endp = _endpos__5_;
+            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.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = mutable_;
+                MenhirLib.EngineTypes.startp = _startpos_mutable__;
+                MenhirLib.EngineTypes.endp = _endpos_mutable__;
+                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 ty : (Parsetree.core_type) = Obj.magic ty in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 45367 "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 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 45381 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 45389 "parsing/parser.ml"
+          
+        in
+        let attrs = 
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 45395 "parsing/parser.ml"
+         in
+        let _1 = 
+# 3630 "parsing/parser.mly"
+                                                ( Fresh )
+# 45400 "parsing/parser.ml"
+         in
+        
+# 1855 "parsing/parser.mly"
+      ( (label, mutable_, Cfk_virtual ty), attrs )
+# 45405 "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 = _6;
+          MenhirLib.EngineTypes.startp = _startpos__6_;
+          MenhirLib.EngineTypes.endp = _endpos__6_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _5;
+            MenhirLib.EngineTypes.startp = _startpos__5_;
+            MenhirLib.EngineTypes.endp = _endpos__5_;
+            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.next = {
+                MenhirLib.EngineTypes.state = _;
+                MenhirLib.EngineTypes.semv = _3;
+                MenhirLib.EngineTypes.startp = _startpos__3_;
+                MenhirLib.EngineTypes.endp = _endpos__3_;
+                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 _6 : (Parsetree.expression) = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 45452 "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 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 45466 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 45474 "parsing/parser.ml"
+          
+        in
+        let _2 = 
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 45480 "parsing/parser.ml"
+         in
+        let _1 = 
+# 3633 "parsing/parser.mly"
+                                                ( Fresh )
+# 45485 "parsing/parser.ml"
+         in
+        
+# 1857 "parsing/parser.mly"
+      ( (_4, _3, Cfk_concrete (_1, _6)), _2 )
+# 45490 "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 = _6;
+          MenhirLib.EngineTypes.startp = _startpos__6_;
+          MenhirLib.EngineTypes.endp = _endpos__6_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _5;
+            MenhirLib.EngineTypes.startp = _startpos__5_;
+            MenhirLib.EngineTypes.endp = _endpos__5_;
+            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.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 = _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 _6 : (Parsetree.expression) = Obj.magic _6 in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined2 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 45543 "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
+        let _1 : unit = 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_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+          let _1 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 45558 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 45566 "parsing/parser.ml"
+          
+        in
+        let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 45574 "parsing/parser.ml"
+          
+        in
+        let _1 = 
+# 3634 "parsing/parser.mly"
+                                                ( Override )
+# 45580 "parsing/parser.ml"
+         in
+        
+# 1857 "parsing/parser.mly"
+      ( (_4, _3, Cfk_concrete (_1, _6)), _2 )
+# 45585 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              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.next = {
+                  MenhirLib.EngineTypes.state = _;
+                  MenhirLib.EngineTypes.semv = _3;
+                  MenhirLib.EngineTypes.startp = _startpos__3_;
+                  MenhirLib.EngineTypes.endp = _endpos__3_;
+                  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 _7 : (Parsetree.expression) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _5 : (Parsetree.core_type option * Parsetree.core_type option) = Obj.magic _5 in
+        let _1_inlined1 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 45639 "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 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 45653 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 45661 "parsing/parser.ml"
+          
+        in
+        let _startpos__4_ = _startpos__1_inlined1_ in
+        let _2 = 
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 45668 "parsing/parser.ml"
+         in
+        let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
+        let _1 = 
+# 3633 "parsing/parser.mly"
+                                                ( Fresh )
+# 45674 "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_
+          else
+            if _startpos__3_ != _endpos__3_ then
+              _startpos__3_
+            else
+              _startpos__4_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1860 "parsing/parser.mly"
+      ( let e = mkexp_constraint ~loc:_sloc _7 _5 in
+        (_4, _3, Cfk_concrete (_1, e)), _2
+      )
+# 45694 "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 = _7;
+          MenhirLib.EngineTypes.startp = _startpos__7_;
+          MenhirLib.EngineTypes.endp = _endpos__7_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _6;
+            MenhirLib.EngineTypes.startp = _startpos__6_;
+            MenhirLib.EngineTypes.endp = _endpos__6_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              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.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 = _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 _7 : (Parsetree.expression) = Obj.magic _7 in
+        let _6 : unit = Obj.magic _6 in
+        let _5 : (Parsetree.core_type option * Parsetree.core_type option) = Obj.magic _5 in
+        let _1_inlined2 : (
+# 647 "parsing/parser.mly"
+       (string)
+# 45754 "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
+        let _1 : unit = 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_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+          let _1 = 
+# 3393 "parsing/parser.mly"
+                                                ( _1 )
+# 45769 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 45777 "parsing/parser.ml"
+          
+        in
+        let _startpos__4_ = _startpos__1_inlined2_ in
+        let _2 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 45786 "parsing/parser.ml"
+          
+        in
+        let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
+        let _1 = 
+# 3634 "parsing/parser.mly"
+                                                ( Override )
+# 45793 "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_
+          else
+            if _startpos__3_ != _endpos__3_ then
+              _startpos__3_
+            else
+              _startpos__4_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 1860 "parsing/parser.mly"
+      ( let e = mkexp_constraint ~loc:_sloc _7 _5 in
+        (_4, _3, Cfk_concrete (_1, e)), _2
+      )
+# 45812 "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 = _1_inlined3;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = ty;
+            MenhirLib.EngineTypes.startp = _startpos_ty_;
+            MenhirLib.EngineTypes.endp = _endpos_ty_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _5;
+              MenhirLib.EngineTypes.startp = _startpos__5_;
+              MenhirLib.EngineTypes.endp = _endpos__5_;
+              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.next = {
+                  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 = _;
+                    MenhirLib.EngineTypes.semv = ext;
+                    MenhirLib.EngineTypes.startp = _startpos_ext_;
+                    MenhirLib.EngineTypes.endp = _endpos_ext_;
+                    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 _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+        let ty : (Parsetree.core_type) = Obj.magic ty in
+        let _5 : unit = Obj.magic _5 in
+        let _1_inlined2 : (Asttypes.label) = 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
+        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_inlined3_ in
+        let _v : (Parsetree.value_description * string Asttypes.loc option) = let attrs2 =
+          let _1 = _1_inlined3 in
+          
+# 3727 "parsing/parser.mly"
+    ( _1 )
+# 45881 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 45893 "parsing/parser.ml"
+          
+        in
+        let attrs1 =
+          let _1 = _1_inlined1 in
+          
+# 3731 "parsing/parser.mly"
+    ( _1 )
+# 45901 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos_attrs2_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 2787 "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 )
+# 45914 "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 : (Asttypes.virtual_flag) = 
+# 3594 "parsing/parser.mly"
+                                                ( Concrete )
+# 45932 "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 : unit = 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.virtual_flag) = 
+# 3595 "parsing/parser.mly"
+                                                ( Virtual )
+# 45957 "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 : unit = 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.mutable_flag) = 
+# 3618 "parsing/parser.mly"
+            ( Immutable )
+# 45982 "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 = _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 _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__2_ in
+        let _v : (Asttypes.mutable_flag) = 
+# 3619 "parsing/parser.mly"
+                    ( Mutable )
+# 46014 "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 = _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 _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__2_ in
+        let _v : (Asttypes.mutable_flag) = 
+# 3620 "parsing/parser.mly"
+                    ( Mutable )
+# 46046 "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 : unit = 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.private_flag) = 
+# 3625 "parsing/parser.mly"
+            ( Public )
+# 46071 "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 = _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 _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__2_ in
+        let _v : (Asttypes.private_flag) = 
+# 3626 "parsing/parser.mly"
+                    ( Private )
+# 46103 "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 = _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 _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__2_ in
+        let _v : (Asttypes.private_flag) = 
+# 3627 "parsing/parser.mly"
+                    ( Private )
+# 46135 "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 = _;
+            MenhirLib.EngineTypes.semv = _1_inlined2;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+            MenhirLib.EngineTypes.next = {
+              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 = _1_inlined1;
+                MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+                MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+                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 xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs in
+        let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
+        let _4 : (Asttypes.private_flag) = Obj.magic _4 in
+        let _1_inlined1 : (Longident.t) = Obj.magic _1_inlined1 in
+        let _2 : ((Parsetree.core_type * Asttypes.variance) list) = 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_xs_ in
+        let _v : (Parsetree.with_constraint) = let _6 =
+          let _1 =
+            let xs = 
+# 253 ""
+    ( List.rev xs )
+# 46197 "parsing/parser.ml"
+             in
+            
+# 897 "parsing/parser.mly"
+    ( xs )
+# 46202 "parsing/parser.ml"
+            
+          in
+          
+# 2887 "parsing/parser.mly"
+    ( _1 )
+# 46208 "parsing/parser.ml"
+          
+        in
+        let _endpos__6_ = _endpos_xs_ in
+        let _5 =
+          let _1 = _1_inlined2 in
+          
+# 3189 "parsing/parser.mly"
+    ( _1 )
+# 46217 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 46228 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__6_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3112 "parsing/parser.mly"
+      ( let lident = loc_last _3 in
+        Pwith_type
+          (_3,
+           (Type.mk lident
+              ~params:_2
+              ~cstrs:_6
+              ~manifest:_5
+              ~priv:_4
+              ~loc:(make_loc _sloc))) )
+# 46245 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          MenhirLib.EngineTypes.next = {
+            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 = _1_inlined1;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+              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 _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
+        let _4 : unit = Obj.magic _4 in
+        let _1_inlined1 : (Longident.t) = Obj.magic _1_inlined1 in
+        let _2 : ((Parsetree.core_type * Asttypes.variance) list) = 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__1_inlined2_ in
+        let _v : (Parsetree.with_constraint) = let _5 =
+          let _1 = _1_inlined2 in
+          
+# 3189 "parsing/parser.mly"
+    ( _1 )
+# 46300 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 46312 "parsing/parser.ml"
+          
+        in
+        let _endpos = _endpos__5_ in
+        let _symbolstartpos = _startpos__1_ in
+        let _sloc = (_symbolstartpos, _endpos) in
+        
+# 3125 "parsing/parser.mly"
+      ( let lident = loc_last _3 in
+        Pwith_typesubst
+         (_3,
+           (Type.mk lident
+              ~params:_2
+              ~manifest:_5
+              ~loc:(make_loc _sloc))) )
+# 46327 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          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 = _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 _1_inlined2 : (Longident.t) = Obj.magic _1_inlined2 in
+        let _3 : unit = Obj.magic _3 in
+        let _1_inlined1 : (Longident.t) = 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.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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 46378 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 46389 "parsing/parser.ml"
+          
+        in
+        
+# 3133 "parsing/parser.mly"
+      ( Pwith_module (_2, _4) )
+# 46395 "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 = _1_inlined2;
+          MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+          MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+          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 = _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 _1_inlined2 : (Longident.t) = Obj.magic _1_inlined2 in
+        let _3 : unit = Obj.magic _3 in
+        let _1_inlined1 : (Longident.t) = 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.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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 46446 "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
+          
+# 813 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 46457 "parsing/parser.ml"
+          
+        in
+        
+# 3135 "parsing/parser.mly"
+      ( Pwith_modsubst (_2, _4) )
+# 46463 "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 : unit = 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.private_flag) = 
+# 3138 "parsing/parser.mly"
+                   ( Public )
+# 46488 "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 = _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 _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__2_ in
+        let _v : (Asttypes.private_flag) = 
+# 3139 "parsing/parser.mly"
+                   ( Private )
+# 46520 "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;
+        });
+    |]
+  
+  and trace =
+    None
+  
+end
+
+module MenhirInterpreter = struct
+  
+  module ET = MenhirLib.TableInterpreter.MakeEngineTable (Tables)
+  
+  module TI = MenhirLib.Engine.Make (ET)
+  
+  include TI
+  
+end
+
+let use_file =
+  fun lexer lexbuf ->
+    (Obj.magic (MenhirInterpreter.entry 1802 lexer lexbuf) : (
+# 783 "parsing/parser.mly"
+      (Parsetree.toplevel_phrase list)
+# 46551 "parsing/parser.ml"
+    ))
+
+and toplevel_phrase =
+  fun lexer lexbuf ->
+    (Obj.magic (MenhirInterpreter.entry 1782 lexer lexbuf) : (
+# 781 "parsing/parser.mly"
+      (Parsetree.toplevel_phrase)
+# 46559 "parsing/parser.ml"
+    ))
+
+and parse_val_longident =
+  fun lexer lexbuf ->
+    (Obj.magic (MenhirInterpreter.entry 1776 lexer lexbuf) : (
+# 793 "parsing/parser.mly"
+      (Longident.t)
+# 46567 "parsing/parser.ml"
+    ))
+
+and parse_pattern =
+  fun lexer lexbuf ->
+    (Obj.magic (MenhirInterpreter.entry 1772 lexer lexbuf) : (
+# 789 "parsing/parser.mly"
+      (Parsetree.pattern)
+# 46575 "parsing/parser.ml"
+    ))
+
+and parse_mty_longident =
+  fun lexer lexbuf ->
+    (Obj.magic (MenhirInterpreter.entry 1768 lexer lexbuf) : (
+# 795 "parsing/parser.mly"
+      (Longident.t)
+# 46583 "parsing/parser.ml"
+    ))
+
+and parse_mod_longident =
+  fun lexer lexbuf ->
+    (Obj.magic (MenhirInterpreter.entry 1764 lexer lexbuf) : (
+# 799 "parsing/parser.mly"
+      (Longident.t)
+# 46591 "parsing/parser.ml"
+    ))
+
+and parse_mod_ext_longident =
+  fun lexer lexbuf ->
+    (Obj.magic (MenhirInterpreter.entry 1760 lexer lexbuf) : (
+# 797 "parsing/parser.mly"
+      (Longident.t)
+# 46599 "parsing/parser.ml"
+    ))
+
+and parse_expression =
+  fun lexer lexbuf ->
+    (Obj.magic (MenhirInterpreter.entry 1756 lexer lexbuf) : (
+# 787 "parsing/parser.mly"
+      (Parsetree.expression)
+# 46607 "parsing/parser.ml"
+    ))
+
+and parse_core_type =
+  fun lexer lexbuf ->
+    (Obj.magic (MenhirInterpreter.entry 1752 lexer lexbuf) : (
+# 785 "parsing/parser.mly"
+      (Parsetree.core_type)
+# 46615 "parsing/parser.ml"
+    ))
+
+and parse_constr_longident =
+  fun lexer lexbuf ->
+    (Obj.magic (MenhirInterpreter.entry 1748 lexer lexbuf) : (
+# 791 "parsing/parser.mly"
+      (Longident.t)
+# 46623 "parsing/parser.ml"
+    ))
+
+and parse_any_longident =
+  fun lexer lexbuf ->
+    (Obj.magic (MenhirInterpreter.entry 1730 lexer lexbuf) : (
+# 801 "parsing/parser.mly"
+      (Longident.t)
+# 46631 "parsing/parser.ml"
+    ))
+
+and interface =
+  fun lexer lexbuf ->
+    (Obj.magic (MenhirInterpreter.entry 1726 lexer lexbuf) : (
+# 779 "parsing/parser.mly"
+      (Parsetree.signature)
+# 46639 "parsing/parser.ml"
+    ))
+
+and implementation =
+  fun lexer lexbuf ->
+    (Obj.magic (MenhirInterpreter.entry 0 lexer lexbuf) : (
+# 777 "parsing/parser.mly"
+      (Parsetree.structure)
+# 46647 "parsing/parser.ml"
+    ))
+
+module Incremental = struct
+  
+  let use_file =
+    fun initial_position ->
+      (Obj.magic (MenhirInterpreter.start 1802 initial_position) : (
+# 783 "parsing/parser.mly"
+      (Parsetree.toplevel_phrase list)
+# 46657 "parsing/parser.ml"
+      ) MenhirInterpreter.checkpoint)
+  
+  and toplevel_phrase =
+    fun initial_position ->
+      (Obj.magic (MenhirInterpreter.start 1782 initial_position) : (
+# 781 "parsing/parser.mly"
+      (Parsetree.toplevel_phrase)
+# 46665 "parsing/parser.ml"
+      ) MenhirInterpreter.checkpoint)
+  
+  and parse_val_longident =
+    fun initial_position ->
+      (Obj.magic (MenhirInterpreter.start 1776 initial_position) : (
+# 793 "parsing/parser.mly"
+      (Longident.t)
+# 46673 "parsing/parser.ml"
+      ) MenhirInterpreter.checkpoint)
+  
+  and parse_pattern =
+    fun initial_position ->
+      (Obj.magic (MenhirInterpreter.start 1772 initial_position) : (
+# 789 "parsing/parser.mly"
+      (Parsetree.pattern)
+# 46681 "parsing/parser.ml"
+      ) MenhirInterpreter.checkpoint)
+  
+  and parse_mty_longident =
+    fun initial_position ->
+      (Obj.magic (MenhirInterpreter.start 1768 initial_position) : (
+# 795 "parsing/parser.mly"
+      (Longident.t)
+# 46689 "parsing/parser.ml"
+      ) MenhirInterpreter.checkpoint)
+  
+  and parse_mod_longident =
+    fun initial_position ->
+      (Obj.magic (MenhirInterpreter.start 1764 initial_position) : (
+# 799 "parsing/parser.mly"
+      (Longident.t)
+# 46697 "parsing/parser.ml"
+      ) MenhirInterpreter.checkpoint)
+  
+  and parse_mod_ext_longident =
+    fun initial_position ->
+      (Obj.magic (MenhirInterpreter.start 1760 initial_position) : (
+# 797 "parsing/parser.mly"
+      (Longident.t)
+# 46705 "parsing/parser.ml"
+      ) MenhirInterpreter.checkpoint)
+  
+  and parse_expression =
+    fun initial_position ->
+      (Obj.magic (MenhirInterpreter.start 1756 initial_position) : (
+# 787 "parsing/parser.mly"
+      (Parsetree.expression)
+# 46713 "parsing/parser.ml"
+      ) MenhirInterpreter.checkpoint)
+  
+  and parse_core_type =
+    fun initial_position ->
+      (Obj.magic (MenhirInterpreter.start 1752 initial_position) : (
+# 785 "parsing/parser.mly"
+      (Parsetree.core_type)
+# 46721 "parsing/parser.ml"
+      ) MenhirInterpreter.checkpoint)
+  
+  and parse_constr_longident =
+    fun initial_position ->
+      (Obj.magic (MenhirInterpreter.start 1748 initial_position) : (
+# 791 "parsing/parser.mly"
+      (Longident.t)
+# 46729 "parsing/parser.ml"
+      ) MenhirInterpreter.checkpoint)
+  
+  and parse_any_longident =
+    fun initial_position ->
+      (Obj.magic (MenhirInterpreter.start 1730 initial_position) : (
+# 801 "parsing/parser.mly"
+      (Longident.t)
+# 46737 "parsing/parser.ml"
+      ) MenhirInterpreter.checkpoint)
+  
+  and interface =
+    fun initial_position ->
+      (Obj.magic (MenhirInterpreter.start 1726 initial_position) : (
+# 779 "parsing/parser.mly"
+      (Parsetree.signature)
+# 46745 "parsing/parser.ml"
+      ) MenhirInterpreter.checkpoint)
+  
+  and implementation =
+    fun initial_position ->
+      (Obj.magic (MenhirInterpreter.start 0 initial_position) : (
+# 777 "parsing/parser.mly"
+      (Parsetree.structure)
+# 46753 "parsing/parser.ml"
+      ) MenhirInterpreter.checkpoint)
+  
+end
+
+# 3761 "parsing/parser.mly"
+  
+
+# 46761 "parsing/parser.ml"
+
+# 269 ""
+  
+
+# 46766 "parsing/parser.ml"
diff --git a/boot/menhir/parser.mli b/boot/menhir/parser.mli
new file mode 100644
index 00000000..dd3f68ee
--- /dev/null
+++ b/boot/menhir/parser.mli
@@ -0,0 +1,200 @@
+
+(* The type of tokens. *)
+
+type token = 
+  | WITH
+  | WHILE
+  | WHEN
+  | VIRTUAL
+  | VAL
+  | UNDERSCORE
+  | UIDENT of (string)
+  | TYPE
+  | TRY
+  | TRUE
+  | TO
+  | TILDE
+  | THEN
+  | STRUCT
+  | STRING of (string * Location.t * string option)
+  | STAR
+  | SIG
+  | SEMISEMI
+  | SEMI
+  | RPAREN
+  | REC
+  | RBRACKET
+  | RBRACE
+  | QUOTED_STRING_ITEM of (string * Location.t * string * Location.t * string option)
+  | QUOTED_STRING_EXPR of (string * Location.t * string * Location.t * string option)
+  | QUOTE
+  | QUESTION
+  | PRIVATE
+  | PREFIXOP of (string)
+  | PLUSEQ
+  | PLUSDOT
+  | PLUS
+  | PERCENT
+  | OR
+  | OPTLABEL of (string)
+  | OPEN
+  | OF
+  | OBJECT
+  | NONREC
+  | NEW
+  | MUTABLE
+  | MODULE
+  | MINUSGREATER
+  | MINUSDOT
+  | MINUS
+  | METHOD
+  | MATCH
+  | LPAREN
+  | LIDENT of (string)
+  | LETOP of (string)
+  | LET
+  | LESSMINUS
+  | LESS
+  | LBRACKETPERCENTPERCENT
+  | LBRACKETPERCENT
+  | LBRACKETLESS
+  | LBRACKETGREATER
+  | LBRACKETBAR
+  | LBRACKETATATAT
+  | LBRACKETATAT
+  | LBRACKETAT
+  | LBRACKET
+  | LBRACELESS
+  | LBRACE
+  | LAZY
+  | LABEL of (string)
+  | INT of (string * char option)
+  | INITIALIZER
+  | INHERIT
+  | INFIXOP4 of (string)
+  | INFIXOP3 of (string)
+  | INFIXOP2 of (string)
+  | INFIXOP1 of (string)
+  | INFIXOP0 of (string)
+  | INCLUDE
+  | IN
+  | IF
+  | HASHOP of (string)
+  | HASH
+  | GREATERRBRACKET
+  | GREATERRBRACE
+  | GREATER
+  | FUNCTOR
+  | FUNCTION
+  | FUN
+  | FOR
+  | FLOAT of (string * char option)
+  | FALSE
+  | EXTERNAL
+  | EXCEPTION
+  | EQUAL
+  | EOL
+  | EOF
+  | END
+  | ELSE
+  | DOWNTO
+  | DOTOP of (string)
+  | DOTDOT
+  | DOT
+  | DONE
+  | DOCSTRING of (Docstrings.docstring)
+  | DO
+  | CONSTRAINT
+  | COMMENT of (string * Location.t)
+  | COMMA
+  | COLONGREATER
+  | COLONEQUAL
+  | COLONCOLON
+  | COLON
+  | CLASS
+  | CHAR of (char)
+  | BEGIN
+  | BARRBRACKET
+  | BARBAR
+  | BAR
+  | BANG
+  | BACKQUOTE
+  | ASSERT
+  | AS
+  | ANDOP of (string)
+  | AND
+  | AMPERSAND
+  | AMPERAMPER
+
+(* This exception is raised by the monolithic API functions. *)
+
+exception Error
+
+(* The monolithic API. *)
+
+val use_file: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.toplevel_phrase list)
+
+val toplevel_phrase: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.toplevel_phrase)
+
+val parse_val_longident: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Longident.t)
+
+val parse_pattern: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.pattern)
+
+val parse_mty_longident: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Longident.t)
+
+val parse_mod_longident: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Longident.t)
+
+val parse_mod_ext_longident: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Longident.t)
+
+val parse_expression: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.expression)
+
+val parse_core_type: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.core_type)
+
+val parse_constr_longident: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Longident.t)
+
+val parse_any_longident: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Longident.t)
+
+val interface: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.signature)
+
+val implementation: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.structure)
+
+module MenhirInterpreter : sig
+  
+  (* The incremental API. *)
+  
+  include MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE
+    with type token = token
+  
+end
+
+(* The entry point(s) to the incremental API. *)
+
+module Incremental : sig
+  
+  val use_file: Lexing.position -> (Parsetree.toplevel_phrase list) MenhirInterpreter.checkpoint
+  
+  val toplevel_phrase: Lexing.position -> (Parsetree.toplevel_phrase) MenhirInterpreter.checkpoint
+  
+  val parse_val_longident: Lexing.position -> (Longident.t) MenhirInterpreter.checkpoint
+  
+  val parse_pattern: Lexing.position -> (Parsetree.pattern) MenhirInterpreter.checkpoint
+  
+  val parse_mty_longident: Lexing.position -> (Longident.t) MenhirInterpreter.checkpoint
+  
+  val parse_mod_longident: Lexing.position -> (Longident.t) MenhirInterpreter.checkpoint
+  
+  val parse_mod_ext_longident: Lexing.position -> (Longident.t) MenhirInterpreter.checkpoint
+  
+  val parse_expression: Lexing.position -> (Parsetree.expression) MenhirInterpreter.checkpoint
+  
+  val parse_core_type: Lexing.position -> (Parsetree.core_type) MenhirInterpreter.checkpoint
+  
+  val parse_constr_longident: Lexing.position -> (Longident.t) MenhirInterpreter.checkpoint
+  
+  val parse_any_longident: Lexing.position -> (Longident.t) MenhirInterpreter.checkpoint
+  
+  val interface: Lexing.position -> (Parsetree.signature) MenhirInterpreter.checkpoint
+  
+  val implementation: Lexing.position -> (Parsetree.structure) MenhirInterpreter.checkpoint
+  
+end
diff --git a/boot/ocamlc b/boot/ocamlc
new file mode 100755
index 0000000000000000000000000000000000000000..8a4f068132adbf6c76a92709729a7d7e43b7694a
GIT binary patch
literal 2754789
zcmdSi3B2Y-c_(_H8#ry77zrRm1AR_6y@SvK3M#zVEr@GeZ~?>O=}3bJ5|>0GqS7LX
zPBJm;OcE25-0X`**Bb`<`xd|B|d!E&%YI5yDs29F5#1dG9?frh84p2=hXYCQI@#JnPrMbNm{3
zPFMrai388R&>I7B(pQ{}C&5C%M}BBe59aYdGHaIw8-jk%tQ^S6YO$kdH6A)w=rr2L`U&^?z
z&x*PD&EhM0tMOHxuEu9wELY>JdR>jLYIZfgs@v80s&-+R$J}YZ|ZC?`l
zS;2L|YlC+LUl)9T@Z-VH2frTte(=8n1^$TO5#M+IVDHD$gau4Djt>R)@P^6I=D
zEqUY|P5bKn9xeM82K&TcKEz+F<)q?oeiGEPN$fSevubZV&ufuQM_(Un*+X}~=Sc4-
ze%fF6(~<74d!hEvi-&rqXI-GpDgIdyX_dC%63-
zpS9R_${KAub+BzMvL7?ZK2m>9>-^cBvAa_{^Plg(zo&m{pkMd#`|rnBci3f!H1Smv
z7X@nhMZtF@k>fMw#hF)Y+FJa?CvOq;fagWYr4!yBX!w?c+GDM3)n6ZQz_~scXn5qx
z=Lt=X-xfH>#iUK~DShR%&MWcBu!9sjrn`Mpo`
zZ1~I>HhlUF8~$Mp`W`())+1MurH;LeEe4vn-_h-<^}U%tD^OSN1@ub;XU(&Af8cZU
zl|k(x)A+GL?R5t1JrLCA59h>rR{Ohxb;19<|Ni^gMV>sG8)LXHbM}#^M>~IL{e`V3
zXDPr_W9#TAwVq#iCV@t0y*rRw&uDzh0iXCsUioGoZC)I|AgCH#>z+U8_PDdj`R72~
z>U#<{+!(NlzB>1Kiof(`YRbc2{vGK)zSv9m)?i(rm7nw0%#ZxD=F0Z6_ekv{^Zx|D
zd|r1>)(3L*kHOVJ`F)^`<+keF7@V=w+qkcB`6uhXz}PduJCWy#X9}768v=Ds*2v>o
zvn|*VXzY>WvfjTf$<)G}M7+taQj>i^u+!~aeI`fmvX>^cVI?L7ti)msZU)rmK;)FW>BYV?drb%CowXOE$eb5QnN?cb9Wpyj3gi^}4U@
z`^|P=iNW!ipvOLPwOfK8&b;$ro7h`%yDQ^}oqpErb5nIomh;Z0$}M^SwdJ;QDu!yV
zkLMqRKAQ17E%L=^1wxCWy3a4t3Lc@+XZp
zFNd3h3xj?SdP|^opBV=>q~8^2f0@|y^dE#ika;{S58roXuIG7N<8dbx&&Tt9WY6>Af&O6VQSOgr&bwmC
z_|DM$F8cLt&u4dYS7(l%-2vOQU;c+f@BaMpu6R>=W6!voyK!&dlLlS8LT?Oj={~dR
zUhL)`)pX<0ekb3__A-AdG#@=zO3t^mxpTU?JBNL@4fHDp`WXX#e&{|<+e7!Ze|Bhg
zI9FxIegAZ5PTVSX;`il=UAklNKPkZPJp8Bd_d0&C?SFjZvG?C)uJ`{l8qX;m&+%=}
zdlem?|htcP0OxVU1mQoYk`L4UMP#+thfR_u_eF<0=0t
z2J}C_t<@YKp4R3n=I&5>dzpK})8}_v=#7m}eUuN6&HN)9P4;Jm_ADb0Pw}nKyjr+8
z=xgF*sV}_lEWBj=R-0qbrGeJl@>5ygn7QKrj?n%3*SB>t*;>yBvgxWgTNeZGzUJAb
zC%d=t?#S!uI|lmJf!;sR*9`RYLSGUcCj?qA`_injVe>Hmgh9s6fnFTwQwDnDKp!{I
zAN$xLz3wLZon!r;j_&RJlg95(!1u(~d!Om~KG^u4+ScW>U;o9d_w-K=^bfWD`-Xkr
zI`Dl><9kNa^UT&ir|Ww?Z)^O|ALPEF&A+(qyQ=jsY5n;_U;bDB%={@=I$>s$Yx)_+s$zq$3_+WK#6{dctf
zyITJ}t^dB(zpwQ_*!uUk{)b!tBd!0ju6Gu_Pivk7FAdbOv*6wR@wqs5q~961QK&`k#G<9lCp3S)%_XJCU`AML;b-H)V}Gy5`;gY_A(yURk9*C&
zNuc%mjMoRN>GJ-j^}6^=S8o#=H9qr&jlC_C&>Fo9LHS&K-c`vpzgF8k54Cx=$qAXq
z24id{nbYX19PmNR*v*~|!I9Wwuh!dhAT+taS25E+A=nbE59ay3E^GAL+sAsA9&^3@
zn?sMac4Fqp6AL*yFW{$q^mQO!_Vzm2tnCfh+xv*O;x?QaWpij-rimx^Ez(@9yIo2@?+o-u2Kwa4z|RKl{Ls%0O2>~k9Yw#p(Y=mqGiUE31GW0-;G{qf`d;kN
za-uIj_cvN>-0K?y%{-az^>YIE`d<`FxFKXm?
zF5MU;HTPRXF9$VV$p-dlWsfoc=+(0edK*F>b5-EHmOZ0RJY@Dfd@Z|-wc_dLOD3MO
z-5BsYi^l9z3v5*bbd?s<8?rprTlp%z
z^su9N$?bK9JZ!IV?JIjnUyFa9o(sb8_`tb28*>`J*)U7*EII4K%g(Yr!w2|ojXxWL
zU4iz$+Z|H$9}o1e4fIb9^!o<->jwJXfqwl!-#E}$5A?+Yeab-JpF6bo=Pw5Ow;Ih?
zb?8oXR@`w5t*^V$x_LbM;xmSmTYqZnPiwvBtaa~u`ZEG|r~R6{)7ag4Zs6|pyWyJ8
zMY1fG@VNcVxUXc(`nqZ$8O$jc57p4A(kd^*F|&
zw|hD3a#m-*k1_vios5cwu{QGd>;1lpjeRigD_*&_zBi~CyRY1PE6JGUW9{o@mkfHK
zw}T9Gqi!+i=j$#uU-IVpWnOIUAN^X)T>sv%F7!(B)aE=HS(@r0qt|J^_fZXNyxA|H43zKZp8;Vf~#0{knmE`9SX*=*JKAXASft
z2Kpa|XWuUj^j8n`+Xnj9fqrSDh3k{~?DP!X6zG>)za_nAs{2yYgJNp4?5
za_ua7K9h4Gcw#XTk_KHrUWrjEHgcuc?->+HwxoE4qnVIRrUdLQl4%uPPU
zY}^!^#IbCAN2A3<xSWm>=#takw#XSDhb>ayDho9jTGKEx0DY4?RD*-ig$o
z=8ir;f?LFen}9Ck`|p`gLcd=nSVhy(PV8fuG~@7cCwK0%!e&ff(#>
z^zG^Kcz?Y$xGCuQ)Sz{}XAS<(5BfbfhaUH!N4{5ed>Kw{tl!;WGn>k8=exH#nDcqlwe*w+*K*7>9Z#8AO5|*+Rr9BABuc(Yriw{lz?9s27W%L
z2HqN!jbiSev#$2~`K_V7uaR?UP;w?2&yv&gUltxRpBAW>U4b_Kj*{Q`Jdk-c;WuBV
z{cj$kkNN#J|M5fpKd1QIJ?>f0Q|}sVB3tafC$ijQo)^{@T5qm+yx;Zvi>J;mIj;^6
zx|i>~yd?9zFV7k1%R}44M*8Gp&%iVO-jMf%Ugl>G^u|U<)F=4f+g^HmSsxqjsE>xm
zSFtmOlUuKz(P~idJn7G9{igJ4#OGVh{iNP63ibx>r_TvAcl|#F+XHdX%snbZ&Fu(X
zcN94XgGnF<%K>@fzCYlXrVceS)TVu&1ET)0yeRgUw4JM^jsafe5~{2ZXl~a>%F`zO@D9N9C>eyyaR1~XU6JrZ%}i$
zck7?ujlZxPzqT8{p&NfeH-3FLeqF}Sjx#t3ybrLsdh-i`n$VknO>kF`Fh8Jtx^J^Q^-e*6woa%iKs{i}e|6S|~9{hzh|Ph0;dt@m#Y@%jE$?`LoNKTKbFdRu7s
z;J#oI+!u(SXH%W6M`kQG>jFPJ!vFNZx_Y#h)Esj`*2Gb(xYm1r&G&KM-1sZ*K8wz~
z`{-ha9*_P=?+ItgzW%;IFSYqCt#|&+Z*RRj0KL2Q=d}LZ*6(Tk`K=cp{LYsC;?_T<
z_3kM1lh!}2^;fk1%GN)l_0Mm;yUV^8wElUmuXXR&)?eCs=NvuqU6(mFoEKY{Sc*usb)wq8SFNU538l77Ldl!PTpB^@_vDdX6nl5@Y
zvdJr*y@n~gzS9^J;|ir3yi4$EG1
zbknmGj5f+^=@5(3VGMM5wi(kwZm&bUmjZf>q4F^=F7jSF*JWHfd%x&G&-2R~9y-LT
zm&w+WX$%!B_v(7?>)1Pn3?--Zf{?jm~vETca#@-{be_i1do?KFf`K%ZJ#b`Cey$?{cYC9x4uX
zcAu5CF%SH#7(HC}v**FsUokHGpS_CxeU48KFM3}fW_w#NFV_ao4Gsi8e?8cI_xfhl
zExq&|Egh#t*65RS%SU?nSoc`@crbI?`oLawBIjz!Gq28%{P+&~?7$u4Gj!EO@2Bqo
z9;^*@rY?;PZ6#YO_w&y1soB3)JNnPqM#{z=LGT~XZ`&da$0|6@JU^1#`V70
z+sQ7pvs$&Lex2K;zWSk0lwnl+vb4INuX^HHU#T};;X*+$(saP@v~n((N(iOUB2Se
z%3l6?_tlK;(fEp|d}bs4>W?4$1G?4+n!RFrW00@era$Ac*5_ih!5;4s8a?z?%xC-5Y45eb!5d@n|1=CV|F|Sv;jz-O_a+kiT7l=DSq2
zcTTVnY!2M@X9fIXD?N*W*!TI^7n-koTTe&DKrWWr{3N}`Mm~~hO#Ugs?tpFZ|HdBu
zEy3SrK)0NV+vq=A)S5QhLjPjGzDc0bNlxh(uhO02F}^>h+n(~jbmG<6W1a3x0?pVt
z)_ObGh87nws=e+Pu@TRMfkvkI%MHFspt2rpHtx(BFfho)wpXR={d%<7!V
z>m<^xyNS)-#;e*-ee_3)8DFa&HUlH-18}6j&1rGWWJ#
zj8|GekaaTT>x{s=$L3%XXmUbEJ-0qp?qbi{^7&xKT7MVMTCW`UHQVR--a}%haa`$+
zu%~j|%j)aDa)`I?;*$Tu%(+A4ZCzlFj|zif8ro_jmD1KJ>niHmoI%EA6j1lDm=(z1}{iE5)(j)5l`m
zUvcdDd!Bx8#c%BG9q%GEzT*ORJ{))PteDj~?e9n^T(t8>!lXWX-peQK?y@J#}(uO;`*=LBTU(o?ef{k_~#)>9*g?w-Hr>G#s@o>)zH
zzo(bg>mbW}-D)xE_xEx~S@`(T^Y=XcUT3W5+urE@nd0o#9n98q0!_W_nvNb=FI&1f
zveg2edNhoAujfQ>C%#Fb(d&$_=2yRmFAwJVpgxxZHud#Qws@_yejw|7@O*eE@9LlI
zGg{C1dtunm(=sa1yy}jH~
z7QWSLc@iG&U+avHK7J~l(UsoO#A~JX{)|4@cewZEeatg-e24qv%*&a4vtxJQ9IXo;
zoA
zwe11F>-~#f4WGE6+52A-6TQ3uo3;hsVQa5-;KQkHJo;&0y@!r>H`^Z_^#1a#{9!+P
z%7^|OkAAR28~ylT{NOJiDz^OaK0eD2_K-Ep4>4t*cPTwxON}m@J=@sK=d*(KLFq9s
zPNR(<>S8Sxvtn&8h_(I3Y-Gn+Q{s$Iyfo`%mfe$#H8$6KI-jeS%!!Xi7eB;M8*TsX
z*uI>3x{9y-B@@_kdK>p~wFl^}8o^7qxbbZgXzqHl%;Uc+5QB>QLZi!Gd}RkdZM5CL
zKO<9Zz-n>#?>1J7JKHP&WcBt}teqb+toL&vSB>@Wt`h5#E2b55a*f?Xn)q9SMe=%F*+?E@6Ldq{5dnQPd?<1J>Yz83e59YF31pEBcCV@~(>V2n9i?+G+Mip}$b
zS+S|yWciq1Z@H0|dAY&IAD^kTdH%3nW8Z3iuw
zD-aj|o^L~=(;egA-}Ur=8|a@N=x-lr|Gu|u-x7Ib_4>be(0@tW-}8JRJU#uZq5aO?
z<$;3GZF<19!^{&?Vi2sp+^XfAy-^r=J57X=VFU`Ku?%y43`bgue
zIDRPaxqaOJOQU<)$L1eR_Vh`iW5(fJym!W)rD4zc1ATdDHfVRx*njK5|J4Ki(*yn2
z1HC>4(%XFcKtFw;Zy)F{9_aTB^p6enZx8g}4)kZ_AENg5>>TLJ2Ku^z{-S|?_dtJF
z=!L}6JyN;-yL`S;Lnj69@0$PV%$sxeYVOP0+>XpyGY`)GOWNAbHm5dsw7KFl_tAVO
zKGxrR20MRZp#P}ZeQx&C>kO9OcSaujH?}q3bKrS$P&|*$KLj3iZp=Ua?PI+?G=A;9
z8Iy5gV2<5y${ZQmBLnO7dgnK`rmwZ?ok{Zr-ys=qYW-5{-6!U^wqD%P;;Cn=-g8#J
z*!tR6y&PKK(R%iy-P?M1jsBw6ixb-SFnZ5g{bj9phojw3`e(HMiq=1?_0MVjd9ANJ
zlwS9~{V!?#)vd4jmp1ykp?BZecT?;45A>@WeOv2qZ~bdq|N7Qn-1?`q-tS`jIVArz
z_bH#n#og<^y);P`M>$aAU`@`9#m4)}zCbNlJ2^Nu@ZMPSY5@9LL4R&=UvO)K=Nj32
z0(m5p9<|i-stwNu&De9H>|CEQuw~N5?CkBac6Pu{HnDSKP&&%q1DUh$hQOISG3afv
zm+koR$`hN5Kf~$V!qDR(xAfJ%iUZmnao7^@)$@(LwFeEOjpDUEV5??qf5k_v$dR`<
z2V!B}xeyckt_kqr;qMCq^@3MyONVjs-Ia04wXbZ)!>a+RGeudncpY8P!Jq
zwc0=iTkjzxZI=Id=pSuhpS^VRz4++P>(1f#arMjI@_W?T``pVJ^^rke?{m+;nqGTB
zeP0_m|7>TErk?8WP2tnbT^`^wS3Zogp4xcGn#bdgDSh*J__i9)WCjntPsc?B5WWulr$=an;iHjM+V|
z*L>MM%2hWHhum5Ax;xk_w`Esv@4UOEkHai`AF5pb-xc_qIo=)Ir~RB~B-A_48#4aF
zpnRAW+kXEiTc&4+yL>Hnx-(|w%6_?0$K_|At9j3g)pGSvBs+}?n1_XTo_?%$b~L;LKq7-+@w*o^UB7r66J3EmQjix}z4e`oZJz`H}Q@8;02
z3D|yi;N5a5kcV0PW!H&WzaV%?P|f_v
zoSe0jx_(2W`NF16L7jo#cXOp+Un3q1h&IudH5|=)P
zVpB1!IP<6C=)BU~?-}D>^|V&|u8GV~rhQR&*q^o5#mi^d$Zuy>9g*XE26^8Sh_4!{
zSU%W#6!$SUN20fKSZAg3$mZVGS$SW}o`{*+=WgLMnOg&K(b#T{&HY-%rR*!a4u(%7
z%i8v!YTo|EfL-i=K_KomXZ*rIvv0KFXxQh>_cpSv*ToOt39^wrbza;J=sSa}0?$k}
z#YcB#`C_~j;8joj!DD|tD}8rZF}WjS^89T{cdR?gn#L|Z&x`fZ@`XL4FWxWY9@|mvx0SjhQ}T@R&MDhmn|i)
za>1tlJbf^9pXRx{Tk_=FG2lu6GaTI$J*BS$ALNoYzY&
zrjf}n=Ul$Dw*>S--3MQku`^Tlv)ehB^T!2?f#;gPp}d^l-a7lM>B^Sr@92_Q`s$sy
z*H`DX*H_OU`eyC7XI#6j*=Ant*yl_2$4!>^u3erKcjmouiHjr+Utj*NG<`E-ZxS$@==TW7*Ksyo_x-P3yK>xRIy
zkq*8T&q*0C1ht;w)E4&k`t4H_Y}QIYIr2y*UFusbjKz3!PLRo1
zqVlpmb9gTZt_}EecA%XVtP6TM;@ZcmYIH-Jzcal$76a#jk5zZ}885YYd+f(^a=;Gb
zI|4F%M_PGg?}M>Jo<=*wbupl8H5>em^I0~q2i_5A@e;%O%hjn_bZ*3;Vk8#g
zTYJ=%Io@Lg`=4hqC8r`EY%7ABhim
zM<2wmk2}BBQTZgM=*q+BLmyLd8toA;I^?8qea5c|*dl&am-K-6K;_W8-%?OLo2HjUAcva+@v5JX^R?%vyXx%U?
ze@kdFEc)Mt?)h&W_^%z-&mPu4+U{$j@ORQ}??^TF__uiEqe
z(7kQ%o+0D61{rS(&&E#1=g!#kC&QjAhCSOui$O2vFY_OT>0|Kwp(~g2{{5l*xPNnK
zGEVJm`KmV8$M%ccT;-LlJKNkT-QL?X*UR5O&`)W5oJV@kX}!B#Jk{I($`5CI8DBEc
zuNmkU5A;(*_xac|&>IK-kK}_*ukSYp`X>hZTL$_a1O2Lje%?SoVW1x~(Epgc_xAkd
zKz}H-J6rq~0=(WGoV|YEe+nNS^-z7k{(-h$XLj80PO#4&y*ksY{a(&jG`_OQcLezK
zJ>Odz-x+OP->=`+);G8H>bEv}N7wiJUfTAZJ;=MV&7a%$?P>k_1K&mA>*bw0&|8|E
zr?&miZT;u8-ZPEA-cj_Iw0_e1r?q}x>#u12Gl%{;jedUXOWsQw{esqeZ=&a#*8ALt
z_WaV{JcoW=n}0*=Z*To;TYpFE-_-gyxBe}yzq|EsZ~eVP|ISALo7R6>>%Tm`nDAHg
zOusVlnPz|RqF_f}jO2G`;JpU;xzxsc)2ll%d_-W)UF058w>7T@!JQ`-@{0Cc_ZjZi
z^x&O|>^;G@fJ{2w8$GXk%GuJ4*9B!~OrE}QnAOzcy``0()eD}y%%c*VDL7#Cl?H`)VbJ08BQq#w_6z}8;osN3fZ
zx-Sj1k$pM~}Za=#eN`y5kzyTfx<8dg;Sk`67!ieGJ8>VpwtJPsy)y
z)$bYOZl74M)joOrWZD;XhyCHlTI%Aa88-4;9jha9+(+`hC6HsesaQVPdb~L@#@HN*
z-pZjEv$68X=HAv>c|VdpRhQ&e{fU9LJrE~6YRR*}nNdr>pCU1SSMcP(y`fqA*=}ty
zG{5W4eo@A!4>aA{-2q+2F9!HW+IeLcU3lz=J;Ao%#K8P`kF$Y2;&)a+?x~I5o!%b$
ze>Cwv?#lG{Gsp6O$Jz2A!!8RGAJX!G);28*A+rGI}nuJc4DlrMa9PVjo)
zSPCjX>oQ);KDD>fJ~s8atXQif^LGYvBA)%v2GzTD{*%vcd#dhE&RERN-w}|p)}K-O
z>^RR3aTx88v&CR7Hq84OrM;l0#8|8P)
zZ{<&|IVZOSYC^1b1UrMWMgC{qJ9zDVbuiweeO=%Kd4j5|swuU}&fcbwpTI}vV#hbn
z){@KqrH;S1srRk;!}-hMvcoc+DLrw{a*p=*!6xBC%o
zjqTQY`~PnEnZvJyW+y&%sfV)T>$5&DO^>y*hosP2UbK2b2
zw%;95dM{~fp0{N0=+@3|Yxu1>Gqvw=Z4JLQ^R>3ItrfqVeLQv0^O^fdn>)MhHTQ>^
zexOp@BRF>wzscod~%`poYbGv`qlW{XZX(;`pT7a*{BXd
zY~i}#k_29k-7}hJ%{K?;V;W}XhUp@~2HO8>PP|4l$9-Fzjdmn-L^+}C7ol*{Id3Ax`AR6Iss*sfNVg3^oE
z{*m{=_L-4V#JAkzrZJvEUl6kaTnPZdR>nP0NAoQuvYQCKI1Vawf7BKTWRl2Gxmxty2szEy6W$(nc8X3b~%@O@7vzwA3T
zz)${@V=(>J#6aVZde71{4x@bMUu-nzp<+mex*g@qnKdz;CCj`xi2oP|pWk|0OO}|j
zPYjIh7u$ZnXW)2l>>&@IyNvFofbX}q-niD)uk}fw(Z~1Rk4c19E~?h?09oKnh%-Ji
zi;q2Jle5mh(vjixZwbD%&EeZ+GA+Me@__eP|ITbf=4<^!1O49y`o}{b2>&g?-?jel
zTmQdXe_!iA*7|>F{XY)hR|#-e*Y~Q&*`G;ci%E~*uVOGxsW;WqF+yso;-c=
z8H0CtxJ|`7FEY{H(>UN#ttuuV#zCnLW=Id)eZQdZt(Xn&*4L
z`4ayvtrzpp3+(f`P`=oITc8%tY&1FM#oYX@ZESx%lWJZaZ3^hIU+j$Oz-zBFNS6IQ
zfAOg+{KaFBz3!j7gG!&fgFo&)e(nf%25epq$f+8)hiqs6s^A&H%LDahZ`r1v@Bw}1
zOU9)cYh<}U*hPl6H^5)}`EJf$I`Cc>RE@kPFX6-(o?i`=q{u3dpV{d)9NT+E5_$(bu#$zWgECSSjh2ZjE5
zZB3lt6gVgB)eZ#g(X*3H_K^E|fjzf3n*Q4YyyaWv3!m{v1G3Ky$RG3XO%qpa0cAv16}$uoYp8^TLZD{<-IaAd+rKSCinL_
zyd!gJfDPj5K3)he2;LlA7|=fnv}=Onf_ZVe2UA+T>-2F_Gku)!Ra~9HlH2=X?m*D*
z6Em^2Hp;BE-v5_{Zy~6fB5NtQI>1j3ANL00%C|QL;=(RD*%#o!PmZ~F2c?G$dNu_1
zsI@xln=>w5?4GB~eCbkW730b?-DOX&yJ|)()P{QtI5I~1JAAi|ChG=TmE2ofX~{0%iW!B`X1Kr
zc}4c{L9GORL?_AX?+6o{9eEo@(l{l7QE{+qJ5YQ^XF{Xxa0>?&KG)ta*ppSX^;j`L;X_V9|4
z?;Y%`drXart95>8j}7RuSFQBCZ0vdE%)UK=n5(HB!Ooy!qlVZ&tA>BK#f44wyF*vA
z(b>h{+sWSN1_uL;Uq{>4-4`%s0#(Ay&lBdn8p}r=oo{q%dw?yvI@OM@%
zj{f#_D4&ag*dM8X57&8#DGxX+y^Tj&a}U~ROz
z9i?`c0%zdLfQ=i1lDXFB3EA#8G3o6kuk1aLvFAZ=GhJ+|?>_qHUvDS-=vc{Kx*m$X
zl^^xzvkrP+z&^U`9##X_1@#`pHu1vmF5eosAFPXs*lXnSPb1fT*2@(ivgJd5J{r)u
zJ1E;em^`lweN(_Lx}24Z1G?~4{EfAH4t3Mqm@Au%*+6I2!z5$PeAPhtB)3{`&mXsY
zjxBv&%eKBA=mUKGIv8kp%6`5r2Vz<_i3?g>*j2Hq7?ho3ExCW{J*KZEw$*!xv6}4j
zNlxW+Rz3ZB^Vu`0ax12zulyL}GTKN+*~pIax$NSzn5|}0{T;8-4)#^d#js*e{vCmu
zTnIep-Wtri_h;qG`vxDK$+BCndYVssps&wcotcDk`ZFf$bq9C`R!mOHn0+N5-#F*2
zmX0IMW!3MPOXqh-urm<9is6yeEn63ZBdJ;UL;2p-~RLov0P{L5F^<
zkGExRtPeH6mOAhK>g$89p00Wk@6~F){NjsR?DMr2o77Ron%=50wJFwXv0>it)Qgcs58KZbwTlq1^zn2_}N_F6*wc#@ZG_fBeiTV{vJ1kCU=Y<
zy}hk;s*T8yXH3?tnmihIygjlwU^eszbpbZ7Vp`pBv_b#M+J3f+oN`#AIOQiS?L*B&!h2P!Y4kGYhu<$#Tg
zLGSNPZGJU>*}`A@%UAhwPOUvyf7zyeZt#&nj>+2WaSu+a_AF?*2mw(OQ$nDp@AainC
z_ifMnd&Aye8|eRMp#8fo`?b2~=GBpPc~NWn;xm>9Hfi!;EDv82$ir_0JA$1-#hN_u
z%v8tX{=T4c@PUkH<-nP;5C5M9FAm(*mA^AG7H=}^d4aaC+IEY_k@i3PM=)Zub%O*3+#D!pj{Ze
zGobtXf|8lx;qM*T^mY?z@+w#4m%X*NkU5R5KNgg&C9`axUn@TLS6#4O%*nqsP^-?o
z*2^<@LGZ4iZ29qwOP95O)2)47#ubYU5Azwb;|IDqd%rX&x$@r2{jzTD+lRG(8(K`i
zy!GNNhr0r8{5z3I$ypjAPes#
z(5?xreRaV9KM1U|Q+~cSdfXeva^Q~fd^kIBzu5CbfjwxkvR7XGJDJ*BeeZ*x;q~<8
z1ATGm-j-dV$)|@;rROn?&%86KSD*Sv2l&*!_o!ap&$joZby;&y)V;|jd#f**d@q@O
ze{!2Ywe{j}ecb1sG4C$YZwf96*r
z+IQRIBC}#V-fd@Pt?rAXdAEH_%kLRYce-h-yNylr?zVo-+0oo>yE|L?L*{t5eQV~b
zw$2Gd@wxZ@uWoI%yKQmU`)%Fcs#*HU^{!YtPapPuN7md)-`V=_O5fijYq{H=ls)}>
z;a#C~Jxt#xzdK_!taj=7o}g@DXRph5TV(b3;O6kuJ!s#qz*+pN@Xopi@6CKK^Ok|W
zK6Kru5k38PXylIf;8Po)dFM)B?`y{F@Q(LS!#m!eKFs%^`s{70yZMYZzp3?0=`U&H
zbklb|`@HLYZ{R-sPy(qw`Tv~Y_@L-#XRKWjSf^KiNATi+tWyKAlzVGW58Oxl0`IPS
z12%}0R{6q1pFQ-UpA|R@a;weL>)lr?z4p>CNA#*ac}1^9|16z#CL>~M2VLVF+vy$W
z%dVQ=5uTj^o4`K4iOH>vX16o))WAM5827y+a~k<2r{7n1WbGH%8jrHr(C;1j=%=G}
zs(ZAU-WIUIxMJ?i?hj53HV3^e>qD0<>oP7|O2=AcZp%KhwJQQLD~@WmY*GugKFc<8
z@ShUYe!ZF&13s30#u|BeDzCBl0{s|YvSFS~XQ%Y;&3HBWWYrmbcE+Vo
zPRfpjHjj7o(RsG6(Z{YjtL_Q8BFj8p@ptxXt>QUvZ9{l34sHq#%z(Ruot~loJ{ejr
ztFGu<49M9PXnv1QT<~dp?(2)6Kp!6WS3O%^nDLf?+!KO69`?|o_kAn7?A;pR?|DN`
z<8h?1drbDti`}@!XR(_Vx0<^p>x>gWa;J2XRmBUa|blOALK^!)6zR&{56Q*eC1&!+`X4C<^o`@PLKhki{^b!NTdCWd_I
z_4W4k@!*H|w(ko{mU>(aw8|@A_^xKiLih67-}}!VezT?L8}G{A@32noer9@ig8En=
z)PB5jDkgj|es-W4;}bu5L#q$8`Y4(_t@zbb&yUuump{hO3do{^?{X}M&kODfa(t)n
zg8Wr$R|RJTFAv0%-`BRDANE&Wi6^_rV+-C#1=j_1*ZoKi-Sios9Eg$e9RZzx7(4iD
z51DdChWo0o)4o30QZ+iO9sLGq%<|9(g2VoUeSdr)q*McGABu5X-%Rd#G|>@hsW)X#Byml0Sc*_5aiSalXI5
z*}W^hdillnyeazMw)#bDUz^Vs7p8w-z+drHN7m)x>fy7@8Fr%Li>DDGJkjY
zx%y9st~$iSuJ;c-?-}TK4fJgTeZxRMbD*Cz&}R?y=7IjKfqryoHamM|^IzxZ`R4ep
zKeeri!Oymz^*iJC)VkhT)^BXRT1Bg8u{O3(F9&)t)~j88@fpKut@j>*_RP{dSNf&a
zFSdSj>vyJiMx0B{8FAP94EF|g7ASf~7TXWZ7&;#M@>*9PJ|+OXPQcgna|tn8zMz4PS1J!=}iweBIWWV65S
zeDl36YG)wQ7*3)sOPxuAE}KJSrd1Z=oIcv^(=<0Zif4c0dWmj%wR`-6VA
zh)?;yH{)vq^-JF^fw-{O-NG)-_{6{&7T2o-=ataTY{WYIyE
zIdW?4-5G0aET8GUAo#(c?B++=-0P}6^lIKcygO<9V;|Y#!7lfXzcDtR0lvt6mJajc
zsT!lZ=czj52Uw@4?3GXP-yM)Cu2-kt-G_Wpe|XBT8uO#Z;#y<-Yb-uBcF)(C4RyxN
zJtrVfZK{o$Bg>q4(66txsv*5NtE-a&vX=sNAWnQOz2xB`v*hrv>|}@iufc$>#{h=p;HN5|K
zU_ZVQ?5Vu<7n6tpZXJbHK3k~SKW;N9o0|IJ3QW!{qem2vZ3go3{6ha-_zcY7rMEx%^aP@^Q8lQ
zaG>uP=+}g1XYcbXGgo$J>6q&pZT!dpfA!7~+S%>*Jg3R^e6j9Xr!Rhfq6=$T?{nmt
zY41hB4+ox|j}(YBHM|(`$(?j@u(6Htv)%kt0$Yrq8nDe+J;{slc>!CEA0Nnv@!0|W
za)B0qv>2fGG`eiq(de>+eEen0_C}XI+ZtUq*@wUEA{Sk@(Tgto*o6l6Y;9w4LvLxc
zxT7~Wy6#|S*IxOvzSQV?PK&Sg(*o<80`%zt+I@tU3-tMou6M698tu7d{j(dbN1L}F
zAKE@NxoCRPn*ubu(Ck9<1I=!9)fYd}RX^f@cHiMYD{xmDi{G~4C*V4$(lJwpBofp*WKZt4#`>SIq(
zd&%~GMz{U;*?(fA>0^iZ@{hiC!6*kkPfnJmc9Yf1*&q5qK)zm#*r2gtUW~+(FSBAq
zRsmo6DrW3o2sC!cC0}OcVKp6mDcPlOEjsw5iMxD?`?CVg_-WJ8p&GM3%SW-kJYb`B
z^|miibNo{q=I#pUW9yv(`SjvpGk$&fvboXbDo=EXQOPPDy*xF853G|{{ho};?d6U7
z@zPoGBd6?kzSYFmpsz{izveQW`X(+K|J5mfj}J61EPFXLJ@jh5T=^?o>8`pqS2pwiNNjd@X%9yBT5NZhYJE)9RoO0=;;Vk4
z>T5CM%JJxH<>7+x{D;6ZRz5U&QxCJw=@pqD^|FO+rJGLlQXsAe15F*S3vLSRxh&Aw
zqNcTb4t3M#96jT`C&u*fm*4cL8Q{0N-yB$jUI$y~UyIDzuXkQHbbaX^z948
zPkhj0{H*i2;ztg9HT>kT#he_J{q7&@<9yw}^^C3k_-pU1oK&8d!zT{wgIQy-@_Z1#
z13^8%7c(y1_VzKehhJ9)#%y8(-}z9!ixU~>%JIRBwcZ|QU#oM@7IMdPPA9)Ly81Yq
z2YYt~q!984Ya6Z-rv-FtLMm^;9x;BTN1llb5Y|*|owutWpk%srUppUEh
zz823lk;d<{r=$6`ST^3Jw;j(r;2>dcI1iwnf+Xy6Z_O{
zf7etzX2n2U%TBt)PafE{H;@Cm;Icr&!(Mi(U;5TkOFP4-(Ya+hI^^FhoowL?TiC}I
zHsBr4^WB-#_@`AJoRG1-VyfQw0!5b(OmpJ?vi$oUz^)
zzLj2UrOUW^MPOe_^#0O-x`p+E~xmLpH;VPwKnVQ@U=gWOO2kS*Vs_!1WhN~XX$w`pNS6=
znx?+UCEpp*?m5&=*VylQf``v_f3R&K@b2PlsL^YJvJXFqv+uTz#evW2Nd4>$#F)&*
z053V3IlSVqEs%3E%$E%{pQ*z+DgEpQGQHm$&&mV+Y#H^Nqrc7=U+FjB=jKzz|4U<+
zCXe#;$&N#v1u-h!#_(Wjz`j{Ekm*lK4bVTU2I&7})WC!B|KX^CBZAYJPa;9SuL|a(;bJMV{Qa7kfX9wcZc0!tXgyGnwZ(vJ@gxI(jh(j|11
zsh!d^z)FXYuwlJLuq(CKtx`kw@45Zrt0E>8Wf!%*$up)$%#!
z_DJ)|7LEN6w@yBbD_#2jE~~gyEaX%ZgN5nn(9eR^WZenw2z=t|UMgO>y*!x5Yu;J6
zmo4>sKl|DoITyF_)6MZM$RoG*1;5HKQK*CFjd+
zEC!m`?wXGBH>LAD?CGBhZ7&<~*zdnbW=@WG2jrN);qUIhzvTR3<56cl&wImzf86{2
z%x8M4r++u7y>jz&;VByLsek`KdfPx>G|iuRm%RQxg&n^V9x=cprlTA@8}fIL
z$tfA?y7X9oRo3}0_V&B?YMssR%X+%Qb8I^{e^1&Tut(l!={_%fB`Yk)+!|Vs*IiO;
z^xW0f9+|ONnp~(^-$B&Bi#{WB^i{tj71J6&);Q5`*iPN6JhQDd^y&wEym;RjAKcV&RaXEDtJuf*`Kjj0z
z7xMSf_4bNM$*41SR@*b)BfGPYeV(CJGaDK&8QYsI>u8_#^`4pdos$nnhPhtG&t9#{sqD=i|2JfQW1IJEp_80@Gw)8&9vL``{oTTz(r+DI=e79E
zLDlG~jXtgQp7qw%uD)`$snJWV-_rW6t*@Bz+dh8kE2rl+dQa=mZ~cX>muvhNw_dE#
z{MS!f|FqWcYrW@_^=GvHnXP|z>z~{D&uRS&TJM=|pLY`dOIv?+>tEjbYg>PP>tE6O
z{jGmx>kqX4=GNcR`deH7n$~}Q>tEOUH?;l>TYpD-K7%H%lRyn;MUZ#87>F7{k7CQD5joAcZ-
zuII}_qsbRvHe1)D%LX#gWygt)E?cV3%AWJudf9Ytqsy*S8eO)X+~~5e?ru8SqX+Zo
z$2ZzO^x2Ij7rmp=r#4!C?DsshzOB*D6Z(us`yL7HnS@{b&~?tl7LCukdGzi^+lQ8O
z>*S*A{GHk8v(j7N)M$30<^Abxyp-NvHd=G{pigMDn4{}mfK0S|4?msg^?^Fw7HDE|
zTp&g}+ZgSPUEAo|C!d!G^2jdv+ZV{&-atJVixZm7YUW^|iT{a#{XXy0!9H~dY*B0G
z$Yyudp57eWt!u?^e2@Q2lMCm|UNWoSld+hwhaaPU^2xJa`su?f&*Cd~Y}c3E>U;TO
zu#)^NPkkXDM)~_QcOak}j7PuMWo}0xXZ!{6R5Ql%jwj>U0ule6+W0v<~#ii}6}wx!CrUjpAE2igVehzSwBJVz!X+|4A{sH1=wrDzRH`
zwy4L-qZq?OsWtmosQRpUhf2+A(`LYwf|rZaMK(_kFGPcgE(d
zt@X~BcmJLc8Eor)e=zs(YPNd+=xyB>+OuMB;Er^EjW!<0oM+or0bcE%L*4WqC9j?h
zd>Cs_?D*H)7IJz{y}xPnyCPDa$~=D{H;Mf=kLi_
z^I3zQ@@FYyb~_{WE=Y#l^JO7W+w=my{ymT`{G&YdJb76rgzPR<*d`vNvp+>GbNOm|`Ijg0Q(NLg
zo;mdRer(=;K2*-^(JE)BXDnxBSM_@`w>cQ|SN6!gI9fM1FNfkLjwQGHUj8h9d->UZ
zSpJw(@|OdC^)cnMCZ;z92Le3y8;`N#137$R?~Y(+AU06*)bK>Y>h&c+kN=
z^{=k*@)5l*sP(NGF9f9*?<~Fc(OWf19vkRp1Kn&Om%nVFuWZ1lJ{AK!eGbUBrdEp2
z-Z4I8u4dN=gxSge2RtGR6I9l%*KipTKsE$TgGBVk6Kz6
z%*v_rxSDQx?rVq5Xsv2UjLe@9&{gwQTWqklKQLz3(Xz+;&n$b)uV&A3ct(5J29+D*
z%LB2VRp*t5>ebDLp!z)-%TNCdkV|pbyR*f~*{_)NHh7+`#Rj>r{L@$V=#NCV{Aucm
zed2ISpc%hnI{KG;0FU^{!K}N8O?78D<9O?A;jcKkJB-!s-fsS`jQOvo?hM!P>*T11m12#D
zJbTK&JsG=G`nAe)&r2^p=e*)maw^`|``WkP&kw})MM2fcRT<0Eav)~bH9nm^9UY2^
zn28D7)C|3Q12(M1-`-aI<*WJfar8y}%TIi0e(=Bc_dep0|DOpi4Al7~(5?wqs)ete
zavk#f%i6f=g6}Jx+lPAh_I2cQo?P;EEpg?e{o(=@mx`r&G%xr4n*5qu7sw+Y0q@v*
zcajHdrLT{>^PpKTeR@7v+Y+d;y5HF*SF4?ol2`Vi_XK4NIaL#D@y~v-5?5n+)A#;a
zhk5>$KK(5J+$Unh9%E;%&Qw2d?7W>2R9)f+xp_hxuT*!H3o&umh)2a1%@1*|b#Ww{
zzsCjaug}(GY4~f7-D(loDyN#b0r`D?>DKh(w>6-1Ik2D3S-x(|Jii|fU+E{iuW>%I
zzqeg1v?I0sS=n=>wu`kplx^&)np2BnEO%@yy7D*fW2=0g8nA&+;%+}Vp8a$^=^#32|kE!yf*KNMewsHA3D}M3^a!+sh?OudQpiQR#e@Nd68JFM3Wn8+A#eweg
z+L&%~=%z=l^G%%f*62nr1!8e`poyJ!&!KMmp5k4lzsuYga#Ztme)>9~!x`e+TKL6u
zA>dEtxqRf`DZ%c*7=AjxH!2<#Oa11+`8z96kJi~)ajrEw$g@`Wd(|v78~XEd=qKLWNGqjeO8Uh
ziFNgDT`u@@Qos&AsRjG{T3}N>fAF%E&-JcAKbr4k)_q476fN)kGPgajXSt2#MkA~8
zgvWS)P~(cNd}(B}b$1}PV)p)42fc1S^fcXUIUy*S_G{KE#!s2f9J1@eHWtI99pnDI
zRV?_dhS{jEc+cbI-$JkbvZ|1KXUlA1NkV`C
znRlE?LRdr~2}{BRxD#?iVge$vlZ3>CA{Gs}V^L92Xc4Qn;8K)|;s$j?saj)c5wNaU
zYqdK4ec$;%JLoqKPJu3VUF;~R3E13A7vNGO;6
zTSLp`;hk&DgB+5p7R1@OtxbM{yl)D`i?8blS$XD^>TZx|>&w2aBy1tJht7_w!!`OLrKHO>a>9plk)$NBGz<3(HlQ0R93Cqt_rF~CFKkL2gB
z#iHf=-pujOIoKJHg?D#;*NAO3XZ{De-#_~B@H@J
z?TPB+-ZFvb{h3>zHMLQ^?EJl9zV*rc3Hkk=;tP4)mX3Z*M?bBj>-UG$f5{>Dwc#VL
z&boVC%+=Ml;rDv%F|Su=wI9znXFoaCP9J(_ujTn@XUjF+?*V;vN57?`f2N~g=$SR2F}{sK@u~022R>_RQx6rd_YA+o
za^GQ&Z2#RvG`=lC$+PyZPVYI*y4aqa-`5day4pIi_BB~!Q#()Q=KPL|`=zZP^Uun>
zyM`TN(c1CatQDQ5<9;=?9`Ct9ox!W(%PGVBgPZw39{$^kt&HF4Wd89WlPo@c^YGtl
zlq-6wC!=_75087o`a_3#zAO!U-36tS%)e;tW+yrLuM9t$9Cv=rk1|h&cHh9=DW3Sm
zNMHJ`qw(mA&lr5Sqpve?=0H0y=G)pt&kyq(hJMq~s}bv4hkpCe^V7Vz>%~KV-q8CD
zi@tE^`H8-0=pQrmo+ajY5B;8@_pCPWF4tc^^iLT2Ck_3RhyE!;|FogMa_FBv^xi4S
zxq9fIJ@nTO{d0$YapK_Z}m!pN?lmYH9dC}-mL-J}JuN*mp+XDGHen73W$)2b`^!@S59&NW(uD
zEDmG#YQ<+S8?~CNJ)S3OL#s9X-r+QM^23^*AD0JnfwfzMg!h2?#|K(#mpCs5^i8tM
z{iv-)51Hhb57Tlm3XdjtY!~yg-Pkodk*`{W5-pD*fNsQ9hHv}Ztj
z_q)UF)5tS+{(m8GCw*;#D?D4RT==r$+*8vXd?PJi<-zC1nsrR(tnO$Od4
z473=t)je%^2;u^z=lA40k8PF-%k$c
zA$u<9Ws@TYz?NyxgvupZY`|YO@Mj^=jOq5gaBnXLyiTStK=R(QqbgrH(3Kh6@J&X6??f8}mkY|TFba~iwn#-oG&(O)2oFT02J
zig)P}kIxI(w=nSFC%;{DPw>+m-{c!#J@v@udRAt5m@Vr~q_IW(T0i)>oFDXQwU;h?N>|mH_>dzP
zqd*gT=ecsmZ>{nyANI+Qe29tt@?mUV-O%a&*dN$ixod0BxOgi!WZ^Bl$gOelmfcHP
zgWZ8fXRWo*^*y^7vGl9b#C#R*ZzEXmoNHL1KrB{VCL|atdE9nWwpF->3Dyz
z;pK~aujD*CYppF$4&C!?&763d2Ybcg{=?o3$Mq$i;(|xK^tDg@q4DU8&zVM_KJ;e}
z{Yvv^4}1$lziH^*&E7e@n`mNW?49G60{7+10*!6z$$#7Xk?CI@h{Y*^``g`iQlL)R
zzb_z9Js`Y44>TNb*4(T&n2zws_AECo*uDdL)GiYa)#JTR@s~3*p9jf>1gkX
zUk*JA+!L*=zlf}s_Pwk;maZS|=(-bX{g$k&7fpS%^>6;-Ky7IJa(}DC4+ZM*J5yZS
z(r*uhRy|!Bu&J#hyj4^DdVj!9xl`}fmXkv-`L&lkaW%IZIb}m{&pTErr?to4qixSc
zM_`Y=v)U8Z@w5Hb^y>q$ykzLz3v$TU>jUd*M9ww@;*Z`NIA41L_5Aoivu5lJ%mr=pUZ4ET
z2lg%m{DMi}i?w+udupF&$b*BEgGuMo{UqOHzb2?N?!J;|G1bUZ4^Iv7sxP|E3(7t<
zGYYiP`2YXDR**Xbd%*h-9b|0|`g%H=c8wxmtGYFAZE=4uXA67pwkd7>!R}CAq;cuNGv2AmAR_I*6<65ZC-bD3s;Fmr2F1KFx
zvs7wZ4WtR9}32Ut*@Ox)eWh)L6Th{L)czvfkI2y0KraRJ`iEsJ)U=cJ?-(6CU|F
zJ(wn^VkVZ_O0g&%>O)*g$0S?Y^@dCr>
zRv+ryv*bSq7Y6b@3N-a~ec-ucFP&(16wbhuV)l`Q@~y^uD#*__R)1^
zV7)#Q$Qyaq+$|>sZ2py?WM?=&vlUZua%MIL_L9Nh{%$hQ&&7aGY-{ZbdFZ=fGWq9@
zDO=Pao#fEBAvik_M{Dj^d*p=w&fOOW^8sDn5}r&<_xY6`2DNFq+Dfs
zTpuNay^lAU*84^-+-Wh*m>>AqT|S64o7D|eyuDA(2lnx`l`|Kb968j)K+O0`hB4cm
zBR<^{kYNsQ%~yY3<~9Wt&&m%yI|Fs6`S0|yhm55_%nP-jp4x98><#d@H7l3)kk{5~
z?GcCl0a*({<$p`Y_VhZQow<7M@^f!caj5*aHAN45s-}vzkAG^3&2sbH;8B5QkDPA}
zT06uFtV3^q>DrVv`_>2LgMDg)J~ld^_|3O-_L$>e`75`0%eOkazm~bGr3}Y0v{xMY
zC^qfcsQqeyeRNc8infogJwerL8ykBnHsq9lVhilC_vBz9P%C!@8sD6~Uk|38J^Wu2
z__lIudNC`TD#xBX=39TR3oWPRk2^LZ#y-9{y*Q|2wmEm!*~6cg2G+^tL(3O(JWn6_
zt?zjM-rg@5-!GXO^Yh@QVV!I`(8vAOamRhtFg}oE(a*l|+V31(6L&tV%hqQ(DxcK=
zAI#Mm?|qlY@*R(y^#0@N{h!3!$Fg!TiFZ<5#p~|t*1$K`A@0t_}rTx0`2jtxAM9%VxHoj!=I-qMU_U#mKI`7SEpxT6e44bMu4#Mt*6s;8jsri~
zU2$-4oBR7Xe8Kp6#7A+!+r~kBDh_O~JD;vL7S2u^i$4urK3Q{)CdI>^S>myrj9FqT
zKGS3@7gw?B_hstPb3+^|wtV!=_-L@w*$vA$-fF($-F_zCpLupwjM{}OoCo*VFcA<*c0c7T^pX9w)GPhBqsbn4}^
z>?2F8#biEk4m7;{rlb6RLdMR6d^smTwpf%8))#|{DVu*gm{bp~Ec#ZGlh?C}a_HL{
zI0wdjQwv({Z)XEPxkV&-CJ{+9{X7Iw$R%H{BU=miL)jiYO!j0ea2$&yFukG
z!_WAhdr#(`8qlNGOOF^q>2V%fy{8ZBe4+c6fPQtSHr2pfQ2XVXJm;w5U=Kcft_sTL
z|C(`cvl!ctzXkiB8{p@IIw~Ld)7nh8xw7fxfu7_;YtQe6ueXOSWbql;foFdpC+7rg
z*7gQVLC373XN$&$O9MVZ#g?x2jJJE_Mo!Ebvy;8zb#YL7
z#n*U8p#5&{A2BTY!yWDS)$>6ya{{6=Z=Bqk2x`V
z^e{Zq96zDm3Pv!P2L8-6r&8-wo}`0Fkt
zhh67)a!&5{{bhcSrIq8qUDMJZ=;#-Ru3VNs&f~}OyENuYzaH3O{b#a{K5dxe!#SC2
zb)D7Gf1ckfvgg!h&j&JBdgh0De*W;l>$y}heA6&@W;6GqVa~s86yKK(bMB&=+mX38
z-lv6b^LZe@Q`OR+3|;Zy+pl%>PlonPDEV&>%{Ts6@7)8;xo_}WV~4){u3o*EFTU!<
zYZ5
zuzi;e{pCadgrR@Z&_8+TpEC4M8+y+N_lo;OdqD7z!1r+X2JWH1%q7O&?SVYO)5rb&
z#__Pny9Qs~YwlnAd>?&%;C=n|!FL7!Hh6FFf#6qy#ei=0NUptN@cV%r*1KPZWBR=G
zTLQUm`TyInJ}dvnR>}Y0SIPfBR>}YIRr3GAD)~P#Bmdrkuk!H8(9S>`SF}8+b?-Hw
z3R)g{DIU4HPhd{1%4x~|!;IT~ArI{<+5fZSnI^kr{!#c>Q#XISO8!4tCI6qUlK;NwwYXbAEOQCkOWOPn#5HHL{Y;^sU6hhLw2OwGxkKfAK74?2b{tOaFiV
zsK>!~nQd&SL_$
zv7Ns2kFmbfI(?@cV|{;=?>yRi`B>;x^!@lT*7qHqzBetS&)GWC^Y@ZY-;K-Y
zTj||trStD|K6p1?2+j{S1grJo{=*)3hUeYG2Os+REmP*tm@@CbU)|Tz{UTpG8h6j9
z^4(lpyZ46f^&QQ-?){xUf0yQ1>if1%-`5{yef5m^s!q=fI{G;s?eEnbO~1>Ii#k0I
z?dUBX{UuZE*p~X*9@KNyXMt0K_A}+Vp>GP_8GI_(7Urek?ZL-`%{d7BgP#gM9(?{>
zzW)lY544hXM#gmxr}e*_J-;2?9eiW(w%~_?_XWP2`18Q`NzUyk(5?;^1Mf6GFU6$s
znd$xTo!~UR<{uPn2z0pPL;j_2>jO;UIyYK6=ucg1a
zqjz=m$|o7yg#+G^_q@8p`-srN1xfz8#;Pt
z=+*e%`ai4h7dAR3`OfD_d4E7>>jOLb12Mck?;q~yk9PFOI{J@7=YJEQar~SH_y4TE
z|L;b}B;V`1&_3_K-r4$JJNmAU{`!vowvPUuj(%6@{O>cqL#=m=X}-7f^&H$3Ir6tN
zcxZ4zATLSR_&LuOW1n@rJMRfRSAEY}&-;xuD+Fb+2Bjbe@aJR-O<-|^ev(D
zzp3AEtTqPzP1ySizb*@&5cqdKHoMQS2(BM&DEgYv#y*dUgV^|-LWVjquJ8XUM&=(D
zECj}v2I6M#(lEAWEY8OF55!O3zF)QTWb6*=yK*^hZU4iL{$Cw^prcPd{_y<|2%Y~O
z%6r9^f3t#3J#WdJbgs;84V)|QyPpmwz3-L`F(|v*8eeJb49I`WCwAn@``dz+{+3~_
z^4#V`4Y8x_K3cZxyzj?Hncp;`G%Jsed|NLPd+m9?9;XcCyqyx&$9frdih*2E&Gq}cv{Ip$>cjck@TA$si#oK>xdsWuR)a(_LikZ8>9bt~$b3yB8
zFUwthLb$!loECV0CF7i6XCU^TD~}FF0h=Em`0Q{+@SNbffDS(9$9xZLPG5SLo2wYt
zyMb7*Mb51HKAU`T<%F|&vsZo9
zIWs1goPKXFdy-5%d{)ou${DP4R=P_5o?)Gw6N9q?d#?_9JFDi~ca4ScJubK<_<`VK
z!S)#NqToG&Kk{*DitM)FO~DTY?+gBKa7hAqQ}CwX2ZA37{M*F(9NLS6^M*bm$385j
zA0g7pUgLxI-0!$A3coX@Ukk|E6Yx_n4&aX15L6t^wd-=EjmH0f&^9%pm2IDnUu@H_
z1!U2=7Tc17&#=wh-bSA975L@*EBAQ$TYlo@fBC}~ICbcYp0$5K_OaoLK}Nc%o?B1R&3TMCL@7Kn--g+
z@oeSyB&_tzZR3DfbMLP9+3H>%1sXry+wHw-el71K>=@acMsB?;ktJ^Quon%pJR3&g
z^E}aOs{zodC6D_@;Hr$Tz=PkCI3B(J)_Ng_SJK<-Zj}&<9!*Q
z9~*pbI3Z|rgeGsL7<#6z57@aouxAu#e5Ow;pLa#yEFf4=U%z+O$1&-ZzG)@=|^2
zAe%0=RH*Yh%AE74@AF2ER<^CC7TdG2E;8(8YyMouvNcrC$KDp7e_NR$$9D0tYF^!b
zalqFbgEs{~9(*h~B?sAir=P3(#=y@Q`kB6W1^a@#0*%jXU~B%w#n{%Rj7Nc{p4p<6
z-mlMIy7g-TS(P6>pU4xl^MZ{*pHn>0-kl-G_Ep}>zNOd&WY%~!J-J6>U&4Ldh>$e#
z>+KuGwgMY#JZn$xk=PgY%i8DXPg}6DrB@msseN-R*!QOia1S>2bJOS}weN%#?E7Hs
zn*=san(yb1)IQIh5g}=l>hC*a-!!ms+FH$%dnEPOf4A44kC(;1<-o?}){oRa&+ic-
zX_Mmj<*{!iuyGm>x$X1K^9Eh-`0l~F=h{23{oL$~cwhE@VO-BQvR1l7>$BMU@QwnF
zpY&>VkNVr#vw*LY_{gg75%@>Gy5XmJ&mHsjn`e9f*}sj$w6$q*Ibj)jY*~vuwtMC-
z1m1V)*bu1U`u$4dO9Q#%-_kI)$C#hSa)w7Q26}sYyH?6)*<-($R=+#rde_Ntoa0js
z(kjQ_k@2ixW6w*L+*NM*gAcuu-Ezy{QJ|?ov{v@LB;(b9?v|gdBe9P^BSO+9+4rQ(
zuLbP1PdgI()Y6EMv`O}D&iq=zM(s%Kb6!S-q?LVjZ<%vuM!|_eohLC@(|-2G=Rj-P
zg~7Vx5B@hqZqK;(I)lsYJ)>D~<=S^}R
zQ1ATov&}hz9l^T5f75=N%!-qIi3go}^JLV|GS&S;-iDxJM=l%Nm@kHAN69JOV%PhV
zsd0|kuFAY~l`A&!eUi@7fv5K3ZS`5JSn&f6-Wdmf&elHbYUZ-Q_Yq$a+!=g(
z@b7}33w|^B{os#-zX?7+#y>FF8u_U?DmcMZ=Yx~pdwnq4Oa_}DdzY-jmc$yVpbO1AHVj)iQw
zsGN(hny6l!oqKV17vSsj?=CnucwjJV4OFhlb8pI_@p-{H1KsN(8`R1uur408N1d*;
zXKuZFemTld5kyh{U5
z<;&b^Wo=$Y*2Brmh3dYR!%?7J9k5+)tohvsu^0tv1~1zy20Jol_uLS}$_=0K+S}*m
zlll7)>cBp_DlU_Ff34#s7oR<10_p{Pr@1L0*SRb|@Y}~``zp5T)qeBtO>l}h((97;R&&#dJ-HB6j
zx7@ye&TH~kHBdR1=e}mv8l(Q5%{ztnF?A%bYH1dps*C2k!{}eenL^
z=YzHm)o9%dbnFS-t?oQE44xA^0(JJQ!#k|;Ec`#YO8)O(CI6dN$^V*F^53vZ{wr3=
zzpLYSk1QAe?HℑqRY8?jUexomI~wV|*I|^5xb0&&fmY`HR+9zMc02!?V}?EcyOK
z_pDyAo>s~KlMTOT)qSQstE`{SnRLe*QnAJsb&Iqbtjo;bW`
zkS7-8k)w{?h4qf6FFV@(_S`eHqEEDV$sK(40}rM
zEVi|0!Pt3rcFAh*nu|lfDbQ{Yt_tYUjNKPv19g|w=U%eU7!YM
z*>4{^|4p+mWY%Q7fJg~2xBjn0m+m|nG-|Dfy
z^?{Dx9^Mn|p-(K$-yVqHLjv>0K8I-K4?g;)(f*24Z!`JjkA0({YN@SZYgI>8!?kZMHriA2$es%(JtHs7{Obbk_P~91
zHX_Z~{l_PJ3+{lw$bBq+)^`N-{mO7htG|`@IEVJ(`?t-$kcT}N<-C8t?{$;$`auSM
z@!K2J9j7nf9+t5)TK6_yaW2eq|F!z7miR*VmkoB%S+dC_UyrBn`*@bjiji~nMT1=9
zk}LLm0(0&2Po7#o>OR*`)5U&r{$RMj@zO&++iwrV44--9(*w;u`l^?IblWed7vH
*ZKwrfwJhKAH44b&A3yxJThB=^zH-Hm&4E2<1bis_
z@Yy?UK1*ZU_*Ophhc0qA1oho6`RG0lbl9^k*dE}6gYWEz|64u#pA)~9l(aj+%0FxVSBIe2<-TX1)9Pw*YV_XqC{^1rd~V!>xNRNTc8#Cv1F
z2loqJwy%}k{ZapxB8S%G@t@n?e{8ued)qVV4sjmkug=a|*VT-(*Y4jKx;+#N>}
zoLPJD?g*Tv9~qt#wSST?t*-t&&bn{&pm&ydlnu_d2-@?2U@j=Xil=(dp*lzP48s4_
z@eeH@Vz?F=*LE^|=k9OMUO31crPrVWQl-u%kmO3C8pFMTYEM+WC
zApdOL6yNAl3!8!y0`CvyN6FxiXK2-u=N{g6PdzWqi!)xj+dFz|=qCl*?SXd+<^^
zKKtboya!i2)LPY_v6}MEupIwtcp~a^+NSpNjvOxMcN?d6JWD)|27lFpIsmz4v+Qx@4U_j{PWp@&FWK4szFeHe%G=HXz?oqXsV()Hrt&Zbv~&kU{$
z76Y|Ohy8m4df2Ll>$9`5x@6;qKtp?{JU7@KYzf@`ljO8_+NlFi>1gG;WBk3;UUsXK
z4W%o?!|ZkT%0{xhgPLpYELp`%mVESf*Iicf#7J!9<-~!X4|PWrA33G(;*9aj=}Pk3
zePKULPn(z0Cnx1Y>r?68o%Q8>${-8TZN)=GB8()?;_&CerOt@W}hPs`-otW;NIxCbj1v((k3J8WNMTo-&U*44i_igk6rqgYpBB|i&+JgSR(hp~LzCr~f_
zz4lMF*4lF;E=z&;Lg&go;I0)5_3D}FPEhyYneF=-vGk1h%(iC~XwM3^24dTY^@
z;GKXx&jkA})F=|
zlCAYNhHdOCJAAI^k9d|J>oNxG6%VqiHqCp_VXwValj8G;z`1{3l*r8;!RElv#B1nL
zAii^f8uvV6Q{9PVo)q-!bcz|hm3O_n8(N!M`FxypPsM;e6{oUqHSrS9b%B_8&shk_
zL$jxk(Y2Xl^I{;M1-zRA`IdwIL9LZt=$`Ma%(0=ZX>`rkxyaPGzFK?8y*KZ$V*7?b
zecJngfDcy$R|cAAdA%dcG4Qp)mt@Q~I@N(ViMPCoWBGbs#+w82Xzh7e
zX#4p)>wf%Vz8ZcxSPj2AUJbvq#P_OiV?ON}=Gj|gw$zxO8p~DPE%u9*yJAydKY81N
z?SXuPz3#oa;EdoI1Fg2s4&=g`y4e>v-`3FXp8JP(Pt6DP?GNm^JlGn@Vd*4iG1wJo
zOTlW!d{PH`dDlNU*b$KZ3q$SF&qnoI@z9H{-ks6*c%38iswaPEAV%c*`A=~Naa4=u
z%Qy3UHTUvBOy$E|*}IT2JLx9_k2THs%s_2EbfCpkyqr7nmJc=MUh)0?P3g}KS|8cr
zKHL(_2V~e!-*v+nk49&!gRS!Ce3dWkdq}V^sJs2{jM+$sc2{swAeZdrAF$)}U}GTm
zdjodt8G1aUK;wfv%+ia2y9ckaoNWqD4%D!AXQ0m2rW~?OZx0)0>8oD!w+6Kz-ReAb
zSaT=N4LB$LV}i3s2-9(7zcS+6@}(tRjLa)u8|=Cs~r^+8%e#&cOZdPUUCGaa;@S$?T|5_tgtDG-pEYF(*u}sLvGSrY(`_#9b
zoEe6eAJ3kEj-_A}Xk?KoZ(1+Me`jl&oEySFvMH^VQ*oqA9>^zy5Awed@L!Cz8-r2c
z9bi|WZ4IJ&+{~RG^lQ`Pm4D00BY2X$sw+0O`EZYE?3Pb4{-PMD?yn81{_0+pSGiy#
zU(}ygIcRmyWxn-=e6_qKSZPg-Z4bl>+;jE2C-gryAiHe9vnSviUh+Y#_|DF~0YCUk
zhSu84H~#xM6nU+fRSY&|4$u0aX*e_0#Vs>}t
z*{vRX``uGodoIYRcs*zaAIP*vPS{YnD!uNC(*n8iEa3CmVXQsq`OwbYv>33n)w4M8
zlD7~n4YXLH#S_}|us*bQWnf=aj@Q{?AG)u_Et#VWPwnabQ-`z0l^^_Fh%)EUXPaq0
zv!7f(&~Gmrd;RXy(}Fg>8^TzA(YJ91ef0GD_GiwyzC56VOg4P3&DZ(hgM8JwT{?oX
z=Zo4Ub4MUHzO$-%^;+}4-pqTh)cgmVdGA9t{}atT9X0>%X5MGLn*W~6*XK~@xaPkl
z^QVM%r;$TP_1<6A7RZ}D>il8ZgQxt^PvUh4d@MgBQSz#v#_Mlph*j(7Ycj_^I?86h
z=TLU?kz9Sr#Ygw$gKppN-4(nl_=~xNceFWY)!d(C?jI7r7yV_2F@HnzjO^bXbe*4Zi&oEHrjXHp+t^j>n{v2oT>V=He)P57din9KnSW!}-HIy1uO7W
z4$4RN(91_YXg36-p!I=lc4%zlPiv#t<9Ymy`d<*??2lbvLW
zkA3xwsJK}l1>(-Xm14s;t>o8PEV^POS6hOrflD&B=2>FTo}o7ewz*R-4%`*c#uwc_
zTb>ew*JrM+W8WLQx5%@m2H9~=urGMt@ds;5?8F4`CxTwir21nY->s=v`^>JxnlV0V
zPE&VcFw47|v(@@K7rH%9ua2+c;d3+jE8Q>d)w(;Jw_f%YnOlm?vj;x1=L53cjdd_(+Cx
zTz2fs*!{4So{e=s7Hw`JC|bRv%{xEzX8R%ff{gn+o8RSs@#C9zcUPVFcXyqsia-C>
za<1y$Dxc($PhxT;cenStU4f>?`n%gR$h>&T^M`_eih1Gp=TctWzsu!CKH9vzEcE)o
zdAT!qVz3yrxoXdHe}-23zH@72*BSEuGwBSq_fqjMcZRCQ`!iJMyUviBT}!U&%+who
z<7k{A&w}N0;kA
ze;a-^_Vd4$@7XF2+XgwF2bDW#!rz^rq<8x&^?Dvm(z|1j?D{u03TENbo1HZhm
zOYOUpuMOPCbAdd~nos#Ar}j;&lXIijGn}5PkLoAYi8I>zTk=ca`B`TtKkg1Zv(#kG
z-I4Lm;M8W$JvItX5BS>iFJ#XClHna=b3iwK^YtAGpVjnYV68tF4<6z?OB}O(d=}+t
zTd+OI_A%TkKHF5T}O)J9u`Wp{+jzk#=kFHN(5o8!{$K
zEws-7K4?!5!~odCS7Y%b2b=dRIXNddDQM;Rx9*<*g7Ey$=ocUM?iqS=MuBs@E717r
z`K9s0_jCTXr$+zx4t~sH=Ti8m+4<*Lo7GNoM!_^Y@5mazekst{Js*5D(AZr+mWh>mX8UNEe^Y8jrEza9Up?D?i<-@nfI2ZLGtzc9QHO%6usC&l0anU^AG<1Ili
z*Y_%F+P$?ds5CfQbUmfLSH+&Ad!u=bbD)8vTJ!E9lk}KhZhg|(RBxkTRvRYC;EQ`^nw)i66Z6)WNpfzSB7^K%
zWw^iO7XK*d{UWRGV?56c#6avkpW1ubIXyRU_qm_!Rm&R#_io+GcVzsSzu*G?m)0J#dOS9M_2Nws+<$&IjSLaX6
z_-uxKL__Lb)))~jMF;Js;*~8D>fo5zk|E!S(n%=uUy?k~it_b!A=GDlgVGzR=Asb07}#@QKtw
zosB)AofR=21#+<~(AdwOZNc_{UU!Fge0GT&dGwS#=ltxT?v7c`IUeoKpgrg0E(TWw
zj}F`u<%8NNoqIFpKVQ@@dFYjFyD2=goT-x6*B~8j4f1=^nZh>;#E<><7>@#N*THU_
ztIGGf%vJq~Y1M}qkXLv1sTpg0FP@cZhz$DGPK48*epGvHtjk
zx>B2?psy?Wqp$KgY43$uzaWN=()attsjW-?R9xyAWlrqqS_m{W|Mvy;j->XX@=|qk
zPUiahUrrC+Ru3CnJ$Hmw-)dAtJ4>EhT5resnJXLUE&H6yx#0SMyz+_eifQqlm$@xL
z8!tS|`QhA^A77Gj>%-ll9~`tkj6$|(cJYB8O&m4{{MYE<*O>ts
z)8cZ{uuiA_YDsH#_VI9+i-%lk>eD@7e|zWJM-ClqXKO1rNO3)*@|vxU!OvW*O}7CX(DUG-jbMaK5*
z4{A^4Xr;YnBR!rk@=QkAct*x@VBIsN>P?K?P1fj_0}bEEAZ=^Fu37Uf9^`4{tG$ZP
zof*#u>^(l}>6@R{pYst;J`)w`Wpr*k&JHkI0~n2^sD-wy7mH_iOG8fP-rtEhAsT=iUZDTMB@azgS
z_NWQ#^whq68M|jj!~7)vey+8fP4rZ**mU+VM<09Xawmzwqp|^Qem=mX6;IhyG4T9T
zr|c#hZVl*lzUAwrKnz!^oqA4G3`$O~yL@3AJrz6SX?xgvcW`a+(m+GMGB_8J=1jaM
zxCfC&R{gur(=%olh?RQ2K5+iqI^-w6HwIz|<#(-}lR5T~!)EvJOM;Ro4;N*juYdQp
zz2dF0_c_7y19nyH>8TjG*Q|+Q#n(FD^nGkAuVU(6*X{_!iC*$rf61;qTQ46b@odcc
zN-?p2Td>ys**dnD{d8$}24uQFO1>CBIx%){w>48SUf=NIDZa`fU&_Ww`4tQGIccvP
zlCRP2zvC$GZwTfCF>Y&PM`%qAE(~z)W`#XH@1!|Av&`dZ?enZCdNE_MKR(#sj58dc
zx0}+7v8H}+3A`_8VlnAw(#RK|k}U_N&)IRml`dERhaCdMsy-=7#B
za^y}8-9L~o=j*EA^uYR+!TSQf8heM=?g-eU1~j(Z5cqd}^~Wam@Cjdy$t3^DLCJi3
z#@Z}(@|J_FYpxS#q^}cqV?T%XterG3zBT`-jQJ}Le3Yj)Z!ZjOU0iD&E$%ICUrRf8
zEqzi$i<=nM*`Jn+UkDFfCkAB6#dXa%!22-uB^2&d~`>XHA!Aux9$ENQ}|EHe8slqKfB{s+v@}Nx|{S%&A8^O
zKQC*W0=ctSj2@eVVqLz!aKHuW-A#D);xiYB(I}|1wVXZ6*|D5Gem420=$H?dv!{*o
zq&Sq0Np?(%!>$?Qa4dZv&1i$X?GEpS>E&${XjcdBk?nz6_8f6Xsz14__c-G-0x@*1
z(ek`M@Er9Wi`-hH>r11naw4v3uKM#co)7GApTWlXw32^a#^%}O?or#u>PxQqa(8ff
zuqn`P4Zgj3FH(nmYtMzxubO*>9pDU+_xZv8plqYJY;)%s*SU8t&~f)L`Hu;$vF(z;
zyRyc%A0KS%b&I*!m(T2IZAM=ou(h>;-IHwaZp1FJbk4OqgG+;wCEoVdGq2XmKfQH)
z^13GiFHGOpQ02wE8W;uI*1+DXF}cw2xZC+GHtc(3aC3lXV?dTXvrS)o^zV%wXz|}P
z^kkJDH3Ia2SlD+-_Ni5S_}1DsZO^3>_K3x0nWvMyEdjgDKW@T&*_EYnPV6h2E^p+Y
zka<3}{2|9VWUIC(5Sz9(*uFpDYsFEHck>BRoJ_@v&H!d6aN53{2|NlWgcJ}()7@eH;(}U%7^f4}fN7<*1#{Yj%pPJHo
zyT~6|NMk>{)S4Wy{pEo;)P6knXjQZOGJakr<@Jt$?dt;#Js;R_U&YASov%MH*c{N^
z#zc+qskNb(;hePk$$V>Sm@RJz_(C_?bl13at0(&1Q~muS{wwKM^R527Lq9Z7H`-mn
zMS+-jUa(8MGdMS3mw9%r3)pDRxNKxY+31d7*M-636O1~O_PAr8kU4o{({nSHJA14>
zF*Nz<#;wjbesXpM^!j-ab7HeID0^O!`ELt;ELa@Y7t-?yzq7hw7^6MM*zWG&fBziA
zJ7K_6L0D*LA~~?&l9CH8QQ;5R|R-KR0+(pcOxx
z={+%!XF8q~@cWK{J!EKi2XcT{&Yu?J#Gih4*4Ww=nc%P5{F9*S*xHrNKJ--$EpKdZ
z@9xFWWYeLQ+uA
z*67lo7i>uvlShx5y*BvHp!}-3XD9Fr$ff(Yf9J^3+%14Zmb^cH$F8`zs9c!==|@ogPhuv;rM*jxwtX3T$If(
z%DDAKE%A#T{M;32?5;CH=R2Z@EOlA3zH%6|r}mNIdzzJEbwPM4R-V25d~+}@Ue@Wc
zPX0nrKC=DPKn&%b4Rt@S&)A)DZQu;r=h-elmj@Mh`6R!1DxT(6%E5=a9L!};|NLSH
zSz80~+!kyP%t76i<(r&c82Eb)>gvS6-EmV;cgey)JMZ|NH$3#C?Q;j16N3i_Egw7R
zeSN@3@~pdC>|s~SA95^H%;+RrbC0u$EWKPjCO9)7Yd+W%@O@|S(BOh#6xf5;*t6rA
zQHqal^s_qp>W;pqqo3W;`#Rd+Qf%cvr=y?S(VpQg|6)h)@966qI_4kM*gU_HEjHJ8
zw7(6~+ImArdk1gVZ|vxsI{GU*`sR+lrK4Zi(J$)guWaa}9h(<7vc=}BI{GCY{nZ`)
z(vE&vN58zIU(wO8?C4i@w7&(@#{M-OeQQG>?bzJb$QGO1JNmU9eMd*%+0kFq(RX$9
z-5ve9j{cV&{rZmn+KzrhLyL_&!*k2?X(8}TsOOFQ(cR_V@|;>1;NKr;wRS_s_AdqQ
ztmg*HefDVY>#&Yxo}0ezYqH7)GCe1~KhUBT|)ZGmUu&ji{X!F(WA8l5|WpFpJ1`5S{ycerOF&{@6l8G+~LN@#6;
zO88s)t)b;YTmz0`D;1tLPGMxtkyQbcbqC9eH;0
zqm7T}VN3HtEXZVoamDM28JC~!dhe$*pcd6;?;HEbjcbSgE;O6UH~Hb4*zk>vS$#Vx
zyk&dYe0Jtqn|oWu6%UfwP3Cd|`8Y
z=ABjh)SCWPfqJ%I4CrLPc4t5q8!8Uu&kgi^`ik-XjI|Ac9JZg6)yS4WtmK}2SPI%0
z8BfX=oo@~77vtJ5u5#d9+!D+x>kZ-M)9V7w9V&Juug;kB>+T_c+Pc`XVbZ$z%?Arp
z*7+}f*9Mmb{5v%$|8C7#t(RTpr+NA1?+to8~Wjo#BTC@>zP@c)Tq0
z{GGIJ|1$#qPFiQ{O8&aHN^k40I^<*BTg&+?hGKa%YDK&>b;+k~!REj@GIlQUfafIN
z@$%Cg+Ig7ty#k-0)}0;u&~SU;Y@Q#GWlXoWH(-Nvc6=hk*8=}*JZswJUMt_@D0Jg34T8KcrX`3d@tr_
zi2Qq%&#^v_y*2pt;E#g)tjlNS;EBO?!RvzW4c-@gC|HafK4ds`4NvoDu94UJ!^YC1Umuj8FK*UaKhSsgG&N7vZ>CrGw2>RFE`E@xZmw59eTX;0X}*4ep3F5k2Z@g
z`_zk^w09q!>}YkmKj#DSJQ_N^Lw~k)KJl}tbCx{H>wK_W9*YsITSDKPJ>yfUb@l9R9;nzQEI7XKu@!S9c4I3_h&3=DmA(6A%mUGa7%K
z2Rfa{f0ZOvyz4w>`ZMOduaa{`;C)x?Wxa6?va)6B8D4AbzcMn*rziD&r)raLlg?4=
zn|1I`EgtHT9XAB+-g*zI9JM@jdiL|xyA0plhgSyHt_hs=%>&)O_sYYh7~=PNsMacW
z@<_+6fwB5`7K~pJ(AobRt2p%WcDHR0?9<8zz58A-j(YW>CqpkT`g)eJ2Q5Z=_q<+S
z_2r{_aIX0x-a7;O#p5IS`B!$*MbDPNzShq2qrL+Z1K*L*Z%@VC{UGLK^I>1$du_5S
z&(`c)E{=Z^*>rlIu)Vd#{yPFW_{_>a
zF;k29cLWa&$hs%8*g_ZjO&$H_j{e4u{-%!p=8pcBhK~3{cPgD~OxqK%dD7esnfLw2
z&4I=T_qzY?oB4BtHVzd}v8wY?F|;?^#<8ns0UNAWZQ+?~=EyOpFFrM7&fcY<&Qa+R
zWA$3L&aS|c+WNrSe9*6vuSQGP-i*cc?!Z3w*t;>P
zz3k)*-D1z4ve`U-wOD@fnSAuoh#wuTZ1EJ!g=U_O>@T}MTX~&ihZvR}6=%70Pm7J-
zdF#g&t4X~%5NkQFc<{S?ou4uoRqirz7StJ$v8LYWwiS7
zxaWJGOdWbg@#oPd(&PQA
z(t9SGXBQpr0X~_xN51vqp$_*C2R11N?*!~Q^B{TXIi$WS
zhGf&lF1%Hb{9#||inv3$uvYJ{&i*tz#?bq8+E*Ygmp33)0=dJfkJjlmeaeQUQ
zCaR_cF<_R)3$ZkF7J*#`^To+TDRz
zd!}3;{9Q0fm$k|R*=5IadFcI=m)=kJapi8BpVlYYRQvQ~xBkmzyY38EZj9B(Ie{9g
zvoTG7t?SiFt4A)j1=|Dq;EsS$yy!j-=Ia?D*Bb+}D>iJ~5Qw?D>gUNUUnZ^Hlyw5@
z{&0?JPwPW|m2dpF{KU!~FxT;kDYz>tR^=->(EH|m@PBh~TA-mvfmmx~x~J6+-TcH~
z^X2=fnOljs-Cw+|tr0bjIlVgrw($2A`G?!@4t^&1>)@Wm#P4jf>FU5atX!GX?jN|<
z$YQH|S5B?(3)(#=g?9E9f-3@fFz39Pv&VC$_OM+Hwf1>zPwBWRWBC$)`)}^(FKg&N
z25e=!wkM#=y+9WG#DvUC1Nqn+;9-k80_TUl@_SbBz+gVu6tK(w=MQ7&1ASdbU((Td
z>@EJw8k%kG+EPb9uA|vr{27jI7w;CQhAy0$F~~E_58#hI_>9@OKOmb;=o>ovWgY#D
zj=rU%U((PSj&s7liv1%qrt_rWoZy6@%_%$7kKeJCC;RGs>FkU>7v$9EJ^AL(-hd8u
zET43!p%a7op-(rKWsfy-FAw-mUTXvU)Mn{r6WZSL
zxzO4)e(RI?`A)Wd^1C$jrOVvKfqX$L1Ffw_hWs6=3^jP9GESONhPv|nS_q6QE*EC}
z?MZgUW_{>MHciWiGu86TkJiVMPS_pDMZ0HO{M$Y5wbkx%k5Agu`Z5ZS=UU5GK1_Oc
zwtQ-LF>pSd7tJ0q(dcpJZwN+#R%fZ**Pe57ZVc42GkjAZ$71o~fUK_$$TjCq@($uV
zW9#bv6#+eJl%C49HS*35*l54I)SaO=t_j>h2ZCPqOEOn?t7qoIz#}i$2A2hFC->H2
zEdF9-o=x=pLGC*?)g7AQq5D=G+-Gwp)9N1Phk3H_Y!AqUwZ!VN+4oh!B!9%S{HYj<
zi6(aQLD`kz_??!$I}mC46B>v8zN4Q37n555h0tP)X8*Tz>#ynP8$0@0p)2=fh{;Ry
z9^2~J-_g(L=uM%?C>uU6^eGMfKk|1yT6rJo=(l(D{*Hc9XmRwu;jHV?^oi9OS@#Sp
z{a5F2ig>>)`tpu`SZFb;_ZNNHJFb8zBDkN=;;j#
z124Xv0e@ltdk!2ZI^=O*`rZSM`S_f(wPcrXWnaal>~wC)c4z9nhv?lgdUu0*~Sj|p6GmU
zu?Z&3a@T}8Wah0dhU<=#G
zeRci@R2%1y=kG$b^!r1LY4LyEK+9p>A5}BY${c;(DfHe^^v?(YU~a_B2Z{Kj|R
zp)YyU>Zasv8Tg++^fwLt%|rjfjyBIGvC!PN?k&Fy@f}Ih73tp}Xj=n$)7m`cdOe_S
z=~hqPUq%6&?+vttKs>=b*?im(XvIrDUhVsex?Jx6o^;JzfZ>U
zaZ;d}KQ}Pf+8grF8Xx+##mtrOy)E>%vB*_Ajs+cRL;J_Pzx;K6LG0zt8H9?p81q@L
zxnpWgeB{|(S9v9CnrwOe7X#!NZ~k=Lfs)tfwbivgyvIrxTeMtThuu@Tb`PU}By`2d
z9yR*5%!yagZ|vw-cJ%cf{q)dcQv076x~;oMhNiRD&j@`=Xgr#`#JZjx?qy>#^>xqL
zQ#|_OYxlPE?j!dHnVS2<*!}UZ}q~T0ov>nBUW=nqi~1DIkyBvQ^z#u6yG#87~C*UT>kyAWyO%r~)SAK%H&Ysk13pPBKdfX)2zEM`OL
zdP>G*svolW@baMic29aXm*4WJ;Ww_Bot&}wsT{ekCa{cPW}GG+riOE+DuK6cZG
zZ!Xa82})+g=-$l9NyXxo8CNaZPo_08N*BM)v2D*VZx0{L<9l6Tul$ssp1buuyLIi<
zgWaKjj}w1q!uKzCrmtGW=6jH&;=s}{Pmkw2+s+Bp9-FoX{HvNUrKwN=vXfo*?G5;TNpNBComr$q
zZ2T^kdSEZ`w|swk#%{fOzRc3Ar{WVg_S4HwcFWMr`G{Vy%YN(z610n0S}3Y_PAMLGu}tMF&~)
zL4Q7adF>hL<%xy*<;#hIc2B^M^4orX*K@yLXNz_Ft5*2U&V@kDiI2bMQ?;kgYwT`S
zLq&_v*#W)l1M>N(m;3Tp3?CHmVLqVWvw%Nh$tPpJkgvAdSdtZ!4!xf_li!^QvG>l!
z2YIq5TO-##auZ@qAy(v&XYP@RlNOZMlpDuM;dfYM2d8>ymd@XJW?L4#19=2)iGw96F
z{CIreIqAH;F!+|>r-DxeUyvX_Fz|PN{S7Wn%-G~^5xa%JUOJrpxj<|Atl`67?~2B9
zq1W&m^8;_26FxsY`2N^nOt*8rJIK`7*HL=y>Y(I0E4i=C*xg;`R(rRCw@v@=reRiH6h?hDMkFA0Hofh0SjB8E|$igo#MeoU2?C`A%
z&Iru$Q>_`7U-D=_`{{1i>ivIT=J`~5&&+sNK(=T7DA44PF7oh~-U~DScX5Ia`gaF>
z>h~^Yu5?_V@dpDjyEo7l0x=Vt@(0cL@`K-18!d17;GE0_YVn6-g!~+QH#uP}cSq<;
z1MlSgqlf)J5?=O`<2xcgqRIKuZtcpojvjQae}Jz!aB}3yXBkD;vg>ScVi$&KNd!F@^@n(N9zM?Ki;iXZpp6tGhPVP?Q{W}vu@wZ1MydNU
zHoJ_)hJ6nVrrF15{+3>~HVU+>4|a$Bn*e!p6Xq)>)-M{?<%_%>fj#dWe&)?t=3mrSja=I;qA-<1cl
zZwttjUvfP+=`((1;O^Lv^SGFPYaljim96$TXD$(XEm-}RwC
z7~s1%(AcTI3S@2!wBn<0bI{6D2SE2vhQa>QkB79o
zHkW^kp+P-38|KNFbpNSUykxvDGU%^7nER>B?M|%h!jv!_q_q(}2t&??nurX-)>E@T5|3WtKgYVA%V}r8w=8VOo?5`YKzcrxC_?CcO
zHOE%^?B@sl)|Y~^yQ8Y^bR{>4r4W8?#zHbzCJ8Ji{JXZZ}@rlsw+P38h(D=
z`)T=j_Ap1D=luU;?_R()J~jz3t?Rujj{V+g-oA13u7+;jyLYUg
z9$Xm6ttM~I=+lA^#aYkK=O^grq$ivI+LZxY?hLLD+5B?C{j)F?JjI&)yY+)0&qf8MmIrWNzPT)^6H_
zMm_NL=`rS>^jc%Ek=*KV&#NPJ>wz|p$rwv}d}#dc&Nz?K#lQK=aKYO>Gzm)nsoF0!o
zt^T1C54xTl{F^L@zjZvl2j!g)X9p|6IlGrT-Doy
zjq5K&nP*w!n&Ia)uHvO`#qZxn7k@@wjYXCh_W>Us72IPXt-QY&-o~D+UmE7i=zn?G
zNB^;5KE|DneL=P#^6}JydK}OB<1<$m>gdd%Id*5rp<2EqP_u^uHENID@>%=;T@<)?
z)CYS$p1HUm47_`65AdBh&FNDE_QY&8P#d2JU*kvCjsWj?uds{FJ^$>mb~q5jj`>=-
zzcQ1%mc6;mzGLB6`|7eZ*JRxMR4+Tv4fw=|zH?MRdOk$;1Ae~Eyzd+0C${XY4!%{k
ze01!dMW^-5iP^74U}J`tZ?6i<_sWcS1?(DY<5)KEbJX)|OZ05?zEV5ATWOU;rhJK+
zrUtByvFbf7c9p+9<1xmqyMG^>nwQe5t!1>oKG23_p}R4nYvegC^N=sqi3d>t1{GeQz{wT>CsyKbqRx
zxftE=8`=Ybn(29P-;QU}y(YG3`s}qPj(i}q^2xH+d!x3OPu}|uE9ZPdV_n-H7(@Q~
z?|p0`lbySQl|XYh(evIwF5Szo3dDxbYr#zc8`Xiidi|{k9&2)U*2GrxTp%Chflhb%
zZ-A(SB%8&aM1j-`%~Ft!@fZKK=R7p
z{Xw=C_}={fiVPP%pcCtNhR#_rNB5PPvrTQ5=7)yQ0=xD-(^~oN$sAwj*JsYI{}Q3r
zw2QMg+W4v2XM%rqnu`w}_T4q3xjpmlvv>EjuQto`*sP6uPMXbsKi~5l_kVFV|Dnvi
zGl*aP`K!a4*o+`cQyXH*7W~_T3xn3a^J!dL+5h}W?xQoVu4m2cd0ghBEvuQIJkXyq
z$)KCwM@@U;_q)kC-qy+}=RaicNcMUr$aGeo9K%MspPOXxkKc5hI`yZgXE(oIG11kJ
z=S_2U@af1T`||YSB{tAFkNLPDeB<2jWf|wYX7ew}oE-5zFv;|F%B6v`)0kW`joE%^
z8jJhEV9ZnL^=eJuobuOvH5hIBy?jn>o$va`%=UjX`y>6wC;G~BN8&qo>K{M#=M6m@
z*{kvOtl(+Ee@#q1D_$4$`Qm=)v+A0R_XHtZJlo_Oj~w$u-rcS1fo2Z!^*l^z_Xg(#
zdxL3d!NXs5_N%!!_&4hJZcaY^>=VP*+o<1~IHM(dBmL;qAUcgt@~g=^AMn08xH=F|
z^5mDV^*h6b40ZXtA?SVEXIjq+`741~8uN3EL2YHvix2ImumK%Ejq!dqV{$JW
zWMsH_$7)TkTS#N0dT*SpvAwaNTYbDEKjQjm3eb6`@ROdE
zsef&pGe0doeJ2Ff_q7?*N8b6t?}r9I9lj5v?YzG`dOxH4%rWT5K=qG?8qA0k?&yU<@>`2!6!%M
z`=ev<@%O&a%wx-+EH7ePSq|H=d`2seo|(qwJubYx3o0Yq57`ma?~#{`@;>xI@_PR*
z@5+PZmAmpD{~&pti}IfEAbER6)QG?Rxmm2_Y+GpP8e_SZd6pNkS6^gp&w{&nq;qac
z=Zv8{=@@kGYjh7=Lg$@B%=ZP_!)MQ#-v-v-r
z&Hu@4{tssJzn%Go(W9<3d9J-*JJDK~hjoKAcegl=w0DM9o}Ep!&i2KD)*O!XubtWP
zirM^ynaj02=*eKG{AuH}^5hufIda_;#Je&!?EU@9O!}^NOV*t$@|NwtDeJce?%he;
z;&<&|ocZa2_O9R+fxAI_XK-V1_SD-Gi`xRW@L`mP{?dScd}MD%PsWE+JLJ4K5J&kM
zpP}0_C+i6T-{_`Oo}7y>$Uv>18{l0Jw3puB9lfK)XGd^HaCJZ~{=YErXS#ULX`TGw
zWE;KK=={#Ck>#D#{VzX90&C74AJD%oxGH!|(C@w6oUwOp=Xf<>_tOK-9G|`GgG+KPT7~^bGWQRr}|$_`)Tz5c?g$R(#zXy86lw
z&w4dVpW0LlUlFK})j&MZiHX>KSwNpL+S`L=w2eo3S})>qta$yx7UH!MIhuM_o8reV
zH7MVmzanF{6CV`=SI8a4=|%pE|8w
zn%@Qm%^*D2*ywbCQpUY&~@t6UaDMO?QzP=?41H4|F7|(T>c202
zeHqukJ?mEo>^~upzxqUm#wYum`Sdf{uTN~PKYX!A=g$Xdo-y^?((|RX^?jrteg8;k
z#fmIrwl)qwk+C>DB5`oW#NoSx#^Dz-#`j~v7>BNpap0?1HV!9ctce4g-OFT*b|1<7
z%>f#9Hpa?)q-RIJK6kXA96U0Ekw)C!6wG7UHMC*}()*6U`F9RF&+w?tr#%SSH-^u%O}q{Uy-(aV)-De;d*%lMaZ=yT$eC0BnDk=k
zozD3{`^Eqb`RFVEw2aBOHp;s-bM$<}PmXh?cJMk!=sla&z1G?}oN?w&f>puhF!_aKwoxv$g4`SUXuYcWJa#}`d&=473i
zxqbGR=J#ixzxW)9oc#eF_#62?Z@LAKxxc?A7bDF-oYCAJ8Z|P~d}2o9?_7x4-wDLf
zx!MuP0sCwB6`^ys#8d0~1zA^jou8gL+dF@F=JL}xvHc-gGuQaQM)_|Z^(S^-
zXAI7w{?w^IZR*{*)*n0dXH5N$^cMzf*3_V}I&l8JI8M8V&yS(&={2^ngHK{|eqwlX
z`Z3RYvsPb9cShFcxqd{}>Tl^z%$j;=9O?LjeBZmi%1dcKnRRr0YfRDq>hyhbwDy_<
zdmqUjd&v<0pPXpN7+3y}PJ8Id8GU?z_Qt%~XZNK+ZPlAwx6fAd=FyrtxyIseUR&hT
zynZ}tn!D%G%d>rTX#VJFe*83-|4RZnCR0OKdDT;Uj#XEst3P_O*{`vm3}0`4NrLT+
zTpK0lq~9BeH;Ct*!PNm^~UD)1g3q=xt4|WgPPteC*foiJ{z+#~1N5w{8yfhzI+`fgE)D^0#Nh^#MCH@w_}(
z2`W=x-myO~>t_XO0KeK`<6S|n*Twm`EMu{)zK!}(me|nG$8FR2Nc#FFUvwP~*bAc{
z_Sw`NH237O-(1X%#hks?*dTv+HFDTqImc%VX*}kT{_TNAHq8ALA5HzpK{3XYO=7iKTu#lt7_bpNJ#6HcIo)%=!~##{X1Jhh
z9NFefof{axG-xdG0pG>v!RnTOJQoGpW;WFKF_*?bzh_hPQ=j>340FHL%}O9wawrbQ
zmj~5V`_u-A$?o8!;D&&`WHcVeP@Vdh2j3Z>rQ^mxevbs6t7}2)rSJ4vTF~=HI~brj
zF!jc0@w11WwV^pdV}D;jj?XQhn*MPC`<)T?Xn)f3<;Pv7)dw}nzVWPyiO(&r3Y;TN
z%y$KBZM+XpW4_M)-k-I`;8)@^-|1+qjrpq{(%d
z?g+H*U3~xa=ouuV_cdK&())`|mjyQj#%Qk$-Zah8_E{$H_*)Bd>Wqq0S{-
ze(3I)e;u!6JkQ%!Vtr}&v;#r&!4CDMUlwciBi3qZjPVmP*EW*1QH)1+Z!|7mKe4TT{1W?S??l{+9>e8QdPIC$Z2f1K*s7pYIFa
z5R_-MtFfH(y*%`E&3WjABZ2!AULKT|Z<_thWYT+M;LOP5Y9OcMIn4B^e&h3l$40q3
z(OIW!?u$L~*fs5^Tg2`_db0Ngbmvd`J>cuo^{i>0-~1zoP2yf&a>dwr=l3OndU7uu
zAE;YnHOnt!XTD$0Zp&ESw+Ht0J?G{pO>;WU_4e6qt~Y0cx!#;D=6dtmq&Kf!dh^<*
zH?Mtqb0Du{F)`O$>(|@*&KuWnOkCN`Hfv((-&F8TVd%~dIkdiW>eYq$?x|Nl=BEZ1PJOyX-Khcldjt6e&$0c}SY5DFJ%}}*
z@mOCA(Eji8_0-%iv2c#|1nONAgYyDsb6YTfMl_cApz$#lGx0kZr~xrGCv&dbnZk2X
zplxQu;b~tTR=+XOf2^;k=DOAPN}ygZ3&g?r@}RnEpV|O1QEw*&Hw5e@KYb57Qs}FL`-}(9ZT)sZy@BTmx
z_&k1%)Y!J(uFJlf6Q^B)oHmAd$!MI{GVc8*7v;6qeE)g<8cAHlLG0v)ug-|N)ztB7
zAa3h{rk2G^voC%p1cw8AV%Jz2!#p?tHqQrfCilVQrt-$z7|-*PYa#rBXZ4WBXc@obtU(4<-vf$!CD~+{-!S#W&L7p7k6_88+Wx);8
z810q8o2EJ1t$uz}o5|HGi>_P^5BQo$Z0w8A?SXn>n`Tcu)c6^}@c}>f1!Vi%WBjwH
z#;oJ@cS`xVKR^d}=lg5v7Jin_yRCW?=aKerPqgx3U(E5W1W%lJ=pA`}eB$Z*t$3E_
zC#Ua^lGSx~zJL0@sI^hnznWyBpZmv#=S_U}(D1cBJ!#mp#`lx5_5~A-`G1c5^5QS=
zhqEr0+XB6~=uet@HECX(PM+puTjvK_d{F!KXzYt=V}#ZoIePp0#=Uf>PV3IPeKn!)
z*9JSL`Oc|#AKF)kdj9Fpo%+Y8zc3(I+Y^wbsYP>f($wH;z*cfJKS%x4^p6YFBz^Lt
z9SA;Ke)jGS)CT>Y9llO7CRYsECr+Mo^58t27pw*L&DR5MeevJ>?QuSQt#xG}-afA;
zpZ$jeHuJ&QKEJOE=pwiG1YLbE&2V84JN5_c1b;V}oFf5V@liXPHL}@@PcEycI_S54
zeW144_Ryg5sh&|59yyU?JaqC+6SLCp%NT#(nctl;`ket9a%u;=J{|CZ40~)RgFXH}
zES+Sa;ge=84|v2|Js$|vTy5Hu@k%iIl<6WT?9uShNe-EEPHyG1h23c6h0o3||HvO>
zW~}WG8b3b+Zk?RfKt5g^v@X~u5B6RXJS`xfJ&y>SiHibF?AXO$@r&riX9U(fH@y4%
z8vojWPQKX_o93TPzN`i6?y`Wb^fV_vqrh+dj(}W$L;G-gXT_dcuOI4edq75g$#9{+
z^w(rAUTEnjlMJ~UdG5_z)1MRU4cGzA(N<%rPT4Hio5jq%BxYw$v}_V5@u9P^6MwSo
ziD`S!&K&{Y*me!qQ;w9hOdBLuLtzsi5Y#w8s
z=>uw*y>h
z&Yn7ux61>~nz&h~zy1D<*(K)RJe@J}+-sTsFL&iwcVviZ<1DVL0eRNRFkW^y&g%{x
zfAAm--=-rrXPw0+-{Lv(VpD_9Bm#fHm<
z@iIB;@6!|Q<>|**@c&5A^Gr9nbXTr%?MKUB^VZ1rjL!=A!%p(qI@U#|i@2lJ=#{(H
zxVm2n9u?T**DZmw?yeJGcBm2KQv>`j3;Yf@<9mWX2pTJL$Yrl)|Gx!nU?2NGG>uo&
z_w3p0IYQ%S6Ui6bk?wHjY=R?!8g8u3=Vygoct)8AGndb(IO_YJjM;EQAm8%PwG0<_
zyf!_(&ke>swIy!H2Yr8}S7SfBte0nB#@c_G?$XYGW14$^-5xk|XT(VHzAMIElU}^e
z4)~*PJzLn+n)Tcp`OjR!e@bXJ;%7I#JHkiTN}$~v%pE(R|M*hBuUf!bON$}6WA
z1)4G6#r?bEJHF1pbrzei%^aUvIw{y6;L~34dw=}9)YL8+?7na&V>R!Hb3v~1NwZ9X+T%l63o;pyj@
zN8j(A2U@+oxn1UJN$=|={bQzH
z9nv9IPn~pB=LMg6U|b(Lo1ZY7|L*MXHGFXTdkwXRT=Ds)iEfO~wNreWGjwlWLif&z
zZp@#*12NCvw@q~J?CSmd`H-b^HTi9s&-wn&#K&gw*1KoOP^(W5Pxl(9olDj}6FG8K
znqSVm@^((^eEdMx*?>;_fy~Kg=h)BlCy%WGcTjE8pFYjcoch(Nr`P_Irr!Nw?tapr
zGxcmSf85l!W-9NrY2C92-5FC~J?=g0Pn-H@Ouakb`g&lDPjly}1@x;4iu>%7xiHzY
zHxMWJk_S3Y4(<#*@7(3~-P!V^iMzU93rgd8K`z?EfjV>Vp@q8wI?fAr2PX!je*C57
zH~H*2D{vRf!AMUJJIC7bJIUyU>!w~!hyy=rGrl8%v)ny8s|$~IAn;794E8lXWO$bG
z|M7uF7FslVbzqI{dOq(9*z%#+Ng@lDbL08cP)u7z1WDYhKFC~a!L1f!KZ_h0%wW5+Kt9}
z*5l=?obL$40ll@6o_(d4D|Wm)Ab&@I54~L12QrM&>T`R>+Z_^0Xx}o@{|XBVnA2zM+5e54frQU%l7&4D+5i2NAFJj{HMF;
zhi_{EeQIT2p!s*hr9qEII}(g^zcA1_M>_*ClhbT1-U}Mro3lorS`zE7lWDzkd+NG*
zFupKQ*BbxDarD16$j3Va^@T><8m|l&xsa3UIwNDbd2@ir9jsZWPp%pt`($b2h=vY2
z#mE|3bod?`R8H$&obB^b!?VbL`t?9FAJ4?unQss15~ukdf1F>w(%JZ%J5%`iXwKF-
z|2&rH_;WB=4cJU(W5q{nd|>}|fqk;shtHaQYt3Wjppny_C34v?KNo!Vdvgw_KN8Tv
z7jnkj-;lYy@O@mzH`c0ud(0-_-&p~@@;v9G3()Nj#BWYxZ(kr@?$OHT?w316p@{{*8$WaQwLaxTvo7!Rx>5(4yoe{A>@=4*y2%%-%Fv5L>!h{Brm*OK^u=Tu8#!WX?9h{u>4u{a#e^Rn5!
zu|M=0|KyAQ`Y7hsHF;zy>FLNzlZXW&FnT^i%nW5u@*z%#dx+r4}pWMpJjzAnv
z3*EYRX(2f4oIMhB49`$a7}6L{_n)D1ta^NTHNLQk*rD*u`_wATglQQF=c
zkIR~7UA@oib4S*+W7TKhAuDHIpX}4f;fuJim7RYQbt>k68g=U3#@Q6R`CTIx@+zkC
zygy(Q|KBsKTWj+g!E-QJ4eYlroG-PY4qJcX?fsxS&&pVQ*)_^lGuFwvGf+$3=d{{M
zexC=e)iFovi(mHUJoKL#sJR;gHlp!d*N^7|f9<_4WA(|eu3evTzXqc}AzOSNxREU*
z&3U1(ooY=zXqN_Tr$;T)D;DP6Gd~!NHpxZvz&_{B{7Aq@y>)fIGawJ%8i?g<0{)`q
zQ)97zT9=b=ihug*sy}42NnZGIPoSL|G@s&I`&*CvyFO4C7X-^__=$#1J{vkWpo1^s
z#7DV2Gf;#4V-J~ny5x;NI|BA=wPCc0oYAJ0%*kL^zouyXHsT-c?XwKep+Ic=^(Q;J
z&c5bB-mG5|G`{pdH>fKS4&N}XUy)vn_5@_UI=DHIE42A|{Jz&sV=;Yw
zfR+r;B{rZfj~YRb4!`(_i=2q}*@3mgf!boD__badL;maz*w(X8Ka>{#oq^g!M<(0I
z*Tigohc`a#)A+vzn!a}
z=H6K&@3uf4^?qRglY^Zh?3v~BdZ4{Dpo0x?Yv69n(fMEQO!i+J;HQHfK
z)f(H3?+DzB{hk6p)kOW2Tc}@T;_Lj;)4q5v^OJ10h*x>UhD<(8e)^_
z;xi!j;Xe|v-+K~zYh;XgMdp7k2J=g7>K7l#-xc}d1#D@&_;X!w@5C!!bKbL$!TSxH
z@a{ea@7FKkWdob{Ea9~$4z0Tb)3~*Bedad?;vi1^ua7rP>vB{d$wMQ?Zw<&6cda=S
zv$q5<4(x9W@U@mRT;z*BddYuOK<|}-^I)AGZPc|rbI(roK;NZ-yy9igs8dYNiQ-Z3
zYSy%u1%EvXs%PI~^&t=OGnY4KEMC^w;NNhL^By~Kr$>^nQ?xgBj<$vU88&-MWSfk6J%k$L0Q^NyB1
zrEMLwX5`GCxT%jZzK!!*)(;1r^U<2twf4@@MT?#L{W&XR{*X_Pec&e>$lVjDp)vl}
z#qC(2m(4E?(el6G?<*y0e5`0Ziz2YI3WbmInYX<_d%*i`1;B#1y
zuAPxF8or3hMsjMON|sa4ZgS{oyv3(FGF*(wS7-Ff(|Vw>3B7%>rC&_7+FrTN`(|?8
zCEpQa)X!?bA9286`zi~KbD*A_$NJk?H3v`39y$8WknM#ow0O6r!i_frzwM9puGZNi
zPqkfd&Neae?&VC1yRmxHjJE~k*>`>(79#TSkwYIkYvq?0Jl626O+1YooUE{%T@vtTyzZu~9^AwM**2h;*zRlyo-^OEJAK&`tFdlP%;=dbIqqjv(bSA)?8HRk?gL;2Y?^52v>eYXbMTEOqQOf|-@%0$D~`JHc$
z&Yj19`p}K>&2%wG=RQP-{+wWMfL=V0Yypi)?>}`w*GA9eAByn*Hz0pczz;TVwKmvB
zCmrmkkNyAWnfzz}8KidQ&+}EiX~y$s@}(hC6KZ3t&*bYTo?e-7iZ)%y5Ae0{L>@oy%c{~hb&JsZShv-t&r4q;jn7NxYOEPL`WzW$S|_u6%#&Kj!>k3Pr8_Ymu9V%;Fk*Ta_ty8`b~+I;^|);8N$
zPn+$_XZPptL27~x-p!l~y7vWa@$Y%;k87XET5Ga&AITcuN4kHRHS*B}(OLedx9iQ9<`yvcI
ztOaboB6xJ*GvfW(CuhEYTGkE+WY70}kISAjGT-B8U>Dh9OE$XB=@pX`g2Msd@X3dH{cB9JwAe>CuJwLwJmrB*>-1G7d1`62yY+J*
z>*6-X7hhw|r+!UBCRyT6&&LyYaoQ;ECuL6~@6W64@+4LofB3HDTh;gRtNA!JWBDD|
zGF{B^h<*Nv>wV&|SuWJKc#11o<#kWZ>sozl%i_CiO>J%DPyQM31NU>lp*Mo(?4
zZ{xd=+V}23&W=F7_XnPV&kWWBaT;^)oOG>qKd$xMk~Lpv*RpkVUB5Bo^?*+C8Q0a;
ze4Ss10%!T)w2wx7*dhjv1-sRVnBqGS+!Cw@_~}~_MSGjCD95kj~#|!-T{AUZ=0|8y05#}!pW=W3|))|>N-r}XSTE07=SV~jIhp_Q*5VMw$beJ8!)Q)Byg*uQHFD)|wkKtcfYvYE?bR>u4)E>_oE`
zXuS*Zvx$9O6Dw;P9pw4GUH3CQ`VM1Eer=IEEkAm;xTng~ShJxvR_3``yD+HV86K?x
z?@YA~-NAruqnu11V8gNIV{Fb0v3%EV|CZ{cVeY+aoclLUY72VT?Z{Y-s3UeYo>yc{
zwl>y*b$5j(XCwV7i`74lyXmEYGcFF71af&O_zQt}sM`Yp-L2R0tm2g;x%jEzxPZQ-dVbBT2r6)ymz9nANBilStIxK;KG29
z+MYl>wDC+Wn>XKb^yc8|KuxkuO^Ctc6NBbZ9OP(i+IzwfAM0la;{N2|iP>XIx<%WH
zuJb~?k*+6gqU%csT^rp8=fsM=0pFl`<>zWZuQR14?C+a;@B7^o8}0LPJ{z0St{Wm-
zJ&600M<)Icw}D
zd#sVqm+Xi=8h^EUegyaYG)|q7u^q
zYCNrN6f<-;478OSHx`XeY+;jlzca9h&t3MEOz2q&H1@wWa9@_@sRIq3rw#Mbb}_gq
zDE|{Owl>;M{uKe)_M8u6>&Eh3{u47UjrA7>rw07JIS|kCzkZnG>p3Oc^Qt*?M%I?h
z#isdk2FPgqM<26%)Xru5jlo+&Cx+x&>)ld&%*BN+HL#hi#)I!$d~_(XtK5NLH-&udGQQi
zCNs-N>6h)ZTTRv{@vv4q=vl^><)d;(J1R#!owXx@SRM*44z%V)p5&L#Wje}F78$!I
z+Qu};Y|-R&9*^3gCNwnUyfz@~V6Ylk!wc&Hnbt;I#m7E-*|0reuREc(h?z!@e2g*m
zE~;&2r`qA~&B12zayIFzp4JGvYKnW+Gci=%~tt5GNE5jj=i%n
zk0bfbxih%TzGLN_y=cUj{Eh13$=SOg$)xlA;OQA(oL)13#<2IyVQ-Yl#^yI9i@5U}
zjrt+`z|=Qp>ZG}84X$QwWm?Dk+F-0fcP^|4{3D~EaT$;ETQi5AA$#@9nz(rXIVotp
zvQw-_f9TO__hx7Kme9%Pye{!HpZ1sKGs~OmAVWT16MQ!E@sfdeE$EzI-V1jHV&6RS
z`-b4b^4u66KFS}^w>xlmjj~^z`LSqTwFMeB9!m~iox#oQ;jfzTd{;M`I9WRuU*8FQ
zow*t`W@l$C7Ng(vl%D*p(tk~8Pue0qdwVW6vi+f+I}I>T}=Fajw9xspO!Is
zo%=q<$}krz^>Jb_>dbUur+s#^87~`*$z_KzoxYB4j>%i*13Bca1#C2z8@a=~Ouu)d
zW%9DT(5?2C?N`2-Y$Ri(*+@?F$L?izl3{N>(6;K6Gl7=;TLSe!j{II6Xq6>inpm?F
zuU=CZtwAwd4b%e~^{2H)nlF0P8J+ZRzL!mVl0(fkrQVT&7Ds^;u+_e
z9+lm9UHexA^wsWHXUtcA(YHGo>s}1C+DVo;jk3DGkxyb=8hTzE&~-473;OZGdax3p
zyExF)PHFhd#_fT|uDRZRE<4h=YuG%`9bG-+dgTmu6eWFAl`9&jRn5joYmmkM$s*mj!GhqrM-XF&|C}_66Dx
zYxJ_2zCQ_F_b$uILFMly!Nq|lA8<<$HTSKj*D6CE
z&JM(2tdHX|7wf*?jd8Rtm%9VGEgxC<#=3AP^y^UL(JnIR9%bMMHj}d!Xsw;bKpx~;
z8*38}-a7*{{La%=C@z@BwYEH|3h&)P^nedcUvZK`R$UKjj!fKIOHx4s@|
z^soWHb$0QW{p*2N8g|XsADXq=WDGq^Z1H*KGlFLa*9W%;?+v~_I6q4Lj)0#EKFWZ!
zLqY4p8CebZ!hY{V+JV5D{-j`kFtI=6hf`n1_Ie*|&)C<}mj?2DTfnxpslO~eAH|1{
z^*6&sOlyxgv4_rmf%eVQxv{5>_AjINJ9?XU^aq2=pZhD;TKz@KZ+A%F<<&0#_}u#B
zqsCu*ziJfBZH)vkOt
zhT>q&ndP^2b!%P!`HaJ6{vM95Jpo_mb;#c4OD&8xn;!}`s!6n3YjEDnai1~WbC>N8
z3q_?j=Rs&yS*z-AqULE%94z-9*Oy&Dsfky6=gNwpIC%?q}{9rw67pK>n
zgZUW{8>s*IE)HMm>8-qH&EzdRFNZ@f=G%ghKj7>iE9Pv#$IsS?Iua*#+Y=`-WEXn2
zi;0}w9oTdJ#IE~dRC(6P6Jxb=V?ak^enZCi4+iXo^+0Pq@ayb=|HcObHme!^oQ|H-
z;b|Pad-BH```xi?0a~`R742N!wybGrJU{IJRKSnQQ-khdjeT^CcAE2(jMkO;71LZC
z*@K77(u%iwD6P4C(|vdvvtJX#+Aap8ZSH8TwxMN*`IuY&H+S-=-4*1Ky!baa@6C86
z5Uc8MywUevakR6(?V5PcNxwI+4)RDZo8+Z7vWq-9LO0rZ+cXzHy1GB+wESvE4(EEE
zy#omz-S~C~;#xX!J(hiP&OR|AV>P%Tpqp*-PKMYtr*yFY)?lm)Hp<_*0a|kH<0Z>o
zj#mvCTQ{z}(uv2Mu5pw%bnF%v^6M`<-E9Y_m|U0f%~@32^w}4ymj!-~cpf)(DQ1;t
zj7OcZlU@8aZ{EYvJJH0fO&mMQK_0i_aua8Hv{}(3U
z5xd=i_{wu_)sJ(r(eR9S2A?+4c_@42;K8pxDt|7|y!R0M;DSv98`Y
zKhk|V?+;>L8ZrNwteu>`{^Pa&9a*;~KGpNOtdU2?JZ@+!$GJE6Zh==^-;m#PiPt(i
z^{_wS6MO$@e&{aUVtusnQ3J1>)W$!WekUe5&QRBXd-|Q0T_gXe2ij8y+7}J$K8vl4
zbEkEFlJ9F$d+hv=`2poIuAj)fKAo0*^v+A^|5o;`&G*Flt3UfylFRR%(_Z8E)M0OB+FQ*UzNZa)KaopwjMw{T^Y705($d9U+uX|joEkpwCA~F@1mf4Uy!}ghWql5JJ39CqP=*a{do4qy8P+c{GZO|KQNnr
z&usq9nbY;GNe3U_ku~;MUz^tX@QP`j-RLf#$+|G}le6CX!Q&sQjQ0L&zQH>B`r*vS
z{eO}9c#o6ucPE}vuD^pym-Ev&-aPTLyJrsnRZIAvm9GynX*J}@_bFLN<&JoT-Mo=fj5Z=La7Kk?P>%QF`f
z2Vu`G@((w&VPF
zXY=36ym2E#9sSab=BFkaHbCjVG3#Tj4rY(t)=r-KagD9^#x?PsugTwhO`NP$R
zE7Dg^pHt3Z*VH|EhlaI2FVuMHyc?h!V{p!rwY}5YSXXKk@3^*q$(nOGr+eJA=4;8?
z^7tidPgt_{#3gIzEm?cgw03d&>iE)WZLEVQFIn@o37bbc?+EiX_l&i-1=Zo5z}j8I
z+6B|vJBGEVPiyxKYtNY0-Z`v2b6OjDy${eauHBNk_#ZdnqWnWn&#qeow6{VbFHkId%ZmO0)_1N~P7c->()PJ5MW56zpW{w-7g)l>iVQ~xdL$=DVg9~loz
z-+SwhjL9g^yQcZqOg&!v-!b+7XzG73eSIhI>G540diT|qyC?d0PyKtQ{#&R1JE#61
zPyG+2ALTwQUssXKe*ORRI}eQC-<-|AA#=W!{+`U)$A{-m>tgxFte?DO{pPIqYd`v~
zp7<;88JUwM&wBTQ-hHTdzR(^YJaXc-{v*>m-T(cQ_sgh$_XryIr~bu3Wqc&Gwg1Pa
zbuxZTr>DO6=!d8IU!MA3n9cv~G;bV#ahg}}$ESJq)-TT(c7AN?EB_PI
zyz+i+npfV>PxHSv^&g%3Z6Pp
zG;bdLPDyfpcG^FCn*Y)?-!aYq-8A1h&3|P^|L>>yIkWwXr}?;lVQ9ZG&>k6lFnC&U
z$wTkIs~>(^CTU+Bc-9{utOh3sUHigm?ZxS@4!px@-gEM?!{WK{o{aH+QJ~q&N1cm3
z^%T<7g=zLC}Gw0qT6CIl`3HV@sUa%`z2}*ZP
z#(M+%K;Odxws*cGWA7>E_P!u^QgC*_4$Xaxrt+lMvC+E(yR9)gntJk{M
zSbGlqY2~8N;^x}9JwCX4I=9BPWh2_B4zwYE(6z4)ogZhKzGXFke4-_Orv{$sYM!m?
z_bGw8my62+&uO*)(%==rO~GwJYu>$(Z`0q`J7lZt^sNLR8t$~M@;+Eye^%+$LTg{%
z)QueUj(D)~7;}xc_wKw7D%ZW*yY|G4=lpE?)1+zLx<8lMa%2nko*$Y^s@MXar!FL6p3bsZ6V*|f)%fG96Tkwa$@i`bL
z2W!FM;O&9K{K(*};9zh#OXIu1fz0Jgj6DCmU#$gEvzW{8YS24V&&HhrzV$#Ob9{b{
zGJE%at}=V)y939#iSOqMzKg|1a>lRCUmH5@V8Bm&Y$8M6#mjuzJ~{h>r0XHK=MM88
z==`n+WRbBg;H#WGBCxJU3mtpkJu5&@u2x&bhZcI)7Nb9YW|CbxJ)N~njt<1G+Ceuv
z{$fC{{Oh*|*7^*sp3;oAS+n2#9ZUaX{si<#{UXkCGWYj)^Wn|h-^N)UJ@fcrJo+UT
z;zeeCBFFPlj_v*Y64{O6N!f2)jYrvP0{-!FSR|ERVGHy-UV~-qs
zf9#P{boSAi^Ra%?SAX^9qiyK^By9W2!8X4BS+ecfgKgsRXUVqH2HVue=VDvyN}Z_>
z_lSB@FLShJ)rRp(pkCRaUe#UCTWd}|$t@UL?-?*2>kR)^WU9x{w@fxY7@5w){2q98
z*7gPVzCV8xUi{pf{B);2n0r88@bxp*p7*P>=KdEa`)och*d17Za&TD=KHbL$yMjKa
zM|lK+al#U+uHII`}j9eJ<-*ylRD9_OOAkdj7D-GnqZc?pE^nYtA-%
z>hC21-QHQmr*|V+c&-Uv7@QWMqX*5o0UrAL*|c%}LQ5C_>3U>fk1Tc=-y2weXrOlJ
z*NfB6fV}lU+Y>ZypAX;F5;O)+$(TRZ8UyhagZll5jM;E38hn-E-H`w0*7ZL=YS3Onl3o{<`
zD_-EfXL1*CG6Wie#G`0WnJ|7>)=G<gISlG&FIH_%^jkR=S56ACu^gxb=-T^B|d6h{fMXYF~+N3Ba1Pg@tqdz2%H1-
z_^pc}dE|@tdLYht$sWgQNFL}~4>Wner=b^Tb3UP4W;2`E0BDZ{^>4IO4o4f=RGyA&
z)4VqLC;zoWebLKCG9MGH1>$c_zmY6;P8J#T^nHPSV#kNZeaf3S$SUe=4VAsoD=K~$XyA+QIV!M(?Bcj={5&n9QhbIaK%kJtkGWjtiz=^0TUbnFYX{Ijyf-_rZC2suCV7p513
z<^lg&VDGBz&DYsTzT9Y)U;9Q~`DZ_ipW`I!>Os$~nX{dbbNOgrw29uW#NyOR_85!W
z7txDWz49&2Yxgf7eFmMB`9|;ma*zI+z&qWe19??%l`H=0pzr_o#m0Ft7DxV%&&ZX`
z(cC+&vlXrLzbj}?`GudX)`)!6M=}82SR;)~c|O-zRu5a~X}m|drMY^dF=sb=@e(5t
z)79X-;OwBjsxNUEeLF34I-M2q!6#ShSR6d#@axU_>&*Av;F^r(&G%99vxDtpzW6Za
z=8DYOj&`FQmxsONuLs_H&JD%PD@%11NWw3hiwAb!rti^I@&1U4P(T)iap
zwVl7@kw0JSJX=d^lnt#>F=?FI^IhCEF&}Bf+jEt-F=r8fGk)7s2YlKdjCIic=2R~}
zrD=VT31TGP_?+ea0Xwv7axdxaL!T*?EjH?FU%-x6PWPBtsUnkes`
znCT+6zF+J)v>MzLkaJz|%B&l!L%$2)uJrln?Y^7Sv#U83@1248I5+EoMo;7He6d4o
ztn7IYwA^FSK}eKwMA^$jgNeFm9o08
zcPl^C0srccF*H8=GiHjle;!`4=oSa#1A#cJ6S-as$gK@?KOZ&QZ@gO5%_G}^oJ#`w
z$8|ka>w`6RNo_&0zuX5-aW#L2rq(BVi
z5iMJwv}hU=V>W7Ha&5py4L!cvye(rk^JQnCw&r?jQ)xG|X&LS4qZrk0@b
zS0L7XwjIj2`SHB@aA@V~y@6b!RUg*ail6MR?a7$!TakBa=)6y9bp6bri%fWA@X)}0
z?AbWZjWxXa^$17pWaFGyp30ly1MFw7#wYfR%{;cPC$f9?-Zjy`F}-GfLGV12GvOu!=k%SoFWs)_5|`rw_FOreUy`|a^bXiJ&HY}|
zBN>YeS;p$rSR9ReR>iCD=3?UAxb-Za&H)}x44)9lgQiC3x~~d9y`xTJw4;7^G8^P~
zXP|zz5B)~AkgeSvG}q?u4A{zMZGHx<$uS$)0&_p{wzkyualt)-rZ%*mD|Vx)4D-tF
z8Xv8Br^8Pk8|1a}#1e1yq5*pF^0(t#GIl0k7pP4>%86Ea@6PzXK#tj`_n!5#Ovd*t
zF=r=R=-2w5TN}GxJ+BB&<10UY_Z9o;(b#fvFw*?wKyzdE)DNF-3(8yH$$|RI_Kx|^
z4!+OVZzxo
znpobOIPuS2vuy$!3(sz2_W@mK8^7_6aF*?>@9vwQG|V$x)b%UV*Y@qxer?8U+}s#L
zYa8EcAQ#YeG2IoNV8@#S
zJp7?!Jm=do7jw3eM;|@a$#&kv(G$=W}`2*gN_&
zw|6D`W1N~hX9~#S>;3>8`fp0zb#GVZbdP+QF79%1y(*v+ePgCBSA*v1aK=5el{-Fb
zGtk}{ToCy8s~Q?-d|9rS*~7=J*n^H-b;n2bwL2hF
zW7iV`|Nd7Kt7Z9HW`jIz#fFh?jLF^Me{sMz&HO6^=c0DAWtrXXkgeLu=dIX@PW|C$p&Zn4;=k@v1TpH~^JJ7`R
z-$hR8yMHk2#@=c8yiwiZ*WAr~>G`}gR6Uk#?E?Xter|
zhOK)7K55O*R%*Sqxmk|*>5g6v8tcZ>nL9gB3ysIFjIDpZ?^`x3J709I1RKS;cCmk?
z8{_Nj_)I|_-V^Ky#8F#zuEdRAemiH*ia5xhT2MpkL|(MJ1HZp@ex`P0UH-l(SazP&
zu~^UR+FjNh@S|~Y2Glb@$TQ}LdFgAb`eKV@_CVYVW7#Cze&U2
z_XhOu3$%9yJA!!*E=U680FSted230IcLw(6wyS~C;aLrqy)QgD>({3s+!b=6M#P?N
zj?pSw0nZf0?%i3e*cEX#;x25Y@&NBzMUC5b;ZY*
z4?c>Qny!yKGUlUo_G<1Dx;D~-#`)=4D;+tj0a^0>bHlk+XQu?({M_!yT4Neh7qMag
zcwQeh&4ozvsPku^4m2NA}BY?=N!c$5YyQTsEt%ur1-p2)E
zRogDgSQ~4wykng=KYXJ@U%GjnXKN9sv(wLM$2^hw{NOQxX8yWByvrv>^Lvi1VhW9)
z@oj}W`ll^71%lsottAC9@8FXvCkGFCb)d87!H?r|?_WB-D
zS}}6=)T`XkRk~dn%eO|ZbGq!=WA8{X-q-lHVu$q`x=|ziTM5ny_D9t>v4!*uD=;ZNXK+(}HV*F$Qd04bU~O*JbSc^WtickDe>WcLbgh@**ESi}u)jAZW}tq6^7_
zPfVRhJk1H)b_RUBENI=woJ9@u&Db5;JBUsE^O@G+^my!PWbX;oVdH5JT4Q3c7O0nd
z0u6m>)-9xwgLWmTy^Y^kf5zg$e{#@^?|Pt-BYxW5!Q%qD(TRt;=v}d%u{QFQrZ$W*
z<5O!19lzw!x>`0jzAa#r-drBH2iBJ9w%7QHKa4W*nX~EafPW)>rblBdW*VQwn5_EJ
zc#_w(F`o9(;}tJW3=ait)XZNMETa`$c8U#DM`I{P>^J|@vR_Tlzh}gDvEgU^5C^u)
zCv0TEuEw1I^4GQT9-gn0H>Yn5=d}Eo)6(CyG2X2&KCT6=
zuTl1#zVV=UHE^cX!V`j?XL5RnS8tXUXHIQY#)%p448}Ww{aSOfl5y$n(J4n=+o*2Y
zr@bpU9LR&lR_Bqe+C9Nn2K@JKuq&XaH8AR`y?jH%x5^>+#esJfjow!VVsR{a%@0{<
z@iYfrJC;5Ctv&Oc;U#a(vG}3KH>YoG?KQ{F&(G)Xm#g;%4-M@1*&%jxXfF!n4d`|U
zs5P;i$8&eq_&CZrDf45|+aK?z`T0II`_8Xs@4Y~rX!x^)SeK!o_
z3>UJ-JE*xWkC>LnSeyGrt{T~hr@0h+GVTd9HhSNBWfs-ju0a0KEz7rax*B-C%Acl(
z(v!J!T5FzrHsrN=w0C}RIJ!MI$De&uGi)KNw)0V|?fliml~49-gFSXSGhN&0PT;Gi
zhUu+;eASlKC;zPT;k@ANK;GDJcW`~c26l~i)_Bit&)!aQvsl@a=NrP@JmV*?@sW4Fi^IIWkyxt&7I5e&Yr4
zWgpqzyMHcdzK=!w4<7`r-}70yVLKWVey;{}e?@?XUB}Y>YZGlk^Z?pSAMieKLFV9|
z*b$r?kl&nCzj(iTiZ>c@78CdDW;{1;z_TNK8|gW+0Z;GZWwzb40gt*{rbi9+>nLMq
zMsp?(2WsuQz}G_d_65!pS#r>`uTFCm?z<_yv!EVt4ORkojWemC`~KlMwIg%&UZ2GA
znStgxwK~BabS$U^G|uOo_VG*B(6}?^wC2ue*V!=I=iH8S&mysE-QF;aUp0(hJ&bS6
zSnSF}-_6OL`jUtBKznI`_JjbfxNFOD|C;bSr}EXmIcHAxEwjC=vL+{^t)mawTG;a1
z@NIOr$St1U4VPxzbJCir&2qChU_apL+2M;=ledgcOm3aou{&#G!nfP9R~Z>D)?PPT
z%ksjX*U#jvWqsr=-5a(@cl#FT$X_QoO+H5-Uy`|4oEjVmyc3D{)qy%@-!(z&#GZRb
z?(q3s2koPRn6fx~7p2#nL%MecVog3C?+ELGw!Zl9{ri_qW4d~-@154UolF0E
zw>64tJ%`uJruzY*cH;ZwbU(4AFEQ4V~)V{Z*c~XH2$MTky#rd1R6C
zlt5nDq(;u1#*a>aB&d9OY;3Tpg+279&IVoW!=*2vRpk66_vd-&PYH8xx0N9C{ut+-qfkgbs~
z*78EebAn|$D|>tPcLii?ne)wD^Rw0C{Lb0@`q})7+5F&a?sveB@*Y2%KXNvISmx@u_Wel>ck7ap1@E3kB5Ks
z<2y1JgZkXKskQ37DKxER@w7)Sy<}oXaP7dyoE
zF^SVSKRI(gcmEIn=L75ccQS9B@&88V&9(W*G8a4i+J`bHzxj+A5BWgW_=Zm0@WCg4
ztQPF+?YlEz=YP2Gz6*n^g6)})cD!$r$rg7U*<_&6k2U}LnT=mE@zzGR{9t}b
z#2AORTtg+KNxq8nt{pmq@zi0OMhVRWBpW3)1Nn!U|Fy_wRMJ~--LZkNQG?x!F
zZw-wYqM=`o^yZDx!zcR2Ei4cDqx>CVbFspYr#{J>`8fd@o{8_6{_b#NO~#iGYvrl_
zle14ob3w+_LvO9;c~8dVlXXJ&(2jbo`#Z&zZLjn{mUZ^l2YcsE`||dx?3W&oynVsM
zW4*OH+G(B7`X>hX*!`S*(9gEo(VXwi+DPkJ|B?KmkjAmH#SC5f$u(!M{!0UE+kzXX
zzxDd~X^q`4oYtN&tbJnkcTNA+Z2n!D*N*chKJk3bjP8nou6CeX%R1Y{LI0$w_xxb1
zyWxN2@13e;zqgsMtAY8Qnahj0^<_17LDtE2kCG?O&yPGdH(u5G%!x)`KlNYkzbi|_
z=1~rsJ3?cP4f>}~eRZ+@n?7|v&77a_*Gzl8_wkXl9@O{W&fn*==6PsMo<5kh@htz)
zY<}-F-yd2wXs^%x`|Y`lUhM%U|Ef
zfX++rnQ2{a^w$Rmr}4|vdtNsNubAfLedRQ7?ha4$J|AzG=Di1BHO)^=PuHubd7rB{
zPV@SFWSXlL^fyiO+I;ggw+F8Y)TVPN=h`^NCyw6R?n7@cb?Td
z1F?Qdz%T2M4Vm8qSjjXr51O=
z)+#PlQET0ZqE@X|MMY};*Z=)_=G?={&*z;aYI|v~p6j~jd%kD+?&th|&%4bT!O?-7
zvA^r_^83o*%79PXf;R`hmyW&~xFgWNW$@>RI@4_H{F&*W6|i3;PpxSC1G>b=dT}Ao
zXZzR1Fz2Z2*}2tv`FmXisIji6Z>#k?$DH~CdRoh3e|Eqgx$(PJo1x;tH}=X$bFs`7
zIko4)^j{yt)vfxzHA2<w+Zs5M6VcNZhM2Qivs!~P#y#74ZFDKgcT7;5%i
z9(1fV!5*=Sm{nbit@u1T8})As{wioak*h}7qnZC;pq}VbzdtkjyF;y|!<-t^x8@Vl
zA^+0Ax|avX1}6vd%nx}~8*=!DthcY<|KF89{~MFj(zi#Q%<>O}S2Of#;y_=0Ge!>k
z#HQ=W6$f7*y(#oyz-O{=47LTQ2jZfwlPf09(XGSwb1Y0_kNw&|gdR4~b6fPxK8Pcm
zXFs;`q4gjR@a90<9^l=1eB2YLT`?2u>g$?oGUjX0w}qY?h=DoxQ)+DWymm*)7a1Da
zvyGK$Zngt|Bs=KQtXXG=x!Df)2RoXJ&h-v$E%5v7fP7=$9;uMOtKPz{N`P6|FfChkO}s^*7Hdqi3J&7X|BLZf+yc)UvwK++%M_kTx)B^PD=rI`Ev*
z=ze>2v;S>@_Y^UnpVRU+^E<+8YUXi)y4Vb==h~^iFMaJdqhqc+KD{~+54PCP_ns$f
z8!!6Eoab){|ER!w3%zmoaP6^24Zk^q?shuF-}wH(7@c&zI56M4?e^^PED;Y)ZLmX3
zKR0vBnw#UYEoxEQnl=A?T7$nMJe`&8tUEi`1$zQ=
zI{&~ic15UIT61c!Zq1b$mjjKSFC2Q@YiuXGIXxb0*(4oyo_9uMb_jJfjz6&0LF*2(R55oE$9I(?74@7hWU(
ztYAAP?Y4k^Idm@MTC+}nCnk-}?;AEhGkteP!FHJW_GcU9vV6LS>+sI>t#ACUOW)aT
zo!*(gdAZb<atj^6Kt9Ca}Msr&^!(
zofMGKy|YglUd_uB-@Mz{D}VO(nSp;!;11K)$+Vtba)S0fgN^uu!NUS^aVM@DJ2T_z
zz}yLe`=&n0r5w~JHqSm8*XU?$$WcS+Rni934C~Ad9{D`o^yI`@Y8>
z`(G5ibegZcyR&_kKkL0VvgB6Y=zUG#4*Ix2PRK?1xr_&U?5nM6j~?SU2jt{SP^-_M
z&Zb;xtyi^R@4A}3A>(@jwk`E$Xl1KCqA6^@{clkkvHQ-&-y-B`%p02$C-5q;y`s}DL)^$wnJTC&t=8yPQuA25tubj%h
zIAa=H)WznSzM7i-WAp4&`}OOj%+G7)7|ebC;+HnfWA*Jw{;Dtf_`qk)9k)9Wi>Cxy
z?Ns-#3Dgu_4-fuDHX0YFIo^$v*!JfoADzB-Bza$QFXWwmNZet0FAl%7?@J@k_&u>t
zJha-kPTrT@LwRB~~LezcZnA|C~Si
zd+*HpAC+o6F3fAj+0t=mL^Do@aXQpVbvQ40zJL7a?+;a1d|{`Y
zm?uyDeR=ZX{edl-ed_nZ;43ocjGPnnovbx)4_##Z%dDe=TxZ=ly=2bvzVaT*`>HkT
z?jKo|pXs&o-@azwI(xr*%{uX+VXQ$=uQ>waFJXoe-~DYex>2ch!6r=~ajC$VTG_
zgROM*F1;sr)z?Oz^Ky6c*eq{aeZDt$RrmKClLgK3e7E)7H%4!wG|gFaAF=hMKn>0@
z7C-lc)_K%DuqO~>do=GedHq=ZP3}|EudausKl9a1?g>HtNcZqNvv;n_r%PMP*-BsK
zADcb(t?zJsPnrEPr)H|}?);%woW*P_xy^|fK+opc>AUCPs}idp4E&CxI{dmU?AI}R
zKE(*c=$Jq(S}XNm&5CdBuK&y2l5?conxErddDYX;9sJQ62lXa5rv?0~@2&0HBOi^M
z=fcvK=Gokw4|ka+hVFsdLvL-^N?y-H_w+LbUu$P`M4tSV|CZ$CKaJdceFoXl`$pZ9
z!C$#yJARoPHp`9NRUez6YvqZ3TYVN#t85dmI|Fgt6Kn?L*Ei$%*92Dtrv%Rl=xSZL
z6K)GnruA&@op{;McLzhTgSJ?J-v&ilV3U#y+^e;Hm*$fy6si+TUg?Y#c@
z!9P1|cLdJzzljd{y(I#!3Kh?Oo;fG|?SY)Sm(>#g?E9wdvsPVccLZX_4!(SI<{uC$
z54(fe&dv
z>wRyuIqJG^$~yYgne~}Z
z>bqb0rN2EOQ~l$64)}uSr+I$jXCLv6SI4`b{5?VUqLtM-y!LBrcvaKlst(k*F*17xi3#iv$U6}5^^!n+vEd&gSK>J5iq1J#
zbkDhB1HNa0E%?@a^JL$?fM4&)&ukjUYu`A2uCr^z;Pc1Nby|ZzC;UAB(c$Ur{9oh`
z7tb>PApFId|6srebz&|3-g&_^B|3ldm^*RMJ%gSy=xKvG?_``c=-Gpw8|og|8EEX<
z8$2@j-Z-XCZw%BjI@jMnwc3*}wTOyE@2}>jcNl73PONWkjNwrb3p|Q<-{Vod9O0WQ
zF~+0j)JbL-iSNA35njYskBc6{&n2M-=KuLjJw7Ss;DHMDE+sP$^m
zd}~r|;ag+s1dm#;=J2h(QwNVa2U^cfW86F4c_YI-+8lMAF=%WX!^WyHsqgi1*VtE^
zYg^C78DoCkxuEa7F@OG`7Yyn=n0Mc!j~etbgE~{jHwJzDpa%wZKbwETpid07hh3VQ
zIz4a>zwhWn&w%etUoE+d=)E#<*YHjJ%BOqy>ub-%r_dD7;!=Y&^l%e6;kjIQ3TVt(IXGtiHFt0p#lBNLTVdc^wsv#6gf{S28V
zm!6S3Flpw+gSEq4E06t{;dp_da>G
zOWuwNmTQ0TUabA0BdlH8DXv+*@^vFrYh2f@WtX^Y1lp0-nqRlpxcFWZ^n0qerT>sX
zPOb}{6I6D(hx?C6U;T@}82)gKS7Xl(y?4JXUn|*U2FEM
z->vqm$86d1vxM`ZMzlMEo(1;5I~&m-9rWLaULPKe|A#UDV}t(3L4SPEp9ob$*1jkG
z+NhrQ1fEaJF>8Nv&02SgST5K19R1XqJ!*Top8TI)vzB~kdENS-$$I<#)1W^)=+A{7
z%y?nV&u5Gbbs(Tp|
zx;??tUir(mm5yH=`%4Utn>%Nn+azyCQp
z>Hg(G|I4t!JXzJ{oN310H`PVYNr5)ks&Q-S_?031R|oyINr!w?2Ys4-^wD9StR=4=
zH#08Jt^ely=4s5FaX$X~(El5QzHiVwL)DrXUm4KF?%&Kf-E6@B)>tR^^Sbvh*8O&P
z`hI87-yQV74*Gk8{(fkmQ#WM&Uj*m}2Nf86spmbpe=zp{w?Y4K&_4>Tzl}?M|L>V=
ze8~9YvFA?){nJ4|FzBBR`saiGMW|Zp86x9@8FLn#r+(f%F@3T6%QbUq)ZB*_b5~?c
zeTuc3w&s6i4c<8ZuLj>-{Lk>}L+#XOd!1M9`o-7lu3GS)99}%+eOJJrzm81z-=1J2
z(9G`+%>RE|%v*2%e{C_pcg*`?-*xg&8S@Hl-TbLz{-`bHPaE?`Z!v%RnBTU={262Z
zzFW+nIp*)T#eAQw$7J5w5RZ*O6Tfo<@!7t`{8?ju#}@N)YX7lY%%45xKVpmdhm85-
zwwU+cP5%A2m{(`!KXQxt^T+&0t(o_E&fbsC+`8QE81o;qX5M;xKX#2=pH<8~V9mbe
zIsLdbYvjdwA>;Th=ABpb58Ptj**Cv)i~0MH`3G$=uU70oVT<|W$NY(zUsqQT9P=N)
z#r)1O{|Q^j_Zfu#Ph2zK7&bo-&KmD7b8UA`<9O1VHR622&~x${J?7n+?AW!%ymwgh
zySJEUhxt8Q%s+C>@7-d)&y`cQn19sRf9e+Vj~?@$
zTg-2a`Lni|KQQL^Z83kzm_K`qdCxrh&)H)BvN3<|7V}RS^AA}w-*=q(*>!Wif8gvn
zKkmLfHtw^TvGSgICywtiq`O+Dj@*Oj^6Lmoo-fv^o7NxdGr&6j5Z&fc-k^UZqC33O@i1!H_^x4N|c?!FEpzt+hU`osnOl)*n`&`%xo>4SPd
zvG19KK6%g=4tj9V7Yuscpw|!jl0k18^yPzo)}Ws~=qm?()u68#^p-(iKj^K4zH!hu
z5Bio+XK8<+^|^(Dd*Hm(p!cfhrKrvfJu6U8;69hbJ%ReWGB_sC$TW6F;5|LtSN(`v
zHEY$0*0s(ZdHtM3e*3RZ-yY8~t>a>8kJ`L3Ab)RQZ^zW3cb@wN?6GEZ^!c&$%Na8M
zOZg1voIN{mm)lP!J9Y%*dggYFUa`0;5HrspbLRxx12)N-{bEuZ^tC&J#&MT{wEclG
zv9TYI)_?B{?W-4OzPuV_XXCIf{k?(xwX2`w-I<#Buyu3v+2(!vq1kL--`&;t?1Ok|
z+wQq1Ep#ZKltsHv|_3=V!x4=!XJp*|jgA$Ir=#
z!41Kqg8IHEeP}+}z<%{)O>4`V=1**`W0(BX)BK4mpXH_g;2S^v=5zK{4Qcd=vo`yE
zYWTRfiuuFRA&;yF27J`dpNCj|&xbur+r{UC?5p3-quS@II=1J!;ITn#*SS%vv+s?|
zy4qzoJLr0Nbjd+=q4jV=3lnCtGu
z@MP^@Gp9~ECx`frK$~-B&N|e+cy!==%jG=YzMQq*)d!pC7Y{nbYj>~_Xy%t=VtZkn
zuK&$r>&JR?cLsFH-Gc(LW1kqQCHhzF^xQDzh6(K=f{#S
zGTs`*)YUUD9?IRJ-wXL~km|J~7xA
z(Ea^c%f|YtcGzfN&nz3nf(@Uvuz`%OU+3$u4`2BshD*ElW=vzh9E1B~D>%=c6N~Et
z`Eo8$w$6UjX^nF`uQB$h#aP&tkB^*uBu|qQacj<7J7QY@#g+~346QNk9%H)$viQmV
zvjedf$7>U-%}_Saa&8^`u22on_Tw>Wc>e9cq>)>l>~zO$3p|e=mCigbCiDEG?`Hln
zN0^VOBl@i7`1+IalmGl=r#nuZ_XOr^yZ#)9i^sfs!korGa$=e^0r;nZ=><#MY
z?({bTO`Pu+kf$G2hjoy7BprNETjb5U_JpTvBhad2bM)z2`azC8{BZ^~{gYR{yT0RD
z%U8bfm2P{*QT*t)SD!!TJ0}*Wk1=+MvDSCCYtvuaD?YWiF?pj+Y3_m9FZ1q-l-a7T
z=vx<$IR=%8S~=6I(n^RYy0A|mA<8&S-O(5TPIB%#gJZkrNiArN8@dr
ze0%h*wWoXa)%ixCZLI!1WTRY=buicnG`7o+JL{r!E(|4iBhaosMD8Qj_Rc=wuMOz@
zoS=4HpZ<*j+14!c=3d+#&~xZ{dgvW|Pk4UMJO}YhIqo=X-D4U%
zJjb=l?j2WZO`k#Y8hhq7{9pPb2kOJVxlSGy=jG6QEPL3@)~>;C1X^vKb?rDbwR(<-
zmwnw|dUM9;FelctOnNuQ_)@NXU%c(ZbrJS1x#;wn%ami
zdFJ$TKS94^<1N5|4#3etC8>mfZM6ESe)&0thT^Tq7n?cV~x_9~B
zH@^DSAN}HeY9N>D>tG-s;%wgfIalh<8vB-W>g0J5+?tXvezUW6P+RRiA*jBkEa%Am
zfbvT%E!U7c*Pa;Qwf#ZQzgl7k8{Qu@mOIiH&vkdU^=eowHUh2d_-9_sdLNgXW3N`9
z>jV4MIGuZf$`{jp0eNrFyN=lN&3ZoBZ@oU7j}B_ftk?d|$?tOR%#58Cn1g2qcG#o#
zjO`CD3@(i@He3_<9{Lrby{|9JTx;y%8Gl0f`7>nKT|U;4OBTP#eqzS?=3PK;_6Ej3
zd5q8JhAfS(y>Hzi4+wS!WHvshrO!XI*!85ylMnjwpR(Yeyx^a*;GeqSKXt)BZNWc%
z;-hXAOF3ra?top-$Qr)aM>e-!_NTvGf5kmme`WSH=2s3IyxeNZ&7yR=k{@(f|_TuvVNd|s%!C$-JU$Ed`xZtl_
z@CO(C^%KwL{efJgbN*g5)-``Gp7<=?a^DTpI{v(5!QU9Z=lRo?)_UbirjoWM1%r$PW
zT{G9X-Lht`aeLjGxnA2SbsrX&;0J8OrYwTFHNeMfjUXq{&_eOkw^KE$s0zRTF_dExn|zdN`p@I1!T
z)#pCn`J~+ueAtdd&wM^>-J|d8U){qd&u5KHtupz_PJY<)xIpu4p7$RUelzHPG8@C%
zxz${jZn;lv*X?WU8gIS>D
zX9qh1_v2f(9eV$tf9G1h>F^mq4X~k~hw4M$t21?%&u+%|2K*tz*RkbXT#X&7%|qu}
zoHe$ZYt6_RJLmg-S;H4*{;iQMetQ;c#nxUq5F_#%^K@5s$;;!@uU+Ca$G-N9fx5D8
zGiY3%pT4_PJYKM7JmL@kUv#I9c{(4L{#LTsOV?S!Q3D4;`My8s=QD9@KAOk3MYjC1
zuV-XW`eb&WbHh)*ofyaqSsia~#Y&$I;!D4ri23KO(Q``1)gZY```K;0pE1d544rAQ
zVMq5x{Hn2&Z(3!{^>74A$_};)>L^s)*JlF?pG2Zi3on*ge
z%!#9ROAzs^zg6pOd`9r1fNw7gZd~yEccyL%y4PBJ-8o{X={s-yH0CU^xqe@lKD{>#
z+Wm5@*)J}weewBc8R#>3SsUUDEQd{JI!4~r6m7L~PEuApN
zTDz^WGcsNu)Y&ybzps94`t0DFhTj#iRb#iju<^OUWdT{@Os6=ve}4L{H*4m(>%%`R
zX#Q)rb?V33*>2AYYw-~%7&P-|BN&hm2tK8Sbg
zM{PNi)n!lfYfk(c2Ybn_|6<5)<2MKN;y6>Z={zKCj!`3NT>hytu
z<_yV=TID-gvrTe-PvwfO*mV8emrJ=~ht~UrPJK4%ix2zH4){jqbK>(`hTjLnle;Id
z9?xdEx;7x69&x-bcxqto&OqB8*h5ckU~j~)zF%y-IaR04DVv(Z8`5WkoQNMg#C2X{
zzIxfhUTf|yzrQ{FY<{!lupIkO4aDSxV1Gcr`+PHCuY6q|hz0$gE!Ob6&yYTMjI)_-
z8r~hCki4Ah){5li!ygH|wEzX*?nsTNA2?SoPcch_uRA5zB{sy%^|CHNB*rZ7pDJ(nXpfO`}GO=v-gYE%!$V%
z0y<9**!221%YMFW2IMvV*QGDU{Dw;d^Opql90=q@jOAm0AU61m0y))c^Y!W5SNT_@
z-yF{4FBs$OVOw0e%l$64WQtSu%PIY8K|ICai?gxzG>*pqMaHiRt=~t=gSa?brv~*$
z9?lHT3e*aFjt^#g+(orV+_iPKd`WC+eEz;R(Lrb9`=s>ey4n|>z4E4hzBIbc&-L@*
z@M833Yvw!~%zgQqIll8lyu{kG;(-Bs=xZK3cFCGCYrC#7X}!wn)qy6C&a1Wjsm$^j
zTGheHI%)K)U$x=RwTBFGGUhC*LoxY^_-6dZK;De=XGdTk8_8-eYiFso>g3vK4Y~g^
za>cr}rf#eAD~C?!()eis8JauDrx-jN)Zz(&JbYF5)o1+MCqC@ovXvcQeFR5%1^*2T{$DTnZ=Cq~tjb~Y
zAjj?ufje+Hw~;YTo~)m35r==1!P+x_p4!YD
zdv*t{U9r?!d&Un0_U|85|F%GLCh7R5=unp-EB>3)AzOaGCH>mmdN=;98Fz-|)_iSa
z1G)5U2J8IF@JfE=?h4E|U{ISk
z($_Xt{~of_9U}ks_F3D#=-ut*H@nE8PyfC_eIgrLLwsos>Ax*VSPy@uFqdBsy34ye
zc`pp)i;for^WAc6c6&qD!pFFsAvLMR^iOckQ0QK4a$u
zVj`{^f#!_MgSzZKd6YZ35)*N1OxQ8UM4adNu!l_J@>0FMlgqoeYnwf6xM^DN*~F&T
z1bh(}v0%@RK#N@xZKD4=OF3Di~
zjX`}j*LCcbV@Rv#ER8(|+%R=B0F0&J4~9*aCg#lT~XbWW?R_Z8gTabs_u<9)_c>xCwBe8WS4i3#_I25S7Wubt2Ooau}l6y4lWJU
zfLMG+FptUE%f?*K%5%eC7RZ5GsITnteo}etUdp3`Jad(YJ~n8rrn~xGCbi#O&g*-2
z*xdQq=9gw%4l8fA$sYRcW3PSJ24Z23EguLD26S5I4m@`7?g#g0>w1>WE@#p{aeHo{
zj_ygGTGzebX1UGFEWdu!RXyn*&WXM}h+*Sk?2Vr-
z8@1}Z_z=5_;pOSG-}~z3=sQ!I_05xYT79ifv42n?c0MzT*K32mf2MnQkF}o|sDXaZ
zL7e-w`?sb~x14I`)CT+C7TC|u=1?u1xZvedyER}}*V}9Tl0P_QS&h?-uUB
zd7gjg2d4#OH4fIO*~Wp4#=)Jb*{g0nKg{=8<1B3p_68e)CeFslweBBV%-FV!nYf6V
z`+1(P-}1_L@i>z256!&zioJGrAP(}gnR@v8@hniA;<(I(bOY<=6)ePYn@=0!a1Y3=c|abVA8V65}=+#Dk^tUEi<7qfpq;`34Iv!Ss_
zcNHT)qat3r1AE2In6<{#o4R{Qa9wb2pw=5-d&S&+rglFz=$!nh%?AX0tZXqOTP@iy
zespSGD@M-#v}pTbVDJ_Ez5e
zr?IW%{plLN=lZNH&(vEnX*+_=;JBdY;jvpswUc?OhtM!}*E}tK7XReQVUSMrQS?vCj!A$6m5KuQtu|$(l0)-3UCpL^Qg&lK1{328QwKpCjD?iMOi#=k%p2mQ@
z`Yvzsb#LNAU+*$DTpiHCUiMX1<8e;L_6NHH@zD6?KAPjw^XDwo);Si=9?Y?LcVai5)xcjbCEE&L26rr~drh7P&nT8GIB+6k5Z(V<@{%59T|CUQIsa+d6Ge
zApT_R3#@Z*S>yguAJ%B%Ag9euW!~LAMU{Kl{qkKAAaBlXf8TD7Gx^rDhYjv~`cDhg
z+N_&?HQ{~Y_E63Jw;AwhexKmm1A=+aE#c$p>U$b&sy;UC4QhkC(ij`qN=9qKokW*$
zw!A8n;(_njn=;nB$zEq;e?Z?kgQx42LHBN^-+0?|N1&NMb=AA;9W4J#d&SMUV;^1h
z!#Eq3_GW0MQ=I8s&KqNsdGTm{tFzt#+tYUkEc4XZIzzhy`seeT5U+kV9pwif>CtLC
zKkS|TB*U0F<8uDI7}_|7Jsd|iih*YRytcaPQ}axwF*<5TYoUASQg_;cz#jQMQclP_
zQV!^6YVD!xNHIP;^KpCCzAH7Yvy895<+d)q?0?W|=RLFkAJT3%H?DjXmn#Cco7<`e
z`LT?L^^Jr6PsCqTK28n9bXk|?==XCFYNBUcJj^+h?D1^WoTuI^^1C|_KXtFUQ|N5o
z*y+p|Tk7VUyQ^nm&X*c{U+muut^ISoIdhsiv%mLIV?ys22JR=e^ZnRhU!eK^Grw;S
zddFXEB5l5_tT`tjukq;FVq5j5ySk(1xOLsNW1SdijiGm0GR1LEaCdR6zICyDO7?FR
zNAKIqIG&L8TlrHvy~oLQ?VRnNZ5G?5kL&87`4>w%YP0z3-yAds4^RKQw;ifY@z-`A
zBCCAa1Fd&9EZ+sy$gGoI^6k^#ABdT{zcBc>(Wh2=9$uaPDFN9#0yce5)>z*)Ju_-^
z*2O>dEXH)oudxGxJ#?eySU(|(0&dICZUGGgg`6ABsQygYr?A;M;3&f#wwc8k5_@cRk
z_*`GMvR90Oe095wdC$o1%;{T4u2$d0lI?79ABtOJW9~??5s#(L=J|n{vtMkEl;_5V
z9CjQjHnnTc?J`bt%#LLHNztXz@2qQVl{=lRR7cW0-)y&xg
zKA$;Xje}f0F3{wNud^S<&kn>3{EnZxqT}G8r-!cFcU#6adgX>4OWhk8)95DGI<~QM
znNM=~OU_21;oXPMTK(S<-hJ}#B9Ojw0yVu6XjcdIkx%u{+|Nc1z4eWs{G0E)#)6&d
z4ljqTd3$O*o6W7Wecc%l18o_niw_O2;zagrvu6++*eo{AmE6}y>&>%^9qir{7*m7x
zun{$_
zZwSczfymql{ZJr3-QT~jTi(}_#0szZo3b}OEZ6TjGg%h
zE%=KU{8JbFix&J%`CF*7ysujDKNh}z{C0krV)o-}7yL^HKg;{MY5zmUJiqQAs0lUW
zJnR@$T=3>mYc2}RYvQCo+p#w~@LHb>b3AMRUyuJsqWn)T_%9edIkoR`m^AW|{#6~^
zIMM21_x|9xz#V4)C4oEm(tsbA1?tL~)OY9cU;miEdD7n=G$#1QhL3pEJe~N)jBY&I
z7~&gCw&2mm7SA?(?do%^wlzn!549fbZ(l6%sIlV*kK&zO^C*7j;8DEKv*uC!34=%R
zzV2fl#XG}z6z@F}kK%oHz@zvF4<5yP2Q`o4y-(v&{H_3x;&%sl6z{IVqxijpNAaf&
z9>sg+T93L<<~nLFcV&F8;iJR5n|?UZ=6-9BJ@;1LkFTU1lGpx`9yY@r^+rKj?u$
z-6`guFz6EpebS&$9`vb$K5fuvgp%D@%K@9`{E3~oS$E$+vrd1`(;xiRUGwzL1%LH|
z|Cj~;`}tuG{_{nhh{+G8Q}rj;p*^gcs}9n)}P#(ZSO)N0%7Vt$qLRfB2bs>X^4)`^W{q{QuP7JN|F;
zuK(r*e|z}Z*Ut%mT;y6$|EGt)|HNMw-hJQsbHlI8b^Vib@z%sve~#r(fAFrc{ekea
zJvS}pcP;pv|KhIupTFRrwcww!;4fY9k6rK=Ecks3e$Rsc&HO?7*}tDy@ZY)Mzbrg|
z8)G$aW5(tj90)(h{1X;3ju|ozUSnw`{ho5_U$DfxNELX
z2~URSQS0O1QtSFGoA>-q*39wxweXFn8h(5D
z>lb_LuQSM2cfiYroW9T0ZgZDrj?T&z-xD*|HDT}bdw+cB|HYhj9nARZPRfQG)87cR
zj=ebj4FhQ%dr|ru2GZud|48K5hTf^-%?7kT+jQ2f_etj{h4b7i9xiK#O+Uc=*=8s+Qf0-YepXa|}!QUR9uIiZkjT>Lw`_1_U
z*~6BkXH{Ru+4V6C+3(GNR6gteng#!s1%Jze|I7t{{eu7W1%JYV|A@iIw0o6D`H*Lg
zpZe;|-=jJ|w6Su=emG<3kAxl7CPTO56K)`$)V#f^MfDc
z$W3McP{zp9{!g5JHl7rqy9QMkcr}8a7N|*giKZs?Yv(2D^ULQN_Yk}Fy(@~dcRS<8
z_$rqAC|-Yi(9f3MH|SOO=IF!Ihi}})4sQ->LvvO;*kB&D-Z;KC*@tJ({(!IS(kf$n
z`rWUNx|gl>hrjmmmyHJka`_=f`h2L4o^i75>soa70dEc3b^0*h?|iE-{T$tWCuGii
zW6{sid?CkYAM=g9&(HiY=kpNz#YG%6<79Sk*P-{Mo~%1#>_2PJvj;tQ(DMd8f6xmC
zb^qA!{z2!@O?;3C2h-NWSjIxu?mpuWC{f9{~q8+0?2PPM?VGlSN+n6);=v9)=6`f_glX+dlA)b!Pk
z@l%4HwY}-ntrpGo?Dwqg9`m(f*Whc%$%C&g&3*0Z*I8;)KU>!>bw+<}Q-}E4*RS&!
zV_$2|oq+GxiJSxc&cNEOzRuM1((}=~rRT$5==tbf)APYj^X#UNA9#M@`HAN@zUNI`
z@Zw}%-0(fGy9O`L=EdE-JmBR8FHd-R!*3tFoZ^oeynN&DH+Z#xSMTw|q_O0HOwDF?NK
z|61)>p5Yf~j%{o}4-WdGL2nrJ#z9{?=*tKF>@}1QcZo(X{*l4Ew;lRg#HS3S)QG&*
zZ^P}YkH$dlGzRwctf;xhK|S`2sMVeib=|YkTBb*C*~aIdU45txt>xO$TCOdv<=WF)
zu1&4w+GQX4wT)bS?W4Cgu&=euPCUEK_w1?@e9x|0!8_B|s~3FFu3Ev1l^W6)L$#wX
zwyjAqZw<+X#tyaIc+lTiojZ+RkbYzIu=E?B^V4r^9-4mRa$fq4$vNpa9%rY|uI6js
z;G3_r245STMeA$d8H2Aarw_jNoHqE{bn4)1*C~UqZF>h_`+E1&Dc)*XzxmoV_~xs3
zfAi&zv%dN2-QRrm?(bdOyT5m>eA$oEZyevd);@giT5|EdYkT*z!+v&|?_JyTvMXce
z`DLD;czx(yD=v6(GB0j;am4q$h%;W?&C3J6=jHUl_q@oX`JNYf#`nCa1ANbmI>Gn6
zs3ZLLfIc;b?|D(X_@0-C48G?@efGSl+n$&6)9-mv=RGg#UlT9qrS(T&Ymcth9X(=0
zhnSHsmX*zq%I2dcCP%M&hvFa>V4XPGOD|b;l0ECAN1ezeU23THOP`v-S07pSH>Ztl
zb6{RErKPixB
zITw#t23H33m=_az*iQz#>E9b@w_4OU;nHJKJ5$mkuP_w
z{*NKGXO0gV-R7Og{ed}h<&Zr3)Ql$2=DSXRwo8nz3&flZHd)hk`_iW?UkW<>wGXja
z+EV|m1#yIpK-*aT`{DR+hNt7$fDSERN?iFn+b{mJ4;vPy$=~iMa)-_Ro+*CVTfgtF
z-sM=F?`=&9+Prh{gnPa^2$>xjs
zZNa0*eC?sXd+(pQ%Hv=6eCY4^GY@QU-1MP(`>f-Wadx84Bid*2uEFma^prtQ8`Rmf
z{;WaI9`xKn&l~joK`$8e!a>!td(kskBX3u5WF)Yhr+-Rd-Z@^zOsvRYtD4Q1W>^15cw;fIXZyUi
zKc_|p-TxuFozZo=w`W|l|I)zvADe9T|7U1h+4}Iz{l~1Qi~O#aTU(cYh`BhJxA(`_
z?5&TPUghtS(2Fr?bo}tDch~;^Eq7_}&fcZH15owUyA#DbzXiVc9g6Rrf#Q3&p?I}p
zKZ@^rHHtqWFpuKI=w|Erq9N|%XKNs}9y>}IAzMm`l-o7hi_M_%^2Y3{(
zj_@dc@8D6qGi+Y{;?)-3IR5m(8^`xfte?(V&*1*luD$iy9oM-BXU<)NSN9*xyZ*VoXU6?=POv>VE_h`?wte#6
zbKqWAqxQ+Qc1O^A%D6r9-{%}3>FXNLFgo1b&XXFVSFIR#W;{FCNw4}@)m3WI92@LG
zXFvIBKl%1q!)N{(r;9B9`1xw`mvYQO*YmZ0Sj(>Jw2sZ@fjsir;a$BkbLVw$x~u26
zJlU^VN6)c={aSv!{(ukW$fPSj7O{FpZRNB0)Yr?>
z7vBqmpNL|WtZA
zzP6=%m(R22*wc8hXJ?@48`t-?J?vq}6~VcIcNa3$pgtM&_uWFg
z`73VXr4IG2Vb^5=KQ9b^a@&W`((A(S3hbY4U@JeDdw*)NcW>6PQ+>ZXbDA?EX8f4r
zNPpvEDKri!UE*o{I}%U6iYME;ukk;SvDQ0UGza!*cyh?KH$TpE_*}~c`Rvm8aY;~{
z`Sjy~HuoE+-5IxMe;{79i46W+8pz3I0Udq+RUh(WT%7ve%jV|KoIEy%c)7&WiAV8t
z<59d=;88qV@F>1EwO(o$YQDC$hH78m)2$&71@XY6_~QqU;yshhqj+)0qxim;qxcg7
z^C;eXD;~wSCQ-cnnn&@TKX?@1_wv4{dyg=Wns#Ad|rMyyym>LKcAQSdtBzL>%IA17vu6%yS{gf
zotrUp=LhQ5{I=ljW4yqg=BHCo?l!WP@3?Y(B>Citle=|)fTxoV
zyj=2sd!TO3v&Wpg?g;pCOrVivzxmp3%vrD8@*5e`*uDGcLpt3t_YIC@bLGlw`kQ$C
zvcF?Ll6%q`=d)wqkTGlAc^&)Qj9KIScI<|X(XDmP9#Dhs3XSd7*{A)|*jN4!#(h%$
zKKZ?$vopH1{ey9vS?nY;xXyFqq>-
z2Yt@iivsqFm$s}M(1tfLBu(DrVSg~&SUsK}y92Rt
zk6jwfaTV{k1mbXNu&!?GePuwtd9Aw6O#iGvzCa#-AwJxj8oMcbDtll0T8_tEenvY#
zdVClDeGC2_94bM`rN>=!F_3u4Om0|9?73EVegNbY5Udrlqd%LU!~
z#{_-XmVeLc9f3KNyt9MG?X9uDzJK}fEz_%Y^`SCQ_MzmU)}ZvGh4&VB96vNZ+jB5b
zx8hX2Pg=zEk}d2YulGH9`m>x9v+stCiHq32BjBfd>lXuO`KN+;?nvwH`{jVoY-g`J
zyfg2vvtIAbc+I+H+}JHgT5~_|f7e1@zs}wG{Hw+Mmxt$rniKEpu3rAbI=%KSYwmw%
zz16mLabf$B>WTf`FK*VBCr?eQf%$Ck<#B=5c#t#Kja+!%{bJ6Z=iNn;n&zJBIV77t
z^{Y>Bbvj3M8YhdM+9K}Gsq=72;4B^p_-Y^fX1~q|PyLy}S%G?ec0fMaWRcl-L9*!b
zezPaID&WKUf!v-GY!BG&?)0o7n-2Ey$(VaWV~;U*&{y4L(8d0{)6M^_bdxFe^i)T>
ztFKSadY5BK&EJZN_>m_bOaIwP9zE=x{kKnC`D4w+fmVCW-4PrdW3z5?6B9DTjBcN~
z=Ge1kE8X&5-QvV9vGTV}wB3Pc*Dpn>aqmX-?+wU3HINI-XB)+ISuJfUT`Jb9`pwMxb3CI3w&3qtgQGG`5?w$35(C4&vV&
zX!L1peN~`F`M4RVZ}ES4@ShVL@gip<(C9rnkiXVE+1CGZ*0(mApAlsBU#DFKm#1ew-eN<6KAV
zu<+b7Ue$%QbhAesYm>T>
z8!@(@otI^Q_wEe8H?UW{E)UpfU2SA9kbUW(`puj887GIYmjv=+y!Kp_KAGB5z8C=;
z$g#I~%H7FHXjZLztADmlJhrlfUrRrivgDdCD9p0!_g3=xT=`2sYioTJ|7D!`=MLcm
z8&KzRwxRwl_tK~FNAB^y4|?q2L+(D}~^&mMQs8v^zE
zD=~T_^h3dM0eN(|yK9TMY-BHg=KXxxkukn#*{bS7yo?u=4j>)*avwUMq`D8c;
zmH+FLeEZ4Y4Cs`z=Lhn`R(tOVw4R^(B0i@D5w~jW5I=Euue&FWseOCiorP?3{x1ux
zLEW`%u#W$~k#$S|GrXF6-nEPhYXd%zBmU&8uiBRGYRnxn>)_YS)6rP)Lto9&
zXRWxht$y>l@$Z;3WPDq&j3Zt4KP$K*AX}>*{Wk~3mwweAKF2=h)SbEC&fKiycNYBbPW)!pcWt_N
z@u%m4%>O#=!T;WZ|NRC32jQ1~)%O3km}9%Rk^6@WIe#?qo0*?&6)X3xegA!0hyUXR
z|0m&>_B76ax@NAneqb@j*2ekI7CQcX!T-g?Z)V?Y`!mC5dWAX8ADs5^<1ZKdhbDem
z2(+t%+5Xzf?sfNqJtqa~z#4JEpD=iN77KAP
z?yiNsLDa9FrN-HZdT!10?o;Dx6m>t%^Oufs_l9}z6Z8CK;VWBwt?>@BTvPe-WzF$x
z)>Mc1StAGht1om_N8=!tOI_VB?&Qebat%A&x8~KuQcr8aygB<%59n{biZ7@wI`#Jl
z_V!uc`ch+TwwA1;0&AN;Hb9>@d(*e>^5Bd>Y{;<38hL3w;12|Q0`j^?%>OCb+A}78
z;>2gIF%^exft(w|i%Iv{({pG}j5h;k%-_AiZv
zV{h!7z`b!=kgcoc9saX}$}wo{{eOqC>$2yIV!Zv&3E1Rov6@)z57d?#P(zml>OhUC
zq00hsarX83>746}u`{i|J#cn+3?9WFJ9rdNr}e0@eS!9K)8`;|&`nQeb}wokwFd1v
zeGp?*t}hC#*Lo+2`#;7Q`2LWXX#cxoP(5-X|NUG@Z}Zt)sZDE)pBi+{De0>f<9mbF
zi@T)tqSjk4yV7sH`0Oc1trvGCo?YbmjDoKXo>BPP;mqJ`i+c=TdrlmDZ8~A_waYWn
z`r4*e@U_p`#shm=Q)&p0nlp~?TKn+i7$XS{UcT_oIbJUD?f|?zyBqZ7-+iI4E)I;odU3Bf
zd#49lpJ~kx`!`IaZLI!1wC3paoljru(Ae{j^}PDtV9$~K$YJx`csDQ2U-R5`Vh63S
zySuZ5g-r1kLop{?9>i8|TJv(&dY8}Ex?H!;x2I2k&mqdEeS!9ze;^;#0=qS}!1l&Y
zed+(dJLpg@nw$T32OWyXKZZN#;8dUgub*I~-4N^wdT#%z#O1=+{6BM%)^7Y?PyAMX
zTz@Zpy|?SP(mRif`JW&4VcWOTF^|vvS=K-1{y#;V|98jJdyvnQ58I*+#mqCdb?v$C
zGoNR9O6ES#$p0;2%xA%lZDee=dyaec?ag{;@7d*xI5jC%HAsj?<{0j27TULe4Z7PM~6Nu==>~q?$@V{X{|HGhr8Q5+bz!C
zyTp;-cjo7WEBpNLZ1&FOYXbfwq}q%3GA$-Yg^H!MZ18?2z92`h2+W_5jz#23_R;BBb9^TF&vv;d8+}8tKiD1AZ{z$zZwrnz|HiwSf79K}zxi(FZ@-)Q
z&;5JOzx8hRzwK`3KX1+aTpx3Pu0J^u$vA&<3`x*PBF}`ciJ%gSy=xKwVG3Z%?o;~QfgPu3&`Gcx`e$o5P_}~m|
zOP!+k9rS*K9uwNL(fSmpyTe6UqsBEp?h3@*=jxXRl||?F=pavj$LQm`??vg)dyI?4
zy75!C7#FK`>(5v-zO>!hWV`sycCh!@*o%I|pvMh*|Iqqi|BDxU`LK73@l&@LKYfew
zGuMpIKCq+lp8Fq>akZ)zjt<_L->Hx@pI1%P;ojj=Xh(Be}PZ{(n
zgMR9u-W9BS?V#rm`p7{q8B`9e^X@ZK?@aj8#}57_gT8!F&v5HD2Ytby*A4nvgT83c
z8wR~`P8&~F^{n+E-sLBDO#uN(9`
z2mS6rzh}^Q4*GqA{@|cLJm|Xy{n0^xY|tMc^gVp!*gYFpgBL@A*K|gxXj~(>m27Tb54;u8uK|f*8?mKDly9V7e=qZDqHs~3H
zo;B#%gPuF+d4rxm=mmpbIOr!0`lvx4Gw4NwZVdYPK@SXi>7Y*-^ofH$Y0&Q-@mto{
z_mAp2d#^ARP{))jL6aI05CLbN|zAG2|p1Ee9JJ&hU+^^pntnRz}9{TL`
zr2BpN`_bv%1W~p6yu2&aKF^1Pfji*JfbHH(KQ4McD)gG*dD+zG
z3fcO5gO3Of1Z3{F>V91M+Q#bNL*K)-PqTL^<0CUh7Q0Ul$UY%3_AwK@n}0&^
z@xiWu-Ah^ao)pBD)%Wp3R^LPB!fxGm7cC$1mn*|8aj7roZkCid(J
zHUjO!;P?pNz@%-g{ypT+C#8Q*a7tj0`~T>GZ1OG+H1kag9j!+
zbleyix89j!r}>?k=bJVCn*h7g=OBwlULU_c_BGe_%~=*VC}Zx
z)3aVat*;EfS5P||bG6gh+PfK$2jW#7_2bhr=J%e&Z$1a)iXA)H-udT_F)@<|?UI09
zl}Qd=>=ct-PSzh&QmEZkY-+0fp
zwDi5P+@+2a$PT^wnf#?o5BKara;EhVBzD{dr&5m7Z68)l2X1
zo?OcL*)?)5%{sOFieM?v=giLanaQ8sW33wN{BrMncCu`BZtN4|jX;xsb=S4};JzT6
zets_R0ye9q8-tqyG2Itv?~jjkG)~qz)8Ya1nG(A%&idAR&*(Axf!=}OE7{F4-LNlU-!G0B?M`xx?+G+I*2%MnU3|5M-Alf{qU`?7fGjzwZLJ6UVI$Bs
zR{tJazisrznQg}g?AH3X+}JHfdjmGjYu-EM|ANe&7RZymxHnDx*#pCfj>FLA7_d5*o`k~uM)b68(8ywbZn)V`+#w*=X8
z_;=Fe%N-yu&k3~G1=i^E?{=LuXI(SayGhdP2%}~ugc9@rg
z#&4GOiIc32tkIVFP`fV-=zeh4v#UAfEBR`Id}~h18uMVz_u$ZN0o|_&x<@R@v+v~W
zlP|y1X6@eKhTz*I{K;KK*K0Uf8f}VT1R5
z`n)%)9s4gG{g;I{mh7mn;zy_F_3p?!7^)uSg5CDaXRGVyy0mvs_R4Q-XqLf_a{@Be
zHGk**VOM+kw0Dh9VzbYpwEkWtUB=}5H&RD@;(Nz_Dq~yK{?4pp->HH9wMCp^mXrU&
z`SAI&M~t@zCkE_telHI;1M~ZX-2vSv1;-3(5C1O-_Kq<*V)sU%SuZvy+2ZC7HAXL4
zwUynPS|UfIo8G>&%+GIjcD^~Tt<{S+*RPqdS-bcUIc#73wN_oT;Xv^0Kwj9xFSV*)
zKlrpKxGG>9y{!$p?5S?=YA*=r=>Bw9`;Cbuonmd@@xiu0(-$*wFh-YisofEXk-e=C
zezSF*&Btb(&CZDV>XHkMF1FKUj4u6qYkTua9-GPNSZhoyf&b#{F7ocwIHPLUdht<@
z`vQBOkveW3#q-@!LXWy4YcsH3Jne0ctNVWLEd*hwoW3#@5%4
zHR-POwpQo(ksb5y@?Ll_`^4b5V0X}(HP(K0kxAdS;HlYXk6h1Z!aN<{m7i~(eYkD>
zyt8@j;DUe1V*T&uclE{d^aw-G81&3R&kCJ=ql+!%i^tbx{~SxX=-lmNjvsSe&&c@9
ze;_}@Ro{DGojv5+`>_11#T$ZjS7*TIE;`J8Yxd5vb}sl|$j_ftcI|q}7!zmuoGX-E
z)Ln({4D50Ly?y+=$G*gayjkZLX3pJnWzf%j)`;iXS#R#ffSf&n@pHy_-?NO1-7NQ&
zYvkH{ZuX)N8T7nR`!q6IlYH0_pvKV?26cDg-GlPm{c`D^d}Q#@$aU|Z?4YDst9Gvp
z>~%lv4~`4!cyUNh@9x77Xj(IqysuKMHm
z-ORDeJ@&k#K72oIhVT8K?#f?r5pV1HBL>EnzSt)wU3Y5w&eG0+Zu8<=z5T2f^{X}J
zx^7?k_Wo(^iR$BvdSXM@vj1Tbz#cWq{>C)j!?xD`lQNd{A0Dp{#?A=n)X1QNZt>a{
zN_Tx=r~6{7dJu=bWBui!VnE)!@5b0p*yn5a(geaDI~N4s4C9kz)e3$f@QY(3OAB>NiH|RiTwf7eDAeC&1I&_g?!R
z6b(kCY@WwwQG*entg%h>z_0Kz6Jli;n{D!*!J%PrF)nA
z^`h|n()!Fln0|GVq4vd=EPme-+2T^!pB-MEsXb$2e0|33TR!jY_xCT!wSGCz7XMcs
z`F%!`_x|zBx4t@lcJW^D?rDv?oqlWS{OU>Oa_;6KXGhjSpP}~4tMzP^Q+=^e`;QB>
z#>bpEpmKxOKWp%)nDbu~bFw|F9v0`-=xc&AgR=s;1ND5rK&@Xe*6|Df@bKc*x@Fg%
zK!}j#Ws%N?}ePs4oD?ZvCf!s6}kIKA#
z?ibH8u_BkwN3WSXHskiP<@IBImaRUc)$VJ3xFTbXB^iyS_*@*m
zv1F^~p!%do-cAbS1^U(ypZGn0Aa(WS^J-F7We9e1m2fvOEOghd9l-W
zuJrJY9C^0(le3n*-bs7Y?-}4vW9b|=j<=_;@nJKV&)<_WNbW}j8-eEhRgSY|{!`Z2
zNZz#pd3+(ecL#Y_295b`>1%AX);T2GUFZH3FEOvb>W-i8W4^HA$x%4_zAIyF;J+Br
zSv~aD2k&N$Md$6)!EEcKXhA%
zM@_Qm<^QMt9c1xKyq9)8Z3|g)lBvUWZ9iM&a>wZJ4;Aa?TK=tb4?I1a4~7DppE30G
zJz&1uF3G$cc|M&UO0L?!IB;Gc5~vMlpX@8Lj?6139rWc!r{_kNIN&QAzfQLG
zpFV8zoN@=u`^dGAjy~g_H`dR!+-Dm9#pU@~BaSh3#czfe7e1n7k=b0}=}|{)COcbJ
z{#-lswFdWQe9ldEykO{P?8Vf%s$BZSRO{F*=Rq0Y465JSjX>*|`)$KOTF2<$Fpwsm
zFC6yH@vI*6*Dd_nl`%H={07_Hi0wJci(hZ_oX^KGdL?yD;gW!;ZF|K
zi#6^PYog-t{L|7m-@DyCAXmoNwzMNdhxd|ioqSvSoIo8^cV(CF`fIbsJ@@B%w-NWo
z$o+9fAg;}&J>=38(^k*1Hyw3o9X~WN;-9uZXf5?lJ2hius?Y1QiH?X^HL8|6B6dMAn{wJz{E&^}d(YH9f!9u!XHXOE2C+f0o=ur|;=k
z-mKGDW6=3opL)9?I?T;A%a*<`yeWNF+oyH>&6o_TRdIdEkaKDJ;x|9%_`~nnzp$%3
zWZUZNrEGY2HhK>d1G(1Ncw-hdPwoQE^U~h=`FK+Xtbb|f!O)^{;KQzfJ$yV6$nXB(
zBZE0dzd6N}kMc-0S!(i=gWZAFy!yXcJHMIn&a>%dv8i*dvtw*d>>j;9
z5vCmo$lE`tzB>BMk$dMro}2@9v@@7v-k(`iH?3ba@L6NO8iw7$b;0ukwQzGl4l`a8
zToF7ua0j<89-Y2suXwe7_35KW<3qC>S$t(Pn3>%!m_!@e8S=a+FYvX)+F
zmtJc>dl8Gh852YCrc3PT=l{C>pR;CvpGBqQsrAjkm_FI;cW(5L4>~S>V)oss;dzgK
z&*Jmb?;W=@eRjI5UKNN3zpej-;PT*s!PP#i|(ceb)^ovqKz_ycn)A0H})PYj&Brv>c1D!3+i
ze(=KJMS*kj8Nn+8wfEZKjlt&y|2+8O;LC!q4Bi?1QQ-GI9~oR8ye)V~@SVXA1V0x1
zWbi9-6n-`RKMn-+V}f15dBH~T)Zq5uKLjVIFm4ULF!K+6f2+XH
zu=<%3Utjb+fL8@?48Az{>fqah?+e}&JUnX6x5n|WUhuD3@ULC)w=DSAE%?_j_%|&0
zTNnIo3!d$>eQ#RuZ(i`XFZj=0@NWsPp8A>R)c>EoJAv2xs_Vqx=B8~*5fs}{wl+6=
zle9oL_Vx+6Nh!3fC6s~%ddrYPDGoXyMJUh?Ft{U%IG{5OgNz#@i{P+XQE)?46qHr}
zh`2G}!qk=j=l$e-!|CCH9#-#yUZ)6o$zJ!f=$Z{|I3)SAzC&bhN8{@>U3B;`~3rH!}Ffb+I7Am{tD
z*3YvwQ`5F5|F8RKN1I#d=1$0%zL#Z#b4Z>VAy3U89njOuFTFq5_)g6_d+24qGNzZT
zmxqUsv-bbcjQ#Yn=M`DApY4-Cd(6RZD!Y8z)y>hf5Y(E_n{08X)I6C#9NClf8lNWy
zY1aO0w}yUY=sp&FToX)3(88R|;=(9oj^wvx+75BF_8K-7n-E(AUwcoRJ
zsr~H+*V*fjr+5fIp?0@$%`+s4X{R@c!zr{hnKkzw26aVX%k^74?)=N`=uH3j>#T(^)F{_sk`94Gxo7VTdroyUo}a``y$8t^<1NWB{Uv(
zd(Z06h4W%6d%wiS+HVdv&WahkJ&(!n_0ET`n)yJ}
zLFR8YnJeAZzr70GW#{hewohi1qa>scJsq&&zC9qg&v_L;A25nh7{}apXUx<|c+!?dylWk8u2e)PJ
z=s;U)&mZ1|J%4l)_WXa#>=BR3>!%uDUso05{Zmg4e%`+>WA&o0-FttWef^#K>Cj^G
zCrw@-6MM9UppPT@?oLfDm0eX=pP3=coubk8r)|A|{+F(jMMv5EXW_5+CO-UmM~6J5
zpX|RFbgR`&Obt+<6~DgIgdSUoAwUm19&kmdYVPwtUzZ=ZYhc1p0rdT>IZ4i*A>
zUL1H<&j;$r8jNdndcPr0JvjsQXAnLUYzX4kA^Ggu7pQ@~!EGA)?=1WJJwNN)12RT?
z{W+4K$>Xo@9rp)p*33-|((HFG`N34L_+9rN-!}&KmA~xY5{Q9DzWe5Z!7TY?-6!aE^kZ>29DV#d
zE%>@XLr;PoL2oC&)&*w-TLU^Z{5u2d8o%n#4t@8{FOUm4ToaV<_OQ2P%0<$y8dN>=ad$wkhJHe@9+CFKplX7>
z{r)?Jo)73A^V0iv_pGy_;!37ExG)%Hjx}&ob;!ebPRAU0=E$EI%RgV7!M%Z;E(Cnr
z(`aW_owLziIo}w_55DIFj||*tj}49tZWmZ58*N-Qa(u@8H-B|tub;<|JGEj>tN7VF
z=CxvaAZv2N9zL+04{T?5)rmR!$(C33;yh^mopfDjXJ?azw6b{?k2$U6E@zAQiB;)l
zKc6bkVj-@0b_d$_Kpk5%KdzDC{bo%PEI0lgZv2x#d(6S^2tLgPY`{Mk{wvb6mk)e3
zzqZX=Gr!GTaCsnp;{3Qko@WsAWmdpS8rHycMeWlwKo
z$vGuD3m@Ju*LmNuRmL@^Q1Rd{*%dm^3RIQw+3RWR<;D}bElF2?11m~
zYw}QcBH!i%>uN|-*K9pKAd4QY;%cl`s$MpkNJAe8`aIWjoE^^!DhF&Wc|A|*E?zNJ
zN5>@p%hkF&O>WCC`byTUHS6%A;Iu$&_^f^>!36<%C8KHp&%2YSdTxoCIdXOe=QP^B
zS(o8BIF#JxkhDvoq+3`&<=7oVKqgIRp;Q+BCy@inH;JwED_Gngf(*N0~*
zeR8yJnH-&xb!U+sP&t{;Sk1C&%=xj)$m72~PYawEaaA8z1#`ispw1E&%Y%~XK
zwV$o_v(^0}&RW%p9GoA>v9*%J5B8QFhbw0>d&ySAbsn7~^rHhd;c+jRtLKlgR`y+z
zG21FnB?He(gI*7t*^7tnodKUdmYO;@{TG6gmEkldc*REDh~@gAV!;1d`4(UHE>&k@
zFJEecA9KOs=(Ydm*6Z_4@248nDn}Iud3LVkhs{R@tKCcfxHnT%9aUrGReVc6o&&)Z
z0edEaHktnaOK}#Ht$}!I*B$JpIbO`Tm*>7s+P~;MLruxqB+y2_9}OSb-x=H?SQnfX
z9G63Oc6w`*Kzq!=Zu)mZ*$NwjEx{?lsexyK{p#aBfpfPzkXLcIFnDP2h~QDdC4snI
z7CbQ!ho=VL9DHl=ZNaWU>@;_*81ji;HD3O&$(Zh2AN8f0Lx0^s-)5k1+tIzO)r`si
z`ffk^8wUDz9lexH`@V4rK5PD6Fu5xqPw41gCf@bk8v6DfJ@TH|t>L}HK;N;WvpmgN
z{jA>J&<_YM2;|f=!(H;&;PJub!GYk)pwH*Ghkjn5hF=`0z3&ZP7W`1~%HY2RuL)ik
z{ABPm!JC4&25%4E9lR%aU-0X}2Z9d<9}Yemd@}e{@R{H*g3kqi6WkE|W1yh?`xE}n
ziCYI>9~>X}y^(hgHUxfN(7y@c-+}P^Nd0>c{*4F!uEQko?>Af?QQHrSJM{PUGkxg$
z(OP>_=A5OTR>M7g>w)%M@7KS6ppPHu69(Gd)$d<7(03l_yA1TUfj(oP&m8D`4z%;%
z>vtFQ^kksd4)oCjeat|Q{v123_xHH?dv5jmeGcqtp9Oo`^Q)&lAA9=5fp#DE>z*q;
zebPYtywb0480h(dcGvd&n+AIGKyMjn&yRk;aZkI$dwRz}?;Pk|1MU9r_n$V-F*bP3`Zqlx;5yeO%`8u~|>2bv9hsem`EVm+VL7mocibJLMUuzjJzW
z#E3u6Bf8>?F26H8;vU&wzOrj?{^H*lUooY({51x52Rowjh+AhLJ?7~xe(UUiSALl;
zxxSlyLBQ6#WaA|L4MCr$*N2yk%H^7jUzIs~PRbtklJD6-zV&Tc=a*bq19zX^okza>
zfw_`VzLm|MPu4w`^cz~gvGwZSyn9mbd89_gMspvZ95~k}$JUF|e^_AC*fAf_?Hq~M
z-hd6x6q=pJc-UmjFSTIIKe~*M3HW1tbif|#=%}93_AazBnR^2E(xq(=#E+eL9~)?L
z%U<@CJTcJ5HFB*zGWcBHeHYV{%k5Kw9c`TMPz)~4cz?j&^#QxsGzm01&JW7IUJm(n
z{>851wlibCd@45dwp%aT=@Db=#qWLH-Nha;mt*nkbv`<@&mQig(SNZgzv3$=be4^k
z7dqua?l%Q$g}s*q0Xduh+-D5$Xm*P^DFtUK1cuAKMAzS^#6zFzu2lL{>#xM&?eLWAB^8z8;>zCE%xGGdG;LM
z7?4{s`yZkVw)->s2R?+Ns%+wy}hbKl=|v90Ewk~u!1*>iDdbtH~8x3A5K
zLCx)KbGS^uXO0i&|BBz(HEaF_zbCc4#gh7ChqpIP5ZIf
zRyxbxjj^NdVfQUx?-guJ3_bI1qe#-!{CvPBIpK@@ViIU{RUYLPO_o-BD^BLV5L=wH
z7YA(I8Z=c?emPfXd?{I{WV|CF7u@^1+n7$g_Oa2LxUk845Lxm|7kkQo&%(O%#C2m(
z@t9<+(XXCIS@fy*l1+Zen$MUlc9>smJ>9);lh9h}6!UcfT_Z0Zeoq3e?DCmvQ}T6o
zdcIErt?ni^vd0?TawlGTI*ezn8}3A~ru=iQc%_E}T6@?Ph#m+kCtYCPws=PTRD
zH?Fg1e04y_XQFp8eZALZIMr1-;xnD}i1%FJX9d_@u^^A1#fyIuXp`yx59U^^)!rCm
zcbEMa2Wrb5ua$3Vt8y+^Rcl*@THD;#)IjCBuYY#Zt+sl9J`#UQSJe+6wg&DPt!x&9
zHNl^Ed#Z-;*ds=oc;Khk?@zE^^y5NXFFVNm``r8eo*!J|d2~*A%PxMhdGwRqx&!H*
z1ezMM_P9VDv8~Qpoky{j541JB@=X^zdtD(9$t->9;&)pR!;
ziJ21%^KxJF8BT4fyq+GK4`lH{KE;AwzV~@WKO|sZ`6DNNysrrT)PRkZ13c#jTKPwp
zTHO_ptA_ks6JM_hGMs)-b8N=sKRa-@Z4TU@_PF1zmoH?yXNs;EiNTrxKb~4=!+b#Z
z^8zyKjx;8_Y?*b>empiVwmszABj#fbtjnA>D}VG|9*p_J-=Co|PijY#+bse8m9q?|
zy4XTS<=#1aUck8QpC0+~zwOHRtEI*z@AR+QtAcx$MHH*(;_+za(@o=eD8gVk;gt
z{lV~T`tRMdsq(Booyp$Lb2>h<*z;TY-nidGzRx#Xv)Q}iRhZIzwtPdtep7v1(QH)%4(ma#iZa|f}x?iX`Qjon4PpR@FBUxmI=2f3^9cR9QIGw3_wmj}lNWIK!Q
z$!7=NiQLV_vo7PF=Q*MG2li@WcuIT{zw7g`6svkRW;oqD>fV=ma_wbD_1~DW{q*k%
z*t8JH&)&fE%3kjT=LMcuw{2tj@;+ex=)gOJ@iBq-H2TnbH2cwdG@WQYnr^fn%?7j{
z%@(vCT{h{_WtSdZw&|y}mYyy2T^no&*sP%^f%UV39dS;K@J<5lF~QF1C_lrKXR&8u
z|NMSI<|>|iEZ%2jzNeo)(EdG`e*N(S{iuO{K%|1H;J
zpYQj#cd@FM_YU;C2m0p*`gM&?$ZpZ~Aph!2ljqw9>a)(GI#|=_N%}gAJC`_%VVT|s
zC!}|0xEs_nnZ|0p?hJQ=Ghkj{cZKyn7Y|7+>mFmHnr4T6#y#)3Lmti^=u-!J^FZGz
zG?`@=y}kU~4E$>b`fu~IAU*$Q+Ruito4w9Zzy6_t|5pe49c{n7*l#cUoLO|;EzT|a
zn83Qb0__=qzEh(;AJFa)>+Z_lo*!!Z+%29l{hEJUvZtRt&{qxg69)QGq3L!%?G22#
z1Pg8KzH+~)$!&q=KL5eM^N_t&pT_F8YDryH&eT!Wk~wSm$GSSL*;BQoX4%9?{B;k@
z8MbiLAjyPfP_tpbF*YuTbV{Lt*{chWm_h$qBv4Q?TXg08uePeCCYvBLcf&QOu
zf7KGd$*Wqb+NxSQrma^kRc%!*Rc+lReC!!(>v>Jz$ypm~>zfDL76*F&K%YO*=Z0px
zdaBw|PgPsnG9GK|-}>`RJnG)mqd{(JT=!DdcGXhVzB7Tp&W1CG){{~9k{(^Pq(@gR
z>Csh7^)6Gjq_CHnPfwS?BAHw0)sdOkqw(cY2Jdi177>(TBe>w2_$
zLhI3L3axiuG|#rWXYkayQD125dOZ67m+yP@->uog#_4m&Blwe12WW#akFAe@Mu-E&@
zES~4Cu>S2UtUqUk^=GfJe)S6L&+69ej{m>I=LmmRrmkxJ69fG_1MR#0o`3xJ_kOyq
zN93yNRDO=ZoF+fU@^fm-&);XPJt{c8LEYRlP$%}^KXAW4FnDnA@L+#%Ng$7x1^*#<
za&T4f^xzqR_{rf5f)@ra3BEgcY4C%=4+lRIygGPo@Z-Tx2R|FUCHVQ^ox%0NF9*LG
zyg&Hu;P-+*2tFSCQSj;D&w|eee-*gj)RvlC-;LdCHSbQV@f|WwNNz+QJz)Zc?U~TiCk?b`LchLYpyvmA<3M{R^!q&%dV0%1Zyo4u18r}=-yPP|
zI|kYv(68?r=u-#!w1K|sK)d&Qd3PV^(>r=GWA&&8uL+!suhCzN$JgrN#^=GgaPQXp
zwKL)#bvNtlUC&*Lc1P;nefoOOt@l@Vka>5D-g(u#3-r#o-r3ck+4_2CyLY4OU2W3n
zdPm#W=<{2DLF*sV`iHmvk*&YD^^a-&rLBKL>o0HplUo1e)<3oN-`x6dY5g-=|E$(~
zC*y}ZM*o7=|L4}fxb@%B`tNT2_qG0I>BZ*s;1BZoTAZI4c(!Wi9_*&?GIDjV;IyL-
zzH441acQ0#YXiCP%yI8~7EJ<;@9ydy0U6r+Km>w!JiC`q|`sXzVrj{J=c_${u5_?5;SF$u9Pi
z+1ng)YO5IR3i!>(UyD8XuMF73&fYe5h^c2Nd;0i!Z>jjHqmu*vlY4e>*9bh2UW~}0
zTdXS1?A{RYr{=`l{>8wUZJHR^uko85CDWMPiXk5~>*n}&-@Qj1F-foWy7)|obFn2r
zmu|j!ck6w&epYa|4A_T9+Z7nY2NTov>FKwZ+_`|Pnww;-@#*}aWL3`agZoh|?;d?(
z3-)Xd*dp$=M;tY=S~neiDF)-2V~aQyuNbgRyk_y5$A7zkY;}50P&(b;@~n1xn<^%3
zCZ7y^-uc*Hw$l&dWqo5%`5b+z7*xG4hFAR9Qu0bKd8Hfw$djpQ43183kJ=D-^4L>z
z#x*zUDEa>yeB)2~QNCsB(46r?AZ}F;{Nm$$FbOm=#Ho*kdAxN88;>!!2goN+j-MZ>
zL%CTD$W|K~Tkz})?AaTTYu?$|6C4}t4788s?BP=*YSmt~RAck@^}eWGb7UMDyel&J
zz$R<uWT(|
zwYwDWV%B{A1^(mxc#EN!)L9kdx(mnrvaRg2Un||lOX)tGJBXcPTsf*d_cpG}df6fV
z+P{PyRSR`bRXnbXzAeFcuT?Fue-dcwqUuP!_c6p@d#V=HNbj3?)V(vGv3wWAM9kf>
z>gufE^cYqA-c6qn1!BWivOJ5~E`RF-HnE}B=rB)i$x*9?7iDZOTALMj?~nA+<2~iX
zfF5(@+g!%5H@G+;hhOICJv%rf8`NvX{o6CHbF?mFGW&ShyV%WVc<5fi%kI)|jF&Dx
zquFw7p!PI>x0i0V_4kAPE;LNiYidPoi{H84*yj0AF;PpK0e*ea2Z|}Q8lW$#4UmLn)uP&Xe>JsZPQJzb=%DuV7v$)^(Q99yPyCs_5kDPu=g`Tf{lVJ6nlm{U(5>$A
zSXZ}Y-y~zL?wuTJlm37^UBL!T46-j(bx
z8_Fj(v!(7)e}|Y|#|7>P_KDZIk+W2u#8@n+-!mmJugtjY6$|TH&6SV%uaBXpw>9(P
zsIf^bFAm6H%LxG)Y}3P~K|R;Sujf&BJrDU}shL;9R|awUi@qOuWN=KN**mV+emdAN
z3ACE8oRtoCvq_^*{3{prJrG%9N8ZlBUVpEk>hikKTLXD6-ztaVLx=qLYe~Vh7R69a
zqZfm+^Q?>~5lE-_`8}QF93NQQJ!8$8vUdMr?U9+A3;09NT}v98CO1v
z#~!Hf1ldx4)cJd9<|=3A=%QDCO3p(vri+g|19A6vK-nx0?!dXAo`viq#~!|kU-fdj
zAz+L7((%}g@oREMUioB9_nx5m(M$Oz?`-5-#q5(A^NEhCv*%`9xn9h;;wP_kv6a40
z24rpw?0sH9zE<(Kw_Er45V1yv&4KvY&%eFF
z;rO%=e&@uW53JUoid*j&-TMM|KP{N$FF*JrUitM=Qya
z&weqfxp#K4a(1AP75=if?w6(V&kk{6pBSr=t%0U4>RdlBV}5DZ26)}A8roTAw`PwT
zs(NyE)DvB&2U~*jd!+5H+MUH;>txIYw-5FNRTIz7m=FG}{KTMaU^^enpPKhOz)p=U9uT+5TSqUr4ED?>jtC|ff;lqbCIqN)q=
zd`DLowN`hLp1xgyScvg6!_OY`Y&$9t1Ny{pU9csveoC+-uvb%8R|Vp(_7(y;wvR3N
z#A8kHq~NrU&T#4{x%TmeUNt37C39!SbHN|QPBzhpho0h{WUSG}evM4)dOFA^S5KEY
z@?H|C&9j4rY&LhdKuv54?AaY?qx_Of&o>42ZxgZcnjj`0dJmX{*2=HF8J7>@MUTcl
z@~UTl)rJ}q%X-IJ%(&|AHW{;L5@^fWTK?|~-?afd)q-a3y1?Ap^mO#Hte0=SJ~FNG
zV-jeS>HoiEf61vjBA-81XU64s`Nh|{K>dh|=Y@Rj47B&f&Z<>=HU?^u9QAAu`n*7G
z)Eu2hDbTdiDb^MHz8g>4OWuzU5!Ug
z%RhbmJvk6JwWU7Ud0zAJ_>6lWH-uIX_Q>&B!2`l;U!5)c&tG9byZKFjU#n=gJSTW$
zaADvbtoZ3vC-#W64@i{EHFSz`I1W^=Fe+Z#Vw_?&BFwybGmF%Yjer)C$^i-9#VFK9BwuKXyO
z#iu8;X#RQr%JUrpb;w6C7XLa+-jGK(=iN#DhNe
zvfccHo6X}H+nP0c@VTet`;=fuzZ%e$s8Z|2KJN17xQ{^
z*7?g8`f86kInnT$mq+tQ2XSe-mp#^f{;>{~)7=?s?4!pXXAA$+g7QNyXYElR;%N`e
z;t?}VJ{}SU_Qrj3DS?^6SDI}o_b*uziXIhC!C$@qkTzRD~6#ZbKEE+LzKo~5hq#5-hMccMCw
z6L;19f-3`h`xuDJ^8)^Xm{wiPxE|APJU3X%
z*HMl*oD-0v*ncd)0fzy{{Q}2LI}LaAd}OSgu}PKh(=gHdf7-EqzSbFD6UX%9gB&mv-I3?ndXF
zy&Bo#zb@cs(d47W#aSEY)xjjts@D3u!9H=U{rJgokBIYA0(y@Qv|a|?Vnd$sDZ!4Q
zZ0_r+eplA@a|h+qqn^deUd`Ms#TM}xZE+4)vhh#DBVNwy`alfCvF6pD_=xc&(E6CF
z1@Wl(*S?acALZd!=aWDitYGs2s6_pKRopzOXanH99=5QxYDj!f3aWPcJ+pjbU*%5E9(YmU&fFGg&kx8J%emk{
z;Le!@+Lghb-}J4&Jwc>RrvE<}+jVW+$AS)VB|}`U3D{>m3AE*8+OL&ebhyhOoW-i?>bZPi%$B5(Yz`C~KQ8EAfYt31#>A2>&oK(kLy
z%=bR1*#`&gB1@}y>dB(do?dUwmt1mQ8K|w^SLc!6V(cztA4~#mGX4LTdVK1YzTVDB
zXl*k6|Ci1>vX6m(*S4My^lS`@CXfF;|EoLxGaJ9ys=Y^~27BHO9q;>^7}Dg
zYrglxe0^87Gh^)!;!~d&e?HUG?+Sf(_%4YJ&hefGK0G0bs95mBni^vp6mRWY$egpF
z2cP5c><#K(L+=Zo*3IE99=4&2=ZcK0j^vqN>f?E_TiubXH!n9&Y5qJW{#d(p(AST1
z>aM7L^BMEeJMGB>of7N_
zj%;vm@Jr5$pUwEi#^;UOWxxmZ%MU(k_HGH}QQIDntC97#ERfa9H&^~!qqjeAbZTVD
z1O4`B_
6%~!S?pC91G1N^eSEfBX}4_WLHC+`GkGWkQ+
z&VVhRIrz+rqqv~=1?<=x(6tb_W6lZ0T5}ih+j{AFLdNuvW8NM#{XO5NHa}~>nDWOS
za!(CT3+4mQw&w-*)%nF&@u|6b2CC=EIUm&#d32ENJ1~vxSu(^zobk^E6=V9r`Xtb*
zR*l82;^_HlEQVsbC)gcmWp6K+Kls@9mOw1n*Uuf@=6X5uX)j%eyO%GQ2jW$G<(b}o
zPPokVdhMmR=R2IeqwnNg5qKu3x0a%*Ul)ev-}a#QSM8b?BV)N9ZB!F@objgwWUyUL
zydlu++ZW)IL-OQpw54jFou#+e$F`k;=I8J{BcGU{;GGZXu}=T^-skTX9^2N_9r3n-
z_Pfse^_LFxH3R+Rf%d&*zyE^J?73Y~cCmkwd3OJY*nMt#O>R~imkhq06dC=Ve(iQy
z6OW3++R)-%^l#(~>E6z32Kq^%dwKf?`k(&k#_OMLv^$Bfdb;L9T`|xn5A+Rxe`EgZ8y(ft8dG2OUb!yg%7yxO)-^R}Y^{&mZw&wb-m63RaeHQ4
zr-Q$8`;YmhFg?%RL-(s22yD!mq3Fu?<_vargGPk+S
zsg3h8*W0iwG@1Ck&zG&Y8Tf9<4|VfyT
z(4JS;+4_(9<>Ed4xzN4rj}7#XhxYzj`(HNDFAiNkER}mUmS1?(g4)pdX+N+FZ{@)n
zT0SZkyE}c>o=w^-rvp-3-)qr%{h5{TdO+&U-|gDwpR2jL-#TIjwUvOzbLe4oPS%G8V2L-*Iifp$G+^`)cCiw{*)zpzLPul_ipnQUv~h$J*~f>^$%_R!&~n=
z0(|>he{t(CY5n7d{)vr#QtPj1{gp%SU6$Pc*!pj2{eNoxGh2W4&|lN&=eGWN>G{H6
z&7E~&aIfG%YJmN33dCzipkCoof$Ua(<-@#q$Tv&^ZF_*vx_3A^$EU8;3`_#;^k8e?
zS#?%$MQl+2*AtK?e}=t1j}AQ_h}mg@`ULx~3Y^JJ0e$>uhjqHtmvuH(Ox3B_>PrTl
zWK050oXC+!{;dh{o*KBz`2Vax-pOAK%2(&i&rH(iSpiGwsn~^O`m+|~kbTF1?Vj;`
z=Nnz(rtJyL)qb&ja$;Gw_VMFK<;%EuGMvhEw`g*Qk8C~Eopo%+I|J>{^8Uyl_N)&!
z1;tnP@WYrst*@tbp~Xt;{Sae~9p#%jzCC3|ofQ9ptc#brnhSOXrT0OxHRRNGb9vpk
z(X;aR8{O}@EOX`S&t=RO^<$1sKbIpOn%we54LE0O15N$Nm2-AwY&c?YDXUyFpa}oPxyyofcWo!vuv7-B?((IkJzv6O3;-U_|5cIj9wWnY>h8)oaD6KMV5Dho$zYIXNm>-l>a!lCf6t=xw3@xWGRA;;4S=
z&xtCIY#R5KF8gQcvS+n6g>~lHAMN^!A;0|A`dF1eVzrcQwNH({C2*hO=SS5=hSM6h
zuAawr`KtX#t*|bp$EUkww-Q{D>>W&|4-oM$^
z-)U^_F>YRv-oc%ZgRRWaK}2so;ObnJnJq9>aM$d#$2Yp?B|r!4>>;HYz;go#vEJs
zeT;i{PeAwH)?b_6y#4kr1WyipR(epNS%XQS)prBl8)^@kc>1-F)B2`=U9cstIp%XQUi-w&XSh7h4#kxpbc~;U@$i>icC+uOU@?#f
zd-_<0JY>7I55;yeJiF{IyV-hn@YD#ic4<(5Ck{`^x0k(@^HJBaS=$+C{bzYG+8Brz
z`R<3R1NWyjv}g3@06)Jpw%M}~hk;7@LjZ8|@OOvWq=p
z#wU$EWvl!HJ^HV9O-1Fjw%NyKjeSMCE6UzU#+uxo9~4ht2V%w#wFUiIs5s1JUfUa(
z^BtNw5C?aZ@5cUP@`QHw)S~ZoH>a;Vk1jT-0k-c8$a_&>&X}C1XCGT;$;r~8`-Oh|
z-;zoC{P~W#`9M9XiHe7HbL#@@#|AqC?N@To)w+DLmz;_hyX%~@(LVP7VfOWMej+sg
zYyDNj`VS2BcZEJX{NLK_7cb4+f691*Nb7YzHhX&d)}iH(-hTd%@@M1bp>mPoRQ5BL
zko_~mpQryo=-$6)475Lg@7KRR^p(-!SyOuFB{pqi(A)RN`SW*YN}lCO%*6bindgf<
zn6v#=nOm*g=Qp{&2fbZTI>~-?lWl%oQ1b7Qd3Km*Q_UZL7~QXJwwvVy^Gy-?^<-Y^;~=Bib6D%)2{l?IZbF
z2y^ZQeXsBB%dGv^wx%BJb9PJSwcVOI=kGtYxw6^Zflhw$J!Zz<2h7-ej~R12+FbcZ
z$L(jxJG#wPj`96ne&&N8P`3Os>QOc;^v)$T+b;va^F0)>hbqw1jYU3o1&
zv4NYb?#ZgNQ)i}Xgg@4Iw0@GF&+2?v^M$WfuT`sTtvXeQeT`OqTE|zlUFW9!uX9u9
zq|QwrCwq?x*mzu%#Wr-=;(VgZ9%mQLrhRS9roC;+jHd-y7kZwEq6BFZ(t$y3U{TfnN>lx3|9XcR`~c-1>*L{`A&+
z53}z+t>4}Hiqpl7zNGb!ZT+RKe|+od7qe}F#_#(D_X?hwgj|$fOil^driMTcC&AHy
zS~S)kbFiD{LVfUSO|TgFGyfL^Z2z{%o}|AaI1uz}&+69Hk~-FW4p%E^HheU+bi}RY%`u^+bum-d{xiWf4KRVH>mhmPV_ZbIguwi`uo{l^W!~jzH)I(yPFR8EQ&>;Vp4H(R%))|
zBt~>pFE-x!wejAbJ2-uds#CT@`BlE^`Q*$k^iys2UEoeuH|pnWu{ro>K=q7Y?LGPLv2MN=n=jqDb@$d8s(Kior@jN!4g~J*
zNub%cH}Fh5HP{@eK`~wktb2d$pKG4Yb*GaH_$O^l_nJWSy_#mOY^djF{k*BYHOKz>
zp!WGLdTT(Z&qL1%L(lKIivQBU&${(`JbQKqTK;k@Or!lwc$ny=#*Xb`)%*Un8e92i2NJrk=oxuUlGQ)&)xv!6)qX#9ud~Cwwl!c!ogX!!
z7U~Qe?+Ki}{%14rEw*{@gp;7Y?Q}()$pnP)$lowtKoAF
zSHmX`tKoB&SHmY?OYzm27UN0a{^)t>s9g84wy)-RFJn9DnT`r-u47(x0W9;~e+$#xuN>-ka+T
z_qv^x{;ZF>t=}AHvhE~4faipJb9}$*pD8`Bm@mgGhEVqbKSuuky=vq~9}Yj;mgDbj
z7w?gGDL=!yEH7EwfuMXvlfO4`@0}WK4mJjIyAW946YLJOx-0vi>v+xIbBDc?QstX%i;y`|>*aOyvy`*&Lxeg4!u^xvzfWi`;(vieYOuw2bAc6{|c
zKwmq3oo!lymkluMd(@3H_O8oZ+1&d$$^85b{{H^z?b*#A_WzIzmJc&jk5drjJC6L-cpnT8p|H*q~+3$`R
zZIP#neIJ`yXML$Su5{MNT3+ey>Ft$$ccu}
z`>K83MJs>mMYHZq`8_O0MzTD+b2bEL1iOP51+NHxJa~8T!QlS{$0YEJ=`RY7%~&gW
z?h86k3e=(A9k(gae2=2_-`(GEaBBK}!1(!}U8e{0!8m3k^<>Qj?D^wBD|_tqobb8d
zy|*!7gZk=i_)uuA_Ej%Fq?5n3!CpR!AG!P^%RC!41?(cD;=r%6gD>o`SB$iZi~S{!
zPPDv~t=0E@bj_kY7p#@7vtl8plYp+0T|JrK7ieVk^=Eu$ur?^aD!!98Pfo?;nvAtk
z&MceAo&*(#l5th$v{42>%~h=Xn&UrtRYQ}E#k{xe;?UaO054hMB7geA85xhh?#`S$
zj=aj3{aSCQT4CpCg{j`mX4MDsQ8X~bGGv9alXigKE{3S
z>CwvOe$UNqH$V8@zpK*ChKe&=)vbGt&Cad3P6Bzw=kNAwlj;8t{vLvgQOTxfXIuC0
zSd*nLYwjc6S*bfmebBWlm<#CkyQThPc>hP>%(Hb%urAOlZuJaw&#nYIiie$Sr_1<2
zL)}Mpr+fBp4#a>R<)?jsuk0tkp4B}spMVdOK(kL=?CJOQ?_A?PzAwkmM&JYN4#*q#
zkW+q)I@mq(FK3gII2?ZV9S%SHmgDd9U_A2nd6*R+xgYoR@#*D<^~-pB`FIys;Gs`b
zZ+$(mVPD{!of>QoHU`d*`^ox3V9%al)_q$!WryZ0^F^~qoz{KsE)?7P^KJ5r-~L(r
z<;*|Js?-Bd)FL!rOQ|o
zqe(y}9{We0vL{PR+ViBWT@{cg-#-=bcRpZWfA?$+-N&GX4KSeb*qQ5t^_!s^3(7n7T4)kL}-!A;?x;?ua
zPo}26sTkooyVg6n~(e{`e~uvF-1Qvbop9y4{mc6OS!slo9pwlv&|jX$vd&l^)|1|
zTu*;0zX!5pXX_Ea+-PHbtIYwsD_6#FeCyY@{>0X+S?j(B(4Q2@q5YcN827RK#rzJ!
z-p<#C?tOhl=-#iFgzj^5b?9E+Q$qK-@p}~e+*}a4&&_>9v$e0+oo%k{lAAlWxjr|y
zYID84_4^Zhn?KWjS6*-Thud6l`}^8lZ~t4{T<^n=wYlDpm$x~-RE@nTb9~UgnmK2~
zhCsiu^_yGo-cl24NK+HWz0YSiyZNErA#@+(TZQi9`w#g&c71I9uE9R89}3;ee_!Z6
zo^K7^$MSWd$C`L~o9k<$em`Je6VGUTy}eItbG^+MwYlEzJ#DVH{qAk9w|~CP^*-FT
z&Gml#bN*2&en8d4U$!}MuelGmIeDnL_qI9jS~d6PHs{>e+-ut0?Yp^`wK?}f@m<^I
z{26l1eM_5jZ`9lq+MMqYYwn?K&b?A|lQ!qi(`)W-ZO*+@b0@dCle@Xwwz&=6+&|~v
zmKCS@Ztk;fP7Rm5kF~i?-Q2IVIW=B%2;KYmn9#kC7l!VAJU4XjQk&V^=WLakIRLF&1Zz}dwS?Tf0u>s^Y@6*WB%@+xtk+y>X)yY
z`ZcDj_wVSYYiH)QzsO&n@7F&Xy7&J#Lihf^J#_E?PlfLNe^uzi@rBL4>(tn6%;w&P
ziz2hn;hxaF&AUSP{3nF&Z9Xz|Z}aE!Z({d0eSI^n?a%S8R^Vkv#rm!J
zM_ubo%(8)>#e3xny!~gKQ&-^aKl^+n|A6aqHuRr~p1J~W|5@pe{`}y5)_+!dMVsqC
zD?Kc8rC(0vb9bQe-}k#>*30?p{9qKt9r-eGv_byq
z@H|y}zW3GGWQ<>KwAXa|$2|6Y-?t1OUA>)83~zr9FA9BJc&Z-ucCwa>Tkq%X2bsqV
zGH>|Im&aku#Zqx%D<9P1c|p-?4Q-!w^@J8zw3>kn`A+D1Pj
zeVx;bGUhKij|{}Zcz;mmQhjRX)tdhF)~g+K)kx{A8Y!J>q;#r}(y2B|r@Ek%ysC-v
zv1)>k>Om|tykzUivZf9-`8B5R`7w;I8)Gnkb_7Q@JSx4X+g$!H2kOQeThQ{RHn#@+
zv&Lrgc;pdI57dOZ-W>3qowNAy+OHS87eugnb4KjtC*5W1nv6kSoC{<1;S8!Xy5vHw
z%m)V=$i6nR#o?QS4FO*B*JWPKT6;=BuQf4W47LYiGTN|^IXWvo;&)^$!pmm<^O|uPR0vYkWqfI6~y-VHm=y}-7|eW
zUlh4~+z{}Ky)Vw3n5YwWnwP`HKpf?3)F;>E*t0VbKYw;g-hWv_UdgC>*caYw15GWM
zH>V!OeSILV;>-v0djoM>2r7@~WXxvGxe*U*>eGHUy(Bid1LfmM0YCXDM)b<5{2#1`
z^G;-~K>8#g7hiV&B_N#xATED^{Y0%CvxS1@0$a4!S_+7
zz2YrSI|4ScRqf(;w?)*A&fE89qCanBu%9g@%O3A7-B-XQskN83H9GNre`vL?
zcKPtK&~jfs*vB@FoMQs}ejp3#2%kFU>tf)XvuX6%-l_?)WScp{Nm3m!cccZ#ZcVqUMM@!
zqaNpqO|#;vZq^6;8;?5q;ph@udejM9%>UOJ^ULL}Z0chtC)z?l#~8cb@AAc*ePSs-
z_K3+VTTIkL#e|>Ew^sVaqnBattFqU9Qv0ln=d2iQ$-Ej}2fIpzybuo1Rvdi9jR+Vn?`ybK6h9?Ib0(mz7n#|Wb0sZW=My9q9
zRDH6UjH?1R+ea6FOSYbzI?GRM&%*y1JY$IE*j$&N535=%{*h0e->dQA
z{f35$V=pu2AMyG8Oc`H)viY)HOsk&z*z%?Fe^ti4{I#Lq6Z!n!AGpKRK*e8P@bo$V
zsn}7rZfNV}Gx==&=@o3vai7X4{?|ADF;8??ZI^HS0r}YwYzx%LDZ!3_Y$*PN_t7^@
z&yMr664tN4Q|}oUg%7WI?F+<84CBh7cPcz$!yY-Q`ogQWtxW>WJ>YKQi-vb%khVRb
zr+hTt6_Bf4pEIkj*m13iH1}D}ktJSypAYDkQ?;}=u+BdAh}$`V*lXpln6uG-IsTbA
zs&>`FVz4=I7x9f=a*QkfyE6th)Oc1epR?v`F3UH%JNQ5sJ1!0Q!mi%dH?;a<&uA~7
z`6?d98-uEUviMZ8@BsgRHZsXVZwSaR|HjPM^Pu8ljZA&j?-?0?rM0_0GQ@MWs9dT`
z&qA&8RQlfL3~{ulktf
z!}{>gnqO{?kM3f2oEvDRiw$?1&fM5GdC+=$%P01ewJTT`@ZC8pzlzU1KK0{#(ka(^
zYo`b5NzI5;|4#nq2q~ZHJyPAB5b#IskWCJn9cX@{*?^vFv_7es@|QmEjQqsg-ytGFgeBTb5
z^|OPw#9?vk>s21SJO12^HSrNs{#T6o>EV-FL)+`V#q+lC
z@L4`9)|)e48{pOKqhBi@OYeN<$g=mz0hvGFWZK`$R6lsx*z^DIRoK9%s_)(wI@rW_
zcbr(T$vj)$-elX`+mh*Nosd;^wVHd79i@{@W4bFY{atnc%mexT`jN?+n6D4?UkTVR
zp6Wsk7|*&3<{FO}^!Bi;zZ3X!Y4C(F$vgj?ZE#-2^c^jx&RN|J>P7t7BhUTWr;mQR
z@zp&;Z^?XTR|6%J9Qymaq5Qix^BTL%;e#^+f1gz>?6<~8xvH}--aZSyHHK|U@BYQ(
zv)~JZR|LNsSpRJLwdubhI61gSus3*c;Jm&oc8dew9v5s4=+#PZ^>t1z$r?VkYqd_s
z6@eJPJ95Rdvq*mP+y-Wk6;V=YrRx--PuoiGZ
z%`)`mZ4J+2Q2W(oe=fums!rwdK!Y0m55b0DZBWk_>+0h7Vu*N(`&iF-*{=s@qkg}`
z6&a5@oG<5qtW$y=0o!43K!%*FhdvMWXUpuqIKYpm{9)&ZVrSLwH-)B)KXhs2k$+>k
zH}AVq<<9ek?tKCM&fJ*K^_jz8_UQRkHC69K_LIfO54T+4kqdr0FZRhjzPUi0DmH4t
z-rsL~>t3oDu?vsJhObtP)XGXR+8LhJ#7Ml=l{kxoamBT2xAe_tO`V9zAGDZ=U&V8C
z#$tk};{K7ww_M!SB>nyz&A9YC*S&5uo1Dk~yvP}wKH7B2NpI6Jq46x0-;cF@%jI_=
z`?m*TTIbIg*iNT$*P_VAOPCjiH)|l--}4VYhu{x4o5nV{K1>hh5JK_}ABkF}M@24K%SWIdd6XFFBsSN9GoPS{7zu
zOV(%2e>LW!`jDNYz3g%p^tTka6UEjUx>Mrm49SChIeSM1c(OF*xm^av3xWLZ3GnLC
z>e1QOo}aUQ&-CQ@?rCEie=!QzWen;~@4nNkyT#T&zV(kuPo}ftcY3)mdOaV=T0yhyhW>r+jL;vCetxpqS^UE|iSN?D`rUn)
zl#lZn)B8u!Yu;VMZ+>nF)c)nc_P}}8WY=?_jz7*Ov{-o$sdH_PFXAY6e0M*M@fX{tWnca~6#q}pux)47+5IOo
z)<(M@-Q=;`_bFtvyXun-2O2#|ud&thSUt=KeEUoU>;JU%f0n*{+MIdy=N|5JaqpW+
z_n$YNf6@BCT!rpCHQnk!9{M`>a|57R=htT=Q!J{^#Vb=&f8<>qADumO>8qyx&x}1E
z$-3NpZpPYc+uG-6tXQAj
zzPurjidpxnn!@wCz<8`%`BH=K&ocve;Iwo;a)61Hf7AtvfKMzZ@2Zb+dHB$8^w1|z*e@6am72@^N-Dre`@_dH+%S1_Nc2~
zKYeJmyBLVw`k?04WXvA5V-C$GaXvDe?5lNiHw2owigWp*zcM&2P#5yJF|hB`!IOgf
z1mfpee^qcofQSF$(ccN~r<;l`U%}qxbVlro7YSta7uX-k9V{k>Fz7GU=%oh(`
zo7y}ba*Rg~)s)ZP>=5@eg86{nxOiy(%r>^hm$QSpFc_01c6xI3>Pzq4YI8uBo?q&g
ze0uwwu(SN;@Ag3Lnqy1NIRoluN09QHVo!R$iSbwZe0P?CjvC(_efh@s^?|(Z3)n3W
zM+JR6SEoW&eH3AEFLt%2BU{hAse+ZrF{f-!d1)dXD?M|XlaJ125pf9`p<
z`6NSL)QgD!%t=#oz;F%E$Zw$k$8g_-Z#@3#7WPWdbP`saO<6mn0HQ)DN
zm$f?vrv_xhgMv$fD+0W9=xhCDq1~P9Vl>~%kF6Q=Lt6;Mh%f5AaQBQi1s4bVgGp@E
z$aq*VAIQ)1gGUB;Y3mh}Ycuz`m+twkH>TInKYQVWeEdBWZ|Cy1*=H*|)WNYaj6HRZ
z<}=K);V%sB^QdsV=OO#ylKYw}Nq8ezwtppWbGLtA&Qm$I8&GEWG|
zE#Ew!=sz=1e{$>YIXk#jCaj~YPB&*`M}=Z2fEa(R&{r6#-D%Ndw!v6>&Va-1;+=*gZ!Hwxy?!4;#L**+52bgE}KqtDIQBEU@qR?5jGe
zcaOE1cTP0+vD02X8%__(fAi#=(DaXWEe7^!6;J!i#+@0@1y9KbP<(a9<&YhH?$<|$
zeU}Cs0_$|&KJ(t`O6KOaMutYOaou5IpW1Kli6NHrf4RMPSYhuNyZ!V9TIHNwb>8yp
zyrw@d#7=n@%Q4S)j81D})%(k*I(zzY-<`s+ni$zz`<;Vr0Xv)*v2d@*DVl$LQVVie
zwd($>8o46l${~9nAIJ}T`QFP>r#Dqjwl4V@ad*}p8f*!k7QC>H(X(*Z7zMM|`ngwS
z|2t>M_+Xp+lk{^8T$bg;ugPZF79A
zZ$Ka2y}rI)#Zdk0Zzc!MpzTA=ain-eMJ-XUI
zt;^XRL(7+SF{8tnY&kIYof(^~myEkchC8SB%QrigyH{qNkz9?-{5_`4N4zSA$kC~R
z@hteP{@~yZ!FxKs&v)amBPV!Ra9{~Jvt*n5?twpI55>Fgf6tArfxAhJx#WkD`34mJdGB9C{^eBEJ>2)((jkvSLG^RQsPjUV2|YT~^3H1f#b
z^8@R*543B8-};?LOzlHo7p!~b))N=fi~H%Zp?qY+)<6ubow3APmJY>-{7dir#`mfv
z4So9BYwlU~9y6!)zCFD$z3eQ%eIG+7pZoQSE4k_p#Dj11f%{qQ8TYY1Gd9nP^;wyB
z&y}1$-p&_)&km2gux}D*?9<9_`bXbBl{vQW3G5}~9+6c((&hQfCylJSM?Kfo44doS
z1^>=qZSeE?o)B-vgM9P7&-a|+vz&@u)gznk6+Zju@_w`_Fn{mNiw)VFRB}PnhtGwSV8t_wm^r9)8V=5gYFperJr{KKJ6s&wh^YEBSL?c<2+`
zeF52f1M(IEGUSu)bE13H!FGG~_Rz<6zFyYR_LVLAl9ONYJ*{1HJYPxv`z>vaQc8`5M2;q{AE?`igbw=wn@TbWEZ{zdJqqtF|f+
zbdPr3zu84k@3Zqsuf`5FNw59e19e8%p6p+$e&(`nPwlIF;)={wZPMv`l+8gzP4%3T
zen;RL4QvCt*9IE{pZWF&eA^nh3vRA`m1FwI=4;iVSnzux#)=R7FAUhv25}qh=;h&?
zC2wyh??K^Ntvs=qC2wCR@BAg?9hrGhck*#{Ag0F$HGgczo~!(F1}blQ?=TyJwSkzN
z7oBol?=t2y^<_V!P|hl{`A<1NBw8JwHO+57xwnT)A}yRx7uE*DJXX?BtqTPAXbJbwketOo}
zE*1~!VzE2)tXLeGd7zsw&ky9AJUQ7Hm^a7YZw$;|6h!=?pEp^Xv9*%NSG6!7u;qd<
zlR4Hw#jf_19X>bGKnGd(53UGa61*(X@RBJm^1@ENJ@m?7KYwhSXU~OUlFzco9{aVj
zVPD4LO+Hx*0e#l(T}p4=0cDT4v8QrnFQ44~&X72<>A^9=ocb-h=oeS*t8JIq$t&9)
zvP#>;h|O#jhoxd9j(u+W7|ohz!$X@5@fA;PJ-qPzV551+CQ9(cwN0!A+kk1rJBaLKa*$85cyv2-0*c2zWJjU3V
zGBO^y5+D%UU;`4EVmc)BG!i-qkV0-Qgj7;VBZLG3Apr+&8ZAyjF3f%Yd%kD9wAkm&
znIg$1TEE|`)!zEN?^@rt_c>=Y)`nVnX2?19J%v91i>!6;-NO7Q(~I*3A^k@z{qvXp
zx#^FD)X)cqmrnKT-nAw#?pp+#KNRQa;m20UKL6FyXs>$3=$AyvzHq^nemd|R3W=B9
z#@aJ_B5T)$%CEzTt_ApriSN}3oBKlhLiCGK
z4{vthb38Qe;k8E=b+2_S$BjV^cMjW+S$rnfI>w7<^f%LW?we=*KV52!zifU;=tzjq
ze>Zz#J`sZBp3oSlxa}PZT^4f2VQRhS5hgx2zjX1@x;V#k`LWq!dllLW!HHe5y=;+F
zkL0Yqd|8v@`pkzcuXDf`Sm6D*EE=n6woir*huA1K_>tK7?p$B0-y6O$y3UvQwVh1g
zZSD`x2Zc14k9996uoC0(Q1hh5$Xh256L*@p)e9``wdTe(HAg2NddR@{6+9+mX=T&{L8(dw7d=`I>7r0dLqg
zF1>lN*Ndb6(eK=RWxn^Uj6E@J%EbdqjPAbbXnkClHLbZ2BOlHAz;7{+81uKd7hiGk
zWyT%GuUzcIVYIJ?=+@YygFX63d*tdvYmwehUi7vWTlZOB$B^!9Ty!IPz5BcC$Z3sz
zTBa
z_hn5i4@Tiw%Xkij*kP}}!5FdmrqGGdbs=k`f7^WqdUX_f-fe~W$M$QoCe9H@c3}vI
z+Ac2Y;h~TwC)Ta;Q+@q>V%ncxZun^(mau^3Jt3{{GHl-&BEz58#<;TwD|c#f5FcA~
zxHr!{XRcb;@xjbt`uxzVL!Te|#?ZHhH1_#XS-S5IvE94Iv(oyrL$yuk-q4>~^7Oj+
zCQp1RPyG|0RvSGt>ZIqz{_zlBU`B>-t+V=5JgP%q+*&8F_W8ZIy?*hH?%6l;+K2;_~BMR|N*2xnlE=EPKYV)YDB*>*GkqTK>0@zwO^i!OQQsy6*R-hplyYgV{@|)sso$U60|M$!Jf%}Er@1Gq%dcQw2
zIu3=hw62rie!rjjjMSQcQTU8YdoosQh_0JM_B1strzb+rX!EQ###+HM@;)_l&6*ft
zuFiUX)v+~lUBf4TZ&`9=?p!oJKEa;9`caN9X9RE0!&?_U>UY!wC-xf)AK0osK73A?
z*cj!UHN2X*ih(uw+#aG6j<8_^W_0NPQF3nloMp{t?dm_0F~5Fc7r%$_xnU$nek;VU
zVmxE;dEtf4P8jeLiC^yN*r}f7L5AvnRnb4+X9h{^L2{trc2
z>zn>VA#w6etBkq#Nq(>oXMAeFxhm03?^ejZ@x!~cA)oZpPcPZe-=(a)Ao9MihLdxk
zHHI+Pi8Qvj?l+yUg!TkMDty
zJo4=Yp*3YW~Lt3}*fC((oJ8
z+nhrZ4+kp$riI>cuUsyFY8~oOYC;a4Ld!%V{Lr>qFdZ!
z3|U^^0qM?S2ABT60^H2~f4Ru{&a?9HBEL6y!TvssQAGmZCKvIsY|C6<$+
z!y&v{^UF^JlV1%c_}SDp@%V0TG&@FfG6KM??&A^05$6+gbP)i};PH_zO`*Jl0c
zp-&2ZX6Q>p-xSiyPapr-_>&uK?9DnGT4l`D3LoW#yg2wOHbmc_$|n7HgtkI-S^v|!
zv~wc72SS&HU^QdLCQOPGf1Vst2Yl-HU2OiD*py2#Y`TxXHTz`g95KE!b8_{;8Ir@=
zr2EfCR{f50V#TY~cecea%Fi*-_vaR0;5_Qg^4h<28+DE`Z_@j1yU^Pl!;-%KoQGfE
z9{ITj#W~l9_z-#TN1LpRHNXnVLWI{oeDl|I&~e
z9M8px%%2m|8e{vuYdU*9@8{c(?=@d{=bXuRPzi%CYGjZIb=&UC92(BnuO|8!v3$
zKcp20etl1Lx7OI^7rd+?e*Nv}KA7I~>U%fvXZaEQu%k;($o%=psM9(2v3}Vg<4$Sa
z@dF(XJrvT&Sffj>^?O76L*n@hu_f;DGijFAGO*y2I`sQDpOk*48#k=YJeO+zq7AmP
zw2s&PO^Djn*Z&WW_D+WA7sHr~OwZo?XU^H~|Np(}^tzCK6OH)2JUm+S-hQ;XldetrH?6U`CnRTZ
z6|a2A*&}UUv&ITuJCVF~pKdv)8Ol_ico*E1C-uO0d6{dV^)zBfN7w1yZf@Pa
zm`{eT4&4^Au5IPchRvyvm<}v`YgBFeonp=S+3V4}aJx5iykmW)yC;S>vagXM2>hMy^=)PP{v7Oi*`+Zum-xzA168e*F&*#St19l#X#f9DF^xhx3Db(C<7qfS9aW>~_V9a^Xn%;VIUX0{^
z#^(QCu(>vSBR1@)L4E7B*t$d1YtKsksJ)(*`Z3nnUt8?S)ojllA{X_ucIrPr_&?qu
z|IeaNy^s2`yguu7t^ZY}Lt)9h0S>u!VYex=|
zTCuK1_@?&x-ru*oBV)D>hK_{z<8N#5o(Q>9=pj!JeXWbW-IX1@HW8-9qJ^s!1_>O;nsClL1rVuPImLJaYEf)QmdjIV|gJqAe2zGeo
zQLU@(o-tU^+4Y`Z{yV!r8VuYm>>)AT5fZ!F!}IsT)4Qu!u}il`KU~PuwVfZEeCWN#
z=RRB6{QHYdHg@vu9}Il;?dr(TtC8J=BY%ru`_{U8_47D2B^L7PjE}8RJaEDz{`y&7
zcd<5N!!PUVb#G|C3;$taac^#yhkum)=1;6!q1h*~_%8GxPrP!;*E>TuhO)hG>fHKV
zx6Rf5?1^bR9E;tE=ZGVWG&odGu_Dv@HXe0Uubw`5!F;DX3l?~4zgV@dT5ELme5kb_
z3mEE~{nikCoNH~?L*}1^Vbk4F9GxHZNZii+{>x2Se|G4_p-&0DG4y$%9|(P5lJSzz
zr-lAW=qE$}E%ZM_8XWmaubvOj3i*Hr+4)Is?6!tiia5R
zIj{7|LDwE!*6vBK!Kqlm;pPxo=jUH!fo=0uNPF3t?rdE27Z(_k=abghN1mTaj%FVI
z7aPBq)A(-7x|GB7$A0U~JHfpf*Ix5YR(yK7fakAAkABp5By;EE%It~j#}l8}i}$8`
z|6gu{yEDn2Mqcc*U2{G*p4z`Rv8XHgc}+-+#j1Jgymte8Bi%8~8=0MA_}2>`f19&I8T0w6A!p*>gy&pmg72H+tZ$74
z-h75F+~-=|leI4h9`&2upIUr`%jl!pkV{RB&g}6}b6T6lz4uP>V?$o(9G?q6z1W-Y
zO!nx~*t0K(+WW-k+V%GZ_0ztXekd0x|Hu~;zn=mFe(HT!q5q4EJXv~fTzYvK^}_o^
z^s?(*Ju}1>-x?d6_Q+lqVq47C`S1S5E6@LSh+7?0(
z`ulgw8qDi6*(|T~&lh#T2ReQ(8+dOH(R(sHT^XH=zPQS49??}(?)9-r?!=oUx!e`(pL1ONZK
z_(WfZYv1&JH*_BO+dX>3Esoab(TtHf9FK)Y88MRSzSxcV2$%m9<>vAZ??WNEvsNsc
z^Lv*)Hu%6UJ;rLDEx9rN2dM*o+#J%w<46c5-<~}-VB;AN54z}~TO9VtUKZMPFYxz)
zkQn~+5(Bvdp;HUl`!CsJA8m#B*!Y|cJpXl(S7+p{{kLU}Pxb#$##vt1Fu!0#2Vcni
zayI#juXg15SF&!Of2)w@y{-7th13B#_T*Y`zCXlg_;;^0!Zz$sagt;9eszg~kIk(Z
z<*c^lR+BUD=K8;|dDhAupMHGF9X-yZnD{ti{%f&Ij*nX*`~3O!tn;@z4=sEA
z(~gDsCKf$;v54QZX`Ivd-xoXdH@+;b?~Cix!)w%oM;!Rw&uZ^PNRDp`?FkhZ`9Kec
zG<7SN?~DOD=^{fHzT%;W*NDgeh>SS4LiqXqKeHyM_1k)u)<2(82e7VfdnZGOLu~Qm
ze}#GUgYV85xyC8CeTT7rJS1PKas*68x=kIT1B6p*|WVNFqIW-q&
z?bGu;!I_^351s0i&i|c>GX%5hwU1Y$m%rrr+M2JPp1c2V(W8z=J!Hpx!tFQ1Tinz)
zJnsw9FIF`pFULaaf)D8K5FU+uYY}d+Rd4hdv#YN5hcxny;dsUmTTG*0t1kTb=zz~}
z#aCE0ChI*bqYU2D;oX#$2W37*38hKzOk+5L*rVyUuNDt!YQ$k0U`7b5U
zbczXn?vd}!+Q`R$?+0|-r+3`nllj*!dgxG>;`dC!$DffuZa(Q~`0(zNEV?MIoc-04zPdPSLukJp4)>@bHaC!9V_bmP1^z+%@mo>7@D<6}-
zN919)Kj-_3ZFE#ljLyZ+qd_1*~7_W>Eu!F%?
zNE~u@JY@Y~sOS6WvL+5|&d{-COgBH@8QayTufOzubN1N0DmKaUy*!69=D#{<{PKj{
zb!Tq7Gd^153!5iG?rN=Z($jmic^zZEI`-#$zE{@N{g}@zoy{k_N4xxnxn6AhLt?vT
z8$CP4B%h;hF?qKZgM8IiV-eqOV}0)pvA$2%#yg1(`f88<(dNyW78^ua_U0e%Ez&gI+kzv{;udzcdrP&Iu5-!y*#+{es}inU*_r7^`ZXwO($IU
zhvbqzdeyqR_4~*6tl{mwV$a{@=)ZfZ?dviYA6dDB#TR9dEFXVQ{21#SpZd=78h5zB
zf3z!BGM){)u_@*cicNBCK6$a(+>JK*HRB9d=Vv@y;?nHFxERR^y{JCgLwAS7qp^dY
z5xO~~rZjwP!OT4)b~^Ej^@kG&>}TEL`n^kBbde`>Cc+YlxHiU|y@MfmkGx{11K(2?U&Y#cL_X=SpW~hGdl>P5XL>r-s$PtG
za;>i)4Uahz&v>6*7rXf32ODwnVYJEah)MI?8tA|0Nan_OBkK9RKR&@iYdy6;Q^R}K
z=i0LX$%`5j--(c1(`B8mz6VstbF-$^UVFTi-IKBT)e9d?&DGt=Z~bHl#(cXhZ(C&f
zA_n_%-1_%Eb#vzQ(#0pTsD8a7!T4Ue;UB=o@{4Q_bE`1_*2XH}dx
zhqAP8&H=27GfZKniNAV^*Y96^b(Y~pAH38OJsO+uA3l1@!zLN6I_=39{u?I#>YQc7
zcYDY?fjp9ZT4XoHH{y0OeEcKtcNU!M10i@?cNdy_c5X$VHTRaaO|my-UCj2X^9>pE
z$=U~n*m-?=x~h+zgP~cDKYKQ;pG#l;8-1v*F@ABf-S;NA?N6NU(B9ADabM1IXX@_%Thr*{$@!T9zZ*%+_czloed_F>U9=ZM&4M54UgNALH7s-KTHR
zvq`pgKVSp@XcrE5OgwwCHtTe5dOl!}^LaEnjA8t&U{RenXU-Pi?hUbtS3bnYf353{&z!CgjIMqT;3MCick&vZ
zyTT)8`|M?U$?$y5CBXAV=ZWWBGw>3dSU)Ji!B$>ju{Si{MX=FetFE=?W_%~zlXW%!
z!O;in@{jl3CjLJVepusIn{+%oYo1B1HMt(=*{63e`uZJ=Hbd0`d`iR)Z*z5Dj@Ei__r~czZ^m~spuKr^gi{Bnw
z_F!&Z-S^DH@~O+b*k`)lzcW4iYJhytqcyR>{O&k(S9-QqA?;ntum;El{#*EKJ^qh<5QtgkietYa{^}GF<=lz-QBEBX2NV9)e=)(fCe0cBm{UzLe
zmT*3gZrIzGb#`GX7hk-LkEd4$u3XZs8*qv42=dtKVXO=6dCkao)ONtvJGht`7*oeG}Glh{ySbt@$QC=M$gz
zFj(`;dD6QFjLEJ-8vZ*&^x7BO)ge0YnX_juX7lEqesjHcD%87oWg%^+dZ--VV9=a@
zQO3I=x!4WgrQnIFvpF996}>n~i|ePo(a*-le==8x@bHHX|8L?|daXL>^vp2FtEnG4
zP#|2#0?+$0!3PKP51;1G8|K+Qd&l8@{;+5M5ySkJ%x?|VruP$f-it$G!vB%s7Zbek
zd5^&ZL?X#eKSuLx;!1P68xgv1}wb?Y8`?ievP7Z~b?INVvVA+LrsHM}>}b$)2p#ou-I
z#Ki}Dd}EJnYh=U;&M#czdqu{5Hi}g{6=KVt?~8hmv3D-LFWNybJp29BTQkmU+WO}#
zwe!ZTZRhX(8}y1>oBbX2*#F!RT%T%^b~FU@heF?U^_TA}uI69&hWEJ(wsHW|p2=~3
z)wB=ilOev7d0-f4c-Fp})<*mP`h9MH-`O60)!}@Py2&@5P5OTMtB(G&^VL^>`V6`;
zHq?v$-GxT{ofWNqx97i8wkQAfJV(aIL-O5whb|a5w{lh;&XAbZ7C!Q?3f=dP-~9RJ
z*ZFyI7@U`$AN92_H1n!CeB&8%Pt4C5d0S;&s~ux^#Ho<8({pmZy3~*u#df~BzW<{>
z;y|n3I=_8
zXLpr7jhuUM%!j$wJLokTzd6Ldd+lUsj7bci7;>NB@m+#*IrF?eYvs8%<5zCrAy*#q
zPYJQVU0(SED{)*F($2?kzSrJ%e)F?D+xh+J1J8x{?W~;0S-C6yOP2m)($jS$B(}ew
z=Kvf!|Kpj2of6Fv~(=>nOH2;Wc{*27|
zH2cG^YeIVOmi$p?SB1a+TXSZ9J%3lyxVrYwvPRxBsB7PuwK0}&nC1^p^Z%N^8yWfE
z@xRafu5RC#VE@u!KJxsF@Qm}nGtK`>=3?cO9DR1?-orY7XMRyfUONB5%*77}vFP#N
z79y{fKkgr%KAmp8SKDy;rpUsI41Dz0h3F=CW%j#Qdq4WW&a7Rt@Uig&%Nkwf`xDDr
z@x}Kg%i0*Q`ap6NO|@w|WLVyOM!y~sFUUAt`IX?=|K-8l8d
zgrDZ+Ge&gkVWq!*>D}|@o|Afat$u6i4=nwmrFYlZch~4|UHaRW{^?79$I{=q^v*W^
zXD|J8mj0gfWbv{6Udj8B(3gc?`HxSZ{>S-8AAk0roId@I{K3qR*>>1{I}Dm
zZ~v9kr|iQYs8EfVJ78&myWXkJ|{8sGuTzzEbbXfm)S;xz^
zUQYHeV|>=0HLQKqvewTY_CI=Ad%uNG&AV$qG~_(s;iulZdTcG?wcdWN)fZ;(?$9+M
zO>CbW`U9bl&7E|A`tMV~Y3i2mY~2^y3XwB@W(e-acZOhL{EQHr#vc&kud!O?qw&*2
z&aClmp~hi;`!eUhd26~pzz%=?II_&^%dN}2{#?1t>yu{zd43&T#`Wu#WnSNU{_ykV
z=4Bsd<~^s*y?M{?Q0-
z=r2yzijlSA1J@Co5trs_Z+MD{`r^ZtA&n2tN_{YXS_mI($(8uD6{4?x;jLfdtY0vw
zU+}75u&iHju3!4*$v)ip05@YK*5YVhAJ{RkAAB&cFV@ZL4>|MtL@!L()nMX|(dIM5
z|JvbyZK$E@A9ahV@sit3y!@i0@ixB3TmS0^KK%6sZszr;XQc7UpM8EEU&j2pcNz2f
z*fPfFT){_-8hpmORWoXrKW_}32(e)uZ^!oepsx8=dTYky?+hIZ;TJ>C9XT=6D@MF`
zg>p#x<4@V@*Q-!7x=VWT_1Ozx^9W?TSGA2s&)9nM4RulszdA9Qqm
zJGt`OpLt)LHF4m%I&>tY<#p?{_fvCnc};u7yLMgyPoK)V`th#9S2)QLJ@uL18$x`h
z4=^;7;n$~!x?Lhcf{%B
zHaKN@{VcyRy*xSV>Y%pS6C<0i3GwUGLaz?t`^=EFw}r@h9`VV(^JLF+Nxs^vCu8-j
zH$N0&i@avNvT_S!e8q{a`pS>uGh$`jIE-t9FLS-VIcsvk_u5bo8Xd<&qm2WZ^XuV|
z#&0RD_ldbPp?Ajg&V>Hf5WnfwtkZo<
z$eujH=bF%^e6O#5=T!dbe@V#9T>R`FUB>3>R1YJ0+8+`x9pZCW%EL}_@FEAVQD*cf
zTkE@^XOB(%aAHH_uXXm&u@L|Gi;qtlJk`Od-`??%vqLXCJ%j41=MeTkl{0P57UI9N
zbajaTbdx<9vga8AzuJSvxJPIA_)%ZPgQ{OlYNzMbx^^_gA9rQ_Qb+ve--uDyi_y7o
zVvDcv5C@%}Bd<)5ADsU7khUpC_rvv&oUz
zPK8=maOHooX1n%bS^IQdh<&!j_&Cn=l^F8Ci`#_M9#L$-Q`B2|w{@_|#i*
zc~$6h
zLh$+2&}&0*krVH~tB?l&+GqFP5L@)KGwUvP^{1HK7vB0y?pSEVZ8x#ObdJ3_g2B;{
zzBMz~1)Ji-r#Dwmox_6uV){_V8oxDqVPsCuJ80KtTXc2*@{Gs*OxO1D)aUVBcpk#s
zUU~E*&(#Bun8m|)`8Ai{9M9AB?_By|`#@;suWtFN?lBg6+1(%FW5?UYz8n6iS?lWO
z*!I;A7xrEedQC`e%gM>mc)nhhWNml8#3?TtpVjA8q1T7lVUw?;Z5SL2?Z)=0UE2P_
z=+id&|KK({3|4f&
zVbfaAJ|AulC5*H6zb9jjoco@BHO7W9oA!=}*sLwQ#_E)Qz8?w6;lD_HecoG>x9?ci
zoD+L=m;a$CK(5)dk
zSf7{l+^WDc6G{#5=KT!2m*1J=Ehmq!f6ywp58hTqu;|Csk$R7wfqi+sv
z_k4Wym7AZB&M{fU20ZC~eTbcp57~p=>?0pWpTtY1KGC<6Pp{d=r^Z&C_yPydF8&rL
z_Owfh(`&c!$=MeVpGJ)48XWyoqXy?-z%h4{}cpS*J@s%8?gKWox&#vUS$a
zQ4g8cka*xZ>gA7^)W{}XSzcpsD*ba!(&(XAK97X*qxMau~gw;;x4e#4R8eUCK=x^TmA?6XA*KdQ(p78Ob_}0Jr&A-}{
z2l27TUvv9A*?q${cAeWX{?;o@$9qpbAiR8oVei}w&(?5xT2G#DH-%tPJgbYmnm3m#
zamW=s&Dk>7Be9CpIpf29A^sl>!4Foorxs6!!~rYq-q5Jix!E6L*ZK`1eu_0XTab#q4G)>@&Hj2zt8G$-^Gf=
z%7@}azu#X!nf_D=j`f31e!#MNU`WPUa0l)5Ecn9-;I8n9dlk}N7GmptL$w13_0-
zm%Zj%oNv$P*K}(hbANXL)3GM_{Iyw!KcDT(fqGXT)&HI0sjuSYE4y^v7YaOU|M;~E
zY0ie+KMzA?kZVHL7^8D0BdDyqcjo%)UJ7-9Jkx@^t3~4V3HIGlpSl;efdSmpw
zY2NkrAD#WZAvu$)`pE{{aJ44}`Fc%=O?kXM6Rbzcm-r*&iuVY
z@(btcpkICSc~foRB_pSEer6l$9M9K;_#oD&hMX}qYHxmylrLLrpL+M>EgtSi=Rv~{
z<1sdN#iO3dH4d0L7xJpTAY@-G_>Y9h=Fcq7-fv_MhUD|}Lsx~=ht^ztYQ|mLR5O2M
zo0=JQ{NYU4fcvPgHEA7>dt+WJF62LM;W?H5xgpJZ>xKW~gxNPIPJFGkOxNGLs*668
zpOdj?^2t#3!AtGYb#-Xum*4WUDF=Ar%+Aq}`uy~en4TAcIX#WTU8Gj5zbWMT>~|aa
z;Lfq9(IvMZVv@!dozBb0hwcmYj@pe4|2ENRgB|)G2;CB*Ureizb~prsS1r95$J}kI
zh0oZg7DgRoEqqFJ&UtlTz-m*zU;=;fHb*@}WB$Z3=kDf3mM^D6u%yquKjSRt^wR-v
z{;m=kWLhtCF4f~Iq{*doCC|5p*g#(x((IYL
zC*B-75t3hxEF1RW0t2=1>ScUq`kO-K|ALG)IzK3MJfx23p+mbZWQ_cOn>@!K4AEa*
zqpw+B@9pHd9StRp&zZ$wa^t2EjKAZ|U%le+B;*NJKv@fL5{rphxGch)f
z;!!*F-xJdC!Dz(7`osQ{#{P97zKUUg$Q?e;$-g#~GF*Q~ZT(q?f&1F{Scq+U;6#VD
z?R2^Wv
zte@@Tai;LgEm=7_5V}588UDzT*4%B%mHpYD@;}#R8lC(q2J_kC$6cW}1wZ|pm;SSs
z{h0m>_ZNqkEptA6PUdWN{^^-l&K*~IJ^lFj^UUy#
ze$z4Y+z=i*G&)Bg;e)@v!rHtz7$f(GUM=X=%-tdSw8J6mn!KwszTCI;_>9?Eg*5e|
z*43a!hn$=YwTAGM#V2Ms=g+<$agHjNt+RQ4Nyg*IK
zV=`l{u*;vZuH~|NW*=b3hqvy+2YG;@bMZOhclY?)LiT$1WcY}?0p4<3?B%dJK6lb_
zbM~$ZjlO4k)_3+#Eo3~#LhdOc*fdYhlf26xA7H>Abz@C4=06Orkx?_1f$?r+oS#ug
zLR&X=vI+&Jv-|kir1yCtIb&~(+jswJ@kFS)j%VzS6q8usNH3n&L}RbcY_0zm-?_Xo
z#O`cI9n%2|`rK9g7CW5TGB5GL^Ta+M%=yc|gQ3Qk;krJpiQWP~);s
zPjS5|W45}!%Gep9d(&Cr2VGZ$MqACtOS4Wtop|}e2fpwLh94WcKh%8c$-FT%>aLGB
zX1#cPRmL#G535nXHTt{HuJN&u@pjmr${tzv^3Q~vhKU+zeTY+i@N@L9wi|o4*EPVN
zyr^@2!*WlE4*oP3Co`slZTR5bAJWLH8+-IOjt4WoJA_wjebgR1&7FNQvxlEOxL+0W
zEc(0zc~^R}tB}^`AuQy$Ie2Eqe1%JW?VO)-t?wEh^?xWthRx#17g+2Ik&&BMgkBTk
zt9kcp3-%+=rg$ETp-u77#XjA7ZT9twtihgMwnl1Qh=tGaYAme{@|*PI7en>qZ>{B@
zpjp=%o0>e+-I(#AH-_kL%!f0UXXjI0$g#dPvQw?kbwcMD3;)hM@As`SkXOE!JS*|^
zeV;yd?+o1(60c{5I#O@^-yg!qFV9qGwDZc*Pp??)HOBfTUR2-MB10cCXO~TOYSW$5
z_e^@tOKi(24D8W=bQz23#t<9U*{II3Hbxy+FT9n7#q9sFtdVC2HjU?wjM;(>GB4Jr
zGM0zY{uq;ZS0U}mAvHetqo4Rktob8Wa@NOK#j*-%d?=0j#6eCETe+Z1Ykb#bjKs*k
zd&^ua=9}KB#3^p}_;`8fWaw~+P50Qt+njs)dzQq+zfEU}PQ1rM`0ibLxsrpsLuy2`
z&tJGS2lTE&8o&00ns+`H8!;SN_WyOxzIfjmBEyGKCeyRuKf#QS86RuKNBy1%>9t}C
z>$iqt?(Fwc^cBPHd==+`Q1u4lb*o->ClQT%;+5Pe<1VL+sS1N596yt
zM?#vvQ6J~OoVj?5i##0)iL3D*%UHbP7OQz0O>AtEIk3!~LowQOzG3%3
zNPJg>nnUC2XAAZ2l}G#fk?3(=_(D(h8;|GcZQGn9Hat64A+7P~#c(LZU$s)-*h0<(
zjOLj8Z0-Hy{)OKdA9*<<4;z@#M;F_(ZaRx`am&(Kd~V1Xu_4F4-!j))gU2#v4>hOz
zGS<3xG~@E{pWo%N$3OAh7=oR9?hAwMe9wtbYyQN?H~mPNp1tS!H0u4LZS*z|@OxE=
ze|{b=PsI;j^uf_OOw@d15#uXDUlAoI)7K|_?(z}uQ<;;cM|&_tzWBt=bz>V9LzvQg
zZ%9s$hv*%BGUgMT#xU~v*!arOlS69HTyL)a&GqJNn(NK^X0A8qgSp0_y-;wn!o%QoaBR}$xf91j>rus~}yjk~&p6~3N<);gWmTf616hOS-u>z4lgmfqR5
z?`LHCt))M(^oN$-{b&F1(%-uD;;;@&{T)kx=h8oG>AkzzcR%W%z4XsndiRR;)zW|1
z(z`pXyEF73zVy#u`j1@tk6!vexb!bvde1&`o`?F6S^AG%`j;=gJJ9|oEd3`f{R2z?
z$xDA~>0iC{uT9T)@oDh+kkBn57+t=Q{GfY68b0Sr8|&lOat__s@b3Q6jNdCnhCU50
z^P2m0UK@4ipP+q2E&9E$aX3RMeq-p0(8YUwq}6@6grX
z_l4kiAmrY1W=eb{^V9K>UgUn44_H<2Wf^OH!1ItvnscP7H~wh$kA?6aUFOc`TSGCk
z{w&9rV$%0xeuzchuL@~&tPIk+esUS(KbL>(YW!nQx}8$gf~CQJQ#X?
zh>!fLk7P&u=zJ{wg{3A>u!M#4q6YON&gSX`E@BYN-cbGLJE8|>@bGLn5VGd1kl!SO
zmwxhm8P5?}ev&^JGGB$X`Y_^oTh{5(-ZwQg&hMP&FU%a@kr0`m${hZk|AWlcUPylHC3n11%Oe>A;sd|T$?tv?S>^9L7xvh=SE(pr~v
zYxV7(Gt>3H9NK^O)Ylj9ca?wcAP1+>=a=Q*N+0Kkr}@6j*>4QLmWNdJ)-RaBMr~;P
zHy-uAe2|;{c`c#U8LVsP_4&e{{B5Du!!PCElh5?5FSmzh%=hoh{F-6^H^V>r@axn3
z9m|}~F_!J}Z(WUuRefk;H6HDJSM-j4eNleUHSWJW^Kt*V%bXA5zdZD%dC?eSd1K~u
zXgm4Jw=33MXM8grZNGTY!;ZFE?1-zjzx`JqY5NoM@B7y`x%lwRck+b~?q>}?#-k6v
zkuSK$`43F6D9^u05T#ZIp#c4Ke>5*_<)6>isqk;N
z*LAr)8XEEVYx#$S*@I_wvg>{y`TTz&%I6tC&nl!9m+>yWFYBFOld-w_fE_=MFJqY4
z<72VDcNw$8k7AEcotyVFzx&4=@kw49uQj&Fm5;sJ7AITxgf#rtMql|*esPYv_`p9l
z>DTBe-<8X}zSegq6ogW41Qy
zJ++PA>%&Wr=e*wM5B&`xF*L@fEpz_c-&*EyGT$F6t_L!%e+M&e9_iBH3sX(3#(yC6
zB>~ub-k0yaEdM?8F7x#D=!`yfN0**|e9`lPP4&(0$Yj^AgawKwsuC|
zl*Ia(=-zjxd;j2Zx8ECbNB0@fXGh-w-2I+CcZI$zwdpzLF79)IY}fA2SPg3K9y}Tw
zm%{#+KaTdtI4>sl5r^%@&Nj^0kr%e*rSFD)2P^J!X-pq}JsJGguUdL~%WF)J+{*DP
zbVUfidG*o75BwvoGS}#^?#?<8@~*-jxxS;(#g`d3w&$Ah-lokpLtpE6yD>i=OWfud
zoeMFI>wFS_aWY?pG?>8JcT%^94uxPyk9SGEXD@krQSbb%jQ56MoMW-(xmb+(cE0z*
zr8*ZEYI}VDzu0@}V(O~rO6`wlP|oC!Z{;zz-g5@S`E1ym&jvl(g`ACxiA_9>q2uPu
zI^X$ZESB=9$Hpw)5f|s7I`#DFi;4Zpj=UYW?${7p@iX@MVQ*-ENPWN?KVk>1LR#0x
z`-?0+JzLFT?=`mQD3ABC`moAaBfBpoCj5GzIXBtwx$Wm4{65nh42^o+jg7PM(>d2k
ze-5-$o$$jxeeyzIpD}PB^Cc(Ehn~OIdiJb|zp>6S;0gEB`X__YMZD
z{?>MzKmOpQ8}4+w+r;0T6>m5+H~9Ee%*z8i>-@w^4}D|Ydo!Q!h+9ky9c2VpxUtg~pnotF=|V`c+8VZB5WW&80W7lO5T
zW~})zV=d3xZn5TjaUaKgq=QYEietXJtQVt>$rWp|%?lVp%uUzMg$-Y3Y{<^oz);&QHhgRC
z?*^yV_=pD`BWB}W&L4VmEystfN)JsZVXzSuykkhWWl`7~op-;D9a
zeCKyDco+K-PyWu>&-aAdDgHfI>QZbMk^`8NUxlgOZm0lJHdPHSLX6GZ~cg$-V3Q8GIRZy&-LT%Yrm7~
z2bNzIEZv{)Ni{Uyk-Hi1RC8)gE%om7-0GNI$KxHTF0Hd|U2V|OXN?}7dV9TFjmy*e
z-Oc@adF0OLF6MW?%iNS(`uKsbXUOjwnWI%m+wF7Fvvxj1^v!3;`=vIYAvR$|hdr3W
zm;HWrFOJq=fk%w>-}6RH`Z*4~*2Z_Jy_u7p-xKCI)WaMH9_>=aQNP>I{__)d`$OV?
zwBul}?|kE!Ut$)&{J?eoywh5jhw+TanfS){LSyT4OON~Lt8*VY6Ss%@c|^?fTCw7v
zF`k`pV`Ic^U*=@T{EKJKKfQDQ+0*9yk63Lt-VKIuo3WyA#Ituv>z>|XZ`}K+`vqk|!snUmwkjG3Iym~Hn?T)*jnryPirzwFs(Lu}T1_KVMK
z`+Uyp#pI}1pHH3hpUtu6njdkC6|F*=HF1(@Zi@fjW$)3dS$@a|yYj(~e8`2l`nnJd
zT9@?B@wN`}%<;C~9<6w{tA%lWCrn_aHeu5^ijSJ?IvrgXBRTxyDo-)CKH_YShfnzN
zS)*T1pPnCjbyi!(vZo_
zkIgZ?$g`j}jjhokH?^%dw_e=!Xs#hVY|M38`LQmI=~heXXWZ*~qGz_z80@V=+M`*g
zeB{F_bUt7?JGY|gw%$2AaS)mjQOz&c@}lOH71@-wJCmeW=|e^uk6cs)PE`PkT3YN1uOZ7
zHy_*)_Qin5n*8B$r(O}_gV@{SN2`#AcT+5Tvp&b-Z197f)}ggIw|KOja!dEQ?oocy
zL7$k}?7e6%PkOQOqhoULuwGgA$is@9J!^XF78?Veb%&#%_R()?~BQ6b3Eou4A$AOKIRyPBVIi#){OP#fz6m#dwiYi!2DFGb5
ztE=@w-nkR^PG?aL_lBII%R<|oJNCCbceTCU*;Au4{_M@J$0N3Fkk9lt#?#%LAN*ge;|-~)f0jXj|`H`QNV
zyL~40U6}6qT!>*l7u$XBG~&PAn2+c4PEoAsdr!!VyX)OKFFWB6YxyqD;!vyB_3Fc#
zT=dy%-CSL(9s1EKq}ki4uGv%9WYzT*p&36qc6z5G)3Z6(ulZcR;?U-Mo!??5W6yH}
z7X0z-vQHL|HNNBF+rAJVdQa$QEZj3sTX^_flmfKKiuX7>;5QmwdonKIFn&4eE;#|BdOht|x=vdUMo#Hx7E_Rlf=~r!b}i
zA6(|Vl95aP$>YJ0^Ff|m&kA`y%sHfU&f#wE*qw0MO%7oKSN_9^Z*UdAy%OK{hP)4m
zWlsoCF%i$jU_y4r#C*nte;S|JZY^&&-U%P^ilMclCdOKk6Zw++@)%p+4mbSt6gT}Q
z?8;aC;D0gru`}aG=Zqh_+D`cGgxUW|H3bLp!WCXHRv&P6M(nFcJl0wlt(iF=7kW>R
zwY^hrE~cKH1Agum5}4jaF<
z##Mei)|_iO#=i=cSKl!{w$Li1^=yy$?aMlu@wvc|tGjsCdL#WmX(^K9Q|1#PE0gx%iFY~iIF?(lSe*fSS*v1V_~%}#ePT$`)eZ+o-f
zc(rrk1|L3(VH1A4$>*bm<@w?YOL33SFgiwz`HBbj`qom%@*@xA#(M3ua9k%#j*Kx{
zg*1FSeGc%w4t95~0fSN!1ft5%EMZhtnu6`h*8VCzC_ay!}I>9s0uG}f_tXDe#z1!
zx1+6|H?=<3Ab$I;ceStH`LI)M-jIEE=yQ&HmgySLg}S{wG~cn#58Jh~sc!AVXufCJ
zwD(xl?#0w4OyvP4jko8H-rjk}?hP1@d29UhdgCW!j8-9y{7!kBpMT!T=G;_&b#2NG
z+jCwXjprXrYF9Q?Abhq<*8Q|sofz4OJ7JvmgjYI|R3#*hA;-V?6KKKpF<
ztgDgwG`}Z^L!0kj@?xdK9v!gYk27qaEFNoo$HTY1A@*92J!;*(z_jxiR#Ss$PGYF|vF-^Tn|g*5lI`|Dg-!IdtuusIka
z`)J_8$8$Y@#STyYs0se53H4wO3w`sXMvUnuXG{kkYptL1>*=nXu{E`#K1M!ziYq;M
zk#)2RX|*%vNWJjcopvHb|Nao(K1+8Rv$G0mV=l=cer~E4es0R=zD2IK$%~gAGH|ZW
zxz63a+NG%To?|u49$ebbxW2p9Cfr-Ue7#h4Dt@uHCgr2`Yh9l4s42ai>3c_ZtcRy{
zGOay2=Gwz+y|Q8(YrC~!OX;6C?Txj&>32lPYIE(5x!lc|@AAVYU9giQ_Qejb-b-@OG2P8;Yli>yl!uP;
zz>R)9)ky~)YdtU4%$q~`t`2hcdI#;M7OI~t-TdP(vSyAhRV~oPNBt_KnY(M+uQJxe
z;d#!ly`j58Uz0+FmGReREYDjZ`)Wf^kIyD-h_6^#o9{TkW2@~{C(R#yaz~%s^8@yC
zzM2y~9zLL+8-CE^-0+qD*;n(~SGu&Fe1%o-s@;rtijAGd#!ofaT9X?w)c>yYyLH^N
zf`{+rFFw|hb-v=qXKlXo_+ed+Ystd$^PIC>Gf2=9_u}=3+_1GNK
zi=64&G`2>E+|;(-+`3rlIN!Rg{8*Pg2Xd~4#=V}WcelSY*c(6Lv70)*lz(Rc``y%?
z8h~|k%FnSbdfzxpZMWx3t+Pot8M^sK_ojD}(Z8MrI5Zw|
zt<&n}(^$XaZ@yL;YmKM+ckZ1KD%d=W78vpT(=jZn2S*HijjG46=Gv`#B
zF{}UEVPl^@n21}x#E$HtRY+_6balxa_xX{Ur%@CjIF_F
zJWtl>p#u*+dNgBLJ7bRE!smVtqTjO=@0hdg#_X&@+L%l7h<}^vg`b=9xo?rHJ@Vph
zY`q)kob!2I*0c-BCtsU$xWS!Gy3TcHG|zN2UvxCj^pr>3<$-&7#5mSMbFD9qW9-#2
z)&hNSX)f{4xulN|#g%UUwN{F?HP6AGvs^=GYpm~A>PXEW2sQV7pmWS0UF_*sAHJ;g~6&&uPo
zroQ!L+pjX#%tu;TOxtuOzF{~M-?-sSTpl^P;80u6iur}+ko=rOYjX}gpS4SoLps=m
zw;b+tCW^Iqn=7$4pJVNhIkc`m;nn=GX+GxA*qS^W@8+(hyL$LVZ*wr-weGZoA$TU8
z>zv^|-@BG>_Pq1e&MIR~%swMuHjFb|`!v2&?aLY+oAOQXZu8ClPG``5@$ES(Uh*J*
z>*LyN8;^D&wZ{I1)>qFz-^RLtTjTCno!~3>=FR;*89S@6mKQQ&)~lDfX6Qz%kVe<3
z5FExFs!_6|UVhG)@?*x-b56SuOxf(S?tJm>IUVui?~JvWi;o_*J^QT{@fY(9*ZkJV
z(zyxu-s9|FO5AI6tYv=BxS#K{Z#VcB7qO2xHdg1XJjT{fEq&`{6IL)31DQ*Sm7L8r
z3bz?6wzZ3`(Xn1HX1tqRw7y~1F}aS#-f{0mamtA}jnz_lob8UC*^Yfz*_^7WuDc()
z?s;Qf%1b`%9(n7Yv$G!Y(c^i0d+1PzK74%HA0lsmyMF^&c92QPiJR0??KLkI_DP|IJ)Dl
z>*48pk8jF{0=TKa`5c(f=YX6xpMy*7*Ee4xzb@o%fXlZm_8*V)$Nryq9PMAKyK$_E
zaV#h5M}4VJ_MC0CW!^efm!3bZVSH-3=e+L&a%3HDe=@kSH9lX+&9&`3%(YFgHrMur
z)X=5E@bR=g=4?0P-Q-m+o4<}5qxIGVdoWZJ>cO5hz4hk4IIENL;-g1B{HfG~TG$)1
zj%O9REHu^#8*`1YHP?uDFm0|8y6+3sPRF~!q_LcDt^etz*84s;#sil*p2wo*>kI5I
z_U?SFF;yEdT7|UM+GCC5sn{OfwYVcCj&V|_K-(2rwoj;y_U1~qZ+S=(^;TdtR
z_j&n5{T%OEB+myzFr$CI%gpCzoO@84pK%wG%g3{h9!w06XRTZc+hcuPs_{;Bre3@Y
z>Fa;T&A;{DCC0r^jMYy0M?IcLeb4b7A0F|LCDV62HmbAw^d;X%R*$iDGL>)79{sI%
zJ;IAtAq|f+-o0Z0-6gYnt_aA?swtrmqjaukhX4Dx~4RJXGGw
z@n!atk1&H(?`%BQ=b!P>x7**>I~ZPVKI?qxJM5z|<~y6P5f`lH&w#BX`RJHj^G}wJ
z;#Z!z2Fs7HJgq@%*M-XCJ5@YlZf)XG2m0m+?&keGYK&TwJ||SCu|58_KE-5BJbFIp
z%S#Vit)1E#{ji6p^@yiLFIt5(eD=ogv-f0
zjE8-AhzS-=Z~M;oipq39rN5VEIJlPYgsH^hegNg
zr99%dPRCAXh+e$Sv3yjAu{}E2q2HLyZu9?Oct`!t)GDO44qMaotLOUL`fNSh?^!PZ*)qgQWY>T}~#
z)n021CasUT_R2HXQ15s?HLviNXMOQ+9nx>Tq+V*T_qv!`uk_GyJ~c^JP4V-x5L;?X
zFNdp;wq1SlQS7b73#m`?=c-S56(7D_Y<)f!?;|_aoBDur>!i;cxQo-eep8*$+d43&
zM;_e+<99OTo7ZuCq4yUZ@+8-u)vJ)k#^oWtivyoApUx*w@_H~tpJy%|tqpb7`;6ZC
zx#c`)7yH~g-<&mnV@_Z+=dWj~*odV$Y+TN-IK@}2=`|kn*t3%5^}4&BezC)hp86#p
zo(Z)h|_b#+bud!u~F1G8l`NigwpY@?W(L3kUGf2DGeDb~b|90bx$$4=WOUG)q
zWAQf6;bh+#mhmi+Rtfx>|)a
zKB+@`@bF_ho$SGZ&vdk=tY6H#gm)Y5Qr66+s*UEZvF}s^@&`NkRLqO2UtNWf^
z{;on-EPc9l&U^2--tc5{xRorvI=SRKauly-S6tWcfEVB=e6~IG3T6)3wakf6**_heb{=C&x<*uo9^Yu
z^NhlE({o*n?gDp*yvT`XjPqdbOf+Ba(vIgmcD-`&d$gbB7n*Na@K4PB9M*j6?cWm;
z%POReb#XDz>rHp}Za@3~pYpuEn7lg6=ab8eIpdph`R;PYAB}U}yV@P=yzg{Zvo8;F
zsUPnGZe&4zw
zYucrJ-x9~ByL>n6k49be?uUKHuv-CiS{>wvR<5zj<9PM{~m356=RGsB_
zzTI)FkXF57t1jcm@)_?Q)-L3J74LTSC6BF<)`#4{v~|&(wsz?2m~3l-d~1!4^3YQr
zc_|OQc<5_A^zOE1pMHIx$#PL$))8JdjCWIe)iu}1Tzm7+?AhVZqfvW&hhO_u#+tcz
znD(oTHD~i_AwKO5-4*&XSDwMi_**mfPPrAb4>vtMVko}emBfu!A+5QC)BK(~pGW#O
zeYUhVKco1o?Nr13u+K-e0TVv(Mc!MJ{O6|}TG!*T*1Jb7%y$nte5=sD5L_+`wHAuc
zCQPis^gxIldHSk@EFQk|qxm$SvEYL?V?ka#WbDxa2l|?eVqpy)c+M4bedMqE4K`g9
zJKy{6!gk|tzsj11*V>2!T{8}J%{W+_aloU^IMCNS>s*-he&HLe$ihZUd>iY-n*H{3
zeD>&3=gsq;jA0Hpjm#<}o)N?99r44b@n^!@c~9oeJ1e8%$7S{pGj78{xp~miF@gZ=fj0Pr+qH^v-w=q=Xm=*pL<_>=35(|&3iL{;@SMJcc1gU
zi(vofp1^+n8C-2WmhY#q|F$Qvf84PD_9w7^+_3+SC$N9qu>Z~{uz%dJ|E?#nf84PD
z?kBK++_3+iC$N9qu>amCuz%dJ|MO2^|F~iQ7oNcWal`)mp1}Tb!~Xl9!2WT={s;aK
z#@_d5ekS5)mcB=ue@DXiwD$Y+UEfvq=cecSeSlSXH9w2%&*R45dAXFoE5iTz=dR}S
z&t1i%?eufkConnl`%UA|pU3e|-?{pknp)}4+0@ARb2j+vZ9<@8`bKy`{&q}92|_=I+u$2((({e_DW
z{}8`{g!kTi@4fflUE*6^&rWR2drqBGb;|Ti)sV=^+PbNK0PKKQ2=!NNXv>XR24
z>zx(;;NY38;G;(qZ#>TKe#)8F$cNwDXWpE>#`dTs@#&Vo$caADbL(&I?bUATFZy5C
zkMR+^GM>K6eD_K6%h_zSCN6?eaMK679yj3)_Rho$r|AQ_y||p;iUIuef#-SASrH%P
zo_;8Qi$~9^@+w$A`s3Z-aTH{a`B4}==Es-cjgl*{$yhDQ__pd*-Wk+*HA{V=16oB|
zY8D;TEPGP(vQJ%9v)oDK*yDZryr{k+xTs-g)#r?Pr+5dQ?*O0Foc49UQyzWv?j1xf
z$ccQ`@GK6KBlmgFe4TxCm+x%xb@#jXqr8)Q=fZQyyIkI9)ire~qy|QwvH8?F_0MzO
z1O46ou6l_t{Igz)7xfa4HFfjT%jbQy^U!~r@^#75ZmV`a`h5G2eDwKgYV>2CfBAE_
zdNJRT4#{)%Y1d~pbxtix%~aRaBlCK-(H!y}roVN6UOoPoMdF?O`99})>PnV2Ym)uW
zv&UNAd!6a7w{9;UbM&PfT1A@QE&ki;MH4Ta=;mJdpoorY>eSKP)De$HkLZ=&8XeTW
zw?%ZCGS&Mj)BCSB?d~^zZGX>k<{>`H-$$%5XzO%Vb?Crw*ka>Ds
z6-(Bqf8s0qc!_#9E54m{Qt(UWU^Vt&~J~w7p&sWd(Bqk!mS=N$wdPHZm
ziZnd-%nmSlhGxPtI?0e1UMc(sZ<9k5y!p7LC7uU(2i8
zEt&IdzrAE-KK0p}v(Adni=4^coWW+gk;z}=ZGHas`CXfN1Fy*6HBJmUXDhc7GtQ=0
z;)3q@&6Ay&BquzHL+d@>Jln^v&dcYCn;v7%N<0Jy*pm}{^l17P&sKanKe46X+85h;
zY^GM&!{=mgoonvUm`7S4%%`Zxov
zBCY$!x|p7EdsD0rwGr0zN&LW_?&kIUVU7>jFn!>8`oJFTP#+wsD;?>iPfR4f$%qZG
zqXQl>9^J#s4sv4as7oz{!CBdTO@VuVwamKX$)NyhsKJebY!bD
z@2kEZ>L+@O#rOuU8Iuv**=WA|2}b;?XM1>!<3s!SDesCf@y_NBx6gU_(Pu^G<@1vw
z>)prB#z$tSRnJ=d-*ba}`+ALFFFABcJlQ+_?K6eOr)1WbH;x#OU(+-_~_`l^JJcUx(Cy@HDnl<&*u0Tj^+~w^iBM;$6j;c@A+tNe5)5LfMU;-D{iMBi}j-I^Wz~t3fAmrFMag%5L^0Hq{VMjKhIM?
z`?P)fv3o1d_UTPu`XzSwDX~Ca?BNqS&>4QwJ-p5!M~viqjcKdrX)FF|>s`Fx@=x>>
zE5E4%U{$ZhwyEn~`US4Axhm&_Ki#%`#fR+aHNiN(vflHM|D9`3^4~MQ;Gsu+j#iO|
z$DZ6FEw;*|_zzCqf3bnSoyWX9GT;4{oOBL5^ucD;Sc~n>
z>OOi}&)K6!(V6~pKOXbZAK!I-WiMM|Cw-@{oE5!{@z|HS=_`0>hx!U0TlMnTc{n*U
z*aR1Tg4L|A!7s5AT*)xDKRl6PzRO{2c+|_pi1&W;Y#_&e`|RiU$k$toT)q2NFXki9
z*j#);XR>?jCFbxP`aL0;Wa;VIg%7h
z=eISs2S%M|-!onPegR$Bb6x~1a>Q5Utr~0V;=k|wmK=t=GkTu-Io8b6Z(r_(uQN`O
zgU8AdH_oT8eBo1e^O5K7ci1N%oMRt6$iQoCf5v2lKXHVo%bfX}y<$FNaUVJ2#=P^L
z<&3NH+8NG`|31Ea=BLOtj{bUhIHTvIv%(`zJ}(j{V!reCab)SmLzm|a^U;TG_9k}p
z=+OKo3$Nb)M}l5%9U{}a-*2vWKl}UNASMsZce{ecw`zXs7hiWjC!hEXcKLbqL#P=r
zN`1Jmnn8#79Y%b2UNmdQ_iIkOi<-f&$JB=8t9{8UHl
z*>kY9Uykj|JNnrpN7??S=ylPl?`pav&zz@5<@wZk7k{vA6>00@zwaMgq#$;tI-!g_v`~rLP
zc;iF3*l&+M=NNY%@m*gYyB@2
zeO~meh%Vj>epK|N=!2qp20gqJ=kuzX{=CR%et!44&F5vZJUcHv9rAt)tBmo$t3TT#
zw#d!AbMsvkKb{vk8%8<9{TZxcueq5cFw)3@5j)OKIKIo6jDHii@JQUUea0<*{?R8s
z62pnR{+>%l=Y_R>J)X0FYb`SEnfv0m#N_~rlRM%@BL}YP;M|iO31;l3k38MV6?}>NnJd9Fy1gmh*O#)ghrP}?CWpkV
zeOsRa&CML5yEb#^s@S*AH)2%1V#nLd@v2^n{xg@^H1)uvJybo!N$LyR=}BjKDXx!s
z=Y$tpMH-yQoH%)&IKf;y1x{iRIUB7ajjiVU9hCQi)ExcX2ZzM2HE}Dx*b1Ljq{$2U
z=A7ixDPpDjsE_F)PT>hRdh%QJ61$%1z^>F?acZ6{d+_1$+<7ujzIFY?#-3f6l5L-U
z?lX4`ra50v|H#v?B8}bb5=;D&J@j5hu{Zwfd-+T4w1*sf^s&Ks#;iTsDPlI~ux*}w
z+jYg+YTPQ)g7HoCfc2^CO5$ZvvKl@4aO&xK`f68wIaW`;7VpU)a_Q0Y%UJHjr^XQoxp1sbnpN;n6Gp9Eneq(cqUp#yT3-RSVdWDBR
z!RoUbYvIS^tQouJXY6_(*6uQP#m>J9-{?tRe5arI9#R{eoqD}%%!Y>+lXPO=LyAK_gkfTA))@Yki&JN@$R2*}
zKJ`3(YQMHGXHMnE)Cclnn>eEboz;uz9$t2&t|q2EC#Gw7@%#CDd&!!1^Xs&G*Y}6r
z)_rkGKXTzlpV-rFi4CcP@gqGSdaWoGe}ZeT#iy(lhu|ArgB?s059WFfbe$7NGZv1?
z0s1-59)1?9^l`5Ev(Ddm%!vm)bV9ky;_s=;G4JCuF8Aq0kKoktqlZ|`T4I%KYkD@J
zRiu&SId_g&cv@s{=esIKws0p~yKe0{27~wj9>#RH-GAmfdrOu%ZSKu?e!sHT
z{;v9P`-AG8vx>A|R}}f_qbFV2rzdw6Y3AM*ts>`o&hMbHpBz11SCQs9_`r@IJ}EjY
zdR4@a=2wyPJ?9dDcI$u1+j_WN#Fe3J2L5g9!;GPWn={oPp49<+)y
z^NEvLi>$?$tHxSn>hZ54%`;5&Y)!n7?Kv@sXBE+VR~$X7HFD@Xm`YrbkujSxhDUtOznO=7#(Wwcv0%*NL;dv#{sKMLmw_9J{Tv
zqrU@Lo3`2$yVQ^5lbD)uc3yMZzBpr}b$0U~d3j&qo5TuV+*KW;le6hWx5S_G>1JIV
z;xR|Z-~dPaIyUAeHh8ps*swYIwGSt_^<3byo(qY0dL-VB6HjzqMT!0RoUg4p8?7QO
zb3JyS)%?sCm`p6}ome3^oOno#JI^>c!49wU^f1kyj&J1Y
z`Ct`kp2;xB_EqEzdIw)~TE{c;oRQqJKJh&EUHCe<1rz$y>#95|mJ7a{#y?$Q4J*Em
zk6^N|4)Jez-qzTD^jVPx$0tRx#ahStw(Av}V9BQBYjjC$!JHkz-g=M4@WCj4!HZ9C
z9<3rRYh<_sUlzeZUU%8a@xGUibPZqf2TuH89)_9cC-Y>9@lT6lM`9VjSUxM#*wD}P
zjJnUPJB!@uGrTi5ysK(-w-;vV?e|PCF|s8SR#T>T6pc)Kuc}iw;i0Q@f^EkY)-!g3
ze{76j;=ANeFbqFAi6?8BhhOG>9yA|6!W(a5l8&C`kv{8U%(HjH$TBuZPrW!I7jNzp
z{>Yl1F8cnC=`80Wvd}8h$g|#K-8pRSXGL#+zd2>FfsFaN24CXZe(U+2dT}q_voG`F
z1XkAQ;q$f}G#5Ogi|1cmq{Zeu(?8?j)1S%M^-NE{gYV9u=XsIy;m#)VCI;OnY$l&=
z$z%A=9C=-Hnz$p6-_zUgnGfC;J;c1DTk@LTca?+5JD4X|#C_()Mdp15*_V%O;7`8N
zCm)SbzTfe=B{GezB@W3zJq9924C77g+KV^wp+_^G@X+bdynL}C8sIHsKd*m_im(GM!-kr&EM&1vvdY7bcc6aoHl!&Hrub=waskFXTzI}_hFZskz5y3
z$x~;tIaq~9d}IupjDtCTlzI6cnOA+c<4k+`N}oGeta?@hBFoqu`}FcfPX_AoO%C76
zlh2FrisjDN$C0DYXEXVLCo!W(&PS_A!$bdBf5?JwKPS2NqUNU@{Pd0w;2TV>$#eUA
ztuem3(7Z;D`qZGUXFllb{ogLb-)op>_H_Pz
z&veee^N^YsY!f#V(;gG-k1w6$d_J4`4>Rq3&3~Arj=+N*>=sMxhF$Ww$JkA4L1Go=
z$yv1^^F5aj{f>#={1pEhquiq(*EnYxTgx8yc!ojZyj$b(^ztIUfp
z>%KE_9{KV|kMN;Yq~Y0BH>`D?lZSG7%Hc~sh7qjUc2%vQ4_)Or4BiyIF1pKFAvSvM
zdq3~bw^b|P!}j=O)mZC3edynNiGf{tEgupKi7_^t*NYeNgjSIT4>Dn5KK0S_tdI6<
zcU>QEYBL+f6ijj##^*iP*ypTOq=o0Y7?GWN+{dS~=WWTS^D5HFjeRq>W6N#Y>wK}6
zUJQA5W^|o#rVh^ITan^C`r!A?yC9n)IIEe%jbCWsYmih
z?&2|aPVQwg%$u{HP02TX>O#i3!|@}}^S*{3xvNOa=eK^hIm>>$#;ZuPFZb!L``o_B
z%6Q(ZndiTKcPxx%ox?xtobM^L+q`38(La9$xA@FDU00C?tGthHVKp(it9YfC_@XPk
z_*aavO?<-KI-C=G*4X*YqO2tr`7#)gjds1eJ*&06XJyZA;>N}qKb~j&uvyy|KkQ7-
zAA(`>Ihe86J6bS>yK{p>avqO)xLCuNKKQPh(}KM-dYGbzZpzqh3Q23wn5>Ris_z=j`Q!?Ctxb??du445pvAYWpFd
zpSo`k8N-G@oG*Uh#(%vAdWM^vi0_iW!81JBZ(dytKfm<2u*ODw@u|I@&G&ug5@)f8WLZ(;CxLOwX7wH)BFRXotpx^YM~RH}Om_{_qUL_);8qU#9-DB|OIF?HB8M
z??rwd`n-BE_no3wMeK6kv*chzHr9T@JYvy8C`0<#7
zA3pe`9$bYF{)rD+6Q7T3PCFEzLvV=x^d{H2{F@lyr*3!nVUT%yWBaPHCN2=W@>wBx
z%vkw$@rV`taGUFiCApCLNw0|+oF``XXoq6f?b<_a9NLvzL1;_%SePt3xFEo|yB>$&qJR>^0FJ~po!Yk17p?CPuQBIJ9m}KmC85T5u>PFq^sWdFDPHwCm*lAy_46NDh(_
z9Jlh9&Yc(TbS9(csT{V}=aZlC4^1E7-^xMf?%HE5cj~umtQI~mav#yb8Ck!JJD2T;
z#sy61&*s!bb2BdJtVsGTsGcAA@Z;?YiF=MPHG
z-%~Gj;^wC3i_5F-*v*Bxf
z_MX+44&>x~=bH0=JmbZ=+Kd-xT;(siox(@)OMLBYI>VXXp7rL!n{_x@qf2=3$M(p=
zj|Z(H&Ds|B=3q~rn7}7qko|hGxQaBg<*|Mh`5fW=ya$oDiasccu58=#-?K{|>#>1c
z`_S~?slLNz*Hyk`cQA<`U}InG3J;yb!+!JeMf`ebz9qll;T-bF3Ovf5Pi`p{7uiR{CyYs%C5W0=^h7(kHi6-`7}J96Dx2qPgnj-eyh9jkDe@jVySV`2LSCQt-Uc;@gBDF${rB*~wdYFg7DoX7zZ|_#^
zcwX~t+4{c0XRld1KCL;8e-4R_oA9vZ)b%Ct1KY$HY%&jvjC*|ee05BWkx3TcBvuly
z;>H~N^x|~JTlOc0osU=TzG=+O_)Z-&zc2o*ucBk)Pdr`~f8HsQNBG$)zGwWst~u>4
z;%`^%@*7{$mmc&L8?bZ7v(-Ah5@YPkQiq#dEp@|WAZY_7n!Mh<`SRAVkG=>
zIAeI`T;J`QrwjdieVcbIUC2#LrdE<|UOaTU=HkP|uRZXv#@Bi}+%%RWFS1`<%Klc9
zo%#yj=$3P%hc)yIMV}X)6{(*;Dw41Dk>*1GzW)4j9X{;*UJ-fv@I9-swVx>>>*?h)
zzlTU6f1ed;>*Bxf>RoEyr!@ytvJwyGW=_AUIZa&C`>OYi+vZ`fc&0m@=nhME
z!17f2ot!!JE}{ec`I}zG`*J<}{G72k%DLy4^YCQjb!ve326{L{&%a&1Ik@RlS8|u7
zHi*B-pi5#VdeMzf5{EUsh!b+vl9xqd4nH}ON4`009~4=8b=iNb`keLlaxQWG%Pybw
zGmpipJZ6Jjp<8&)YW$?gx_Re+r^vbb@I9-swQm>UwMTuKHrkh;!NFt|X|o=DQge9Y
z1LITI16a|I+*K4j#iH}X&Syp1y7=!q+|65ucl-*Q%*|TxD{4&>-_A@eaJIPGm6O(;
zg-2Y-QRk%QIS+1A2Xj*gJlfQu>(j^1#%rHEbFMl;AI~sLPVl=q`|;&YrAK&-&D+nG
zRTRAKnKs~=Hn3NlHaz0^F81yVM}ALC_PX@G#pVynj=#5x7JFjHF54clzIh#(II9h-
zNL>j2a{i`RJ0~^wknth4PrXb1%{X<)eCnq2=+8Da)0(;1mHLRsoLU-QeB_ABzpusR
zvwF6+3oqx)dP?@Jr`~h4Sx?E{!s`%RV$ZR6f-~dueYV{+7UCoLu$w&obKkh%tizQZ
zk9Y37m@Fv16eEu~ev!j7*B;+p9^V0b4ZY2}Db`leeZNb)UvBGt?^rBzANS86WSH0I
zKF)osPd&>xceQ)W9Gvl>RitHq?pvSReHM3*`5bNCT{7!~&q4Dp_Ssvzt-F|9`oJVO
zuqk%JC3m-R=3~Ep6=~i_{{DI&fd!ji7Uk{^R?}uUOq=b|rp@uiv3GRrn`g6mo{dMF
zXR|%;KJ>7T7iQunpMhb;j}uGtuwyTL=|s-d$@A379&MjaUB5owrz;)lqz^{j*RkQy
zyhz-vl6Tf*(uaJw&SH>}TRNzd^YdG3GX3Qk9F56H%?s}4$-!ftjrPZOJ^9&(
z*BrTc?df=Wwys}An&;f5`cSe-mCvhJL`Q;!Yr~4*2@C{x(@y&d;*ID|EJ+C4Su8~g<_GiaTe)Nr<#%zkc=~vBZ@Y}K*R?}{KZ{mCM
zQhWNC++8s%_UM?}PA_xz^I5+K!oxr2?Sn(Nf7P?5cK<_FyQl5;tRh$@o+3j}wzIp;
zn_$X@iK+aX`Q&Wv6#3*#`SH9c7@gX#o8|~i`4cv5rZd08Mm@8>RZo-m@zunZUK3k9
z+9|LVPp3G$=f_RPhvXJqqjPe|neZ@AMtI@}^TFR(zJ*^*g5uIIcb
zkn5cDqUS}cNMjS-$oD%g&Y*v6r1Q*2_GmL7>9KWx95PP_@|-U=oljqSd+sp{pTry4
ziEA4B8mUtsG
z{?M-?%^mp<*Bwb_&xNP;Y>)Tq=#c$lYWnk&n$xc1PiJ4(Z~Vhfx&=G&PIq#HwQ=%l
z;*z|#A0Jvp8adYGhRIW&cuvACT7Qe&rI*+Mr?Bq?AQ+r`iXhxC3fMF
zF&Q0`#63B|vd3|-AwT=@vXflA6Hm|9^{Ytp4FB}2#v1uAitwHliN}AW;t__%|7eY2
zd|qT-JSR5En>d@BI6r>&eiyqioxT!Be1c}|^R0QlhciEXzvxNPU4QnbcVhpLF%vSu9Gvj~P_ZhozJOsPg
zoZ3Pb``Jwgc^w{O^D~}22Q%ZTH#r(V?$Wi-$9H1&keb-_OC2OHKBrUs9oclklX>==
z)2|}Ub8OYGB5kYI{bQ}x{o@<8POg!+b*Gq{n0f!!_F=Zqzc9(&!Omb{p3TlQhw@$+
z%wEjPFZ60Z4tfZ
zy-!}3!`Bl7a}xtR+Qfjot$If%y!MGxI?Z?7#5G$I%U9)Q{K`JI`7E)Dv{m$^C~;1=
z#Q4OBKY|g=UlqaSS<%FZP7@>hCq~ZF9s)*U{_`T(!l>J1498XE9i_(u{zGx=v2`1`
z@tGKbJxuvQoWNczS)ciZN50S}agct-0N%tvx8u{HSV!TudM0mpvQyP
zI^XNj^d}zcy@p1|d0x)q_bDgu0CMO}(d(j@mwc%?_FF&ndyQb^9be3`Ep?rZbl>%y
z`-@)U{=DdU(JIn{4>{!14G!_g$2Fd{>b&MOvE=N;AU&^>bIykGJlotn8;|DfoR{93
z^XUX9u{LF@QB!8Ul3cV?*z@C(bQ|{gocK?aqW58wv;WCD`?_}BG)A2NPo3!esmrc<
zD30VzYL}cyUDNXez5eM-y~N;*HP18F?9*nfom#Jd<^k#jLoswyta`q~QLW-9@^{_s
ze1_~rt4M>pd9_)cRu8?`s2`oL-!<2%Ro%aRe3dO?P%P51$08invaE?Kb7ZGK)K+_U
z*(!z)iEDalGp?_)&${#3!GGlNCqJ?!xZkBeZc-Drbl-4`n2V!R$NEjMr6U{;(fht|rDKmo>2k<)+xf?1x2X
zMSV=}uJ}e}N67(meax4U6W%R)6OCJp8IBH@wDh6%X{cH+FYi`ZySM-YtxrJ2B#qiP5f~Aw^Fz
z;0JSd(R0^(0AKHlZEIV4ij%3Qxv3`}ZJ#gq`3&alk8jwKnAXFK?#Jry%&EWUsXzJJ
zKK*+v?z4pr(LJ#hyH1^tyZrWb&%s@|+%)fc4D|7B#>1|dPi(149~5on?^iJn_Tiy6
z?Ze}?{NH1tj}M6pwSh0`p0Rzoht#WHKiHtY*yAicKZoBqu^|txdw1=MDQC}`>bzM~
zeSfAMT2ni2yT&)cGuU>lV6zKb{$Lkd^>7cy#^&&d$73;O$G$lAPBAg|v%iV4?`*Z3
zVtf-^gULh;J)Xpcd1vF9F&HcoN7f^M^3M2xVfNF}
zv$OT~-ZUP`BqMc?TspjMbBRyC!%Y{oiZnXV=eqYM?C8+%&AW_Gb=P@(6Fb%X`M%`$
z@wFMBu;9zYNn(V&UEinV9CpvM&CRp%Xpd)q`TNbD?|sZK$K-zUk&K?p$u&8VTnw)>
z#J`_u{uG7QfWRQu4c=44VQRnnpjJNgcOiGozh79e{l4DC)cOAI{iw$y
z9`e?mDt{hAe8`jkpz`FQ=<**vAYJ~W2c*k?{D5@%Pacpi|LFtL3yE?y@>Y@-%D?O
z2jP2>`Mpg+anXDhiLCUekV&5(7M(Tu$A0#iKl`=c`(M5byXyPk*pvRzu6I8pF9^T!
z-J%`?-CunSyItQEi#zY))_q@?@8tUT!uifl4C3X#e9y^$&Wd04$eCyrX?X1Ge^ZgY
z`Fw~c@sc??7MVS6#LvtJx@mWj569vgT!S481wIEzV}=b@9L1aR=4*33^=v?y6;Id*OJf2=x~a&
zyB>YKFaP1AzSEfw?#|Q#__?d1TX@`uxnHf}o3$V2v-acF;L`Owc6^9EY>3_&CqB&6
zx7+Dn%DV!6VpnX=od%!C)x&{Yw2HL8j(-)M6{+ja^=|R1$h*VSBK*#t7@D6L-sESX
z9p_--%&jxGkivBh#xhGPM#lX&K(;U
z@gE<=|A`Sjzb3CDJATc4;zGZQG(3q3{VLM7eEmN*U;j^gd=2~QYje}rhx{8&Z2Mu6
zc-l2SBnHF+TiKOy$0_mS3^7FC;AYNV^YKHkQ}Pbs6Vv`406+Qqj6JU+4c6|%XKh@=
z3*36$vTi?JCZ^^mrl+b~r^0&1DxHJ1F&u&^%){U7BEImzm;d6Y_=sO4J970|7i*D`
z-%}?e>)B6-?6V%s>BE1Y6p6)8i}=qzHX!TW$6~}Yf4(fDyS?NlPVDpSO#dImQ-*bG
zbY4aF;lUf3&e@8;#OT)VF_OD0{`@Xi?#;xXxC$0s?unw3na^H$!zb~wFD|pU$Cuwpi~Nt8d>BS1pV;esy3RNZ#)(HdB@Xm{cUmvD
zBGcF$JElBy*65?Bi$1wvo-X*v%)t|@-FCH@Wx$Et5e)?5o
z%`?BIUp3a;Q}UaPvm&3d{^u%)y26X;I`ji~iBm8M9XG`aOSVUbk*M
z`so|r_+Oi!{qF@=WY(<&CrPiQnwUXHKkd6yqPcNX1>TbZQtEW*IoA`yHlrvQ|gBv2FX`)rcR!xPWEVzI(>oN
zBTnz$iy!0Zi+b~zckkX49%6m!?;D5cr`D;Ld9PFZbElA%dnmOupJT}mpRt%A$6b=U
zNbT^fUqza6f6n{3vsRI2k8@U$=KB@zWzNax+sNsk@9>c0zVW$~9C?eEPO*Wmv-bPk
zsoiGnrvv)gBL6-^{qF+bm(@?b**f+1JoVmnXT?AEu!-$_>3r|_*6rm(b1=a(^$-tJ
z4|7uwJla0|$o^qbe2LdSdO3T3_Dy_=1-$&}Z2V-=J2B@u{Kk0)NG$2iqu8TIut2Lw
z!$Wrd7E?Sq*F4Ntk@)Iymi5Hklu4es#IL>2ipY$dJ|@SW=$hDd{>0vX?IB^`aqqe8
z^Va`a?~kzP_$FT;B93$wTYLfILvu-j9#e-&w&
zJEj)VW5yRbGrpXuy)W_ge}6^d>)2QmUo)o2=y4~u5>I+Dl=w4t$BF@QXs`G%Z`|)R
z^Q%b9y_d7~&an@zB2B#IOm)*a8s&;D1JNChOcWJ{=c^vhwAWk-ggscvlffDS&Q*#`)cu3
zdZ;<{l*@@1xtF}nTJACTk~RIjZ_JU?Ka=|<Kp}D%`Bw4;ML|&(<&@qvOSfjuo9_v+*i=UUVv3;c@wf|oB37q+I8Q7$VLz49S9EW<{vm5f+vi3
zVM!J_cwnk$Z~9eZEjX-;r+2@nj0et{^X!~F=d(B8Bo`y+@jJu
z8}-Dx{16Ap0X#kS`9b|B1CRC0&Dw@Xn|hFU-5gJ@iUo3Wc5<9fi8<$l-`M=jfAc8z
z=n*W?D$?+f-R~1Pm?v`;J${F{AN%BRdYEb6!~eg__n(e$-ot~leXyRs;TLnM1F6S+
zlRLSO$+0IsPYjbiW7vLe#<26m78%Fn(&KlCU*yuhJWY(GUxl+KR(|n4ixshVih7qC
zCtlsHu#p?7amMDwvG`s^=7J$TjFT_DzGd#19HPg}A#!F8Ia8ZCbShk~a}NZQ^y@;y
zck$$jfS|s-nJ9`}PiTQ53&rRm@86q_`*rlJc#D}>aQ)id5x(qQo_3JqH@jid^zj~lgoaMeD!@ORM&>fF=^XML4XOQE5O59FcJZZ^k$
zdpzUqwCY*QebMVVdHpQ1=r*xD=Don#*YV@jzP~iADO_>)aPb_?;bFa<2KrE!;A;pPsv(6XW$!
z`{K;=>Yo>_A`PDQlLH6m(T5Ms`5VA_Z_{5BLu}-;^!9ru^T(Hce72QOY@PDys*z7l
zuh(Qd!&>5%zVM`jGw_(>m$yY^LVZeQ%1+;9d{Bnmhked|QfFV+uAAcP
z{HG^6f9e8vK2UG?nvdgOzBO+TU&{%8*W;nr*`;3MV*1^u
zwxQUJmrnh;V`81XS0Rc@gaNVq_O~*SQONOgv)uE>6S)zg%^XcI^5Xj^c%1
z#S3}I)O)d-coc()M{y;`#3A{K!^9+g?;|Gn)ht-deD*x^dDne)Uoq+L?+?jm`M8zi
zd_HrUfB5gb=);(hu4HtXc6
zalTDmzYaD1HgoC`zc0U2yzlR7cUhB8o!g1W^xp5h=cq~Yz`Z=*0l!&u^BvGTk>=gD
z*Rx~C^w{v8(77|~NIQ?|I-!z`&x6e5~+mN-ZrpY@wXFcCh
z*(*-@My*XAZe#Q;`
zw3%Pd2_AjC51Z8cZa=xPJ9WL|L3a3!;ncCT*F1_nH^I!=yD+nsGlCgiCT4KfCT8Ta
zg$!$Cu$kO_wVNNEvx>Ct$A?zO`61u6L{IvQqgAA3p6_5XG4(t#WxqBtb>1oBFtNuc
zbWKbq_TX$j>#N2ZK6BFsKAkq;)us*Ci3?}$%5Ru-j87RO9dCNGh3)X8lQ`xp&vG^R
zee-h8{$RKZWBYgI;k4~Ou!lSSR*^P!df)JlKh}jcU$*BFD#Isj~G8<
z{8*3Q74h#@x9feQ-{F0HS9y7gcc!j)AK#V@^Um+@v+tulvsS*3Haz;|;pO^m`$T>p
z`x#oSi|?DhmtW^>pMj9QXccMdhv$5^oX^bpog=>=>$BC%BA?~_{=|#V#6UZL#{Tz^Ks^`@2!r(KDgKu9O4sokB`i=qw~;?kNz0Ho!FNdtN8;`h!nOsNaSCQ6rV)N9=
z+|&t=Hg)Rp<9zFQ`5X56-jq)CNgU9R?dJ9LGe=%>H+t^V-@Y6}~p
zJHLLjD0ZjLs~uy5^U1cyIrJo(U*eD0&~@Fi2R@z0
ze!htf>G=e$BF(;>(eJ^hm-FxVwqZVr%?F-z{H?N4)Upyy6-z$w54x)5E6YbCqwi*E!kS
z_ebCR_AR@oZ_Ujd+*O;q4-Xl`;1qu5+v!Jf+I_C(;8CZ7x88hwZ%^l8yJvm;wrZ@g
z&-_*{XCHalH~npY_qXR`av49FSLJf->F4K8v1UAdZf^RVo!ZQ2a`*YrdN78ET%fbF
z<=;Hp+&mkPHqVAZ-m{%!9WTE-1D-kCxrqmQ@DaWBc%l_Vn0r_Qb;8iG_2tL$T<%^zl9)
z1|xl9Cu949OZ-nR{o#{*G-t2*@Ee;;U4W}+SdxoYk!GF@@>WrJf}?vA(IKBdSBl})jSUgi_4$vZtBI&}TaduAt@v2WE_v&MHb4#~osHF}5_
za_m_}&LXqdzvuOg$6jk46VDS9=V%iX`>*3;F-ccC$d~lfZan6??&7s$XD>faJC5<~
zb?r!;0NAN(aNW&xFdyc{H$3>BgCpnDQ{CUxqtlY2Pu5~pe`jH6>>u-u)7riVZ%e?g$
zMZPO!7hSETS4;AKW}bch+5TP6Z)?rD{>?Oe^g1u{?z4(C_OYkiYP?m$U|@|N^qn|Z
zH<#}{$*!Y+O18Z)XCMB=i#_w50+yQCb#7|aU5?q~eEP}>`sO{(bI%(XC+FyBAA8A2
zKG~l!|A*h56aFr9=3@4G_s-bgv_%fTnRmXkoRJ))AAN$kHP6n_=ktXa^UP0?Yuxw3
z!x{E|aJd$FPKlaXdZ~WxJ#rm5f`;WT~P16qePdm&_JMd`Jj&9SjWBQRtHrwfZTeXRN`Z*(c&QAEzL!TT`Z&EjA
z?Sc8kF#F>Vz9J9d4ZeDWAFUz{kF&e4qT4*resa~gDaX0w%v{BnxUqj%uG{Nev8~2A
zJ2ln5w?**i`AYX)&(3jolbgHyd5u?*Cb#TI{6o*gzA?GA{ipb!)-(I9+h^?E$un9-
znlnB3+DMi?sfqTok8SwHM&!--|E0C2iB~d`$EO<8m2A4)b}l%FoqXvmW0)l7z3cXT
znK=-gl1KKV{;r+4iI2q9#GbA8h36D`BR=9!a*Y!k=~vBZ>=M&>k{^lX#4Z_dc~t}>
zaYEwGtJoxW_--$t&pf&ItkI(_V;
z8$V4f;9%~mT=(ul7XDyM-puuvHK)y7cZOIX!x|ZEAun}n>&~7$r6eGae>GBR$ZZcKQDT`*pNdHa;{TX=uT$d9byAr)f2K)U)hF#*R%7t-W}}Y
z-&Lf+kZnkeI7=Mi3tp?nnzdz6&Az8a9hWJ?Gpy+NVbLnmvNvboGv2Dxba3ufwaL1(
z@Qb_1oB8^kTGM8}IzzmXaf;d`W>%5L-X}$LN*?H)*)gTJ=i9DLr?yobt|INB*($b<
zsl%{2MO~Fk&gN73mUqC!y7|<%#H*OVhX;=NUd8jAr>A(rXN*>n=Dh3HATsHbTI5}p
zUd|!6*BkS@o>PD9Q%}x|&Wcu%X5JZWQ*%EpGS_VmR&<&+9$FXRHtPa;vo5$Nv{@JE
za7_H%grAMqjlJCOJ+5Fx9((yNJTS=^<{9_TAMT#a!zQun9nd^Got1l6EI21VbGGNK
z8>9Yn0MBY&WE-1HKEQ*#9v5`SlXKjao=@>zA{+X7;)ZOoIpgmX_xyRub!KdEhVx+G
z^Qu3;z2vd4^VqxVIk^a<AL_s=)fl(H&{I>VsCt)pSH>Ya}V`hfd1|_BcbkFMGbZ!yY;KzS*+?S?zt)`!?}DG&jV2av?P(dD8D^d6|3GIQN%x@QeNA
z&F3{fEBXyZKPpnMetl7D+N!a}XZW^ckhh9HEW!t?=!f4p^*p>a^^>_?_ny_fJ>=y5
zkZm(p$(yWy|3d#XH6fPn?Cf;s2$@&yk!5H
zBC#U2$@V<+C4OU`fC)wiP=Nzy?4@r=cnqa=j61wN(`?WYni*tx=e>%c`QCt
zi+jGB&pV+y_S=+Uo@1MQxvp*Y&3yAb>y-VOU;414sOH$pQz*T
zRgXVvG5))3#CYCMzizcT_~q_wGp>ZY9Bdw{rTv=;}(7}^^W~PQQpDnmEWCxUE`NU
z;(8TnuoCw_SG0<>$goCceCB!PgBX`<&L<=5=6h~@SkLy~MQ$AHi_`&j&bkqNVtaU<
z!4`JH(_Zz!ym2th{Hi(4{IeqRk`u5CZmY(cn)J4a%zV!DIpy_b%=6N#BauI&e-1g%l>>0
zjqP~jzsS+^g`UmXkIx*uvnRei#^;f(Uqu?Ze3yRJSlg<9-zsD2B^JJY84Kq%=65ol
z7LgO3BGYp}GZ>IH^H#h~|C2raZ*KZu&TH5C+)F?EoWqBFMmIWomT&PbY~mY!h;PZj
zGkuF67Ck16&50lJWE?(n;$K+dMdr~e(sB;FUlzfH3_8;{G9u5q`keVyW6k`tqRjgp
zKi?6pBF*}fB0Azh#?F{J9qU`Rv&}x3NAC13eYETNmcCn`pXq*#&*OjlGNyB4A+|fu
zeEiUT8^2r2KI8CY4;k^f@gcs84E{SWT18s+T2Cw(drvvWe_MAd+0%dIPXEbk?Ueqz
zZNJ9H-B;q34e;wV0S@se`%?$R0lxSqKF}xL<9~C=Jr-HUeNSpc_Vhd#e=zx^=&Z>1
zfMUTOXQAou%=H>#Z(`0Jocg3znLj2j=}s@bGq%o;E%*|<^b#}b+A4ytUNe4HL?%8u
z?UJ9IbjG}Ew%#>-pE~22-ZP%vQQB?AGn~W#U7W#AF~uHs@QG)3^Gn9C$k^VDg9Cnh
z6JO#d@oWu08Th;3tp#UtJ;!f7_RS;uTkr8{jtue?O$#)7A=No^w#(a2QWZn5siy}XEkvZctxNXJH*1HNBGk(m?_&KjRZN|@4eh;qv
z7azeGP2JgLK6wDV*utJ~#2~x9H;6gU;z1lHCKIRla__4t;W0KZPMo9O`gwGZje`Ft
zF_w6O|0>clcU6qhVaAxfGsfty?TfLA346%4$2sgKd+VL5+m7FP|J0eJ)!71_nTJ_&x=ajgI0j?!wG}tP
zU%!epd+sxC=n|XwHa6*3ktRO#PGLTAVty4R-k#T(JT?Uj&yl%mtUcs-6SHtoZ`2gI
z#!k<0N-g1IyzG<5sZVUp*#7XdIsB0aBlC%^U}hh==CeOM&dS(X!FSbI%f9sMV)lz#
zmvKsGtcX3X1^PT4|e_r+O;+J2A>9uuDF$spD!sxOHsF
z4xceu@C)vGxZ4~2^=M)re{}4VLy_ITYyO~QL>Kanoj>K$$J|vh&%e>J=k<*FUGMA8
zfCU-wBm-{FSDUOm1CKen;!&?(6~&hH(~jWN?NA@sKI3uP0mo?v9_`TFbxz(7uCkSF
ziKTt@H?c#P9%J^yf!=zyci!ZA>VW}LYnbz<0=J)X%(96IwMzE8k4`07`YW}Z*duNrIo_M!-{S|JyH
zdF29L#OiCv8%qMuE0vY5Oa88BnDt0E>;mtIz|QGPcTYs
z_Z-Sxui0DiF5YIm+dJc(U$jHxoi6Mn+aBkzjcm5fI^D6r?>zPgJNx8e;v@WcG7l5$
z`c5w{d$oN>Fz#eX7
zXH4Hz`rh9y0E|_G5zSCk)Y)QW;SdH!GI+j~`
z4$ItAv2osa>&I9J7dt?jKNcWUn9Sr2?w@*Rqwmsx7Cwhxu>4+
zQ+)Y#yYJZTbBK8D?_p|0Fi9+L#rN0ce#;%^?vbDRRit@Vd(*EPYg>2R4_ZwAej73Q
zwDv`Q@FyGg*TLW3SzpY}`f|t}=lor@!yS`%3VOp!?KH1zQ6gRI=YY~6aN$~{9y#`gC6*u3>)@9*4ouoN%)i6gnzY``8pLJV)lLv6lK4Irn*2)9t!3
zmbfBg#udB8fxgEe-r$`Y7d))3A`O1{w&DoxI$EI8#hK)c3vAGroX{eidoK
zDE+#a-M(M{fbu6F^6ej3WBxcVIxFIn+^^)PCVUm%`S=(<;xxH0#**7?O?^l%CqL}T
z-c@4_J}B|*euLkWqVNVkc!z)0SW7-!^?rzN<^y>%ADpcnnh*3jrj7<1SOiPd(;Cxd8rYp59ZaKRg`jvC4
zF+#>w@!5Ikc1#UP9Lh~`NT9_VfA8(hDJJnif)mU@peaAjqU=@4xt4MoWWPKH}%UWVDd65|Y
zu-0NfyNtJRIy8o(SC3(HGlsuzKkG_f@CA&!zdUDMzlt=zn|JB2u6*D_xv^@@ujfVT
zm|Bv!B|rXri0^`QJEm?O!q4VoYFp|V*%`~JjKy%q{E{($W$Yay^$pIcmpU*7=8f)whR0Grl-#^g9eq=vd
zMOx-kOXzY|M2>N4NrmNwZsv0yIpK5PWq#FIv)`Rae>$a~I@o88p7@;qvdI3#zMR3M
zUqzaI_g%AN7u{l4$Ct0;D?I#hUIcf0;ltKd#9n?h|Gel`5gSuK_!CcjL3XgSC+Dvk
zYpL)34s@P9`na8D|5f9#`v}G7JctxbiH>JXI{59ucH#FKSnGBUP5(u-B$2__8*5lEK$TjY@#Mm4i
z6F2N2iyU?s$A6h$HK&>9Gcwqge$`mZdFj{1>^rRF7I|ky?xN4i5HgJakQ(p0m+;s}
z=Dz=bcDb6oren9mUU53(kh~d(->Er`AIL~t!G@p6uogeVUA$PQE1viZ#>g64MH;#0
zdtFqE%*$adKA?MiuAj2#VXoT`<7q!XPy5YH`|)U}u%B-9zv
zCZF&npXiqSGd7>xAa~*&e|Eh2j-BLAjK#vl7_as|VBGQEH9o`-uum*xY+ta48$5zz
zc#>1*`KJ3Ye&RRlS%s5wm;>lj))^YZXNqc8ZI!8N2Ou_+8o#|#iIYm$Qis9JChOR#x
zgU6J|Hgg?=vwEHwzGg)KTk$ML#in&WODv~`vL$hB
zjF-K5`K#Ax^UgrihxD=DV~Ti?k7pHWWX+fmQ!^%_4}NkYZ^i_>v>6i}
z$3Av8T*$YFY}h$Rtsu{HVmcVIIT+i64-eU$C-dZ6--YQ`p4l6$jCbK048vQj2jgll
zojR_@6IW+zhvIq@jGY0iU~C*e1;Z`u@muGQ_<(J&l?RFS_<~G&#(o(4F5%}YL119b
zK71Y9%=a8fOh$*CrQg~g`??IZ6|Xfk_r0w-IAQ*&C(mn~Gw5r)rHg%C
z4nLD^PmecygHvoZH{;|cKVzW>zd1(?IA>oj-glh*n#VY~mpBod{Z2e4W>U+^$XL9k
zUL@wM8~3_lP9Djb&Tr10s+WK1Xa3qRXJ*bPFITN4fAc72EbYmrVR@y$<&FPVCK1?B#%VDE4&Qihnwi
z;Y_$*73Ych_>#TZ>x^A@hWYr%*gifHYwTM^!B3wtzUyKs1}2u|O)ULPPdf#c$HaHA
zWNXIs?Kmaw#Va1Xy_Uc*80le|{fTk0X)T!QSCMAE(=u6YD;NHVmJ5I6o?PIsoTdI>
z*MIg-|CyWq^BF+9j{oR(O#BC1_Qf}3Z22a*cb^)=JAMm~eidoz{2x^e-cuqECx_*JO`cir|J;k(Rl9KBj}cdg?Eo;OiW|3RbYDi+^ZCEw
zp3ndD?)m&b|DMnP3-0;+xA%PhkMH^Xzwn;V|BLSV{J;2~&;LvA`TW21p3ncw?)m(`
z{GQMMEAILHzw(~X|Euo#{J;91&;M)g`TW23p3ndJdp`fKyXW)&`g=bA7w-A|zu}(G
z{~Pc5{J-g*&;Oh6`TXB_kLTy-R5$&(OaD36sm6YOp0Hi0|U}WBz82jnRwDUHRkZ%=Dy>J#d19
zc|C07BXXurp6Abl?a`ds_2}c9>O|-Gk}R}}wB&KmVX+`)vInLi`tt)~YyVva{(YXTj}NkvN8>
zb^B(_n4dB8am{HnX2_=>8P@2?CTH@eb-Lm)$M<;T+UJ*Jbwd8ZA$2FV;CoZ_x=6lT
ze^L~jU~8ZAv&R{pQMcLey7V*HX+J)?1z&U1emvT=pSIc+=IOwn
z@o{2>EPG<7=kOTYPu9fIT-JM@d{FbwVyAU@lfQ~I`l@Msv4#25n$LbcyMnjgp45JL
zJS*Za`x0-?jeq+%a<RDWoMVGAcsTd*0
zo>k;5=R7aE>KwciKXFG^bR`?l^ttEhbNXqg@HyMOTO@AfI9>GgL90l^GwnF5xoO8u
zW5OB7#xC8&C;vtN^tyob7?_eoQ^UZ~ddo
z{^RP+#ix2iHd;j*9vdEfw
z>o1DDH?WJY*3!#^d`2|SzW!|guIIP4=G=S^rPq0p_mWklv2Wte?ydZTfi-&2cj92(
zoHaI*{j8|tXfMp!hhIEK-n@@eK@_|?ns@5{x=
z@qJLn{#G<{_|3fYoh8PSgJK2N!Q7f>e$vZzy%^K;Q{)<(%U=F-M)Jd2nfHQ@U-r_CDRY_Um(
zH8R9K9pG=BzIe>ZFFdJhe5u~1pSIvN*JF-NJtpjh|Fpy0v;&Ve?I7>Eb&Y=Hko(Vq;w#=+1y*crnPk9~NonI}_EhCVss+?+LQ56mZq*&ly6k357o
z`05dUw2Cx5&hEa7Zu30*$yMXFlxAElOeqLjI@Fx?mxmBd8Rpz(wHD|B)Bs^#pX|VI$>tG%IB{}Yg_(B{+
z-i-CH!@o8*YhNC%;&I5>?KdKp8J32MI
z>3+W|Z?^soKys2F;+0-AH=MtfTQg_!4nkKs1Eb^w9D4qEc6QdU%9&NX8ocd8{N*e;
zMxMB)>nhT$ErV+IJuR}&_=C%_y5sXm<{}55vGs|4a_*4361H@*CwWKa%sX{RQ`?=L
zd&Sw}iVSOHu$w$~Tjw)8=3u_XgAdkxu!=M`KPh5o;#@!NCC?mNUKZJRR@AX1Lp)4d
z%}rbJXt!;vvzLRaJv3Xpk8fklU+{≻Q3wB33-hb$$Gnv3(ialbR;B$ip8Q#$67K
z!>^u2POpvm?89dAQ%4hj^d;AM`m7tH)R>QJoU@FrWiQ!?KJvWFG2i9T$DF;+)T5aL
zc&s1up7LTt4tvN^@7@%>E|OEpFSW?|*5_xE)Z6n~gV(%gJg1(ru|L19XLI&-9_Q|Q
zri1qwpIgMvc~Sf%23C;Pp@;~GfS?E>SWrN)fdx=RQ4vrSM5Wm%
zcBz6uzV|n0yOGw&(+_{kb_JcF9Rz}|wMUHj%U
z%>79Hu!G)w2H`iOeJ0uGGucniHGu&i8^qe^+XlXKg->OSJv}SrtvoB}E6>Uh@feHZ
ztgI_Nrz<(wA;!`^ywW~0j74St{fo#xHSoRBlV|EgUlR|p(A%6N>O~*$UV$bz^pBs>
z?PvDpvjLy=W@icAS>C$KGXozzUZ+Q=3HZVLj5Yd_cX5739=_+Y7p;>yzjt|O5DWV_
zN98`&@WJm-^4wp*7ko$F>%1d}3qF_7_zjJI10Tq7K9|V&XD9Q~%R7^I3HfakM9x2#
z)`ySe*LM{BvUhp!GRoe?7xzw2`hpq~x9g2v>=CEee7B+7wPFu)&NXwHYvhq37iEo*
zWsMlieO=XvJR{$%M$~+UFk3+XqNokIaI9r*pv&6eBcr?8u+DyRPaZg{7l?8DFrM>rAf7I`cCcgWThX>)GrX
zAO4%`OyA%m_0DyGaFTgLA%zgM~Y
z->i2rKNp^%52m;7U{31)jXRi{&V8$jMAs>>cF~v!Vmm%pRu;5z*rP|9TVrKj0s+uXJium{-TG-
zy?_36Pw@R}p3gJBv5r6FB%>ypfh_!dwy~3K&`%2+JNo>yA@&xg$GB^#z3+mWo*DRw
z?y^SEWsREkUG}rtb65UzHpnTn^Tzq$8GSxG^b|h8C*Stnve-ZmeeF1##SFiUnSEu<
zJ^5L^tJr#S{yB^Gmpau1hT|*!T+rGqte^Ns&-+eB-~T1wh=+Q4CN^k#kngQC)pU*e
zhF&cDhIbF6ywCFaSlD{dH;bZ2a=iGz-dI%k`=ZQ;?}wWFWGrZI
zoDa{r4>$u0+XGo|PxFmka$ge|#I`8kFFmb;?`nDhAL#vjKXZrLH_PBBeEje3z3lff
zI;dxPzo4T$YsfO*?6c-Ons*HO!Y=+%Pf!yW_z0c94;B;6o*W-CWqi9dpzlo928^5uMZuVe@K0`M>iVx7}r8l#G$ipWN_a^(uCwy{Zd1TB-kM-5`
z%z$RE=bD}wH9XLS`9ap0qCi0`gB
zb#a`z=IFM3cQq&G4|EYTddrv_)sLDp%9!1M=wPkvZPw9;zt|#o$dGU1D{aFo^NkGS
zE!%JW9R>GR?z3jk3)_Fx3LW$!&(zQTM@`+M@O>Vsqt6txd%(}k^t$EU6VSxrzTlZP
zfDfQ1Fj&KWKFj9K79UycF#A0Vjc?eQC@^ZB|6AQ_t$Id=ezy8sD-o%f$
zYSg~C$Fv{_n7NOe6BOPEQ3DFpv%v$EinS`C7)%@
zT}$WJ_2gd4`_SV%j%W7^`|;1Y<(c?;Q*Z0D&LP?lk9*L%X9o|OHT?A&G_}MBaFQ@h
z=qGUQcNSRZ=L-DI>-|NuPX5R_->m3kw%lTRW^EM#S?+Uad@yQyX0SK^-7Eaz=d1Qu
zb6$|c|C->t2_NBuM(+{VhWt3+=tCY}*~@L>G3Xa;_2%8t6M15%NALw3_(Fdz>b`a#
z(jV^qvd7)~^sS%Cr}vhBpAKDR@4Nrd;hg6E@W_kn;MsiF1Q~MST9c=mz+jF1(A&cW
z&Lli^pbtR%?z11v>|qT%vjlj^F}uH*%f7`9eM?``yZB`p&PZQ@b@=o(KZ~Q2*>XMu
z^fI#S;XF0!fA#|3xw-$jL)b%{HNm~_ILJ+--X~`JDk&A!lz!@1q-E
z=r??sB+x_9^p^XOnB7PC!an>a50+uSpREHK^ms2cGU!0QQ4c#O?oIOQ{mwD_(S=_;
z!*?B=XZipcgEN7wbI%OQ`XfUPsX2XzZtS23o!Opk(buIO{6|muyCvk1A11J$b^rYp
z@(&+d?8Pqkxc{vR->>ZB{E*xH4UcclXzcL!Rp@!_v>u(l#=T|0dhy
z&u5<)@eMyYN94d~mbi)8=ZhTp>@kxY>OelwQ|1G@%m;fIWj_8JeOi$Ia6T5cKNe*^
z+_V2pHF`6A$~o)Fb634j&%4*@Z|)U()@Pq}_r0Hef57*>!E-)C$gqZP?`P(0F=v~W
zp_f?02kzWy@yxwWoPJm3=d7FkF&6e+##u)fcRG0mHGx6Qd^h1QzVQCxJ=iL+
z2VQ>15RYm13HdRPJ@{)H8G|+K`F&^^zpIGb?<#UaEouS-yR4(b-)Y!IA3WZb<$boO
zel~tHdXf7Zzlp(jxcd*j`^vS;J?!kr)%wAU`AirPhMwjL3*Wc=;XV?`W>@-h5jsig`Q+|_3k4Mznk-OSN-Al
zGMkjG!=ff>LDHGzQ)ddLNL
z0JTAfd&oA>zcBi;-9BN5y5T>tpRN~vl=b2+W4u+b|G)L(OjD0VRWEvh9;W8h(mhYF
z@h)K9cON`@Z?-_6(3@qiz$<$N8AeyVf*sb8<;>v+_H7%x`7Cml@tYYL-)HD4eS$81
zVh>|iVSl~7PS$*?aJn#8I9oVZ_>gd+@Dbrs;d0>$;VR)%!l#AL311Ly6mAy2BHSW;
zL%2=&w(woy`@#=}9}D*j4+swm4-3B*9us~e{9brU_@nR_;qSt8!i&Po!mGkOp|1|_
zV!}XS3E}O+Qo>+id0|CiWuZ-I7e)$Wgz>^^!kWT5!n=hHg-wKs!en8pu$8c_u!Ha(
zVVbbJ@LpkWVLxGiVU}>PaF}qUaEx%gaFXyo;WXh4;Vj_;!g<04!bQR*!ezq8g)4=t
zg=>Y+3ZECgD11fux^TPjUEv49y}|>+FN8;g-w00%e-i#Kydb|5g;)$Tlj?~IFu
z%LKkLJ}F!)@O^Q;aFf8d#jV1(gl`LX2|p0{rud2QbAj)PM}#K?z9pU({w(kv@x1U)
zfo}+2fc*r%AC?r}De&zuL|92^6FP*^0^ba)3u_B}FKi^#1ilrv5VjHcPS{!4P2d}0
zA7Q32OE^S0LO4b^K{!P?O_(d3Bb+B(C|oRDCR`zWQn*(5oN&ExlkgScR^eO1w}rce
z9|%7dej@x_cvyHuctZHS@U-w};qSup!as#q1r8721_Om9g?9>rg(1R9LYvSbj26ZV
zs|#xj?-n)^YQkh;3t<~!2VrMnH{rd)KEh0y8C|7X-u@iqH9rl7|b^tgf^U(gc@
zdewqnt)N#g=(P%Z?SfvXpw}(v^$Pmk1-*VjZ&1)17W761y>UVF^IOgzzt75at)M3s
z^yGq`QqWr$^fm>(Z9#8e&^r|Ljs?9_LBFSW?^e*e7xW$ly=Otcx1jeb
z=;;N$cR}w{(EAm1{uzt=C*On6<^2aQ*K>A3A5_o>7xWTc1$}Zs4=8AUf06Swq@Y(QXnq%;<=YE-je=gYpf@XMzBjYJ
z%?o;JL2pseTNd5&Z@9eNg(4Mb~fvAGq@x$)49h7904-IV^R5sDV87pDQrfH$&h~lW3jdZCWCyz<6DFpWq&SgqR+DIqxLm{F=+ui&fKPrl?Rds&
zjlup|g8hMKpLw=^&yDP48@AJ`z2uGWKm466U;{nO@QIte^E_NAeNd`9d*H)*AgAbH
zrpF^)b$W>d@C`ae;M_5|^QH>yF%R4PIh(z;_3~d**qr@QOfvT`zhMoeb7r6b1^cVJWMmPt~F#PKF%*T(X
zPjr~aOsw>R-(9ZJXz{40&m#62*rOiwJND6skLbZRcS%iP@a^BP^XcE;y_`7)@eC8t
zgARI_pHXW9qtt;u`-G0Z0`|!V_L;4dXL7^6vYx=7A7qVwqaNsD4|(^WEu_a;!zc2R
z*RTVhpP9)M>i{3I!60uu+eh*SvL0-3cc6C!QF~1
zwx|iVe5Pu8X5cHn*;jH2h<}{G_>+1SJ%HSG2;>d_%YC+s@7N_rz1=$`_Toct_mV%y
z+uOa!_jE6P2k5P#0>gD1sb}=i%j7)Q)NAw%Yn&xN`+Yn?JaSC!+3VV&-)rb0x74n*
zYx$nq?aoH-seDH8ofxp+n_iRnzxiD1%KbA!^7JI5jJ4c1L^9-_-s#Oga^TwcW?$|Z
z@AH|UHUPbx7i@6G*)v6;KPC&*f0DpC2b?i#58s%mXL7*#MJM;8e?FL{XMlcwm&V?j
z!0>rztp-D5v_O7JKk)^*>j*10CdoXL5-z#KRp5
zk2{v{JoMEBdJG$u_ctKC;eus7lNa8LoMYYr?c=Ei*r#og=WH
z^8wgDOTZuGc&-VITIc^(wj1&3g+_e*YQ)C|=fBw+KCdfWGO+Ro{lf+K1p9OU5tDf%
z^z8c%{qT8THL}&rKXTki9$nb{a2$WS^k3KhXHX9{bWvFMR5OEO#$@8u?5-+(C`j@ar=9#eBJD-{G#a_13gb
zzM%1sy7_$e)iYyJoX?NR2hK*T!1?^RX#CgI`FGaK^LeiLj7I14K=Cg|Bs`Oeo7)A-GOt~oy?+K
zr*AknoI`#-VA$``dTte*&zhbY@Y$2^1bUCYBUe`|S2fMZcqS+Qu2@XZ-iuB4a&D;|
zwy8DG{`sFA<}>e}!JeN7>3OIC51sI-*X(#kA3SFKXcO=Qp8J<)^l-Ng7fkzGp+h|O
z;2#4$!vtbu58smHi_vV&aigcVabw5+=6D?k=VeyNI5*5?yzIqqbg5Kz@j~Z#`-vux
zjAk))wdQ!yLm#0FA8P`m*7?89-}BU~kvuhHttJq^?}V7t@!-&7?-cUMGrfv`@bE34F>>Emm?R*RZI2dBp3vdD%jagec(a9?z(5u~yf;5J
zusV0wXeJNzV!Pn?x^=ie*>i2|`E)P#d?xmMwikOo7kjSj;U4Fe*!=Sbc_m-ulbo@}
zJ@a|#M-QI@|
zWZWOr;|q!&wikYPdt1W>G1@M%XFC5Lt(iXhil0HT
zxu@W`@E?$Ka>ujJsq;twVH5l0h5Vprw19t&bdkGK7y8iQ-&b^{gZl(|`+|M^!%t#o
z>>?~HpvQ8&r)mQC4>h;X#K2&WO5J&f+^h#`&st4jkQ;{eVaxA~iFzI^lzJUMelYMI
ze?d)P)H?t7jXNywVV}^A&+0vUg+t|IYF)pX|83Jc^mQWKI
zwa)*o-Z#|nRw?4{oFMo-@Gfd}2D$&}>(K(wK9BD8vIoB|-OYON8^szu_yK_)oGdV0
zpPHTlJ;?mu0J+ht9wes>V&lFcSImIC4-;wvgZqZNkvwze8UJg!=&DzHnu}J&UFM=E
zJ^fAfR&RQm{PJhQmQ&KtfzaT6hb`*E9m?N3o~xO2!uy%wJ#+M|U;odWt(ktu_F)44
z^Ufz149?rP3g7syKrWvp>|$er|(9wzvmhOeh<
z6Z^kqiM6-;*|RYFx%Zmw*HWkN
zzDJ#7=e<#Gy~nb>*-LGBr*AG$gDC>vZIcD-f$v!1Zhnm2^
zE@zif+Q~Hb+3&jseKmp6Ob2^_>r>M+19|GeC~a7t^%?>i&E$y@f6&kGlWGE^nSA!g
zar9K49MurkXr{lc74~w@%9tAEJ^R>K`)dNDnawOuKhzM`u)O;oU4Xbjv$M0T)+PzO
z2e^}ayMOs6`{@^ezs+p>9xdWus%KS%~UjGMwvj_DNfa@+@o%vzGSf7^?f^SXJ+aHm*i)!^~>;>}wzcpD^M
z|3cRTFVCCDx7qCjt8cVBV*a+~Z1YaZW%_HPiG$u|=I0FTa!x)KYwmAybh>!1o%;>h
zL&aZ0GdkRJ@b?hk=fQmkf2#PdhkFnH+Tx>w``YopJ$Sqa%=^bbE4e9&cb|Cp;Cm5$
z-w_Y{nfF!kuj^%GY8$HO+ALxYtg!t&$FnGjvL-00Eyc5&@y@SvG1I5pI*rA};FX-W-vB%E{j;pVD
zJ|9{4pP#E_Yf1LU;#qb^@bTkoA;2o*I(8j&|9bF2{cWORFGr5BPZt(Al`FonP&W*G`(<_K3?xO|g`g4D*c*i8(
zdcng6^2fz|VaU)!*F010<2xA{^3MEW0o}+v|8%|mdkXqf1wE&rrxo;sf?m9!pL(j^
z-hHC+X^y~rxqxrfdzDz5sb|(s7reIHlhwZcW9|KE?aDt?Yvxh!j^LdUa`3+T`$}$Z
z;!PDV*Q2AL`xNwJzpHfcvx)0xIl=A>;j%L+10E
zZR>BpuJm|6-&ffDLXw#sGTy&=$XuUfp8Qp%$NRn3S27pH8a#A=KlZWK5o@a&iSFi^F8uq@z8T`$guD5UsU_JPskPf
zRtw$%iT5}CB7nV|cV>Eu`P(u7R5Sbg3H?KsdjOeRVzvx+H+!(sH#^q8tC{`eYEZ0k
zXR!aHF@GcGA8NL(*M3&%Ik<@oww4c>LqaC!{*DK#{fEYyb>qibv36Lj{YbNY+&0$k
z3m$n}E_nAR-t9lF^iNN`3xenT9IiFu%x7cqkRd74$Pdthe{Qg1)+--&fGP7xX#>y;MQ}dar_Bzo3^b=x6l{(0sP;7tNV^rw*vk-(|t`z4b_(yJaMU?6M)tUHQ}RSNngR
zWPCP{inT{$ZE)=4Zu-~vs(t2ZspXpBalWy`pCPcWjf*w@eRQuqc2}kAH?eO>TALYb
zeZ@oP3Tf@7?^gR-V~u}r-8v75wSKYouC(^xoz*`6?RIpol-5p&wf?cjzu#`1Lu1W6
zEww!Lol4ihkRO`luZlJEkl!_UZ6OD*EqKEc?@!;Z^zto&k9Wn)zcCLzBIZ%CXEE`H
z$DS-}-#>mweczlQ8a+!Uo9h=c%Y_X8raiKwLzepAe|xq6Sv{9)BV+B0vBo>fwwUP)
z=J7G}Z{b7p@8RR`0AZ=yD*eyvnYFR8hV4tgRjtv-tc{C#^^oD6`^Yydnb-7;4E@GD
zA!gg+477*rOCgJl^Y*Q8RC?yc+Nx=7|5$rD)`-LV{`mE3A3cd(d}CfGWbko^kfAqO
zTO;Omlgt-xt@N;lZcQzR2hXvs6>H>XV62&k{Oz~Y$6z0jpB!uSBR*i8nST=sd-(aW
zuT}f|#M*kX#{RWq%{(o&Jo(j1-sf`tB!5V(b%d@BV%{`lu=k~}RQp+T%qIuWb+o@5
zr+rI@3}=EEyoR4Qe!0@=bIN~f!L?c|*7$ETun%9DCx;9^o&Tk3KYhqrE#@gn=H;6!
z8TaGFSi}CMv1Xo@TJ{Lu+d|i*B>&t^l`iv;zb<&3LwvAp^lukyj$!kp>xC~?y39k@
zZNcLlplgdHe{8Iohx{hNTRY^pO7bt=Sn2nr)^VlChQqhihX$IjvRu3?Xw-t>iP{|m|9l;HWDAn}&RKVQkw
z&-Uv>!CNKqmJQw#;*kg5W6ait&8x4gbkV=oH70oO1K$~bZ?NyHpR4u_Py03w-aC>V
z?B#tw{A{(4^JaT9g6Df3dG=X1_F6+`WZHMdXDVI(j^KU8KHf#>X5U63Lyy|tgP*SU
z`Mz#%umO_8
zX{qHipR9kcA5+kq74+f-{lHcA`@bj}pXf#B_weBP+hcF7A#-BLQ1{taR{PwGGeYL1
zB=eI`R5JNn^}^uMi?+8z@Rkl8*7d%mYtJhxUG$>&y(@Tplj7h0G0#c+mj8IQ&%Jm+
z$efmBw)-ZRAi_<^HHIP`)ttVl^)*%r3`s%zpRqsyO#Zj$9{V4
zo{v^*z7LK}Ye&bLza5TFYa7HG_YOLbNo###&GBlfb>z)_k_zv#gyLYa4|R
zr>1>lw3dB%{=$0t+Xekm(fIJO(4nbi-$G`Sg6?0?KfR#d#^nV)v!KTp^h@X0@4us<
zFD>Zl1-(u|zxJVeeLpYgD+>DPg5I#8moDgEoL8^^3k7{#L2p*jD~KlNm!+KF{lSWN
zdE%WaUasX%1wFo?TMGJD=hpAPv7pZpjUQi6HrorC#S8k2AE?*4XF(4r=!eg#mp`eX
zcP!{v&aRjLX+fV<&}{{M?^*TxPb%n*3wm%t|KrU1{SO!PjRifop!X^0jS6~rLBBe;
z-rf_UT@&V?MQu3uE6197T57rHj7t82RKsJ%%YCzb$oxFXy!8HhnV%Q*B?UdZpf@S#
zWeWPQr&oUcD%t#c@V+M=u{{!N#CBAyeLB`2O=~N}nt57kx$m?}|7Sz~@g#q2teJ=W
zdcnIcF{VZ;idg#&-lU-Fa%I_pIP)YMB+hClhaU
z@O~;Dd3ie4(DAeP)!V;GG%{aG`wuH*)-C8hvFEF4&mE`K>pi=mcM^@A3)7x|o?P*`
zFIf9Wtl{TXv1Xo@T6PZJH$(opB>%6IDqZFwe_QZw3;7q4{LEORrr3Tlt-XF?eJl?b
z^k+n~=f|=4muc@7h3wFRe({8Q-S-yswFP~0LGM)1V+y*Zpnq}v8@~E`^oZcy8-8nQ
z=@Y#B67Qnps=Xf+k9ePoxm5*%=D(eYPQEFhJhqZOFJ$OBWccqWF)yBEUpc0d{ZPm}
z6Z2vryF`-RK4j5j|6e$|+Mn;OYsAav>d26JP`bVE?ZM-}>tx=oN7e5;tDt8T^d<#8
zqM%a~1$|RNf3%=y7xWGVJ-na?74)x9aY-7K2C)>2N64Bo`V+o;&L
zOhG@hU%lQt3i{&(eSAUhRnQw0^ss_{ec#IOt>q*B?;pNuYS}i{_DTLP8@zoJ@6LTH
z9s7xgj@hxMspY6x+dkH2rnRwJ%kPJO?Oo|vBV_2c>%_}4$A`>;NoM8X@eV2N-!i?@
zxlWSbCU^%W-Ya`ma_fc;{=0zmwx*Uju?7$QN2Rqdzqj7M3k&*S(d;=i_7KzR!8J-;sK&lL3O1-(r{
zk1FVAr`7Afx1cX8=%Wkz-39&hF7^6uDCjc_daHsSUeJHpxnAE73i=}jeVAzSx}kE&
ze0ClbnMaS_x_y1@7mLQ;Cu1Kny9Do?(D|vP^9S2i^5!9bYVght`D>H>
zZQEAz<{^JT@XibQ&m{Sax2fdKLw+;y@_Bi2>w5ZIqKRR<(06pq7lmHxvueor4&^Mf
z=OanximfU={C7=R;~XDeTB#IQr~Hch-i!Q*|0ol{~>
zQ_E#r)W^6_K~ELUp8QQQsF3;l)PI-xl6X0nmxoOL4%xGi*(_wXO}_UDo^yUy^8MJ&
zE4$>{-!`j@m+dYeGUVDa4^64|kz4aVAzt1$x1e_`=uJb%=cI%D+!?wwwQM%IUe_4W
z$b3Fz?@F@kO{$k&rJ$ePtbYBMqS19@==wp@wPGRLCuDC5*&ij@Z6?<1T}w22zZ9}R
zPO^K}>SZ?*jqF!K_P!*0(5CgWJBmj3Ya#oSBzyWM^|G@>BYSJeK9FRe-?(1(?t;EZ
zG<$E3J)DL0gNL84^UE7maz9JFo5jnuKR;ylPBQxjk8dgL%!t|d8E60Y4J+OI#oEl+
zuc>8fTC*=J1`j!O9+2cezCoqy8^PSLhA^YUI^}22;
z=-HytK_4+cm2@p$$bNmDdR-qB&7ON>558{~JohlXrHXyOTf1J*Z3X=?(dd0ReEM7R
zX;iHJGS>c{)*fH0UhkI+`a=bMplIwo8oFLex-M9=T6-+k{+ZUES)*DzKX}CW4e@d>
zy|18mF6glZ{mz1ZYV~@3cNO&2qFpcMK59F~X8TDxb}YVGb=`(w=g
zLWUmy>V!(BTtoL=hIeTO!PrtDCuC(^Z
zh-xk0`8SA{eLkX~rxf(~(DC~e)9W4eI_?*Z?Vm=ze-rZ`Vvk&E*)n8!XCeFBn0-GX
z^WFAJ5APmixCfb^)J%^cvvJ7$Jl3#*3}?eK_YAM}JQ!>2M~42l%w`}l!op{%`ReP6`)94+g8F`7ctRHJj$J*$$_M4&AzIhU4U+(#{
zVr_8j8yoX#v0qcmz>xWJ^5yPTDxKU3=o}yN_;PZrakg2Tkk(d(o{?ED=CzW{sF2~DBC~wV
zYbTjI-c{LpN33zykX>4ufjI|YFUN_17ZN*BDYs|Ss&w5Gb?2vKpIG@P8JIM?U
z8Ru@LkXb*;+_FMt%eh-QWHv}L+lP#Ew@S!tm}H(BQt5H-hK9^WNoG#SICpI!vvHDH
zK4hG`VIi|glDU5Q%9e9CJY+UaG803_xoZ!ZT9SEaxk`_7*AX%klgz;(_~2;St7gZIebN{8t3h`wxt@6EyqY*f7?%
z2p;yHX{nFp7SZ^5Q0zY`<}+iDCjI~GmCV7hc5=*TC7HeEyg4{@tF;L;nuJyCCTwDPHcW=U;v!M(W4D`-Au4wD0)f*(P%D
z7BA~sHe}9E`|kN?r9b;{T<|VTa^r)SZT|YDdi`G#O^kEXzGH*uzQM1N!E>L$`{s+)
z-m}x*9fEgG;{EA`O6~)RcUJJuO}xIr`(Wao`+T+c2UsUNo%{rn)7~ZT5E|l^YHPmKUccG9&+%G
z3*I&2Vf&j&$GksP^4G@Nx6;~YW9`$ic3WDT9&6@dXH4*J4>@>${$r(|??Y_w7qfNV
z8M6GYa97FZ{v1)zEd~APGnMY`lD#>>yDRa=i_-X%%(f$)l_TPEOf8t?g9h=b1(Ab7%hITHQp`A}=X#2zr
zZNHeI?VIar|Cm_^*z+@Wg=U6F{h{3l{QG*)%&gNF(9F=w2h9vUBxq*n6@q3a2Ml7v
zfBWcMIVXo~rsP&dho~YtZaN7kZ$12H1i2
zJ>zqaU##ON>%OP>H`<_m#yLaK#ECrT2-jSO{F)K;TAI1*S_KC0IOH}LP87KRxU2AK
zUEyxodAH^X0)CM@>PJo)@W@YJVT{1N$$kd)qE@R5=(t&+hsZazI#0kap4o%^B*D6&
z*A(!VS}=AMW(Gc>`EubC!qvj3h3kdy36BcD5nd7aJDL2QJpR7ydjiKg$@O>yKt4j|4+g1)y4|z3tJ023;Yg)pZEDWn4i!127W|%O;}4!vX5}4@B!gN
z!iR-Rgv*6b2v-ZA7OoR+5N;N}E8H#IBit|iO!$THYvFO>cfwP`pM<{&&j~LH{}Sd2
ztxC`UVF}?K!ZO10!n=f_Lc1_Z7$>YItR<``Y$$9hOcJIFTMOF@dkcpPbA$_otAsBK
zUlzVA{7m?r@SO0HpwxAq8M)F~N7tL4A1=@b^w1<>H({E
zhA>N*9W!Txo1$4;k(Z=Z<@$UBCu>bdD3q4P#S5<~r@8V_|IAXTEcW
z35-%d@$$}eybEKmtC*bQH!G%Q`g1)R)q$SdU7#oNje3v|>NQMv1$wE?9s)T+hBf+r
zfWSWPSbD#|K>o-v&&ac%agmU7+nry{YG=J=9=p>=ZSafXI2MIJ3#xCHHj=v<3N-MI
zS~T))j`-!-YE(<-fSh|zmh-)pbHSdPz{ozJqc{0!6c6wC|8zX|p||lkNAw#x%y*yr
zd~NZOV~sNcpeGB|miGdAA;(~%z#z}$mfTnucV@1eYe}C|OXPDceUBoCEqviybC}ST
zKj^?dqbt8S+t}>RufCFL<`?$_|6K`Uz%S(16@ECd=l&AYK?3m-7kYSqpyx-@gHFTm
z&`rc6mkeU%y+^J&Uo!;f7J9nCe)F8~uHq_lGF$uc6MohSuYB)etIP{>*zai#$wi}_
zz;|t(6K3*4UpC7NYdxtod9?pG>pAye8545U=$>BI`ry!8*80aitTlD(ZLPbC>%XDa
zjdIf4T01Y)dZ@siF;kc&(7(*|iPGG8&c#S#g(dWRpCo`srOzAVa(MxaS95gx`
zvm`^VYXW+Z!RHQv*nIzU_IYNlUBFjrHCbT)q?oNsWM{nm{7h`U(SwcE1a$J=zTRiU-U(`fgET1zJZne1U>ub=$f7x)S~pwXQ|8``D~OsB=4*iVuOP5L=V1nVh4MZ#P2I=~`O1E^2Y*3o=Df_2j@KLf3`H#(<)^G8zu(}j
z-mkilx9P&Za+DhL9fTgoLEjD&sN+wfj?L$|S{jXuL3^M7JLchSPw_qknA|2dxvW1n;D{nU?d0BHJqLGsC+
zXnhN^-{*Tl^D$r{?fc%vKKa->^yPf8M&5k~a_0>fd~rv4M}gC&mioo`IkEF31`JK-_{X2noKJQL)#9jV?3Poa_METWE9Z$%UWtbs}O0C
z%)@VVnU`ii8EZG%3b&RM=yboL!z`U|{Qf38B(SJ%%$cepE%ai70O&)6il=%ByplM@AULOze_#)K
zDS`Yp>J4nrhv?*P;hEh2U+$5I{)>9#6y=&4`TWuo(7Y?C8GZCVA`F!S{WP&S63OoU(3T>Ag8Y`;Na^
z^il$MGx4FHo<-t6%^y1PBt#dkm~
zmZyKPS^8Dxb~nk8U+zz2>A(Dac!+53NczZY9ePGLv9kwY-*xG!O?>4Hv5#l#Cx62d
zZF@aA|83d_+z&nRi@xA)a&GuepCquCyU^!~xHup9XMbyLC`;P*8z*@p6AlEAr~D+%*kzFSM(+Y_*{|jGJVW3v
zJ~(D_hutAUhd^!y3YMF#XXLw*Bd6HNG0hasok`8{m-uS}W7BHtyoXt5Ke1ucdwAxa
zW}Rnzqz=%;F-ag7)Oe7~$i_LUKOd|iS4_}NEY%QJTpdS(dpJ3iC|2J}Qh+dE@8
zUo(3q39JG3*8~Q8EziBnPz-Rk_
zjaGpi+$=y36UZg-`=VXXjL`ym#|XariIaUG_a5heEdhVnr=#1jUzQi2K@RYPb2?DK
z58{T$xhJ;a0;7~8F3XWuz7L$=Qnr~+>S`VMjt=}FzV7;MeaTQ~_d`!(VNdBFI?N-d
z#GHLbH@u$irSH+>*ocY!4BK(OOIhcVUSO2+*)P|pr+($Vj)`2CHt-4mdg_0c#ee6j
z)Z-dsn}L4L0Qsl);ExkJ>#y%;XuffHSK#}2fi=#da>94{B!T_(
zw(XfWSv=&?i*5Q2-_Q+jgn(`ad$3JCPZZF{-cBDivmbrf;F
z-$>X|c&~7raHepvu#WJE?99?kE}S!B=V$r}njJg3sRemveM14>FoC>18hUuYG}6-{
zK6Ri!*hkHQkiOOnpVd!dv3JQ4Ce$qzB%_ithk
z&%f0({Z#rtL_GSmCNR9-NY-`m8F3xZ|GTi&)4b=szwhPVW;N44GdaIze+ZpDshQ6n
z{WML`*3Prf8D+rdJxGn|Gy1|jdda=_q&C7QPd@)OJu~Q6?vD{dt6-bxstF9%w-iPT
z^bvJ`N;+*X|9)$h)&Tb4bM`s}{J~G3M`*@W0X_7OVda;QQu+?{R7j
zeR$%b6I+}szK8IEXTHBC3x^5p+eENWwn?vTD`1P**=PUB10bK|*}lW0SFyuBayL>y
zH#%H9_~dAq7y~sUPswLZK*nqN&VfhXCkl)`tEuy6Kh8HkG0qZ>704}v9=b^9
zh8*!-fGvPNgMQ$dJAqmvOD*XY-xJ&`^eyY$8D58`hfV9T^Zz5-PqTYN>FZo4HU_dh
zyT0@c_1IKkpdX*mOP=}vVs{ZH2zh+C=3-C
z(EAG5V^B|W%pPXes1^4CzT?~B0_)gjuxG09E`dGh?`{uq{3QD1JUtT|K001H>AKU1B4re`%7_F@fu!mYs6d2A^wnt6KVU7(ysSR@2vyGX0_U|3=5xP10!f)goeRm+k
zo$ddR7g_7-sSf>6^?yPj){z1}Gx8d>Y_>Kit>KIH;TthyEAs~?KKY|g?-#f;
z|Ek5B=6?qLH_?aa`4R!Wcgi`wqlOFcNr3G^5+lBj6R`i=_^vbkuxR?j^u3~q+w`5H
z>0#5ih|c=HAR2qz9}K@&$i1Jl{N<8wwsyYOW~Y7l!F$2qiTFS*j+Gof`8&N_-%IP%
z0C|S~>HN-r!wEU~%$!wb^drZ6OaCO{{6DMONCw+?gba6(b85opb4b#0uXyYs53F&9(T^XOXl)72&V%D%?Y&ydHJdCN9o|p>y`sOHhEC3^
zeg3O>*n^L5_{csievai@(Yc2CIm?|Zx!Kz9KFD%87srQP`>~hk+><+r&U!zozyD-E
z$0k2_5Z}GXdz0Sh4E=pzbq0t_kDc*(KX%~fet@Qy%*(}0U7)!GnECS`%-CRVkD2og
zJu2ogF%uj72{Er0^O`ZQ9W(wSM;y!>#Jo|=SZgl$hqU4J^m0BR1e-}th_{D5M8~DW8
z!WQd|XmqpA)yngl0{w*_jEe;9o-Rxi9Pb%=rk_pE)$`T@`tS!)w>k0hZSPZ`F@fClFl`&Po7vSeZ^o&mv1qOcMGsCsW^7J=*vCp&j
zkvHtYr+=swzVJLr7%q4X9yuH(;4ZOcd14wS%oea=+5UP)7JcXjes&5W(*!#2KH
zpY3HG1GLU)q~nEN>cBp>UyOa^rIBrVCd&42cG-iUd&n_rhrX9WUsw5{ubdD2@y~_u
z1G_KxGX6$6e5DsUmXpm{0y&^($rE+<9YRlosRDHdoH68i=I4TO0%u9Dt$FAeDUj=|
zgS&dTFhd~M{GOVDF7vpf8Sq#p_dMetd%h+hlJ}sePw)=ZytRN2TM7){FPx{*0)A3s
z>V?im?*;rvC%Hv7zZd9jYTgX_J#c{J))D?Cr?JJkBX8KAF6=8K(=^jZY4i-J-i#pJMj{`?>qKp|M)gV7QgVb
zE7@`{KH#@=L@w|N`>%Bq2eSB^F=LY@6NzFzCe}-oFm>%c%7jnddo!pz2b>I5lLT;SEzQ5{BL5~j_-kth+KvQRq
zkt28f+=m?fh2QY;wM~3#k@vqG`;qm2{pTb)zrA_)vY+$L`Vs=ZlgqpYpY?KWvUu1l
z`IE%somBF%Ba`#bdTD2X*66Kr-{#`+GgHY&A9+|>KySG|CD!QYa*e(4*^7=w>zq~A
zo8^VRV7*ap&`-az?i^u{8Zcf}U9bz?NBEs+p9%jwggo`8MgU#J$?UkX4Nbn8$se;Z
zIG&e_c}UFkCg0uo#^8J-v%c`UjBqC$B%v{y#|roexF6{@`VE__2=J*nK5>ruK?S|U
zlmDCm`9zk!!Eg4ETd=0UUW!5td2feka!o!O?Po9gtfP+v>6cOm_VJN{ZPxR5Kws@6
zFXcY!h<%3Z^|v@f)5IeWBLr$i4v7anBL(uraDJ-%_3e~pok2d>gA6ea6^Mtu@W@N6
z7RWWeFyjw4+5~vWP7z8O?#gz7yp?Nng3rA+N*Ew8Y_nezo9JV7r;mJ(5$GRsLtOL)
zz7sS1`TZI3Ehbyk48Wf)vd7Z6i+kwwM`+tz0OaJk^
z>`!#H3iv%;AfCl#XKBsIG84b!YSS~dBnJEM__9s=-ppn{?MLVS0ydZEfld5$kD%ZF
zQBU_0Ik2ze^o+0i&yRK9$qyqs6pw3&ZpPL}L}e+!cn`iY#7i?@X>d?f!O=f~8h
zXXF^<-F2s598;q{MF;1W_{-eCJ?!Cw>+T%3iAN6E%Q|^+PmuHXCYn9;K%0OK_cVOY
zs@JItYoFEcV|`B?EV@HrA9fg%1!_D=u>Zu2576jgoF_fx?Hv&Zd+cKwhilX*Z`dJ+
zjqEl$C-3Y*-mpiEYsKswl(BYYoBNBHks;2dx`~q<+AjH`PUORP${0P56{rCqUTmOW
zs^|9!Hu0AlV|VGWiwydhSwB!{6X+A{k}I%=fKATl7{NB_CF~)OZFKOnCN`FlQu5`#
z*k8|W0iw})r@y>sM+=(?I|%4LUbtBJqHwS9xbT9oqykw<
z7$>YR@OL6+3cOba%SYnF4!)zuaq6)%kJx67pIwM+*@%mJcn>{5T=Xl0T$KHeoqj^r
zwVZU3|FX~VqfJ0316y77IXeB`UcQ(9VcYwufuD(WNccw%a-ZNIF%J-ki{YMLL3{8O
zKDv-~T^$26YX=DEAurfqOcomD&ON+`*70q{9^_7C{LL$q
zTF3u|v6XvcU+Kc;N$CDAtPg&!B7N@9vfk#eDLHz;IdUIx
z)*96vy+apJFS*eF=3ul?1*k`ao;uTkuh2uEAZ}U
z^xon9K;Mj%jr`u3Azqt+?ndt&YSS(-n!k5CI)9#=Aejw?Erp|mGlj1T_Y2Pmt#W=@
zVNGFM;V|J$;Tqwq!h-_;-HtwTWPM==;W*&};S<6w!jA<0+q|tx9{;_|VZw$2|1FQ1
z0{{KVONH+Uyu(H*UUKbs*bI0A?`p;*!TqM7>$37m*vuCEzCLpI2&Oc*o
z>N)o-K4E*DY;za+++(v{V8Hji%Cq%%=o$U^z~DQEoDnxZP8O(zZH$ljsE5CWvK`{d
zYX^zO2VzDqwwxE@@H77GFSH5B5O3DChG_J(7JPJ&3w&kZFLovgU^}X#npod{T
zI^e05J9*@3=Xfsjn|KT3!`e-JklOjakwg4)oUS3?tehWm!{FSL*U17ooFowEIVSVIpp
z?+D-N^kliVrg-j|W^4G}XpOw#1Eb8_h6|WC&MyBJWv)rHUfW1Ea{tfJUSeUG@A!OA
zI2O*KZ4sOAMS87GK+e6$y<=JY>gqluAMB-;)NJFZSyy+W#Om&k96NgKoA2~Z8pPcp
zIqKh)Z}d&8Ku`JiEt`ga?8|wWA-YXKCw=3)mwcA~5ob+$y1Gxu-wuNB!tsfl>^U*z6
zfZvmRP3k6J)XIL51I8o)en*4^X`d*mgbYwTbT-^K`I1$-iw!2)@nDzF#dcM;f+U(o(N
zz&2r9Q)fKPtnVwd2?GT5`W=p4azotIi#1||59SE?ij4l)?L5m+GuF|)zd(;$7T$hB
zhk(D>%rRlZ`D7nJzy7Fk=X6X79(>=|Y=;etv(keHZ$$gFbSMKK$Asp1aby
zLld2?+DpCdzjdJ3btew)0PK<%{KRkn?rz7(sm}*%&L_P|OgnX9ADzg#*81b+oqtBi
zzMyY!p+mqncE$*t1N_H7=Vg+f0lA?z?~z^l0HBB8+q4PTWA9|4tnn!E1_=onaZ`;GFZ0Z-xiz19
zxu2hvj&{-X%`VEd*T@BNvBogpxua+49qe--GsqEO4ZW=8{vlR?UjD=j`NFTk0y)Kp
zY4QOcz=vG~^pJPfckN=`xukD)lN`AK*5g><;UmCb$Ala?>k#k_-?Pr$d!Unk=}zYu
z$@slOOnVeDaev|~wxmnruO8@}B01}1UspO?wZ6H4t(^p7n=Tvq
zX9oQ45Qs}lb>|hI_7>CmM9+?b^NlZFBiDY{>T!OY*xaXx%Q~_gwV)2n=v+%^bS9i%
z{KY;#u@5`@%1*vhw->KXK$iX>7ujFl-NeFhUC048kaKTX|9+vLoMYGeUB4McoUEh2
zRhTTeUu?@U4$#^d!F`Ue)je7LS+`-L;aP|MnJIhZ3*gVT0`?f@+ZOd%RbahOti$`g
zazH;=&T-Kb#3d7T=X(E$kyuKb(3=U=;sD8^x73Y~=%yy<9wRtz@{V5Ch!uUC3g|mf
z!nw9vi`OQ&wo~++YwNpO?D?^wo7`~+SNUD6b3ZxZ+nK&RRA6AA_X6_xiErezRlu*B
zfM2t;$X$UfGrC#N{*iB=S^i$C`)3>R$wfbb{S54(ceeDBJJ%L{_{lKe{eyoDa)2Iu
zCl}UrkOat`?Pgt>&mDmc{578*!DsmNp!wvB^O^l7_C|Rl@2!IUIk=mgk&n^`zdvoS
zk)36d9oL9lAq&mxtfC3Fb=gz}D{ACb>zh5x^k_zsg#)Cr(xs?a7N%didh(=*KY
zfNy*!;eV@u|HNFKmHwUg;c}vD!a>40!o>muS!^FJ+wM=>Mjyj`?D+rpmw4x}EowxK
z@e7~G5B{-^EOAq3VnP2z!F^rRGcntjBea3~!eh3a^T9VuYpkIg8F`-@d`Df+Q
z{Y+mmET8?P7Sx%Xw}uS*j)^>Bi&~+>J=Uh@enR#Wn}3h`v1g1hR^aTSpSzVlq953c
zF8&NZwvLr8@&Vw}k8J|->}LUCu!o*&6Nr<2_J_Dw_uX+q5Bxc?i9gf|JNDJ~@yY-H!T>#w
z5xT3xdXgbOC&^Z>!zA(Ags$rFN5$XMI&3Um*g3gD+}Rd&IHic2b?h{&1K(C<9jH^A
z(5w#bzxVaPpHrLo(<=SV>cBTT=e1ECs2h33M|y&o$;}+u$u*cLUYp<=&_nqgJl!Dw
z=q6vB+3I~#{axOXqOo(JaJuk$;XA^k0s~)sf60ycy-SSvh=1U;$X9tcWMBJ8&S&J|
zs0}(c6FLNH!hQz6qW5&^^?M6h^tB5N^ULora*rP8g%}(^I^Q3@<};u5`aR_PU<>WR
zCVfVp@e>(raJG0ynZ`$aZxfK?uFCq5eKKwpIev?1qE^}c%
zI`B2;8XoJ-a!sDFgFS3xPp1B@)|-fjA9Evr$PycS?N6JY>B}-#^c}Ht@305j{(ef)Oah`qY=26W!L*q9+)B79l+p72wFfv%pM1%7vipXbU?*MZq*
zA^S^yh=abi-}uQlIDS$K$GKTNTh4WG4vCR5Ng%H7{3Y+`z*q3W@Rxkq?=rvC1z*V@
zYt)s!=QY@y{md~F6Z(C}S`JAIKRPO`&a7dZ5;G5JwROK>;laS;FM4!*~r4k?(pViV9--jQS4Ee#1*U78vjb3s{-w-qXmG3+D@c&1)3B;NGnIf9?
z)db?ctOx#F-ozj3#rL0moug;!fls~p_8upBeEFE{?s^8oGDx_FsPBw$#^~E%g4hP@=Ct&h5h)#ox@-svR6pf=iajR%Y5I(
z673weIZYIL$=hTB-OR*^4DzmDtDe!ns({^3XpvqbW@h(G&Kr7jzpW`6-{|R*&$&T|
zeZj_+vf=xwjLm#>vX>k(90&fRPz
z4?iW|Iq(l&_LnvCO-@?{$8fb4$QQPm-7n5He&M^{BiQ49z+U#(``l-rl3wqz@5Jdo
z8>8p30`&sahhD-zE}9rWt;I$)%dz4TJ%*i!;vU5p=nkQukn4xu&vfIrbrD0Ui~2L1gU@!O%kMS!
z67e#;|8qUu&v!-H`{*Kf_}Lmd@t1xh&g&%LUS~$$b!yYIdu7W1WA9Gjb-l{+;FIh#
z#o&Y?iCWDWbCPosMhP-}xMNOEKtNO=Op54^8WF)dP!SXqr`o-t+TeY
z)K9H-Xl)&;wqhM?tF}@V$MaqPz2EC(ormXr_q$I{5WnBIeq21yTI*i-aNYM>&-1=#
zXYbsP`RZqt3~$%nI5+oQc>Q><$n!&f*|{OGR;>Cr2K@SG3%~4z=6CeVKG5d;nsPwj
zH%DK6te#`r8g|CzlPxml$J!Y4**M6JeAe%8S@>tj)%o#VG^Szkb
zq4UPzRM2P4or`gOIpe424fMG{|DP>%*l*rj|9SkR4{-m`fDP}fQyV+)W;;I{btLon
zduqTYPS|2QD&OvWKb|r2-<`?sqh8s4aBw(qK8f8K3Zw6Rrr>L8Q-0`Sr?J%L_bhB$
zS59k_3@)sh>Rc7a_x?4+@qKH?absd>ZFpA53trCz;%@G~Kl;2&^nK#y+#e3e;=)2C!t~I}r``Y+dnZUh#yINOUhjYI#z=NFOf<5n+{I%xB;8Y-oAopra
zEzomQa6F*Lc{0k^AGOR^^6wYO)4z^i;~uo`a6ne;`NvM<-Pvb5@AUk;J$QQXX~8Rl
zFAKgt_}<_bgFg%2HNhPYJ}@{FXnYY{IeK$^X&vy9FUJDn9mk8mnPFTT$A5IeSMxjS
zkLtI3CS0E}9Q>P1&gF*v!vQYp1N&sz<)fS&5B3FO(HhT>L~rY7jE79e>HG0XU9Ic)
z|FcKGe=>H~@%u;D^t<&L@$J^Qe{9Y5{oZZ5{>Rr`k8|}mUH@-)S&wsTTYmr48oGSXOfOrjbp7-SU90$?<765)
zzxn$!u`!-EKONuXU|-PKfC^IW&)}&dH@1J13UT^|{b|<81DoeQN7;TC#{7c|Uva-|zI8O^|BkGY
zQ@+}FeB(Pkd{<*r-^I%}@3nmY*@f@&!T09!NbU~@e0NUKwGoVQ|HqlNjg8!>gP(mr
zkZaE>{D`~bUF&_soH{Z`{`(`}+N@kTKAw5{`99@n=N)6`-;nS_Cr;!DZ*+febep5^
za8P~yd^XDSZJF%U_PxoExaH?R&2Y?5?_Gxj`I&P2BMWYuH}lq99nkr6Gdf33N8Q!2
zvC#2e3mred2OZ6$m}&>_-yJ{IwsUIA-I>>HA}C2(EYT)+}7ec=S$j=*#n(k%d~)b~;}_r65qtV-2ams;iRQmo^Uk@$!NGu^%Y68b!Ovy!
zibcIl{jAlu&pn&+Pw~CH8T8I9O%>+t#$t&VP-a
z#vl*sQ9Wtn_|@qfUl#MXtgxvDoa5se|IqX`IaC|XH(5DQQ|e=1;NSIb4xD#K0)CO>
z|F151qJzAvIOO0LTvGv~;yqX{P
zDVv7_R~+6Mka15R{pI=Lxo6+lR&YZww}4z@DAd*Y|P2-dljhR#Da{39u;ot?q;{$e|AACyisR5fW
z3^YFA=>IJAn(N<>;5&WRkK@;;Keunh5jER9{84V~wdp!%fH?km#r%z#ANTC2_fJ-=
zqxWqq=2z+c(-rIJ{j(MGtMvZ)igon<#fte=djE38I(q+V#r!J0=T@wv*TJ(g>K&hdp8eMaX9H*QnLxeX7Vy(Krmw~~V#70OtVw66T29#8>#d8}w*0=_
z*tes+z36Oa>-K_4u$gyQj<2aBt&bZO9
z#=-a9csLlLRXj}j77yF>HV(cYik@Zs$mtcCpT_0v*cVJ~;82Y8zDw4XGci6Sa1QmX
zx^gi;7yo!Z^S4~k-5jxT|9h!JUD5Nd(c`%>^+oQ+=VpCrjPI6pQ|{ytH`b2)JTmD(K8S!DRkmN7AZ+#;sRd|3MYZ2u7pz53d<>9fnn>iE9Dy72D+f6b)-
z%1QqdC;g{P`j43O-*?i#Y|?+rJU;0-r{1f+Aq^~a26Ta*BD>Gg$$bDM+VkhUE
zs@(H3ZrybJ$r-Pl^~ci34O{e>vqlZLnsco$qb=iwz2g4r#r4|7)&4N*Mfx_WqUK<8Jc9`66!=g!?2{8;{@#~;am;QXh-{``T*R|nr4{6uhde)#Iy
z!S@Eg99)$@fb|iG+sSDW$rjHwELG$<>nKPz#UH$g~oqI#(##;E&
z^zA2hPX*+w^I^Fs%OAQP7ucVg=kJpOy01#YohP4n^qzA^oxqiWeBKsZA2=&|HdV&F
zT#9X+bWoUed?AzI^Ckv*_Em`rW_A^;35>IrO7?CQG*e(ASv`K{mcMO^ybAL7>U`GOaHJkfVJ&@Z3rKwo~%<6FOZP(S)t
z1m@*QU*7cPQUBngFUR_7&-}?nfB&MdHq5Je^Xlg8;$A)7zPMLsXBPK2U%5rsKDPw;QLbo*VhEj2)t>HoBz0Ghn|}j&o=Y+Q@Y#FgXiWRcVIk^pY7*C
z$K?k{@@MbZ^K#*w5|`%L{=hiH&o@MfKY0GQz?hgmHjoQ?%un|wxwkTqMy~5VV9}rI
zI+5{>K;7ZWQe5Mheh|Cy9MRj)NU`HY&g8H1WZ>?gGDjDEetho!d-kQ+&20u6+idMc
z7p~RFy1MR+><0yWR44M@>oams6J2|STv*eb$Sq#A>L0K2e07Z5OX|ZrFyBJYwhmW1
zt_tw0zQyWlf0O0A)^p&B+#ebG=JmyjTl2l2xv>|zZ$2{jczi@~ZT#vu
zF69`PR|g$`X70)B_isKwA@_4K&V;V3oeXX79XjN;^N-EFG3S%I>G-X=KN>hkYEP|=
zGWH0W%a)91_`JR+=3ZQCa4YCuRv(*zc*j~+XP0{KTpyj<)QRh=lAkMb1x=(*`rgtEim@EfpL4=Gw6LY$X{o@<~;mc8QauJ+uZ*Doo9Yr
z+-}Z5y6EPErDA_h(A?+)TgKd5Cl0>!IlzyH1^C?zG_e^!5^M$<`SBd_9^>rc$FabB
zn8yG2%OKyZU$%~o;{k3D1zUl&@4v^j{LsY2mtJ?CVLN}v-1!Tdd3LUgFdydL*ETZl
zoThs#xFO(Yp9gm>#&D{6rkvis%g>0U_T>}ro_lyL2jyflV;cLdaa@pRM{69tj`7GL
zTppYW=pp9{?9k=>ug{I6K971YOD5D2sFmLTbzk|;U%Bv%)keRug)dM;u8r3k&tvWO
zKyAp${(#Iz&>XW-y>d;)=W}^gD~GeVIqY8jfQ%mx*d(u2hg^-Eo=ATc-jSS-oIZ-v
zY4y9;vDO}(dC<(`3JeAtJ($&=X{
zhn1#i>9|jCJuhC8w{A-vbkE6$c~|?!xZ1crPTid=
z%$5|o3z?3=%i+~F8Ervj~h%iXcn&x_IKV`k*0{_}OJi|x~a_TuDQ4jWIep=@cL-Ilpg
z$5V&TN>^v@Sm1oEU9#G1b}rjLS16wkpUKNdX58Ed%*;J$G53g>xyLT%Zkd@=?{q$L
zX3pmkb00V}H?5J|BRAH_o#|)U_WDQVM(u-|@IAl>^eGj(R9p%Vb`)
zhRhq*ka^sUj2cn%-e-36!~4o8vz5Ns#3lFguC_emem!T3*uj{+_L%(Jytr}ay~h5{
zw%Bev&x4)Mf}fF*!latRwRN8qXdUZyXZ^cxpWW*CV&L502%HH|4Yca-b+6A|`Gp%7
z*Y@v=>-gL{7JJ&6pxo`xJ(&Z680Aa6b24&D#`!>gPDZ_waiymmsR=gOl6QOT(JS_d
z8oAJ_QvCdwbuKS=B>+m&lvAIIFT&TgRja%1P=ggR{``|U!d1hJXtdU#w=$R&W
zx2>_>b9P*>Zo2-=iuJe=vuCh1>Z3l4I&NQ~qnvp@FZ1E-iuKMxHe0KAtdPyrHb3^D
z9P#myLBC%X&lLea__GzriSfqzxgpoyxg+rIa5$i6Dr4?Ua4gsiw7w6Exi;nK@o{W3
zSMAoF%lY?A-5Y|-f(HgTvi{8*Z~v~!CuajL#Nqj%<;T>{so}9U+>beWLVPHXo0-#U
zcRWM*;dya&;GREt#TUDcQCuIAiJlu%e#)Wz9S`^-FI$1NPu$~L`s(N9xd;5q10UJv
zqvsbtHv^6R>GuQ6d==-(;8399L4DNcC+*Q^`?PDHd=YE2{O#(laUYwR!_nD54EP>v
z9}mslX705c0y%EowO^jcIo!gs+GLkc>fs3iU3`63;Cq|eke_8b)VCTv8r0Wk=e~Yf
zcXObQ#PgCsj>L-R+RW|t&kK%mn7=y^gL=3%;GZ#|yL-Q}7*}8Qr82AbKEKrWhbG^f
zxoV^Sjr4B|k(#z~(z#`>?0b>kX++ASV-#PpOQrp@%V8v=Erk@>L5
z;K_g6^om@s55%n99^i*Q{^KFy+x&c1u5x)r;JxR=7kX~aJ)SlL?K#2e?Yq1y=iIYi
zpASEfKCam4*c*q>S@!bLKI@u&QKM4a7BU)$XN{~i7g)19Xwy{3V8F!`gQpisI
zu3d5S9e?<2o#3kb0xzEH_#lTPXX&AUo)ZB-duEd9d}G9&^*zJXeq~(kA6K!e(@}Pm
zGq2BYwp)+Y+q02x^c)Wk1bmuuV4fav(o07C^d1iQVBA>iWHa}gI^Gvdb>fgty6G#2
zV@*~U4ve?%tQq4rH|2U+yxzyyIv()rir`{=YYyMhzO7r2xGi6;z2*s59Obony4X0%`#akIp2-*Mzj~mf{7?6iap!pByRYj?z22L;YCQC)
z-})`Caqo9u9Ljk2$8=v*X52fg_5?lk-Lp+C>}5~X_jfj*cfN<+`5qT1p8Gchmj&YG
zH-4Q}_&FAg=L^}5V41x7syvz93A7bHRGN;!tdIlS1uUa$bmpJgnFFair
z@OLxNZU}HbwS{-K*pwT-O?5Tz=IL*q=(l#~9NhUG>Zj9xQt-mywZR*M9}F%J*rJ0i
zzOrRKuH*bp0bPlu**9y~hV>LG?4FpXNZ#&iPM%tSLH2UZ*_b
z50CuqvuGV2$|H*)_>(&W>R>kMvN6oJr
zAAZL8ZcJYeFI&Jql)EYS^vjDl)_M22ENscSJ^0Yz!-9_wJ}db0;Cq6f4gMr}&lrDr
z@buvB;B$g64ZbP(7r|C!aMnF2FTHOasT*~TU%A5Xn75vJV(Z$Gvr!KY*2zB0@s+-(yKCEkVx<}Q))Mo9HWmnCQv3E?o
z`1hQ_`!o;h`b7VfhjD+ghlA0FsjYQuRcsfNbMdX>#r(SQ@^u>TGzX2@wY7I5_m|QS
zbvE^5+1DvSf+QcJ~|_o>AE*QTDy+kb)V}!w|!qR>RqQ!
z`fM2MwLGm`qx>9e*jlA~^ckQ@q_dwqd
zoEh}eLAK8k&kr_k22j_wZ?#u5K3!W0Z
zDER!~n}S~qwqjTQKPb@TsP|K@uFsqr!)eT(&!OCmKO?u>e#O0d80+=6^y!`E8P7+9
zb#&r&)Hzpk^t4V~*;EIur_LKUj~nx+f+NA)^TgV6W{qc1`%?}>`F6eS&sF_QdF*;N
z$*vnadAyzs_)IT8Q|HT$G?36pVsw{Jnrg0zsp6r
zGrz7M;(urGLmX2-mhI=}Xl@^s?=k)<_x9ztMYICG~SE#
zV_lo}*`>1CJu|I6`?h1{#aKVXOmnub@A9**@3ng=_X$6z_V4YpVf3?SVC$-9WzUtd
zmhd~Ch12?WKJ#^*=fl0-OV*EjX|J4&=X^PsJ~zuj=Pw0Eo(WTq&SY$zbKp|em0V8i
z>aW8O@BULiJWuv5IPo4}56G|j;-kDcqm7GWSzgRn2ESzWr_Za7yRtDiZ`?fF=C2Fn
z!d$c$5JGJfS2Uf+?d~{#*Su01ix9VBDE(hLyM-KKX)-d&yh*X9yYxJ%g-?0_(IWzF5uABwxcG;OwzB^yu_36PQZm0k5!uPIGyJY$A-L4#xaZa~C
z&5``T{(v8s2g~*tz4WtLeIr*>-6tZ~9Nn1vQ^92mjJ$}K|8(6E^m|9+&j>tSJzq};
zeDmL`e{%5h;7fzA4}Ku{cfo%N-WpsHL+=~h6tFq9Csy$o7ZY3hb7zXV#>CJK9bw3k9^n{?B=KW
zResW=9!Fp2;=N%FJqOm%<2`COe-5sxXO6RRzl`}1r(En7XTNh4yXDs&Tct<+?WV(C9CcjGnbR|Noij)MI4@2H+l1qBJkK~vx{&XMlXMATloIV@&%tr@*J9uUAy5O6Ge-Zpl@N2=J1n+uTJ`V=@
z-}yb&eaX)0V9HZt=w4sv45EwNk-+-#-BJv59MRwXy6Qb-ncgu6qt9ofcl5b6GR7?@
ztKt^VzBTl$dS~DtJ@(IT{#+ZG-TXPQh8}0?Zh8)`p@%#$tMu9ryTxp;j5?-g)jFSddRF4E&p3K}
zKkixe8bqOdTVxD
z-}8KxAD6G8XO$lt!}=+2&Q~>rBfQ9cW04EI_gQ1UXC(R7$n>4{rl!NMab>>(z_s-I>(bn91TkSgU
zj|c4IbY0swMOKXJdiwmVkFK?|SHBKq?bNR^XXOJAtv9u^4%Y`GH*&p9Z_k8v^?If(
z)4LZR&klN~dj!`$(=9s#x`)em_fPF_X06t*Y$X@9ZFHXF4)>Rj&(IIyiB4|KdB_>$o30@1K!dgfvg6MN=e*-^vg$$Vj6+|8Z7z26$Ip7zTz-}qqv;F#PP^E-ooV%`@l^HKhB
z)ciMg*PbcmtXvu|CnKk7u^h>F??=AK?+^IHFT9VOjdj8&H6l;TbREpx^#Pxj>0xu-
zGe%Cy%jd~J%=g{i*}u&NJC6-MHu%gy9P%RWF)z-&=7*2+vg~ZATx%N7<#6sf<=>fa
z51JRYSMh0o91V8czx3J%<&sWz=ocfu#7Iwlc5Ut9zjiwAYP=kDevFF@z8Z6DkU!R`
zJ+Z1qb;~b)ushZu*>!8Dy6GI_73XfbY@Duq$8Y21LqFTBlSlIESA61Rds@SCg7am$
zzzII->T`f?WB3pg-s#rwb5OtBxAyMN80_Y|nEAtR{*#~jz4P9=^WXIHYq#g~iOAR^
z^##B5_WSP5+-o-kxT3FhfS<;tj?9tU2&R7Vn>=2|T(i|@ba^yie#@h^=XkI$5aZN8I`;>3xhKaDbwDTo`9u#taA1787a9YZ=GnDA@Y%YKxpptR
zmkWO18PL%hs$BVIw=vfi-^uY?3}bHR^maWC#n%3)d*o2eI6N4TnQ}PR9zUkFGWBa3
zXYIF!maTV=EQ`mQuAlSI&X8L%;9cEs1=d_1+%?=UvyZD~_A_%W}xyEWrzyGO(!Cb?vHPL_-{VkOIe`RSOeSj^Rjj=91(XOA5VmenVD9J+SzP4%m*
zRW)*V=ApXAxbWS6_g`~%Jagv7IIVB_#>;-5H~qbD4Er*s7EcCZu;2LTp1sP;eecJ$;MH(KHtDEbpD82nBL~x%4`i*F#m>H%r@oB(dp^v?zOK!Kv9X)YcU1iH
zxtlLz{QOdH&4)T$H*R^H+FDlk>ZtY4zH@et^D(#Oto1(4HNV*(>-$Xl>(re%M;_GK
zoImSwLD!Uvo*#TNuRq$Ha?gIp>QCQ&#eQdipV4<5bdT8M<;wo<{ggL(sITI)N9ybJ
zT+nB4-E#oL_ZmJn
zf_D^`&XZMK?!5os^EYS@Mt)x)S2qNBale-u6*qLBsp0N5`qZV|s=?`AFo!=r(_!D(
z2RQG0knznx<0F5kdYlPrjqh}|?vCWXepxFQTR~&39^)Wx_W31_+XDXC2XrmFzcq6j
zy*RC2@t1?~JZ6JFvGsm4_Zl7hgX*{}_b|s*b!=u{vv!W3>Dpy>tvyXq+W*S$;J+f*
z_WhmcvH#)pI13mnp
z3qQ|Z=&GMb7k0@wpK)pppY@%4`gqd!8AM+Wd@gj)mNT~N*d1%-&;R>QY?T}5erqx3
zxlkX!W{`JQ(|gS@e|P3b9gkSZduJl+osllw{n_vA*!JB|b&dC)t+o56g{*g%j=g3v
z=Cf4CK0ITi{W}&ihX)IlVFW%_*OHPhWM{wz_(+L0@fbWNhT=t-rMs
z^TQ)wnV(vW-ITFu-Tc5}?h%9h>oca_Zw|Ck|A%C5?El7Z?)bMjxF`O)U9C;d;I=zDVd_L6w<2Dkj`xpVAkr!#M#)c#-o
z#*RPs+w?rF-2Tk{r^tJgc%
zeK9;QF<7hB=G0&Q&}ZJ&de_RihpQG>XM$Xl*PLzc>5<2t$FAk;P5*T#?#9K}zmu`{
z`TC2$a-r{EJn6qU{l-fEqbKuES@iHl}hl
z?K=m__pGxA_33kMuEaa)t^ARUjGzpIp@VV=gj5nzF?}ma%>z4`h9@w?yLNHLcbwr++&IKZIkX@9
zZv~g-ULRLtn$2zFbV(oZ+KA5qKu{Fj}onqLlEo*Q&m(Ox0r=vZ6+*^A*5VP3E
z@%kZu9dFFeqA}*J^lu307{~Fb#`uPRxuQe7>-g4uj6O^`+Re9n>qB|_>+s|YNht4SH=Q5eYYslEQqaHj=&q*AyIX?f!^HQFV1h}B!
ztUDXo-Oh`iU1MBh&APu7wJPR)3xD{v*Yit`?u{Sn9QdJLT0?x2TRw@^*@_c2;N7Rs
zRqOcB98Yt{x62mt-T&-)mXqCB%=Ovc{l|W7uz7vJ?zDEy?X@O7Tc&=}e_%$xxansH
zH};#l>)9aw`Yf)FlNYJsFrAz8XN=eVT)dSL@2Yt|;J7l=dfCav&cAz!
zLv5Brd2an5U+CDskZEp4nfgj*Y6r)crfzor)`eX1>4Sr31uqO<9=s;drg_1^^u4-!
zjGnprzk;H)@=?xls^-cmnX>`@#yH7Lb4~|a-TU~S%Jhu2f2MP-f4a4~I2#w))?UvJ
zzSoDoXH1_hjaw{YVuQU=$LaK^oXy#)ztwp${_+9W)iIZkvBo31l9&EI0^E-=jlSNP
zxl;idkl#yDzx}%g&d7fM>Fj%G@VMY9!Lx%G1TP7`F!-wA>w<3%zAN~l;75Y3;D*3{
z(?(wC9_w=z@2$7;(Y5#U^$8kSSWovKb
zWa^_n+x+dbVwvBo^ekI57i;(Cl=E?X8ms!R{jpw`={O$wQAgL}tGV5cpRsl><@)Bp
zb+j?Z)vCH^e9QK!vum&Kj^)$2JJyzaXWPbP+#YTW%lr`6y?IZ%EKj);(P5uIB=G(H
zSduLN$ADjvNeUy(6z9jhC;7!4g2md~JOYqjf
z?<#-)!0#)6NN`*5q~PhnbAuNJuMM`Mn@@9R4<7dgcei&=!?-^
zUYzgRrO+{+5#_%z?B#rH?X2RYXV~cf^m$O*l|8f*>aMZMyL{FU{l2S>aqQKxOlUL1YBn3@&W$m^xh;ho2R
znw~2?^Ksi)UDa&glbWl!dA^pDRr4E5^fy+1X%`dg@vIy9x)iylv-xa%)4HtP-RhEW
z-PdF7j(e!{bMaTMc~J9wk)QI{GiKC3-5dJVwd}kYeO<+4_0*>+H~pUW@`bOhjnU`w
zHWzc_bFGbwiF=G^88@TMDqmXbm&K>i7j@8Dp=(tx#5}cUjP5aCqs*M&_#I_d`8~cL
zjD9bxon?7%4qe4auDO|;!^!knq#mZSV@>oNn2VY3jrqphp9CxTq
z`Eq-~@1F8~-c7+Hf)5U!82C=_qk`uLpBB6<_=4aof`1fzQ=pA}v)B9?$BEXlF}`u1
z%R3**kvSbqITP=}Kr1KX8vc(m>`(Qc%-CM_-Z0TSXIlGE
zJU;mFKx+-CX`czmwC2aTo^|%hC^N>bj>+}C_OeC4&xW3X&LVAY?I_FEeW9aq){nV3
z@iE3ZC$lPtVv|Gbe$8pBH>$@TtMegD(ocJkaW2YvGQJ
z-4xK({lq6Z^7BD>b#}fw(7Jw{V?*oQsQXf#H?7P1IA;qlV;plb^c)Gs=htp));W`W
zr@NaTob4ua;3E7}KYNJ@FQXsh{#xgmH`eoBo=Ki7rvfzvYSpKgeffXf91hg8xp7~x
zVPEt+QuE_JIhnqAaJTN-?(My-QP=j%y|p*x;l4b_9}|CZ`Q$+Bo>=!BKb$qV?O8w8
zioC2k$IEfg&$+cd$H&~#+3}lmedXxwhb;{r23L^N}|k^xf4S9y#gz_Qo(yU;Urj-gyS@{QN`TsmSxE_W3k^)*tu&
z@yyBFc)naVtfi;#FZ**pwJ&BeY|>ks;un`ZgQ#~UjSI^I|hW^8JUEQ
zAFQ{Q&H5nkBhO>q@M&7F^>LItzL3MuoV+}Z@{Nga9p{()T@g%U8uQ2ZDfi+NYyFr$
z$MCUi%~hG3`pge&=KPrco*nPHTS1>Smm_hpe>T9S
zx{w3>%XjOdXZZBH%8t9r)yVs@{Hxu$b?N{Q)#d6;8+CTf)%h~csoP`0m~ZvD5s>%X
zaIK%Ga&KPU&CR!ddJf=iPOkNf%jrBG)em2%^@H>2IY6%aT5Q#gvyRirZ_Qrtdu-m2
zE70dW7Tf<7JR$hV;NyZ%30@MsF3{wfJ^I#tcHl%jIMiAnYDe9S`55zHO`qHBvD>xQ
z^~_Q4`hB*rH@7$D?6)@OJ0teO;cGad}_+%C3fkIbT=R!5ruI
zK{=oLUOsT$bKSW?el9OQPaO;{3u?>S6T!ZqImLNxZR8%r;~ZjBj9qU`OmrG|Z@pTf
z*Z!+6<3I<0tHXVD&}ZF&pzG*{G2Z$-m8s4#uG3ko@ff6jbC{}(3xe>LfU
z>!klRlm7E3{l}!Q2KXYb?m_#<_!wIiCyg!1tf{!yS&u*T%KO{6Ee7sN)M4@}AZF
z@g7l5pSPH!zq-bI?}D{^%R<(BQpet7G3MVkI`+H&`$GF~NuS*#gUk<1WL`h%zjU$Y
zSk~ZMJajm(Yv*|jnZp^Y?zXNS@k&$x~*tv-&|uH~yWc)c~yo)hqseQU_-
zFO%KM+{ph&rT=+>T6kuZZ07p5fWFfKU0=U=S8D&&lXt1R7W2+(GU9#QA|Gn^A?Y6p
z>>>KZN>-iQV>s0Me6gpV6$kM5Fl43SpWoWZP2=YOv(pjxbA#u{kTv#}ef^x7xoNKG
z;(POgXMUG|_N@^^WgeFM6M-1Yt$B@odr6!6yi;>Kf7cctdjX!vyYd%L_Hcd20ei0e
z6NCHBKx-U-)BTn6k4(~d!7||Pje_86X*1nsQeQm}y`Ax{%S9SF9llXD-pMysPpD;7`vx~XAXXb8Q%zfg_+|7%*=g-XH
zfxSzkM`wa8+kXGSDR>Sa5AY~|8d+=1cg-g*
z`qMS^u~E4`=jD;kLf$q4`|%3`t$D%!XKat$GuFAD;XRM{a)wvdTJ^~G^HjgXRd|`efvf%<-TyJ(txeSu&buw0raR
zoA(auoY%Of&m4XBy1xAD8`tJ)%NRH}Jj?mL71-bQx?G$J)ETtK=>FmX=E@7dUm0i}
z>-AFA)JAlR?UNWutNvcud1tOE`R4y)0&VnL=I{$+O?4kVDC4acH8IxI!Sv}p5y&6C
za_ZUON@ve&^GAZ7=gxBatReH$5unfbO9FP>TX!ZP>$#zRdUd9$Bj3T0^Bho%?$wC8
zJ`&XLt8=e4e%D)q7e;`szUz8U;=;N8qRjPtslBmo@kH)ZBG>w^oOoK(8@Y$6PscK*
z@ul4H1$W{!Rt|H!{R}OKY>Um>WgJ>Ra)>LakM?W16UX14i31m!ob;Yew#&CV!1-N)
z{VmSZfid4N8)LI$2Ns`m*!Qe4zTrOK1>caX_{$v~Kz1|mPKqNjk7tuQ)#{roIM0p-
z*4!RU*RiEFH#p;umS4Mi{RXJ^3=dd2hOi<+B@M_hEM
zL)_G+n4o)4%X_zLZmh3wq4$3Ib)wt*VK?7!piS%ImW+LR>Oc(74Sctt
zzR8bgiP+Q=x#p;ODBtGCG4VH+@^O2{#Be64F7b=?7ZZyZjk_+ZA)L#ndO8$n&F!)^
z_CR^#%P$Y-2*2r~QzJ*uodFKy7S|d*a7*wR6W++dP3$*gn>kdyF+qHO2=0V=oNo$A>y6j21
z-W;HV4!M0<1m$uw(8k)N!`g#^wf{WOYQI;0tm5&$ar`0OmC%eglG+myJ;(BC)Cku3K_L=D!@azi1^|&{>6QF
zkN0Z>ae4-wUfk!`X`kE7y@m%dYWQb!yz=`M85DotN90=Ej|e_@GWYb1;RWaT9QTEO
zefX}459&nR>V%vtn>**+PA&eO^b30HCx1RU&^p%Z&iZ%X&OJUZ2I{6UiBGHkUfJn6
zXwSa0?R9%oPWYycelOeWo+s9*A?xKtec)RkFMU4XwK?hgyZklZ51!=P-tT_Q?fG~9
z%D>M<-aa;`-I6)F8-uGl{k%yn^0V)8ubj+{b;=iQtULN%l{I(gYVY*f=nU|g+WXM)
zU|)cfjQ~HRj-A@usol@dTv48^IL8{;u|scUy@+seG1zX`Sb@QME;zw+P=aaC8X
zUFWn~m7CU#s~YVU*ZOMsXduV(;yI>I&Y0(dT*-0k!Md^E`gl;rj|cVVk-1klVt7vA
ztW#s3ALHxRSj5kNwrK5$Q)}(qkbAZ0Y<_iw^x4uzzV1rDFxU0sezt+Mj`ez}>+yqk
z%*@*Pn^2E(FTZDk=0mNG_2=9g_q+4xL|~kpxvfB++-qZ==y%4tPUV`H)?#ygI5u2?8z(iC1j&u@0Ub>Ba;{=d%1{nA2?
z&hootq3y`g_}aqYTe=|3*$bDADM*Z8R5|Bln%QGOfAX>`CH!QsI9znHpUj*ZUU
znEO+~WebRdZ*-6$YtB9w`)vWPcJ}Gc&%4?8TY)`jud;c2@Tx!?_pf{B^J}7nKK`Qd4M~-;BMr9jz>Po>9Jrp
z->v7nt97pHBBCpOSL0LPcU#kV)#bYJwubGu#(P`t@2TB`+xMO?b10u1nb*3uobw4M
zr-He?;~lwnr_VHd46LhOevP_oA6IjB$jYa)!2YqX=H$u)`TA3vJAUo_Uivu>_*6eO
za<6sm=%i`_1{W32(>bn?@?o1FB$;$rs+{djfW
zj()ST?95xmO_rVay_}Jsa#mj1@c#GGT-O0E){(muGBI@l-ydQit-kl#82Gju@UWZA
zrJPqE_*WnDyFWM^ct7wwRiDmx^(5!^sI$;}iE~zM=v&(w8+CgA>t8;Zr)QLJ-}@d}
zcIRxgp2^ScAGPx0%-tQh;>r~sKHP8SzB2rH(E^oScI}#F^UKDg{(@S;b7Nuu34yr9
z?Cjzy4@Y)g}%+1GM@%&f#P$xFK+_7Hfab&)QSltIwAA-2OLJ-vLeG**qOv)sOgj
z-|_xP18I%5*PZj=J-6R)*%)#4q(9CryT_9_adLX4J3{l-XdH+|{G<$u=IG%gCT+Z*6+y8x$@1?-`(EI82@M12P^M0($;{&s1Whe
zmeHq7E#8ZE{vA=Q?A{f~DLq&?LcTMzmLFa3N~de})=#;+E&n|=oxUfchacBvjEuUpt~U7b
zyZKJ7-zkm0|7ga^)1e-|KYeS-xRwk0|G{ETeCGI9+n>6aYkZBj{_)}Fg^YF9Hy*nG
zWbwTnpUpV~s{5xFbLHXcVeab}bLE0=`}U@QF8B0U>;6Xom?0Z+AkIA)$aA#ax#>>m$MZdXn=9q6@@uiPH>yIt^t()VE
zerwDbN51)ZaPF-;xfr(>^yQD7b61~#`u3N;yq{g%tB2bc_v*wMNap6?w%~EWg8~gN
zV&88=S^2XDPh>X(4PUsK`l23|*&TJsOWfLS{O1Gz@gx@hpAN+L
zJBu@PSsdiW#K+N}bhn>X^k}0U9I-hUbNNxrV&>Dh_KNhM6}Yxu-1C|IvjhAb4Cq%E
z?%8`uaA$x!v5`9zXs-=Crz-!P+)v|qM#eCQJ9{6e8t(A0PE6MDTN~plCyk@Iq<1%-
z=*0gr|1ZxR&?SB`>o@0pUsL18w*s+@@#5vN0p6@@9?0R>K7-9bKIpwRSe6g5
z(>oWZ*zO4A>_|Y@Mxe=AeOD)HMs16aKKzQgak2xOf#x%V#&5iz4Ct9#dw0ewcWfau
zj&*IO&fDAJ@1Fl2-rVg$eQl1#EicZ2u|DdzxX8}UjW*;&6ZdFiZrxPpSnJ}iZTkIw
zF+BD;>A7(#cues4zUB)
zro0`er~9tw0shq~-?j0-AF;pWh_4R~=JJD!s{>rn$PL>-m%sWo&3R?UHR6%)aoy;bSj^!?8|UyoH%EqEeyFkT+Yepr+lOQf
zzjJF><(kfY!E|q4nX&riDo(X5PW#1tePwqmXwBvJe2%T*FTdE)rX23JZ@Na!O!cka
zQ*Zw_5ZQiW@VwyDf>#7z9Q?!Jjlp*YKOX#i@Vmhu1@Dq#xF$Frd|+@k_^9Bn;03{_
z1+NJHY49Dv_XYnl@ZVehdhol!9|jIOekmv@Ec5g$_Dn9JYEj2#NJa@>77%Ip?H?ci=BxM9NG
zy7uL~G1u2|ZSAPb`ZQOIW36<(+Ua^@mj|sU`pQG?mxooH@5Q$KP3?{xcVEcEZalQM
z%fZF0xg&P=Eo?2@XCrrW{*Sz^}RD`2zxtzdoz0OJ^cGZ{FCcm9x2*&y#_B
zyu4Rn&-b^sO7Hfb;st;e^d0~nZFoh*{t62=eAEoW)-~ut(w1-b7KzNYt6yP
z-A2Z7r?y7!)RI~m&pdT^a5475x$;--(Jzl0J=S#I{ucMCfPPR<4-bw6({qrXsr>C3
zV~79FwdS?{86Wr52c(~WzByOlkEJip?t632rS3WF$9HwIQyi9j3Y$T*Xo>s{7
zIKcnKKAShPw)NtkE`IPq3}ao7F{qjPiPP?%$K;-0j|@%+bbj`v*66kOHL=JAZgHnZ
zM(#RKrx@|p`s!Ts!e-Y_bIy0`ACMw@T&~vk>{64?5Ik%I`i}_Y;8_9xvTQpy*74<`
zf%#_#_Kdwi|ILBe*n3I927Tu1?@rzA{96d!pmm=92L)n15b&un)-O8QVw-Q;YlCUr
z)wyGHr`FXNAHm*pJr?j${^h~BCO&rLksW?$)yXHa?33j;pO)o_Ed9+hb+{CJ=i#BzJ^k-=vL
zUlV+P@Na_O56%Ve5rbDVnpS=IrC*&mx8!moFt!E{1h8mcAQtu!$$5`aYJ8qcz*0fhdfMk
zygy@F{ln3N0(zJEQXj~AR_w)x@yxp{YuUx&SUdF3n>pY3({~7a&KcmDHAQpXIJ`gjw>-M#Rcp>$Px&(n+n=F&
z?oa1iqt1oX+Zyh7zyFvucu)(jedpNCcmDF9Ur!948GL;3!ay5s(@ihVm-&VldvYrf
zL1RZlv
z7hgOp`Kd;=(O0p`MW3hiwr>q?wRP4s-f^Ay*l1n+#*(@azjf>7{GPuzdQ;XsI=D5^
z=KQ2v4xsV14vu7OJU8cjpXyX=U0C>&h+TpWcyw{L~iC
zw*vcjBhYRO_(jgT@;K##U-E>nZd^eFAM%r@PomR
z2EP#ePH^alC&Uk$cK__3RgFtfzD@_12QSEY
z`4W$N^X@kTZH_5jaQPFPkGHhjQf|ul3`8t}gMz4|AJ=CJ#NU#Z889*9QDt#`*MF!8X3s0Dsk&
zXTh;xD`1E1W$XGK$U3rp_mGcedY_Rw7TFXNj&EDsi=VIld#LMkZT!`hq4V!hKo_HC0{#cPs&3%HO}YOTJ2ADTGtvo
zntQtC$g_G*U(X3Xle;~zhF(7QZ1~A=Mz7Bw#{#}iZFTSWb3t`aeH6>|bAi0DaXMGI
z`ij#Zv;;Z9v^7cJl)*7@DqzX;$|zb=f$g4wtKNT#o65Y
zj+3uldZ)QOn=$^gzwCWKQ`_JBKOtA~kazZouixwQ)t;E@=QsKH3B2x3uznof{o=tqvrd-tTa^F5X`-5q|nw!y{GibC|
zUETxeXbsSPEYQSP9r*h0=x{ck4alDe_&l{=|LLlo(WlnSn8U_SZj6uJss8Z{l507-
zEs#6@@wqm}oQQKywmI?cI&w7SSKfe5wdcNe`7!R}t@PCo|21-OOYmiJ6o1bR`g2Lv
zJ|g(?$((bV4reNkwgP(D77Ks<9vJ>KX1}}A^Ivgt>gD5fwam$GWT;nlike+oQr=m(5lltu5e}y$6LV%1=^f{;%9SiPRyh4
z@^(7V{N0VQ@11Sz|L~%JQ)J7}yXEf%kNw9^`cF<@{Z_`hmt|~@tNPa1#LPEqzBsn^
z)pB*=;wz&om+icJhakTZJTdY(@A`)>)~n5q9bLquul+@ShL#O7Y|sx^=0p1HgUbDS
zUq;*9p8*u^L2wRd&xMzUba|k%zkQ&=H7R)W*nz$BjZ=*T6=$--*YgR+va`b
zkFG<3D;=)lbFB}a_4?NZ<@R9iUzeD3+2)pQzWm$RZXUW`jm+sa23IYvS1+#DF0Rgq
z+I2m;=$}|z#bf+bz%SqZuz4nb5B&1{gYvrt9~gXO@b`oJ=l5%VNbs`Y)xm!Z-XniU
z{sV&N1YZ~&%!ktF245F^OYq&nPX^cI_b5CgFLECjd`j@r;B~?2#QTN-hj>zBK8y3~
zn#C0#`VU)N@vpDOT_3x+K5lW{%+wMt$>SJ0-}R&1U75dof%;tEj8A=|SHmMtwA%t47;{c(
zY^p)>mj!16GU78PuQvzwh-bKFy?W3_o&2Ulo}3wUi4pkB){#Jd#7}4CN1NV3z9Iwi
z$F{~twa_}T4*25z#JxIUmwmpl&n_P?wob0jT6XCycWh|%+M{61b(#nH-xu)58E}0-
zkJh@eC-`qYj#{hM^qqqae96n9KwoU^j&&kuQ$6y(Oi!k^_0Toy*-D?SWt=2Sb
zxbj7A`9Ic}JhYy2d%ixzijV!lw9e-8{P4)JDHm+fizBwD`4!K)=YSaLz!MHe|IO9^
z1G(2{pKS9fA6oM%H~e(Ak>3c&H(v7V#EY}N#JlReQ-_VEoNZ=IV@GV-y@|nkd3Tm+
zI8__?>fV(BI6x*1dl`_xl2T=NPxrk2r{>;z
z{_Oa4-`KIspr%y0>0+5UF(}}()gwx?h5)2%zyiVjne^Lzp{w4`=zp#tIh6Va`NFExO;IW
zOP@LaT@U@o12L&f?M$Es_-%e2y>znW-#Vu{>yLS@d(U|&pPGB);_NwqZ@e7|_~R_0
z`(&U-=))8KtysAueBvWt>E|o|%GYk(
z?nSoT%H_xtF0KfAoyI+KtghvSzvR_r>tc>?{1(;AXRzK}ubp4U_g60A8>gd#IL?&HgRH>(e3Q?^225Xdt$Yz+U*O%+p2ot8?!xto+Mze>~uW
z+R@Ysc|PEeP4U&Px~J=FcCq`0#r&M_)$xyZ(eaNn&jpW<-cx5
zUj32R#J4WTUmsoNY>wk^$b32e#u>XK$8+^@I=+0vR^nqSiI&Ta3>B>)dZtyWF6nq^D$W@2)y`bk}{IYHL)ai)(tADKSAu5d9r#Ww0Znm*9$YHpgB-Tdr)^Q3kQ
zdg(k9j5R6OLC<6{YzErM0shMCKVA6p<`85p4s*NRs(XyH=asSAdc|;WP3_XN
zj$Fjf%Z>YA9Ipu2(Zoo<`o1+VUf;HI|AOFtzxGG_@6Lsv+IY{e(}8uro#&_eY5x}|
zeLrWV{>*FtdeZ;?^wpMJkWmM(o5_hZUpe&eNFT?ej;khX9+!VxtS|Q5
zO@SQXY$N|p*?zkBdusZ|J4S9RW9IH3c<1Je+Ip9TUSs0CHt0I@FV4C{xyn(;>HDdL
zK5O{nsSzPf;e(En?jUQWFPb{uC
zEUxlzUY_YV9%yp(=-^SoHzzSq%k?cu?2WmKUCuzRygNKS_~<~BH{(0csh!{PVJ|*1
zu%@_~XlNw%KKWv@MpYZ8~e?Xzpv9em>3F-pY9O@`ui4`JvDLv8J-Q
z-R5d8SDTq*yS$8i?v^V)&E@KegHAe{vr+e$EB58;nqZEv@`5k?y)w|msfp9Rx0bA0
zdSP%l;GekpT06%U_w`Hc(^}fd*fgKchB^PneD3C-v#dGhmsVcN3EQ6#c&3X@oOcDi
zpXR>nt#dx&am*<@@*JN
z|G2Jks7wAHSj>-H(xZm>%QpY$`IZnN5B0mBe{RXxw`OiSZV%OOGT$~M!xmqhry8D)
z2BR+ARL|%qo!`FjX*V5olK+l->BBTXBj333?ltmVzC26B&^(hFW5EN6pP%0udA#Gn
z_oV&aQw=*?=GI%=eL}}~MTa_`>X7qHZMV^X{^3z;UEh#<^`&);oz}X#_~%i^9-W(k
z_MDx|+ts6(wCds;Zd#8U+p{~|&^Ox0m$A`4aqmoO)!a@z`?k-@ed!l><-WSMhWp%J
z;Nvyvi%FaFk)3{Sy)*Z?)YLDYYGd4=&S{PRa!jx5sOPHmwZ<~eIiuv;n$5*MJGdIh
z^*hdf^VYp(j=cE3J7m%4oufZ@kE^Yq`;*btGqnk6yQhurNkjd
z@<69pMxV)!`^U3X-i-5!{?X?br2p94@7W`bfjmFiu?~NHh0Q=4{q!t;&{yC8eXMVe
z@6Ns2;paxcck^^ledZHc9I&O1#dcRvpSqr|n*w??fA4MVzjD&|IiB3@(Y76k6!q4|HT^I
zzAf`Os_x%NUtP)#-CFloZIXAcy~$+Scwd<#8NYHd_v3`p$n}1dV+Swf)tED#55`@M
z*C*G`_v&mhUR=AlR|Cd8vs~YQaXp-?&tyHT`C{H@vhPiB&WG2fFmBBCRKPdwRXdjp
z_B;;j`^$45iqAbPSG9-d%|KIkWVO2kpY4oUJGEn-nC-pG!^k6ZEyUdWyM2HN=?%1^Zn7qz1X$_`VR%3
z6Wc
zHorG>Ik_UxMvmOAO9Q@Dhqr`0?#K1rnUA^PpFFRUWos^L?UsPv=EB*r4%Keu#77QC
ztvNQwoIf`6@7aPMbyv=Dva`|y1;KjhiF
zMQ=G$4{wj$XnWTr!$!8w*=9$x&L_6WvVCiy(L*;>r@p!x6J3poE{zOXdfBD-F#);i
z+QwSzlo5$_V%^>PufP{oOjb1cZ`4X%{OkpM(>u2}V9&jgSNgoOeFw(R3VPT8GJL*0aF)Hzz~`HH
zPK|lHj|bWv0iVh0wVt~x;|rZrL(cITFV4EhR|WjW>Ay`(*2GgE&SVVY@jd5A`t^W+
z@_{3bK5y-)?*|^BK0f?l&bU+FxaY@Ndd)}P&c`ht=iEl+^6zF78$FF}&TqDsZ)$mJ
z?CkRc$GE;bC{O*2z?r&fZj6;Ceyrh2{jraK=k*sl7m;)FV&jXNah|^RKAY64b~vzi
zbs%4I1@c^or95W1tVO!#dem(7h(nFyg?{|)4Q>qn-IO;vR_Vcoc5i@7JZNtY=;a@7
z`L0IU={Um=I`_t`k#la89d%^u+_@blY3{-KY|-_+;0=MeekgG*(!V#r|ItAE^?WxO
z=RY}{fB!VUCbIn0Zp)w1>*=uet+O-!nF%%F9?2_?$gTyyn%`-#H|l$C^tm(dh>v{z
z;i>~JaP0U@h
z4(f2M1+}hq{e>AH4y?DvjIR!k1o+VKO5gZ%3LpA5cHJ7^#4_f8y%Nb~D
z)|y!Hq`fJ?Gk@s%u|b#le;DSE&)m7Af%YF}b@%Pl+@4r)b=)LP3~b~3KSn1XewpDk
zJl(z=o&9{x_A&;ag6`WV1wIehHC{}8x^v%GPiE}gy#akVV$Ztqi2%3P2hHCiV-0s|
zn2%iI+qHqbIPctr&X@c8!3UhuNe`WV??FEq{9H(<^AFUA%Hu+;2Lirr2I91@u}#Jr
zpXRmbvyFXzc8rHYja?FkFHc{TgYMzIuty(V#_ngwes|IwWO(i#u;sJiV8GY8k9;Fj
zd-R&CmB$3yy@6ajCAceKha4Wt|9F1qv`=Qto!TGIurvBS?v48Bsm@WKn8q^~qwmU`
zDH_ActhJWhH*>m-y;*+8sqGE$;GBGq_V`!dS|{YL2=K+vn}X}s&i*qu)$_uvscZV2
zW9n!?K7Xys@-v7JhWrgzMvH|9U(Ab-fte@8XS(ydju+7SDbET;ARD>D}Fjlnyk
zyIfTF{;cz3M=vmCa@A8iV;rNM`fOiwzibFc@Y;I=6D+C
zzUz$h_1Sze%riXq*-@Y9Hy(W$?}9V<_UHV3-Ux0FB+2k!lNh7C31yM_!R?Kd|1
zJb|Bs&2w6oH6*U(C?o5JyWk%t&e|>j$7w7+~Q#L>q{rU8q4cv^Us~l
zUpSjTJ9B=PnSbT6OYasK5&eC{p*951pF2EMqpk3tX&pZbIzPjbDv4T=4j(V
zu`$-%@8)+F-B)+-&Rp#E^9QHjab)RFB_HyjE;V^D9`o?^lRx~^z9jQ8o>yg#lls3o
zlfQW;zjwC({^@r%bmOx8;a2@O59OM_a;5Rt*t_|2aZ3O5Q~wK7|6kIN@%-iKcS7~|
z_R0P=IV&I9Z|C31XuMC^!aw=<7WnKHzq{_v9t`+J7oXYIlhJz@^nGV~_q_wwfgW#!
zFUyIxvDO5y}$IC*C#s7J4zFx%J)5JZW0meB?AQZ+`B!zatP2U$w3HKa{=le=#!RY+UuJaj|J%
zTzn`GVlyuf;xjJ~Vk{5hD-U8T58{#|`qu;JTN4}8ym{I?&6}rv)4X}wKh0ZX2c|hr
zan}3YSn9((NBlV+XyZA2vh}#&T~Yds^uIGHy*J}$27SxvV7L8k8Se*qih39GvBS+w%9M&Zu4MbcsU@-V$qX3^cKrdn4`hbt8CEptWan
z^aF?dt6%2V2DL}8yy56%fbY={>sr^$<&7W5g8hN~vvDwxUv)^Q8a@?}r<<+fp&5&H
zuE#nZ?u!`tDJE+j%iYz1nzjZwkuT%g;-CYJ_t{7jH^>z(jrqR_wEFEG5bt=7|E&RI9D57tVZ*rkns+(!Hl7URsyX1B
z`@1)gkC7)jG`#Owjy|}4=o{>wX>lM`Dx{7A=jzR!!e
zaV{QXzTmboxHIy!J2(`GWq$X1X3S0BIG@*R0iLyTOXtqz$_LimUv_bAZ_EwOwAxay
zWas`l*E_I10rPI`}IptSNFxK-5ZF*S*^8$
z%U{}p%lb;cHrgmJ>}%a)_dvj|^ZiV1FZQ)S>zUR9z6(5bte1cM8n-vrsz*%c^JlyZ
zTgk}Ey1@3-x0hcpo4E>(AYIz3%V}0UrubD+f#Sy;#Aql)nH`ihPc;GBO?xV5u^w7t?
zxgIy(Rjq4eypiU5v5IYO%ibc;>Q{TdImZUh76Cr^WKEo7Jhihk>vMT)Yr%!`|Uzq-X9-^sJJDz9Q!Z|?Td
z05|?#lR4jX$Zz9ZWL&-OF*|Cvd8Sh==c|?03m^E`_kb_B#G5@e@w!00;83&XPP{xI
z^OQitS-C>IPisp|IKiRV_Xhkj*KjH?
z^FL>I&n^jC|7=*3?^^;K$d!8mtt)Hw!`W_nau|DGsuZ4X!-90)r`n@X}Kl#R2V{y}Aers@3
za4Zm)`&KT@L5{AO#{6NoT$)!ezm5AI+?nz76Rh(-i`IhjVvQ_6tepv79W*Af;7S|w
z?het@Tsyl6wB{2Rn*k2UHXgjgy+P~F+!(*!nP1D{8`IOV2sE5%^x?x9apUwv(D?7p
znEyD{MxnrQ2m(i;dK#cqrc{(
zkI&5fn8mcNkAAUpKA-H3-%r#`eZi;t?|s4{8)FT>Dsy?G$2n*4z7~+hi#h)A&6c~d
z88nX>p7Y%qy6z3=#eZejGG^mU(07aMuHa~(`TMr|nId-lUTPyvt+Ym*o7>{6HrC;<
zN02@ovwa}ozxwO@-}vgQ&x?&f<10C5_6F?wY#4pCE=K&8yHPh=y?c$_`6Jn|cPQ8y
zTp5T7H+pvHqnl4Xvz9TNd=V@DG-sOIg@v@kLF1|q&UMV6Q8$0~1$taB0UB1@G`Bk$8G~cUyn4i0HZV^!DvFz8E-9j(>W0)|g*%c_7e?
z^i0jjXI|8jWSsQ$4>}yMj4_)RdInTfI>3Ql!
z$oxt9^M99~s}tjqK%V+}a3*8*=QHm?fp+$uZCmo?e)}Bv9r8C)JY$~aNdu#rRtntNs5orA44`0ZOsq)Q9
z&+W?I(Ll?8vhaT2-^AwZs1HZ=)mR(fw!ZPt%=#Fs@m&G?jgelsCE%Yrz{#kejZ=X<
zl06Xgytu7x1lq~KTs+SC@0ZBKyK
zcZN$@^5nWckH@|^R>jJmc*x*HOs@<0X0CZ78#C^GK8a1w=7Rz})2}s#`eUs+R@rF|
z*>?8j0ozXr=-n1<24^N5Pp`=lfA~h8?)q7OoU?apVC|AXW6S!9sUKw;NB1hbE3!ue
zt+}4(aFp@S7|L5^%GEqS>@>g5i@}-g!DiskI(G)%o&TPoZ%i-tMWEerwmbLpTWzW#
zxILf`x0-nHwg@z_X5`bD5Q^VH?&19FvD3%3S7Q*n&zZ9!u-*2GE{7J;@{
z{_p+sv^K3Zr}s_sa?)JhmG%12zI%>{RSfLvs}FyDo5jxF{P)JqTeg>z~x%N
zzt&1QR5KUDA-~w8QxiX~Yj?~IzW8gc>&*ooab-^5D*LCh-h7Yex007j5sDGNYL|U_
z=I;c(Y`2c;t2LaAbu;>^e&lSF6F;AJ1niXyJ-g-F8Rs>;*=tVUzQuQ-%AcOef75XP
z=`APoc$;f7jfqZj{OWpRxHN0?IylSg_T@V-@BH@WkFhpRF^|49&T=x^+!fhXzVMk2
zzKk{+OLKN0`>X1vchFh(ovVM&R==~GfqStnn8(d$yf|C#HZq>qL+y;R#*Iz=nU8+2
zW&V+}cY3n7%J04zAFgjWEEm-&XX@iZah3n`$(AcNR`IKDYrpTvJf?a4-jK>%3`Z9m
z&-r{2hd9UD80E`d{c5e$cl`tLV=LLSclhkTSMPnhGFT7f%J-}%1m$_WFZ`j?U0Jn%
z`U3lnf7C(eXoC#>qs*#%d+9~U?6?S-erB?%$qjq+dODD`ZGmRL-@)Wc6NfeLLGvgE
zcU!Zs=Bj6YFXUuf{!e}I8z;Mi@l6`X_&+hpsf(k5wO>BZXTd1X7iYxujxEk)Yw1UG
zf*WH#vUxgCzl{xN=J-)p?9IQ+v9~Jrv(cYDKaZ_%>_c)E-~Ari?=W-ua^df+TXmLv
z&t`be|MTUh{^4M5uQtR!*6ql5eR}uc(bsOH77GtjE@LUQztK2*P$E~hB1Yjo1*XAXAS^Op{=#@D%DxD&rP{rm#r
zGS}P*=iP}9l?(cI1X_J={O8;A{_G3bR}UN0ST39s>pXY3AYVIMAYTF$g?_q2E+N_U|uW`O=9FcSJ)6<_D)D2%X{LrPITEk-P-}R2`#&v1N>AWUj3w|*C>D`O^k>R;GabsOh>R~=Vr~AevSPv4x;8s@-aW(b1%={SP#yP^YP8u$R1s1bGmI=C%9h=`0AYTUBfuT
zCHFn6-nA;9#KEMxR<|XR?kjd(LXN1myWihjIPEWBoMN
z`c9Ewb(T!yV&h~``_AzH1Drf~`R|+U&zf9=+;%+nV(a{|8UK$cxiLLmi$HTmZOL(ep1|SGK;OILo!~zn`P@3S{)RwP
z$IjFTW3Bd#ABepjk>}&w-e*ng^zNR<)q8K|*4n^T}eZKiVXgt?H_Zb(fe3oOax{NPI*DC+STEFJpTgRR6TiCooZ?6>Hv_i4fBsoR`t}BVl27^2=%uT7-9G(`Kx6OL
z<>&)4>lz<8x+|!S+QX?P9x-fXZz~(4A0Mv0
zQP)=X#`TM}=RO_@8f$YV7YBm1Kr>fUt?}`kyx$YhVT>>Gt*e_e#<5n8eWtu8q~4ew
zw~IjYnQ~L$pO4UV^wqD%r3T*?Xyds18`Jv5==s5=ma}>~KA)abk#~nq28%$eJYP0a
zynE7*jzee``o`&YgIogFUa{k+w)##d$!2QLnMPkVikBP;)#z4A}5yYn@Xan8@X
zUHj|Pnz>xPA@k9f=g;QHXY-BB<0-eby!(dX~-Gr}duwlAOh#dp64bROGxt
zT@%YMWz9M5o%#D?ob&sX#!vs3&;DMSdo#Z*>$Ud>lWu(JTZ?4OE9d<&zhdgug}J{QK<{nW``+)p#+T;YT$i_99DMz2@ok=4_hV=F
z=xV&XSID)V#Krdhp!KG{uN`XSz4-?L$DDrmZ2t9`k2Uv2(|**PuT8gCl2e6&-%E=&;8Sy8ZSo=nbzEauKi*D(8^hNq-*b<*4&}4{n)hTo^|bCPHUHC
zjgF^G{nIBIZ_SrPW}cUSG;!!m!-eN
z<@2UFf9%)qa;<)?*B4{B&}UI&=y~5qoZC0`eM=8d^CMHQuE;%V>g(qX)7a4ma((CI$o!R4|LUoK>ePSg)PMTaR&PSUoh)Gf0}>c)W2rxzi8^;F!lFL{hOx#OQ-%zrvA&O{>!KSE2jRd
zrv9s^{%fZG>!$v1PyOGS`oBB%e?PtZi$Bfh@}0rsg5S+W_OtnKW%26ta_j!VvjU&E
zYx!R_A^+ChzXu2MrUtK{=6XN3{9bgbC3zqJp7cvI&(;U&u%?Ec-y6uowSl$jVBa45
z*4;C8NvAcw(4*&D_uaq7B@VbPpwCz=>fbp%Yy{fJ2IjSEUhs8)usvXRGr*7eDtlLD
zoxR#&*Ezn(hZx*j>o~=qIoo11u3z?w(GPLcQ@`=!Jz3=&Ign%jtx(?&fZmQTrr$Tn
z)5rg@HXfPzmD5`5<9{Y_cADGQX1qTTCr(!Bah6{C_5|we_b);ZE*}%%Vtdfs%;SGr
z_6ojr{6Km-y@{;XUKViC7IT$0T(r`s~eacfJQYgv0}dOVN$!mqlblkJn!7-#OjdZ>Jc%X>x6
zdiASa&6+n(Zw+VTdECjD8k*ZmDJ^}V6Zabdzqe1Z)Q2%Y>YE8n(^B(dzclcE
z*_T86Yr(PXo71PKPd;(LUwVz@_r5@DeOwy<`OBVq*)h%O+Um^CNrr7_c4aO;wyO8f
z&15di9A6Jk&o@4n^X82`eux<_e83A?yzt-m4Rf|zPxOBDq<3D!>)G2L+!gd^Kj(pd
ze&aU30$lz+k=}on-{ta6JbQwDfjB=VHt;+8EvNkEGhgZCYediW)z8n5&4w699s4uK
z8{hfqZ1*!<)|Bs#hl6qN@@bE4>$Rf>$zMIKS6AgXXY0Lt+p}(u9cyBKNEDAY%CF6qzt`o{LnE|RU3vrQn}{Y*coG7&s?6x
z$zO5c`0~ilYXVo#2-w`5KnBEdC~#h*OK!FDW36}bis+|{uk7v4oS#>w7sKcyz2aq4
z9XNAEK%cms-;;Cs|NEV5P3+G48w0KK4?B-MeSh&h`>lo6*s6B{&u}!r*E^F}^(DrS
zi*EVJuXf(={l_a=aoc}*_T`o}jtuy(s_wZn>!ms#I&zjR?-D=cVP`-WAIa4Ja>&O;V16>F-^Vh(E1EZLZzAf|eGOpuAoa~X2
z1NP-yuHEaN8{e6plh^X&{G6YyYK-px9^HJwH6Hn(h98-DpOJoTnqQSU9@f*VFF7fv
zeed{@?dAE642(w^G152pk6k>=Ut{;3)tJq_QN+Jd*Z$1$Ki=(CvD2-_=%#C5bopLG
zHye1hzCY_Dw~dL73-LSt{>5FPyS0d0bDtS})zf!0;O~!z|CnChF){LiKL@gSA)eXT
zD!1NLy4aIbIuAxCp6?7^oWr-JS7-8lXxhW^v0(h}w>HTfjto6lPrmKSc%Bn6ig~N}
zk4}5{Om#-sMIN<>bg@_k6WCudOjRd!p-jF!wEL&+#Nz{4a0jVm=xn
zbu^DxE^$cb>A+bz;q%ErPU$cob&`_{Iq03cCN{=9cP#U{%(XL_M`g~x>(Z+izRZ1;
z6ZZcke0=oG{`Hy9eSFMJ=7!Aq_}KIp@^PNO969grh4AOkY{iCW@#Eb&bA5mQy)hF!
z;ODx){puC(A0HX|Mt%=wu2$!MtGi3Gb8C7!^u_2a|J8+7|J&Ph*3ad9
zRU5|aiBSzTR`=c9`-AJp#nG*}RdoHzIXXu#KRp6)6e&Xq&IGv1SVe-0@x
zugqF`ef&lE!3O*FAE)Bpic>c2>x)Na>~k5Hj|i>_=v@oGHvWrM?r`&j49@p?GWz2^
zx{yD7@g`j!i2Dh_X5jk;yY$@<Eirp9N2fj9iQ|sC$l6-adxNLAyySw7TLK*5>~zp~`*_CMV)?&ke^$W-U)Z4o
zPvWt*5iA1ja3KGyVt+-}o#zMp^`D+k4eWg=d^~wNJL;Qr;l7HMjClF5E4U_LSNp2z
z&Ya1ZO!>hJe$r`~HG5WMG^Kw<6
z-Zk^7yp6HWZI5*-ug8PW3BD@$uHb(Kdt%7jayowG|L^Aq8@S<1>x}=W1G!Qsd>2>i
zuKD#Ah|}DjJhnb=%UHd!drORZFV?2{lQSoWpZfy5SN7JK>{Bww;ZvtGY>hnb&)oeH
z`$sZ{Pn!Alw8@`UF?{k&_ERz!!>3MXE))Y!cXX>5ojD$8KJT^%Y<^m7
zuDY-G-7osskYnfEFEz0vus8SR-mJ;3Gxpi|^w^l!w>wuItsiI9$mIdOcyRvd6ECao
zySm8sN?*>_{`O_Ee|`R)!p
zGlOTOXV?6;Y2Lbj)-*4tw`cB-ke}DP9H|eoYGizGa0*-b@$8u&&zbpg$KZ$WEn^IzM7ijhWxzjnZi|=`v^ZjU``8{~wm2v&+vW_=8`7KvsQYU?H@Srx>w~qUABY$_s
zmbvqDuCle%$*0fA#C()d>wLaCI1=C#8XsSs{md=SZlC1GnEbsEzQd2d<9L3~ukz1%
z`JCIAKY!Ne^ZY=dK374GtmALhzBTdmcO&?dv(tew+c&Vqw%*N%
zFYkr;UY5zK8g-W4`ZCsxv3kUT#z#8&tS^7$I%ezT*>oT0T=u^0&Yt^VUOh)MR=dBl
z;yWu&TN7kJU3vd{?!V@oxplRrFQ3kTUG~Q_xO!36#Noxdaf46?-l%1YixGCF=XkZJ}y4>vx}c%_=9}j^|PyM@18yztzQ;+(;K_q
z+Q^SQe16VY$Dwm#7Lz;Cx!nGx2$`>{B{k^#OLN6P5D$*k5B=(gu2)1Cn|B6&hyBd-
z>e2i3Ioa_2#$4l1IicgW;7EWo`nsl$HSzIBEwJ^u(bqLSeS3rMe_r;>*T-jl{C$d?
z;6bYn_UQfm>6|>x&+%Q{>XpB^F?Q|?w(y6%{V$yKieZ)BY%kmRjymhUI)lSkMu^;a
z-agLoBrka2o1AHK)V01**1Rd?$9i1#M!hNqFZPY1mw(<0F~2&KRdt0&cKPfK+1Er?
z4#wCHWlmNsYNPeneCzEW4RG+b+$WrQi?#>!oetz$O&t%kM+er(Ie%ZE8RPl2@kOoD
zY5ql%Z~S~+#;f>n=fp(*^^wW{-!GQt$^Jd(*)J!}nbzpoOwb}e&j%``e!ZIFYb4u-U&V(4z%X;jTzG|58gu@
zkW<^vRE{5&*`6^ObzqGQ&iR$_mbto^d$5SCc732e#l#mn+(S0yXCqhy8vpsVil=YQ
z`uTX;%zi;{$L+JUGG02x`}ANdPOOu8N-*a{9bFU9qkVB|i2RuVZ+$OXPu}1Y!SO&_
zEdTfH+rKwsJmDNq@3HKz1!|cNwfW{8UiDeLo;~O5^Q$wK
z8#=7XpYvZlo#)T^j_%LgdH%>>ZJ*3oo#@3xr|*3lpX#e~eC>BaKFXi>p}v2~WSj2M
z_Il>t#(vhz5q`^oT#b6Zbkf70xgIgdp}ds?{#z>tejB^D>`)+YjaTe91*e0f0WMz^@Ja4{R{ixTpkvI%!OZ2&*<%5ntImGeMVw`4)!Dys
zp0ncR&+la5{6>IRe$%CuUtE59bj`Ue7x-%)$-ZTU?Eb9F%g7xc;Ou9>_GQiCMC}#!
z<%3WBiR$IuGhYOny2Yp3AWvoyXliv{pVr06C#`W>^JlAC*V^0Tn>$FKJLnFt1@%ww
z-D3Ytun4p#o$b!e`CgxK-+R54@7F}ep7u}k?v8VR*C~J4bBFc@^2ir{@LvyV_vzPz>pu2e)I9~#YcXt;ol0}74v>p%8fbMzn=lQ+XDTI1ADj?&qhG*
zA7oK3t=pFqaqS3doBWyJivlvv{lkkmNA6o9=L{cyBk1{Wy~y+b#}?=R(M6vB$6K8L
zwhNp;6<@`TzsrLc1>QaN(mJ%R-qo&k^<+*~Jm=-?BB
zPY#|P+!ee$cy;jCg0BevZt%WfdlGqN&_6r5BWq)B<>{Y<4>j#);MTTS?0x&hRpWkb
z*0!n>^8YmQ?(`^sDDz7Lc25T7cI4w3S$|J}Pc=`59<`|+#a$iUx98p22u8k*$u?|cBV|7T>k%FTCW&;1>_UX`1OE$`le^xK1xle;rlyEw!r
zj*Z3t-4~(%ROIk2ukwYzU4goMLcpGP&fjy~?}6Tu+X6Xe&->E%_hlKc1^WUup&sP1
zpZU(Qr}6Qh$47f&9C_$@wWIYjNQ~^NZ+mo&{@{k*e{mkY?jgUP6L=T+N2l2Na4fLK
zr}@u4|1yhs7=2Z%IAi-QQ%@J2{Hv_-R(1V7(YsZh{HyF;s7~aMJ^b=rjQo)UcE@{(
zpSP{h>7L`%x%x7%sqf9X`TMXx^6Eq_^!;NG_;c+v=3{G&ujWy=uNv`uFDeX}%HonZO(mVtsq`sGqst>sjOTTELDvzCOSM|26~lVSiOz
zzJH5xj0@L|Lrv@s`0%ge1HW1e-r;?LCU)OZ#fE$H(HDHI@`YdIad^!%=Fd-r4_wf5
zcOY)O@Kq|IQoh-Ywq)<>-eonCGEN;kZ_Q~_HHNiHW{HQKI#MB4X$1i5R
z^?`@44Ah4_?F;yzy)hv7c_wM)>a#Lt`*jx6oLdiYr^(mepmNW#m}Xr){w0$%KNp$5
z^a3DrRdC%PcRXYH;GY<9qJMgTvwH%(k$FKdm*M}HPx}|60|%>g-17i*sFPJXUj6`d
ze9jg+?##L-kKRmt=<(5d6*F86ZxLJR>q#4F?8qDLd{<*n&)%iMJwf@uD`PeFioh9p
z#D#nNgh1N}E~KY6^$!l{!^elKlWz}H4^G|3a=VuCJ%O0vLT|wO>$U}qqQ-UPnm(LZ-^d3yJbU-*IUy*A^0L3Qwt4*KUh4rWab>F0yyO?g^?
z`!@#kd_thTIUvVxpUFQEh0gK=7e3>DFl&7IhAcSCPrB&+!oa(whF=_rv3Aw#!vnhL
z`F9u41k$?>Fc_Y9L9oBIE?{jEglZUd7KQeT-UdiEs
z-+215Y<8bs`qj`g1Lw8cy**=b(plg5Zm!N=6VTzlSf{rfSBHI^+AmLh0(|k?9oY=n
z!rfiN7}wVXY{D;uH+{K1lQFyM6{;`8WsW~Hz0W-D&B0Fw9_YEvxlQqHRSwOd$l3g&kp!^
zY2fn{@ba91e`|pnp{w7~YX3iFQGM0EH}_ybm-d!GoNC|=fjjZeoLQuQZ{V&R4fy)A
zsTX?9wYOz%f2^sG`pvU{AMBHs5@&g+{L3c!>U-{Nesnf}NamxxKhDo$qd%|DeB8fd
zHvftIvT&6D>S>M-b@9-^SdUXZ@DD$)nB>P;8f&&c>V5eKHOKj1NbHUEt+T&t`kOOX
zBl0E}&q=}ZZS?;wk-02uYLuLPXUyxLI^g5(fNe5-{kYh^BY11@#Q*mG_rEfKc=p$W
zKcByQ{rcbq!M6kvJ@>O4JmLCFFt^emO)_-)1_3zta{cEybe$|5agr9uSH=fo>_k9lA
z-!t{T2be!{>fJ5#>!#j)5;whcy*x3$C)l08xaXUL+w=FfZp+`@``N)q=P%TFeSo9J
zPFH<${?$Ems6F_#m5HILt$zvH|6`o?&5#(Z_&oALwkCEZdFxrYUM
zdcYg`is|n>ufMyp#@_Y8WdZp)cddylr~T@!{KmAtZ|ZND`bGMi1953`;j`dz!H?&#
zcl~YI6vvT39M2B$#MhI7d*uFoXOfSvTLRy2+_%1`_$PBL@VUaTR|P(QeOB0iR)8fu
z$p>Go9}cV;v&Z&{fDXVlZuSO?fRE0|;i@xyto*9;&h&hS%lEwT+XJ!qds>~xt-9xv
zUL5{goKH-@5y$l-_-{_fTqaBR`~9ZaP6s~!)`Ob@cG+Ru=i~DeFdp{=Vy|y<%C|R8
z>+;m|ach~Y$~F%C_Is23lEa0ZH6Ln1ezX$-U&vTvziZ;;e{IOKy?w#Rp<3l9`O2z!
zYqtktV_!QHRK`28HxL(&$n6Y#NBD^ZJ$$BPGZ=O7nGSxQ3h?mMKy&|`q5sxE
zY;1g5!2ibCd@r&#LOkPq)i@&e)6@EAcP+pENk@b3&h{I#a*C7zX<5}zKFSZ_;|+k1)qE&H~LoIe=?5Tm_0SI2sGa%N7>u9
zoz+*~{7gH7&o2-DSosF&WoSlji2A_w(lKRFY+d)y@A^DhB?dc>ab6Ct9MM?
zI3aT^kR!bJ9iwM6D7WR6KlbK)(uY^=Ey2jq!OX>iBh{9Wmo@r8^|P(DW^jdHzJWX9
z4p`q8@ZFp*Y|e9SeQjEQcZ$Gx%)`h(+ve8?bhCFNuqGegRIO{HkJaN|_MSVlJ=hHR
z9eLbJPapL53#&Rwu=lJ5?
zc5WlMFW|d*V`$9!a@Ks%?emPS=H-<+IL`0Md@cLsvo`s$5zxz@uH&QYJ<~hsEjb_5
z(0o5j=WNgQkuQ9A>G*v87~A70Ppe+F;62pJu{C#08`sL49*^!;s5++$$L?}#!&|SF
zdw!5_Kjvb4*3HGVYJY9o_vVcI)z@6UJNw=uIZ-=4@5Oghpl;|IFU2;-M;sR%&~wBA4i$;b!gh#mmc^0!@W9^ho1FDsvX?Uzf*_@
z&(7e^nd(g#@W@)fuC8{?Ub)zl);__HubQWc%j$3c>6Tx
z%iYtM|77&I+Z$BxfsEG!e#*-&!&pq@wG%<#7Ji!Z!MM7&dc(F9fc53!oRDbVD&GJKUs
z?R+)QA5APLgZhCl@$iHHa?!o_0X5reO4Qg&16ugbxg
zQ+&|JXZ~Ip*f&;NcyMoV)H{lggMo8b2S)<-053oXIp_GvU$LH;dSmsh7LEq&_3y#*
zJ?l{Brvh~(=GtKs&fc9J%RS$*9v$2oyfFB};L8GXbl``5_SmnFcpqzg-?Vo;y@r$W
ztrqE_j~@D*r4L7inB`u-GZ<@(%*}yV-6Q(R@bkmb&mX>z`kVjiza{(Zih(U>#3BZ<
z;6g0+3o*!D`x`Q*gRRPl=RtuO#3Od&3-Qh#eU}FG$qC-+r{_kZS
zo!+^A@l^kwjC}@;_h^6SV&q3_dVY7*a_>a`C}H{c)y?k&9rN>I;S=ulYLDFBK)y~+
zy><4j_fF_RPV&bG?-y5VHN$00Yw0g!v!6$!y?*ChWh=jiU;aJY-j?eE{PF92w%r{~
zyne>wmo;-a7k_(xoC)ezzZ2jGAMN?(o!bb?8xEX5G4y>e@Hdy8`z){CQ?~ij?>~J<
z=@M)0jdjAdyXV{@5TCjdYja=?&c20be>X+m8lQW+oU40&%dh?y^~!GFI+
z4dS4_h!q;=#xxdde~%|WhXOfXb#=$ogBr!By!3OW_to0*KwB*T_X9H5
zXO1s?jP}NR()w?mtC`j#o9wW;D^Rb6_11gBzn^Wg^tRr5w{TIP?0+PEl8;58)&H$*
z%klOAPq^WmoZv)G_}`q2+~9(4ocTN(VGlp89U$kc=qb79|^Vv+P#4{iXP2aY&Qk{Imz!shgbd%YuI*I3-f^zEI-r_+y|oKcKv;^z-IYgr7&*4%Gr`yTc?j+|T<
zu*HTq!QJiK(EGYCYrTgjhjG_Nef(pGzSg3gbnNZ0=e@zL*1G%C;u$Bn#fiQ?sVnj8
z%R3&$EGBV`9O9+#W`-ZpIR3P_Q46g>bu{OvH8tm`^@TqiwIGZ3cdV(_hk9sD
zwf5ACIvwi@=Q{%JPrG*5EkEUItRMV{Z_ZD7!ws&yQDVZ2h68JjzkPYYS3mdqp1Jqi
zg3X|7^vQv~IjF8xcbEP#AKuaC!`NAU{n#oW^ShiQOFz7c?E0LcSI;k;xntt82FC+U
zPPZ>dXV22%tiFC!$0~nDx!&VN&T6ff`THv;^`pKW%^E*`etO5p8dL*#mS^$l!CB|l
zg11fQ-j&3ftAUMx&)yX=>A|^u!OcNqudjbvcVA4cZCr?l&-mn{u^O$v;!w}l)rfKV
zc4z$_Kn!Ps))86v#+)v5^=HnGx%lms?+lk*StG~C_UZs{7jrk95tm%|yd2W|tiVsD
zZ10%XUO_dKm3r
zm$`azR(;`I59M}W#yA&?`$Jya%160Ao9(mba9_Up3iWNyLF=8qfe`j7iH|cTDo;uZ{FGI
zpPM<$h8XDX@1fkM*3)w`cBk1Rb1d*yd3VM?H`~md4}8LhxbwYli;UUi3m@f?-RiNXZKbDN
zEh01O8DsiTI6oA9TXF6k;^*0STZtw;BAbB?NfnuI(G#)Z?nP^Ns~oY1zH*V_k~?}%2K-`2J;M0;w8)%X&+_@_XFlVC{*lK_m!Eas9{k)C
zJT#8HAw65q3~)&|uJ}&Yec2n}Kwa7A)9JvzdsSU;%(%LmceMoKqDzjna%Aj`yy(@#
zFT?;FcLx1$Kkmy|tp8=j-ovK7cdghHt8>4&VvjHKCa%6^n;F-)iy7ZF$>U|@8z=pp
z2z_jf`@;_BV8khtL9^DyCQ!y(EPWZ@n?>k@6UYP|9i9f
zm(Jv0Gu!`++5Bm<`C~KZ>oXWl)7=tW6Q~bkzTnFENT3#s&Bbkw2XnlbwIFvp`gUd{1rj(2l;Fqao|v6;)8xjdT7tND&;F6ZW#
zPV+<4-2El5R_wbw=IY3uH&$P#rm?y^IgQn$d*t363$%V87&$)`&iO4i=e>D*vPOmu
zcS^f0zpU4jvGzUr3vR^U`71J~2WQoDQ`SaXmu3Fa?B@!d`*$Xtsg6I&zhE=!{MF2T
z_Wn{9_3utU_w}uj8EyQ7%=;!)ws|+lnOODm-xzWKyjhHIp8Tn-9*6v03!a^QI>(r=
zoz_}Q&cN=#IXV2J_kG}8eQRy2b#ik5nUkD3&YzZf<@MI(Yxg9_PHW7#vGMi3{Ck_}
zmcHQ2e(z83rF&A_Uz)$jOKi3Mg_)PP%ck?apS}0)QO{pLJAYN?IH|r%Gv`C^Sl<$N
zj|`uGX7=y({y^r=)Q@se`#p=}SIo}dIi1~?Jv!V${nbJ39hlDWsk&P;_0t*HKlSde
z`H`u=Ha*_eld~@i@7LrXj5!^=FSsoK9_rzMP3^}r9_#lXXHH*ZVu!3ee?j)>6o2dM
zvW&@-0d;d^(y11_b!5DSeGlg`^&Rx?j<#Eq>(hGcq`C4gk@sCzf5X&&{M0{Y>fJ~C
z$EW_}toOFrf6AeO{$mwNni$#j^A&D3f<>V5)BTa_BLOY}
zkDzYVjM|{bJ#b!L)D*t#pBd2n;CMa2d*$gguROkRp!FQt^?)4x&MX3rzdM4>fR1sG
zZ*=Sp7J){Fjrls8;-*hO>La@mECOw`Q9kIL+hKpcKDSez+0^9aT?x|M=N7ws_NM|)E>1PHGtlIh|L(1v;^c6^xB6|J
zz1srkj86poQiEjG9=W4|mcPPa`R|6Z$uGa#_Xgk(x7Owybd8*IJ=>qrs^{>q@1Bgg
za%R;UKCFvZ@BPAQd9vo7ECLNj=9+iHIqw4gd>=6{Kie|a)QL5E?H>(r^KIdRJ^OT7
zcjh%&-Um3}*S`5TWxO7YcbFWRzLhs*ydG3W4gXq5Acr&jJ~~(rMwwrqWYi#;YlHQm
zGNV88K?Z;8!Cb~&w0}5Q55|4I?hEuA0Uj2C)>y2q+J92kFA4OT*nVU3o4mSb_du{7
z%%nNhcZ!cE1Acf*$>V%IAaDKP)E}7o
zjj4CXaZblu^If<+us`ZQl{q~-1N!#_>p}G&&e*>DqoAywRIsG
zZ`@qQ_rLkt?%7&vW6s@tKKgVqIa9Z6tADlZv*Jh~zwW?o!Om%XBE4D~KVQ|vX5h`O
zth48nWv_Sil8jFWYN>194l-i4cD~PAGB_ZA_cV4lti#PgKQqbg4D7pGAa3`haq~y3
zFQb3-jsBR6yKj#%d;Hf92j!(pknagG8@5x-PbpAV;`_9z)?`GcG>e}y3Yr6)y|2eIRqjJALt))A+_TFi2^!X2_
zwbAcCoYqF)-#4v|{{PXmHpcM3rnSbwfBWV7|Lb%2v|JeD1C9styDFFezx?_6X+0ec
zSC<68mhV>cwRf&q``)bmS>tx@_ZR;e^wB%_$I~6ZA>+O`etFA(KU;Op<7my9u3a*%
z`8lg=+om<|Zr9ePHNWra+V*Mf@x$7KrnM&wYnM)IpD?WLnAV;+tnHlEe74rcu4&C3
zwWdZA+PTk?Y@Zu@GZ%q2e(rc97Z%gJeG7v$Z{orr4KF)`MWC5`(-(ne?mb@wn)&F5
z`RGgMeOvgpYRtybK>L~ePF`;Q+!XVvjLXAi(^|hnk$dp8cFQ35(bL+KhqaHH)_mqx
z-^WgCPZ`!8GOayzS{r@){OQjWBC_Nbk7C4`9yg6ykAHpTc2Dy?Q|~*1{r=qSySVxK
z)bE{oKfhW(IQ568{>ao{GxgU^y*ehpnEFqe`e#i2ZBu{y)IVqHpF8z;PW@+2{R^i4
zuBrd5sXsIIFP{3BPW{WK{uNXIx#{Ki>fkGllMgv|)_CNfU3$BAp`7s%{H&pG4*iT|-rt+}xyIaG)~j>BN<|)Rb0^+z&r<(XkPb>mF|XbDln*E(GuRD3j?qJ+-krYi#ht
z&v#n)@M2GF?5khAF9NN3;%8&Rx4Xl(&jdQkHyvtCuC?Yxe00%G{?-83=9Sr;)|~Bl
zE#r|}{IW?Oo>ZV50KWAafB4KF_V~+hP)pYJ>QeoBJN5^3>sH^^CHj|%l|!FBm8eZ=xF?F8OyhL`GW^d
zJ>MC;Cm3_U_B8>X#Ou!@=)f}_2Ltt3{cM5Sp@)9^8egrocD-@l4f=4$7Ma#p<#uK5
zs^IcKTui%a%f19Isc-*DWs)|?x4^T&Lw6?3}y
zgr`>rFAYN7xqn`x^Xek^s=!=ai$ILkJ%CQ%bgK(FTm<&{E5Ge)%e`?=y#wokJ6DeJeku^l$)NSo*x5H8c^~!K
zN2-CN^~eKmDYV6Qg&Hn6W=@PO;S&2+SG
zw;IbkALT^+M+5qPc=~-X`|`9m(C9bsyDryw8hdqdO~BWk!H?zlIeOp+uy-h+@20>%
zCm_y~!QsH!#;0!iRe?qTz(G8AKBInU$(_-vbEE3BA2x&PT4b!@$=w=xBG){y3wWlhw$#Xh
zX)WEkb-r&5bNa2R$JYfod1;_ot3LK$9*})Xpq&W#D`$Q-)Vt^Ut>E)}+`|PubN)_e
z4R`A5)_|Yl(`vWAsZTNS<@%uOS7l6x*0pkfd)CBCuO`;&<)3)GSADmPF9tpz=yk5K
zsr%Z`aQVG;9-FsAUGhT=a_6&>e{yMWjO`JbADs5csGqS$GF|$y(;%&}jrYKr&0zG6
zTx+Yfcum&WC;!>GTiesOj*NT$SjO@|mY({4G-K_jb9Pty&Oa%0dd!{ae}_md$f@oW?Xz*^WP^Vi-}x=ZFN}}Q`90hl0`hwzzexYyfb2B^Sva2Gho(Ds
z{^2?Av!MFkpM4y#A2sLr`RS~WT)%FbM`S6B%f8?I_nrbh)^Vi%G&N)Galyl4#Cvs;
zb7}JIT@-7-^U!VkWFQ`Q7|-~8RQkO^YwU2waRIpSaTM)2C$2KK`B^JU)
zV|G^Qetp*SM>Weg<;--ZdYyk+kaR4+8?ZyBF^+reKR>?SmVQq#+L9alcTf9#du;HC
zY`8!4n?Evh{Pz7=WSk?*J7uih5vbed$$eV{n!Ud1Y`AOUZr#dPxyW!Sn=)AW-((Ui
zxW_o(7iemtysDqdh?~vY7uW89|IVy>7uZ(I<#X=eJT~%g3Fxd3jmI8N^z(CBIwya7
z#yG(<+x+LBJ5ZgK8U5;-bMmPs!M#%Zni|K+W-z|#SLMJWYwr!z`q4o9nW^sRv&Q$2
z&)O*Shxu$9=if7Z{;}ON-;_1JdsDAVFFt4RB==-}P8jo7o;11QueW?XPRQ9ePMcfh
zj844a;eo#8IkNn|hcTQzEO>O#T0WJre9(^*K9uj~LX3UeHzFk0VjtgjF*&DgrL+02
zzE%47ZlT}(1ywJJxfHjJ3t`f6sE_?*_Op^Ao{s0o&gE!*SBR<2PN4
zK*OUme>wg9%+(h-bNz}lN6vGGKe*ZmaDktW&GFW^1K*n3Q_JN7cbb}!4?g#f;g24*
z<@>_HfSeu=a~&tM_TlPaUrg-caw7!GU2SH#^v6DXdT_2aY(DzTcXf>$9GPDlRA=Lm
z%c}zR#CLa44xL*M@Yoo4W$gP8f35SU-vRg{KSzSS!E*xj;_bF~EZ7n7)n_$XcGcF=
zD7-N}JBvW`9YOOs+RtkH&WT0Cfi*d%o33lN(B%ymWAC_oI=`P|j#CQD#)kKR-(!Bn
zczeJfy77S*I_>f0SQebQDvIfo5Ay1bJiP^fjs|@A@!WO%vwa{CuNX)Fwq<@XxsxMj
z*>B#Bot00zQ;XDshg{ZZS3w*+HtX1er&&yR@^j_wSeA7i(r$Ah1H`X-50J>yzF
zp>?(q1LXOwZpHbufG<5i=2x!xq~10H{%>W|-BTaE9iTDcr~_I_*zt;x|>b+j*-
z$Jg`jEcw1u87}WX+pR77*8*~En2$Z)`;M+>j2|4pBG3*8V%OxSJdn}wWGuc_XT?8{
zp*a>K|D400+*p$ncOU=d(%ZHOG(M=&F;=mRvC=8l_RjSE+A2=GY4-+leT_+)yG=K^
zmp&)NeZQL?8WPTLfDDu}0@c62jkofjr>Mo_24*
zhBMljdp79a49fGB8Q1rN8L!RuN7?3tj8-mAWZc~Jd)tCQ8hi3F_ZtU2FIRZL9o;{=
zg1dg!$RWtP7>)Zr7|Vh0nfO_s`gBYG#3@GkYAm60$zf|1pCe`(#-3J1CM}3=_gF`vJXbd~YDmxh=7>rHPmA`X?rEt~PGXm>hq!uAj)*I{EQ@Kj-Mhx4Jns
z^=e^X@SLDJ`AS#wyDMY%Ulqum8el_B;ejq3(M`_S`tg9AS~w8woaS#yuT`Ec=je7%
zo#|TNJlyRGs^4dkc=*Wv{$P8+#%3UvwV*tdD?W>_dF_2Xnl<|T-b+5&ktaTxt7Unr
zK0a#v#1D??y)?j&vucn|zT?;T2zKoq3+Q8~yz;-k8*8|tmmgx&P6pOme_~~4JUjOj
zN6zrKKD>SHtbLrQAu$^BmtVIAa~>OaefV(o$qSwL1sYDQvA+nk`e40d>ujG1$jZUd
zK>Ll^8?Y~HVpo&R3;B&{KIRyY8b0KJZk){PTurb~Z*_`;PM^!GxFt^yUe6~ZKV;Sd
z^^I$KHv_e0&lne%PUF@BKAd5z@onWx&+z|3GB1scyGeiJ&2U*OKKsiXpYY&5@YT;6
zHzerZ33czz?G5O8Oh^_3UmxflQ4d=02z~3ZWu3mUh8ipXdJa#EK)WO0>tl2N#`N;K
z2sC^1eA!nc>j68)bm#bTd?>v8m`YcAAe_mV~i}a
z_TGRW&Ri0_BWFe(-#F;7u2pA!P{%$0vdGI*=Qq#v?VHX2D8Jhu?Y(<8_un?bhwl!T
zO?q+vx3bP}>(1+O#jcwF^qHPpX7k6-<{vYg|IhrPnOYt78(06gWM7=)zR$$&KQa6D
zZ}j`;^Jm)T)y-!*s@r?<+{pASj_DNhx8={ZabYf3UpJe7@ieE4FZw+Jd7Rvy{V`V`
zojI9@O)_-8C;wj2n2%qY&3|+@|L)Ao`~St>y})aFmgS-EWF?u2*lk4;602sdS(C{m
zLy!cLh)DRtoCty_0%A}QCY1@|S!+?WARr#v-8KcRwzhTK3TmYuDz&1mrpQ69XX^>2
zT92*P69{T+_Vr)uy(Z7R{k}D8CJ9vcetx;~obUU(56|RQ=X3pyspbd$`birq=c=h+
z`R*I@`=|P0Q~mI%e#BJYFxB4Et#=QoA00Tq
zzSr;{UyXkUfUb{-EWS6_pBcGF+>hjW4#**QJD&i~_C7ij{4wr5kiP4Mzpn|d4aiZp
zxo!Vh1v>dmA)5}ey<_bS*h;tiO)e_>)>v=9_9Fvp+2`K7FsMEA=L@^6>9e5nr|WR3
z{6|eP>0qZ^t3TT3>y3b3;CJ}~>>(fL15+FC(Kq~K?D~Knd)PrHyT+LEjY6I|{;~Gv
z;JU!PXU8)6Y{^xz_3t|J!7};cK9`lD|4rX0-~1R`_nf#Zc#g5<3pO4L>f5W*W`lAx
zn8%nu@UriG;yl;2%Er;pVyBFJ@B%r~vF*JW$Qn0#W^JT(wIYjF|Z`lUYGj@$P4`g8*y
z7f(z3F@e%O4^I1%p!M}>ldEsv(*w510pB6slG@(JInAx-kJww!|8m0L`LWM<$K;7z
zZl3Ug_{`VyQS%Cq{lPPXQD^Tg`#&gX&7bTX`?sfmC|C=~?cGRE$g7UT(4{=fM3L0m+0jEEbIn)VpKcCqKlHT)8SY
z_zX|B<03a#*)Fd}-h83pM>qbL21;#ju8BFl1v!m@y-N4sAivlkH>#7}{9@l|SGs4!
zU_Je-4W^LEX0|(v?zs~IK4QgI`NkH$xFgt29)AVxO?jRo0r{%nEz
ziL8R{-Lp2WBb&e2g1g^?%0B!z19M|OerWojbZ>2LK8l-sP&y|Da#fBP^Zv*tK9c)5
zo($N-r;QOm^Q$qn^Jfp;4-WXfHQ(S|f6FhrmYut~zAQWKZ}BvbiyTpo2K-O2nost`
z)BLs;sI4{6XKY&pNOy$z4
zfNc577P&QYxi@bw+_Ht=iyPDa$T;(+)YdHmQ#$9r9j`9WT~n|v0O>-z$-
znu|UE`fQrle7hdt)O_U|HeDBJivhd&)H-AQMwfC|Fy>tEpPu2-ALV>`_TbDma_GQK
zd)e7)?pnj|t#3$sJsA0uv5LRAnTJCGKFVF&)s~I?#2%cE1pF!I`yM2>jUNc;HAgOa
z?uW~QV}bqVthHw|VB1Fr*3xk@ux=43=8p!(@R;v?V#e&1vx>EqwW?1RIqcZZ=e=7o
zJdyrefS2>
zh#9{2%d^JceB;k{Wm){k{I8F#CwEz#$f3g=oy})^niF&{0;P6UHyvU(`qmmgDtEDb
zVsI$XR(ki4Q`^<{?hDBD`Gg#KRW9b)cx#|o*KQGmh1{7xD_7ku>}4BSuM7cu*~ynz2A2hV
z25c2;&z|~|jpeQ`$3CB&6K%G++t&lKth1NATLZ;@dfid=-+eh>PoCtkgI~t8fD`>=
zO}Bn+!}(NzmwRbF*c;T&+tNN1kfZRUHb1GYBje7Xaph0`oyWH8`NrC1`8mqi%$m_(
z&NCT3qvM&ePac~Wk5$hA{vv1e6JL-?7u&1Xc)aSyod-8?ZZ=Ub)*x;xX{@7`bPW-_>
zzVzJSLv!rWciwR2BV2K&ubjqx<`#i6KATZG8Qc=c1%*%cOtn7W$O(lWF{t0V)*87c
z=GHtjz|-1?2JR9ua=)-?{4?xp>Dy1|9f38s1s%I4?Q4VbldF|4W^5qySE7uJ-bM7`
zfS3E>u`z;Ajaxtey9rOpnEmF)`@Q)(*FhFtY!p+vaO6+i-K*O5m34;$I^H~;7yS1H
zt7Mb68Q_0Q_>04{gXc!b(^HEz9UXsO#$TBJa{}KLSVR7@HRM|J%m8*YL%`
zzia4xT^bw-oIi4#OYD`8jTIXee_q4i4?dOpivoJeM^3V(oXf`=@xCLlrZWC^+M%)a
zvwa-DIAEW5m`@7mWWy?%^vV@+TLjj#sh{igzKTC4h{r-B|qvfd)5ML*f!6>>oc}LQ1EA``_Ru$$(Kis)h}ht{zn9CwhzbJ
zo#s|-ePXJBvI^2Ip2?AK-|dD?7jzI!jwCYR0H_#B>Jno+a+rjS)-6w?h6AcOsGP7LJ1B9pkypUrHs
z#@zU9rUNJU3ETL(e&Z9q@cyCh`4IJ$5
zb7bGG0e|CX4|$zu8y?2bc7KxJ`?GqDv4uQ&>RcJaou9SowMKn7z~zVXX9oFHT==Q`
z_=p_)@S5-Y<`w(c?Ofdwh_iAiFn&#NZ6I&O`qnJ4W)UcOt@14nfDga%)BWjFJmx+%
z#%}fKQ+n%DeCwxGw#)U)0(Xu)Zq6Hb4~RFPb)4@zP7e;&(4&3fRNK$b`sBNl#d6hi
zq5ike9zN9OS9#OBId+=U=L7CI
zn+|qZtKeB#GsiE+YUeF!TdN!j@ONLE
zw~tP``aX@%s&{F;&Er$w(8W&nJSuqS0%F={Ja?$*RRd?$QR?dTc^z)vBh!BPdu*)t__?eSmg(Hz-Tic;=3Dr
z@xYIb^0fWdY-^sft$ON@`(h^{w+xyDF1i>=|vv
z>1e>#^SPhMwx7&Z@ujzRpKpB07;S7^_GVlg++nrlzTUgLv5W6&msl$9F+3Gq>Jwwy
z?wI|7{J$YM7_iO$LjnI(Ci(JY`+NHBKUcqzzL*<76378}7klL<$RqL4p4X=`Cdc_}
zJ)pa`maDql7ilYp0=nomN5?Y#*5J}yB^!sa_RPR-JvbNrWUSJU51I7Wer>wPnr?nw
z51bn^-Bq<&T$b4-ext1R$C_;RtOu1{KaMipu{f0H=$p}3p4s{jnQHsQ&c5}4y<)G=
zFJfwaQMvl|>Ep2;lplMY`$Zu4)QWhE;Wfdv0lswc<#^_L_O8$PdQiEe-F#d98)@UQ
zozvTYk7Yf51-JQ}zS23iE)1mLNH#x!=hQs!8hi6Nh}VIj{!jC?Y-g8`mFnX=92PT1LaU)jBfMdYMw6nsvcv&_oHsURz{uoC9b3Fd0gjbc%Ef@XGzV)e$)fek&uew{w?&sUPqs%+AvHbym^YJ23
za59!{m6{12lp2*zFozu`GZ$|rj65B&+n~cnI~6n&YuOfwdbI6
z+8^s1vVT2Tb|&o;S2@{xXzr`Azv?-_@9TkD!B6hX0e8jb)W%^WXl!?L-`j&DUyu*Z
z;0Slm_#GDyL_Gtj3LQGMiV{)Fv{?Uk|LY&-z86918Rm
zKJq>|+HzI;_8blHwMH#hjPsfAq!jy}9ei5A56+eQ-28{9<~N*A2G;V0QW+0Vn~(A5
zZ?%5c;YyYL+7|@Z1lI<*z<7T>HGMx{G=3}~j~zD!N78XV=lVR_&ak7s^c5`5qzn(ereE)VlYx3V|?(%YD
z>W|;6lXoHu)lW#xu2JTJ^!Zt=_=C^H-1^(He(pDCgdgU9wobm_#5R49V|3t6M`O5_
zHi+S#WY|MeJ7>=9=LUZ_cx~_l!7m2y3O*o8H-nplW5LG<&ka5^_~PKJg0Bf)8}QK+
zm+(KBas26KE3SCsCT2LB!`nDNe01c92fvKITTh=|_L;NK9pxPIY4@;eJ+L;^w$2Or
z+H}~fCfoVJWg{?-qZ*GVg@^jdQ~fa$ujX)b`#{#v&$g3+^HZDY*~!+YOfs!mW^0DG
ze8fgF^bP!7kTHa=i|;n5ANry=c(tQ$5}mJJs*D#dgRUd>Ur8Z
z=#hWttLN$GpeIXr)YEhFj4bpnIOgwW`ik={chxv+%iCr7TX~;wKgt{Lm1jmS4kOQ1
zJjQ*Wc%J)iKhJ&7I?sKdbe{V@`8@YM`#kqOXBYd9CQf};$an87?zn6{<5}@38F25<
z?@w`cUs``naBbk8^j<@@T-$yYZvVYDI^5xExG=DH5h(6-^TyjgnYOj30{RaJ%CF}$
zy8OYxdizEWc-XfH6!NU=8qX=R>4#DF@6BYhvHQsVizu7Dz$Zt7MWFDDc-6k0{NnfO
zjXod!@<7Y~i|Y3Wg7-rcFK1OOHUf9;-BI-L)CU7P8_(+ZYyjuSm>ic2-Rtv>y<%GV
z{oF!N$m=#f|USjT^t2ISDKuFa#J^uMp{>30OUvFElx
z@!6nlw#Zq99k|OOpS}5>zczwr1pKa8$FBOJWA@e`<`==Z?wa(k4fqb4tM-T&xd($$
zXX7#QbguStU@*?(X5UohLxfB55pGdpl*hq~aeeSz549%q1`*8-dx=X14*jQe5}
zU*4Dfc#r$}fKT{9&1Sx--HWvM2KL~t>}JottUK2|JqOj({KBhzJg=M~vc*Cf`G_I@
z&dvCJ(yDVLe)84X^<55`=d#~<6caMa)A{6Q`Mb=Y){VY7*BrvnetMO2-OoqeKfiBq
ztM9Zo0?&9l*d;dOo^-eTWzFG$&A*f9>?(irmpkd|0RPHzR_zr_@!h_^{Hwa#daW~0
z57~ZSi*@|27C+pewvjov#U0P4W$W$bn^oM8XO0h?2fP}?v0Zy`_5Ipq!Og+lS;U`Y
z@BukTfx6s=JqNeLBh1ri=aB^vNl0dyh_S>-lB=&OxVA
zE_`2GmyMBs*oKsMPyT7YpKn&eg`V-=8o$5CrRTs|#c?-s-DBkPAswSk+Vq3$m@L+}BR`gBa`$
zt`6+2f9l_(8M7Z}`?Y~wK5p#hd+oQ*8oIT|^CM2<`N5&O#Z0Wl<}p)yS#0P$m)P(%
zIqFq0!cl3A@V373svq^ub(~+CO57zZ2_vb66nS#t6IkaheVd1>`Pmm$--0rR50Gp%XrD3RlN3Rjy^s=7O>kn9{JW^^x@v;gtg~t
zJGshe`?4`Q>kn-OFC3I3f!OqWME-Y&-4R?8Ec2gu*vEI;YHQEtKkHWc&wl(L7vLtB
z+ynf1bzoj$FTO{E@=%ZO0d$B(ZEJ0hz1#147jAv76F0F?gEGpdx6ehnSXjX^?c6)>&OJWL
zv49-=`V6jkhmCgSBIp@v0f%${MnETdvmYSRMEZMv3&&kE{KJo$8d?{fe2E+wB0bkz^78)rQ6BL^@0?c+bZV3n;M
z=i38;XR-ab-?4(b{M#w-@G!3|%gx5nqbzeS+%-I#A{>B~1U#Enhon`h;8S7gx3
zS8D!bGc?E8@Z(Ez43Ean8aXEK$_>Awc|8RkwfE+5z@
zk7}#BIfSD*Yx%`qd-z6tpmwR7FU>t1KlLvF$LIeA;CSjU0LMFb!SP(qhMbdsa&D{_
z=_~Gq`Pq}J@5_9D!7hC8zUKI8XW{7FyT?X9-jMzir*ZM{oSpxBV3$qvPfzXhomjgw
z#K@hc-Dk_ZzB6;~kM+R)L5KLdL(fIdsjOcmhfQ+I9Y;P+Wb5PTKJGn;pZ>h=JJWjR
zMxOSslJ7ZO`Sk(aWRJCbc|GW};aJ-89_NH?Dd)L7y2u^tK5y4EUfE>!Ow|wev7s`T
z*>8`27VAFO*r|}Q2t2nB1^oKnct;i2MWE0-zBh;$`^LPMD`4DS?`1EHv-#%P
z!3*|mKco4r-&uH%6^}~;&%M5TwXVMpWR6b0kZ1PrPh+k84v5P3!E!9z9{exGPh4WmAe9YU=8~fx|w4g
zd^jNU?=5*>!n?l2gI$XtuHO1?P|V0=ci+R)CR0
zlIu<+U%d$URIR)(e7ovS=zH95-euRrT~4ymJBVk;Rlx;;ax@Ub>eB8z;Hq~PGTxDA
zwKMGQuy+wCo(rBA<8y(2db|U8Z}OZv5x5IB19Cj``;Oood6pOByWCGLc}Ea0Ivy7&
zYW9&sre~XH!hrxcHul-K(>vVyw7$N>cQ?MHV|*7poW8yPb@16DeP!-1d*N7s_fG!m
zGrsRVY^|@z@aKu=?^E6@%#FTUOTRMaz7m_p(!Ng&eCFam`pDx?@st@!?$9rQf<8+R;*xTpjdfM(5
zh0XoErSHs;Rk@x`%W(&92EBLpr@hL*
zzEhIJIN|{1s;+!@>|9Uzu21XS@%*OT74);badOD$*!<3JT>RVWWH?861lryg%zGZ-
z={dlrlY#L?pw#dDR9nn@E^P$$$8J9}o~s`YL=A6%31YXiFBNWeEEpky|lS^#XUKVeAK5N?ZPa}kFn*n?H)1L10XUYzze;~kt-etLd
zdB({RTe{WtPnxIC6JL-gKm5KJyzkCNImlP?@am~Hb}*2`hXOvYZf*Kr8t~6mQ{OY*
zIIzW;u-2W9m$3rB1A%#GyzA)g8uhAmVzkpb9F7Fm9Sfcr;7X6uF}#dl9EfS3KjO?!
zCj)DG=PuG#yayE{NBZg~9PD4kb5%U~+}`dZUtEme99%cGpOyNuz`PjXtI#QC>?s#*
z>Ib$u`{JlT^-3=c(b#;IjU)VqTg55Zg#m1d%Gfx&D^?mScd*=SA&zJdw
ztj4S{JjB5h%_|*EX-j{9qtff069_oL$=2=TXn{-qJw5e$kmi)C7lGF`qeFlSBq&G}rLx&1-k
z)6zWsPK;ydpMF;v+vWYr%zsKCUW)$D26!tk3*H^b5#`H*p9^jX+-=tdihW-c?A1xJ
z?)w8AtlJC}Kf(yB~
z1?>9#S+0}oe4G25vpIU!0`U^x3j%&x1pIB>y)llni*L;1?X&iQ)OhzjvHN!FlX-I3
zb4S{2p^q(mZ_PskK6_@s7W}Nm!@A3Y=0dp~%ow}o`9!ut&c3bIy|Es-UYI%D`k7X&
zx(6qG_+Y;0=8WN>I0xNB-m*RQf%sU-_
zL5x{8{}zMmHB)shJ54<
zoDAxFcJROF4L_;-y)=KxLvrYPXylCZ*4bNGa^~tl+~}`dHJ^8$p81)li{JeINNqeT
z*IxWL1AMpdoeQ?&#ZL;`%)K)B&Wm1r3;q21q9_*^bBjQER?ytiKNPG5O{fGm5aQdQ&Q#rnP#_@$&^CPc&{<{{b6?^w=wen|_Q@`}b-gs~^
z_2+Y!|JEyhan;SlU$AVCeO>SDTF>9|pzFm*A@guRpFj6&Z}%Iw?iVvIpNkt^Qz
z>W_OD(_Xr|m!9e-r?QNZB`#|IA(OmCfLHbKzxmpv?tXLn)>e+X;6LvRWP^?dQ_otvv7yy)t-M@Yvu9!N&)RxHV?<-~p!s
z`VIu-^N+IAdUx!(tf#~C&mQ^VEGqH}C%SOqbN&cZT&aD0-P!0uT
z?nYj7%so+gbjcfX_f3%d+PFJIxUUCdU>!M&K%t*ccBB7%?BUl7f@S_GcXIL7$9=5X
zdgnCW`))n`=FuW;Wo`#sSLvk>AHJFUk#FW)>POsgz^6XNW0_CMxF)zZ*eOTYDt^|B
z15WhOf!lh}xa}rynu9pWt8&0K-&v-A8*}e4z
zyTJad1Kh_od(y9;nv3iQ`{=6&M!hF|tohZT9x_o}42WcWp(k^?7zMZF`kNfxY!74r_t^^fb0|
z2JAClG{*d3u5!qz9I}9{0|6au8`m};=%~)-EVON4zX;^Xymz*}mnQBdPgG&d3vG9AlqijO@N!%0v6`>p0Gv!Fc}Y+^KKR
z%|YdME#Dsv*dT^}kd>VO_R)&nxd
zfE?@8Y&#a%FGtAQ43tBGb;?~qbIthyoS-%xNZWq?=-N=)${qRQ=NkGr;j#VsVEbnR
z_5ppqbNZ6_kw2|l1j@6vtJC}GT?Dw){>P+!G`K2|)8@w5^N}@tWQ}|)*O-6S^*G*_
z^>pA@`}f3ZF~vh&$nl->vfRl#7yH~1bcm6a(Z
zj1@W4^C?!=%kM>?7+a-ZeB`efj{at^JES&`_X(TqQFjksApgEA$)J5^{%wCgwNEa8
zQ}Fx2by@ovfw&wEaPK~x$A7!1Hpw-7oU46H>hWwZGOsMQ{(tYD8`3`z&};pupHIj?
z7VsTj)~w>?o>~NW;dDuWyF0}g8Sb6UKt7IkjyBLC_KjEf+h@#LYv|Li59T$Wcptqm
zpnnl4i>?3PE9Zvv>w|}+{g>4T7sR$jpe(ljzdIkC$XY(+UpXNLazYHmP^?zvMB}>1
zn&ySrH!sLNTVBW`a_E`oh5ch*m~UP*S60>J$`A2g3l@R0*!usyI>-F*PCn)bKky4b
z(6h=9-i;PPeIPgKKO88(mVcjVCqIlfv9b4&J@ut~X!M1-?sK2;q1xE30pBeGWwG`D
z?KSp|HoH?toBuN13+!41%3|yP+dh!nqYwTv-wX1lwzrlm%Y5LR$dBfo=bT*L2;`J<
zDB#y?f@^~dCRlsf)OJqfVxMi~kzov)-#9os^15T@7lBe;C)1vf<5~{dhXcjWvfM!r
z3-(O-z??svd&itgn_m3`fjRP(BLThkD$c{Ie)U^>Wk8;D$FA}G&;K1TzhBg|(mT<5
zK>xV@mov|Ie2VA6fZXcSX7lzt@AmH~caHhMI2&*o{oYvMwlU4&;QrqmcxS=E{-c3)
zzMUd1@@i{8rRxGCyaXO)W;EDd$;Y~{yUR5rLPS$v2u=l~
zociRNj9(kz3~Z*~Sy}|f_yEsEpihqY;5*+x-@C{f#rRwXzp?v@fL+G|yq$r^O#O}2
za>+d-zZLcw6Js36E^lq$(-^03GjQ)jXvPi@4dvEvgE
zXSgAt(|R>us&Qc_pU^F4{~)^g`AC4fGqDJi#n%6~<8WKrd`m|4@;@96#&gEc{rkRldCno5wfRT9$y2k9K5NB#E$Dq@jrCs`kg+$oG5Fgtyk|b$Egz`aim!d3ZHyjm
zxyP^L7+!p0es3UN+BkU+(B=p6*XBoeihakYHo3>9HrYo5zPTk3BZX~jRK`2us_miE
zdBa{Zp!(QC7g_YMhYnn=7lVy}K3tW4r({n#X)gk$^UX8-*rsTU)h7mY8>gQhe&2{8
z^z09A54zsmb-~`iKF?8c^Ere(^Zl;2ZJfx#kzI2=bZ-U@MKqg-MxHk{RP1%Wj)<&Zf=tc-ESXx^sxEjKkiui$)Jz%Oj=n)Xj-Y`$i^gEDvu;)}@4Ib_RbL)XzC*L_#(}%Zt#W-2U`Ayq930>lb$IF-S
zu#Rpuj(4wZw~f*7&QO>4sC#e5ce;NveTKi-3co#IQ6Vvjj?$-QOz
zGkjX+=!=m*oqV(#d*#-JL34d4d*u{AvV|S=&}(npy5sZgT-S>I1!s}T{;rejxEXtP
z@Z69!hx0tg`NiEXJ{tj_Z{LgCKWlwh`mYM!7${`QXZMmE7MBx&eeR9QGiSW9xIJz6
zz5B}==fhq+dq?T>KQ4{M!L*GlcLj3$6$$E0djjz6Z2X15jkSn%yi;J_wH~3k1F8=t69dyc@
z+JnE`9CZ85nh@8pf`X8PyK>#NRz
z7u|d@`i{R8oDT)_J4XLR;0|tniL=5!W4)iR2p8+wAh+14{MKNjb7kJXQ^6uovh{Qu
z4>>6p|IP~guF2fB0ex^RU`umQKJ)i{9XrQ$xUhrH3xfIjuDw6jMf@4hSUGXPU+rv+LgPoq0ncfxei?i;&@+RZG
z&6{8ED{nF$DBk4CKc#shmiL9T{SOphXYj)VrF_+MzHE}O+wUveKR1$#iuLAt7tHh1
znzNk)GVTu>-3#uRZJzi3Jnx2Syn5I-K40)R#~*!vc+50*Fg07rWrwqGtvjJ|v{+{nWI?Y?hSNih(_*ApO{cdg}AggEHI`eYfygerZ
zJjuHxI2yqw@K^JGna$+GD4YJu-jlXsuRI`sBY0-OPxRgx{NE8`&2@od
zjl!nJ4Ou2*mkTs`G&kxfxC|XtYz1FV9)J=*w|Yhxba<|x6WVv
zYAtTcUBNhhdHV8PUZ`Ihu(kWe-+r>S@xw0q$SFQD-h5%VIcHHh6&PCt3jX}2+!gShG4|Ca
z@nVxXYx%x;r@udF&KY0D*?A$W+3m?zW&~?l5cHclY&PmS;H8H{Q$QJl@CMTOZ=-ZuomiqMK5)cM&Mh3c5}{
zTle?RvJMC9{=tfM=I&ZCm#NeFP@b#CI$wT#20eQ{uXu}{abt2K>bLs1j_vun=F5R$
z-_dE0dORnWq`w&~+aqT5sCUwFF!MMm)`~^%5A9C~_9WY^DfXp3-iv$FSGvFX<~*DX
z_^r9uHRq~>?mH$~YpLgQ@pLN8@jrCE7yR+je8RxKJYFjpEiT}y&;E2
z|B9deLUlnvMd9{ac*z?e7o;|%Q*@Gh)^v-pV+xOc=+KTf*X6@(CRrbFwbLPoiX8$WP
zKDVFFV*%gT=edNl9An4x0=|22V2zy~sxgg_oE1hr5$zR1;+}KBceLdDUWcVD!`B^y&Z2$tPqux8h(Oo8{&_
z*PSK%)a+D_2e^!W!bc7^55++~s_Dk(yC>bNo&)xlPjk7o{5ue^6JLdXJdOm$M*Z@a
z-V1`Sh~DOKWmsFETLWY*0)@RecMTsv_0_HnZT-E##$`QyHdu$>GN0mFpRz~cQ)`>!
za=!kqoX+7+KA#*6yid$|+G8ExSbMHH?3u`>@#l}^HLtao<+X9BKlo{XKtHa_&KrKq
za(!8DH&*PT=WxK6zcb|ZM*4JGTi?y|+Wg5toW~g8GWVUa-h=e51#dV@F56QM?lTZC
z&jN8)=&`Ob(zcEc-2YB=^uDx@FTGpY?~XOcN414Lw+C$E6EV0hkRN3CeV4s=1lG}`
z+!c&DL>B*w8~JqV(^r1}ZYUkzxx{v-_%1SEPVOFZj49bKS!vBbUkgL~I$EA+d6
z6u!jO87t5K9-hswo+0Op?d;@7IvS_(`-tZ8obSb1Ummyuy+;GO@lba^AHpI~*t`~0
z1};z;>>)!9mBSC4!6Hz|8GV9>9AS^MMh5%3|6D#7$$6aEgcm=n6>_zYO?C5B4(to?
zkW)%)a`+LqMW8hHo<;Uu9j{0B5-EaJwvyrO%{FPab2+NY*uH)Z593-^VVk(
zyxBrG-z|^l?HG4)|J4Xj!)z0yKOMK`P3x9u;e7;+zPj1M`
zewMP%bLOgm&5b2lK(;x4=$v&h#;^MSVA4On+gK;w&0qde*wg&wM}2vxEk2d`Gn33!
zu_b>qP}?Vm#GM>A$Zs~!`I}z^iZ!E+wci@NQ2iEZS{(z4*0`W1|XO39OwXQpvHryVtflS<1<@FuYI`LEFb@z?_AycmP
z+=x@}K{fsSfxF+?NhhvsgNp+>);!ea3vycb-6cb(-#zH_If7hr#0{7E_*%xwR~zW!
zYwaV!oOAj9Lijc(@Y1I5_*CqHjrKW!oD9;L>AN)oLe{$+i3dBP3
zZ=Th+FHGNk$v@-IS?j-zjNe~tE{Uvi_*daD_WybMyU}xM;yTZVQPzuRvi(~Q<{uV_
zpYqfH>z;ec#lP3Uclze9nfmXacK68Pi}L%2+E4ede9^4`ZRs25PqOU!ZyBRoA&+0p
zduEEinr^juwKeLl)An9yo#NT3y&GSAdF&j0^SQJBlV|ST6SEk=w?$5@>p<_MkV%mF2+q1$tZMoF8ccHe;wJk5&?sM6E+heX6AANEl
z9F2{3TspJk;#vQX-+iW?Z%=>R{~yw)gWLi~ep(A&HrxM2v;ODI`ghLy&rW|?T%NLG
z{BbMBKYYdb6&V-r@viuQ@4M$7&!m5r+^X);kNdJ`^uaxUy!~$(vDuyQ&h*Fizm+~6
zinH7MQ>;8s73bRX)xM(v`QmInzg`)T?>_#P$TMbb@7ayC&GY$ZO!H*)v(5ft{+IF#
zrN$h;JAJaqynI?m&utmMGc`Hn%Vm7pcE|X$w`?#r+Pt2<_TjWAxHNrx+uxhM_lEKQ
zeAhd-|81v!e!$^3Ggce+P5X`iOvd|csV&Ceobm3b_l@bZt9y<8>uK!zw9SdN`sS&A
zbZR`=_0p`ZZ`fmk}`t`B?Poz)x
zk)Uh7e;RX!I`-`u8~yt7^cz#-WR$O*)_-DPzccxq-``$ec~4CLLDM`QACV-klGi)#Edpb$s^rjF0*K`t-?q{Itg2ubswvu8kedSmXGN^zHFoh5FNj
z@|ROr{QEQco2Q>`f1Y0=S~#ILR4YYQN8%wO{=OQ~yh*`Xy8SrBnU#ss6I5{_?5*%BghnituCe&EjNca6FORH!VPLF&{)6AxmeoDhRMyWAbH?P%+omzG
zuvRR){@XIw=RxH))?YNOlS@w>WK`})4rAo@EX(iBVXo^h9dv!xB-`4*lJPN5-kM*?
zS)OX&os{oCALc6eOQ$hw!5!4~&z$D?v+Hjh)_3efhA}ceY>@G;U)$zmyzAedvHER{
zi>9sAw?y3O;ehq2dA
zWB({)bbjqL$L|+st~{SN&7Yd)-4UPmtK0LH|M>JDG_CuGQ~fW8_22p{+xkCeSYt0;
z56;{evCrY6_gC(PFNzWI)6?VE?S@A>&NIq)~R-#OK98P@)**;?!1
ztd&@od;6heqd*9_B<6ri3_kPale4j7o4`sgo?R=jn=HK?S_kQl_d_O0ezccf5
z+xjdq|9+Xrt+`SeS7xjnzwJM7uVJ6HJ@Z}b&NBXpp!sxZ_Ec~8J!o2Y*;If1u>RwJ
z=HB)F?#EqpV8!^me)`Pw^7HA>?ZAbMZ`xt*MLW#hw!_>NnH$gRAO6&~etyH_)j{>Y
zX_~X%+(U=C&(GW_=ft$OK6Sn;=dx*z-;M1F{>x8p>lKrZy=5AE&@lG;C1bB%GWOyn
zV<$5vmX-g+C2Ovq#u_`^9x{zJ-;BNIC${-EcRp{DD^5Q-&5bhNuw?9OmyCVMlCkGa
zW6i_g9dy0_Fju>N|Hrqvjkf;uG$v+Z_xpp4mke{2amSLe+orL8hW^z_)*nvwdnTFg
z%UA!{HisXc=DPOnQ~ytfwa2Hm@1Dl^_lk@)&whOx=i7@i{-D%s_|0MbcYpNWXZUXo
z<3E$}K5Kq^82{dk_u25@hVgI6IN3J_>K~eFA6WUuU2}X|bJH|e8~22G*Zk-Iv@Pf6
zY0ZyJ^)F7f7?RHq>IGzKPgK3=4z9i#)
zUj5-P{)~(_r~YUdzcJ%D^)7wqF!z4b+^=NJ8vE3j47Pv$51;uS_d!3jE$`2>?s0))
z51+O#*0uS9LDpN|cBZVqH|xJN{mO7Z^M&%+E5;u?+y8;-pprK8_(^BPh*!4Ixfvv{e@#=+jyD7ss3!9cbz$K
zKdJj1s}4DJFwcB)YL|C`%KhLeK62~D8UKjX{{HSGQf~y}fQvYi|Jp$P&!*Zvs$Z1H
zhfM1qG}ZonHfug?sy|?=KY!Z$1ylW@)A*HB-JEWHcpBe7tv@i;ho*XMn!jkOtN*V~
zeYuUttETmRm-;7Dzr4%y{igNrKh@tjt$W>6fAduL{q@_Ye&5NyYwCZ;RDbtWf6r8Z
z?^M5jR=;8Dcm1*1{KF?cKRAuQb*g`8s(VNM=+yt=ss4$n{;8?{nW=uyRDbeRKWD0+
zJJlzr`uS7+sZ;&8rh5Dg%D-PSjlX27Uq00@o9b6g_2*3W=S_9d&71HuuwyP4o53PfmURrXYK+nd;_W^ZDRxzUv+~jUSlm=H<;(
z|0AdRaZ~-+*?9Li&X1VppE%V|n(B|8>ZeTg)26z5y6$79@uyGqXH9kOsr(zJ@f&CL
zS5N)FGu3}O`KR@3GJZ?O#8q*(^39`D|MOg4PfPs-FB2)B5bVi~=5BJ2S?k`qBJerl
z%E0-)DsZmdTMrMe59Fb-h<>lO?-=xs?F^ssJ;?i||Hxn?aA&vuptOr;q|FtTvp4P9
zrL7zZ*vkj*X2oZ)4-O6nYr!?awEaoozAP4?JZ?zniD69@jeD5wwcsw`{B8gsy2YwSH3R1eu>T)$@)
z2W#n3b`#gpUoXy{^3vW7=$ZSA%yY>B?;4*N@aevQA0Ir_{KFPLTm;JPfxE@rM+9QW
zfA+p8=vh0NwsmWPa#zqC8}rWHQXlUomgT&eeK@oET&86B?}mUb?Qu??uA0L|PKuqjSd!rm+6=~dzMs!8GN#}~Z}0jG
z45k=6m$SuIT;yx(Thqp4%qRLT3`Tu>(iazNohQ#~WBl1Mb;odHli16f`kQR|saPX-
z+2dUDr9%F`t=6{ut|Qwz+)f5$$s_Zld}sG?pyVr#Gk%`(ZRwZW!!l1M{hyriwbX35
zDj>J^TcfbYxx(+-!2ODgGRDsS#z?F;g6?D2IM09fT1OrZmj=dhSp|w9*KZqT8+G~$-Tz);{<-pJT1MBG_lU}8KaT$hKeno)w%78m}>zjQfoBrNK?X*C$|$
z)b9!Stj|Ar?EFBvh
z&Nvz&WU$>L3yPX?zUc7ooh&lhZPu@kr$)Iu8mIL0&_?%yk2d4ryk}ZeivHYCBbCJ(K
zO8yAm)_cpt(rylYNB-W%p9Njx{hXZk-|*+#KTENPEclbGPqn4rIV8}L
zbhrQdX%F9Z&o^Xj)bpBYk9P~}%8^aS!|~?SzSDkCYWb{9$0(zJ_a?(z@5koJQ|V^W9{>Z{$*2r`BZyHFzy+pzH+KJrh0R#<&^oW1G%BCxSPp-bnyQ~sXO}bU$Ok|
zaI36komxJ
z+sjXt@h{VnQ*#;g<9JPQZ9o=$LQtFNUJs1dCif|B-x#@Up38L(JzMPA$+p+t54OGT
zEVhNh7T0geI=n}&Vt}h6$MJpV?2eQl@>za~3mNWN@m7un#_OAH-);ZidwUf==o>
zi=ne6!#=+J<_yRkeAMDg*Lq-#zWKZy-wg1c&;9Lb{6kW+)A>=V?^{;rBTqS-Jn?Pb
z@DH2hINt7G`=1lA?O#Qg`~%}J4Aui{?L85&G0V1K&F2T@Qd{~QkhA=}C)vxd&MN)h
zL!T0m|El2IgSQ2L7Cbagx-s>)Mv0syt6b*(>A8J<*2;f(P}d$v8&_+TV*w6F1N`gX
zf1M6{?eE^&Gmd{w=8cPC$DLbad^3*WNtaSR-xfXi_3n9L+SOy6tn&Z#v{&&buenLq
zT7dV-Kn%Y>j%!xxidYF>6{;3)%YeaO8ins!i)@^PSRs
zWxITt+r;MS5ZFhLax}nY&k4NCeRc57!S@C~9Q;D?+kxlJ_k>Wn@B?4bBQ8qynDcp(f8UrrV&@JUeM~nW
zvr%Ci+sPnL%-D?oDDQhGdG?JtImRthTe|q8z93r}Ietp|IDX$QIofOezt8&mx_;Qq
zxKf>Jb9V-8Wk)&4lV!H9W!#=m3h4O{yRfzAkDc}JsFRB5U&&v`H~HvI_hIi3p2yxX
zX7s-~GQ_xc%K6Pe={P?aYpkp_=A4S{HNmw(?_#;wyZGKaV*B^=%Y#F~t%39Zmgw(Y
zD>pthsIGDRGc!(~Gp{s;Z_R%Gg>gSF6U5CT>bdN(J5xYo;w2maz@ATPoKt9
zogU}M{2GHTKZ*~z^31-<|B=Wa<5~IqHI7%lyIO9sK^|5IpVNWk^MmyON4Z%!U0a`z
zcK)aHw6iklsO|%kZuwFj%^mrHyEFEq(a8p=Z`aet8|MDSn~jYl+rYVss4bsXkD3g;
z`kjuw<7Z>s`c82uZR;!B9AD!g7DoddpB~`;V>9m0%h-C*JU=nD@dA6@-*Sg+oW-&F
z>A5~Q9GK4^Gd=w?z{}FN&zd8_y?4j@*7w^u-yD$n8NpWs-w=FX@Uy{h2N%at8^H^M
zmjz!Rd}r`e!EXotqV%Jp_?5w{gKr4FFZl7`kAnAG%b)iO4h0_(JR$hp;H824>c?Xw
zU*pKu=LL;dnx}c2^D{F({E5kjy<_b;5bz=2C`SVJ+IM?k-%svhU;Qg?{7=p$ftcbM
z+FLT8lbXz*$|7gTS~dN(V?Ax0>@_b>ddJECCk}mkP6q3Nb#dJp&kH`OZRLm?4nG~?
ze9=3bKQ;qp96y!5@q}z^9ET@N?ds=8`m5{c)UK|d*@dnfvS+U6V>8xxolN^|dj9iy
z>N!_?e)a*~OeC*u0SL~^8pK5GKEskt2R~NFe@SOq9J1u}
z_^4xC+jmd?>bSMzT~J?BQg
zf{z?D-}kQH3WuKK>OPS9=24nk=U~3?w|B8`ynpa=caMH3hyOPDL0s5SUC&Eo#JKZ;)6Hf}7!za^btN2$|&kZj4N94*lJ~MOl{?5eTTKwnvRsQue
z9`V#1gT{&srQ>948{f%imH9s+b0?pPS9yt{(!IZTANKzK
zF7~ozJrL`;?myV&etsMGk2x6;r)~MebQ*`bZ#&*+IbL#xkDJr_VlR(6-+uRzdooxL
ztRG`<&l3V%8-IT8S$Ia;Z26-lJP%}ieqNh5J$GWf790!k=yx^mj66K8FW=g~o-uM2
zT*e&3Wz$58Gh4PcLsQw=ZnrYM&jV-_gzDVSXpQP-w52(U2p8Uff!gv_ik+axU5@d
z+aIs6?b%ts9*nk?7jAgxkIQU*zr^N|16%n}F5wQ=|NgZ8Y@GYNdvf-SoS%}uJb3pC
z&OW2B2P0>(!Wa1NWWd)-eM;tgvH;JnBg;CuVvLRAC+Du8>h34k&zaT(KJwoFCp*Y<
z$B}m;u%1l*!9#l|xqrGs?ppSdC#P#i<@9GzY;i8DTaA04i+>i`@|*wp-CTW2F1!Bc
zS@iRLzrCc_y5X(F(AwH@alja=Kp+$`Q{`a
z`$KJbLFF_j%H29~8oBe+$bFPa*x6)$(=d#$Y2V%>%3wI&&
zc-HlN*te6+waoL0b?ke3z`l#3XME?tT^!lQH*=p~ob{tmpO!WCIUC10`8@YGoqK1t
zRYs;x=ahJeg_=y~R6ftoMPrBWXdfbI@mpV4*Xco&c(a*1E)uFm(LY{X-(Q@{TDt63oLV3dvHs{Fe$
zbL5H_f01`MFw(bTpo)Xm0_AB-CUyI!F+>%#YI^O&dBc+^=
zrp*tP^?{S`aG-aT#it$bImNf*uEb9^`rgOFOKuGg9|xylKnyHh#ipmq+l~pI^O(XZ+_+9);lSE=J}b<
zt|8;eL1V}NBZo1Mak2if0WJ>-7d`~zPYl+Bivp!O@aH3Sec@cq*RadD84x1Gy2$CHaiFGAm4oRiVXJRaanj+
zr?2js`oaCbHqDW1jj{R#$6ro-;xIDV(9sRJGzS8lz
z?dHcbI-eiUWqm`}712eHc#F|fg9E{Z!TcPFr`#9M6Vtpsj|s^7;E6Ym#-9+Z2iChM
z>|v)|Y5sm(+O@5mn>%z}9ND)Ta7)a|MsH`M7@`WSNg6a?58&Q;X}(0lyrWxYQ@+*Ml*~@fvgd$?5ZpQvZ{G
zB=~=syBBE9ud_Vt)|{~hd)GfN_&dR`1e&_*J2B>u
zpE&j&9*lCiBdce_{>b&J%*B(f{FRiKzkjfCAmD@Z8lHSV6utdisJ{Bu_38HyxuS<{
zF{!S@(KX&1`_(nBzizRPZ`X1D?QkZ))9)YnABoNJts8B2{bc0m9phuIwYMxj_0b+5
z>5ZukUzg?S?(E@nG(z%2R_|=%I?MR^f%|TKcR)rg`G4~;cZTg*K(1$;AI~_~`Si@n
zVy|!N$;=N2Y-@aC`^=($WBR>;I9cP*u{hEk)sM!q>-1XFx`tQ&d6JFK@7A1}?S8p*
zZ{*VW?uqxu|3I>@WLXN%w(Zcfj9~gIu#O*SN4r2QDYFA%CG*z@?+rc_d~cx9BTu-{cE9_l0e#+9QBhsKW`t#@`APj`KH;H=M8H9&`$zI?$~tjc@jdv(^!
zho182yVx4uE>5HUyP{*Xf6K?oKEH9PU$;gtyKL1TvDLa>U&KCtUGC+dhql`HeyAI*
zc233)8@(U%jBBUsqn&=QS3?>-bjrnT6VATlHP2+mdm<;B^}G3d*K%jAyiP?|{-^4NfxGcec_W+`NBi_FtMh&@yFEf|l4)N%v#dQo=o=t5Z2626LvQlv%S$sS
z-36|8sU?lqm9dfPCp0Fg5800?x=I_2u}Fi8D;!&cI4p<9KSH_*j>}@on9cIa$Bg@I}Fs
zfmT`iZVhmG&4Nqgg3Eybm%cU5k^LKy?H!|oEIV4)`%bA1tv277F}-T^Y(TgC@Q=(`
zODmbve@npb>DX2C{M9!mW8CPq*IGN7F>c~HT|b;PI?9EOyP{kS_%ZdZ>vTFR-dg>@
zpN{zsb>PJ|y=q9ljM??MCQiG9Y5ebw{>FLAvFr4?+jvfM;7s%W+UOeZ!!++lBYP|m
zKj5R7$#0HsaP>Bo>opmVXWT<_>PVj1wl7X+7Pede)@A`&ZR`5}gv;-~cj7aGw+8PC
zE(Jdk{6g?=f@>0Be~+!dQ}bM)HBV<_zwyG0eL2y(E{^#t>o?xd#_?>{`k7~qk7B(N
z(9`ct=b~TDk=6Ho9sNY9`S(sY|9(zvOsDxje+Aw+)5QmTMqRDh#^AygboDdDdpoTq
zethx{&-=CM>G{SEPqD)Z-1>`?$1LPb|)s+wshCd)&s7DP)cY#{%!VH!R{CcdB`^
zN6%+v!yDaqnoqMp4xDX`y9>Zi-^JDf`{LZaugut+M@N5cQvF!&5H!zcIkySZu^jtYGw~zxHrV)_s?}Hv;urOl}F(=rS9d-`h5Szi@A4
zA=zKYGR*y*X>MV7t1IqsFgsi<-+h-ptA7uT$(<$Ud0<^Mh{-wAKSI
zbm8*Af=fTkacNAapXCoO{P#Ia2ibCx6YJi6d6W;WHs6@BJi1TfLHD^p&5vw5)*55UapSl?LPG*iHJ>|pBTVh~*gGT?l-m_{`
zt1o<@Dpz^oorb(W@7~y@4~e_14%@M`P})x9j*?)4JB!h(UAApYGSk?$zGs
z#9s5<_*Zw=>CQj-arryTcqe*4#a*35-9{ddr&n{k1NUF!KTh6K=QKRVwNba)p-(Ny
z34SjQd_nNl!KL5_f}aY0EBLeE`XtBSi~q@z
zl;(^WHhympkLJ5P#EHg5ANi9v+U~=DqsLyX*A%Z%M~DVT{Xmyx;L0dFP+zx%@N9cDz4#hrIji
zUN~ya<2!eFzMpB+^A~q`zMs+4^N(ENyqG&H2h$w3cKAZCdqZv|utxqRfx3BD?6h9=
z3rHYXKgQ?vMxm<-wMpo#@am1o(EpJjc3p
zp1r@hO?+|nUTOa-e^-ycm+g&#`?5cvpKZUlZp_Znpm%7DKU<%-Lt8($jV(W~?!?x+
zx3RTd4wuDs8aICN=RL8}H;eDL1f%a_aV+qrgIwpxM(wo@#_s^F#rH<2HQ1hhZ}TjW
zTW^@N&^LXoIo}PovhPiDj;|vRdfB-l;NRyjc<{G(!#*Ep0eMY6VC3;Li+aR!tNq4x
z%Cq$=R>r#ne496M6!$6rtFwmR^#T50u;A}A7=OKewL1&&_a@M_5{$lo;gYlUZ>j@7
zpSS(Yb!XNBzIVN6eHXB&9_-24PbXIR$yw#tI2edE{kTu#wD~=F^Y=T%hfXn(FR`Qh
zA4Io3`c{MLV{0mp+g7qu+ke#@@m-F-Xi1!Lg;^j+)A*_zF>LPalW*OA@e-Y5Tu0s2
zv9i$dqV#xu$#c-rT=J=Q#QrA|dt7~&n8r^H%aMG&AizWH%R^1#@udqMWX8APlQN$L
z;-k)-h0(s;v%k}~fW0q^z1~-Gx+xHAt?Q!=KHA6OjlsUfm|yfg7JYnyo}20&_r+4|
z`hLg<-S-Ce)))OUF3#{*tj2izdGhh_aEJN^;E6Y#a?!n!ho(6dJN9v7pPjGBr1t<{agrOY>tlXf1M2II
zf&3cNhwCyv^4%I+kIaz(|7l)FZp&ih49;J%*AW
zTXRM`7swlqd?s6tIP4C5*EXt7F%-O>9s%(
z?epaa;>-Ack`w;}0X}SKtjb~#Ph=F!C=w54CuJ*(MocTz$+{IX{Y*cU96eGHi
z2kie3i4Q&Qfju!8eIkRe7+Ei0`NR1GQ7nH@&iFWovvV-z+P6fV?uxWCIQkB^8k`8c
zMNei?P4G=z#Gt;~|C(*~vwbV2c+7~nD?2SCxfX@h?478s8<}J?B`z@0_eCVmI^1*L^;9h(%z{8x5
zOA{SiaTAXl7iYe8a%LxXoi7h|zipzUcJ2MATkMT>@XpB10yX`v;JpF=-W_QCle2GM
z=(5+pb01%|(YK=OhqC7G)K2dW?k@;%`;O>ibJXXYyJY`A+h%_|z2CXbIeNcqoBi$d
ze)l%#=>5;P+22m@_iS^H-tXOJe>=V3x6L_vpW0@BJH6k(%{h91V4MBz^nQ4obM*e;
zHv3b(o8O~0{|vwHJiZs54ZI5v1n&sc#X-
zJIZh6^WS|AvLAU4vOlto>@=@@<>!wsIU_E+1F@N&6ZfhAeX~B24d=W);-uF8Ui5GE
zHcfTQUwQrg=fLX~Id@$Q&(qWKh5(QC;7H(I^&QT4HtS~tcFaecKNg$n#OK_Y$64mB
zUG*piF9`Vex&3kG&K0
z{bUw>2N?Z2kU78jdpywoyKs_Ub2fe`bH3iZn5TQ*JO9nI|Bau&9T|F?fAZD$`Pq~I
zo~QFelk*QmMlNdef6A|ek2-#7GXIgu{L*CpWs~_sllj@n{Mcmv!pz4Q{NCc<8!Eq_
z$y}^E|BlSXTtgE>vvn~gf`=ZR{p!3&d&Tr@HzjLq5di99c@8mZ*T9-Zh%UQz_
z4>qbtF3H-{+t-uPSI!vxT7-V@qTjdZ-4E-&!|VMFqMt4L{fk}=S@+iI)w&)}{mTNm
zza_XK`0nKXV}Fo1{LfE6{f7VL>8Jlu@Y?(bbT{S?CA~iQ{NVk;)4`eiLyJ!ZzZmSw
zA2gZ=|04KU@ZtQ!mb*Xp^wVz%-uZt%{qzTe&-&x1pZ=QQcY<&Elc%5l-r(B&LzBmY
zPY>Q1{CMys`39;{iySr1uNwAFEOOP{y)<+6tu=plZ%#Kp(>^U@y8l6n>fZG0U%k00C#!+n
zdMEUoKM!sG8vtr>3UxGH>%5aa#$r&F?gu|1Oq1$eDI7
z7|&K-EUeQ}pSF^n>Xu(^nSA4fpEk;@X8uUa#`InvTobg$+h3bC`rz(Bn{WL8<{MBsy}TR3
zBAaqGz7>2T@2(k>p?5tPZN4^hJlLVzU884L;Jg^j1Fg2{FeWqgzwbzWBFCOsd_{oA
zj|Q5x%F*+lfb8o6?M&daO>e#EdwMBr-XT4Bd)^v+?qY833x~1!-he)L3g&?}-}wK{
zUq8Di1#jFSetMB|1*4>vj?*7v!WbMWUS8FdMu!Scd#Ci!$T9B){neD5}XWH137X|EgTB?
zPloUOx)_kPXKwF&K(6m)^@)Z3@eFRGzSabLs{x%oZ{B@BFVLrTP29-b7vRiyO?;;|
zWUOTM!oOsER_s?e^AE)Q=)ad0cPiL+Rc2W~`%HbH_=7im`PMZgHF~;S6nfrdIuBSHD@${W&p0jn?
z=f?0YSp%_~1&4#KP5V#IUi0o1lE#0W
zagrOc7e9K%Y#yiyaVZ~M?UTi0jI~<(-RPzdA3FTp_GrKkU(^mB?k*qje}6z9y`zrv
zi*+1ohfU}kKo>jJ!_NQcK$=gT>CcqPQ4z`=?-ghC0^F>p9fmkou6AsYb-BiEF9u4zsBVF#$T~4
z=ia-gVt@^Pv8N_+bvJJa_lFrMPiYqil;=->0(~tAG3AgY(6pcZV$h=7H9Ay5|b-*_GHzRV8?u`nmM#_Qt?iob_Ab$Fj#aJn+S1
zde`Ng@8YgDv~xjY%)a{ItGbaJv9)f^d7LzS$8+p{RiH-B1{W7#N4{Ph;N?7>*5%}>
zIM09f*ulqH`Jw+pz!&2^0UtGE`s6@Pnrn5tRj&Q4u^xyE`^N+AfuW}5442xYTVqe|
zYENBsPrZm0yS;yBG9GQ*85?Svj97V7*)gUUuOk6&bTv+V6fg0|m+Zdi!q3^42I6Z@
zw&%$EEW(4G#z(B(XYyi9hxoE@?_l7*X#A3s+Si+_17m0CaYo$ggEj43K>m?{U!(u#
z^su=S&{zJI^QQK*hfeX4|D(aNVAlftaYnqwVqYLmy?^wORZCX~;(^!Mpmtj`2NwJ6
zy)Nh-7eDsttt>9&8b>wG7e37cjU73W59dZMbgc!rT@1!^AL)aYU_HRa_~BvP_*lnHjDfwifS=wBdaD0S#?RP!;YN*I
zm$j|XJ2&n}{BoS}k~5!w@{bD+V*Pj^5B9A;8EE1s&d#c{WoKJ=xR3kZrV{~ubgwPO
zXVUYFU3F{De`CHk)){WdSaTj%T#V%!H#*qC+q+7axxJCg_+FB|J@}~v?2h!f%meMg
zp!QcX#;LL4zjHsGbJo3UhXUv2w0`kL4!i@^b$GGAmVQ0B7|1t2_6N?WeR_Llp0Pbm
zowKk0?g_-wkY3TXSCQ#1wB_#KqVect`N%U)RauftPi;
z*cWJI@Z-Z+%Z;D<(D-63PrbAFESs-p{l=i&*kE_l_gx#~mBrd9$3}I=-Hp~av~Nc9
z)R^<7pS$+%4(N7HJ>j>yh#ek2pFR+1;X`bxJ37majcXS+&Sy-o
zJn^}8VU12}PXu`H4K!nQ7ZsOlkn9-qmu8MjYg8>(_koPp0zBL&jjwExS6h`;)41&q
z_++2lGJW+=zY@^@>sM{&sQRl{?CT%>V=d8N`PTnivbG&?p6+MqvYx3v@`W6Cyj{;P
zG3VEvfmXe8a%5xWnOs_PzcfDb%UWwgPnY*4VY;kK9^F5&?pu)I<@}Cuc8-qf+`X9d
zsdD4~%3@#rjQjMA{@t5}@ojC5_MWq+?pq5!AILNw%^UxZ2aT(F$ND{s`6%Q4{fF7S
zBR&1|KzneryKH0RFNS<$zjuE8PNt6Stp()7ws%Z?_Ab_Ua$c8m(`EM%K{AtXM5N9ipv`U@2A?r=RzQl;-KdErPr)^oA5Xnh^ZP@
zkMy4o_^gc_T8F(STh$p`IFsucYu*)T?ThpK0<~7#xZ|R?-}ANko~+S@ryAe~edLW>
z!*aw2JnV}Leb(5+ogMotfwz**JA$7{V7&jnAM6hr183B-_Q>MTYqCkN`^3hwyxfv?
zHt`Vi)u3`2Zt$>1&%uBmTyP*~-FJ3eFdkIvZO$#IKj{)LHF8xT{&bsH*MW@1lmB>VM*_8b
zG&mMG3uL^z@<%t{$u?%z#Zo&PkUtafOH57%`vdFqKy#k1+k<};LA*``8b4Qpk%u^p
z@tx`_7j|z7=&&Zf;-nUQCR|*A%q+k`EZxPvr{aMh-^)SFLA|dA;>72U8`muTg*)Uv
zZuK(~`|PlXr`Y0%tC-<5-a$6yvs{m7OozX>i68%0Fb}kz<&Vb33xfNDQvrMY81LuJ
znX_yCY|vb`HtVOed>?B<&Ed))^74;^xK$_L`Y!gaw>HVj16g{V6FYT5*5@+aYMsvy
z1bo7!^+OKl*6Y8_cp6i@)CnKo6!^7C@dkS%y57Cc$*?P)X`V5-k&i&_}>#Lf9JUh05eI<0q%dvzYncov8kU)&SA
z#2;sMdrzQ^HIFl&>A{um{Q(^}1;>M{f`6U=USleQ4-WEZ??iAQaNgT*-9G=T=NAV(
zzCW!6)3eUif9LrD>VRH$_b%yAW^ERT={(>A|IPbZVeDS8aWP=qyM;F{tyi4IOKy$?
z)PUf%Ep-01IpwkN*g-+OFLtl5)CZM0_(+|Sj3e|*vRUR=m{
z1V6_4vT;N<^pM3zOrDBE^@;v-!3P3OE;Rej+-;JExA@loYcjqr5DPUXKKz#pd7b*t
zXLsvF;Ov8eCI-z5E^1Uf=_@z9&jxxB^N|<1sqW@cOu;#^9rMUnc^Pdshbvj1`Y`6u
zSQ~R_4W@Y$$F0DZWqXZ@c*=!Vz4(q0uLFS?lf~VAYVDc3Q)0f1-{V;yfzO90YtwnQ
zFV~f~MSL}9$IncAY_11tNbc3p%LDO;>jLL{Uo+gONx5=<uD>WI$9_ejQka)upybQ`-H;z9RXP)_2+FLLFytS>jY
zopPanTBBpEvb|BC?RRD1bIE-nr-tfphR=%mm^1f&nSA3-PyK4F&FhabKlSxz8tX%g
z{q^+X$>!1ESm6HN5a3RS#_!dj{N=^`zQ7%54L0_AI^|vd4g_KF@c-$KIfKT5NFDyeWS@;4i+o
z@~g2GL%xf}JkYGEVR3b5t`FF5Ez2dH>n}3viVGu@{TZPi8y|oa-I3KdsxBXN`R^
zXIIY;zCV?TIbXzv9`7Pf_D=-zk8AH_b4gCDv`azn5Z}r79griO+p~weS~wnvh0c`Pew=#qg1U%~^my-+X`Zt{e);mH&~9ani)Z
zo|w7=>RTMh;B+)N7F-pGvE0fB?#}R!+#e18t!2JHp!e*ezbn0l19^FeTr_Wn{5lKd#Hl^*t?~7Y)yh239t@VPHLv0en{VPXzxPdtb4LQclerM^
z6L-1B2}gd6?;gHt-WmJ&@y{B4bl4LUI`ni_PE4o#n$ybb`;NaV;}L9*^JU|RY}kE4
zdUtJK;BD$#^;8JqBxn7c;g`7cL+s_EZ!Ed4@x%OqfWQ0^qZ0uebf`)C=(s)@*H$vu
zE(Og2n;nZ^<3kqsysXa2${(I;Yc)`p<6JEHy6il=%@vMk0)5dOye@11dkpCTpN_Zc
z>1`d2cgecDbbEk1oA}ih-Q)Lh@w2ua#(VYh$d2>g?`2%X78m(6#^pZ>*qYWoAH;h-
zkauxr#~K|tYoi|@j)U9rp6;oo)|njM6yT}^mhxU}y3{+-C$Soh-e_V_JMY?GS@8eM!I^|HMdK=(?Zj($5v#`$+;ZjW8DWLIw3m0xQQ1&;=A2<(wpzrMHJk$yF>C+^y^
zy&JObdy#m{iClTV^zKmmlNrwfGIG}Mo%=E-qbGA9Ame)zf7B2EesJR7*JqypZTK_I
zb>9K8Tn)C0U)P%>cK+7F4&CPdtpnr6O%CzhGxWD*T;4ZkJnDPv;{4gHJ4=s#n)h;P
z{ySgR(=Uej`S%#c`6p#=k3DDE6Ce3zSDqX1_NTI@Cio!UVqc%PiY?u^@^=}>u8py{
zZNZgp-2abY+~1Rp+U*-OjWw>j16=j&YmMhkQSjTD>tSWlk-OQtMH7
zIi|HqcWcggSq`Uh8vXvGoEhgInaqDZ^V;1mF7Dk{arw>ceS4sXe>{x4rpLc?oYjIF
z>V0Lyd*E)zAPoef&wYUT~W$v`bWmpHKxjhDEz)<2x_IDgw@{^UXy7jb%HAh%;|
z>0Sx=M8;gs`OzNl#^r
za?JB;*0t*H`S$d5yjAb~GTrJ%48&I4=YjTMFvg}oN6fPB-pHT#*XQU{Nt(RLA$`pq
zoz~nRwX0dfkxyz`9=EdJ81(y=bL^d1oO3rH3+UM$lrL`DrOobHKWE@K{n>&}IyAh*
zbGr6;)~0;7wHk0{YdcJv=T3;;Y{6i`}xbcx-icT4QAAfhMk31-M#o
ze_O`oEe?2J9O8h>p@5&wIX&96M#N^i#)smGjB#`q=`a>Yt$Vm>;$ZLIz%pmA7=vk_;Y8VS);FK
z$h*7lqr9sPzI}8t9(6dUb*(w)t9whwfxsM3`skX)3dVGob5U5uCUsPFHO%ovL=S)3`Sk$ca)cXH;Di5)euKOj%f
zvK)xj$aU{Re&i~ynl(D)e<$>NK(9t&QfPzD(z0s5Q1HGsab~jr@AH@t)4zS$j_e
zeN)Vziw)uV?Ijs()jjJM%#6-E7XMcT((XpHBAm4+nIbSHE%J
zC}VN1KAcwr{dA3uGl4wo<=K0;Kd^T$kpI>b8E^UVK>O!;FMV%0AE;S=vh7Uo51sVM
zg?0HF<>h9XeD$qopAL5CfhKk%R6o1FAIOdKc#7qo
zfPS|6_ErCMpWkw9-FO~o>XF`a0iNxR!9Dgbc8Rq--4c9ppgj?=O`qnTw3cxG=|IkK
z66cW<*>4YUBKwg*tIqG=oNnmJl2KA=`_h^&k+XAjt_1aMD(^j=
z1@%#!@$URH7xVhT|Ix3{$lO}_Ph-(|j5T;{p~Ja*19e^w<%iT!b|MztpbdFZ`RZ}RIr{qi-fM|Si8j-h%QGSB;MH
z`TC8OO+Fu5jL$Ci@p2!``C#6fpo5)rfjvFj;#CelpJoBx8a>rlKlSQ#^F`WxBk^Qw
zx+h-UD-ZAPN}wjD_FtT}S-}2SPk4{>!;`sq*3Ogz|HiZ4^~#o$Gh1=O5ue$jA9c|)
z&e>WIrr*=Z(4n@(NqzeJ-sNF6V1L>ALs@@YjHo@jag@iC!J$Abm)XnmU#K_sm&qQ@
zdTXCQxZD=p8nl+x#m#|zJnm0@(}zDkxVTT%MNYFvAO5cjG~>UqG1{!J`rbO5)~)?z
zb<2LgPt7v^tHzgo`8gY~sqgobf8Vheuf|@?^H;P#t%e$NzWv>-rMvvy-FWjJZvI`|
zIIC?%juSO;~|
zSo3u~s2)7rLEKgYc^c>Zbl%$OV1J;-Mm_3>9sZKr8_?zc-yeKmj69s)9=`Vka!%f7
zzrJzOi@X2s;^CabM-Q(V#$D5&SnL~XJwMBM1YP5N+4$PX;O+Ah7o5epep{Q$kfqzb
zUJLFG?hlu(v*f)yC^UCh!H+?;@g}q^No-7
zN$;~{^zEN!KI;Cn%yCy2{Vb{7Pt1m~`c_M$%u43CT^$+Yb3xxHbzzPR``+~N&nwaM
zvOp87e%^Uk<;wQ~?+iTPw_@TfKgAbMWBxfuMy%I@sVsi>eO|IT-N)IlReO)^
z^Yz_?}+@c9c_Z&~%-nK6Ck
zbmNk}_h*egG2-X-0h^;9?+!iIZ&>tnoeabeS2o7;qg?rnddBk)EOdBF#a&F)$72C*
z#&oj}_Vs%MzL&#F#@eMo{KXG9u`#E^{Br{HU5nniQQo=klYeud_0GON<5PitJGj5y
z=kG1SnE-cpM&J59k?~r9XsZs~G%TDPO@vbr7jm({Jh)ao0aZ0UCjoa;~fk?;5(
z;xqM89LV1mh=JJeUVy)9$=y*WM*^QQ>@*(EkM*L4j~%&pUf=!y
zBxCz}XZ6+X4P6VKA8fTJ&UA~1I-!gFbd9gxcXB?<$+@?3C>G-4d#xaYQz9
zK@Z*Rs$04BX7CqJ7}wcf8P@u__#cW7J5xR*ce&jY;HepxuQk4rF~H7md`86DJbXVS4=lU7Qe{=Hm%mRA)w(y6H
z8o`-zS)>-ydF;o;;3x;F~v>?{wg$&sEr{
z$F=n3DgNboQ^q4lzS*yxS7*!)-J{MIXD;TWO}4Bb3h?0TrQm3AY%#aSe|*JBFE;$J
zhs%`z;jF2Jt@hn9ejE?j_3yY}Ob__n<|QM-C}#X`;+
zi;>Hf{B?#M{Z4UpWXoY$KI|{c#dvNRFFxK7oC)}+zVzZd_4gH7lV9&C-cy<8g08Vv
zdVgP<_0@n4H99>%@~a(j9dm6ymGgGETlWVy#bNSLJ{L1CyoId^IryerIDY-J;7^0M
z?Rwtx{w%N#M^`rcr_#SD^K_Tb%L5(7S7hJV=TFzBJ+5?!;iC!6`eOXCh3@m2<9Igc
z{dZsJbdI0K5#MOW;ydd7y=>a2i;i=F+Mu(wqaWjdXZ`t_jHkS(bN0NA{J1j&jM;0<
z*)*0fc8%53nMIG+L&2kg&rk26JopafeI#d{-mylX%v=m!A4K$WE!>f@+H&TeKx>_h
zd#}y9^WuTizTi~g&m^s-PwF?~uxt;P>J$(5h+R`1sbTIaa02ja&+oSflz
z&sMKk?hnKqKWF-e>UVO+SvH+bx;AvNWBx1IShipJUs!qe{)KGVV|RL=S|@7hB|+y~
z^`qS%8uY3azR3gJ7OVy2#cK4U^Y2>l?EEDQeP<)zyQFX3|6Il+a2)5$#$rcb-&#DK
zldI{k34M3g#@hWr=31VpjrD!$#Zb+(v3f
zeEW>S?!L^|f@Sw$SJv_A{qFq3SyLzcn(qBtgsk;Wd_l$|)b==EHg?{fa2G}!Y~thB
z4vpnc9vg!_i#dO94aCQJxznx-wvsuWJ@p|TbUJruupX#+@fUk{QXbVo-|BI#zm{lE
ztQjFBYp*$EcjSxLl;^1gto+KC+)rg)Zq$yuf}_5*D5fLS
z58LC~bWA_{^uH*98tq*dd-m87o5q~XsldCu7Su<6?G4mU&y?HSvo-}T)3tG)?aTM1
z`qb^KY@~H0G$zyeD6<}UvDy_p9EgRxikIAUzd3De<)O09ci$Ov
zHpkd^pPf;@b9vYJ?*55|8gqyJy2IV+_Xnd*XYm{D;6BbjDMC2)yD=ASy);r9&zn@~}
zjO+JG#^QJ>5L4V5+xFr^W}JUX7Ubh>z$V>d^oBqT#Ok@^yEW0gvqcBn|01@`aWntt
zfjzdxT3pRXe(r|a#)}O7jo+z^`}0!Iw5R{h;N!{v`zQRLihd18KBy@?)tX;p5Cb`s
zyK-I4Se$_$e9}9kR&HL*`?IGtZ|^MV=d4`wFLa(2PygMhT%HT)#|bx_^naN=_700{
z-x&XWuz7hrwAf=;4A|up-y08iZ!HiPKH1}QeINVPtXBu#_NF~ul`+08aE|POfL(Un
z&siYOz1zn!wtgZIQ}y0^ji0;dp3-qK=pNbifL`yxJkTBtRsz0PFAnbOF?URjPX^Ab#mlC7#KIF7cw3pZ{vK~*!eR79%3m*%kJQjth3LT);ND|
z4e)nHyu@u^K&LhG@~rRK#=*JnjqkbrJA$=CQkN$69`Q=EZ?w+_h;Rk;~`3btB|xoG%-T*GIRA
zSGF$yx?*GdkGGH&k7aRcE%>ZaZ$4A#@00gjy(v1zyzk0fysXK;&#@x`
z+fYvU@$0dGeZ0u?)0@Jk{d)p!S^UXg3XTTH0=5A^IyF9s+jQ;mtdY4Uz?Xh<^FVtr
zpvxL~2mUO-?nGa8?aTOZAphlnlg3Z}Hvj6AkIU+GtF?$<)`RQx4WWM}xGT`cnmC=g
zyyM0{IUrk}?&ggc@l`)+
zhdtvj57_0ebKWMhn(;KI)A{uqlF#U*OU-EPs0}@x`va}DzZ3n(HjiA6$HC0SL%&l{
zF~%4t9C4L@4M*{Dx5{%T{M>={pm!X%##2ny61JiG1}+iLO!fp#IF!~XdI
z?{fhga@RM^+#Vfl;eUUy8r%@@oozm{O^yvZjOB)mF`jF|D95HfT<9hb`1ZWs8E5;Z
znX5CpUmWnG?-?%Y4F@u<5jxfDO#%PCyL8S2jh?wdnm34!OM$zgR(1u}@Yx%P0sZW-
zj|-jK?UNTlV6GM9Wd@&Fk=kU|p>pB^0
z&U;@^1mtkLHJAl*N2Y#O9#7}g#H#~#`B$BM={bDWjF?+@2(FYnSfZg6gNIc*$bi*g9)ZeIF0#c||z&vxYxn(b^k1iW52C9ZxUh)JSEfd)azc
zO_9|q$9H+wPuJwkdh2|5#_Pe6z?d#R!4rXdDc;uK5RlWl$6w9fYEWJBpq&Z$PG7mG
zze9l-(Mx8uCzjUPRx{&!Y;PslO5g3-`>#^iccka*JkZ=lZP^{cL+#xdsQoPK0W6HoYkn$m0dyinm2J-4SN2bj5W3z2fXVOf7gTRdw3z&
z^X?ZJw$+aqkXN4<1Mkz_0WLd@!AfMEeLUbJpRCE@@j&~T;a++Z`Aol7yEyRWx!PB&
z`0{xz5W|rVF82A1pIpkxwE=&(i`~d=9$9Utap@hxr}-4`)j%zt3Gfk*#v7-~s&%qz
zMUA%Join!2UuS!UO=sxcA82IdV(RCStf>X9=iR5CcSfA_I8?^>(L=%2!MI<3dV7Zh
z`p7u11}_A7n;Ww)?{Xs-=K?jrU$HtJ(4{q=;=e3T^wYIntg^i!!w#P8H%`t@eZ>E0
za4fhg(8$dV(!@~wM;UVbn+IBDjM=q^Bfhog^GMt;2J+-?@{z8sWaw4f+LiQ;9OU!(
z#;N>$hr_+}`Fbd*&XFt5;O>YQ?rd69kAD?kyc_t*v-gS4;{o4)XB&R(^5y=(9g@q&
z%IBwex@Xo_lceXT$6c)Xad)73$H|-sDQCr8<3}C%sYMc^J2zwRh{xP
zuHmoYPe!vwrm?Wb4*qaFpyx-1JmWt8SuID(#6;rb9Gl8=IT*fc2@1)9{iIef3#(cBfI#k&wjrb
z6S)#6zBg85{kTi^tH&GbT~Uv?Id4sT#8w_=i7g+@wLi|^Q=wWV&oje0)l-3>i1a>|Fl
z7Tl6QkLEnv-k@=;4(<;=C1B4TvQL-Znwrt8Z)z8K>~zdY&7i46T
zFXsF=-WAA;yRDX11M<+=kjF)y)&e%|p9^qim(0gYk6M%uI@x5K9lksqG!J-?vyVGY
zj|F1m?0Ue*m4NJ}K<>!V=gi@t+|`I$a37kt*JjKv-^8{tYR!ys5<^@XCui^*V?`JL
z)Q$aXgX+@Lp~vZXfctMO`HXH1c4hx!;0)gP1R7tx75p51kt;g?vU@l;PJA16Zxts#
zUMWtMX-zdw?lPNv<74AB#)&K*^6uR>Ult#HcN(9gkv$fu8|`es2l>^rrIzellLPB|
zF`oxoe=f)C?qJtq&AEA?;iazTf%agq9yoI_;A{Day*g~%y|t@>w?=HH>*9yc@qlgr
zE)TtU&I8SR|41+ow7&oJ@yX{VyP9$DRzKSw&YF6rpKj+L3#Rwb9$#>#_f5f7Ii()=
z2R|5SLUd_?{2Qh>gB6`0B)ENeUz20hk#Nt%o?~*y3UMulB6y^A?Jwe3#r3-mbX8!P?p@N4|^_=}e_;x&y4-C&O&M;09G|Clea
zBJ`xtulUznbrGbgOB-`0zta@GX}=kMY`fUY+ro
z?Z#O@`i26QZofpvC%ZDD6wtgl|k
z{6b{Z?#P8djnfw{xZr?`JzTuO{26uc&s?+SouRWa#*>c1IvG8`^ge@51@6F=>TutJ
zSMQHn$E$a+G5ApY!xI-W=K}SQ5Bs>%VQ<+RC6{WXb@rN!#ml>QXP_D15yaHx&z%f6
za>Ujv13A-HgWBdbJ%cb_Z#caDx_F{=zccPwP;
zBO3<-J~k)EGS=kOJ;q^K-00(vn2(>yK40;0c3Ow*)CaY1F8^%E&*K4K_)7PDO&RXw=w`RJxOvm++lh^V6%XCBkp2?niIu`I}`ZlOtd;9?$#aL|R
zf!}8q{hQMJyXM}Rp3nLbcTDEv9{<%YeHR1oFa7L|bNj7hcUHZPHRb;Eqj_mBhU6P7
z{Bh)O{pdR@X8rY!UD-bpu&bR9a5@*@fipc~V7)Q7r>5Ce2j&k2Z;PWit7+{60pHzO
zayUK`^mDTQH12%GcO}5fx;1uioc1TPb|4_bhS>NFn+KZr|7dV5AOqfk+BbKGEiq$P
z{`t&5I>$K8lR+Z<&tPN9)U*_=KnEdZKLmeo8EbL#RDIPc_~d^+!5$*K9zCimm~qnT@s
z^-pA8u-Wl;z4Kz&7`vDCQyq&rzCO#R{cTyB1?8EPZt(o}2`@jxj=*i4FB?Z>BggXE
z9LqUAiw?wy!-?!SN28uK?~J_Y}#YvbJc`k-&j
zox4)ZPc39->8Ejj<%HYIGG7LEmaSV8H}Pt{ikCN6?|qo|Q$Aw0cf#X^nO_MwjWU`3
zm12bdESSdVf6JQI{QZ8$I{|)`yD{T^f!y^zv!|~125W&h{AM5&>bCbw&3bFZ&3!2k
z`gaQNFIjcjJNJ`|FzNPS&(H1%5{I
zdGcJqAMISA4#v9J>az`J-)Rm7?&fO1cX{K(wD-A3uRZpb_3m+HjxA)y{&!gR9^C9Uem}1@r0-|kcIU|L4&+9Tv`fLL$A0DT
zJQC1}!uu&jU@&=yG<%t(nVH_3g{}aNw+VA#jebd{8TDZ+frH?eWVU=c}6A6O5k+
z^vJmwk!44Zw_XnQY|a9@nge^yf$yYa{10T__&YD=?9ks{K28U8)9d?)cvimON%hO*
zZpwP|$TrLa4WGF|npop9&82!{ix2GT&j$3UD|WZrCogwo#9EB4$p;;DS*OeVVz8_(
z#Bm;IxXO>aDOS*T+#O&`Eb*n^oNhHEuI%Y?pZ2G+mR~M=dX`?iwd&>v`LVw(^PXV`
z7kz7jj^hD7{ymS@EFFge9C~-eUnAq!aq#4We!3=x)_a%L$9ixiFs6&o@I>IAv1#4s
zu=r`+Qwy3s_o=%0;Y{;Wd45`_mydmmyixX60=COr9{4K`bc+$5^FWhR`J~Ia?yGm)
z)bWA9K2Fa?Hsa5!H?b=(pOve@7~`&O7h^p5-xzOxHg5hNxO3hht?@b<;l|Xv;jEaF
z6~nbavxdv4kNip?#=8PBzCH?!M;-F3bWH_?As&vCkwgS
z8tb4O|1dJ^ftr-}sn0LV8dzWt$5Yu>lgCNc&Rtse<@Hu>IiT3
zYCP7!YcoF-u!&F4{=eJ8w*MUEdMuhq;oYw}Y*H)Jg5^4U7YXMezU@5i#d
z9?!n@S1x&L=;Mohad>huuWw(K`IUTg9zVGpIX8y5jhvUo@N*+Wk9gqm_QhCCaXc5e
zgJP>b#Yc>d``Pf>88=?^X!iy3X?;ELX3PW4`$CSMi;MnrdcO08?veNY#kw^*HTlA8
zy4E+?9$k8|S(cx*toQuBj1LDs1Ds<=T#U~I^z0KcXvWUt
zY)$=>u|~(0+}&K=yTkb|z2{&5^f4T=iRFHreww(W6G$
zVqcxWeT%vHk8<oG%w~)!1p=Zps*6
zKG5sl$^RX}e;tz3`zMzdgJt*5`MUx>s{x#=pTFfb-WjpMS#6#S@U5J>#%=UT?T$XN
zIqtJ-zxw$6fH%jcv$oVBg?TDRf|Vz%t_o2}h}HwLHj
z9_Rd%gJtK%`TpReA%$OZLymuIPZQ4iV^7#*E?7V)bz>yE`#vc0-Iqsx81qR@&~bC1CfreTIb9FvVP_s_4+ake-m&+rY@R=nG5O}w
z`GWzw{Hi^AjtA=MYloi^*kJogc9-en2jAv_HsARFP5<0;Zvn2My3sD>|6df~VEuG9
zjMZG@Dd(fit1~CleDi69n2z&h<5Az?g}!ArcV!PRF)s=_dxQOfweG2%agPmizOM$;x!5kdZ}|PI*j2xD;;eq>
zfyU;ZfNnZ31nxIJt;1ib$@;4;;7##V&&{s
z{mJaj0{6^WXT%$D-|Ae~$Ma&|_lQ38{=LMV|Arz+YwUj|^FoX|-mZ6EOdE5xP`}-4
z{^RE}a;yHf?9Bqa)P|D4*B#c%@B1?!f#Wz|Hg;a_<-55z$E&>U$>H>E$G5)V)*M>v
z-n1Wm8FL^O=I@OUeC+%SCO%%wd3^=so(Rtl=xR;=dY*
z|FXW^-8=WMZ$@jKPWh8pIu0!6{F?N^H)fkZH#(2Y(coC%zJmC$p{)jLb-MO=*2s*$<2(;EKbO+w>@=6;
zN3(T7@W9Q||=hm331DT8U*}!>nQ~%}ebU-(*-WIX1ynGkSjPis>2Z!P>%oyg4eSco#Seeu%G2vy-%avUi2HPHocAuf<8*7)YtE-D^(P~9
zAmF?D#JTqw@A6gW=5iw*?DT%&DOUVp&zqp%vrT_0d;K#mY|Gch!2OmFvBafo;wx|B
zE0)g815IsdY~rEEX{-LW?A1P9&Qzz~JvbilXV>uSQ~Wv<@T+eZ-kO@Y(w~LB{3D=2gL&fGu%47--hm8ugK13ET%Y
zBObr87>_y{->!+}H1E?`G!E*Ces<{pxd6wlc-SNN;|sakwz4}v$JP|
z-ZSxY?kj`oo|+sv;3ppR%P9`uycpBjcwWqyEZw86-l6iPzn}f=`24a)H(7kI6vJ6$
z)RNrv?aXkaZp3xER(scH&lxi8u#InPm|d})=4_TV{Hk|f#)pH(yt?H7+F++XuvML6
zus`6JJY6XU#}~5x9=B1)p{$D|Zg|MofyJCX^I0GcTjkjvxxEWH`D~tBYjRD7&&JKK
zdE+f+>w!8H=hl!lZ^As#yeUV6V*&k*i}z2iRs-=7lg0_3+T8Txh1-6%;RW<{tjEb6
z;ET9v)!W*=QhzdM#8~dUUn75f@o!y@f2O29^j`8${ip+b=Yr{dqVIg*?a}x1&0EW^
zwfh41TmCh7vvP96-*HVGtg)q*P6YhHgB)ITbxs%k{FO^@{5;U)a`ayf@xPq*WbEFF
zsdwe+kMYC6}kStH~YI5=W(ZVS>H2w9uJ&*>+oyCVtOcGw{<8UAP4*}SGf|S
z-%Wy6(q9PZ6`SUaFZTy(tM8k=#WB*9zCxcml*ZAiA
zVdnICbEfuiac@TXU(S4#cTS#H199eyFf4^-%jsF-WGbtyD1Lz<0oJD2GbmT?P6bC?SEZh
zEXQJk6aV?EA8UeLHt1gooPTICfA?aKK6OE#x2Ey4=FFpkclEWwviC!L!~!S1dTg)8
z8lPFleDr?cqeh$K>HD!Kdwj*|V!#(V`9mN7#II}fjQOe8wz^x+?+SW9@S#Hvs;fP_
zCxcl)4re_b>c!meuZ%Iqd7Sf0I~TA~ySTD5-p9_xY_v-sz3j2O9!&is!!NNt65!d`
zk`=$c%{Vu<>c-DkAbes7E^IL65vrk**F;-3>tSb
z<%rKX7aK9NuJ@h8uZ76_YVZu_UC(<<=4|OTXY7mXYXZ$$>!_bS?u9(*aq=$ruJrAj
zWv#g!IrR)1djdIC;~xw(JlBJ}Owukc!1g@Qtep;cC+3o&=8EfKwB;eQ4
z;MiiE?(+9Xe*0d%D?d-E576XJec`s2R{}3dGNxO=RNOpf;WUX
z{CLK1PJcMi)62KMaX8i=9N!g)!937#bypq^$cf24!FoW)JkZEp8&vjGrZ`8}qXut1C-%@($I1z|F*~fyh9>#lhBzyR4-oCAP+dmi3cQ)YLnE+=#
zA^qn}_SA!O
z^sCR+01xZd=(mQKcVI2&#T0)seZ&0yc2mgJbZwl=qZ;MU?wn_zP45Al`2N2EIrj0Q
zlZ^KWZydyq|2UCzN6CthUJbHi|6*Vb9tnJASU2~XL^mC?fZfKSu`!?e{%cvA0?+B%
zIM4R8c$Yu@;_+hy(rRn;kqo}_sba6XV_uYpoyoeMN90
zkPDyxw+H_;huEd#o?tx?PiMv2dHdqeALC`;Lz*M+u(*&_o{o8-@mn0fX3^uVv5jZr*tm(o
zs8<}xipM#oTWeg^}38U=6IT~Eau(cZa%HAQJ?e6_T{4AAJ~-J6T$TR
z!@;bHx%klK?u#3Lw(3u2Zx$@8BXRs-ps|IAwRxb)hk95K=wG&%<&EzxVvCnLB`Ytj
zr9Bz%59Es-`s~dEjU9eF({uBTHMOZ`9trHJDQCs#sZ7l2X4Cq`ptYe^*t3V5+NwM*
zU%R7>nk92zK$m>tS;ssOs~vFa
z{Hg<=d7vE$=+rK4b{lt`F7<#@YsY7%SZLOb`7I{K^gA;TG`iWcM_%m7ix)n8eqZ3c
zSUb;OF#u=y=nOvdK%>(gWQ$zypgG<8=GpjUFbl49|Jb-HxEL&ZKbL(MbEa|S(>&1l
zZcjTO@bz4v9?k^y0e8Na_m%qXe5p=#g$vNP-P_dt?eyY~XKSlG}F=I0H?+@6shX+5m>RZFdBjYZe{ddp2MPn}LriY(nZpORS
zJY0y3eBe~u#sytu@nnPl>}#_n_D^SB477IzV&x9;by?0^FJ~9B(>t+}b-cvqO8v>m
z%z`W3Z@S!XxiOvx;;BL+u`{Ikh0Ra*Urg
z-}wJ${9|8Sq4M&^_x8REoDbNZ2O3#t^>iOt%*CYsUB6g!Kh#b2_l;MZ&sF#T$KIU>
zYJS$`!6$P9P8!@WOcJqj&dem4C8IEqpe*4DGf5n9L2FnNMf60OloYIOu`IG^+_mb|
zw^eLyYOUI8TkBixu86gQyB6xcVC#lfty>Y7d9Tko_cgim<2lKQyzgJ{4Oi~%dw-Yf
z`@QeyIVY2Z%_9N-v|9q4<3|s8qW8L>wcUL@+tbUp8fqTpM6Sh2$4!CQG&VPa)`J+Y
z3h1bw+ASCEeC6rc7vO-r+~Z}Qs}Xzs4(1I1*{19H0q(5ha}{WG_*~WFR2@1e4m{C&
zM^HU#_C!D@zH0C9MDcd!eBj$E(AMea!=XS-7_&j3Q&m_x#cKWGVqo5*w91oB)t!&kL=0da6q3sfJ60$)1OJ;GpCnkE|)l*
zYofW+_psCX*N>WEhmX#%r|-P|6S7wS>74cc#w*v-m9mVE-`&h2J`%-!_GQi68_Gamqo@{-27!nZ7qNQBL?|a&)xy`
z#MY$&+jm9JL*ReL~WbPg+Du`J(L`q
z;^hz7zWHjvozeFWxz{%ZxX@NRf8FKDp5`5L27ku$yz5WQIvs}teBX5|ht@_F_98TpIkF@!xT8tu_C1-&%3rcQSK1+6>(P)}Fe=J-^A&iQi@Y
zxqH<~mfn8G;l=zwa8tlXZME~)-Ft5j2j>EL5xbb#mS5-DK0Ck`y_*4ju4$L1{oS?A@ZIeK?$!+AXNjo<40cVlFpzjd*HW%kMPL;m@}e}1$E{zb<4
zz%w2i+uT1r>zX+6Sw1SmFZ|)oyS^F7b-8wiZd}qa_j~E?_arrWWAJ?;V5y&;`oM;L
z^6FLGzrW^peXSj})_9zA2Mz_#3FzgoJd*1hDZd8;+^gg5z@FcSJURVVP+p&sv07k*
zPiz3+)ZzC`zR3-}^59;uT|bxomD!_n**j0aJ14)JfgFfO&Myt>E8qCaj(p*IU5w6)
zkzTT^K)W*#KOXRoFE%TOv)*HS;$7N)Qr1ocY|wW}a4t~K&DKD0gvKP
zUt*L0gMs`$CcwqK?>=|`12V>oyV821hdlo1Q+MR8^-k$e2I{`GOc$TDzerrpUrb!S
zxBPkH!qYOI#(FVv&G~wLbj^^jdA@GkeBrhH{MC$S&@<21jp;cZ@EK2izv(r02bMn@
ze00{HA3Q#gZ}%Q|#^mpdGWz5hC*GT_!2Vwf$}?GYr5?$$cU#aJ@ZOVEgY8ddjQ0;5
zJ$>ft@_4ZG{d4-grJCIg+`rb;9T^`9=J#l?J5HwdddHhz{_;z$-xRF75J;OeqyotR_mDQgNdY9OQeE~hahxilE@}APYS1k746FQ=1
zhmWJ_j|F_w_zq&jCGLT*w+3Qe1)9$vxow>Msy=7&-1^FJr~c?(uDv2_YEa#{3+0Co
z?9t;KKja(Ky?u46=Ggn;>Cg7mFYD^Re$fwV+#Wt}8ND$yc6SOcCid9|z4)ZZ`c|NB
zP6uL>^ValU`{cz*hckGv##eK?_(~Ta_4fuEPUOOQpW7cEh`Ian<~>mFSJ_<844v;4a*xFT5A
zYism$_VD2j&41>a&E*;&irvqr-G9f1dq!4&B*3@&kQch$#bbeHjqdq8&NhO+X?T8V
zpyp>CzL#j$a6mVITG!$?miLRfW90gNv-xpj&Uf>t2Fp0qp)-|vLdN_okIPuq{$8<)
znVlyF#t#;2d4G3f#TUPE#HP<*bH1A!YxUK=;FDgPeOq!sryRGqB
z|H>Mk+2Gd~j`3c$TVt;oah0ajf4bShh4*UqzdH3~
zwgPd_b`NB(&1*eJ);aOj7cpEBcoW$+R;y&Jk$1<;`C~37bGdy|FyAF-;7CAs=iUeP
z=(C0$xxmB4yo2objylV3-+p@VpkJ=Bk3a9Zo^5^{4D8)9=D4a1J?`mq0={c!182!N
zivvDrVwmNv?
z20in9-MD)2h!@;1e`dQXYdBO>V)VwVExk3p^Ljeg)k0;TnEiL=yTjr1>X~foxV^l5
zRG^ikzm@UDK+KinGk@^Leruw?_jzH~+@*U1?GpmI?EHBd&)+v6ojE=9>Kk*{<-$52
z_TqqSIoQk?2hOx6jAvAqzT?5A!EMvOH^w`0U2tWfl`lSk`v&v4Ys+3-kY4p4vYhoDKZkb!{LY8V=;d+oFcZ(a9(M$$+1=qrWMTA3EMIaE5R6
zUKX%-B-j{Zx~jW!wQo-Uk^{T}dmTSiAJLsS#9zPf&iExk{n;L4xlk9!0{%jC^1&HD
zBH$BlycNF7Yj`>sJSV_G^=)MAcQJdN!?SbMeI{d#4XT^_&&^oOdbo1*A3d#o+B7Dk
zzWB$7^8AX7`S{lZys3lPKY4n7z!sm?x0)|+joHs<{JtZ=;ll$pgqOZA-VVCdsr@-d
z_lj=ztm8~i?oiM@c4s?$QX8`!@imqVFZ@pUoJksvm$i)B#)2EQb~dQ*{E&NfTp#vL
z^J_EayVhJ)pLdo%HhktgZ{B^ph)L@j|H(WrkRSYL?of5GDHr(01OMb{sb6l$k~tb2
z3&;XranauR1;GomNv}L;?D8KcYQ~=Uw*zNZfo9+RSOuE7I*_Bo0e!ff{m68u9xHb|
z^Nrxwr=O|S0*-J|pXx)FcFwO1(&lx3&+(OC9Bu_-+Pzczc4||7vaLC5pUr0m+Pvob
zF%E7G@P5naaY?^k?r~s$6=-vu&VT0=r@S8u9u=r3{r&*ww+Hm$PaOQx#39Dz+AFh0
z#u=RH)pq6Rb=LY#0hy%z!uLQm=QEAHj~~4`pUuT&-ZSJLZ0?-Khm}E^T(R4FAOq@!
zZ)EY<_?GYM^Rg$#SH=nF*2&7x!GOPK0u2XrU7entSwG&b;rq@&lf#}--}JHjR|1XQ
z`)lcuJO93@XJoBlyW_q3h&(`#O5DhrJm_a`k7b^acj}Sv>T>4l6Ei;$0YAg~T^|4W
zAcmI&^c@PUKRwV|ANo~5|IGo})?qnNF9!oY$)9>4Kl`{pbKf`K9K$!J$ImLz@H)$0
zlEcoQ3T7VPk@*thnAg5zG0*e@FZAK3dgbh8fz~zLv1#v91I=2`u}2oaxY`$#2Q|MH
z;D@|-3Lm(kkKXNI$=}UcBZD`##NL{BroQ#_{y^5Q3Hb70m}P30zWO`cJ)Cti&A&HG
z?#XNfd}ga>n{z%tIv|4+Zn&tu;4|Y4#US@BaWp97vnWB@LnnWKH_%Q6^z>f2yIW%o7wSXKt+i&o
zf9%?u&(b~LZF_tIvJZAQvwfj98*gj$GqT6O6M=f0>+waI^UvF}mp^}PxxPXC
zS;tx9E{C1dfp0Y=cJ_?h&vuPlM~5>$6qH+b&ji|$fDY|kfE#P>&e7ml(36$Rf1ozh8Xe-4V}ADg16eUx6R$Jv&t~ki$3DAD
zzHiQ&CNAgdvmEmqe6BgKKKVjcZpreA44?RYDo}6yh5ClazO{14KWpvl=VsRErh{*6
zu-E&=4&RzTHnzsv?)Q*=J3p7+n6-^S>lv}1*jaht+TpCRb88@$#v~T{^s}14P5NGx&jGs`<1sdIHC
zj_OlO_~NVct+}OKf5zA!nR14E5HBC-Eq~9;7{_#Kr-S?X*!?p)?&=jm^Wq)$_G#r0
z-|Bpp5wkhn&ZsSI-I>a$`|7wWee|-9|
zpntFZ+KlPi4)}n}qrtI2+;BFS<8>a7^6tD^=^1>%ErBz&wUIII{0v5(J@;*Ya6|9|
zapK1G>U9-pcLsE+UwP)Iv6^7pm@aiMm+msV-lo%|H}3C`e6F#Fi;mli(YtdfXngeX
z+2@0r(a7~Kn;!|@6Y>AxL&VR1+CcT@$n1_Va!tW3j7;_T^wR
zYhvo>X5S6@l8^16Yxu=^dBl6i?Pvb^z!!VQ?Q8o`*4FXAKkFK~b^P1ohj{qVns3a`
zl%IZ@>{>uvCe05t3ab`BRCqkS2zTDs$DT156JzG>5Xg+
z%DwpHoj-b*&wbZ8_qHUT9yPHQ91O|>d$@p8L37mpY}V-948-5>Mj5V+!{^U`2(|-f
zt7q2TH$cpMX>ERF#u`~?TW@sWPn^blCL=c+0e$|Sl6;Dh6~
zb>KYR=6$PuKbe91dA@EOk$0&R{=gLhA2nmP+#hT1)bW7dcwYsYw~q{;$?$)F;7oZj
z7NdTS@lfW=JH#eg{)o4J(Xa6fpR>)*`NoH*1$+RtNS|^0bw0?`Gb1DK^;O+>+FHDJ=305UBjY0h4#?n6
zp4jVmB{sK%`gcjj=YsY}Gd>p3;l5m-4Sv(b4>%jNMh|7Y%%2=P>%HZp_?iR0h(W*9
zqsH+k4ms@m&-OA7I_YN1X9upf1Lv&aL`>`Et(ER?L{7s)&+!fFtNgHmSN84=G`=<7
zt&I63Zgpc_4E5C>eOF998|88{V>bG>;E1eqnsH;>moc9BYb?&c9_*F(kH{W9>WTlW
z0AH;G`Pv+7^;;b}LnprvO#O`+|4;-T%6DfqzKf^+)_3vp{TabtzWdI=kMepp;|Jr0
zES)C;Ic{FdQ#ow@m-CCMkJbr0^-rGVefF=lC4R9wXU)0V>HH(JHs^$Ya^-uG@u>hu
z{Y-HuwgNJAJ3H%be6`a#9yB@Sv)YzxbG^BBbM<15Z}WbCYfX3$?BlS09myC6cyg#*u=qJHFUA>9)0eDT6cH(w?7acf9GC|
z?$2hxws}9NGu-hL=k-sXAIiU;ckW!!UJaCAKH_F8;OBDvnyisI8XODgfXZdKQ%ikk
z&6k;;mG@@cFGl>Ul6=FxIK7Wz%M%SD;7L}eSYIg?a)IX
z&h%=AoW1>1zsguU8Q3px&f$ONjgIm|zji8E@=Hz*`14)?&hThXZ*`D68mOCn0Xg>S
zFP`~8|Mh`=cK>0%&*R~2pq{P`>Q8HWU2aZC?pcApz-7mJHfNbkclP-uRz0)^RvBM9
z)|}@nf5fdh!bQ)Z5&*CR^jp^=9P6JlCId
z^e^kHpHX}!)4RZL+~T-v{IFKL@`f{Ya&w^F8HiVnULD|Yuk-bHuFd0-XZt&*pHKOK
zXZ+1IPCuWjM-2Si9&7Y?Bk(AP*5w<{2KdBxd)&y4m{x)2GmL(6n*p8X>+EKEC!hA!
ztX}+$Pi*G@A+a4vFGr0BXZ%wSOTMh(m|uLnInZ#uJa7L@AZF*-xM%ctrx$l)7X!VU
z0l(%NIhDB@T?N`YfB8&?O}_ElXO8(b!A3Cqm+6K0?u&C*X6_ujy{E?B;->~0KdjNY
zHO>1O@gZ4T!d+Uf>&U+);X~pH20ob*+8xo%s4YO@2FrLp4Fhcok^)qF>#~f$w)4
zW4P)P6==&Gm-E&LKY%ZE-4(P3jQPRd_B5VzLf`3tP4z-A
zzub{)1F>mmgUbRnto_b(KM!PnT_Da+4b;SE1osB?t1ay{L5}UzzIBa%#>;c|_@sTo
zZg)|7ma*{#r#}*IZ%&Vkax%+$bG?P`jo9}OG_US5E|z!u?y)BJ%|NVo1hpXsbtETz
zd3hjL{Y=6A*}z_H^j+ye&B62fz8rrt@UQAugY_+UEr2WPiqF)q%4(lH*mNxz`5*axm+n
z`cbYi(a}G&mM?f3B@{96H+==)N=%D_gTq
zc%k2Z-wJPt`$WF=?M&|&?#XNXQx6(>G5`1;_l;cRaQ;OBuG|^%ZUtupK5A;r+q6Hh
z*Y8N3i`zLe^pRP&MyK^TS9G!K&N{1pE(!V;(q*iUjKzOCsD8RGR@T|Z;yxV=$|rsF
z;!Z4lHTDju(c=NXUN?OX`aZ*7KFBQ@?K37BpDpar53}6%8oA#0!{Z$J#|Hh3qN6_P
zuNrf{m|q>-9pFT4n?diO*k}8HJpEbn#^MY;@`4Xz^(Z#+zkZyV-&#E3p=ZgjJNx2`
zIP0FPZ+1JLYhRs+0jJA#?~oe7RsH?2Jz{isdSCc`B=GlOe74*ZsBP~R8)P-Q`6VCA
zbvp3yih#WFb|7DKy{|IY=w2D5^*!3mxcc?{ndj^`uX;St#YR
z^Ty!6g*bL`xEWj;EI%W~kNZ=BG1-1b^7E2FEjGvevUV;w8XOyQzB=2yii4kW$*wa;
zf_-C57H{s%)M^UYls
z_k5?l$p-_xkzvz$vf{wU|Ns4I_fE{b;!EAB=W^%{z#V~nd3VS;=kDURH7h^Pdo$FR
zysZMwS$DkkYmJOE_N;64(r;~F(0b_poKLppe*WI)?CS!xPxqw(KiIOj3N+tYtZQuE
z9nAXJQA6VGcbfLKNgo|A2tGLu-kzQgwRuZmueC|m8lAnD8D8Mjn7p^+t$W-RzLbxR
zj5WIU?~Lx}u6~LUhj#_{1UCfoD&DQY`-C6!#zgOHf_%K6@BW$0<@IdPH%%O3!js;*
zp59s4tb?EMP#mG9_?`vW%Uuu9pyzxgo{59s|{C({i(|4?X$KeA$jtANkCYgQ?(GRoS;Wcvd
zbRsw$@Q?gs1AgYjvwdI2zp%%58T$76zV_;i_|B!)
zaY>IcUgY#+F5+yzqdD90d|%ZGPH?kaKae#wGJjwDpgm%AN5!bA3-+!a{Z*r9GHKR8tBQKkQJZ%TwbMFHid{T$Y?;!N!62D|-
ze>TS6xv|b~`~1TRo0kS>0_{kkR>W~Ea9%uWL_GLsul%&f|JmT_fp$-zF6Vbl{B-kw
zGjKoe3dG1RKj;%9d(QVW%ieZC&N=alseYC(F|7iPKl5BJX0UNMpwB(PiTd$5^_28-
zgD*AUt-%#pJ$vO&JmQ@7kze{||4bl`+Ie!uTLC}UfnIlozMs$AASS-{{`|MBm2*1Z
zn1tp3JHI={rFJ^N<*Cv0gH3B4uQJx~>%2z3`OrT%@XuztBYQ!9*X^k}T&m^GG3M7g
z{dDXFy4UT|uSV#Xn|W@1I}n??xoa9{xD%)P#i{n)(;FdyBc2b)*O7}Brk{L
zaVyug*;-)Vn?%Rmf&7xgP2b|4?_Rcc^oXN+$ct%NM|7x1`Bf|3f5KREmvOj%z@0R1
z&*q_kEpn}KKHU-E*Bxr!@F3RZJtemhh}S)B{`ps*o{}*?H9Wan8XxFoQ!Kb*!#R1d
z4#snC_hs($xALouH9Byt)wcWOe)F-M@^w4tec~&-^4@%t|A{Hz-t%h%H8-Di4jKpD
zwS6Mv#(gSdvGcutu+cbr#@cIwm_FZl#C|sDdxVqbi~jlSgPpl7vg+ch;ITn#VXg~n
z__!y)haB;p9eZkmZ8_Ww@NrjgNAMS|8TRUbhC6)mt$eixaD65)_c=O)zlQ^UsokEv
zBx6l2$=8zt@BhrVxK9VK2%4)|uKVsl_cPq#2tRzMn~u*4*g6zw&5?Q}YfnCA{mpxI
zyn4v-(P!43fkuDziSMO>GtUgPlR@`ex0hzEK9>`dE;DC)eW_OzZ^pg4J=*j0_{j}+0JN}d;0l;zsAPa{@?|{i-X$(Yu>Tte}mDwJlq>-
za;Mdg8#CSt=pct%wpM}0AGW*)8^MF+Ma-JK(Mb=?{Ncl%MmMhJywZ=4;^`S{bRG`K
z^Rs981oqDa^`Bj~t_x;)`}|aMKA-r));yO-=lg!L$uIsoWZrU3|>+W?K)2qK&
zMD)UW{>-S4^V)LE&)#D(91Qwd+r8FKd8LEjcoMVstM7w4^fn(4)PTA3=*FA4Zmzk5DQJMql%sVAQS
z{8cVXudn03dD>@I#z);=j>?aIOi{&)x|fu
z+$X+>#b=4U-Vprv6qUD>kE=kVmmc>D%9*&Vi@_SM4+iYa6KamA|I!o4_QmDtJ`Tdc}`3I51X&VsN%^u)cHrso%}9Mi=>2psjZPx|=6Fm#>*CXPRG}
zsRvw$Ph7Zde$B;Wu5bN{Tm4#76Z|_G91HlU;e#Db+_<2pwMNHwaAWY3Nus>ZKM$7=
zHA^SI={OtkS>HPP$c#4wF_3YlapD1IYV!JkefkdO4N{wQ@v}M6)64%S1P6oiOxC>h
zTG6OUZHJaCpTh|EfS<@nX;V
zD$v;Fug2EOAg$}wO9twXyzuEzKsP_^i*YNEqvqaR4jZ>SXU+UX(AwlzKf{g1dN6R7
zJ!@p0yDyG>Y3-S-_(ty~(^H+Qsmsl2IgIk-NMYdQIm
zycc@9@orqb__s!u?{sejd*%I}?D2sO^3ICsa9|zZJxeFB%ii*?uqB4~5BXQ5UnhsZ
z%O*MRuw1RvM@RLM+e;sgD(B2n-;(D!9`Ek4K&*2u(xHCnz9l#t^liI3W6fQ>JLoze
zwbQ{YuiiDa$j-d?2peg>$MrpVUdD9c`i=mv&9VH-2`*}v&h3DlTx;I;IZkWz%WrF#
zem>F1X6?-9o}YE!1@_`c-qftKe4=lE@QQ#PYub{--l3Vp_e9KW&F_@)Wr5mm{qR@g
zlN|GN<`CC%yw^ECJ6GLjGS=9j`niGMNB>NExz_`(I&S~$#agBp^f-GuU{*{3^)!BC7eBT&#A#ZA4eXIhl>tt6J((Vl8nr^KzKPKbWRzEZO
zt-i?^%effVy@TYMf8X`KB+#nAbw)Qkc<9=JvG%<5VtiSkb^lQr*Ei?1?%~58pY&{h
zTA<;Le0^wMeJ_w3{ly}p7xY|AUfGqOOGck=CwJE63YYQ)>XA*p&Q^Ls{4ji@8z=9b-`jeQ)P2-LG$oojL3P!I5+Fy^UVQ2{4C*qvg3U9^(`X13bZ2uj%FUVGj|5}TY-4w
z)0(=`)B=8)p0yB{Citsri1Tv+!m;XYezqy=hNAM93RvMt^l8h0&D!y
z^MNj(gE(ZPHO*Jth}Zq54`<$!{lQfM{@DY5Zw9!b2iR=P>{&Y<)IV|6Mut1G>^Glm
zYjmhPI-FSrTK!*gP`h)i{aku{&f!CUv54pnXRQ@^p+hXa4>;Tx;MN{)Du3Nr$G_%1
zz-4QKpVr)KZ^M~D>$@RNob;XD&e$5R8#~+Xso0MP=KnFZ!xx;b%d0o&V8A}Pi;?NO
z#kQP_fj$1cWP1C=d`r;x>OjV1#m4tbg09hXZGcy?HE#8?3bdYisC{pebLHMyepLTM
z?Uzsf!Kt8i$A5anR)dHdi;U5outpibn>IqS{IqcYwftlJZxd{yrc
zOnT)|PU%uFj}6{G*a+zC{Si~^j}Nt{w?~g0Z;n3Q18jc7Mc8z{`c@gwHr4q<*~Hmp
zfjG7KpR+7axR_-=ee$a^;uCjc&+tNBmCKdIwAIdE@AvIY=JMbyf5|r{e&O|_WAki!
zJkNXkGWX9Kw4UYojXB_q`@uhTKxcC?*UwzHtv8%JDR^7R#P6wqZ_ah?wv4?c>fm{S
zT2QkZJJ$q!aHsgF_08-XKrg?R{?JJu+uK2Pc>mZ~ckb4#J6GK})yS%ezRfSoc!nCE
z=N&uug0YwGg3Z$z)AyXf`yrRe?8Bp2T%uh{GMS
z6!a~=BV!zR2k2xM_qgk4!~Trvp_2^%)W5fcZ`!$FJD`gX>@=_aE_qAV%D))MlTlyv
z%dHr!Z3U}9>pGuS7Siqv*xE2j!;}3}qwoD!7kJng+&=MOzrM`1z;{io*93hZ8@pK6
z{oKJ1Hu&z%q#IX_onO62azze@{1e~x0S?&z$oR>wc=&*SjSlkGox#y;bMKD__WtW4w`A>;%U9CUrstoHD?7ngjKBlhXt3dr)epDkoGoQaW6cZYrcknbDf
z?c@9N0y^k*hTLD|^X1Z<*Kmhd{PK_9#{~5mPwdY=slV>`U7`cT?B2@<9^`lCL0tWu
z5wqAg0&hcYoXGf^03Y*uraOM}j}7PC;bQ??-mKQFc$S|_&Z&><1M)cdmHZAT-A?SS
z0ssE>vsrWJt&#o7tW_UB-x%ZUUl*u{`oU*)$ZzrC;jw|7?;rC=jh+qgxw;wf2jBcW
z6x3)0bmE+&KIiI$tv#qW71jh%WcggV;SvwerUtAXxGhg0Qe&GSP
z{kfqv#veJ*KR58b;HLCTxWCJ_d7kYDe15T2z3M_8XkEiWYk^N%_v%|YQtMj*J^a`X
z`u@xRD!{jQ#(k$-4P6_!hw8$;QwMaJs}J*yG1ueB{h@2V)sY}-eUDuxw9FIU9I7RZXEI79+bPgGbY2Xo`1OC4Cvbq
z>T~N5j~DX>;aNKu+z|Xi2)Qx6oUa1y&S2)5z2^MM8OwRO(6fz)4-Vu=jP+|HW4?>m
zo8dhbmnL?cbWa^E-v{UAnZNq_Ay53UuTHNCoSpq9&o;Sr_sQL#p*H6Ex-p&P=KEUP
zkIwp%JN3dg-{jl5@^mQU^0Y7GbzE2%0~@&2a52aE|Ame1*ev%?&KRey0X5kgC@+mm
ze#-qaKIg<&z0Ik6gGXF1W3`44_N!Ol`@hWD{~I}dFfRDAZ4j=+x>7(j;);v
z<{ZoEj6d%i|MNMo-4d{KI`DbK4qfJt3dBstdsXnwT|N}F{`yY453S{slZ6hbWJ;@gzd^VJ4wJSb0toL)@oR4~U
zMbD=Gsz7eo*$nt*PUopW9M=Tao#6{k%b7KNI!~Yem4S240Nd{7Z2=$MKb&aJ0DXRc
zuu4y#hNI0*~#YPwZ>2LgJGlueicgD3v4>=sVmzx1S?%k09?_%IHU*>vr_CO#mzMTu|
zpW0PF?BHG#ll&~#$^-fBfSpyK(ai??_QZVS$*#S-F#?{o|y4w@bJLiM!+u4
zXFu4+hduh#;V;FB8`Fz>6=*oM&lkMWi&JZS<`19G2KMEJ?{v&D+HXzGdid3Mj!*W~
z!>NECcDxJr*jmb{lh(*p8TX8H&3|K8pRHB#G{4JQ6~n&8`E!}mqdyuP3&?B-%Nmq3
zy4^Q?;X#Zz0Df%-{OMXbxg~4#iL3tU_o}~j_13l4ro8iAt~Ud1&J8a3jN6R>-~6e6
zc%SdQnD{j7aQ2Eo?lfaLVA~qo?q=7aMp!9*F1fj^E#V$FIwrU)Ka|*4J{<^Ejd7a6pH;slEE@T@jmhD!|*EkJb=f
zg*ay4esK@q*wg6z#Na6j(D>fqodKW3%q~9all?yov#7T1F=`Gdhm_M)>hvU9MxZboekvm+Cc2ywEq!>H>StSD$wo>
z8k1P@!babbelHN`Tqoq-oLq<*mhx=y|FS?`Y2P+-$A5KnDBx%B`p8i@+qbR0l)CghsI3@uJLj-
zI2Nc8AX~ZeNk{b@&v;+(>r-uKy7N8DyVV?8yCrb$bRg!&hPVBJT+0*AfbGpdZpp*V
zfhH#F8h!NAr(fzgl(ls+tg^1rwJvrwZ^s^fKPte9IQYUYo@=-HuJ7yYlJ_p34Dc>5
zbU8c6);mo%nOg&LI4S4zzh7_8&Fmk&^O>(5d3sxvitDyuE8vSdlMD9LBHOKJF*UBu
zjB$U{=+o_dC%{d)+>58i+W2czFaHl_&siL)H+IOkrf2`w@$Ox4ULN^AbHB=5tMBt2
z@ZJ6TKs@lb!(Y0cyvt>|rSs>eJ8)g*@^DRHuRjB*L!V8!clJy`ubSNo)Nj`_yx`N7
z8Ow`&u}jWaOkixyo-tXuH^!}+Gu|Jl7322`+)-osF8AiR#hEex?a{xE=f`E;d7P4C
zTfI7u18e+Ro)vS?h~aeLOzV!%%QMS+tOmuY9SPKiMt5_A>u=p7HRz4`BOvVE@MkpFR)!_N+42=wyqW^X$>pvtPgF?9;PP-r0@d&wH=W<_yTe
zpjAwaQHlv5$#OS@W%9XuLAAP;F16*)$_EBuMPO(dnBId6jSG?GN$Kr
z;HhW$f}W<+wIKR
zai3n4erwEqC!|ZR=QTCjoH}=w!ZbeL9dxgs{qvf=n*z0?9SQjS{J{BsFEXZk{$5&c
zUXyix-4UqK%HmJ{)zixZe5+&ek=qEgb3yYY|G07{R6W3^`aKkoITL92?shw$NACHr
z<&YYGLGV}O6r23v-zNqKGT?7Ya_659Bljs;`<(QL1OAaM4;k+0le=FZx%=7(@cp^~
z)lUk_3*YM>9dv29!Zp~hE$0se;zSHuh
zIjsHi%6Ina8(Hty()XiT>zk0_1-^}O;r_~_b6deG(4M~AUC8_Vw)G6(@WBuNPWZ-w
z_gjK%0{NPKz&E?K-M547iv@qlYNrGK@SpwW<6y?*x@Hdc`LrG2(73hjPMrwcSN@5w
zG40Fvw!j`eY?ATbRVKroxa~hLVC#xNTPN$jkd<3`br;1$=gB~f^?&}Xxg_g%1g!xw
z{C1wM-etc(;`i*I7{p9>b4>SM@sd3hYy^D6={n!kKW;Sd1un@t-`uEi{>(hG+gQZ4
zS1e+4kLl2y6F+?#n{%C6Yux)Y7O#Bpk)7Tre)F-qUX<~iQ~KF*-kGz3_e*UY3LZ?p
zb$NZ{*re;G+!H-r#{=vB+X?m69)9c}4D46#nSYyY!yHY4AD
z`Q%RV$-O)rkfE3F{ocXWMxZ&{7_5YIC{9?MPF%Q1di3y&V>#jRfXsHWz)XHMvx_m-T<
z>;8Z(dbWeU^VUMoyWAl>)W?mC*~4A);Qq{hR#pyLM|3-TG&mOESMy%r;+_C6X9MTu
zNmC!yM@R1*xsJswPPy})gHCVj^#L{F^xwJsYq_`XrnB-yce$e5S#h<##idp%&(Hee
zjyO+0esE%Mt|2wYkK=)Oy;F^iJZ|`|k-H|KZ{}z_bMc%B=->;k8b|eIX~!RW_=5}Y
z-QhqC;Oen~bNdJQ_Naiq_I%h3aB)X)B;b#@
z`N>~8`p)s2Z?*fBjM?1??he!lG&Xvj$BoZA`mHrq>(E%)y(Qoy8{Q$Y91L1Vr!#(K
zAeVS^o}ae`>SimrGtjEXySd6-PSu;{-4QGK#>2mI{pyU__~t-kw{rY{X+ZXwfyQq-
ztp%nrUi)`b#*!UhkY}}fj?_zLP48136`{uy@O#z;@a!_96$l6A5
zNpLb~EzaKu)GuGP#|QGDRn~pFCLp60j*T&$e85xdg8$9E*xj+~17~sgp?NQVHBe9d
zEBsu{t{UP`d62Wm1njhqyzgw|L_XX%Z=2Q}yBoaXS3$Pp@}geEw$#Ty8QhW)3z@S4
zU+7}ro9Mo^o>v*;+gb9fKYtu^;J
z$1h!Cps#1uK3>_Sn_X+_hyO6&330Ci4R_AYpDETG1AFzGeRf|Ed~y!WpBt4qmOY&E
zSIuq&y&voVosF;eVk>L(n?F40Tr6xl<1=%%W6THZ2Lrn2eLA$ug5x`*-9NXmJcoDh
z!2W>j>|gacPoKE>C`Wjd3wz?6|2-b{>A`efpEGolf!aDT#&c}dQ<=U=+mUUJ@ToPz
zH@vk*e22jgKHX3H*2P($)M0Jy<Y(q8Gu`{pjB!2l#jo`7&PW$Sclq~6ug=xlAJ>E2J-Pvz?h_kqu>*BV|
z#mRs6^xCX@EAyUVUp~aqHRsEb&sy^Kdmq`Pm(Gi=ujJ?rae_KpSgYxTj}TpRe4
z)7}?c^YN~Lk7Du}v6qkH6A!tKfIatE{J2odwY~0*AT#f?t
zKJ(b@?-0aZd1ou1;RTLn{nq)ze>^=a(2PGKUO>4l~L)qjPJ3bTN6E-)Z2X9+}TIm>{1uhQ
z$Mv;->cMxO7iLrZ&S-4#L2P`uCcv*&PFg$iMpkZK7swes{GwA#8eM9I&7P%eezzMh
zS^B)ces6au{Sx?DuFdmoKj41hkFRHJq%}r%P6c{=9uKtdUA(*e+#lQ!ygkNmOz+Gp
z(C*yrF668_8-ve{8T?m&^V)K}oqZh6+>2x8@aD|w=SS}=ya
zxZcd(5`0~*>&UaNRmwSx9qk{#nUd=j&o9zrUG-55@1Cw{m=7*woL!^E{u&mt+se
zgRTqT&3tdhU3vXqd-&w-xjvu={I_fMd-3aiSprYXwRxWH3pGl1_UpIy@XMKXHD0bx
zWS=hm41Uk^dAyxHcgVdZ=S?;5eSX?lyDR<7>8VLZ-sIl9^T{FVIqB#3!We(I24tIu
zM`WzNfBU`H*M^+(skv}xzH8*7Jn)0gaxin;an!%tx%izue2dCG>p^X@slQmr1AfI=
zuKPypRd=P({(-Z4`U?7c$KIYXAFm9^;lTbX(442Qz5U|mjJ4IyU+;LlB0K>59I9YPX_hH&tQ0?U+!`5Z4y6STVsAAy)y>`
zu`XrSt<{esk@q`Q8*Q^mgLecMSS8^WyidRR
zUkARdTeqh9j8NxlODtk?MofBjhmYdsjJ4IyUw3OqTzt7CaAp-~@{EIJ9CWkUzW3~f
zQP4BX?*!jDK8NIqp9cdr`McD0S=NpR+Arl?>*R@)vOk*%^O^651
z26*NFD$rItf8F)h9qPRO-C2{j&fAOOjd22>YO^^$o$*{Nw`P7%@QJ~vk3DNI37WV1
z$!DMgf2T%o&hO5boW+eDc|6jIlUe6>=KVfTFWekBC$?+Gc$Q;h6xeep01q6v%M@|I44g)2M+OJtkKgtss8P(v3X|f^WD3|ujd8iypNiiyDtIASAA4}
zcLmi!A31-Y{0ZsF*=L(>ZN5Y9Fnb!C^f~X(_1kmacW!6<`??G-e0I-!`?G#S@Vg=4
z#`JWp0?iwAHo%GRWS&HJ18(AZvWHuE#09G&0VWv)5$I*UD7Kx_z;A
zy>fEQ1`e7da$-3h@ZY{SWR{axa@Olx<5>EW(%bo-*I4w8ZI!XM+WG7K`s(L0uKH{J
zV)eW>vV2;`{O;)3%de=vkVoUC-#u3!$khMxhwq-Ve@ig)du!$&9N=@lKUZZ=S97$C
ztKXX~9aao%yC>@X_fq#~)2khS#-2Q#ovTwd(zm$l
zC$hE~sG;uRh3@UZxOYQMZU!1(T90~rR|HyZTZigZX9olI-1^RN$A&kM&6B}3LBAh}
z$vN*eAL|odjt0j9W4L}A`|rwF6DM2ygROu+^t09T;sbuK0*%}%AcupEpz`$cgM82M
zZ53$zT^Xd6Kk{^{2Y%p$PIY3w3bf@}wlqAf0%z##I{C)v^9E03wB5IM_s=}|e)N>!
zp5TR}Pq$Me@-h2my?z^?3dqoRNwni+f1p1Q%ddM5ovE;LP%hpa!%E8j-b?55$R^-`~7rnXs)Q=2zY^#gyV752szV9fRuHQ9{
zUzG7rB@jOYd_r(M(EPJGIO^P=!J6m(Tz>r_BbGO0jUVQ?`TQZ%`70JWUbsfb$1h|)
zV#xUUvi8~f(fnCn_N)7QGe4WTI6gbLG5Gx?b(Q`dLC6XGWS`a_q{^D8Th`?
z@8Ig$n7!MA%Y!8+e=u<}^Y^QNy8C+q-whs@bLwq*_7A7C%f0{eAbamv?DgK#(ed5W
zcwXnDe3VytQS<*Y{)#WEcYd}PclW+Bdp^(1)!~}jvQauv;Vm4SFdySTT}MmXV{+C`SfRha{j!vo)H_J_I`Wpu|tOM-TQ^H
zR~uq}Yt|Z5rVsmPnJ;;Dp6nNAkKWE-lX-csjeFLd$8k9o*KLvU-uwAZjv9wLuAV0i
zTVl9+TE8yqv;S9TF8-z5{;^(P-}%S8dF=e{nY;Ucl*4kQj_cFq8PA-2e`M$Rza8_4
z?c{4^kk-!$dbW}b@yz3XXJBjQc&~A}Z4PnwSqoq8$(&r{x^=Ptgv@cHJ}dJ+W34gC
z?QgwvSB`Au?#o(bviz{m95VR7K5!1MeAVv1kEG}R?jP;y;`c1~l!e?&BX@aZdhTP#
zx!wuynLTxVXzb1Y{ik>A+QDmee9Bn!Mt1Fnv37aZocC^4@1Opk-5Bd!(Ex)V>$WOtdV1@^=19(Sr?!6){pfc
z`-6A=?ET{@CO$dy*wN$9oDbdWd+odBQ=_l?Gkw^v|NaB#Kbv{a>z@^r5B_}0XYJOl
zy(a~Y_4~%T6IrwOw9$Wb`ku$?WeuHu^{(ILSgp~k?(}z#UhU9_tE0o0Cyc#2#vUGS&OeAvS2^}B((}C0
zzaV}6^?mj~5Bp>)+wX+p{@wf`FnO|%SN-#Y>LBwIuf3o9XABwN!OPtbM2B;HDktAP
z*2*=V_QdeAvG?SRYX^^S&L1dFx8uW8(^vkv`Qp0d^^(uty>sQgecxgJtcEV%o6OIQ
z{#m2{sL}iGTtDRYWOS#y5D%YU{5!jMik=q+_3c?%f8>~p;i;K>SKby!aCa)0eRGc7
zm65wVedllb?FZh6f1Ej6w@xy5WUcWv|8$W1xFIL!PZ?)>-`M+#-`dqTza7udT4f^g
zu=D@x{up!BFU0uoruBQK_2*`t?K$r^Wo?}BY#7do!<59GG_DG=pZ_TP&UIb?xk2~u&c1N1zi{-Qoxc04NxyY+pFiy%$i6ju*9YQ<|1oMs
zZQFP6^`95eeQEGp`JtF^mHE_+XZ>V;Ff!fup5tF!dUcLJ=-u%4#-^{x+clL`%|K;iF;PbPi!(Q>yu}8;m|H}P8`@DF_
z{LQh?_pi#nbN1-NJ9(>w^0A{$szKf7X!s+##ce
zzT<5Ve6#8B{^;dG|C-UekLK!?4SD;BoUaf44#KxL{^GlSX1r1^#3_?_W8`#kH`M6e^Gvp`r`BFzbW{!FFAkyhA%yT
z{>%T)`STz1W#`ZT%K$gP?%xgYB`04qVs)RJi&tlD=Hs>@<1B2A{^Lg9cMBJnMfRTb
zmyf-_pZ-+f%&ha*e|9$qj~sIDEc{!F?w`XlW|Bacqj^_2hzgTacqT*q%
z4-aCd`;$iBJO75v*%!knMTh#}n>A-1Io9M@UhC^m{`3QDnr{B+FCYEajsEM?*Tz@o
z92s-{<42E6^UoOl52h#Mu0A7Y>K8wj@1b+hchTEpe%0s?jlOkwbj<6+hmQHl(cd_F
zZy7yL8$I65Pmlh#(LZPOcZ}XUMeYkm|5c;^$D{uzqyM(ifBWeF?dbpg=)ZIHZy5a>
zNB>_&|6fP{=F$Ji=>Oa3e{%FcJ^G&={qKza_ecMSqkl(wbt8{BxgvG*2VZ{v{0q*V
zKmWq7K7an3gRg%5`STz0HRsRY^bgOU|D%8O!25L~XT<%M0Jm!T8-Hpych>tJRPKpc
zv+iBde_P<3&#tpMcX@j2A2RyKjlOy4=fZ2pdU;&(^mAkX7t+&D??3s;`~C8B@0mco
zv&S!T=3hGG%-zRVWlrW}0{wT5{=3tY5%cz>ySemsk^h;1ocs2BKXHGI>f8Q*9DVij
zy?5DNcb4LFk
zM*oqce_MKI`11$<{ekb(w`AVCO2=b@S?4px{3AyHQKSFF(f^&%f5Yg%Y4qi>{FKi(
zjr|`TeeXhR{CBgCKfd}*{;Kfz&VQPJPs=x)KmX?7)4%EbdAZ=@sX$!v{^Ajb^>W;M
z{7YH0{yn3AdwS>8?fd7PJ@ugf{-F7z_Z$A%ZvM*o@4t0d{*$uTwV%)0%;6Q;qw6<^
z41Zrc&K(+ipECB?c+uGNK2+yz3!O*Cx$@t7zJ08J>*&92^o^BHzWmtee`@qUKKefz
z{U4_<@9&%Ofq$O2BLA|>&kLUPug;(U%x^t^eq+c!J3T-7{_SshV2yrJ=9dq-A0GW5
zq$ltE^Rj<7z54m=z}x+&xg4wX-ZQ?w-{{#fZw#%K9~kRzO<&nR$+&sjpYdJ)`u^|I
zbikuW|9PYT=cDi4t={_mqhr7C@jJ)-k)!YXym85HeD9O>-}&*~zyHAA#|^pGeD(j(
zSpSL9^OyXe1#=9)@ol>?u-ETs&G#F!=FAU{{zpdNJpas?@8zrY&->8_ekbrbB2U@}
z|HuR1iAOHxfBM6_``1S{;qSB?{>|>)q{G@B|NEow=j;0>2zLB?HXG-G%zr6yrrX&o
zXYRsg;IkA{OHa(8Kbsre~{eOS{
z{HJ~A`SbrYc*7fZ-;U<>hU`1@X`^o}zc%KN96H}`^p8r9FI<1l5AD`e{r!z`Mh=@J
z@60!R_x(9)Ouv(LdhCDy5AN!**K;xRu%FI3b?0s3V|loI@`(;{eq(f;O+UY7e>S~k
zAC^6T?^Bb{r|*pJ{~7y>GH0W?`mK!LcdWgC?A5PFWbLgZo=0Y^{u{?5MjRhJ&fPQm
z|2g_!8U6oGUwuAXKk$2Y`JqSLzw!gSwfmtN*KhU7@2!Adb-iv+i2S0%vOd2zdpIGdza-A}K7CNe*0$0&7PjyGFT1hC!~_29#;f9oeP`|n&ID|i
z7`#)qM&0)#=6V{;;FHIWp|v
z*P3%L9p`XlO)O8$nsa=8Y2eI@0y53v_l)%qh!Xn;M^DE5(CB|}^nWn=|1i!
z|HaYw?)PVlUmfeeHTv@TyJNo0hq~ui-+VP$lkN(-Czhm^DF!~pa{)MCW=la>X
zYxJKs`m>||TciK1(Z6P~{+VO`@;&5UJ=Q;a^!JYbOGp1@qyLK0f92@^-srz7{cZ8@
z{Q`b|^_aWc=C2>~_ZsuB$^4cv{s$S~n(ikFm^ZDBXc^ib}G1h;AHw6gG*vlTs`}$j1LFSdT-X9
zcb2~D*cTn%*rkp~WQ}h}19#m!_WZ!wr9ti97iCeg^Y>7EKH$J-2z@64yz=|y!E*v<
z-Ffeov34$?SB&~yzAoL_Cj<2KTysI*=Mequ&HpaI+cS5DtbKA~zAnHG`(kW-xPm!X
zpPKn+jP?4)&iv2H@Yi>>t-x4}e3-wJuD|LI
z4y{?gEoj?o?pxJ^3n50Gd>p3
z19N@Qqt2{1*L)KnU+`XCN$UkUGU9OFTd)=2f-jnNH6_o+OI?j?_T`$$0Xs8CV!Joc
zuH5Z*>SV6r-W~S&A|^hH%i7ss8Ph6j_VMH%c?;Qg|Mlkf#m^sigU-8ya=*&BIvUgL
zJKMATa_+pgSFT={J-jv+V|8>xun}UM7yjVRo*cn!AOClyZ3Q3V|Gsj&hn%0tMdnf*9PJ+rcXWT$-3*S
zKwItnb$9>F7&mv#rR8%$*YR>=@Q4J&kN)>B8q4y|JXjvyYvNrV_D}QXfzJ=c^=0GS
zMr1Xy;(8t5^0D-hytv${{Gyit#;1rPIv4*F=KJ!P@Htu#^tfm
z`&1i;v(HBPe|*OD?hmdFaIuV+UiurKJ7q48NA6)mt+CL?gSe$i--Y0U-%`#%TG~fsQ@2(H;dyzi8--GzDCR>1xTL_jW=e)EAo=V#y5r*l_i!`__R
zrQiHzi@$v0ueqKda?cNA^{9VDV2wOmY;>R9M`wY*&Ms~9*E#;OSzBW3y<+Ehun~OH
z`0iVN=syts>+Yy?>YeU~%18C_y<^-rPx2~H*4Vsq#B{Mas7`0E%2{@nTwI#9)(^h%
zHJ`is&v9-YcfXY%9N7QB=)v=C0h><E&hi<1c5u`Q)cPdgKV#
zZ;YL}F6jE;oY6maoMmSjzcqU4X#Dix*xAjT&Hvx!+{_zamo;QQ`@a<>;#%5Q$2e!d
z_kbVl9ze7P<%%e%l=dJhEEiGzslw666t>d1rGaWB|8
z8ku#Ru(RZQ_p@R5I}YFYL&vcP@paA(UvZ_?S6sehaC!Ve{KX|(*YDx49I|z5ARhJR
z9aO(LvSZKuWNZe=fl7
zc5oyx-U#^2H??|q@RFeWPs;d2!0w%ahD)`r&9>MCK9ivjo;T*@iLGk__SxaXU1N;L
zIW}`T`A-&i-8a_Q+P^cpKj#03y?c-M{J!e~pP4fxGu!f5R+H)Ag`6{IlFTLPCAU&q
z!f!e^rcg>RNz)Wk+cSYPX{lPStw5VLw19vZ1S_CKSY%mTZn}c7sGF4)MGy)K3WBI0
zDuS{qDB}2f{?7L``Q+Q*nOq9%{;{7&U;W(PpZDeUet$l{-<-K*{0>e|%m;$k1>Y51
z9pKnG{yrKK#Kd3k#u!&W>-_%H7@yB6@~z?SZ%jH)P5t=2ra9Mpx5oLZ@fgQvMP3_y
zt3S0}?(189$C1Xje!h-tt&c-XsT~=7otWldpL*Jo`ra9-?kgiCt$?pc4C?M&^JBQf->-um4C
zc}?Kmz4G3v0rN$miA!zk*8+avXv`&fjqUMgD%SXbqeY-O=kDAW91Z9e!!3b(Nmujd
z94_Plwga;2yLnq=uF*xW_Q+26gr932%-T)U`lSrT6CF9MCN
zz01+#cl6fG$*kg*&WnM!Xc1_mzvCTn{z|&=(0y^>e6F{3<*v$_yfwd8=JDI(d+TJ3
zZ}d$ZQ2UFF_XOnG(B|@$ou9*B&mGFRKJECtcUdQMj$8BUqT~BB{<^^ZRZCkz^|nT@
z%NqT-a@P(ARe>3
z)zW20hYNb^6Hc6=r+Rz-MAr5Ocg@~a+|#3-4R9;R
zxEpy3wh
zVt3AG7@kM&D=QYCzhuk({0_5kk3ahIaw20ozbiir8tuxf#s{@XcYReW#?4Rt5Kn!U
zuVcaSfPP^29f7w-EE=0{QTS=}+!?$eO0265XU+ybE3OXsA+MTP=%QPj&*!zQM%m!|
z&U?A{@|#EZg@8W#w}x?sA9OFOYdd>mOdpxKx0f%E+j;g?uS&r9!uNLs-yi&HVEwn!
z?@bW??Bve|zZ~42_3Dx<`PX|x4hMAOdw(#>wYGd;5r;joIm<768aqdi`?v_`6Z^hE
zlVh?tBqJW@#9(}PK!+w*YEbSr0)DZn^)0VI?*6UGFWsxoy*ld&{qi0;I_G?vkEmbc
z+I*ZNm-EQS;}+6dC)Si=?;4-gaMH1~RU7>NpF)b*8prtOQs`0t&f%=Nb2o5KZ|&gQ
zTs_sU-q}%ZxA|J+aC%#mkLT0@9#`4t$EtO)i1B2=o_e51!=)M-&w1Cy~zb0L%G1Wb99gX(d)fnPaF5@J3HG!zgsLa
z7K2#!2ioXsW73cMyx%tk_>zy?W1Me~O@!Q#@icq_Cu42!6-U~sfZx3%VkviLGZwR4
zX=L$#!X)h{hqs*0*4*6wc*ei&RxW!+j9sIb{Z(sk&pKbu1^nkX|M03cmXSw%;Sc}x
zlD{v|tnXGUbdULRZ`gLGwKL|Wc_uT~Q*+z+T0gyW5nuYYNRKz~E*<6Gd1$Q8YexgI
zd3Uc1Mqm1N>+#sS-O89<`su{Un49xMZW@m}r?F3;b-t++dwZtwUFrG89^cd(h{<~6
z@m4r2#@PCKSU&5gnC5YckL@wWXFr7)`NUs38$Y}A7{$u>YXd%BJ@wAJ
z3){gWz}?Y6?3y}t_H@v^mPxpmH#djj0=VOz5Yvqefc@-1j
zqVMG>H`b7U!x29{>;5=f-Rc(K=FKO)#(SrAoYG+(-<7|1TJOAZmiO)K^V``)py6Jf
zZ3W_07x(`yldVP>-d!i>x)2JEdPI}F4!fbMvOK39g++2(j$kBr?qk*YbOFNeaF2gZw_`F4lP^PY?~T*`-eIU|P$d&Vye)Sq~8h4Xg=
zeCJDb8iRA2)0k}YvdTwyT5SI@@f=QHpEF$gB~RcpiOy9zoS|nCXp80l@Azj=Y&dat
z=M8=K@-xSGe7?bI?=^Quw
zacAkT9lFSkfBwSv6fv;LU%JJvCdls%@=s@8wq1GomXq=K=@*%6^02lX?c9~UxmjX<
zI*^mOJe8*dzOunLx&N3c_hQq?v>wgnTs-`Jey~5dF{qE-zaeXMYB+11^!K^=G~Vkc
z8#f=VlTq(Inc!Pv>(1cCi9_!04<1Y~WaN+@zS6^o>w<_b;~}FKpz=6*Nd(B84{#-?
z^oVaOu!b*neS8{Qmw!HNOly3z=54g5o?7epVe??1k+rrR;F<$(NXIu^(W|D|{g$Do
z_(`VziL-u|!z?ZRa3|l3tZ*7WQKG^JCHzvObw4Q0tCzZ68|91~S>%L#7$S)i2wKjmzg&IhPkTE*A05>z&@78~5dB)!h1Ahk6@z
zkQvwTrVjM{(8kZ!+R|?Y)zz4t!)-rLuF2S%H-|hwy*C|iW~`kGM%%p`KQsJnsx@Al
zbQx>odG*{F=;7-RJc*u>1820a${9Y1O%CalWBc;|yzHBg>umY&Qt-hZ4(U(_&kFdd
z#+_;1sv~I4sU2rV9=%N;6ZlM2FZR{q!C_7}9rXGfWslzacX(R6Ha-6}!
zqPCkYXII%0;?mKbwI*)zSw*?1o%L@
zjet(NyVvgn_Q=YKIKg}KoM0`mM^+71PVUG#gG=_SmreN__2RMe_}m-d{?6Ub$M}r-!De~)rm2zZg7UP;Sffi!{H}cg__aXeG$&Vo
z>aW=4SZpT(I`U7)U;g!kIB`Qp?kdN(w@q?>-M5yxw?oW$IS`OhPt7|Xoaci*xhcou
zo!8RYto2@!WuHHM*8_gU#Yc1ZLj4_vHP9VI)3Ne(5>E((EBCNViim8!js)Gavv77
zc30gochS21`wRp*y(y4yvCEIzV1FavuiWs7%;CTqzva_>5omIx?s33(^7{J3M>?(3
z#}{*V$UCc5_E5(5$l+KoKK9hjBA};lwL8b|R=~H~#p{#ZE&BSMsy^xu1SbOR^M-qN
zF!Rlz=hVw6d+&<7#wTa^EJiWos(j!S2keTq`owhO3fpR&Y|p4IV|tut4_CESpI6y;
zj=e>|-qFCFG^UqMF-F`3Sy_^Ht-BEaRa^9*$c`6JyuZn(wH5;PbIyPe5O7@a?JoSt1oYlAhDG-GFQYE6v%IuU5^&-=h;&+$vE4(F`#t#`e)`9;*u}yiO)G>`7!SrZmn$vWUQO>PaMW{v!h=GTI-O{?8>Lykdu%4NA8y3NN{67
zPGd`cYx`)%Yk|gZap={}OB1+w?hocaf5n@+@Lj`L?9TRW5RX_2@v`GgeW^XM%->Mw
zE(H9uw>6FTq}O)rT(hiGdGU6f4IT_WH~8W}I~_D9+Zm6!vyQ_>ps~eAt-j6gx4G|e
z{dEH0`C9*Qp|Nu&5Gx->+v7XFnY~4zvEMp(mVeID#UDE8E94UAa~=HA@IeP%)lr?}
z9eHT@ZbBzc*dlX%z@GO&9r8oH^$lp9-<~yg*Qb7wUK?W)3;T_wx#+!JWKVNuZ8_TU
zy*@XFRXo_+jfbbor8rmV=zF2|fd6=xdv>+1@eLQh8BX!2?wwKhYGW(t8XeBhYiyCV
zwV*uIzBP~|TyF%e1vdNpy{mMdoX*hc>|Cc%*AIH2|zc(PiKXC6(Wl?R2
zqyILH*y&O$IPo@FaN!M?!H=HzR%G1eQshXZ#~yypV4I1@|j
ziXT935oqP7HhYHe-Sg`_@$`LV8+SN-VPN09yjXWu{`p2;E_;q1wM0%W^1bos)zzKB
znG~J580NLNKWpNs?Nb?xVYDaL^||ZL(S7zwbkpS?or@fK{x1UU^+7qs3y5PxKTr7H
z*!aL7d8NHTUR
z=#v|qi%;Ed26FuIQ%$ImvEJ4*#}!{64m5tKkMp~n!HbxkVTUhlye#t7{ZQr`fqnk*
zLmiw8_{CRy^pMNZrH)U?z}TDc_Nkx8@`(|!Hjm{<*65?VbtX2Tb41Tqx87NO`E*X*
z@cTrdZY~UUt?tw{KSq1rjo*{Q&Z?bz13JzJuL~XwoB?(AreS_MV>!jCvvSe8v&P3c
zwz8%+d|qkJZ3lSZqns>*Pe;Fdun4rV&g4^!wO=mCm!G*Vxw9sYzIWobPETX>nWbL&
zxE82W=WYp(1Zye~K!sDXC26*;=;#qqJ=ct8)|afc`4Q-Pe1dEuk_)4XMUi^blt
zo-gFs%YVLS`QOuQ4C<8L+U5s{ZzE7Ei$LS&-k`Gl6;I-Vqi;rd_EV@%hwA*`Bsbkye~K!$mPYL`x!3p
zhR=*wL^0pVECTKI!Li_Yuy+Fg4o+jaC$ARt=BTlRex;L17oT8)qwr`YiO%J7Tpa{T!j<9J^nciJNX{d8L&InH#cmmLj%Y_NGl
zK)z@3GM?p!nkO&ke5!46R@OPPbdos{tOed~JdXJ}mpPj^26(6r^3Zyq|2cs-gP*qs
za!Te@AokNk&&P4SF?s_I1md_Uus-VOd&UNv^F3?h9-H10w!{na-FHSz<%o}?KKXpr
z?7patu~waTW^M06&R8onai12aqqMG?;|vg?x?w}^MPG-
zs)=L4@qli?x3i-ycEtE;*|4|jJB@s))lZKAH%6HoGsp8PTYPYC`wHjmUwo4N2Y1zK;$SKg5ro-2T;J(0TrF}7+3M$8Ux$Sp&HOe0OwZQ%(K{+K`UtXLs
zUo?KZqxIXl>aMMqWX)Y=pC8T5p^QhUsd2t)9Ffa$_%k}s$-KVx-}`are8!50f8rVa
zbEn?2%bmc3{m!
zhDVw4yWb15r&VulCWXtG&ZSqQ?+G-upv~pBvnGD>{KwzffL-r_&)uHk55Dl|oOSn)
zU$`R6pSyx`UY~si?+@s8zB<{wF(BW2C%+|vhHFMk^4*1s3f()Nf
zquZG~*Bp>@_csGMTLc;(@W)SMoNC@2J7Tpz$Azqs=cjfm;LquyXUDp{jr(2KUksX0
z`4HFL0lR!zwck5cpZ79qM{qxAs85e`hZY<6{{g59os(9(Mjt2tKVf
zmgZ&rE_Gw})f2hX0U7dq6Xz(q>inINd21Z*XH--ajbMDI
z@zD2t6>syi&4V|*`ud$=e{|v68AZ93jy>NY_6GLKeQnO?@{g1IgEt4_P#4aQ{#nz=
zE&}`VXMN0HrkCSqi$CRj{yAh_Ebix@3h0zi=h_>Cd*f%W?@K?zTQJU7jU#gT{O4vo
z!ufH&YV7=YKl-`h9pEPp`}u7=%6cz%+jAZVkH@!n`FF0?vgYsajC{OyIp6u&+cg=J
z>F1ez`<$zMbJ{xDm%R&td>st>+2-8y18vlQbLRA`AvLYO=I?;_K>c|Sye)kTd=D3s
zxVy$5I@Fdn*2K70fBVMJqi%cl`iyT1J~C)5ThsX3^u}TnuYG-MQ!MuRbS|*R4{K}~
zlWDH*%=nKaL2O^22Y4+#8UCvIQ5PP%CvQG;*^noC{^+E~+xxD}afcK4i+}2go$c7+
z16`dT$(THQ^~G5-&3}fMfBwMU+hVVu)8l(DX1f6a%DHoF
z@l&lH2%2;LoA+lq8yRl}v@MM!6*;Msnh*T<=8VAMcF&
zhpTd-$9Zk(*}yA3HwSwHynR`G7X$yc19<~}J45g28~;uRT!HN(C9F(UvnsuMKDMn+l$b}fhq|tFhz|Y2B&ctTT{B(eW`dD7XNzPr-x_>5PcE)o!qobdb
z?gZcT{5Tvu7QYeIC057ed6RJd;HlB*m`XsV{*op{?OF3bz4yX*D`h>KR8abo`hjZXV
zj@=L6Uo<@8{CxqR+18IWNuPS#2#gnjCYNF@&-}N>hQ`l3mZN9xr#R{358M33
zaC-YbuU;7V^M)@-Z{M#u_;zzppT2YYY@%x;plcCm>b-j1)x$yW{{D>Viu%j7NGBfY
zQuqEo8vf{2+twb9ftRJfDR6exoniMxK;N%SpDVa?Po2Z@crMeW-|RN;ugG`~`M)jD
z=u`XJ=|Ik{@l_kw+&#@28#w8m@fq5=7`+FJKqIp-NE>-wELV1FgWcAPI%MBm?B@OV
zDENjKZS;+-w#qj)`Seu$Xg=9po6arLYe$29K{?->u{?{L|LpKvZRnkE-tpD-3@_i2
zQP+h@o*pr72FB{;N}tpG;BWa5tIr8_ZjT@JJ;SBHbo#!-Z@%3hyfI3gIS`1;ow7&v
z7baP2hl6_qI_V!{;0Hdczvtzx->9?~QoU`n}OPvg(H&`kPZSYIj^GPxyg!bg@Uy
z-I(j*Tm3pT?AI^(nV-qhrnAJ65*x_8NX<>Y&mBd>N&
z1bYJi7G`}D9}eUSPg?<5cID0)?d{VUx#QQlKs{{+y=!8xZDTsz<%Ei@
z0Qc3)2RIX`3-uxAWSyOV9`x@R-R+36ZN_VvX>
z8LPJ=0ejwLGFoF%U;Q^aaqv{2w#c#|
zdLJ6^mA-F?Q^U*nzB?=C)-C&B9rw*khL`J)uRHwgTYkpKkJyV0mpbX-C!0T-Lu=^|
z2O~dX;ak_}_UkWilGycQ>|2@F*9<=>9{isT_^wV`i}bF_!C2e;#Nod5IJq*_#k$EZcgLsR>O3==Xlfb-CXkbh5#>G-?@VsKOM-$T%JB0-~zX7c;7xR
zF`CQ6JQklV_;5e$^PRuq@p}yNBd6k}o4hsh?1+c#J%OB%)x0CC)~$Kd4h{R>3+He&
zKeLuKd1kktCDznHZ9G5Y{Q(^(0_|J#JxlJuS-G&cH~6~Yds}Vuo$c}N*kcFR^`Ume
zjt}~AriKm#=K_4<3!Lp6*gCr_YdF-prw+sg_UPIQyfNawFpcScU>eI8KiF9WVv}d}
z**ud0`N6L-e~tBWZG1kkXWlzSPd^XX80Gpi6!9+tjcva3+j`F~GS=+#aqb(v8-ZBp
z6+3(K;l8e==j)AuJoY?YczHVaaXjmMZLgFzY~*O>Kk!7C_~`!0
zA-?BiepApKlH;Sso;sA{F;@CD{^CMA6^ON;$^9;VVOl5427hXUPO;SvKjiXQa6I5E
z^e)hUIuH+g`iBFJZmo9B$;)kdH240>qc=dKM|=l@x!wB72jZij>TE7w8Rx{ZN@lLJ
z{PK5|zWP7cCkMc0<7-{5df)I~9y45?X+8U#YK~XQsdcu-J!5vy1$DS}@lxu6{G{dE>i|I$13z?IzJ^VRK*E<6Gr!X(q_=&91
zJ^r^B{G7D0(q~`e_v7(Bd-geE|MKuY^PkSqhrO9=*6?J1D`2yAAYb^d{`)h2
zV>av8vCNML+G{r3euE8bgzYXaxgH`(_Dbg8j}fw+90kyi(7srUL^
zookcKDxGi1o_)H+vvY5sebvh|W=DS|j4~0utcSn1TS%*J`uiPpdl(fX8iUn@<)yIXF=xm%~(w=0&TJU|Ho_6RBf=SJ+jkX?#Ei3*J0~~
z4cy5K{~Gg0W<2_FB6IQot6eyf1K(-zQ=N~k?TpW6P5rr3XQn<|Pq;VEjdiB}>C|5d
zqfA7X_URFi7_{o{oveRj%*M@CIUVC)P?Sc8`l(FwxizirO>bN|A}!8^gGco%_IJI;;2XDj|I$va#9+Znqb>TWZ@
zw;0$tHO=kQr^oAwU@iEe)X#zRETpit8CX9Z;G3MDz1}UcyE9_wd)T|U>OG{d_FkJYMsVUgkk&mvpTp%M
z&>D|=IUh7X?whgZEZ_LJ2(+i82N!hl=e|I`-BBFg610vQyLcNjyJA=bTK#R$@79@`
zI~!~U@+cm*=-0eWwQXJ*9FLy^?jf${^@9gK+OJM`cYm-E$eA~BD_}?58X4>SvDfO#
zcKc?EgFKEGf#wW7nls{U?N^@vd^h*mj(2>_V;=q5pZ#kC&7HzY{WGpDxvB2@);n0=
zt|UMAO>CpR##Z0hu%>VR=-&$1Galoz-g-9f-8Sx>aR$%sihS{5w{ztnB2UPp+Q)?&
z{(>Z|zGQlttMTlqtjpD%!52mzhu%Cs$qzrqIQS@kY#5K{-$m&0k?kcX{CFsG?DM5^M>6J%dN~--gToWS-r(O3-ve@d>HAvx`c4M;e%&-aou0p9
zpwGDa{A}JDU3_|X2L1K==o5eNC%*SYrgc~u@sZKg4xa!g2ZF7jIl3^69~j1s0pH~N
zrnFvgwGp)b``w#g*2bUbisj+>S#IBzxjGxqjy|*H%ookh$g6yezVYWRfq0#x7l(5n
zn)CTtXHEs;=~;JXmHZ2{?z2N9rKatG7g^s
z<6G~uSL=DY=Q39>B_97i&>WBFZq4L|KwWB|8XSy6@+P#K1OD0niPR(C`0Wf|H8rK8
z?ppr;&Yv%^f=7C~zn1as6X-l0&_xd4#`5I%V|{nRKTeJWuM6A_dF`7@7XL3!zY*X-
ze_!CcS>J(MGWI6XKj!E{<~X5K^WBHP^;-?I;k$+=cl!fp#NN-Ut!Yh6^Llzq*60`C
zxj^2;#aHq3w{g3#IB$)Ny42cZA&~6ZfG+jVS8MdWA)uds^5u=Oej?!8znR{rFU}Y@
z>_p`U`P>}jx?T2<9)6=jPWY*@Z;ig*nXQb=jXdyWT;mI$$v4&vpHL5UvO%U?iTCPY
zQ25sDqw3Pz$u-N+p%lpfhawd=RrSXYOee9i`zajew
zr{RR3c*VPOtrzR`@%u^~G=BY+_%o<*Q7mjC}a&vMeW_RjRq
zoyd4^@VwdgkHcA$qsAjX^)}|EdY-JlDmUhbZa(0lF^)Onw}w--We?wcxHEWfg6}=)
z9inUG$h#+(&CQe5r~LDARjj`oH8{RS2V=MOvx?6fv)|l%L)D}jP?PfK{lSyFCr&(g
zU&zVjeZf=tT&vEt$ZL-T^p1Dm95g-~_pb71^o^b|&O@0y3h)6a5aaw+HP%+_Sg^?Ih?M_3)}qI4Eh$UZJcZ6
z!*~^!Y>0u4vG(eh81SH-4#?w*FJo<6cV7P4mXlF_e%D$fXC`^P)8Vf2f7RQJ!}8R8
zllT5S88>~O%MD$-#Y>+iPH~jOv5wTuc2J(gS5CZ({9NUedn8{ta&{4Di{<}6euiDL
zxL@`C$sYgcI3MtlPrf%<$K^BeXVf*1m(Ip3J~?_rAeZd#4Yaw;{aN#F*GDqm(D%*W
zP%){4(XP8lzq)e&dIwv3YPa`pk+F7PP=9c6OCaC;@BOoo
zH{@wM_+vrO-jVSahkLfzJvBj|-k2h)T;uxpiHiF%%p*E4nps(<`Wp5@EmQEto_kD7OF&mz#|b1vr%=slrx&bc#m
zeNr&m_4eCia}j9vCjPc77BfsVx?aP`P7|*KpFONJsqr7?{KgyoST=U;cV$Yl}
zKbJXs2d1@jSN+(EoU4&h=C2Pj-jl<@c0l*(04Kj5@C|AchhICKjr+^9dOTNdE#vc%
zlb_b5vHXekivx49(m%#3E^Dju!nfw3?+m|t|1(_be=H8rp%%S2eRtedK8#$9f2N{$
zWZWPBT|;mG;Ng5wU+3}J=Xdk|c^S)rd-4@eqlR#W6I|A=+7+X^5I-CK
z{T+PK|0kl~eXZ@@@e`=(a|d-@Y&16}Tf>?aR0P?dAh6HYfS!M!Z`=-*EZjhxXd#|F11S3+#hd
zf8LxiAH`Ll`SfW4J!`?I2i7{jFpcG{JR3vb;R6}_Zox;s@I!7u>~e8K@ciJ#0sUfr
zGzpLcIpLQcuk`tBB0tJDf0aEm$=x`U!}+MQa(Ey0;eM2BPTA)7C~H2KwNF-@?v|R>
ztnCTP&wUw}PjTN8TocHDzeCX_ujGuiM*?~)|9XpQBft3bUL6WPDmW52gIiqV3is|s
z*I%;Bx<5~`N?z@*S{L8Aej;fpBU8V{5<>4Igi`<
z&rY-S1isY0I>On(z^G9a$ubR#O)NKCM!#wJq;DgxYO`X<{<{oDk
zg8K5nF#fb*Jl<1h%#~lyjXY&}X%9c+JLqlwn)qq`&qWD-Zwlz?XH|JsPq=f}R^@@*
z`G9@3rkx7vk9qGy*ZBOB*!6o2pAy_0h(-JHAH8%*&o{Q;nVx>!wJ!WOoW{BDj^q5N
zr+JPn<4>rU|E{aIQ5@Bu;bs5C$p&Bk+DzxS&E{W{`CB4~GaPIL7lXG3qc8r9!Kn8Y
znah9eym+>Mb>@BJy;GHY^uIn)&$}~cM+;5M+9t2A_D?;#=Jws?YXXgaV;npdGWdTs
zI2YU$$X|0thtD(M3+^^!o6h=n&CIud``bI;^}7F0GN-3;tCR1~+8Ey-nPlj#99!S{
zUoKtp23OZtW&U*H7Qg)K*~3H6NH(6h$-~F8Dt#SO_Nmu7TkolOuug@Gutsj1{
zOGe-IYo|Hhtbb%cr+WKO|9MA89T>E2P&{xzCpA*&&O+CNNeV@>O)YPv}{o(ZL%br%A*mbw?
z@T_Sp_WCjA{omz3knDZ_({WCoz1z-sU+VuT|7hepkH}SjVw&HaFrAAmA$Ux
z@fW6bT$6oS&XyB8#ld#ZxR0MQz0Y*n@7=Wb+??lQ_5J?Y{KGTvIXyXk{Hx#CSr_l4
z*?3p_^T8O`k4I*l|HaJR&EDH_%m?~!4#dUApNZd{XL{9d%;taK?>%w*JrvYhFg%Z=P(Ad3a0W9Oqw@IeX6z
zR@L7(WPgA5d``8_?ucGIRF9lL_<>88ydQMb2X*iflWh64S37#2bNYTq>l@{}Gka`*
z-+$P#NACI4I^DNV>-Fnk=JeOE46k}Pe(9a1i>$NXn;#I0VYJtC?$!^@&N=_AK;Igf
zzgs7>M?W5}ivBUTyNxeKw7F|t;d7qr`S*tT=MNrnIKB^mGe6wLd-?gY%;mZMH&5by
zQ}*ytp2`KTzCB#B4ueJ5h3(A$e|K|_v
z)LVW0>gZ~X;mnz51@`&%?#Y&QpI_Gb^x4DuCueT|H9^n4G5hp1zs}s9H9pHz^_I<=lZ$qPMCkf)ZdpLUup#}@Bat+{Qap*m;OxfpM%%@
zbo>px(_&C}`zJ0s|E>JNzsB*bNlyI#D(m8}+&|8|?@Mce+z)4+PsalNJ%Ka!{zCTf
zXZ=Xf_4iI^=(mTb?tRX*R~vl(w5;KnjCOpI!KXDc|MJ&9xXxNDt*70`b!SH(KVo+Fzvd5TjrsZh%v)0%IXl`G!&|do-&;4&o#bv$F9*1ghmRR}?|1Fy
z?S|~r?enxY^xl5G&po}*1iiOU|G88DMd@ox?EfLQ(p~=i<{KXPd?G$O+dAgoujDU`
zjB)=&=4`tI_!2uF=vE8OYu~%)XN^vI(bw;fndT>_{&Ujv184Wd2A$@7IF&j5-kj>^
z6MZk3dYqc8BfX!o>0dha_@Iy8Z^#cQM*R8{_}A{E%M^zGLz2
zTp)*C^G?YDSnJOojeQ3^I_*_Pe{r_vEflLZ`uSLFoAc4zuK(i!U*+#Jvp@R!8~^f&
z^Iy!|d0aaCB|*>raQ3XdcD9FuFP+Zu=`t^aF6++jpZe2D5jtH$2>vzIPC?;q#yF$Lcqe8SINy7cB?{0#Vg@sA(;m8bnveDXlI`qkeX
zl!KqnUmVAey0-VMsqfpYkw%vzjf+AJ3Sfs|K(qL+{USC|CPi3`?Ej#^p?!o#7PV8bcP$#
z+IYv={K|kWe7mxG9lRVjngUN}U^~~S;#U1}Te>8LU$1@+3Gva-MpOG8C^ZHrx
z=S4>SjB+17>F2B5>&3txe*X18f1IDL%fVmC`l#nyXY;SioS(3pA8JC(qn-z5dTz_S
z_m59(|DF7BbUgED=Dlb1J(M}SV(I(zO&L2crn|CVoxN|>hsPiPr#p4?$r;npvur;*
zd!wx%%U_URrOUa#3vbGp?d3Z+$(!@_)tT3JrdQpOxwGFAROUbAKW=KxUFzBgrnP=%
z_>8y5$8X8rc#j{-eDtwz3%m3ln)-gP==X)|r}e{Af8*4D#?=4OssF+BY~$r8etyRm
zz3-jY`SeX$x7N>UKW8(qt&M4ZWa=-brxRxf2AzE`#p8VS^nI*vUq0^{d3dLb0^Pa+HX$t=JxzF|AeW3`PBDbyn34VJJH*x`RS>D>D2dg
z=wqk(si{9R^;=W_z|?>G)W3P^TU&o*nz!Gc<_}K&7fk&(PW?ku|DLIT*VKE%#r?&z
z{;Q^WKL>ptkbD2s|4RCP|FHgVruj9~{;#G#JB@#B+H3Cr?KGDg-#4sl^i*&2LoW^&
zfkx*0rvC3w{okAVe>(NQk-ohDX2v*P1e)`Ia_WC+>VJ9aKYHr_pQ*o;o`2T0-y8hx
z!1ugAlbTg`|9VgUFHK(5^4DhFTjEUrjMb5h_XXlqi^l`U;8}sQt?_&fzWg0GsxJQ-
zgZVk1A-)69Ay#!O&g!zBkHzKt#m0wEdwl%5D8>W+=YD!8$g9Jn!QQ}IR8<3j6rto7~BPn7%RN=4)L4rmW*~
zj71*RH{SU2KVQL?{cpa){yd*PiteN7y+iVc3-^w%dh^zxwT^M(lD;Y(PUyp7{aMS{_c(8%J$Ka^zi*?C
zHUj$31@_0WH;Wx|_VGQR)AhaxhgRc{TmLIP_;f?qkv-$gH^RM}@JKx2f=l@4#&Ie8I_=ykS71+{zSHP3+3g4Z;
zd{?+9!u6XT@a{XsKW7Vj^4vPX2b-@8*rdDsJeuGSW_~!3i(9Ahed+1IGfr*^*im1;
zpQxvuZ;&e+-K1jbtZRa5NkpCHF-!@T`%8LtO)d|c4j
z)rdwHd;EPM(8e`+;p6E*9keGSZvQrkyJJp=8s``O)&e#){@`{I(AT=Ab33>-SP%Hw
zdh6Lm*0e?7EI#?%I*@<9*sFi~RsK24-@g>H_$2S-+(ouGrn%q$w|6+u|Gya%Kg5JT
zG0K_7cQrDvAH4sM310m2fSaBA+4*mW$;lm2^0MHogP#xneLz2+8sC%E(mY3toYnX>
z))PJS^5e|ZKa`%IuL?9{v51e~;(dA0ch^}mFAcO+ak1mh%|T~5lv}O-oXxnpYoAT_
z-QjY0XU2ayHNplRU`W@`t3~ld2hy=T>1G7uj*KTnsNjbPNr--iS31p!_fo7lxB&cVaT?Rluf}WpIdBd;uWhL{`dC3ai|63XA(!_
z(c`M`2>x*F49T-_9DiOOHn2<>}Xh)-%1gPHXJa3H<38|LR>_i$FUXus3pr7i+k49xpi5
z^V@sE#@;~P`*pvuJ>0hLssp#H-indOz6tGHD>-`kjCX%#+>%9s{?gXe>-o_A9_2dW4AYMD|>jvL+e9qFxJOQr}+;~dwl1&d+#0b>k7GO
zjPmi^KqJdvzwUIVdFcCdFl)~FwWhaIoc3-B$l|KM*4&>lU+pvQ``N-c?e#m|^6xj5
zEB5f<+;07?**g;8NIYuI=ffh<@WT(BG?wc#7SmdwrV4k``SpN&?*>1vq|-jmULEk`
zbRceh>qt)JgiTE`CqYvc{&~Z5U-MRzvEv9+Qo!^?hBLU9%vfCXvmc8Qv9(xDK
z(%n0te?hPwGzUjBmh;&b#DAYr
z;*u*ppV`#&fzNWX8Q51B=KVRT+91dOa_lpTj(&!DgXvdue38>f0(#1^v;DJo+s45d
zC%M`d7vHOgPF#@@=WexmrMkd_7{|JhBewPjzY{iaHn)M7+BlZ+@yQl@d?~yy&f*D=
za&cqee9x(4*sXS)ITh$14AhJK=C71ps_y4!PN%ndXHpAfpm$0f#_aN|
z@%ZdvV~oeV-yg1QZ|CQq^s#x%)EmRx_SvklyXp?qANAyY$BFoHWX!+$ul=1_1nRGM
z{P$(N9*Et3xg#T%`gJbj%J6Hqnzdf+mQS|#2e{qMS2`9!edXH=0{O0w8D4%zYSW(j
zmp}fqGta#{?q?eE#>aUr^ex=V9v$M=_)EUF)WS^x8>8$vp4)Z@-Wtet^^KpcY~%b$
zK-L)6g44lh|JKZFzx!gNS5Fs^+YGGD>q5OO0zB(AF{`CfryA^AE*EU*<*zkJ7cThN
z9MAjh>;XR>jl!3wUk});pViOa++X_GTLi5QHd`CyZwc^sW5Aa&4jj_Ue?6a}Ijvux
zl(o%(PdKJ$D>xd^H|CWea9-V+9#bN}>(bFD+V_O9MH;JDonG`Gyxf
z)Cc3k0XbZWN32@c)H}Z9f$Z-M=zdK=-wOlv&NsiV?tZ`L@V|FLTyod%H>=KPd-)xw
z{_~4ZtwCq(HShLXBlfle9P&qVZX@7>_|)DFf&JB7UbFl?Ilel}j=T7(38U>ZSrgB>
zU|&!U{rOmO4+U&qH_eUth$Fn<5Py6*8}xi-=p^&pU_8UOajtgE>Cv<8oX?oKzijN(
z%+7yvME&=yGsfdwd~}G_+17=3;r77ya`x$&*TOs(J9c;eeIRuS&iM7PTBKX<*wbo@
zT{+$e_#>A+b2el4ai+~}(EC(u(0@a)7HIO$79aGZ{fukvhJpO5kv2tIPI6KkIGowdh24B-}29vnAwpF
z@zswEm+NYqkMbagxS)&OMIfhgL63ZSQ|yy1=Z|FE*zNT^E)NH6*Jo#*KOx=HSM`K1
zJc*e-e)=BT?_0kobGF;_XEVT?`nSFtZ*;09`oxJJXGZ^f|3;oF-yE|)*MkTAHGVpA
zM$ef5kMgn|oD8(uk{>zIlYJsr`5dLf|aeBkp*{>06;&rG?nCP(Xm7)D?Cp{??j
zA7ZQzY_Z9fCJuhlA^t_6b^Tbz$Ai5S==rv3T<&&iap%`m;spME$uu?>&*=cy>_cl#
z&K7~jE?+9o|8s$u$*CP&oeAimliz$1KUjaFZ~K;iSHtHK(4|$zc^p^Y;f%#;jvI2#
zsk-TTW4?;jntXbPnj5*~|5`x*{;8+ST<<&7df+^6P6y4I{z~@nN)I{p!5*L4(brDx
z(vP3k>nCQs9*E)AU^D3VG(CBI(~ocb^Ut1N-|<;%ym;&$o#I{u+R?yyYmIT#DW|6b
zeSHuE)Zb6an2+_9Y;iJU{wxBGJ#lYMV|H81dol)k$N!F!c=@1L(|h7^{i&U&(w7hQ
zaA>J#C+6DY3r_!7pw9U1yOFgo2(0nl8hbtGO}a6Vck$s^!)s;KuKR*FvSh}%GhP0f
zO!5CfzO#(y#OgOCE
z=@3J8IH$?+MquvEFy_;VfQ|gs-Y5Kd+59!Q<$S#3INc6wpMS*esj3$a}RfFyl8BVqx$u&$J)W)
zM!*kuU0VdslJQ-ijC-&d@bi3tJ3ft^IYYm5-Z*)Yd%eB-etX6RpF7r*I}?bBziOm@
z@0{Pa``_aYX8+0FUw-km@$ePz_{XXEH`CAe<)QB>
zzUk5T&677=t_2@HaoN1#hulp8d*l7^hN&}e02z7X&sK0>&>G^~ErD9)e}C<$-Y*2?
z*w*InmO9!F#6&+o*sCAT0YB;EqkCWsbd%@npPt6vG(J5VrS$UIxzj=4eB*ZnbUD92
z5UV@+u0V{fQ8AqgoF#KI;8Szryn9o-3hxz}vn#ghaemZg+`Zj&I>R@%M!o#FK2Y!W
z=^`sn?b$95FUxp6z!_QRa8td1IOEM=jGG>Ejh+0J{3MHKxiV(Q*f}t+ZDX>%qvGMa
zb@B9$UXyXZC%FgZgB;$?=_!w$pPlyDJ2Q>>&>Co5z6bF^^Dfib??bI|Yk0aP;18W@
z{O*9C8ji~4o{THg`l?R#wHAsD&vJ^~&589$HI0r-BR
z@sk|AWW|G5YhvUJKaK>>kAf9^{$=p_g>x@tjdX4eo^pgxT*hL=l4wkPHHd1
ztG+dVx$A^MTK?&tv;X@1`*Cl}zrV-da^}}M=L5Wwx2Jtm
z`zjV-(xop6=oPCv;g9|G$Ui&1+P3HW
zoIU*hNPgfg7v|dbG&d&utf|M5`Jq|g_4ag=yMF4u73Q~0{qv??Jl5Sk{cVAF&RkQY
z>ib2(Uy0+dNq=90IhKBWf86)hwX=rBQ6Rfp|VU_}btv2R{=0QgA#6zA*6jxV|~~
zp5X5WzCS%GiD}OMXx8$-C;U8z@23L!#Q(K{+6TG6HQ>9uh;zJ@yS{sUN6Xdu$gBsr
zk`pz<{%rXqS3Cv#-qWWVKfC2-J7XvZpOEo-Aon8&pE3DxHtSMz
zCXj>E0Y1lEJSTI$$jz7w-y7sY&DN&3oBU>AALc&2JZtO0)d8RIBQGC+1zvE>PV0cL
z)!jNcm^F6oHU3YU*2dVM`wZ;V2AjAZZMc1S)-Fs#q|IRf}?aQGzU_Fp8_s-nwyf^<(kH)q=Jo8CDKQhp|_r8q((uaNi
zUHjAD5qwXK-kILHMWDStptqm<-oizo*&Fq?eWvwrKU%yrEz|xF<_Prn|>4GwzG
z%gKCR?*Hm8+>iWTh(3IZUu;*ZuM?B($LIS4-}-Z+bJN+)^mOBspZspF#68xmdN6N{
zAD{8zU_Ae^nLn9t^w3>BugbW3)-vWt{XUbi7{%(0Sm$pJeewp?`KF8;+rEtH^bYau
znd;oi*||>oM*EA*wejA9{l)sP{^y<@5{Kn_1_{nl65}%?xFFmyuK~t8w2Nk7FyqkK{hr5
zK2-KX#y14~vHq#Sy90K=KSmene=~SX@Zw-QsJ;xBG4i>!kbg4o^3TX_&N`cPe{;Tz
zrn@Zn6SME}e=T!*yti~Y^Nm?!3!l$V&v$Poo$ftO^x!*W#FkC1L(>G
zZOjKf&4IJ{WS{8xPM^%2?5P!dczr8d
zDHcAf9e%qvyY;tcZ-1~J$RR!ILHo+79@GNcY8=1Eg5v@CF^6JR1I-UEtvTPd`l*I+
zl2Dd4pKj?d{}(1{7lV=aRoq?|8UC|XS#gVb5oqT4SOgk5ezbo<#&Ru2YdHQtCyvEy
z{@65UM-x};>HnJc)DvGu-QpZE+7j!r0GDjjN4C7ZJ7c_^4)~!a^lZN^(8OsUkM{YX
zSHnKrt#1V6R;}Nk^#@~wPBI#~%HzZMWWbm4KGUt{e0SpeD*a^61?og>9apclvw=C^
zjrl(RcX-&5>$O0vx(6b@N
zcLw_kG0G
z+O+m?dhw8@$D7W^g@Eq**q$9Ve0^|jpdN65V>wv_THn(7x;XGD_Z)j=y7hp4`Kcf5
z(CtqC&B%4$`2PQU^uhNCC+k7;qmJac_1m0`eeVdaf4A;P@9rWtwDHc&>tozgxBtEG
z5nkK}wdwnhdEd5&GhTIf9>}_w-D!3HXcBQe{o#NPXWX^kDYB;nc{&xG4CKvOzyHVP
zMz9_9j63X1@7|Tpc^BMQ?<&6K*;)K90*#)o^J5Wc?yEgIR^8dVv(A6<)R%ehJLJAV
ztN-pZU-;!acKte&aee7n9iN@n$1(rQ!8j&Eho0{Bp!($zcN)&bTzm6=H@}_nuD1@H
z!%ye(Uf_pqjcvK~ru|?XKAPU=5AHfXmhtgGjcE4v#~anD}xc(EJ;&
zt;1i4^t@Q<7B7?w@p_xto9~H_
z&wQBgl^gt&
z9iPmYp4J>bHiG&sFZH|U`WbjJd-RZTp7K|wTMzij-~J3!EL#EDMWFF*K7TTOWBk|T
zy!iii?2df=of#j8BBM4Ni@vdxkH+F|?-t8w8)t0)@MO!Lns`s3nQKP_>o~-zw@i%Y
zYN~Z&t#_kq`VkLhj#F{VwfY@>>b)dGzea`*zW&{bCw^$;TK_*X?a?bwbg8-BV&W?s
z(3q?l>%rO4=S)Ay=da7!p1{wX{La8vrx#OoWq4V~S7gjLx&HFNxzoYOSM|^V{L_#3
ztJ7Q67**!3e9Y^(hreG2y!
zPhu0RIu_ITeWrWvEuOlMi@T?_t@LtGp6Db`r`YtJduKk7!+a)BkNoc3gq^!tee`I!
zBIivPn_e4Z9yuWUo~6W&&xS{X(6O}3Z+UBMYN2u2Q={F(i5%jD-Z5r6<=kMtTYXcm4Z#M#ZUJ$$__{2cIemwq&^M(Mo);_Re?I%{O
z{p4(|9Jmwo{QcQJZcYXK!@&sO@%s;AQ|v{iOFlQ#+yAL)-+6fw
zdu_3c_wP$#lr#Hk2{#%YKOG(P;!`Y|^?$fx{h8*HP5SwEHo(=HKuw
ztv&vd6QAEdR1Z*|=Ii45N0Fls2l&DP`*Qm;*&FL7OCM6*s_?bwz&rio7O%L)%dS}E
z$hc59ay!PRKE&IY%*FGwQ#^9kc<8^9Ejq^En`n*9*XaMp(a$fs_XT{SoB!uTrw(c03lz7upkFTnfH$KIG%YyV`nCML10y2rcSP4NN$
zo3p50=4s>s-){|i|8VdN5hQz4z-H}#C_4Y?OlQ=7NSw;JoVR{oHu-rb{i+(a2DtDU
zESA=*HSvyfJp8jPx{o+e5AGu!_}Ip4B$?+V8F=-e0Bt8C|=oi(}V2Tt9mMW8K~|G%?;KI01k{%}VBoTF>A#+E&{?w`i1
zVl0npbUcIS(RVSYB$r&BPTzbr4*ami20hi={mx&Uz4|XtY|tmy&dzgAue^^sk7rJw
zb9izNXKI$8+D5?N`C9LU_%!Fc<}=~CpnjQ!_)kh^hc(-oQ*l*2VeIETS4nQ
z!^^cYzgxI$4!vDs*7v;mg@7(&?OebHduOKJcoAro?RzH=xGqoQ`+_ID^J`oudny=v
zW7zTc*;l=fKl%3iJLjZLaR1oPBd>h!
z@5}4`{(QdQ^E;Oj&y#^Mv6CBb3GgsqF9!D1SNq(}&XPPOYrOCE-2tsvX)CV_I#wOy
zvw#h+4aBkYwRvtsZTUcce8l=$iJW#q8$QuH>r
z@NLc2pyx$yDY&|@Zsl1v{rni&Y{NT0_3sYEX30;SJvp%U&frX7FP-LY4(4;^+F3Ry
zcX4g+vA{bdU-{SCxezyfeBi}%Noh|1m9!56j>k3j<7l3fo|p9Tn;*Cu^YNR~SJ-c@
zvuJJ4<2YuooODOYNph{f6s!V;4!pNsrLB}Jb0b&V>ElX#et#e@$P**}sLPAJ(EJ+P
z9h=v?SwGJ`ywmrpKpAg-
z;P${eV5_~&n`fsz0ykrSshuT{kmD3@WsFYHCa3=QU76mwe(UBCyK!vZFMo0ue-8#Y
z9G}ZL>AKx%o?Rm!>8^89-pb9!P%Uq73KThXLqO)`;A-%uz_`7}`^@j0{l?kXJzt)7
z?Hp~cP1g3gX0Q042-r5ZQKy-yv`T(iFG*jc}{q3h%Z8@&&IVL(4Sb_1M|<4pBlviD?A|M6su
z48F;q=LTdbY8!6YrY@?lHqbYYy(ay)1osC2K8J0U`n>^N7XrS$Jq+%kl#xk=Wm_*>?e~y|0TcwY7L(|_VvS<*clhgyQlGv+5Zpo
zyS7i9*0A}VQ{Vl8Q`~m{lQTEk^XvItVD{b-;7|F*d|3aQUwi-izbp9U{2ugM0^?+m
z|2^45M&-*vdYmz9#O!zF_n~W}J;(EV()6&!-o_sfm2>kn?inuj?gPa=aAV*u`-Loa
zZ@e%L-uu%xe}CDu^Z=bwP}v*gmIBScV6Q%@?xBPyeRc$v~P^vZq~Rjwt_hid;ahJ
zE+aeSK;@0xRwpj4DJSEa>O7e559o`iYqCcBtFQdlrcG<+es%rmpZF?cJn$-a=v&I2
z4^=;Y@KHNPyEmOTylt{!$v^U!d=bay4gZfM`;76`J!S4`fp?k*0%zs5!50Nz8tex0
zMUIbcai@>o#viAi<>jz?=i~C#IVYo>%yW9lcR60Y&d{UTv!uuU`kSGr`CI#!Y`N(G
zTgvg==brsdTzbBD%~IaraqnDQx4s+6e{ygpcvhg)-Z5{*kKF4mNa>m@X)nd5HhidS
z`9I!`^PD;;*LJgi)4fObrt>Lwl|A~;$EDoC$DHS$6CCkjl+*K>;VBM#-;;7SJv%O#
zNa@+0$A8HNd8RZb;~w^nu^^WX&9B4o+Ssd={bIw1@;Ay}l7Um}!5tzdY&{kzwQ;_t
z9Q6I+FnhXY9;++S(_A<>R(pSA*L$A#1n*;?7W|&z4+Y9&6*nUrl(4|&a*CHtL=o)NyS0;TWM
z_VSCI+H9`+UO&@k%~mkqU*F`L@@Ra+5gXXDly~)SKbf1(MC~GDDKFV8)_7uruNiQ0
zU9hzN@OixV&MVer^6NRl>x13ke84tk=}wXR>^N>g%98J!e6A1WO+Je~8MU9^V{Y2h
zd|MhnI$Q7FVPA8(I+|;wyXU)L!x@
z!;cv6-ukl?6Lya=;q&}{t(?Xd=liX>E%Ubr?hx2}pFFnCKm6eEuE6)*b_03CH*4qd
z#B&n}!>d&V_?f3}8i*9V(qyVt~tkBtL)H3zV;w}a~`kk
zBTw!u$s282k|&OAWE&p3{<^g1>-XOO_TD?JmxJB`aa&$SS=$-M2U+ttKbrN~e(m`<
zKGWq5`SNmZ>&QKymblOG^e*+m_u4Zv=d+aB-Q2I;@rL5nHh6mQoPh728oVU?%jrjB#NPtO7+W8Y8}q@vQ8t8D9m;7>lkyzBjdKi*r5NQkkQi(}!5Y#)IT|2RdjC
zIqddXoE%}tL3_OW9<)Y29JEHx(S6X`E7Q71W8=wv_UvZvd~ht7=c==Dm|Pw2Am0yL
z;_&(f`OXc!^Yce1zMLOLj#`5ou+OvBnkBoto}3H8k>HmW?vl#q=UjemAYZA>y=TSV
zXLk0NzoY9_A6PfqT3OXsS@SjJ?XJjjpVU91dp7Jj8*CX&nLoRnsi&=H9=T_UH_O=K
z%#ZTNwR4-u$LDB!V^RMOE35wPMxGobcb9_F77ejxbK;Kzf18vN_P%i>m0KCaKurncqy;5Qq~3!h*WC`<3&
zc;|OiEzUPz$*CUa!~N(UrEe#g-$Cvf>&=rPPWIVTJH*o*{nnbhFtwjOiy1rZ|4?LB
z-zHlhZ@KlooYn9BcoWZ&=fmvb-+p_>yQJ}H-qgl120uFeJjT~X?mSNAbZ*zEqr6u3
z+}@YFo54UaWXd?_zWxmvyTy>VH}pC!)4csKCOxqj9@l0H9|&J??v
zyW_d*{q>&V=Z^aB*!65Z7L-Tw=l1ezKVRs#kBtY#SeyI07
z=1Tg9IhSmzkIe}+&doLUeV4cPXfR)kOZw&9ZqU3q49`9%s15UY@_}42Q+jU3cc&XO
zZjIcyEx0|P7si~iw|5k|%r|DO@O
zHne#%W4}`V<~sJTicwgRQ=<*)ptw_h_{pZ0ux<2rB9&tzf(>mU6;6Wz_NgGaY=8KXV`Cs80{r%NKboSDRn#8rw(GZ|?BhXR=Fi#l?Ir
zUN^0s+qIN$_Vbn8F}IdD;qUdqT<&-#@in)x@f&51`TAJ+h2t@|d+x}d+uQtUj&-eg
zDdx!=bM|EV{O_8^t847({E|Mp?2)%4&-%@^JsuzVdGJ#+@8_1te?ef)gTe0(-Wa?k
z_@lwQ0;P62Ct@M*>1LZ;R4xVd)*kIupp56j9+*EfN7?75HIG)doIOZ3UPil@d^>%J
zHS9e|jx|f?sD3T!KFsIB-W@mTzK}U*#lIIc-t`Bqf7v0|H~!v*`6gE@dpB**Z}~jW
zSNYJhVcuSS`^EdZV81=`z$+mA?CywHM
zeZVH=-^HersoVdFS>I=>}iz$Kg{}X
zPhXt6{_|%2Po4Vwv<9C$Ga0`)`+58yob~_otpB$3y(3iT=gj7xlm2Mae>?kks6H(}
zUqAZvlhe=Flc)T^tp9NO&ZK;;&R@>I?`7=fVeDrzHp=}w>5q22VK(pIA{*B~W7hxJ
zS^sa%eqP_dX*TYE@~r>G)6etQuP4m<|3`jjVBG(wX8n(t^?y0PYcQ_=d$az#XZ=5#
z{^wn~||K9wL!>I3<(r+Bp?nAjNpY`2!>N8XAEOnjw_NlK8cTcsS4beY6
z)$TU^?OA=})E9H}Po3&Jr~3I*ecM!5jyu76cZ9n0?AQ18z4}>G?Pr(tJO9AczhkPq
zzk2KU)2I3R^TOHsi|PA01N)Ved)2ky*^}RQ2kiO9kow}(H|L8|>v8A40(Lpa^KpJY
zF>rslGx6n~(|6aZ-2>*d&FRY#&j)*PWK3My>KUWZd0jBqX?^9}#|C{lLB^=dxUqhH
zp}!OKdE(x!z1GaX9><@u$(H(99@xVUHk=Kr%QJv{y7;^b6mt1H_mMmt?Y(dA{rt$8
z^q&{JDER!~O9O>2GRVa#AImBG*h8LrgnXkzZExkU(K@lfzamex<%gelP`duGdg(b4
zcve?O?Wr!gHtKp#`U-#O;Sc{BbFr;F;~-{719G+kHse{bpB($u^fza`H?Yh2m@^$;
zWt=>6$tRaj3VFC3wv&hMEezMM(-%9y*~KuF4A?Ol?~#@flgF~{CSc*^`-;&J4{`_Gc>RmP76WU^h}
z;#_&GY`!kCMw>r%E&X7d8^2Z7Uq8vHjoz1(O*WRZ#$0_e5c`{gB`z*z{CF_hYMnCY
zcYZg>Yn-ow6T!%*I4DcGkHb2HQIp#N6eA^1>QS(il747=1#^s0dp21%6uwN`|
zLt~@HyE*cAg84Jge05tdFD?d(cZ#Ka6aP`Kwj8p*9PT}v_kMod_fl^U@Tzpbe)p*7
zd@k8*9n{8=Uz{toVZ7(vInDDUY1^k3i>C+5VeIO8VZ)|;uYJw4#@}6~?3Z7akJFKl
zzE`g@P9FQopXXBJDdzHxoDcP0>3Qc5d7I*lF0%gCvstxpdE;tVd*~FGH2l2%ARWQ%N
zH)c#}&ft(vHsKP71f^?5(u*#>21(|HIrX<%<1dOviggP8{}LVcVR8
z!@jRHN9^YxU-_rsGsQ=?*8j!{=XjDI^vNr{uwC)Y;_Lh!X|9v(>Li2Smjxt|<^2t>
z7lKa>-W4cv;#=3P|pxuTXQqy6(UE>HOIWcHlSZKjh=b3M(2
za%P<}&jUV=G2<(FtH5~}V_%tS{<38}EB1gXg+*=;zHX4U953B!T#>pgGZ02!m4w|#4`N$W(E&0Tk
z`pZ6Nk8krcIG!!BQ0n93VFzBy@j?3bo*N(dS_gN&=D|G~%_qL%WIGT~u~O>CVb;%M
zYp=062RIc2v81yx)UQo_-nj$$ctb#*SQ%5gc8p!$VV9n9&)?hjL3aT@@xqqg-E1mX
z_*eye8SlBLrmx5i>)E3o<*|7u=zYV!)4}}gSD)M(?O3J16^we>r7Zd1T;%_;z&^3V
z8T*xviFwb3wQRsIKF#rqFH3jxJf@zdl`FntX+Jsa)F0zyEnbbo#X!NAGrBvq**w?9
zPJ8flBEYXcj?V@5&-bup+^1dr<#8|P_I_r|8F^;#Kw$iHgEs^Z1@8>LCHM=$Uk`pF
z_&0%4S);FPqN``BJc-GV1xoF+pKY)Tlrf+9N|v~7+H)jxbl`!G?+%pOb~Wvlft1nC
zxokSvd^8|$D-W9chP`%Y)P`;MhO?t93ll%;*nLih1^-1i2X
zQkM2PXWi$18TW~`vb2vrJk8H9e~$;FoX<>OS(0-@#;acrkNYm$l(Mu>j(6Y5w8wqV
zvMFV0pLOgW_lxhiU!E%S{qBTKKFiZlhR+0)xs3ZW#@O9nzzng=k73i@k{1)(|T=w+3U>clUZBvY>vI=
z>2dbi=nj^r3O~1kxu4dLe%_KkU&Or6#d+S+&rZ7S9eJ%@HY@bDU0v4Lw|95$eP5YO
zF*DaYB+a$2D~*&&$hdv@%-?>MXG_^i~PQ8te7@BAv(
zA6>UT_I^iu{>t_1e8
z&Dt^F^~q(2y83t0p2tWG$WcST&I%1{z1O9t_peQQM?dVFf9*nd^)z4g<;$i!qdd&{
zBMTp^;8@_!W(IrSHQBQi8~Yv&2VIM&#$}9$IN*VPywLxqN&kL)m@60FXWbvCg2VVL
z-lM;-ne@p$c9PY1d-gBsamJ4aP
z6}fVF%K5JiYVR@GO>W
z5HshzvDybpRlv-4+hFX`^011_oeGyAMDd6+mB~`ZTDU@+Wt9{tR)-DGu!3DXaoC|
zM-%I%c!~?#8b>LZ@;GZ_PO>eGSGA72n$4c-!bWALrPUkrXYP%Z~-;SXELRTttr
zfA+d_*nTnKAKtbCy#8RI)IMC|2?zG=1oJ$S+xC}#a^4*%o9vr^9kNMw{b1{{V6^p}
z6r^m@VK4vZ_t2>8uFQL$HJ0?qnNiQ1(pToWjrUD{G#@tQz$$y`rRQjXv)2a7qvc-C
zk|UPnd|IGvlEYUq!^^nOn6lqKvHw=YrpN_rM;T8wk+Po*dd73h=IucFP-5BG9hB?h
z#n!EWPPLpGeQDD&yqC;f42}lp19?r3wz0XbeB?Wut*}NOD|C|0X7#9(%{zhI
z7|)Y+>>`6tt3VM0vc&)=iZWRk_c
z>Kt>>91fLD@~r2h{nj^*IN9_WinaJ2_t;w=Uz)Z&VVCi8!MAcDp7xg)T-bvP@zO3Q
z$J17t2XjuWC#&4hNgmnT!IE9oYDE;
zCAm3cyMaANg9nH9k+jJs7ms{fis|z*u8^@6%=d}orhV3S-`rk21dPf^p>61who;@4?Mqtc3`*2GxdFKN1)lV<|@|a$BDtxuR9Pk_J4>|S6SnW8O
zHrf0Xquzzbr#2h=+;9iT?ef#L^!C1It2ViO)+V3ba;1GWKghZzpl8#WvzG1kneEEl
z=OY;ddaa?8Zu|7rAm{e)cbBOraO=N4a>f+{SS9
zgWYtHH?~*lE48idBWYaFNy$H%`-s2wGXJ|r|J!W-JEos|ppOjpyl%GU{#pOlS^r~a
z{p-@NJhuH>zE3G8ElVv-y
zm%m{|5Bt<|LJjna@t>Uiouh}QJ$;6_OUl&)v$ao8pUnFDs|g4n^_9PwzOzZ6@0+MS
z1FHKw^EZ{oxtpdno_AgI>G}Ia*39Sl_qS(%o9NqT{Xdkxz4bvn9?IV*8tpLl#k0Rz
z^y%r>Zl7~oza7-3e>D4>Lw|18fBUTe;H>{E`I|&zj%>~TX3@X-l|38JOuBEKbo2Q~
z|KlS$zJJy~JL`YjFF$hq_vH_kjWK%XtpAy_{zuRHznXu512?$9-ER7$ya#6eQ?ve&
zS^qcQ^MM%Q*?GrJbM{=?#z!u?PJR0{uMKxk^~X>3>8UC=4udEspR#q>Ql?N?6j
zRo8xQP44@C0ejvPQoZ|sR1UuL$Op0XPU}5RaW_9PFy}5&dj@t)`zr%`%|IDd@~Jz@2_QIoEz=!U4VOg<-4^z0h@n49pmGf
z(B`Lj+IL~9@0!lP^H5pxfd9MG*j&!pjFU6Ye{uTs+v{A_r;BM@%dY(s^vqS!jcKl!e743*A>$?%}AU3$e{rh50AZMxJI8}
z{H@*gDUBi9o$-$f*y}7_2&~Ji@3r4&eMb7??|!%=sGPr+HQI8k&-bfov*~moPaX)C
z?68kcaTxPydm3xLuF|L5dK`6qZ6AH}-2U!B;iG%&3j=(zU3~vbNF$^2FQ#2ta-Xho
zel?BNUi)4jkiQd*Yss>op8sb-&ypX;=-m!RS*!HB-m}EqVR@2MU0>fup7=sm?QdKB
zH?41elG`?Ze>RZse=tzwlhT;eCC+T>`Oxm(t`oZ_WwX4oUd&De%}sh&fx_PA75Phh
zueUIzzTxoYLFL|z=fTR@#+g{!%h!jq)|kF{eEm$;>(j@B
zd#`(5lQHiw-SgY0HSPbWeEvd5*U#zQha?4#74PHUi-~A{(yLIGb%-{HkRYpJ9ym<$9dZ{^N-~-?~mbaAgmB`p&P<*XIWKQ}8VQ=Gfuf*wdJi)%)j6+T`++
zoR0Iy_{#%xHwE^QJAw}5)x|Cx;SRTKd2_gxANK|}3gO*w>uLle4gudKDb@P
z+J7}|u)0w*{OY*pYuf8INJ{H2o!$Pqudwp
zm7hQ#+t|V<>#T3SEv>h&>#bW_FQ@qWwShaa>+$qx*5hGZuU%jE{64XMmW@7teAe*m
zGlSO#O8pR9nEP$bsAp-tyS9F8;%SsGXS#mQ)1}ObJ3Z=g-;L?pXM7cuGqtj08=k6b
z&e_uXF@|#XAm7Ea@;z@3TJOAe{qbS_cs6jzZ+XqP@vM0E-n^k2eRm|!OETUZ8M~?Bm4W-ibGY)@hUYg0&J^w*46I|5@{XYQm3-6o@*9LO+>CvZGpB?(_(r2eWyY=~@&o6y`>hoJ45BhkLL-O!d$)S!}gG+tf>f>5}
zJJ1&keX-F$KJ~>--x)D4ruxp9zIf})Gkv*mWopZj%TxPY>Pu5wPTdzgH*kKG<|8}n
z!}kwg1L4HD9R8AwUrp^iyd}6dIGP2k)b9=WX05WDwPXJU=|3^!Z0-2bw4XNV!nM7|
z{^xu>WvxC=|7iO3dafvAo898jy?1GXI)c|Guf;+-Qv3Z_ddv
zGR5bK*~2ID=)zfZ%{ZUsTxB%Rx~6$6PsQemfnuD#X9ru^^y1WiP{31O8t_9AUwgz>
z4RTf<%Nusx9mo;ecLTX#{I=lsshw)Q=Z>i_7C)DKR#$dqjQhyL6VNH=t_%3X4l$CC
z>|!gsF9u5U&pvs(6;w98Y_x}LHjwqQfE03Ys2+jC&zOyk^X$dtD+6WDpYzS03juq6
zJRGoH98Uz=_&*+qKfAhM6l;ttwVf_L=*t6paKKl4@kXX~m1*9%`8xxp^4L1(
zSDx8F=U6OG1?8MPcb{^QJo8KP*#A3&=Hp!ck<3+Jn(MU=pmBToEw=8^V}UzOTQ1KKkuz&b6kOjNPCz)4XPDbKIFTFZaom&(0CKZwlsewlb!?BWNDc
z>1^~oUP}97;Ea$t=72ryqVv^((pb|apX3P{>STOJ2stDa^%F49Qx%2-y1(?0xxo9KbibmlF7E-
zAGlqT@vMyd_s|qPTnPB(XB6!>b$4K#?SC)he3WZ!Cf^+SKb7|(K2*jJr*FSIoiF3s
zXHD-;UHh@=KXKUmThe!S*@OeneDm7p0yb##iB9da0e#wM0yb)&4%nbASIE`g33?9o
zx2L}R(7$Es(`DUQo9C19>c@wEZQ!qd?eM(PuPrxE{o3Q5!~Bg?EeGj2?AH#phaCIJ
zC669`diB|%&o2Gu2)p(9VV+<5<;mAj#>K(7yw?{aeSGQTPk%em_uf%C`p2ifSm<9r
z^~Fiw`L$kdsKxcl)E4i{Q~O+M=fxWNabNJ<;I=?%&gkDB$loKucz4>ve&@&M>&_B?
zd;Z-Qa@#rS_k8h!1HAD8k1q>Y&UXH)#ZkQ*u!W!c)hVBvJGdo_jXle3IU7{oxKE7O
zY3$_BSr_U!P!A;oS}o($c?TUdCl;(XT`l~Uzfzd7oXTHR(A#BDps8{e=)#iW1r?a
z_FEb$mjgLxEpEuum&@|MF{n%&j(a+8A6*JR*doX2(I%hV<~Ki&2Z|iI5YY8gc@D6Z
ze)ooTwUrKQ&jw`9IWo5s@PnSp^gY?ROq?k8fShbTRA1%sxw7)3%I|mP=K9N%wa&ni
zSRpU)b3>qg7-ZSCb1~i({88{o$2fN^{oMfH#@XF>3;X!~9od9W{J2-hxftMK%nkFE
z-I{OYuz%!4ek!}wZr|WUt9XDt37-+Uz>2NU%L+b?8T*hYIYs=*()cl
zw-;`j`j6E!n7`!npZwqKXR#R5FPG>S|0`2lUR<8q=Tcvq+VaRn;xKjLG}|Jbm_+=C%EON0O)f
zBwJnH>EMrfMV@FsJGef{=4}6U!B26&u!Jr4$w>t#)m_t-JRyhR^A*WEbp%@ez0FYxR=OoZs18?IG1vQ-)y=X
z;O+WA>7BJ&_x5a|Z~m;PUB@%WF7j7_Ql9L?51VlAPXENzBiJ+cm)co!O^)Z3@4-W~@5xWj~qpKGyL&7Mb(-;p{}9@Q>cw%YOE`W5tzyYIbc0?iJiVRx(d*kcq42
zQkvK7+{>lyHD`D$&JOL4J>K=mnRiH~d_I&mp80SjaPFF~x1_Bs<*Rs!foF?-m8W*b
z`9v;R3K?%*xAx+qNf*7&H5>f!Z_p
zLcoT9oI8xIa$b&Azi0A^Kz%ZBXN>a~(^tkE{Gs*8-t%cm@1D(je>dvptd*>Ok4V
z`{Ut14oCk_r_Zh>|J^wkrup~feU1Ot?F4cPH~3ZaedNaYDj-|_z{NljhuR@Wmbmf$
zrpQG)8xL~&HB94ezVG#NkR6>{rLEA3cfQk2=XRiwJ^JeV&18`i(4G>Q@rRu6___B&ej{VcRUO3Ofj6x
z+wV@GZxtwX+0R#cw9DZ<&Sx@rDiDh?X3bgru&=S=Q`?Q($7PKCa{)UZZ+^T#@Conu
z#1p&Nz*aoT9X0!VUUt%Evv&-<@Y{O07$~^g3VyS=_g>$F-P=$?;$*COt#en%5U!d*mA1
zR)OM7ir1rg&$yEH{3oBxp3U};O>@mH`f8JW+KbC?S<7J8O~E~Ze0)vthT!XhZw|gU
z_=mx6AgBIOpojrkJxgrBl{G&WDCDuTyxGIXO=sAgocD}SI|KYX6Y#A`yV191ceKZ*D{-*Sm(Qfw7pJ_|-tmBtEm#wRSedN=_&bI~%KCEZ2x_j$8
zyKf1W^sF*|EEwg!K7Hk}virKo8s$4j%3%O!1&D8hdr`Kc5jS
z@o_QZ#{+usjpy3~Wwe(Zd2t~)5}cXdljnEorrZ>xRUkJPRRDBails&=ro_mO%j-e)pSzWJ`96E`^N*J9TAoD4q-d&(_;*z+lY@?XoI
zqtT6@+9QTa?P=`vm+pdcVXk*XITP#7uhLd>a+%DW8BJ{+WM;j?i*vd
z-gfiSvzbgbkSEU%%1ybr6Ob`Ke`GaRmwY>)d3?@wG{@|n=f6JND)&;_&8_m`nP`=D
z-f3|G8j(4`%3t
zY?NQ@p~pTl+30QtxnYcba(xvjtM&i)-p`!dtw8Rvf1Z2gh3y}D?j2u0$Jm0e=L9ba
zzBKqp!83!CNsxO}<7pKr?rDW@#>X6T7WuW5Lw`TxO3w`+*iVjn9>eQ1MwYpy9O`@R
z)y(6uckl@Qo_$W55_wJg#c;A`vCEyK5_Q_#6NH%Vqn|{y49e}&?+2?}VUio+?
zSh5?RUDtP&RmPO^IO=rf=63l$u~Ofba)TXmM{Y0KH^y-8r!y}1f6Ip4uYI)_H;1{e
zs&gr)#{24cjqSGv
z?h(1&HGBEH_gS@gZU^qA7Y1(%l;$pZ&8_lO{={m2Mn?T|2A1wGcZSluXWLRN`9MZ<
zT@3u}gRxa`G#KOi8R;t@irnV5GgrN@a{@%sn
zV_q!hy2Wken=I$)iTj)&pdm;z6G|?b^O{uAhr>*~|Bq
zUz2UU{9(s-K(~E(9QS>4`U*YG3-y?L&41(GQ}#R0?j>bEc^5Lj6UawrkS_LBe$OD=
zt9zBUSg`$Q;JmOyDW9Xyy$|?&EEs(j17#Dp?(%W{$eA-Qrj3F8YnwmLmo;oU7n}&@
zc~hUsou4(fkvaN~msOz1MgHtgZCohU*h9B-{^^QisC$DMEQnLvD+59LYD
zja;OAjYD}g&dqshJj=<*k^5qaAGYA7-0emLpJNSy=>w`ZT{Mq1pgTEX6RG?HAn{dg;+XFt9ce=&gy=bo@
zUhK19ZLj#)e>PY;U)HSxvdBCdkoi4!|5h}<=H5Q
zZOW1yYd6Vp)})*QcPgNZJ>}`h6Smj+ekNn`-97f|;6xOh4n8q>S@62xyMiAL
zelB=l@X<%}a|gj^244_76#V(%UkAS!9F6fe2Iqsz!K;HW2)-wV71@14Nu09*mowh{!;$@JG3$Hp
zn2Y8*u09!<7ZbY1dyB2sUkpOST0gb?`@u;+ee|<~-SXvGfnv^BIWWg3epk*j(k6Rp
zP3TL^2Q#ib6!4XN
zYs-y$L|okKJHec5amLG-7cWd-DVO|o2Fa}b{9-#FJwHzc;(ALUuI9>t+Wt*8n5RR&
zHcwY+E9K1o&hf$5x}FhiIvpIej=d*>?Vz@?m)=#NRE9Xtbw%CU{_0}uJcibcJU$7r
zDVG8=@ks}rVsar6tG||?aco>}N}mqvH=U=
z={Y{r^EW0vIO|=;7jcven{ru<#~6I~BuAd`l{~exa&Lftob?`&zqaVhOY+omWk21`
z9qZ@0gF}1C6x+^^cFHGu>+dGrrxx~)a>&>X8rRW6u9!`NpE}8pd&?_IzTK{cP5j2Vb;-
zkMZ5#e#_*XSg}JMj6aJ-rZr^ZWoiBRv+DcpxA&m9`V3>_{y8?K;I!wW=gb{@V=&tI
z)M>p~(A9iU%Nai4*q-K@uQ_&tRiKP__tEtEe)A-^_e156G8>orSUXqQ@0maPb!>xQ
z7qX7dH|Ot-&rbHi-VdhIeL0(i%rMX
zy|2iwE^)SAzSuioKjsddbkHkD6#lXgzqoU5J~>eMbu}=4OJL1zAQ$K%ujj?Oj*+Rb
zv0o3cgP+?0PORtOd@UdG#HUrDbPc<`8-7F#Sfy50>;Lbqv1iN^=S~@Ue>6E?-&T=<
zbFz;HI65-*)#Y`xv+a=se6kULVx^WN*9YV`rgHII;EdlE+#b*a%|UU*DVt6O%^h_)
zG~Tuve`7xAvq{YsbK}>JwDGrOi<}s3DW`0$Eo`sem!&O>kLCZKea{R&IiQ1Y
zIGEqx__5y^ah_HIJ-{wGCAMUYJoRpn3*C#C%IiFtJ%62F;>{X+@FaHh(@FoWQ+q!j
zHp#3{;xPJz2lC0Jn;&=;fB8PXx2)2?B^dYP2A|e9567IGpRaS%+EnXU^ObJ3^9=ZD
zzI5C(?NqP|6#26iG=JCuVq*_`$YHB}?aMiBK3Z$8InNKd<8M6}`=sD&9|ewOt^6g&
zJI2!jrSWRLr(KU>+a7XKd$#x+;dUj+*8+1%K)womN!@umNwsn1^h
z@0t2!>sN34@1ExIYyQs!b6=m4F{M7L%dvQjKD$%lRKTVspWP#LeSOdzvyM!%n`^7I
zmHIp9fsFdkW_>wteR=(osm~VkbN|0+ny>#4rcc)8ps{*I+6vo@wI2OGk#TpCz4X@}
zI&pm|z*YD5KAGPec-kH^U(ff-wEswe
zGrY5p?+W?iW6ZiSPF=IgxKe(MI|uq=O~%JgHrDUf4`t3>gmc_o4&(+s;vpyN7u&xu
zu%4Yn)&@En1GehdhQ_4x_KoY?mw(!9;43?v#o8fv$DFgaKDQ?KX9J}^xatG^`7A$91?1p$l=C;!SJ*D@#mjyQfk0^o2Pwq{^l`ZYdLMMG(XL)f<8ZwrY+uby}Eji
zn~O{De)5H1=K@^b7Tg|?1N0pW*nu;B^677%3~hG~pUi1r3E1GCmkn%`tIB@9pUM1A
z;B3wFQNFuV=vV~`d&uTLy$bns%cGtTJdFIz`RcP+-92(0M()I^oc8>S!{vbO&I{dh
zF3p!m_VEF4_%DC>WwSYYjaQfcsE-W#js?eqxjwSkvZPaN<~qyycvc%zbveNW+4R;n
zHuF#2JD;titghvUbz^_@3m^RA(-M!>UBC1nO-}NqKG1_}{Yz6_KkL(I=RtXJA~Fuj
zgAd1kHqK)qmh56L*?ej&$MaKv)ICFw);Ide-<0FyS$AhSZ{jJAW4?_xF6GGitltVY
z?I*iF&iC8X{qr-yJ~z>^)W-vMiT7?`k9*|7p}k4J7;Ms?scZT-?LVyjWcA*-lr|3W
zsb)9K^M4%2bMKj@@r#*P_>Pk~Uu2&M_B(4QGvC;jG`h1AX?>+jSl1llFx`EZ)8F^KsqNXDq(kKFnQqbyz>jl3VTfe#52soe9k2Va_?;
z8fU!2oG-qv0)_AVoXaUs`^C<_rP#Ss#ExEaZVKqsXP;U=8RI_~tG`RnNO7p|o9>Up
z*lh2T&EhuNd?x)(HutXNe{DXD56829?n8#wXS8=o&m`V&4d_tpo3Am~HS_pg%G{>d
zRo32pyZ7_(w`Bb@g69XuKR0+o@KEs1;9G*f5d2W^4}yOcDAhwIeK4LaamC{*P{#MI
zAKM%HAQ|}WS>@MGFn=GQXB9Y?qs+gQzEU6QZ@g|#n=N8?G_cQp?{eQBD06>CTh3;F
zKU=mkKicvR0#lZ35x3eRj-xGawJBw3-?@x;-*st^``&0%%F@0YGTwdHr#uQ1_dRF5>yi5|WK2x&*>G1oL!%7&
zrHr~OLIvw~N`m?i$4r3Pr<=@5+xmVweefPji-r6UQe=$G5G_Kp7^`Dh~_j#U>Z{Pd=^PU|YW5rP@{ypiBx?eKwC-=5N?hpTm
zJ)Irn%kRrr`6dt8@NK`ex3*)}{;~J$jX87G{R_YNNZmg^>z_`a9ZwtfJoy*)#_k@*
z-t+GtDd&r3{q6M0@jcV({`LIw*?4w-KIeJlVLN?$>ffDd>u*mrIr^S;YP_h~s&?Mg
zbgF&7P%92nPm9_o8Osqdd^&uslyO||=+P5e>DSiC#`z~2)yMu*&aXZm7uA|T%!
ze#;#>a9yBy&Up90`A24vueUxX7mFD2Lym&y$j;QhFEyF`XNx&^5&iTSr`O%rcWkl!
z9hubU@0AGs%G9RpZ_|KN(8-@$X5=Q(s3P
z$x|5*bjc0zeqON7!`R9PF*_FEfM5LPzqw}w=AIIegCDZ*3C1yT_-`Ul-ku4nb4e!u
z$xz#O!-joqU^koCQk!t`t`H{vLlywQ{VoZvVR`?av@*mve-oyndMv`=XvC=-yw{%)6W7#{F;BdZcgV(sc|so27R7k
zY^y%~R|K99y&vo&n~X1F+M20x2
z$=T$SHLHN^QNKNh@y)(>1bk4B@sywSceEAXUlaV*Y_bnGqpv&Z*H^WIkLK;eG1{6_
zLH)D8_TyPx$N8??RNtNTX99U5=A&IpdaI9J%@t#G^4ZvEr**hC?%!!vtd)a&#ECqW
z=gN{VjpxbC&wcFNe)Z_1_u0|MF+R?ncSa}|o<~2Q4c$|J*r|O`?Y?lv%dz#N>|dYB
z#>+1UM}tcNZq@vgFV5fGW^-&O7pH9gfyf>EKb5{YGT2SeKMdsRlAgxdy>>NdtjRnb
zh=ntUE4uaB)^%yFxxqJ|$?nTgF}-JP;_g
zsa!e(OFEsa4@cjfl%?PV*NQx#-+R+sKc39-h2F#H=etth<%u!=)-QA9R<=Ig6>aOA
zvvLdf_+XzsVj||+jf=K;ZUw7A8Rxs#`Z1T-#6Nf_zztnW`)u0{&IdOKa@U=>3glYH
zM_-R*!a8S4&b%z(C0XPfQ`=)5e*VF%-}5gGr4;@
z@NR>HX9xDs*EMfQo9;ISVtOWE)1|=LJ)8FaEk$__%H@DR_R_0nQ)|9m43yRS|9fW%
zx9xl98RII)^yz1BW4Ng=cFH?~?qf4Mn#Xbn4?gd}g*iD@=+nEYe%&<3pL+uQkc|g+
z;gV1ME~g)t_Nf4$?tlFH*NeiPmiWemfT>ky_HeBTjTLB
zXCZmpL3Q&BtZOVb)og!8;OnU~sr#IqbH>l=)vk`mlSBNKLww-SyUup7#G$o4`y+?;
zvb}Y=QI|va!gf#&#iM@K_jxSlee!VmzJW{6_HrqQ?vjl8UH0mX_0DqFxu2B#1Afu7wC@EOANTP~aUXBmb1`$>V=Znk1vn6+oxol)
zjPdj81ZUk@vW7kGF1ZeG4vqxPHGA=ZH${6ZXq@>eR^9(aX@~yx=VANp!(GpZ{nf`d
zzA4%`yb_!a@N#!>F5oXa>htK2JBGdWg^l{aA9*^;at8TqZWSo!1M-_Y+JLWLo7!}<
z!YU`mDP;fp6@fv$-c$a!ox4`^X`8Q$F#JulEGndvZ@)yT=-%c|FGR
z%(S;YIiJ54rOhe+yW4jIw)gv7xORu}Pdx2=eXtdr4xSg3V|l?(MVmcrFvfoS_3eEy
zke_r}dn{12<&bs8UJ-mwz&0_#FPm|tJ{4?=iQKcNabO31>YIbJQ(K>{WV7@3p>I7O
z74pOz2cEtB#(_PaL6x!J9zJyseM@^b>68E6OSk;KC2$v(Yc}2#jJ0+8H%>LaE(XeK
z{r^4R?@oI=U?cv;!Tad>pnl((c6oeL+VbX1z#eV!V+#(%yXTj$P`%ESb?PO1a4JtK
zi~al{SDWnC>}CVIjVbR4oE0|p-f-uv0_9afxwB79t)*`#kTe`MAeLA*-
z_T2%-*;$_Kk;k~KJRIK|*f-9t(pSz0*4!4zOFRQ#*jfM5yml|z!*`|aali3P0UPcM
z*w`~dX2GVm)#72Fc+tx)d2%EWFWlp@GT)rGIr6Ut;*ZyhfwEfv{{uB!@kr0yKXNLM
zF8&$g!zxhhr@y|EWzFjX@qIYNzcKZxfGr*4OULd_`=b*)v2%_t1Y~@7?!e~Ajp?5b
z@W9uuRhv_@>yE%){`_RV2Yw>;$)NN0;srmIH^v2@<*qtv&mY)ekM&?LeQLI-`MjyV
zCv$Y*U0pxiEwxw8{`w`ypO&8yphuf8P#t1@CJ+<%fxZ?6sEs
zF{akjH^!;d{b7k)fnUK;$<1i=`-8#8rt-rS3VuL*u6xI60~48A$Yf7f!p>+xyN
z5}XI|mZLtWWIJ7#0&%$X2f4kZ3lcf7Vw8}JHgdJuB`%P
zwf_HJ3=i^k$=}h}Bm4MzIeMCl^y||nw&FC#R-Z2O*0Nu`$GS0eKO5J-C)f`7O@?tf
z%Ws^}p*Ck6+zqFLn7;mZx9&`>?49#Ret%9*J~Q~37h#`8GF?;ElX
zclMHT&>3XcL1)k!=-s9LjDXGC0e$5~`!Hv2$(PZO*G_Wl$6?PLuIK*L?s-k0yVjoV
zfK7bj-(z*w=6;So-WolRb*#v5yjt^7K5qw`VzryO^V7WZ@v$4u$8DLrJ>ZvToO~w}
zyjP8XbAbNl-`MVXaE9C==GrFXYZ7#4U_0>q63;#Z!vYsoP+!r;rg>deQR$EezQ5kff!#6aNz4&_wDJR
z_a(pZx(XEbz9M*Gz%O?xUc{$-;REoDPy0J(%-!8F^5g`4TLF9U(RzOV^zR9_196tS
zWW6{z8tew+*mn8~z1}Yswp6dR^wLRow7Y`9qea|`{9+r`M})-Y+w(b
z-V}_yxPz@J2lAI*^~FGL>*HTdhH+)J{{NorwmqY8^p2o;Mh4#bOipE~n+s{K<>QK;
zrTQ5e&yQ=qe>=5&Dz9QZ%H_{ot}$}e&L^IBf{wMG>u7$d9|~|sm(o62a^ZYHKL4)<
z_K>Sy1>&Y}f5$JTt*qAn-}`!`ZCsW^GJ$?)LR(zv8{Z?`cXtM>;AkMe^joXuAA6l8
z9QipjvhEE&E=f@P%=PE{&ZNzD`Uz@(U09**2H8
zeSj>_n4PTQ^QiCE^zpY87u+w!MZCd2aJH>`aey~=KRw{%spxbEj5_gepPaXkulCu)
z9{w-cb9csW`>oM&J~jLG&rN-HDE8w`ZuCB7lle=5__%M$_kH-M
zr9Kt(o+o=Nu%0ZRLyWSv)2I9XfK6my3FO7)Am*&~@W;LCdB}G)^nRoB>NHl}wdtuD
z-ww#{9J}P$ZcrPWSL_9Tmw$JMvF2<0a^rlA6azNSV|5~9azG((C$L70$Z8H&H=cm+
zxW$(}FA2!O6*=_Y7QMA+yubL#H_wXu0=jT6zPD!&IisDp+YQ9=fnd%@ZF+0w6!NXN
zjy>kd`;icY1NO50Qa~>oUKf=6`o)h6LAE{Nhx4p6u20_gq<=LvxwvL?bA>=k#ap)6Lvy%<u~6~
z^-+PGWzTNV9BEBYzKQk9nOM%&6%DJviWi%z#X0V
zxg!Mh?2h?E7JhCEZV%W5auS!~>RjMMzra1+uY&gn{_U4%2A6{06MR$f9f6;bwV#b_V3e;rr~b$XS@%SSJv}$A53~0flO4}YZC`bkt1}tnlQVT#9^^xL
z&|U?~$iuyp-e*nq?@V1D?BVOxV9tX)-NeJQBg3Bh-?}{PxA!@d9Uq_iFg%EV&v?&-
zd-!a|cLF-aNuD)FYR9HEV)+S^etBp87zeWG5{Jvd{2b$av_<}&3TjKwkbO{lHmzgN
zCrt8eO4jiUH}tV7+t&Qo
z-~S~OTN!g+%vo0+?o4|rx2&DtJDb+B^?4I#xS4Y%uJrQt!?pK9WE|GsO>5b^I;6ew
z*t4m8;nDt!+0UoBuVTYrzHZw4{10RAeFyA~+G}4A%YF6~yJ?>fJhvVk+P9@WKGWZt
zzG7eZ@W(zmi&w?>{`mjWz+HW6YRemI<$Ujj@!j}Rd}wZtXPv(5r@fw~c)onV+AR71
zyuVit@Bvr#_x=Oc&SQmp9Fx&}+k0O+w!Rl}T6ow0q{zpsoL&Wr_bKtc6u864QG@vQ
zYeagoeZ7yqy94*AJX7QrISRYneahS}=c6{M`|j#p*|U%A(H1#($26Ym2|tv)qsLwI
zJOe4(wS}J#Z18i=A3gTgXL*UAPtJb%dpb}${wdS=xs36<^4J69*#D_nS1x--@OLV}
z4Zn8-oN4p9_p+~F3iwvLS7|F^@8=KsCTGqB
zlp&5qG`eB3dOX`h|V
zKa{?4&n!i|JduMZU-yV@Ia1>UPwbL|@{=FdtpcTUqaV)h7=ss1{p$LZ^tIU`ue5PC
z#*saWHSShx8bkcd?X%Z7`?i8rps>%}XrFbXedlKV(^J3p-je=kWA7$+%)=pwyi-Aa
zV6!z!$I8>Z9__Mco?r9+{M_KdK6=E+XIA!zZ_hLTF9&k8@wJ{U?nmR=_?0841ADA(
zUXzUn^Y#G0#fk6zx~cxTyXJGf&-$!GceA!
z@%iBS^XZW(Pe*xjjQz?xf^sOPfE#(S576?4YP5g&Pm6Q#D}iR}IIhR?X$2`Y!}iv4m&UtY15
zj@qgXI4;k=H?FWxJWuRX*RPXVV}Iq+33x5Hqul*uk23A8OgsQS#cGr{>gn$uR!(!P
za&S>T=5oq|dfYFT-On%QQVuvnHwHMe24Co#%QfEl*5!r0@yUhEKjhxoka;
z>D6hCcvw^0$i?Y)K<;k9Z#*h5TmOIW_g9Ts|6pJZTNSY;@9yAiz~0KSrm@k!Bj~>T
z8Kw2tW^CFC@W&VPJvVZppBKD5J<=W5XVoDFoy
z`8NmV`F3kyjt#gd56;7A&*iKF`hzTjni
z-*{g7ig;X}>Wc81Qe6d|wvR@wX{e%T6
zOKbQ+hV#Ncd~1*P;atJPL7Z9pSa8OU$3l*COHO^$9({W>adb{9tA5U9^=>$lwSceB
z3SJP%8!=J#&e{ilPtv=~4S{&~`FkeqX9k~{v)g>vfAOsUl3D+yv;NCw{g==BubA~;
zIrQrfyS-2Fhwq-_^6B9a;vAm}cjhu;057+uaQ~Anza^$deQHlnXoq8MTuxc3S6MN&fQHID6FYhsKlrINc7|
z#6CXYa_&R-tLp<n|Cjj>Gy(ZvDmC=x=QiGjni%KtJ1^x$~)UW6rw94>#gJ
za^nn*-1OPTm-?nAdwd3(CtuCp)>qRmhwR=CtgGGoaX9KLhh&sPdJfB>_?E-wetFmm
z3GBfG`OPJ{%vLeSsT?n-x2BEL`59s}Ie2#0@XuNDo?fMce21yVI9T=JmfS{kdJQ8SJ9BYhRhQjZ4S;F6wCO
z`)7ZL`d6oZ#9aHFy6?gA;qRD88QY!T$@nPyxii@(r~VyT#~0;m^7nrKU*_%wT=VlR
z3w<+dnoQctAtsXv?A^?oHIvLC(>8}DS6dps=^SDJIX0n5Y)ZREx&~sw1BVn!O{q{2
z+%(D=v4D!Qp`y6mx?2T;Y*7&r>j4l2Iqq#epokpY#{2iJ|2=v0=UZz{6fgIC<<5J0
z-sicW!~1^Un#@e}<@d|^4;g$QvlfthZ)C2?-zEGJ0Xgld$c?tXaW;Qq(j&gT>o3e$
zJofJd#fAt$vU-=hLbG640Jjv}3|IZKpOa6Z4kImn^
z{HOB=0&ep6N#`$x{p8?-LH#>4@ptY(U|k*ki~Jqj;$!{D)E`Z6U%b98`*P!Lerx*s
zgT85%qv!S0-{mbn&WiKzn${XuYqw8pe68G#E6)Ds{KYdp7t!baQs(nK{$Tzv&)Tm)
z{q$`C4%PR=k>!uLi5I)@K;+UrYwdHVwVwT+oaKY_@?f3rZ<}-;o7U+2l8F=f)+IgU1889^aDp|L8y)
zc^{k3i3MHcekt5WnfFX{y4iol)W0fy?LQnDw)|S=%hIbg@xu8fL1XO<9Ve&WcR_RC
zEA;dG*SUK;&&eyZhRdS~qMuD)mM_PL()*dmeW&x*KzvRFZ1NBI0(S=WA=h~McLHC?
z+E&0Hf7VVc=q7&chz|G%l
z!(Xv>@Ayf-J(uJDbVmZ;Q+zIJ&f~cK>ntx?{x=D^Ira
zy`9s2%UY#Z&06ny=fqjFwiPs1#?aVjxSTiMV%8kFYxryi^YfRow$mB>Umm<6_x0}d
zbSwf*E=T?HInMckL*vkzkOzLMp~jlrJ;CX~Il49R6m$FXJ>J73nK!oHU*F%wP-||^
zXUvDjQ@mMVNpms7`*6yYB
zUl8CXE@HwjF(Hq~TLWu86LIGoZsf&HJlGTKRc}LSrb6)+BuaE7=T4P_Gep(Vi
zzHuGx8H?pcfE$i*CeY}^&0YENK&yRc$K2CVUfuxw#EZg1>DB}LJ->a=U$o?fTOm&!
z@6?Ze8f)yaOTQi#fi}iRj`+jhQIGY_VNF~f3i^3|Amg#_Zk+0FJqOu35{QSm^o~57
zFs4?ZwzSZv4dq*Htw=>RykGRy}O_PH-^2JvRBJbx)1jYdwwndUwSNcR3sP
zaUAD-mN)$AD}VXkjsMyt@15&C(tFEJ1@>Q+pK)>S{g)@}jTIifUn4KE!;9Z%0!@DK
zJQ17>_~%Sx;%!_HTDNb>m^@BwkW;J1c<_~fW4*|m^+$uxi1PBzbeU6oi@+J5Sz@(Q
zjKq(8b>e{!+x%*cjO)1H9C*h!19@Hq+E!qF5oqQ(@QdIlr8^w3fw!IxHQ;m5UB=rw
zJ>%KeWWEvfzN%T=&j!^m*3S3d%Fn)_9C4?UU)EODJsnR5^6qT&&u;U}-s!-*Ft>+$
z?Pa)(<2=7)ZVkj=W3M&CzL<#JrKvXte2+|HcN`Xhwpjjq`}0$MYigK{#)tf|U@g$j
z1^A1ho}7E_zN`o0yZt^r`@3G2FTVxyC`KARc(SXNw>&H?q*=Q+5CgtCt5*Z;@qKINWB~g#(K2A5sY=QS3O=IdG?(p
z+q`7B{PQyF(>njzX3sq!zgw+l`|_^~(<>);TTGLa(bl2N+39*ef84(j{2%AW&W>xD
zF7@En`guqawGWvLr!l9kNTA1jy{Uvg#dSX@b-ZF!bgoBccgW146Q@*@_i~;3-Z5ETmJe`
z^R-EX>yeW#*soHZ7>2xpEHXD5tcH`w8!TqKHAGV#Pm%Wn#y?9zfmOX1~P;A~1l*jz@
z#y%T225jKQ2EUwnYHj;os*n2upE>&aLv}aY;=GgXmu3&2=9hn)fja8@EyiP>59}Z#
zCVVDeAHE-G_eO5d1pKt7rsRMg{_hJk
z=h-TEGV;AYxGI>R<+Hn_w(1u&-!~IrK0CJv
zG;h8}FNoKXpn9#DJ0q^A0_}T-@AZ`tJGNK();!xM&lf&vVr0xGHf|2Y4sQ?_d+LL%
z*s}4SC_SD2aKK+2M_tZ|&7Fb$#;pAl)BZ;Ks{?20aK<~RCe{Km6azZQyep6w9IMw@
zY^+~e5gR(@I-MEsNcY8Pl6o><}`X3bNE%lyAJJ^tP-ZNAT@vvME~X99ZF7~l1k
zanEsT-DY^XURsmwcd8q@*lA6?G~@L^ZoHNJY0TX%t@7@u_}5Q|4rT5Qw4
z(8KN`aF#B-@UX6pI=m%CW3MiqY0ixsUvJKoe}6lf{&2t#=jg^o4r&W8V>MMB&f|GH{o%m*&ER4n2EaEt#|uwmYnm|`
zc6gm<9gIIt^0Rp{CneEb$bWISDk8j
z;P~30Zv1ZJnWvCTTMz74UXQa{r>n8usRmlt&6QX-
zKe!sZbNFus)pvWwhlBmW<^=gD=rP8}Sbj8P+{Rpu@e=FCb)K`EvNzTho%r#gTwCM2
zaTUj{I4lR`7lHQ3cDH;t44(|}=ezje^meycZ^`QmuwVb~%@{9D
z&YgcU=zXhAy|>`1MDOd<&!PUtwUe`Xrc3Vh)W?s=cs;O&6K;I?jG#W*yD8u&-}Q??
z<1(w?C6{>t4Kkf3T;i
zGjVP1AIkVGfu5{dqsxBv;VMTb13vanin+bh!Tf!eU%L7Zi4WPQ*0$}-rQF^+^&gp@
zZg$1A@uAzgxa8=vJ(+(u2KB#hn*R1+Bk0@1FL~y>H-=y3<3d;`U%!rK+!&OH8WFe0
z1F^U-@PUTljtH&FKKV9+-r&eyBDkUtCPL-t0}Rq
zO>=g~Iz|M0*~+{m%1eP-m#7q^X|cKb%kt251ieIW<@9(l;wy^~%#*kr%?l^@}e
zbMdDaH@d{i*c+`c8gqL3X3>2ha1ZYd=+fwDJs-^2zBTe{d6~2H>Py_ks
zXdn*VzdvI!ZVk1+J!=~QeSDx}JhPd3d5S@Kc1;Ydtp#$>+VA}oNBYzepKv%j_#}R{
zPp25w4qb}?H+$Y+df2nZ9?;Jof19)N;}iW_b4vdr(359}A9AXl4H}Q;R6cJG*x>_R
zi$H5E_3j0mmjb+;I~+JO*IDk)@Tsw5(^>p*;aAt#CA%-Ez4me`#%sa*r{5<&)|}d-
zukw0p__C)C?QaC^;ZC3Stt<42#VGT~SIF?`Oh8|ABF=me4;<*A3lBZq8;F_au96|k
zf4TCWX!z1Yx8K7lW_0uC>R=IQzH^=kP6lEJ&ODKVV#hnv*y0R#1^MN{r*BP9SI=LS
zG2lxMhn|sB`7D3+I{JMqb8FRAEpX)PcV~!hFtX0O(TAz`?
z-kn~&7J()%o5AsbPuhh*zRm~r&m8;=!*8Dx8v*|Ozayw`hcfoxscHN($ro99Xie}JS3MhxKr4^x*7Lo!3GF~ap!K>n-phFX^oxIMTl$RGK8x^n8_D^ic*fg`=W
zzjDi#vpCbMotyrfnYPBPpvvfzkC^wdvtUUKYPt18|y*i
zP8LRf*ABlg;9&OfV}slx(2fV@+PT2^?9{X6JE}ThOANQ)ntjXP<8?#kYk_tlaF!17
zr$c`!U=!{QTLTUe;3^>Y;JzTJyqQ*A7f_cy0vzw|`&Y?GPvLm)72znBs9hV2i)>^XJ-t
zkJ`Ia$86EBe$|Xvs~N3#l5SkYo^N>E5tOI5>z07be9v2A4`1=$7ihS+Lvr6Y#hc+g
z{`|n7ANb?V4u9yvrJplf8ROp=;N`zdza;(PKwWeX2j|(rfz6QvA8=$-tjBZoYzB0!
z1t)@&0bS5IR(Eqb{$1#w8RC4van;{t<@@Plk-=${5kvM5P3v^ZY2Uxj`Ez&h`=Ud9
zM;%8qcVGC(5Bp@_5?OMm1LxJjBGCBCAM$K10*&0lAkA6!iX;2>|KJ|`e`t^W&)H?)8^}HKCNedx?}8~4dmlg
zpgom0N3PYLy`B{#{#^*XZ?{gp{f)p~@)poT@1L9AF6UmFxjQ8`kB5)%9qM4@r1o)Q
zqr6t#&$s4${`oCu<%3RV&j)>%*sUM9)*tsl!|4kqPU0}>GJH`uJG)bqx%!vasKKlXMD#0JqV|Hf6V#n^FWOGgGc=t_4vC>#<@S2rxyNO
z^foqM6#s;JjH}v7_%3rGEAL|Y_A7|Txya!prp`f*Eo(33_PoEI???781@)f|c3UIP
z^0l8?&Q(_2aQVYgx~f(WXHUIp^w8a()edLOw*E>H(aU-s%-DIYx=&@C>-@Ygn7+s2
z`BVtMG`+jbkA4@}%=mcF`#r{rPfx_B-UIV@WZpXI`=Cyo=U3~*nEV$w);-;%)mQE4UoVy6@bFgYmq)&(D9!F6Vt#wl;8?
z*T$Fb!5zPMtc*L$%epxF#x$>7
zbDZVn_rtD>Ii1?^U@cf>_x`Nk6S!O6lncRqfjFHF*d&9;r2r4#x$qFrbHR%PF|Q9~
zthrBWlio$3t>Qv=c^}G{9=h4r_nkSKv3Ej$rHJTK5B=^`++6B7m%iWe@zs2XFS9~lwogY4D@T%{x$(a6!gX$75
zXDcI*&iBsZ*4&bHck!gxeG(fnEU!m0CjVs6+>;&a??;E+%Y#~33mSLlYqP$I6^PxD
zY1}-&GV}GI{^MN#8^ik77+j2uILM82e6GG%WlY~@&^Jgv9}C2n&YJ=@#EyS@-#1!+
zPsJfRF9d4$)~P3pznZQ5nT)l?^54(Y|NWWcC|7LZcRFwn#~i5veB=dB9Af@*P7h_w
zpZe##IawT>yF2)bB(yflQ@*vvQBBF^Jm;HP8}mcH@xfKCuyr8V&EJFB7fWX#t5}H>{o0d(ISwa+lfhL1p7lvB)s{Mh`bj50PX%;5e1&i3Zf`{2{is{s+3H`*
z{N>S)ud!xNja8)$BTSo(T{7T?^?^mXf)G9rTKzk(E46OgL>^Fz*
znVjP4O;Ce+ywxwRns{_9Zr29xxtiG@&}UyhUKczVTp!qD^M8wCagd+pK#lRq`g;u0
zTF+$IcV5H4ZzYb-tg83>vR?iC_5H`$+Md4)WXUn#njd2`um7Fwir+>s)^FcM@8?>e
zxpQ6ThjZfZ&1n3~V;=vjBO||Gm4j;T(V%~~$$^ad(e*c_FdxhO4Z&Lj`BST7-N_%j
z2ZOWIcqjkHxIP?N`rNUd;>t(+a{ulfa-Xed<(~iU(LC?u#BJnWU&*UEJOonx+!Cmp
zE0I^DmCtZlw}%YU#038*SHxSrl!H8ocey;6Is4+>IFX%??Q6}`;~75?sB_Kw8-p(l
z=n0e*bCKX7g>aG%I;1(knM
z#^e`)RvUb-3_E1Twa=W^?n(btl#_8E)Y`29JEMJk#+;g;3)m;?F5~4)bHJYaCm%6!
z`Ho-8m~7GS$9;e3!~L-YT^-|Y{;e_Qz8(qG>489_2Y(#wJHH6D#q!_J^!Bac2ylFu9sesIn4c}$&%3SRDhgfleZdzEdJkq!28TtU;e1Wt
z&HUpbb$5Dp7lFoKdw*hwz0K^sK6ppq>{mx_k^a{Le8;`7*=6r*hrMfa4u8$>L8`yw
z`Ui$}cagljeCy=zQwb_R=Xa&La9cGN)4k4)_C753-Ip8wnYdg#de?`1B&
zmG}2-kMlp7Io{p>%FNw2GWs#MpPIc<_iH9y_>gVy{Wh0>dcBd~kzY3(?SA$2>u==h
z-@c3=pXBK3&l+lS)ZcZVXV$%c`a@H%&duE^{fnpmaQfQWV&a(BPlTVcu!|KuZUW(I)Rg{6-OL-Xd$_@sas6
z0Oe7?-D~?P`{%tPu~NtLzt}*WWz#IGN+2XHVZ4*2j4*
z9FC0lQ{8H6OkxF-#apPM*P$;*`onn{8uB+viGThKhq;8?jX5kOw!x?!QdBy
z8{)(*!Ck?b;1dFI{DvrZb{@xasvY~||KH*6%)c>baU0Lxn)!i1<7ea3T+zV~{_&HZ
zZ;BFi#kWxxU+^HSm5Z2&<9guypWK5-&yoG+$oi}myPp43SrhBIZ9H+(A{R2
z4HCxX8hzH}d@Uf~T-z%LvBu*)vB@tw{H*doda={!;k(9Ob-SP1xc28vx~I*T74t$*93%Y3d2M{fjP<-{kP*y$QQ
ze|pl>dg#NT`sfAa4C
zpU=Q}l)z{8!pJ>cti$5HozUtmA^)x>tUe(ch
z;EUh;TwknrO%48~1ZdUg#{TT7x4mje%|922i^dQ2E$@1HTbxTGoz3B
z3Vzwga<&g*wK0v^!(oi0SgS>~(sg58)Sow2jKnQ}^mY0BAO7;h50ClX6*uy9j_2gS
z-e%yAtOeyt7I0690`2>{h!fcZH%87@o$U^*}odud93LXC+qZ{3fTJj
z_)VvHiGS_=wG}$p+aIv;f34u-tTyNVz7?|NPJZO$?_?eM9LqkQT77>@#*K}*b^Wt4
zUZ3Wt)4wd}`7uV~;JnU8E{n5*>Z%$Ce
zrnQmbv*ez-Lb)HfLb<pZ5g>wJ*70UgsJ>hjuTB5IPG5HZNXD8t)OUQew+Au%
zbU!=X$wi=v7rEZQp1}q02ZO#h#)ks!TwwofFuwKH*l|WIM>%`IuSK9OmjB-7LEfA9
zccvP6O5oGn5iu~`3KoHeJAcc4U&eqtECOw@{P(u}q;l!k`n1jmw)uBMAO_{Fr;E&3
zJ3p6r^1CrLF2wg}fLnd~yYWfwnlA$Fkzg}u4y=`fF`MFrL;0EG*O*%`2RzyKMyOkI
zbgu>C`olYLX#B{7_eP<~^?HB@JNB<_TCfn_#X+_
zIzRPn`qRtmz7W>~6TGANI**6*__`au1M=s-pt%rVXPjq8y!d$CG_UWk%ABsQi?KPq
zVk@41Z&s)D^t-NpU+{1s2kg^*I&fYd9}n=sg}xt|=~MS&q&*ps`THwm=++uD_Sn|u
zxqDOAK&dlN`$!-L
zeAogxnF94
zp4SC*;e1m-=T_jZxJ&9+{m9=&(7HaFvAD|Zivza3MU4p#<6D#I($0^h$BE4!n#T35
zecztnm3?rBaVY#+Xvbs!(yWiM|NPAH7=2ftun4qVv1LASKVTv4e9$_sJRkYSXWaR_
z85|GXTXxw}tKNapF8kticIrp_>Qg<@tH#vvzJUB9&?^3GN*T$^-_$&f#r+A5vn9B!yjTaxrI<&_Zu^MA29%S(w
z*U5_|`7u75nI8}MDOTjzITqldjXu%Qdp)mF^6t0T%2DHUrT4qFFHSvcO>C_JevK#p
za1bl`Vu$@P$K>hgIdR9oxySWy4Y{XF46D1b5FgFCg+ZFQiP?$Z{96%
zH{a*=A=cv?_Qx_G?XoXk^yy&{XnmjPm6LJL+uiqVta)7B*V=FnKQUaN`qqW{PInS-
zP2G^^e{;*O{O$|hp8S^g$io@y8v)z%IE&MTKqJTh=Gk}D>!vwdbn!_))_LpM+DC_n
ze7S?<_>C_+?!smuU&jJ*RcFq#+qi6hPriD&ZjaCUIq1UKId*U*%P#KhvSFP~^D#DZ
zWba^rvoYVtb?59^V?(SPLwxQF_6OzOJ^na{%T77ReGzCo<)1$qKj<>&2i<&x)|U8h
z1f!2+*@1DLF20e!BOqs9pX7>9!$Gx}Qj@oYqv
z^1i=oX9IDggMV~4w(ap|2aiRd(JdeS46hC6$G6U$Zr>TI8^_vh-*?VgJgyXXO?n$o
zoN(n+`LiLG{Y*2af6P^k3^TXWVL
zj`fl5=8C`K^H6YGKnFMnY`Pb0>hb4~c=-Db<~87q^K9_1`Wjc~$N1A*F7rE{t!M3t
z#lykzfNuANzQ+Uh*m`;Jqan)1Q)~HG+OYsH?a2UlI{4!Z{~I%LCTs1EV2s&#N1Wa1
zjx;{MnP1zU$EUusFE5%gKQ^ba`(kWg{LR(;BG5)1lZ#9L#ZObC^qmdVq`6+aa2E5{
z1ifM>wi+(()x~KnRwsg!fiaMO|1_=*YkxVQ2j||?-ii9)PO{nhtsVOsj?UwNCqH1U
z8T;c*H(-1~j|){IvHXY1O9U@Ks^=lS5z72{`3Jvak6k{83qe}BfC
zf%u4-<_!=ZIUrYG$?%!HHD~8*_O;_dbJU;9%NBOF*aJ?$n&6Z#5>#z59yjzclR?ed>>*oTwv9E_kpy7ej%Y%QANAK?R{9Xjw
zBSGH>u>rLr4)oA1pLCxIG<^7IeGzDj<-fP>txaQfxiO7Lj_jWg^knMaD8v4#fSn)D
z9rs@Idp)pM;CeLJAK=T+AKSst&FqN>opYa`$Qmx*B{49j^J3r(pPUw0glnkU2mf4GDH^%)-^
z&maBxCLPIqr`$Idb6sOx{&LQ1qknk1>ulBk#-u-QeR=laz8U0tzGg078rzMd9@z5E
z@MWG$v6drwmLtAsbH3(uw?@TmTDu+vn%b2k-0XFq?EDOF*2Xi>
z&zy}Lraf^~58|+YS`*{Z2XS-8S^C&s1e*1pdte%0On*Eer{4KPPQ1hsS9^ME{4dDy
zX(PDOTIxM{WkA0Jvq=Cm&QU|#R!K*ppD7w>eL7WXHMM!BJj!
zJ4>duxAv1Z}`_n5X8e>qW_`bD}rAMUYxy;4?b%^hD*Kbi@x6Vk+1dIpc~{-
zj5^<~Z!N2<*T>*Ee@*7)(73pdM}n=u&l9Wiw2BW7SHfwu|B4wOF`DzaGkSe~;AiiA
zAP>E_J8`)ZKDek6u{k(#>HIgRJ@)8g4+oz+?y$9v<@#r`DOX~rZoRYky4&>uZ}F@z
z^`Z6e+{=T;fQ{Y!+sjA(tp)u1=fODtfoZRPvF+Y!__%j^T#X+M-WXzY-&(W$An4PO#nc*7u6>Zd^xRpAuc;Tz%ILPUh-BTMzJ_uX#IK
zD;X|j%A1b=);RCv!^n3d`p5Z!%t!wCwr+9J8oTQ=26j5$tB>gAy7HD+w|87kjo%-(
zGKcZAc#*j#_i9(}Ul)jxcjV$Qo_{X!MefDg_c6`*;Bxfr`r(s$>OJV$+q1@I^R<@o
zJVv-22+C!D#&a%e)H!`?b*#(l_a&x5W9$8NCw@41LlX4$!A}R3(>HHd`WY#%;692+
z>t(0@WMsx#c_=o=`G?HrKN~{jq;~i#Z*qMkcxRxAkK8qGbVk+kJzC6k9?85q$9Rpt
z;J=qYrz10Rzh!3UCu3yX|LzsO+!Y;o9|_o(Bfj`-kpBw-pMBR-Cw#YlYhZoU|G`PW
z&ro~k0)D6ueec}d&%JzoP0q5z{%Zqv#`(9*=AWB6Sv=G}9&*>uZ)+WU$L62q?ow1N
zKL^M7h)MM{M)KDf)vq&Ivp>elXDZI_J0IRRs;o!BLB^CyEA9mql3MVne=!5^lbkF
zlk6Bb+~|-`I(#S2KbPNVF%+9IhR(Qi-W>0Xx}c+e9-r}e!K9Pj){B0xdfBOFUOL&U
zpD&u(`~KPf*JMt%HNo~>fjk@uS{`n^V?g<`?;Obz^xAigpKbm={T)rz;;@>JC
z@16A0B`5O6PUl}Xo6Ak@%Gdn65P#=u{eDER)|l{7Ow{ri5AhKXa_)i}A7f#CjK#N4
z^O18o?)DiY9&?PJJEvxPzj8Kz&1`;S=C#{ez9VaV#JN7QIr_)nRsPkV2ePj<$Jb{J
z^mM#eAJNM->7BysmO$;XQ{8%)$7Q#9#4n$}HDlOKe!e%__iJj;1#~$--gosR-f(At
zk2-J%y&>vOtIs!P{9M4M#wNY}99U&jJzW#{Z!q4h+CP!;$zWgbQ1Ge%FK@u@ftryU
zd&X*nEp>HYK$p2Ozt~n&xSbFB*}s*sH)llkTXXJAK$o|mvFRJ|aMoTM(5FUg_wkH<
z7P2k=WW4LzlR?k7r-$!kR_S5a9{%{<5|j&ljTc)Q-Z&`Z3
z=IX_KH@Pv+9e+X2uqkKqgS+t^ft;BaVyrEe|K5&;nDVFk@aVX@#gA^aAYb%Vzq!46
zzmu)%89DYWF7DmPdnY~nB6mEHdpYZP%+brT?(YJ)Ej=IMt1@?1{6UV@(|9h^XXW-L
z3u)qfa5;K*ZpA|m@s~q$x*Ma;@5-7#&(FU_py4eho70#-8e9Hbt=76=L;aYy?ykvr
zEwHC{*gO`rmdEw=tZxPQECOw@{P#8waVQV5(pK@P{pu#e_c@Q+v$qJe#q!_J*qfgz
z_mRh#8@$+)6Js328Ylkq&1e5#F-bcTkl!D$)jDyOY;z=@i$JRk4)gVWS)21YpEc(2
zP`|5cioJ5|oB!6V0Ur8482Ah&_bJo-)6!S&%^7Re(|66g_Xn0c&(wiCET4F7+gn@u
z!XFS1zLYy%YXM#4yXT(vJ@A=*A^3>kNKjpV4SPKhXZ5J|#Ns0Za&*#XUA+6<>|n;X
z22-jo*DyWqgf{w02VM6Bqwn&iRknFOl{Iny>fE`xO+2;v8M(t#Q(Jr_Q(wn-i!bEo
zx<+o|j028q0bk2+6{m5(Tv~7Z2eI{?lwRXSpe>gFe#X{L=ZNig&b}OcqCr|?q%JVP
zVIK3!IHw-?Dt_#YJ>SV*8_19LPm&*Rgm|hWGKJ40aq{<{sb^=^)zLtnPdaAs$BPX#R{kfQVeVNPNXd$ik
z^zU4*Y{!otxjGPt-#^+Re%ZPlGx^i1b2okecn5vzKwdO;iicL6qrd7->t1{3#6q0c
z0)D_)gW{{LI>Qh0_XW+B+-wD}58e@|rGFA17U_R2kbifD+@DE}x;wsOTJIf@Pu#rG
zM}mg~cGNpQ`o{w@`-9Cu{+!pI4Cte$cMV5xTXp-)T@QSB#(|yr89vW-uu&ZcGu{Zs
z`edVg_^6HV!|UTS{!l%>8?it4XDw@V;7BjNIQBEj+hOg2V2p$DsX+UP$(}n;k3F^;
zM{h)be&7rJ=K}oBPW{N=-*a2u%@192PLKGEzGS-0ojTLVE)3Gt40$%k&(i9(UcCo0
zu3d4zHNZ>bTVr!R<8ohQtf`HC!HM8xAf~`ieCnt8zb??ajzi;Zt+sHP*A~CYk9%z3
zMlb!Z4shY4{Pm2zI|B_LdgNx*bzkOu?wN6KZl|9eqm1+34Sc%Z_m}-K?rQp2fX8)#
z__N`hzhCxfdOZ48w0BSWw>j;Jv)s#p8n(9;jCHWcTqCnTI25pRa}KVh#}_~EnD(J(7c%A-{r3lzpVyAFV&k2?>UoEkzb1+2
zUH=mi)0b<9PkwGtFL*UxeEgwsJb!!#o@CWLnV*OZUE%7`D61)&^JQtje}0D!F;O4Jd*Kz4(dcmw_%r&T=I~zxntQY`ND~L~>GwDO;uf2K>iQ8+EB6chBB|Ks?+Reee9ZM&IFpzBz}vt=gn}5on|TYP|2q
z+;6;Ev-Io>8mHSbmjAWjD^mCBfnK1qsNdqGiI4v$k9{#7<0bYdgJS_(wQUUY;fz?|
zjLVUr@nZuYu@lF6@4e&W;i;$RQt)`-PN;Kt>z{=jUi0tz_W4{t=@XZYK`Q~Y1G?Whp>m&`xmG>noqcqB
z>+&8OqQPHax8wHomft-Yzbr&wIjm)PS>I@@_fKMS&W0b`fZg1fy@x^6i=ojM;K`tM7cq<=XYFX>E~S6PJgAzZ)C~
z*u%YV1RvSp-;uywbw*Ft8hLa6tOsnGt8sHYt3!xn$YvN%0*$YymZR_<>et)X^Yl3@R`jX43&VU>9?1bY{*e(|^>r=~12Migpj&J0;pC1x
zzZUd!*ZJm>&clJT#Lu*WL?0Hiv9EPd6^c<_
z96#r_#2(MulrQaU;LMnh7Y+F!hiiF^J>CxobRP;Y
ze205od;22u#ewENsWblE5!@26)wQjR@m>VlV)^f9%Wh`vctEeFPR<6-;&0ErIuV?l
z#*MSsj-TCXfPL~~9P_{Uy8P?LYWYYYXWkIansa*R^arM1yv+Hk=bK)hop%?+yKlGH
zeqVle<_{m#g}6A!7wd9_I}X}6GvW32c{KRte}4L^SMJYM!%=Qz+Y
z#*q%O#+kjj46e09->GRn{ylXEvo`WHUkh;dh8WidJJ#G`_UOau{X>4#3m)RW8Hm~F
zyRlmS@C1u3IvaxwmoZQWKKm=j)=qNjx^g$}BBw4YCl;&py)Ntcido~#e-MxNOk?qo
zSG=uj>w&n)san_wn)`QUto58TZ(pvg{`{6VZ^7Gw=9n&VxDc>q?ym9UT%h)<-@6Ik
zG3(_bR_eIC9?4j9?(X1U!~s5ycM{i+4}3i%l?7D+xFAZ!JpdZBblp%-fd^cGe5J#8C{26_3k%bBR_WO!mk|hXw8cU(6g$ZZ_m1RHsDYDCo;xQUg$p;*taH@{9X&#
z-v~y(_mX$F$y~`D;B$fhy#fC;`M_y&8snp>H#P8F^&oPc4$ejFHGAUjNC8t=b~f7?xW(wI?fPn?cv;$9ECPMPs9mHC!4CefhsEWACiEjykMWhp|>(
z&iZ`ehq#^!)`E{3zV|d&-UId)fp?%fSJlg^Jc~)su&0eY8biL%zS{!%<;RC4R&?Wn2mZb*>dyq)@c^G20zT8B
ze|tcW`Tc>0*Ov!;sXl9`1NPQOBui&wn2j
zi(icK-gA5O{?JgvK4Uk6xgX{uZ|6D}&jZ0`AU}&hoAY#LJ2=e-Bci=DTCt#M5)ECOxZH!s(b
zm-X8MI>G;!oc*nUE_OR+t9O(x@^f7{@@NbXJdN@2vz*2zxw8RIqkaFcr8#f5$d7VAHOSqRz4f5y4rc7`x=X%C
z|5A$d?(}Re0_~At^hqpm+z1*Mc5!68_hpf>Cck5T78cXwOYEIThM8v+kVw
z>*uaB>SHay(O%DsGd^=adxy#6pw$k4HJpsA*Z5-KOl9V^&2RD={*Cv6jMe(SK-=xy
zZhPl*mQP}EU7(!{#D=}rhJ0H$Uj$lf=*;%?a;((l|Fc6~61`HJIIt-fxcDqx1llT_
z|L-m~uQUey)7a%74&|}R-~HL=@4wo`_UNyBtMNzN@sh{t`QR>k$es$+;`r-@>U*pc
za_d2D^k*}11U_CVHY2M()!D^ioZ+rDx0QVu^Mtpi*5c-}iF51k`5BLQuy?tB;IS5n
z_rKmDPJQ?A1vvws4I4pi9n4s(?(zNgXB2wR#Op}F7j@9sE;82U_kJ^Lc*gaHMY(f(baWVGt2k8=NScF4V$?&Pm^Xa8-^R_1i(
zIE%^Xf2PZr%G;Pj-yO%e@PCZSR_1(C+h+oH8WXt~b>T@=czQ?K!uRoM-Z(5W*PNk48_zhqlkD6-e&D_t_)Ikx
z!`_*(uEc^L<63LY8vbK!%^Ta1r#L*GxII~MY@Xa0
zcV-pjX8sOl>GFBGSqs$jFYm%loW(}p`cXUDZ#Qq8`EsSa|NS1k<@bLy?{a=Fy#K=<
zyw&(_yl>8ap-wt(pQX!rmZN!{jGX7Z>C;+guh01Ng0WtHWf%Vatnu!+iys}RGyPaU
z>h3>A4=#@eWZ0P3R(;YxS6}CTUWu>%p25-AU){mi&G6x?|6ZUy7Mu*cFV^1@XyR}t
z;QKrVS-SjdHuZh}{_){$fp?Ipdjg+1e0e0$*n8D-^z8S~S$p%(0&&F0=f>LuG56VZ
zOTfmB!ET>X&hf>$`ZRw>**qL*-ep``Q{(*FtUnas#CF1c`Lp5SjK#$|Kk7GKK64rq
z_obh`;-Wnn_$+T+t=0ZcZ+qWaJwD^ySgVflUg5*;9DBWE{BjTe(+)M3t^ck!b|+qV
z?!|2_GPwQPF5Ki^YYmLCetXu{N7v?cEq7lP0Wytg`2@s^h+l
z#kZf8SLKCKCj}j24A^wH-lMqF)SE9k?t+@Me?C|b?hbxEi;MJ{`EO+IjNfO>Cb>nR
z^=?>apYQ#Sg0DA&{&RtIz8{&7-(7qL9|`1?omGEd!J({+xBRXJer<&vb9dWabMO5;
zGOmk-*4T};jr#+^rQnMK_v+6EVv9GOrvmLA`I%=c{kZnISsUjcn>pKT9u4><-)#P0hPj*_3-DhRw=W9EdEBmKBBQKw7)qR$CcgvbwIj7Fm=T{E8
z4`#j*kY~&LqEGPGyYwFm4g}ug
z!c;?rNVz*&6h)8vO=WXK)7b?|AI9d^v8ohzri*rRMg>aru18LRxLk{n^R>OL7L-
z?|AI9{9Ejof4?(03u2(|<;q=Ae>VhTCZ>NQG5e78V%xRv+2M1npUrftQFC=A*7D#j
zXdE)U{O8WLGWOlq9-CU@*4i-V16^a?Req;fH7|VackEn!NNaU*7Yg?HJ-H&ivngNA^AMO&P=fKt7zck6+K$Kl!xR`cU^@
zJLKLOHnsx3Ij6_NnmfD*)aBft@%}fT{BoWz4+Pf-8eU_p-jz8nadX+opPI&(27Z3l
z#Lrpr<*WMYe=8NI`pPz6SNT!yy*u(%PL07>U*6um=9`fb*F~UJ{^5*|2Xf8E>1m9&
z_lhs}=I5Q^pY~+1YF{2s1SbRW)A;7?z?olS`p!UG3l0X}o_zrht<$;xjm@#hsI9pj
zHmuWeA=nDk2b>A4<8o_&%ly3DlqcEh!>mmEMdmGmc;P2z^pSackYmfAQ^fpjfjg=meot^!
z;NG)K&+7uUiaURdXD7&!SgYRy!CHXRxnMnL%-lnB^{l4UyxQ|t^w(K#nbxXLeDFN51JBBdi^e9M
zXQ!U-@xQ&PSMQ{H!S#lq9K;wu9K137;fuDH-e+R7Z|Sf1rDwf6_UWg$Z@KRp{OkN;
z#%%5n@RIkwqvb_j;~$+n<=!1z1wLEXs-rf=`Pv=g+&AT_$N*p7J&miU{Z5?Nen+4l
zZ=c5I9~-!%?7v_K``Nn8cU3)#S;0e0_J^66nD{91=+_0;){>|+_
z5Rld6%ecBP47z|EB^uMc9u2W#7(
zultri8{U}tTA-Z|?610OxF^h)zhB6Gb-yNKu`D0C#tBdLGw0TG-nMc&n{n%jZ$7WY
zR{J|cd=6&55s($v*9G#zCVuMCdHZh-_(I;EH6Vl6rNDjW_tu1RqmNJ4eRh~@tx5HG
zAgDZ>d=V$H=bJqP@wqin-;GIzm+vIs#eIJFpU4{i&T0I_do8FQW8V{eF5D87r*nq_
zjedUP)%=>vQP=Ls7=Q6t1X^uuW{le+(5$oT&3WM-Z_ZwJ`<-_uyZmCiIm2-gXysvi
zTX5Bc?@PT{lM8201^E7C)}7&ZYtlN1*Im=N`8%7rc$xFVTwaaoJrX!~LqLa`y*c2E
zdhlJC?5h4i*7X)G@6ipxAstL9=xRu1hy5zyyt($u${)o0wj$%{b4*BZawC$>k~`br1C^v-3aJ95{To-o&SqK|BV(@3b?r5Oan8t{cpM4n!dHyco%rC~oK{{AaFQSA
z7J-I`I_vpk86OBX1AFo`=GdI?t+(b1r@x(Ctxfy%&^eyX^m5GP&#%?t1o(EmTkmbu
z&IbGhaqgYNT^r-5j)4tw^qY_8)W=%TxQXxh8Npv~gjm%l^4h#+|7PMK9_2@;v$*xF
zI5w7-GNyyf7_(7kYZsYpJ8yPpg#@7cg2|g+K`rrqGp9(6Ye|hktTrPL(DaO-UTgGgNvzlye
zvw3b>vv1EGxi8>D@4vXP;ky^raQmcVb<@$c`ai}=+{8)l+*iH$II}7~<9knYrtL*S;Es%FHHx?T<*%lY^so&~Zyn82{U!|8{
za{nPa+)H-oSOnVfKuvpBYK!fT`?Iz;qi={YkP~O)@y`MJTsso*jc)tw$VbmDGS<32
z*X`^l1mwk~_gXEB&)AEDwe@Me-#_sCs6ed1SR6Z7tL)1Wp7!ntZV6hi^jcR_^wVjN
z-`e|!`s#NJ`@Ykgi+A5JcLZ1d(AB!NCbwO4-rD(T%~(F<_HckJUAUC5_*@m#pA1*V
z_F&fOyDcCuC*K+$jBAJf_25cl+<3OftK)LQUA*yB*J4cOL~t@_ZQ!sfmt@rh*w>3$
z*UEp@+1n#0UvwBB4dhgQj5X)@+q(BA9ShWk*8P5G8~4s--&tJv=!w;8ClMW7uI=(Ii`%acY|->SZKcV_KK;I89LhnyPAh4}MrEufb!Z-Cr226&Jo
zqp>r_NUr)m$X|2G_lE+u*_ChcxBhR2`?8Tajt>W7MIQgt0dBa^FRtZ>Yxz8xF+Pod
z{TO-hskVPSw&?`%vX1vt11ELCXS}uD>XGaSdOP3D7$5qz#;*Lm(H|P&`FAJ2jr^S*
zIjE;`UVpZ-4r18%@B1=75O`pp`GZb8*iiFF
zf~}ynZEr8ztL%@q-W(m{-2JFd`mYb
z&(0#y9trLV{P#RDbBE3a<6D~P(r5Li;r;Uj(>fN1zW-wkoasGvq+{pCJ1frPxlETn
z&?_d+7LASn2Xi4VuMFhsn}UB3?9cwI2N|;Y=d!-)@%;$A|2GA6?S`Y-AM5RJM(H?T
z%;uYeU9sm=KU>woRxsAksOu|+v;1Gh8P~mduSaIo`?WKUzjHRfd$3#1cSVOh$+NXl
z-F
zXZz?E?(R(etG$zxfAxzlvb*`Wn~x`RR{W~}&Y6FIVYdHclPvr6vS0uDp7QJJpnlz%
zv0Uxs(|?>~d%yPbWhZ~?3%hcKz*rk!n5A*<`vlqgfS(-6iTv=3pX$BbjK@6TGU|LP
z^XlB~o;WvRes5kj)BE>kbDyQ7-N!PoUA(<(@}R8;e4DSi>#e~ImolSo^r*oD!D#Et
zGOw-Y;v;`YKM&9J{)yS#=lW>(&dh5UH$L4Fta=ANE$doq=?`ZNW6bv&v(@vToiR9b
z{S~5I`5{i_dTqv9byweW(d~Temi|%q$Xh)>7vSLh_`di|Du4IF_YwEoJ(=gA^^&d2
z{yi7_WO2~OyC>gx@N?vVYu8%`<*=DOV_Yu|YT`_0d;@OJoIQ6#
z6O;Wx?HJd-@oqN#Y^1T-Ut2wwF-~maWbXT6x!7}8^T$G#|8HYw`MDPCmXp1B=J@jG
z37qJ;Eua(Lmp}XC_u~6Kgqbe)aXMp?Cf2^=)mLZs1!NlE$1pmj}8b`fZ5?r1=_yQ)?HXzOiR
zXUloKM}6#y!y?eSH`<@up=0E_>O4KWaoxz(ZP
ztgY;qi+Wv5@?9J4jyA~hv!6|TSr4qw*A`jRjt6SJb*7$f2-K=Ed|GOBUwSo+8}O%j
z^mdKsGhNE6LGQBH&Cf?b_V6_B8XISWQJx%F>$v^+Ip*Eyd3B2;U*8fO4*ITCW|fUq
zc19cG*Yj+=KKQ(Vt&Shf_;Z5BQy!eN{_)egn%Cryzv}^gV&uPXPPRgIW`1sk-eK-=xr|&O4m*M4ifgK#}tp%FeKeZg??@UN-w6^HO
zqjGaUpU9s27jLca=g9eD*2`n$Pkz)V_T!viMdSIBIDH`NV*1M9&j&vk+>rId0+Lov
zo#SNu+Vn3@PfQHxu3on3<*$B@v3C3nGtRFabc*YJfxOY#alcE_t63Mb${06aWOn0d
ze-+P>)6Ya^od5Jp=NMN^*cVfEcPw~m@QOg3G;tz#A^*0v3M4A$thYcvN0u(ju>;<`
zj@xJHvK&su@nLLDt6ls@_`cNnD7WfP`s}iyoPZ3Z}c3tAt>K8sHUxc>F&&&xlQv6$hDQ}@3u`+bWyvhHnvIN(2dd#3|6%BDE0
z0iR2?Dc0JPff^v^?0Qh$zE|H8u&3(f=@9qek(s<-C$K*r9hd7nexoL2{G
z{ZfFRxPC?;N9;Od?e_*6o$Or+Keie(btgt6U%rmD_;HzQ<;^}{$XpfRVNa_}^^#o+
zMp^OFDl7J4b}FFv&(1#Q#dIscdl9JBk>AnGwfcT8WB$Sfb+J$L9>AdW8&K0JkecX}Kaf%eFD
zx4Z+md`ITM*7bqU$J+ur-x7Rz@O44uzAa;|w)O4}yK8}Ft#u>sa$dB9?nQPtxHpHhojpbWjtjPUyW;B0)mhWnalUoazX#+!
ziXhEd56X?{=%RNcu)a#hJ9GV%yYcTIuztg|zUuF(@@CO1XJbD9#*b|OdIWy__j|C$
z8vgFt{M%>qZ=TJ+dN%*;%;jIct5*zvb@uo7{G-ep%hB(~bsnej`wP9Akn*$k4rI)(
zdeGa~lX2d@=B+R$*EoDj_=r{KzkkN}!}ANA^(SJ_`}O>NHqOhxGkpA~SsP{kXy)Zp
zy`MXs!>#9j@Hd`)?sI-^dmfR??{7b+UYNDs!Lu2gyBA{V*HhjRsEvaO$|C)*1tX{X
zqkHuGrp$3{>_&fH@}IW%x~5)UFs*ra>(j6N>NEc@cDn584^I6}!`vBn<&$%!`Qe*&
zF+7%ad~XZb(>7AGdOEAicNS;dwXe??
zaxV$!C--&#W}63JM;kAgY&1rEch8Q1|6gy{-FQ~KzB=pHUKWgJ
z?0r`D)WV@8w)uD8$Q_ybJEwm6IiB%7)BF{~Iu3Y$L;lAn&Ylc#V?!P<#K*rn`Dwp!
zCyd8?WnSBA)BKL9ziaAowyqZRzTfD5KW}X18IINuk^~lo-dX2j(lkTCt%{JeNFzL*}NA2VD{}fTVLk!
zbNB4eeP~_MZ@;+{FLR$ydT+Yk_Zoe3eJ6VAu`}LpO)=&0DLBDglv$$*WV~j`b{Nm4U``!23n_0d5eN*;d
zn7*GWw`43X&b#A!KM#H5zx=KKy=w61QubSK&VO=H-`ROIvgww(Po$?;9Pi3G@@(mg
zgVUI-HS+rZ%G|xcdw$+^fzQlIG85B9X>*x)A?M7Q`()ZOX%pIF`k&4vgger-xoBuP
zNi&m%LIIH$ER+-w5Rm~D1l<5a0atOCi>`9BT)eHQEH?$jE+VL)?z-%<>dX3h|IhDp
zc;?stnVEL=wfn%Q&+Yqszn|~rdH(-%W|Gv8*3=)I)?2G;h%7GedGEIF*6o|7J$B#m
z&#t^b&t%@Z@4MQVl#3c{Jihstt~~$Mnd5gU(2ur0H+%S4|Ae4%!Q;n<82*!gdZo@E
z$h;q8
zC%rYiel5P*dugCQJ@ubA_3xbe=cfLPr~XT){>#(5SGZ~X{j9*}LfjSju@a8(}9du83(?Jg%
z&d{OnoZjm39&QHsu|qdG@51%+DxVv3hOhK50!_TEYd$B8*%m7t|K$)X-_3CG{?b7&
zea`U}zmEuB7u*}z8{Vkl5M`659nPBnr~xg_}iG|N3Zv*pVm!#`tAwD5WjEF8Do0b*ca4>bqyE$XM?e(
zE@e*Np+J7-d9PkFep}WL~^HYB=JuYPUEO(vXobjze_nfb;=9nIzbM$yez`=o5py0x9QM3
zV_jU$>BG4)cpI~gyD{74&$c%57dQGe_mlm3F6p9^p86$jblaoXp1y1D#73|PwC>qo
zSV&te|M$21RrdXy`TG(acKgQ2?a!q?)w?&(J=+Y#10V6iN4&ga=6u9KOvD>M=hd*b
z9*~g}^3I+Nw2vNadH0S6_8TYf6i)b+6SW6}=A7Sin}@Q-CO+D^fXv~5PR*LQ(65cW
z^6SE#7}Q>Eh>Nu&!CIibJ}?G(=BN06SOjas{O;L&eVEs0I&fldBVdm&TLE3hWcc0O
ziQBxsvb2oRgXziQWb909&6+*yji<3#T<;xnPVSv?7C&?AAIu%%BmWu?`2w6T2F>@O
zjM>^3+#mRzp846JG0$+PUR!g!{e86B6MGOFHCMg$t##OXbzjG`k7h1**7b88_*O^1
z3p|!JocYN|<9Q6o@|};kh_^ai1R7hH0&8k#Js`Uk%=OXDR`s~Qi$G(epyyCP&;Fo(
zI**SWdrR3oKlM0xXUjnx%7Gq@|NcCOT{TXRpR4?LQTYFPfx2hYS-E&3@Xs4Pn|?ER
zTfi@VXx8bU$6K5Z2K1>*jVxYQla;5juFhr7UMMWvIOaQ!WEO!o?pwb&K^-pw?bX}e
z&fJ;3)0#74cz9T2ho1UgE~9-sKpw~~0*!8Y(?)rG&IaDt>VJF2zMtX(^gR-&3q4*(
z12GzFf_}Ql(e+%QsS$hD-WA|27uM9^je&IyA5Cqrb27jozmmJ+P4@n>Kk86N^6ad3
zHV`lT^@~7TEdTenKd=3~#l}`Jeum>qr}uqt{_h*o1HS5CV}p!3!&Uo+8P|hZ6BG4z
zDmWBab5Htq>i17`y?l_nDR5R>W$W#OEkFCxD+Yds(R???OU$1cWZhY^IFV;#W9t9k
z@Z1|6V=NXcY|6(d^O9X;<~$nbzJ=nXUc^q$_55fr26DAN_4T#Bw_X~nbCJVMob}+$
z)jk8nta|Urcrz%^lNoD2_n+Utc5(2XU?YS3(mS&Vw8sPaBGbB1D=^jt-+TY~xfb}$
z6$`by2sAOF-(552m$CC;Y|WlASvrj6>3Y8l$cHm(7H?xs=s5V?&!N3nj>%NGl7QB+-C2JT#A|fi$QsPO2&B2<;2Flzb#N_=6na|
z7lEdJ@NE1~X3YP$4R4Hmtp{RA7xb-Qn+|!#P5siRW{l+yjIG%-ChLrGxf#>VSL1zw
zSQ`6GWXHa_S~GXn9Jh;sHFnNVW46WBI=!pzi9KBA{rGl>qgvbCrPlUlZypm||NkBn
z`B2Zh#f1;zGWKI!#7z@#aTjYnTncvkPUY@we@ocbZPt6`9XK4QL#^v_eR8>S!wvak
zlK1<5qXsnRdmr2x-+kyh9-IjFOsL-8<2$o19{TGAUC!WToIkeM;iVqfR;y12$AbEF
zG2=y`S$B5MPfT0C%~NYk-1*5rch~2H-Wj^zKJ~`VJ{M?WxPO8e`Ma#{*+$?UC+n`c
zD{`pr)wX7gzqiZUYXdS{0Xx@{cZLo2z+|$80TS52fd?b$*G7@ou`k
zf1^$LZQSSUbME-atGvwj#6=8RGw;e+c#W8E1!6|c2G
zdn9mQ)fnHqhpRnvHpGUE`$?BIdtwB}M*{qN|F<&k-NUvri{G^2ZL_y{C=a{;ctz43vLs*xscH^S#!}joBy1R%?VUIXoF?`RfNe-^tvE
zgMl8e<`!RLai~o9@Ezl_))sdXHpYnRjKZi7md~h?fUypr0#e
zGp--4SAOt;Ph(8}{_y*p@~^IlUJ+Xy=kcJk@sXRx=bnuDp^pB$*wEXTm-_hb!FKcE
z`|DbuZ~d@Y{?7MpXNxX!cjfQ@H@7~Yjs|>fEy~4sPsGUnn*-;@Hwo9xfX!!utL97+;LZgk!f$b4LwD!tz+Ppo<858v
zbvn9Ecl9*hxT(Q024c!*oShLbK94eEoL0q5KGOnMW&GD*^
zQEucbuk*d0SykiLYge4-{MhaJXEGl1BKGR1cSH`!J~>+xdvZNH%5|-^^3-rv41wLb
zzkN&85}D@P`1WaSe&%X*OjeN`NGI=jRj-(c@2c3UFZ<=sPxnb2v{h#sPd3g5?6f}n
zS#u$4n*o`J0_}8w8=cPKwEZT%;D&#lG1yxK&U{7i)q(YI48D09|Mm1g9BAtA*5F)F
z4&&WtgH8R#U{y@{FQ@cqmxA5o#7X^XCOd4~x
z_;e(|U*jj9WcBX~G&$J{(SYA~1bqXZk0G|$_x6)J8SDwR^8V4+dupE_^xy``m1AiY2%0p~U1^WW}-xlzTKC)x%)C?PVTOa*zj4o$ga=Gk=~9No@Ed
zE_kcw@vL*|mG3y64O+8(Px$Y1j{mK%*3YS|(Z_b{%Y5{WPMq=4)X`Sp?__*Ya9?mZ
zNnND>t)O=!!yA4!cSG(^2Dtj~=ZyPr$#+cqd~0ox<@1lu{&~~4{DGD`
z?DM0x4rX56V)DYETL>pb`R6`6&-8|eGsnC3&dlbg
zGN-Hix6jW1$LXK*w6FczZ2ohZi%HM_=xqNhGp}FeC9j{8_4?hI^2M9f7(9^i&4K3a
zF|H14{@K(qHm{z|PfzpmWB2!DO+0YI+1jt?FI3U1*=tPow@&i|Q_tQio_K3``h0&y
za3lrb9=kR4;-9sHtzJ@N2&U5xu~9Labqz(HK($y>yS?+?iGpH8~$Yv+Qlk+)8#bALGy
z!k*&`*-_@L(_Ac^`KDlQ>l3r4RZng5W80JM-`km021oC(R(WgXhzEOL9I&@aMx4of
zexN3+8~>g^ld-wFAj==EvTXVesI9V5JzLqo77sNw@)+Y;u6}1b^7*)F-uOP0xf;WF
ztUEdPdGVnNCvDuLd%h>HYNfSUf91sAFSsrJ^@44(TJ`XO4Kd}jao76pd_mUoQM7!U
z?#`GVzKLnyRCDq^Yx-uqGUN3?ysPVU#zzC^UT&NN_ob(65onJGc#N@8Psf83)85nR
zpA3W%)F8d&?g^aNek|V!^d|#r`A67y-q`BrFWgZLKyd
zyOuS&9t`+I_9rv2wlS^w9I#Jc_vtzqI5XZi{-{|sptiK;uKdNEKDCD5nLrcA@}gg(
zpR63RZ!CT|Su-b7j&#bEbvdrBeHr`Qw~m+m+Be79+*$MHpWX{WYvKGfX8+tY#({r6
zZ*b7~F0S=OEcw%X9Lac$lfB9s10BxI*Xej7cymx0b$L9F+QZAff4{u_Rl51Xhx+PV
zA(#CO_{SL^2<{CuZ(a~CW
z-@hjq&+&sS895{4d#gD)^LJ0<(bgwsP3u~1j&*!!TVzKDAGNAge&mQNd)|3mR>`P4
zG8Y4}sC|6J#NMf3?oXC>WZAsh=SF#aLgcQ+Lv4>d#(3_}9zJq8^6}=3@nxrXOil3#
zM}BCn5AT$AFp#tD&x5_odm=8jw*ocGw$}LcuFmUB&1zSZtG(wUrzXTiV+W6?hH?EO
z*L!eh#)Y$E{fW)VK)XBdG=6;luz+1Zk2>>Yz@8k}$8pSm>*LQ{ClZiF)_yA(?R?1e
zc~HCmPd+ck{eL@~|7zymDDt@f!fgLrGZ*{re_rO|BA4DXdyT)|p0^HXP0Wm~SI4JJ
zHnMbu9_JeW)|7fW86#@#@}#tRK9IGIp!wadnHMboyirW~ffRBqnv%WA$ldJNq?bZgK-dl|xev@AdG;4G@*Pe{J&}-G%^K|bG=+*`|k!`#{0q?^z8Bv1FHC%XtVpV|1*
zjr;N7L_h~zE0_F~$2sm;u~r#+jTeDdzpQs`{X)QhzLFnfA@}B|1996Quqh{V&irk>
zTZ6Y{?OI@Sl*x2QkGrLI*}gdtyRjbY$2^{`8L~Yu=eGwZ12M?I`ssasCxkOO;FB8U
z|O0U^;Y)l
z!>A+6%lq?S`qrc|Kfss`d&X){tr+9E+jm=Uvwb~Z$;(UE&BfE4PBAoQ>-;osOs%so
zR^Dv(HU6vx^+$ZftuZ;0F`Jqg9S&B-aJSetht6*V^v>7bmNm75Yi*NxZ=7Nq=bpJc
z`b*=`N2aG!?yJ*xEdGeuqk)*xBmVZ(*keKU_Kn~--sS0xn7NOK19LVm
z2aTgS$PvHz@W?c#ZzG`Jo$7baq>OInexhTY5P)o
zKJXRq&1sBR)a}%w^ZXHG_B1lMzB9nd{&PkI{kC?R1bfK2&A|C*f<>S$mjCh!&-{kU@t3dU8b52j7i_BQqf@?}#pS`k_+Wt3vA}t)dvuDKd#Z-ikGF$9
zb9y>|Dq}jVYid%C+1KX(Zh#|Mqh~AlV9qtZ?6Hk|-()<`2OEJnYzFn4U3D{_r$dbC
zz?-c4#}C9ouI>tM3P%0jTj#ph&yUW@x&ye_W2;E5adkD1U=4rc=~bH5u)zrTJ(=HNZ?
zxn_)y-uDfDo|@*??hUl&g8yF+b#AgLecz&tJ03XOg{_?y{Gy
z9euZC{HEX;i)pp9mhl^cCj(8~e8&(YGJH4Zw;trD6W<^PjU3-*puHy
zps6qSRZfls_B6emu<5+~?GNZtH_u0ajM{Vl=74P9ywe%?KB+-`PX^>pPj893={t09
z#&kJ@3*FtjBjclidXR7X>JJ}{Y<;Ys>^phgk7BW7wI)T76xf}
zwl2hqEpeIK!k;XjII{8J)br8%;-1m1HI9wJ7>{>k|5(8Ht!a#FZHo1y0bOMJdH=!w
zJrO$O2Pbyd0_}28o8rlC{lbS|jn8PCJ~0q)exDC;Y##V*AAdH_1X_JIc7|?eDrer>
za$a6)mmYGXE*!O0y2#GY(>>~+>l$Mr9?czH9XCGi7>@nk-?&!Cp6o&M-kPL0|BBY-
z@0aVFI&#-~momKKvySiL%!c!0F4@q?uytYT`_7Z)v;KNPXZ6v!2sHM^{N=%iU*+>j
z+{f<$7c=eJr(`T{w*)5x?H^9@aDTkXyWMwr5J%^)6?b)oyZ(vby+PwQ<|xZod~V7s
zZd*a+#iQe=hH-{FwI}Yl;ply5*IW5Oa8saFhdhv1Q{*oOmx8%$bF04lzPu`9tu@iO
z9?058K(2eOf!2L{pW7Yp*1sq+?E8*rtnrEd(WY_pCNJYT=g0Z}%+=26U22Ey-hj=u
zz~?kys-yYDfp4VA^Fbrq_^T~@-f#rg5v{0^ys7gClcHe!yG-X8wtY^=E_8$r3@WUqemjXzrcRmWHSJ-2sfelhF*
zeCUgU`+|E@SBvz&6{ySp9#PK5dE@S$SO0&S{+z4x-x&VftNdDrbp7o>8^_(}lRBhJ
z%>KdjosQl8f&E(p@xkGqpfR~Of7kIZ1iv$XC(_@GET8X;j?oA8p*B}>`=P9BzgOD1SpD$y_e|9i
z&idwQE#q&<{;jihw%?w0a$0RTE8gBaV_ekl`RBU7kU3lQ)ZUM0tvu0?j
zym!=j@q1bJ8qZ8`c+qTrOXhTvmya7VZ;s7>GqpLM|AE>3yECtE?swxe#&Dhk`DpCf
z_%oBv43{yYhacW2XM0!V&)O@3m&K6Jjkg}#em^c|tgbyW&U$nCe>^xbjm;|~ej5Q_
z&jz;!_S_TA8*(t{Teg*POf5g#=~;Eg{d5NZhXRcpmHlk~>WoLQKhDSTXHR?S-tUba
zbMnJ^8*#@~{BdAYz13eeVcj`DYw%ZG#j3s|ekOBrj|Jj;IG~Fk)g@=nye(i;u6@qG
zJjU-!Pks?-j|cY$rvi5cr=BB+gE#F%16-`hF&>)p>|GAze{Z0Tbyi*TRiA3Mtfy(`@T51>TYLi8GAA2Pw)1f8RIX`Y>sg@7ZWwcp4iEorY`+=
z)?S=`Js{UTe9X53V|j0Vvju8`KI7H|osZ@5;R_$`kAVDIzYry#pZ-ulw>OHv9}yY;
zj56*N8I655$i5=7oj;v9JI@AB27LX@;H|->Kz!_x>7MZy1bN1npQV31W4)phaj@yH|?5lQ>#cMA6kt<}``~A~8UYfj%-?@OF
za-o->a(p0XaB_x@S7+{wy4I6*mo;N|i`*h|WaQ>lppL|*`)97QAF(TRz2+*iY@MC<
zpUC))3F65AT=wK$&4^RSw`Yvo*Go>?eZl#`&b;Otj|-7mRdbE0Sh{B$f!w$k?6T$E
zr{{1$ets{UEhqILesa<^^?~Pu;owcOKJvUd^ZkK#K4`s*(ML_Zt8e^w1k*F-Xcad;
z^GhCk*K7ZCvvx4(-5dR4`=MQ8rtU{s{*ATRILnc@T5Yn~xmbL3blWSJz7t|0{_KCu
zF829p|6{MQ|8dvY|M;uy&;9c*?9XeUKJ2|BI1@Y+d{Xde@W$X$@Y#Vk=gWg{41Oxu
zpCBCy{IgqsIk-8+b!TuQ__*Lr!Ji1eDL5Sm&jcSEyd`)p_|w661@8&?{t3HqmmB+^
zn0>MJ_jo=mJw7qJtiw;rUhnu=ht7(>^MBwP`ak&^`>(ym{=?VUf890qUw@T-ex41~
zky?8svU7irW}UBd*+)MB*~hLSd#yWx+vCxZ|9`)G;JvwJ;y2gxx~y*mTHpWr`Uj(o
z-aj<;Po!4||2lV3em8^0V!V%^GRePT>fe~&cbeYiu}-{I)API3J?iHOBzKbih&
z_gwr(|M=0j!duBtGF@ZW+Sag!BOR5!IP7^#4^H!+j$p3C&gbRz$cg1slP_;dFDCrQ
zXN-x@DLil;{c-;3oNLT`2B(vO_KW#lj$C*Ck21%Nuh963^XbeF1$`&y_C`H_b*A?(
zet>!}#E$y%nS?*T@Nu_BJMWm;`Si@?(OEv_NxR|ktU22}Hn-}$Yxb{}TRyA(y&fiEbsBgRRlG_hdZqDb@#AjY(
z>O@_N(Y#Lh@k}=6XZWb$E!hXs$;ns;4`$9k@h^Nn_ILBI%9zc=fhK1@Q#7@sHtdU&
zv7eE=$GG4*udg4>?*Q?Aa}JGl_dQv6ruovF`>w-xIb&y)&ObTnd^Q3;ANiwJ$$tJW
zdVP-?^=@S@uQ=5Pf12~PjPd@o*wDWv{i>RA2lfZmLH5%lE4Fi8pE2orYx?~Ea=&j%
zxs}hk?DzA5E_y$6I{#Ty|Jmu;7(XAJX-&>+?GI1qK4bbcUKe}HRyd%)~Pw$xb@xHuu_V1Rs
zCv%+N8PM~}z*{~34D4sb!@=DF*WKeUoOr%->c1%cD*x9bdt>n0z?(4Ycy2oTuBrdx
z>(FsxrsGSdvtK&(f9yJR^ym53A5OTttMarF@Kb)jY|{JXQ~wo{{?r)87S%
zVPonJm_Hnd#a3`Ea9`LIe>UlKFO1p#X0n_2;51
z|G#6SKcCa(+~_;`KOf=Ue9QJSuj<}8%^S1*jbZycidp?8=gw$d8@c*tu=p-MILa4Z
znp$g3`@M~Ls3U7^`u7>WH2qrOyO&lQ^r=~`Yq-d3@3y?I2U=}8$Bs6x^&DTEo9BRT
z_NqI>o%65G*g1ZVzkh0t{r7QvzSkJwE+@}NMn1`%3fu|z%-%Om=es_}@O<{gYn}(^
zzIlbt@vJj)tnR-hvYnsIT+1JUF7NPP$ljP!|31Zw+4t@&0?qeAoX787-k;;ai9meV
z;v*S0P^JV#E#}a@c<4Lq)IXPr_HRpb86e2
z*2pdb@oApu`Z_FSg&F4Ri4!-}tU)
zEVkaIy}@I_v4FqiP6hUHYAx|)D5KzMAXhZ#@vl59FLTrstd$3pE6-6a2(fI~VZ9eb&UDoL)T6PQZtp-`C@PFjxed
z80`tfiwtAUBOO4ec!*2>bM3o+-hFZQwK4v5YhMuL==)Bm$M52V+7!E0yza?*b@=;Ays2_yGlz&^d!)X8YepE+vwy-EDH-`w>aF}j>*!@k&cpN+=PO%F)Bl>x
zH-pClI&TaThNX^j5J&oZpV+WQ7g_oif!L@OJkJE$;{n;r!SUe4G*5R0Pdc4n#gUzn
zBfqc3k>9&<6z2=UZalNK^5<1H<;FR&`MQv012_D4+hb4saB5t{n!noFfNp+T-y1Ym
za>rk_=RCX5#~8VdU~5{#h3vQ{zv|GMyvhwd*1Wgu;oYBU)GHop$Nkp)^P6mXQ=G3%
z*Rr(Kua=!vi*o4vp5QO7I8RnQ)D3Qr1Y!rh6L|86PPV;;T4TiqS^RMsbJ1A7I_nx+
z<(nU8Q{v!DEGen{<`^~LyqubQylSqSD+bh1^l$Hi7)&3$lr5;CLY$@
z74qhDy?l2bC!C!Zx3>q@)tWPWEEoHIOYrrXD389Ee@BXpto)J#zImrlq+bu}gFSZH
zkr%NkceP56O}gpBt@*@Nb8ao@_X&Q|+0PI<*}2v^F~#%w7<)SX#x(Ee(79=i9{Tur
zXMi6Y=JG+u{Bx-5bjd-_uu)y(eV~ia`a7onK>G1BruG`U{n=;dY~cROiJA~YIU+As
zdhzLZ6Z>MPPQ*@J#X{qY!*583D}C%aud#)vm@EQz%S(Nq2{fM}bk>fw%IU??8zzpM
zfi-@!ej6I>3;2i|U+}NoTE_fnUGtG$HOEK!
zx9=TNo5ph=$zKjyi}jamIkM;9y+rn4P@l-Oj^vA+zbjk0-MEv{oWCCKVtqZ_`L9m(
z_!x_WIg{pMC>O^3;G;S;*VkwBeF0f(>p1CpYGFUzo;hioJDrL;Q`|mbdXPxI^NF
zD7zcRX=+OT&8^E9dyRANL+_rye_1|svPXtZ;Jn
z&*Q;~z&!&o0NhRnWcx;;|MqmgYE!AzkBpWM1xUkp;4P{`^FQ#BVdG
zyjb-Ps5PHQ-x-6>(DOv_#suo&^muIr*>YBVHS+YT#m@`u?F;bxixWTbF2CA+Q`W9!S1mM#?bT$cEMvn*@p?W*_H_D<
zX+Hm4s~tQ#R)fuPb*puLXmV^U?}vl6ptk-<#%%HB_TYMXwD$D!>28iT*^+O*@R8hu
z(|Defc@6SGyyT_+$Q7uElYw?T_pg4}pGUL49~?d!#t
zZR>p87iiuCx)*`wezSQzI1%g#H1WZ2{Bu;i$%}Y%4`f`Wtl?wt97
zbaIF<|J67hIOFsBz`vtF+(z(goUa;3WT}V!TLU)LDBt_$h@ttpKpl}2XRz)J-_?lN
zJEuO@g376Zz0@hV^6
z4L>aN&ER6d7XCf|$EKed>X#VUKN|3nud$|XIJmt#YH~F
zSbQ{c*7(gXTWagJ03SJ#yEB324crRIdlSmjIqSRevaZ!08{P}tcC*p^(ajIBei+#_
z@j4V73B*Osc8`dCd3MhDo&X19IZ(UCCjuOd`NC&o{`Ji{nsLAXu;)&T6*=#r9EcIU
z>g4;ATQcRbnX!4f9GvFmvoX!fX?>cP*WJ^++|&Yn<>&j1c{$3pIpBz&v3Q!}YA(m-
zYQ|hX%nwZSJEr-a(_C-gI(c&D&Y9C=POmvT=Iol|VQvg~n)mx+znAs>emT%66t-CQ2b<;7h6nBOwZ<1F<)0X6<@2!_kHBY~uNpf)
z@==%9;`5gVKF-${wRo+we|b8qUc6B~t8TA#_PeIDYERyJ)}6T4*}pQK6=E?|Z(D(S
zRGX~{oV5Fb|1oFScy!1MJNEvkUH0s|doKv&(7ndB_4IJY_1(BR{_csNJx#5btMl^h
zuHr|py3vfuS!cs|)me8-Eq%{qM=fd2*JjWAoYBO_UgPA*(m)?k!jg
z#@OO{J`h(wx6xU@s`F&loa?{ymHfq^XZW}o)K}-&)r&p(xVemjJ8&k@7R&$L_KOcA
zudU4Kzt-=Xy{B}lpGyH=<>o#g$Xu+&O&rz(^;H>fj6FVUxB}bu#LU=tp@-5R3^Xzq
zg1OvFvqs-2SD80vogHzKXR*=5N`2BPW{bd`;Maoz-{!d$pT0dAEp8dV}B87t&{r6M{)9d
zJ$|nT`o{vX!AZ>6uN>d;ds`sKc#*?Zj?V@5-Dy0G=eZ?+InbQ@Z&g2h*vm*7JEN@+
zw(gx115I4ShtIV&BeA=~(fS?7;r>|HKTF}*opW84!nHtcC)_TCtmFLy|sH-hpp
zXX9dEOc%TQGl52*^BSJc`fSGrpPPawgZj2LjO!b0Huj-Y*W=wtq5kf7st2;6)#v_O!n`
z{VYg+GdLKyCq5^AHnM@MdyP-;2j1dCj{ln4uP@fw!;4L^aCgk?jUKt+7oW9_Kn+=cdtjX|pYz|FgM9Jsh(XVKTQq0!8|~gV
z*i{eWO6NRg^nYLUh>3k1w6lRVF-1Z1><(niH@3;Ow)otdR8Xd&!+W2+^fGFFHUQ?v4z8)
zVeQB?7DM*K_xvreajVzd$H@dMoKkAHVd3=8!lX6|!i*U!e6WKFY24}D_oPOB^Y@TG%IeeZ|f
z+p`{s2i@{V&-uW4dgY}&?JWY0ULbc{V2|&{)-+@1#mK%`FN2kiPJFDtD{vOyt$>`E
zJ{8m-w)O|)ad%!XcX*1II6fca_oiPD>R0y={_w2JYhy|uU5z)L4+iYY{bsM552JHO&@TRLTa_rip3qQR1(>Lp(
zY>wd1IA1l6$Wjju>Ies%)vDOA+xVIrx93ai#TuSxg0*1o_abW=I|qXCtTnN2e=Qxo
zcet|UUR;{a`<)lt$b3?|_29Kvg|9Q}dXtdr;4XiwhR+s^meGFM^%eAL(=(^_#y=FqB9
zO3a~p
zIJ_nud$n^QY#5)&xixyvk08++#1{#+!@$278}jjTTGXIewFJF?7~&9#Q6Cr
zemeceH1~T1`o+;24szu?N%_b_$L^3iHFsC^{Cgn4L9@0>NAH7udRh;10_~C>fUhHXjIXCAeR%FDN
zu{Wd>OKa{9`x<>X;=BmhC^wwvpUGQUtIZ6T+?=Jy9m0h^Xnpw}PA4vGp9l^HzH`!l
zC}>?~xV&3lXM7}Jx7_4KI~SCj9!5^`Q9Y|T(J2OFY%|@7nf%$O
zcM)h}gSW=Mc;kFHuzo$d=0A&-M~?4&FBgl2g)}z#d>|Ol9?jg@(PnE_T4@-y97yBD)2ZsX5&;^5~dI#<=0HG6D{8-0sF!-4(A?v9Mv=#8DG0t#lOWetkIWUdyPEWpdz*lEGuN`a7;cbk!c!bgoKc0BtTv?w#
zWW~06)cYdPa2Ch%Tx6_S-y2x3uBS7uzw>vH&9f8u=FIrB;v#d6UR*Tt=YmUt^TzzK
zekRcR{`2*|;0N8$LbL~Z=!e7
zyBK;)Kl-MR?>yg~KOUS2#236x?BG7uPWRa8p7(@b?BjGxa5B*T;)>tJH9m*3@0=J|
zV-Q#Qtbg>#&2uaCjOWD8IrWP7T0mDn2kN_=kSlld^?*P0wI1d5hoXSo-Fa;3bFTHx
zMs?!o{ENd;t=JR49NW1Azn-6$k=$0o!VAC#QoR
zF~f=c$YJ#T&4Ya7gCpPgL4W1t>thD_>d*3y{SVK6YgR8VbgFvJUh*;HG95mI`4P+;*Y0w?~rwW
zho0@8>$<-W-}T3`FUKDhh|k%eI?3?gyRMdS;G?%ke$EB<-7R%$EEZ=1?eTzob>gGV
zb*e8q=^u68G0Dz#lCRF){%$|+bc*+=(|7V!Jjq`U`i74^d*Z4loRyE>HS_L?iM`&9
zd2Yo*?pn(k-tdy4URwKf!XnU)1#*2nI1$jJ)i1FSJNDsHAZCYx8v}gCv(D2`=44>*
zyG{9u(b2#==jZnyPTt6~15X5R%pts-r9=D8=pc6?P)n~5`tPJF4}D{+?(PpXdYw^c
zFAcPFLDz6`ZY^+*KXmz=v^STtN6zO)>qYt1j$W+fuK8+>XK7i}C#L;d(zD~viqZJ@
zh53t@J@)W3XLBnMBjb7e`NlpTbbwlwlg(+qNUzbspScca#vK0IkVCa}G!UDf!voF-
z;`Ppe&tD#B#*MSQ^5=^KJ~gMK3|(YCKWHxW&BbSAtnsnFZDdTxQ-LO)HV>q;=WJsl
zM)v(4liq`YeR1o#ho*HpKQ`D3`dKfxw*>Tc+`ThdTMOvxyEC_Cy=%WeWA@bwozAHV
zGV)-I7Z_W!XH1s=#?E>>jOkL7#`^+qgR!@~b!jdq=5&_7Ilc1Iz4Ox;2eGq`1OFcg
zaM08fUF?H7Ug}nyyn03qd*(BCIrDU6@VOX>f!fjJ{@Gx+J-L;8+-l=Tcd>CiGADwy
z31Wgbu6nwlcTV1{`Q-eVG5<obD_=Jv*ze^%!1{#L*)n>aq7Vz@0mS#dcR(9;|m^SeHu&UiDJ%Zd;E{KSWT7~}Pt
z%<*b$4rEN%V}bXXU-YtFdwVj*;cWq5y_gF``a?3En7XS$MbZs9^gTb9M#vx|5Vo0%jhE>TY;FY1={6+4%|V!
z@phNR+j(|Z_2ogYc!{Gse-`)*9{r3c7fb+NKXL#ox4Cul~Ey2lvJ^w9sIe2NXKd9e#
zW$bL<8NB(=#-V^d`y+oj6u*P%@naXSRXo{u-roaKcVxu~jIF6FW4!4xuHVMu#}{MV
z=a7Z3a8#kM)!_W5JZ?uBWL%lT=H%eiTci#&N>`KI+gk!wxAJmZakjp`L&
z9Od$2P+7L^$w^~s4CVK(j5S=HKQ@iYoDKLYuG;vs4vx*q$gl5Q*ZSFoGarlQT+GBz
z>*vSVm-pW61K-pG|LGJ1M%bruI__
z7SMzLsQ@Rs`k5{F>TtAyqlUM;QQkOr?{dcC#sBgCuqBUTJJy`f!x8Kro~_O2*sW@#n2l<
ze`As1(!N;neYaS-`^N*i#AmFV{;s7uM&0KkTmF1;9$#G6rnxwc`J!j6pG#RB%zbEl+
z#P81ho`9_S{^aQ2O5ZrXGGj5sK^}aEZyqX>rJX#Arx-Tx#?Cf2&txoqjTZ1{PcPb2s;&R2~i@_s*W$l0d_jWd7Qem+H`
zZVm=74AdSD_VCs4>Sye@_V%osyHmc`{aC(K@%@3o=LB8sIZG$~e7-o1tCQd-WopmF6}<07t_vve*3{+Wx7dOH(nj|cOI!@1!@$>z9shd1ZtTdbgJ38
z&MYnKWh*^CivWkX@P4wjPxja(*E_%#_!{XKnlZg~+%+a;|4j?j8%&S@XOqKJuX^|8^Xev&KKeo$u+FGp2)I_DA0G
z!v}B|w{QHmujKhO-%}sso_(K_V$<)nCo_(FSNvUw1DS6I<-#}d8Rv&*bNLxt#RJ?{+(UoOV-_RPOXWBw?dt2#%yb1**Y0x);eqK
z4n+_|nI)N>{Mvod{lV57<@9yGz
zw%$)y_1Rmc>+kKN>v-h(#wMH#_~U0tjV^D1CU$DrR(;{azG>}H`mI2HecUkq=!`YG
z@KmGPPvrLyawkr7Zv^($4;yQN{k}bVv7grvIW}J!XmdN?w2Phc__FM?zgr&ZW7odA
zQtz8V>s2i{-**!CzFlm{|4&Zer<`~94+hSQAMRuQ8+(uJ(d7(#8ZPS7KE2&{Uo`vH
z%8l;crT=A@8mKHEaO=GgZ)e9h*xpv4PQ3%IADjW#JE!rv^yJG)590Mi@Wvbb7|$Qh
zoL^gk81D@?N=ldN)KCIDCmcB(G
z&tvVK$y|FpAb&ZyKX`8r;o>}-_B8%9mtwmX+!4r)7}W3P%KW#cH=yynm^HqQe~*?e
zjZgJUE#bZqh>^ETuF2w|Ch%(ws>i;k<+z@;n*w?+1Y+c@TsSLE?1_2#d27hp1Mza6
zT*nV&ES6gRc|J;?&KzI0;kj2rO81$T4zBv#lw&eL_p#9SD=BZaQ?ts|o$?XaJJJr~g!^-K!
zkiFJ}{rblKBZ0La2%2L$`Ss_bv-K;Fbd29q%-MJ@P?!H86Y*uw=j68q*8kyb{rRkE
zjV=36FITo>BB%EB_VA+TA4LzJtKXi+k8;Bt_w_&gd>udGXvlaC7
zoKJE}{(p_UyGwT5e@W)rXjjg(`n1aaPfhmazV@@U^Oo>$(McdhY?=7bkeryrUNad*l1Z}jhLhjZ*X*U#w;mv5SP
zhM!_1uIzgcapd>>dzZVy208XBFMjq;26A>hw&^ri8~*#R-f%va13yPjr!(IOoI4kg
z6(hYk(bI8;%duRM*NpAUjkVVXJ})(Ttf?EE#Sv#dZU%FkK41Gz((&^lOP{lN=
zCj+_usr>g=>zg;1Z*+)<*g8*cD_~DN7J(*~qmO(MPt91&`DM-divbRF$d&s_CwuH_
zd?q8Ge8oe29|^<>?DG}x@w;l{G1lie#>qRN8H*!+)?ORXU7p5d)&k8K7xLEl1dUyW
zOP;ui3x4(2n7{1U2XpqF_cQge^yKT8H%okaP7Lbzcwe3v^4HoVCl>kx0UfxTt08^w
z!5tYtFs-Ls?)9$7LGQF0xP7qIJ1t&(pjbTc)X(!L$8zCkc$~=KabNHYA#MzGjlUl;
zKNa|1u11(9rDS551WrI$nb=^62r$Ns#}rhD;=vB$0$EduTF?QZ$AJss|g{j-61
z+#RS}IcW^VPHfr1-CWI*Sr1w-Vy86^^u8`w4>UHKFL4`V!5D6vfiw2`p-!9wF=3h!ybh
zt<%`qi-CN)=QygbaZRkP>8<0TRyG5+&IM|KE_-Bp$5y=^&ag-LKsvgeweGusKeMEJ
zgt{2#tHu%8(IXx>u`~YNB)*HmRv<@wYJOJD?THC)bdKEb$oyd7o-YEr$dDJ4-D-ne
z<1M%R*Lv^x3Z2WjyyC4L3)ox>E=}Xz@*x-EpqHDu9$Yni>D?2wUeqthiIFj``m=#p
zlxzKQ{$OA(*0`IKtv~qi`(&W~vlYK5sO(}XvCU1~R@oM3^}q%{=r2Eda1yVM7a42(
z-M1WVe;0L@j-G8T-kr7Ug?NzFs!tr|b;b@}wbdGI-}i$|*W^%KpN}(7r{9?7KF7$h
zXAKAM2b*%!nE6HWvrbI
zthMj`V`GHR<#E1h-1x{3KQwyPo&N@ap963)?|0uL8Sf9a0=}#TtN1%}Owpy)k8Q4d
zm;9aMhsLIHYj#zP*t;0e>*Dx+jLT@>SdOa)_ws)}{_wF}ny<$971`5pA*a73I2mZG
zzFXRVG{8k})ul0=<*9zyv`%l=Uz71>@L0fKx}0OTGOdNyn)kw5??!DcvgVDbjrp76
z%;jJ!V2iAA=wtKAKux+c=5&gU`tj3)x&?cBjSezw%Nf2uHGC&vM;^%AqknH84qeM|8TqOdzwKl$gVnp9>go}0j#p1r;mqUQg@jJboXyoLp
z`#3iD^F4mpBkP|P`Sa=3DBsu=qt?7w?Fr-pkEa86yy5ij3+8vKca+?*Nv1lib$|b`
zpW)KRxUXha#xQZpae=V^b>(Ae#v(HyDdxJewynE(r
z^7q`vGoPOMsPk2`{o67Zlb%15-}#FjAG>yHTB}~%{#Je$I_mxT|F}JORu0PVp=ljw
zxn+wCUHV(6zU%7SS@ysC|Gv_f%m3FlH+6kafCrrW+4sFK-45T+jvQ_yk9X%^M8n?b
z>z@DfN+15!zu%TA2fDvCYonh(oBzlx&N$kCN9Oe2F|0k5weifa|Jy75_=(J&f$I5l
z|K`dwUy*s^9kCnk$(;Q77Juk;hM!{67&f-now29y{%zCzz|_-ee`D%>MwlO+dK^Li
zJ~RKp9DBvx)1F%V%KQVEqu;N{eDvY2X}`Q`*Be8>_v2^s566x=erM+Ok4@aj`V9EG
zU%68DEt!up^7F#1jU2x0pKs@nocl-@?mzm=+qy(qN&$g59%W8Qdv*tG7?_w1`#z4(rwljPa-
zz4ce(fY0X_rzqJId%S?%CxSNzK3~+WCQtnGzIUAA&iAO-XT0Zz^&8%hej_*?7(Y4n
z#>FQLt>)9{CT+Fo7Cph89)BXAOCyV%+~UA`)&W?m;d+9v$XvFX&(KIJYX_jSXA!NUyrnTQk;=K9#flcDyx=uVqI}=+w>z#^|basDa@$XsRtFLwTUrlFk
ziLBbi{e#Kp$LHJ#`5fn~#u3@6DfRX$3u)&9^=8dGrHyN9R~y&F5r6)>dnW?9Q@gn6
z`RM(nn~!2kJ|S4X$>h}adSJcsdh+5~*$>HhlwD-5$v=5q)&gAQbbJ@Ao8u?<|9Z-S
z_2U8V#`fiJe*gVB=p$Jlf%`aLHIB&6U3L#yVW%}$PBl`
z&_RZ*J?(P9XZ!f#-8{)ZS$mq#E9V{z?BVDAb4I(`ese0H^PFDH8t|`gqg;;gonoAi
z<9nyQ^5(}k2h9yxamQWU?g(&LmAA%0T%31K%x(+#Y|WS)d)C-H6KG_uSI=8B9`#h;
z2jgdb9_@;o#uxrwub=7z??-}>AK$!x^^+WX*2tS{^|N~J&l>nl@;z5B)#CiKMIC5;
zI}T<{mw1R7><_$4!1hzYu>c1)#_ufR|E8e(PY&Z%vRlLcC_9eXr9JKIr$pwT`cc
z;M3Brsx^0Jto_~}G2lBNeFix@-iJFfAK^ZX^Ht-BEboJNX`a_3SrgN85u0+s<7!;w
z9dPLQT75*9HG#*uKo5&Rd-Zm=b05n~yspOUZ1&|@{N{4a#fj`~1dW0GJdk-~Ove~&
z^AY?U=c~pMS<2j!{?ULw@m+N{)VI2)cenbMkF{W4+w?vdxM#+==wBE3`NzHRy@Fo9
zZ{TzNBy)41^&I`qTQ|m^4&(iSIxxoPWT3r!`kk@4{jZfJeWpRekfKFvD{uL%BKl&H1Wg!u9FCjvQxTZ6te>Or3QrJWDN$^PL$Eo$zr
z_1Bw3n!I|!Z9HE&+?*HN>$UGKD>v^H+k91{)_qRVC&ujOSMEE1-(JiP2I^nEpAI$x
zoN;oVulkDt|M*&Ywl@Pd_~kQ}KJu^#G=8~>9KKPAbUy}Kv;I+XUg0Bm{CHUdsmxCMkhHr3x@P^SA+i)
z{Eh_r_TY5zieM333_d#$f40XQpUoW4mj!AMN4~C-J)d>)6Cbk9>YE>9psO*L1N&m=
zE!F5DWA9`T_ip&kacerI2agzctA&URNn2?@)+lh%>TbazXQ3md{0_-YDzux
zSu6L}o4xg5E`L+j=+x8cyP%jk@9hy!ITWYE0l(?;7CjY=IT~YWonCpNS8p!==4;a&
zANKI%4;|hCe%QNrdi$-*QSYJo!2lOJajD*?r!~CYVedCM)4VS-*7(>OTUbaV_mY6G
z#;uS28Ed$zRWZ`T%L20X;m|bSOwSj!^|SfRazF6ZMm;@GRy=+%vbg&^5zAHF$Jj3-
zqm{c{jrIIY=6IH0<1qSnQ}(s<0a^US@WH^I@%CL}nez-0IjXifj
zJ>gH^=*uWO#-laQpV|~>HpjeuGS0|L&#^r}H`=Wnu2+*A`8ED*Ip=-woyIzT
zYF6#o)4nuV3+#{azd7@#g4SgBT3_^(7yBoIF@F4~LpvYvUky3aIMjdVo2x~}T6N>R
zu#om_AjjjLv)-dIZeu*kf$cE|qmD)PH1$2MUrV=`X>;B5)VHxFMvfnhFSYkz^c(Z%
zLV&Xvt1Y(G_0{U7w*OmjY`pOq<2|=I=6qG0E6=y9`7-9Z@ljtrkHe~W_ej<&KhGbV
z#+GdBge={C
zQ;qS_zccWz_VeLOGWO@${CqNaZLl|ZQ?Tj{tzZ3ab#vsj+T=f7ho?T>6?-_0dlxe2
zv$!s@f-8?Z03Bz6E{3Z
z`$sZw?D;`XJoL>|&)$}`o^5T2;npPIniF4gi$JSR_M6XzjWoQ~3*LJJ4UhVaAFKsh
zbG7}m{>{tJzZYixKtPw6yg1P4nfp(+KAg;W^#4NU__00a`TUA?-yh}USWw=$&F%e%
z{4BA`-m3H4K5hU0;^ycgLqF^Zv{gR&cZ$`9&v-uFNI1>Ut$r_Hzd!qnB{}@7cl$f`
zjmugf54QyB^-Y1g5ff*(X7fz1`2Hb=&a)@R&irCH(lOS})0yKr>dtgm&i2j*^pE*>
z-hKCTHFB^i?$u-
z?LWI0cfV89dWMblz?ro`vsXXoaU{of^B1+gBgoGJ>r7{-`rI^?2ENH-5h9*_l1n@
zc@r9MYxI!O!y?c|x$3Zncl|Why1$+C4_W>WSlrZ-Kcn)Q{AlnQ!50KRqrN)$v(xxT
zrhY9w8_hAj&jfh6bN?>!+DI=qdcON?1i9#*&l|Cj6S3GIXk#vVPAq|bIt~Twi`B?y
z9A|6C=f?Gxtev!x_T58X{mhG}o*%fE9~<2(2Ww>Hb8{M3zW%VKi4S=_f9N+JZScKu
z;vYY2ca*E{#;Ur<8sP&pW{Zq9HGMRoSL@j^CQq)2NpnzMH|H!pqksKQQyIA-Gx8km
zoQ)lE0CnekUvu!HjNM&4#et5-;AF;Yfj_??&tCV`Qe$QhCo!=9f#hkdzw&!;6w^27
z`k`4Pvx|rf!+kI6
zU*pEltHq7~?EB24gCFv@TQ1pae2nMyB$wsV{Z(Alt~SOV7r8rNBTeqqg7a+pjA%ZZ
zCpFtOwMYKO0Ehm0MdKy*a`9BqJ297~gRS}?PwdvuBN;ch_^C6#%wsI>Cj-rY7rA!=
z7xltdw#43_li|&dzJ7=$9XNQ0t(UiPIniehy~}E4GpIhY;yCgbdpy_`M|P2AmA`26AvQef=8a?cUK(H{XmG
zfmZq5I4zb^+h=`u;``0hT78!*xyMgm-;4og@hXSrbF5Xdb8d_+y{p#QwZ5J2D}Npn
zJ9WP|(8k>TA4BeXC)^K>t;SfKZkp!ClZjbH3G-gCX>SzYv2#%BcE-nQx%zqLS{=R`c&Dz}l-
zJcfKEH^vYbb3Wp8ArQ+kj+McuKIR`yTGo8?QvSVH?z>#p-u{g7q}v)S0*!yTY5XyF
zw)x__`7Hta+W1b^rh2G7v1dy!mg4qbsJk05&9AdO?Ao1`G>%;$&aztBfM#}fSEF66
zZCUclmd*NI?T3&t*kDwHu%8a}PNm;F30dvxN+9cNEJlOD-f-28Y+fdAWr
zt-w6r#&I4m=^yW;3z@I{b2Z+{*3_S~5yW%j?wNdZ=Hx}b>Z@md;(p90neN|ypKX7B
zp;z8;cU@rbO9N+;UC%4e;yGL9cP{<($R+!F_V{~fF_u4YrVa;umtU+TZ!dQh46a%`Qy{OK7mzZy7;&kHnj*3FH6Td&{7^&1z!7TfqR#<4mY<;vF>kNBJ~
zw#IrP>$&S}RF^f4o#TP$W$(OlBpx=@V0BFWF3&iXw`Km1agOphoXYdbS>R*u`Ed_!
z>=F0qlYRU?8^{?xJ&Tk7zp=OjKa{ci>c&8P)$xh8tA3n^sa@Q#Z5{7trss}
z$2^ZYu?Nai?{hq|H`dcAJAHRF@6F@Lv3;7nRE|%4+f5Gt_U6|RTzUtUhn@Ut-r1_X
zLmAHkZ8N~zR?wWUXYAcG*3G!~^;xrzFJsO<Uc}fq-+g?W>M)-`gWgNB7asH(Y*jF;D*^
zi*aQyIyS$%u<^}t5ZGuO{!&&!-v{p}n7OR^?@
z{U-}CJ`n3_CT3cHg%O@_JsXc+(!bSI3>-|KBbG~eUYplFh$6b+EpY%Px*sIRj
z!M%C<)U4Kh=IrCwzQE_ZPYL)~uI*_)=pnljkkxx;r*WFo&IIJ&u;|~Pp5EHChmIqG
zz3SkNfj#w4o@pmr{_5v-nKK?`{Y)zTpmsXuqcMBt`O$qZ%-FeZjOvmvpXBMDiyUt%Qe<#uBopPm!=vgzRj>dRP#>WF||5M&=Y6s-9^?V@X>Yc{Ao!{-h`}eaIkyHK92od~WCAADMlk9eWwtuFDzpXcYYeAie
zOOsnR^e2Pg&WClrJ{){WNFC3knC$I&tbgy%9R6!#-$G7bKdo&Aa!A(rEy4Q&cK@H)
zou&W%fZuYc{ddXX`23T3=C6F-9PkMr59Q~zzbz%9IFXv|j%{@Obhwp!wIW|@U^S~c|){b5rdT}nB$DjH3&5?bY
zd3x(N+kZZ`$LDXzbNRCV6?wL&zJ5`j+3)imdFH1au-Ew)XTE&W^ZY#XO^lWKSNXSy
z=E^U*Uti2Ue~|ly#lKm!Py6rl%x8W!=hdw*?^C{-H!`q)(H~g!?p^cl2)%QpcgNkl
z7}Ifk{_^Li^9_yvIrt~Rr{yn|9|(Rd_}$D2sT;Pa}^+msyUYzRpk0s9Ly7OxA&IKPCUaE;3Gd^u1O`eYiK7amB9Cmlz{DJ(D
zb}?}N5NG{RfUk1_&d&z&;d`s%cBXv}(vwr$?liK-T{ovr=;1Rxtqb==-_LxLXS(@<
zEJ_SJeV?uVSD2dMtB%RhRhNiBECjr(b72TV4-G2VU9HUrFxC@|}I0mB%|X-U#Hb
z^)TkJw#25%LF-9B*2^r<+GemaA8pqQ88-Q_8#m8{4;;46+ji&$GoXs_t|RD_-@UZym@{&
z^Tz{rAJ6BO${oz}Mi5HpzLC{N8*H&L`uegwi-Qe*E<=6iL*?+^&nESGmN{)U|8x5@
zPPr%BxH!?=T)U8MjvJ3NS3ZAcWxF0ci_6_$-xGl*C*+$K&s%|5roPKZ-NQ<*Tw_tx-(8GAqRh0KXSjj`SLDIMyH96Q>R
z!Sr3`YYDA+Z0tCZXS%hnH%|vM*Bb9y?^T?QD39aZbX>pq+dNh;UU4Uf>Q0=m2!1yt
zolMWyS)e@>(1mBfUF!>%a=#JSBd6k-{+=z|tpuBavBuxpcb+u-ct>jWb=u>EHu~g9
zU;o4^F0K2TW46_!+BqBWm;EC_b4$j$RvC3ih8?YXw{!D{Fa3_c+p^{z0IwCd*9@qjPCINVWm$d@=YKFZy=PYv~5W`AR}XXL-}jdfyOtG;oKUaf28
zPrjQszBQNCZ*4Wux_8VM|3^Ff@_ZrSi+bA{#%J2Z*KT@C6J@t7c#_A@g3hXbr^ffzSoe*=R?#uX@)|x%+jInR#SzH>9@P{L|)CPNU#ZU1b4(M^mXwPO(ZT5a*
z-~CJf4T1VT9%%hpc{W=I?OV%gWvp#Jn{x)%0&5Qjaz-~h;&g}K8<2ZN@UK#ke3Nh7
zE|dAaK_(*eyBt^bW!%pXwhjdvpTuz_kk9Lap1+G31Nq9~n(w&oyMVuRYz5+34fy`A
zLxFwvm!tB+HyqRTOS$vK3f8>`>jQr(_di6AzefZ6%29o<|NO=&-^rX0
z=ut=YgX~UsBHg_c`F<*(OB-{`54qClUk~_Kelwguo40On_uz$(jhRg{8-cv=nXYHz
zv)Jf#ugwBJkG^l_S*>eyvv=A<8sF;ocrL7+3;209a98tbVBhwTFW7orM40o>y#2
zdorlpR>nPxs~NYJI=8u)OLs}Gb85y}1@{E~e$S*_dpE16Le22|aNulsr)aGqu^kEa
z2Fvb^)y&gXzgnN>s$0(|oZc1SgD=Kx_cLcd6V$ir#I-Xc9^B)auUh%4zs@;()=vj)
zjq>ApIhwU{Pj72}Pgr_Mo`LO-m-Pp;zOjo;mM+!P%QMDh>*Q?4c&Kgb&2we>|487h
zJI`eCWbd-N+sgcAAYa;OgDoh(dO8jV?5qaQHpg<)JdgbE%lwt_|4jXi+WGrHtj^`s
zZ#9Lp6z%?$iB<@AqQ#;kIo}L
z%JsDwv#&XmYMUSB%SE)B=gM@SGi&aKAR_aBr+R)dmNR?w?41mLKNmv%TwBaHxAyfu
zr^_?h?yo*~$_oSabUN4*oC?^`$l+QquA__RX-%?4e`A^6m2}AUR5$+UW{+;QIIS1_
zsR7MGmE_3$={MPuu-d+!B_Vk%-eRL-I
z&@1oqLEkbi<&mB0Rnr<@)&jOP`sgi>bbA)h>SBB*y>~+2F+L-ZW7{2ES+VRSdoXKs
zI1BueU%ng;_@bujgZ$D(H{257id_EJUGwh&oy}N`Y@5Fj)UU0K*=nuo#exfWTXp?#
zbm5RM)+(cREAy?9q02K~zCO>-Pfw3M>d+d0za(qo8|}G&x_)ogtaz*
zQwaK&ko9Z9dJ^}o!4CyL5kzdRtNinY?qxk*o-y73dhxSr@{C_G
z6?8%K=N{Gg+H=QuGU7K+zqyT|^X0BG?2w~Fp4cPXT2x1SgHyrCVdcrnqh1X76th;}
z+&7pkpL)O-&grTQzUk3JYaai6*XV8iv5V_R1F_QAwbL1E)xplq0lTmjzE{%Q|8)VM
zyazf*kD6!OdBuae=sbPEFSgGG{9%tye&S6WTKyp7j%iO{c{eW~8^L-oo@4ikJ^I6e
ze5?hJ1Z-GS_v{+et4>BA)Tu^>@6M^XHTFIjh?BmpV66LpyF=YaY<`xG8>H
z1#GPa&bmG3t;;vP;y4-nyC^rOKGp)cYF-*AU3A)q!%#Z+*O;FNgWeDFz#cyM3*^|-
zjK!$oRvcu+h!Y3mW$D%z&*ZJyudlp4Vm}?M1#CJ8<>kQQ`BZu_X?)xY8ke~-E@y&o
zU8hrQc&l&fn=jUuoq1f!&srd-D}fl^xft^gpY7GS&(!>-bHuAA&*R!oSRgNDCy8orJpaJ`90dBb9|;-6RX;p1zKg=(?#c2K#re{kw50@
zk29soIq;dEM}tFwm^`~1HL<@lP{;Hv<93-JofA`ev%mH-ocr{y^z5liZMrUw?&lMK
zP6wKL+8>xR=A$}Uc7Es`->Lkb#60bb82Qf
zw`VeEU4GnKVy928@O*PXo}QcXZwcJna^-!wejp#
zcG^$(cD?y~G)63n%!CT`LuACWr`RCc4cOe+L={!!&%fl;ze;=JE)64xV(7f~HhF)jJ
z`NS0)Q!gx!wr20y>Ta)-<;HMlT=UA87jm
z@_fJ}?tOD`8TaJacK19Gkg=ycJD2q1mY>cVTcd6JTSLyjT+zYLaqXGbVYbgdJIVo^
zHj&nRi(UTtqZymSJKi1)aKI1#vCls;&YL{qx*RkHbK>NCZLDOhv4LMU%+cSqCo|UU
zmn(g1ulL-6%(YI{-SL1=zm$K&#a89jvHiUl_4cVdd&KvB*+WMBdK~GUTQdCmj)e@r
z#Y>0Wcs>)@dp?j``|aBsd|tsfKPkzV@<7CYhKtOb2zYXBXD+bio3oitCwx#
z_IU7Y&uFLb!|GqlI_}7hYxJ|FmN`ZqCu;%w^gBoR*J?vNYGAzkJBOUHw%Hulo@s51
ztu-X)?D~KB;>-D=U#;jzj2utzI&${wTMMn9>e9=x`uUyw+d*~OTBWb~|7Tgl8;))a
zTJ;x{YM_2XX$Nrv6
zV>vW04)tLI2W*UUtxGXa<#0aM44roed|{jZt~Wlm`ByH?H(qt?+4&|XS9-Y;w>W<-
z|3;OJ*zu?@Kjx>gn&T%u#`O<}=5W$E_NP9}5l+=FJ0myZ6oftN@cYEg7)*w@zE17e4#ZEt-aR*0&V*y#u
zH!XVpl9NlV{w4Zh2(+EO!Hfjv0$`FT$+nUm@HGz&DGlC>8P^f*`Fo}yv%P(Yp?wQs%8Y&pZ~
zfDN2q4D9EWIuAs<&qD
zNq32QFHX;iHyFSwZ{!z
zfCHSb1=j@T@VOS?!*c+&MWMB}!02Lm}Ib1tA;e)wkZln?UD_)sHsTi5R&`rY_o_pZR1XWMvRz`mNrGr#D>
zt+`RZJ)Uti3vhfo&}Q>Lx6hK8=n~Ud!@alZzza^)G5*ZSjhYshX21B$!T5Dnxe_~n
zoKffZm4UB|jMoEtt<`4xop_Q@GOd^HUDh9u9QjA{`&Mw{ob%Owv5HT=`B8gaC)4^F
zzpkWXr+3P}khbidB7S_*Eq=lGtnmwva!>DT0?iy-=39fajJ4*e9Lpse@}nl$>Y2np
zyZpL33u4CAT7VmCVl~HR?^biu8Y4Tcr^@ls-rerUo(H)*8sK#+paU9neL9f2#zX&3
z_Q`d9tY)b<{J~+tda*t@r$NUB0yXFzVfx`8@%y
z_6GL8JU9|qyD2ypSR;pfIel;7XZiRmCbF9RJr>Z{xiMd=OMN{rxFPUPU`uUm1@$At
z`I+U9JoA7LtAW~hZ@`}mfj#`t&IW4ly@7R&zieC`RGzMJoX1P~sQkVqGG{Y~Pci97
z-$woXVZZX{Grkz$247^g+VU(8HnnpB{q{RwwI{aqpmih;IyzUqzVB)7{$SKgPdWAf
zGx)STUn!hZvKIn6+1?t)8P4-6mzw_{NYAx<%l8$W|DyqZH1W}eE6sB`pX=305-qg5Zw?HwEjNdujUD1g~E_n}aW$JU_g6{?hbc6+9Mv
z&th&p^537av&2tl)|#>0;Yut$PdLf)RX-O_a3Oy_=N?*&<;{A}9-i>xtk8*rQK$Xi
z9%$CssXc376X3XOJfU|u8&K?akoQ*MT`@8e+(Zq}W4+L7{)SnEl$&1DL
zc{u3r(PZ}(!L>`))Rnc>C2MkH?`puN&sN4gpZp%}dwx8S2k$WX8*@{AY|xX&&mwk;wLp
z+25Gtus-78@r92c%6NZ(Lwwt7ebl$?>{j1suQAbcb%1Yt+!K7u;+byG?+Nfw9~;NW
z^Og8A?i+ofmygzQ=R@t=)2#;=gRc$bgP;7kE7%v{>wF-$c(JA#i$zT4#P9`+apUIu
z=)>jaM<1OXzVfZ_7(PJr#_m5Iel~Z!Z~1j0;6Ghz5!XMvkpGpC!GCdD-w2wg4CnR8
zc0cQ=SN0mitr?H8@pY^%a`cv`4CiB=`&SqcrbWTk4Z|nJ#`PW76Bj+FRe=K-)V81yrym1)6DdT0f>UZ<>
z%fp>U@6kZ)TKy2$csKp*73>-Jel(Wt&z|&`6XW{1%&xuih#R$!E3Nu{j%zI6v4dZ=
zMMrH-xvsw2VwdhC!M;GN%ywR`nb-0)ncoQ1-*o{FwaV(%)GYx&+5O-Z_!+TFI$D!c
zKj^G~)40^bDkW+4<+hCTBjfY`N99V!-Qz6W6dVhTp?k!-C%3@|(u1>hGH{+d*Z$qZ
zT!xoEdsmnH(D$V5@40(^##@0qp!ekqGd>i^H92|rF4#%VUU!0bGOq09r*m;Cz?+z=
z-&r~m(5clwI_zhYEDrmgcQ?x2RL9ks)6NEBq03phA)rrv@WZ_C0g)5`^Wp?uPsPy_
z>DK~&s=HAaou2KjPZ`dAd{=rt%JVXAoMrmx74uH9k-=AEJCL!xY-{Y3DL>Z4wUfke1^)JCq%ITz|$J*@^~yx*H=t$TLMN7uyFbM{QmK3}SX
zFV_TGW7uhJ%!7MEEWN+P=4%ws?i636Ij7DI-_(Kqt&2M|-UuEH4ven^5xc}2F8QFb
zMR(`+X56#QpPmWv^xrxk$ylBngFW(hF&OLP&|>bh(%&3-=66B<)&QS!yBc`U@Xa1`
zdR#k0eIHkzTzw$J2liKT_~>dboW&77TarH>(6QU^-`vQ$+JM&vVx0wAZ9OkzwzSOv
zXZ1@yHTiwte6*bhd)$#^`K`9-a39jK5;XTXP}6+qUHFcS={_H{HlEAh<#l`Xj(GLt
zd0hJsHST@weQ_et&IaPguX-VaJ2L77N9O`(^-Q1+JUiFj>-o)r^JK4He&kzo9!>{p
zg{{_a^KvS4>PdSj;DfyKfj-at(4Gvo0{$EcthZLw7KnvTV?MHXCScq1#RaBk&AW~q
znMVWlV%*rppw%CG=$-}Ic-L98uN<)T_|@AS-<7fWHiD@R+^q()Ko_{aXs
zgBurPJei*b+Gc>LX4wJ+ET$kSm=&vXwtersofo*jQLA`c_@Ha;&K
zN91XGc)OB0e|HR8?YO^se)(>_?>z61&(8DFK%L1^Lj0H-5*xm7U{AjfBChL#i;Fdi
zPh^ZAb(+*IUE`B=`_<3k#h5&O-MgC{UXBI)g`M(ucCm(!=LPP+TY~EYF`IWj_2L`9
zAIH8}N|f_g2O@+1v=kss6+`3)D(|ZcgOuR3L8cq3v#d$B?(TJUyK8TT?un
z>D5qkW~`BAn>_!_kN-bgHu3MQk<;vPz7GcY#o;oacB+Zd2lmtl-Szv4j5WM2(;;s2
zVlu8ibIascGOy8J9z2UdUOOkAi-A}U1vn9#IS}jNK&{B@m7bG`&iQ+ZL0aQHo3VW3
zRxNAR%vns=K{--jH
zulk#7Jd4peBC{Ug-FP)1Z~Z-sF`teGxL>x`oXxVX@n`g(ZyHX;SWfG=dx>3p)V=!S
z(}O`jd+c=P4@ai=8UCFm&EJbRKJPw0(#?k2lBfE8bH?I=AIU!b#QVvW4quLsSE_sC8;X>8BLH+-!GeHYX>zKnk1u6#6)*5w^1KbZVk
zH|DSXa;Nc2+}e}DmE=hLTKTyvV>)r!@nad&y*Kb4u*M(0=Etxu)!{~-og;Bx?z6)*
z{=?bBuDHf?F0bWo%FCl!D|hy(=OY388lU+n*Ea_AvujW5=xoN~ITOgY&p`G!Pp!R!
znZq}Ee7reOGq(pXjN+H2r{n&BzwQ?}9cax_@5l!;SO3^J5y%B!=yzA~cPl9O8P4;n
zKOc1e^m*h@{1=19On=X!d3+oW@W=j@zI*s(Ki_eNi{^f6pKWr^{cFmtzN8axNW}O9{chP&YfPft}gB2pPIWVz*Xn!n{{@{YzFl3ksLkzQ4@QD(J%A-
zVn^eby4uOEIBL7`_dO!_pR%ZdPhI59_m%16Piu0PF+a?YJb0JTIYM0H^RjV7=6b|W
zCzzmyFC~`AKaT~?^*NxtRcT@{at}|wXe26E%AuE`p4fxbs_U=*ja7uEPGaK
zTZ4?euyHt0r*Z+cb6dt_pidxw}4d=GC+~apD=DAl~|^e_}C@m$wD>;Ne2hIu}1a4+S3z
zH1cG~TYGze7klxK8+A;F{r0lo{Ehv|%>Us8Pxj%UKieCs=Dv%89sIC+Hkjt#JQ4`W8RaMH@Gcu7p(>L
zL0-hqp1k0v`aP4oE})YfJ5YTGGF}V#Ovc_vgMRHI9{gL|AE<9O<)wbgTgT3XXZp>7
zIQ4wdvwu2}fAxAzpwWF~0e6We9-LGkuIT7pp;l_2@7BoRir&M482GN?2@mw@<@A~a
z$QOF(6`!7r-uZLKtGD&Qo_)bqa8DpE_xuYJ7#aS~0?lU_ja@OwiM~1F7d`gUkmuuHL+W}G1v%ZfyU1M9qh0A)^}o~zg&jUD{Ug}Tw72~G!EbK?8+xa8M$yZDu*OEHYRk9?{9#yQGN
z^TyV}9c(Sj%gAH>rb8|CymVfy<~_@cXSp0v-_#>c)&jYo1zKg~KDzC<)|xQp2OY-FEEubUS-{uv{b`MlM*^Q8w4MBIykzWKmebLH{^3${Ht6+y
zZ{S|h>N~$1-;EiITN`tJG|%?m5I7TftN)KK#`IXL-u)T#$-2B84Aug^O>;w+ymhbf
z7-#)Ek@?nSeu)Fb;cKY1^lWq=InR1N
zkgb1w@4p#0S6-@b%FCI>UiDKxjQQiay7}4~Tg`YDToddRH`^NheB_sU(B$@m!QMcf
zZUy%Q^!nWJ89UrjS(1g~Z@AQpNxp6g=q3Bg
z=%vq|J%PNF#YuBw&(Xl1mEbc6U%W>)g6=7=_T!Q5#_)%ReT`xCpHV*ZrMY;1#{4Gd
ztnQQp`?Rt4_{4|NC-F7L^1>Ifl0O{CwOZ0fedPFsYrdXHClB;I5d2~wuY9J9PnGTW
zcUo80r)%cy=X0Ts{#GEz>dU-de(wu>zo#+n*7IdtcUI|Ciysa&ddWOj`qexAe>TwS
ze`{5Zv{tQ+oQeBbfZxjFj(j;FUmkapmycqbv%T|ttz=%_)O};7=XHTrf4hgg8q|;c
zsjucoUg$UxXmqF#cOY);ceM7earTne=yh##H==I
zLyjK{@PAhz7X09|+~x}U2)^ulS->C9@`kJ9f%d=u{`P%4%Frcu&4n?&%RoQF%?}yl
z)xce*c~%p%K%33~e0sjf+EabMaH$#h
zob+ydICIAKzkV@3lb%lg%kOC8<$2aBb2el4=w?s6PsKRmz^H-vSUm6`F
z_vUfqzHnY{2yPCJ2io`KcRF|8-v^4FUwkyL?=!zVyOVDV@JJ6E?_2zC=<72c_xQSm
zef9OKU@Z`%^WFKQ8RO$*@L5?Pi>tMOZnZJ$>@$DJ-V*Rb+;3d?AqV&ukFou1lK1@{
z9P9~Jg3rkB{DneyCY~SflG~;7(@KzMBS{WX}Y(Yiy4i7jJ9eM8;yahDT?L
zkMgHim->T?p5J4v^nW;h+jmzWcK*}6g8?!UY8H-7MiSt}QuCej^RM6VQwOD(n
zu*Fw3q8YP6&fGl#`}T}>#l&}g>q(7xR)1o2zv|@)$JZJs)@8Bbw7%3=zSu**xs^a(
z#A)1|h;`)U4SBX_Z@_@3i{=lN`o5AO=tC?8$pvw2PZ^u0~)k-&bk
zeaDY~S13Q-Z)`vL(QomIf8^LRIdw%hTgG~PYJYC=JBUA&v6wdkvUoo~jLr2k7+(}g
zYggRXe@BO^j+<8-1aB8YkbTaW30q?-PN>pRHhw
zpKbB0+m%2Q7g=|{b@B3Do;>qk99lW*+I5+upKolh1y=|5FZ0j-aqr0Uo~-eOzSck4
z`hyeq3V--@V9}5FHJUfrQ9J!vy4GNQ;pcjQx7unwsV_X;5*!ck`^WP?FvpEOdjr1kuXW;kNA?^I?7_*s
z*~6ZD#$G;jPx)zn`B9&jon<-Tmwc2Hd}{3C0K}r53+!>$_==aY=6r16>%}2S-)TMfmlhXk%P6f;O=3CEkIVFeF^$DjvhivW?k2Sv3Ut^q%{(82*`c^Yu
z=BHTI1f7~%z>_?Q%{*OvJrrU270*U6%?DkzXS|#L_^SWLQ~&uOE_!B*@lO1b(MI3v
z8~@9B>v$s@men!eck-Ekbg2tm9FC5W3v1JudXLC8y*u4$(^&a2#_Cy)8mG?-?hgBK
z$hUI=-*CW>@tlnuWNGgIkqHO5CU+(0Z<)TM6McLor&f02wDa{>z1hIdc5(*JEVd%UX3v`iVTdm&GJzOo}1dsj1WuSQ-@
zHq&)(lx?oYdkX){WXb{k<&YfU8V75E*!hJE`M4`+?UysM=K{|Mg672?W6r+T$LWl<
z+5FG#T;PqY+L&_8Hja1u{9M1=i|yXvF9dw0*IM~&J~B1;kB`m8O2+EFx!}9~WX$RL
zayj|loA!%OPMis!7v-efc!$@odotb#_{t8><#}uIOh=#THFjq91im+H|60ILK3DHb
z#^fIh@X|eU#s>ea!z@tG?0?px=divNt#3Bva+wVO+1JaLUS7$uV
z>Hk-uHOc4E@A}&B1$!=+$fX01vperYA4Q)k}6Gz{8oqzSl3t
zc&OaLjM*nc&xq}J?%GvIeE3w`)gYx?>qXP)UY#`*N;(&a*Zl9NMungyC%+#PHM)+5~W4SZqjo?DiyY@iF)m^zgnUk;H
zwQSN|pVbh1?BjMNu;UaVn9xP);1rF
z=`p@PU{7t_9!&oZOB}BVZi*7RybIVFzdy-uv6P>8W<2FbTq8f-b1w60_UvMv%q+Mr
zU{4-vSDjzUyGZ<>8%%4i{Jbe^^zyNG&tzP_oG%>V-1(FXK3uLw8vn7#PUFYV7{55o
zvCoDzHsne_)}ZrM9;}@T_;h{X`S7CmOy8CA)Oyoj6VQnR@q_x>AMkDOVk}quHg8=s
z76UzG<$CbG>54&27Q>PVU{;JLcUXiXO5s`pS>(cgWgR-<<&0^Q`}5
zA?Ba7IzxF*AkbO}=Kb^+|?dSjH$9~Tj
zU+jo`7W8bn7dp?!o$iS&U3xFEXODk>EcTPZu^j07_~JbCzxg)*RD!=_F>kNCPQL9u
z{tWhtz2I-_K)+LcsuywZ4dmn}7UR~9JEys!r+)MEV6a=Au4SFv&4D-t^}2Lx!C0s2
z2r6R_j?9V2^Rb}o=Q7?1_#;j-{3U0uzI#>|-FIik_NlAU9vSw;xznE8v)1no-IejE
z!@1Dtba%UB7gO`vyCKhXuLds-#eQT%+=1#8HUSSh*D^b^tc$@udYl9M<)(UZ?wpPOIbY&h
z531ijbA9Hcd&T+Mvlu%snt3|Zvvu|Ss>So(#k1IaKD#;2IbVF51=>S_z3vfv>G!;{
zcs`W=hCu%4;fwR}Xu!|j8*I1ctgi*lDLH&h)d9>)479-xt=5a_T91lb)1~?|8jWQLWZy6;`6PUP7>``z=Ezcb^FKpSnpW_#+=-EcO~?08Qc5B3J;Ou{?E1<`FMs1yl)BL(FpksV*svmakRWD*1lkZ*p7fh_*iB`!z#@<2`uf@2(cZM$j`ia)WQaHD-R-CpB{@s1NsL
z?B}U(Oh1Ksna+*RS-zyF`qeFd%EcJRHzp48iIe~Ks4*N&W8uHNi+3w%eC_GSxm<};
zzT`%%U`?&LJ9qnfG0T_uR>xvqUG&Zkp6I2E-+X>5&btfN0)FzvdUL1elX>y21sYv^
ztIr*`9?N0tpFJ{s((_ACzaF>Z#>uo!$$H0F<0IQ@rL|tJ__z~CS$bMr?2R1ZryTKz
zu8||}skNXS;e_w!0x{!EYe2%y#s6K{9Uif@8P|LNgx6dB9Ef{}xz`FSP
zd@^`x9&k?YH*+&9fZhN(|F{;!8f=zuuS4r?bq>(4!Y-f#w)?QfAgbXQ?R)aJP@$Q*K+u>1&7YW9hq-F)EAC#S+YLM
zyyot7#_4PxuFaTly)%usg2slw`idibX+Gy@PX^;1AzrytYh%BC?|tmowz#z)2YkDA
zG46i)TDv&#%*XPmR};4d$zJ-M?F#xp$2
zGahk5zeYxG)y=`+6~W6xpuFH>7HH+}T*iD6s~E+`9`KI?bn3mkW}TdT$@aeapWAt7mrZ#xe_=7+lfE@D`iWciJEvwJ
zST=QkDIrAXC)j(W)mB$+c&0OzI`p8`$bdMhA)~X91{NdkQ(ys+_
zN;iMV)2j#fx@N5Q@S+*BhYNFfl2>!;iM{Sw$yl>zU(hqaZgVOQyttpMr?JQxj_8Ej
zg7NM(M~~#LrlUt|ebe2z$%u0!Agit`XN)sk&}q!qo&|oHYwx}&$8vXd;65AAiMl+p
zfOxc#XSS+S48N9S?MdGn9%Y;B^20ZK#nBw|d&&
y6Wx4$qAfKjIYAEI1hK6bHN7
zSbuEX9*jSOcWac1|7ai{c_g=6F7ZLHe)}F>oB#dTtMj}Y1Ryk56^VB_W9hL%JnV5@xWPl!Eb!@XH1=IcAbBA#=77K9dy=@Wi`xx
z<83YRrG6{0@@kGw`C%6izJ3^a;6u+Q+uC^En~OQR#QClOKXO8jKlbVIr046jmfrS%e&i$gseW=etnHn?
z_WYH|$cg@Pa7U2gEB$=r^KC)@PKJ*lhq%RoaqF5-YIGJf?;Ne~d^s18lS?+v1Y=#|
zd{01ze!c)s-V|&ET5}`6KQy1&)@2Xf?Bn_?1NzuDFQ)R=`dyY^HMF%v)>)=o%zS(_
z7mYxZ`@BFee(1H|XBfG0&%Ywc
zGv{l4_U;bWf}S@qE~^K7=p4B@k!QY|zmhtTANf5VTrT$B#r^!XEOx%`=I?6OKOTSG
zA7fq8=WBzL;SiT>&jRhCptZi6U;V5iw>ZP={=hjiZqC_yZNP`qfi|1}xh_f{^mx&F?&&)es4X={Zp?ev$GP4WWa)V-fj*L+JHOAs#Tb-yuKKT2T*4%-`oOLxo&*?y$&Hvoq)BEmB=EnN#`7Ebu(cP+%
z#dA5~?}13z@i`&h$r)cS2a2Qw$0
zjR1dZ!A>a1D{GSD4n#Rti*xA+i
zH2SCx=0kr+bTC*8R)eWep5>2U+S#CUace%0&wCd0
z#_~zV9?$K`u;E?s$~bc}J-Jz+`TVP9%)ct@?!GS!4h8(aE^t3J4tmWWSoA(CvR&En
zuEK#FwVrz}$%q4A_Ti>?qOrN1-s$+WemuYnxzVOIwQ(dk7HH*W?8SRWg5uM|LBDtA
z%;M_ROV-N0dc^C`2FA^g&l0Lko&D$lv$cJ1#@}Zmt#j?S_kZdl
z)!&|-JvsR}x)R)Ug>qM->vA&uzdGRmTLZ29;?5cwcL$mK19Qt{u3gByA-z0_zh_u&
zIv38Nu{E{jolKXpd*G=Q#I5Pq0(P98yN2;Lmn-u+QcEEJTKVR$Gs$0P;gLX{snyzN
z^Rt3wpB3%rKl$r|o)u$0`hK@ssn6rP)|`F&12WF>EMRMTZmb^(+~M_^uVSL3cNz|N
z@-<6ypFS9(Rx@5-$daE0nmb2LIiKRfjogwqUd9`_w*}2#?|$)+=b!!4+})hHwLnhf
z&boN)X^%s}$pwFFe>=A?n9o})*zS0zJ|dU&yfS0|zQsQJ%dL74*VZtnF4(tc>Jxwa
znb8<$^wD9g-uDFG5SUX-Z18cMR|{I>;}@Uw({bmfJ)h~uf5+-Wy~vS#;9GBR>)ZQ6
z-N}ch7TEU8XYtPhZ8MP5)`}Q_F1qQ()oTL{XTH9{&7pwI#eiS81RH@l`8JPpfR24Zd3LvYw%?t=FFck@wI)t7
z^_lF*sTyNLGbTI6rH;i$Cr%{^PkgsVmwjZk>Z8Nl?ZNo<@|*L_Z)bo$+#X3UM`Gu*
z^{t@x$XfULo8Hwxt@JKg=9@J#)gk8_!Gpm)0Y93{%HUZ%<^FRrR$FwLuiWLnKcN=!
zuD=qrX83g=5Fe-^w()#AP&c0G)LVC7Ul%MptKy-PEDqI(ack^d8Pls4tB>DTqEpS#
z|76fy(>vA|oqWZc@83CV>wz5K7Rd3KJM!wvy(HKCRge5R9N3Esa?pI-nemw0PtWt^
za*JPg#i<0$FY>cMbJtB{Ge7z<=1iSy>P>8X6kGjci|<U@Yt
z{Cx3#QFCfkeCElLITM@>%um11B^R$vaQt|Ea42AV%)5BZi9xSk^f)^eu(KzipTEv9
zyY`vm;E8l}SC@R!ft&W_*tx6TmBm=h8b9UB9d;n--Hf~G-G_sn?l%77Q2etPmaqIu
zi|6!rZ=R3No~;`*#*-Mua5TWjv@Xh_xXVj9JeWDW%B4HAcl$K%`?IDF;B=t1Ht|k(
z?`1Vezx=2lob*2C?^bY6V2}1>(6cBuxln(2=C8Rki*aLX9Xu6>__`L*-TidX-)FU_
zE?OJnpqsCB6?k+P-xaX67VrbdWUK?8<@t0LJijbh3-~~{nAt2>n;EYL+I_*b@s56a
z<$%BPhck8a>Hwc#5#WohI~TUpGFkC;?aVG~XLngUx69i3UDoc}W$km8ti{z!-`7=Z
zI64#H)cXa8zIU`9%mR(fvU%K^_nCW?$I;yr+j6I|XlDg$usm!uwl;|7JG1G51FpLahJ6(ShAL_bH1HR;D=nf
z_iqmHdPi_N_?+Mk!M(v-f(yYrg0BqRW%c0;7k1oVQ~%zy%i2A=ti5@cwR?A2yKk4Z
z`*&G;V3)NAcUgOAm$fh2W$i7ytUbKT+86J#_D6SFd+U<5r0dc-a|YEFs9(8ke*f5F
zZ@T%J^WHM<`qq+l@0_k*ShDU6v7u+r-K6gMVK1=Jv*qmF61*x`Xfu$+3NbmCF}g@`lCzM*N62lS+Xv!?tjOU^-Nt_f9H~Q{B-}9E?LKG`SpIm
z@hs5XTQh?+pI^L_-2pxaxCgG}PWrNiO?#$i{*Ujn_T@{~qGEo>jCa3#?<*Fv{Kcmj
z_~~|i
zU;Qliea*An_t>-C_pWET?`wD1=iZXj=0mMc^I?5DC%0cW(Rp>|v~z(ybkkSeJ|j-`
zJQI6gKe2aB^l8<^19RB5ACpb*?Cx|L#>(5ub%%Hzy8!jchALhq5B&@fx7?nCs6l)_8jS6
zRtJA(2i@bnuq=n__RmiCwuYAF>XyilHP{+h=F>M#^zK#z&qVJxKLfq}EODhif6ETK
zr#$-k%26jCpPcM1kK3O^_FnqB(7xUoe{QkI_m_H~WVqwk`99~3cFVu-&yDl^`PPZ<
z@;{Ab+1@`t+1pqikKTKO7Y3R!pBm4%E%ve1c)IqVFIkJ&)9yL>x+a*$^6ito^=F&g
z>*s%Ou$Fzk@8oM=pYJXN9}0dj`1#;>gM)h_6WkHJA-E7c9(-5u1Hq36|6}m0!T%k+
zU~ha0UJ{%M8q0UYAK&L`j2S*Hj_EsIKK_egPyHWrv24#@ShDAAbjf@7?)3R#r}O?7
z2c4~nk5}h+F41{@;pe&Zd}PDtpZe`(Z!M|)?;8AZwzN;C
zKY!^zGJl@>kIbLH{7Lj@+5Pw3OZ@qG&&Yo{=Xd+q>1u4-Gb3E6;?_{4ZoaCiWj5be7M{#r`A1p2q%6{8;w6^S>T+^27Jb
z{+rCnx$no$0_~ygZvH*De6*Q=W;&8SA8Y2HYhIMzIX%6Y^Y?S(I(}and}HA2-|=3t
zx3U>7wQ*DCj|FUN{QJ@PIZJPj?R$fR0iW>F&kJl@6A#|{Jx_M|(eESPvsh1eY0mdh
z>9f{Y>0wWdjYCY01CPF!$?h!BHUoZc1s4Od{5usimz8O(>}ih%bcv~V;pvREevg;^
z2ZApS=sO;;_s>&%zDL{V|1Hn;-y9p?pE-If^OqJfeg5V=KR@d)4D9W`_f7VF&0-&2
zKA$B$m;UbBUOH|L#O)ltI~VqzKlsQ;P6T%bZwdZs@JI^veZhx=zmorF{XfVTi2pXY
z;op7q-;%gfoR|9py5)lY=2ESFX9(cSp@82#U*z2Zdi<>ivp}N*U*nuw`)dh?{DFWz
z`>qQf4CD>xwZZm@K#cVH9O$3%1}~U>|+HN7eY)
zr`Ts#aoip(``I-*$UYU4oIkSs;w!(^>QvXVIW?q4EBmU9%Q+wE;-g&fQOs=cdDOR>
zXFiCxx^Qcbjp>|vmjnCoa51P1{`sH=m(9ziJ(a&RK
z-Ja!2eexT`-B@<=zx%{i4#YC029QZw=N0XLj7nE<0*XOn4mqV~c-k-WWIR+JjGinLi)YX8pP`b83{|
z&H`JlBfdF1_Rw)M__0iSR`cw9cCZ#)9k5}q9D9~8WAk*eKgLx~)FwMPIUC?eoN5yn
znjG#4dNzJNWBRAD{$l3v^q#=p=IYgp@ypVSQOwQdcu!etj>O5|+k*T$=K0T$jsBCx
zu~u&RIpubl9eZ}-3Lnn}SIyh#b2;x>@)-e#^0X0*zBWF!(KE?6dfhv6W?o(V^+jF0
zDC22eWa<+d>q_*uF1~nS>r8rns5`Ott`Vm?!Y}^s3qCFX8q53X|Bq1Dm-Aaqy35@W
z@@4#F&@*M;dEM<9$9S9WGp~*Fwby&Z-Jxdmrvq&>;EN_#&4quXamCH
zR$!mJT^PnUWqd4P1APAM-P50|e>%4>xax}{;|w1RjIRXj+XM8AjnCpd9ccVpnUA(P
zapukiuyyQjtFUfBrf!M*;qf#!K;kT#qDxy|{}jMW_8
zyj%Fg#`^>9+Q8ZIx%4yAp9#d~&d}T+S(?YGe#P8=Hy+421I-;h#=X;b;!NJ@{f;=x
z?;}AuwWfaQ5rZ+`_$@Ezg1$d-$fo$pk-1r*&E|i8G(I+QeKm0Qw-&28posAQ@-1?%_qL$X7q0}&-fY7MIPszj{ko~
zI>h``is+H_>e%zI#KAr3&o1UF=jZA*&uWd$#ne1c-j8DQE|mi^-OI+^d0q?nY#w)`
zO!b=+r`$Jh{QB!&lPjXba+C-PW7YNPvi(mTr@ZPYiL&wTXm8u`VScpeVk
z5o`u~1Fh#){_%rXvd)?Q{=j(?o5okMANP><>-o$jX1mBXX|G9FKl#Vs`-1+S6h7ipekG$?tS&LJkw`hEL%ZiaqjI|4d|#Y{N5JiS9U+A{}!S(
zrRRTpxsbDRFGu%;doiC6_#^J}jtBm#6Z7H|)A)S@@zRe6?~;}DIC@v`=D_}Ojh^yy
zFk`&XPu_WxXLl*z>@`+bjj4WC$BC@*R}JvD`BF>#9nVc`fUH=jI_%*yxiMGGxi$V<
zJFpn@%RPfz_BR52ZU)x{qwG$x@%fqfzsx4yp9nO3O??p4@x}aiF87jR_7}%#z%w+XGHyjVt`YRXu#XjC2$1;y|HAA1gxmVrSIHt?``0u9ZBTvsO
zf}e=sPO{FO`ViAkMyNLUJjT>o+9@B_#XQXkyVmSew-D?vt8{i
zo3CHw#S3Ct3+k&id>sw=ATBc1%TD)_I~>?c_f5gEfS>$Z4dhL4u6a3`@p@pbbwhuB
zz*qfe8z1I=F?=`&?p(R}8_9**IUA7YgIs94=^J^r=LaS{@6Fs83wv^Vf52yTtbV5N
zLjIfYyO164HhcJaA;6iO7e?>v>B`f^#uoU<*IiNpEGd427lZm
z_UrjdUVHlzdHUsVE8w?Wv*YvgmH7Itk*lxvi5X5W=9@eD#}IZQ!5#3;!+FZ
zGPfrnYp=dG4ra`6bLw;!XtVjB+uwIPoH1Q$mp(egBR}@xZ5C)^eAoGUXt9TWy67;r*IIKUm=lXRa%x}}Xqy3!wUfc$PQbXcUmp4S
zKp@7gKzwR`nQnI`|Jd{Hu-Bdo!Gi%?IIpjjHHU-80ygn#ANiHQ`jd-i12Io|QCo5?=H3Z%?YTahum82%&p*wR
zzMpO0pD`VLHog*UMQ&MK^`UkfuQ>UR6aBjb_MC!emR}Ech|wVN4mwy?VsiAj{0>V&o>66KWeD5zGoyZ+}dN_`cGw^Z{>3w<3$|&mZ#nm?QhGR?}5|V
zv!mWU<5tfvy%^b~@5>jT+sAta-){-z|9sH8;On7aS&r_{yqtVqppD!d8NN2aCmlU2
z<;))W#LINf9YnVnR|7Jm{%Z#PKA+J~elyTU+20#JQ{ker_GvgD<$pEu{Hjm&-*Z2U
zcMVVU$)8$kjOv-p^j+j$CD;4)a`_f}b?VhZ`&%*=k2v%`FX){uy`0}1uxI=?^7Ehc
zf%TI?>+rF}TswGtARveL-m~o=&m5W056I9hUNvIg8EAa&diAt7AXDFc##|4`<7q3f
zw%cdVu9HWEbG{KwYf~<72^-(tU=GxTE_gRv-|GI*gi3sbB4zA
zI?J;*oB#RIelySe16;UQaKRtXbgc&L;DXmz>n*KWwvowPVQQa={4qub^WrvYD1p*z&APJ+o^zE4Ig~(
zJHb6lUt?q2^SED*)#&D84Hx|AT_7Iv{A3TG{oW$3R~K^}JD9OrB=6pF7xJy24PKTp
z9rp+HiV02!S~+c=AIzLwi
z#NU?ZwE$<;@&7S*H}IOCcU|B+bCUMN)>YVcGQirLGp}c6GJQ$YiKQidCi6yE-f7b`
zfns{n%?Z}3sL-Zh2`!4U3Pur@E+4bF`capz%12q<%I;D`7DZOHxMD#m3N8qUf`A~-
z{=Uz-f0HXW&zU(>DtLYJ%k^^qumAt|f4Q#vIWIFK?`y+c4e=jZcY1v3D#TOXXn6Cxb^jF^
z9|**mf1b&=zdzX-+ziA(Of2eO}x)8LM_15IYzOHxdnKkj`ryTMLUyYxh;o}_Odo~!k+2c8G<+U}f
zrCZuA4?R8fvUets-*3uinaVi7KGX4Qm7N1wAMF_9MXx=pc-SKbi$LrCmu8H6bMX>_
zX=5xsQycBofw5Y_T?|_{Y`~=eA9}8L-}9O72ZQ<`o^0#{K&$!R%|H@&mPRO+%@1nP5U7hX+zaICJ8kAS}1)iGN*3VZhSDx`@l~2DOJogi?
z%JAvdfKPHe`e=RCTzQi3^Umd7p1s$`xKwT}>-Ld(G@#qw(FPrl1!Af$)tKIWsn*oq
zy}>Pk=DvGNP+jV-XIR~;w^sywv+f+I_3FGkV}DnNI{?409==BTxXh0RWcj47@!ARc
z`QdcN_1Sa2lG&}}wIwgy0B4{N7QqXrG5@TwxtE{z`i#^4``OdDs9U_sal9|Y<8m;+
zGx*F_?c9;^`GCK2(EE8SW1nqa8GJ`BjdSVQS_GOL9S+Fs_1O}??Vxwf^D^EHtm7x<
za+QCE?S_ADf*;lMnv9PG_CweCWnCPs`Ak}yYNozj%$R-smj<4hKNffgvn5}>!^zP%
ze!Y25=Dx;PhZh1m4hPo#yAy1U+|Fi>n;1F|?qN3MUY$nObG|uoP|ITC&mognzgq!6
z4hD}0_Q{9m&KiH^wQ;~#jgz+*7kAX@fIM6d_eM3_RE9Z(SZp#?&zMvjV?A5^QJRRv-sj?c9~|@jz}L4Ju>Y
zd!u_UXN_Oo>uw`+B;Y@uCjxnJ2RcW5r@OLZuon3GqjexgbZ8F*bm7|?qem_GUhTSA
zT6dP{@LcV%xjyx{n3L^2g6Bqnm%U-sdO
z+xnS6`~K8X^E$5o-C=#qx3g1S)#3LG#SABRvRX8s|NfvF9&?O8&WD3@!QYwg4*@uv
zIXyc8UDntouXSxJU*7wF%j4lPZ
zt1ohVzBf>(TKTHe=KlQh$!=}iqtzA;wR0k4e(3q7;W2WdQ=Z9nA1)_@?iqEu;@@q>=$Lk!3?=EpLYul1n!2zhqcT?>4s##OC|9sjIrTLEqw
z-r^`G*2@W(`I$`}}O;xjjAO)bldl
z3^cJ~zcCZ5=Bje;e=$>=c=!3)jOBOSL$10jw>7QZkzP&Vt8dNG%a)$+dYtvQ1RFtP
zE$-IvxEzS5ST#m+CQkM?)}G;l@38>qKEFR>XMY~ElUW;MR=;o`{Ze=IX}II3#_%gw
z_HiBKgo}Ni;lH1A+WSA^*X|WQ;?}siZ}|4Sz`dp>)b~apZkp%fsrDNSoaN0PXnuM(
zv19$-fNo7*@z%r~2Wtm|Q^DzgEZ}t}(EJ@zVyOP<#G(A%y?usfpOM88toxn=zId72
zvufY#v(E1W0Uh|x^G!w!@uY(g?({e2_2JH}(WO0{?-|)AhjhOx=)CceTfUj&s#hCN
z2KMmZ9&wf{vh~#&=PwT8@MzFG+gi`%jrMjATYRElOtu4h*cff`wR`kr8wVVAg2w6b
zjOi3tdes%ZeNLC><68HS8P8pFMMq;G&;NHEtbKY$`=kEeVeS-iaY-s7vsYL8M<-yOn&UGeDhJ>)_n~@9-rC}*Y4r7XKLv}Fy_ebqRi#Q
z9d?2z0^FQiYwFFqJ%V{Q9o_X&ZI>JV>g-H#F!)<5Y>8`i(a+Zd!$+z;-vq{gZrvCWUA5DKI5Zk|)-?1XwTv*dQ7n?tk=X9J7HUm8PP#)I!
ziaTHV?3o&Ho;@Rj3mMPEw$IrX3q60vXT1wNqeFipz(-wg1h^as#Bvd6TLGQgg@8|Q
z2o9t|$m67k)_whYG;8)Z*2eT})z$vVtnpdw$X^W9{H1`+@m~C);WHfm_&pfduddkG
z3EcO5be7nbdoeR!3$)sAzw6rzma$hC>Omg%gB$6tk789>oO*to3pSlwy%_M}-oPHs
zc{mlQp~jM&81X^O^zNd|fjSUF`e4-6n2h@9q_29M4{^oAGrFyrZw8*N2cEIl_a_1;
zGjHvb4-V&o?@p1Cm<*qeP3zY7qoaH6AM4Hf$jQA|eZN*d
zd+om-mwDX9u{mu`%Byv;q09LbBk{Gi9^4Ml}A_hh~i+!Ek=BU|*1w)o7Jx~l!HVNG6F)f9X4
zGeXxpb4Jvs@lHTz&&bh?*?(=I87~ad*c3Cq%Gb@{5Ww{C>e-4IB=}9F@B@eD&7+eOi2=
zTa262a~Xe6ibf9K6g(28uTQUzwu7#}IqPrD{PTl%1Z3o8mCVse=E3xQlxvMH9QfwU
zv>wl7EMDJ|x^OSzsM$xBo$k?-)r)2K`g^3w*Z;R?d?Fw#?(B`6t9Oxgt?}efV>8C7
z^7Q-Jtn-bh_?G9$i@f~R$G(^N@+ZTU93Qh+}#S-NBrQfgZ
zZ;Nf5<^AtZ_fpUM$*hU#D}(RNGiQa5xZaTmIGBs$ivn{0Pvn}jRdQ_I9`Kd#j|F@l
zWshgB_W8*-@@zL|?0#tA{SQ{~7HjQd;EuR3^}FwaU;Vq+YysQ9QP`e1@bA%KY+c+M
zmkgivIT3Gp(D-^KxHYiHSS-}!&yn37!{d{AwKKV9YHa
zP6X^~@=GsUY}(s%(Yfcv?m79G<@Yw}+7CYYI&yh5eGWUe{PzwY$^4@QHFf8&QD3$%
zVEt>?Ej*?XOAYpncnq5F)7
zX@1sBSNGs`qdorZ39;)P#_nd|T+Uz%9)Di0<^OUFn&3PAioF
zAtwiNxE6^2gMqcff#@&*r!$9_J?8AXLq42;-v|$R_+T8cw_m^UQ6AXR>d#nr
z-y!
z2ZPrRx@t4a*L3;JYfsPRUOHbo$yGOh{!{+lsK%nY$NhcwipYuwuFjggjQ;+ULC+Xd
za&j$STKDs_{(Zx+xAy>9KD}&`!|81+_W^gLtGk?VspS377z8J{e
zg+PtD7jRa4bXgaJ{eI4h=<u9n4&UUulEul-mL?tHS=#&z-fNY~jBPx|f+@DWG;
zcpz@#b@`IqrpSL>w=AdT;s_;F6_P|kQ3+Dnpjn5bF;|W
z@qnFzZ)Cmi>R*P-`2My&lxu5^E?oC|
zW`Fn0^U2t$*2YK*VK%nGVt=PzTRqgO|zHjs$NBTyNc#27}lQH0UED%SWy9Z~Ww{j;lR(F-5
zbJR;to~pAonx*A^V4c3+17gj_g>1^8W@=GH(Sjt1&V+Y0Em_d+0lqu%w*4+iw`
zY1}8C+W{T8t9|kk)>LWc+E@aLGWd3b(ZT;~;KKwmG?9m~fK1Y6kl8Kw=m!s%Q
z(w_*}_WU1T=ec|9T=4%!hMiGIdD8Ju_MzhkZlL3z?nB3iB7?)(pl60}Zwh>kDyDK$
z-amK)n?H0Nn^AM^_gUqdpZ_fKwc$A~{;aKjGZ3qPK5-Q5cV*sKyNBd%5oq?vm$PfH
zyr~!ds40E(M((AV*TxUWhT5g0IX#xKnoxVVe)u}RwYJ2{ec*096KHCx^=M7)eP7mg
z(!V%hgCFifw(7@S8E*vY&U--2+$(tE^CRISKL29s|K-&GXnJRM?u-4;3&b0Tk+Zv$
zt{=v!>JZnTh!1=m`OAg6kk7sL{p%a-bEffO<0m8Qo}SxKoAX?$MRsw-p*8LMqt?b}
zV+`mLgB!{GACnBbjRT%NpX$+jSq#{^E$I2Un6W+f%B3-m{QA}en~%=CoF59*k8@{#
z<>;?%=aC*U`l+dwEx;8wdHu8?W90;x^9N!z&c7#RR9Hz78im
zaS$K2>Wi^wVtO**_o`YZLw4L>&U*Xwe8-o**1Ns$o$`1~#*YW}!83O4)2xp_-{;rA
ziC=V$akhspP0cxjKNA~d9taYi<<}YWyN%qFlMG+noj()(&rd(r+IJpbA2JRjrFH|=NR8@`?U_o>7iN3q!qUK?nQfA0yk;{9ZdiUZv0-*+4O2dos#{JHzE5gHzE6it-rJuh&V
z(0_3n(>vbzKbh|@cu!To`;7dDvaaTENvSUDkG=JPEFHCh4&e2zX(RnElw~GNDTw`>uNz`8Sj9NDqAI_(r{Z`!|OSTlDv{s+{~+
zQ%+XZN^>Fx>VTf#vWK4EdJ}r~%EMTDZ%-`w`1(L>w*#Ny@i4~yVZo%#u8U~
zKQ(X_v+HrSf6R+~9Eu_K_gf?UqX&0;8f$Asxr-~F^7*&(bK~aZdK_Cj^wU@UJulU{
zmS^vpbgrtUm*n}e;Fh4ZL>K*yA^&fm{9mQxY@XAB|6GTf9q+2cH>qdzPwq#3d>uJ{
z+@!m4oyV^{)q}lqd?Wp0!T*n+bnoYmo$Hm)Re4$e2=ju^Cro_yTaTlkBOm8p?WvRR
z&(G35Tb1MM)d@cT%}w&T-aUW=zedQZn(R6G(uwP;e2iSxjC`y*kMund9GYZ$&$(;l
zYpgXs{dU*f^>rhiFa8L0uJXmX6C2I%E$|!oB90>u^SN(#3_QeTFW;OU
z`{y-o&#IVhOnO)4spnC=nx|EF&*r3KRb5ucc=wF8KE~y*OmPvX1HqroytRg(aZD|9
zD_-^<3R{O0jHa+4fa40$k$GcaFJ5#uhL?xmJ2{&5Bf&#Kxrvh;)gRw)
zapv4R?i@AaY@Lq1#-F{t>JL9Ww5NjB9UW(GQimEI^ZDHgHh<~5GrII=r~W0A?(5ZY
zeH``D@zQCpbF-IUx8#{SWqz*I0PvZvm+gbcc%Jq;3;*C3pZ#^=cVvFEXJIehe_^Kk
zy&r*Yc~J-IO#AZa80TL!=@b{WguC3#&#l;<3Qh-d>%6ETa$?@^>-wDOto2;qmGQAa
zEajy-%(nx!=D?NiAI6
zUa|Jd6>H~KtlhI>?YFO3d)11yPh7F~>e<>Dm(X9vp3j=ti-*{Z|IV?T%6s#By}rM*
zL!4iq~D)qdl9~#`68XnRR*4|3=`W;ir0hAUGQs*UyU?%R}ewSLH=q
z_mdlZ)vUab*J=j`XN-)#xhp4k&6qpfwu4oHeDHVG`n}kGKJ;^9
z?MTpg^ZhkBpW<+5a8F>L^LV3upET_w+kNi!8|}My+9#*o_o995d+oH({VR9sq2P~u
zSTnwTIohpXeAMqwAg6Z(_Ng=X?zvzQ-JXk^pWPfzzY(a{MWD&~deFLae~fpAxW6Ir
z_F~8LIl7k*2>ADh8W@I=67bybJj
z_O*xju7WeRYTcSvp18FR+LwoX`D}G0czuAoRvjOkF&&dP`O?Mb{k-oQ4`-!*@j(q93&fpY
zjlGy@p3AlQn}_!T4*m|CThpuY%F7QQcI)zEmNDVm9CAKiyWYI~ompHT4YmSy%UKSz
z@g8v=`EVjw^Dyn%9AB{fK8EjQj1bdtJ|EL_F=)QnRHq|1_R6~)8>czP=A?1;9^ISs
z-fkNbARlW1IdNcno*#S1cjYtrIC!lt
z=!Y;Z7WO;&%FuHC7JGv1u$^pX(|oc~}T593)SBlh-a^}Fw7Hg5#JjWVO2`qw=0
zuWM?H-3J4_@YHY^@0Y(etBE5^sonEfU3X-yv6t(+flVU#%JreYppSTZFQX;^7@^?8E41W
z`1T(SJX-`>?e+ZQ1$6V7E_soo)-zpwMxT2~T+Re+_!^5%dGmSuNI=J!x9?pcL;ooA
z?JH#1JsfA*1nceK~qY{&41-f&KGy@XoB^eM_(%*e@Q=KAYn5B>@>V
zFh6@)x~5k=*wI$i92<@Mfu+FHG|82vKz3(OJ|EUN|?t8SeRceXI$8MuG3*-_PXD1>NN-
zH`?x9wehUa#^SXT{GNdQyQjIeRp9F*!!!F}l=ZG2W%{ggo@tHS`0lW#T@1upt*D&?
z!JixaRoA`8GF-~bZDVfVW?ZjJ0bcZ~yE>isPN9dbYZU7wzfd)1ZJn0&PA5TDl4JsB6`((!)#m)&5`
zR-WHTCL-5zH^%a%9;EG+hm*UHujO{!yOC$&H=eim4YhMD&yECQpafV>LU^qkCeW^V_rbhQRj#ob?gj1LJ(v*nZsD^0O54+MfRmM$M`tu^;)m_xUO&
zcLvUu_C<-yq4e~r(Y3%{&)K;g_?n@4z`={@HR+B7jTsrAozDbxd`I+J^IW~t4~>Jp
zeE+z>ct3Ey_~6XGBw!2AyJD;NrTF9TJmFDa$^8%c{q)9;uk>sO?jv)1$M={$IMZD{
zbpG$L_vrM@J~8h;+8PhlJ
z@h&(TRDN#HT;AEUU(EDASJAINHv%>_bxD_gw1dNDa3E+Lo5L(UYi*t{&*@_qkM7s6
z;*Rr!ft+syY`bGdK4T8ai+lBExQw|RFHF+drehJfPs|JVfLN%ZdxOTp*IQeG=dTPd
zWW%}i;`lQV378l=f7^laTA;Zr#q4ME0ffFILF>Z)
z#{#<4u=rjthw{=`(*^c`9GwZ+_4l2z+51L~^GmDmBQJVa@p8`g!wZk{q6^sfJxX!j
z3~+3Xk6e9^a4)Xp>=iFDrB~wvUGku}-`{VIFL^nzemuBknv?PM#3!aFqqe(Gjay@n
zPU~W~9#~f!X9CUNh12KkiJMkkBL}gw|G@N|eP^J&oJsapaS^XYpe>gF-{p6I#*GC(
zaUR#`#NBcKO6&M%BD5C$?Mq`cX4q?;;YtsCmzhW
z^44w*G~Bz61N}Z*il0^QL?ozEI-;b8g;LG96F9iMT%=bQbWoAr#<
z49;WU+{u^PuV3b5^|+~nmk-=-&m4ccE(PS&shY<{U(mz;XxlS&+4H-VvDp5XaIVFH
z&uZrf<1^pH+Bx@3&cxQ5vwgiY+qyXvSuxIt=&(NKwB*T|IB-;!3M}n@2`}NLddGM!x&;`!sl?YV#dgdDe8~kz)Yz7YmVp)!hj5TZQ
z&;JbpJn^>I*M#bt++OE={GKYE{Bw8N~6$AMtPZv3UjlQdojQ~d=
zCkE#O4gcPqp0)l@e}rdV?9~=q+EyUf+Qq>5LVyFG)!6mUkvfC&rEe{0tjoW7pcmw`
zaS#J>Iu^+HdeE9Xkg+y$b3WLtPP(c?eB{{YB)-VkCnxZH>ECmEGGlgXgFLAH>Xdi2
zUyf>!U8qlNiQ_+xEpc^E;>DIa6@#Mz->i)_hx2^R8KqPEABX(Xi;w5(jbH4xo|-Rl
z#f>i;0U5G5i_hGi_11$L)3yTZjg9q3gX_hnyvoPCq^!duge+Jdnpi$i-EI8pSj$UJrwkNc;1g<$uDt!Itm_3
zzd6n4pBY;(?%
z;_(Z^Ub@N9Ioef+a;w(F7@9{tuFl^5NirXMMmI8E57-w+cc><|e6z+EO}&U;^@$Vi
zc*`jp+QUJ=e`>xJ$oI(CI^Aq*?BURT^2nF%K->lO@pSBqL4n(N*Rb>cDPG<^>fl5m
z*0o=rAE|wDwpWbV6NARjeDs0c$AbB~{PFEv@F~fOSi)_AT+-dV^jzw#_1t!@cdy99
zM!=Ss@n1eq2A^Piqc8yl$rEDoYPP*>AqC
zcR#3&^~dhNj`;zt;rh`WHy7fVurKdRW1Ka7=+x$1_p{gCsCDn0
zpP2J~Cm7?ril5rv4$5zy2R76|zvs7^u|~gjhuV4Wy7;hve?TYw8a?=QkD9ipYvcDc
z&u3kmb6U%qdsrUSM$bfb-kG(d!9#()@*+0%0oMbW+uwT+4{ME=XNv%De!;4Gwdbi|
zJE#xzJG<%-*TxbL80B7``H=uWw)OSnaK@X{8t$I${tV&;%YU=zRhbv+u;ab@h+Ox3
zIJf2b8A55_Gkpe8quz-)%IEojPvRlB{Nd|7zU1s#pPrE?C$96pwJyHL0%ufCoy$*)
z@Tzn9Xr9Tf_-o?ddE?z@^lk=x5hv@Tul~+azAXZ6vHbt8zJnQ)r`uTbZlTW|tnWKV
zk2`xO1F?fVu~|88V=UY)ob_Qek8aQ*z;syAAXv#
zTC!Ij#&@H9Tlc&7_L?6E{2m@&aW>qi4I9`$~H=3>ph95yG-EqlK&z?D6`Mt6K(@B=!{4{pXDr0RCX!3A>K#$n7XY8HRxIK|EoBuLA
z@bq5sOrr~5GVJ=AQM2B-tY^F#oC`i@o@%NGV(D&I^#&qIh
zycRUqxP!dPP5ah~wT{K(!vP&^Yn8_zulDX^me_jH1S_74A+(;1)yg8kMX#0rVmaHj
ztLEsuSq^;{QdJIoV^{1plOVdqS1p|nG){@G@O-g4rX@f`twJ*Su7db;Pm
zTyF&BO-KF3hdz9?R}Fmb&RopsBU9b@xSvl3I2;N*TLc<=$Ag2xsX%Uxq4_cHpOYqk
zBEU~;&e+)u_R_bVXYAw7Cx4%a`MCDs!5??dvA`Ktv)ZKqcjp;5dD8C$^yr<7MWEdq
z*nc>{3)k`f>HCfzvE2&zs&ekWhu(dwc_wC^<8~$B&#}NWHbd@eGdl?$7k#k*XG{w%-Z}u?p$uvf<63xe)jYkzpabGFXs0@`KLC@RnKp0WWA?9JDct2=NPji
znX8!x19jAR*}EQW2DqAkYM?c?moldRV!+4p#p~~_;6+cliUZwa-2Z0wh*xFsA!7}9
zx$oUn88yfU{0;^5J|4KA>Mw4UZ;bBE8rj2>oOLq2uNxQsISX`=Y24pF_(wl^{K$&u
z!C*URy|N{4YUhanUpgNRa9tJmuAk3y@2C1R=b1;#`@$L0=#q;E1E0D1pt-li^fLl+
zqz4a8oPDja6_mSu)kStQ5BPC1&}*K*HBc*jt6YZH-XXP1U*qTRfFS#of&7Y}&%|V^
zgHF86@f`m=*s07<2e=*xs@Lz-(FfK%_cIbXvQ}LuGG?>2{lbj3>&eKi*7LoUv9rm(
zHGS8_d0gvWu`p)W`|n_GM|B1Es29-0w*2~x4fRDwYfBBW%h&B;+!(E84b%t!b^>vD
zIure|Kt9(4?P5S5TN)mnk2>F&b^e3TvYWv}0a^NRw^yynYrmE)?@L+3hds|5hx60A
zHJr(jQPVxQ87{xh!11Y|yu<+1i+7r_z4YLsr&m4T+j<~-B(SeJB?ET_Cj;?eueG$u
zSX(7iz4jar#6!bDT*QQZGA7*E+(JZml{SSM|Z3&v(7g=p4e{9s_+LAVjQ6s`S9;~pe*ER7_1qfn`$R8aa%H>-wDPF0w`Psp
znP4q=a=P!tlZ^e%b^Q@Xb)mmE-~+$=yuG-uIty7|o`tav)Ga&oUJ2;rA0B)bTRw{$
z{kV-i`{F{!MqocY7_^?mul^g8R}XyDMm}PpJr#`W^34X{=n{jSp!pEb+I&1?cEsNu
z>XaYM{~r#zZa;l|!G+J}qx^lDYnA2C%a<$9=3!rD_=ZdM(T}74P~f@v91XmC?Zt_&
zWLh7Mk8@y69^|8WXgohIYxcFT4LUahThAp^
zw)M65M|(O9mf}C6kJnz@5cq{@9kMqIp0bMxhapG5Pvv(+<
zYxL(_=C4l;i47ahmU=l7c=kY^&DX_1Ugq}HXzlTTJE&iHUJ0z@ujd=!!{<@!Cn@xoPno(LWY#9gz7lU@y6FK+kdISz*d94=11xZM_P1>&dC({qHov2$U6
zKc}6{SPj(w&|T(!tkt-(T%%7sK&<(%Cg}6C5dJkE{1cnz^PY_52)BoW?VxevJAUFJ
z23;p>|5~82&j)tZsP&PzTEUAhI*swOzUuoRbT#&ijJ4*K4lz0!kmC=XnwWP@?exq!
zgJQ8AjCm*rf996{$AkJvj~vLIHu}g;{p>S7iLn@Xj^~?#N8%)#^4FM%kM{+6V|Pj4
z5$xGd-{oKbw1;=Q<>$HT#La$n
zqV6{XO{~ex>)JCqF9l@TmqRhpoImlR_e@~jzv*b+&)C+!CTo1VGY|vqo%y$Q^y-iv
zwMU0|y*Bdmb$WcSt+wd-u6(bje%Jn=&l+3i+PgCsul2y1eV;y)d1>bS7ZWu=XZPqm
z(|e}(yqxuF&H4+2=9;c2;v+8FjdXiHw_#q;eQ&^jP0o6T)e~}u)5((@LYSZ4_or$v(AIra4tRli$GIrr-IXgJS}sTUhNzS_y(Qh+rLY|ohbL+FF)W6
z*uxjSIo|b+4!`H;4&XCBedcVjRXv_rbB^Td-GL^Sj|FN&-kdph>=kRW8vl9*o%yw4
zKH3mVy4v^7#owA*m_J)&O%r3!8;8abZ+p!7hqE~F$+-NBX?+zICZD(!||966(5i$0;MH|l;-uw`A
zx->lbtntrt{?kV{UB+xwzghtL)YM!b{v%Jm)6Gx1_2#WJJzxDko7&h6#C`W%9emEG
zXH2JFqocKUcDb^=u=ZMW
zi>1^v`a0jr`fUMU=;*%k)Q{ZcZV_mU<^OkMX74KAm0@Q+I2efaBG9ZqFW3&~;FH3`
z+x>voso->A?;U~t)^WKIuq$`n|8xZ8U?UJydGWk;)SlmG0&VT4QOQE}tF6n7pyrdv-aHw@X1e*Iv1bJ>4U}
z>aWjYK{s9G?d9W{fUWoE^Gf|~o#Ms+y8?|Lbg-odvUG`qo*li<7S;XLgYM?aKKu9U
zJDuJQ*Ynl=El*_0HP%}hiwBO~-})Rm%O4+C)o7NNe&b7@dez3WKK^+o{>|^116dOj
z&F`r2Uq1BW{IvlY@nuJ^20Z)9fX(q4U+@)kJ)7g)I-lg#pIxR~ZPWKD!7YL3{o2AE
zPsYBx0{q$Vb&S}1zB6H7gWj24!{KO9{o}Lyre_bOcaL~hU%MX%F)1$`tkFwW&h(35
zEucg0SLMyVrvmvGztKOj;J>&n0&TJU|89=uras`)IEv3^uxjm1S${l6#MpB+M;>ST
zx^I!O^DYKzh@9u6oZK%0a{RrXpLx8L;is6;%P$QV`?axttTis=`MMo!1#HSS9~Oc6
z_3WR@^V0#_2ZNqPzIV(&kf%EXxghU%&5S+cv$_+L>huh7$EW>%^YJ^fnNR%F=svR?
z?f&}&^oY^j0oyof?BKeWJ-L2l(#_}c6)TNSdDZA>y!j&D_G|||<7BN}PgX2Fms>v2
z_5H)U@Wq)Q3D_2UT*$lc_|Mm;8BC*N)tTv@#ux9+ptjYh7`9&Vwk9{us`pT1u*g`m
z_x^x?xTz&~3T_Vu*6e>vFmiN0S8+U?^~Qm192SALSpNT+&+zPOTLIpu0<|i38a;fh
zzdhgl!>N4k%lJrut5~iDbasqq-?u{CeQ(a#*EBwl*7m`S*>BA^m;ZFgrTEzA-t9hn
zwga~ApT>=CrpvfmC#M#0tDL#KnB$FuR{!6Sv9ImvTLoNKty|MB1>$uv;6J_kqPaYl
zHN0*M_%d?gS7Y%5iACcnmcBN}e||>guH4o1D&W3q-P)r;In4Rsh>zxbxN|;oT0W;T
zR#$6*b~zA_D*=D`;84CMojSr>j7I)=-U#A2%DBVj+nr*pRWDij*4XzMzx6%tvwxhg
zXYPA559e^5OON9s&>jvdYaN&B7SH;&n-jnF@|@@Vkw6`92V!lkm1pk+JT3Q-#|p?`fKPxyXr_=
zYhSO44?pQ{49RZ>;w%o^LHXhZz4zIn_j){WD+u^K>k@%?-H6;IyyL$JmHPU*P=hm~h`A<7)(tamv>O~CHKIhok2)=q@YYBN_8wUiIqnOrZVL@L96&
z<(~D%4|lOW8;G~K_byz|Sk69wkDTSvv(71wKu7bn$au~XSMgVaYEhk-yKDV+mz=V#
z7dxDdoxh%UHk!xgGE2+*T@3g|ub8j_=L1b_>30v;@397N#t-^O-Xr(M8gKWch7&Fq
z18eo24|6|mmgCKQt`yhCWv{-m#{Wd1;mv1vs{2$M*VLwcYk_@-1M#fidbQ#20e9E7
zR{FC$wL-Tz+SgpsNjIHzH@52YckEH0`!_W46VjpULEhZ_e7~
z!2Pfp>;&Ss2sCoe7hS$ap@ZD{Ko0qNEZ~!Qd8tvn-aO-VI%{)YQG4y4V*f@qaji|~
zp*F>Cd)kjDUAXhn{ocEKD`R}g_B~D(k42!3dE_hI){qmQ;{hLQ+Ze<{e0p|vPyO!w
zljUpY76&=kE(GLp?%g+kALY^VEMkuP`+{!`zBAA+2J%mrUY&hKa3HAuKb-MfgU=4M
zKNS4#;0sOC-WB|*+^glzXE++14EQJB?rJ&0Lrgvpp%BdS`YZ}R4|^|OPSw@&*jLJ4?DjWK98>86P3%~{r=R+4xZPG56MqHqmvE(l~eu4
zO)fPt!e1>pkM`(`^BI#J_o_9`9((Q4I|KG<)y2N?A~+h9OXHKJ<=WcRn|o%ic^^8>
z;_hzwxZp@|Cb&EJq`NU`4xG_veyI4y$x$jUn&*V8$2bSFKQ
zx;~d)4J`uAXDiQk_INhe@%TRFzF?nnzjF^c+|<7_h~HZy*I1eVu3?_(vt-{kJR|$N
zhq*e}{NCDa={xuRLvwA+Wk1Wv&F2MQ9*E)ZiOxm(Ukv8Ye(&&XwDE!1=(!))zh#g0
zZ`xzsJ8qSpuh?V#_h)^y_m#(v+>zJ5Gjlr3>HPZ4@j5iDeOlJ!tT7xp
z+?{9U_V}Du9^d)P&#e25)b&rA)@$#vUwXFB4`lxQNgkh2k+w=`8WOiF30M~(sMra&fVV+Z5)3*{{Zw(*2gpVg;BJ~nlm^0`2NV^i!Wc=E!GaInvxK
z#<+;vXy?x8;ZMH~#L+w9Tz(Op+!(iCO58lxj{ck7eRPUJ_kGz<@8-Ze+nOA_FW-Q8
zJpE|*-B}yw@65b)Ahu%WGeh;>Gm~GR<`LPq|8%n1+PNd+a(wzHf3?5=D*mdqR}XSK
zk(<}b?~CF^WLDkJzkhf(`g>`z$G&zp^VZ7w%o}%S;q;e06ZhL@`+ojkKRb@!HJktS
z%=vvOsITvx$$Vwz&(HJLv|4Da^q%RP7jR&eXJws~8b8*-EoT$HV>V0-K_ce?Dlc)Yur~cEY{`FJ;;MDv4LEbsnfBw|JW$MMp
z`q`yZxXX#J@eU_1-}q&_zq4Q;c{)7*<)3(_p6Bs9mFMKuxBfE%``j6y
zIqfrdc3zNq_kUXE*6IJTAAfe*j}
z*T0`X&_9=N4&8&~o6A>CbKje?et$rZ^L1+8OR+B)xO{Ww_`Pmedm?M&p8xZo@6N}V{9m(}{GrIuOIOeOADDEC>CgSM
zU7lom23vc52X%j+?{(MtnwFj3b>1oFN2dPx)VnXNfbc=z02M@&42&Yf6>&xW9r{I_3xVcC#U}1Q~woH|A(jkk4*hnP5mFA`mdS#KRNYZ
zJM~{T_3xefZ=Cu+Gxh(|)c?;@|F)?w&%ZFu|5EzK%w6(D$@SL--xmDvpS*hYlizps
z>OTt3{;yZB{;9uw_3H1-U-I@Jf^U5P)vI6g?N_h<$Oo=oeaClRz52iWovT-W?|0|V
z{``Z;A{r!P6*Y&5f{w34;
zc6xi9q5A&%=(ToiSi3TVU
z9gv6WBv0omnUPPZF70=(x~@&NJlfYzAbFTZ7-1
z?@h4r;cVvrmB4vznz1HF_*Jg9
z?d7xjGREIt{+NThkr#XUE}`xT`4UfUuiT2aT`^BLvVfFFF)#Jf7K
z$GfqxU+kJ&-02est^W6pkVL#jzxR7*G#B=Z6WgsL9AM1Dq0G-s>-^$#`KYN;-<%Ks
z=p)BB_SBQLF)wtEdhFBK@eEgc{@#ilh;!vHXFSUP)fM+iV|^oE_TuidD<57Q(506z
zpJlyM<>*-88M(%m49L@nS7gpVviWjy`SmAmJAs&t{~p$Q=H7drv&Gl*fu>%>Xtbw(
z#DqP2)c3{Uw+7BfcbKG%;vmZRUT5-;598~bGE{m8YP&qq!Z+xkvd_p)P5
z_t^7y^oj3ybl>%Smlv(R?Z@}l1N~}+4l(N7dzugC{fv40Glb-`Ltx%y~t$L((>Uh2R5ZYEy*W?TFk7u@j^2hZ^+m*$qw8^J9>Yo&Vd
zpkuGT`WBJV8>qxVBY&fPS_Q5
zGV?PockU$m$vQuDx;w;;4KWv6`z^jEoj7~W7N79fdgrz#*luiWpv&HK!53vxoz2Tw
zgE-kMKI?(KY<3T>8v(gF$NRD-j&BV3L#Ah1j;o_`4`t2S^bW_pF=bG^#m4u5WE)e{+u#k@Af>lFe1p8st4x31zDGr*w>SNqnu43w0e*CnIDSvR?{Va9sQpbBT|I@+u2R|HW?1>e5
zvAZKs7h=c0_2!&x^YnBA@bb(zf?EQ%MqMw?9Pj2=Z0Em^+B3t3n6k;%`qWqFUa@75
ze*2rda~U5Ay0^Z`6B)IvZ3dpr*Ph5488-2mKVP+{obfmxkg?WYJaJv+N0y)EGk?gP
z3FPy9@>veP#yA>~0e2UB8h@=dSLM{_=6E=p_G$RqC(pfG8awqUCkKM+?%aNQ)Qd)z
zuVX&U)k@>O>a60+H-COk-ZlfVcMom{>}m9nT?Cpv{at7NtxanjVUHg7w)kniOYv2+
z^|5>#NAmU6+89I6%=yK4G1D4DoZP=^mwjh>5oqoLjXnFj2QR*PzgRmOus_PN!}mFF
zdgOBvtOdC74>$5^1sCT~9qXSv_0FaFEy4WjQ?mA*3Qh<1fOxDz?{j^v#;@x
zr~89D0&x>d&&C*y`^9)8V5{r+tY?n1#=pjvf5v@3E;43g^j%CY1m$GR2cH|o=1PDk
z-ePkxU|S9B<-aq<2b{`t^uKFkywwc-YGPGP_}64{iVSD
zW8Gb4U9Rt#=5phib2h>;v;Xm+eu?QuU_Wm5^)9s6*gnq|fwoxw|Jgq9o$P+U-zERz
z?F<>a!;G!5YkW(NEVFk-TjQV
z`@7vglKG3H;6g~fJ@|{k_XZk1>|YGzb&D|Sx<8mgz^S4i*zud+AQZM{J8n8RYh&?>{MmHVW?Sl?`
z=nxw^>?u!seg3&CSPxn+_FM=WLubiz!24M61=INW)bn!@;4IGM)B(ODx1ab=&-_j@
z-^pzRjVpQnHW&1Q_&ZOUF?n&brUuAt2Yjf!`q0SZMcx`e#GdW;Y?|9U_MXe9wdSv~
z^jh~m)$`{}fYUcke*S#Mi$D{Xdjs6Ht>EZ#^vv0mOB@=93mLPwduDh4-u#`+`Qe%S
z_hWC_{dv8)e6qhCcqSn1Z5pT9i>nxTzUp)GDxEluI_D^?Dpyo6TW!+g{DmtLEiW>^@0T@%l2^oFYff*$dn
zj^=Yc>VUtVNt)QTt}hSkThqGQ#=S9S%e^8Wicly#Bg3SY|+6M
znN>Z%_q&e`7`e-}dDq)J8`izYoDs2j&9Cg<>p!3IBGAaI&GEk5$XvqnBg#yl3{xYvE5
zei|cp|AD-9)!=Ug+zETxl^189kMbf$+f%=j-uimrE)*9{KA+5G;yraGux}%9hl!<_
z*yp~KTXC>wulsUsk~x?D9oe`@-}|!X5HIKLdiUjxY^fdGR^6A~yU25muVTXwwTJ(z
z`;tC!8t==|pC=}N+&OgZ#~<xEhniPq05F-A3T9SKsnR_Km^c59G`~
z&svx7&-gb2>T)l;d9>u-bEJPD*bKzHKC~9qo?4VgGW=`(swHx(J}WgR&CAD4vJ~By
z@zFp{)9;+9iS0lgHs*&jX0x1jR+|5=b7(kDM?dP&5PPnuehuQ&I*pB5BFrg5r`o<`^n+b
zc#mA@Za&n1eY`K@qXACp8>jU^?A{q=?hpDGf%b4f7OzqEORgh(AhPmBUR>zA5R`-G
zxb?jEPT><-KJ{$k^QBohpWZ&t`VO*hultPbQvvP=C)nHfw%%U(5)aS3C-KBVeW(ZP
zjbr;4PV4r1?hMZRGg+hO$MRkoIabU$wdV~vufliizv*f;+6iRW7IRf(tf%FhRjK&#%l
zPhzCiCvvTwz6;0vtCh-*`RAX#ho{~ie7px#DfYH|ONsY2~E8$DhNf1)LUv<_@t(Es%X6a1KrcYk^i>
zTN&e{^**r2_tx>XPYm20qwK2v^7eVbs}Jm+ulHp9OM!bYOG}${l!NE$%6rLkcE5KT
zJLBrwdiR{l`1G`99beqQUhfV$kt4pV$FAR(@yS39Y4(!gN8@DwOETY_))wit>)GdX
zZQxhlBUd^u1?;dZuI$F#vVP>84l$P__FD&HAbz#sjIzOx+K|7-1E2QZ(7a>ll0&Hd-V>dR5Bu~#7|0F(Um3hB!j*IW$Tj!u
zi5cDUydKc)YFN_Hb)PtL9c
zVk?%$eBl$$>iSYZr`WS4w)T0>jy1f=?!~*lHpcu|3&e`Qpk5oxzAsz%2sBRW&wlp{
z9{5zhJlpe*04Lno@t)-)zRi!=@TuqY-i-OKsb9LD3i^50{xj41{rOo3U39P`J_iG~
z)kfnkCiZxC+w}91${)!ZF6A@!=d-TykFM(DPwnb^rrmRQ2mQS{y1qT%Ki)|X;xqrf
zx#k*YITm~I8250D9b8Ad{A$ea%lK%(M>@#q$L_@$}qXuo2K9zM7aX0=(yXaq|9X
z{QCU9tkEe~eNJXCx!x`O=Ie!^x(;M4hP_+dQP$*uES@h6=+TTOQT8V%*?!)f-wmxt9OicZ;b5otz^L2bxis>ypYPR0H&_>Mr=G1>^k%e%xJPw%or!<@do?uOQtTBe^P{an>EYPmV0
z%h_xE%<-GwF^jBeTLC}ag*d8R=gqs;XCZd^X3g_c!RbIPfZP_Z$XFc7<*%Sw{`;(#
zG8Q}B`#w6E@$-V}I*>734DePf?eXt@fR7x~^>hS`)mZh54ZZTZ9gwe{QRZyc$9;09
z^&PUFF&lp0NZrs^4%WxNw^eM(pAR%SQ4`u|lMFqYT+>6j*jqmkI0NErpO}iB_?s^R
zGWgif&P02;Hs{;9_|dQK?g+#T7wh~5`pJvw{pmLXJk$|;xGVx~vHbrt{Z{65&2#yN
zrQF&w2lAj+@aI!=VjsJ{#yOWBPiIB^$g+D^AV%Yw{fj^wpPS=zFqre1*A^Xcev-G3
z&zkxhx!sdFZgTOa;E|B49nV@nJuiInxm)ax2CW@?_%(7noH?J@r)R6;L66+w$+B2lorU?wC==o+E*?y=wiotk;fwkyitw>}Us{@tJ(l-}l<+_m~qL&H1Gs
zTPwdU!GU?L$Q|ACqOUwTaOP{1@6Vrfs5Lh1Pl%Sb-kpBgB7;NYEsvW4{atHK^3%Fl
zi2a#>5Bcjwmj6z0*Xa9_tnH+S-lg)p9mp{q<_`|@^26~$z@9a+>AalElPtN`qtAEp
z#|D^tcWCd~?UuF;<AGj3e1iR)Jf)z1fYv=)?$xFoF4dFk+Vj~K9l
zkIw|+AO>P>-=Tn?H?sYEBBQA(u@`eW5hpcxZ(v<}ICy37WifCry*Mob&9mkKpT_l7
z8RJQoZ{B5E<9|70JlPXJ>y4pY+SAxoC)@n=%voZ$_2ut=5r5D5#0Prmw}1Q`k?FOZ
z;fE(Zjhj4aV#tQGU`@`*T4U>ay!f&+$>95vz~1^LZ|VeJdJhKH>|?K7)-u*`k&m8B
zYwz*DG=AblpIV?}%+VrqjUDza3Qh+HCh*67@ro>vIT&a=!4rWsvf70}96a;&&nVyfSG)k{?McS|M~88S
z&x$1uVxjThoNrGju*UMhX3qm2=42Gi*>sh$)_1R*%l&#_{nz^0O?(%D#&@-%T@J*h
zd^|fIh`|`|OqYJk;~N9Mi4~q|p!@I3_-OD@Ko>pq^Sd%)YQH?lw{v4n4UrX3bxE(<
z!BPC?ccMK{1=>zPhK>Hd!O4to3F-$ffD1djd0$_~_}eo7@!+Y0S&z`)3?9hlM<__c
z4QG4B;Eq5{)g}Jc<%P{r=3%lkww`0HHRbE7|hC+@9{(dMccv02$O
z8H?Fp8{TK)tNz%>i%)!MuFhrb`J6XD!G1o7$~%Uj$)&=OxIe#
zmbLn4+_l=l_wFFyTDZEAUOmq1!yf+e3wJ&{*Ye<5eHG)b@5PsH4JZ5X)~lZn1#;+)
zV1qq9nR3EgZ1nZl`+Pe%7d#n4>TmoyxW1CdPb2eW0-OJqU)%C;Be*5#GqJc5xOy@~!tE%K=QNY|9deijl2Z;gVh#TyWVT5C;<+LPDd41V{)AZ5<#aAp}Axr_^Z(
z3E|Kt9KxXlf)h?j3WNY9je7sS`R?`Omv3fwW#g-TF5P;b_j&)v`~QF5_nVpB*^yJv
zh3@0eS#W8`XhhA&RFS+)&
zwHOcbuU}_@IGhnWdT=_wBzq?V^6nYr`0le2FVjC8&hAd&9>JrTHUc%Ew-(@d>aW-I
zd=G$~Ss-6=@~d{20{P0ZXMI&1`ecj)m*UtCjK7!f5wi#Moqs-01U^q6T7nNcuK&dH
z`^vA&S`K9OS#7>K_uC6*c0DuLRr|Yx%|NdDuDQyuw(z7^#E!4ln4j~3F<<=ucfX5p
z#I|RA{o`^y*RueZ&8_!2;eR9G8@J@mY_&%^>o2`A3-rclhaNlT@;d!~m>3Lo#4UMz
z%J1nwzu-oF@iTty$gY^^n$=jGuC3)i#&ch;@k*A>^TFZeHIDeO4`jq(7P}c&eJ|1L
zI?MNZr{ct5kM4!#`~{f}JgMg+fgC);zbFozf4t5E=^l*{5>dGpE+%S}UJJ%cnelC48!7d1DJ{`a~S``4F?S%9eWB$1S_o)t6uQ
zW?A17h~;olTkThJ?9sJWv&Je{e(QtIJP_-CXTq5>*dtG$O+7Nkzmx0n43d3wAXfQ%
ze&J>o*jp7hdvcuz1{-ue)2-FCxzOJZaPSxMXBf%pAJ5#)U~0dyvV&{$^m&1w@tk=U
zT?yL9o@sI**PLcqp9pZx9-iopHE<7a?z`uj|LWkLUD&S<^bB_B;vZMyP*C~dM;+|>
z`dOa##@zYf7eCYaCE1$=Wca9^gKW2#_;NPc#K%GU;%#i|hqLn4eBPKnvGbe}Rf|3|vRufCzq!+wJFeL1xe^N>
z?pgEQv%8yh^X&74E;&77O}4PlzPOFrK9}_^OLXnN_{hIFV8hUBV&!-I^S-{fGY<^!
zJcEDwbi`V}_SlnS_xi3W&!g^?H6XtM6LQ>NNJZy|MPlQ;FADs=>^Ubs
zuXuK?^5Z_=xHuCyV|b9aJjHM*Xl!~+Z{Weemze07}xjeXUApohQC)qiF7HUrPBwcxQ}D^L?M^z{+lz7y4ZCm<(YpNZcQ
z!+MT93my!7=97ofxcl7HyL!{O9MB!_@oCg$&n?eB&wO_2O>0k9PlM;qcCZ%Yp9Q)0Sw;SL2lzF_#pcK_KhEFffGu^$
z2m5;Eu7Djj^orP=VRhFpeQv6s&$IVuo&`sO-fNBd5d)uN3~Gae=0EDOQ=a5^JecxB
zX39^wkuPq@kgZvlFyO#5xbisG0W`-HkwxlAi~L
zcgx%&qxF}!H9yuT0)FXMM*rG({Ub5x{)GT1diO?UZ;PxLaQdZ74(PMnUc;?DHP&zc
zUF762%8dQ^=MT7lEPC?N<97u7J{x&;8|~?T{Jk(BFHXMy`vYvd{}&FppW6$6UltiX
zv&vs<-CmXFcHlby%--*Mjx|Pk{KW(E5Zhn6PHbM!@G+
zM5cLsey&@GV_D0Q%vVN6Pgc(JLrukAUw`?4*u?Tzu5{3EhBJGlDl$W6IAk$pX2SoDXLS&(r6ie&^>>K=xwL
z=bPTH{jZ9>z9;O_$v-`|c-Gc_LR_4ORetC;A3iH{I&1k|jWRo{dchgT)z{nrS7Xe7
zB=LQ4^k5_4=WAE^ai;lL6Ddd
zx~poq8w2V(XDCA*<`x-vnOkJE9&*E#Jm_|RE9(=>>+!kH_KnEtsT+~Q@n1`>`R{i<
z%W<_Huq8gd%D?x^SoiPGpNEm#c95g@g73~X-}L0iHapGjOxA4Q8qj0=a=G7pM
zr@sDjY?E`3?&|^^8`k@aU%$Neesui}x%PRPZ|8$gkOP@V<45f6z5B8j
zvzqW<;P0=;R{mS;P5V@iZ1A(HUwX#PGV
z>Vwgy=atW|WcND*Z_Urm*w8;>yuAE5TI1#)H++kk5B~nv0X5dkt?}rWe)INzxi{Br
zv-eH0*Pb0ew;jp7{hpV{mb!mCx(B@zH8DoC;0{&J*|=Q$M{f;PXTvj(&a=
z+g5fg=fJ-WTe27NZ^$<;ea-u-&6vM*fTV@Dt1@}Z!;Yt0uMz^C)U
zmb&oc`-`4GhM374?y=WA%7L7Y1%D#I#a#hge3}6#R{}h-Bi=6#oSBV4jDw(;RSs=NBIWAJq-Xf3SqFDJTeidEjb
z0sdzJAFFs4=g7wot>9xG8G~nk)aY#R-N~QaeSsL{BsY8h
zJT<=U>GkTZy5DCIyQ}W&--GmVFnwN$yBx~DIXVpLCm(up+78Hn_liE>&Axo-$%mf7
zhI{kCU<+DXI(kX%HiK2YH0q0^&lU4};QZjPwtOFIm8~&GdX2I6@Z0*-mV0c|<@?S6
zPrYAXa`rP1GVV7va(9OW=a!wv0-rg=ELXLx%v#p;`*R6A;ag4hhW>KjdknAEbl;r|
z_s<8$;{m;AgMQB8OMc?NC20Jf`Q?gDaqA;;p0hZrY-_|XkdfCY!-hO7Gtb)C3dGW0
z6CXSjh)ev|^juquSuEE0#fP=p@nd~7@T|8MZ+UkuPuFx^w=V2@H@L?ieyz)~wHVZ<
zGJ5nY0>0_=-qg1H^;Hhc^gk~!tpC_zwP%N4_Qb`X++6PlxJSa7Oq&6j_5m6E(80lt
z>XcV{`mjD;ne|x9n4SYN^S~M8Q>z+mDtY=Z|J&QQ*=PohR@7dBbYHY?IF5K_gsJyt?R*!ePnb9@dCxYI;8sXRETHW!t
z7O=?%+3IC^ZOsoGz0bxc=9-Q2yh@KxdX>47H97jP&O8g`kBfu!-Jj~7TVSjRPJLU0&h*vSH5+C&`s`%O9$(_B
zoY?f3`^Hwl{+OG6_Q$weJNtU9af_jG;}}o)X#C_F9~IxE(T(0
z&GEyxc&+(w9mRkb`{F1UuEpb;ylcK(v*nt9*W$apT+12P_VFMV>&9bE<^wU~il1_}
zowdCEeQ_~2r`@cb!SVNEc!ziwki)n8zUOv-=6eFUueyKla6ijM{%oiPJJwGGPv)?`
zE;Ad>E&G19hntN6$8QVB@U;_cE!UYA_O4`Rue!LtJ2)DU)eG&7!&!rz+yB=5sf{&T
z?GgUlBkJEC(JweP(>c1lZjZEQ+9T~5w#mz-wQtXer#&MUd5{qc-q`l}L9FcCbKkpA
z?h@F|bRu{x@ND^1&_V&93JzR)uUS!a{2>amBP#%RWgnVh*j>`b~g_w4q}kd>=*Lf;@OmxE?J
zx_`4XAB}+ze$B>KfbW+FzVCu>HMEb5{q}Qfk%N56s?Dk3^m0v?9rxcJ7)OJ(Ks@un
zpv$NIt`G7lkMgGnt)B>yHuI1;NE!X&RE%wXH_1H&^olN7|&ANHBw-Ly-wcyL17}%2ccA$5@
zX8D;zetgnVPr2Z@XH$Ia&@=qmkEyIUe0^zO7o1JeCiif#iQjAVzUimi@+6F2?(88O=-Yc&_25Jl0lapUpk_mm@wZs|a-QJNEw@
zmwWX1CwH^&&=Uj4YAx5pLG5{u@QVvEw0?Zy-Mw;AeVmY^s~6d{$A+5K_Svl6o90cf
z?jw>_F14Y^t`M($9hkEJ#W=7Cpda#
z?)REMGMhnr;-0MK-=3m#DA)MwbA|7oS^d2qANUtHe$EGdm#Bk%{diD5{64#s(*yFu
zvD)=KHJ9c#=5jJ}*UQCuS_{M@u8#`X>SsYQ^Cf=$R=MXBf6pH~`i>3u>+@{ZtNL&3
z@q_y6uIPJ)H6Oht_SzrMPTwtZr8f)Iv^~`G(OTiMcCOb$4@CBQysJ~=6w7`+groMq
z`Fe8d)IQT2^!4A(_8A-MB>(o>lmj{R+?>k#dO3@~JtVH{<*k0ske(m=Pmj>oyEl`U
z{%ehKA{H_12CeOVS+nmsqL<`Pr#@#{S5_a49FVyl2c8#)f{RO8dBCOMLNE_{HrjhP
z`<##$&e-uzF#c5jEReWg7xX>P?~4K)9t~W(=eqrmhjQG$!d?52j{XoUo%WoV&jsun
z&sq!_1WpYj~Bd(ov!@&YYg7yhl8D<<9j2bHNmvl@tv9m5{J%zE_I
zL4EM)o@@Q+Swv1;_`I5%ugR?dYTmJPTNTnYMad0E!E0`T9aE_$0@t*y+7Bcx|Asjqb@6e+C`8fFy`~7T(?h-XU$i0eMQ#JQLptU*X4i&2=Yf5Gjn?#J*3HFzz34NUcz`ZG$jFC`
z?>BB`cHeWMdh#bnzxL%e*8I$hn)AV4b8*J%yWDMOPfq&T&=ZFOx;?XQzA@MJtuE|{
z&%HC5HiK#J=!448g}Va%CuctOL1pk!AM)!yomoJ~us`Knp4a2M{q=nK#`Vbe5C6{U
zcZr-2;#{K!LIU3VYP_VHn_d1txE+x_+t
z8#pfy*0pEWla0maoLL}7`{E(b2VZ>Fws_g@v(lQq^4#k&*Bi0V2A?>wcHY!dj?>?#
za%=Vs_aumKvO9r2&lGuxyVq;W>)p&yUB2|cx*iD(eR?Qx4=Uf^9qHP>n(@Jxb0;on
zpRan3>Rnv1!RLBlu;+6FJ9tow){GzVUQIDxlX)|!ZF1FJ6(@i6>+fjR1|6u~Pt2NK
zx!6}f=c9F1fBT(1>s5@jQQgK@0qu9&8AwO4%A{ND3@2V)^q&p$v+%H+kS8l7L&dw`)e7N7fU=v@?EBSY=?R|cbH#s?vJj%hoc+G&j
z@!4ii9#;Z3_1>#9&jP;0tPc8w?)kvj3f32^J(*9*`UCNAy{U~}e>gZ4=rcWt1N&l>
zhw~*q9LjGyF#g$!@2!nC$;fRjI2D`@+Ap4$xWGTI`C|JG0pI+&#;J8{%9ffoPMoq~
zetRGfTpK;_&TsqivE{yV!RCE|`*MFvAXob0q|cx6Y|zg$&aE1@maU`xG0w}mz9$fy
zzTv}tzyF8+-NBTbY%Tbe$FGN9+~C34I2q{Wv%%jBF^#`m$VrXd|6g-oJg#?x^4OlH
z>(9?SBjVf)t|y0g+{~6U`J(nOW^d|4%yju`4mfE~;6T1?;Z$t>eYxUljd4cCyq`>a
zh#j#y?_y(v4&_&7Vz<5EGr#*6g35?z>fQ0Z_;{}AJsY$KUCUt}
z7+b-5;Ojs7%}o!U2%5iHtv3QTa4`?)-WkaE;lSwitFvYw$Ig}*y))E8PV6=3S7u#a
z=CXTzSEz{(DylIlsKeN8>q&pZ0@((eHY{apG5PJNG$`NIA{|vf^zlqpV!{
z_Ut0}T{&Cs<4*qlyCnKlZ8n1DZYFEi6R!^rWreTn0pFFu6E4~DoDoN#DV{a=2V~sC
z#o<6M^2Ud_#48rS&u-BA;Y8f_a6Sw4M8BpLJDuiYW)mmm{_ExQeEc_l=h-*dczChe
z>nFY%yWZlHJ+Zcb<)WYD+nO{+_qGDhD7l^v-XC>uU+h;;aq5NrVibSR$?F3fibl=wZoS^_SORSP6oB7W^9;2eg3yeeejGI{H&_a7;DeCv&i(IoEdwVtaYec=e`UaXz;L-e;-j&MjUD=3k6-K9r`Pi)KfSyesQbeK|62h&JwJK?^gB8I&X%0`X0zAsvwt-K
zd|GCLf;k+@Zy4&vyOWvPSq5naI1=YkuBzV!6hN
zAwGTo;^1&lyRDTy7<-b;T2L8rfE?K(%lDJnHty=-5L{i&=s0{rNca@gEn
zw7lPIek(5ydb@%B?SRi8Sw7#zbS&5moG8Sz+qHtMsxGkLzLbNAF*4cOFMYeD(3
z-U;{|F`h5_>{UnoeCGK_Ie2F?vpo+CpOe}1ebhf0xc`qMH_!ZAf!dDuzJItk*7{#1
zXJ^hB_y6gV3*UR@m;HYd8#wlNxb5k^QTN_li`jTb42;+B%(eaY!@7Q`PKXx^r@dOjZAz0XO{PS{pWKn*QCBUH}>_)
zcjV8;jC{Q_*Olw@^H}7_tNkPSc{3Z{WA^a$AM-O&bt;F|Cqq^rSN}63Yw!4SkNz*^
zch-+FeBI>wQ*zCwGv1iUv!h4NzCJSFwVc(|^=5#_TLL;?6^_0=_{bl9?ztZg?)|an
zo)ZIEKFZ69rBD0o!+qE4ZSLm}&mq^%*Sp@eyv?57=Ef!_*Upyt)N#cmbCQd-xZd>d_jJokWl!fG
z-H!~&dWQU+UwiN0ZMK!`u~&W~zqob0{_4r~N9USNpF7!<^C#pNNXjX+ENa<0PV21S
z=s2tI{CBH+oGuw>>Ej~9m(P#&_0ie;;9QSA2GM>Fph@QOlh(Gh)?-P#veb`c_v9SN#zj<$t|L8C8*=dfa
z;i%d82B;pWqm4WEwX&CT6i|_zY|nG%WLt7
zqxREEiy>zFVy0V}6Ishm9<2jD+}B59U*6>%C*qOweakh!jY%9hP}}hgxb|N0
zycaKh@4K--)^pu6YW-n>S&p;dNFb-(KwdbT2gX*Q9_q?QfxnXhU9pLutZQShPDd8k
zY9c=8c_$zzcjID!C-KTv?9QlM`Evhk@Iwi@eeFFw3;3!%+;x4kwtx5rY`0EqgZSh<
z_Twzq+reK6zA5;w;2#AB`Q|A+sZIBJ9Md0&c6itXfo-&v{_1ij!}-iIX1x@&;?M
zvnAegD5f#jsSUQEw#?A_e04-g^i9{zZ+P=lcTn0zLah
z!4C$%8TfheM+JUIJ5)}esR?&^R)MwfPat&Tb`4ypIWX%&9%>Q
za=9z;*??{Nl{fy%k66W|C)NV|>;`1S;oj9Ke@f354dwpM{M#0F_fz(vYrKF4aG+e
zXKYOSkv{w91A6no*b3+x^c#z~*Mi#H%^KvXUuVJSU%cgL+QY5ASsX77^6kgx_Txj|
z;#X_^DF(WH^SK$gUp}5(?vWusav`6Q3-{>V7n}^HJ;g@jBVrEbOsl$r{es%&iI2@b`P6vmAoBce3(|oJ*+P_))K(22M#C}Fdu)qyv_Y4Dan1u{
zzWD!M49@--1ODif7Xy2H@BO{+_snwb+5A(%c7*?M@Onxal{fPV;#9NEK>X#Z=el2~
zxCisVpyzvsCj)uO!>A9o`)pceR}O3ojcnKZ*&R94ABCRR`=1r81?1QhhnRZC+b5%5
zW2JvSFzk`he+=PaBk11M5dZXYk4!(?^GnV%#+p3e>&xqNnU4fU`-W}zy*I=>>Zsw5
z!~h%Q`Qm$gpV7nLs-BX2YiE6Xz?WgoCVhL41p3JupW>(vP7ONZr_(*May8EbLmu){
z^K!~|{foE$vs|pjKgL2=--`pP&u{h1C0qKhaoHF9OM|`(%AwwFP0ai@2Qkls!+{(s
z*S%?9iqViifBJ?!`=jsHMh;~42V1T;m)GL5cP!Wl_;+9K^T2Q|CcZk;VQ)K-_m8gl
zj8XrMkKTY+95pZz%DJ+9&I3c7hZn28{=S%XpKo&Fi>`RR3&rB=@a8$on#^4R&aK5Yl^4e>a9?iC
zmygjdxsw4oaT;XFiS>zH{
z;d*rw<1E1OD1SNEQ`_aR@~z#`$X>5@t3FFcZP8DwYRNX9aCR|p{`8(}X#V!C#V=lQ
zlW(1~T=c1W(o+X(_i?@!@Q(+Bu3Y%i!=taUH|z6cWcbE`G1adf&s4Syd*TLr=L5s@
z#So9!c9v`Q@yE6poVmM$wP5;85j(rM!v|mGLQk>X-g1w8a~bo)+;u^8m6aroB2
z_w@NP+{1x;ZwcHhr|wzz9xmuT9k6%jaxT~Fxt3$&&hpxGTU_E+8=ucN0`}zbR8U)H
zK3Cb%=f{GV2mSrkdV+1S%GrD5fdI#RxbL0Bck4ukKABlSPh4*fcE0J0etVwTsJzcL
zhXQ%Bg9HBLD_;8c)It4D2KJ5y`_);@(>n996|AZ=Ut^s|KWZ`hVF$NAogl0)28~^w
zuJJAx*RKySg{wz`tHDnPFOKqO1TRZKzZ85_2zw^@%HT+Be^PKY_};*%J$YRW@V?+W
zFJdB_!PI}>Q}~P7g$?@nl^1?p?*{$4Zk9EB_?6e0;6%VSUgXAqb2bATV#0ktvxxb8
zV9Xc)-;;Hpj@jo3vsl{`;^I$E^T4PbH59WUj&f~=`Yt!wTFDLj&0p@@LCWxgx8&<|
zx@ydi-1P^D`AlGMKR(JiT|71(`+OMxReac27csCs3&`7(hnWmJ=7Qhu&$CVoEo>ab
z7mf|}Ah#Qg{gcamIck0Al`pgB2;MwP62n0`
zJ8y=ZTNCwL3)s^;wTX}Ri~F-cE!Za~rgEphM=r+R`EOU`ueKnUGr>Wm8v^|Tio-&z~ez2HBPy22J^r;zc(%36=M&H0Y4JO)kdH%^pbq7w*!3qM81E?
zzc{Pc@AdJ;=f&l`_kOtfpVidv)i`=Ow!|a8>Gx~Y1^;ppk88fmS(b|!*^?JOL5!Y(
zJ`Wi7T6c2mfw?s?)3L{vYd*y!#_{_)&A;cWcEz?9RF_Y&PW!2SHp@MAJQT3i_lLFb
zn|SsZ*5dV9!=CrB`q(pzw>tbAblC3qUC4@?+?k-~W50JI9`MJGXQN!47rsD_Y?>?POkO*Rufk(>@U|J9ukfeMHu3@n}HaXKcE-!kM3C?gW)T
z=&Xnde{#c}e#FOGfFpJde&k?&zUR06@P!}T6!O#)d;osziKlrSbe_ocGd%nHrF(MN
z4Bi}!pT`>y4#>1O_`ewF2mamfIrD6vp2g-O{xgBv;0d4V#+G>4H5dFjE9T?N*>(F_
z9ox^xvSx>Dd!G)Q_V76EY5je@o@UozN6d1iBbVmEuRJP)x9z~VlyAu5*|`^2b;{lN
zS>f~`i&wI^gPY+_jAIPHk-uNSpXc0WfM1-jY1R*B`Hgx%7rn;Lrg+quo$K+2Z=;-)
zH+j(&gIM|jk^C0H6fIoY?OR#lIFbj?ZXT)~ERSzFz$JHd=?yVxfy)y(*t4Q*XX-EGM;J^%v~m;V?EX1XgwQ~{?T8)CpQm_$M>dd&)?CG+TRh7
zzY?%>H35EhX1R&Ov)bBuTXh!Ni+IovzOV66AfL@ZK4i@G&92WC_T|jSJTS!I?>*C(
zi?J0rOQ(XHLMfq*}K
z)L6(ro$Ja>zy9V2_%CN!z94@kc5${xo9D7GXQTE7EI#(>-xaX69*CW7z2I6tWShqm
zS(Mqm8o#BX+AtnN2vGl)U047z0bod*V=M+2Yv^`^eOJHW*l$4;)x
z=RtKACm(!?M||RK&+8d6$=|?Bd1yZ4eesFK=L@pzi(~qClJuV#?+I#qJ8K*|JAAZv
z<=Y&yT=2-Z+-qA6HnxF#^O$EY7xr;m!c3<>3W`yc&>a
zm(Ip=O|Q>hdTYV2EPn>z_Y%shvVB&%7Jv16%|DLCe<-L7pUsJm{pz@Ozt>Y6?yK#{
z!`BTzqi9}i!aOkaDxQt@$=>(5Ze8@1+5#QCSR0k4j|;HTVAV~d-6RK
zG>@+5*~1}wddfL-{YcP$tWP>G4#+ttj|bv99k37M_v+{$4;~Jl3ix1~9Gl_-F*{dc
zJ+a)g?=y;c+k3tb>AB?Gv2iibAB~T`_>6H+43%fsz1xEEJ-?o7_1F#c_1WOZQryP&
zak-uaX}R~}sMqY{Yrub?=~emhCw9&GL?%AP
zM($ED%Dp7ly`SZx4h!9^%VTF8i`BqCJN9P5T42u^?@Vue_c<#Y0WQS#WCEfuUOcrg
zU8~1DFy@Q@zvnZBK9x`VbnIJkxRxt4&ar=YvacWAH}?AW=nLMNHGa*Xxty)Rs4aOl
z_tsqe;`y?``f`8^e9N1T=f{yipS4Eg=Z$&x4gBNf{@}!N{i@8zgB#U7z0?&0c&>{1
zq2;w2Sc?O!?UA)6D{gD&MLn$7182ngXuz)ZtwD~=;=XIVxMtheZiZ`iabwLNekzAw
zYcb&KTp$LcHFa$tkLtG-h{Jt8)!?OpAr5l<@F^DlYF{k(2JMx3-brfL7#klwv5n6S
zwGb;lHkNC8;vT;io8?*zjXBF}x!@GoS694}lgC=n+_JpZuYFdy4{vufgAcLO>6%?|
z1~&uo@rOe=6Kn^I_=fkfIP@KPwJXnR?45@1I|J8d@tWBgb3d7DGUOXKSwny0&bScp
z)f%gzTy_GnOd*E{1F^IHlZjm)sx2O!pMKuFCu_Ei-jn>N=30*S-WqHL@*Lw7Yh&v(
zg1;XOW)c4J;9J-7yV-*umV5^J_KCRHm)H1qPn?ei?emLSH?FHGmYU20zT02&>RLV3
zBrX?wdX$a!(mZRUePliA;)b8`=X!M2L%fEyGol9M{ccuyZ!E9rtF7x$usCyHn7O&q
ztsi;gS?=o4&j_#0x>!#`7_~mY;a1IXHiKlY`v&Jt&9VUgWTfC$Tm^HZKIzc=b%bZ273~?vMG<7ngH!XCQXH(|%$P
zmpC^z0`W}u-jY2s>dQAy)M6(fU*GJ>Rcz|Sr>{p(2I{Sc3^CJ_C;1WLbu0
zmJZuw*yf|pKry=^S9#PXS-SXU_oD-&zUf^JQBP;4=X&}*I)22_+}4-ZxE7<)z7VVX
zcLaRXp?@~`@dPja^3Lx;Kc|;(`OR{%#v%KLHNX1R-XnpUTl2#=eR6AoVJ+sK&8M;^
zBW^j0c^(+JWQRTL^MN6Lc5v#vShJxwti@nhljV!-BZ0l0fL(H8gxVBaZR(lYbao8-
zo)c`6^{i{o;*R;nOVc+Oh6l&nlkW_xZp)wcq^3({u1Avpx~<
z-*??trU)Q@zk|V$8yUV{kv-eZ+brMa|AwrO1#0CitS=#6^$|z&@cGQXyx9?#cc3u~
zpMd_e0eN+2Q{JZo^8AZm
z42`l)mj~5hOMZ0aVpN}A_4%X!w}YKPe2vF5
z$NdXI`wGSCqE0v&>%!;R;GgFPUsqGykIOs@)T1`oX9LgVe7)Q8ttxjfqo)7ps7pR4?6*NA2;`l$KK!=|T
z!4tuQNkGo*Jsrq>v`?14SaHDz8N>6&eRX6*?&4_tZ1y~e^F%<-`i;TpM-8s$hrQ8u
zxp4;R?gnhCrCB`taf3$#59IYMJM_d?oBQRh?qZ>5&=b$~@*pc#obla$p@%zmdM?KK
z%5bkfJtt;?XHB_aPt5G$yY_L%esx`ogIsM})Ac!c7Tgk)OZMd}rprOE#fwX}*p!nV
zp=)df_%z(p53Bx-%$?;uM)cW6V5kEfzvEOaa$03WJfjVLSsUV|!?t+Feesj+{a0ko
z2Vdef`)qM28MiOYHv(Mt40@J48N4arbL16w&GA^)_&X99&X`f|$;wr1X7$|;jISO3
z+#}yTZ|bTZcu@a7L*y{lkIt$y?wvlZ8Qt0xyWc0dmihC8e2ZxDb1XG$A3mCWXJ6i)
zr$3W>e76tT82?R}yK-G0;%&_M!~tDvF?%P^0`b@r2fhz2ug$K-VqG5iW(S96z0LN1
zJhYbV$VJ~6wIK)ZesPz3>o*QEH{yp~FCZfy~g>$?CVqZ{eE|`tHW;4*u;EKAa`T$
zGyUH0N|C#`9|&F!
zM_sw{%SLO+U;V4+2r=MN-0WBz2jwcx=bJ10W4z+LQJ(Zlbx&n|I$#gjQEPdE8n>=r
zkhOkT1?OM?tOs=H>H+KBVSQzJ{nE_-T-hwMc*y80r1GzK=(C4^ap51I_T{S2>23yO
z=wHp^$>kp3BmaDiv3Mr5Bv&v7z1B*Uh<=x1yBxn~XdVb247Henu>7!Y|-?Ubh<3sIx&F;qreA#24
z3?JeW^E@!*fnpKi|$-T~+0vSyEtxag~!KaaVdc_Y9B
z+x&U{Z3gm}r+cHmSaI6D^I02o$=2sQYoor@g)bb7_e`K4_VXiNz>_%Hxi2^w&~r~L
z^T22vTUoPj$Q8zWhjV=_kf)j-32r0~{%VJwIyT=duf;LVS6_JVi3!K*$)_P!y>>hx
zBUYcCuPoPMlrI^)8P1>ev@VT}%|pT14?DSLTMpu2gH1KFmP_NJI}ePhj=1UQ+3U&c
z9kP0^vV6`1L!5^ftG!;jn6(~pcICzwUGd^XEcj^tv#iOG*F)Cgn#zk~7Pv3B=F7)u
zm)yyKoHz}#Y?HM%&jUmJH^TFJCa3;4F~^JjdfG_KrU#2_Cr=sz=A*bdajpB?n9c_6^~-2vO)QhT&UbU;R~+79tz+|)(=3oX|CQ;?PWRWB_vPn4U*`h*22R~Gnx9#It>^fx
zD_`Pn53zN3ARePKY~YH09Eyu=^9b=&S3GKI&}r`Ges({a^$5K7`b}Ajw{>Gf9Y!CI
z=h`_Cn>g@1jnUZ@D?30Ar`BvWM)Asj{QA|sI|DhHZw=TI$BCf*c{b~xO;N;qG9V|9
zu}61ujmO5xKU>X59%3*X?zMLOkF}F8Kla7ApC58lKb{Bs`H}zV2cM&#Twbf?#jJ5H
z&i1`|Ex_++hwLm6?@oX>x*r=DeOAa9ukM`>46)Md^OCIZ3Ca8JfWPLCJKzt`VtY@&
z?fuRn_P#v$-e4_cyfk=Ya5;+K68uo`Yr)+y{8;eL;M)R&T`^t=*p=sY5b+n}pWs^j
zIqu!8#W+3}$k}iI&9gSf9M|`@ewPo=XkVA$8fX6Gr
zTLQV1yFM3dW0rd-0{sN`zcveYaKVn8e7&tFw*!7JulSl(j_mU_4-N&*c`Ix74e^PW
zyt?!0_vXuEGnnR5KFIS;UtA9b>eKjkvlb&BW&wL*un+Xd^WNCz**C&vj`-&RUdNot8@R3yagl2;u4jEEX#Vca0=B0$bdCGQG4>NKzGMX#_SH?C
zV@{tHSv+`uYzFG8Zv5_-1HU+KtZbhMR>e8yysGE;X+6cKrgEDF?lo@ro(cH%JW?CB
z&jpp6XKgeG{d`ak{HOzac)1wRWtTtsai}gE!MLYx_Q*r~OD^p#d#>Aa_|Z$aJ{;cd
z*XH>ACMPEI-e;HJyWda5hdA{_XKQCieCx~o-V>K~c^dPzHw)CGb;)v(2Tpsw{k%aP
z^~_Fy1E>$O;_|G0O<>q-TKo%+&JjZfz>YkwSXsBPZ_T0LS)k3HY7|23z1P8rI&0@;!V`<>_BCo49&e$HUe
zXQ<7<{qi&B@!%kPY>*|-Z{wNffBT>(Hu9vOkuGyh`C=jn0#=5Le>ee%XvyBz;$AG{`?q_F%{RWy)sd^-?wOVsyPE+S_O52}wt
zJRY11P6ujlj9)|5hUeI!z`IKy?gV1+-X+5>9`VMHdVspVG{__IIdlG5=tZARpV@tG
z&{41UhumDt)r&DX0kNn7iEo=Aj+L#{9`tE>F_w-lqoyofQ
z#IqHskwI@G7<*N$?yrvJ;J>#z+8^T(E57(~E`6SBOyn*F;;meJqB5&v+50z`adJFh
zhko;(FZblTwp`;y9OUSM^NFJq!8~Ax4!&O&{9Fh>o0;8tU^o{BJNk*8et$uav2i)z
zOKxh9)MIBS
zU}G(~Bj~xnx4rVs2FRo5#{FNsFGWuu
zjd7jKwfsEyrn>(8vc91E%Qva3zV-Vn?}P5Yc^twrbn{ZorPePf1^&+i%^nT=@LI;xqp(o&{6C>c;kd
zew)+y_saM4-5AGwe|70wA549VnSH*eJlc15<-QT%?$=_=^J{8H|FO>wc|4YbV_DPv
z_2^!&cUQ$wJNL#$vo)>F+Y+K8lugifR_xzAAUis8d
z)AQ6gooo7iCXMGjAunPZ&!N5Q>dhBUblD=)^Zu?7NnUJX_1V}tBGczZ?bvIb8kfDE
z+i{N^UjI`B$cS;ut^JP(jPlf2_{J07@WjWB@HECpM=rRVa-^o>X>KFGBS&)ZLjti@
zrk@>7W>37%zac(;%Kz)K=HGMw(O@gc$BxAy>sntKVo?ici%y@B-yQ{A*sDxA8tWxa
z-`Hx+?#rdmaC|qOtGT(m+#`P|@~s^|`j@=8`8W8aCr)eM>%|?pM+34rPw0!!l=V-?
zpo3!rH|GNU8b06oymUBms599y?$K7`wl@z9{IPW^I30*VocwGr*I&QlXK`%trC)td
z54Q%stVd4pV2}I*agb22_2D#Lvc8V_V+jH;uL^M5y+^aQua69$!JBvaYR))INfy3W
z@y4#6To1%C)>eJ=5xt#&oIQD4^I;b6JTP4M%&sL#*X^6JCVcrC81J({90r@!KN9`=
z;)9OQMRZOEbjYfgxYWw{LkHAKes7M9T8OLlJu&Fqoqc`DpT8^O>xK)#qXFK1ZBbtM
zJ{#P!%(Xm@x#B=Clq+_fQT{In&fh%&AMT0qnas05%eM}`p5srwjdEL#_|Ov{F|eJH>`U4Eu9+TU5;lcVR2d<=fY
zw;kx0Z%l7CrsjiJF|umKUcE=y$5C^|H95Utj4_Wj)raQ-
zeP#H}V>}xqyoJ5ix^c3JXT8!h)c2)X9Muuym4JVHV(PngmbLs^v$4+Fu{EoY_
zwbh)aXO;Zf;6s-Ds&hHhd*XK8=f^B-aTv8}re|({;MQ522gX)_-n#-d#Ua1{S^VOl
z`ZvM>J8XMai0|<7ntxo_TXi0KzNeohoI&SUf5_F(Tg0cA%BTA3!{2uRPyCZ_KJsKw
z4_wJS3)tTPfWFTg1d5cxtcL)4V{pr#ABsc2sCrj=^pzr8{UcnK4
z9N!jHU;p$ODJJq_mXscJ4)hD2yZ_3pH-pE5tpGRrjNi(zE5AM~@wOJ2=Rs|X>tZ18
za{+#g#{)K=4aQjQk;e^xauGjH<;KoNAU4nMo*%U#Gsfgv>}<^gLq7V$;JfzacPzlA
z9GypcCxRRGHRd0+g)cE1eDNW-cLav`_S4zPz4n-z;r0AdUVQ%UyF75AKjl3S4AD&
z?h65~ULUAB4(}g;3)eJWhB&M}_sNSF-+lIx5j&r?
z@1Fj4@1DSYV551fzcrqmjm_n?`hk1=;qYpNp3F?f9$hm0RbD+>H+#1)uQM&y{ELf>
zxb!z4qdp$gsrqs-*lN!9yxaajjNxDW`fNME(}xaU&)kvgRWVnOF0ilmIJB0dVJ#MM
zyZ=ZaZgK7|QT?@CSASL9?(YQcQ+&wP%=X&@13&hl=Z;@F-WBl2zCOpFTw1G(S@*NX
zENh&Rr&~F8J-hHFrmx8RNlg0cc(57Nk9g_U{*~pL4fPhsEZ~Rz+R1W}8$JG~`+Zi^
z=R+Er(PCALd0=b>Y#V#$Y42z7YBsZ(aUqZ^Ju$p1MyxLf4+Zxu
zXZ?R7DBo=BB?G5)*fPVJK<(zip@6*j#Q&e~6Mt@fz~hwHesSKuPn@Tsb2^Y0>~XvI
zdnnXIf4+D*TZ2)~=#(qmsgY~CdPF~|h3|`4i*LW$sMBV^2Hxj^!Iv|*pD(h{*Oxf?
zn+HaHS??F8{0_P|r<~!OZ!cCac)?#Ao>RxNCr`eo{dRBmZTw}#VsE%$KPbABRg=adga&hqiBAg3Pe*>~>Ulgn;^o2v=n{>-!B
zNHERSb4$Et_G+hc_C0&&fpIR7v*G#7rugvW+Dw;C_COqdj)1q#zxe=7RmuKDYXUY-q2A+j4OhWw50z8Y`
z*$|uj_!e7vYrdVwc*UmH?G<_8O5WDu#3PR06sV)my>|rSRonG|Z|la;ns?8PH*v|^
z_Xdnvpl*)^{NP?b>RmbUvD^0qRWY(fR$W}%=SMv5t*Q;VX9GPUC!FF%KLI^)j&YB<
zmAfO68GEigX8T%PY|DYcPtByx_T)jH|MG4PYDWkE4+eB_z8x69Fgz#j&b9kEsLq+J
zHa#s`d-n8@
zx~(rkUp{!Urf(KI8~gQ*ysp
zUbnZz%?{`VeIO6}BUfw7Yq43sJuvvx7tWx8AFg)-HuT4;bC~VLXRdPaP_Eg+w>2Ad
zt;K`4%YisA1@gHV;QK;A&-I-Fc{3Z0OWuAaBB#wj58{&E`VwqU_4|FES?;lSz20SO
zH=w6)8z=w!_3r!f%&Q;$A^%letC=2ZJsV%2cjA;6{hl}W%ANaa>AtnPc=q8LtZ`$w
zPq#CE`E$)jXFBR_*dxcsJTSHbv78D{2XX+lW?xT>-{_wB*l-ssc$A;Ug6!+J`e;p}K2uEwNx?YDBEezO3ddPhF^W9MveEJc*Z
z)dco&nNJ2}*>?`*!nZ+g{9Mg;_vG$*Fy$N{M$cXO#5w)#fK1;*4`i*5Y~gBZPb}pX
z$2)--5Fx*ffZjU-0Hf&|`BmV3+?@KOcS5
z3VD9Sr`J9|h{)pKFFTVp?)h=w5D$ow3oX0aJtfqFJ3wZ^CMW62#KVw2y!f&1$Ej@<`W^FU#}KP{nxj4I@w}6fHy*8F9*9Rj$QuXp6ti>7rd(I$NRK^w
zcLi*y-Q_^M&1F1KYB~?-_H6OT&n)1px!^IO@nB}Y{hl3vu
z?`)Dk7RVE)xRj?DjP`~-@tz7!FW0Wc4D7IPSc}_e4Ccztv!*-R);l{veXsI^tBs&>
z%gb31>r}p9o2sGbC*ZAXbN%5%JQoAIK8LJ;p17$
zYc1f1%;-ly9AqDFH)`K!O7ZZ`F22h1V_CP3Vq~{p8<8LR$mQbQUtVzpjpICl40*7x
ze)#fpG2HTNOzX)HsND#BIX6aava_E}{>Iqws^@lxneNpD+-ENP>%pjZSFZUJlm2yf
z*r@JDW<3ksZ_Ui|YP@H&zGL}*eS@1B>S?K8=sp$D!QserV-df7zCkYSVLW&@$m8Ka
zKYnKL#etr>7~t|kpr-oE%#M0_-iwtFYup*uYvVU8^?v>zX?S4jd
z_Or`3yKfF~b+fkd#J0Rw@$k&^u=&cR&HcFj^ygvozI|-scI3eNW;r-^fNh+XU$ws(
z+jm4B2XveX?=d!Tt;gHneCThnzdY#sT;J-;@j0VbdQCrBS4O|`LD$!%o57s{+x&c9
za6F*bubugGW~05q{oL|1)Yu>F
zZw6wp#wRZ5@b!iHOwXQt+}B^?bI$Gw)Vwk9;T*W{%vm=-@rs+w$jh5^{gq$;=^sAN
zY>>lEZPGECgWn@AM$b?z;ptfL;^1Y0oYmo}K>YQuf52yJ`tmsusK0@ylK~xE+>9>1
zp0BRwh2DI=`p(Sr)#Y2B?~A@Vzc2dgH|kI8u9wyWqqQ8*oBnt@`1N1{;yn?yNr?uy4&i
zjv9;gM&KFU7&k(sSlF;H-&X`iV=E8zBfij`XXb>moA4&+Iu_Oo1Y{^rd8f4HZnM+KeHynK%F{+9RM!CKIF
zfxJOo-QNz}_q!Kx;O`jV{l&}u>e-{$b7!s2>VSK-v%V7O;f;X3cg47xZ3cYe+Wiy3
zJTS!VEb(D2p8B=6&#ymMZ_Tehx)AW`9v@Ey{k*!9wfd2JCeTBxVxkZ3p9toGAr8Fq
zZ_R#V62pyf!S6v_l&h)VDHn3t4e;sDXgW8oYnBT>+y}Y%94T(#UoWu1pBmgA$ic8C
z*U$a<(?7Um??&Xwuzw@+{Y7pOro9iveAG_#U6_pB|a~x3G^tvf}Wp(&v|g?(4A&f#=tHfP3AdUrr{5
zt-$Oa)Gu57zbz2M?~9Bv#v@MkxGneOB?dj|G7XPcQde|7;9Yhg|pcA03eYLxK3**PmON-RpCk9UPOR%ND-GCm!`(
z54HpT{_ya9arRFH>=ktNgSmCMEo=J5OIPT7PU6gHtNsaO5(9s1n2#-I`SWRZyfI~6qq1tDM
zjoPPIeH>c*y2>ox&aGYVs|EYBfIT_zMUG8zTlYL#+jGyFtQf4t#+Nl)W3T89`+V{3
zzH2$Urt6x2*Ui_OKWETd9D2x_UuSVut!v}$xqm2NcPDVZoOS;BAUAT?>vHBE`}EnF
z2S(+@(;CQOm8|=%F}~}MZuie;ZOj+{-#b&svmT$*;_kKh0T=RUkIN5Vu8#(;A3VG#
zyGmXj;#Qwkzyo_d8*f1I9PL?qj;OD?hW5q2
zYcdDb+B=bcYrwwsxnSCRwVzuzWnaGSz0P{abMZxK7<=k+U(jdb^=ePYXl}Sx>)N+I
z6Pyg>fhWC5PH%omdI(SY$nV~=z7WX&V&IHC6wqbUGtfQH1HDNGw{+N4PkZuW)AMCK
z8^4n4Y2DejXa2%ql>ZmGt~|SZl*fb4#G50hXT{uihq%Rw1HA4AYY|P|GdU|Vc|L1nzWD#@
z=d74|7TJWp55$5?*X+t^zt3l{$-Vbi56IE?qSc5`J>%=66TzcF>*1M!3)f3ZbDS;0qnBSUr`7~LNeVu6ZyWQ@LI5K^qy-dXJ*eH&slxw8bA9zAH>a<+USRKL4EX@NQVE;?CmbE#Y(5=
zvpVLrrHmdJ^Vdr_uy4JpAH>cEzXrLB0j}I*uepg!OpVd{OfU=NGOZt7vh%MZxXJsRJ#zJUu1^K01HER5qvzIpNl)O79pL9B!O4Jq`P7D57|sPbc6{Fp
z&-Vo8RkGgUY*$_lYTt8ymCk5i>{I(hd+M%^uL{^DQ``3K)wXLt*E22#bji}$<81HmzsV19RK9kyrY~1(`)srKUxfU#
znc0~KhThXJbkxTAP#ZephGWaQeD|6RUe#wkQIkx-&a`
z@+X#lkDi`uK5;2_eDZ%KsH_;=8}oF|4K~?lYnA=-^v%QHjjb=|`ygL(z$u>jHoLZO
ztsk5xcGd#VF#BhNJEI`37Y5}K&uTsk%AvUD!T-zNoxt09mG$DMIVnvoDq@=kufjQ*
znyJvHZJ5gr8A<^ulolvM5fkN(gJ?de(Z@Gq3f&d*|dtqr(|fJ6i%df%40{
za$iGa)46xxMblx=C?L-qTlMr!$|D)q1)6;97?1w*{Uj&8;}f@qfF3qFlgCB6yH~FD
zD}{Knt7>6=#&B`Ke(O7fO#>}9;&(8p@quB?kFCMBz!=!b-olYKpETB8?~3eL4s9*4
zsdU^Nhhvk;PxZwXjh$?1?Y}hiW1~=x#Na?62J*`;b9V{cH{{hBbr*;w8|{5ypj9lY
zU&`Z>{cRkUix1spKmFR?K+MT@uF;j_49E3DM?Y8h
zF0_4h|EfjuD<14A`C@e-5I^Tia|ZC#`$(--Y>S_-eVvKxj|Y7{kp7&^7wD?7UfUnY
z&DDYZaz&@Hn)u#eF5thI?F;y}XQ17O3jrB;D(>PWhT8)Ex&zErKgw7ejsL$iPcAu+
z4*WiJ<7~{8#wI
z7qP!S#;Ip^&IN6)vqg@|=It4?(cdv~Zqxx^oJz?v6lQ<^K-RZ9MH9u!X(uL3fcez;5lM*-O4PHiEG^&vs+`?K39F9b`<7?;woT
zz8ve(Ck!+mG=Hs^9qdMvZCx#)>D@n!*`n6Xvqh~K)7kdkGx#H3KM{YU~i4}_}EMKo}pjbck_EbKgH>EmWBcT~?#6W)1AFxvxp_{IBqj9gBgwmYew`qx^k9=!&^}t7?(YP_?6GK%MEW8I$eI^F!Qf
zZEwb6z<+-0@r&<0uNdOy~^Z7+>)=E?Cqs~F*N
zFX^qFFwl6=@@c*7VL!TTk}I@4?H|VCx^Eb>S&s0OUB+eC-C|dN7s@Mnqd*fk`DyFQ
zJRWw)?LyGkgLP}C24cVtwzc^e_ZuRd9QN~>EP1e(|K##xXRtXC3pR<_!C{O~vqwzS
z37&r3`#`^cGf7krYvaR5cB^xCki&QTDh}dPzRSg3f{#U(y>#QfJfNfI06ueTp$>XvSu^Uf&Z^@rVcB@+sTixe{CXX(5(!mZn
zW=H8|$BDzdHDHVSBX1OFY{6Hyv~jKa5GU{9VrXyq=+3GfU!TC-FZ6uCK6c2-$pg(c
zdP)u+a`?)&#Xv3fa@zdJwO0DCSt7^!4Bh|gMr`R~ulR{=>2~K?w?|g_*%*!)-
zyu*mud_cBXkl}fu8OsG;-#gK>G2kD+ybsV(zLCowbDp!#zdW+DWU!A6dg;{m2KIYrtCf9D_!g4nUFqdu6ljkOeC}i$yY4WI#mZQGYffy$v3wP~%2ny&JFu@%
zaiQZAv6YSc19iZ^_TTYkTbl!Z<5e$gB2(Rn6FxGkzSxg{6ll&N`?QMNXiVLFHjx>-${(xnEAIe=;n)mZ^9b8(d0g47}KX#
z#ieXTuL-QN)fn~!YHmlsuCcw*b0A}T)wy0Q$iqv<;!^Feff@Y0kcqg>NpIKHDpoVt3g!DL=dzmcd}f5&*ySE4Lt}%6
zZ!X{`|0eN$CDSUC@;2JS>PD32R6
zS^LnNI(l+*Q%5j*7l8wAw6suA`rt?oqK1Jea_(C@bvNg-NA>t!|b=u-D;m2J#^EO?79P~Z(J
z=^vKt76)s03amMY-}0&>yTKOVY`{qJ`4TSN2bjKG;#2wMJ^cl?)xrt@w=>A2f4cbCky{=E5*mi)ng
z&w-y0-}9*>ZQL@@>~MiRG2QureQK%n{8WC?D&N#x<(94ZP8xdW30?P+I}`0Qv)<=n
z{ru3cANo5F{h32ArugnY^!FS32Mm4jKX{-YlAiDGW;$OT-`^M9kUwDGmp?dp*+-6i
z7VM5MY``ti@`fn4=2kxxm*SGxk;pO{$fY)5X8Fo+E$Huupdv9#|
zRPedL9y01oY#ZnYrWb$fug^cSSu&0bt*!p6oA2Qt$U0xxOcq{!q0Zk0!`wyb$##z3
zkuMtXRsQZYtf`mNhPCsDIl50B=Hy-7_;>W=7|)u(88+|VI3ly=w>I}s%?`Ye9C~*l`Z2+t;NF2|j()wk>8pmZ=8QG&=
z%-6q1KA*At9|%qg_662Y&!lnHw|jJlek{5aX?Z+#73^w_HKv
zcOyFP5Xd*%)!5!Zj;-r9appm^01I5r@{MuqbE}yi#RvrGHb!}*MAs(&lkmLFxpMO6a(8p(WwP)z9y(AD9
zYwWfrF8ZR`_QYU5;5VDdu3VCBo;l-cOYc0@_*i9%`|*PueccP>qK{Rs9EdwPdUEBc=wp>DA8Q7XDZX_k#N%L~
z9_ZB62|peeq@2h9PLbFh2=E!V^}Hjr8q>}TzdB$mIrJ_B@-S&`bLQ!4<&kx`ely+}
z;G?hY*5-WS~E(8|`?3Dv|zqq>l&dS}lE4@9VK=VAqSN6EG
zoaIrVv0*O2Q}*=n-;*_{xEZraT-ie&`M?jgGZ*j!*vMXU_L?KBc&(X}x8gO2*PNQI
zv3T3ZM|x^r?UEsPPYNn7JrDlkv8VRexoy|mIkM5tARdr&vDYe&#^j3y+bd>OYw~k;
z@+5xsXBHbXPI`|xb5#rcq;q?q)xY5&2JS<#C-a=hq|cJJix$vsU#GavXCxIS|zR!DgJ{nCAq8H1T44`-~*_ZWH9PQ4>>p$X^vqIxBr`
z_Gd#}T06DN5BY?=FIjy
z<;R+=(M7(7xAgG0^vse`XQj=Txba1E7T9!;#-`#ukon4I-3{J1>&)%QI@`qZ*~4>~
zZ1$MLw>Z%2)6;X$=uy*kZ-~1bI=A=A8hvwtc2z)L-52K$>lKg6RoSyCyv`+A_YSYS
zO3gh!8!k>?az>3DJ{I4%hL5c02A*l|ZVmm|pkn!)jGrEy8mOlYfp$&sn7}^s>R7Y?
z?m@eMcj!|BeC*Q5JtI&zeApd3-4~PY)%#?vofk*G$A!aZvvT&mhR
z%seU35~lH39kxCm>}#=%!AId@%7!Gfjq6FpU}}4ck~M;{29r^G8Yxg`s_UM
zO
z9=t#JLa;i9-6^3g&{l1hv-NR{O<3
z{i5}-Ggt`D3Y>L0(`t{r;Io$vZLR-S&NG|brOu1HxVLdz=E!%xN>|TAW~;k=qnCbr
z)kG`9S}#Xj*wFIzJp5~QwK3`ad)5U1TG?VoA6weEJbA*t-j0gPBtQCiRP0+B@>4lm
zow3&XQn738+CRZA{@B;@-E|6I<*)p%o{Y+w7^(;Ns8)4Ud)+y$A9YX2iTgy!JEwA~
z$va=zNKe&nYwwx~_S#cA%TBt>wz)wTdy9|!S+-^Q2;10Xf4gT=URodU+sBqZHuSfC
z{b8ORWUu6Wx%SGB)*kUCbJE$Yvv5MzwbssxbsHZxmySt!l(SiS=+h?Yp|5058~1*Z
zw-SBgtsbg&N>5uOlVqz&K54gvj5;IqiUB{{S~yz2ow4%8-rk4G2Yvlo<=&aoX8G6d
z-5=gIF6iDLwj8Z5b(gVAYtP1}&~xM2B|EDoYkq6iwgtoEa;&>P`?R*Vcg^bXxBKkn
zhiCTo0G&T_J$(MwhCVG2Q>~u&-Z@%${-@RG%{{7guLa69as!0(`Yc4YAFARXp;B$Na&--7fZ8$!&c+ka;|8
z=<`!Pe|OeeoZQjvn(>Y)>yI1e>8i7-Zq>B=O{|?Uez{-Si}tR=W_J&|h4)jw^N}AX
z1mu(TUzIohY8BtBm&n68sl2hDZTy>-H}C3vX=5N3;sm>gzV#KaHTs9?xRHCf{>u>~`0%VNiK^
zt>)}&eX+mf)bmyhM}ekh$S1FrFMhorY;zaT!G5yosywJMYvN{J4C!1L#%&E+8wK>U
zy=o3Ej_T28HfyVb1A+VT{JF|R#{9XV=K^uoSM13o
zUu*ZE+dXXU_mIP{OM}Y;`pBQeTlSYO_lNx;Mr>Al`%-%q2lW1qKChv(JidFy3D_bR
zYR)|?r#}C!4>kweg0e%LD~`sG3)oh=(Q;Mvw>9H$Z^ro6bo7ZGEhZ%g{|OD9;Y1(e
z=J@Bg)JE?^Yj^8UYgcP;?+d#3wYAB5Z*%Wc>vP!0KG*|zogrt$-Lf`l?QHEoR+}So
zqRz_ysabFJwECBe$26Pjtj$F>sJF$yy)X(ib8@yZ5Myy__o=nLf%xnR?5$_1y4`RK
zf_^%j4f^U%mJ?^fdBr1V>QfDIy#eVS(ppUHIQHU+B!&HRplOmm;l
zdtAD)zTy!N=bx>5dlrWAD80tMx$)@cJNPSszjDhzs9gH)2;}tc!6Sn23Z5IhB>02i
z#^B$A+l23%f-{11g9ikc1-^%RQSdWC{yUt@^D>qnu`-rJ`Q0C=zkNYHtK?9e^gYx;
z)rDG+V>!fUjjV-0-YeIh0rDmv&iO5A7oBRA&eqmmzdC63uQUc#$K)IPjU=xh9h
z%<)l;idEHI#YPV7+aBPX^nKGP^YX=Jxxyz$mHB?`iBUyXj|_Jn(}JWQir6Y-n@b=i#KRj{>!CFFE$I
z+g>v0t9T&=5HH|mF^>>-B
z4)s8;nBXIm-QtQayN#jEZ_#qZUUbzW8Fa4XT#v#>&#~G_uiETusO(#lwX%=>lkByB
zmc4y0$Z74Jm5Wh$J?~q7WB0q(zV9CwdTZbv+Pcp$bo0%hbvQ%v=lNgfQvT#}F~E0y
zi1X8L3|0qgf|5zTwmmTRZ`zVCCg!xi819-@pZJwN{B(MMI4zLllF#N#0_)yK)t6c*
zAIm;6$n(6uD8O&+^ng6;PYvqbX)fc6Uxwq~`(@88Tlfcc&*1IjD4v^xkX84=&SBpDRW{T+diyTc+CdlH
z^2_dKl$!HeV;>d
z5Ua8Yk9e)==FCIg{bIxxd~9JqJJ>G}#J%EWjqFKw)6Guyu+tuLX6-3o
zD&}E7{F#zG_EhZnbwbek#WwcSOBTIVW9Fgv$z1D?{7&+x_~f{3V5hviq?#h9^Vn^n3X9(}4
z{IH)MHL{$Z@_`)wwsfC&Jgr=@Vy9SDylX$2A4QKc#%q7Y{%H4$QM^^_&UoNI(!0m!Ie>EqE<&(KOGjy_TO(5p2Z|oC~RyRA<(8a;(;6QLuV87?=ee=NB
zm7cy)pgl4;E}*w;Aa@k-^;lz5zR_LhrRI(%2I_?kx9)>XA8~KB^*qX&oU*UZMJt2sNpVdY4##zC#@hlp0DI0176P`{
z^J8yu~)l`!8Zh_1=cDiVhr2|GWm`dHU?^q
z?B({b_h|R5JBB^CpRq?cRB9}^LGFK(BxPb4>_=YUa&flgO;acn{WBqVU8W_F~+Nry**&l8*=aPy|qbhTbr&L
z)*p~wdv1W|&WN<<1ZtJexuNF+nd<}1TFt3_t(`kQv^&Ip?+Kne>|=lVVZR#UkNQTJ
zPiQuX0UomWK$d4Qnmn{x(=HBt=Im{D&a_GPl}x(IK6c16-SSzwTDf9AEzb0`KH}vU
z`L$O0x_6f^@x`Ym$SA%$PvL9ps6EU4+Be9clMP~DzLh;~?c8>P4s!66?5gjIB^&!V
zRE?MZ(u=qB8jJ5V-Zo~_c$f2wuCkx5ItP`5vTK&ES-keOKD4>uyY-4we{Ym+RcEbj
za#TJapD`b*9$LB11&jjCIT{(Hk=y5`a#w!a%l^_)wzl&Jvc4sl3$_N^g5w6b57>?F
zWv*}8IrHxFTM7|1jwkf!jYo^_dT5whc3`d!wgN8h5Ji5F$QkD>Z2dt3c{JTKrU+l}p2!~289fd6}guM5r!
z`0x2GR^AEL1kRCpHC1P+>~VId=@%zt*l*v$vEO@8^09tGlMkNwl^B}42=U&W(r
zWjo*Hqt!nxmMf9PzGIOkrmda5jcjk_PKr_OXG3f2D6|;1@mg-bJ#1+AI4|rFAM(hc
zr)t&Mp2`)v%{TgX!J43KHCJZ=FMaAtPFG^1vt2fB&3N0e*M4z0Ggt_mO?L$QHV3N%
zjShTOYs)>?k7ZA9ml)QaYFzOWQ!&;%ufEsZp5A%Nuk||oIhqe@w{oF&_)+Jw-S>MF
z_K7)vEAAPNV>p+-w^hvO5l?%Z6*T+mJJY%Y<$;U?fib&{Yke`}x+6DaEH5Rm;=Utu
zas&Qu@{h)T-(!9x@Lt09HGzF4%X_N2awmvO>8tk?cN-pgZr@MJPV%(tg4Ta?e6_EA
zCetGan$P%j9}M`+Zta?&YOr5>Zq~#GZ@X6Zm|uw<>=qA=9qQ(ypysa0m<{|lUw%F(
z;iY;BpQ|Ela&6L${C78mvc{ig;CfmXcU&owqW_iRz~TJgxcRyKRYxu;f_^L+L4!hh>#~QcO2DxoL
ziCfuQ_S`9RnwYr*4hD3KvsQc?m&n6$n-4vW*Sn-v^><3fEpPdIv~h8^+^J&L#-*(x
zvdO(PxIEyC{IxtGC!RNQtER={maKEJ)&45?%ZcfW_V0JF7tQt`?$-TVQ7ylpn`r5O
z%=^!-?0aB}O8vN#$T4@pFn3wTbhz`~Gn1aH?Hyh9xftF@2hR$~dr%fe>2C_I2vW
z`rl()EC260`pq5vn$Uc74^$jpHt_IIe7r*xkKS`x?=z_0J*#&n^`{TL=K58`t|ptZaYJqq539R=^hkAnA-
zqu_nSQSd%;25%cao!LHSx6T~iy@5MW?9`MRa`rXz*6p{xGpL&Tp45YNd#qbi
z%5*+DI_1=Qt5?0rmHR`(d+7>&Vb@xl(%3{Vn@$Yar1_m7txe=VX0XLw)Z3y)$#E}y
zOZa+wog+MbOdlKGX)z7^;WPKG;rnu&IXc=H@WELv`+bkMIyCiMF$(cl)EL{kMPrX%W|$3+#&MzZ4-2R9=KcSKN#5OK9R>ZPEQOiW($E>
zeftDi8#B)b_0z`cKfs6TrGNJI
zaiF`ehbLyA_pC|vaAM}G9@wH)9X)AE?C^cL&-9Zg=P;@)eV*0otdHM!CVt}F*3NurvhDTE-xSpQmv=hz;I3gCo$l%HimdVj
z{oNh?JsthM4ITC)?kT?WgZ$p+@5{bP&)mv+wj3d=z4P#>gQ~5IGUf++pE5zNn$${P
z)t-6zGSAM
z(<_4)1g{8wKlsbQ-;4UeAj9$bQ12C+%3B*7XQ+78L%*i>#f>~aKP#5brWiO|_BxYw
zUd=f-p3VCMwAykO_YS>th=*?ScLmQ#yv>u<)`oc0`D%SCee9tJ&%U6)AJ|uS06*ma
zlKA2Npqri6`BQeGopp5C&c^Q_Y@GC*p(o4ZIF)T|VjG*-MyD9iS$7wkv`^8)Jz*Zia6i+S?I2gtp0kjuATZrL(R?kR&@c9AJ2_K|(nmni#}
z^Jg$@F4=5X3zcv2d1#=P+)K}jK6mTfKwlj?|Bd};&ozTR;@tbH{^;VX+A$VOK8a<;
zPCV80$rEg&{yAt{AZRP&p3gxyr5UaC-
z$}{_ZC~_vnT^=j$y$rUrGJbdkGOC{K+aK_I(*0FFR?oJF237w*5?yWm|7d7AVpI81
zdEnpkvVObta^A;ZJgkZTG#~A0<^9+SeB~cM`NvPP`P1K5@5`S7u;H3OD<7Xf_-Ku7
z)}6;%f5EU`cffU_`A28fHoxjF7ay_s@$i{vOCJlhE`F0@!G5*i9d$02umeBe>^UWH
zH@$GM%R2}9MFZ_SG4xLibn*Z9fhI!}pE@UP%wHV7viHjHYzQ(nwpA^#xoCX1TYalr
zjnb2MaiEs*R84Kp*j*^5rBjWa5or7sduz2vY|U5gS~IpT&uxvqWbkV)^ZfqF(DGsr
z8S-Hal_z%l9oHJ3g}@p+
zk%6YC&BMzgug+M#6Vorg^0qbD7Kk-0eNVmg9(r=4#!ogo&kW>pbzp9qAN&!I
zmmj75^2;x=nD$wu{G1C9R4(NGr=t(u=Bwo_`MDW9Y7o!Q
z&){)B<%LXllh)?t7qZtq(%%X6XX%KuI~N+%)F}bozc@oTfAPF-29MYt2-v4))c4YJ
z&>cu^;(Xstj_Zt7q=M@=0Ir#42DS>)PgVzUd3f>aDHF#U__TZhtyMy-y9|%4ad^q@M@bTc2!HvOZg3kvx
z1z!vVV|B15xJ_`|;N)Ok@QuNIurb&Y>$!zqzB|($W8;qkp}lf1{({+R?w+(ZAKv|Ffgt*3rM+(KmGT?{xIr
zJNg|R{kt9gdma7Gj(%51|9(gRK}Wy4quc}M?6M}N4Z|FWY$($Rm_(I4&Tk9G84cl6(M^v65;6CM4x9sPG5
z{mG90R7ZchqyJY&-`LTA-_ifj(f`=dpXun&cJ${u`hR!y=R5kJI{KeG`d>QwrjGvC
zj{ZVN|650Yv7`UJqyM9$4|TK`xc2@#uA^6V^jt@;?&#w?`qmwNLPxLZ=o35ot2+9m
zj=oJte|1NHO-FxiN8h%izpkTi*U?|!(I|1#bx6
z7W_%@>ELsLe-!nr^3r!o@J+!zf=hyL556n7GWgNpCxcf8zZASBxFL9V@WJ4t!A-$!
zSLbt6urat(aM$2I!2^Ql1wS3UKKPB`eZeP!F9ctk52qW0y9Eyn4g^mLel&PR@aEv%
z!N-Ds4tCsn>AhiH@;K}B*6o*B|AuAO|JyR_-?+^BH!ZV%hh^69xXk+eGV2S=tgl~Y
zeZw;A8<$z%w9NYEW!6tyW_`;t>syyu-?q&9_GQ+0EVF+4GV6C*X8q2~te>&W`kBkD
z?_6g6tYy~EUS|EAW!85svwoLl*6+H^`rVdUzxy)l_gH5Ap3AJ?Ynkc}$JJzn!#yfA&xMzSCa(tzYz=7k;|i
zIGh$bkEb#3zV!Uy55CqPGJW>FZ)9AQo?Ynk2bt}6BzzPH>-QV@>pPMA4|K_Uz(BK=
zZu=@e-<&n^vA4Ck;)CD5Hvaq;|C0Z}L4MhLL1_D?+54b@zwCYRK$pA=2bx~G$P(L!
zWPVaERu6oAE-niHtX#A{iODp3FCOeEdmlQ`W$(iVntpPCy${d)ZPWL0WiMHMTx)Op
zXUmsNkwJIKP($LRr}q)rGt2MdXV-=K+_5SB!m#&|E8Hvp6^}<{j~umrZVp}XdGw6+
zHfOEOOK0p+^N*Ra-pXW`c&-V`rgq)WJe2R>5}7NBn;1X#D0shhg}h~}xVE@;zmRd{12=-_use_w*@zeZD+n`3Q1#YA_#c4R!`v<>(omOfl5jJb!=3
zQ+a54eqaSW&s+h|l`G)6Y66eC+8;Pm`vU%{1GE^R%jahe`#n2127106jf|^j$f){r
z2CfMoz3p?`UC`H{Ggi;~XJ-$)+dZ2@*R%dPGuHV~`dgXLow3KW{@NMq(`5eOj6G!j
z(2VtIGJkl+9x{Jq#`-jwKRRO%na`WCK27G2&DcZc^JlD2llg)fd&s>=~TGuEfce94SGWd7ug^=UGHYQ`QiUpixbn#`BY
z*hA*aXRJ??`O`D@ka_)#^=UGHX2u>eUom67mFfB983OJ(pWm`|{CC#9E6oS)Wio#@
z3m2uYpLKiXK-bT@y=tIO8Tem4&_2W3|C)hz2cus*&~?}T+(6ge`tt+LUe5$~_%CG6
zGo-zb-Qm;TH-0hv{d=Tm@3w$k5CihTcLUz3*9Uk!qwgNvC%9j5VZip+MXqeVO&&SZ4jLGuC6?5uZbUGraY8fa<$LHLP~}*r>5fgUf?0LH?-f
zKk<0CI6qL!?fZtB)fR&jgYAg4Pv-A!ETmVv_Bzk%-Ixsr0=nh`jZAjz4V)2t^8tO%
zvU%(6XVKq^kNtO78^WWxWAL(vKX2*&9uZsQ^nXT1|9z60;0xWYzPE*U+GqQG<(BJkKH|dIwf%a*#W;D`Fxyq-fx((&Q>w3*s-6?-^rd?@0M?$vEItu64>a5DfB!)92mOJ8u6X>(Kvz6IIM5XjXG(pjO?mm#tjiUD
z+!fBmMS=C=`A~T1Z);NS=pc*lYPj~)86}I3Kg)jhw)@>f?%~?YK4|k!jx(i^^XG%D
zFAt--a7NXNX8kXgS^w~q^|FEeY^d|j<{Fd#mlOOD2R5it?W*9RLD}8<)7J4vBFo)J
zpFI9mM}M@TvwZkmvqx?5zw9OhN;e*Kt6Qv{zXL(t@AQ5wdS=}>e?4QJjy-`IXyf!Z
z*|XAoAB)W&pJ5Z9J~3l`n$3SZ!{&%QB9?6)|1SI5JbtpHKh@ABN4>zBpx%Yq{pp4m
z{l7Z;#*Y5`hTai=zG?T#KjOE2X?Ux@$usZ7jEjCxX!%0pe_3exFZznmY%2Qxq2;pZ
zU7=ffUl+QS_aFKDeC_%Vcl5nNdw!O@Pv-Bzwfrya=rcl-&nETjIqlt9?DW?3Y}6ML
znz0VD|EBw0SMSg7x@vXq?dUT)`ljx8SA8h-B%8>jpKkryp?5aq$Nj?Y8}o~io);O$
zrv!X!WB6->KI>vdR^P81=F4yE(_+)wb8h%f3N&|==Z@#yKZNO`^qXAtX?332wKu50
z>%ApoerQL_b6)mr3+OlA8jJ$1E6O3`T)w+|nbHY3-btZVAMh4SNFi
zKRqCKO+cU8K09zv^T9sxwGU6fk1YG_(X-PY^?*Jrs5$%HC;xczl7IXi1==G6b#Po@
z-u^zW;o~#r*LMW19CQ3Jw=Y2N4HkpTf>EILv@>Du%%Jw$M~yr_wjMKm`0jIF@QOX(HG7QPJ@U?P{FBz#WS$*+hIM|G?oq~C)m-UA+lP;S@jh6k;o>iZ0uNrj+vzh#=(Pw0=M#Y1V*6>$+
z#fqK#1GPHoo;DA4A9`;P3;x{F^-AVt!6?vrS}xhb{;K7<33KeLGuhU$I9L;hR)!iT
z5BfEG$dXgK#cvd7WVkEW2kKNl@Qbyvx=~l{oO&^*(KRwi!w=T*$cvu*mDJ;NmZ`^j
zH=vVUe68Acel_!KrPsQ+yeIf_*67bfe%+(|cUL%flj`{g2VOSf
z?oWANDKC3Y463j5qW%s9VyX5H2A2h+K*KNB)vt8l|E;s2Hjd^j@C()kYFqB=e0cvb
zr}bw+En1^bj#qL9p4y#(mF#(JwG6#M&GSpUCa5^@e=(4={}!wd#PHI<+@_%JOMLR>&csKy
zJm`JzdR$I9dG>uckTZMKaLJbQRyKPzKFSMu`1uR;(Z3;}XMcciUtrxn`s_nbvJp?&
zO8;^^?iZ;0$Q{iudfBr&;QvE|?ExRu79Dgs^LR&rR&{6IcxPZg+F4)8K79Q?K9k|h
zJaHJiSJ=Q#ayJI-T^CHU6VE8nj>b;09@&)E?mHGc#j3S)TC6vOj}QE<*olc8*t0qJ
zS;a#y7VY}&hIKNm^ZiM~7;nYXe8tnE8tqyxj=FW^;9pxW8s`lEmEDjq3dYonP>E+MzVLAEY
z+REP=dfT8U-8dJk($~B(8!ia04K%hL2rdfPdrt8A1a#7K2%p&P4Hg15RBQ+qpx~w~%Za%S<|7@(UHbxjZH&d0JpS?v4Z8zP46L*JF@g6ucPsndH}a_Uy2ONS
z{XE@mti-2cq^FB)IagQn0ouHEHu6DyS7Kw>#&^ln)62IwsO@J4Db?|xN7r~~=EVH?
zU`x=}=W(Hd{o=#FiaR?iHukaC9sJKz?i{shKOe6Q$n{*SF`DdApot-Vdg^|qV?&_P
z$tQC0TpF;^JXx0n>c}2CO9nsJ2Vz3LUT(>HL{R(dOsNreRh_XJ>}BJX0e$wfWBV}v
z^C8Zo(3-kv?dW}(8*?4`?+ltFdv8$jXYU2UuHau1>-voIxzJYx^&BaGGd1>iG5x&}
zY2rdg(fnhdbGatq1Kqzo_+ZVRn)mN6vV%?Z*=Jo}cYw8;7ndCYU&#Ne?APO|IxO8q
zTaza`wac=H4sn<3&joyEJ07wh5}xwgy!~3q9*wD`9Fw&!kVCrUhMngH{M{JHk$TbS
z#ruTdNdf<_4mA6`hvDtdGTX@U@2Sw!%b`ntOSibNyJ&Zi^GQapqxMd--QNBlCAZE>
z`Tdy8iN}^e9XmVxqZ5C{w9d{WGKW{pt(_k9=R|HMo%u|Uj1)IfJO`_X*F!Nq}p
zU+h47_oMu-WRHJSw)W6%Ot+Y|b;rMoJHNyOA6qM~7e-dqp7r&CrdIK?zx+~9_Nmd6
zvrir2)1I@`jq8~`RlBC`t2$}t*>^!u^-T{O%4W61)}pP^FGhYQ%(~o&Z^-}jXGZtU
zy!^0-oIZbN4eN8mI{jkE-VMP+197viM#=}WN~b(83^co*9@s|~ntk@RHBo!TuHB2*
zzBL{Hay8`Ln2+_0rFXeKzdm748%yKzca*WVC6N2A!L~r{X?p^3f_jF#Zw?0b7~`$n
z;uB~4!~k8o%sZcA2I6~%fQ$`6#ix2ao*CAhr}?1nMEZUpkPkWa?sQWQA>SSyd~ZN^
zjoI*o1W!K~*uzHjy3FrN|F79E|Lq>Uc%C2dSM1vu$p<}83gjMLve{TQ<9^Waf^%_g
z;2Fce#lUmO8Lc?AJzLRiSQBVfYv#monq802TIKF88MCp^SKXiVRIT7^YlVL6@Wv(yy_v>@0qfe62qB(KKCb24~ZrN#|vhc@59VAg%R9j3?#Gxz(Pt)Q$BV%y>({KaE{tV!t!Q
z*Gq%T1J5;egtzYbof&Tm_({&HK)WDNH^nDUCD(k}yCY-r?EkaeIriJ*XBg-vTW%^B
zc!4cGvm5UX$lnu?jkXspM!gT>Yae^vU37~xU)*EjbV^{qc<9L=1=?u*|0RFU&v(^a)(F!Y9Cu_OoyCReX-@q
zsi}11SZq&k?t_`b%kP%=g_&1(7X;4?LLOSldj(nE1@yI7E!)e-HV^nt4EkKy+s2Tc
zWQn7CZtG*uFxT6rUd*vwy!iK|pnc~l{r!8NePUUD^y_tw@!?q$kX^dyn6_6=*m7>*
z9BT4SM)_Rl=Yq`P*Ymw_b;jDy4vaubk1<#%t1fYJFXfmp%N$cX{9*dTnqZ
z;IsUe3^bc-{)rivU3fkhly3X1sTDOrPkqne96T!EE?I4^@u`W&4D)#GC(C%!cL4s~
zKK9nqf_0)1QSlk}6<>gx5+4f4f~FY>WF(CAf1{2-@|ciCmG*8BW9FKzzl
zt{C!{e5n2Egg=iN`jzC=-y3gpD$ZL1xp5}QQ%~}O59nO3UcZv+RNb`o!M8R?b%x{!
zU&XI{ZTI#$^0}zZQJrxzD@S4|H*Nk`lABL=xrvBzZq$@Ue&yy{GcJ3NH8=e4{rhs?
zA#<^ty=uyxp_av_&rh3|Iy+y9dErC(qpxS6v*aC7Ef_mv?m72YjkjjJE#N=&cjlhV
zkqMqvPYTo&lpZoS40DU=)k?o6ZWUj;+0*N$i+;V@H9kLJ*WQ8F*V_FuCd>WN%fd$|
zS$Z@diYD7LV|`Hf|6Im+-GSn^CLkMcJJ;(Xv+S<-TQTYFwl>Y)Rz^J&R)_y!vxmHv
zuXM>puWOo&1C6|P-223zy7${>*ROHUZ?ohq=
z5xrX95vVD9@A%n6hkhvdo8V2KyZP@bmu+ie8~yhB>}sBCe>eQQi{{rg^KZ|5*+ggY
zzajH{!0!yz{L3@n&WYy_X0CMlJYT#Q4ZJmncSFN_hlckb^27cWw~C3HqpM_>o#voo
zL_T_9=r<0%yTJUmKn&^U(;t8S(4lkEe<3ffm9xu3*SO99<6{>YWs~|S|L!%|%r5!F
zV@s+x54{+p
z`#kc|ynO0+4E>#k{*0mDIrL`_{jQ;R&h5MV(BE_D&mH>F(BEh1_YVF3p}+6Y-*4z2
zF!T=``UegDg+uSN0NHY&vH$eI87CVpUz&V@=Y+Udjr`Mamt|@^KQc&jU(5w!xe(Y(
zW}CZFXpNrL!Pa0~Kqug*i%$DJPvyuOxt9iN(b~fTH;KE%dq_QljJ1+cXGl$u@tDB5
zV1s%sTQVH$SCh4uemwM-9Ql0
z_MSJ)+o#dRXHC4sqUPkW*Pr7vQ~##yA+K^_4Dvuf9qWV22l*O%`FTmOA#k^w^NisS
zyY;n~oHn)(4=pD0QhVvVEEolvc+o+Qny1GZJwFils<}sGEC$C1VymWoZldq00X<@4
zoj&J#b-*_A*o{|Ri~l;3g2jN1?B5+|^0Ym$?_
zctGal!~8-(pST#?YwSKDPh%UuHG0`4e_EX%Ib)kVy))3-ajnx)wwFD>6MIS?{i8sm
zmkna#&y1fH>EGV-i_HJANm3HsQev9r!No9bu2)t0!)
zS=q;i<7U_(7VMr2Gkyz0fy
zcpt#Su30B-17n4
zf78x-JHIx32ZBj5C&k{`E1lNGfM5JzckMxwDQ^ddF`FmF-JHEEi8~%T-3QK&vm}Pt^7N7w3^V!`{>`|k}a&GVbKwS0(RZk`F+{~#@t?V9+
zshex5=$)D07?4XR{dAF~S65YcyEE4Kg`W)@g1*M=C5N5mXJ5CT9nOk-Qf%-$!}wP+
zcUJgL3*@5C8+iwU#XwBRJtI&L;DfXucRm%YP0UU3oA;{tiu9IzP=-m3$RP3HAv
zvd#W=fmSwGJ%3Z?)(3d_cp#{=LhdNgYOea7nJfSJTlvO|EAH^x`)Pv_}SN
zw&I4DTs~Dz(#v=BD9|bv>Z58xF2zDuux5NH^uD4B$*+_S53)`wb
z#X}>j-sjXMU&Z69K&|j!yEx#F?|0=$9Oniaf7LAe?AsPtmm9y6ujK9x%?`Tk+c(hW
z*=>F?VArwSbH20LA8ZK3l`iqo7rilK{;O3!$)k7`pKuUNvs}
zOdt07yo~83d+9xSZfp;mfQ&k4;%x3H)QP%rudSYPuhGkgQJ~fLo9tr0
zd#~)rtI_fL@#x6s)N6*hJ?Sf#`lVVpdHftYIrJ?B=YdW9{P95Tw{cO=Y+W08CRk&S
zIeD>P{_S@@#7Z5g)k(c`voR1~^=_|z6ll&-JrC+Esm03g^P2oxUmuh%=T5B83)rTP
z*x+4Je)wq*)E+giogKJO=hL%|k9?)Oa?#RtAKy9a?r!qvr_VX(msoyHWTrd3RyLMD
zeuuX`Xl;9FvOp~8;bX-FFTc=rK6huV*`qG>@=$yE($=RlET4EP7L)omS1J7?a&50O
zar}%kL4To@W$)HtTOcP;eB#5F@=PSO=*|XzQ)&
zQ677_#qUghD$pkFwU6$S)zUS8Rn{*Kej(6m{%YeG$je
zbG^~cHZkX`b4b=JvbpNk{_VkW!8MI8x#b(aTEDzmui9J8I+^WzTG?gZd*!P1^tZb1
z7g_F%ox@rmZ!x%IAXjq%nRwdRoH4;3d}7RR`6*lUp0T4q^Zb;b`9RLClU@6(=O3V9
z6lkOI|Bw9h9QOhrYfX-7yd~px0h@LP;?etTFVHi|7X0Itb;v>MqOYzxFpT{#c*i#J_*wzuy)J3`yLMxUI?C)tx?
zpsqmeoE~fp)(7O$WltL)y6COBe&6n_Y1S*YdV9#LXL#||{af@XJR1M`S^lre__(0%
z9Pd2-jEmgS0DjbXTF*D}AYVK+GU;MxouRsyuF0H+7wofEdG&7N+-Q3PGRPCBO9omV
z(C&kZ+s=$P1dj;FR4;Y!KQ&`_n>)=sANgj_X@R=bt_xBsEBdoQGVV12kiPft?q*PjBA~2H8@L#dYdML
zUUJpw#(-Ql)cK@$Rp9)HueK04^Y%P35R+#F*7-(;^+M?;pFBKj&^~MUonQ0&f{HPE
z??B5VdDXL9%$+;)ZEp>&-x<)sr|p4Qy)t>VE_RE7{r3*ordI=_K*PtLQJ{I=$t`)}
zwmGn0RLk;MmV*IdTHuU*5q{L%A|UzIQW<=31VsA8gxL;1p{i1Ge;B4BappAprfH?TfXv}}{D|yz)BckTiH=oqH9M?YaqMr`Um~9$4
zXpIgrD|yzONpdQ_*2z0BAP;T4I$+=a0PntlJ!CBg;>xy#K-}bLcVPdyfjnw#F{aa)
ze`5Ak6Jo}PsvZ1L_ObooFjwEth-Hf%9c_)>EzhL!eFq-4$)le~dEzkk??IVg9~>Cw
ztUoE^gu{mu|P<1Ac
zMPHe5#aNEr2~`tx;3L1}$ipaL6Zz_~*Tr|wrp?1zy2IZY)?A<8HkbZ@^C
zjBg#Vq2}onGy2H2wl^sI?A;!a|0~VsLg%&YoweusDSHlPfB9IkrvobXez!>rXQb$T
z&A8@1Hes&T^kgp=%eCQ~3tz=joWxT7)2SZCNA8T()%rlb)uLFsgW$42etm{tmwscg
zIm2b1+BX0QUZ{s7^;v;@-Y{WvH
z*)u5?)<%Ig8vp<1II^j&he@%auZ;`)#6?cT#koUQojfFCapGeypWXJCUwmX=(bn4Y
zVZDVqxl^E4#rotxGcRXy2$j!@WA!_;CXThvFY@ixYvhV!D~qr8=zAH{WZ93uWEWj>
zs-Je=#X%g)|7m>cb!)I~;J1elivumc@~|fme>A($VsGqO=d7`DebDov<;dQJfPClT
z)&W0^tKXUNX#t(S6?#_S?^-KRFf-QkHpUcFizHhNltm&)!nNOw1cob-O+0g0{6SipA1;+*C
zj{=QeHdHS80^+oH7*{Q@t=>;|WK5R0Ju}ZuF&9Vnw0S8z%}tA|J*9&W;xH*b;?T#3
zPV?+_E{)ku4!L`R$|W6qFCBfqGiw_IJ~;=c29FH1>jH6-hl1GBQLz&bV9T~)%ocjf
zj%mI7%y)-$lFv5dl^|?~y87~C(?g;J}tPS{pAMd_E-t2Wp?hZ71#9OTJR=?Pc
z`8pr4i!3t8Vzb`au(#~lnDP36EbHzBG>igGJmpC3xm!x6J?x&ghyJpo^@%Kd^z34b
zc*qsKy}xv}I4d-}$!7Dk+<9J+iI2_fX>%r)a^?)VWAUxEiEo|
zRm{mGk8gcW=)5cti&3DB#{XZ+iF}b$F~h$Q^f9ATjK~*j{LshJI+^wT2HVutB-_Lm
z$gZBu@~>p0PZ{PX^=D^obs(-{?M^)>xJ{UMrDxM9(A+<_bUyhuEuZQ^t2|ckesaUE
z8~=a#?*rV$D}h*xg}S?2uqseH&Sdp$K&uNm9R=EG{Qsr+Td!OjgMF2gx-0O=an%i)
z9{I%I=GdBCp4jvy&-^UZnUr5Kqn~f`{MF0k+1V2lb<1D&v6p>paYsVkk?i2FzUs2=
z`O6o%WsiN<*|-phJ)JdwcE}5+IKRU@``+R_J6lhxlXK8D&
zEwCnDbw7#Q*CcLioeR)kJH+v}>7D=jJ5cL0wx2F`u^s={b$sT@!pHypfjRcsCsv*}
zEyQd-Xyf3_-fn{IOpj%gb6!xk9G5YF&A0xtdFh-j{S4h1p)U!{%Y7er^4RMB;zt|v
zihbM5YySHGq51T!{qjOSIVGd+OLWy%+mq$*4R1&;h
zJ>rhXTHo)?+VnPFWM*j`YkYXbqUwiV{8OXt
zdK;6ySu6SVTqc7oHsIYOF==AX7q!8*r14hsLF<=!a(bC{PTIad4?eewmsrxT$ysZA
z`F3*Vd*AA;Rj%xtWj`77ftqG_?XNhrwz3C(EH+nOs;7%i@hn^UQhw5dNBlPg_OYq0
zry(VW&zUo5k0xgJ+E+fc{UrV3Nz;WWR@f+Og~@x!bdURghmlaKz6MZq6L}6}#gyhI-e(
zFhmQrup{uE{!77M1Q&$oi|M~M{rcdXZjb%<8RpWBfgX
z#1h@&+|cqtme{(>$tQzsGQ^Vnl2Ng>&mMd2!7H!)-kzU4x+4AmYgqh$$R~G(yj>K$
zI%w%v4Qpyj9jFI2Ajee;bsp}L^I#6tmb0rS+}mnqA#g{Y5!9JhpXwIBbvo#>hb}d1
z-a4ICrx_l$lfK=7npKBn9~Y2Y^6-#Xa>~v+6Lj>p;VIk8$B*X+!SH#e+UqRgV;5i7
z1g#B|;>IR+)Hy;!*+M3NoFTG~5BT$?$Z}SXMV9=ucCw4Dtt@dhH|vfNBYVV%FZ~|&
zwJ{lmzFpAnF?R3TFE(^;3dq#z-nsV@Io^xE?qhst_jsQ}@;r0oS*yRl)aKc`&xd?j
z6QJ3suV-F6=NU8~$RArh&q}Xn_-O&XTZ3%@zcjHCkBTQ7=(KK5oUEH$49M*NoS7YS
zLB%h_!_T3Gj6Hj9DUe+;-<9zxd3j@#pKahDeWO5QPx;9g_VZ;FXx8OO>*FAP^$gyS
zalenh2Z#BxXB1j1z1~OHcJ`^EX*$^_ccVZXjsL$SkG{&C+By)Z1GqyV2kQeeN{(Dw
zmw)H^iXhkK`1kV3N7-RazPs4mMFE*~RKCR(#Dy&JC|!7b9@a+V|KHr>cQRX_o7)?Zw|>{S=R+-&?eiI16GQ#RfDX2p
z`#;p(37lqUT_^fc3zDXJGU7eofal1M?Lnkuse_wn0|+v
z{_e>={hU0=`GJ5A+!^}+VCQ%qaX
zUA*ispEsrtQ=g|lyT-TN&zHP|8QXUtV3T<*9qe#kjM+igVo)`2uGaY?FV&VWE15%&
zoi>xax+~=G-_OV&yUV_cS;-?uji?WCDSyp@JRJ)7#5cC{jXz|zeqEa}8Hl{OpyaUu
zDn4RyIADAEEVpE`k$vXN-;$T9W4^G1ea@y>iNU8P2I6@i<)Q5Xo9M=0IkAro<`x6F
zD4ivfJqQo~*=CLm=mOMDKBqpH9S@n2i;73Zmt1<;vK%nm|8ujg3HL1@hI`q=RyFDG
zRmerd(?yA8qePrFuskySf2IQ)5dg^&ezC7ArGRVI?ARFB~ZBEGl#(s{UWw(~^hXeY>
zi4HcYK)KK
zhzI$-#FhVH{Zt<1hg`PPp&sz+mtJ$mc;#pzkW00zw#|!;I}R^-Y$21ZE{HjZ41<-TF|QRE}(}zHX*jK$+@C`R?f+>UU^$j-}8ZNH9{u)kU08Yigz(!
zYZoAVa#HoOF@2C{^ZW)rs9kopym+d%_(XQym+woz1^w-KtY7jy8I
zs!RQUp9kzq|_>R1iTr@uECs{ys47Oc5P
z)x=_;Hr1lKLjPvue#EQB$gj3)jV$MQDKNJZplwT`h
z+t}xQ2M_z*Ir!+T=f=+T$sOvcJA@80D>j?cAKp7R-LybLK_(5j7=iS*OPvln2@VeK<
ztk$~p@u)Mk!Ol+z=%9Zt@cReL|Dj$nz+W*SV=dq-UC;%nn|x0B?SXn$;#XspbFpN1
z$ui#sXn$~NieV)!zMX+Ml?@xyw@<8ro{FWPLyzea1AE%q;~RfUu6vpucCowSlmBJR
zoJr+i-DSO
z&e+`6v{;Kn)n)bTELGcu2l1`us_iU<>{ULHzXqw~8njE+D
z3(fq_@beY%kDub8WtUiW0qQ27(|Vcf`)9hR@~0L+9DO%Xhf9HYJ7<1BgmWqO>;SRu
z0@O`Dr*rIAOX$~9OLEwrRq;glE(_>n|It8w(IMAzROh*Kdt>;fNq>Nlk+Fu_OQME9_XB~uks-dc{WyM@=pex3xPPh
zcjtl|0(Oys#~L~9cRqPoI!PYx&HAojcR(gmAFDx|+YK4hRe9#4_4Po%3y|}?63BV+
zr#q1;uj;1m$eOR(0>cgXZ%G&f7vRwWrG+Yd70(Y(7t*Wo~&hOyI%g&
z*XpiZssl9r9(B>A4o>!6>`d3l-ydwv8RM(G%TGPW)Myu=sxy7QTN_(%Z71JdNVXbK
z$CZD!qKad+_?$_y>n>&2dZ1>zKrXe2UFQYvif!>jzV4gLN2tz7+0;)@&H+0ru4J5P
z>`und@4EsmKh&1{uux}vOXju(n*#Q<*{*VAHQTHjy#kqj-$fww!GZ=o^#G270V%p$m{aI3r2pk`HG!+`tXS>9&xU^u6jCI
zZPc1GR{c}8Y@(09beDab(xt$EzVs{rHJoc^x71PVp
z7c+EkKrfyyK=jT9yMo;Tzl`xzT~=J#CdcYzPe7K~?aI3&KjgXUi(dAYT)ZHL{MA1Y
z$lGebUSoQVwZ?R57Xy36f_={2-e5-{7S9O8h8^~ci+yGLQu;$3;$=?D4soLIaA3ab
zx$3{m9HO`69ZbJ$Enl=`l4rdOka_SvYn=~WfV#=&GQNQ*L#M!`9P}<`MnUZr{ru-e=fiyHe?ikmp(F^?bn?v`Zfe5$DF*DU+yeA+c7!D_IcL6wC|T)YZ+I+
zd=*Ear|Ls2%5HYBTMR0%Vs|KD6JGk*ZhpBR|48%wm5il;&2(K8ToF{xuS__Oa#qz~1>leC#9pNI<{5ii3GF#EI|r+jmib2kFlRZH)1g
zZEw|SwX@Dr$t4Ss%O-NoxmW65n*#l^0k3**#}%WyGmq%Dhh5g3Gp*Qc4ahCK)QmB?
z{M*#GWpDA#8s8Xx#2k_8RkPp{Wb@tqa7AETeRirDHzG~UB5Qq)?)&u-qfc6KMNB2tFmgi{3*9LOI4|eOfcC)?g7}_Kb1vYF8$QRp^
zA%2xxvS-O+Z#`4lLdJon72nmM>e2m9C!WiLR_BI{k+s@q-JNC+8`_`Ks}pr*P3(-j
z0I{jl35ny*CXV7M-ov=f(ofcz>SuH1y-OdlW7lcep`PGiAb0bDm{k3Ur??*uj@H%a;>fyK7ufOCK&_L*eLDkurANQy@}=~Y4)u06
zdc<^Jusiuz2jq4E@@!y}GpFT0+qwX;Z8@-iIs2W1_AY8|Vka3|u#db?Z{CI6t6Kv$
z;E_Z5ti4_Oh@E?)ZzZif(Sz@3(B3~~JDd3cWaBS8hHcrkal|h2HU$+6_L1cbs(EWm
zfjgoLkUZj(Kk*SWv>4DmAK2?$8LJ6nemyT>ue^G%<70tdvg}DHCbdy(_|=s7(yPxl
zq_57)2eDZQ+UK4%a;sG%#`ZdYY+VS*WS{$h&j$j!SNpc~mJPGc7kT!H&lSP8Kpe@Y
zPmC7(F&%W#AqMV1YwmCJaDCsVnZ(F`WDlAAViVubOUF7}EAACjW44uCI;_bN-FFA%
zJSk9HHGV=rFF$G$PwB4quFRpzh5hV#W-u4)b?>|t}&EdA!!0{u+^dhE10!A|y<-?hJDU3Idv-?y69+%RVR6Te~1
zw&&FcLBOBkXtn&zHM!Y9pBi-{yIbQN6s*Yb=NFpO>D`#HsC+v
z7dsaFzS@)*K5NMnN9!fuyuP`WK+NUXSPZL9tB$Ki=CWoVTgC2F_q@75^4;l#TKm}E
zj>+8{uw!iPX_@!#B(?>xTd`{P^
zZ=aa%3$Dn+XMb99x&V1^u=dcb;oT7I>Dx5tyeH??92wgKHX}Y9n)FVL(^zayCvIXT
zZ)&3SJEQAC7ocwPIklzwY@QF;CBEVTYWGy}bmrQ9^xNA7sGEGAI7gp-V)n3;#PiA-
z@qAYk&#_t(XSHjs?ROa?`s;kP^(pRZ(1~$oK%G>-T6SMG!|p5{iy_^ei4dLggT#2K
zYfKM)bon1`kJX%-YVD`*bal?sS30kLfI4@@mfeB71=y*c_^vIeRqI=WVcp|t^C5=L
z%dNqSgRcs{IZ%J%rOReO~sF(>@>CIJDn2Dh|%38u3gO7coB=n3E&xs{wn=
zIsbLPvisUV9gB^1XG|=_#B=YuK%DWKBZm(4`|!S|_NA5E@>y)jTnI|eHR;civ%i;f
z&1uMS-_DZrh+fVkPeTqLXUTa~FXz#xA!kG6h>e(@>iLRiSKu7k2l6IIb-#7#qi*s!
zy=OM2Kit>m)_!C1?gD2Rokx5WnC`$C*NIw9kILkO9nlkl%lbB
zHDGJib-EKhccf+CLj(Tfk%x*2nf{;5wXbrto_V?48VqZoVoR=^@vru$JJGv8?Wgsz
zcw?NPXDQ$hAH_o4#ljrB=v)cV&cOPXfF3at-)jdl?dO-fh`nsH?^Jeg4i6%mZX||$
zC4)?|+vg)c+3?udz`t%_OZmqS=VItf)s0vny5|G74C|Ty^x>5&>+EUIUxvqQF5B^m
z1)tQ>!GK+5QuLJ?yLeSN)hb=kF4a&9RX`?Ybh2e}UJCxZ=0Ojx)qZ(^p67b8K_vq^bKCsU-V|$>c+360gc$U5PR*cvL^xLa{AaJLw
z2J{)X@mtSW><-ExwYCyktLn$!QT%!!eBIm7w~f?4rm1E0vZhYoVY
zu>3fbzBsCPaTu;woaN%~0G0jrh@ZRTaWn1?F{XDIWBS$jLO`B6QAe%J)fqDRCC_5;
zs=m+1E*e5pDt`4>awbvZ|DTQPIU&)n>Q8)QKUW;c^-)AD1nzDCG`f32$
z*p$5$tDzsYUhM<%VLiHs_N%$lJ(OKKhwYG09g*YvihQ)WUCWrx!q{GU#K%6*5a)E3
zO(jP=OIFqM#_)hMeMR3tkk;PSVC>#h&j(Y_o^@)uJlYOe0T%QL5jXVuVESz8F~
z8;k#Z=EwXnUok14$N1*Lhxq7xAwII{WIi5>k77Oak>2vrz3W`NBls!D8v^rp1axi=
z_-;*n+UG;v2@9DY^PikCpF9uo^MUVVmaJ{*Ta%ZHk6g`?#onq1eUJzI?VY_dW3en=
zee&_G28#im%K;hwJ*csF9M7JrwRhy-?S4+yGBr61Y~bfxLm3v6U?SlimGfl)q)aoU+-N-*~jDe6Ep|I_?!<0;=vfZLz%H?;S*em@&`1d9P*#jonC?5Q)y
zem3C6cQCLvZ<5MF!b?5)ZP6wI)UgkKB-JPK?=8v9B6e`x^tYYfcWtLc1Jn2!6TAtM_rT
z#IkZ%eCoAowD`&fGTCjc#`W3Q#+^)h$#_*zb*_fgl=bt2@(*w2^<=)OC%VK;e?B0)
z?0)Hp-DJ15$e-fBd4!)lcD40cF=e;4EB}+srSGEj$uvTe7TpkQ%SgRbhExYK^j_DzL`e%6;P58w3!NR`Cx-Rb?&P@CF@zi_SsMdf^@kIKY
z0{Jxelt4ViYPIj5&c3it&eCGPhm4~Ed;C4wEorv}bj=5Ce8lUn0NJ+|$ZeYo^Zf7}
zSP9ykW;ipyWWd-Swz*FbyI&cwPs}a}*vYQBK%JtigYAL%;K56VGgsr)^u_Gb;DWwY
z?|d-Fb}e0ELbi1@+|%;o!*5^Nb4&XC8~XAEnX5Cw#sdMH%C@W0=d-!$mrY_X&LxvR
zy!KWtX*UF2fb8W%7of6xC4K&C*|{?yukz0i@Lh)vJZ$o8SPIyFFfhjl>+I0heLmJ!
z+{rG##A8n&cXIoZ+-2_!=F%sRemUA6xTng-4e3M0u39#Uk)Ko3vm@XuqJMePJLjA~
zj*g0@b6S3}hc5cjFh|yJ3fM$f7a%d5wMXvkI~dS2wy*VTt>@=c#a})1U!2U#0lDlr
z6p&kW;NB1$_Xd9Q#1i;#?Y}nux9>0LklUA$YSQ^#zqJ;Sr<9F!m8BZlPtkJx7IxeYRmQBGQ#ujU2vvEhjj;dXKkbk++Uk%u=cG*Z~`A5$0MrPSgp4f@ig#q4*!%u`y
z4A_H@Z>5)QbkT`NO!T_|(bwsO_6PqV&tx@2hSnZ7)ZUiAm1FP!J+fCm_)_-BFLI9f
zAqHA8U_blx<%R89d%6JeyVD7=WoRpX_W9Xi<*H&+u@#RGCuViW;k`Vtuk6IL7F4_{
zZ+u}h-`NePdOz{bOEwwqAN>OX8D!O&VrMIpE=0b3*lW(+H6OT}AD@_uJsDkqZk#rg
zoQY-mO|RcMTCr9uC^LNf&8-3yq4aI=}Y?l
z-n9I?B~Z)ifLt*d``v4Nuk(=ZvFF(ET$G(1rVyX-B;3c&NS8k9CZEUctGKWk`0?nz
z&pvTj4fw28w`}K!IrfRA_Zo2=wtF%s4r1lc(&p2G+?CyAvH5Ty$Ku_-Cy^^o!*%mw
z=bgqra^!+(K@5!xQOZ!0$HXG2hNa7O&TZ2PY~3APN@
z9-1)~d@sAnUF^qKq}>)co8pD&#Lq8#%H{yFd>0$xa9+=cs)KlTl~VeM8Pl-+E3h1fH+@o`a{7QTHTS
zb3rSMu2bzF?yDLUlS2U?pBjkEa{_ib+ed=prKjxJoBm>8zxgge-Q;r`SF)-O*bH>Y
zo&JHq9l09NudVZ}CSXsnAt39X+>v50muiG=Ib%m#1LTvp9*}QcesN{$P+fmI`Jou${%GbKf%&Q~v#YVmH
zmHk%)+X6M|?8+IJeuhxLwWSH*))J;DBX+55sd2zdbq#oxo-`eLs@^{3)HZ5D&x;uDI
zaBEPywS4aa#8zkPnZcvunEu_t-v;#al|0W4ejw|A70d_L)zJI;{$g6Z8~d@k)W0@R
zTgcsDZfDdkO6KAHZ{YGj^FzjH`7
z9r)B{)yUEGtM=3gyQ|*#(XOc?0rU{uGyx>Dn=#eQJEwEhQNL3y};TP0bAKp&-P2x-xoYH4v;gUX~+Uoc(vb4o^6inA
zp$&B26xm%rlC2XU%1
zb3yvc0s5ny7q-;7T1=lG+XA}qmMlJi_}ta^52UqUp6dL_SH;TQ;egNfAan9_G%()<
zsGEFF^Yr+>Z?7|J&$JHbCN}UB>}L~M^mYO2CZAJT*QD=G-V&$>_L5us>O7O7PY%DT
zF9&1ixMH@Db+J-k{H99`hq_*pxrF=J?FXAl!
z!~0H**MpS+RV)7TqE^>WqgKOqtWMfHo1ML7U4j&lr(E%!9EQLYs$rHn33EC$9`
z1lxigK_9|NOvOvx@`nt(!#harszv!2%5r8tIjC69rN237ea`ThZS>q_B7_eavsEs&
z&L^Lj1MIh{PHlNQcaJ0AAMfo?U#Po!?~
ziSsaa>PgMqGNWd)G+G}+y=P*VT%yW(ojdUrYxdka!=5c!HX8yy{B#_aPx0g1=ZDuG_H_Ze
zF=%}=CnsW7I)`I1H%G2_!>UR4%NHBE0Lj~qK&_M>@nn}Zveb}p|7L24JhH{=U?9)r
z8M8;7@J$U}9Bd8fw~m)hcvb==Uh_fe-jF_!#m6o{_FNZO8_R8`A5dJ>v|RF~3lN>=
z#bdGWZ|Yn1XpQaSATDCdUvb+O*hfbBW(?vnL>p@|e-R)wh
zUoz#F-DQV9kXtn^#~Xt`iQdZJwv5GtEcv`BKqcRPYsSE~E|qD}6({?Fk8kVy^x_?}Z)k7bU9G)C`|YXt&@&&PHa<%kTeFwV_5DSQ
zzYCD}CqCHAZoc_{_^Ri{;O+oDaoWsWKisdAQ_m&(R|5KgZ)|Z-bpa~7tg&@#V4qs|
z-pALnx!Nvs$evbi#jdj$>L#DZTl>kY+|nmbU4V85)=Tf1%Ex~}&;_WK$8YCGT)P0_
zSHo;L(_DQ#Y~*|SaHhU@*^BtRand_p?^XA0O{)<#T<5sXkG<-!Ju_-buJDT$JFVCA
zu1g=`VfUt>Vv6UyKuc$xb7%IyHRt>x8M8(H_#j`cO&Ol>Okoqh=)o0TRjtyC_}Q-0OJB)LccMog*6y=V~j_f3u<^{q9}IG
zmc367o|1$-E4U?iL4fWI#G}UI@%*fLH~GQ=&u#q}&*$|#H>WktHt{_is6YMbS(-cH
z9Er93w>GkqkJ=%;d*Wx$1^*(&yBimJw8rmH^A^7~@
zYlH6zJ{X9}(8pPR(uJRopFBesf9M-SYwKM0x8seyytA?8Poj@q74O#XS@yKLe=B?2
z@o)C>&c>FX@Ar<`A|_+@w7P$2V9O6a09(H86t;}n)7tWefi16p0JgmHG;A5#)7tVS
z16#iM0odY>n^iAtXi@oUZJE@6`0Bhr`2pCnat5|kd|F$s%KmnIWyYv#_hIR~y9>i{
z%eyUu;k!gT*YeUi2JaB&QQ0uOE8DT}!fV0K!1GjY#`>8);e6M>tM$xk;W^Tdhkdrm
zy&Teq4g{V9^v(tQg6DtA^ci=biO}{yzK732d)@2m#PiNON&S4y*x#}BoH-oO=gv1q
z?ueGhn4AlO~HPhPy5^@qu$RqjqqBd%O3VG1@?G9GtWl*kacV3
z#i$*NZN2+y`A3%LZpGQ&(zBR;7a;s}&^fkV@1{@By1Wd1&eXAZ(@Sw&y>0TSDlpzJ9h%0|4m2V%xoGRoGW-R5h*T38G!KlC7S+uHlHB_uJ=A6%Tv50P)kkxG7){{*MNgdv;e{bm^noLlzyLBVsqSfjqu+
z0W$7%LS)F@S}-PmW9G+vmnZS!Ge3qttDDwme&MH&FUIy%e9CtFx&W1bY||gwf`@MY
zh|{3}>32Gzp}P3W`@?lYt-fK+I2UB9{ci~P?0m7i;y28zm~9Sf-$&E8kL*o>
zcW`pM0Ckhk_$1GKcMH4uf!Mkn
zknQ*W51;S+Mh5~uulB9JoY=ngU_@9lg_W49ctBX%;@*couHOI#<89c+c
zWzM=Y=o$Z|gZ0JCAvMfj)PCo6U-84<+Xs8ai_J(**nnC)#RIwkwcjbku+3pxFL93s2N7YNr8U1@f6@UKFA*Skz9b`K9WA#~bvwT84{yO{R$UgEAd!9Jy9lyU;GnN-?
zmkrj;(OGw=_vXz3f5fZy6_2>$5mP$xtOtD9AG|QmcWF^K`JBe(y!7qG&*#cTdpA{l
zma<-Y>v_@oV2vy_(B5fX#z?&8gS7w;yY84_7rx4!TC~T0bHlugb=^Poe{15e<-3~O
z6d*Bu!=!gS2j*T8R9x+;Sd?$o`o84nSY+}~4D?S2bNwD?(4R%2Zt{7&t>+wn5xwFB
za?=H3Cvwm!L#Ec=w(h!&
zQN><7?QMOsUjDPct(p50H*@a2#?$xgmhjMF`*^AQqjdb$AB{nAZFCqC;;;U!Cri$8n1
z0G+NZIY#9-nPfR%@>KSA>7!H0ZTFpxJz_0Rdjsczea^d@aEJ0$tt
z_|n?YWsJJX=QO@_sr{-;ddO>Q-ubm&vAQ>X_rObM+yiSpzkR2w^F86gw=sBX>Y6?D
zt6ldK;s;-=_O3`D_*VUD)lBuOoqr8H#!an^s+%8kF`U=zYPusYEHeZ
z2VyQ}a@7US+qHe0W)e3tDu(<-&Kx~rWj}kY8Ov{t-H$g0n*;A`!~4bFEguekXG3{;B&2k9}gOF7a#UgEQ4-
zpV({Vf?hU$U-XKDF+bdorPCarza?{W)%v!YF&oW(z!rMN@QPqt
zpq|W=*#&54kfS+~Td^y<#FI_rsegCvLf~AQuXFkF9!J$Ap6*@GlBx?f>Y_@j2s
z8ENISk6&u33lO{HWMA;I6yN@|WOf1aY#-*6jymUc7R7>WwTq5A9a(@Y5X>&FMfAF09_SNcJQr@
zPnR)jbM^8Wx`w$@BV=mJ53!aj{_?T>#mDcKPd)RG?u`M$Q!=&q{mf}DZN;m`>gg4+
z6;J(H{C9jJJts8e(gEsPwlJt
z@fG+3b=I9v&w|T?^MaQDp&8?&(_X(%sNy8fcLvu7HwUPEy-PnA)Z-_!)89?--q)>6
z^q8{#`9Jo<4;Qoc8AMj)j{G(+o-N{At(xir#GjhyhwJH;I9!tT^8@#QXAJ*5Ywh!1
z&DXZBK7UYGOIf#1Z7lYEadAJNP0Z{Wiv#=AA$?tdy2;&C{BYS#nt1bGmTi~F|DEWg?1{Nmf(_tm5RYQV3`srNp)$Te~7XWL}?d#-FE
zug3Nn)7u4zpX_YU;>L{0ggTRR>3?95uN|3_mHtsl!t-x-)%oB=_dv=f3l*$$Rp5rjLs6mFfTfg-=<2=45vI
z|LA<}V_va$do#ZM!$0_liaEc;vU0zee&tWC^6$35o-Qq_z4GU2@cTxG{;4be@w4)*ZT%|$%C{@C?i^Rml@9*V
z(WOPLe|07*KeP1Ky;yDORCE7lP&(Py>iz3$Uizn9=1{9wO>GEDFB`?BON%OY!&WZs
zJshZYG18YWx(@|-_~8ta&%X9RoAp
z9=coX9gMAgX25qcHwI`d?(9EPUn@VumK}Uq3FsciL){>;sB=ZPJIuZZVvC=HbO9Z+
z^p5$@j^_tFExoP2Iu~7JqHgkeyrx>+p1YpaA8+0K+a5SSXjn__*g0U2{4NLf{7UX_b!N?+
z82bMS<68~H_s&3m&kt@6Jm+f9j*Ri3;(ulO?)Dodv&Y|&)djNtomoFOZN=2R|GGdf
z*-U21qx+(uU1Oj4E(TqIZVTFH3K^A0t$Jjy=Lz4{m;1vU|6BQO+{if;sK3L(ra=Aw
zNj8(Y6sS?p6Y|W7&!qug`bvM7J~|qZ;ooz3uU!c6;-il}aw`U{k6p%SZy@jVpt}O!
zQx*(D#=fTvWBh5EpXDe2pw4!>Cp=f$_y6*zS}|k`AJ}~$V7GTxZR<;$+dH%7yOOve
z{#q}8hW4MAHTH{-{FUBxkHu|hQ?1DZ8|~p|dtNgfeZS_07ykCy#F*l}%4RnvK(ai>aYoQD1
z!!P#euE4vDxFdF`{{@4PvG*}KI8z_#po`9S?=0KGc7knmJDX>to4;eaPbW8Cu(`x?f#=3z&;_WQd>%h%h9$#2
z+@4$Kk=)W#GPPZRy2t=c_VWuq@@pkP_K6GP$AV6%eB(#^4Ab`>vm7A*uX(ax6?ld%^)20a$o_?%
zhy3D6cVd%$WNr`Ko#OE2y}kF%We~EqanhUa@pI_sWlZlM<)sfBy=(oP_0LPc_PHa@
ziy?lt@>xOg)t^oC2f6c5y>He#&V1$;19q+kd=r;84j+tO*nbb+A
z6QY~1t*rOtcLmX1@%+Y&+x5TyhZEO-Cu8eKzB`=|+3H3e?g``uuKN4w@4}TE{Pc+F
zeT|$pHtbsu#Pel=8vBamtV{c`fc&!c-$r(8>%;$U`n{pnH)YH>dz`t_{o{Xo+y{1b
z0V*F_nSc2=Q{M6k-v!@u|NZjZ+W3`?jqU#T_xtHa?-`80VK9EtVEoL%_}Yxi7x7&j
ztl$5!?vH>^Qwi7`Ns&Yy=0hw!(UDJ;I*&xTl?T&o>&)OkujbvLD_Jy
zpKJZNwBHxDi9CCp&o+i)R{FFR+nN_c^P2~)?^t3@AHpX_!&-m!ppN#0M~u%$n~6C3MDY}nZP__6$g*V>Pt9qQoynQ!@itmkWazM`LFQ~7Q0;Xyrq!9dpa
z8GFvv?~I@avA@#^v6U=*f1l^A{$kMD^q5{ho5lP7{DW@mWlOr}Ja=Hr2YQ~0_g4?b
z*JmuImj+tjQ!6Ih`!(-C*8B{ic=4$JpUNNLRy@h5z3<69UVF4-Z~f}N_5RC8@6=?yKkosb{Jrtl8|C4T|KNCzJX7p9|NhLk
zHSns2Z(qar>;d2QhL1lb@0`rDQ9k&n&fwkg2@iVv@1Lmi%^9;-%h{>JF;GT+Iajx;*sSEzdH+$pJ|e-?jOf1WQibed;(yKe6{
z_v;nUs?Y1PMh3gSI6Q4U-u#i{GRqG2ac4g-?(~$b1L>En=Z2@1wLfFLkL&mNSytJ8
zUe?w#J{pMqYx17L|Mzhyv^8jD{ZalxHNJbor~Rt5Y*`A7zq+6QnzZ~ie_DT&S{?_prRs8F0KC$N$+Yg4X_2DfUllg=|`=p?3
zJJQH}d^3M_KVLZ%7ki)F^U(8$zj>mbU(A?YWIJ>BWPD-T+NXV5Q2so!=O5a1Za-hT
zclI)#-tVRRg}-s4?#~>Iw`E-Vw0=fVK7ZuHQ#(sOoACJFi--KLZFuTjxfg2vVAgNT
zSf13=ErEKtH+3+qCuc`KTE4G6316GLKmGONwwC?hkvTkj0&zy4kn_AR?Q0{q&B0Tf
z{rsqBhW&h2gC)n$7M|SS3-#=&m{006vh2A&&^{w5n?9OfXjL`Y#`-+W%Y1>%8
zAp6_#jf3$g4#pb><3If1iS_@h8MpF&W-xw5#^R`Uw9gChqw=%zpw94AjIA5jGotv+
zLEV#^`|*~(9eWq_USdD;UZP*|{hahG$G`ilQ+uD4IXc?4Ls?_f;Xs`^Tl(w+eRJ0I
z@zSGzVL+dL`Nv;lHA$Da7@yyd@fn-9PKI&Csccaf*2^Ae+n7zB3;Jw2*!S6VpzpJ3
zHE84GYRTmgmJ5@pxR%NB1{}k3C-$Xumip8MpRwOQ&@))qZ*3-qW{t
z^zDoL_GM|wVZ+b<^7P&pS9`0La@;24szoyFk>f}H(uqGy`Kez#F&>|vam9n&l6hhJ
zbPVhL3;X#y)0SQDf8W%1Hri7$6~Cj+8vaS1`Z;=QZXt7JhrE!})|~MR`uV%k+IN2N
zzkcpS-SzBwY0smcZVb;bhYw2**Rt0BjPCzUAiK(qM?WKLKSN)6GhX(cktn8!vl|k7+rkG!ywaO#g
ztbbKd^7!zgA3X6n@ZO9wJ+X_vKmX}zKI(2Mc^77lyz;l^-EZcr7VAFr-Pe5Aw{
zz8^oSZ{-2sXZNi$Z2Y{wy}fVie7vR~-`ls}*thTL+i&gLZ|mFdPRoBa1*c
zhxF~`Y3;}JqVTkNkzc%px;K~lxgCA`6@7bU-?HBx^{M^7zWvd(bg7XG^AF|QJihbC
zP8`2BUVF2lLg8E4zEKNp;S*ZH)`d;fao|25#Y#?ITD{sXc7YkE1=J`h$>2Yz|Ym`@T@Rr-Se2u?U*m^Se#16n_Q3~``Fp?kzIWCd&O6K-V6G*
zvVB*^y92hO^&WgEJG=DJ>CWvB?>8n8D{0v*?&RJQxUcxdS2n1zErIuv@}Z4YYk$Q{
z-pS=VSz>GtAKjmPbVs8+(vSUq0JX3+P&t3nAEsh
zIUMS|ICK0GyDmT#>+-qc+f7!F*S>o8Z+D-amJG2H3uKSjY%~b9aVEF5Pd?OO8-KE|
zOhBB=>jN=Z3!LluU|;aY2-=@k47&i`7>wC9w*Q-E?59WW3ZBD$u7#?uyUA!;1J+{d
zu{FM4*U!nN8ZB8B%eym&tc#K7yc}HAkJC*0R57aDt08vPdTVp#{kX3PBOdr2{9hsLK@z*{hcvP@Cpwqh+Kj@a1
zr9cevS+fV9GbzSH-kR^ShHePd9pCU?5%5XgZV%}3-GhB)8=KWOJ@~o+$(i^ecNRa%
z<}(6<)w
zuVl8Z^)5hF58Y&RqCNC%?C1IS7fA|#_|VG3Voa_*TJ*HZ=ed*T-M;kMtOax+kmtJ$
zLTXkmhzVY{(W~x_mx9t;v1i|`*vk`LZ~l}i&+y*!Y;1MN&(;8y9{!j|Z4DR?eWvSM
zdR^W@)s$G>7O2DZp!`X9;t&7bA!1hVMx`5Xz01}d8Do9th#d6V+=XJuKXYRAC7Hvs
zC#d}F{QK$8=!(}FtTSexnE&xVPXDf5tzDQoYtF@ovexST`HYWd{+3{W@U49;+CQ_U
ziw?0V+uo9W;!t*2FTV1DEnWENx7QgdIa*`#@V)ULj`Nj{yEE6uPHf*qNoXvd*4uaZ
z;wk-fUKEfo7SC*SvPHh}I4@<_mhhC170>yeFQGcdZ{H>T*qJtVe~}~JUzfaTkyt><
ztGHF`4A@`t$uU-!*9PK_@X`6m;4NWx_dOz)>8`Z912qKXf^*}nlzww;H793a&fRQ|
zo}GcaxMZqBSPiVZ55(74{rsocVSH2I|CQ)Ir(<96){!;wvG$)w*4Sz7{~N4bpSih!
zzhtik>{LhQ*}}HzU3T8Yem=;tw!jZHvJ}vze%2#oTiP9gJeO>HQ1Oe?kiUI@IaQp#
zt?}vEVP@|uC0YLr)vatNOLKkF2rTzHc8{s~o&zWKA8~_Z=f^Vye#gBi>IK
zj2}N3zi=>CAMO6<55{~&ubMWKzgxtXcaGRn{=I8tt^E7Wk+t&gyGGWA{)OcPdk+o9
zj~k5Tr}ghqgRwJFH8fVA8_rpn)SH?sEH?d``*^oy<9X37*H!1U&P7;`@yt34cb4>nvB%mqlFZm~2cKMxDgp#Z-;$csFPL+Mm2;xmjLo#yTg)YJvRd|>XC0X=jg
z`iyJcJ4iv!)t_Op%s=J;x#KKre)pWW;)nNB2ya%ZddD#;<
zV{HA}oG*Pkw)b;s{{R*ef7__J=@&Ncjew$WN-O2pFV1zEo&LKcft2R2(?i6!K`NpoBp})f*&}8
z`Vf0?|EOVNY@^6}@7y5f7;(2n`)zWt&2wx0HufRDhoZ2_Oe@;Lz?#R#3P
zt{*-_UHhWzN3w?xU2thIwBy$^hsJyq_ts~=)Vl&7?hBR!lz+A{`8TZ7_kvB6JiRmX
zg-z*~4txJofNHMV>HbfgJcBEqXWF*!1@}zVO#I*v-R?C!Y;q60JeUjkI^@BN=S6|{
zfwHq&_HIbFkEDg|eOu#y$u_1Ov$ygxpSev9>RpGAR|n`oFpLA=@$3%NG5?+K`uR4Q
z&i8!@q&l;{7Dv$XXlp;+v-W#lmkd6#$v*mL?eSe8E>G@)AMMZQtr=I%dhgp7)Ll@vl8?lJ?Z(6R
zveNI|sVgyF4p9F2_TazFMQ(cJ<-_y`}+OQOP{SZ
z|6c}j&5NOXpbO-hkHh#}oH>56rTlW1*vpOr`^@F9GBWn-o*M53r
zZF9f&Gb3y2b6@bYBWqO$?3QEa;z%&`i;radTx9S|%(?*GIBh0AJDX|%f1PQv!Fl1k
z{$J!Q*V)6j6p*R@@Kr9vOH5F^hQ}Je$t(V9TV8VIbZa0M^wytK(7P72XJJ#usOq5d
zFFyRjPYxTp0Et(7XNb|ykHouj@xGC@VJ_Hlq?cWK>ESQpD?RTYkyUzrVPtKnhacAj
z_4l{Lb*Nhm=;iyE4Zk>|r)>D8k+qM94Zl31M?LNfer05hPu4y#vgX-r?Z1w!&1b&i
zp(Z>J+B`kbSpK&WofXSp9a$U3a+td|XUnk_{cg^m=T(j0F&KaOV0>gSJ~SAgHyHoO
z;Lph))&F@ned_4ke(V`(u#
zU(~Gg+j{A;eoNNdcpS*sy&<=Bubg7rJ_2oSe
z`PS5$_M)J8zF@%PJ!~lF!+&$4&0jqjzvE*ku0K2DlB0&nV?*g&?fEk`@o9|Lo|+en
zvZ-1>SG0SYx|6_KBVQ_d~JWJUxDQneTy@
z2c8E*-d{TjZ|U_6<`W-hKYJeczbv*2L~Wzz;mn
z4^a75E&n$}D*30v_VE0N)8IRmoLTE!o(t5|3&Gev(4=jvUl<0gf@<6o7;-9+{%016KdjQ@!p&DHr`kD^E;te=%UoMS;Ea7?W3H
zGVB5RJu|ijWn0B1Q^(?>&(EC!S;&2HZvLawS_?enZ4Ru1*xJ7#KouwV@AhCW81fv*
zT=`u#vv(<|ePXc|w6fW@oZo=+xbp%e
z_H)6`03WLUuJq-BU%(ErVk>{@?$amxaXmJt^$fc_u>ZCxq4;b5`pk(z&5LE(BnLHL
z^8Zcdo*u}HzBtR9n2RUd)$2-tZVbepuN8ZJymC%=8}rv>{N~^%gO3Kg!?+qeC%7m0
zcMJ;Ae^uWXE4G;X(g3w{{18Lz;~VUiQo7heyu3+GHcy>TkXu+fzE#1Zs7P
z0cz)lc3hHmHjyP3Vun@`goww=nJr!@9FX~Z7&hT8b-nNFQBr>0TM
zSM|Ip^Wyl(5xboU`4ca#xQZv+t#tts-%ck~@xCSfp?~&>_gp~dr$(o7<#J0u=Bo9J
z8k^)we)&+fBu{8DFy}5cHy?P0l`SjjI}38|oV7OmUB>kBj||U5`)&$u4ano4{nqyf
zzm*#9(jqnu&lo+<9KXn_denz8ezIFT=;fEWHgBhM*OhK}4di<%V3Sy|pG_-4
z#mF2PbXO}M@9gI)R&2bZpDR7)s)eRS~^t`8m>AkQV=xGu`)?gtU1(#u!=
z*SpPP3{odc0h`6;NWjmspZ{ZHzTg)d{fZ?yp1b7IS9;BF3D8)aN{<}r+o$Hlh-~>d
z*|Uj0cfoI`F88OUy9?0p*~4Bs$W^23ft+*!s(L14C8(Of)7HWj8JDf>W4Bm)9*zAhbNEgb
zw#j=Iesv>mWX=U^0bTagI$hpV)QEc69ncB0blM{xT0H)okePD>w@mTxIGY?
zEy2(R^8Z&O&-f3UvG-Q_AMP{nJPzmW|D$HV@gEPyf6|Pze1iSzK~0L6_m`z$N3c7f
zQx3;;{%IqV&Od9$_Q~sTpLsbP&fEXz&3@y*7>xh28E5&7e5kWDte?MXWYYQ9&6urq
z#@c=6>zuUn_J6F|Z~Qld@!vM%ET54N&c|5X{;rWp=ifJDw$^!XZ8cwaL_2T)KQ#M|
z|8X$BzZqxwjC^q4j`^VY+H<_28MD>BFx+Qe-45s3ys_DDJU19`YQ|YUBOkoS40Ya|
zxr>7G!8l<$HfF2!;Xd>DhVyJbx3SUqyutYVW}M~8J^jM8Y;e8q3Y=lj9%HraIp+Tj
zikx%j;;Df<7Oe*6Jj?MLYwLYyY;P~_*j{_q`+Z$nqy{^kP`&qhhPvn00_UjT*ZVv;`Yo4NLnWT^9?V(;%MB)h5Z#5dY6LIMPAuz-&`P`
zawWd}#M1?+^%K85*~6wsM0lIGhY!YAX3S=O?+NtTUAB~uVVlU?mX1DO+T0uSNzUc6
zd}HTQ;2x=WeX{Z19?;wR%TMz0^XsCZ3sCDPzP4unF@~2PTeGImCVc#%ueDJvo~?~!
zwKjULbOCB@#Mj#Rfqy|8H^-JPKqs^D?f-%{`p(cXFmy5-@A?$(fl1l1Z3RknuOnCW~w)
z86X;w6W~k|QBkTO5|$}TE2y|o)GCPLQfqsAtJVdtrLD`o*4}%yUR(=mT~HC!Ds63Z
zKkxtfeJ4+z{LYyZ60r1ny*~5o-{tfDKF{y>|DQ86bU~f*s*h&OdhbC)ptRiB4{Ybt
zr)-0pPuvDKJ3fxMIS{{xK-r3$U(7su#Hr5-9Jk0SBs1L&AfOizV})T
zjJcn04a9v2b_T6Y^d1QwnhVV50ryzRtem2MIgl%Rf?99gh1QdAKiMUZ4NJkfK)EkA
zx_`IQSw25M>$c;wT-}bm7i?3WXV``0;pByZbF>{B>*pVv#f8r$(=&WKGX3m)yLS41
zWIHmwzin5hJ7z1HYnk^h$1gFGLp5fv`{%$oo@%C-JfA`E3eJH2o;6A<%h{5T%4>tU
z04E9=`rfa6meiI{>>*ddxpSwyF0h6^dD5<{yO#aE{=FGfO20E=9eK_OKd1J&_my6r
z_4bv1^V)KvZKpf)(RwgPX1z~3?}ETM>|jaIursg*Ye
z<*Tvs)p}s_5GeSuW-TE9(%@jA{Kfd03=eF+GQhLDxA>u(?d0})`23i0?s#f8i7SnC
z;!j=Y8oy*H^g;Pg-`hgMLh9v!EMq^K204q(nBP%z{~D|F$xi;2-ScTL13H+`U1KKR0dT?gF{Xrqcl(@`S&qg7R6v-m}u2
z%@3*Vt+?U6+N~|dH@M#Txh+1n!nGHeZ}*lzt)FtD#-E#Z`RN_C_p^MxFTS;Yu0^Kv
z_3GeoFu!LbpFfEBV{@zcqblO}?<9Vw~nI7vz+^?0st1Iw#dXp1$0u{`KkG
z@9)Qbc51N}N4DJ%u=m#B>MR?3P{xMT$}szL!`BBlP-Ch6TU4Kv4zpU%;?fReE^*^oae|pz{MA!d}uK&oc
ze|gtm==zIYf2r#)cm0*Fzpv|G(eFab5qjyZ+<5{?V@gIbDC~`p3Hd6T1HK
zu79HIpX~aly8h{||G8cNiCzCmUH{2l|0!Mn^Sb_1yZ+O<{?ohuGrImWyZ+~Q{TsUe
zja~nyu79TMKdb9MyX!xv>)+hwi(#e{R?R;;#R^uD{mxZ|(Ze@A@z3
z`Y-JI>s|kB*T1dn-`@4_==xvM^wittzuogL@SM!>J)Vm%Z`KW&Q*H}tz4wzLP!0!QJF(ugy4HK&83M)n
zS4^zm%APwX)^BCcD<{^s^7qDuAyC-!s)_Zj{L8Xt2o&pIJ+Xc(e_u1Po}6>dxc=Yk
z`mgQ!uj~4+@A_}(`hUOc|AVgobzT3BUH?s8|LeQ{H+21P?D}u+`rp*`zq#vwOV|I_
zuK$*<{|~$VTf6?Zb^UMe`rpy@|54Zf&aVGmUH@%e|LtA>ySx57y8icc{qODi@9g^D
z*Y&@@>;FL4|G}>RkGuX4b^U+R^?$hQ|I@Dj&$|Bq*7g5+*Z<$U{=ew@KhpJowCn#^
z*Z-GY|Hr%jPjvmC?D{{|_21R?f4b}cA6@@vy8gfF`tR=g|GMk{o38(FyZ+C1{h#al
zKi~C#q3i#jUH|{;`oGxq|6SMrrLO<)yZ-;(^nDimtiWfocjt4Q&(%wT&w<+NgTc<=
zCHZ$9^nEv1V^7am`}y*!uK(-#_ZsY}&yD1K#b4j^|AzQ~Vo(2>&}Y-zg2Tc8dx801
zo|t#9*ZyCbm~Z9(hYQUA>co62|NonqZ{@$|0`tE%G2hDn^@;gb{%>4h{x>J)Tlv2=
zG2hDn?F-ER$BFq?{(C3pTlw$1!2It_%(wD?cVfPk|9cmh|4$S1m9xH2^&OA1FhADj
z^yRd=el}R^jDhzjb;QqV?=SkkgH!uihT6{x)C*(n{OPZZ^%Y~in%cSZ9{0Hae9v?D
z_4$XRTAzP^!Y5~)57s$vzSC6b;}hAw_xXy*dQj6}PoJ+-T=?FTtyhh;pVgA%`=$9m
z-}pCQ7SguHI8giDAKK7iy!>Z}`CLO6eP-q_9s8*+I`_eid&K&(m7Fux(#r?7==)y!RS{?n
zTWgIP4?8YenDM-rHtY+&XKdHl{jJ}>4SD=$BmZyQkv~$(Cw}6|8a!C@l&rCAJ3g_W
zU+Rw~*voGAF2q>ztz5-Fzm5e;`P$aC0ojtdH$FBXYXzAJSH8E%}w_gNc-yJCycHuq)UbkS*8g
z{nfx3o3hP%Yd#pnyxBQ)&gB3*?O_uRoyW@qwvx>r`m46jdbTVCWS4*Z#%aZh3~g&R
zyI07zPHlhNH|{*!FMr#!&3C?(Zt{ChS2O0`RVqKk_6>o(WgDAoe(G#5X8v#c9LQfh
z6t{H_o|!SF>~Cx5;6it5tI#ep5%}`yDkt*F`8N@
zm#lkAU|r=_)Sr(hSz^1{S+Q2Guz$0dVo>>8xjke|Sq;cltfhyH*96LU1kUQ=
z;QdiV=S$+~?$k?x{`(TFHs{%4+`EmUFAnkrZ{zU!`+#0!b!PZ$eaU%S7CbTig#f44
zlkexx)-DDuH@}$w_f9Nu0M_D(Og0w>{FG;v_hgaHPC1DSa*V4%-mA^GdyUy!Yg!rh
zi$%?;*;02g`@CO~$rtnZt@&eVE4UL2rF<}lyM9g%oeglvE;YGqZtccT@!tF1+Fd;M
zcH(ddl-`CN87tcd3sTrnJgE-_D}lJ;mS5WJUme@~Qy&P(Q_gKvv%A6=--dC_9(#?8
z`QEX8A~k)^0$*@_XOJH+-^GTd058^=uXWn3k3;$jJ?^T<1b;l9i>uS7cV93Uw00XO
zla7t&z=LPcLU!=kb8$P!vh#B6rAz#k-gfa@oXu?HFh8#d*u56;Vam=r5BQRs{(VS=
ztU60%ra>-g!M{YlQ*;c*Jv>HyNpLRs?chj=`A~3eoH!NS9K1UC?ckvyLyMq_bUv$wMgSQ6%D)uPe<#zfIH^HAP6h7G(?QIc
z-LDZjljW|}7Qd*_-W!x`a+KqNoU6LchkY3*^KT1v
zSGm7_El~K$UL2@5?A5ZC*At3%)e>gYvoSu5z~q%e=5JurLE*>
z&2pVjmAClY8LS0#Tpq9mSJnZ!>{M4@zO?6w9p>F*c&c`rht{)!UB-RC=Ikv5YO>2#
z_AAa4S>`LRJ!^4;`<^S~WLsm;h1S?VwWjPh&u)B>T|VPOo;XkPj&0@lr>0#t4{7t|
zXmD|$RPGkv3mKCOwIBbR@kXxwYJ9oZDwf9B*!Hby`^)Lev)#c$ARhME>$yg^yXne6
zF3@F-Qn}i4tUbkFyXOAJ0ke)~+5f4Sq;aJXy%ki<+1~&1#YVub`R4%7G+fR=D>chdG=3Mf-{R~ScKFO&&$NI`G
zWA^xW+jgYJrFrKAAH~hFaeOs(od>$b*IM$8yCaP8uk3SPo*mF7mU8v#fL?cM*|nbb
z5bO-t$DZc|bjoG>w8?#GU~gQW&C$o+&Ek#+aWB8=0)Ek_WK-wpo1Cru
z#mDJD{hB~=w)_mo8<=1hF~f;_&Svv
zdowPU=K1JMX>XPz;wl&09HCck^f`h9rE-LPW5p9)`r@%G(3gW{hxTT6826b(J}(E>
ziWfNw4vq1Rj*_XpnM{7zGXx6R>%kBxt2VVQ1OV
z)^rbn;%t5}XX9Avx>NY8RKAqGRj+2wTIFO=am6M6)CIZ3<~Fy;FMqV%PfNi{K(4(?
z$*!2l`HG1(WLoc>xIcF0R^g93#phjZyjnw_nBEue%4U9((Q&RS`3~P=I>qmD#_=o9w08$Ukvxwv!9aPUUXp+>kMa@0-oBtB;*M#{>Jy
zPaN_S&-IMv8@}qkasE7u_Xq5;_ohIx_vL}Ueb&iEoIX2XhjRyYSJi$T(BuBW<_%sB{*`V|fX^U^k
ztyuGo-O8JTcAOse;m_wue!ecSUOW_>@VV!$&XRgZQ2ChV+1;0w&+5ECs-mCF^dB8Sf@&^BPw)pS)$<}Lv
z<-mC{R%^tCemU5$tMOXPMtaLeaVn0zuaIHB-&bc_zP37Qt??-xN#)?JN
z;w1)G2I8&oqx><(@5;-~IJ+%tZV%YNCbhM7wuZD7ew!=5)%>WOE4ym1{&Fw`%HiP8
z_uPHw@YlVi-~qp@!6kvh7q;_(9)0y@epo9v${zlgEymfxKk=wF`u!UF_^BQO#kxTw
z<&J>e?j<#w=L6+bzz(+B&vv}&tGBYfwaeb#E;bbRTiH(!8?4v1NB{a@Ay^6ICN34W
znSUU87VE!AtohLXzbkUHa-MDcY;EjqJ(zj6uIB#&B
z0^@IEWC}aQ7LRPepBR!+c{BA6$1m~}_v_^W+b;>qclC(~KB)_6Vd#1p6FiABi}BY9HmaPI6?P900zSnW^qJm2>DOw1P?s9zP(
ze`}z;CV1)Z|L%u;?o(bD-2C}ZeT45&cLcbQFBi&HewR%{+Dhexy?z#t3-<0DYaFm!
zo@_@~@qil~wK_|eTFm|`F|)pX4h-ol!|cxu`;Ml~4#nMue|+*A&s+Iz-4H1Bo(-(`
zZ(O+NrhKJ~uXP5mNV`3!Vk8EaecI8hu1<}s?bt$|bq@`;vKeRn9Xe!8DGu%5EM9|!
zDR%@10zOt8)$FbO8~f^#14L(4t51%UC*7eojktOxH#5*gA1{-
zmVWtiFgPBp1Z1*BF~*+qo$c21tzBP!luh=Z3h3br8`(s+eRZ$8U&NO`E!aj^$}4c3vA?8I(Wv^M@TJn;zrp&2q!IJBE$qT@onvkzG8g-EE8GcBs
zLuu~|=-3||2=EPJBwzAZDDT1<4sQzZf_HnAQ-QUW8`gP7@L?%nH=BI_?Rza_L!gv>
zt#0G==D)qZ3-9dz{j|xTr?rEu>QDJ%FO)9{-(B{I4|(#P4a;Mnf4c*F@JzNGw#Rx9
zKlYWZW8*j-VpuZeJPs5(rZ{%a$vhFTiOyD!v&c5Ghd?2#?j`%}Sr1+om=n8}PklLZ
zFi`T>;?92t5l6mNjOd$+HGT3OAAWyjF11+NukE{DYxvI3iZ$Ck_lH2)%szhfJg}+s
z?M$0&oU&KHc#@Bmr+j3`Z^lQQSX2AV+4oDCbH^*>zdH`_p^X=Njt3tLUZZAq-;1$4
zU^Ct2U(2O6L!jUi*9v>_)!WS9t#ToM&2iIQs2nfeezjR!cL1&xdN+&hluvxaEgTKV
z;Y;h2ef%X`4TppOlKhiM{>E*0vtZb$4V8GVz8_%S9&p~%mdoR7U$*=Zz2HmOi<63*^
z6c4^B+G5QoV>bkRSPST3!-e*+?_8kBMf!j&`pvht-qzSk$5K!}Ij{Qk%GdvzeD%yQ
zhF9(4DaeP3&N
zVvnLtN7Xl_jl)j~b_O_nNr1!CfjRNfmOK3L4uR*B0Uza~eh=~IzwseZhS{HY-zDw>
z1vhg6J9>L=&6rX)7e6>D>}}dLc3*3{`F%rheV~-is$0I;YwiBvf#eIPL!b<^Kkpk~
zY-xSLgRdgxsQ07GQ;Vti6y*94D8uZ}t##5Nw$2@HMOZf}17H^*ak|CCMbx-V$f
zk+(F;axT5E$OT1?(NS^Wi{HaJoO&_fPd$6}&2ROr5wimUKa|R;SEda(Q-375F8iK5
z?oD;xX6LTX6kqC0vE7-f_c5_>zwntKR|hKrZsZ0IJcsM-6tB+E&R{i=n+myfIji)L
z=?s%m`sgCJ*VUfqdhWB0{L)?VDE{zvf3dfbQNG=fG4HL)c6_S4`@Z;e$%gpZJ8J&v)e%Zse7_!uilHo?3szYAq0tT06JJ+81O_oNBGJv6$wzC-{!UlRavw_~;2Hf>>Dh6cX8&ArA
zYIu^nIJwwF%2xjKRURnLEjyfB^663+ypyug?=+LW6dVf_ez*2sl0L|ve-ZMu%XW3?
z5qE3w-RA4}r!W3&vZnSr`#UaLnBBvRX&3f2?Hc=N*X*4O+!uZpHXq;$f4yJ0vF^nI
zzfK3nz<&`z|(BZ7rxP8Xe
zp4aw^uQjcHI@iZBvdlr*Y5q{K5SV9!IkB$z@vUNC`s9`M>Rx`1+C@X446{Esbow0N
zPE=}-{p@M;)ciugpUPuv=vKGiK@90DY8J@7knw+He?%#16G0UyK(rw4-_!6!9$fjP0QeDsV_`nZ%Yd?QEsQ1iZ2
za`-`4yY4;BI`LW#_{Cm1KOguW_P=NHaB8*;fg*SHTY2wnU
z9&rSoEq@bk@Zo$J+uhW-b+@s5A^3!#_~rN6;8>sxvp+Xxf+V;om64aDrK
zfPL;~_K{ig)qG@QeScVUmFN0pckNY|zBFfc%XMq%SRYY)hxC&oDP99%>LY(7ctx$;1_Tr&gAs*Gv3Az
zXV%v~^;G=WwmzabAJSKb*`J%+NG2P_2B)6A&b_=Kv)(hs(4Dpr$oU!<&uaHE6|1Fy
zU)IQRH68rti=RI~H?=#(SjnQ#ed~R9C158x`-1}k8=(CxpnYvXhUd${fUcj;q-S#PT8oe25eE}J$u>VJl459
zk+!qMR?k9ytOVq;M`7QAS?k{K5o}}g$$$^!v4?N$bT6@oZfCpnw)c?re73(mAIs@G
zA9B0+v&LFJ91O^HH}Dm|#+08K$I5^DhJatiOXXdy`DpvXzB(IhQP_eX1!vY&UGJHE
z$C16-+d-C{mqQ1hl#*Tbt1>3OVlDRK#|C?h$ur}R3I4~P>G!$faV~3i1my8ayYy7P
zIz!~G1$?sByFL5lOU3V}5aJe!>Ozt0_Enw`r_U`efz|qWU0lk?&YnxWh31e;xJ3@!J#}X
z4(Y1A=sB=PUQERg=lCejwb}l(z*%(W`L!1CQG9L<$h_auAe3r@wDZgyHzcP~5SVCAQ^
z&WdyP*g#B`^Ku_(v3Nz=bg{c)j-#o2&b)iB
zjfF91*q$c^iZ$ZLCq*8v2gd^TtLrXdpJET(9t;7w?YgI@KNnO?v@aABoNN`7$7Nnj
z<~E55Uf5JI;D?x$Uwky*`&HcIeJN<=6wmg_W4zVxC@!ZhN6A$Wfr1M%a5w}?*}xv-
zQ#S0(I2(2ZtxdR7-W=389c;qy?x3}~^3NJ}T_3n}_-4#mX9GBI&Ij&S1HLHQ_`~2+1V{Gw}5AZFsK2_^&W!@
z_pJOkM(>qlKh^o~h{S;&^PBN)eh3si&dpkP$I#f$ajg6-z74k==f51e7sqrD%dG<`o}xUYD|_?CWd$hd?Pgbh1eimj#WK3k
zDLce?2$Zs|w?m#^x=EhbxfXB5GtKWmsQqrc`qxwALe8n_lm~L=zvbsCa`15QiP2$B
zKJYu~cK$n$mUC-x(XJJr#rrT;_W|8v$@j8rXWD)z%b0n5TSKRPXM!Dx%Bxau1@>$;
z|3J(|#d$7phHr(P?LG3y_*1;r9ni0N$ix~lE)VR%vAex^sdHq^Sun0mkLTfB>V-h=
z;TD(Hh$}nao4lx;WXp2k4B2->urILpT%gFYwZI%(&g%9DL?9rv*F8w9Rc3Glq;P=~
zIWPpu&4Cz-6F~P>tgAR`<5@l`3jv=ij+JlxC%cW^^-b*9;eCr3ejNzJ
zzT$uT*ru1P;{l%@GRC?6Ok(`+OpMdbXTHk&lYy9$C9mX0JyVKv`k+25Pkp|Y0}BC}
z@}zRBeYYQ&ZtfIr2jxY%R=R(jg?m4`$2C>6V@ak`HN;-Xk1Z`>FBCRYr-ONr+~
zuq(igm>mk10y^dc9~Wi_C~eNvnbX)Am*R(#Rj{!G{$TWjCRw8g;t4X){8
z2fy|Qa^;eMKK8o%-ZMTE*?LtVkJ#t;@8tkl_K;nE$pdY21#*mT`s!S=(f?uc
zsMHIAbu~w){#u~Tj{U)bfG)TxpvSZMlVb#%$UK$BFHe0%K!*8;ZZThSt%VbTn4AfA
zWaP@!F?06$Lz^!OE^t{kYePLB+2V7|C8<{eGVsBkhs7TA?-tOMeSvlSwZ>d~p61hE
z3~+xeP;L&`OCQ)H2XV|!+>~$lIublI!k1H9`?j==i%ad51LoOKJRBeA#fnUJ;OAt}
zp9A~tQ};gbZz-^sPCC?3d0SjoJ!DQHug0n#Or+F)cM07k3s3T9YW>j6;Xq%pmwiK^
zcz%9LVnvp7Xr9kiiwC}jK(T&zvwk)GHV*6&2Y0+U;Z`0y12z8Kw2j{w*uNH(4^^{~
zzZDC9v&%j?cshuR*_yMdi<6e0&En$@uvZbIAt-;f6?Rp=%02mOPvsjw!G81fR*trL
zT{*!PXGJWo3~+saWktk!S=wj(kyDs7o}DAHE11C@UN_cVGV_mpfZJ-T-N9`2ZeI6u
z?Z?er;G94FvW;`_ZUZTJ!i%z@XZP%0iR-g^_XAKrJTlx3N^29n^za$qZ%qOnPA!M@
zuL<~aMZnzRU%O&?aBSzl*PQ)MncON_xLY3k^80aV(~rBtO=+(LxT`s1Y*yq;jjyLo
z_K!v|yOsiS*t}=t^*bYIF8$>|OxP(VVx&yTXk%9~rIRl2&ULP=BfC9MTjj9xd@8s*
zhc(MS?m{wV*%fWK(WSIBja@7Op$9H-|GCU$s7X3zVg+-5yG$9Q#w{N
zHXkVbrNh0-U%q>G=wBI#LmPj&yf-$p-M%4E))CFgR-Y=`P2z{pOL?y(#k)bzPQQ5+V?B@
zyvR;*5&n4~n<>|A@dNQ68o96PR+oS*NuDebL
zF9=>1ye;^N;CF&g&WrZrgCEL2mhjBKxa+Pj$`4825&UlO%lXCa2jvU>4+M|Q|2O{o
z`DOFs>~*7W^vgx#JA>zrpOO3j(-$}H6zknx&Y1Rru`UkCGG2Xc@V>A1yHuWicvYPL
z)!?&&&q#i_SAIN;_opUXE@gO@dyh;5cS`~8P6VGG$j8l|clCKeKH+yyAP#bqJ;uoz
z0%e%}dCzwtYkPhD_Yc;{9ktjEfileg+!*J#dq{C++PF?hKe~4%l3Qy5J8-}zwvjn?chP69
zXUeI-9&4RnR=^U3glq#kNER}9(LGA7T)=x46{Es)>OOd)y&ze
z;Lkq$=O=3N;ZRU_mE4o3-V?|HxhiiwL-?zl4vg`!c#xOu#UUA&2l7iUv7w&Bea*I>
zo6Xje2^QpzG}IOCp!4H9(+0w*NNBrjkeB)-j^;U5x
z+4QcBGTF{Ib{FWfM(n*~@NFRw+ujGhDmXJI*VxM^bFEKu?&5&_%7?yY;{%a%`$7g%TyZaX>#@Wc`bAiIIBSF0b@fDYHx$ei><2;#L3#QgpJa%VZ
z9Pn$e91#n?4uMkR>WW#LC-vUINA{iw$SZF2?IrVEps-CIvrT?#(+k#;GX%;o`}6L1
zBy)8J`C&aQ2iuil{}3pvf&EH*Zpx0$YB^YQe49EaY^^ni(q0MX1No{HM^pJ@Z{?j@
zoY{&irS_7$FTklXHC}m32FQ;+WBWvEeAuTJyIX?WgEo)oro(=DLhn*=Hh57`^K$g+
zfXz1tekROk&lzKCxlBeqd(>o;RnJ(@_?1A6anbwG+if5Fz%f8{I<*;
z4csqum;D#gQ#R8_R_VjRebwc&GQQ=``{E=&-P!DaR=_4c^ft*;zFNx$TsV_rST$K2
zdA0F*=LzYr1(!zPds5E?r#c<*pB*KaJo)Xp$0zaP?{Xj>-dVst^KE>c1v$??HM!Q<
zM}En}8+o;6NLyJCYK>Za)O0NbMzOopc3)o@bT!6E~`jKz#)j^#F{q`9rF6^o2l=zf^zORc{^`U_5`LSj*
ze+~xbpPSExb!KDk?Cxf-J6+7guGJ@|#!IJm$rn2^FCXXUQdfM{+k6I4{#WPjbbQ3IIPew6a#rl{sxLMNgB`(Jo8Py)B7Lzm
zFTVAzM&_PiF>n^i_MW6a1PZzR7&-lzn2JY#|5R?7BUjwpJdi*1o(byyeM?$Xu)CXip4{XE7A?utW^7(+j6Jx*4ALonAgZEM9kUh$3;IpnmK0R!|KlP#P
z7t{8hmY2H%zQ}nwhbPZ!dEh-$oa~cxI9Avvr}hU2#jJq84{P$x%AZTUT)~55*gOe0_KHSvLdR+9vMG$)MFamp;y}4)Ek%wau%`
z(s!1wN`qeUmaF`iulQ^~x6)&c@sGEkdE){H#q&lSHa-VEIpa?YemMBe;6VxcwE~}F
zy<9&V)bGh&k@m9#@2vA9YiDVzeVM+;
z-vEh>ic3p|HaAPmV>gLfAYVc#S3X$KV`cyWr}O|
z7T4PJskdV*->wSe4t!NUzuU{+ItzU=-D3}82jY$#dv!c
zx_1iJR=YjRt&invy;m<}Pw6ZB*@i#*)axVc<>wG6!|czypGDR}n?vkXw#p$qu@M)Q
zL)!GUHGUQXF(-G*UiR_*fy|{kzjbGM2l%-OTt6{3wXPq_w)3%--`{jXTp^Tso2IY{_t_p=yIJ?}h&Zw*!hG4IzqcZ##$%dnmvXUo3I73XnZ
zaB)!2$hEZTu&(YeZK(6(ceGkKPx?<8>vnECZL-}jmA~H7_oh$o1BI6FtE13+#Oc7@
z=?vn;nRO?r-Gk1uSS$wK5wvk=ulwGbAy9C6MKB-GMJ~=C7G3-+&OaW{=SS=Owdek$
zrQ;)&+vdyL6F)I;&(^o4ue5RfXyxr(^vI<<1G&`N@s;T-9}7D?x7p$M|9d;0nla^L
zVaFxW!;Z%Vy&Y^6JLk|E=h7N>IoE2>UbXYL!_uyEz9(%m+zl{w7kIB&3&{DL
zKpAF#ZanuNmFIr-S2J!s+sI>^THpPv&oBMDJLbl|+&dCn9a!Ug1*QGY%iTmCd(=aq
z91b4c*?|wmT_k6}J_A$Oo!P1Jsj<&(WRQyAy3aq}-bdOyx?+FO5c5oufLhb$;KKeRy&J)8E2{w;cLsDq`6G7akGkw`$LX<`
z3|vh4gO}ER`-ea=$NtA$z(zk8kdJ(n_wQs(iuXJ^aUKyf8~L!A9aFjwUqH7#br$G;
zU3Ba7TmLobw|OTwD(@bY3vDzos=-3@-y9;noI;y@ZW8}hv^Rs4a
zEBCCIcX%ngkEAV!>RppQve|tm_-Ng2#lzt=E{>Md!LFdrB%9saCj<7fed?JYpDOR%
z_x81Q8|Oorb5`i7SZdFBjU9Y19{G+t_>th(0(PDVT5iPSMGqjvfzPduz3J2QKtb&J
z#qVDY@C+4qXUJJp%3ovnY4iW*(icaZIrD1qP>TZ}HjA6*LmRinaXo#N18Q;V-_Po<
zIC6pW>P}!U-}w6NW1rrSHP621o#MGTtvq~j))lAh=j&A78($0B{1&s%3@1ZsWi_y_
zjoEY3m&a|a%LcsQ=@~)sBaZB@xQOpou^KY3RE$3B0x^;|y*-bfNw{b3T`@6Mb{BWc
zS;JQ6|71`(Shm+QLSELGTxDy^W7+=L3)qf}_AJefeLS*_oXxl@9gn+!4!$VtbY|?U
zpIc|^ELZsIobk!}%f~)mJX6*KcW9j>`E-B&O(}ZlW0Rcw>=>dC`j1baK6>iknOaF3
zC+yoF90>4rYk>O#Tk*pEvp+ZHj;75IMGW|DkI$ZDvFFNw-n~J^$r|(as^^2{
zz&KlK-H^6|`=et%ZS^~EL)JNW^pit2-}$4>4m#jyz&>NOR{x5C9~GCKY2(YD_AJSX
z-cD=I2I71yAY0AP)qq?)oC_4TDy`3KFFCD^_V2Jb#XOWx`1zdhQ@V!ql~(RB8`NZ}v~=
z;G41)rzaa(EvI!3jFp^ztj>C1weKjt>`D3hbU+$tI`;?N`>cP#a&L6h>
z99FqezZZBiV@tuag4MvfY@Mw;IQH|;+?@aYVgHtl^*05+zu-Gx+%Lt;khWr6{`I-U
zzSB{{_Ra3ReVN-C6t`1;lJEYR(mQ1jp6`ns@mLIoKwl
zS8gS1Gk(jy;(-h}8t|W8WuJOJsAm9Piwkq@okT`^)`s+zl8tkP&vQZ9;jETS&lCPR
z6KZ)^wvbb@%Ffk{RlG~ae8z@AvA^fI^peHieqIcobRS}X1NM>!M}yYB9qCWqnRPc+
zJhN<;D^K2r?ydCUqtzF2=g;p=X&(rd0y6M(OHjYRqOZuUK_dl6?m)a93zVCK)j%9u
zU3?XXzf4f+9_p7K?Ms8p12Wwscs?7{d!SsAXSiJm+FY*u
z*q!m^K;BtT#_`}>ptyU;Ztn=s6#ccJbl_uY?As&uY&jZK{P9?F?dL<~8=2OTXfcE)F9u}VkB8DXq^(Tlyj9KDJd=4r-eeBO<
z&bJpopFa!uuJ%V-^GS@vtZM$_k3D$B=MM(fo(Qb9<{g1j`)cl088iPDlPRq{a>@JF
z0NO?!1=jAv3D*YOU$(U9IjZ)VRJsKR9-HmO@_W4>vP!p
zX9rgX^MU*GS;36~AC3h5zpYy1S7(k)XW5y;qdq&FFY&JYW`l7)u8(az41pqdak3Ct
z`}f?6Yo>;6|4uk1Y;u!UdbSG=85Z8ia(%=fvB(|+uZjN$&+
zSo@4Z#@V1f!#>{{Cu0bdVfN?U994fc<9Jct9N?7w;xG34>c<36P437coDP8^7W;z(
z0l$Dudun_~+Sz*1D+6ss&K(cLtnLwZ6o>qj!}5eZC5v1#tZVsa6F$f+8TOqH)W*b+
z9m_%SZrr;WefE;Urp2I_W6jdU_@&Kw$$DbO2jv5Oyf26^2*|L=3weC?&XIAKrCi`BtkE_g%pzPu;>D+6mQ
zR(J=T8ppYMIp9M*1Dvs2g6k4kF>)RhdBktJ?6ar+dnsh|O-?>7fu*OosdK51hq@bT
z9*<&Ne2Nq9YV1VX?81loSpg2ToiD!FTQO@UeVj)AwW_eV;#}j}Mmz_L0RGa&`we
zY<1wAZ^rCX+e@Fl3uDcPHm>?&B(~OxN9lD2jgd{>-mz}|!#DeHi2Y~Bd2z6QC7_?Y
zg|VK}e=c*1SXXY*`nYCv!PCvUV|F(N}?0?oKa-TghPS3u8
zk8(kIWb^lZuTP&H#dE!r7w6(=UXDPGUpJ1+>jGU@1?_$Hht1y)7N6x{XMlJ4rN%4U
z(#E_;DyOUu)TNBxvva;zAs1k6eAuMDED7n?F*8=Mo0_)pcKN$WhXDgTa^#$?kSZXru_1#mei#-b4#G`bS
z->r^Mn$RIl!^*q%X(mX>IxPW=(NfXM-PPde>Gj1oYB>Jp1H+Hc7J3k?KebyR#Y;Z16
z@F@0li;aA+o@_F23~CKMwFZBcGjvv74{0m(uzzYisWS7!{Yc&rDDvo*Ov)GUPD(pp
zz8mulR9oBsdscNX82_fs9}jK{#6aOAn-%-({#Z|&-QqzP&iHvOsMvgV+QpqbFAm&;
zL!fLXXPC|29YglB4i7_c>W`Az{-yre?oF)EVKlW=}Jp@nf#{K;Ub9Xf3
zV#x0ufx>TR=)_p#=3rp{7n;v!a^9VUL*-;}f4HWz)%9Hyy6OyE5H_qKQF(^yQU4
z|MiXQUo!UPp1!;^?_O)q&KuKLiVrpWz9jZ-mRpY<*Su)LhvMu@C*~@DzHDNy^5@GZ
z<|=<)JTcdE<{7|GKJxqNW8d>r|0!diO#ROdZXMevQ@>zrKOwbJywsWbiU}L)%zWj<
zT>1QxiMjIm?@r8>&tEk$*ZaH>JNfJ`;ZxIvHA4n%U4IZd&@Z;0_EmF4$bx&43q^+z5WU$q`_8mq%mV##m*4bZot2Ueo
zJXzT8u00yqqrN{N+g;42vg@X_7lYO&T*)8y?F?!k9_&}!*T+mgT6-$6rrwF1Pde1}
z9t^Dem(6qE=UsV)H*@ZreF0mFAGSO@cz+;1FHL-kTl(k_ua`}X-I`Y$T)Xv2O^JVfN<+
z2TN&_eM`W8GH~x);K|u|dw`FxneZDQFW+SRYd0Bx#U|r-PK=lRY~ur;*~ac6P;kH5
zT
z{@0lKAy9_dpLgr7eyyc%KA6(Cm7gU?tY4WJ9ZM~5abEWEr?sziwYs)tT&+*pdOnLK0b^e~=)2rgsFpgVG-u~dg*me%c
zy*AK35!5-cUTMe5UUHlt_l|w;HhHKn-ki}PP@Ka-BV{TcY<=~3My9?Gai=W??h-oX
zR{Jc%0h@|H?e!7tBL6i_e24TEcJ=4P+H?287Mv)2ryn21v9^LkdH>2FSNH7mg1$X`
z;@?uh9(FtTZLXAG8J^U`U$DRBdPrZX{bko&#?}IBad|LM{&ak6Qab1(v-0k2+U=dW
zl0F^$aM%C6F}6P2kxe%l^7TbQ<%2i?A4|73-sH$@Bga1P8hll>aVs~CIU{0g4=(6y
z`Tn}*InMs2pzg;ZZH2DaZ9~_5){$R&)W+&A!2|hxpiABz4A^^PV@FiY;>|bylf&lL
z?i0=W&Fn5aiq9c3l-?e^8{6vKZ+3^SW*@oPHbfZ
z-pGaiZ0^cf*&tWpcpx5UX8i}xzQ1A$B0
zzhU&V*2#Tx_*U(cY2%a*eDQ;k)(DB3u4`Y;ius
zOaC8?wrv#yb`62T_xXTtHwNwiK9>z-`x(Y&w#lhlJEX0&_R5Q|+lEc}7y|yS2W0ee
z>nskLQ^%4XTTQsBiT4Grj*{P`Qpf);t2n}zr_JR
zTi@ttWgJO=vu8o^z(4!w6#pS0zsA$NM;^N`ZV&hhVhHjU#|nGNB!i90@xYyOMrZuq
zXLnleef9kX`&+&AEA--!?$d$T@>3fJ=1v8CJ{h=EP6YBvElyVlE5TA=oXpnW`h3&s
z=XV>6bkDz=(#ziBSi5-n?6eCwsrE-&lU>|bUFW%d_jUhRTO8q~IKmB%oJXAK7vz9(
z&rQ7ce3@^#!VzxxJ|CZHP~_H5Mm-D~N1P}*PC{onP!^#}K~;h}%H!H2cA50BrQ@l@w!*BqYS_eXcn_4*$%
z?vdlg)4B0?Z%Rg{E;{u74H?$ZcU{)-zt$Mr^?`e?`Q;C9aGI&}&x*Q}+I;!ZtRt&9
ztXMxdV>qgK?HT(EW4$!i?m+9V9P0yPUHh+2pWX8BC;oCnSNZYc58ku?#pyfup8ITk
zV$j-pa$HZ}6#+Roe&o2%-<`iE{l&mOyp(Nn;#i>IfxVv$40eh^-Rt5b2I^iOU%n;2SlfQqwf6FWKK9^JA@^(`
z*47*f76P`i(K7=VL!jt`eM6uOvp+Xv;I3p<%`fs+0{-!p-Tb%yWWX-G&}F>zTFVZy
z<^z8HK@OA{kcT7l&yz;)a>FI%oz2lh<)ax~-oRoeSVT;=EUgWCh#>61wp`)>;H$0ok<
zy>ftDaZ!x%$6mThmb0@EkY`MO_i~N*vgR_j8te%62RI`a>dg3T0LI$(iS)$=r}Fw+
zx5#Up(N#X-8<%{&G?0UNjNY}7nh%vz=Ik8;rPlL>j3H2l*`IgM*Se|?Wqu{VBb)hR
zKhRbB<(Row#TMhx=NFsy2e`r;oDA5B6MJx?)~{R_v+|8h=btWnmjXFJ|IVQ1D^II0
zFBSv3!*O-^3-a1he-eHoPNkdvUcV;44n>%oehG+2pm~g`|7l
z2ko+ljh=B=1Y|1YkxRa@Iukf4;2G-7-;g$2#StfS0j|nMeBTn_xwoAzJk_(X=U0ps
zIa7AAzwEq_Y`nIzaeORL`uMR~A)l_+cmDEceMG96FJ$1Q{4Lwm{r+n*2G-*aU$}ev
z*e1Wu5}w5M^#NNJ13YOv+Xn;tf4s>LzAgo1SZDv$!AfAf&VIZ9H52=XtX25Nj@H&E
zq`w_s*?_a&SNYb;dsO=TXnkipU)fpy;IsNe+H7Foe4w;ki+6zy*7C#piWMCv19Ds4
z`mJt#I2Oq3(&@SImdiFcez%E~eF6FVg98D*Fr^1S^wK4l>8NvTZZTkc-DgzPv*cmp
z+}YIHeBw+BtS!;o_G9TdnABOwGsqGsA<>rm*Ja6X2qdq&b
z8DDf?7c2y1<6#ICKG=6Kp!-eD`Pl6KEt$pVZP^FL`CI&^In!;OxU0?89Vfoxyc(GI
z-I+NyvD33mn@{x&TN(S-RgB1h;+`zr{#p(npBBeHuFWk4)}IK($=desr+UU&W9{((
zKh7KL=-nG!9UKc@AG|eCYAyax1!aflj=N|%P~$<(xA}li{AG(mj@ZdNGUfu@Ry@^Y
zv}5*GjM+%WYQUGZpw0l>3fHDB?$*COaX*`yOg6C}FTV37qin>5BB$xZA=&hqE8f|N
zcVpIAYt3zAyX-fwZ9RXjqo2%LgDZBqM-K%H0ltPnsl8;`t8Z`Z@AvgNxHD_XFI%cz
z@mbE?*>R0{Y{redKrvtbl8J9;kX-hWYg~?*<5Tg=Z>9LG9BO}_aG@O9pZx~{=LW=z
zZ6%YAvgJaxoMM|CpjRQs{mV!3?%#8tm9f7y
zG*>ZjC(u82c8&L+Q{{z%|6PIntUPnq@QJVH_^Z5jqne$OBWd^FnV7ckmVhjGn!v7<6i;IC(c>ya<}~D2c2anS>-n_%3t|bX9YhCf!g@`2=^u~j1Pgb8qlE>2V~MGUi1~;?9$&(
z&Bv91kDePlf|5^euajJU@}YevqgxzGhR?M-1NT~SWUsz6rY$Dow;0ev<~2dd!iVwe
zgZ6u6e4Y-hBSRZs?k6&QCZu~gDBYD8#R>ge!Mb{8_UjI1ZXuY;3-;pe(E(p^$)@%h
z%FcR*lC57p=vR)k{L+Qr_L<7}A+X1p0c+HSg4!jK=CBMPK+pd
zWKG#dC)+!C+SM`vi31)7qt=`qt`KeC@{(8~NYY
z?CQr3Wo#jsiet&$o%y-I-uba^WmRs4wNm3zHiWzXKsu}6Q3hn^p6@hZ>xMRvdMP{tO5sa!2S$Q=TCpjK7`
z{wkGUQ}HFkyf}aRCULHF#a{Nc@of9GPR;H%&W}r+=f?eXt_RzVv-Nc2-9DgKoVJRw
z_4wV+{YTzfKsNu*1b*khXWYjIxGg*;?e7@5dN-$1oRvN=*ewsoC9}3XWVf*!f|mxy
zDi6|}$-<$y);Ry^kXr`><-PfRqnfu?{)pp0ifzYIyMN1uooOp&4;zfJ;aLISWR|~d*%AEEXiI%xLYm-=~|
z`2C%Y-(u*Dmwiuc_FR#1Tv<~-rg@%UpQY)?N!f-MZD)!-<`x3>Sc_M_D%x@Z$2CSz
z|8J;TcVrxYZfcyldw_~41b+2G~DD}!$c-VuCX@M8g64h8n$R5=mw
z&p3Jb#b5t9^6HGO1mfv_>}B=+EScHe%f<_?*_Q;LAKO=zt+ma9h3^Z*v#d&j>=rme0f|Wu88^;+>p2PvmWux9;AH
z19?k_ye&V=mfaaE`?Ti+>y26e-ax7KRd1$~zS23DHW}XYv|F3$VmrIE&CzSjo_7a|
zvt_K!har6hxA-Xk+^v;Q{Mal;ZM+}X#G9O@pud}@@@q5M_?hB}AH_}8e0R>}Je^y;
zJK#qlo6p5%@zUDN2b^z5E?JxT((?4j&39Fsy_0OklNc5+Rkt}*oT#l;iwE1}!&QM&
zd#i3`)V@|08SVlye21ltm*P)cw2Q|YuYS)fzAh9icTDBt;wXPRv6$kIy=6;po7@=!
zrM2^l^yU9r;Ec#KZSP@E42}dor{W2ZcxlJ2^Ycn$_L2RzI4-aFQ)7NNfqm|LaZ<>$
zpRGRgyW`l&hLZvQihpb9CfE1H3VX?VVNo#jItcRJrW$||0G)-FEU
zwUrm-Z^bh%>=&nYKW>yi2{*W?{%@s^OEPhdEAedC{QImi*6WoY^vN~+Lz`dX{?!><
z3UKp%@l_t;o2>T#3zdK3Q8s7m?3}R4vs7PhRNSo<&pQL$XuDJ7n7Oit?jf*G4DfO!
zXn$Ww&XiuV)&jm2%io{)PMraA*vMBl
z$~`*#9WMSX2lA+LFwJ}ThY$R);dnrnePq?1y6@=!f!I<0>;GW-*14OUpT&Saa@3WR
zW!EcW7kTWuG`M`M`C0d?t89N>2d6h6<*S{rvD+Z49dUSs`Pwokl{1nv`Y
zw1&Or)NB=dzpqQjVl!6n8pf2;SLfS4a&h5Kx1YTFy({aMf+0{!XCJ%DCHYN8{hJbO
z5^MU&+83Db_lt}3&Yu$jE{+G}%I!M?bM9aE6lda7oDFF!^^BnBSm53yul0pYzOb#h
zogc^W{qbTSTNV86nYA`}<1g-to2v2F-fQj8>v4fwJgo%!IKjJpfbVu*J}P3h8d$5e
z{hmv6&f^&ib3?czk|wi%gXjAr;MTNX7kqE<=Yg?L4sHmveb1s+N>+Q8-`LIFn00d7
z@QHwKd|e(WC8Mujl{xEtM>!X?d)-NNs@)%aXxEs-jk&W?tdCE9>&o8NCTFqzzJ{I7
zgc!8vRE)%z&cneE=Pq(*)jB`Vq+=yupFB{G2V|ZK#Bnj`bDxb$yY|xboonR{d2X=<
zFZDbuJDszdV;eh_t$dJE_&qt+m0Rp4S1DW6KptJ}7sKM-9C^hBnbl?&Uih~VsPWRu
z6fb!~wqlMARrC2#ftZnP&KO%Op5pu1z_~mX)IHX6RCddGcCf$BXVv_`FZ=7+K6O@c
zLH|NP7Cm$tFMs%XA)Dzao5`TR<+AjwWW2cJvpszNu|O%V+MM}t^Bssi@}l^dPkSo2
z-QlHE?$PsaA_pg)O=Sl?O6gTstc~NE|0e=E-34lVoEvNL?$3cSI_)E`{f^0*`=`kz
z%>oYHAzJfF(#b`C8?@jQoRI{
zPDp}F@;1GMW=FG;U?5h2N(d3$fB=SsC{YnHg8FBaL3G?5aYJzd4KAqYsN*i9qUbQ9
zj-n#!X#T(Nt@CtFUhb{#4sizl^FN>b`Z>#Up8cHny|*geVqna6JRtAtqGGU+{-!{l
zYTdqz0{OSL9E{_EpA75tvXM_!`(-nK`J;)Z7&v-!-CQ|HV*A$L0hvd6W-mYu<_03Yzp
z-L)97vFsV^+L$%1;$&aNR^06;XLmqu{wkNreXGvI`jPuA4&3YV>kboBxf9E!;HrRc_^q84I6L;$_kPB;Zm)cA55!EnGbkPQl@9q_
z4AfuEiTBn(P7Vj9dtATHt9|UY2Q3+LQ}blZb!+s~DJS*b&GsSCP72Nl_^=W|+bt$F)orU)VbY
zntK80*cOm0MD1U}4i#Ti?V)^97jnNXFyH5ZuN4QmqQ7Fknm!xHpO5QI
z@Yj0(S(!~$|5f8?-HGaqEn-;jDs0*s(0eGre=xv%ASk=4o{Fk{u|m}@S~B^~fA)wa
zzSYDMANlo;Xuf>3M~v(tYiF>ljm^ouyz3tb=n}7zM<$3HJwu@3tC;YeulQ~W)Ysl%
zTR=abwZ5(|%9u`VIlx!8=>yxowDs9kIb<7Kjh&zR`<`ka|91rHi7o2)v4MI5d&ww2
z#f7XfWpB+5>1)H}&wJ);eeAdVi`Q7^!OTso0dmY272kq6_0h*{$XF}>F`Z_QcxZSl
z4&;gl-ST)%>z6I!q%YTZ&8_WQN}mjCV_G$6&k$(l#-RvmTU1RUI
zfF10q7?TUmB%k!FZt5J7)#p>4@cZuhFAy(zwdeZaqJXdLT5i;RI3JKXe)fpFed=jzfX9B6jJ`(uXOehnbc=~N?hQ13
z`O?JHx|oWAu{_k+e*46!V#}toV^(b0+sC$#?_%38e(Wcsp3Qt*FJ9uLT^4u`ofbQC
z*+-7pRjew0a#HrIfo*}9^2<5>p&9QSJF~Vc5L*yOzUYe^ec~og>(wS7##bZvm5)REnrG0*!ui=av1TpD
z{(cBeZsq5UzP|xz)
zpQAI|e8|M^adtj5`YH$J`0n{4X0s?c3jsO!>iwYq
z++go~AfC=sAIq&74*`8*M875$ksHVp4Hezt;GT;y>8>eB=|`7J_N9FaPAq
zesossd!D`FTL}8t^XXV(&sMEsk5->`c+du8uK!4TuYWf!i{1yxQhM?+?evLiqqv))V
zP(X&g^_>Je=q}jD4*PCv{j#^}&X}C4J+`u|;#T<<
z0y!|pU$Gq5CRysA9b)Ca>Fe*UUHz4>C1fIS{K2fwpna-Wmcwr)SZ_3j7z#Cai*tE#Jw>2D26Hy!lV-C#_1QGC}2=LLN}Y8~Ah
zECli)=0FDjXVvI9S5=4N#P(@$hCDbFn?+A_<;YF6FIA#
zu-SR1<3J!k<|=j2j6I1&5K8vz(Tfjy!)7)v|WZ&*U`?37L|8@4{VkxMYl6_);)?I_L;rc+$
ziJ5vG^U%K#(64s*kDu*y3;~}??lfPj&MJqfJ!}`3%VRseY_KM-e5OM_welIQe*dg_
zVdlx|p&s#yi_an2VoF@z1O{kxsG(%I9!87~Cn
zn(yN}pYg1?@|6y@pAyIy-a7*R8?$9vUhS#(!9G9yVPECSc{J{^UTz+i+-wZLm{o4j
zS@ETB2>30YYC+={yDB&IS1s|U@{5PA{#?^H1mama;m3S{pDc2V(pfU_Z0**HXK&^f
z0y60~zn))1*2^bUE1$-+zYF?1fUU-C7t>3Fmjv2+GHPEhiwreO24BfL6yT+Qy?0kW
z+jmudVfRR7e&<{U(XHp237BS(%%q}_b>l+_uX=$59*ozA*fo}
zlD;JrXWq*yQ(XstyH=Qq!-D*b;%I-Q>WV`3BRgUC<|7va_
zuveVeS8=HvpOU$)fmoM}i_%wT_ALk2)T_Pne>hMpv*ewbwfSIYuqzP%rw4S(ncTC{
zxc}W8zKDCpxqPIDJoELvtr%V(^nT%62+Ci3Rs%5`0u4Vs=F6Xwxi53-V+gbx0y^lj
zMsD%cd3Gk31M%U{S%G}8)m?FU;EdKff5}@6)Y02o9obhuDn=(Kl}_pOiv2LuZLLjb5<#(}
zs5&rrC{T~?J8=?Ay47Rpwx<8+;Kvg`ag@^`(5?=|fUe4q{;d3zte==6D_idsd$9y{
z1%3S48ZndKui;O{U#_$Rftc=MAq%TfG
zpp|U7srZ|(_zwnY>(%*?b$geCszW*A1AF+-Mm%h)n3QemQ69Gj<7L_aKyh)I7>3
zbiPqKjMV^29?BMeI_rA^d}8XN4BX+A^76<73Cc0Kffw
zv46Go>7!Rn`g-1$F_VEY{b*~avfMaJ%6F8KcBbGh~1$Ja%OXDT^zL5639y167ETb{`hYo9cp
zoITUvSw3z4Xmg~}UpjW@Z$aVz$0Kh1IJNtDW9|8tGMGFkf2sAI3psRd-xg?nUe%5o
znFi-|+WgVx>N$I9_J3!f^*TS^YU%%$`swRU4&8}zctN19`dV@a<3aH}GMEdd@wm6}
zY!5tJ)q-bF)r9+S2sASBpmY|s|7hc~$$tEvgX`_b&o|E~_xRO8@n4nxazLm1w|Ly+
zFA1C{&(&HVzr+9JY4_}_`k>r6mii;T02}7WH&Ut<;1(h?r-ob`I
ztG%9I^#6p
zjnOVejJIp*w#+OIDj
z(|(?|nt4!1?l12{Voe{t=E&7*jt%T$t9nvb<=ZTq__iYu+qbvax_jxU*xpyUY$x{}
zQ{?ikY?~E#^JJ7yp5t2swwbfWS5%Gd3$$VK=UQD`$E%iW&))R61>zagj+~3R^gUC=
zuFe%3&ds@cPH5$Wz8)ouKXu0J+Yp$m=Y}{h1(iSgwaVXe`s!sRa3;sKF`qd(VPE-r
zb^4l`qN`*%Z{7{e9SZ6!tKTyMXP>|P5Et`eCC22_{dIzqwh*wDj3Ln2I<}u4^L(#3
zhyjqlJJ9~Fdxq05CS)r?bXZe6
z_Vs6`?pX79OOO7hpubCm$vS=FH_n?p@bUcMr^8HUy;~klKA-B2_P)6_utz-TQzzqh
zM*1rL>;iEp@N;*Y|A8sF;KO1--;SX2EN+hrwEclPE_#K@L{v;46UaIHs@C_U&kl3!
zuYLWPpXT}GjI!Z|;CVsi4^^-8!4PQbcF;)^5*1o>){&`dE5Sjbq6#dd;)x
zoS^Jw-@yPSkDnDw{q_7-H%HU8IXuUrOOC}?E{8yq$9;kL3;`R(o8CUA6)S#j3Hn%O
zIEmfkbkZtjMf=zttqv+4V*N6jR*@;R=*otfJeSOc=yv?q{T*pz$Wis0J=V>YQ@xf}0y*4TPYfRDag
z12z7lK+|W}N+9QCvfp0%7Xv&`4A@k0B(LN@Gkq~8!`ysuOAr$$e;1`ZzC5@rxFC2&
zK$d%~x9y6IX{VoFZGS*Ex#|%=d2Dl^*XL1ZYbjuB(%LN=4##kKCg1AiHo%Z
zfm|A+Fa%oZpS6_U!_4JJS#jM|ZC}aBjxr0;Y*f-`Y+xxv@w>!}OF}0vJ)gphF
z0^>UZ{w+4z@A_Q-#~=Vy*#4}aO~I~6%E+x7W^J|$QU_#@XJY~#wA
zdKM40`1z@WHPFZrTYfp`nmMxM@g;#ZHuBqCy>kxfYs-Oq
zOe0II#eU3Zes6GQfUoXSar)UAamvy}PM?$h?qHYwKex_){;+2pi(U?UwBqIGU?Pow
z?hbl>eukck`&@X$-TvLJ@9$D3Urehu@qB&e$z2W9oprI{Q!kH9Yx4b81(&uIkh$i=
zrpcWxKc@z#2O3|iRsZgb#ejY9ihai36*PM2|Ku2S
zMkrq=bwGIl4m?Os*L4`-Wg&pi$%841p%+wXb4CwsXxE
za)v-tNA_22^~DG8j=-3Gl|z(FKBMH8&+-837*+#ucvBc3AG#213Q9I!jZAtj3B;u2
zo6~<@P`-}+%+e9t*u*!n#;3XO$#*2xjP+2A>Ph@o0(^LO2D^d{f%CX0FmL=_c`tZR@bvT-0(Hi3
z_K;it%juy&EW}Das$X;=bL_e}Alp1Sc*oB`Jla)3`9q)ht1J5InM($F;0a)eeSMPCVcmt0Y31JoqYDQK)GKEo(hd>k8!vPyM1uLyjeqSSJWUOZA
z0_T?;&r*BHAm8&(PU-dk0a;rJQ1;L(Huj1YTomvf4;#oYz2<;Eb%qw`+#Oi|oxCg1
z>Hdk@BY$68$>ED;oevrtDn>pNle-vHZ0xDrm0c^D)0fw2viYW!?Al*4?W?(IGVQJP
zqWIV{P2Wj2q?NwXW3J@eTQ;-*bA#Ig_s1`{`{TpulO>+opC_LE`1eQSyGG;h$XLzU
zPv6(J^*!m!k9Ki{yd!w2wG-d7_6}b@_p&}Cve^3W*eb_9V~O)((A#)I
z_*OI5`}ZrIe_{h{ln0-E`u$ht?`@^m{RG8#S^l3nHDk=)>+=5$;Zr*`KbQU$|9o$G
zf0y4;CC8boz2BR;(&5~ej<0L;{36pn^@w^WK)qL>>KpYAggS5N89~LHj+Z8;?+d;=
zzqIgyKV18HYMsmZtRD{O*WU2qd*|<`@`0R;vVpC1IPdnz>C+ld`F2{y;@Ri*&403%
zXYtln|Mc#=uYKR$cVCdcGv{7XyVLT1`#;=$cj@O_#p=e)vrVijHWjn7b92@zCg_ef
zb`FepHF{Pkxep3{_3!VUzdQ2}!_Xto?sWV3hvG-op#A*#$`9N-hM$}
z%-
z#mqk_WAo>A^Z%I3ip}P|;}`#(neXLp9F4y#Um&rg{AJs-+8kM8Ub6OQUOv1(oE<7p
zcq+G#Xyfu-jvtXd^lRdW|FMmdWxUX+JHoj5%Acx#Yp|!$(qB0cd(Tn)n!93O@R;Dg
zq{c1{{R0<8+JQhE_cv;~p5Nw&Kyz03p?$3G*%{k*1sfW!2=zwf9uOPf7d$a|W^i-x
z+TcM+^kakP1}_f2DtKe?!@0n3s>K%uvF81RKW
zc2<7GtmKKQ{l>ckK0hb#3FFuenJ1fE^2sGne$ncvQ_=zc~|3M
zmouW4>nxs}ew{;S8|ocF4bKPkkxAB%w6Xd({((R%pI^B){D^pcN9Nhw$IE@H)!w>u
z|2^aNWzjc|*N%x5_qMHKSbo2#?PIHZ0Tny(nH5iW30?R+zug^TUE?8r`4DHh6K8jk
zxVrm|D~DoZTyg)L*8e{h&$8p3*fEZ0#ZJEY!as8dgSubq-gZZun^upfWS*YYpkh|F
zIb=?=*Bp8K0`-emUWTCJEB@kVolR^rW;-2hlUMPSPaspy76bP6&q&XL(pUbGRX&na
zb;3rdXW3Zp*;!-PQee-afZcTO4%qkhe5Rac1AXMtSAO^VzIDnzvej=r2h*L{S323j
zH?`RN#x8#Ju@VQe*bOD4Vs>`sdf()`x9_GY_L0;3!XCD63gnedWQsSx*~A7pvzPqR
z-{;Kw5U2$*$RlG`&gywjf90_Js~9=AeT+UDS?s$nvZ|iS&asVb@8!;lnf+|&{T?zF
z(>`9uyPv#%f1Lw%sVVZs4IkP3kx%2^7h@RLM$PqithuUh^5|F3>(xy8KZK9o`)V`Y
zRp-;{up3ibvU2Tu&18Qd7WB=GOw
zy)N)?IBJyrv*gtNTf-wpHwN052kM$FntU6>lNzoI?LiN04A{pP
zGMxjhpA#c>i`TRL$pIV79=WPm&8J__eY|+aI<{s`>vgC}t)DBsbD1aW?4b0DbLkgb
zHPYuI!^u4+24x$*-VZ+m>22MT@z~a5iHF#gUHY@)(aUCQUx!s={O@a}_lXYceCL-M
z(*7ymkDnVVu6PawW1hbp@l-A26Q9MvITB+z?CbYn#%wCx75A}i>bGi}ukVUZGSyYp
zw)x_lrt`$Cm!EaM`Z(2jEt|@g@?)v(ukkcLYR}mI_4XXA@AUUR(%<{EUT&x9KUzJM
z551q2Te`%FTyiR&a#V4u{bhHJ$9DI7tyLZlrGH=b^m(lqRc^?vb6dK~hw)likNkYv
znXYHyT>3kMU4fbc_ry7Yvt#{lNB8gcHXkxMpZSr}k$*qF>KKn4Ys&$-np!`3(*qvx
ztWbVj7VztWz`S>!n$K|Zy@h*Czs_=g6fx1qhsD5q0a~)Rre8A1er_=987gkt^?|s^
zvBu`IzkfH_6Gu+Z+UtTh2gdgm*?#1HCX=mvSd3zKmm1=?#vk=nv~1dvxl`^(^mqT?
zL~h)hoC`Hky2rMjkTr2*pZpJjR{W^_2LgFen`G3!+tb(V=kHj)Sdgy{)Rjh$yldp!
zQ}Lne<^Yd5IbKhub$-)LhZ^jkdGi_j`DDqj&;Ra>$2Z=&PU9(-BknPz(+Mt_SQfw`ChRY=dS9896CND&?=S((yujgG;8kdiYM7X
zHeTy&s^7;EXL*Op>xT6CesY_)*ZSE0+SmJRAAYrrl3y{~nttt(S8+Wr5D&HDT|hq6
z)?8qJ)rzq_YHWKz4qkgTzFAwZmdL_G7kN8_T>*d9{RzSTpnNbs9I%I-b^oV3v8~pZ
zGak#sBR^!7%tPtdT`p$U``EcN_62+)vwW-C|N6|qDUH6g(V9PAn(Y(YsxHvdb$^^K
zb{6DH94`&73&gyS58d+3=c+R~UJ5P`yo+jM9`%JsoITfSZ_TT*%7J?nFI{B1|1|kA
zSG7}Xc-7<(sAoQ~n-6UBbL(F_ZT9cNs|mbpv6pYg+uC?z8yD)u8TOpC#4LuO~o!7E8L+@6o>3*byGSmCom;ua?QL`cHR~zZ*l3wkDVRgT+96
z>bbAx7-lzt|vnd
z#poxpSFKbH(r^Fmfrf`{HY^9?TVwt0fm&8uy8?2-n*7+~e8{D_A<)d@t9^Jh_Ji2h
z??<`o&kXpaiEr(%G5h$y_KJDwetPDttM7WJSMTgy3a$!D9=&G;Vp2ZfRh#TBnd#o^
zcWdd!Uv`Vz!GL`GjV}nu=Ihl#$*LHT56-dM{tfxF$0?(6zjiErvc*m;%BKGOere{}
zCf<0;4tkFVTaLot-$B=gS1Y?p=h0*wk3D$loC_`u4g~UfNu%;czjG&N?h`!c2fuOJ
zz3Z{g$2D2IHUSmKM+TdNs@s~Y-0#SmdYZO=S>`OG>?*}oXDuVg5~KZ7=P7`
z+@g5J%zGOfd)eR8$u9e=Hu`w5lV7ECNMEyO&`GP>*_r;Xz<$8PM-cZtfx2MdFGjyR
zSd8Zbw$Wd<(0L%>qqvlx;)hRshd^VSeSD>-#$!6pHQ(^iF$CH$`E%_Yh~HHK|JcX|
z^|>*yr`|Qx@=8D!KaQ17vxogdpbe8h*YuOC-5FdLut_X6aS|^z!j>HY+qL_9El2l=
zo~87+bYo{!jGPmGutSWiF4zlopSy$oj_5*gL+~ZR?*<ZO^F3r^l9Q*`sIQDrQiPb^s#+4aIbg=V2{?@
zVEv_m{8y~iLB(Glmjip{K^@R54pk#~cL)4`VE4>qFTd^MN69QbWRXFhH8B~VcXd0~
z%V+Y=4JxiBzx0t^b7kA_bkC^XHZdLZ{@jRnM|jF^xo30fs92E6kFuf0rQiSW*ZYTW
zV^HT(pDeP?sSR@#Cv)N@9+e|9`Y}8EvzOtKd&inOTM6W}kL|JMp?oi&D{f^+ji<%y
zzU(>H7}GCS6?6KJR!I|=I*nlnG-qkhNh{sc&SB}R9FkGzx%7==cC>qDTq|mFQ?N7G6{u^d`0>*jsCR9)
zR4nUUWomMd@P+^5d3UFM?5}&zS>l7-h)2!SCkOVN6D*C!V(mQH+smxGcA8B7tpuJg
z_WJztn|TR3Ka{>9(5?=8-KEQ3aheM>F=sRVsP{Gb>+|}t%D*{w@>zbxip`a4`H?^Q
zm6uNq_{zV^sl3UFHU5|H7o~qfpw;udK8uNkn$qeW!n?zx0?!lA%Ksj`JHh|s;Df=g
z1pD#9(}NcVw*{{cek=IX;NOBzNMe_R^8#&u;2!pwgkPqehZ6(#FGen(mx8MTc4ca^
zc2+1p`|2}+{nqsl>o2td{Fr|PmlSkg_5nt*koOw+;P2?
z-nuX7px4q+bxX>fcuy5l3QB_KF>Q`6hRl25Ll%%NO>SFMaF|W}XjXcyb^{
zw+EW@A}3_i;XIOwzd)A0y{Ouydt0y+m=~-5%sFdwftvIV!|oFUd2nXgiWX+=m0wL9
z9u%mDKK5HO7W4ZHRXgIV-o(0MN`LD)_`n$+XL%#
zThr8*KAaQ5Hw1ovla6r=X8C?!W7Egr`4pz{yW;-w_V-oAbbMp=C-qwxjD}UIiO|zZvY{#o#`|3Ot#Y30(
zw%?lZ-q!QV!%D!`GXlPst^DV+_m`!>n0{2O`1-s+JnUHrD%NbQ_Xd3KaQQxCbP!mu&re3!}Y;M
z0e|gX4%9ijJ{lk8rEHm{`-bq0^CF(LuYAhXBtK=3c!)Xs#hk7Kf%)=p+&4Zs5Tj{2
zGd+$Z`6V3BKIc+>sq-NaL-CV4jcxX_jbG%VK=xRM`F(+!Ax9jv
zX>!z4*=HXe#%1HrPqDG$*7Ln(3ZJ-Etjo@`GsiBz@)_vGi?Y!@V9d{|sdOjjOWfp%
zf9i{Wa-qqkIFV7lu$3GXrrA;RPaj&k`uv(70(YLh
zbAi_9MoxNJ6$_M1Hk3a@`Wk<0O>D>@U#zuWK3+EVd-VG;8EhqkuiCN5C>zGIjC)!1
zv(fvUw^VoX{e^|d+7O80xW3E2A!}k-IVgTU+sEFr(K#2##o&%W!?!UgdA+|w=1aEP
zD8B9KS3dgul2vm0{*ZY&FB{W6a-Q(1cY5W8J~F4(in+da#{D{D&J|t9V&f1#XZOC^
zRyK_9u9_F?alh1HF5^CtcTJ4M(9ehX>0Y&7_Eenez015kJu0r&@bkU=QoBzNoK5R;Ui#FD
z`@P=LeY@H{Bz@PjqMc<-Z!hSD#<$cGh~k$l4m@
zW(R-p{X%R&*^S>BXMg3Ly?76_c`>u@jzsw>Zbv&i*Aey#WS(w3}^pS4e(GB@U#Hm(C)4C
zfs=EqzWI-WePUzZj|b-XRK64sfAIW3Q2D^4cKEC<26Zp>b2n$c?!uMy#d1E-`doZl
zmkV;#V4e4VPw&_N|6R{o{jVlgAFJqVOpP3^#+(Z^S#|i)*4Vg)ss^2Nbv>5vUK!6#
ztKr(;%QvT$?e4qn0X^FNHDCA0D{>gYo#4Fe3eFEM37#5!e(=WNEy1URZ(DF);QzmW
zd~kJeZSY0G&4E_u3*8$mnoMK6amB{nyCW!{Yu};Fxf}5Ez1G>J@4m!?_VUO4^!0bE
z_1yt8-`3p~?BKikX)?-|S$6k&=sPzkpUXb7@%1*`Il~6N^?bLD_{7W^&<+N4lCAD4
zhP~ci*7YM<{B~B{uUlH546@95PFg2l9L%|UD^~ohzFc|k)w3ksBk?>T{guEyyeZJg
zto(Stp!fQKZqI!_ZVgKQIQ|ubvaRecTJvniTXuO4Idkkd81SpkgL7~+h||${YQ4X^
z#9EtX*Iec=4IUQomk;W)^2q*r7ZP(elT&dM8}H%u+^e{HU#VE0nZDSPZ(VNruU~rP
zy4S-F&xMx;6~}as9(IgH3@}GWfS%O^XA2
zYySh&*X%3*>+Is4rt5fk`}>EDY_orwj`eISem={)R`*#imwXrkjZcG48lT7K!5P!U
zewvQn*3!KaUilLnt$eg!zCY7s8kyy9={3(!HOBt&y!x$uRX^r71^nbs&8s81JSV8w
z>9dnx_Vlvq_fMwDGRH6HiCjO&`0W(k`Jwz80`2Ocbe10b#KU~OtLtkAf~qTifS91G
z!9~FX1NzC(?`4QFA9@*;W3j8xP-5w=y_sd6c=&kt@5zB|tTNw6_Nzcn}|e0ze6gC_-72VWB07Q89=-awNFwE$|~
zw769L%ZogS@4>)bDG&X*tGgB@&zktE12wDFGsp8r9f^05zFj
z>Fbky_L9rqUT)nzwI3g>jvzMbsy_Gqa*|Q--PNWTRO62~`mGKR~POql8e
z8~Jc%81R%2^zzA^zH`NAbNIJq!TBlvvKudKX|%@omG*HyEi&hVX}Ku7{vk%Oxz4D3
z(0yXSUVZlvx#lhn{Y@ZzXE>Yjv9sxV|uJ!2asr7kXaXFJ8UB@}>22c-SfC;`GMYmj5O>SKn+@vuqMeO`q?5
zeBYK$#{4Je)r6#teY6+;J!)q$a@BC}-+DgF2V1X=t;}WX*k^ufY(6RAqdEItmQ8)^
zo|5r6=BI~G>unmxd|#)3Tzl$hH8`Hy!`tU#XS1tvfqGZ{og6l~y(aMcacZ+{t2{nD
z^I~f4)YdOK{e5tMwzth=2Ef$}id27cDHdVd-X!=RPN5rE1XKVHCGv>>81#>~~N5#wC
ziRVp$ob##p^oPK_cRae619$Y;j(Xows~=Ce@#DB$bN2`fXZ9E46j>?^Va;1IK6uYgT5%A-JpuWekUyRN7
zGG5lnV8cSd*OF6b&|dcSe^!
z%O8IJp>(Pb&jxZUUihq`w+EV7LCF+TGOeR$2B!w%Y~RZQF($X4ulm`P`IUfw?DJjS
z@8)IX{7`lbf#$s8E#Ir&tclAs-^X^2_n(}7bPj<=PRZYwKK;u9KQ!^Gm{cvv+baUT
zYqh`T{k)=bAO_-WFZpDV&rWTce7q%dR-Y_uWbsiu5RhMaC>iFeKcvqd``D-*>pt=C
z_g#`P-Q>IP*~1_5$;8hVwDjwb$Nif7Tx`@RUG5ESJsXFtyXWq!ZDo(UM%|LN6x6&N
zj{9Y&`dQD;aqLfS{KpdeA-wL3-Y@+P!Omb;urbio9{W9`#EkuFnLq9xO)li7YUHNY
zKO9
zWApE3im!Eb!6$LOJnFTiNil(LWyw{Ma7grPKdoa$DdY
z{r%`1LO&c>FB#-KHUAzaf3+Wqzn!0z?_&0Q&-v@S@2(h|
zr<2XvYw`@2?EhOgUe58lBU9}juY2;}wp;D+FN!Ht2~qs|Yi9#Qt9d`9U;^ihqT-RL=u?rrqkM$c_(r{sIy~zwNdBB*x5nr{OH5;8@;K~&u{bvjlQtaFKF}&8~vh2
zzqrvaY4k;nzPQnsGPBDF=+`v*+D5;&(K{Rcx<+3YdQzZ0ICx0#(BR}?zR^!;)Vg^*
zXz}U8DUG^AjNKimI|FrBpza8Cq0yyA-38{|0qAn0yBgio=p!3FyV1Rkp4X@|Y`?RM
zIL7&y=
z=QZjqn0E%y)kbe<^u|VSYV-w-enF#O)TkP^U+to57FDaL8bx2x=xvSO-l!V1en+EU
z+32eqeNCgUZS>AYU)Si@H~Ni@zM;`?YV?hbzNyhSH~MXjetV=*j7CY}D^T7@yGSe50Sx=z|-5NTUyJ)W7#?-zkl5ZgfkdeqLq$(;7X!(S=5r
z8ufd|_;xh99C}g4uMf0O3G_XS|2QuwmxlUXWY3a^2cD7o-c9tEgDfBUe5DTuf=>t@
z9NZM(n+r}2_6MthJJCCa*8h7fn={@T(1-WJ;POCQ3~mhOgBJwkTla3_d1>8q;cxPu
z?)e0>YxnO6oD=6RkefqWMvh;TZn}YEk_Op!)v0*pg#K@Q&
zV{z5LCb%}t_TjbflLG#*xpaDGV83;Ko)ECvo`(kb_Xg||Gw)ntbz&f1V>{{I6Ogwt
z_%DfLV^DM6trnY%vlEb0()a%4
z-1IienfTdPd=>xt*|2!Bl|SNgW58DRN0t~rBq-fw&r0Ux^Kfuo!1t3H^)5sAw%{3o
zcd<=@oRyrit)DBu$lV{Xl?_9n4U<3b(d#^mC%fr(HuS}#=5J1)u0Kq!*<5v$?!9VL
z-22+wm+?|SUO#^*ot2JZ$w`Bau
z-S|WKJ1E&v>;7*3+K=DgQR&&z^W5IeSrf<7_q?o~l(A-B?&-%j-zZte{OW1(nFICg
zImRAM-P_|i_9yY#b8Inz>tn9p=i<{cmLv102hO9hT=K8x-Cc_TUHIIk#+7GhdMOZl
z>n8-$)~hDTl_U2C8FvKywr84s*JXa1eVLw|A$F6==jxL~9-H{No;~Gn*d{ger->iC
z?wVWsj>FkbcVh2+=%a)8g@+HfY*>32r(66hCSoLBFA1FUvWqVDtlb&#n~h_A#b0Mb
z-H6u^(En%6M)yEWnCyRB1hZ2v%8nWr+1E((5r%yS^N1u&3}As)cCJ%*{{`JcF|pHCEwX(16zyNcs)I2m!5=Y(rSPI
z3}(~LU{_#I-N$&!4*9+!nB|+?k|RHVp8U9f*f#{))j{RI*F_&a*7Oeq?gw_NWBRTM
z#DToq15MueW(}meZCwB@SY$1_nf2RuYAbkc&^6wd#9cc^qu|E
z-{-mFAy@1W53!(k7N6LwA34+1viIv(g+|N+76NDg{jvFm(AA)x2{)y0-_}5EugyOC
z#7Qez-dFRQaJT(ci~U|P`5&X0^fvL8-_BL}NY7%x$18)LM?UcF4($72clOA&r_SB9
zeHHg@Gk8}rU(Yb{nAYcK>CcZ=?)6UhI~hBF*0rx`>z-Bht|qRZn0dJ?Iscj<_B`_Q
zXPK)#eEqeIdzlyPk+`r-4_Mopp{LJN&hcWbMBaT=dkPy
z-4%!-sNEL@i$UEd&N4naBl-ca2*|Pr)vlQQx%T%(sQb?d)bH~r
z^J{krTi5tboWx8miP7fZ5rO(WGtksJemdkuJKnkS^`nt7Yj4HM{U?@eL!B{aSQA5Y
z?vO_(P^+PJrqrG_bZ@Xb;OCoiHcE!vi%G@Wb4sf?6rVY|`1|63Tp-ilS9CJfCYjoL
zzR5K`_54^#|MWl&9}eWqx;b{4Bac4KnmS@fJu~=fUCiWGUGZTx0v;90u8L3DMz6kj
zk863YmNrdn;un3MCv?zHhg$qVik5D=4n@$*Le*K0$4Bt~<#F)-)p79t^*X%0Uoq*(
zJ0*MT_X-cD?~WJ$p1?@CC)ftfkHEHjEYc*MW%HE}{X=LC>hd`^EsM@r~NA%?ZUrr1j9sJM4n-6!*<&U(*
zH8Qb9o!A3IpqVS*#8ey4mELik-*d06)gl|@308ut-*hKBovF$fo7u+iD+6QaNfU2t
zw+80LQmfp!AFPWtH`zM`+SNhD%a~5Qb?)%Wg?+!8T#(({M7G*t%edaeZ9ShiWWCpo
zzvK_;Yu3d_TMbSM*rWYfcVBJJ_{;$BvDksH;{U(P4sjDt@#Twq`1Qdv1NRbNHwM}?
zKFq>_4+Q4wj5-5<+t$S28kze2onGfu{Jk^K
z`HbMXfkw7Hb${M9w>IZaxFqoW-Wn7i`uPEW>{CZ|4z1Z&_eniZ*rweQYzXW<9MtC$
zb7JcKz4W{^0Qm5{Raa&H8!!C{Hh!BeV<5P
z`6fo0y4Uvs{hF9)VpaB?kbd#heN-_h8~5otzQ=
z3j#H)m48o3Uv8>Kwm$Y@)y7=uW9xNcXt?q*pB13GUVp2D5DM|1Q62wrA@k{&jzoDaTh>NVLSunO_JV
z8Stym4PLQY4CL6I=X}*YerEdeJ#Am*^mzC2^}guq@8k7!?u>kAmdzl4oMUEiVfw+7D*<^#{87YF$I=fyW8cSpv~>CJ(2DaIEB{r-zH
z=7Sgyfp&F3m)Mu?vdMkc-^1=uwd+oIcUs#Vum|sF2a7?~;dSX>7WmG0CG@JG&T{Qx
zC)9IQe(~aCt9IuaIilyu8Pnse(4}7R{%-V$fgGDlNGAXOH@~%tv$%=>1B0q1y!^9Q
z+&(!SKGi#bn5yBWfFELTN>F|{lf56}^XT9oTfWq##_oD18uP85C;X|i$Pe}R{6M|N
zwIjb@UH%N2*YL8#=VFb``vNf;^Wt-Nvv&yah~fT#{d5k2Hcb9pTR)t>oKPV?es@``
zb6Yw1zSv2}9RXQO!Iq%%@tU@-F3-w5z3SJynmyWlKu6ERHuWitwN~e1yq`^C|KZr^
z%=}a6YACyWC+wVU4a8f%tA@z-_srt$Yv{Bt_GHK<-a5nV5f3#~_gTe&oVvGG(x*!e
z(7`9q)5@=!!7o3~O+-%47`bA3O{0AJ=PdGr9(RGZHP9u8Ono&PmnZ$3L&?pr!B5Vk
zy0a!${}Oq0_wwY<+W(rd#-ESIhkw1FefYN-cJkrw8EYS{4~qN#%)^Gr8|PtK{fN6<
zIYavbJaYkms>W_iUxM-dv3}ZOQ1!iD?Kwm4cQy2oplVMYmOOnm^4vh{*VLdj`;S(S
zerJZ=RgdW&(P6)H@42uua0i>y#EGxZ4BUCkLEN3x?8d~=+WrRie=w-I1L=$5?tnb+
z`}}gY%^wOb37m1%9DlUZ!)Ehje_n)$H(PHGJTKgp8l8&)etYTjta1PFORU-H?q?T0
zR|Un(E_psNps${l?7ARuPo5e|#$|!evgZBV^PEuo_0JAvtKS8~M_%pUoWA|+HqSS`W=d&h9o=bFy%@Al;uaSE_6Xm$KLu|wVO1~JI
z*Tl?NtM>*z(8CXWD?!DU-`3=NF{oV73qzm{lRwwi54S!U8(Y8EQD^b~$T1tliLbu<
zbQakue%h?~RXwPuidB7gTKSYWP2K??T6^jlGGtC;%h>nvnVcny-4*Ap>C<&I`E%hJ
z%V!%q$Ws5}UbUI-+)H5dYouHAt+=6^f8*XR0Q&-kRa9`b;nY-4?T*zIn)D5$!U
z_Y;DZz`Mt7!TG`5mNlIpPQRD=`|WP2_&fJ(XE)pQw+Hm;ZwuU|`eMZf{iVROMqdrE
zOMfA7=Jn4AP7dbV`1CerkM&2iaoM2W@s}OqXX;8yA|+8gCq}|5Sc<-t)gD
zV?GuCr)6CAQ}$H7s6Tx2^RxLoRr>S%-uyip#b5caI;#B@8~Og3@Y}y9V7GR0{%s7D
zuT|4>Nv9ZJl|9y=>>b)%@sV{w=BlRaEIAt`=OInEvG(@-TNq_~`CfYJY)+5T7g
ze~ztJJm`F1n{y`1w%=-Vr5oQnGuOxMheqSC&iFy$tC%?x;2Qjx*z}4X#9N{^U+yTqdo5nvR3ih)pV%U&&j;A<}>%%p^E_-3ynIf
z#>SG8AnYu&+h_tqU>cl&uwUOgMO
zwz2rrx3f`x^*+>iZ=2_f^+z@;9>%r)==9xHa;T|Wdma;P$_0IC=yxXB^ofs}f$JOG
z(c(((Ym)?PYK0%}NHIJy81G-r9E|s8YU+M*!YluB>l~0RZervPKu-wh##{Q$;Yab<
zS9|O)emTeEcc9J>ePH}&Bj3)60=~JY=_-Hp0gpP9=fiETd`nm+ceI))&|CU`FZ$@Q
zmo4V`_|DANy-&VpM*f@Fa8jtYKcGkby(G9iP=jne5YSC#+4rdQ)lkV@PM^$`K%d_7
zjSRRVuwt!b(@VBEov>wXo{ppaF2;%L@MilFJLoMt*av(T8_myx)LEg=H@>Jj@|lE<
z^O-0f`BDR$19RJh-tWq(wZ(v+{FXDZGZtGh7YF*D9;^i9%7ODsj+mSkTp5sM+}Ftk
z8T)MLOp;}<8hLKuKJWRh*OR%ZH}~i$T?zbL_7A+`#v;eQqwxoZRq39Igqj4G)|6b6p@#4-3>8nR3W~eL8On
z*eSj@2F1hI@p>=c9?!U|gOy;M8#Xyt?5Y|h+jHnaTh?UXMMxTd*{KG4S?WrC41u;B
z@M~uv2e#W&IWWc#@+xO?)6cW1=1UG48aZl8+aJ(hewBS>PhpuVGZ9|LERtf
z+MN1y-kfFn@X}87KD;bxiUom4(e`e%wC8)cL?+@9s<~w;qpgB|C8%ySu>6btK
zGiA)f&i;IC$QVja-7R#fIlk-;;^qT>F?XNXo9DB6KL1$e>m7m|F~RQ)smXC2R_xEu
z+9z#U^X;Lb)AFjmd{#ImAd`G~H|DQ9WIR`Q7x|wYxz_9FuM6q(pMU1R&>)R0`rSiy
ze^zd-X;%i92kL|0_V+yESaA@yA<*Oszgl={m`cuk#)&KtVd%G`bJZzaZpXnp|o{+w?!beTs
z)iU|Mn`Z-?*;sSxx}S6ZFJz7#>WvKdi9LOM=wZ`JV82=+bJ~7+)Jmp!S3K1Fr);_B
z9Qm9=*0w;5OLyt0ShGj|Psv^~PVHp$cdYz4i|UNMRd3_-NXF*KxG?ls&)v=86(9bL
zd>m#}NAAKn`{X`0vV{)sOu>LdWyF6)#%f4D
z>=EZ*$oE<9#?tYf?fWfrp7-X(?eU}Uy-v%RtlIa!_B~k1BKub|w;I~}wq=HIUl`ur
zm(R_Zd^WfnODWntarlnWcW1Y@b^Cyg?71%U^6RYmo>k=hUELXk7EX9`od&WyizXIANO1KcZ1JjBhEpC=eITUAH-S
zOz^O5a&P_`C23bo{ybrF2e=17jH|EimIJk=?GM!7!y|`}V&$CR-w~))t>lu`%bO@s)vdN+N
zAV2O`JobA>+8watT{&N5;1w^qS`F%+u+N?Ksax*xrI#lbWNF_%MOMkSu6C~vUK-F>
zvOlepUC%)^!9KoMtlWcquveYVvg4-Cj?=@(r(WM9I(@y2vUNWEY^B3~HDp}t>X=N;
zoV-ZIx|-Fv+k
zY|mJHwf?^E=c{(fs(E(=oA^5f8otuCA$|37`j#~wcGr0nGk)_2&lxj#_^)qZ*xj#01p)V_2lwnX)jxt;0n3dq;I_ox-IITWZLxsuBRLFL|6
zcSXQUex4aTCAcMcV1)T@!94%Os$xK%T!^Dq`N3n&`LI^C<~@WA`mBr7SwYDd($~zZ
zVf>ZHlhVI0Hqh1E@aY+|K~6ji#-
zesfUu^z8KUiQ(r3i$VD_pFTh3-u-HA2sC@d7f;1kzv8Pd?87%cEAsHb8SCt_w`{0<
z_h++o_qnCpIat~aUZfrE1$>lE`OdC
z9=UQCB?L!w?n!@|ZDXBsQn?<|*Gi|g!@+Vuzjl7GHHz@`=g;_8bJpc%2(+t%s*94@
z`&crzg>Nb7d3wEL8NJQ3WQ=XETlUGAykBd_U<=LcQ0};Tg@Zg@8=8Q}cAGgKRxwPxnw8)3h{u`dGno~?u}<$v>P6F^5A2%@sx~Ty>=bi$*15HZP2`HR
zy0Bh%=SuqQGKW{5G<~+wW$w~|-DIhM^Ws(1y1R;faBFaRH#T=!Ahu-Sw_jru*+uIt
z?amxOzj<_@E@iItqU4FiazLi~bcV#Oj|JWQ#Ye8j7wyWxJXw`XvOtXh8`-4&U2N*>
zK#cgP9gm#9pCPAgC_BYO{^(~@{oRe@`QK=@y*qX196C48ic|J}d7xdAK&Z_<;c-t+
zyyESm076b7po1UHi;h^46`O@3$3@>%-e5B)o=qMRu9yN#O!V%Ao%sB_k
zfqE)m@jfQJRRd$2v-ALVmcFsgY+BFevggx}VvqBFYamYEyNoXj+ySQs`vW$zeF!x7
zrTCRko711hr-pjI43GSObM&dN&uB4FH+_8%ZT&N6tnX^;pEYB>>i41<>vG=L?{ngK
z<))A8*6=b?0?(j$2TLZb--|@-K_)c`D@Ez!E>T~$nZT;Yk^`WgFnz8QL
zNd6@=*4?qzA2(xtoa4XBq3v^ia&q2}AChtYJ8~XQO~394aqVmT!i?{lTe~ORFUFpq
zav|Qv>QN5<=V<(a(fFOC@jEh>3x2Ey7Y5?|)uBV6sqrT@d+_$>
z)VSX#UqhhT_vGy3lRfTj?T$6_fHO9(#queQXWE(g)Es{Cerl(G8sDqKgYRjLZ=9DG
zwe`=Qv3_k^|C|}?PiX6x&RDPe@v<4~!N$2sARUT*t3|-)Z3;0?odsALG6!hj$1x`>x8qszdKG+8t};0bdlVcCK!++0Nd2
zH`KTOj2Y{XYwMpoW8L%J{%dBek89%_GEw>Xg6w1eGuvJ{xiFA-O@8Y<)}GJHT)kry
zZ_+gR{IwKXH6pfJ)d=4HvpgAUgZ^iA`j1uv-se|><$%5O!MGmq41q@ewM{
zYX3h*&k$(x_JvJee`YGT&&oP~FAsbMpC*srL!goOMN{N0XWo5La&Kt7U)*?)rDndc
z?fH`9*t6R9yy!UgxX1bN;7c0-Sx*L!7{Cq=r4+rD;kaaL{
zcd8@yyrkJ92S>X*$IqruOf9IrniW%#5pWQlReSB8lJvY6!`7i{U9NZRp{qtWg__i8c
z7^o4SU4}rj=atO{yz4!aPRaTZX!hNHjQd_0-XYNJ`?6!)cUyReK(p`5r|h$Khdvg|<<&5=l&Yn3VXTF0T7@WqhuWIs+7XO!rcL+55UY&hM
z%k_of8v@OquRcayJHk5zntiW1#(m?v`)fuvl2`fqxAfKTYdhJ~&gw0V?`s?1IIq{Y
z^*d**e@~HqjOCsYK62|l`Ns731Q!P0>6RLd>Gqs6XY8)9zqgkz@m~#!=gZO`
z0*zhYuw_kOZ`ZVao&iIk+4qf8_F22bA8D1x|EKY>L%r1Jm(NOHp58EH{hYS`A7-rA
z`TnLE>*G8>cjG;I?&I;==otcyU*Fv19W5Sv!#f0;eQ%ty&)uE0Oujq+^%?rzV?&^k
z^BCsjJ4APYkf`N&&T|k{MLGYaezK%kH~lkG&a8}
zHrL%&?J4FCS3T6lBk`!v26ga_ZZHokF9J*%yM+l=*tZT&yZ
zSeFa(zkSAf)!cW?SRdEiFU2phV`m>fxf}vb{Jyiv!@J%y-I*8y&A#u-zKXkAn5OIY
z%nyNP&vzfg9?9%eo)FZ^pVf
z$<=?Ju`VvwzkkO1I9Jb1uKM%(XESoQJu-(t6Nk4n`A5s$x#1lG&AuNv#(n37cL+55
zesIdZ`W*DEth)y;4CL%vLcK>V2A*G@EA`pP^Ta&hzdYC$ECuy>V{`f%ndW-A=4!8V
zGuOuW#?R3=XRhktA?a@j`0_*Xg-o`%cj#uLJH+}AXT5B8m#LA`IsT5%y{J`v{c`&9
z|07L?{7k!3zOeDVwegMX@N?VxkIq=Xq^5oJfU)Z@C
zTo}l;^DqRO*!@J4hj+a@MSO=qv+pO5ao-!mI|Q12Kef)jvhgb#@7o(MALLa{s=c@|
z^XFT4WNipE`ra``pEZ1%`V{w{?sUn2y?;0})_-Qk`tG)V*NpX3+xk0atdH}iPUND`
zo1Y_UI|4O7UYFNbWPS)Ve*bLKhqvsiCr6NBQtuJQbQ`YHZT+9`n{(om+xsK|N5`N0`5ezZ_ndq7z4v+Fgcykw
z`?&!ZY_g^v>W25H!8;|eobua$ABv|gz&`m{9l_o1*y7hmdLahKu!S;IRu*63IjpeJSquvK$EyV1oTzUto(hYoYUe`5-s#*wpmfr6b%4H3lM{FwsmlYtO**0_0cCwhO@P<(E(F%fnxX?mBBaGxF!uyufS
z^)zk_mhwK)cR?omBr)S1jqTBMe;Ylgr`3QjM)|f+%;yGNG+4VZ<|SJ;hw-=%
z>=8rh*}b#Y(-UHA_uLsh_Ad?iRK&!#->dL#UO@R8(~YtrH-DFUeV40!
z)lz+{cddzmj5?$7^-!k;=84Z1G(EM>HJ|#dueLDJJ
z68QT8LtT4?tol`)pUHo_rRaME?H(=q%kl53xC@K^V9?%=qF)~LFckd$lY>`!%GOb_wq@!gb4bv`dhZjo{I+?m8tjsL
zHx2ykudVSVrlU2l7^Xr-Eb|hZS8VX2qzlWBb#EcOB=H^%?M}cyAhGXY^dX7c^}}*~
zuar?cLtScx4iJ}o8}_&d
z-O)qdssS%lPxFRrd>P8SQ=OH$0Yf=!L%AWZr&kWh59L~0J>GE5ozv=YPKJK)SMN;%
zjLL(YFHc%d76j;%A%CbRSkt`Q<8YD_zk69v+M`x%59`5p)j;h&8!{z3Yar{bR2w?^
z)bkgw^{3tiI_;n8$l$fVf88Y3hQ5u>`TV&NpH~I1?E1N{t%Gmkp}%x}exPgE*X)8XkZ6Ts_gFt3T*z>*?Mb+BzWUk{`~+b3}kX7Rx_IEMgdb
z*RgGl%!L8vQ@i(zcVKVnlq=uPrE|Ex=|-%F$lCh9I_Ap*^t-yL?ScTqx)|j8HA$C@
z`_~}jZE=RK4mcx#j_QdoWqf?D9^|{c^3~aB>%dmkq56#ci~ys2x<2M5M~~6!nu@id
z%&MSkzjtQH3-Z707gsA&`@NSvUhn+(bRXF4cZU8c@>Ket*6{UC{l0yDGIf^JroG#W
z*Yo@Knd{!Qa?g%E?OogEnQuLvdgmD(Ub|mihWjrLx?;R2d2G<9Z&nZZ`e|N3@%ims
zemVRu9j#1+IxX|hjm%E5j>l&0ZSB*)KKrHnDD7da9OO2;a@_B^HuUO
zoj!AZFTjtIe{{^re|00}`A_~|H&Xt&DgU*Nlz&{x|Jz2&KQ`sRzLD~eO!;qYr2G?7
z{+o@wdt-S(o6pCj{I?qUSnkR{D&@buk@6R&{C67p)*rp%4DTPH_g@mYdUV)F-r->%
z4S6RuJUv(X?D1wgKg0D~bG>W@`CsnFhs4^L&6C%|yKOzZXE(ecyMJChGuHLKyJ?HS
zYS_E$@P+Xj1cr)TSan{5p5=-fxQ?B
zv3l1hTYA^$-;gJ_e7Dbh$W!+*Ua-0``<=x4;%IGb6Y|Rg&InLD-)HRdqkJ0XR{vDq
zOIOvFT=7b;UQrLf&-492b`oHe4L!HX^vaqX6kR&#og}~AvvaK1IU*tkXTT7bGhmNC
z)hqr#aQzN|J@=(v$1^?`ypqNLXwdf4SNr|{=ZNVZ0sOK)GvGI4-8nlw!0B*4{QR^a
zz&GXr0fz^i5O8+D#R1+gKgYcy;LQPV57;!I{HCw$J~#B&8I&J&8p`sgWUo$HG4y1I
zdN0|4-l6QN8;~9Pusmhux97u9cCR}id;gT(Y$Nn;dIx0xEq-4rzq2<&@851fRu9ez
zFjfR?8K9={>VPEya|4_UvhK@y0r*=5Y!N`l+9bf>n_iSle0lBl1AFw9J$+bx;rGjI
zOafrK#5?SxVXxnsaatqW_8j}_SiIp`)O&2~8el#nVB4riplNw$##kLd?#KXlm!GHT
zk)KI`QG9m~zPF{vcOLO~9N}BXUogUV_VMR$fIn}9Pp|!a>-k47{?rKHeSyEj2wzX(
zmyJoxjmpnzF94-HdZ(fhTGWn;D@Gnfh@3!9l3zF~W
z&L02#DtZt8pN2w&asj~U^s8~#H__~ODp
zdW0`8_zxN3t2_QtBYbto*K57}@0@&RrpMR!_B%U0{=(!tLp}aZ$#<9Z`1>S(*$98{
zg2%k;e%y7U*W4`kFT%rmyGc1`^P!%?XT}2=eWoB
zT|obyBYfWl_;OFXU~j*758pl3
z<8PjP_gIg=S@PXeJ-&C7e)m9+ziIN_Lp}bi^{n@z*NbZ1_OP>MsDt5-n>jsO
z_jeqp#+o>83+VZBO7d?V;h&ZKu^vA;`InFEKPmaAkMK`S{%IrpXD0vIBm8G1|CSN{
z)06+K5&q4|XQ!8+rzM}A9{;JyXQ#)%Df#U5_%|k>ogV)w$!Dj>e{%BK>G5w!K07`B
z^~qe`504>G2<*e0F;L$0eVg9{;h)XQ#)1
zO!BWD;XgY0PZ;4pD*62E>8IEE|Zg$
zXA@r@diJN1FAqKb4#|Jy2%m27h!MVT1N?`N@J~qoWg~oVv;8j|;UAm))gyfOxcwK6
z@ZH<^t48?SC4c1zf7|3=IKtm1`4?<}fBp#nnB0Hf2>+qUKX-)h`$K#W8{vD;@Xs0H
z`#!-xdxXDL^1Va7{$baCebD1yocuFK`08f=86*6MB>&VAzV9RZpEttyeT4tq5x(yu
zeD7$_f8R&=-sv9y=;V86dwh27_s;hCMG7YF{NqRXzGvt^ZiIhC@|~le{=<{6
z4|{xlL%(y@<2#r5`n1QtNAlIN$6t|rdF=6*Ctsd={KJwj4?X_flP}I5|JljsM~}ZO
z`SRG~Pm<5i9{-l)^Rvf4H2LiG_=hBaGQ!_7`SkSmADn!B)Z<@~eD`FJe|hrVBR&2>
z$>(Q}@7~uR{OIv7O+Gz6zVBZ9$@TbmOa6f){4J7yzzF}U?e~qePi|b
zdeVO1SS`QaE#E&aPw(hgdwt*Z`1-Z(o_obyjFSMvol3`T0d(9mpr^x`!ry9yujlc7
zqxAOcEBt$p@SO{MZ)k77bAj)T>+w%ZzIb~4-a`Up&G;H~D<%>3?MM-O)Y1
zb8D|Vy2p2J@!g?4zH^Je`3T>gj_;1_?H4!xjw5{M7T+D&+h6r_NA~!)=KdFq@Sm6b
z=XdzNCwkvpD`I`@t#%K!@3h<+z7GsB&77XC`+KT7FJteJ^CA~x?@-;9^z?F3wW6oT
zuUd`W)m4kJySi#YPfx$x@PF(b)C2gvck0MkcL(E-y;bgD{IR#n{enOCR@GY~j-LN@
z7mB0D_wyJ1W8WF};E(nCRPx8(8og-$*ju9~@yFhZx~urn^IzZEKeYk=*jrWKiFEYz
z+lM#ybE-EOzjx-;-y4QMcJ{ns`0CiR?+wFO#~$B1hA)mD-#doip6`0A>Ma`kmheW|
zKlT>iC;4Mp+2e1Xe0F+#Zy@{h^!VO5e0q9(
zZyY{7E&qt*jlGlZbbIM&_Z}W=y)(BW)_c9~U2M;wn2im+arHg4I%Hcv^zf+x{Jdm@
ze@gOw*Y@_GoczN^_$MWQ*$DrF6bV0A3MUYH|m%T@E4mSZwz-%k6&-ByQjymH`E=}<-}~0%JFoce=N{jA#n)f!<9nZbeCOGI?`Mzi
zJmY&mTYlX+-o}c!tglWP_q+N|0*uP9^G=8Nr>CQS_VE7n_zQEt_oc@_
zJNe#^9{;T5dp~;oGm`Iq?(y9>{C7Y0`0g8g@%H$qC*S?h<>m{e>jj0v1!>KjmZA{Kvtj8
z`yV5+|JjlK@rbNTqhc!`Hi@-fY%@BtGe=}+b!0akk=?8#yZMOh?2hafBeHkv$Zk0z
zd-sm)Jw{~j*^#~1i0r*PviBL0-Kryd-x1lZJF?r1$Zp$_-EKs7PDgh85!w57WbZ#B
z`+$z@14m>Z)REm`M0TnpJ9k8OUPpHRi0p!n?2aR{J9T6ij>s|q_*BeDI_ib>>z?UGW-|$mMWKZkJo<1UbMywBgo0~rI`^?}?2J~4YI?i5?j&m9v
z4;#^OZmd@>!sK*(=XGTLyyM>ts(hUvGDH9U3{ZNiW*4kSkMBmYUbqo@R(ABL&8k>0
zn?X+NyJ$rA;*RVkBeJVIvX_p?Ue=Mld_?w&j_j2qvR8FvA3h@ch>q+dM`Ry0kgYmB
zdPMdy9off@$UZLC^}|QvtofN@5@7f_P4D=(1pT~zT7aL~76%ydPYwTAA3T0w%eu8E
zG`42MTIo74=5#spdg1EM{wFs3!?kJIYdW&mj>uluk$uvL?DZYl8%AWG+>w1sM^?Q4
zU9M*amXjMpX6)S6*}SQvM~z
zj_k8XWS`TKeeQ_t^E$G(j>z8Dk$wJ%>_1AIjs4LiUuv`nqJQ*GuNb
zDN{e|zNBOGr5&5}|8ht6Wh1gL@5sJlMD|xYvacMGebqp=?x0tX$i8ME8}3h^f!B`6
zzOEztt0S_n@5sJkMD~px*n-SShc4Yr{MD|l1*}of+{d7n6??+@m(~HY0@89afnIp2ZIftvw;uRZ3t
zcy-W61n84VfV!#w-i^L!_h}vb#JWCS-|w3Iy`R$p*kO0y*i-!wLE*r>}-or*@
zmv>}WjL06|kv(EW_Q;OxQ6sWP4`eI0hm6QRv?F`Wi0rW)+2clJj~~cZ&Q2JSJ+UKu
z(unNI9obVxWKZqLo;D(TdaOGu>${837}f8NmVYv|u<=vOuLtquK@hJJKIuWD%j7WmMgBN}?YhF;Xr+c)&x8u~}^
zZ%+^P`!~0T^t&7SO%46BhQ6htuWRV58v4A3KB1wPHT05(en3NS(a=AP|Nq5dJb%;B
zA8hD%HS}v5`j&>iuAwgoS}%JuE)VP;JUjXkJ}0ohW8<5qWUh!g-osMn+`zs|hcZ{D
z%y}tueqet-F_gI~WiCjW3j_OmZ$p`fr_9QfSrypdT_ZEh(F2>9HgD+f$Nxv=Q2w7A
z`cn=4-iH2_hJJ2C-_X#HZ0HLc`s9XQ(a`%g^iB=ET|;lu(BJ&gy77LYp+DZxf7H-#
zZ|FBP^h+B084dl!hQ7R^&uQpm8~Tuj-lL(X8u~sBJ)@z&^}}`Z@sADt*A4y04gHRW
zeq%$ww4tBb(APBd6%GBchCZ&L4{hi@8+vX-Z`IH<8~WQnST`SEZ0Juk^q(~J>l^yT
z4gK_nzPh0=Yv{8Z`k013xS@Az=m$0Q?1uiq_t%a0D-Hd34gG5keOp7{*wBw@=!+Wq
zw1z&iq4#g-og4ao4Lz%&zxKU#AJ@=_HuRni
zJ-4B^YUr5_{q66r8}Anz`V$TPCk_41hW@pN{^f>#RzqLg&{sC}xea}MLr)rduZEu2
z(D!ZVSq=T2@2s1TFE#YvH1r1>`dtnEriOl5L*LTS*ERH24SilipU}|D8hS}X&u{3h
z8+y}*{_eNe&Bs4A^d}qoPlNV%oP5Xl2J!djXD7Cf_A@WMLt;NyqkVV7{_Z-wM`C}U
zAML*xfc?A-Pyaq9@Pm`~=g`*uYz_Ne6TB?(^2CQHJ~Hvqi65Hy*u=*tJ~6Ss3s2u^
ziO)!UR$@O};GdiL{KOX~UX}Rb#H$ng4z$mA9PIa?@S_qxCh_AFKQZxjiLX!mmJ*@+*P_`JjyCtjWSvcy*;et6=?C4NHU>i=t#zCQ8O6F)oga}(d1xcd8rNmpN2
zKffy1tFK>|^sguWVB$YZ{Ds6{46JVMqnqRZ$NlbsH|G8$qmK7ZY!0?gylvt+iSL*A
z0g3(hE##*X&r7@@@lJ^sCEnOR8S9UOQqLiYCyDQ9zZ{qQPDp%G;!_fzmiUasWBqeM
z@>eGI=Ogmr_dT$41Ye%G`stBLKRWSa6JMS9n#5!G>y62OYT}y{KO^z85?3ESFX`J7
zzaa6862ByI^<#U_zAE``U%o!q-{IzfSx&i9eP2Gl@T!_#YDgW8yC*{&M24B>rmRuO
zYvSD#@0ED(#QP@RFY$vDADH;y#D^wcmUwyM!vnjg+<(9G^U3Gx05npOd)mljkR0_r)udes$v4CjQmLZ%F)WiQk;~Es5Wn_;(Y(Bk{Wu
zzbEnUC$4+pqe*Y*{Qqsr{axap)jja_)K~XFeUA;#t-e>+Szr9|kE_4$miz9W_@Kmx
zB%UN*o_MU!j!pgviBC#g@7GyLpOd)0f2yxG)K8DfeUC|8{ZoBY?@+xv8~W~faq9V%
z#AENs`;z~G#Gg#;9+%IZ16F@w-JcK73|e0CHwpOQ=hx-GuAyHN^!_2|cjof~tHs;^
zYyNuD@>JbZn+8FEZzIV#=OU{jb2RW^H=osp)c<$S*-xM_2c73m0-@1{n
z__uA=EB@`8^@@K^vtD+$&-GzEKaBs=U_IdfgM6F7c!nIxmmKg}&EWQ2*Lg2FGC(Xa
z-(fz%_e)&4e^Am>iS;SD1&OP6i;~_Y@vez?Ph7QF6109~$B=7tegpT7zF83V;oS^ZaXWvlw8`eRP$!uv&>b9VMgdrK2f=QQRABz;g~cLMoI;_9F37v~@U
zsKgIRd`#lw5}%Oxq{OELrn}w;=W5r0s_n5cm%FwekBNE=>v-v)j%>-ZJ*DT&nDbA4
zT3sg(_Bwmy)Ni=|_*{4I4A<*>Nu7u5C#Jl6Xt;iKu2)Ru-_5!1ULrq?ZQj7YlB@Xm
z>aLQ%O#<#VkgeZo$?4FC(}T88?+w?_$#r*E>%+f(<|pUmjFfBN&+36Wjo#{sdOs`X
zvr>;r=Tt%>Apwk0E_)LqEBp
zAKB0sH1vrLy{w`4YUsHQeV>Njq@lm@_v`xmrJyU{ugo}i&p0=r(J(m
zuJ6^z-;(P~a($T3H#Gj&dyK%g^5=szBuvf#Fr($BCt1NzW_sDnpgk2Gwa^0
zHQy=s4yg0*@4LFA@y*@KCF|RT|N64zeOq}0tk+vG?As4~dfjvOmWF<1(DeHz)4w(6
z_fXF*&AuCQANwy2S@r?HhWoA@$cd9od!Kt_tk-?c2S2B58@T4~@S)xl26~?oJp0>w
z`^H?adz&u)vQPg00j_nH~MaC=%)|#-w^xh-!=7=-F96(hW=Lb
z>WA4ex4-%rA6
a@IiAPk*52Bvxm%dcodRcq*~HqU#*(l(hJ*?~+&?XzvfaXW}J^
z_et!$;8)$Neh1~cy8wTZ_^`w)65o+~jINyn4EKupus^nG>NBIEfApz!`{&yY{ZBzx
z-75a}8`8I%c+_XuN0qR5_Rq9$SX=!0I{i;SdI*cYvdR9y953IKhZC_kqcNY
Q|-O+W9y?tmHUtH)q-+n$o
z!}tJQb9F+)*4zW=x(~b`Xc*u9fUbMO8-j-M-5cn-KfE7k7~g$@u6xCMfrjzjGw8Z+
zya#9)-~EGz(cT3#jGhWW!)Rv&4Wr#x=(@M&Ck^Af$M9jadmdf)z55Ma_uRsyVe-x`
zew|@fI3$#XUCkJzJ;qtsuxNQ4^$1SR#lVAedV}v
zIhFe=H+btW-|GG9U-?19>ZYI3)z^33eQWaZfAQ{9
z@5Nbf80|h$|GHOpOB%*^&*0a6vq#b}zWWEi?jgU6K*RV;l7`WHCk>0ga{IbNaNc_sguTK2h#J`&O4T*m(@tYI>M&jQ}{M(6tC-Ltlen;YWC4Nuh
z-%I@d#J`{T4-)@z;twYNP~s0K{z&4#Nc^$HA5Z*=#Gg$3sl=ZS?Az|D0OP&^YIo0o
zyYBuq`S51Si@x4E01czJNg76Pn>38xE@>F;XB7MEXO-=fhVlLEf?q$w+&^g;-<^;D
z|HIuc-v4diPzQz2cb%KN&dvNhr?5W$MgHD}y^90x>chMG@aNfwzRlgw#>YPXlRpcn
zZ!X_ja|4EQuOGbx%GhBmHj=nIpMt#|#-F>)Z!
zKkd&Er=^}V5}%d$oW$oQK0on=iSNko9Qk?I&k<|twV|IQ-kbS-U*ZoWzCH0DCjNQ;
z9HCyHNjslQ{11u$G4YoYe>w425`Q)E*Ajm{@i!BHJMniDe?RdL6aRbS|4i%x;m?f3
zKdb-NXxr2`C-MCfKOpgg5>F+bmv}+qodO>cez_wJKUcgc;64F&z1P3k_j>qdeBxv4
zz9AoN=nppZ?=|#W8v2z%?;kbwcSm-F1H5Z<1BP~=Gmu-Da(*97&VGNVWz)dJJ=f))
zAumMkdfOrg^4xpdoVlF>3};TRmj+xEKWN)CJK(PK_lrG$^6vK>cm2NOCx4G<$z6Ro
zeIA`reF5u}yMFJsCLex}ARpco`KhXf`g&_2FCf$A7WzyZV-fep%4v&$g-O(vF@RLeBkMKN~)((Q{!#pWe{N
zH1x8d`7D;wxin>B>8`glav(pwx72#|!f`1#_UBEfCI5`X8~byjy0CL`;?;>SOMFFQ
ze{MnUuAdXvN}kJZE(H|`$b&x-CHpboPWJF94Xm<(KU
z=Aix@#o1?vyuprn*>Shg3CtG+Y?ET{I18(+TB@`6?i
z^kzxZTldUV%<(o2Agi8-=UkofW+h#}+vE>fJ+UI^YO_2*Pwf<7$j>GLRWJFjTHZ2P
ze`d_9hR=$5)$i7ri;>={*$pwTUV2{4t5(mBIiISRr7g
zl3tkfo=GoCdXJ=cPI~vG>9K!F((Iu5$RB>7_f49g=zWr=2hC6N?4ZSg<_CHz0L@SI
z!laiZUFUl5q~(P?J9YN>V6T|*mL_cvdcUOQ2)%#O>V7$aqG3ld|hQ;=fq{*Qln)EZ0J|^j>Cw*+vPfq%{q}jCp_@w0teL~WeKXH(~
zJ^=ruq@R@Z$w@ya=~I$^ZqlbFeO=P0C4Fturzd?)(q|<7_@vKF`iV)OmGtA1mUsSL
zo%A_LKQ`%yCHo42IkbIfdeHQu*+KIQt#8r%M(bPjNlEK-v^wGQ8?7#AaiP@}
zEe~jQL_aENbwSG`zPh008Lh5pbwH~tTHVm+2cXp%tqy4C3aw6Pbw#TyS|6bGEn458
z^)*^wp`VttzC%AXX?=@!F39U^v~!NWApq?hp`9D_p-Jllv~!5>oT4WIXy+R3T%y@U
zACfe`(E1Yp=A;i#+PTGFk+gG-UY_(blRhlzXC-}5(zhi2;H00O^npn`r}XWgv~!9+
zAnE5N?H=IYtx4~f^leEm4J@YT2N?Ga*d*ZY0rYJdaJQVFpR{#-Q8Ies9s$JL~t!dG*`uq^lpdNV@u^e5n5B7kkyu<;xziCf@RA_oU0G%4hji`6%Bi
zpXFcGi%#}-N`3N#en8S&Cw)@V+a!H_(%U9o=X<-Pk4yfXr0HR6`=r@H-!JJp@Apso
z7xUapPzK~|AM6J{O_3bQGvHR(z6cT2j?yFOsM&aXZ}9~{7+J(I5U
zw^!1~CVxrNb^i8Fy3X4^Njp#U?VB`=w$2_ow7x^rgVuNGB}wa3G(Yg!LGu&M541SZ
z{6@W77_ek0u
z%HHNlpOf^gq@7Fr&5}MhaGf=06mQeyou9Njg{=z$>fBuzbG6k!D+7%C25b_*7kXv~
z$dkEz%89w2L7R)a`gRUN}H==snI)3%2
zb@bc-`shJd56UyTdPbhm4-OzN_vrnT7B_moq~#gCH0i0N4^En0e0L9hYKA^AX?aE;
zkhJ=u^%8k`L+_TfI-!>(y)fxX(s~Gg&!pWI=sl9&CFxz0UYzvaNn0mxoqcxEyC)5!
z^#MM;=p{+Bi*|S7@0B!+CWp^2G`r}1lXmx`VSMXoexv0Xt?$t4fL@)nI-$=^S{>_5
z%W<7q`6pL*kNTjUA9~dfy?N5=f!;J}@u4?MdXjYAE$V}RUI2a0Ir@U6mnZGMz;}P(
zpC5qcC;Gyq#elvzX>)K%(nlq|D(Rz>z9{L3BzoAZ@}!SV`qHG2OZuFo
zk5BsSq)$kC%cM_C+I=IQlaf9w>64SD7yp!`&rJH%r1^z^TGFQ{4U3njh$gB`t4g{e;hNw7Q}%OZxnzPfA*y@#TTMI-=zXt?p=fM5`NG
z-O%cWuHIF5v^wKolC(ZS>wkQJRyT8Tp!tc`XJ~as>qEV*4~+W;Y!cvn<8L0IhUU(i
z`kFh>chC94!1oB?t9^WOKFMtnaPOQuTldNN=7ITPjohY5lSglsblIMjblG2&bosDL
z()_T0*Q6_sos%xV7AIZ4?U8i(w`bCPq;I#R0pdXO*{G=b4G&}eYO4_@F-XUpzqNkFE(Q}jLH`+e&
zT1T^krU%VWG&^WpQf%qxGe8r7sNeI#<^8x=%E26
zAJgeQYQaY}kau&sRtMNu{~p!yn4cQJZ}l+ze^r*f%Yzn!9^j8*J~KcJ*7&Z6`|{4dHLWZFGGo+y
zLCnQ(Kiy{qh?5u@J;$!PTpcjJ{tE
z06n%k3Ph)R={vG$@?xWlZ`SsVO$P+l`ETX;={94gbCWxn_T`rfbWWdK2`|
z@LpF(d3R4=5%o}q8}G61y;^zsMr<}0GyA6pTokAIwSn(~jmv?aX>;|Y&RQ!oM!#`n
z@6$%se`RESOnHlK^gMb-!0Lb{0XqfgDPwtn{(oUKj6LW&FV30y5dlXA
z*k|ti4EMO}?H%ghENC__4H(+&`C)DE0Ou@@;q;)t?dK=Qnt0eZt`B%ip0#Ji+&ktR
z8F;~(K8Lr&JdVtC%>3jJTXNuhvF}{D`-~d{eiVC)FOT?qTNyCSub6%3$ql~ul^?qX
z&}(cPx;`8rC*=7ehO&KD%;{vuxm_Mm@$**=>Yd{gy%htS_T3gRd>5>(2oMu}_YYWK
zUDel}#xFjw->W~Ja|6`Dd&(EO#Wc2uZn4uHSJ?D^Ia(TUWi0q!x7YXOwSgA|h?5`2
z`t-8RA9pBySB>bCC-GH|_zmO-$mik!`S$(Rv$-&MVv$Gn=A-X{hlkBe1FNlXs;eUT
z=LVJ&__CnoiyiWh2zmPb|G@Ks{}%;V+b!V20Bhb_|F$f9Hw46VdjBJ1KU+O}r9)ok
zrOZ(7yjXKaRwl3Y*Z#7pZ^rh93v0jmE2sPe{1x|c0gD2}xGI2d@3L=$qXY2B8;7nz
zYh|W_9?I~y_UjisYvQ!-8>GGghO%!A-rN9d`r}cV`}#L~*;OaJM+a|NU}G}y?uo!rqv_H;?RpdaT=1JyH32#)$kgQ-1TLLz5gSWN1b!6{tvF;p>?R);nz89p;ZDa4Swl5r!e^IPons&DC
z`1j(GeJ_di)$7^!(vf|?9P46ohYfT7vJv^0$9naUKCrjf^RF1$|0`+FdpNZB$`Scj
z4eTA#?0NObp4X%eZ{*O%Ye(c?m-61SQl%AF#U~2w>{3G?*MjY1dy?>z6o}W`OE;{
z1xMt%T)ZiB;rr>jpi6(dm(F(YoA1D0d0_9?V~<+UU*BwOqI=(rzM16HHxvKqSsvhw
zO#%$LI68oTz7g~`8E2o~S|hVV0C}>lJ>O{djroE%2{6>gT?xCB-GAoZyQu*6&{Hb{
z_-d~>T7Sq{)1&0nv*_yColN+2m;@MX@Q;pg
zZ+efP^)|^hceuFppZ=2D`2p+8tsXA>J)iX^9c0+&5Bv2yUbe4{H`=)nyPo>Zh>8Ez
z!&5O=2V*Qh`blq9eD;e?obv+YMQm!qXZ-c~OJ0913eXpZ{8#Pan=HoQn_B!<`0c#T
zO!_TBlM~Z#4`RAJ=!&m?#^JZVGlq8boc(WI&wlxpNAYbDusFc@tNhtTJ?pOF=kKgX
zms}ZazAfe4tMtpUSa%NCCBRzQ6=&twyqDjpSf@h|40Y5Upth3$BTTQ&zZx3W=$#u2
zYQk5snQt3V_9rnnhBf4;G1MUzI^=km^NMA4tUKfSz%aL8e)$ytT>siTzVd6GAJrTB
zdR0LEoWc*e{oPO`mdY(ZW(5rWQ%m{M7ZsmxgGqofj880NP79bHz@|7R0me}8Fn4NE
zvV3H3X28mTjon|e!~Kh5zgSE6B<9ALAN(&_dgP<@PGWA1?G;1G_Iw!YwPC+a7>L1!
zdh>rqfN?~CTpS)?&x!!OuspGT5bHlhKUgQLALzoH8Sv8VmD_{Br_+5U->`jRW>eo?
z9iW!(NqHIiy1qP=EP1-sS}dCd80@m&i^Vz6lf&<;qV1WR{5FQ++eK~?V2Hyvqd~Wv
zOacu44da*<^!$M8^I^Qz=VG8=PJlP%kN~}7h*P|m1bDmHulpjV)A=3x#0GtGzc@hd
z-!VAT^v?_6d&#KtH3OMC_wrt`I=9||?E=mTpjWT3OE3
zAJfP<8#l$=_=oV3jap~>i2>xj=iY(0M**w@dGhB?y9S=0wD@%bbVJ-&SMhaSFFpUliPy4y;_M&eypDrP`MKWd+JV(jp{A;jv89KG+=cApL~nbZT_FL*PInOoeH3*
z@*@8gpFLti^PRrB^Q;?_>Hl5Rmq*8(A8Z?^Pyg?X=@{5H=wgeU*jDB|Qn2=Hek1OV
z>Nmd9C(c@vtGXL2-(ub|fb8M`0(*3`_Tomt!
zkmJMQ0dlz_fY0(#Ijto2)*jeCpjl~dl=-87>*3!6Rd~l2UPE%$=S18z=D8z0dhtEyFw|M;)@S|5@1xk
z{5AN{%GP;V6g)ZEP+VpE-JwjrT78pPGwM94hdgf^urh$(?}@$gGPak@dp98CEXz&l
z{Jjmxm*4LTId{pJ?bdI-!iGFg0*tyx%J%z1XRi)yf?!YgrJo&U2P_Vd>z56_JJ?mb
zVXpWICIJQ;Lq8@KW5~nS0W%OW%x4C8L#^@G@3nxtX?XxU6`NX20*qm7Y!B^i$c~uA
zsDH&Rrp*HGNZ&ih?C{ZfgU<-yZ{?4_WU7XBF8E8P$K#85=LO6O80uXVw7Sqc?CDmo
zxLTV-z1s%Aax3>6qtkslrqjLPUgn?J>TJq0SRG*RZwIKe*!aIR-~-Wgc*EbJR$jcF
zGlNIoAm?2WpIX(o7rOG{?b17Zg3Fg#F<%)#N4;-H$J{sR?O}w?BLduS_R3Gm@`0@P
z``7^a0{Gj{Sra3Fwg@0&-PjU*yr-RW{XvKEs;4h?UJrfFZ}$&I)km_&{e*$8E7*H6gz!KwRo0
zUa_%P{da22`Li;h?jC&h=pU=gBzOk>n+1^9e{7)Xm;@Llb4TiIAN#un93Mbm)pqBY
z^H)tvM$P56>N))86Z7hn)&H9WkmYaXvF&s3A)BR-ALrznIEHm<^F1T@rFXb5mZx(}
zZ>vL&Mupm*Kr^z-f9fD41KFK!Mv
zJHVZ1JT2gc06hIB2Zr@!0rE*t-T$j%UO8aL8M`E4Dxm5kzPSNLt*K+hg&*#$y(`QO
zxv)>a4)<9jGdzE{=lSdPtUHBY>drT@l|HulA$Rrjn>Z?Ny-^zR4~Q(8qp%TKAE>6;BQRAb8}hyEDaV
zpV-{7`d2M$-JaWG-F;ARkQnQ}73b}pID5IZR{5k)-iGm7lUsKjKjf~p^#_eDwVWL=
z%#FS&JA8gp06k(f)J~q{QJi&NZ;JU;fc)T99r#l7B{6pw(ACNed1L<2HS|Xv%b%Eb
z{h1T%&Xqf|>UmzwojdDO0oKb$^)7z-DBiI+g0+s_)<)@o$8@-Jz3ER5tgiB{j)ol1
z4X8WK+7$s)0raW!?a^rFM+AsV4c#ZF25cT+49}9f$Cl}_Yy2!S~=b=_~qZynEz4mHq!7Tg@lEJB-)2;KsyT-x6&ed9cD9sTuP
zF0b;uYXD!=@A8ljw06zd+dqxu%G>Z~8uM#oZGHf~^3Ny!%nb0xxP$1i*MDn7pSfICe#I?!a|0>|
zlb9QPc~AfyYEkF+teER5`s`u1>WUUeonQAXxfKC;;`z`WjK`Uwqj%QXmeWaq!S>Ms
z{8K}D5Nq|Jd#-Xow))9g)K_8_>oCTO&AAxHc2LmtTj!&iKQ$b+*F8HwU_<%gSDT+d
zy94=|8~YCks6J*l%DXmSRkJ!L{CEG438O#!2HLn!&}5uhcZ2@-O@*(QJ{EtT%@=33bi66n$a?c?4?HJj_kqhm-7RT%j6G_(P3$S#yCh#8@%6^%zxR`zmH*a17VB!p
zkLow;?~nDNzv{6h*4p~KGwLIk&dbVx^_^2ZzZ0dy+@BE`?0~5N`NA)qt75(}I>lZ(
z`AQ$3rUK~1uQ>54w{<=i#hUdtcU=7Jx7Y3CcQ^DKf*#YqW$M+ds>}ODXcQ(8%@$$rnCq6Rq(TR^q?A_KIa{}HLHRL~9?oJC@ehfLA
zn8c7zet?g~S@q8D7YBH|z(G!bKdla|4t|I7+FUy=uo~zOd-Sv6tk$>2r7_>oK4;mm
zul*+DclF;6aUjIwOwSBZV|ADtz=n6!8Nhe{$bmf3&sTft;@c#^5Z}Zkh8V)cv-#&qi)=U2RZJR(58R|L3Y4i9i2)2SZ*-2!q`
z0kAbToV}qP14@rP91!$^T$4+_%?SwB^d5fNBTsbsvqH6G
z3%zv^;x%XIu)yNz*_n#T=Q#VPDU>Iqu1yvef%k#YCSJ$y=>rBFSEbC9^+@lU{BTg
zv{+Ad(=oVL)Zx#fZglctbpTu9qGx^pU)>98L>HNoCwp!b0&glnY%3G+9vj6`AF*4v
zR`;;AO#-T~syD0wHp|Dig^%|3&OcdsmA8#K!}L~uoneFSJ9>uMt9{F2F1Nk9EQob^
zA@9x6zjekok9nOnSf4pthXmjm*6rOfK)otY*5tHm=HK=(#HJqn;h(?%Xjm7nHRt2v
zz;gqtF80f%H9FnJlK{iHn3%-S=YJit^jsCdXS(H;P4#96cAm$u+KRD$_M(puau-~yW)R&tPkxT*U&o*_6=)854v>er~inb{pgyVfG=Ng)wb;G
z3F~Cxs`*f_^^!B!*Z77z+1z*I-$u?a2^`}CSH%BB=!f#dATu$EVb6>Jdp;F=d~ac7a?k2*AfHxvCeef7DAo
zAo`5Z@5?O(e`W`FbOd1sk>IsxF3hIL9Ufu-+ppz
z9&Zw(*E2`N`s5b`ch=UO-M68*oWJT3^{u|Kt_Cv#R_5HAA)jYX&-(eC1n(CGd@oxM
z8O&?#gw9&=eja#u2A!Gp<+qpjRk5d+_qqqG1~-MAF)LtLD|7X^IM;jqJ_+7`2Z*<|
z>s+>LKP~OgJ;rnl>+`^nn-Rb-cZgiUpzbnfVy6J#OdFEz-FxmZ`_y!1fcn&Zg`NZ$
zRr9vaH?Co?{aMOh?`FK!Kjz!KfYkw$0K>Q1Nf9J}`6G@=fKfJv{W7#?-COE6+kO`O
z)*S@j&|`b(9_IJlpf3*?<^{jr^YVcoEzIexwK6?=So`;c4r6F@ar|u(x%}S>zTwLE
z;k?%VFJLvC5pYU?`(9r;zxu|#r=G^Jt~%(>_DrvjtntI$%a26?tsm|dW9XZ^z`o4_
z?DJjYoRaZv!{@C6W(PRubw1KoOnMuPd1IWnR@Vp1P&fUic
z`rH|Oo0qgZ#lOSq=f8ykeAyU1bW8&HP49;EkduSUQvMNvw3n)AES5E1$$Cw-7``(&&#oSu?z^5Yvvp(#5^wm
zUFXhSJU^h`f!Q(VgB;i|CvwC8#Q}!jW!Wzm-X}WEt?d`!eA8q9BtUNP)_3l=3BJ6_
zOX-g3^x9>C>+WF3AnRV2GvBc83ULknymsKH`1$GH6AxMOi1qw|+;&0B2YciyFZ?2F
zT~1)};g_C+I(q0B>fs+f@=K>4`rmqYToJyn?!ek{ozh?yK
zgI>Q5&+n{|F^2VaXLxg+3q53B`b#GrY%B^O=kECQ$lalzYM=9f9{OPaP^RStd#!)Y
zmpj3@Ibdc0AK|jmp3m0T4atV8wQ;S?xjYShth2RKte5}GV=mt?_rUtAB5Cf+xdDEkgfFjrD_Qv{VmAkW2He0_3dLyouEh
z^JDH!gT+1xFqQ^Df$CmYfo=K^4KRjS
z921K%_$NlAa=|}2(I5QOQ~Vj`qG*_%^0Ur~e6P>X&)q>kSBJhyfWe<(Jl4={T=K_{
z_FQbJ&KsNS&)>lqR*v{g7u$4zVUDc#a&%y?zp8Jq=%*XP%`bK@6cd?5>&t4ZGr}88gb-+J5fX&qj>N4!9n}fbJU_m7G
zx`1B~SP=>y9*KTbB=XjP&j-9GiZVYEyf!}2fcLd7NB?Z%+&#MaC`v!zF*1lM_u(>
z&pw;>vnh9z0Hd`@&zQ|UgEzFP2fa1=zh_e&%BJ`y0Y+<+o-vzr&rH6%NPg!AIMZK@
z16up)o__bd|e$d2{7>aQ+v(#4pGM36OV#
zFH-?x;lqalW(1IvYksz8MNE?bxquC}t@CMU|B)U0B|GeAHI!qyg~cVee0EpSsdwaY
zb^yOF4dB1Kl)v;^SL;mz+z+(|(^)(;J@)fiZI%Q~1+Xv2lK_J(`{Zg)c0mBy>W>vM
zXG7iPrp=oi4|B8SAUDI`m9GrB{Q`cP-<8Y5(AK}i-~TLsst@=`u6lGT=JH`}*8n-x
z=hw#G$_bua)2$x-mPb0}rgA#0i8Va+xGLvzVXgM5|FAZE;|t%~+E}YtVmf_}_%#Wj
z7dGgxGcwG@Ydg6p*7TP+5jE9wYON3K)jQtGxdFANKWe@t<_iKMP18L?A04LzJR|hAe&{J<=m#6daIJic
zwwc!TxX|S+gTn*(z)$B9Mti5D{icUGS-zM%gM7p1+mmC%F!pmp|Iqideulmuc?Wzi
zfBA0od_Sr2eUHZX#U0=OdX2hua{S@WTATMdp^Hy)><)p|UcU9!iv#$I#;ZHxzvJ(#
zPs0As3-sor?x6l*KOGx;a+ftpDA&a|7gW$gj7~TQw`deSB!Zb^((BLp|K{
zRhOcd#M)GVeeBrhEtv!uMww+zTEwj|a4eCc4NvNrjI;ZGi
zkCXp-pEh*2-?Eb6LYR#0%k#a8}`;1@J9gn*LsW
zyGe}Y0o9kh^~UM%A=oFrQv%-D-M9I4UgWO__S0woOJYA2!}#kw#i!x4%yUDa&Xf8s
z50H27_JV-90lpP|7pRvr?_Jj?Qvs6zLyd}8^I^T@ly7wK?U7*@JtOHWljaNlr9ty`
z==)Vc8^g7W)+{x-{rT4Ou<*@T9&ktMxlecB#@BN}?5AQFe_PM{hd{5M?#H&K>NKn=
znV+_-xQN>)G4511D)2{1}VZ`OR+Yx-k&
zF7^ul(CW$G-GXlOZNJfrGsLI&?GTf;C+Z9>2pKV+8sN_+opmu>5x~z$fKmNoE*}Ow
z%z^w&0*sCArK-hu!@*&!-we89WxHzQdyVga4QGB{!0rJ{0}cy#NPshcZh&~ap?F^k
z;Yna)y8eNO{C{frCpP>qH~gaqeEFhl5@4|R&yD=Su{N~#m4?6XfZx;iFOB@p19|qo
z+VIu2?Dh2hYa{RHj*_SEYYkst7r&?P-x~QS;o3T>SKW2y`d06$zaCQS!vpTjeXl=G
z3)nS)&6@*e1~^X!zuR{}@A_Vu1Q^w?w`Ql3i|FCG4Q@I;QcIpq2C#+{Hu|iekH)blgAYSa^oDzus;*%f!z1jH?*dH!?XUs
z^}kV2o1X@pub*cBFLLkj-gbvMd-|k$$k`?XyLa`@>;Qe_%sWry^;gy2d30}I9iR_q
z1*{CP-(GgU8E3(nU}q9w_-0RT*!K~c(rdnV
zz=8m|wh!hn8_NSqFMWKS8^A|0Y>|QS$>P`d%j#S&IXr9L1^awId^5mW**Sc$UTa6j
z8o$`ptNb+Rux3Bs?41{|GNAG!$8tSfn;kR|gIuWh;sA29;@=0Yx5qktC4WTB#WIxt
z=WqR2dA9h-zlzzu;{z(@qOXrNfB#kt`j9`@1e_Y6zt0KSAz^8%_z?V-yaSPVx8$o0&CO#;}hnD{KG)}I(4
zrVmG~@?#I4dFg6vPrtR&*UOPJCP!@Wvtm}Gnpcg7v24iCe;M(UF8QbXn*n^Uwe|Tq
zC*;acd(^W0lk1w_8DGEB`0963e54CZ0{pB68|=$JT>XJw60jgZfAAO9^ZZi>`CSoE
z=huF{QdmxR2v9dZkOTPEoU50|g^xECK!5FB67vPQ#vUG9=3*fyXAjEx+`x3A0h%xT
zv~F+JMK6>rf93^{wGQkLx7L2&vi&FV@9J(JSl-G$U+A=-KjL*C$razw?9y$0(*SwZ
zo9-dD$l+Ig=mGTBd`Zj~1n{HY5Vr9vpCympC&2q^51Z}*d*#Bu6#;C*@=)>crTpOg
z;sE2uh+VD3pyrjYT8pK%cYywpKXO%rp&k4i1LWYC0R0iq=d^!(uiUdyvAH*{3J|ZH
z!PT!~bI$0qE)R5&n;)e;W^V+_T$N?ePd@s{P^Nw
zV`K79*D$}8lVLv(`E@=wlz(~-4KOCt|GUPonqLuX{41K@!@E&#Tb^9)5Wx1#06Ed~
z{Ht2&+ge`|^Qq(w_4jJQHvIHl4`kH4iCMi2Mt9XclghPYcja%7F4lK^8;fOWR(X8?Kk
zO~N-7OM0_dn7u#TP+fWJx7awkSLp8x;YI}`Z0uKM0fBgeLqurwr&LjhlnG}yO)SkQTD&BLge^&1+APqP*9`+Lv~_4r7YglrECwFkp`~Sc
z&_XFK^w9@&&!f=1-}m10pE+|iqmdG}Pe1P@KizZw=YRg^znyc>y)%-9EkYpRt7M#s
z4f;^R=w~b+ns2M+)dr6bUBBV!>f7Ph(GmDMk~2p4^-GS!7IcJ{I=meMws1e=IxNs<
zYyEcB;aMvXPw4csNAbHd>_KV4@&q~X;#cfsF6Jx=_<=b>fkL18-)x|bUV#9w-Ouk(
zy<1=&<{l6@S2NDu=`io5!hgt*@SJJU4;A(Z_$W^Z$Yo7o2WyHshXwS+KJxQ50y%bLkzstxc3GAa0oam*JA6m$rwsE}8j#nBmF^q|-{d;$#}
zILDyVK>-fzf{*LB1IRX?#B~G(5!y3>K(!=!Q%dqYh$a;%Ut*b+e3k}QrRX8`_LI1@cXcU&xwbvbM`ZILQiPP
zxuGL36ezUOmvuobtl#L^83@R<_!7TRpmYoH(vLpqhd!nkdJ+r#K!L~BrTrZcXxM}w
zn+0+MUDz|esRS@O<1BX6nHL-J3*-9)bbF)zK}7g$F4jj&Q!46XU&N;CgufOx2*ksD
zj7(z96`HlTs2&Kbgn}?Bz?T-V6`%+EL#M#{cqX!ui~R3|Y~(ISw%DQ=qJ!;UhnR%3r7Uj4tjHCd?-*DbCtjzOu;Vv+emJYczOl)B7kgQal@82MgEULBL_f9Am->B3KZlrm)Wd;3a{)J@)BNbMvm!B{W5{?3~^RKCVFG%
zT>?3XJ%Io(G3DAOU_169+qVxLm<#>s;|j0YLp=UXx&^wz2M_adE(!$-`voy#?LR2M
zM?9IIHJ28UiEiBgD83H0a?IBQ|0nf89=f9o`(-Fl&?P0Hi=Bb-@k(_uU)XgipZL10
z*Ic1M@paj%HZemF_JQTb1mEBbyP{9h7szZBXM8|h$kkAwAea2)N-rA_{Daz*JCL(hFdo*{I|ud1LjrLy9U03!=#&=lJvNUC2Lyfe5`8{;hw8|p-^QvM
z>3>33_7vn}AAF|M6RKNIsv6CY&MBcsAWqZ)GHk65tB&62i;u`-<_1M!i_k8>Lk^&m
z|2Mz!AA7X@?IQD&&DpFz3i27t+!TC)|M~^v`J{Y+etQIR>23jiXp@Umf`0w}=^0(o
z$Mo8*dO<*E<0W^f(_kom&O|SYxOw#b1MF
z7gux-1&Zm*c&nT4&;WAo5^faWNeLA6;oqU6yj(yR>>@v*+gSP-N86XJX7p^rcjI=-
z-buB|3+jfMM0-x{W5RvH1H!9?hlL*%9u;0M{FLxB!kdJ*3U3!q3BM-%hVa|M?+Wh|
zJ}7)d_(S2N!pDVA3ZD@^C;W}@CE+W=*97$XXI;PH>di80t?)d7z8C2FLg6K@-K}fC
zut~T~2!%a@*~j%pwSP#+3-=0-3cnz{LwJ|)4WUI&KUcUwc!|&@Y!a>zt`V*mZWUfC
zj0=3H{pW;t3Lg|cBK)E7QQ_mlCxy=lpA-H@_>%Ay;cEiFx4`c*@cRvH5SL3w?qh7G
z7Ju5!UVB_^>zh#hoJ9NFM4R>L^RqVnHaYFLS?hlL1&KCm-0#02(O&1Z(LLqqPP--1
zUX^H{m1wU{wAUosYZL9(MEmSS`%DDaqH0@ZD9Rjc~iyuQ4vqZ7qsuop82>odl%%{1y)k|)Oy+v8pYcNicA{fFnHPCu(CdYX_78e(buUZii@Y(&d~u@v60dDC
zEoK|kS1)G96D+}ly$1z+0$5*tg0}YP{F3ZnBRaWAo)cTnp2x+E-fd1#a-MeDYd4Yy
zf4j%;%YT`Z-{JKyM_$I`M}DW*_T^uTFcso&KI;;1BfoYpgQsU1JiW`{>01U*|1x+6
zmccW)44#e4;Muecp3TeP*;0pxebMrhy$aA~?`DtY-pXD^>@SuK+qY<6l4xI=Xm3rl
zFH5v9_u3LyUMml%PCBthIEVg-&?>YE?6Fs99P|M})#xl8>gw<5YF5c(oz;`KZJF}O
z?ZOgrwl6~te%m2FySLE3GSR*&(Y`v-4ioL2iS{*#_E4fdoM`V#w09@kdlKzy6Yaf;
z_H|xc=9Twv_Q
z@}GF71>f)Z)Q^QyrJO(XQFaUX{FMT6Am+?NF0vlmg;1ba4C#mWodR`>o5}cP(J1gF
z_mN)^twq2N=7s0K2^5p_|KlI~hxp?w_Fw!&F(0v}@t+?%`rya6+8vX*?wZ7BldH6`%hndOdUD|F5qbq|$O+63KYF7hSM)U4
z8pw#o7~%%sY5_a(J-p`&&?wYRM`-A{MWC2Gd_p-Ovc}&&Z!~L1B5vqM+$ivM
z3($zkkieKEKQzk=V!*vG*|zbfhn*$Jd+U3Rt78W_!`#?|EXzU5k9xXX==hO|E}V5t
zesXSdfj(QSwdO-V-xk&eV|?Fm7P`}&Z_eOE74*b!wPJw`iv@Ly1J_py3Q6{%6znb8(gCBG&kh^+CZ`tUv!dGTduI
zf#UO8{;+>g9u|lh@ufT@^a_k;EfHS|v4GF=gB$@q&FW*KGbeiHyn2u7$c7GxIiUW%
zj`?>YZlUaYrto9V8l;$yXxm;&KC}q{eceQuo)3KTyV@cnc|t;qgft+_`2
zzgc>Q&j8p{Z`@0l==1&GAwCNJC+G41q`TUE#J?ZgT7s7tgaQTM6Dx~Ns5-@uiOpfL
z<2_OclZuU}PCq&Te{O$2y;FS@WPUIA(?+okrQb8b4bO0#A6xEK77zS{Uz0IoT~Ykl
zgb}4WCKih}^_d*Y593eDZV|8Tiz(Fs_f2vPzj4oHUao+B-oAU&uKG@aV!6TD=RpCR
zs56#6+Bw1WAs_l2U4OH)xFC{-WBZ$KD$J+yAQ4|D|um^8NAeP`}^)u-eRH
zG;BHd^A#Dt;bhpH4=37z+W6vJ0ej(V5q?)+04AR1kFV(8k1#%H#QY&gBOi&I(Qg)=
zyt26Y^`wl=;yuTWjbhZN%kNts8*n;0UgV>ppEAw+j23PFkYJAjzL`7Hb
zf3(-T>jrmCyK9HLcDgI;1^!-lB_C)Hy6Yx)z1UrO7NGw!cirZ$7wO7a>}D;!?Tb%8
zeVzWs%<{6t^U2Nyc}Mt9xp
zuIP@8wZdbP!QAFYat{5UT1Y**5|b#mb>;k$cWw4L{KfsA_n|lI`rSnMU7oLzZR7^`
z58{e%xDpH23~PNvekEqCx!q!Zxvs1O;)EY#Y;U=1N788efS
zl?-Gi=O+h{Lt(B_@iE5d>rxxOq-<;?*T|2ryL;Lrs$+Afz!(a0b1RT*ITdQ$wF16B
zB)m+R6lR3u!h-_yJtn+SI4S&+a9Vh`@P6UbG5HNYUoKeQm~ZLNH|QU4&_B_jf3iV;p+W!M
z4f>BX=$~rPKi#0e*r31Epns-8|2+-*XB+g-HRzvj(7({2|7e5$V-5O`H|Rgnp#R04
zwlfV=bxRzpum~#
zq~zfb-)8!GR-pgQ4f@~Gp#QB6`hTH8|1U1lpNz-b#Jk+}`Sum?{?amecgbJGZMQ(o
zXp;l9@v*g`kpsUhxwT@6@5#eHf%4~i$Hcv-U%+N?sc5>C_y3<)n>?rBgOG{}&)Y2m
z&)dJE`FP&$CmB?36Ru@470XrsdFXQWeLv$*SAFO7!^gxDzvHJL)?AcYehNkZZUVhN
zyv#ZOUVJ|wW6_YXvg{EeHAjVVl7Ia-LxO`;V$_Ih|6SoMtbCmqL5B
zK%1CYj&s&zZuWiV{v825Rx`)4EvU0MWm`6&Ti{rq7riur>pd;3A*zuI^0
zu{$e-D**l@?)YzyKrSH1a){5B{2Zcf`NH!D`9Ur`)BNexSPJI^9#fc`tHsNo`vTF4
zHTyEp*Oo)fZMv9l%gJS)#ju~T*pD54J~0<$L2Rgh)pxAgl!j;!A-yfnp9A6?oQGKm|uFOZV`_`oD$ukRnwmo1zOHt*Lsy$~DVhFQeB`%pQrq|2v#}9BEXPKF{*7*a;>&pU
zOS2!nupj^93yY1#iu=CJw?lRFDPw$HuJrm;t@5|&V%Ox@T4xaQh*(i7xS0w~v@JAAdiDJo0_;KD8-kGx_|z+Be^>xk0!Lz=s|1E_V#P%LQ@b{)pdr
z<|apczp+**-w%EZrN^^{`SRJy!EY%6zpWE|zj1G2FK4ez3*3W3fx?5(z^sv5K<0`eJaJjjGbo1CM)LBJQR6Xu;1
zn3p>DUSF?0YO@~&0(M*|*cg8fkt1DNbgiX}%?%&p{AU2aZ94fnFduri3h2)H%J|To
zwr_(!7X8sX5YWN&hljPaRzSAd;@jry%sR(sI|WL&K)=~)F-FcB0h#0%e-8~^$wB5E
z5Rj1;C`Q|>I%BYdxs1+z7T#u$X1v6T`OF6MjoFASatNEwb9~4>Bc1wnO~y7S8e`x|
z{vPzTqFp2qH{`LW!Z#@=ARFCjzefv&Jbf3p(%=_6OsAG`54^FZgbb9k_m=NRm?7@pKbQ;vo&(c5JE
zxzFAL9l6ZUm0Z8dwRMSPB4drf965pc|3w2Xb~Mw~k729&$V>EPew$;f>Zg>PHW&L(
zAi#qh%P(Y+d)Q6!>Esmo^ct`^#bP@r@R#0$SOrdB`lDZc-S-9F(K;gE2bFecnB%m_z?
zmkX~F9uab?C)9boS<2^O85U==ap2&(@*O)uGSVp)b^-lf$+2IaY^$ybk@9b?84_
zhyJQMbk7I?6dfwKc$wOe$jn(tg_HF)=_l
z0PkvnK9loY)jJ(smvYQrt@?64hemE*;L5&e_7AE~Y|-6(Ycbs9=;%Q)8;lPcdYi0E
zRrh@WKYK(y{wr$mv%e(yp&b<1k`
zt7ob&`YcCZe;qI%zA_t{RlilZP@rypeU0jrHG<8tO?AsV-&flmoj6eZyz}{LTHpt(*g!~(pDc|-f)>kdRChax;8&}9r
z{wL)VhkEi4tdQUKCh~wn9)7pw4{J_aSLUaKqM6+jsy|;iSGY+yD!@;jJh8Qd4Xj1-
zhkiicYJomvKO!I}EwD!}#nY*N#!`@Jy4|k2=|*2YpV_^J`~~DWYuVPyovI_pVrldz
z>d;@GpsQK6Ct=HLg|h_aX%&sg;E_oz{|%}!+bepYkQIB56@yW!=X
zirJ=Wl@HmwOg4QcyB`08E9C#NI{f58PN+AZ=}wOLx{#0L0-*0aVZDHy4#8sgYSnoU
z#aQyo=&z|me{CK5!*%En)uEHu{=8~N=bYu}d?GQ{biTI^{k}T%`|Hqo2jlBz@?Vjl
z6Bqc{pSd4DsRWtQm9>AD@J|9cLqEKnuc#yMOiR3$cdNcf=oE$o;&YZ@V`!7(w7UiJ
znzBoPACLpA8~?pDbJ52-p>HMcs7+5>kBmhJa*_S_LLn!xMqeQ&o16EP@FeFx)3VrB
z>`psgY_oHz?T4&I=<5XRpdAVn^C|w2=%{eUpiUn;)Fz(KGxtn#7I7#Y0(cA^mo;={^lq6@E^LS1YBj!(oA9KABM+{m69+bnGM62L%0@kLcg_B6hzj=b1l=Gy5m9
zHweVYpL3)skc2p;l`c#&h4Yj>y)pZOkrxZjW`YX$WD
zH4U;js#%p|oP~&|@82o4i4%4cU)snbzi8Wf>QEh>(EFL{$oQOq4dej@ohazM(tiVr
zaq*rJzkeVW=xLyzn3Cr)U;O?7d&!q1Y@a7z;Gx)fbS6HOMl@_AAMO-#!lXkjU-qc4
zS3tJyIeyNZQAfY}h6Qqgn3JExoc+V{4*w;2vHNa;Joo$2A6ev?8&suqFa`&ho
zzCcLkue~QBH_@?{4YsG?A9x-R;9rUtzZh?$y#w8hmvKwURd+N$V_0Xl2F)&f#CYV{
z8pAi}J1pQ^c(^hi|8mCJsB2odTA+|O%#m|-Y_OOk%jB{COdj>E!f6R+PGsBP?dVV)
zd20oe)1o?Sl6&xF0-s}3M;>{CP3#Ttlss}99nj}I0XcSMo;iWiF5DrQ{$?*c1Hx*-
z_YHOQAjd<2Vm`o+Aq15>1#D*BqXXx(R|(kr>(VdO^(le*`UH4C;(nipHszga)6ZPc
zQo`#+LpNfuN!K=ky$okTw;Uc)oj%iT(yJpA-)9n9e=$;bYg6CywUN&!yaUO_d0poL^IueAMtkrh$A$vz8&98{EajEO$T!6
z!|r#dp>a;8-*lp%znNxoZ5%$oSM;R+7;AdNGv{*=xargaZbF3GgxrxP}>UV7!XY-iN<`acF;$=Pkl6cW&
zouiSbM;(o|hfHY0P9}bXf33TkY}3Q~;Q{BnEAnY`2H?8EUEAFi+n5WT&(S~5?C0D`
z{T(;vVGfgTwh>?Cv2Sx_jr#L&4y7HqYlp7=0yg2JztbOU(j|&De9X(0KCXtet1}*2
zw}8I*fxnjqzxj8mv5aBQxlv=xXXeXVbHPuXHi(~on}c}M_Vt37JpWJcZ=Ge-Mj!lz
zuNZ%ofJ_R0>k_UIep89TzIs}U<#Z)a_6pRAo7M3t^U!9Ww(klJsZJlV>AOh4R$?+N
zvd@slcE#z+Wn1u#z)9RZ*()gSQFeQ-lcKmvp=pw
zZN}lBrN;jD3dS`&-P-QOd5^oso#JPI
zY^XK`8T9QH*1I;c*$>!z4hhJCmJ^T{3Y0qqTfeN6_el}tVIMa0&WmxroL^OYx%zMq
z!6&xQAe-En6sY4vyH_&boF>+kO@V+8@ZBpcr9VF7yS6>LE~Wbc^|SApkI@N#BKw4p
zv*Y6m__|ww{{jKIXXJG3
zL09w1KGm_sWHRqM!RODY?aRYQ#49J5eOwvK6}>FS@ogYrhvgfx@zZtzU5LjA#Yn8I
zZ>Q?`kOGZ;AGz=o-w!q5NB;GWpLrRJZmb7nu;_I3))
zM;zq(s9+0c6JmlMhXjig>$z8G7HqB;tIk}EBlqNns;EY__f>d4;_;x9pYP-yvL*%Qzz?+HW8Mpeb^$tm!7lvY
zCs5w)o-^(2wnsGPB@c)fa{NB?A$`ba-=QGa=ZB83$w_iFc|XXBW@~Gm>WpWu~`D8qQ=;Z%V
z9r^H)d(3C&Eo`uyqMtT)m~F(AJc9NqJ+GrTGKf8Nso(To(QRKszcVfIy6jRNnfS(R
zrA^Kt$9#aztRwt|&4GZ;e=Ixv{o6l75EF6=zCUqxf7D$+R>ywqJYPU(3U#Skb-%=J
zWd5mS5a*=7(VurI_i53i>so<={j9xOYk+xeZswyfH-2G#K(oB@{Xm?c+t~oWn;(&f
zACvl#50-~Eu9hA6-eQJL7E^KzpF`tHoc)}@UOy)eyLTCk?-S&frW-^v+34rz1G-?-
zZUMWu3V$YFW6xc}-OjJ@5r>Z_`iMK@uoM3=U$;O^Cxk)4{8Uu^0)cfxtdji5|8vPV
z{sFbsjP5V+_6WTKa{zpXzJDPm^ZS)*w+rZRw3}3Kb2Ovl17eLX6yrUtI=sj?+V!eu
z1oFw(!E)q5(T4}l<0|H$v=~8am7DICofp%8Nuj7
zsxzLPpx^`69C}mOf1VQTUPzu(-z(TSa^f=@$l6^im<~HtM-Kg;U83LO$N7+g522xp
z)oqQlSJ*sU6~<^UkZDaH)7gXg_X*hZduqeO`2{+;h3@Etj>L>Thc>zR`3swx9@UjR
z`OAd9#)A(Pl33mrc%{!mv+
z82zlCmsl9@UpL_8Y+<}#sKLv8f73ueeB8*!FD@a2`;q03|EvHV{fHNH;Qzl}LXO>+
z;QPBJ_~`#qo&HYsF{kZ`Db*Faa&B)|9exwS$TVBKWzn9>%
zvFK#FsT#>N-I$LuB|NQ3w(9y7$uzs{K1%GE7oQ{VkL7be1|Rfd;M0HGqa)K|)1^AT
zw4A}doM3UBRGrwcr>;}y1G-97^qBJuRRs`mwhor&T~l>gNl{rGBq~o}ZNNj3IZH
zvKt-jK7vfv=N`dqL|62|PGSQ;G@ILeKp*;9ANr8@HVzrq*P=T2Z0kdY^^uc|!_Ex?
z<5&yO4EXx1@{^rQeSZh)gZ~2IK>?poM?OBM&-eL++TaxIy$i>pC8ec
z!q`iNugQN)ofE&Ve$z+Q$REsqyFeQ|>AzSNWTLO}-{jga(UrUg^qo=Qmpc2>hpl%A
z=!Wekll>k!Cj@L=E5LiTK*4_@6_q>VOXL?DPmKNX)EPf4*nJ{Y9l1$a@I4`ze#tAb
zF&q88wq7hI#ebi$R4f^r9FIToLz{rker)eooAp6#|4{)lef;~%R`vap`phS)Msda0
ztXB$hEpEoQQ#96tt(9bd==z!apC#1q_wOb6jd^^3p`YbDeqqk!S@T7rVYB&zJS6Ag
z{ofbrhYEH4i4V{f9c;aDWh~D)n{gdVy;uX3Q1Jj2qwxK67|8)tOE$Xi~?%$Re=dS~D-g1Ze{(XsY+!wiDnco?U
z4*1>l*sA(dP6qjd@A<5scm@Jj=J~%%%#+lQG0efZZ!9qmz0_T$kHvnE=;qV^SVD%y
zh4nlnSniol*y;Q0n@h;DG3da4M2=IkADYaF>v6j&)#ttP@y+
z$Vsk2yEov2Zb8G!XU-PY8G}r8VK1Vc7C2L|wvcCQ^3yt3z-P9@hYVr2Jj_=Q
zsy-yZk8jwoIb*ZGGmiGV)Mg%Z*eZNWMk0@O$r-L)AYWMjoUgE#T*Ke^i!1BG{LhuV
zV2{RMra$sOuJ?b$4}0*#`@Q#p*lYCP^yp?A`gRHELV?aRljYz6wW(9g&(tRc?u+*O
z6O2I?zC#AzH^3g^udb+|v-x1B>hR_SpT0}&P61gxLa%^L09(zLe@MiPF{URn;2jq1
z42gaIJiFCqe&qV}J&umfNjh_^7A_Em1Z*J(C~X3BntdkUczxY@X0Wlg&zm3iN{0E_
z>_->iuOG%i!$xuleV7A~uK@i!1pLBY+=!pN^7+|+{!>I`n!V&Nd})Ea<_|ZR%|^GJ
zP14cfc7c3nZ$)qN9@rZ2^B%n|-viZ^QswWPVhb@fz1W+v7hO*X#DzNX9TwolXQ9v{
zz)PKSrvM*kPxCoE%waazS=(&DR?{6{qd$GgD}2n=Cy+a*YQ!EpZJxublS_99u2*q=&U>D?WZK%ty(X
zp(7y9_&n{}!@Bx&l7rUAUSWM_G;zP$>;d=)9%9Q{wiu9S%uAo$5Bz&4F~(meV^a0|
z1oCma;P;`Y`N4F;cB36qy-o1>jK-YsvCk4O_-L~aV-Ia~Hoci28hTU5Pt5}NEOep{
zZzxcR{g40+A7BUb5NG7<6ewZzGv?o`I`?H{Q^+B7dc@V4+kAGu>c~eI_{=Z(k1_Z;
zv=et{nFU=uvhm8<@XOfbUF=edrF+$%hvUww@V-&)6TZ$M#laGxu%*yU`UJhg};Q*eNhSc83Dx
zPJyvc2;>WK#)dB8A_4vICv$KmAMhvkl0)bQjofE^n*eW;M!w=(WS|Fm?DH`%V{KfA
z>d3dVrTK$#@C*oR1m6$XmJ{$>i$F2Eu+g`Narg**LV*%SKP!1;xr=UojA0`V%+Hw&
zJCbV&I=-P07krN1mb2JKoqd)aY4zJI5*wJ(;uTOX=#KHCyGiiiTYj^!aw#zDu%@&73_#uYew`0p2~K
zH}f45(Di!3`UX{}&-RE()h*`avGI`;_4xYL$9%&A@>dIE0`oFI{v;k22fJ_5kK7Ky
zkAs@gGZq^&JZD;Bf5XE%LJ#thm>>%t=H=c1Pf{*pnBVgKLe-JMSYjm=7meYbz!=NF
zoa*@KRl-)GSq!1BPYL+U_U(FgV$FQ)X?=oBYWhjH#w~}@$>hKfAAX&8IcV)eY9q_q
z18V#7*>lNJ;~_6@)B9KR8DL5ary6Rvqq3bd3~aNx7xMrL?-hgi!1v-GS&#s
z)tICm^fBKrC4Pr(Ty66W{a32(&xh=D1g@47W;<*2_w_q)zWxvD_rd)3or!k8+P-{?
zo7uzpnYq&LnsHb12zrmZVh=#K-_#!x@aO#Xf2zcZeE~jv{}ZB_E5BQOSU*W$(NNIBJ
zza0{k)79=r)NL=K?(Z?gk1`~{k8f-rCg15F7O)o?<_pef*kEf6`&tC#Q^ywkj=jhL
z2L*cQGuh0GZ1%PmDF&T6YW?n!@tO|!o^h)*4*&S$h#`9hxy}Ah-+*wvKz^Wu(a%V6
z*0s^O_i#34zh;df!^ZDa9lMFQPv5I{n=mOP$Lto(#wd--{qUh9mJUVlok@D!@C19Vg&+TgC7kmfrGkI1^X`JbSzM(+5GrlbQ
zS?v+=Tb{2|-OgdG1M}Gd)$uv)de3V8>N9(Y6KmZ3%-(OZupL>8kZ{TMi
z!%p}q^bt4XAy(~zzy1!ZjjWu&9u^7|_D5u~FOnx_Giw{ZyM(L)$y%fD+hNO)g*Q32mi;Efx0|(%-^m-98s&MYD}}s)7y2DSx4@cUE@Fg_
zK=Pho{pNRkTu(l-ll&q@xr)zgJu9$oD8mB&LjN%VIsVyR&FEd2zn`IZhk(zZ?-eM-
zpWMO6rjPMKH@-cpuM&t$EnevG;wx-JSN0ry0EPv8W^-8X`+i`2oA4arI)QP_OH5gJ
z>0yXq#7*iQ=g3HT8^{l1mx$=t}Z@vW-Yn!ihQ
z;)Q>tQnV)hXPDJ;U?}=i0y6pp%CBiJMOWM3>eX2r%*z^LEOQh!7JBl0{$@RYK*x7}
zAMrh^K7and&{-Z{Tf4}{)_04JfBiF{$?|#8<1OMvCWSfaM_10QR|(8ZVa?(DD}*)j
z2m8}|74#lmd!acHv%6iLyh0u^7!uHx9N-Ec@uAR%4jTmS+vvso&>4^JE4{Lg0s*<$
zg)aDnXGrWImyt<5Nw;{~xt+Kn!}w_1S_oBd7NF7pw-SiY+6Cl8_w_G&bmWHu#dwp~
zE$ZtK@FDjA;tLNxTg#ikWRfq$I%z9=ALEc~I-$q88e_6d58EqQr^q?e66beDbz;UEX3Rwbx{@!*
z=Za4yG8(s03CNs*fL+839vcJA#*jDUR)>HLc(_LqANbHCc{a7&q;EiA4D(rT;s@*{
z|B!+FP@voyU!wcH<)F-r?1QgQVC?6#ha>+sfgDN;7B~EYFWLlr`5YO}{H6~!!EZF)
zffGOY;bA;|oB{R-_<}zC1fT6Gw23Reuq(3B5u1NjI$GSJq4(pW*}9ul+vdZ@E`fO|
zLxQbovlAWA`;dT-rFK-X@wu`QKKyO=F+NG7?eD|Pm!yTFQ7n$shrPDN1$!vyiZ9|l
zV(~k2^h6dmQs5^~{kh34e9g5}Aa9fN>=KQ6h&eH#*xWW2nZ%8l^a+%|kk82xVh6An
z8SLrp0x~Uk>^&zkd_IefZ;RMk+Il9yv)C}(H9+k{rLN6{#@vkGAp;WELV*T`%1fOn^W?zYCE?G+e5Dfn{n6};GI
zx26tG68K{Uv^zD8opg41OjqQuB|U*5JTF`!PVX;u5)dZ
z$Nq^t$Ck48QjZ4ff7bP<9(4i7?<=j
zX~j6!1~yQ~Ca&y@R|)h{EQhcWyWl~utz6|d+NNLfz0+#-nQZhJ5Uv&QA-+lW5m)+%
z6*}6O>s7}e>L#=_5>r-V
zu$R64bpkx(Hu`df*MDDT{m5q={v`j6ZsYtbd1`H2?}2E<5BbD~nBaqT0zQKu8tb3D
zF`dmfxPPx;^TLO1$in6^LE)_88CDxzO%^sYr^z5!$UBQAe&rt2E^yCF?(58FW0{}&
zq;Q{r9>g-)Uu%B!HJuKrPE4?$_$IHmccK$xeBafQV>w8yY`vAd+{53!8qd^aqRQ|BqC%s%!IWW!^5M(lh#^A34DMb$YEU<<{3V(ScgNQa88DSU&j<{Rn&
zozNfo_=lXqk`F~c<9{QLIt3p5M*egN_>H#hC#(tlZuX#u?PK(ji}X<^_bB86@g(-l
zk52f4dMHq^A*7;0j+?!fGx*f}N!*zCgupy~0`lqSJclpQV@enl;HB@35`{XkBbJ=^
zOjqg@=6OMl*qM!f+-yE%GM{f}N^MP7wgcN~Q=SmaKD*MNrBlU^0s1|g7}WANzDoL=
zd2PQjoxT^oKmS?y9-rgKXX1OtP*{`rpS4VmlKZSh)@>+I!sutryH|DA9eg>#|9s#A
z*%FHOlrSmSe(2Y0S6TZ~waHa%V?EPn
zHp0WYd`$2C$(eou8Q{6!c>3wJx?-cr>U4bg1z9GCD|2u)A6mcZf~-%w@AeoUaq|4&obaKUi7jtTy5@Es$Z|M*g`QK;lY>ex$sa}2aLNySf^N$
zTdU*{_6lrd{!eQmu^$n$7NJMz70h?=vDVT8x}g_220#Ax`7d;RX5&{CPsY$j-WSwn
zf4We*5NCjF_GxrR4|GGX0pWTfBj8t~vj^fwqpwpPUu+QY1v+r{Lmsk+T^n7I%X0@M
z5a5BfS(VkgqT716exWfhcGvR_vhfGG&ei-$ezXbLZno_3Xz*f#VZc~K5HiBphF`$7DwjxpC@VmisFe~rWZNWNFKJEfAJ$WV}qZ|
z$izl`PJ9^yLV-fA(a*d*V^i7$+T;$oJn6M9m&hl^+Wfr7wlS827uCr@`YG_UZqXUt
zk?re_Y|6h%HaY!5$zx7{Z#o3VBJWb+2h~rUO2-apP~c(we~9XVXu0T^kJ|1mN&3x-T8oHT2Z&Tg$frh>K5PL5Z(0QY-*m9ddo)N<~rvr09gC8B3hyJwsv7z1Z
z;bRJOP?xHap4>mofAk?w|3~uf(3QBf3&a^6;Q12`X3lej69RfMFEWP(c;OomE)md;
zerVY9c1O!Q8hoRUW@kC(#Sh4QLV%tU#so}3mha!3qalC2>Y+d}KK9-af{N*}P4y6h
ziqU*NKi4Of>+oP}r;v7IXj8DUAlxTFyH>FHy+w6=hhOL;=P5>eSoM^!Rv>mAGH|P|
z@P`8B&iGQ+^UZ4S5||g6GQ0fTZ*nqqmB%wc@y8~lwQuz~v!x=jkmXDv|B!T8BJ_~}O%{Dxc`1C9L#8a#Z*
zgMtiXL))N)$G7m1XKxiuJ~@GW^yv~9W3r#EKFo=3?33vIVeON&(Fxhau%4cl|LA*6
zKwoS%{~b~ro$ejE}Wn1AhI&PA)
zzJPrA`gN_xhmXje9>uK|4>sT@3cldn;>-1Q*{Z%?mxJW0rjBwI9?N5Lz;Y6K|l6kbq3&-|gz0e;DW6=I`nFben*m
zWk$6B^-Is3>d1n3TwpHv*dGVf|ER9H?DW(~c64rJe5#b4cgx;-{FGL|1*m>4M(
z$4ib!G=Ip{R4F$ywlF9J5K&R>pUo41zd
zF4Hcq%u%Loy(Gb>`4){8ZP8fKDr0j;=4Z3H{K(vVc7DOE)`A%sJu#p6+jH}?h2n&p
za_(4mraTvnBe~M_Om@~xi%9u<7P4+xMZz%7jgR_$Ta8dw)(B-yV?vZkvx_Ci^m(P9
zKf_dhZf+4T#3W;}G{1)CeoFi0TyC~7
zGhdpGMdzlnb90696IHyvd$oZb&Ckw{%w~^`jAmT~-Pl@PBXd(Fr*^J1b7HPAQMJkw
zTezB&RZ~a4_46TK&sE+TD;)L5jGZV>6^cjLc1C7q3)6-9!cmtS)|Hzo&1t77xSh|)
ztk>Ma>}zyiinx4nZecdc>fDi$Ty`d#E6lsw
zO@3xFAMIKrW7+v^?6wN+NZx15P3AQ|!50$~jNTR(3B!)WI3sDT%=nW)ua@R0Nk-*T
zQYNJ8vD(=ev&F;;<2`<`yv)xZmEWgI6C*R(g*g|nGEF<-!n6^O&s2#xJ~O@9C$L-l
zDHFB*W~WAG^Am-+`MgW~YMR0}HI*M5IaZjT)ZJv{Xm)DB&2EfS`K)Of-NmYR
zp_rs)terIubD2`538$HCd@}H&81cqrg~J;k)8ynuGgLJYF3mS~;GBCr`|js^k=k
zGu5loBgmT4w7>or_4zB%@0>4g(|@umW$+N(!PNAe@lLzeF7RqrvTviItcU()N3W8~Md?5taRQO9&viCs?9%AE;bbP1OR(`M3WP0q<=)Hj(qn7W#>HPG}Y~<7Itcfj?N^bAgd#U&d
zb4n)8yStl+_Jrk4R!tnS$4i)_2NE~LDKjOXajPAf)iI|qogYz*ih2xo8^1=4Pc7K(
z)LPt4=L`1eD{6FqD@%;;cACfS+Qv{x=Q3q3m*ttpVkUa@lv8d|eyB4lBnySn%AACHDurLrVKD=)zcThjU&y&?3}jGMmWq4>(Ww$GAu
zzYB|7E}DBTpFiTy;@ZB9h~&>>glZ-kuSb*F6YTGnp~x>gP#c9k1u=2-ia@tpFY!ua
zRVODleQzO^_oK><(IeSyutM_gZ53kG{jEYS-{UGI|Hf6JmTz7j$&M!#Qu)SIA!#Yr
zv_v-gYFly@-CyKhhg%dCO7d=#?D38?HMyYQ`%JT%EkQg`RurEIaTATUQU%p?~Y!pl*Y%)&qdHi^;X?I@X#Dv
zaC;+-!d$X@@y!K3JveBQv)_5oWOR`J^I3OZg;3ql^3)r3w_51tncd@w_X_U;-t8U{
zg**A^!uYt|XBYMHVlCdFl3jidY1`5JB>xsSQ#w}d$f^gpswG?9LlnGsX4RdQcWLrg
z^vOm102pgHo6qTKHu)TBuQ_ZF=C(dErUbUa*kft6!joo{@_I2ddsN0+2R+6vwD!PdgEYQZuDrFue>2J
z`qAucA#3M;X7ye@(2U|S8y|dP3q{qtJ1OUydf3o`zN+D;ed4nSHLG4rmfcrMc*+Ea;Itim6j7rc|EH9m{M!dhwJ9Nx8Ff+Hg0A
zs?FNbyytaC(eu4c%UfsvqksyBZKV~8onVZz=ygDKN9C=6qbE*{9(56G^;>essg2(|
zEjXe=?QB^Xt@81SxsmMbgnOW#Q!6()R&aZM)Z`H6hSFP78b_;1pXrUvpRmtiBG$OC
zFrfq(Qz|A$X~*_XnUxXK+2cwJFG%HiN^{IGk~=YR%nmG-VXjlJOWenei@G$Z9GfEO<^@Bd`^yZ6Fn6X
z2lw;ZbwszOS$XeR)4w~a)Qiq1dYxY=HT_#m-Kh`f*n*vee~qZy4iv}odcQADCFsKJ
zoIW@r6Bnf6zl7;be}8n_J)s+%ow;dlNsE+Wuk2`of*sMZT4KgLqX3!w)3&jYYvW>+l2O*Ai7<)_V16L90zB$dCzBc
zT#MeB2OEQUU^Th5*KyZouA;VT5psYS)DPul{3>2qP!U~CZ|z*nUyHY_arN*rYc;vG
z!%3}>YjF0*#!7!ZKV0ob@Qso(FAevQ-5WDQx!kexv0|B(h7+g*ybc9h9hY{4GL!0I
z*^+7}mwBqm|5be-1Ov`LvHQahw^dWQ!HQQWikaj9
z*L6wtfcT3IS3rz1D7p{IJ9D}>a9FC}6Q1slw)w&7spjU?@W4(!PnHl)Z(9cA7Ed8;
zHm&_}o84qvkcD$Dm|mEh*QR$gAIwi`!_>hjh~Fu-I$6=S)|kCFmW^Lsm1WTrQxz0P
zWdFL@?Wl3zHKqCa(zNcdW8k8ZLiBIsa;3PdZbebsu2uB-_Eczk(D6SY!s+hl{g2$z
zv}^akrsJDO*!iO$@ie;Qxf0#km`la0M|Z!N+T_<4@%VBcbOWM0r|XF4D>gOLzGy@h
zn5-hvF{NBdboryoJk4QiW}l+0-IiB5vpTsS2I8w9Yv@PhJxpXLg0*mi_s8-O{6%0XoHwC9|J>i+;Z^rs#J5!-~mi;*{I8^=9VqGoYmZNu`a8dTeixQHO(!TMdr0^yAAVN
zw(D|sbIa9tonCcLb4#epxy>!ZcgT+BmR-6$x4GrU!>3n0ues$WU7p|Evj1Q@vv7LV
zdCjZW4PSAy4ixj_+k(;TSfEW&XMFa@Aam#GRp&RazGLF_stcM|-!pQ0)w<@@vm^7&%$*6>s&
z&|{)1Ve97Qj>_zh#$@(?SEt%oh#$YqBI&+WJNbO&@EquCr=$7V;6qxwr#ANodV8y{
ze<=Hd@u}=Y@Oap|BOxQRzqW+T*rL&yp|(w3Gg=4QUrz1}9}9bQ;?6}6d5?#W?`-et
z?P~8D5H<Cs
zb+uSW^NM*saJojJDytf{>ciORDc0P$lnWxaWrmiTGm~jBfX{68UxLAIc(^J^Yykb@;dP%Dr%v^tfEe
z?ak-xAB{7PoC1N!Pd1-(>@dyKtA4floFA)g>{6Rtx<7bJcnyKUBl=TH7d_U`B##%Fg7HqPZQca9@kn-&77;f1pt#q28i9Vyz^u=cz6{;=W}ox3z95mWl(s`V(<%esWHaD0wCA
z+``OEX_gdK&IXyBcLtcdd_kX?xdhgOH}ApX#9pyAkz>Qwffaf2N!r-75A^du8k+6EtM
zn&`;%6~{U<0YCbR1!|n^j(23*i^o+tMCFhwB`PIV#spXvG+>IM{OFrvD2Ku+hE8ed
z6ho&pbc&%<8akz+5eq~2F_a&D`xv^9vm`_JY3M$N?$gkH4Be-p`!qCSS!mDnsU8S@
z8WQOEsR8ZB^*T=#(Hy1`Q7m`^;SMfu~VCFJa5stqa!n?v}rqA4IPQ+mT~FH>V0ZSpSBfy
zwNtxY*sFGBb-d7*j_ew=1wl9Wt&+~Et;0KKC-jnahGQaoLE`)oZ8fk&A5}(QIaCsh
zIr_+BM88;&oi611^oG)2o40pg-P1WRFqxm4$wWV8!YMt&FBFdyOUH_Vd)L|}YJ1n<
z+2IwLxy7BCId!>#$Mgbu&_vBPF#mPL1-Y%v?O1
zZiJqCmv#k3eQ2Y#T`W(J>~>@uA7W~7p?i9psng8}CV4D&$z#qz;&MTL^14uB&yKsV
z42BDHGy0_~-FFp`DZLkI1Cx!N+-j7}r!L#A
z7h+TKQ~fr%-+iYXt*#5V)#;Q9dK9_T>*cn`*C`hCO=!r&9kKmeeXQ_K!INu(yb+0lLHg|_QG7hJXD+y^wE0m
zh@Ly$uR8Uxd|Xz^d(TEt_^d|v+>$MDkju{Z-;y7gwMJ{;=%Xj};fDL|C#86PHu^4x
z*!za`5X7BSUz6_*bZ6m9eq%k6dtRpH)k^^ME-4?RW$CCWdRBoaenK3Of9!LYx%h-V
z%{e=4-5BM4Wi)RcbViScaw_tM>ExFglOs=UF7IFZ3Q?qCc(KITre?&Gr!G0LC@V4o;ncC$XC)@!36dK;hz+JKJ_^JAOh4->iL$Arq~
zh&q|M&k=+8bHtNRPO@^JEQFofyfSk=K@gEd=n$djWaLWS3Qy|rkk0IH8##HZbGHk|
zsctR&#*v6O$gs6L9;YxY5d`+nlV1-5A{d-}TwzQ{?^?8n494qTUt)`Qgvzg@gqQ4I
zC=TxC*QoS8mpJ#f1y{J8YjIzA^3=ug@7v_`jpO+DNVIcfs{**SMptG`d(*}7Z?e=L
z!!HTx?Ybu}9uuACqu*4~3~{k}YIHG1D(GDBdncvMW1$WTgPX=rp4t>E6@3>il0*OF
z`iQooaHTKPt1(h|lfEuIt#8cf7svR$qHTdcDA`vY6kA!5<_}8txk0hYBX~~`27~+#YtuUWQXIQ;-m12iWUB3hvVmaOEvkE9VTDL9DPA7
z`b{LP_(baYFMj+ZsVy)5$78AHqaS#EYQw+x{bTASk38O*
zI%oIw>r;IXz31hrwU7U=Yf~*Rn9rrw-tpl#r!M%!hK;H1fAaC$Q#~K}z?RguhmICg
zTc=<5P-?@Sqv_O+zy7T^r3T-3{I648fBb_Fr819R`N7oXKmE!#q*7n}(7x3A4_$qK
z>UqWeH>F;3|3BZJI_st9ydw4dFW>lz)Op!AelhjjW9dIkz39Dv)t$Qd@%N0St_=Ua
zH+AmqufH;N&g(w*+o_JPJ^i9ocgweaCAIb|9~n$N@0P(Wsk5&5@z18(hEMKGo&B{P
z|0C7>jy)HpE`86APo#Pe{G8?}eR49@`Gp6zrq-9%e=xQ2eLs1xc7fBq{C?W}=#*Z0
zH;o@0xM^tT4f}36aO2H8Z`pZ6zuySL)~?BDMQ`dOTJ(|QKvcCa=5$*tuIP1FU(Bj!{rP+t=;3mxZLsaC^p1@|+f{8l
z^k{Rrd;FQvFDdKO$BBGNzrr_rVq5UIzM*hj&yr(WFu{&s%j1_!YgOqkzvD{X%dF=y
z2@QhB_z|2A!XVHG-O<6+iH$$7<(swPV@-EH)^y)i_p}|oGLH^Y(RXyV@tXsSU)A#g
zL*1_V^rdc;9^3dVDte`npFQ0jk@?`^tasedI#5sa)#;!+r%y3U)9%fH?$bSWXX~x6
z$P!%xOO4X)`log4*q>=@OWS|Ek+t{5>63Y#+gtfIiuopXn|m=*ehELMm+;X8PT1Pn
zh&fY;?%t;c`PjC6x(XiGt1b7P4;@}-`NE8QkX5c$v+6B%ZBFUh5q;KTN4-E>Q&wM<
zDNOU6p|@td(GLzk_L$BY%VEsqGC3Sj&09;LBz899LYm%4XNzseyWE?R&glK8o`rgS
zPi*4JJO0v8{03NO&dwlW4O=@Zobl^=pHZjKh;7hxtSLWwi5L&7;?vV?ZQ)g1=}n{Q
zO{Mgvh4iN5r&sN5PWA2ez5#af)aJ^YrRYTj59v=%gqJKL>uLGqseb-KL3AwDJF>@5
zb?f5~z7M7sgO~d~nIY@Q47K+7CP%L`NLoMEVu;S=t^Il#F{bYkNx0q$=*d-^iQZn!
zyIII}UWWwp`kk|)v>|)>eI?G*@_OrbJ00_-D;=Tr6+tCZ{JxF@ZYdZ24)vIQ665+J
zabfFTUz}p&PTJ2vRt?oIEsKl30HK$Oh4F$Ok>YPb1jqDUvH4Odn48o)NLF-gW7s-W
zN2!%aIeF>|-4XH=EGvoA=Z%%bc|6=+w@;s}4QyH{@-WU@oyw$N;$n?=<^bzGaC$PbLh?n@r{A6
zKt|ti+{FvG5A8mA&2ByDggoVJ+Il=QciCPgM)1wJ8!+==Hb1!bZnfTp6Td1+||{7&30zlsORA6se$+l
zh8y)&&6v;~9YOZ(y{3!Phpy>du6;rnD9IZGH*E<9#*3u^qMe%`&=+p?1yHTMf$?Lr
z*_ord-n@6HwS8cCWcS{EyGCx>y?g(zTSuH~EUy$9
z8*s?1zGX{mSvJP_Lmv4H8*F22feps7WJ|IIvg}y4vB5TrF@!)u1nHw`+Ttxu(-b+0
z!V82FLJTE|+fYi#M@gCxLTQ>uQ%aLGp$#GLch3EoJF~lz9BBXV|6bSD%>6v~+;h)8
z_uO+oX5L&E!5dbrSl79sV_oMv3T$r6z;3r?pl1LZz6SR0-^B|R+=gh!CLP%{(Bro3
zb5WIg?CM6HtGo9J@};@j+g7ewv3bqvb(bNN+p-(Wc|8LIKpVT+0TX{&k+k%~B*w-04Z^sF;I
z%S}%wJhf0&`|G-Q_spByfW741*zSzwlfeUrsxgMR)#*Le>7nX$cTIX|&zwW^=i&Hg
z%ibNt!Uqnu>>NChFRWgOlUi(OJ|sFtU3VH5(?*gLFe>b9Ru1g>>uue!n{EKviPJ=4
zU&rhnyARvTeuSy|n9PNQ_k+V)$|QkBo2O9Po4O3~?zCfuFI1
zQ6S>ADk&;)JUl-ffTM@pvl`?!Fwbq=NU9l5Ho2(FYM;rcNz}T~ej@wJfZH&*r6l6iFH~mx_r@o|JMA
zfSJ%hnWt9J=meV*%FS*gZgA*F1McJvGSv-DUc5;G4yDJkvXL5FT$-{YU==aE4!&aT0UOc5z)z#%o1FWm-W>(kX&`OOr+Hzoj|G>~JOxAahg=EvE!!Yrt
zH$kCSEAic=^J7+yXLA!QA~=7*M>llnj3y|dyk#ft#an|}q2H4++{mUvRF+1p9pZpR
z?>?-);xKdXKD0_FE$ZPo*lyC+F^j;wSC>}b#CkjYZLZophI>
zlWR0uZAXu-BW2giF2%gPo>bjAJy=p1a&b+>{=?01sI8j;9
zG!x+TyJy(L8-~~6<-;qoC+Rd^#d6rwx;^Zy
zo72+5*ZPv8jj18@|Gntgr;cKFIX_QS-O%E?p$nH@xq8j=ZR^cDme67{k6vZm%?8;GrltL0d1271BQ{jNeK53ck6CA$D=W50dUf!7&DjU;
z>EPW2T@QF7Hd>0sshM>%Xk!8Xd(EjMS&FH=2QU^LZ1?z4=WT(TBPuYV^tNJ#x?!zb
zi=(64UF^Qa)&ri#U}MjY26>xIYGG=3_4!*;vs109IjOmL&Q7(l>%!E$)I|c=QUF`x
z*3!U+wL}rNY-G+Vh>!)?Q_uxl%#VRz}tQ~m72c|>M|y5ucN1z)
zhYlOD;RC0*AZWohZMYDWSSX7oq)kAaZ#gQL7S5$3t?liuv8iE!>$Q1H!eOn9Cnpo<
zB7|B#n)R~79dsCU7&Z`0{D(WTSWwKa$ga%7HX_eXAmAhl?-nJB4YDV_TEbb?5=}ar
znsj#iDeES}k!vn`1vbQYc%r_itfR8xv(fOg+i&u=pu@P{)}!9m?8#GI*!j{8qjQbh
z=z8?XLdK<oFWRg?ES?a8BXj5^
zM^FFIb=X_IpR{|3){`T(?&5ZSEy4?0NuETg71H2|Bp_OTK;DIUbJBL4#*?&xhATN5
zy_y-wn+b)ZyBVt<;2b{sp}__2SJ6#J
z*yb#^w7{IPvlnLfe2K9^j`xLOV23KgDYGMOW=a8+tVH>M*5)Ry%L8#XlFgTRjt#IT
zCuJUZPeaoI1^UU#Cs!(<_|QVc=p3OHV(x^6%mHjUA>DA@ns^=h3tOW|=Y^dZ3HT(q
zJ0vWvV&jJ!cRT!?w4Bzsu_-N1ACa{e6B{a%JFa|#vKiR0zaJA%Tzp-}mTF}1gv*Gk
z?;f}TXZ~ut5A5GlH;DUn_Yu_L4i1o!B7C$}H0O>1o~+RtoZY_^SPS!pE0>^aJ?U_j
z10f&#J^KCm5_Ga=3;d#f!yUPahh@;k9x##a)xcqEgj7Kyjt2XNw#wHf*?j!?ul`SFc$S_jToJpHw0b)2mvDXwR$L14VnEc&2Dy
z6h^czITSDRnrQH%K{!zjVn~F=7d?1wUWN=Sawv!QVHNVy5+O-CXtT+TJ{s;Jt7i;p
zSg9dSaL>}=Ww05yVt2`$J{_qYquQk%UiBqQtJf~AzJ6(HX*OF+_fuY_<+Y
z&OJMvxldMInawt0R|xiycJFn{_TGOmo1Kj>E9@CKu)nuON4$K;@78#zJTxYkHw3xp
z&pc%r#EgONtf1Ko?|Fh&KzBD`jy*J#07=|VT8;#~-GjV;n>z`nD=XeUAk1YN`C5Az
zX6rF49vm8w9RcHB?fF~g?#82aHzfG^TX@%xwe(|N!}(k4dY0CujL;4l+EJGhI+9S5
zyxQGE2X{1))g5O7b}guGS)*HDDP&%YY=5u-{-gg&z&{62e%~dac5zqSs;q=
z78Qu*GDf2p*w#l^;#ehaStk_;*zMaPv4e6sL_SW*Jg;K0A5brfcx^hB4g(;n(nt#}
z)96r6iNt0Y6;fcXw
zU_%pwi}S_t%mD4R8vj$Gkm{D5qJyI=Qnxm`JJ$*gs7Rz5j@~Gt-CzTxL0;p(Kr!VC
z#V`w`#6D!~Qh>n$_g?J92KJe*mwkF!wqu#vI^0k;yI3l8930{F>%JiD3q9P8i#4cBpuTGAueE0#effc!;pK!E}Wvg
zVIRQ3rbPhgcmr-R;a#c_CtZ#147aIaNj$|xp%hxCri5})*e@r32`5ojU>BcY;nRyG
znUIebs9}L-bE?%Qna%n5^5I(c8ORe`pBNEoW
zbi9!vhz;pj5Y~zkEv173r~&rzQc>|)oKh#a0nnL9NJ6;aq7Pv$k_*G>_&kA}Uee-W
z65DLhx)9TipgJ3?vJe<#jlEl3ohDj=w}tfJc0xWnnNZw`&a+S2RMW1z@cMCKS2%;e
z+G~r&n{+B2?<&}%RieadY6Ns=+WZ4z`Mq2W2L>w(A%jEX5G<%4)x?drxv=tspK(}L
z3mnLDL)@eCjD;Et(ik=y2D-QR4h*^R+1y-ble?a?x}&p&YNy6xo(KKO)inze0LpTa
zFVQB#i7zGy?CH?JzJ63;P>EuQu_367vq;SOvFVuvL*#Vn+64Qv*SK;V$Vc;#fQ)Y`
zNcd37#3~{m%7&E=TlvTuFGp+|#Bds!@8zOQ+_z|=9Pdc1fCxud!X_Xz#V*|NiMzL$
zpvDjY;exhuaRzK#1Gg6{BvDVtF(zW@&?J(%NitDUd@-38>|*dxc~Sm~L??1@@5K<@
zk8UO96^}N&km$}y&u(=a!N(LoWTd1mTf6#ck7Bxsn`%)I4_Zg+rkRW~_KwqP@#XIX
zCc-kLIU}9GpiJU7gbVnf%C^7Un@XqLcnEQv={ZPuGbmo;PO%$1GhOl74qj&wV>38(
zwi;8#<`#^PbErgohlEEH$#!ij6@U-!=-=Btkep=AZW4n17)JPd
zJl<`UzKFJM8uE`r7r52gkyI}LF2`wJ@7SuN{44@Pck?$UQHIbb9sP~qM3$RLVPs3
z(RLC$<4ajU_pw!!jy{vvRp_VP^?X$^mb`JL*!F&C=#X1neUK3U`4}-o+(OU+7k=yn
z+hLC_aW>R1Dh5{Nccz4RGf0lHi>EMZ1QUhkDRVS>jqOzJif;yE3}6QmtKdMVMcgY3
zrNpQa=9$e2tV`?0mWF7SpJIQ3J2#CBC&6dvnt-=24Qx<-niPSaT12Z^UwQ`dhfqE+
zFA$xa#S4ZBxgQamq-akRa}tCmP8!hJ4%)Q5kA&zvxABHu{m?v73^qeaNrG)7E4kz`
zfI$u#py103Xkuuw0i_@+VzN9oDuv5mtY*`B7j8j<8dogT){dDF1&AXQOH{JG-G{M@
zUEDK)N&LQk?4`g|mLTHjJdGIj<0Qpi{B(j3UAnO2j$o?}bS)Z@U2qdl6^hvhT3$7{
zo|lRN(u=1joCEmNGIAWoKsg>`KLT&P;I1h4|BJz37u$j4_=oCLr+NIl@GNs;phb~%
zZor*bQSliEP-PsV#&QOxE<5~t;USjTR)h^RJMk5=-kzomp7$UB(Nze-iVXT
zs&%AwL=1jHAcOHq=s}2soYbGNF=~Ptj6&ubc|?yTg$HtzFYm#{p)|i19TekV|9
zl$-)5oEdkPEEBdKaW0#gcy=fVdPwsOUvX_xPKf1C+0HuJ=Fr^15|=0m)kEq6TFIah
zhi1rZG+79)hM3`*shC##dz6&L#5V}6KO4YcPnz$J0kv*FkQK~yXkvUD#}#Fy@!<<-
zXlk{Ei3T1T%cS&GhxzyH?S9_@tiN8%>^hMWX#3Pzf={K>QbUlv3stJ?BoPmVNql}3
z$}6US@(4Zzztpfm_=IKI>zXkI#;r^kZ-|K?$yr8_%@RYS+bic_dk&!oVHi0uh|6T4
z%DbBoK`J`kqe1pTAz3hpLd)bE++a|kQ6LDG1_dGODC?z))HwIGv=JKzT(DGlemzpplU;cO&nWzk$=U=Os?TpBAyD0uasom+Ked+
zb!cdIU@21j=w?Wtw-Ul&0mVib`lP}q>X-JY0lzV!)+W~a?{-!_;_bIHR!T%Gd!Et0
zp7+i)Yao+-O38Bq$beAP%$yZ=aU(X&;=>bU;g`o4a03F}UC2*t
zP0g30t|wjB)3k8)zyROmhZa^h8Yx@l46Gqw=7t$S&$!NbDi5G;Y|Y22UGIKcsT+D{
zlGLC}j7I;(w!XfaZWH#h%e?Gz?2_}cUD@vJ_Uw*qPqsJPm)*%
zUY1?sW!HMyb=k|a>$6v6H)J-?u9LL=eJzg+Ak*ii1O{)#!#wv;e>_kAGyPFt;nqj!>)6E(^3v3}dF1orc>1aGr~4^&oG~
zzyzGGW2LPd;5MT-3Ja*Vy3=%?ru&dK%&KZhfq_U9G4NUuzZzS#XvG9_gRSx4LuG-d
z8>5t3tcO1S1O#apDiuTIZq14pv=cEM0Q8md`ZZ*4HqHJjn`!$;(o5Rb@&}7e+j=&;
zDn47HCx`@E$-QW_{6mV6BBx%41gzEZ8ntCju6iOJEgsS0rpkbHm&Q-5@GB@+>gemY
zEp&B`OUqEg#*XhW9KcBpIhOS7=^YwuP*<+QvcMFmCTWJ@m=aR%HE~=arE&+BuMHq3
zebz2sonx~$mNc^2b@4Q$2_I_Cx7?kxmI@>;kJqmc*tXGN`K;PVx_#jMo
zXe79TZ(t&g8_XCqb|ZGf9Bd56W^!rkW>XV_H!kQT(-x@|Id<=Cw)5gEh2d8y`5fqF75OGHXK(;;y=Iy}8ULTMrSN7GFuK^$_;m2)?SOqO0X{Hxg`)U$PXI2*YH(
zfV*SZ!mccm$|TQ+TFh*Kb#=VjmpBVBRk{JpA@*!2ewvSD*TnDgg&2lcY3dgH;psZT
zK!9dbHlH#RvqDx4i6i#ab<^Eb#L$Z6S$YcF7-lUz3x&lLN>*d_w(2GZp${ejpDpnZ
zug1(~#{trpLZuf*hwY=hhk?)$or_U|l>vJN-zHAi#usmT8(R!etF7@RVBoj0%>Xdo
z8^5;mhCRxbiFySjxfI;|DF@c#NRKrZQ1;)jhslBkZRi}3++acRy(3|GMFHF5tsRPq
zpvuwCGIXZ>H_%K^PJtM_f3yghx>PR_%Oi$5h{*1FvI_-`eu&vVU&e%$NW|?>xq@pb
zi0M&<3W@LQ
zdIcK>WhXX`xCBC`_$|C7Emp!Hv>}As9J#$Cpezr$8adlz=hV
z&Z-r$Pd>9PQtVlvh7I3XCoQsw-5Z~|dZM;e%uKTH!}m+JlR3pORnpEgrOF-Hs~8+h
zncb9QUp$4LsW$B7wLv1)P+TdCWd4Kl)N@5`WU&M`bS!A@
z+2^8@Lh(z-%!iw4dUsqelq_5hyLT6FiPRQBjRLI+;t&z`2IGtpjtIp!zH?x4tO-#0
zv=JR9!nuGoJ=re{*FaBpWPT@X^7wQww%CfJN8(6N>!GJtVrOrQx=L4_J1UgAPJc6y
zQ;xQYM#J1z0>{anEAU+!$J)68g=a@*uAX(dx?dQpU@eBXZfMx4`1R&%3=>21tXVio
zFn~$tz^qv~i*_R$V#Q%MeEzU|0qz>5AaSsbwkyj+XWk4tZ$@WKysey~LY$1G6LQUH
zLe4at9cfqu``4a*?VfUs)bZHD<#c$h-c2$Ahk8eK#->GbRx(+e}7}#BCV8?N1gJ+M|exMk|GtnFMi9|Z!i36_8K2(MqV6*yd7%zIa1;R9!<(!hGUH@1l
zK7z(!#73jX!RI*JgCII!i}-swkid0ut{>-aao~W`RSsuQ9Rbyjd9{n`hT2h^o9NAP
z6&*N9Dmbm8LjwI6fYy3Pz2;$gVpkl@#doqgs%vngl{-2ILYa1a&Qf+8C4B(w?bJ>aF9v!|>rVEnDF
zR|omDmAL2BjVB?>h8937ow`|g>zA;9SkxAh3tzhdPb`!t+VOEL9J(Ep4H-vV1K4G;pE#G%_ZIuzX2uFl!MrvuH`(k{W(_}zq#1Gk}@cne$F
zy@k|M3Ik~+Al*X}$lQEDx`zq^QBr%REOD%|&_W8Yt=W+}RA~VmR@qTcmywKL3H1m2c{j5U;ZQ^$ILDTy=&iF0}-Mfq@Wt%sJl@M>cW(TS}#nWQ#;J2lZ3(9d4r_X?YQre7&v*#+A520;kJfE
zfJ~rbCBA9
z)p*VREf?Hqt+Jc6N*UW&~B
zlL?{|G#WyGMzy^f)Q|e7V7i$7U4pt09odJf`-D#P4?usUX5ltKYIuUJb-XE=b&2GJp?_N=iC&P$%6Cq91U)0u&MjG5ggH
z5Bi0a(J}iq5H9Wa%b_Mx27}@wX8)Xe-nJ&ydT$_4i_Wu+vgEYmh`(Q3p?Z}fzvs>6
zD(fBHf+Z#607%}b!9a__;I##)+!w15hMwnl|Rd4te^
z;-w+o7l8CJq@6{Y9ojnp%)smc!c1s?RMH?=0o7GB_Ap<1z{7u4d^feuq88z8U=;=`
z%~B;d7Sbdb|Ay$#a~HM96sWf5ST9;-0_EFpj7(coDOEbA02tJ03P7(@-KrERJKIwP
zwg&V58Z7kFUmbsyS$>*5wH3GSRHwJ3n)uz=xU_#KU#nQpsb-5;n|RG>yaadr(xr>3
zqe5}6PTw@Hb9Ann1MTIlC{Xih667q~h;JxuMZvz7P%#>dM1&#}5Y;2KIOQd81&T!`
z`D{De12G}3DO&KXCQC>U@LT7MA(5T0`LJk~E7Sut3ah0iJ44qIBMOFH@Fr{Wvc2uE
zdDP{-8LZTkAp><9^it_;^|6`wYsuCeo0-O=CGBbSv;@wO?ZeP%jDj}5_ZyhA~hj`+|BCC$PLrE%2ok?NZkVFYbg
zgE}cD3`qU)wDOzr)wAOf}H2)NTb@QpfWSD4z{b{Kt_$hNDbm8iK44e0pG$9
zi>?h;sEuGzFU+wr)Bz9Z>f%MvNLJ?!^b5wlB=n7KiLF9mDq6;$`*^A@anh{04E<_r
z7XYYU9`7)KkufOnfKtt(RyLR@gdhV6ueSD)8hk26m73NSRUvKWm?Pl`#7uwd>cV5@==(EG1t|6psS}CLtpGD
z@Pz=yX96VdM$!2MMLfk-!-LG_q;SAmUO;FN|L1g8jSQMj8pC2yklN(-(O7JT*)60#
z!H0dd40&1SQB*hkZd-eQpX?!mXxMHjxla&F&p%`B7|#RqPea%#&{#Y|W!M%VXUU3|
zAr_|jiDUwrNQx1W$LWHD*~wEoI{Cs}v^RAuDXa>6(-K6Qq
zi!8EKZ4*o)TZux=n0^$fG+W?gt+feI7yz=+SDQTi!LenlM>Z3G>L2^VFzEv<
zLng7HMU40f6BtadF%Nslj@aw-+Z1A-lYp_HSH~h-kpKg-C%y}9R3}iXsv`wzAug}W
z#3Ug`gRdmN0{V5(Rof4EgeSfilA28v#Bv3U2~y;%QjP8rur6>>Vz_6}ZS7m6p}}Ah
zKXV;6;}0mg6?;Q9HPHVR39X(z3iaRkQAG}-YJ0HMB?}W$j3KdzS=h5jy$5@ZV#g<6
zZtZI6<{0Pz?qZ2a5t%`ho0c53r@_G3Qz@ENY8^uB4JP*Si@61KL%;`-j8Y*ph20Bc
z6AeSPLgR=gqS~WoU}(re`m_qJ=>#JS1r40r<)vKk6vcV;pp>*;zd)?lHzO^j=5_WQ
z(@7C5?F6w|nM+V;o>dsIJ=b!DR=bOmlu_G;#k6S)>mrwH~DErW^{0~rqnY@YJ!N`%Fi5_Vd&aJ%{P)U5QW
zUY}}YW6Ggg9ah%HqS~om6U5E{2uUq~$O9yVb*}DGbP&LpcBnKnCoRtebrUF-5R}*h
z0ye3m`(g9&$4Eo}Ag)g7SGrsg=BFC2m>J3hVgU55MgG)$q!#-qT}B3N0y`90e3bVj
znn+nEi(r4!z)7^VwNp-ljDMgcHe68G$y-Q+yaogoJAg;M)Ev4POOzVwVumV{qW2J7
zfaM;U7c5;mIz(SC7}O;Aih_sQV2#A*Fn_9aQfg&>X2x8ZTl|&4SaCfD30hnwf+&3+
za-@#+88c9i4K#Q&y&UTjYchAsG*9EgqbU;!o)b*d{);@>tx!9Q#4m7
z#WVP_B;JN+6e{mIR|F|ST7@Xjcb
z=(>cVnu&?LV|Mo%q~>;G%BX?8_;mv+i9MDeqQP*~ZH#_COUeX|E#Ld#OOcYO0Xbg7
zphHO~I0Z=w^PE}aGx0
z$Rf&XlSx~<5LsYAsZ)(1t4gLAvMTQiuv*ZE&gI*WN}v*I{4i5AgjWe!SiD(eKcaC7
zTOR3+G1au1mt2HIzSSHFuya7w4%0!ys!+0&;LRXV!g@g(pGvyg7${5D2$(Z5Xvc_sijpD11!e?ay)LM@%V5kcs`P`XAMgrO$L
zy(cL3EE%KHPNd}Dl_f(tRsx{pegf8J7QG;+Y%~2QDSfM7xJo_N9;UGN)c_9If$OhS
zQ+*LlwMz@ok|)iUdzx@oi=ZWEg8bww5W)n<^JEDeA2HA>5EecKuNf1g5K@|Num!_p
z+3%x#+3?zWO-wW%ypa}(huesc7s~Bgv66rC!IA01L|7yg(n1f7C9HzzO(n6CU(g(R
zoLwcVE^!-m@$IOiv3SfcUhnmw+Ng~qpigjDMBVr@sRsMuWlP4VYxpVzGe=V%iJ7<7
zppaEmSZYmr*blW%$Q+8Z5U7~Zsp6RC_#3!lagrgj)wo1b=9SG;@H+N(p`W3?BaL##
z=aST!sXP!nvJsX+-Ari2v}P4jg5n=HxHkT$y8K)vNbDWZS~;|i__fF@)>+`ejxB%Q
zB`wC3sMoi;g{kB3I*P^jupLxQ5#l6m1SLor(c6Z2R}vPt1rh4H$FNKXEzxnrawmQ
zz|j7xc$lpoGW59k!)BvAYLHPb6KRGDD7F(V3X)7qy!h8l-g$PMqI8>SYK>VZ2r$1O
zn8C5+rG$U{6{9Gc=@DsEQ?c;mp+K`LO}E0V7vheeg*)aisd&wS1v(>bc^I>lT48;c
zypSj{@YZsSk`U74fP(J6W8grKvcDy!8n7->B3Y(UzyhUg%I8zIMTAD>=m
zq9SwV*Qsd3T3*S6RyH+3OtKH`P;=}AdIu4QT8I|Ac*RRnT@cM&FE9mioIW2#fCW6(
zZp6MiwbsZgBG`H)G;AjzsElDdfvJ4hMm8pTRs6F7;36_{u+YFeQwr4=1xb9}6H8Je{o$FF=9x%3ibRy*cnrI*1csa(3w
zECcJH7}Tf?k)0+r*jBF#)ip2OM69DXSjS4u0k@O~+*txlp1kj(Qo^(>z24xK(m?~m
z_n8>dvZvR|piR7dt}De#kM1?4$Bv)%$9L#Kz-;h$$
zh7p`o%U!3!P(z#;ka!6+8QQFw)~F3gA;U~!Z6SFV%4cGr+Vx8&@=pPIj_`Q(OInch
z>X(6n2@3WSOsjl5Pbu-R00U_QDQ8%sz|C@3A9p+A4N3{|>BZvnWG*ZyG+`+L);cVs
za-mSeO0i4O=knhpGAkRoG4zL|jH>0IfDH{@t@O`~vAGmRDj)D?Lb&rpL8|?Q^o;_A
zVs;fM6w@nEN^h?$g{<()g?(1jjI2z-a;dNRHd)k{HCWSg-XogXC3$QgOu4RzxMziJ=Ee$ha{aCZ_NKi8_`?0RgNhv#}S}Z$2K(3d5
zcw(At>F*bk>>(XET=|f$UG|uPo#x<>uAK!r__IuOPAFtdlO1nT3X+2NJgDzox{wlN
zrP9ry2_yyu`gW6ISZP3(repe^6AAdxkXQPBK^kr=18Qi@EB#-ED8m_{iEXlDpS#om
zAV(}3tdzKz1Z_khHyWEn%82YnV!4nk`(nY3n-D}1XDOD^zL*5ISV%8cQ;&M}H+hM=
z?xVWAP=hG?)q)Fi7wRT8s{O45f6Vk)0m27
zbfOy=GJ+UQC*4cM;LOiLZaO|LEYA!h5~C|0oNKJxU$-A8Ci(cBOhYOeLItQ$zE1#M
zPi7*u)siR5Vv{h&dNoJH>Y-oGXDL0vk&31hviF3>XWgld||2
z;QKiOv;DdJOXtyaOGD$9N9nj(mKkWm21#l~0+`Zd(93shLms814GuFGyBaDcf|7rf
z(nBJI^&Lt_B22Km*2pKpq^OSW#U}kbu##u@6u11Enn4|ojFsDj9Hx`T=}5F>c~LMG
zbVehUF0358C3IosP_0#AssiQH2#%gBmQN=*Wa3vdL!GcXn6N&S5Szkl8y75Sf;`bZ
zt(@j9vRdVBlmQ>W)18YXkBWpYLM%k0ftbRG@r;g9j=2lNpk%>$PC3>eV0*>XO@YKd
zS|S?-$>nPz8|E-{qLmVf$-5E|8kMcVdSbj2QFK|sLY#$V#TM$Uq7bb;gJbw~jaP$n
zGr|cq&8ruuX!!7pSA&Bq?BW=4ibZjMd2@&N$8?4rH)!jy*)&uQV|zU&gmpV~@I@5N
zNySnr)oKyZg>viuRNi4E8-bGM;g4ak(p~yfRVlhDfb6o0A}qpS(U5PIEN}!cm>3k4
za!+sG14=u5y6MgJw2hCu!?*y%c_x;7V(;H6t4ki2%Z^kxxI}>l&?S3nCk5kReHQeq
z2KBVWP<(JZ_@GHi5uD+w$DRIz`_-ne@(&W5h#<7$NVOjWS?Sg8-$S7dxby&8iR&o`
zj1lbTC*tL@tSa-TRHh6A^FgB&-?UQkZ&17pLp-WLM*^v}=>v&7as%!`f@L)Lpm$kx
zHG+5?^=8~uH*|#mA5|0(D+)lHxRMSSi*cR2o{I^=EZcf=qwsM%5CeT52;qDq-LgCTo-4YU>yLCxKbnyG-2&YH_Dn!UO{Z8Jgd-GVbe!4bUd{6LM$axV&IDz
z3kB0<7qYhEyVxjv@@5mp7KYKN0q~TEk2DW8;pPArx0l|WwT^k&quC?bV_D0~TJOzT
zN3wm{>$AJF*Jbx)dvLMo4lj#s1^co%(=gbR#i!W!;W0Eo4+=a)eyE$-YB*q^%~q%I
zhf^%LGJ@`5nZF9za38}?aTyDiJH=&Q;=b5RKjtkil%TFBLEk`~zoB>N06s&Y0MJd9
z1TXP1Z$Y6b%C}%Oef|+wHRQ{=sBk3Zy=V`4o8Z%)LXG--Lfv9A~3(V{zfcH$%Fxapj}Sj$(h@`Z?eV?Ez^JQ|JJW$Tc=
z$S(agUd49lFYzj|OJBh&ZYMsybTpc<6A$85Y9~H{SDBso5MGn)#8$k@?Zh^`CfkY9
zOGl$gJN_7a6?XiKEAhd2JN^au-et$Hfv?IgA(&I__!PX(u}h9Fy>OZQc+Hv(jkB8s
zKjFhKi}-7qa+8AyZRb0WQfXXroEVM1+b%u>h!@z!kFLb(+4f%S+vIO$oZ9KlR6cwT
z15&2Dk8VGv&uFA^r!6joRMBX~o!$Z&jkJMC_(!8@JGLE|&az_%@M^V-POgg64$&RG
z+i<-nEZ?|1gzjttPieop5);>1o8OB=622g7G}>ktZvpCa?4sM3$1lPyZTKt&U73c9
zs)k(EgZS=ZM>Zt1kCujqB_a4~44lRy*(!60lcfMt7
zYG(D!^v6B#^UxNCapI45WXN4;sist8$SXu#U0*j&E7roS-%HYt|Che-_u&aPc#xbpdzQ?P65KBEdagID*!Isba{P?dZrtWOdMg
z3PRRJdcPhms8?Sy0kboM0Gx**Z{t6C0lg?jYE%Y8E
zDWeVKJwhJmCxkMTFd-to-Py(@*DoL=J$fN4Y`GEybJjp{-ecZwzPvZ#$#C+YD
z`eC;@@5`1-2%o1VeEq{c+Uh0vvj%;TcKhgqW@=RkCq{7IN6q;0=54U%ZYe&`N4DTP
zKC>k^cS#$R(n#n$WW6B1>@b*mu#p3tt|nh(q#~BX$D(NwjJ`8B2t|qe4xQ*?8qmtJ
z(t}tL7yIscKSZ#3(V;%#eWYU)os|gJ2$Kmu+OcP!sXwZN)`_``yLr
zUVGZ@DlXC
z>)8!-8;JSG;wE)WNK?E@bN|B3x^`;YBEvp;27k$Lu?+Mlq0#~!gCu>Z);+9&P%?LV+j*$>J*-=nwv
zyTWJxo_znl{aO3d_8;2+!~Tpt3Mg|Ub0QaU+%$Ws^*CHFSl_XxQi%Ok`zst1dPHU+
zUn>PhTJYB#X>{7~o@rUm9G&z!cI~34?XlZ`JZi7=J;?QL(`WT6pS^}$_T~0k`%0_B
zxgG9G88_J~SE-!;2?)JTAD%m$9u6a8rl6G>pU6um-78JXOWYJyBei{
zp2+u*j7iFOMWg~$r5YdRkdzFs!MhfJ_3UqOY8?vke>(v2QLE4Dw|bmUMdmx7w*SRJ
zOC$7QXS?%xkO2w4tNt-4AK+t%k2I3rS?9@b>0KtZX0-6f6X!P<>z*Ue$D>*w5QuXjG|d`P5mJ{C;toB|dj!LY(U`#%D4|6>2U^|}bLj|E~1dtOD<
zKZ$5Z_Iqca^FEa!aNfY`3#;<;qOW3G>59k8{}|AU$CrSa_}##e^b$xpz6P)EtxX*
zFDS<5T=viHpV|Lv8=PoQvnnl7s^#o=hA6Fb+_{C`^mC3mNBQmX^N4d3zcbFw&PT{4
ze$FA~LXLyJTe+MYmFt~&JJn9g`css213_~R@RKCQjTU1^e(O#P{W7`Tk$vBp5?H_a+;h53Kc&)LT@|Dz6aqdvSZ|Se&6{WJU@=VKXLvTPjHpFR
z+~@ocPH#C$8Kb5=W(@jU6=FZ}iu@SVWlZ4NMT{?PdY5$-H=?uGvzXBf{vbv|Kb
zL^z%|YggETwy`(M!0Y);X8DPk*VgyR31O7+sx?qeA3e(TNN4(jM@y^Crn(t>Poohw7bB%mojnvW&_>h>v
zU!+6&pA3duE0o^`kJ^5JSS7-pGC(U;Y2+W#!bGQrZcp%K;|NW@n@GUT3Sb#XcWCDqH@9)?-&W
z&?CY>`!4(aGVFPJJMWUI&v7c8NWDbXSIk3kS!K-tNrKj
zT`1GcmGAj@Uu_YGFR)MxyGDkK7vmcUvFwsaStLSXkz(hKh!ZJ|B<%OFpTb}aj7+kB
zMSh3s@g;{av8)&AVP9as8_#R)E#!0l!g&a(clZ&gb9{vz-wa;7=wI#td&&J<^=41a>&%v0Z%Ay$NB#}|~(
zo^Q92+n!?qPis1dvvvfRYn{)2%bFtJmi<8+IN2v6^%Cy4RE)F9neLqD$Q)eeH+9@q
z$kT7{g8v*~N<1`E#aXDQ^GN{eYu;r1$fwS9^8E_=CE1t0Z+DBc7g
zwXqoo``cC#{NPxds8fRX3wT4m+TX$3vcGF3`2Ba5A#oz-MyeuHBGV#-*SjsqqX=kV
z*HOyIdH7Qlu~s>LM&((nTK!RF0`UgKKa`G(Z;!E(md{(ZfnKy5B+PybJ58e%f36DyWxk`
z-;zD_C99alZ4`ap3qU#z(PI1{667yqWr|;FuC*dByGbwEII6<`KX^mB{onj6k>(Vt
zc8EUu<9g9Ox75%5V(ZKT17-g5}YUza95i0vcrusOj
zHVsre2(zx&W)&s7NY%4?j*J{1r
zZ_rFIt!0&ME`8LxwJvq~$;#rcbGpv~QM)YUMmhO@ezc4BL#tCVsxV0fj~bNAR=GnJ
zyUn^MYgI0tUS_+M6|Oyjp$1S3{=h9|x!j_uFPTYY2WkOs385xvUO5d!J!m^QZACOM
zaXGpV(U*jV*w7#uR%2^|Lo7vahL*cnYPkwU^{z}ty^^v@O#2|nr=2DedzPmwCNcM9
za?w!ACj;}pC}*hN`4j$@p^3LXfAe>q_|46~dGZ@?ZBJhON(fA1-n0|PX8d5o;`Z(T
z9<@LAPq(B>mRp%8YlbZwn#Tu&WSRa_D0kRAwpd9_QF1zs0uDe-AmtzDowNk?$4*w#hI%{CZfI$5J3ngQ`!zMx
z$lN8Zq6>Kv3OJR1QSl;)e0D!W(a|t81Uo3O^9}T7rlbpBi7)QCXWRm4Or^xJ%CgN5
z{$S2g+k4Bk=D+l({%r1L%;pf?Owo%G-Gyk4gmeIS)CZoSZs%FIpg_?CW0!5M7pP(8
z$>3_vu8)Oqq1;dTO0Z%@H4l}*Yov}`w&m}>c=KKV{Ig&E=8^Xt{rqqKCKPS(8ai;&
zi=-?s6MeG!Ior-!n2)z5YsX?muD#g^0bJ3#f;@rHf}RWnn*1e+r9z5HP+(W7r0N}v
zjv{x1uh!U}N~YdH;9f8{DFOI}E0*ERh${hZa`Iv{JbMlW9;27~atsO)y%w)*v5a;2)3pXi6rhaZh=0bweoEs07
z+s%pQOvb|{w}&zzok%ls@uz=h*Cd2FezNQeSA$UwGdhPXAzt$Ws2DA)fSGSQq|N~a
zvm*I&yMF#LqM0my%DgU5)>}qW*=O^UVvn*BO-d|Vk%sXKO5`XB>@p|^{Z`Tx*!9CU
zDJC3E0=r2@hY?}WXNzGN$bX7I-geK!aeGbW^;YuSrA6ObZ=v=XV9J_Dz7`r2i;py&
zzkayt$@ILA{IrF@zzv{Kg`9)rH7>XZmE#TCaD*Lq^9{e`kKObn9S}x
zz`@$R<_cp3W^FGNT{5;Z7`L$f2h{P>G0k<|HK
z22?}EK4-1Ha_q!;VhwdJH#Q?iL_zFTdZ^D$$RTH0?^^?UOHPA^iONOzroRF>sNhJ-
z@wo+kEcD9=u@?$0DbAxu^tR-!0pQCi^eldc@UW~^6^8I&Ah!~4h@!|Jj^;GK
z^&=C==>>dwJZ;0VI3yGGZ!7wB$%?0g2~FB+X3D1wO7)7;OPmFjKH4H${A#U-OrYqfm04lLmC(Au77*tjfd0)uccvXE3YewxlA
zESb@9d2{PnVL-FlfYt>A8YAlJXy`34B(2eYfq|#}zQZQ$pcEY-q3E#LF%+%1SpgDd
zvjOd35}2!S`8H9r5KV3Agwhz^P=khZ8!3HfhMhzgrj5@#B5b{nf(?UF79%=qA>^d8|xOtNy!r|BE!R+>|;K)f{A=zs7X#w
z0CPX{I4%?OZeX4_If#w^bRm44zh#`-qiX
zU&}I8t)9DBJ(sy@W$!pv_DqpW(RRvO?q!~A7#8L?1^lowJ0jY!&Z%f+l_Ye3``?$p
z_=UfHSfM+3Gt7+@3`dUPyJiXH-0p0*gN;rqoIQSxVwaw
zEEQ1`^O7e_qTb?I-dPxu7`PfNkdHF^OB$h~(N1G_gKA=Uj?RhZ1g
zz?-b~&jI+Tnlfp{M9ioVJq#0=igu}Lg>}Uo{hY^BB3IH{Q-M*?oV_E|h$g_Y?-5b?
z$I-%h*3Vo2=#EQXYW|1nZ~T2~)H}CXu%d1_fFs}@gJlx2%XkFKCVdT4hnYN+T&#Hfyt-kEh_FI40efl?#6d(QkKTf9HM)#K{&mn2@{DG)p
z#>ogrm>ohD3+2W(Q2KfNEchrGJt5Qz=jH-W7s5Ovn5iIE!3dvf_Z1%k)yAp!)4%hD
zTYubs&h*K@>bl|Yj_rLt2<*4^WhiGfRCXAeF8klRZn*2%-k*jP@Ux2!V;+>}Z@w8~
zrg2dF$AA06S6}_oFPHq_*L!|>*UfMJGPJrjPVP`e!>o9A6?=PR`S09f-`@W#G=E(V
zR1nyv;gD8(cz8Fb=S5#%KcTV2XJ?rkgT=X)vtAF-!xFfkkX_^Sl3PPd^P$`saWYGc
zB^cClhS)%Q=&8dL;L#B4@I=#G_YXt|GO~If?xDdHcF3bQ$+7z=gzK32YAS)@gjn
z(y^`BadeUi|JJLN{#MEy;8sQ@n!r0_{eI-7vS>8&lAE+PcP*Hg{G2~c&Dq})?nGy2
z0ng1X=ROm_GdGF-wv>M*a&zHwh|m>(Am{#Xo~6z-4q4tFaOw@lZ=8J|VMfka_ZaQ%
zwi=MgDL_wj;&GN`=W?oR7XS9hlCf?vE4FCt?Jr@nn0TChAA7r)Lp$+*Z=0w*Oe%P1
zhuWKGM>PRlTgYT?%)jq@&mn9%QaDWPt<;(VsdI%#fNJ4fAznjtfGpwUMweoBC>$U3
z=K}ZR-5e8`9|u<^;LGRvEfjFWT7$u)%iJA9wPqWhsQy@(BV~k4U{%rt7Sls)J~Z=$
zO(eJ93gHF~0W_m+SO!DU<9NgUyMXRc5Q-Ow2~jN!e4OY2DBpu3pex>z4CVF{gj|9z
zkB3Ymp+w4H3X3RD_QKI2e`t5>I9)K5Ib`a6HXNM^1b6{ot_SU%XVpQc18T1JOw{42
zgnpl%5Kr4d)xyuyYQ+Fj2n!8d6{6mO?Toc5RKEk!n8o_remKc34Bpep$9AA%evcYE
zDaCp!3B<&DxH+%Cq!C)HQHj-CTTJp>1~V$%m`jl=(OF{d>n&Z-Q{DNp5qQ%XK#HQY_*oNNRTNR-Cnr@aHfE&lQd4HI
zIa9PP?N9`Xy6AzQ?c!l&9D0x|=jS)E$dJiN5eRStK6pS;(IjxlJ)$_<;-~UF-<{7@
zAll1g5}``)kK_s()U;Berd+6JaVofZ{}hmtKM}2b%v7G|NBa@NrECYE*3!%NWb0D!rk3P&AI0!7O2?GK8AtD%4c!
z+_%BVxsl_9Xn`%3Q+^&wZlIR6?5eO@ld1$&d)}Fn_J4N4YcPAlik1MK&5I6K5s=V1qbNx`0dJQVuv!fk~ijANF;}M6)jT<;4qg;p?MnI(#=P6DJCPL!_SQ3H9mZb
zwpF<^g4e?7RWt#oP88zQaPs0z_3P8zuRf1%(4~QknJ!BvYXg(p)^IHQ~8OM72a!odgN-UVk!tic^Q(YCT-+AS^GhJ59%-xkI
zH-q7_;qo+4A}cB{T!+BLu|gEIPmMHRBmoNLqE?TQ&_|HynK)-OtgH#XpyZzbk1m?P&GRRFoU6nk9d=e
zxTk|cjsm$kJtO2$27wv}lDE(g9r%;9Tza}AS)6aV^z15jg7)24S5A+Ln+jHWL_;@q
z+QTysB-x-{Orv~#jIl;$rbwvXMuRf&6M`M4q2knm!@rCl!1VFG`CJNk#>H%goe<&&U$0QE%+BjwB0ttk?W2iAhQhU3T
z^vyH3Wgf(=W~ovJF}$NU`e$+(5rb<&xr6LL$HQI9;n5>18DPxZUFLcTy-!%xHXXG;a
zgb|wGd0Uq3YxkaqNzackqg_SZ@)Vx{L%qABvfeD$^4RudG~HW+i)oTx&SWotp)yqD
z=9`A-S{p7~-p@pwI%eLSNY!GeWrNx-^`nfF!GowKQENo^a=m-avg;?8J#nhN
zqh)I({%aiQWi04LX?Ku2M{sG4D4up$rDp_tWV2;CK=3=o@!3$N~l2!wbI*KMnny{9*lECFZp1fgPq^XgyTl`l`|x
zZ|ZyFtn_Hj2bvSLJmM`}^PZnyU446rl
z1|M}`FN(MNQS_KUKRV1z|HZpo6_yiV2bEO4PY@X#XPV@56|CN%36Vv4={*)%GL*n4
z3;A+>1)>ognvdn=qyRtn|9@#-GxqgOC&q3Pj3%CAeH~(tXhD`isP>bRU9y>Ew4+EB
zl52eS9B0?$uKlnTnxZp)G`4~88kO1xVyyIJj5Vr^l>sV@554tIss^42$jEU}H=&Hy
z$&~{fM^RzSb1WvV%0MLx;GPZ&IV87)&+LiAX*hjmZdkH&Mgt8DsNv^@P}9-EQF6__
zpX#`?WzMgjOkU8HJoL@m{%poKr#d~{ldV{j^^RqZ;Ks3y9}Y~(IY5RI3)B4Pnl%yP^v=S6O>#Sb1;5~IWL@R
zyg@S5-XY-QA+9i2%L*hk>4qh>
zupdtTj`}6l6y~d>DM(foIKRdr}F|nND1LrAn9$0RkutGt)VscLr7_?AQ
zgsZYMVtSs_Bx7Wy+(xu(xC=O+=G#E-6?Ud-x}pSw;RGa_0>{Ng*@pw(p&#|J;5{Z8
zO5xEX_ZRNK89xcS;o1H&fec>2H@@c0{;e?=
zECtS!KM0TG@(SY#+;HrvZ2mjYWT1Hlt>Cht2-7?{KGl$MjGxVMp5_wOJ6sNzHta4m
zJmCcC&?U^wF5xrYFK}h`S?AW!1Jux=xmORJ?
zpo)5*4unaMmoKnz7?s4O`JCGDL-~=fDg2Qy5$)F@_D9qOpHC($@U6))1x4Xf3&x24
z&9m5^JiGpK@{L_Sf4{`W{F_$M-JHx4`;3mrlSIeCF=li_kZO*+Yk#r5{w)ue=|@>`
ziHcFV8ntARH#T4tY{}fTY{+8o>~a$X^CxrD1e?kZqh=)a40j%9zUZv{(D}`P#eJURSkw>Am=w7r(i!CxE-J7TeE&!xn*s>_Pl2=I}=OqJ&)={
zB@m>QcP_oRxa=UHWFDgM^)FX#rnuyxb04$Um3#&G-C6P`g@_-;c0AkvaRFidvsIg~
znYQT+7>YYi?5C7!)hD9Pv^yimomTQiPT^aK4;A$leXMHpbkt+ngOqpuH`o6T`B!{G
zl!p*e@*9@5>CEBBZ$w?F^h7nmSk~N`ynUBt?Ydh$cinAmFIr&Dx2!6BuCa(I7)KrH
zx9e^}kE>qnOm?22np@Vo8TkGXe%s26&m$^d?rtkzkIxs`68}ZKt9Y|z
z^*^@$RnZ>c^h#>CMEjJ7raVMGs}gVPx;3%ZrT3yme)54XqEhen&g3??&jGE5JCl8X
zK+vjstohqcmmIg|cLAU4eiQ?oDGyzr0i~XfKhY)WL@7b-rSyypBksubw=C=0(|Be3ahw+k!r3qgGe0w~xoFL4|o&F^^u-O#G5OlsqKTA=T^C>X$x_uh`zV
z;nMZrB;G3CMVLot;JdePZG7maM^-<9nr9TJ9Y|JfKK%HmGb>F#=P2uYhvYuQQpbaeRrngX&>LZ|~
zd)|@fQJcy*^CiVqCpMj_arVBt_f_)Yo3$vjn0eH)-uFQYaqgV@1~`@>ZQXv^0ENXL
zrzf~I!!OW1`ogpyBfJX~e$KMm)*%jks0bW1XQgG8KT~|#vgWoAKo%3d;@>TK6kofY
zXIZ89#Zk9;sKxv4!#*_YqWbu&=O&T+`O>Uq&A$LCUMTyhWnFv@>X(=_j4$Dqm)~Jo
z3yUUa-i6ZWS9%^j%fL^THF*#&#ucT$2!E79FFh8ybMooEe*mepo&3a6>OEPyMaaUp
zMEgueZ5I8)vKGIFR%dD@fU%MfN3SdWEAm~^jM9+;U-PX3e!IwJA1?*HsmGi%og`_;
zw?XmdbF)*vN1>DMqo@7axffgo`kagUm7x@bpQ7i^_L4+&75hDYo}njtIC@p=ljNFu
z4axV&9n;^s;gu;5*-NLtb!hu!Pz8PZ4)mEHzw3=D&w#$eq;r9cS8XdVLO+=Nwd#tH~A+7mrBpP
zNi`Qdl4J^6R{M{V_a1(H$&0%dQJPhkqUAFf^MJ)UpgTq$v`PkYfN-bxxyxx}i=~eb
zPkHF*8w4x1uVj?!viH>!FNs=_i=a^$^~YroZaQ=RQVQWQl1DCv$(q6BGo8t@yOa0c
zx*jcx^rH5M9-I0~{3pknOO8)|wQ4hki|4Mp`}*E>yYr&G&YHgtq3V6^^4PxkC#STP
zp*<+vX`TG)l!x}ddi#rn)8wBBH{npyg%Ru}s@tt6C?)xYhTxaJZ{@Pb&U^7)57Gyc
zC%piz07muXuB1Ed>8j10k9Hfez19a^w5L(`W5ms!$>NX3!H1T$8`1`GuS|P-
z_bZeKB_^rOuez3e<=jr>A`FOPCtf2wC%uq-B)Mza)8wZ(8TLeS)!H}LTmyc1cI}(H
z?yhS|G=rpoyj*kljZw3zKouhMNo=c%fTDvz`J4~
z`5%{^!TaFQV;^`Ua%Tl}pvluHT}3lJsf9$IsvD~|PkmfMlqm
zwk|K5`V7h$Bw0cu3Du+gV^aZt`Q0n_L*dy#khXK%?YI-^PfvZOr(VIZswsBuo0C{Z
z_M|HyD+o)ZNz|n>bNt$Uk5DV$cDJPCr}sTVK1zqy
zdt?2x!X=(3&Y_+lT9!igzWV+*P+NpSCqAd*Cn^NxK}JCTnHy=N_j0s4X!BDld-CfP
zLiOMmG**%zMGv7CsBQ6HgwCLt3Z$+)@9^W8XMelmO%8eEybaTrPI=~F>(p0>vLq?Y
z-@*AJd~&tmK)`s5a!|U;Dx`cZ{_U#GT`yCf=}#O6e5803aV4agPI|TU(_-}KOhz{p
zEhUW0DvO@3Y^QWLGo80)MX8l-=WTfR0+JEpH+k31kL$R(Do&iwDM=7jPzq>(@;;3}
z)T!b*@?Cp(#S8SVd*s^2O4Ocy%4eVyvZuE9s7xRlXJiG0G`h}eetHqJ@KZ>
zEO;e9knt0Q>GsN3|KH7nQGn^NZsyb31|8~5|eirF&kIb-Mb6!3-P3a@lcphTEqCyk|f)jaOgj%l^
zf5ML^mtS5mT$ElsNTK$1(T?Iu5h7BVZULeAys@BBTuG6i%YK;u^-XTKACB}(p9m}X
zEPvI0xcI5uw2|u~gZ9JLYq>G@!$sc}p~e3Zj&&{#hnW8JPm-^4U-65e>IO5$cb9*<
zWTpLZ?0yOmw2+fvAlb
zh}uXaiNugV#NPjZt-ZeeodMh1dw+KiXYaMwd+qo4IEOn}E9_#
z6zlWe8;fCSS>>E~oX4q5HHD2miVe5-e%8|o<@xgz^`%2-VQ%G|
z*_Z7S`IRwg4@gNMlZ7c66*F40;zTubo31KP7zvod|Jv?U%Ftqetr
zVoQBl2Cqjei>YGL_sEm~>s~h+dJ%C4@GDx$l@#Or6r(}sHiOHf;&J7<;F&^9(=@{$
zSf=lJT=})~Yb_5K=anku*V3h|1-qE@50;UqcjRk?Vdu5tM#cI(y`vbmJZ@5oPef0!
zsr*`Xj$#^Hn-+Q*LTaTJ$6EVv=EZr;qovWr@+#W3zi^sCrXe0EoRdAiJ5<<})9_09
zm3V6~C%UlwO6B@8YHcmd`4>q&9_4B`7{2sAWKOY~mBo$iBN`!rD4l%yl|&#!_DXe$
zVq53bwR$=sQV;f5*G_EfJm%r!@iMF)?|Z&t;^8*YSn5Sg+W?R64i$ElyoT-N?WGOH
zdFa3Gbvw(b6(42JzjP~e_$4(f%iEK|;B{D~Ngfo#6tbSLyuH`!q@X9ZSC=Vg!;bc6
zb26Zo=GNA&7QaIX{f#_n>9wP@AsK2kU|#XCS}ZOhCfw)o2S7pmc!t|h-oX6_F>WX?
z#AieD5p(|G6ob6!Nv$;tRp3SC4RvD_>+^JQdP}+*Qu{ovrJXQF%!ca2iVb&FTRfdm
z%fQ;Y)vB$8O6!@2A62Kz*$S}!#p4YsZ%EG~Tql_7ERXLFrDvgqOvCf#=cBpJo5K0!
z=c_}@sHMx8^RKv+dGiieU+Bu`13=Z`Rm
z!kj~X;9s3si1v_@u5B7Dac6vu^SnfQ4&itU^XeFn?+&Hdiw#!^Dna#~>M7V?gX%)o
zu;(I|Kj3`5+G68iSkpzJnGC8(QExW@osUsr6pqdMKw3H5rswr;ih
z2?9MV`I8N;#igyG(JDd9Di5c#^PC>v9ZF}{?KE8Z{qp-AgM)1io#pp2`cXrhAm?AO
ziFtLS)*6Ou3H)+khg!|bq|)+a!}#+14I>N#crM}k6#RP>8!k!OJ)IEx8~K5MrPqk7
z7Y)f9Esut)+H;c0b}vzSM_^dN-$ak^4i$F!*vjvg-{lBum{)$c^d4(HMlt7K^H%27
zg<3-^I6T_t-G&KPvoaY_daZs+`Q3VGvcHCB3AOG6wxT$krN^@|9^C?DympK?~4K2bp{F>%@x
zC)7Hiwr;i7xk5dKd8sYfbjZ+BFQY+^;I&@g%rb^o@P3Zx=?>wFX_MiiyP~_=?k`S0
zWOH;^<$Bg|ibc-9`dQ3-?{l?9T1IzuT#C;?t6AB8Oa0Q;Rnc8xY8c2qOgNqjUCR~Q
z`NlL+?AZ?5R#jAm9D3
zM2>2y7?72BfaEv!UePw9Z4Bd9dRxv)
zn@G1kNlM#hrEAW(6=K}&VS6Q`4yg=jAKyN&eKpFhhKEs`2{pK~ii
z5O<9(*7{t;91pZ4=M6JF_+Z?^srWo>oQl(2;ue0!O$|m3M~3*10hw5at0bQjjx0|Q
z=yl1#n!k)8=Qt`$+)$yaeFGSY*B+`{;&D&cpSAMFDTy1JeP4O
zO>2(3n?BQapmZKnS|1OmMYBbX1>Drl^Emy5UiTA1t86b$05mXt*LhJWqEA}eLtGyz
zZxQ{h5L)lu!b<2|$+G6JP*~ZzNicx$$E2n4p&pMQuC!ih$<4yC5~rb+rS~0d+|W>(
z=QN0>Fg<`{WmuutjdRL<3oFApg_XhP!ph|4aFw&|b*Vql6D?`pT<#0Yxapt16KsRd
zLWsv14U59%nf^lKT!X`-!lUA;;Mo-(g?v?bRO7;MPIy!>OX{zON2NQ-BQ+_5&A}o(
z(z_9(TI$R()*#Ik?kL^o@z}3gOSl7`Nn=!}DMqzO>Zs-#jZvNHGAON(qT2A7byP7d
z&y`UvoYbj*xT{ns!@hDh0rGz`s--TY8V_zV+GoSh;t|I@U{Gof4S>VX#ygm^#y{K%
z*Rs&@&%kfTpVWmW(rH6{U!jm}%H#P+mRiz*!iO=6$Y&`Bxl!BFB-Xu@LWl-&Qx<>Q
z)471q-{}^kY8igEJPKFGb5WZ^4Az>=EBO8$Cy#h~t)R7xIxZZC(Z3b_J+Afja35>o
za>)TT&ke^NQVGEmjw_GRvRa`wjKYOlXI?)MpJ`Z+1|HI09pUk%@02D4PX>ckUpNlq
z0`1i>N;w)PHq6q8c(5rp^0~%c`VMi03i}|~Byk9*mvH?}zd=FVc}?4m506HcN!&&q
z5@KfnbxAm+M?2z14RJG9{E!~QL-2${s#CP2=S{K-yE}Y_IP0c+BMq4G)X1
zis<+V53yPhw`kP3%WWbj7%xfd>~B~D1@m-Sh!}9C(55`psedkR@mT#f3ThZ%#$WEN
zu`@ax4I0~Jbaipsz#2v>ae@y=r|ltlP!80xy12TS8mf!6&Yaw(Uc@rb
z0m?zxrCnaeAnH=h%zaWiY5GTR;{C>n9d)Tu!qM^m$_rYfeBQV65#=LPr4d_8=+S8+J*P4+>S
z%^S)mTpP`|sUdbTCYIR8q$cpx=oVrz^T88NZJVVf_EML$&YXOV8ztiwe&+F#Xf68t
zHRS+C)&=7*Jt7Bg#GOe}0&$DxaB8~A^C}PGcDzb4PSdT_>a|uUm&9!rW{0z#h2~F%KNn>cd0Bo1g{!Q
zOLsi$s!RE-ZZ+;tOsu27GmX?&+@yZwbnhx9%44PQVFY^4S{`Hh?q=G|Gu@y|-~mJ*dv3OR+lknZn}XI-h})mpk=<BtgfRB?VRu&XZf5`
z1?xF#h#R@$5%+5$c*1k6RBq8Bc*LD?nW`-
zdaE_&_Gg;OPg#=&{krfv)`3A;w~=}A73PXZ+^F%-O66vr-@lbxY2@bq?Qw)E1M_vj
zvf`OG%J}`8HBy*E*F@u@jA+OH&C>XcQ~8BsjL{%Jo%rHP)rdOx?@Pi7L5-2IN1k^UB)#%orU$8#Fq
z`0^H1x8{`akgoxEMtFwPhZ5&hsWDeb;s%dmJU3;s{?52fQ+S5-H}K_oA?KuUs7CUL
zo?Ue~v((`PZJ4aToxKC)jMMaae+;9#VSkL#Sk_t=%zfc~&N52GEj8u}N!;L3jF!ru
zi#y{sP2qhKH}KWf61Q-uM)6%V^6LuKOS?FTev*G_f0si46k$;DYeF2A&DD2iqTT}b8%%X3>%CDg^PEaY+`{Ggy>G&CLwJM3NU1gE3Q64HQH++#@8jnE7Uecg
z;SCbE)2vjS*K&2hwQ<9O#a$V1cGPO_yaofL@qPw*)ZJNT{ByOi!bs_Ft9dK>ju#k(}
zd8Jmn#SNOojneyL{?Qiy5I1uAqjmL6YmB?Jy|i6%TKZfe#!Vj9tTY`KH^;eho2Jrs
z#_e&0Dg*O%z%_AGw~t%xsaEKkXck$L#<|JC7%q^taPYNx2@&)q$yrn=(FbvqL%Ps)<{)bAF3AW>-0xR~AA7
z_fx$N%fE@#b~Mgetye(?zE6bF6r+K
zM`_IOTpe&t+?4Tgn;o@U8@Fg@e~VY9Q#qNVzn_u*7N5z7{;shsac>AWxVWX%8gqpt
zZty5Z%Y(-4v`F0Gmbfzj
zkjcd@_S6UHs*Ri488=GrkNGEYKO%8wIuLh_Wr_O-;SXHgQfiI4LJ~K46r<%q<91pk
zZg5N78IID3J68u>8#iQfaf?0m0lI4Argp}S()(lnN!&k>xHBDyyT-D_y*^y;;+9ft
z%oUQj!J`;04;r`AB5{LT;?8iCM%=kN;M%w$lZ#vIsSnUq8#lExZj|01^H1VlFL7r&
z5O2rUP-;SeCe73SV+@OQ|*H3Q64HQH+)cjoWFFxWO%PXE;hD?pz&k
zZQPK_#Vz*K2k5Geo7x#SO7D;PCvm?dac4RZca3F*#Vw`Qm@6c4gGVu19yD&J
zMdAjx#GTc_i5onM(ej{iJ1r77xFzlkM`^^Js{^i$8#1}L#h&^AUA1vjJL5*_{W1R}?uR7q
zOb6nwu`F@p)pHlOlv-n+heF|EZrl=|)Qx7XK}q{Foa*zkN;hh)uDon_InU{>s20y@
z@+^(N-aU2oQeoe)ualHgYs?jr{sxa?JU3-(u1lO2u>@}E?+iz2^mncfxVFC`lk0D>
zr#?VeZGTfc`x|BbKGVrky~8=Ruk?4O1N~iNS^B#zY;$o-sWs*bN!;L3jF!sZEpDep
z;s&?Go#7~rxN~*DwQ)lx7q{3`AE2u?Zfa-TD7`=CpN#W1i96GQxN9s++-t%$E^aBc
z##|wZ8$629@}O}$EfP1lCGHGIX~dnY1Fnr5GP$_Lp85b?wQ*BB<3{QIG5;j)H4=BG
z198__mbmM~dKb5pT4SDvLg8X=+!CMEjb^PuN&7RL>hrQnH)^e}yli(l&*`nG7SCz&
zER8=mzshr*rcpyMCO9P+A57p+q~N~7@?bJ}uqFo>)&AEUgj4v{k6^lT5nl|dk5F^4qOu1g
z{$Y8`{>k8Oyze-ezvd96!RkU9+#js1KEi0>5uyz{DGM0UB1beOdVqNt4rH|SwtKXQ
z!bMwxFCQ0e`Zl8#;r6Jrxq3Q*yP~zQM&HLnkFMcg{@W6)qi3Nn+0=V8`NiusX?rh;h&>A$zAZscu}dA2
zdhXN`IWT-$-fOVHYqUoJKjXe7vZnA1yjX=?-W;?jX_q+v!FPa0Xq3^z;KfLXKhsDr
zJsRC2Q9eVv#b=3QlxP=ffQ~H6XMlO8CQ4!?@jXR_>o=K%Qe2eAsU_x8E;$|OUC0)m
z$)c2=1Rv?o6dLfGHm!yBLMLhi3Ip*IK|>3}0got*LXKZ6gFMIDDG5f1&U@6x>l^W0
ztqK!RpIDe&m{OQlm|mEL|CJqlz|AepLp~q#9&K$YL_1mHDpgn{tJIRhQp2LWzHnpV
zmRx;VVR>Oi0rR7tInuCLor5W1~!bL
z&pHGDr#?4L&ijn-rF2_0&xb`sx4M9uL8cnl(E!{~h*UV^oxIGwJ+0A-11v6#@vAVAbPF5SNfv_6A
zlT0jBxY9$WW?w5*g2~Br!B3$SAz2p+$=YBVS4v$ixzgJk;mQSD*w^YpuJpukr4Lrc
zQy6Qo8g{U+G1kg*XqZz6ER*hP0{yqKihyJhtk=d0^ser)BF=3t)`RZh&>^v+oKkeF
zosZS5r45WV*;JSHHu|nz_waNeV=bH-RJy_G#gILz!e`d|}=d~NvG|{hc5wyta(c>fH
zD=$$~1Zu+Mt#4*F~O|ecM
zUj}=6?8DDhVszAu8IkLW2$f$;=HU`ztR8nNq#6lps;!$BF=S2JG1hp4zM5)yLZ!Fk
zsa{j21vqk%ru6C+)hiUkGT2nT!s{Vld^b)Z-~oQ1mdb5h@zn5HVpIzu<=2uL!X@!k
zr5X?GqH(H7?}8Per9vNUE@5~5tb%u^|6$?%k5%GcAIf#7$u
zNgIhj$&HhB!qKYqX2;{WfgPD{bP^Dfq|ydEUBW|{NlRa&Mded^J~uAKDW`C!Hvn~<
zV?9nF%@t*o0{B!rxmBLDJg@3839pNg$5OAa8O<p{dWTsCUA*Yd
zt9lO9MSa9_Pf%)}M`?xum+T4Rb7q@+f@)zNU>C5&bA-ZvPpDp5y^^@N9T06xP2~lT
zGb4GbSH_)M!fG$ol801I@#G_9xS&^U-87mO}75Doy9&xZB=eDS`xWBj`
zzc8A+11A_VWy#KXil{x~K^jSOCm^R1jR9V`b1KhxdQR0d9`3}+%6#y1YVeH3KuBXi
zUUQub-7W^S0=V)qI8R)W48bp%3U4wDzl;jrd<<#z)i>&!3?nA$
zD;^-Py+489gar?&R;oGEr!~?I6ZMVfm@cF8S60=6LaLF}WQg+85B%n9fuE?aLcoEl
zIlTq1zf>D=MP50x$4~t430IC6&qv&#o;huT@@a*~%R8VBDq9
z-n56j{6=we1AoFgpDM5QXo)5e!z*M@aeao-jML$3cGXx}#Vh1^vFB5$$HHVf*AkDn
zD=GTHk0q`p1}k2D<&~82##1U=1m1$R9{)v2bW)SLawAY}u~&ln?jsP^>$O)Z%RY7lKBT>Zc9aoFeYJBSs86Qb
z98iz7S8!c*Kj(lZ9T(n%%0rchq4S}-&S-*+KzLAjh`mB=&A901foaT_92fbd9zfIm
z$>L1C9sO)0K4b$r3Df@lH+BMYwqdbLhexZQe*6sMEDnimrRX
ziVj%dGY-=9t`uQ#qa}G)ir<=U8KYV?r#w0I$!_!D7O@`Br0owH%p%?Xisp-c`Td@aF@}7-9bv&
zKYKPxIFIMC%EX}J&ts(V*>lgW_`F`*e?p@K-hmDV#+~fH((fzNi4R7=ySeN?K6@rc
zQ_pt{($e=I=IJ@nIl*K;yFdw>(K&fu_MhTFolaUe`ihRB%1^xYpXgkTI{Gh3OhaCl
z9JQKMi{+vXJ63c~sjDO-3VkDGsmo+l16#Y)l_aFv$240>ttyQjYl-TtZEaHH_EJ~l
zQuTmVRl+=CsXG=Sqm{bqkElO_82oaKl=VlLtk*z_e#oDfR!J|-^;vb+A60)8@$o>G
zup+tf)2hP}?>OFY1r-{im%QoujhkAs170
z4t_=4jTx5pN9ifV=*lCk$h=PWX;Su7-;dV!Cc~1a5UqzxqjU5Wg3W|
zGi)?2o{Et^jx^qHQl1k10T1uOkmmW#D&_Nd!ol-EKBB(h4$mVZh1{Zv#_^9l-9D%?
zIjY{_A&(`%LbFmeSWZtL!Jk|2oUgz*h*}ihE0$T`%gp7JWzv!q|EcxDYAUTVrqkmT
z%GdXrZxlh=>nvN1<@yY_UeKBwreC=;RlLK
z-vGq)13;viHkPFLk5Gim^C=x{Nb60f(^&Ajl|kzA-go*2VC~xEQ
z;GCx{iK8#Uebu*(zxp;Y86Rj)5;)~KCzO5y5(pV4ftM6am
zzxp=dUG@D*sqarq#CVJK{gZ@L(v(Yecnidve$`11!%&iSFH5VwMp|t$8o2t__f?vf
zs5@D&fs~q$Sj*c}I@Sy9AbFjtIi6{{c~0fIj#d??95{t7H(t#36{MA}C|#jEr7K7)
zU7_bXm2KY0l9c?XIF#p9m1=ItORILTljl0s>T`vlZ`Z-kb$L!&P2YzWoXIRvyL!VM
z=dHEO$we<&DxPKS*^V5<$_grHJ3`nukTdDo4jkM~h{Jpk4oB~Pwllf(eVpww9%>4g
zRHi7#e>*)!8I>5S-sa4xabXdoQ5-
zQIh3kyN7$Vo&PO*Qe~VVdY-rWwgR6>)kYuew(~!9O>EvsDNVfl$dfHvVJY8M(5IOC
zjuZFl%EG3JJlQrOW=)J<#|bQUf&(YpkCi
z+yfJjmC8IlO*H~W-2UE<+T(RCp8_QJrKjDT1RyYWgJK
z7a|^SD|LcPo)_Y+K6(0}_v1tsXK|-hC`wlhWnuX{#Sl5(ib}pieDWQ|Ggt1$X~g9}
zsL6Y7m9svR_
z|1pkyX>!CR>+%1A%u%Z25v`slSq~Uv>ElweUhkhI>+KE>dIaN)iL&ZVvfl3CD8=rd
zm>nz8?y>^t9h_u+^=|U#@1KAJBQ?T2<{ccnB37+-{jB#-{JP=qpC}(>4{}A!J2;@Q
zW#<8KG3z)ZC4WU6jV6XE8jV$Rldlt}>xSW28VuS(e6VhiPw{$1Y&^jkx@v|?f-@+k
zxp7CM6-T`PD3u!24%c4NEfFToN~0PNDS#1ifb~Ol1gFt5>rCbaC5Wr}KvwXQJN`^g
zc|`{_=BZvcY~dI8m1en7Rnp`F%wh)vs(v%Lj#DDUy)p_C;L
z=XkDz9nlnwG(Lgu(zS9Y|M+W!<#}<`PsBsSK
zoOPKtT6a7w5=V$51~YdqDjiyksB{JLn6KTkQx
z&r=8ab3beL{!@NpjeS5G@s6V5V2|4%(gRv)|#s44G3azE;P
zS024k0c=Un3s&=G>n-Ym^}@%uK{64Vr%|%p?B(6rWxC!cC!TACdXTI&UXBQ#^1j&j
zFZ9eBO$fK+|KO7mVJFdif8^c}hA-f#c&!F;tx#FjX}%bae0H8DPVpuU-{+~<#AB@(
z7mp(?9%nLISAK)7G%Wwq?{ItT9@g_VOjn-Ya3ah9EdjPPx7lLzM$34d;VBUvr`*Kl
zKcdZLHq%*>U*(t+R&9A33Nz1Ja>^XP$@x;XM#r^b>`}4}>n_XcZ6>J@bIx>PSrQ`7
zO3x4f_M5EoSS`<^IK^nrFdfS2LX_KcmU8PKuou|nmvKU1y;nxJ>O1pLcQvPsx
zJ7z-ky0eGgw*4zP%RD87(WE)F`IMaH#w2J;_cVj@c<^IPYASBz49)8%9vo+J=SyTS
z7K}hv7rO9y9@6APS<^uP$>a>y-b(Ph#)OionhPs!PX+%j<rm4
zwW_?zaco4#rGeIxsR~(LIjPz6kfwA>HsfTc%q?
zumjY*mBH~9w{!i4^bY0+TY-6x1#|2b=)?F*7h;sJjV5q>nKz`@zLjyHH)#vGH2rtG
zK{|qb2lEB?#T(L-d8!Ay!JKS2z^=lSZ<%0ozGeKbQoNR&nsYbEw{W%_EH7SLyf%8B
z`GGM}UQ;qJm20kKdhuHLlI{JO9_JVQ2cOzJSbWL6x*JWW>0x}<)*(Eh{K4Z(o=v7j
zW7Jn_QC>py>%jPG+v&jg>XuWM$=Vtt2yLyn+8tbR2a5@(=v7Mfdj4Lic>li8F0!VmOxkm<2t>
z4Nf=6JKizQj-4Xq?id+ddx}vVloL8V1l+z%Yxn_=ClzBk
zbyrWbt6J<5Q(+O`j!=2cRU5v=AX-T?ddKeSX^QnUlf*X-hLwh~RvN~;@3g|Y$u>3U
zb-ePJRK8}MTAD5`_4>UujHSu2q|M?`!(c>onUQUfb^OXh*`N#XF2jp9uT$vA6yx#l0fW&=S!&W;WHnRH_cN{Ui@o=SNLeP7
zz$&gFCE)b;LPG`!d{Q?alAzOgSmL8p&+|SoyNrh-c~~?!tsbBL-ocb*vQjEugO?y*
z`h5C4Y3c8qR%=;!KiTU<3JN8A$wfYLG>>OVoR);~nQ3crGLyW?Oyf~m<)J$zmGvd5b>fvl@e8bzgEw`U^71^UL#=4ub0@8sZsTC-lX8lt(~L7d
z4RUSBhlz9>OVp3TpYXWyw75<6fCjqhq_o0Kn*e9{9*+~I2Fp>x3iC`hgEEZpS2j91
z(0Qex6436nsg}5n?|echx!luO)uVj+{Xnx9?CZHAeJOp39DEwvTTbe}zle{4i`&Vi
ze8g$W*Y!%lQ;f#aWaE*f6GJHOul2@xaev}n4ob!`QgKQ%Sfwe!6bny0$<_KR6i*Th
zDRrqWa0(BsqBMThpt1r_%2^@bNcB-m$ih?TmXc6igUQAt_3BOQswJM(yvOJ`jqd1)
z^~U-HTGStu!S48yj87!&&0+S5^5Jc^%Uvzf_-kJ2q0
zSN)KpYY9lh)A}LM>|#=0_I>N{;x|oa@dn7?V|CS}-|Ntz?ePfE-wY0o;3<*c4(F%o+8$+I>
z7P2u^i`ANqp@Y$CalMw@b7}>{{)}o}rCcheNgUw^SR{S#08
z^Z!eF{P7?B;IV&t^pQu_t@}r$hmjt7==(_juy)Ow2OoUkf&1^f?|a|)YS{*0;X3V#PPVdFP#f`?t%N-*Lz7xBt!GEL(QlZMWWf
z>o<^Yx#i}YZ@THPnQlb7;f5Q&uIaBdU4Q*`*L_XWSHHS+>9yBhbIn)2@|7iv7caj0
z>Z>d*T6E==U-s!s3$M81a;63I=XZ5oR+BEhbl$v6{_Aw{#TQ*PckYE3UU0$r=g*ll
zd-i$foqO)ASu=f_@x|%qeBm#rO+EWBvNUDNl(Wt{>+?u|ZfWx5Nla&+`MJ+cJmd7!
z{}ZzyxnWXXK$A9*-pZUzEKYhw6hkt0ty
z;rQc6j5zMN<39DNPaS*gvBQTCABJ?yCx;%8hA@3X)6xHLY4G5q4w{bqpQk~C1`Zr}
z#1V&gONSjcU_gIO{g4hlw3DfC-##7f?d@%Cy?ggQy)JL_XLA!#_2V)9vVud_q(S`jJhgiMfP28}(F>(H#MQM7
zlKml|#*RW^)ROQqNPat*PipvJcuV+lG%MH;7IS_q{}iqziVdH-k$HGE@oXtg#fAZk3__gai+hZsW!eO(uOr5<`FKjD
z(qq-bOYNo3(%4d;q@gsUFszIdDN^6$>!o{w2TRYD81ZfKjmf&=*DC`^`t;rS{G$9*
z=z2CCKV~fTMW93+lZEK#%yE5mIX<0*+X$D(FwZ5yl2&?-@r94ZZ!srFWs}Mnclc=a
zYxSpBK2?5wz@7ZvuJY2-qxE-}cb492JA2qfG=B9m6md6{YRC4k5UFal$$Ln##JSo$;Mb@C3E5SJoZTiccp#`zq@OhWNDOb0Xz$D(jA1hz~Rz)qu}*d@jHTe1pg1^V7<@^8JJV_^DqZ9`w@DC!BaO
z&emwXlRv?+a^h;{C!filY<^7rJUWZVM&HSs$wlgktLre5#*RqGx3sWchu$B1Dr)zz
z*77uSV5X(xd-Oq^ANKfKp>Ujx-Q#Ydw&T9fJUUPLm>>7sVne(wX;n;RT@Tk?>e?~jLwQ^E;ZyUTme!k+5-^j8JTx}8oYoDwzM>(gm?wI-1Uiq-?
z+r+f}x==Xg^Mq{lw_nd1Q~Rx2;(jDn5+*r8p9J7U;7-8mnQ;hpIP>m_)~fe*$71F^
zR{T}?Xa{W9tuFtfIykts{PpnB`mu%E%HQYQ?ZC*wPEx4bSl$(%?d9uU4~7<8WGA9u
zKmA+i+JlIij3;z`SvQ#La(Hj>Fs@)0hWCc|R(eD4;?rhzUfpgo2#rv(?CC|(wfYGZ#(LCR;E;YSMP29eBrjV3d*$V_0=bm-sxl2<&~xN
z4e7Gd*Q#&PLh*^x?TF}m;qDO=iw%9ylf|>6hpTs2R@6;Tet|anUghreIgGmpv93(3
z{~Dqi1?&fv)#;e};n5W8V5+=|UtTO=#kd&j-K?fh)sL?~v+`E@Y8mlV-YMQ#X+gA;
zE4%7{4h^tUfu{NoF^_r|ZmWN_E^KH8{6aFK{@2tN%}wvALmTvXt8iN#W@8L${pPx+
zUc=KBfVS0*DSp3xc>O!|zpXpH5%h*a03Tg?pziGY9b=#5EDoQmyQKl~`82MO-isD`
zv;lqNQ@XZL7}uGO=h#L5df_qfyi@n9B6=o>)lGwOcZcv-_>VuGhjS2tWhsBT~5H4S44^+oGcF>3lB
zIRYyT=JLcAw9hzLV4?-kM>SksEi~TRFoCsG8mhN8+(f8QI0-%CQ*{~IrwPp(#p(&-JCRWAc|5%<8xDb*($o>odaK3W(bnPA*$
zYPhj_Ia=o$tJjw4_=ZK*YZ_l}xDj*y7lrq#%NnNR_gi#z11?JR|>BwoxuN&s3@T%vnvH}jHrh>~W@UsrJ#v6~>RnPtu{3+tK)#}mm
z^_|I+_0OT4aMIfPKT-jc432_4kso%-uTX!rFl;2WG?W^4*H3J!G(ckH{Dy``wgys<
zYN=fz%`5je^hBGr7_Onc18rzDmJLG>z26~FVC}*xfw2U`r_5t}7k}!h3N^e?e`eht
zu5zsvV8GuLd!BwrdKi}P4_nKd8!n4(t-l@k9eEmT-W-%={Pw{(q{9x9rO7Zi69_vs^b#(jE1I=*zKa_I~#?`eFxLHfV(vBLd+
z_Lst@O6B6l=X8cOJ{dm|-I8fXL?z5JrhbU5A0o9h#6^JJ88h8dI3-^*Y{IdJbkehW
zR;XaSF$JBj+^VG;DTQP9>G{@mI*8Hm_?pI2{29krQ;Z&p_FHHuTtn=sAA7WT+OYhS
zOBCO*>O}OuCb@Y0>^*5ivGB`flHP{gQwDl^cd9;&PZNNKN-9kl!Fh0_kv#*HUv%h>meFC
z3pb_B>E8!02fqm?r#*tVlDmVlXgDw3nY={4=g-wpmF_+Liurbj?Sf7XNjg{NV=
zciOwKEa*s|4E{ZBPwy_Q58g@-hcACBoE-EB86Ani?kg+C>m@e`h(2s)x)h95*Lq5ZI6LV8x(CtQ$T9nLO19bSZ+jF-4J
z?TUU!4Y1I+upF&78xmg#%G#!ALBtvKD9i{aqwE_l2o7VLraOXiv@7~;v^$)QHU*_{
zJiI&}a&v-Vs!y=DrB^}67t@vLDwI7$*YWA)q@`2RUk0m!>GBkXT|}3
zdSX4s1v!?+_oOr8Ers)fFNOo+p9eF8S?HCSg)8w>>9f>-^h#&=LE+k9P~mGq2io*_
z>6M>4|2r`zHU(z}Cx?@x&FMSw7W4}IkGG~*M@z%sgujLKjC6W%6a1(~d(tD&mm`Bg
zuwD+vi4VO2u?4O{uZaKYzo&m5{Q>><*pSL$vUp;{Txk@lEi*L;U}Ut48vRuq*f}{g3;leKA*>pz}X5qT1pw
z1a0&`I68U&<45KS=HvqW2=1$HHZ-Seh)+I9P7XRahl)Wlj5mdoig9pid<#a?;mP>q
z&%(*^7lWS#i=&lkOEE3{GghwSlRu>QU{=pa{vuk9NROAX{HIh#a_|}+Be#dM<8NU8
zd;#-uap58K#vF_v_=)keKD-F6i;=+({FgbD>`VKm|C#^n3%N5qhy#d<*)ZIUOs}z~g9Zu^v_?VaZ2prp?7Ne*F6-%<4gfA0?j)
zeuFq##bd70$EPPCj!ozd%&nj^c{%<`@@#N&@-sy98?Gtob68=17rlwuij@*$d_(Xr
z7*T!Ftr-0>nlOjPL3UiY2hn^aqv=ET23E}Bc<}u+SA@cADd)vL_}P>16$ui(iC
zh;M&1NJ~U|-xn=ndXEK^y%{f5u)Z{1Uyg6D#FU
z(jLhPveI=Gc9YJPGC2w}dK*T_Tj>SCWX!bQn1c~kX!Kq@5o^gD%<8w3(!%=
z3ewK*^&EBVHH^BA;p2t>
z2tPn?H3xU4mnJVIf52*wQCC=xHYn3RxQV-ePpcx3drMB1{lJl6+of_|w?42c|vai^2u*vEeN2
ztDQj;qWNNQX)u<30Ny}+{{H*cQ~z9)N32jgSgM9)McgQ?~2QKF>?||
z<0E1{OqWFef_9#h-X>#nPdXvM*&{xIt$^`41DE(4f`{YL>4Icna!l}c;c2dS!STTp
z`1DSuB`3i*Srvkg%vKBk(uyjP*^9c
z!sK9FG_P<;{H3rhx+(ryuqZ^!q*n*;pqJ4S!E(++jL+uad1+_vut!4vH_0iC!OfYY
zu}_>8yciBkHlR<&v-Oj!!v7Ucl2ax5E{JDFT;ayzTz4|(UAiqkFZeg~$d1A#&^aS|
zLiEiFdPlEBkHPAPX#Lq3mxuw@52JPLg-^?@Kr19ah%d(Z;_ng9ov_jYN@w&mYQJDB
zpmr$MVxC~iVKKZQ*q@x7yhaP~tuuNdcq%>&Kdm+k<9AT>8gS!+H=~`1Yrj8DqL&W~
zFN!Zqz7qW!ejXKeMY?uE3(k0}*-Pw?bQ-K2j~FU(gx(tfYnVsjg0MF|3ErYrdJ-QQ
zbi|(o-=JW>n~UhtaBz4`coIt8_fHPS#a|95#m8Yxbuv~^Mxx!Gg0(-OCr?d37oQ=c
z;LZ4K#6KhWC3>j|D>dQ=?+4KZwWB~SarZ_aVRy%xcrM1^xOi?n4_;0R2E_}YU(Q!N
ztp{&GQ#t-hIy!C$$Le`9UWPSs2JrOvv+)gFIbF|Bh))au5MGAf`fk{a9zrk0e~U-g
zlfoD1W%5$|ZFu=gIGMi1Y_ra|1aF>BZ%^+?HUT?B#_G%HzqQ~P`;}@`UzKK5jZS;H+L@#1*+ef`gkN7Q_`|m<(cJyjgjP@r-
zVpU6EsVjI(=6Xlih4BJQ@lg7lG{=L`^KWCN9ghA*1bFS}6Bq?@28d5&4~5Oedg{l%
z&lYF~2J=Lq&n53;
zO-$2IBep~ErFX6bv#|DDkh~er;%PEQI|XlHrEP|0v`kihz|$mX9C07u%yUV44%+Fx
zs2E=u&ri7P_6@t@>lp`hUl?AHeo4+K=vhd0CcmKv@giyGE1|m?Jpujkb)aH@jIZGy
zpe+-B4Vr%!UKIT)>`MM9Ez_08EYmv7r!S}2m7u>Lv}j-6=6Ya3dQ`j|G_+8>H@FNf
z(-jVhzlGU*cf2Z{$Cd{bV>7-#>WUvqSD@vkXK|JDz4(dvkLZE-MuU$z;I@v=UemW<=P4xUOr9k*g7
zot%6&nS|D#8N8XCo1B+ih+PW%ELtABBz^>MR`S*4#^jb{b@I=c*UiaKwB?gGSf=&Z
zAHNvPNQ-icE2Y)os1BrQb!%JdpH3t6#vE$6@1b
zzRcrVs2OJs>D9Er(r!m!_Ra?HMM+<@d?#B7D|t;TbkQj*8L?ARa<$Y9inO+kdWoTLzJ+*xp(Tw0E%Z+ZwmP)HW3~ly
z(JXq7mX>iguqKeoHDNYJ*hRrxsLe*}V4ZZWy~!Yr!Ho=P&L`2SmZWc~hbcM(yNX1E
zQ#~{%CD?Fxj8JzrlvnsC0y~M2^SA?JXtIleJ-S6=xZ3sS4DCIDn8QceErLf
zK#Qg+H)14)v=KbbX|ro_wGB&Yi?l_)H*s4LJML`s8e`BqHCYTesh_Dja1FFTaGw2BY}q_JJU=Z_*|5=@mm-PlQF3(<7;$7^1;cf=OEvzxzI4$z|5Y-8>Z;JJgb**FpZIpZTdK!P?|Spa4JGcJ)hVD{-x
zEwVLi_OYEcNq^@gh>heS4lGE^s87V}%Hky~eyl8KvDa;ccnQdGJ;MZz0wsUh7TqiDN5kXVH+^kQ#e3nO&$XEa8?RPU&W%gju$3?`F{vhg>@gxEaYS<=JxS`6m?4nTr6(g`
z1qa<&dogZV;^X4AGWrMQ6W(kLm|dF}5{Fn5KDFyw9XcmR*<+&UYq?gRm5qi>Gq{`a
zk@dkW*Nl}W^sB_7)ab9oqLY#Fn~htO7Y^C+6eE4xrSr$EVca&O9WuKXzv}_EVa`XV
zXEsI{#{l|~P&fxyfHEh6n{1k++r<71^x<-YthK?X?eDxn-9rbBLo~R)19t`y&*U{@
zz2P$vi&JNS#9*F*yE$!S%(x1qtgI6nCm;CMwDZ4`gFN_T>wLGq_$fJX7hA2&V9h6b
zCMRJzcVkwXXW6+MXI#gwCkGoH(20BUu&Xh2>kA(Zg{5yNrTx8K;Ih7eg-=7^
z{ZW?=u)sLotc>06Z5mXBr%~8Sw8oJbz;1x+KVmp49VIt%asNW@RVsxR7>7p6*H|qM
zr6$TaUvw2YaGkQ0CA=sy_dUj%PZoz^@^RoEb(U}?!w33Ecz$K8
zpTrTso?YFLj@g=Bv$%0F+4>9KTt^OkWIn4`GICu@Bz3hTH(3Vly>ZRF1$Wb$aE((B
z*_w4G!B=8%&%pJE#fkecxGLo?Y{@tvucOtCa?)iCXI_~E@H$_>Z#{-P_AYggQ@yfC
z`O`eLak4ehGNMuLbVz@BuM)ie3%c`4M`nJWClArE@w=8gU{}N4G}jVbV|cbVjUvsF
zn~RfICzvI`Xws1x4B{FSoRDEN3AP-^8SL+bs^P
z8Sb77o|HXKE=|1e4rl|oU0-sI;haN^oaYiTd94iqQ3CY*s^BBWJfETKRq%Jhm&M5%
zG_vMw3;h8IsvvONzgT!W!;j;u;mD
ztgyN&SYIlgdG|z#7@C=6u62u1==Hg_>%v{8Z1!R;tFws7-A@Q_elU+C&=wr$sfB--u3BrS9~
zs62yn4a41Ewvg$zNVBr0jc>w6~IxKP~(kKNmK`(f6x(~Pq%BOT}L=i&rMb`thb=GTk^A*X|p{taRA>kjhRkwua=raXP3^zT7Qwek-T%fH-Y*
znN~<<(eWOF(|9khAwjd%yW426Uc`SU-|ZSw<@MAcao*)LJ_2pd8$cI?kLd{~`~mvh
zonAulfc7Tefke50Urz)T@2V(|ME7?-0@LS57p?_9_Jk5H!23%Z^tEoxQH(=sXVTd%
zFPNhi;Q7IU3FqP80SkF1@OITkH7{Pc_;ZEdycf#oIlw7k8!KUAjW>BZDQy2lwfOB&X
zc9dRYt(FTTU{chP)QKL9$^4lLC+{tY1kb8??F^b~%kH7;`odm|`h(hxr?s$dYceH#
zf}Q4QpwPveY@}hXBz@B#;%TkS2%9e^sq=+1%61H;Wb?{(~3w<@QC)2p+QI0L%{dxkP{iW*(#&!bu>~vzIOud5pXB
z?s}}Y|BM4IdO`FVt)*YX3gvcmc#As_)R*>*PNQ{vWOU&@M4mGl`|0c-%vP+e))TmL
z!)cVWwb%m^+4Tgi`?b|pXuO-4-8U3#Xp5TrhP1Lo^v@7_7v9s$jV|bvwUr#IAMfe8
zwO6dWRiCob-v_Mj+LGQg@bUWde9^K2E$-HCYOs{Gh4%A7IN0Cv?x!y7m;|WShe@
zSx@;9j=roJwHZg=Gr)NBy*EAMyaIf*z_R-5Obd<%Uaq*)W7QgSzUiH-4N;8r3;G!~
zJpWRk@s_Z>SL(Sz$@PoYkV{|VJ-O`OjY{~_rK=BfC9mm4Di93b{?q#cIJ?Nax(t}E
z;9AEmr%O;6an6FZ3b5!Gx{Yqeeq^?bZTnC-LRz`PtiU5jeH^fmg#gwaD?8z}E0SSXQdG*=3bo6925E%Pnn
zM=-SFP6_g^;A)GYwnb{a1ZOu3HM*qDYvs)eXXSeFGHVm)b0byTAg@2%>TS`>@HKdO
zgFlObw|ko}!V3LoW-+fzdO9~ElqWCmK`8rjpixh2tD70l6DFSU8bGF1&21YRS#>8JF#Hgu?=>TLsNj~ZR(wGgYa~_
zvIOn?;1qDWmCae$?Y$$1Xxb2bMppxR7jJUvQTVk*EKplbGI?-{|M56Li%c8f!|-jC
zZlj7Eer4m_w>D7KI+nT1ns&Xij+=X_MHX`PjCuS+a
z*KcVJavRVCH8T!Z4!QfDsxMhfNgsjfNdtuQ>7DV-4{eQNt8Z{r|ZvIubUUz>EIC1u4)
zo+mHHJS@nVKVSMw<}!U1O{f`^9O_pVH|A^FFn$W2iB6PTsmuC-Q1UnUrb9op0MF*m
z2Kf48E({P$^yM)0y3^^_x$Jr|Se|TQyC>75OQUzd+dB>6JLhU!TH##QlrGe{tTla4
zle&2F=eL8v-+>mux5c1q8oB5>a%a8vW*}M4wUd{DDvWG(T(+ya$*YWl5jt9X*w!w+_SA^@gws5?D3h`?%=c
zV4PlE=T_LmXglePC%@1OeSOgySvx^4TMtR~2|kyj&#|67jnO4sIFY&Wir!^wwAqMI
zIjpd`IC0;OqgPf~j4npjfgRyt<+bZdi63!l5-zkx{0r9OUm_}e%THFO_8A{0rif-Sj~;uzg@F{Wp~5Vv_AKzyX6E
zMm~?8Y
zc3Kpd^#Sg?%m>f7?j8e|@o-@ucr7hx+z=+Oj
z9GPPIurP~~@j%w~lJ@}Z;jZN{Lwt{+m2HM-tm-ANE-lHs%x)Gbk4Y$pw~7_m36Gu;Dlz<4y4z8}<@^AI6-Bk9-OWqCPVoEj+512`VwD?`
zm;=OwKgw(v<|ovtexO9G;m<8r+CZF`+nJuMKShtU7J9h@JmRI;upTU%)%Z-&FR`i(
z{ES^pwvhAz3a-0#8#{pQbJ
zFnj*O+2{3}bLsqkS1g#_@4|Wg&X|4q%+Gy#<|P;RyR{$wmC&s{C-fiOuixDR`j0;0
z;tS`^?l
OJ>cU-|x~ZF7J2goPP6X&O3j0|HHmN?6R5j7hE{+{7+sy`^&TE5545#
zi-Yj&GY^WMGx?zCFC83x$C(2@IryFj28`;rYV6p+Q}&AasSet<5yaNf+zXP-Crzb4=Fz_F)YeDUn_A$RTtGw07d7n1#s
zTs8K=3&)N)2;qnYN8R&4d6-dV%{=#_1sBg;a6!M>3(lQ+nY85s^#+aGO(9#gX>2)D
z`+qD9qeonR&jX_;ThDpL3ubp+F?-&*v)N2efB*lI?T7{co4q#ykn5_>gkN=6%W7d`
z%PhtV@Or6Uq~6q8ENf}MmSkZW*^(_8gN107x=T`7)m2SbwH7aA;3p1~ghW6l$*@F)
znPh$_O{Uq&@@F9|*+~dl2w4dO!}4bm5(ps)Z@zQRJ@4ID?^Rb-%ONn6eqHa~d+s^s
z-h1x3`$nv`?JdpE=ZckjSv7zo%3F?}f$q#2ve{CxlFb*(Zno$y6+>aWCh{gJyw#Ca
zYdh+a^knWd`F19^nDbU}t6p)SBem}FK~nUrdp39Rd}(oR#LZXS*=&&%<7AF>e$LI7
z-9q+c4%(8P&w1UGCo<(WiK?}U1I2UMLVhmLJm}|SJ&e?KdjO-61x6WxbSr0aQfg4~QJ3M$?$E^O@pmg#PDDMnBFP(Y?_?8xO#p7gKd^so=7W3y&zCQ#?
z;6pZj<@{-gV*pZHnyo+%{ZP5$i$PE+9U$A{QV#Oyt1MoGB>F2C7jh&AC^(`&crL$K
zS;`g=`Tp}DL&P)Z&*TfaX#(UcXFQ-5N{ery7eIvzF!LL5MCUE^A~+HmaJ&h>TzE6R
z*tkeWR)aE(+43S~{SmsFH1!R~d8_|6|1X@*)Bx_uE~I`q^#T7qIC|(8{A12P(|`)@QpuxW5=^z@~n3~>s!xy;MqU*?1!9hKKs7sJoTKfKj$8t;`;MG
z4pQ^q*-={a^Urmj@kRg6YsPN+pMGb$ded)R`vw2{wKqQR^ZxIp=b!h8bJlr=^FRF0
z`G4;F&p7A2$|*R1h4{@opY>mdSQeeX^ndfZlJgh-r=8FEf9CwL{|)EK=Y87$wdZ~1
zdFyZ9a`Qts|Em9M{;&HV^B=vr?0nGqMgN!lU-m!ayvJYmf5v~?&F}X==>O8qe|7Vk
zTZV7>rHpto$GO|-*wKl5H>w)
zolV$o)9G};ZPuAJG*A`uw>dBofGAEdUDkOPp7qWRc;A5MdN!{I_KnVsu#sJPwD)x#
zd6KDmz_k~@J{+d$`!mk4bIf^(GZFZ;)49)iv9TRA-@EwxkaNFt)HxDhI&8WQ?`QHa
zd?)+dK6D*&Dp6g7>_m@`>_zX!f1T_qZ{MdhA({}M6FHv9p$Aqp|@>e7?i8;&ztCxPoW>7JJE+WGKIE~w@s~P`>UArt%Ao>
z&VOOwgx}9tT#3rY4$aC>Akk2Sw%-vn@c08ZDSgN_#0^bfW?zYb@D=xK&NpDEAHk6L
zyI#&bBd=j+1D;{z?{Q}o&j#f7F_`ntPdPv9JmUPe^K&qL62;nYJ6{CeTIV+BCT9(D
z{d1jLoSU6zJI{kwJ`1^a0Oi07oae_L%H>pQtaCD`9yEWp^Sut`&$XZ(a-M^W8+sF-
z{sdTvcPq-AZj@s`==_lL1I`nO#rHe^5$}TuPXQIlqO;^&bRNf%u>Z-q1iT+c85w`h
zInk%=#Gms{^m(Dv&hy4P>>j7R=S?yE4y4hmobSP#p8w#y8tF`?NBG_8R1%&}=SPgI
z()@SWe;R5fTz&!PG5rc-yxrhkaH7x0oL{#%5Y=xvpLgDl6s6pI
zUps&8Jc;9Z{|0Y*Jj1^keA|1boL8{l@=6L_W7yQHVjJ>vWAsVwA1in;CSf##DF=7e^wZ2@
z+M!4O#6-4f=hx~U!mugGe2Rak@NMszc5=kd{Drb>#WWq0Z!1(GPEU+Jsimc1lW!76
zGnjJdab6m0n>C{)cL)9T_8;~2WvitBODFmezg9vU;;!ZX$k+&6P|YE-7fxjcKY1eFzt?G%&Xl;)8{x0?a~td
zUnD&3%DY|s@1*qE)i5=}e50m0r~OCMXAXw;spoK+OY{+b^%7j!ezoZnr=LLo*ulso
zJ@O|ef&7&deH>sF$3lvw(?u0B|P#ScP|MWytlXc#3>}rBsGMsq=^j)yki4Vh^t_J
z751;L;+b$JoxjDe{il~xPPL5!rMc4n591bP9LxYw{ON7~CCP6K5EO4BCbJ}pdKmfe9%$Jn{?)rSx39M6
z_ipt3-o1*)ah7eNSmx$owK3uvX1g{wPsXI3l)E=u;d54z|0e@_G9~%Y4ECrKe*&g#
zu-&6Bt=U?oZ!S|C<7(37+D}~cj#^ZCDlzkfuML>+pN2U
zpZGwutD|3Spa0$H^FO^gGf6&;Vey)~F>aE}9WiMqwVQU>3Al=O6}89YZ?!G6$DH`{
zv&{163}@TjfEs>qwngl(Rr(|;HimsDCf~-mNiMxH`lMD$G%`sT&0xx*^)}7!NbBl1
zocND({7v)CZ=%4MpfjS>rrH_V_*xi%x1m3X0#)#+lLy0ATav({phF-&YFX-v#B&_*6$nfyhC~a4Q
zD>eDI5?*6B<)GiB)rsmRUz=B4p2-m9Kyh9Ty~5zZMXw?^M+
z9BH;a{G&J~&Ao>hWJ|Sq&{FF-IYSsc%}vtZSi_hTNWH1X^t^CRwR1Z-r>636)k=tE){zZq2x?
zVS2)pHQ<8ZE*GMgFsP5phg>Lx@}}6zpP1}*-~v}JYrs!j1yktdZ9|Bk;0e9FLoOi?
z_4&<=V(%wtzQcfa2k0X{tcHtn5dVk|g;OQQMozCNMBwBf{b;X)%2udX$0g*UT*My-
zdzI+#zp6FiOB6yyZ=7pp{@&^QH<+%dwaHhw{G`+Vql|wNhW4p{(s>uC>i?4XL~)WZ
zn!%LAYD22@_V@j4k+%&`Hivj*dao1O9p?ki|C=~+PMku#_Q%#~)K~siJO2A_tQ%O(
ztmgZ9y+Igu4M*}fibo@!;ok>fOd9_TG02pJ(F~>>Ry)G_VZ`yn%EU4$=$CO0SpB1J
zt$u&gi9eyA4t%xUL#`ioeu*s~#;!8L|5N;aks5LpJ}B^FIn9x9n)p4~YJ3Zu<=vUEMY;_4HyM1QdNrOa
z*k1nMK$+&}XRs0d!)$uHfkZb|pU0-LUxQ1haV4tXbpDVx7{A^5J8aga=kKwZ_aE7$
z8;pMm#XUV$4r3MczTXAfaD%b$|0!=U{!?sEmZmuAc9qS#$eWJ#@cmmDLMAyLM0ijb
z==TZc@C@fmd;~}oLypm)H$6fprVwI>j;Qs>jSzzlC?Q%pKtxQRFeZgm*FdU%kf%%t_3#hEy`FItgXo{jSkJ{l31a$&F)4)7TK*`k^m{IN
zh^x~0{!M`2gd-Q|5o|Hp5P?%z>30)&h%3E+f~lTo-p|8v4TMc!GU-=1`2J6DSSh^E
z1Fg8y`xAiNir-IwU;R_xTqFBU&aL?Q{zIT$%?4wlq%hnH`de4=JRdX~C*OZQ%t;%J
zLkuz{VKjp&hekd$qkn-FO5Z2j3vh@={iD9fx8AiCyK-pcLo*&PG>0+hp$s37ZJ4CZ
zl1n$UMWp_BIz2_7r{^{&qwE
z?b%=)hK@|lHWMegD+d=bO>%Dr^ZjX-k!&y)Ze$ktbloQQUp2UdClrKvihu2GE+*`0
z{51UShJM;<7PFPzdt&tU3w_8QhK@{07|meHp$Er7G{a4D_x%S!+3ush(xGAP(h~ls
z>z?*wzdC7!5@>BfqsCLdNekDS!IT3XLe>m7$^E6+INt7~e!dibwo6O+@!^X_vR4g&<|NP$BtvrA%*Qe>gO!{Y?qesqlYK_CAiREJZvjL+QqNu
z6{pW&OR(=}a41{Ggh)&RiEfGhEHEwukAC_{EW&rv2IJ7xHrf6tx7NNC-T@Bp0KNlQ
zctL#0ByWPmA97XqWQ;gX6hidGf&7cQv}Pk(`3a}iVjE&#oe1jl*15wYK|SpQ2IvS
z)?yoC*>V?XBhK~kc-U5gtS+`8$2h$lj4IpGC2VB&eH#)DbLc9VzW*@rX@hYT&)$9+
zngyFMSGU2KDBpDz8;mKG4yH@c~XerF`zfdNvm`K7`^R%|Xcrp^!W}AVN
z+%=xWDapMVtcYbV^^fwDuk9LjY0cIueY228-B%aekVl+;E2o8Q7M7Ti+4pToG{&K;
zVETR*__V<|ikGyFayxJoZ*?1lHH@p>U`)Pe5!QB}cY|UzQ}Mq4?mD@sl#=Ds2uc#Z
zny0l5#&<-*nzRME8BAkGoSNY#x!W7_)%;ElmArjlq4ZVX8hw?{i8hPYr95WTCu$|!hI!*`jD+`
zUtMfNo^kr!kl=2I-uhJtL8Fi2G{%VH$891Bf{Sl)jFllo^}ba+;;-+&5B^>az4B={
z^zGu;OX1GCl-TXunec?6BU2JaGnjI?69>~Y!%cGc{r7;f-A8?W4^pRHTEbU)`a5@RBL+-W;MF#GmH)^%!(LN%XINb1~VQV-f6cMu7%z&2
z^F_FusQyu3^R1ONI1!6Zy#2(
z`XXP2w)0gEjeKav>z+tBiJQIsSIz2+d==WxS2>V>?a(Q%UKd1PF~1mB2-QF8i+t-{
zTd^w#@uwAvD2`rdqU6HfYy`H&NT)ED{2-J3&{gZR@NzaHaoOrG@{jLELP$Ttb28B944uV%PO?)TS)
z!S`u{as8vd$hY3L6}xgE|60MX$9W(Y&ZG^->Wh4nFq*-X1NqksH_82F98P&Fug2df
zUfhX1Gc2r?IX1bP&VPq8$z`5Be~G!QsOF@MDsePeH|{A5)(nlWJ3r~
zLQSE39e9XqNb`E;@_L6J!4{JZ5x9iV_g@bl;u_NY7}Ne3uFn#a?~BQX2p0(1{-+V|hWT;76<&BR0yGT9K}LSdyJU4bU9AR8zM;nYoy!S%(N!y1BBg9L>Xa-Y1$oFQrN$&6GtAj`B&uXa-XbF
z&9+Y;iX7(~awUJs_95p}Z2A;zHeHCRT1|wl`>&d#^a`b~P1&lseR`73SK-@g
zuJfQ!eRWmgY&AaLJ$Tq)Oc&RGcm3@!CyIRDd1(p}aDF|N!aLn@uH(jUdqg^%Pjp=4
zkpH(d^qcM!`PGgcot4ft&QEu`>4u0+9O8s)a0m11|Gp~|fA!J**Q4zJ*JIs~vs_fu
z(7CC@zbAfE5j97+tvSkfBnA?H-JW>JuECD$H1@V%&)3$E0)eitZ}cbFFJ$LNSm7@4
z&=m4Zq2O%yQEDo3+odIZIsc%&x5kbN;Pxm5`x*|kyfyrdzfnAjXY?;A*3B`JsBD;W
zSgl-bUagw1*3bVNkmHo{Jt{Eu=;!e|E5v?KqT;U>ASX0yJA`sMI*HT1_p_w+1z5I*rG2O2{8#@(Ak
zlmmseId&X_76UvzOCE$ze93`^P`+{Z<`CsTVQr2b$5_ol0_x{1{9Fw^EnRqemRSg&
z_%a6#p?u@+%^}Kx!rB}=jzNbSH2O)#-QPn@)B4*Z6C2R3^^cq!&Rt)^uLur(jO`UbQxU
z+7#T@%nURqcvEkZ)>`7^m9
zqm>pa`BKpxEtW>XYV_1nan^-&%DKvz_igm6TAMmR0V1zwOA82L<>Eqa#66c?%x6y)
za_;3?w@U$A%$0MC=irX`aRdsb*=&Ka-KV@OMX!7B%8WAEW^6L$v1)C^7PA+zRcm*i
zTr8c10P{r-U$Fucq`wHME#`7N5D>4srwLA`T&-;*28H|_XlKu6PvS?7huYHh=8X)!lLY2;o8$!KWJWQpo9oMy7c
zi=YaO3Wm(YqY-u@D|@w3Fp;Ituk&n6wI;U85+bfnVnISN)oiI)t}Jp`#%%zHMo>y8
zA3^D0p%?(8hzGNUY`M%BW5R^(77rv=w(RyI&-eDO^Cl#~0?U+p5%DbyQmvRRl*+le
z-6WyglN>BrEtCou2~WaGHg+6kGF1;k5Kk4tNCL`TsN{-e%FG%*35*4oFm5=Xubhz_
z!)X^PO2zM*v25>0)nB{MvG886NnemYQ;*wE`$vT+jr>3TgRZs({
z2z7+%7jwu6a~ucp!~m=iWfvE-$QDK{Y^m0Un7XvM&I?S{+JqIPEFwq>N6`>nX9zMP
zgD4}e^DMJE6ta)PGjU)uWf)?zR3sI$LTUgUQVDzR!fcLfhjm^(Km%v#mdO)an7aiR
z@kn%0utPhMbjUoyQXrWu<(-YFzfrui3bUqIb`I9WVL%Y_#awpw4Alw{NF9WV3IgTl
zaz>ZNEW1fmLI{*g^eqBnv|*+z(W|c)QP04|bN)c!{J8%h!_7T&IqJ$bw7$MAxNTACm5hs~EfU1TQ
zy(siLlv9>X!*VL0E6i!=#ezl;W1?y_u61^$4e|x?6$@z@+485*peg1GW$1Ve5_<5;
zrCf0qDC&W+s|V-LKwKsGB3kX{}Y98!dFHmgV#Xr*Q892&(?f0aXESFM0b&zI(w
zs7-|^OHzk0<`e*}A|L^#kw>MOTSW0BkvBFffk-l10tIGupgN9!1s;%DeJ)WkM3En5&)LfHmTU)MlonKr#iE*Mm1{wHNB&!I
z3Be@lsHNP@T&_I3n3pE@Wi+?o=k~Y@nxyRgCW;wo&e{=pmt<%H==W9gF#sOYlTfciaLA(%>%Yx=gL})Ie&@GRU4p
z470P)!+HSaLq?&Lri2YGq*iP*g&pOZh#le)fEIjFD|~14Kmp);9Y9h52s5a6&lvfU
zSS%1rj|43+P0SbsT?T^`l;b5y)duitE$}Ilep}S90Lnqou!j}DiHriOwXN|0P&y}r
z5#B&DVbx8tsyhV8vmhNEkSRkHAUzgxvH&qZGF@g*w?p6wgy8CA6(v
z2N`3OpgF9sN!J<41v-z2G`9+k1EW0twE>a^vSa6Rf|18M+3Kz=f6>)O>W~zaD*kGY?r_to-Np!
z4G9|98G!+)1kmE;tX5~IZWbueN~dm?F|m3UOe-9%5rDNt&N!(5Ir)%D3o~S4pOA^w
zYtgoP0M$xBiRawSbzsr0VS?KEmZ=l7Z5X`?5l|RmlxqSCbL_Yc;Gm<-3i2w)3|@r*
zMnS|SUs5t4;$k5u0+_Oqz$PbhYFYLuCiAzN%v1tKvMT393PQe;$2h^GIdp@OpQ8|z
z3a4hQ%*#v?#hZ|IhhBnwxRfm*-PMGq|K3t@b}@(628Dklu(1e&%ntblZ80mehhRqM
z?Dub!Z$_jwA68T2Hb8=RcplY=-6sz1j4;j!R+Uf>pk@%!a2MCq-xCoC^NE6nhAAO!
zGC(N95r{^es8$ZlR4bE(S{$WQR4ZFH(h)=}AwzAchf9vy$kg_*6LAx}L^+7
zvxvto)&wb1t_i1nakj8Toz|$88b{<2mtrb?v5-atPMij$Y;_QcyH#umM!ekE!ju-=
zl*@hEtMG;cBL#}IH%$03%g!+$6@W>GP~=-9@KE9tAp?_2D3UhU1C3I#-wEk?d%#?H
zgzUA52Dzy3J&J+CLFA#X
zdd#v%f?ONem0di|Uho%_u|+b2$67aIK(4?
zK}Q&aO(BF);;M7yq|wZbNGZUmWsa2QkyqtYt!3^j70Jqj>B*qhQ4Dk
z(F+4`JT+V!IJ|Tciw8XOh3*}e;UG^9)ms0)()pstZ}56>!NU){9>~pl^n#+mLzD!b
z`GVpQM%g@m!*wrDfqLePVD85h&lyiX=#d>V!_{730#MuHUSLAlOv~L<13>pKRd^am
z4M_O|^YaE68mVXi%W?&MjEXx1Z7$F>_@oWQ%sNep2bh>(T690Mzq)6Shh~LPGb}SP
zd4Y;V0U2!_dI#~W4UABlxUl5C-E|n5Bk(}nGe_XjSj0VGK*=}k-4S&ZT6PKvPZdg8
zD>hpUi2-YTSUucJ-XMo8g9Pg*J|4e&W~xTN+{@k|DHs}n$sn4v6Qry`x_srN*N@_?
zw|eD_nT^eRLs(cq6R?QjfP4B(sa)~Q*M-_$agKe&^YA&2H3;QnnYrT@u)t1d6=8%C
zMly37frceNgAbOmLV^}Y)Vh1zV<@5*vluixT|Vya$`?;zZfDBfRa(L<6HM#g>~)VA
z0t_%W!_M?##v`TVVb987g2wZ3{&sWap%RF1>
zqHi>xEzsf{lmz+W!cqdGIO|K^MhO5fXzJauqxabH!P!#jY(9r&B6l31S??ms4YS@!
z7l#~M>o{xI-^K4YI;Gm?`bfBsk-Rp!PaJoRrj~i(6t9wLz!M1+69)J|jP+bHr?Qxn
z>qk>4clCiBC-z*%Y7nOzMtj8|T0BIMPgB?mdCX{BW!NkpPgAHCvZz3>GE^21E*AQ!
zthoB{vD%en@=HUA#aXLSy9k$YR5we=cIRXPQdu)fW-fPf>GVeAJq)Yzda4oA{G(Pz
zc^Kv89M8dwP@B^R^7K;cJZ*-}6vUDLg$L-HD
zY~}2!oN29WTq+|hXRt0|4lXdCn>RKr*xOPc<-oCSO*
z&1GPwh}w9@Lj||tXsLv{qj=Fhfiin!&<(mPWp8`vM$1w|7qs!GgIQCe+d1gYm2zcP
zt?VpK+qqdRFT6;S@w$gBWMb41brT`ZoXHhX*NxppG4dwoa#)^&rKZROrj4~-(c-8b!)p@LYpVQO*{6(UkyL%Wnx25Uu5
zyD|rWrv9cn5Y~aVhK9BvNnt~nytY6l>eJrBb9>ggDEUS;4pOl2l3ff1
zO64Hu@OtdtK`c7n)D{)A7^`*fco5kW2?_A4-85Fn>)^3!#`4cacyeRiy+>(`-kJ(6
zyR+FM;bG-}ZXQb-#EspJj;-UYsG>=BYSoh#jT6$M@
z=a#{KuU2I*t3l-Q|-npxayyTvuf
zo4hx>Ft(VR$GFeTe7-o7D^#krT?c429%H+LL`o!2U(j2Chtv$8;7HrPCh
zCCX{Dje|oW8a7xIg4$%hDqw+r6Em(
zOBz=14byM%E}_wSrJ!jzLWRJHH$u(gwKu+@>bV#dx{^2PGUOej9Vgy#3>_XQ&Uy5L
z@knmLqZdYZ_T_R5WmwgKMJ!Zim&YE=&yAr~jfBRSGDdANy5`-{z$tSC*`X)mNJVeH
zz^f@SAB3i&aOm!9ij_IC0Rv0aO3W6fP_$hs($EwYMq?QSerT5jX$M?hzhf&a^Qh)jIC2u+1l}i21vE}rdRO-w4T$Ad2
z=ArRD6$oJLB)YP+uJNqf^QxXZQ8-R7+8zYnX$mebd#oIgLboW21i^1aLH^{+TQ
zwqb5*e*U5>D>F8DDElH?euC7wtO-Y%uMeAA1mJn2-my&9a{OTWvq;`B-XbJ(xO+bcNc9}ai>^b
zEMY)*A^h%?cf4n&#|1*~l-ql!OMX1%B?b<~ZRpa!>kLB8Z$-91CRpafzAmT#!!%XK
zCJ5coViUDvVgfrP-8qgaMZ0vM#z)W^0>12T84H|GY!2T6@*9R;~2-;&r?U^xjG5S!v
z8kWBUQL6d(KrjR+&mBN0ZLCkjCBrT#413*yKp+E2;2(K9k+y4-G{gtb7ysM!Vm+F^qC%^*KsdCVixPEJt+%H1Iuawi95{W6LiBU_>C
zN_9x!nrxC`^EZ%mHPBctY;|mo>7e
z8jyDoN4IB(jWPa|N9!g=CD$Odn}TSO<{?H|I7*b1F{UviqBZ`7lBx|zKPHkjx>7Gv
z))D2Z^;)c?uWFC!zKMJ)-xT|2Lvth)z4L6y$5>n&
z&UK}JAoSyQjtZegJ)qg9GeQ2$d&9K$pK>K8i+YEKJ^ZTCB!4@Ydc#3N2gw|0er?b!
zBvFa}bPx=Mya)ALZ>U8dAeJI*Ln=b{j55XjP(`I`3OR|2c&StSDMM5*^OQdMhKiwH
z0c(9&kfb5`eGOYfE!(9^1}YAgDb_@>YJ&i~WL5)OAzJ*>gyu%IaJbalFH?-M<(C*%
zB{IlOe``Y(_3Kne*po_kp_W4r4%r_CGZ)P)A1XY2;9_nXlYl7rXzEa1I@VB&f>-Us
zamYhW&Ca#HF_fnC8gf;msjkoPijTP5NyALQI$nU#hPGaK{ir%+RH~l0T~Y`-O>w2S
zDe|HoZeS0&A+fTrw?};4316R3U#C{`)#Tea^V)`B5ss^BwV4AQ!dbz{8&aoG(ajPr
zZ4q%eJZ~!#n;O})j1r5WI&#z&S_pNV4x_R&ft{8@39%V89&TB?5`q
zo}hWU=dw5I?lu($l_er^_@(BKfKF0ffBPkE$;yj-*7<
zJVh?a1yYpHTqptR6;OjyGi9Stgzf3BPOE`}^b>MwQnS}O#?aOISX?t+Yiq{qVw&+E
zt#n>VGkzq{j5k>nwq{_M5w%#L+<|t+YWxfrLY!d8*Bf_hwPj^oN_C{+otk`7a94l~
zg{3OrG&2|v+W78hDPzW5x;j4;m&Y&L^7v>>9v`z}w~{=5H;@PVIwl4lngL->`L~h>
z^}f40|4zb(0b~x6bT%pDevQf$l*TA(NP3Yvl!|$+rP7@-jSbq{O6hf_pV`2l^bIk8
zfPG7?f0X*3Cf(BL0R=6FG&Nx);rYGKL&ZLxoa_<_mCE53kcG74IAlJlVcF@=!F8^S;`KyYy@dt+&(rLPa$K
z-r^k#(WHQnusNK><}i}UjBI&^4~oPHAB=24{C6BeJ%^EJEIH#PA>pFoEtU&f?6UE5
za}>zS#UcRb9zGnS<*xKa
zkjSXY31s9xj57pIuNJ4IZhoNHuZLn=qq{N?M2c(%dC42edS-wipnPkP3(VL6QIS4d
znr~_<9T!=Pe4R!^%j5)ajB5x4SqQJy<9LnXZ|+3IsjRNj{1XiMn`iQjQ~f9aSDXTb
zQpgu>o_Rzmo$ANgVMSF6}(CsWAUgU(18_8bOG*T7>{|v1WIrp%VeKGkZKcq
zE>!wF_9S*?CKh)suSaUaoMS=cI~iA
z@2=gU{!t5M6P3YQY(w8nzUtZsw#agxJ9cRA^t}g<9y&bp;L-gv+j&i`td~Vc84~Z!
z9O)}&i`8GPdV9S~2QjNKwrTRTu^wXUR<%CB*6pVQO&=-dPGc$aDcUi4aYzk4)N>ee
zxnVZ!4GdAoXt>&2TCDb=aH;keXk5Lo0DFJo0znJq0=;0$mKQy3HKNn0{q%8DKHXI)
zlGHU`hAL9?7rr<@;pWL$s*;k9>|<8V$t
zG#Nou2V}+JuuLR^G=tyfNqTSFGC*gV%v1(Mjg#l?H}Fg#GaS8_
z4i=m_mCYBhEqN5REG-k0>UhE|z@U}PypmvWzn~4@SE|gMDlHY~hL2nx|aRIHj;Wa}qPbXR%x>UmBa{Gg>qdJ02`zHZ5O-
zo2jH}y#Vk2u@?1WKo0AWNik^2IIocNmM4*vv={(WxL6;#ut<~Uj~;}Sy-U+?^xQl4
zDSR&vdSZQ>i3jGQB%8>D?@nD9!mA??BU&zvUizu*Y|gurveya-$|}7UP2=uuD`1*)
z0)e4Rwb2yfwcDmiQrmn0%X)J;9G`*(EGPNkM9M^yaRRSLv2wkI#>E{Emn^wj^
z`>4~7ypQz+nEos;VObFJSJ}j?2Z-a8yFxXEny@3L2M(c9pqa$bM~V}9MBf$pd)$_`
zxYDRaH;3Jtymn6&upes_xs{62GG&g%+$)#zm=E976%UM{?{Qfduoj
zXK3XBu`nyCd0eq9SzJj%I4qfo6`z(R-NwjzAzNT{#8Y|E@uHoj<-F$EN+
zre{(!Im&_hC$W=AU#jl+s(Y{i04o8!RrY=`>Pt1X*@2ixs>mU&p*VBQ&fvl&1rPWUlFJ12x6s4=}}q!U9Ses=G}3
zKg+^EB~hD{>~8b+y2BOz6k_o`7xY>|!XCW`G5(IWn+eWk
zZz2lFWV?qhmX>rOS9T8P9YdId@OaS063z2;iYV5cLRWI#LwBQLw8K3>=Q<-9@t?Iq
z$n7|68!r`QVt)NT5-b$fOCJsdyPpMnf_lU(cC4ACezXYG&E%!LNA|K8gw+NU{$}+joHT?yf*4p(!bZDVWJqi5vd|Y<>P!b%qkP)c*cBz0
zG*?7_q1(HH_Ai|?UB?aU5h(KsGD=S91ZRQ-R2;!Zs4*5n3kVB?YTbKhgXPe)YXqGI
zB+FuHp4Bo`F=|9);S*L>$2of4$CG{H=H1ovuhu4se>qn;6^d2sNsRQ@x~JNSMN$Ng
z#yw~^@Nu>#1xOvrl%06>JD+K8ioiEMEn$Btg+1=c(-8ikK>4ZKM)E{6VXZqOrIC~r
zXv&Sa`HHo&o|nw$f;BXlO|{4|*~vv&6Jiuif&cHW_aDogQ5u?qA6NDq!|id;SERIk
z{`q>J;Te^~W(|q$wJiR}HZE!>%Bp`;=63H+3PX!L?9hC?J~SH}$zg@SV6jO{0!d(D
zhvk#C5n^Km;a;wdQ&`Lv1FQ!hF-rcMQ1ae<#n>>dR2z`oY9OB?_meqe`yw@qJcm-5#<(JGE|#?9WN9+fLu-rq)f;
z_omdk5&AwawXT=GH>cL!b~tEcyV$sewb&+q(*hiCqp{FZF5vg4*8cE|@y(>xzV^k^
zChtlOrq&L;(#(!?iy_0uV^GT6%B}0Qx4ABeCQ{dY~c>MlLtc{nf#YLAy43|`d6!uHD
zm@diEr%M^G$1j;>F<|&`s$;`EzQLv#4P{N=@A3LAHITpXT3ZA-7JU7p6sc=oHcU=?*}@>*>SkXBk>tQ$i%^2AAQ&&a3PP;1vz?MxQe?S
zj-o55>7+(#l#-d!$(-9i76Rnh{t+RRTQJc5ri(FbkYEWJr%iCn17igsBYg5MNZrta
zK0t^b-r7(HV;(^W^W>AJ&?KX3a?pxI6m=4I>4xCgD@HLk(li!>xv#;ps8r0+=ImlF
zR}dP`&p57*UBsf{4;K32R6TYM0a!)F5WWUNP1NY6U|_-n=bh+@W(hEAWrm273FK_j
z25?LTS_D)$u~KcW2eM2zSx`Q)%V@*a7+jKj;wb7&lNBWtF$hUtkj&Bfwv9wgj^>c~
z(2QOlTY?kc(N!Xqn~Xvwd94Nk$Bj0O>kSheEeTZQMhWI)K}ZiMBs`=bTr9g$IEe@M
z(##Dej1$%EVTS2}vJ&~=L|KUyH&f7+$H`EP9N0A!)HtE5BiL0e>Lj;C7$>n%F-t*{
zt0MxVQUuwIarEj4Mic!Bu8ydKS+Nc>R3se&sAeipfihp-Wbg0BK-2COTxq~bSaFF=i6F_s
zR!)IcT|=?a?0(1Lf=JmD#CMYgLKjL>m#PeVE2|>^pLJUW+8rEG9c7?;I|?9mUb
z%9PMTS)OgCK%{a#V#hGQ0JLz7TG47?^gun}dmR8?=v@vN%Ex94POm74(<^qFgcpOL
zIE~-#z$J47IErcYDY!_2{QvH{UP4O1y4xkV42;|-;YDnc_k!CckWa(gCD;<&E@9iM
zB%M}ompDq7KS)i?sXA^0I86l-^qomJi6#V)ZW2Uqm#{1p0dg{h#|aAALnB5tPJDvf;zi(_*;Q>YV~
zA^{P_Gjaw!$2wYnI{}H@>?f20?d86wu6;A-5)6?r@Z^P2fX#II!?4$ZFyh
zLQ|K!INKYTWD@Qf15L9Ix9yqVW};SbfXu$s2_cf1sOiQ5v9EZjhaeFnS3CrFHGHSu
z+Hm!Ht_QPIoi6DmEn6Pvl=RwolrAo?d!M1*)Bywti+t1pQ2;eU2%=-)rqw(d1!}+D
z#^lr4BWQAg1A}Pw3l2ID&D5bMYKjbB;9%RRA|gi_Hlw;m0ws2dNDv46pmnWxtb^7!
z9tCD_BZFn3EKE*;I7dUPk(E00`cH*ZABa~;B4SQHO50wI7B+XR565F~a4C_xZm*(K8i(?*IW
ziH|u>k!ovVq*h8*vUABqP2bQ$Sw66FilF6C50S8jm8`6O3foBGr3=yf7mkwh8KxU8
z3yGhdjQpidV?$Vq6CsJwgBXO;TInPih}UEtjJath=31Dr5^h&GiU373abP#;N(jMZ
z1Ep&ez?m2*@l0$3gG_7zO(u>)I6DFqj3<$ATHQ^s-*$N(gK%C4i4I62=Z7}PE{KVp
zm9=)WvNBYV&f7<;j*61N%z6a}9y{ec0Zj?)niBxP9-QFL1jYyfTo?ewE)3Kv>Ba=)
zY;wABg^hDMtkIkv0dPqH2;wbwCNMW+Q~EGpQb_~s5WpE#=<7174Gc0WfF`3-FP~VM
zT*^Z}WDoOTVBtKdwlEJyAsP{rr!fjn+>A}cZe>uYw{%~=!>&Xav92~SW!{7h5F5>yR>P7eb^*d5U%H^P9vh9#usIsL96=!5BI0Y)!^yJYzzD4lBpJ+0#ICrc
z##Z2JU5`2b0I!yU3Y}iUrBo;)>HsMG421U{psbEqp_9hGB%8zCchbz;WF0VblC<9d
z^F>;LHpjbuEL;U==777&;09w9oL{%Zpq%G|3lqG+gnSxalwd}YS8;X1YA;F%uSH0>
zGvVKFQLt}O*szxt1)^xEutM;iX~v$xiD(8*FChP*q
z6cE7>XWJI{<53(yG6#V(Asz+$hTM-4-sXB}279rtoV2b`ko}nvP%F18U=09HY|%Rt
z+PqXD*vy4tAe=OZv+2@D4`YuPj-^Zg;7cz-0t}zapE`wulgkx4pKk5v9;?0)%cI};
z2CQv=;~TKr0*BB&g{-A`Peo4WoJ_bjJxN?reZi?n3?hOzzR
zeoJb7FIK(Znp*$rd$)@ZMcR)-H~(=RMU~`o`uV9F-?C>p{esku-?xXz+|>1#4qocn
zuqn2ZaXHO&&X+Bx?@py2#*u&rQqET%f_mZfTwVpduvj{cYl6+{D%qy9
zMW@|n!^OM0eFfWcc*`Vq=FqN`6T#A8tSGPD!E3yD84ew(iY*#vWNqn~SzU$g?zPQ(
z&tUaBPHiso$<4r?$KvYQ`T%*dz7b`F9SYAqfn}=fGc7u9=%42%__ABH1V=cZGDrMk
zMibk_u--R+>f#1*J(@jT9u?yeIeU1s*!J?;E*c|)_mdGAH+bLZO$ZQ$2pUl(EPXYK
zzjv?MjJHt`4$We>jPb*`Y^o=nxFdkz-0T@yScdI;xaJ9)I~uRl!M?wfbdu@NelzPi
zyq{*)Xe&KRRyIFIrQ8!Z-i0-6%z}BDxuLyF#j{1+)zi1PbaumDRNH3_asOlax!qDi
zJmC$JB{TPguBpU917^=~Ex@Y{?kwcaIDGzM3JUb~lk{=D3UWtz^l2
z<8(R25HZJTqkMK4?@p8pZEyhB5W5=&gEoVWu+(~ohrLaL6Y{_TWEq#Fiv#=UgG+Lb
z7W3FBPH(s!=T{m#iFt`yyH;bubECBLfdOLjoZ
zw&grof}yi<7vP;qP1$+QjubshvLWrjQ68-@#J?F58&zOep&rH&
zvRn`C-aw{PdE9QYdm|amVl_sbea$L&0g8;{VEZZU
zX)uLOm-G@~=%g{?1NqbWInOeqRm=r0s$vLdND9~q8w8I~zK$~JfgEkhnlosdA~37%lsvDgdNx}Lvw?Kijw6w^nccqg6J!;VqgYXahwR96s<+}tGOJ=?Gejb#mh|2ID5fgLTS`T9=#v`&?cyKN{*x8hA=ZD^#6J`g
zHs`1}%ju)3wHFU+w5_wLyg`JGg2rw*(yW(?l!=F+)!5R_{S+i@&Wl0x@CVu=gXMj+
z8Hxtm=Le*z-=U0
zV2_oJ*h@rLzPi{4Ek`xbZd~4pi=8UC;tBUxP=pbm?gNy!WvdH{KI$vcMJMg^Gc63{
zw2mD(_Gc4i4Du6OTy&cNE*HcxAP7O2lwS7$29fJgsry%l7>L4bOQpoiP>H1nvde})
zQXy;8Ty4xPQAZ5B9&Sdqjjy>TKJ>8qQa3fAfv9~130CI`Yo1O>D4iS9`BHF$6
z2yHTCI_bedd@kyLs=P!~v#vCf?2B=5nT9vAD#}0-FSnKAB`C`f{L8hSwl92w0<7AK$FlywD-F~G9n5M
z$Mg!}XoZgnA2lSqI%r#aqYOy9m?Py@7%|kM6dd94IA$p!mOx;&VU{5!FNYa|comc<
zsC7GDgW-;D_ax5EtAGw82Xd2}VZdsE%%`+ZT8j4~jl02x)|2>&g!ByE+-6)ub<}8g
zb-aaivL~il=$B`aHS!hQCPdp)u+<%3yDfJKO9ApsD?FM
zPyk+rq_&;s+ej>5%Gj6OhS$$aWcWZ{I#93UQ$cj|UE
zhH?9=PoBzS=6)(Wz(64Y{rkWAgJc0na2~D
zCQGV!`|Wy{5m%^nJFl|@(RmFbl)fP-0y}YtyNL}BYDBVTD!~w)sg$-y;{**sd!PG{
zT`q-)v>bF`k)=i{k85*jW}bb;~biK?unsc+nDG{9GAMiM1^EkT#56YLrd`_j@
zHmh5DJvt{UoS7+6K`oE^pAir>o<+HsKS<%n^vVv$0Ug!wa{P$JL}H
zQ{wjrsJMIcMYaAhto_ubRRH?bwIL0f0zXSYoUBGCGn&b>uFlT`*xg5iUC4A26%;!-
zr>Kl$&+-L2ZwSW=1xGk_b$$s1eK@vHxniWVHe?P84E+BpfW3MrQCBDK?xv2Vx67^b
z=E{(MHVHdW202F1Qik+xaIaT}v`avZze$yJKY;BhLmG!-*~*X}A+9PRVkA?RuJ32o+^-XwWJA{r7Y7@HLUIEr-^5k6czP62Oc^6
zw{h{QYLwZKE9leG1io}?(fpwfEgE-0FB#>EOz%^lcSTp)vJRhP
z3pyY`69_tVGYo{Z$KvRa;nNkMEz=lD!@3G=8kM6espaVT#_C@}fZ+%?PJ)}3Zc2hA
z8arK;II6Yo$!Qb$aKH^K$*|zW97Lv9MnS#M2A-vhzP;5D!K)pCAW#F(l{g(lWg+J>
zt$-;m&7Xtx+z!+8*(?kqelEg%lu_&_0OoirGPU?J>9#k>-Iw1|X%Xl1v6ANAy*3~Dbd
zoy2|RVX2G$e2_@4Ot7h3jW1COTb2gjmf}O$$6}?0)JQA%f%OwMKDamWV6H(l>J`?E
z320m}B}x7?jteWO4kXBUE~ibYwwVddHsc^EZ~|>0H=$+0*83MFv*TtF*#dl2{8MEP
z{cDyB&n_>W|uC|`Re;#K`S6Tor9r3
zT&%~FBNfr|nA4F+Q`(zW|2_}%dI?xm>yLS3BREouJdgu)`2_bjOkbjloiDu+|8$}|
zJ=2%=;n|BvpnERemDJd%?LxFKO4Uy*M(Mm%9Lu_hRuQh7@K$t1ncRbl*CY}bxiYGW
zxrIe6Ma$xJc&s&Sj)Tz@gd)G_o`q0QwsSbfyd)s1IYC8A&=eU47ej)^PSx6OA(H_;
z9Ol!N+i70|%gi^G;0Z;b>&D06%)338XL}#5~Z6>*^4Bvn+wfa5a2p0G7@!
zmyAu#%_|rZ#n>%Hz8N_UzRLetm3l$pQKM4bRnBC&NtZ30&tAkd+x&cPE{}yFbRsR*
zIiJLU)dH^6#yHYEQns5e`!cPW>?#;g5OxF%aDr*z9Vr4d$6_CI)hgAVYp?Ct8_rw=
z$-@mTBe{6n3HN){Za0xYiC|AkH>9~M9JQfi25AtbvBzNpOQTxvjfEl2@)q>Hr944p
zAc%Uxamlm-q1Q9a{5n;R$)YPkNh;MUGQt2)G^SJ^Q`qH3Z
zIlsSS70O&=Wj-J|J;^gG2RA56EDUSJ)EbnnjTy#m>$J9bXqg&Hq9~gdG&^kkL<$OX
zhXy3uRM9mAyzES`!XQGVTtfZ;6zYx(B6=cqqHM{DR(y%2e4CXehHLH0QUhzm)po@R
zaY4l=C}P@yqap&ZAydEyHJ9x!qCl2LNzyPkH_qqV4isk#OLLSxb7T8(C(8`0Ia-jH
zsxQLzYqQxxVQ8J}_N^OUH_T@Skga!k-2i2~p>@4%q3dw5qVJSDgq8vu`Y{yl_Tz?^
zLI%C7*|P&u5cH0Y_V&8qz2Do$7h28iIdI?fefJ$YI`hzhqj%qR-%D_v3|;SIT_@8s
z(=+2`=#cJFjC~ePp(-6+-VE=lNxM{}aAfJ0s6wja0}s;W7abowOFND_e)ztfa>G-w
zkylHrbur$DE*G2=_$&l8TSzK
z<`E@&MMy-eZ&0-cgm0o7G?urRv^G14v7&)*I{9mChw4bB{%Lp;8Oydqi9ru!pa;;?*G;3_`+r-fHW%23%sxfGI
zS3DJ5lT$chft8hp??xx5K!Fib`sm`e!A)KStSi!j=Xizg0+ysk?F9ez|I6zkpLxbPK*#)Cqqn^rF&
z^<_G|yu)s+*#qQK9<3&x-FOQ~9lI3+N5O;!B$
zdb#ypJ`5w8dZz!}m0DCaYgsWLRSGEPG^Yy`GtrM$G&4}6`e1ht2v6yoG*rVNBCpe6
zMI$m6ExuIJ7}5&_eP1*Z%{;VY6=g1YO=E-&00(8f5_i27a`PB@;{qgTUv#D3iVn~2
zC=Z@+;;|ySa}l^#9>whhGJILbhuR}65@*UgG%&Fn(YrHy`S5fu=$lLTipr}c>Ap{~
z1I_*rAbjtG6q+sh-AvHr-Z*})_|ZISRGo@i(8fWov8SDH)fydkXm&!aPuNmfvek;ohEJv`Xe-6FM+XWC@>?mS&{ZTr8@rN5WeqCb$s?fVw+)d
zdbWbGBD;F2y43+(!&=PER3nS2%$k9{TABw9>u_~L$Ht&4@w^Fd9fBtd8PIjd9+|Gx
zZ{RA7yBkKmd#B#0h8s1g8%!&AslABHqiL-b#?kbO92zmps;H@?(A85NJA$P=DCWLe
z8`+OVu(=CaD(FT`(soRnq@`X)`c05@jk5O2u
z#j8<4?r9hkT7lDA=y|bm?W&T>yDI7`jmx})m$bOJc>IcU%xEOGf81=UPAnnxhK`}X
ziK(mOa$gFsni&pG=nAi4wnt}MSyh8GHF!`3X)1GJI?6(TX*zIUu3yHbi2K!FOcl!oJ{Dy;{ft!VmhV|kUzp0Tob?81smc(OtTrL(Ep|{3x!H~8Dd`qVE=rW#YUXIK`(6kh
z8-0$Vd}4(PR_a6iAZyBo5(kqy0llRGQii9GYSJ#JAEK5lxKaUr5$o8g4xt16G5cZ`
z^kN@g5-U~#GdSCTQuPgsuC^wzFnM7)Jx5iFR19U8C!R)wh3VKRVk)LI7IxQeHwr!#3{8&UF*x6YASsf^AC&)gwTQTBgisfbNJ
z*z_Y=il()LnKhdV>P6*GoJP|z+^eir3RXHL&ER1rFob9BXbW$?Tv|ZGMFeFO@kfxN
zBSR;1mGg9m_28~S1OIVS2&$L|rv}YFp)~cmcG4O$%6bXqy&?vBGNM1=6^n?{3&qGEYy**T$l-2KdVQV$e>6Y0O5Hw~hrDTBmF=b&)H>>85MK9a
z(0@i2<`!HDikqMntn@5)$kT|DOI6DLZ87nVC!N`)dBaP;vNrY-+C53z(r|hfDThh!
zPa(t^3MA>v4rDUQi-;C4jzpHLJ09#aK_!eJqeB(tN|i73;_TXh6W7rwox+kks6=Q6
zp9+YbT6SZS3z>ndC36fK)@6pZN0d;iAgU}9$W#{5ZG1eLZf!A*)@iiQH0-p>Rg!de
z-JBU8O8*@?a+GjpC#1buHOeW{`?VQS&vOf=%w=LDnhmqM)!Nj(x~)bE0$E{&xk70p
zpuym-jKLL#cB1&STWeSQWp76#C(s4i@q_W~$m89$t&kQg1^T1mUU|)SW;tY#?GlmE
zv>ikjcp~Ne=mBo(yFG){Nx%JxS-iJDKELg#Hsei|I>WLY3&6bcF2rIh&8D8uF3#1>
zb6#;~Ox{dGy#{bV(G0W%P_JjEiY?r@*eQs$i%Cg?{A^_8K2(w6aYLB2!^|RbB(;p`
z@ERfR2@g?8KP#Nn#Mv8+55(Rb!4RL9emqs_4vaOR?9c!ptmGD%0}Qww(FUT->3$u-B5Dyi((B3-;UQnxV}9A&kSXuxL%EQ(*_pP#08+hjk4HDwj-Je&M)i$}$Hn{w
zoO>LxVt)&!Mb+`m-l%2E^w4bQE)T!zl~;K^!K|#8{;Uxd2YwF;frRbd87AqMYC}W8
z*kGRV_(Tc?O7@4?Sv$AleKGb=ymStJXKv_rKYD7wAZnt4vUT
zRjS-sZW|js2J`&&NJ%LvQ?Dvj*ZY@LRo&{Yhq|iTxZRZ1smzp=E-6!1rm9Nq#w@cu
z2Ig?6rp;nJZaT4HcNP^pf@SwC3p)z~1BV%g*BO@KVII3Y&MeGX7=~GPd3e9?-iY|)
z&rGRQ-OUcWGj^BqkN1rmH*VaxapQ(JV?kL6Cu{2t9@{6E+z{%`l;D!JH#66SZlxEB
z6~iUy-1b2ioEyTY?OKy=Y#(%8M(A?sa`UGoR7I#-s$zmilM4mfb`)3h+%w=Ap_RJR
zci?PSlW5EF%h!0kfB09PO82-TxMj?jLn&bRrX2ORCd;^Mr+jY}u5#d>_HDtDuZIKG
z$ATl@1>ddd;K=VGbTml+&>bpI(!Ywx$Ke6?^5oU>3UrZo%8TW7ykE75y~=Ltox#!L
zaOe7Y!O_#t4EO24!gyr>mn64}<@+H$+dlT|TTqe&kNwH=t6}>1(V?dxhu|vSXjtdv
zjFm0$ZOA3XHSyfTOW}GJE*k*3@tM!2zy9bIB9ynR`LrFDX1NIpDc2aja5H7lCQD^K
z9HQ(s?CfHO;fn=Dvq#s_Ysjslm4YyNw*nPY5inps*T4pW>Iv0ra=!^pjzJVUo)4!T
z`iiUN;_XF@W}{MA8}XX)zkB=oY1{!fyhnZvzHfViBj1jn-r&e9_~{Fdd^2#{9~}AE
z)!kGk=>E$ayQzU7^`p;G|1}h(-j8v}2C4t@W4o#0AoblZ?WRV8)Ti(>8l-;cg~z+(
ze}8H1)^tI+k5siv#zeTx;T
z@O_IP)|&D6eT&tufT59@>h?9tL^lg7F$s}WAp`HG&IYNscfr^mFGv44`htg}zaNy1
zccVW8l^dRo{=4YeY;brRl!8a2pSe8Y(1`a8b$-B)@1aj!IqeckHNJHyY2gt0b~c_>
z1#ztg-Lp9Q{de=?==bZMOAou!3p$jGtC)Xz=w7UH>{K|k5WXBfo5is7jP#7;U5SgN
z>2JFqO`Z{|bY}I16ICyQd-R&_atM4>dey;=;);W_K_t
zvpeX5ljOre@b)WBcxY?RMkgrABy;O!g56WC)ftm_)VBEy+JC~8H0IvLZF3J{_k3&7
zdU*o|5lfY|N@JVQbp6~1#cu3%cut1h*!SWm6$C%Mx|@P<`ZM@}!u9{cXuYj#<+;OTCR%oI=r^6Ez}Xwt`z5!c()wn)%9sDxfL0OkMc0ImjS-NO}_w+=!_V
zmwJBSDTPyzV2xc_Y^V?o(Lw42PWn-#k5A%IXpjeRu+hoHdQ87dx~GOp6`n%~%mMQ?
zcTV~0T2Y=kM|9CXX|SdzWkvEAT4l3AXtC*6SoTX~kJ@fq8uw&%E-fHB@k)Rm9Vp*P
zUMUpJa9i)8$lD(9@?i}Q#0phy=V@_Y2se*7#
zL$*?NT>?6(*QXr%UTT97*-W?cShFgk?p%H0D`Ap$!>^Z+l<0nd+K2Iu6C0_5=S
z-4}O;4adJVW@C=w(6_LH3%$2O_Y4Y}8;y%bQCx`M?b+?%MyZLNG_GZHvU}Q?r5gO$
zin7U6gqC8(6(^F>S4Qb4q8HvsabHkB2@sx~xo{Hzzzvl-+ly60a!dpXtPl=jmf=pt
zV7RnaE8g}&cq7F*u%~arOO`*oWmI*&ft-JKpJXTsaJYfuYlWrqnv#Pnc%owhi^x@d
zL3d$k377J4A&iIl(8~>zDHOMhxaMJ8Cbef%Eu3buV;C#v^$fqH1<^p+
zs@Qy+Dmu2-+Xl%B&}3V2-RBO+8O2G)D3|iuCR`hX3!QcV)Uvb(k*Qm_rW>`cx
z`c1-lrkUq)tFAmP6w=Skz-f})8mg964z+WYR>aHJ6^rPa(MAhSRBTP41VjC2W{@9_
z#3*bTTU;*zD^L~}BhCo1f-Mq_2%0{QJp1B@;={}P7WO?}%-$#|bqD=#AuUZDjFy~J
zs{poPe>2qZ&;G+v1MV)owL`piZ_azQ^~AM(z}ALy
znbHft
z)B0-q6CFe>z}5;p=hg|r?HTMiK?asu@D!IwN_K2iM@@~C#M!N`W5Vlfe_(655M%ip
zJuH87+=1@kTl@e-x46iwegJo;Y!@R4J7&;1GOhn^4FkJ|p7w$5cHGdXJ=nh2Yo~<*
zPC63@VcXO@!GQ<%qxm$f|FDy=OQXnoFy7G(h?`fj@DDvOw8rj2A~5w*49yRC5LoiY
zh^40uedBKCn!22ZTPPm>ibenqHDIQX4MiJlCk_IeTFR*GihAhe!5hbKh@tzR9CVm2
zKL!rlJ1_o;?Lf>o(j#phjcp_TCZPNF7`mVJq5Jtx(4Db;GOBY$H-G|`uW#{BII-0<}9qK*wT>{mUXfBWiu1Y<;$|&5ko>(jd+xn9|
z0EDWg1As8cgLo=ZGX-o&dsBIkhALBR9flz^r0v
z2w&2)Hy)qckp;ymsKi+M#Gt?BYv6|bs%$%SmxISK*y|kbuU4?tpwlDuP^{Ktb(p~j
znS+FRxf@Hzo%rU$ITocGceAIYcq7~%_`ZV8yz96XXePEnW%&MpSi+^B~OnF@eTLwX2otT4L|(Z)I5iw7iOs~`u(YMZFm<~WJ6_h@4OzK3q1$l2%N
z-rEp?$li3?1R!KwUck$d_-`ktUKWJ#Z@EeL10<-2c29`o(Ygei#fNr79J=lcdnU?6
z3Ahu3bNtZ;XPpaFyo$mM<3L@PmGs*pImPOE5rnNbJAGJT-2!^(?>qT4aWgRIR%!0qUf&tf)lSUFtPt=7T)A<#%Gyz<
z5u45R!bEwTqRC<@#j!c4Z)|N=@Sp=#DdbRghZf$)i@W#v-|T(7#WiTTq@f%WjG9B1
zkv8)>Ha3g{UU4UPkxzKxy@Y=e9R90k@%wW@>TO?%-=7asN3Y`d7lPF1G5m|c;op5$
z{NJHdsm~94hq4*bPLFt-4%A4ObaVG-P~x+}p|^hszrPtAdJk*&@NX{PkBlj!eZnSfjU0$o6@v6-2G3I_)?k?;@YLFnQ_%RB2v_NR
zX&^mJ_Uu90A-i1?&UeZRua-8Q=9v$xOSafKK!w3HzGcpKDurq#YyG(C0U|soPj&29
zhswv};#wabitD4vO!uLG8wCI8gZTZ^pzCL6@%!(BuJ6BkKax?j$DR;UjD;mQu0ghB
znBtBEF!?tHFjQpn+_D;bfaal}{Or$u)1lFGU;KsU^JhNuzwCk(W`l&CAm;vya=
z!Q-oi?cE7XN^8kb+n}eJuHvO;b3_>J)Z}7$tubSR)5jQ`Z8mY6v+=|tPr>jGBBJJ+
zO*|uws4XaJZRCY!a~zQq(_Y4l&E}-W`8m-Z&gmieu&yUHplv_r|bPF@i+F|)8K%dBI~G-NS-yt`$iKvw5KXwAx$;W%3QS*8!I4iqb$`aUwV`QM_orZJ@mSFPllVyo-M@Lc
zIZ9dx&~}{GS4U=GGV^$F*dk#cLm+wc?Ir!
zg6`W04`gs`P%r282X|Y6gJO9ovx)O^#DnMH)$ybMMc0h_A=*v7FF5-6k_HBWGH8pZ
zpO`DG*
z;sGLu<=M*nnc+H&HT18aNYD331T`X&fA2?LT@%64ZvsvygQGu&pQ+&JpIzc<0AMgE
z;+W}^0-W-0uL{5vxyOUISC)n4K80B^2XCDh`)Nje|I#OpNnchrfCr`uov)0Yi@NVjI@QyEd`u>xd<-%Is
zu8g~>h2R|@zxIhKfyG!%^8HfG(%saJ;GJK3EhGEx_zI_QF1VjpsC2J20+&ky=rcsS
z7XQGulg|h5{MHX>L-*+sR8eUW3tp6+;ev5wW6XZy)=&{9Lz!7vP2L{9Qdp@J!82Ye58uF^XA!#UXr+q#_3PJB60U5Ztk80
zKA?dQNT8;Hngq5qpw-Q34Rc!~m)2?p`14vTtSpXt-y43QK4?+
z_$oXK9AyC;$Vm|wvV@?MW)5v<$u7@E>0=q8hJKO)
zJ~7+#T6z%%hcv)a$~1xDm{RD8fJ7sh$Ow(VIt>Jp*MtU162<%=Zutx-(d2{`Sd@)R
z$U{|LA{-&Ou@XkPoBH|S^S=M-`+KfohLwznyau5Q7RLU!a=|`;`kiOWYfwpmLa=?u
z$^@Ll5X(xVefZcv$0yF~9-cy8YiYTQ3P)YRyZ*_|Pn>{Y1E~Zk(N)Ga@twys0nMWh
z8#|b($b8CX)F!O4oyH>-;Mi7Jf7p`v`@y^Cp1B`+cHEE{=MfPr5xHQ7cwrd-?$7A5
zyqo&>!RP!`fL+A*bxEj#tDt_&`0dap;CqakxceE&?i
z(tuWgQqUjImZ4pa->g*kkS+~6WeU<1YFphIs(Fj)N)td*3MN!ACVp?RH1Zu8djXw(Y>xI!gjv
zA@iz;En&q7R?IlsEnz#PrSa^LsPMQ{oWd(@%P=iHg&s_Vr_SMLGCP=0=k+4;9L-*^
zU>e0=0oIgjP;mkq>LS<*sAjU)#S2v|iIb*@D=lS4JKv^h>3F7^`a*Xqv77p0_Z>yk
zPJLpnl&C_vHDzc4)}LET#4!{kz|nKgBSMRmNh&zAcPhsoFKi@--t2!>wiYsiWyyY7
zPzy;wuX!0ig(dp(F0n@z9yv-rJd&S0x9w;|?6n6^Z9Hz0=*fdPh;b
zT-{a=kx6T5urny#UNnY0Df;9YgZ*KR%#{=`>9`-I^xVVznCm>?X~~6H=IKx;j`_&|
z<4UQhanxz;jKEa}r3QHT(_6#s?Q|??8iuE{9bq5^bZF;%@(4~FmsPHW<
zs1bTZPmknjVpC5UnB!ZP09VIU+TBfky(&7b8%`4obAgydP~>EM(OuDFnW8x-1jmJi
z0JNUG=cyzEQpw=mb~VmIB>r<24J~yz)&9G8Q{O>WAn#>ihUUoepjpusAW8;tk5Cw*
z@O{o!N!F}rO+C>JJ4EWT9<96|XORt(18fWDx8Q1`e4e
zYJU_MfS#c%#>=a*&%hbYA#@3AB^pdX
zWUf^4&JfftXzEQBw_;V4`Vm-5iunR}=5Y3h@q}Wfyosr<=0tUP&4JP#@SwY67!g;)@rp4G*v3!JEfFjxg)>!7%nK6}*@fow0?V;SH<;ZKA9nk6xYA!0P%T={r7ejZnBF5WAaMYrJ4Eq&%r
zppEj3%TI?0-12!N#r*;Km7VmHS1R`?(+R&9v^&oUF-&lj24dm-&B;Y@CsH|zaZo)I
zz3>**=mYv&JL#vCKVTdF8|UWkO;+iH
z`Ue(Zo)}Olh2>myRb?`7ydKOpT?$$n68hFli`X?oO7YS$!ydg18dBRakAuX#
zgAQTZCAAmfS&sxV2+z>M*xpE4G<->hi?6a#{_|vAVAP+;0HRf5Lw*m6x2Ph3q#hA1
zNa&-vHv{ht&?W5&B4p%5Uk+T*F}3dC$ewqyyMwckCm!xuusgVbeAcy~6;DL$f{el&
zy4dyEX@d(jcGvfQ-Sv5-BwK7d^^)EKW3Pg(4J7l)w0gh4>5w;Y)Nxee7PDJHWVrxK
z#VrF@5Yj%V;UJ|>z_kWee;k5yiCp1A5WaYN(3x_z+u1wc#=OUfR-6cBw;s9??G8%T
z5XY!Tx`S1B&kWX(xboQ#6$fgtD537cUZ%DPub;Nn)nZMPHw1byZc-IOZJ?N2WVm&9
zke0+a9u9=k&=>%w|!MDQTmx1@McmDukqX_JeHrB7;QgRaIXuPg9BM|!(6o{8*{fqHg&TTS2P^fvyI9lg$?v?8I!3(y+Uh>vuHt&|Rk%)2ZIEkVAAr
zjf*>jJOj3}irH0C^rhH^8-H-W=WqgpKDlfA&=T6W4qIc`@|%fdENRTe<^%@RoR0I#
zWNJbwL_ciULC&dGKQ`Fpg$rmlDx2ayT-O-5z#BYJMtT%U<8)I_3h?wb%{o2Z11h$r
zdm`VVUYvX$Ff;2uW^!ZU!?~Losn_weu8|a5YtMDc4|H_OF5XZ~ewvopy8I;wdMcb4
zz&fq1Yux|RweUkK06pzloB)97bFG67#(=I@6WpY5`!pIH`mAtc3qxUdS9>RMIoZP8*Md^zIy
z229r6=@=zeT$|$>w>r1>*TRN#C525Q+(P)dZ!*XU-Os{9;XnL<~bzfLedGKCF*UQ}+UOy8R1%7+u3QioTf_O7y?Gw_c4^)t67jiujOMtuZQK#-E
zcAm9ocXc(iGDtmr@j#_4gyicySI}BwEpU4BK-JKA(J67Tg1d`%hvvzactSw3Xj!h#
zq1A?7W8q%0rIXm6pLEyoT1%75?^iYf!%fa&aSq<#B(z5cUIj|CNdQ7#Z%D%M2!(Oa
zAwBsNZC6kT${6$53RibdEF5_NBXEkMPqbsnF0O)IoHA;2RRoGh9MvcpzK=VtxC2yj
z8xLH!$r%obDZb?P4G5Gi8%y3F^V0hPtov+XtVjgPgmsHI^jjf^!sB_N~`Crrb#
z!>X>)IL@d=fqgs?ZPnV-$y#i|4ozcARj-%frm|MmzP9VD=&b7_TjWHe@Q3MivF`QQ
z`&GNY0R7$CIi_|g7ocmWGGV<8guRHd+UXrUZx(NyGk40wff_s?-MSxTF44GpxBKuv
z4<7rSXPj+yY!!X~5-hT#`xj|vhHU>bNd4N=`2FSJ@So3rJjDB|2>fbr`1NPQPoy(4
z&B-ZqOYouKG@zvlT(9Gb!@t4;5YNqA!0#Ug!DI8j4el$ftv7>N
zH8rW^*1Eq@hsedhi6{p+CX^#%NXF6jCsUXV(`E9b}g8w6c{{{#Mg
zA9W=$XqJ1pVdZrJxg8=m7Q}_4_|A@l)^|4i+W~_T|CO7tFj=I0vzWw@_^y;JSHV6O
zmmm%B7QyY~uBiCYT-1pWeOrY4AT9fc_84;)%>1}#k2#*QJki1Ap+9(5+*khVD>fT$
zTpWJk`nTcM!jT}g@&W(m0FPk~eyxDMX;V|UMDX6=ZDR{ymN2^k(=dmq_==@ry*nV1
zQ*^Lw@ERrtEb;&r1V}44S_uFvihf_#3|LN>>HQzU)6CQ1$YVF
zh^j6QLp1EHRMyLo-r|c~bO3dVY~SoWmSE=h2$`)tiWz*4meoFB1xcK)`)ORzaFmL^
zs66Ewx22q}&7KtBiwhZ84|j%po3
z=H%E!GG*#<7DLD!E^^q|%25cpEjsHAf|@WKvudv>>skI_nyGc0CB)PvkkOEvA)ROl
zXy$Z6bDbyUzNv53CkP@-)GuS((
zPkWT+Q3X&+nG?c|oaE@C9$Z_BCftsRVFfF8=0hNyvxka%9RTfHq3{3-sB;H`%Blch
z%GW_X4`AMcS^$hL0CsET-CMVcWKut+;Q?vyAsHcK>IT^ELyD?pRGFVUDPdS*&?0fz
z-gl#DU?!GkVF&9ub&xdV1));WXfUPYlj~1#reN
zDPSX_R$VdBJ8`c62Dv(OJyYWk+PuKuQwq1=u0r0@j7A#f*1}?W+IZ`@T5NH1SyD|6
zHfi-i6Pp!@k1;W^d=TK^v5l&M3Qmdmr3yUUspsjQj!^7Q5X-{2=vLeTL1<41q!x5&
z5?&q}aJMFQq#TmCG#32C;X-(dfcqv4A5rzM&*;<-pix_;{uOYWJjk6?MU|ao-aB!>
zg}nAKR}OLQ^t6Y$6KzFpCzgF`^0gF{PIPI3@KR|jA0O_vHrOGv-|@evwuC+z7^~df
z)c?VLBvw!->R5X@XrwKM{ylQ12i4+{*v8o(JSSs^!#%q!%ieNehW`Jy#W8+`c7l}C
z>^%Tbx;$WWk{Rs$%~<@$G}>aTpZY$yi;>eQ5s)0g8=BK2aOwdmhcQc=KTK4eG@uyXpG*w!GaTSkZWQQxrwH$^g^jvQXe1=wbrfY5A|aoN
zgs8?{KrDQ!qyLt?qx6eOB*>&tLTerPM{W`ofV#7ASA@r@!F2{(e&duThXe~wl=}0X
zlUys>v;h?5p?5Wxw7P>Afe!lEh-pY%1&Cc6He*Ko0bxVKv}c8xx?a=TqY|DHg&nrW
z7TE3}4NfDXU8M>>Uui(A2Ty7>2xgRg%vmGMLhuxTuD?Qh7zNLAB}$9Pg8m(}65y5B
zequ1*W3PAY^isk0V8u4`HN+Byawr~gh;T>z(Zou8$p##aD2}i!zX(THx)bkQBGGJS
zuV(L)RtMScx_zZCZd52!$V@lS76`FA6lFjR!~u#YAex3uK4;G6>25&RW$+ubPd5r<
z$2#zas97%cqE>naBt^KF`2Oftl?rFOhXqv%hp>FW?tp~1V)TrxYf=9_z`+z(+~n)I
zIuC*KuZvzd2&9~Z(de6oiu}6`6g(l<2U`5K;K+|(Q$G&I=|ob|W)*4O!EXn_*=umU
zBD7vEv8(S5JIoMN`uklUz9sHsg_o$e8C42$gP>unP#nZ-2B44ODB)cO`hI$s*<65T
zm;a}GBK|f1PiGq(5m;2n%L-~8fnkuXA9VgAqMxhx-vZLe@!-~wN`fy7N$
z=W+wT(!lj{EGOv;RtE1P^8(n@$#xQ
zsE{wxsaBKfCNIHpgY>a2lh6QPFtuWT-M-lyr5}h`_GWs5h5wC0PrrZ%2N?#2`FT-S
zkuc-4YQ2NQ>oKHcjD?}@dVJ6qS~Ubn)hgxG(g$+^5v$qPz#RpG2U*{24=HNa
z8_1W}ogJ^zlzYfUPcqF#V~^f&R{I7DfxcCR3Ysn$Y1Qw3J_NF`XzP`Y*zS^3a42gp
zD7~S=XnI0Sv1Rb^>PW4+y{=SmhsD3rMz(Y6EbPS}xs085QR<7V>5;*ko5*IcJ89O2
z?ZSmo#1kDNgB+x|EGJHM@TUCK4a+t7PPeF+%qp3pd@YkPqT^_o+H}a8te5Y{-~|M9
z#B$>n#o(N+5`
zIuIxcP&Np+FhS?d=H0;Ks&A+f7SAnWd6QGr2zjXuQp$i6&{ea_Lm{{R$K}lW(?F54
zhW1=T=!ff_PLs%FhgE^Y!#5edz$1eT6vVrTeSw5g7I7hl2@b_EXuPrg5PaU-QC8cA
zOJ3c59XIgl@lNeOoJbWfL}sy1eG9OpPnSS52+!G-wY40lsCj8-FZh(L7}Pm+FL>HV
z4eEr6bOa3svHL@&i#N7P2Lm4i~YZb9KFg<-h
zGVIxJsu5GKGadewCD$JxmfS0S94yY5)0v7>_h2x%6}Iy#KYxg-NnUbtJ^GzD*`vQJh
z+*>j>f2b!butq3vF2l{HTdMw=fMXfM{uxrdIp`Y|EyIWD>6;W|ue^5$hnTx>1_o)|
z<*#E=*6aM9Q}8=5<1D#}1@|7R7PIZjn)8s>@OI9_Tkt2;U%~=ojyK8$Zd@c$(JWtF
zuizd8&LL=>=lZUUqdRyf2T<7vmI6FgfAA_eCS+W=XD&-eJbTH8WpkA@O_r@hQabGp
zXmyU;=5L?|wvWbRV-!oG343S?M5?EEhZ9aE_2tsG2*e4d@X!jhX|WHGg0F)hR60P<
zjU*W>I)NCuXRibSg$)i6aEMEqkkY(>j!R`#m3f1X+d0mkM+57TQKZdB
zxBAIXlYbh=hiXe?F}mY2YQ(I|)X1PrLkcyTN{AQWTE7tG$8uAXxv68hsS~-WCvwx{
zagk#~)*(nNsChLG=-N}LfX<#pF*KhWGci)}03W-h@f9RAC!lHgRB6O#E%6rJBUL*@pm`u(8mTP|h9
z_QpI?Aliiy!<0C~VsFc4_bZysjA+A$<*!V{+)d;~F;$3*b*u|n_4uUCbF~H^x^U&%
zSj7QL6D)%_(W49|V5WknzU5weZ!RaXgQJ;BF30$fMm?u@r`BNLTq=x}%1c|&TrbyX
zE8F$@g(kSnOMGDo#rb!gf1?pFxJ+p@Q_5vZJzw2(y62-|@A>mReLeXwduB`R@y}(3
zpfSmYVNbSaC^~jo>dynX;_9M!=qQ&m;xByA_zllV$hs5X9XAl^kC^WM##19IC(t%D
zKfGX{a|utHlM)di;MJCTPObu{!akg?@ZT%ZFU-x(M$v?UgQ!vmhyOMDBixoC2VHBJBx{wm=1)uLGD4Rt
zmzzH&p(;YvN>!?P&{c@~G8Ly>!2&TsOPYyu54v7pJC@(4#$&^R@O87yJm|V*mV9L0>xl}_bt
z-B45*Ohm-30AsUwYdUIv^&vH91th*Cl^DhvMTh29vVtqG$H5e}bfFHOR6d58$$^Ygi
z1c=#~pS_NQ?X#AKcT;~H1BlByrk3!mkTGSFTVYS3r`B`FVwq-5uSWwMU(l-E>2?PJ
zfbGNfx{2zCBK&JUs6;(kQ>;69JlQ==r5L20fg$R{ww2DigZHrw{LiXvB98v#InAUk
zv-L~?suedITnBfu}dqVJF)f+}7(jkNBfjU&+#nnOm8TJO!
zvUk|~IzO!40d$(|1`(e*b0-`>7wJzD?kM8mPMjMO!CElOyb7gHEvAv3{1EhJ*y$)3
zp(7b677x^1I-~6+Y9U1-x^v6c4m1O!%Zj6`e=-wMV2DSSYYK>-d4S&1UPC-Eg!9az
zkRGn$1z;Mc3+8>MiE}eupW7LbbKoJr1!VqgVuZ8Wpj5{Jm90o_;+z&$2==73{-MUE
zo4|k68HkM3!f;t(;8Bet)T7;W4ccS#6D-=iGFcxYY>)goz`_)nmd)2G|BlwOncG8YO74MeX
z1_bPZr82ry9u`iY;|jRLjUi=FOc^-Dl(=w^WBvV>ISRppL;aD|mpoajpY|
z4}?FFN8#V9NG=uG1I&r^kG~c*-|3?x-J{^@wmnlH%2cx4Bvi1)An+Zjhi&alg?7gf
zQZ2+4?woDn`w~s`x+dC7?AgZ7AZ7*4;BB2h>|y*z{rcS;Vs49Y!tIFbCy_lGP*TDr
zGiaOc7Pjk)b(jEEuwAW}qYiO!{u)-{P5^In#QEBznmc)0pSs_RTEcMhYw9uS$sk5O
zT!nOp=WV!gjS?YNt}tlokdA9)!7#BHv*v>r1yL7whM*l-qqB-=B#a^(Kr@v(Hkm?u
zwM~oEKZKx!XJg|8%1r(B#@3R}0X=&(zzC+~4Cb_5n+4ubqOn8@^N#v}+pK@Z_WT6q
z9P#>ZG9EsRj5#l!`S7CNCM;tO5^T=5Bj>0|0V0@jqHTa}=656WR9h;`jJJ-pEdrf!
zG})TS5~HRbQHt8!UxwUyKY=+%w0I(8A2Q~=_$bUSK#^ZjTl@2uLCd1F2MLx#MSHqo>7&ru>}}6u9e`Kaeafn1BMoOxf`01LHVd{_AfwR
zKDbaVLt%hlc})htFb9(`Y%?{UZ+J8Y7I1{lZ1>FXT3wUZ>Kb2=-`oP5!-)pyxKST-
zA$cUHKC*z=+Oh;j7UZXfJ%1xhAS9Swz$=6Ht5h;y0Lgp-DDzdS+>x)`f}&!rTwQ6b
zj+hYrC3xTUQAMR@8rA^wm`^;rV?PmFk7Mft3wTP0-LKSflW}NaseZSxF)=;Ho-7vX
zi{^RM!G+pJ0Y{(13wVWQWv#YUSQ`eK-6xN-moV_R2Xs`jOqB7NbYE_y3~D4fFUfpj
zNP@!)aOSL+xd#@CoZbTqs)fP0-vLa63s@`gJ466E7DILnh8KW&w2FB9iM|f&Ffixv
z0-=;=06|4t7)3k?IJzJ|7I6|##L1^3&c*_9HkLRw<)2v0vS
z%=&>*)(`Z_#MDe4&@W?v?@dhsJ?aMt(tem2kR)TW0ttHvDlqRHq6={VornXa%KDfg
zqD49}UF2XZiD`IhG8x80yJnu6?1|viWFm-nqfBNrimLq(^s-*s^sz}o>$f~H-4-=9
z*%mc@Y{Dz3&9uhgd8?K@)5kD0AQ%|(3@$7Qm1EajDMk3##9I?dMijM1xGat}*(@#s
zTT^9Lk@;=z3|X!fxi3Uo1{S$5tba*f7PW){>cBvRfB1O${zIdPy7Mz
z_qkn^2mxlBD153OwS>78gNN`nHcoFCfqNk&N-UERA03V;REhWxUtOZgpQIyESV-5&v6!(%Zp%UQF~N#2QM{BEll^m
z0ksf{tvwOK+Nz0O-EA?gnLxf#G81Cp=1OZ~^YN#PW+4+TxiiATBmHUa;1{f%LHt0R
zFf2W?9~e0fMaJ9^m?pw}pNmsB^5+t%eTn
z$wah34(z+7GJM_iZ!C_&DI`t;jPl?7V47@Unrt;6)S{j-)PS{=Z`figMBX=801_hp
z@n$)f8XAU0<96O_Os3uxas4(A3`S6PmtU~WSVf9BvLYF?W%3^jJmKS=WNicW;_w6*`z5mhfPi6i8#qNp;7T{Hd&9g#dpY#
z@#>hJ@sfR5YrzaR`EqfDpCPWuWH2=hDB~P}?2K{ggRs#DIin9EMjxb$VF(sxVEgdt
zjV%Y23j&q`t^s8JY18M)Pp=;JxpwGdiq$0dZv#h>Omf_9wtt<
za&>^*Ar7U1V10CuBxNUV1=(rei_<;^}0MxcR2yk2sIs8Ct9T?lTzDS&_Lvxrq
zOj5E{A=Cv~OzXwos~5TSV_(wE@NZ;80RKw56rm+A`Vq
zX=@)GqA-!tsnSk3G}-rQYabk!5%U@J=j`8@zcz(-Y)N%G~gn#(x!AH;8=7X1`o-@q{*oT~BtB5?q)N}YahtxGd
z-UqL>hzf`B-5=tp$Q)K`6tut@MrI*vZkAWJU^N=qkLFHBWTHraAVaHSt~5kHT=&YQ
zY}6KmYD{8eKd|+(0BJuyANz{Irr!Q#>$1hyxiT#0jdgWt+zJcu`vB@`)
z_(D!7zWcd1V`QezuS~sXSn*GneL(N2P>^6Wf=7Cx=*yZoDg!fc_EWV7ZAXTXiV}!n
zTJI^yk+$F%k_Jx6$p>nEK`Ol!*$-6o0!q=KgFo2o8hHt3BlTM`CVf0ZaH;mw%!ZH}
z(sA}WdgMrZo!~p3ZFYUG>vQ^NXXr_Buy!gGL!zgn5gX2wj_#(828TX$VK?>m;P5T{
zJRThWO8mSdI6QfK7yF9GyX1d=d_Mm8$KNyY!6%>lqrfwe
zcO<-a9U*2(1|e-r^806OdP~@rU$~MeZ-czS+x?|a@20*m=)ShFoBE=ldj_HR1>N8E
zd=oAsQ(qE1cK_)oTu(~1MW}cib=XZULt%f+CEz?l_n?Kw2^WcT2yjkys(32gO?^f1
z_}9(vro!OyZ=KKFtThU2(Bs0zX8{_E?A*003-gyRl9qM`k6xL%Irr4jXwt=I>Lv~|
zd+z23jz;nqbKvRct}NU*8kyhS)MW7Zk6hkOO$Cqt)N_O2*cgLh`}>1H^=|4!@XmjP
z98U!A{9*LYag=J;v&su>bt2k!8^a|`X^^t#V1io6uhGW=ZiDJ
zJ62sYldk8S{);?zhBa8#y0v^YdJX^IP0a^KfA_gQnCiTWz~$iRFJ2Q=Uk#4_#E0Z-
zAvoH6Za4L8aP$@YTn~=^z2`8!QtzIXzcZX_Lo*EEM?38IJ~iNdH!Zd`b>nTUA5$y&}}JP
zV4Ns(;o_y4=Puv0jFW{Yyl5~^MB!-h^-rojU{4d&*aITYet2trL+tg(K4UCh
z+gvC#Mk$#s!pX`arsO!R7mDRYnYePMH9n_u8=hk=tX;-@&Pa~7=wnig>NaR6%;U(l
zDL>L^&R)5HpPYT>wF_Wb7hjtjbKpH!mDBwngfWS;d8Xi5$C2BIAtrQv3>@xI*Vo|h
z;jY`Wqw19hD-JL{fU6LE?b3(#+O@p2FYNCQT!G+lLJr^ujp#e7=Ia{D`GL}ehU^f-
z>fqpI$6L$hHNu|L5688R#GfU1sNa&^#dAID%h(fUxS4jJeO{H!)!P#8Gr&ul_uV%t
zRg5VHn$3(HR?jq>1A4q2Axa(;o8?z)VssXs9PA}ET=0Rw>ARorP@>uF=XpPBd$594
zZzbvJarH+GKgN6ja~XPBdmRKo@M2!~5aE2go2;4GM60Za;QU
z8rf8-&b`(E+IwkUu|1+gDQIh_5q~(_sK6T&OMpq5+Y2nyu~BVW$0};>oVGsmm$oWv
zIQixKLF@2uj|<)~$$qdDo!ch^jInY3t51A@<01tN5`>TMRaJW6069@-KVj%A->dE(
zOQ4d`6!Z_hcJq@nue<_D4%Z$(ev{&1*gH0c|G*6|@lxSuAkU8K{SFcJb9kcNzBgOf
z?TOxVNcT$q%ng$}gC{AyoO1u+HEy(0`UcyOT1R0shPcOuX2F6a(FlS1V+BNTCrP{{
zc_RiOJ?hUa7?&g(xlw&MXViMBKW`WX7$TFe4G)uEUHcB(@$3+QBrVg|^`)?yxZC(yqHkTGT_TKnc<
zb-Y6{1LSyzViw4;4#f`cXppK$o-q2tHZ(FP{P6^UR=4M*rm930`
z*(CE%XnwF8%Rvg}L~#+cuGPJ3cm}8H7dz*WijiYBiY|1{Ax$6$6o4_Ga;?CG$+VJX
zD;?@!4s9jNR`#evTgkE&A17WXBI!ijeI^;`BY{4dWWa`qjwa(I4_;Pyp(V)x$_iUc
z83UZ3rf?`8`;u8K6E+nJ*_PA@BPi?5^f8u2B}zjmhcUD%dTMM_W>97-
z<0@(?7onV=+ENzK3>#Q!E5yZVaCX+k(UgdB1BtjbiOYC#G(=*)e#B)>eI}~U%SIa}
zX6yChXrF+%$9iUgHwz0?4H6mpkvI~U(qG|~#!IcJXvL63zYoy@($pjb0D~S(SR3cilZZ3u@!}kM5GUwCeHJ}lHisTB&Y@?<
zq6cLidi+R-9u~|ezGrSGFJO}KF4L%cSc3AI)fAkdPGnl4Zizu#VX-QkDS}#J>BfS;nYEnZ{gT3|>Z~jhV(=k{CY^
znBRzQn7nM5@VhFUap%)ke#cSw;5;A7+&F5#32CCPz
z50GNzQ!J~SU&$~?*BI3|-#>%BADjv)Lw#4*=NN`d5fcVi82|=I>#tp$_BbE#rC5xIf
zbI>>d1CsZx7PwBIev(zj#u1tq>cx)}Wei-x!Q{sy
z04FKe<~}|L;N;p$6Lgsc%zB-r32Ge7sNHxI2p>1h13X>lb`vPKkyryvB!I)vm}@l6
zXl7V+0HUs#P*sW8FE2{WxGD&QDM^HCQ>;d0AFZ`AGMiB~$xd@}+;7OmYHgMS8YPQ1
z$UIb^BpS4lswR)iF{5_H*Tp>Hx9KOG@cQV-Yu`-_>(q>fZ+h|5?G-S)9t;>wPbXFW
zq*u;lJ0(%@@zKD|rNzy{U5|i=`i!%NVH#p?t(9?FmDwn47S{8s^O83Qi(8Er<)K8=
z<;h=cifS=+I0%kk+r`^}!KsQKQXdI|k9_FWsJ~d-*p@$;b
z(4qD7f}AGl-`&*b2Z#Rc_1)AL;I+XUyQ%jChktm9F9sg|>Xm+)SM$XG@W;F6c;tV$
z`PErCDb<6Q-P9KchkxQ~AKb|(XkQi_{tcYjetB^Cmu}KHg6H?C$1X9$ZmKs(z3);#
zpXSWK2l*-tNz%Q~Rppsj9&z$b8hS^;Ez9sOTxCf@xfC5F6RJ8rg9i+Vck!!;7e}Cy
zm-nWY;JcB}xxtq%l!d?qH1);{ym{H69=)m3c;8lZmNHP_O*pZ^asI}saH&uVZ{llF
zrmGqQJmKZV(Hb}zpf
z=&!};k65aF35*~P1wrL$*w?JWrb-Z5$3=56q=71gwAx*5FC3&qhjVG@N^!)@20;az
z{XDfAP~iH(6c>m2N3twRILi!+j2wcfv&fLBc434>)3|;{PR(I@@;P64K@ul*<#kx8
zja@zb#bNnk-@o_P)7VmRZJ)vu5-#Zf#gS)Be
z;LvYh88j^jQW4$H(NzCTO%l!7;Lu;pW(10ijO-9H=!c^M#MB2wUtS_e{3mxb6f7(@
zU|@`d*;|9h$TQfP?l6FSK!%ATp>XmQ#A?|T7uq9
zy%-!?dnP%d6#GLQZ_0xng
zt5iM}*U?a>i=|y1@>+_m#8vyQWywQYJZfOTHUxTmyUBKhWnbpX06@5!bI;Z_gKgWL!H
z0ttsLgM~;P^?Hr*$=RJ_AUfnKRAEGbMN53^=;2>gP6d0jc%0xLzL}my?D2lxp_hSt
zL?7}8fgS#7IzXH$ZtSk|ZD;HwADNgk3D
z&JT91O%&MsX&ub6xZ2dcw!!i!57K)>AZ+N0no!}~TnDdHW+Y-Q@oGNPA+vEY5Lcbu
zuWFaOt?pAD>K500am^NzjzF8dZS|&yJ5&s5qg)l~N?0AIN^LW4=)`_q*rO~P-c8*I
zj(p@AH+fi0Q+&{%FLy4CGEs=1=IgIRrosLP|A#TxVsPZedCty^?8W%Cn<@rJ-upa1
zTPFB!YBlJ7_NkNcJm>j5WEF0HU^KR|oBD8&`i|%Bi=8DaNbm+HUIQAjn^(rD8A&BgT&fLGaWo(JM2r%#Ot^
ziGVjY=UE}2u>)nET#M40_#|1RbuHYG58eduwb};WA~MpOxDl)@lYbt*DrTYm
z=51V|Nisf&$=KxK(I|Nn0VW7^doRyU;7#*Jr6~S>D_}%qlbK;G4Z{OiP^vWU!nWhr
zA??2{IP|6H;A278fBTf~+bCto_8lfww4V<0$oBT2>wlP?zCka~0O@+UK=Z9-uouYf
z5vXUpD|c;6E)B24t>or*_6E+?%aABH2QO&{$LFh{_)3YV?OU{I8@Y%T4*TV0z&(Be
zDi)IW;?nja#MoMvQt&eUG3La^%AzTMqXCV@B40Rz;C(mGW`r8?*n6dxpTWj;69u(N
zyz*!mJ#EdD`EyvYeS56y$X9jg#uzu1Rfr#x{a>M2Ghy8}Qot7Pl|UTaS85)_iQKP(
zJdD|(Iw)*KK*C9t%c?${aKX8@SY=m7Af$Q+bmbVKN{>!>Te^DhPHJ6a@51
z1ITmRxRkA!VXWAhj7VP)#5t|1O7weiA`zNQgr;0O93z)R?8n6zii;oJeIuxfvizq++f0PEUcL|~u3TG%MNrirq+X@=sa8H$@`$TS_7hD1N6Ru*w>Wf3=h%nn)cc7rNL?1Jz>o9#6w3|I?<6oVFq
zRheXPsP0obXoXCHSPN(HED`9OpDulEiI|#fiI_gNm(ptwT~E<1T0-dt
z1_qAaNGjdV%k=7)vn^fe>kGS@;bXEYj(VVa50a+&2ll2*`Lw$RFskWvhYztE7
z#}Zlq;vd8WQZ?4UVga7DVfd)%EpM!rg=;NBa4Bey;<(%8Z6yMUg1s@yGoM#hBau-D
zUNZ`d^D1LMSWbsp^4KWs|2DQ2w=N#FDSG@E$>`MyT9P`wvW!ZCjAg=P^FY=}WK>2}
z{)i5ir%*SUc{6FPwt_2JP$U{e*f?-Ph$1@PRP}jlI)dvH8lgl)Ztb%W2`j;9OW0A0
zRJ4K%QsvDwJWXPKPDWzf)*z&bc!lKzJMXovvZBLgl*hzO6g7*$nE0(y3<-b~njq$B
zUtElWq9~V0BO1ss8VFgTTkPB7fMq2$uXwyf@0Em7N;N1|+fExVEVa
z74m>|ReHep>K69~7#g02p+b~aszRESQdHRxm=Bh`I7bDZ&f**l;p*^aDQ^BFTNTvH
z^~g03tm(poN||740~kb@;@W2%BpjLgXN0W$B&etCHIX>6e6LvEpwu6qVWjz@!x}pd
z1-DI2oN_2dF@rjXk*TRXiIIYe#icFWb8fW8f`OJQh9gT}K?5}0Wu-{QZEQhq1x7_5
z7DpQuiK<1FH1<6SGN>|?14q^96dqDpRp|M}yV`d!;c+^n%xblKPp60MH;7@SmDTMH
zZZqPDN);~YbXqEPcoBCQ(r7wPuKR*eA#UCQ$i?1Eep
z)v1FiK>MST5$a5^TGDeg4KCsRxR(By1j;f>`x;?bh+j2UH@_}H0V`vrItE%4)+m^y
zeo4&YL~zUOGc-RAw{cR#+6zeKPln(v2q@z
z!a`d#Ekqz3;C7ABiAlFYss=GSZ9uBoj$a5y11<6ByI&?pGT`utVS5$PNXS?EJo)m_*+Z=lbrW93<*@3BlH8y*mxc0Rf;TD>p~o
zs5lIQUf>9*>tN=nErAugv>Te>{5zM1Zd;z>a|D%g(12`o
z;yoiOQ!?w2gk@B9X-v}=x#O&(!nz$GNdY(xW5`J8WWT3#OG{gjT`x>V&RStVaW>O?
zLjr4XuS&~I*H;Y!@n*a=1FCaXGY0{lK4#mcE1AXIAOT!oW|BhZ
z7!p^;wy0`J2P4iUi<@FOjx-BgYjL;8#W{85YR!nwwMA{MwMJnnQq08F*>y+}kcf8#
z+!{MIsd!ApE8>(cyo609+Bha&Zgdv3rpS_$?h`8PnC8}<*4|;UY3-d|Xh8;&x;zM4`DG#w4DlNuS2kKVT7qF5T<3zcy
zTO|hJ6;P4O0IZ`WS^LEpe|gc-VJx=5;7sIrvMg71b
z9*dY5Wh=6YSB8aYN1h@vT+5fXmT^X+Bixoo)m`UeJ`sWOK&j*}avQa~aQZF-pj4IE
z!xBOsQ!W})duUuCQ
zbT$teOi6L0L%vz2N|0Q+2&SaGz&ytmAGn+oDuf~cLseMjssilD`H>uIDQ=NWlb59W
zP=|SwXGn@I(`~cp$@Z{JHG$HoWyWF+0gnsPE?X4?Eky%^G9a5O`?yT78v<}jN8E2f
zrq}6X0{(n)Clbn65j4t4#ehSfT@BK@#f{@>7)MIJjdLm|;z5cll}(Kw;SpH8?V^4G
z`)(OkMT&{x_FM_YL~O#u4nA<)n3z6jc_0}QhYp=t9}K_N>0shSSTlgAF)Q}|i5v`1
zx5mKpvtrzpnLeg7*wpLm1au^m3AFk&qoh?h$x+AG2I
zW>8&;gqgWcnYba(sJsKsBAD2U$aDT#m79W6&
znD_YSwj3sCr4p3$0c9N;7NxRwL?SSH+NKSmvl~V=FHx8`F!4A$%SBI3
zqU!lsU~|2&0@j2h%BAvVbU!*aH*@9k;^hl4%AdVHbN%_ng_)aA4X#0Z147sp=kDY=
zVP(gF2EyQZ*Hv*VR)4|f8ClS&|VmP-&lDWSJ$v4h1-sF??ZCIV6>?Zm(y^D
zu46*G!xg*K$wBv|vvu$krAJ_E1smwL{IovBqq1Nyp>qcX!?s~#{spanN&JAw%u&NO
zvk-+!H86mR(xV5@PH%xH35*CK)-*20z|L_8&^G+$5u1F3!#u&LaW_ANBd!SlVk-~(NjT@XdE
zj^5nb04PnEd<}%Tjqn`%j;kK}ovG(sgEZ9%Wm)7=9D1Bn)SFJDg8rfG>7&t9A{ws;
zA+ou1jxIVu8z%SAushGoN~wpWWBB@93Dv0^*CUHX#=meYJR5%WDD2=4kc*Br(aoLS
zQ8=~>VU;`z0H?xm$d%28`xs8o`>4|G|IPehD_5`e}1^CXv>cP{nMg@DF5C`hC
zsH%tJz7%D5$4i?~(r%7zNQGper6*k~rk%Xa^&%!6uB?F+`ClIz4F_u!%{Den7SMy6
zn#gjFRJ)*6%0Qejfooe0XvHY=DopS&g~Q<&F9=|`^CX59~}z&qOPOa-Uz
zE8$#7l-JW|yrLb8;o6y342tST1#HKZ9@o-guHaeD$@LO$>_UMKI0Qq~0{K4Rs2~3t
zz4>Cld+hpjsa73qgtx1;yMVLM;9^s%g;EDHo)c_wwFmInsX<(mRYVV@$e!m!s@d9<
z9gH*;mT4*nMi8CeGm)Hq!Yl+7R(71e8}aXL
z688RJI8TL%%qX%?=Cc6v!HZyTnHR=$CkwfkW^x}~%n#o}EtwZgFh?E;+8DmZ1$|-W
z`pgyh>}@RP>evxi?%`U=T5U56l~hhF7zbg4N3PW~-+OJc_uACZHMJNi_T1>X;Q~nD
zOWw$GA8%MKui?drdIPUJW7Tm%-5O>JKzt)3b?e`j3@)g}ZTopN%jc?dBJk94T3gMP
zD)l0i)xE`HrdWhE2L9GI8UymT-d9{N;9m{@?)8(nTWW~AIB7h!sgKkgEL0j}aB?TD
zVSX%OcQ7cEx7ZMu!Z;G1nj9)&W3~xzl_NqQcob!OtvqRqRbWsF%YD4=&>;%XH}D3N
zF6dz1$HhlhuU8LTm%*ho{5Plj?y<6eDLq=V2Q!A08d!?2(MtsNqoI$WkCBo
zVY)4wPw91f9C9Con`)zQk2dr%g-FZBt{gA9!KP9QKpGn%fTjrgGNv$U)#8&lI_KrE
zeQ@cR4lC_2wxZvHifvR*y{a8Ez?(5!hM7Ta(|D|g@Js7G45Q5jQBJl75;<*(!djN*
z^0}pQ6~bu47G@hI9MG?(#}0%ImwzyQ{6Ga-+8sw>-vSMS0ALg8)%%r;DA*W=UuLx%=JXT=CCE=I^ueVsx>@m3Z^`akF7?Hm1nDX
zVpOc^kg6A^+((?|6^JW|LGOcLgZO%*1m0|(J<{8<8xbc@=m?-}n3#&ss}oW&VwwVs2<0nbs@Hgci`A2VCL
zoZ;U+^%34IGH+gu)K@{|If!wqc`7_mIvY
z#zOSl(So0eqVt`zn1RmRcuOjIWYEK&#S@KMjTi8?!@lNHk=jFAt
zP=ZuL^f8$OD1p|<6I#Rc=><`VhvMvZd0Va?QdG5?6+PAwS$q^%)mghC@mvikrzS>s
zY{1;`sNIx>(R7@G?URc?a|2qu668&|5yd*NxedB8`pi?|)ExE{)c)NN>FFZ(4AGF?
zXq*85jt@pcvD0U_kLmd#me!KHC$yQKUl7hmcy;5lLRN^GY@mNJw=tNdUPi9r*S9vf
z@?w5(ZE(AzT{@N@ejm7k0LQFj#}vHnqnD;~%WZ-ow~$Zc!Ld5@2WMgw
z*i|@2gycKFUk=of&bN#XHe>5p3xo@Somz$)p4q_ag9lS|I&c?p9~v)3eMWBqMKppp`
zMF8Bh;PKXi2@!D5Vr?KgA#l$kZ7n6lz&(piwF2mgM|&1(!+N}(*t5)FOGA5RjLuMG
zI2YnhUl{~vLU4Lf&@H*Jhao!vHoqJ~C@aE7y+EG`
z%c1tJTnB%`GA{GETsj)^e?x`RodVW#I19$PM93ZR^43c)LHAJ9UE9p1%Zu|@Z`@qG
zK67*aT6PT5hQCQp_gxgbAFpbofxwQ>))p7i#?v=U|E@!X2(6MAI`JxOs$-|cAr=Qn
z7gYC9|H5+)b%g9BsG~HWHOLyEU{xPaU*D_l@?D*f53N)X6M9u=r0SzxT|p+CDbmat
z-Nk}iDRI4nEh~meq5wiQBD+*&K?8|-wHqBqi^AXqW2vk_7f2M>yuR$Sz>liUd;zjFwK(aOK*f1tm4=#
z!dQ1VYjxQM;O?mi2?8VLb!vsQb4(s&E~BBs5NC6YAvcI(Y@BBp&WKn)pB98HDMIBanDWvXDh9V
zCRj+ej;3;gSb7a;()1sn%hXJYYkiK
zD#nVP<(XhBhy%pwopNh*CRZxf+hQ?l7;WfA+ftApPLMj)vcBFLJAzuMw1-lq*qR0~
zWpzo9nT}pkMWirst~_+nLCLTn5>QCd=*VG!a4ye$011D&bFJklrcGO6Ey)^(
zb672NoE_Nfru!)Hx5`(LVfOOilFvrz;RBQrA1e9mR1R`SaTPl-@Z5VivVc8CYnO9a
zhhz0zdel&o9T$p*m}tqZAs2U=)(qq@>o&{H9j@Fz6NZp28=JK?*{j}#fFkM(xJ$!g
zvVwI*1P^2KEhlfn$Be|m9aro~2WA^&a3})-#BBmk8R0?{RVsn$Hc={)X0=I?J|J<~
zUYK$Q55z8nM2u&z)C83i{K!BK!ZHhO$p-GROI=FSm~*AFslc=;KlN$_{t;-&un8s6
zMvYE9SGY$d6S584-MWA!m9U>i$b&R3y(D|Wk%o*BU>nRMZReKuZqQ1ym@A
zqY+45wgL(Ug*7?u<8_#|ZPWng97sk+@Y0o4sZEYN7B61Ee(n0=jhoM3z8HFU_@Et9
zcTD-{KMm*qpN6wJ9Me`aBNQKvs%jAuBo6j;{{Cecnr#|{6-)!#ErYmmUdojjUwW+U
zrn95wgU(v2-#K%*U05w|ZNd((f(;}h^;(E+OcX!Zz`AKKErn*E5+-w-G*l+$+Px_R;Xm5!5!{1A49QeCAkWjSNz873N9
z^}F=dNAGBcFRu`Ts-#FnnzMM@j+BeohGc
zh?#k~EE<6901lAu4{xl(>crla;yDZi1D;WE(Niw9d+uwrjRAI%!f@mag#=*TvPoAAJY3ThL&%YH
zc`e)AC$pHHecQ_->UBS~4drv9roV7nL&_Kt!LhRE~i^141I`@&5`TPd2a+
z8ORK&xh}B8#JPN)zmrn55aQrdRhn4#U>C9_ue&A78!*t$8SDZfH+iiVs5!%efqgKJ
z@yiWutHTNcf})`G>A$r@7P;{?3vB!F{>Ly*nH#;iyXVZl#_XOA9ZC1OlgZ@nfPzk7
zFNUMJwHgR$GnPM~&$_d&XW8k{DhzbXVXMP}F3NUTOi{0CqEECm%Eh0pWpfY9F=R8O
zdrTeTh(m-WYcdLnjOy;XwpbR@}dulju}^tLWX$ozlh8@w;IkZCT#Nn-+*)-rrZjjruO~<)w#M{zJ>i2l
z4Qyb<6q6S*poXT-8n%+OHGmHk&ujrlPkQ(+>QJmkX0znX-cPu*#e_9{HlHkaJiG#L
z{}@In*Rb(4PXV-KI^Qus!1
z7V3b0kp33skVDK4L^c=01J&fSWAs?ACJ8Y(6C}ojp#nDe53Mb(iQVz69I!xrF;``er;js@y&lr;K`J-(~2zDTVp7ao(mVK1m>kT
zx5uuBcPd!huvF6{CmqeZ^Qr_ItPRRoOWn}m84IHHkeT$x$_7Zq6oKA{G8*TdQ=+1b
z$pfZ>gQgC1dp;adJ_qVE3~wU54Cf~~dWnH5b`wY3%NP)A;-gR5$}tql5#tS8Lwhb^
zGo{b(Uk7#JqTfi?;|3dgEReA|>~NKaI4Po`oj82clQ_rL#FlyhMIcI^py&z{0=)G~
z%O>t+W#)|LWGk%pPG^BcYie(7!(@(atZl)|!yvLk5mf@Nhxo_<^(w|tT)7jeR5p=@
z@n(VH1UIRy8-5aZ>ck#70N4N1-j|0*Rb+kVLZWm)2#X-d(pfrtcWx4b5JKpz5CsxR
zSi)lHB%MXGkxqc
zC+cb(>j<5o{OD5^nrqTAjMYkBXzGn1Yqd2yH9&JLUUvmn5$16oe4wA2!O&k)37iw$
zNd^NtkBFbtK{IjA;3LZhF1Xsn)2w1Yc%~3b+l`E0$S@Bpkap>cQJ%7cbac<^1fmhx
z+>bOtI5&Jma6ZNJwVn=121_zwQP^ZrH3@o(&+5^h8pBh>J_Ve8(k~HKk#EXOQHchW
z%&WwCh5b7{rUL3k@KGfACUJ+583IFKn+RVRvtCvBgACHY)ux2B^m3KSuLJgcd3f-Q
z3=ing2%>XkyVwk
zd>l4Jz(O9^uviR3Q%7lMiEv;BD1^ph*FdY#3!pBk@Ee@)1akt_YYl@x<^U=@J|AsS
zlF*J5KCLly+`4771dW-`mfLJ4MjIbhj!zMKTdaC6?6_!+wCCi_dRDO$w*^+DsSeo8
z0?n?o#uToRbosz|V!}Kjj+VmgCzE_3)>@NY+xmRv8?G~~rJx10OWb8m8~j3*s2&#G_FaiRlyt^Gtgtja0vrc;S}gW5ZVPg+|xQ;#DrN~)>l;|)JW?XfkO0Q8luZ=(41y4pv?i$WpOA&T_rr#D-(9{
zXhQwKt*IDY1A(WD2Nc~;w6CsbYTs&3U!Wh4~@kR`8YP#IsgzG1PV3I
z1eyS5SKalgGH`Zn9hOXm40lI9hOx{YJww5E7xXbMMLt*%
z)AKc=o64uc3`rfgufowDqk5A~8xPrgzyuVuAs+sQ2{$bdjY>890I7;s8eBFS8UH3<
z5*IYzn9h||jWN_4Mi-zDB2?_t2(n#={~CCXDrh`^*UBi;4EkwSWp!gU4Hujtj*<%)
z089ssm@O-bEURS$Qld*~GAeoyc9*bBQuzvx;g!x<)c$XF3hp6ZGX~XdE={3r0Eix&
z(Mcqzc<~~dx`n_irc<;7Tx{B=QoXsEc@{TqhI%y#WrcnYt=y8w%*$6cOvyv}{
z!7_#1q{zxQl28}rVYs8{XcLwa`vtaUY>cQ9ZMe}PtDw`2B15=&qDCN}!!q%rQ$1iI
zu>m}%gq%cl@dXp`vKhnxaJSSI~soKh=u%G-t+UkI~N}Y>Md0Av%G=ZV-C%*g>&b42U9_mVF?shL#)eE+&}sOU6tn>Adb%<}GR?pwBGu=)2j4u2L@mbl3T-3nA*>?jsyUPQ#HCbSU5(1wQI1jo>2j*p9skEw}*g&cADM%08f
zO{%=hZAT!Jbn=O8Xan#3x4O3263U{IFmXEORxi_N0HUak(G*}~s;-5EcvYisqML|-
zz*Yrm28v00dZ85BUcf|0%KF4PFp()Z)?9(uevth@2#W_fAblf(Msz?D5}3XG{=YmD
z3ydl*Gl&~BD7CP02b|v1*MFF*Dg?
z6#JnZp&z0Yq4~iK#I(sJTycPa?#0y@&ARkK?NjeAoX}_U?Ml6GZJ@!!vTCqj!1OA
zMwqkcSciEXMCTarB`1JeCJGwWu|gIN$(DNVfS_25K^v4!+bJRrVqnes5B85qUU}CM
zFj*scxvA8g27?p@`T=1m=)$0WU!mHpKF@Z?3jHlPnD$Brd;0b4S2w>IiVLVlmGBDLn|1_K8
z#|kQ%Jup#T$YQa5ab4jHV}$)bb}a@(*1=9K3LHm_Q`@tfSJJPpcJZ$r9I$;dTK~;W
z+fmQruurv5g`qJSC{mZEo6T9^GR)I#DphUMwoe4#gOM)WO(cN9kj=aT(EmXHPy2$7
z8<%z>wjmI{dctL~aZv)&Fml<#wk>JnjHKy{NVdy#hPCbqPw1CMWJ`4H1OdtygJ%~2
z4gPQRqR!6asfF1M{q3{UuRZm?hnr?=9PfLUW&cKR7Mq+^F~w4$H{L#&miB;ZMvi7jp{hwz@r4*e7|0j5VGK&)LgXitc>e5g5}p0eQ=AX`>L
zwy7|ML&0IZx_*=K2@6ArH-eW0jti7$(@0|JERA4|r7$1hr&)kV@T3&-%y>dZZH+{n
zQKZxqV$KQwb|)pix~TPZkMT}Ig6%5M_#awMwCg2#1;b`ORef%
zZn9rmcMJKUrc>u-5FY)Y74_FUAV1Y%%W5m_V#X4(td<>W$*xtfLogB)CfHiLVAL8C
zTDRMl2G~bYQ(9Y_68x2_q!3aD(kAgdgl@}PWD#|s*!8D{88%9%pKr-g27Gf|M
zzB@{>cQtQYE=lehNEj#>Y0SB#5#X&>*<$fwdQj8%VO8Kp(}2YVi;LUC6^R18Va
z(KAU@!LsLZt1SnEQ3`1TbrGS~fUqKi)g*j^Jen!}oi-LYfU5=Lo0wpQ+Qtmi>;^i^
zFg2sC$Zyp^U6LzqXyXNMBr2IOh!izS8cdVSIm}X%+Z`M$*rP#^1}r4eTrCJ9WtC3i
z;^4Q3drHU#g)@%_OAu_tv2fPICCmFEA5&5a4n1}NYk-N6z+6OW<#}F-2a!wxOeqBK&U-G!pNp)lTO17BfKA6Y8gVyOA35NnAk
zSYSueV3jfjirvYmo}5lofyEl4u|n#zN~Q#FB*Tc+h=si?GwOkBCfPVZmH!7>=JFExjPNUQpMlQ3X5wQY#S&oW^L0<3IZNX)4y?J+)!N#RmFAKiM6
zlgx%3fzDw#W;G;w?2g+mALG?NKnPOD*aQ}+3{Ux22|GDYH(vettVVKwuBumJq7k-w
zCYO&Xd3B0CF51N5@-YHqSvrll+#%>NJbN+8FR3k>a5r&#k
zrZJ81%zt_faG2;JGFg`ftJh43)e%l_&{b81(LXqHw0f$C79KCd&ls|QRCN$x^ot&?
zBj*;vU5=`7At91c)604XQEY`Sj7%c^3V>>Kn>k$YE
zfv**O;f6^2(3E(yH6b<4@0aFKXluAB$b%z@YTy375PI3r
zODNvYgIHO%6VXAgzNk(w>cMrBl|o>AQnNjHD%rERY5`#pL?&cx)dZ|oSr7S_W~gDK
z_hsz=UJI7sNO}D+PT690xsXQ+G?u@
z0wRgh6e^G%|hJXWDG=6vwjd^xtb)^N*L!hgr0!LwNLlxYKK>&OW>q;LU@VuBQO
z6zqW^@u4@K%=8M7&fF1OB$B5P2CqgPgPesXo_(dr=7#_*fDLP9t&C~t
zB^olm&SPvwHL1ZOi4s_Bu^Ux{;I-gbVK~~-x>u9A4Ka9?{5CUh1yW5$MUo;Hn8XD=
z4n1Cy0p$R2Y`vMjfJtG4(*zQxsagXEt7GT^WsW-^YlU{ksuqFB;7XeSH>0)?gBJ7#
zGE&Mg2F4cji!NVHnNPewTt9*Ry{3o@$K&C~s-`e#O0kKkp*&$81yWd@OAB36YMZ5a
zu^==dLC8o=hex(2nj;zoS|H9$Gcke8@Uk{2;ZX14o%(-OvI4q26W11R%2u#wf;_yA
zmz7y_{=kNYSkVbV3xULxWzHqBVymjY%?Qkq-gX3L>rAtC;1Fy)2VSf|b1CL*kR*hR
zn9RgEndPjv7DJK?o(%RiwNU>Hb{AY#V-1kKa9ZR=vhquwGp(W^l+(VC6l$UmadN__
z%D=>bm~O}>92ufNNCoi^V_<9tIQ=mONE)0FOAlv|xgDvv5(Zim@ihqH8J)CE251j4U-Umw88=mU?Hh-4v%*!sUELHQcL(AUV?>CSIOSU^)zAG(LRA
zBt)itQ0qLdM6Wd4LqQ9`5+zynY}9rExi}L1@fJNj4#vcV5R1AK
z%C$2=XG}(>#g%NqtGSR;+d`_VLUG_R;B__l|1^6zl-8K0dtD9<4{h2BRCs*V9$|uL
z+m&nYK5v#qu0L7o?oW;lBNS@$eA{5_#1c(5?a~~r$zZtD=3aN>a(if?
zB^c^i{Tb%k5L+#M%;JCeX=xW{x|@f2(Rmul0|x~%rXvTm;g>96$qzQ;e}Q^eq6_-0
z4Yp}8wfo04Thqz%nRVgG<_Ju-T#$d-3fd=o6#)6hP|+ahpWMvPzglxxxlvoAKWeT)
z@dnX?p#Zi30akA!^IvTuY+Oy{EH}MyZFkcf*Om4N^AskRf|Db)ttY_k7Mq23t;22$
zwuReRM!*1}e`eY38xqB3hX)ww2c$@7Qu5m}WrKe^$?s712LJX_`$2gt6@{nPUj&n2
zP6sias;isQXh!`-xC=uvUeCs}Md@v1vPGAuDT1LGYidGEQCUQnF^0QH-{9X>YFBad
z4e9EDu_@{hm!z&fnGB=N+^2|fp+&e7P1)#Sl_EXtl}Ho?tJJ_dmrE=6QO;MI77Nj<
zJvBa}F^%FELz3ChW?GP4z&(z~&bCVI?~=B`KU!+{O|~Zl7Cb&o2|hrQhYaB&(*SY;
zeuT4tK%vzm(h5gxgTGa3A2tg>^B<7*aM~ZzA5MEXeTa{CAg+d1Fl6{}vwLZp7?g-e
z<1@gySX`fRd5l@K=Q!knux$}pVvj+(%5Sj)V+-hrKqU+=?+md;sJs>qPP8M^MFr%b
zfJoQ&ff^0XmgP0`{Dcxz?
zdLorTQLV1NP@=9O$Ji?R(;H~9z@7-T32C7S0~iVjg<=PXV#9`Fe};m^2n8)4Qd=L2
zaDmaDD2D?Lk#zOYg?Q1JqB?V|L!Npx?<9^OCO|B(Dj1qpX~ejZhngrSj=CBm%#$pj
zO+^j$#c?)<6H8Y&wS%Kj=^wOm`bTMHbrFwIRQH^%_(5U_Ez=Vde5Vf@XdJSB!~ERE#E1fR)+28v{{Es7mQjo1-`2?p9=TIXovX`Q1DsYQ-q
zRIPKgfwj)T*rJQ|2xw7yurbItMews|Smq!I9$AsZz~%}15NxZ;S+VMG4q0YZKT4X)
z@f}MX3}kLaRM_3D;z&f+f>;%?*g#aPOQP(0)kqR2kj8xjJMEYA&X24Grf=v3OQvLQAqWAGl#6Fkoy1_pv
z%}y=b!%)2vCN=y4KBE$CnCcJ^*e?FS2F(QH9|}xi*MA{KgNcG7i%Z3B{BSqNny{xR
z7nWqzcCRnW#1=7R8ou1kHmWJk8nJBl7T*Z`L0g
z8R9o>EV5g`#-cx-y=@Pptxefb6`FY?VjTEMn=#Uar*ri5Xzfegr?8e#%VX`-@`B_P
z>Cu=EEh1;d@xI1!YoM#%%qPnp-y)G3M(=F*#!W}5AC$qrLGM&^>j>i|dWoYVoNTF#
zRY!qd8tZGcQK(Z;?p7$Ix1;VdGZX`CO@Az%9tdK{Diez6_WrEF~U@hyTSK8Ost<
z0;)NdX4f!L0x%JZiEKh#KuBnwI24ZU>kZdv`iHs#iYvEn1CnF
zs7QQ^Y|O(eTmPo)I06axV<;2fB2g5idc==;74%M|f>9=+##47*jQ&ZP+7}Ez#KyF$
z*_1#9Z2C7zd_@`AJB^CP<8V=U2+@_^T4JkYDm<`7s;A{azH(4SyJw864K&AE!j
zJN`dxPa?BYQcT#`$lF=Ot~|zcLGyrL;|WGunwA8kC$)Qx7TK-lDZ0o-zg_4KGgn(&iUEQ1{B1-ej7~3;ig5;Bh-WG
z0iEV7g^xnZ4zXDOt=@n{jLSh|qNQ8Of@ffVRJ;G)gSQFDD-m}y`z)~92uqFzKFL_|~5^!GP4Nb*@kqRkM8hkBb?PYx7prAKg3cbqBsGDT+08+D+n9WhvD&nSa&`nQ=R+a&cnTrr!
zwW<-%!Zx}B=|q5*3dsmTq*XGzs4NTAicQEFGiadxRWv$h%!mnz2}MPLY&3_4=v^uC
z4_j6aMFUkXr=DFzIC0QGVbn>PqIIt_+=O163#4fM8-_VstBv4K6rT#Ra)&z>zd0f{
z=@aaR97I#alnHIeu;79iOL1IFf4LUk^
znmgT{Z8yLYp=GUrCFu#_!~?-P>Gy_Vg<^(LtD-}@39mb~Dr9jPiUcF*a*nAXRNO9R
zit&iR6L^$!OxmdYKo9IMw_xf6CmgOkuDXf=>ata&q6M!kW;Pq^C}${s!-buWFzy=g
z+XOE)sbkHV*A7X5_lB3C0WQPe|dQiod45=ccjPO*qvOc9Jt
z)GbtPni7QAtUIObVYNx2d9374C8Byw{qx=>H
zxj#=S-duM;F~hSZUbYA-S9&vs;+Q*O6_k-XI&V}~K~_=L#H^uOK^0^S9^OCv3z0)0
zFsUu`q(sH4CNiGK{^%EXMj-O8K`EE2p+U&ImX_K^&A4cD9oTTf7}0TN+4q1LXr9?Y
zM#F-W@eY=_M9NVJ?QF)C$2^ui)Qm=ndV#SS823^%95_1=OXdGW;EY47y!^3-=I*TYJ?f@CQ(B>gx+gT$Fhy}Hte+DzRg-z
z*7lZn?^^2RM{q@(&(Nv54+(-T_Yrg-wN=hi-!NQ~X8O1hxZpG08Mxxz
z?7t1J7#e!`PX{BoS_oZ)?(}qf>wk%TwhzS3C?|ORKNbPGahNM$pNp{7jrFXJ5nnMO
z=8!O%{;`MH;vm6{b5(!{bCw`w?3jYlVHvrZSz(!@@(S?JsC>RfRf_;zQB<&z&C$X#
z(+bkW1Tw~Em$50#59Mjfq=uh4CuQ>|xVDS8Cy}J&7bO
z@UUYm|C79%OcyX6QSe$2sMI&Hm|nF@cGT!2P0CiyI@vs*qHvP!6eumk)Ke`vLA8hY
zECt?7D?KRt3%kxS7FZ
z2-zKTZ_P>It{On!2!55}0oy}Wx)+dU$3(-$(|q`4Wo}f95NbDN`DmT^ET3(H9fYws
zMT4im;A*vYG{B$(an*C|Mti&fiwM-fNo1i?8Eo^Gk+{WlRFf99NHA<$SQA6efv^UH
zT!KR^QiN~B3{1n{%J5n`BPEC)$Q^l1%__;_1t$v|)@e?-p|y>fX#}|u!Fu17%1%Dy
zRb#Y(;-@Lh5u$y~u-eSec*7kShFu6sh1f!5wkxV#W(b3Q3?Wv1fsQr+8=LBn`}+v&
zNKkRmKeZcdx4W5V;U%c5A7e&@`X6$J)umMR;
z0S(w(pM5QXbwFeqo=LNtMqjE)3+$$UQ+uYtn&$#N^NA3i@c7Y#M8fpfI113|hLM1)
z0*7n$7Qv{-!ba&$HKbA`C$phCW*kOVc*O7~{id4O->3((zF5_&P~8chUBkBVt``c*%_j_-gE`NGfd>cf71SN-Ic`r7u1|Lkk5qe;}i)!Q2_n}bKm|9pa(OUrHv(ZcxIQk+d
zoskJ?$c=#sAKT6VVNJ|L?Tj^YCNx>n$&moY4AHVO$OAuO(v0z&X@$>25Y>_^Q;W`fft
zHN4cRHy6$%sR=3JrS3Qvi^DV7u2>3u1T{l5tE!}4U!h*c;^<7gCB+t5E-7FpRgKBS
zt9#_t0j0kbU_(lzCjFMK-$b2-W?^!j+*CLmKOK#;q|RH>i6sY*zcomK&34*UvHXSS
zH0VWKsr@@*7O^=(QUZrpmrLsWXH<*PlJIzs)cI?)8m*?_j7VK>p%Dnz+mZ&U&qqA$
z;W@CYz*w
z?|8{Sk%~r+0{)`wP70_%VdU48!`}e&38-TDhm8hQq`t9~Nk2Jsu+*oF#yc7^Tye=s
zect8uU>pWQM7nkb3WSZuT`2YXSS&6+X|3D8Mj%11Wwcnym(X;?81a;m)c!rnipZ@a
zYQ-h>`UIKbxe$3_L>=ElR%D)oHeE@D6x4@dVnKq-DRuaTXU-p(?cY!@EDtAJ3VaE*
zYrD*-ICNJxR32RGZYPE6qL+qCNQa%>V+~
zYfsO@NN7}4Iq<(lwhH7Vw%N5>N7vr%~X&h9Wj{kb=%ocJx^B9wJb!)ax)xMC6l~L?ylsQv2|!
zV;PLp*D7YIdf8R;8pH^fyCPauN!p9*R!>U319)Ts8o@n4a?zrqVi-|lFZp3r(mf@M
zf!$nwrS=RQ;E{`CwZbGJyMqB^Y@)Oh!Oa?^c0ov#wW2gXa)*`LZK0O+{!|3hE*pjQ
zp~7NVl73)dY4yuXq;?$%8gW_*)Fu^#Guj2yDrl*+i~JVSLC~j(q{IZt?=e(1rVSb>
z`K?BpJ`}i9(7yJ20RznPOp@&2{l-(*dM9*;`0YZs`e3TD%_
z?|I`OAt?5n4P27#>0D5xbp%Yq9BKFRm|mh}9hh~rqws2nB%MLC`UE(+Op=~J)1Ik9
z_tfZ={NAD#^rDCfQd(OrwY%O}AI3y@d)0+y
z$#0uiO(HBLzdc^7EfBI_4GIp_fF#mJIf^0Jm)gBTtL|yG$>o>LJ?SHYzp10%k5Iq9
z4QDzXw@K}yarB1eBia2PFL~TCwEg^*^8qJaH^c7t(F2}(KZ2~
z0QjN^nkGTGbUuN!7*10um(C{%B#{LiQW@8ne+o*(6<|f+OQ;bd(zPE_V=*FG+$p`5
zU=-163SB9^`k_daNT3^~*E?vLu$)N3E|ac(ikeX?VSiLhJ-JS3+g3J
zQsBEh_9#jgoppN~#UlBey6Vbq+!cmnJbQG;7XrG3Lf@1h4Se&TmK}HUGjUF47
zg8B*&CFz;MBUQW^C!Cl-bby`hRji7=A
zjP7x0jlXcTq@Zv4>b6iWh`djEx;!78qdKX}QWTCFSJQxOLib&QXu1>B*o;!Z0D<{(
z1c~3H+0Uzb@7Z2-1+=tnc5&?G~d|5S_yCR)#Z{(gHk4-imf`zyVJwuCL1IPKx71Lhy<
zwhV)z?igH(yxdfqaC60)So4QtM-N$Y=z!bZ8pw)#zu$O!LgInOVc{3=vo&5d*X?e#
zLW=yumTw*inHREYWR#=$$dRlnx7+s;EAm5O{XTx+=Ay9!TyJ!2Dms4A?e?`(6nWh%
zh0Q@HzP#M6Q+Hsbu|Zj>`YK$!<%1`E1piMo%7P2$pc>5
zGdgZs0HE69#3=Im_dEWY{lKx4a}!gCM|Qtvy4!6yWr|!-GphI>$NEf`?kce^&$VBm
z_W6k8R4Ve)p|7qT-)-rAbH;x*z5LN1w(GgPZm*X$efMPDLqkmN4|@J_ZXR}+;nXYg
zr!)8c)%9HJqRI0%7u!~M`@-!uq6tMF5jr{d+=Zl9f76DwFce~v!v5O+_?qT|*
zXv@t_&)(gA(;W|99Iv}Jb5SSw0GOji#v{&Sy
z+}wMT?(Uptce}lj9`>@iY{B{3YjU=I`1SQ&d!PJ)=BHswMfS@Z`u4Jo_vG)nerwph
zY0FcQtK(Kh9=M{i-OCr>D43b)KXJ^)ZBJon8X{KYv)xyYsa!BUVqK83?Ya8gP`6vf
z*@`@`ceeBNwo{)T_-NMELkb-`aef%JEApi0cAvbq|6L=mx%vE&b6r2PQ6)O*E=BHo
z`rOmsKGgC42LiX`uAfr8#_hiJ6@nV|KivD+?P-JlGXDJP`Js=P+-|RXNRg*Mv-#2e
zLvNmY)_Qbj+~F=u4F%}cWrCJ=_3>S%$j!C=&LwYqVqReCHP>d0O?edX)=IdVFvzBy
zu+8(|+Yzv$V9JZ(L$b_nx6jK{k;}I>Z~pe>I^M>WQ$(=V=uQgJUE2MzwIbsPbAR4DHN$2NsNO$xzhV4>d{N|>C&RL`3-6pBpS@-FE!Rzb
z&sc=X9z}llzU>#M+;VHds`Pcke+gK>(9jQ)ONxAO&6oG=-YHeDzp1u5CS;Mz(1;+j
z6nV-C+xgl_VTJqWMl3kI`L6GP8Z~HZ1ezk(v~Rxpt0-sp=3CF+Wa_qLBoLWih{C?p
z(~T~`Nv9-Ll24IWeb#SK^6`!RKF-{`+BALhVZ#Unv51-OJofJGFXf-_KlGMsdr8|0
zfhe@bYio_bXQVUucPVNAeDlx8NzM{HX=^VUfTk4$)T%GZZy
z2Y+H1FugUX?+1OrD(S1pr#t=WpOy2k|LVxQciUcjwPJ-~ae+Co_0s$Hdv=dN7SdmFwoz(G*#iv0TA6;r?7y5;@x
zZ*=VMx@YG(!;!0ks6>%p`5@++Uw3>r?XFMv?>hSE#On;}4ccwcKt+DwDbvP>k5zs5
z%#m5W>mQhOt#^sU1Vy%0`Rxd6*m(BaJy$JH-P>GYm>$|ti9)4eb@wB
z=BD=kQ^4EyS;z8{&&A49}roU
zlDi1HO4PPCGo$)$(UB=9D{`%J`oPr2@4G*DDu3^`;aejNV-&otB8T4OI6venzri8q
zvG;!MeDY4ib|L2jBS7H#!ro)X{yCv_|D3GIS&?tf4QcmW^^aSll9ugFTW44?+<=O_
zEx>)N%NRfhChZI8Jn6ah`$t3)s>SQRMLBk1m>*
z{iO2A!C`m4u&C!Tz(0>=KvFURbj+uiCweDl#VLW@r3)_33A~4qUM{
zBR#id`lcK6`slQYUYi6t#0p^C+1;OvjkC*llrbnJa}f?pSQG|
z(|bYP_j!~7NuwhF?XiZpez+s
zeE#SgTV{=$b12R<;<2gu-yc9VU52X2<8$}b6~;dM`4i7>S^w+kG~zNefvY0d#{?(U
zB({I>(RcoQ@xx6c=;Z0*Sw;S_+um-yH+PCW)EKpBMYrd%xI&T(?xF05RP)%>Hxgc)
zGwHF%wr$2D2!SskpZ1
z7l$!wa%WH|r71mruDgHVu6_|URiB=D5J2-tsTKLY+3(MOsNedbCnEhPJ@ohkn7vV~
zjcwSifB5{j60gZVS~M~D>G?kbnQCHhl7xeon%*=tqW8s+X`7RpkD59-sQ`(eRRKB*
z$ilhjroNo8
zw;YGis1s1+KiqtJSpBj^LCIg;UGT}oLM)d-ivXVSiKbp*0h>!oo|tss-(MQA1ARi_
z09vv5ww{*$QzjK%xGQ>T)9$x1Ore#)c0KrZ`teV~=5?Mk;LLk7y1j%AperyG`FQV_
zhC9Al^_TMS8)J@kKRFSD)zlq|Ja}Z`LvQw6zTmzAZ}mUc_wTq!gknUI`|N-8yN~bf
zHb-(D>$-Dq8qmE*g@QBn=CyC`9x~}Q`5$LaOtxQGg3$<#3oe4CT|Q5ma8=`$$G&$Q
zOBnes`qLCNkTUH1N5g%Sx8#OxI=k+`((k$hiBYCUr313LzkK124TV*2_{YrO*!}m5
zamdvo*azuPt>5$DhMDpEmGw`Y`4RV;rY=(C!pUb|{$<$fg@5T#`0l|a$!h^uk8(+o
zyUmzU{6cE}(y>3=oP}3KXVZK%Wt1ZC@4jKps69LP|Gx0WW3FW@A^kw*T2(Wp$b2^LrU|usPF(-|$+u`&LJy|MKNtLAOWv-@
zUz~jEZ+E=7d*J|rFc2X~RrBnAA8${%dh&t4{`kA{^DiV5EDVaf++0QeW6q&{CELDS
zwqW*%XHGR#XD#@8{T&xR+5_1Q
zt0^^&B=$qU2lI}-`NoA;kCd(apQaW6R10W&Ok6+9tf`-Dzc@6ekLyh5kI%n`4MU1f
zvIWAbE?n#H`1FA%UC(d5bN$xYIUp=Wrm84a8TRG0HBNa=#IeH|hEZ{>$bWkK;)LsV
zZ8^LwJ2c{%>cA4rGR;LA8015t>;BK&D~HCkUu(V&6gX?JHCf0P!z%YrKPQD2
z$28m;k$UYf03qt?@?S8lO?TaRVuIGyqP&HPg*4^g(RR99qqNqkXg_V9VPbWTd?)qljR
zn0FdE3@P$^O#$ajeO7hvTh{Z?-W%S&$xg;$eqpNzl6{yT{v#7H`kOa4XSAQ+fO0Yl
j^9u-{Muu$=Zyq7jFh9Q@+fd|c+W+xGh76e~Ck+07QYc;p

literal 0
HcmV?d00001

diff --git a/boot/ocamllex b/boot/ocamllex
new file mode 100755
index 0000000000000000000000000000000000000000..930676103aab5d3ff3010901d7d3041663c4f372
GIT binary patch
literal 340174
zcmdSi37q9cc`tlq2I$F<7zrRmh3TGQb`VBDL50Q{LEMev0*1vNWk3XpOB6*^MkLXj
zg={7>%gyGS?PhzkXx3};X1UoDH4A2u`}>}$XHt~sboanuOnv-W^;A9e
z>{b8&In&)d=ZGVY`0$bWzqIEC4?5z(M|^hr&j}tLoEDrBJUUnmE)6~}xFWbVcx7;F
za7XZ^!8?MbU~BN8K-(RBMzAZG4=xNeJWcgf9{X3~v416=HLKuRy9%D8R>5=hDtL|=
zc=m)|ABdB_;$*xS%msYphxWu^7XPtXyC_%}^n0e|Ku%VQ9X%`Y(76)NXRdIXi>bY#2#aA`G5+5C_$wk%nO7g0{@lCJqlaKh^to5~hLFlIhR|T&K
z-Wq&;@O{CL1wR}7M(~Hh-v<%6rh3md*gXtjchvl`dG~#y8AtcdOz{g{<@zI
zb${IpwSQJT)H6M60&Nzb_qU#JH8FTd+fzAN&7R|iJ+tibF4^02sPQ?z?XUQ(#P}&FG?<*@RmTsw-nSKYh|nc>VN~z_5MJ^BUe68XlneX
zz&SR)F<>*eM>YlYxI?th5B@!%Qyj}SV<6|sU@in6&z$?ivu+h~j_Y`$ZertSwz+hZ
z#_o>?E7|QiUUu7PAIECna&r%w!uOtRsJ*k|@Yz#zuAd^Sx4-Q8*Hy^xeVS#%=S;ET
zv!>YaFRRe^kSVf`T|t&Q_AWLbXySfLx2M*3Xa2N6UAY&~&kvk6&)U6#&(W6#wTDdO
zhXu9Q8L)R>P@g}X6X#j&?+Dfe|L2~2?qL^s@@Q_1;hxOdN1h(-{Gs*dww|1Y08fpr
zqaV|He&JaRG&<|uf!umV<68>R-NH}h!o;`oI@)!=IP{BgI(olVZa2jW)WQ?TLM
zfKBw(xyMudr8iR(9`^F@Q1|i0Ub;62YXYtOoV8|tZ75wsf-8oqs
z$kD$Bmj~tdzBZQIs&iv-#!hbIzQ*OBth)na&j9a4o-3XyWa_U8)Hzurk7v!6U|pcG
zM~=&e2W4D!cw`8A_6M5tYMp)d8#`C#+2#4HZpe3*`sd%Bp*4E6+kzbVduks$YmOhz
zs$5?kc(yJDWf#Thij{Xfwy@*IpybqJ)G1LOgZ`c(wiUUC$n8tJdV=U0LH_>08K{EicVxHsa~?MP}J5FQ*1`!BGJjYC??Y
z*$|YEvt*Jlwr>qIaWz-8nm|`9)noa7YsTt>zvl$@((BG-k9}fPkmF4Oo7h}_9Znng
zznl$MXI(PHwqhf0=LXJ~y=r<~tC-eW*)Dc+qHg$qRd9PI#CuJ8zFTt_o`5l}bdUGO
zzh~|8z}cdoUEYgr8+n(zW5PbsPoBmW{PdDlwi_=6atmy~Ad~p`ReXn)8w0lUoxR?h+53h-%#R7&iRRsVcs&~`PUgsYQT$=cTZ1zL`?NcP
z^8>!f8y;Ic_*=&v7{n}-r*=S8%dpVx_MK5(@ypITaIdq_{oieP^
zAvb%2S@KTJ8r!NSGMw0bRC+Qu1hp4E-_aQ!eCFcU?hNh;>iN2m@hHFKZOhvBAfcMH
z%C(r)xbl8un^Qm5_jSGJ+%>^@0a?yk@wmI^f?CgTBD>yI*nMq~GP*|`Ulo*n86Nac
zU1|N=%R0LEg$<|Uz3OK%@Vr2)JH7nr>C&@DuRipeey;Um
zhZZlr{OIY|i)(Mo4-U3{<3NAuK))sQb&+vHkl{V(U#0#$Dfyd;1=($pIzPZhv(aqgD?7L~8Uo_B98tAh__i@@9y0`riq1oYFl^u8g
z+krW8tJsO(mnU}Vj==wz0KfC_zrx?^_`$aSk&VaRugzTV|7SOz6FQ!w+MM?)Iy}cq
z$H)KmfKBd7Yo1}X_BX?t=NO*KhqLScwbwqIX->I
zl(~1cxf7d=sz-6UtF5t}e9ya*f5))KEt$bLf#-{af5eD>=gB`loe$ujkE;|5=0FSGW1+wtbhi{&}rGd+5vm>L1(Idw<2}qBg&~^-pa5C9S`-
z^-pPi+5L=0vy+@>w|=ziWo`bZ*5BOvSG4|Bt@rLg&MmEfed})<`ZqUvf9vmP{hh7<
z;?}>t^t^exQe^u+hruARf`ggYeU9JD7*1xCq-_rVTZT+{m{ySU$-L3!L
z)_;HNf3WrMZT%0o{(Y_g(XMwEy-#bN1J4iCv9sXa{gJsiwx!=5xKoz`cf@?~8G%}H
zhiK~5nmn6xH|`1+0`rT3=8kv%$@Sq!bwI~SDC#phj>T=T27&GS&3Wt*Ik`JiBo&0^*>
zx+({J5HohOXI*e8_SmcS_UsEyF7Q>%^p6TQ1#5#@ey_WpY2*Nmmcpk>|m3;)EOaz
zyd#6M9gns%For+P=MX&f*(=_~Z=M{nm=EYvGt=U0%{=gty=0E{OJ@1m>nWSEe8eBc
zrZws5Ey#m7^?TS)$6}z7YhUqLKOq=-$}jwQb_7~pzwY&p^mn1xWxm$`|3>$=ejuM`
zdir+<`Xd8KG#pnJ;
zi;a7IeV~~q)4hI1;9fr|0qWyfF;{mB!M@^~}
z+g#-l?V02>Ul=&$xd>xBrx^*ZHLnM%%=Oe_|q@Bb})uZVw(B@Wnd&
z@vGaSGd$>H)j;o~J({`2Pcs`g#3pep8{gV!@zD7H!hpY;_aT0G?-Pe>gL8sM2BVw}
znRC`Oa<>Fm1o+PkdVX@%z53IT;J@UP@ZtCyzfP^of6@B}
z`mqE3Sp)qqxo7+Re>Tv+7g`+2r}vlIdWMtusSS64`e45vzg|4`c-)uPHD}t`eR*ym
z=id=%<=?FFwk&K9*aBjHW$;IVz2Y>Dr@w2%axXo1h8BNu(CXb_r5xbx?Nwilx^hKk~_~{m#du1Ad(wuuBcRsg0c*F?Y{dKQAcT&2J98?~rqT
zP;wrd@iaL-|Kq|#rqAH&Wk;Zm|0dwySodXKP57pH(tqdxeZ(KO`A;0^|2@U$tn_Dz
zO=OGRcSn|c%=4l@XXc9MZQ<$n&o$mUyX3qqJaslpzVq_D%=f-LZJ;j>UFVrTx!5)E
zjNj9HPv~WS&OonkbVPlU@4fA%x0m(t;g0%fXnb`K8N>0dSI=lQsCS<9&WnCSa6#Zb
zPjf%1cXeal{q)R0bJzb{P_*5ezvpe1p%Ab%GcY%TzW1KT|U-%
zayO9GpY>i|mL@-^V2-@kM&7{H&s*wVTm|4I7F)0;!P2gPAAxH}L(cYmF&V>1?;HG$7+_!k4~
z>d{(KbHq7W6GyG$>I_<|`997Y8-K<9b3@O%`{-ha9*_P|?+ItgzW%;IFSPkht@oTT
zzqR%50QAn*pV9g=TfeLIXSZH_@H<<2&nErjTJJ7GFSh;(t-qx8m$v>%t$$YQ-Cg#5
zUhALH`dasXZT{s8~o}gl*
zx0hVwy0_U`F)usVST-AjxICnd$rZ2Nfqa&|=IEwpAsB6x*U}*trNbEL@N6@tgWO(+
zcrOI>7(?Y_R$S!0bgs#`boPGHgP!G=H9T~PRWFmRCDRxxR>sTuL9Tc~@5h$V>SmhV
zy$<_E9byg@pM{JoCncBOs<+;D^K8d&+{eRQpWlt4=`k-Rp8sr_C0G3LlkXnYj8C16
z4(PJJJHSgf*=TyL9T$j8`Gn8hx?ooR)u(n@ur{ces>O4HCj@mCGMs$ImftZhz5OR)
zOk=|d=N{b%gM
z5rad?L+Soh_%8qM#N}#SJk?0$U9RQ98Cxml_1UsNQ|hnR+t>R2(KV~idR^0MoX+y6
z*T0Z?=W#L6if1LCXXU!LqjKzw9d7;Z`e}78&+~z21HBrb>YR_y#?_qdX?Ldl_PW%u
z)}P^7I#-JAta>VabdUb2(>|}8L#yFlSIEh}diL%KUH9X7UsjyNa$K{=9l022BfU78
zJrMV~jL!+46v%^|_4jAUN&S(*Cv~M6*ZXE~C%e$jYSo(hb#4~|>wP^hhSun2i&pOe
z6&rbCU}v)0VTho_*?rgzM8Q;8ej30&upY${qbXOK-bzp
zvsX;74e~YHAD+d?Ow_6M4MrPCg3cLv&M
zpY_sVJle;e#Xw`nG@jC{Zt2<=$ls1Y^IfXiJ0qA2HU{qc(*l06m7e)P?E8G|3C-8t
zt*4`6AQua5elfkqMm~~hO#TVM&VX(3|HU5t4Z%NTK)0NV+vq=A)S5QhLjQcgzQsVJ
zlbq5oUZp$3BYb~Mw>{;5>BOtC$2#2?1e&pPto3%V4PAFe?RCG1jd<=4G&03sZtyJz
zn)}Xv{%i@#-#aqa@J`!zT;|Cd_ZF}D#XzH@_@(z
zCB|CS#_buawNC`r)Q59&c4Jg)XSK1~sx$ew8EgIApB|X{q?+8Fd3n{#EqFGMHL2d{
zR&&$V>p9=olJCx)X{~CMjY|QYi-9)oQI~l7`JTVtP00VYKr8vr&UiUHOMfq$Pm6&@
zW}W4dX?;1H$Ngu7e{C=;R%Ju)Q*RF&>b+w*8$1ga18v+dkIUKI@2z-NPye$5aa4=b
z@?AdkzK=GnCXUPPuQ-ysoDIF+KBmjXvES3jV%%SG?D>11es9HZ?Cm9IG0?UKXnaQo
z?DWoF`_PXKG-up1S?ka9SqG-3o@cUQTFmO4%IjjF(KqXy_W2q2)H&_vd;apr+~~jO
zQLSe^FW?un<@i3o>`NUW}Jp-kjE<_w_?&-618@`f@gp`_Bk}-Nnn<(EHTe!-l$xm$RY22gd#CbUB;*y%o>u>F@92
z<$UOUA8lAo9GBZ)aU^#+8+yHcOqYvezo(DIxWD4q^Y=Xc-iqJY+dJMxXnaQo?0g{Z
z;%PCfbK2jZ^w(Wn^;YMk&(FALF8kD2Ki~6L9L$aW--(CW^5tx8
z3>E`zYamDCJ&bQ>;9i!ecjX6at3WNOpqA4q@iJfQZ|(qD1XDo3|xEazVySlb_{
ztse5IWXnifY
zZ=M;DHBC>+>i73@M_GP`nC_mx=jr#-?VeakcfY5X)$1V3d)-Pg>G$_?M_Ksz(ew8_
z{a$CR=iA!o{+Z(J)g8>%GXhP$?3j%1T`!xuIkMFPoq9Bkd9UY0ZzsORK%>_gU&*h2
z4`1%f^Fe(s1Z?W-n{4q~Zhc?Y`QZ6*f8NzU)n~Mx@pr~@UXnUt<87yhx;9le0Q-s)!3b-_I3wy
z#>V*o51QRFXB%$fHKcR?jtF%vjqR@Vnl>=+*Fv3!1&Zl9=e_1=zGD
z@D5vhtpguUY~#^S`|3S(yt~={kf8UMZ{-jB*;79B=Xmsk9op!}2jd5S`B1UthxhSm
zez1qEX?}<)`@Bo(=~`%X+3eZIWT-@1S`6sKlzhdqD
zkYT-_3%O#fe}9Eoms~Nen3HSl9@50$desD4Jd0-Yae;WM7i;3S5G)2-#T>78Ss>nG
zxixT?o)bJd@Lluifu=sj`@{UsfbHc*_Rj~4fi~uaPkifTd{DmPg^;x}4u#FzZNAnANcybfAA{
zp#Nc@KRdsO+S{{zpf4Kes|NaY1AW&(e`n~qI=$Zcjjicxt$JtD
ze8G1}#v59{(0ccYdCyC|xa-AJ&sM$XtbV@rwXb?PwBF|k?cUbAYxL)}UYyXrhtYf1
z>Mv@&I~;v+>z~y6OIrVw)_Ydr^Eq8#c__V?wfX0@{_@t>{PP=q)zG`|$h)rfdk6Yu
zjlQY%H@E&3t$$VP&u{(XTJLAE{W~Q8HTNl>#pPLn`}V>lRUG9&je~nx&Wy#z`^ug`
zEm%7~cu?TIvF6nP^tFQi{NV23#s<$dvUdgYNG3gMspnN2o(-C@=R(=JHe+DRVjHuw
zx5wJ)0Xx~m&hkTi*Vcfonz8*AAF(1w-rf+1g>~mbOzgWNz=wywpBJbXykc8AjEnEK
zj7zS4Wjh|eETio)r16PS>6^y)q*d}=x=Ow$uaa-IdT04j@5=5F
z&kjBRgIuvJI!8q2YcnV?CR~Eb+`0!
zm}c+&mCOIz0)I2dyTe66Kj#?<_0IF^j9(L!57T1X@BdWG^z3k#uf|Sy#shfBYpYrjGhvBcj)z9ANu71+fNU?TP_6hFpaUO|TR=XW9)1x&wWTD4n&=7kb6e
z+KxaR-rw@WPI+RBHS)i%<@1b;*)AsTv$7k%F)}Q%%@sXA06t_87dxr
zX;qi_%18ET>iX88_s!?|vMa-hZ{+gLXa73a;^eFy*Y)cf%@;Op29s;AZ3C;k}me?DLr`#&!b_nI?yH)-~b
zHXIK7ocZ2Hw)MLB;SOOVd+NNn8_>4~&ZB4M3j;p7E6W$-g#fR5;twAC>sjf$!-~l*
z8I$L4OS)s-QPwne@p)FP50@|O8GZ47AuosOhrg9M%MbGx23p0p>Sk7)FAs0oCZ6KV
zZ_k1a!Hz()|9?lfwYLT52mI1XwzanhYFa&4tmT`Wp5ESQxwEcbHG0`x`)l2MqWwjy
z^`5q_+3!B~+|bk_*=TyyiFQXY7tnKUpbo5~U);v(WN%P<$k`p-7#Lp~uxF*(^Y>Q!
zoY_-(VJn&SY^UEk|4s|m1R5TD*jTxxpIo+-yvhZe`t$U`(3NMk*XMa-Xm)6~2l&1j
zktR-Lz9gXgdjd_IHv|=De9q-p1^D{?>dG@r^PH$UW5X=qIW;)5E-W@f!N`BQ84nb>n&}4H8Nf~Lx%a)+M!ma*|Bs8GQMDj46)OkyBh*N`L_gd(TmH`
z!5f2$i+Yypn*)2qmyIj!D;;`uWk0(PRR-NF?Q`CoJ^4C0SWT?MHZ{)9fyQpn4zbaT
z4L#yg{hEy5*yhZybgp*}=Q>+H=~;Jo=A73HEvAvlFXvpov^NIyLEQ(h%h;JI``PWB
z%lX5D`M`6{-%wskZ*QIbm2_pxC9c6;Ey7sJY(n3CDkY|-$mr;*>;DE_64>1X5KZoDny
z?QK5Y!F!e;b?4TZaE|JZwqEzN-ub#F@NA@mFU50Q#&bcfXE?Eiy}f?>)C8Ng(oc>&
zl1Z2P77JrB-WZf!a=9rWo6d^6_>8*9th%VYY|R|ra{{0F_;Y%ooffPKdO70S$Es>{
zU7No(y*d^H=Yfw^clH@Cw0V2%$8&tZ4&z$_GJHo`d1UW>u|u9lJH&N9plc-?{EhQz
zHn0cY8ffxDUeW5=x|qw=iCJ`R#Gqm%7UElb)SW%-v&UUy4?cU;iX6+;<-wRM^>07^
z9@m6EFOciL2Ju4aU&)8E=WzLOMRXsE4|qo(#IKJ#ztvIsB&O)f!{|dFQ*|=hBVKgK
zN#W{@UmmbU{HiYL0r7##p?AN9pn5i0bI0v#aK62BX?##~&i%^*w%7T{a583-dxJi5
z@UWGXcDlh%o_hwD}@Us1zLyKY2UpvUUap1plSU-JOAOE}aKhl0C
zv}}9JKtFS!{deGddyg9Ezst`nvVUi@pAT;ueopY)LT7rCCwGD8F8yNmf$Z<)f73v}
zrpdRj?vmrX{qtG31{JgSxBvEb`M7_epB8$3$A3|1`K|ruh9=K*y5>>%V_72N@3v
z&5w#hhDZEB^SfmH^^~8f{P}_BgW*wMwdcK|d)w}sBICCQ8Ltn|`cB5@PucV5!=6iq
zJzGPIK`-ZT@*joiWAKNeE0^;AeWCkYz9%#pCw8`cRh#Q$`$cW8@=DgNZSI6_@6DO(
zh16IkF&juFCOTZ5A<^f`thOrd~6!%^#lJ$^1-Ip_o0FQ
z@qzy4fqv^izjUCVG0=}1=!XvUzb5a!J%2OM9}ex#7QeXwuXhJ$uiy8-!iPsaRNt?^
zzpdAq9rwEv?6XI&&h%=(m-7{kuWa%i0X}`t_r}I|N?X_W>o>LajcvX9&5hpH_5Hr*
zw|%D%@-A)jXSRL2T7UMycV754r7
zOIrWrp?_MVpVj)3_q;}bUhBO#(c}GF?>$5B`K7;p2K~x5|LWG?-1=9v{+8CizV&Zt
z{To|Bls_Zr~mLL2W+
zukOU~GXiVwBKMHGt$8&F?mV%OSG4E4&u}-U2k%T|?+UgAWYX#0=y}~!&X#7pCMY{&
z^5or&EsJf;&fXqt>XMyoVyAOdI?7(Tv+tTfT#gBPTkK^we!P5RbMa?5nVTDWJmi+X
z+E;Nv+anH}0=|A$z~0(}hS5gx+8VG`Gq%6tBUa?dn_3bJ>yHk^#6C5Q4-bF8GI(u(
zSA0u{aq-oAqdiczU1N-cy
zoA1R(cU~bU&p5uTU-p*Yqt4#vUe2hG4ElPXd;XR5+6(I2openIwzEg`ndYiM?&pJ9
zpJR$|XLwEvYJYvssr4Ph`olt#Tk8vr9`%fT_Dr*9+i3j(ol
zUhDZ$Fr-r({;jMfAt!+mRCf4}0#N3M2PP&Oybleq6o&ptZbHSVzD;g?qRim!ZR
zpQdJR4czJF+cg=NT^UY%BbRUL<s6h#dEkyl)ERSZ*qo_q85h92xgVZ{=`bA
zwlxqZJZj0az?o4?f0!aMetYoPz`dba`m(q`Mr-OX^+@~)I#HHR%>K!vv
zlh~0*PQ~uw8Po4sMz&UYt@AnZl4(vG{c(r&{;*w>H@Y=)^L4<%T*+-8Z_o5GzTWS}
ziVX30KD1f+QG>I-ZvJ4%FmjNSF=y;Ew_(NeJ(53>d5@9
zft-k^_aFB0S-o2~Cf~e0_8T7`h`I4C0U4|PH%gx!XW1bRqaAWKAJDau4YU4@(q2$g
zVyspDk$GxBw|d~SxVlTk#kzhjFeiT-1N+s8+TIY@TlrIK&dIfbnh>jP!S7*F7SaoLDf~&l-guxZ&S!m;v;juchFMx%X$TWXfHQ*Jq5zr+q{C+~Yfgvipbf
zy>`)fekZh^UNxY%pU>B4e=qNe1AS`f+M`!jW#ebGHMU#p?f=K&-yD89G&}LBOFfhw
z@67tNHSu|Clhyn5*UcyU`F-XTo;CTK30a!x!1KA`VQcNVJO2(*v9SKZ&|=Z+`J6$<
zPljiGC*$2y_G}#XylvQXLukJCa?Z+}_>^s%LOaVve=IWX*%0W}t~K%bqqa7mu{GzV
z)_$$6;kUM_Tl?%
zW@_KV+Zujr=4)+zTPuD!`$X!X=QH<_Hg|g4Ywk}n#~)43)v!F7RW#@7ezW}`X;u?6?y1qr+yyJs}dn)d|eoUB4@O3n%|>NK8Q`}
zbZ*#Gv^b$x6Z@BiZ?xg)%+Wz^k846-7{%=IPO>A=elO1)zIb<|+dTW;mwB{YnPZcm
z>nnDY*;usC7}nXNHs^!>
zd|eh={M1wJkqdjov)_YnJUe8~stbPJ64V(clZ+nMgcc`$sg?4J56=9{19bpw*%(->
z_+Fjy7?aw2bJmvId)<`1VoUEAOxbI#mlgTgpP7Lsq|JWE@btncJf7E-HCUF?$JO5&%
zIS&;>^40Gs|FxO3CZ^M5nHPsw2V)$3e(P;5Sz^jQF)+6O3xj^YXW)2l>>&@|jRD;Y
z0pHP8m$j~btuF=|eSGizSd7rhMb$bUD0$9=IO8L;_}Ei6IqUo@9T`skmf-W-9KIbU
z)AHjb_j-@@duHo0U+W(p=-(XZ9}B%N{5J&u*!q8J{Xe((_QL0Fw`4r0i>{x2%hW;t>htAX=ERGBJw1Bz^u=ck-YG5!*r$n)vG{6Y)5m&iZ0YG!
z2Kt17UN_M9qBqn&TG8oIcR#X+9=
z{NO;tqrUVf2Y4z@z0Q)YUoM{3-E;brTJIi2yR-DCw0=YD7h1om^_yG2we{Ouzq9pc
zwtiRZ&rZ)L?=hM@8lM-uCU7s`oq%miPnJ3ccdxh`%eAri-4>W5pDkjkvB%w|c}Czj
zhqspT8vzc{*`R;H?wEiVlP{qKkrLbzvlT~aK6NUQ|rb2#esd^Z{>^qHw9|(
z)JBtIUd+wk*v9tPGpXj)(T0E?`^C5@WMd7*;}@$CwxGk`I2#A#u{1f4|b8E?GEtQe!iQt
zmkzvF1yv(&%s6Si$C)eMH)Je-blX$&_Lkf_Z*R$*R(0C*Pt)m)xTo;3zj!?FYW|jt
z#isu4Y-`5stGLRM*s@O^7lN|mjEu?V-zmXSLGN$rvsOOWdA0|C@t{FopRX?Q?;LzKW%B
z*+p*IMc0l%o_-^GDlX>4`1s6~tz@vTY?H5_%Y#DyjJ77uuMeCP_G3NqjZ$BNyBiDQY
zYv%bOKYXg#)>$P_KAb_kXt66_#NFDRfyO4S=dll6H7`fxnBNs_3FtRJ@@~x>zss&Z
z=Va0?cI+sd$Uv9A3@0^8*XBU%dU-Di&7RwWl*v7P4sXev8eoHXx{v3AbAs0f=LYmI
z2HF+Dk-@Au-GM2s-gWvoshK`b_$sc>V9D+MFt;!0_lcQUS{r57TJQf0!Z#OGO_8+_
zTpr*jhmX4hapfD|#f4pRvM0cUpB!^{1*L}!de#N@sI@xl8#69l?4G5|eCbkW730b?
z-DOX&yJ|)()P{Qt<(;l<(D(Xg`E^J5w2F24H0mlH^pjoda;%OP
z1MP~S>I5I~1J8~C|ChA;TmE2YfX~`*=I%~6c@OLNyeND4pjL`s9R9ZP7q2
zy#E|tchfV1mj>)Af87(t**f)SWKYc63j=l@7uZ{O6uaET=ADU+0Y2lBIqjXvzws}H
zr{1$NJjj22#`cpf_TI5h3uf7%KIz9_c8RSy{Z&ET=XlHBxr`SA@zS$}?W?i>52o0E
zUG`S3_}soXsJN6}WvjDVbN1mA*U{E-zHHnYUNQ2$gMD?6sZnvY&JXQj0bTa0m7bT4
zJ+GYEw<{2HHMK3+9#m}95c{Xq@b9;{u*rUR=t?#^yZC!M+57Zhf1vT}aNGL3Q*4#D
zmEu`BhJR#fNCMLbT
z-NS0&s-WJ3*d|{1
z-Q}AD_k(pY5qphX{%Pd8&w9DyL$-X#&qo6~cLrtK2b1SDp|1;tDfc)
zAL#4zR%a%moctS;^|}K*11l!SWz4>kk8hlFR!hgB=CbN{%%$_YE!ZC1*Sclvd~hf=
z>wYNT`o#Xn6FgxACbln`#n2P3re0`7SCM9+P;9VqmI(A?(mlG
z3_nR9`SpynPn#y!TG?)FPk;Z|!(X|XcK6ovh<^_b*!I!D9<}qVKu**R8OGC|k@Y+p
z?^S-3efDYgRvtiH@50^P)Zd_R!v$`ngxPIeW-_&amf^1HEpbKbY^SdU-!E(64Cm|pl@#U&Sr1ABYr-=Jf<%n&K>srZGNV{xAA`t^mh*Qtpk10KtE`p
zf35x8eZ~FVp`8)=dUJ4Y>lf4C9mql1`bYVDMmL0ZR?NFU)Qfdz&)*Unb9UzNw|v%x
zw$HP^aR
zyFGYLuszV|aId((-W0Ia8DSe9V-QO`e-z-6w`n}D?bff&I7eynb7HS*^JHoDjC7Z2
zrPugn9lezCb%FXJtB;4jk=w6*VR+=W?%SUC4~D(JKG6T~K>NKd`?b2~X4R2(c~NWn
z;xm>9Hfi!;EDvu9=DL!vklgX!_aJ
z$EEj;T(Rl(_2Utt5B7gap#RdK-|u(p<@usu
zE)cuhgAKt+frefTtn=l|0U$sj8(vReJkaNd?rqr-ntXcrRC*rT_{=+#diAM)NPti6dynen
z{Y-mLT9Y;RMBSTgvbXw@$@h}k_s6&S6I(C-*2jJB8T0NU{f6LzfQ_0M8J`#26^Qo-
zf^EU}Kn{Rhs5`~^`^7+PjDI^&r*hEmJt4Gxc>XeYZg9Bo=MOdc?55|p0y@h!c9sq7
zd?4;;a{K!keYo%EpNY(h@pwP~de-WWI-K|OS46Iu{#?_o7Bs$^XH(t5d)^V+J@&P&
z|GMTYAx
zth=pWb9OX$+s@8b{*XD|ZQq!=s;x7^P<-y7Z|c@oy4&W5z3=Y!R?X5+?t8kmlZSoZ
zoHcjSx3vDhr|<8P)!c25$)1Y>v2a)27UX)Eyia~>#%fsY(&N3g{AXvc%XeF3_4nY$
z@YFqM-;Tgp{HpLyy9e*gd@u8cfxbF)-KP;f`8_mp$9wScjnBMurLXrjV|IAQ`?uj8
z?=K$Udr*D$Hr3sHN}J!%`i1ltv~jx0yPkdC^}aoDAAUH2RG<8RT5wcQ^iwm|E(xsD
ztG^|9Za~(FfmmJ~SbJjNKH3v_cikPZL7cS87ascTp%49(z*&%6ZI<5S4=f+lYcKtB
zM6cSDSM+N1Pt$3R42>Op9Ou|h?>JxasQGQ-*&dJw_K_(jH#VBx&dB2f`@~?}_twm5
zX&U)_>#L`{j{J8sW4b+V9
z&&Zp`Tj$yL6!tmm_P#!_*LNJJ1}6o_1jWy1cGMoRGAEw&81tv+XP>pIJL?;QqXK?D
zA$W9fQGnOk?`^(5^vi>)GwT&MG2}z9ueYy{2S2>GeMeBT)Z=`hRbKhRcQr#6x|h%X
z-hcM+n=L)xcvtp*hjn82lheBs)W_PO_T!aP_YWV8pBiY!_{2}%(CP!NK8hw!D}MFV
z^P@HE<&W`G0iAb-``Wx*-I3j^`w_m!>Zhy7Jo;>j-Z*n;=L
z!Bqj>bw83rH+{y(2V!J=OF-wJ#18)2L#CXO;lAqYw69OLRE({qlt)kVlSR31?
zmjk^R>(#El_>AGC)_adYduHjKEB!+2=UczA_1n`sBhIDfjJWH4hWqZoGieKl(mWHM
zon$#La<&xIIK#<1j5Bvy(6&tG=yXm;-f^Bh_OEt6tP}paGj8f=aVwhcD+6&JZCGiq
zJ7wG}R`$`s-dXbBk~IzAYWI*=ve{pEzWLr3wX+;=Zxj9MhaZnh;@r3Hy9_7sSd(79
z=*o34`MVc#h=<)f1HABySubDM0C>r$`?Gkh^}e9@1ngjsT+lmhpZCa90ybP7JRw5)
z@x0*Z2J0IFa?T819Go0jw{}!8-^S+37P38C=7Qq4#=cr}Mz!mLUBTvn48C6xs8wf-
zeBN;#2s-TWwWQ})WI`0otJ6xYjB@9sms
zs6RaASB?2mV{xsq{WTV!8oTFf%!WGS=AIUir#96_&5>nJJm}ZgTGfzVoYmEF0oe&hDqqojRU@?@uecUXmO3n&-{QJE80*nqymH45_Ik$Q
zXD8ct1bAMNoX8nlE^TvnrRTeS_M959-yB_H#@2m}rbpe~9*Dt)z8^W_U=+|qm^10j^StI|n
zxeLN4=9;tN9Ek4~IR|R5=-r{^5v@Hg^o0k8lYQz>-0OX{c-77L-%_*qS*C~zm+_L_NM(fe$?Z=0<4^1wbUi5|l%`P;%(ELEN8(sCqPjuCf
zIH28k_)iPmmBwOb%^0>cT8zdq1Pwe*5e{rqT4VLwxy1-gDVWy)PhNFGg(8*f1+b;>nk3F(RvguY46V_Rj?xJLHlt)AF#A4!)G^(zhBN
zeA2{SKE?ehfoA-K$>>0hS)b;kSYI5l(Ykuu6R0`e}Cm5yGXn!yLw$*X=>#^m<$M*Vo{toV^rc01o{Vsp^fr1M{M8BTl?7mfew
zl)py>8apcAYDc{AYz_GL=-~8#jw=GqesR;6DfhiiiC0(&kBG`6T|?T!Q8V|QD(&%I_{eDL>k6;m}Xf1~cwG3qXx^-fOM5gYV?4
z+oJ-lr~7-!TAwG+6-}Pbnv4#tiwk{w0`U_c^cX+ue6IMB!(I(PIczZ}2W7we$ND&5
z_isI8Yd`+lJ1r-b=cVw8!`filSgbrB#BX0v&+qw+OSip!%o@pYD-=|MTvum+z>hG`eb1r-NNw$0}
z1Zt36pQE(iPit~l^@WcN^2ksdbqA<3Ip>eqlumKp+veqBIY0X|S3c8of6g5HG`7{5
z8P66S;#PjD9sbC@+|<6Fhg>rIxjHBIsoVapsd!9_fw-2Pbcvrluxoc92Xw(jfrf{@
z>{P$>t)`Z?hfkw((`0nOziB$z!WXu%k1cG#JD%s;GpF%St2#J3V|&F^z3~N#E+5F<
z8`xJe*mzWMZIEMgPpvH%OEF`gz20RsW4mlgZ1*!m=AchI}UUQ|Gj8mXkZKUpQ}gNaz0Boy}cacm1LFuo15IN>CN@A
z-W%FHfBSQ+_V`@yWz*t2-X-?1e?D-=dSCcfdaac%+%^V$L90PI
zueB{1yQ9eF+nS*Ckze{wZsTeC=qg{tq4HZk(OES?PtA)pU+Fz6sQBW!KQ?&3pJs!3
zwXvKH)8gL8;q>gE756d674!M*;j^<5
z{MH@Lrj>j;KRm1TiM%}lUAqJN-4%Rf?{NY9%FmIXZEAt-blOvQA({5uLngmA28)5F
zPQ=tceB#ve+26}s46W5ZpDW+nXffB=VvnY_%P&12_|=bZ3r+ux0l8~}im&-;b<0+3
z)6NcG`}4Ta=*9FJ8|s{(>16vfJ@@4^@qR+n)EBwrJ0sd12fE1``#n$a@VV{}w#^0J
zU7QUydPPw7;RkW{-L|nf@L3(HpWT5NlQ|#YB}X%dR~)tka!!W%vZ3ZPbucHTpWQ&F
z_j}`Md7z&yqkePr*BRq0{pS1Je7g95VeHc6QJy~4aj3H(My1;r?n@2WH?0OT{VAyd
z`lr6&w=X`Vwh=RS4^I>+uDtz^|*KRb}@mHf~HSaTc+30zzx#!9BoFR+NdZ0t@
z+~M;9zQsUe6C0<+R_(Eso*ivG?RmoH(nBv@VsU$*op7K#_>7fnb*w(buby}I)V#He
z0*&m|@bQIgb{nq=>R#ptJ9Y-f@N@Z`$#3=-HfAjTrv>WLx_DI#YmE-_tW~~7eOWpf
zm(3ZI*W1&tSA0JboBX@V8NpoOc`rYjJlr@L-TS?i4c6Gouf7Iq&HK!(wTqTnV{h$~
zA9}=!ZE9Iub_Z;JR^Z)0{(Yy&ZgFG-8FK1us9Cb))L!e(+I&E^c#?s?#?D)f@mI{r
zlMCzQvWx7Jr*>-JG}-b(PsvzmFMj&*Pvf=D28|6>N8Sgw2I4TS2FQF{poZKX_?{Q2
z8L%#&mV8))}}dL{+&l`iqKvN6W&k6pY;M{;+i-C4U;2!Mn)k~w3eQc|HA;Zb}Hpe$MlYL|`>pbw4
zKbkRH#n5?{TX|t`jh#35rDp*B?4+a4MNgMb`nB5+bQ7EHrK|2R^6Q>s`yGLHVqky2
z7j56#z&`#?+gr~m>rl2kcVw8Wd#h}*wmB$&_GL`AIdLhU*k3+aXER>+%Cwj-Wxnhz
z-kxR$9emQ{!q`6Y=-S(jdpj~ckD?Oa0u>o;F9$`EC5f^kiET@7+P=
zdOl+@Q!~bI2<$bdUOj6oM;kM?59Caq@Ug)j-#-{n)8|aHx%z1`=>oFpDjj&;ML!(4
zTTTzO(}Hz@wf_-}Ye#2JZB(4tT5%HFwE?>y*T(F2?}<~rr?9zVBZf7uIGL*)hztMN
zRQ>1+8?=g-F}>#LB}0DL0n_3{cIm2IOpDk1!Z*gG;`RP1YvQGmS^o7g6if9gZko87
zD_iyBc{nO_pQ`h4xb2SVlRQ;i)Qoy?&gFcmjm1C{+Z~fp{-$)Ehduq1q3vZO9{c_G
z$jr&{&VU^A*Zku>_mrGJX*}wz=XrN{@Q-`noB2#n^z`orwO8&w5T2s(p7>Aqrne0A
zc?12_(C#z-l^nKQnfY{+dZ-%Z$C}`)%%FTCo_e97zIQ`qs#;SmEoVmivfvo3%4n4FTKu1k;gmu8*+VsF2Duh!Z8{aH_U
zaE@&c%HNZ=2kepeX}Zq}U&#u~5jTd`<8_zR8a=nQwPQ0DOLKFrUeNS@y!|}C_s806
z{<{V}N9Au~*Ls$Zc=$k{JlcgKcT~R@H>e5
zz35XiM_={ZGA_CN`q&`nq4`_jnZ6g#uFTaQYfqoT^U{Imjww9v9(aCy3eWFmPMmfP
zHhiqj_kQq;UHUUx|ESix$K}*r^o-HGVkL=7o_IZX@
z&8%y@WNdA+tfL>@de2P!&dCQO!&)!n1DUHD-`;p9XQT1XXRf#ZlFVmnqGMyn{|%X6
z-{w7A=p^UP%)1k`V*_WgzgyT-`mLkuycVB1s2V-7(I>Uuv);Pe)mN@IG{>Ik7y!Btu`d7C8
z)vbR`>u*WVXVAoTF;D~A#@uyP1LoBK-+uHzey^+EvCqr=j|BYukYY&t+&~SgkxK&S
zOr06;3a}Z=i8EuYzSWSiyV!HVm@GAAY|eATxSlU_jV51w*=${pE*r=|mmSA6x@@UB
zD|^mr>t)lKjV`-RXmr_je51?0y1VIQj~>jUAK7U8(5E+=T=cd^pV(;mvETF1`j$pJ
zPv}z`?RzA&XA*w#L)SSITQolF=FvMFZ68|Bt&@wc^LJ{aPfKroL!;S+miH&N@j`lg
z*=Wt(gFd>^VveqN0W#6|Ch$=tR;
z&iD)Bsb-Aj$$5NYK*pYc?Ug5bXXS~1;64DGT7GpeqZk4m2CC?(c8Kw
zv}eWcz#ZxS8g1N{InTDs0=(KC2fE2UN?tu1_%PO<*zvEoE#%~!dVkaCcTYOI^{jWc
zP7BDS!*k7j&t|qxyVJ)zHEa`^CmN*PUp;+(JVVMS_G#=dU7jK3lU!EZ&6RIt++W|k
zA8Ln7-)emHoYeYwx)008@jV1xsCS3?%=OPn&(Yd1M(RfHeYW}0;4y)B3{73kI*)8B
zIinrw+q&9Or(><}&zz=S<;H&R_?v@z&fk%-=CcMp<~==#U62g9=gVB6w&?|Y
z;KeZ(njC2c2&PC
za~p#(e`Sx{i=%aOvvMeI;#hL4@8wVPx0j#o2j!1BC4VX4S07V8Yhrp`urI)4zwsC=
zK9IvF_HGNd2Vw(tj~S~6vYr^wqaNxUi3c70Q~&A;FCWosf?D64@mx@P@lMlgAH7wR
z!`pO1;>SI2@)8~L}YigzV>>cAn=1O*M3eWwulMQ7b+YYzAV$4SQ
zbnc9o%cod~O~rF##%!!up~b(}w`43<^r)pZ!L*z@k1Oex=e~B>jMl1##K`>70bMm;
zwZ#T&djn&39WHyk|4g&T{7UvLg=e&fZBV%}zBmx;X?0$Cs9xQy3##9hvHbMU0J#)*
zy*pc+oc)SPZ-eLAYHX1E%0GQ&kN!|}%b%v6*e4D*1e)=SCZqqj2k?lG989~5*i?6h
zGmf{;7XFHpyTe%B?(XJq%b5Ras{SorOim5xoD1xm26@;OYzWo{vtr_X*LvwHJ4&DD
z6FsG?@9F4m5fA&>IQG3QeNN~nv+kK`eg95|zhZ*dcR1{K?%AW3%!4yt^HpDJ59IUm
zHeN1=d?IVs`-Pm*uVyX`G_k&DGCFX^j%njNS}$g7sG42Km>e}h-=08z)xxY8SFEcS
zLvh^@u*ZJr?Z9hoHF|4*>9<#G<&}S9-|HTAo)i8b3$_MwSGh122lB|5lf}SXof~$@
z4<7LupSA2@qx{SVa`lFQEPBMnIyvfLxme>N&z|ycSH|v?ey#G{^U{mYIj{JXoQk*g
zzV_|+?+4=goS^FDvW(?vDG)R38lO&|j1I&^%*2FkYKGq30UK81Z*MF9^3{C#IQk;~
znwR^2O@7U-3FMKFfOqV@JIRB!($~k`dC;tvK0P0-Z3@&_-S2FZ
ztCh}3$t!!%yMnTXoT`b{_-DUZiL0@^>3jdI!z}+wpMIKu?h`R$kFm2>XR4n!cHWK-
zsxI+^+&rp{m#e$Vg_yW&#G_)1=7%`fx;T=}-y;L|*Jo?8H2gKkZnX$(l~YaJfc!qc
zbZdI?+Z@oj6xdJaG+(!5p5G6Iuk@4M*Ek>9-`g%0+M(M1leFmEM}}NPX7Pi{+KF%dfn#hY#Wzv)8Z$8
zAoui^-|j_N47A0`{~yqIbjIcPkr|h6V{xGStTv{b9J=XI>wFVuy*0Yg3xQbN9%y2x
z-Ep9syr+0q>F+Z4g&fs{)7KxzWg~JmE3k8`QXBD_(v6piw
zx^iKzk8j9H4&?aSAfa6LZw)P%hwr+Nd5}YL)q*%1_qEASkoQf2c=6Rf{Cr$ZZtd6T
zsrPPk^MM%e3CN?nVrNZ#fEbInyp$dI)sg-3CyrWAFIR8VY~s%>o9LcqQy-hv*u=*1
z?D1o7zz^fHTbwog;;vm1$OAw7_iVXa3goN!@vX#9j_17nVqM=ykyW+vf;M&@oey^!
zJ$nLooxGW^oQgw@>pKE>zIQ4*T;jJ9)%~;)w
z!R2i%27D5OY0n+`uH1-Kjr%-_YsGw;-(t(3zMthc9a`ndn2r2kqx{Pgebe&9Ub@Eq
zQ1axQkkR+E?5#ZgRQPA*>8Gcx$&<#PilsWK-06KDUK?ogX-=+sc#o4)&3!<|wm^;J
zm-Br=<;Qs35b
zLig)G9$Ni~0Uq++o1eQDi=OYlXO4f)!Onmzycgwnjo4Om=D%b3{i9!Pzq8cyd~D$P
zoc6m#JZ}l0)vB!$)47b@#ZKtE+A8_j>FxuUBWaAJ5lhKRMP;Y`wGB^Zd?W%L|9!
z1A6s9zjL5JFwh?!=zBtorDr%hPU-Zkhll0&bF4oiuzqS#_F4CPM(GYdvo>UmZ(~q=
z&h@2@&zjoQL&fWT?RQv?ZF6M%?%`hyvc{%<
zp3KwoJ1Xv%zJAPKo_Ti-JH(>5BGHMw|c>4=KS*HZ0~vZ^M2pGU0tn5dtp#_@Y>jN`mp|>
zX8liwe_OHT@w*+*KN)!9#ip+x{;fu_BBy#hisp{c)N|n>!#Z1*hqG!y$;9)o8olX>
z5Bh6DZ%&SyU+bf+~NkYUm$7
z^iLf6Ck_3RhyII({+gkG>dl-n05A1MkkY~=hv)W=HM*R55U~}M1@iYc>au150E^3AQT=b;_dU_PCd~N0K$(&8-
zHT27Y?$~~Y-TaDfzO$Qe%UsPVo#}K=*5s^pxk4BDux>b;;W!TV
zs-~~c7=4`+C-eGzQSU-UZx5zD1KQfJhB>FBq;Nq=Dw7mJ3m}dm!@Esj0zdx3oqAy;hZ-!$%
zs#cKE-o;4;{
z^6*=eTwBv`3)n25b_aB9^9XI_6uaIT&{OQ{xw8@4tRG}vKJ>3jFNSQrDX=d`#B4*r|K@uF_iHhb&yNcJ%AxZ4UZ;I-Yus!e6VrHEwlLzgNw_}_Ib`hY$wB2|hM%&={}t2y8P5m!${BL$KpuXcDdu$Od6QFo*jhZ;
z<&3i{?U(-Ow4Oho)%jjecdp%cmRx!mv%@>t#(?g70(*Zz0)6R#$Buv=Z1Qh!FQqS??vpVY_9~}}x4l;f
z@`-((>2ee8bpf9Ius3LPi>`7~6MH%7UgBFZz?+U6g3{gEt$}wca2IY4=7NpEDA4fl
zW5%cF1$dzMp6m{IC*y;K;C{jSfM4bVJjgDc$SfVK#Z}{f{}`{8bdewBJ3cADl<&mP
z8ol{Iqf_g*yEEt0`kZP0?0~Pey8?bZJMc_DC(z{m4S{pk*{C^xY0#eEojH5av0cOW
zAwjDn|Iw2#$~Sc%ooj8)^l*N$@g4D*zVcFS$48E}XYnr?#M6a{=ti3%v?U(=Lp1kBo
za^$&oAdpY?HFNnPzdcKSIoKJ9_bAZh*G+-vjNZb58xbG*97+KGl96_XHRW8HK6ma1jReU@trN7@{>EWF>n?S_V%^OIy;vFHqous
zE7S4&B_4RP@A*OLA_vLDhrA8Jc>zD#Q(v7C6ZX4zpBu~vWI1>F(34U8Uzsso(a_Bu
zTpzIeSA$8h%JLC9()V!|(|X(Rg*$Dg8M6Z&y~_r^rn9_(^0)WN`M^20wtVI?$43k`
zKHxL9;$ciT_lQlm26$LQTkF-k6PtqaXT^t{9f7>l{F{07!DBh#^Fo~`r_MVEdjj#xt{4&s}zsS$?Saw>d>l=^>|T?i~B*NoTQn
zcJRnRb4JX!1g#!?1@@uWzhrI7o^$JivcWmIK^`65PxRK?HD|1`uk00Dv}Ie}-CxUE
zU8Fk-k?i^W*LFH@f8)wQla;fa&TcFQn!D+!lAXn}RG`6{W
zzaC7xd+1*q_|vT|>G`a5Dm!i)*2^FCxG@mZvPX>#i?NL_O3x4Sm|gCjefqHHC4qf>
z+0fEuI$oy-{;ln3|54x18rPRBjp~m?iJt8@frnvfRY+*z>Npzs;vfdHJs?@7Uhv)TI27OKonJ{gY^W
zU#^sQ_||=@`+T%{_Z#6gDOZjr?|yR%uPh(VJ9gExo^QP0cn(@SqR!;vKPYSLQX|x)
zwnnH^RU@h{%D=WY;K@%_lYTa1HHpvEp0-Bp%DjB4M%^A1EuHDsp2_rZy(G8pGnsVz
z$9j3_IpOZJ18r*u`&v7mn>jhH9rSAL_-N*(o7&miL4SHwepcPRJ!^HYY?^eQtZ8T1
z)}G09><4zxyZoSTTl+^peAf7RBv$-@w)F%5lpp9`HJ_~37w%5$i$BY}Y_jJbP4b5`
zv-o2r9<%tAf2Q$R$*+9XpUcwW=LSENZ`tUX@xEZSyBm_RzvX=SyZubOFYELwAJZQ#
zUzHy-9P8l@pe;S<+}4RqkB}wy?v>^_cXdGb>jMq{=LIha$h<1hth*=f{PP2O;XN|H
z+I0N=(!(>}9XJE%D|gP$xZQ90)aN8Rv@|7~e)5)Y-yhUFC%YE{jjU$|XxVgLKu_o7
z^>RR_UOY=bylx2iWIk{YG_>p{qwIcs#_of7xhH@(Uz82@mxA&soj(vv%7>O0d8_gH
zttouS+Y-13#%z-d+7&_h(VQ*(^vS?Fo1A55d$!iHJhrjsTQlDlpohByjh{9Ckc*Ye
z>oewq4+a&t3_s<2ZhAc>AV;p396o}Q<36-<&l>jGLiViz`IVb;U@oZh;*6hrRDN&<
zoio=4rSorR-0RH8&ZBQZ|7Qp2*&vU~2KKZ%lWnbZI&GLwvZ2-IL!s;Sp$lGY26~{8
z(_(T#Kxd7AmV=(oK03U#X>`S}=e(7Go~kf
z`O9azlFPrw+XLzr=VwY=K7NmUJAYR?m`nRy$}gZcU9cK(N%mp|C{{%-y=nR_M_|F>q&HuhKV-2<$tH|XurLtl1R
zFJG(|UG@AmiJrdJ*{-kipEt}OIP~*FzhUS%4L#kRyKv|qI`mtIe&^7u73li;V}|wW
zN5lN{hu(A8xhseMs-b`U&_8kLpEUGO9{MjD`fJjwE9!}M|KP!a@8Lcis6&5!#Xr_@
zae}9g`}>al;f!|;wyJCDFL}O?zA1Q7@a4g`1>YaMJ$P5}o54~*wtU3bSw8rkKn&~M
zFT?TtqV(qnV%^ezWZ0jT{&&|%|9fks|Icfr|NS-6e{_xXe=sBco`J67@Lw`_2U@?H
zi-TPEUh}b_r4g5+5i8F-YjRagi}!!cxILHY;d90NzjZXzco)x)hkh-2^WWD<|A{ry
z|KS?x|7ZsKkc{8a)HIFl#$vJ%+#EbVsC%_EjQLLM@2*<5Ie1Xu{*D55zL*8mMbXbjsUaQe~_7}}k
z#%hfGUH<>;$K4OU%WQos$N0Qm@BLpi?RrZuc16>!xAZMdzwS=c;s3Ay^Ynw*sm)@v
z+BhUfJXbblJ_@c6UK+eH_@Us}f=>h|hw*%HL-2~=>w_N+ek<6XeeDz7XUae5=D*X;
z-=BH^89D66Z886EpOMB_1nQkStEQ>5>K0mkfj;>7S#oPN_xmP#d1}6PJmh_4C-1-s
zmUm+(@46E#?=hXci%+n;Gdp>wpI~`^obNo^eEC@BCo*5&)yey*6D;prI(ctcL7uyH
ztoQH5oxEFCkhj{q(`xtM=X~&PybxR*YzWqB!~KRcYKG_C!v-7r_4B8!pFL&Wza`n{
zlJ7FK<57G5DBsPsx%<(~dwIvR*1fZn=kJK0NO|AX$@}W#EU%ssU)sreUN?VMH}`kP
zkEh+G$EBT|hjjDvyZPr$(PL}!Ygso_
z>bZ
zSPHz;_`DRA#&@Q-!*_zyJ>QA)&zMZb;cJrUh!PfR)?dHGL&40g}
z|6%5<**?wwS#AHzM#d!DW70(1f1}g&ce?p&y7}w7`PX&xZ|&x9%X}8wC)q!%?LXGY
zm}I+}Gb!i4rqlJCyZK@_e_}U(YBzs&H@_wGS#9s_pVjskH!>#KUf-?t_x&lIuGe?-
zle_u9>E`Ej^9|j6N9Jp>y|sT<+jllHCfUyBNpZh_r|Sc{`MaWcd*9#N%|G1DKi19v
zIP?5B@fpX?X;A-Xwf%1z8Ix?U??U^yf1uO#KX>!Hy7^ak^Ka_r-_gx~AoKk9Dc_;i
zJH|BI+x2=5ZVDgq+Yvk@xFislglqhqr;D-AI^LZZ1J708bJp{|pO3P)KEPMs^1E`d
zrT9O&n_t(>Z|vr`W}g41e!sC+ANVt2?oYg@d5j8|5rY;?$1dV0^=(Jesgwt7~3=EXXEh{ImT<*8~U)ar`k@-rxyB{Y?clEH~6l$&9`@R`MZ)W_2)&E>wg^j
zNx6>CpRBO=rz`CJ*$R7qzQW#Ltg!c&EA0K%3VZ6$H2eN~g}uL7VegYG?EUW*_WpLt
zUY5u8#FNi+%Kg#m-dBHd);0$x+f1wV>ihjeHR{}PEqp-e&kr6P_&J!z2hR>(5`1Ow
zmcY-H{8I4i!TSS0yYk-xarwKzpErC)aBi?6*dAOGJSOm*T?&nRlHs_OUKeGy5VW7u
z*{RJ!P)L^-6=ZayV9MaLrb%gZD`5Sw>H%Ko)o{6as&BW-Ewd7
zs+{e|_57&)p5GlgE5GWV8RLsjf41j6i6G*vIFT;M~Aj-}(1?
zR?fHY8VjL&Y;bGvJ;BFCbI(JdkP6y2=tY53hYV|MxeN*ynI%TBcHFMHSmXAFJK
zXYKEwb9A_R;E`@@9~pS8=JU@E%_vwm^y$VqL3cUK|8n?Wi=9cEBVsto&MQJAKQ0gK
zi#Mt`AfWIro&P|H((Z;!rvF{o*vPw7kcE3QZR*Sd%ELuG~FAH+j#~7v8
z)CKzXIdCFbooY29|hV!m2cMSpHG)>JOf7@llD*Po3;4o)8!kVp++2&_D}7b
zS^e|r^3D4AWW+IP(|mJ0o~`Vjgw>w8tsl^8>h4;ft?Ke9(AcSNw{_L}(Y%k)W8`oe
zzV)tz7r&81Uvrq{*)R&7=ZRj!mmKX_`8q$sD6QpN??SK4OU7yt$7wY9vb)|Z+3#8G
z8ExIOub!Lru1TjF@6Gt)=-_k1$w3<X7aSMc~|7k0{kY?
z;l;*TY_8945qZRSi*%Z{x0+A-b4TMN@fii$Bp>~C)@KDj^|bibJ<#(NtQJdoA!kN`
zMz^|S6~FgpZ7rZ*OP}dc>xS0|gS1vR@s#gkQFdEf&EB%LJ`?1~nD1)$AMc9;-@6oT
z`RDGe9Szv#oK`lhHFoOv2!piNKc(BVvJPbF*NPlDteZQ?-~3*m70hS359EV-;W;x3
zG&;*ut#sz+f-^Oqwa1Gek2Obp-!=*~dRE-0@wI+QppI6awDoms*0%-g0*$?9=J;#$
zCWnu!-pN^G-}P+>`h9yl|AoChF_ORdR~>`$$0+0V
zLB-ryn|7w|`^L~zT&gb_c#|cU3UyycS#uxtecbTTO1HJ-VtY5%g@?0r&9BQ?F^B5;
z*z4l+Z_6{&v0iMfoR_zs8?g13;0?h~1s@Ae&qem$>F27xHt;isex~mSg1y0AfyQP!
z&^5o}Vyx?O#-l)!&vemB?pNn5+4`daUKJlboABeai-L_oA5%2Y*3L}F`c>RYzvbu!
zc-D9=J-)}HU)+7K5hiK;*XuWmZUs8lc-9`@W6>|-SJcnXpSGZ5J6~;ltoqHZqTipz
z!9D2MuT7gDt9~c1qTjot-z3m+(t5vktonKGj4(-?lz-nE{icDA)Ani|-($(Y{=2>Y
ze!MjLtpqx*w12Gnd47*DNt@)qFN}VxfsWH?@NJ)Oo;T+8j;{_@ooj1e`?=X2@xJW+
z!nmGqc&%1L>$BMU(2fF)o#bj&NBwT>S-{pwba>VG2<*dO-mufU=Z1m1Va*bvC!`uml}R|I0mzU5);j4?Zn#SD#}5A@FVdaV}E
z(#Lr|t$ugL^{$iQIL2ofq*aW+CF5B^$DS51v8&j!2c7w9dW$W4M}Z~>&9&0+#Tl;!
zWViHq9gBYK8DWw(Nxvs%{b)c>=d@$dPcDrxNt>kK=Bytr=%^iwe(uW%leE&W>XtQk
zW)z$f)P3S}Iqhd}d=9jy?F{}daNq9;>a07s(%G|{{g$tD=LF=*#gl^KX}l6`wr8R(
zex7+fzq7JNHapJ`=7M_XC!cQa5o{0E1^#{6X*|nM;>90i>aF8ZKg(401-}hJ`3_$?
zwmx6VoF2ueWb<8bPnO0prn^SoLQwoi8CR_6#P&%tO9q-ci?)?#uYAQ0I8-wZ{hY0H
z_T|i#f$t-}IJh(T=HN$yUkZLZ_=Dh2g1-wsGs-_8*b?~sGzz{r_|o9c;Hv_EH|D#7
z{5Q5?b9#2sf$!BY_Y%}Vv9tfniJd#J5-q*i=?oixpgXfCYxt6*wxiR&Ep&Wj&%Fho
z>DC9E0=(!&$Cd|q?&GXyJ=e&%JaD)1^2{l_@sro~z`KU$5!uz#%bZ@P2I%ND3vYM%
zMDdpACyKZ4gH8l*v8b5yubil!pWSa`e-0`0nh?qXx_?*qOV1#$*0-OC5t
zGp6_4;KPayo6$Pk$L0_7`yu3kb7YlYCegmXqs14UGkgN_1$?KuDZtmgEIZIUM`!2C
zxAN6_>*^-B!{+#~#lGj-wt)Zf6yyGT_{~|{5zyh%V0ZA?;7NgJ;WLAM!7agygI5Ol
z@g&)@OYdtsp
znVsy?a0nN
zoviEWQuUiI&Xt|^)e7$<_4jb(&4$1pe-*rA_%p}t>GAM8F}Dn3JoW_6$_Fx`@~z&F
z>KzFm`k}#(AAVxs#~1kFBahX>dPmcj9_@K&?itQci(~6+_BoF~-W|is{Gj2{`>y!vkH&v^SMIlWy!YSnwn^-@X*QKD@&nB*xzPFv|2kJZi-)}16S$*loW5+oDC2bj
z+xZ+VpB2cd=X&+dTW|Yb54ph??4-kJ&_``A89fj4-e&Wbck$HUf8a^i;#toF=ju6v
zuh_MH+0yo{9Oqjb$oR`7
zTfp|>Q+$hG=|l%Kv)V|G<_z6?{^sJXKUx`V(^?+We21p=Ah+zaPS>(`HUCYDU7f|J
z<$J95k)@T6dTVXY&GP(d{X|FS%TK+|_?JD-je^RhHizw19#sz4xuen1nc|1{TrlYw
zxijmp3$!}|_3S*8G-LITP0kk7fWJyT=0E$}1M+@zsL}FowKMLabLhUmIhW}X&qXos
z-|u_bczpT513mxk3982F%eIGR?2cC5M$6BIS?XUazjBE!WPib+2bskiPyF?0`o8yP
z@hl&?XP-0hH7>q@%isV{YFa;{&c@1;4^gAjn4`+=g6yG
z{LR~bCAsK+sCzz@k5-C(?#PduM6@aGea4(`{&Fm?~D
z)!kOV)Q3$0y7pe8aWDB&ER8Fk{pZq)vd8z%|Cb>bjODU;i`OW?lYQ*)Z?|5Mo`1!P
z9-9Ma&JNg6`k`}n+IqIey0NWnWDi;RZV2kTUHr{^Kak12(8HXz6~mw1;dw^t(vJ+MfZ>1$zSdXALIF+*pA_)}hkdDV~lvlKD3CyxKGo&A><+tRnalWK_jD1LQ!j&@(pxO?sSjhVOi
zqV7CebZvgs`;a^94BG91yYyqjbE3{qvZa;P-^W?cZ64&#;*Zk7-R41O?jOtrWmnNu
z?>SWWsGdRSzby8diw7Sb4UZc-9=>y5m*Tv0;5kaKT^G>x@?h3@P0EdpIX@}3W$P??
zfG;{{s?IED%ugWxblnu&$dU`2f|CR94`oO3V2@{L<&x(f+V)I6FRk-4TC&?3y(RM}
z2HG8gcM8uK&6qsr#S**+mp|lM<)5*f^3Jdl{aR?k>Yuev?dKgaT*>a%PwjXXe;g0`
z$_04qQy%*dcCWb6+b@W8*w>hpl3tXh@!)%
zYbugb$dKU!XV
zR5_91G38a+wUQmH+ZLLf)vMH|z5
zXD(m*y7sR%*V=o-FUx`VLib7?P;2=@zCJxr6Fe)xGu!tweCZkQneEId(4G-&3Ha1=
zRBd`$;GFV4DWSM(B2PgtLexNGVd4AlMH%J(v7@cH+ouU58K#G
zN599s)e*D+*cTj}9*J$v}G>{ypE*e`$JRk>;1dk%e_t(+wL;lbYEIT0c@2ZGIk
zpNZGZM*;uN1#;Z;h)z`#@jNx?_sQflax3n7wHsQUTK;UD^-TGIKINy!9R`-0jlz07;MbF)T=HmA*Nz3xSp#`)FigYQT4
z4$HT%59Ft__Yc@`b#P6fd6w5ZvKRwfYdopHaM*ujLw9+`bR$z9@DqQF8$Xt<7iGLT
z;Ez_Hhi2|PduKh5p3m1pF9vI&m&a?NcbC{+`EAUm#bKSkHKt3A$*HkeRc&#euhfc7
zf%Eun4Ymd13C^l}bHUlc(}ua+Ixi3ld-7&);C|aPS9^SytWM1bt&mDwpx2xz^CG2t@K^Un4aY0fySO@d`=)YA2Q7OlfT?M{uU28rLNp3itSH-
zVbI!05B2c;U_QXZdGc-?#%MG$TN!i}KliI_q2Ggpy+PIXyECRE8QNXJrGZ$|mwiBw
zvx1EQ-|q?Nu{iW-MuEl#ahRp&1GNXOv6yWNP7CC)c4r{Z<)#?YP45gHX6Y+m^tT0d
z-n^B0#;~U*&JDOA{iB15XWc8Z#n0c7toZQ*{z=swHpB%Uo>cz%D4(ti&v^ey;(rf7P)zek)d7@{FzMd&X
zhd+DJ^QZg8W^&|l>14lZ$fSBGMq-8zis!W6eOJ%<84X`-59sxd+#9i@ueH5FU#sY+
zRjqn##&ZFl{B{1&ryKunwQcFkPvY>w$iTxL=NmXL;N$9z_XYG@Etgi>Cr?a^PsN>l
z^;GQbUmb`~J9kFS*%7GkYAQR6Cws36oWo;(AQocO`l01v?2g|z2k@6m$J)0xxhwd8
zR`}D$UF~b4JFcd($8%ENRh;P~_SN%~dF8D9GM|*&*5!2hM^3vtavDEzs+`7erJUZL
z{e^%$w0tycKj{we5&g)=n?666JS@IwF
z>YV%*lg|!8OOIwTAY(Zg1sYy>iksH+x!($WZVvs(p|qAy`H?Jfz@IK`5dVdM{d}z5
z5{v@x0J{QhOAyiHX6>w?-|2Q+#*_F}UeU3QhdQRwTRi#L&tk~?8-mKes;lBE
z7Ib8b{L?B1t?aq1x3=Ifm(LGY+mmD40=@!uuKw-``HuA5Fh
z2V3#bT7B8Z{xiZ%T+3(WgH2gOvpy((=|sp(-|?LL&d7(sugDjV&hrB=5s<=XUzTEc<$XaAJDUv
zvoz4+w-783bG|a?PiXJM`pmU!0_P%fyiX73%==tCKWk*6sWZKO@^DtavV*;!6JhS5
z&o#G7X@T9{(xAnRoY!I)y
zx68*c_I#1Mcy15)#&=e=E?;Z?1I@bUO0B=US@%9v>p$JBlTqtG)U5lgSL@%A_4*v@
z9@qLeWc~Ea)iiv_sNVal+yZfPMxH-3XV8=#`bo5Ez{m1462-6jX|#T424A&yzB+64
zBcpWo_Z&)3HsY%m;)I-#2>I{-#{+8dv|Of!_RvZolmK#;ku;
z_P;kh`c}4a%cJD$+x0)p+0(MNr(17nuFc;1=&csX8@;^wljQV<^zv_U=+yx8ss-v~
zj*mafygdnaQ^x8BKJHZY_?;1KY}VxPZGrQXoV`NAtKDY(_UT0r
zt=@e%XG|Zl+7mdxIP}GfO}&kHmaU)2U{bE&If*wN+z`pC
zQ9u@crSmlV#aI)2ysiuIavrbU!5KkoulGH^`++HT_WI-HJpEff>oUjZO#>hLZx6)g
zmH9!g(xcXvhBda>(@*jjJC=gVHS+mPzG;hrwF4$;=zPDjCAcOKJMdY?nQZ}I(3Ot#
zuKHvxsXbn+__XP`ET!F_i8nJIp^6cR`h7=#q%;B1#Nuk)Yc37O!E6>k-wC^
z@)H>+@=k{ROgTvpZ7p|FOj;Xb+W5Jl=a0Dz#B?=Z%L{zOx8+y4`sW#_H?Iol+1IQy
zvbHh6r}i(&xW5zj+<7+M7T`aLPRzvwPqD9DsQjy1kgX$X0r}`h0lV>;r54ClbnehA
z0(zR`wL741>z8^yes2soFMINky!oJXt=zA9^jxUbplF8hlf-L%?WdEVFVx>MzU
z_8rZ=s=8G+i6fi%_
z`oMj;Gk8L<6tuBw?{a^K*80A4TX@$U^8PdF4z+cu=vTT!mE-*#s{37cNX{Njtm@9x
z9m3;y+#%0`m13m^hyx#s(R`q`sA>F?5;*?(oeMHnV;>mDy4Rb6`9N-(Zwa0j@XuQU
zyyU=QQ0wZ8b+JZACfR)VFyrthdqbdC_o^2ga^?dv@v%3FKiwzspI;+?zL~_|XWL2q
z7uLw1{VjjbR({wp@bNsT*trva@BAdW8`mh;^I(!(-^uc+dpb$3xQW-90X;Vl^x{G<
zxvwVQ5U9sL=xiJKEY?{7c@&*{3Hv?hZV&+i({gP&*dV~&sSqBw00
zwgovphMMBDO~pzK{d)#m(yt3NKA@+3^B&{Wdp`JZpwYX2#+}{^
z1L)S`;oZF5d)~13$`xo@`gZ*9a^~xrbN@c$9}H%-e`jd7CI+MQlYDUhtP7F5@ur~X
z>w6VBt!}LgDv$bHc4y@_ek~7Yrsa@2BVR_rB;AV7O6Q%0`viR+*7?$T8XrE|wt|ml
z<-;DeW)!SsPpc1lHIW}C$+5oD{-nDp-$uc#I!xlh7IkJCpLN;e^VXJ0d~TV-1MgXR
zs9$1>eiZa};Z^k*&C>%u;5*N!wl2G;7Y1sd`sA!!-WaI6RhJKB{OG`bf99sFT^7)z
z>@OaV$eP+{4^Pj|^?`c)>cCx^#FIW~ZVifOo$Yzclj40^#(fFUmI
zk5Dpa)sHP@U#lNo=%?KiR4%b;DOe8pSzdi45G(Pe>otKr{t>5zU~eFg_NSLaFAr9V
zdz(jW#cM<0xzzKtc6acQfF9ai!KDE`#D$HTn#{NSXnj)NvD-PmAshday(eS57K6$K
z^I3G1!|xxS_g|4Q{!a-sd)Yet_r~~{47#|lV!E0xa%mP_#Ne`Er5KP~{ObPk8Jo`t
z=$jv78Glw2-@4;yHU@GOEq&OzJJ5`sWuHB~K+}8ICzs9c#MQyRz?wQ{e#tP$!+b}e
z9SG!&n4+)!Eg7?i59!t0bKk73X3uhH=+xSRUvCRu+8F`*@?qKX&|$4~o0Naflnrcl
zmJMplq}t%Vk)TWD%
z?ym6hC=iQXfkuD&Yz?*roim-1GB-svWc3b2QqWL3_{fT?(!a9u=q)
zWrN%(nR_y3KU?H4e&(y`wm&qp+^OQ%=O7tv4zhdFokBMX_>cb17>@#N*P(74tBUu!
ztX2N;Y2^nW;8!*KjEpt57tLxpga`R@sJ(M!@^`JVTfILk(8#dX`dbc^uRlH^ujJ+^
z=<`ba$g6lxI=eIb7e>)h`u;pWwRy>&@=HCVtnnRL3xQ_N{=GrHBguWJxK!R;khMPl
zSCWIal|#o?&VkJ3w;a{X-6hX0t=Hq?td$PrmVWN#TyRr>U)e-<`Lt*+%G&us>n}7b
z+2P)m9iNwRYs1}{KPYHz7-dce?aqKrVnavkWaCF>>BRG-VkWfNat5XiU6%}Kt-i!VMm
zz+3yAU~f=4Sw10CGv`DqHzcEXlhm;NP0lrEI9U^!&;<6T
z+q2VbP%|_(i~_#Lqx{MD6%X~KwTs^3Pd{f`yTnGLi(29PBRYryJu3!u)Z~Y|rhir7
z8LWO@AE2rFS$@G6zYW8_v*jn}=;PeW1HAm%+EV)RVTNPf@DK;Kv^qIEt!AB=s*~5!3DwoJC`W+eb;VHpe^V0Zp!CwYn
zFxa@9bv1z8>MKXY(j6$B$`)&-Kb`glZN8h+h0S=<4G+HNJI$D0^P*FG
zwX>xoIi4@#j7RBscE)00-!rB1jgQnOd*q9OhHhk#wk4p~tnua#{51UKUis(FjOPRT
zo)oaFY`iFAxy2_Mx%4Ty#&xFRBc|3$&O*kT`ME*K0bh7u+8^NKUH1jS^8@#6cfbyC7x|aJd`Hpll}_&WgQK*$+}{+?0dGy+fYvYS
z0Da3BIliJV*uD^G
z&h5=uof!@5lj!@kR&P3yQ?a7cdBYlc^d(D8;)9EFz})(LfJQ5t(x-gj`FC1CZ@l5Q
zfL!-myiN`HaJAg2=S2CS`1G>N7P^sBzB8V7hQ4~J!>be^KY#`GGq4g0~^JujoS+{x6iM&Z_e-S+_`q{-nH{nn>oMn
zVcq>{vG|qHkabFcmss4`j5D0c=Rbik?P%}jB%kjHzw%+*KX}Ue#m)M|GiKNNpnTN&
zT#c!F#IK$mMdutpwDbFPb9b@!Gn~ms?zq6e>vtyOGSX~-ya$C!AknHexBrqk}*k-
zNq%_5jD9$gwm))49mMU@(C$nxZlgfEE>K6d1#;PQM2(bxVps2R#%Bk7=w6$P^S;1y
z)ORdmYmcl)MOMXxU*%l&7iT;lINv^ljnQev|Hh21(@X7<+s5)stl4sRa8YMz^0D
zbn9jFIp3Gf^k{W9zbT+=s{_3!>EPXnUVQ1EYj*}$1jUQLovmkH?U#Le`{=~=(P6kV
zeV;=W7wd9h6lhxlXDi3VLPMjrvzc$`_lV%;0L{h#FL9=uzUat*O!P44|4l=WSILnh
zKo0PQbN(KKTy=(Rt!~rK?3!?fFGg7>6TkBVdRyN;VZHRq);K24l}?}E@IN{0Y-;H<
z9mkNa+G4;rZEnzgU%=M#%l3?|`**O=o0I?BnUi1hU(a0L_2=X%-}meFnS-o~Pt{I+
z=|Ep+0;K6?gZpjZS&HwSi
zgMX4Qp1<*b9X$B=`NwC!`fm;%{Pz5V)-TRKB>v~YegE#@!KVa29Q=Op?);&^+}|HO
zcwz9n`9Al>v5kK7!7~HD|7STp{VSewu;S3>hW!lzpY93xQcT<_ce;L$l6{|7_#6%X
zy8~@YAkK0I4}L5j_!LGNYwbCDJBOaH3%fEVtEJ`pvcaBqN1!Iuoi|2j|K?y6Xmn(^
zb-IrNt=5f82lkP#jmG~!L`TnFe(R&tvVT^vl8oNRW$!5Gw9)wghvdmAt=9|xk&QI^
z(@U<20o`8~@I#$P*C0jm`uTJ&#h5uKRFXvnNcW3^PK;CF~1(ybV;(0+Y
z?atuBfL_+=wJxBeHRIBe4yB_SL9d;`Vw_QT(it^&Pu9eZPS4I*?3}T8dFJ@18@IaO
z=<(Sekn86`tntl`p!9ip*1swE$zW;NUr5g;^zQ10VQlU>Mt8M?{rz(cjl0(JFvkPW
z-uGnkm0WpxfR=4)G+E|k>3dmh{aEmf0FN^QG8O~0V$tWk7?O!6UFqrUT)>C-1oeEk
zUv{FaGuB@oR2+JK;&Mfpu|dq9moZxLwRh!&y$26_kDai0-mrJoguOF|y~j=1qbGTf
z@Aj_AnmpJSu$^5u4r4k$cNmKm+t7%0Z)f@KrtHaezQ=bIX!272X!YEa2WJK1^Wh+>
zjbl*pGM5YM0&OwaZ;*{TW4aKKhwt_Py+0$R^Kzh<{}%*e-qxT@$GSN~ce#ZYPd)=R
zh^`tLbec0sqlZ}1we+ZaM^`fOaM#H|e?y?*Y47HsbS3}U!6O5$=;=)EDS#&Q?avqLUi
z8Hma40UOz_Z|%r*TtCF&>jE*@6==(W^{Q{~QBq=@GyMIk;F{op!Sw;&o*{1x#29`5
zvjzM}hCDZh+XH9ot{a~gIB$GLAb*Wt9+3H8qX#~9Cd2Xls(W!u=3-GgzcAz0mgi^A
zE_$$YSD?|m?g*K0iyXYezbd%76R%ytG(&ZfLNB~Ux|2USZJhPnHW-hD$uzPWR1fHgjNP|(uRgWT5!Y{bvL
z+TskoTKY`KJo$`Fyft;4PI&3X;?co50bcXLrhx4`f`z1G2f6>mL-p!xU&9Cd`*LU-0cJsZ>JnA1;-}pU{t?tk2=Fjft
z-alIUrEb2jo8Q>YpWDrE>gIkINz4D{Ztk7G-M^)oA8+66Z+Od_FYe~g@8-95^A~jU
z7k2Y6>ES~A8+5htl`Z!FYo5B=;p8N=6;V&8^>37^V_=l
z?cMy2ZvL8XexRG*+09?u%=t#mxH<5AS_nK7>UpC+s$J@q=hV6Yz51`!UY%dgnws_O
zV5QFBo{2za^~Prh{I?ofU7sBK
zcK+tf#e!eRHGWlaZE)Eze_i^M0)E;T@J;!UEiVn$2mRiiS$kTrBe*H>d}-zM@fUk>
zE8dk0>=Tpo0=j#?(KTNmAO1bir)7TYuzqrSetKTu9mabVS@?mSd^Nf<*z4XTz0nmy`AoWT$G!=ZS=!8rXBvh&~z%>#D{HcVH+N^+IDJa
zOZU?GysWi4_qy^c8Zzl7_T-jM*4c72x`@-30AK$1-o-wsJIg-zNJGCAxJzit7CN_g
z-d%N0uIXPH$YN^F>o(#4QA!_`p~lJb%Caa@?G((JLdkXJ@`-C=UX~V+ULLdU}4HW
z`}vRWt_;|BMo{+Mma$wfy~+Hf1N$ra?hCVD_BuDsUi!Mj4-NJOCAam*OS8`2
zN&C(}Enx4YeY&n@uew!oTYKdp8>?=uWG^4`-4Z+r6bKo8syO(IdbCT_7
z*=fz(eVFvU0-K=r-5ux5;f}!Fyg0zim~3rNKnM5iqbXNP>TZd{+x
zpB2mnbQuL2olg$Oiz2=k^RorM
zm-e~R=c6|V9|-<9xc9nzW)7YZ+!(wr_|D)R!Fz(G@L@xST6^eNa`fwivhzjFUTdekEIau{
zJ5f4(QFxbrtLbn>XvN_2fR1#kJM9jt!`8*d9Ru~$Z}4;
zh)G-f$fQRrQ~jI|`15$ke17dPRNj7mA
ztj<&oRfi_kl~!-LQ|I*Z&K-8=`KfYu(p~M(x-To8b+_n4KHhZSA8ZavhqCwNX3ZY?
zcxy$gKQ*xKuDl|sz2XzM9A2~M-WL5Nx%l|p)bnw#*jN4_S3A)*dFJ%G9F0w$pFN*x
zHmwwwbqyc}Ie0PsXGiJX#rFx&|4O@?736G(6a_)|~h5;Z1-qyw7OtaUaNZ
zAMZ|(%HMS#v-~M*-dFLtI`F=$^}Jqp6ufd|>K#5>-+xJXmQAb0_e91c)N{waq?w
zr{)j&NROL?_H4a}RE%00GClj*>RpCy>ftqkz3T&aee*DH-+RSjk`K}QJXCw-J8>lA
zw!m2ay9>rI56JBQjFlgHf2(cV0_U`{L9gEH`B5)F^myp`MPJV{`k3>PUY*yAtG;ZM
z5AHQv_1W-2C!vSZ8ysXE^>Wd1|T+AJXxDfzPb;<1@L4
zetYnc0I#nIFS?Lr{`zkImEHW`b@Q+4=3m{-zowao{o$HQrX15213FJyyE*H=|Ilk}
zP}lDXU+WhJtslytd{y_OeCTYBjeS?o0y@~Q+(I+gtl?u#UvzTFnzPG6-J_Dj$MUsw
zArs0@&n+_G-hmui3Osw<6MAnCY?>Z^!~(?Okelp!fT@HP3bm+S^ci`-xmnVnuAy+QbyL?EWUZ(w$iD&8TEIxIX
zueS|r?iXKA(vg3hYx(pt?YBHy8+x0|-{jvA^s#dXC&jI;7yL^m9v22Zk5)b!b-t&`
z(&1+mdv;n#6F0Q=4D9#HkDe|3T(zn7Q@_ryTD$(V%-LFdYA?Cl1NMI?&&d7hJ(I1|
ziwt#uP1cC1-)GcG$X$(W7K>z&6JkCGuyW&5Q2*4xD&_@ga9z9M6Md)jF}
z;3sX85AbY#(DUSzR{k}ad#|iB-V^Qf7yGUEJn^tszn`u5tvl5E`mD^gy92)VOt~re
zhhUN{dld(~OOKV}(Az04y`AcD#crCN_9y97=k$2D_KRh^?+#aNjOE7#fgGy4F-?B$
z>*Y!-M=Z7m+XC|7K!7P)^WG2E>lq=|8w0${H+0(&@VUI|*YPY{ChhIdK8964+@m_v
z+K|7>H~w9Ie5D4=b##0RYDM{~Y{dt9+uRTKZw}53H1kow*BYMcwA>+^o#<=5Y#%ji
ztI@XSi?-D@tj0bkcSk@M_P#uSaQp4SF9d%Z+!LSpJDYU6E^rSkR@Sup1?n1JbX9l7
z)c)R}J#%X2?%qOhbs!Gb+&62^c+S)ry7QsdK98L#8T&I9FaCG_`Q7{rntAU7y3$=+
z49HR!@S-1|;CV$L9(w{bbdg8k{?J!^&kY_B%mN2Mi$cSvsuFzzXJh&AfMD^bbMjX-kSHmaVJj>1=~DFJqtDmI|4eB;rZe&
zz9e{E@TTCqgC7sx8N4^3)2=|PzGT*3^=SG%_D?(KJ)_^lqjH0ft3Hl0W_L?Jm$^2L
z-u@(dw&U%b_%089$+C7?AYRb&FxS??L;Q}Fha5as9;eR8Ltc4)Ed<8pmz^2EF~Kh1
ztj~OsPSfJyPPO#nqxHTd6Ltq;(Vm&+|MrZ!w$?N1_@pzfEu+wQuC;V!!=z_tODA`i
z0{6px(VXEEjU0FW=3o?Pb(h+6?LEimmOw7M!}|j<=8G2vczs!buQfHvJBaU$?aTX@
z2js|6aw^vL@H;P{qw{L1njtr?57eN8LC^ceS*zOWnYl2~h|3MZl>y!Hy=@rtKOb4A
z6FL7q^^Q(eLo+;FZ}~wzo3of!b(kI2@j|mLz!Q$fSC7fLFAXNy!=GhO`H)XEzMBt9
zuMEfUwDjF>l9pegam3$u^fTamQv1J>Ip3Po{~NmfS9kMUy7@CQuh`?kCojo+Y%615
zH-B0;-;_BXrNd`retI+iZ~46*Ex!+T^S5^Meck+tne(If4R>8{P99&Koqf-+l7C%(
zr-=8^yRue3l)q%7DP2n!_4#F?CCgsf
zv_50>&gy~g=&u~)*(-a_9OOA)vdDL?c)Baa2oUX;YY%BfBC#9!*i?^Do_a35GWAti+eqrc04!yg?
zK5{;D&>3Cvao)ao{&_Bu{A=~yJm_nU-E8^~KbhZ2^V5gy;(P4}e>R`(g3ozpem_m{
zEx`{5OWE^|_L{&m?`y+gl>U=J>%TWfw)uSm`jEA&S)=pmfxh*PxYCUt@Ewu)_F&yF
z9Xxn#@PKz8Ja|!{mN^T>|J=b|bM3)@b!7Y>`Ikq|&+6vC`WHv;-`>q1*3JLu&kyC(
zhRCAFgNFX0Lx1tmKWymLJG!y!Z8_W4hEp@=ue#6t^+$hp=+4NQvhhP%Lj2Y)_aCVXT5(&`@sfBW9dfAiqM?|I+BgU)L&8T7)d?wV&W
zUi5|!hW^_>aPZ*f-#YYrmBhh5U%(@Wb$Q&bzh_u~c(=aygNN=qndMh;8V$P84c}Mg
zcR;m%{&;>bR6BoX=6qW8UpdUhu~aC-WxpGCt~eB~^@Xn!WO^d{qiz<%Y(qlUSC>)w0yRkyAf=GP2;#faVL?lbho
zZ(80Izw-zB=MMe;p@06+zo462rxRaj>aDuv??QZCf^>EIcLv&)K-{!8PARVkMQfv`765lP2K#dne$1Ve?sPM-aR67GHd_r%uml8ji#2^*V98?HpWw5bxHeF8j4P-5&+v3n$8QPH``nJ+U39n1
zouL~&FACgWIiOBo7|6%#f-?jBJj1>rOe$ySsBH@H!?$#mcebl;JUZirfPHxBw+HC_
zJ~DI%0yRhuYIXMU8LMabv)j7bh(Dh6VWZsE+!O2khrjl~fR6k{{wUCD{i=*x-fSn+
znbs!!O0OqnOpfQoyNC6*W-n)LSD^7T+xVJ(Y{xsVA>&+pdd8aqIKm<}cD$r+O+
zfAC_%%Yw3dDPzy(vRfQA^v310(=z5?xpq>pFYx@VpY3}_#&n=($tJ6nM{n}b%>~*$
zLGdgf@r9Vsi7#FeR4zJ?r#(DM7Q3y{ZE;v7Klq8y>RyQn
zT`Et}l3VwRy=Mg*19WUH|A>qD)w*|=@{4nFpzd+2BR%Qm+@64qmj^q8Z_FkceBqjUMc1?^fjsdU{n3U6?Vx6|;(Ct&v+c
zwtADvHon5Ie6&B~`G8%{(uMxTmtV<}&-5=_GCZt9*@;J;D}Cg{H=XpU>+J1)yFP2$
zoxy2=-14kg4CIjgeF5FC3Mvj;GLDFGtMO81RV(QQ+XHmIhb%kDk>7l?HP{xQ0lsSU
zn;!TaP2TcHo44hE{3;KgKhTs9>+Y%BTG8P%iN+nr@72Mz0h_FqPcj_)uB}<~Su6fx
z%EG=BBmp@Z1)tr(ZD<*;0OMxciAciBM)=js_WpD|u!
z;58rg_oL_6-jSXkU&vp!oDyjF1nelgoo9DF_xpXi*mu5ih28XA2;?09_?pN)F4FMIj$fdL!l1M)o!*u$4>GG+_@a;x}|6i7(oI
zIrH+hG2hMyd~>uu`Ibg^y3zf3_~hR=eE+5S#NVSn5qa{h4d1o;#68f|IQgN;PdV7W
zBZ;BshdWrPyJs%HYA&}o1@cFZS56*_toH7cB~MF^8sna~a>zp0;^xfVXSz8pS6HDVWI;kyuw-7i>hPyu(Xf2&Rbm;3{
z(O4|>8hT@PplxHq=7$B}79EVqcCU8_SsL3qO0QiP)LD9=b%t&gmsU42$=esu^QvG=
zAP=-jwD_(@+uBS%8MEk9=Zb%SW-ffR#h~I)XV_9TpFH!m`uN-9(BtjnqtQ_&reVe{$e1pC8n{+mo?en3TKLq0aKZ
zXQ}*k*ER1v*84jlUY`BVleIJWuGp!6>(GC9dUbR@D4Ord8hIB6_Q=CywfYj0BWx)9
z<*9d$>w|Lx??G(6Er_Tw-}S@V-t_DtZy{)HGIzdcpOi5kz8j!h@qIi^S%@}oQSw#IJ08wHx$S$dRSY^(ZJ^`_>NY%H46oqrDm^w=1*`WqJ=8*dFJ**VF7
zJzsL^JPI_v9T}w2cVv)O=jx7^4psN*c~-z*@`OLO1mbsQaQiT>H9o)#y|~nTF=M_%
zw=Ot4u*OcgW?XiOqx1A9yWOkz|GimfQ^`Fi<6QyXp7oPG8f3j?~4-RbLidVpg+Ts}
z0!^;+(l``tUC7-TFeR8lN!0(Je
zOf+M<$t$sUx9Bf_`IkKV&b=()e|bvgd|(fMep?9GBInW5L9ZTZbfc$rc{)ii=QVmc
zOE0|XWz0A9dq6NvKQ^Cpj~&UJL1m-@SB^kUOusZ>98+e_-zlI`QG7Y-rQyO
zwSCdi|COO*Ga5Xc=kHsFpP{o?XX%e_68Mad^kT2C7>g;HI|6>f^L6=)UF7qn_^=5b
zo2+Z(psjspD-SkiOrDs1PJmD40r_af8x4Q+2|MuOYx~a9t34}k*k5PW#5!aBo}l7g
zalrfb08jD7*K?CR<5vV~$A;X;rSw|@zLBeRb;dn=Nl>}LPIP#dot0Po)avYf@tqsa
z(6i_Nv8)|${`4TfbUQC&{+dNj#lPY<&5o_%w=LicAXCgY1n&HgXOaB+p6~pO@oLZA
zl=-^@bRP~hddjZ?o*M(L=*Zg~wEW}&ko_M*;C#tPhlg|OF&U+=F}n7%1|Nu1`4P|m
zn8Rh?Qsy8Z+zsn^Osao!6)he=5gz1M9IU-PYrE5Hqw)U_@thmRZEnlU(u!&8@_0wz6%Uvjc^TDP-9;jXA7i)5W-k#MzGw40aSabi|+{pICKL;VFo`1_3yT{iC
z7`kzZL
zSLOpeoU{MVtgEZ)PcMtV@Kkqd;ICSH$FNrC-rCK-Hgon=?V%%D
z?M2yZ=TGhCj~aOKE8XNOdVS61gn8kNVJs)CofDA9)`#Y2@mrhs4nOZ+dBw(E!_TjK
zKP?;28`kjioY#9tv@e$L%MT&a(RwSt_FtR*(wBU6y?%0YOXymEeDsq?>ie~sxBCZ%
z{WcySNX*HwR{E44-;urc{A&hU`*Psy%=f2v{^o#98v<*ZIM!Wh`FtS%j%uAdJv0kJ
zox#H#y=E?__?Ld_fZn>^yJFjK8|KxQ-@L1#>w9&_`U8T?07t&hoRfd@0A>$68y;SiJ2o1aia~y*+-rFnDfYpG;@*A+z4SosqNF#okz6EC%9G
z=XPZ5Tq{!^vI&3j`jz;h;>Bmq>q{5$tLI%vk2w3Q6V8TY;#o0f8-B(6vW)3bpC!t^
z*4IV5K6GOIvVd>RJ?nmL&;jpDg3STHX!itsb!x!Ba^a0Z@h^L}WR1-l-&_?~v){%y
z(72%NbWb^GUDYLe_3xfkr;C^-)pg&h%ROU>e_&
zq0Y-AbfZA)ebV~U9vjMk2Qtp1bo_U|G8~_EFV#_bME7d~`e^D3dNrl^l<&!@afZV?
z=b_)-c}nK{n*E-(e90H`X`c?er);mtn1as(veT-kKerm
z`}LfsC!I=Y5
zH8Fi}4tge&U7u|>X57ZK{8DRV(L>%DpAn!jetAHzk0d{r(mP{MEBny#huA$V_>C;^
zzjbG-4vIS)&JX5-t--bc9h863@i96)dpiDRt22uMzdAFkU*+3c{rZ~`=2=#L&2ap_
zQ$BQ8j>WJ1C2#rfeUZhUR#y2U%j0^$hBJdZEu_`i_vdW+9xwl9LCq)8|5me){)5fD
z^*b5cgKXdH_md0qvAyRH&Yb=7=)9m}tY(OzT)rZZvzG^Q)E>RXv-JP%2;fWkL7xw0
z&hL8y?;h&|=k7hs$&&;2_-rAN8z0WO@*iIFfwOI0p%>axo#wmZzdqyE$CY=#7o93DMJtArX#aCV8nR7A^`Qh)lFCX^zq?cFp
z=KJ3dkvn}`KqvR5z~+hz{+j}JJC8RWC0}fM`C>^P|4ftr(MCSrC0jpDK7H|S<)iQA
z(|I-de{dA?$-gQb8jYP~uwzIv<%9G`Y8N
zJUV0>+QmT5)O}EI+dHYQ@hzJ6xxtT>&&3}vYgIQ&_d54~$-5JHz0a~v__QZ9Cl*0U
z8&ZYjEZLV9QW|7So^Z057FsK|(1jE@!Jf9E?ZAk%r3WkZ`
zuj}ie!uXE33*&}6sHhz_of$j7@00%(?)>>bC#My3-uJyf{CaQKeJ#K1y6@*XNl4_q
zzQfA7n8;Yyb_T|f|NHO5e4&${n}Vr8^ER>b=0GmJ%dZS@Bj&l_#(t*&c)b%AZ*H^}0Zt
z4XzAuuJQd(2K4gXy?2fubXHB(d)(^y)6?j{*N_f;Xnfoi;8Q-tg_A#vUL4_WF{u3W
z`-9oz!;V1vspM6>JA-VE@g4d5D>59%Kn~Y$jGVh-PVRM?^G$7*%#Sp`7FcWF-mTTS
z`!jd0=GSM=uMb73HEn;^S|9(q_iKW0>E`%xhJW|;WL}eb?elj_x34zq%u}+~+F8?^
ze>}hE+3vr;H~*2$eP_U5#q*YC4L2?5($oen`QrR^us5jMcR!8GSN?xtr}xPjm#ydb
z{J9|W)|c7L&u-+;?R2os?s?rF{yvhNJ6pBV>iN^`EoHCn1fA~6#c`~a`;|_I_{7b|
z+OB_UdVY)R<(*u`aalK42Y()&bYGGlU$}wdxy{G3bFQ8Hds*7~rr!MXGN%W>3!P3s
zryLI4o#NzBH|G1nZjAQ>L7S(N*Q+&sB~4uahr*
z-bm-%d;Nu7zq{%A$X`vY8-r&Be-Tc7ejH7&-4hskFLCbAhScZQ@yu}|mqYun&H63D
z)}T{2{<~cFXU->kC^O=tG
zFW1_C?0jR_8k=v+8eQt#Mx0eLh$h2mK$6KRz>XW>2G+j%~rF052MUiwpkux%jInE-uOQ3HLL>N@Cp}
zxr$XBRin63n`+_90`);RKFHw&cP|RqGba0*U`V$3s54bBasRY@{niTj@;R)jXElyL
zemyOa@0!0nW4`3KYR2#OEg9E+Adh2l6sPj#F3~SH_~J9Pa{DtUhcm6tU!L)7pvJE5
zdUj%d{P*49`y;_M0Y9gMRhyuEY4U8X
z=6E&dL)GQ28Po6XxTE}cNB{baPjZmy$?s0BPwM@nLHSN@$WQmdIj!t2Wz24?BPPe+
z4R1_86VPQWUi|L}G=F!5Sj?UIgUs9gpXlwsqqqO2-u%wq{FdJQn#@~!pViy{+3veo
zTp7pYj@0i9^2=us&h_;fNXES6+$Zz%0-sIfHS2it+4MIFR*n6uj!d6J>fk_7HNLi6
zJDlE~Dek>jxW7L-oT>E;Pkx^%eFw8v`s@#_w|3mQR$s~UL7YRn?1^jA9-b!c$;G5S
z^;>(bk7s4QeB74t_CW1u_?Qj&gZEbl>>m%3>V57=y?^%YS*trkx4Ub7cfh_i&E4>(
zOtL8_KM=6BKDaTUr+j)%#wFve`QbqPd^P`}z&+=e`S%5Tf`<~EytqRT26(amqh0@<
z=_{6Y{hP9WRlxtp2J%-i(V>aS{&F$>QuZq*zE(V9vB&1G2V|bx^{dm1rDQAiR=$n>
zS0jrnx{Uc+Jp4k&c=&JOp?*F2n=>ySek)_=ej;djsP&cyvEs6LSd+1a2RPiu`Y{bUG0m5k7VA;;O(_RpUYY!i#woC4)yA?=JfY#kuP-ra!~f>
zy0za)Uq1EycV<`PW1ZR9#L=D+(?_$%fBt+h;Nx^)?_=3htGfctUFCb0Px`ev1TU>Mqo|rQRAI3jCJiwr0)M
zq&ip=%m(7EI<2_PeKxzhRky949a-1>o-{o*&tEY){`Hs3vvxm$G;a-#_L-#lyr*|6
zkR!6q?KK$GjTp2tm@ST(I*3Sv>u@F=~?KyW(V0>=ChVdN%J^5<}Px%?gJ^Q-|
zlwW+HpC9V3IFT2%V4Z*X?fXazGgkN3?aOP+5gv<^({bg`6f8!*&KTq2l0aRp4z>l`0~~J%_*(JfvV1q@
z&vd{ayxte^VJ4`zsNRXP!B=*j$Gx10^`T%CXj=pJtN#2wd-T@a&uQ)a3p2+x4#}|b
zIo+B$U1w!(pZ_KE@!qdZ{!Hfd>7&&(fpIWUyJL~GM=1?=^oy=JHcK@%=GbGuOnxNBOTj
z>gmwi*OSqgoH4kI`n6rZuIs(I)}PY#>$`p?{oa7jni@1#2kzg0kAvRfJ?Tg3HNNme
zOgPyS4$n^C=6QS8DwdL4pS6Cj&&gWFTXJV*O+6HkZ2Vn*UA1DBmy-Q(*2#&jI3@oF
z-LJ!vwO2W?_p90CFCF-QcPHC&T>5{!+apg;8{_w7ug#l%ejg6XSG~D)`+PO8JX$lS
z*BJli<%@ipR~+YcbMHKPdA6?(&7a)OS9NpwKNQF@of^5)S9Z#u)74eURXlpS`LFSx
z4nJ@HkC5w*To)tT(r*v&4fwn}xGLbQwl$C+Z_oaKt(&_3w)8%uhUDpM<#uP@|E|Xd
zIDct3_CE6eKp;;C1NmXMYH}{)xIaF}f6X}@$~}Ez!Kb-(b6^J_{KEr16`Opq
zwHWXh+BodUKy8{?e6*7zWQ&T91Vz4WZg80gvAjm67f`s9wjqrqjt{ek8#
z(9?3mXWXz=aT>QdWPdu)=!Slr_|epl928nU`Gl+Gcv+i$9Pp7mJA4$EIotiXaN$hp
z&2TJNJo3$*+7%dI8x)t$f!Oi$NNvl%Gy4KpXw>Sw2)w$k^Wz(Bs!FKR^8i0sq|*{%D_R{qo~2(<%lv$-nll;l!_7
zTp74W8qPNbd@a5gyRlgNaqrApaqxk}EOs`EYh&@M2l>HM=`UT*&`~_kWnAw}d)8Xj
zhWeWi#5xmbwYUGo^yD3+quy(_a8mCVpN<5_0%Nk52e0ksWb3m`-kq;nkW+UQPsJa9
z#I89jCOYwOFtEo?|9+?u4ga$N`B9+JziK@CWPaFN?DlY1TpGj9t~Y-Fqs&X`5<}&)
z;;DSfiI^`9w4s>A;tuv>#wQ!?dt^cU%C`C+@p;;Zpg#{ImlgzLjOr!54P4}PdG{Sepc2iIz;<@jltYm;7ev^2k?o1GIPO@KDuCkpp}fZ
z1HnJWyHq~&SM$C-5U4--)%arFyO`%<{PSSd)bXqx3-tVdS@5>tHGz7z@(l
zw*;>a>P+ibaoIojvdFX5Kf@+01>RG5Sx~ZK)9f#&lieEvcSas(137K)VWubT8}AAJ
zXAXK3-F3G5vDm}Mrfxson7f7abngh*&Oa4%%Fm^vtZ6>K#YYdH@Lp%>#j*P??n8lk
z@-D0j)UC0a6_>F)Uq8>T&RE{31AF?q=jLm=Ih*Es`}{W7oAbe3Z_XEUy?ObhH!r{R
z=H;8-y!_Lf1AR5diMifd{k*NOdGY#n;g#QfvxZB5W>0JyANf(XD&~rE!8w+HeIKF4-;V|Bq#
z^?++JJ7aw=Ap8H7pQrk9;le%I8mM;-2fG7zb9K=Fj3_RhgW|^+XZSl1r~#as)7iJ}
zPC2tL(3bOIvD;UNW#1UsKi$t$ecNh#Dp0RS0z4RB5|pj-Pi+8B)Z3ciSioO8ZV24L
zrGOnZLl@L%TZUtK{%ZKKztHt1>pUB5SDeK&8T&f|dj6?@MsnY@ib1Z$+rK~mke`pl
zyEDLnnA@L`ircEUquEz;c-j=mX>sT*9mVrp#`V6*MV+-)`Tl?F&q#Q|1McKTtnP@q
z)ztB9fVWYgsbzd=_VM@FU@@?VyW-Lq`nh>uJ|FN*?<2`g>1%Ui+|P>`E)BG*IWp|2
zJ-vI_kGt-1`_5R?=)7n=nygcu<8CE-i(`7pYmwaI;+ZUJ
zHKDJc4Q9IeeAjyq?W;q*`1HHF{=)Qo1A4Ws0bQC}G{=*s24@4l(xdrv)SsXJfivgd-U~FI9M+3I#t#^X0`d*sh*dKoE4EPEDT{?P}0%!4~b~I~r^Vd1KEIVa`
zee2f;YMXCo2E|X=X>~axCvxlzn_|;&RP#BzPBz{TiLlTGd;<`~MLB
zy-nH>|Le2PhxV@f^BU?N_wJ^*W`CfGoo|&dZv`FdqByZeA6_(P@Ox=c@stfYV?%vj
zAE@1u!KZVjzxJJ}8j-_EHR8NlT2+TAhwyla_$%3Imi9UV9=p7A;x&}W?vq6PlJENhIhhOWIlnicSEGxqZ2?~BEuQAPu`_Z@FCFZ#TlwCfvBpkuLqDH}
zxS7uS#lhdl(4O>kjRNi3fPLq72b%-(i$VFC;n>bPgEan;=O3T=r#7nYGJMRtQ)l$@
zUp~uc^3Gbvk;YEF1;);4^t)5!^$!FUCmDIb`L4kC_t}7KeczNra&ogNme>M9b3;4i4{{MV8o=snO
z&tBalGX88L{kU!A7BlA)ECp(~xHj+K6@EF>>O7FSe4ZIp>{~PD!?8fV<)PLx9Q*OA
z^z6PMX!q0>-c|+m{gGXb|NOFEXLe+){Z03l*8ESpx$m#jfjj3C;QOBR*QCeS=0H5^
z)@KW!s%CxewdV!dKYwmyCY|RuyJzGaTT_AdV9>9d{yGl6DButMHwO4sJ9So0_XV1<
z*zx|YiQT!He?yO(f0?;+YH3ZdGjLA(qK|&^@9I#ybnts`PseQLt_0AWm&zx8^MkD3Uf(ZswWRm+lK%XzSBGri
z>hn7rW%JpeIF;8Y_2!T5%|Fun`+(om{e8gY554&L`cAIp=emxc${D%a2jt$^$+h|O
z_YC**_l=#LH@ob9e}0jr=4$dAGw+}Kp6(o<@vZmH(4khJlQXqfJk1ZReIk0~s$_mU
z^U^opt&8!evd#x`+B-9+pPy~t&!0S24S0jfC;d~q`G&5a?Rs|YU)1&94|DI6ep}b`
z#r%S$-KHJ>=GRecAEuS$|g7Key|>`PN5)v2&U?M=g*)Go*OWj^@Esqh|%=
zymxwUw|s~NZ&wHWvCbd$d^{jO3bdPpkwMyx!N?%3-qz=3OrM$>1)4Y9=fIhPye$MJ
zZ+>=gd*Cxy%}xcrxBOWK#_H?A!1$hSzB~PyH@V(Z|1WIZ6J8?A;rK-iDHAZ<74lZchyYJN4$^Uat5rH(#H(dNDmd#KvFws9f}OMNj#&
zC*xIdTpeE@+!v)j18+;uzklo;;7}`$j8Dgr+yjnUZutL`J#O&jbCyoEg+tA`BSEcI
zP4EX-Q8TV<+~VgS`#arhVslO4{>!sC9E5Gc2>tu8v`Es+{Q5}hN=fVzypD{IxzR+nmsZVPwA|;OU!+)OO{NH)tnlAW1!(tj;Ets4YsvZJT7H@D8KGSYctc6
zcG$SjLfV=W-ARtbhs(L3-Yc7f;EVHOulqz6_f-#cw)@93e|F$|3%d#TWbN@s4S!Y^z3p`1-}*vejZL<0
z4(!+4c6QGAZh{X@ZSZ4H@VM;tYp&&GDl+VTcH~CsHTQ&m_UyAycdPgDE7bdhMlUW(
zZ1U3YhG2<8HMYX7`$?aK7HB(o_PlDR7Da-gxZwzK11<2&7z(=#%rCn95=
zGwCPk#FJbSSwO&z6|ffL3?K*qz)P%mkV{`7_O(d~W6yL&^5<=rbbI*5WfW
z*X|281bun-TlpQCYxHjqR-2^VAFwZn?uA@yj4&T?EE&guE+}*7@t$n%F`s;PhUi;>ro4MROuZc%40Uu`selMcx4ku-!&XG|w
z@_K%7R^a^Yf!eG3bZ&h>N1eq%>zjRf5}WTf&dQ&&^_gLQUEmGVhIEqWmz?P9dj=oP
zmx7A|w!Mi%YumD}4(zQ9yf+n-T*^Vk#OF39>lz!y4LxdTC^q+5tJtP9Chz=gaAxrI
zfG+-;S8V*Maed$8kMlPLw>A5v?{vPm`dholqDyY&jorHfZ_twhIiXiC&ORUfajtw-
zd+b=hBcP{#FUsANE3N8PEjT+=v&XYO7x1lbH%nt*)yvL+Ubr%K{gpxeJtK08YkQ@G
zZ#Y-8Z9Qaq(l0!ekL<(Uf!Y@b9b~|FP46cCHwJ9Y2W;2cQ#0mA#X_#u)XvMJkZ$qd
zuk@;EpH-!&bnnZW#us(5I51XIZG3!gW2$k*wLbf;Ov^z#7O#2Vr*^GkTP|Mp#hw_%
zta;;R16*7lXyvE6zbjBvY+W3jpM%!%)bd?C;nu$+L*H`(Z8?3P`v~-HIic>PzMC`e
z`}cX#XMH99;X^C`hV(sUh5B%cTdnk|x$Kf`IPxwZPk&+H-r{RRpgofF-ibQz
zPH1($%^&;q?zHxwoptBS|9<_p{(3vgXK%Q=u&-I?ORc*jnsqj;v!PDPhWlbJ_RsCc
z3+dIBSokR?_UTi9Pfb32f8dMeoci4ptk0f1vMZ?XWL5Ldutmp)$gx3h|NC^SZ)S!1
zW(VXR*XYmo$?w&z{<(p3L;lVW$l-^LQJ~Q)_WpP6jon$b=sU$+Cs!Q#?0&TG@=VUE
zd49mH0l)h16t1g|{&#qHi(@|5UE$-MdQ#TeUg*+?Uhoj&0EGJ6Gv9*ZO)U*{j&r
zEdA*&p4Z;w{jw8sJpo{WA@=~;p!)XUk}vbmI!(WtEO>_
zBfyb&0~b{*6~CIrZ~0yE_j60na=EqN@?QGNPW{{=9<6v#Z*sFa5Ld-swO#(mNAc!!
zq3=uO*42
z@SVy;^Sn0qYes=`g
z_eB?bHTUN_+WB1Od$PYRhV|P0Ca2^Hk4=
z7v;~fwEI7vf0slI#k<(NDbLS(D>v84*;kXlmw!LIpOeak9FTLjef3lUd1uq-ir#mJejQks|27|n~XTCel;&joc>U%G0~T&sK*kENq@e!B0G&xZYh
z+QH?s!AqUyKP&|F9SFp7Fi>BIf=@@T
z@Yv>x%{EtTx4GhjdGX2@^Q!sElXE))alNPaXT-ic^U5t5@xCQ%Y}b5O=B2~_6EbJB
z_CMPFc`tMALz(YO|FM7`bz+bG@68^2&XdtvTW`;PYwN9jW
zHD{d-cJ=b8Cc$2<&t`1@ysr1_)8>8D{)TSv{H~wt`i)(`x$E6`I<|NH&aS^8y?4MH
zr15J$cvkS-kfZj#CIoLw?<}shtAa}db7OU9Ty>}}acGV^b9|YLchWvt-<#;fTY>NN
z?GD6*|5aUI-*@iJ+&Ma&!#$hM;6;8$fwncE&mE(y&XSo5*rP*U+H<4KwbqZ-nUiO)
zUC(rECp3<^Vbi$fviRe-rhifJ>EKda-klEx^zyUMOL3X4aV_@cC&gC0weo7GuOILH
zQ0I8`KJMz~_C|p=8vpl`dFk6FTlZxpddipOIOn^D8{b7fU7S}fsl7>j;A9kNqw#+~
z8M~=iOAjvkd{o}}+{)6ce)Vd%?#3u%Z8ZMxsh=tCBl)sNAHTs}Qq#phefe5He(OdV
zYoqahPxxPVuRY6GIoleX*~r$|Ti~3x!5!jD{p=(LKRd1M)_s4yKH#(1$ybcNZ_#PJ
ze%|rt@)t8_8!uY>Cb3KBj={YCg{=fBsR
z`#pU7JA<-+b$<41=ik+vpOG^+P@V&7XErzm?|m4EWBzI~Z0maXXB22^#k!ghvxYBmEe8GA>dnB*^TSJV
ziwo!b^0?sp5D!aPFaL0FOkNF>ue|v4`E+jy%CEBf%B&69qaBZ==C|`bJw4P
zR||IsL!Z@sxqBkV_U)a#n%CU%qk&()Ue30&TIp#&V^*SLl(TfKgoB-(EcySG&*I|C
zyT2-!lrQz(=j(K`?gO82yPWJ&_D7xEO627RFS7xk*ck=I0eg?8mP===zwUYE&wMUu
zxp?fOuvdCVIm=&hi(?W`I2w9mTRj#3Bt7-{wisPQZ{3=#``M1pRRKQ4?K4V@;=U%R
z9NF6y_}rqe>VGC#V=mz@wueN
z_ICz!X#O3j9Vdp5`JKGO>ij_Deg612t;`Sh=7%!3ez@zupzDux
z{Uu$0Y1h9X{qe|uKb^q~yY!u0$rfBYVDJO8@gy#8+KlE1aLf2=qE;@YknW6)^6&ZyQVk4v^RflZ@#TJ
z|D)dT@BL11{wuxtkN4(3)SG`xZ~hg%`OUrgvEKZ$-u!~z{PDfH-;Zo_{fXZ1{rydE
z{$G3ZU&|ct7d0IJU{B^9z4^cG&0pD@Uz54_(w)=J4&1A{%kG-b2X?&ydT)c?`>Xf9
z>PyZT{JNKZZP%+gb9JMy-}7UG56)}!R}F2Bf9CZaz^@a~>(?2s$X)Vl3mfv7cn?zA
z54(f>^j+|wKs+xD@Lq2w{_0KMmhtwW-U>0T54@W=ct^nAe87)42cOrCogwednhiAb
z-9f#T*1UaUg_(fOY0{_lt{&&isqZdE_#J4e+3;HrXC&(NQaE8ZvXZ8K{s+D(SPag4f
zQ!pfZbJo>LUx&5gS`E-4Z{FuW4C;(EzFigg3{3jR+^d19KwAjN9SX?mo#)Tqz~{d9
z#NdSiSvBQ6JUx*6vjSY;>dC>809Vfl)PZ#v;!rKF4%{g^ovZk)&jvmtz9<2(e>AAy
zgZ+Yx{hG*&2KJuU?S1jUo|<#+%7MKt-QHCLdr$55UOcepj?(#(fjzZh@9N&(m05GY
zUm1uW-}n$`&GA}ed-!kX)4jR-SNmVmj59p>F4X>F*5ri`c*ec^-sY=h&d<8MxPRox
z^TpVElhDR?<&e+nsq)Cjxquvb_Q{ERNREB?pN;+*=MM+Cx+h?_)uC3|vewG6*WSO9
ztGieF^z9uhIdx2@J^t}+KCu3#;Nbut8v=6l)Eh5;HGEB+#YzAFKTnQM^|d)rFIpS>
z>dgDGi)kgX^JOKmdnZ;BJATF9`sWS!bo*DF`-MUA=l!?lt=k;ncU!PM;E(+IJoW2s
zY}^@K71VpjKHYx(tlmy?_XN(kROe_vs#}s+*cl^Gd?3|W5mT!9{QZ&VkMl3X(gQD31@A7oh@HiXZ-2*RlSOf
zO*z10YhR3I-@9A(aj0&*J*VTPy&H7R+Co4!+@&oOW%%e|N(g|LUH!
zbzk|VL*5nw@!cL=6?lU$4qnlV3CI1Ivh*pOlbH+nUh*^DT2!7AU-^swA>J#elittv
za}mEU?DWv(^K(mpi;`oX&GO5;SGmT;e8A?LgQ)-)&XC6w4m5M{ImX87K=U~!7ErrB
zf90&@!hOOIz5H}veeSv!E(*Oe!l5A9Eh>*H#uuAurcUCD`9*{GbzhlUGry6cq_pEdJAs$
zAb)k^!{$T#tq-nedLt_iKvJ>WdHjTnJ_Z
z&3ve)$iq2-ddBk=!ApW;f$!9}cTgv|yfZ_XnCg=v?KK&sCRweN{vJ
zo9)iY_d`)$wI>Hda&4aJ{dCou`erj_a};aDTUU
z^K_^DJ$JaNJLUVg8Z16fSHs&PyFCz_CdcC8%b|c>I*f1a#s|{-d~wG9LV(Xzfkys?
z0X^k&Ysb0zS(HqTk7vw(_vMxVSMsK*Z(NifwFCTkZ|aH78q+f!(9>TZb?fwlIQw>R
zw^BRK5808Eii4fvA;WR*UY_2)*7*J1iGfVz;em|z2d#|1*S?jhcx$bEE*({CIGzpG
z1RDbNEyl+O2Lqo6m0voYwtRCb{O|*W|-S-QJ
zZ1Iyna@P098b8Evb=OaKy?58T7_SNNfj4zUr*qz4_i0C+}2ZUmeWFZ-3T+
zf9D5u(lH7&cbu(f1+PkM?)ujTnp)W!;G=*4?42FBS8`9MyOA`E^JacmaAm-zpY!Qa
z|K1tu`0MCZkNi0+(D+cc`Juk<3+&GawRa?A%~^WeSlD|Y
z(Bw*^mw$H#R|V4nxr(>^FMaOSwLz;l(=j)fr>}aU_wInsxj?%qxGmr-Zp2ag*)x79
zz>iu`^Wq~%w{zC?cxJ2R!nv8iJ=er|Ng(gI0I~9|>|dWTonp3Lc_DWs5cgD|d4tMF
zK8ym5jPu^GnSft)SAFm1m$~)>nLFFQAGgG@QP#X4?OAVcd-m?${KdWbWtlr)cU4?a
zTocrfo6UqDVksZ^C|1q7vn5x$%*h`P#8_wKjSQdp
zt5uHO(E|VG1MiZ%qP4oqr?Rd7_#&qAwQS>zyz_Y0x4zjQ1scDm#-mg1_4W7d+NZm(
z*IMPBKkgNK*4&Yjul1Vaj9mHa9Ut<$FF%T$CXRZKob#C{C;Y_4DA35AIUX$^FFS_<
zJ{6avjJ48Hxh2cyDA4TpbNyvmE6DYQ!KHzGYtHvMuH5$5Cvi`n9z5&&T=jFn5ApTo
zMp@JPoR%N>XzxM4R{HvizshZYf5ccCdsE}l3IA7;Lw=P0@~`}NzAaAl{VabT@w;HpsL#to7|=X)Hr0S$!+RUe&HK
zRPFMUPwRuH2hMuSUKT6{>T)W0a$rv#>wTa0XVk?w3N(9100qqJ+^yL_6Q{V$#lR;G57svY{KnB4f!3Z;pQk%>EHZVz9WOTP8J_g{IT;uDD|Wy4
zxHG8F1>EqX?&Ic+rvj~f7gNbqjN}god~VOsCGTpzxKJBf@jyQgN5{2XgnK^x`LDJRj^2E(_KMY}Om&4w={6HOg2M&!M1VUG5zFqd@DQvsN+6#cZHn
z)RN}SS`}F5OL1gw50`U+d{i#jXmjDb*79xM>gwmSuVc!AG`^M|JXhRRhxG=FS*zG^
zFEh@(Jh0Dx*~Z(dz$Y=V)EHG6*wcNTE8Y^9P!KN%C0~S(sO&j_jN(}
z?%isA_ZeAy^?mdnw*H9?@1sCtmo4qV6Ww^94RXb&-rAkPl>zS03|b#IWL~**wtQ)G
zpe8B~I{3ZPSjdk8Z8ZMxC;i8rSiCV+XVw6J_jhCV>U&4!yYgi&r*c!D@5Xb1y;>9F
zY(TGg#LYK6I*+H*^}8c86Yy7#Mu8><{%CZxc8!ZD@S
z55D6j|K*@|aJ#^U(R#0{eF#YdkDYSX@R-kRyIZ~axzGXWpT%5`x^pF1aB
z?;xGmb-g;l<+}nLvCki8%a%1hR2}F?fi@cd_r&)vx{AwV8T(B1Z)`87zb0T?3}r9F
zF;BOrcYpX!mKtbb)*5yYl7f+0p~vyknz4!yTRcq^Do=bg^G@Vp2D=fq3{uMr~P>
zce=zPzs{NS*SV1?984+!JV35Bp9`PuiEWSH}@@Vi^V6
zwL!&LvCn0VOx0VCo#aLgZH(gM|Bwz`iMRMKz2--Qn*%oJcb+bsFLq<=T0fRaT;a)m
zoC&rBUlh2DUlVAhhy9U-w8{_reB}=xw7OHqeO`xj;P^FhdO41(MsbZxH82;jyC&dA
z`ROi<0A66ztn*>g`%mV)PNs4!
z=as)v##+6DL+}4m_D6)$ym3?G(W!6ss9U2)Zf67UY1Q=5``NzFRg?Uxn$*|&&}YM>
z`dgKAbo0CJD8A^x2Oc%&*{l2vak!ZMN$W%TY~TJIJ((}E?!m#Ja_4jKSiqlApz#HF
zl@GStbEC|~=KF@c@^9$8cct~OuU9@=z56rQ*rTt_*C=yM?s0o{fJF
zywYXmzuvl0n(*DtsM>UM+SBTV*POboutxJ
z9Ej7|Hg0qF@t}!&WRSKsP!rpN?E!zM0(RxA`Zr{JRp5SA?!BXY=iNWH*aUKPEd`^1tK>`v0F{@5)a_`Vp(0lrc)V@`1`-xZrPqd*%4
ztzX5fvmhSl7Xmuf6fV7qbHSB?`Yu`g$RnL(>)jt^tl-EuB}WStuY8aoAX+20X3`{Q}jD^_;q1Ag;MY^@&qd@7zw55DhPMo;A>
zVq?ARm2Ud0{`lz4vu2+U?R}F&{N5RU<$^DodommJ{jRrpls!%E_$rPzF8)R3DLk6<
zfv**Bn=iK6t-bXb;}a(v18>uspr4zPHhkEj7@SGn7+GzaW6EX5vO@i}u?+D2M
zT6kwut+x3ihp#r@Q<;BDYd=wM4<_U1FLdTH;Ox?op73N-r_k8`6y
zV^0o-Vq?ph&4E04XR4m$zG{9=#_PI0^7cl7M!$Hq8u#@$b1-0MDkxv-oVf8zZ^b~i
z^_whsdtcFw$>N~u)m)Cw4F0UCA)jM7VMlybcO}m!|G&SgIsVNB#l17^=-Jn6a-fc!
z+ZAjKoZB7ne>%{dxnMjxp@-fVkLM@;92QxPjiunmKn)xT_-?)41@_q2R~!}pj;!JA
zEln(Se|+cU58wER3m663X#C$3Ib4%*+4GjY{>;gr6>^^KQ*!Ea>-hm+dq;rx^8IfL7~BD5zxpGJXp?TK#i|8J}o%AW%nL*cLer+KXKH%*y`MpJ#n^r$XBj29E^n>GUAXAJr3o{dgV^+-b4Fp08ceHrU#6x
zw&-!M=7YMsY*dc$LEe7ZG;eKsSIZ_{HE-?6YjKYob9~|PC&Jf|J)F`@kA3mAJb&|q
zb7ap7oW)Pg%igPUj-EEQdRN5G-YC$l(
z%(#5vmzY-t{22vW@pDba?o7g%_=en_Jshbg9Pz>U-hi#C05^313coObQHH__;0Ul)j76Cfrh8DL%w9#n+kqxf<4^vm;dU7y!LI8
z=S!O(a%>hi&W-|2zFU7r7Sl%K|9-L-#XwHa$F{ccg0Hql*&;($?YM{Y-JCy10`mAG
zs~-iLntfMrWj|ZA;+Zv}fEmy7_{a_O85~z-OMf!+ynjPsVu0nLP7{erM`EsCqEJ
zB+%GdH6ESFskemA;{ko6^jbe(Yy%rh9q6svo6VS?HwP8780@PParv_-c$f>s?6a(D
zd?;qJl>@S3)YM|VTWd0A53lD3)7==ihXecU)m+clvVTFwlQ^Hx-eMpIzTkOXfG>48
z<}Cf|1F`cDpVtPsk_-0afe-cWw|vmU4!!pV>Qt-vCdFO*>auT#&Z-ysjQQpazvz@3
zV|$vKFfRM@B2M~^)qd5}C}T~Hh-F)_J)jTBIy(w9_YA65swRq8J^OXP+>afBT)sRt
zXjv%z9eagwWh$A)?7vhM7=0m{H*!9JQv&CoGA`2y}ukYAwZVBW}b5HoJ@rgb?{*DGW2W0rO7^v0h;Nsx!
z7}=BFnNgr!d!jq(W957<>vWE~{qjeAQ8V~+!6f-JBHxb{r{t?w>9@>w?Mr~3n)9=uf?eHr$P
z+aVb>RD7vH^&m%L6w4^kaB(P5V`6A^t+}-WbdTLtL_7IzNzc
z>0HeCrNNg6-k5vNJQ33;GF}tx2(%9;U+zr#U7WJ}V+7LLaqZ7$z18FIEo|pM+tb_X
zXveKSag-lqem2nBaVzi6wDPC(SDZTooWa9?dE#fvcJ0y-lCAOggjx@EkGVDL&OAP7
z*Z(N%#pUa|n0>!!Wsd&UiT|%f`MQ+-8uRIKfxFQ9Ht>JE=^NsJuY?i;Hj5RTi
z4AMs9|DMQ=&j>o&9F(7}@9ntu#o=7#a`!TEobC>|GwK4zKELQxYoFceEE_+WUlWis
zZ+PYMZCPvm=j%#&t9n=a&iOv5R>judhe_k(k>g99_p_Ha7l?(g^!gsD6=!0t7{qy9
z7gt-0Vk#YCRge23*Vf>k%*kx+WaYhhnakeUnOAL3cQU27YGik}{*3Od&yPRJpM#@!
zd$)#@%eyuD!P-pL`uZ;H_QkcjJL5Y=oq2!$tV&2s2FM1s6
z-EBQP`gL9JGv8cI>1VpW^0Td*%Zq)VW%}Zi&*sII?*QgU0(9)0C6KiNGi_{!)lTl!~pdrIx|I-58gI=?FG
z*MI!Pd7r~{^5vqe75C0n&6HnNOMZT`@8=}F?}K`O&PczZ>xG~IR{pDR>`s&<^y7ep5i=Dqm@|R{8?|U;J
z1)BHHoNxDr+%Hc50!d4we-b-xJX7
zKFF<~kHzqF!F7Qg;z1nFvT5A@`k$O>xS-FOR|S=0^4ACKYifRdpl0Ng9A8QXAKwsY
zWN|?^Jy!+%(X5HloJ^h1@KbD*ocb%d#f))#MjUQ=nY1RbK2I0seDPHL7Duhm-dfF?
z_@;sz0^G}68$Z9~LhSB=_x_3i&+~yhkGFc;D;{;_uEx!=pZ9d*bDQ-$GL~PzkIhb<
z@#`Pn0Cw?-CppryY3v=ZeLS@La$|24X!Odj^?nW)vQ{?qa#Jy6IF@hs@mc#~>z`-0
z-Dj^o-_{?$keF6UG
zgGsXD?#osURJ_j8)7mkgWM@cr$PWFLdp6D0``*Ca({Q>Ycy^#ZR?`1d`dha3YC`_p
z19jf6Wjg-+mRrpmv~D~)QH%I;CvOQpH^BALK;7OSxZ`-%?ClOV1@5XlUH8;oZ`ZeG
zu7>dHv%)*0=GZGcxL0p#%J`<>wt)SI0&+)!4S~ElU$tS6E@$Oa&Z@qQX9B#`J2grF
zC6Sq=U%aJ%I^!Yz?%-5Vv5AMRF)tyYK9hbrJZ5>!AK!Nd_;L0dvgf;#b2zl7iO(88
z^pz)E+q*tc$87iaovHn;8Os;B^6&19)xxS^F(AVqjem0B&ag$d`OSedYK-hS#`IMa
z{O+&MX3cr^GzzrQ_`fG?@@reLJusFppC@?7cl$GhHBbxXpZOC4aq&mJ%0J(WdpTBr
ze51S0lDj(KA0E`vX9Z2OHmBEjMx5e~zCd2WV
zUlmK$th4^y19?8p2CdKX(aQS!;agd`aSk_Pz}=33t>;HCj;{#hc`m4T-kEU>38*-z
zx2e|Yx-_7R{3y`226D!a;{k%y!9xMLBZ1nB`SHK~-QT|?dlduy^x?Ji4V_!ce&5#q
ztZD6e_T9OPyS^*6Z>l<#2YIbJ?El_o>6}!fPt93xfPFuM<4*46gRQb(ypQ?l_Q+{%
zp4E5j3*Y7mrSWBIJUUU++cMrB;7oh*_`fIqY#=?>@o*p*1)BLnFbXs}K
zK$|4{Pi2=+l~Y`cZ*zc?#h`MK;mPk_J2EEsHz_9f)m(dTZ~nbqjlME_O95T&JE>0O
z&}Rc3Y~GeLWbrf`Xn41e)1y5bm-OblyYp(rdAgi8Zhd`A_iI$-%7=Ob_3Z1t5qjXm
zbZ~3;>nHm%*3=pszCXMnPI@Q*GJWM#T;MJArd=F-dG^`H$*y33Fc)kH@Nz8hMl5u_
zG04?S;0-0SHBir5<+0W0Zp`%dMwwTR%f~aa2I3Z{@t=pw_O3Zowhm;xK5#erxF@(T
zFSXXj0wov&QR4jQJ`nWJR{UQbh5NFvsedud1gnDfp7`_iRRhn+-dvzQ)vkM6z>&PE
z9e#gVbFSWLvAsEV&D;7=SMC*GanY|yaj~fvr+DuRG`et69PmM2|3&QZt+lf;bNa=n
zsYmkc^SN*L4Ozp>xd9u-&WhtL(a)DwKRx)f|1X!>r>kNq`_5_Y=Z!Z<6B{|4J7zyZL(iGAiE{&
zWQ+HRjO!fFPYdw)ud_JxPLgH!ia?tU*!e%QA+N1Z^O=*UM}6Y|=O@(X*DYhuc@Q%_
zQ^D8v^r!)`t7ZEY8=Jt#uWxKr&T!#e$>YWOgMk`95ZoDD8HmL`o_;g%Hi=p876R|z
zp@6NoM%cXNVxm2_44n
z51)L6$CrFi9fC|-5{Z$g-y($(gU&1{`q=gZz;HdqXB!Z&B|c3~i2s{{U7
zcgDSOhVS=veZ4pLXU?`a=2#$qYLnlfwko&Iu=#?3J@J#3V|=aT3~u;dcIvx3+w}Ne
zY5$sFYk=#DgAKSnz%BdqEd<`J)>rr88$w>?sO5EI_MD?jdoW;2Eb`=zOa-`C^Wq=6
zAL;?$*HC+t$V;5-=`
z0YCYxR@EZ{+WX8Wek=v*7;oj{i!z=Ga7HIRxWiG&S8dc8IhhHZ(bPVl#3Po9H^aw#
zh5w}a`#dWyxzG*?t(mi5^PkJ_Gq>lzy_?H98Mgj;)>@tZ4LP+^I^LbRT<;4s`s7p%k&}OG
zdh2?7dO6px4dj9yO>BI4R`AVnLfo$i8F+eI=1)mqImPc>psf#ZrB^59ykF+t3-!CP
z8@qGcg6)CvGXu7!(=P-s3Ea(Hfw~s2Jvbb&qn`NBZ*NS^#j8GRes;zOnmHcWuzyPr
zH)VcXFiCHnQ%~O#fAQe^gPNEL_$78e@`DX|Fz2VaJ8UkN^0DGt-K>!(hr5!a(;6Gr
zCi!oj>{8%63ohxI#54PvxZd82OMab`i_JmhUd_w~^d1WMGrptue$r;jX8h|&*QS@p
zCj^TDe%YMVv!NdHzcH`kt@q72z+<80@i!C5gINA;6sY&|d4I;@q02fwc#>DO>dd$1
zOy%FX`hGZ*F}?k>YOBtE+ao-yPV4NqKf<#(ue0B=g0r}ioZZ6zAon&VT2l
zIInK%{C7Qy^KxD1zxz>~$3>n0_mASd`&sAz!=pH_?!1v|?j5H&@9q7b$PCpo9^{ig
zcW^1VGpHKADr4v2d!s`g4BZEJ2`BYF*7^SD2s?Fe>&>6ZntVEs7k9$D>+`i_`+c4D
zwmZ9&&qsb;5r}gx;PdxQ@VVX*cIq9_(@}57#*Ede80h*xqf5@(d(DpK4Umg>4#>=B
zz22XxjKx=qBQ^?&KTC$L}Aozd7sdZVR>tX9VX3aw{L^
zeE)%*WwVWMOXmFA8n9J5tihoGhjf|C#lfKJNIu1KVIVF%$)z)RsMwveF6Skq9?06s14%ME+RVo?v``MG?Dvj#(Ue1Bnw?jMS7a=yE?vCm}AAO73p4;w@Js_yCg
z;ZC0z`}%OC6<>1pA0zL3k{p@;NapnXXnOIrI_5i>AIo0d#rlky%U<1Q9I0pL0Wb7l
z)_u2a?+KsyBSz;H;veBq<@ZDZzi;cO*(etZRbs@~)jH$Rax#p|xj_Xpx$
z4CKHYc2AHnKjqgx+=J_a8|(+k_qwl9O=*P%+IqmcD(*v?|ky{BL7e(%o@_{!zh+WKT
ztN43e#zP#cg_c9}K8HV(I36vBzcj$%|2@FV5QlP%gO=}6<~X!>Ea3Y;3&j1j;FdtH
z-BE2em~`HI;hbK4^t?KFw7U56NY7W?J91Y0nef%VmB%yZzkPMOF>`fW^7rSnbt!W{
zJAZi~?w<|6qx7E$oE4k9qIXWMzBNBz+JjM`sq?b}KOg?5=))d+
zeag>=K8NdPLbkj+?cET^ivzbRYRCI>xplmf|D-uzwR>a6YO>w;-r>pHNLH)0`X1o-
zL*0eBzQ3RS-Zc8jT_1Q0%IC_3yS^bH$7i2OE%;F1w`MYy
zNAh@gmd--STAvB$^G*uE@B)GvZP0w{maqafR2C
z!(Hj~|K}}E-34-$-|~}gXVwS&C*#hDac^KvcHBs4Xpk8z}jyNto`P|
z+HVc4y>DRc{R3P-7tK@Ru$
z`$&Fmo4xk!=F7(?_#(dIwAD#Reg16Bm~J`W7Hkjr1bivZ#qNE!F1}jFm$>-3B@j#8
z`IP$jL>Aln_}k2#mA~1bKJVo9@3O~VdElS#PJAi@L49V}$2Feiz?EUxHt2H)f0-T7|S+QRj;QD_=R=iasY^lw%Rr#g&e|CELXkA}s9O9^2R`
zTYX;6YV`S@R(a)fw#K<$&u$?8)mfyY@@HLc)EM~#0eQTWTL|!2bzyxbsB?Tj7U=Q0
z+}Wh&WX<4Wy77hY>{sp5PoB?fvcW$-&j+>sSrgXJp0NJ73G1IdVg2zF)}Jt8{c|R)
zKXJnPIlXl;9}e{RY$5g?0si0AeV4qVlbK6joII(~S?^47nys;%JS_!x23G~%DK+5U
z(Qn@!!2P*7`uP*qKexA@>B-NKdMm}gI;hz3
z1MSaBTf4Ob>BRwRem>B||9Mf~)?TeYrMFJ^LO=(7c*UhUe`;jgH+_BP9ep?r_ZvF@1+DtGf)TNOB8y4GeaXY|llzwY9Uda&+{
zw}(&sosCX&du>hdTa4Bwot>L-mJj;^jcxVkeHL5U=HK3cKU#g~U=vqSJ&wy6Jn_RC
zpXW2cchxC*cgvc$Z9X7t4Uc?aziiX7F#^`;*cjl0yja%;X9evUXT8OGeCu(hXIC$`
zbZ?68TBm;|aE71uH)o$;-r!vUpXY+U|75pBwqkV$_@K3Qf9{E;F~9Y$=h*n%Li%=%
zEqb>`pguRm?{48hn{;Md?~EG3lh*o!2Tks(7TMgM^XwPrt1_lTW0TB|Mn=43+B=`=
zSZ-(J*lBB^c-oP5T)%(dU3GtVN6bnrtR
zYW%n|;HSoCXP-WB)*Z!_*7{bw`~Us){lWY0o-TgkKpxp^Bm9)X7f>dFep3iK7KTDjttUpF)~PFPh8VM#l`k~
zP=`js@wfLJN7ltl?&8Q*&e-Ei?YH-W{%yhbfK7NHFpz8a
zaZhxKhrP{#`$Ud@wzS!x=Jw3(Ju_$d=IoY0ZIr!ijq8Q(g@7-7n-A<=6^O^!K0QG0
zU_c)qeHN<$e%0qV+n=97es9IN>bkn8D34hI
zi!Hq-4mO^XbNKT6v>Be{72nUz!q)UDqj76LGuL)&VsPHCQ#jA}h29$f*?L|C@LKjV
z9LI&bifhu@y%WyjQtfK3f9>Z)<&_WnqK7|yA8=cF;RD&xfUI1Tt=hp2TovFY#75>&WYp&2^n5B=cbIJX
zP;Wio`RMEyH2V2jGUX@U>-^;zi=kb6PPc}mvhCf`*yj6EK*u`*v0JwWHwN;wRzelE5B4uj=$0U(wj&!+}ob-mJ65-&&`0A@J7dacJx_;+X+%4+iQPs=f|&
zV|tvk?z2OWC;fQ=f7FjQ6Nm}d#(c5=hR$Dpsa>|$26EN6&0g6q-`Ogh+l`&4+wYHS
zGXdL`L*q7Q*JaMWbvB%p`%8mb=bLr8JfmBuPY$jLwg!A&3dsFMgy?b}ccrszRqk3l
zsOsC01AlJdjnOA3`(mG*I;!uLGZ_ojSv4g#c8gEEID=339*4JfWA(wmg}|LT62bD-
z=ZJCr`KXzU9~%^pa{20jU+)aq`%L+D$s_dZ1)X2+MyMP6CC1`xUB+td`GH&%4~M(C
zw**h>8gIC{^fW%m6;9+7C+?iqa`M@ks}uVCeO!~cp3gpA?jv1lx#Fl8T3s((fi8A6
z{`k4*vM8kU!Qe}R^5qp7ZwmfbdtU+{$x+_hJ<=Yd^@Yv)K3XGU?MM471`fwq;hm3PWVB*M4HSiX5-5+nLojWywp#F!c;H&
zAp^DLZhYxOYaVj^9}p*c!aV?7(x>1>uxkOMveQRrzZ~}<;8bTa?(hP*hXQa9FMxX;
z;G|=+O)G8wq)(FN`UPli0G#?gl~Kj_L6nK)qP{?MH!eVT6X4V*2v_8Ba{w-tQ}{*1
zKL`G#Cz6wV0{XP@8?#BmFCqEKo>SW+*~s2}4L%gXx_#FOeV=>^2tQ1oXyVI=`LUayu@fZmn^08IX?liNl)A0Lcy3x7?YD`
zE+s=oGHD?#!${_HNk@JL8BJ$0GR2tbAwV=?q*8?{6pyfsPti+|dvNAYbc|_)2
z&J~SOGf^dl3-vRw)2i}!p*}IBBw3nbI_F_tGID*@069KlBwXzxk{ma3V`d^_%;d|q
z3JF>;jgrYrh-fOEmBWd(o>-qJw$6#Ubp#evBQ6=mTr!HeWE2}Sb7mo(bXZNKMFRn=
zDp_;oED2b2kPBvU+?aHwrwVklrkI;G#oVkZR-JV*lTJ#!M7=|faynPqOa)uJ(aGC^
zt#k8mU>nz0;UPaCEnq%cz+BqoM5$mT%|x+el**#i=rDa3tjb){+W-&KzDs^OJMPn8l(G
zmw?rXxqQiommh^vq%t!BpgTDOS>+<#TLekjNi&_1I}df1oSA{WEG7%-$x^<+Stm0_
zv6vp6@!-npg#nu~3#CNCIF=YO>>9LbgOU=(Ox_kdnV*~~rpG+Jyvl?lI_}Au=~iwJ
zygz%ilS)s?G^v?fCY_rgvy+%Cq_gQ#ddhAaA}N{47hx&Vw&fFG>aWRipPSMszajZFeupvvj^26ba%XUsPYAm!m@@pn)f(OqxnMC@OTb3#4Q^QREc~(k+z+m
z(Sqr%q_HH|kK{=)P&tPhusa$6qh(ZG*0@cWBY>O|Av|8j06&VVAN3J^P{RRUa>C{yC7HRY
zbRnP1qM5si=5*4WB=@q~ni5ktF~Hms!dNChf~M?tb^`LUkCc-WqMf)rI>5R<8fXM6iwXyir;emc#j4`i3FOGggdR7B<6vl$
zF&rC0Og#y#i^`C!s5;IlTegQR9?hAyH^rk~Z96aoWR_J(G=p&wb1faSe0g~&HM+0&Qu3eyWbL*565V>}FG=QI6=Y&+w1R%*R0Z51jAorqX<*gekw>mL!|nz}5|H8pLG%WzFnlf$7vJ
z2(}I=Z`*FHOYs?I21P8{qZ@!?h9za@1t!Gwl91Vi#3r$Y$v|f`)FujWbJAHefjY`z
z8f+VWP>p8FVmK8s8cj=SG4%zMjc*P|KH4E4+iD90w>dkIV$z^Fji@ug*(}GMFoMS6
zTb<;rzz`WmYP)1bFf0m9vJ?#CE|YSJMs;cOLM5g8l_=5#?9t-AD+SRs_e_GSoC}f%E*I(yUJ^*SCoaet
zm|PILVqjSSciMsn8&F}AJ#e{`O9^(Ta3R&BO?8Uo(gY?|jXDyJ7SX`mLU@=spp%omljdZUK+V5o*#0U3yb*Lytf%ky2l8=-}N5wenOQVG~ZlJ1@q~z6(f=P>kWRjDPNh+Ax
z{FLe2YQY)+YRVX;F$c=Qa!n2sX=mdE$yjB?Xy#uyEMOw9
zV16&MrB!EnE5OANrqqQ94@N+I%K_d5cU8cKS9y&R)Q9R_CATqQ_$6<_2BNC%vXn(m
zyiAuOYfPhANR{N|lP^*ZiR8@KG2yVdWOgE!OYH4NUlNF%>T!6IA*~X_oHmnXwt^$M
z62#4%cDe&%STcn@n})MyTR%dfMIf&N2?8~ZrfutNV;ya#jZZdxBRjR|S*lSSFa02hVFSznX@P8Vm%yynDK00U9KdCedE
z$w%;jr)O|z<{xmF0w+AWm#Dfl;1FT_a5{r^61dilwWhy-RY@xk*$T!ByKkgdF59O
z-gynJ{?Q}|#Npub;`
zxJ|kHM>t)94}~o$Y{ONCLr{kS
z7ix5(ZGCL*+SppXa|i}6mNh2(x>zU;VfxmvAXZ9JY+bW2?#7w>-`8sc3N(E8^{^N>
zoqZKu=W*B-%=uMnBodvrFgFr4B}vD~-3{>qH`@Ok_Nz@7zUBXpCBdd9+`{
zw4Bs728*Gw!7to1%;tfy0!(qqfb+#xz_m3RC-j2DT{d6*h}u9dcomVo2v^B!0h3Lh5VQe?6fK9e29Zf5qrwq#gPfJ*+!*J
zLI;&1Hbc1M7~(hDSm@gh62iJu60edS9548HRri|KYwL%rU+>$82@#gtV(wN<0BEhi
zqU|f@r-Zu%$eEY*YmPnjS~-2={*l{ad$6IN#YmBhvFgPx^CmCY*)XqyW2}br0{jhL
zd>h*Dh0<^dT=)l*)dY6ZdM^P#rm%&8tOc=A4caNf(v$16aEdHsKx~Cu`EL8H8EXvgKk4MsLd0O5-q?aC0=iLKL=nF|&4J^e)bu
z^lAsGTXb?LD#Zqp{aR;RRGzjgUn=FZ7%x-wy&#chPpzRlee63178VzG51bD+Y2_Xp
z|84;0JJ@Ot)S~R!+Z&%=n;^^2et0$*zw8eirzkIcq%a%HI8>3tJ{+0PJvIRw2kiu&
zUrtdeenA2OLJ|S6<`5@Pl_XO+II13w4xyG|ZE0bq06!#?sj~KLq2gnjt}E8Zv;iH1
zOK}Dke_CVi*9N;14xsN5n;UPWQMkVfN~v(|$zOxlGEmvYoRdAe-ZyNPV)oP?K54?t
zl;)8IhOqfIbP8&Yp)Cj72@6}!3*D*fPX@4=Z$lepP5RAOfn_^k5t{|>kcPV{%%_X(
z$xfDL^!`B{0!1S*3)qMq!v00f@z?Yp3zaha+-F+AV6Tva}Q#eCxmRe3*RD^=xVh=o<<0mPbA
zW$ua{F0Y`fn{PZ#xn`fyvOHmt*Kx!SN1C0U_1Y+}W0=)aDN*RU10CbePbE9M(lsSP@Ar>PCQ
zZ$dfLhCR5Qp*CD|WWMoCwP8PQXQ>Ut*GHn|`Np%=<>&6+asbXlX|!J(F;W@~AiQ(3
zg+(FElJKnFs
zHsZ93Mzd)xn=T@p9M?w7(lOJ_X^-o3Q4JG31oZIQTB)MLj3zq#Tg_@snopcWi6Hw%
zSnZPQC~G({I${>IC(%#m*7j&vcg4XCw0>EUfvJfg$F9HJ>7b#$;f-ad(b
z09#TS&}a2dc-KibJ$p!hXrQINtG%VY7vDI(UG2^BhX$JC63&1duFTb0mi8XI1asSH
z4nV7E8m)~TGgBH{qGm%|`*Cw_Cs0RB)VZnIva+gjMAgICMrHF)p~l5jz|}#p_P7G0AJH+y;J1gy01bhy1Ny^v29~a+U!%GRuW3gu<#VPpZ^MjhvV=NI
z=cGo9!KB!u;fSAh+yvDIq+;y_9T-g;+iy6o3G+Zr`gl$cV>;ujy>`?=eHlRs(ZFn?
zsaRl%x-dP(Kr<#f*H$W$eYOd0&&aU`n4!a^OjJGGA0Vh;5rqa8B*z*+Dm|7i%{RVX
zUA6k^Kykv&{Tfz6KBfP~?o1(7<@Nsq3u_F|nZ+ySH>cQZ`E@tE+J=$aX+$K^d
zmf`4Jaw&~1BaQZa(6r~`?SM-fVs`$9fRYE9Q8I#2Fb?D$O;)p};h;{t#>J02)z+h7
z`5{GydS`tyih8#hLR8eYt$Dmlo{+
zOqIrqn2wlew8iq|WWGR66m3?ECM6%BxVenoF1rC^l1(dEykXZ}8m3r1+*_9xD|4F#
z{z!gW6DJ$U{J=eMbWxoKZ=j;@)|y9}$6LnpQ<3qh=BbvPk)yvmu}=@}z0!Y!Ff*FL
ztc3@fW3$RwYqUF;YK?02)16CGh&;RL)@Vy^8i5-qa03E)3gi(;;Y%oG5M+pye!4S6
zN={*hNHZYK5NQUa86wSqGy_tGLZm}PN$re=kAI#Jc3fp94hXv7y
zfy_2568KAikxeJNu^K5ByjwbUcDD8Qj+>duDEmbb<}hC`=O%LbV>t~gYSiZ10c~lI
zHR)TTMSo(nh$Nfv7}h(+9QKT`yM3$72mPA&tfB_45ikv}C9c(!;Of#L;!s74JU0x4
zl6V{1wH&rv(6@6=_Qbn|cndsY6M#jsNBV_09YjHy%yN~?+6n@eUCGC<(!sWgCvVqw
zr;C&LyA;Mx
zaUqsoR;|LcLCqn&wc|h`KZX)|!5-MiGZ
z>Hr^|k&;&=k-_terl82VwT}J5;U6ZUz7A}JQ4_$*-1@`5c1dOcHL)oug|+SaX=rbf
zOagC-d@oQFdx4t{V0RhIMjBfUz=T$#jXyIL=i7i}eL2A00fc8}?*M9i2e5K{oO}Taix<)mqRUSe$M%Y>lY)FjvdmKOG7Qy`^iN0ocdJHFV_{u!~Z&4lZwbQWxkJPvw
za~8&Qci9$uf&8P|p3l<*(qgO9a}Z-s=ZgAAL_pELwAN&KJ=w4LJjAXlA)D1ee%)J>MvZjCbadbXKoC2
ze*EKoq5k`(a-ogcH{KVz?BnAscmff=Im7%k~ea$OFXB%(-M(B)VkWE5LhBy-
zP%5-t|4vuvv>V^DJ+$hLPk%7f`a|pDP)Eb_?+dN`-lt-rGY`i4Ld&+i>C2(!-IbwG
z(+{`(&yf0OmtPRt@S$yA2z4EP7xKve^LVK3Yj^smL^V1BnlQhxm>0pdL-=5@a*vjDp9fK6a
zc#Tn*9~65UeP}>mxV!d97Lc3LaBF|lK@-OY&0G@uEP0qcw#N>uF$Twrm-|*&N#@Xn
zuUxc0Ytd9K+?WT5ZgNCX)n%%>9IMx=x>8lcs@kNgt5o$gRXtr*&rsDfRrM@YeVMAB
zt*Ym!>dRGiwW^-0s^_Wd`Ko$>s$Qr+tc@L-ISr2sKc^(Hspi~iBhA$rC0NxZ{#_l{Hf~oe^fUwA)QdRb)
zbP7{S_0I4LSny
zyf%b4qPcE|R0OAM0N+b+@fbZ4<`R7AekKdiquDODLxguRQuya$yBz%CZ5)ptqCyRR
zwUfpl=Ot)(nut*vQ}yXeNNrSA5Qktv&Vv0o7e)npL+UQ&OxTF!FfEO$rmTWZIUN=y
zs+~%VA2E;cA2#xe&jwKPpwsGH^Ld-C}cTgi$&l*J@=KAcD)q2n#MexAPd6
zFmi^;a`2iE_u{Q$c*`K?g^=$|TdGFLA@I%wbtkHFgK{C{;Lsh)YDl;Ya&TGkb}#JM
zuEe(qIJ65(sjFFta4403U_F^OEXz$LYOW2DW?3(HDDbo$rYXUJ(!%dPRG_0{huA1%
z-|$~GS`Nd%U=G1QQV#L6xQDR(r5wT$xgi&;D*@l
zuyP199FSy
z%|&eo`&L0vrd$JAm+!#XAGxa?u6!-X(c)dixK_DI>Q2G;L{hhF>)4;{v8RunL2Mte
z@>k}zV)2z#Rtl>%$JpG&(T=`YVjw?ly(beoM~kLah00qNmR&Jn%tGnYn*Eoy{wD4q
zL22HJlHc=kmyp5>vRPo>M1B_LOtB_y9Zp)9g&3W;z44s`kD1}JO%U@*3Uzh
z^-FL#zhR|vBjdG-JgLxctn))Xp}(H@@JNRX2sl!xs?;)pIdvHerY{tovZxX
zdL9^Cmi@;1;j;5qop;)Kr`;d^=hOcA^j}#|gf`&mhi_CKJmVG0+{#Bo;fAD=RVlxl
z8;&Zk3jI^4sB8_FxSCv3=MP;3A(mmRT@ByJf(PKo5D;=2=@RjvdlORWYgxkmBzJYi
zqBIRGmH%>{0)Hh^$gK^^iC{b>Y^Mjw9$Jvr%ag|12%5oy9}OvjghE_dZbe(V6CPCkR}(sQ814LJ
z%vY_S{&aY%=fM{|AD-ToOiix`$7>m6Sb04lJ+MmhMc8+vf!wd$gD;;G(L-~^wB}s+
zc(q);@NVU+KG|s+bTXHpJ_LUB;SH1p19K1!ZeffQ$;By20>2a|qNQ~HIS-HJ^k1Er
zdsJV9PZLb>p(cMfi`-*_EEr|~wF}O3^@WFW3pTjdBCU&4FTP7zPe>B4ZV7olg2Phl
zXANe9)fZU`{=ieZ%c+BymR4W%xXV3N7tx82Outw0UIK^i_2}&^Ja)A{{Az4}er=F}
zzWmdsJXm!_F)yvYu4TvvrFJIT>Kox0$QS1t$BexC5_wWzZS$nsqTtqMFRut0cLLUe
zHIz41UGxfT_u}-ln!r{RSd>Ed@&xv~5%X>TCHI^C4DSKOf4OWf$7|23FE>xhUru%D
zc3>rlK3v9r7T&5{5pa3wWei4yAIo}!;=is^{1+aiE?xd~FGTP^zyfj_x2`fo;4XZx
z51aTuHF?^5e*
zsroPDl@8@4TnZ+x!Jpd8OqhP1*GE4J9^NZhs%of-*ILwj2_7Z__0kf48FVkMu7yPP
z-s_WoX{B}Z@Y9p;>ivwtnp+nC^`->Hym&McxSw%0F8DR#Vo=DHuJ(}NKoi*7sa#CU
z8u3Uf`2F_pu1vLrmR4Gqv!9-7nm+v3Usu(TF}z@<{!4J7KZw;&&HrXbJeF!(7a!Y%
zbhX^;lYVKXb@TAk`&;PA^w;}6y@2}boAGe|>dTv_oLY;<2uEkq{q&Y~hf@C~YLzyp>Zc~Em&&I;>6cboHxEC(zvcb5``=P(
zLP$;heQESBmHu}h6aRHJ7Gm+zzE<&HUdDcUKg3H>d+aqn)K~i;|Fr@32Dxaw?w!=a
zD}uJXFJK$w7vKb(j;(S2JB0Lu*dV`9IS5?7MT|3Tz;-`$u2o~(F|F8=X~p(sFEHcS
z#^4t%dnfSCyCijmUTI^~sotB3`1(F4+d+cp&tfGw1HTv8WvSi*r1*t)
z8ZT`S#))8@(!zNo`qqDOdOFVQzx-R~9ZcTyB&n&EU&rG7m+J1kfXlzhw;fc1hNP%Z
z_ImNFxxdV(tC!(mNcAPO%kR~xwZsL7m!Y(^;8)|cV57DA>SOxmzm_GZRv$s2xMlS@
z2WZ4W8X*PEWY>bz@vc9`D0Z
z1ON3}2j8-I8U1d7jI$MgdZ@nKJSl%URmehcj>TmZVR_=|kH`03rv(-$KY
zv;phalQ*YPyj#BBOK=#)VTXEY3185k`g?uSFRiq09)5ZgTjNwi{MTPs)sQh|doc|sihUXgXlBNUdmDiZQ#o3OFPscI8c5;Ih+V4=uiFq
zM3Q>bmsVPr$CPh_yfzI?;aF_Fm*6~wI;xkJ@CE&;zt<=I(n{;*;iq>uPhX5s&<3nu
z$KIT#mHIEiVH(FH>Zc~Em&#S2^h+zPn}?tNm~#6PE>Wj+1ma}q1)o!QuTT1=mDbI}
zPw#G?zZfC^afcwydUFcGI1x;6p!`mR8pPP$&Co2Lt@GT^&&I
z04jPOPXI&0Q5!;yp~e-;CmKKDJ_{=V*9&6LBk+QL+c6UUrT$s6n&{~RFTGEzEt0qg
zNhs39JqV{71~r||&mnnIsL9ef68hl
z^r!y5u#7<|zl-(1v@(gB`+W-tY9|ZB{Mzf*RZb7~I>>ZKlj67;9~eqo&lzx;=nYS$TI`sw}0fA|3=|1l;%
zCPBP--WX5!>)6Z5J(^Q{NO1W5;iuYlMwmf|pWLH1wTDEVp6p>J!ROT7YcDfl`VS+W
zEWQ6Y4;>JqLo@!AAcz;w8{>TZy7lsLx1?(i2@X?`w00^NQ_!FKyDL*Ip{149Mfh_sg~zWND>!Ir{1E
zP{LhSBc6SaN7Y-)Evvy&@Qx9L5y1~d8kUDvSa@%UqFQ?QAp>tOj_oNF@&$U)S0~;{Zg}_8AL54hKmFaoS^Z-=J{7#LyRk`a
zj9kk?r>PAOTsz-*y4vvQ&GU_CsG*PT--ve|5a)enHeZ-Yh!^AGrEyo`-5y#Z!CuLb
zK>i8-h7YY@>!9}|*q4DH%D;IB=DBNLIUqC*B42{+cx}!
z^zxPxqg*Vp@|gYzq}$f3kx*Nk^j^Hn&7e4bx01>qnF}{l+@FIGjmW}LLANMg<+yS)
zy~uE`?H1z6!!5UHTlLt@(G-W#eXE1m$$*pER!#2_C=_ey=%V+X4s9oP$8Xi6L))V%
ztySy7dpPGd`GvrX8)F>|Hyxx(mdxrP(!$@t7NNIX&P5_kdRGf-N5d;CBTW^&Rv7GZ5M
zoFF!~QWj-Xg~QqOdvaph^D^17FhURqrmMv`cn~-TZ+r77)7#$cB%*4$tEs7jS~1?e
zsFwFSny`~i-P?Ju50(a5f!>xe^g-qB$p9xuB*=!L<2}(ZwHU4Dx;Yt|qozIb$Xu^y?1VvzVgOCTShw4F%%okVhu70Pb`6O*
zYQTca18=m*NFAhT3gwTJb&|29EbMW^lg!KzghPhal-2xYu7a!;?}AFeZsRqa>|ME{
z`yt!SxWT~j@TuV)0sv)Z5~aikH=4yq$jL*
zS4t>!--2S+swi0tl9p`$$fHE2BvQ`gi<;{ROWf21i=su^j8V!|fDDfUDm8Q#vVRrPEtuj3J8U|&vA?Az8jZM*9>9|9Ns(>Tyegw3FB^367
zvYe1pdfum<(%VtI-yBvlmxA-m@3!+S2DBX~GoaDfb&?EFJO4?;6r6XB2Av+(%1#mx9UOMTXbaT?rR&59mw^Ve8WB;8G0w8~F{VxePZl)|6S^c*O$5k-
znR;gCYaLVSr9dX#j;d-IOX|VKJC%ud@EEdi5@foD=rpZHYwhh*(qQ8DtQVPKWsW&)
z+`zj*NX|UUAZLk-BTbbL#0yx~$b_b06@V>gu%%|KAk6jo=Ra)e5luk|
zNG)`67aDvbWO4UkO+g;U*zkZQi`qFwi`$!E`LJM$Ss1?F<(CL%B_#A(UnWduXBi(T
znEJCJyh^cHGr39+Z^nd7+F_^?lL`?;8!fUO1+2Nyz6k3eO?u3`jDlLn+>Mkx;gnj+
zsbCiQq9b+$YC)rUAe0eB$AR<9Z%_}@5LP>xIS6FGSR!M(0B1+>q~^$-eBGHZadkzD
zchb7HyUYcYHhaR;5iRl%(S>_#(fITx&?mK%nDa|IUm&;!`pD%jQwrr1I_
z5fWp?#zIZIgSik8jaIV6N*Pp%Ge6m-me2=q)0lp*B)i7-n70r3M+Ci
z7Vl_Fv0$VzoA20bq%-A$snLQOc0c+xGdo$D(MtIVGZ&$W!5Zombx^QOYF`{~=c~Ou
zBY!nu6RK)SS*#B;orJrXfuJf`qz|I2uwIB3Tsu0IV*^9C{TDuKBSxESKGg}V=x8yt
z+EnAL7<-F#;IjdO3Q&=$+Zr6I(GRz<>b0amrU96p&NxUT_hY)f{Qz=Y
zyf-hQ9c{#BZa{@FFQ5&Tf=yl4~Y(LYHWxe#=aH=vW^LS<<|_rqX==1p=>y98G63Oh(>9
zf*l`kk+_%>lv9*By~G&aYAxbR{y1la^sydr%UWSiFaNjuN7cm2Rb$}gLOfykhmm;5aV{fluf}fmbGi2
zh%t&5mNQH&O}}WBLuvtHMh4Dy%iYR+NP9caDLQj!&`m7fO&s{5Dj}5zD}-0Z5}F5V
z0!~|~LlJh4i)+Dd(2Hn*yng7am9LpG--m3_36JA+(rAFO3S)tDScgU7>}w@vGoyqe
zAFk0#uyF+Ahie?f4#7*u`4f&ptVpg%N0;6jEp~L#COH{kezxYgawlb>x7-;`5gMJt
z(Q){P9mioPkLg$e1VOY2f%ud|Z>6aQF`~_N_G_2Eox592I)-mM$Yw*WcVh1dWcVd6
z?U?9|>Crne&a_jme2lR@A-?Cujb*sDQ4}nKFariWJ#6xJ$~_{o!0-#mQK)ek4nhma
zhf3uRu54b5Nscqx^2sU#(@85#U7sApF{8&`dm}$X}6ToW7-ZTzM(dn#?NRO7mp#eUx?dj3z
zs2;XG%>sw?_e+o>Ms{<0(nNA92K&>`+2B~0%_N$V8AMYH6W1d{yk9HMP{gfL-t|(4TMmtz
z+WtW!n;~ZpjRr?p%>pvPy8V<{D8il7!mZ_^F=qB_>;x;&w3~7Eluqp3q80PyLed;X
zYuuq7D5P^GhYAz)5%8lUGMH(WqPmE>32Q
z8CW2k%_50ejPxE2w`<$DOxiG-e4ZUP&9RK$G6GaIk#}lJ`Hh%DOec^f)0p8$-^{4g6
z<5%XUj7&O}FbZSkteGnv8q^1NJ>G6l;t%h78c3bj_@Hw)7_8vAI{;V91Ky4j#!n^a;D4#*VipqQ=#>T`>2^Q
zO`*E>vYJ!Xx9I~9Z}unbGK%SBaR^j#IdRCieMVJ2Mcmp3^Vw`Zr-t4I4(*6c!s@A^
zd-Yv|yB}^HgsD?QI|(s5L=9UFWr5d*Fj}}8x`#>By3a`G)P^IJ!W)4adJ-g^JTj6l
zstu&GhuaPq1r%BhU5nI?;ZiC=ZCY)(MIRX4z31UJKr-o(EMwZuBMGWBRs9rr_qq_A
zlv9;gg9)@vBng_TVBcI-zDW5vnCz^olF$eDUjA^8Kqb>YMY@#fQ)#sMlBzxnU|e8Q
zZBt8EL)(b$8UY_SisPk`j2a37+YuCXqAIUNQQZ6iTGyv44+G7S39yapRpniB?yv?}
zMN*aH)CgQjGwEVUxz?+WtTCx7Pe2`xG+8Kh+{h?7a9k@y%%ML|nM|bjlI)I@`H|a{
zX<$0!lOSiA{{<<;Df=XuA#*yZs^3Ruj-DBK6es&-@p1S#mCvf`Z;%sJq?1|EJeu>0
zPYp`>TM#??z}zW0p(>vwDV=PJC1j76vg?BqvzelTzUWexsU}|uNZT+Q7u67Y`@>Oo
z8cGf2nJ{~=;5KB%J$M*h7i`HPMQM0#rNXgh<6qgo_QBVW_fNd-D?k3U^0PmEPo-ir
zn~i_x&sJT!>e9i>-#YZxi}u|<{NE}SrwJW1jR{?fmviY7;!c^EWV7+P{3XxzfArn=
zH0?Nj_29v6Z>v;X&CC>M<1<&be(=7}Ke6nchmQPJ+m=0ArLtbsA6LMTF@kvoI9DlV
zHvX>Am(;61{p`PeCHcD8vun}
zYvArjU$|N(gDo&i>8uG}uHa^AHh#;->n?xv%w&Q5G#mfi>p%YdkyqSy=+RxrcfPRf{SQc7
zj+V_biRI{px69f1k?+TTmA|R=#?Ri}e*afL`05{5D!vvy8_zY&t@v)IdCuHzKfOA9
z_FJx~RQiP8C(XhXjOLU{TCeUSv++m2cFD&6Z-3yDf7|`kW8tG8{Hi1YAIw43C3xlY
zh&hTw$D56BzH{5amp}7^dmnqlrj9RcoYk@0s*`NMFa+3dRblJ~xE-KyeH
z`WKI_T)#!)Ovc9H?6h=(&c;_i^`qzw|I3{EyL113fB5tB-<68ZP1kJvlXt)KmhXM|
zLtnV=Q>!j5zV^xIq~4Lia5EeK+kfdk-Fo83x4!y6KKu9IeA^A@OSQ>N;%xlEKMsH3
zp>Jh={GP8*Ur>1Prqy1Ib$zq(SVnoGwe*3X{^--o-?8JVxpAp@;4vHD`RIz_8{a&&
zY4Bg;~yOP*K4*OHShY(^DiHM$8*MoQduyjp*V6CjwR(P#L^t1
zPMhOy6Ch5X8qMSlG6YVW6C=oM{BPcPQO~-|KGaiwcE`7#{^AA4q?$J;$MJWgLf*ri
z4@jud58b`vf8Pm1+(!_TzpI0K+5>5!M^hg
ze|+tCPp?!Qr(-tW_3hN~_ZuI0`;BY=UVZwu_r3~r+&!6%U-|vfBinAh=y^*!)cg1c
zp1;0Qab20&_+3B#a(Hab-*o-i<~P0Vjz>NR?b=??Y<&5@e6;7ehp$Y3e&pXzd*z4U
zrBy1-H=2zf{>#5E?TS71p0l2L+t8+Kr!CM7F&}C+{@m%eedH4te(s~+dH(&Me$BT+
ze}S
+#   Copyright (c) 2008 Daniel Richard G. 
+#
+#   This program is free software; you can redistribute it and/or modify it
+#   under the terms of the GNU General Public License as published by the
+#   Free Software Foundation; either version 2 of the License, or (at your
+#   option) any later version.
+#
+#   This program is distributed in the hope that it will be useful, but
+#   WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
+#   Public License for more details.
+#
+#   You should have received a copy of the GNU General Public License along
+#   with this program. If not, see .
+#
+#   As a special exception, the respective Autoconf Macro's copyright owner
+#   gives unlimited permission to copy, distribute and modify the configure
+#   scripts that are the output of Autoconf when processing the Macro. You
+#   need not follow the terms of the GNU General Public License when using
+#   or distributing such scripts, even though portions of the text of the
+#   Macro appear in them. The GNU General Public License (GPL) does govern
+#   all other use of the material that constitutes the Autoconf Macro.
+#
+#   This special exception to the GPL applies to versions of the Autoconf
+#   Macro released by the Autoconf Archive. When you make and distribute a
+#   modified version of the Autoconf Macro, you may extend this special
+#   exception to the GPL to apply to your modified version as well.
+
+#serial 8
+
+AC_DEFUN([AX_FUNC_WHICH_GETHOSTBYNAME_R], [
+
+    AC_LANG_PUSH([C])
+    AC_MSG_CHECKING([how many arguments gethostbyname_r() takes])
+
+    AC_CACHE_VAL([ac_cv_func_which_gethostbyname_r], [
+
+################################################################
+
+ac_cv_func_which_gethostbyname_r=unknown
+
+#
+# ONE ARGUMENT (sanity check)
+#
+
+# This should fail, as there is no variant of gethostbyname_r() that takes
+# a single argument. If it actually compiles, then we can assume that
+# netdb.h is not declaring the function, and the compiler is thereby
+# assuming an implicit prototype. In which case, we're out of luck.
+#
+AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include ],
+        [
+            char *name = "www.gnu.org";
+            (void)gethostbyname_r(name) /* ; */
+        ])],
+    [ac_cv_func_which_gethostbyname_r=no])
+
+#
+# SIX ARGUMENTS
+# (e.g. Linux)
+#
+
+if test "$ac_cv_func_which_gethostbyname_r" = "unknown"; then
+
+AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include ],
+        [
+            char *name = "www.gnu.org";
+            struct hostent ret, *retp;
+            char buf@<:@1024@:>@;
+            int buflen = 1024;
+            int my_h_errno;
+            (void)gethostbyname_r(name, &ret, buf, buflen, &retp, &my_h_errno) /* ; */
+        ])],
+    [ac_cv_func_which_gethostbyname_r=six])
+
+fi
+
+#
+# FIVE ARGUMENTS
+# (e.g. Solaris)
+#
+
+if test "$ac_cv_func_which_gethostbyname_r" = "unknown"; then
+
+AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include ],
+        [
+            char *name = "www.gnu.org";
+            struct hostent ret;
+            char buf@<:@1024@:>@;
+            int buflen = 1024;
+            int my_h_errno;
+            (void)gethostbyname_r(name, &ret, buf, buflen, &my_h_errno) /* ; */
+        ])],
+    [ac_cv_func_which_gethostbyname_r=five])
+
+fi
+
+#
+# THREE ARGUMENTS
+# (e.g. AIX, HP-UX, Tru64)
+#
+
+if test "$ac_cv_func_which_gethostbyname_r" = "unknown"; then
+
+AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include ],
+        [
+            char *name = "www.gnu.org";
+            struct hostent ret;
+            struct hostent_data data;
+            (void)gethostbyname_r(name, &ret, &data) /* ; */
+        ])],
+    [ac_cv_func_which_gethostbyname_r=three])
+
+fi
+
+################################################################
+
+]) dnl end AC_CACHE_VAL
+
+case "$ac_cv_func_which_gethostbyname_r" in
+    three|five|six)
+    AC_DEFINE([HAVE_GETHOSTBYNAME_R], [1],
+              [Define to 1 if you have some form of gethostbyname_r().])
+    ;;
+esac
+
+case "$ac_cv_func_which_gethostbyname_r" in
+    three)
+    AC_MSG_RESULT([three])
+    AC_DEFINE([HAVE_FUNC_GETHOSTBYNAME_R_3], [1],
+              [Define to 1 if you have the three-argument form of gethostbyname_r().])
+    ;;
+
+    five)
+    AC_MSG_RESULT([five])
+    AC_DEFINE([HAVE_FUNC_GETHOSTBYNAME_R_5], [1],
+              [Define to 1 if you have the five-argument form of gethostbyname_r().])
+    ;;
+
+    six)
+    AC_MSG_RESULT([six])
+    AC_DEFINE([HAVE_FUNC_GETHOSTBYNAME_R_6], [1],
+              [Define to 1 if you have the six-argument form of gethostbyname_r().])
+    ;;
+
+    no)
+    AC_MSG_RESULT([cannot find function declaration in netdb.h])
+    ;;
+
+    unknown)
+    AC_MSG_RESULT([can't tell])
+    ;;
+
+    *)
+    AC_MSG_ERROR([internal error])
+    ;;
+esac
+
+AC_LANG_POP
+
+]) dnl end AC_DEFUN
+
+# Added for OCaml, should be submitted to the autoconf archive
+
+AC_DEFUN([AX_FUNC_WHICH_GETHOSTBYADDR_R], [
+
+    AC_LANG_PUSH([C])
+    AC_MSG_CHECKING([how many arguments gethostbyaddr_r() takes])
+
+    AC_CACHE_VAL([ac_cv_func_which_gethostbyaddr_r], [
+
+################################################################
+
+ac_cv_func_which_gethostbyaddr_r=unknown
+
+#
+# ONE ARGUMENT (sanity check)
+#
+
+# This should fail, as there is no variant of gethostbyaddr_r() that takes
+# a single argument. If it actually compiles, then we can assume that
+# netdb.h is not declaring the function, and the compiler is thereby
+# assuming an implicit prototype. In which case, we're out of luck.
+#
+AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include ],
+        [
+            char *addr = "192.168.1.1";
+            (void)gethostbyaddr_r(addr) /* ; */
+        ])],
+    [ac_cv_func_which_gethostbyaddr_r=no])
+
+#
+# EIGHT ARGUMENTS
+# (e.g. Linux)
+#
+
+if test "$ac_cv_func_which_gethostbyaddr_r" = "unknown"; then
+
+AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include ],
+        [
+            char *addr = "192.168.1.1";
+            struct hostent ret, *retp;
+            char buf@<:@1024@:>@;
+            int buflen = 1024;
+            int my_h_errno;
+            (void)gethostbyaddr_r(
+              addr, 10, 10, retp, buf, buflen, &retp, &my_h_errno) /* ; */
+        ])],
+    [ac_cv_func_which_gethostbyaddr_r=eight])
+
+fi
+
+#
+# SEVEN ARGUMENTS
+# (e.g. Solaris)
+#
+
+if test "$ac_cv_func_which_gethostbyaddr_r" = "unknown"; then
+
+AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include ],
+        [
+            char *addr = "192.168.1.1";
+            struct hostent ret;
+            char buf@<:@1024@:>@;
+            int buflen = 1024;
+            int my_h_errno;
+            (void)gethostbyaddr_r(
+              addr, 10, 10, buf, buflen, &my_h_errno, 0) /* ; */
+        ])],
+    [ac_cv_func_which_gethostbyaddr_r=seven])
+
+fi
+
+################################################################
+
+]) dnl end AC_CACHE_VAL
+
+case "$ac_cv_func_which_gethostbyaddr_r" in
+    seven|eight)
+    AC_DEFINE([HAVE_GETHOSTBYADDR_R], [1],
+              [Define to 1 if you have some form of gethostbyaddr_r().])
+    ;;
+esac
+
+case "$ac_cv_func_which_gethostbyaddr_r" in
+    eight)
+    AC_MSG_RESULT([eight])
+    AC_DEFINE([HAVE_FUNC_GETHOSTBYADDR_R_8], [1],
+              [Define to 1 if you have the eight-argument form of gethostbyaddr_r().])
+    ;;
+
+    seven)
+    AC_MSG_RESULT([seven])
+    AC_DEFINE([HAVE_FUNC_GETHOSTBYADDR_R_7], [1],
+              [Define to 1 if you have the seven-argument form of gethostbyaddr_r().])
+    ;;
+
+    no)
+    AC_MSG_RESULT([cannot find function declaration in netdb.h])
+    ;;
+
+    unknown)
+    AC_MSG_RESULT([can't tell])
+    ;;
+
+    *)
+    AC_MSG_ERROR([internal error])
+    ;;
+esac
+
+AC_LANG_POP
+
+]) dnl end AC_DEFUN
diff --git a/build-aux/ax_pthread.m4 b/build-aux/ax_pthread.m4
new file mode 100644
index 00000000..5fbf9fe0
--- /dev/null
+++ b/build-aux/ax_pthread.m4
@@ -0,0 +1,485 @@
+# ===========================================================================
+#        https://www.gnu.org/software/autoconf-archive/ax_pthread.html
+# ===========================================================================
+#
+# SYNOPSIS
+#
+#   AX_PTHREAD([ACTION-IF-FOUND[, ACTION-IF-NOT-FOUND]])
+#
+# DESCRIPTION
+#
+#   This macro figures out how to build C programs using POSIX threads. It
+#   sets the PTHREAD_LIBS output variable to the threads library and linker
+#   flags, and the PTHREAD_CFLAGS output variable to any special C compiler
+#   flags that are needed. (The user can also force certain compiler
+#   flags/libs to be tested by setting these environment variables.)
+#
+#   Also sets PTHREAD_CC to any special C compiler that is needed for
+#   multi-threaded programs (defaults to the value of CC otherwise). (This
+#   is necessary on AIX to use the special cc_r compiler alias.)
+#
+#   NOTE: You are assumed to not only compile your program with these flags,
+#   but also to link with them as well. For example, you might link with
+#   $PTHREAD_CC $CFLAGS $PTHREAD_CFLAGS $LDFLAGS ... $PTHREAD_LIBS $LIBS
+#
+#   If you are only building threaded programs, you may wish to use these
+#   variables in your default LIBS, CFLAGS, and CC:
+#
+#     LIBS="$PTHREAD_LIBS $LIBS"
+#     CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+#     CC="$PTHREAD_CC"
+#
+#   In addition, if the PTHREAD_CREATE_JOINABLE thread-attribute constant
+#   has a nonstandard name, this macro defines PTHREAD_CREATE_JOINABLE to
+#   that name (e.g. PTHREAD_CREATE_UNDETACHED on AIX).
+#
+#   Also HAVE_PTHREAD_PRIO_INHERIT is defined if pthread is found and the
+#   PTHREAD_PRIO_INHERIT symbol is defined when compiling with
+#   PTHREAD_CFLAGS.
+#
+#   ACTION-IF-FOUND is a list of shell commands to run if a threads library
+#   is found, and ACTION-IF-NOT-FOUND is a list of commands to run it if it
+#   is not found. If ACTION-IF-FOUND is not specified, the default action
+#   will define HAVE_PTHREAD.
+#
+#   Please let the authors know if this macro fails on any platform, or if
+#   you have any other suggestions or comments. This macro was based on work
+#   by SGJ on autoconf scripts for FFTW (http://www.fftw.org/) (with help
+#   from M. Frigo), as well as ac_pthread and hb_pthread macros posted by
+#   Alejandro Forero Cuervo to the autoconf macro repository. We are also
+#   grateful for the helpful feedback of numerous users.
+#
+#   Updated for Autoconf 2.68 by Daniel Richard G.
+#
+# LICENSE
+#
+#   Copyright (c) 2008 Steven G. Johnson 
+#   Copyright (c) 2011 Daniel Richard G. 
+#
+#   This program is free software: you can redistribute it and/or modify it
+#   under the terms of the GNU General Public License as published by the
+#   Free Software Foundation, either version 3 of the License, or (at your
+#   option) any later version.
+#
+#   This program is distributed in the hope that it will be useful, but
+#   WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
+#   Public License for more details.
+#
+#   You should have received a copy of the GNU General Public License along
+#   with this program. If not, see .
+#
+#   As a special exception, the respective Autoconf Macro's copyright owner
+#   gives unlimited permission to copy, distribute and modify the configure
+#   scripts that are the output of Autoconf when processing the Macro. You
+#   need not follow the terms of the GNU General Public License when using
+#   or distributing such scripts, even though portions of the text of the
+#   Macro appear in them. The GNU General Public License (GPL) does govern
+#   all other use of the material that constitutes the Autoconf Macro.
+#
+#   This special exception to the GPL applies to versions of the Autoconf
+#   Macro released by the Autoconf Archive. When you make and distribute a
+#   modified version of the Autoconf Macro, you may extend this special
+#   exception to the GPL to apply to your modified version as well.
+
+#serial 24
+
+AU_ALIAS([ACX_PTHREAD], [AX_PTHREAD])
+AC_DEFUN([AX_PTHREAD], [
+AC_REQUIRE([AC_CANONICAL_HOST])
+AC_REQUIRE([AC_PROG_CC])
+AC_REQUIRE([AC_PROG_SED])
+AC_LANG_PUSH([C])
+ax_pthread_ok=no
+
+# We used to check for pthread.h first, but this fails if pthread.h
+# requires special compiler flags (e.g. on Tru64 or Sequent).
+# It gets checked for in the link test anyway.
+
+# First of all, check if the user has set any of the PTHREAD_LIBS,
+# etcetera environment variables, and if threads linking works using
+# them:
+if test "x$PTHREAD_CFLAGS$PTHREAD_LIBS" != "x"; then
+        ax_pthread_save_CC="$CC"
+        ax_pthread_save_CFLAGS="$CFLAGS"
+        ax_pthread_save_LIBS="$LIBS"
+        AS_IF([test "x$PTHREAD_CC" != "x"], [CC="$PTHREAD_CC"])
+        CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+        LIBS="$PTHREAD_LIBS $LIBS"
+        AC_MSG_CHECKING([for pthread_join using $CC $PTHREAD_CFLAGS $PTHREAD_LIBS])
+        AC_LINK_IFELSE([AC_LANG_CALL([], [pthread_join])], [ax_pthread_ok=yes])
+        AC_MSG_RESULT([$ax_pthread_ok])
+        if test "x$ax_pthread_ok" = "xno"; then
+                PTHREAD_LIBS=""
+                PTHREAD_CFLAGS=""
+        fi
+        CC="$ax_pthread_save_CC"
+        CFLAGS="$ax_pthread_save_CFLAGS"
+        LIBS="$ax_pthread_save_LIBS"
+fi
+
+# We must check for the threads library under a number of different
+# names; the ordering is very important because some systems
+# (e.g. DEC) have both -lpthread and -lpthreads, where one of the
+# libraries is broken (non-POSIX).
+
+# Create a list of thread flags to try.  Items starting with a "-" are
+# C compiler flags, and other items are library names, except for "none"
+# which indicates that we try without any flags at all, and "pthread-config"
+# which is a program returning the flags for the Pth emulation library.
+
+ax_pthread_flags="pthreads none -Kthread -pthread -pthreads -mthreads pthread --thread-safe -mt pthread-config"
+
+# The ordering *is* (sometimes) important.  Some notes on the
+# individual items follow:
+
+# pthreads: AIX (must check this before -lpthread)
+# none: in case threads are in libc; should be tried before -Kthread and
+#       other compiler flags to prevent continual compiler warnings
+# -Kthread: Sequent (threads in libc, but -Kthread needed for pthread.h)
+# -pthread: Linux/gcc (kernel threads), BSD/gcc (userland threads), Tru64
+#           (Note: HP C rejects this with "bad form for `-t' option")
+# -pthreads: Solaris/gcc (Note: HP C also rejects)
+# -mt: Sun Workshop C (may only link SunOS threads [-lthread], but it
+#      doesn't hurt to check since this sometimes defines pthreads and
+#      -D_REENTRANT too), HP C (must be checked before -lpthread, which
+#      is present but should not be used directly; and before -mthreads,
+#      because the compiler interprets this as "-mt" + "-hreads")
+# -mthreads: Mingw32/gcc, Lynx/gcc
+# pthread: Linux, etcetera
+# --thread-safe: KAI C++
+# pthread-config: use pthread-config program (for GNU Pth library)
+
+case $host_os in
+
+        freebsd*)
+
+        # -kthread: FreeBSD kernel threads (preferred to -pthread since SMP-able)
+        # lthread: LinuxThreads port on FreeBSD (also preferred to -pthread)
+
+        ax_pthread_flags="-kthread lthread $ax_pthread_flags"
+        ;;
+
+        hpux*)
+
+        # From the cc(1) man page: "[-mt] Sets various -D flags to enable
+        # multi-threading and also sets -lpthread."
+
+        ax_pthread_flags="-mt -pthread pthread $ax_pthread_flags"
+        ;;
+
+        openedition*)
+
+        # IBM z/OS requires a feature-test macro to be defined in order to
+        # enable POSIX threads at all, so give the user a hint if this is
+        # not set. (We don't define these ourselves, as they can affect
+        # other portions of the system API in unpredictable ways.)
+
+        AC_EGREP_CPP([AX_PTHREAD_ZOS_MISSING],
+            [
+#            if !defined(_OPEN_THREADS) && !defined(_UNIX03_THREADS)
+             AX_PTHREAD_ZOS_MISSING
+#            endif
+            ],
+            [AC_MSG_WARN([IBM z/OS requires -D_OPEN_THREADS or -D_UNIX03_THREADS to enable pthreads support.])])
+        ;;
+
+        solaris*)
+
+        # On Solaris (at least, for some versions), libc contains stubbed
+        # (non-functional) versions of the pthreads routines, so link-based
+        # tests will erroneously succeed. (N.B.: The stubs are missing
+        # pthread_cleanup_push, or rather a function called by this macro,
+        # so we could check for that, but who knows whether they'll stub
+        # that too in a future libc.)  So we'll check first for the
+        # standard Solaris way of linking pthreads (-mt -lpthread).
+
+        ax_pthread_flags="-mt,pthread pthread $ax_pthread_flags"
+        ;;
+esac
+
+# GCC generally uses -pthread, or -pthreads on some platforms (e.g. SPARC)
+
+AS_IF([test "x$GCC" = "xyes"],
+      [ax_pthread_flags="-pthread -pthreads $ax_pthread_flags"])
+
+# The presence of a feature test macro requesting re-entrant function
+# definitions is, on some systems, a strong hint that pthreads support is
+# correctly enabled
+
+case $host_os in
+        darwin* | hpux* | linux* | osf* | solaris*)
+        ax_pthread_check_macro="_REENTRANT"
+        ;;
+
+        aix*)
+        ax_pthread_check_macro="_THREAD_SAFE"
+        ;;
+
+        *)
+        ax_pthread_check_macro="--"
+        ;;
+esac
+AS_IF([test "x$ax_pthread_check_macro" = "x--"],
+      [ax_pthread_check_cond=0],
+      [ax_pthread_check_cond="!defined($ax_pthread_check_macro)"])
+
+# Are we compiling with Clang?
+
+AC_CACHE_CHECK([whether $CC is Clang],
+    [ax_cv_PTHREAD_CLANG],
+    [ax_cv_PTHREAD_CLANG=no
+     # Note that Autoconf sets GCC=yes for Clang as well as GCC
+     if test "x$GCC" = "xyes"; then
+        AC_EGREP_CPP([AX_PTHREAD_CC_IS_CLANG],
+            [/* Note: Clang 2.7 lacks __clang_[a-z]+__ */
+#            if defined(__clang__) && defined(__llvm__)
+             AX_PTHREAD_CC_IS_CLANG
+#            endif
+            ],
+            [ax_cv_PTHREAD_CLANG=yes])
+     fi
+    ])
+ax_pthread_clang="$ax_cv_PTHREAD_CLANG"
+
+ax_pthread_clang_warning=no
+
+# Clang needs special handling, because older versions handle the -pthread
+# option in a rather... idiosyncratic way
+
+if test "x$ax_pthread_clang" = "xyes"; then
+
+        # Clang takes -pthread; it has never supported any other flag
+
+        # (Note 1: This will need to be revisited if a system that Clang
+        # supports has POSIX threads in a separate library.  This tends not
+        # to be the way of modern systems, but it's conceivable.)
+
+        # (Note 2: On some systems, notably Darwin, -pthread is not needed
+        # to get POSIX threads support; the API is always present and
+        # active.  We could reasonably leave PTHREAD_CFLAGS empty.  But
+        # -pthread does define _REENTRANT, and while the Darwin headers
+        # ignore this macro, third-party headers might not.)
+
+        PTHREAD_CFLAGS="-pthread"
+        PTHREAD_LIBS=
+
+        ax_pthread_ok=yes
+
+        # However, older versions of Clang make a point of warning the user
+        # that, in an invocation where only linking and no compilation is
+        # taking place, the -pthread option has no effect ("argument unused
+        # during compilation").  They expect -pthread to be passed in only
+        # when source code is being compiled.
+        #
+        # Problem is, this is at odds with the way Automake and most other
+        # C build frameworks function, which is that the same flags used in
+        # compilation (CFLAGS) are also used in linking.  Many systems
+        # supported by AX_PTHREAD require exactly this for POSIX threads
+        # support, and in fact it is often not straightforward to specify a
+        # flag that is used only in the compilation phase and not in
+        # linking.  Such a scenario is extremely rare in practice.
+        #
+        # Even though use of the -pthread flag in linking would only print
+        # a warning, this can be a nuisance for well-run software projects
+        # that build with -Werror.  So if the active version of Clang has
+        # this misfeature, we search for an option to squash it.
+
+        AC_CACHE_CHECK([whether Clang needs flag to prevent "argument unused" warning when linking with -pthread],
+            [ax_cv_PTHREAD_CLANG_NO_WARN_FLAG],
+            [ax_cv_PTHREAD_CLANG_NO_WARN_FLAG=unknown
+             # Create an alternate version of $ac_link that compiles and
+             # links in two steps (.c -> .o, .o -> exe) instead of one
+             # (.c -> exe), because the warning occurs only in the second
+             # step
+             ax_pthread_save_ac_link="$ac_link"
+             ax_pthread_sed='s/conftest\.\$ac_ext/conftest.$ac_objext/g'
+             ax_pthread_link_step=`$as_echo "$ac_link" | sed "$ax_pthread_sed"`
+             ax_pthread_2step_ac_link="($ac_compile) && (echo ==== >&5) && ($ax_pthread_link_step)"
+             ax_pthread_save_CFLAGS="$CFLAGS"
+             for ax_pthread_try in '' -Qunused-arguments -Wno-unused-command-line-argument unknown; do
+                AS_IF([test "x$ax_pthread_try" = "xunknown"], [break])
+                CFLAGS="-Werror -Wunknown-warning-option $ax_pthread_try -pthread $ax_pthread_save_CFLAGS"
+                ac_link="$ax_pthread_save_ac_link"
+                AC_LINK_IFELSE([AC_LANG_SOURCE([[int main(void){return 0;}]])],
+                    [ac_link="$ax_pthread_2step_ac_link"
+                     AC_LINK_IFELSE([AC_LANG_SOURCE([[int main(void){return 0;}]])],
+                         [break])
+                    ])
+             done
+             ac_link="$ax_pthread_save_ac_link"
+             CFLAGS="$ax_pthread_save_CFLAGS"
+             AS_IF([test "x$ax_pthread_try" = "x"], [ax_pthread_try=no])
+             ax_cv_PTHREAD_CLANG_NO_WARN_FLAG="$ax_pthread_try"
+            ])
+
+        case "$ax_cv_PTHREAD_CLANG_NO_WARN_FLAG" in
+                no | unknown) ;;
+                *) PTHREAD_CFLAGS="$ax_cv_PTHREAD_CLANG_NO_WARN_FLAG $PTHREAD_CFLAGS" ;;
+        esac
+
+fi # $ax_pthread_clang = yes
+
+if test "x$ax_pthread_ok" = "xno"; then
+for ax_pthread_try_flag in $ax_pthread_flags; do
+
+        case $ax_pthread_try_flag in
+                none)
+                AC_MSG_CHECKING([whether pthreads work without any flags])
+                ;;
+
+                -mt,pthread)
+                AC_MSG_CHECKING([whether pthreads work with -mt -lpthread])
+                PTHREAD_CFLAGS="-mt"
+                PTHREAD_LIBS="-lpthread"
+                ;;
+
+                -*)
+                AC_MSG_CHECKING([whether pthreads work with $ax_pthread_try_flag])
+                PTHREAD_CFLAGS="$ax_pthread_try_flag"
+                ;;
+
+                pthread-config)
+                AC_CHECK_PROG([ax_pthread_config], [pthread-config], [yes], [no])
+                AS_IF([test "x$ax_pthread_config" = "xno"], [continue])
+                PTHREAD_CFLAGS="`pthread-config --cflags`"
+                PTHREAD_LIBS="`pthread-config --ldflags` `pthread-config --libs`"
+                ;;
+
+                *)
+                AC_MSG_CHECKING([for the pthreads library -l$ax_pthread_try_flag])
+                PTHREAD_LIBS="-l$ax_pthread_try_flag"
+                ;;
+        esac
+
+        ax_pthread_save_CFLAGS="$CFLAGS"
+        ax_pthread_save_LIBS="$LIBS"
+        CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+        LIBS="$PTHREAD_LIBS $LIBS"
+
+        # Check for various functions.  We must include pthread.h,
+        # since some functions may be macros.  (On the Sequent, we
+        # need a special flag -Kthread to make this header compile.)
+        # We check for pthread_join because it is in -lpthread on IRIX
+        # while pthread_create is in libc.  We check for pthread_attr_init
+        # due to DEC craziness with -lpthreads.  We check for
+        # pthread_cleanup_push because it is one of the few pthread
+        # functions on Solaris that doesn't have a non-functional libc stub.
+        # We try pthread_create on general principles.
+
+        AC_LINK_IFELSE([AC_LANG_PROGRAM([#include 
+#                       if $ax_pthread_check_cond
+#                        error "$ax_pthread_check_macro must be defined"
+#                       endif
+                        static void routine(void *a) { a = 0; }
+                        static void *start_routine(void *a) { return a; }],
+                       [pthread_t th; pthread_attr_t attr;
+                        pthread_create(&th, 0, start_routine, 0);
+                        pthread_join(th, 0);
+                        pthread_attr_init(&attr);
+                        pthread_cleanup_push(routine, 0);
+                        pthread_cleanup_pop(0) /* ; */])],
+            [ax_pthread_ok=yes],
+            [])
+
+        CFLAGS="$ax_pthread_save_CFLAGS"
+        LIBS="$ax_pthread_save_LIBS"
+
+        AC_MSG_RESULT([$ax_pthread_ok])
+        AS_IF([test "x$ax_pthread_ok" = "xyes"], [break])
+
+        PTHREAD_LIBS=""
+        PTHREAD_CFLAGS=""
+done
+fi
+
+# Various other checks:
+if test "x$ax_pthread_ok" = "xyes"; then
+        ax_pthread_save_CFLAGS="$CFLAGS"
+        ax_pthread_save_LIBS="$LIBS"
+        CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+        LIBS="$PTHREAD_LIBS $LIBS"
+
+        # Detect AIX lossage: JOINABLE attribute is called UNDETACHED.
+        AC_CACHE_CHECK([for joinable pthread attribute],
+            [ax_cv_PTHREAD_JOINABLE_ATTR],
+            [ax_cv_PTHREAD_JOINABLE_ATTR=unknown
+             for ax_pthread_attr in PTHREAD_CREATE_JOINABLE PTHREAD_CREATE_UNDETACHED; do
+                 AC_LINK_IFELSE([AC_LANG_PROGRAM([#include ],
+                                                 [int attr = $ax_pthread_attr; return attr /* ; */])],
+                                [ax_cv_PTHREAD_JOINABLE_ATTR=$ax_pthread_attr; break],
+                                [])
+             done
+            ])
+        AS_IF([test "x$ax_cv_PTHREAD_JOINABLE_ATTR" != "xunknown" && \
+               test "x$ax_cv_PTHREAD_JOINABLE_ATTR" != "xPTHREAD_CREATE_JOINABLE" && \
+               test "x$ax_pthread_joinable_attr_defined" != "xyes"],
+              [AC_DEFINE_UNQUOTED([PTHREAD_CREATE_JOINABLE],
+                                  [$ax_cv_PTHREAD_JOINABLE_ATTR],
+                                  [Define to necessary symbol if this constant
+                                   uses a non-standard name on your system.])
+               ax_pthread_joinable_attr_defined=yes
+              ])
+
+        AC_CACHE_CHECK([whether more special flags are required for pthreads],
+            [ax_cv_PTHREAD_SPECIAL_FLAGS],
+            [ax_cv_PTHREAD_SPECIAL_FLAGS=no
+             case $host_os in
+             solaris*)
+             ax_cv_PTHREAD_SPECIAL_FLAGS="-D_POSIX_PTHREAD_SEMANTICS"
+             ;;
+             esac
+            ])
+        AS_IF([test "x$ax_cv_PTHREAD_SPECIAL_FLAGS" != "xno" && \
+               test "x$ax_pthread_special_flags_added" != "xyes"],
+              [PTHREAD_CFLAGS="$ax_cv_PTHREAD_SPECIAL_FLAGS $PTHREAD_CFLAGS"
+               ax_pthread_special_flags_added=yes])
+
+        AC_CACHE_CHECK([for PTHREAD_PRIO_INHERIT],
+            [ax_cv_PTHREAD_PRIO_INHERIT],
+            [AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]],
+                                             [[int i = PTHREAD_PRIO_INHERIT;]])],
+                            [ax_cv_PTHREAD_PRIO_INHERIT=yes],
+                            [ax_cv_PTHREAD_PRIO_INHERIT=no])
+            ])
+        AS_IF([test "x$ax_cv_PTHREAD_PRIO_INHERIT" = "xyes" && \
+               test "x$ax_pthread_prio_inherit_defined" != "xyes"],
+              [AC_DEFINE([HAVE_PTHREAD_PRIO_INHERIT], [1], [Have PTHREAD_PRIO_INHERIT.])
+               ax_pthread_prio_inherit_defined=yes
+              ])
+
+        CFLAGS="$ax_pthread_save_CFLAGS"
+        LIBS="$ax_pthread_save_LIBS"
+
+        # More AIX lossage: compile with *_r variant
+        if test "x$GCC" != "xyes"; then
+            case $host_os in
+                aix*)
+                AS_CASE(["x/$CC"],
+                    [x*/c89|x*/c89_128|x*/c99|x*/c99_128|x*/cc|x*/cc128|x*/xlc|x*/xlc_v6|x*/xlc128|x*/xlc128_v6],
+                    [#handle absolute path differently from PATH based program lookup
+                     AS_CASE(["x$CC"],
+                         [x/*],
+                         [AS_IF([AS_EXECUTABLE_P([${CC}_r])],[PTHREAD_CC="${CC}_r"])],
+                         [AC_CHECK_PROGS([PTHREAD_CC],[${CC}_r],[$CC])])])
+                ;;
+            esac
+        fi
+fi
+
+test -n "$PTHREAD_CC" || PTHREAD_CC="$CC"
+
+AC_SUBST([PTHREAD_LIBS])
+AC_SUBST([PTHREAD_CFLAGS])
+AC_SUBST([PTHREAD_CC])
+
+# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
+if test "x$ax_pthread_ok" = "xyes"; then
+        ifelse([$1],,[AC_DEFINE([HAVE_PTHREAD],[1],[Define if you have POSIX threads libraries and header files.])],[$1])
+        :
+else
+        ax_pthread_ok=no
+        $2
+fi
+AC_LANG_POP
+])dnl AX_PTHREAD
diff --git a/build-aux/compile b/build-aux/compile
new file mode 100755
index 00000000..a85b723c
--- /dev/null
+++ b/build-aux/compile
@@ -0,0 +1,347 @@
+#! /bin/sh
+# Wrapper for compilers which do not understand '-c -o'.
+
+scriptversion=2012-10-14.11; # UTC
+
+# Copyright (C) 1999-2014 Free Software Foundation, Inc.
+# Written by Tom Tromey .
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see .
+
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# This file is maintained in Automake, please report
+# bugs to  or send patches to
+# .
+
+nl='
+'
+
+# We need space, tab and new line, in precisely that order.  Quoting is
+# there to prevent tools from complaining about whitespace usage.
+IFS=" ""	$nl"
+
+file_conv=
+
+# func_file_conv build_file lazy
+# Convert a $build file to $host form and store it in $file
+# Currently only supports Windows hosts. If the determined conversion
+# type is listed in (the comma separated) LAZY, no conversion will
+# take place.
+func_file_conv ()
+{
+  file=$1
+  case $file in
+    / | /[!/]*) # absolute file, and not a UNC file
+      if test -z "$file_conv"; then
+	# lazily determine how to convert abs files
+	case `uname -s` in
+	  MINGW*)
+	    file_conv=mingw
+	    ;;
+	  CYGWIN*)
+	    file_conv=cygwin
+	    ;;
+	  *)
+	    file_conv=wine
+	    ;;
+	esac
+      fi
+      case $file_conv/,$2, in
+	*,$file_conv,*)
+	  ;;
+	mingw/*)
+	  file=`cmd //C echo "$file " | sed -e 's/"\(.*\) " *$/\1/'`
+	  ;;
+	cygwin/*)
+	  file=`cygpath -m "$file" || echo "$file"`
+	  ;;
+	wine/*)
+	  file=`winepath -w "$file" || echo "$file"`
+	  ;;
+      esac
+      ;;
+  esac
+}
+
+# func_cl_dashL linkdir
+# Make cl look for libraries in LINKDIR
+func_cl_dashL ()
+{
+  func_file_conv "$1"
+  if test -z "$lib_path"; then
+    lib_path=$file
+  else
+    lib_path="$lib_path;$file"
+  fi
+  linker_opts="$linker_opts -LIBPATH:$file"
+}
+
+# func_cl_dashl library
+# Do a library search-path lookup for cl
+func_cl_dashl ()
+{
+  lib=$1
+  found=no
+  save_IFS=$IFS
+  IFS=';'
+  for dir in $lib_path $LIB
+  do
+    IFS=$save_IFS
+    if $shared && test -f "$dir/$lib.dll.lib"; then
+      found=yes
+      lib=$dir/$lib.dll.lib
+      break
+    fi
+    if test -f "$dir/$lib.lib"; then
+      found=yes
+      lib=$dir/$lib.lib
+      break
+    fi
+    if test -f "$dir/lib$lib.a"; then
+      found=yes
+      lib=$dir/lib$lib.a
+      break
+    fi
+  done
+  IFS=$save_IFS
+
+  if test "$found" != yes; then
+    lib=$lib.lib
+  fi
+}
+
+# func_cl_wrapper cl arg...
+# Adjust compile command to suit cl
+func_cl_wrapper ()
+{
+  # Assume a capable shell
+  lib_path=
+  shared=:
+  linker_opts=
+  for arg
+  do
+    if test -n "$eat"; then
+      eat=
+    else
+      case $1 in
+	-o)
+	  # configure might choose to run compile as 'compile cc -o foo foo.c'.
+	  eat=1
+	  case $2 in
+	    *.o | *.[oO][bB][jJ])
+	      func_file_conv "$2"
+	      set x "$@" -Fo"$file"
+	      shift
+	      ;;
+	    *)
+	      func_file_conv "$2"
+	      set x "$@" -Fe"$file"
+	      shift
+	      ;;
+	  esac
+	  ;;
+	-I)
+	  eat=1
+	  func_file_conv "$2" mingw
+	  set x "$@" -I"$file"
+	  shift
+	  ;;
+	-I*)
+	  func_file_conv "${1#-I}" mingw
+	  set x "$@" -I"$file"
+	  shift
+	  ;;
+	-l)
+	  eat=1
+	  func_cl_dashl "$2"
+	  set x "$@" "$lib"
+	  shift
+	  ;;
+	-l*)
+	  func_cl_dashl "${1#-l}"
+	  set x "$@" "$lib"
+	  shift
+	  ;;
+	-L)
+	  eat=1
+	  func_cl_dashL "$2"
+	  ;;
+	-L*)
+	  func_cl_dashL "${1#-L}"
+	  ;;
+	-static)
+	  shared=false
+	  ;;
+	-Wl,*)
+	  arg=${1#-Wl,}
+	  save_ifs="$IFS"; IFS=','
+	  for flag in $arg; do
+	    IFS="$save_ifs"
+	    linker_opts="$linker_opts $flag"
+	  done
+	  IFS="$save_ifs"
+	  ;;
+	-Xlinker)
+	  eat=1
+	  linker_opts="$linker_opts $2"
+	  ;;
+	-*)
+	  set x "$@" "$1"
+	  shift
+	  ;;
+	*.cc | *.CC | *.cxx | *.CXX | *.[cC]++)
+	  func_file_conv "$1"
+	  set x "$@" -Tp"$file"
+	  shift
+	  ;;
+	*.c | *.cpp | *.CPP | *.lib | *.LIB | *.Lib | *.OBJ | *.obj | *.[oO])
+	  func_file_conv "$1" mingw
+	  set x "$@" "$file"
+	  shift
+	  ;;
+	*)
+	  set x "$@" "$1"
+	  shift
+	  ;;
+      esac
+    fi
+    shift
+  done
+  if test -n "$linker_opts"; then
+    linker_opts="-link$linker_opts"
+  fi
+  exec "$@" $linker_opts
+  exit 1
+}
+
+eat=
+
+case $1 in
+  '')
+     echo "$0: No command.  Try '$0 --help' for more information." 1>&2
+     exit 1;
+     ;;
+  -h | --h*)
+    cat <<\EOF
+Usage: compile [--help] [--version] PROGRAM [ARGS]
+
+Wrapper for compilers which do not understand '-c -o'.
+Remove '-o dest.o' from ARGS, run PROGRAM with the remaining
+arguments, and rename the output as expected.
+
+If you are trying to build a whole package this is not the
+right script to run: please start by reading the file 'INSTALL'.
+
+Report bugs to .
+EOF
+    exit $?
+    ;;
+  -v | --v*)
+    echo "compile $scriptversion"
+    exit $?
+    ;;
+  cl | *[/\\]cl | cl.exe | *[/\\]cl.exe )
+    func_cl_wrapper "$@"      # Doesn't return...
+    ;;
+esac
+
+ofile=
+cfile=
+
+for arg
+do
+  if test -n "$eat"; then
+    eat=
+  else
+    case $1 in
+      -o)
+	# configure might choose to run compile as 'compile cc -o foo foo.c'.
+	# So we strip '-o arg' only if arg is an object.
+	eat=1
+	case $2 in
+	  *.o | *.obj)
+	    ofile=$2
+	    ;;
+	  *)
+	    set x "$@" -o "$2"
+	    shift
+	    ;;
+	esac
+	;;
+      *.c)
+	cfile=$1
+	set x "$@" "$1"
+	shift
+	;;
+      *)
+	set x "$@" "$1"
+	shift
+	;;
+    esac
+  fi
+  shift
+done
+
+if test -z "$ofile" || test -z "$cfile"; then
+  # If no '-o' option was seen then we might have been invoked from a
+  # pattern rule where we don't need one.  That is ok -- this is a
+  # normal compilation that the losing compiler can handle.  If no
+  # '.c' file was seen then we are probably linking.  That is also
+  # ok.
+  exec "$@"
+fi
+
+# Name of file we expect compiler to create.
+cofile=`echo "$cfile" | sed 's|^.*[\\/]||; s|^[a-zA-Z]:||; s/\.c$/.o/'`
+
+# Create the lock directory.
+# Note: use '[/\\:.-]' here to ensure that we don't use the same name
+# that we are using for the .o file.  Also, base the name on the expected
+# object file name, since that is what matters with a parallel build.
+lockdir=`echo "$cofile" | sed -e 's|[/\\:.-]|_|g'`.d
+while true; do
+  if mkdir "$lockdir" >/dev/null 2>&1; then
+    break
+  fi
+  sleep 1
+done
+# FIXME: race condition here if user kills between mkdir and trap.
+trap "rmdir '$lockdir'; exit 1" 1 2 15
+
+# Run the compile.
+"$@"
+ret=$?
+
+if test -f "$cofile"; then
+  test "$cofile" = "$ofile" || mv "$cofile" "$ofile"
+elif test -f "${cofile}bj"; then
+  test "${cofile}bj" = "$ofile" || mv "${cofile}bj" "$ofile"
+fi
+
+rmdir "$lockdir"
+exit $ret
+
+# Local Variables:
+# mode: shell-script
+# sh-indentation: 2
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "scriptversion="
+# time-stamp-format: "%:y-%02m-%02d.%02H"
+# time-stamp-time-zone: "UTC"
+# time-stamp-end: "; # UTC"
+# End:
diff --git a/build-aux/config.guess b/build-aux/config.guess
new file mode 100755
index 00000000..f50dcdb6
--- /dev/null
+++ b/build-aux/config.guess
@@ -0,0 +1,1480 @@
+#! /bin/sh
+# Attempt to guess a canonical system name.
+#   Copyright 1992-2018 Free Software Foundation, Inc.
+
+timestamp='2018-02-24'
+
+# This file is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, see .
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that
+# program.  This Exception is an additional permission under section 7
+# of the GNU General Public License, version 3 ("GPLv3").
+#
+# Originally written by Per Bothner; maintained since 2000 by Ben Elliston.
+#
+# You can get the latest version of this script from:
+# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess
+#
+# Please send patches to .
+
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION]
+
+Output the configuration name of the system \`$me' is run on.
+
+Options:
+  -h, --help         print this help, then exit
+  -t, --time-stamp   print date of last modification, then exit
+  -v, --version      print version number, then exit
+
+Report bugs and patches to ."
+
+version="\
+GNU config.guess ($timestamp)
+
+Originally written by Per Bothner.
+Copyright 1992-2018 Free Software Foundation, Inc.
+
+This is free software; see the source for copying conditions.  There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+
+help="
+Try \`$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+  case $1 in
+    --time-stamp | --time* | -t )
+       echo "$timestamp" ; exit ;;
+    --version | -v )
+       echo "$version" ; exit ;;
+    --help | --h* | -h )
+       echo "$usage"; exit ;;
+    -- )     # Stop option processing
+       shift; break ;;
+    - )	# Use stdin as input.
+       break ;;
+    -* )
+       echo "$me: invalid option $1$help" >&2
+       exit 1 ;;
+    * )
+       break ;;
+  esac
+done
+
+if test $# != 0; then
+  echo "$me: too many arguments$help" >&2
+  exit 1
+fi
+
+trap 'exit 1' 1 2 15
+
+# CC_FOR_BUILD -- compiler used by this script. Note that the use of a
+# compiler to aid in system detection is discouraged as it requires
+# temporary files to be created and, as you can see below, it is a
+# headache to deal with in a portable fashion.
+
+# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still
+# use `HOST_CC' if defined, but it is deprecated.
+
+# Portable tmp directory creation inspired by the Autoconf team.
+
+set_cc_for_build='
+trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;
+trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;
+: ${TMPDIR=/tmp} ;
+ { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
+ { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } ||
+ { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } ||
+ { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ;
+dummy=$tmp/dummy ;
+tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ;
+case $CC_FOR_BUILD,$HOST_CC,$CC in
+ ,,)    echo "int x;" > "$dummy.c" ;
+	for c in cc gcc c89 c99 ; do
+	  if ($c -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then
+	     CC_FOR_BUILD="$c"; break ;
+	  fi ;
+	done ;
+	if test x"$CC_FOR_BUILD" = x ; then
+	  CC_FOR_BUILD=no_compiler_found ;
+	fi
+	;;
+ ,,*)   CC_FOR_BUILD=$CC ;;
+ ,*,*)  CC_FOR_BUILD=$HOST_CC ;;
+esac ; set_cc_for_build= ;'
+
+# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
+# (ghazi@noc.rutgers.edu 1994-08-24)
+if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
+	PATH=$PATH:/.attbin ; export PATH
+fi
+
+UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
+UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
+UNAME_SYSTEM=`(uname -s) 2>/dev/null`  || UNAME_SYSTEM=unknown
+UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
+
+case "$UNAME_SYSTEM" in
+Linux|GNU|GNU/*)
+	# If the system lacks a compiler, then just pick glibc.
+	# We could probably try harder.
+	LIBC=gnu
+
+	eval "$set_cc_for_build"
+	cat <<-EOF > "$dummy.c"
+	#include 
+	#if defined(__UCLIBC__)
+	LIBC=uclibc
+	#elif defined(__dietlibc__)
+	LIBC=dietlibc
+	#else
+	LIBC=gnu
+	#endif
+	EOF
+	eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'`"
+
+	# If ldd exists, use it to detect musl libc.
+	if command -v ldd >/dev/null && \
+		ldd --version 2>&1 | grep -q ^musl
+	then
+	    LIBC=musl
+	fi
+	;;
+esac
+
+# Note: order is significant - the case branches are not exclusive.
+
+case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
+    *:NetBSD:*:*)
+	# NetBSD (nbsd) targets should (where applicable) match one or
+	# more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*,
+	# *-*-netbsdecoff* and *-*-netbsd*.  For targets that recently
+	# switched to ELF, *-*-netbsd* would select the old
+	# object file format.  This provides both forward
+	# compatibility and a consistent mechanism for selecting the
+	# object file format.
+	#
+	# Note: NetBSD doesn't particularly care about the vendor
+	# portion of the name.  We always set it to "unknown".
+	sysctl="sysctl -n hw.machine_arch"
+	UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \
+	    "/sbin/$sysctl" 2>/dev/null || \
+	    "/usr/sbin/$sysctl" 2>/dev/null || \
+	    echo unknown)`
+	case "$UNAME_MACHINE_ARCH" in
+	    armeb) machine=armeb-unknown ;;
+	    arm*) machine=arm-unknown ;;
+	    sh3el) machine=shl-unknown ;;
+	    sh3eb) machine=sh-unknown ;;
+	    sh5el) machine=sh5le-unknown ;;
+	    earmv*)
+		arch=`echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,'`
+		endian=`echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p'`
+		machine="${arch}${endian}"-unknown
+		;;
+	    *) machine="$UNAME_MACHINE_ARCH"-unknown ;;
+	esac
+	# The Operating System including object format, if it has switched
+	# to ELF recently (or will in the future) and ABI.
+	case "$UNAME_MACHINE_ARCH" in
+	    earm*)
+		os=netbsdelf
+		;;
+	    arm*|i386|m68k|ns32k|sh3*|sparc|vax)
+		eval "$set_cc_for_build"
+		if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \
+			| grep -q __ELF__
+		then
+		    # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout).
+		    # Return netbsd for either.  FIX?
+		    os=netbsd
+		else
+		    os=netbsdelf
+		fi
+		;;
+	    *)
+		os=netbsd
+		;;
+	esac
+	# Determine ABI tags.
+	case "$UNAME_MACHINE_ARCH" in
+	    earm*)
+		expr='s/^earmv[0-9]/-eabi/;s/eb$//'
+		abi=`echo "$UNAME_MACHINE_ARCH" | sed -e "$expr"`
+		;;
+	esac
+	# The OS release
+	# Debian GNU/NetBSD machines have a different userland, and
+	# thus, need a distinct triplet. However, they do not need
+	# kernel version information, so it can be replaced with a
+	# suitable tag, in the style of linux-gnu.
+	case "$UNAME_VERSION" in
+	    Debian*)
+		release='-gnu'
+		;;
+	    *)
+		release=`echo "$UNAME_RELEASE" | sed -e 's/[-_].*//' | cut -d. -f1,2`
+		;;
+	esac
+	# Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:
+	# contains redundant information, the shorter form:
+	# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
+	echo "$machine-${os}${release}${abi}"
+	exit ;;
+    *:Bitrig:*:*)
+	UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'`
+	echo "$UNAME_MACHINE_ARCH"-unknown-bitrig"$UNAME_RELEASE"
+	exit ;;
+    *:OpenBSD:*:*)
+	UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`
+	echo "$UNAME_MACHINE_ARCH"-unknown-openbsd"$UNAME_RELEASE"
+	exit ;;
+    *:LibertyBSD:*:*)
+	UNAME_MACHINE_ARCH=`arch | sed 's/^.*BSD\.//'`
+	echo "$UNAME_MACHINE_ARCH"-unknown-libertybsd"$UNAME_RELEASE"
+	exit ;;
+    *:MidnightBSD:*:*)
+	echo "$UNAME_MACHINE"-unknown-midnightbsd"$UNAME_RELEASE"
+	exit ;;
+    *:ekkoBSD:*:*)
+	echo "$UNAME_MACHINE"-unknown-ekkobsd"$UNAME_RELEASE"
+	exit ;;
+    *:SolidBSD:*:*)
+	echo "$UNAME_MACHINE"-unknown-solidbsd"$UNAME_RELEASE"
+	exit ;;
+    macppc:MirBSD:*:*)
+	echo powerpc-unknown-mirbsd"$UNAME_RELEASE"
+	exit ;;
+    *:MirBSD:*:*)
+	echo "$UNAME_MACHINE"-unknown-mirbsd"$UNAME_RELEASE"
+	exit ;;
+    *:Sortix:*:*)
+	echo "$UNAME_MACHINE"-unknown-sortix
+	exit ;;
+    *:Redox:*:*)
+	echo "$UNAME_MACHINE"-unknown-redox
+	exit ;;
+    mips:OSF1:*.*)
+        echo mips-dec-osf1
+        exit ;;
+    alpha:OSF1:*:*)
+	case $UNAME_RELEASE in
+	*4.0)
+		UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
+		;;
+	*5.*)
+		UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`
+		;;
+	esac
+	# According to Compaq, /usr/sbin/psrinfo has been available on
+	# OSF/1 and Tru64 systems produced since 1995.  I hope that
+	# covers most systems running today.  This code pipes the CPU
+	# types through head -n 1, so we only detect the type of CPU 0.
+	ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^  The alpha \(.*\) processor.*$/\1/p' | head -n 1`
+	case "$ALPHA_CPU_TYPE" in
+	    "EV4 (21064)")
+		UNAME_MACHINE=alpha ;;
+	    "EV4.5 (21064)")
+		UNAME_MACHINE=alpha ;;
+	    "LCA4 (21066/21068)")
+		UNAME_MACHINE=alpha ;;
+	    "EV5 (21164)")
+		UNAME_MACHINE=alphaev5 ;;
+	    "EV5.6 (21164A)")
+		UNAME_MACHINE=alphaev56 ;;
+	    "EV5.6 (21164PC)")
+		UNAME_MACHINE=alphapca56 ;;
+	    "EV5.7 (21164PC)")
+		UNAME_MACHINE=alphapca57 ;;
+	    "EV6 (21264)")
+		UNAME_MACHINE=alphaev6 ;;
+	    "EV6.7 (21264A)")
+		UNAME_MACHINE=alphaev67 ;;
+	    "EV6.8CB (21264C)")
+		UNAME_MACHINE=alphaev68 ;;
+	    "EV6.8AL (21264B)")
+		UNAME_MACHINE=alphaev68 ;;
+	    "EV6.8CX (21264D)")
+		UNAME_MACHINE=alphaev68 ;;
+	    "EV6.9A (21264/EV69A)")
+		UNAME_MACHINE=alphaev69 ;;
+	    "EV7 (21364)")
+		UNAME_MACHINE=alphaev7 ;;
+	    "EV7.9 (21364A)")
+		UNAME_MACHINE=alphaev79 ;;
+	esac
+	# A Pn.n version is a patched version.
+	# A Vn.n version is a released version.
+	# A Tn.n version is a released field test version.
+	# A Xn.n version is an unreleased experimental baselevel.
+	# 1.2 uses "1.2" for uname -r.
+	echo "$UNAME_MACHINE"-dec-osf"`echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`"
+	# Reset EXIT trap before exiting to avoid spurious non-zero exit code.
+	exitcode=$?
+	trap '' 0
+	exit $exitcode ;;
+    Amiga*:UNIX_System_V:4.0:*)
+	echo m68k-unknown-sysv4
+	exit ;;
+    *:[Aa]miga[Oo][Ss]:*:*)
+	echo "$UNAME_MACHINE"-unknown-amigaos
+	exit ;;
+    *:[Mm]orph[Oo][Ss]:*:*)
+	echo "$UNAME_MACHINE"-unknown-morphos
+	exit ;;
+    *:OS/390:*:*)
+	echo i370-ibm-openedition
+	exit ;;
+    *:z/VM:*:*)
+	echo s390-ibm-zvmoe
+	exit ;;
+    *:OS400:*:*)
+	echo powerpc-ibm-os400
+	exit ;;
+    arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
+	echo arm-acorn-riscix"$UNAME_RELEASE"
+	exit ;;
+    arm*:riscos:*:*|arm*:RISCOS:*:*)
+	echo arm-unknown-riscos
+	exit ;;
+    SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)
+	echo hppa1.1-hitachi-hiuxmpp
+	exit ;;
+    Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
+	# akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
+	if test "`(/bin/universe) 2>/dev/null`" = att ; then
+		echo pyramid-pyramid-sysv3
+	else
+		echo pyramid-pyramid-bsd
+	fi
+	exit ;;
+    NILE*:*:*:dcosx)
+	echo pyramid-pyramid-svr4
+	exit ;;
+    DRS?6000:unix:4.0:6*)
+	echo sparc-icl-nx6
+	exit ;;
+    DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*)
+	case `/usr/bin/uname -p` in
+	    sparc) echo sparc-icl-nx7; exit ;;
+	esac ;;
+    s390x:SunOS:*:*)
+	echo "$UNAME_MACHINE"-ibm-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`"
+	exit ;;
+    sun4H:SunOS:5.*:*)
+	echo sparc-hal-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`"
+	exit ;;
+    sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
+	echo sparc-sun-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`"
+	exit ;;
+    i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*)
+	echo i386-pc-auroraux"$UNAME_RELEASE"
+	exit ;;
+    i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*)
+	eval "$set_cc_for_build"
+	SUN_ARCH=i386
+	# If there is a compiler, see if it is configured for 64-bit objects.
+	# Note that the Sun cc does not turn __LP64__ into 1 like gcc does.
+	# This test works for both compilers.
+	if [ "$CC_FOR_BUILD" != no_compiler_found ]; then
+	    if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \
+		(CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
+		grep IS_64BIT_ARCH >/dev/null
+	    then
+		SUN_ARCH=x86_64
+	    fi
+	fi
+	echo "$SUN_ARCH"-pc-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`"
+	exit ;;
+    sun4*:SunOS:6*:*)
+	# According to config.sub, this is the proper way to canonicalize
+	# SunOS6.  Hard to guess exactly what SunOS6 will be like, but
+	# it's likely to be more like Solaris than SunOS4.
+	echo sparc-sun-solaris3"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`"
+	exit ;;
+    sun4*:SunOS:*:*)
+	case "`/usr/bin/arch -k`" in
+	    Series*|S4*)
+		UNAME_RELEASE=`uname -v`
+		;;
+	esac
+	# Japanese Language versions have a version number like `4.1.3-JL'.
+	echo sparc-sun-sunos"`echo "$UNAME_RELEASE"|sed -e 's/-/_/'`"
+	exit ;;
+    sun3*:SunOS:*:*)
+	echo m68k-sun-sunos"$UNAME_RELEASE"
+	exit ;;
+    sun*:*:4.2BSD:*)
+	UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`
+	test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3
+	case "`/bin/arch`" in
+	    sun3)
+		echo m68k-sun-sunos"$UNAME_RELEASE"
+		;;
+	    sun4)
+		echo sparc-sun-sunos"$UNAME_RELEASE"
+		;;
+	esac
+	exit ;;
+    aushp:SunOS:*:*)
+	echo sparc-auspex-sunos"$UNAME_RELEASE"
+	exit ;;
+    # The situation for MiNT is a little confusing.  The machine name
+    # can be virtually everything (everything which is not
+    # "atarist" or "atariste" at least should have a processor
+    # > m68000).  The system name ranges from "MiNT" over "FreeMiNT"
+    # to the lowercase version "mint" (or "freemint").  Finally
+    # the system name "TOS" denotes a system which is actually not
+    # MiNT.  But MiNT is downward compatible to TOS, so this should
+    # be no problem.
+    atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
+	echo m68k-atari-mint"$UNAME_RELEASE"
+	exit ;;
+    atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
+	echo m68k-atari-mint"$UNAME_RELEASE"
+	exit ;;
+    *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
+	echo m68k-atari-mint"$UNAME_RELEASE"
+	exit ;;
+    milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
+	echo m68k-milan-mint"$UNAME_RELEASE"
+	exit ;;
+    hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
+	echo m68k-hades-mint"$UNAME_RELEASE"
+	exit ;;
+    *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
+	echo m68k-unknown-mint"$UNAME_RELEASE"
+	exit ;;
+    m68k:machten:*:*)
+	echo m68k-apple-machten"$UNAME_RELEASE"
+	exit ;;
+    powerpc:machten:*:*)
+	echo powerpc-apple-machten"$UNAME_RELEASE"
+	exit ;;
+    RISC*:Mach:*:*)
+	echo mips-dec-mach_bsd4.3
+	exit ;;
+    RISC*:ULTRIX:*:*)
+	echo mips-dec-ultrix"$UNAME_RELEASE"
+	exit ;;
+    VAX*:ULTRIX*:*:*)
+	echo vax-dec-ultrix"$UNAME_RELEASE"
+	exit ;;
+    2020:CLIX:*:* | 2430:CLIX:*:*)
+	echo clipper-intergraph-clix"$UNAME_RELEASE"
+	exit ;;
+    mips:*:*:UMIPS | mips:*:*:RISCos)
+	eval "$set_cc_for_build"
+	sed 's/^	//' << EOF > "$dummy.c"
+#ifdef __cplusplus
+#include   /* for printf() prototype */
+	int main (int argc, char *argv[]) {
+#else
+	int main (argc, argv) int argc; char *argv[]; {
+#endif
+	#if defined (host_mips) && defined (MIPSEB)
+	#if defined (SYSTYPE_SYSV)
+	  printf ("mips-mips-riscos%ssysv\\n", argv[1]); exit (0);
+	#endif
+	#if defined (SYSTYPE_SVR4)
+	  printf ("mips-mips-riscos%ssvr4\\n", argv[1]); exit (0);
+	#endif
+	#if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
+	  printf ("mips-mips-riscos%sbsd\\n", argv[1]); exit (0);
+	#endif
+	#endif
+	  exit (-1);
+	}
+EOF
+	$CC_FOR_BUILD -o "$dummy" "$dummy.c" &&
+	  dummyarg=`echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p'` &&
+	  SYSTEM_NAME=`"$dummy" "$dummyarg"` &&
+	    { echo "$SYSTEM_NAME"; exit; }
+	echo mips-mips-riscos"$UNAME_RELEASE"
+	exit ;;
+    Motorola:PowerMAX_OS:*:*)
+	echo powerpc-motorola-powermax
+	exit ;;
+    Motorola:*:4.3:PL8-*)
+	echo powerpc-harris-powermax
+	exit ;;
+    Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*)
+	echo powerpc-harris-powermax
+	exit ;;
+    Night_Hawk:Power_UNIX:*:*)
+	echo powerpc-harris-powerunix
+	exit ;;
+    m88k:CX/UX:7*:*)
+	echo m88k-harris-cxux7
+	exit ;;
+    m88k:*:4*:R4*)
+	echo m88k-motorola-sysv4
+	exit ;;
+    m88k:*:3*:R3*)
+	echo m88k-motorola-sysv3
+	exit ;;
+    AViiON:dgux:*:*)
+	# DG/UX returns AViiON for all architectures
+	UNAME_PROCESSOR=`/usr/bin/uname -p`
+	if [ "$UNAME_PROCESSOR" = mc88100 ] || [ "$UNAME_PROCESSOR" = mc88110 ]
+	then
+	    if [ "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx ] || \
+	       [ "$TARGET_BINARY_INTERFACE"x = x ]
+	    then
+		echo m88k-dg-dgux"$UNAME_RELEASE"
+	    else
+		echo m88k-dg-dguxbcs"$UNAME_RELEASE"
+	    fi
+	else
+	    echo i586-dg-dgux"$UNAME_RELEASE"
+	fi
+	exit ;;
+    M88*:DolphinOS:*:*)	# DolphinOS (SVR3)
+	echo m88k-dolphin-sysv3
+	exit ;;
+    M88*:*:R3*:*)
+	# Delta 88k system running SVR3
+	echo m88k-motorola-sysv3
+	exit ;;
+    XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
+	echo m88k-tektronix-sysv3
+	exit ;;
+    Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
+	echo m68k-tektronix-bsd
+	exit ;;
+    *:IRIX*:*:*)
+	echo mips-sgi-irix"`echo "$UNAME_RELEASE"|sed -e 's/-/_/g'`"
+	exit ;;
+    ????????:AIX?:[12].1:2)   # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
+	echo romp-ibm-aix     # uname -m gives an 8 hex-code CPU id
+	exit ;;               # Note that: echo "'`uname -s`'" gives 'AIX '
+    i*86:AIX:*:*)
+	echo i386-ibm-aix
+	exit ;;
+    ia64:AIX:*:*)
+	if [ -x /usr/bin/oslevel ] ; then
+		IBM_REV=`/usr/bin/oslevel`
+	else
+		IBM_REV="$UNAME_VERSION.$UNAME_RELEASE"
+	fi
+	echo "$UNAME_MACHINE"-ibm-aix"$IBM_REV"
+	exit ;;
+    *:AIX:2:3)
+	if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
+		eval "$set_cc_for_build"
+		sed 's/^		//' << EOF > "$dummy.c"
+		#include 
+
+		main()
+			{
+			if (!__power_pc())
+				exit(1);
+			puts("powerpc-ibm-aix3.2.5");
+			exit(0);
+			}
+EOF
+		if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"`
+		then
+			echo "$SYSTEM_NAME"
+		else
+			echo rs6000-ibm-aix3.2.5
+		fi
+	elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
+		echo rs6000-ibm-aix3.2.4
+	else
+		echo rs6000-ibm-aix3.2
+	fi
+	exit ;;
+    *:AIX:*:[4567])
+	IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`
+	if /usr/sbin/lsattr -El "$IBM_CPU_ID" | grep ' POWER' >/dev/null 2>&1; then
+		IBM_ARCH=rs6000
+	else
+		IBM_ARCH=powerpc
+	fi
+	if [ -x /usr/bin/lslpp ] ; then
+		IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc |
+			   awk -F: '{ print $3 }' | sed s/[0-9]*$/0/`
+	else
+		IBM_REV="$UNAME_VERSION.$UNAME_RELEASE"
+	fi
+	echo "$IBM_ARCH"-ibm-aix"$IBM_REV"
+	exit ;;
+    *:AIX:*:*)
+	echo rs6000-ibm-aix
+	exit ;;
+    ibmrt:4.4BSD:*|romp-ibm:4.4BSD:*)
+	echo romp-ibm-bsd4.4
+	exit ;;
+    ibmrt:*BSD:*|romp-ibm:BSD:*)            # covers RT/PC BSD and
+	echo romp-ibm-bsd"$UNAME_RELEASE"   # 4.3 with uname added to
+	exit ;;                             # report: romp-ibm BSD 4.3
+    *:BOSX:*:*)
+	echo rs6000-bull-bosx
+	exit ;;
+    DPX/2?00:B.O.S.:*:*)
+	echo m68k-bull-sysv3
+	exit ;;
+    9000/[34]??:4.3bsd:1.*:*)
+	echo m68k-hp-bsd
+	exit ;;
+    hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
+	echo m68k-hp-bsd4.4
+	exit ;;
+    9000/[34678]??:HP-UX:*:*)
+	HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'`
+	case "$UNAME_MACHINE" in
+	    9000/31?)            HP_ARCH=m68000 ;;
+	    9000/[34]??)         HP_ARCH=m68k ;;
+	    9000/[678][0-9][0-9])
+		if [ -x /usr/bin/getconf ]; then
+		    sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
+		    sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
+		    case "$sc_cpu_version" in
+		      523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0
+		      528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1
+		      532)                      # CPU_PA_RISC2_0
+			case "$sc_kernel_bits" in
+			  32) HP_ARCH=hppa2.0n ;;
+			  64) HP_ARCH=hppa2.0w ;;
+			  '') HP_ARCH=hppa2.0 ;;   # HP-UX 10.20
+			esac ;;
+		    esac
+		fi
+		if [ "$HP_ARCH" = "" ]; then
+		    eval "$set_cc_for_build"
+		    sed 's/^		//' << EOF > "$dummy.c"
+
+		#define _HPUX_SOURCE
+		#include 
+		#include 
+
+		int main ()
+		{
+		#if defined(_SC_KERNEL_BITS)
+		    long bits = sysconf(_SC_KERNEL_BITS);
+		#endif
+		    long cpu  = sysconf (_SC_CPU_VERSION);
+
+		    switch (cpu)
+			{
+			case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
+			case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
+			case CPU_PA_RISC2_0:
+		#if defined(_SC_KERNEL_BITS)
+			    switch (bits)
+				{
+				case 64: puts ("hppa2.0w"); break;
+				case 32: puts ("hppa2.0n"); break;
+				default: puts ("hppa2.0"); break;
+				} break;
+		#else  /* !defined(_SC_KERNEL_BITS) */
+			    puts ("hppa2.0"); break;
+		#endif
+			default: puts ("hppa1.0"); break;
+			}
+		    exit (0);
+		}
+EOF
+		    (CCOPTS="" $CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null) && HP_ARCH=`"$dummy"`
+		    test -z "$HP_ARCH" && HP_ARCH=hppa
+		fi ;;
+	esac
+	if [ "$HP_ARCH" = hppa2.0w ]
+	then
+	    eval "$set_cc_for_build"
+
+	    # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating
+	    # 32-bit code.  hppa64-hp-hpux* has the same kernel and a compiler
+	    # generating 64-bit code.  GNU and HP use different nomenclature:
+	    #
+	    # $ CC_FOR_BUILD=cc ./config.guess
+	    # => hppa2.0w-hp-hpux11.23
+	    # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess
+	    # => hppa64-hp-hpux11.23
+
+	    if echo __LP64__ | (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) |
+		grep -q __LP64__
+	    then
+		HP_ARCH=hppa2.0w
+	    else
+		HP_ARCH=hppa64
+	    fi
+	fi
+	echo "$HP_ARCH"-hp-hpux"$HPUX_REV"
+	exit ;;
+    ia64:HP-UX:*:*)
+	HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'`
+	echo ia64-hp-hpux"$HPUX_REV"
+	exit ;;
+    3050*:HI-UX:*:*)
+	eval "$set_cc_for_build"
+	sed 's/^	//' << EOF > "$dummy.c"
+	#include 
+	int
+	main ()
+	{
+	  long cpu = sysconf (_SC_CPU_VERSION);
+	  /* The order matters, because CPU_IS_HP_MC68K erroneously returns
+	     true for CPU_PA_RISC1_0.  CPU_IS_PA_RISC returns correct
+	     results, however.  */
+	  if (CPU_IS_PA_RISC (cpu))
+	    {
+	      switch (cpu)
+		{
+		  case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
+		  case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
+		  case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
+		  default: puts ("hppa-hitachi-hiuxwe2"); break;
+		}
+	    }
+	  else if (CPU_IS_HP_MC68K (cpu))
+	    puts ("m68k-hitachi-hiuxwe2");
+	  else puts ("unknown-hitachi-hiuxwe2");
+	  exit (0);
+	}
+EOF
+	$CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` &&
+		{ echo "$SYSTEM_NAME"; exit; }
+	echo unknown-hitachi-hiuxwe2
+	exit ;;
+    9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:*)
+	echo hppa1.1-hp-bsd
+	exit ;;
+    9000/8??:4.3bsd:*:*)
+	echo hppa1.0-hp-bsd
+	exit ;;
+    *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)
+	echo hppa1.0-hp-mpeix
+	exit ;;
+    hp7??:OSF1:*:* | hp8?[79]:OSF1:*:*)
+	echo hppa1.1-hp-osf
+	exit ;;
+    hp8??:OSF1:*:*)
+	echo hppa1.0-hp-osf
+	exit ;;
+    i*86:OSF1:*:*)
+	if [ -x /usr/sbin/sysversion ] ; then
+	    echo "$UNAME_MACHINE"-unknown-osf1mk
+	else
+	    echo "$UNAME_MACHINE"-unknown-osf1
+	fi
+	exit ;;
+    parisc*:Lites*:*:*)
+	echo hppa1.1-hp-lites
+	exit ;;
+    C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
+	echo c1-convex-bsd
+	exit ;;
+    C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
+	if getsysinfo -f scalar_acc
+	then echo c32-convex-bsd
+	else echo c2-convex-bsd
+	fi
+	exit ;;
+    C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
+	echo c34-convex-bsd
+	exit ;;
+    C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
+	echo c38-convex-bsd
+	exit ;;
+    C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
+	echo c4-convex-bsd
+	exit ;;
+    CRAY*Y-MP:*:*:*)
+	echo ymp-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*[A-Z]90:*:*:*)
+	echo "$UNAME_MACHINE"-cray-unicos"$UNAME_RELEASE" \
+	| sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
+	      -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \
+	      -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*TS:*:*:*)
+	echo t90-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*T3E:*:*:*)
+	echo alphaev5-cray-unicosmk"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*SV1:*:*:*)
+	echo sv1-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    *:UNICOS/mp:*:*)
+	echo craynv-cray-unicosmp"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)
+	FUJITSU_PROC=`uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`
+	FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'`
+	FUJITSU_REL=`echo "$UNAME_RELEASE" | sed -e 's/ /_/'`
+	echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
+	exit ;;
+    5000:UNIX_System_V:4.*:*)
+	FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'`
+	FUJITSU_REL=`echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/'`
+	echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
+	exit ;;
+    i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
+	echo "$UNAME_MACHINE"-pc-bsdi"$UNAME_RELEASE"
+	exit ;;
+    sparc*:BSD/OS:*:*)
+	echo sparc-unknown-bsdi"$UNAME_RELEASE"
+	exit ;;
+    *:BSD/OS:*:*)
+	echo "$UNAME_MACHINE"-unknown-bsdi"$UNAME_RELEASE"
+	exit ;;
+    *:FreeBSD:*:*)
+	UNAME_PROCESSOR=`/usr/bin/uname -p`
+	case "$UNAME_PROCESSOR" in
+	    amd64)
+		UNAME_PROCESSOR=x86_64 ;;
+	    i386)
+		UNAME_PROCESSOR=i586 ;;
+	esac
+	echo "$UNAME_PROCESSOR"-unknown-freebsd"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`"
+	exit ;;
+    i*:CYGWIN*:*)
+	echo "$UNAME_MACHINE"-pc-cygwin
+	exit ;;
+    *:MINGW64*:*)
+	echo "$UNAME_MACHINE"-pc-mingw64
+	exit ;;
+    *:MINGW*:*)
+	echo "$UNAME_MACHINE"-pc-mingw32
+	exit ;;
+    *:MSYS*:*)
+	echo "$UNAME_MACHINE"-pc-msys
+	exit ;;
+    i*:PW*:*)
+	echo "$UNAME_MACHINE"-pc-pw32
+	exit ;;
+    *:Interix*:*)
+	case "$UNAME_MACHINE" in
+	    x86)
+		echo i586-pc-interix"$UNAME_RELEASE"
+		exit ;;
+	    authenticamd | genuineintel | EM64T)
+		echo x86_64-unknown-interix"$UNAME_RELEASE"
+		exit ;;
+	    IA64)
+		echo ia64-unknown-interix"$UNAME_RELEASE"
+		exit ;;
+	esac ;;
+    i*:UWIN*:*)
+	echo "$UNAME_MACHINE"-pc-uwin
+	exit ;;
+    amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)
+	echo x86_64-unknown-cygwin
+	exit ;;
+    prep*:SunOS:5.*:*)
+	echo powerpcle-unknown-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`"
+	exit ;;
+    *:GNU:*:*)
+	# the GNU system
+	echo "`echo "$UNAME_MACHINE"|sed -e 's,[-/].*$,,'`-unknown-$LIBC`echo "$UNAME_RELEASE"|sed -e 's,/.*$,,'`"
+	exit ;;
+    *:GNU/*:*:*)
+	# other systems with GNU libc and userland
+	echo "$UNAME_MACHINE-unknown-`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"``echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`-$LIBC"
+	exit ;;
+    i*86:Minix:*:*)
+	echo "$UNAME_MACHINE"-pc-minix
+	exit ;;
+    aarch64:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    aarch64_be:Linux:*:*)
+	UNAME_MACHINE=aarch64_be
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    alpha:Linux:*:*)
+	case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
+	  EV5)   UNAME_MACHINE=alphaev5 ;;
+	  EV56)  UNAME_MACHINE=alphaev56 ;;
+	  PCA56) UNAME_MACHINE=alphapca56 ;;
+	  PCA57) UNAME_MACHINE=alphapca56 ;;
+	  EV6)   UNAME_MACHINE=alphaev6 ;;
+	  EV67)  UNAME_MACHINE=alphaev67 ;;
+	  EV68*) UNAME_MACHINE=alphaev68 ;;
+	esac
+	objdump --private-headers /bin/sh | grep -q ld.so.1
+	if test "$?" = 0 ; then LIBC=gnulibc1 ; fi
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    arc:Linux:*:* | arceb:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    arm*:Linux:*:*)
+	eval "$set_cc_for_build"
+	if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \
+	    | grep -q __ARM_EABI__
+	then
+	    echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	else
+	    if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \
+		| grep -q __ARM_PCS_VFP
+	    then
+		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabi
+	    else
+		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabihf
+	    fi
+	fi
+	exit ;;
+    avr32*:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    cris:Linux:*:*)
+	echo "$UNAME_MACHINE"-axis-linux-"$LIBC"
+	exit ;;
+    crisv32:Linux:*:*)
+	echo "$UNAME_MACHINE"-axis-linux-"$LIBC"
+	exit ;;
+    e2k:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    frv:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    hexagon:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    i*86:Linux:*:*)
+	echo "$UNAME_MACHINE"-pc-linux-"$LIBC"
+	exit ;;
+    ia64:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    k1om:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    m32r*:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    m68*:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    mips:Linux:*:* | mips64:Linux:*:*)
+	eval "$set_cc_for_build"
+	sed 's/^	//' << EOF > "$dummy.c"
+	#undef CPU
+	#undef ${UNAME_MACHINE}
+	#undef ${UNAME_MACHINE}el
+	#if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
+	CPU=${UNAME_MACHINE}el
+	#else
+	#if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
+	CPU=${UNAME_MACHINE}
+	#else
+	CPU=
+	#endif
+	#endif
+EOF
+	eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU'`"
+	test "x$CPU" != x && { echo "$CPU-unknown-linux-$LIBC"; exit; }
+	;;
+    mips64el:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    openrisc*:Linux:*:*)
+	echo or1k-unknown-linux-"$LIBC"
+	exit ;;
+    or32:Linux:*:* | or1k*:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    padre:Linux:*:*)
+	echo sparc-unknown-linux-"$LIBC"
+	exit ;;
+    parisc64:Linux:*:* | hppa64:Linux:*:*)
+	echo hppa64-unknown-linux-"$LIBC"
+	exit ;;
+    parisc:Linux:*:* | hppa:Linux:*:*)
+	# Look for CPU level
+	case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in
+	  PA7*) echo hppa1.1-unknown-linux-"$LIBC" ;;
+	  PA8*) echo hppa2.0-unknown-linux-"$LIBC" ;;
+	  *)    echo hppa-unknown-linux-"$LIBC" ;;
+	esac
+	exit ;;
+    ppc64:Linux:*:*)
+	echo powerpc64-unknown-linux-"$LIBC"
+	exit ;;
+    ppc:Linux:*:*)
+	echo powerpc-unknown-linux-"$LIBC"
+	exit ;;
+    ppc64le:Linux:*:*)
+	echo powerpc64le-unknown-linux-"$LIBC"
+	exit ;;
+    ppcle:Linux:*:*)
+	echo powerpcle-unknown-linux-"$LIBC"
+	exit ;;
+    riscv32:Linux:*:* | riscv64:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    s390:Linux:*:* | s390x:Linux:*:*)
+	echo "$UNAME_MACHINE"-ibm-linux-"$LIBC"
+	exit ;;
+    sh64*:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    sh*:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    sparc:Linux:*:* | sparc64:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    tile*:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    vax:Linux:*:*)
+	echo "$UNAME_MACHINE"-dec-linux-"$LIBC"
+	exit ;;
+    x86_64:Linux:*:*)
+	if objdump -f /bin/sh | grep -q elf32-x86-64; then
+	    echo "$UNAME_MACHINE"-pc-linux-"$LIBC"x32
+	else
+	    echo "$UNAME_MACHINE"-pc-linux-"$LIBC"
+	fi
+	exit ;;
+    xtensa*:Linux:*:*)
+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+	exit ;;
+    i*86:DYNIX/ptx:4*:*)
+	# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
+	# earlier versions are messed up and put the nodename in both
+	# sysname and nodename.
+	echo i386-sequent-sysv4
+	exit ;;
+    i*86:UNIX_SV:4.2MP:2.*)
+	# Unixware is an offshoot of SVR4, but it has its own version
+	# number series starting with 2...
+	# I am not positive that other SVR4 systems won't match this,
+	# I just have to hope.  -- rms.
+	# Use sysv4.2uw... so that sysv4* matches it.
+	echo "$UNAME_MACHINE"-pc-sysv4.2uw"$UNAME_VERSION"
+	exit ;;
+    i*86:OS/2:*:*)
+	# If we were able to find `uname', then EMX Unix compatibility
+	# is probably installed.
+	echo "$UNAME_MACHINE"-pc-os2-emx
+	exit ;;
+    i*86:XTS-300:*:STOP)
+	echo "$UNAME_MACHINE"-unknown-stop
+	exit ;;
+    i*86:atheos:*:*)
+	echo "$UNAME_MACHINE"-unknown-atheos
+	exit ;;
+    i*86:syllable:*:*)
+	echo "$UNAME_MACHINE"-pc-syllable
+	exit ;;
+    i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*)
+	echo i386-unknown-lynxos"$UNAME_RELEASE"
+	exit ;;
+    i*86:*DOS:*:*)
+	echo "$UNAME_MACHINE"-pc-msdosdjgpp
+	exit ;;
+    i*86:*:4.*:*)
+	UNAME_REL=`echo "$UNAME_RELEASE" | sed 's/\/MP$//'`
+	if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+		echo "$UNAME_MACHINE"-univel-sysv"$UNAME_REL"
+	else
+		echo "$UNAME_MACHINE"-pc-sysv"$UNAME_REL"
+	fi
+	exit ;;
+    i*86:*:5:[678]*)
+	# UnixWare 7.x, OpenUNIX and OpenServer 6.
+	case `/bin/uname -X | grep "^Machine"` in
+	    *486*)	     UNAME_MACHINE=i486 ;;
+	    *Pentium)	     UNAME_MACHINE=i586 ;;
+	    *Pent*|*Celeron) UNAME_MACHINE=i686 ;;
+	esac
+	echo "$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}{$UNAME_VERSION}"
+	exit ;;
+    i*86:*:3.2:*)
+	if test -f /usr/options/cb.name; then
+		UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then
+		UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')`
+		(/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486
+		(/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \
+			&& UNAME_MACHINE=i586
+		(/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \
+			&& UNAME_MACHINE=i686
+		(/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \
+			&& UNAME_MACHINE=i686
+		echo "$UNAME_MACHINE"-pc-sco"$UNAME_REL"
+	else
+		echo "$UNAME_MACHINE"-pc-sysv32
+	fi
+	exit ;;
+    pc:*:*:*)
+	# Left here for compatibility:
+	# uname -m prints for DJGPP always 'pc', but it prints nothing about
+	# the processor, so we play safe by assuming i586.
+	# Note: whatever this is, it MUST be the same as what config.sub
+	# prints for the "djgpp" host, or else GDB configure will decide that
+	# this is a cross-build.
+	echo i586-pc-msdosdjgpp
+	exit ;;
+    Intel:Mach:3*:*)
+	echo i386-pc-mach3
+	exit ;;
+    paragon:*:*:*)
+	echo i860-intel-osf1
+	exit ;;
+    i860:*:4.*:*) # i860-SVR4
+	if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
+	  echo i860-stardent-sysv"$UNAME_RELEASE" # Stardent Vistra i860-SVR4
+	else # Add other i860-SVR4 vendors below as they are discovered.
+	  echo i860-unknown-sysv"$UNAME_RELEASE"  # Unknown i860-SVR4
+	fi
+	exit ;;
+    mini*:CTIX:SYS*5:*)
+	# "miniframe"
+	echo m68010-convergent-sysv
+	exit ;;
+    mc68k:UNIX:SYSTEM5:3.51m)
+	echo m68k-convergent-sysv
+	exit ;;
+    M680?0:D-NIX:5.3:*)
+	echo m68k-diab-dnix
+	exit ;;
+    M68*:*:R3V[5678]*:*)
+	test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;;
+    3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0)
+	OS_REL=''
+	test -r /etc/.relid \
+	&& OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+	  && { echo i486-ncr-sysv4.3"$OS_REL"; exit; }
+	/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
+	  && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;;
+    3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
+	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+	  && { echo i486-ncr-sysv4; exit; } ;;
+    NCR*:*:4.2:* | MPRAS*:*:4.2:*)
+	OS_REL='.3'
+	test -r /etc/.relid \
+	    && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+	    && { echo i486-ncr-sysv4.3"$OS_REL"; exit; }
+	/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
+	    && { echo i586-ncr-sysv4.3"$OS_REL"; exit; }
+	/bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \
+	    && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;;
+    m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)
+	echo m68k-unknown-lynxos"$UNAME_RELEASE"
+	exit ;;
+    mc68030:UNIX_System_V:4.*:*)
+	echo m68k-atari-sysv4
+	exit ;;
+    TSUNAMI:LynxOS:2.*:*)
+	echo sparc-unknown-lynxos"$UNAME_RELEASE"
+	exit ;;
+    rs6000:LynxOS:2.*:*)
+	echo rs6000-unknown-lynxos"$UNAME_RELEASE"
+	exit ;;
+    PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*)
+	echo powerpc-unknown-lynxos"$UNAME_RELEASE"
+	exit ;;
+    SM[BE]S:UNIX_SV:*:*)
+	echo mips-dde-sysv"$UNAME_RELEASE"
+	exit ;;
+    RM*:ReliantUNIX-*:*:*)
+	echo mips-sni-sysv4
+	exit ;;
+    RM*:SINIX-*:*:*)
+	echo mips-sni-sysv4
+	exit ;;
+    *:SINIX-*:*:*)
+	if uname -p 2>/dev/null >/dev/null ; then
+		UNAME_MACHINE=`(uname -p) 2>/dev/null`
+		echo "$UNAME_MACHINE"-sni-sysv4
+	else
+		echo ns32k-sni-sysv
+	fi
+	exit ;;
+    PENTIUM:*:4.0*:*)	# Unisys `ClearPath HMP IX 4000' SVR4/MP effort
+			# says 
+	echo i586-unisys-sysv4
+	exit ;;
+    *:UNIX_System_V:4*:FTX*)
+	# From Gerald Hewes .
+	# How about differentiating between stratus architectures? -djm
+	echo hppa1.1-stratus-sysv4
+	exit ;;
+    *:*:*:FTX*)
+	# From seanf@swdc.stratus.com.
+	echo i860-stratus-sysv4
+	exit ;;
+    i*86:VOS:*:*)
+	# From Paul.Green@stratus.com.
+	echo "$UNAME_MACHINE"-stratus-vos
+	exit ;;
+    *:VOS:*:*)
+	# From Paul.Green@stratus.com.
+	echo hppa1.1-stratus-vos
+	exit ;;
+    mc68*:A/UX:*:*)
+	echo m68k-apple-aux"$UNAME_RELEASE"
+	exit ;;
+    news*:NEWS-OS:6*:*)
+	echo mips-sony-newsos6
+	exit ;;
+    R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
+	if [ -d /usr/nec ]; then
+		echo mips-nec-sysv"$UNAME_RELEASE"
+	else
+		echo mips-unknown-sysv"$UNAME_RELEASE"
+	fi
+	exit ;;
+    BeBox:BeOS:*:*)	# BeOS running on hardware made by Be, PPC only.
+	echo powerpc-be-beos
+	exit ;;
+    BeMac:BeOS:*:*)	# BeOS running on Mac or Mac clone, PPC only.
+	echo powerpc-apple-beos
+	exit ;;
+    BePC:BeOS:*:*)	# BeOS running on Intel PC compatible.
+	echo i586-pc-beos
+	exit ;;
+    BePC:Haiku:*:*)	# Haiku running on Intel PC compatible.
+	echo i586-pc-haiku
+	exit ;;
+    x86_64:Haiku:*:*)
+	echo x86_64-unknown-haiku
+	exit ;;
+    SX-4:SUPER-UX:*:*)
+	echo sx4-nec-superux"$UNAME_RELEASE"
+	exit ;;
+    SX-5:SUPER-UX:*:*)
+	echo sx5-nec-superux"$UNAME_RELEASE"
+	exit ;;
+    SX-6:SUPER-UX:*:*)
+	echo sx6-nec-superux"$UNAME_RELEASE"
+	exit ;;
+    SX-7:SUPER-UX:*:*)
+	echo sx7-nec-superux"$UNAME_RELEASE"
+	exit ;;
+    SX-8:SUPER-UX:*:*)
+	echo sx8-nec-superux"$UNAME_RELEASE"
+	exit ;;
+    SX-8R:SUPER-UX:*:*)
+	echo sx8r-nec-superux"$UNAME_RELEASE"
+	exit ;;
+    SX-ACE:SUPER-UX:*:*)
+	echo sxace-nec-superux"$UNAME_RELEASE"
+	exit ;;
+    Power*:Rhapsody:*:*)
+	echo powerpc-apple-rhapsody"$UNAME_RELEASE"
+	exit ;;
+    *:Rhapsody:*:*)
+	echo "$UNAME_MACHINE"-apple-rhapsody"$UNAME_RELEASE"
+	exit ;;
+    *:Darwin:*:*)
+	UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown
+	eval "$set_cc_for_build"
+	if test "$UNAME_PROCESSOR" = unknown ; then
+	    UNAME_PROCESSOR=powerpc
+	fi
+	if test "`echo "$UNAME_RELEASE" | sed -e 's/\..*//'`" -le 10 ; then
+	    if [ "$CC_FOR_BUILD" != no_compiler_found ]; then
+		if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \
+		       (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
+		       grep IS_64BIT_ARCH >/dev/null
+		then
+		    case $UNAME_PROCESSOR in
+			i386) UNAME_PROCESSOR=x86_64 ;;
+			powerpc) UNAME_PROCESSOR=powerpc64 ;;
+		    esac
+		fi
+		# On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc
+		if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \
+		       (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
+		       grep IS_PPC >/dev/null
+		then
+		    UNAME_PROCESSOR=powerpc
+		fi
+	    fi
+	elif test "$UNAME_PROCESSOR" = i386 ; then
+	    # Avoid executing cc on OS X 10.9, as it ships with a stub
+	    # that puts up a graphical alert prompting to install
+	    # developer tools.  Any system running Mac OS X 10.7 or
+	    # later (Darwin 11 and later) is required to have a 64-bit
+	    # processor. This is not true of the ARM version of Darwin
+	    # that Apple uses in portable devices.
+	    UNAME_PROCESSOR=x86_64
+	fi
+	echo "$UNAME_PROCESSOR"-apple-darwin"$UNAME_RELEASE"
+	exit ;;
+    *:procnto*:*:* | *:QNX:[0123456789]*:*)
+	UNAME_PROCESSOR=`uname -p`
+	if test "$UNAME_PROCESSOR" = x86; then
+		UNAME_PROCESSOR=i386
+		UNAME_MACHINE=pc
+	fi
+	echo "$UNAME_PROCESSOR"-"$UNAME_MACHINE"-nto-qnx"$UNAME_RELEASE"
+	exit ;;
+    *:QNX:*:4*)
+	echo i386-pc-qnx
+	exit ;;
+    NEO-*:NONSTOP_KERNEL:*:*)
+	echo neo-tandem-nsk"$UNAME_RELEASE"
+	exit ;;
+    NSE-*:NONSTOP_KERNEL:*:*)
+	echo nse-tandem-nsk"$UNAME_RELEASE"
+	exit ;;
+    NSR-*:NONSTOP_KERNEL:*:*)
+	echo nsr-tandem-nsk"$UNAME_RELEASE"
+	exit ;;
+    NSV-*:NONSTOP_KERNEL:*:*)
+	echo nsv-tandem-nsk"$UNAME_RELEASE"
+	exit ;;
+    NSX-*:NONSTOP_KERNEL:*:*)
+	echo nsx-tandem-nsk"$UNAME_RELEASE"
+	exit ;;
+    *:NonStop-UX:*:*)
+	echo mips-compaq-nonstopux
+	exit ;;
+    BS2000:POSIX*:*:*)
+	echo bs2000-siemens-sysv
+	exit ;;
+    DS/*:UNIX_System_V:*:*)
+	echo "$UNAME_MACHINE"-"$UNAME_SYSTEM"-"$UNAME_RELEASE"
+	exit ;;
+    *:Plan9:*:*)
+	# "uname -m" is not consistent, so use $cputype instead. 386
+	# is converted to i386 for consistency with other x86
+	# operating systems.
+	if test "$cputype" = 386; then
+	    UNAME_MACHINE=i386
+	else
+	    UNAME_MACHINE="$cputype"
+	fi
+	echo "$UNAME_MACHINE"-unknown-plan9
+	exit ;;
+    *:TOPS-10:*:*)
+	echo pdp10-unknown-tops10
+	exit ;;
+    *:TENEX:*:*)
+	echo pdp10-unknown-tenex
+	exit ;;
+    KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)
+	echo pdp10-dec-tops20
+	exit ;;
+    XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)
+	echo pdp10-xkl-tops20
+	exit ;;
+    *:TOPS-20:*:*)
+	echo pdp10-unknown-tops20
+	exit ;;
+    *:ITS:*:*)
+	echo pdp10-unknown-its
+	exit ;;
+    SEI:*:*:SEIUX)
+	echo mips-sei-seiux"$UNAME_RELEASE"
+	exit ;;
+    *:DragonFly:*:*)
+	echo "$UNAME_MACHINE"-unknown-dragonfly"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`"
+	exit ;;
+    *:*VMS:*:*)
+	UNAME_MACHINE=`(uname -p) 2>/dev/null`
+	case "$UNAME_MACHINE" in
+	    A*) echo alpha-dec-vms ; exit ;;
+	    I*) echo ia64-dec-vms ; exit ;;
+	    V*) echo vax-dec-vms ; exit ;;
+	esac ;;
+    *:XENIX:*:SysV)
+	echo i386-pc-xenix
+	exit ;;
+    i*86:skyos:*:*)
+	echo "$UNAME_MACHINE"-pc-skyos"`echo "$UNAME_RELEASE" | sed -e 's/ .*$//'`"
+	exit ;;
+    i*86:rdos:*:*)
+	echo "$UNAME_MACHINE"-pc-rdos
+	exit ;;
+    i*86:AROS:*:*)
+	echo "$UNAME_MACHINE"-pc-aros
+	exit ;;
+    x86_64:VMkernel:*:*)
+	echo "$UNAME_MACHINE"-unknown-esx
+	exit ;;
+    amd64:Isilon\ OneFS:*:*)
+	echo x86_64-unknown-onefs
+	exit ;;
+esac
+
+echo "$0: unable to guess system type" >&2
+
+case "$UNAME_MACHINE:$UNAME_SYSTEM" in
+    mips:Linux | mips64:Linux)
+	# If we got here on MIPS GNU/Linux, output extra information.
+	cat >&2 <&2 </dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null`
+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null`
+
+hostinfo               = `(hostinfo) 2>/dev/null`
+/bin/universe          = `(/bin/universe) 2>/dev/null`
+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null`
+/bin/arch              = `(/bin/arch) 2>/dev/null`
+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null`
+
+UNAME_MACHINE = "$UNAME_MACHINE"
+UNAME_RELEASE = "$UNAME_RELEASE"
+UNAME_SYSTEM  = "$UNAME_SYSTEM"
+UNAME_VERSION = "$UNAME_VERSION"
+EOF
+
+exit 1
+
+# Local variables:
+# eval: (add-hook 'write-file-functions 'time-stamp)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%:y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
diff --git a/build-aux/config.sub b/build-aux/config.sub
new file mode 100755
index 00000000..1d8e98bc
--- /dev/null
+++ b/build-aux/config.sub
@@ -0,0 +1,1801 @@
+#! /bin/sh
+# Configuration validation subroutine script.
+#   Copyright 1992-2018 Free Software Foundation, Inc.
+
+timestamp='2018-02-22'
+
+# This file is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, see .
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that
+# program.  This Exception is an additional permission under section 7
+# of the GNU General Public License, version 3 ("GPLv3").
+
+
+# Please send patches to .
+#
+# Configuration subroutine to validate and canonicalize a configuration type.
+# Supply the specified configuration type as an argument.
+# If it is invalid, we print an error message on stderr and exit with code 1.
+# Otherwise, we print the canonical config type on stdout and succeed.
+
+# You can get the latest version of this script from:
+# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub
+
+# This file is supposed to be the same for all GNU packages
+# and recognize all the CPU types, system types and aliases
+# that are meaningful with *any* GNU software.
+# Each package is responsible for reporting which valid configurations
+# it does not support.  The user should be able to distinguish
+# a failure to support a valid configuration from a meaningless
+# configuration.
+
+# The goal of this file is to map all the various variations of a given
+# machine specification into a single specification in the form:
+#	CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
+# or in some cases, the newer four-part form:
+#	CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
+# It is wrong to echo any other type of specification.
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION] CPU-MFR-OPSYS or ALIAS
+
+Canonicalize a configuration name.
+
+Options:
+  -h, --help         print this help, then exit
+  -t, --time-stamp   print date of last modification, then exit
+  -v, --version      print version number, then exit
+
+Report bugs and patches to ."
+
+version="\
+GNU config.sub ($timestamp)
+
+Copyright 1992-2018 Free Software Foundation, Inc.
+
+This is free software; see the source for copying conditions.  There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+
+help="
+Try \`$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+  case $1 in
+    --time-stamp | --time* | -t )
+       echo "$timestamp" ; exit ;;
+    --version | -v )
+       echo "$version" ; exit ;;
+    --help | --h* | -h )
+       echo "$usage"; exit ;;
+    -- )     # Stop option processing
+       shift; break ;;
+    - )	# Use stdin as input.
+       break ;;
+    -* )
+       echo "$me: invalid option $1$help"
+       exit 1 ;;
+
+    *local*)
+       # First pass through any local machine types.
+       echo "$1"
+       exit ;;
+
+    * )
+       break ;;
+  esac
+done
+
+case $# in
+ 0) echo "$me: missing argument$help" >&2
+    exit 1;;
+ 1) ;;
+ *) echo "$me: too many arguments$help" >&2
+    exit 1;;
+esac
+
+# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).
+# Here we must recognize all the valid KERNEL-OS combinations.
+maybe_os=`echo "$1" | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
+case $maybe_os in
+  nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \
+  linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \
+  knetbsd*-gnu* | netbsd*-gnu* | netbsd*-eabi* | \
+  kopensolaris*-gnu* | cloudabi*-eabi* | \
+  storm-chaos* | os2-emx* | rtmk-nova*)
+    os=-$maybe_os
+    basic_machine=`echo "$1" | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
+    ;;
+  android-linux)
+    os=-linux-android
+    basic_machine=`echo "$1" | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown
+    ;;
+  *)
+    basic_machine=`echo "$1" | sed 's/-[^-]*$//'`
+    if [ "$basic_machine" != "$1" ]
+    then os=`echo "$1" | sed 's/.*-/-/'`
+    else os=; fi
+    ;;
+esac
+
+### Let's recognize common machines as not being operating systems so
+### that things like config.sub decstation-3100 work.  We also
+### recognize some manufacturers as not being operating systems, so we
+### can provide default operating systems below.
+case $os in
+	-sun*os*)
+		# Prevent following clause from handling this invalid input.
+		;;
+	-dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \
+	-att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \
+	-unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \
+	-convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
+	-c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
+	-harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
+	-apple | -axis | -knuth | -cray | -microblaze*)
+		os=
+		basic_machine=$1
+		;;
+	-bluegene*)
+		os=-cnk
+		;;
+	-sim | -cisco | -oki | -wec | -winbond)
+		os=
+		basic_machine=$1
+		;;
+	-scout)
+		;;
+	-wrs)
+		os=-vxworks
+		basic_machine=$1
+		;;
+	-chorusos*)
+		os=-chorusos
+		basic_machine=$1
+		;;
+	-chorusrdb)
+		os=-chorusrdb
+		basic_machine=$1
+		;;
+	-hiux*)
+		os=-hiuxwe2
+		;;
+	-sco6)
+		os=-sco5v6
+		basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco5)
+		os=-sco3.2v5
+		basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco4)
+		os=-sco3.2v4
+		basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco3.2.[4-9]*)
+		os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
+		basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco3.2v[4-9]*)
+		# Don't forget version if it is 3.2v4 or newer.
+		basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco5v6*)
+		# Don't forget version if it is 3.2v4 or newer.
+		basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco*)
+		os=-sco3.2v2
+		basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
+		;;
+	-udk*)
+		basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
+		;;
+	-isc)
+		os=-isc2.2
+		basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
+		;;
+	-clix*)
+		basic_machine=clipper-intergraph
+		;;
+	-isc*)
+		basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
+		;;
+	-lynx*178)
+		os=-lynxos178
+		;;
+	-lynx*5)
+		os=-lynxos5
+		;;
+	-lynx*)
+		os=-lynxos
+		;;
+	-ptx*)
+		basic_machine=`echo "$1" | sed -e 's/86-.*/86-sequent/'`
+		;;
+	-psos*)
+		os=-psos
+		;;
+	-mint | -mint[0-9]*)
+		basic_machine=m68k-atari
+		os=-mint
+		;;
+esac
+
+# Decode aliases for certain CPU-COMPANY combinations.
+case $basic_machine in
+	# Recognize the basic CPU types without company name.
+	# Some are omitted here because they have special meanings below.
+	1750a | 580 \
+	| a29k \
+	| aarch64 | aarch64_be \
+	| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
+	| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \
+	| am33_2.0 \
+	| arc | arceb \
+	| arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \
+	| avr | avr32 \
+	| ba \
+	| be32 | be64 \
+	| bfin \
+	| c4x | c8051 | clipper \
+	| d10v | d30v | dlx | dsp16xx \
+	| e2k | epiphany \
+	| fido | fr30 | frv | ft32 \
+	| h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
+	| hexagon \
+	| i370 | i860 | i960 | ia16 | ia64 \
+	| ip2k | iq2000 \
+	| k1om \
+	| le32 | le64 \
+	| lm32 \
+	| m32c | m32r | m32rle | m68000 | m68k | m88k \
+	| maxq | mb | microblaze | microblazeel | mcore | mep | metag \
+	| mips | mipsbe | mipseb | mipsel | mipsle \
+	| mips16 \
+	| mips64 | mips64el \
+	| mips64octeon | mips64octeonel \
+	| mips64orion | mips64orionel \
+	| mips64r5900 | mips64r5900el \
+	| mips64vr | mips64vrel \
+	| mips64vr4100 | mips64vr4100el \
+	| mips64vr4300 | mips64vr4300el \
+	| mips64vr5000 | mips64vr5000el \
+	| mips64vr5900 | mips64vr5900el \
+	| mipsisa32 | mipsisa32el \
+	| mipsisa32r2 | mipsisa32r2el \
+	| mipsisa32r6 | mipsisa32r6el \
+	| mipsisa64 | mipsisa64el \
+	| mipsisa64r2 | mipsisa64r2el \
+	| mipsisa64r6 | mipsisa64r6el \
+	| mipsisa64sb1 | mipsisa64sb1el \
+	| mipsisa64sr71k | mipsisa64sr71kel \
+	| mipsr5900 | mipsr5900el \
+	| mipstx39 | mipstx39el \
+	| mn10200 | mn10300 \
+	| moxie \
+	| mt \
+	| msp430 \
+	| nds32 | nds32le | nds32be \
+	| nios | nios2 | nios2eb | nios2el \
+	| ns16k | ns32k \
+	| open8 | or1k | or1knd | or32 \
+	| pdp10 | pj | pjl \
+	| powerpc | powerpc64 | powerpc64le | powerpcle \
+	| pru \
+	| pyramid \
+	| riscv32 | riscv64 \
+	| rl78 | rx \
+	| score \
+	| sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[234]eb | sheb | shbe | shle | sh[1234]le | sh3ele \
+	| sh64 | sh64le \
+	| sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \
+	| sparcv8 | sparcv9 | sparcv9b | sparcv9v \
+	| spu \
+	| tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \
+	| ubicom32 \
+	| v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \
+	| visium \
+	| wasm32 \
+	| x86 | xc16x | xstormy16 | xtensa \
+	| z8k | z80)
+		basic_machine=$basic_machine-unknown
+		;;
+	c54x)
+		basic_machine=tic54x-unknown
+		;;
+	c55x)
+		basic_machine=tic55x-unknown
+		;;
+	c6x)
+		basic_machine=tic6x-unknown
+		;;
+	leon|leon[3-9])
+		basic_machine=sparc-$basic_machine
+		;;
+	m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip)
+		basic_machine=$basic_machine-unknown
+		os=-none
+		;;
+	m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65)
+		;;
+	ms1)
+		basic_machine=mt-unknown
+		;;
+
+	strongarm | thumb | xscale)
+		basic_machine=arm-unknown
+		;;
+	xgate)
+		basic_machine=$basic_machine-unknown
+		os=-none
+		;;
+	xscaleeb)
+		basic_machine=armeb-unknown
+		;;
+
+	xscaleel)
+		basic_machine=armel-unknown
+		;;
+
+	# We use `pc' rather than `unknown'
+	# because (1) that's what they normally are, and
+	# (2) the word "unknown" tends to confuse beginning users.
+	i*86 | x86_64)
+	  basic_machine=$basic_machine-pc
+	  ;;
+	# Object if more than one company name word.
+	*-*-*)
+		echo Invalid configuration \`"$1"\': machine \`"$basic_machine"\' not recognized 1>&2
+		exit 1
+		;;
+	# Recognize the basic CPU types with company name.
+	580-* \
+	| a29k-* \
+	| aarch64-* | aarch64_be-* \
+	| alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
+	| alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
+	| alphapca5[67]-* | alpha64pca5[67]-* | arc-* | arceb-* \
+	| arm-*  | armbe-* | armle-* | armeb-* | armv*-* \
+	| avr-* | avr32-* \
+	| ba-* \
+	| be32-* | be64-* \
+	| bfin-* | bs2000-* \
+	| c[123]* | c30-* | [cjt]90-* | c4x-* \
+	| c8051-* | clipper-* | craynv-* | cydra-* \
+	| d10v-* | d30v-* | dlx-* \
+	| e2k-* | elxsi-* \
+	| f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \
+	| h8300-* | h8500-* \
+	| hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
+	| hexagon-* \
+	| i*86-* | i860-* | i960-* | ia16-* | ia64-* \
+	| ip2k-* | iq2000-* \
+	| k1om-* \
+	| le32-* | le64-* \
+	| lm32-* \
+	| m32c-* | m32r-* | m32rle-* \
+	| m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
+	| m88110-* | m88k-* | maxq-* | mcore-* | metag-* \
+	| microblaze-* | microblazeel-* \
+	| mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
+	| mips16-* \
+	| mips64-* | mips64el-* \
+	| mips64octeon-* | mips64octeonel-* \
+	| mips64orion-* | mips64orionel-* \
+	| mips64r5900-* | mips64r5900el-* \
+	| mips64vr-* | mips64vrel-* \
+	| mips64vr4100-* | mips64vr4100el-* \
+	| mips64vr4300-* | mips64vr4300el-* \
+	| mips64vr5000-* | mips64vr5000el-* \
+	| mips64vr5900-* | mips64vr5900el-* \
+	| mipsisa32-* | mipsisa32el-* \
+	| mipsisa32r2-* | mipsisa32r2el-* \
+	| mipsisa32r6-* | mipsisa32r6el-* \
+	| mipsisa64-* | mipsisa64el-* \
+	| mipsisa64r2-* | mipsisa64r2el-* \
+	| mipsisa64r6-* | mipsisa64r6el-* \
+	| mipsisa64sb1-* | mipsisa64sb1el-* \
+	| mipsisa64sr71k-* | mipsisa64sr71kel-* \
+	| mipsr5900-* | mipsr5900el-* \
+	| mipstx39-* | mipstx39el-* \
+	| mmix-* \
+	| mt-* \
+	| msp430-* \
+	| nds32-* | nds32le-* | nds32be-* \
+	| nios-* | nios2-* | nios2eb-* | nios2el-* \
+	| none-* | np1-* | ns16k-* | ns32k-* \
+	| open8-* \
+	| or1k*-* \
+	| orion-* \
+	| pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
+	| powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \
+	| pru-* \
+	| pyramid-* \
+	| riscv32-* | riscv64-* \
+	| rl78-* | romp-* | rs6000-* | rx-* \
+	| sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \
+	| shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \
+	| sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \
+	| sparclite-* \
+	| sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx*-* \
+	| tahoe-* \
+	| tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \
+	| tile*-* \
+	| tron-* \
+	| ubicom32-* \
+	| v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \
+	| vax-* \
+	| visium-* \
+	| wasm32-* \
+	| we32k-* \
+	| x86-* | x86_64-* | xc16x-* | xps100-* \
+	| xstormy16-* | xtensa*-* \
+	| ymp-* \
+	| z8k-* | z80-*)
+		;;
+	# Recognize the basic CPU types without company name, with glob match.
+	xtensa*)
+		basic_machine=$basic_machine-unknown
+		;;
+	# Recognize the various machine names and aliases which stand
+	# for a CPU type and a company and sometimes even an OS.
+	386bsd)
+		basic_machine=i386-pc
+		os=-bsd
+		;;
+	3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
+		basic_machine=m68000-att
+		;;
+	3b*)
+		basic_machine=we32k-att
+		;;
+	a29khif)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+	abacus)
+		basic_machine=abacus-unknown
+		;;
+	adobe68k)
+		basic_machine=m68010-adobe
+		os=-scout
+		;;
+	alliant | fx80)
+		basic_machine=fx80-alliant
+		;;
+	altos | altos3068)
+		basic_machine=m68k-altos
+		;;
+	am29k)
+		basic_machine=a29k-none
+		os=-bsd
+		;;
+	amd64)
+		basic_machine=x86_64-pc
+		;;
+	amd64-*)
+		basic_machine=x86_64-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		;;
+	amdahl)
+		basic_machine=580-amdahl
+		os=-sysv
+		;;
+	amiga | amiga-*)
+		basic_machine=m68k-unknown
+		;;
+	amigaos | amigados)
+		basic_machine=m68k-unknown
+		os=-amigaos
+		;;
+	amigaunix | amix)
+		basic_machine=m68k-unknown
+		os=-sysv4
+		;;
+	apollo68)
+		basic_machine=m68k-apollo
+		os=-sysv
+		;;
+	apollo68bsd)
+		basic_machine=m68k-apollo
+		os=-bsd
+		;;
+	aros)
+		basic_machine=i386-pc
+		os=-aros
+		;;
+	asmjs)
+		basic_machine=asmjs-unknown
+		;;
+	aux)
+		basic_machine=m68k-apple
+		os=-aux
+		;;
+	balance)
+		basic_machine=ns32k-sequent
+		os=-dynix
+		;;
+	blackfin)
+		basic_machine=bfin-unknown
+		os=-linux
+		;;
+	blackfin-*)
+		basic_machine=bfin-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		os=-linux
+		;;
+	bluegene*)
+		basic_machine=powerpc-ibm
+		os=-cnk
+		;;
+	c54x-*)
+		basic_machine=tic54x-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		;;
+	c55x-*)
+		basic_machine=tic55x-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		;;
+	c6x-*)
+		basic_machine=tic6x-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		;;
+	c90)
+		basic_machine=c90-cray
+		os=-unicos
+		;;
+	cegcc)
+		basic_machine=arm-unknown
+		os=-cegcc
+		;;
+	convex-c1)
+		basic_machine=c1-convex
+		os=-bsd
+		;;
+	convex-c2)
+		basic_machine=c2-convex
+		os=-bsd
+		;;
+	convex-c32)
+		basic_machine=c32-convex
+		os=-bsd
+		;;
+	convex-c34)
+		basic_machine=c34-convex
+		os=-bsd
+		;;
+	convex-c38)
+		basic_machine=c38-convex
+		os=-bsd
+		;;
+	cray | j90)
+		basic_machine=j90-cray
+		os=-unicos
+		;;
+	craynv)
+		basic_machine=craynv-cray
+		os=-unicosmp
+		;;
+	cr16 | cr16-*)
+		basic_machine=cr16-unknown
+		os=-elf
+		;;
+	crds | unos)
+		basic_machine=m68k-crds
+		;;
+	crisv32 | crisv32-* | etraxfs*)
+		basic_machine=crisv32-axis
+		;;
+	cris | cris-* | etrax*)
+		basic_machine=cris-axis
+		;;
+	crx)
+		basic_machine=crx-unknown
+		os=-elf
+		;;
+	da30 | da30-*)
+		basic_machine=m68k-da30
+		;;
+	decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
+		basic_machine=mips-dec
+		;;
+	decsystem10* | dec10*)
+		basic_machine=pdp10-dec
+		os=-tops10
+		;;
+	decsystem20* | dec20*)
+		basic_machine=pdp10-dec
+		os=-tops20
+		;;
+	delta | 3300 | motorola-3300 | motorola-delta \
+	      | 3300-motorola | delta-motorola)
+		basic_machine=m68k-motorola
+		;;
+	delta88)
+		basic_machine=m88k-motorola
+		os=-sysv3
+		;;
+	dicos)
+		basic_machine=i686-pc
+		os=-dicos
+		;;
+	djgpp)
+		basic_machine=i586-pc
+		os=-msdosdjgpp
+		;;
+	dpx20 | dpx20-*)
+		basic_machine=rs6000-bull
+		os=-bosx
+		;;
+	dpx2*)
+		basic_machine=m68k-bull
+		os=-sysv3
+		;;
+	e500v[12])
+		basic_machine=powerpc-unknown
+		os=$os"spe"
+		;;
+	e500v[12]-*)
+		basic_machine=powerpc-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		os=$os"spe"
+		;;
+	ebmon29k)
+		basic_machine=a29k-amd
+		os=-ebmon
+		;;
+	elxsi)
+		basic_machine=elxsi-elxsi
+		os=-bsd
+		;;
+	encore | umax | mmax)
+		basic_machine=ns32k-encore
+		;;
+	es1800 | OSE68k | ose68k | ose | OSE)
+		basic_machine=m68k-ericsson
+		os=-ose
+		;;
+	fx2800)
+		basic_machine=i860-alliant
+		;;
+	genix)
+		basic_machine=ns32k-ns
+		;;
+	gmicro)
+		basic_machine=tron-gmicro
+		os=-sysv
+		;;
+	go32)
+		basic_machine=i386-pc
+		os=-go32
+		;;
+	h3050r* | hiux*)
+		basic_machine=hppa1.1-hitachi
+		os=-hiuxwe2
+		;;
+	h8300hms)
+		basic_machine=h8300-hitachi
+		os=-hms
+		;;
+	h8300xray)
+		basic_machine=h8300-hitachi
+		os=-xray
+		;;
+	h8500hms)
+		basic_machine=h8500-hitachi
+		os=-hms
+		;;
+	harris)
+		basic_machine=m88k-harris
+		os=-sysv3
+		;;
+	hp300-*)
+		basic_machine=m68k-hp
+		;;
+	hp300bsd)
+		basic_machine=m68k-hp
+		os=-bsd
+		;;
+	hp300hpux)
+		basic_machine=m68k-hp
+		os=-hpux
+		;;
+	hp3k9[0-9][0-9] | hp9[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hp9k2[0-9][0-9] | hp9k31[0-9])
+		basic_machine=m68000-hp
+		;;
+	hp9k3[2-9][0-9])
+		basic_machine=m68k-hp
+		;;
+	hp9k6[0-9][0-9] | hp6[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hp9k7[0-79][0-9] | hp7[0-79][0-9])
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k78[0-9] | hp78[0-9])
+		# FIXME: really hppa2.0-hp
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
+		# FIXME: really hppa2.0-hp
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k8[0-9][13679] | hp8[0-9][13679])
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k8[0-9][0-9] | hp8[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hppaosf)
+		basic_machine=hppa1.1-hp
+		os=-osf
+		;;
+	hppro)
+		basic_machine=hppa1.1-hp
+		os=-proelf
+		;;
+	i370-ibm* | ibm*)
+		basic_machine=i370-ibm
+		;;
+	i*86v32)
+		basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'`
+		os=-sysv32
+		;;
+	i*86v4*)
+		basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'`
+		os=-sysv4
+		;;
+	i*86v)
+		basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'`
+		os=-sysv
+		;;
+	i*86sol2)
+		basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'`
+		os=-solaris2
+		;;
+	i386mach)
+		basic_machine=i386-mach
+		os=-mach
+		;;
+	vsta)
+		basic_machine=i386-unknown
+		os=-vsta
+		;;
+	iris | iris4d)
+		basic_machine=mips-sgi
+		case $os in
+		    -irix*)
+			;;
+		    *)
+			os=-irix4
+			;;
+		esac
+		;;
+	isi68 | isi)
+		basic_machine=m68k-isi
+		os=-sysv
+		;;
+	leon-*|leon[3-9]-*)
+		basic_machine=sparc-`echo "$basic_machine" | sed 's/-.*//'`
+		;;
+	m68knommu)
+		basic_machine=m68k-unknown
+		os=-linux
+		;;
+	m68knommu-*)
+		basic_machine=m68k-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		os=-linux
+		;;
+	magnum | m3230)
+		basic_machine=mips-mips
+		os=-sysv
+		;;
+	merlin)
+		basic_machine=ns32k-utek
+		os=-sysv
+		;;
+	microblaze*)
+		basic_machine=microblaze-xilinx
+		;;
+	mingw64)
+		basic_machine=x86_64-pc
+		os=-mingw64
+		;;
+	mingw32)
+		basic_machine=i686-pc
+		os=-mingw32
+		;;
+	mingw32ce)
+		basic_machine=arm-unknown
+		os=-mingw32ce
+		;;
+	miniframe)
+		basic_machine=m68000-convergent
+		;;
+	*mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)
+		basic_machine=m68k-atari
+		os=-mint
+		;;
+	mips3*-*)
+		basic_machine=`echo "$basic_machine" | sed -e 's/mips3/mips64/'`
+		;;
+	mips3*)
+		basic_machine=`echo "$basic_machine" | sed -e 's/mips3/mips64/'`-unknown
+		;;
+	monitor)
+		basic_machine=m68k-rom68k
+		os=-coff
+		;;
+	morphos)
+		basic_machine=powerpc-unknown
+		os=-morphos
+		;;
+	moxiebox)
+		basic_machine=moxie-unknown
+		os=-moxiebox
+		;;
+	msdos)
+		basic_machine=i386-pc
+		os=-msdos
+		;;
+	ms1-*)
+		basic_machine=`echo "$basic_machine" | sed -e 's/ms1-/mt-/'`
+		;;
+	msys)
+		basic_machine=i686-pc
+		os=-msys
+		;;
+	mvs)
+		basic_machine=i370-ibm
+		os=-mvs
+		;;
+	nacl)
+		basic_machine=le32-unknown
+		os=-nacl
+		;;
+	ncr3000)
+		basic_machine=i486-ncr
+		os=-sysv4
+		;;
+	netbsd386)
+		basic_machine=i386-unknown
+		os=-netbsd
+		;;
+	netwinder)
+		basic_machine=armv4l-rebel
+		os=-linux
+		;;
+	news | news700 | news800 | news900)
+		basic_machine=m68k-sony
+		os=-newsos
+		;;
+	news1000)
+		basic_machine=m68030-sony
+		os=-newsos
+		;;
+	news-3600 | risc-news)
+		basic_machine=mips-sony
+		os=-newsos
+		;;
+	necv70)
+		basic_machine=v70-nec
+		os=-sysv
+		;;
+	next | m*-next)
+		basic_machine=m68k-next
+		case $os in
+		    -nextstep* )
+			;;
+		    -ns2*)
+		      os=-nextstep2
+			;;
+		    *)
+		      os=-nextstep3
+			;;
+		esac
+		;;
+	nh3000)
+		basic_machine=m68k-harris
+		os=-cxux
+		;;
+	nh[45]000)
+		basic_machine=m88k-harris
+		os=-cxux
+		;;
+	nindy960)
+		basic_machine=i960-intel
+		os=-nindy
+		;;
+	mon960)
+		basic_machine=i960-intel
+		os=-mon960
+		;;
+	nonstopux)
+		basic_machine=mips-compaq
+		os=-nonstopux
+		;;
+	np1)
+		basic_machine=np1-gould
+		;;
+	neo-tandem)
+		basic_machine=neo-tandem
+		;;
+	nse-tandem)
+		basic_machine=nse-tandem
+		;;
+	nsr-tandem)
+		basic_machine=nsr-tandem
+		;;
+	nsv-tandem)
+		basic_machine=nsv-tandem
+		;;
+	nsx-tandem)
+		basic_machine=nsx-tandem
+		;;
+	op50n-* | op60c-*)
+		basic_machine=hppa1.1-oki
+		os=-proelf
+		;;
+	openrisc | openrisc-*)
+		basic_machine=or32-unknown
+		;;
+	os400)
+		basic_machine=powerpc-ibm
+		os=-os400
+		;;
+	OSE68000 | ose68000)
+		basic_machine=m68000-ericsson
+		os=-ose
+		;;
+	os68k)
+		basic_machine=m68k-none
+		os=-os68k
+		;;
+	pa-hitachi)
+		basic_machine=hppa1.1-hitachi
+		os=-hiuxwe2
+		;;
+	paragon)
+		basic_machine=i860-intel
+		os=-osf
+		;;
+	parisc)
+		basic_machine=hppa-unknown
+		os=-linux
+		;;
+	parisc-*)
+		basic_machine=hppa-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		os=-linux
+		;;
+	pbd)
+		basic_machine=sparc-tti
+		;;
+	pbb)
+		basic_machine=m68k-tti
+		;;
+	pc532 | pc532-*)
+		basic_machine=ns32k-pc532
+		;;
+	pc98)
+		basic_machine=i386-pc
+		;;
+	pc98-*)
+		basic_machine=i386-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		;;
+	pentium | p5 | k5 | k6 | nexgen | viac3)
+		basic_machine=i586-pc
+		;;
+	pentiumpro | p6 | 6x86 | athlon | athlon_*)
+		basic_machine=i686-pc
+		;;
+	pentiumii | pentium2 | pentiumiii | pentium3)
+		basic_machine=i686-pc
+		;;
+	pentium4)
+		basic_machine=i786-pc
+		;;
+	pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
+		basic_machine=i586-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		;;
+	pentiumpro-* | p6-* | 6x86-* | athlon-*)
+		basic_machine=i686-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		;;
+	pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)
+		basic_machine=i686-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		;;
+	pentium4-*)
+		basic_machine=i786-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		;;
+	pn)
+		basic_machine=pn-gould
+		;;
+	power)	basic_machine=power-ibm
+		;;
+	ppc | ppcbe)	basic_machine=powerpc-unknown
+		;;
+	ppc-* | ppcbe-*)
+		basic_machine=powerpc-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		;;
+	ppcle | powerpclittle)
+		basic_machine=powerpcle-unknown
+		;;
+	ppcle-* | powerpclittle-*)
+		basic_machine=powerpcle-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		;;
+	ppc64)	basic_machine=powerpc64-unknown
+		;;
+	ppc64-*) basic_machine=powerpc64-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		;;
+	ppc64le | powerpc64little)
+		basic_machine=powerpc64le-unknown
+		;;
+	ppc64le-* | powerpc64little-*)
+		basic_machine=powerpc64le-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		;;
+	ps2)
+		basic_machine=i386-ibm
+		;;
+	pw32)
+		basic_machine=i586-unknown
+		os=-pw32
+		;;
+	rdos | rdos64)
+		basic_machine=x86_64-pc
+		os=-rdos
+		;;
+	rdos32)
+		basic_machine=i386-pc
+		os=-rdos
+		;;
+	rom68k)
+		basic_machine=m68k-rom68k
+		os=-coff
+		;;
+	rm[46]00)
+		basic_machine=mips-siemens
+		;;
+	rtpc | rtpc-*)
+		basic_machine=romp-ibm
+		;;
+	s390 | s390-*)
+		basic_machine=s390-ibm
+		;;
+	s390x | s390x-*)
+		basic_machine=s390x-ibm
+		;;
+	sa29200)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+	sb1)
+		basic_machine=mipsisa64sb1-unknown
+		;;
+	sb1el)
+		basic_machine=mipsisa64sb1el-unknown
+		;;
+	sde)
+		basic_machine=mipsisa32-sde
+		os=-elf
+		;;
+	sei)
+		basic_machine=mips-sei
+		os=-seiux
+		;;
+	sequent)
+		basic_machine=i386-sequent
+		;;
+	sh5el)
+		basic_machine=sh5le-unknown
+		;;
+	simso-wrs)
+		basic_machine=sparclite-wrs
+		os=-vxworks
+		;;
+	sps7)
+		basic_machine=m68k-bull
+		os=-sysv2
+		;;
+	spur)
+		basic_machine=spur-unknown
+		;;
+	st2000)
+		basic_machine=m68k-tandem
+		;;
+	stratus)
+		basic_machine=i860-stratus
+		os=-sysv4
+		;;
+	strongarm-* | thumb-*)
+		basic_machine=arm-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+		;;
+	sun2)
+		basic_machine=m68000-sun
+		;;
+	sun2os3)
+		basic_machine=m68000-sun
+		os=-sunos3
+		;;
+	sun2os4)
+		basic_machine=m68000-sun
+		os=-sunos4
+		;;
+	sun3os3)
+		basic_machine=m68k-sun
+		os=-sunos3
+		;;
+	sun3os4)
+		basic_machine=m68k-sun
+		os=-sunos4
+		;;
+	sun4os3)
+		basic_machine=sparc-sun
+		os=-sunos3
+		;;
+	sun4os4)
+		basic_machine=sparc-sun
+		os=-sunos4
+		;;
+	sun4sol2)
+		basic_machine=sparc-sun
+		os=-solaris2
+		;;
+	sun3 | sun3-*)
+		basic_machine=m68k-sun
+		;;
+	sun4)
+		basic_machine=sparc-sun
+		;;
+	sun386 | sun386i | roadrunner)
+		basic_machine=i386-sun
+		;;
+	sv1)
+		basic_machine=sv1-cray
+		os=-unicos
+		;;
+	symmetry)
+		basic_machine=i386-sequent
+		os=-dynix
+		;;
+	t3e)
+		basic_machine=alphaev5-cray
+		os=-unicos
+		;;
+	t90)
+		basic_machine=t90-cray
+		os=-unicos
+		;;
+	tile*)
+		basic_machine=$basic_machine-unknown
+		os=-linux-gnu
+		;;
+	tx39)
+		basic_machine=mipstx39-unknown
+		;;
+	tx39el)
+		basic_machine=mipstx39el-unknown
+		;;
+	toad1)
+		basic_machine=pdp10-xkl
+		os=-tops20
+		;;
+	tower | tower-32)
+		basic_machine=m68k-ncr
+		;;
+	tpf)
+		basic_machine=s390x-ibm
+		os=-tpf
+		;;
+	udi29k)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+	ultra3)
+		basic_machine=a29k-nyu
+		os=-sym1
+		;;
+	v810 | necv810)
+		basic_machine=v810-nec
+		os=-none
+		;;
+	vaxv)
+		basic_machine=vax-dec
+		os=-sysv
+		;;
+	vms)
+		basic_machine=vax-dec
+		os=-vms
+		;;
+	vpp*|vx|vx-*)
+		basic_machine=f301-fujitsu
+		;;
+	vxworks960)
+		basic_machine=i960-wrs
+		os=-vxworks
+		;;
+	vxworks68)
+		basic_machine=m68k-wrs
+		os=-vxworks
+		;;
+	vxworks29k)
+		basic_machine=a29k-wrs
+		os=-vxworks
+		;;
+	w65*)
+		basic_machine=w65-wdc
+		os=-none
+		;;
+	w89k-*)
+		basic_machine=hppa1.1-winbond
+		os=-proelf
+		;;
+	x64)
+		basic_machine=x86_64-pc
+		;;
+	xbox)
+		basic_machine=i686-pc
+		os=-mingw32
+		;;
+	xps | xps100)
+		basic_machine=xps100-honeywell
+		;;
+	xscale-* | xscalee[bl]-*)
+		basic_machine=`echo "$basic_machine" | sed 's/^xscale/arm/'`
+		;;
+	ymp)
+		basic_machine=ymp-cray
+		os=-unicos
+		;;
+	none)
+		basic_machine=none-none
+		os=-none
+		;;
+
+# Here we handle the default manufacturer of certain CPU types.  It is in
+# some cases the only manufacturer, in others, it is the most popular.
+	w89k)
+		basic_machine=hppa1.1-winbond
+		;;
+	op50n)
+		basic_machine=hppa1.1-oki
+		;;
+	op60c)
+		basic_machine=hppa1.1-oki
+		;;
+	romp)
+		basic_machine=romp-ibm
+		;;
+	mmix)
+		basic_machine=mmix-knuth
+		;;
+	rs6000)
+		basic_machine=rs6000-ibm
+		;;
+	vax)
+		basic_machine=vax-dec
+		;;
+	pdp11)
+		basic_machine=pdp11-dec
+		;;
+	we32k)
+		basic_machine=we32k-att
+		;;
+	sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele)
+		basic_machine=sh-unknown
+		;;
+	cydra)
+		basic_machine=cydra-cydrome
+		;;
+	orion)
+		basic_machine=orion-highlevel
+		;;
+	orion105)
+		basic_machine=clipper-highlevel
+		;;
+	mac | mpw | mac-mpw)
+		basic_machine=m68k-apple
+		;;
+	pmac | pmac-mpw)
+		basic_machine=powerpc-apple
+		;;
+	*-unknown)
+		# Make sure to match an already-canonicalized machine name.
+		;;
+	*)
+		echo Invalid configuration \`"$1"\': machine \`"$basic_machine"\' not recognized 1>&2
+		exit 1
+		;;
+esac
+
+# Here we canonicalize certain aliases for manufacturers.
+case $basic_machine in
+	*-digital*)
+		basic_machine=`echo "$basic_machine" | sed 's/digital.*/dec/'`
+		;;
+	*-commodore*)
+		basic_machine=`echo "$basic_machine" | sed 's/commodore.*/cbm/'`
+		;;
+	*)
+		;;
+esac
+
+# Decode manufacturer-specific aliases for certain operating systems.
+
+if [ x"$os" != x"" ]
+then
+case $os in
+	# First match some system type aliases that might get confused
+	# with valid system types.
+	# -solaris* is a basic system type, with this one exception.
+	-auroraux)
+		os=-auroraux
+		;;
+	-solaris1 | -solaris1.*)
+		os=`echo $os | sed -e 's|solaris1|sunos4|'`
+		;;
+	-solaris)
+		os=-solaris2
+		;;
+	-unixware*)
+		os=-sysv4.2uw
+		;;
+	-gnu/linux*)
+		os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`
+		;;
+	# es1800 is here to avoid being matched by es* (a different OS)
+	-es1800*)
+		os=-ose
+		;;
+	# Now accept the basic system types.
+	# The portable systems comes first.
+	# Each alternative MUST end in a * to match a version number.
+	# -sysv* is not here because it comes later, after sysvr4.
+	-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
+	      | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\
+	      | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \
+	      | -sym* | -kopensolaris* | -plan9* \
+	      | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
+	      | -aos* | -aros* | -cloudabi* | -sortix* \
+	      | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
+	      | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
+	      | -hiux* | -knetbsd* | -mirbsd* | -netbsd* \
+	      | -bitrig* | -openbsd* | -solidbsd* | -libertybsd* \
+	      | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \
+	      | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
+	      | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
+	      | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
+	      | -chorusos* | -chorusrdb* | -cegcc* | -glidix* \
+	      | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
+	      | -midipix* | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \
+	      | -linux-newlib* | -linux-musl* | -linux-uclibc* \
+	      | -uxpv* | -beos* | -mpeix* | -udk* | -moxiebox* \
+	      | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* \
+	      | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \
+	      | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \
+	      | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \
+	      | -morphos* | -superux* | -rtmk* | -windiss* \
+	      | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \
+	      | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es* \
+	      | -onefs* | -tirtos* | -phoenix* | -fuchsia* | -redox* | -bme* \
+	      | -midnightbsd*)
+	# Remember, each alternative MUST END IN *, to match a version number.
+		;;
+	-qnx*)
+		case $basic_machine in
+		    x86-* | i*86-*)
+			;;
+		    *)
+			os=-nto$os
+			;;
+		esac
+		;;
+	-nto-qnx*)
+		;;
+	-nto*)
+		os=`echo $os | sed -e 's|nto|nto-qnx|'`
+		;;
+	-sim | -xray | -os68k* | -v88r* \
+	      | -windows* | -osx | -abug | -netware* | -os9* \
+	      | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)
+		;;
+	-mac*)
+		os=`echo "$os" | sed -e 's|mac|macos|'`
+		;;
+	-linux-dietlibc)
+		os=-linux-dietlibc
+		;;
+	-linux*)
+		os=`echo $os | sed -e 's|linux|linux-gnu|'`
+		;;
+	-sunos5*)
+		os=`echo "$os" | sed -e 's|sunos5|solaris2|'`
+		;;
+	-sunos6*)
+		os=`echo "$os" | sed -e 's|sunos6|solaris3|'`
+		;;
+	-opened*)
+		os=-openedition
+		;;
+	-os400*)
+		os=-os400
+		;;
+	-wince*)
+		os=-wince
+		;;
+	-utek*)
+		os=-bsd
+		;;
+	-dynix*)
+		os=-bsd
+		;;
+	-acis*)
+		os=-aos
+		;;
+	-atheos*)
+		os=-atheos
+		;;
+	-syllable*)
+		os=-syllable
+		;;
+	-386bsd)
+		os=-bsd
+		;;
+	-ctix* | -uts*)
+		os=-sysv
+		;;
+	-nova*)
+		os=-rtmk-nova
+		;;
+	-ns2)
+		os=-nextstep2
+		;;
+	-nsk*)
+		os=-nsk
+		;;
+	# Preserve the version number of sinix5.
+	-sinix5.*)
+		os=`echo $os | sed -e 's|sinix|sysv|'`
+		;;
+	-sinix*)
+		os=-sysv4
+		;;
+	-tpf*)
+		os=-tpf
+		;;
+	-triton*)
+		os=-sysv3
+		;;
+	-oss*)
+		os=-sysv3
+		;;
+	-svr4*)
+		os=-sysv4
+		;;
+	-svr3)
+		os=-sysv3
+		;;
+	-sysvr4)
+		os=-sysv4
+		;;
+	# This must come after -sysvr4.
+	-sysv*)
+		;;
+	-ose*)
+		os=-ose
+		;;
+	-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
+		os=-mint
+		;;
+	-zvmoe)
+		os=-zvmoe
+		;;
+	-dicos*)
+		os=-dicos
+		;;
+	-pikeos*)
+		# Until real need of OS specific support for
+		# particular features comes up, bare metal
+		# configurations are quite functional.
+		case $basic_machine in
+		    arm*)
+			os=-eabi
+			;;
+		    *)
+			os=-elf
+			;;
+		esac
+		;;
+	-nacl*)
+		;;
+	-ios)
+		;;
+	-none)
+		;;
+	*)
+		# Get rid of the `-' at the beginning of $os.
+		os=`echo $os | sed 's/[^-]*-//'`
+		echo Invalid configuration \`"$1"\': system \`"$os"\' not recognized 1>&2
+		exit 1
+		;;
+esac
+else
+
+# Here we handle the default operating systems that come with various machines.
+# The value should be what the vendor currently ships out the door with their
+# machine or put another way, the most popular os provided with the machine.
+
+# Note that if you're going to try to match "-MANUFACTURER" here (say,
+# "-sun"), then you have to tell the case statement up towards the top
+# that MANUFACTURER isn't an operating system.  Otherwise, code above
+# will signal an error saying that MANUFACTURER isn't an operating
+# system, and we'll never get to this point.
+
+case $basic_machine in
+	score-*)
+		os=-elf
+		;;
+	spu-*)
+		os=-elf
+		;;
+	*-acorn)
+		os=-riscix1.2
+		;;
+	arm*-rebel)
+		os=-linux
+		;;
+	arm*-semi)
+		os=-aout
+		;;
+	c4x-* | tic4x-*)
+		os=-coff
+		;;
+	c8051-*)
+		os=-elf
+		;;
+	hexagon-*)
+		os=-elf
+		;;
+	tic54x-*)
+		os=-coff
+		;;
+	tic55x-*)
+		os=-coff
+		;;
+	tic6x-*)
+		os=-coff
+		;;
+	# This must come before the *-dec entry.
+	pdp10-*)
+		os=-tops20
+		;;
+	pdp11-*)
+		os=-none
+		;;
+	*-dec | vax-*)
+		os=-ultrix4.2
+		;;
+	m68*-apollo)
+		os=-domain
+		;;
+	i386-sun)
+		os=-sunos4.0.2
+		;;
+	m68000-sun)
+		os=-sunos3
+		;;
+	m68*-cisco)
+		os=-aout
+		;;
+	mep-*)
+		os=-elf
+		;;
+	mips*-cisco)
+		os=-elf
+		;;
+	mips*-*)
+		os=-elf
+		;;
+	or32-*)
+		os=-coff
+		;;
+	*-tti)	# must be before sparc entry or we get the wrong os.
+		os=-sysv3
+		;;
+	sparc-* | *-sun)
+		os=-sunos4.1.1
+		;;
+	pru-*)
+		os=-elf
+		;;
+	*-be)
+		os=-beos
+		;;
+	*-ibm)
+		os=-aix
+		;;
+	*-knuth)
+		os=-mmixware
+		;;
+	*-wec)
+		os=-proelf
+		;;
+	*-winbond)
+		os=-proelf
+		;;
+	*-oki)
+		os=-proelf
+		;;
+	*-hp)
+		os=-hpux
+		;;
+	*-hitachi)
+		os=-hiux
+		;;
+	i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
+		os=-sysv
+		;;
+	*-cbm)
+		os=-amigaos
+		;;
+	*-dg)
+		os=-dgux
+		;;
+	*-dolphin)
+		os=-sysv3
+		;;
+	m68k-ccur)
+		os=-rtu
+		;;
+	m88k-omron*)
+		os=-luna
+		;;
+	*-next)
+		os=-nextstep
+		;;
+	*-sequent)
+		os=-ptx
+		;;
+	*-crds)
+		os=-unos
+		;;
+	*-ns)
+		os=-genix
+		;;
+	i370-*)
+		os=-mvs
+		;;
+	*-gould)
+		os=-sysv
+		;;
+	*-highlevel)
+		os=-bsd
+		;;
+	*-encore)
+		os=-bsd
+		;;
+	*-sgi)
+		os=-irix
+		;;
+	*-siemens)
+		os=-sysv4
+		;;
+	*-masscomp)
+		os=-rtu
+		;;
+	f30[01]-fujitsu | f700-fujitsu)
+		os=-uxpv
+		;;
+	*-rom68k)
+		os=-coff
+		;;
+	*-*bug)
+		os=-coff
+		;;
+	*-apple)
+		os=-macos
+		;;
+	*-atari*)
+		os=-mint
+		;;
+	*)
+		os=-none
+		;;
+esac
+fi
+
+# Here we handle the case where we know the os, and the CPU type, but not the
+# manufacturer.  We pick the logical manufacturer.
+vendor=unknown
+case $basic_machine in
+	*-unknown)
+		case $os in
+			-riscix*)
+				vendor=acorn
+				;;
+			-sunos*)
+				vendor=sun
+				;;
+			-cnk*|-aix*)
+				vendor=ibm
+				;;
+			-beos*)
+				vendor=be
+				;;
+			-hpux*)
+				vendor=hp
+				;;
+			-mpeix*)
+				vendor=hp
+				;;
+			-hiux*)
+				vendor=hitachi
+				;;
+			-unos*)
+				vendor=crds
+				;;
+			-dgux*)
+				vendor=dg
+				;;
+			-luna*)
+				vendor=omron
+				;;
+			-genix*)
+				vendor=ns
+				;;
+			-mvs* | -opened*)
+				vendor=ibm
+				;;
+			-os400*)
+				vendor=ibm
+				;;
+			-ptx*)
+				vendor=sequent
+				;;
+			-tpf*)
+				vendor=ibm
+				;;
+			-vxsim* | -vxworks* | -windiss*)
+				vendor=wrs
+				;;
+			-aux*)
+				vendor=apple
+				;;
+			-hms*)
+				vendor=hitachi
+				;;
+			-mpw* | -macos*)
+				vendor=apple
+				;;
+			-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
+				vendor=atari
+				;;
+			-vos*)
+				vendor=stratus
+				;;
+		esac
+		basic_machine=`echo "$basic_machine" | sed "s/unknown/$vendor/"`
+		;;
+esac
+
+echo "$basic_machine$os"
+exit
+
+# Local variables:
+# eval: (add-hook 'write-file-functions 'time-stamp)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%:y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
diff --git a/build-aux/install-sh b/build-aux/install-sh
new file mode 100755
index 00000000..59990a10
--- /dev/null
+++ b/build-aux/install-sh
@@ -0,0 +1,508 @@
+#!/bin/sh
+# install - install a program, script, or datafile
+
+scriptversion=2014-09-12.12; # UTC
+
+# This originates from X11R5 (mit/util/scripts/install.sh), which was
+# later released in X11R6 (xc/config/util/install.sh) with the
+# following copyright and license.
+#
+# Copyright (C) 1994 X Consortium
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
+# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
+# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC-
+# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+#
+# Except as contained in this notice, the name of the X Consortium shall not
+# be used in advertising or otherwise to promote the sale, use or other deal-
+# ings in this Software without prior written authorization from the X Consor-
+# tium.
+#
+#
+# FSF changes to this file are in the public domain.
+#
+# Calling this script install-sh is preferred over install.sh, to prevent
+# 'make' implicit rules from creating a file called install from it
+# when there is no Makefile.
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch.
+
+tab='	'
+nl='
+'
+IFS=" $tab$nl"
+
+# Set DOITPROG to "echo" to test this script.
+
+doit=${DOITPROG-}
+doit_exec=${doit:-exec}
+
+# Put in absolute file names if you don't have them in your path;
+# or use environment vars.
+
+chgrpprog=${CHGRPPROG-chgrp}
+chmodprog=${CHMODPROG-chmod}
+chownprog=${CHOWNPROG-chown}
+cmpprog=${CMPPROG-cmp}
+cpprog=${CPPROG-cp}
+mkdirprog=${MKDIRPROG-mkdir}
+mvprog=${MVPROG-mv}
+rmprog=${RMPROG-rm}
+stripprog=${STRIPPROG-strip}
+
+posix_mkdir=
+
+# Desired mode of installed file.
+mode=0755
+
+chgrpcmd=
+chmodcmd=$chmodprog
+chowncmd=
+mvcmd=$mvprog
+rmcmd="$rmprog -f"
+stripcmd=
+
+src=
+dst=
+dir_arg=
+dst_arg=
+
+copy_on_change=false
+is_target_a_directory=possibly
+
+usage="\
+Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
+   or: $0 [OPTION]... SRCFILES... DIRECTORY
+   or: $0 [OPTION]... -t DIRECTORY SRCFILES...
+   or: $0 [OPTION]... -d DIRECTORIES...
+
+In the 1st form, copy SRCFILE to DSTFILE.
+In the 2nd and 3rd, copy all SRCFILES to DIRECTORY.
+In the 4th, create DIRECTORIES.
+
+Options:
+     --help     display this help and exit.
+     --version  display version info and exit.
+
+  -c            (ignored)
+  -C            install only if different (preserve the last data modification time)
+  -d            create directories instead of installing files.
+  -g GROUP      $chgrpprog installed files to GROUP.
+  -m MODE       $chmodprog installed files to MODE.
+  -o USER       $chownprog installed files to USER.
+  -s            $stripprog installed files.
+  -t DIRECTORY  install into DIRECTORY.
+  -T            report an error if DSTFILE is a directory.
+
+Environment variables override the default commands:
+  CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
+  RMPROG STRIPPROG
+"
+
+while test $# -ne 0; do
+  case $1 in
+    -c) ;;
+
+    -C) copy_on_change=true;;
+
+    -d) dir_arg=true;;
+
+    -g) chgrpcmd="$chgrpprog $2"
+        shift;;
+
+    --help) echo "$usage"; exit $?;;
+
+    -m) mode=$2
+        case $mode in
+          *' '* | *"$tab"* | *"$nl"* | *'*'* | *'?'* | *'['*)
+            echo "$0: invalid mode: $mode" >&2
+            exit 1;;
+        esac
+        shift;;
+
+    -o) chowncmd="$chownprog $2"
+        shift;;
+
+    -s) stripcmd=$stripprog;;
+
+    -t)
+        is_target_a_directory=always
+        dst_arg=$2
+        # Protect names problematic for 'test' and other utilities.
+        case $dst_arg in
+          -* | [=\(\)!]) dst_arg=./$dst_arg;;
+        esac
+        shift;;
+
+    -T) is_target_a_directory=never;;
+
+    --version) echo "$0 $scriptversion"; exit $?;;
+
+    --) shift
+        break;;
+
+    -*) echo "$0: invalid option: $1" >&2
+        exit 1;;
+
+    *)  break;;
+  esac
+  shift
+done
+
+# We allow the use of options -d and -T together, by making -d
+# take the precedence; this is for compatibility with GNU install.
+
+if test -n "$dir_arg"; then
+  if test -n "$dst_arg"; then
+    echo "$0: target directory not allowed when installing a directory." >&2
+    exit 1
+  fi
+fi
+
+if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
+  # When -d is used, all remaining arguments are directories to create.
+  # When -t is used, the destination is already specified.
+  # Otherwise, the last argument is the destination.  Remove it from $@.
+  for arg
+  do
+    if test -n "$dst_arg"; then
+      # $@ is not empty: it contains at least $arg.
+      set fnord "$@" "$dst_arg"
+      shift # fnord
+    fi
+    shift # arg
+    dst_arg=$arg
+    # Protect names problematic for 'test' and other utilities.
+    case $dst_arg in
+      -* | [=\(\)!]) dst_arg=./$dst_arg;;
+    esac
+  done
+fi
+
+if test $# -eq 0; then
+  if test -z "$dir_arg"; then
+    echo "$0: no input file specified." >&2
+    exit 1
+  fi
+  # It's OK to call 'install-sh -d' without argument.
+  # This can happen when creating conditional directories.
+  exit 0
+fi
+
+if test -z "$dir_arg"; then
+  if test $# -gt 1 || test "$is_target_a_directory" = always; then
+    if test ! -d "$dst_arg"; then
+      echo "$0: $dst_arg: Is not a directory." >&2
+      exit 1
+    fi
+  fi
+fi
+
+if test -z "$dir_arg"; then
+  do_exit='(exit $ret); exit $ret'
+  trap "ret=129; $do_exit" 1
+  trap "ret=130; $do_exit" 2
+  trap "ret=141; $do_exit" 13
+  trap "ret=143; $do_exit" 15
+
+  # Set umask so as not to create temps with too-generous modes.
+  # However, 'strip' requires both read and write access to temps.
+  case $mode in
+    # Optimize common cases.
+    *644) cp_umask=133;;
+    *755) cp_umask=22;;
+
+    *[0-7])
+      if test -z "$stripcmd"; then
+        u_plus_rw=
+      else
+        u_plus_rw='% 200'
+      fi
+      cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
+    *)
+      if test -z "$stripcmd"; then
+        u_plus_rw=
+      else
+        u_plus_rw=,u+rw
+      fi
+      cp_umask=$mode$u_plus_rw;;
+  esac
+fi
+
+for src
+do
+  # Protect names problematic for 'test' and other utilities.
+  case $src in
+    -* | [=\(\)!]) src=./$src;;
+  esac
+
+  if test -n "$dir_arg"; then
+    dst=$src
+    dstdir=$dst
+    test -d "$dstdir"
+    dstdir_status=$?
+  else
+
+    # Waiting for this to be detected by the "$cpprog $src $dsttmp" command
+    # might cause directories to be created, which would be especially bad
+    # if $src (and thus $dsttmp) contains '*'.
+    if test ! -f "$src" && test ! -d "$src"; then
+      echo "$0: $src does not exist." >&2
+      exit 1
+    fi
+
+    if test -z "$dst_arg"; then
+      echo "$0: no destination specified." >&2
+      exit 1
+    fi
+    dst=$dst_arg
+
+    # If destination is a directory, append the input filename; won't work
+    # if double slashes aren't ignored.
+    if test -d "$dst"; then
+      if test "$is_target_a_directory" = never; then
+        echo "$0: $dst_arg: Is a directory" >&2
+        exit 1
+      fi
+      dstdir=$dst
+      dst=$dstdir/`basename "$src"`
+      dstdir_status=0
+    else
+      dstdir=`dirname "$dst"`
+      test -d "$dstdir"
+      dstdir_status=$?
+    fi
+  fi
+
+  obsolete_mkdir_used=false
+
+  if test $dstdir_status != 0; then
+    case $posix_mkdir in
+      '')
+        # Create intermediate dirs using mode 755 as modified by the umask.
+        # This is like FreeBSD 'install' as of 1997-10-28.
+        umask=`umask`
+        case $stripcmd.$umask in
+          # Optimize common cases.
+          *[2367][2367]) mkdir_umask=$umask;;
+          .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;;
+
+          *[0-7])
+            mkdir_umask=`expr $umask + 22 \
+              - $umask % 100 % 40 + $umask % 20 \
+              - $umask % 10 % 4 + $umask % 2
+            `;;
+          *) mkdir_umask=$umask,go-w;;
+        esac
+
+        # With -d, create the new directory with the user-specified mode.
+        # Otherwise, rely on $mkdir_umask.
+        if test -n "$dir_arg"; then
+          mkdir_mode=-m$mode
+        else
+          mkdir_mode=
+        fi
+
+        posix_mkdir=false
+        case $umask in
+          *[123567][0-7][0-7])
+            # POSIX mkdir -p sets u+wx bits regardless of umask, which
+            # is incompatible with FreeBSD 'install' when (umask & 300) != 0.
+            ;;
+          *)
+            # $RANDOM is not portable (e.g. dash);  use it when possible to
+            # lower collision chance
+            tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
+            trap 'ret=$?; rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" 2>/dev/null; exit $ret' 0
+
+            # As "mkdir -p" follows symlinks and we work in /tmp possibly;  so
+            # create the $tmpdir first (and fail if unsuccessful) to make sure
+            # that nobody tries to guess the $tmpdir name.
+            if (umask $mkdir_umask &&
+                $mkdirprog $mkdir_mode "$tmpdir" &&
+                exec $mkdirprog $mkdir_mode -p -- "$tmpdir/a/b") >/dev/null 2>&1
+            then
+              if test -z "$dir_arg" || {
+                   # Check for POSIX incompatibilities with -m.
+                   # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
+                   # other-writable bit of parent directory when it shouldn't.
+                   # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
+                   test_tmpdir="$tmpdir/a"
+                   ls_ld_tmpdir=`ls -ld "$test_tmpdir"`
+                   case $ls_ld_tmpdir in
+                     d????-?r-*) different_mode=700;;
+                     d????-?--*) different_mode=755;;
+                     *) false;;
+                   esac &&
+                   $mkdirprog -m$different_mode -p -- "$test_tmpdir" && {
+                     ls_ld_tmpdir_1=`ls -ld "$test_tmpdir"`
+                     test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
+                   }
+                 }
+              then posix_mkdir=:
+              fi
+              rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir"
+            else
+              # Remove any dirs left behind by ancient mkdir implementations.
+              rmdir ./$mkdir_mode ./-p ./-- "$tmpdir" 2>/dev/null
+            fi
+            trap '' 0;;
+        esac;;
+    esac
+
+    if
+      $posix_mkdir && (
+        umask $mkdir_umask &&
+        $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
+      )
+    then :
+    else
+
+      # The umask is ridiculous, or mkdir does not conform to POSIX,
+      # or it failed possibly due to a race condition.  Create the
+      # directory the slow way, step by step, checking for races as we go.
+
+      case $dstdir in
+        /*) prefix='/';;
+        [-=\(\)!]*) prefix='./';;
+        *)  prefix='';;
+      esac
+
+      oIFS=$IFS
+      IFS=/
+      set -f
+      set fnord $dstdir
+      shift
+      set +f
+      IFS=$oIFS
+
+      prefixes=
+
+      for d
+      do
+        test X"$d" = X && continue
+
+        prefix=$prefix$d
+        if test -d "$prefix"; then
+          prefixes=
+        else
+          if $posix_mkdir; then
+            (umask=$mkdir_umask &&
+             $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
+            # Don't fail if two instances are running concurrently.
+            test -d "$prefix" || exit 1
+          else
+            case $prefix in
+              *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
+              *) qprefix=$prefix;;
+            esac
+            prefixes="$prefixes '$qprefix'"
+          fi
+        fi
+        prefix=$prefix/
+      done
+
+      if test -n "$prefixes"; then
+        # Don't fail if two instances are running concurrently.
+        (umask $mkdir_umask &&
+         eval "\$doit_exec \$mkdirprog $prefixes") ||
+          test -d "$dstdir" || exit 1
+        obsolete_mkdir_used=true
+      fi
+    fi
+  fi
+
+  if test -n "$dir_arg"; then
+    { test -z "$chowncmd" || $doit $chowncmd "$dst"; } &&
+    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } &&
+    { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false ||
+      test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1
+  else
+
+    # Make a couple of temp file names in the proper directory.
+    dsttmp=$dstdir/_inst.$$_
+    rmtmp=$dstdir/_rm.$$_
+
+    # Trap to clean up those temp files at exit.
+    trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
+
+    # Copy the file name to the temp name.
+    (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") &&
+
+    # and set any options; do chmod last to preserve setuid bits.
+    #
+    # If any of these fail, we abort the whole thing.  If we want to
+    # ignore errors from any of these, just make sure not to ignore
+    # errors from the above "$doit $cpprog $src $dsttmp" command.
+    #
+    { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } &&
+    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } &&
+    { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } &&
+    { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } &&
+
+    # If -C, don't bother to copy if it wouldn't change the file.
+    if $copy_on_change &&
+       old=`LC_ALL=C ls -dlL "$dst"     2>/dev/null` &&
+       new=`LC_ALL=C ls -dlL "$dsttmp"  2>/dev/null` &&
+       set -f &&
+       set X $old && old=:$2:$4:$5:$6 &&
+       set X $new && new=:$2:$4:$5:$6 &&
+       set +f &&
+       test "$old" = "$new" &&
+       $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
+    then
+      rm -f "$dsttmp"
+    else
+      # Rename the file to the real destination.
+      $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null ||
+
+      # The rename failed, perhaps because mv can't rename something else
+      # to itself, or perhaps because mv is so ancient that it does not
+      # support -f.
+      {
+        # Now remove or move aside any old file at destination location.
+        # We try this two ways since rm can't unlink itself on some
+        # systems and the destination file might be busy for other
+        # reasons.  In this case, the final cleanup might fail but the new
+        # file should still install successfully.
+        {
+          test ! -f "$dst" ||
+          $doit $rmcmd -f "$dst" 2>/dev/null ||
+          { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
+            { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
+          } ||
+          { echo "$0: cannot unlink or rename $dst" >&2
+            (exit 1); exit 1
+          }
+        } &&
+
+        # Now rename the file to the real destination.
+        $doit $mvcmd "$dsttmp" "$dst"
+      }
+    fi || exit 1
+
+    trap '' 0
+  fi
+done
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "scriptversion="
+# time-stamp-format: "%:y-%02m-%02d.%02H"
+# time-stamp-time-zone: "UTC"
+# time-stamp-end: "; # UTC"
+# End:
diff --git a/build-aux/libtool.m4 b/build-aux/libtool.m4
new file mode 100644
index 00000000..ab2fd56b
--- /dev/null
+++ b/build-aux/libtool.m4
@@ -0,0 +1,8387 @@
+# libtool.m4 - Configure libtool for the host system. -*-Autoconf-*-
+#
+#   Copyright (C) 1996-2001, 2003-2015 Free Software Foundation, Inc.
+#   Written by Gordon Matzigkeit, 1996
+#
+# This file is free software; the Free Software Foundation gives
+# unlimited permission to copy and/or distribute it, with or without
+# modifications, as long as this notice is preserved.
+
+m4_define([_LT_COPYING], [dnl
+# Copyright (C) 2014 Free Software Foundation, Inc.
+# This is free software; see the source for copying conditions.  There is NO
+# warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+# GNU Libtool is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of of the License, or
+# (at your option) any later version.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program or library that is built
+# using GNU Libtool, you may include this file under the  same
+# distribution terms that you use for the rest of that program.
+#
+# GNU Libtool is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see .
+])
+
+# serial 58 LT_INIT
+
+
+# LT_PREREQ(VERSION)
+# ------------------
+# Complain and exit if this libtool version is less that VERSION.
+m4_defun([LT_PREREQ],
+[m4_if(m4_version_compare(m4_defn([LT_PACKAGE_VERSION]), [$1]), -1,
+       [m4_default([$3],
+		   [m4_fatal([Libtool version $1 or higher is required],
+		             63)])],
+       [$2])])
+
+
+# _LT_CHECK_BUILDDIR
+# ------------------
+# Complain if the absolute build directory name contains unusual characters
+m4_defun([_LT_CHECK_BUILDDIR],
+[case `pwd` in
+  *\ * | *\	*)
+    AC_MSG_WARN([Libtool does not cope well with whitespace in `pwd`]) ;;
+esac
+])
+
+
+# LT_INIT([OPTIONS])
+# ------------------
+AC_DEFUN([LT_INIT],
+[AC_PREREQ([2.62])dnl We use AC_PATH_PROGS_FEATURE_CHECK
+AC_REQUIRE([AC_CONFIG_AUX_DIR_DEFAULT])dnl
+AC_BEFORE([$0], [LT_LANG])dnl
+AC_BEFORE([$0], [LT_OUTPUT])dnl
+AC_BEFORE([$0], [LTDL_INIT])dnl
+m4_require([_LT_CHECK_BUILDDIR])dnl
+
+dnl Autoconf doesn't catch unexpanded LT_ macros by default:
+m4_pattern_forbid([^_?LT_[A-Z_]+$])dnl
+m4_pattern_allow([^(_LT_EOF|LT_DLGLOBAL|LT_DLLAZY_OR_NOW|LT_MULTI_MODULE)$])dnl
+dnl aclocal doesn't pull ltoptions.m4, ltsugar.m4, or ltversion.m4
+dnl unless we require an AC_DEFUNed macro:
+AC_REQUIRE([LTOPTIONS_VERSION])dnl
+AC_REQUIRE([LTSUGAR_VERSION])dnl
+AC_REQUIRE([LTVERSION_VERSION])dnl
+AC_REQUIRE([LTOBSOLETE_VERSION])dnl
+m4_require([_LT_PROG_LTMAIN])dnl
+
+_LT_SHELL_INIT([SHELL=${CONFIG_SHELL-/bin/sh}])
+
+dnl Parse OPTIONS
+_LT_SET_OPTIONS([$0], [$1])
+
+# This can be used to rebuild libtool when needed
+LIBTOOL_DEPS=$ltmain
+
+# Always use our own libtool.
+LIBTOOL='$(SHELL) $(top_builddir)/libtool'
+AC_SUBST(LIBTOOL)dnl
+
+_LT_SETUP
+
+# Only expand once:
+m4_define([LT_INIT])
+])# LT_INIT
+
+# Old names:
+AU_ALIAS([AC_PROG_LIBTOOL], [LT_INIT])
+AU_ALIAS([AM_PROG_LIBTOOL], [LT_INIT])
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([AC_PROG_LIBTOOL], [])
+dnl AC_DEFUN([AM_PROG_LIBTOOL], [])
+
+
+# _LT_PREPARE_CC_BASENAME
+# -----------------------
+m4_defun([_LT_PREPARE_CC_BASENAME], [
+# Calculate cc_basename.  Skip known compiler wrappers and cross-prefix.
+func_cc_basename ()
+{
+    for cc_temp in @S|@*""; do
+      case $cc_temp in
+        compile | *[[\\/]]compile | ccache | *[[\\/]]ccache ) ;;
+        distcc | *[[\\/]]distcc | purify | *[[\\/]]purify ) ;;
+        \-*) ;;
+        *) break;;
+      esac
+    done
+    func_cc_basename_result=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"`
+}
+])# _LT_PREPARE_CC_BASENAME
+
+
+# _LT_CC_BASENAME(CC)
+# -------------------
+# It would be clearer to call AC_REQUIREs from _LT_PREPARE_CC_BASENAME,
+# but that macro is also expanded into generated libtool script, which
+# arranges for $SED and $ECHO to be set by different means.
+m4_defun([_LT_CC_BASENAME],
+[m4_require([_LT_PREPARE_CC_BASENAME])dnl
+AC_REQUIRE([_LT_DECL_SED])dnl
+AC_REQUIRE([_LT_PROG_ECHO_BACKSLASH])dnl
+func_cc_basename $1
+cc_basename=$func_cc_basename_result
+])
+
+
+# _LT_FILEUTILS_DEFAULTS
+# ----------------------
+# It is okay to use these file commands and assume they have been set
+# sensibly after 'm4_require([_LT_FILEUTILS_DEFAULTS])'.
+m4_defun([_LT_FILEUTILS_DEFAULTS],
+[: ${CP="cp -f"}
+: ${MV="mv -f"}
+: ${RM="rm -f"}
+])# _LT_FILEUTILS_DEFAULTS
+
+
+# _LT_SETUP
+# ---------
+m4_defun([_LT_SETUP],
+[AC_REQUIRE([AC_CANONICAL_HOST])dnl
+AC_REQUIRE([AC_CANONICAL_BUILD])dnl
+AC_REQUIRE([_LT_PREPARE_SED_QUOTE_VARS])dnl
+AC_REQUIRE([_LT_PROG_ECHO_BACKSLASH])dnl
+
+_LT_DECL([], [PATH_SEPARATOR], [1], [The PATH separator for the build system])dnl
+dnl
+_LT_DECL([], [host_alias], [0], [The host system])dnl
+_LT_DECL([], [host], [0])dnl
+_LT_DECL([], [host_os], [0])dnl
+dnl
+_LT_DECL([], [build_alias], [0], [The build system])dnl
+_LT_DECL([], [build], [0])dnl
+_LT_DECL([], [build_os], [0])dnl
+dnl
+AC_REQUIRE([AC_PROG_CC])dnl
+AC_REQUIRE([LT_PATH_LD])dnl
+AC_REQUIRE([LT_PATH_NM])dnl
+dnl
+AC_REQUIRE([AC_PROG_LN_S])dnl
+test -z "$LN_S" && LN_S="ln -s"
+_LT_DECL([], [LN_S], [1], [Whether we need soft or hard links])dnl
+dnl
+AC_REQUIRE([LT_CMD_MAX_LEN])dnl
+_LT_DECL([objext], [ac_objext], [0], [Object file suffix (normally "o")])dnl
+_LT_DECL([], [exeext], [0], [Executable file suffix (normally "")])dnl
+dnl
+m4_require([_LT_FILEUTILS_DEFAULTS])dnl
+m4_require([_LT_CHECK_SHELL_FEATURES])dnl
+m4_require([_LT_PATH_CONVERSION_FUNCTIONS])dnl
+m4_require([_LT_CMD_RELOAD])dnl
+m4_require([_LT_CHECK_MAGIC_METHOD])dnl
+m4_require([_LT_CHECK_SHAREDLIB_FROM_LINKLIB])dnl
+m4_require([_LT_CMD_OLD_ARCHIVE])dnl
+m4_require([_LT_CMD_GLOBAL_SYMBOLS])dnl
+m4_require([_LT_WITH_SYSROOT])dnl
+m4_require([_LT_CMD_TRUNCATE])dnl
+
+_LT_CONFIG_LIBTOOL_INIT([
+# See if we are running on zsh, and set the options that allow our
+# commands through without removal of \ escapes INIT.
+if test -n "\${ZSH_VERSION+set}"; then
+   setopt NO_GLOB_SUBST
+fi
+])
+if test -n "${ZSH_VERSION+set}"; then
+   setopt NO_GLOB_SUBST
+fi
+
+_LT_CHECK_OBJDIR
+
+m4_require([_LT_TAG_COMPILER])dnl
+
+case $host_os in
+aix3*)
+  # AIX sometimes has problems with the GCC collect2 program.  For some
+  # reason, if we set the COLLECT_NAMES environment variable, the problems
+  # vanish in a puff of smoke.
+  if test set != "${COLLECT_NAMES+set}"; then
+    COLLECT_NAMES=
+    export COLLECT_NAMES
+  fi
+  ;;
+esac
+
+# Global variables:
+ofile=libtool
+can_build_shared=yes
+
+# All known linkers require a '.a' archive for static linking (except MSVC,
+# which needs '.lib').
+libext=a
+
+with_gnu_ld=$lt_cv_prog_gnu_ld
+
+old_CC=$CC
+old_CFLAGS=$CFLAGS
+
+# Set sane defaults for various variables
+test -z "$CC" && CC=cc
+test -z "$LTCC" && LTCC=$CC
+test -z "$LTCFLAGS" && LTCFLAGS=$CFLAGS
+test -z "$LD" && LD=ld
+test -z "$ac_objext" && ac_objext=o
+
+_LT_CC_BASENAME([$compiler])
+
+# Only perform the check for file, if the check method requires it
+test -z "$MAGIC_CMD" && MAGIC_CMD=file
+case $deplibs_check_method in
+file_magic*)
+  if test "$file_magic_cmd" = '$MAGIC_CMD'; then
+    _LT_PATH_MAGIC
+  fi
+  ;;
+esac
+
+# Use C for the default configuration in the libtool script
+LT_SUPPORTED_TAG([CC])
+_LT_LANG_C_CONFIG
+_LT_LANG_DEFAULT_CONFIG
+_LT_CONFIG_COMMANDS
+])# _LT_SETUP
+
+
+# _LT_PREPARE_SED_QUOTE_VARS
+# --------------------------
+# Define a few sed substitution that help us do robust quoting.
+m4_defun([_LT_PREPARE_SED_QUOTE_VARS],
+[# Backslashify metacharacters that are still active within
+# double-quoted strings.
+sed_quote_subst='s/\([["`$\\]]\)/\\\1/g'
+
+# Same as above, but do not quote variable references.
+double_quote_subst='s/\([["`\\]]\)/\\\1/g'
+
+# Sed substitution to delay expansion of an escaped shell variable in a
+# double_quote_subst'ed string.
+delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g'
+
+# Sed substitution to delay expansion of an escaped single quote.
+delay_single_quote_subst='s/'\''/'\'\\\\\\\'\''/g'
+
+# Sed substitution to avoid accidental globbing in evaled expressions
+no_glob_subst='s/\*/\\\*/g'
+])
+
+# _LT_PROG_LTMAIN
+# ---------------
+# Note that this code is called both from 'configure', and 'config.status'
+# now that we use AC_CONFIG_COMMANDS to generate libtool.  Notably,
+# 'config.status' has no value for ac_aux_dir unless we are using Automake,
+# so we pass a copy along to make sure it has a sensible value anyway.
+m4_defun([_LT_PROG_LTMAIN],
+[m4_ifdef([AC_REQUIRE_AUX_FILE], [AC_REQUIRE_AUX_FILE([ltmain.sh])])dnl
+_LT_CONFIG_LIBTOOL_INIT([ac_aux_dir='$ac_aux_dir'])
+ltmain=$ac_aux_dir/ltmain.sh
+])# _LT_PROG_LTMAIN
+
+
+## ------------------------------------- ##
+## Accumulate code for creating libtool. ##
+## ------------------------------------- ##
+
+# So that we can recreate a full libtool script including additional
+# tags, we accumulate the chunks of code to send to AC_CONFIG_COMMANDS
+# in macros and then make a single call at the end using the 'libtool'
+# label.
+
+
+# _LT_CONFIG_LIBTOOL_INIT([INIT-COMMANDS])
+# ----------------------------------------
+# Register INIT-COMMANDS to be passed to AC_CONFIG_COMMANDS later.
+m4_define([_LT_CONFIG_LIBTOOL_INIT],
+[m4_ifval([$1],
+          [m4_append([_LT_OUTPUT_LIBTOOL_INIT],
+                     [$1
+])])])
+
+# Initialize.
+m4_define([_LT_OUTPUT_LIBTOOL_INIT])
+
+
+# _LT_CONFIG_LIBTOOL([COMMANDS])
+# ------------------------------
+# Register COMMANDS to be passed to AC_CONFIG_COMMANDS later.
+m4_define([_LT_CONFIG_LIBTOOL],
+[m4_ifval([$1],
+          [m4_append([_LT_OUTPUT_LIBTOOL_COMMANDS],
+                     [$1
+])])])
+
+# Initialize.
+m4_define([_LT_OUTPUT_LIBTOOL_COMMANDS])
+
+
+# _LT_CONFIG_SAVE_COMMANDS([COMMANDS], [INIT_COMMANDS])
+# -----------------------------------------------------
+m4_defun([_LT_CONFIG_SAVE_COMMANDS],
+[_LT_CONFIG_LIBTOOL([$1])
+_LT_CONFIG_LIBTOOL_INIT([$2])
+])
+
+
+# _LT_FORMAT_COMMENT([COMMENT])
+# -----------------------------
+# Add leading comment marks to the start of each line, and a trailing
+# full-stop to the whole comment if one is not present already.
+m4_define([_LT_FORMAT_COMMENT],
+[m4_ifval([$1], [
+m4_bpatsubst([m4_bpatsubst([$1], [^ *], [# ])],
+              [['`$\]], [\\\&])]m4_bmatch([$1], [[!?.]$], [], [.])
+)])
+
+
+
+## ------------------------ ##
+## FIXME: Eliminate VARNAME ##
+## ------------------------ ##
+
+
+# _LT_DECL([CONFIGNAME], VARNAME, VALUE, [DESCRIPTION], [IS-TAGGED?])
+# -------------------------------------------------------------------
+# CONFIGNAME is the name given to the value in the libtool script.
+# VARNAME is the (base) name used in the configure script.
+# VALUE may be 0, 1 or 2 for a computed quote escaped value based on
+# VARNAME.  Any other value will be used directly.
+m4_define([_LT_DECL],
+[lt_if_append_uniq([lt_decl_varnames], [$2], [, ],
+    [lt_dict_add_subkey([lt_decl_dict], [$2], [libtool_name],
+	[m4_ifval([$1], [$1], [$2])])
+    lt_dict_add_subkey([lt_decl_dict], [$2], [value], [$3])
+    m4_ifval([$4],
+	[lt_dict_add_subkey([lt_decl_dict], [$2], [description], [$4])])
+    lt_dict_add_subkey([lt_decl_dict], [$2],
+	[tagged?], [m4_ifval([$5], [yes], [no])])])
+])
+
+
+# _LT_TAGDECL([CONFIGNAME], VARNAME, VALUE, [DESCRIPTION])
+# --------------------------------------------------------
+m4_define([_LT_TAGDECL], [_LT_DECL([$1], [$2], [$3], [$4], [yes])])
+
+
+# lt_decl_tag_varnames([SEPARATOR], [VARNAME1...])
+# ------------------------------------------------
+m4_define([lt_decl_tag_varnames],
+[_lt_decl_filter([tagged?], [yes], $@)])
+
+
+# _lt_decl_filter(SUBKEY, VALUE, [SEPARATOR], [VARNAME1..])
+# ---------------------------------------------------------
+m4_define([_lt_decl_filter],
+[m4_case([$#],
+  [0], [m4_fatal([$0: too few arguments: $#])],
+  [1], [m4_fatal([$0: too few arguments: $#: $1])],
+  [2], [lt_dict_filter([lt_decl_dict], [$1], [$2], [], lt_decl_varnames)],
+  [3], [lt_dict_filter([lt_decl_dict], [$1], [$2], [$3], lt_decl_varnames)],
+  [lt_dict_filter([lt_decl_dict], $@)])[]dnl
+])
+
+
+# lt_decl_quote_varnames([SEPARATOR], [VARNAME1...])
+# --------------------------------------------------
+m4_define([lt_decl_quote_varnames],
+[_lt_decl_filter([value], [1], $@)])
+
+
+# lt_decl_dquote_varnames([SEPARATOR], [VARNAME1...])
+# ---------------------------------------------------
+m4_define([lt_decl_dquote_varnames],
+[_lt_decl_filter([value], [2], $@)])
+
+
+# lt_decl_varnames_tagged([SEPARATOR], [VARNAME1...])
+# ---------------------------------------------------
+m4_define([lt_decl_varnames_tagged],
+[m4_assert([$# <= 2])dnl
+_$0(m4_quote(m4_default([$1], [[, ]])),
+    m4_ifval([$2], [[$2]], [m4_dquote(lt_decl_tag_varnames)]),
+    m4_split(m4_normalize(m4_quote(_LT_TAGS)), [ ]))])
+m4_define([_lt_decl_varnames_tagged],
+[m4_ifval([$3], [lt_combine([$1], [$2], [_], $3)])])
+
+
+# lt_decl_all_varnames([SEPARATOR], [VARNAME1...])
+# ------------------------------------------------
+m4_define([lt_decl_all_varnames],
+[_$0(m4_quote(m4_default([$1], [[, ]])),
+     m4_if([$2], [],
+	   m4_quote(lt_decl_varnames),
+	m4_quote(m4_shift($@))))[]dnl
+])
+m4_define([_lt_decl_all_varnames],
+[lt_join($@, lt_decl_varnames_tagged([$1],
+			lt_decl_tag_varnames([[, ]], m4_shift($@))))dnl
+])
+
+
+# _LT_CONFIG_STATUS_DECLARE([VARNAME])
+# ------------------------------------
+# Quote a variable value, and forward it to 'config.status' so that its
+# declaration there will have the same value as in 'configure'.  VARNAME
+# must have a single quote delimited value for this to work.
+m4_define([_LT_CONFIG_STATUS_DECLARE],
+[$1='`$ECHO "$][$1" | $SED "$delay_single_quote_subst"`'])
+
+
+# _LT_CONFIG_STATUS_DECLARATIONS
+# ------------------------------
+# We delimit libtool config variables with single quotes, so when
+# we write them to config.status, we have to be sure to quote all
+# embedded single quotes properly.  In configure, this macro expands
+# each variable declared with _LT_DECL (and _LT_TAGDECL) into:
+#
+#    ='`$ECHO "$" | $SED "$delay_single_quote_subst"`'
+m4_defun([_LT_CONFIG_STATUS_DECLARATIONS],
+[m4_foreach([_lt_var], m4_quote(lt_decl_all_varnames),
+    [m4_n([_LT_CONFIG_STATUS_DECLARE(_lt_var)])])])
+
+
+# _LT_LIBTOOL_TAGS
+# ----------------
+# Output comment and list of tags supported by the script
+m4_defun([_LT_LIBTOOL_TAGS],
+[_LT_FORMAT_COMMENT([The names of the tagged configurations supported by this script])dnl
+available_tags='_LT_TAGS'dnl
+])
+
+
+# _LT_LIBTOOL_DECLARE(VARNAME, [TAG])
+# -----------------------------------
+# Extract the dictionary values for VARNAME (optionally with TAG) and
+# expand to a commented shell variable setting:
+#
+#    # Some comment about what VAR is for.
+#    visible_name=$lt_internal_name
+m4_define([_LT_LIBTOOL_DECLARE],
+[_LT_FORMAT_COMMENT(m4_quote(lt_dict_fetch([lt_decl_dict], [$1],
+					   [description])))[]dnl
+m4_pushdef([_libtool_name],
+    m4_quote(lt_dict_fetch([lt_decl_dict], [$1], [libtool_name])))[]dnl
+m4_case(m4_quote(lt_dict_fetch([lt_decl_dict], [$1], [value])),
+    [0], [_libtool_name=[$]$1],
+    [1], [_libtool_name=$lt_[]$1],
+    [2], [_libtool_name=$lt_[]$1],
+    [_libtool_name=lt_dict_fetch([lt_decl_dict], [$1], [value])])[]dnl
+m4_ifval([$2], [_$2])[]m4_popdef([_libtool_name])[]dnl
+])
+
+
+# _LT_LIBTOOL_CONFIG_VARS
+# -----------------------
+# Produce commented declarations of non-tagged libtool config variables
+# suitable for insertion in the LIBTOOL CONFIG section of the 'libtool'
+# script.  Tagged libtool config variables (even for the LIBTOOL CONFIG
+# section) are produced by _LT_LIBTOOL_TAG_VARS.
+m4_defun([_LT_LIBTOOL_CONFIG_VARS],
+[m4_foreach([_lt_var],
+    m4_quote(_lt_decl_filter([tagged?], [no], [], lt_decl_varnames)),
+    [m4_n([_LT_LIBTOOL_DECLARE(_lt_var)])])])
+
+
+# _LT_LIBTOOL_TAG_VARS(TAG)
+# -------------------------
+m4_define([_LT_LIBTOOL_TAG_VARS],
+[m4_foreach([_lt_var], m4_quote(lt_decl_tag_varnames),
+    [m4_n([_LT_LIBTOOL_DECLARE(_lt_var, [$1])])])])
+
+
+# _LT_TAGVAR(VARNAME, [TAGNAME])
+# ------------------------------
+m4_define([_LT_TAGVAR], [m4_ifval([$2], [$1_$2], [$1])])
+
+
+# _LT_CONFIG_COMMANDS
+# -------------------
+# Send accumulated output to $CONFIG_STATUS.  Thanks to the lists of
+# variables for single and double quote escaping we saved from calls
+# to _LT_DECL, we can put quote escaped variables declarations
+# into 'config.status', and then the shell code to quote escape them in
+# for loops in 'config.status'.  Finally, any additional code accumulated
+# from calls to _LT_CONFIG_LIBTOOL_INIT is expanded.
+m4_defun([_LT_CONFIG_COMMANDS],
+[AC_PROVIDE_IFELSE([LT_OUTPUT],
+	dnl If the libtool generation code has been placed in $CONFIG_LT,
+	dnl instead of duplicating it all over again into config.status,
+	dnl then we will have config.status run $CONFIG_LT later, so it
+	dnl needs to know what name is stored there:
+        [AC_CONFIG_COMMANDS([libtool],
+            [$SHELL $CONFIG_LT || AS_EXIT(1)], [CONFIG_LT='$CONFIG_LT'])],
+    dnl If the libtool generation code is destined for config.status,
+    dnl expand the accumulated commands and init code now:
+    [AC_CONFIG_COMMANDS([libtool],
+        [_LT_OUTPUT_LIBTOOL_COMMANDS], [_LT_OUTPUT_LIBTOOL_COMMANDS_INIT])])
+])#_LT_CONFIG_COMMANDS
+
+
+# Initialize.
+m4_define([_LT_OUTPUT_LIBTOOL_COMMANDS_INIT],
+[
+
+# The HP-UX ksh and POSIX shell print the target directory to stdout
+# if CDPATH is set.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+sed_quote_subst='$sed_quote_subst'
+double_quote_subst='$double_quote_subst'
+delay_variable_subst='$delay_variable_subst'
+_LT_CONFIG_STATUS_DECLARATIONS
+LTCC='$LTCC'
+LTCFLAGS='$LTCFLAGS'
+compiler='$compiler_DEFAULT'
+
+# A function that is used when there is no print builtin or printf.
+func_fallback_echo ()
+{
+  eval 'cat <<_LTECHO_EOF
+\$[]1
+_LTECHO_EOF'
+}
+
+# Quote evaled strings.
+for var in lt_decl_all_varnames([[ \
+]], lt_decl_quote_varnames); do
+    case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in
+    *[[\\\\\\\`\\"\\\$]]*)
+      eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED \\"\\\$sed_quote_subst\\"\\\`\\\\\\"" ## exclude from sc_prohibit_nested_quotes
+      ;;
+    *)
+      eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\""
+      ;;
+    esac
+done
+
+# Double-quote double-evaled strings.
+for var in lt_decl_all_varnames([[ \
+]], lt_decl_dquote_varnames); do
+    case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in
+    *[[\\\\\\\`\\"\\\$]]*)
+      eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED -e \\"\\\$double_quote_subst\\" -e \\"\\\$sed_quote_subst\\" -e \\"\\\$delay_variable_subst\\"\\\`\\\\\\"" ## exclude from sc_prohibit_nested_quotes
+      ;;
+    *)
+      eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\""
+      ;;
+    esac
+done
+
+_LT_OUTPUT_LIBTOOL_INIT
+])
+
+# _LT_GENERATED_FILE_INIT(FILE, [COMMENT])
+# ------------------------------------
+# Generate a child script FILE with all initialization necessary to
+# reuse the environment learned by the parent script, and make the
+# file executable.  If COMMENT is supplied, it is inserted after the
+# '#!' sequence but before initialization text begins.  After this
+# macro, additional text can be appended to FILE to form the body of
+# the child script.  The macro ends with non-zero status if the
+# file could not be fully written (such as if the disk is full).
+m4_ifdef([AS_INIT_GENERATED],
+[m4_defun([_LT_GENERATED_FILE_INIT],[AS_INIT_GENERATED($@)])],
+[m4_defun([_LT_GENERATED_FILE_INIT],
+[m4_require([AS_PREPARE])]dnl
+[m4_pushdef([AS_MESSAGE_LOG_FD])]dnl
+[lt_write_fail=0
+cat >$1 <<_ASEOF || lt_write_fail=1
+#! $SHELL
+# Generated by $as_me.
+$2
+SHELL=\${CONFIG_SHELL-$SHELL}
+export SHELL
+_ASEOF
+cat >>$1 <<\_ASEOF || lt_write_fail=1
+AS_SHELL_SANITIZE
+_AS_PREPARE
+exec AS_MESSAGE_FD>&1
+_ASEOF
+test 0 = "$lt_write_fail" && chmod +x $1[]dnl
+m4_popdef([AS_MESSAGE_LOG_FD])])])# _LT_GENERATED_FILE_INIT
+
+# LT_OUTPUT
+# ---------
+# This macro allows early generation of the libtool script (before
+# AC_OUTPUT is called), in case it is used in configure for compilation
+# tests.
+AC_DEFUN([LT_OUTPUT],
+[: ${CONFIG_LT=./config.lt}
+AC_MSG_NOTICE([creating $CONFIG_LT])
+_LT_GENERATED_FILE_INIT(["$CONFIG_LT"],
+[# Run this file to recreate a libtool stub with the current configuration.])
+
+cat >>"$CONFIG_LT" <<\_LTEOF
+lt_cl_silent=false
+exec AS_MESSAGE_LOG_FD>>config.log
+{
+  echo
+  AS_BOX([Running $as_me.])
+} >&AS_MESSAGE_LOG_FD
+
+lt_cl_help="\
+'$as_me' creates a local libtool stub from the current configuration,
+for use in further configure time tests before the real libtool is
+generated.
+
+Usage: $[0] [[OPTIONS]]
+
+  -h, --help      print this help, then exit
+  -V, --version   print version number, then exit
+  -q, --quiet     do not print progress messages
+  -d, --debug     don't remove temporary files
+
+Report bugs to ."
+
+lt_cl_version="\
+m4_ifset([AC_PACKAGE_NAME], [AC_PACKAGE_NAME ])config.lt[]dnl
+m4_ifset([AC_PACKAGE_VERSION], [ AC_PACKAGE_VERSION])
+configured by $[0], generated by m4_PACKAGE_STRING.
+
+Copyright (C) 2011 Free Software Foundation, Inc.
+This config.lt script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it."
+
+while test 0 != $[#]
+do
+  case $[1] in
+    --version | --v* | -V )
+      echo "$lt_cl_version"; exit 0 ;;
+    --help | --h* | -h )
+      echo "$lt_cl_help"; exit 0 ;;
+    --debug | --d* | -d )
+      debug=: ;;
+    --quiet | --q* | --silent | --s* | -q )
+      lt_cl_silent=: ;;
+
+    -*) AC_MSG_ERROR([unrecognized option: $[1]
+Try '$[0] --help' for more information.]) ;;
+
+    *) AC_MSG_ERROR([unrecognized argument: $[1]
+Try '$[0] --help' for more information.]) ;;
+  esac
+  shift
+done
+
+if $lt_cl_silent; then
+  exec AS_MESSAGE_FD>/dev/null
+fi
+_LTEOF
+
+cat >>"$CONFIG_LT" <<_LTEOF
+_LT_OUTPUT_LIBTOOL_COMMANDS_INIT
+_LTEOF
+
+cat >>"$CONFIG_LT" <<\_LTEOF
+AC_MSG_NOTICE([creating $ofile])
+_LT_OUTPUT_LIBTOOL_COMMANDS
+AS_EXIT(0)
+_LTEOF
+chmod +x "$CONFIG_LT"
+
+# configure is writing to config.log, but config.lt does its own redirection,
+# appending to config.log, which fails on DOS, as config.log is still kept
+# open by configure.  Here we exec the FD to /dev/null, effectively closing
+# config.log, so it can be properly (re)opened and appended to by config.lt.
+lt_cl_success=:
+test yes = "$silent" &&
+  lt_config_lt_args="$lt_config_lt_args --quiet"
+exec AS_MESSAGE_LOG_FD>/dev/null
+$SHELL "$CONFIG_LT" $lt_config_lt_args || lt_cl_success=false
+exec AS_MESSAGE_LOG_FD>>config.log
+$lt_cl_success || AS_EXIT(1)
+])# LT_OUTPUT
+
+
+# _LT_CONFIG(TAG)
+# ---------------
+# If TAG is the built-in tag, create an initial libtool script with a
+# default configuration from the untagged config vars.  Otherwise add code
+# to config.status for appending the configuration named by TAG from the
+# matching tagged config vars.
+m4_defun([_LT_CONFIG],
+[m4_require([_LT_FILEUTILS_DEFAULTS])dnl
+_LT_CONFIG_SAVE_COMMANDS([
+  m4_define([_LT_TAG], m4_if([$1], [], [C], [$1]))dnl
+  m4_if(_LT_TAG, [C], [
+    # See if we are running on zsh, and set the options that allow our
+    # commands through without removal of \ escapes.
+    if test -n "${ZSH_VERSION+set}"; then
+      setopt NO_GLOB_SUBST
+    fi
+
+    cfgfile=${ofile}T
+    trap "$RM \"$cfgfile\"; exit 1" 1 2 15
+    $RM "$cfgfile"
+
+    cat <<_LT_EOF >> "$cfgfile"
+#! $SHELL
+# Generated automatically by $as_me ($PACKAGE) $VERSION
+# NOTE: Changes made to this file will be lost: look at ltmain.sh.
+
+# Provide generalized library-building support services.
+# Written by Gordon Matzigkeit, 1996
+
+_LT_COPYING
+_LT_LIBTOOL_TAGS
+
+# Configured defaults for sys_lib_dlsearch_path munging.
+: \${LT_SYS_LIBRARY_PATH="$configure_time_lt_sys_library_path"}
+
+# ### BEGIN LIBTOOL CONFIG
+_LT_LIBTOOL_CONFIG_VARS
+_LT_LIBTOOL_TAG_VARS
+# ### END LIBTOOL CONFIG
+
+_LT_EOF
+
+    cat <<'_LT_EOF' >> "$cfgfile"
+
+# ### BEGIN FUNCTIONS SHARED WITH CONFIGURE
+
+_LT_PREPARE_MUNGE_PATH_LIST
+_LT_PREPARE_CC_BASENAME
+
+# ### END FUNCTIONS SHARED WITH CONFIGURE
+
+_LT_EOF
+
+  case $host_os in
+  aix3*)
+    cat <<\_LT_EOF >> "$cfgfile"
+# AIX sometimes has problems with the GCC collect2 program.  For some
+# reason, if we set the COLLECT_NAMES environment variable, the problems
+# vanish in a puff of smoke.
+if test set != "${COLLECT_NAMES+set}"; then
+  COLLECT_NAMES=
+  export COLLECT_NAMES
+fi
+_LT_EOF
+    ;;
+  esac
+
+  _LT_PROG_LTMAIN
+
+  # We use sed instead of cat because bash on DJGPP gets confused if
+  # if finds mixed CR/LF and LF-only lines.  Since sed operates in
+  # text mode, it properly converts lines to CR/LF.  This bash problem
+  # is reportedly fixed, but why not run on old versions too?
+  sed '$q' "$ltmain" >> "$cfgfile" \
+     || (rm -f "$cfgfile"; exit 1)
+
+   mv -f "$cfgfile" "$ofile" ||
+    (rm -f "$ofile" && cp "$cfgfile" "$ofile" && rm -f "$cfgfile")
+  chmod +x "$ofile"
+],
+[cat <<_LT_EOF >> "$ofile"
+
+dnl Unfortunately we have to use $1 here, since _LT_TAG is not expanded
+dnl in a comment (ie after a #).
+# ### BEGIN LIBTOOL TAG CONFIG: $1
+_LT_LIBTOOL_TAG_VARS(_LT_TAG)
+# ### END LIBTOOL TAG CONFIG: $1
+_LT_EOF
+])dnl /m4_if
+],
+[m4_if([$1], [], [
+    PACKAGE='$PACKAGE'
+    VERSION='$VERSION'
+    RM='$RM'
+    ofile='$ofile'], [])
+])dnl /_LT_CONFIG_SAVE_COMMANDS
+])# _LT_CONFIG
+
+
+# LT_SUPPORTED_TAG(TAG)
+# ---------------------
+# Trace this macro to discover what tags are supported by the libtool
+# --tag option, using:
+#    autoconf --trace 'LT_SUPPORTED_TAG:$1'
+AC_DEFUN([LT_SUPPORTED_TAG], [])
+
+
+# C support is built-in for now
+m4_define([_LT_LANG_C_enabled], [])
+m4_define([_LT_TAGS], [])
+
+
+# LT_LANG(LANG)
+# -------------
+# Enable libtool support for the given language if not already enabled.
+AC_DEFUN([LT_LANG],
+[AC_BEFORE([$0], [LT_OUTPUT])dnl
+m4_case([$1],
+  [C],			[_LT_LANG(C)],
+  [C++],		[_LT_LANG(CXX)],
+  [Go],			[_LT_LANG(GO)],
+  [Java],		[_LT_LANG(GCJ)],
+  [Fortran 77],		[_LT_LANG(F77)],
+  [Fortran],		[_LT_LANG(FC)],
+  [Windows Resource],	[_LT_LANG(RC)],
+  [m4_ifdef([_LT_LANG_]$1[_CONFIG],
+    [_LT_LANG($1)],
+    [m4_fatal([$0: unsupported language: "$1"])])])dnl
+])# LT_LANG
+
+
+# _LT_LANG(LANGNAME)
+# ------------------
+m4_defun([_LT_LANG],
+[m4_ifdef([_LT_LANG_]$1[_enabled], [],
+  [LT_SUPPORTED_TAG([$1])dnl
+  m4_append([_LT_TAGS], [$1 ])dnl
+  m4_define([_LT_LANG_]$1[_enabled], [])dnl
+  _LT_LANG_$1_CONFIG($1)])dnl
+])# _LT_LANG
+
+
+m4_ifndef([AC_PROG_GO], [
+############################################################
+# NOTE: This macro has been submitted for inclusion into   #
+#  GNU Autoconf as AC_PROG_GO.  When it is available in    #
+#  a released version of Autoconf we should remove this    #
+#  macro and use it instead.                               #
+############################################################
+m4_defun([AC_PROG_GO],
+[AC_LANG_PUSH(Go)dnl
+AC_ARG_VAR([GOC],     [Go compiler command])dnl
+AC_ARG_VAR([GOFLAGS], [Go compiler flags])dnl
+_AC_ARG_VAR_LDFLAGS()dnl
+AC_CHECK_TOOL(GOC, gccgo)
+if test -z "$GOC"; then
+  if test -n "$ac_tool_prefix"; then
+    AC_CHECK_PROG(GOC, [${ac_tool_prefix}gccgo], [${ac_tool_prefix}gccgo])
+  fi
+fi
+if test -z "$GOC"; then
+  AC_CHECK_PROG(GOC, gccgo, gccgo, false)
+fi
+])#m4_defun
+])#m4_ifndef
+
+
+# _LT_LANG_DEFAULT_CONFIG
+# -----------------------
+m4_defun([_LT_LANG_DEFAULT_CONFIG],
+[AC_PROVIDE_IFELSE([AC_PROG_CXX],
+  [LT_LANG(CXX)],
+  [m4_define([AC_PROG_CXX], defn([AC_PROG_CXX])[LT_LANG(CXX)])])
+
+AC_PROVIDE_IFELSE([AC_PROG_F77],
+  [LT_LANG(F77)],
+  [m4_define([AC_PROG_F77], defn([AC_PROG_F77])[LT_LANG(F77)])])
+
+AC_PROVIDE_IFELSE([AC_PROG_FC],
+  [LT_LANG(FC)],
+  [m4_define([AC_PROG_FC], defn([AC_PROG_FC])[LT_LANG(FC)])])
+
+dnl The call to [A][M_PROG_GCJ] is quoted like that to stop aclocal
+dnl pulling things in needlessly.
+AC_PROVIDE_IFELSE([AC_PROG_GCJ],
+  [LT_LANG(GCJ)],
+  [AC_PROVIDE_IFELSE([A][M_PROG_GCJ],
+    [LT_LANG(GCJ)],
+    [AC_PROVIDE_IFELSE([LT_PROG_GCJ],
+      [LT_LANG(GCJ)],
+      [m4_ifdef([AC_PROG_GCJ],
+	[m4_define([AC_PROG_GCJ], defn([AC_PROG_GCJ])[LT_LANG(GCJ)])])
+       m4_ifdef([A][M_PROG_GCJ],
+	[m4_define([A][M_PROG_GCJ], defn([A][M_PROG_GCJ])[LT_LANG(GCJ)])])
+       m4_ifdef([LT_PROG_GCJ],
+	[m4_define([LT_PROG_GCJ], defn([LT_PROG_GCJ])[LT_LANG(GCJ)])])])])])
+
+AC_PROVIDE_IFELSE([AC_PROG_GO],
+  [LT_LANG(GO)],
+  [m4_define([AC_PROG_GO], defn([AC_PROG_GO])[LT_LANG(GO)])])
+
+AC_PROVIDE_IFELSE([LT_PROG_RC],
+  [LT_LANG(RC)],
+  [m4_define([LT_PROG_RC], defn([LT_PROG_RC])[LT_LANG(RC)])])
+])# _LT_LANG_DEFAULT_CONFIG
+
+# Obsolete macros:
+AU_DEFUN([AC_LIBTOOL_CXX], [LT_LANG(C++)])
+AU_DEFUN([AC_LIBTOOL_F77], [LT_LANG(Fortran 77)])
+AU_DEFUN([AC_LIBTOOL_FC], [LT_LANG(Fortran)])
+AU_DEFUN([AC_LIBTOOL_GCJ], [LT_LANG(Java)])
+AU_DEFUN([AC_LIBTOOL_RC], [LT_LANG(Windows Resource)])
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([AC_LIBTOOL_CXX], [])
+dnl AC_DEFUN([AC_LIBTOOL_F77], [])
+dnl AC_DEFUN([AC_LIBTOOL_FC], [])
+dnl AC_DEFUN([AC_LIBTOOL_GCJ], [])
+dnl AC_DEFUN([AC_LIBTOOL_RC], [])
+
+
+# _LT_TAG_COMPILER
+# ----------------
+m4_defun([_LT_TAG_COMPILER],
+[AC_REQUIRE([AC_PROG_CC])dnl
+
+_LT_DECL([LTCC], [CC], [1], [A C compiler])dnl
+_LT_DECL([LTCFLAGS], [CFLAGS], [1], [LTCC compiler flags])dnl
+_LT_TAGDECL([CC], [compiler], [1], [A language specific compiler])dnl
+_LT_TAGDECL([with_gcc], [GCC], [0], [Is the compiler the GNU compiler?])dnl
+
+# If no C compiler was specified, use CC.
+LTCC=${LTCC-"$CC"}
+
+# If no C compiler flags were specified, use CFLAGS.
+LTCFLAGS=${LTCFLAGS-"$CFLAGS"}
+
+# Allow CC to be a program name with arguments.
+compiler=$CC
+])# _LT_TAG_COMPILER
+
+
+# _LT_COMPILER_BOILERPLATE
+# ------------------------
+# Check for compiler boilerplate output or warnings with
+# the simple compiler test code.
+m4_defun([_LT_COMPILER_BOILERPLATE],
+[m4_require([_LT_DECL_SED])dnl
+ac_outfile=conftest.$ac_objext
+echo "$lt_simple_compile_test_code" >conftest.$ac_ext
+eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
+_lt_compiler_boilerplate=`cat conftest.err`
+$RM conftest*
+])# _LT_COMPILER_BOILERPLATE
+
+
+# _LT_LINKER_BOILERPLATE
+# ----------------------
+# Check for linker boilerplate output or warnings with
+# the simple link test code.
+m4_defun([_LT_LINKER_BOILERPLATE],
+[m4_require([_LT_DECL_SED])dnl
+ac_outfile=conftest.$ac_objext
+echo "$lt_simple_link_test_code" >conftest.$ac_ext
+eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
+_lt_linker_boilerplate=`cat conftest.err`
+$RM -r conftest*
+])# _LT_LINKER_BOILERPLATE
+
+# _LT_REQUIRED_DARWIN_CHECKS
+# -------------------------
+m4_defun_once([_LT_REQUIRED_DARWIN_CHECKS],[
+  case $host_os in
+    rhapsody* | darwin*)
+    AC_CHECK_TOOL([DSYMUTIL], [dsymutil], [:])
+    AC_CHECK_TOOL([NMEDIT], [nmedit], [:])
+    AC_CHECK_TOOL([LIPO], [lipo], [:])
+    AC_CHECK_TOOL([OTOOL], [otool], [:])
+    AC_CHECK_TOOL([OTOOL64], [otool64], [:])
+    _LT_DECL([], [DSYMUTIL], [1],
+      [Tool to manipulate archived DWARF debug symbol files on Mac OS X])
+    _LT_DECL([], [NMEDIT], [1],
+      [Tool to change global to local symbols on Mac OS X])
+    _LT_DECL([], [LIPO], [1],
+      [Tool to manipulate fat objects and archives on Mac OS X])
+    _LT_DECL([], [OTOOL], [1],
+      [ldd/readelf like tool for Mach-O binaries on Mac OS X])
+    _LT_DECL([], [OTOOL64], [1],
+      [ldd/readelf like tool for 64 bit Mach-O binaries on Mac OS X 10.4])
+
+    AC_CACHE_CHECK([for -single_module linker flag],[lt_cv_apple_cc_single_mod],
+      [lt_cv_apple_cc_single_mod=no
+      if test -z "$LT_MULTI_MODULE"; then
+	# By default we will add the -single_module flag. You can override
+	# by either setting the environment variable LT_MULTI_MODULE
+	# non-empty at configure time, or by adding -multi_module to the
+	# link flags.
+	rm -rf libconftest.dylib*
+	echo "int foo(void){return 1;}" > conftest.c
+	echo "$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \
+-dynamiclib -Wl,-single_module conftest.c" >&AS_MESSAGE_LOG_FD
+	$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \
+	  -dynamiclib -Wl,-single_module conftest.c 2>conftest.err
+        _lt_result=$?
+	# If there is a non-empty error log, and "single_module"
+	# appears in it, assume the flag caused a linker warning
+        if test -s conftest.err && $GREP single_module conftest.err; then
+	  cat conftest.err >&AS_MESSAGE_LOG_FD
+	# Otherwise, if the output was created with a 0 exit code from
+	# the compiler, it worked.
+	elif test -f libconftest.dylib && test 0 = "$_lt_result"; then
+	  lt_cv_apple_cc_single_mod=yes
+	else
+	  cat conftest.err >&AS_MESSAGE_LOG_FD
+	fi
+	rm -rf libconftest.dylib*
+	rm -f conftest.*
+      fi])
+
+    AC_CACHE_CHECK([for -exported_symbols_list linker flag],
+      [lt_cv_ld_exported_symbols_list],
+      [lt_cv_ld_exported_symbols_list=no
+      save_LDFLAGS=$LDFLAGS
+      echo "_main" > conftest.sym
+      LDFLAGS="$LDFLAGS -Wl,-exported_symbols_list,conftest.sym"
+      AC_LINK_IFELSE([AC_LANG_PROGRAM([],[])],
+	[lt_cv_ld_exported_symbols_list=yes],
+	[lt_cv_ld_exported_symbols_list=no])
+	LDFLAGS=$save_LDFLAGS
+    ])
+
+    AC_CACHE_CHECK([for -force_load linker flag],[lt_cv_ld_force_load],
+      [lt_cv_ld_force_load=no
+      cat > conftest.c << _LT_EOF
+int forced_loaded() { return 2;}
+_LT_EOF
+      echo "$LTCC $LTCFLAGS -c -o conftest.o conftest.c" >&AS_MESSAGE_LOG_FD
+      $LTCC $LTCFLAGS -c -o conftest.o conftest.c 2>&AS_MESSAGE_LOG_FD
+      echo "$AR cru libconftest.a conftest.o" >&AS_MESSAGE_LOG_FD
+      $AR cru libconftest.a conftest.o 2>&AS_MESSAGE_LOG_FD
+      echo "$RANLIB libconftest.a" >&AS_MESSAGE_LOG_FD
+      $RANLIB libconftest.a 2>&AS_MESSAGE_LOG_FD
+      cat > conftest.c << _LT_EOF
+int main() { return 0;}
+_LT_EOF
+      echo "$LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a" >&AS_MESSAGE_LOG_FD
+      $LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a 2>conftest.err
+      _lt_result=$?
+      if test -s conftest.err && $GREP force_load conftest.err; then
+	cat conftest.err >&AS_MESSAGE_LOG_FD
+      elif test -f conftest && test 0 = "$_lt_result" && $GREP forced_load conftest >/dev/null 2>&1; then
+	lt_cv_ld_force_load=yes
+      else
+	cat conftest.err >&AS_MESSAGE_LOG_FD
+      fi
+        rm -f conftest.err libconftest.a conftest conftest.c
+        rm -rf conftest.dSYM
+    ])
+    case $host_os in
+    rhapsody* | darwin1.[[012]])
+      _lt_dar_allow_undefined='$wl-undefined ${wl}suppress' ;;
+    darwin1.*)
+      _lt_dar_allow_undefined='$wl-flat_namespace $wl-undefined ${wl}suppress' ;;
+    darwin*) # darwin 5.x on
+      # if running on 10.5 or later, the deployment target defaults
+      # to the OS version, if on x86, and 10.4, the deployment
+      # target defaults to 10.4. Don't you love it?
+      case ${MACOSX_DEPLOYMENT_TARGET-10.0},$host in
+	10.0,*86*-darwin8*|10.0,*-darwin[[91]]*)
+	  _lt_dar_allow_undefined='$wl-undefined ${wl}dynamic_lookup' ;;
+	10.[[012]][[,.]]*)
+	  _lt_dar_allow_undefined='$wl-flat_namespace $wl-undefined ${wl}suppress' ;;
+	10.*)
+	  _lt_dar_allow_undefined='$wl-undefined ${wl}dynamic_lookup' ;;
+      esac
+    ;;
+  esac
+    if test yes = "$lt_cv_apple_cc_single_mod"; then
+      _lt_dar_single_mod='$single_module'
+    fi
+    if test yes = "$lt_cv_ld_exported_symbols_list"; then
+      _lt_dar_export_syms=' $wl-exported_symbols_list,$output_objdir/$libname-symbols.expsym'
+    else
+      _lt_dar_export_syms='~$NMEDIT -s $output_objdir/$libname-symbols.expsym $lib'
+    fi
+    if test : != "$DSYMUTIL" && test no = "$lt_cv_ld_force_load"; then
+      _lt_dsymutil='~$DSYMUTIL $lib || :'
+    else
+      _lt_dsymutil=
+    fi
+    ;;
+  esac
+])
+
+
+# _LT_DARWIN_LINKER_FEATURES([TAG])
+# ---------------------------------
+# Checks for linker and compiler features on darwin
+m4_defun([_LT_DARWIN_LINKER_FEATURES],
+[
+  m4_require([_LT_REQUIRED_DARWIN_CHECKS])
+  _LT_TAGVAR(archive_cmds_need_lc, $1)=no
+  _LT_TAGVAR(hardcode_direct, $1)=no
+  _LT_TAGVAR(hardcode_automatic, $1)=yes
+  _LT_TAGVAR(hardcode_shlibpath_var, $1)=unsupported
+  if test yes = "$lt_cv_ld_force_load"; then
+    _LT_TAGVAR(whole_archive_flag_spec, $1)='`for conv in $convenience\"\"; do test  -n \"$conv\" && new_convenience=\"$new_convenience $wl-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`'
+    m4_case([$1], [F77], [_LT_TAGVAR(compiler_needs_object, $1)=yes],
+                  [FC],  [_LT_TAGVAR(compiler_needs_object, $1)=yes])
+  else
+    _LT_TAGVAR(whole_archive_flag_spec, $1)=''
+  fi
+  _LT_TAGVAR(link_all_deplibs, $1)=yes
+  _LT_TAGVAR(allow_undefined_flag, $1)=$_lt_dar_allow_undefined
+  case $cc_basename in
+     ifort*|nagfor*) _lt_dar_can_shared=yes ;;
+     *) _lt_dar_can_shared=$GCC ;;
+  esac
+  if test yes = "$_lt_dar_can_shared"; then
+    output_verbose_link_cmd=func_echo_all
+    _LT_TAGVAR(archive_cmds, $1)="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dsymutil"
+    _LT_TAGVAR(module_cmds, $1)="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dsymutil"
+    _LT_TAGVAR(archive_expsym_cmds, $1)="sed 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dar_export_syms$_lt_dsymutil"
+    _LT_TAGVAR(module_expsym_cmds, $1)="sed -e 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dar_export_syms$_lt_dsymutil"
+    m4_if([$1], [CXX],
+[   if test yes != "$lt_cv_apple_cc_single_mod"; then
+      _LT_TAGVAR(archive_cmds, $1)="\$CC -r -keep_private_externs -nostdlib -o \$lib-master.o \$libobjs~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$lib-master.o \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring$_lt_dsymutil"
+      _LT_TAGVAR(archive_expsym_cmds, $1)="sed 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC -r -keep_private_externs -nostdlib -o \$lib-master.o \$libobjs~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$lib-master.o \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring$_lt_dar_export_syms$_lt_dsymutil"
+    fi
+],[])
+  else
+  _LT_TAGVAR(ld_shlibs, $1)=no
+  fi
+])
+
+# _LT_SYS_MODULE_PATH_AIX([TAGNAME])
+# ----------------------------------
+# Links a minimal program and checks the executable
+# for the system default hardcoded library path. In most cases,
+# this is /usr/lib:/lib, but when the MPI compilers are used
+# the location of the communication and MPI libs are included too.
+# If we don't find anything, use the default library path according
+# to the aix ld manual.
+# Store the results from the different compilers for each TAGNAME.
+# Allow to override them for all tags through lt_cv_aix_libpath.
+m4_defun([_LT_SYS_MODULE_PATH_AIX],
+[m4_require([_LT_DECL_SED])dnl
+if test set = "${lt_cv_aix_libpath+set}"; then
+  aix_libpath=$lt_cv_aix_libpath
+else
+  AC_CACHE_VAL([_LT_TAGVAR([lt_cv_aix_libpath_], [$1])],
+  [AC_LINK_IFELSE([AC_LANG_PROGRAM],[
+  lt_aix_libpath_sed='[
+      /Import File Strings/,/^$/ {
+	  /^0/ {
+	      s/^0  *\([^ ]*\) *$/\1/
+	      p
+	  }
+      }]'
+  _LT_TAGVAR([lt_cv_aix_libpath_], [$1])=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
+  # Check for a 64-bit object if we didn't find anything.
+  if test -z "$_LT_TAGVAR([lt_cv_aix_libpath_], [$1])"; then
+    _LT_TAGVAR([lt_cv_aix_libpath_], [$1])=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
+  fi],[])
+  if test -z "$_LT_TAGVAR([lt_cv_aix_libpath_], [$1])"; then
+    _LT_TAGVAR([lt_cv_aix_libpath_], [$1])=/usr/lib:/lib
+  fi
+  ])
+  aix_libpath=$_LT_TAGVAR([lt_cv_aix_libpath_], [$1])
+fi
+])# _LT_SYS_MODULE_PATH_AIX
+
+
+# _LT_SHELL_INIT(ARG)
+# -------------------
+m4_define([_LT_SHELL_INIT],
+[m4_divert_text([M4SH-INIT], [$1
+])])# _LT_SHELL_INIT
+
+
+
+# _LT_PROG_ECHO_BACKSLASH
+# -----------------------
+# Find how we can fake an echo command that does not interpret backslash.
+# In particular, with Autoconf 2.60 or later we add some code to the start
+# of the generated configure script that will find a shell with a builtin
+# printf (that we can use as an echo command).
+m4_defun([_LT_PROG_ECHO_BACKSLASH],
+[ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO
+ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO$ECHO
+
+AC_MSG_CHECKING([how to print strings])
+# Test print first, because it will be a builtin if present.
+if test "X`( print -r -- -n ) 2>/dev/null`" = X-n && \
+   test "X`print -r -- $ECHO 2>/dev/null`" = "X$ECHO"; then
+  ECHO='print -r --'
+elif test "X`printf %s $ECHO 2>/dev/null`" = "X$ECHO"; then
+  ECHO='printf %s\n'
+else
+  # Use this function as a fallback that always works.
+  func_fallback_echo ()
+  {
+    eval 'cat <<_LTECHO_EOF
+$[]1
+_LTECHO_EOF'
+  }
+  ECHO='func_fallback_echo'
+fi
+
+# func_echo_all arg...
+# Invoke $ECHO with all args, space-separated.
+func_echo_all ()
+{
+    $ECHO "$*"
+}
+
+case $ECHO in
+  printf*) AC_MSG_RESULT([printf]) ;;
+  print*) AC_MSG_RESULT([print -r]) ;;
+  *) AC_MSG_RESULT([cat]) ;;
+esac
+
+m4_ifdef([_AS_DETECT_SUGGESTED],
+[_AS_DETECT_SUGGESTED([
+  test -n "${ZSH_VERSION+set}${BASH_VERSION+set}" || (
+    ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+    ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO
+    ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO$ECHO
+    PATH=/empty FPATH=/empty; export PATH FPATH
+    test "X`printf %s $ECHO`" = "X$ECHO" \
+      || test "X`print -r -- $ECHO`" = "X$ECHO" )])])
+
+_LT_DECL([], [SHELL], [1], [Shell to use when invoking shell scripts])
+_LT_DECL([], [ECHO], [1], [An echo program that protects backslashes])
+])# _LT_PROG_ECHO_BACKSLASH
+
+
+# _LT_WITH_SYSROOT
+# ----------------
+AC_DEFUN([_LT_WITH_SYSROOT],
+[AC_MSG_CHECKING([for sysroot])
+AC_ARG_WITH([sysroot],
+[AS_HELP_STRING([--with-sysroot@<:@=DIR@:>@],
+  [Search for dependent libraries within DIR (or the compiler's sysroot
+   if not specified).])],
+[], [with_sysroot=no])
+
+dnl lt_sysroot will always be passed unquoted.  We quote it here
+dnl in case the user passed a directory name.
+lt_sysroot=
+case $with_sysroot in #(
+ yes)
+   if test yes = "$GCC"; then
+     lt_sysroot=`$CC --print-sysroot 2>/dev/null`
+   fi
+   ;; #(
+ /*)
+   lt_sysroot=`echo "$with_sysroot" | sed -e "$sed_quote_subst"`
+   ;; #(
+ no|'')
+   ;; #(
+ *)
+   AC_MSG_RESULT([$with_sysroot])
+   AC_MSG_ERROR([The sysroot must be an absolute path.])
+   ;;
+esac
+
+ AC_MSG_RESULT([${lt_sysroot:-no}])
+_LT_DECL([], [lt_sysroot], [0], [The root where to search for ]dnl
+[dependent libraries, and where our libraries should be installed.])])
+
+# _LT_ENABLE_LOCK
+# ---------------
+m4_defun([_LT_ENABLE_LOCK],
+[AC_ARG_ENABLE([libtool-lock],
+  [AS_HELP_STRING([--disable-libtool-lock],
+    [avoid locking (might break parallel builds)])])
+test no = "$enable_libtool_lock" || enable_libtool_lock=yes
+
+# Some flags need to be propagated to the compiler or linker for good
+# libtool support.
+case $host in
+ia64-*-hpux*)
+  # Find out what ABI is being produced by ac_compile, and set mode
+  # options accordingly.
+  echo 'int i;' > conftest.$ac_ext
+  if AC_TRY_EVAL(ac_compile); then
+    case `/usr/bin/file conftest.$ac_objext` in
+      *ELF-32*)
+	HPUX_IA64_MODE=32
+	;;
+      *ELF-64*)
+	HPUX_IA64_MODE=64
+	;;
+    esac
+  fi
+  rm -rf conftest*
+  ;;
+*-*-irix6*)
+  # Find out what ABI is being produced by ac_compile, and set linker
+  # options accordingly.
+  echo '[#]line '$LINENO' "configure"' > conftest.$ac_ext
+  if AC_TRY_EVAL(ac_compile); then
+    if test yes = "$lt_cv_prog_gnu_ld"; then
+      case `/usr/bin/file conftest.$ac_objext` in
+	*32-bit*)
+	  LD="${LD-ld} -melf32bsmip"
+	  ;;
+	*N32*)
+	  LD="${LD-ld} -melf32bmipn32"
+	  ;;
+	*64-bit*)
+	  LD="${LD-ld} -melf64bmip"
+	;;
+      esac
+    else
+      case `/usr/bin/file conftest.$ac_objext` in
+	*32-bit*)
+	  LD="${LD-ld} -32"
+	  ;;
+	*N32*)
+	  LD="${LD-ld} -n32"
+	  ;;
+	*64-bit*)
+	  LD="${LD-ld} -64"
+	  ;;
+      esac
+    fi
+  fi
+  rm -rf conftest*
+  ;;
+
+mips64*-*linux*)
+  # Find out what ABI is being produced by ac_compile, and set linker
+  # options accordingly.
+  echo '[#]line '$LINENO' "configure"' > conftest.$ac_ext
+  if AC_TRY_EVAL(ac_compile); then
+    emul=elf
+    case `/usr/bin/file conftest.$ac_objext` in
+      *32-bit*)
+	emul="${emul}32"
+	;;
+      *64-bit*)
+	emul="${emul}64"
+	;;
+    esac
+    case `/usr/bin/file conftest.$ac_objext` in
+      *MSB*)
+	emul="${emul}btsmip"
+	;;
+      *LSB*)
+	emul="${emul}ltsmip"
+	;;
+    esac
+    case `/usr/bin/file conftest.$ac_objext` in
+      *N32*)
+	emul="${emul}n32"
+	;;
+    esac
+    LD="${LD-ld} -m $emul"
+  fi
+  rm -rf conftest*
+  ;;
+
+x86_64-*kfreebsd*-gnu|x86_64-*linux*|powerpc*-*linux*| \
+s390*-*linux*|s390*-*tpf*|sparc*-*linux*)
+  # Find out what ABI is being produced by ac_compile, and set linker
+  # options accordingly.  Note that the listed cases only cover the
+  # situations where additional linker options are needed (such as when
+  # doing 32-bit compilation for a host where ld defaults to 64-bit, or
+  # vice versa); the common cases where no linker options are needed do
+  # not appear in the list.
+  echo 'int i;' > conftest.$ac_ext
+  if AC_TRY_EVAL(ac_compile); then
+    case `/usr/bin/file conftest.o` in
+      *32-bit*)
+	case $host in
+	  x86_64-*kfreebsd*-gnu)
+	    LD="${LD-ld} -m elf_i386_fbsd"
+	    ;;
+	  x86_64-*linux*)
+	    case `/usr/bin/file conftest.o` in
+	      *x86-64*)
+		LD="${LD-ld} -m elf32_x86_64"
+		;;
+	      *)
+		LD="${LD-ld} -m elf_i386"
+		;;
+	    esac
+	    ;;
+	  powerpc64le-*linux*)
+	    LD="${LD-ld} -m elf32lppclinux"
+	    ;;
+	  powerpc64-*linux*)
+	    LD="${LD-ld} -m elf32ppclinux"
+	    ;;
+	  s390x-*linux*)
+	    LD="${LD-ld} -m elf_s390"
+	    ;;
+	  sparc64-*linux*)
+	    LD="${LD-ld} -m elf32_sparc"
+	    ;;
+	esac
+	;;
+      *64-bit*)
+	case $host in
+	  x86_64-*kfreebsd*-gnu)
+	    LD="${LD-ld} -m elf_x86_64_fbsd"
+	    ;;
+	  x86_64-*linux*)
+	    LD="${LD-ld} -m elf_x86_64"
+	    ;;
+	  powerpcle-*linux*)
+	    LD="${LD-ld} -m elf64lppc"
+	    ;;
+	  powerpc-*linux*)
+	    LD="${LD-ld} -m elf64ppc"
+	    ;;
+	  s390*-*linux*|s390*-*tpf*)
+	    LD="${LD-ld} -m elf64_s390"
+	    ;;
+	  sparc*-*linux*)
+	    LD="${LD-ld} -m elf64_sparc"
+	    ;;
+	esac
+	;;
+    esac
+  fi
+  rm -rf conftest*
+  ;;
+
+*-*-sco3.2v5*)
+  # On SCO OpenServer 5, we need -belf to get full-featured binaries.
+  SAVE_CFLAGS=$CFLAGS
+  CFLAGS="$CFLAGS -belf"
+  AC_CACHE_CHECK([whether the C compiler needs -belf], lt_cv_cc_needs_belf,
+    [AC_LANG_PUSH(C)
+     AC_LINK_IFELSE([AC_LANG_PROGRAM([[]],[[]])],[lt_cv_cc_needs_belf=yes],[lt_cv_cc_needs_belf=no])
+     AC_LANG_POP])
+  if test yes != "$lt_cv_cc_needs_belf"; then
+    # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf
+    CFLAGS=$SAVE_CFLAGS
+  fi
+  ;;
+*-*solaris*)
+  # Find out what ABI is being produced by ac_compile, and set linker
+  # options accordingly.
+  echo 'int i;' > conftest.$ac_ext
+  if AC_TRY_EVAL(ac_compile); then
+    case `/usr/bin/file conftest.o` in
+    *64-bit*)
+      case $lt_cv_prog_gnu_ld in
+      yes*)
+        case $host in
+        i?86-*-solaris*|x86_64-*-solaris*)
+          LD="${LD-ld} -m elf_x86_64"
+          ;;
+        sparc*-*-solaris*)
+          LD="${LD-ld} -m elf64_sparc"
+          ;;
+        esac
+        # GNU ld 2.21 introduced _sol2 emulations.  Use them if available.
+        if ${LD-ld} -V | grep _sol2 >/dev/null 2>&1; then
+          LD=${LD-ld}_sol2
+        fi
+        ;;
+      *)
+	if ${LD-ld} -64 -r -o conftest2.o conftest.o >/dev/null 2>&1; then
+	  LD="${LD-ld} -64"
+	fi
+	;;
+      esac
+      ;;
+    esac
+  fi
+  rm -rf conftest*
+  ;;
+esac
+
+need_locks=$enable_libtool_lock
+])# _LT_ENABLE_LOCK
+
+
+# _LT_PROG_AR
+# -----------
+m4_defun([_LT_PROG_AR],
+[AC_CHECK_TOOLS(AR, [ar], false)
+: ${AR=ar}
+: ${AR_FLAGS=cru}
+_LT_DECL([], [AR], [1], [The archiver])
+_LT_DECL([], [AR_FLAGS], [1], [Flags to create an archive])
+
+AC_CACHE_CHECK([for archiver @FILE support], [lt_cv_ar_at_file],
+  [lt_cv_ar_at_file=no
+   AC_COMPILE_IFELSE([AC_LANG_PROGRAM],
+     [echo conftest.$ac_objext > conftest.lst
+      lt_ar_try='$AR $AR_FLAGS libconftest.a @conftest.lst >&AS_MESSAGE_LOG_FD'
+      AC_TRY_EVAL([lt_ar_try])
+      if test 0 -eq "$ac_status"; then
+	# Ensure the archiver fails upon bogus file names.
+	rm -f conftest.$ac_objext libconftest.a
+	AC_TRY_EVAL([lt_ar_try])
+	if test 0 -ne "$ac_status"; then
+          lt_cv_ar_at_file=@
+        fi
+      fi
+      rm -f conftest.* libconftest.a
+     ])
+  ])
+
+if test no = "$lt_cv_ar_at_file"; then
+  archiver_list_spec=
+else
+  archiver_list_spec=$lt_cv_ar_at_file
+fi
+_LT_DECL([], [archiver_list_spec], [1],
+  [How to feed a file listing to the archiver])
+])# _LT_PROG_AR
+
+
+# _LT_CMD_OLD_ARCHIVE
+# -------------------
+m4_defun([_LT_CMD_OLD_ARCHIVE],
+[_LT_PROG_AR
+
+AC_CHECK_TOOL(STRIP, strip, :)
+test -z "$STRIP" && STRIP=:
+_LT_DECL([], [STRIP], [1], [A symbol stripping program])
+
+AC_CHECK_TOOL(RANLIB, ranlib, :)
+test -z "$RANLIB" && RANLIB=:
+_LT_DECL([], [RANLIB], [1],
+    [Commands used to install an old-style archive])
+
+# Determine commands to create old-style static archives.
+old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs'
+old_postinstall_cmds='chmod 644 $oldlib'
+old_postuninstall_cmds=
+
+if test -n "$RANLIB"; then
+  case $host_os in
+  bitrig* | openbsd*)
+    old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB -t \$tool_oldlib"
+    ;;
+  *)
+    old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB \$tool_oldlib"
+    ;;
+  esac
+  old_archive_cmds="$old_archive_cmds~\$RANLIB \$tool_oldlib"
+fi
+
+case $host_os in
+  darwin*)
+    lock_old_archive_extraction=yes ;;
+  *)
+    lock_old_archive_extraction=no ;;
+esac
+_LT_DECL([], [old_postinstall_cmds], [2])
+_LT_DECL([], [old_postuninstall_cmds], [2])
+_LT_TAGDECL([], [old_archive_cmds], [2],
+    [Commands used to build an old-style archive])
+_LT_DECL([], [lock_old_archive_extraction], [0],
+    [Whether to use a lock for old archive extraction])
+])# _LT_CMD_OLD_ARCHIVE
+
+
+# _LT_COMPILER_OPTION(MESSAGE, VARIABLE-NAME, FLAGS,
+#		[OUTPUT-FILE], [ACTION-SUCCESS], [ACTION-FAILURE])
+# ----------------------------------------------------------------
+# Check whether the given compiler option works
+AC_DEFUN([_LT_COMPILER_OPTION],
+[m4_require([_LT_FILEUTILS_DEFAULTS])dnl
+m4_require([_LT_DECL_SED])dnl
+AC_CACHE_CHECK([$1], [$2],
+  [$2=no
+   m4_if([$4], , [ac_outfile=conftest.$ac_objext], [ac_outfile=$4])
+   echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+   lt_compiler_flag="$3"  ## exclude from sc_useless_quotes_in_assignment
+   # Insert the option either (1) after the last *FLAGS variable, or
+   # (2) before a word containing "conftest.", or (3) at the end.
+   # Note that $ac_compile itself does not contain backslashes and begins
+   # with a dollar sign (not a hyphen), so the echo should work correctly.
+   # The option is referenced via a variable to avoid confusing sed.
+   lt_compile=`echo "$ac_compile" | $SED \
+   -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
+   -e 's: [[^ ]]*conftest\.: $lt_compiler_flag&:; t' \
+   -e 's:$: $lt_compiler_flag:'`
+   (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&AS_MESSAGE_LOG_FD)
+   (eval "$lt_compile" 2>conftest.err)
+   ac_status=$?
+   cat conftest.err >&AS_MESSAGE_LOG_FD
+   echo "$as_me:$LINENO: \$? = $ac_status" >&AS_MESSAGE_LOG_FD
+   if (exit $ac_status) && test -s "$ac_outfile"; then
+     # The compiler can only warn and ignore the option if not recognized
+     # So say no if there are warnings other than the usual output.
+     $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp
+     $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
+     if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then
+       $2=yes
+     fi
+   fi
+   $RM conftest*
+])
+
+if test yes = "[$]$2"; then
+    m4_if([$5], , :, [$5])
+else
+    m4_if([$6], , :, [$6])
+fi
+])# _LT_COMPILER_OPTION
+
+# Old name:
+AU_ALIAS([AC_LIBTOOL_COMPILER_OPTION], [_LT_COMPILER_OPTION])
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([AC_LIBTOOL_COMPILER_OPTION], [])
+
+
+# _LT_LINKER_OPTION(MESSAGE, VARIABLE-NAME, FLAGS,
+#                  [ACTION-SUCCESS], [ACTION-FAILURE])
+# ----------------------------------------------------
+# Check whether the given linker option works
+AC_DEFUN([_LT_LINKER_OPTION],
+[m4_require([_LT_FILEUTILS_DEFAULTS])dnl
+m4_require([_LT_DECL_SED])dnl
+AC_CACHE_CHECK([$1], [$2],
+  [$2=no
+   save_LDFLAGS=$LDFLAGS
+   LDFLAGS="$LDFLAGS $3"
+   echo "$lt_simple_link_test_code" > conftest.$ac_ext
+   if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then
+     # The linker can only warn and ignore the option if not recognized
+     # So say no if there are warnings
+     if test -s conftest.err; then
+       # Append any errors to the config.log.
+       cat conftest.err 1>&AS_MESSAGE_LOG_FD
+       $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp
+       $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
+       if diff conftest.exp conftest.er2 >/dev/null; then
+         $2=yes
+       fi
+     else
+       $2=yes
+     fi
+   fi
+   $RM -r conftest*
+   LDFLAGS=$save_LDFLAGS
+])
+
+if test yes = "[$]$2"; then
+    m4_if([$4], , :, [$4])
+else
+    m4_if([$5], , :, [$5])
+fi
+])# _LT_LINKER_OPTION
+
+# Old name:
+AU_ALIAS([AC_LIBTOOL_LINKER_OPTION], [_LT_LINKER_OPTION])
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([AC_LIBTOOL_LINKER_OPTION], [])
+
+
+# LT_CMD_MAX_LEN
+#---------------
+AC_DEFUN([LT_CMD_MAX_LEN],
+[AC_REQUIRE([AC_CANONICAL_HOST])dnl
+# find the maximum length of command line arguments
+AC_MSG_CHECKING([the maximum length of command line arguments])
+AC_CACHE_VAL([lt_cv_sys_max_cmd_len], [dnl
+  i=0
+  teststring=ABCD
+
+  case $build_os in
+  msdosdjgpp*)
+    # On DJGPP, this test can blow up pretty badly due to problems in libc
+    # (any single argument exceeding 2000 bytes causes a buffer overrun
+    # during glob expansion).  Even if it were fixed, the result of this
+    # check would be larger than it should be.
+    lt_cv_sys_max_cmd_len=12288;    # 12K is about right
+    ;;
+
+  gnu*)
+    # Under GNU Hurd, this test is not required because there is
+    # no limit to the length of command line arguments.
+    # Libtool will interpret -1 as no limit whatsoever
+    lt_cv_sys_max_cmd_len=-1;
+    ;;
+
+  cygwin* | mingw* | cegcc*)
+    # On Win9x/ME, this test blows up -- it succeeds, but takes
+    # about 5 minutes as the teststring grows exponentially.
+    # Worse, since 9x/ME are not pre-emptively multitasking,
+    # you end up with a "frozen" computer, even though with patience
+    # the test eventually succeeds (with a max line length of 256k).
+    # Instead, let's just punt: use the minimum linelength reported by
+    # all of the supported platforms: 8192 (on NT/2K/XP).
+    lt_cv_sys_max_cmd_len=8192;
+    ;;
+
+  mint*)
+    # On MiNT this can take a long time and run out of memory.
+    lt_cv_sys_max_cmd_len=8192;
+    ;;
+
+  amigaos*)
+    # On AmigaOS with pdksh, this test takes hours, literally.
+    # So we just punt and use a minimum line length of 8192.
+    lt_cv_sys_max_cmd_len=8192;
+    ;;
+
+  bitrig* | darwin* | dragonfly* | freebsd* | netbsd* | openbsd*)
+    # This has been around since 386BSD, at least.  Likely further.
+    if test -x /sbin/sysctl; then
+      lt_cv_sys_max_cmd_len=`/sbin/sysctl -n kern.argmax`
+    elif test -x /usr/sbin/sysctl; then
+      lt_cv_sys_max_cmd_len=`/usr/sbin/sysctl -n kern.argmax`
+    else
+      lt_cv_sys_max_cmd_len=65536	# usable default for all BSDs
+    fi
+    # And add a safety zone
+    lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4`
+    lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3`
+    ;;
+
+  interix*)
+    # We know the value 262144 and hardcode it with a safety zone (like BSD)
+    lt_cv_sys_max_cmd_len=196608
+    ;;
+
+  os2*)
+    # The test takes a long time on OS/2.
+    lt_cv_sys_max_cmd_len=8192
+    ;;
+
+  osf*)
+    # Dr. Hans Ekkehard Plesser reports seeing a kernel panic running configure
+    # due to this test when exec_disable_arg_limit is 1 on Tru64. It is not
+    # nice to cause kernel panics so lets avoid the loop below.
+    # First set a reasonable default.
+    lt_cv_sys_max_cmd_len=16384
+    #
+    if test -x /sbin/sysconfig; then
+      case `/sbin/sysconfig -q proc exec_disable_arg_limit` in
+        *1*) lt_cv_sys_max_cmd_len=-1 ;;
+      esac
+    fi
+    ;;
+  sco3.2v5*)
+    lt_cv_sys_max_cmd_len=102400
+    ;;
+  sysv5* | sco5v6* | sysv4.2uw2*)
+    kargmax=`grep ARG_MAX /etc/conf/cf.d/stune 2>/dev/null`
+    if test -n "$kargmax"; then
+      lt_cv_sys_max_cmd_len=`echo $kargmax | sed 's/.*[[	 ]]//'`
+    else
+      lt_cv_sys_max_cmd_len=32768
+    fi
+    ;;
+  *)
+    lt_cv_sys_max_cmd_len=`(getconf ARG_MAX) 2> /dev/null`
+    if test -n "$lt_cv_sys_max_cmd_len" && \
+       test undefined != "$lt_cv_sys_max_cmd_len"; then
+      lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4`
+      lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3`
+    else
+      # Make teststring a little bigger before we do anything with it.
+      # a 1K string should be a reasonable start.
+      for i in 1 2 3 4 5 6 7 8; do
+        teststring=$teststring$teststring
+      done
+      SHELL=${SHELL-${CONFIG_SHELL-/bin/sh}}
+      # If test is not a shell built-in, we'll probably end up computing a
+      # maximum length that is only half of the actual maximum length, but
+      # we can't tell.
+      while { test X`env echo "$teststring$teststring" 2>/dev/null` \
+	         = "X$teststring$teststring"; } >/dev/null 2>&1 &&
+	      test 17 != "$i" # 1/2 MB should be enough
+      do
+        i=`expr $i + 1`
+        teststring=$teststring$teststring
+      done
+      # Only check the string length outside the loop.
+      lt_cv_sys_max_cmd_len=`expr "X$teststring" : ".*" 2>&1`
+      teststring=
+      # Add a significant safety factor because C++ compilers can tack on
+      # massive amounts of additional arguments before passing them to the
+      # linker.  It appears as though 1/2 is a usable value.
+      lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 2`
+    fi
+    ;;
+  esac
+])
+if test -n "$lt_cv_sys_max_cmd_len"; then
+  AC_MSG_RESULT($lt_cv_sys_max_cmd_len)
+else
+  AC_MSG_RESULT(none)
+fi
+max_cmd_len=$lt_cv_sys_max_cmd_len
+_LT_DECL([], [max_cmd_len], [0],
+    [What is the maximum length of a command?])
+])# LT_CMD_MAX_LEN
+
+# Old name:
+AU_ALIAS([AC_LIBTOOL_SYS_MAX_CMD_LEN], [LT_CMD_MAX_LEN])
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([AC_LIBTOOL_SYS_MAX_CMD_LEN], [])
+
+
+# _LT_HEADER_DLFCN
+# ----------------
+m4_defun([_LT_HEADER_DLFCN],
+[AC_CHECK_HEADERS([dlfcn.h], [], [], [AC_INCLUDES_DEFAULT])dnl
+])# _LT_HEADER_DLFCN
+
+
+# _LT_TRY_DLOPEN_SELF (ACTION-IF-TRUE, ACTION-IF-TRUE-W-USCORE,
+#                      ACTION-IF-FALSE, ACTION-IF-CROSS-COMPILING)
+# ----------------------------------------------------------------
+m4_defun([_LT_TRY_DLOPEN_SELF],
+[m4_require([_LT_HEADER_DLFCN])dnl
+if test yes = "$cross_compiling"; then :
+  [$4]
+else
+  lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
+  lt_status=$lt_dlunknown
+  cat > conftest.$ac_ext <<_LT_EOF
+[#line $LINENO "configure"
+#include "confdefs.h"
+
+#if HAVE_DLFCN_H
+#include 
+#endif
+
+#include 
+
+#ifdef RTLD_GLOBAL
+#  define LT_DLGLOBAL		RTLD_GLOBAL
+#else
+#  ifdef DL_GLOBAL
+#    define LT_DLGLOBAL		DL_GLOBAL
+#  else
+#    define LT_DLGLOBAL		0
+#  endif
+#endif
+
+/* We may have to define LT_DLLAZY_OR_NOW in the command line if we
+   find out it does not work in some platform. */
+#ifndef LT_DLLAZY_OR_NOW
+#  ifdef RTLD_LAZY
+#    define LT_DLLAZY_OR_NOW		RTLD_LAZY
+#  else
+#    ifdef DL_LAZY
+#      define LT_DLLAZY_OR_NOW		DL_LAZY
+#    else
+#      ifdef RTLD_NOW
+#        define LT_DLLAZY_OR_NOW	RTLD_NOW
+#      else
+#        ifdef DL_NOW
+#          define LT_DLLAZY_OR_NOW	DL_NOW
+#        else
+#          define LT_DLLAZY_OR_NOW	0
+#        endif
+#      endif
+#    endif
+#  endif
+#endif
+
+/* When -fvisibility=hidden is used, assume the code has been annotated
+   correspondingly for the symbols needed.  */
+#if defined __GNUC__ && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3))
+int fnord () __attribute__((visibility("default")));
+#endif
+
+int fnord () { return 42; }
+int main ()
+{
+  void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW);
+  int status = $lt_dlunknown;
+
+  if (self)
+    {
+      if (dlsym (self,"fnord"))       status = $lt_dlno_uscore;
+      else
+        {
+	  if (dlsym( self,"_fnord"))  status = $lt_dlneed_uscore;
+          else puts (dlerror ());
+	}
+      /* dlclose (self); */
+    }
+  else
+    puts (dlerror ());
+
+  return status;
+}]
+_LT_EOF
+  if AC_TRY_EVAL(ac_link) && test -s "conftest$ac_exeext" 2>/dev/null; then
+    (./conftest; exit; ) >&AS_MESSAGE_LOG_FD 2>/dev/null
+    lt_status=$?
+    case x$lt_status in
+      x$lt_dlno_uscore) $1 ;;
+      x$lt_dlneed_uscore) $2 ;;
+      x$lt_dlunknown|x*) $3 ;;
+    esac
+  else :
+    # compilation failed
+    $3
+  fi
+fi
+rm -fr conftest*
+])# _LT_TRY_DLOPEN_SELF
+
+
+# LT_SYS_DLOPEN_SELF
+# ------------------
+AC_DEFUN([LT_SYS_DLOPEN_SELF],
+[m4_require([_LT_HEADER_DLFCN])dnl
+if test yes != "$enable_dlopen"; then
+  enable_dlopen=unknown
+  enable_dlopen_self=unknown
+  enable_dlopen_self_static=unknown
+else
+  lt_cv_dlopen=no
+  lt_cv_dlopen_libs=
+
+  case $host_os in
+  beos*)
+    lt_cv_dlopen=load_add_on
+    lt_cv_dlopen_libs=
+    lt_cv_dlopen_self=yes
+    ;;
+
+  mingw* | pw32* | cegcc*)
+    lt_cv_dlopen=LoadLibrary
+    lt_cv_dlopen_libs=
+    ;;
+
+  cygwin*)
+    lt_cv_dlopen=dlopen
+    lt_cv_dlopen_libs=
+    ;;
+
+  darwin*)
+    # if libdl is installed we need to link against it
+    AC_CHECK_LIB([dl], [dlopen],
+		[lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-ldl],[
+    lt_cv_dlopen=dyld
+    lt_cv_dlopen_libs=
+    lt_cv_dlopen_self=yes
+    ])
+    ;;
+
+  tpf*)
+    # Don't try to run any link tests for TPF.  We know it's impossible
+    # because TPF is a cross-compiler, and we know how we open DSOs.
+    lt_cv_dlopen=dlopen
+    lt_cv_dlopen_libs=
+    lt_cv_dlopen_self=no
+    ;;
+
+  *)
+    AC_CHECK_FUNC([shl_load],
+	  [lt_cv_dlopen=shl_load],
+      [AC_CHECK_LIB([dld], [shl_load],
+	    [lt_cv_dlopen=shl_load lt_cv_dlopen_libs=-ldld],
+	[AC_CHECK_FUNC([dlopen],
+	      [lt_cv_dlopen=dlopen],
+	  [AC_CHECK_LIB([dl], [dlopen],
+		[lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-ldl],
+	    [AC_CHECK_LIB([svld], [dlopen],
+		  [lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-lsvld],
+	      [AC_CHECK_LIB([dld], [dld_link],
+		    [lt_cv_dlopen=dld_link lt_cv_dlopen_libs=-ldld])
+	      ])
+	    ])
+	  ])
+	])
+      ])
+    ;;
+  esac
+
+  if test no = "$lt_cv_dlopen"; then
+    enable_dlopen=no
+  else
+    enable_dlopen=yes
+  fi
+
+  case $lt_cv_dlopen in
+  dlopen)
+    save_CPPFLAGS=$CPPFLAGS
+    test yes = "$ac_cv_header_dlfcn_h" && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H"
+
+    save_LDFLAGS=$LDFLAGS
+    wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\"
+
+    save_LIBS=$LIBS
+    LIBS="$lt_cv_dlopen_libs $LIBS"
+
+    AC_CACHE_CHECK([whether a program can dlopen itself],
+	  lt_cv_dlopen_self, [dnl
+	  _LT_TRY_DLOPEN_SELF(
+	    lt_cv_dlopen_self=yes, lt_cv_dlopen_self=yes,
+	    lt_cv_dlopen_self=no, lt_cv_dlopen_self=cross)
+    ])
+
+    if test yes = "$lt_cv_dlopen_self"; then
+      wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $lt_prog_compiler_static\"
+      AC_CACHE_CHECK([whether a statically linked program can dlopen itself],
+	  lt_cv_dlopen_self_static, [dnl
+	  _LT_TRY_DLOPEN_SELF(
+	    lt_cv_dlopen_self_static=yes, lt_cv_dlopen_self_static=yes,
+	    lt_cv_dlopen_self_static=no,  lt_cv_dlopen_self_static=cross)
+      ])
+    fi
+
+    CPPFLAGS=$save_CPPFLAGS
+    LDFLAGS=$save_LDFLAGS
+    LIBS=$save_LIBS
+    ;;
+  esac
+
+  case $lt_cv_dlopen_self in
+  yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;;
+  *) enable_dlopen_self=unknown ;;
+  esac
+
+  case $lt_cv_dlopen_self_static in
+  yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;;
+  *) enable_dlopen_self_static=unknown ;;
+  esac
+fi
+_LT_DECL([dlopen_support], [enable_dlopen], [0],
+	 [Whether dlopen is supported])
+_LT_DECL([dlopen_self], [enable_dlopen_self], [0],
+	 [Whether dlopen of programs is supported])
+_LT_DECL([dlopen_self_static], [enable_dlopen_self_static], [0],
+	 [Whether dlopen of statically linked programs is supported])
+])# LT_SYS_DLOPEN_SELF
+
+# Old name:
+AU_ALIAS([AC_LIBTOOL_DLOPEN_SELF], [LT_SYS_DLOPEN_SELF])
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([AC_LIBTOOL_DLOPEN_SELF], [])
+
+
+# _LT_COMPILER_C_O([TAGNAME])
+# ---------------------------
+# Check to see if options -c and -o are simultaneously supported by compiler.
+# This macro does not hard code the compiler like AC_PROG_CC_C_O.
+m4_defun([_LT_COMPILER_C_O],
+[m4_require([_LT_DECL_SED])dnl
+m4_require([_LT_FILEUTILS_DEFAULTS])dnl
+m4_require([_LT_TAG_COMPILER])dnl
+AC_CACHE_CHECK([if $compiler supports -c -o file.$ac_objext],
+  [_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)],
+  [_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)=no
+   $RM -r conftest 2>/dev/null
+   mkdir conftest
+   cd conftest
+   mkdir out
+   echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+
+   lt_compiler_flag="-o out/conftest2.$ac_objext"
+   # Insert the option either (1) after the last *FLAGS variable, or
+   # (2) before a word containing "conftest.", or (3) at the end.
+   # Note that $ac_compile itself does not contain backslashes and begins
+   # with a dollar sign (not a hyphen), so the echo should work correctly.
+   lt_compile=`echo "$ac_compile" | $SED \
+   -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
+   -e 's: [[^ ]]*conftest\.: $lt_compiler_flag&:; t' \
+   -e 's:$: $lt_compiler_flag:'`
+   (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&AS_MESSAGE_LOG_FD)
+   (eval "$lt_compile" 2>out/conftest.err)
+   ac_status=$?
+   cat out/conftest.err >&AS_MESSAGE_LOG_FD
+   echo "$as_me:$LINENO: \$? = $ac_status" >&AS_MESSAGE_LOG_FD
+   if (exit $ac_status) && test -s out/conftest2.$ac_objext
+   then
+     # The compiler can only warn and ignore the option if not recognized
+     # So say no if there are warnings
+     $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp
+     $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2
+     if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then
+       _LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)=yes
+     fi
+   fi
+   chmod u+w . 2>&AS_MESSAGE_LOG_FD
+   $RM conftest*
+   # SGI C++ compiler will create directory out/ii_files/ for
+   # template instantiation
+   test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files
+   $RM out/* && rmdir out
+   cd ..
+   $RM -r conftest
+   $RM conftest*
+])
+_LT_TAGDECL([compiler_c_o], [lt_cv_prog_compiler_c_o], [1],
+	[Does compiler simultaneously support -c and -o options?])
+])# _LT_COMPILER_C_O
+
+
+# _LT_COMPILER_FILE_LOCKS([TAGNAME])
+# ----------------------------------
+# Check to see if we can do hard links to lock some files if needed
+m4_defun([_LT_COMPILER_FILE_LOCKS],
+[m4_require([_LT_ENABLE_LOCK])dnl
+m4_require([_LT_FILEUTILS_DEFAULTS])dnl
+_LT_COMPILER_C_O([$1])
+
+hard_links=nottested
+if test no = "$_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)" && test no != "$need_locks"; then
+  # do not overwrite the value of need_locks provided by the user
+  AC_MSG_CHECKING([if we can lock with hard links])
+  hard_links=yes
+  $RM conftest*
+  ln conftest.a conftest.b 2>/dev/null && hard_links=no
+  touch conftest.a
+  ln conftest.a conftest.b 2>&5 || hard_links=no
+  ln conftest.a conftest.b 2>/dev/null && hard_links=no
+  AC_MSG_RESULT([$hard_links])
+  if test no = "$hard_links"; then
+    AC_MSG_WARN(['$CC' does not support '-c -o', so 'make -j' may be unsafe])
+    need_locks=warn
+  fi
+else
+  need_locks=no
+fi
+_LT_DECL([], [need_locks], [1], [Must we lock files when doing compilation?])
+])# _LT_COMPILER_FILE_LOCKS
+
+
+# _LT_CHECK_OBJDIR
+# ----------------
+m4_defun([_LT_CHECK_OBJDIR],
+[AC_CACHE_CHECK([for objdir], [lt_cv_objdir],
+[rm -f .libs 2>/dev/null
+mkdir .libs 2>/dev/null
+if test -d .libs; then
+  lt_cv_objdir=.libs
+else
+  # MS-DOS does not allow filenames that begin with a dot.
+  lt_cv_objdir=_libs
+fi
+rmdir .libs 2>/dev/null])
+objdir=$lt_cv_objdir
+_LT_DECL([], [objdir], [0],
+         [The name of the directory that contains temporary libtool files])dnl
+m4_pattern_allow([LT_OBJDIR])dnl
+AC_DEFINE_UNQUOTED([LT_OBJDIR], "$lt_cv_objdir/",
+  [Define to the sub-directory where libtool stores uninstalled libraries.])
+])# _LT_CHECK_OBJDIR
+
+
+# _LT_LINKER_HARDCODE_LIBPATH([TAGNAME])
+# --------------------------------------
+# Check hardcoding attributes.
+m4_defun([_LT_LINKER_HARDCODE_LIBPATH],
+[AC_MSG_CHECKING([how to hardcode library paths into programs])
+_LT_TAGVAR(hardcode_action, $1)=
+if test -n "$_LT_TAGVAR(hardcode_libdir_flag_spec, $1)" ||
+   test -n "$_LT_TAGVAR(runpath_var, $1)" ||
+   test yes = "$_LT_TAGVAR(hardcode_automatic, $1)"; then
+
+  # We can hardcode non-existent directories.
+  if test no != "$_LT_TAGVAR(hardcode_direct, $1)" &&
+     # If the only mechanism to avoid hardcoding is shlibpath_var, we
+     # have to relink, otherwise we might link with an installed library
+     # when we should be linking with a yet-to-be-installed one
+     ## test no != "$_LT_TAGVAR(hardcode_shlibpath_var, $1)" &&
+     test no != "$_LT_TAGVAR(hardcode_minus_L, $1)"; then
+    # Linking always hardcodes the temporary library directory.
+    _LT_TAGVAR(hardcode_action, $1)=relink
+  else
+    # We can link without hardcoding, and we can hardcode nonexisting dirs.
+    _LT_TAGVAR(hardcode_action, $1)=immediate
+  fi
+else
+  # We cannot hardcode anything, or else we can only hardcode existing
+  # directories.
+  _LT_TAGVAR(hardcode_action, $1)=unsupported
+fi
+AC_MSG_RESULT([$_LT_TAGVAR(hardcode_action, $1)])
+
+if test relink = "$_LT_TAGVAR(hardcode_action, $1)" ||
+   test yes = "$_LT_TAGVAR(inherit_rpath, $1)"; then
+  # Fast installation is not supported
+  enable_fast_install=no
+elif test yes = "$shlibpath_overrides_runpath" ||
+     test no = "$enable_shared"; then
+  # Fast installation is not necessary
+  enable_fast_install=needless
+fi
+_LT_TAGDECL([], [hardcode_action], [0],
+    [How to hardcode a shared library path into an executable])
+])# _LT_LINKER_HARDCODE_LIBPATH
+
+
+# _LT_CMD_STRIPLIB
+# ----------------
+m4_defun([_LT_CMD_STRIPLIB],
+[m4_require([_LT_DECL_EGREP])
+striplib=
+old_striplib=
+AC_MSG_CHECKING([whether stripping libraries is possible])
+if test -n "$STRIP" && $STRIP -V 2>&1 | $GREP "GNU strip" >/dev/null; then
+  test -z "$old_striplib" && old_striplib="$STRIP --strip-debug"
+  test -z "$striplib" && striplib="$STRIP --strip-unneeded"
+  AC_MSG_RESULT([yes])
+else
+# FIXME - insert some real tests, host_os isn't really good enough
+  case $host_os in
+  darwin*)
+    if test -n "$STRIP"; then
+      striplib="$STRIP -x"
+      old_striplib="$STRIP -S"
+      AC_MSG_RESULT([yes])
+    else
+      AC_MSG_RESULT([no])
+    fi
+    ;;
+  *)
+    AC_MSG_RESULT([no])
+    ;;
+  esac
+fi
+_LT_DECL([], [old_striplib], [1], [Commands to strip libraries])
+_LT_DECL([], [striplib], [1])
+])# _LT_CMD_STRIPLIB
+
+
+# _LT_PREPARE_MUNGE_PATH_LIST
+# ---------------------------
+# Make sure func_munge_path_list() is defined correctly.
+m4_defun([_LT_PREPARE_MUNGE_PATH_LIST],
+[[# func_munge_path_list VARIABLE PATH
+# -----------------------------------
+# VARIABLE is name of variable containing _space_ separated list of
+# directories to be munged by the contents of PATH, which is string
+# having a format:
+# "DIR[:DIR]:"
+#       string "DIR[ DIR]" will be prepended to VARIABLE
+# ":DIR[:DIR]"
+#       string "DIR[ DIR]" will be appended to VARIABLE
+# "DIRP[:DIRP]::[DIRA:]DIRA"
+#       string "DIRP[ DIRP]" will be prepended to VARIABLE and string
+#       "DIRA[ DIRA]" will be appended to VARIABLE
+# "DIR[:DIR]"
+#       VARIABLE will be replaced by "DIR[ DIR]"
+func_munge_path_list ()
+{
+    case x@S|@2 in
+    x)
+        ;;
+    *:)
+        eval @S|@1=\"`$ECHO @S|@2 | $SED 's/:/ /g'` \@S|@@S|@1\"
+        ;;
+    x:*)
+        eval @S|@1=\"\@S|@@S|@1 `$ECHO @S|@2 | $SED 's/:/ /g'`\"
+        ;;
+    *::*)
+        eval @S|@1=\"\@S|@@S|@1\ `$ECHO @S|@2 | $SED -e 's/.*:://' -e 's/:/ /g'`\"
+        eval @S|@1=\"`$ECHO @S|@2 | $SED -e 's/::.*//' -e 's/:/ /g'`\ \@S|@@S|@1\"
+        ;;
+    *)
+        eval @S|@1=\"`$ECHO @S|@2 | $SED 's/:/ /g'`\"
+        ;;
+    esac
+}
+]])# _LT_PREPARE_PATH_LIST
+
+
+# _LT_SYS_DYNAMIC_LINKER([TAG])
+# -----------------------------
+# PORTME Fill in your ld.so characteristics
+m4_defun([_LT_SYS_DYNAMIC_LINKER],
+[AC_REQUIRE([AC_CANONICAL_HOST])dnl
+m4_require([_LT_DECL_EGREP])dnl
+m4_require([_LT_FILEUTILS_DEFAULTS])dnl
+m4_require([_LT_DECL_OBJDUMP])dnl
+m4_require([_LT_DECL_SED])dnl
+m4_require([_LT_CHECK_SHELL_FEATURES])dnl
+m4_require([_LT_PREPARE_MUNGE_PATH_LIST])dnl
+AC_MSG_CHECKING([dynamic linker characteristics])
+m4_if([$1],
+	[], [
+if test yes = "$GCC"; then
+  case $host_os in
+    darwin*) lt_awk_arg='/^libraries:/,/LR/' ;;
+    *) lt_awk_arg='/^libraries:/' ;;
+  esac
+  case $host_os in
+    mingw* | cegcc*) lt_sed_strip_eq='s|=\([[A-Za-z]]:\)|\1|g' ;;
+    *) lt_sed_strip_eq='s|=/|/|g' ;;
+  esac
+  lt_search_path_spec=`$CC -print-search-dirs | awk $lt_awk_arg | $SED -e "s/^libraries://" -e $lt_sed_strip_eq`
+  case $lt_search_path_spec in
+  *\;*)
+    # if the path contains ";" then we assume it to be the separator
+    # otherwise default to the standard path separator (i.e. ":") - it is
+    # assumed that no part of a normal pathname contains ";" but that should
+    # okay in the real world where ";" in dirpaths is itself problematic.
+    lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED 's/;/ /g'`
+    ;;
+  *)
+    lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED "s/$PATH_SEPARATOR/ /g"`
+    ;;
+  esac
+  # Ok, now we have the path, separated by spaces, we can step through it
+  # and add multilib dir if necessary...
+  lt_tmp_lt_search_path_spec=
+  lt_multi_os_dir=/`$CC $CPPFLAGS $CFLAGS $LDFLAGS -print-multi-os-directory 2>/dev/null`
+  # ...but if some path component already ends with the multilib dir we assume
+  # that all is fine and trust -print-search-dirs as is (GCC 4.2? or newer).
+  case "$lt_multi_os_dir; $lt_search_path_spec " in
+  "/; "* | "/.; "* | "/./; "* | *"$lt_multi_os_dir "* | *"$lt_multi_os_dir/ "*)
+    lt_multi_os_dir=
+    ;;
+  esac
+  for lt_sys_path in $lt_search_path_spec; do
+    if test -d "$lt_sys_path$lt_multi_os_dir"; then
+      lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path$lt_multi_os_dir"
+    elif test -n "$lt_multi_os_dir"; then
+      test -d "$lt_sys_path" && \
+	lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path"
+    fi
+  done
+  lt_search_path_spec=`$ECHO "$lt_tmp_lt_search_path_spec" | awk '
+BEGIN {RS = " "; FS = "/|\n";} {
+  lt_foo = "";
+  lt_count = 0;
+  for (lt_i = NF; lt_i > 0; lt_i--) {
+    if ($lt_i != "" && $lt_i != ".") {
+      if ($lt_i == "..") {
+        lt_count++;
+      } else {
+        if (lt_count == 0) {
+          lt_foo = "/" $lt_i lt_foo;
+        } else {
+          lt_count--;
+        }
+      }
+    }
+  }
+  if (lt_foo != "") { lt_freq[[lt_foo]]++; }
+  if (lt_freq[[lt_foo]] == 1) { print lt_foo; }
+}'`
+  # AWK program above erroneously prepends '/' to C:/dos/paths
+  # for these hosts.
+  case $host_os in
+    mingw* | cegcc*) lt_search_path_spec=`$ECHO "$lt_search_path_spec" |\
+      $SED 's|/\([[A-Za-z]]:\)|\1|g'` ;;
+  esac
+  sys_lib_search_path_spec=`$ECHO "$lt_search_path_spec" | $lt_NL2SP`
+else
+  sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib"
+fi])
+library_names_spec=
+libname_spec='lib$name'
+soname_spec=
+shrext_cmds=.so
+postinstall_cmds=
+postuninstall_cmds=
+finish_cmds=
+finish_eval=
+shlibpath_var=
+shlibpath_overrides_runpath=unknown
+version_type=none
+dynamic_linker="$host_os ld.so"
+sys_lib_dlsearch_path_spec="/lib /usr/lib"
+need_lib_prefix=unknown
+hardcode_into_libs=no
+
+# when you set need_version to no, make sure it does not cause -set_version
+# flags to be left without arguments
+need_version=unknown
+
+AC_ARG_VAR([LT_SYS_LIBRARY_PATH],
+[User-defined run-time library search path.])
+
+case $host_os in
+aix3*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  library_names_spec='$libname$release$shared_ext$versuffix $libname.a'
+  shlibpath_var=LIBPATH
+
+  # AIX 3 has no versioning support, so we append a major version to the name.
+  soname_spec='$libname$release$shared_ext$major'
+  ;;
+
+aix[[4-9]]*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_lib_prefix=no
+  need_version=no
+  hardcode_into_libs=yes
+  if test ia64 = "$host_cpu"; then
+    # AIX 5 supports IA64
+    library_names_spec='$libname$release$shared_ext$major $libname$release$shared_ext$versuffix $libname$shared_ext'
+    shlibpath_var=LD_LIBRARY_PATH
+  else
+    # With GCC up to 2.95.x, collect2 would create an import file
+    # for dependence libraries.  The import file would start with
+    # the line '#! .'.  This would cause the generated library to
+    # depend on '.', always an invalid library.  This was fixed in
+    # development snapshots of GCC prior to 3.0.
+    case $host_os in
+      aix4 | aix4.[[01]] | aix4.[[01]].*)
+      if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)'
+	   echo ' yes '
+	   echo '#endif'; } | $CC -E - | $GREP yes > /dev/null; then
+	:
+      else
+	can_build_shared=no
+      fi
+      ;;
+    esac
+    # Using Import Files as archive members, it is possible to support
+    # filename-based versioning of shared library archives on AIX. While
+    # this would work for both with and without runtime linking, it will
+    # prevent static linking of such archives. So we do filename-based
+    # shared library versioning with .so extension only, which is used
+    # when both runtime linking and shared linking is enabled.
+    # Unfortunately, runtime linking may impact performance, so we do
+    # not want this to be the default eventually. Also, we use the
+    # versioned .so libs for executables only if there is the -brtl
+    # linker flag in LDFLAGS as well, or --with-aix-soname=svr4 only.
+    # To allow for filename-based versioning support, we need to create
+    # libNAME.so.V as an archive file, containing:
+    # *) an Import File, referring to the versioned filename of the
+    #    archive as well as the shared archive member, telling the
+    #    bitwidth (32 or 64) of that shared object, and providing the
+    #    list of exported symbols of that shared object, eventually
+    #    decorated with the 'weak' keyword
+    # *) the shared object with the F_LOADONLY flag set, to really avoid
+    #    it being seen by the linker.
+    # At run time we better use the real file rather than another symlink,
+    # but for link time we create the symlink libNAME.so -> libNAME.so.V
+
+    case $with_aix_soname,$aix_use_runtimelinking in
+    # AIX (on Power*) has no versioning support, so currently we cannot hardcode correct
+    # soname into executable. Probably we can add versioning support to
+    # collect2, so additional links can be useful in future.
+    aix,yes) # traditional libtool
+      dynamic_linker='AIX unversionable lib.so'
+      # If using run time linking (on AIX 4.2 or later) use lib.so
+      # instead of lib.a to let people know that these are not
+      # typical AIX shared libraries.
+      library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+      ;;
+    aix,no) # traditional AIX only
+      dynamic_linker='AIX lib.a[(]lib.so.V[)]'
+      # We preserve .a as extension for shared libraries through AIX4.2
+      # and later when we are not doing run time linking.
+      library_names_spec='$libname$release.a $libname.a'
+      soname_spec='$libname$release$shared_ext$major'
+      ;;
+    svr4,*) # full svr4 only
+      dynamic_linker="AIX lib.so.V[(]$shared_archive_member_spec.o[)]"
+      library_names_spec='$libname$release$shared_ext$major $libname$shared_ext'
+      # We do not specify a path in Import Files, so LIBPATH fires.
+      shlibpath_overrides_runpath=yes
+      ;;
+    *,yes) # both, prefer svr4
+      dynamic_linker="AIX lib.so.V[(]$shared_archive_member_spec.o[)], lib.a[(]lib.so.V[)]"
+      library_names_spec='$libname$release$shared_ext$major $libname$shared_ext'
+      # unpreferred sharedlib libNAME.a needs extra handling
+      postinstall_cmds='test -n "$linkname" || linkname="$realname"~func_stripname "" ".so" "$linkname"~$install_shared_prog "$dir/$func_stripname_result.$libext" "$destdir/$func_stripname_result.$libext"~test -z "$tstripme" || test -z "$striplib" || $striplib "$destdir/$func_stripname_result.$libext"'
+      postuninstall_cmds='for n in $library_names $old_library; do :; done~func_stripname "" ".so" "$n"~test "$func_stripname_result" = "$n" || func_append rmfiles " $odir/$func_stripname_result.$libext"'
+      # We do not specify a path in Import Files, so LIBPATH fires.
+      shlibpath_overrides_runpath=yes
+      ;;
+    *,no) # both, prefer aix
+      dynamic_linker="AIX lib.a[(]lib.so.V[)], lib.so.V[(]$shared_archive_member_spec.o[)]"
+      library_names_spec='$libname$release.a $libname.a'
+      soname_spec='$libname$release$shared_ext$major'
+      # unpreferred sharedlib libNAME.so.V and symlink libNAME.so need extra handling
+      postinstall_cmds='test -z "$dlname" || $install_shared_prog $dir/$dlname $destdir/$dlname~test -z "$tstripme" || test -z "$striplib" || $striplib $destdir/$dlname~test -n "$linkname" || linkname=$realname~func_stripname "" ".a" "$linkname"~(cd "$destdir" && $LN_S -f $dlname $func_stripname_result.so)'
+      postuninstall_cmds='test -z "$dlname" || func_append rmfiles " $odir/$dlname"~for n in $old_library $library_names; do :; done~func_stripname "" ".a" "$n"~func_append rmfiles " $odir/$func_stripname_result.so"'
+      ;;
+    esac
+    shlibpath_var=LIBPATH
+  fi
+  ;;
+
+amigaos*)
+  case $host_cpu in
+  powerpc)
+    # Since July 2007 AmigaOS4 officially supports .so libraries.
+    # When compiling the executable, add -use-dynld -Lsobjs: to the compileline.
+    library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+    ;;
+  m68k)
+    library_names_spec='$libname.ixlibrary $libname.a'
+    # Create ${libname}_ixlibrary.a entries in /sys/libs.
+    finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([[^/]]*\)\.ixlibrary$%\1%'\''`; $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done'
+    ;;
+  esac
+  ;;
+
+beos*)
+  library_names_spec='$libname$shared_ext'
+  dynamic_linker="$host_os ld.so"
+  shlibpath_var=LIBRARY_PATH
+  ;;
+
+bsdi[[45]]*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib"
+  sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib"
+  # the default ld.so.conf also contains /usr/contrib/lib and
+  # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow
+  # libtool to hard-code these into programs
+  ;;
+
+cygwin* | mingw* | pw32* | cegcc*)
+  version_type=windows
+  shrext_cmds=.dll
+  need_version=no
+  need_lib_prefix=no
+
+  case $GCC,$cc_basename in
+  yes,*)
+    # gcc
+    library_names_spec='$libname.dll.a'
+    # DLL is installed to $(libdir)/../bin by postinstall_cmds
+    postinstall_cmds='base_file=`basename \$file`~
+      dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~
+      dldir=$destdir/`dirname \$dlpath`~
+      test -d \$dldir || mkdir -p \$dldir~
+      $install_prog $dir/$dlname \$dldir/$dlname~
+      chmod a+x \$dldir/$dlname~
+      if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then
+        eval '\''$striplib \$dldir/$dlname'\'' || exit \$?;
+      fi'
+    postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~
+      dlpath=$dir/\$dldll~
+       $RM \$dlpath'
+    shlibpath_overrides_runpath=yes
+
+    case $host_os in
+    cygwin*)
+      # Cygwin DLLs use 'cyg' prefix rather than 'lib'
+      soname_spec='`echo $libname | sed -e 's/^lib/cyg/'``echo $release | $SED -e 's/[[.]]/-/g'`$versuffix$shared_ext'
+m4_if([$1], [],[
+      sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/lib/w32api"])
+      ;;
+    mingw* | cegcc*)
+      # MinGW DLLs use traditional 'lib' prefix
+      soname_spec='$libname`echo $release | $SED -e 's/[[.]]/-/g'`$versuffix$shared_ext'
+      ;;
+    pw32*)
+      # pw32 DLLs use 'pw' prefix rather than 'lib'
+      library_names_spec='`echo $libname | sed -e 's/^lib/pw/'``echo $release | $SED -e 's/[[.]]/-/g'`$versuffix$shared_ext'
+      ;;
+    esac
+    dynamic_linker='Win32 ld.exe'
+    ;;
+
+  *,cl*)
+    # Native MSVC
+    libname_spec='$name'
+    soname_spec='$libname`echo $release | $SED -e 's/[[.]]/-/g'`$versuffix$shared_ext'
+    library_names_spec='$libname.dll.lib'
+
+    case $build_os in
+    mingw*)
+      sys_lib_search_path_spec=
+      lt_save_ifs=$IFS
+      IFS=';'
+      for lt_path in $LIB
+      do
+        IFS=$lt_save_ifs
+        # Let DOS variable expansion print the short 8.3 style file name.
+        lt_path=`cd "$lt_path" 2>/dev/null && cmd //C "for %i in (".") do @echo %~si"`
+        sys_lib_search_path_spec="$sys_lib_search_path_spec $lt_path"
+      done
+      IFS=$lt_save_ifs
+      # Convert to MSYS style.
+      sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | sed -e 's|\\\\|/|g' -e 's| \\([[a-zA-Z]]\\):| /\\1|g' -e 's|^ ||'`
+      ;;
+    cygwin*)
+      # Convert to unix form, then to dos form, then back to unix form
+      # but this time dos style (no spaces!) so that the unix form looks
+      # like /cygdrive/c/PROGRA~1:/cygdr...
+      sys_lib_search_path_spec=`cygpath --path --unix "$LIB"`
+      sys_lib_search_path_spec=`cygpath --path --dos "$sys_lib_search_path_spec" 2>/dev/null`
+      sys_lib_search_path_spec=`cygpath --path --unix "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"`
+      ;;
+    *)
+      sys_lib_search_path_spec=$LIB
+      if $ECHO "$sys_lib_search_path_spec" | [$GREP ';[c-zC-Z]:/' >/dev/null]; then
+        # It is most probably a Windows format PATH.
+        sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'`
+      else
+        sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"`
+      fi
+      # FIXME: find the short name or the path components, as spaces are
+      # common. (e.g. "Program Files" -> "PROGRA~1")
+      ;;
+    esac
+
+    # DLL is installed to $(libdir)/../bin by postinstall_cmds
+    postinstall_cmds='base_file=`basename \$file`~
+      dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~
+      dldir=$destdir/`dirname \$dlpath`~
+      test -d \$dldir || mkdir -p \$dldir~
+      $install_prog $dir/$dlname \$dldir/$dlname'
+    postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~
+      dlpath=$dir/\$dldll~
+       $RM \$dlpath'
+    shlibpath_overrides_runpath=yes
+    dynamic_linker='Win32 link.exe'
+    ;;
+
+  *)
+    # Assume MSVC wrapper
+    library_names_spec='$libname`echo $release | $SED -e 's/[[.]]/-/g'`$versuffix$shared_ext $libname.lib'
+    dynamic_linker='Win32 ld.exe'
+    ;;
+  esac
+  # FIXME: first we should search . and the directory the executable is in
+  shlibpath_var=PATH
+  ;;
+
+darwin* | rhapsody*)
+  dynamic_linker="$host_os dyld"
+  version_type=darwin
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$major$shared_ext $libname$shared_ext'
+  soname_spec='$libname$release$major$shared_ext'
+  shlibpath_overrides_runpath=yes
+  shlibpath_var=DYLD_LIBRARY_PATH
+  shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`'
+m4_if([$1], [],[
+  sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/local/lib"])
+  sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib'
+  ;;
+
+dgux*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  ;;
+
+freebsd* | dragonfly*)
+  # DragonFly does not have aout.  When/if they implement a new
+  # versioning mechanism, adjust this.
+  if test -x /usr/bin/objformat; then
+    objformat=`/usr/bin/objformat`
+  else
+    case $host_os in
+    freebsd[[23]].*) objformat=aout ;;
+    *) objformat=elf ;;
+    esac
+  fi
+  version_type=freebsd-$objformat
+  case $version_type in
+    freebsd-elf*)
+      library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+      soname_spec='$libname$release$shared_ext$major'
+      need_version=no
+      need_lib_prefix=no
+      ;;
+    freebsd-*)
+      library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix'
+      need_version=yes
+      ;;
+  esac
+  shlibpath_var=LD_LIBRARY_PATH
+  case $host_os in
+  freebsd2.*)
+    shlibpath_overrides_runpath=yes
+    ;;
+  freebsd3.[[01]]* | freebsdelf3.[[01]]*)
+    shlibpath_overrides_runpath=yes
+    hardcode_into_libs=yes
+    ;;
+  freebsd3.[[2-9]]* | freebsdelf3.[[2-9]]* | \
+  freebsd4.[[0-5]] | freebsdelf4.[[0-5]] | freebsd4.1.1 | freebsdelf4.1.1)
+    shlibpath_overrides_runpath=no
+    hardcode_into_libs=yes
+    ;;
+  *) # from 4.6 on, and DragonFly
+    shlibpath_overrides_runpath=yes
+    hardcode_into_libs=yes
+    ;;
+  esac
+  ;;
+
+haiku*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_lib_prefix=no
+  need_version=no
+  dynamic_linker="$host_os runtime_loader"
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  shlibpath_var=LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/system/lib'
+  hardcode_into_libs=yes
+  ;;
+
+hpux9* | hpux10* | hpux11*)
+  # Give a soname corresponding to the major version so that dld.sl refuses to
+  # link against other versions.
+  version_type=sunos
+  need_lib_prefix=no
+  need_version=no
+  case $host_cpu in
+  ia64*)
+    shrext_cmds='.so'
+    hardcode_into_libs=yes
+    dynamic_linker="$host_os dld.so"
+    shlibpath_var=LD_LIBRARY_PATH
+    shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
+    library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+    soname_spec='$libname$release$shared_ext$major'
+    if test 32 = "$HPUX_IA64_MODE"; then
+      sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib"
+      sys_lib_dlsearch_path_spec=/usr/lib/hpux32
+    else
+      sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64"
+      sys_lib_dlsearch_path_spec=/usr/lib/hpux64
+    fi
+    ;;
+  hppa*64*)
+    shrext_cmds='.sl'
+    hardcode_into_libs=yes
+    dynamic_linker="$host_os dld.sl"
+    shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH
+    shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
+    library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+    soname_spec='$libname$release$shared_ext$major'
+    sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64"
+    sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
+    ;;
+  *)
+    shrext_cmds='.sl'
+    dynamic_linker="$host_os dld.sl"
+    shlibpath_var=SHLIB_PATH
+    shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH
+    library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+    soname_spec='$libname$release$shared_ext$major'
+    ;;
+  esac
+  # HP-UX runs *really* slowly unless shared libraries are mode 555, ...
+  postinstall_cmds='chmod 555 $lib'
+  # or fails outright, so override atomically:
+  install_override_mode=555
+  ;;
+
+interix[[3-9]]*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  hardcode_into_libs=yes
+  ;;
+
+irix5* | irix6* | nonstopux*)
+  case $host_os in
+    nonstopux*) version_type=nonstopux ;;
+    *)
+	if test yes = "$lt_cv_prog_gnu_ld"; then
+		version_type=linux # correct to gnu/linux during the next big refactor
+	else
+		version_type=irix
+	fi ;;
+  esac
+  need_lib_prefix=no
+  need_version=no
+  soname_spec='$libname$release$shared_ext$major'
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$release$shared_ext $libname$shared_ext'
+  case $host_os in
+  irix5* | nonstopux*)
+    libsuff= shlibsuff=
+    ;;
+  *)
+    case $LD in # libtool.m4 will add one of these switches to LD
+    *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ")
+      libsuff= shlibsuff= libmagic=32-bit;;
+    *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ")
+      libsuff=32 shlibsuff=N32 libmagic=N32;;
+    *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ")
+      libsuff=64 shlibsuff=64 libmagic=64-bit;;
+    *) libsuff= shlibsuff= libmagic=never-match;;
+    esac
+    ;;
+  esac
+  shlibpath_var=LD_LIBRARY${shlibsuff}_PATH
+  shlibpath_overrides_runpath=no
+  sys_lib_search_path_spec="/usr/lib$libsuff /lib$libsuff /usr/local/lib$libsuff"
+  sys_lib_dlsearch_path_spec="/usr/lib$libsuff /lib$libsuff"
+  hardcode_into_libs=yes
+  ;;
+
+# No shared lib support for Linux oldld, aout, or coff.
+linux*oldld* | linux*aout* | linux*coff*)
+  dynamic_linker=no
+  ;;
+
+linux*android*)
+  version_type=none # Android doesn't support versioned libraries.
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext'
+  soname_spec='$libname$release$shared_ext'
+  finish_cmds=
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+
+  # This implies no fast_install, which is unacceptable.
+  # Some rework will be needed to allow for fast_install
+  # before this can be enabled.
+  hardcode_into_libs=yes
+
+  dynamic_linker='Android linker'
+  # Don't embed -rpath directories since the linker doesn't support them.
+  _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
+  ;;
+
+# This must be glibc/ELF.
+linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+
+  # Some binutils ld are patched to set DT_RUNPATH
+  AC_CACHE_VAL([lt_cv_shlibpath_overrides_runpath],
+    [lt_cv_shlibpath_overrides_runpath=no
+    save_LDFLAGS=$LDFLAGS
+    save_libdir=$libdir
+    eval "libdir=/foo; wl=\"$_LT_TAGVAR(lt_prog_compiler_wl, $1)\"; \
+	 LDFLAGS=\"\$LDFLAGS $_LT_TAGVAR(hardcode_libdir_flag_spec, $1)\""
+    AC_LINK_IFELSE([AC_LANG_PROGRAM([],[])],
+      [AS_IF([ ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null],
+	 [lt_cv_shlibpath_overrides_runpath=yes])])
+    LDFLAGS=$save_LDFLAGS
+    libdir=$save_libdir
+    ])
+  shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath
+
+  # This implies no fast_install, which is unacceptable.
+  # Some rework will be needed to allow for fast_install
+  # before this can be enabled.
+  hardcode_into_libs=yes
+
+  # Ideally, we could use ldconfig to report *all* directories which are
+  # searched for libraries, however this is still not possible.  Aside from not
+  # being certain /sbin/ldconfig is available, command
+  # 'ldconfig -N -X -v | grep ^/' on 64bit Fedora does not report /usr/lib64,
+  # even though it is searched at run-time.  Try to do the best guess by
+  # appending ld.so.conf contents (and includes) to the search path.
+  if test -f /etc/ld.so.conf; then
+    lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \[$]2)); skip = 1; } { if (!skip) print \[$]0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[	 ]*hwcap[	 ]/d;s/[:,	]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '`
+    sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra"
+  fi
+
+  # We used to test for /lib/ld.so.1 and disable shared libraries on
+  # powerpc, because MkLinux only supported shared libraries with the
+  # GNU dynamic linker.  Since this was broken with cross compilers,
+  # most powerpc-linux boxes support dynamic linking these days and
+  # people can always --disable-shared, the test was removed, and we
+  # assume the GNU/Linux dynamic linker is in use.
+  dynamic_linker='GNU/Linux ld.so'
+  ;;
+
+netbsdelf*-gnu)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  hardcode_into_libs=yes
+  dynamic_linker='NetBSD ld.elf_so'
+  ;;
+
+netbsd*)
+  version_type=sunos
+  need_lib_prefix=no
+  need_version=no
+  if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
+    library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix'
+    finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+    dynamic_linker='NetBSD (a.out) ld.so'
+  else
+    library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+    soname_spec='$libname$release$shared_ext$major'
+    dynamic_linker='NetBSD ld.elf_so'
+  fi
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  hardcode_into_libs=yes
+  ;;
+
+newsos6)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  ;;
+
+*nto* | *qnx*)
+  version_type=qnx
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  hardcode_into_libs=yes
+  dynamic_linker='ldqnx.so'
+  ;;
+
+openbsd* | bitrig*)
+  version_type=sunos
+  sys_lib_dlsearch_path_spec=/usr/lib
+  need_lib_prefix=no
+  if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then
+    need_version=no
+  else
+    need_version=yes
+  fi
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix'
+  finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  ;;
+
+os2*)
+  libname_spec='$name'
+  version_type=windows
+  shrext_cmds=.dll
+  need_version=no
+  need_lib_prefix=no
+  # OS/2 can only load a DLL with a base name of 8 characters or less.
+  soname_spec='`test -n "$os2dllname" && libname="$os2dllname";
+    v=$($ECHO $release$versuffix | tr -d .-);
+    n=$($ECHO $libname | cut -b -$((8 - ${#v})) | tr . _);
+    $ECHO $n$v`$shared_ext'
+  library_names_spec='${libname}_dll.$libext'
+  dynamic_linker='OS/2 ld.exe'
+  shlibpath_var=BEGINLIBPATH
+  sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib"
+  sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
+  postinstall_cmds='base_file=`basename \$file`~
+    dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; $ECHO \$dlname'\''`~
+    dldir=$destdir/`dirname \$dlpath`~
+    test -d \$dldir || mkdir -p \$dldir~
+    $install_prog $dir/$dlname \$dldir/$dlname~
+    chmod a+x \$dldir/$dlname~
+    if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then
+      eval '\''$striplib \$dldir/$dlname'\'' || exit \$?;
+    fi'
+  postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; $ECHO \$dlname'\''`~
+    dlpath=$dir/\$dldll~
+    $RM \$dlpath'
+  ;;
+
+osf3* | osf4* | osf5*)
+  version_type=osf
+  need_lib_prefix=no
+  need_version=no
+  soname_spec='$libname$release$shared_ext$major'
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  shlibpath_var=LD_LIBRARY_PATH
+  sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib"
+  sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
+  ;;
+
+rdos*)
+  dynamic_linker=no
+  ;;
+
+solaris*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  hardcode_into_libs=yes
+  # ldd complains unless libraries are executable
+  postinstall_cmds='chmod +x $lib'
+  ;;
+
+sunos4*)
+  version_type=sunos
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix'
+  finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  if test yes = "$with_gnu_ld"; then
+    need_lib_prefix=no
+  fi
+  need_version=yes
+  ;;
+
+sysv4 | sysv4.3*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  case $host_vendor in
+    sni)
+      shlibpath_overrides_runpath=no
+      need_lib_prefix=no
+      runpath_var=LD_RUN_PATH
+      ;;
+    siemens)
+      need_lib_prefix=no
+      ;;
+    motorola)
+      need_lib_prefix=no
+      need_version=no
+      shlibpath_overrides_runpath=no
+      sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib'
+      ;;
+  esac
+  ;;
+
+sysv4*MP*)
+  if test -d /usr/nec; then
+    version_type=linux # correct to gnu/linux during the next big refactor
+    library_names_spec='$libname$shared_ext.$versuffix $libname$shared_ext.$major $libname$shared_ext'
+    soname_spec='$libname$shared_ext.$major'
+    shlibpath_var=LD_LIBRARY_PATH
+  fi
+  ;;
+
+sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
+  version_type=sco
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  hardcode_into_libs=yes
+  if test yes = "$with_gnu_ld"; then
+    sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib'
+  else
+    sys_lib_search_path_spec='/usr/ccs/lib /usr/lib'
+    case $host_os in
+      sco3.2v5*)
+        sys_lib_search_path_spec="$sys_lib_search_path_spec /lib"
+	;;
+    esac
+  fi
+  sys_lib_dlsearch_path_spec='/usr/lib'
+  ;;
+
+tpf*)
+  # TPF is a cross-target only.  Preferred cross-host = GNU/Linux.
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  hardcode_into_libs=yes
+  ;;
+
+uts4*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  ;;
+
+*)
+  dynamic_linker=no
+  ;;
+esac
+AC_MSG_RESULT([$dynamic_linker])
+test no = "$dynamic_linker" && can_build_shared=no
+
+variables_saved_for_relink="PATH $shlibpath_var $runpath_var"
+if test yes = "$GCC"; then
+  variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH"
+fi
+
+if test set = "${lt_cv_sys_lib_search_path_spec+set}"; then
+  sys_lib_search_path_spec=$lt_cv_sys_lib_search_path_spec
+fi
+
+if test set = "${lt_cv_sys_lib_dlsearch_path_spec+set}"; then
+  sys_lib_dlsearch_path_spec=$lt_cv_sys_lib_dlsearch_path_spec
+fi
+
+# remember unaugmented sys_lib_dlsearch_path content for libtool script decls...
+configure_time_dlsearch_path=$sys_lib_dlsearch_path_spec
+
+# ... but it needs LT_SYS_LIBRARY_PATH munging for other configure-time code
+func_munge_path_list sys_lib_dlsearch_path_spec "$LT_SYS_LIBRARY_PATH"
+
+# to be used as default LT_SYS_LIBRARY_PATH value in generated libtool
+configure_time_lt_sys_library_path=$LT_SYS_LIBRARY_PATH
+
+_LT_DECL([], [variables_saved_for_relink], [1],
+    [Variables whose values should be saved in libtool wrapper scripts and
+    restored at link time])
+_LT_DECL([], [need_lib_prefix], [0],
+    [Do we need the "lib" prefix for modules?])
+_LT_DECL([], [need_version], [0], [Do we need a version for libraries?])
+_LT_DECL([], [version_type], [0], [Library versioning type])
+_LT_DECL([], [runpath_var], [0],  [Shared library runtime path variable])
+_LT_DECL([], [shlibpath_var], [0],[Shared library path variable])
+_LT_DECL([], [shlibpath_overrides_runpath], [0],
+    [Is shlibpath searched before the hard-coded library search path?])
+_LT_DECL([], [libname_spec], [1], [Format of library name prefix])
+_LT_DECL([], [library_names_spec], [1],
+    [[List of archive names.  First name is the real one, the rest are links.
+    The last name is the one that the linker finds with -lNAME]])
+_LT_DECL([], [soname_spec], [1],
+    [[The coded name of the library, if different from the real name]])
+_LT_DECL([], [install_override_mode], [1],
+    [Permission mode override for installation of shared libraries])
+_LT_DECL([], [postinstall_cmds], [2],
+    [Command to use after installation of a shared archive])
+_LT_DECL([], [postuninstall_cmds], [2],
+    [Command to use after uninstallation of a shared archive])
+_LT_DECL([], [finish_cmds], [2],
+    [Commands used to finish a libtool library installation in a directory])
+_LT_DECL([], [finish_eval], [1],
+    [[As "finish_cmds", except a single script fragment to be evaled but
+    not shown]])
+_LT_DECL([], [hardcode_into_libs], [0],
+    [Whether we should hardcode library paths into libraries])
+_LT_DECL([], [sys_lib_search_path_spec], [2],
+    [Compile-time system search path for libraries])
+_LT_DECL([sys_lib_dlsearch_path_spec], [configure_time_dlsearch_path], [2],
+    [Detected run-time system search path for libraries])
+_LT_DECL([], [configure_time_lt_sys_library_path], [2],
+    [Explicit LT_SYS_LIBRARY_PATH set during ./configure time])
+])# _LT_SYS_DYNAMIC_LINKER
+
+
+# _LT_PATH_TOOL_PREFIX(TOOL)
+# --------------------------
+# find a file program that can recognize shared library
+AC_DEFUN([_LT_PATH_TOOL_PREFIX],
+[m4_require([_LT_DECL_EGREP])dnl
+AC_MSG_CHECKING([for $1])
+AC_CACHE_VAL(lt_cv_path_MAGIC_CMD,
+[case $MAGIC_CMD in
+[[\\/*] |  ?:[\\/]*])
+  lt_cv_path_MAGIC_CMD=$MAGIC_CMD # Let the user override the test with a path.
+  ;;
+*)
+  lt_save_MAGIC_CMD=$MAGIC_CMD
+  lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR
+dnl $ac_dummy forces splitting on constant user-supplied paths.
+dnl POSIX.2 word splitting is done only on the output of word expansions,
+dnl not every word.  This closes a longstanding sh security hole.
+  ac_dummy="m4_if([$2], , $PATH, [$2])"
+  for ac_dir in $ac_dummy; do
+    IFS=$lt_save_ifs
+    test -z "$ac_dir" && ac_dir=.
+    if test -f "$ac_dir/$1"; then
+      lt_cv_path_MAGIC_CMD=$ac_dir/"$1"
+      if test -n "$file_magic_test_file"; then
+	case $deplibs_check_method in
+	"file_magic "*)
+	  file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"`
+	  MAGIC_CMD=$lt_cv_path_MAGIC_CMD
+	  if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
+	    $EGREP "$file_magic_regex" > /dev/null; then
+	    :
+	  else
+	    cat <<_LT_EOF 1>&2
+
+*** Warning: the command libtool uses to detect shared libraries,
+*** $file_magic_cmd, produces output that libtool cannot recognize.
+*** The result is that libtool may fail to recognize shared libraries
+*** as such.  This will affect the creation of libtool libraries that
+*** depend on shared libraries, but programs linked with such libtool
+*** libraries will work regardless of this problem.  Nevertheless, you
+*** may want to report the problem to your system manager and/or to
+*** bug-libtool@gnu.org
+
+_LT_EOF
+	  fi ;;
+	esac
+      fi
+      break
+    fi
+  done
+  IFS=$lt_save_ifs
+  MAGIC_CMD=$lt_save_MAGIC_CMD
+  ;;
+esac])
+MAGIC_CMD=$lt_cv_path_MAGIC_CMD
+if test -n "$MAGIC_CMD"; then
+  AC_MSG_RESULT($MAGIC_CMD)
+else
+  AC_MSG_RESULT(no)
+fi
+_LT_DECL([], [MAGIC_CMD], [0],
+	 [Used to examine libraries when file_magic_cmd begins with "file"])dnl
+])# _LT_PATH_TOOL_PREFIX
+
+# Old name:
+AU_ALIAS([AC_PATH_TOOL_PREFIX], [_LT_PATH_TOOL_PREFIX])
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([AC_PATH_TOOL_PREFIX], [])
+
+
+# _LT_PATH_MAGIC
+# --------------
+# find a file program that can recognize a shared library
+m4_defun([_LT_PATH_MAGIC],
+[_LT_PATH_TOOL_PREFIX(${ac_tool_prefix}file, /usr/bin$PATH_SEPARATOR$PATH)
+if test -z "$lt_cv_path_MAGIC_CMD"; then
+  if test -n "$ac_tool_prefix"; then
+    _LT_PATH_TOOL_PREFIX(file, /usr/bin$PATH_SEPARATOR$PATH)
+  else
+    MAGIC_CMD=:
+  fi
+fi
+])# _LT_PATH_MAGIC
+
+
+# LT_PATH_LD
+# ----------
+# find the pathname to the GNU or non-GNU linker
+AC_DEFUN([LT_PATH_LD],
+[AC_REQUIRE([AC_PROG_CC])dnl
+AC_REQUIRE([AC_CANONICAL_HOST])dnl
+AC_REQUIRE([AC_CANONICAL_BUILD])dnl
+m4_require([_LT_DECL_SED])dnl
+m4_require([_LT_DECL_EGREP])dnl
+m4_require([_LT_PROG_ECHO_BACKSLASH])dnl
+
+AC_ARG_WITH([gnu-ld],
+    [AS_HELP_STRING([--with-gnu-ld],
+	[assume the C compiler uses GNU ld @<:@default=no@:>@])],
+    [test no = "$withval" || with_gnu_ld=yes],
+    [with_gnu_ld=no])dnl
+
+ac_prog=ld
+if test yes = "$GCC"; then
+  # Check if gcc -print-prog-name=ld gives a path.
+  AC_MSG_CHECKING([for ld used by $CC])
+  case $host in
+  *-*-mingw*)
+    # gcc leaves a trailing carriage return, which upsets mingw
+    ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
+  *)
+    ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
+  esac
+  case $ac_prog in
+    # Accept absolute paths.
+    [[\\/]]* | ?:[[\\/]]*)
+      re_direlt='/[[^/]][[^/]]*/\.\./'
+      # Canonicalize the pathname of ld
+      ac_prog=`$ECHO "$ac_prog"| $SED 's%\\\\%/%g'`
+      while $ECHO "$ac_prog" | $GREP "$re_direlt" > /dev/null 2>&1; do
+	ac_prog=`$ECHO $ac_prog| $SED "s%$re_direlt%/%"`
+      done
+      test -z "$LD" && LD=$ac_prog
+      ;;
+  "")
+    # If it fails, then pretend we aren't using GCC.
+    ac_prog=ld
+    ;;
+  *)
+    # If it is relative, then search for the first ld in PATH.
+    with_gnu_ld=unknown
+    ;;
+  esac
+elif test yes = "$with_gnu_ld"; then
+  AC_MSG_CHECKING([for GNU ld])
+else
+  AC_MSG_CHECKING([for non-GNU ld])
+fi
+AC_CACHE_VAL(lt_cv_path_LD,
+[if test -z "$LD"; then
+  lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR
+  for ac_dir in $PATH; do
+    IFS=$lt_save_ifs
+    test -z "$ac_dir" && ac_dir=.
+    if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
+      lt_cv_path_LD=$ac_dir/$ac_prog
+      # Check to see if the program is GNU ld.  I'd rather use --version,
+      # but apparently some variants of GNU ld only accept -v.
+      # Break only if it was the GNU/non-GNU ld that we prefer.
+      case `"$lt_cv_path_LD" -v 2>&1 &1 conftest.i
+cat conftest.i conftest.i >conftest2.i
+: ${lt_DD:=$DD}
+AC_PATH_PROGS_FEATURE_CHECK([lt_DD], [dd],
+[if "$ac_path_lt_DD" bs=32 count=1 conftest.out 2>/dev/null; then
+  cmp -s conftest.i conftest.out \
+  && ac_cv_path_lt_DD="$ac_path_lt_DD" ac_path_lt_DD_found=:
+fi])
+rm -f conftest.i conftest2.i conftest.out])
+])# _LT_PATH_DD
+
+
+# _LT_CMD_TRUNCATE
+# ----------------
+# find command to truncate a binary pipe
+m4_defun([_LT_CMD_TRUNCATE],
+[m4_require([_LT_PATH_DD])
+AC_CACHE_CHECK([how to truncate binary pipes], [lt_cv_truncate_bin],
+[printf 0123456789abcdef0123456789abcdef >conftest.i
+cat conftest.i conftest.i >conftest2.i
+lt_cv_truncate_bin=
+if "$ac_cv_path_lt_DD" bs=32 count=1 conftest.out 2>/dev/null; then
+  cmp -s conftest.i conftest.out \
+  && lt_cv_truncate_bin="$ac_cv_path_lt_DD bs=4096 count=1"
+fi
+rm -f conftest.i conftest2.i conftest.out
+test -z "$lt_cv_truncate_bin" && lt_cv_truncate_bin="$SED -e 4q"])
+_LT_DECL([lt_truncate_bin], [lt_cv_truncate_bin], [1],
+  [Command to truncate a binary pipe])
+])# _LT_CMD_TRUNCATE
+
+
+# _LT_CHECK_MAGIC_METHOD
+# ----------------------
+# how to check for library dependencies
+#  -- PORTME fill in with the dynamic library characteristics
+m4_defun([_LT_CHECK_MAGIC_METHOD],
+[m4_require([_LT_DECL_EGREP])
+m4_require([_LT_DECL_OBJDUMP])
+AC_CACHE_CHECK([how to recognize dependent libraries],
+lt_cv_deplibs_check_method,
+[lt_cv_file_magic_cmd='$MAGIC_CMD'
+lt_cv_file_magic_test_file=
+lt_cv_deplibs_check_method='unknown'
+# Need to set the preceding variable on all platforms that support
+# interlibrary dependencies.
+# 'none' -- dependencies not supported.
+# 'unknown' -- same as none, but documents that we really don't know.
+# 'pass_all' -- all dependencies passed with no checks.
+# 'test_compile' -- check by making test program.
+# 'file_magic [[regex]]' -- check by looking for files in library path
+# that responds to the $file_magic_cmd with a given extended regex.
+# If you have 'file' or equivalent on your system and you're not sure
+# whether 'pass_all' will *always* work, you probably want this one.
+
+case $host_os in
+aix[[4-9]]*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+beos*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+bsdi[[45]]*)
+  lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (shared object|dynamic lib)'
+  lt_cv_file_magic_cmd='/usr/bin/file -L'
+  lt_cv_file_magic_test_file=/shlib/libc.so
+  ;;
+
+cygwin*)
+  # func_win32_libid is a shell function defined in ltmain.sh
+  lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL'
+  lt_cv_file_magic_cmd='func_win32_libid'
+  ;;
+
+mingw* | pw32*)
+  # Base MSYS/MinGW do not provide the 'file' command needed by
+  # func_win32_libid shell function, so use a weaker test based on 'objdump',
+  # unless we find 'file', for example because we are cross-compiling.
+  if ( file / ) >/dev/null 2>&1; then
+    lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL'
+    lt_cv_file_magic_cmd='func_win32_libid'
+  else
+    # Keep this pattern in sync with the one in func_win32_libid.
+    lt_cv_deplibs_check_method='file_magic file format (pei*-i386(.*architecture: i386)?|pe-arm-wince|pe-x86-64)'
+    lt_cv_file_magic_cmd='$OBJDUMP -f'
+  fi
+  ;;
+
+cegcc*)
+  # use the weaker test based on 'objdump'. See mingw*.
+  lt_cv_deplibs_check_method='file_magic file format pe-arm-.*little(.*architecture: arm)?'
+  lt_cv_file_magic_cmd='$OBJDUMP -f'
+  ;;
+
+darwin* | rhapsody*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+freebsd* | dragonfly*)
+  if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then
+    case $host_cpu in
+    i*86 )
+      # Not sure whether the presence of OpenBSD here was a mistake.
+      # Let's accept both of them until this is cleared up.
+      lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD|DragonFly)/i[[3-9]]86 (compact )?demand paged shared library'
+      lt_cv_file_magic_cmd=/usr/bin/file
+      lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*`
+      ;;
+    esac
+  else
+    lt_cv_deplibs_check_method=pass_all
+  fi
+  ;;
+
+haiku*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+hpux10.20* | hpux11*)
+  lt_cv_file_magic_cmd=/usr/bin/file
+  case $host_cpu in
+  ia64*)
+    lt_cv_deplibs_check_method='file_magic (s[[0-9]][[0-9]][[0-9]]|ELF-[[0-9]][[0-9]]) shared object file - IA64'
+    lt_cv_file_magic_test_file=/usr/lib/hpux32/libc.so
+    ;;
+  hppa*64*)
+    [lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF[ -][0-9][0-9])(-bit)?( [LM]SB)? shared object( file)?[, -]* PA-RISC [0-9]\.[0-9]']
+    lt_cv_file_magic_test_file=/usr/lib/pa20_64/libc.sl
+    ;;
+  *)
+    lt_cv_deplibs_check_method='file_magic (s[[0-9]][[0-9]][[0-9]]|PA-RISC[[0-9]]\.[[0-9]]) shared library'
+    lt_cv_file_magic_test_file=/usr/lib/libc.sl
+    ;;
+  esac
+  ;;
+
+interix[[3-9]]*)
+  # PIC code is broken on Interix 3.x, that's why |\.a not |_pic\.a here
+  lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so|\.a)$'
+  ;;
+
+irix5* | irix6* | nonstopux*)
+  case $LD in
+  *-32|*"-32 ") libmagic=32-bit;;
+  *-n32|*"-n32 ") libmagic=N32;;
+  *-64|*"-64 ") libmagic=64-bit;;
+  *) libmagic=never-match;;
+  esac
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+# This must be glibc/ELF.
+linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+netbsd* | netbsdelf*-gnu)
+  if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then
+    lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so\.[[0-9]]+\.[[0-9]]+|_pic\.a)$'
+  else
+    lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so|_pic\.a)$'
+  fi
+  ;;
+
+newos6*)
+  lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (executable|dynamic lib)'
+  lt_cv_file_magic_cmd=/usr/bin/file
+  lt_cv_file_magic_test_file=/usr/lib/libnls.so
+  ;;
+
+*nto* | *qnx*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+openbsd* | bitrig*)
+  if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then
+    lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so\.[[0-9]]+\.[[0-9]]+|\.so|_pic\.a)$'
+  else
+    lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so\.[[0-9]]+\.[[0-9]]+|_pic\.a)$'
+  fi
+  ;;
+
+osf3* | osf4* | osf5*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+rdos*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+solaris*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+sysv4 | sysv4.3*)
+  case $host_vendor in
+  motorola)
+    lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (shared object|dynamic lib) M[[0-9]][[0-9]]* Version [[0-9]]'
+    lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*`
+    ;;
+  ncr)
+    lt_cv_deplibs_check_method=pass_all
+    ;;
+  sequent)
+    lt_cv_file_magic_cmd='/bin/file'
+    lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB (shared object|dynamic lib )'
+    ;;
+  sni)
+    lt_cv_file_magic_cmd='/bin/file'
+    lt_cv_deplibs_check_method="file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB dynamic lib"
+    lt_cv_file_magic_test_file=/lib/libc.so
+    ;;
+  siemens)
+    lt_cv_deplibs_check_method=pass_all
+    ;;
+  pc)
+    lt_cv_deplibs_check_method=pass_all
+    ;;
+  esac
+  ;;
+
+tpf*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+os2*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+esac
+])
+
+file_magic_glob=
+want_nocaseglob=no
+if test "$build" = "$host"; then
+  case $host_os in
+  mingw* | pw32*)
+    if ( shopt | grep nocaseglob ) >/dev/null 2>&1; then
+      want_nocaseglob=yes
+    else
+      file_magic_glob=`echo aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ | $SED -e "s/\(..\)/s\/[[\1]]\/[[\1]]\/g;/g"`
+    fi
+    ;;
+  esac
+fi
+
+file_magic_cmd=$lt_cv_file_magic_cmd
+deplibs_check_method=$lt_cv_deplibs_check_method
+test -z "$deplibs_check_method" && deplibs_check_method=unknown
+
+_LT_DECL([], [deplibs_check_method], [1],
+    [Method to check whether dependent libraries are shared objects])
+_LT_DECL([], [file_magic_cmd], [1],
+    [Command to use when deplibs_check_method = "file_magic"])
+_LT_DECL([], [file_magic_glob], [1],
+    [How to find potential files when deplibs_check_method = "file_magic"])
+_LT_DECL([], [want_nocaseglob], [1],
+    [Find potential files using nocaseglob when deplibs_check_method = "file_magic"])
+])# _LT_CHECK_MAGIC_METHOD
+
+
+# LT_PATH_NM
+# ----------
+# find the pathname to a BSD- or MS-compatible name lister
+AC_DEFUN([LT_PATH_NM],
+[AC_REQUIRE([AC_PROG_CC])dnl
+AC_CACHE_CHECK([for BSD- or MS-compatible name lister (nm)], lt_cv_path_NM,
+[if test -n "$NM"; then
+  # Let the user override the test.
+  lt_cv_path_NM=$NM
+else
+  lt_nm_to_check=${ac_tool_prefix}nm
+  if test -n "$ac_tool_prefix" && test "$build" = "$host"; then
+    lt_nm_to_check="$lt_nm_to_check nm"
+  fi
+  for lt_tmp_nm in $lt_nm_to_check; do
+    lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR
+    for ac_dir in $PATH /usr/ccs/bin/elf /usr/ccs/bin /usr/ucb /bin; do
+      IFS=$lt_save_ifs
+      test -z "$ac_dir" && ac_dir=.
+      tmp_nm=$ac_dir/$lt_tmp_nm
+      if test -f "$tmp_nm" || test -f "$tmp_nm$ac_exeext"; then
+	# Check to see if the nm accepts a BSD-compat flag.
+	# Adding the 'sed 1q' prevents false positives on HP-UX, which says:
+	#   nm: unknown option "B" ignored
+	# Tru64's nm complains that /dev/null is an invalid object file
+	# MSYS converts /dev/null to NUL, MinGW nm treats NUL as empty
+	case $build_os in
+	mingw*) lt_bad_file=conftest.nm/nofile ;;
+	*) lt_bad_file=/dev/null ;;
+	esac
+	case `"$tmp_nm" -B $lt_bad_file 2>&1 | sed '1q'` in
+	*$lt_bad_file* | *'Invalid file or object type'*)
+	  lt_cv_path_NM="$tmp_nm -B"
+	  break 2
+	  ;;
+	*)
+	  case `"$tmp_nm" -p /dev/null 2>&1 | sed '1q'` in
+	  */dev/null*)
+	    lt_cv_path_NM="$tmp_nm -p"
+	    break 2
+	    ;;
+	  *)
+	    lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but
+	    continue # so that we can try to find one that supports BSD flags
+	    ;;
+	  esac
+	  ;;
+	esac
+      fi
+    done
+    IFS=$lt_save_ifs
+  done
+  : ${lt_cv_path_NM=no}
+fi])
+if test no != "$lt_cv_path_NM"; then
+  NM=$lt_cv_path_NM
+else
+  # Didn't find any BSD compatible name lister, look for dumpbin.
+  if test -n "$DUMPBIN"; then :
+    # Let the user override the test.
+  else
+    AC_CHECK_TOOLS(DUMPBIN, [dumpbin "link -dump"], :)
+    case `$DUMPBIN -symbols -headers /dev/null 2>&1 | sed '1q'` in
+    *COFF*)
+      DUMPBIN="$DUMPBIN -symbols -headers"
+      ;;
+    *)
+      DUMPBIN=:
+      ;;
+    esac
+  fi
+  AC_SUBST([DUMPBIN])
+  if test : != "$DUMPBIN"; then
+    NM=$DUMPBIN
+  fi
+fi
+test -z "$NM" && NM=nm
+AC_SUBST([NM])
+_LT_DECL([], [NM], [1], [A BSD- or MS-compatible name lister])dnl
+
+AC_CACHE_CHECK([the name lister ($NM) interface], [lt_cv_nm_interface],
+  [lt_cv_nm_interface="BSD nm"
+  echo "int some_variable = 0;" > conftest.$ac_ext
+  (eval echo "\"\$as_me:$LINENO: $ac_compile\"" >&AS_MESSAGE_LOG_FD)
+  (eval "$ac_compile" 2>conftest.err)
+  cat conftest.err >&AS_MESSAGE_LOG_FD
+  (eval echo "\"\$as_me:$LINENO: $NM \\\"conftest.$ac_objext\\\"\"" >&AS_MESSAGE_LOG_FD)
+  (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out)
+  cat conftest.err >&AS_MESSAGE_LOG_FD
+  (eval echo "\"\$as_me:$LINENO: output\"" >&AS_MESSAGE_LOG_FD)
+  cat conftest.out >&AS_MESSAGE_LOG_FD
+  if $GREP 'External.*some_variable' conftest.out > /dev/null; then
+    lt_cv_nm_interface="MS dumpbin"
+  fi
+  rm -f conftest*])
+])# LT_PATH_NM
+
+# Old names:
+AU_ALIAS([AM_PROG_NM], [LT_PATH_NM])
+AU_ALIAS([AC_PROG_NM], [LT_PATH_NM])
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([AM_PROG_NM], [])
+dnl AC_DEFUN([AC_PROG_NM], [])
+
+# _LT_CHECK_SHAREDLIB_FROM_LINKLIB
+# --------------------------------
+# how to determine the name of the shared library
+# associated with a specific link library.
+#  -- PORTME fill in with the dynamic library characteristics
+m4_defun([_LT_CHECK_SHAREDLIB_FROM_LINKLIB],
+[m4_require([_LT_DECL_EGREP])
+m4_require([_LT_DECL_OBJDUMP])
+m4_require([_LT_DECL_DLLTOOL])
+AC_CACHE_CHECK([how to associate runtime and link libraries],
+lt_cv_sharedlib_from_linklib_cmd,
+[lt_cv_sharedlib_from_linklib_cmd='unknown'
+
+case $host_os in
+cygwin* | mingw* | pw32* | cegcc*)
+  # two different shell functions defined in ltmain.sh;
+  # decide which one to use based on capabilities of $DLLTOOL
+  case `$DLLTOOL --help 2>&1` in
+  *--identify-strict*)
+    lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib
+    ;;
+  *)
+    lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib_fallback
+    ;;
+  esac
+  ;;
+*)
+  # fallback: assume linklib IS sharedlib
+  lt_cv_sharedlib_from_linklib_cmd=$ECHO
+  ;;
+esac
+])
+sharedlib_from_linklib_cmd=$lt_cv_sharedlib_from_linklib_cmd
+test -z "$sharedlib_from_linklib_cmd" && sharedlib_from_linklib_cmd=$ECHO
+
+_LT_DECL([], [sharedlib_from_linklib_cmd], [1],
+    [Command to associate shared and link libraries])
+])# _LT_CHECK_SHAREDLIB_FROM_LINKLIB
+
+
+# _LT_PATH_MANIFEST_TOOL
+# ----------------------
+# locate the manifest tool
+m4_defun([_LT_PATH_MANIFEST_TOOL],
+[AC_CHECK_TOOL(MANIFEST_TOOL, mt, :)
+test -z "$MANIFEST_TOOL" && MANIFEST_TOOL=mt
+AC_CACHE_CHECK([if $MANIFEST_TOOL is a manifest tool], [lt_cv_path_mainfest_tool],
+  [lt_cv_path_mainfest_tool=no
+  echo "$as_me:$LINENO: $MANIFEST_TOOL '-?'" >&AS_MESSAGE_LOG_FD
+  $MANIFEST_TOOL '-?' 2>conftest.err > conftest.out
+  cat conftest.err >&AS_MESSAGE_LOG_FD
+  if $GREP 'Manifest Tool' conftest.out > /dev/null; then
+    lt_cv_path_mainfest_tool=yes
+  fi
+  rm -f conftest*])
+if test yes != "$lt_cv_path_mainfest_tool"; then
+  MANIFEST_TOOL=:
+fi
+_LT_DECL([], [MANIFEST_TOOL], [1], [Manifest tool])dnl
+])# _LT_PATH_MANIFEST_TOOL
+
+
+# _LT_DLL_DEF_P([FILE])
+# ---------------------
+# True iff FILE is a Windows DLL '.def' file.
+# Keep in sync with func_dll_def_p in the libtool script
+AC_DEFUN([_LT_DLL_DEF_P],
+[dnl
+  test DEF = "`$SED -n dnl
+    -e '\''s/^[[	 ]]*//'\'' dnl Strip leading whitespace
+    -e '\''/^\(;.*\)*$/d'\'' dnl      Delete empty lines and comments
+    -e '\''s/^\(EXPORTS\|LIBRARY\)\([[	 ]].*\)*$/DEF/p'\'' dnl
+    -e q dnl                          Only consider the first "real" line
+    $1`" dnl
+])# _LT_DLL_DEF_P
+
+
+# LT_LIB_M
+# --------
+# check for math library
+AC_DEFUN([LT_LIB_M],
+[AC_REQUIRE([AC_CANONICAL_HOST])dnl
+LIBM=
+case $host in
+*-*-beos* | *-*-cegcc* | *-*-cygwin* | *-*-haiku* | *-*-pw32* | *-*-darwin*)
+  # These system don't have libm, or don't need it
+  ;;
+*-ncr-sysv4.3*)
+  AC_CHECK_LIB(mw, _mwvalidcheckl, LIBM=-lmw)
+  AC_CHECK_LIB(m, cos, LIBM="$LIBM -lm")
+  ;;
+*)
+  AC_CHECK_LIB(m, cos, LIBM=-lm)
+  ;;
+esac
+AC_SUBST([LIBM])
+])# LT_LIB_M
+
+# Old name:
+AU_ALIAS([AC_CHECK_LIBM], [LT_LIB_M])
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([AC_CHECK_LIBM], [])
+
+
+# _LT_COMPILER_NO_RTTI([TAGNAME])
+# -------------------------------
+m4_defun([_LT_COMPILER_NO_RTTI],
+[m4_require([_LT_TAG_COMPILER])dnl
+
+_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=
+
+if test yes = "$GCC"; then
+  case $cc_basename in
+  nvcc*)
+    _LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=' -Xcompiler -fno-builtin' ;;
+  *)
+    _LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=' -fno-builtin' ;;
+  esac
+
+  _LT_COMPILER_OPTION([if $compiler supports -fno-rtti -fno-exceptions],
+    lt_cv_prog_compiler_rtti_exceptions,
+    [-fno-rtti -fno-exceptions], [],
+    [_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)="$_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1) -fno-rtti -fno-exceptions"])
+fi
+_LT_TAGDECL([no_builtin_flag], [lt_prog_compiler_no_builtin_flag], [1],
+	[Compiler flag to turn off builtin functions])
+])# _LT_COMPILER_NO_RTTI
+
+
+# _LT_CMD_GLOBAL_SYMBOLS
+# ----------------------
+m4_defun([_LT_CMD_GLOBAL_SYMBOLS],
+[AC_REQUIRE([AC_CANONICAL_HOST])dnl
+AC_REQUIRE([AC_PROG_CC])dnl
+AC_REQUIRE([AC_PROG_AWK])dnl
+AC_REQUIRE([LT_PATH_NM])dnl
+AC_REQUIRE([LT_PATH_LD])dnl
+m4_require([_LT_DECL_SED])dnl
+m4_require([_LT_DECL_EGREP])dnl
+m4_require([_LT_TAG_COMPILER])dnl
+
+# Check for command to grab the raw symbol name followed by C symbol from nm.
+AC_MSG_CHECKING([command to parse $NM output from $compiler object])
+AC_CACHE_VAL([lt_cv_sys_global_symbol_pipe],
+[
+# These are sane defaults that work on at least a few old systems.
+# [They come from Ultrix.  What could be older than Ultrix?!! ;)]
+
+# Character class describing NM global symbol codes.
+symcode='[[BCDEGRST]]'
+
+# Regexp to match symbols that can be accessed directly from C.
+sympat='\([[_A-Za-z]][[_A-Za-z0-9]]*\)'
+
+# Define system-specific variables.
+case $host_os in
+aix*)
+  symcode='[[BCDT]]'
+  ;;
+cygwin* | mingw* | pw32* | cegcc*)
+  symcode='[[ABCDGISTW]]'
+  ;;
+hpux*)
+  if test ia64 = "$host_cpu"; then
+    symcode='[[ABCDEGRST]]'
+  fi
+  ;;
+irix* | nonstopux*)
+  symcode='[[BCDEGRST]]'
+  ;;
+osf*)
+  symcode='[[BCDEGQRST]]'
+  ;;
+solaris*)
+  symcode='[[BDRT]]'
+  ;;
+sco3.2v5*)
+  symcode='[[DT]]'
+  ;;
+sysv4.2uw2*)
+  symcode='[[DT]]'
+  ;;
+sysv5* | sco5v6* | unixware* | OpenUNIX*)
+  symcode='[[ABDT]]'
+  ;;
+sysv4)
+  symcode='[[DFNSTU]]'
+  ;;
+esac
+
+# If we're using GNU nm, then use its standard symbol codes.
+case `$NM -V 2>&1` in
+*GNU* | *'with BFD'*)
+  symcode='[[ABCDGIRSTW]]' ;;
+esac
+
+if test "$lt_cv_nm_interface" = "MS dumpbin"; then
+  # Gets list of data symbols to import.
+  lt_cv_sys_global_symbol_to_import="sed -n -e 's/^I .* \(.*\)$/\1/p'"
+  # Adjust the below global symbol transforms to fixup imported variables.
+  lt_cdecl_hook=" -e 's/^I .* \(.*\)$/extern __declspec(dllimport) char \1;/p'"
+  lt_c_name_hook=" -e 's/^I .* \(.*\)$/  {\"\1\", (void *) 0},/p'"
+  lt_c_name_lib_hook="\
+  -e 's/^I .* \(lib.*\)$/  {\"\1\", (void *) 0},/p'\
+  -e 's/^I .* \(.*\)$/  {\"lib\1\", (void *) 0},/p'"
+else
+  # Disable hooks by default.
+  lt_cv_sys_global_symbol_to_import=
+  lt_cdecl_hook=
+  lt_c_name_hook=
+  lt_c_name_lib_hook=
+fi
+
+# Transform an extracted symbol line into a proper C declaration.
+# Some systems (esp. on ia64) link data and code symbols differently,
+# so use this general approach.
+lt_cv_sys_global_symbol_to_cdecl="sed -n"\
+$lt_cdecl_hook\
+" -e 's/^T .* \(.*\)$/extern int \1();/p'"\
+" -e 's/^$symcode$symcode* .* \(.*\)$/extern char \1;/p'"
+
+# Transform an extracted symbol line into symbol name and symbol address
+lt_cv_sys_global_symbol_to_c_name_address="sed -n"\
+$lt_c_name_hook\
+" -e 's/^: \(.*\) .*$/  {\"\1\", (void *) 0},/p'"\
+" -e 's/^$symcode$symcode* .* \(.*\)$/  {\"\1\", (void *) \&\1},/p'"
+
+# Transform an extracted symbol line into symbol name with lib prefix and
+# symbol address.
+lt_cv_sys_global_symbol_to_c_name_address_lib_prefix="sed -n"\
+$lt_c_name_lib_hook\
+" -e 's/^: \(.*\) .*$/  {\"\1\", (void *) 0},/p'"\
+" -e 's/^$symcode$symcode* .* \(lib.*\)$/  {\"\1\", (void *) \&\1},/p'"\
+" -e 's/^$symcode$symcode* .* \(.*\)$/  {\"lib\1\", (void *) \&\1},/p'"
+
+# Handle CRLF in mingw tool chain
+opt_cr=
+case $build_os in
+mingw*)
+  opt_cr=`$ECHO 'x\{0,1\}' | tr x '\015'` # option cr in regexp
+  ;;
+esac
+
+# Try without a prefix underscore, then with it.
+for ac_symprfx in "" "_"; do
+
+  # Transform symcode, sympat, and symprfx into a raw symbol and a C symbol.
+  symxfrm="\\1 $ac_symprfx\\2 \\2"
+
+  # Write the raw and C identifiers.
+  if test "$lt_cv_nm_interface" = "MS dumpbin"; then
+    # Fake it for dumpbin and say T for any non-static function,
+    # D for any global variable and I for any imported variable.
+    # Also find C++ and __fastcall symbols from MSVC++,
+    # which start with @ or ?.
+    lt_cv_sys_global_symbol_pipe="$AWK ['"\
+"     {last_section=section; section=\$ 3};"\
+"     /^COFF SYMBOL TABLE/{for(i in hide) delete hide[i]};"\
+"     /Section length .*#relocs.*(pick any)/{hide[last_section]=1};"\
+"     /^ *Symbol name *: /{split(\$ 0,sn,\":\"); si=substr(sn[2],2)};"\
+"     /^ *Type *: code/{print \"T\",si,substr(si,length(prfx))};"\
+"     /^ *Type *: data/{print \"I\",si,substr(si,length(prfx))};"\
+"     \$ 0!~/External *\|/{next};"\
+"     / 0+ UNDEF /{next}; / UNDEF \([^|]\)*()/{next};"\
+"     {if(hide[section]) next};"\
+"     {f=\"D\"}; \$ 0~/\(\).*\|/{f=\"T\"};"\
+"     {split(\$ 0,a,/\||\r/); split(a[2],s)};"\
+"     s[1]~/^[@?]/{print f,s[1],s[1]; next};"\
+"     s[1]~prfx {split(s[1],t,\"@\"); print f,t[1],substr(t[1],length(prfx))}"\
+"     ' prfx=^$ac_symprfx]"
+  else
+    lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[[	 ]]\($symcode$symcode*\)[[	 ]][[	 ]]*$ac_symprfx$sympat$opt_cr$/$symxfrm/p'"
+  fi
+  lt_cv_sys_global_symbol_pipe="$lt_cv_sys_global_symbol_pipe | sed '/ __gnu_lto/d'"
+
+  # Check to see that the pipe works correctly.
+  pipe_works=no
+
+  rm -f conftest*
+  cat > conftest.$ac_ext <<_LT_EOF
+#ifdef __cplusplus
+extern "C" {
+#endif
+char nm_test_var;
+void nm_test_func(void);
+void nm_test_func(void){}
+#ifdef __cplusplus
+}
+#endif
+int main(){nm_test_var='a';nm_test_func();return(0);}
+_LT_EOF
+
+  if AC_TRY_EVAL(ac_compile); then
+    # Now try to grab the symbols.
+    nlist=conftest.nm
+    if AC_TRY_EVAL(NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist) && test -s "$nlist"; then
+      # Try sorting and uniquifying the output.
+      if sort "$nlist" | uniq > "$nlist"T; then
+	mv -f "$nlist"T "$nlist"
+      else
+	rm -f "$nlist"T
+      fi
+
+      # Make sure that we snagged all the symbols we need.
+      if $GREP ' nm_test_var$' "$nlist" >/dev/null; then
+	if $GREP ' nm_test_func$' "$nlist" >/dev/null; then
+	  cat <<_LT_EOF > conftest.$ac_ext
+/* Keep this code in sync between libtool.m4, ltmain, lt_system.h, and tests.  */
+#if defined _WIN32 || defined __CYGWIN__ || defined _WIN32_WCE
+/* DATA imports from DLLs on WIN32 can't be const, because runtime
+   relocations are performed -- see ld's documentation on pseudo-relocs.  */
+# define LT@&t@_DLSYM_CONST
+#elif defined __osf__
+/* This system does not cope well with relocations in const data.  */
+# define LT@&t@_DLSYM_CONST
+#else
+# define LT@&t@_DLSYM_CONST const
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+_LT_EOF
+	  # Now generate the symbol file.
+	  eval "$lt_cv_sys_global_symbol_to_cdecl"' < "$nlist" | $GREP -v main >> conftest.$ac_ext'
+
+	  cat <<_LT_EOF >> conftest.$ac_ext
+
+/* The mapping between symbol names and symbols.  */
+LT@&t@_DLSYM_CONST struct {
+  const char *name;
+  void       *address;
+}
+lt__PROGRAM__LTX_preloaded_symbols[[]] =
+{
+  { "@PROGRAM@", (void *) 0 },
+_LT_EOF
+	  $SED "s/^$symcode$symcode* .* \(.*\)$/  {\"\1\", (void *) \&\1},/" < "$nlist" | $GREP -v main >> conftest.$ac_ext
+	  cat <<\_LT_EOF >> conftest.$ac_ext
+  {0, (void *) 0}
+};
+
+/* This works around a problem in FreeBSD linker */
+#ifdef FREEBSD_WORKAROUND
+static const void *lt_preloaded_setup() {
+  return lt__PROGRAM__LTX_preloaded_symbols;
+}
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+_LT_EOF
+	  # Now try linking the two files.
+	  mv conftest.$ac_objext conftstm.$ac_objext
+	  lt_globsym_save_LIBS=$LIBS
+	  lt_globsym_save_CFLAGS=$CFLAGS
+	  LIBS=conftstm.$ac_objext
+	  CFLAGS="$CFLAGS$_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)"
+	  if AC_TRY_EVAL(ac_link) && test -s conftest$ac_exeext; then
+	    pipe_works=yes
+	  fi
+	  LIBS=$lt_globsym_save_LIBS
+	  CFLAGS=$lt_globsym_save_CFLAGS
+	else
+	  echo "cannot find nm_test_func in $nlist" >&AS_MESSAGE_LOG_FD
+	fi
+      else
+	echo "cannot find nm_test_var in $nlist" >&AS_MESSAGE_LOG_FD
+      fi
+    else
+      echo "cannot run $lt_cv_sys_global_symbol_pipe" >&AS_MESSAGE_LOG_FD
+    fi
+  else
+    echo "$progname: failed program was:" >&AS_MESSAGE_LOG_FD
+    cat conftest.$ac_ext >&5
+  fi
+  rm -rf conftest* conftst*
+
+  # Do not use the global_symbol_pipe unless it works.
+  if test yes = "$pipe_works"; then
+    break
+  else
+    lt_cv_sys_global_symbol_pipe=
+  fi
+done
+])
+if test -z "$lt_cv_sys_global_symbol_pipe"; then
+  lt_cv_sys_global_symbol_to_cdecl=
+fi
+if test -z "$lt_cv_sys_global_symbol_pipe$lt_cv_sys_global_symbol_to_cdecl"; then
+  AC_MSG_RESULT(failed)
+else
+  AC_MSG_RESULT(ok)
+fi
+
+# Response file support.
+if test "$lt_cv_nm_interface" = "MS dumpbin"; then
+  nm_file_list_spec='@'
+elif $NM --help 2>/dev/null | grep '[[@]]FILE' >/dev/null; then
+  nm_file_list_spec='@'
+fi
+
+_LT_DECL([global_symbol_pipe], [lt_cv_sys_global_symbol_pipe], [1],
+    [Take the output of nm and produce a listing of raw symbols and C names])
+_LT_DECL([global_symbol_to_cdecl], [lt_cv_sys_global_symbol_to_cdecl], [1],
+    [Transform the output of nm in a proper C declaration])
+_LT_DECL([global_symbol_to_import], [lt_cv_sys_global_symbol_to_import], [1],
+    [Transform the output of nm into a list of symbols to manually relocate])
+_LT_DECL([global_symbol_to_c_name_address],
+    [lt_cv_sys_global_symbol_to_c_name_address], [1],
+    [Transform the output of nm in a C name address pair])
+_LT_DECL([global_symbol_to_c_name_address_lib_prefix],
+    [lt_cv_sys_global_symbol_to_c_name_address_lib_prefix], [1],
+    [Transform the output of nm in a C name address pair when lib prefix is needed])
+_LT_DECL([nm_interface], [lt_cv_nm_interface], [1],
+    [The name lister interface])
+_LT_DECL([], [nm_file_list_spec], [1],
+    [Specify filename containing input files for $NM])
+]) # _LT_CMD_GLOBAL_SYMBOLS
+
+
+# _LT_COMPILER_PIC([TAGNAME])
+# ---------------------------
+m4_defun([_LT_COMPILER_PIC],
+[m4_require([_LT_TAG_COMPILER])dnl
+_LT_TAGVAR(lt_prog_compiler_wl, $1)=
+_LT_TAGVAR(lt_prog_compiler_pic, $1)=
+_LT_TAGVAR(lt_prog_compiler_static, $1)=
+
+m4_if([$1], [CXX], [
+  # C++ specific cases for pic, static, wl, etc.
+  if test yes = "$GXX"; then
+    _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+    _LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
+
+    case $host_os in
+    aix*)
+      # All AIX code is PIC.
+      if test ia64 = "$host_cpu"; then
+	# AIX 5 now supports IA64 processor
+	_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+      fi
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
+      ;;
+
+    amigaos*)
+      case $host_cpu in
+      powerpc)
+            # see comment about AmigaOS4 .so support
+            _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
+        ;;
+      m68k)
+            # FIXME: we need at least 68020 code to build shared libraries, but
+            # adding the '-m68020' flag to GCC prevents building anything better,
+            # like '-m68040'.
+            _LT_TAGVAR(lt_prog_compiler_pic, $1)='-m68020 -resident32 -malways-restore-a4'
+        ;;
+      esac
+      ;;
+
+    beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*)
+      # PIC is the default for these OSes.
+      ;;
+    mingw* | cygwin* | os2* | pw32* | cegcc*)
+      # This hack is so that the source file can tell whether it is being
+      # built for inclusion in a dll (and should export symbols for example).
+      # Although the cygwin gcc ignores -fPIC, still need this for old-style
+      # (--disable-auto-import) libraries
+      m4_if([$1], [GCJ], [],
+	[_LT_TAGVAR(lt_prog_compiler_pic, $1)='-DDLL_EXPORT'])
+      case $host_os in
+      os2*)
+	_LT_TAGVAR(lt_prog_compiler_static, $1)='$wl-static'
+	;;
+      esac
+      ;;
+    darwin* | rhapsody*)
+      # PIC is the default on this platform
+      # Common symbols not allowed in MH_DYLIB files
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fno-common'
+      ;;
+    *djgpp*)
+      # DJGPP does not support shared libraries at all
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)=
+      ;;
+    haiku*)
+      # PIC is the default for Haiku.
+      # The "-static" flag exists, but is broken.
+      _LT_TAGVAR(lt_prog_compiler_static, $1)=
+      ;;
+    interix[[3-9]]*)
+      # Interix 3.x gcc -fpic/-fPIC options generate broken code.
+      # Instead, we relocate shared libraries at runtime.
+      ;;
+    sysv4*MP*)
+      if test -d /usr/nec; then
+	_LT_TAGVAR(lt_prog_compiler_pic, $1)=-Kconform_pic
+      fi
+      ;;
+    hpux*)
+      # PIC is the default for 64-bit PA HP-UX, but not for 32-bit
+      # PA HP-UX.  On IA64 HP-UX, PIC is the default but the pic flag
+      # sets the default TLS model and affects inlining.
+      case $host_cpu in
+      hppa*64*)
+	;;
+      *)
+	_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
+	;;
+      esac
+      ;;
+    *qnx* | *nto*)
+      # QNX uses GNU C++, but need to define -shared option too, otherwise
+      # it will coredump.
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared'
+      ;;
+    *)
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
+      ;;
+    esac
+  else
+    case $host_os in
+      aix[[4-9]]*)
+	# All AIX code is PIC.
+	if test ia64 = "$host_cpu"; then
+	  # AIX 5 now supports IA64 processor
+	  _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+	else
+	  _LT_TAGVAR(lt_prog_compiler_static, $1)='-bnso -bI:/lib/syscalls.exp'
+	fi
+	;;
+      chorus*)
+	case $cc_basename in
+	cxch68*)
+	  # Green Hills C++ Compiler
+	  # _LT_TAGVAR(lt_prog_compiler_static, $1)="--no_auto_instantiation -u __main -u __premain -u _abort -r $COOL_DIR/lib/libOrb.a $MVME_DIR/lib/CC/libC.a $MVME_DIR/lib/classix/libcx.s.a"
+	  ;;
+	esac
+	;;
+      mingw* | cygwin* | os2* | pw32* | cegcc*)
+	# This hack is so that the source file can tell whether it is being
+	# built for inclusion in a dll (and should export symbols for example).
+	m4_if([$1], [GCJ], [],
+	  [_LT_TAGVAR(lt_prog_compiler_pic, $1)='-DDLL_EXPORT'])
+	;;
+      dgux*)
+	case $cc_basename in
+	  ec++*)
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
+	    ;;
+	  ghcx*)
+	    # Green Hills C++ Compiler
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      freebsd* | dragonfly*)
+	# FreeBSD uses GNU C++
+	;;
+      hpux9* | hpux10* | hpux11*)
+	case $cc_basename in
+	  CC*)
+	    _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	    _LT_TAGVAR(lt_prog_compiler_static, $1)='$wl-a ${wl}archive'
+	    if test ia64 != "$host_cpu"; then
+	      _LT_TAGVAR(lt_prog_compiler_pic, $1)='+Z'
+	    fi
+	    ;;
+	  aCC*)
+	    _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	    _LT_TAGVAR(lt_prog_compiler_static, $1)='$wl-a ${wl}archive'
+	    case $host_cpu in
+	    hppa*64*|ia64*)
+	      # +Z the default
+	      ;;
+	    *)
+	      _LT_TAGVAR(lt_prog_compiler_pic, $1)='+Z'
+	      ;;
+	    esac
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      interix*)
+	# This is c89, which is MS Visual C++ (no shared libs)
+	# Anyone wants to do a port?
+	;;
+      irix5* | irix6* | nonstopux*)
+	case $cc_basename in
+	  CC*)
+	    _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	    _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
+	    # CC pic flag -KPIC is the default.
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*)
+	case $cc_basename in
+	  KCC*)
+	    # KAI C++ Compiler
+	    _LT_TAGVAR(lt_prog_compiler_wl, $1)='--backend -Wl,'
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
+	    ;;
+	  ecpc* )
+	    # old Intel C++ for x86_64, which still supported -KPIC.
+	    _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
+	    _LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
+	    ;;
+	  icpc* )
+	    # Intel C++, used to be incompatible with GCC.
+	    # ICC 10 doesn't accept -KPIC any more.
+	    _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
+	    _LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
+	    ;;
+	  pgCC* | pgcpp*)
+	    # Portland Group C++ compiler
+	    _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fpic'
+	    _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+	    ;;
+	  cxx*)
+	    # Compaq C++
+	    # Make sure the PIC flag is empty.  It appears that all Alpha
+	    # Linux and Compaq Tru64 Unix objects are PIC.
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)=
+	    _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
+	    ;;
+	  xlc* | xlC* | bgxl[[cC]]* | mpixl[[cC]]*)
+	    # IBM XL 8.0, 9.0 on PPC and BlueGene
+	    _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)='-qpic'
+	    _LT_TAGVAR(lt_prog_compiler_static, $1)='-qstaticlink'
+	    ;;
+	  *)
+	    case `$CC -V 2>&1 | sed 5q` in
+	    *Sun\ C*)
+	      # Sun C++ 5.9
+	      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
+	      _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+	      _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld '
+	      ;;
+	    esac
+	    ;;
+	esac
+	;;
+      lynxos*)
+	;;
+      m88k*)
+	;;
+      mvs*)
+	case $cc_basename in
+	  cxx*)
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)='-W c,exportall'
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      netbsd* | netbsdelf*-gnu)
+	;;
+      *qnx* | *nto*)
+        # QNX uses GNU C++, but need to define -shared option too, otherwise
+        # it will coredump.
+        _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared'
+        ;;
+      osf3* | osf4* | osf5*)
+	case $cc_basename in
+	  KCC*)
+	    _LT_TAGVAR(lt_prog_compiler_wl, $1)='--backend -Wl,'
+	    ;;
+	  RCC*)
+	    # Rational C++ 2.4.1
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
+	    ;;
+	  cxx*)
+	    # Digital/Compaq C++
+	    _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	    # Make sure the PIC flag is empty.  It appears that all Alpha
+	    # Linux and Compaq Tru64 Unix objects are PIC.
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)=
+	    _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      psos*)
+	;;
+      solaris*)
+	case $cc_basename in
+	  CC* | sunCC*)
+	    # Sun C++ 4.2, 5.x and Centerline C++
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
+	    _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+	    _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld '
+	    ;;
+	  gcx*)
+	    # Green Hills C++ Compiler
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)='-PIC'
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      sunos4*)
+	case $cc_basename in
+	  CC*)
+	    # Sun C++ 4.x
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
+	    _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+	    ;;
+	  lcc*)
+	    # Lucid
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*)
+	case $cc_basename in
+	  CC*)
+	    _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
+	    _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+	    ;;
+	esac
+	;;
+      tandem*)
+	case $cc_basename in
+	  NCC*)
+	    # NonStop-UX NCC 3.20
+	    _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      vxworks*)
+	;;
+      *)
+	_LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no
+	;;
+    esac
+  fi
+],
+[
+  if test yes = "$GCC"; then
+    _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+    _LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
+
+    case $host_os in
+      aix*)
+      # All AIX code is PIC.
+      if test ia64 = "$host_cpu"; then
+	# AIX 5 now supports IA64 processor
+	_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+      fi
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
+      ;;
+
+    amigaos*)
+      case $host_cpu in
+      powerpc)
+            # see comment about AmigaOS4 .so support
+            _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
+        ;;
+      m68k)
+            # FIXME: we need at least 68020 code to build shared libraries, but
+            # adding the '-m68020' flag to GCC prevents building anything better,
+            # like '-m68040'.
+            _LT_TAGVAR(lt_prog_compiler_pic, $1)='-m68020 -resident32 -malways-restore-a4'
+        ;;
+      esac
+      ;;
+
+    beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*)
+      # PIC is the default for these OSes.
+      ;;
+
+    mingw* | cygwin* | pw32* | os2* | cegcc*)
+      # This hack is so that the source file can tell whether it is being
+      # built for inclusion in a dll (and should export symbols for example).
+      # Although the cygwin gcc ignores -fPIC, still need this for old-style
+      # (--disable-auto-import) libraries
+      m4_if([$1], [GCJ], [],
+	[_LT_TAGVAR(lt_prog_compiler_pic, $1)='-DDLL_EXPORT'])
+      case $host_os in
+      os2*)
+	_LT_TAGVAR(lt_prog_compiler_static, $1)='$wl-static'
+	;;
+      esac
+      ;;
+
+    darwin* | rhapsody*)
+      # PIC is the default on this platform
+      # Common symbols not allowed in MH_DYLIB files
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fno-common'
+      ;;
+
+    haiku*)
+      # PIC is the default for Haiku.
+      # The "-static" flag exists, but is broken.
+      _LT_TAGVAR(lt_prog_compiler_static, $1)=
+      ;;
+
+    hpux*)
+      # PIC is the default for 64-bit PA HP-UX, but not for 32-bit
+      # PA HP-UX.  On IA64 HP-UX, PIC is the default but the pic flag
+      # sets the default TLS model and affects inlining.
+      case $host_cpu in
+      hppa*64*)
+	# +Z the default
+	;;
+      *)
+	_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
+	;;
+      esac
+      ;;
+
+    interix[[3-9]]*)
+      # Interix 3.x gcc -fpic/-fPIC options generate broken code.
+      # Instead, we relocate shared libraries at runtime.
+      ;;
+
+    msdosdjgpp*)
+      # Just because we use GCC doesn't mean we suddenly get shared libraries
+      # on systems that don't support them.
+      _LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no
+      enable_shared=no
+      ;;
+
+    *nto* | *qnx*)
+      # QNX uses GNU C++, but need to define -shared option too, otherwise
+      # it will coredump.
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared'
+      ;;
+
+    sysv4*MP*)
+      if test -d /usr/nec; then
+	_LT_TAGVAR(lt_prog_compiler_pic, $1)=-Kconform_pic
+      fi
+      ;;
+
+    *)
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
+      ;;
+    esac
+
+    case $cc_basename in
+    nvcc*) # Cuda Compiler Driver 2.2
+      _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Xlinker '
+      if test -n "$_LT_TAGVAR(lt_prog_compiler_pic, $1)"; then
+        _LT_TAGVAR(lt_prog_compiler_pic, $1)="-Xcompiler $_LT_TAGVAR(lt_prog_compiler_pic, $1)"
+      fi
+      ;;
+    esac
+  else
+    # PORTME Check for flag to pass linker flags through the system compiler.
+    case $host_os in
+    aix*)
+      _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+      if test ia64 = "$host_cpu"; then
+	# AIX 5 now supports IA64 processor
+	_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+      else
+	_LT_TAGVAR(lt_prog_compiler_static, $1)='-bnso -bI:/lib/syscalls.exp'
+      fi
+      ;;
+
+    darwin* | rhapsody*)
+      # PIC is the default on this platform
+      # Common symbols not allowed in MH_DYLIB files
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fno-common'
+      case $cc_basename in
+      nagfor*)
+        # NAG Fortran compiler
+        _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,-Wl,,'
+        _LT_TAGVAR(lt_prog_compiler_pic, $1)='-PIC'
+        _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+        ;;
+      esac
+      ;;
+
+    mingw* | cygwin* | pw32* | os2* | cegcc*)
+      # This hack is so that the source file can tell whether it is being
+      # built for inclusion in a dll (and should export symbols for example).
+      m4_if([$1], [GCJ], [],
+	[_LT_TAGVAR(lt_prog_compiler_pic, $1)='-DDLL_EXPORT'])
+      case $host_os in
+      os2*)
+	_LT_TAGVAR(lt_prog_compiler_static, $1)='$wl-static'
+	;;
+      esac
+      ;;
+
+    hpux9* | hpux10* | hpux11*)
+      _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+      # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but
+      # not for PA HP-UX.
+      case $host_cpu in
+      hppa*64*|ia64*)
+	# +Z the default
+	;;
+      *)
+	_LT_TAGVAR(lt_prog_compiler_pic, $1)='+Z'
+	;;
+      esac
+      # Is there a better lt_prog_compiler_static that works with the bundled CC?
+      _LT_TAGVAR(lt_prog_compiler_static, $1)='$wl-a ${wl}archive'
+      ;;
+
+    irix5* | irix6* | nonstopux*)
+      _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+      # PIC (with -KPIC) is the default.
+      _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
+      ;;
+
+    linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*)
+      case $cc_basename in
+      # old Intel for x86_64, which still supported -KPIC.
+      ecc*)
+	_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	_LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
+	_LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
+        ;;
+      # icc used to be incompatible with GCC.
+      # ICC 10 doesn't accept -KPIC any more.
+      icc* | ifort*)
+	_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
+	_LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
+        ;;
+      # Lahey Fortran 8.1.
+      lf95*)
+	_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	_LT_TAGVAR(lt_prog_compiler_pic, $1)='--shared'
+	_LT_TAGVAR(lt_prog_compiler_static, $1)='--static'
+	;;
+      nagfor*)
+	# NAG Fortran compiler
+	_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,-Wl,,'
+	_LT_TAGVAR(lt_prog_compiler_pic, $1)='-PIC'
+	_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+	;;
+      tcc*)
+	# Fabrice Bellard et al's Tiny C Compiler
+	_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
+	_LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
+	;;
+      pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*)
+        # Portland Group compilers (*not* the Pentium gcc compiler,
+	# which looks to be a dead project)
+	_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fpic'
+	_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+        ;;
+      ccc*)
+        _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+        # All Alpha code is PIC.
+        _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
+        ;;
+      xl* | bgxl* | bgf* | mpixl*)
+	# IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene
+	_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	_LT_TAGVAR(lt_prog_compiler_pic, $1)='-qpic'
+	_LT_TAGVAR(lt_prog_compiler_static, $1)='-qstaticlink'
+	;;
+      *)
+	case `$CC -V 2>&1 | sed 5q` in
+	*Sun\ Ceres\ Fortran* | *Sun*Fortran*\ [[1-7]].* | *Sun*Fortran*\ 8.[[0-3]]*)
+	  # Sun Fortran 8.3 passes all unrecognized flags to the linker
+	  _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
+	  _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+	  _LT_TAGVAR(lt_prog_compiler_wl, $1)=''
+	  ;;
+	*Sun\ F* | *Sun*Fortran*)
+	  _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
+	  _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+	  _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld '
+	  ;;
+	*Sun\ C*)
+	  # Sun C 5.9
+	  _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
+	  _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+	  _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	  ;;
+        *Intel*\ [[CF]]*Compiler*)
+	  _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	  _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
+	  _LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
+	  ;;
+	*Portland\ Group*)
+	  _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+	  _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fpic'
+	  _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+	  ;;
+	esac
+	;;
+      esac
+      ;;
+
+    newsos6)
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
+      _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+      ;;
+
+    *nto* | *qnx*)
+      # QNX uses GNU C++, but need to define -shared option too, otherwise
+      # it will coredump.
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared'
+      ;;
+
+    osf3* | osf4* | osf5*)
+      _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+      # All OSF/1 code is PIC.
+      _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
+      ;;
+
+    rdos*)
+      _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
+      ;;
+
+    solaris*)
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
+      _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+      case $cc_basename in
+      f77* | f90* | f95* | sunf77* | sunf90* | sunf95*)
+	_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld ';;
+      *)
+	_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,';;
+      esac
+      ;;
+
+    sunos4*)
+      _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld '
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-PIC'
+      _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+      ;;
+
+    sysv4 | sysv4.2uw2* | sysv4.3*)
+      _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
+      _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+      ;;
+
+    sysv4*MP*)
+      if test -d /usr/nec; then
+	_LT_TAGVAR(lt_prog_compiler_pic, $1)='-Kconform_pic'
+	_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+      fi
+      ;;
+
+    sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*)
+      _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
+      _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+      ;;
+
+    unicos*)
+      _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
+      _LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no
+      ;;
+
+    uts4*)
+      _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
+      _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
+      ;;
+
+    *)
+      _LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no
+      ;;
+    esac
+  fi
+])
+case $host_os in
+  # For platforms that do not support PIC, -DPIC is meaningless:
+  *djgpp*)
+    _LT_TAGVAR(lt_prog_compiler_pic, $1)=
+    ;;
+  *)
+    _LT_TAGVAR(lt_prog_compiler_pic, $1)="$_LT_TAGVAR(lt_prog_compiler_pic, $1)@&t@m4_if([$1],[],[ -DPIC],[m4_if([$1],[CXX],[ -DPIC],[])])"
+    ;;
+esac
+
+AC_CACHE_CHECK([for $compiler option to produce PIC],
+  [_LT_TAGVAR(lt_cv_prog_compiler_pic, $1)],
+  [_LT_TAGVAR(lt_cv_prog_compiler_pic, $1)=$_LT_TAGVAR(lt_prog_compiler_pic, $1)])
+_LT_TAGVAR(lt_prog_compiler_pic, $1)=$_LT_TAGVAR(lt_cv_prog_compiler_pic, $1)
+
+#
+# Check to make sure the PIC flag actually works.
+#
+if test -n "$_LT_TAGVAR(lt_prog_compiler_pic, $1)"; then
+  _LT_COMPILER_OPTION([if $compiler PIC flag $_LT_TAGVAR(lt_prog_compiler_pic, $1) works],
+    [_LT_TAGVAR(lt_cv_prog_compiler_pic_works, $1)],
+    [$_LT_TAGVAR(lt_prog_compiler_pic, $1)@&t@m4_if([$1],[],[ -DPIC],[m4_if([$1],[CXX],[ -DPIC],[])])], [],
+    [case $_LT_TAGVAR(lt_prog_compiler_pic, $1) in
+     "" | " "*) ;;
+     *) _LT_TAGVAR(lt_prog_compiler_pic, $1)=" $_LT_TAGVAR(lt_prog_compiler_pic, $1)" ;;
+     esac],
+    [_LT_TAGVAR(lt_prog_compiler_pic, $1)=
+     _LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no])
+fi
+_LT_TAGDECL([pic_flag], [lt_prog_compiler_pic], [1],
+	[Additional compiler flags for building library objects])
+
+_LT_TAGDECL([wl], [lt_prog_compiler_wl], [1],
+	[How to pass a linker flag through the compiler])
+#
+# Check to make sure the static flag actually works.
+#
+wl=$_LT_TAGVAR(lt_prog_compiler_wl, $1) eval lt_tmp_static_flag=\"$_LT_TAGVAR(lt_prog_compiler_static, $1)\"
+_LT_LINKER_OPTION([if $compiler static flag $lt_tmp_static_flag works],
+  _LT_TAGVAR(lt_cv_prog_compiler_static_works, $1),
+  $lt_tmp_static_flag,
+  [],
+  [_LT_TAGVAR(lt_prog_compiler_static, $1)=])
+_LT_TAGDECL([link_static_flag], [lt_prog_compiler_static], [1],
+	[Compiler flag to prevent dynamic linking])
+])# _LT_COMPILER_PIC
+
+
+# _LT_LINKER_SHLIBS([TAGNAME])
+# ----------------------------
+# See if the linker supports building shared libraries.
+m4_defun([_LT_LINKER_SHLIBS],
+[AC_REQUIRE([LT_PATH_LD])dnl
+AC_REQUIRE([LT_PATH_NM])dnl
+m4_require([_LT_PATH_MANIFEST_TOOL])dnl
+m4_require([_LT_FILEUTILS_DEFAULTS])dnl
+m4_require([_LT_DECL_EGREP])dnl
+m4_require([_LT_DECL_SED])dnl
+m4_require([_LT_CMD_GLOBAL_SYMBOLS])dnl
+m4_require([_LT_TAG_COMPILER])dnl
+AC_MSG_CHECKING([whether the $compiler linker ($LD) supports shared libraries])
+m4_if([$1], [CXX], [
+  _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols'
+  _LT_TAGVAR(exclude_expsyms, $1)=['_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*']
+  case $host_os in
+  aix[[4-9]]*)
+    # If we're using GNU nm, then we don't want the "-C" option.
+    # -C means demangle to GNU nm, but means don't demangle to AIX nm.
+    # Without the "-l" option, or with the "-B" option, AIX nm treats
+    # weak defined symbols like other global defined symbols, whereas
+    # GNU nm marks them as "W".
+    # While the 'weak' keyword is ignored in the Export File, we need
+    # it in the Import File for the 'aix-soname' feature, so we have
+    # to replace the "-B" option with "-P" for AIX nm.
+    if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then
+      _LT_TAGVAR(export_symbols_cmds, $1)='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && ([substr](\$ 3,1,1) != ".")) { if (\$ 2 == "W") { print \$ 3 " weak" } else { print \$ 3 } } }'\'' | sort -u > $export_symbols'
+    else
+      _LT_TAGVAR(export_symbols_cmds, $1)='`func_echo_all $NM | $SED -e '\''s/B\([[^B]]*\)$/P\1/'\''` -PCpgl $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) && ([substr](\$ 1,1,1) != ".")) { if ((\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) { print \$ 1 " weak" } else { print \$ 1 } } }'\'' | sort -u > $export_symbols'
+    fi
+    ;;
+  pw32*)
+    _LT_TAGVAR(export_symbols_cmds, $1)=$ltdll_cmds
+    ;;
+  cygwin* | mingw* | cegcc*)
+    case $cc_basename in
+    cl*)
+      _LT_TAGVAR(exclude_expsyms, $1)='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*'
+      ;;
+    *)
+      _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[[BCDGRS]][[ ]]/s/.*[[ ]]\([[^ ]]*\)/\1 DATA/;s/^.*[[ ]]__nm__\([[^ ]]*\)[[ ]][[^ ]]*/\1 DATA/;/^I[[ ]]/d;/^[[AITW]][[ ]]/s/.* //'\'' | sort | uniq > $export_symbols'
+      _LT_TAGVAR(exclude_expsyms, $1)=['[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname']
+      ;;
+    esac
+    ;;
+  linux* | k*bsd*-gnu | gnu*)
+    _LT_TAGVAR(link_all_deplibs, $1)=no
+    ;;
+  *)
+    _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols'
+    ;;
+  esac
+], [
+  runpath_var=
+  _LT_TAGVAR(allow_undefined_flag, $1)=
+  _LT_TAGVAR(always_export_symbols, $1)=no
+  _LT_TAGVAR(archive_cmds, $1)=
+  _LT_TAGVAR(archive_expsym_cmds, $1)=
+  _LT_TAGVAR(compiler_needs_object, $1)=no
+  _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no
+  _LT_TAGVAR(export_dynamic_flag_spec, $1)=
+  _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols'
+  _LT_TAGVAR(hardcode_automatic, $1)=no
+  _LT_TAGVAR(hardcode_direct, $1)=no
+  _LT_TAGVAR(hardcode_direct_absolute, $1)=no
+  _LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
+  _LT_TAGVAR(hardcode_libdir_separator, $1)=
+  _LT_TAGVAR(hardcode_minus_L, $1)=no
+  _LT_TAGVAR(hardcode_shlibpath_var, $1)=unsupported
+  _LT_TAGVAR(inherit_rpath, $1)=no
+  _LT_TAGVAR(link_all_deplibs, $1)=unknown
+  _LT_TAGVAR(module_cmds, $1)=
+  _LT_TAGVAR(module_expsym_cmds, $1)=
+  _LT_TAGVAR(old_archive_from_new_cmds, $1)=
+  _LT_TAGVAR(old_archive_from_expsyms_cmds, $1)=
+  _LT_TAGVAR(thread_safe_flag_spec, $1)=
+  _LT_TAGVAR(whole_archive_flag_spec, $1)=
+  # include_expsyms should be a list of space-separated symbols to be *always*
+  # included in the symbol list
+  _LT_TAGVAR(include_expsyms, $1)=
+  # exclude_expsyms can be an extended regexp of symbols to exclude
+  # it will be wrapped by ' (' and ')$', so one must not match beginning or
+  # end of line.  Example: 'a|bc|.*d.*' will exclude the symbols 'a' and 'bc',
+  # as well as any symbol that contains 'd'.
+  _LT_TAGVAR(exclude_expsyms, $1)=['_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*']
+  # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out
+  # platforms (ab)use it in PIC code, but their linkers get confused if
+  # the symbol is explicitly referenced.  Since portable code cannot
+  # rely on this symbol name, it's probably fine to never include it in
+  # preloaded symbol tables.
+  # Exclude shared library initialization/finalization symbols.
+dnl Note also adjust exclude_expsyms for C++ above.
+  extract_expsyms_cmds=
+
+  case $host_os in
+  cygwin* | mingw* | pw32* | cegcc*)
+    # FIXME: the MSVC++ port hasn't been tested in a loooong time
+    # When not using gcc, we currently assume that we are using
+    # Microsoft Visual C++.
+    if test yes != "$GCC"; then
+      with_gnu_ld=no
+    fi
+    ;;
+  interix*)
+    # we just hope/assume this is gcc and not c89 (= MSVC++)
+    with_gnu_ld=yes
+    ;;
+  openbsd* | bitrig*)
+    with_gnu_ld=no
+    ;;
+  linux* | k*bsd*-gnu | gnu*)
+    _LT_TAGVAR(link_all_deplibs, $1)=no
+    ;;
+  esac
+
+  _LT_TAGVAR(ld_shlibs, $1)=yes
+
+  # On some targets, GNU ld is compatible enough with the native linker
+  # that we're better off using the native interface for both.
+  lt_use_gnu_ld_interface=no
+  if test yes = "$with_gnu_ld"; then
+    case $host_os in
+      aix*)
+	# The AIX port of GNU ld has always aspired to compatibility
+	# with the native linker.  However, as the warning in the GNU ld
+	# block says, versions before 2.19.5* couldn't really create working
+	# shared libraries, regardless of the interface used.
+	case `$LD -v 2>&1` in
+	  *\ \(GNU\ Binutils\)\ 2.19.5*) ;;
+	  *\ \(GNU\ Binutils\)\ 2.[[2-9]]*) ;;
+	  *\ \(GNU\ Binutils\)\ [[3-9]]*) ;;
+	  *)
+	    lt_use_gnu_ld_interface=yes
+	    ;;
+	esac
+	;;
+      *)
+	lt_use_gnu_ld_interface=yes
+	;;
+    esac
+  fi
+
+  if test yes = "$lt_use_gnu_ld_interface"; then
+    # If archive_cmds runs LD, not CC, wlarc should be empty
+    wlarc='$wl'
+
+    # Set some defaults for GNU ld with shared library support. These
+    # are reset later if shared libraries are not supported. Putting them
+    # here allows them to be overridden if necessary.
+    runpath_var=LD_RUN_PATH
+    _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir'
+    _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-dynamic'
+    # ancient GNU ld didn't support --whole-archive et. al.
+    if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then
+      _LT_TAGVAR(whole_archive_flag_spec, $1)=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive'
+    else
+      _LT_TAGVAR(whole_archive_flag_spec, $1)=
+    fi
+    supports_anon_versioning=no
+    case `$LD -v | $SED -e 's/([^)]\+)\s\+//' 2>&1` in
+      *GNU\ gold*) supports_anon_versioning=yes ;;
+      *\ [[01]].* | *\ 2.[[0-9]].* | *\ 2.10.*) ;; # catch versions < 2.11
+      *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ...
+      *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ...
+      *\ 2.11.*) ;; # other 2.11 versions
+      *) supports_anon_versioning=yes ;;
+    esac
+
+    # See if GNU ld supports shared libraries.
+    case $host_os in
+    aix[[3-9]]*)
+      # On AIX/PPC, the GNU linker is very broken
+      if test ia64 != "$host_cpu"; then
+	_LT_TAGVAR(ld_shlibs, $1)=no
+	cat <<_LT_EOF 1>&2
+
+*** Warning: the GNU linker, at least up to release 2.19, is reported
+*** to be unable to reliably create shared libraries on AIX.
+*** Therefore, libtool is disabling shared libraries support.  If you
+*** really care for shared libraries, you may want to install binutils
+*** 2.20 or above, or modify your PATH so that a non-GNU linker is found.
+*** You will then need to restart the configuration process.
+
+_LT_EOF
+      fi
+      ;;
+
+    amigaos*)
+      case $host_cpu in
+      powerpc)
+            # see comment about AmigaOS4 .so support
+            _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+            _LT_TAGVAR(archive_expsym_cmds, $1)=''
+        ;;
+      m68k)
+            _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
+            _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
+            _LT_TAGVAR(hardcode_minus_L, $1)=yes
+        ;;
+      esac
+      ;;
+
+    beos*)
+      if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
+	_LT_TAGVAR(allow_undefined_flag, $1)=unsupported
+	# Joseph Beckenbach  says some releases of gcc
+	# support --undefined.  This deserves some investigation.  FIXME
+	_LT_TAGVAR(archive_cmds, $1)='$CC -nostart $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+      else
+	_LT_TAGVAR(ld_shlibs, $1)=no
+      fi
+      ;;
+
+    cygwin* | mingw* | pw32* | cegcc*)
+      # _LT_TAGVAR(hardcode_libdir_flag_spec, $1) is actually meaningless,
+      # as there is no search path for DLLs.
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
+      _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-all-symbols'
+      _LT_TAGVAR(allow_undefined_flag, $1)=unsupported
+      _LT_TAGVAR(always_export_symbols, $1)=no
+      _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
+      _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[[BCDGRS]][[ ]]/s/.*[[ ]]\([[^ ]]*\)/\1 DATA/;s/^.*[[ ]]__nm__\([[^ ]]*\)[[ ]][[^ ]]*/\1 DATA/;/^I[[ ]]/d;/^[[AITW]][[ ]]/s/.* //'\'' | sort | uniq > $export_symbols'
+      _LT_TAGVAR(exclude_expsyms, $1)=['[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname']
+
+      if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then
+        _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
+	# If the export-symbols file already is a .def file, use it as
+	# is; otherwise, prepend EXPORTS...
+	_LT_TAGVAR(archive_expsym_cmds, $1)='if _LT_DLL_DEF_P([$export_symbols]); then
+          cp $export_symbols $output_objdir/$soname.def;
+        else
+          echo EXPORTS > $output_objdir/$soname.def;
+          cat $export_symbols >> $output_objdir/$soname.def;
+        fi~
+        $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
+      else
+	_LT_TAGVAR(ld_shlibs, $1)=no
+      fi
+      ;;
+
+    haiku*)
+      _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+      _LT_TAGVAR(link_all_deplibs, $1)=yes
+      ;;
+
+    os2*)
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
+      _LT_TAGVAR(hardcode_minus_L, $1)=yes
+      _LT_TAGVAR(allow_undefined_flag, $1)=unsupported
+      shrext_cmds=.dll
+      _LT_TAGVAR(archive_cmds, $1)='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~
+	$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~
+	$ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~
+	$ECHO EXPORTS >> $output_objdir/$libname.def~
+	emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~
+	$CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~
+	emximp -o $lib $output_objdir/$libname.def'
+      _LT_TAGVAR(archive_expsym_cmds, $1)='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~
+	$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~
+	$ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~
+	$ECHO EXPORTS >> $output_objdir/$libname.def~
+	prefix_cmds="$SED"~
+	if test EXPORTS = "`$SED 1q $export_symbols`"; then
+	  prefix_cmds="$prefix_cmds -e 1d";
+	fi~
+	prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~
+	cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~
+	$CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~
+	emximp -o $lib $output_objdir/$libname.def'
+      _LT_TAGVAR(old_archive_From_new_cmds, $1)='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def'
+      _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
+      ;;
+
+    interix[[3-9]]*)
+      _LT_TAGVAR(hardcode_direct, $1)=no
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir'
+      _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E'
+      # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc.
+      # Instead, shared libraries are loaded at an image base (0x10000000 by
+      # default) and relocated if they conflict, which is a slow very memory
+      # consuming and fragmenting process.  To avoid this, we pick a random,
+      # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link
+      # time.  Moving up from 0x10000000 also allows more sbrk(2) space.
+      _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
+      _LT_TAGVAR(archive_expsym_cmds, $1)='sed "s|^|_|" $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--retain-symbols-file,$output_objdir/$soname.expsym $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
+      ;;
+
+    gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu)
+      tmp_diet=no
+      if test linux-dietlibc = "$host_os"; then
+	case $cc_basename in
+	  diet\ *) tmp_diet=yes;;	# linux-dietlibc with static linking (!diet-dyn)
+	esac
+      fi
+      if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \
+	 && test no = "$tmp_diet"
+      then
+	tmp_addflag=' $pic_flag'
+	tmp_sharedflag='-shared'
+	case $cc_basename,$host_cpu in
+        pgcc*)				# Portland Group C compiler
+	  _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive`for conv in $convenience\"\"; do test  -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive'
+	  tmp_addflag=' $pic_flag'
+	  ;;
+	pgf77* | pgf90* | pgf95* | pgfortran*)
+					# Portland Group f77 and f90 compilers
+	  _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive`for conv in $convenience\"\"; do test  -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive'
+	  tmp_addflag=' $pic_flag -Mnomain' ;;
+	ecc*,ia64* | icc*,ia64*)	# Intel C compiler on ia64
+	  tmp_addflag=' -i_dynamic' ;;
+	efc*,ia64* | ifort*,ia64*)	# Intel Fortran compiler on ia64
+	  tmp_addflag=' -i_dynamic -nofor_main' ;;
+	ifc* | ifort*)			# Intel Fortran compiler
+	  tmp_addflag=' -nofor_main' ;;
+	lf95*)				# Lahey Fortran 8.1
+	  _LT_TAGVAR(whole_archive_flag_spec, $1)=
+	  tmp_sharedflag='--shared' ;;
+        nagfor*)                        # NAGFOR 5.3
+          tmp_sharedflag='-Wl,-shared' ;;
+	xl[[cC]]* | bgxl[[cC]]* | mpixl[[cC]]*) # IBM XL C 8.0 on PPC (deal with xlf below)
+	  tmp_sharedflag='-qmkshrobj'
+	  tmp_addflag= ;;
+	nvcc*)	# Cuda Compiler Driver 2.2
+	  _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive`for conv in $convenience\"\"; do test  -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive'
+	  _LT_TAGVAR(compiler_needs_object, $1)=yes
+	  ;;
+	esac
+	case `$CC -V 2>&1 | sed 5q` in
+	*Sun\ C*)			# Sun C 5.9
+	  _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive'
+	  _LT_TAGVAR(compiler_needs_object, $1)=yes
+	  tmp_sharedflag='-G' ;;
+	*Sun\ F*)			# Sun Fortran 8.3
+	  tmp_sharedflag='-G' ;;
+	esac
+	_LT_TAGVAR(archive_cmds, $1)='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+
+        if test yes = "$supports_anon_versioning"; then
+          _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $output_objdir/$libname.ver~
+            cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
+            echo "local: *; };" >> $output_objdir/$libname.ver~
+            $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-version-script $wl$output_objdir/$libname.ver -o $lib'
+        fi
+
+	case $cc_basename in
+	tcc*)
+	  _LT_TAGVAR(export_dynamic_flag_spec, $1)='-rdynamic'
+	  ;;
+	xlf* | bgf* | bgxlf* | mpixlf*)
+	  # IBM XL Fortran 10.1 on PPC cannot create shared libs itself
+	  _LT_TAGVAR(whole_archive_flag_spec, $1)='--whole-archive$convenience --no-whole-archive'
+	  _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir'
+	  _LT_TAGVAR(archive_cmds, $1)='$LD -shared $libobjs $deplibs $linker_flags -soname $soname -o $lib'
+	  if test yes = "$supports_anon_versioning"; then
+	    _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $output_objdir/$libname.ver~
+              cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
+              echo "local: *; };" >> $output_objdir/$libname.ver~
+              $LD -shared $libobjs $deplibs $linker_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib'
+	  fi
+	  ;;
+	esac
+      else
+        _LT_TAGVAR(ld_shlibs, $1)=no
+      fi
+      ;;
+
+    netbsd* | netbsdelf*-gnu)
+      if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
+	_LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib'
+	wlarc=
+      else
+	_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+	_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib'
+      fi
+      ;;
+
+    solaris*)
+      if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then
+	_LT_TAGVAR(ld_shlibs, $1)=no
+	cat <<_LT_EOF 1>&2
+
+*** Warning: The releases 2.8.* of the GNU linker cannot reliably
+*** create shared libraries on Solaris systems.  Therefore, libtool
+*** is disabling shared libraries support.  We urge you to upgrade GNU
+*** binutils to release 2.9.1 or newer.  Another option is to modify
+*** your PATH or compiler configuration so that the native linker is
+*** used, and then restart.
+
+_LT_EOF
+      elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
+	_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+	_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib'
+      else
+	_LT_TAGVAR(ld_shlibs, $1)=no
+      fi
+      ;;
+
+    sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*)
+      case `$LD -v 2>&1` in
+        *\ [[01]].* | *\ 2.[[0-9]].* | *\ 2.1[[0-5]].*)
+	_LT_TAGVAR(ld_shlibs, $1)=no
+	cat <<_LT_EOF 1>&2
+
+*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 cannot
+*** reliably create shared libraries on SCO systems.  Therefore, libtool
+*** is disabling shared libraries support.  We urge you to upgrade GNU
+*** binutils to release 2.16.91.0.3 or newer.  Another option is to modify
+*** your PATH or compiler configuration so that the native linker is
+*** used, and then restart.
+
+_LT_EOF
+	;;
+	*)
+	  # For security reasons, it is highly recommended that you always
+	  # use absolute paths for naming shared libraries, and exclude the
+	  # DT_RUNPATH tag from executables and libraries.  But doing so
+	  # requires that you compile everything twice, which is a pain.
+	  if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
+	    _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir'
+	    _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+	    _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib'
+	  else
+	    _LT_TAGVAR(ld_shlibs, $1)=no
+	  fi
+	;;
+      esac
+      ;;
+
+    sunos4*)
+      _LT_TAGVAR(archive_cmds, $1)='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+      wlarc=
+      _LT_TAGVAR(hardcode_direct, $1)=yes
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      ;;
+
+    *)
+      if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
+	_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+	_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib'
+      else
+	_LT_TAGVAR(ld_shlibs, $1)=no
+      fi
+      ;;
+    esac
+
+    if test no = "$_LT_TAGVAR(ld_shlibs, $1)"; then
+      runpath_var=
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
+      _LT_TAGVAR(export_dynamic_flag_spec, $1)=
+      _LT_TAGVAR(whole_archive_flag_spec, $1)=
+    fi
+  else
+    # PORTME fill in a description of your system's linker (not GNU ld)
+    case $host_os in
+    aix3*)
+      _LT_TAGVAR(allow_undefined_flag, $1)=unsupported
+      _LT_TAGVAR(always_export_symbols, $1)=yes
+      _LT_TAGVAR(archive_expsym_cmds, $1)='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname'
+      # Note: this linker hardcodes the directories in LIBPATH if there
+      # are no directories specified by -L.
+      _LT_TAGVAR(hardcode_minus_L, $1)=yes
+      if test yes = "$GCC" && test -z "$lt_prog_compiler_static"; then
+	# Neither direct hardcoding nor static linking is supported with a
+	# broken collect2.
+	_LT_TAGVAR(hardcode_direct, $1)=unsupported
+      fi
+      ;;
+
+    aix[[4-9]]*)
+      if test ia64 = "$host_cpu"; then
+	# On IA64, the linker does run time linking by default, so we don't
+	# have to do anything special.
+	aix_use_runtimelinking=no
+	exp_sym_flag='-Bexport'
+	no_entry_flag=
+      else
+	# If we're using GNU nm, then we don't want the "-C" option.
+	# -C means demangle to GNU nm, but means don't demangle to AIX nm.
+	# Without the "-l" option, or with the "-B" option, AIX nm treats
+	# weak defined symbols like other global defined symbols, whereas
+	# GNU nm marks them as "W".
+	# While the 'weak' keyword is ignored in the Export File, we need
+	# it in the Import File for the 'aix-soname' feature, so we have
+	# to replace the "-B" option with "-P" for AIX nm.
+	if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then
+	  _LT_TAGVAR(export_symbols_cmds, $1)='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && ([substr](\$ 3,1,1) != ".")) { if (\$ 2 == "W") { print \$ 3 " weak" } else { print \$ 3 } } }'\'' | sort -u > $export_symbols'
+	else
+	  _LT_TAGVAR(export_symbols_cmds, $1)='`func_echo_all $NM | $SED -e '\''s/B\([[^B]]*\)$/P\1/'\''` -PCpgl $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) && ([substr](\$ 1,1,1) != ".")) { if ((\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) { print \$ 1 " weak" } else { print \$ 1 } } }'\'' | sort -u > $export_symbols'
+	fi
+	aix_use_runtimelinking=no
+
+	# Test if we are trying to use run time linking or normal
+	# AIX style linking. If -brtl is somewhere in LDFLAGS, we
+	# have runtime linking enabled, and use it for executables.
+	# For shared libraries, we enable/disable runtime linking
+	# depending on the kind of the shared library created -
+	# when "with_aix_soname,aix_use_runtimelinking" is:
+	# "aix,no"   lib.a(lib.so.V) shared, rtl:no,  for executables
+	# "aix,yes"  lib.so          shared, rtl:yes, for executables
+	#            lib.a           static archive
+	# "both,no"  lib.so.V(shr.o) shared, rtl:yes
+	#            lib.a(lib.so.V) shared, rtl:no,  for executables
+	# "both,yes" lib.so.V(shr.o) shared, rtl:yes, for executables
+	#            lib.a(lib.so.V) shared, rtl:no
+	# "svr4,*"   lib.so.V(shr.o) shared, rtl:yes, for executables
+	#            lib.a           static archive
+	case $host_os in aix4.[[23]]|aix4.[[23]].*|aix[[5-9]]*)
+	  for ld_flag in $LDFLAGS; do
+	  if (test x-brtl = "x$ld_flag" || test x-Wl,-brtl = "x$ld_flag"); then
+	    aix_use_runtimelinking=yes
+	    break
+	  fi
+	  done
+	  if test svr4,no = "$with_aix_soname,$aix_use_runtimelinking"; then
+	    # With aix-soname=svr4, we create the lib.so.V shared archives only,
+	    # so we don't have lib.a shared libs to link our executables.
+	    # We have to force runtime linking in this case.
+	    aix_use_runtimelinking=yes
+	    LDFLAGS="$LDFLAGS -Wl,-brtl"
+	  fi
+	  ;;
+	esac
+
+	exp_sym_flag='-bexport'
+	no_entry_flag='-bnoentry'
+      fi
+
+      # When large executables or shared objects are built, AIX ld can
+      # have problems creating the table of contents.  If linking a library
+      # or program results in "error TOC overflow" add -mminimal-toc to
+      # CXXFLAGS/CFLAGS for g++/gcc.  In the cases where that is not
+      # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS.
+
+      _LT_TAGVAR(archive_cmds, $1)=''
+      _LT_TAGVAR(hardcode_direct, $1)=yes
+      _LT_TAGVAR(hardcode_direct_absolute, $1)=yes
+      _LT_TAGVAR(hardcode_libdir_separator, $1)=':'
+      _LT_TAGVAR(link_all_deplibs, $1)=yes
+      _LT_TAGVAR(file_list_spec, $1)='$wl-f,'
+      case $with_aix_soname,$aix_use_runtimelinking in
+      aix,*) ;; # traditional, no import file
+      svr4,* | *,yes) # use import file
+	# The Import File defines what to hardcode.
+	_LT_TAGVAR(hardcode_direct, $1)=no
+	_LT_TAGVAR(hardcode_direct_absolute, $1)=no
+	;;
+      esac
+
+      if test yes = "$GCC"; then
+	case $host_os in aix4.[[012]]|aix4.[[012]].*)
+	# We only want to do this on AIX 4.2 and lower, the check
+	# below for broken collect2 doesn't work under 4.3+
+	  collect2name=`$CC -print-prog-name=collect2`
+	  if test -f "$collect2name" &&
+	   strings "$collect2name" | $GREP resolve_lib_name >/dev/null
+	  then
+	  # We have reworked collect2
+	  :
+	  else
+	  # We have old collect2
+	  _LT_TAGVAR(hardcode_direct, $1)=unsupported
+	  # It fails to find uninstalled libraries when the uninstalled
+	  # path is not listed in the libpath.  Setting hardcode_minus_L
+	  # to unsupported forces relinking
+	  _LT_TAGVAR(hardcode_minus_L, $1)=yes
+	  _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
+	  _LT_TAGVAR(hardcode_libdir_separator, $1)=
+	  fi
+	  ;;
+	esac
+	shared_flag='-shared'
+	if test yes = "$aix_use_runtimelinking"; then
+	  shared_flag="$shared_flag "'$wl-G'
+	fi
+	# Need to ensure runtime linking is disabled for the traditional
+	# shared library, or the linker may eventually find shared libraries
+	# /with/ Import File - we do not want to mix them.
+	shared_flag_aix='-shared'
+	shared_flag_svr4='-shared $wl-G'
+      else
+	# not using gcc
+	if test ia64 = "$host_cpu"; then
+	# VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release
+	# chokes on -Wl,-G. The following line is correct:
+	  shared_flag='-G'
+	else
+	  if test yes = "$aix_use_runtimelinking"; then
+	    shared_flag='$wl-G'
+	  else
+	    shared_flag='$wl-bM:SRE'
+	  fi
+	  shared_flag_aix='$wl-bM:SRE'
+	  shared_flag_svr4='$wl-G'
+	fi
+      fi
+
+      _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-bexpall'
+      # It seems that -bexpall does not export symbols beginning with
+      # underscore (_), so it is better to generate a list of symbols to export.
+      _LT_TAGVAR(always_export_symbols, $1)=yes
+      if test aix,yes = "$with_aix_soname,$aix_use_runtimelinking"; then
+	# Warning - without using the other runtime loading flags (-brtl),
+	# -berok will link without error, but may produce a broken library.
+	_LT_TAGVAR(allow_undefined_flag, $1)='-berok'
+        # Determine the default libpath from the value encoded in an
+        # empty executable.
+        _LT_SYS_MODULE_PATH_AIX([$1])
+        _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-blibpath:$libdir:'"$aix_libpath"
+        _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -o $output_objdir/$soname $libobjs $deplibs $wl'$no_entry_flag' $compiler_flags `if test -n "$allow_undefined_flag"; then func_echo_all "$wl$allow_undefined_flag"; else :; fi` $wl'$exp_sym_flag:\$export_symbols' '$shared_flag
+      else
+	if test ia64 = "$host_cpu"; then
+	  _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-R $libdir:/usr/lib:/lib'
+	  _LT_TAGVAR(allow_undefined_flag, $1)="-z nodefs"
+	  _LT_TAGVAR(archive_expsym_cmds, $1)="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\$wl$no_entry_flag"' $compiler_flags $wl$allow_undefined_flag '"\$wl$exp_sym_flag:\$export_symbols"
+	else
+	 # Determine the default libpath from the value encoded in an
+	 # empty executable.
+	 _LT_SYS_MODULE_PATH_AIX([$1])
+	 _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-blibpath:$libdir:'"$aix_libpath"
+	  # Warning - without using the other run time loading flags,
+	  # -berok will link without error, but may produce a broken library.
+	  _LT_TAGVAR(no_undefined_flag, $1)=' $wl-bernotok'
+	  _LT_TAGVAR(allow_undefined_flag, $1)=' $wl-berok'
+	  if test yes = "$with_gnu_ld"; then
+	    # We only use this code for GNU lds that support --whole-archive.
+	    _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive$convenience $wl--no-whole-archive'
+	  else
+	    # Exported symbols can be pulled into shared objects from archives
+	    _LT_TAGVAR(whole_archive_flag_spec, $1)='$convenience'
+	  fi
+	  _LT_TAGVAR(archive_cmds_need_lc, $1)=yes
+	  _LT_TAGVAR(archive_expsym_cmds, $1)='$RM -r $output_objdir/$realname.d~$MKDIR $output_objdir/$realname.d'
+	  # -brtl affects multiple linker settings, -berok does not and is overridden later
+	  compiler_flags_filtered='`func_echo_all "$compiler_flags " | $SED -e "s%-brtl\\([[, ]]\\)%-berok\\1%g"`'
+	  if test svr4 != "$with_aix_soname"; then
+	    # This is similar to how AIX traditionally builds its shared libraries.
+	    _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$CC '$shared_flag_aix' -o $output_objdir/$realname.d/$soname $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$realname.d/$soname'
+	  fi
+	  if test aix != "$with_aix_soname"; then
+	    _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$CC '$shared_flag_svr4' -o $output_objdir/$realname.d/$shared_archive_member_spec.o $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$STRIP -e $output_objdir/$realname.d/$shared_archive_member_spec.o~( func_echo_all "#! $soname($shared_archive_member_spec.o)"; if test shr_64 = "$shared_archive_member_spec"; then func_echo_all "# 64"; else func_echo_all "# 32"; fi; cat $export_symbols ) > $output_objdir/$realname.d/$shared_archive_member_spec.imp~$AR $AR_FLAGS $output_objdir/$soname $output_objdir/$realname.d/$shared_archive_member_spec.o $output_objdir/$realname.d/$shared_archive_member_spec.imp'
+	  else
+	    # used by -dlpreopen to get the symbols
+	    _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$MV  $output_objdir/$realname.d/$soname $output_objdir'
+	  fi
+	  _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$RM -r $output_objdir/$realname.d'
+	fi
+      fi
+      ;;
+
+    amigaos*)
+      case $host_cpu in
+      powerpc)
+            # see comment about AmigaOS4 .so support
+            _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+            _LT_TAGVAR(archive_expsym_cmds, $1)=''
+        ;;
+      m68k)
+            _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
+            _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
+            _LT_TAGVAR(hardcode_minus_L, $1)=yes
+        ;;
+      esac
+      ;;
+
+    bsdi[[45]]*)
+      _LT_TAGVAR(export_dynamic_flag_spec, $1)=-rdynamic
+      ;;
+
+    cygwin* | mingw* | pw32* | cegcc*)
+      # When not using gcc, we currently assume that we are using
+      # Microsoft Visual C++.
+      # hardcode_libdir_flag_spec is actually meaningless, as there is
+      # no search path for DLLs.
+      case $cc_basename in
+      cl*)
+	# Native MSVC
+	_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=' '
+	_LT_TAGVAR(allow_undefined_flag, $1)=unsupported
+	_LT_TAGVAR(always_export_symbols, $1)=yes
+	_LT_TAGVAR(file_list_spec, $1)='@'
+	# Tell ltmain to make .lib files, not .a files.
+	libext=lib
+	# Tell ltmain to make .dll files, not .so files.
+	shrext_cmds=.dll
+	# FIXME: Setting linknames here is a bad hack.
+	_LT_TAGVAR(archive_cmds, $1)='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~linknames='
+	_LT_TAGVAR(archive_expsym_cmds, $1)='if _LT_DLL_DEF_P([$export_symbols]); then
+            cp "$export_symbols" "$output_objdir/$soname.def";
+            echo "$tool_output_objdir$soname.def" > "$output_objdir/$soname.exp";
+          else
+            $SED -e '\''s/^/-link -EXPORT:/'\'' < $export_symbols > $output_objdir/$soname.exp;
+          fi~
+          $CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~
+          linknames='
+	# The linker will not automatically build a static lib if we build a DLL.
+	# _LT_TAGVAR(old_archive_from_new_cmds, $1)='true'
+	_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
+	_LT_TAGVAR(exclude_expsyms, $1)='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*'
+	_LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[[BCDGRS]][[ ]]/s/.*[[ ]]\([[^ ]]*\)/\1,DATA/'\'' | $SED -e '\''/^[[AITW]][[ ]]/s/.*[[ ]]//'\'' | sort | uniq > $export_symbols'
+	# Don't use ranlib
+	_LT_TAGVAR(old_postinstall_cmds, $1)='chmod 644 $oldlib'
+	_LT_TAGVAR(postlink_cmds, $1)='lt_outputfile="@OUTPUT@"~
+          lt_tool_outputfile="@TOOL_OUTPUT@"~
+          case $lt_outputfile in
+            *.exe|*.EXE) ;;
+            *)
+              lt_outputfile=$lt_outputfile.exe
+              lt_tool_outputfile=$lt_tool_outputfile.exe
+              ;;
+          esac~
+          if test : != "$MANIFEST_TOOL" && test -f "$lt_outputfile.manifest"; then
+            $MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1;
+            $RM "$lt_outputfile.manifest";
+          fi'
+	;;
+      *)
+	# Assume MSVC wrapper
+	_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=' '
+	_LT_TAGVAR(allow_undefined_flag, $1)=unsupported
+	# Tell ltmain to make .lib files, not .a files.
+	libext=lib
+	# Tell ltmain to make .dll files, not .so files.
+	shrext_cmds=.dll
+	# FIXME: Setting linknames here is a bad hack.
+	_LT_TAGVAR(archive_cmds, $1)='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames='
+	# The linker will automatically build a .lib file if we build a DLL.
+	_LT_TAGVAR(old_archive_from_new_cmds, $1)='true'
+	# FIXME: Should let the user specify the lib program.
+	_LT_TAGVAR(old_archive_cmds, $1)='lib -OUT:$oldlib$oldobjs$old_deplibs'
+	_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
+	;;
+      esac
+      ;;
+
+    darwin* | rhapsody*)
+      _LT_DARWIN_LINKER_FEATURES($1)
+      ;;
+
+    dgux*)
+      _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      ;;
+
+    # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor
+    # support.  Future versions do this automatically, but an explicit c++rt0.o
+    # does not break anything, and helps significantly (at the cost of a little
+    # extra space).
+    freebsd2.2*)
+      _LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o'
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
+      _LT_TAGVAR(hardcode_direct, $1)=yes
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      ;;
+
+    # Unfortunately, older versions of FreeBSD 2 do not have this feature.
+    freebsd2.*)
+      _LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+      _LT_TAGVAR(hardcode_direct, $1)=yes
+      _LT_TAGVAR(hardcode_minus_L, $1)=yes
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      ;;
+
+    # FreeBSD 3 and greater uses gcc -shared to do shared libraries.
+    freebsd* | dragonfly*)
+      _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
+      _LT_TAGVAR(hardcode_direct, $1)=yes
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      ;;
+
+    hpux9*)
+      if test yes = "$GCC"; then
+	_LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$CC -shared $pic_flag $wl+b $wl$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib'
+      else
+	_LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib'
+      fi
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl+b $wl$libdir'
+      _LT_TAGVAR(hardcode_libdir_separator, $1)=:
+      _LT_TAGVAR(hardcode_direct, $1)=yes
+
+      # hardcode_minus_L: Not really in the search PATH,
+      # but as the default location of the library.
+      _LT_TAGVAR(hardcode_minus_L, $1)=yes
+      _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E'
+      ;;
+
+    hpux10*)
+      if test yes,no = "$GCC,$with_gnu_ld"; then
+	_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
+      else
+	_LT_TAGVAR(archive_cmds, $1)='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags'
+      fi
+      if test no = "$with_gnu_ld"; then
+	_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl+b $wl$libdir'
+	_LT_TAGVAR(hardcode_libdir_separator, $1)=:
+	_LT_TAGVAR(hardcode_direct, $1)=yes
+	_LT_TAGVAR(hardcode_direct_absolute, $1)=yes
+	_LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E'
+	# hardcode_minus_L: Not really in the search PATH,
+	# but as the default location of the library.
+	_LT_TAGVAR(hardcode_minus_L, $1)=yes
+      fi
+      ;;
+
+    hpux11*)
+      if test yes,no = "$GCC,$with_gnu_ld"; then
+	case $host_cpu in
+	hppa*64*)
+	  _LT_TAGVAR(archive_cmds, $1)='$CC -shared $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	ia64*)
+	  _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	*)
+	  _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	esac
+      else
+	case $host_cpu in
+	hppa*64*)
+	  _LT_TAGVAR(archive_cmds, $1)='$CC -b $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	ia64*)
+	  _LT_TAGVAR(archive_cmds, $1)='$CC -b $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	*)
+	m4_if($1, [], [
+	  # Older versions of the 11.00 compiler do not understand -b yet
+	  # (HP92453-01 A.11.01.20 doesn't, HP92453-01 B.11.X.35175-35176.GP does)
+	  _LT_LINKER_OPTION([if $CC understands -b],
+	    _LT_TAGVAR(lt_cv_prog_compiler__b, $1), [-b],
+	    [_LT_TAGVAR(archive_cmds, $1)='$CC -b $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags'],
+	    [_LT_TAGVAR(archive_cmds, $1)='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags'])],
+	  [_LT_TAGVAR(archive_cmds, $1)='$CC -b $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags'])
+	  ;;
+	esac
+      fi
+      if test no = "$with_gnu_ld"; then
+	_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl+b $wl$libdir'
+	_LT_TAGVAR(hardcode_libdir_separator, $1)=:
+
+	case $host_cpu in
+	hppa*64*|ia64*)
+	  _LT_TAGVAR(hardcode_direct, $1)=no
+	  _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+	  ;;
+	*)
+	  _LT_TAGVAR(hardcode_direct, $1)=yes
+	  _LT_TAGVAR(hardcode_direct_absolute, $1)=yes
+	  _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E'
+
+	  # hardcode_minus_L: Not really in the search PATH,
+	  # but as the default location of the library.
+	  _LT_TAGVAR(hardcode_minus_L, $1)=yes
+	  ;;
+	esac
+      fi
+      ;;
+
+    irix5* | irix6* | nonstopux*)
+      if test yes = "$GCC"; then
+	_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib'
+	# Try to use the -exported_symbol ld option, if it does not
+	# work, assume that -exports_file does not work either and
+	# implicitly export all symbols.
+	# This should be the same for all languages, so no per-tag cache variable.
+	AC_CACHE_CHECK([whether the $host_os linker accepts -exported_symbol],
+	  [lt_cv_irix_exported_symbol],
+	  [save_LDFLAGS=$LDFLAGS
+	   LDFLAGS="$LDFLAGS -shared $wl-exported_symbol ${wl}foo $wl-update_registry $wl/dev/null"
+	   AC_LINK_IFELSE(
+	     [AC_LANG_SOURCE(
+	        [AC_LANG_CASE([C], [[int foo (void) { return 0; }]],
+			      [C++], [[int foo (void) { return 0; }]],
+			      [Fortran 77], [[
+      subroutine foo
+      end]],
+			      [Fortran], [[
+      subroutine foo
+      end]])])],
+	      [lt_cv_irix_exported_symbol=yes],
+	      [lt_cv_irix_exported_symbol=no])
+           LDFLAGS=$save_LDFLAGS])
+	if test yes = "$lt_cv_irix_exported_symbol"; then
+          _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations $wl-exports_file $wl$export_symbols -o $lib'
+	fi
+	_LT_TAGVAR(link_all_deplibs, $1)=no
+      else
+	_LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib'
+	_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -exports_file $export_symbols -o $lib'
+      fi
+      _LT_TAGVAR(archive_cmds_need_lc, $1)='no'
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir'
+      _LT_TAGVAR(hardcode_libdir_separator, $1)=:
+      _LT_TAGVAR(inherit_rpath, $1)=yes
+      _LT_TAGVAR(link_all_deplibs, $1)=yes
+      ;;
+
+    linux*)
+      case $cc_basename in
+      tcc*)
+	# Fabrice Bellard et al's Tiny C Compiler
+	_LT_TAGVAR(ld_shlibs, $1)=yes
+	_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
+	;;
+      esac
+      ;;
+
+    netbsd* | netbsdelf*-gnu)
+      if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
+	_LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'  # a.out
+      else
+	_LT_TAGVAR(archive_cmds, $1)='$LD -shared -o $lib $libobjs $deplibs $linker_flags'      # ELF
+      fi
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
+      _LT_TAGVAR(hardcode_direct, $1)=yes
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      ;;
+
+    newsos6)
+      _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+      _LT_TAGVAR(hardcode_direct, $1)=yes
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir'
+      _LT_TAGVAR(hardcode_libdir_separator, $1)=:
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      ;;
+
+    *nto* | *qnx*)
+      ;;
+
+    openbsd* | bitrig*)
+      if test -f /usr/libexec/ld.so; then
+	_LT_TAGVAR(hardcode_direct, $1)=yes
+	_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+	_LT_TAGVAR(hardcode_direct_absolute, $1)=yes
+	if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then
+	  _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
+	  _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags $wl-retain-symbols-file,$export_symbols'
+	  _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir'
+	  _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E'
+	else
+	  _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
+	  _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir'
+	fi
+      else
+	_LT_TAGVAR(ld_shlibs, $1)=no
+      fi
+      ;;
+
+    os2*)
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
+      _LT_TAGVAR(hardcode_minus_L, $1)=yes
+      _LT_TAGVAR(allow_undefined_flag, $1)=unsupported
+      shrext_cmds=.dll
+      _LT_TAGVAR(archive_cmds, $1)='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~
+	$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~
+	$ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~
+	$ECHO EXPORTS >> $output_objdir/$libname.def~
+	emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~
+	$CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~
+	emximp -o $lib $output_objdir/$libname.def'
+      _LT_TAGVAR(archive_expsym_cmds, $1)='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~
+	$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~
+	$ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~
+	$ECHO EXPORTS >> $output_objdir/$libname.def~
+	prefix_cmds="$SED"~
+	if test EXPORTS = "`$SED 1q $export_symbols`"; then
+	  prefix_cmds="$prefix_cmds -e 1d";
+	fi~
+	prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~
+	cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~
+	$CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~
+	emximp -o $lib $output_objdir/$libname.def'
+      _LT_TAGVAR(old_archive_From_new_cmds, $1)='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def'
+      _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
+      ;;
+
+    osf3*)
+      if test yes = "$GCC"; then
+	_LT_TAGVAR(allow_undefined_flag, $1)=' $wl-expect_unresolved $wl\*'
+	_LT_TAGVAR(archive_cmds, $1)='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib'
+      else
+	_LT_TAGVAR(allow_undefined_flag, $1)=' -expect_unresolved \*'
+	_LT_TAGVAR(archive_cmds, $1)='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib'
+      fi
+      _LT_TAGVAR(archive_cmds_need_lc, $1)='no'
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir'
+      _LT_TAGVAR(hardcode_libdir_separator, $1)=:
+      ;;
+
+    osf4* | osf5*)	# as osf3* with the addition of -msym flag
+      if test yes = "$GCC"; then
+	_LT_TAGVAR(allow_undefined_flag, $1)=' $wl-expect_unresolved $wl\*'
+	_LT_TAGVAR(archive_cmds, $1)='$CC -shared$allow_undefined_flag $pic_flag $libobjs $deplibs $compiler_flags $wl-msym $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib'
+	_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir'
+      else
+	_LT_TAGVAR(allow_undefined_flag, $1)=' -expect_unresolved \*'
+	_LT_TAGVAR(archive_cmds, $1)='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib'
+	_LT_TAGVAR(archive_expsym_cmds, $1)='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~
+          $CC -shared$allow_undefined_flag $wl-input $wl$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib~$RM $lib.exp'
+
+	# Both c and cxx compiler support -rpath directly
+	_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-rpath $libdir'
+      fi
+      _LT_TAGVAR(archive_cmds_need_lc, $1)='no'
+      _LT_TAGVAR(hardcode_libdir_separator, $1)=:
+      ;;
+
+    solaris*)
+      _LT_TAGVAR(no_undefined_flag, $1)=' -z defs'
+      if test yes = "$GCC"; then
+	wlarc='$wl'
+	_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $wl-z ${wl}text $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags'
+	_LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
+          $CC -shared $pic_flag $wl-z ${wl}text $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp'
+      else
+	case `$CC -V 2>&1` in
+	*"Compilers 5.0"*)
+	  wlarc=''
+	  _LT_TAGVAR(archive_cmds, $1)='$LD -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $linker_flags'
+	  _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
+            $LD -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp'
+	  ;;
+	*)
+	  wlarc='$wl'
+	  _LT_TAGVAR(archive_cmds, $1)='$CC -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $compiler_flags'
+	  _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
+            $CC -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp'
+	  ;;
+	esac
+      fi
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      case $host_os in
+      solaris2.[[0-5]] | solaris2.[[0-5]].*) ;;
+      *)
+	# The compiler driver will combine and reorder linker options,
+	# but understands '-z linker_flag'.  GCC discards it without '$wl',
+	# but is careful enough not to reorder.
+	# Supported since Solaris 2.6 (maybe 2.5.1?)
+	if test yes = "$GCC"; then
+	  _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl-z ${wl}allextract$convenience $wl-z ${wl}defaultextract'
+	else
+	  _LT_TAGVAR(whole_archive_flag_spec, $1)='-z allextract$convenience -z defaultextract'
+	fi
+	;;
+      esac
+      _LT_TAGVAR(link_all_deplibs, $1)=yes
+      ;;
+
+    sunos4*)
+      if test sequent = "$host_vendor"; then
+	# Use $CC to link under sequent, because it throws in some extra .o
+	# files that make .init and .fini sections work.
+	_LT_TAGVAR(archive_cmds, $1)='$CC -G $wl-h $soname -o $lib $libobjs $deplibs $compiler_flags'
+      else
+	_LT_TAGVAR(archive_cmds, $1)='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags'
+      fi
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
+      _LT_TAGVAR(hardcode_direct, $1)=yes
+      _LT_TAGVAR(hardcode_minus_L, $1)=yes
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      ;;
+
+    sysv4)
+      case $host_vendor in
+	sni)
+	  _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+	  _LT_TAGVAR(hardcode_direct, $1)=yes # is this really true???
+	;;
+	siemens)
+	  ## LD is ld it makes a PLAMLIB
+	  ## CC just makes a GrossModule.
+	  _LT_TAGVAR(archive_cmds, $1)='$LD -G -o $lib $libobjs $deplibs $linker_flags'
+	  _LT_TAGVAR(reload_cmds, $1)='$CC -r -o $output$reload_objs'
+	  _LT_TAGVAR(hardcode_direct, $1)=no
+        ;;
+	motorola)
+	  _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+	  _LT_TAGVAR(hardcode_direct, $1)=no #Motorola manual says yes, but my tests say they lie
+	;;
+      esac
+      runpath_var='LD_RUN_PATH'
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      ;;
+
+    sysv4.3*)
+      _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      _LT_TAGVAR(export_dynamic_flag_spec, $1)='-Bexport'
+      ;;
+
+    sysv4*MP*)
+      if test -d /usr/nec; then
+	_LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+	_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+	runpath_var=LD_RUN_PATH
+	hardcode_runpath_var=yes
+	_LT_TAGVAR(ld_shlibs, $1)=yes
+      fi
+      ;;
+
+    sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[[01]].[[10]]* | unixware7* | sco3.2v5.0.[[024]]*)
+      _LT_TAGVAR(no_undefined_flag, $1)='$wl-z,text'
+      _LT_TAGVAR(archive_cmds_need_lc, $1)=no
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      runpath_var='LD_RUN_PATH'
+
+      if test yes = "$GCC"; then
+	_LT_TAGVAR(archive_cmds, $1)='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+      else
+	_LT_TAGVAR(archive_cmds, $1)='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+      fi
+      ;;
+
+    sysv5* | sco3.2v5* | sco5v6*)
+      # Note: We CANNOT use -z defs as we might desire, because we do not
+      # link with -lc, and that would cause any symbols used from libc to
+      # always be unresolved, which means just about no library would
+      # ever link correctly.  If we're not using GNU ld we use -z text
+      # though, which does catch some bad symbols but isn't as heavy-handed
+      # as -z defs.
+      _LT_TAGVAR(no_undefined_flag, $1)='$wl-z,text'
+      _LT_TAGVAR(allow_undefined_flag, $1)='$wl-z,nodefs'
+      _LT_TAGVAR(archive_cmds_need_lc, $1)=no
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-R,$libdir'
+      _LT_TAGVAR(hardcode_libdir_separator, $1)=':'
+      _LT_TAGVAR(link_all_deplibs, $1)=yes
+      _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-Bexport'
+      runpath_var='LD_RUN_PATH'
+
+      if test yes = "$GCC"; then
+	_LT_TAGVAR(archive_cmds, $1)='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+      else
+	_LT_TAGVAR(archive_cmds, $1)='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+      fi
+      ;;
+
+    uts4*)
+      _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      ;;
+
+    *)
+      _LT_TAGVAR(ld_shlibs, $1)=no
+      ;;
+    esac
+
+    if test sni = "$host_vendor"; then
+      case $host in
+      sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
+	_LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-Blargedynsym'
+	;;
+      esac
+    fi
+  fi
+])
+AC_MSG_RESULT([$_LT_TAGVAR(ld_shlibs, $1)])
+test no = "$_LT_TAGVAR(ld_shlibs, $1)" && can_build_shared=no
+
+_LT_TAGVAR(with_gnu_ld, $1)=$with_gnu_ld
+
+_LT_DECL([], [libext], [0], [Old archive suffix (normally "a")])dnl
+_LT_DECL([], [shrext_cmds], [1], [Shared library suffix (normally ".so")])dnl
+_LT_DECL([], [extract_expsyms_cmds], [2],
+    [The commands to extract the exported symbol list from a shared archive])
+
+#
+# Do we need to explicitly link libc?
+#
+case "x$_LT_TAGVAR(archive_cmds_need_lc, $1)" in
+x|xyes)
+  # Assume -lc should be added
+  _LT_TAGVAR(archive_cmds_need_lc, $1)=yes
+
+  if test yes,yes = "$GCC,$enable_shared"; then
+    case $_LT_TAGVAR(archive_cmds, $1) in
+    *'~'*)
+      # FIXME: we may have to deal with multi-command sequences.
+      ;;
+    '$CC '*)
+      # Test whether the compiler implicitly links with -lc since on some
+      # systems, -lgcc has to come before -lc. If gcc already passes -lc
+      # to ld, don't add -lc before -lgcc.
+      AC_CACHE_CHECK([whether -lc should be explicitly linked in],
+	[lt_cv_]_LT_TAGVAR(archive_cmds_need_lc, $1),
+	[$RM conftest*
+	echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+
+	if AC_TRY_EVAL(ac_compile) 2>conftest.err; then
+	  soname=conftest
+	  lib=conftest
+	  libobjs=conftest.$ac_objext
+	  deplibs=
+	  wl=$_LT_TAGVAR(lt_prog_compiler_wl, $1)
+	  pic_flag=$_LT_TAGVAR(lt_prog_compiler_pic, $1)
+	  compiler_flags=-v
+	  linker_flags=-v
+	  verstring=
+	  output_objdir=.
+	  libname=conftest
+	  lt_save_allow_undefined_flag=$_LT_TAGVAR(allow_undefined_flag, $1)
+	  _LT_TAGVAR(allow_undefined_flag, $1)=
+	  if AC_TRY_EVAL(_LT_TAGVAR(archive_cmds, $1) 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1)
+	  then
+	    lt_cv_[]_LT_TAGVAR(archive_cmds_need_lc, $1)=no
+	  else
+	    lt_cv_[]_LT_TAGVAR(archive_cmds_need_lc, $1)=yes
+	  fi
+	  _LT_TAGVAR(allow_undefined_flag, $1)=$lt_save_allow_undefined_flag
+	else
+	  cat conftest.err 1>&5
+	fi
+	$RM conftest*
+	])
+      _LT_TAGVAR(archive_cmds_need_lc, $1)=$lt_cv_[]_LT_TAGVAR(archive_cmds_need_lc, $1)
+      ;;
+    esac
+  fi
+  ;;
+esac
+
+_LT_TAGDECL([build_libtool_need_lc], [archive_cmds_need_lc], [0],
+    [Whether or not to add -lc for building shared libraries])
+_LT_TAGDECL([allow_libtool_libs_with_static_runtimes],
+    [enable_shared_with_static_runtimes], [0],
+    [Whether or not to disallow shared libs when runtime libs are static])
+_LT_TAGDECL([], [export_dynamic_flag_spec], [1],
+    [Compiler flag to allow reflexive dlopens])
+_LT_TAGDECL([], [whole_archive_flag_spec], [1],
+    [Compiler flag to generate shared objects directly from archives])
+_LT_TAGDECL([], [compiler_needs_object], [1],
+    [Whether the compiler copes with passing no objects directly])
+_LT_TAGDECL([], [old_archive_from_new_cmds], [2],
+    [Create an old-style archive from a shared archive])
+_LT_TAGDECL([], [old_archive_from_expsyms_cmds], [2],
+    [Create a temporary old-style archive to link instead of a shared archive])
+_LT_TAGDECL([], [archive_cmds], [2], [Commands used to build a shared archive])
+_LT_TAGDECL([], [archive_expsym_cmds], [2])
+_LT_TAGDECL([], [module_cmds], [2],
+    [Commands used to build a loadable module if different from building
+    a shared archive.])
+_LT_TAGDECL([], [module_expsym_cmds], [2])
+_LT_TAGDECL([], [with_gnu_ld], [1],
+    [Whether we are building with GNU ld or not])
+_LT_TAGDECL([], [allow_undefined_flag], [1],
+    [Flag that allows shared libraries with undefined symbols to be built])
+_LT_TAGDECL([], [no_undefined_flag], [1],
+    [Flag that enforces no undefined symbols])
+_LT_TAGDECL([], [hardcode_libdir_flag_spec], [1],
+    [Flag to hardcode $libdir into a binary during linking.
+    This must work even if $libdir does not exist])
+_LT_TAGDECL([], [hardcode_libdir_separator], [1],
+    [Whether we need a single "-rpath" flag with a separated argument])
+_LT_TAGDECL([], [hardcode_direct], [0],
+    [Set to "yes" if using DIR/libNAME$shared_ext during linking hardcodes
+    DIR into the resulting binary])
+_LT_TAGDECL([], [hardcode_direct_absolute], [0],
+    [Set to "yes" if using DIR/libNAME$shared_ext during linking hardcodes
+    DIR into the resulting binary and the resulting library dependency is
+    "absolute", i.e impossible to change by setting $shlibpath_var if the
+    library is relocated])
+_LT_TAGDECL([], [hardcode_minus_L], [0],
+    [Set to "yes" if using the -LDIR flag during linking hardcodes DIR
+    into the resulting binary])
+_LT_TAGDECL([], [hardcode_shlibpath_var], [0],
+    [Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR
+    into the resulting binary])
+_LT_TAGDECL([], [hardcode_automatic], [0],
+    [Set to "yes" if building a shared library automatically hardcodes DIR
+    into the library and all subsequent libraries and executables linked
+    against it])
+_LT_TAGDECL([], [inherit_rpath], [0],
+    [Set to yes if linker adds runtime paths of dependent libraries
+    to runtime path list])
+_LT_TAGDECL([], [link_all_deplibs], [0],
+    [Whether libtool must link a program against all its dependency libraries])
+_LT_TAGDECL([], [always_export_symbols], [0],
+    [Set to "yes" if exported symbols are required])
+_LT_TAGDECL([], [export_symbols_cmds], [2],
+    [The commands to list exported symbols])
+_LT_TAGDECL([], [exclude_expsyms], [1],
+    [Symbols that should not be listed in the preloaded symbols])
+_LT_TAGDECL([], [include_expsyms], [1],
+    [Symbols that must always be exported])
+_LT_TAGDECL([], [prelink_cmds], [2],
+    [Commands necessary for linking programs (against libraries) with templates])
+_LT_TAGDECL([], [postlink_cmds], [2],
+    [Commands necessary for finishing linking programs])
+_LT_TAGDECL([], [file_list_spec], [1],
+    [Specify filename containing input files])
+dnl FIXME: Not yet implemented
+dnl _LT_TAGDECL([], [thread_safe_flag_spec], [1],
+dnl    [Compiler flag to generate thread safe objects])
+])# _LT_LINKER_SHLIBS
+
+
+# _LT_LANG_C_CONFIG([TAG])
+# ------------------------
+# Ensure that the configuration variables for a C compiler are suitably
+# defined.  These variables are subsequently used by _LT_CONFIG to write
+# the compiler configuration to 'libtool'.
+m4_defun([_LT_LANG_C_CONFIG],
+[m4_require([_LT_DECL_EGREP])dnl
+lt_save_CC=$CC
+AC_LANG_PUSH(C)
+
+# Source file extension for C test sources.
+ac_ext=c
+
+# Object file extension for compiled C test sources.
+objext=o
+_LT_TAGVAR(objext, $1)=$objext
+
+# Code to be used in simple compile tests
+lt_simple_compile_test_code="int some_variable = 0;"
+
+# Code to be used in simple link tests
+lt_simple_link_test_code='int main(){return(0);}'
+
+_LT_TAG_COMPILER
+# Save the default compiler, since it gets overwritten when the other
+# tags are being tested, and _LT_TAGVAR(compiler, []) is a NOP.
+compiler_DEFAULT=$CC
+
+# save warnings/boilerplate of simple test code
+_LT_COMPILER_BOILERPLATE
+_LT_LINKER_BOILERPLATE
+
+## CAVEAT EMPTOR:
+## There is no encapsulation within the following macros, do not change
+## the running order or otherwise move them around unless you know exactly
+## what you are doing...
+if test -n "$compiler"; then
+  _LT_COMPILER_NO_RTTI($1)
+  _LT_COMPILER_PIC($1)
+  _LT_COMPILER_C_O($1)
+  _LT_COMPILER_FILE_LOCKS($1)
+  _LT_LINKER_SHLIBS($1)
+  _LT_SYS_DYNAMIC_LINKER($1)
+  _LT_LINKER_HARDCODE_LIBPATH($1)
+  LT_SYS_DLOPEN_SELF
+  _LT_CMD_STRIPLIB
+
+  # Report what library types will actually be built
+  AC_MSG_CHECKING([if libtool supports shared libraries])
+  AC_MSG_RESULT([$can_build_shared])
+
+  AC_MSG_CHECKING([whether to build shared libraries])
+  test no = "$can_build_shared" && enable_shared=no
+
+  # On AIX, shared libraries and static libraries use the same namespace, and
+  # are all built from PIC.
+  case $host_os in
+  aix3*)
+    test yes = "$enable_shared" && enable_static=no
+    if test -n "$RANLIB"; then
+      archive_cmds="$archive_cmds~\$RANLIB \$lib"
+      postinstall_cmds='$RANLIB $lib'
+    fi
+    ;;
+
+  aix[[4-9]]*)
+    if test ia64 != "$host_cpu"; then
+      case $enable_shared,$with_aix_soname,$aix_use_runtimelinking in
+      yes,aix,yes) ;;			# shared object as lib.so file only
+      yes,svr4,*) ;;			# shared object as lib.so archive member only
+      yes,*) enable_static=no ;;	# shared object in lib.a archive as well
+      esac
+    fi
+    ;;
+  esac
+  AC_MSG_RESULT([$enable_shared])
+
+  AC_MSG_CHECKING([whether to build static libraries])
+  # Make sure either enable_shared or enable_static is yes.
+  test yes = "$enable_shared" || enable_static=yes
+  AC_MSG_RESULT([$enable_static])
+
+  _LT_CONFIG($1)
+fi
+AC_LANG_POP
+CC=$lt_save_CC
+])# _LT_LANG_C_CONFIG
+
+
+# _LT_LANG_CXX_CONFIG([TAG])
+# --------------------------
+# Ensure that the configuration variables for a C++ compiler are suitably
+# defined.  These variables are subsequently used by _LT_CONFIG to write
+# the compiler configuration to 'libtool'.
+m4_defun([_LT_LANG_CXX_CONFIG],
+[m4_require([_LT_FILEUTILS_DEFAULTS])dnl
+m4_require([_LT_DECL_EGREP])dnl
+m4_require([_LT_PATH_MANIFEST_TOOL])dnl
+if test -n "$CXX" && ( test no != "$CXX" &&
+    ( (test g++ = "$CXX" && `g++ -v >/dev/null 2>&1` ) ||
+    (test g++ != "$CXX"))); then
+  AC_PROG_CXXCPP
+else
+  _lt_caught_CXX_error=yes
+fi
+
+AC_LANG_PUSH(C++)
+_LT_TAGVAR(archive_cmds_need_lc, $1)=no
+_LT_TAGVAR(allow_undefined_flag, $1)=
+_LT_TAGVAR(always_export_symbols, $1)=no
+_LT_TAGVAR(archive_expsym_cmds, $1)=
+_LT_TAGVAR(compiler_needs_object, $1)=no
+_LT_TAGVAR(export_dynamic_flag_spec, $1)=
+_LT_TAGVAR(hardcode_direct, $1)=no
+_LT_TAGVAR(hardcode_direct_absolute, $1)=no
+_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
+_LT_TAGVAR(hardcode_libdir_separator, $1)=
+_LT_TAGVAR(hardcode_minus_L, $1)=no
+_LT_TAGVAR(hardcode_shlibpath_var, $1)=unsupported
+_LT_TAGVAR(hardcode_automatic, $1)=no
+_LT_TAGVAR(inherit_rpath, $1)=no
+_LT_TAGVAR(module_cmds, $1)=
+_LT_TAGVAR(module_expsym_cmds, $1)=
+_LT_TAGVAR(link_all_deplibs, $1)=unknown
+_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds
+_LT_TAGVAR(reload_flag, $1)=$reload_flag
+_LT_TAGVAR(reload_cmds, $1)=$reload_cmds
+_LT_TAGVAR(no_undefined_flag, $1)=
+_LT_TAGVAR(whole_archive_flag_spec, $1)=
+_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no
+
+# Source file extension for C++ test sources.
+ac_ext=cpp
+
+# Object file extension for compiled C++ test sources.
+objext=o
+_LT_TAGVAR(objext, $1)=$objext
+
+# No sense in running all these tests if we already determined that
+# the CXX compiler isn't working.  Some variables (like enable_shared)
+# are currently assumed to apply to all compilers on this platform,
+# and will be corrupted by setting them based on a non-working compiler.
+if test yes != "$_lt_caught_CXX_error"; then
+  # Code to be used in simple compile tests
+  lt_simple_compile_test_code="int some_variable = 0;"
+
+  # Code to be used in simple link tests
+  lt_simple_link_test_code='int main(int, char *[[]]) { return(0); }'
+
+  # ltmain only uses $CC for tagged configurations so make sure $CC is set.
+  _LT_TAG_COMPILER
+
+  # save warnings/boilerplate of simple test code
+  _LT_COMPILER_BOILERPLATE
+  _LT_LINKER_BOILERPLATE
+
+  # Allow CC to be a program name with arguments.
+  lt_save_CC=$CC
+  lt_save_CFLAGS=$CFLAGS
+  lt_save_LD=$LD
+  lt_save_GCC=$GCC
+  GCC=$GXX
+  lt_save_with_gnu_ld=$with_gnu_ld
+  lt_save_path_LD=$lt_cv_path_LD
+  if test -n "${lt_cv_prog_gnu_ldcxx+set}"; then
+    lt_cv_prog_gnu_ld=$lt_cv_prog_gnu_ldcxx
+  else
+    $as_unset lt_cv_prog_gnu_ld
+  fi
+  if test -n "${lt_cv_path_LDCXX+set}"; then
+    lt_cv_path_LD=$lt_cv_path_LDCXX
+  else
+    $as_unset lt_cv_path_LD
+  fi
+  test -z "${LDCXX+set}" || LD=$LDCXX
+  CC=${CXX-"c++"}
+  CFLAGS=$CXXFLAGS
+  compiler=$CC
+  _LT_TAGVAR(compiler, $1)=$CC
+  _LT_CC_BASENAME([$compiler])
+
+  if test -n "$compiler"; then
+    # We don't want -fno-exception when compiling C++ code, so set the
+    # no_builtin_flag separately
+    if test yes = "$GXX"; then
+      _LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=' -fno-builtin'
+    else
+      _LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=
+    fi
+
+    if test yes = "$GXX"; then
+      # Set up default GNU C++ configuration
+
+      LT_PATH_LD
+
+      # Check if GNU C++ uses GNU ld as the underlying linker, since the
+      # archiving commands below assume that GNU ld is being used.
+      if test yes = "$with_gnu_ld"; then
+        _LT_TAGVAR(archive_cmds, $1)='$CC $pic_flag -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib'
+        _LT_TAGVAR(archive_expsym_cmds, $1)='$CC $pic_flag -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib'
+
+        _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir'
+        _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-dynamic'
+
+        # If archive_cmds runs LD, not CC, wlarc should be empty
+        # XXX I think wlarc can be eliminated in ltcf-cxx, but I need to
+        #     investigate it a little bit more. (MM)
+        wlarc='$wl'
+
+        # ancient GNU ld didn't support --whole-archive et. al.
+        if eval "`$CC -print-prog-name=ld` --help 2>&1" |
+	  $GREP 'no-whole-archive' > /dev/null; then
+          _LT_TAGVAR(whole_archive_flag_spec, $1)=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive'
+        else
+          _LT_TAGVAR(whole_archive_flag_spec, $1)=
+        fi
+      else
+        with_gnu_ld=no
+        wlarc=
+
+        # A generic and very simple default shared library creation
+        # command for GNU C++ for the case where it uses the native
+        # linker, instead of GNU ld.  If possible, this setting should
+        # overridden to take advantage of the native linker features on
+        # the platform it is being used on.
+        _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib'
+      fi
+
+      # Commands to make compiler produce verbose output that lists
+      # what "hidden" libraries, object files and flags are used when
+      # linking a shared library.
+      output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"'
+
+    else
+      GXX=no
+      with_gnu_ld=no
+      wlarc=
+    fi
+
+    # PORTME: fill in a description of your system's C++ link characteristics
+    AC_MSG_CHECKING([whether the $compiler linker ($LD) supports shared libraries])
+    _LT_TAGVAR(ld_shlibs, $1)=yes
+    case $host_os in
+      aix3*)
+        # FIXME: insert proper C++ library support
+        _LT_TAGVAR(ld_shlibs, $1)=no
+        ;;
+      aix[[4-9]]*)
+        if test ia64 = "$host_cpu"; then
+          # On IA64, the linker does run time linking by default, so we don't
+          # have to do anything special.
+          aix_use_runtimelinking=no
+          exp_sym_flag='-Bexport'
+          no_entry_flag=
+        else
+          aix_use_runtimelinking=no
+
+          # Test if we are trying to use run time linking or normal
+          # AIX style linking. If -brtl is somewhere in LDFLAGS, we
+          # have runtime linking enabled, and use it for executables.
+          # For shared libraries, we enable/disable runtime linking
+          # depending on the kind of the shared library created -
+          # when "with_aix_soname,aix_use_runtimelinking" is:
+          # "aix,no"   lib.a(lib.so.V) shared, rtl:no,  for executables
+          # "aix,yes"  lib.so          shared, rtl:yes, for executables
+          #            lib.a           static archive
+          # "both,no"  lib.so.V(shr.o) shared, rtl:yes
+          #            lib.a(lib.so.V) shared, rtl:no,  for executables
+          # "both,yes" lib.so.V(shr.o) shared, rtl:yes, for executables
+          #            lib.a(lib.so.V) shared, rtl:no
+          # "svr4,*"   lib.so.V(shr.o) shared, rtl:yes, for executables
+          #            lib.a           static archive
+          case $host_os in aix4.[[23]]|aix4.[[23]].*|aix[[5-9]]*)
+	    for ld_flag in $LDFLAGS; do
+	      case $ld_flag in
+	      *-brtl*)
+	        aix_use_runtimelinking=yes
+	        break
+	        ;;
+	      esac
+	    done
+	    if test svr4,no = "$with_aix_soname,$aix_use_runtimelinking"; then
+	      # With aix-soname=svr4, we create the lib.so.V shared archives only,
+	      # so we don't have lib.a shared libs to link our executables.
+	      # We have to force runtime linking in this case.
+	      aix_use_runtimelinking=yes
+	      LDFLAGS="$LDFLAGS -Wl,-brtl"
+	    fi
+	    ;;
+          esac
+
+          exp_sym_flag='-bexport'
+          no_entry_flag='-bnoentry'
+        fi
+
+        # When large executables or shared objects are built, AIX ld can
+        # have problems creating the table of contents.  If linking a library
+        # or program results in "error TOC overflow" add -mminimal-toc to
+        # CXXFLAGS/CFLAGS for g++/gcc.  In the cases where that is not
+        # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS.
+
+        _LT_TAGVAR(archive_cmds, $1)=''
+        _LT_TAGVAR(hardcode_direct, $1)=yes
+        _LT_TAGVAR(hardcode_direct_absolute, $1)=yes
+        _LT_TAGVAR(hardcode_libdir_separator, $1)=':'
+        _LT_TAGVAR(link_all_deplibs, $1)=yes
+        _LT_TAGVAR(file_list_spec, $1)='$wl-f,'
+        case $with_aix_soname,$aix_use_runtimelinking in
+        aix,*) ;;	# no import file
+        svr4,* | *,yes) # use import file
+          # The Import File defines what to hardcode.
+          _LT_TAGVAR(hardcode_direct, $1)=no
+          _LT_TAGVAR(hardcode_direct_absolute, $1)=no
+          ;;
+        esac
+
+        if test yes = "$GXX"; then
+          case $host_os in aix4.[[012]]|aix4.[[012]].*)
+          # We only want to do this on AIX 4.2 and lower, the check
+          # below for broken collect2 doesn't work under 4.3+
+	  collect2name=`$CC -print-prog-name=collect2`
+	  if test -f "$collect2name" &&
+	     strings "$collect2name" | $GREP resolve_lib_name >/dev/null
+	  then
+	    # We have reworked collect2
+	    :
+	  else
+	    # We have old collect2
+	    _LT_TAGVAR(hardcode_direct, $1)=unsupported
+	    # It fails to find uninstalled libraries when the uninstalled
+	    # path is not listed in the libpath.  Setting hardcode_minus_L
+	    # to unsupported forces relinking
+	    _LT_TAGVAR(hardcode_minus_L, $1)=yes
+	    _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
+	    _LT_TAGVAR(hardcode_libdir_separator, $1)=
+	  fi
+          esac
+          shared_flag='-shared'
+	  if test yes = "$aix_use_runtimelinking"; then
+	    shared_flag=$shared_flag' $wl-G'
+	  fi
+	  # Need to ensure runtime linking is disabled for the traditional
+	  # shared library, or the linker may eventually find shared libraries
+	  # /with/ Import File - we do not want to mix them.
+	  shared_flag_aix='-shared'
+	  shared_flag_svr4='-shared $wl-G'
+        else
+          # not using gcc
+          if test ia64 = "$host_cpu"; then
+	  # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release
+	  # chokes on -Wl,-G. The following line is correct:
+	  shared_flag='-G'
+          else
+	    if test yes = "$aix_use_runtimelinking"; then
+	      shared_flag='$wl-G'
+	    else
+	      shared_flag='$wl-bM:SRE'
+	    fi
+	    shared_flag_aix='$wl-bM:SRE'
+	    shared_flag_svr4='$wl-G'
+          fi
+        fi
+
+        _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-bexpall'
+        # It seems that -bexpall does not export symbols beginning with
+        # underscore (_), so it is better to generate a list of symbols to
+	# export.
+        _LT_TAGVAR(always_export_symbols, $1)=yes
+	if test aix,yes = "$with_aix_soname,$aix_use_runtimelinking"; then
+          # Warning - without using the other runtime loading flags (-brtl),
+          # -berok will link without error, but may produce a broken library.
+          # The "-G" linker flag allows undefined symbols.
+          _LT_TAGVAR(no_undefined_flag, $1)='-bernotok'
+          # Determine the default libpath from the value encoded in an empty
+          # executable.
+          _LT_SYS_MODULE_PATH_AIX([$1])
+          _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-blibpath:$libdir:'"$aix_libpath"
+
+          _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -o $output_objdir/$soname $libobjs $deplibs $wl'$no_entry_flag' $compiler_flags `if test -n "$allow_undefined_flag"; then func_echo_all "$wl$allow_undefined_flag"; else :; fi` $wl'$exp_sym_flag:\$export_symbols' '$shared_flag
+        else
+          if test ia64 = "$host_cpu"; then
+	    _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-R $libdir:/usr/lib:/lib'
+	    _LT_TAGVAR(allow_undefined_flag, $1)="-z nodefs"
+	    _LT_TAGVAR(archive_expsym_cmds, $1)="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\$wl$no_entry_flag"' $compiler_flags $wl$allow_undefined_flag '"\$wl$exp_sym_flag:\$export_symbols"
+          else
+	    # Determine the default libpath from the value encoded in an
+	    # empty executable.
+	    _LT_SYS_MODULE_PATH_AIX([$1])
+	    _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-blibpath:$libdir:'"$aix_libpath"
+	    # Warning - without using the other run time loading flags,
+	    # -berok will link without error, but may produce a broken library.
+	    _LT_TAGVAR(no_undefined_flag, $1)=' $wl-bernotok'
+	    _LT_TAGVAR(allow_undefined_flag, $1)=' $wl-berok'
+	    if test yes = "$with_gnu_ld"; then
+	      # We only use this code for GNU lds that support --whole-archive.
+	      _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive$convenience $wl--no-whole-archive'
+	    else
+	      # Exported symbols can be pulled into shared objects from archives
+	      _LT_TAGVAR(whole_archive_flag_spec, $1)='$convenience'
+	    fi
+	    _LT_TAGVAR(archive_cmds_need_lc, $1)=yes
+	    _LT_TAGVAR(archive_expsym_cmds, $1)='$RM -r $output_objdir/$realname.d~$MKDIR $output_objdir/$realname.d'
+	    # -brtl affects multiple linker settings, -berok does not and is overridden later
+	    compiler_flags_filtered='`func_echo_all "$compiler_flags " | $SED -e "s%-brtl\\([[, ]]\\)%-berok\\1%g"`'
+	    if test svr4 != "$with_aix_soname"; then
+	      # This is similar to how AIX traditionally builds its shared
+	      # libraries. Need -bnortl late, we may have -brtl in LDFLAGS.
+	      _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$CC '$shared_flag_aix' -o $output_objdir/$realname.d/$soname $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$realname.d/$soname'
+	    fi
+	    if test aix != "$with_aix_soname"; then
+	      _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$CC '$shared_flag_svr4' -o $output_objdir/$realname.d/$shared_archive_member_spec.o $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$STRIP -e $output_objdir/$realname.d/$shared_archive_member_spec.o~( func_echo_all "#! $soname($shared_archive_member_spec.o)"; if test shr_64 = "$shared_archive_member_spec"; then func_echo_all "# 64"; else func_echo_all "# 32"; fi; cat $export_symbols ) > $output_objdir/$realname.d/$shared_archive_member_spec.imp~$AR $AR_FLAGS $output_objdir/$soname $output_objdir/$realname.d/$shared_archive_member_spec.o $output_objdir/$realname.d/$shared_archive_member_spec.imp'
+	    else
+	      # used by -dlpreopen to get the symbols
+	      _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$MV  $output_objdir/$realname.d/$soname $output_objdir'
+	    fi
+	    _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$RM -r $output_objdir/$realname.d'
+          fi
+        fi
+        ;;
+
+      beos*)
+	if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
+	  _LT_TAGVAR(allow_undefined_flag, $1)=unsupported
+	  # Joseph Beckenbach  says some releases of gcc
+	  # support --undefined.  This deserves some investigation.  FIXME
+	  _LT_TAGVAR(archive_cmds, $1)='$CC -nostart $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+	else
+	  _LT_TAGVAR(ld_shlibs, $1)=no
+	fi
+	;;
+
+      chorus*)
+        case $cc_basename in
+          *)
+	  # FIXME: insert proper C++ library support
+	  _LT_TAGVAR(ld_shlibs, $1)=no
+	  ;;
+        esac
+        ;;
+
+      cygwin* | mingw* | pw32* | cegcc*)
+	case $GXX,$cc_basename in
+	,cl* | no,cl*)
+	  # Native MSVC
+	  # hardcode_libdir_flag_spec is actually meaningless, as there is
+	  # no search path for DLLs.
+	  _LT_TAGVAR(hardcode_libdir_flag_spec, $1)=' '
+	  _LT_TAGVAR(allow_undefined_flag, $1)=unsupported
+	  _LT_TAGVAR(always_export_symbols, $1)=yes
+	  _LT_TAGVAR(file_list_spec, $1)='@'
+	  # Tell ltmain to make .lib files, not .a files.
+	  libext=lib
+	  # Tell ltmain to make .dll files, not .so files.
+	  shrext_cmds=.dll
+	  # FIXME: Setting linknames here is a bad hack.
+	  _LT_TAGVAR(archive_cmds, $1)='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~linknames='
+	  _LT_TAGVAR(archive_expsym_cmds, $1)='if _LT_DLL_DEF_P([$export_symbols]); then
+              cp "$export_symbols" "$output_objdir/$soname.def";
+              echo "$tool_output_objdir$soname.def" > "$output_objdir/$soname.exp";
+            else
+              $SED -e '\''s/^/-link -EXPORT:/'\'' < $export_symbols > $output_objdir/$soname.exp;
+            fi~
+            $CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~
+            linknames='
+	  # The linker will not automatically build a static lib if we build a DLL.
+	  # _LT_TAGVAR(old_archive_from_new_cmds, $1)='true'
+	  _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
+	  # Don't use ranlib
+	  _LT_TAGVAR(old_postinstall_cmds, $1)='chmod 644 $oldlib'
+	  _LT_TAGVAR(postlink_cmds, $1)='lt_outputfile="@OUTPUT@"~
+            lt_tool_outputfile="@TOOL_OUTPUT@"~
+            case $lt_outputfile in
+              *.exe|*.EXE) ;;
+              *)
+                lt_outputfile=$lt_outputfile.exe
+                lt_tool_outputfile=$lt_tool_outputfile.exe
+                ;;
+            esac~
+            func_to_tool_file "$lt_outputfile"~
+            if test : != "$MANIFEST_TOOL" && test -f "$lt_outputfile.manifest"; then
+              $MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1;
+              $RM "$lt_outputfile.manifest";
+            fi'
+	  ;;
+	*)
+	  # g++
+	  # _LT_TAGVAR(hardcode_libdir_flag_spec, $1) is actually meaningless,
+	  # as there is no search path for DLLs.
+	  _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
+	  _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-all-symbols'
+	  _LT_TAGVAR(allow_undefined_flag, $1)=unsupported
+	  _LT_TAGVAR(always_export_symbols, $1)=no
+	  _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
+
+	  if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then
+	    _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
+	    # If the export-symbols file already is a .def file, use it as
+	    # is; otherwise, prepend EXPORTS...
+	    _LT_TAGVAR(archive_expsym_cmds, $1)='if _LT_DLL_DEF_P([$export_symbols]); then
+              cp $export_symbols $output_objdir/$soname.def;
+            else
+              echo EXPORTS > $output_objdir/$soname.def;
+              cat $export_symbols >> $output_objdir/$soname.def;
+            fi~
+            $CC -shared -nostdlib $output_objdir/$soname.def $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
+	  else
+	    _LT_TAGVAR(ld_shlibs, $1)=no
+	  fi
+	  ;;
+	esac
+	;;
+      darwin* | rhapsody*)
+        _LT_DARWIN_LINKER_FEATURES($1)
+	;;
+
+      os2*)
+	_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
+	_LT_TAGVAR(hardcode_minus_L, $1)=yes
+	_LT_TAGVAR(allow_undefined_flag, $1)=unsupported
+	shrext_cmds=.dll
+	_LT_TAGVAR(archive_cmds, $1)='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~
+	  $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~
+	  $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~
+	  $ECHO EXPORTS >> $output_objdir/$libname.def~
+	  emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~
+	  $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~
+	  emximp -o $lib $output_objdir/$libname.def'
+	_LT_TAGVAR(archive_expsym_cmds, $1)='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~
+	  $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~
+	  $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~
+	  $ECHO EXPORTS >> $output_objdir/$libname.def~
+	  prefix_cmds="$SED"~
+	  if test EXPORTS = "`$SED 1q $export_symbols`"; then
+	    prefix_cmds="$prefix_cmds -e 1d";
+	  fi~
+	  prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~
+	  cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~
+	  $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~
+	  emximp -o $lib $output_objdir/$libname.def'
+	_LT_TAGVAR(old_archive_From_new_cmds, $1)='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def'
+	_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
+	;;
+
+      dgux*)
+        case $cc_basename in
+          ec++*)
+	    # FIXME: insert proper C++ library support
+	    _LT_TAGVAR(ld_shlibs, $1)=no
+	    ;;
+          ghcx*)
+	    # Green Hills C++ Compiler
+	    # FIXME: insert proper C++ library support
+	    _LT_TAGVAR(ld_shlibs, $1)=no
+	    ;;
+          *)
+	    # FIXME: insert proper C++ library support
+	    _LT_TAGVAR(ld_shlibs, $1)=no
+	    ;;
+        esac
+        ;;
+
+      freebsd2.*)
+        # C++ shared libraries reported to be fairly broken before
+	# switch to ELF
+        _LT_TAGVAR(ld_shlibs, $1)=no
+        ;;
+
+      freebsd-elf*)
+        _LT_TAGVAR(archive_cmds_need_lc, $1)=no
+        ;;
+
+      freebsd* | dragonfly*)
+        # FreeBSD 3 and later use GNU C++ and GNU ld with standard ELF
+        # conventions
+        _LT_TAGVAR(ld_shlibs, $1)=yes
+        ;;
+
+      haiku*)
+        _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+        _LT_TAGVAR(link_all_deplibs, $1)=yes
+        ;;
+
+      hpux9*)
+        _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl+b $wl$libdir'
+        _LT_TAGVAR(hardcode_libdir_separator, $1)=:
+        _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E'
+        _LT_TAGVAR(hardcode_direct, $1)=yes
+        _LT_TAGVAR(hardcode_minus_L, $1)=yes # Not in the search PATH,
+				             # but as the default
+				             # location of the library.
+
+        case $cc_basename in
+          CC*)
+            # FIXME: insert proper C++ library support
+            _LT_TAGVAR(ld_shlibs, $1)=no
+            ;;
+          aCC*)
+            _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$CC -b $wl+b $wl$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib'
+            # Commands to make compiler produce verbose output that lists
+            # what "hidden" libraries, object files and flags are used when
+            # linking a shared library.
+            #
+            # There doesn't appear to be a way to prevent this compiler from
+            # explicitly linking system object files so we need to strip them
+            # from the output so that they don't get included in the library
+            # dependencies.
+            output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | $EGREP "\-L"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"'
+            ;;
+          *)
+            if test yes = "$GXX"; then
+              _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$CC -shared -nostdlib $pic_flag $wl+b $wl$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib'
+            else
+              # FIXME: insert proper C++ library support
+              _LT_TAGVAR(ld_shlibs, $1)=no
+            fi
+            ;;
+        esac
+        ;;
+
+      hpux10*|hpux11*)
+        if test no = "$with_gnu_ld"; then
+	  _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl+b $wl$libdir'
+	  _LT_TAGVAR(hardcode_libdir_separator, $1)=:
+
+          case $host_cpu in
+            hppa*64*|ia64*)
+              ;;
+            *)
+	      _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E'
+              ;;
+          esac
+        fi
+        case $host_cpu in
+          hppa*64*|ia64*)
+            _LT_TAGVAR(hardcode_direct, $1)=no
+            _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+            ;;
+          *)
+            _LT_TAGVAR(hardcode_direct, $1)=yes
+            _LT_TAGVAR(hardcode_direct_absolute, $1)=yes
+            _LT_TAGVAR(hardcode_minus_L, $1)=yes # Not in the search PATH,
+					         # but as the default
+					         # location of the library.
+            ;;
+        esac
+
+        case $cc_basename in
+          CC*)
+	    # FIXME: insert proper C++ library support
+	    _LT_TAGVAR(ld_shlibs, $1)=no
+	    ;;
+          aCC*)
+	    case $host_cpu in
+	      hppa*64*)
+	        _LT_TAGVAR(archive_cmds, $1)='$CC -b $wl+h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	        ;;
+	      ia64*)
+	        _LT_TAGVAR(archive_cmds, $1)='$CC -b $wl+h $wl$soname $wl+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	        ;;
+	      *)
+	        _LT_TAGVAR(archive_cmds, $1)='$CC -b $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	        ;;
+	    esac
+	    # Commands to make compiler produce verbose output that lists
+	    # what "hidden" libraries, object files and flags are used when
+	    # linking a shared library.
+	    #
+	    # There doesn't appear to be a way to prevent this compiler from
+	    # explicitly linking system object files so we need to strip them
+	    # from the output so that they don't get included in the library
+	    # dependencies.
+	    output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | $GREP "\-L"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"'
+	    ;;
+          *)
+	    if test yes = "$GXX"; then
+	      if test no = "$with_gnu_ld"; then
+	        case $host_cpu in
+	          hppa*64*)
+	            _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib -fPIC $wl+h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	            ;;
+	          ia64*)
+	            _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $pic_flag $wl+h $wl$soname $wl+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	            ;;
+	          *)
+	            _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	            ;;
+	        esac
+	      fi
+	    else
+	      # FIXME: insert proper C++ library support
+	      _LT_TAGVAR(ld_shlibs, $1)=no
+	    fi
+	    ;;
+        esac
+        ;;
+
+      interix[[3-9]]*)
+	_LT_TAGVAR(hardcode_direct, $1)=no
+	_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+	_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir'
+	_LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E'
+	# Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc.
+	# Instead, shared libraries are loaded at an image base (0x10000000 by
+	# default) and relocated if they conflict, which is a slow very memory
+	# consuming and fragmenting process.  To avoid this, we pick a random,
+	# 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link
+	# time.  Moving up from 0x10000000 also allows more sbrk(2) space.
+	_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
+	_LT_TAGVAR(archive_expsym_cmds, $1)='sed "s|^|_|" $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--retain-symbols-file,$output_objdir/$soname.expsym $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
+	;;
+      irix5* | irix6*)
+        case $cc_basename in
+          CC*)
+	    # SGI C++
+	    _LT_TAGVAR(archive_cmds, $1)='$CC -shared -all -multigot $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib'
+
+	    # Archives containing C++ object files must be created using
+	    # "CC -ar", where "CC" is the IRIX C++ compiler.  This is
+	    # necessary to make sure instantiated templates are included
+	    # in the archive.
+	    _LT_TAGVAR(old_archive_cmds, $1)='$CC -ar -WR,-u -o $oldlib $oldobjs'
+	    ;;
+          *)
+	    if test yes = "$GXX"; then
+	      if test no = "$with_gnu_ld"; then
+	        _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib'
+	      else
+	        _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` -o $lib'
+	      fi
+	    fi
+	    _LT_TAGVAR(link_all_deplibs, $1)=yes
+	    ;;
+        esac
+        _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir'
+        _LT_TAGVAR(hardcode_libdir_separator, $1)=:
+        _LT_TAGVAR(inherit_rpath, $1)=yes
+        ;;
+
+      linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*)
+        case $cc_basename in
+          KCC*)
+	    # Kuck and Associates, Inc. (KAI) C++ Compiler
+
+	    # KCC will only create a shared library if the output file
+	    # ends with ".so" (or ".sl" for HP-UX), so rename the library
+	    # to its proper name (with version) after linking.
+	    _LT_TAGVAR(archive_cmds, $1)='tempext=`echo $shared_ext | $SED -e '\''s/\([[^()0-9A-Za-z{}]]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\$tempext\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib'
+	    _LT_TAGVAR(archive_expsym_cmds, $1)='tempext=`echo $shared_ext | $SED -e '\''s/\([[^()0-9A-Za-z{}]]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\$tempext\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib $wl-retain-symbols-file,$export_symbols; mv \$templib $lib'
+	    # Commands to make compiler produce verbose output that lists
+	    # what "hidden" libraries, object files and flags are used when
+	    # linking a shared library.
+	    #
+	    # There doesn't appear to be a way to prevent this compiler from
+	    # explicitly linking system object files so we need to strip them
+	    # from the output so that they don't get included in the library
+	    # dependencies.
+	    output_verbose_link_cmd='templist=`$CC $CFLAGS -v conftest.$objext -o libconftest$shared_ext 2>&1 | $GREP "ld"`; rm -f libconftest$shared_ext; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"'
+
+	    _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir'
+	    _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-dynamic'
+
+	    # Archives containing C++ object files must be created using
+	    # "CC -Bstatic", where "CC" is the KAI C++ compiler.
+	    _LT_TAGVAR(old_archive_cmds, $1)='$CC -Bstatic -o $oldlib $oldobjs'
+	    ;;
+	  icpc* | ecpc* )
+	    # Intel C++
+	    with_gnu_ld=yes
+	    # version 8.0 and above of icpc choke on multiply defined symbols
+	    # if we add $predep_objects and $postdep_objects, however 7.1 and
+	    # earlier do not add the objects themselves.
+	    case `$CC -V 2>&1` in
+	      *"Version 7."*)
+	        _LT_TAGVAR(archive_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib'
+		_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib'
+		;;
+	      *)  # Version 8.0 or newer
+	        tmp_idyn=
+	        case $host_cpu in
+		  ia64*) tmp_idyn=' -i_dynamic';;
+		esac
+	        _LT_TAGVAR(archive_cmds, $1)='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+		_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib'
+		;;
+	    esac
+	    _LT_TAGVAR(archive_cmds_need_lc, $1)=no
+	    _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir'
+	    _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-dynamic'
+	    _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive$convenience $wl--no-whole-archive'
+	    ;;
+          pgCC* | pgcpp*)
+            # Portland Group C++ compiler
+	    case `$CC -V` in
+	    *pgCC\ [[1-5]].* | *pgcpp\ [[1-5]].*)
+	      _LT_TAGVAR(prelink_cmds, $1)='tpldir=Template.dir~
+               rm -rf $tpldir~
+               $CC --prelink_objects --instantiation_dir $tpldir $objs $libobjs $compile_deplibs~
+               compile_command="$compile_command `find $tpldir -name \*.o | sort | $NL2SP`"'
+	      _LT_TAGVAR(old_archive_cmds, $1)='tpldir=Template.dir~
+                rm -rf $tpldir~
+                $CC --prelink_objects --instantiation_dir $tpldir $oldobjs$old_deplibs~
+                $AR $AR_FLAGS $oldlib$oldobjs$old_deplibs `find $tpldir -name \*.o | sort | $NL2SP`~
+                $RANLIB $oldlib'
+	      _LT_TAGVAR(archive_cmds, $1)='tpldir=Template.dir~
+                rm -rf $tpldir~
+                $CC --prelink_objects --instantiation_dir $tpldir $predep_objects $libobjs $deplibs $convenience $postdep_objects~
+                $CC -shared $pic_flag $predep_objects $libobjs $deplibs `find $tpldir -name \*.o | sort | $NL2SP` $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib'
+	      _LT_TAGVAR(archive_expsym_cmds, $1)='tpldir=Template.dir~
+                rm -rf $tpldir~
+                $CC --prelink_objects --instantiation_dir $tpldir $predep_objects $libobjs $deplibs $convenience $postdep_objects~
+                $CC -shared $pic_flag $predep_objects $libobjs $deplibs `find $tpldir -name \*.o | sort | $NL2SP` $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib'
+	      ;;
+	    *) # Version 6 and above use weak symbols
+	      _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib'
+	      _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib'
+	      ;;
+	    esac
+
+	    _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl--rpath $wl$libdir'
+	    _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-dynamic'
+	    _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive`for conv in $convenience\"\"; do test  -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive'
+            ;;
+	  cxx*)
+	    # Compaq C++
+	    _LT_TAGVAR(archive_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib'
+	    _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname  -o $lib $wl-retain-symbols-file $wl$export_symbols'
+
+	    runpath_var=LD_RUN_PATH
+	    _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-rpath $libdir'
+	    _LT_TAGVAR(hardcode_libdir_separator, $1)=:
+
+	    # Commands to make compiler produce verbose output that lists
+	    # what "hidden" libraries, object files and flags are used when
+	    # linking a shared library.
+	    #
+	    # There doesn't appear to be a way to prevent this compiler from
+	    # explicitly linking system object files so we need to strip them
+	    # from the output so that they don't get included in the library
+	    # dependencies.
+	    output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "ld"`; templist=`func_echo_all "$templist" | $SED "s/\(^.*ld.*\)\( .*ld .*$\)/\1/"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "X$list" | $Xsed'
+	    ;;
+	  xl* | mpixl* | bgxl*)
+	    # IBM XL 8.0 on PPC, with GNU ld
+	    _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir'
+	    _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-dynamic'
+	    _LT_TAGVAR(archive_cmds, $1)='$CC -qmkshrobj $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+	    if test yes = "$supports_anon_versioning"; then
+	      _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $output_objdir/$libname.ver~
+                cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
+                echo "local: *; };" >> $output_objdir/$libname.ver~
+                $CC -qmkshrobj $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-version-script $wl$output_objdir/$libname.ver -o $lib'
+	    fi
+	    ;;
+	  *)
+	    case `$CC -V 2>&1 | sed 5q` in
+	    *Sun\ C*)
+	      # Sun C++ 5.9
+	      _LT_TAGVAR(no_undefined_flag, $1)=' -zdefs'
+	      _LT_TAGVAR(archive_cmds, $1)='$CC -G$allow_undefined_flag -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	      _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G$allow_undefined_flag -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-retain-symbols-file $wl$export_symbols'
+	      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
+	      _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive'
+	      _LT_TAGVAR(compiler_needs_object, $1)=yes
+
+	      # Not sure whether something based on
+	      # $CC $CFLAGS -v conftest.$objext -o libconftest$shared_ext 2>&1
+	      # would be better.
+	      output_verbose_link_cmd='func_echo_all'
+
+	      # Archives containing C++ object files must be created using
+	      # "CC -xar", where "CC" is the Sun C++ compiler.  This is
+	      # necessary to make sure instantiated templates are included
+	      # in the archive.
+	      _LT_TAGVAR(old_archive_cmds, $1)='$CC -xar -o $oldlib $oldobjs'
+	      ;;
+	    esac
+	    ;;
+	esac
+	;;
+
+      lynxos*)
+        # FIXME: insert proper C++ library support
+	_LT_TAGVAR(ld_shlibs, $1)=no
+	;;
+
+      m88k*)
+        # FIXME: insert proper C++ library support
+        _LT_TAGVAR(ld_shlibs, $1)=no
+	;;
+
+      mvs*)
+        case $cc_basename in
+          cxx*)
+	    # FIXME: insert proper C++ library support
+	    _LT_TAGVAR(ld_shlibs, $1)=no
+	    ;;
+	  *)
+	    # FIXME: insert proper C++ library support
+	    _LT_TAGVAR(ld_shlibs, $1)=no
+	    ;;
+	esac
+	;;
+
+      netbsd*)
+        if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
+	  _LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable  -o $lib $predep_objects $libobjs $deplibs $postdep_objects $linker_flags'
+	  wlarc=
+	  _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
+	  _LT_TAGVAR(hardcode_direct, $1)=yes
+	  _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+	fi
+	# Workaround some broken pre-1.5 toolchains
+	output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP conftest.$objext | $SED -e "s:-lgcc -lc -lgcc::"'
+	;;
+
+      *nto* | *qnx*)
+        _LT_TAGVAR(ld_shlibs, $1)=yes
+	;;
+
+      openbsd* | bitrig*)
+	if test -f /usr/libexec/ld.so; then
+	  _LT_TAGVAR(hardcode_direct, $1)=yes
+	  _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+	  _LT_TAGVAR(hardcode_direct_absolute, $1)=yes
+	  _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib'
+	  _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir'
+	  if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`"; then
+	    _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-retain-symbols-file,$export_symbols -o $lib'
+	    _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E'
+	    _LT_TAGVAR(whole_archive_flag_spec, $1)=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive'
+	  fi
+	  output_verbose_link_cmd=func_echo_all
+	else
+	  _LT_TAGVAR(ld_shlibs, $1)=no
+	fi
+	;;
+
+      osf3* | osf4* | osf5*)
+        case $cc_basename in
+          KCC*)
+	    # Kuck and Associates, Inc. (KAI) C++ Compiler
+
+	    # KCC will only create a shared library if the output file
+	    # ends with ".so" (or ".sl" for HP-UX), so rename the library
+	    # to its proper name (with version) after linking.
+	    _LT_TAGVAR(archive_cmds, $1)='tempext=`echo $shared_ext | $SED -e '\''s/\([[^()0-9A-Za-z{}]]\)/\\\\\1/g'\''`; templib=`echo "$lib" | $SED -e "s/\$tempext\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib'
+
+	    _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir'
+	    _LT_TAGVAR(hardcode_libdir_separator, $1)=:
+
+	    # Archives containing C++ object files must be created using
+	    # the KAI C++ compiler.
+	    case $host in
+	      osf3*) _LT_TAGVAR(old_archive_cmds, $1)='$CC -Bstatic -o $oldlib $oldobjs' ;;
+	      *) _LT_TAGVAR(old_archive_cmds, $1)='$CC -o $oldlib $oldobjs' ;;
+	    esac
+	    ;;
+          RCC*)
+	    # Rational C++ 2.4.1
+	    # FIXME: insert proper C++ library support
+	    _LT_TAGVAR(ld_shlibs, $1)=no
+	    ;;
+          cxx*)
+	    case $host in
+	      osf3*)
+	        _LT_TAGVAR(allow_undefined_flag, $1)=' $wl-expect_unresolved $wl\*'
+	        _LT_TAGVAR(archive_cmds, $1)='$CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $soname `test -n "$verstring" && func_echo_all "$wl-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib'
+	        _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir'
+		;;
+	      *)
+	        _LT_TAGVAR(allow_undefined_flag, $1)=' -expect_unresolved \*'
+	        _LT_TAGVAR(archive_cmds, $1)='$CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib'
+	        _LT_TAGVAR(archive_expsym_cmds, $1)='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done~
+                  echo "-hidden">> $lib.exp~
+                  $CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname $wl-input $wl$lib.exp  `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib~
+                  $RM $lib.exp'
+	        _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-rpath $libdir'
+		;;
+	    esac
+
+	    _LT_TAGVAR(hardcode_libdir_separator, $1)=:
+
+	    # Commands to make compiler produce verbose output that lists
+	    # what "hidden" libraries, object files and flags are used when
+	    # linking a shared library.
+	    #
+	    # There doesn't appear to be a way to prevent this compiler from
+	    # explicitly linking system object files so we need to strip them
+	    # from the output so that they don't get included in the library
+	    # dependencies.
+	    output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "ld" | $GREP -v "ld:"`; templist=`func_echo_all "$templist" | $SED "s/\(^.*ld.*\)\( .*ld.*$\)/\1/"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"'
+	    ;;
+	  *)
+	    if test yes,no = "$GXX,$with_gnu_ld"; then
+	      _LT_TAGVAR(allow_undefined_flag, $1)=' $wl-expect_unresolved $wl\*'
+	      case $host in
+	        osf3*)
+	          _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib'
+		  ;;
+	        *)
+	          _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -nostdlib $allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-msym $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib'
+		  ;;
+	      esac
+
+	      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir'
+	      _LT_TAGVAR(hardcode_libdir_separator, $1)=:
+
+	      # Commands to make compiler produce verbose output that lists
+	      # what "hidden" libraries, object files and flags are used when
+	      # linking a shared library.
+	      output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"'
+
+	    else
+	      # FIXME: insert proper C++ library support
+	      _LT_TAGVAR(ld_shlibs, $1)=no
+	    fi
+	    ;;
+        esac
+        ;;
+
+      psos*)
+        # FIXME: insert proper C++ library support
+        _LT_TAGVAR(ld_shlibs, $1)=no
+        ;;
+
+      sunos4*)
+        case $cc_basename in
+          CC*)
+	    # Sun C++ 4.x
+	    # FIXME: insert proper C++ library support
+	    _LT_TAGVAR(ld_shlibs, $1)=no
+	    ;;
+          lcc*)
+	    # Lucid
+	    # FIXME: insert proper C++ library support
+	    _LT_TAGVAR(ld_shlibs, $1)=no
+	    ;;
+          *)
+	    # FIXME: insert proper C++ library support
+	    _LT_TAGVAR(ld_shlibs, $1)=no
+	    ;;
+        esac
+        ;;
+
+      solaris*)
+        case $cc_basename in
+          CC* | sunCC*)
+	    # Sun C++ 4.2, 5.x and Centerline C++
+            _LT_TAGVAR(archive_cmds_need_lc,$1)=yes
+	    _LT_TAGVAR(no_undefined_flag, $1)=' -zdefs'
+	    _LT_TAGVAR(archive_cmds, $1)='$CC -G$allow_undefined_flag -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	    _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
+              $CC -G$allow_undefined_flag $wl-M $wl$lib.exp -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp'
+
+	    _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
+	    _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+	    case $host_os in
+	      solaris2.[[0-5]] | solaris2.[[0-5]].*) ;;
+	      *)
+		# The compiler driver will combine and reorder linker options,
+		# but understands '-z linker_flag'.
+	        # Supported since Solaris 2.6 (maybe 2.5.1?)
+		_LT_TAGVAR(whole_archive_flag_spec, $1)='-z allextract$convenience -z defaultextract'
+	        ;;
+	    esac
+	    _LT_TAGVAR(link_all_deplibs, $1)=yes
+
+	    output_verbose_link_cmd='func_echo_all'
+
+	    # Archives containing C++ object files must be created using
+	    # "CC -xar", where "CC" is the Sun C++ compiler.  This is
+	    # necessary to make sure instantiated templates are included
+	    # in the archive.
+	    _LT_TAGVAR(old_archive_cmds, $1)='$CC -xar -o $oldlib $oldobjs'
+	    ;;
+          gcx*)
+	    # Green Hills C++ Compiler
+	    _LT_TAGVAR(archive_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-h $wl$soname -o $lib'
+
+	    # The C++ compiler must be used to create the archive.
+	    _LT_TAGVAR(old_archive_cmds, $1)='$CC $LDFLAGS -archive -o $oldlib $oldobjs'
+	    ;;
+          *)
+	    # GNU C++ compiler with Solaris linker
+	    if test yes,no = "$GXX,$with_gnu_ld"; then
+	      _LT_TAGVAR(no_undefined_flag, $1)=' $wl-z ${wl}defs'
+	      if $CC --version | $GREP -v '^2\.7' > /dev/null; then
+	        _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-h $wl$soname -o $lib'
+	        _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
+                  $CC -shared $pic_flag -nostdlib $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp'
+
+	        # Commands to make compiler produce verbose output that lists
+	        # what "hidden" libraries, object files and flags are used when
+	        # linking a shared library.
+	        output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"'
+	      else
+	        # g++ 2.7 appears to require '-G' NOT '-shared' on this
+	        # platform.
+	        _LT_TAGVAR(archive_cmds, $1)='$CC -G -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-h $wl$soname -o $lib'
+	        _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
+                  $CC -G -nostdlib $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp'
+
+	        # Commands to make compiler produce verbose output that lists
+	        # what "hidden" libraries, object files and flags are used when
+	        # linking a shared library.
+	        output_verbose_link_cmd='$CC -G $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"'
+	      fi
+
+	      _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-R $wl$libdir'
+	      case $host_os in
+		solaris2.[[0-5]] | solaris2.[[0-5]].*) ;;
+		*)
+		  _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl-z ${wl}allextract$convenience $wl-z ${wl}defaultextract'
+		  ;;
+	      esac
+	    fi
+	    ;;
+        esac
+        ;;
+
+    sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[[01]].[[10]]* | unixware7* | sco3.2v5.0.[[024]]*)
+      _LT_TAGVAR(no_undefined_flag, $1)='$wl-z,text'
+      _LT_TAGVAR(archive_cmds_need_lc, $1)=no
+      _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+      runpath_var='LD_RUN_PATH'
+
+      case $cc_basename in
+        CC*)
+	  _LT_TAGVAR(archive_cmds, $1)='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	  _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	*)
+	  _LT_TAGVAR(archive_cmds, $1)='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	  _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+      esac
+      ;;
+
+      sysv5* | sco3.2v5* | sco5v6*)
+	# Note: We CANNOT use -z defs as we might desire, because we do not
+	# link with -lc, and that would cause any symbols used from libc to
+	# always be unresolved, which means just about no library would
+	# ever link correctly.  If we're not using GNU ld we use -z text
+	# though, which does catch some bad symbols but isn't as heavy-handed
+	# as -z defs.
+	_LT_TAGVAR(no_undefined_flag, $1)='$wl-z,text'
+	_LT_TAGVAR(allow_undefined_flag, $1)='$wl-z,nodefs'
+	_LT_TAGVAR(archive_cmds_need_lc, $1)=no
+	_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
+	_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-R,$libdir'
+	_LT_TAGVAR(hardcode_libdir_separator, $1)=':'
+	_LT_TAGVAR(link_all_deplibs, $1)=yes
+	_LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-Bexport'
+	runpath_var='LD_RUN_PATH'
+
+	case $cc_basename in
+          CC*)
+	    _LT_TAGVAR(archive_cmds, $1)='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	    _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	    _LT_TAGVAR(old_archive_cmds, $1)='$CC -Tprelink_objects $oldobjs~
+              '"$_LT_TAGVAR(old_archive_cmds, $1)"
+	    _LT_TAGVAR(reload_cmds, $1)='$CC -Tprelink_objects $reload_objs~
+              '"$_LT_TAGVAR(reload_cmds, $1)"
+	    ;;
+	  *)
+	    _LT_TAGVAR(archive_cmds, $1)='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	    _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	    ;;
+	esac
+      ;;
+
+      tandem*)
+        case $cc_basename in
+          NCC*)
+	    # NonStop-UX NCC 3.20
+	    # FIXME: insert proper C++ library support
+	    _LT_TAGVAR(ld_shlibs, $1)=no
+	    ;;
+          *)
+	    # FIXME: insert proper C++ library support
+	    _LT_TAGVAR(ld_shlibs, $1)=no
+	    ;;
+        esac
+        ;;
+
+      vxworks*)
+        # FIXME: insert proper C++ library support
+        _LT_TAGVAR(ld_shlibs, $1)=no
+        ;;
+
+      *)
+        # FIXME: insert proper C++ library support
+        _LT_TAGVAR(ld_shlibs, $1)=no
+        ;;
+    esac
+
+    AC_MSG_RESULT([$_LT_TAGVAR(ld_shlibs, $1)])
+    test no = "$_LT_TAGVAR(ld_shlibs, $1)" && can_build_shared=no
+
+    _LT_TAGVAR(GCC, $1)=$GXX
+    _LT_TAGVAR(LD, $1)=$LD
+
+    ## CAVEAT EMPTOR:
+    ## There is no encapsulation within the following macros, do not change
+    ## the running order or otherwise move them around unless you know exactly
+    ## what you are doing...
+    _LT_SYS_HIDDEN_LIBDEPS($1)
+    _LT_COMPILER_PIC($1)
+    _LT_COMPILER_C_O($1)
+    _LT_COMPILER_FILE_LOCKS($1)
+    _LT_LINKER_SHLIBS($1)
+    _LT_SYS_DYNAMIC_LINKER($1)
+    _LT_LINKER_HARDCODE_LIBPATH($1)
+
+    _LT_CONFIG($1)
+  fi # test -n "$compiler"
+
+  CC=$lt_save_CC
+  CFLAGS=$lt_save_CFLAGS
+  LDCXX=$LD
+  LD=$lt_save_LD
+  GCC=$lt_save_GCC
+  with_gnu_ld=$lt_save_with_gnu_ld
+  lt_cv_path_LDCXX=$lt_cv_path_LD
+  lt_cv_path_LD=$lt_save_path_LD
+  lt_cv_prog_gnu_ldcxx=$lt_cv_prog_gnu_ld
+  lt_cv_prog_gnu_ld=$lt_save_with_gnu_ld
+fi # test yes != "$_lt_caught_CXX_error"
+
+AC_LANG_POP
+])# _LT_LANG_CXX_CONFIG
+
+
+# _LT_FUNC_STRIPNAME_CNF
+# ----------------------
+# func_stripname_cnf prefix suffix name
+# strip PREFIX and SUFFIX off of NAME.
+# PREFIX and SUFFIX must not contain globbing or regex special
+# characters, hashes, percent signs, but SUFFIX may contain a leading
+# dot (in which case that matches only a dot).
+#
+# This function is identical to the (non-XSI) version of func_stripname,
+# except this one can be used by m4 code that may be executed by configure,
+# rather than the libtool script.
+m4_defun([_LT_FUNC_STRIPNAME_CNF],[dnl
+AC_REQUIRE([_LT_DECL_SED])
+AC_REQUIRE([_LT_PROG_ECHO_BACKSLASH])
+func_stripname_cnf ()
+{
+  case @S|@2 in
+  .*) func_stripname_result=`$ECHO "@S|@3" | $SED "s%^@S|@1%%; s%\\\\@S|@2\$%%"`;;
+  *)  func_stripname_result=`$ECHO "@S|@3" | $SED "s%^@S|@1%%; s%@S|@2\$%%"`;;
+  esac
+} # func_stripname_cnf
+])# _LT_FUNC_STRIPNAME_CNF
+
+
+# _LT_SYS_HIDDEN_LIBDEPS([TAGNAME])
+# ---------------------------------
+# Figure out "hidden" library dependencies from verbose
+# compiler output when linking a shared library.
+# Parse the compiler output and extract the necessary
+# objects, libraries and library flags.
+m4_defun([_LT_SYS_HIDDEN_LIBDEPS],
+[m4_require([_LT_FILEUTILS_DEFAULTS])dnl
+AC_REQUIRE([_LT_FUNC_STRIPNAME_CNF])dnl
+# Dependencies to place before and after the object being linked:
+_LT_TAGVAR(predep_objects, $1)=
+_LT_TAGVAR(postdep_objects, $1)=
+_LT_TAGVAR(predeps, $1)=
+_LT_TAGVAR(postdeps, $1)=
+_LT_TAGVAR(compiler_lib_search_path, $1)=
+
+dnl we can't use the lt_simple_compile_test_code here,
+dnl because it contains code intended for an executable,
+dnl not a library.  It's possible we should let each
+dnl tag define a new lt_????_link_test_code variable,
+dnl but it's only used here...
+m4_if([$1], [], [cat > conftest.$ac_ext <<_LT_EOF
+int a;
+void foo (void) { a = 0; }
+_LT_EOF
+], [$1], [CXX], [cat > conftest.$ac_ext <<_LT_EOF
+class Foo
+{
+public:
+  Foo (void) { a = 0; }
+private:
+  int a;
+};
+_LT_EOF
+], [$1], [F77], [cat > conftest.$ac_ext <<_LT_EOF
+      subroutine foo
+      implicit none
+      integer*4 a
+      a=0
+      return
+      end
+_LT_EOF
+], [$1], [FC], [cat > conftest.$ac_ext <<_LT_EOF
+      subroutine foo
+      implicit none
+      integer a
+      a=0
+      return
+      end
+_LT_EOF
+], [$1], [GCJ], [cat > conftest.$ac_ext <<_LT_EOF
+public class foo {
+  private int a;
+  public void bar (void) {
+    a = 0;
+  }
+};
+_LT_EOF
+], [$1], [GO], [cat > conftest.$ac_ext <<_LT_EOF
+package foo
+func foo() {
+}
+_LT_EOF
+])
+
+_lt_libdeps_save_CFLAGS=$CFLAGS
+case "$CC $CFLAGS " in #(
+*\ -flto*\ *) CFLAGS="$CFLAGS -fno-lto" ;;
+*\ -fwhopr*\ *) CFLAGS="$CFLAGS -fno-whopr" ;;
+*\ -fuse-linker-plugin*\ *) CFLAGS="$CFLAGS -fno-use-linker-plugin" ;;
+esac
+
+dnl Parse the compiler output and extract the necessary
+dnl objects, libraries and library flags.
+if AC_TRY_EVAL(ac_compile); then
+  # Parse the compiler output and extract the necessary
+  # objects, libraries and library flags.
+
+  # Sentinel used to keep track of whether or not we are before
+  # the conftest object file.
+  pre_test_object_deps_done=no
+
+  for p in `eval "$output_verbose_link_cmd"`; do
+    case $prev$p in
+
+    -L* | -R* | -l*)
+       # Some compilers place space between "-{L,R}" and the path.
+       # Remove the space.
+       if test x-L = "$p" ||
+          test x-R = "$p"; then
+	 prev=$p
+	 continue
+       fi
+
+       # Expand the sysroot to ease extracting the directories later.
+       if test -z "$prev"; then
+         case $p in
+         -L*) func_stripname_cnf '-L' '' "$p"; prev=-L; p=$func_stripname_result ;;
+         -R*) func_stripname_cnf '-R' '' "$p"; prev=-R; p=$func_stripname_result ;;
+         -l*) func_stripname_cnf '-l' '' "$p"; prev=-l; p=$func_stripname_result ;;
+         esac
+       fi
+       case $p in
+       =*) func_stripname_cnf '=' '' "$p"; p=$lt_sysroot$func_stripname_result ;;
+       esac
+       if test no = "$pre_test_object_deps_done"; then
+	 case $prev in
+	 -L | -R)
+	   # Internal compiler library paths should come after those
+	   # provided the user.  The postdeps already come after the
+	   # user supplied libs so there is no need to process them.
+	   if test -z "$_LT_TAGVAR(compiler_lib_search_path, $1)"; then
+	     _LT_TAGVAR(compiler_lib_search_path, $1)=$prev$p
+	   else
+	     _LT_TAGVAR(compiler_lib_search_path, $1)="${_LT_TAGVAR(compiler_lib_search_path, $1)} $prev$p"
+	   fi
+	   ;;
+	 # The "-l" case would never come before the object being
+	 # linked, so don't bother handling this case.
+	 esac
+       else
+	 if test -z "$_LT_TAGVAR(postdeps, $1)"; then
+	   _LT_TAGVAR(postdeps, $1)=$prev$p
+	 else
+	   _LT_TAGVAR(postdeps, $1)="${_LT_TAGVAR(postdeps, $1)} $prev$p"
+	 fi
+       fi
+       prev=
+       ;;
+
+    *.lto.$objext) ;; # Ignore GCC LTO objects
+    *.$objext)
+       # This assumes that the test object file only shows up
+       # once in the compiler output.
+       if test "$p" = "conftest.$objext"; then
+	 pre_test_object_deps_done=yes
+	 continue
+       fi
+
+       if test no = "$pre_test_object_deps_done"; then
+	 if test -z "$_LT_TAGVAR(predep_objects, $1)"; then
+	   _LT_TAGVAR(predep_objects, $1)=$p
+	 else
+	   _LT_TAGVAR(predep_objects, $1)="$_LT_TAGVAR(predep_objects, $1) $p"
+	 fi
+       else
+	 if test -z "$_LT_TAGVAR(postdep_objects, $1)"; then
+	   _LT_TAGVAR(postdep_objects, $1)=$p
+	 else
+	   _LT_TAGVAR(postdep_objects, $1)="$_LT_TAGVAR(postdep_objects, $1) $p"
+	 fi
+       fi
+       ;;
+
+    *) ;; # Ignore the rest.
+
+    esac
+  done
+
+  # Clean up.
+  rm -f a.out a.exe
+else
+  echo "libtool.m4: error: problem compiling $1 test program"
+fi
+
+$RM -f confest.$objext
+CFLAGS=$_lt_libdeps_save_CFLAGS
+
+# PORTME: override above test on systems where it is broken
+m4_if([$1], [CXX],
+[case $host_os in
+interix[[3-9]]*)
+  # Interix 3.5 installs completely hosed .la files for C++, so rather than
+  # hack all around it, let's just trust "g++" to DTRT.
+  _LT_TAGVAR(predep_objects,$1)=
+  _LT_TAGVAR(postdep_objects,$1)=
+  _LT_TAGVAR(postdeps,$1)=
+  ;;
+esac
+])
+
+case " $_LT_TAGVAR(postdeps, $1) " in
+*" -lc "*) _LT_TAGVAR(archive_cmds_need_lc, $1)=no ;;
+esac
+ _LT_TAGVAR(compiler_lib_search_dirs, $1)=
+if test -n "${_LT_TAGVAR(compiler_lib_search_path, $1)}"; then
+ _LT_TAGVAR(compiler_lib_search_dirs, $1)=`echo " ${_LT_TAGVAR(compiler_lib_search_path, $1)}" | $SED -e 's! -L! !g' -e 's!^ !!'`
+fi
+_LT_TAGDECL([], [compiler_lib_search_dirs], [1],
+    [The directories searched by this compiler when creating a shared library])
+_LT_TAGDECL([], [predep_objects], [1],
+    [Dependencies to place before and after the objects being linked to
+    create a shared library])
+_LT_TAGDECL([], [postdep_objects], [1])
+_LT_TAGDECL([], [predeps], [1])
+_LT_TAGDECL([], [postdeps], [1])
+_LT_TAGDECL([], [compiler_lib_search_path], [1],
+    [The library search path used internally by the compiler when linking
+    a shared library])
+])# _LT_SYS_HIDDEN_LIBDEPS
+
+
+# _LT_LANG_F77_CONFIG([TAG])
+# --------------------------
+# Ensure that the configuration variables for a Fortran 77 compiler are
+# suitably defined.  These variables are subsequently used by _LT_CONFIG
+# to write the compiler configuration to 'libtool'.
+m4_defun([_LT_LANG_F77_CONFIG],
+[AC_LANG_PUSH(Fortran 77)
+if test -z "$F77" || test no = "$F77"; then
+  _lt_disable_F77=yes
+fi
+
+_LT_TAGVAR(archive_cmds_need_lc, $1)=no
+_LT_TAGVAR(allow_undefined_flag, $1)=
+_LT_TAGVAR(always_export_symbols, $1)=no
+_LT_TAGVAR(archive_expsym_cmds, $1)=
+_LT_TAGVAR(export_dynamic_flag_spec, $1)=
+_LT_TAGVAR(hardcode_direct, $1)=no
+_LT_TAGVAR(hardcode_direct_absolute, $1)=no
+_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
+_LT_TAGVAR(hardcode_libdir_separator, $1)=
+_LT_TAGVAR(hardcode_minus_L, $1)=no
+_LT_TAGVAR(hardcode_automatic, $1)=no
+_LT_TAGVAR(inherit_rpath, $1)=no
+_LT_TAGVAR(module_cmds, $1)=
+_LT_TAGVAR(module_expsym_cmds, $1)=
+_LT_TAGVAR(link_all_deplibs, $1)=unknown
+_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds
+_LT_TAGVAR(reload_flag, $1)=$reload_flag
+_LT_TAGVAR(reload_cmds, $1)=$reload_cmds
+_LT_TAGVAR(no_undefined_flag, $1)=
+_LT_TAGVAR(whole_archive_flag_spec, $1)=
+_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no
+
+# Source file extension for f77 test sources.
+ac_ext=f
+
+# Object file extension for compiled f77 test sources.
+objext=o
+_LT_TAGVAR(objext, $1)=$objext
+
+# No sense in running all these tests if we already determined that
+# the F77 compiler isn't working.  Some variables (like enable_shared)
+# are currently assumed to apply to all compilers on this platform,
+# and will be corrupted by setting them based on a non-working compiler.
+if test yes != "$_lt_disable_F77"; then
+  # Code to be used in simple compile tests
+  lt_simple_compile_test_code="\
+      subroutine t
+      return
+      end
+"
+
+  # Code to be used in simple link tests
+  lt_simple_link_test_code="\
+      program t
+      end
+"
+
+  # ltmain only uses $CC for tagged configurations so make sure $CC is set.
+  _LT_TAG_COMPILER
+
+  # save warnings/boilerplate of simple test code
+  _LT_COMPILER_BOILERPLATE
+  _LT_LINKER_BOILERPLATE
+
+  # Allow CC to be a program name with arguments.
+  lt_save_CC=$CC
+  lt_save_GCC=$GCC
+  lt_save_CFLAGS=$CFLAGS
+  CC=${F77-"f77"}
+  CFLAGS=$FFLAGS
+  compiler=$CC
+  _LT_TAGVAR(compiler, $1)=$CC
+  _LT_CC_BASENAME([$compiler])
+  GCC=$G77
+  if test -n "$compiler"; then
+    AC_MSG_CHECKING([if libtool supports shared libraries])
+    AC_MSG_RESULT([$can_build_shared])
+
+    AC_MSG_CHECKING([whether to build shared libraries])
+    test no = "$can_build_shared" && enable_shared=no
+
+    # On AIX, shared libraries and static libraries use the same namespace, and
+    # are all built from PIC.
+    case $host_os in
+      aix3*)
+        test yes = "$enable_shared" && enable_static=no
+        if test -n "$RANLIB"; then
+          archive_cmds="$archive_cmds~\$RANLIB \$lib"
+          postinstall_cmds='$RANLIB $lib'
+        fi
+        ;;
+      aix[[4-9]]*)
+	if test ia64 != "$host_cpu"; then
+	  case $enable_shared,$with_aix_soname,$aix_use_runtimelinking in
+	  yes,aix,yes) ;;		# shared object as lib.so file only
+	  yes,svr4,*) ;;		# shared object as lib.so archive member only
+	  yes,*) enable_static=no ;;	# shared object in lib.a archive as well
+	  esac
+	fi
+        ;;
+    esac
+    AC_MSG_RESULT([$enable_shared])
+
+    AC_MSG_CHECKING([whether to build static libraries])
+    # Make sure either enable_shared or enable_static is yes.
+    test yes = "$enable_shared" || enable_static=yes
+    AC_MSG_RESULT([$enable_static])
+
+    _LT_TAGVAR(GCC, $1)=$G77
+    _LT_TAGVAR(LD, $1)=$LD
+
+    ## CAVEAT EMPTOR:
+    ## There is no encapsulation within the following macros, do not change
+    ## the running order or otherwise move them around unless you know exactly
+    ## what you are doing...
+    _LT_COMPILER_PIC($1)
+    _LT_COMPILER_C_O($1)
+    _LT_COMPILER_FILE_LOCKS($1)
+    _LT_LINKER_SHLIBS($1)
+    _LT_SYS_DYNAMIC_LINKER($1)
+    _LT_LINKER_HARDCODE_LIBPATH($1)
+
+    _LT_CONFIG($1)
+  fi # test -n "$compiler"
+
+  GCC=$lt_save_GCC
+  CC=$lt_save_CC
+  CFLAGS=$lt_save_CFLAGS
+fi # test yes != "$_lt_disable_F77"
+
+AC_LANG_POP
+])# _LT_LANG_F77_CONFIG
+
+
+# _LT_LANG_FC_CONFIG([TAG])
+# -------------------------
+# Ensure that the configuration variables for a Fortran compiler are
+# suitably defined.  These variables are subsequently used by _LT_CONFIG
+# to write the compiler configuration to 'libtool'.
+m4_defun([_LT_LANG_FC_CONFIG],
+[AC_LANG_PUSH(Fortran)
+
+if test -z "$FC" || test no = "$FC"; then
+  _lt_disable_FC=yes
+fi
+
+_LT_TAGVAR(archive_cmds_need_lc, $1)=no
+_LT_TAGVAR(allow_undefined_flag, $1)=
+_LT_TAGVAR(always_export_symbols, $1)=no
+_LT_TAGVAR(archive_expsym_cmds, $1)=
+_LT_TAGVAR(export_dynamic_flag_spec, $1)=
+_LT_TAGVAR(hardcode_direct, $1)=no
+_LT_TAGVAR(hardcode_direct_absolute, $1)=no
+_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
+_LT_TAGVAR(hardcode_libdir_separator, $1)=
+_LT_TAGVAR(hardcode_minus_L, $1)=no
+_LT_TAGVAR(hardcode_automatic, $1)=no
+_LT_TAGVAR(inherit_rpath, $1)=no
+_LT_TAGVAR(module_cmds, $1)=
+_LT_TAGVAR(module_expsym_cmds, $1)=
+_LT_TAGVAR(link_all_deplibs, $1)=unknown
+_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds
+_LT_TAGVAR(reload_flag, $1)=$reload_flag
+_LT_TAGVAR(reload_cmds, $1)=$reload_cmds
+_LT_TAGVAR(no_undefined_flag, $1)=
+_LT_TAGVAR(whole_archive_flag_spec, $1)=
+_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no
+
+# Source file extension for fc test sources.
+ac_ext=${ac_fc_srcext-f}
+
+# Object file extension for compiled fc test sources.
+objext=o
+_LT_TAGVAR(objext, $1)=$objext
+
+# No sense in running all these tests if we already determined that
+# the FC compiler isn't working.  Some variables (like enable_shared)
+# are currently assumed to apply to all compilers on this platform,
+# and will be corrupted by setting them based on a non-working compiler.
+if test yes != "$_lt_disable_FC"; then
+  # Code to be used in simple compile tests
+  lt_simple_compile_test_code="\
+      subroutine t
+      return
+      end
+"
+
+  # Code to be used in simple link tests
+  lt_simple_link_test_code="\
+      program t
+      end
+"
+
+  # ltmain only uses $CC for tagged configurations so make sure $CC is set.
+  _LT_TAG_COMPILER
+
+  # save warnings/boilerplate of simple test code
+  _LT_COMPILER_BOILERPLATE
+  _LT_LINKER_BOILERPLATE
+
+  # Allow CC to be a program name with arguments.
+  lt_save_CC=$CC
+  lt_save_GCC=$GCC
+  lt_save_CFLAGS=$CFLAGS
+  CC=${FC-"f95"}
+  CFLAGS=$FCFLAGS
+  compiler=$CC
+  GCC=$ac_cv_fc_compiler_gnu
+
+  _LT_TAGVAR(compiler, $1)=$CC
+  _LT_CC_BASENAME([$compiler])
+
+  if test -n "$compiler"; then
+    AC_MSG_CHECKING([if libtool supports shared libraries])
+    AC_MSG_RESULT([$can_build_shared])
+
+    AC_MSG_CHECKING([whether to build shared libraries])
+    test no = "$can_build_shared" && enable_shared=no
+
+    # On AIX, shared libraries and static libraries use the same namespace, and
+    # are all built from PIC.
+    case $host_os in
+      aix3*)
+        test yes = "$enable_shared" && enable_static=no
+        if test -n "$RANLIB"; then
+          archive_cmds="$archive_cmds~\$RANLIB \$lib"
+          postinstall_cmds='$RANLIB $lib'
+        fi
+        ;;
+      aix[[4-9]]*)
+	if test ia64 != "$host_cpu"; then
+	  case $enable_shared,$with_aix_soname,$aix_use_runtimelinking in
+	  yes,aix,yes) ;;		# shared object as lib.so file only
+	  yes,svr4,*) ;;		# shared object as lib.so archive member only
+	  yes,*) enable_static=no ;;	# shared object in lib.a archive as well
+	  esac
+	fi
+        ;;
+    esac
+    AC_MSG_RESULT([$enable_shared])
+
+    AC_MSG_CHECKING([whether to build static libraries])
+    # Make sure either enable_shared or enable_static is yes.
+    test yes = "$enable_shared" || enable_static=yes
+    AC_MSG_RESULT([$enable_static])
+
+    _LT_TAGVAR(GCC, $1)=$ac_cv_fc_compiler_gnu
+    _LT_TAGVAR(LD, $1)=$LD
+
+    ## CAVEAT EMPTOR:
+    ## There is no encapsulation within the following macros, do not change
+    ## the running order or otherwise move them around unless you know exactly
+    ## what you are doing...
+    _LT_SYS_HIDDEN_LIBDEPS($1)
+    _LT_COMPILER_PIC($1)
+    _LT_COMPILER_C_O($1)
+    _LT_COMPILER_FILE_LOCKS($1)
+    _LT_LINKER_SHLIBS($1)
+    _LT_SYS_DYNAMIC_LINKER($1)
+    _LT_LINKER_HARDCODE_LIBPATH($1)
+
+    _LT_CONFIG($1)
+  fi # test -n "$compiler"
+
+  GCC=$lt_save_GCC
+  CC=$lt_save_CC
+  CFLAGS=$lt_save_CFLAGS
+fi # test yes != "$_lt_disable_FC"
+
+AC_LANG_POP
+])# _LT_LANG_FC_CONFIG
+
+
+# _LT_LANG_GCJ_CONFIG([TAG])
+# --------------------------
+# Ensure that the configuration variables for the GNU Java Compiler compiler
+# are suitably defined.  These variables are subsequently used by _LT_CONFIG
+# to write the compiler configuration to 'libtool'.
+m4_defun([_LT_LANG_GCJ_CONFIG],
+[AC_REQUIRE([LT_PROG_GCJ])dnl
+AC_LANG_SAVE
+
+# Source file extension for Java test sources.
+ac_ext=java
+
+# Object file extension for compiled Java test sources.
+objext=o
+_LT_TAGVAR(objext, $1)=$objext
+
+# Code to be used in simple compile tests
+lt_simple_compile_test_code="class foo {}"
+
+# Code to be used in simple link tests
+lt_simple_link_test_code='public class conftest { public static void main(String[[]] argv) {}; }'
+
+# ltmain only uses $CC for tagged configurations so make sure $CC is set.
+_LT_TAG_COMPILER
+
+# save warnings/boilerplate of simple test code
+_LT_COMPILER_BOILERPLATE
+_LT_LINKER_BOILERPLATE
+
+# Allow CC to be a program name with arguments.
+lt_save_CC=$CC
+lt_save_CFLAGS=$CFLAGS
+lt_save_GCC=$GCC
+GCC=yes
+CC=${GCJ-"gcj"}
+CFLAGS=$GCJFLAGS
+compiler=$CC
+_LT_TAGVAR(compiler, $1)=$CC
+_LT_TAGVAR(LD, $1)=$LD
+_LT_CC_BASENAME([$compiler])
+
+# GCJ did not exist at the time GCC didn't implicitly link libc in.
+_LT_TAGVAR(archive_cmds_need_lc, $1)=no
+
+_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds
+_LT_TAGVAR(reload_flag, $1)=$reload_flag
+_LT_TAGVAR(reload_cmds, $1)=$reload_cmds
+
+## CAVEAT EMPTOR:
+## There is no encapsulation within the following macros, do not change
+## the running order or otherwise move them around unless you know exactly
+## what you are doing...
+if test -n "$compiler"; then
+  _LT_COMPILER_NO_RTTI($1)
+  _LT_COMPILER_PIC($1)
+  _LT_COMPILER_C_O($1)
+  _LT_COMPILER_FILE_LOCKS($1)
+  _LT_LINKER_SHLIBS($1)
+  _LT_LINKER_HARDCODE_LIBPATH($1)
+
+  _LT_CONFIG($1)
+fi
+
+AC_LANG_RESTORE
+
+GCC=$lt_save_GCC
+CC=$lt_save_CC
+CFLAGS=$lt_save_CFLAGS
+])# _LT_LANG_GCJ_CONFIG
+
+
+# _LT_LANG_GO_CONFIG([TAG])
+# --------------------------
+# Ensure that the configuration variables for the GNU Go compiler
+# are suitably defined.  These variables are subsequently used by _LT_CONFIG
+# to write the compiler configuration to 'libtool'.
+m4_defun([_LT_LANG_GO_CONFIG],
+[AC_REQUIRE([LT_PROG_GO])dnl
+AC_LANG_SAVE
+
+# Source file extension for Go test sources.
+ac_ext=go
+
+# Object file extension for compiled Go test sources.
+objext=o
+_LT_TAGVAR(objext, $1)=$objext
+
+# Code to be used in simple compile tests
+lt_simple_compile_test_code="package main; func main() { }"
+
+# Code to be used in simple link tests
+lt_simple_link_test_code='package main; func main() { }'
+
+# ltmain only uses $CC for tagged configurations so make sure $CC is set.
+_LT_TAG_COMPILER
+
+# save warnings/boilerplate of simple test code
+_LT_COMPILER_BOILERPLATE
+_LT_LINKER_BOILERPLATE
+
+# Allow CC to be a program name with arguments.
+lt_save_CC=$CC
+lt_save_CFLAGS=$CFLAGS
+lt_save_GCC=$GCC
+GCC=yes
+CC=${GOC-"gccgo"}
+CFLAGS=$GOFLAGS
+compiler=$CC
+_LT_TAGVAR(compiler, $1)=$CC
+_LT_TAGVAR(LD, $1)=$LD
+_LT_CC_BASENAME([$compiler])
+
+# Go did not exist at the time GCC didn't implicitly link libc in.
+_LT_TAGVAR(archive_cmds_need_lc, $1)=no
+
+_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds
+_LT_TAGVAR(reload_flag, $1)=$reload_flag
+_LT_TAGVAR(reload_cmds, $1)=$reload_cmds
+
+## CAVEAT EMPTOR:
+## There is no encapsulation within the following macros, do not change
+## the running order or otherwise move them around unless you know exactly
+## what you are doing...
+if test -n "$compiler"; then
+  _LT_COMPILER_NO_RTTI($1)
+  _LT_COMPILER_PIC($1)
+  _LT_COMPILER_C_O($1)
+  _LT_COMPILER_FILE_LOCKS($1)
+  _LT_LINKER_SHLIBS($1)
+  _LT_LINKER_HARDCODE_LIBPATH($1)
+
+  _LT_CONFIG($1)
+fi
+
+AC_LANG_RESTORE
+
+GCC=$lt_save_GCC
+CC=$lt_save_CC
+CFLAGS=$lt_save_CFLAGS
+])# _LT_LANG_GO_CONFIG
+
+
+# _LT_LANG_RC_CONFIG([TAG])
+# -------------------------
+# Ensure that the configuration variables for the Windows resource compiler
+# are suitably defined.  These variables are subsequently used by _LT_CONFIG
+# to write the compiler configuration to 'libtool'.
+m4_defun([_LT_LANG_RC_CONFIG],
+[AC_REQUIRE([LT_PROG_RC])dnl
+AC_LANG_SAVE
+
+# Source file extension for RC test sources.
+ac_ext=rc
+
+# Object file extension for compiled RC test sources.
+objext=o
+_LT_TAGVAR(objext, $1)=$objext
+
+# Code to be used in simple compile tests
+lt_simple_compile_test_code='sample MENU { MENUITEM "&Soup", 100, CHECKED }'
+
+# Code to be used in simple link tests
+lt_simple_link_test_code=$lt_simple_compile_test_code
+
+# ltmain only uses $CC for tagged configurations so make sure $CC is set.
+_LT_TAG_COMPILER
+
+# save warnings/boilerplate of simple test code
+_LT_COMPILER_BOILERPLATE
+_LT_LINKER_BOILERPLATE
+
+# Allow CC to be a program name with arguments.
+lt_save_CC=$CC
+lt_save_CFLAGS=$CFLAGS
+lt_save_GCC=$GCC
+GCC=
+CC=${RC-"windres"}
+CFLAGS=
+compiler=$CC
+_LT_TAGVAR(compiler, $1)=$CC
+_LT_CC_BASENAME([$compiler])
+_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)=yes
+
+if test -n "$compiler"; then
+  :
+  _LT_CONFIG($1)
+fi
+
+GCC=$lt_save_GCC
+AC_LANG_RESTORE
+CC=$lt_save_CC
+CFLAGS=$lt_save_CFLAGS
+])# _LT_LANG_RC_CONFIG
+
+
+# LT_PROG_GCJ
+# -----------
+AC_DEFUN([LT_PROG_GCJ],
+[m4_ifdef([AC_PROG_GCJ], [AC_PROG_GCJ],
+  [m4_ifdef([A][M_PROG_GCJ], [A][M_PROG_GCJ],
+    [AC_CHECK_TOOL(GCJ, gcj,)
+      test set = "${GCJFLAGS+set}" || GCJFLAGS="-g -O2"
+      AC_SUBST(GCJFLAGS)])])[]dnl
+])
+
+# Old name:
+AU_ALIAS([LT_AC_PROG_GCJ], [LT_PROG_GCJ])
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([LT_AC_PROG_GCJ], [])
+
+
+# LT_PROG_GO
+# ----------
+AC_DEFUN([LT_PROG_GO],
+[AC_CHECK_TOOL(GOC, gccgo,)
+])
+
+
+# LT_PROG_RC
+# ----------
+AC_DEFUN([LT_PROG_RC],
+[AC_CHECK_TOOL(RC, windres,)
+])
+
+# Old name:
+AU_ALIAS([LT_AC_PROG_RC], [LT_PROG_RC])
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([LT_AC_PROG_RC], [])
+
+
+# _LT_DECL_EGREP
+# --------------
+# If we don't have a new enough Autoconf to choose the best grep
+# available, choose the one first in the user's PATH.
+m4_defun([_LT_DECL_EGREP],
+[AC_REQUIRE([AC_PROG_EGREP])dnl
+AC_REQUIRE([AC_PROG_FGREP])dnl
+test -z "$GREP" && GREP=grep
+_LT_DECL([], [GREP], [1], [A grep program that handles long lines])
+_LT_DECL([], [EGREP], [1], [An ERE matcher])
+_LT_DECL([], [FGREP], [1], [A literal string matcher])
+dnl Non-bleeding-edge autoconf doesn't subst GREP, so do it here too
+AC_SUBST([GREP])
+])
+
+
+# _LT_DECL_OBJDUMP
+# --------------
+# If we don't have a new enough Autoconf to choose the best objdump
+# available, choose the one first in the user's PATH.
+m4_defun([_LT_DECL_OBJDUMP],
+[AC_CHECK_TOOL(OBJDUMP, objdump, false)
+test -z "$OBJDUMP" && OBJDUMP=objdump
+_LT_DECL([], [OBJDUMP], [1], [An object symbol dumper])
+AC_SUBST([OBJDUMP])
+])
+
+# _LT_DECL_DLLTOOL
+# ----------------
+# Ensure DLLTOOL variable is set.
+m4_defun([_LT_DECL_DLLTOOL],
+[AC_CHECK_TOOL(DLLTOOL, dlltool, false)
+test -z "$DLLTOOL" && DLLTOOL=dlltool
+_LT_DECL([], [DLLTOOL], [1], [DLL creation program])
+AC_SUBST([DLLTOOL])
+])
+
+# _LT_DECL_SED
+# ------------
+# Check for a fully-functional sed program, that truncates
+# as few characters as possible.  Prefer GNU sed if found.
+m4_defun([_LT_DECL_SED],
+[AC_PROG_SED
+test -z "$SED" && SED=sed
+Xsed="$SED -e 1s/^X//"
+_LT_DECL([], [SED], [1], [A sed program that does not truncate output])
+_LT_DECL([], [Xsed], ["\$SED -e 1s/^X//"],
+    [Sed that helps us avoid accidentally triggering echo(1) options like -n])
+])# _LT_DECL_SED
+
+m4_ifndef([AC_PROG_SED], [
+############################################################
+# NOTE: This macro has been submitted for inclusion into   #
+#  GNU Autoconf as AC_PROG_SED.  When it is available in   #
+#  a released version of Autoconf we should remove this    #
+#  macro and use it instead.                               #
+############################################################
+
+m4_defun([AC_PROG_SED],
+[AC_MSG_CHECKING([for a sed that does not truncate output])
+AC_CACHE_VAL(lt_cv_path_SED,
+[# Loop through the user's path and test for sed and gsed.
+# Then use that list of sed's as ones to test for truncation.
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  for lt_ac_prog in sed gsed; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      if $as_executable_p "$as_dir/$lt_ac_prog$ac_exec_ext"; then
+        lt_ac_sed_list="$lt_ac_sed_list $as_dir/$lt_ac_prog$ac_exec_ext"
+      fi
+    done
+  done
+done
+IFS=$as_save_IFS
+lt_ac_max=0
+lt_ac_count=0
+# Add /usr/xpg4/bin/sed as it is typically found on Solaris
+# along with /bin/sed that truncates output.
+for lt_ac_sed in $lt_ac_sed_list /usr/xpg4/bin/sed; do
+  test ! -f "$lt_ac_sed" && continue
+  cat /dev/null > conftest.in
+  lt_ac_count=0
+  echo $ECHO_N "0123456789$ECHO_C" >conftest.in
+  # Check for GNU sed and select it if it is found.
+  if "$lt_ac_sed" --version 2>&1 < /dev/null | grep 'GNU' > /dev/null; then
+    lt_cv_path_SED=$lt_ac_sed
+    break
+  fi
+  while true; do
+    cat conftest.in conftest.in >conftest.tmp
+    mv conftest.tmp conftest.in
+    cp conftest.in conftest.nl
+    echo >>conftest.nl
+    $lt_ac_sed -e 's/a$//' < conftest.nl >conftest.out || break
+    cmp -s conftest.out conftest.nl || break
+    # 10000 chars as input seems more than enough
+    test 10 -lt "$lt_ac_count" && break
+    lt_ac_count=`expr $lt_ac_count + 1`
+    if test "$lt_ac_count" -gt "$lt_ac_max"; then
+      lt_ac_max=$lt_ac_count
+      lt_cv_path_SED=$lt_ac_sed
+    fi
+  done
+done
+])
+SED=$lt_cv_path_SED
+AC_SUBST([SED])
+AC_MSG_RESULT([$SED])
+])#AC_PROG_SED
+])#m4_ifndef
+
+# Old name:
+AU_ALIAS([LT_AC_PROG_SED], [AC_PROG_SED])
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([LT_AC_PROG_SED], [])
+
+
+# _LT_CHECK_SHELL_FEATURES
+# ------------------------
+# Find out whether the shell is Bourne or XSI compatible,
+# or has some other useful features.
+m4_defun([_LT_CHECK_SHELL_FEATURES],
+[if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+  lt_unset=unset
+else
+  lt_unset=false
+fi
+_LT_DECL([], [lt_unset], [0], [whether the shell understands "unset"])dnl
+
+# test EBCDIC or ASCII
+case `echo X|tr X '\101'` in
+ A) # ASCII based system
+    # \n is not interpreted correctly by Solaris 8 /usr/ucb/tr
+  lt_SP2NL='tr \040 \012'
+  lt_NL2SP='tr \015\012 \040\040'
+  ;;
+ *) # EBCDIC based system
+  lt_SP2NL='tr \100 \n'
+  lt_NL2SP='tr \r\n \100\100'
+  ;;
+esac
+_LT_DECL([SP2NL], [lt_SP2NL], [1], [turn spaces into newlines])dnl
+_LT_DECL([NL2SP], [lt_NL2SP], [1], [turn newlines into spaces])dnl
+])# _LT_CHECK_SHELL_FEATURES
+
+
+# _LT_PATH_CONVERSION_FUNCTIONS
+# -----------------------------
+# Determine what file name conversion functions should be used by
+# func_to_host_file (and, implicitly, by func_to_host_path).  These are needed
+# for certain cross-compile configurations and native mingw.
+m4_defun([_LT_PATH_CONVERSION_FUNCTIONS],
+[AC_REQUIRE([AC_CANONICAL_HOST])dnl
+AC_REQUIRE([AC_CANONICAL_BUILD])dnl
+AC_MSG_CHECKING([how to convert $build file names to $host format])
+AC_CACHE_VAL(lt_cv_to_host_file_cmd,
+[case $host in
+  *-*-mingw* )
+    case $build in
+      *-*-mingw* ) # actually msys
+        lt_cv_to_host_file_cmd=func_convert_file_msys_to_w32
+        ;;
+      *-*-cygwin* )
+        lt_cv_to_host_file_cmd=func_convert_file_cygwin_to_w32
+        ;;
+      * ) # otherwise, assume *nix
+        lt_cv_to_host_file_cmd=func_convert_file_nix_to_w32
+        ;;
+    esac
+    ;;
+  *-*-cygwin* )
+    case $build in
+      *-*-mingw* ) # actually msys
+        lt_cv_to_host_file_cmd=func_convert_file_msys_to_cygwin
+        ;;
+      *-*-cygwin* )
+        lt_cv_to_host_file_cmd=func_convert_file_noop
+        ;;
+      * ) # otherwise, assume *nix
+        lt_cv_to_host_file_cmd=func_convert_file_nix_to_cygwin
+        ;;
+    esac
+    ;;
+  * ) # unhandled hosts (and "normal" native builds)
+    lt_cv_to_host_file_cmd=func_convert_file_noop
+    ;;
+esac
+])
+to_host_file_cmd=$lt_cv_to_host_file_cmd
+AC_MSG_RESULT([$lt_cv_to_host_file_cmd])
+_LT_DECL([to_host_file_cmd], [lt_cv_to_host_file_cmd],
+         [0], [convert $build file names to $host format])dnl
+
+AC_MSG_CHECKING([how to convert $build file names to toolchain format])
+AC_CACHE_VAL(lt_cv_to_tool_file_cmd,
+[#assume ordinary cross tools, or native build.
+lt_cv_to_tool_file_cmd=func_convert_file_noop
+case $host in
+  *-*-mingw* )
+    case $build in
+      *-*-mingw* ) # actually msys
+        lt_cv_to_tool_file_cmd=func_convert_file_msys_to_w32
+        ;;
+    esac
+    ;;
+esac
+])
+to_tool_file_cmd=$lt_cv_to_tool_file_cmd
+AC_MSG_RESULT([$lt_cv_to_tool_file_cmd])
+_LT_DECL([to_tool_file_cmd], [lt_cv_to_tool_file_cmd],
+         [0], [convert $build files to toolchain format])dnl
+])# _LT_PATH_CONVERSION_FUNCTIONS
diff --git a/build-aux/ltmain.sh b/build-aux/ltmain.sh
new file mode 100644
index 00000000..22589375
--- /dev/null
+++ b/build-aux/ltmain.sh
@@ -0,0 +1,11346 @@
+#! /bin/sh
+## DO NOT EDIT - This file generated from ./build-aux/ltmain.in
+##               by inline-source v2014-01-03.01
+
+# libtool (GNU libtool) 2.4.6
+# Provide generalized library-building support services.
+# Written by Gordon Matzigkeit , 1996
+
+# Copyright (C) 1996-2015 Free Software Foundation, Inc.
+# This is free software; see the source for copying conditions.  There is NO
+# warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+# GNU Libtool is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# As a special exception to the GNU General Public License,
+# if you distribute this file as part of a program or library that
+# is built using GNU Libtool, you may include this file under the
+# same distribution terms that you use for the rest of that program.
+#
+# GNU Libtool is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see .
+
+
+PROGRAM=libtool
+PACKAGE=libtool
+VERSION="2.4.6 Debian-2.4.6-2.1"
+package_revision=2.4.6
+
+
+## ------ ##
+## Usage. ##
+## ------ ##
+
+# Run './libtool --help' for help with using this script from the
+# command line.
+
+
+## ------------------------------- ##
+## User overridable command paths. ##
+## ------------------------------- ##
+
+# After configure completes, it has a better idea of some of the
+# shell tools we need than the defaults used by the functions shared
+# with bootstrap, so set those here where they can still be over-
+# ridden by the user, but otherwise take precedence.
+
+: ${AUTOCONF="autoconf"}
+: ${AUTOMAKE="automake"}
+
+
+## -------------------------- ##
+## Source external libraries. ##
+## -------------------------- ##
+
+# Much of our low-level functionality needs to be sourced from external
+# libraries, which are installed to $pkgauxdir.
+
+# Set a version string for this script.
+scriptversion=2015-10-12.13; # UTC
+
+# General shell script boiler plate, and helper functions.
+# Written by Gary V. Vaughan, 2004
+
+# Copyright (C) 2004-2015 Free Software Foundation, Inc.
+# This is free software; see the source for copying conditions.  There is NO
+# warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+
+# As a special exception to the GNU General Public License, if you distribute
+# this file as part of a program or library that is built using GNU Libtool,
+# you may include this file under the same distribution terms that you use
+# for the rest of that program.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNES FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see .
+
+# Please report bugs or propose patches to gary@gnu.org.
+
+
+## ------ ##
+## Usage. ##
+## ------ ##
+
+# Evaluate this file near the top of your script to gain access to
+# the functions and variables defined here:
+#
+#   . `echo "$0" | ${SED-sed} 's|[^/]*$||'`/build-aux/funclib.sh
+#
+# If you need to override any of the default environment variable
+# settings, do that before evaluating this file.
+
+
+## -------------------- ##
+## Shell normalisation. ##
+## -------------------- ##
+
+# Some shells need a little help to be as Bourne compatible as possible.
+# Before doing anything else, make sure all that help has been provided!
+
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in *posix*) set -o posix ;; esac
+fi
+
+# NLS nuisances: We save the old values in case they are required later.
+_G_user_locale=
+_G_safe_locale=
+for _G_var in LANG LANGUAGE LC_ALL LC_CTYPE LC_COLLATE LC_MESSAGES
+do
+  eval "if test set = \"\${$_G_var+set}\"; then
+          save_$_G_var=\$$_G_var
+          $_G_var=C
+	  export $_G_var
+	  _G_user_locale=\"$_G_var=\\\$save_\$_G_var; \$_G_user_locale\"
+	  _G_safe_locale=\"$_G_var=C; \$_G_safe_locale\"
+	fi"
+done
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+# Make sure IFS has a sensible default
+sp=' '
+nl='
+'
+IFS="$sp	$nl"
+
+# There are apparently some retarded systems that use ';' as a PATH separator!
+if test "${PATH_SEPARATOR+set}" != set; then
+  PATH_SEPARATOR=:
+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+      PATH_SEPARATOR=';'
+  }
+fi
+
+
+
+## ------------------------- ##
+## Locate command utilities. ##
+## ------------------------- ##
+
+
+# func_executable_p FILE
+# ----------------------
+# Check that FILE is an executable regular file.
+func_executable_p ()
+{
+    test -f "$1" && test -x "$1"
+}
+
+
+# func_path_progs PROGS_LIST CHECK_FUNC [PATH]
+# --------------------------------------------
+# Search for either a program that responds to --version with output
+# containing "GNU", or else returned by CHECK_FUNC otherwise, by
+# trying all the directories in PATH with each of the elements of
+# PROGS_LIST.
+#
+# CHECK_FUNC should accept the path to a candidate program, and
+# set $func_check_prog_result if it truncates its output less than
+# $_G_path_prog_max characters.
+func_path_progs ()
+{
+    _G_progs_list=$1
+    _G_check_func=$2
+    _G_PATH=${3-"$PATH"}
+
+    _G_path_prog_max=0
+    _G_path_prog_found=false
+    _G_save_IFS=$IFS; IFS=${PATH_SEPARATOR-:}
+    for _G_dir in $_G_PATH; do
+      IFS=$_G_save_IFS
+      test -z "$_G_dir" && _G_dir=.
+      for _G_prog_name in $_G_progs_list; do
+        for _exeext in '' .EXE; do
+          _G_path_prog=$_G_dir/$_G_prog_name$_exeext
+          func_executable_p "$_G_path_prog" || continue
+          case `"$_G_path_prog" --version 2>&1` in
+            *GNU*) func_path_progs_result=$_G_path_prog _G_path_prog_found=: ;;
+            *)     $_G_check_func $_G_path_prog
+		   func_path_progs_result=$func_check_prog_result
+		   ;;
+          esac
+          $_G_path_prog_found && break 3
+        done
+      done
+    done
+    IFS=$_G_save_IFS
+    test -z "$func_path_progs_result" && {
+      echo "no acceptable sed could be found in \$PATH" >&2
+      exit 1
+    }
+}
+
+
+# We want to be able to use the functions in this file before configure
+# has figured out where the best binaries are kept, which means we have
+# to search for them ourselves - except when the results are already set
+# where we skip the searches.
+
+# Unless the user overrides by setting SED, search the path for either GNU
+# sed, or the sed that truncates its output the least.
+test -z "$SED" && {
+  _G_sed_script=s/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb/
+  for _G_i in 1 2 3 4 5 6 7; do
+    _G_sed_script=$_G_sed_script$nl$_G_sed_script
+  done
+  echo "$_G_sed_script" 2>/dev/null | sed 99q >conftest.sed
+  _G_sed_script=
+
+  func_check_prog_sed ()
+  {
+    _G_path_prog=$1
+
+    _G_count=0
+    printf 0123456789 >conftest.in
+    while :
+    do
+      cat conftest.in conftest.in >conftest.tmp
+      mv conftest.tmp conftest.in
+      cp conftest.in conftest.nl
+      echo '' >> conftest.nl
+      "$_G_path_prog" -f conftest.sed conftest.out 2>/dev/null || break
+      diff conftest.out conftest.nl >/dev/null 2>&1 || break
+      _G_count=`expr $_G_count + 1`
+      if test "$_G_count" -gt "$_G_path_prog_max"; then
+        # Best one so far, save it but keep looking for a better one
+        func_check_prog_result=$_G_path_prog
+        _G_path_prog_max=$_G_count
+      fi
+      # 10*(2^10) chars as input seems more than enough
+      test 10 -lt "$_G_count" && break
+    done
+    rm -f conftest.in conftest.tmp conftest.nl conftest.out
+  }
+
+  func_path_progs "sed gsed" func_check_prog_sed $PATH:/usr/xpg4/bin
+  rm -f conftest.sed
+  SED=$func_path_progs_result
+}
+
+
+# Unless the user overrides by setting GREP, search the path for either GNU
+# grep, or the grep that truncates its output the least.
+test -z "$GREP" && {
+  func_check_prog_grep ()
+  {
+    _G_path_prog=$1
+
+    _G_count=0
+    _G_path_prog_max=0
+    printf 0123456789 >conftest.in
+    while :
+    do
+      cat conftest.in conftest.in >conftest.tmp
+      mv conftest.tmp conftest.in
+      cp conftest.in conftest.nl
+      echo 'GREP' >> conftest.nl
+      "$_G_path_prog" -e 'GREP$' -e '-(cannot match)-' conftest.out 2>/dev/null || break
+      diff conftest.out conftest.nl >/dev/null 2>&1 || break
+      _G_count=`expr $_G_count + 1`
+      if test "$_G_count" -gt "$_G_path_prog_max"; then
+        # Best one so far, save it but keep looking for a better one
+        func_check_prog_result=$_G_path_prog
+        _G_path_prog_max=$_G_count
+      fi
+      # 10*(2^10) chars as input seems more than enough
+      test 10 -lt "$_G_count" && break
+    done
+    rm -f conftest.in conftest.tmp conftest.nl conftest.out
+  }
+
+  func_path_progs "grep ggrep" func_check_prog_grep $PATH:/usr/xpg4/bin
+  GREP=$func_path_progs_result
+}
+
+
+## ------------------------------- ##
+## User overridable command paths. ##
+## ------------------------------- ##
+
+# All uppercase variable names are used for environment variables.  These
+# variables can be overridden by the user before calling a script that
+# uses them if a suitable command of that name is not already available
+# in the command search PATH.
+
+: ${CP="cp -f"}
+: ${ECHO="printf %s\n"}
+: ${EGREP="$GREP -E"}
+: ${FGREP="$GREP -F"}
+: ${LN_S="ln -s"}
+: ${MAKE="make"}
+: ${MKDIR="mkdir"}
+: ${MV="mv -f"}
+: ${RM="rm -f"}
+: ${SHELL="${CONFIG_SHELL-/bin/sh}"}
+
+
+## -------------------- ##
+## Useful sed snippets. ##
+## -------------------- ##
+
+sed_dirname='s|/[^/]*$||'
+sed_basename='s|^.*/||'
+
+# Sed substitution that helps us do robust quoting.  It backslashifies
+# metacharacters that are still active within double-quoted strings.
+sed_quote_subst='s|\([`"$\\]\)|\\\1|g'
+
+# Same as above, but do not quote variable references.
+sed_double_quote_subst='s/\(["`\\]\)/\\\1/g'
+
+# Sed substitution that turns a string into a regex matching for the
+# string literally.
+sed_make_literal_regex='s|[].[^$\\*\/]|\\&|g'
+
+# Sed substitution that converts a w32 file name or path
+# that contains forward slashes, into one that contains
+# (escaped) backslashes.  A very naive implementation.
+sed_naive_backslashify='s|\\\\*|\\|g;s|/|\\|g;s|\\|\\\\|g'
+
+# Re-'\' parameter expansions in output of sed_double_quote_subst that
+# were '\'-ed in input to the same.  If an odd number of '\' preceded a
+# '$' in input to sed_double_quote_subst, that '$' was protected from
+# expansion.  Since each input '\' is now two '\'s, look for any number
+# of runs of four '\'s followed by two '\'s and then a '$'.  '\' that '$'.
+_G_bs='\\'
+_G_bs2='\\\\'
+_G_bs4='\\\\\\\\'
+_G_dollar='\$'
+sed_double_backslash="\
+  s/$_G_bs4/&\\
+/g
+  s/^$_G_bs2$_G_dollar/$_G_bs&/
+  s/\\([^$_G_bs]\\)$_G_bs2$_G_dollar/\\1$_G_bs2$_G_bs$_G_dollar/g
+  s/\n//g"
+
+
+## ----------------- ##
+## Global variables. ##
+## ----------------- ##
+
+# Except for the global variables explicitly listed below, the following
+# functions in the '^func_' namespace, and the '^require_' namespace
+# variables initialised in the 'Resource management' section, sourcing
+# this file will not pollute your global namespace with anything
+# else. There's no portable way to scope variables in Bourne shell
+# though, so actually running these functions will sometimes place
+# results into a variable named after the function, and often use
+# temporary variables in the '^_G_' namespace. If you are careful to
+# avoid using those namespaces casually in your sourcing script, things
+# should continue to work as you expect. And, of course, you can freely
+# overwrite any of the functions or variables defined here before
+# calling anything to customize them.
+
+EXIT_SUCCESS=0
+EXIT_FAILURE=1
+EXIT_MISMATCH=63  # $? = 63 is used to indicate version mismatch to missing.
+EXIT_SKIP=77	  # $? = 77 is used to indicate a skipped test to automake.
+
+# Allow overriding, eg assuming that you follow the convention of
+# putting '$debug_cmd' at the start of all your functions, you can get
+# bash to show function call trace with:
+#
+#    debug_cmd='eval echo "${FUNCNAME[0]} $*" >&2' bash your-script-name
+debug_cmd=${debug_cmd-":"}
+exit_cmd=:
+
+# By convention, finish your script with:
+#
+#    exit $exit_status
+#
+# so that you can set exit_status to non-zero if you want to indicate
+# something went wrong during execution without actually bailing out at
+# the point of failure.
+exit_status=$EXIT_SUCCESS
+
+# Work around backward compatibility issue on IRIX 6.5. On IRIX 6.4+, sh
+# is ksh but when the shell is invoked as "sh" and the current value of
+# the _XPG environment variable is not equal to 1 (one), the special
+# positional parameter $0, within a function call, is the name of the
+# function.
+progpath=$0
+
+# The name of this program.
+progname=`$ECHO "$progpath" |$SED "$sed_basename"`
+
+# Make sure we have an absolute progpath for reexecution:
+case $progpath in
+  [\\/]*|[A-Za-z]:\\*) ;;
+  *[\\/]*)
+     progdir=`$ECHO "$progpath" |$SED "$sed_dirname"`
+     progdir=`cd "$progdir" && pwd`
+     progpath=$progdir/$progname
+     ;;
+  *)
+     _G_IFS=$IFS
+     IFS=${PATH_SEPARATOR-:}
+     for progdir in $PATH; do
+       IFS=$_G_IFS
+       test -x "$progdir/$progname" && break
+     done
+     IFS=$_G_IFS
+     test -n "$progdir" || progdir=`pwd`
+     progpath=$progdir/$progname
+     ;;
+esac
+
+
+## ----------------- ##
+## Standard options. ##
+## ----------------- ##
+
+# The following options affect the operation of the functions defined
+# below, and should be set appropriately depending on run-time para-
+# meters passed on the command line.
+
+opt_dry_run=false
+opt_quiet=false
+opt_verbose=false
+
+# Categories 'all' and 'none' are always available.  Append any others
+# you will pass as the first argument to func_warning from your own
+# code.
+warning_categories=
+
+# By default, display warnings according to 'opt_warning_types'.  Set
+# 'warning_func'  to ':' to elide all warnings, or func_fatal_error to
+# treat the next displayed warning as a fatal error.
+warning_func=func_warn_and_continue
+
+# Set to 'all' to display all warnings, 'none' to suppress all
+# warnings, or a space delimited list of some subset of
+# 'warning_categories' to display only the listed warnings.
+opt_warning_types=all
+
+
+## -------------------- ##
+## Resource management. ##
+## -------------------- ##
+
+# This section contains definitions for functions that each ensure a
+# particular resource (a file, or a non-empty configuration variable for
+# example) is available, and if appropriate to extract default values
+# from pertinent package files. Call them using their associated
+# 'require_*' variable to ensure that they are executed, at most, once.
+#
+# It's entirely deliberate that calling these functions can set
+# variables that don't obey the namespace limitations obeyed by the rest
+# of this file, in order that that they be as useful as possible to
+# callers.
+
+
+# require_term_colors
+# -------------------
+# Allow display of bold text on terminals that support it.
+require_term_colors=func_require_term_colors
+func_require_term_colors ()
+{
+    $debug_cmd
+
+    test -t 1 && {
+      # COLORTERM and USE_ANSI_COLORS environment variables take
+      # precedence, because most terminfo databases neglect to describe
+      # whether color sequences are supported.
+      test -n "${COLORTERM+set}" && : ${USE_ANSI_COLORS="1"}
+
+      if test 1 = "$USE_ANSI_COLORS"; then
+        # Standard ANSI escape sequences
+        tc_reset=''
+        tc_bold='';   tc_standout=''
+        tc_red='';   tc_green=''
+        tc_blue='';  tc_cyan=''
+      else
+        # Otherwise trust the terminfo database after all.
+        test -n "`tput sgr0 2>/dev/null`" && {
+          tc_reset=`tput sgr0`
+          test -n "`tput bold 2>/dev/null`" && tc_bold=`tput bold`
+          tc_standout=$tc_bold
+          test -n "`tput smso 2>/dev/null`" && tc_standout=`tput smso`
+          test -n "`tput setaf 1 2>/dev/null`" && tc_red=`tput setaf 1`
+          test -n "`tput setaf 2 2>/dev/null`" && tc_green=`tput setaf 2`
+          test -n "`tput setaf 4 2>/dev/null`" && tc_blue=`tput setaf 4`
+          test -n "`tput setaf 5 2>/dev/null`" && tc_cyan=`tput setaf 5`
+        }
+      fi
+    }
+
+    require_term_colors=:
+}
+
+
+## ----------------- ##
+## Function library. ##
+## ----------------- ##
+
+# This section contains a variety of useful functions to call in your
+# scripts. Take note of the portable wrappers for features provided by
+# some modern shells, which will fall back to slower equivalents on
+# less featureful shells.
+
+
+# func_append VAR VALUE
+# ---------------------
+# Append VALUE onto the existing contents of VAR.
+
+  # We should try to minimise forks, especially on Windows where they are
+  # unreasonably slow, so skip the feature probes when bash or zsh are
+  # being used:
+  if test set = "${BASH_VERSION+set}${ZSH_VERSION+set}"; then
+    : ${_G_HAVE_ARITH_OP="yes"}
+    : ${_G_HAVE_XSI_OPS="yes"}
+    # The += operator was introduced in bash 3.1
+    case $BASH_VERSION in
+      [12].* | 3.0 | 3.0*) ;;
+      *)
+        : ${_G_HAVE_PLUSEQ_OP="yes"}
+        ;;
+    esac
+  fi
+
+  # _G_HAVE_PLUSEQ_OP
+  # Can be empty, in which case the shell is probed, "yes" if += is
+  # usable or anything else if it does not work.
+  test -z "$_G_HAVE_PLUSEQ_OP" \
+    && (eval 'x=a; x+=" b"; test "a b" = "$x"') 2>/dev/null \
+    && _G_HAVE_PLUSEQ_OP=yes
+
+if test yes = "$_G_HAVE_PLUSEQ_OP"
+then
+  # This is an XSI compatible shell, allowing a faster implementation...
+  eval 'func_append ()
+  {
+    $debug_cmd
+
+    eval "$1+=\$2"
+  }'
+else
+  # ...otherwise fall back to using expr, which is often a shell builtin.
+  func_append ()
+  {
+    $debug_cmd
+
+    eval "$1=\$$1\$2"
+  }
+fi
+
+
+# func_append_quoted VAR VALUE
+# ----------------------------
+# Quote VALUE and append to the end of shell variable VAR, separated
+# by a space.
+if test yes = "$_G_HAVE_PLUSEQ_OP"; then
+  eval 'func_append_quoted ()
+  {
+    $debug_cmd
+
+    func_quote_arg pretty "$2"
+    eval "$1+=\\ \$func_quote_arg_result"
+  }'
+else
+  func_append_quoted ()
+  {
+    $debug_cmd
+
+    func_quote_arg pretty "$2"
+    eval "$1=\$$1\\ \$func_quote_arg_result"
+  }
+fi
+
+
+# func_append_uniq VAR VALUE
+# --------------------------
+# Append unique VALUE onto the existing contents of VAR, assuming
+# entries are delimited by the first character of VALUE.  For example:
+#
+#   func_append_uniq options " --another-option option-argument"
+#
+# will only append to $options if " --another-option option-argument "
+# is not already present somewhere in $options already (note spaces at
+# each end implied by leading space in second argument).
+func_append_uniq ()
+{
+    $debug_cmd
+
+    eval _G_current_value='`$ECHO $'$1'`'
+    _G_delim=`expr "$2" : '\(.\)'`
+
+    case $_G_delim$_G_current_value$_G_delim in
+      *"$2$_G_delim"*) ;;
+      *) func_append "$@" ;;
+    esac
+}
+
+
+# func_arith TERM...
+# ------------------
+# Set func_arith_result to the result of evaluating TERMs.
+  test -z "$_G_HAVE_ARITH_OP" \
+    && (eval 'test 2 = $(( 1 + 1 ))') 2>/dev/null \
+    && _G_HAVE_ARITH_OP=yes
+
+if test yes = "$_G_HAVE_ARITH_OP"; then
+  eval 'func_arith ()
+  {
+    $debug_cmd
+
+    func_arith_result=$(( $* ))
+  }'
+else
+  func_arith ()
+  {
+    $debug_cmd
+
+    func_arith_result=`expr "$@"`
+  }
+fi
+
+
+# func_basename FILE
+# ------------------
+# Set func_basename_result to FILE with everything up to and including
+# the last / stripped.
+if test yes = "$_G_HAVE_XSI_OPS"; then
+  # If this shell supports suffix pattern removal, then use it to avoid
+  # forking. Hide the definitions single quotes in case the shell chokes
+  # on unsupported syntax...
+  _b='func_basename_result=${1##*/}'
+  _d='case $1 in
+        */*) func_dirname_result=${1%/*}$2 ;;
+        *  ) func_dirname_result=$3        ;;
+      esac'
+
+else
+  # ...otherwise fall back to using sed.
+  _b='func_basename_result=`$ECHO "$1" |$SED "$sed_basename"`'
+  _d='func_dirname_result=`$ECHO "$1"  |$SED "$sed_dirname"`
+      if test "X$func_dirname_result" = "X$1"; then
+        func_dirname_result=$3
+      else
+        func_append func_dirname_result "$2"
+      fi'
+fi
+
+eval 'func_basename ()
+{
+    $debug_cmd
+
+    '"$_b"'
+}'
+
+
+# func_dirname FILE APPEND NONDIR_REPLACEMENT
+# -------------------------------------------
+# Compute the dirname of FILE.  If nonempty, add APPEND to the result,
+# otherwise set result to NONDIR_REPLACEMENT.
+eval 'func_dirname ()
+{
+    $debug_cmd
+
+    '"$_d"'
+}'
+
+
+# func_dirname_and_basename FILE APPEND NONDIR_REPLACEMENT
+# --------------------------------------------------------
+# Perform func_basename and func_dirname in a single function
+# call:
+#   dirname:  Compute the dirname of FILE.  If nonempty,
+#             add APPEND to the result, otherwise set result
+#             to NONDIR_REPLACEMENT.
+#             value returned in "$func_dirname_result"
+#   basename: Compute filename of FILE.
+#             value returned in "$func_basename_result"
+# For efficiency, we do not delegate to the functions above but instead
+# duplicate the functionality here.
+eval 'func_dirname_and_basename ()
+{
+    $debug_cmd
+
+    '"$_b"'
+    '"$_d"'
+}'
+
+
+# func_echo ARG...
+# ----------------
+# Echo program name prefixed message.
+func_echo ()
+{
+    $debug_cmd
+
+    _G_message=$*
+
+    func_echo_IFS=$IFS
+    IFS=$nl
+    for _G_line in $_G_message; do
+      IFS=$func_echo_IFS
+      $ECHO "$progname: $_G_line"
+    done
+    IFS=$func_echo_IFS
+}
+
+
+# func_echo_all ARG...
+# --------------------
+# Invoke $ECHO with all args, space-separated.
+func_echo_all ()
+{
+    $ECHO "$*"
+}
+
+
+# func_echo_infix_1 INFIX ARG...
+# ------------------------------
+# Echo program name, followed by INFIX on the first line, with any
+# additional lines not showing INFIX.
+func_echo_infix_1 ()
+{
+    $debug_cmd
+
+    $require_term_colors
+
+    _G_infix=$1; shift
+    _G_indent=$_G_infix
+    _G_prefix="$progname: $_G_infix: "
+    _G_message=$*
+
+    # Strip color escape sequences before counting printable length
+    for _G_tc in "$tc_reset" "$tc_bold" "$tc_standout" "$tc_red" "$tc_green" "$tc_blue" "$tc_cyan"
+    do
+      test -n "$_G_tc" && {
+        _G_esc_tc=`$ECHO "$_G_tc" | $SED "$sed_make_literal_regex"`
+        _G_indent=`$ECHO "$_G_indent" | $SED "s|$_G_esc_tc||g"`
+      }
+    done
+    _G_indent="$progname: "`echo "$_G_indent" | $SED 's|.| |g'`"  " ## exclude from sc_prohibit_nested_quotes
+
+    func_echo_infix_1_IFS=$IFS
+    IFS=$nl
+    for _G_line in $_G_message; do
+      IFS=$func_echo_infix_1_IFS
+      $ECHO "$_G_prefix$tc_bold$_G_line$tc_reset" >&2
+      _G_prefix=$_G_indent
+    done
+    IFS=$func_echo_infix_1_IFS
+}
+
+
+# func_error ARG...
+# -----------------
+# Echo program name prefixed message to standard error.
+func_error ()
+{
+    $debug_cmd
+
+    $require_term_colors
+
+    func_echo_infix_1 "  $tc_standout${tc_red}error$tc_reset" "$*" >&2
+}
+
+
+# func_fatal_error ARG...
+# -----------------------
+# Echo program name prefixed message to standard error, and exit.
+func_fatal_error ()
+{
+    $debug_cmd
+
+    func_error "$*"
+    exit $EXIT_FAILURE
+}
+
+
+# func_grep EXPRESSION FILENAME
+# -----------------------------
+# Check whether EXPRESSION matches any line of FILENAME, without output.
+func_grep ()
+{
+    $debug_cmd
+
+    $GREP "$1" "$2" >/dev/null 2>&1
+}
+
+
+# func_len STRING
+# ---------------
+# Set func_len_result to the length of STRING. STRING may not
+# start with a hyphen.
+  test -z "$_G_HAVE_XSI_OPS" \
+    && (eval 'x=a/b/c;
+      test 5aa/bb/cc = "${#x}${x%%/*}${x%/*}${x#*/}${x##*/}"') 2>/dev/null \
+    && _G_HAVE_XSI_OPS=yes
+
+if test yes = "$_G_HAVE_XSI_OPS"; then
+  eval 'func_len ()
+  {
+    $debug_cmd
+
+    func_len_result=${#1}
+  }'
+else
+  func_len ()
+  {
+    $debug_cmd
+
+    func_len_result=`expr "$1" : ".*" 2>/dev/null || echo $max_cmd_len`
+  }
+fi
+
+
+# func_mkdir_p DIRECTORY-PATH
+# ---------------------------
+# Make sure the entire path to DIRECTORY-PATH is available.
+func_mkdir_p ()
+{
+    $debug_cmd
+
+    _G_directory_path=$1
+    _G_dir_list=
+
+    if test -n "$_G_directory_path" && test : != "$opt_dry_run"; then
+
+      # Protect directory names starting with '-'
+      case $_G_directory_path in
+        -*) _G_directory_path=./$_G_directory_path ;;
+      esac
+
+      # While some portion of DIR does not yet exist...
+      while test ! -d "$_G_directory_path"; do
+        # ...make a list in topmost first order.  Use a colon delimited
+	# list in case some portion of path contains whitespace.
+        _G_dir_list=$_G_directory_path:$_G_dir_list
+
+        # If the last portion added has no slash in it, the list is done
+        case $_G_directory_path in */*) ;; *) break ;; esac
+
+        # ...otherwise throw away the child directory and loop
+        _G_directory_path=`$ECHO "$_G_directory_path" | $SED -e "$sed_dirname"`
+      done
+      _G_dir_list=`$ECHO "$_G_dir_list" | $SED 's|:*$||'`
+
+      func_mkdir_p_IFS=$IFS; IFS=:
+      for _G_dir in $_G_dir_list; do
+	IFS=$func_mkdir_p_IFS
+        # mkdir can fail with a 'File exist' error if two processes
+        # try to create one of the directories concurrently.  Don't
+        # stop in that case!
+        $MKDIR "$_G_dir" 2>/dev/null || :
+      done
+      IFS=$func_mkdir_p_IFS
+
+      # Bail out if we (or some other process) failed to create a directory.
+      test -d "$_G_directory_path" || \
+        func_fatal_error "Failed to create '$1'"
+    fi
+}
+
+
+# func_mktempdir [BASENAME]
+# -------------------------
+# Make a temporary directory that won't clash with other running
+# libtool processes, and avoids race conditions if possible.  If
+# given, BASENAME is the basename for that directory.
+func_mktempdir ()
+{
+    $debug_cmd
+
+    _G_template=${TMPDIR-/tmp}/${1-$progname}
+
+    if test : = "$opt_dry_run"; then
+      # Return a directory name, but don't create it in dry-run mode
+      _G_tmpdir=$_G_template-$$
+    else
+
+      # If mktemp works, use that first and foremost
+      _G_tmpdir=`mktemp -d "$_G_template-XXXXXXXX" 2>/dev/null`
+
+      if test ! -d "$_G_tmpdir"; then
+        # Failing that, at least try and use $RANDOM to avoid a race
+        _G_tmpdir=$_G_template-${RANDOM-0}$$
+
+        func_mktempdir_umask=`umask`
+        umask 0077
+        $MKDIR "$_G_tmpdir"
+        umask $func_mktempdir_umask
+      fi
+
+      # If we're not in dry-run mode, bomb out on failure
+      test -d "$_G_tmpdir" || \
+        func_fatal_error "cannot create temporary directory '$_G_tmpdir'"
+    fi
+
+    $ECHO "$_G_tmpdir"
+}
+
+
+# func_normal_abspath PATH
+# ------------------------
+# Remove doubled-up and trailing slashes, "." path components,
+# and cancel out any ".." path components in PATH after making
+# it an absolute path.
+func_normal_abspath ()
+{
+    $debug_cmd
+
+    # These SED scripts presuppose an absolute path with a trailing slash.
+    _G_pathcar='s|^/\([^/]*\).*$|\1|'
+    _G_pathcdr='s|^/[^/]*||'
+    _G_removedotparts=':dotsl
+		s|/\./|/|g
+		t dotsl
+		s|/\.$|/|'
+    _G_collapseslashes='s|/\{1,\}|/|g'
+    _G_finalslash='s|/*$|/|'
+
+    # Start from root dir and reassemble the path.
+    func_normal_abspath_result=
+    func_normal_abspath_tpath=$1
+    func_normal_abspath_altnamespace=
+    case $func_normal_abspath_tpath in
+      "")
+        # Empty path, that just means $cwd.
+        func_stripname '' '/' "`pwd`"
+        func_normal_abspath_result=$func_stripname_result
+        return
+        ;;
+      # The next three entries are used to spot a run of precisely
+      # two leading slashes without using negated character classes;
+      # we take advantage of case's first-match behaviour.
+      ///*)
+        # Unusual form of absolute path, do nothing.
+        ;;
+      //*)
+        # Not necessarily an ordinary path; POSIX reserves leading '//'
+        # and for example Cygwin uses it to access remote file shares
+        # over CIFS/SMB, so we conserve a leading double slash if found.
+        func_normal_abspath_altnamespace=/
+        ;;
+      /*)
+        # Absolute path, do nothing.
+        ;;
+      *)
+        # Relative path, prepend $cwd.
+        func_normal_abspath_tpath=`pwd`/$func_normal_abspath_tpath
+        ;;
+    esac
+
+    # Cancel out all the simple stuff to save iterations.  We also want
+    # the path to end with a slash for ease of parsing, so make sure
+    # there is one (and only one) here.
+    func_normal_abspath_tpath=`$ECHO "$func_normal_abspath_tpath" | $SED \
+          -e "$_G_removedotparts" -e "$_G_collapseslashes" -e "$_G_finalslash"`
+    while :; do
+      # Processed it all yet?
+      if test / = "$func_normal_abspath_tpath"; then
+        # If we ascended to the root using ".." the result may be empty now.
+        if test -z "$func_normal_abspath_result"; then
+          func_normal_abspath_result=/
+        fi
+        break
+      fi
+      func_normal_abspath_tcomponent=`$ECHO "$func_normal_abspath_tpath" | $SED \
+          -e "$_G_pathcar"`
+      func_normal_abspath_tpath=`$ECHO "$func_normal_abspath_tpath" | $SED \
+          -e "$_G_pathcdr"`
+      # Figure out what to do with it
+      case $func_normal_abspath_tcomponent in
+        "")
+          # Trailing empty path component, ignore it.
+          ;;
+        ..)
+          # Parent dir; strip last assembled component from result.
+          func_dirname "$func_normal_abspath_result"
+          func_normal_abspath_result=$func_dirname_result
+          ;;
+        *)
+          # Actual path component, append it.
+          func_append func_normal_abspath_result "/$func_normal_abspath_tcomponent"
+          ;;
+      esac
+    done
+    # Restore leading double-slash if one was found on entry.
+    func_normal_abspath_result=$func_normal_abspath_altnamespace$func_normal_abspath_result
+}
+
+
+# func_notquiet ARG...
+# --------------------
+# Echo program name prefixed message only when not in quiet mode.
+func_notquiet ()
+{
+    $debug_cmd
+
+    $opt_quiet || func_echo ${1+"$@"}
+
+    # A bug in bash halts the script if the last line of a function
+    # fails when set -e is in force, so we need another command to
+    # work around that:
+    :
+}
+
+
+# func_relative_path SRCDIR DSTDIR
+# --------------------------------
+# Set func_relative_path_result to the relative path from SRCDIR to DSTDIR.
+func_relative_path ()
+{
+    $debug_cmd
+
+    func_relative_path_result=
+    func_normal_abspath "$1"
+    func_relative_path_tlibdir=$func_normal_abspath_result
+    func_normal_abspath "$2"
+    func_relative_path_tbindir=$func_normal_abspath_result
+
+    # Ascend the tree starting from libdir
+    while :; do
+      # check if we have found a prefix of bindir
+      case $func_relative_path_tbindir in
+        $func_relative_path_tlibdir)
+          # found an exact match
+          func_relative_path_tcancelled=
+          break
+          ;;
+        $func_relative_path_tlibdir*)
+          # found a matching prefix
+          func_stripname "$func_relative_path_tlibdir" '' "$func_relative_path_tbindir"
+          func_relative_path_tcancelled=$func_stripname_result
+          if test -z "$func_relative_path_result"; then
+            func_relative_path_result=.
+          fi
+          break
+          ;;
+        *)
+          func_dirname $func_relative_path_tlibdir
+          func_relative_path_tlibdir=$func_dirname_result
+          if test -z "$func_relative_path_tlibdir"; then
+            # Have to descend all the way to the root!
+            func_relative_path_result=../$func_relative_path_result
+            func_relative_path_tcancelled=$func_relative_path_tbindir
+            break
+          fi
+          func_relative_path_result=../$func_relative_path_result
+          ;;
+      esac
+    done
+
+    # Now calculate path; take care to avoid doubling-up slashes.
+    func_stripname '' '/' "$func_relative_path_result"
+    func_relative_path_result=$func_stripname_result
+    func_stripname '/' '/' "$func_relative_path_tcancelled"
+    if test -n "$func_stripname_result"; then
+      func_append func_relative_path_result "/$func_stripname_result"
+    fi
+
+    # Normalisation. If bindir is libdir, return '.' else relative path.
+    if test -n "$func_relative_path_result"; then
+      func_stripname './' '' "$func_relative_path_result"
+      func_relative_path_result=$func_stripname_result
+    fi
+
+    test -n "$func_relative_path_result" || func_relative_path_result=.
+
+    :
+}
+
+
+# func_quote_portable EVAL ARG
+# ----------------------------
+# Internal function to portably implement func_quote_arg.  Note that we still
+# keep attention to performance here so we as much as possible try to avoid
+# calling sed binary (so far O(N) complexity as long as func_append is O(1)).
+func_quote_portable ()
+{
+    $debug_cmd
+
+    func_quote_portable_result=$2
+
+    # one-time-loop (easy break)
+    while true
+    do
+      if $1; then
+        func_quote_portable_result=`$ECHO "$2" | $SED \
+          -e "$sed_double_quote_subst" -e "$sed_double_backslash"`
+        break
+      fi
+
+      # Quote for eval.
+      case $func_quote_portable_result in
+        *[\\\`\"\$]*)
+          case $func_quote_portable_result in
+            *[\[\*\?]*)
+              func_quote_portable_result=`$ECHO "$func_quote_portable_result" | $SED "$sed_quote_subst"`
+              break
+              ;;
+          esac
+
+          func_quote_portable_old_IFS=$IFS
+          for _G_char in '\' '`' '"' '$'
+          do
+            # STATE($1) PREV($2) SEPARATOR($3)
+            set start "" ""
+            func_quote_portable_result=dummy"$_G_char$func_quote_portable_result$_G_char"dummy
+            IFS=$_G_char
+            for _G_part in $func_quote_portable_result
+            do
+              case $1 in
+              quote)
+                func_append func_quote_portable_result "$3$2"
+                set quote "$_G_part" "\\$_G_char"
+                ;;
+              start)
+                set first "" ""
+                func_quote_portable_result=
+                ;;
+              first)
+                set quote "$_G_part" ""
+                ;;
+              esac
+            done
+          done
+          IFS=$func_quote_portable_old_IFS
+          ;;
+        *) ;;
+      esac
+      break
+    done
+
+    func_quote_portable_unquoted_result=$func_quote_portable_result
+    case $func_quote_portable_result in
+      # double-quote args containing shell metacharacters to delay
+      # word splitting, command substitution and variable expansion
+      # for a subsequent eval.
+      # many bourne shells cannot handle close brackets correctly
+      # in scan sets, so we specify it separately.
+      *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*|"")
+        func_quote_portable_result=\"$func_quote_portable_result\"
+        ;;
+    esac
+}
+
+
+# func_quotefast_eval ARG
+# -----------------------
+# Quote one ARG (internal).  This is equivalent to 'func_quote_arg eval ARG',
+# but optimized for speed.  Result is stored in $func_quotefast_eval.
+if test xyes = `(x=; printf -v x %q yes; echo x"$x") 2>/dev/null`; then
+  func_quotefast_eval ()
+  {
+    printf -v func_quotefast_eval_result %q "$1"
+  }
+else
+  func_quotefast_eval ()
+  {
+    func_quote_portable false "$1"
+    func_quotefast_eval_result=$func_quote_portable_result
+  }
+fi
+
+
+# func_quote_arg MODEs ARG
+# ------------------------
+# Quote one ARG to be evaled later.  MODEs argument may contain zero ore more
+# specifiers listed below separated by ',' character.  This function returns two
+# values:
+#   i) func_quote_arg_result
+#      double-quoted (when needed), suitable for a subsequent eval
+#  ii) func_quote_arg_unquoted_result
+#      has all characters that are still active within double
+#      quotes backslashified.  Available only if 'unquoted' is specified.
+#
+# Available modes:
+# ----------------
+# 'eval' (default)
+#       - escape shell special characters
+# 'expand'
+#       - the same as 'eval';  but do not quote variable references
+# 'pretty'
+#       - request aesthetic output, i.e. '"a b"' instead of 'a\ b'.  This might
+#         later used in func_quote to get output like: 'echo "a b"' instead of
+#         'echo a\ b'.  This is slower than default on some shells.
+# 'unquoted'
+#       - produce also $func_quote_arg_unquoted_result which does not contain
+#         wrapping double-quotes.
+#
+# Examples for 'func_quote_arg pretty,unquoted string':
+#
+#   string      | *_result              | *_unquoted_result
+#   ------------+-----------------------+-------------------
+#   "           | \"                    | \"
+#   a b         | "a b"                 | a b
+#   "a b"       | "\"a b\""             | \"a b\"
+#   *           | "*"                   | *
+#   z="${x-$y}" | "z=\"\${x-\$y}\""     | z=\"\${x-\$y}\"
+#
+# Examples for 'func_quote_arg pretty,unquoted,expand string':
+#
+#   string        |   *_result          |  *_unquoted_result
+#   --------------+---------------------+--------------------
+#   z="${x-$y}"   | "z=\"${x-$y}\""     | z=\"${x-$y}\"
+func_quote_arg ()
+{
+    _G_quote_expand=false
+    case ,$1, in
+      *,expand,*)
+        _G_quote_expand=:
+        ;;
+    esac
+
+    case ,$1, in
+      *,pretty,*|*,expand,*|*,unquoted,*)
+        func_quote_portable $_G_quote_expand "$2"
+        func_quote_arg_result=$func_quote_portable_result
+        func_quote_arg_unquoted_result=$func_quote_portable_unquoted_result
+        ;;
+      *)
+        # Faster quote-for-eval for some shells.
+        func_quotefast_eval "$2"
+        func_quote_arg_result=$func_quotefast_eval_result
+        ;;
+    esac
+}
+
+
+# func_quote MODEs ARGs...
+# ------------------------
+# Quote all ARGs to be evaled later and join them into single command.  See
+# func_quote_arg's description for more info.
+func_quote ()
+{
+    $debug_cmd
+    _G_func_quote_mode=$1 ; shift
+    func_quote_result=
+    while test 0 -lt $#; do
+      func_quote_arg "$_G_func_quote_mode" "$1"
+      if test -n "$func_quote_result"; then
+        func_append func_quote_result " $func_quote_arg_result"
+      else
+        func_append func_quote_result "$func_quote_arg_result"
+      fi
+      shift
+    done
+}
+
+
+# func_stripname PREFIX SUFFIX NAME
+# ---------------------------------
+# strip PREFIX and SUFFIX from NAME, and store in func_stripname_result.
+# PREFIX and SUFFIX must not contain globbing or regex special
+# characters, hashes, percent signs, but SUFFIX may contain a leading
+# dot (in which case that matches only a dot).
+if test yes = "$_G_HAVE_XSI_OPS"; then
+  eval 'func_stripname ()
+  {
+    $debug_cmd
+
+    # pdksh 5.2.14 does not do ${X%$Y} correctly if both X and Y are
+    # positional parameters, so assign one to ordinary variable first.
+    func_stripname_result=$3
+    func_stripname_result=${func_stripname_result#"$1"}
+    func_stripname_result=${func_stripname_result%"$2"}
+  }'
+else
+  func_stripname ()
+  {
+    $debug_cmd
+
+    case $2 in
+      .*) func_stripname_result=`$ECHO "$3" | $SED -e "s%^$1%%" -e "s%\\\\$2\$%%"`;;
+      *)  func_stripname_result=`$ECHO "$3" | $SED -e "s%^$1%%" -e "s%$2\$%%"`;;
+    esac
+  }
+fi
+
+
+# func_show_eval CMD [FAIL_EXP]
+# -----------------------------
+# Unless opt_quiet is true, then output CMD.  Then, if opt_dryrun is
+# not true, evaluate CMD.  If the evaluation of CMD fails, and FAIL_EXP
+# is given, then evaluate it.
+func_show_eval ()
+{
+    $debug_cmd
+
+    _G_cmd=$1
+    _G_fail_exp=${2-':'}
+
+    func_quote_arg pretty,expand "$_G_cmd"
+    eval "func_notquiet $func_quote_arg_result"
+
+    $opt_dry_run || {
+      eval "$_G_cmd"
+      _G_status=$?
+      if test 0 -ne "$_G_status"; then
+	eval "(exit $_G_status); $_G_fail_exp"
+      fi
+    }
+}
+
+
+# func_show_eval_locale CMD [FAIL_EXP]
+# ------------------------------------
+# Unless opt_quiet is true, then output CMD.  Then, if opt_dryrun is
+# not true, evaluate CMD.  If the evaluation of CMD fails, and FAIL_EXP
+# is given, then evaluate it.  Use the saved locale for evaluation.
+func_show_eval_locale ()
+{
+    $debug_cmd
+
+    _G_cmd=$1
+    _G_fail_exp=${2-':'}
+
+    $opt_quiet || {
+      func_quote_arg expand,pretty "$_G_cmd"
+      eval "func_echo $func_quote_arg_result"
+    }
+
+    $opt_dry_run || {
+      eval "$_G_user_locale
+	    $_G_cmd"
+      _G_status=$?
+      eval "$_G_safe_locale"
+      if test 0 -ne "$_G_status"; then
+	eval "(exit $_G_status); $_G_fail_exp"
+      fi
+    }
+}
+
+
+# func_tr_sh
+# ----------
+# Turn $1 into a string suitable for a shell variable name.
+# Result is stored in $func_tr_sh_result.  All characters
+# not in the set a-zA-Z0-9_ are replaced with '_'. Further,
+# if $1 begins with a digit, a '_' is prepended as well.
+func_tr_sh ()
+{
+    $debug_cmd
+
+    case $1 in
+    [0-9]* | *[!a-zA-Z0-9_]*)
+      func_tr_sh_result=`$ECHO "$1" | $SED -e 's/^\([0-9]\)/_\1/' -e 's/[^a-zA-Z0-9_]/_/g'`
+      ;;
+    * )
+      func_tr_sh_result=$1
+      ;;
+    esac
+}
+
+
+# func_verbose ARG...
+# -------------------
+# Echo program name prefixed message in verbose mode only.
+func_verbose ()
+{
+    $debug_cmd
+
+    $opt_verbose && func_echo "$*"
+
+    :
+}
+
+
+# func_warn_and_continue ARG...
+# -----------------------------
+# Echo program name prefixed warning message to standard error.
+func_warn_and_continue ()
+{
+    $debug_cmd
+
+    $require_term_colors
+
+    func_echo_infix_1 "${tc_red}warning$tc_reset" "$*" >&2
+}
+
+
+# func_warning CATEGORY ARG...
+# ----------------------------
+# Echo program name prefixed warning message to standard error. Warning
+# messages can be filtered according to CATEGORY, where this function
+# elides messages where CATEGORY is not listed in the global variable
+# 'opt_warning_types'.
+func_warning ()
+{
+    $debug_cmd
+
+    # CATEGORY must be in the warning_categories list!
+    case " $warning_categories " in
+      *" $1 "*) ;;
+      *) func_internal_error "invalid warning category '$1'" ;;
+    esac
+
+    _G_category=$1
+    shift
+
+    case " $opt_warning_types " in
+      *" $_G_category "*) $warning_func ${1+"$@"} ;;
+    esac
+}
+
+
+# func_sort_ver VER1 VER2
+# -----------------------
+# 'sort -V' is not generally available.
+# Note this deviates from the version comparison in automake
+# in that it treats 1.5 < 1.5.0, and treats 1.4.4a < 1.4-p3a
+# but this should suffice as we won't be specifying old
+# version formats or redundant trailing .0 in bootstrap.conf.
+# If we did want full compatibility then we should probably
+# use m4_version_compare from autoconf.
+func_sort_ver ()
+{
+    $debug_cmd
+
+    printf '%s\n%s\n' "$1" "$2" \
+      | sort -t. -k 1,1n -k 2,2n -k 3,3n -k 4,4n -k 5,5n -k 6,6n -k 7,7n -k 8,8n -k 9,9n
+}
+
+# func_lt_ver PREV CURR
+# ---------------------
+# Return true if PREV and CURR are in the correct order according to
+# func_sort_ver, otherwise false.  Use it like this:
+#
+#  func_lt_ver "$prev_ver" "$proposed_ver" || func_fatal_error "..."
+func_lt_ver ()
+{
+    $debug_cmd
+
+    test "x$1" = x`func_sort_ver "$1" "$2" | $SED 1q`
+}
+
+
+# Local variables:
+# mode: shell-script
+# sh-indentation: 2
+# eval: (add-hook 'before-save-hook 'time-stamp)
+# time-stamp-pattern: "10/scriptversion=%:y-%02m-%02d.%02H; # UTC"
+# time-stamp-time-zone: "UTC"
+# End:
+#! /bin/sh
+
+# Set a version string for this script.
+scriptversion=2015-10-12.13; # UTC
+
+# A portable, pluggable option parser for Bourne shell.
+# Written by Gary V. Vaughan, 2010
+
+# Copyright (C) 2010-2015 Free Software Foundation, Inc.
+# This is free software; see the source for copying conditions.  There is NO
+# warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see .
+
+# Please report bugs or propose patches to gary@gnu.org.
+
+
+## ------ ##
+## Usage. ##
+## ------ ##
+
+# This file is a library for parsing options in your shell scripts along
+# with assorted other useful supporting features that you can make use
+# of too.
+#
+# For the simplest scripts you might need only:
+#
+#   #!/bin/sh
+#   . relative/path/to/funclib.sh
+#   . relative/path/to/options-parser
+#   scriptversion=1.0
+#   func_options ${1+"$@"}
+#   eval set dummy "$func_options_result"; shift
+#   ...rest of your script...
+#
+# In order for the '--version' option to work, you will need to have a
+# suitably formatted comment like the one at the top of this file
+# starting with '# Written by ' and ending with '# warranty; '.
+#
+# For '-h' and '--help' to work, you will also need a one line
+# description of your script's purpose in a comment directly above the
+# '# Written by ' line, like the one at the top of this file.
+#
+# The default options also support '--debug', which will turn on shell
+# execution tracing (see the comment above debug_cmd below for another
+# use), and '--verbose' and the func_verbose function to allow your script
+# to display verbose messages only when your user has specified
+# '--verbose'.
+#
+# After sourcing this file, you can plug processing for additional
+# options by amending the variables from the 'Configuration' section
+# below, and following the instructions in the 'Option parsing'
+# section further down.
+
+## -------------- ##
+## Configuration. ##
+## -------------- ##
+
+# You should override these variables in your script after sourcing this
+# file so that they reflect the customisations you have added to the
+# option parser.
+
+# The usage line for option parsing errors and the start of '-h' and
+# '--help' output messages. You can embed shell variables for delayed
+# expansion at the time the message is displayed, but you will need to
+# quote other shell meta-characters carefully to prevent them being
+# expanded when the contents are evaled.
+usage='$progpath [OPTION]...'
+
+# Short help message in response to '-h' and '--help'.  Add to this or
+# override it after sourcing this library to reflect the full set of
+# options your script accepts.
+usage_message="\
+       --debug        enable verbose shell tracing
+   -W, --warnings=CATEGORY
+                      report the warnings falling in CATEGORY [all]
+   -v, --verbose      verbosely report processing
+       --version      print version information and exit
+   -h, --help         print short or long help message and exit
+"
+
+# Additional text appended to 'usage_message' in response to '--help'.
+long_help_message="
+Warning categories include:
+       'all'          show all warnings
+       'none'         turn off all the warnings
+       'error'        warnings are treated as fatal errors"
+
+# Help message printed before fatal option parsing errors.
+fatal_help="Try '\$progname --help' for more information."
+
+
+
+## ------------------------- ##
+## Hook function management. ##
+## ------------------------- ##
+
+# This section contains functions for adding, removing, and running hooks
+# to the main code.  A hook is just a named list of of function, that can
+# be run in order later on.
+
+# func_hookable FUNC_NAME
+# -----------------------
+# Declare that FUNC_NAME will run hooks added with
+# 'func_add_hook FUNC_NAME ...'.
+func_hookable ()
+{
+    $debug_cmd
+
+    func_append hookable_fns " $1"
+}
+
+
+# func_add_hook FUNC_NAME HOOK_FUNC
+# ---------------------------------
+# Request that FUNC_NAME call HOOK_FUNC before it returns.  FUNC_NAME must
+# first have been declared "hookable" by a call to 'func_hookable'.
+func_add_hook ()
+{
+    $debug_cmd
+
+    case " $hookable_fns " in
+      *" $1 "*) ;;
+      *) func_fatal_error "'$1' does not accept hook functions." ;;
+    esac
+
+    eval func_append ${1}_hooks '" $2"'
+}
+
+
+# func_remove_hook FUNC_NAME HOOK_FUNC
+# ------------------------------------
+# Remove HOOK_FUNC from the list of functions called by FUNC_NAME.
+func_remove_hook ()
+{
+    $debug_cmd
+
+    eval ${1}_hooks='`$ECHO "\$'$1'_hooks" |$SED "s| '$2'||"`'
+}
+
+
+# func_run_hooks FUNC_NAME [ARG]...
+# ---------------------------------
+# Run all hook functions registered to FUNC_NAME.
+# It is assumed that the list of hook functions contains nothing more
+# than a whitespace-delimited list of legal shell function names, and
+# no effort is wasted trying to catch shell meta-characters or preserve
+# whitespace.
+func_run_hooks ()
+{
+    $debug_cmd
+
+    _G_rc_run_hooks=false
+
+    case " $hookable_fns " in
+      *" $1 "*) ;;
+      *) func_fatal_error "'$1' does not support hook functions.n" ;;
+    esac
+
+    eval _G_hook_fns=\$$1_hooks; shift
+
+    for _G_hook in $_G_hook_fns; do
+      if eval $_G_hook '"$@"'; then
+        # store returned options list back into positional
+        # parameters for next 'cmd' execution.
+        eval _G_hook_result=\$${_G_hook}_result
+        eval set dummy "$_G_hook_result"; shift
+        _G_rc_run_hooks=:
+      fi
+    done
+
+    $_G_rc_run_hooks && func_run_hooks_result=$_G_hook_result
+}
+
+
+
+## --------------- ##
+## Option parsing. ##
+## --------------- ##
+
+# In order to add your own option parsing hooks, you must accept the
+# full positional parameter list in your hook function, you may remove/edit
+# any options that you action, and then pass back the remaining unprocessed
+# options in '_result', escaped suitably for
+# 'eval'.  In this case you also must return $EXIT_SUCCESS to let the
+# hook's caller know that it should pay attention to
+# '_result'.  Returning $EXIT_FAILURE signalizes that
+# arguments are left untouched by the hook and therefore caller will ignore the
+# result variable.
+#
+# Like this:
+#
+#    my_options_prep ()
+#    {
+#        $debug_cmd
+#
+#        # Extend the existing usage message.
+#        usage_message=$usage_message'
+#      -s, --silent       don'\''t print informational messages
+#    '
+#        # No change in '$@' (ignored completely by this hook).  There is
+#        # no need to do the equivalent (but slower) action:
+#        # func_quote eval ${1+"$@"}
+#        # my_options_prep_result=$func_quote_result
+#        false
+#    }
+#    func_add_hook func_options_prep my_options_prep
+#
+#
+#    my_silent_option ()
+#    {
+#        $debug_cmd
+#
+#        args_changed=false
+#
+#        # Note that for efficiency, we parse as many options as we can
+#        # recognise in a loop before passing the remainder back to the
+#        # caller on the first unrecognised argument we encounter.
+#        while test $# -gt 0; do
+#          opt=$1; shift
+#          case $opt in
+#            --silent|-s) opt_silent=:
+#                         args_changed=:
+#                         ;;
+#            # Separate non-argument short options:
+#            -s*)         func_split_short_opt "$_G_opt"
+#                         set dummy "$func_split_short_opt_name" \
+#                             "-$func_split_short_opt_arg" ${1+"$@"}
+#                         shift
+#                         args_changed=:
+#                         ;;
+#            *)           # Make sure the first unrecognised option "$_G_opt"
+#                         # is added back to "$@", we could need that later
+#                         # if $args_changed is true.
+#                         set dummy "$_G_opt" ${1+"$@"}; shift; break ;;
+#          esac
+#        done
+#
+#        if $args_changed; then
+#          func_quote eval ${1+"$@"}
+#          my_silent_option_result=$func_quote_result
+#        fi
+#
+#        $args_changed
+#    }
+#    func_add_hook func_parse_options my_silent_option
+#
+#
+#    my_option_validation ()
+#    {
+#        $debug_cmd
+#
+#        $opt_silent && $opt_verbose && func_fatal_help "\
+#    '--silent' and '--verbose' options are mutually exclusive."
+#
+#        false
+#    }
+#    func_add_hook func_validate_options my_option_validation
+#
+# You'll also need to manually amend $usage_message to reflect the extra
+# options you parse.  It's preferable to append if you can, so that
+# multiple option parsing hooks can be added safely.
+
+
+# func_options_finish [ARG]...
+# ----------------------------
+# Finishing the option parse loop (call 'func_options' hooks ATM).
+func_options_finish ()
+{
+    $debug_cmd
+
+    _G_func_options_finish_exit=false
+    if func_run_hooks func_options ${1+"$@"}; then
+      func_options_finish_result=$func_run_hooks_result
+      _G_func_options_finish_exit=:
+    fi
+
+    $_G_func_options_finish_exit
+}
+
+
+# func_options [ARG]...
+# ---------------------
+# All the functions called inside func_options are hookable. See the
+# individual implementations for details.
+func_hookable func_options
+func_options ()
+{
+    $debug_cmd
+
+    _G_rc_options=false
+
+    for my_func in options_prep parse_options validate_options options_finish
+    do
+      if eval func_$my_func '${1+"$@"}'; then
+        eval _G_res_var='$'"func_${my_func}_result"
+        eval set dummy "$_G_res_var" ; shift
+        _G_rc_options=:
+      fi
+    done
+
+    # Save modified positional parameters for caller.  As a top-level
+    # options-parser function we always need to set the 'func_options_result'
+    # variable (regardless the $_G_rc_options value).
+    if $_G_rc_options; then
+      func_options_result=$_G_res_var
+    else
+      func_quote eval ${1+"$@"}
+      func_options_result=$func_quote_result
+    fi
+
+    $_G_rc_options
+}
+
+
+# func_options_prep [ARG]...
+# --------------------------
+# All initialisations required before starting the option parse loop.
+# Note that when calling hook functions, we pass through the list of
+# positional parameters.  If a hook function modifies that list, and
+# needs to propagate that back to rest of this script, then the complete
+# modified list must be put in 'func_run_hooks_result' before
+# returning $EXIT_SUCCESS (otherwise $EXIT_FAILURE is returned).
+func_hookable func_options_prep
+func_options_prep ()
+{
+    $debug_cmd
+
+    # Option defaults:
+    opt_verbose=false
+    opt_warning_types=
+
+    _G_rc_options_prep=false
+    if func_run_hooks func_options_prep ${1+"$@"}; then
+      _G_rc_options_prep=:
+      # save modified positional parameters for caller
+      func_options_prep_result=$func_run_hooks_result
+    fi
+
+    $_G_rc_options_prep
+}
+
+
+# func_parse_options [ARG]...
+# ---------------------------
+# The main option parsing loop.
+func_hookable func_parse_options
+func_parse_options ()
+{
+    $debug_cmd
+
+    func_parse_options_result=
+
+    _G_rc_parse_options=false
+    # this just eases exit handling
+    while test $# -gt 0; do
+      # Defer to hook functions for initial option parsing, so they
+      # get priority in the event of reusing an option name.
+      if func_run_hooks func_parse_options ${1+"$@"}; then
+        eval set dummy "$func_run_hooks_result"; shift
+        _G_rc_parse_options=:
+      fi
+
+      # Break out of the loop if we already parsed every option.
+      test $# -gt 0 || break
+
+      _G_match_parse_options=:
+      _G_opt=$1
+      shift
+      case $_G_opt in
+        --debug|-x)   debug_cmd='set -x'
+                      func_echo "enabling shell trace mode"
+                      $debug_cmd
+                      ;;
+
+        --no-warnings|--no-warning|--no-warn)
+                      set dummy --warnings none ${1+"$@"}
+                      shift
+		      ;;
+
+        --warnings|--warning|-W)
+                      if test $# = 0 && func_missing_arg $_G_opt; then
+                        _G_rc_parse_options=:
+                        break
+                      fi
+                      case " $warning_categories $1" in
+                        *" $1 "*)
+                          # trailing space prevents matching last $1 above
+                          func_append_uniq opt_warning_types " $1"
+                          ;;
+                        *all)
+                          opt_warning_types=$warning_categories
+                          ;;
+                        *none)
+                          opt_warning_types=none
+                          warning_func=:
+                          ;;
+                        *error)
+                          opt_warning_types=$warning_categories
+                          warning_func=func_fatal_error
+                          ;;
+                        *)
+                          func_fatal_error \
+                             "unsupported warning category: '$1'"
+                          ;;
+                      esac
+                      shift
+                      ;;
+
+        --verbose|-v) opt_verbose=: ;;
+        --version)    func_version ;;
+        -\?|-h)       func_usage ;;
+        --help)       func_help ;;
+
+	# Separate optargs to long options (plugins may need this):
+	--*=*)        func_split_equals "$_G_opt"
+	              set dummy "$func_split_equals_lhs" \
+                          "$func_split_equals_rhs" ${1+"$@"}
+                      shift
+                      ;;
+
+       # Separate optargs to short options:
+        -W*)
+                      func_split_short_opt "$_G_opt"
+                      set dummy "$func_split_short_opt_name" \
+                          "$func_split_short_opt_arg" ${1+"$@"}
+                      shift
+                      ;;
+
+        # Separate non-argument short options:
+        -\?*|-h*|-v*|-x*)
+                      func_split_short_opt "$_G_opt"
+                      set dummy "$func_split_short_opt_name" \
+                          "-$func_split_short_opt_arg" ${1+"$@"}
+                      shift
+                      ;;
+
+        --)           _G_rc_parse_options=: ; break ;;
+        -*)           func_fatal_help "unrecognised option: '$_G_opt'" ;;
+        *)            set dummy "$_G_opt" ${1+"$@"}; shift
+                      _G_match_parse_options=false
+                      break
+                      ;;
+      esac
+
+      $_G_match_parse_options && _G_rc_parse_options=:
+    done
+
+
+    if $_G_rc_parse_options; then
+      # save modified positional parameters for caller
+      func_quote eval ${1+"$@"}
+      func_parse_options_result=$func_quote_result
+    fi
+
+    $_G_rc_parse_options
+}
+
+
+# func_validate_options [ARG]...
+# ------------------------------
+# Perform any sanity checks on option settings and/or unconsumed
+# arguments.
+func_hookable func_validate_options
+func_validate_options ()
+{
+    $debug_cmd
+
+    _G_rc_validate_options=false
+
+    # Display all warnings if -W was not given.
+    test -n "$opt_warning_types" || opt_warning_types=" $warning_categories"
+
+    if func_run_hooks func_validate_options ${1+"$@"}; then
+      # save modified positional parameters for caller
+      func_validate_options_result=$func_run_hooks_result
+      _G_rc_validate_options=:
+    fi
+
+    # Bail if the options were screwed!
+    $exit_cmd $EXIT_FAILURE
+
+    $_G_rc_validate_options
+}
+
+
+
+## ----------------- ##
+## Helper functions. ##
+## ----------------- ##
+
+# This section contains the helper functions used by the rest of the
+# hookable option parser framework in ascii-betical order.
+
+
+# func_fatal_help ARG...
+# ----------------------
+# Echo program name prefixed message to standard error, followed by
+# a help hint, and exit.
+func_fatal_help ()
+{
+    $debug_cmd
+
+    eval \$ECHO \""Usage: $usage"\"
+    eval \$ECHO \""$fatal_help"\"
+    func_error ${1+"$@"}
+    exit $EXIT_FAILURE
+}
+
+
+# func_help
+# ---------
+# Echo long help message to standard output and exit.
+func_help ()
+{
+    $debug_cmd
+
+    func_usage_message
+    $ECHO "$long_help_message"
+    exit 0
+}
+
+
+# func_missing_arg ARGNAME
+# ------------------------
+# Echo program name prefixed message to standard error and set global
+# exit_cmd.
+func_missing_arg ()
+{
+    $debug_cmd
+
+    func_error "Missing argument for '$1'."
+    exit_cmd=exit
+}
+
+
+# func_split_equals STRING
+# ------------------------
+# Set func_split_equals_lhs and func_split_equals_rhs shell variables after
+# splitting STRING at the '=' sign.
+test -z "$_G_HAVE_XSI_OPS" \
+    && (eval 'x=a/b/c;
+      test 5aa/bb/cc = "${#x}${x%%/*}${x%/*}${x#*/}${x##*/}"') 2>/dev/null \
+    && _G_HAVE_XSI_OPS=yes
+
+if test yes = "$_G_HAVE_XSI_OPS"
+then
+  # This is an XSI compatible shell, allowing a faster implementation...
+  eval 'func_split_equals ()
+  {
+      $debug_cmd
+
+      func_split_equals_lhs=${1%%=*}
+      func_split_equals_rhs=${1#*=}
+      test "x$func_split_equals_lhs" = "x$1" \
+        && func_split_equals_rhs=
+  }'
+else
+  # ...otherwise fall back to using expr, which is often a shell builtin.
+  func_split_equals ()
+  {
+      $debug_cmd
+
+      func_split_equals_lhs=`expr "x$1" : 'x\([^=]*\)'`
+      func_split_equals_rhs=
+      test "x$func_split_equals_lhs" = "x$1" \
+        || func_split_equals_rhs=`expr "x$1" : 'x[^=]*=\(.*\)$'`
+  }
+fi #func_split_equals
+
+
+# func_split_short_opt SHORTOPT
+# -----------------------------
+# Set func_split_short_opt_name and func_split_short_opt_arg shell
+# variables after splitting SHORTOPT after the 2nd character.
+if test yes = "$_G_HAVE_XSI_OPS"
+then
+  # This is an XSI compatible shell, allowing a faster implementation...
+  eval 'func_split_short_opt ()
+  {
+      $debug_cmd
+
+      func_split_short_opt_arg=${1#??}
+      func_split_short_opt_name=${1%"$func_split_short_opt_arg"}
+  }'
+else
+  # ...otherwise fall back to using expr, which is often a shell builtin.
+  func_split_short_opt ()
+  {
+      $debug_cmd
+
+      func_split_short_opt_name=`expr "x$1" : 'x-\(.\)'`
+      func_split_short_opt_arg=`expr "x$1" : 'x-.\(.*\)$'`
+  }
+fi #func_split_short_opt
+
+
+# func_usage
+# ----------
+# Echo short help message to standard output and exit.
+func_usage ()
+{
+    $debug_cmd
+
+    func_usage_message
+    $ECHO "Run '$progname --help |${PAGER-more}' for full usage"
+    exit 0
+}
+
+
+# func_usage_message
+# ------------------
+# Echo short help message to standard output.
+func_usage_message ()
+{
+    $debug_cmd
+
+    eval \$ECHO \""Usage: $usage"\"
+    echo
+    $SED -n 's|^# ||
+        /^Written by/{
+          x;p;x
+        }
+	h
+	/^Written by/q' < "$progpath"
+    echo
+    eval \$ECHO \""$usage_message"\"
+}
+
+
+# func_version
+# ------------
+# Echo version message to standard output and exit.
+func_version ()
+{
+    $debug_cmd
+
+    printf '%s\n' "$progname $scriptversion"
+    $SED -n '
+        /(C)/!b go
+        :more
+        /\./!{
+          N
+          s|\n# | |
+          b more
+        }
+        :go
+        /^# Written by /,/# warranty; / {
+          s|^# ||
+          s|^# *$||
+          s|\((C)\)[ 0-9,-]*[ ,-]\([1-9][0-9]* \)|\1 \2|
+          p
+        }
+        /^# Written by / {
+          s|^# ||
+          p
+        }
+        /^warranty; /q' < "$progpath"
+
+    exit $?
+}
+
+
+# Local variables:
+# mode: shell-script
+# sh-indentation: 2
+# eval: (add-hook 'before-save-hook 'time-stamp)
+# time-stamp-pattern: "10/scriptversion=%:y-%02m-%02d.%02H; # UTC"
+# time-stamp-time-zone: "UTC"
+# End:
+
+# Set a version string.
+scriptversion='(GNU libtool) 2.4.6'
+
+
+# func_echo ARG...
+# ----------------
+# Libtool also displays the current mode in messages, so override
+# funclib.sh func_echo with this custom definition.
+func_echo ()
+{
+    $debug_cmd
+
+    _G_message=$*
+
+    func_echo_IFS=$IFS
+    IFS=$nl
+    for _G_line in $_G_message; do
+      IFS=$func_echo_IFS
+      $ECHO "$progname${opt_mode+: $opt_mode}: $_G_line"
+    done
+    IFS=$func_echo_IFS
+}
+
+
+# func_warning ARG...
+# -------------------
+# Libtool warnings are not categorized, so override funclib.sh
+# func_warning with this simpler definition.
+func_warning ()
+{
+    $debug_cmd
+
+    $warning_func ${1+"$@"}
+}
+
+
+## ---------------- ##
+## Options parsing. ##
+## ---------------- ##
+
+# Hook in the functions to make sure our own options are parsed during
+# the option parsing loop.
+
+usage='$progpath [OPTION]... [MODE-ARG]...'
+
+# Short help message in response to '-h'.
+usage_message="Options:
+       --config             show all configuration variables
+       --debug              enable verbose shell tracing
+   -n, --dry-run            display commands without modifying any files
+       --features           display basic configuration information and exit
+       --mode=MODE          use operation mode MODE
+       --no-warnings        equivalent to '-Wnone'
+       --preserve-dup-deps  don't remove duplicate dependency libraries
+       --quiet, --silent    don't print informational messages
+       --tag=TAG            use configuration variables from tag TAG
+   -v, --verbose            print more informational messages than default
+       --version            print version information
+   -W, --warnings=CATEGORY  report the warnings falling in CATEGORY [all]
+   -h, --help, --help-all   print short, long, or detailed help message
+"
+
+# Additional text appended to 'usage_message' in response to '--help'.
+func_help ()
+{
+    $debug_cmd
+
+    func_usage_message
+    $ECHO "$long_help_message
+
+MODE must be one of the following:
+
+       clean           remove files from the build directory
+       compile         compile a source file into a libtool object
+       execute         automatically set library path, then run a program
+       finish          complete the installation of libtool libraries
+       install         install libraries or executables
+       link            create a library or an executable
+       uninstall       remove libraries from an installed directory
+
+MODE-ARGS vary depending on the MODE.  When passed as first option,
+'--mode=MODE' may be abbreviated as 'MODE' or a unique abbreviation of that.
+Try '$progname --help --mode=MODE' for a more detailed description of MODE.
+
+When reporting a bug, please describe a test case to reproduce it and
+include the following information:
+
+       host-triplet:   $host
+       shell:          $SHELL
+       compiler:       $LTCC
+       compiler flags: $LTCFLAGS
+       linker:         $LD (gnu? $with_gnu_ld)
+       version:        $progname $scriptversion Debian-2.4.6-2.1
+       automake:       `($AUTOMAKE --version) 2>/dev/null |$SED 1q`
+       autoconf:       `($AUTOCONF --version) 2>/dev/null |$SED 1q`
+
+Report bugs to .
+GNU libtool home page: .
+General help using GNU software: ."
+    exit 0
+}
+
+
+# func_lo2o OBJECT-NAME
+# ---------------------
+# Transform OBJECT-NAME from a '.lo' suffix to the platform specific
+# object suffix.
+
+lo2o=s/\\.lo\$/.$objext/
+o2lo=s/\\.$objext\$/.lo/
+
+if test yes = "$_G_HAVE_XSI_OPS"; then
+  eval 'func_lo2o ()
+  {
+    case $1 in
+      *.lo) func_lo2o_result=${1%.lo}.$objext ;;
+      *   ) func_lo2o_result=$1               ;;
+    esac
+  }'
+
+  # func_xform LIBOBJ-OR-SOURCE
+  # ---------------------------
+  # Transform LIBOBJ-OR-SOURCE from a '.o' or '.c' (or otherwise)
+  # suffix to a '.lo' libtool-object suffix.
+  eval 'func_xform ()
+  {
+    func_xform_result=${1%.*}.lo
+  }'
+else
+  # ...otherwise fall back to using sed.
+  func_lo2o ()
+  {
+    func_lo2o_result=`$ECHO "$1" | $SED "$lo2o"`
+  }
+
+  func_xform ()
+  {
+    func_xform_result=`$ECHO "$1" | $SED 's|\.[^.]*$|.lo|'`
+  }
+fi
+
+
+# func_fatal_configuration ARG...
+# -------------------------------
+# Echo program name prefixed message to standard error, followed by
+# a configuration failure hint, and exit.
+func_fatal_configuration ()
+{
+    func__fatal_error ${1+"$@"} \
+      "See the $PACKAGE documentation for more information." \
+      "Fatal configuration error."
+}
+
+
+# func_config
+# -----------
+# Display the configuration for all the tags in this script.
+func_config ()
+{
+    re_begincf='^# ### BEGIN LIBTOOL'
+    re_endcf='^# ### END LIBTOOL'
+
+    # Default configuration.
+    $SED "1,/$re_begincf CONFIG/d;/$re_endcf CONFIG/,\$d" < "$progpath"
+
+    # Now print the configurations for the tags.
+    for tagname in $taglist; do
+      $SED -n "/$re_begincf TAG CONFIG: $tagname\$/,/$re_endcf TAG CONFIG: $tagname\$/p" < "$progpath"
+    done
+
+    exit $?
+}
+
+
+# func_features
+# -------------
+# Display the features supported by this script.
+func_features ()
+{
+    echo "host: $host"
+    if test yes = "$build_libtool_libs"; then
+      echo "enable shared libraries"
+    else
+      echo "disable shared libraries"
+    fi
+    if test yes = "$build_old_libs"; then
+      echo "enable static libraries"
+    else
+      echo "disable static libraries"
+    fi
+
+    exit $?
+}
+
+
+# func_enable_tag TAGNAME
+# -----------------------
+# Verify that TAGNAME is valid, and either flag an error and exit, or
+# enable the TAGNAME tag.  We also add TAGNAME to the global $taglist
+# variable here.
+func_enable_tag ()
+{
+    # Global variable:
+    tagname=$1
+
+    re_begincf="^# ### BEGIN LIBTOOL TAG CONFIG: $tagname\$"
+    re_endcf="^# ### END LIBTOOL TAG CONFIG: $tagname\$"
+    sed_extractcf=/$re_begincf/,/$re_endcf/p
+
+    # Validate tagname.
+    case $tagname in
+      *[!-_A-Za-z0-9,/]*)
+        func_fatal_error "invalid tag name: $tagname"
+        ;;
+    esac
+
+    # Don't test for the "default" C tag, as we know it's
+    # there but not specially marked.
+    case $tagname in
+        CC) ;;
+    *)
+        if $GREP "$re_begincf" "$progpath" >/dev/null 2>&1; then
+	  taglist="$taglist $tagname"
+
+	  # Evaluate the configuration.  Be careful to quote the path
+	  # and the sed script, to avoid splitting on whitespace, but
+	  # also don't use non-portable quotes within backquotes within
+	  # quotes we have to do it in 2 steps:
+	  extractedcf=`$SED -n -e "$sed_extractcf" < "$progpath"`
+	  eval "$extractedcf"
+        else
+	  func_error "ignoring unknown tag $tagname"
+        fi
+        ;;
+    esac
+}
+
+
+# func_check_version_match
+# ------------------------
+# Ensure that we are using m4 macros, and libtool script from the same
+# release of libtool.
+func_check_version_match ()
+{
+    if test "$package_revision" != "$macro_revision"; then
+      if test "$VERSION" != "$macro_version"; then
+        if test -z "$macro_version"; then
+          cat >&2 <<_LT_EOF
+$progname: Version mismatch error.  This is $PACKAGE $VERSION, but the
+$progname: definition of this LT_INIT comes from an older release.
+$progname: You should recreate aclocal.m4 with macros from $PACKAGE $VERSION
+$progname: and run autoconf again.
+_LT_EOF
+        else
+          cat >&2 <<_LT_EOF
+$progname: Version mismatch error.  This is $PACKAGE $VERSION, but the
+$progname: definition of this LT_INIT comes from $PACKAGE $macro_version.
+$progname: You should recreate aclocal.m4 with macros from $PACKAGE $VERSION
+$progname: and run autoconf again.
+_LT_EOF
+        fi
+      else
+        cat >&2 <<_LT_EOF
+$progname: Version mismatch error.  This is $PACKAGE $VERSION, revision $package_revision,
+$progname: but the definition of this LT_INIT comes from revision $macro_revision.
+$progname: You should recreate aclocal.m4 with macros from revision $package_revision
+$progname: of $PACKAGE $VERSION and run autoconf again.
+_LT_EOF
+      fi
+
+      exit $EXIT_MISMATCH
+    fi
+}
+
+
+# libtool_options_prep [ARG]...
+# -----------------------------
+# Preparation for options parsed by libtool.
+libtool_options_prep ()
+{
+    $debug_mode
+
+    # Option defaults:
+    opt_config=false
+    opt_dlopen=
+    opt_dry_run=false
+    opt_help=false
+    opt_mode=
+    opt_preserve_dup_deps=false
+    opt_quiet=false
+
+    nonopt=
+    preserve_args=
+
+    _G_rc_lt_options_prep=:
+
+    # Shorthand for --mode=foo, only valid as the first argument
+    case $1 in
+    clean|clea|cle|cl)
+      shift; set dummy --mode clean ${1+"$@"}; shift
+      ;;
+    compile|compil|compi|comp|com|co|c)
+      shift; set dummy --mode compile ${1+"$@"}; shift
+      ;;
+    execute|execut|execu|exec|exe|ex|e)
+      shift; set dummy --mode execute ${1+"$@"}; shift
+      ;;
+    finish|finis|fini|fin|fi|f)
+      shift; set dummy --mode finish ${1+"$@"}; shift
+      ;;
+    install|instal|insta|inst|ins|in|i)
+      shift; set dummy --mode install ${1+"$@"}; shift
+      ;;
+    link|lin|li|l)
+      shift; set dummy --mode link ${1+"$@"}; shift
+      ;;
+    uninstall|uninstal|uninsta|uninst|unins|unin|uni|un|u)
+      shift; set dummy --mode uninstall ${1+"$@"}; shift
+      ;;
+    *)
+      _G_rc_lt_options_prep=false
+      ;;
+    esac
+
+    if $_G_rc_lt_options_prep; then
+      # Pass back the list of options.
+      func_quote eval ${1+"$@"}
+      libtool_options_prep_result=$func_quote_result
+    fi
+
+    $_G_rc_lt_options_prep
+}
+func_add_hook func_options_prep libtool_options_prep
+
+
+# libtool_parse_options [ARG]...
+# ---------------------------------
+# Provide handling for libtool specific options.
+libtool_parse_options ()
+{
+    $debug_cmd
+
+    _G_rc_lt_parse_options=false
+
+    # Perform our own loop to consume as many options as possible in
+    # each iteration.
+    while test $# -gt 0; do
+      _G_match_lt_parse_options=:
+      _G_opt=$1
+      shift
+      case $_G_opt in
+        --dry-run|--dryrun|-n)
+                        opt_dry_run=:
+                        ;;
+
+        --config)       func_config ;;
+
+        --dlopen|-dlopen)
+                        opt_dlopen="${opt_dlopen+$opt_dlopen
+}$1"
+                        shift
+                        ;;
+
+        --preserve-dup-deps)
+                        opt_preserve_dup_deps=: ;;
+
+        --features)     func_features ;;
+
+        --finish)       set dummy --mode finish ${1+"$@"}; shift ;;
+
+        --help)         opt_help=: ;;
+
+        --help-all)     opt_help=': help-all' ;;
+
+        --mode)         test $# = 0 && func_missing_arg $_G_opt && break
+                        opt_mode=$1
+                        case $1 in
+                          # Valid mode arguments:
+                          clean|compile|execute|finish|install|link|relink|uninstall) ;;
+
+                          # Catch anything else as an error
+                          *) func_error "invalid argument for $_G_opt"
+                             exit_cmd=exit
+                             break
+                             ;;
+                        esac
+                        shift
+                        ;;
+
+        --no-silent|--no-quiet)
+                        opt_quiet=false
+                        func_append preserve_args " $_G_opt"
+                        ;;
+
+        --no-warnings|--no-warning|--no-warn)
+                        opt_warning=false
+                        func_append preserve_args " $_G_opt"
+                        ;;
+
+        --no-verbose)
+                        opt_verbose=false
+                        func_append preserve_args " $_G_opt"
+                        ;;
+
+        --silent|--quiet)
+                        opt_quiet=:
+                        opt_verbose=false
+                        func_append preserve_args " $_G_opt"
+                        ;;
+
+        --tag)          test $# = 0 && func_missing_arg $_G_opt && break
+                        opt_tag=$1
+                        func_append preserve_args " $_G_opt $1"
+                        func_enable_tag "$1"
+                        shift
+                        ;;
+
+        --verbose|-v)   opt_quiet=false
+                        opt_verbose=:
+                        func_append preserve_args " $_G_opt"
+                        ;;
+
+        # An option not handled by this hook function:
+        *)              set dummy "$_G_opt" ${1+"$@"} ; shift
+                        _G_match_lt_parse_options=false
+                        break
+                        ;;
+      esac
+      $_G_match_lt_parse_options && _G_rc_lt_parse_options=:
+    done
+
+    if $_G_rc_lt_parse_options; then
+      # save modified positional parameters for caller
+      func_quote eval ${1+"$@"}
+      libtool_parse_options_result=$func_quote_result
+    fi
+
+    $_G_rc_lt_parse_options
+}
+func_add_hook func_parse_options libtool_parse_options
+
+
+
+# libtool_validate_options [ARG]...
+# ---------------------------------
+# Perform any sanity checks on option settings and/or unconsumed
+# arguments.
+libtool_validate_options ()
+{
+    # save first non-option argument
+    if test 0 -lt $#; then
+      nonopt=$1
+      shift
+    fi
+
+    # preserve --debug
+    test : = "$debug_cmd" || func_append preserve_args " --debug"
+
+    case $host in
+      # Solaris2 added to fix http://debbugs.gnu.org/cgi/bugreport.cgi?bug=16452
+      # see also: http://gcc.gnu.org/bugzilla/show_bug.cgi?id=59788
+      *cygwin* | *mingw* | *pw32* | *cegcc* | *solaris2* | *os2*)
+        # don't eliminate duplications in $postdeps and $predeps
+        opt_duplicate_compiler_generated_deps=:
+        ;;
+      *)
+        opt_duplicate_compiler_generated_deps=$opt_preserve_dup_deps
+        ;;
+    esac
+
+    $opt_help || {
+      # Sanity checks first:
+      func_check_version_match
+
+      test yes != "$build_libtool_libs" \
+        && test yes != "$build_old_libs" \
+        && func_fatal_configuration "not configured to build any kind of library"
+
+      # Darwin sucks
+      eval std_shrext=\"$shrext_cmds\"
+
+      # Only execute mode is allowed to have -dlopen flags.
+      if test -n "$opt_dlopen" && test execute != "$opt_mode"; then
+        func_error "unrecognized option '-dlopen'"
+        $ECHO "$help" 1>&2
+        exit $EXIT_FAILURE
+      fi
+
+      # Change the help message to a mode-specific one.
+      generic_help=$help
+      help="Try '$progname --help --mode=$opt_mode' for more information."
+    }
+
+    # Pass back the unparsed argument list
+    func_quote eval ${1+"$@"}
+    libtool_validate_options_result=$func_quote_result
+}
+func_add_hook func_validate_options libtool_validate_options
+
+
+# Process options as early as possible so that --help and --version
+# can return quickly.
+func_options ${1+"$@"}
+eval set dummy "$func_options_result"; shift
+
+
+
+## ----------- ##
+##    Main.    ##
+## ----------- ##
+
+magic='%%%MAGIC variable%%%'
+magic_exe='%%%MAGIC EXE variable%%%'
+
+# Global variables.
+extracted_archives=
+extracted_serial=0
+
+# If this variable is set in any of the actions, the command in it
+# will be execed at the end.  This prevents here-documents from being
+# left over by shells.
+exec_cmd=
+
+
+# A function that is used when there is no print builtin or printf.
+func_fallback_echo ()
+{
+  eval 'cat <<_LTECHO_EOF
+$1
+_LTECHO_EOF'
+}
+
+# func_generated_by_libtool
+# True iff stdin has been generated by Libtool. This function is only
+# a basic sanity check; it will hardly flush out determined imposters.
+func_generated_by_libtool_p ()
+{
+  $GREP "^# Generated by .*$PACKAGE" > /dev/null 2>&1
+}
+
+# func_lalib_p file
+# True iff FILE is a libtool '.la' library or '.lo' object file.
+# This function is only a basic sanity check; it will hardly flush out
+# determined imposters.
+func_lalib_p ()
+{
+    test -f "$1" &&
+      $SED -e 4q "$1" 2>/dev/null | func_generated_by_libtool_p
+}
+
+# func_lalib_unsafe_p file
+# True iff FILE is a libtool '.la' library or '.lo' object file.
+# This function implements the same check as func_lalib_p without
+# resorting to external programs.  To this end, it redirects stdin and
+# closes it afterwards, without saving the original file descriptor.
+# As a safety measure, use it only where a negative result would be
+# fatal anyway.  Works if 'file' does not exist.
+func_lalib_unsafe_p ()
+{
+    lalib_p=no
+    if test -f "$1" && test -r "$1" && exec 5<&0 <"$1"; then
+	for lalib_p_l in 1 2 3 4
+	do
+	    read lalib_p_line
+	    case $lalib_p_line in
+		\#\ Generated\ by\ *$PACKAGE* ) lalib_p=yes; break;;
+	    esac
+	done
+	exec 0<&5 5<&-
+    fi
+    test yes = "$lalib_p"
+}
+
+# func_ltwrapper_script_p file
+# True iff FILE is a libtool wrapper script
+# This function is only a basic sanity check; it will hardly flush out
+# determined imposters.
+func_ltwrapper_script_p ()
+{
+    test -f "$1" &&
+      $lt_truncate_bin < "$1" 2>/dev/null | func_generated_by_libtool_p
+}
+
+# func_ltwrapper_executable_p file
+# True iff FILE is a libtool wrapper executable
+# This function is only a basic sanity check; it will hardly flush out
+# determined imposters.
+func_ltwrapper_executable_p ()
+{
+    func_ltwrapper_exec_suffix=
+    case $1 in
+    *.exe) ;;
+    *) func_ltwrapper_exec_suffix=.exe ;;
+    esac
+    $GREP "$magic_exe" "$1$func_ltwrapper_exec_suffix" >/dev/null 2>&1
+}
+
+# func_ltwrapper_scriptname file
+# Assumes file is an ltwrapper_executable
+# uses $file to determine the appropriate filename for a
+# temporary ltwrapper_script.
+func_ltwrapper_scriptname ()
+{
+    func_dirname_and_basename "$1" "" "."
+    func_stripname '' '.exe' "$func_basename_result"
+    func_ltwrapper_scriptname_result=$func_dirname_result/$objdir/${func_stripname_result}_ltshwrapper
+}
+
+# func_ltwrapper_p file
+# True iff FILE is a libtool wrapper script or wrapper executable
+# This function is only a basic sanity check; it will hardly flush out
+# determined imposters.
+func_ltwrapper_p ()
+{
+    func_ltwrapper_script_p "$1" || func_ltwrapper_executable_p "$1"
+}
+
+
+# func_execute_cmds commands fail_cmd
+# Execute tilde-delimited COMMANDS.
+# If FAIL_CMD is given, eval that upon failure.
+# FAIL_CMD may read-access the current command in variable CMD!
+func_execute_cmds ()
+{
+    $debug_cmd
+
+    save_ifs=$IFS; IFS='~'
+    for cmd in $1; do
+      IFS=$sp$nl
+      eval cmd=\"$cmd\"
+      IFS=$save_ifs
+      func_show_eval "$cmd" "${2-:}"
+    done
+    IFS=$save_ifs
+}
+
+
+# func_source file
+# Source FILE, adding directory component if necessary.
+# Note that it is not necessary on cygwin/mingw to append a dot to
+# FILE even if both FILE and FILE.exe exist: automatic-append-.exe
+# behavior happens only for exec(3), not for open(2)!  Also, sourcing
+# 'FILE.' does not work on cygwin managed mounts.
+func_source ()
+{
+    $debug_cmd
+
+    case $1 in
+    */* | *\\*)	. "$1" ;;
+    *)		. "./$1" ;;
+    esac
+}
+
+
+# func_resolve_sysroot PATH
+# Replace a leading = in PATH with a sysroot.  Store the result into
+# func_resolve_sysroot_result
+func_resolve_sysroot ()
+{
+  func_resolve_sysroot_result=$1
+  case $func_resolve_sysroot_result in
+  =*)
+    func_stripname '=' '' "$func_resolve_sysroot_result"
+    func_resolve_sysroot_result=$lt_sysroot$func_stripname_result
+    ;;
+  esac
+}
+
+# func_replace_sysroot PATH
+# If PATH begins with the sysroot, replace it with = and
+# store the result into func_replace_sysroot_result.
+func_replace_sysroot ()
+{
+  case $lt_sysroot:$1 in
+  ?*:"$lt_sysroot"*)
+    func_stripname "$lt_sysroot" '' "$1"
+    func_replace_sysroot_result='='$func_stripname_result
+    ;;
+  *)
+    # Including no sysroot.
+    func_replace_sysroot_result=$1
+    ;;
+  esac
+}
+
+# func_infer_tag arg
+# Infer tagged configuration to use if any are available and
+# if one wasn't chosen via the "--tag" command line option.
+# Only attempt this if the compiler in the base compile
+# command doesn't match the default compiler.
+# arg is usually of the form 'gcc ...'
+func_infer_tag ()
+{
+    $debug_cmd
+
+    if test -n "$available_tags" && test -z "$tagname"; then
+      CC_quoted=
+      for arg in $CC; do
+	func_append_quoted CC_quoted "$arg"
+      done
+      CC_expanded=`func_echo_all $CC`
+      CC_quoted_expanded=`func_echo_all $CC_quoted`
+      case $@ in
+      # Blanks in the command may have been stripped by the calling shell,
+      # but not from the CC environment variable when configure was run.
+      " $CC "* | "$CC "* | " $CC_expanded "* | "$CC_expanded "* | \
+      " $CC_quoted"* | "$CC_quoted "* | " $CC_quoted_expanded "* | "$CC_quoted_expanded "*) ;;
+      # Blanks at the start of $base_compile will cause this to fail
+      # if we don't check for them as well.
+      *)
+	for z in $available_tags; do
+	  if $GREP "^# ### BEGIN LIBTOOL TAG CONFIG: $z$" < "$progpath" > /dev/null; then
+	    # Evaluate the configuration.
+	    eval "`$SED -n -e '/^# ### BEGIN LIBTOOL TAG CONFIG: '$z'$/,/^# ### END LIBTOOL TAG CONFIG: '$z'$/p' < $progpath`"
+	    CC_quoted=
+	    for arg in $CC; do
+	      # Double-quote args containing other shell metacharacters.
+	      func_append_quoted CC_quoted "$arg"
+	    done
+	    CC_expanded=`func_echo_all $CC`
+	    CC_quoted_expanded=`func_echo_all $CC_quoted`
+	    case "$@ " in
+	    " $CC "* | "$CC "* | " $CC_expanded "* | "$CC_expanded "* | \
+	    " $CC_quoted"* | "$CC_quoted "* | " $CC_quoted_expanded "* | "$CC_quoted_expanded "*)
+	      # The compiler in the base compile command matches
+	      # the one in the tagged configuration.
+	      # Assume this is the tagged configuration we want.
+	      tagname=$z
+	      break
+	      ;;
+	    esac
+	  fi
+	done
+	# If $tagname still isn't set, then no tagged configuration
+	# was found and let the user know that the "--tag" command
+	# line option must be used.
+	if test -z "$tagname"; then
+	  func_echo "unable to infer tagged configuration"
+	  func_fatal_error "specify a tag with '--tag'"
+#	else
+#	  func_verbose "using $tagname tagged configuration"
+	fi
+	;;
+      esac
+    fi
+}
+
+
+
+# func_write_libtool_object output_name pic_name nonpic_name
+# Create a libtool object file (analogous to a ".la" file),
+# but don't create it if we're doing a dry run.
+func_write_libtool_object ()
+{
+    write_libobj=$1
+    if test yes = "$build_libtool_libs"; then
+      write_lobj=\'$2\'
+    else
+      write_lobj=none
+    fi
+
+    if test yes = "$build_old_libs"; then
+      write_oldobj=\'$3\'
+    else
+      write_oldobj=none
+    fi
+
+    $opt_dry_run || {
+      cat >${write_libobj}T </dev/null`
+    if test "$?" -eq 0 && test -n "$func_convert_core_file_wine_to_w32_tmp"; then
+      func_convert_core_file_wine_to_w32_result=`$ECHO "$func_convert_core_file_wine_to_w32_tmp" |
+        $SED -e "$sed_naive_backslashify"`
+    else
+      func_convert_core_file_wine_to_w32_result=
+    fi
+  fi
+}
+# end: func_convert_core_file_wine_to_w32
+
+
+# func_convert_core_path_wine_to_w32 ARG
+# Helper function used by path conversion functions when $build is *nix, and
+# $host is mingw, cygwin, or some other w32 environment. Relies on a correctly
+# configured wine environment available, with the winepath program in $build's
+# $PATH. Assumes ARG has no leading or trailing path separator characters.
+#
+# ARG is path to be converted from $build format to win32.
+# Result is available in $func_convert_core_path_wine_to_w32_result.
+# Unconvertible file (directory) names in ARG are skipped; if no directory names
+# are convertible, then the result may be empty.
+func_convert_core_path_wine_to_w32 ()
+{
+  $debug_cmd
+
+  # unfortunately, winepath doesn't convert paths, only file names
+  func_convert_core_path_wine_to_w32_result=
+  if test -n "$1"; then
+    oldIFS=$IFS
+    IFS=:
+    for func_convert_core_path_wine_to_w32_f in $1; do
+      IFS=$oldIFS
+      func_convert_core_file_wine_to_w32 "$func_convert_core_path_wine_to_w32_f"
+      if test -n "$func_convert_core_file_wine_to_w32_result"; then
+        if test -z "$func_convert_core_path_wine_to_w32_result"; then
+          func_convert_core_path_wine_to_w32_result=$func_convert_core_file_wine_to_w32_result
+        else
+          func_append func_convert_core_path_wine_to_w32_result ";$func_convert_core_file_wine_to_w32_result"
+        fi
+      fi
+    done
+    IFS=$oldIFS
+  fi
+}
+# end: func_convert_core_path_wine_to_w32
+
+
+# func_cygpath ARGS...
+# Wrapper around calling the cygpath program via LT_CYGPATH. This is used when
+# when (1) $build is *nix and Cygwin is hosted via a wine environment; or (2)
+# $build is MSYS and $host is Cygwin, or (3) $build is Cygwin. In case (1) or
+# (2), returns the Cygwin file name or path in func_cygpath_result (input
+# file name or path is assumed to be in w32 format, as previously converted
+# from $build's *nix or MSYS format). In case (3), returns the w32 file name
+# or path in func_cygpath_result (input file name or path is assumed to be in
+# Cygwin format). Returns an empty string on error.
+#
+# ARGS are passed to cygpath, with the last one being the file name or path to
+# be converted.
+#
+# Specify the absolute *nix (or w32) name to cygpath in the LT_CYGPATH
+# environment variable; do not put it in $PATH.
+func_cygpath ()
+{
+  $debug_cmd
+
+  if test -n "$LT_CYGPATH" && test -f "$LT_CYGPATH"; then
+    func_cygpath_result=`$LT_CYGPATH "$@" 2>/dev/null`
+    if test "$?" -ne 0; then
+      # on failure, ensure result is empty
+      func_cygpath_result=
+    fi
+  else
+    func_cygpath_result=
+    func_error "LT_CYGPATH is empty or specifies non-existent file: '$LT_CYGPATH'"
+  fi
+}
+#end: func_cygpath
+
+
+# func_convert_core_msys_to_w32 ARG
+# Convert file name or path ARG from MSYS format to w32 format.  Return
+# result in func_convert_core_msys_to_w32_result.
+func_convert_core_msys_to_w32 ()
+{
+  $debug_cmd
+
+  # awkward: cmd appends spaces to result
+  func_convert_core_msys_to_w32_result=`( cmd //c echo "$1" ) 2>/dev/null |
+    $SED -e 's/[ ]*$//' -e "$sed_naive_backslashify"`
+}
+#end: func_convert_core_msys_to_w32
+
+
+# func_convert_file_check ARG1 ARG2
+# Verify that ARG1 (a file name in $build format) was converted to $host
+# format in ARG2. Otherwise, emit an error message, but continue (resetting
+# func_to_host_file_result to ARG1).
+func_convert_file_check ()
+{
+  $debug_cmd
+
+  if test -z "$2" && test -n "$1"; then
+    func_error "Could not determine host file name corresponding to"
+    func_error "  '$1'"
+    func_error "Continuing, but uninstalled executables may not work."
+    # Fallback:
+    func_to_host_file_result=$1
+  fi
+}
+# end func_convert_file_check
+
+
+# func_convert_path_check FROM_PATHSEP TO_PATHSEP FROM_PATH TO_PATH
+# Verify that FROM_PATH (a path in $build format) was converted to $host
+# format in TO_PATH. Otherwise, emit an error message, but continue, resetting
+# func_to_host_file_result to a simplistic fallback value (see below).
+func_convert_path_check ()
+{
+  $debug_cmd
+
+  if test -z "$4" && test -n "$3"; then
+    func_error "Could not determine the host path corresponding to"
+    func_error "  '$3'"
+    func_error "Continuing, but uninstalled executables may not work."
+    # Fallback.  This is a deliberately simplistic "conversion" and
+    # should not be "improved".  See libtool.info.
+    if test "x$1" != "x$2"; then
+      lt_replace_pathsep_chars="s|$1|$2|g"
+      func_to_host_path_result=`echo "$3" |
+        $SED -e "$lt_replace_pathsep_chars"`
+    else
+      func_to_host_path_result=$3
+    fi
+  fi
+}
+# end func_convert_path_check
+
+
+# func_convert_path_front_back_pathsep FRONTPAT BACKPAT REPL ORIG
+# Modifies func_to_host_path_result by prepending REPL if ORIG matches FRONTPAT
+# and appending REPL if ORIG matches BACKPAT.
+func_convert_path_front_back_pathsep ()
+{
+  $debug_cmd
+
+  case $4 in
+  $1 ) func_to_host_path_result=$3$func_to_host_path_result
+    ;;
+  esac
+  case $4 in
+  $2 ) func_append func_to_host_path_result "$3"
+    ;;
+  esac
+}
+# end func_convert_path_front_back_pathsep
+
+
+##################################################
+# $build to $host FILE NAME CONVERSION FUNCTIONS #
+##################################################
+# invoked via '$to_host_file_cmd ARG'
+#
+# In each case, ARG is the path to be converted from $build to $host format.
+# Result will be available in $func_to_host_file_result.
+
+
+# func_to_host_file ARG
+# Converts the file name ARG from $build format to $host format. Return result
+# in func_to_host_file_result.
+func_to_host_file ()
+{
+  $debug_cmd
+
+  $to_host_file_cmd "$1"
+}
+# end func_to_host_file
+
+
+# func_to_tool_file ARG LAZY
+# converts the file name ARG from $build format to toolchain format. Return
+# result in func_to_tool_file_result.  If the conversion in use is listed
+# in (the comma separated) LAZY, no conversion takes place.
+func_to_tool_file ()
+{
+  $debug_cmd
+
+  case ,$2, in
+    *,"$to_tool_file_cmd",*)
+      func_to_tool_file_result=$1
+      ;;
+    *)
+      $to_tool_file_cmd "$1"
+      func_to_tool_file_result=$func_to_host_file_result
+      ;;
+  esac
+}
+# end func_to_tool_file
+
+
+# func_convert_file_noop ARG
+# Copy ARG to func_to_host_file_result.
+func_convert_file_noop ()
+{
+  func_to_host_file_result=$1
+}
+# end func_convert_file_noop
+
+
+# func_convert_file_msys_to_w32 ARG
+# Convert file name ARG from (mingw) MSYS to (mingw) w32 format; automatic
+# conversion to w32 is not available inside the cwrapper.  Returns result in
+# func_to_host_file_result.
+func_convert_file_msys_to_w32 ()
+{
+  $debug_cmd
+
+  func_to_host_file_result=$1
+  if test -n "$1"; then
+    func_convert_core_msys_to_w32 "$1"
+    func_to_host_file_result=$func_convert_core_msys_to_w32_result
+  fi
+  func_convert_file_check "$1" "$func_to_host_file_result"
+}
+# end func_convert_file_msys_to_w32
+
+
+# func_convert_file_cygwin_to_w32 ARG
+# Convert file name ARG from Cygwin to w32 format.  Returns result in
+# func_to_host_file_result.
+func_convert_file_cygwin_to_w32 ()
+{
+  $debug_cmd
+
+  func_to_host_file_result=$1
+  if test -n "$1"; then
+    # because $build is cygwin, we call "the" cygpath in $PATH; no need to use
+    # LT_CYGPATH in this case.
+    func_to_host_file_result=`cygpath -m "$1"`
+  fi
+  func_convert_file_check "$1" "$func_to_host_file_result"
+}
+# end func_convert_file_cygwin_to_w32
+
+
+# func_convert_file_nix_to_w32 ARG
+# Convert file name ARG from *nix to w32 format.  Requires a wine environment
+# and a working winepath. Returns result in func_to_host_file_result.
+func_convert_file_nix_to_w32 ()
+{
+  $debug_cmd
+
+  func_to_host_file_result=$1
+  if test -n "$1"; then
+    func_convert_core_file_wine_to_w32 "$1"
+    func_to_host_file_result=$func_convert_core_file_wine_to_w32_result
+  fi
+  func_convert_file_check "$1" "$func_to_host_file_result"
+}
+# end func_convert_file_nix_to_w32
+
+
+# func_convert_file_msys_to_cygwin ARG
+# Convert file name ARG from MSYS to Cygwin format.  Requires LT_CYGPATH set.
+# Returns result in func_to_host_file_result.
+func_convert_file_msys_to_cygwin ()
+{
+  $debug_cmd
+
+  func_to_host_file_result=$1
+  if test -n "$1"; then
+    func_convert_core_msys_to_w32 "$1"
+    func_cygpath -u "$func_convert_core_msys_to_w32_result"
+    func_to_host_file_result=$func_cygpath_result
+  fi
+  func_convert_file_check "$1" "$func_to_host_file_result"
+}
+# end func_convert_file_msys_to_cygwin
+
+
+# func_convert_file_nix_to_cygwin ARG
+# Convert file name ARG from *nix to Cygwin format.  Requires Cygwin installed
+# in a wine environment, working winepath, and LT_CYGPATH set.  Returns result
+# in func_to_host_file_result.
+func_convert_file_nix_to_cygwin ()
+{
+  $debug_cmd
+
+  func_to_host_file_result=$1
+  if test -n "$1"; then
+    # convert from *nix to w32, then use cygpath to convert from w32 to cygwin.
+    func_convert_core_file_wine_to_w32 "$1"
+    func_cygpath -u "$func_convert_core_file_wine_to_w32_result"
+    func_to_host_file_result=$func_cygpath_result
+  fi
+  func_convert_file_check "$1" "$func_to_host_file_result"
+}
+# end func_convert_file_nix_to_cygwin
+
+
+#############################################
+# $build to $host PATH CONVERSION FUNCTIONS #
+#############################################
+# invoked via '$to_host_path_cmd ARG'
+#
+# In each case, ARG is the path to be converted from $build to $host format.
+# The result will be available in $func_to_host_path_result.
+#
+# Path separators are also converted from $build format to $host format.  If
+# ARG begins or ends with a path separator character, it is preserved (but
+# converted to $host format) on output.
+#
+# All path conversion functions are named using the following convention:
+#   file name conversion function    : func_convert_file_X_to_Y ()
+#   path conversion function         : func_convert_path_X_to_Y ()
+# where, for any given $build/$host combination the 'X_to_Y' value is the
+# same.  If conversion functions are added for new $build/$host combinations,
+# the two new functions must follow this pattern, or func_init_to_host_path_cmd
+# will break.
+
+
+# func_init_to_host_path_cmd
+# Ensures that function "pointer" variable $to_host_path_cmd is set to the
+# appropriate value, based on the value of $to_host_file_cmd.
+to_host_path_cmd=
+func_init_to_host_path_cmd ()
+{
+  $debug_cmd
+
+  if test -z "$to_host_path_cmd"; then
+    func_stripname 'func_convert_file_' '' "$to_host_file_cmd"
+    to_host_path_cmd=func_convert_path_$func_stripname_result
+  fi
+}
+
+
+# func_to_host_path ARG
+# Converts the path ARG from $build format to $host format. Return result
+# in func_to_host_path_result.
+func_to_host_path ()
+{
+  $debug_cmd
+
+  func_init_to_host_path_cmd
+  $to_host_path_cmd "$1"
+}
+# end func_to_host_path
+
+
+# func_convert_path_noop ARG
+# Copy ARG to func_to_host_path_result.
+func_convert_path_noop ()
+{
+  func_to_host_path_result=$1
+}
+# end func_convert_path_noop
+
+
+# func_convert_path_msys_to_w32 ARG
+# Convert path ARG from (mingw) MSYS to (mingw) w32 format; automatic
+# conversion to w32 is not available inside the cwrapper.  Returns result in
+# func_to_host_path_result.
+func_convert_path_msys_to_w32 ()
+{
+  $debug_cmd
+
+  func_to_host_path_result=$1
+  if test -n "$1"; then
+    # Remove leading and trailing path separator characters from ARG.  MSYS
+    # behavior is inconsistent here; cygpath turns them into '.;' and ';.';
+    # and winepath ignores them completely.
+    func_stripname : : "$1"
+    func_to_host_path_tmp1=$func_stripname_result
+    func_convert_core_msys_to_w32 "$func_to_host_path_tmp1"
+    func_to_host_path_result=$func_convert_core_msys_to_w32_result
+    func_convert_path_check : ";" \
+      "$func_to_host_path_tmp1" "$func_to_host_path_result"
+    func_convert_path_front_back_pathsep ":*" "*:" ";" "$1"
+  fi
+}
+# end func_convert_path_msys_to_w32
+
+
+# func_convert_path_cygwin_to_w32 ARG
+# Convert path ARG from Cygwin to w32 format.  Returns result in
+# func_to_host_file_result.
+func_convert_path_cygwin_to_w32 ()
+{
+  $debug_cmd
+
+  func_to_host_path_result=$1
+  if test -n "$1"; then
+    # See func_convert_path_msys_to_w32:
+    func_stripname : : "$1"
+    func_to_host_path_tmp1=$func_stripname_result
+    func_to_host_path_result=`cygpath -m -p "$func_to_host_path_tmp1"`
+    func_convert_path_check : ";" \
+      "$func_to_host_path_tmp1" "$func_to_host_path_result"
+    func_convert_path_front_back_pathsep ":*" "*:" ";" "$1"
+  fi
+}
+# end func_convert_path_cygwin_to_w32
+
+
+# func_convert_path_nix_to_w32 ARG
+# Convert path ARG from *nix to w32 format.  Requires a wine environment and
+# a working winepath.  Returns result in func_to_host_file_result.
+func_convert_path_nix_to_w32 ()
+{
+  $debug_cmd
+
+  func_to_host_path_result=$1
+  if test -n "$1"; then
+    # See func_convert_path_msys_to_w32:
+    func_stripname : : "$1"
+    func_to_host_path_tmp1=$func_stripname_result
+    func_convert_core_path_wine_to_w32 "$func_to_host_path_tmp1"
+    func_to_host_path_result=$func_convert_core_path_wine_to_w32_result
+    func_convert_path_check : ";" \
+      "$func_to_host_path_tmp1" "$func_to_host_path_result"
+    func_convert_path_front_back_pathsep ":*" "*:" ";" "$1"
+  fi
+}
+# end func_convert_path_nix_to_w32
+
+
+# func_convert_path_msys_to_cygwin ARG
+# Convert path ARG from MSYS to Cygwin format.  Requires LT_CYGPATH set.
+# Returns result in func_to_host_file_result.
+func_convert_path_msys_to_cygwin ()
+{
+  $debug_cmd
+
+  func_to_host_path_result=$1
+  if test -n "$1"; then
+    # See func_convert_path_msys_to_w32:
+    func_stripname : : "$1"
+    func_to_host_path_tmp1=$func_stripname_result
+    func_convert_core_msys_to_w32 "$func_to_host_path_tmp1"
+    func_cygpath -u -p "$func_convert_core_msys_to_w32_result"
+    func_to_host_path_result=$func_cygpath_result
+    func_convert_path_check : : \
+      "$func_to_host_path_tmp1" "$func_to_host_path_result"
+    func_convert_path_front_back_pathsep ":*" "*:" : "$1"
+  fi
+}
+# end func_convert_path_msys_to_cygwin
+
+
+# func_convert_path_nix_to_cygwin ARG
+# Convert path ARG from *nix to Cygwin format.  Requires Cygwin installed in a
+# a wine environment, working winepath, and LT_CYGPATH set.  Returns result in
+# func_to_host_file_result.
+func_convert_path_nix_to_cygwin ()
+{
+  $debug_cmd
+
+  func_to_host_path_result=$1
+  if test -n "$1"; then
+    # Remove leading and trailing path separator characters from
+    # ARG. msys behavior is inconsistent here, cygpath turns them
+    # into '.;' and ';.', and winepath ignores them completely.
+    func_stripname : : "$1"
+    func_to_host_path_tmp1=$func_stripname_result
+    func_convert_core_path_wine_to_w32 "$func_to_host_path_tmp1"
+    func_cygpath -u -p "$func_convert_core_path_wine_to_w32_result"
+    func_to_host_path_result=$func_cygpath_result
+    func_convert_path_check : : \
+      "$func_to_host_path_tmp1" "$func_to_host_path_result"
+    func_convert_path_front_back_pathsep ":*" "*:" : "$1"
+  fi
+}
+# end func_convert_path_nix_to_cygwin
+
+
+# func_dll_def_p FILE
+# True iff FILE is a Windows DLL '.def' file.
+# Keep in sync with _LT_DLL_DEF_P in libtool.m4
+func_dll_def_p ()
+{
+  $debug_cmd
+
+  func_dll_def_p_tmp=`$SED -n \
+    -e 's/^[	 ]*//' \
+    -e '/^\(;.*\)*$/d' \
+    -e 's/^\(EXPORTS\|LIBRARY\)\([	 ].*\)*$/DEF/p' \
+    -e q \
+    "$1"`
+  test DEF = "$func_dll_def_p_tmp"
+}
+
+
+# func_mode_compile arg...
+func_mode_compile ()
+{
+    $debug_cmd
+
+    # Get the compilation command and the source file.
+    base_compile=
+    srcfile=$nonopt  #  always keep a non-empty value in "srcfile"
+    suppress_opt=yes
+    suppress_output=
+    arg_mode=normal
+    libobj=
+    later=
+    pie_flag=
+
+    for arg
+    do
+      case $arg_mode in
+      arg  )
+	# do not "continue".  Instead, add this to base_compile
+	lastarg=$arg
+	arg_mode=normal
+	;;
+
+      target )
+	libobj=$arg
+	arg_mode=normal
+	continue
+	;;
+
+      normal )
+	# Accept any command-line options.
+	case $arg in
+	-o)
+	  test -n "$libobj" && \
+	    func_fatal_error "you cannot specify '-o' more than once"
+	  arg_mode=target
+	  continue
+	  ;;
+
+	-pie | -fpie | -fPIE)
+          func_append pie_flag " $arg"
+	  continue
+	  ;;
+
+	-shared | -static | -prefer-pic | -prefer-non-pic)
+	  func_append later " $arg"
+	  continue
+	  ;;
+
+	-no-suppress)
+	  suppress_opt=no
+	  continue
+	  ;;
+
+	-Xcompiler)
+	  arg_mode=arg  #  the next one goes into the "base_compile" arg list
+	  continue      #  The current "srcfile" will either be retained or
+	  ;;            #  replaced later.  I would guess that would be a bug.
+
+	-Wc,*)
+	  func_stripname '-Wc,' '' "$arg"
+	  args=$func_stripname_result
+	  lastarg=
+	  save_ifs=$IFS; IFS=,
+	  for arg in $args; do
+	    IFS=$save_ifs
+	    func_append_quoted lastarg "$arg"
+	  done
+	  IFS=$save_ifs
+	  func_stripname ' ' '' "$lastarg"
+	  lastarg=$func_stripname_result
+
+	  # Add the arguments to base_compile.
+	  func_append base_compile " $lastarg"
+	  continue
+	  ;;
+
+	*)
+	  # Accept the current argument as the source file.
+	  # The previous "srcfile" becomes the current argument.
+	  #
+	  lastarg=$srcfile
+	  srcfile=$arg
+	  ;;
+	esac  #  case $arg
+	;;
+      esac    #  case $arg_mode
+
+      # Aesthetically quote the previous argument.
+      func_append_quoted base_compile "$lastarg"
+    done # for arg
+
+    case $arg_mode in
+    arg)
+      func_fatal_error "you must specify an argument for -Xcompile"
+      ;;
+    target)
+      func_fatal_error "you must specify a target with '-o'"
+      ;;
+    *)
+      # Get the name of the library object.
+      test -z "$libobj" && {
+	func_basename "$srcfile"
+	libobj=$func_basename_result
+      }
+      ;;
+    esac
+
+    # Recognize several different file suffixes.
+    # If the user specifies -o file.o, it is replaced with file.lo
+    case $libobj in
+    *.[cCFSifmso] | \
+    *.ada | *.adb | *.ads | *.asm | \
+    *.c++ | *.cc | *.ii | *.class | *.cpp | *.cxx | \
+    *.[fF][09]? | *.for | *.java | *.go | *.obj | *.sx | *.cu | *.cup)
+      func_xform "$libobj"
+      libobj=$func_xform_result
+      ;;
+    esac
+
+    case $libobj in
+    *.lo) func_lo2o "$libobj"; obj=$func_lo2o_result ;;
+    *)
+      func_fatal_error "cannot determine name of library object from '$libobj'"
+      ;;
+    esac
+
+    func_infer_tag $base_compile
+
+    for arg in $later; do
+      case $arg in
+      -shared)
+	test yes = "$build_libtool_libs" \
+	  || func_fatal_configuration "cannot build a shared library"
+	build_old_libs=no
+	continue
+	;;
+
+      -static)
+	build_libtool_libs=no
+	build_old_libs=yes
+	continue
+	;;
+
+      -prefer-pic)
+	pic_mode=yes
+	continue
+	;;
+
+      -prefer-non-pic)
+	pic_mode=no
+	continue
+	;;
+      esac
+    done
+
+    func_quote_arg pretty "$libobj"
+    test "X$libobj" != "X$func_quote_arg_result" \
+      && $ECHO "X$libobj" | $GREP '[]~#^*{};<>?"'"'"'	 &()|`$[]' \
+      && func_warning "libobj name '$libobj' may not contain shell special characters."
+    func_dirname_and_basename "$obj" "/" ""
+    objname=$func_basename_result
+    xdir=$func_dirname_result
+    lobj=$xdir$objdir/$objname
+
+    test -z "$base_compile" && \
+      func_fatal_help "you must specify a compilation command"
+
+    # Delete any leftover library objects.
+    if test yes = "$build_old_libs"; then
+      removelist="$obj $lobj $libobj ${libobj}T"
+    else
+      removelist="$lobj $libobj ${libobj}T"
+    fi
+
+    # On Cygwin there's no "real" PIC flag so we must build both object types
+    case $host_os in
+    cygwin* | mingw* | pw32* | os2* | cegcc*)
+      pic_mode=default
+      ;;
+    esac
+    if test no = "$pic_mode" && test pass_all != "$deplibs_check_method"; then
+      # non-PIC code in shared libraries is not supported
+      pic_mode=default
+    fi
+
+    # Calculate the filename of the output object if compiler does
+    # not support -o with -c
+    if test no = "$compiler_c_o"; then
+      output_obj=`$ECHO "$srcfile" | $SED 's%^.*/%%; s%\.[^.]*$%%'`.$objext
+      lockfile=$output_obj.lock
+    else
+      output_obj=
+      need_locks=no
+      lockfile=
+    fi
+
+    # Lock this critical section if it is needed
+    # We use this script file to make the link, it avoids creating a new file
+    if test yes = "$need_locks"; then
+      until $opt_dry_run || ln "$progpath" "$lockfile" 2>/dev/null; do
+	func_echo "Waiting for $lockfile to be removed"
+	sleep 2
+      done
+    elif test warn = "$need_locks"; then
+      if test -f "$lockfile"; then
+	$ECHO "\
+*** ERROR, $lockfile exists and contains:
+`cat $lockfile 2>/dev/null`
+
+This indicates that another process is trying to use the same
+temporary object file, and libtool could not work around it because
+your compiler does not support '-c' and '-o' together.  If you
+repeat this compilation, it may succeed, by chance, but you had better
+avoid parallel builds (make -j) in this platform, or get a better
+compiler."
+
+	$opt_dry_run || $RM $removelist
+	exit $EXIT_FAILURE
+      fi
+      func_append removelist " $output_obj"
+      $ECHO "$srcfile" > "$lockfile"
+    fi
+
+    $opt_dry_run || $RM $removelist
+    func_append removelist " $lockfile"
+    trap '$opt_dry_run || $RM $removelist; exit $EXIT_FAILURE' 1 2 15
+
+    func_to_tool_file "$srcfile" func_convert_file_msys_to_w32
+    srcfile=$func_to_tool_file_result
+    func_quote_arg pretty "$srcfile"
+    qsrcfile=$func_quote_arg_result
+
+    # Only build a PIC object if we are building libtool libraries.
+    if test yes = "$build_libtool_libs"; then
+      # Without this assignment, base_compile gets emptied.
+      fbsd_hideous_sh_bug=$base_compile
+
+      if test no != "$pic_mode"; then
+	command="$base_compile $qsrcfile $pic_flag"
+      else
+	# Don't build PIC code
+	command="$base_compile $qsrcfile"
+      fi
+
+      func_mkdir_p "$xdir$objdir"
+
+      if test -z "$output_obj"; then
+	# Place PIC objects in $objdir
+	func_append command " -o $lobj"
+      fi
+
+      func_show_eval_locale "$command"	\
+          'test -n "$output_obj" && $RM $removelist; exit $EXIT_FAILURE'
+
+      if test warn = "$need_locks" &&
+	 test "X`cat $lockfile 2>/dev/null`" != "X$srcfile"; then
+	$ECHO "\
+*** ERROR, $lockfile contains:
+`cat $lockfile 2>/dev/null`
+
+but it should contain:
+$srcfile
+
+This indicates that another process is trying to use the same
+temporary object file, and libtool could not work around it because
+your compiler does not support '-c' and '-o' together.  If you
+repeat this compilation, it may succeed, by chance, but you had better
+avoid parallel builds (make -j) in this platform, or get a better
+compiler."
+
+	$opt_dry_run || $RM $removelist
+	exit $EXIT_FAILURE
+      fi
+
+      # Just move the object if needed, then go on to compile the next one
+      if test -n "$output_obj" && test "X$output_obj" != "X$lobj"; then
+	func_show_eval '$MV "$output_obj" "$lobj"' \
+	  'error=$?; $opt_dry_run || $RM $removelist; exit $error'
+      fi
+
+      # Allow error messages only from the first compilation.
+      if test yes = "$suppress_opt"; then
+	suppress_output=' >/dev/null 2>&1'
+      fi
+    fi
+
+    # Only build a position-dependent object if we build old libraries.
+    if test yes = "$build_old_libs"; then
+      if test yes != "$pic_mode"; then
+	# Don't build PIC code
+	command="$base_compile $qsrcfile$pie_flag"
+      else
+	command="$base_compile $qsrcfile $pic_flag"
+      fi
+      if test yes = "$compiler_c_o"; then
+	func_append command " -o $obj"
+      fi
+
+      # Suppress compiler output if we already did a PIC compilation.
+      func_append command "$suppress_output"
+      func_show_eval_locale "$command" \
+        '$opt_dry_run || $RM $removelist; exit $EXIT_FAILURE'
+
+      if test warn = "$need_locks" &&
+	 test "X`cat $lockfile 2>/dev/null`" != "X$srcfile"; then
+	$ECHO "\
+*** ERROR, $lockfile contains:
+`cat $lockfile 2>/dev/null`
+
+but it should contain:
+$srcfile
+
+This indicates that another process is trying to use the same
+temporary object file, and libtool could not work around it because
+your compiler does not support '-c' and '-o' together.  If you
+repeat this compilation, it may succeed, by chance, but you had better
+avoid parallel builds (make -j) in this platform, or get a better
+compiler."
+
+	$opt_dry_run || $RM $removelist
+	exit $EXIT_FAILURE
+      fi
+
+      # Just move the object if needed
+      if test -n "$output_obj" && test "X$output_obj" != "X$obj"; then
+	func_show_eval '$MV "$output_obj" "$obj"' \
+	  'error=$?; $opt_dry_run || $RM $removelist; exit $error'
+      fi
+    fi
+
+    $opt_dry_run || {
+      func_write_libtool_object "$libobj" "$objdir/$objname" "$objname"
+
+      # Unlock the critical section if it was locked
+      if test no != "$need_locks"; then
+	removelist=$lockfile
+        $RM "$lockfile"
+      fi
+    }
+
+    exit $EXIT_SUCCESS
+}
+
+$opt_help || {
+  test compile = "$opt_mode" && func_mode_compile ${1+"$@"}
+}
+
+func_mode_help ()
+{
+    # We need to display help for each of the modes.
+    case $opt_mode in
+      "")
+        # Generic help is extracted from the usage comments
+        # at the start of this file.
+        func_help
+        ;;
+
+      clean)
+        $ECHO \
+"Usage: $progname [OPTION]... --mode=clean RM [RM-OPTION]... FILE...
+
+Remove files from the build directory.
+
+RM is the name of the program to use to delete files associated with each FILE
+(typically '/bin/rm').  RM-OPTIONS are options (such as '-f') to be passed
+to RM.
+
+If FILE is a libtool library, object or program, all the files associated
+with it are deleted. Otherwise, only FILE itself is deleted using RM."
+        ;;
+
+      compile)
+      $ECHO \
+"Usage: $progname [OPTION]... --mode=compile COMPILE-COMMAND... SOURCEFILE
+
+Compile a source file into a libtool library object.
+
+This mode accepts the following additional options:
+
+  -o OUTPUT-FILE    set the output file name to OUTPUT-FILE
+  -no-suppress      do not suppress compiler output for multiple passes
+  -prefer-pic       try to build PIC objects only
+  -prefer-non-pic   try to build non-PIC objects only
+  -shared           do not build a '.o' file suitable for static linking
+  -static           only build a '.o' file suitable for static linking
+  -Wc,FLAG          pass FLAG directly to the compiler
+
+COMPILE-COMMAND is a command to be used in creating a 'standard' object file
+from the given SOURCEFILE.
+
+The output file name is determined by removing the directory component from
+SOURCEFILE, then substituting the C source code suffix '.c' with the
+library object suffix, '.lo'."
+        ;;
+
+      execute)
+        $ECHO \
+"Usage: $progname [OPTION]... --mode=execute COMMAND [ARGS]...
+
+Automatically set library path, then run a program.
+
+This mode accepts the following additional options:
+
+  -dlopen FILE      add the directory containing FILE to the library path
+
+This mode sets the library path environment variable according to '-dlopen'
+flags.
+
+If any of the ARGS are libtool executable wrappers, then they are translated
+into their corresponding uninstalled binary, and any of their required library
+directories are added to the library path.
+
+Then, COMMAND is executed, with ARGS as arguments."
+        ;;
+
+      finish)
+        $ECHO \
+"Usage: $progname [OPTION]... --mode=finish [LIBDIR]...
+
+Complete the installation of libtool libraries.
+
+Each LIBDIR is a directory that contains libtool libraries.
+
+The commands that this mode executes may require superuser privileges.  Use
+the '--dry-run' option if you just want to see what would be executed."
+        ;;
+
+      install)
+        $ECHO \
+"Usage: $progname [OPTION]... --mode=install INSTALL-COMMAND...
+
+Install executables or libraries.
+
+INSTALL-COMMAND is the installation command.  The first component should be
+either the 'install' or 'cp' program.
+
+The following components of INSTALL-COMMAND are treated specially:
+
+  -inst-prefix-dir PREFIX-DIR  Use PREFIX-DIR as a staging area for installation
+
+The rest of the components are interpreted as arguments to that command (only
+BSD-compatible install options are recognized)."
+        ;;
+
+      link)
+        $ECHO \
+"Usage: $progname [OPTION]... --mode=link LINK-COMMAND...
+
+Link object files or libraries together to form another library, or to
+create an executable program.
+
+LINK-COMMAND is a command using the C compiler that you would use to create
+a program from several object files.
+
+The following components of LINK-COMMAND are treated specially:
+
+  -all-static       do not do any dynamic linking at all
+  -avoid-version    do not add a version suffix if possible
+  -bindir BINDIR    specify path to binaries directory (for systems where
+                    libraries must be found in the PATH setting at runtime)
+  -dlopen FILE      '-dlpreopen' FILE if it cannot be dlopened at runtime
+  -dlpreopen FILE   link in FILE and add its symbols to lt_preloaded_symbols
+  -export-dynamic   allow symbols from OUTPUT-FILE to be resolved with dlsym(3)
+  -export-symbols SYMFILE
+                    try to export only the symbols listed in SYMFILE
+  -export-symbols-regex REGEX
+                    try to export only the symbols matching REGEX
+  -LLIBDIR          search LIBDIR for required installed libraries
+  -lNAME            OUTPUT-FILE requires the installed library libNAME
+  -module           build a library that can dlopened
+  -no-fast-install  disable the fast-install mode
+  -no-install       link a not-installable executable
+  -no-undefined     declare that a library does not refer to external symbols
+  -o OUTPUT-FILE    create OUTPUT-FILE from the specified objects
+  -objectlist FILE  use a list of object files found in FILE to specify objects
+  -os2dllname NAME  force a short DLL name on OS/2 (no effect on other OSes)
+  -precious-files-regex REGEX
+                    don't remove output files matching REGEX
+  -release RELEASE  specify package release information
+  -rpath LIBDIR     the created library will eventually be installed in LIBDIR
+  -R[ ]LIBDIR       add LIBDIR to the runtime path of programs and libraries
+  -shared           only do dynamic linking of libtool libraries
+  -shrext SUFFIX    override the standard shared library file extension
+  -static           do not do any dynamic linking of uninstalled libtool libraries
+  -static-libtool-libs
+                    do not do any dynamic linking of libtool libraries
+  -version-info CURRENT[:REVISION[:AGE]]
+                    specify library version info [each variable defaults to 0]
+  -weak LIBNAME     declare that the target provides the LIBNAME interface
+  -Wc,FLAG
+  -Xcompiler FLAG   pass linker-specific FLAG directly to the compiler
+  -Wl,FLAG
+  -Xlinker FLAG     pass linker-specific FLAG directly to the linker
+  -XCClinker FLAG   pass link-specific FLAG to the compiler driver (CC)
+
+All other options (arguments beginning with '-') are ignored.
+
+Every other argument is treated as a filename.  Files ending in '.la' are
+treated as uninstalled libtool libraries, other files are standard or library
+object files.
+
+If the OUTPUT-FILE ends in '.la', then a libtool library is created,
+only library objects ('.lo' files) may be specified, and '-rpath' is
+required, except when creating a convenience library.
+
+If OUTPUT-FILE ends in '.a' or '.lib', then a standard library is created
+using 'ar' and 'ranlib', or on Windows using 'lib'.
+
+If OUTPUT-FILE ends in '.lo' or '.$objext', then a reloadable object file
+is created, otherwise an executable program is created."
+        ;;
+
+      uninstall)
+        $ECHO \
+"Usage: $progname [OPTION]... --mode=uninstall RM [RM-OPTION]... FILE...
+
+Remove libraries from an installation directory.
+
+RM is the name of the program to use to delete files associated with each FILE
+(typically '/bin/rm').  RM-OPTIONS are options (such as '-f') to be passed
+to RM.
+
+If FILE is a libtool library, all the files associated with it are deleted.
+Otherwise, only FILE itself is deleted using RM."
+        ;;
+
+      *)
+        func_fatal_help "invalid operation mode '$opt_mode'"
+        ;;
+    esac
+
+    echo
+    $ECHO "Try '$progname --help' for more information about other modes."
+}
+
+# Now that we've collected a possible --mode arg, show help if necessary
+if $opt_help; then
+  if test : = "$opt_help"; then
+    func_mode_help
+  else
+    {
+      func_help noexit
+      for opt_mode in compile link execute install finish uninstall clean; do
+	func_mode_help
+      done
+    } | $SED -n '1p; 2,$s/^Usage:/  or: /p'
+    {
+      func_help noexit
+      for opt_mode in compile link execute install finish uninstall clean; do
+	echo
+	func_mode_help
+      done
+    } |
+    $SED '1d
+      /^When reporting/,/^Report/{
+	H
+	d
+      }
+      $x
+      /information about other modes/d
+      /more detailed .*MODE/d
+      s/^Usage:.*--mode=\([^ ]*\) .*/Description of \1 mode:/'
+  fi
+  exit $?
+fi
+
+
+# func_mode_execute arg...
+func_mode_execute ()
+{
+    $debug_cmd
+
+    # The first argument is the command name.
+    cmd=$nonopt
+    test -z "$cmd" && \
+      func_fatal_help "you must specify a COMMAND"
+
+    # Handle -dlopen flags immediately.
+    for file in $opt_dlopen; do
+      test -f "$file" \
+	|| func_fatal_help "'$file' is not a file"
+
+      dir=
+      case $file in
+      *.la)
+	func_resolve_sysroot "$file"
+	file=$func_resolve_sysroot_result
+
+	# Check to see that this really is a libtool archive.
+	func_lalib_unsafe_p "$file" \
+	  || func_fatal_help "'$lib' is not a valid libtool archive"
+
+	# Read the libtool library.
+	dlname=
+	library_names=
+	func_source "$file"
+
+	# Skip this library if it cannot be dlopened.
+	if test -z "$dlname"; then
+	  # Warn if it was a shared library.
+	  test -n "$library_names" && \
+	    func_warning "'$file' was not linked with '-export-dynamic'"
+	  continue
+	fi
+
+	func_dirname "$file" "" "."
+	dir=$func_dirname_result
+
+	if test -f "$dir/$objdir/$dlname"; then
+	  func_append dir "/$objdir"
+	else
+	  if test ! -f "$dir/$dlname"; then
+	    func_fatal_error "cannot find '$dlname' in '$dir' or '$dir/$objdir'"
+	  fi
+	fi
+	;;
+
+      *.lo)
+	# Just add the directory containing the .lo file.
+	func_dirname "$file" "" "."
+	dir=$func_dirname_result
+	;;
+
+      *)
+	func_warning "'-dlopen' is ignored for non-libtool libraries and objects"
+	continue
+	;;
+      esac
+
+      # Get the absolute pathname.
+      absdir=`cd "$dir" && pwd`
+      test -n "$absdir" && dir=$absdir
+
+      # Now add the directory to shlibpath_var.
+      if eval "test -z \"\$$shlibpath_var\""; then
+	eval "$shlibpath_var=\"\$dir\""
+      else
+	eval "$shlibpath_var=\"\$dir:\$$shlibpath_var\""
+      fi
+    done
+
+    # This variable tells wrapper scripts just to set shlibpath_var
+    # rather than running their programs.
+    libtool_execute_magic=$magic
+
+    # Check if any of the arguments is a wrapper script.
+    args=
+    for file
+    do
+      case $file in
+      -* | *.la | *.lo ) ;;
+      *)
+	# Do a test to see if this is really a libtool program.
+	if func_ltwrapper_script_p "$file"; then
+	  func_source "$file"
+	  # Transform arg to wrapped name.
+	  file=$progdir/$program
+	elif func_ltwrapper_executable_p "$file"; then
+	  func_ltwrapper_scriptname "$file"
+	  func_source "$func_ltwrapper_scriptname_result"
+	  # Transform arg to wrapped name.
+	  file=$progdir/$program
+	fi
+	;;
+      esac
+      # Quote arguments (to preserve shell metacharacters).
+      func_append_quoted args "$file"
+    done
+
+    if $opt_dry_run; then
+      # Display what would be done.
+      if test -n "$shlibpath_var"; then
+	eval "\$ECHO \"\$shlibpath_var=\$$shlibpath_var\""
+	echo "export $shlibpath_var"
+      fi
+      $ECHO "$cmd$args"
+      exit $EXIT_SUCCESS
+    else
+      if test -n "$shlibpath_var"; then
+	# Export the shlibpath_var.
+	eval "export $shlibpath_var"
+      fi
+
+      # Restore saved environment variables
+      for lt_var in LANG LANGUAGE LC_ALL LC_CTYPE LC_COLLATE LC_MESSAGES
+      do
+	eval "if test \"\${save_$lt_var+set}\" = set; then
+                $lt_var=\$save_$lt_var; export $lt_var
+	      else
+		$lt_unset $lt_var
+	      fi"
+      done
+
+      # Now prepare to actually exec the command.
+      exec_cmd=\$cmd$args
+    fi
+}
+
+test execute = "$opt_mode" && func_mode_execute ${1+"$@"}
+
+
+# func_mode_finish arg...
+func_mode_finish ()
+{
+    $debug_cmd
+
+    libs=
+    libdirs=
+    admincmds=
+
+    for opt in "$nonopt" ${1+"$@"}
+    do
+      if test -d "$opt"; then
+	func_append libdirs " $opt"
+
+      elif test -f "$opt"; then
+	if func_lalib_unsafe_p "$opt"; then
+	  func_append libs " $opt"
+	else
+	  func_warning "'$opt' is not a valid libtool archive"
+	fi
+
+      else
+	func_fatal_error "invalid argument '$opt'"
+      fi
+    done
+
+    if test -n "$libs"; then
+      if test -n "$lt_sysroot"; then
+        sysroot_regex=`$ECHO "$lt_sysroot" | $SED "$sed_make_literal_regex"`
+        sysroot_cmd="s/\([ ']\)$sysroot_regex/\1/g;"
+      else
+        sysroot_cmd=
+      fi
+
+      # Remove sysroot references
+      if $opt_dry_run; then
+        for lib in $libs; do
+          echo "removing references to $lt_sysroot and '=' prefixes from $lib"
+        done
+      else
+        tmpdir=`func_mktempdir`
+        for lib in $libs; do
+	  $SED -e "$sysroot_cmd s/\([ ']-[LR]\)=/\1/g; s/\([ ']\)=/\1/g" $lib \
+	    > $tmpdir/tmp-la
+	  mv -f $tmpdir/tmp-la $lib
+	done
+        ${RM}r "$tmpdir"
+      fi
+    fi
+
+    if test -n "$finish_cmds$finish_eval" && test -n "$libdirs"; then
+      for libdir in $libdirs; do
+	if test -n "$finish_cmds"; then
+	  # Do each command in the finish commands.
+	  func_execute_cmds "$finish_cmds" 'admincmds="$admincmds
+'"$cmd"'"'
+	fi
+	if test -n "$finish_eval"; then
+	  # Do the single finish_eval.
+	  eval cmds=\"$finish_eval\"
+	  $opt_dry_run || eval "$cmds" || func_append admincmds "
+       $cmds"
+	fi
+      done
+    fi
+
+    # Exit here if they wanted silent mode.
+    $opt_quiet && exit $EXIT_SUCCESS
+
+    if test -n "$finish_cmds$finish_eval" && test -n "$libdirs"; then
+      echo "----------------------------------------------------------------------"
+      echo "Libraries have been installed in:"
+      for libdir in $libdirs; do
+	$ECHO "   $libdir"
+      done
+      echo
+      echo "If you ever happen to want to link against installed libraries"
+      echo "in a given directory, LIBDIR, you must either use libtool, and"
+      echo "specify the full pathname of the library, or use the '-LLIBDIR'"
+      echo "flag during linking and do at least one of the following:"
+      if test -n "$shlibpath_var"; then
+	echo "   - add LIBDIR to the '$shlibpath_var' environment variable"
+	echo "     during execution"
+      fi
+      if test -n "$runpath_var"; then
+	echo "   - add LIBDIR to the '$runpath_var' environment variable"
+	echo "     during linking"
+      fi
+      if test -n "$hardcode_libdir_flag_spec"; then
+	libdir=LIBDIR
+	eval flag=\"$hardcode_libdir_flag_spec\"
+
+	$ECHO "   - use the '$flag' linker flag"
+      fi
+      if test -n "$admincmds"; then
+	$ECHO "   - have your system administrator run these commands:$admincmds"
+      fi
+      if test -f /etc/ld.so.conf; then
+	echo "   - have your system administrator add LIBDIR to '/etc/ld.so.conf'"
+      fi
+      echo
+
+      echo "See any operating system documentation about shared libraries for"
+      case $host in
+	solaris2.[6789]|solaris2.1[0-9])
+	  echo "more information, such as the ld(1), crle(1) and ld.so(8) manual"
+	  echo "pages."
+	  ;;
+	*)
+	  echo "more information, such as the ld(1) and ld.so(8) manual pages."
+	  ;;
+      esac
+      echo "----------------------------------------------------------------------"
+    fi
+    exit $EXIT_SUCCESS
+}
+
+test finish = "$opt_mode" && func_mode_finish ${1+"$@"}
+
+
+# func_mode_install arg...
+func_mode_install ()
+{
+    $debug_cmd
+
+    # There may be an optional sh(1) argument at the beginning of
+    # install_prog (especially on Windows NT).
+    if test "$SHELL" = "$nonopt" || test /bin/sh = "$nonopt" ||
+       # Allow the use of GNU shtool's install command.
+       case $nonopt in *shtool*) :;; *) false;; esac
+    then
+      # Aesthetically quote it.
+      func_quote_arg pretty "$nonopt"
+      install_prog="$func_quote_arg_result "
+      arg=$1
+      shift
+    else
+      install_prog=
+      arg=$nonopt
+    fi
+
+    # The real first argument should be the name of the installation program.
+    # Aesthetically quote it.
+    func_quote_arg pretty "$arg"
+    func_append install_prog "$func_quote_arg_result"
+    install_shared_prog=$install_prog
+    case " $install_prog " in
+      *[\\\ /]cp\ *) install_cp=: ;;
+      *) install_cp=false ;;
+    esac
+
+    # We need to accept at least all the BSD install flags.
+    dest=
+    files=
+    opts=
+    prev=
+    install_type=
+    isdir=false
+    stripme=
+    no_mode=:
+    for arg
+    do
+      arg2=
+      if test -n "$dest"; then
+	func_append files " $dest"
+	dest=$arg
+	continue
+      fi
+
+      case $arg in
+      -d) isdir=: ;;
+      -f)
+	if $install_cp; then :; else
+	  prev=$arg
+	fi
+	;;
+      -g | -m | -o)
+	prev=$arg
+	;;
+      -s)
+	stripme=" -s"
+	continue
+	;;
+      -*)
+	;;
+      *)
+	# If the previous option needed an argument, then skip it.
+	if test -n "$prev"; then
+	  if test X-m = "X$prev" && test -n "$install_override_mode"; then
+	    arg2=$install_override_mode
+	    no_mode=false
+	  fi
+	  prev=
+	else
+	  dest=$arg
+	  continue
+	fi
+	;;
+      esac
+
+      # Aesthetically quote the argument.
+      func_quote_arg pretty "$arg"
+      func_append install_prog " $func_quote_arg_result"
+      if test -n "$arg2"; then
+	func_quote_arg pretty "$arg2"
+      fi
+      func_append install_shared_prog " $func_quote_arg_result"
+    done
+
+    test -z "$install_prog" && \
+      func_fatal_help "you must specify an install program"
+
+    test -n "$prev" && \
+      func_fatal_help "the '$prev' option requires an argument"
+
+    if test -n "$install_override_mode" && $no_mode; then
+      if $install_cp; then :; else
+	func_quote_arg pretty "$install_override_mode"
+	func_append install_shared_prog " -m $func_quote_arg_result"
+      fi
+    fi
+
+    if test -z "$files"; then
+      if test -z "$dest"; then
+	func_fatal_help "no file or destination specified"
+      else
+	func_fatal_help "you must specify a destination"
+      fi
+    fi
+
+    # Strip any trailing slash from the destination.
+    func_stripname '' '/' "$dest"
+    dest=$func_stripname_result
+
+    # Check to see that the destination is a directory.
+    test -d "$dest" && isdir=:
+    if $isdir; then
+      destdir=$dest
+      destname=
+    else
+      func_dirname_and_basename "$dest" "" "."
+      destdir=$func_dirname_result
+      destname=$func_basename_result
+
+      # Not a directory, so check to see that there is only one file specified.
+      set dummy $files; shift
+      test "$#" -gt 1 && \
+	func_fatal_help "'$dest' is not a directory"
+    fi
+    case $destdir in
+    [\\/]* | [A-Za-z]:[\\/]*) ;;
+    *)
+      for file in $files; do
+	case $file in
+	*.lo) ;;
+	*)
+	  func_fatal_help "'$destdir' must be an absolute directory name"
+	  ;;
+	esac
+      done
+      ;;
+    esac
+
+    # This variable tells wrapper scripts just to set variables rather
+    # than running their programs.
+    libtool_install_magic=$magic
+
+    staticlibs=
+    future_libdirs=
+    current_libdirs=
+    for file in $files; do
+
+      # Do each installation.
+      case $file in
+      *.$libext)
+	# Do the static libraries later.
+	func_append staticlibs " $file"
+	;;
+
+      *.la)
+	func_resolve_sysroot "$file"
+	file=$func_resolve_sysroot_result
+
+	# Check to see that this really is a libtool archive.
+	func_lalib_unsafe_p "$file" \
+	  || func_fatal_help "'$file' is not a valid libtool archive"
+
+	library_names=
+	old_library=
+	relink_command=
+	func_source "$file"
+
+	# Add the libdir to current_libdirs if it is the destination.
+	if test "X$destdir" = "X$libdir"; then
+	  case "$current_libdirs " in
+	  *" $libdir "*) ;;
+	  *) func_append current_libdirs " $libdir" ;;
+	  esac
+	else
+	  # Note the libdir as a future libdir.
+	  case "$future_libdirs " in
+	  *" $libdir "*) ;;
+	  *) func_append future_libdirs " $libdir" ;;
+	  esac
+	fi
+
+	func_dirname "$file" "/" ""
+	dir=$func_dirname_result
+	func_append dir "$objdir"
+
+	if test -n "$relink_command"; then
+	  # Determine the prefix the user has applied to our future dir.
+	  inst_prefix_dir=`$ECHO "$destdir" | $SED -e "s%$libdir\$%%"`
+
+	  # Don't allow the user to place us outside of our expected
+	  # location b/c this prevents finding dependent libraries that
+	  # are installed to the same prefix.
+	  # At present, this check doesn't affect windows .dll's that
+	  # are installed into $libdir/../bin (currently, that works fine)
+	  # but it's something to keep an eye on.
+	  test "$inst_prefix_dir" = "$destdir" && \
+	    func_fatal_error "error: cannot install '$file' to a directory not ending in $libdir"
+
+	  if test -n "$inst_prefix_dir"; then
+	    # Stick the inst_prefix_dir data into the link command.
+	    relink_command=`$ECHO "$relink_command" | $SED "s%@inst_prefix_dir@%-inst-prefix-dir $inst_prefix_dir%"`
+	  else
+	    relink_command=`$ECHO "$relink_command" | $SED "s%@inst_prefix_dir@%%"`
+	  fi
+
+	  func_warning "relinking '$file'"
+	  func_show_eval "$relink_command" \
+	    'func_fatal_error "error: relink '\''$file'\'' with the above command before installing it"'
+	fi
+
+	# See the names of the shared library.
+	set dummy $library_names; shift
+	if test -n "$1"; then
+	  realname=$1
+	  shift
+
+	  srcname=$realname
+	  test -n "$relink_command" && srcname=${realname}T
+
+	  # Install the shared library and build the symlinks.
+	  func_show_eval "$install_shared_prog $dir/$srcname $destdir/$realname" \
+	      'exit $?'
+	  tstripme=$stripme
+	  case $host_os in
+	  cygwin* | mingw* | pw32* | cegcc*)
+	    case $realname in
+	    *.dll.a)
+	      tstripme=
+	      ;;
+	    esac
+	    ;;
+	  os2*)
+	    case $realname in
+	    *_dll.a)
+	      tstripme=
+	      ;;
+	    esac
+	    ;;
+	  esac
+	  if test -n "$tstripme" && test -n "$striplib"; then
+	    func_show_eval "$striplib $destdir/$realname" 'exit $?'
+	  fi
+
+	  if test "$#" -gt 0; then
+	    # Delete the old symlinks, and create new ones.
+	    # Try 'ln -sf' first, because the 'ln' binary might depend on
+	    # the symlink we replace!  Solaris /bin/ln does not understand -f,
+	    # so we also need to try rm && ln -s.
+	    for linkname
+	    do
+	      test "$linkname" != "$realname" \
+		&& func_show_eval "(cd $destdir && { $LN_S -f $realname $linkname || { $RM $linkname && $LN_S $realname $linkname; }; })"
+	    done
+	  fi
+
+	  # Do each command in the postinstall commands.
+	  lib=$destdir/$realname
+	  func_execute_cmds "$postinstall_cmds" 'exit $?'
+	fi
+
+	# Install the pseudo-library for information purposes.
+	func_basename "$file"
+	name=$func_basename_result
+	instname=$dir/${name}i
+	func_show_eval "$install_prog $instname $destdir/$name" 'exit $?'
+
+	# Maybe install the static library, too.
+	test -n "$old_library" && func_append staticlibs " $dir/$old_library"
+	;;
+
+      *.lo)
+	# Install (i.e. copy) a libtool object.
+
+	# Figure out destination file name, if it wasn't already specified.
+	if test -n "$destname"; then
+	  destfile=$destdir/$destname
+	else
+	  func_basename "$file"
+	  destfile=$func_basename_result
+	  destfile=$destdir/$destfile
+	fi
+
+	# Deduce the name of the destination old-style object file.
+	case $destfile in
+	*.lo)
+	  func_lo2o "$destfile"
+	  staticdest=$func_lo2o_result
+	  ;;
+	*.$objext)
+	  staticdest=$destfile
+	  destfile=
+	  ;;
+	*)
+	  func_fatal_help "cannot copy a libtool object to '$destfile'"
+	  ;;
+	esac
+
+	# Install the libtool object if requested.
+	test -n "$destfile" && \
+	  func_show_eval "$install_prog $file $destfile" 'exit $?'
+
+	# Install the old object if enabled.
+	if test yes = "$build_old_libs"; then
+	  # Deduce the name of the old-style object file.
+	  func_lo2o "$file"
+	  staticobj=$func_lo2o_result
+	  func_show_eval "$install_prog \$staticobj \$staticdest" 'exit $?'
+	fi
+	exit $EXIT_SUCCESS
+	;;
+
+      *)
+	# Figure out destination file name, if it wasn't already specified.
+	if test -n "$destname"; then
+	  destfile=$destdir/$destname
+	else
+	  func_basename "$file"
+	  destfile=$func_basename_result
+	  destfile=$destdir/$destfile
+	fi
+
+	# If the file is missing, and there is a .exe on the end, strip it
+	# because it is most likely a libtool script we actually want to
+	# install
+	stripped_ext=
+	case $file in
+	  *.exe)
+	    if test ! -f "$file"; then
+	      func_stripname '' '.exe' "$file"
+	      file=$func_stripname_result
+	      stripped_ext=.exe
+	    fi
+	    ;;
+	esac
+
+	# Do a test to see if this is really a libtool program.
+	case $host in
+	*cygwin* | *mingw*)
+	    if func_ltwrapper_executable_p "$file"; then
+	      func_ltwrapper_scriptname "$file"
+	      wrapper=$func_ltwrapper_scriptname_result
+	    else
+	      func_stripname '' '.exe' "$file"
+	      wrapper=$func_stripname_result
+	    fi
+	    ;;
+	*)
+	    wrapper=$file
+	    ;;
+	esac
+	if func_ltwrapper_script_p "$wrapper"; then
+	  notinst_deplibs=
+	  relink_command=
+
+	  func_source "$wrapper"
+
+	  # Check the variables that should have been set.
+	  test -z "$generated_by_libtool_version" && \
+	    func_fatal_error "invalid libtool wrapper script '$wrapper'"
+
+	  finalize=:
+	  for lib in $notinst_deplibs; do
+	    # Check to see that each library is installed.
+	    libdir=
+	    if test -f "$lib"; then
+	      func_source "$lib"
+	    fi
+	    libfile=$libdir/`$ECHO "$lib" | $SED 's%^.*/%%g'`
+	    if test -n "$libdir" && test ! -f "$libfile"; then
+	      func_warning "'$lib' has not been installed in '$libdir'"
+	      finalize=false
+	    fi
+	  done
+
+	  relink_command=
+	  func_source "$wrapper"
+
+	  outputname=
+	  if test no = "$fast_install" && test -n "$relink_command"; then
+	    $opt_dry_run || {
+	      if $finalize; then
+	        tmpdir=`func_mktempdir`
+		func_basename "$file$stripped_ext"
+		file=$func_basename_result
+	        outputname=$tmpdir/$file
+	        # Replace the output file specification.
+	        relink_command=`$ECHO "$relink_command" | $SED 's%@OUTPUT@%'"$outputname"'%g'`
+
+	        $opt_quiet || {
+	          func_quote_arg expand,pretty "$relink_command"
+		  eval "func_echo $func_quote_arg_result"
+	        }
+	        if eval "$relink_command"; then :
+	          else
+		  func_error "error: relink '$file' with the above command before installing it"
+		  $opt_dry_run || ${RM}r "$tmpdir"
+		  continue
+	        fi
+	        file=$outputname
+	      else
+	        func_warning "cannot relink '$file'"
+	      fi
+	    }
+	  else
+	    # Install the binary that we compiled earlier.
+	    file=`$ECHO "$file$stripped_ext" | $SED "s%\([^/]*\)$%$objdir/\1%"`
+	  fi
+	fi
+
+	# remove .exe since cygwin /usr/bin/install will append another
+	# one anyway
+	case $install_prog,$host in
+	*/usr/bin/install*,*cygwin*)
+	  case $file:$destfile in
+	  *.exe:*.exe)
+	    # this is ok
+	    ;;
+	  *.exe:*)
+	    destfile=$destfile.exe
+	    ;;
+	  *:*.exe)
+	    func_stripname '' '.exe' "$destfile"
+	    destfile=$func_stripname_result
+	    ;;
+	  esac
+	  ;;
+	esac
+	func_show_eval "$install_prog\$stripme \$file \$destfile" 'exit $?'
+	$opt_dry_run || if test -n "$outputname"; then
+	  ${RM}r "$tmpdir"
+	fi
+	;;
+      esac
+    done
+
+    for file in $staticlibs; do
+      func_basename "$file"
+      name=$func_basename_result
+
+      # Set up the ranlib parameters.
+      oldlib=$destdir/$name
+      func_to_tool_file "$oldlib" func_convert_file_msys_to_w32
+      tool_oldlib=$func_to_tool_file_result
+
+      func_show_eval "$install_prog \$file \$oldlib" 'exit $?'
+
+      if test -n "$stripme" && test -n "$old_striplib"; then
+	func_show_eval "$old_striplib $tool_oldlib" 'exit $?'
+      fi
+
+      # Do each command in the postinstall commands.
+      func_execute_cmds "$old_postinstall_cmds" 'exit $?'
+    done
+
+    test -n "$future_libdirs" && \
+      func_warning "remember to run '$progname --finish$future_libdirs'"
+
+    if test -n "$current_libdirs"; then
+      # Maybe just do a dry run.
+      $opt_dry_run && current_libdirs=" -n$current_libdirs"
+      exec_cmd='$SHELL "$progpath" $preserve_args --finish$current_libdirs'
+    else
+      exit $EXIT_SUCCESS
+    fi
+}
+
+test install = "$opt_mode" && func_mode_install ${1+"$@"}
+
+
+# func_generate_dlsyms outputname originator pic_p
+# Extract symbols from dlprefiles and create ${outputname}S.o with
+# a dlpreopen symbol table.
+func_generate_dlsyms ()
+{
+    $debug_cmd
+
+    my_outputname=$1
+    my_originator=$2
+    my_pic_p=${3-false}
+    my_prefix=`$ECHO "$my_originator" | $SED 's%[^a-zA-Z0-9]%_%g'`
+    my_dlsyms=
+
+    if test -n "$dlfiles$dlprefiles" || test no != "$dlself"; then
+      if test -n "$NM" && test -n "$global_symbol_pipe"; then
+	my_dlsyms=${my_outputname}S.c
+      else
+	func_error "not configured to extract global symbols from dlpreopened files"
+      fi
+    fi
+
+    if test -n "$my_dlsyms"; then
+      case $my_dlsyms in
+      "") ;;
+      *.c)
+	# Discover the nlist of each of the dlfiles.
+	nlist=$output_objdir/$my_outputname.nm
+
+	func_show_eval "$RM $nlist ${nlist}S ${nlist}T"
+
+	# Parse the name list into a source file.
+	func_verbose "creating $output_objdir/$my_dlsyms"
+
+	$opt_dry_run || $ECHO > "$output_objdir/$my_dlsyms" "\
+/* $my_dlsyms - symbol resolution table for '$my_outputname' dlsym emulation. */
+/* Generated by $PROGRAM (GNU $PACKAGE) $VERSION */
+
+#ifdef __cplusplus
+extern \"C\" {
+#endif
+
+#if defined __GNUC__ && (((__GNUC__ == 4) && (__GNUC_MINOR__ >= 4)) || (__GNUC__ > 4))
+#pragma GCC diagnostic ignored \"-Wstrict-prototypes\"
+#endif
+
+/* Keep this code in sync between libtool.m4, ltmain, lt_system.h, and tests.  */
+#if defined _WIN32 || defined __CYGWIN__ || defined _WIN32_WCE
+/* DATA imports from DLLs on WIN32 can't be const, because runtime
+   relocations are performed -- see ld's documentation on pseudo-relocs.  */
+# define LT_DLSYM_CONST
+#elif defined __osf__
+/* This system does not cope well with relocations in const data.  */
+# define LT_DLSYM_CONST
+#else
+# define LT_DLSYM_CONST const
+#endif
+
+#define STREQ(s1, s2) (strcmp ((s1), (s2)) == 0)
+
+/* External symbol declarations for the compiler. */\
+"
+
+	if test yes = "$dlself"; then
+	  func_verbose "generating symbol list for '$output'"
+
+	  $opt_dry_run || echo ': @PROGRAM@ ' > "$nlist"
+
+	  # Add our own program objects to the symbol list.
+	  progfiles=`$ECHO "$objs$old_deplibs" | $SP2NL | $SED "$lo2o" | $NL2SP`
+	  for progfile in $progfiles; do
+	    func_to_tool_file "$progfile" func_convert_file_msys_to_w32
+	    func_verbose "extracting global C symbols from '$func_to_tool_file_result'"
+	    $opt_dry_run || eval "$NM $func_to_tool_file_result | $global_symbol_pipe >> '$nlist'"
+	  done
+
+	  if test -n "$exclude_expsyms"; then
+	    $opt_dry_run || {
+	      eval '$EGREP -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T'
+	      eval '$MV "$nlist"T "$nlist"'
+	    }
+	  fi
+
+	  if test -n "$export_symbols_regex"; then
+	    $opt_dry_run || {
+	      eval '$EGREP -e "$export_symbols_regex" "$nlist" > "$nlist"T'
+	      eval '$MV "$nlist"T "$nlist"'
+	    }
+	  fi
+
+	  # Prepare the list of exported symbols
+	  if test -z "$export_symbols"; then
+	    export_symbols=$output_objdir/$outputname.exp
+	    $opt_dry_run || {
+	      $RM $export_symbols
+	      eval "$SED -n -e '/^: @PROGRAM@ $/d' -e 's/^.* \(.*\)$/\1/p' "'< "$nlist" > "$export_symbols"'
+	      case $host in
+	      *cygwin* | *mingw* | *cegcc* )
+                eval "echo EXPORTS "'> "$output_objdir/$outputname.def"'
+                eval 'cat "$export_symbols" >> "$output_objdir/$outputname.def"'
+	        ;;
+	      esac
+	    }
+	  else
+	    $opt_dry_run || {
+	      eval "$SED -e 's/\([].[*^$]\)/\\\\\1/g' -e 's/^/ /' -e 's/$/$/'"' < "$export_symbols" > "$output_objdir/$outputname.exp"'
+	      eval '$GREP -f "$output_objdir/$outputname.exp" < "$nlist" > "$nlist"T'
+	      eval '$MV "$nlist"T "$nlist"'
+	      case $host in
+	        *cygwin* | *mingw* | *cegcc* )
+	          eval "echo EXPORTS "'> "$output_objdir/$outputname.def"'
+	          eval 'cat "$nlist" >> "$output_objdir/$outputname.def"'
+	          ;;
+	      esac
+	    }
+	  fi
+	fi
+
+	for dlprefile in $dlprefiles; do
+	  func_verbose "extracting global C symbols from '$dlprefile'"
+	  func_basename "$dlprefile"
+	  name=$func_basename_result
+          case $host in
+	    *cygwin* | *mingw* | *cegcc* )
+	      # if an import library, we need to obtain dlname
+	      if func_win32_import_lib_p "$dlprefile"; then
+	        func_tr_sh "$dlprefile"
+	        eval "curr_lafile=\$libfile_$func_tr_sh_result"
+	        dlprefile_dlbasename=
+	        if test -n "$curr_lafile" && func_lalib_p "$curr_lafile"; then
+	          # Use subshell, to avoid clobbering current variable values
+	          dlprefile_dlname=`source "$curr_lafile" && echo "$dlname"`
+	          if test -n "$dlprefile_dlname"; then
+	            func_basename "$dlprefile_dlname"
+	            dlprefile_dlbasename=$func_basename_result
+	          else
+	            # no lafile. user explicitly requested -dlpreopen .
+	            $sharedlib_from_linklib_cmd "$dlprefile"
+	            dlprefile_dlbasename=$sharedlib_from_linklib_result
+	          fi
+	        fi
+	        $opt_dry_run || {
+	          if test -n "$dlprefile_dlbasename"; then
+	            eval '$ECHO ": $dlprefile_dlbasename" >> "$nlist"'
+	          else
+	            func_warning "Could not compute DLL name from $name"
+	            eval '$ECHO ": $name " >> "$nlist"'
+	          fi
+	          func_to_tool_file "$dlprefile" func_convert_file_msys_to_w32
+	          eval "$NM \"$func_to_tool_file_result\" 2>/dev/null | $global_symbol_pipe |
+	            $SED -e '/I __imp/d' -e 's/I __nm_/D /;s/_nm__//' >> '$nlist'"
+	        }
+	      else # not an import lib
+	        $opt_dry_run || {
+	          eval '$ECHO ": $name " >> "$nlist"'
+	          func_to_tool_file "$dlprefile" func_convert_file_msys_to_w32
+	          eval "$NM \"$func_to_tool_file_result\" 2>/dev/null | $global_symbol_pipe >> '$nlist'"
+	        }
+	      fi
+	    ;;
+	    *)
+	      $opt_dry_run || {
+	        eval '$ECHO ": $name " >> "$nlist"'
+	        func_to_tool_file "$dlprefile" func_convert_file_msys_to_w32
+	        eval "$NM \"$func_to_tool_file_result\" 2>/dev/null | $global_symbol_pipe >> '$nlist'"
+	      }
+	    ;;
+          esac
+	done
+
+	$opt_dry_run || {
+	  # Make sure we have at least an empty file.
+	  test -f "$nlist" || : > "$nlist"
+
+	  if test -n "$exclude_expsyms"; then
+	    $EGREP -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T
+	    $MV "$nlist"T "$nlist"
+	  fi
+
+	  # Try sorting and uniquifying the output.
+	  if $GREP -v "^: " < "$nlist" |
+	      if sort -k 3 /dev/null 2>&1; then
+		sort -k 3
+	      else
+		sort +2
+	      fi |
+	      uniq > "$nlist"S; then
+	    :
+	  else
+	    $GREP -v "^: " < "$nlist" > "$nlist"S
+	  fi
+
+	  if test -f "$nlist"S; then
+	    eval "$global_symbol_to_cdecl"' < "$nlist"S >> "$output_objdir/$my_dlsyms"'
+	  else
+	    echo '/* NONE */' >> "$output_objdir/$my_dlsyms"
+	  fi
+
+	  func_show_eval '$RM "${nlist}I"'
+	  if test -n "$global_symbol_to_import"; then
+	    eval "$global_symbol_to_import"' < "$nlist"S > "$nlist"I'
+	  fi
+
+	  echo >> "$output_objdir/$my_dlsyms" "\
+
+/* The mapping between symbol names and symbols.  */
+typedef struct {
+  const char *name;
+  void *address;
+} lt_dlsymlist;
+extern LT_DLSYM_CONST lt_dlsymlist
+lt_${my_prefix}_LTX_preloaded_symbols[];\
+"
+
+	  if test -s "$nlist"I; then
+	    echo >> "$output_objdir/$my_dlsyms" "\
+static void lt_syminit(void)
+{
+  LT_DLSYM_CONST lt_dlsymlist *symbol = lt_${my_prefix}_LTX_preloaded_symbols;
+  for (; symbol->name; ++symbol)
+    {"
+	    $SED 's/.*/      if (STREQ (symbol->name, \"&\")) symbol->address = (void *) \&&;/' < "$nlist"I >> "$output_objdir/$my_dlsyms"
+	    echo >> "$output_objdir/$my_dlsyms" "\
+    }
+}"
+	  fi
+	  echo >> "$output_objdir/$my_dlsyms" "\
+LT_DLSYM_CONST lt_dlsymlist
+lt_${my_prefix}_LTX_preloaded_symbols[] =
+{ {\"$my_originator\", (void *) 0},"
+
+	  if test -s "$nlist"I; then
+	    echo >> "$output_objdir/$my_dlsyms" "\
+  {\"@INIT@\", (void *) <_syminit},"
+	  fi
+
+	  case $need_lib_prefix in
+	  no)
+	    eval "$global_symbol_to_c_name_address" < "$nlist" >> "$output_objdir/$my_dlsyms"
+	    ;;
+	  *)
+	    eval "$global_symbol_to_c_name_address_lib_prefix" < "$nlist" >> "$output_objdir/$my_dlsyms"
+	    ;;
+	  esac
+	  echo >> "$output_objdir/$my_dlsyms" "\
+  {0, (void *) 0}
+};
+
+/* This works around a problem in FreeBSD linker */
+#ifdef FREEBSD_WORKAROUND
+static const void *lt_preloaded_setup() {
+  return lt_${my_prefix}_LTX_preloaded_symbols;
+}
+#endif
+
+#ifdef __cplusplus
+}
+#endif\
+"
+	} # !$opt_dry_run
+
+	pic_flag_for_symtable=
+	case "$compile_command " in
+	*" -static "*) ;;
+	*)
+	  case $host in
+	  # compiling the symbol table file with pic_flag works around
+	  # a FreeBSD bug that causes programs to crash when -lm is
+	  # linked before any other PIC object.  But we must not use
+	  # pic_flag when linking with -static.  The problem exists in
+	  # FreeBSD 2.2.6 and is fixed in FreeBSD 3.1.
+	  *-*-freebsd2.*|*-*-freebsd3.0*|*-*-freebsdelf3.0*)
+	    pic_flag_for_symtable=" $pic_flag -DFREEBSD_WORKAROUND" ;;
+	  *-*-hpux*)
+	    pic_flag_for_symtable=" $pic_flag"  ;;
+	  *)
+	    $my_pic_p && pic_flag_for_symtable=" $pic_flag"
+	    ;;
+	  esac
+	  ;;
+	esac
+	symtab_cflags=
+	for arg in $LTCFLAGS; do
+	  case $arg in
+	  -pie | -fpie | -fPIE) ;;
+	  *) func_append symtab_cflags " $arg" ;;
+	  esac
+	done
+
+	# Now compile the dynamic symbol file.
+	func_show_eval '(cd $output_objdir && $LTCC$symtab_cflags -c$no_builtin_flag$pic_flag_for_symtable "$my_dlsyms")' 'exit $?'
+
+	# Clean up the generated files.
+	func_show_eval '$RM "$output_objdir/$my_dlsyms" "$nlist" "${nlist}S" "${nlist}T" "${nlist}I"'
+
+	# Transform the symbol file into the correct name.
+	symfileobj=$output_objdir/${my_outputname}S.$objext
+	case $host in
+	*cygwin* | *mingw* | *cegcc* )
+	  if test -f "$output_objdir/$my_outputname.def"; then
+	    compile_command=`$ECHO "$compile_command" | $SED "s%@SYMFILE@%$output_objdir/$my_outputname.def $symfileobj%"`
+	    finalize_command=`$ECHO "$finalize_command" | $SED "s%@SYMFILE@%$output_objdir/$my_outputname.def $symfileobj%"`
+	  else
+	    compile_command=`$ECHO "$compile_command" | $SED "s%@SYMFILE@%$symfileobj%"`
+	    finalize_command=`$ECHO "$finalize_command" | $SED "s%@SYMFILE@%$symfileobj%"`
+	  fi
+	  ;;
+	*)
+	  compile_command=`$ECHO "$compile_command" | $SED "s%@SYMFILE@%$symfileobj%"`
+	  finalize_command=`$ECHO "$finalize_command" | $SED "s%@SYMFILE@%$symfileobj%"`
+	  ;;
+	esac
+	;;
+      *)
+	func_fatal_error "unknown suffix for '$my_dlsyms'"
+	;;
+      esac
+    else
+      # We keep going just in case the user didn't refer to
+      # lt_preloaded_symbols.  The linker will fail if global_symbol_pipe
+      # really was required.
+
+      # Nullify the symbol file.
+      compile_command=`$ECHO "$compile_command" | $SED "s% @SYMFILE@%%"`
+      finalize_command=`$ECHO "$finalize_command" | $SED "s% @SYMFILE@%%"`
+    fi
+}
+
+# func_cygming_gnu_implib_p ARG
+# This predicate returns with zero status (TRUE) if
+# ARG is a GNU/binutils-style import library. Returns
+# with nonzero status (FALSE) otherwise.
+func_cygming_gnu_implib_p ()
+{
+  $debug_cmd
+
+  func_to_tool_file "$1" func_convert_file_msys_to_w32
+  func_cygming_gnu_implib_tmp=`$NM "$func_to_tool_file_result" | eval "$global_symbol_pipe" | $EGREP ' (_head_[A-Za-z0-9_]+_[ad]l*|[A-Za-z0-9_]+_[ad]l*_iname)$'`
+  test -n "$func_cygming_gnu_implib_tmp"
+}
+
+# func_cygming_ms_implib_p ARG
+# This predicate returns with zero status (TRUE) if
+# ARG is an MS-style import library. Returns
+# with nonzero status (FALSE) otherwise.
+func_cygming_ms_implib_p ()
+{
+  $debug_cmd
+
+  func_to_tool_file "$1" func_convert_file_msys_to_w32
+  func_cygming_ms_implib_tmp=`$NM "$func_to_tool_file_result" | eval "$global_symbol_pipe" | $GREP '_NULL_IMPORT_DESCRIPTOR'`
+  test -n "$func_cygming_ms_implib_tmp"
+}
+
+# func_win32_libid arg
+# return the library type of file 'arg'
+#
+# Need a lot of goo to handle *both* DLLs and import libs
+# Has to be a shell function in order to 'eat' the argument
+# that is supplied when $file_magic_command is called.
+# Despite the name, also deal with 64 bit binaries.
+func_win32_libid ()
+{
+  $debug_cmd
+
+  win32_libid_type=unknown
+  win32_fileres=`file -L $1 2>/dev/null`
+  case $win32_fileres in
+  *ar\ archive\ import\ library*) # definitely import
+    win32_libid_type="x86 archive import"
+    ;;
+  *ar\ archive*) # could be an import, or static
+    # Keep the egrep pattern in sync with the one in _LT_CHECK_MAGIC_METHOD.
+    if eval $OBJDUMP -f $1 | $SED -e '10q' 2>/dev/null |
+       $EGREP 'file format (pei*-i386(.*architecture: i386)?|pe-arm-wince|pe-x86-64)' >/dev/null; then
+      case $nm_interface in
+      "MS dumpbin")
+	if func_cygming_ms_implib_p "$1" ||
+	   func_cygming_gnu_implib_p "$1"
+	then
+	  win32_nmres=import
+	else
+	  win32_nmres=
+	fi
+	;;
+      *)
+	func_to_tool_file "$1" func_convert_file_msys_to_w32
+	win32_nmres=`eval $NM -f posix -A \"$func_to_tool_file_result\" |
+	  $SED -n -e '
+	    1,100{
+		/ I /{
+		    s|.*|import|
+		    p
+		    q
+		}
+	    }'`
+	;;
+      esac
+      case $win32_nmres in
+      import*)  win32_libid_type="x86 archive import";;
+      *)        win32_libid_type="x86 archive static";;
+      esac
+    fi
+    ;;
+  *DLL*)
+    win32_libid_type="x86 DLL"
+    ;;
+  *executable*) # but shell scripts are "executable" too...
+    case $win32_fileres in
+    *MS\ Windows\ PE\ Intel*)
+      win32_libid_type="x86 DLL"
+      ;;
+    esac
+    ;;
+  esac
+  $ECHO "$win32_libid_type"
+}
+
+# func_cygming_dll_for_implib ARG
+#
+# Platform-specific function to extract the
+# name of the DLL associated with the specified
+# import library ARG.
+# Invoked by eval'ing the libtool variable
+#    $sharedlib_from_linklib_cmd
+# Result is available in the variable
+#    $sharedlib_from_linklib_result
+func_cygming_dll_for_implib ()
+{
+  $debug_cmd
+
+  sharedlib_from_linklib_result=`$DLLTOOL --identify-strict --identify "$1"`
+}
+
+# func_cygming_dll_for_implib_fallback_core SECTION_NAME LIBNAMEs
+#
+# The is the core of a fallback implementation of a
+# platform-specific function to extract the name of the
+# DLL associated with the specified import library LIBNAME.
+#
+# SECTION_NAME is either .idata$6 or .idata$7, depending
+# on the platform and compiler that created the implib.
+#
+# Echos the name of the DLL associated with the
+# specified import library.
+func_cygming_dll_for_implib_fallback_core ()
+{
+  $debug_cmd
+
+  match_literal=`$ECHO "$1" | $SED "$sed_make_literal_regex"`
+  $OBJDUMP -s --section "$1" "$2" 2>/dev/null |
+    $SED '/^Contents of section '"$match_literal"':/{
+      # Place marker at beginning of archive member dllname section
+      s/.*/====MARK====/
+      p
+      d
+    }
+    # These lines can sometimes be longer than 43 characters, but
+    # are always uninteresting
+    /:[	 ]*file format pe[i]\{,1\}-/d
+    /^In archive [^:]*:/d
+    # Ensure marker is printed
+    /^====MARK====/p
+    # Remove all lines with less than 43 characters
+    /^.\{43\}/!d
+    # From remaining lines, remove first 43 characters
+    s/^.\{43\}//' |
+    $SED -n '
+      # Join marker and all lines until next marker into a single line
+      /^====MARK====/ b para
+      H
+      $ b para
+      b
+      :para
+      x
+      s/\n//g
+      # Remove the marker
+      s/^====MARK====//
+      # Remove trailing dots and whitespace
+      s/[\. \t]*$//
+      # Print
+      /./p' |
+    # we now have a list, one entry per line, of the stringified
+    # contents of the appropriate section of all members of the
+    # archive that possess that section. Heuristic: eliminate
+    # all those that have a first or second character that is
+    # a '.' (that is, objdump's representation of an unprintable
+    # character.) This should work for all archives with less than
+    # 0x302f exports -- but will fail for DLLs whose name actually
+    # begins with a literal '.' or a single character followed by
+    # a '.'.
+    #
+    # Of those that remain, print the first one.
+    $SED -e '/^\./d;/^.\./d;q'
+}
+
+# func_cygming_dll_for_implib_fallback ARG
+# Platform-specific function to extract the
+# name of the DLL associated with the specified
+# import library ARG.
+#
+# This fallback implementation is for use when $DLLTOOL
+# does not support the --identify-strict option.
+# Invoked by eval'ing the libtool variable
+#    $sharedlib_from_linklib_cmd
+# Result is available in the variable
+#    $sharedlib_from_linklib_result
+func_cygming_dll_for_implib_fallback ()
+{
+  $debug_cmd
+
+  if func_cygming_gnu_implib_p "$1"; then
+    # binutils import library
+    sharedlib_from_linklib_result=`func_cygming_dll_for_implib_fallback_core '.idata$7' "$1"`
+  elif func_cygming_ms_implib_p "$1"; then
+    # ms-generated import library
+    sharedlib_from_linklib_result=`func_cygming_dll_for_implib_fallback_core '.idata$6' "$1"`
+  else
+    # unknown
+    sharedlib_from_linklib_result=
+  fi
+}
+
+
+# func_extract_an_archive dir oldlib
+func_extract_an_archive ()
+{
+    $debug_cmd
+
+    f_ex_an_ar_dir=$1; shift
+    f_ex_an_ar_oldlib=$1
+    if test yes = "$lock_old_archive_extraction"; then
+      lockfile=$f_ex_an_ar_oldlib.lock
+      until $opt_dry_run || ln "$progpath" "$lockfile" 2>/dev/null; do
+	func_echo "Waiting for $lockfile to be removed"
+	sleep 2
+      done
+    fi
+    func_show_eval "(cd \$f_ex_an_ar_dir && $AR x \"\$f_ex_an_ar_oldlib\")" \
+		   'stat=$?; rm -f "$lockfile"; exit $stat'
+    if test yes = "$lock_old_archive_extraction"; then
+      $opt_dry_run || rm -f "$lockfile"
+    fi
+    if ($AR t "$f_ex_an_ar_oldlib" | sort | sort -uc >/dev/null 2>&1); then
+     :
+    else
+      func_fatal_error "object name conflicts in archive: $f_ex_an_ar_dir/$f_ex_an_ar_oldlib"
+    fi
+}
+
+
+# func_extract_archives gentop oldlib ...
+func_extract_archives ()
+{
+    $debug_cmd
+
+    my_gentop=$1; shift
+    my_oldlibs=${1+"$@"}
+    my_oldobjs=
+    my_xlib=
+    my_xabs=
+    my_xdir=
+
+    for my_xlib in $my_oldlibs; do
+      # Extract the objects.
+      case $my_xlib in
+	[\\/]* | [A-Za-z]:[\\/]*) my_xabs=$my_xlib ;;
+	*) my_xabs=`pwd`"/$my_xlib" ;;
+      esac
+      func_basename "$my_xlib"
+      my_xlib=$func_basename_result
+      my_xlib_u=$my_xlib
+      while :; do
+        case " $extracted_archives " in
+	*" $my_xlib_u "*)
+	  func_arith $extracted_serial + 1
+	  extracted_serial=$func_arith_result
+	  my_xlib_u=lt$extracted_serial-$my_xlib ;;
+	*) break ;;
+	esac
+      done
+      extracted_archives="$extracted_archives $my_xlib_u"
+      my_xdir=$my_gentop/$my_xlib_u
+
+      func_mkdir_p "$my_xdir"
+
+      case $host in
+      *-darwin*)
+	func_verbose "Extracting $my_xabs"
+	# Do not bother doing anything if just a dry run
+	$opt_dry_run || {
+	  darwin_orig_dir=`pwd`
+	  cd $my_xdir || exit $?
+	  darwin_archive=$my_xabs
+	  darwin_curdir=`pwd`
+	  func_basename "$darwin_archive"
+	  darwin_base_archive=$func_basename_result
+	  darwin_arches=`$LIPO -info "$darwin_archive" 2>/dev/null | $GREP Architectures 2>/dev/null || true`
+	  if test -n "$darwin_arches"; then
+	    darwin_arches=`$ECHO "$darwin_arches" | $SED -e 's/.*are://'`
+	    darwin_arch=
+	    func_verbose "$darwin_base_archive has multiple architectures $darwin_arches"
+	    for darwin_arch in  $darwin_arches; do
+	      func_mkdir_p "unfat-$$/$darwin_base_archive-$darwin_arch"
+	      $LIPO -thin $darwin_arch -output "unfat-$$/$darwin_base_archive-$darwin_arch/$darwin_base_archive" "$darwin_archive"
+	      cd "unfat-$$/$darwin_base_archive-$darwin_arch"
+	      func_extract_an_archive "`pwd`" "$darwin_base_archive"
+	      cd "$darwin_curdir"
+	      $RM "unfat-$$/$darwin_base_archive-$darwin_arch/$darwin_base_archive"
+	    done # $darwin_arches
+            ## Okay now we've a bunch of thin objects, gotta fatten them up :)
+	    darwin_filelist=`find unfat-$$ -type f -name \*.o -print -o -name \*.lo -print | $SED -e "$sed_basename" | sort -u`
+	    darwin_file=
+	    darwin_files=
+	    for darwin_file in $darwin_filelist; do
+	      darwin_files=`find unfat-$$ -name $darwin_file -print | sort | $NL2SP`
+	      $LIPO -create -output "$darwin_file" $darwin_files
+	    done # $darwin_filelist
+	    $RM -rf unfat-$$
+	    cd "$darwin_orig_dir"
+	  else
+	    cd $darwin_orig_dir
+	    func_extract_an_archive "$my_xdir" "$my_xabs"
+	  fi # $darwin_arches
+	} # !$opt_dry_run
+	;;
+      *)
+        func_extract_an_archive "$my_xdir" "$my_xabs"
+	;;
+      esac
+      my_oldobjs="$my_oldobjs "`find $my_xdir -name \*.$objext -print -o -name \*.lo -print | sort | $NL2SP`
+    done
+
+    func_extract_archives_result=$my_oldobjs
+}
+
+
+# func_emit_wrapper [arg=no]
+#
+# Emit a libtool wrapper script on stdout.
+# Don't directly open a file because we may want to
+# incorporate the script contents within a cygwin/mingw
+# wrapper executable.  Must ONLY be called from within
+# func_mode_link because it depends on a number of variables
+# set therein.
+#
+# ARG is the value that the WRAPPER_SCRIPT_BELONGS_IN_OBJDIR
+# variable will take.  If 'yes', then the emitted script
+# will assume that the directory where it is stored is
+# the $objdir directory.  This is a cygwin/mingw-specific
+# behavior.
+func_emit_wrapper ()
+{
+	func_emit_wrapper_arg1=${1-no}
+
+	$ECHO "\
+#! $SHELL
+
+# $output - temporary wrapper script for $objdir/$outputname
+# Generated by $PROGRAM (GNU $PACKAGE) $VERSION
+#
+# The $output program cannot be directly executed until all the libtool
+# libraries that it depends on are installed.
+#
+# This wrapper script should never be moved out of the build directory.
+# If it is, it will not operate correctly.
+
+# Sed substitution that helps us do robust quoting.  It backslashifies
+# metacharacters that are still active within double-quoted strings.
+sed_quote_subst='$sed_quote_subst'
+
+# Be Bourne compatible
+if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then
+  emulate sh
+  NULLCMD=:
+  # Zsh 3.x and 4.x performs word splitting on \${1+\"\$@\"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '\${1+\"\$@\"}'='\"\$@\"'
+  setopt NO_GLOB_SUBST
+else
+  case \`(set -o) 2>/dev/null\` in *posix*) set -o posix;; esac
+fi
+BIN_SH=xpg4; export BIN_SH # for Tru64
+DUALCASE=1; export DUALCASE # for MKS sh
+
+# The HP-UX ksh and POSIX shell print the target directory to stdout
+# if CDPATH is set.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+relink_command=\"$relink_command\"
+
+# This environment variable determines our operation mode.
+if test \"\$libtool_install_magic\" = \"$magic\"; then
+  # install mode needs the following variables:
+  generated_by_libtool_version='$macro_version'
+  notinst_deplibs='$notinst_deplibs'
+else
+  # When we are sourced in execute mode, \$file and \$ECHO are already set.
+  if test \"\$libtool_execute_magic\" != \"$magic\"; then
+    file=\"\$0\""
+
+    func_quote_arg pretty "$ECHO"
+    qECHO=$func_quote_arg_result
+    $ECHO "\
+
+# A function that is used when there is no print builtin or printf.
+func_fallback_echo ()
+{
+  eval 'cat <<_LTECHO_EOF
+\$1
+_LTECHO_EOF'
+}
+    ECHO=$qECHO
+  fi
+
+# Very basic option parsing. These options are (a) specific to
+# the libtool wrapper, (b) are identical between the wrapper
+# /script/ and the wrapper /executable/ that is used only on
+# windows platforms, and (c) all begin with the string "--lt-"
+# (application programs are unlikely to have options that match
+# this pattern).
+#
+# There are only two supported options: --lt-debug and
+# --lt-dump-script. There is, deliberately, no --lt-help.
+#
+# The first argument to this parsing function should be the
+# script's $0 value, followed by "$@".
+lt_option_debug=
+func_parse_lt_options ()
+{
+  lt_script_arg0=\$0
+  shift
+  for lt_opt
+  do
+    case \"\$lt_opt\" in
+    --lt-debug) lt_option_debug=1 ;;
+    --lt-dump-script)
+        lt_dump_D=\`\$ECHO \"X\$lt_script_arg0\" | $SED -e 's/^X//' -e 's%/[^/]*$%%'\`
+        test \"X\$lt_dump_D\" = \"X\$lt_script_arg0\" && lt_dump_D=.
+        lt_dump_F=\`\$ECHO \"X\$lt_script_arg0\" | $SED -e 's/^X//' -e 's%^.*/%%'\`
+        cat \"\$lt_dump_D/\$lt_dump_F\"
+        exit 0
+      ;;
+    --lt-*)
+        \$ECHO \"Unrecognized --lt- option: '\$lt_opt'\" 1>&2
+        exit 1
+      ;;
+    esac
+  done
+
+  # Print the debug banner immediately:
+  if test -n \"\$lt_option_debug\"; then
+    echo \"$outputname:$output:\$LINENO: libtool wrapper (GNU $PACKAGE) $VERSION\" 1>&2
+  fi
+}
+
+# Used when --lt-debug. Prints its arguments to stdout
+# (redirection is the responsibility of the caller)
+func_lt_dump_args ()
+{
+  lt_dump_args_N=1;
+  for lt_arg
+  do
+    \$ECHO \"$outputname:$output:\$LINENO: newargv[\$lt_dump_args_N]: \$lt_arg\"
+    lt_dump_args_N=\`expr \$lt_dump_args_N + 1\`
+  done
+}
+
+# Core function for launching the target application
+func_exec_program_core ()
+{
+"
+  case $host in
+  # Backslashes separate directories on plain windows
+  *-*-mingw | *-*-os2* | *-cegcc*)
+    $ECHO "\
+      if test -n \"\$lt_option_debug\"; then
+        \$ECHO \"$outputname:$output:\$LINENO: newargv[0]: \$progdir\\\\\$program\" 1>&2
+        func_lt_dump_args \${1+\"\$@\"} 1>&2
+      fi
+      exec \"\$progdir\\\\\$program\" \${1+\"\$@\"}
+"
+    ;;
+
+  *)
+    $ECHO "\
+      if test -n \"\$lt_option_debug\"; then
+        \$ECHO \"$outputname:$output:\$LINENO: newargv[0]: \$progdir/\$program\" 1>&2
+        func_lt_dump_args \${1+\"\$@\"} 1>&2
+      fi
+      exec \"\$progdir/\$program\" \${1+\"\$@\"}
+"
+    ;;
+  esac
+  $ECHO "\
+      \$ECHO \"\$0: cannot exec \$program \$*\" 1>&2
+      exit 1
+}
+
+# A function to encapsulate launching the target application
+# Strips options in the --lt-* namespace from \$@ and
+# launches target application with the remaining arguments.
+func_exec_program ()
+{
+  case \" \$* \" in
+  *\\ --lt-*)
+    for lt_wr_arg
+    do
+      case \$lt_wr_arg in
+      --lt-*) ;;
+      *) set x \"\$@\" \"\$lt_wr_arg\"; shift;;
+      esac
+      shift
+    done ;;
+  esac
+  func_exec_program_core \${1+\"\$@\"}
+}
+
+  # Parse options
+  func_parse_lt_options \"\$0\" \${1+\"\$@\"}
+
+  # Find the directory that this script lives in.
+  thisdir=\`\$ECHO \"\$file\" | $SED 's%/[^/]*$%%'\`
+  test \"x\$thisdir\" = \"x\$file\" && thisdir=.
+
+  # Follow symbolic links until we get to the real thisdir.
+  file=\`ls -ld \"\$file\" | $SED -n 's/.*-> //p'\`
+  while test -n \"\$file\"; do
+    destdir=\`\$ECHO \"\$file\" | $SED 's%/[^/]*\$%%'\`
+
+    # If there was a directory component, then change thisdir.
+    if test \"x\$destdir\" != \"x\$file\"; then
+      case \"\$destdir\" in
+      [\\\\/]* | [A-Za-z]:[\\\\/]*) thisdir=\"\$destdir\" ;;
+      *) thisdir=\"\$thisdir/\$destdir\" ;;
+      esac
+    fi
+
+    file=\`\$ECHO \"\$file\" | $SED 's%^.*/%%'\`
+    file=\`ls -ld \"\$thisdir/\$file\" | $SED -n 's/.*-> //p'\`
+  done
+
+  # Usually 'no', except on cygwin/mingw when embedded into
+  # the cwrapper.
+  WRAPPER_SCRIPT_BELONGS_IN_OBJDIR=$func_emit_wrapper_arg1
+  if test \"\$WRAPPER_SCRIPT_BELONGS_IN_OBJDIR\" = \"yes\"; then
+    # special case for '.'
+    if test \"\$thisdir\" = \".\"; then
+      thisdir=\`pwd\`
+    fi
+    # remove .libs from thisdir
+    case \"\$thisdir\" in
+    *[\\\\/]$objdir ) thisdir=\`\$ECHO \"\$thisdir\" | $SED 's%[\\\\/][^\\\\/]*$%%'\` ;;
+    $objdir )   thisdir=. ;;
+    esac
+  fi
+
+  # Try to get the absolute directory name.
+  absdir=\`cd \"\$thisdir\" && pwd\`
+  test -n \"\$absdir\" && thisdir=\"\$absdir\"
+"
+
+	if test yes = "$fast_install"; then
+	  $ECHO "\
+  program=lt-'$outputname'$exeext
+  progdir=\"\$thisdir/$objdir\"
+
+  if test ! -f \"\$progdir/\$program\" ||
+     { file=\`ls -1dt \"\$progdir/\$program\" \"\$progdir/../\$program\" 2>/dev/null | $SED 1q\`; \\
+       test \"X\$file\" != \"X\$progdir/\$program\"; }; then
+
+    file=\"\$\$-\$program\"
+
+    if test ! -d \"\$progdir\"; then
+      $MKDIR \"\$progdir\"
+    else
+      $RM \"\$progdir/\$file\"
+    fi"
+
+	  $ECHO "\
+
+    # relink executable if necessary
+    if test -n \"\$relink_command\"; then
+      if relink_command_output=\`eval \$relink_command 2>&1\`; then :
+      else
+	\$ECHO \"\$relink_command_output\" >&2
+	$RM \"\$progdir/\$file\"
+	exit 1
+      fi
+    fi
+
+    $MV \"\$progdir/\$file\" \"\$progdir/\$program\" 2>/dev/null ||
+    { $RM \"\$progdir/\$program\";
+      $MV \"\$progdir/\$file\" \"\$progdir/\$program\"; }
+    $RM \"\$progdir/\$file\"
+  fi"
+	else
+	  $ECHO "\
+  program='$outputname'
+  progdir=\"\$thisdir/$objdir\"
+"
+	fi
+
+	$ECHO "\
+
+  if test -f \"\$progdir/\$program\"; then"
+
+	# fixup the dll searchpath if we need to.
+	#
+	# Fix the DLL searchpath if we need to.  Do this before prepending
+	# to shlibpath, because on Windows, both are PATH and uninstalled
+	# libraries must come first.
+	if test -n "$dllsearchpath"; then
+	  $ECHO "\
+    # Add the dll search path components to the executable PATH
+    PATH=$dllsearchpath:\$PATH
+"
+	fi
+
+	# Export our shlibpath_var if we have one.
+	if test yes = "$shlibpath_overrides_runpath" && test -n "$shlibpath_var" && test -n "$temp_rpath"; then
+	  $ECHO "\
+    # Add our own library path to $shlibpath_var
+    $shlibpath_var=\"$temp_rpath\$$shlibpath_var\"
+
+    # Some systems cannot cope with colon-terminated $shlibpath_var
+    # The second colon is a workaround for a bug in BeOS R4 sed
+    $shlibpath_var=\`\$ECHO \"\$$shlibpath_var\" | $SED 's/::*\$//'\`
+
+    export $shlibpath_var
+"
+	fi
+
+	$ECHO "\
+    if test \"\$libtool_execute_magic\" != \"$magic\"; then
+      # Run the actual program with our arguments.
+      func_exec_program \${1+\"\$@\"}
+    fi
+  else
+    # The program doesn't exist.
+    \$ECHO \"\$0: error: '\$progdir/\$program' does not exist\" 1>&2
+    \$ECHO \"This script is just a wrapper for \$program.\" 1>&2
+    \$ECHO \"See the $PACKAGE documentation for more information.\" 1>&2
+    exit 1
+  fi
+fi\
+"
+}
+
+
+# func_emit_cwrapperexe_src
+# emit the source code for a wrapper executable on stdout
+# Must ONLY be called from within func_mode_link because
+# it depends on a number of variable set therein.
+func_emit_cwrapperexe_src ()
+{
+	cat <
+#include 
+#ifdef _MSC_VER
+# include 
+# include 
+# include 
+#else
+# include 
+# include 
+# ifdef __CYGWIN__
+#  include 
+# endif
+#endif
+#include 
+#include 
+#include 
+#include 
+#include 
+#include 
+#include 
+#include 
+
+#define STREQ(s1, s2) (strcmp ((s1), (s2)) == 0)
+
+/* declarations of non-ANSI functions */
+#if defined __MINGW32__
+# ifdef __STRICT_ANSI__
+int _putenv (const char *);
+# endif
+#elif defined __CYGWIN__
+# ifdef __STRICT_ANSI__
+char *realpath (const char *, char *);
+int putenv (char *);
+int setenv (const char *, const char *, int);
+# endif
+/* #elif defined other_platform || defined ... */
+#endif
+
+/* portability defines, excluding path handling macros */
+#if defined _MSC_VER
+# define setmode _setmode
+# define stat    _stat
+# define chmod   _chmod
+# define getcwd  _getcwd
+# define putenv  _putenv
+# define S_IXUSR _S_IEXEC
+#elif defined __MINGW32__
+# define setmode _setmode
+# define stat    _stat
+# define chmod   _chmod
+# define getcwd  _getcwd
+# define putenv  _putenv
+#elif defined __CYGWIN__
+# define HAVE_SETENV
+# define FOPEN_WB "wb"
+/* #elif defined other platforms ... */
+#endif
+
+#if defined PATH_MAX
+# define LT_PATHMAX PATH_MAX
+#elif defined MAXPATHLEN
+# define LT_PATHMAX MAXPATHLEN
+#else
+# define LT_PATHMAX 1024
+#endif
+
+#ifndef S_IXOTH
+# define S_IXOTH 0
+#endif
+#ifndef S_IXGRP
+# define S_IXGRP 0
+#endif
+
+/* path handling portability macros */
+#ifndef DIR_SEPARATOR
+# define DIR_SEPARATOR '/'
+# define PATH_SEPARATOR ':'
+#endif
+
+#if defined _WIN32 || defined __MSDOS__ || defined __DJGPP__ || \
+  defined __OS2__
+# define HAVE_DOS_BASED_FILE_SYSTEM
+# define FOPEN_WB "wb"
+# ifndef DIR_SEPARATOR_2
+#  define DIR_SEPARATOR_2 '\\'
+# endif
+# ifndef PATH_SEPARATOR_2
+#  define PATH_SEPARATOR_2 ';'
+# endif
+#endif
+
+#ifndef DIR_SEPARATOR_2
+# define IS_DIR_SEPARATOR(ch) ((ch) == DIR_SEPARATOR)
+#else /* DIR_SEPARATOR_2 */
+# define IS_DIR_SEPARATOR(ch) \
+	(((ch) == DIR_SEPARATOR) || ((ch) == DIR_SEPARATOR_2))
+#endif /* DIR_SEPARATOR_2 */
+
+#ifndef PATH_SEPARATOR_2
+# define IS_PATH_SEPARATOR(ch) ((ch) == PATH_SEPARATOR)
+#else /* PATH_SEPARATOR_2 */
+# define IS_PATH_SEPARATOR(ch) ((ch) == PATH_SEPARATOR_2)
+#endif /* PATH_SEPARATOR_2 */
+
+#ifndef FOPEN_WB
+# define FOPEN_WB "w"
+#endif
+#ifndef _O_BINARY
+# define _O_BINARY 0
+#endif
+
+#define XMALLOC(type, num)      ((type *) xmalloc ((num) * sizeof(type)))
+#define XFREE(stale) do { \
+  if (stale) { free (stale); stale = 0; } \
+} while (0)
+
+#if defined LT_DEBUGWRAPPER
+static int lt_debug = 1;
+#else
+static int lt_debug = 0;
+#endif
+
+const char *program_name = "libtool-wrapper"; /* in case xstrdup fails */
+
+void *xmalloc (size_t num);
+char *xstrdup (const char *string);
+const char *base_name (const char *name);
+char *find_executable (const char *wrapper);
+char *chase_symlinks (const char *pathspec);
+int make_executable (const char *path);
+int check_executable (const char *path);
+char *strendzap (char *str, const char *pat);
+void lt_debugprintf (const char *file, int line, const char *fmt, ...);
+void lt_fatal (const char *file, int line, const char *message, ...);
+static const char *nonnull (const char *s);
+static const char *nonempty (const char *s);
+void lt_setenv (const char *name, const char *value);
+char *lt_extend_str (const char *orig_value, const char *add, int to_end);
+void lt_update_exe_path (const char *name, const char *value);
+void lt_update_lib_path (const char *name, const char *value);
+char **prepare_spawn (char **argv);
+void lt_dump_script (FILE *f);
+EOF
+
+	    cat <= 0)
+      && (st.st_mode & (S_IXUSR | S_IXGRP | S_IXOTH)))
+    return 1;
+  else
+    return 0;
+}
+
+int
+make_executable (const char *path)
+{
+  int rval = 0;
+  struct stat st;
+
+  lt_debugprintf (__FILE__, __LINE__, "(make_executable): %s\n",
+                  nonempty (path));
+  if ((!path) || (!*path))
+    return 0;
+
+  if (stat (path, &st) >= 0)
+    {
+      rval = chmod (path, st.st_mode | S_IXOTH | S_IXGRP | S_IXUSR);
+    }
+  return rval;
+}
+
+/* Searches for the full path of the wrapper.  Returns
+   newly allocated full path name if found, NULL otherwise
+   Does not chase symlinks, even on platforms that support them.
+*/
+char *
+find_executable (const char *wrapper)
+{
+  int has_slash = 0;
+  const char *p;
+  const char *p_next;
+  /* static buffer for getcwd */
+  char tmp[LT_PATHMAX + 1];
+  size_t tmp_len;
+  char *concat_name;
+
+  lt_debugprintf (__FILE__, __LINE__, "(find_executable): %s\n",
+                  nonempty (wrapper));
+
+  if ((wrapper == NULL) || (*wrapper == '\0'))
+    return NULL;
+
+  /* Absolute path? */
+#if defined HAVE_DOS_BASED_FILE_SYSTEM
+  if (isalpha ((unsigned char) wrapper[0]) && wrapper[1] == ':')
+    {
+      concat_name = xstrdup (wrapper);
+      if (check_executable (concat_name))
+	return concat_name;
+      XFREE (concat_name);
+    }
+  else
+    {
+#endif
+      if (IS_DIR_SEPARATOR (wrapper[0]))
+	{
+	  concat_name = xstrdup (wrapper);
+	  if (check_executable (concat_name))
+	    return concat_name;
+	  XFREE (concat_name);
+	}
+#if defined HAVE_DOS_BASED_FILE_SYSTEM
+    }
+#endif
+
+  for (p = wrapper; *p; p++)
+    if (*p == '/')
+      {
+	has_slash = 1;
+	break;
+      }
+  if (!has_slash)
+    {
+      /* no slashes; search PATH */
+      const char *path = getenv ("PATH");
+      if (path != NULL)
+	{
+	  for (p = path; *p; p = p_next)
+	    {
+	      const char *q;
+	      size_t p_len;
+	      for (q = p; *q; q++)
+		if (IS_PATH_SEPARATOR (*q))
+		  break;
+	      p_len = (size_t) (q - p);
+	      p_next = (*q == '\0' ? q : q + 1);
+	      if (p_len == 0)
+		{
+		  /* empty path: current directory */
+		  if (getcwd (tmp, LT_PATHMAX) == NULL)
+		    lt_fatal (__FILE__, __LINE__, "getcwd failed: %s",
+                              nonnull (strerror (errno)));
+		  tmp_len = strlen (tmp);
+		  concat_name =
+		    XMALLOC (char, tmp_len + 1 + strlen (wrapper) + 1);
+		  memcpy (concat_name, tmp, tmp_len);
+		  concat_name[tmp_len] = '/';
+		  strcpy (concat_name + tmp_len + 1, wrapper);
+		}
+	      else
+		{
+		  concat_name =
+		    XMALLOC (char, p_len + 1 + strlen (wrapper) + 1);
+		  memcpy (concat_name, p, p_len);
+		  concat_name[p_len] = '/';
+		  strcpy (concat_name + p_len + 1, wrapper);
+		}
+	      if (check_executable (concat_name))
+		return concat_name;
+	      XFREE (concat_name);
+	    }
+	}
+      /* not found in PATH; assume curdir */
+    }
+  /* Relative path | not found in path: prepend cwd */
+  if (getcwd (tmp, LT_PATHMAX) == NULL)
+    lt_fatal (__FILE__, __LINE__, "getcwd failed: %s",
+              nonnull (strerror (errno)));
+  tmp_len = strlen (tmp);
+  concat_name = XMALLOC (char, tmp_len + 1 + strlen (wrapper) + 1);
+  memcpy (concat_name, tmp, tmp_len);
+  concat_name[tmp_len] = '/';
+  strcpy (concat_name + tmp_len + 1, wrapper);
+
+  if (check_executable (concat_name))
+    return concat_name;
+  XFREE (concat_name);
+  return NULL;
+}
+
+char *
+chase_symlinks (const char *pathspec)
+{
+#ifndef S_ISLNK
+  return xstrdup (pathspec);
+#else
+  char buf[LT_PATHMAX];
+  struct stat s;
+  char *tmp_pathspec = xstrdup (pathspec);
+  char *p;
+  int has_symlinks = 0;
+  while (strlen (tmp_pathspec) && !has_symlinks)
+    {
+      lt_debugprintf (__FILE__, __LINE__,
+		      "checking path component for symlinks: %s\n",
+		      tmp_pathspec);
+      if (lstat (tmp_pathspec, &s) == 0)
+	{
+	  if (S_ISLNK (s.st_mode) != 0)
+	    {
+	      has_symlinks = 1;
+	      break;
+	    }
+
+	  /* search backwards for last DIR_SEPARATOR */
+	  p = tmp_pathspec + strlen (tmp_pathspec) - 1;
+	  while ((p > tmp_pathspec) && (!IS_DIR_SEPARATOR (*p)))
+	    p--;
+	  if ((p == tmp_pathspec) && (!IS_DIR_SEPARATOR (*p)))
+	    {
+	      /* no more DIR_SEPARATORS left */
+	      break;
+	    }
+	  *p = '\0';
+	}
+      else
+	{
+	  lt_fatal (__FILE__, __LINE__,
+		    "error accessing file \"%s\": %s",
+		    tmp_pathspec, nonnull (strerror (errno)));
+	}
+    }
+  XFREE (tmp_pathspec);
+
+  if (!has_symlinks)
+    {
+      return xstrdup (pathspec);
+    }
+
+  tmp_pathspec = realpath (pathspec, buf);
+  if (tmp_pathspec == 0)
+    {
+      lt_fatal (__FILE__, __LINE__,
+		"could not follow symlinks for %s", pathspec);
+    }
+  return xstrdup (tmp_pathspec);
+#endif
+}
+
+char *
+strendzap (char *str, const char *pat)
+{
+  size_t len, patlen;
+
+  assert (str != NULL);
+  assert (pat != NULL);
+
+  len = strlen (str);
+  patlen = strlen (pat);
+
+  if (patlen <= len)
+    {
+      str += len - patlen;
+      if (STREQ (str, pat))
+	*str = '\0';
+    }
+  return str;
+}
+
+void
+lt_debugprintf (const char *file, int line, const char *fmt, ...)
+{
+  va_list args;
+  if (lt_debug)
+    {
+      (void) fprintf (stderr, "%s:%s:%d: ", program_name, file, line);
+      va_start (args, fmt);
+      (void) vfprintf (stderr, fmt, args);
+      va_end (args);
+    }
+}
+
+static void
+lt_error_core (int exit_status, const char *file,
+	       int line, const char *mode,
+	       const char *message, va_list ap)
+{
+  fprintf (stderr, "%s:%s:%d: %s: ", program_name, file, line, mode);
+  vfprintf (stderr, message, ap);
+  fprintf (stderr, ".\n");
+
+  if (exit_status >= 0)
+    exit (exit_status);
+}
+
+void
+lt_fatal (const char *file, int line, const char *message, ...)
+{
+  va_list ap;
+  va_start (ap, message);
+  lt_error_core (EXIT_FAILURE, file, line, "FATAL", message, ap);
+  va_end (ap);
+}
+
+static const char *
+nonnull (const char *s)
+{
+  return s ? s : "(null)";
+}
+
+static const char *
+nonempty (const char *s)
+{
+  return (s && !*s) ? "(empty)" : nonnull (s);
+}
+
+void
+lt_setenv (const char *name, const char *value)
+{
+  lt_debugprintf (__FILE__, __LINE__,
+		  "(lt_setenv) setting '%s' to '%s'\n",
+                  nonnull (name), nonnull (value));
+  {
+#ifdef HAVE_SETENV
+    /* always make a copy, for consistency with !HAVE_SETENV */
+    char *str = xstrdup (value);
+    setenv (name, str, 1);
+#else
+    size_t len = strlen (name) + 1 + strlen (value) + 1;
+    char *str = XMALLOC (char, len);
+    sprintf (str, "%s=%s", name, value);
+    if (putenv (str) != EXIT_SUCCESS)
+      {
+        XFREE (str);
+      }
+#endif
+  }
+}
+
+char *
+lt_extend_str (const char *orig_value, const char *add, int to_end)
+{
+  char *new_value;
+  if (orig_value && *orig_value)
+    {
+      size_t orig_value_len = strlen (orig_value);
+      size_t add_len = strlen (add);
+      new_value = XMALLOC (char, add_len + orig_value_len + 1);
+      if (to_end)
+        {
+          strcpy (new_value, orig_value);
+          strcpy (new_value + orig_value_len, add);
+        }
+      else
+        {
+          strcpy (new_value, add);
+          strcpy (new_value + add_len, orig_value);
+        }
+    }
+  else
+    {
+      new_value = xstrdup (add);
+    }
+  return new_value;
+}
+
+void
+lt_update_exe_path (const char *name, const char *value)
+{
+  lt_debugprintf (__FILE__, __LINE__,
+		  "(lt_update_exe_path) modifying '%s' by prepending '%s'\n",
+                  nonnull (name), nonnull (value));
+
+  if (name && *name && value && *value)
+    {
+      char *new_value = lt_extend_str (getenv (name), value, 0);
+      /* some systems can't cope with a ':'-terminated path #' */
+      size_t len = strlen (new_value);
+      while ((len > 0) && IS_PATH_SEPARATOR (new_value[len-1]))
+        {
+          new_value[--len] = '\0';
+        }
+      lt_setenv (name, new_value);
+      XFREE (new_value);
+    }
+}
+
+void
+lt_update_lib_path (const char *name, const char *value)
+{
+  lt_debugprintf (__FILE__, __LINE__,
+		  "(lt_update_lib_path) modifying '%s' by prepending '%s'\n",
+                  nonnull (name), nonnull (value));
+
+  if (name && *name && value && *value)
+    {
+      char *new_value = lt_extend_str (getenv (name), value, 0);
+      lt_setenv (name, new_value);
+      XFREE (new_value);
+    }
+}
+
+EOF
+	    case $host_os in
+	      mingw*)
+		cat <<"EOF"
+
+/* Prepares an argument vector before calling spawn().
+   Note that spawn() does not by itself call the command interpreter
+     (getenv ("COMSPEC") != NULL ? getenv ("COMSPEC") :
+      ({ OSVERSIONINFO v; v.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+         GetVersionEx(&v);
+         v.dwPlatformId == VER_PLATFORM_WIN32_NT;
+      }) ? "cmd.exe" : "command.com").
+   Instead it simply concatenates the arguments, separated by ' ', and calls
+   CreateProcess().  We must quote the arguments since Win32 CreateProcess()
+   interprets characters like ' ', '\t', '\\', '"' (but not '<' and '>') in a
+   special way:
+   - Space and tab are interpreted as delimiters. They are not treated as
+     delimiters if they are surrounded by double quotes: "...".
+   - Unescaped double quotes are removed from the input. Their only effect is
+     that within double quotes, space and tab are treated like normal
+     characters.
+   - Backslashes not followed by double quotes are not special.
+   - But 2*n+1 backslashes followed by a double quote become
+     n backslashes followed by a double quote (n >= 0):
+       \" -> "
+       \\\" -> \"
+       \\\\\" -> \\"
+ */
+#define SHELL_SPECIAL_CHARS "\"\\ \001\002\003\004\005\006\007\010\011\012\013\014\015\016\017\020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037"
+#define SHELL_SPACE_CHARS " \001\002\003\004\005\006\007\010\011\012\013\014\015\016\017\020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037"
+char **
+prepare_spawn (char **argv)
+{
+  size_t argc;
+  char **new_argv;
+  size_t i;
+
+  /* Count number of arguments.  */
+  for (argc = 0; argv[argc] != NULL; argc++)
+    ;
+
+  /* Allocate new argument vector.  */
+  new_argv = XMALLOC (char *, argc + 1);
+
+  /* Put quoted arguments into the new argument vector.  */
+  for (i = 0; i < argc; i++)
+    {
+      const char *string = argv[i];
+
+      if (string[0] == '\0')
+	new_argv[i] = xstrdup ("\"\"");
+      else if (strpbrk (string, SHELL_SPECIAL_CHARS) != NULL)
+	{
+	  int quote_around = (strpbrk (string, SHELL_SPACE_CHARS) != NULL);
+	  size_t length;
+	  unsigned int backslashes;
+	  const char *s;
+	  char *quoted_string;
+	  char *p;
+
+	  length = 0;
+	  backslashes = 0;
+	  if (quote_around)
+	    length++;
+	  for (s = string; *s != '\0'; s++)
+	    {
+	      char c = *s;
+	      if (c == '"')
+		length += backslashes + 1;
+	      length++;
+	      if (c == '\\')
+		backslashes++;
+	      else
+		backslashes = 0;
+	    }
+	  if (quote_around)
+	    length += backslashes + 1;
+
+	  quoted_string = XMALLOC (char, length + 1);
+
+	  p = quoted_string;
+	  backslashes = 0;
+	  if (quote_around)
+	    *p++ = '"';
+	  for (s = string; *s != '\0'; s++)
+	    {
+	      char c = *s;
+	      if (c == '"')
+		{
+		  unsigned int j;
+		  for (j = backslashes + 1; j > 0; j--)
+		    *p++ = '\\';
+		}
+	      *p++ = c;
+	      if (c == '\\')
+		backslashes++;
+	      else
+		backslashes = 0;
+	    }
+	  if (quote_around)
+	    {
+	      unsigned int j;
+	      for (j = backslashes; j > 0; j--)
+		*p++ = '\\';
+	      *p++ = '"';
+	    }
+	  *p = '\0';
+
+	  new_argv[i] = quoted_string;
+	}
+      else
+	new_argv[i] = (char *) string;
+    }
+  new_argv[argc] = NULL;
+
+  return new_argv;
+}
+EOF
+		;;
+	    esac
+
+            cat <<"EOF"
+void lt_dump_script (FILE* f)
+{
+EOF
+	    func_emit_wrapper yes |
+	      $SED -n -e '
+s/^\(.\{79\}\)\(..*\)/\1\
+\2/
+h
+s/\([\\"]\)/\\\1/g
+s/$/\\n/
+s/\([^\n]*\).*/  fputs ("\1", f);/p
+g
+D'
+            cat <<"EOF"
+}
+EOF
+}
+# end: func_emit_cwrapperexe_src
+
+# func_win32_import_lib_p ARG
+# True if ARG is an import lib, as indicated by $file_magic_cmd
+func_win32_import_lib_p ()
+{
+    $debug_cmd
+
+    case `eval $file_magic_cmd \"\$1\" 2>/dev/null | $SED -e 10q` in
+    *import*) : ;;
+    *) false ;;
+    esac
+}
+
+# func_suncc_cstd_abi
+# !!ONLY CALL THIS FOR SUN CC AFTER $compile_command IS FULLY EXPANDED!!
+# Several compiler flags select an ABI that is incompatible with the
+# Cstd library. Avoid specifying it if any are in CXXFLAGS.
+func_suncc_cstd_abi ()
+{
+    $debug_cmd
+
+    case " $compile_command " in
+    *" -compat=g "*|*\ -std=c++[0-9][0-9]\ *|*" -library=stdcxx4 "*|*" -library=stlport4 "*)
+      suncc_use_cstd_abi=no
+      ;;
+    *)
+      suncc_use_cstd_abi=yes
+      ;;
+    esac
+}
+
+# func_mode_link arg...
+func_mode_link ()
+{
+    $debug_cmd
+
+    case $host in
+    *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-cegcc*)
+      # It is impossible to link a dll without this setting, and
+      # we shouldn't force the makefile maintainer to figure out
+      # what system we are compiling for in order to pass an extra
+      # flag for every libtool invocation.
+      # allow_undefined=no
+
+      # FIXME: Unfortunately, there are problems with the above when trying
+      # to make a dll that has undefined symbols, in which case not
+      # even a static library is built.  For now, we need to specify
+      # -no-undefined on the libtool link line when we can be certain
+      # that all symbols are satisfied, otherwise we get a static library.
+      allow_undefined=yes
+      ;;
+    *)
+      allow_undefined=yes
+      ;;
+    esac
+    libtool_args=$nonopt
+    base_compile="$nonopt $@"
+    compile_command=$nonopt
+    finalize_command=$nonopt
+
+    compile_rpath=
+    finalize_rpath=
+    compile_shlibpath=
+    finalize_shlibpath=
+    convenience=
+    old_convenience=
+    deplibs=
+    old_deplibs=
+    compiler_flags=
+    linker_flags=
+    dllsearchpath=
+    lib_search_path=`pwd`
+    inst_prefix_dir=
+    new_inherited_linker_flags=
+
+    avoid_version=no
+    bindir=
+    dlfiles=
+    dlprefiles=
+    dlself=no
+    export_dynamic=no
+    export_symbols=
+    export_symbols_regex=
+    generated=
+    libobjs=
+    ltlibs=
+    module=no
+    no_install=no
+    objs=
+    os2dllname=
+    non_pic_objects=
+    precious_files_regex=
+    prefer_static_libs=no
+    preload=false
+    prev=
+    prevarg=
+    release=
+    rpath=
+    xrpath=
+    perm_rpath=
+    temp_rpath=
+    thread_safe=no
+    vinfo=
+    vinfo_number=no
+    weak_libs=
+    single_module=$wl-single_module
+    func_infer_tag $base_compile
+
+    # We need to know -static, to get the right output filenames.
+    for arg
+    do
+      case $arg in
+      -shared)
+	test yes != "$build_libtool_libs" \
+	  && func_fatal_configuration "cannot build a shared library"
+	build_old_libs=no
+	break
+	;;
+      -all-static | -static | -static-libtool-libs)
+	case $arg in
+	-all-static)
+	  if test yes = "$build_libtool_libs" && test -z "$link_static_flag"; then
+	    func_warning "complete static linking is impossible in this configuration"
+	  fi
+	  if test -n "$link_static_flag"; then
+	    dlopen_self=$dlopen_self_static
+	  fi
+	  prefer_static_libs=yes
+	  ;;
+	-static)
+	  if test -z "$pic_flag" && test -n "$link_static_flag"; then
+	    dlopen_self=$dlopen_self_static
+	  fi
+	  prefer_static_libs=built
+	  ;;
+	-static-libtool-libs)
+	  if test -z "$pic_flag" && test -n "$link_static_flag"; then
+	    dlopen_self=$dlopen_self_static
+	  fi
+	  prefer_static_libs=yes
+	  ;;
+	esac
+	build_libtool_libs=no
+	build_old_libs=yes
+	break
+	;;
+      esac
+    done
+
+    # See if our shared archives depend on static archives.
+    test -n "$old_archive_from_new_cmds" && build_old_libs=yes
+
+    # Go through the arguments, transforming them on the way.
+    while test "$#" -gt 0; do
+      arg=$1
+      shift
+      func_quote_arg pretty,unquoted "$arg"
+      qarg=$func_quote_arg_unquoted_result
+      func_append libtool_args " $func_quote_arg_result"
+
+      # If the previous option needs an argument, assign it.
+      if test -n "$prev"; then
+	case $prev in
+	output)
+	  func_append compile_command " @OUTPUT@"
+	  func_append finalize_command " @OUTPUT@"
+	  ;;
+	esac
+
+	case $prev in
+	bindir)
+	  bindir=$arg
+	  prev=
+	  continue
+	  ;;
+	dlfiles|dlprefiles)
+	  $preload || {
+	    # Add the symbol object into the linking commands.
+	    func_append compile_command " @SYMFILE@"
+	    func_append finalize_command " @SYMFILE@"
+	    preload=:
+	  }
+	  case $arg in
+	  *.la | *.lo) ;;  # We handle these cases below.
+	  force)
+	    if test no = "$dlself"; then
+	      dlself=needless
+	      export_dynamic=yes
+	    fi
+	    prev=
+	    continue
+	    ;;
+	  self)
+	    if test dlprefiles = "$prev"; then
+	      dlself=yes
+	    elif test dlfiles = "$prev" && test yes != "$dlopen_self"; then
+	      dlself=yes
+	    else
+	      dlself=needless
+	      export_dynamic=yes
+	    fi
+	    prev=
+	    continue
+	    ;;
+	  *)
+	    if test dlfiles = "$prev"; then
+	      func_append dlfiles " $arg"
+	    else
+	      func_append dlprefiles " $arg"
+	    fi
+	    prev=
+	    continue
+	    ;;
+	  esac
+	  ;;
+	expsyms)
+	  export_symbols=$arg
+	  test -f "$arg" \
+	    || func_fatal_error "symbol file '$arg' does not exist"
+	  prev=
+	  continue
+	  ;;
+	expsyms_regex)
+	  export_symbols_regex=$arg
+	  prev=
+	  continue
+	  ;;
+	framework)
+	  case $host in
+	    *-*-darwin*)
+	      case "$deplibs " in
+		*" $qarg.ltframework "*) ;;
+		*) func_append deplibs " $qarg.ltframework" # this is fixed later
+		   ;;
+	      esac
+	      ;;
+	  esac
+	  prev=
+	  continue
+	  ;;
+	inst_prefix)
+	  inst_prefix_dir=$arg
+	  prev=
+	  continue
+	  ;;
+	mllvm)
+	  # Clang does not use LLVM to link, so we can simply discard any
+	  # '-mllvm $arg' options when doing the link step.
+	  prev=
+	  continue
+	  ;;
+	objectlist)
+	  if test -f "$arg"; then
+	    save_arg=$arg
+	    moreargs=
+	    for fil in `cat "$save_arg"`
+	    do
+#	      func_append moreargs " $fil"
+	      arg=$fil
+	      # A libtool-controlled object.
+
+	      # Check to see that this really is a libtool object.
+	      if func_lalib_unsafe_p "$arg"; then
+		pic_object=
+		non_pic_object=
+
+		# Read the .lo file
+		func_source "$arg"
+
+		if test -z "$pic_object" ||
+		   test -z "$non_pic_object" ||
+		   test none = "$pic_object" &&
+		   test none = "$non_pic_object"; then
+		  func_fatal_error "cannot find name of object for '$arg'"
+		fi
+
+		# Extract subdirectory from the argument.
+		func_dirname "$arg" "/" ""
+		xdir=$func_dirname_result
+
+		if test none != "$pic_object"; then
+		  # Prepend the subdirectory the object is found in.
+		  pic_object=$xdir$pic_object
+
+		  if test dlfiles = "$prev"; then
+		    if test yes = "$build_libtool_libs" && test yes = "$dlopen_support"; then
+		      func_append dlfiles " $pic_object"
+		      prev=
+		      continue
+		    else
+		      # If libtool objects are unsupported, then we need to preload.
+		      prev=dlprefiles
+		    fi
+		  fi
+
+		  # CHECK ME:  I think I busted this.  -Ossama
+		  if test dlprefiles = "$prev"; then
+		    # Preload the old-style object.
+		    func_append dlprefiles " $pic_object"
+		    prev=
+		  fi
+
+		  # A PIC object.
+		  func_append libobjs " $pic_object"
+		  arg=$pic_object
+		fi
+
+		# Non-PIC object.
+		if test none != "$non_pic_object"; then
+		  # Prepend the subdirectory the object is found in.
+		  non_pic_object=$xdir$non_pic_object
+
+		  # A standard non-PIC object
+		  func_append non_pic_objects " $non_pic_object"
+		  if test -z "$pic_object" || test none = "$pic_object"; then
+		    arg=$non_pic_object
+		  fi
+		else
+		  # If the PIC object exists, use it instead.
+		  # $xdir was prepended to $pic_object above.
+		  non_pic_object=$pic_object
+		  func_append non_pic_objects " $non_pic_object"
+		fi
+	      else
+		# Only an error if not doing a dry-run.
+		if $opt_dry_run; then
+		  # Extract subdirectory from the argument.
+		  func_dirname "$arg" "/" ""
+		  xdir=$func_dirname_result
+
+		  func_lo2o "$arg"
+		  pic_object=$xdir$objdir/$func_lo2o_result
+		  non_pic_object=$xdir$func_lo2o_result
+		  func_append libobjs " $pic_object"
+		  func_append non_pic_objects " $non_pic_object"
+	        else
+		  func_fatal_error "'$arg' is not a valid libtool object"
+		fi
+	      fi
+	    done
+	  else
+	    func_fatal_error "link input file '$arg' does not exist"
+	  fi
+	  arg=$save_arg
+	  prev=
+	  continue
+	  ;;
+	os2dllname)
+	  os2dllname=$arg
+	  prev=
+	  continue
+	  ;;
+	precious_regex)
+	  precious_files_regex=$arg
+	  prev=
+	  continue
+	  ;;
+	release)
+	  release=-$arg
+	  prev=
+	  continue
+	  ;;
+	rpath | xrpath)
+	  # We need an absolute path.
+	  case $arg in
+	  [\\/]* | [A-Za-z]:[\\/]*) ;;
+	  *)
+	    func_fatal_error "only absolute run-paths are allowed"
+	    ;;
+	  esac
+	  if test rpath = "$prev"; then
+	    case "$rpath " in
+	    *" $arg "*) ;;
+	    *) func_append rpath " $arg" ;;
+	    esac
+	  else
+	    case "$xrpath " in
+	    *" $arg "*) ;;
+	    *) func_append xrpath " $arg" ;;
+	    esac
+	  fi
+	  prev=
+	  continue
+	  ;;
+	shrext)
+	  shrext_cmds=$arg
+	  prev=
+	  continue
+	  ;;
+	weak)
+	  func_append weak_libs " $arg"
+	  prev=
+	  continue
+	  ;;
+	xcclinker)
+	  func_append linker_flags " $qarg"
+	  func_append compiler_flags " $qarg"
+	  prev=
+	  func_append compile_command " $qarg"
+	  func_append finalize_command " $qarg"
+	  continue
+	  ;;
+	xcompiler)
+	  func_append compiler_flags " $qarg"
+	  prev=
+	  func_append compile_command " $qarg"
+	  func_append finalize_command " $qarg"
+	  continue
+	  ;;
+	xlinker)
+	  func_append linker_flags " $qarg"
+	  func_append compiler_flags " $wl$qarg"
+	  prev=
+	  func_append compile_command " $wl$qarg"
+	  func_append finalize_command " $wl$qarg"
+	  continue
+	  ;;
+	*)
+	  eval "$prev=\"\$arg\""
+	  prev=
+	  continue
+	  ;;
+	esac
+      fi # test -n "$prev"
+
+      prevarg=$arg
+
+      case $arg in
+      -all-static)
+	if test -n "$link_static_flag"; then
+	  # See comment for -static flag below, for more details.
+	  func_append compile_command " $link_static_flag"
+	  func_append finalize_command " $link_static_flag"
+	fi
+	continue
+	;;
+
+      -allow-undefined)
+	# FIXME: remove this flag sometime in the future.
+	func_fatal_error "'-allow-undefined' must not be used because it is the default"
+	;;
+
+      -avoid-version)
+	avoid_version=yes
+	continue
+	;;
+
+      -bindir)
+	prev=bindir
+	continue
+	;;
+
+      -dlopen)
+	prev=dlfiles
+	continue
+	;;
+
+      -dlpreopen)
+	prev=dlprefiles
+	continue
+	;;
+
+      -export-dynamic)
+	export_dynamic=yes
+	continue
+	;;
+
+      -export-symbols | -export-symbols-regex)
+	if test -n "$export_symbols" || test -n "$export_symbols_regex"; then
+	  func_fatal_error "more than one -exported-symbols argument is not allowed"
+	fi
+	if test X-export-symbols = "X$arg"; then
+	  prev=expsyms
+	else
+	  prev=expsyms_regex
+	fi
+	continue
+	;;
+
+      -framework)
+	prev=framework
+	continue
+	;;
+
+      -inst-prefix-dir)
+	prev=inst_prefix
+	continue
+	;;
+
+      # The native IRIX linker understands -LANG:*, -LIST:* and -LNO:*
+      # so, if we see these flags be careful not to treat them like -L
+      -L[A-Z][A-Z]*:*)
+	case $with_gcc/$host in
+	no/*-*-irix* | /*-*-irix*)
+	  func_append compile_command " $arg"
+	  func_append finalize_command " $arg"
+	  ;;
+	esac
+	continue
+	;;
+
+      -L*)
+	func_stripname "-L" '' "$arg"
+	if test -z "$func_stripname_result"; then
+	  if test "$#" -gt 0; then
+	    func_fatal_error "require no space between '-L' and '$1'"
+	  else
+	    func_fatal_error "need path for '-L' option"
+	  fi
+	fi
+	func_resolve_sysroot "$func_stripname_result"
+	dir=$func_resolve_sysroot_result
+	# We need an absolute path.
+	case $dir in
+	[\\/]* | [A-Za-z]:[\\/]*) ;;
+	*)
+	  absdir=`cd "$dir" && pwd`
+	  test -z "$absdir" && \
+	    func_fatal_error "cannot determine absolute directory name of '$dir'"
+	  dir=$absdir
+	  ;;
+	esac
+	case "$deplibs " in
+	*" -L$dir "* | *" $arg "*)
+	  # Will only happen for absolute or sysroot arguments
+	  ;;
+	*)
+	  # Preserve sysroot, but never include relative directories
+	  case $dir in
+	    [\\/]* | [A-Za-z]:[\\/]* | =*) func_append deplibs " $arg" ;;
+	    *) func_append deplibs " -L$dir" ;;
+	  esac
+	  func_append lib_search_path " $dir"
+	  ;;
+	esac
+	case $host in
+	*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-cegcc*)
+	  testbindir=`$ECHO "$dir" | $SED 's*/lib$*/bin*'`
+	  case :$dllsearchpath: in
+	  *":$dir:"*) ;;
+	  ::) dllsearchpath=$dir;;
+	  *) func_append dllsearchpath ":$dir";;
+	  esac
+	  case :$dllsearchpath: in
+	  *":$testbindir:"*) ;;
+	  ::) dllsearchpath=$testbindir;;
+	  *) func_append dllsearchpath ":$testbindir";;
+	  esac
+	  ;;
+	esac
+	continue
+	;;
+
+      -l*)
+	if test X-lc = "X$arg" || test X-lm = "X$arg"; then
+	  case $host in
+	  *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-beos* | *-cegcc* | *-*-haiku*)
+	    # These systems don't actually have a C or math library (as such)
+	    continue
+	    ;;
+	  *-*-os2*)
+	    # These systems don't actually have a C library (as such)
+	    test X-lc = "X$arg" && continue
+	    ;;
+	  *-*-openbsd* | *-*-freebsd* | *-*-dragonfly* | *-*-bitrig*)
+	    # Do not include libc due to us having libc/libc_r.
+	    test X-lc = "X$arg" && continue
+	    ;;
+	  *-*-rhapsody* | *-*-darwin1.[012])
+	    # Rhapsody C and math libraries are in the System framework
+	    func_append deplibs " System.ltframework"
+	    continue
+	    ;;
+	  *-*-sco3.2v5* | *-*-sco5v6*)
+	    # Causes problems with __ctype
+	    test X-lc = "X$arg" && continue
+	    ;;
+	  *-*-sysv4.2uw2* | *-*-sysv5* | *-*-unixware* | *-*-OpenUNIX*)
+	    # Compiler inserts libc in the correct place for threads to work
+	    test X-lc = "X$arg" && continue
+	    ;;
+	  esac
+	elif test X-lc_r = "X$arg"; then
+	 case $host in
+	 *-*-openbsd* | *-*-freebsd* | *-*-dragonfly* | *-*-bitrig*)
+	   # Do not include libc_r directly, use -pthread flag.
+	   continue
+	   ;;
+	 esac
+	fi
+	func_append deplibs " $arg"
+	continue
+	;;
+
+      -mllvm)
+	prev=mllvm
+	continue
+	;;
+
+      -module)
+	module=yes
+	continue
+	;;
+
+      # Tru64 UNIX uses -model [arg] to determine the layout of C++
+      # classes, name mangling, and exception handling.
+      # Darwin uses the -arch flag to determine output architecture.
+      -model|-arch|-isysroot|--sysroot)
+	func_append compiler_flags " $arg"
+	func_append compile_command " $arg"
+	func_append finalize_command " $arg"
+	prev=xcompiler
+	continue
+	;;
+
+      -mt|-mthreads|-kthread|-Kthread|-pthread|-pthreads|--thread-safe \
+      |-threads|-fopenmp|-openmp|-mp|-xopenmp|-omp|-qsmp=*)
+	func_append compiler_flags " $arg"
+	func_append compile_command " $arg"
+	func_append finalize_command " $arg"
+	case "$new_inherited_linker_flags " in
+	    *" $arg "*) ;;
+	    * ) func_append new_inherited_linker_flags " $arg" ;;
+	esac
+	continue
+	;;
+
+      -multi_module)
+	single_module=$wl-multi_module
+	continue
+	;;
+
+      -no-fast-install)
+	fast_install=no
+	continue
+	;;
+
+      -no-install)
+	case $host in
+	*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-*-darwin* | *-cegcc*)
+	  # The PATH hackery in wrapper scripts is required on Windows
+	  # and Darwin in order for the loader to find any dlls it needs.
+	  func_warning "'-no-install' is ignored for $host"
+	  func_warning "assuming '-no-fast-install' instead"
+	  fast_install=no
+	  ;;
+	*) no_install=yes ;;
+	esac
+	continue
+	;;
+
+      -no-undefined)
+	allow_undefined=no
+	continue
+	;;
+
+      -objectlist)
+	prev=objectlist
+	continue
+	;;
+
+      -os2dllname)
+	prev=os2dllname
+	continue
+	;;
+
+      -o) prev=output ;;
+
+      -precious-files-regex)
+	prev=precious_regex
+	continue
+	;;
+
+      -release)
+	prev=release
+	continue
+	;;
+
+      -rpath)
+	prev=rpath
+	continue
+	;;
+
+      -R)
+	prev=xrpath
+	continue
+	;;
+
+      -R*)
+	func_stripname '-R' '' "$arg"
+	dir=$func_stripname_result
+	# We need an absolute path.
+	case $dir in
+	[\\/]* | [A-Za-z]:[\\/]*) ;;
+	=*)
+	  func_stripname '=' '' "$dir"
+	  dir=$lt_sysroot$func_stripname_result
+	  ;;
+	*)
+	  func_fatal_error "only absolute run-paths are allowed"
+	  ;;
+	esac
+	case "$xrpath " in
+	*" $dir "*) ;;
+	*) func_append xrpath " $dir" ;;
+	esac
+	continue
+	;;
+
+      -shared)
+	# The effects of -shared are defined in a previous loop.
+	continue
+	;;
+
+      -shrext)
+	prev=shrext
+	continue
+	;;
+
+      -static | -static-libtool-libs)
+	# The effects of -static are defined in a previous loop.
+	# We used to do the same as -all-static on platforms that
+	# didn't have a PIC flag, but the assumption that the effects
+	# would be equivalent was wrong.  It would break on at least
+	# Digital Unix and AIX.
+	continue
+	;;
+
+      -thread-safe)
+	thread_safe=yes
+	continue
+	;;
+
+      -version-info)
+	prev=vinfo
+	continue
+	;;
+
+      -version-number)
+	prev=vinfo
+	vinfo_number=yes
+	continue
+	;;
+
+      -weak)
+        prev=weak
+	continue
+	;;
+
+      -Wc,*)
+	func_stripname '-Wc,' '' "$arg"
+	args=$func_stripname_result
+	arg=
+	save_ifs=$IFS; IFS=,
+	for flag in $args; do
+	  IFS=$save_ifs
+          func_quote_arg pretty "$flag"
+	  func_append arg " $func_quote_arg_result"
+	  func_append compiler_flags " $func_quote_arg_result"
+	done
+	IFS=$save_ifs
+	func_stripname ' ' '' "$arg"
+	arg=$func_stripname_result
+	;;
+
+      -Wl,*)
+	func_stripname '-Wl,' '' "$arg"
+	args=$func_stripname_result
+	arg=
+	save_ifs=$IFS; IFS=,
+	for flag in $args; do
+	  IFS=$save_ifs
+          func_quote_arg pretty "$flag"
+	  func_append arg " $wl$func_quote_arg_result"
+	  func_append compiler_flags " $wl$func_quote_arg_result"
+	  func_append linker_flags " $func_quote_arg_result"
+	done
+	IFS=$save_ifs
+	func_stripname ' ' '' "$arg"
+	arg=$func_stripname_result
+	;;
+
+      -Xcompiler)
+	prev=xcompiler
+	continue
+	;;
+
+      -Xlinker)
+	prev=xlinker
+	continue
+	;;
+
+      -XCClinker)
+	prev=xcclinker
+	continue
+	;;
+
+      # -msg_* for osf cc
+      -msg_*)
+	func_quote_arg pretty "$arg"
+	arg=$func_quote_arg_result
+	;;
+
+      # Flags to be passed through unchanged, with rationale:
+      # -64, -mips[0-9]      enable 64-bit mode for the SGI compiler
+      # -r[0-9][0-9]*        specify processor for the SGI compiler
+      # -xarch=*, -xtarget=* enable 64-bit mode for the Sun compiler
+      # +DA*, +DD*           enable 64-bit mode for the HP compiler
+      # -q*                  compiler args for the IBM compiler
+      # -m*, -t[45]*, -txscale* architecture-specific flags for GCC
+      # -F/path              path to uninstalled frameworks, gcc on darwin
+      # -p, -pg, --coverage, -fprofile-*  profiling flags for GCC
+      # -fstack-protector*   stack protector flags for GCC
+      # @file                GCC response files
+      # -tp=*                Portland pgcc target processor selection
+      # --sysroot=*          for sysroot support
+      # -O*, -g*, -flto*, -fwhopr*, -fuse-linker-plugin GCC link-time optimization
+      # -specs=*             GCC specs files
+      # -stdlib=*            select c++ std lib with clang
+      # -fsanitize=*         Clang/GCC memory and address sanitizer
+      -64|-mips[0-9]|-r[0-9][0-9]*|-xarch=*|-xtarget=*|+DA*|+DD*|-q*|-m*| \
+      -t[45]*|-txscale*|-p|-pg|--coverage|-fprofile-*|-F*|@*|-tp=*|--sysroot=*| \
+      -O*|-g*|-flto*|-fwhopr*|-fuse-linker-plugin|-fstack-protector*|-stdlib=*| \
+      -specs=*|-fsanitize=*)
+        func_quote_arg pretty "$arg"
+	arg=$func_quote_arg_result
+        func_append compile_command " $arg"
+        func_append finalize_command " $arg"
+        func_append compiler_flags " $arg"
+        continue
+        ;;
+
+      -Z*)
+        if test os2 = "`expr $host : '.*\(os2\)'`"; then
+          # OS/2 uses -Zxxx to specify OS/2-specific options
+	  compiler_flags="$compiler_flags $arg"
+	  func_append compile_command " $arg"
+	  func_append finalize_command " $arg"
+	  case $arg in
+	  -Zlinker | -Zstack)
+	    prev=xcompiler
+	    ;;
+	  esac
+	  continue
+        else
+	  # Otherwise treat like 'Some other compiler flag' below
+	  func_quote_arg pretty "$arg"
+	  arg=$func_quote_arg_result
+        fi
+	;;
+
+      # Some other compiler flag.
+      -* | +*)
+        func_quote_arg pretty "$arg"
+	arg=$func_quote_arg_result
+	;;
+
+      *.$objext)
+	# A standard object.
+	func_append objs " $arg"
+	;;
+
+      *.lo)
+	# A libtool-controlled object.
+
+	# Check to see that this really is a libtool object.
+	if func_lalib_unsafe_p "$arg"; then
+	  pic_object=
+	  non_pic_object=
+
+	  # Read the .lo file
+	  func_source "$arg"
+
+	  if test -z "$pic_object" ||
+	     test -z "$non_pic_object" ||
+	     test none = "$pic_object" &&
+	     test none = "$non_pic_object"; then
+	    func_fatal_error "cannot find name of object for '$arg'"
+	  fi
+
+	  # Extract subdirectory from the argument.
+	  func_dirname "$arg" "/" ""
+	  xdir=$func_dirname_result
+
+	  test none = "$pic_object" || {
+	    # Prepend the subdirectory the object is found in.
+	    pic_object=$xdir$pic_object
+
+	    if test dlfiles = "$prev"; then
+	      if test yes = "$build_libtool_libs" && test yes = "$dlopen_support"; then
+		func_append dlfiles " $pic_object"
+		prev=
+		continue
+	      else
+		# If libtool objects are unsupported, then we need to preload.
+		prev=dlprefiles
+	      fi
+	    fi
+
+	    # CHECK ME:  I think I busted this.  -Ossama
+	    if test dlprefiles = "$prev"; then
+	      # Preload the old-style object.
+	      func_append dlprefiles " $pic_object"
+	      prev=
+	    fi
+
+	    # A PIC object.
+	    func_append libobjs " $pic_object"
+	    arg=$pic_object
+	  }
+
+	  # Non-PIC object.
+	  if test none != "$non_pic_object"; then
+	    # Prepend the subdirectory the object is found in.
+	    non_pic_object=$xdir$non_pic_object
+
+	    # A standard non-PIC object
+	    func_append non_pic_objects " $non_pic_object"
+	    if test -z "$pic_object" || test none = "$pic_object"; then
+	      arg=$non_pic_object
+	    fi
+	  else
+	    # If the PIC object exists, use it instead.
+	    # $xdir was prepended to $pic_object above.
+	    non_pic_object=$pic_object
+	    func_append non_pic_objects " $non_pic_object"
+	  fi
+	else
+	  # Only an error if not doing a dry-run.
+	  if $opt_dry_run; then
+	    # Extract subdirectory from the argument.
+	    func_dirname "$arg" "/" ""
+	    xdir=$func_dirname_result
+
+	    func_lo2o "$arg"
+	    pic_object=$xdir$objdir/$func_lo2o_result
+	    non_pic_object=$xdir$func_lo2o_result
+	    func_append libobjs " $pic_object"
+	    func_append non_pic_objects " $non_pic_object"
+	  else
+	    func_fatal_error "'$arg' is not a valid libtool object"
+	  fi
+	fi
+	;;
+
+      *.$libext)
+	# An archive.
+	func_append deplibs " $arg"
+	func_append old_deplibs " $arg"
+	continue
+	;;
+
+      *.la)
+	# A libtool-controlled library.
+
+	func_resolve_sysroot "$arg"
+	if test dlfiles = "$prev"; then
+	  # This library was specified with -dlopen.
+	  func_append dlfiles " $func_resolve_sysroot_result"
+	  prev=
+	elif test dlprefiles = "$prev"; then
+	  # The library was specified with -dlpreopen.
+	  func_append dlprefiles " $func_resolve_sysroot_result"
+	  prev=
+	else
+	  func_append deplibs " $func_resolve_sysroot_result"
+	fi
+	continue
+	;;
+
+      # Some other compiler argument.
+      *)
+	# Unknown arguments in both finalize_command and compile_command need
+	# to be aesthetically quoted because they are evaled later.
+	func_quote_arg pretty "$arg"
+	arg=$func_quote_arg_result
+	;;
+      esac # arg
+
+      # Now actually substitute the argument into the commands.
+      if test -n "$arg"; then
+	func_append compile_command " $arg"
+	func_append finalize_command " $arg"
+      fi
+    done # argument parsing loop
+
+    test -n "$prev" && \
+      func_fatal_help "the '$prevarg' option requires an argument"
+
+    if test yes = "$export_dynamic" && test -n "$export_dynamic_flag_spec"; then
+      eval arg=\"$export_dynamic_flag_spec\"
+      func_append compile_command " $arg"
+      func_append finalize_command " $arg"
+    fi
+
+    oldlibs=
+    # calculate the name of the file, without its directory
+    func_basename "$output"
+    outputname=$func_basename_result
+    libobjs_save=$libobjs
+
+    if test -n "$shlibpath_var"; then
+      # get the directories listed in $shlibpath_var
+      eval shlib_search_path=\`\$ECHO \"\$$shlibpath_var\" \| \$SED \'s/:/ /g\'\`
+    else
+      shlib_search_path=
+    fi
+    eval sys_lib_search_path=\"$sys_lib_search_path_spec\"
+    eval sys_lib_dlsearch_path=\"$sys_lib_dlsearch_path_spec\"
+
+    # Definition is injected by LT_CONFIG during libtool generation.
+    func_munge_path_list sys_lib_dlsearch_path "$LT_SYS_LIBRARY_PATH"
+
+    func_dirname "$output" "/" ""
+    output_objdir=$func_dirname_result$objdir
+    func_to_tool_file "$output_objdir/"
+    tool_output_objdir=$func_to_tool_file_result
+    # Create the object directory.
+    func_mkdir_p "$output_objdir"
+
+    # Determine the type of output
+    case $output in
+    "")
+      func_fatal_help "you must specify an output file"
+      ;;
+    *.$libext) linkmode=oldlib ;;
+    *.lo | *.$objext) linkmode=obj ;;
+    *.la) linkmode=lib ;;
+    *) linkmode=prog ;; # Anything else should be a program.
+    esac
+
+    specialdeplibs=
+
+    libs=
+    # Find all interdependent deplibs by searching for libraries
+    # that are linked more than once (e.g. -la -lb -la)
+    for deplib in $deplibs; do
+      if $opt_preserve_dup_deps; then
+	case "$libs " in
+	*" $deplib "*) func_append specialdeplibs " $deplib" ;;
+	esac
+      fi
+      func_append libs " $deplib"
+    done
+
+    if test lib = "$linkmode"; then
+      libs="$predeps $libs $compiler_lib_search_path $postdeps"
+
+      # Compute libraries that are listed more than once in $predeps
+      # $postdeps and mark them as special (i.e., whose duplicates are
+      # not to be eliminated).
+      pre_post_deps=
+      if $opt_duplicate_compiler_generated_deps; then
+	for pre_post_dep in $predeps $postdeps; do
+	  case "$pre_post_deps " in
+	  *" $pre_post_dep "*) func_append specialdeplibs " $pre_post_deps" ;;
+	  esac
+	  func_append pre_post_deps " $pre_post_dep"
+	done
+      fi
+      pre_post_deps=
+    fi
+
+    deplibs=
+    newdependency_libs=
+    newlib_search_path=
+    need_relink=no # whether we're linking any uninstalled libtool libraries
+    notinst_deplibs= # not-installed libtool libraries
+    notinst_path= # paths that contain not-installed libtool libraries
+
+    case $linkmode in
+    lib)
+	passes="conv dlpreopen link"
+	for file in $dlfiles $dlprefiles; do
+	  case $file in
+	  *.la) ;;
+	  *)
+	    func_fatal_help "libraries can '-dlopen' only libtool libraries: $file"
+	    ;;
+	  esac
+	done
+	;;
+    prog)
+	compile_deplibs=
+	finalize_deplibs=
+	alldeplibs=false
+	newdlfiles=
+	newdlprefiles=
+	passes="conv scan dlopen dlpreopen link"
+	;;
+    *)  passes="conv"
+	;;
+    esac
+
+    for pass in $passes; do
+      # The preopen pass in lib mode reverses $deplibs; put it back here
+      # so that -L comes before libs that need it for instance...
+      if test lib,link = "$linkmode,$pass"; then
+	## FIXME: Find the place where the list is rebuilt in the wrong
+	##        order, and fix it there properly
+        tmp_deplibs=
+	for deplib in $deplibs; do
+	  tmp_deplibs="$deplib $tmp_deplibs"
+	done
+	deplibs=$tmp_deplibs
+      fi
+
+      if test lib,link = "$linkmode,$pass" ||
+	 test prog,scan = "$linkmode,$pass"; then
+	libs=$deplibs
+	deplibs=
+      fi
+      if test prog = "$linkmode"; then
+	case $pass in
+	dlopen) libs=$dlfiles ;;
+	dlpreopen) libs=$dlprefiles ;;
+	link)
+	  libs="$deplibs %DEPLIBS%"
+	  test "X$link_all_deplibs" != Xno && libs="$libs $dependency_libs"
+	  ;;
+	esac
+      fi
+      if test lib,dlpreopen = "$linkmode,$pass"; then
+	# Collect and forward deplibs of preopened libtool libs
+	for lib in $dlprefiles; do
+	  # Ignore non-libtool-libs
+	  dependency_libs=
+	  func_resolve_sysroot "$lib"
+	  case $lib in
+	  *.la)	func_source "$func_resolve_sysroot_result" ;;
+	  esac
+
+	  # Collect preopened libtool deplibs, except any this library
+	  # has declared as weak libs
+	  for deplib in $dependency_libs; do
+	    func_basename "$deplib"
+            deplib_base=$func_basename_result
+	    case " $weak_libs " in
+	    *" $deplib_base "*) ;;
+	    *) func_append deplibs " $deplib" ;;
+	    esac
+	  done
+	done
+	libs=$dlprefiles
+      fi
+      if test dlopen = "$pass"; then
+	# Collect dlpreopened libraries
+	save_deplibs=$deplibs
+	deplibs=
+      fi
+
+      for deplib in $libs; do
+	lib=
+	found=false
+	case $deplib in
+	-mt|-mthreads|-kthread|-Kthread|-pthread|-pthreads|--thread-safe \
+        |-threads|-fopenmp|-openmp|-mp|-xopenmp|-omp|-qsmp=*)
+	  if test prog,link = "$linkmode,$pass"; then
+	    compile_deplibs="$deplib $compile_deplibs"
+	    finalize_deplibs="$deplib $finalize_deplibs"
+	  else
+	    func_append compiler_flags " $deplib"
+	    if test lib = "$linkmode"; then
+		case "$new_inherited_linker_flags " in
+		    *" $deplib "*) ;;
+		    * ) func_append new_inherited_linker_flags " $deplib" ;;
+		esac
+	    fi
+	  fi
+	  continue
+	  ;;
+	-l*)
+	  if test lib != "$linkmode" && test prog != "$linkmode"; then
+	    func_warning "'-l' is ignored for archives/objects"
+	    continue
+	  fi
+	  func_stripname '-l' '' "$deplib"
+	  name=$func_stripname_result
+	  if test lib = "$linkmode"; then
+	    searchdirs="$newlib_search_path $lib_search_path $compiler_lib_search_dirs $sys_lib_search_path $shlib_search_path"
+	  else
+	    searchdirs="$newlib_search_path $lib_search_path $sys_lib_search_path $shlib_search_path"
+	  fi
+	  for searchdir in $searchdirs; do
+	    for search_ext in .la $std_shrext .so .a; do
+	      # Search the libtool library
+	      lib=$searchdir/lib$name$search_ext
+	      if test -f "$lib"; then
+		if test .la = "$search_ext"; then
+		  found=:
+		else
+		  found=false
+		fi
+		break 2
+	      fi
+	    done
+	  done
+	  if $found; then
+	    # deplib is a libtool library
+	    # If $allow_libtool_libs_with_static_runtimes && $deplib is a stdlib,
+	    # We need to do some special things here, and not later.
+	    if test yes = "$allow_libtool_libs_with_static_runtimes"; then
+	      case " $predeps $postdeps " in
+	      *" $deplib "*)
+		if func_lalib_p "$lib"; then
+		  library_names=
+		  old_library=
+		  func_source "$lib"
+		  for l in $old_library $library_names; do
+		    ll=$l
+		  done
+		  if test "X$ll" = "X$old_library"; then # only static version available
+		    found=false
+		    func_dirname "$lib" "" "."
+		    ladir=$func_dirname_result
+		    lib=$ladir/$old_library
+		    if test prog,link = "$linkmode,$pass"; then
+		      compile_deplibs="$deplib $compile_deplibs"
+		      finalize_deplibs="$deplib $finalize_deplibs"
+		    else
+		      deplibs="$deplib $deplibs"
+		      test lib = "$linkmode" && newdependency_libs="$deplib $newdependency_libs"
+		    fi
+		    continue
+		  fi
+		fi
+		;;
+	      *) ;;
+	      esac
+	    fi
+	  else
+	    # deplib doesn't seem to be a libtool library
+	    if test prog,link = "$linkmode,$pass"; then
+	      compile_deplibs="$deplib $compile_deplibs"
+	      finalize_deplibs="$deplib $finalize_deplibs"
+	    else
+	      deplibs="$deplib $deplibs"
+	      test lib = "$linkmode" && newdependency_libs="$deplib $newdependency_libs"
+	    fi
+	    continue
+	  fi
+	  ;; # -l
+	*.ltframework)
+	  if test prog,link = "$linkmode,$pass"; then
+	    compile_deplibs="$deplib $compile_deplibs"
+	    finalize_deplibs="$deplib $finalize_deplibs"
+	  else
+	    deplibs="$deplib $deplibs"
+	    if test lib = "$linkmode"; then
+		case "$new_inherited_linker_flags " in
+		    *" $deplib "*) ;;
+		    * ) func_append new_inherited_linker_flags " $deplib" ;;
+		esac
+	    fi
+	  fi
+	  continue
+	  ;;
+	-L*)
+	  case $linkmode in
+	  lib)
+	    deplibs="$deplib $deplibs"
+	    test conv = "$pass" && continue
+	    newdependency_libs="$deplib $newdependency_libs"
+	    func_stripname '-L' '' "$deplib"
+	    func_resolve_sysroot "$func_stripname_result"
+	    func_append newlib_search_path " $func_resolve_sysroot_result"
+	    ;;
+	  prog)
+	    if test conv = "$pass"; then
+	      deplibs="$deplib $deplibs"
+	      continue
+	    fi
+	    if test scan = "$pass"; then
+	      deplibs="$deplib $deplibs"
+	    else
+	      compile_deplibs="$deplib $compile_deplibs"
+	      finalize_deplibs="$deplib $finalize_deplibs"
+	    fi
+	    func_stripname '-L' '' "$deplib"
+	    func_resolve_sysroot "$func_stripname_result"
+	    func_append newlib_search_path " $func_resolve_sysroot_result"
+	    ;;
+	  *)
+	    func_warning "'-L' is ignored for archives/objects"
+	    ;;
+	  esac # linkmode
+	  continue
+	  ;; # -L
+	-R*)
+	  if test link = "$pass"; then
+	    func_stripname '-R' '' "$deplib"
+	    func_resolve_sysroot "$func_stripname_result"
+	    dir=$func_resolve_sysroot_result
+	    # Make sure the xrpath contains only unique directories.
+	    case "$xrpath " in
+	    *" $dir "*) ;;
+	    *) func_append xrpath " $dir" ;;
+	    esac
+	  fi
+	  deplibs="$deplib $deplibs"
+	  continue
+	  ;;
+	*.la)
+	  func_resolve_sysroot "$deplib"
+	  lib=$func_resolve_sysroot_result
+	  ;;
+	*.$libext)
+	  if test conv = "$pass"; then
+	    deplibs="$deplib $deplibs"
+	    continue
+	  fi
+	  case $linkmode in
+	  lib)
+	    # Linking convenience modules into shared libraries is allowed,
+	    # but linking other static libraries is non-portable.
+	    case " $dlpreconveniencelibs " in
+	    *" $deplib "*) ;;
+	    *)
+	      valid_a_lib=false
+	      case $deplibs_check_method in
+		match_pattern*)
+		  set dummy $deplibs_check_method; shift
+		  match_pattern_regex=`expr "$deplibs_check_method" : "$1 \(.*\)"`
+		  if eval "\$ECHO \"$deplib\"" 2>/dev/null | $SED 10q \
+		    | $EGREP "$match_pattern_regex" > /dev/null; then
+		    valid_a_lib=:
+		  fi
+		;;
+		pass_all)
+		  valid_a_lib=:
+		;;
+	      esac
+	      if $valid_a_lib; then
+		echo
+		$ECHO "*** Warning: Linking the shared library $output against the"
+		$ECHO "*** static library $deplib is not portable!"
+		deplibs="$deplib $deplibs"
+	      else
+		echo
+		$ECHO "*** Warning: Trying to link with static lib archive $deplib."
+		echo "*** I have the capability to make that library automatically link in when"
+		echo "*** you link to this library.  But I can only do this if you have a"
+		echo "*** shared version of the library, which you do not appear to have"
+		echo "*** because the file extensions .$libext of this argument makes me believe"
+		echo "*** that it is just a static archive that I should not use here."
+	      fi
+	      ;;
+	    esac
+	    continue
+	    ;;
+	  prog)
+	    if test link != "$pass"; then
+	      deplibs="$deplib $deplibs"
+	    else
+	      compile_deplibs="$deplib $compile_deplibs"
+	      finalize_deplibs="$deplib $finalize_deplibs"
+	    fi
+	    continue
+	    ;;
+	  esac # linkmode
+	  ;; # *.$libext
+	*.lo | *.$objext)
+	  if test conv = "$pass"; then
+	    deplibs="$deplib $deplibs"
+	  elif test prog = "$linkmode"; then
+	    if test dlpreopen = "$pass" || test yes != "$dlopen_support" || test no = "$build_libtool_libs"; then
+	      # If there is no dlopen support or we're linking statically,
+	      # we need to preload.
+	      func_append newdlprefiles " $deplib"
+	      compile_deplibs="$deplib $compile_deplibs"
+	      finalize_deplibs="$deplib $finalize_deplibs"
+	    else
+	      func_append newdlfiles " $deplib"
+	    fi
+	  fi
+	  continue
+	  ;;
+	%DEPLIBS%)
+	  alldeplibs=:
+	  continue
+	  ;;
+	esac # case $deplib
+
+	$found || test -f "$lib" \
+	  || func_fatal_error "cannot find the library '$lib' or unhandled argument '$deplib'"
+
+	# Check to see that this really is a libtool archive.
+	func_lalib_unsafe_p "$lib" \
+	  || func_fatal_error "'$lib' is not a valid libtool archive"
+
+	func_dirname "$lib" "" "."
+	ladir=$func_dirname_result
+
+	dlname=
+	dlopen=
+	dlpreopen=
+	libdir=
+	library_names=
+	old_library=
+	inherited_linker_flags=
+	# If the library was installed with an old release of libtool,
+	# it will not redefine variables installed, or shouldnotlink
+	installed=yes
+	shouldnotlink=no
+	avoidtemprpath=
+
+
+	# Read the .la file
+	func_source "$lib"
+
+	# Convert "-framework foo" to "foo.ltframework"
+	if test -n "$inherited_linker_flags"; then
+	  tmp_inherited_linker_flags=`$ECHO "$inherited_linker_flags" | $SED 's/-framework \([^ $]*\)/\1.ltframework/g'`
+	  for tmp_inherited_linker_flag in $tmp_inherited_linker_flags; do
+	    case " $new_inherited_linker_flags " in
+	      *" $tmp_inherited_linker_flag "*) ;;
+	      *) func_append new_inherited_linker_flags " $tmp_inherited_linker_flag";;
+	    esac
+	  done
+	fi
+	dependency_libs=`$ECHO " $dependency_libs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
+	if test lib,link = "$linkmode,$pass" ||
+	   test prog,scan = "$linkmode,$pass" ||
+	   { test prog != "$linkmode" && test lib != "$linkmode"; }; then
+	  test -n "$dlopen" && func_append dlfiles " $dlopen"
+	  test -n "$dlpreopen" && func_append dlprefiles " $dlpreopen"
+	fi
+
+	if test conv = "$pass"; then
+	  # Only check for convenience libraries
+	  deplibs="$lib $deplibs"
+	  if test -z "$libdir"; then
+	    if test -z "$old_library"; then
+	      func_fatal_error "cannot find name of link library for '$lib'"
+	    fi
+	    # It is a libtool convenience library, so add in its objects.
+	    func_append convenience " $ladir/$objdir/$old_library"
+	    func_append old_convenience " $ladir/$objdir/$old_library"
+	    tmp_libs=
+	    for deplib in $dependency_libs; do
+	      deplibs="$deplib $deplibs"
+	      if $opt_preserve_dup_deps; then
+		case "$tmp_libs " in
+		*" $deplib "*) func_append specialdeplibs " $deplib" ;;
+		esac
+	      fi
+	      func_append tmp_libs " $deplib"
+	    done
+	  elif test prog != "$linkmode" && test lib != "$linkmode"; then
+	    func_fatal_error "'$lib' is not a convenience library"
+	  fi
+	  continue
+	fi # $pass = conv
+
+
+	# Get the name of the library we link against.
+	linklib=
+	if test -n "$old_library" &&
+	   { test yes = "$prefer_static_libs" ||
+	     test built,no = "$prefer_static_libs,$installed"; }; then
+	  linklib=$old_library
+	else
+	  for l in $old_library $library_names; do
+	    linklib=$l
+	  done
+	fi
+	if test -z "$linklib"; then
+	  func_fatal_error "cannot find name of link library for '$lib'"
+	fi
+
+	# This library was specified with -dlopen.
+	if test dlopen = "$pass"; then
+	  test -z "$libdir" \
+	    && func_fatal_error "cannot -dlopen a convenience library: '$lib'"
+	  if test -z "$dlname" ||
+	     test yes != "$dlopen_support" ||
+	     test no = "$build_libtool_libs"
+	  then
+	    # If there is no dlname, no dlopen support or we're linking
+	    # statically, we need to preload.  We also need to preload any
+	    # dependent libraries so libltdl's deplib preloader doesn't
+	    # bomb out in the load deplibs phase.
+	    func_append dlprefiles " $lib $dependency_libs"
+	  else
+	    func_append newdlfiles " $lib"
+	  fi
+	  continue
+	fi # $pass = dlopen
+
+	# We need an absolute path.
+	case $ladir in
+	[\\/]* | [A-Za-z]:[\\/]*) abs_ladir=$ladir ;;
+	*)
+	  abs_ladir=`cd "$ladir" && pwd`
+	  if test -z "$abs_ladir"; then
+	    func_warning "cannot determine absolute directory name of '$ladir'"
+	    func_warning "passing it literally to the linker, although it might fail"
+	    abs_ladir=$ladir
+	  fi
+	  ;;
+	esac
+	func_basename "$lib"
+	laname=$func_basename_result
+
+	# Find the relevant object directory and library name.
+	if test yes = "$installed"; then
+	  if test ! -f "$lt_sysroot$libdir/$linklib" && test -f "$abs_ladir/$linklib"; then
+	    func_warning "library '$lib' was moved."
+	    dir=$ladir
+	    absdir=$abs_ladir
+	    libdir=$abs_ladir
+	  else
+	    dir=$lt_sysroot$libdir
+	    absdir=$lt_sysroot$libdir
+	  fi
+	  test yes = "$hardcode_automatic" && avoidtemprpath=yes
+	else
+	  if test ! -f "$ladir/$objdir/$linklib" && test -f "$abs_ladir/$linklib"; then
+	    dir=$ladir
+	    absdir=$abs_ladir
+	    # Remove this search path later
+	    func_append notinst_path " $abs_ladir"
+	  else
+	    dir=$ladir/$objdir
+	    absdir=$abs_ladir/$objdir
+	    # Remove this search path later
+	    func_append notinst_path " $abs_ladir"
+	  fi
+	fi # $installed = yes
+	func_stripname 'lib' '.la' "$laname"
+	name=$func_stripname_result
+
+	# This library was specified with -dlpreopen.
+	if test dlpreopen = "$pass"; then
+	  if test -z "$libdir" && test prog = "$linkmode"; then
+	    func_fatal_error "only libraries may -dlpreopen a convenience library: '$lib'"
+	  fi
+	  case $host in
+	    # special handling for platforms with PE-DLLs.
+	    *cygwin* | *mingw* | *cegcc* )
+	      # Linker will automatically link against shared library if both
+	      # static and shared are present.  Therefore, ensure we extract
+	      # symbols from the import library if a shared library is present
+	      # (otherwise, the dlopen module name will be incorrect).  We do
+	      # this by putting the import library name into $newdlprefiles.
+	      # We recover the dlopen module name by 'saving' the la file
+	      # name in a special purpose variable, and (later) extracting the
+	      # dlname from the la file.
+	      if test -n "$dlname"; then
+	        func_tr_sh "$dir/$linklib"
+	        eval "libfile_$func_tr_sh_result=\$abs_ladir/\$laname"
+	        func_append newdlprefiles " $dir/$linklib"
+	      else
+	        func_append newdlprefiles " $dir/$old_library"
+	        # Keep a list of preopened convenience libraries to check
+	        # that they are being used correctly in the link pass.
+	        test -z "$libdir" && \
+	          func_append dlpreconveniencelibs " $dir/$old_library"
+	      fi
+	    ;;
+	    * )
+	      # Prefer using a static library (so that no silly _DYNAMIC symbols
+	      # are required to link).
+	      if test -n "$old_library"; then
+	        func_append newdlprefiles " $dir/$old_library"
+	        # Keep a list of preopened convenience libraries to check
+	        # that they are being used correctly in the link pass.
+	        test -z "$libdir" && \
+	          func_append dlpreconveniencelibs " $dir/$old_library"
+	      # Otherwise, use the dlname, so that lt_dlopen finds it.
+	      elif test -n "$dlname"; then
+	        func_append newdlprefiles " $dir/$dlname"
+	      else
+	        func_append newdlprefiles " $dir/$linklib"
+	      fi
+	    ;;
+	  esac
+	fi # $pass = dlpreopen
+
+	if test -z "$libdir"; then
+	  # Link the convenience library
+	  if test lib = "$linkmode"; then
+	    deplibs="$dir/$old_library $deplibs"
+	  elif test prog,link = "$linkmode,$pass"; then
+	    compile_deplibs="$dir/$old_library $compile_deplibs"
+	    finalize_deplibs="$dir/$old_library $finalize_deplibs"
+	  else
+	    deplibs="$lib $deplibs" # used for prog,scan pass
+	  fi
+	  continue
+	fi
+
+
+	if test prog = "$linkmode" && test link != "$pass"; then
+	  func_append newlib_search_path " $ladir"
+	  deplibs="$lib $deplibs"
+
+	  linkalldeplibs=false
+	  if test no != "$link_all_deplibs" || test -z "$library_names" ||
+	     test no = "$build_libtool_libs"; then
+	    linkalldeplibs=:
+	  fi
+
+	  tmp_libs=
+	  for deplib in $dependency_libs; do
+	    case $deplib in
+	    -L*) func_stripname '-L' '' "$deplib"
+	         func_resolve_sysroot "$func_stripname_result"
+	         func_append newlib_search_path " $func_resolve_sysroot_result"
+		 ;;
+	    esac
+	    # Need to link against all dependency_libs?
+	    if $linkalldeplibs; then
+	      deplibs="$deplib $deplibs"
+	    else
+	      # Need to hardcode shared library paths
+	      # or/and link against static libraries
+	      newdependency_libs="$deplib $newdependency_libs"
+	    fi
+	    if $opt_preserve_dup_deps; then
+	      case "$tmp_libs " in
+	      *" $deplib "*) func_append specialdeplibs " $deplib" ;;
+	      esac
+	    fi
+	    func_append tmp_libs " $deplib"
+	  done # for deplib
+	  continue
+	fi # $linkmode = prog...
+
+	if test prog,link = "$linkmode,$pass"; then
+	  if test -n "$library_names" &&
+	     { { test no = "$prefer_static_libs" ||
+	         test built,yes = "$prefer_static_libs,$installed"; } ||
+	       test -z "$old_library"; }; then
+	    # We need to hardcode the library path
+	    if test -n "$shlibpath_var" && test -z "$avoidtemprpath"; then
+	      # Make sure the rpath contains only unique directories.
+	      case $temp_rpath: in
+	      *"$absdir:"*) ;;
+	      *) func_append temp_rpath "$absdir:" ;;
+	      esac
+	    fi
+
+	    # Hardcode the library path.
+	    # Skip directories that are in the system default run-time
+	    # search path.
+	    case " $sys_lib_dlsearch_path " in
+	    *" $absdir "*) ;;
+	    *)
+	      case "$compile_rpath " in
+	      *" $absdir "*) ;;
+	      *) func_append compile_rpath " $absdir" ;;
+	      esac
+	      ;;
+	    esac
+	    case " $sys_lib_dlsearch_path " in
+	    *" $libdir "*) ;;
+	    *)
+	      case "$finalize_rpath " in
+	      *" $libdir "*) ;;
+	      *) func_append finalize_rpath " $libdir" ;;
+	      esac
+	      ;;
+	    esac
+	  fi # $linkmode,$pass = prog,link...
+
+	  if $alldeplibs &&
+	     { test pass_all = "$deplibs_check_method" ||
+	       { test yes = "$build_libtool_libs" &&
+		 test -n "$library_names"; }; }; then
+	    # We only need to search for static libraries
+	    continue
+	  fi
+	fi
+
+	link_static=no # Whether the deplib will be linked statically
+	use_static_libs=$prefer_static_libs
+	if test built = "$use_static_libs" && test yes = "$installed"; then
+	  use_static_libs=no
+	fi
+	if test -n "$library_names" &&
+	   { test no = "$use_static_libs" || test -z "$old_library"; }; then
+	  case $host in
+	  *cygwin* | *mingw* | *cegcc* | *os2*)
+	      # No point in relinking DLLs because paths are not encoded
+	      func_append notinst_deplibs " $lib"
+	      need_relink=no
+	    ;;
+	  *)
+	    if test no = "$installed"; then
+	      func_append notinst_deplibs " $lib"
+	      need_relink=yes
+	    fi
+	    ;;
+	  esac
+	  # This is a shared library
+
+	  # Warn about portability, can't link against -module's on some
+	  # systems (darwin).  Don't bleat about dlopened modules though!
+	  dlopenmodule=
+	  for dlpremoduletest in $dlprefiles; do
+	    if test "X$dlpremoduletest" = "X$lib"; then
+	      dlopenmodule=$dlpremoduletest
+	      break
+	    fi
+	  done
+	  if test -z "$dlopenmodule" && test yes = "$shouldnotlink" && test link = "$pass"; then
+	    echo
+	    if test prog = "$linkmode"; then
+	      $ECHO "*** Warning: Linking the executable $output against the loadable module"
+	    else
+	      $ECHO "*** Warning: Linking the shared library $output against the loadable module"
+	    fi
+	    $ECHO "*** $linklib is not portable!"
+	  fi
+	  if test lib = "$linkmode" &&
+	     test yes = "$hardcode_into_libs"; then
+	    # Hardcode the library path.
+	    # Skip directories that are in the system default run-time
+	    # search path.
+	    case " $sys_lib_dlsearch_path " in
+	    *" $absdir "*) ;;
+	    *)
+	      case "$compile_rpath " in
+	      *" $absdir "*) ;;
+	      *) func_append compile_rpath " $absdir" ;;
+	      esac
+	      ;;
+	    esac
+	    case " $sys_lib_dlsearch_path " in
+	    *" $libdir "*) ;;
+	    *)
+	      case "$finalize_rpath " in
+	      *" $libdir "*) ;;
+	      *) func_append finalize_rpath " $libdir" ;;
+	      esac
+	      ;;
+	    esac
+	  fi
+
+	  if test -n "$old_archive_from_expsyms_cmds"; then
+	    # figure out the soname
+	    set dummy $library_names
+	    shift
+	    realname=$1
+	    shift
+	    libname=`eval "\\$ECHO \"$libname_spec\""`
+	    # use dlname if we got it. it's perfectly good, no?
+	    if test -n "$dlname"; then
+	      soname=$dlname
+	    elif test -n "$soname_spec"; then
+	      # bleh windows
+	      case $host in
+	      *cygwin* | mingw* | *cegcc* | *os2*)
+	        func_arith $current - $age
+		major=$func_arith_result
+		versuffix=-$major
+		;;
+	      esac
+	      eval soname=\"$soname_spec\"
+	    else
+	      soname=$realname
+	    fi
+
+	    # Make a new name for the extract_expsyms_cmds to use
+	    soroot=$soname
+	    func_basename "$soroot"
+	    soname=$func_basename_result
+	    func_stripname 'lib' '.dll' "$soname"
+	    newlib=libimp-$func_stripname_result.a
+
+	    # If the library has no export list, then create one now
+	    if test -f "$output_objdir/$soname-def"; then :
+	    else
+	      func_verbose "extracting exported symbol list from '$soname'"
+	      func_execute_cmds "$extract_expsyms_cmds" 'exit $?'
+	    fi
+
+	    # Create $newlib
+	    if test -f "$output_objdir/$newlib"; then :; else
+	      func_verbose "generating import library for '$soname'"
+	      func_execute_cmds "$old_archive_from_expsyms_cmds" 'exit $?'
+	    fi
+	    # make sure the library variables are pointing to the new library
+	    dir=$output_objdir
+	    linklib=$newlib
+	  fi # test -n "$old_archive_from_expsyms_cmds"
+
+	  if test prog = "$linkmode" || test relink != "$opt_mode"; then
+	    add_shlibpath=
+	    add_dir=
+	    add=
+	    lib_linked=yes
+	    case $hardcode_action in
+	    immediate | unsupported)
+	      if test no = "$hardcode_direct"; then
+		add=$dir/$linklib
+		case $host in
+		  *-*-sco3.2v5.0.[024]*) add_dir=-L$dir ;;
+		  *-*-sysv4*uw2*) add_dir=-L$dir ;;
+		  *-*-sysv5OpenUNIX* | *-*-sysv5UnixWare7.[01].[10]* | \
+		    *-*-unixware7*) add_dir=-L$dir ;;
+		  *-*-darwin* )
+		    # if the lib is a (non-dlopened) module then we cannot
+		    # link against it, someone is ignoring the earlier warnings
+		    if /usr/bin/file -L $add 2> /dev/null |
+			 $GREP ": [^:]* bundle" >/dev/null; then
+		      if test "X$dlopenmodule" != "X$lib"; then
+			$ECHO "*** Warning: lib $linklib is a module, not a shared library"
+			if test -z "$old_library"; then
+			  echo
+			  echo "*** And there doesn't seem to be a static archive available"
+			  echo "*** The link will probably fail, sorry"
+			else
+			  add=$dir/$old_library
+			fi
+		      elif test -n "$old_library"; then
+			add=$dir/$old_library
+		      fi
+		    fi
+		esac
+	      elif test no = "$hardcode_minus_L"; then
+		case $host in
+		*-*-sunos*) add_shlibpath=$dir ;;
+		esac
+		add_dir=-L$dir
+		add=-l$name
+	      elif test no = "$hardcode_shlibpath_var"; then
+		add_shlibpath=$dir
+		add=-l$name
+	      else
+		lib_linked=no
+	      fi
+	      ;;
+	    relink)
+	      if test yes = "$hardcode_direct" &&
+	         test no = "$hardcode_direct_absolute"; then
+		add=$dir/$linklib
+	      elif test yes = "$hardcode_minus_L"; then
+		add_dir=-L$absdir
+		# Try looking first in the location we're being installed to.
+		if test -n "$inst_prefix_dir"; then
+		  case $libdir in
+		    [\\/]*)
+		      func_append add_dir " -L$inst_prefix_dir$libdir"
+		      ;;
+		  esac
+		fi
+		add=-l$name
+	      elif test yes = "$hardcode_shlibpath_var"; then
+		add_shlibpath=$dir
+		add=-l$name
+	      else
+		lib_linked=no
+	      fi
+	      ;;
+	    *) lib_linked=no ;;
+	    esac
+
+	    if test yes != "$lib_linked"; then
+	      func_fatal_configuration "unsupported hardcode properties"
+	    fi
+
+	    if test -n "$add_shlibpath"; then
+	      case :$compile_shlibpath: in
+	      *":$add_shlibpath:"*) ;;
+	      *) func_append compile_shlibpath "$add_shlibpath:" ;;
+	      esac
+	    fi
+	    if test prog = "$linkmode"; then
+	      test -n "$add_dir" && compile_deplibs="$add_dir $compile_deplibs"
+	      test -n "$add" && compile_deplibs="$add $compile_deplibs"
+	    else
+	      test -n "$add_dir" && deplibs="$add_dir $deplibs"
+	      test -n "$add" && deplibs="$add $deplibs"
+	      if test yes != "$hardcode_direct" &&
+		 test yes != "$hardcode_minus_L" &&
+		 test yes = "$hardcode_shlibpath_var"; then
+		case :$finalize_shlibpath: in
+		*":$libdir:"*) ;;
+		*) func_append finalize_shlibpath "$libdir:" ;;
+		esac
+	      fi
+	    fi
+	  fi
+
+	  if test prog = "$linkmode" || test relink = "$opt_mode"; then
+	    add_shlibpath=
+	    add_dir=
+	    add=
+	    # Finalize command for both is simple: just hardcode it.
+	    if test yes = "$hardcode_direct" &&
+	       test no = "$hardcode_direct_absolute"; then
+	      add=$libdir/$linklib
+	    elif test yes = "$hardcode_minus_L"; then
+	      add_dir=-L$libdir
+	      add=-l$name
+	    elif test yes = "$hardcode_shlibpath_var"; then
+	      case :$finalize_shlibpath: in
+	      *":$libdir:"*) ;;
+	      *) func_append finalize_shlibpath "$libdir:" ;;
+	      esac
+	      add=-l$name
+	    elif test yes = "$hardcode_automatic"; then
+	      if test -n "$inst_prefix_dir" &&
+		 test -f "$inst_prefix_dir$libdir/$linklib"; then
+		add=$inst_prefix_dir$libdir/$linklib
+	      else
+		add=$libdir/$linklib
+	      fi
+	    else
+	      # We cannot seem to hardcode it, guess we'll fake it.
+	      add_dir=-L$libdir
+	      # Try looking first in the location we're being installed to.
+	      if test -n "$inst_prefix_dir"; then
+		case $libdir in
+		  [\\/]*)
+		    func_append add_dir " -L$inst_prefix_dir$libdir"
+		    ;;
+		esac
+	      fi
+	      add=-l$name
+	    fi
+
+	    if test prog = "$linkmode"; then
+	      test -n "$add_dir" && finalize_deplibs="$add_dir $finalize_deplibs"
+	      test -n "$add" && finalize_deplibs="$add $finalize_deplibs"
+	    else
+	      test -n "$add_dir" && deplibs="$add_dir $deplibs"
+	      test -n "$add" && deplibs="$add $deplibs"
+	    fi
+	  fi
+	elif test prog = "$linkmode"; then
+	  # Here we assume that one of hardcode_direct or hardcode_minus_L
+	  # is not unsupported.  This is valid on all known static and
+	  # shared platforms.
+	  if test unsupported != "$hardcode_direct"; then
+	    test -n "$old_library" && linklib=$old_library
+	    compile_deplibs="$dir/$linklib $compile_deplibs"
+	    finalize_deplibs="$dir/$linklib $finalize_deplibs"
+	  else
+	    compile_deplibs="-l$name -L$dir $compile_deplibs"
+	    finalize_deplibs="-l$name -L$dir $finalize_deplibs"
+	  fi
+	elif test yes = "$build_libtool_libs"; then
+	  # Not a shared library
+	  if test pass_all != "$deplibs_check_method"; then
+	    # We're trying link a shared library against a static one
+	    # but the system doesn't support it.
+
+	    # Just print a warning and add the library to dependency_libs so
+	    # that the program can be linked against the static library.
+	    echo
+	    $ECHO "*** Warning: This system cannot link to static lib archive $lib."
+	    echo "*** I have the capability to make that library automatically link in when"
+	    echo "*** you link to this library.  But I can only do this if you have a"
+	    echo "*** shared version of the library, which you do not appear to have."
+	    if test yes = "$module"; then
+	      echo "*** But as you try to build a module library, libtool will still create "
+	      echo "*** a static module, that should work as long as the dlopening application"
+	      echo "*** is linked with the -dlopen flag to resolve symbols at runtime."
+	      if test -z "$global_symbol_pipe"; then
+		echo
+		echo "*** However, this would only work if libtool was able to extract symbol"
+		echo "*** lists from a program, using 'nm' or equivalent, but libtool could"
+		echo "*** not find such a program.  So, this module is probably useless."
+		echo "*** 'nm' from GNU binutils and a full rebuild may help."
+	      fi
+	      if test no = "$build_old_libs"; then
+		build_libtool_libs=module
+		build_old_libs=yes
+	      else
+		build_libtool_libs=no
+	      fi
+	    fi
+	  else
+	    deplibs="$dir/$old_library $deplibs"
+	    link_static=yes
+	  fi
+	fi # link shared/static library?
+
+	if test lib = "$linkmode"; then
+	  if test -n "$dependency_libs" &&
+	     { test yes != "$hardcode_into_libs" ||
+	       test yes = "$build_old_libs" ||
+	       test yes = "$link_static"; }; then
+	    # Extract -R from dependency_libs
+	    temp_deplibs=
+	    for libdir in $dependency_libs; do
+	      case $libdir in
+	      -R*) func_stripname '-R' '' "$libdir"
+	           temp_xrpath=$func_stripname_result
+		   case " $xrpath " in
+		   *" $temp_xrpath "*) ;;
+		   *) func_append xrpath " $temp_xrpath";;
+		   esac;;
+	      *) func_append temp_deplibs " $libdir";;
+	      esac
+	    done
+	    dependency_libs=$temp_deplibs
+	  fi
+
+	  func_append newlib_search_path " $absdir"
+	  # Link against this library
+	  test no = "$link_static" && newdependency_libs="$abs_ladir/$laname $newdependency_libs"
+	  # ... and its dependency_libs
+	  tmp_libs=
+	  for deplib in $dependency_libs; do
+	    newdependency_libs="$deplib $newdependency_libs"
+	    case $deplib in
+              -L*) func_stripname '-L' '' "$deplib"
+                   func_resolve_sysroot "$func_stripname_result";;
+              *) func_resolve_sysroot "$deplib" ;;
+            esac
+	    if $opt_preserve_dup_deps; then
+	      case "$tmp_libs " in
+	      *" $func_resolve_sysroot_result "*)
+                func_append specialdeplibs " $func_resolve_sysroot_result" ;;
+	      esac
+	    fi
+	    func_append tmp_libs " $func_resolve_sysroot_result"
+	  done
+
+	  if test no != "$link_all_deplibs"; then
+	    # Add the search paths of all dependency libraries
+	    for deplib in $dependency_libs; do
+	      path=
+	      case $deplib in
+	      -L*) path=$deplib ;;
+	      *.la)
+	        func_resolve_sysroot "$deplib"
+	        deplib=$func_resolve_sysroot_result
+	        func_dirname "$deplib" "" "."
+		dir=$func_dirname_result
+		# We need an absolute path.
+		case $dir in
+		[\\/]* | [A-Za-z]:[\\/]*) absdir=$dir ;;
+		*)
+		  absdir=`cd "$dir" && pwd`
+		  if test -z "$absdir"; then
+		    func_warning "cannot determine absolute directory name of '$dir'"
+		    absdir=$dir
+		  fi
+		  ;;
+		esac
+		if $GREP "^installed=no" $deplib > /dev/null; then
+		case $host in
+		*-*-darwin*)
+		  depdepl=
+		  eval deplibrary_names=`$SED -n -e 's/^library_names=\(.*\)$/\1/p' $deplib`
+		  if test -n "$deplibrary_names"; then
+		    for tmp in $deplibrary_names; do
+		      depdepl=$tmp
+		    done
+		    if test -f "$absdir/$objdir/$depdepl"; then
+		      depdepl=$absdir/$objdir/$depdepl
+		      darwin_install_name=`$OTOOL -L $depdepl | awk '{if (NR == 2) {print $1;exit}}'`
+                      if test -z "$darwin_install_name"; then
+                          darwin_install_name=`$OTOOL64 -L $depdepl  | awk '{if (NR == 2) {print $1;exit}}'`
+                      fi
+		      func_append compiler_flags " $wl-dylib_file $wl$darwin_install_name:$depdepl"
+		      func_append linker_flags " -dylib_file $darwin_install_name:$depdepl"
+		      path=
+		    fi
+		  fi
+		  ;;
+		*)
+		  path=-L$absdir/$objdir
+		  ;;
+		esac
+		else
+		  eval libdir=`$SED -n -e 's/^libdir=\(.*\)$/\1/p' $deplib`
+		  test -z "$libdir" && \
+		    func_fatal_error "'$deplib' is not a valid libtool archive"
+		  test "$absdir" != "$libdir" && \
+		    func_warning "'$deplib' seems to be moved"
+
+		  path=-L$absdir
+		fi
+		;;
+	      esac
+	      case " $deplibs " in
+	      *" $path "*) ;;
+	      *) deplibs="$path $deplibs" ;;
+	      esac
+	    done
+	  fi # link_all_deplibs != no
+	fi # linkmode = lib
+      done # for deplib in $libs
+      if test link = "$pass"; then
+	if test prog = "$linkmode"; then
+	  compile_deplibs="$new_inherited_linker_flags $compile_deplibs"
+	  finalize_deplibs="$new_inherited_linker_flags $finalize_deplibs"
+	else
+	  compiler_flags="$compiler_flags "`$ECHO " $new_inherited_linker_flags" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
+	fi
+      fi
+      dependency_libs=$newdependency_libs
+      if test dlpreopen = "$pass"; then
+	# Link the dlpreopened libraries before other libraries
+	for deplib in $save_deplibs; do
+	  deplibs="$deplib $deplibs"
+	done
+      fi
+      if test dlopen != "$pass"; then
+	test conv = "$pass" || {
+	  # Make sure lib_search_path contains only unique directories.
+	  lib_search_path=
+	  for dir in $newlib_search_path; do
+	    case "$lib_search_path " in
+	    *" $dir "*) ;;
+	    *) func_append lib_search_path " $dir" ;;
+	    esac
+	  done
+	  newlib_search_path=
+	}
+
+	if test prog,link = "$linkmode,$pass"; then
+	  vars="compile_deplibs finalize_deplibs"
+	else
+	  vars=deplibs
+	fi
+	for var in $vars dependency_libs; do
+	  # Add libraries to $var in reverse order
+	  eval tmp_libs=\"\$$var\"
+	  new_libs=
+	  for deplib in $tmp_libs; do
+	    # FIXME: Pedantically, this is the right thing to do, so
+	    #        that some nasty dependency loop isn't accidentally
+	    #        broken:
+	    #new_libs="$deplib $new_libs"
+	    # Pragmatically, this seems to cause very few problems in
+	    # practice:
+	    case $deplib in
+	    -L*) new_libs="$deplib $new_libs" ;;
+	    -R*) ;;
+	    *)
+	      # And here is the reason: when a library appears more
+	      # than once as an explicit dependence of a library, or
+	      # is implicitly linked in more than once by the
+	      # compiler, it is considered special, and multiple
+	      # occurrences thereof are not removed.  Compare this
+	      # with having the same library being listed as a
+	      # dependency of multiple other libraries: in this case,
+	      # we know (pedantically, we assume) the library does not
+	      # need to be listed more than once, so we keep only the
+	      # last copy.  This is not always right, but it is rare
+	      # enough that we require users that really mean to play
+	      # such unportable linking tricks to link the library
+	      # using -Wl,-lname, so that libtool does not consider it
+	      # for duplicate removal.
+	      case " $specialdeplibs " in
+	      *" $deplib "*) new_libs="$deplib $new_libs" ;;
+	      *)
+		case " $new_libs " in
+		*" $deplib "*) ;;
+		*) new_libs="$deplib $new_libs" ;;
+		esac
+		;;
+	      esac
+	      ;;
+	    esac
+	  done
+	  tmp_libs=
+	  for deplib in $new_libs; do
+	    case $deplib in
+	    -L*)
+	      case " $tmp_libs " in
+	      *" $deplib "*) ;;
+	      *) func_append tmp_libs " $deplib" ;;
+	      esac
+	      ;;
+	    *) func_append tmp_libs " $deplib" ;;
+	    esac
+	  done
+	  eval $var=\"$tmp_libs\"
+	done # for var
+      fi
+
+      # Add Sun CC postdeps if required:
+      test CXX = "$tagname" && {
+        case $host_os in
+        linux*)
+          case `$CC -V 2>&1 | sed 5q` in
+          *Sun\ C*) # Sun C++ 5.9
+            func_suncc_cstd_abi
+
+            if test no != "$suncc_use_cstd_abi"; then
+              func_append postdeps ' -library=Cstd -library=Crun'
+            fi
+            ;;
+          esac
+          ;;
+
+        solaris*)
+          func_cc_basename "$CC"
+          case $func_cc_basename_result in
+          CC* | sunCC*)
+            func_suncc_cstd_abi
+
+            if test no != "$suncc_use_cstd_abi"; then
+              func_append postdeps ' -library=Cstd -library=Crun'
+            fi
+            ;;
+          esac
+          ;;
+        esac
+      }
+
+      # Last step: remove runtime libs from dependency_libs
+      # (they stay in deplibs)
+      tmp_libs=
+      for i in $dependency_libs; do
+	case " $predeps $postdeps $compiler_lib_search_path " in
+	*" $i "*)
+	  i=
+	  ;;
+	esac
+	if test -n "$i"; then
+	  func_append tmp_libs " $i"
+	fi
+      done
+      dependency_libs=$tmp_libs
+    done # for pass
+    if test prog = "$linkmode"; then
+      dlfiles=$newdlfiles
+    fi
+    if test prog = "$linkmode" || test lib = "$linkmode"; then
+      dlprefiles=$newdlprefiles
+    fi
+
+    case $linkmode in
+    oldlib)
+      if test -n "$dlfiles$dlprefiles" || test no != "$dlself"; then
+	func_warning "'-dlopen' is ignored for archives"
+      fi
+
+      case " $deplibs" in
+      *\ -l* | *\ -L*)
+	func_warning "'-l' and '-L' are ignored for archives" ;;
+      esac
+
+      test -n "$rpath" && \
+	func_warning "'-rpath' is ignored for archives"
+
+      test -n "$xrpath" && \
+	func_warning "'-R' is ignored for archives"
+
+      test -n "$vinfo" && \
+	func_warning "'-version-info/-version-number' is ignored for archives"
+
+      test -n "$release" && \
+	func_warning "'-release' is ignored for archives"
+
+      test -n "$export_symbols$export_symbols_regex" && \
+	func_warning "'-export-symbols' is ignored for archives"
+
+      # Now set the variables for building old libraries.
+      build_libtool_libs=no
+      oldlibs=$output
+      func_append objs "$old_deplibs"
+      ;;
+
+    lib)
+      # Make sure we only generate libraries of the form 'libNAME.la'.
+      case $outputname in
+      lib*)
+	func_stripname 'lib' '.la' "$outputname"
+	name=$func_stripname_result
+	eval shared_ext=\"$shrext_cmds\"
+	eval libname=\"$libname_spec\"
+	;;
+      *)
+	test no = "$module" \
+	  && func_fatal_help "libtool library '$output' must begin with 'lib'"
+
+	if test no != "$need_lib_prefix"; then
+	  # Add the "lib" prefix for modules if required
+	  func_stripname '' '.la' "$outputname"
+	  name=$func_stripname_result
+	  eval shared_ext=\"$shrext_cmds\"
+	  eval libname=\"$libname_spec\"
+	else
+	  func_stripname '' '.la' "$outputname"
+	  libname=$func_stripname_result
+	fi
+	;;
+      esac
+
+      if test -n "$objs"; then
+	if test pass_all != "$deplibs_check_method"; then
+	  func_fatal_error "cannot build libtool library '$output' from non-libtool objects on this host:$objs"
+	else
+	  echo
+	  $ECHO "*** Warning: Linking the shared library $output against the non-libtool"
+	  $ECHO "*** objects $objs is not portable!"
+	  func_append libobjs " $objs"
+	fi
+      fi
+
+      test no = "$dlself" \
+	|| func_warning "'-dlopen self' is ignored for libtool libraries"
+
+      set dummy $rpath
+      shift
+      test 1 -lt "$#" \
+	&& func_warning "ignoring multiple '-rpath's for a libtool library"
+
+      install_libdir=$1
+
+      oldlibs=
+      if test -z "$rpath"; then
+	if test yes = "$build_libtool_libs"; then
+	  # Building a libtool convenience library.
+	  # Some compilers have problems with a '.al' extension so
+	  # convenience libraries should have the same extension an
+	  # archive normally would.
+	  oldlibs="$output_objdir/$libname.$libext $oldlibs"
+	  build_libtool_libs=convenience
+	  build_old_libs=yes
+	fi
+
+	test -n "$vinfo" && \
+	  func_warning "'-version-info/-version-number' is ignored for convenience libraries"
+
+	test -n "$release" && \
+	  func_warning "'-release' is ignored for convenience libraries"
+      else
+
+	# Parse the version information argument.
+	save_ifs=$IFS; IFS=:
+	set dummy $vinfo 0 0 0
+	shift
+	IFS=$save_ifs
+
+	test -n "$7" && \
+	  func_fatal_help "too many parameters to '-version-info'"
+
+	# convert absolute version numbers to libtool ages
+	# this retains compatibility with .la files and attempts
+	# to make the code below a bit more comprehensible
+
+	case $vinfo_number in
+	yes)
+	  number_major=$1
+	  number_minor=$2
+	  number_revision=$3
+	  #
+	  # There are really only two kinds -- those that
+	  # use the current revision as the major version
+	  # and those that subtract age and use age as
+	  # a minor version.  But, then there is irix
+	  # that has an extra 1 added just for fun
+	  #
+	  case $version_type in
+	  # correct linux to gnu/linux during the next big refactor
+	  darwin|freebsd-elf|linux|osf|windows|none)
+	    func_arith $number_major + $number_minor
+	    current=$func_arith_result
+	    age=$number_minor
+	    revision=$number_revision
+	    ;;
+	  freebsd-aout|qnx|sunos)
+	    current=$number_major
+	    revision=$number_minor
+	    age=0
+	    ;;
+	  irix|nonstopux)
+	    func_arith $number_major + $number_minor
+	    current=$func_arith_result
+	    age=$number_minor
+	    revision=$number_minor
+	    lt_irix_increment=no
+	    ;;
+	  *)
+	    func_fatal_configuration "$modename: unknown library version type '$version_type'"
+	    ;;
+	  esac
+	  ;;
+	no)
+	  current=$1
+	  revision=$2
+	  age=$3
+	  ;;
+	esac
+
+	# Check that each of the things are valid numbers.
+	case $current in
+	0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;;
+	*)
+	  func_error "CURRENT '$current' must be a nonnegative integer"
+	  func_fatal_error "'$vinfo' is not valid version information"
+	  ;;
+	esac
+
+	case $revision in
+	0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;;
+	*)
+	  func_error "REVISION '$revision' must be a nonnegative integer"
+	  func_fatal_error "'$vinfo' is not valid version information"
+	  ;;
+	esac
+
+	case $age in
+	0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;;
+	*)
+	  func_error "AGE '$age' must be a nonnegative integer"
+	  func_fatal_error "'$vinfo' is not valid version information"
+	  ;;
+	esac
+
+	if test "$age" -gt "$current"; then
+	  func_error "AGE '$age' is greater than the current interface number '$current'"
+	  func_fatal_error "'$vinfo' is not valid version information"
+	fi
+
+	# Calculate the version variables.
+	major=
+	versuffix=
+	verstring=
+	case $version_type in
+	none) ;;
+
+	darwin)
+	  # Like Linux, but with the current version available in
+	  # verstring for coding it into the library header
+	  func_arith $current - $age
+	  major=.$func_arith_result
+	  versuffix=$major.$age.$revision
+	  # Darwin ld doesn't like 0 for these options...
+	  func_arith $current + 1
+	  minor_current=$func_arith_result
+	  xlcverstring="$wl-compatibility_version $wl$minor_current $wl-current_version $wl$minor_current.$revision"
+	  verstring="-compatibility_version $minor_current -current_version $minor_current.$revision"
+          # On Darwin other compilers
+          case $CC in
+              nagfor*)
+                  verstring="$wl-compatibility_version $wl$minor_current $wl-current_version $wl$minor_current.$revision"
+                  ;;
+              *)
+                  verstring="-compatibility_version $minor_current -current_version $minor_current.$revision"
+                  ;;
+          esac
+	  ;;
+
+	freebsd-aout)
+	  major=.$current
+	  versuffix=.$current.$revision
+	  ;;
+
+	freebsd-elf)
+	  func_arith $current - $age
+	  major=.$func_arith_result
+	  versuffix=$major.$age.$revision
+	  ;;
+
+	irix | nonstopux)
+	  if test no = "$lt_irix_increment"; then
+	    func_arith $current - $age
+	  else
+	    func_arith $current - $age + 1
+	  fi
+	  major=$func_arith_result
+
+	  case $version_type in
+	    nonstopux) verstring_prefix=nonstopux ;;
+	    *)         verstring_prefix=sgi ;;
+	  esac
+	  verstring=$verstring_prefix$major.$revision
+
+	  # Add in all the interfaces that we are compatible with.
+	  loop=$revision
+	  while test 0 -ne "$loop"; do
+	    func_arith $revision - $loop
+	    iface=$func_arith_result
+	    func_arith $loop - 1
+	    loop=$func_arith_result
+	    verstring=$verstring_prefix$major.$iface:$verstring
+	  done
+
+	  # Before this point, $major must not contain '.'.
+	  major=.$major
+	  versuffix=$major.$revision
+	  ;;
+
+	linux) # correct to gnu/linux during the next big refactor
+	  func_arith $current - $age
+	  major=.$func_arith_result
+	  versuffix=$major.$age.$revision
+	  ;;
+
+	osf)
+	  func_arith $current - $age
+	  major=.$func_arith_result
+	  versuffix=.$current.$age.$revision
+	  verstring=$current.$age.$revision
+
+	  # Add in all the interfaces that we are compatible with.
+	  loop=$age
+	  while test 0 -ne "$loop"; do
+	    func_arith $current - $loop
+	    iface=$func_arith_result
+	    func_arith $loop - 1
+	    loop=$func_arith_result
+	    verstring=$verstring:$iface.0
+	  done
+
+	  # Make executables depend on our current version.
+	  func_append verstring ":$current.0"
+	  ;;
+
+	qnx)
+	  major=.$current
+	  versuffix=.$current
+	  ;;
+
+	sco)
+	  major=.$current
+	  versuffix=.$current
+	  ;;
+
+	sunos)
+	  major=.$current
+	  versuffix=.$current.$revision
+	  ;;
+
+	windows)
+	  # Use '-' rather than '.', since we only want one
+	  # extension on DOS 8.3 file systems.
+	  func_arith $current - $age
+	  major=$func_arith_result
+	  versuffix=-$major
+	  ;;
+
+	*)
+	  func_fatal_configuration "unknown library version type '$version_type'"
+	  ;;
+	esac
+
+	# Clear the version info if we defaulted, and they specified a release.
+	if test -z "$vinfo" && test -n "$release"; then
+	  major=
+	  case $version_type in
+	  darwin)
+	    # we can't check for "0.0" in archive_cmds due to quoting
+	    # problems, so we reset it completely
+	    verstring=
+	    ;;
+	  *)
+	    verstring=0.0
+	    ;;
+	  esac
+	  if test no = "$need_version"; then
+	    versuffix=
+	  else
+	    versuffix=.0.0
+	  fi
+	fi
+
+	# Remove version info from name if versioning should be avoided
+	if test yes,no = "$avoid_version,$need_version"; then
+	  major=
+	  versuffix=
+	  verstring=
+	fi
+
+	# Check to see if the archive will have undefined symbols.
+	if test yes = "$allow_undefined"; then
+	  if test unsupported = "$allow_undefined_flag"; then
+	    if test yes = "$build_old_libs"; then
+	      func_warning "undefined symbols not allowed in $host shared libraries; building static only"
+	      build_libtool_libs=no
+	    else
+	      func_fatal_error "can't build $host shared library unless -no-undefined is specified"
+	    fi
+	  fi
+	else
+	  # Don't allow undefined symbols.
+	  allow_undefined_flag=$no_undefined_flag
+	fi
+
+      fi
+
+      func_generate_dlsyms "$libname" "$libname" :
+      func_append libobjs " $symfileobj"
+      test " " = "$libobjs" && libobjs=
+
+      if test relink != "$opt_mode"; then
+	# Remove our outputs, but don't remove object files since they
+	# may have been created when compiling PIC objects.
+	removelist=
+	tempremovelist=`$ECHO "$output_objdir/*"`
+	for p in $tempremovelist; do
+	  case $p in
+	    *.$objext | *.gcno)
+	       ;;
+	    $output_objdir/$outputname | $output_objdir/$libname.* | $output_objdir/$libname$release.*)
+	       if test -n "$precious_files_regex"; then
+		 if $ECHO "$p" | $EGREP -e "$precious_files_regex" >/dev/null 2>&1
+		 then
+		   continue
+		 fi
+	       fi
+	       func_append removelist " $p"
+	       ;;
+	    *) ;;
+	  esac
+	done
+	test -n "$removelist" && \
+	  func_show_eval "${RM}r \$removelist"
+      fi
+
+      # Now set the variables for building old libraries.
+      if test yes = "$build_old_libs" && test convenience != "$build_libtool_libs"; then
+	func_append oldlibs " $output_objdir/$libname.$libext"
+
+	# Transform .lo files to .o files.
+	oldobjs="$objs "`$ECHO "$libobjs" | $SP2NL | $SED "/\.$libext$/d; $lo2o" | $NL2SP`
+      fi
+
+      # Eliminate all temporary directories.
+      #for path in $notinst_path; do
+      #	lib_search_path=`$ECHO "$lib_search_path " | $SED "s% $path % %g"`
+      #	deplibs=`$ECHO "$deplibs " | $SED "s% -L$path % %g"`
+      #	dependency_libs=`$ECHO "$dependency_libs " | $SED "s% -L$path % %g"`
+      #done
+
+      if test -n "$xrpath"; then
+	# If the user specified any rpath flags, then add them.
+	temp_xrpath=
+	for libdir in $xrpath; do
+	  func_replace_sysroot "$libdir"
+	  func_append temp_xrpath " -R$func_replace_sysroot_result"
+	  case "$finalize_rpath " in
+	  *" $libdir "*) ;;
+	  *) func_append finalize_rpath " $libdir" ;;
+	  esac
+	done
+	if test yes != "$hardcode_into_libs" || test yes = "$build_old_libs"; then
+	  dependency_libs="$temp_xrpath $dependency_libs"
+	fi
+      fi
+
+      # Make sure dlfiles contains only unique files that won't be dlpreopened
+      old_dlfiles=$dlfiles
+      dlfiles=
+      for lib in $old_dlfiles; do
+	case " $dlprefiles $dlfiles " in
+	*" $lib "*) ;;
+	*) func_append dlfiles " $lib" ;;
+	esac
+      done
+
+      # Make sure dlprefiles contains only unique files
+      old_dlprefiles=$dlprefiles
+      dlprefiles=
+      for lib in $old_dlprefiles; do
+	case "$dlprefiles " in
+	*" $lib "*) ;;
+	*) func_append dlprefiles " $lib" ;;
+	esac
+      done
+
+      if test yes = "$build_libtool_libs"; then
+	if test -n "$rpath"; then
+	  case $host in
+	  *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-*-beos* | *-cegcc* | *-*-haiku*)
+	    # these systems don't actually have a c library (as such)!
+	    ;;
+	  *-*-rhapsody* | *-*-darwin1.[012])
+	    # Rhapsody C library is in the System framework
+	    func_append deplibs " System.ltframework"
+	    ;;
+	  *-*-netbsd*)
+	    # Don't link with libc until the a.out ld.so is fixed.
+	    ;;
+	  *-*-openbsd* | *-*-freebsd* | *-*-dragonfly*)
+	    # Do not include libc due to us having libc/libc_r.
+	    ;;
+	  *-*-sco3.2v5* | *-*-sco5v6*)
+	    # Causes problems with __ctype
+	    ;;
+	  *-*-sysv4.2uw2* | *-*-sysv5* | *-*-unixware* | *-*-OpenUNIX*)
+	    # Compiler inserts libc in the correct place for threads to work
+	    ;;
+	  *)
+	    # Add libc to deplibs on all other systems if necessary.
+	    if test yes = "$build_libtool_need_lc"; then
+	      func_append deplibs " -lc"
+	    fi
+	    ;;
+	  esac
+	fi
+
+	# Transform deplibs into only deplibs that can be linked in shared.
+	name_save=$name
+	libname_save=$libname
+	release_save=$release
+	versuffix_save=$versuffix
+	major_save=$major
+	# I'm not sure if I'm treating the release correctly.  I think
+	# release should show up in the -l (ie -lgmp5) so we don't want to
+	# add it in twice.  Is that correct?
+	release=
+	versuffix=
+	major=
+	newdeplibs=
+	droppeddeps=no
+	case $deplibs_check_method in
+	pass_all)
+	  # Don't check for shared/static.  Everything works.
+	  # This might be a little naive.  We might want to check
+	  # whether the library exists or not.  But this is on
+	  # osf3 & osf4 and I'm not really sure... Just
+	  # implementing what was already the behavior.
+	  newdeplibs=$deplibs
+	  ;;
+	test_compile)
+	  # This code stresses the "libraries are programs" paradigm to its
+	  # limits. Maybe even breaks it.  We compile a program, linking it
+	  # against the deplibs as a proxy for the library.  Then we can check
+	  # whether they linked in statically or dynamically with ldd.
+	  $opt_dry_run || $RM conftest.c
+	  cat > conftest.c </dev/null`
+		    $nocaseglob
+		  else
+		    potential_libs=`ls $i/$libnameglob[.-]* 2>/dev/null`
+		  fi
+		  for potent_lib in $potential_libs; do
+		      # Follow soft links.
+		      if ls -lLd "$potent_lib" 2>/dev/null |
+			 $GREP " -> " >/dev/null; then
+			continue
+		      fi
+		      # The statement above tries to avoid entering an
+		      # endless loop below, in case of cyclic links.
+		      # We might still enter an endless loop, since a link
+		      # loop can be closed while we follow links,
+		      # but so what?
+		      potlib=$potent_lib
+		      while test -h "$potlib" 2>/dev/null; do
+			potliblink=`ls -ld $potlib | $SED 's/.* -> //'`
+			case $potliblink in
+			[\\/]* | [A-Za-z]:[\\/]*) potlib=$potliblink;;
+			*) potlib=`$ECHO "$potlib" | $SED 's|[^/]*$||'`"$potliblink";;
+			esac
+		      done
+		      if eval $file_magic_cmd \"\$potlib\" 2>/dev/null |
+			 $SED -e 10q |
+			 $EGREP "$file_magic_regex" > /dev/null; then
+			func_append newdeplibs " $a_deplib"
+			a_deplib=
+			break 2
+		      fi
+		  done
+		done
+	      fi
+	      if test -n "$a_deplib"; then
+		droppeddeps=yes
+		echo
+		$ECHO "*** Warning: linker path does not have real file for library $a_deplib."
+		echo "*** I have the capability to make that library automatically link in when"
+		echo "*** you link to this library.  But I can only do this if you have a"
+		echo "*** shared version of the library, which you do not appear to have"
+		echo "*** because I did check the linker path looking for a file starting"
+		if test -z "$potlib"; then
+		  $ECHO "*** with $libname but no candidates were found. (...for file magic test)"
+		else
+		  $ECHO "*** with $libname and none of the candidates passed a file format test"
+		  $ECHO "*** using a file magic. Last file checked: $potlib"
+		fi
+	      fi
+	      ;;
+	    *)
+	      # Add a -L argument.
+	      func_append newdeplibs " $a_deplib"
+	      ;;
+	    esac
+	  done # Gone through all deplibs.
+	  ;;
+	match_pattern*)
+	  set dummy $deplibs_check_method; shift
+	  match_pattern_regex=`expr "$deplibs_check_method" : "$1 \(.*\)"`
+	  for a_deplib in $deplibs; do
+	    case $a_deplib in
+	    -l*)
+	      func_stripname -l '' "$a_deplib"
+	      name=$func_stripname_result
+	      if test yes = "$allow_libtool_libs_with_static_runtimes"; then
+		case " $predeps $postdeps " in
+		*" $a_deplib "*)
+		  func_append newdeplibs " $a_deplib"
+		  a_deplib=
+		  ;;
+		esac
+	      fi
+	      if test -n "$a_deplib"; then
+		libname=`eval "\\$ECHO \"$libname_spec\""`
+		for i in $lib_search_path $sys_lib_search_path $shlib_search_path; do
+		  potential_libs=`ls $i/$libname[.-]* 2>/dev/null`
+		  for potent_lib in $potential_libs; do
+		    potlib=$potent_lib # see symlink-check above in file_magic test
+		    if eval "\$ECHO \"$potent_lib\"" 2>/dev/null | $SED 10q | \
+		       $EGREP "$match_pattern_regex" > /dev/null; then
+		      func_append newdeplibs " $a_deplib"
+		      a_deplib=
+		      break 2
+		    fi
+		  done
+		done
+	      fi
+	      if test -n "$a_deplib"; then
+		droppeddeps=yes
+		echo
+		$ECHO "*** Warning: linker path does not have real file for library $a_deplib."
+		echo "*** I have the capability to make that library automatically link in when"
+		echo "*** you link to this library.  But I can only do this if you have a"
+		echo "*** shared version of the library, which you do not appear to have"
+		echo "*** because I did check the linker path looking for a file starting"
+		if test -z "$potlib"; then
+		  $ECHO "*** with $libname but no candidates were found. (...for regex pattern test)"
+		else
+		  $ECHO "*** with $libname and none of the candidates passed a file format test"
+		  $ECHO "*** using a regex pattern. Last file checked: $potlib"
+		fi
+	      fi
+	      ;;
+	    *)
+	      # Add a -L argument.
+	      func_append newdeplibs " $a_deplib"
+	      ;;
+	    esac
+	  done # Gone through all deplibs.
+	  ;;
+	none | unknown | *)
+	  newdeplibs=
+	  tmp_deplibs=`$ECHO " $deplibs" | $SED 's/ -lc$//; s/ -[LR][^ ]*//g'`
+	  if test yes = "$allow_libtool_libs_with_static_runtimes"; then
+	    for i in $predeps $postdeps; do
+	      # can't use Xsed below, because $i might contain '/'
+	      tmp_deplibs=`$ECHO " $tmp_deplibs" | $SED "s|$i||"`
+	    done
+	  fi
+	  case $tmp_deplibs in
+	  *[!\	\ ]*)
+	    echo
+	    if test none = "$deplibs_check_method"; then
+	      echo "*** Warning: inter-library dependencies are not supported in this platform."
+	    else
+	      echo "*** Warning: inter-library dependencies are not known to be supported."
+	    fi
+	    echo "*** All declared inter-library dependencies are being dropped."
+	    droppeddeps=yes
+	    ;;
+	  esac
+	  ;;
+	esac
+	versuffix=$versuffix_save
+	major=$major_save
+	release=$release_save
+	libname=$libname_save
+	name=$name_save
+
+	case $host in
+	*-*-rhapsody* | *-*-darwin1.[012])
+	  # On Rhapsody replace the C library with the System framework
+	  newdeplibs=`$ECHO " $newdeplibs" | $SED 's/ -lc / System.ltframework /'`
+	  ;;
+	esac
+
+	if test yes = "$droppeddeps"; then
+	  if test yes = "$module"; then
+	    echo
+	    echo "*** Warning: libtool could not satisfy all declared inter-library"
+	    $ECHO "*** dependencies of module $libname.  Therefore, libtool will create"
+	    echo "*** a static module, that should work as long as the dlopening"
+	    echo "*** application is linked with the -dlopen flag."
+	    if test -z "$global_symbol_pipe"; then
+	      echo
+	      echo "*** However, this would only work if libtool was able to extract symbol"
+	      echo "*** lists from a program, using 'nm' or equivalent, but libtool could"
+	      echo "*** not find such a program.  So, this module is probably useless."
+	      echo "*** 'nm' from GNU binutils and a full rebuild may help."
+	    fi
+	    if test no = "$build_old_libs"; then
+	      oldlibs=$output_objdir/$libname.$libext
+	      build_libtool_libs=module
+	      build_old_libs=yes
+	    else
+	      build_libtool_libs=no
+	    fi
+	  else
+	    echo "*** The inter-library dependencies that have been dropped here will be"
+	    echo "*** automatically added whenever a program is linked with this library"
+	    echo "*** or is declared to -dlopen it."
+
+	    if test no = "$allow_undefined"; then
+	      echo
+	      echo "*** Since this library must not contain undefined symbols,"
+	      echo "*** because either the platform does not support them or"
+	      echo "*** it was explicitly requested with -no-undefined,"
+	      echo "*** libtool will only create a static version of it."
+	      if test no = "$build_old_libs"; then
+		oldlibs=$output_objdir/$libname.$libext
+		build_libtool_libs=module
+		build_old_libs=yes
+	      else
+		build_libtool_libs=no
+	      fi
+	    fi
+	  fi
+	fi
+	# Done checking deplibs!
+	deplibs=$newdeplibs
+      fi
+      # Time to change all our "foo.ltframework" stuff back to "-framework foo"
+      case $host in
+	*-*-darwin*)
+	  newdeplibs=`$ECHO " $newdeplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
+	  new_inherited_linker_flags=`$ECHO " $new_inherited_linker_flags" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
+	  deplibs=`$ECHO " $deplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
+	  ;;
+      esac
+
+      # move library search paths that coincide with paths to not yet
+      # installed libraries to the beginning of the library search list
+      new_libs=
+      for path in $notinst_path; do
+	case " $new_libs " in
+	*" -L$path/$objdir "*) ;;
+	*)
+	  case " $deplibs " in
+	  *" -L$path/$objdir "*)
+	    func_append new_libs " -L$path/$objdir" ;;
+	  esac
+	  ;;
+	esac
+      done
+      for deplib in $deplibs; do
+	case $deplib in
+	-L*)
+	  case " $new_libs " in
+	  *" $deplib "*) ;;
+	  *) func_append new_libs " $deplib" ;;
+	  esac
+	  ;;
+	*) func_append new_libs " $deplib" ;;
+	esac
+      done
+      deplibs=$new_libs
+
+      # All the library-specific variables (install_libdir is set above).
+      library_names=
+      old_library=
+      dlname=
+
+      # Test again, we may have decided not to build it any more
+      if test yes = "$build_libtool_libs"; then
+	# Remove $wl instances when linking with ld.
+	# FIXME: should test the right _cmds variable.
+	case $archive_cmds in
+	  *\$LD\ *) wl= ;;
+        esac
+	if test yes = "$hardcode_into_libs"; then
+	  # Hardcode the library paths
+	  hardcode_libdirs=
+	  dep_rpath=
+	  rpath=$finalize_rpath
+	  test relink = "$opt_mode" || rpath=$compile_rpath$rpath
+	  for libdir in $rpath; do
+	    if test -n "$hardcode_libdir_flag_spec"; then
+	      if test -n "$hardcode_libdir_separator"; then
+		func_replace_sysroot "$libdir"
+		libdir=$func_replace_sysroot_result
+		if test -z "$hardcode_libdirs"; then
+		  hardcode_libdirs=$libdir
+		else
+		  # Just accumulate the unique libdirs.
+		  case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in
+		  *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
+		    ;;
+		  *)
+		    func_append hardcode_libdirs "$hardcode_libdir_separator$libdir"
+		    ;;
+		  esac
+		fi
+	      else
+		eval flag=\"$hardcode_libdir_flag_spec\"
+		func_append dep_rpath " $flag"
+	      fi
+	    elif test -n "$runpath_var"; then
+	      case "$perm_rpath " in
+	      *" $libdir "*) ;;
+	      *) func_append perm_rpath " $libdir" ;;
+	      esac
+	    fi
+	  done
+	  # Substitute the hardcoded libdirs into the rpath.
+	  if test -n "$hardcode_libdir_separator" &&
+	     test -n "$hardcode_libdirs"; then
+	    libdir=$hardcode_libdirs
+	    eval "dep_rpath=\"$hardcode_libdir_flag_spec\""
+	  fi
+	  if test -n "$runpath_var" && test -n "$perm_rpath"; then
+	    # We should set the runpath_var.
+	    rpath=
+	    for dir in $perm_rpath; do
+	      func_append rpath "$dir:"
+	    done
+	    eval "$runpath_var='$rpath\$$runpath_var'; export $runpath_var"
+	  fi
+	  test -n "$dep_rpath" && deplibs="$dep_rpath $deplibs"
+	fi
+
+	shlibpath=$finalize_shlibpath
+	test relink = "$opt_mode" || shlibpath=$compile_shlibpath$shlibpath
+	if test -n "$shlibpath"; then
+	  eval "$shlibpath_var='$shlibpath\$$shlibpath_var'; export $shlibpath_var"
+	fi
+
+	# Get the real and link names of the library.
+	eval shared_ext=\"$shrext_cmds\"
+	eval library_names=\"$library_names_spec\"
+	set dummy $library_names
+	shift
+	realname=$1
+	shift
+
+	if test -n "$soname_spec"; then
+	  eval soname=\"$soname_spec\"
+	else
+	  soname=$realname
+	fi
+	if test -z "$dlname"; then
+	  dlname=$soname
+	fi
+
+	lib=$output_objdir/$realname
+	linknames=
+	for link
+	do
+	  func_append linknames " $link"
+	done
+
+	# Use standard objects if they are pic
+	test -z "$pic_flag" && libobjs=`$ECHO "$libobjs" | $SP2NL | $SED "$lo2o" | $NL2SP`
+	test "X$libobjs" = "X " && libobjs=
+
+	delfiles=
+	if test -n "$export_symbols" && test -n "$include_expsyms"; then
+	  $opt_dry_run || cp "$export_symbols" "$output_objdir/$libname.uexp"
+	  export_symbols=$output_objdir/$libname.uexp
+	  func_append delfiles " $export_symbols"
+	fi
+
+	orig_export_symbols=
+	case $host_os in
+	cygwin* | mingw* | cegcc*)
+	  if test -n "$export_symbols" && test -z "$export_symbols_regex"; then
+	    # exporting using user supplied symfile
+	    func_dll_def_p "$export_symbols" || {
+	      # and it's NOT already a .def file. Must figure out
+	      # which of the given symbols are data symbols and tag
+	      # them as such. So, trigger use of export_symbols_cmds.
+	      # export_symbols gets reassigned inside the "prepare
+	      # the list of exported symbols" if statement, so the
+	      # include_expsyms logic still works.
+	      orig_export_symbols=$export_symbols
+	      export_symbols=
+	      always_export_symbols=yes
+	    }
+	  fi
+	  ;;
+	esac
+
+	# Prepare the list of exported symbols
+	if test -z "$export_symbols"; then
+	  if test yes = "$always_export_symbols" || test -n "$export_symbols_regex"; then
+	    func_verbose "generating symbol list for '$libname.la'"
+	    export_symbols=$output_objdir/$libname.exp
+	    $opt_dry_run || $RM $export_symbols
+	    cmds=$export_symbols_cmds
+	    save_ifs=$IFS; IFS='~'
+	    for cmd1 in $cmds; do
+	      IFS=$save_ifs
+	      # Take the normal branch if the nm_file_list_spec branch
+	      # doesn't work or if tool conversion is not needed.
+	      case $nm_file_list_spec~$to_tool_file_cmd in
+		*~func_convert_file_noop | *~func_convert_file_msys_to_w32 | ~*)
+		  try_normal_branch=yes
+		  eval cmd=\"$cmd1\"
+		  func_len " $cmd"
+		  len=$func_len_result
+		  ;;
+		*)
+		  try_normal_branch=no
+		  ;;
+	      esac
+	      if test yes = "$try_normal_branch" \
+		 && { test "$len" -lt "$max_cmd_len" \
+		      || test "$max_cmd_len" -le -1; }
+	      then
+		func_show_eval "$cmd" 'exit $?'
+		skipped_export=false
+	      elif test -n "$nm_file_list_spec"; then
+		func_basename "$output"
+		output_la=$func_basename_result
+		save_libobjs=$libobjs
+		save_output=$output
+		output=$output_objdir/$output_la.nm
+		func_to_tool_file "$output"
+		libobjs=$nm_file_list_spec$func_to_tool_file_result
+		func_append delfiles " $output"
+		func_verbose "creating $NM input file list: $output"
+		for obj in $save_libobjs; do
+		  func_to_tool_file "$obj"
+		  $ECHO "$func_to_tool_file_result"
+		done > "$output"
+		eval cmd=\"$cmd1\"
+		func_show_eval "$cmd" 'exit $?'
+		output=$save_output
+		libobjs=$save_libobjs
+		skipped_export=false
+	      else
+		# The command line is too long to execute in one step.
+		func_verbose "using reloadable object file for export list..."
+		skipped_export=:
+		# Break out early, otherwise skipped_export may be
+		# set to false by a later but shorter cmd.
+		break
+	      fi
+	    done
+	    IFS=$save_ifs
+	    if test -n "$export_symbols_regex" && test : != "$skipped_export"; then
+	      func_show_eval '$EGREP -e "$export_symbols_regex" "$export_symbols" > "${export_symbols}T"'
+	      func_show_eval '$MV "${export_symbols}T" "$export_symbols"'
+	    fi
+	  fi
+	fi
+
+	if test -n "$export_symbols" && test -n "$include_expsyms"; then
+	  tmp_export_symbols=$export_symbols
+	  test -n "$orig_export_symbols" && tmp_export_symbols=$orig_export_symbols
+	  $opt_dry_run || eval '$ECHO "$include_expsyms" | $SP2NL >> "$tmp_export_symbols"'
+	fi
+
+	if test : != "$skipped_export" && test -n "$orig_export_symbols"; then
+	  # The given exports_symbols file has to be filtered, so filter it.
+	  func_verbose "filter symbol list for '$libname.la' to tag DATA exports"
+	  # FIXME: $output_objdir/$libname.filter potentially contains lots of
+	  # 's' commands, which not all seds can handle. GNU sed should be fine
+	  # though. Also, the filter scales superlinearly with the number of
+	  # global variables. join(1) would be nice here, but unfortunately
+	  # isn't a blessed tool.
+	  $opt_dry_run || $SED -e '/[ ,]DATA/!d;s,\(.*\)\([ \,].*\),s|^\1$|\1\2|,' < $export_symbols > $output_objdir/$libname.filter
+	  func_append delfiles " $export_symbols $output_objdir/$libname.filter"
+	  export_symbols=$output_objdir/$libname.def
+	  $opt_dry_run || $SED -f $output_objdir/$libname.filter < $orig_export_symbols > $export_symbols
+	fi
+
+	tmp_deplibs=
+	for test_deplib in $deplibs; do
+	  case " $convenience " in
+	  *" $test_deplib "*) ;;
+	  *)
+	    func_append tmp_deplibs " $test_deplib"
+	    ;;
+	  esac
+	done
+	deplibs=$tmp_deplibs
+
+	if test -n "$convenience"; then
+	  if test -n "$whole_archive_flag_spec" &&
+	    test yes = "$compiler_needs_object" &&
+	    test -z "$libobjs"; then
+	    # extract the archives, so we have objects to list.
+	    # TODO: could optimize this to just extract one archive.
+	    whole_archive_flag_spec=
+	  fi
+	  if test -n "$whole_archive_flag_spec"; then
+	    save_libobjs=$libobjs
+	    eval libobjs=\"\$libobjs $whole_archive_flag_spec\"
+	    test "X$libobjs" = "X " && libobjs=
+	  else
+	    gentop=$output_objdir/${outputname}x
+	    func_append generated " $gentop"
+
+	    func_extract_archives $gentop $convenience
+	    func_append libobjs " $func_extract_archives_result"
+	    test "X$libobjs" = "X " && libobjs=
+	  fi
+	fi
+
+	if test yes = "$thread_safe" && test -n "$thread_safe_flag_spec"; then
+	  eval flag=\"$thread_safe_flag_spec\"
+	  func_append linker_flags " $flag"
+	fi
+
+	# Make a backup of the uninstalled library when relinking
+	if test relink = "$opt_mode"; then
+	  $opt_dry_run || eval '(cd $output_objdir && $RM ${realname}U && $MV $realname ${realname}U)' || exit $?
+	fi
+
+	# Do each of the archive commands.
+	if test yes = "$module" && test -n "$module_cmds"; then
+	  if test -n "$export_symbols" && test -n "$module_expsym_cmds"; then
+	    eval test_cmds=\"$module_expsym_cmds\"
+	    cmds=$module_expsym_cmds
+	  else
+	    eval test_cmds=\"$module_cmds\"
+	    cmds=$module_cmds
+	  fi
+	else
+	  if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then
+	    eval test_cmds=\"$archive_expsym_cmds\"
+	    cmds=$archive_expsym_cmds
+	  else
+	    eval test_cmds=\"$archive_cmds\"
+	    cmds=$archive_cmds
+	  fi
+	fi
+
+	if test : != "$skipped_export" &&
+	   func_len " $test_cmds" &&
+	   len=$func_len_result &&
+	   test "$len" -lt "$max_cmd_len" || test "$max_cmd_len" -le -1; then
+	  :
+	else
+	  # The command line is too long to link in one step, link piecewise
+	  # or, if using GNU ld and skipped_export is not :, use a linker
+	  # script.
+
+	  # Save the value of $output and $libobjs because we want to
+	  # use them later.  If we have whole_archive_flag_spec, we
+	  # want to use save_libobjs as it was before
+	  # whole_archive_flag_spec was expanded, because we can't
+	  # assume the linker understands whole_archive_flag_spec.
+	  # This may have to be revisited, in case too many
+	  # convenience libraries get linked in and end up exceeding
+	  # the spec.
+	  if test -z "$convenience" || test -z "$whole_archive_flag_spec"; then
+	    save_libobjs=$libobjs
+	  fi
+	  save_output=$output
+	  func_basename "$output"
+	  output_la=$func_basename_result
+
+	  # Clear the reloadable object creation command queue and
+	  # initialize k to one.
+	  test_cmds=
+	  concat_cmds=
+	  objlist=
+	  last_robj=
+	  k=1
+
+	  if test -n "$save_libobjs" && test : != "$skipped_export" && test yes = "$with_gnu_ld"; then
+	    output=$output_objdir/$output_la.lnkscript
+	    func_verbose "creating GNU ld script: $output"
+	    echo 'INPUT (' > $output
+	    for obj in $save_libobjs
+	    do
+	      func_to_tool_file "$obj"
+	      $ECHO "$func_to_tool_file_result" >> $output
+	    done
+	    echo ')' >> $output
+	    func_append delfiles " $output"
+	    func_to_tool_file "$output"
+	    output=$func_to_tool_file_result
+	  elif test -n "$save_libobjs" && test : != "$skipped_export" && test -n "$file_list_spec"; then
+	    output=$output_objdir/$output_la.lnk
+	    func_verbose "creating linker input file list: $output"
+	    : > $output
+	    set x $save_libobjs
+	    shift
+	    firstobj=
+	    if test yes = "$compiler_needs_object"; then
+	      firstobj="$1 "
+	      shift
+	    fi
+	    for obj
+	    do
+	      func_to_tool_file "$obj"
+	      $ECHO "$func_to_tool_file_result" >> $output
+	    done
+	    func_append delfiles " $output"
+	    func_to_tool_file "$output"
+	    output=$firstobj\"$file_list_spec$func_to_tool_file_result\"
+	  else
+	    if test -n "$save_libobjs"; then
+	      func_verbose "creating reloadable object files..."
+	      output=$output_objdir/$output_la-$k.$objext
+	      eval test_cmds=\"$reload_cmds\"
+	      func_len " $test_cmds"
+	      len0=$func_len_result
+	      len=$len0
+
+	      # Loop over the list of objects to be linked.
+	      for obj in $save_libobjs
+	      do
+		func_len " $obj"
+		func_arith $len + $func_len_result
+		len=$func_arith_result
+		if test -z "$objlist" ||
+		   test "$len" -lt "$max_cmd_len"; then
+		  func_append objlist " $obj"
+		else
+		  # The command $test_cmds is almost too long, add a
+		  # command to the queue.
+		  if test 1 -eq "$k"; then
+		    # The first file doesn't have a previous command to add.
+		    reload_objs=$objlist
+		    eval concat_cmds=\"$reload_cmds\"
+		  else
+		    # All subsequent reloadable object files will link in
+		    # the last one created.
+		    reload_objs="$objlist $last_robj"
+		    eval concat_cmds=\"\$concat_cmds~$reload_cmds~\$RM $last_robj\"
+		  fi
+		  last_robj=$output_objdir/$output_la-$k.$objext
+		  func_arith $k + 1
+		  k=$func_arith_result
+		  output=$output_objdir/$output_la-$k.$objext
+		  objlist=" $obj"
+		  func_len " $last_robj"
+		  func_arith $len0 + $func_len_result
+		  len=$func_arith_result
+		fi
+	      done
+	      # Handle the remaining objects by creating one last
+	      # reloadable object file.  All subsequent reloadable object
+	      # files will link in the last one created.
+	      test -z "$concat_cmds" || concat_cmds=$concat_cmds~
+	      reload_objs="$objlist $last_robj"
+	      eval concat_cmds=\"\$concat_cmds$reload_cmds\"
+	      if test -n "$last_robj"; then
+	        eval concat_cmds=\"\$concat_cmds~\$RM $last_robj\"
+	      fi
+	      func_append delfiles " $output"
+
+	    else
+	      output=
+	    fi
+
+	    ${skipped_export-false} && {
+	      func_verbose "generating symbol list for '$libname.la'"
+	      export_symbols=$output_objdir/$libname.exp
+	      $opt_dry_run || $RM $export_symbols
+	      libobjs=$output
+	      # Append the command to create the export file.
+	      test -z "$concat_cmds" || concat_cmds=$concat_cmds~
+	      eval concat_cmds=\"\$concat_cmds$export_symbols_cmds\"
+	      if test -n "$last_robj"; then
+		eval concat_cmds=\"\$concat_cmds~\$RM $last_robj\"
+	      fi
+	    }
+
+	    test -n "$save_libobjs" &&
+	      func_verbose "creating a temporary reloadable object file: $output"
+
+	    # Loop through the commands generated above and execute them.
+	    save_ifs=$IFS; IFS='~'
+	    for cmd in $concat_cmds; do
+	      IFS=$save_ifs
+	      $opt_quiet || {
+		  func_quote_arg expand,pretty "$cmd"
+		  eval "func_echo $func_quote_arg_result"
+	      }
+	      $opt_dry_run || eval "$cmd" || {
+		lt_exit=$?
+
+		# Restore the uninstalled library and exit
+		if test relink = "$opt_mode"; then
+		  ( cd "$output_objdir" && \
+		    $RM "${realname}T" && \
+		    $MV "${realname}U" "$realname" )
+		fi
+
+		exit $lt_exit
+	      }
+	    done
+	    IFS=$save_ifs
+
+	    if test -n "$export_symbols_regex" && ${skipped_export-false}; then
+	      func_show_eval '$EGREP -e "$export_symbols_regex" "$export_symbols" > "${export_symbols}T"'
+	      func_show_eval '$MV "${export_symbols}T" "$export_symbols"'
+	    fi
+	  fi
+
+          ${skipped_export-false} && {
+	    if test -n "$export_symbols" && test -n "$include_expsyms"; then
+	      tmp_export_symbols=$export_symbols
+	      test -n "$orig_export_symbols" && tmp_export_symbols=$orig_export_symbols
+	      $opt_dry_run || eval '$ECHO "$include_expsyms" | $SP2NL >> "$tmp_export_symbols"'
+	    fi
+
+	    if test -n "$orig_export_symbols"; then
+	      # The given exports_symbols file has to be filtered, so filter it.
+	      func_verbose "filter symbol list for '$libname.la' to tag DATA exports"
+	      # FIXME: $output_objdir/$libname.filter potentially contains lots of
+	      # 's' commands, which not all seds can handle. GNU sed should be fine
+	      # though. Also, the filter scales superlinearly with the number of
+	      # global variables. join(1) would be nice here, but unfortunately
+	      # isn't a blessed tool.
+	      $opt_dry_run || $SED -e '/[ ,]DATA/!d;s,\(.*\)\([ \,].*\),s|^\1$|\1\2|,' < $export_symbols > $output_objdir/$libname.filter
+	      func_append delfiles " $export_symbols $output_objdir/$libname.filter"
+	      export_symbols=$output_objdir/$libname.def
+	      $opt_dry_run || $SED -f $output_objdir/$libname.filter < $orig_export_symbols > $export_symbols
+	    fi
+	  }
+
+	  libobjs=$output
+	  # Restore the value of output.
+	  output=$save_output
+
+	  if test -n "$convenience" && test -n "$whole_archive_flag_spec"; then
+	    eval libobjs=\"\$libobjs $whole_archive_flag_spec\"
+	    test "X$libobjs" = "X " && libobjs=
+	  fi
+	  # Expand the library linking commands again to reset the
+	  # value of $libobjs for piecewise linking.
+
+	  # Do each of the archive commands.
+	  if test yes = "$module" && test -n "$module_cmds"; then
+	    if test -n "$export_symbols" && test -n "$module_expsym_cmds"; then
+	      cmds=$module_expsym_cmds
+	    else
+	      cmds=$module_cmds
+	    fi
+	  else
+	    if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then
+	      cmds=$archive_expsym_cmds
+	    else
+	      cmds=$archive_cmds
+	    fi
+	  fi
+	fi
+
+	if test -n "$delfiles"; then
+	  # Append the command to remove temporary files to $cmds.
+	  eval cmds=\"\$cmds~\$RM $delfiles\"
+	fi
+
+	# Add any objects from preloaded convenience libraries
+	if test -n "$dlprefiles"; then
+	  gentop=$output_objdir/${outputname}x
+	  func_append generated " $gentop"
+
+	  func_extract_archives $gentop $dlprefiles
+	  func_append libobjs " $func_extract_archives_result"
+	  test "X$libobjs" = "X " && libobjs=
+	fi
+
+	save_ifs=$IFS; IFS='~'
+	for cmd in $cmds; do
+	  IFS=$sp$nl
+	  eval cmd=\"$cmd\"
+	  IFS=$save_ifs
+	  $opt_quiet || {
+	    func_quote_arg expand,pretty "$cmd"
+	    eval "func_echo $func_quote_arg_result"
+	  }
+	  $opt_dry_run || eval "$cmd" || {
+	    lt_exit=$?
+
+	    # Restore the uninstalled library and exit
+	    if test relink = "$opt_mode"; then
+	      ( cd "$output_objdir" && \
+	        $RM "${realname}T" && \
+		$MV "${realname}U" "$realname" )
+	    fi
+
+	    exit $lt_exit
+	  }
+	done
+	IFS=$save_ifs
+
+	# Restore the uninstalled library and exit
+	if test relink = "$opt_mode"; then
+	  $opt_dry_run || eval '(cd $output_objdir && $RM ${realname}T && $MV $realname ${realname}T && $MV ${realname}U $realname)' || exit $?
+
+	  if test -n "$convenience"; then
+	    if test -z "$whole_archive_flag_spec"; then
+	      func_show_eval '${RM}r "$gentop"'
+	    fi
+	  fi
+
+	  exit $EXIT_SUCCESS
+	fi
+
+	# Create links to the real library.
+	for linkname in $linknames; do
+	  if test "$realname" != "$linkname"; then
+	    func_show_eval '(cd "$output_objdir" && $RM "$linkname" && $LN_S "$realname" "$linkname")' 'exit $?'
+	  fi
+	done
+
+	# If -module or -export-dynamic was specified, set the dlname.
+	if test yes = "$module" || test yes = "$export_dynamic"; then
+	  # On all known operating systems, these are identical.
+	  dlname=$soname
+	fi
+      fi
+      ;;
+
+    obj)
+      if test -n "$dlfiles$dlprefiles" || test no != "$dlself"; then
+	func_warning "'-dlopen' is ignored for objects"
+      fi
+
+      case " $deplibs" in
+      *\ -l* | *\ -L*)
+	func_warning "'-l' and '-L' are ignored for objects" ;;
+      esac
+
+      test -n "$rpath" && \
+	func_warning "'-rpath' is ignored for objects"
+
+      test -n "$xrpath" && \
+	func_warning "'-R' is ignored for objects"
+
+      test -n "$vinfo" && \
+	func_warning "'-version-info' is ignored for objects"
+
+      test -n "$release" && \
+	func_warning "'-release' is ignored for objects"
+
+      case $output in
+      *.lo)
+	test -n "$objs$old_deplibs" && \
+	  func_fatal_error "cannot build library object '$output' from non-libtool objects"
+
+	libobj=$output
+	func_lo2o "$libobj"
+	obj=$func_lo2o_result
+	;;
+      *)
+	libobj=
+	obj=$output
+	;;
+      esac
+
+      # Delete the old objects.
+      $opt_dry_run || $RM $obj $libobj
+
+      # Objects from convenience libraries.  This assumes
+      # single-version convenience libraries.  Whenever we create
+      # different ones for PIC/non-PIC, this we'll have to duplicate
+      # the extraction.
+      reload_conv_objs=
+      gentop=
+      # if reload_cmds runs $LD directly, get rid of -Wl from
+      # whole_archive_flag_spec and hope we can get by with turning comma
+      # into space.
+      case $reload_cmds in
+        *\$LD[\ \$]*) wl= ;;
+      esac
+      if test -n "$convenience"; then
+	if test -n "$whole_archive_flag_spec"; then
+	  eval tmp_whole_archive_flags=\"$whole_archive_flag_spec\"
+	  test -n "$wl" || tmp_whole_archive_flags=`$ECHO "$tmp_whole_archive_flags" | $SED 's|,| |g'`
+	  reload_conv_objs=$reload_objs\ $tmp_whole_archive_flags
+	else
+	  gentop=$output_objdir/${obj}x
+	  func_append generated " $gentop"
+
+	  func_extract_archives $gentop $convenience
+	  reload_conv_objs="$reload_objs $func_extract_archives_result"
+	fi
+      fi
+
+      # If we're not building shared, we need to use non_pic_objs
+      test yes = "$build_libtool_libs" || libobjs=$non_pic_objects
+
+      # Create the old-style object.
+      reload_objs=$objs$old_deplibs' '`$ECHO "$libobjs" | $SP2NL | $SED "/\.$libext$/d; /\.lib$/d; $lo2o" | $NL2SP`' '$reload_conv_objs
+
+      output=$obj
+      func_execute_cmds "$reload_cmds" 'exit $?'
+
+      # Exit if we aren't doing a library object file.
+      if test -z "$libobj"; then
+	if test -n "$gentop"; then
+	  func_show_eval '${RM}r "$gentop"'
+	fi
+
+	exit $EXIT_SUCCESS
+      fi
+
+      test yes = "$build_libtool_libs" || {
+	if test -n "$gentop"; then
+	  func_show_eval '${RM}r "$gentop"'
+	fi
+
+	# Create an invalid libtool object if no PIC, so that we don't
+	# accidentally link it into a program.
+	# $show "echo timestamp > $libobj"
+	# $opt_dry_run || eval "echo timestamp > $libobj" || exit $?
+	exit $EXIT_SUCCESS
+      }
+
+      if test -n "$pic_flag" || test default != "$pic_mode"; then
+	# Only do commands if we really have different PIC objects.
+	reload_objs="$libobjs $reload_conv_objs"
+	output=$libobj
+	func_execute_cmds "$reload_cmds" 'exit $?'
+      fi
+
+      if test -n "$gentop"; then
+	func_show_eval '${RM}r "$gentop"'
+      fi
+
+      exit $EXIT_SUCCESS
+      ;;
+
+    prog)
+      case $host in
+	*cygwin*) func_stripname '' '.exe' "$output"
+	          output=$func_stripname_result.exe;;
+      esac
+      test -n "$vinfo" && \
+	func_warning "'-version-info' is ignored for programs"
+
+      test -n "$release" && \
+	func_warning "'-release' is ignored for programs"
+
+      $preload \
+	&& test unknown,unknown,unknown = "$dlopen_support,$dlopen_self,$dlopen_self_static" \
+	&& func_warning "'LT_INIT([dlopen])' not used. Assuming no dlopen support."
+
+      case $host in
+      *-*-rhapsody* | *-*-darwin1.[012])
+	# On Rhapsody replace the C library is the System framework
+	compile_deplibs=`$ECHO " $compile_deplibs" | $SED 's/ -lc / System.ltframework /'`
+	finalize_deplibs=`$ECHO " $finalize_deplibs" | $SED 's/ -lc / System.ltframework /'`
+	;;
+      esac
+
+      case $host in
+      *-*-darwin*)
+	# Don't allow lazy linking, it breaks C++ global constructors
+	# But is supposedly fixed on 10.4 or later (yay!).
+	if test CXX = "$tagname"; then
+	  case ${MACOSX_DEPLOYMENT_TARGET-10.0} in
+	    10.[0123])
+	      func_append compile_command " $wl-bind_at_load"
+	      func_append finalize_command " $wl-bind_at_load"
+	    ;;
+	  esac
+	fi
+	# Time to change all our "foo.ltframework" stuff back to "-framework foo"
+	compile_deplibs=`$ECHO " $compile_deplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
+	finalize_deplibs=`$ECHO " $finalize_deplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
+	;;
+      esac
+
+
+      # move library search paths that coincide with paths to not yet
+      # installed libraries to the beginning of the library search list
+      new_libs=
+      for path in $notinst_path; do
+	case " $new_libs " in
+	*" -L$path/$objdir "*) ;;
+	*)
+	  case " $compile_deplibs " in
+	  *" -L$path/$objdir "*)
+	    func_append new_libs " -L$path/$objdir" ;;
+	  esac
+	  ;;
+	esac
+      done
+      for deplib in $compile_deplibs; do
+	case $deplib in
+	-L*)
+	  case " $new_libs " in
+	  *" $deplib "*) ;;
+	  *) func_append new_libs " $deplib" ;;
+	  esac
+	  ;;
+	*) func_append new_libs " $deplib" ;;
+	esac
+      done
+      compile_deplibs=$new_libs
+
+
+      func_append compile_command " $compile_deplibs"
+      func_append finalize_command " $finalize_deplibs"
+
+      if test -n "$rpath$xrpath"; then
+	# If the user specified any rpath flags, then add them.
+	for libdir in $rpath $xrpath; do
+	  # This is the magic to use -rpath.
+	  case "$finalize_rpath " in
+	  *" $libdir "*) ;;
+	  *) func_append finalize_rpath " $libdir" ;;
+	  esac
+	done
+      fi
+
+      # Now hardcode the library paths
+      rpath=
+      hardcode_libdirs=
+      for libdir in $compile_rpath $finalize_rpath; do
+	if test -n "$hardcode_libdir_flag_spec"; then
+	  if test -n "$hardcode_libdir_separator"; then
+	    if test -z "$hardcode_libdirs"; then
+	      hardcode_libdirs=$libdir
+	    else
+	      # Just accumulate the unique libdirs.
+	      case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in
+	      *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
+		;;
+	      *)
+		func_append hardcode_libdirs "$hardcode_libdir_separator$libdir"
+		;;
+	      esac
+	    fi
+	  else
+	    eval flag=\"$hardcode_libdir_flag_spec\"
+	    func_append rpath " $flag"
+	  fi
+	elif test -n "$runpath_var"; then
+	  case "$perm_rpath " in
+	  *" $libdir "*) ;;
+	  *) func_append perm_rpath " $libdir" ;;
+	  esac
+	fi
+	case $host in
+	*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-cegcc*)
+	  testbindir=`$ECHO "$libdir" | $SED -e 's*/lib$*/bin*'`
+	  case :$dllsearchpath: in
+	  *":$libdir:"*) ;;
+	  ::) dllsearchpath=$libdir;;
+	  *) func_append dllsearchpath ":$libdir";;
+	  esac
+	  case :$dllsearchpath: in
+	  *":$testbindir:"*) ;;
+	  ::) dllsearchpath=$testbindir;;
+	  *) func_append dllsearchpath ":$testbindir";;
+	  esac
+	  ;;
+	esac
+      done
+      # Substitute the hardcoded libdirs into the rpath.
+      if test -n "$hardcode_libdir_separator" &&
+	 test -n "$hardcode_libdirs"; then
+	libdir=$hardcode_libdirs
+	eval rpath=\" $hardcode_libdir_flag_spec\"
+      fi
+      compile_rpath=$rpath
+
+      rpath=
+      hardcode_libdirs=
+      for libdir in $finalize_rpath; do
+	if test -n "$hardcode_libdir_flag_spec"; then
+	  if test -n "$hardcode_libdir_separator"; then
+	    if test -z "$hardcode_libdirs"; then
+	      hardcode_libdirs=$libdir
+	    else
+	      # Just accumulate the unique libdirs.
+	      case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in
+	      *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
+		;;
+	      *)
+		func_append hardcode_libdirs "$hardcode_libdir_separator$libdir"
+		;;
+	      esac
+	    fi
+	  else
+	    eval flag=\"$hardcode_libdir_flag_spec\"
+	    func_append rpath " $flag"
+	  fi
+	elif test -n "$runpath_var"; then
+	  case "$finalize_perm_rpath " in
+	  *" $libdir "*) ;;
+	  *) func_append finalize_perm_rpath " $libdir" ;;
+	  esac
+	fi
+      done
+      # Substitute the hardcoded libdirs into the rpath.
+      if test -n "$hardcode_libdir_separator" &&
+	 test -n "$hardcode_libdirs"; then
+	libdir=$hardcode_libdirs
+	eval rpath=\" $hardcode_libdir_flag_spec\"
+      fi
+      finalize_rpath=$rpath
+
+      if test -n "$libobjs" && test yes = "$build_old_libs"; then
+	# Transform all the library objects into standard objects.
+	compile_command=`$ECHO "$compile_command" | $SP2NL | $SED "$lo2o" | $NL2SP`
+	finalize_command=`$ECHO "$finalize_command" | $SP2NL | $SED "$lo2o" | $NL2SP`
+      fi
+
+      func_generate_dlsyms "$outputname" "@PROGRAM@" false
+
+      # template prelinking step
+      if test -n "$prelink_cmds"; then
+	func_execute_cmds "$prelink_cmds" 'exit $?'
+      fi
+
+      wrappers_required=:
+      case $host in
+      *cegcc* | *mingw32ce*)
+        # Disable wrappers for cegcc and mingw32ce hosts, we are cross compiling anyway.
+        wrappers_required=false
+        ;;
+      *cygwin* | *mingw* )
+        test yes = "$build_libtool_libs" || wrappers_required=false
+        ;;
+      *)
+        if test no = "$need_relink" || test yes != "$build_libtool_libs"; then
+          wrappers_required=false
+        fi
+        ;;
+      esac
+      $wrappers_required || {
+	# Replace the output file specification.
+	compile_command=`$ECHO "$compile_command" | $SED 's%@OUTPUT@%'"$output"'%g'`
+	link_command=$compile_command$compile_rpath
+
+	# We have no uninstalled library dependencies, so finalize right now.
+	exit_status=0
+	func_show_eval "$link_command" 'exit_status=$?'
+
+	if test -n "$postlink_cmds"; then
+	  func_to_tool_file "$output"
+	  postlink_cmds=`func_echo_all "$postlink_cmds" | $SED -e 's%@OUTPUT@%'"$output"'%g' -e 's%@TOOL_OUTPUT@%'"$func_to_tool_file_result"'%g'`
+	  func_execute_cmds "$postlink_cmds" 'exit $?'
+	fi
+
+	# Delete the generated files.
+	if test -f "$output_objdir/${outputname}S.$objext"; then
+	  func_show_eval '$RM "$output_objdir/${outputname}S.$objext"'
+	fi
+
+	exit $exit_status
+      }
+
+      if test -n "$compile_shlibpath$finalize_shlibpath"; then
+	compile_command="$shlibpath_var=\"$compile_shlibpath$finalize_shlibpath\$$shlibpath_var\" $compile_command"
+      fi
+      if test -n "$finalize_shlibpath"; then
+	finalize_command="$shlibpath_var=\"$finalize_shlibpath\$$shlibpath_var\" $finalize_command"
+      fi
+
+      compile_var=
+      finalize_var=
+      if test -n "$runpath_var"; then
+	if test -n "$perm_rpath"; then
+	  # We should set the runpath_var.
+	  rpath=
+	  for dir in $perm_rpath; do
+	    func_append rpath "$dir:"
+	  done
+	  compile_var="$runpath_var=\"$rpath\$$runpath_var\" "
+	fi
+	if test -n "$finalize_perm_rpath"; then
+	  # We should set the runpath_var.
+	  rpath=
+	  for dir in $finalize_perm_rpath; do
+	    func_append rpath "$dir:"
+	  done
+	  finalize_var="$runpath_var=\"$rpath\$$runpath_var\" "
+	fi
+      fi
+
+      if test yes = "$no_install"; then
+	# We don't need to create a wrapper script.
+	link_command=$compile_var$compile_command$compile_rpath
+	# Replace the output file specification.
+	link_command=`$ECHO "$link_command" | $SED 's%@OUTPUT@%'"$output"'%g'`
+	# Delete the old output file.
+	$opt_dry_run || $RM $output
+	# Link the executable and exit
+	func_show_eval "$link_command" 'exit $?'
+
+	if test -n "$postlink_cmds"; then
+	  func_to_tool_file "$output"
+	  postlink_cmds=`func_echo_all "$postlink_cmds" | $SED -e 's%@OUTPUT@%'"$output"'%g' -e 's%@TOOL_OUTPUT@%'"$func_to_tool_file_result"'%g'`
+	  func_execute_cmds "$postlink_cmds" 'exit $?'
+	fi
+
+	exit $EXIT_SUCCESS
+      fi
+
+      case $hardcode_action,$fast_install in
+        relink,*)
+	  # Fast installation is not supported
+	  link_command=$compile_var$compile_command$compile_rpath
+	  relink_command=$finalize_var$finalize_command$finalize_rpath
+
+	  func_warning "this platform does not like uninstalled shared libraries"
+	  func_warning "'$output' will be relinked during installation"
+	  ;;
+        *,yes)
+	  link_command=$finalize_var$compile_command$finalize_rpath
+	  relink_command=`$ECHO "$compile_var$compile_command$compile_rpath" | $SED 's%@OUTPUT@%\$progdir/\$file%g'`
+          ;;
+	*,no)
+	  link_command=$compile_var$compile_command$compile_rpath
+	  relink_command=$finalize_var$finalize_command$finalize_rpath
+          ;;
+	*,needless)
+	  link_command=$finalize_var$compile_command$finalize_rpath
+	  relink_command=
+          ;;
+      esac
+
+      # Replace the output file specification.
+      link_command=`$ECHO "$link_command" | $SED 's%@OUTPUT@%'"$output_objdir/$outputname"'%g'`
+
+      # Delete the old output files.
+      $opt_dry_run || $RM $output $output_objdir/$outputname $output_objdir/lt-$outputname
+
+      func_show_eval "$link_command" 'exit $?'
+
+      if test -n "$postlink_cmds"; then
+	func_to_tool_file "$output_objdir/$outputname"
+	postlink_cmds=`func_echo_all "$postlink_cmds" | $SED -e 's%@OUTPUT@%'"$output_objdir/$outputname"'%g' -e 's%@TOOL_OUTPUT@%'"$func_to_tool_file_result"'%g'`
+	func_execute_cmds "$postlink_cmds" 'exit $?'
+      fi
+
+      # Now create the wrapper script.
+      func_verbose "creating $output"
+
+      # Quote the relink command for shipping.
+      if test -n "$relink_command"; then
+	# Preserve any variables that may affect compiler behavior
+	for var in $variables_saved_for_relink; do
+	  if eval test -z \"\${$var+set}\"; then
+	    relink_command="{ test -z \"\${$var+set}\" || $lt_unset $var || { $var=; export $var; }; }; $relink_command"
+	  elif eval var_value=\$$var; test -z "$var_value"; then
+	    relink_command="$var=; export $var; $relink_command"
+	  else
+	    func_quote_arg pretty "$var_value"
+	    relink_command="$var=$func_quote_arg_result; export $var; $relink_command"
+	  fi
+	done
+	func_quote_arg pretty,unquoted "(cd `pwd`; $relink_command)"
+	relink_command=$func_quote_arg_unquoted_result
+      fi
+
+      # Only actually do things if not in dry run mode.
+      $opt_dry_run || {
+	# win32 will think the script is a binary if it has
+	# a .exe suffix, so we strip it off here.
+	case $output in
+	  *.exe) func_stripname '' '.exe' "$output"
+	         output=$func_stripname_result ;;
+	esac
+	# test for cygwin because mv fails w/o .exe extensions
+	case $host in
+	  *cygwin*)
+	    exeext=.exe
+	    func_stripname '' '.exe' "$outputname"
+	    outputname=$func_stripname_result ;;
+	  *) exeext= ;;
+	esac
+	case $host in
+	  *cygwin* | *mingw* )
+	    func_dirname_and_basename "$output" "" "."
+	    output_name=$func_basename_result
+	    output_path=$func_dirname_result
+	    cwrappersource=$output_path/$objdir/lt-$output_name.c
+	    cwrapper=$output_path/$output_name.exe
+	    $RM $cwrappersource $cwrapper
+	    trap "$RM $cwrappersource $cwrapper; exit $EXIT_FAILURE" 1 2 15
+
+	    func_emit_cwrapperexe_src > $cwrappersource
+
+	    # The wrapper executable is built using the $host compiler,
+	    # because it contains $host paths and files. If cross-
+	    # compiling, it, like the target executable, must be
+	    # executed on the $host or under an emulation environment.
+	    $opt_dry_run || {
+	      $LTCC $LTCFLAGS -o $cwrapper $cwrappersource
+	      $STRIP $cwrapper
+	    }
+
+	    # Now, create the wrapper script for func_source use:
+	    func_ltwrapper_scriptname $cwrapper
+	    $RM $func_ltwrapper_scriptname_result
+	    trap "$RM $func_ltwrapper_scriptname_result; exit $EXIT_FAILURE" 1 2 15
+	    $opt_dry_run || {
+	      # note: this script will not be executed, so do not chmod.
+	      if test "x$build" = "x$host"; then
+		$cwrapper --lt-dump-script > $func_ltwrapper_scriptname_result
+	      else
+		func_emit_wrapper no > $func_ltwrapper_scriptname_result
+	      fi
+	    }
+	  ;;
+	  * )
+	    $RM $output
+	    trap "$RM $output; exit $EXIT_FAILURE" 1 2 15
+
+	    func_emit_wrapper no > $output
+	    chmod +x $output
+	  ;;
+	esac
+      }
+      exit $EXIT_SUCCESS
+      ;;
+    esac
+
+    # See if we need to build an old-fashioned archive.
+    for oldlib in $oldlibs; do
+
+      case $build_libtool_libs in
+        convenience)
+	  oldobjs="$libobjs_save $symfileobj"
+	  addlibs=$convenience
+	  build_libtool_libs=no
+	  ;;
+	module)
+	  oldobjs=$libobjs_save
+	  addlibs=$old_convenience
+	  build_libtool_libs=no
+          ;;
+	*)
+	  oldobjs="$old_deplibs $non_pic_objects"
+	  $preload && test -f "$symfileobj" \
+	    && func_append oldobjs " $symfileobj"
+	  addlibs=$old_convenience
+	  ;;
+      esac
+
+      if test -n "$addlibs"; then
+	gentop=$output_objdir/${outputname}x
+	func_append generated " $gentop"
+
+	func_extract_archives $gentop $addlibs
+	func_append oldobjs " $func_extract_archives_result"
+      fi
+
+      # Do each command in the archive commands.
+      if test -n "$old_archive_from_new_cmds" && test yes = "$build_libtool_libs"; then
+	cmds=$old_archive_from_new_cmds
+      else
+
+	# Add any objects from preloaded convenience libraries
+	if test -n "$dlprefiles"; then
+	  gentop=$output_objdir/${outputname}x
+	  func_append generated " $gentop"
+
+	  func_extract_archives $gentop $dlprefiles
+	  func_append oldobjs " $func_extract_archives_result"
+	fi
+
+	# POSIX demands no paths to be encoded in archives.  We have
+	# to avoid creating archives with duplicate basenames if we
+	# might have to extract them afterwards, e.g., when creating a
+	# static archive out of a convenience library, or when linking
+	# the entirety of a libtool archive into another (currently
+	# not supported by libtool).
+	if (for obj in $oldobjs
+	    do
+	      func_basename "$obj"
+	      $ECHO "$func_basename_result"
+	    done | sort | sort -uc >/dev/null 2>&1); then
+	  :
+	else
+	  echo "copying selected object files to avoid basename conflicts..."
+	  gentop=$output_objdir/${outputname}x
+	  func_append generated " $gentop"
+	  func_mkdir_p "$gentop"
+	  save_oldobjs=$oldobjs
+	  oldobjs=
+	  counter=1
+	  for obj in $save_oldobjs
+	  do
+	    func_basename "$obj"
+	    objbase=$func_basename_result
+	    case " $oldobjs " in
+	    " ") oldobjs=$obj ;;
+	    *[\ /]"$objbase "*)
+	      while :; do
+		# Make sure we don't pick an alternate name that also
+		# overlaps.
+		newobj=lt$counter-$objbase
+		func_arith $counter + 1
+		counter=$func_arith_result
+		case " $oldobjs " in
+		*[\ /]"$newobj "*) ;;
+		*) if test ! -f "$gentop/$newobj"; then break; fi ;;
+		esac
+	      done
+	      func_show_eval "ln $obj $gentop/$newobj || cp $obj $gentop/$newobj"
+	      func_append oldobjs " $gentop/$newobj"
+	      ;;
+	    *) func_append oldobjs " $obj" ;;
+	    esac
+	  done
+	fi
+	func_to_tool_file "$oldlib" func_convert_file_msys_to_w32
+	tool_oldlib=$func_to_tool_file_result
+	eval cmds=\"$old_archive_cmds\"
+
+	func_len " $cmds"
+	len=$func_len_result
+	if test "$len" -lt "$max_cmd_len" || test "$max_cmd_len" -le -1; then
+	  cmds=$old_archive_cmds
+	elif test -n "$archiver_list_spec"; then
+	  func_verbose "using command file archive linking..."
+	  for obj in $oldobjs
+	  do
+	    func_to_tool_file "$obj"
+	    $ECHO "$func_to_tool_file_result"
+	  done > $output_objdir/$libname.libcmd
+	  func_to_tool_file "$output_objdir/$libname.libcmd"
+	  oldobjs=" $archiver_list_spec$func_to_tool_file_result"
+	  cmds=$old_archive_cmds
+	else
+	  # the command line is too long to link in one step, link in parts
+	  func_verbose "using piecewise archive linking..."
+	  save_RANLIB=$RANLIB
+	  RANLIB=:
+	  objlist=
+	  concat_cmds=
+	  save_oldobjs=$oldobjs
+	  oldobjs=
+	  # Is there a better way of finding the last object in the list?
+	  for obj in $save_oldobjs
+	  do
+	    last_oldobj=$obj
+	  done
+	  eval test_cmds=\"$old_archive_cmds\"
+	  func_len " $test_cmds"
+	  len0=$func_len_result
+	  len=$len0
+	  for obj in $save_oldobjs
+	  do
+	    func_len " $obj"
+	    func_arith $len + $func_len_result
+	    len=$func_arith_result
+	    func_append objlist " $obj"
+	    if test "$len" -lt "$max_cmd_len"; then
+	      :
+	    else
+	      # the above command should be used before it gets too long
+	      oldobjs=$objlist
+	      if test "$obj" = "$last_oldobj"; then
+		RANLIB=$save_RANLIB
+	      fi
+	      test -z "$concat_cmds" || concat_cmds=$concat_cmds~
+	      eval concat_cmds=\"\$concat_cmds$old_archive_cmds\"
+	      objlist=
+	      len=$len0
+	    fi
+	  done
+	  RANLIB=$save_RANLIB
+	  oldobjs=$objlist
+	  if test -z "$oldobjs"; then
+	    eval cmds=\"\$concat_cmds\"
+	  else
+	    eval cmds=\"\$concat_cmds~\$old_archive_cmds\"
+	  fi
+	fi
+      fi
+      func_execute_cmds "$cmds" 'exit $?'
+    done
+
+    test -n "$generated" && \
+      func_show_eval "${RM}r$generated"
+
+    # Now create the libtool archive.
+    case $output in
+    *.la)
+      old_library=
+      test yes = "$build_old_libs" && old_library=$libname.$libext
+      func_verbose "creating $output"
+
+      # Preserve any variables that may affect compiler behavior
+      for var in $variables_saved_for_relink; do
+	if eval test -z \"\${$var+set}\"; then
+	  relink_command="{ test -z \"\${$var+set}\" || $lt_unset $var || { $var=; export $var; }; }; $relink_command"
+	elif eval var_value=\$$var; test -z "$var_value"; then
+	  relink_command="$var=; export $var; $relink_command"
+	else
+	  func_quote_arg pretty,unquoted "$var_value"
+	  relink_command="$var=$func_quote_arg_unquoted_result; export $var; $relink_command"
+	fi
+      done
+      # Quote the link command for shipping.
+      relink_command="(cd `pwd`; $SHELL \"$progpath\" $preserve_args --mode=relink $libtool_args @inst_prefix_dir@)"
+      func_quote_arg pretty,unquoted "$relink_command"
+      relink_command=$func_quote_arg_unquoted_result
+      if test yes = "$hardcode_automatic"; then
+	relink_command=
+      fi
+
+      # Only create the output if not a dry run.
+      $opt_dry_run || {
+	for installed in no yes; do
+	  if test yes = "$installed"; then
+	    if test -z "$install_libdir"; then
+	      break
+	    fi
+	    output=$output_objdir/${outputname}i
+	    # Replace all uninstalled libtool libraries with the installed ones
+	    newdependency_libs=
+	    for deplib in $dependency_libs; do
+	      case $deplib in
+	      *.la)
+		func_basename "$deplib"
+		name=$func_basename_result
+		func_resolve_sysroot "$deplib"
+		eval libdir=`$SED -n -e 's/^libdir=\(.*\)$/\1/p' $func_resolve_sysroot_result`
+		test -z "$libdir" && \
+		  func_fatal_error "'$deplib' is not a valid libtool archive"
+		func_append newdependency_libs " ${lt_sysroot:+=}$libdir/$name"
+		;;
+	      -L*)
+		func_stripname -L '' "$deplib"
+		func_replace_sysroot "$func_stripname_result"
+		func_append newdependency_libs " -L$func_replace_sysroot_result"
+		;;
+	      -R*)
+		func_stripname -R '' "$deplib"
+		func_replace_sysroot "$func_stripname_result"
+		func_append newdependency_libs " -R$func_replace_sysroot_result"
+		;;
+	      *) func_append newdependency_libs " $deplib" ;;
+	      esac
+	    done
+	    dependency_libs=$newdependency_libs
+	    newdlfiles=
+
+	    for lib in $dlfiles; do
+	      case $lib in
+	      *.la)
+	        func_basename "$lib"
+		name=$func_basename_result
+		eval libdir=`$SED -n -e 's/^libdir=\(.*\)$/\1/p' $lib`
+		test -z "$libdir" && \
+		  func_fatal_error "'$lib' is not a valid libtool archive"
+		func_append newdlfiles " ${lt_sysroot:+=}$libdir/$name"
+		;;
+	      *) func_append newdlfiles " $lib" ;;
+	      esac
+	    done
+	    dlfiles=$newdlfiles
+	    newdlprefiles=
+	    for lib in $dlprefiles; do
+	      case $lib in
+	      *.la)
+		# Only pass preopened files to the pseudo-archive (for
+		# eventual linking with the app. that links it) if we
+		# didn't already link the preopened objects directly into
+		# the library:
+		func_basename "$lib"
+		name=$func_basename_result
+		eval libdir=`$SED -n -e 's/^libdir=\(.*\)$/\1/p' $lib`
+		test -z "$libdir" && \
+		  func_fatal_error "'$lib' is not a valid libtool archive"
+		func_append newdlprefiles " ${lt_sysroot:+=}$libdir/$name"
+		;;
+	      esac
+	    done
+	    dlprefiles=$newdlprefiles
+	  else
+	    newdlfiles=
+	    for lib in $dlfiles; do
+	      case $lib in
+		[\\/]* | [A-Za-z]:[\\/]*) abs=$lib ;;
+		*) abs=`pwd`"/$lib" ;;
+	      esac
+	      func_append newdlfiles " $abs"
+	    done
+	    dlfiles=$newdlfiles
+	    newdlprefiles=
+	    for lib in $dlprefiles; do
+	      case $lib in
+		[\\/]* | [A-Za-z]:[\\/]*) abs=$lib ;;
+		*) abs=`pwd`"/$lib" ;;
+	      esac
+	      func_append newdlprefiles " $abs"
+	    done
+	    dlprefiles=$newdlprefiles
+	  fi
+	  $RM $output
+	  # place dlname in correct position for cygwin
+	  # In fact, it would be nice if we could use this code for all target
+	  # systems that can't hard-code library paths into their executables
+	  # and that have no shared library path variable independent of PATH,
+	  # but it turns out we can't easily determine that from inspecting
+	  # libtool variables, so we have to hard-code the OSs to which it
+	  # applies here; at the moment, that means platforms that use the PE
+	  # object format with DLL files.  See the long comment at the top of
+	  # tests/bindir.at for full details.
+	  tdlname=$dlname
+	  case $host,$output,$installed,$module,$dlname in
+	    *cygwin*,*lai,yes,no,*.dll | *mingw*,*lai,yes,no,*.dll | *cegcc*,*lai,yes,no,*.dll)
+	      # If a -bindir argument was supplied, place the dll there.
+	      if test -n "$bindir"; then
+		func_relative_path "$install_libdir" "$bindir"
+		tdlname=$func_relative_path_result/$dlname
+	      else
+		# Otherwise fall back on heuristic.
+		tdlname=../bin/$dlname
+	      fi
+	      ;;
+	  esac
+	  $ECHO > $output "\
+# $outputname - a libtool library file
+# Generated by $PROGRAM (GNU $PACKAGE) $VERSION
+#
+# Please DO NOT delete this file!
+# It is necessary for linking the library.
+
+# The name that we can dlopen(3).
+dlname='$tdlname'
+
+# Names of this library.
+library_names='$library_names'
+
+# The name of the static archive.
+old_library='$old_library'
+
+# Linker flags that cannot go in dependency_libs.
+inherited_linker_flags='$new_inherited_linker_flags'
+
+# Libraries that this one depends upon.
+dependency_libs='$dependency_libs'
+
+# Names of additional weak libraries provided by this library
+weak_library_names='$weak_libs'
+
+# Version information for $libname.
+current=$current
+age=$age
+revision=$revision
+
+# Is this an already installed library?
+installed=$installed
+
+# Should we warn about portability when linking against -modules?
+shouldnotlink=$module
+
+# Files to dlopen/dlpreopen
+dlopen='$dlfiles'
+dlpreopen='$dlprefiles'
+
+# Directory that this library needs to be installed in:
+libdir='$install_libdir'"
+	  if test no,yes = "$installed,$need_relink"; then
+	    $ECHO >> $output "\
+relink_command=\"$relink_command\""
+	  fi
+	done
+      }
+
+      # Do a symbolic link so that the libtool archive can be found in
+      # LD_LIBRARY_PATH before the program is installed.
+      func_show_eval '( cd "$output_objdir" && $RM "$outputname" && $LN_S "../$outputname" "$outputname" )' 'exit $?'
+      ;;
+    esac
+    exit $EXIT_SUCCESS
+}
+
+if test link = "$opt_mode" || test relink = "$opt_mode"; then
+  func_mode_link ${1+"$@"}
+fi
+
+
+# func_mode_uninstall arg...
+func_mode_uninstall ()
+{
+    $debug_cmd
+
+    RM=$nonopt
+    files=
+    rmforce=false
+    exit_status=0
+
+    # This variable tells wrapper scripts just to set variables rather
+    # than running their programs.
+    libtool_install_magic=$magic
+
+    for arg
+    do
+      case $arg in
+      -f) func_append RM " $arg"; rmforce=: ;;
+      -*) func_append RM " $arg" ;;
+      *) func_append files " $arg" ;;
+      esac
+    done
+
+    test -z "$RM" && \
+      func_fatal_help "you must specify an RM program"
+
+    rmdirs=
+
+    for file in $files; do
+      func_dirname "$file" "" "."
+      dir=$func_dirname_result
+      if test . = "$dir"; then
+	odir=$objdir
+      else
+	odir=$dir/$objdir
+      fi
+      func_basename "$file"
+      name=$func_basename_result
+      test uninstall = "$opt_mode" && odir=$dir
+
+      # Remember odir for removal later, being careful to avoid duplicates
+      if test clean = "$opt_mode"; then
+	case " $rmdirs " in
+	  *" $odir "*) ;;
+	  *) func_append rmdirs " $odir" ;;
+	esac
+      fi
+
+      # Don't error if the file doesn't exist and rm -f was used.
+      if { test -L "$file"; } >/dev/null 2>&1 ||
+	 { test -h "$file"; } >/dev/null 2>&1 ||
+	 test -f "$file"; then
+	:
+      elif test -d "$file"; then
+	exit_status=1
+	continue
+      elif $rmforce; then
+	continue
+      fi
+
+      rmfiles=$file
+
+      case $name in
+      *.la)
+	# Possibly a libtool archive, so verify it.
+	if func_lalib_p "$file"; then
+	  func_source $dir/$name
+
+	  # Delete the libtool libraries and symlinks.
+	  for n in $library_names; do
+	    func_append rmfiles " $odir/$n"
+	  done
+	  test -n "$old_library" && func_append rmfiles " $odir/$old_library"
+
+	  case $opt_mode in
+	  clean)
+	    case " $library_names " in
+	    *" $dlname "*) ;;
+	    *) test -n "$dlname" && func_append rmfiles " $odir/$dlname" ;;
+	    esac
+	    test -n "$libdir" && func_append rmfiles " $odir/$name $odir/${name}i"
+	    ;;
+	  uninstall)
+	    if test -n "$library_names"; then
+	      # Do each command in the postuninstall commands.
+	      func_execute_cmds "$postuninstall_cmds" '$rmforce || exit_status=1'
+	    fi
+
+	    if test -n "$old_library"; then
+	      # Do each command in the old_postuninstall commands.
+	      func_execute_cmds "$old_postuninstall_cmds" '$rmforce || exit_status=1'
+	    fi
+	    # FIXME: should reinstall the best remaining shared library.
+	    ;;
+	  esac
+	fi
+	;;
+
+      *.lo)
+	# Possibly a libtool object, so verify it.
+	if func_lalib_p "$file"; then
+
+	  # Read the .lo file
+	  func_source $dir/$name
+
+	  # Add PIC object to the list of files to remove.
+	  if test -n "$pic_object" && test none != "$pic_object"; then
+	    func_append rmfiles " $dir/$pic_object"
+	  fi
+
+	  # Add non-PIC object to the list of files to remove.
+	  if test -n "$non_pic_object" && test none != "$non_pic_object"; then
+	    func_append rmfiles " $dir/$non_pic_object"
+	  fi
+	fi
+	;;
+
+      *)
+	if test clean = "$opt_mode"; then
+	  noexename=$name
+	  case $file in
+	  *.exe)
+	    func_stripname '' '.exe' "$file"
+	    file=$func_stripname_result
+	    func_stripname '' '.exe' "$name"
+	    noexename=$func_stripname_result
+	    # $file with .exe has already been added to rmfiles,
+	    # add $file without .exe
+	    func_append rmfiles " $file"
+	    ;;
+	  esac
+	  # Do a test to see if this is a libtool program.
+	  if func_ltwrapper_p "$file"; then
+	    if func_ltwrapper_executable_p "$file"; then
+	      func_ltwrapper_scriptname "$file"
+	      relink_command=
+	      func_source $func_ltwrapper_scriptname_result
+	      func_append rmfiles " $func_ltwrapper_scriptname_result"
+	    else
+	      relink_command=
+	      func_source $dir/$noexename
+	    fi
+
+	    # note $name still contains .exe if it was in $file originally
+	    # as does the version of $file that was added into $rmfiles
+	    func_append rmfiles " $odir/$name $odir/${name}S.$objext"
+	    if test yes = "$fast_install" && test -n "$relink_command"; then
+	      func_append rmfiles " $odir/lt-$name"
+	    fi
+	    if test "X$noexename" != "X$name"; then
+	      func_append rmfiles " $odir/lt-$noexename.c"
+	    fi
+	  fi
+	fi
+	;;
+      esac
+      func_show_eval "$RM $rmfiles" 'exit_status=1'
+    done
+
+    # Try to remove the $objdir's in the directories where we deleted files
+    for dir in $rmdirs; do
+      if test -d "$dir"; then
+	func_show_eval "rmdir $dir >/dev/null 2>&1"
+      fi
+    done
+
+    exit $exit_status
+}
+
+if test uninstall = "$opt_mode" || test clean = "$opt_mode"; then
+  func_mode_uninstall ${1+"$@"}
+fi
+
+test -z "$opt_mode" && {
+  help=$generic_help
+  func_fatal_help "you must specify a MODE"
+}
+
+test -z "$exec_cmd" && \
+  func_fatal_help "invalid operation mode '$opt_mode'"
+
+if test -n "$exec_cmd"; then
+  eval exec "$exec_cmd"
+  exit $EXIT_FAILURE
+fi
+
+exit $exit_status
+
+
+# The TAGs below are defined such that we never get into a situation
+# where we disable both kinds of libraries.  Given conflicting
+# choices, we go for a static library, that is the most portable,
+# since we can't tell whether shared libraries were disabled because
+# the user asked for that or because the platform doesn't support
+# them.  This is particularly important on AIX, because we don't
+# support having both static and shared libraries enabled at the same
+# time on that platform, so we default to a shared-only configuration.
+# If a disable-shared tag is given, we'll fallback to a static-only
+# configuration.  But we'll never go from static-only to shared-only.
+
+# ### BEGIN LIBTOOL TAG CONFIG: disable-shared
+build_libtool_libs=no
+build_old_libs=yes
+# ### END LIBTOOL TAG CONFIG: disable-shared
+
+# ### BEGIN LIBTOOL TAG CONFIG: disable-static
+build_old_libs=`case $build_libtool_libs in yes) echo no;; *) echo yes;; esac`
+# ### END LIBTOOL TAG CONFIG: disable-static
+
+# Local Variables:
+# mode:shell-script
+# sh-indentation:2
+# End:
diff --git a/build-aux/ltoptions.m4 b/build-aux/ltoptions.m4
new file mode 100644
index 00000000..94b08297
--- /dev/null
+++ b/build-aux/ltoptions.m4
@@ -0,0 +1,437 @@
+# Helper functions for option handling.                    -*- Autoconf -*-
+#
+#   Copyright (C) 2004-2005, 2007-2009, 2011-2015 Free Software
+#   Foundation, Inc.
+#   Written by Gary V. Vaughan, 2004
+#
+# This file is free software; the Free Software Foundation gives
+# unlimited permission to copy and/or distribute it, with or without
+# modifications, as long as this notice is preserved.
+
+# serial 8 ltoptions.m4
+
+# This is to help aclocal find these macros, as it can't see m4_define.
+AC_DEFUN([LTOPTIONS_VERSION], [m4_if([1])])
+
+
+# _LT_MANGLE_OPTION(MACRO-NAME, OPTION-NAME)
+# ------------------------------------------
+m4_define([_LT_MANGLE_OPTION],
+[[_LT_OPTION_]m4_bpatsubst($1__$2, [[^a-zA-Z0-9_]], [_])])
+
+
+# _LT_SET_OPTION(MACRO-NAME, OPTION-NAME)
+# ---------------------------------------
+# Set option OPTION-NAME for macro MACRO-NAME, and if there is a
+# matching handler defined, dispatch to it.  Other OPTION-NAMEs are
+# saved as a flag.
+m4_define([_LT_SET_OPTION],
+[m4_define(_LT_MANGLE_OPTION([$1], [$2]))dnl
+m4_ifdef(_LT_MANGLE_DEFUN([$1], [$2]),
+        _LT_MANGLE_DEFUN([$1], [$2]),
+    [m4_warning([Unknown $1 option '$2'])])[]dnl
+])
+
+
+# _LT_IF_OPTION(MACRO-NAME, OPTION-NAME, IF-SET, [IF-NOT-SET])
+# ------------------------------------------------------------
+# Execute IF-SET if OPTION is set, IF-NOT-SET otherwise.
+m4_define([_LT_IF_OPTION],
+[m4_ifdef(_LT_MANGLE_OPTION([$1], [$2]), [$3], [$4])])
+
+
+# _LT_UNLESS_OPTIONS(MACRO-NAME, OPTION-LIST, IF-NOT-SET)
+# -------------------------------------------------------
+# Execute IF-NOT-SET unless all options in OPTION-LIST for MACRO-NAME
+# are set.
+m4_define([_LT_UNLESS_OPTIONS],
+[m4_foreach([_LT_Option], m4_split(m4_normalize([$2])),
+	    [m4_ifdef(_LT_MANGLE_OPTION([$1], _LT_Option),
+		      [m4_define([$0_found])])])[]dnl
+m4_ifdef([$0_found], [m4_undefine([$0_found])], [$3
+])[]dnl
+])
+
+
+# _LT_SET_OPTIONS(MACRO-NAME, OPTION-LIST)
+# ----------------------------------------
+# OPTION-LIST is a space-separated list of Libtool options associated
+# with MACRO-NAME.  If any OPTION has a matching handler declared with
+# LT_OPTION_DEFINE, dispatch to that macro; otherwise complain about
+# the unknown option and exit.
+m4_defun([_LT_SET_OPTIONS],
+[# Set options
+m4_foreach([_LT_Option], m4_split(m4_normalize([$2])),
+    [_LT_SET_OPTION([$1], _LT_Option)])
+
+m4_if([$1],[LT_INIT],[
+  dnl
+  dnl Simply set some default values (i.e off) if boolean options were not
+  dnl specified:
+  _LT_UNLESS_OPTIONS([LT_INIT], [dlopen], [enable_dlopen=no
+  ])
+  _LT_UNLESS_OPTIONS([LT_INIT], [win32-dll], [enable_win32_dll=no
+  ])
+  dnl
+  dnl If no reference was made to various pairs of opposing options, then
+  dnl we run the default mode handler for the pair.  For example, if neither
+  dnl 'shared' nor 'disable-shared' was passed, we enable building of shared
+  dnl archives by default:
+  _LT_UNLESS_OPTIONS([LT_INIT], [shared disable-shared], [_LT_ENABLE_SHARED])
+  _LT_UNLESS_OPTIONS([LT_INIT], [static disable-static], [_LT_ENABLE_STATIC])
+  _LT_UNLESS_OPTIONS([LT_INIT], [pic-only no-pic], [_LT_WITH_PIC])
+  _LT_UNLESS_OPTIONS([LT_INIT], [fast-install disable-fast-install],
+		   [_LT_ENABLE_FAST_INSTALL])
+  _LT_UNLESS_OPTIONS([LT_INIT], [aix-soname=aix aix-soname=both aix-soname=svr4],
+		   [_LT_WITH_AIX_SONAME([aix])])
+  ])
+])# _LT_SET_OPTIONS
+
+
+## --------------------------------- ##
+## Macros to handle LT_INIT options. ##
+## --------------------------------- ##
+
+# _LT_MANGLE_DEFUN(MACRO-NAME, OPTION-NAME)
+# -----------------------------------------
+m4_define([_LT_MANGLE_DEFUN],
+[[_LT_OPTION_DEFUN_]m4_bpatsubst(m4_toupper([$1__$2]), [[^A-Z0-9_]], [_])])
+
+
+# LT_OPTION_DEFINE(MACRO-NAME, OPTION-NAME, CODE)
+# -----------------------------------------------
+m4_define([LT_OPTION_DEFINE],
+[m4_define(_LT_MANGLE_DEFUN([$1], [$2]), [$3])[]dnl
+])# LT_OPTION_DEFINE
+
+
+# dlopen
+# ------
+LT_OPTION_DEFINE([LT_INIT], [dlopen], [enable_dlopen=yes
+])
+
+AU_DEFUN([AC_LIBTOOL_DLOPEN],
+[_LT_SET_OPTION([LT_INIT], [dlopen])
+AC_DIAGNOSE([obsolete],
+[$0: Remove this warning and the call to _LT_SET_OPTION when you
+put the 'dlopen' option into LT_INIT's first parameter.])
+])
+
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([AC_LIBTOOL_DLOPEN], [])
+
+
+# win32-dll
+# ---------
+# Declare package support for building win32 dll's.
+LT_OPTION_DEFINE([LT_INIT], [win32-dll],
+[enable_win32_dll=yes
+
+case $host in
+*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-cegcc*)
+  AC_CHECK_TOOL(AS, as, false)
+  AC_CHECK_TOOL(DLLTOOL, dlltool, false)
+  AC_CHECK_TOOL(OBJDUMP, objdump, false)
+  ;;
+esac
+
+test -z "$AS" && AS=as
+_LT_DECL([], [AS],      [1], [Assembler program])dnl
+
+test -z "$DLLTOOL" && DLLTOOL=dlltool
+_LT_DECL([], [DLLTOOL], [1], [DLL creation program])dnl
+
+test -z "$OBJDUMP" && OBJDUMP=objdump
+_LT_DECL([], [OBJDUMP], [1], [Object dumper program])dnl
+])# win32-dll
+
+AU_DEFUN([AC_LIBTOOL_WIN32_DLL],
+[AC_REQUIRE([AC_CANONICAL_HOST])dnl
+_LT_SET_OPTION([LT_INIT], [win32-dll])
+AC_DIAGNOSE([obsolete],
+[$0: Remove this warning and the call to _LT_SET_OPTION when you
+put the 'win32-dll' option into LT_INIT's first parameter.])
+])
+
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([AC_LIBTOOL_WIN32_DLL], [])
+
+
+# _LT_ENABLE_SHARED([DEFAULT])
+# ----------------------------
+# implement the --enable-shared flag, and supports the 'shared' and
+# 'disable-shared' LT_INIT options.
+# DEFAULT is either 'yes' or 'no'.  If omitted, it defaults to 'yes'.
+m4_define([_LT_ENABLE_SHARED],
+[m4_define([_LT_ENABLE_SHARED_DEFAULT], [m4_if($1, no, no, yes)])dnl
+AC_ARG_ENABLE([shared],
+    [AS_HELP_STRING([--enable-shared@<:@=PKGS@:>@],
+	[build shared libraries @<:@default=]_LT_ENABLE_SHARED_DEFAULT[@:>@])],
+    [p=${PACKAGE-default}
+    case $enableval in
+    yes) enable_shared=yes ;;
+    no) enable_shared=no ;;
+    *)
+      enable_shared=no
+      # Look at the argument we got.  We use all the common list separators.
+      lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR,
+      for pkg in $enableval; do
+	IFS=$lt_save_ifs
+	if test "X$pkg" = "X$p"; then
+	  enable_shared=yes
+	fi
+      done
+      IFS=$lt_save_ifs
+      ;;
+    esac],
+    [enable_shared=]_LT_ENABLE_SHARED_DEFAULT)
+
+    _LT_DECL([build_libtool_libs], [enable_shared], [0],
+	[Whether or not to build shared libraries])
+])# _LT_ENABLE_SHARED
+
+LT_OPTION_DEFINE([LT_INIT], [shared], [_LT_ENABLE_SHARED([yes])])
+LT_OPTION_DEFINE([LT_INIT], [disable-shared], [_LT_ENABLE_SHARED([no])])
+
+# Old names:
+AC_DEFUN([AC_ENABLE_SHARED],
+[_LT_SET_OPTION([LT_INIT], m4_if([$1], [no], [disable-])[shared])
+])
+
+AC_DEFUN([AC_DISABLE_SHARED],
+[_LT_SET_OPTION([LT_INIT], [disable-shared])
+])
+
+AU_DEFUN([AM_ENABLE_SHARED], [AC_ENABLE_SHARED($@)])
+AU_DEFUN([AM_DISABLE_SHARED], [AC_DISABLE_SHARED($@)])
+
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([AM_ENABLE_SHARED], [])
+dnl AC_DEFUN([AM_DISABLE_SHARED], [])
+
+
+
+# _LT_ENABLE_STATIC([DEFAULT])
+# ----------------------------
+# implement the --enable-static flag, and support the 'static' and
+# 'disable-static' LT_INIT options.
+# DEFAULT is either 'yes' or 'no'.  If omitted, it defaults to 'yes'.
+m4_define([_LT_ENABLE_STATIC],
+[m4_define([_LT_ENABLE_STATIC_DEFAULT], [m4_if($1, no, no, yes)])dnl
+AC_ARG_ENABLE([static],
+    [AS_HELP_STRING([--enable-static@<:@=PKGS@:>@],
+	[build static libraries @<:@default=]_LT_ENABLE_STATIC_DEFAULT[@:>@])],
+    [p=${PACKAGE-default}
+    case $enableval in
+    yes) enable_static=yes ;;
+    no) enable_static=no ;;
+    *)
+     enable_static=no
+      # Look at the argument we got.  We use all the common list separators.
+      lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR,
+      for pkg in $enableval; do
+	IFS=$lt_save_ifs
+	if test "X$pkg" = "X$p"; then
+	  enable_static=yes
+	fi
+      done
+      IFS=$lt_save_ifs
+      ;;
+    esac],
+    [enable_static=]_LT_ENABLE_STATIC_DEFAULT)
+
+    _LT_DECL([build_old_libs], [enable_static], [0],
+	[Whether or not to build static libraries])
+])# _LT_ENABLE_STATIC
+
+LT_OPTION_DEFINE([LT_INIT], [static], [_LT_ENABLE_STATIC([yes])])
+LT_OPTION_DEFINE([LT_INIT], [disable-static], [_LT_ENABLE_STATIC([no])])
+
+# Old names:
+AC_DEFUN([AC_ENABLE_STATIC],
+[_LT_SET_OPTION([LT_INIT], m4_if([$1], [no], [disable-])[static])
+])
+
+AC_DEFUN([AC_DISABLE_STATIC],
+[_LT_SET_OPTION([LT_INIT], [disable-static])
+])
+
+AU_DEFUN([AM_ENABLE_STATIC], [AC_ENABLE_STATIC($@)])
+AU_DEFUN([AM_DISABLE_STATIC], [AC_DISABLE_STATIC($@)])
+
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([AM_ENABLE_STATIC], [])
+dnl AC_DEFUN([AM_DISABLE_STATIC], [])
+
+
+
+# _LT_ENABLE_FAST_INSTALL([DEFAULT])
+# ----------------------------------
+# implement the --enable-fast-install flag, and support the 'fast-install'
+# and 'disable-fast-install' LT_INIT options.
+# DEFAULT is either 'yes' or 'no'.  If omitted, it defaults to 'yes'.
+m4_define([_LT_ENABLE_FAST_INSTALL],
+[m4_define([_LT_ENABLE_FAST_INSTALL_DEFAULT], [m4_if($1, no, no, yes)])dnl
+AC_ARG_ENABLE([fast-install],
+    [AS_HELP_STRING([--enable-fast-install@<:@=PKGS@:>@],
+    [optimize for fast installation @<:@default=]_LT_ENABLE_FAST_INSTALL_DEFAULT[@:>@])],
+    [p=${PACKAGE-default}
+    case $enableval in
+    yes) enable_fast_install=yes ;;
+    no) enable_fast_install=no ;;
+    *)
+      enable_fast_install=no
+      # Look at the argument we got.  We use all the common list separators.
+      lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR,
+      for pkg in $enableval; do
+	IFS=$lt_save_ifs
+	if test "X$pkg" = "X$p"; then
+	  enable_fast_install=yes
+	fi
+      done
+      IFS=$lt_save_ifs
+      ;;
+    esac],
+    [enable_fast_install=]_LT_ENABLE_FAST_INSTALL_DEFAULT)
+
+_LT_DECL([fast_install], [enable_fast_install], [0],
+	 [Whether or not to optimize for fast installation])dnl
+])# _LT_ENABLE_FAST_INSTALL
+
+LT_OPTION_DEFINE([LT_INIT], [fast-install], [_LT_ENABLE_FAST_INSTALL([yes])])
+LT_OPTION_DEFINE([LT_INIT], [disable-fast-install], [_LT_ENABLE_FAST_INSTALL([no])])
+
+# Old names:
+AU_DEFUN([AC_ENABLE_FAST_INSTALL],
+[_LT_SET_OPTION([LT_INIT], m4_if([$1], [no], [disable-])[fast-install])
+AC_DIAGNOSE([obsolete],
+[$0: Remove this warning and the call to _LT_SET_OPTION when you put
+the 'fast-install' option into LT_INIT's first parameter.])
+])
+
+AU_DEFUN([AC_DISABLE_FAST_INSTALL],
+[_LT_SET_OPTION([LT_INIT], [disable-fast-install])
+AC_DIAGNOSE([obsolete],
+[$0: Remove this warning and the call to _LT_SET_OPTION when you put
+the 'disable-fast-install' option into LT_INIT's first parameter.])
+])
+
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([AC_ENABLE_FAST_INSTALL], [])
+dnl AC_DEFUN([AM_DISABLE_FAST_INSTALL], [])
+
+
+# _LT_WITH_AIX_SONAME([DEFAULT])
+# ----------------------------------
+# implement the --with-aix-soname flag, and support the `aix-soname=aix'
+# and `aix-soname=both' and `aix-soname=svr4' LT_INIT options. DEFAULT
+# is either `aix', `both' or `svr4'.  If omitted, it defaults to `aix'.
+m4_define([_LT_WITH_AIX_SONAME],
+[m4_define([_LT_WITH_AIX_SONAME_DEFAULT], [m4_if($1, svr4, svr4, m4_if($1, both, both, aix))])dnl
+shared_archive_member_spec=
+case $host,$enable_shared in
+power*-*-aix[[5-9]]*,yes)
+  AC_MSG_CHECKING([which variant of shared library versioning to provide])
+  AC_ARG_WITH([aix-soname],
+    [AS_HELP_STRING([--with-aix-soname=aix|svr4|both],
+      [shared library versioning (aka "SONAME") variant to provide on AIX, @<:@default=]_LT_WITH_AIX_SONAME_DEFAULT[@:>@.])],
+    [case $withval in
+    aix|svr4|both)
+      ;;
+    *)
+      AC_MSG_ERROR([Unknown argument to --with-aix-soname])
+      ;;
+    esac
+    lt_cv_with_aix_soname=$with_aix_soname],
+    [AC_CACHE_VAL([lt_cv_with_aix_soname],
+      [lt_cv_with_aix_soname=]_LT_WITH_AIX_SONAME_DEFAULT)
+    with_aix_soname=$lt_cv_with_aix_soname])
+  AC_MSG_RESULT([$with_aix_soname])
+  if test aix != "$with_aix_soname"; then
+    # For the AIX way of multilib, we name the shared archive member
+    # based on the bitwidth used, traditionally 'shr.o' or 'shr_64.o',
+    # and 'shr.imp' or 'shr_64.imp', respectively, for the Import File.
+    # Even when GNU compilers ignore OBJECT_MODE but need '-maix64' flag,
+    # the AIX toolchain works better with OBJECT_MODE set (default 32).
+    if test 64 = "${OBJECT_MODE-32}"; then
+      shared_archive_member_spec=shr_64
+    else
+      shared_archive_member_spec=shr
+    fi
+  fi
+  ;;
+*)
+  with_aix_soname=aix
+  ;;
+esac
+
+_LT_DECL([], [shared_archive_member_spec], [0],
+    [Shared archive member basename, for filename based shared library versioning on AIX])dnl
+])# _LT_WITH_AIX_SONAME
+
+LT_OPTION_DEFINE([LT_INIT], [aix-soname=aix], [_LT_WITH_AIX_SONAME([aix])])
+LT_OPTION_DEFINE([LT_INIT], [aix-soname=both], [_LT_WITH_AIX_SONAME([both])])
+LT_OPTION_DEFINE([LT_INIT], [aix-soname=svr4], [_LT_WITH_AIX_SONAME([svr4])])
+
+
+# _LT_WITH_PIC([MODE])
+# --------------------
+# implement the --with-pic flag, and support the 'pic-only' and 'no-pic'
+# LT_INIT options.
+# MODE is either 'yes' or 'no'.  If omitted, it defaults to 'both'.
+m4_define([_LT_WITH_PIC],
+[AC_ARG_WITH([pic],
+    [AS_HELP_STRING([--with-pic@<:@=PKGS@:>@],
+	[try to use only PIC/non-PIC objects @<:@default=use both@:>@])],
+    [lt_p=${PACKAGE-default}
+    case $withval in
+    yes|no) pic_mode=$withval ;;
+    *)
+      pic_mode=default
+      # Look at the argument we got.  We use all the common list separators.
+      lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR,
+      for lt_pkg in $withval; do
+	IFS=$lt_save_ifs
+	if test "X$lt_pkg" = "X$lt_p"; then
+	  pic_mode=yes
+	fi
+      done
+      IFS=$lt_save_ifs
+      ;;
+    esac],
+    [pic_mode=m4_default([$1], [default])])
+
+_LT_DECL([], [pic_mode], [0], [What type of objects to build])dnl
+])# _LT_WITH_PIC
+
+LT_OPTION_DEFINE([LT_INIT], [pic-only], [_LT_WITH_PIC([yes])])
+LT_OPTION_DEFINE([LT_INIT], [no-pic], [_LT_WITH_PIC([no])])
+
+# Old name:
+AU_DEFUN([AC_LIBTOOL_PICMODE],
+[_LT_SET_OPTION([LT_INIT], [pic-only])
+AC_DIAGNOSE([obsolete],
+[$0: Remove this warning and the call to _LT_SET_OPTION when you
+put the 'pic-only' option into LT_INIT's first parameter.])
+])
+
+dnl aclocal-1.4 backwards compatibility:
+dnl AC_DEFUN([AC_LIBTOOL_PICMODE], [])
+
+## ----------------- ##
+## LTDL_INIT Options ##
+## ----------------- ##
+
+m4_define([_LTDL_MODE], [])
+LT_OPTION_DEFINE([LTDL_INIT], [nonrecursive],
+		 [m4_define([_LTDL_MODE], [nonrecursive])])
+LT_OPTION_DEFINE([LTDL_INIT], [recursive],
+		 [m4_define([_LTDL_MODE], [recursive])])
+LT_OPTION_DEFINE([LTDL_INIT], [subproject],
+		 [m4_define([_LTDL_MODE], [subproject])])
+
+m4_define([_LTDL_TYPE], [])
+LT_OPTION_DEFINE([LTDL_INIT], [installable],
+		 [m4_define([_LTDL_TYPE], [installable])])
+LT_OPTION_DEFINE([LTDL_INIT], [convenience],
+		 [m4_define([_LTDL_TYPE], [convenience])])
diff --git a/build-aux/ltsugar.m4 b/build-aux/ltsugar.m4
new file mode 100644
index 00000000..48bc9344
--- /dev/null
+++ b/build-aux/ltsugar.m4
@@ -0,0 +1,124 @@
+# ltsugar.m4 -- libtool m4 base layer.                         -*-Autoconf-*-
+#
+# Copyright (C) 2004-2005, 2007-2008, 2011-2015 Free Software
+# Foundation, Inc.
+# Written by Gary V. Vaughan, 2004
+#
+# This file is free software; the Free Software Foundation gives
+# unlimited permission to copy and/or distribute it, with or without
+# modifications, as long as this notice is preserved.
+
+# serial 6 ltsugar.m4
+
+# This is to help aclocal find these macros, as it can't see m4_define.
+AC_DEFUN([LTSUGAR_VERSION], [m4_if([0.1])])
+
+
+# lt_join(SEP, ARG1, [ARG2...])
+# -----------------------------
+# Produce ARG1SEPARG2...SEPARGn, omitting [] arguments and their
+# associated separator.
+# Needed until we can rely on m4_join from Autoconf 2.62, since all earlier
+# versions in m4sugar had bugs.
+m4_define([lt_join],
+[m4_if([$#], [1], [],
+       [$#], [2], [[$2]],
+       [m4_if([$2], [], [], [[$2]_])$0([$1], m4_shift(m4_shift($@)))])])
+m4_define([_lt_join],
+[m4_if([$#$2], [2], [],
+       [m4_if([$2], [], [], [[$1$2]])$0([$1], m4_shift(m4_shift($@)))])])
+
+
+# lt_car(LIST)
+# lt_cdr(LIST)
+# ------------
+# Manipulate m4 lists.
+# These macros are necessary as long as will still need to support
+# Autoconf-2.59, which quotes differently.
+m4_define([lt_car], [[$1]])
+m4_define([lt_cdr],
+[m4_if([$#], 0, [m4_fatal([$0: cannot be called without arguments])],
+       [$#], 1, [],
+       [m4_dquote(m4_shift($@))])])
+m4_define([lt_unquote], $1)
+
+
+# lt_append(MACRO-NAME, STRING, [SEPARATOR])
+# ------------------------------------------
+# Redefine MACRO-NAME to hold its former content plus 'SEPARATOR''STRING'.
+# Note that neither SEPARATOR nor STRING are expanded; they are appended
+# to MACRO-NAME as is (leaving the expansion for when MACRO-NAME is invoked).
+# No SEPARATOR is output if MACRO-NAME was previously undefined (different
+# than defined and empty).
+#
+# This macro is needed until we can rely on Autoconf 2.62, since earlier
+# versions of m4sugar mistakenly expanded SEPARATOR but not STRING.
+m4_define([lt_append],
+[m4_define([$1],
+	   m4_ifdef([$1], [m4_defn([$1])[$3]])[$2])])
+
+
+
+# lt_combine(SEP, PREFIX-LIST, INFIX, SUFFIX1, [SUFFIX2...])
+# ----------------------------------------------------------
+# Produce a SEP delimited list of all paired combinations of elements of
+# PREFIX-LIST with SUFFIX1 through SUFFIXn.  Each element of the list
+# has the form PREFIXmINFIXSUFFIXn.
+# Needed until we can rely on m4_combine added in Autoconf 2.62.
+m4_define([lt_combine],
+[m4_if(m4_eval([$# > 3]), [1],
+       [m4_pushdef([_Lt_sep], [m4_define([_Lt_sep], m4_defn([lt_car]))])]]dnl
+[[m4_foreach([_Lt_prefix], [$2],
+	     [m4_foreach([_Lt_suffix],
+		]m4_dquote(m4_dquote(m4_shift(m4_shift(m4_shift($@)))))[,
+	[_Lt_sep([$1])[]m4_defn([_Lt_prefix])[$3]m4_defn([_Lt_suffix])])])])])
+
+
+# lt_if_append_uniq(MACRO-NAME, VARNAME, [SEPARATOR], [UNIQ], [NOT-UNIQ])
+# -----------------------------------------------------------------------
+# Iff MACRO-NAME does not yet contain VARNAME, then append it (delimited
+# by SEPARATOR if supplied) and expand UNIQ, else NOT-UNIQ.
+m4_define([lt_if_append_uniq],
+[m4_ifdef([$1],
+	  [m4_if(m4_index([$3]m4_defn([$1])[$3], [$3$2$3]), [-1],
+		 [lt_append([$1], [$2], [$3])$4],
+		 [$5])],
+	  [lt_append([$1], [$2], [$3])$4])])
+
+
+# lt_dict_add(DICT, KEY, VALUE)
+# -----------------------------
+m4_define([lt_dict_add],
+[m4_define([$1($2)], [$3])])
+
+
+# lt_dict_add_subkey(DICT, KEY, SUBKEY, VALUE)
+# --------------------------------------------
+m4_define([lt_dict_add_subkey],
+[m4_define([$1($2:$3)], [$4])])
+
+
+# lt_dict_fetch(DICT, KEY, [SUBKEY])
+# ----------------------------------
+m4_define([lt_dict_fetch],
+[m4_ifval([$3],
+	m4_ifdef([$1($2:$3)], [m4_defn([$1($2:$3)])]),
+    m4_ifdef([$1($2)], [m4_defn([$1($2)])]))])
+
+
+# lt_if_dict_fetch(DICT, KEY, [SUBKEY], VALUE, IF-TRUE, [IF-FALSE])
+# -----------------------------------------------------------------
+m4_define([lt_if_dict_fetch],
+[m4_if(lt_dict_fetch([$1], [$2], [$3]), [$4],
+	[$5],
+    [$6])])
+
+
+# lt_dict_filter(DICT, [SUBKEY], VALUE, [SEPARATOR], KEY, [...])
+# --------------------------------------------------------------
+m4_define([lt_dict_filter],
+[m4_if([$5], [], [],
+  [lt_join(m4_quote(m4_default([$4], [[, ]])),
+           lt_unquote(m4_split(m4_normalize(m4_foreach(_Lt_key, lt_car([m4_shiftn(4, $@)]),
+		      [lt_if_dict_fetch([$1], _Lt_key, [$2], [$3], [_Lt_key ])])))))])[]dnl
+])
diff --git a/build-aux/ltversion.m4 b/build-aux/ltversion.m4
new file mode 100644
index 00000000..fa04b52a
--- /dev/null
+++ b/build-aux/ltversion.m4
@@ -0,0 +1,23 @@
+# ltversion.m4 -- version numbers			-*- Autoconf -*-
+#
+#   Copyright (C) 2004, 2011-2015 Free Software Foundation, Inc.
+#   Written by Scott James Remnant, 2004
+#
+# This file is free software; the Free Software Foundation gives
+# unlimited permission to copy and/or distribute it, with or without
+# modifications, as long as this notice is preserved.
+
+# @configure_input@
+
+# serial 4179 ltversion.m4
+# This file is part of GNU Libtool
+
+m4_define([LT_PACKAGE_VERSION], [2.4.6])
+m4_define([LT_PACKAGE_REVISION], [2.4.6])
+
+AC_DEFUN([LTVERSION_VERSION],
+[macro_version='2.4.6'
+macro_revision='2.4.6'
+_LT_DECL(, macro_version, 0, [Which release of libtool.m4 was used?])
+_LT_DECL(, macro_revision, 0)
+])
diff --git a/build-aux/lt~obsolete.m4 b/build-aux/lt~obsolete.m4
new file mode 100644
index 00000000..c6b26f88
--- /dev/null
+++ b/build-aux/lt~obsolete.m4
@@ -0,0 +1,99 @@
+# lt~obsolete.m4 -- aclocal satisfying obsolete definitions.    -*-Autoconf-*-
+#
+#   Copyright (C) 2004-2005, 2007, 2009, 2011-2015 Free Software
+#   Foundation, Inc.
+#   Written by Scott James Remnant, 2004.
+#
+# This file is free software; the Free Software Foundation gives
+# unlimited permission to copy and/or distribute it, with or without
+# modifications, as long as this notice is preserved.
+
+# serial 5 lt~obsolete.m4
+
+# These exist entirely to fool aclocal when bootstrapping libtool.
+#
+# In the past libtool.m4 has provided macros via AC_DEFUN (or AU_DEFUN),
+# which have later been changed to m4_define as they aren't part of the
+# exported API, or moved to Autoconf or Automake where they belong.
+#
+# The trouble is, aclocal is a bit thick.  It'll see the old AC_DEFUN
+# in /usr/share/aclocal/libtool.m4 and remember it, then when it sees us
+# using a macro with the same name in our local m4/libtool.m4 it'll
+# pull the old libtool.m4 in (it doesn't see our shiny new m4_define
+# and doesn't know about Autoconf macros at all.)
+#
+# So we provide this file, which has a silly filename so it's always
+# included after everything else.  This provides aclocal with the
+# AC_DEFUNs it wants, but when m4 processes it, it doesn't do anything
+# because those macros already exist, or will be overwritten later.
+# We use AC_DEFUN over AU_DEFUN for compatibility with aclocal-1.6.
+#
+# Anytime we withdraw an AC_DEFUN or AU_DEFUN, remember to add it here.
+# Yes, that means every name once taken will need to remain here until
+# we give up compatibility with versions before 1.7, at which point
+# we need to keep only those names which we still refer to.
+
+# This is to help aclocal find these macros, as it can't see m4_define.
+AC_DEFUN([LTOBSOLETE_VERSION], [m4_if([1])])
+
+m4_ifndef([AC_LIBTOOL_LINKER_OPTION],	[AC_DEFUN([AC_LIBTOOL_LINKER_OPTION])])
+m4_ifndef([AC_PROG_EGREP],		[AC_DEFUN([AC_PROG_EGREP])])
+m4_ifndef([_LT_AC_PROG_ECHO_BACKSLASH],	[AC_DEFUN([_LT_AC_PROG_ECHO_BACKSLASH])])
+m4_ifndef([_LT_AC_SHELL_INIT],		[AC_DEFUN([_LT_AC_SHELL_INIT])])
+m4_ifndef([_LT_AC_SYS_LIBPATH_AIX],	[AC_DEFUN([_LT_AC_SYS_LIBPATH_AIX])])
+m4_ifndef([_LT_PROG_LTMAIN],		[AC_DEFUN([_LT_PROG_LTMAIN])])
+m4_ifndef([_LT_AC_TAGVAR],		[AC_DEFUN([_LT_AC_TAGVAR])])
+m4_ifndef([AC_LTDL_ENABLE_INSTALL],	[AC_DEFUN([AC_LTDL_ENABLE_INSTALL])])
+m4_ifndef([AC_LTDL_PREOPEN],		[AC_DEFUN([AC_LTDL_PREOPEN])])
+m4_ifndef([_LT_AC_SYS_COMPILER],	[AC_DEFUN([_LT_AC_SYS_COMPILER])])
+m4_ifndef([_LT_AC_LOCK],		[AC_DEFUN([_LT_AC_LOCK])])
+m4_ifndef([AC_LIBTOOL_SYS_OLD_ARCHIVE],	[AC_DEFUN([AC_LIBTOOL_SYS_OLD_ARCHIVE])])
+m4_ifndef([_LT_AC_TRY_DLOPEN_SELF],	[AC_DEFUN([_LT_AC_TRY_DLOPEN_SELF])])
+m4_ifndef([AC_LIBTOOL_PROG_CC_C_O],	[AC_DEFUN([AC_LIBTOOL_PROG_CC_C_O])])
+m4_ifndef([AC_LIBTOOL_SYS_HARD_LINK_LOCKS], [AC_DEFUN([AC_LIBTOOL_SYS_HARD_LINK_LOCKS])])
+m4_ifndef([AC_LIBTOOL_OBJDIR],		[AC_DEFUN([AC_LIBTOOL_OBJDIR])])
+m4_ifndef([AC_LTDL_OBJDIR],		[AC_DEFUN([AC_LTDL_OBJDIR])])
+m4_ifndef([AC_LIBTOOL_PROG_LD_HARDCODE_LIBPATH], [AC_DEFUN([AC_LIBTOOL_PROG_LD_HARDCODE_LIBPATH])])
+m4_ifndef([AC_LIBTOOL_SYS_LIB_STRIP],	[AC_DEFUN([AC_LIBTOOL_SYS_LIB_STRIP])])
+m4_ifndef([AC_PATH_MAGIC],		[AC_DEFUN([AC_PATH_MAGIC])])
+m4_ifndef([AC_PROG_LD_GNU],		[AC_DEFUN([AC_PROG_LD_GNU])])
+m4_ifndef([AC_PROG_LD_RELOAD_FLAG],	[AC_DEFUN([AC_PROG_LD_RELOAD_FLAG])])
+m4_ifndef([AC_DEPLIBS_CHECK_METHOD],	[AC_DEFUN([AC_DEPLIBS_CHECK_METHOD])])
+m4_ifndef([AC_LIBTOOL_PROG_COMPILER_NO_RTTI], [AC_DEFUN([AC_LIBTOOL_PROG_COMPILER_NO_RTTI])])
+m4_ifndef([AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE], [AC_DEFUN([AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE])])
+m4_ifndef([AC_LIBTOOL_PROG_COMPILER_PIC], [AC_DEFUN([AC_LIBTOOL_PROG_COMPILER_PIC])])
+m4_ifndef([AC_LIBTOOL_PROG_LD_SHLIBS],	[AC_DEFUN([AC_LIBTOOL_PROG_LD_SHLIBS])])
+m4_ifndef([AC_LIBTOOL_POSTDEP_PREDEP],	[AC_DEFUN([AC_LIBTOOL_POSTDEP_PREDEP])])
+m4_ifndef([LT_AC_PROG_EGREP],		[AC_DEFUN([LT_AC_PROG_EGREP])])
+m4_ifndef([LT_AC_PROG_SED],		[AC_DEFUN([LT_AC_PROG_SED])])
+m4_ifndef([_LT_CC_BASENAME],		[AC_DEFUN([_LT_CC_BASENAME])])
+m4_ifndef([_LT_COMPILER_BOILERPLATE],	[AC_DEFUN([_LT_COMPILER_BOILERPLATE])])
+m4_ifndef([_LT_LINKER_BOILERPLATE],	[AC_DEFUN([_LT_LINKER_BOILERPLATE])])
+m4_ifndef([_AC_PROG_LIBTOOL],		[AC_DEFUN([_AC_PROG_LIBTOOL])])
+m4_ifndef([AC_LIBTOOL_SETUP],		[AC_DEFUN([AC_LIBTOOL_SETUP])])
+m4_ifndef([_LT_AC_CHECK_DLFCN],		[AC_DEFUN([_LT_AC_CHECK_DLFCN])])
+m4_ifndef([AC_LIBTOOL_SYS_DYNAMIC_LINKER],	[AC_DEFUN([AC_LIBTOOL_SYS_DYNAMIC_LINKER])])
+m4_ifndef([_LT_AC_TAGCONFIG],		[AC_DEFUN([_LT_AC_TAGCONFIG])])
+m4_ifndef([AC_DISABLE_FAST_INSTALL],	[AC_DEFUN([AC_DISABLE_FAST_INSTALL])])
+m4_ifndef([_LT_AC_LANG_CXX],		[AC_DEFUN([_LT_AC_LANG_CXX])])
+m4_ifndef([_LT_AC_LANG_F77],		[AC_DEFUN([_LT_AC_LANG_F77])])
+m4_ifndef([_LT_AC_LANG_GCJ],		[AC_DEFUN([_LT_AC_LANG_GCJ])])
+m4_ifndef([AC_LIBTOOL_LANG_C_CONFIG],	[AC_DEFUN([AC_LIBTOOL_LANG_C_CONFIG])])
+m4_ifndef([_LT_AC_LANG_C_CONFIG],	[AC_DEFUN([_LT_AC_LANG_C_CONFIG])])
+m4_ifndef([AC_LIBTOOL_LANG_CXX_CONFIG],	[AC_DEFUN([AC_LIBTOOL_LANG_CXX_CONFIG])])
+m4_ifndef([_LT_AC_LANG_CXX_CONFIG],	[AC_DEFUN([_LT_AC_LANG_CXX_CONFIG])])
+m4_ifndef([AC_LIBTOOL_LANG_F77_CONFIG],	[AC_DEFUN([AC_LIBTOOL_LANG_F77_CONFIG])])
+m4_ifndef([_LT_AC_LANG_F77_CONFIG],	[AC_DEFUN([_LT_AC_LANG_F77_CONFIG])])
+m4_ifndef([AC_LIBTOOL_LANG_GCJ_CONFIG],	[AC_DEFUN([AC_LIBTOOL_LANG_GCJ_CONFIG])])
+m4_ifndef([_LT_AC_LANG_GCJ_CONFIG],	[AC_DEFUN([_LT_AC_LANG_GCJ_CONFIG])])
+m4_ifndef([AC_LIBTOOL_LANG_RC_CONFIG],	[AC_DEFUN([AC_LIBTOOL_LANG_RC_CONFIG])])
+m4_ifndef([_LT_AC_LANG_RC_CONFIG],	[AC_DEFUN([_LT_AC_LANG_RC_CONFIG])])
+m4_ifndef([AC_LIBTOOL_CONFIG],		[AC_DEFUN([AC_LIBTOOL_CONFIG])])
+m4_ifndef([_LT_AC_FILE_LTDLL_C],	[AC_DEFUN([_LT_AC_FILE_LTDLL_C])])
+m4_ifndef([_LT_REQUIRED_DARWIN_CHECKS],	[AC_DEFUN([_LT_REQUIRED_DARWIN_CHECKS])])
+m4_ifndef([_LT_AC_PROG_CXXCPP],		[AC_DEFUN([_LT_AC_PROG_CXXCPP])])
+m4_ifndef([_LT_PREPARE_SED_QUOTE_VARS],	[AC_DEFUN([_LT_PREPARE_SED_QUOTE_VARS])])
+m4_ifndef([_LT_PROG_ECHO_BACKSLASH],	[AC_DEFUN([_LT_PROG_ECHO_BACKSLASH])])
+m4_ifndef([_LT_PROG_F77],		[AC_DEFUN([_LT_PROG_F77])])
+m4_ifndef([_LT_PROG_FC],		[AC_DEFUN([_LT_PROG_FC])])
+m4_ifndef([_LT_PROG_CXX],		[AC_DEFUN([_LT_PROG_CXX])])
diff --git a/build-aux/missing b/build-aux/missing
new file mode 100755
index 00000000..f62bbae3
--- /dev/null
+++ b/build-aux/missing
@@ -0,0 +1,215 @@
+#! /bin/sh
+# Common wrapper for a few potentially missing GNU programs.
+
+scriptversion=2013-10-28.13; # UTC
+
+# Copyright (C) 1996-2014 Free Software Foundation, Inc.
+# Originally written by Fran,cois Pinard , 1996.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see .
+
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+if test $# -eq 0; then
+  echo 1>&2 "Try '$0 --help' for more information"
+  exit 1
+fi
+
+case $1 in
+
+  --is-lightweight)
+    # Used by our autoconf macros to check whether the available missing
+    # script is modern enough.
+    exit 0
+    ;;
+
+  --run)
+    # Back-compat with the calling convention used by older automake.
+    shift
+    ;;
+
+  -h|--h|--he|--hel|--help)
+    echo "\
+$0 [OPTION]... PROGRAM [ARGUMENT]...
+
+Run 'PROGRAM [ARGUMENT]...', returning a proper advice when this fails due
+to PROGRAM being missing or too old.
+
+Options:
+  -h, --help      display this help and exit
+  -v, --version   output version information and exit
+
+Supported PROGRAM values:
+  aclocal   autoconf  autoheader   autom4te  automake  makeinfo
+  bison     yacc      flex         lex       help2man
+
+Version suffixes to PROGRAM as well as the prefixes 'gnu-', 'gnu', and
+'g' are ignored when checking the name.
+
+Send bug reports to ."
+    exit $?
+    ;;
+
+  -v|--v|--ve|--ver|--vers|--versi|--versio|--version)
+    echo "missing $scriptversion (GNU Automake)"
+    exit $?
+    ;;
+
+  -*)
+    echo 1>&2 "$0: unknown '$1' option"
+    echo 1>&2 "Try '$0 --help' for more information"
+    exit 1
+    ;;
+
+esac
+
+# Run the given program, remember its exit status.
+"$@"; st=$?
+
+# If it succeeded, we are done.
+test $st -eq 0 && exit 0
+
+# Also exit now if we it failed (or wasn't found), and '--version' was
+# passed; such an option is passed most likely to detect whether the
+# program is present and works.
+case $2 in --version|--help) exit $st;; esac
+
+# Exit code 63 means version mismatch.  This often happens when the user
+# tries to use an ancient version of a tool on a file that requires a
+# minimum version.
+if test $st -eq 63; then
+  msg="probably too old"
+elif test $st -eq 127; then
+  # Program was missing.
+  msg="missing on your system"
+else
+  # Program was found and executed, but failed.  Give up.
+  exit $st
+fi
+
+perl_URL=http://www.perl.org/
+flex_URL=http://flex.sourceforge.net/
+gnu_software_URL=http://www.gnu.org/software
+
+program_details ()
+{
+  case $1 in
+    aclocal|automake)
+      echo "The '$1' program is part of the GNU Automake package:"
+      echo "<$gnu_software_URL/automake>"
+      echo "It also requires GNU Autoconf, GNU m4 and Perl in order to run:"
+      echo "<$gnu_software_URL/autoconf>"
+      echo "<$gnu_software_URL/m4/>"
+      echo "<$perl_URL>"
+      ;;
+    autoconf|autom4te|autoheader)
+      echo "The '$1' program is part of the GNU Autoconf package:"
+      echo "<$gnu_software_URL/autoconf/>"
+      echo "It also requires GNU m4 and Perl in order to run:"
+      echo "<$gnu_software_URL/m4/>"
+      echo "<$perl_URL>"
+      ;;
+  esac
+}
+
+give_advice ()
+{
+  # Normalize program name to check for.
+  normalized_program=`echo "$1" | sed '
+    s/^gnu-//; t
+    s/^gnu//; t
+    s/^g//; t'`
+
+  printf '%s\n' "'$1' is $msg."
+
+  configure_deps="'configure.ac' or m4 files included by 'configure.ac'"
+  case $normalized_program in
+    autoconf*)
+      echo "You should only need it if you modified 'configure.ac',"
+      echo "or m4 files included by it."
+      program_details 'autoconf'
+      ;;
+    autoheader*)
+      echo "You should only need it if you modified 'acconfig.h' or"
+      echo "$configure_deps."
+      program_details 'autoheader'
+      ;;
+    automake*)
+      echo "You should only need it if you modified 'Makefile.am' or"
+      echo "$configure_deps."
+      program_details 'automake'
+      ;;
+    aclocal*)
+      echo "You should only need it if you modified 'acinclude.m4' or"
+      echo "$configure_deps."
+      program_details 'aclocal'
+      ;;
+   autom4te*)
+      echo "You might have modified some maintainer files that require"
+      echo "the 'autom4te' program to be rebuilt."
+      program_details 'autom4te'
+      ;;
+    bison*|yacc*)
+      echo "You should only need it if you modified a '.y' file."
+      echo "You may want to install the GNU Bison package:"
+      echo "<$gnu_software_URL/bison/>"
+      ;;
+    lex*|flex*)
+      echo "You should only need it if you modified a '.l' file."
+      echo "You may want to install the Fast Lexical Analyzer package:"
+      echo "<$flex_URL>"
+      ;;
+    help2man*)
+      echo "You should only need it if you modified a dependency" \
+           "of a man page."
+      echo "You may want to install the GNU Help2man package:"
+      echo "<$gnu_software_URL/help2man/>"
+    ;;
+    makeinfo*)
+      echo "You should only need it if you modified a '.texi' file, or"
+      echo "any other file indirectly affecting the aspect of the manual."
+      echo "You might want to install the Texinfo package:"
+      echo "<$gnu_software_URL/texinfo/>"
+      echo "The spurious makeinfo call might also be the consequence of"
+      echo "using a buggy 'make' (AIX, DU, IRIX), in which case you might"
+      echo "want to install GNU make:"
+      echo "<$gnu_software_URL/make/>"
+      ;;
+    *)
+      echo "You might have modified some files without having the proper"
+      echo "tools for further handling them.  Check the 'README' file, it"
+      echo "often tells you about the needed prerequisites for installing"
+      echo "this package.  You may also peek at any GNU archive site, in"
+      echo "case some other package contains this missing '$1' program."
+      ;;
+  esac
+}
+
+give_advice "$1" | sed -e '1s/^/WARNING: /' \
+                       -e '2,$s/^/         /' >&2
+
+# Propagate the correct exit status (expected to be 127 for a program
+# not found, 63 for a program that failed due to version mismatch).
+exit $st
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "scriptversion="
+# time-stamp-format: "%:y-%02m-%02d.%02H"
+# time-stamp-time-zone: "UTC"
+# time-stamp-end: "; # UTC"
+# End:
diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml
new file mode 100644
index 00000000..ca34b034
--- /dev/null
+++ b/bytecomp/bytegen.ml
@@ -0,0 +1,1107 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(*  bytegen.ml : translation of lambda terms to lists of instructions. *)
+
+open Misc
+open Asttypes
+open Primitive
+open Types
+open Lambda
+open Switch
+open Instruct
+open Debuginfo.Scoped_location
+
+(**** Label generation ****)
+
+let label_counter = ref 0
+
+let new_label () =
+  incr label_counter; !label_counter
+
+(**** Operations on compilation environments. ****)
+
+let empty_env =
+  { ce_stack = Ident.empty; ce_heap = Ident.empty; ce_rec = Ident.empty }
+
+(* Add a stack-allocated variable *)
+
+let add_var id pos env =
+  { ce_stack = Ident.add id pos env.ce_stack;
+    ce_heap = env.ce_heap;
+    ce_rec = env.ce_rec }
+
+let rec add_vars idlist pos env =
+  match idlist with
+    [] -> env
+  | id :: rem -> add_vars rem (pos + 1) (add_var id pos env)
+
+(**** Examination of the continuation ****)
+
+(* Return a label to the beginning of the given continuation.
+   If the sequence starts with a branch, use the target of that branch
+   as the label, thus avoiding a jump to a jump. *)
+
+let label_code = function
+    Kbranch lbl :: _ as cont -> (lbl, cont)
+  | Klabel lbl :: _ as cont -> (lbl, cont)
+  | cont -> let lbl = new_label() in (lbl, Klabel lbl :: cont)
+
+(* Return a branch to the continuation. That is, an instruction that,
+   when executed, branches to the continuation or performs what the
+   continuation performs. We avoid generating branches to branches and
+   branches to returns. *)
+
+let rec make_branch_2 lbl n cont =
+  function
+    Kreturn m :: _ -> (Kreturn (n + m), cont)
+  | Klabel _ :: c  -> make_branch_2 lbl n cont c
+  | Kpop m :: c    -> make_branch_2 lbl (n + m) cont c
+  | _              ->
+      match lbl with
+        Some lbl -> (Kbranch lbl, cont)
+      | None     -> let lbl = new_label() in (Kbranch lbl, Klabel lbl :: cont)
+
+let make_branch cont =
+  match cont with
+    (Kbranch _ as branch) :: _ -> (branch, cont)
+  | (Kreturn _ as return) :: _ -> (return, cont)
+  | Kraise k :: _ -> (Kraise k, cont)
+  | Klabel lbl :: _ -> make_branch_2 (Some lbl) 0 cont cont
+  | _ ->  make_branch_2 (None) 0 cont cont
+
+(* Avoid a branch to a label that follows immediately *)
+
+let branch_to label cont = match cont with
+| Klabel label0::_ when label = label0 -> cont
+| _ -> Kbranch label::cont
+
+(* Discard all instructions up to the next label.
+   This function is to be applied to the continuation before adding a
+   non-terminating instruction (branch, raise, return) in front of it. *)
+
+let rec discard_dead_code = function
+    [] -> []
+  | (Klabel _ | Krestart | Ksetglobal _) :: _ as cont -> cont
+  | _ :: cont -> discard_dead_code cont
+
+(* Check if we're in tailcall position *)
+
+let rec is_tailcall = function
+    Kreturn _ :: _ -> true
+  | Klabel _ :: c -> is_tailcall c
+  | Kpop _ :: c -> is_tailcall c
+  | _ -> false
+
+(* Will this primitive result in an OCaml call which would benefit
+   from the tail call optimization? *)
+
+let preserve_tailcall_for_prim = function
+    Pidentity | Popaque | Pdirapply | Prevapply | Psequor | Psequand ->
+      true
+  | Pbytes_to_string | Pbytes_of_string | Pignore | Pgetglobal _ | Psetglobal _
+  | Pmakeblock _ | Pfield _ | Pfield_computed | Psetfield _
+  | Psetfield_computed _ | Pfloatfield _ | Psetfloatfield _ | Pduprecord _
+  | Pccall _ | Praise _ | Pnot | Pnegint | Paddint | Psubint | Pmulint
+  | Pdivint _ | Pmodint _ | Pandint | Porint | Pxorint | Plslint | Plsrint
+  | Pasrint | Pintcomp _ | Poffsetint _ | Poffsetref _ | Pintoffloat
+  | Pfloatofint | Pnegfloat | Pabsfloat | Paddfloat | Psubfloat | Pmulfloat
+  | Pdivfloat | Pfloatcomp _ | Pstringlength | Pstringrefu  | Pstringrefs
+  | Pcompare_ints | Pcompare_floats | Pcompare_bints _
+  | Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
+  | Pmakearray _ | Pduparray _ | Parraylength _ | Parrayrefu _ | Parraysetu _
+  | Parrayrefs _ | Parraysets _ | Pisint | Pisout | Pbintofint _ | Pintofbint _
+  | Pcvtbint _ | Pnegbint _ | Paddbint _ | Psubbint _ | Pmulbint _ | Pdivbint _
+  | Pmodbint _ | Pandbint _ | Porbint _ | Pxorbint _ | Plslbint _ | Plsrbint _
+  | Pasrbint _ | Pbintcomp _ | Pbigarrayref _ | Pbigarrayset _ | Pbigarraydim _
+  | Pstring_load_16 _ | Pstring_load_32 _ | Pstring_load_64 _ | Pbytes_load_16 _
+  | Pbytes_load_32 _ | Pbytes_load_64 _ | Pbytes_set_16 _ | Pbytes_set_32 _
+  | Pbytes_set_64 _ | Pbigstring_load_16 _ | Pbigstring_load_32 _
+  | Pbigstring_load_64 _ | Pbigstring_set_16 _ | Pbigstring_set_32 _
+  | Pbigstring_set_64 _ | Pctconst _ | Pbswap16 | Pbbswap _ | Pint_as_pointer ->
+      false
+
+(* Add a Kpop N instruction in front of a continuation *)
+
+let rec add_pop n cont =
+  if n = 0 then cont else
+    match cont with
+      Kpop m :: cont -> add_pop (n + m) cont
+    | Kreturn m :: cont -> Kreturn(n + m) :: cont
+    | Kraise _ :: _ -> cont
+    | _ -> Kpop n :: cont
+
+(* Add the constant "unit" in front of a continuation *)
+
+let add_const_unit = function
+    (Kacc _ | Kconst _ | Kgetglobal _ | Kpush_retaddr _) :: _ as cont -> cont
+  | cont -> Kconst const_unit :: cont
+
+let rec push_dummies n k = match n with
+| 0 -> k
+| _ -> Kconst const_unit::Kpush::push_dummies (n-1) k
+
+
+(**** Auxiliary for compiling "let rec" ****)
+
+type rhs_kind =
+  | RHS_block of int
+  | RHS_infix of { blocksize : int; offset : int }
+  | RHS_floatblock of int
+  | RHS_nonrec
+  | RHS_function of int * int
+;;
+
+let rec check_recordwith_updates id e =
+  match e with
+  | Lsequence (Lprim ((Psetfield _ | Psetfloatfield _), [Lvar id2; _], _), cont)
+      -> id2 = id && check_recordwith_updates id cont
+  | Lvar id2 -> id2 = id
+  | _ -> false
+;;
+
+let rec size_of_lambda env = function
+  | Lvar id ->
+      begin try Ident.find_same id env with Not_found -> RHS_nonrec end
+  | Lfunction{params} as funct ->
+      RHS_function (1 + Ident.Set.cardinal(free_variables funct),
+                    List.length params)
+  | Llet (Strict, _k, id, Lprim (Pduprecord (kind, size), _, _), body)
+    when check_recordwith_updates id body ->
+      begin match kind with
+      | Record_regular | Record_inlined _ -> RHS_block size
+      | Record_unboxed _ -> assert false
+      | Record_float -> RHS_floatblock size
+      | Record_extension _ -> RHS_block (size + 1)
+      end
+  | Llet(_str, _k, id, arg, body) ->
+      size_of_lambda (Ident.add id (size_of_lambda env arg) env) body
+  (* See the Lletrec case of comp_expr *)
+  | Lletrec(bindings, body) when
+      List.for_all (function (_, Lfunction _) -> true | _ -> false) bindings ->
+      (* let rec of functions *)
+      let fv =
+        Ident.Set.elements (free_variables (Lletrec(bindings, lambda_unit))) in
+      (* See Instruct(CLOSUREREC) in interp.c *)
+      let blocksize = List.length bindings * 2 - 1 + List.length fv in
+      let offsets = List.mapi (fun i (id, _e) -> (id, i * 2)) bindings in
+      let env = List.fold_right (fun (id, offset) env ->
+        Ident.add id (RHS_infix { blocksize; offset }) env) offsets env in
+      size_of_lambda env body
+  | Lletrec(bindings, body) ->
+      let env = List.fold_right
+        (fun (id, e) env -> Ident.add id (size_of_lambda env e) env)
+        bindings env
+      in
+      size_of_lambda env body
+  | Lprim(Pmakeblock _, args, _) -> RHS_block (List.length args)
+  | Lprim (Pmakearray ((Paddrarray|Pintarray), _), args, _) ->
+      RHS_block (List.length args)
+  | Lprim (Pmakearray (Pfloatarray, _), args, _) ->
+      RHS_floatblock (List.length args)
+  | Lprim (Pmakearray (Pgenarray, _), _, _) ->
+     (* Pgenarray is excluded from recursive bindings by the
+        check in Translcore.check_recursive_lambda *)
+      RHS_nonrec
+  | Lprim (Pduprecord ((Record_regular | Record_inlined _), size), _, _) ->
+      RHS_block size
+  | Lprim (Pduprecord (Record_unboxed _, _), _, _) ->
+      assert false
+  | Lprim (Pduprecord (Record_extension _, size), _, _) ->
+      RHS_block (size + 1)
+  | Lprim (Pduprecord (Record_float, size), _, _) -> RHS_floatblock size
+  | Levent (lam, _) -> size_of_lambda env lam
+  | Lsequence (_lam, lam') -> size_of_lambda env lam'
+  | _ -> RHS_nonrec
+
+(**** Merging consecutive events ****)
+
+let copy_event ev kind info repr =
+  { ev with
+    ev_pos = 0;                   (* patched in emitcode *)
+    ev_kind = kind;
+    ev_info = info;
+    ev_repr = repr }
+
+let merge_infos ev ev' =
+  match ev.ev_info, ev'.ev_info with
+    Event_other, info -> info
+  | info, Event_other -> info
+  | _                 -> fatal_error "Bytegen.merge_infos"
+
+let merge_repr ev ev' =
+  match ev.ev_repr, ev'.ev_repr with
+    Event_none, x -> x
+  | x, Event_none -> x
+  | Event_parent r, Event_child r' when r == r' && !r = 1 -> Event_none
+  | Event_child r, Event_parent r' when r == r' -> Event_parent r
+  | _, _          -> fatal_error "Bytegen.merge_repr"
+
+let merge_events ev ev' =
+  let (maj, min) =
+    match ev.ev_kind, ev'.ev_kind with
+    (* Discard pseudo-events *)
+      Event_pseudo,  _                              -> ev', ev
+    | _,             Event_pseudo                   -> ev,  ev'
+    (* Keep following event, supposedly more informative *)
+    | Event_before,  (Event_after _ | Event_before) -> ev',  ev
+    (* Discard following events, supposedly less informative *)
+    | Event_after _, (Event_after _ | Event_before) -> ev, ev'
+  in
+  copy_event maj maj.ev_kind (merge_infos maj min) (merge_repr maj min)
+
+let weaken_event ev cont =
+  match ev.ev_kind with
+    Event_after _ ->
+      begin match cont with
+        Kpush :: Kevent ({ev_repr = Event_none} as ev') :: c ->
+          begin match ev.ev_info with
+            Event_return _ ->
+              (* Weaken event *)
+              let repr = ref 1 in
+              let ev =
+                copy_event ev Event_pseudo ev.ev_info (Event_parent repr)
+              and ev' =
+                copy_event ev' ev'.ev_kind ev'.ev_info (Event_child repr)
+              in
+              Kevent ev :: Kpush :: Kevent ev' :: c
+          | _ ->
+              (* Only keep following event, equivalent *)
+              cont
+          end
+      | _ ->
+          Kevent ev :: cont
+      end
+  | _ ->
+      Kevent ev :: cont
+
+let add_event ev =
+  function
+    Kevent ev' :: cont -> weaken_event (merge_events ev ev') cont
+  | cont               -> weaken_event ev cont
+
+(* Pseudo events are ignored by the debugger. They are only used for
+   generating backtraces.
+
+   We prefer adding this event here rather than in lambda generation
+   1) there are many different situations where a Pmakeblock can
+      be generated
+   2) we prefer inserting a pseudo event rather than an event after
+      to prevent the debugger to stop at every single allocation. *)
+let add_pseudo_event loc modname c =
+  if !Clflags.debug then
+    let ev_defname = string_of_scoped_location loc in
+    let ev =
+      { ev_pos = 0;                   (* patched in emitcode *)
+        ev_module = modname;
+        ev_loc = to_location loc;
+        ev_defname;
+        ev_kind = Event_pseudo;
+        ev_info = Event_other;        (* Dummy *)
+        ev_typenv = Env.Env_empty;    (* Dummy *)
+        ev_typsubst = Subst.identity; (* Dummy *)
+        ev_compenv = empty_env;       (* Dummy *)
+        ev_stacksize = 0;             (* Dummy *)
+        ev_repr = Event_none }        (* Dummy *)
+    in
+    add_event ev c
+  else c
+
+(**** Compilation of a lambda expression ****)
+
+let try_blocks = ref []  (* list of stack size for each nested try block *)
+
+(* association staticraise numbers -> (lbl,size of stack, try_blocks *)
+
+let sz_static_raises = ref []
+
+let push_static_raise i lbl_handler sz =
+  sz_static_raises := (i, (lbl_handler, sz, !try_blocks)) :: !sz_static_raises
+
+let find_raise_label i =
+  try
+    List.assoc i !sz_static_raises
+  with
+  | Not_found ->
+      Misc.fatal_error
+        ("exit("^Int.to_string i^") outside appropriated catch")
+
+(* Will the translation of l lead to a jump to label ? *)
+let code_as_jump l sz = match l with
+| Lstaticraise (i,[]) ->
+    let label,size,tb = find_raise_label i in
+    if sz = size && tb == !try_blocks then
+      Some label
+    else
+      None
+| _ -> None
+
+(* Function bodies that remain to be compiled *)
+
+type function_to_compile =
+  { params: Ident.t list;               (* function parameters *)
+    body: lambda;                       (* the function body *)
+    label: label;                       (* the label of the function entry *)
+    free_vars: Ident.t list;            (* free variables of the function *)
+    num_defs: int;            (* number of mutually recursive definitions *)
+    rec_vars: Ident.t list;             (* mutually recursive fn names *)
+    rec_pos: int }                      (* rank in recursive definition *)
+
+let functions_to_compile  = (Stack.create () : function_to_compile Stack.t)
+
+(* Name of current compilation unit (for debugging events) *)
+
+let compunit_name = ref ""
+
+(* Maximal stack size reached during the current function body *)
+
+let max_stack_used = ref 0
+
+
+(* Sequence of string tests *)
+
+
+(* Translate a primitive to a bytecode instruction (possibly a call to a C
+   function) *)
+
+let comp_bint_primitive bi suff args =
+  let pref =
+    match bi with Pnativeint -> "caml_nativeint_"
+                | Pint32 -> "caml_int32_"
+                | Pint64 -> "caml_int64_" in
+  Kccall(pref ^ suff, List.length args)
+
+let comp_primitive p args =
+  match p with
+    Pgetglobal id -> Kgetglobal id
+  | Psetglobal id -> Ksetglobal id
+  | Pintcomp cmp -> Kintcomp cmp
+  | Pcompare_ints -> Kccall("caml_int_compare", 2)
+  | Pcompare_floats -> Kccall("caml_float_compare", 2)
+  | Pcompare_bints bi -> comp_bint_primitive bi "compare" args
+  | Pfield n -> Kgetfield n
+  | Pfield_computed -> Kgetvectitem
+  | Psetfield(n, _ptr, _init) -> Ksetfield n
+  | Psetfield_computed(_ptr, _init) -> Ksetvectitem
+  | Psetfloatfield (n, _init) -> Ksetfloatfield n
+  | Pduprecord _ -> Kccall("caml_obj_dup", 1)
+  | Pccall p -> Kccall(p.prim_name, p.prim_arity)
+  | Pnegint -> Knegint
+  | Paddint -> Kaddint
+  | Psubint -> Ksubint
+  | Pmulint -> Kmulint
+  | Pdivint _ -> Kdivint
+  | Pmodint _ -> Kmodint
+  | Pandint -> Kandint
+  | Porint -> Korint
+  | Pxorint -> Kxorint
+  | Plslint -> Klslint
+  | Plsrint -> Klsrint
+  | Pasrint -> Kasrint
+  | Poffsetint n -> Koffsetint n
+  | Poffsetref n -> Koffsetref n
+  | Pintoffloat -> Kccall("caml_int_of_float", 1)
+  | Pfloatofint -> Kccall("caml_float_of_int", 1)
+  | Pnegfloat -> Kccall("caml_neg_float", 1)
+  | Pabsfloat -> Kccall("caml_abs_float", 1)
+  | Paddfloat -> Kccall("caml_add_float", 2)
+  | Psubfloat -> Kccall("caml_sub_float", 2)
+  | Pmulfloat -> Kccall("caml_mul_float", 2)
+  | Pdivfloat -> Kccall("caml_div_float", 2)
+  | Pstringlength -> Kccall("caml_ml_string_length", 1)
+  | Pbyteslength -> Kccall("caml_ml_bytes_length", 1)
+  | Pstringrefs -> Kccall("caml_string_get", 2)
+  | Pbytesrefs -> Kccall("caml_bytes_get", 2)
+  | Pbytessets -> Kccall("caml_bytes_set", 3)
+  | Pstringrefu -> Kgetstringchar
+  | Pbytesrefu -> Kgetbyteschar
+  | Pbytessetu -> Ksetbyteschar
+  | Pstring_load_16(_) -> Kccall("caml_string_get16", 2)
+  | Pstring_load_32(_) -> Kccall("caml_string_get32", 2)
+  | Pstring_load_64(_) -> Kccall("caml_string_get64", 2)
+  | Pbytes_set_16(_) -> Kccall("caml_bytes_set16", 3)
+  | Pbytes_set_32(_) -> Kccall("caml_bytes_set32", 3)
+  | Pbytes_set_64(_) -> Kccall("caml_bytes_set64", 3)
+  | Pbytes_load_16(_) -> Kccall("caml_bytes_get16", 2)
+  | Pbytes_load_32(_) -> Kccall("caml_bytes_get32", 2)
+  | Pbytes_load_64(_) -> Kccall("caml_bytes_get64", 2)
+  | Parraylength _ -> Kvectlength
+  | Parrayrefs Pgenarray -> Kccall("caml_array_get", 2)
+  | Parrayrefs Pfloatarray -> Kccall("caml_floatarray_get", 2)
+  | Parrayrefs _ -> Kccall("caml_array_get_addr", 2)
+  | Parraysets Pgenarray -> Kccall("caml_array_set", 3)
+  | Parraysets Pfloatarray -> Kccall("caml_floatarray_set", 3)
+  | Parraysets _ -> Kccall("caml_array_set_addr", 3)
+  | Parrayrefu Pgenarray -> Kccall("caml_array_unsafe_get", 2)
+  | Parrayrefu Pfloatarray -> Kccall("caml_floatarray_unsafe_get", 2)
+  | Parrayrefu _ -> Kgetvectitem
+  | Parraysetu Pgenarray -> Kccall("caml_array_unsafe_set", 3)
+  | Parraysetu Pfloatarray -> Kccall("caml_floatarray_unsafe_set", 3)
+  | Parraysetu _ -> Ksetvectitem
+  | Pctconst c ->
+     let const_name = match c with
+       | Big_endian -> "big_endian"
+       | Word_size -> "word_size"
+       | Int_size -> "int_size"
+       | Max_wosize -> "max_wosize"
+       | Ostype_unix -> "ostype_unix"
+       | Ostype_win32 -> "ostype_win32"
+       | Ostype_cygwin -> "ostype_cygwin"
+       | Backend_type -> "backend_type" in
+     Kccall(Printf.sprintf "caml_sys_const_%s" const_name, 1)
+  | Pisint -> Kisint
+  | Pisout -> Kisout
+  | Pbintofint bi -> comp_bint_primitive bi "of_int" args
+  | Pintofbint bi -> comp_bint_primitive bi "to_int" args
+  | Pcvtbint(Pint32, Pnativeint) -> Kccall("caml_nativeint_of_int32", 1)
+  | Pcvtbint(Pnativeint, Pint32) -> Kccall("caml_nativeint_to_int32", 1)
+  | Pcvtbint(Pint32, Pint64) -> Kccall("caml_int64_of_int32", 1)
+  | Pcvtbint(Pint64, Pint32) -> Kccall("caml_int64_to_int32", 1)
+  | Pcvtbint(Pnativeint, Pint64) -> Kccall("caml_int64_of_nativeint", 1)
+  | Pcvtbint(Pint64, Pnativeint) -> Kccall("caml_int64_to_nativeint", 1)
+  | Pnegbint bi -> comp_bint_primitive bi "neg" args
+  | Paddbint bi -> comp_bint_primitive bi "add" args
+  | Psubbint bi -> comp_bint_primitive bi "sub" args
+  | Pmulbint bi -> comp_bint_primitive bi "mul" args
+  | Pdivbint { size = bi } -> comp_bint_primitive bi "div" args
+  | Pmodbint { size = bi } -> comp_bint_primitive bi "mod" args
+  | Pandbint bi -> comp_bint_primitive bi "and" args
+  | Porbint bi -> comp_bint_primitive bi "or" args
+  | Pxorbint bi -> comp_bint_primitive bi "xor" args
+  | Plslbint bi -> comp_bint_primitive bi "shift_left" args
+  | Plsrbint bi -> comp_bint_primitive bi "shift_right_unsigned" args
+  | Pasrbint bi -> comp_bint_primitive bi "shift_right" args
+  | Pbintcomp(_, Ceq) -> Kccall("caml_equal", 2)
+  | Pbintcomp(_, Cne) -> Kccall("caml_notequal", 2)
+  | Pbintcomp(_, Clt) -> Kccall("caml_lessthan", 2)
+  | Pbintcomp(_, Cgt) -> Kccall("caml_greaterthan", 2)
+  | Pbintcomp(_, Cle) -> Kccall("caml_lessequal", 2)
+  | Pbintcomp(_, Cge) -> Kccall("caml_greaterequal", 2)
+  | Pbigarrayref(_, n, _, _) -> Kccall("caml_ba_get_" ^ Int.to_string n, n + 1)
+  | Pbigarrayset(_, n, _, _) -> Kccall("caml_ba_set_" ^ Int.to_string n, n + 2)
+  | Pbigarraydim(n) -> Kccall("caml_ba_dim_" ^ Int.to_string n, 1)
+  | Pbigstring_load_16(_) -> Kccall("caml_ba_uint8_get16", 2)
+  | Pbigstring_load_32(_) -> Kccall("caml_ba_uint8_get32", 2)
+  | Pbigstring_load_64(_) -> Kccall("caml_ba_uint8_get64", 2)
+  | Pbigstring_set_16(_) -> Kccall("caml_ba_uint8_set16", 3)
+  | Pbigstring_set_32(_) -> Kccall("caml_ba_uint8_set32", 3)
+  | Pbigstring_set_64(_) -> Kccall("caml_ba_uint8_set64", 3)
+  | Pbswap16 -> Kccall("caml_bswap16", 1)
+  | Pbbswap(bi) -> comp_bint_primitive bi "bswap" args
+  | Pint_as_pointer -> Kccall("caml_int_as_pointer", 1)
+  | Pbytes_to_string -> Kccall("caml_string_of_bytes", 1)
+  | Pbytes_of_string -> Kccall("caml_bytes_of_string", 1)
+  | _ -> fatal_error "Bytegen.comp_primitive"
+
+let is_immed n = immed_min <= n && n <= immed_max
+
+module Storer =
+  Switch.Store
+    (struct type t = lambda type key = lambda
+      let compare_key = Stdlib.compare
+      let make_key = Lambda.make_key end)
+
+(* Compile an expression.
+   The value of the expression is left in the accumulator.
+   env = compilation environment
+   exp = the lambda expression to compile
+   sz = current size of the stack frame
+   cont = list of instructions to execute afterwards
+   Result = list of instructions that evaluate exp, then perform cont. *)
+
+let rec comp_expr env exp sz cont =
+  if sz > !max_stack_used then max_stack_used := sz;
+  match exp with
+    Lvar id ->
+      begin try
+        let pos = Ident.find_same id env.ce_stack in
+        Kacc(sz - pos) :: cont
+      with Not_found ->
+      try
+        let pos = Ident.find_same id env.ce_heap in
+        Kenvacc(pos) :: cont
+      with Not_found ->
+      try
+        let ofs = Ident.find_same id env.ce_rec in
+        Koffsetclosure(ofs) :: cont
+      with Not_found ->
+        fatal_error ("Bytegen.comp_expr: var " ^ Ident.unique_name id)
+      end
+  | Lconst cst ->
+      Kconst cst :: cont
+  | Lapply{ap_func = func; ap_args = args} ->
+      let nargs = List.length args in
+      if is_tailcall cont then begin
+        comp_args env args sz
+          (Kpush :: comp_expr env func (sz + nargs)
+            (Kappterm(nargs, sz + nargs) :: discard_dead_code cont))
+      end else begin
+        if nargs < 4 then
+          comp_args env args sz
+            (Kpush :: comp_expr env func (sz + nargs) (Kapply nargs :: cont))
+        else begin
+          let (lbl, cont1) = label_code cont in
+          Kpush_retaddr lbl ::
+          comp_args env args (sz + 3)
+            (Kpush :: comp_expr env func (sz + 3 + nargs)
+                      (Kapply nargs :: cont1))
+        end
+      end
+  | Lsend(kind, met, obj, args, _) ->
+      let args = if kind = Cached then List.tl args else args in
+      let nargs = List.length args + 1 in
+      let getmethod, args' =
+        if kind = Self then (Kgetmethod, met::obj::args) else
+        match met with
+          Lconst(Const_base(Const_int n)) -> (Kgetpubmet n, obj::args)
+        | _ -> (Kgetdynmet, met::obj::args)
+      in
+      if is_tailcall cont then
+        comp_args env args' sz
+          (getmethod :: Kappterm(nargs, sz + nargs) :: discard_dead_code cont)
+      else
+        if nargs < 4 then
+          comp_args env args' sz
+            (getmethod :: Kapply nargs :: cont)
+        else begin
+          let (lbl, cont1) = label_code cont in
+          Kpush_retaddr lbl ::
+          comp_args env args' (sz + 3)
+            (getmethod :: Kapply nargs :: cont1)
+        end
+  | Lfunction{params; body; loc} -> (* assume kind = Curried *)
+      let cont = add_pseudo_event loc !compunit_name cont in
+      let lbl = new_label() in
+      let fv = Ident.Set.elements(free_variables exp) in
+      let to_compile =
+        { params = List.map fst params; body = body; label = lbl;
+          free_vars = fv; num_defs = 1; rec_vars = []; rec_pos = 0 } in
+      Stack.push to_compile functions_to_compile;
+      comp_args env (List.map (fun n -> Lvar n) fv) sz
+        (Kclosure(lbl, List.length fv) :: cont)
+  | Llet(_str, _k, id, arg, body) ->
+      comp_expr env arg sz
+        (Kpush :: comp_expr (add_var id (sz+1) env) body (sz+1)
+          (add_pop 1 cont))
+  | Lletrec(decl, body) ->
+      let ndecl = List.length decl in
+      if List.for_all (function (_, Lfunction _) -> true | _ -> false)
+                      decl then begin
+        (* let rec of functions *)
+        let fv =
+          Ident.Set.elements (free_variables (Lletrec(decl, lambda_unit))) in
+        let rec_idents = List.map (fun (id, _lam) -> id) decl in
+        let rec comp_fun pos = function
+            [] -> []
+          | (_id, Lfunction{params; body}) :: rem ->
+              let lbl = new_label() in
+              let to_compile =
+                { params = List.map fst params; body = body; label = lbl;
+                  free_vars = fv; num_defs = ndecl; rec_vars = rec_idents;
+                  rec_pos = pos} in
+              Stack.push to_compile functions_to_compile;
+              lbl :: comp_fun (pos + 1) rem
+          | _ -> assert false in
+        let lbls = comp_fun 0 decl in
+        comp_args env (List.map (fun n -> Lvar n) fv) sz
+          (Kclosurerec(lbls, List.length fv) ::
+            (comp_expr (add_vars rec_idents (sz+1) env) body (sz + ndecl)
+                       (add_pop ndecl cont)))
+      end else begin
+        let decl_size =
+          List.map (fun (id, exp) -> (id, exp, size_of_lambda Ident.empty exp))
+            decl in
+        let rec comp_init new_env sz = function
+          | [] -> comp_nonrec new_env sz ndecl decl_size
+          | (id, _exp, RHS_floatblock blocksize) :: rem ->
+              Kconst(Const_base(Const_int blocksize)) ::
+              Kccall("caml_alloc_dummy_float", 1) :: Kpush ::
+              comp_init (add_var id (sz+1) new_env) (sz+1) rem
+          | (id, _exp, RHS_block blocksize) :: rem ->
+              Kconst(Const_base(Const_int blocksize)) ::
+              Kccall("caml_alloc_dummy", 1) :: Kpush ::
+              comp_init (add_var id (sz+1) new_env) (sz+1) rem
+          | (id, _exp, RHS_infix { blocksize; offset }) :: rem ->
+              Kconst(Const_base(Const_int offset)) ::
+              Kpush ::
+              Kconst(Const_base(Const_int blocksize)) ::
+              Kccall("caml_alloc_dummy_infix", 2) :: Kpush ::
+              comp_init (add_var id (sz+1) new_env) (sz+1) rem
+          | (id, _exp, RHS_function (blocksize,arity)) :: rem ->
+              Kconst(Const_base(Const_int arity)) ::
+              Kpush ::
+              Kconst(Const_base(Const_int blocksize)) ::
+              Kccall("caml_alloc_dummy_function", 2) :: Kpush ::
+              comp_init (add_var id (sz+1) new_env) (sz+1) rem
+          | (id, _exp, RHS_nonrec) :: rem ->
+              Kconst(Const_base(Const_int 0)) :: Kpush ::
+              comp_init (add_var id (sz+1) new_env) (sz+1) rem
+        and comp_nonrec new_env sz i = function
+          | [] -> comp_rec new_env sz ndecl decl_size
+          | (_id, _exp, (RHS_block _ | RHS_infix _ |
+                         RHS_floatblock _ | RHS_function _))
+            :: rem ->
+              comp_nonrec new_env sz (i-1) rem
+          | (_id, exp, RHS_nonrec) :: rem ->
+              comp_expr new_env exp sz
+                (Kassign (i-1) :: comp_nonrec new_env sz (i-1) rem)
+        and comp_rec new_env sz i = function
+          | [] -> comp_expr new_env body sz (add_pop ndecl cont)
+          | (_id, exp, (RHS_block _ | RHS_infix _ |
+                        RHS_floatblock _ | RHS_function _))
+            :: rem ->
+              comp_expr new_env exp sz
+                (Kpush :: Kacc i :: Kccall("caml_update_dummy", 2) ::
+                 comp_rec new_env sz (i-1) rem)
+          | (_id, _exp, RHS_nonrec) :: rem ->
+              comp_rec new_env sz (i-1) rem
+        in
+        comp_init env sz decl_size
+      end
+  | Lprim((Pidentity | Popaque), [arg], _) ->
+      comp_expr env arg sz cont
+  | Lprim(Pignore, [arg], _) ->
+      comp_expr env arg sz (add_const_unit cont)
+  | Lprim(Pdirapply, [func;arg], loc)
+  | Lprim(Prevapply, [arg;func], loc) ->
+      let exp = Lapply{ap_should_be_tailcall=false;
+                       ap_loc=loc;
+                       ap_func=func;
+                       ap_args=[arg];
+                       ap_inlined=Default_inline;
+                       ap_specialised=Default_specialise} in
+      comp_expr env exp sz cont
+  | Lprim(Pnot, [arg], _) ->
+      let newcont =
+        match cont with
+          Kbranchif lbl :: cont1 -> Kbranchifnot lbl :: cont1
+        | Kbranchifnot lbl :: cont1 -> Kbranchif lbl :: cont1
+        | _ -> Kboolnot :: cont in
+      comp_expr env arg sz newcont
+  | Lprim(Psequand, [exp1; exp2], _) ->
+      begin match cont with
+        Kbranchifnot lbl :: _ ->
+          comp_expr env exp1 sz (Kbranchifnot lbl ::
+            comp_expr env exp2 sz cont)
+      | Kbranchif lbl :: cont1 ->
+          let (lbl2, cont2) = label_code cont1 in
+          comp_expr env exp1 sz (Kbranchifnot lbl2 ::
+            comp_expr env exp2 sz (Kbranchif lbl :: cont2))
+      | _ ->
+          let (lbl, cont1) = label_code cont in
+          comp_expr env exp1 sz (Kstrictbranchifnot lbl ::
+            comp_expr env exp2 sz cont1)
+      end
+  | Lprim(Psequor, [exp1; exp2], _) ->
+      begin match cont with
+        Kbranchif lbl :: _ ->
+          comp_expr env exp1 sz (Kbranchif lbl ::
+            comp_expr env exp2 sz cont)
+      | Kbranchifnot lbl :: cont1 ->
+          let (lbl2, cont2) = label_code cont1 in
+          comp_expr env exp1 sz (Kbranchif lbl2 ::
+            comp_expr env exp2 sz (Kbranchifnot lbl :: cont2))
+      | _ ->
+          let (lbl, cont1) = label_code cont in
+          comp_expr env exp1 sz (Kstrictbranchif lbl ::
+            comp_expr env exp2 sz cont1)
+      end
+  | Lprim(Praise k, [arg], _) ->
+      comp_expr env arg sz (Kraise k :: discard_dead_code cont)
+  | Lprim(Paddint, [arg; Lconst(Const_base(Const_int n))], _)
+    when is_immed n ->
+      comp_expr env arg sz (Koffsetint n :: cont)
+  | Lprim(Psubint, [arg; Lconst(Const_base(Const_int n))], _)
+    when is_immed (-n) ->
+      comp_expr env arg sz (Koffsetint (-n) :: cont)
+  | Lprim (Poffsetint n, [arg], _)
+    when not (is_immed n) ->
+      comp_expr env arg sz
+        (Kpush::
+         Kconst (Const_base (Const_int n))::
+         Kaddint::cont)
+  | Lprim(Pmakearray (kind, _), args, loc) ->
+      let cont = add_pseudo_event loc !compunit_name cont in
+      begin match kind with
+        Pintarray | Paddrarray ->
+          comp_args env args sz (Kmakeblock(List.length args, 0) :: cont)
+      | Pfloatarray ->
+          comp_args env args sz (Kmakefloatblock(List.length args) :: cont)
+      | Pgenarray ->
+          if args = []
+          then Kmakeblock(0, 0) :: cont
+          else comp_args env args sz
+                 (Kmakeblock(List.length args, 0) ::
+                  Kccall("caml_make_array", 1) :: cont)
+      end
+  | Lprim (Pduparray (kind, mutability),
+           [Lprim (Pmakearray (kind',_),args,_)], loc) ->
+      assert (kind = kind');
+      comp_expr env (Lprim (Pmakearray (kind, mutability), args, loc)) sz cont
+  | Lprim (Pduparray _, [arg], loc) ->
+      let prim_obj_dup =
+        Primitive.simple ~name:"caml_obj_dup" ~arity:1 ~alloc:true
+      in
+      comp_expr env (Lprim (Pccall prim_obj_dup, [arg], loc)) sz cont
+  | Lprim (Pduparray _, _, _) ->
+      Misc.fatal_error "Bytegen.comp_expr: Pduparray takes exactly one arg"
+(* Integer first for enabling further optimization (cf. emitcode.ml)  *)
+  | Lprim (Pintcomp c, [arg ; (Lconst _ as k)], _) ->
+      let p = Pintcomp (swap_integer_comparison c)
+      and args = [k ; arg] in
+      comp_args env args sz (comp_primitive p args :: cont)
+  | Lprim (Pfloatcomp cmp, args, _) ->
+      let cont =
+        match cmp with
+        | CFeq -> Kccall("caml_eq_float", 2) :: cont
+        | CFneq -> Kccall("caml_neq_float", 2) :: cont
+        | CFlt -> Kccall("caml_lt_float", 2) :: cont
+        | CFnlt -> Kccall("caml_lt_float", 2) :: Kboolnot :: cont
+        | CFgt -> Kccall("caml_gt_float", 2) :: cont
+        | CFngt -> Kccall("caml_gt_float", 2) :: Kboolnot :: cont
+        | CFle -> Kccall("caml_le_float", 2) :: cont
+        | CFnle -> Kccall("caml_le_float", 2) :: Kboolnot :: cont
+        | CFge -> Kccall("caml_ge_float", 2) :: cont
+        | CFnge -> Kccall("caml_ge_float", 2) :: Kboolnot :: cont
+      in
+      comp_args env args sz cont
+  | Lprim(Pmakeblock(tag, _mut, _), args, loc) ->
+      let cont = add_pseudo_event loc !compunit_name cont in
+      comp_args env args sz (Kmakeblock(List.length args, tag) :: cont)
+  | Lprim(Pfloatfield n, args, loc) ->
+      let cont = add_pseudo_event loc !compunit_name cont in
+      comp_args env args sz (Kgetfloatfield n :: cont)
+  | Lprim(p, args, _) ->
+      comp_args env args sz (comp_primitive p args :: cont)
+  | Lstaticcatch (body, (i, vars) , handler) ->
+      let vars = List.map fst vars in
+      let nvars = List.length vars in
+      let branch1, cont1 = make_branch cont in
+      let r =
+        if nvars <> 1 then begin (* general case *)
+          let lbl_handler, cont2 =
+            label_code
+              (comp_expr
+                (add_vars vars (sz+1) env)
+                handler (sz+nvars) (add_pop nvars cont1)) in
+          push_static_raise i lbl_handler (sz+nvars);
+          push_dummies nvars
+            (comp_expr env body (sz+nvars)
+            (add_pop nvars (branch1 :: cont2)))
+        end else begin (* small optimization for nvars = 1 *)
+          let var = match vars with [var] -> var | _ -> assert false in
+          let lbl_handler, cont2 =
+            label_code
+              (Kpush::comp_expr
+                (add_var var (sz+1) env)
+                handler (sz+1) (add_pop 1 cont1)) in
+          push_static_raise i lbl_handler sz;
+          comp_expr env body sz (branch1 :: cont2)
+        end in
+      sz_static_raises := List.tl !sz_static_raises ;
+      r
+  | Lstaticraise (i, args) ->
+      let cont = discard_dead_code cont in
+      let label,size,tb = find_raise_label i in
+      let cont = branch_to label cont in
+      let rec loop sz tbb =
+        if tb == tbb then add_pop (sz-size) cont
+        else match tbb with
+        | [] -> assert false
+        | try_sz :: tbb -> add_pop (sz-try_sz-4) (Kpoptrap :: loop try_sz tbb)
+      in
+      let cont = loop sz !try_blocks in
+      begin match args with
+      | [arg] -> (* optim, argument passed in accumulator *)
+          comp_expr env arg sz cont
+      | _ -> comp_exit_args env args sz size cont
+      end
+  | Ltrywith(body, id, handler) ->
+      let (branch1, cont1) = make_branch cont in
+      let lbl_handler = new_label() in
+      let body_cont =
+        Kpoptrap :: branch1 ::
+        Klabel lbl_handler :: Kpush ::
+        comp_expr (add_var id (sz+1) env) handler (sz+1) (add_pop 1 cont1)
+      in
+      try_blocks := sz :: !try_blocks;
+      let l = comp_expr env body (sz+4) body_cont in
+      try_blocks := List.tl !try_blocks;
+      Kpushtrap lbl_handler :: l
+  | Lifthenelse(cond, ifso, ifnot) ->
+      comp_binary_test env cond ifso ifnot sz cont
+  | Lsequence(exp1, exp2) ->
+      comp_expr env exp1 sz (comp_expr env exp2 sz cont)
+  | Lwhile(cond, body) ->
+      let lbl_loop = new_label() in
+      let lbl_test = new_label() in
+      Kbranch lbl_test :: Klabel lbl_loop :: Kcheck_signals ::
+        comp_expr env body sz
+          (Klabel lbl_test ::
+            comp_expr env cond sz (Kbranchif lbl_loop :: add_const_unit cont))
+  | Lfor(param, start, stop, dir, body) ->
+      let lbl_loop = new_label() in
+      let lbl_exit = new_label() in
+      let offset = match dir with Upto -> 1 | Downto -> -1 in
+      let comp = match dir with Upto -> Cgt | Downto -> Clt in
+      comp_expr env start sz
+        (Kpush :: comp_expr env stop (sz+1)
+          (Kpush :: Kpush :: Kacc 2 :: Kintcomp comp :: Kbranchif lbl_exit ::
+           Klabel lbl_loop :: Kcheck_signals ::
+           comp_expr (add_var param (sz+1) env) body (sz+2)
+             (Kacc 1 :: Kpush :: Koffsetint offset :: Kassign 2 ::
+              Kacc 1 :: Kintcomp Cne :: Kbranchif lbl_loop ::
+              Klabel lbl_exit :: add_const_unit (add_pop 2 cont))))
+  | Lswitch(arg, sw, _loc) ->
+      let (branch, cont1) = make_branch cont in
+      let c = ref (discard_dead_code cont1) in
+
+(* Build indirection vectors *)
+      let store = Storer.mk_store () in
+      let act_consts = Array.make sw.sw_numconsts 0
+      and act_blocks = Array.make sw.sw_numblocks 0 in
+      begin match sw.sw_failaction with (* default is index 0 *)
+      | Some fail -> ignore (store.act_store () fail)
+      | None      -> ()
+      end ;
+      List.iter
+        (fun (n, act) -> act_consts.(n) <- store.act_store () act) sw.sw_consts;
+      List.iter
+        (fun (n, act) -> act_blocks.(n) <- store.act_store () act) sw.sw_blocks;
+(* Compile and label actions *)
+      let acts = store.act_get () in
+(*
+      let a = store.act_get_shared () in
+      Array.iter
+        (function
+          | Switch.Shared (Lstaticraise _) -> ()
+          | Switch.Shared act ->
+              Printlambda.lambda Format.str_formatter act ;
+              Printf.eprintf "SHARE BYTE:\n%s\n" (Format.flush_str_formatter ())
+          | _ -> ())
+        a ;
+*)
+      let lbls = Array.make (Array.length acts) 0 in
+      for i = Array.length acts-1 downto 0 do
+        let lbl,c1 = label_code (comp_expr env acts.(i) sz (branch :: !c)) in
+        lbls.(i) <- lbl ;
+        c := discard_dead_code c1
+      done ;
+
+(* Build label vectors *)
+      let lbl_blocks = Array.make sw.sw_numblocks 0 in
+      for i = sw.sw_numblocks - 1 downto 0 do
+        lbl_blocks.(i) <- lbls.(act_blocks.(i))
+      done;
+      let lbl_consts = Array.make sw.sw_numconsts 0 in
+      for i = sw.sw_numconsts - 1 downto 0 do
+        lbl_consts.(i) <- lbls.(act_consts.(i))
+      done;
+      comp_expr env arg sz (Kswitch(lbl_consts, lbl_blocks) :: !c)
+  | Lstringswitch (arg,sw,d,loc) ->
+      comp_expr env (Matching.expand_stringswitch loc arg sw d) sz cont
+  | Lassign(id, expr) ->
+      begin try
+        let pos = Ident.find_same id env.ce_stack in
+        comp_expr env expr sz (Kassign(sz - pos) :: cont)
+      with Not_found ->
+        fatal_error "Bytegen.comp_expr: assign"
+      end
+  | Levent(lam, lev) ->
+      let ev_defname = match lev.lev_loc with
+        | Loc_unknown -> "??"
+        | Loc_known { loc = _; scopes } -> string_of_scopes scopes in
+      let event kind info =
+        { ev_pos = 0;                   (* patched in emitcode *)
+          ev_module = !compunit_name;
+          ev_loc = to_location lev.lev_loc;
+          ev_kind = kind;
+          ev_defname;
+          ev_info = info;
+          ev_typenv = Env.summary lev.lev_env;
+          ev_typsubst = Subst.identity;
+          ev_compenv = env;
+          ev_stacksize = sz;
+          ev_repr =
+            begin match lev.lev_repr with
+              None ->
+                Event_none
+            | Some ({contents = 1} as repr) when lev.lev_kind = Lev_function ->
+                Event_child repr
+            | Some ({contents = 1} as repr) ->
+                Event_parent repr
+            | Some repr when lev.lev_kind = Lev_function ->
+                Event_parent repr
+            | Some repr ->
+                Event_child repr
+            end }
+      in
+      begin match lev.lev_kind with
+        Lev_before ->
+          let c = comp_expr env lam sz cont in
+          let ev = event Event_before Event_other in
+          add_event ev c
+      | Lev_function ->
+          let c = comp_expr env lam sz cont in
+          let ev = event Event_pseudo Event_function in
+          add_event ev c
+      | Lev_pseudo ->
+          let c = comp_expr env lam sz cont in
+          let ev = event Event_pseudo Event_other in
+          add_event ev c
+      | Lev_after ty ->
+          let preserve_tailcall =
+            match lam with
+            | Lprim(prim, _, _) -> preserve_tailcall_for_prim prim
+            | _ -> true
+          in
+          if preserve_tailcall && is_tailcall cont then
+            (* don't destroy tail call opt *)
+            comp_expr env lam sz cont
+          else begin
+            let info =
+              match lam with
+                Lapply{ap_args = args}  -> Event_return (List.length args)
+              | Lsend(_, _, _, args, _) -> Event_return (List.length args + 1)
+              | Lprim(_,args,_)         -> Event_return (List.length args)
+              | _                       -> Event_other
+            in
+            let ev = event (Event_after ty) info in
+            let cont1 = add_event ev cont in
+            comp_expr env lam sz cont1
+          end
+      | Lev_module_definition _ ->
+          comp_expr env lam sz cont
+      end
+  | Lifused (_, exp) ->
+      comp_expr env exp sz cont
+
+(* Compile a list of arguments [e1; ...; eN] to a primitive operation.
+   The values of eN ... e2 are pushed on the stack, e2 at top of stack,
+   then e3, then ... The value of e1 is left in the accumulator. *)
+
+and comp_args env argl sz cont =
+  comp_expr_list env (List.rev argl) sz cont
+
+and comp_expr_list env exprl sz cont = match exprl with
+    [] -> cont
+  | [exp] -> comp_expr env exp sz cont
+  | exp :: rem ->
+      comp_expr env exp sz (Kpush :: comp_expr_list env rem (sz+1) cont)
+
+and comp_exit_args  env argl sz pos cont =
+   comp_expr_list_assign env (List.rev argl) sz pos cont
+
+and comp_expr_list_assign env exprl sz pos cont = match exprl with
+  | [] -> cont
+  | exp :: rem ->
+      comp_expr env exp sz
+        (Kassign (sz-pos)::comp_expr_list_assign env rem sz (pos-1) cont)
+
+(* Compile an if-then-else test. *)
+
+and comp_binary_test env cond ifso ifnot sz cont =
+  let cont_cond =
+    if ifnot = Lconst const_unit then begin
+      let (lbl_end, cont1) = label_code cont in
+      Kstrictbranchifnot lbl_end :: comp_expr env ifso sz cont1
+    end else
+    match code_as_jump ifso sz with
+    | Some label ->
+      let cont = comp_expr env ifnot sz cont in
+      Kbranchif label :: cont
+    | _ ->
+        match code_as_jump ifnot sz with
+        | Some label ->
+            let cont = comp_expr env ifso sz cont in
+            Kbranchifnot label :: cont
+        | _ ->
+            let (branch_end, cont1) = make_branch cont in
+            let (lbl_not, cont2) = label_code(comp_expr env ifnot sz cont1) in
+            Kbranchifnot lbl_not ::
+            comp_expr env ifso sz (branch_end :: cont2) in
+
+  comp_expr env cond sz cont_cond
+
+(**** Compilation of a code block (with tracking of stack usage) ****)
+
+let comp_block env exp sz cont =
+  max_stack_used := 0;
+  let code = comp_expr env exp sz cont in
+  let used_safe = !max_stack_used + Config.stack_safety_margin in
+  if used_safe > Config.stack_threshold then
+    Kconst(Const_base(Const_int used_safe)) ::
+    Kccall("caml_ensure_stack_capacity", 1) ::
+    code
+  else
+    code
+
+(**** Compilation of functions ****)
+
+let comp_function tc cont =
+  let arity = List.length tc.params in
+  let rec positions pos delta = function
+      [] -> Ident.empty
+    | id :: rem -> Ident.add id pos (positions (pos + delta) delta rem) in
+  let env =
+    { ce_stack = positions arity (-1) tc.params;
+      ce_heap = positions (2 * (tc.num_defs - tc.rec_pos) - 1) 1 tc.free_vars;
+      ce_rec = positions (-2 * tc.rec_pos) 2 tc.rec_vars } in
+  let cont =
+    comp_block env tc.body arity (Kreturn arity :: cont) in
+  if arity > 1 then
+    Krestart :: Klabel tc.label :: Kgrab(arity - 1) :: cont
+  else
+    Klabel tc.label :: cont
+
+let comp_remainder cont =
+  let c = ref cont in
+  begin try
+    while true do
+      c := comp_function (Stack.pop functions_to_compile) !c
+    done
+  with Stack.Empty ->
+    ()
+  end;
+  !c
+
+(**** Compilation of a lambda phrase ****)
+
+let compile_implementation modulename expr =
+  Stack.clear functions_to_compile;
+  label_counter := 0;
+  sz_static_raises := [] ;
+  compunit_name := modulename;
+  let init_code = comp_block empty_env expr 0 [] in
+  if Stack.length functions_to_compile > 0 then begin
+    let lbl_init = new_label() in
+    Kbranch lbl_init :: comp_remainder (Klabel lbl_init :: init_code)
+  end else
+    init_code
+
+let compile_phrase expr =
+  Stack.clear functions_to_compile;
+  label_counter := 0;
+  sz_static_raises := [] ;
+  let init_code = comp_block empty_env expr 1 [Kreturn 1] in
+  let fun_code = comp_remainder [] in
+  (init_code, fun_code)
+
+let reset () =
+  label_counter := 0;
+  sz_static_raises := [];
+  compunit_name := "";
+  Stack.clear functions_to_compile;
+  max_stack_used := 0
diff --git a/bytecomp/bytegen.mli b/bytecomp/bytegen.mli
new file mode 100644
index 00000000..80c222bf
--- /dev/null
+++ b/bytecomp/bytegen.mli
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Generation of bytecode from lambda terms *)
+
+open Lambda
+open Instruct
+
+val compile_implementation: string -> lambda -> instruction list
+val compile_phrase: lambda -> instruction list * instruction list
+val reset: unit -> unit
+
+val merge_events:
+  Instruct.debug_event -> Instruct.debug_event -> Instruct.debug_event
diff --git a/bytecomp/bytelibrarian.ml b/bytecomp/bytelibrarian.ml
new file mode 100644
index 00000000..294a6976
--- /dev/null
+++ b/bytecomp/bytelibrarian.ml
@@ -0,0 +1,135 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Build libraries of .cmo files *)
+
+open Misc
+open Config
+open Cmo_format
+
+type error =
+    File_not_found of string
+  | Not_an_object_file of string
+
+exception Error of error
+
+(* Copy a compilation unit from a .cmo or .cma into the archive *)
+let copy_compunit ic oc compunit =
+  seek_in ic compunit.cu_pos;
+  compunit.cu_pos <- pos_out oc;
+  compunit.cu_force_link <- compunit.cu_force_link || !Clflags.link_everything;
+  copy_file_chunk ic oc compunit.cu_codesize;
+  if compunit.cu_debug > 0 then begin
+    seek_in ic compunit.cu_debug;
+    compunit.cu_debug <- pos_out oc;
+    copy_file_chunk ic oc compunit.cu_debugsize
+  end
+
+(* Add C objects and options and "custom" info from a library descriptor *)
+
+let lib_ccobjs = ref []
+let lib_ccopts = ref []
+let lib_dllibs = ref []
+
+(* See Bytelink.add_ccobjs for explanations on how options are ordered.
+   Notice that here we scan .cma files given on the command line from
+   left to right, hence options must be added after. *)
+
+let add_ccobjs l =
+  if not !Clflags.no_auto_link then begin
+    if l.lib_custom then Clflags.custom_runtime := true;
+    lib_ccobjs := !lib_ccobjs @ l.lib_ccobjs;
+    lib_ccopts := !lib_ccopts @ l.lib_ccopts;
+    lib_dllibs := !lib_dllibs @ l.lib_dllibs
+  end
+
+let copy_object_file oc name =
+  let file_name =
+    try
+      Load_path.find name
+    with Not_found ->
+      raise(Error(File_not_found name)) in
+  let ic = open_in_bin file_name in
+  try
+    let buffer = really_input_string ic (String.length cmo_magic_number) in
+    if buffer = cmo_magic_number then begin
+      let compunit_pos = input_binary_int ic in
+      seek_in ic compunit_pos;
+      let compunit = (input_value ic : compilation_unit) in
+      Bytelink.check_consistency file_name compunit;
+      copy_compunit ic oc compunit;
+      close_in ic;
+      [compunit]
+    end else
+    if buffer = cma_magic_number then begin
+      let toc_pos = input_binary_int ic in
+      seek_in ic toc_pos;
+      let toc = (input_value ic : library) in
+      List.iter (Bytelink.check_consistency file_name) toc.lib_units;
+      add_ccobjs toc;
+      List.iter (copy_compunit ic oc) toc.lib_units;
+      close_in ic;
+      toc.lib_units
+    end else
+      raise(Error(Not_an_object_file file_name))
+  with
+    End_of_file -> close_in ic; raise(Error(Not_an_object_file file_name))
+  | x -> close_in ic; raise x
+
+let create_archive file_list lib_name =
+  let outchan = open_out_bin lib_name in
+  Misc.try_finally
+    ~always:(fun () -> close_out outchan)
+    ~exceptionally:(fun () -> remove_file lib_name)
+    (fun () ->
+       output_string outchan cma_magic_number;
+       let ofs_pos_toc = pos_out outchan in
+       output_binary_int outchan 0;
+       let units =
+         List.flatten(List.map (copy_object_file outchan) file_list) in
+       let toc =
+         { lib_units = units;
+           lib_custom = !Clflags.custom_runtime;
+           lib_ccobjs = !Clflags.ccobjs @ !lib_ccobjs;
+           lib_ccopts = !Clflags.all_ccopts @ !lib_ccopts;
+           lib_dllibs = !Clflags.dllibs @ !lib_dllibs } in
+       let pos_toc = pos_out outchan in
+       Emitcode.marshal_to_channel_with_possibly_32bit_compat
+         ~filename:lib_name ~kind:"bytecode library"
+         outchan toc;
+       seek_out outchan ofs_pos_toc;
+       output_binary_int outchan pos_toc;
+    )
+
+open Format
+
+let report_error ppf = function
+  | File_not_found name ->
+      fprintf ppf "Cannot find file %s" name
+  | Not_an_object_file name ->
+      fprintf ppf "The file %a is not a bytecode object file"
+        Location.print_filename name
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )
+
+let reset () =
+  lib_ccobjs := [];
+  lib_ccopts := [];
+  lib_dllibs := []
diff --git a/bytecomp/bytelibrarian.mli b/bytecomp/bytelibrarian.mli
new file mode 100644
index 00000000..3670730d
--- /dev/null
+++ b/bytecomp/bytelibrarian.mli
@@ -0,0 +1,37 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Build libraries of .cmo files *)
+
+(* Format of a library file:
+      magic number (Config.cma_magic_number)
+      absolute offset of content table
+      blocks of relocatable bytecode
+      content table = list of compilation units
+*)
+
+val create_archive: string list -> string -> unit
+
+type error =
+    File_not_found of string
+  | Not_an_object_file of string
+
+exception Error of error
+
+open Format
+
+val report_error: formatter -> error -> unit
+
+val reset: unit -> unit
diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml
new file mode 100644
index 00000000..9a7a46ab
--- /dev/null
+++ b/bytecomp/bytelink.ml
@@ -0,0 +1,774 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Link a set of .cmo files and produce a bytecode executable. *)
+
+open Misc
+open Config
+open Cmo_format
+
+type error =
+  | File_not_found of filepath
+  | Not_an_object_file of filepath
+  | Wrong_object_name of filepath
+  | Symbol_error of filepath * Symtable.error
+  | Inconsistent_import of modname * filepath * filepath
+  | Custom_runtime
+  | File_exists of filepath
+  | Cannot_open_dll of filepath
+  | Required_module_unavailable of modname
+  | Camlheader of string * filepath
+
+exception Error of error
+
+type link_action =
+    Link_object of string * compilation_unit
+      (* Name of .cmo file and descriptor of the unit *)
+  | Link_archive of string * compilation_unit list
+      (* Name of .cma file and descriptors of the units to be linked. *)
+
+(* Add C objects and options from a library descriptor *)
+(* Ignore them if -noautolink or -use-runtime or -use-prim was given *)
+
+let lib_ccobjs = ref []
+let lib_ccopts = ref []
+let lib_dllibs = ref []
+
+let add_ccobjs origin l =
+  if not !Clflags.no_auto_link then begin
+    if
+      String.length !Clflags.use_runtime = 0
+      && String.length !Clflags.use_prims = 0
+    then begin
+      if l.lib_custom then Clflags.custom_runtime := true;
+      lib_ccobjs := l.lib_ccobjs @ !lib_ccobjs;
+      let replace_origin =
+        Misc.replace_substring ~before:"$CAMLORIGIN" ~after:origin
+      in
+      lib_ccopts := List.map replace_origin l.lib_ccopts @ !lib_ccopts;
+    end;
+    lib_dllibs := l.lib_dllibs @ !lib_dllibs
+  end
+
+(* A note on ccobj ordering:
+   - Clflags.ccobjs is in reverse order w.r.t. what was given on the
+        ocamlc command line;
+   - l.lib_ccobjs is also in reverse order w.r.t. what was given on the
+        ocamlc -a command line when the library was created;
+   - Clflags.ccobjs is reversed just before calling the C compiler for the
+        custom link;
+   - .cma files on the command line of ocamlc are scanned right to left;
+   - Before linking, we add lib_ccobjs after Clflags.ccobjs.
+   Thus, for ocamlc a.cma b.cma obj1 obj2
+   where a.cma was built with ocamlc -i ... obja1 obja2
+     and b.cma was built with ocamlc -i ... objb1 objb2
+   lib_ccobjs starts as [],
+   becomes objb2 objb1 when b.cma is scanned,
+   then obja2 obja1 objb2 objb1 when a.cma is scanned.
+   Clflags.ccobjs was initially obj2 obj1.
+   and is set to obj2 obj1 obja2 obja1 objb2 objb1.
+   Finally, the C compiler is given objb1 objb2 obja1 obja2 obj1 obj2,
+   which is what we need.  (If b depends on a, a.cma must appear before
+   b.cma, but b's C libraries must appear before a's C libraries.)
+*)
+
+(* First pass: determine which units are needed *)
+
+let missing_globals = ref Ident.Set.empty
+
+let is_required (rel, _pos) =
+  match rel with
+    Reloc_setglobal id ->
+      Ident.Set.mem id !missing_globals
+  | _ -> false
+
+let add_required compunit =
+  let add id =
+    missing_globals := Ident.Set.add id !missing_globals
+  in
+  List.iter add (Symtable.required_globals compunit.cu_reloc);
+  List.iter add compunit.cu_required_globals
+
+let remove_required (rel, _pos) =
+  match rel with
+    Reloc_setglobal id ->
+      missing_globals := Ident.Set.remove id !missing_globals
+  | _ -> ()
+
+let scan_file obj_name tolink =
+  let file_name =
+    try
+      Load_path.find obj_name
+    with Not_found ->
+      raise(Error(File_not_found obj_name)) in
+  let ic = open_in_bin file_name in
+  try
+    let buffer = really_input_string ic (String.length cmo_magic_number) in
+    if buffer = cmo_magic_number then begin
+      (* This is a .cmo file. It must be linked in any case.
+         Read the relocation information to see which modules it
+         requires. *)
+      let compunit_pos = input_binary_int ic in  (* Go to descriptor *)
+      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;
+      Link_object(file_name, compunit) :: tolink
+    end
+    else if buffer = cma_magic_number then begin
+      (* This is an archive file. Each unit contained in it will be linked
+         in only if needed. *)
+      let pos_toc = input_binary_int ic in    (* Go to table of contents *)
+      seek_in ic pos_toc;
+      let toc = (input_value ic : library) in
+      close_in ic;
+      add_ccobjs (Filename.dirname file_name) toc;
+      let required =
+        List.fold_right
+          (fun compunit reqd ->
+            if compunit.cu_force_link
+            || !Clflags.link_everything
+            || List.exists is_required compunit.cu_reloc
+            then begin
+              add_required compunit;
+              List.iter remove_required compunit.cu_reloc;
+              compunit :: reqd
+            end else
+              reqd)
+          toc.lib_units [] in
+      Link_archive(file_name, required) :: tolink
+    end
+    else raise(Error(Not_an_object_file file_name))
+  with
+    End_of_file -> close_in ic; raise(Error(Not_an_object_file file_name))
+  | x -> close_in ic; raise x
+
+(* Second pass: link in the required units *)
+
+(* Consistency check between interfaces *)
+
+module Consistbl = Consistbl.Make (Misc.Stdlib.String)
+
+let crc_interfaces = Consistbl.create ()
+let interfaces = ref ([] : string list)
+let implementations_defined = ref ([] : (string * string) list)
+
+let check_consistency file_name cu =
+  begin try
+    List.iter
+      (fun (name, crco) ->
+        interfaces := name :: !interfaces;
+        match crco with
+          None -> ()
+        | Some crc ->
+            if name = cu.cu_name
+            then Consistbl.set crc_interfaces name crc file_name
+            else Consistbl.check crc_interfaces name crc file_name)
+      cu.cu_imports
+  with Consistbl.Inconsistency {
+      unit_name = name;
+      inconsistent_source = user;
+      original_source = auth;
+    } ->
+    raise(Error(Inconsistent_import(name, user, auth)))
+  end;
+  begin try
+    let source = List.assoc cu.cu_name !implementations_defined in
+    Location.prerr_warning (Location.in_file file_name)
+      (Warnings.Multiple_definition(cu.cu_name,
+                                    Location.show_filename file_name,
+                                    Location.show_filename source))
+  with Not_found -> ()
+  end;
+  implementations_defined :=
+    (cu.cu_name, file_name) :: !implementations_defined
+
+let extract_crc_interfaces () =
+  Consistbl.extract !interfaces crc_interfaces
+
+let clear_crc_interfaces () =
+  Consistbl.clear crc_interfaces;
+  interfaces := []
+
+(* Record compilation events *)
+
+let debug_info = ref ([] : (int * Instruct.debug_event list * string list) list)
+
+(* Link in a compilation unit *)
+
+let link_compunit output_fun currpos_fun inchan file_name compunit =
+  check_consistency file_name compunit;
+  seek_in inchan compunit.cu_pos;
+  let code_block = LongString.input_bytes inchan compunit.cu_codesize in
+  Symtable.patch_object code_block compunit.cu_reloc;
+  if !Clflags.debug && compunit.cu_debug > 0 then begin
+    seek_in inchan compunit.cu_debug;
+    let debug_event_list : Instruct.debug_event list = input_value inchan in
+    let debug_dirs : string list = input_value inchan in
+    let file_path = Filename.dirname (Location.absolute_path file_name) in
+    let debug_dirs =
+      if List.mem file_path debug_dirs
+      then debug_dirs
+      else file_path :: debug_dirs in
+    debug_info := (currpos_fun(), debug_event_list, debug_dirs) :: !debug_info
+  end;
+  Array.iter output_fun code_block;
+  if !Clflags.link_everything then
+    List.iter Symtable.require_primitive compunit.cu_primitives
+
+(* Link in a .cmo file *)
+
+let link_object output_fun currpos_fun file_name compunit =
+  let inchan = open_in_bin file_name in
+  try
+    link_compunit output_fun currpos_fun inchan file_name compunit;
+    close_in inchan
+  with
+    Symtable.Error msg ->
+      close_in inchan; raise(Error(Symbol_error(file_name, msg)))
+  | x ->
+      close_in inchan; raise x
+
+(* Link in a .cma file *)
+
+let link_archive output_fun currpos_fun file_name units_required =
+  let inchan = open_in_bin file_name in
+  try
+    List.iter
+      (fun cu ->
+         let name = file_name ^ "(" ^ cu.cu_name ^ ")" in
+         try
+           link_compunit output_fun currpos_fun inchan name cu
+         with Symtable.Error msg ->
+           raise(Error(Symbol_error(name, msg))))
+      units_required;
+    close_in inchan
+  with x -> close_in inchan; raise x
+
+(* Link in a .cmo or .cma file *)
+
+let link_file output_fun currpos_fun = function
+    Link_object(file_name, unit) ->
+      link_object output_fun currpos_fun file_name unit
+  | Link_archive(file_name, units) ->
+      link_archive output_fun currpos_fun file_name units
+
+(* Output the debugging information *)
+(* Format is:
+                number of event lists
+                offset of first event list
+         first event list
+      ...
+                offset of last event list
+         last event list *)
+
+let output_debug_info oc =
+  output_binary_int oc (List.length !debug_info);
+  List.iter
+    (fun (ofs, evl, debug_dirs) ->
+      output_binary_int oc ofs;
+      output_value oc evl;
+      output_value oc debug_dirs)
+    !debug_info;
+  debug_info := []
+
+(* Output a list of strings with 0-termination *)
+
+let output_stringlist oc l =
+  List.iter (fun s -> output_string oc s; output_byte oc 0) l
+
+(* Transform a file name into an absolute file name *)
+
+let make_absolute file =
+  if not (Filename.is_relative file) then file
+  else Location.rewrite_absolute_path
+         (Filename.concat (Sys.getcwd()) file)
+
+(* Create a bytecode executable file *)
+
+let link_bytecode ?final_name tolink exec_name standalone =
+  let final_name = Option.value final_name ~default:exec_name in
+  (* Avoid the case where the specified exec output file is the same as
+     one of the objects to be linked *)
+  List.iter (function
+    | Link_object(file_name, _) when file_name = exec_name ->
+      raise (Error (Wrong_object_name exec_name));
+    | _ -> ()) tolink;
+  Misc.remove_file exec_name; (* avoid permission problems, cf PR#8354 *)
+  let outperm = if !Clflags.with_runtime then 0o777 else 0o666 in
+  let outchan =
+    open_out_gen [Open_wronly; Open_trunc; Open_creat; Open_binary]
+                 outperm exec_name in
+  Misc.try_finally
+    ~always:(fun () -> close_out outchan)
+    ~exceptionally:(fun () -> remove_file exec_name)
+    (fun () ->
+       if standalone && !Clflags.with_runtime then begin
+         (* Copy the header *)
+         let header =
+           if String.length !Clflags.use_runtime > 0
+           then "camlheader_ur" else "camlheader" ^ !Clflags.runtime_variant
+         in
+         try
+           let inchan = open_in_bin (Load_path.find header) in
+           copy_file inchan outchan;
+           close_in inchan
+         with
+         | Not_found -> raise (Error (File_not_found header))
+         | Sys_error msg -> raise (Error (Camlheader (header, msg)))
+       end;
+       Bytesections.init_record outchan;
+       (* The path to the bytecode interpreter (in use_runtime mode) *)
+       if String.length !Clflags.use_runtime > 0 && !Clflags.with_runtime then
+       begin
+         let runtime = make_absolute !Clflags.use_runtime in
+         let runtime =
+           (* shebang mustn't exceed 128 including the #! and \0 *)
+           if String.length runtime > 125 then
+             "/bin/sh\n\
+              exec \"" ^ runtime ^ "\" \"$0\" \"$@\""
+           else
+             runtime
+         in
+         output_string outchan runtime;
+         output_char outchan '\n';
+         Bytesections.record outchan "RNTM"
+       end;
+       (* The bytecode *)
+       let start_code = pos_out outchan in
+       Symtable.init();
+       clear_crc_interfaces ();
+       let sharedobjs = List.map Dll.extract_dll_name !Clflags.dllibs in
+       let check_dlls = standalone && Config.target = Config.host in
+       if check_dlls then begin
+         (* Initialize the DLL machinery *)
+         Dll.init_compile !Clflags.no_std_include;
+         Dll.add_path (Load_path.get_paths ());
+         try Dll.open_dlls Dll.For_checking sharedobjs
+         with Failure reason -> raise(Error(Cannot_open_dll reason))
+       end;
+       let output_fun = output_bytes outchan
+       and currpos_fun () = pos_out outchan - start_code in
+       List.iter (link_file output_fun currpos_fun) tolink;
+       if check_dlls then Dll.close_all_dlls();
+       (* The final STOP instruction *)
+       output_byte outchan Opcodes.opSTOP;
+       output_byte outchan 0; output_byte outchan 0; output_byte outchan 0;
+       Bytesections.record outchan "CODE";
+       (* DLL stuff *)
+       if standalone then begin
+         (* The extra search path for DLLs *)
+         output_stringlist outchan !Clflags.dllpaths;
+         Bytesections.record outchan "DLPT";
+         (* The names of the DLLs *)
+         output_stringlist outchan sharedobjs;
+         Bytesections.record outchan "DLLS"
+       end;
+       (* The names of all primitives *)
+       Symtable.output_primitive_names outchan;
+       Bytesections.record outchan "PRIM";
+       (* The table of global data *)
+       Emitcode.marshal_to_channel_with_possibly_32bit_compat
+         ~filename:final_name ~kind:"bytecode executable"
+         outchan (Symtable.initial_global_table());
+       Bytesections.record outchan "DATA";
+       (* The map of global identifiers *)
+       Symtable.output_global_map outchan;
+       Bytesections.record outchan "SYMB";
+       (* CRCs for modules *)
+       output_value outchan (extract_crc_interfaces());
+       Bytesections.record outchan "CRCS";
+       (* Debug info *)
+       if !Clflags.debug then begin
+         output_debug_info outchan;
+         Bytesections.record outchan "DBUG"
+       end;
+       (* The table of contents and the trailer *)
+       Bytesections.write_toc_and_trailer outchan;
+    )
+
+(* Output a string as a C array of unsigned ints *)
+
+let output_code_string_counter = ref 0
+
+let output_code_string outchan code =
+  let pos = ref 0 in
+  let len = Bytes.length code in
+  while !pos < len do
+    let c1 = Char.code(Bytes.get code !pos) in
+    let c2 = Char.code(Bytes.get code (!pos + 1)) in
+    let c3 = Char.code(Bytes.get code (!pos + 2)) in
+    let c4 = Char.code(Bytes.get code (!pos + 3)) in
+    pos := !pos + 4;
+    Printf.fprintf outchan "0x%02x%02x%02x%02x, " c4 c3 c2 c1;
+    incr output_code_string_counter;
+    if !output_code_string_counter >= 6 then begin
+      output_char outchan '\n';
+      output_code_string_counter := 0
+    end
+  done
+
+(* Output a string as a C string *)
+
+let output_data_string outchan data =
+  let counter = ref 0 in
+  for i = 0 to String.length data - 1 do
+    Printf.fprintf outchan "%d, " (Char.code(data.[i]));
+    incr counter;
+    if !counter >= 12 then begin
+      output_string outchan "\n";
+      counter := 0
+    end
+  done
+
+(* Output a debug stub *)
+
+let output_cds_file outfile =
+  Misc.remove_file outfile;
+  let outchan =
+    open_out_gen [Open_wronly; Open_trunc; Open_creat; Open_binary]
+      0o777 outfile in
+  Misc.try_finally
+    ~always:(fun () -> close_out outchan)
+    ~exceptionally:(fun () -> remove_file outfile)
+    (fun () ->
+       Bytesections.init_record outchan;
+       (* The map of global identifiers *)
+       Symtable.output_global_map outchan;
+       Bytesections.record outchan "SYMB";
+       (* Debug info *)
+       output_debug_info outchan;
+       Bytesections.record outchan "DBUG";
+       (* The table of contents and the trailer *)
+       Bytesections.write_toc_and_trailer outchan;
+    )
+
+(* Output a bytecode executable as a C file *)
+
+let link_bytecode_as_c tolink outfile with_main =
+  let outchan = open_out outfile in
+  Misc.try_finally
+    ~always:(fun () -> close_out outchan)
+    ~exceptionally:(fun () -> remove_file outfile)
+    (fun () ->
+       (* The bytecode *)
+       output_string outchan "\
+#define CAML_INTERNALS\
+\n\
+\n#ifdef __cplusplus\
+\nextern \"C\" {\
+\n#endif\
+\n#include \
+\n#include \n";
+       output_string outchan "static int caml_code[] = {\n";
+       Symtable.init();
+       clear_crc_interfaces ();
+       let currpos = ref 0 in
+       let output_fun code =
+         output_code_string outchan code;
+         currpos := !currpos + Bytes.length code
+       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;
+       (* The table of global data *)
+       output_string outchan "static char caml_data[] = {\n";
+       output_data_string outchan
+         (Marshal.to_string (Symtable.initial_global_table()) []);
+       output_string outchan "\n};\n\n";
+       (* The sections *)
+       let sections =
+         [ "SYMB", Symtable.data_global_map();
+           "PRIM", Obj.repr(Symtable.data_primitive_names());
+           "CRCS", Obj.repr(extract_crc_interfaces()) ] in
+       output_string outchan "static char caml_sections[] = {\n";
+       output_data_string outchan
+         (Marshal.to_string sections []);
+       output_string outchan "\n};\n\n";
+       (* The table of primitives *)
+       Symtable.output_primitive_table outchan;
+       (* The entry point *)
+       if with_main then begin
+         output_string outchan "\
+\n#ifdef _WIN32\
+\nint wmain(int argc, wchar_t **argv)\
+\n#else\
+\nint main(int argc, char **argv)\
+\n#endif\
+\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_sys_exit(Val_int(0));\
+\n  return 0; /* not reached */\
+\n}\n"
+       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"
+       end;
+       output_string outchan "\
+\n#ifdef __cplusplus\
+\n}\
+\n#endif\n";
+    );
+  if !Clflags.debug then
+    output_cds_file ((Filename.chop_extension outfile) ^ ".cds")
+
+(* Build a custom runtime *)
+
+let build_custom_runtime prim_name exec_name =
+  let runtime_lib =
+    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
+      [Printf.sprintf "-fdebug-prefix-map=%s=camlprim.c" prim_name]
+    else
+      [] in
+  let exitcode =
+    (Clflags.std_include_flag "-I" ^ " " ^ Config.bytecomp_c_libraries)
+  in
+  Ccomp.call_linker Ccomp.Exe exec_name
+    (debug_prefix_map @ [prim_name] @ List.rev !Clflags.ccobjs @ [runtime_lib])
+    exitcode = 0
+
+let append_bytecode bytecode_name exec_name =
+  let oc = open_out_gen [Open_wronly; Open_append; Open_binary] 0 exec_name in
+  let ic = open_in_bin bytecode_name in
+  copy_file ic oc;
+  close_in ic;
+  close_out oc
+
+(* Fix the name of the output file, if the C compiler changes it behind
+   our back. *)
+
+let fix_exec_name name =
+  match Sys.os_type with
+    "Win32" | "Cygwin" ->
+      if String.contains name '.' then name else name ^ ".exe"
+  | _ -> name
+
+(* Main entry point (build a custom runtime if needed) *)
+
+let link objfiles output_name =
+  let objfiles =
+    match
+      !Clflags.nopervasives,
+      !Clflags.output_c_object,
+      !Clflags.output_complete_executable
+    with
+    | true, _, _         -> objfiles
+    | false, true, false -> "stdlib.cma" :: objfiles
+    | _                  -> "stdlib.cma" :: objfiles @ ["std_exit.cmo"]
+  in
+  let tolink = List.fold_right scan_file objfiles [] in
+  let missing_modules =
+    Ident.Set.filter (fun id -> not (Ident.is_predef id)) !missing_globals
+  in
+  begin
+    match Ident.Set.elements missing_modules with
+    | [] -> ()
+    | id :: _ -> raise (Error (Required_module_unavailable (Ident.name id)))
+  end;
+  Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs; (* put user's libs last *)
+  Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts;
+                                                   (* put user's opts first *)
+  Clflags.dllibs := !lib_dllibs @ !Clflags.dllibs; (* put user's DLLs first *)
+  if not !Clflags.custom_runtime then
+    link_bytecode tolink output_name true
+  else if not !Clflags.output_c_object then begin
+    let bytecode_name = Filename.temp_file "camlcode" "" in
+    let prim_name =
+      if !Clflags.keep_camlprimc_file then
+        output_name ^ ".camlprim.c"
+      else
+        Filename.temp_file "camlprim" ".c" in
+    Misc.try_finally
+      ~always:(fun () ->
+          remove_file bytecode_name;
+          if not !Clflags.keep_camlprimc_file then remove_file prim_name)
+      (fun () ->
+         link_bytecode ~final_name:output_name tolink bytecode_name false;
+         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";
+         Symtable.output_primitive_table poc;
+         output_string poc "\
+         #ifdef __cplusplus\n\
+         }\n\
+         #endif\n";
+         close_out poc;
+         let exec_name = fix_exec_name output_name in
+         if not (build_custom_runtime prim_name exec_name)
+         then raise(Error Custom_runtime);
+         if not !Clflags.make_runtime then
+           append_bytecode bytecode_name exec_name
+      )
+  end else begin
+    let basename = Filename.remove_extension output_name in
+    let c_file, stable_name =
+      if !Clflags.output_complete_object
+         && not (Filename.check_suffix output_name ".c")
+      then Filename.temp_file "camlobj" ".c", Some "camlobj.c"
+      else begin
+        let f = basename ^ ".c" in
+        if Sys.file_exists f then raise(Error(File_exists f));
+        f, None
+      end
+    in
+    let obj_file =
+      if !Clflags.output_complete_object
+      then (Filename.chop_extension c_file) ^ Config.ext_obj
+      else basename ^ Config.ext_obj
+    in
+    let temps = ref [] in
+    Misc.try_finally
+      ~always:(fun () -> List.iter remove_file !temps)
+      (fun () ->
+         link_bytecode_as_c tolink c_file !Clflags.output_complete_executable;
+         if !Clflags.output_complete_executable then begin
+           temps := c_file :: !temps;
+           if not (build_custom_runtime c_file output_name) then
+             raise(Error Custom_runtime)
+         end else if not (Filename.check_suffix output_name ".c") then begin
+           temps := c_file :: !temps;
+           if Ccomp.compile_file ~output:obj_file ?stable_name c_file <> 0 then
+             raise(Error Custom_runtime);
+           if not (Filename.check_suffix output_name Config.ext_obj) ||
+              !Clflags.output_complete_object then begin
+             temps := obj_file :: !temps;
+             let mode, c_libs =
+               if Filename.check_suffix output_name Config.ext_obj
+               then Ccomp.Partial, ""
+               else Ccomp.MainDll, Config.bytecomp_c_libraries
+             in
+             if not (
+                 let runtime_lib =
+                   if not !Clflags.with_runtime
+                   then ""
+                   else "-lcamlrun" ^ !Clflags.runtime_variant in
+                 Ccomp.call_linker mode output_name
+                   ([obj_file] @ List.rev !Clflags.ccobjs @ [runtime_lib])
+                   c_libs = 0
+               ) then raise (Error Custom_runtime);
+           end
+         end;
+      )
+  end
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+  | File_not_found name ->
+      fprintf ppf "Cannot find file %a" Location.print_filename name
+  | Not_an_object_file name ->
+      fprintf ppf "The file %a is not a bytecode object file"
+        Location.print_filename name
+  | Wrong_object_name name ->
+      fprintf ppf "The output file %s has the wrong name. The extension implies\
+                  \ an object file but the link step was requested" name
+  | Symbol_error(name, err) ->
+      fprintf ppf "Error while linking %a:@ %a" Location.print_filename name
+      Symtable.report_error err
+  | Inconsistent_import(intf, file1, file2) ->
+      fprintf ppf
+        "@[Files %a@ and %a@ \
+                 make inconsistent assumptions over interface %s@]"
+        Location.print_filename file1
+        Location.print_filename file2
+        intf
+  | Custom_runtime ->
+      fprintf ppf "Error while building custom runtime system"
+  | File_exists file ->
+      fprintf ppf "Cannot overwrite existing file %a"
+        Location.print_filename file
+  | Cannot_open_dll file ->
+      fprintf ppf "Error on dynamically loaded library: %a"
+        Location.print_filename file
+  | Required_module_unavailable s ->
+      fprintf ppf "Required module `%s' is unavailable" s
+  | Camlheader (msg, header) ->
+      fprintf ppf "System error while copying file %s: %s" header msg
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )
+
+let reset () =
+  lib_ccobjs := [];
+  lib_ccopts := [];
+  lib_dllibs := [];
+  missing_globals := Ident.Set.empty;
+  Consistbl.clear crc_interfaces;
+  implementations_defined := [];
+  debug_info := [];
+  output_code_string_counter := 0
diff --git a/bytecomp/bytelink.mli b/bytecomp/bytelink.mli
new file mode 100644
index 00000000..4792e7c8
--- /dev/null
+++ b/bytecomp/bytelink.mli
@@ -0,0 +1,43 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Misc
+
+(* Link .cmo files and produce a bytecode executable. *)
+
+val link : filepath list -> filepath -> unit
+val reset : unit -> unit
+
+val check_consistency: filepath -> Cmo_format.compilation_unit -> unit
+
+val extract_crc_interfaces: unit -> crcs
+
+type error =
+  | File_not_found of filepath
+  | Not_an_object_file of filepath
+  | Wrong_object_name of filepath
+  | Symbol_error of filepath * Symtable.error
+  | Inconsistent_import of modname * filepath * filepath
+  | Custom_runtime
+  | File_exists of filepath
+  | Cannot_open_dll of filepath
+  | Required_module_unavailable of modname
+  | Camlheader of string * filepath
+
+exception Error of error
+
+open Format
+
+val report_error: formatter -> error -> unit
diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml
new file mode 100644
index 00000000..2458030b
--- /dev/null
+++ b/bytecomp/bytepackager.ml
@@ -0,0 +1,331 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* "Package" a set of .cmo files into one .cmo file having the
+   original compilation units as sub-modules. *)
+
+open Misc
+open Instruct
+open Cmo_format
+module String = Misc.Stdlib.String
+
+type error =
+    Forward_reference of string * Ident.t
+  | Multiple_definition of string * Ident.t
+  | Not_an_object_file of string
+  | Illegal_renaming of string * string * string
+  | File_not_found of string
+
+exception Error of error
+
+(* References accumulating information on the .cmo files *)
+
+let relocs = ref ([] : (reloc_info * int) list)
+let events = ref ([] : debug_event list)
+let debug_dirs = ref String.Set.empty
+let primitives = ref ([] : string list)
+let force_link = ref false
+
+(* Record a relocation.  Update its offset, and rename GETGLOBAL and
+   SETGLOBAL relocations that correspond to one of the units being
+   consolidated. *)
+
+let rename_relocation packagename objfile mapping defined base (rel, ofs) =
+  let rel' =
+    match rel with
+      Reloc_getglobal id ->
+        begin try
+          let id' = List.assoc id mapping in
+          if List.mem id defined
+          then Reloc_getglobal id'
+          else raise(Error(Forward_reference(objfile, id)))
+        with Not_found ->
+          (* PR#5276: unique-ize dotted global names, which appear
+             if one of the units being consolidated is itself a packed
+             module. *)
+          let name = Ident.name id in
+          if String.contains name '.' then
+            Reloc_getglobal (Ident.create_persistent (packagename ^ "." ^ name))
+          else
+            rel
+        end
+    | Reloc_setglobal id ->
+        begin try
+          let id' = List.assoc id mapping in
+          if List.mem id defined
+          then raise(Error(Multiple_definition(objfile, id)))
+          else Reloc_setglobal id'
+        with Not_found ->
+          (* PR#5276, as above *)
+          let name = Ident.name id in
+          if String.contains name '.' then
+            Reloc_setglobal (Ident.create_persistent (packagename ^ "." ^ name))
+          else
+            rel
+        end
+    | _ ->
+        rel in
+  relocs := (rel', base + ofs) :: !relocs
+
+(* Record and relocate a debugging event *)
+
+let relocate_debug base prefix subst ev =
+  let ev' = { ev with ev_pos = base + ev.ev_pos;
+                      ev_module = prefix ^ "." ^ ev.ev_module;
+                      ev_typsubst = Subst.compose ev.ev_typsubst subst } in
+  events := ev' :: !events
+
+(* Read the unit information from a .cmo file. *)
+
+type pack_member_kind = PM_intf | PM_impl of compilation_unit
+
+type pack_member =
+  { pm_file: string;
+    pm_name: string;
+    pm_kind: pack_member_kind }
+
+let read_member_info file = (
+  let name =
+    String.capitalize_ascii(Filename.basename(chop_extensions file)) in
+  let kind =
+    (* PR#7479: make sure it is either a .cmi or a .cmo *)
+    if Filename.check_suffix file ".cmi" then
+      PM_intf
+    else begin
+      let ic = open_in_bin file in
+      try
+        let buffer =
+          really_input_string ic (String.length Config.cmo_magic_number)
+        in
+        if buffer <> Config.cmo_magic_number then
+          raise(Error(Not_an_object_file file));
+        let compunit_pos = input_binary_int ic in
+        seek_in ic compunit_pos;
+        let compunit = (input_value ic : compilation_unit) in
+        if compunit.cu_name <> name
+        then raise(Error(Illegal_renaming(name, file, compunit.cu_name)));
+        close_in ic;
+        PM_impl compunit
+      with x ->
+        close_in ic;
+        raise x
+    end in
+  { pm_file = file; pm_name = name; pm_kind = kind }
+)
+
+(* Read the bytecode from a .cmo file.
+   Write bytecode to channel [oc].
+   Rename globals as indicated by [mapping] in reloc info.
+   Accumulate relocs, debug info, etc.
+   Return size of bytecode. *)
+
+let rename_append_bytecode packagename oc mapping defined ofs prefix subst
+                           objfile compunit =
+  let ic = open_in_bin objfile in
+  try
+    Bytelink.check_consistency objfile compunit;
+    List.iter
+      (rename_relocation packagename objfile mapping defined ofs)
+      compunit.cu_reloc;
+    primitives := compunit.cu_primitives @ !primitives;
+    if compunit.cu_force_link then force_link := true;
+    seek_in ic compunit.cu_pos;
+    Misc.copy_file_chunk ic oc compunit.cu_codesize;
+    if !Clflags.debug && compunit.cu_debug > 0 then begin
+      seek_in ic compunit.cu_debug;
+      List.iter (relocate_debug ofs prefix subst) (input_value ic);
+      debug_dirs := List.fold_left
+        (fun s e -> String.Set.add e s)
+        !debug_dirs
+        (input_value ic);
+    end;
+    close_in ic;
+    compunit.cu_codesize
+  with x ->
+    close_in ic;
+    raise x
+
+(* Same, for a list of .cmo and .cmi files.
+   Return total size of bytecode. *)
+
+let rec rename_append_bytecode_list packagename oc mapping defined ofs
+                                    prefix subst =
+  function
+    [] ->
+      ofs
+  | m :: rem ->
+      match m.pm_kind with
+      | PM_intf ->
+          rename_append_bytecode_list packagename oc mapping defined ofs
+                                      prefix subst rem
+      | PM_impl compunit ->
+          let size =
+            rename_append_bytecode packagename oc mapping defined ofs
+                                   prefix subst m.pm_file compunit in
+          let id = Ident.create_persistent m.pm_name in
+          let root = Path.Pident (Ident.create_persistent prefix) in
+          rename_append_bytecode_list packagename oc mapping (id :: defined)
+            (ofs + size) prefix
+            (Subst.add_module id (Path.Pdot (root, Ident.name id))
+                              subst)
+            rem
+
+(* Generate the code that builds the tuple representing the package module *)
+
+let build_global_target ~ppf_dump oc target_name members mapping pos coercion =
+  let components =
+    List.map2
+      (fun m (_id1, id2) ->
+        match m.pm_kind with
+        | PM_intf -> None
+        | PM_impl _ -> Some id2)
+      members mapping in
+  let lam =
+    Translmod.transl_package
+      components (Ident.create_persistent target_name) coercion in
+  let lam = Simplif.simplify_lambda lam in
+  if !Clflags.dump_lambda then
+    Format.fprintf ppf_dump "%a@." Printlambda.lambda lam;
+  let instrs =
+    Bytegen.compile_implementation target_name lam in
+  let rel =
+    Emitcode.to_packed_file oc instrs in
+  relocs := List.map (fun (r, ofs) -> (r, pos + ofs)) rel @ !relocs
+
+(* Build the .cmo file obtained by packaging the given .cmo files. *)
+
+let package_object_files ~ppf_dump files targetfile targetname coercion =
+  let members =
+    map_left_right read_member_info files in
+  let required_globals =
+    List.fold_right (fun compunit required_globals -> match compunit with
+        | { pm_kind = PM_intf } ->
+            required_globals
+        | { pm_kind = PM_impl { cu_required_globals; cu_reloc } } ->
+            let remove_required (rel, _pos) required_globals =
+              match rel with
+                Reloc_setglobal id ->
+                  Ident.Set.remove id required_globals
+              | _ ->
+                  required_globals
+            in
+            let required_globals =
+              List.fold_right remove_required cu_reloc required_globals
+            in
+            List.fold_right Ident.Set.add cu_required_globals required_globals)
+      members Ident.Set.empty
+  in
+  let unit_names =
+    List.map (fun m -> m.pm_name) members in
+  let mapping =
+    List.map
+      (fun name ->
+          (Ident.create_persistent name,
+           Ident.create_persistent(targetname ^ "." ^ name)))
+      unit_names in
+  let oc = open_out_bin targetfile in
+  try
+    output_string oc Config.cmo_magic_number;
+    let pos_depl = pos_out oc in
+    output_binary_int oc 0;
+    let pos_code = pos_out oc in
+    let ofs = rename_append_bytecode_list targetname oc mapping [] 0
+                                          targetname Subst.identity members in
+    build_global_target ~ppf_dump oc targetname members mapping ofs coercion;
+    let pos_debug = pos_out oc in
+    if !Clflags.debug && !events <> [] then begin
+      output_value oc (List.rev !events);
+      output_value oc (String.Set.elements !debug_dirs);
+    end;
+    let pos_final = pos_out oc in
+    let imports =
+      List.filter
+        (fun (name, _crc) -> not (List.mem name unit_names))
+        (Bytelink.extract_crc_interfaces()) in
+    let compunit =
+      { cu_name = targetname;
+        cu_pos = pos_code;
+        cu_codesize = pos_debug - pos_code;
+        cu_reloc = List.rev !relocs;
+        cu_imports =
+          (targetname, Some (Env.crc_of_unit targetname)) :: imports;
+        cu_primitives = !primitives;
+        cu_required_globals = Ident.Set.elements required_globals;
+        cu_force_link = !force_link;
+        cu_debug = if pos_final > pos_debug then pos_debug else 0;
+        cu_debugsize = pos_final - pos_debug } in
+    Emitcode.marshal_to_channel_with_possibly_32bit_compat
+      ~filename:targetfile ~kind:"bytecode unit"
+      oc compunit;
+    seek_out oc pos_depl;
+    output_binary_int oc pos_final;
+    close_out oc
+  with x ->
+    close_out oc;
+    raise x
+
+(* The entry point *)
+
+let package_files ~ppf_dump initial_env files targetfile =
+    let files =
+    List.map
+        (fun f ->
+        try Load_path.find f
+        with Not_found -> raise(Error(File_not_found f)))
+        files in
+    let prefix = chop_extensions targetfile in
+    let targetcmi = prefix ^ ".cmi" in
+    let targetname = String.capitalize_ascii(Filename.basename prefix) in
+    Misc.try_finally (fun () ->
+        let coercion =
+          Typemod.package_units initial_env files targetcmi targetname in
+        package_object_files ~ppf_dump files targetfile targetname coercion
+      )
+      ~exceptionally:(fun () -> remove_file targetfile)
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+    Forward_reference(file, ident) ->
+      fprintf ppf "Forward reference to %s in file %a" (Ident.name ident)
+        Location.print_filename file
+  | Multiple_definition(file, ident) ->
+      fprintf ppf "File %a redefines %s"
+        Location.print_filename file
+        (Ident.name ident)
+  | Not_an_object_file file ->
+      fprintf ppf "%a is not a bytecode object file"
+        Location.print_filename file
+  | Illegal_renaming(name, file, id) ->
+      fprintf ppf "Wrong file naming: %a@ contains the code for\
+                   @ %s when %s was expected"
+        Location.print_filename file name id
+  | File_not_found file ->
+      fprintf ppf "File %s not found" file
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )
+
+let reset () =
+  relocs := [];
+  events := [];
+  primitives := [];
+  force_link := false
diff --git a/bytecomp/bytepackager.mli b/bytecomp/bytepackager.mli
new file mode 100644
index 00000000..95177716
--- /dev/null
+++ b/bytecomp/bytepackager.mli
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* "Package" a set of .cmo files into one .cmo file having the
+   original compilation units as sub-modules. *)
+
+val package_files:
+  ppf_dump:Format.formatter -> Env.t -> string list -> string -> unit
+
+type error =
+    Forward_reference of string * Ident.t
+  | Multiple_definition of string * Ident.t
+  | Not_an_object_file of string
+  | Illegal_renaming of string * string * string
+  | File_not_found of string
+
+exception Error of error
+
+val report_error: Format.formatter -> error -> unit
+val reset: unit -> unit
diff --git a/bytecomp/bytesections.ml b/bytecomp/bytesections.ml
new file mode 100644
index 00000000..2beb0761
--- /dev/null
+++ b/bytecomp/bytesections.ml
@@ -0,0 +1,101 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2000 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Handling of sections in bytecode executable files *)
+
+(* List of all sections, in reverse order *)
+
+let section_table = ref ([] : (string * int) list)
+
+(* Recording sections *)
+
+let section_beginning = ref 0
+
+let init_record outchan =
+  section_beginning := pos_out outchan;
+  section_table := []
+
+let record outchan name =
+  let pos = pos_out outchan in
+  section_table := (name, pos - !section_beginning) :: !section_table;
+  section_beginning := pos
+
+let write_toc_and_trailer outchan =
+  List.iter
+    (fun (name, len) ->
+      output_string outchan name; output_binary_int outchan len)
+    (List.rev !section_table);
+  output_binary_int outchan (List.length !section_table);
+  output_string outchan Config.exec_magic_number;
+  section_table := [];
+
+(* Read the table of sections from a bytecode executable *)
+
+exception Bad_magic_number
+
+let read_toc ic =
+  let pos_trailer = in_channel_length ic - 16 in
+  seek_in ic pos_trailer;
+  let num_sections = input_binary_int ic in
+  let header =
+    really_input_string ic (String.length Config.exec_magic_number)
+  in
+  if header <> Config.exec_magic_number then raise Bad_magic_number;
+  seek_in ic (pos_trailer - 8 * num_sections);
+  section_table := [];
+  for _i = 1 to num_sections do
+    let name = really_input_string ic 4 in
+    let len = input_binary_int ic in
+    section_table := (name, len) :: !section_table
+  done
+
+(* Return the current table of contents *)
+
+let toc () = List.rev !section_table
+
+(* Position ic at the beginning of the section named "name",
+   and return the length of that section.  Raise Not_found if no
+   such section exists. *)
+
+let seek_section ic name =
+  let rec seek_sec curr_ofs = function
+    [] -> raise Not_found
+  | (n, len) :: rem ->
+      if n = name
+      then begin seek_in ic (curr_ofs - len); len end
+      else seek_sec (curr_ofs - len) rem in
+  seek_sec (in_channel_length ic - 16 - 8 * List.length !section_table)
+           !section_table
+
+(* Return the contents of a section, as a string *)
+
+let read_section_string ic name =
+  really_input_string ic (seek_section ic name)
+
+(* Return the contents of a section, as marshalled data *)
+
+let read_section_struct ic name =
+  ignore (seek_section ic name);
+  input_value ic
+
+(* Return the position of the beginning of the first section *)
+
+let pos_first_section ic =
+  in_channel_length ic - 16 - 8 * List.length !section_table -
+  List.fold_left (fun total (_name, len) -> total + len) 0 !section_table
+
+let reset () =
+  section_table := [];
+  section_beginning := 0
diff --git a/bytecomp/bytesections.mli b/bytecomp/bytesections.mli
new file mode 100644
index 00000000..22e1a3bb
--- /dev/null
+++ b/bytecomp/bytesections.mli
@@ -0,0 +1,57 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2000 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Handling of sections in bytecode executable files *)
+
+(** Recording sections written to a bytecode executable file *)
+
+val init_record: out_channel -> unit
+    (* Start recording sections from the current position in out_channel *)
+
+val record: out_channel -> string -> unit
+    (* Record the current position in the out_channel as the end of
+       the section with the given name *)
+
+val write_toc_and_trailer: out_channel -> unit
+    (* Write the table of contents and the standard trailer for bytecode
+       executable files *)
+
+(** Reading sections from a bytecode executable file *)
+
+val read_toc: in_channel -> unit
+    (* Read the table of sections from a bytecode executable *)
+
+exception Bad_magic_number
+    (* Raised by [read_toc] if magic number doesn't match *)
+
+val toc: unit -> (string * int) list
+    (* Return the current table of contents as a list of
+       (section name, section length) pairs. *)
+
+val seek_section: in_channel -> string -> int
+    (* Position the input channel at the beginning of the section named "name",
+       and return the length of that section.  Raise Not_found if no
+       such section exists. *)
+
+val read_section_string: in_channel -> string -> string
+    (* Return the contents of a section, as a string *)
+
+val read_section_struct: in_channel -> string -> 'a
+    (* Return the contents of a section, as marshalled data *)
+
+val pos_first_section: in_channel -> int
+   (* Return the position of the beginning of the first section *)
+
+val reset: unit -> unit
diff --git a/bytecomp/dll.ml b/bytecomp/dll.ml
new file mode 100644
index 00000000..a902a9fc
--- /dev/null
+++ b/bytecomp/dll.ml
@@ -0,0 +1,167 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Handling of dynamically-linked libraries *)
+
+type dll_handle
+type dll_address
+type dll_mode = For_checking | For_execution
+
+external dll_open: dll_mode -> string -> dll_handle = "caml_dynlink_open_lib"
+external dll_close: dll_handle -> unit = "caml_dynlink_close_lib"
+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)
+
+(* DLLs currently opened *)
+let opened_dlls = ref ([] : dll_handle list)
+
+(* File names for those DLLs *)
+let names_of_opened_dlls = ref ([] : string list)
+
+(* Add the given directories to the search path for DLLs. *)
+let add_path dirs =
+  search_path := dirs @ !search_path
+
+let remove_path dirs =
+  search_path := List.filter (fun d -> not (List.mem d dirs)) !search_path
+
+(* 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 *)
+
+(* Open a list of DLLs, adding them to opened_dlls.
+   Raise [Failure msg] in case of error. *)
+
+let open_dll mode name =
+  let name = name ^ Config.ext_dll in
+  let fullname =
+    try
+      let fullname = Misc.find_in_path !search_path name in
+      if Filename.is_implicit fullname then
+        Filename.concat Filename.current_dir_name fullname
+      else fullname
+    with Not_found -> name in
+  if not (List.mem fullname !names_of_opened_dlls) then begin
+    try
+      let dll = dll_open mode fullname in
+      names_of_opened_dlls := fullname :: !names_of_opened_dlls;
+      opened_dlls := dll :: !opened_dlls
+    with Failure msg ->
+      failwith (fullname ^ ": " ^ msg)
+  end
+
+let open_dlls mode names =
+  List.iter (open_dll mode) names
+
+(* Close all DLLs *)
+
+let close_all_dlls () =
+  List.iter dll_close !opened_dlls;
+  opened_dlls := [];
+  names_of_opened_dlls := []
+
+(* Find a primitive in the currently opened DLLs.
+   Raise [Not_found] if not found. *)
+
+let find_primitive prim_name =
+  let rec find seen = function
+    [] ->
+      raise Not_found
+  | dll :: rem ->
+      let addr = dll_sym dll prim_name in
+      if addr == Obj.magic () then find (dll :: seen) rem else begin
+        if seen <> [] then opened_dlls := dll :: List.rev_append seen rem;
+        addr
+      end in
+  find [] !opened_dlls
+
+(* If linking in core (dynlink or toplevel), synchronize the VM
+   table of primitive with the linker's table of primitive
+   by storing the given primitive function at the given position
+   in the VM table of primitives.  *)
+
+let linking_in_core = ref false
+
+let synchronize_primitive num symb =
+  if !linking_in_core then begin
+    let actual_num = add_primitive symb in
+    assert (actual_num = num)
+  end
+
+(* Read the [ld.conf] file and return the corresponding list of directories *)
+
+let ld_conf_contents () =
+  let path = ref [] in
+  begin try
+    let ic = open_in (Filename.concat Config.standard_library "ld.conf") in
+    begin try
+      while true do
+        path := input_line ic :: !path
+      done
+    with End_of_file -> ()
+    end;
+    close_in ic
+  with Sys_error _ -> ()
+  end;
+  List.rev !path
+
+(* Split the CAML_LD_LIBRARY_PATH environment variable and return
+   the corresponding list of directories.  *)
+let ld_library_path_contents () =
+  match Sys.getenv "CAML_LD_LIBRARY_PATH" with
+  | exception Not_found ->
+      []
+  | s ->
+      Misc.split_path_contents s
+
+let split_dll_path path =
+  Misc.split_path_contents ~sep:'\000' path
+
+(* Initialization for separate compilation *)
+
+let init_compile nostdlib =
+  search_path :=
+    ld_library_path_contents() @
+    (if nostdlib then [] else ld_conf_contents())
+
+(* Initialization for linking in core (dynlink or toplevel) *)
+
+let init_toplevel dllpath =
+  search_path :=
+    ld_library_path_contents() @
+    split_dll_path dllpath @
+    ld_conf_contents();
+  opened_dlls := Array.to_list (get_current_dlls());
+  names_of_opened_dlls := [];
+  linking_in_core := true
+
+let reset () =
+  search_path := [];
+  opened_dlls :=[];
+  names_of_opened_dlls := [];
+  linking_in_core := false
diff --git a/bytecomp/dll.mli b/bytecomp/dll.mli
new file mode 100644
index 00000000..485035ea
--- /dev/null
+++ b/bytecomp/dll.mli
@@ -0,0 +1,66 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Handling of dynamically-linked libraries *)
+
+(* Extract the name of a DLLs from its external name (xxx.so or -lxxx) *)
+val extract_dll_name: string -> string
+
+type dll_mode =
+  | For_checking     (* will just check existence of symbols;
+                        no need to do full symbol resolution *)
+  | For_execution    (* will call functions from this DLL;
+                        must resolve symbols completely *)
+
+(* Open a list of DLLs.  First argument indicates whether to perform
+   full symbol resolution.  Raise [Failure msg] in case of error. *)
+val open_dlls: dll_mode -> string list -> unit
+
+(* Close all DLLs *)
+val close_all_dlls: unit -> unit
+
+(* The abstract type representing C function pointers *)
+type dll_address
+
+(* Find a primitive in the currently opened DLLs and return its address.
+   Raise [Not_found] if not found. *)
+val find_primitive: string -> dll_address
+
+(* If linking in core (dynlink or toplevel), synchronize the VM
+   table of primitive with the linker's table of primitive
+   by storing the given primitive function at the given position
+   in the VM table of primitives.  *)
+val synchronize_primitive: int -> dll_address -> unit
+
+(* Add the given directories at the head of the search path for DLLs *)
+val add_path: string list -> unit
+
+(* Remove the given directories from the search path for DLLs *)
+val remove_path: string list -> unit
+
+(* Initialization for separate compilation.
+   Initialize the DLL search path to the directories given in the
+   environment variable CAML_LD_LIBRARY_PATH, plus contents of ld.conf file
+   if argument is [false].  If argument is [true], ignore ld.conf. *)
+val init_compile: bool -> unit
+
+(* Initialization for linking in core (dynlink or toplevel).
+   Initialize the search path to the same path that was used to start
+   the running program (CAML_LD_LIBRARY_PATH + directories in executable +
+   contents of ld.conf file).  Take note of the DLLs that were opened
+   when starting the running program. *)
+val init_toplevel: string -> unit
+
+val reset: unit -> unit
diff --git a/bytecomp/dune b/bytecomp/dune
new file mode 100644
index 00000000..655cb57e
--- /dev/null
+++ b/bytecomp/dune
@@ -0,0 +1,20 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+(rule
+ (targets opcodes.ml)
+ (mode    fallback)
+ (deps    (:instr (file ../runtime/caml/instruct.h)))
+ (action
+  (bash "%{dep:../tools/make_opcodes.exe} -opcodes < %{instr} > %{targets}")))
diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml
new file mode 100644
index 00000000..03251eb0
--- /dev/null
+++ b/bytecomp/emitcode.ml
@@ -0,0 +1,468 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Generation of bytecode + relocation information *)
+
+open Config
+open Misc
+open Asttypes
+open Lambda
+open Instruct
+open Opcodes
+open Cmo_format
+module String = Misc.Stdlib.String
+
+type error = Not_compatible_32 of (string * string)
+exception Error of error
+
+(* marshal and possibly check 32bit compat *)
+let marshal_to_channel_with_possibly_32bit_compat ~filename ~kind outchan obj =
+  try
+    Marshal.to_channel outchan obj
+      (if !Clflags.bytecode_compatible_32
+       then [Marshal.Compat_32] else [])
+  with Failure _ ->
+    raise (Error (Not_compatible_32 (filename, kind)))
+
+
+let report_error ppf (file, kind) =
+  Format.fprintf ppf "Generated %s %S cannot be used on a 32-bit platform"
+                     kind file
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (Not_compatible_32 info) ->
+          Some (Location.error_of_printer_file report_error info)
+      | _ ->
+          None
+    )
+
+(* Buffering of bytecode *)
+
+let out_buffer = ref(LongString.create 1024)
+and out_position = ref 0
+
+let out_word b1 b2 b3 b4 =
+  let p = !out_position in
+  if p >= LongString.length !out_buffer then begin
+    let len = LongString.length !out_buffer in
+    let new_buffer = LongString.create (2 * len) in
+    LongString.blit !out_buffer 0 new_buffer 0 len;
+    out_buffer := new_buffer
+  end;
+  LongString.set !out_buffer p (Char.unsafe_chr b1);
+  LongString.set !out_buffer (p+1) (Char.unsafe_chr b2);
+  LongString.set !out_buffer (p+2) (Char.unsafe_chr b3);
+  LongString.set !out_buffer (p+3) (Char.unsafe_chr b4);
+  out_position := p + 4
+
+let out opcode =
+  out_word opcode 0 0 0
+
+
+exception AsInt
+
+let const_as_int = function
+  | Const_base(Const_int i) -> i
+  | Const_base(Const_char c) -> Char.code c
+  | Const_pointer i -> i
+  | _ -> raise AsInt
+
+let is_immed i = immed_min <= i && i <= immed_max
+let is_immed_const k =
+  try
+    is_immed (const_as_int k)
+  with
+  | AsInt -> false
+
+
+let out_int n =
+  out_word n (n asr 8) (n asr 16) (n asr 24)
+
+let out_const c =
+  try
+    out_int (const_as_int c)
+  with
+  | AsInt -> Misc.fatal_error "Emitcode.const_as_int"
+
+
+(* Handling of local labels and backpatching *)
+
+type label_definition =
+    Label_defined of int
+  | Label_undefined of (int * int) list
+
+let label_table  = ref ([| |] : label_definition array)
+
+let extend_label_table needed =
+  let new_size = ref(Array.length !label_table) in
+  while needed >= !new_size do new_size := 2 * !new_size done;
+  let new_table = Array.make !new_size (Label_undefined []) in
+  Array.blit !label_table 0 new_table 0 (Array.length !label_table);
+  label_table := new_table
+
+let backpatch (pos, orig) =
+  let displ = (!out_position - orig) asr 2 in
+  LongString.set !out_buffer pos (Char.unsafe_chr displ);
+  LongString.set !out_buffer (pos+1) (Char.unsafe_chr (displ asr 8));
+  LongString.set !out_buffer (pos+2) (Char.unsafe_chr (displ asr 16));
+  LongString.set !out_buffer (pos+3) (Char.unsafe_chr (displ asr 24))
+
+let define_label lbl =
+  if lbl >= Array.length !label_table then extend_label_table lbl;
+  match (!label_table).(lbl) with
+    Label_defined _ ->
+      fatal_error "Emitcode.define_label"
+  | Label_undefined patchlist ->
+      List.iter backpatch patchlist;
+      (!label_table).(lbl) <- Label_defined !out_position
+
+let out_label_with_orig orig lbl =
+  if lbl >= Array.length !label_table then extend_label_table lbl;
+  match (!label_table).(lbl) with
+    Label_defined def ->
+      out_int((def - orig) asr 2)
+  | Label_undefined patchlist ->
+      (!label_table).(lbl) <-
+         Label_undefined((!out_position, orig) :: patchlist);
+      out_int 0
+
+let out_label l = out_label_with_orig !out_position l
+
+(* Relocation information *)
+
+let reloc_info = ref ([] : (reloc_info * int) list)
+
+let enter info =
+  reloc_info := (info, !out_position) :: !reloc_info
+
+let slot_for_literal sc =
+  enter (Reloc_literal sc);
+  out_int 0
+and slot_for_getglobal id =
+  enter (Reloc_getglobal id);
+  out_int 0
+and slot_for_setglobal id =
+  enter (Reloc_setglobal id);
+  out_int 0
+and slot_for_c_prim name =
+  enter (Reloc_primitive name);
+  out_int 0
+
+(* Debugging events *)
+
+let events = ref ([] : debug_event list)
+let debug_dirs = ref String.Set.empty
+
+let record_event ev =
+  let path = ev.ev_loc.Location.loc_start.Lexing.pos_fname in
+  let abspath = Location.absolute_path path in
+  debug_dirs := String.Set.add (Filename.dirname abspath) !debug_dirs;
+  if Filename.is_relative path then begin
+    let cwd = Location.rewrite_absolute_path (Sys.getcwd ()) in
+    debug_dirs := String.Set.add cwd !debug_dirs;
+  end;
+  ev.ev_pos <- !out_position;
+  events := ev :: !events
+
+(* Initialization *)
+
+let init () =
+  out_position := 0;
+  label_table := Array.make 16 (Label_undefined []);
+  reloc_info := [];
+  debug_dirs := String.Set.empty;
+  events := []
+
+(* Emission of one instruction *)
+
+let emit_comp = function
+| Ceq -> out opEQ    | Cne -> out opNEQ
+| Clt -> out opLTINT | Cle -> out opLEINT
+| Cgt -> out opGTINT | Cge -> out opGEINT
+
+and emit_branch_comp = function
+| Ceq -> out opBEQ    | Cne -> out opBNEQ
+| Clt -> out opBLTINT | Cle -> out opBLEINT
+| Cgt -> out opBGTINT | Cge -> out opBGEINT
+
+let emit_instr = function
+    Klabel lbl -> define_label lbl
+  | Kacc n ->
+      if n < 8 then out(opACC0 + n) else (out opACC; out_int n)
+  | Kenvacc n ->
+      if n >= 1 && n <= 4
+      then out(opENVACC1 + n - 1)
+      else (out opENVACC; out_int n)
+  | Kpush ->
+      out opPUSH
+  | Kpop n ->
+      out opPOP; out_int n
+  | Kassign n ->
+      out opASSIGN; out_int n
+  | Kpush_retaddr lbl -> out opPUSH_RETADDR; out_label lbl
+  | Kapply n ->
+      if n < 4 then out(opAPPLY1 + n - 1) else (out opAPPLY; out_int n)
+  | Kappterm(n, sz) ->
+      if n < 4 then (out(opAPPTERM1 + n - 1); out_int sz)
+               else (out opAPPTERM; out_int n; out_int sz)
+  | Kreturn n -> out opRETURN; out_int n
+  | Krestart -> out opRESTART
+  | Kgrab n -> out opGRAB; out_int n
+  | Kclosure(lbl, n) -> out opCLOSURE; out_int n; out_label lbl
+  | Kclosurerec(lbls, n) ->
+      out opCLOSUREREC; out_int (List.length lbls); out_int n;
+      let org = !out_position in
+      List.iter (out_label_with_orig org) lbls
+  | Koffsetclosure ofs ->
+      if ofs = -2 || ofs = 0 || ofs = 2
+      then out (opOFFSETCLOSURE0 + ofs / 2)
+      else (out opOFFSETCLOSURE; out_int ofs)
+  | Kgetglobal q -> out opGETGLOBAL; slot_for_getglobal q
+  | Ksetglobal q -> out opSETGLOBAL; slot_for_setglobal q
+  | Kconst sc ->
+      begin match sc with
+        Const_base(Const_int i) when is_immed i ->
+          if i >= 0 && i <= 3
+          then out (opCONST0 + i)
+          else (out opCONSTINT; out_int i)
+      | Const_base(Const_char c) ->
+          out opCONSTINT; out_int (Char.code c)
+      | Const_pointer i ->
+          if i >= 0 && i <= 3
+          then out (opCONST0 + i)
+          else (out opCONSTINT; out_int i)
+      | Const_block(t, []) ->
+          if t = 0 then out opATOM0 else (out opATOM; out_int t)
+      | _ ->
+          out opGETGLOBAL; slot_for_literal sc
+      end
+  | Kmakeblock(n, t) ->
+      if n = 0 then
+        if t = 0 then out opATOM0 else (out opATOM; out_int t)
+      else if n < 4 then (out(opMAKEBLOCK1 + n - 1); out_int t)
+      else (out opMAKEBLOCK; out_int n; out_int t)
+  | Kgetfield n ->
+      if n < 4 then out(opGETFIELD0 + n) else (out opGETFIELD; out_int n)
+  | Ksetfield n ->
+      if n < 4 then out(opSETFIELD0 + n) else (out opSETFIELD; out_int n)
+  | Kmakefloatblock(n) ->
+      if n = 0 then out opATOM0 else (out opMAKEFLOATBLOCK; out_int n)
+  | Kgetfloatfield n -> out opGETFLOATFIELD; out_int n
+  | Ksetfloatfield n -> out opSETFLOATFIELD; out_int n
+  | Kvectlength -> out opVECTLENGTH
+  | Kgetvectitem -> out opGETVECTITEM
+  | Ksetvectitem -> out opSETVECTITEM
+  | Kgetstringchar -> out opGETSTRINGCHAR
+  | Kgetbyteschar -> out opGETBYTESCHAR
+  | Ksetbyteschar -> out opSETBYTESCHAR
+  | Kbranch lbl -> out opBRANCH; out_label lbl
+  | Kbranchif lbl -> out opBRANCHIF; out_label lbl
+  | Kbranchifnot lbl -> out opBRANCHIFNOT; out_label lbl
+  | Kstrictbranchif lbl -> out opBRANCHIF; out_label lbl
+  | Kstrictbranchifnot lbl -> out opBRANCHIFNOT; out_label lbl
+  | Kswitch(tbl_const, tbl_block) ->
+      out opSWITCH;
+      out_int (Array.length tbl_const + (Array.length tbl_block lsl 16));
+      let org = !out_position in
+      Array.iter (out_label_with_orig org) tbl_const;
+      Array.iter (out_label_with_orig org) tbl_block
+  | Kboolnot -> out opBOOLNOT
+  | Kpushtrap lbl -> out opPUSHTRAP; out_label lbl
+  | Kpoptrap -> out opPOPTRAP
+  | Kraise Raise_regular -> out opRAISE
+  | Kraise Raise_reraise -> out opRERAISE
+  | Kraise Raise_notrace -> out opRAISE_NOTRACE
+  | Kcheck_signals -> out opCHECK_SIGNALS
+  | Kccall(name, n) ->
+      if n <= 5
+      then (out (opC_CALL1 + n - 1); slot_for_c_prim name)
+      else (out opC_CALLN; out_int n; slot_for_c_prim name)
+  | Knegint -> out opNEGINT  | Kaddint -> out opADDINT
+  | Ksubint -> out opSUBINT  | Kmulint -> out opMULINT
+  | Kdivint -> out opDIVINT  | Kmodint -> out opMODINT
+  | Kandint -> out opANDINT  | Korint -> out opORINT
+  | Kxorint -> out opXORINT  | Klslint -> out opLSLINT
+  | Klsrint -> out opLSRINT  | Kasrint -> out opASRINT
+  | Kintcomp c -> emit_comp c
+  | Koffsetint n -> out opOFFSETINT; out_int n
+  | Koffsetref n -> out opOFFSETREF; out_int n
+  | Kisint -> out opISINT
+  | Kisout -> out opULTINT
+  | Kgetmethod -> out opGETMETHOD
+  | Kgetpubmet tag -> out opGETPUBMET; out_int tag; out_int 0
+  | Kgetdynmet -> out opGETDYNMET
+  | Kevent ev -> record_event ev
+  | Kstop -> out opSTOP
+
+(* Emission of a list of instructions. Include some peephole optimization. *)
+
+let remerge_events ev1 = function
+  | Kevent ev2 :: c ->
+    Kevent (Bytegen.merge_events ev1 ev2) :: c
+  | c -> Kevent ev1 :: c
+
+let rec emit = function
+    [] -> ()
+  (* Peephole optimizations *)
+(* optimization of integer tests *)
+  | Kpush::Kconst k::Kintcomp c::Kbranchif lbl::rem
+      when is_immed_const k ->
+        emit_branch_comp c ;
+        out_const k ;
+        out_label lbl ;
+        emit rem
+  | Kpush::Kconst k::Kintcomp c::Kbranchifnot lbl::rem
+      when is_immed_const k ->
+        emit_branch_comp (negate_integer_comparison c) ;
+        out_const k ;
+        out_label lbl ;
+        emit rem
+(* same for range tests *)
+  | Kpush::Kconst k::Kisout::Kbranchif lbl::rem
+      when is_immed_const k ->
+        out opBULTINT ;
+        out_const k ;
+        out_label lbl ;
+        emit rem
+  | Kpush::Kconst k::Kisout::Kbranchifnot lbl::rem
+      when is_immed_const k ->
+        out opBUGEINT ;
+        out_const k ;
+        out_label lbl ;
+        emit rem
+(* Some special case of push ; i ; ret generated by the match compiler *)
+  | Kpush :: Kacc 0 :: Kreturn m :: c ->
+      emit (Kreturn (m-1) :: c)
+(* General push then access scheme *)
+  | Kpush :: Kacc n :: c ->
+      if n < 8 then out(opPUSHACC0 + n) else (out opPUSHACC; out_int n);
+      emit c
+  | Kpush :: Kenvacc n :: c ->
+      if n >= 1 && n < 4
+      then out(opPUSHENVACC1 + n - 1)
+      else (out opPUSHENVACC; out_int n);
+      emit c
+  | Kpush :: Koffsetclosure ofs :: c ->
+      if ofs = -2 || ofs = 0 || ofs = 2
+      then out(opPUSHOFFSETCLOSURE0 + ofs / 2)
+      else (out opPUSHOFFSETCLOSURE; out_int ofs);
+      emit c
+  | Kpush :: Kgetglobal id :: Kgetfield n :: c ->
+      out opPUSHGETGLOBALFIELD; slot_for_getglobal id; out_int n; emit c
+  | Kpush :: Kgetglobal id :: c ->
+      out opPUSHGETGLOBAL; slot_for_getglobal id; emit c
+  | Kpush :: Kconst sc :: c ->
+      begin match sc with
+        Const_base(Const_int i) when is_immed i ->
+          if i >= 0 && i <= 3
+          then out (opPUSHCONST0 + i)
+          else (out opPUSHCONSTINT; out_int i)
+      | Const_base(Const_char c) ->
+          out opPUSHCONSTINT; out_int(Char.code c)
+      | Const_pointer i ->
+          if i >= 0 && i <= 3
+          then out (opPUSHCONST0 + i)
+          else (out opPUSHCONSTINT; out_int i)
+      | Const_block(t, []) ->
+          if t = 0 then out opPUSHATOM0 else (out opPUSHATOM; out_int t)
+      | _ ->
+          out opPUSHGETGLOBAL; slot_for_literal sc
+      end;
+      emit c
+  | Kpush :: (Kevent ({ev_kind = Event_before} as ev)) ::
+    (Kgetglobal _ as instr1) :: (Kgetfield _ as instr2) :: c ->
+      emit (Kpush :: instr1 :: instr2 :: remerge_events ev c)
+  | Kpush :: (Kevent ({ev_kind = Event_before} as ev)) ::
+    (Kacc _ | Kenvacc _ | Koffsetclosure _ | Kgetglobal _ | Kconst _ as instr)::
+    c ->
+      emit (Kpush :: instr :: remerge_events ev c)
+  | Kgetglobal id :: Kgetfield n :: c ->
+      out opGETGLOBALFIELD; slot_for_getglobal id; out_int n; emit c
+  (* Default case *)
+  | instr :: c ->
+      emit_instr instr; emit c
+
+(* Emission to a file *)
+
+let to_file outchan unit_name objfile ~required_globals code =
+  init();
+  output_string outchan cmo_magic_number;
+  let pos_depl = pos_out outchan in
+  output_binary_int outchan 0;
+  let pos_code = pos_out outchan in
+  emit code;
+  LongString.output outchan !out_buffer 0 !out_position;
+  let (pos_debug, size_debug) =
+    if !Clflags.debug then begin
+      debug_dirs := String.Set.add
+        (Filename.dirname (Location.absolute_path objfile))
+        !debug_dirs;
+      let p = pos_out outchan in
+      output_value outchan !events;
+      output_value outchan (String.Set.elements !debug_dirs);
+      (p, pos_out outchan - p)
+    end else
+      (0, 0) in
+  let compunit =
+    { cu_name = unit_name;
+      cu_pos = pos_code;
+      cu_codesize = !out_position;
+      cu_reloc = List.rev !reloc_info;
+      cu_imports = Env.imports();
+      cu_primitives = List.map Primitive.byte_name
+                               !Translmod.primitive_declarations;
+      cu_required_globals = Ident.Set.elements required_globals;
+      cu_force_link = !Clflags.link_everything;
+      cu_debug = pos_debug;
+      cu_debugsize = size_debug } in
+  init();                               (* Free out_buffer and reloc_info *)
+  Btype.cleanup_abbrev ();              (* Remove any cached abbreviation
+                                           expansion before saving *)
+  let pos_compunit = pos_out outchan in
+  marshal_to_channel_with_possibly_32bit_compat
+    ~filename:objfile ~kind:"bytecode unit"
+    outchan compunit;
+  seek_out outchan pos_depl;
+  output_binary_int outchan pos_compunit
+
+(* Emission to a memory block *)
+
+let to_memory init_code fun_code =
+  init();
+  emit init_code;
+  emit fun_code;
+  let code = LongString.create !out_position in
+  LongString.blit !out_buffer 0 code 0 !out_position;
+  let reloc = List.rev !reloc_info in
+  let events = !events in
+  init();
+  (code, reloc, events)
+
+(* Emission to a file for a packed library *)
+
+let to_packed_file outchan code =
+  init();
+  emit code;
+  LongString.output outchan !out_buffer 0 !out_position;
+  let reloc = !reloc_info in
+  init();
+  reloc
+
+let reset () =
+  out_buffer := LongString.create 1024;
+  out_position := 0;
+  label_table := [| |];
+  reloc_info := []
diff --git a/bytecomp/emitcode.mli b/bytecomp/emitcode.mli
new file mode 100644
index 00000000..95da242e
--- /dev/null
+++ b/bytecomp/emitcode.mli
@@ -0,0 +1,51 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Generation of bytecode for .cmo files *)
+
+open Cmo_format
+open Instruct
+
+val to_file: out_channel -> string -> string ->
+  required_globals:Ident.Set.t -> instruction list -> unit
+        (* Arguments:
+             channel on output file
+             name of compilation unit implemented
+             path of cmo file being written
+             required_globals: list of compilation units that must be
+               evaluated before this one
+             list of instructions to emit *)
+val to_memory:
+  instruction list -> instruction list ->
+    Misc.LongString.t * (reloc_info * int) list * debug_event list
+        (* Arguments:
+             initialization code (terminated by STOP)
+             function code
+           Results:
+             block of relocatable bytecode
+             relocation information
+             debug events *)
+val to_packed_file:
+  out_channel -> instruction list -> (reloc_info * int) list
+        (* Arguments:
+             channel on output file
+             list of instructions to emit
+           Result:
+             relocation information (reversed) *)
+
+val reset: unit -> unit
+
+val marshal_to_channel_with_possibly_32bit_compat :
+  filename:string -> kind:string -> out_channel -> 'a -> unit
diff --git a/bytecomp/instruct.ml b/bytecomp/instruct.ml
new file mode 100644
index 00000000..c684bedf
--- /dev/null
+++ b/bytecomp/instruct.ml
@@ -0,0 +1,114 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Lambda
+
+type compilation_env =
+  { ce_stack: int Ident.tbl;
+    ce_heap: int Ident.tbl;
+    ce_rec: int Ident.tbl }
+
+type debug_event =
+  { mutable ev_pos: int;                (* Position in bytecode *)
+    ev_module: string;                  (* Name of defining module *)
+    ev_loc: Location.t;                 (* Location in source file *)
+    ev_kind: debug_event_kind;          (* Before/after event *)
+    ev_defname: string;                 (* Enclosing definition *)
+    ev_info: debug_event_info;          (* Extra information *)
+    ev_typenv: Env.summary;             (* Typing environment *)
+    ev_typsubst: Subst.t;               (* Substitution over types *)
+    ev_compenv: compilation_env;        (* Compilation environment *)
+    ev_stacksize: int;                  (* Size of stack frame *)
+    ev_repr: debug_event_repr }         (* Position of the representative *)
+
+and debug_event_kind =
+    Event_before
+  | Event_after of Types.type_expr
+  | Event_pseudo
+
+and debug_event_info =
+    Event_function
+  | Event_return of int
+  | Event_other
+
+and debug_event_repr =
+    Event_none
+  | Event_parent of int ref
+  | Event_child of int ref
+
+type label = int                     (* Symbolic code labels *)
+
+type instruction =
+    Klabel of label
+  | Kacc of int
+  | Kenvacc of int
+  | Kpush
+  | Kpop of int
+  | Kassign of int
+  | Kpush_retaddr of label
+  | Kapply of int                       (* number of arguments *)
+  | Kappterm of int * int               (* number of arguments, slot size *)
+  | Kreturn of int                      (* slot size *)
+  | Krestart
+  | Kgrab of int                        (* number of arguments *)
+  | Kclosure of label * int
+  | Kclosurerec of label list * int
+  | Koffsetclosure of int
+  | Kgetglobal of Ident.t
+  | Ksetglobal of Ident.t
+  | Kconst of structured_constant
+  | Kmakeblock of int * int             (* size, tag *)
+  | Kmakefloatblock of int
+  | Kgetfield of int
+  | Ksetfield of int
+  | Kgetfloatfield of int
+  | Ksetfloatfield of int
+  | Kvectlength
+  | Kgetvectitem
+  | Ksetvectitem
+  | Kgetstringchar
+  | Kgetbyteschar
+  | Ksetbyteschar
+  | Kbranch of label
+  | Kbranchif of label
+  | Kbranchifnot of label
+  | Kstrictbranchif of label
+  | Kstrictbranchifnot of label
+  | Kswitch of label array * label array
+  | Kboolnot
+  | Kpushtrap of label
+  | Kpoptrap
+  | Kraise of raise_kind
+  | Kcheck_signals
+  | Kccall of string * int
+  | Knegint | Kaddint | Ksubint | Kmulint | Kdivint | Kmodint
+  | Kandint | Korint | Kxorint | Klslint | Klsrint | Kasrint
+  | Kintcomp of integer_comparison
+  | Koffsetint of int
+  | Koffsetref of int
+  | Kisint
+  | Kisout
+  | Kgetmethod
+  | Kgetpubmet of int
+  | Kgetdynmet
+  | Kevent of debug_event
+  | Kstop
+
+let immed_min = -0x40000000
+and immed_max = 0x3FFFFFFF
+
+(* Actually the abstract machine accommodates -0x80000000 to 0x7FFFFFFF,
+   but these numbers overflow the OCaml type int if the compiler runs on
+   a 32-bit processor. *)
diff --git a/bytecomp/instruct.mli b/bytecomp/instruct.mli
new file mode 100644
index 00000000..e1cae776
--- /dev/null
+++ b/bytecomp/instruct.mli
@@ -0,0 +1,130 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The type of the instructions of the abstract machine *)
+
+open Lambda
+
+(* Structure of compilation environments *)
+
+type compilation_env =
+  { ce_stack: int Ident.tbl; (* Positions of variables in the stack *)
+    ce_heap: int Ident.tbl;  (* Structure of the heap-allocated env *)
+    ce_rec: int Ident.tbl }  (* Functions bound by the same let rec *)
+
+(* The ce_stack component gives locations of variables residing
+   in the stack. The locations are offsets w.r.t. the origin of the
+   stack frame.
+   The ce_heap component gives the positions of variables residing in the
+   heap-allocated environment.
+   The ce_rec component associates offsets to identifiers for functions
+   bound by the same let rec as the current function.  The offsets
+   are used by the OFFSETCLOSURE instruction to recover the closure
+   pointer of the desired function from the env register (which
+   points to the closure for the current function). *)
+
+(* Debugging events *)
+
+(* Warning: when you change these types, check runtime/backtrace_byt.c *)
+type debug_event =
+  { mutable ev_pos: int;                (* Position in bytecode *)
+    ev_module: string;                  (* Name of defining module *)
+    ev_loc: Location.t;                 (* Location in source file *)
+    ev_kind: debug_event_kind;          (* Before/after event *)
+    ev_defname: string;                 (* Enclosing definition *)
+    ev_info: debug_event_info;          (* Extra information *)
+    ev_typenv: Env.summary;             (* Typing environment *)
+    ev_typsubst: Subst.t;               (* Substitution over types *)
+    ev_compenv: compilation_env;        (* Compilation environment *)
+    ev_stacksize: int;                  (* Size of stack frame *)
+    ev_repr: debug_event_repr }         (* Position of the representative *)
+
+and debug_event_kind =
+    Event_before
+  | Event_after of Types.type_expr
+  | Event_pseudo
+
+and debug_event_info =
+    Event_function
+  | Event_return of int
+  | Event_other
+
+and debug_event_repr =
+    Event_none
+  | Event_parent of int ref
+  | Event_child of int ref
+
+(* Abstract machine instructions *)
+
+type label = int                        (* Symbolic code labels *)
+
+type instruction =
+    Klabel of label
+  | Kacc of int
+  | Kenvacc of int
+  | Kpush
+  | Kpop of int
+  | Kassign of int
+  | Kpush_retaddr of label
+  | Kapply of int                       (* number of arguments *)
+  | Kappterm of int * int               (* number of arguments, slot size *)
+  | Kreturn of int                      (* slot size *)
+  | Krestart
+  | Kgrab of int                        (* number of arguments *)
+  | Kclosure of label * int
+  | Kclosurerec of label list * int
+  | Koffsetclosure of int
+  | Kgetglobal of Ident.t
+  | Ksetglobal of Ident.t
+  | Kconst of structured_constant
+  | Kmakeblock of int * int             (* size, tag *)
+  | Kmakefloatblock of int
+  | Kgetfield of int
+  | Ksetfield of int
+  | Kgetfloatfield of int
+  | Ksetfloatfield of int
+  | Kvectlength
+  | Kgetvectitem
+  | Ksetvectitem
+  | Kgetstringchar
+  | Kgetbyteschar
+  | Ksetbyteschar
+  | Kbranch of label
+  | Kbranchif of label
+  | Kbranchifnot of label
+  | Kstrictbranchif of label
+  | Kstrictbranchifnot of label
+  | Kswitch of label array * label array
+  | Kboolnot
+  | Kpushtrap of label
+  | Kpoptrap
+  | Kraise of raise_kind
+  | Kcheck_signals
+  | Kccall of string * int
+  | Knegint | Kaddint | Ksubint | Kmulint | Kdivint | Kmodint
+  | Kandint | Korint | Kxorint | Klslint | Klsrint | Kasrint
+  | Kintcomp of integer_comparison
+  | Koffsetint of int
+  | Koffsetref of int
+  | Kisint
+  | Kisout
+  | Kgetmethod
+  | Kgetpubmet of int
+  | Kgetdynmet
+  | Kevent of debug_event
+  | Kstop
+
+val immed_min: int
+val immed_max: int
diff --git a/bytecomp/meta.ml b/bytecomp/meta.ml
new file mode 100644
index 00000000..d92ea0d4
--- /dev/null
+++ b/bytecomp/meta.ml
@@ -0,0 +1,29 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+external global_data : unit -> Obj.t array = "caml_get_global_data"
+external realloc_global_data : int -> unit = "caml_realloc_global"
+type closure = unit -> Obj.t
+type bytecode
+external reify_bytecode :
+  bytes array -> Instruct.debug_event list array -> string option ->
+    bytecode * closure
+                           = "caml_reify_bytecode"
+external release_bytecode : bytecode -> unit
+                                 = "caml_static_release_bytecode"
+external invoke_traced_function : Obj.t -> Obj.t -> Obj.t -> Obj.t
+                                = "caml_invoke_traced_function"
+external get_section_table : unit -> (string * Obj.t) list
+                           = "caml_get_section_table"
diff --git a/bytecomp/meta.mli b/bytecomp/meta.mli
new file mode 100644
index 00000000..0cf9862a
--- /dev/null
+++ b/bytecomp/meta.mli
@@ -0,0 +1,31 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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 control the runtime system and bytecode interpreter *)
+
+external global_data : unit -> Obj.t array = "caml_get_global_data"
+external realloc_global_data : int -> unit = "caml_realloc_global"
+type closure = unit -> Obj.t
+type bytecode
+external reify_bytecode :
+  bytes array -> Instruct.debug_event list array -> string option ->
+    bytecode * closure
+                           = "caml_reify_bytecode"
+external release_bytecode : bytecode -> unit
+                                 = "caml_static_release_bytecode"
+external invoke_traced_function : Obj.t -> Obj.t -> Obj.t -> Obj.t
+                                = "caml_invoke_traced_function"
+external get_section_table : unit -> (string * Obj.t) list
+                           = "caml_get_section_table"
diff --git a/bytecomp/printinstr.ml b/bytecomp/printinstr.ml
new file mode 100644
index 00000000..6b3754cb
--- /dev/null
+++ b/bytecomp/printinstr.ml
@@ -0,0 +1,117 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Pretty-print lists of instructions *)
+
+open Format
+open Lambda
+open Instruct
+
+let instruction ppf = function
+  | Klabel lbl -> fprintf ppf "L%i:" lbl
+  | Kacc n -> fprintf ppf "\tacc %i" n
+  | Kenvacc n -> fprintf ppf "\tenvacc %i" n
+  | Kpush -> fprintf ppf "\tpush"
+  | Kpop n -> fprintf ppf "\tpop %i" n
+  | Kassign n -> fprintf ppf "\tassign %i" n
+  | Kpush_retaddr lbl -> fprintf ppf "\tpush_retaddr L%i" lbl
+  | Kapply n -> fprintf ppf "\tapply %i" n
+  | Kappterm(n, m) ->
+      fprintf ppf "\tappterm %i, %i" n m
+  | Kreturn n -> fprintf ppf "\treturn %i" n
+  | Krestart -> fprintf ppf "\trestart"
+  | Kgrab n -> fprintf ppf "\tgrab %i" n
+  | Kclosure(lbl, n) ->
+      fprintf ppf "\tclosure L%i, %i" lbl n
+  | Kclosurerec(lbls, n) ->
+      fprintf ppf "\tclosurerec";
+      List.iter (fun lbl -> fprintf ppf " %i" lbl) lbls;
+      fprintf ppf ", %i" n
+  | Koffsetclosure n -> fprintf ppf "\toffsetclosure %i" n
+  | Kgetglobal id -> fprintf ppf "\tgetglobal %a" Ident.print id
+  | Ksetglobal id -> fprintf ppf "\tsetglobal %a" Ident.print id
+  | Kconst cst ->
+      fprintf ppf "@[<10>\tconst@ %a@]" Printlambda.structured_constant cst
+  | Kmakeblock(n, m) ->
+      fprintf ppf "\tmakeblock %i, %i" n m
+  | Kmakefloatblock(n) ->
+      fprintf ppf "\tmakefloatblock %i" n
+  | Kgetfield n -> fprintf ppf "\tgetfield %i" n
+  | Ksetfield n -> fprintf ppf "\tsetfield %i" n
+  | Kgetfloatfield n -> fprintf ppf "\tgetfloatfield %i" n
+  | Ksetfloatfield n -> fprintf ppf "\tsetfloatfield %i" n
+  | Kvectlength -> fprintf ppf "\tvectlength"
+  | Kgetvectitem -> fprintf ppf "\tgetvectitem"
+  | Ksetvectitem -> fprintf ppf "\tsetvectitem"
+  | Kgetstringchar -> fprintf ppf "\tgetstringchar"
+  | Kgetbyteschar -> fprintf ppf "\tgetbyteschar"
+  | Ksetbyteschar -> fprintf ppf "\tsetbyteschar"
+  | Kbranch lbl -> fprintf ppf "\tbranch L%i" lbl
+  | Kbranchif lbl -> fprintf ppf "\tbranchif L%i" lbl
+  | Kbranchifnot lbl -> fprintf ppf "\tbranchifnot L%i" lbl
+  | Kstrictbranchif lbl -> fprintf ppf "\tstrictbranchif L%i" lbl
+  | Kstrictbranchifnot lbl ->
+      fprintf ppf "\tstrictbranchifnot L%i" lbl
+  | Kswitch(consts, blocks) ->
+      let labels ppf labs =
+        Array.iter (fun lbl -> fprintf ppf "@ %i" lbl) labs in
+      fprintf ppf "@[<10>\tswitch%a/%a@]" labels consts labels blocks
+  | Kboolnot -> fprintf ppf "\tboolnot"
+  | Kpushtrap lbl -> fprintf ppf "\tpushtrap L%i" lbl
+  | Kpoptrap -> fprintf ppf "\tpoptrap"
+  | Kraise k-> fprintf ppf "\t%s" (Lambda.raise_kind k)
+  | Kcheck_signals -> fprintf ppf "\tcheck_signals"
+  | Kccall(s, n) ->
+      fprintf ppf "\tccall %s, %i" s n
+  | Knegint -> fprintf ppf "\tnegint"
+  | Kaddint -> fprintf ppf "\taddint"
+  | Ksubint -> fprintf ppf "\tsubint"
+  | Kmulint -> fprintf ppf "\tmulint"
+  | Kdivint -> fprintf ppf "\tdivint"
+  | Kmodint -> fprintf ppf "\tmodint"
+  | Kandint -> fprintf ppf "\tandint"
+  | Korint -> fprintf ppf "\torint"
+  | Kxorint -> fprintf ppf "\txorint"
+  | Klslint -> fprintf ppf "\tlslint"
+  | Klsrint -> fprintf ppf "\tlsrint"
+  | Kasrint -> fprintf ppf "\tasrint"
+  | Kintcomp Ceq -> fprintf ppf "\teqint"
+  | Kintcomp Cne -> fprintf ppf "\tneqint"
+  | Kintcomp Clt -> fprintf ppf "\tltint"
+  | Kintcomp Cgt -> fprintf ppf "\tgtint"
+  | Kintcomp Cle -> fprintf ppf "\tleint"
+  | Kintcomp Cge -> fprintf ppf "\tgeint"
+  | Koffsetint n -> fprintf ppf "\toffsetint %i" n
+  | Koffsetref n -> fprintf ppf "\toffsetref %i" n
+  | Kisint -> fprintf ppf "\tisint"
+  | Kisout -> fprintf ppf "\tisout"
+  | Kgetmethod -> fprintf ppf "\tgetmethod"
+  | Kgetpubmet n -> fprintf ppf "\tgetpubmet %i" n
+  | Kgetdynmet -> fprintf ppf "\tgetdynmet"
+  | Kstop -> fprintf ppf "\tstop"
+  | Kevent ev -> fprintf ppf "\tevent \"%s\" %i-%i"
+                         ev.ev_loc.Location.loc_start.Lexing.pos_fname
+                         ev.ev_loc.Location.loc_start.Lexing.pos_cnum
+                         ev.ev_loc.Location.loc_end.Lexing.pos_cnum
+
+let rec instruction_list ppf = function
+    [] -> ()
+  | Klabel lbl :: il ->
+      fprintf ppf "L%i:%a" lbl instruction_list il
+  | instr :: il ->
+      fprintf ppf "%a@ %a" instruction instr instruction_list il
+
+let instrlist ppf il =
+  fprintf ppf "@[%a@]" instruction_list il
diff --git a/bytecomp/printinstr.mli b/bytecomp/printinstr.mli
new file mode 100644
index 00000000..3cf3539d
--- /dev/null
+++ b/bytecomp/printinstr.mli
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Pretty-print lists of instructions *)
+
+open Instruct
+
+open Format
+
+val instruction: formatter -> instruction -> unit
+val instrlist: formatter -> instruction list -> unit
diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml
new file mode 100644
index 00000000..dad4cafe
--- /dev/null
+++ b/bytecomp/symtable.ml
@@ -0,0 +1,424 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "-40"]
+
+(* To assign numbers to globals and primitives *)
+
+open Misc
+open Asttypes
+open Lambda
+open Cmo_format
+
+module String = Misc.Stdlib.String
+
+(* Functions for batch linking *)
+
+type error =
+    Undefined_global of string
+  | Unavailable_primitive of string
+  | Wrong_vm of string
+  | Uninitialized_global of string
+
+exception Error of error
+
+module Num_tbl (M : Map.S) = struct
+
+  type t = {
+    cnt: int; (* The next number *)
+    tbl: int M.t ; (* The table of already numbered objects *)
+  }
+
+  let empty = { cnt = 0; tbl = M.empty }
+
+  let find nt key =
+    M.find key nt.tbl
+
+  let enter nt key =
+    let n = !nt.cnt in
+    nt := { cnt = n + 1; tbl = M.add key n !nt.tbl };
+    n
+
+  let incr nt =
+    let n = !nt.cnt in
+    nt := { cnt = n + 1; tbl = !nt.tbl };
+    n
+
+end
+module GlobalMap = Num_tbl(Ident.Map)
+module PrimMap = Num_tbl(Misc.Stdlib.String.Map)
+
+(* Global variables *)
+
+let global_table = ref GlobalMap.empty
+and literal_table = ref([] : (int * structured_constant) list)
+
+let is_global_defined id =
+  Ident.Map.mem id (!global_table).tbl
+
+let slot_for_getglobal id =
+  try
+    GlobalMap.find !global_table id
+  with Not_found ->
+    raise(Error(Undefined_global(Ident.name id)))
+
+let slot_for_setglobal id =
+  GlobalMap.enter global_table id
+
+let slot_for_literal cst =
+  let n = GlobalMap.incr global_table in
+  literal_table := (n, cst) :: !literal_table;
+  n
+
+(* The C primitives *)
+
+let c_prim_table = ref PrimMap.empty
+
+let set_prim_table name =
+  ignore(PrimMap.enter c_prim_table name)
+
+let of_prim name =
+  try
+    PrimMap.find !c_prim_table name
+  with Not_found ->
+    if !Clflags.custom_runtime || Config.host <> Config.target
+       || !Clflags.no_check_prims
+    then
+      PrimMap.enter c_prim_table name
+    else begin
+      let symb =
+        try Dll.find_primitive name
+        with Not_found -> raise(Error(Unavailable_primitive name)) in
+      let num = PrimMap.enter c_prim_table name in
+      Dll.synchronize_primitive num symb;
+      num
+    end
+
+let require_primitive name =
+  if name.[0] <> '%' then ignore(of_prim name)
+
+let all_primitives () =
+  let prim = Array.make !c_prim_table.cnt "" in
+  String.Map.iter (fun name number -> prim.(number) <- name) !c_prim_table.tbl;
+  prim
+
+let data_primitive_names () =
+  let prim = all_primitives() in
+  let b = Buffer.create 512 in
+  for i = 0 to Array.length prim - 1 do
+    Buffer.add_string b prim.(i); Buffer.add_char b '\000'
+  done;
+  Buffer.contents b
+
+let output_primitive_names outchan =
+  output_string outchan (data_primitive_names())
+
+open Printf
+
+let output_primitive_table outchan =
+  let prim = all_primitives() in
+  for i = 0 to Array.length prim - 1 do
+    fprintf outchan "extern value %s();\n" prim.(i)
+  done;
+  fprintf outchan "typedef value (*primitive)();\n";
+  fprintf outchan "primitive caml_builtin_cprim[] = {\n";
+  for i = 0 to Array.length prim - 1 do
+    fprintf outchan "  %s,\n" prim.(i)
+  done;
+  fprintf outchan "  (primitive) 0 };\n";
+  fprintf outchan "const char * caml_names_of_builtin_cprim[] = {\n";
+  for i = 0 to Array.length prim - 1 do
+    fprintf outchan "  \"%s\",\n" prim.(i)
+  done;
+  fprintf outchan "  (char *) 0 };\n"
+
+(* Initialization for batch linking *)
+
+let init () =
+  (* Enter the predefined exceptions *)
+  Array.iteri
+    (fun i name ->
+      let id =
+        try List.assoc name Predef.builtin_values
+        with Not_found -> fatal_error "Symtable.init" in
+      let c = slot_for_setglobal id in
+      let cst = Const_block
+          (Obj.object_tag,
+           [Const_base(Const_string (name, Location.none,None));
+            Const_base(Const_int (-i-1))
+           ])
+      in
+      literal_table := (c, cst) :: !literal_table)
+    Runtimedef.builtin_exceptions;
+  (* Initialize the known C primitives *)
+  let set_prim_table_from_file primfile =
+    let ic = open_in primfile in
+    Misc.try_finally
+      ~always:(fun () -> close_in ic)
+      (fun () ->
+         try
+           while true do
+             set_prim_table (input_line ic)
+           done
+         with End_of_file -> ()
+      )
+  in
+  if String.length !Clflags.use_prims > 0 then
+    set_prim_table_from_file !Clflags.use_prims
+  else if String.length !Clflags.use_runtime > 0 then begin
+    let primfile = Filename.temp_file "camlprims" "" in
+    Misc.try_finally
+      ~always:(fun () -> remove_file primfile)
+      (fun () ->
+         if Sys.command(Printf.sprintf "%s -p > %s"
+                          !Clflags.use_runtime primfile) <> 0
+         then raise(Error(Wrong_vm !Clflags.use_runtime));
+         set_prim_table_from_file primfile
+      )
+  end else begin
+    Array.iter set_prim_table Runtimedef.builtin_primitives
+  end
+
+(* Relocate a block of object bytecode *)
+
+let patch_int buff pos n =
+  LongString.set buff pos (Char.unsafe_chr n);
+  LongString.set buff (pos + 1) (Char.unsafe_chr (n asr 8));
+  LongString.set buff (pos + 2) (Char.unsafe_chr (n asr 16));
+  LongString.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_getglobal id, pos) ->
+          patch_int buff pos (slot_for_getglobal id)
+      | (Reloc_setglobal id, pos) ->
+          patch_int buff pos (slot_for_setglobal id)
+      | (Reloc_primitive name, pos) ->
+          patch_int buff pos (of_prim name))
+    patchlist
+
+(* Translate structured constants *)
+
+let rec transl_const = function
+    Const_base(Const_int i) -> Obj.repr i
+  | Const_base(Const_char c) -> Obj.repr c
+  | Const_base(Const_string (s, _, _)) -> Obj.repr s
+  | Const_base(Const_float f) -> Obj.repr (float_of_string f)
+  | Const_base(Const_int32 i) -> Obj.repr i
+  | Const_base(Const_int64 i) -> Obj.repr i
+  | Const_base(Const_nativeint i) -> Obj.repr i
+  | Const_pointer i -> Obj.repr i
+  | Const_immstring s -> Obj.repr s
+  | Const_block(tag, fields) ->
+      let block = Obj.new_block tag (List.length fields) in
+      let pos = ref 0 in
+      List.iter
+        (fun c -> Obj.set_field block !pos (transl_const c); incr pos)
+        fields;
+      block
+  | Const_float_array fields ->
+      let res = Array.Floatarray.create (List.length fields) in
+      List.iteri (fun i f -> Array.Floatarray.set res i (float_of_string f))
+        fields;
+      Obj.repr res
+
+(* Build the initial table of globals *)
+
+let initial_global_table () =
+  let glob = Array.make !global_table.cnt (Obj.repr 0) in
+  List.iter
+    (fun (slot, cst) -> glob.(slot) <- transl_const cst)
+    !literal_table;
+  literal_table := [];
+  glob
+
+(* Save the table of globals *)
+
+let output_global_map oc =
+  output_value oc !global_table
+
+let data_global_map () =
+  Obj.repr !global_table
+
+(* Functions for toplevel use *)
+
+(* Update the in-core table of globals *)
+
+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) <- transl_const cst)
+    !literal_table;
+  literal_table := []
+
+(* Recover data for toplevel initialization.  Data can come either from
+   executable file (normal case) or from linked-in data (-output-obj). *)
+
+type section_reader = {
+  read_string: string -> string;
+  read_struct: string -> Obj.t;
+  close_reader: unit -> unit
+}
+
+let read_sections () =
+  try
+    let sections = Meta.get_section_table () in
+    { read_string =
+        (fun name -> (Obj.magic(List.assoc name sections) : string));
+      read_struct =
+        (fun name -> List.assoc name sections);
+      close_reader =
+        (fun () -> ()) }
+  with Not_found ->
+    let ic = open_in_bin Sys.executable_name in
+    Bytesections.read_toc ic;
+    { read_string = Bytesections.read_section_string ic;
+      read_struct = Bytesections.read_section_struct ic;
+      close_reader = fun () -> close_in ic }
+
+(* Initialize the linker for toplevel use *)
+
+let init_toplevel () =
+  try
+    let sect = read_sections () in
+    (* Locations of globals *)
+    global_table := (Obj.magic (sect.read_struct "SYMB") : GlobalMap.t);
+    (* Primitives *)
+    let prims = sect.read_string "PRIM" in
+    c_prim_table := PrimMap.empty;
+    let pos = ref 0 in
+    while !pos < String.length prims do
+      let i = String.index_from prims !pos '\000' in
+      set_prim_table (String.sub prims !pos (i - !pos));
+      pos := i + 1
+    done;
+    (* DLL initialization *)
+    let dllpath = try sect.read_string "DLPT" with Not_found -> "" in
+    Dll.init_toplevel dllpath;
+    (* Recover CRC infos for interfaces *)
+    let crcintfs =
+      try
+        (Obj.magic (sect.read_struct "CRCS") : (string * Digest.t option) list)
+      with Not_found -> [] in
+    (* Done *)
+    sect.close_reader();
+    crcintfs
+  with Bytesections.Bad_magic_number | Not_found | Failure _ ->
+    fatal_error "Toplevel bytecode executable is corrupted"
+
+(* Find the value of a global identifier *)
+
+let get_global_position id = slot_for_getglobal id
+
+let get_global_value id =
+  (Meta.global_data()).(slot_for_getglobal id)
+let assign_global_value id v =
+  (Meta.global_data()).(slot_for_getglobal id) <- v
+
+(* Check that all globals referenced in the given patch list
+   have been initialized already *)
+
+let defined_globals patchlist =
+  List.fold_left (fun accu rel ->
+      match rel with
+      | (Reloc_setglobal id, _pos) -> id :: accu
+      | _ -> accu)
+    []
+    patchlist
+
+let required_globals patchlist =
+  List.fold_left (fun accu rel ->
+      match rel with
+      | (Reloc_getglobal id, _pos) -> id :: accu
+      | _ -> accu)
+    []
+    patchlist
+
+let check_global_initialized patchlist =
+  (* First determine the globals we will define *)
+  let defined_globals = defined_globals patchlist in
+  (* Then check that all referenced, not defined globals have a value *)
+  let check_reference = function
+      (Reloc_getglobal id, _pos) ->
+        if not (List.mem id defined_globals)
+        && Obj.is_int (get_global_value id)
+        then raise (Error(Uninitialized_global(Ident.name id)))
+    | _ -> () in
+  List.iter check_reference patchlist
+
+(* Save and restore the current state *)
+
+type global_map = GlobalMap.t
+
+let current_state () = !global_table
+
+let restore_state st = global_table := st
+
+let hide_additions (st : global_map) =
+  if st.cnt > !global_table.cnt then
+    fatal_error "Symtable.hide_additions";
+  global_table :=
+    {GlobalMap.
+      cnt = !global_table.cnt;
+      tbl = st.tbl }
+
+(* "Filter" the global map according to some predicate.
+   Used to expunge the global map for the toplevel. *)
+
+let filter_global_map p (gmap : global_map) =
+  let newtbl = ref Ident.Map.empty in
+  Ident.Map.iter
+    (fun id num -> if p id then newtbl := Ident.Map.add id num !newtbl)
+    gmap.tbl;
+  {GlobalMap. cnt = gmap.cnt; tbl = !newtbl}
+
+let iter_global_map f (gmap : global_map) =
+  Ident.Map.iter f gmap.tbl
+
+let is_defined_in_global_map (gmap : global_map) id =
+  Ident.Map.mem id gmap.tbl
+
+let empty_global_map = GlobalMap.empty
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+  | Undefined_global s ->
+      fprintf ppf "Reference to undefined global `%s'" s
+  | Unavailable_primitive s ->
+      fprintf ppf "The external function `%s' is not available" s
+  | Wrong_vm s ->
+      fprintf ppf "Cannot find or execute the runtime system %s" s
+  | Uninitialized_global s ->
+      fprintf ppf "The value of the global `%s' is not yet computed" s
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )
+
+let reset () =
+  global_table := GlobalMap.empty;
+  literal_table := [];
+  c_prim_table := PrimMap.empty
diff --git a/bytecomp/symtable.mli b/bytecomp/symtable.mli
new file mode 100644
index 00000000..782a6086
--- /dev/null
+++ b/bytecomp/symtable.mli
@@ -0,0 +1,69 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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 Cmo_format
+
+(* Functions for batch linking *)
+
+val init: unit -> unit
+val patch_object: Misc.LongString.t -> (reloc_info * int) list -> unit
+val require_primitive: string -> unit
+val initial_global_table: unit -> Obj.t array
+val output_global_map: out_channel -> unit
+val output_primitive_names: out_channel -> unit
+val output_primitive_table: out_channel -> unit
+val data_global_map: unit -> Obj.t
+val data_primitive_names: unit -> string
+val transl_const: Lambda.structured_constant -> Obj.t
+
+(* Functions for the toplevel *)
+
+val init_toplevel: unit -> (string * Digest.t option) list
+val update_global_table: unit -> unit
+val get_global_value: Ident.t -> Obj.t
+val is_global_defined: Ident.t -> bool
+val assign_global_value: Ident.t -> Obj.t -> unit
+val get_global_position: Ident.t -> int
+val check_global_initialized: (reloc_info * int) list -> unit
+val defined_globals: (reloc_info * int) list -> Ident.t list
+val required_globals: (reloc_info * int) list -> Ident.t list
+
+type global_map
+
+val empty_global_map: global_map
+val current_state: unit -> global_map
+val restore_state: global_map -> unit
+val hide_additions: global_map -> unit
+val filter_global_map: (Ident.t -> bool) -> global_map -> global_map
+val iter_global_map : (Ident.t -> int -> unit) -> global_map -> unit
+val is_defined_in_global_map: global_map -> Ident.t -> bool
+
+(* Error report *)
+
+type error =
+    Undefined_global of string
+  | Unavailable_primitive of string
+  | Wrong_vm of string
+  | Uninitialized_global of string
+
+exception Error of error
+
+open Format
+
+val report_error: formatter -> error -> unit
+
+val reset: unit -> unit
diff --git a/compilerlibs/Makefile.compilerlibs b/compilerlibs/Makefile.compilerlibs
new file mode 100644
index 00000000..3acfaf8b
--- /dev/null
+++ b/compilerlibs/Makefile.compilerlibs
@@ -0,0 +1,335 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# Targets and dependencies for compilerlibs archives
+
+# This file is meant to be included from the root Makefile, not to be
+# executed directly (this is why it is not simply named Makefile).
+
+# For each group of compilation units, we have a variable GROUP with
+# only .cmo files, and a separate variable GROUP_CMI for .cmi files
+# corresponding to the .mli-only modules only. These .cmi are not
+# linked in the archive, but they are marked as dependencies to ensure
+# that they are consistent with the interface digests in the archives.
+
+UTILS=utils/config.cmo utils/build_path_prefix_map.cmo utils/misc.cmo \
+	utils/identifiable.cmo utils/numbers.cmo utils/arg_helper.cmo \
+	utils/clflags.cmo utils/profile.cmo utils/load_path.cmo \
+	utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \
+	utils/consistbl.cmo utils/strongly_connected_components.cmo \
+	utils/targetint.cmo utils/int_replace_polymorphic_compare.cmo \
+	utils/domainstate.cmo
+UTILS_CMI=
+
+PARSING=parsing/location.cmo parsing/longident.cmo \
+  parsing/docstrings.cmo parsing/syntaxerr.cmo \
+  parsing/ast_helper.cmo \
+  parsing/pprintast.cmo \
+  parsing/camlinternalMenhirLib.cmo parsing/parser.cmo \
+  parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo \
+  parsing/ast_mapper.cmo parsing/ast_iterator.cmo parsing/attr_helper.cmo \
+  parsing/builtin_attributes.cmo parsing/ast_invariants.cmo parsing/depend.cmo
+PARSING_CMI=\
+  parsing/asttypes.cmi \
+  parsing/parsetree.cmi
+
+TYPING=typing/ident.cmo typing/path.cmo \
+  typing/primitive.cmo typing/type_immediacy.cmo typing/types.cmo \
+  typing/btype.cmo typing/oprint.cmo \
+  typing/subst.cmo typing/predef.cmo \
+  typing/datarepr.cmo file_formats/cmi_format.cmo \
+  typing/persistent_env.cmo typing/env.cmo \
+  typing/typedtree.cmo typing/printtyped.cmo typing/ctype.cmo \
+  typing/printtyp.cmo typing/includeclass.cmo \
+  typing/mtype.cmo typing/envaux.cmo typing/includecore.cmo \
+  typing/tast_iterator.cmo typing/tast_mapper.cmo typing/stypes.cmo \
+  file_formats/cmt_format.cmo typing/cmt2annot.cmo typing/untypeast.cmo \
+  typing/includemod.cmo typing/typetexp.cmo typing/printpat.cmo \
+  typing/parmatch.cmo \
+  typing/typedecl_properties.cmo typing/typedecl_variance.cmo \
+  typing/typedecl_unboxed.cmo typing/typedecl_immediacy.cmo \
+  typing/typedecl_separability.cmo \
+  typing/typedecl.cmo typing/typeopt.cmo \
+  typing/rec_check.cmo typing/typecore.cmo typing/typeclass.cmo \
+  typing/typemod.cmo
+TYPING_CMI=\
+  typing/annot.cmi \
+  typing/outcometree.cmi
+
+LAMBDA=lambda/debuginfo.cmo \
+  lambda/lambda.cmo lambda/printlambda.cmo \
+  lambda/switch.cmo lambda/matching.cmo \
+  lambda/translobj.cmo lambda/translattribute.cmo \
+  lambda/translprim.cmo lambda/translcore.cmo \
+  lambda/translclass.cmo lambda/translmod.cmo \
+  lambda/simplif.cmo lambda/runtimedef.cmo
+LAMBDA_CMI=
+
+COMP=\
+  bytecomp/meta.cmo bytecomp/opcodes.cmo \
+  bytecomp/bytesections.cmo bytecomp/dll.cmo \
+  bytecomp/symtable.cmo \
+  driver/pparse.cmo driver/compenv.cmo \
+  driver/main_args.cmo driver/compmisc.cmo \
+  driver/makedepend.cmo \
+  driver/compile_common.cmo
+COMP_CMI=\
+  file_formats/cmo_format.cmi \
+  file_formats/cmx_format.cmi \
+  file_formats/cmxs_format.cmi
+# All file format descriptions (including cmx{,s}) are in the
+# ocamlcommon library so that ocamlobjinfo can depend on them.
+
+COMMON_CMI=$(UTILS_CMI) $(PARSING_CMI) $(TYPING_CMI) $(LAMBDA_CMI) $(COMP_CMI)
+
+COMMON=$(UTILS) $(PARSING) $(TYPING) $(LAMBDA) $(COMP)
+
+BYTECOMP=bytecomp/instruct.cmo bytecomp/bytegen.cmo \
+  bytecomp/printinstr.cmo bytecomp/emitcode.cmo \
+  bytecomp/bytelink.cmo bytecomp/bytelibrarian.cmo bytecomp/bytepackager.cmo \
+  driver/errors.cmo driver/compile.cmo
+BYTECOMP_CMI=
+
+ARCH_SPECIFIC =\
+  asmcomp/arch.ml asmcomp/proc.ml asmcomp/CSE.ml asmcomp/selection.ml \
+  asmcomp/scheduling.ml asmcomp/reload.ml
+ARCH_SPECIFIC_CMI=
+
+INTEL_ASM=\
+  asmcomp/x86_proc.cmo \
+  asmcomp/x86_dsl.cmo \
+  asmcomp/x86_gas.cmo \
+  asmcomp/x86_masm.cmo
+INTEL_ASM_CMI=\
+  asmcomp/x86_ast.cmi
+
+ARCH_SPECIFIC_ASMCOMP=
+ifeq ($(ARCH),i386)
+ARCH_SPECIFIC_ASMCOMP=$(INTEL_ASM)
+ARCH_SPECIFIC_ASMCOMP_CMI=$(INTEL_ASM_CMI)
+endif
+ifeq ($(ARCH),amd64)
+ARCH_SPECIFIC_ASMCOMP=$(INTEL_ASM)
+ARCH_SPECIFIC_ASMCOMP_CMI=$(INTEL_ASM_CMI)
+endif
+
+ASMCOMP=\
+  $(ARCH_SPECIFIC_ASMCOMP) \
+  asmcomp/arch.cmo \
+  asmcomp/cmm.cmo asmcomp/printcmm.cmo \
+  asmcomp/reg.cmo asmcomp/debug/reg_with_debug_info.cmo \
+  asmcomp/debug/reg_availability_set.cmo \
+  asmcomp/mach.cmo asmcomp/proc.cmo \
+  asmcomp/afl_instrument.cmo \
+  asmcomp/strmatch.cmo \
+  asmcomp/cmmgen_state.cmo \
+  asmcomp/cmm_helpers.cmo \
+  asmcomp/cmmgen.cmo \
+  asmcomp/interval.cmo \
+  asmcomp/printmach.cmo asmcomp/selectgen.cmo \
+  asmcomp/spacetime_profiling.cmo asmcomp/selection.cmo \
+  asmcomp/comballoc.cmo \
+  asmcomp/CSEgen.cmo asmcomp/CSE.cmo \
+  asmcomp/liveness.cmo \
+  asmcomp/spill.cmo asmcomp/split.cmo \
+  asmcomp/interf.cmo asmcomp/coloring.cmo \
+  asmcomp/linscan.cmo \
+  asmcomp/reloadgen.cmo asmcomp/reload.cmo \
+  asmcomp/deadcode.cmo \
+  asmcomp/linear.cmo asmcomp/printlinear.cmo asmcomp/linearize.cmo \
+  asmcomp/debug/available_regs.cmo \
+  asmcomp/debug/compute_ranges_intf.cmo \
+  asmcomp/debug/compute_ranges.cmo \
+  asmcomp/schedgen.cmo asmcomp/scheduling.cmo \
+  asmcomp/branch_relaxation_intf.cmo \
+  asmcomp/branch_relaxation.cmo \
+  asmcomp/emitaux.cmo asmcomp/emit.cmo asmcomp/asmgen.cmo \
+  asmcomp/asmlink.cmo asmcomp/asmlibrarian.cmo asmcomp/asmpackager.cmo \
+  driver/opterrors.cmo driver/optcompile.cmo
+ASMCOMP_CMI=$(ARCH_SPECIFIC_ASMCOMP_CMI)
+
+# Files under middle_end/ are not to reference files under asmcomp/.
+# This ensures that the middle end can be linked (e.g. for objinfo) even when
+# the native code compiler is not present for some particular target.
+
+MIDDLE_END_CLOSURE=\
+  middle_end/closure/closure.cmo \
+  middle_end/closure/closure_middle_end.cmo
+MIDDLE_END_CLOSURE_CMI=
+
+# Owing to dependencies through [Compilenv], which would be
+# difficult to remove, some of the lower parts of Flambda (anything that is
+# saved in a .cmx file) have to be included in the [MIDDLE_END] stanza, below.
+MIDDLE_END_FLAMBDA=\
+  middle_end/flambda/import_approx.cmo \
+  middle_end/flambda/lift_code.cmo \
+  middle_end/flambda/closure_conversion_aux.cmo \
+  middle_end/flambda/closure_conversion.cmo \
+  middle_end/flambda/initialize_symbol_to_let_symbol.cmo \
+  middle_end/flambda/lift_let_to_initialize_symbol.cmo \
+  middle_end/flambda/find_recursive_functions.cmo \
+  middle_end/flambda/invariant_params.cmo \
+  middle_end/flambda/inconstant_idents.cmo \
+  middle_end/flambda/alias_analysis.cmo \
+  middle_end/flambda/lift_constants.cmo \
+  middle_end/flambda/share_constants.cmo \
+  middle_end/flambda/simplify_common.cmo \
+  middle_end/flambda/remove_unused_arguments.cmo \
+  middle_end/flambda/remove_unused_closure_vars.cmo \
+  middle_end/flambda/remove_unused_program_constructs.cmo \
+  middle_end/flambda/simplify_boxed_integer_ops.cmo \
+  middle_end/flambda/simplify_primitives.cmo \
+  middle_end/flambda/inlining_stats_types.cmo \
+  middle_end/flambda/inlining_stats.cmo \
+  middle_end/flambda/inline_and_simplify_aux.cmo \
+  middle_end/flambda/remove_free_vars_equal_to_args.cmo \
+  middle_end/flambda/extract_projections.cmo \
+  middle_end/flambda/augment_specialised_args.cmo \
+  middle_end/flambda/unbox_free_vars_of_closures.cmo \
+  middle_end/flambda/unbox_specialised_args.cmo \
+  middle_end/flambda/unbox_closures.cmo \
+  middle_end/flambda/inlining_transforms.cmo \
+  middle_end/flambda/inlining_decision.cmo \
+  middle_end/flambda/inline_and_simplify.cmo \
+  middle_end/flambda/ref_to_variables.cmo \
+  middle_end/flambda/flambda_invariants.cmo \
+  middle_end/flambda/traverse_for_exported_symbols.cmo \
+  middle_end/flambda/build_export_info.cmo \
+  middle_end/flambda/closure_offsets.cmo \
+  middle_end/flambda/un_anf.cmo \
+  middle_end/flambda/flambda_to_clambda.cmo \
+  middle_end/flambda/flambda_middle_end.cmo
+MIDDLE_END_FLAMBDA_CMI=\
+  middle_end/flambda/inlining_decision_intf.cmi \
+  middle_end/flambda/simplify_boxed_integer_ops_intf.cmi
+
+MIDDLE_END=\
+  middle_end/internal_variable_names.cmo \
+  middle_end/linkage_name.cmo \
+  middle_end/compilation_unit.cmo \
+  middle_end/variable.cmo \
+  middle_end/flambda/base_types/closure_element.cmo \
+  middle_end/flambda/base_types/closure_id.cmo \
+  middle_end/symbol.cmo \
+  middle_end/backend_var.cmo \
+  middle_end/clambda_primitives.cmo \
+  middle_end/printclambda_primitives.cmo \
+  middle_end/clambda.cmo \
+  middle_end/printclambda.cmo \
+  middle_end/semantics_of_primitives.cmo \
+  middle_end/convert_primitives.cmo \
+  middle_end/flambda/base_types/id_types.cmo \
+  middle_end/flambda/base_types/export_id.cmo \
+  middle_end/flambda/base_types/tag.cmo \
+  middle_end/flambda/base_types/mutable_variable.cmo \
+  middle_end/flambda/base_types/set_of_closures_id.cmo \
+  middle_end/flambda/base_types/set_of_closures_origin.cmo \
+  middle_end/flambda/base_types/closure_origin.cmo \
+  middle_end/flambda/base_types/var_within_closure.cmo \
+  middle_end/flambda/base_types/static_exception.cmo \
+  middle_end/flambda/pass_wrapper.cmo \
+  middle_end/flambda/allocated_const.cmo \
+  middle_end/flambda/parameter.cmo \
+  middle_end/flambda/projection.cmo \
+  middle_end/flambda/flambda.cmo \
+  middle_end/flambda/flambda_iterators.cmo \
+  middle_end/flambda/flambda_utils.cmo \
+  middle_end/flambda/freshening.cmo \
+  middle_end/flambda/effect_analysis.cmo \
+  middle_end/flambda/inlining_cost.cmo \
+  middle_end/flambda/simple_value_approx.cmo \
+  middle_end/flambda/export_info.cmo \
+  middle_end/flambda/export_info_for_pack.cmo \
+  middle_end/compilenv.cmo \
+  $(MIDDLE_END_CLOSURE) \
+  $(MIDDLE_END_FLAMBDA)
+MIDDLE_END_CMI=\
+  middle_end/backend_intf.cmi \
+  $(MIDDLE_END_CLOSURE_CMI) \
+  $(MIDDLE_END_FLAMBDA_CMI)
+
+OPTCOMP=$(MIDDLE_END) $(ASMCOMP)
+OPTCOMP_CMI=$(MIDDLE_END_CMI) $(ASMCOMP_CMI)
+
+TOPLEVEL=toplevel/genprintval.cmo toplevel/toploop.cmo \
+  toplevel/trace.cmo toplevel/topdirs.cmo toplevel/topmain.cmo
+TOPLEVEL_CMI=
+
+OPTTOPLEVEL=toplevel/genprintval.cmo toplevel/opttoploop.cmo \
+  toplevel/opttopdirs.cmo toplevel/opttopmain.cmo
+OPTTOPLEVEL_CMI=
+
+
+$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(OPTCOMP:.cmo=.cmx): ocamlopt
+$(OPTTOPLEVEL:.cmo=.cmx): ocamlopt
+
+
+compilerlibs/ocamlcommon.cma: $(COMMON_CMI) $(COMMON)
+	$(CAMLC) -a -linkall -o $@ $(COMMON)
+partialclean::
+	rm -f compilerlibs/ocamlcommon.cma
+
+compilerlibs/ocamlcommon.cmxa: $(COMMON_CMI) $(COMMON:.cmo=.cmx)
+	$(CAMLOPT) -a -linkall -o $@ $(COMMON:.cmo=.cmx)
+partialclean::
+	rm -f compilerlibs/ocamlcommon.cmxa \
+	      compilerlibs/ocamlcommon.a compilerlibs/ocamlcommon.lib
+
+
+compilerlibs/ocamlbytecomp.cma: $(BYTECOMP_CMI) $(BYTECOMP)
+	$(CAMLC) -a -o $@ $(BYTECOMP)
+partialclean::
+	rm -f compilerlibs/ocamlbytecomp.cma
+
+compilerlibs/ocamlbytecomp.cmxa: $(BYTECOMP_CMI) $(BYTECOMP:.cmo=.cmx)
+	$(CAMLOPT) -a $(OCAML_NATDYNLINKOPTS) -o $@ $(BYTECOMP:.cmo=.cmx)
+partialclean::
+	rm -f compilerlibs/ocamlbytecomp.cmxa \
+	      compilerlibs/ocamlbytecomp.a compilerlibs/ocamlbytecomp.lib
+
+
+compilerlibs/ocamlmiddleend.cma: $(MIDDLE_END_CMI) $(MIDDLE_END)
+	$(CAMLC) -a -o $@ $(MIDDLE_END)
+compilerlibs/ocamlmiddleend.cmxa: $(MIDDLE_END_CMI) $(MIDDLE_END:%.cmo=%.cmx)
+	$(CAMLOPT) -a -o $@ $(MIDDLE_END:%.cmo=%.cmx)
+partialclean::
+	rm -f compilerlibs/ocamlmiddleend.cma \
+	      compilerlibs/ocamlmiddleend.cmxa \
+	      compilerlibs/ocamlmiddleend.a \
+	      compilerlibs/ocamlmiddleend.lib
+
+
+compilerlibs/ocamloptcomp.cma: $(OPTCOMP_CMI) $(OPTCOMP)
+	$(CAMLC) -a -o $@ $(OPTCOMP)
+partialclean::
+	rm -f compilerlibs/ocamloptcomp.cma
+
+compilerlibs/ocamloptcomp.cmxa: $(OPTCOMP_CMI) $(OPTCOMP:.cmo=.cmx)
+	$(CAMLOPT) -a -o $@ $(OPTCOMP:.cmo=.cmx)
+partialclean::
+	rm -f compilerlibs/ocamloptcomp.cmxa \
+	      compilerlibs/ocamloptcomp.a compilerlibs/ocamloptcomp.lib
+
+
+compilerlibs/ocamltoplevel.cma: $(TOPLEVEL_CMI) $(TOPLEVEL)
+	$(CAMLC) -a -o $@ $(TOPLEVEL)
+partialclean::
+	rm -f compilerlibs/ocamltoplevel.cma
+
+compilerlibs/ocamlopttoplevel.cmxa: $(OPTTOPLEVEL_CMI) $(OPTTOPLEVEL:.cmo=.cmx)
+	$(CAMLOPT) -a -o $@ $(OPTTOPLEVEL:.cmo=.cmx)
+partialclean::
+	rm -f compilerlibs/ocamlopttoplevel.cmxa \
+	  compilerlibs/ocamlopttoplevel.a compilerlibs/ocamlopttoplevel.lib
diff --git a/configure b/configure
new file mode 100755
index 00000000..74657d2d
--- /dev/null
+++ b/configure
@@ -0,0 +1,19230 @@
+#! /bin/sh
+
+if test -e '.git' ; then :
+  if test -z "$ac_read_git_config" ; then :
+    extra_args=$(git config ocaml.configure 2>/dev/null)
+    extended_cache=$(git config ocaml.configure-cache 2>/dev/null)
+    cache_file=
+
+    # If ocaml.configure-cache is set, parse the command-line for the --host
+    # option, in order to determine the name of the cache file.
+    if test -n "$extended_cache" ; then :
+      echo "Detected Git configuration option ocaml.configure-cache set to \
+\"$extended_cache\""
+      dashdash=
+      prev=
+      host=default
+      # The logic here is pretty borrowed from autoconf's
+      for option in $extra_args "$@"
+      do
+        if test -n "$prev" ; then :
+          host=$option
+          continue
+        fi
+
+        case $dashdash$option in
+          --)
+            dashdash=yes ;;
+          -host | --host | --hos | --ho)
+            prev=host ;;
+          -host=* | --host=* | --hos=* | --ho=*)
+            case $option in
+              *=?*) host=$(expr "X$option" : '[^=]*=\(.*\)') ;;
+              *=) host= ;;
+            esac ;;
+        esac
+      done
+      cache_file="`dirname "$0"`/$extended_cache/ocaml-$host.cache"
+    fi
+
+    # If either option has a value, re-invoke configure
+    if test -n "$extra_args$cache_file" ; then :
+      echo "Detected Git configuration option ocaml.configure set to \
+\"$extra_args\""
+      # Too much effort to get the echo to show appropriate quoting - the
+      # invocation itself intentionally quotes $0 and passes $@ exactly as given
+      # but allows a single expansion of ocaml.configure
+      if test -n "$cache_file" ; then :
+        echo "Re-running $0 $extra_args --cache-file \"$cache_file\" $@"
+        ac_read_git_config=true exec "$0" $extra_args \
+                                          --cache-file "$cache_file" "$@"
+      else
+        echo "Re-running $0 $extra_args $@"
+        ac_read_git_config=true exec "$0" $extra_args "$@"
+      fi
+    fi
+  fi
+fi
+# Guess values for system-dependent variables and create Makefiles.
+# Generated by GNU Autoconf 2.69 for OCaml 4.11.1.
+#
+# Report bugs to .
+#
+#
+# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
+#
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in #(
+  *posix*) :
+    set -o posix ;; #(
+  *) :
+     ;;
+esac
+fi
+
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='print -r --'
+  as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='printf %s\n'
+  as_echo_n='printf %s'
+else
+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+    as_echo_n='/usr/ucb/echo -n'
+  else
+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+    as_echo_n_body='eval
+      arg=$1;
+      case $arg in #(
+      *"$as_nl"*)
+	expr "X$arg" : "X\\(.*\\)$as_nl";
+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+      esac;
+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+    '
+    export as_echo_n_body
+    as_echo_n='sh -c $as_echo_n_body as_echo'
+  fi
+  export as_echo_body
+  as_echo='sh -c $as_echo_body as_echo'
+fi
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+  PATH_SEPARATOR=:
+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+      PATH_SEPARATOR=';'
+  }
+fi
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.  Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" ""	$as_nl"
+
+# Find who we are.  Look in the path if we contain no directory separator.
+as_myself=
+case $0 in #((
+  *[\\/]* ) as_myself=$0 ;;
+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+  done
+IFS=$as_save_IFS
+
+     ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+  as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+  exit 1
+fi
+
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there.  '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+# Use a proper internal environment variable to ensure we don't fall
+  # into an infinite loop, continuously re-executing ourselves.
+  if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then
+    _as_can_reexec=no; export _as_can_reexec;
+    # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+  *v*x* | *x*v* ) as_opts=-vx ;;
+  *v* ) as_opts=-v ;;
+  *x* ) as_opts=-x ;;
+  * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+as_fn_exit 255
+  fi
+  # We don't want this to propagate to other subprocesses.
+          { _as_can_reexec=; unset _as_can_reexec;}
+if test "x$CONFIG_SHELL" = x; then
+  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '\${1+\"\$@\"}'='\"\$@\"'
+  setopt NO_GLOB_SUBST
+else
+  case \`(set -o) 2>/dev/null\` in #(
+  *posix*) :
+    set -o posix ;; #(
+  *) :
+     ;;
+esac
+fi
+"
+  as_required="as_fn_return () { (exit \$1); }
+as_fn_success () { as_fn_return 0; }
+as_fn_failure () { as_fn_return 1; }
+as_fn_ret_success () { return 0; }
+as_fn_ret_failure () { return 1; }
+
+exitcode=0
+as_fn_success || { exitcode=1; echo as_fn_success failed.; }
+as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }
+as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }
+as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }
+if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :
+
+else
+  exitcode=1; echo positional parameters were not saved.
+fi
+test x\$exitcode = x0 || exit 1
+test -x / || exit 1"
+  as_suggested="  as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
+  as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
+  eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
+  test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1
+
+  test -n \"\${ZSH_VERSION+set}\${BASH_VERSION+set}\" || (
+    ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+    ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO
+    ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO
+    PATH=/empty FPATH=/empty; export PATH FPATH
+    test \"X\`printf %s \$ECHO\`\" = \"X\$ECHO\" \\
+      || test \"X\`print -r -- \$ECHO\`\" = \"X\$ECHO\" ) || exit 1
+test \$(( 1 + 1 )) = 2 || exit 1"
+  if (eval "$as_required") 2>/dev/null; then :
+  as_have_required=yes
+else
+  as_have_required=no
+fi
+  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :
+
+else
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+as_found=false
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  as_found=:
+  case $as_dir in #(
+	 /*)
+	   for as_base in sh bash ksh sh5; do
+	     # Try only shells that exist, to save several forks.
+	     as_shell=$as_dir/$as_base
+	     if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
+		    { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :
+  CONFIG_SHELL=$as_shell as_have_required=yes
+		   if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
+  break 2
+fi
+fi
+	   done;;
+       esac
+  as_found=false
+done
+$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
+	      { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :
+  CONFIG_SHELL=$SHELL as_have_required=yes
+fi; }
+IFS=$as_save_IFS
+
+
+      if test "x$CONFIG_SHELL" != x; then :
+  export CONFIG_SHELL
+             # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+  *v*x* | *x*v* ) as_opts=-vx ;;
+  *v* ) as_opts=-v ;;
+  *x* ) as_opts=-x ;;
+  * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+exit 255
+fi
+
+    if test x$as_have_required = xno; then :
+  $as_echo "$0: This script requires a shell more modern than all"
+  $as_echo "$0: the shells that I found on your system."
+  if test x${ZSH_VERSION+set} = xset ; then
+    $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
+    $as_echo "$0: be upgraded to zsh 4.3.4 or later."
+  else
+    $as_echo "$0: Please tell bug-autoconf@gnu.org and caml-list@inria.fr
+$0: about your system, including any error possibly output
+$0: before this message. Then install a modern shell, or
+$0: manually run the script under such a shell if you do
+$0: have one."
+  fi
+  exit 1
+fi
+fi
+fi
+SHELL=${CONFIG_SHELL-/bin/sh}
+export SHELL
+# Unset more variables known to interfere with behavior of common tools.
+CLICOLOR_FORCE= GREP_OPTIONS=
+unset CLICOLOR_FORCE GREP_OPTIONS
+
+## --------------------- ##
+## M4sh Shell Functions. ##
+## --------------------- ##
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+  { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+  return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+  set +e
+  as_fn_set_status $1
+  exit $1
+} # as_fn_exit
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+  case $as_dir in #(
+  -*) as_dir=./$as_dir;;
+  esac
+  test -d "$as_dir" || eval $as_mkdir_p || {
+    as_dirs=
+    while :; do
+      case $as_dir in #(
+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+      *) as_qdir=$as_dir;;
+      esac
+      as_dirs="'$as_qdir' $as_dirs"
+      as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_dir" : 'X\(//\)[^/]' \| \
+	 X"$as_dir" : 'X\(//\)$' \| \
+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+      test -d "$as_dir" && break
+    done
+    test -z "$as_dirs" || eval "mkdir $as_dirs"
+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+  test -f "$1" && test -x "$1"
+} # as_fn_executable_p
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+  eval 'as_fn_append ()
+  {
+    eval $1+=\$2
+  }'
+else
+  as_fn_append ()
+  {
+    eval $1=\$$1\$2
+  }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+  eval 'as_fn_arith ()
+  {
+    as_val=$(( $* ))
+  }'
+else
+  as_fn_arith ()
+  {
+    as_val=`expr "$@" || test $? -eq 1`
+  }
+fi # as_fn_arith
+
+
+# as_fn_error STATUS ERROR [LINENO LOG_FD]
+# ----------------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with STATUS, using 1 if that was 0.
+as_fn_error ()
+{
+  as_status=$1; test $as_status -eq 0 && as_status=1
+  if test "$4"; then
+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
+  fi
+  $as_echo "$as_me: error: $2" >&2
+  as_fn_exit $as_status
+} # as_fn_error
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+   test "X`expr 00001 : '.*\(...\)'`" = X001; then
+  as_expr=expr
+else
+  as_expr=false
+fi
+
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
+  as_basename=basename
+else
+  as_basename=false
+fi
+
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+  as_dirname=dirname
+else
+  as_dirname=false
+fi
+
+as_me=`$as_basename -- "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+	 X"$0" : 'X\(//\)$' \| \
+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+    sed '/^.*\/\([^/][^/]*\)\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+
+  as_lineno_1=$LINENO as_lineno_1a=$LINENO
+  as_lineno_2=$LINENO as_lineno_2a=$LINENO
+  eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&
+  test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {
+  # Blame Lee E. McMahon (1931-1989) for sed's syntax.  :-)
+  sed -n '
+    p
+    /[$]LINENO/=
+  ' <$as_myself |
+    sed '
+      s/[$]LINENO.*/&-/
+      t lineno
+      b
+      :lineno
+      N
+      :loop
+      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
+      t loop
+      s/-\n.*//
+    ' >$as_me.lineno &&
+  chmod +x "$as_me.lineno" ||
+    { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
+
+  # If we had to re-execute with $CONFIG_SHELL, we're ensured to have
+  # already done that, so ensure we don't try to do so again and fall
+  # in an infinite loop.  This has already happened in practice.
+  _as_can_reexec=no; export _as_can_reexec
+  # Don't try to exec as it changes $[0], causing all sort of problems
+  # (the dirname of $[0] is not the place where we might find the
+  # original and so on.  Autoconf is especially sensitive to this).
+  . "./$as_me.lineno"
+  # Exit status is that of the last command.
+  exit
+}
+
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+  case `echo 'xy\c'` in
+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
+  xy)  ECHO_C='\c';;
+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
+       ECHO_T='	';;
+  esac;;
+*)
+  ECHO_N='-n';;
+esac
+
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+  rm -f conf$$.dir/conf$$.file
+else
+  rm -f conf$$.dir
+  mkdir conf$$.dir 2>/dev/null
+fi
+if (echo >conf$$.file) 2>/dev/null; then
+  if ln -s conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s='ln -s'
+    # ... but there are two gotchas:
+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+    # In both cases, we have to default to `cp -pR'.
+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+      as_ln_s='cp -pR'
+  elif ln conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s=ln
+  else
+    as_ln_s='cp -pR'
+  fi
+else
+  as_ln_s='cp -pR'
+fi
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
+
+if mkdir -p . 2>/dev/null; then
+  as_mkdir_p='mkdir -p "$as_dir"'
+else
+  test -d ./-p && rmdir ./-p
+  as_mkdir_p=false
+fi
+
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+SHELL=${CONFIG_SHELL-/bin/sh}
+
+
+test -n "$DJDIR" || exec 7<&0 &1
+
+# Name of the host.
+# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,
+# so uname gets run too.
+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
+
+#
+# Initializations.
+#
+ac_default_prefix=/usr/local
+ac_clean_files=
+ac_config_libobj_dir=.
+LIBOBJS=
+cross_compiling=no
+subdirs=
+MFLAGS=
+MAKEFLAGS=
+
+# Identity of this package.
+PACKAGE_NAME='OCaml'
+PACKAGE_TARNAME='ocaml'
+PACKAGE_VERSION='4.11.1'
+PACKAGE_STRING='OCaml 4.11.1'
+PACKAGE_BUGREPORT='caml-list@inria.fr'
+PACKAGE_URL='http://www.ocaml.org'
+
+ac_unique_file="runtime/interp.c"
+# Factoring default headers for most tests.
+ac_includes_default="\
+#include 
+#ifdef HAVE_SYS_TYPES_H
+# include 
+#endif
+#ifdef HAVE_SYS_STAT_H
+# include 
+#endif
+#ifdef STDC_HEADERS
+# include 
+# include 
+#else
+# ifdef HAVE_STDLIB_H
+#  include 
+# endif
+#endif
+#ifdef HAVE_STRING_H
+# if !defined STDC_HEADERS && defined HAVE_MEMORY_H
+#  include 
+# endif
+# include 
+#endif
+#ifdef HAVE_STRINGS_H
+# include 
+#endif
+#ifdef HAVE_INTTYPES_H
+# include 
+#endif
+#ifdef HAVE_STDINT_H
+# include 
+#endif
+#ifdef HAVE_UNISTD_H
+# include 
+#endif"
+
+ac_subst_vars='LTLIBOBJS
+LIBOBJS
+PTHREAD_CFLAGS
+PTHREAD_LIBS
+PTHREAD_CC
+ax_pthread_config
+DIRECT_LD
+INSTALL_DATA
+INSTALL_SCRIPT
+INSTALL_PROGRAM
+CPP
+LT_SYS_LIBRARY_PATH
+OTOOL64
+OTOOL
+LIPO
+NMEDIT
+DSYMUTIL
+MANIFEST_TOOL
+AWK
+STRIP
+ac_ct_AR
+DLLTOOL
+OBJDUMP
+LN_S
+NM
+ac_ct_DUMPBIN
+DUMPBIN
+FGREP
+EGREP
+GREP
+SED
+EXEEXT
+ac_ct_CC
+CPPFLAGS
+LDFLAGS
+CFLAGS
+LIBTOOL
+ac_ct_LD
+LD
+DEFAULT_STRING
+WINDOWS_UNICODE_MODE
+BFD_LIB_DIR
+BFD_INCLUDE_DIR
+LIBUNWIND_LIB_DIR
+LIBUNWIND_INCLUDE_DIR
+DLLIBS
+PARTIALLD
+target_os
+target_vendor
+target_cpu
+target
+host_os
+host_vendor
+host_cpu
+host
+build_os
+build_vendor
+build_cpu
+build
+stdlib_manpages
+PACKLD
+flexlink_flags
+flexdll_chain
+default_safe_string
+force_safe_string
+afl
+function_sections
+flat_float_array
+windows_unicode
+max_testsuite_dir_retries
+flambda_invariants
+flambda
+libunwind_link_flags
+libunwind_include_flags
+libunwind_available
+call_counts
+spacetime
+frame_pointers
+profinfo_width
+profinfo
+install_source_artifacts
+install_bytecode_programs
+mksharedlibrpath
+mkmaindll
+mksharedlib
+rpath
+sharedlib_cflags
+asm_cfi_supported
+AS
+endianness
+ASPP
+bfd_ldlibs
+bfd_ldflags
+bfd_cppflags
+x_libraries
+x_includes
+pthread_link
+ocamltest
+ocamldoc
+with_camltex
+with_debugger
+as_has_debug_prefix_map
+cc_has_debug_prefix_map
+otherlibraries
+has_monotonic_clock
+instrumented_runtime
+debug_runtime
+cmxs
+natdynlinkopts
+natdynlink
+supports_shared_libraries
+mklib
+RANLIBCMD
+RANLIB
+AR
+shebangscripts
+long_shebang
+iflexdir
+ocamlc_cppflags
+ocamlc_cflags
+nativecclibs
+bytecclibs
+oc_ldflags
+oc_cppflags
+oc_cflags
+toolchain
+ccomptype
+mkexedebugflag
+mkexe
+fpic
+libraries_man_section
+programs_man_section
+extralibs
+syslib
+outputobj
+outputexe
+unixlib
+unix_or_win32
+systhread_support
+system
+model
+arch64
+arch
+SO
+S
+libext
+OBJEXT
+exeext
+ac_tool_prefix
+DIRECT_CPP
+CC
+VERSION
+native_compiler
+CONFIGURE_ARGS
+target_alias
+host_alias
+build_alias
+LIBS
+ECHO_T
+ECHO_N
+ECHO_C
+DEFS
+mandir
+localedir
+libdir
+psdir
+pdfdir
+dvidir
+htmldir
+infodir
+docdir
+oldincludedir
+includedir
+localstatedir
+sharedstatedir
+sysconfdir
+datadir
+datarootdir
+libexecdir
+sbindir
+bindir
+program_transform_name
+prefix
+exec_prefix
+PACKAGE_URL
+PACKAGE_BUGREPORT
+PACKAGE_STRING
+PACKAGE_VERSION
+PACKAGE_TARNAME
+PACKAGE_NAME
+PATH_SEPARATOR
+SHELL'
+ac_subst_files=''
+ac_user_opts='
+enable_option_checking
+enable_debug_runtime
+enable_debugger
+enable_instrumented_runtime
+enable_vmthreads
+enable_systhreads
+with_libunwind
+with_bfd
+enable_graph_lib
+enable_str_lib
+enable_unix_lib
+enable_bigarray_lib
+enable_ocamldoc
+enable_ocamltest
+enable_frame_pointers
+enable_naked_pointers
+enable_spacetime
+enable_call_counts
+enable_cfi
+enable_installing_source_artifacts
+enable_installing_bytecode_programs
+enable_native_compiler
+enable_flambda
+enable_flambda_invariants
+with_target_bindir
+enable_reserved_header_bits
+enable_stdlib_manpages
+enable_force_safe_string
+enable_flat_float_array
+enable_function_sections
+with_afl
+enable_shared
+enable_static
+with_pic
+enable_fast_install
+with_aix_soname
+with_gnu_ld
+with_sysroot
+enable_libtool_lock
+'
+      ac_precious_vars='build_alias
+host_alias
+target_alias
+AS
+ASPP
+PARTIALLD
+DLLIBS
+LIBUNWIND_INCLUDE_DIR
+LIBUNWIND_LIB_DIR
+BFD_INCLUDE_DIR
+BFD_LIB_DIR
+WINDOWS_UNICODE_MODE
+DEFAULT_STRING
+CC
+CFLAGS
+LDFLAGS
+LIBS
+CPPFLAGS
+LT_SYS_LIBRARY_PATH
+CPP'
+
+
+# Initialize some variables set by options.
+ac_init_help=
+ac_init_version=false
+ac_unrecognized_opts=
+ac_unrecognized_sep=
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+cache_file=/dev/null
+exec_prefix=NONE
+no_create=
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+verbose=
+x_includes=NONE
+x_libraries=NONE
+
+# Installation directory options.
+# These are left unexpanded so users can "make install exec_prefix=/foo"
+# and all the variables that are supposed to be based on exec_prefix
+# by default will actually change.
+# Use braces instead of parens because sh, perl, etc. also accept them.
+# (The list follows the same order as the GNU Coding Standards.)
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datarootdir='${prefix}/share'
+datadir='${datarootdir}'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
+infodir='${datarootdir}/info'
+htmldir='${docdir}'
+dvidir='${docdir}'
+pdfdir='${docdir}'
+psdir='${docdir}'
+libdir='${exec_prefix}/lib'
+localedir='${datarootdir}/locale'
+mandir='${datarootdir}/man'
+
+ac_prev=
+ac_dashdash=
+for ac_option
+do
+  # If the previous option needs an argument, assign it.
+  if test -n "$ac_prev"; then
+    eval $ac_prev=\$ac_option
+    ac_prev=
+    continue
+  fi
+
+  case $ac_option in
+  *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
+  *=)   ac_optarg= ;;
+  *)    ac_optarg=yes ;;
+  esac
+
+  # Accept the important Cygnus configure options, so we can diagnose typos.
+
+  case $ac_dashdash$ac_option in
+  --)
+    ac_dashdash=yes ;;
+
+  -bindir | --bindir | --bindi | --bind | --bin | --bi)
+    ac_prev=bindir ;;
+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+    bindir=$ac_optarg ;;
+
+  -build | --build | --buil | --bui | --bu)
+    ac_prev=build_alias ;;
+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+    build_alias=$ac_optarg ;;
+
+  -cache-file | --cache-file | --cache-fil | --cache-fi \
+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+    ac_prev=cache_file ;;
+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+    cache_file=$ac_optarg ;;
+
+  --config-cache | -C)
+    cache_file=config.cache ;;
+
+  -datadir | --datadir | --datadi | --datad)
+    ac_prev=datadir ;;
+  -datadir=* | --datadir=* | --datadi=* | --datad=*)
+    datadir=$ac_optarg ;;
+
+  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
+  | --dataroo | --dataro | --datar)
+    ac_prev=datarootdir ;;
+  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
+  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
+    datarootdir=$ac_optarg ;;
+
+  -disable-* | --disable-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error $? "invalid feature name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"enable_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval enable_$ac_useropt=no ;;
+
+  -docdir | --docdir | --docdi | --doc | --do)
+    ac_prev=docdir ;;
+  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
+    docdir=$ac_optarg ;;
+
+  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
+    ac_prev=dvidir ;;
+  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
+    dvidir=$ac_optarg ;;
+
+  -enable-* | --enable-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error $? "invalid feature name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"enable_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval enable_$ac_useropt=\$ac_optarg ;;
+
+  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+  | --exec | --exe | --ex)
+    ac_prev=exec_prefix ;;
+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+  | --exec=* | --exe=* | --ex=*)
+    exec_prefix=$ac_optarg ;;
+
+  -gas | --gas | --ga | --g)
+    # Obsolete; use --with-gas.
+    with_gas=yes ;;
+
+  -help | --help | --hel | --he | -h)
+    ac_init_help=long ;;
+  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
+    ac_init_help=recursive ;;
+  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
+    ac_init_help=short ;;
+
+  -host | --host | --hos | --ho)
+    ac_prev=host_alias ;;
+  -host=* | --host=* | --hos=* | --ho=*)
+    host_alias=$ac_optarg ;;
+
+  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
+    ac_prev=htmldir ;;
+  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
+  | --ht=*)
+    htmldir=$ac_optarg ;;
+
+  -includedir | --includedir | --includedi | --included | --include \
+  | --includ | --inclu | --incl | --inc)
+    ac_prev=includedir ;;
+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+  | --includ=* | --inclu=* | --incl=* | --inc=*)
+    includedir=$ac_optarg ;;
+
+  -infodir | --infodir | --infodi | --infod | --info | --inf)
+    ac_prev=infodir ;;
+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+    infodir=$ac_optarg ;;
+
+  -libdir | --libdir | --libdi | --libd)
+    ac_prev=libdir ;;
+  -libdir=* | --libdir=* | --libdi=* | --libd=*)
+    libdir=$ac_optarg ;;
+
+  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+  | --libexe | --libex | --libe)
+    ac_prev=libexecdir ;;
+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+  | --libexe=* | --libex=* | --libe=*)
+    libexecdir=$ac_optarg ;;
+
+  -localedir | --localedir | --localedi | --localed | --locale)
+    ac_prev=localedir ;;
+  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
+    localedir=$ac_optarg ;;
+
+  -localstatedir | --localstatedir | --localstatedi | --localstated \
+  | --localstate | --localstat | --localsta | --localst | --locals)
+    ac_prev=localstatedir ;;
+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
+    localstatedir=$ac_optarg ;;
+
+  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+    ac_prev=mandir ;;
+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+    mandir=$ac_optarg ;;
+
+  -nfp | --nfp | --nf)
+    # Obsolete; use --without-fp.
+    with_fp=no ;;
+
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c | -n)
+    no_create=yes ;;
+
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+    no_recursion=yes ;;
+
+  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+  | --oldin | --oldi | --old | --ol | --o)
+    ac_prev=oldincludedir ;;
+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+    oldincludedir=$ac_optarg ;;
+
+  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+    ac_prev=prefix ;;
+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+    prefix=$ac_optarg ;;
+
+  -program-prefix | --program-prefix | --program-prefi | --program-pref \
+  | --program-pre | --program-pr | --program-p)
+    ac_prev=program_prefix ;;
+  -program-prefix=* | --program-prefix=* | --program-prefi=* \
+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+    program_prefix=$ac_optarg ;;
+
+  -program-suffix | --program-suffix | --program-suffi | --program-suff \
+  | --program-suf | --program-su | --program-s)
+    ac_prev=program_suffix ;;
+  -program-suffix=* | --program-suffix=* | --program-suffi=* \
+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+    program_suffix=$ac_optarg ;;
+
+  -program-transform-name | --program-transform-name \
+  | --program-transform-nam | --program-transform-na \
+  | --program-transform-n | --program-transform- \
+  | --program-transform | --program-transfor \
+  | --program-transfo | --program-transf \
+  | --program-trans | --program-tran \
+  | --progr-tra | --program-tr | --program-t)
+    ac_prev=program_transform_name ;;
+  -program-transform-name=* | --program-transform-name=* \
+  | --program-transform-nam=* | --program-transform-na=* \
+  | --program-transform-n=* | --program-transform-=* \
+  | --program-transform=* | --program-transfor=* \
+  | --program-transfo=* | --program-transf=* \
+  | --program-trans=* | --program-tran=* \
+  | --progr-tra=* | --program-tr=* | --program-t=*)
+    program_transform_name=$ac_optarg ;;
+
+  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
+    ac_prev=pdfdir ;;
+  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
+    pdfdir=$ac_optarg ;;
+
+  -psdir | --psdir | --psdi | --psd | --ps)
+    ac_prev=psdir ;;
+  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
+    psdir=$ac_optarg ;;
+
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil)
+    silent=yes ;;
+
+  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+    ac_prev=sbindir ;;
+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+  | --sbi=* | --sb=*)
+    sbindir=$ac_optarg ;;
+
+  -sharedstatedir | --sharedstatedir | --sharedstatedi \
+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+  | --sharedst | --shareds | --shared | --share | --shar \
+  | --sha | --sh)
+    ac_prev=sharedstatedir ;;
+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+  | --sha=* | --sh=*)
+    sharedstatedir=$ac_optarg ;;
+
+  -site | --site | --sit)
+    ac_prev=site ;;
+  -site=* | --site=* | --sit=*)
+    site=$ac_optarg ;;
+
+  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+    ac_prev=srcdir ;;
+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+    srcdir=$ac_optarg ;;
+
+  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+  | --syscon | --sysco | --sysc | --sys | --sy)
+    ac_prev=sysconfdir ;;
+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+    sysconfdir=$ac_optarg ;;
+
+  -target | --target | --targe | --targ | --tar | --ta | --t)
+    ac_prev=target_alias ;;
+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+    target_alias=$ac_optarg ;;
+
+  -v | -verbose | --verbose | --verbos | --verbo | --verb)
+    verbose=yes ;;
+
+  -version | --version | --versio | --versi | --vers | -V)
+    ac_init_version=: ;;
+
+  -with-* | --with-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error $? "invalid package name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"with_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval with_$ac_useropt=\$ac_optarg ;;
+
+  -without-* | --without-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error $? "invalid package name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"with_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval with_$ac_useropt=no ;;
+
+  --x)
+    # Obsolete; use --with-x.
+    with_x=yes ;;
+
+  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+  | --x-incl | --x-inc | --x-in | --x-i)
+    ac_prev=x_includes ;;
+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+    x_includes=$ac_optarg ;;
+
+  -x-libraries | --x-libraries | --x-librarie | --x-librari \
+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+    ac_prev=x_libraries ;;
+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+    x_libraries=$ac_optarg ;;
+
+  -*) as_fn_error $? "unrecognized option: \`$ac_option'
+Try \`$0 --help' for more information"
+    ;;
+
+  *=*)
+    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
+    # Reject names that are not valid shell variable names.
+    case $ac_envvar in #(
+      '' | [0-9]* | *[!_$as_cr_alnum]* )
+      as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;
+    esac
+    eval $ac_envvar=\$ac_optarg
+    export $ac_envvar ;;
+
+  *)
+    # FIXME: should be removed in autoconf 3.0.
+    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+      $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+    : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"
+    ;;
+
+  esac
+done
+
+if test -n "$ac_prev"; then
+  ac_option=--`echo $ac_prev | sed 's/_/-/g'`
+  as_fn_error $? "missing argument to $ac_option"
+fi
+
+if test -n "$ac_unrecognized_opts"; then
+  case $enable_option_checking in
+    no) ;;
+    fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;
+    *)     $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
+  esac
+fi
+
+# Check all directory arguments for consistency.
+for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \
+		datadir sysconfdir sharedstatedir localstatedir includedir \
+		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
+		libdir localedir mandir
+do
+  eval ac_val=\$$ac_var
+  # Remove trailing slashes.
+  case $ac_val in
+    */ )
+      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
+      eval $ac_var=\$ac_val;;
+  esac
+  # Be sure to have absolute directory names.
+  case $ac_val in
+    [\\/$]* | ?:[\\/]* )  continue;;
+    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
+  esac
+  as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"
+done
+
+# There might be people who depend on the old broken behavior: `$host'
+# used to hold the argument of --host etc.
+# FIXME: To remove some day.
+build=$build_alias
+host=$host_alias
+target=$target_alias
+
+# FIXME: To remove some day.
+if test "x$host_alias" != x; then
+  if test "x$build_alias" = x; then
+    cross_compiling=maybe
+  elif test "x$build_alias" != "x$host_alias"; then
+    cross_compiling=yes
+  fi
+fi
+
+ac_tool_prefix=
+test -n "$host_alias" && ac_tool_prefix=$host_alias-
+
+test "$silent" = yes && exec 6>/dev/null
+
+
+ac_pwd=`pwd` && test -n "$ac_pwd" &&
+ac_ls_di=`ls -di .` &&
+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
+  as_fn_error $? "working directory cannot be determined"
+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
+  as_fn_error $? "pwd does not report name of working directory"
+
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+  ac_srcdir_defaulted=yes
+  # Try the directory containing this script, then the parent directory.
+  ac_confdir=`$as_dirname -- "$as_myself" ||
+$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_myself" : 'X\(//\)[^/]' \| \
+	 X"$as_myself" : 'X\(//\)$' \| \
+	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_myself" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+  srcdir=$ac_confdir
+  if test ! -r "$srcdir/$ac_unique_file"; then
+    srcdir=..
+  fi
+else
+  ac_srcdir_defaulted=no
+fi
+if test ! -r "$srcdir/$ac_unique_file"; then
+  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
+  as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"
+fi
+ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
+ac_abs_confdir=`(
+	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"
+	pwd)`
+# When building in place, set srcdir=.
+if test "$ac_abs_confdir" = "$ac_pwd"; then
+  srcdir=.
+fi
+# Remove unnecessary trailing slashes from srcdir.
+# Double slashes in file names in object file debugging info
+# mess up M-x gdb in Emacs.
+case $srcdir in
+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
+esac
+for ac_var in $ac_precious_vars; do
+  eval ac_env_${ac_var}_set=\${${ac_var}+set}
+  eval ac_env_${ac_var}_value=\$${ac_var}
+  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
+  eval ac_cv_env_${ac_var}_value=\$${ac_var}
+done
+
+#
+# Report the --help message.
+#
+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 4.11.1 to adapt to many kinds of systems.
+
+Usage: $0 [OPTION]... [VAR=VALUE]...
+
+To assign environment variables (e.g., CC, CFLAGS...), specify them as
+VAR=VALUE.  See below for descriptions of some of the useful variables.
+
+Defaults for the options are specified in brackets.
+
+Configuration:
+  -h, --help              display this help and exit
+      --help=short        display options specific to this package
+      --help=recursive    display the short help of all the included packages
+  -V, --version           display version information and exit
+  -q, --quiet, --silent   do not print \`checking ...' messages
+      --cache-file=FILE   cache test results in FILE [disabled]
+  -C, --config-cache      alias for \`--cache-file=config.cache'
+  -n, --no-create         do not create output files
+      --srcdir=DIR        find the sources in DIR [configure dir or \`..']
+
+Installation directories:
+  --prefix=PREFIX         install architecture-independent files in PREFIX
+                          [$ac_default_prefix]
+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
+                          [PREFIX]
+
+By default, \`make install' will install all the files in
+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify
+an installation prefix other than \`$ac_default_prefix' using \`--prefix',
+for instance \`--prefix=\$HOME'.
+
+For better control, use the options below.
+
+Fine tuning of the installation directories:
+  --bindir=DIR            user executables [EPREFIX/bin]
+  --sbindir=DIR           system admin executables [EPREFIX/sbin]
+  --libexecdir=DIR        program executables [EPREFIX/libexec]
+  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]
+  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]
+  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]
+  --libdir=DIR            object code libraries [EPREFIX/lib]
+  --includedir=DIR        C header files [PREFIX/include]
+  --oldincludedir=DIR     C header files for non-gcc [/usr/include]
+  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]
+  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]
+  --infodir=DIR           info documentation [DATAROOTDIR/info]
+  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]
+  --mandir=DIR            man documentation [DATAROOTDIR/man]
+  --docdir=DIR            documentation root [DATAROOTDIR/doc/ocaml]
+  --htmldir=DIR           html documentation [DOCDIR]
+  --dvidir=DIR            dvi documentation [DOCDIR]
+  --pdfdir=DIR            pdf documentation [DOCDIR]
+  --psdir=DIR             ps documentation [DOCDIR]
+_ACEOF
+
+  cat <<\_ACEOF
+
+System types:
+  --build=BUILD     configure for building on BUILD [guessed]
+  --host=HOST       cross-compile to build programs to run on HOST [BUILD]
+  --target=TARGET   configure for building compilers for TARGET [HOST]
+_ACEOF
+fi
+
+if test -n "$ac_init_help"; then
+  case $ac_init_help in
+     short | recursive ) echo "Configuration of OCaml 4.11.1:";;
+   esac
+  cat <<\_ACEOF
+
+Optional Features:
+  --disable-option-checking  ignore unrecognized --enable/--with options
+  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
+  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
+  --disable-debug-runtime do not build runtime with debugging support
+  --enable-debugger       build the debugger [default=auto]
+  --enable-instrumented-runtime
+                          build the instrumented runtime [default=auto]
+
+  --disable-systhreads    disable the Win32/POSIX threads library
+  --disable-str-lib       do not build the str library
+  --disable-unix-lib      do not build the unix library
+  --disable-bigarray-lib  do not build the legacy separate bigarray library
+  --disable-ocamldoc      do not build the ocamldoc documentation system
+  --disable-ocamltest     do not build the ocamltest driver
+  --enable-frame-pointers use frame pointers in runtime and generated code
+  --disable-naked-pointers
+                          do not allow naked pointers
+  --enable-spacetime      build the spacetime profiler
+  --disable-call-counts   disable the call counts in spacetime
+  --disable-cfi           disable the CFI directives in assembly files
+  --enable-installing-source-artifacts
+                          install *.cmt* and *.mli files
+  --enable-installing-bytecode-programs
+                          also install the bytecode versions of programs
+  --disable-native-compiler
+                          do not build the native compiler
+  --enable-flambda        enable flambda optimizations
+  --enable-flambda-invariants
+                          enable invariants checks in flambda
+  --enable-reserved-header-bits=BITS
+                          reserve BITS (between 0 and 31) bits in block
+                          headers for profiling info
+  --disable-stdlib-manpages
+                          do not build or install the library man pages
+  --disable-force-safe-string
+                          do not force strings to be safe
+  --disable-flat-float-array
+                          do not use flat float arrays
+  --disable-function-sections
+                          do not emit each function in a separate section
+  --enable-shared[=PKGS]  build shared libraries [default=yes]
+  --enable-static[=PKGS]  build static libraries [default=yes]
+  --enable-fast-install[=PKGS]
+                          optimize for fast installation [default=yes]
+  --disable-libtool-lock  avoid locking (might break parallel builds)
+
+Optional Packages:
+  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
+  --without-libunwind     disable libunwind support for Spacetime profiling
+  --without-bfd           disable BFD (Binary File Description) library
+                          support
+  --with-target-bindir    location of binary programs on target system
+  --with-afl              use the AFL fuzzer
+  --with-pic[=PKGS]       try to use only PIC/non-PIC objects [default=use
+                          both]
+  --with-aix-soname=aix|svr4|both
+                          shared library versioning (aka "SONAME") variant to
+                          provide on AIX, [default=aix].
+  --with-gnu-ld           assume the C compiler uses GNU ld [default=no]
+  --with-sysroot[=DIR]    Search for dependent libraries within DIR (or the
+                          compiler's sysroot if not specified).
+
+Some influential environment variables:
+  AS          which assembler to use
+  ASPP        which assembler (with preprocessor) to use
+  PARTIALLD   how to build partial (relocatable) object files
+  DLLIBS      which libraries to use (in addition to -ldl) to load dynamic
+              libs
+  LIBUNWIND_INCLUDE_DIR
+              location of header files for libunwind
+  LIBUNWIND_LIB_DIR
+              location of library files for libunwind
+  BFD_INCLUDE_DIR
+              location of header files for the BFD library
+  BFD_LIB_DIR location of library files for the BFD library
+  WINDOWS_UNICODE_MODE
+              how to handle Unicode under Windows: ansi, compatible
+  DEFAULT_STRING
+              whether strings should be safe (default) or unsafe
+  CC          C compiler command
+  CFLAGS      C compiler flags
+  LDFLAGS     linker flags, e.g. -L if you have libraries in a
+              nonstandard directory 
+  LIBS        libraries to pass to the linker, e.g. -l
+  CPPFLAGS    (Objective) C/C++ preprocessor flags, e.g. -I if
+              you have headers in a nonstandard directory 
+  LT_SYS_LIBRARY_PATH
+              User-defined run-time library search path.
+  CPP         C preprocessor
+
+Use these variables to override the choices made by `configure' or to help
+it to find libraries and programs with nonstandard names/locations.
+
+Report bugs to .
+OCaml home page: .
+_ACEOF
+ac_status=$?
+fi
+
+if test "$ac_init_help" = "recursive"; then
+  # If there are subdirs, report their specific --help.
+  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
+    test -d "$ac_dir" ||
+      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||
+      continue
+    ac_builddir=.
+
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+  # A ".." for each directory in $ac_dir_suffix.
+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+  case $ac_top_builddir_sub in
+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+  esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
+
+case $srcdir in
+  .)  # We are building in place.
+    ac_srcdir=.
+    ac_top_srcdir=$ac_top_builddir_sub
+    ac_abs_top_srcdir=$ac_pwd ;;
+  [\\/]* | ?:[\\/]* )  # Absolute name.
+    ac_srcdir=$srcdir$ac_dir_suffix;
+    ac_top_srcdir=$srcdir
+    ac_abs_top_srcdir=$srcdir ;;
+  *) # Relative name.
+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+    ac_top_srcdir=$ac_top_build_prefix$srcdir
+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
+esac
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+    cd "$ac_dir" || { ac_status=$?; continue; }
+    # Check for guested configure.
+    if test -f "$ac_srcdir/configure.gnu"; then
+      echo &&
+      $SHELL "$ac_srcdir/configure.gnu" --help=recursive
+    elif test -f "$ac_srcdir/configure"; then
+      echo &&
+      $SHELL "$ac_srcdir/configure" --help=recursive
+    else
+      $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+    fi || ac_status=$?
+    cd "$ac_pwd" || { ac_status=$?; break; }
+  done
+fi
+
+test -n "$ac_init_help" && exit $ac_status
+if $ac_init_version; then
+  cat <<\_ACEOF
+OCaml configure 4.11.1
+generated by GNU Autoconf 2.69
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+This configure script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it.
+_ACEOF
+  exit
+fi
+
+## ------------------------ ##
+## Autoconf initialization. ##
+## ------------------------ ##
+
+# ac_fn_c_try_compile LINENO
+# --------------------------
+# Try to compile conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_compile ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  rm -f conftest.$ac_objext
+  if { { ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compile") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_retval=1
+fi
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_compile
+
+# ac_fn_c_try_link LINENO
+# -----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_link ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  rm -f conftest.$ac_objext conftest$ac_exeext
+  if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest$ac_exeext && {
+	 test "$cross_compiling" = yes ||
+	 test -x conftest$ac_exeext
+       }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_retval=1
+fi
+  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
+  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
+  # interfere with the next link command; also delete a directory that is
+  # left behind by Apple's compiler.  We do this before executing the actions.
+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_link
+
+# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES
+# -------------------------------------------------------
+# Tests whether HEADER exists and can be compiled using the include files in
+# INCLUDES, setting the cache variable VAR accordingly.
+ac_fn_c_check_header_compile ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+#include <$2>
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  eval "$3=yes"
+else
+  eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_header_compile
+
+# ac_fn_c_try_cpp LINENO
+# ----------------------
+# Try to preprocess conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_cpp ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if { { ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } > conftest.i && {
+	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+    ac_retval=1
+fi
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_cpp
+
+# ac_fn_c_try_run LINENO
+# ----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes
+# that executables *can* be run.
+ac_fn_c_try_run ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && { ac_try='./conftest$ac_exeext'
+  { { case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_try") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: program exited with status $ac_status" >&5
+       $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+       ac_retval=$ac_status
+fi
+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_run
+
+# ac_fn_c_check_func LINENO FUNC VAR
+# ----------------------------------
+# Tests whether FUNC exists, setting the cache variable VAR accordingly
+ac_fn_c_check_func ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+/* Define $2 to an innocuous variant, in case  declares $2.
+   For example, HP-UX 11i  declares gettimeofday.  */
+#define $2 innocuous_$2
+
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $2 (); below.
+    Prefer  to  if __STDC__ is defined, since
+     exists even on freestanding compilers.  */
+
+#ifdef __STDC__
+# include 
+#else
+# include 
+#endif
+
+#undef $2
+
+/* 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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char $2 ();
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined __stub_$2 || defined __stub___$2
+choke me
+#endif
+
+int
+main ()
+{
+return $2 ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  eval "$3=yes"
+else
+  eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_func
+
+# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES
+# -------------------------------------------------------
+# Tests whether HEADER exists, giving a warning if it cannot be compiled using
+# the include files in INCLUDES and setting the cache variable VAR
+# accordingly.
+ac_fn_c_check_header_mongrel ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if eval \${$3+:} false; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+  $as_echo_n "(cached) " >&6
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+else
+  # Is the header compilable?
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5
+$as_echo_n "checking $2 usability... " >&6; }
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+#include <$2>
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_header_compiler=yes
+else
+  ac_header_compiler=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5
+$as_echo "$ac_header_compiler" >&6; }
+
+# Is the header present?
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5
+$as_echo_n "checking $2 presence... " >&6; }
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <$2>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+  ac_header_preproc=yes
+else
+  ac_header_preproc=no
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5
+$as_echo "$ac_header_preproc" >&6; }
+
+# So?  What about this header?
+case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #((
+  yes:no: )
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5
+$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
+$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
+    ;;
+  no:yes:* )
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5
+$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     check for missing prerequisite headers?" >&5
+$as_echo "$as_me: WARNING: $2:     check for missing prerequisite headers?" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5
+$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&5
+$as_echo "$as_me: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
+$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
+( $as_echo "## --------------------------------- ##
+## Report this to caml-list@inria.fr ##
+## --------------------------------- ##"
+     ) | sed "s/^/$as_me: WARNING:     /" >&2
+    ;;
+esac
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  eval "$3=\$ac_header_compiler"
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+fi
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_header_mongrel
+
+# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
+# -------------------------------------------
+# Tests whether TYPE exists after having included INCLUDES, setting cache
+# variable VAR accordingly.
+ac_fn_c_check_type ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  eval "$3=no"
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+int
+main ()
+{
+if (sizeof ($2))
+	 return 0;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+int
+main ()
+{
+if (sizeof (($2)))
+	    return 0;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+else
+  eval "$3=yes"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_type
+
+# ac_fn_c_compute_int LINENO EXPR VAR INCLUDES
+# --------------------------------------------
+# Tries to find the compile-time value of EXPR in a program that includes
+# INCLUDES, setting VAR accordingly. Returns whether the value could be
+# computed
+ac_fn_c_compute_int ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if test "$cross_compiling" = yes; then
+    # Depending upon the size, compute the lo and hi bounds.
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+int
+main ()
+{
+static int test_array [1 - 2 * !(($2) >= 0)];
+test_array [0] = 0;
+return test_array [0];
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_lo=0 ac_mid=0
+  while :; do
+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+int
+main ()
+{
+static int test_array [1 - 2 * !(($2) <= $ac_mid)];
+test_array [0] = 0;
+return test_array [0];
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_hi=$ac_mid; break
+else
+  as_fn_arith $ac_mid + 1 && ac_lo=$as_val
+			if test $ac_lo -le $ac_mid; then
+			  ac_lo= ac_hi=
+			  break
+			fi
+			as_fn_arith 2 '*' $ac_mid + 1 && ac_mid=$as_val
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+  done
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+int
+main ()
+{
+static int test_array [1 - 2 * !(($2) < 0)];
+test_array [0] = 0;
+return test_array [0];
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_hi=-1 ac_mid=-1
+  while :; do
+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+int
+main ()
+{
+static int test_array [1 - 2 * !(($2) >= $ac_mid)];
+test_array [0] = 0;
+return test_array [0];
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_lo=$ac_mid; break
+else
+  as_fn_arith '(' $ac_mid ')' - 1 && ac_hi=$as_val
+			if test $ac_mid -le $ac_hi; then
+			  ac_lo= ac_hi=
+			  break
+			fi
+			as_fn_arith 2 '*' $ac_mid && ac_mid=$as_val
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+  done
+else
+  ac_lo= ac_hi=
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+# Binary search between lo and hi bounds.
+while test "x$ac_lo" != "x$ac_hi"; do
+  as_fn_arith '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo && ac_mid=$as_val
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+int
+main ()
+{
+static int test_array [1 - 2 * !(($2) <= $ac_mid)];
+test_array [0] = 0;
+return test_array [0];
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_hi=$ac_mid
+else
+  as_fn_arith '(' $ac_mid ')' + 1 && ac_lo=$as_val
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+done
+case $ac_lo in #((
+?*) eval "$3=\$ac_lo"; ac_retval=0 ;;
+'') ac_retval=1 ;;
+esac
+  else
+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+static long int longval () { return $2; }
+static unsigned long int ulongval () { return $2; }
+#include 
+#include 
+int
+main ()
+{
+
+  FILE *f = fopen ("conftest.val", "w");
+  if (! f)
+    return 1;
+  if (($2) < 0)
+    {
+      long int i = longval ();
+      if (i != ($2))
+	return 1;
+      fprintf (f, "%ld", i);
+    }
+  else
+    {
+      unsigned long int i = ulongval ();
+      if (i != ($2))
+	return 1;
+      fprintf (f, "%lu", i);
+    }
+  /* Do not output a trailing newline, as this causes \r\n confusion
+     on some platforms.  */
+  return ferror (f) || fclose (f) != 0;
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+  echo >>conftest.val; read $3 &5
+$as_echo_n "checking for $2.$3... " >&6; }
+if eval \${$4+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$5
+int
+main ()
+{
+static $2 ac_aggr;
+if (ac_aggr.$3)
+return 0;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  eval "$4=yes"
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$5
+int
+main ()
+{
+static $2 ac_aggr;
+if (sizeof ac_aggr.$3)
+return 0;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  eval "$4=yes"
+else
+  eval "$4=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$4
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_member
+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 4.11.1, which was
+generated by GNU Autoconf 2.69.  Invocation command line was
+
+  $ $0 $@
+
+_ACEOF
+exec 5>>config.log
+{
+cat <<_ASUNAME
+## --------- ##
+## Platform. ##
+## --------- ##
+
+hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`
+
+/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`
+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
+/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`
+/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`
+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`
+/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`
+
+_ASUNAME
+
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    $as_echo "PATH: $as_dir"
+  done
+IFS=$as_save_IFS
+
+} >&5
+
+cat >&5 <<_ACEOF
+
+
+## ----------- ##
+## Core tests. ##
+## ----------- ##
+
+_ACEOF
+
+
+# Keep a trace of the command line.
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Strip out --silent because we don't want to record it for future runs.
+# Also quote any args containing shell meta-characters.
+# Make two passes to allow for proper duplicate-argument suppression.
+ac_configure_args=
+ac_configure_args0=
+ac_configure_args1=
+ac_must_keep_next=false
+for ac_pass in 1 2
+do
+  for ac_arg
+  do
+    case $ac_arg in
+    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
+    -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+    | -silent | --silent | --silen | --sile | --sil)
+      continue ;;
+    *\'*)
+      ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+    esac
+    case $ac_pass in
+    1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;
+    2)
+      as_fn_append ac_configure_args1 " '$ac_arg'"
+      if test $ac_must_keep_next = true; then
+	ac_must_keep_next=false # Got value, back to normal.
+      else
+	case $ac_arg in
+	  *=* | --config-cache | -C | -disable-* | --disable-* \
+	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
+	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
+	  | -with-* | --with-* | -without-* | --without-* | --x)
+	    case "$ac_configure_args0 " in
+	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
+	    esac
+	    ;;
+	  -* ) ac_must_keep_next=true ;;
+	esac
+      fi
+      as_fn_append ac_configure_args " '$ac_arg'"
+      ;;
+    esac
+  done
+done
+{ ac_configure_args0=; unset ac_configure_args0;}
+{ ac_configure_args1=; unset ac_configure_args1;}
+
+# When interrupted or exit'd, cleanup temporary files, and complete
+# config.log.  We remove comments because anyway the quotes in there
+# would cause problems or look ugly.
+# WARNING: Use '\'' to represent an apostrophe within the trap.
+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
+trap 'exit_status=$?
+  # Save into config.log some information that might help in debugging.
+  {
+    echo
+
+    $as_echo "## ---------------- ##
+## Cache variables. ##
+## ---------------- ##"
+    echo
+    # The following way of writing the cache mishandles newlines in values,
+(
+  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do
+    eval ac_val=\$$ac_var
+    case $ac_val in #(
+    *${as_nl}*)
+      case $ac_var in #(
+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+      esac
+      case $ac_var in #(
+      _ | IFS | as_nl) ;; #(
+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+      *) { eval $ac_var=; unset $ac_var;} ;;
+      esac ;;
+    esac
+  done
+  (set) 2>&1 |
+    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
+    *${as_nl}ac_space=\ *)
+      sed -n \
+	"s/'\''/'\''\\\\'\'''\''/g;
+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
+      ;; #(
+    *)
+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
+      ;;
+    esac |
+    sort
+)
+    echo
+
+    $as_echo "## ----------------- ##
+## Output variables. ##
+## ----------------- ##"
+    echo
+    for ac_var in $ac_subst_vars
+    do
+      eval ac_val=\$$ac_var
+      case $ac_val in
+      *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+      esac
+      $as_echo "$ac_var='\''$ac_val'\''"
+    done | sort
+    echo
+
+    if test -n "$ac_subst_files"; then
+      $as_echo "## ------------------- ##
+## File substitutions. ##
+## ------------------- ##"
+      echo
+      for ac_var in $ac_subst_files
+      do
+	eval ac_val=\$$ac_var
+	case $ac_val in
+	*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+	esac
+	$as_echo "$ac_var='\''$ac_val'\''"
+      done | sort
+      echo
+    fi
+
+    if test -s confdefs.h; then
+      $as_echo "## ----------- ##
+## confdefs.h. ##
+## ----------- ##"
+      echo
+      cat confdefs.h
+      echo
+    fi
+    test "$ac_signal" != 0 &&
+      $as_echo "$as_me: caught signal $ac_signal"
+    $as_echo "$as_me: exit $exit_status"
+  } >&5
+  rm -f core *.core core.conftest.* &&
+    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
+    exit $exit_status
+' 0
+for ac_signal in 1 2 13 15; do
+  trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal
+done
+ac_signal=0
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -f -r conftest* confdefs.h
+
+$as_echo "/* confdefs.h */" > confdefs.h
+
+# Predefined preprocessor variables.
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_NAME "$PACKAGE_NAME"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_VERSION "$PACKAGE_VERSION"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_STRING "$PACKAGE_STRING"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_URL "$PACKAGE_URL"
+_ACEOF
+
+
+# Let the site file select an alternate cache file if it wants to.
+# Prefer an explicitly selected file to automatically selected ones.
+ac_site_file1=NONE
+ac_site_file2=NONE
+if test -n "$CONFIG_SITE"; then
+  # We do not want a PATH search for config.site.
+  case $CONFIG_SITE in #((
+    -*)  ac_site_file1=./$CONFIG_SITE;;
+    */*) ac_site_file1=$CONFIG_SITE;;
+    *)   ac_site_file1=./$CONFIG_SITE;;
+  esac
+elif test "x$prefix" != xNONE; then
+  ac_site_file1=$prefix/share/config.site
+  ac_site_file2=$prefix/etc/config.site
+else
+  ac_site_file1=$ac_default_prefix/share/config.site
+  ac_site_file2=$ac_default_prefix/etc/config.site
+fi
+for ac_site_file in "$ac_site_file1" "$ac_site_file2"
+do
+  test "x$ac_site_file" = xNONE && continue
+  if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
+$as_echo "$as_me: loading site script $ac_site_file" >&6;}
+    sed 's/^/| /' "$ac_site_file" >&5
+    . "$ac_site_file" \
+      || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "failed to load site script $ac_site_file
+See \`config.log' for more details" "$LINENO" 5; }
+  fi
+done
+
+if test -r "$cache_file"; then
+  # Some versions of bash will fail to source /dev/null (special files
+  # actually), so we avoid doing that.  DJGPP emulates it as a regular file.
+  if test /dev/null != "$cache_file" && test -f "$cache_file"; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
+$as_echo "$as_me: loading cache $cache_file" >&6;}
+    case $cache_file in
+      [\\/]* | ?:[\\/]* ) . "$cache_file";;
+      *)                      . "./$cache_file";;
+    esac
+  fi
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
+$as_echo "$as_me: creating cache $cache_file" >&6;}
+  >$cache_file
+fi
+
+# Check that the precious variables saved in the cache have kept the same
+# value.
+ac_cache_corrupted=false
+for ac_var in $ac_precious_vars; do
+  eval ac_old_set=\$ac_cv_env_${ac_var}_set
+  eval ac_new_set=\$ac_env_${ac_var}_set
+  eval ac_old_val=\$ac_cv_env_${ac_var}_value
+  eval ac_new_val=\$ac_env_${ac_var}_value
+  case $ac_old_set,$ac_new_set in
+    set,)
+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+      ac_cache_corrupted=: ;;
+    ,set)
+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+      ac_cache_corrupted=: ;;
+    ,);;
+    *)
+      if test "x$ac_old_val" != "x$ac_new_val"; then
+	# differences in whitespace do not lead to failure.
+	ac_old_val_w=`echo x $ac_old_val`
+	ac_new_val_w=`echo x $ac_new_val`
+	if test "$ac_old_val_w" != "$ac_new_val_w"; then
+	  { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
+$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+	  ac_cache_corrupted=:
+	else
+	  { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
+$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
+	  eval $ac_var=\$ac_old_val
+	fi
+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5
+$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}
+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5
+$as_echo "$as_me:   current value: \`$ac_new_val'" >&2;}
+      fi;;
+  esac
+  # Pass precious variables to config.status.
+  if test "$ac_new_set" = set; then
+    case $ac_new_val in
+    *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+    *) ac_arg=$ac_var=$ac_new_val ;;
+    esac
+    case " $ac_configure_args " in
+      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.
+      *) as_fn_append ac_configure_args " '$ac_arg'" ;;
+    esac
+  fi
+done
+if $ac_cache_corrupted; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
+$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+  as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5
+fi
+## -------------------- ##
+## Main body of script. ##
+## -------------------- ##
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 4.11.1" >&5
+$as_echo "$as_me: Configuring OCaml version 4.11.1" >&6;}
+
+# Configuration variables
+
+## Command-line arguments passed to configure
+CONFIGURE_ARGS="$*"
+
+# Command-line tools section of the Unix manual
+programs_man_section=1
+
+# Library section of the Unix manual
+libraries_man_section=3
+
+# Command to build executalbes
+mkexe="\$(CC) \$(OC_CFLAGS) \$(OC_CPPFLAGS) \$(OC_LDFLAGS)"
+
+# Flags for building executable files with debugging symbols
+mkexedebugflag="-g"
+common_cflags=""
+common_cppflags=""
+internal_cflags=""
+internal_cppflags=""
+ocamlc_cflags=""
+ocamlc_cppflags=""
+oc_ldflags=""
+with_sharedlibs=true
+ostype="Unix"
+iflexdir=""
+SO="so"
+toolchain="cc"
+profinfo=false
+profinfo_width=0
+extralibs=
+instrumented_runtime=false
+instrumented_runtime_ldlibs=""
+
+# Information about the package
+
+## Source directory
+
+
+## Directory containing auxiliary scripts used dugring build
+ac_aux_dir=
+for ac_dir in build-aux "$srcdir"/build-aux; do
+  if test -f "$ac_dir/install-sh"; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install-sh -c"
+    break
+  elif test -f "$ac_dir/install.sh"; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install.sh -c"
+    break
+  elif test -f "$ac_dir/shtool"; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/shtool install -c"
+    break
+  fi
+done
+if test -z "$ac_aux_dir"; then
+  as_fn_error $? "cannot find install-sh, install.sh, or shtool in build-aux \"$srcdir\"/build-aux" "$LINENO" 5
+fi
+
+# These three variables are undocumented and unsupported,
+# and are intended to be withdrawn in a future Autoconf release.
+# They can cause serious problems if a builder's source tree is in a directory
+# whose full name contains unusual characters.
+ac_config_guess="$SHELL $ac_aux_dir/config.guess"  # Please don't use this var.
+ac_config_sub="$SHELL $ac_aux_dir/config.sub"  # Please don't use this var.
+ac_configure="$SHELL $ac_aux_dir/configure"  # Please don't use this var.
+
+
+
+## Output variables
+
+
+
+VERSION=4.11.1
+
+
+# Note: This is present for the flexdll bootstrap where it exposed as the old
+# TOOLPREF variable. It would be better if flexdll where updated to require
+# WINDRES instead.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ # TODO: rename this variable
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+## Generated files
+
+ac_config_files="$ac_config_files Makefile.common"
+
+ac_config_files="$ac_config_files Makefile.config"
+
+ac_config_files="$ac_config_files tools/eventlog_metadata"
+
+ac_config_headers="$ac_config_headers runtime/caml/m.h"
+
+ac_config_headers="$ac_config_headers runtime/caml/s.h"
+
+
+# Checks for system types
+
+# Make sure we can run config.sub.
+$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 ||
+  as_fn_error $? "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5
+$as_echo_n "checking build system type... " >&6; }
+if ${ac_cv_build+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_build_alias=$build_alias
+test "x$ac_build_alias" = x &&
+  ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"`
+test "x$ac_build_alias" = x &&
+  as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5
+ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` ||
+  as_fn_error $? "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5
+$as_echo "$ac_cv_build" >&6; }
+case $ac_cv_build in
+*-*-*) ;;
+*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;;
+esac
+build=$ac_cv_build
+ac_save_IFS=$IFS; IFS='-'
+set x $ac_cv_build
+shift
+build_cpu=$1
+build_vendor=$2
+shift; shift
+# Remember, the first character of IFS is used to create $*,
+# except with old shells:
+build_os=$*
+IFS=$ac_save_IFS
+case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5
+$as_echo_n "checking host system type... " >&6; }
+if ${ac_cv_host+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test "x$host_alias" = x; then
+  ac_cv_host=$ac_cv_build
+else
+  ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` ||
+    as_fn_error $? "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5
+$as_echo "$ac_cv_host" >&6; }
+case $ac_cv_host in
+*-*-*) ;;
+*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;;
+esac
+host=$ac_cv_host
+ac_save_IFS=$IFS; IFS='-'
+set x $ac_cv_host
+shift
+host_cpu=$1
+host_vendor=$2
+shift; shift
+# Remember, the first character of IFS is used to create $*,
+# except with old shells:
+host_os=$*
+IFS=$ac_save_IFS
+case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking target system type" >&5
+$as_echo_n "checking target system type... " >&6; }
+if ${ac_cv_target+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test "x$target_alias" = x; then
+  ac_cv_target=$ac_cv_host
+else
+  ac_cv_target=`$SHELL "$ac_aux_dir/config.sub" $target_alias` ||
+    as_fn_error $? "$SHELL $ac_aux_dir/config.sub $target_alias failed" "$LINENO" 5
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_target" >&5
+$as_echo "$ac_cv_target" >&6; }
+case $ac_cv_target in
+*-*-*) ;;
+*) as_fn_error $? "invalid value of canonical target" "$LINENO" 5;;
+esac
+target=$ac_cv_target
+ac_save_IFS=$IFS; IFS='-'
+set x $ac_cv_target
+shift
+target_cpu=$1
+target_vendor=$2
+shift; shift
+# Remember, the first character of IFS is used to create $*,
+# except with old shells:
+target_os=$*
+IFS=$ac_save_IFS
+case $target_os in *\ *) target_os=`echo "$target_os" | sed 's/ /-/g'`;; esac
+
+
+# The aliases save the names the user supplied, while $host etc.
+# will get canonicalized.
+test -n "$target_alias" &&
+  test "$program_prefix$program_suffix$program_transform_name" = \
+    NONENONEs,x,x, &&
+  program_prefix=${target_alias}-
+
+case $host in #(
+  *-pc-windows) :
+    CC=cl
+    ccomptype=msvc
+    S=asm
+    SO=dll
+    outputexe=-Fe
+    syslib='$(1).lib' ;; #(
+  *) :
+    ccomptype=cc
+  S=s
+  SO=so
+  outputexe='-o $(EMPTY)'
+  syslib='-l$(1)' ;;
+esac
+
+# Environment variables that are taken into account
+
+
+
+
+
+# Command-line arguments to configure
+
+# Check whether --enable-debug-runtime was given.
+if test "${enable_debug_runtime+set}" = set; then :
+  enableval=$enable_debug_runtime;
+fi
+
+
+# Check whether --enable-debugger was given.
+if test "${enable_debugger+set}" = set; then :
+  enableval=$enable_debugger;
+else
+  enable_debugger=auto
+fi
+
+
+
+
+# Check whether --enable-instrumented-runtime was given.
+if test "${enable_instrumented_runtime+set}" = set; then :
+  enableval=$enable_instrumented_runtime;
+else
+  enable_instrumented_runtime=auto
+fi
+
+
+# Check whether --enable-vmthreads was given.
+if test "${enable_vmthreads+set}" = set; then :
+  enableval=$enable_vmthreads; as_fn_error $? "The vmthreads library is no longer available. \
+It was deleted in OCaml 4.09." "$LINENO" 5
+fi
+
+
+# Check whether --enable-systhreads was given.
+if test "${enable_systhreads+set}" = set; then :
+  enableval=$enable_systhreads;
+fi
+
+
+
+# Check whether --with-libunwind was given.
+if test "${with_libunwind+set}" = set; then :
+  withval=$with_libunwind;
+fi
+
+
+
+
+
+
+
+# Check whether --with-bfd was given.
+if test "${with_bfd+set}" = set; then :
+  withval=$with_bfd;
+else
+  with_bfd=auto
+fi
+
+
+
+
+
+
+# Check whether --enable-graph-lib was given.
+if test "${enable_graph_lib+set}" = set; then :
+  enableval=$enable_graph_lib; as_fn_error $? "The graphics library is no longer distributed with OCaml \
+since version 4.09. It is now distributed as a separate \"graphics\" package: \
+https://github.com/ocaml/graphics" "$LINENO" 5
+fi
+
+
+# Check whether --enable-str-lib was given.
+if test "${enable_str_lib+set}" = set; then :
+  enableval=$enable_str_lib;
+fi
+
+
+# Check whether --enable-unix-lib was given.
+if test "${enable_unix_lib+set}" = set; then :
+  enableval=$enable_unix_lib;
+fi
+
+
+# Check whether --enable-bigarray-lib was given.
+if test "${enable_bigarray_lib+set}" = set; then :
+  enableval=$enable_bigarray_lib;
+fi
+
+
+# Check whether --enable-ocamldoc was given.
+if test "${enable_ocamldoc+set}" = set; then :
+  enableval=$enable_ocamldoc;
+else
+  ocamldoc=auto
+fi
+
+
+# Check whether --enable-ocamltest was given.
+if test "${enable_ocamltest+set}" = set; then :
+  enableval=$enable_ocamltest;
+fi
+
+
+# Check whether --enable-frame-pointers was given.
+if test "${enable_frame_pointers+set}" = set; then :
+  enableval=$enable_frame_pointers;
+fi
+
+
+# Check whether --enable-naked-pointers was given.
+if test "${enable_naked_pointers+set}" = set; then :
+  enableval=$enable_naked_pointers;
+fi
+
+
+# Check whether --enable-spacetime was given.
+if test "${enable_spacetime+set}" = set; then :
+  enableval=$enable_spacetime;
+fi
+
+
+# Check whether --enable-call-counts was given.
+if test "${enable_call_counts+set}" = set; then :
+  enableval=$enable_call_counts;
+fi
+
+
+# Check whether --enable-cfi was given.
+if test "${enable_cfi+set}" = set; then :
+  enableval=$enable_cfi;
+fi
+
+
+# Check whether --enable-installing-source-artifacts was given.
+if test "${enable_installing_source_artifacts+set}" = set; then :
+  enableval=$enable_installing_source_artifacts;
+fi
+
+# Check whether --enable-installing-bytecode-programs was given.
+if test "${enable_installing_bytecode_programs+set}" = set; then :
+  enableval=$enable_installing_bytecode_programs;
+fi
+
+
+# Check whether --enable-native-compiler was given.
+if test "${enable_native_compiler+set}" = set; then :
+  enableval=$enable_native_compiler;
+fi
+
+
+# Check whether --enable-flambda was given.
+if test "${enable_flambda+set}" = set; then :
+  enableval=$enable_flambda;
+fi
+
+
+# Check whether --enable-flambda-invariants was given.
+if test "${enable_flambda_invariants+set}" = set; then :
+  enableval=$enable_flambda_invariants;
+fi
+
+
+
+# Check whether --with-target-bindir was given.
+if test "${with_target_bindir+set}" = set; then :
+  withval=$with_target_bindir;
+fi
+
+
+# Check whether --enable-reserved-header-bits was given.
+if test "${enable_reserved_header_bits+set}" = set; then :
+  enableval=$enable_reserved_header_bits; case $enable_reserved_header_bits in #(
+  0) :
+    with_profinfo=false
+      profinfo_width=0 ;; #(
+  [1-9]|1[0-9]|2[0-1]) :
+    with_profinfo=true
+      profinfo_width="$enable_reserved_header_bits" ;; #(
+  *) :
+    as_fn_error $? "invalid argument to --enable-reserved-header-bits" "$LINENO" 5 ;;
+esac
+fi
+
+
+# Check whether --enable-stdlib-manpages was given.
+if test "${enable_stdlib_manpages+set}" = set; then :
+  enableval=$enable_stdlib_manpages;
+fi
+
+
+
+
+# There are two configure-time string safety options,
+# --(enable|disable)-force-safe-string and
+# DEFAULT_STRING=safe|unsafe that
+# interact with a compile-time (un)safe-string option.
+#
+# If --enable-force-safe-string is set at configure time, then the compiler
+# will always enforce that string and bytes are distinct: the
+# compile-time -unsafe-string option is disabled. This lets us
+# assume pervasive string immutability, for code optimizations and
+# in the C layer.
+#
+# If --disable-force-safe-string is set at configure-time, the compiler
+# will use the compile-time (un)safe-string option to decide whether
+# string and bytes are compatible on a per-file basis. The
+# configuration variable DEFAULT_STRING=safe|unsafe decides which
+# setting will be chosen by default, if no compile-time option is
+# explicitly passed.
+#
+# The configure-time behavior of OCaml 4.05 and older was equivalent
+# to --disable-force-safe-string DEFAULT_STRING=unsafe. With OCaml 4.06
+# and older was equivalent to --disable-force-safe-string DEFAULT_STRING=safe.
+# With OCaml 4.10 and later use --enable-force-safe-string DEFAULT_STRING=safe.
+# We expect the --disable-force-safe-string and DEFAULT_STRING=unsafe options
+# to be removed in the future.
+
+# Check whether --enable-force-safe-string was given.
+if test "${enable_force_safe_string+set}" = set; then :
+  enableval=$enable_force_safe_string;
+fi
+
+
+
+
+# Check whether --enable-flat-float-array was given.
+if test "${enable_flat_float_array+set}" = set; then :
+  enableval=$enable_flat_float_array;
+fi
+
+
+# Check whether --enable-function-sections was given.
+if test "${enable_function_sections+set}" = set; then :
+  enableval=$enable_function_sections;
+else
+  enable_function_sections=auto
+fi
+
+
+
+# Check whether --with-afl was given.
+if test "${with_afl+set}" = set; then :
+  withval=$with_afl;
+fi
+
+
+if test x"$enable_unix_lib" = "xno"; then :
+  if test x"$enable_debugger" = "xyes"; then :
+  as_fn_error $? "replay debugger requires the unix library" "$LINENO" 5
+else
+  enable_debugger="no"
+fi
+   if test x"$enable_bigarray_lib" = "xyes"; then :
+  as_fn_error $? "legacy bigarray library requires the unix library" "$LINENO" 5
+fi
+fi
+
+if test x"$enable_unix_lib" = "xno" -o x"$enable_str_lib" = "xno"; then :
+  if test x"$enable_ocamldoc" = "xyes"; then :
+  as_fn_error $? "ocamldoc requires the unix and str libraries" "$LINENO" 5
+else
+  enable_ocamldoc="no"
+     with_camltex=""
+fi
+else
+  with_camltex="true"
+fi
+
+# Initialization of libtool
+# Allow the MSVC linker to be found even if ld isn't installed.
+# User-specified LD still takes precedence.
+if test -n "$ac_tool_prefix"; then
+  for ac_prog in ld link
+  do
+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_LD+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$LD"; then
+  ac_cv_prog_LD="$LD" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_LD="$ac_tool_prefix$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+LD=$ac_cv_prog_LD
+if test -n "$LD"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LD" >&5
+$as_echo "$LD" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+    test -n "$LD" && break
+  done
+fi
+if test -z "$LD"; then
+  ac_ct_LD=$LD
+  for ac_prog in ld link
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_LD+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_LD"; then
+  ac_cv_prog_ac_ct_LD="$ac_ct_LD" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_LD="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_LD=$ac_cv_prog_ac_ct_LD
+if test -n "$ac_ct_LD"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_LD" >&5
+$as_echo "$ac_ct_LD" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$ac_ct_LD" && break
+done
+
+  if test "x$ac_ct_LD" = x; then
+    LD=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    LD=$ac_ct_LD
+  fi
+fi
+
+# libtool expects host_os=mingw for native Windows
+old_host_os=$host_os
+if test x"$host_os" = "xwindows"; then :
+  host_os=mingw
+fi
+case `pwd` in
+  *\ * | *\	*)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&5
+$as_echo "$as_me: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&2;} ;;
+esac
+
+
+
+macro_version='2.4.6'
+macro_revision='2.4.6'
+
+
+
+
+
+
+
+
+
+
+
+
+
+ltmain=$ac_aux_dir/ltmain.sh
+
+# Backslashify metacharacters that are still active within
+# double-quoted strings.
+sed_quote_subst='s/\(["`$\\]\)/\\\1/g'
+
+# Same as above, but do not quote variable references.
+double_quote_subst='s/\(["`\\]\)/\\\1/g'
+
+# Sed substitution to delay expansion of an escaped shell variable in a
+# double_quote_subst'ed string.
+delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g'
+
+# Sed substitution to delay expansion of an escaped single quote.
+delay_single_quote_subst='s/'\''/'\'\\\\\\\'\''/g'
+
+# Sed substitution to avoid accidental globbing in evaled expressions
+no_glob_subst='s/\*/\\\*/g'
+
+ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO
+ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO$ECHO
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to print strings" >&5
+$as_echo_n "checking how to print strings... " >&6; }
+# Test print first, because it will be a builtin if present.
+if test "X`( print -r -- -n ) 2>/dev/null`" = X-n && \
+   test "X`print -r -- $ECHO 2>/dev/null`" = "X$ECHO"; then
+  ECHO='print -r --'
+elif test "X`printf %s $ECHO 2>/dev/null`" = "X$ECHO"; then
+  ECHO='printf %s\n'
+else
+  # Use this function as a fallback that always works.
+  func_fallback_echo ()
+  {
+    eval 'cat <<_LTECHO_EOF
+$1
+_LTECHO_EOF'
+  }
+  ECHO='func_fallback_echo'
+fi
+
+# func_echo_all arg...
+# Invoke $ECHO with all args, space-separated.
+func_echo_all ()
+{
+    $ECHO ""
+}
+
+case $ECHO in
+  printf*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: printf" >&5
+$as_echo "printf" >&6; } ;;
+  print*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: print -r" >&5
+$as_echo "print -r" >&6; } ;;
+  *) { $as_echo "$as_me:${as_lineno-$LINENO}: result: cat" >&5
+$as_echo "cat" >&6; } ;;
+esac
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}gcc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CC="${ac_tool_prefix}gcc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+  ac_ct_CC=$CC
+  # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_CC"; then
+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_CC="gcc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_CC" = x; then
+    CC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    CC=$ac_ct_CC
+  fi
+else
+  CC="$ac_cv_prog_CC"
+fi
+
+if test -z "$CC"; then
+          if test -n "$ac_tool_prefix"; then
+    # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}cc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CC="${ac_tool_prefix}cc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  fi
+fi
+if test -z "$CC"; then
+  # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  ac_prog_rejected=no
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
+       ac_prog_rejected=yes
+       continue
+     fi
+    ac_cv_prog_CC="cc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+if test $ac_prog_rejected = yes; then
+  # We found a bogon in the path, so make sure we never use it.
+  set dummy $ac_cv_prog_CC
+  shift
+  if test $# != 0; then
+    # We chose a different compiler from the bogus one.
+    # However, it has the same basename, so the bogon will be chosen
+    # first if we set CC to just the basename; use the full file name.
+    shift
+    ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
+  fi
+fi
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$CC"; then
+  if test -n "$ac_tool_prefix"; then
+  for ac_prog in cl.exe
+  do
+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+    test -n "$CC" && break
+  done
+fi
+if test -z "$CC"; then
+  ac_ct_CC=$CC
+  for ac_prog in cl.exe
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_CC"; then
+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_CC="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$ac_ct_CC" && break
+done
+
+  if test "x$ac_ct_CC" = x; then
+    CC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    CC=$ac_ct_CC
+  fi
+fi
+
+fi
+
+
+test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "no acceptable C compiler found in \$PATH
+See \`config.log' for more details" "$LINENO" 5; }
+
+# Provide some information about the compiler.
+$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
+set X $ac_compile
+ac_compiler=$2
+for ac_option in --version -v -V -qversion; do
+  { { ac_try="$ac_compiler $ac_option >&5"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compiler $ac_option >&5") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    sed '10a\
+... rest of stderr output deleted ...
+         10q' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+  fi
+  rm -f conftest.er1 conftest.err
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+done
+
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"
+# Try to create an executable without -o first, disregard a.out.
+# It will help us diagnose broken compilers, and finding out an intuition
+# of exeext.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5
+$as_echo_n "checking whether the C compiler works... " >&6; }
+ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+
+# The possible output files:
+ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"
+
+ac_rmfiles=
+for ac_file in $ac_files
+do
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
+    * ) ac_rmfiles="$ac_rmfiles $ac_file";;
+  esac
+done
+rm -f $ac_rmfiles
+
+if { { ac_try="$ac_link_default"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link_default") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.
+# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'
+# in a Makefile.  We should not override ac_cv_exeext if it was cached,
+# so that the user can short-circuit this test for compilers unknown to
+# Autoconf.
+for ac_file in $ac_files ''
+do
+  test -f "$ac_file" || continue
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )
+	;;
+    [ab].out )
+	# We found the default executable, but exeext='' is most
+	# certainly right.
+	break;;
+    *.* )
+	if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;
+	then :; else
+	   ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+	fi
+	# We set ac_cv_exeext here because the later test for it is not
+	# safe: cross compilers may not add the suffix if given an `-o'
+	# argument, so we may need to know it at that point already.
+	# Even if this section looks crufty: it has the advantage of
+	# actually working.
+	break;;
+    * )
+	break;;
+  esac
+done
+test "$ac_cv_exeext" = no && ac_cv_exeext=
+
+else
+  ac_file=''
+fi
+if test -z "$ac_file"; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+$as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error 77 "C compiler cannot create executables
+See \`config.log' for more details" "$LINENO" 5; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5
+$as_echo_n "checking for C compiler default output file name... " >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5
+$as_echo "$ac_file" >&6; }
+ac_exeext=$ac_cv_exeext
+
+rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out
+ac_clean_files=$ac_clean_files_save
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5
+$as_echo_n "checking for suffix of executables... " >&6; }
+if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  # If both `conftest.exe' and `conftest' are `present' (well, observable)
+# catch `conftest.exe'.  For instance with Cygwin, `ls conftest' will
+# work properly (i.e., refer to `conftest.exe'), while it won't with
+# `rm'.
+for ac_file in conftest.exe conftest conftest.*; do
+  test -f "$ac_file" || continue
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
+    *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+	  break;;
+    * ) break;;
+  esac
+done
+else
+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details" "$LINENO" 5; }
+fi
+rm -f conftest conftest$ac_cv_exeext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5
+$as_echo "$ac_cv_exeext" >&6; }
+
+rm -f conftest.$ac_ext
+EXEEXT=$ac_cv_exeext
+ac_exeext=$EXEEXT
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+int
+main ()
+{
+FILE *f = fopen ("conftest.out", "w");
+ return ferror (f) || fclose (f) != 0;
+
+  ;
+  return 0;
+}
+_ACEOF
+ac_clean_files="$ac_clean_files conftest.out"
+# Check that the compiler produces executables we can run.  If not, either
+# the compiler is broken, or we cross compile.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5
+$as_echo_n "checking whether we are cross compiling... " >&6; }
+if test "$cross_compiling" != yes; then
+  { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+  if { ac_try='./conftest$ac_cv_exeext'
+  { { case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_try") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; }; then
+    cross_compiling=no
+  else
+    if test "$cross_compiling" = maybe; then
+	cross_compiling=yes
+    else
+	{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details" "$LINENO" 5; }
+    fi
+  fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5
+$as_echo "$cross_compiling" >&6; }
+
+rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out
+ac_clean_files=$ac_clean_files_save
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5
+$as_echo_n "checking for suffix of object files... " >&6; }
+if ${ac_cv_objext+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.o conftest.obj
+if { { ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compile") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  for ac_file in conftest.o conftest.obj conftest.*; do
+  test -f "$ac_file" || continue;
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;
+    *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
+       break;;
+  esac
+done
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot compute suffix of object files: cannot compile
+See \`config.log' for more details" "$LINENO" 5; }
+fi
+rm -f conftest.$ac_cv_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5
+$as_echo "$ac_cv_objext" >&6; }
+OBJEXT=$ac_cv_objext
+ac_objext=$OBJEXT
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5
+$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }
+if ${ac_cv_c_compiler_gnu+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+#ifndef __GNUC__
+       choke me
+#endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_compiler_gnu=yes
+else
+  ac_compiler_gnu=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_c_compiler_gnu=$ac_compiler_gnu
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
+$as_echo "$ac_cv_c_compiler_gnu" >&6; }
+if test $ac_compiler_gnu = yes; then
+  GCC=yes
+else
+  GCC=
+fi
+ac_test_CFLAGS=${CFLAGS+set}
+ac_save_CFLAGS=$CFLAGS
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
+$as_echo_n "checking whether $CC accepts -g... " >&6; }
+if ${ac_cv_prog_cc_g+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_save_c_werror_flag=$ac_c_werror_flag
+   ac_c_werror_flag=yes
+   ac_cv_prog_cc_g=no
+   CFLAGS="-g"
+   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_g=yes
+else
+  CFLAGS=""
+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+else
+  ac_c_werror_flag=$ac_save_c_werror_flag
+	 CFLAGS="-g"
+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_g=yes
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+   ac_c_werror_flag=$ac_save_c_werror_flag
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
+$as_echo "$ac_cv_prog_cc_g" >&6; }
+if test "$ac_test_CFLAGS" = set; then
+  CFLAGS=$ac_save_CFLAGS
+elif test $ac_cv_prog_cc_g = yes; then
+  if test "$GCC" = yes; then
+    CFLAGS="-g -O2"
+  else
+    CFLAGS="-g"
+  fi
+else
+  if test "$GCC" = yes; then
+    CFLAGS="-O2"
+  else
+    CFLAGS=
+  fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5
+$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }
+if ${ac_cv_prog_cc_c89+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_cv_prog_cc_c89=no
+ac_save_CC=$CC
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+#include 
+struct stat;
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+     char **p;
+     int i;
+{
+  return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+  char *s;
+  va_list v;
+  va_start (v,p);
+  s = g (p, va_arg (v,int));
+  va_end (v);
+  return s;
+}
+
+/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has
+   function prototypes and stuff, but not '\xHH' hex character constants.
+   These don't provoke an error unfortunately, instead are silently treated
+   as 'x'.  The following induces an error, until -std is added to get
+   proper ANSI mode.  Curiously '\x00'!='x' always comes out true, for an
+   array size at least.  It's necessary to write '\x00'==0 to get something
+   that's true only with -std.  */
+int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+
+/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters
+   inside strings and character constants.  */
+#define FOO(x) 'x'
+int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];
+
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+int
+main ()
+{
+return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];
+  ;
+  return 0;
+}
+_ACEOF
+for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \
+	-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+  CC="$ac_save_CC $ac_arg"
+  if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_c89=$ac_arg
+fi
+rm -f core conftest.err conftest.$ac_objext
+  test "x$ac_cv_prog_cc_c89" != "xno" && break
+done
+rm -f conftest.$ac_ext
+CC=$ac_save_CC
+
+fi
+# AC_CACHE_VAL
+case "x$ac_cv_prog_cc_c89" in
+  x)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
+$as_echo "none needed" >&6; } ;;
+  xno)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
+$as_echo "unsupported" >&6; } ;;
+  *)
+    CC="$CC $ac_cv_prog_cc_c89"
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
+$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;
+esac
+if test "x$ac_cv_prog_cc_c89" != xno; then :
+
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a sed that does not truncate output" >&5
+$as_echo_n "checking for a sed that does not truncate output... " >&6; }
+if ${ac_cv_path_SED+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+            ac_script=s/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb/
+     for ac_i in 1 2 3 4 5 6 7; do
+       ac_script="$ac_script$as_nl$ac_script"
+     done
+     echo "$ac_script" 2>/dev/null | sed 99q >conftest.sed
+     { ac_script=; unset ac_script;}
+     if test -z "$SED"; then
+  ac_path_SED_found=false
+  # Loop through the user's path and test for each of PROGNAME-LIST
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in sed gsed; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      ac_path_SED="$as_dir/$ac_prog$ac_exec_ext"
+      as_fn_executable_p "$ac_path_SED" || continue
+# Check for GNU ac_path_SED and select it if it is found.
+  # Check for GNU $ac_path_SED
+case `"$ac_path_SED" --version 2>&1` in
+*GNU*)
+  ac_cv_path_SED="$ac_path_SED" ac_path_SED_found=:;;
+*)
+  ac_count=0
+  $as_echo_n 0123456789 >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    $as_echo '' >> "conftest.nl"
+    "$ac_path_SED" -f conftest.sed < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    as_fn_arith $ac_count + 1 && ac_count=$as_val
+    if test $ac_count -gt ${ac_path_SED_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_SED="$ac_path_SED"
+      ac_path_SED_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+      $ac_path_SED_found && break 3
+    done
+  done
+  done
+IFS=$as_save_IFS
+  if test -z "$ac_cv_path_SED"; then
+    as_fn_error $? "no acceptable sed could be found in \$PATH" "$LINENO" 5
+  fi
+else
+  ac_cv_path_SED=$SED
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_SED" >&5
+$as_echo "$ac_cv_path_SED" >&6; }
+ SED="$ac_cv_path_SED"
+  rm -f conftest.sed
+
+test -z "$SED" && SED=sed
+Xsed="$SED -e 1s/^X//"
+
+
+
+
+
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5
+$as_echo_n "checking for grep that handles long lines and -e... " >&6; }
+if ${ac_cv_path_GREP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -z "$GREP"; then
+  ac_path_GREP_found=false
+  # Loop through the user's path and test for each of PROGNAME-LIST
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in grep ggrep; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
+      as_fn_executable_p "$ac_path_GREP" || continue
+# Check for GNU ac_path_GREP and select it if it is found.
+  # Check for GNU $ac_path_GREP
+case `"$ac_path_GREP" --version 2>&1` in
+*GNU*)
+  ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;
+*)
+  ac_count=0
+  $as_echo_n 0123456789 >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    $as_echo 'GREP' >> "conftest.nl"
+    "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    as_fn_arith $ac_count + 1 && ac_count=$as_val
+    if test $ac_count -gt ${ac_path_GREP_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_GREP="$ac_path_GREP"
+      ac_path_GREP_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+      $ac_path_GREP_found && break 3
+    done
+  done
+  done
+IFS=$as_save_IFS
+  if test -z "$ac_cv_path_GREP"; then
+    as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+  fi
+else
+  ac_cv_path_GREP=$GREP
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5
+$as_echo "$ac_cv_path_GREP" >&6; }
+ GREP="$ac_cv_path_GREP"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5
+$as_echo_n "checking for egrep... " >&6; }
+if ${ac_cv_path_EGREP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if echo a | $GREP -E '(a|b)' >/dev/null 2>&1
+   then ac_cv_path_EGREP="$GREP -E"
+   else
+     if test -z "$EGREP"; then
+  ac_path_EGREP_found=false
+  # Loop through the user's path and test for each of PROGNAME-LIST
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in egrep; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
+      as_fn_executable_p "$ac_path_EGREP" || continue
+# Check for GNU ac_path_EGREP and select it if it is found.
+  # Check for GNU $ac_path_EGREP
+case `"$ac_path_EGREP" --version 2>&1` in
+*GNU*)
+  ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;
+*)
+  ac_count=0
+  $as_echo_n 0123456789 >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    $as_echo 'EGREP' >> "conftest.nl"
+    "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    as_fn_arith $ac_count + 1 && ac_count=$as_val
+    if test $ac_count -gt ${ac_path_EGREP_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_EGREP="$ac_path_EGREP"
+      ac_path_EGREP_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+      $ac_path_EGREP_found && break 3
+    done
+  done
+  done
+IFS=$as_save_IFS
+  if test -z "$ac_cv_path_EGREP"; then
+    as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+  fi
+else
+  ac_cv_path_EGREP=$EGREP
+fi
+
+   fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
+$as_echo "$ac_cv_path_EGREP" >&6; }
+ EGREP="$ac_cv_path_EGREP"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fgrep" >&5
+$as_echo_n "checking for fgrep... " >&6; }
+if ${ac_cv_path_FGREP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if echo 'ab*c' | $GREP -F 'ab*c' >/dev/null 2>&1
+   then ac_cv_path_FGREP="$GREP -F"
+   else
+     if test -z "$FGREP"; then
+  ac_path_FGREP_found=false
+  # Loop through the user's path and test for each of PROGNAME-LIST
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in fgrep; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      ac_path_FGREP="$as_dir/$ac_prog$ac_exec_ext"
+      as_fn_executable_p "$ac_path_FGREP" || continue
+# Check for GNU ac_path_FGREP and select it if it is found.
+  # Check for GNU $ac_path_FGREP
+case `"$ac_path_FGREP" --version 2>&1` in
+*GNU*)
+  ac_cv_path_FGREP="$ac_path_FGREP" ac_path_FGREP_found=:;;
+*)
+  ac_count=0
+  $as_echo_n 0123456789 >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    $as_echo 'FGREP' >> "conftest.nl"
+    "$ac_path_FGREP" FGREP < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    as_fn_arith $ac_count + 1 && ac_count=$as_val
+    if test $ac_count -gt ${ac_path_FGREP_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_FGREP="$ac_path_FGREP"
+      ac_path_FGREP_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+      $ac_path_FGREP_found && break 3
+    done
+  done
+  done
+IFS=$as_save_IFS
+  if test -z "$ac_cv_path_FGREP"; then
+    as_fn_error $? "no acceptable fgrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+  fi
+else
+  ac_cv_path_FGREP=$FGREP
+fi
+
+   fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_FGREP" >&5
+$as_echo "$ac_cv_path_FGREP" >&6; }
+ FGREP="$ac_cv_path_FGREP"
+
+
+test -z "$GREP" && GREP=grep
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+# Check whether --with-gnu-ld was given.
+if test "${with_gnu_ld+set}" = set; then :
+  withval=$with_gnu_ld; test no = "$withval" || with_gnu_ld=yes
+else
+  with_gnu_ld=no
+fi
+
+ac_prog=ld
+if test yes = "$GCC"; then
+  # Check if gcc -print-prog-name=ld gives a path.
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld used by $CC" >&5
+$as_echo_n "checking for ld used by $CC... " >&6; }
+  case $host in
+  *-*-mingw*)
+    # gcc leaves a trailing carriage return, which upsets mingw
+    ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
+  *)
+    ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
+  esac
+  case $ac_prog in
+    # Accept absolute paths.
+    [\\/]* | ?:[\\/]*)
+      re_direlt='/[^/][^/]*/\.\./'
+      # Canonicalize the pathname of ld
+      ac_prog=`$ECHO "$ac_prog"| $SED 's%\\\\%/%g'`
+      while $ECHO "$ac_prog" | $GREP "$re_direlt" > /dev/null 2>&1; do
+	ac_prog=`$ECHO $ac_prog| $SED "s%$re_direlt%/%"`
+      done
+      test -z "$LD" && LD=$ac_prog
+      ;;
+  "")
+    # If it fails, then pretend we aren't using GCC.
+    ac_prog=ld
+    ;;
+  *)
+    # If it is relative, then search for the first ld in PATH.
+    with_gnu_ld=unknown
+    ;;
+  esac
+elif test yes = "$with_gnu_ld"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU ld" >&5
+$as_echo_n "checking for GNU ld... " >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for non-GNU ld" >&5
+$as_echo_n "checking for non-GNU ld... " >&6; }
+fi
+if ${lt_cv_path_LD+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -z "$LD"; then
+  lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR
+  for ac_dir in $PATH; do
+    IFS=$lt_save_ifs
+    test -z "$ac_dir" && ac_dir=.
+    if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
+      lt_cv_path_LD=$ac_dir/$ac_prog
+      # Check to see if the program is GNU ld.  I'd rather use --version,
+      # but apparently some variants of GNU ld only accept -v.
+      # Break only if it was the GNU/non-GNU ld that we prefer.
+      case `"$lt_cv_path_LD" -v 2>&1 &5
+$as_echo "$LD" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+test -z "$LD" && as_fn_error $? "no acceptable ld found in \$PATH" "$LINENO" 5
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if the linker ($LD) is GNU ld" >&5
+$as_echo_n "checking if the linker ($LD) is GNU ld... " >&6; }
+if ${lt_cv_prog_gnu_ld+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  # I'd rather use --version here, but apparently some GNU lds only accept -v.
+case `$LD -v 2>&1 &5
+$as_echo "$lt_cv_prog_gnu_ld" >&6; }
+with_gnu_ld=$lt_cv_prog_gnu_ld
+
+
+
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for BSD- or MS-compatible name lister (nm)" >&5
+$as_echo_n "checking for BSD- or MS-compatible name lister (nm)... " >&6; }
+if ${lt_cv_path_NM+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$NM"; then
+  # Let the user override the test.
+  lt_cv_path_NM=$NM
+else
+  lt_nm_to_check=${ac_tool_prefix}nm
+  if test -n "$ac_tool_prefix" && test "$build" = "$host"; then
+    lt_nm_to_check="$lt_nm_to_check nm"
+  fi
+  for lt_tmp_nm in $lt_nm_to_check; do
+    lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR
+    for ac_dir in $PATH /usr/ccs/bin/elf /usr/ccs/bin /usr/ucb /bin; do
+      IFS=$lt_save_ifs
+      test -z "$ac_dir" && ac_dir=.
+      tmp_nm=$ac_dir/$lt_tmp_nm
+      if test -f "$tmp_nm" || test -f "$tmp_nm$ac_exeext"; then
+	# Check to see if the nm accepts a BSD-compat flag.
+	# Adding the 'sed 1q' prevents false positives on HP-UX, which says:
+	#   nm: unknown option "B" ignored
+	# Tru64's nm complains that /dev/null is an invalid object file
+	# MSYS converts /dev/null to NUL, MinGW nm treats NUL as empty
+	case $build_os in
+	mingw*) lt_bad_file=conftest.nm/nofile ;;
+	*) lt_bad_file=/dev/null ;;
+	esac
+	case `"$tmp_nm" -B $lt_bad_file 2>&1 | sed '1q'` in
+	*$lt_bad_file* | *'Invalid file or object type'*)
+	  lt_cv_path_NM="$tmp_nm -B"
+	  break 2
+	  ;;
+	*)
+	  case `"$tmp_nm" -p /dev/null 2>&1 | sed '1q'` in
+	  */dev/null*)
+	    lt_cv_path_NM="$tmp_nm -p"
+	    break 2
+	    ;;
+	  *)
+	    lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but
+	    continue # so that we can try to find one that supports BSD flags
+	    ;;
+	  esac
+	  ;;
+	esac
+      fi
+    done
+    IFS=$lt_save_ifs
+  done
+  : ${lt_cv_path_NM=no}
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_path_NM" >&5
+$as_echo "$lt_cv_path_NM" >&6; }
+if test no != "$lt_cv_path_NM"; then
+  NM=$lt_cv_path_NM
+else
+  # Didn't find any BSD compatible name lister, look for dumpbin.
+  if test -n "$DUMPBIN"; then :
+    # Let the user override the test.
+  else
+    if test -n "$ac_tool_prefix"; then
+  for ac_prog in dumpbin "link -dump"
+  do
+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_DUMPBIN+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$DUMPBIN"; then
+  ac_cv_prog_DUMPBIN="$DUMPBIN" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_DUMPBIN="$ac_tool_prefix$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+DUMPBIN=$ac_cv_prog_DUMPBIN
+if test -n "$DUMPBIN"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DUMPBIN" >&5
+$as_echo "$DUMPBIN" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+    test -n "$DUMPBIN" && break
+  done
+fi
+if test -z "$DUMPBIN"; then
+  ac_ct_DUMPBIN=$DUMPBIN
+  for ac_prog in dumpbin "link -dump"
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_DUMPBIN+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_DUMPBIN"; then
+  ac_cv_prog_ac_ct_DUMPBIN="$ac_ct_DUMPBIN" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_DUMPBIN="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_DUMPBIN=$ac_cv_prog_ac_ct_DUMPBIN
+if test -n "$ac_ct_DUMPBIN"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DUMPBIN" >&5
+$as_echo "$ac_ct_DUMPBIN" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$ac_ct_DUMPBIN" && break
+done
+
+  if test "x$ac_ct_DUMPBIN" = x; then
+    DUMPBIN=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    DUMPBIN=$ac_ct_DUMPBIN
+  fi
+fi
+
+    case `$DUMPBIN -symbols -headers /dev/null 2>&1 | sed '1q'` in
+    *COFF*)
+      DUMPBIN="$DUMPBIN -symbols -headers"
+      ;;
+    *)
+      DUMPBIN=:
+      ;;
+    esac
+  fi
+
+  if test : != "$DUMPBIN"; then
+    NM=$DUMPBIN
+  fi
+fi
+test -z "$NM" && NM=nm
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the name lister ($NM) interface" >&5
+$as_echo_n "checking the name lister ($NM) interface... " >&6; }
+if ${lt_cv_nm_interface+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_nm_interface="BSD nm"
+  echo "int some_variable = 0;" > conftest.$ac_ext
+  (eval echo "\"\$as_me:$LINENO: $ac_compile\"" >&5)
+  (eval "$ac_compile" 2>conftest.err)
+  cat conftest.err >&5
+  (eval echo "\"\$as_me:$LINENO: $NM \\\"conftest.$ac_objext\\\"\"" >&5)
+  (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out)
+  cat conftest.err >&5
+  (eval echo "\"\$as_me:$LINENO: output\"" >&5)
+  cat conftest.out >&5
+  if $GREP 'External.*some_variable' conftest.out > /dev/null; then
+    lt_cv_nm_interface="MS dumpbin"
+  fi
+  rm -f conftest*
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_nm_interface" >&5
+$as_echo "$lt_cv_nm_interface" >&6; }
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ln -s works" >&5
+$as_echo_n "checking whether ln -s works... " >&6; }
+LN_S=$as_ln_s
+if test "$LN_S" = "ln -s"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no, using $LN_S" >&5
+$as_echo "no, using $LN_S" >&6; }
+fi
+
+# find the maximum length of command line arguments
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the maximum length of command line arguments" >&5
+$as_echo_n "checking the maximum length of command line arguments... " >&6; }
+if ${lt_cv_sys_max_cmd_len+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+    i=0
+  teststring=ABCD
+
+  case $build_os in
+  msdosdjgpp*)
+    # On DJGPP, this test can blow up pretty badly due to problems in libc
+    # (any single argument exceeding 2000 bytes causes a buffer overrun
+    # during glob expansion).  Even if it were fixed, the result of this
+    # check would be larger than it should be.
+    lt_cv_sys_max_cmd_len=12288;    # 12K is about right
+    ;;
+
+  gnu*)
+    # Under GNU Hurd, this test is not required because there is
+    # no limit to the length of command line arguments.
+    # Libtool will interpret -1 as no limit whatsoever
+    lt_cv_sys_max_cmd_len=-1;
+    ;;
+
+  cygwin* | mingw* | cegcc*)
+    # On Win9x/ME, this test blows up -- it succeeds, but takes
+    # about 5 minutes as the teststring grows exponentially.
+    # Worse, since 9x/ME are not pre-emptively multitasking,
+    # you end up with a "frozen" computer, even though with patience
+    # the test eventually succeeds (with a max line length of 256k).
+    # Instead, let's just punt: use the minimum linelength reported by
+    # all of the supported platforms: 8192 (on NT/2K/XP).
+    lt_cv_sys_max_cmd_len=8192;
+    ;;
+
+  mint*)
+    # On MiNT this can take a long time and run out of memory.
+    lt_cv_sys_max_cmd_len=8192;
+    ;;
+
+  amigaos*)
+    # On AmigaOS with pdksh, this test takes hours, literally.
+    # So we just punt and use a minimum line length of 8192.
+    lt_cv_sys_max_cmd_len=8192;
+    ;;
+
+  bitrig* | darwin* | dragonfly* | freebsd* | netbsd* | openbsd*)
+    # This has been around since 386BSD, at least.  Likely further.
+    if test -x /sbin/sysctl; then
+      lt_cv_sys_max_cmd_len=`/sbin/sysctl -n kern.argmax`
+    elif test -x /usr/sbin/sysctl; then
+      lt_cv_sys_max_cmd_len=`/usr/sbin/sysctl -n kern.argmax`
+    else
+      lt_cv_sys_max_cmd_len=65536	# usable default for all BSDs
+    fi
+    # And add a safety zone
+    lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4`
+    lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3`
+    ;;
+
+  interix*)
+    # We know the value 262144 and hardcode it with a safety zone (like BSD)
+    lt_cv_sys_max_cmd_len=196608
+    ;;
+
+  os2*)
+    # The test takes a long time on OS/2.
+    lt_cv_sys_max_cmd_len=8192
+    ;;
+
+  osf*)
+    # Dr. Hans Ekkehard Plesser reports seeing a kernel panic running configure
+    # due to this test when exec_disable_arg_limit is 1 on Tru64. It is not
+    # nice to cause kernel panics so lets avoid the loop below.
+    # First set a reasonable default.
+    lt_cv_sys_max_cmd_len=16384
+    #
+    if test -x /sbin/sysconfig; then
+      case `/sbin/sysconfig -q proc exec_disable_arg_limit` in
+        *1*) lt_cv_sys_max_cmd_len=-1 ;;
+      esac
+    fi
+    ;;
+  sco3.2v5*)
+    lt_cv_sys_max_cmd_len=102400
+    ;;
+  sysv5* | sco5v6* | sysv4.2uw2*)
+    kargmax=`grep ARG_MAX /etc/conf/cf.d/stune 2>/dev/null`
+    if test -n "$kargmax"; then
+      lt_cv_sys_max_cmd_len=`echo $kargmax | sed 's/.*[	 ]//'`
+    else
+      lt_cv_sys_max_cmd_len=32768
+    fi
+    ;;
+  *)
+    lt_cv_sys_max_cmd_len=`(getconf ARG_MAX) 2> /dev/null`
+    if test -n "$lt_cv_sys_max_cmd_len" && \
+       test undefined != "$lt_cv_sys_max_cmd_len"; then
+      lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4`
+      lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3`
+    else
+      # Make teststring a little bigger before we do anything with it.
+      # a 1K string should be a reasonable start.
+      for i in 1 2 3 4 5 6 7 8; do
+        teststring=$teststring$teststring
+      done
+      SHELL=${SHELL-${CONFIG_SHELL-/bin/sh}}
+      # If test is not a shell built-in, we'll probably end up computing a
+      # maximum length that is only half of the actual maximum length, but
+      # we can't tell.
+      while { test X`env echo "$teststring$teststring" 2>/dev/null` \
+	         = "X$teststring$teststring"; } >/dev/null 2>&1 &&
+	      test 17 != "$i" # 1/2 MB should be enough
+      do
+        i=`expr $i + 1`
+        teststring=$teststring$teststring
+      done
+      # Only check the string length outside the loop.
+      lt_cv_sys_max_cmd_len=`expr "X$teststring" : ".*" 2>&1`
+      teststring=
+      # Add a significant safety factor because C++ compilers can tack on
+      # massive amounts of additional arguments before passing them to the
+      # linker.  It appears as though 1/2 is a usable value.
+      lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 2`
+    fi
+    ;;
+  esac
+
+fi
+
+if test -n "$lt_cv_sys_max_cmd_len"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_sys_max_cmd_len" >&5
+$as_echo "$lt_cv_sys_max_cmd_len" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5
+$as_echo "none" >&6; }
+fi
+max_cmd_len=$lt_cv_sys_max_cmd_len
+
+
+
+
+
+
+: ${CP="cp -f"}
+: ${MV="mv -f"}
+: ${RM="rm -f"}
+
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+  lt_unset=unset
+else
+  lt_unset=false
+fi
+
+
+
+
+
+# test EBCDIC or ASCII
+case `echo X|tr X '\101'` in
+ A) # ASCII based system
+    # \n is not interpreted correctly by Solaris 8 /usr/ucb/tr
+  lt_SP2NL='tr \040 \012'
+  lt_NL2SP='tr \015\012 \040\040'
+  ;;
+ *) # EBCDIC based system
+  lt_SP2NL='tr \100 \n'
+  lt_NL2SP='tr \r\n \100\100'
+  ;;
+esac
+
+
+
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to convert $build file names to $host format" >&5
+$as_echo_n "checking how to convert $build file names to $host format... " >&6; }
+if ${lt_cv_to_host_file_cmd+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  case $host in
+  *-*-mingw* )
+    case $build in
+      *-*-mingw* ) # actually msys
+        lt_cv_to_host_file_cmd=func_convert_file_msys_to_w32
+        ;;
+      *-*-cygwin* )
+        lt_cv_to_host_file_cmd=func_convert_file_cygwin_to_w32
+        ;;
+      * ) # otherwise, assume *nix
+        lt_cv_to_host_file_cmd=func_convert_file_nix_to_w32
+        ;;
+    esac
+    ;;
+  *-*-cygwin* )
+    case $build in
+      *-*-mingw* ) # actually msys
+        lt_cv_to_host_file_cmd=func_convert_file_msys_to_cygwin
+        ;;
+      *-*-cygwin* )
+        lt_cv_to_host_file_cmd=func_convert_file_noop
+        ;;
+      * ) # otherwise, assume *nix
+        lt_cv_to_host_file_cmd=func_convert_file_nix_to_cygwin
+        ;;
+    esac
+    ;;
+  * ) # unhandled hosts (and "normal" native builds)
+    lt_cv_to_host_file_cmd=func_convert_file_noop
+    ;;
+esac
+
+fi
+
+to_host_file_cmd=$lt_cv_to_host_file_cmd
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_to_host_file_cmd" >&5
+$as_echo "$lt_cv_to_host_file_cmd" >&6; }
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to convert $build file names to toolchain format" >&5
+$as_echo_n "checking how to convert $build file names to toolchain format... " >&6; }
+if ${lt_cv_to_tool_file_cmd+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  #assume ordinary cross tools, or native build.
+lt_cv_to_tool_file_cmd=func_convert_file_noop
+case $host in
+  *-*-mingw* )
+    case $build in
+      *-*-mingw* ) # actually msys
+        lt_cv_to_tool_file_cmd=func_convert_file_msys_to_w32
+        ;;
+    esac
+    ;;
+esac
+
+fi
+
+to_tool_file_cmd=$lt_cv_to_tool_file_cmd
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_to_tool_file_cmd" >&5
+$as_echo "$lt_cv_to_tool_file_cmd" >&6; }
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $LD option to reload object files" >&5
+$as_echo_n "checking for $LD option to reload object files... " >&6; }
+if ${lt_cv_ld_reload_flag+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_ld_reload_flag='-r'
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_reload_flag" >&5
+$as_echo "$lt_cv_ld_reload_flag" >&6; }
+reload_flag=$lt_cv_ld_reload_flag
+case $reload_flag in
+"" | " "*) ;;
+*) reload_flag=" $reload_flag" ;;
+esac
+reload_cmds='$LD$reload_flag -o $output$reload_objs'
+case $host_os in
+  cygwin* | mingw* | pw32* | cegcc*)
+    if test yes != "$GCC"; then
+      reload_cmds=false
+    fi
+    ;;
+  darwin*)
+    if test yes = "$GCC"; then
+      reload_cmds='$LTCC $LTCFLAGS -nostdlib $wl-r -o $output$reload_objs'
+    else
+      reload_cmds='$LD$reload_flag -o $output$reload_objs'
+    fi
+    ;;
+esac
+
+
+
+
+
+
+
+
+
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}objdump", so it can be a program name with args.
+set dummy ${ac_tool_prefix}objdump; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_OBJDUMP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$OBJDUMP"; then
+  ac_cv_prog_OBJDUMP="$OBJDUMP" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_OBJDUMP="${ac_tool_prefix}objdump"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+OBJDUMP=$ac_cv_prog_OBJDUMP
+if test -n "$OBJDUMP"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OBJDUMP" >&5
+$as_echo "$OBJDUMP" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_OBJDUMP"; then
+  ac_ct_OBJDUMP=$OBJDUMP
+  # Extract the first word of "objdump", so it can be a program name with args.
+set dummy objdump; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_OBJDUMP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_OBJDUMP"; then
+  ac_cv_prog_ac_ct_OBJDUMP="$ac_ct_OBJDUMP" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_OBJDUMP="objdump"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_OBJDUMP=$ac_cv_prog_ac_ct_OBJDUMP
+if test -n "$ac_ct_OBJDUMP"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OBJDUMP" >&5
+$as_echo "$ac_ct_OBJDUMP" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_OBJDUMP" = x; then
+    OBJDUMP="false"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    OBJDUMP=$ac_ct_OBJDUMP
+  fi
+else
+  OBJDUMP="$ac_cv_prog_OBJDUMP"
+fi
+
+test -z "$OBJDUMP" && OBJDUMP=objdump
+
+
+
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to recognize dependent libraries" >&5
+$as_echo_n "checking how to recognize dependent libraries... " >&6; }
+if ${lt_cv_deplibs_check_method+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_file_magic_cmd='$MAGIC_CMD'
+lt_cv_file_magic_test_file=
+lt_cv_deplibs_check_method='unknown'
+# Need to set the preceding variable on all platforms that support
+# interlibrary dependencies.
+# 'none' -- dependencies not supported.
+# 'unknown' -- same as none, but documents that we really don't know.
+# 'pass_all' -- all dependencies passed with no checks.
+# 'test_compile' -- check by making test program.
+# 'file_magic [[regex]]' -- check by looking for files in library path
+# that responds to the $file_magic_cmd with a given extended regex.
+# If you have 'file' or equivalent on your system and you're not sure
+# whether 'pass_all' will *always* work, you probably want this one.
+
+case $host_os in
+aix[4-9]*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+beos*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+bsdi[45]*)
+  lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib)'
+  lt_cv_file_magic_cmd='/usr/bin/file -L'
+  lt_cv_file_magic_test_file=/shlib/libc.so
+  ;;
+
+cygwin*)
+  # func_win32_libid is a shell function defined in ltmain.sh
+  lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL'
+  lt_cv_file_magic_cmd='func_win32_libid'
+  ;;
+
+mingw* | pw32*)
+  # Base MSYS/MinGW do not provide the 'file' command needed by
+  # func_win32_libid shell function, so use a weaker test based on 'objdump',
+  # unless we find 'file', for example because we are cross-compiling.
+  if ( file / ) >/dev/null 2>&1; then
+    lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL'
+    lt_cv_file_magic_cmd='func_win32_libid'
+  else
+    # Keep this pattern in sync with the one in func_win32_libid.
+    lt_cv_deplibs_check_method='file_magic file format (pei*-i386(.*architecture: i386)?|pe-arm-wince|pe-x86-64)'
+    lt_cv_file_magic_cmd='$OBJDUMP -f'
+  fi
+  ;;
+
+cegcc*)
+  # use the weaker test based on 'objdump'. See mingw*.
+  lt_cv_deplibs_check_method='file_magic file format pe-arm-.*little(.*architecture: arm)?'
+  lt_cv_file_magic_cmd='$OBJDUMP -f'
+  ;;
+
+darwin* | rhapsody*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+freebsd* | dragonfly*)
+  if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then
+    case $host_cpu in
+    i*86 )
+      # Not sure whether the presence of OpenBSD here was a mistake.
+      # Let's accept both of them until this is cleared up.
+      lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD|DragonFly)/i[3-9]86 (compact )?demand paged shared library'
+      lt_cv_file_magic_cmd=/usr/bin/file
+      lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*`
+      ;;
+    esac
+  else
+    lt_cv_deplibs_check_method=pass_all
+  fi
+  ;;
+
+haiku*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+hpux10.20* | hpux11*)
+  lt_cv_file_magic_cmd=/usr/bin/file
+  case $host_cpu in
+  ia64*)
+    lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF-[0-9][0-9]) shared object file - IA64'
+    lt_cv_file_magic_test_file=/usr/lib/hpux32/libc.so
+    ;;
+  hppa*64*)
+    lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF[ -][0-9][0-9])(-bit)?( [LM]SB)? shared object( file)?[, -]* PA-RISC [0-9]\.[0-9]'
+    lt_cv_file_magic_test_file=/usr/lib/pa20_64/libc.sl
+    ;;
+  *)
+    lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|PA-RISC[0-9]\.[0-9]) shared library'
+    lt_cv_file_magic_test_file=/usr/lib/libc.sl
+    ;;
+  esac
+  ;;
+
+interix[3-9]*)
+  # PIC code is broken on Interix 3.x, that's why |\.a not |_pic\.a here
+  lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|\.a)$'
+  ;;
+
+irix5* | irix6* | nonstopux*)
+  case $LD in
+  *-32|*"-32 ") libmagic=32-bit;;
+  *-n32|*"-n32 ") libmagic=N32;;
+  *-64|*"-64 ") libmagic=64-bit;;
+  *) libmagic=never-match;;
+  esac
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+# This must be glibc/ELF.
+linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+netbsd* | netbsdelf*-gnu)
+  if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then
+    lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$'
+  else
+    lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|_pic\.a)$'
+  fi
+  ;;
+
+newos6*)
+  lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (executable|dynamic lib)'
+  lt_cv_file_magic_cmd=/usr/bin/file
+  lt_cv_file_magic_test_file=/usr/lib/libnls.so
+  ;;
+
+*nto* | *qnx*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+openbsd* | bitrig*)
+  if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then
+    lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|\.so|_pic\.a)$'
+  else
+    lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$'
+  fi
+  ;;
+
+osf3* | osf4* | osf5*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+rdos*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+solaris*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+sysv4 | sysv4.3*)
+  case $host_vendor in
+  motorola)
+    lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib) M[0-9][0-9]* Version [0-9]'
+    lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*`
+    ;;
+  ncr)
+    lt_cv_deplibs_check_method=pass_all
+    ;;
+  sequent)
+    lt_cv_file_magic_cmd='/bin/file'
+    lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [LM]SB (shared object|dynamic lib )'
+    ;;
+  sni)
+    lt_cv_file_magic_cmd='/bin/file'
+    lt_cv_deplibs_check_method="file_magic ELF [0-9][0-9]*-bit [LM]SB dynamic lib"
+    lt_cv_file_magic_test_file=/lib/libc.so
+    ;;
+  siemens)
+    lt_cv_deplibs_check_method=pass_all
+    ;;
+  pc)
+    lt_cv_deplibs_check_method=pass_all
+    ;;
+  esac
+  ;;
+
+tpf*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+os2*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+esac
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_deplibs_check_method" >&5
+$as_echo "$lt_cv_deplibs_check_method" >&6; }
+
+file_magic_glob=
+want_nocaseglob=no
+if test "$build" = "$host"; then
+  case $host_os in
+  mingw* | pw32*)
+    if ( shopt | grep nocaseglob ) >/dev/null 2>&1; then
+      want_nocaseglob=yes
+    else
+      file_magic_glob=`echo aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ | $SED -e "s/\(..\)/s\/[\1]\/[\1]\/g;/g"`
+    fi
+    ;;
+  esac
+fi
+
+file_magic_cmd=$lt_cv_file_magic_cmd
+deplibs_check_method=$lt_cv_deplibs_check_method
+test -z "$deplibs_check_method" && deplibs_check_method=unknown
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}dlltool", so it can be a program name with args.
+set dummy ${ac_tool_prefix}dlltool; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_DLLTOOL+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$DLLTOOL"; then
+  ac_cv_prog_DLLTOOL="$DLLTOOL" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_DLLTOOL="${ac_tool_prefix}dlltool"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+DLLTOOL=$ac_cv_prog_DLLTOOL
+if test -n "$DLLTOOL"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DLLTOOL" >&5
+$as_echo "$DLLTOOL" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_DLLTOOL"; then
+  ac_ct_DLLTOOL=$DLLTOOL
+  # Extract the first word of "dlltool", so it can be a program name with args.
+set dummy dlltool; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_DLLTOOL+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_DLLTOOL"; then
+  ac_cv_prog_ac_ct_DLLTOOL="$ac_ct_DLLTOOL" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_DLLTOOL="dlltool"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_DLLTOOL=$ac_cv_prog_ac_ct_DLLTOOL
+if test -n "$ac_ct_DLLTOOL"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DLLTOOL" >&5
+$as_echo "$ac_ct_DLLTOOL" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_DLLTOOL" = x; then
+    DLLTOOL="false"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    DLLTOOL=$ac_ct_DLLTOOL
+  fi
+else
+  DLLTOOL="$ac_cv_prog_DLLTOOL"
+fi
+
+test -z "$DLLTOOL" && DLLTOOL=dlltool
+
+
+
+
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to associate runtime and link libraries" >&5
+$as_echo_n "checking how to associate runtime and link libraries... " >&6; }
+if ${lt_cv_sharedlib_from_linklib_cmd+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_sharedlib_from_linklib_cmd='unknown'
+
+case $host_os in
+cygwin* | mingw* | pw32* | cegcc*)
+  # two different shell functions defined in ltmain.sh;
+  # decide which one to use based on capabilities of $DLLTOOL
+  case `$DLLTOOL --help 2>&1` in
+  *--identify-strict*)
+    lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib
+    ;;
+  *)
+    lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib_fallback
+    ;;
+  esac
+  ;;
+*)
+  # fallback: assume linklib IS sharedlib
+  lt_cv_sharedlib_from_linklib_cmd=$ECHO
+  ;;
+esac
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_sharedlib_from_linklib_cmd" >&5
+$as_echo "$lt_cv_sharedlib_from_linklib_cmd" >&6; }
+sharedlib_from_linklib_cmd=$lt_cv_sharedlib_from_linklib_cmd
+test -z "$sharedlib_from_linklib_cmd" && sharedlib_from_linklib_cmd=$ECHO
+
+
+
+
+
+
+
+
+if test -n "$ac_tool_prefix"; then
+  for ac_prog in ar
+  do
+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_AR+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$AR"; then
+  ac_cv_prog_AR="$AR" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_AR="$ac_tool_prefix$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+AR=$ac_cv_prog_AR
+if test -n "$AR"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5
+$as_echo "$AR" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+    test -n "$AR" && break
+  done
+fi
+if test -z "$AR"; then
+  ac_ct_AR=$AR
+  for ac_prog in ar
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_AR+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_AR"; then
+  ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_AR="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_AR=$ac_cv_prog_ac_ct_AR
+if test -n "$ac_ct_AR"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5
+$as_echo "$ac_ct_AR" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$ac_ct_AR" && break
+done
+
+  if test "x$ac_ct_AR" = x; then
+    AR="false"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    AR=$ac_ct_AR
+  fi
+fi
+
+: ${AR=ar}
+: ${AR_FLAGS=cru}
+
+
+
+
+
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for archiver @FILE support" >&5
+$as_echo_n "checking for archiver @FILE support... " >&6; }
+if ${lt_cv_ar_at_file+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_ar_at_file=no
+   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  echo conftest.$ac_objext > conftest.lst
+      lt_ar_try='$AR $AR_FLAGS libconftest.a @conftest.lst >&5'
+      { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$lt_ar_try\""; } >&5
+  (eval $lt_ar_try) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+      if test 0 -eq "$ac_status"; then
+	# Ensure the archiver fails upon bogus file names.
+	rm -f conftest.$ac_objext libconftest.a
+	{ { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$lt_ar_try\""; } >&5
+  (eval $lt_ar_try) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+	if test 0 -ne "$ac_status"; then
+          lt_cv_ar_at_file=@
+        fi
+      fi
+      rm -f conftest.* libconftest.a
+
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ar_at_file" >&5
+$as_echo "$lt_cv_ar_at_file" >&6; }
+
+if test no = "$lt_cv_ar_at_file"; then
+  archiver_list_spec=
+else
+  archiver_list_spec=$lt_cv_ar_at_file
+fi
+
+
+
+
+
+
+
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args.
+set dummy ${ac_tool_prefix}strip; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_STRIP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$STRIP"; then
+  ac_cv_prog_STRIP="$STRIP" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_STRIP="${ac_tool_prefix}strip"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+STRIP=$ac_cv_prog_STRIP
+if test -n "$STRIP"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5
+$as_echo "$STRIP" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_STRIP"; then
+  ac_ct_STRIP=$STRIP
+  # Extract the first word of "strip", so it can be a program name with args.
+set dummy strip; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_STRIP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_STRIP"; then
+  ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_STRIP="strip"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP
+if test -n "$ac_ct_STRIP"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5
+$as_echo "$ac_ct_STRIP" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_STRIP" = x; then
+    STRIP=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    STRIP=$ac_ct_STRIP
+  fi
+else
+  STRIP="$ac_cv_prog_STRIP"
+fi
+
+test -z "$STRIP" && STRIP=:
+
+
+
+
+
+
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ranlib; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_RANLIB+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$RANLIB"; then
+  ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+RANLIB=$ac_cv_prog_RANLIB
+if test -n "$RANLIB"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
+$as_echo "$RANLIB" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_RANLIB"; then
+  ac_ct_RANLIB=$RANLIB
+  # Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_RANLIB+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_RANLIB"; then
+  ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_RANLIB="ranlib"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
+if test -n "$ac_ct_RANLIB"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
+$as_echo "$ac_ct_RANLIB" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_RANLIB" = x; then
+    RANLIB=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    RANLIB=$ac_ct_RANLIB
+  fi
+else
+  RANLIB="$ac_cv_prog_RANLIB"
+fi
+
+test -z "$RANLIB" && RANLIB=:
+
+
+
+
+
+
+# Determine commands to create old-style static archives.
+old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs'
+old_postinstall_cmds='chmod 644 $oldlib'
+old_postuninstall_cmds=
+
+if test -n "$RANLIB"; then
+  case $host_os in
+  bitrig* | openbsd*)
+    old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB -t \$tool_oldlib"
+    ;;
+  *)
+    old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB \$tool_oldlib"
+    ;;
+  esac
+  old_archive_cmds="$old_archive_cmds~\$RANLIB \$tool_oldlib"
+fi
+
+case $host_os in
+  darwin*)
+    lock_old_archive_extraction=yes ;;
+  *)
+    lock_old_archive_extraction=no ;;
+esac
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+for ac_prog in gawk mawk nawk awk
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_AWK+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$AWK"; then
+  ac_cv_prog_AWK="$AWK" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_AWK="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+AWK=$ac_cv_prog_AWK
+if test -n "$AWK"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AWK" >&5
+$as_echo "$AWK" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$AWK" && break
+done
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+# If no C compiler was specified, use CC.
+LTCC=${LTCC-"$CC"}
+
+# If no C compiler flags were specified, use CFLAGS.
+LTCFLAGS=${LTCFLAGS-"$CFLAGS"}
+
+# Allow CC to be a program name with arguments.
+compiler=$CC
+
+
+# Check for command to grab the raw symbol name followed by C symbol from nm.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking command to parse $NM output from $compiler object" >&5
+$as_echo_n "checking command to parse $NM output from $compiler object... " >&6; }
+if ${lt_cv_sys_global_symbol_pipe+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+
+# These are sane defaults that work on at least a few old systems.
+# [They come from Ultrix.  What could be older than Ultrix?!! ;)]
+
+# Character class describing NM global symbol codes.
+symcode='[BCDEGRST]'
+
+# Regexp to match symbols that can be accessed directly from C.
+sympat='\([_A-Za-z][_A-Za-z0-9]*\)'
+
+# Define system-specific variables.
+case $host_os in
+aix*)
+  symcode='[BCDT]'
+  ;;
+cygwin* | mingw* | pw32* | cegcc*)
+  symcode='[ABCDGISTW]'
+  ;;
+hpux*)
+  if test ia64 = "$host_cpu"; then
+    symcode='[ABCDEGRST]'
+  fi
+  ;;
+irix* | nonstopux*)
+  symcode='[BCDEGRST]'
+  ;;
+osf*)
+  symcode='[BCDEGQRST]'
+  ;;
+solaris*)
+  symcode='[BDRT]'
+  ;;
+sco3.2v5*)
+  symcode='[DT]'
+  ;;
+sysv4.2uw2*)
+  symcode='[DT]'
+  ;;
+sysv5* | sco5v6* | unixware* | OpenUNIX*)
+  symcode='[ABDT]'
+  ;;
+sysv4)
+  symcode='[DFNSTU]'
+  ;;
+esac
+
+# If we're using GNU nm, then use its standard symbol codes.
+case `$NM -V 2>&1` in
+*GNU* | *'with BFD'*)
+  symcode='[ABCDGIRSTW]' ;;
+esac
+
+if test "$lt_cv_nm_interface" = "MS dumpbin"; then
+  # Gets list of data symbols to import.
+  lt_cv_sys_global_symbol_to_import="sed -n -e 's/^I .* \(.*\)$/\1/p'"
+  # Adjust the below global symbol transforms to fixup imported variables.
+  lt_cdecl_hook=" -e 's/^I .* \(.*\)$/extern __declspec(dllimport) char \1;/p'"
+  lt_c_name_hook=" -e 's/^I .* \(.*\)$/  {\"\1\", (void *) 0},/p'"
+  lt_c_name_lib_hook="\
+  -e 's/^I .* \(lib.*\)$/  {\"\1\", (void *) 0},/p'\
+  -e 's/^I .* \(.*\)$/  {\"lib\1\", (void *) 0},/p'"
+else
+  # Disable hooks by default.
+  lt_cv_sys_global_symbol_to_import=
+  lt_cdecl_hook=
+  lt_c_name_hook=
+  lt_c_name_lib_hook=
+fi
+
+# Transform an extracted symbol line into a proper C declaration.
+# Some systems (esp. on ia64) link data and code symbols differently,
+# so use this general approach.
+lt_cv_sys_global_symbol_to_cdecl="sed -n"\
+$lt_cdecl_hook\
+" -e 's/^T .* \(.*\)$/extern int \1();/p'"\
+" -e 's/^$symcode$symcode* .* \(.*\)$/extern char \1;/p'"
+
+# Transform an extracted symbol line into symbol name and symbol address
+lt_cv_sys_global_symbol_to_c_name_address="sed -n"\
+$lt_c_name_hook\
+" -e 's/^: \(.*\) .*$/  {\"\1\", (void *) 0},/p'"\
+" -e 's/^$symcode$symcode* .* \(.*\)$/  {\"\1\", (void *) \&\1},/p'"
+
+# Transform an extracted symbol line into symbol name with lib prefix and
+# symbol address.
+lt_cv_sys_global_symbol_to_c_name_address_lib_prefix="sed -n"\
+$lt_c_name_lib_hook\
+" -e 's/^: \(.*\) .*$/  {\"\1\", (void *) 0},/p'"\
+" -e 's/^$symcode$symcode* .* \(lib.*\)$/  {\"\1\", (void *) \&\1},/p'"\
+" -e 's/^$symcode$symcode* .* \(.*\)$/  {\"lib\1\", (void *) \&\1},/p'"
+
+# Handle CRLF in mingw tool chain
+opt_cr=
+case $build_os in
+mingw*)
+  opt_cr=`$ECHO 'x\{0,1\}' | tr x '\015'` # option cr in regexp
+  ;;
+esac
+
+# Try without a prefix underscore, then with it.
+for ac_symprfx in "" "_"; do
+
+  # Transform symcode, sympat, and symprfx into a raw symbol and a C symbol.
+  symxfrm="\\1 $ac_symprfx\\2 \\2"
+
+  # Write the raw and C identifiers.
+  if test "$lt_cv_nm_interface" = "MS dumpbin"; then
+    # Fake it for dumpbin and say T for any non-static function,
+    # D for any global variable and I for any imported variable.
+    # Also find C++ and __fastcall symbols from MSVC++,
+    # which start with @ or ?.
+    lt_cv_sys_global_symbol_pipe="$AWK '"\
+"     {last_section=section; section=\$ 3};"\
+"     /^COFF SYMBOL TABLE/{for(i in hide) delete hide[i]};"\
+"     /Section length .*#relocs.*(pick any)/{hide[last_section]=1};"\
+"     /^ *Symbol name *: /{split(\$ 0,sn,\":\"); si=substr(sn[2],2)};"\
+"     /^ *Type *: code/{print \"T\",si,substr(si,length(prfx))};"\
+"     /^ *Type *: data/{print \"I\",si,substr(si,length(prfx))};"\
+"     \$ 0!~/External *\|/{next};"\
+"     / 0+ UNDEF /{next}; / UNDEF \([^|]\)*()/{next};"\
+"     {if(hide[section]) next};"\
+"     {f=\"D\"}; \$ 0~/\(\).*\|/{f=\"T\"};"\
+"     {split(\$ 0,a,/\||\r/); split(a[2],s)};"\
+"     s[1]~/^[@?]/{print f,s[1],s[1]; next};"\
+"     s[1]~prfx {split(s[1],t,\"@\"); print f,t[1],substr(t[1],length(prfx))}"\
+"     ' prfx=^$ac_symprfx"
+  else
+    lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[	 ]\($symcode$symcode*\)[	 ][	 ]*$ac_symprfx$sympat$opt_cr$/$symxfrm/p'"
+  fi
+  lt_cv_sys_global_symbol_pipe="$lt_cv_sys_global_symbol_pipe | sed '/ __gnu_lto/d'"
+
+  # Check to see that the pipe works correctly.
+  pipe_works=no
+
+  rm -f conftest*
+  cat > conftest.$ac_ext <<_LT_EOF
+#ifdef __cplusplus
+extern "C" {
+#endif
+char nm_test_var;
+void nm_test_func(void);
+void nm_test_func(void){}
+#ifdef __cplusplus
+}
+#endif
+int main(){nm_test_var='a';nm_test_func();return(0);}
+_LT_EOF
+
+  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
+  (eval $ac_compile) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then
+    # Now try to grab the symbols.
+    nlist=conftest.nm
+    if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist\""; } >&5
+  (eval $NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && test -s "$nlist"; then
+      # Try sorting and uniquifying the output.
+      if sort "$nlist" | uniq > "$nlist"T; then
+	mv -f "$nlist"T "$nlist"
+      else
+	rm -f "$nlist"T
+      fi
+
+      # Make sure that we snagged all the symbols we need.
+      if $GREP ' nm_test_var$' "$nlist" >/dev/null; then
+	if $GREP ' nm_test_func$' "$nlist" >/dev/null; then
+	  cat <<_LT_EOF > conftest.$ac_ext
+/* Keep this code in sync between libtool.m4, ltmain, lt_system.h, and tests.  */
+#if defined _WIN32 || defined __CYGWIN__ || defined _WIN32_WCE
+/* DATA imports from DLLs on WIN32 can't be const, because runtime
+   relocations are performed -- see ld's documentation on pseudo-relocs.  */
+# define LT_DLSYM_CONST
+#elif defined __osf__
+/* This system does not cope well with relocations in const data.  */
+# define LT_DLSYM_CONST
+#else
+# define LT_DLSYM_CONST const
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+_LT_EOF
+	  # Now generate the symbol file.
+	  eval "$lt_cv_sys_global_symbol_to_cdecl"' < "$nlist" | $GREP -v main >> conftest.$ac_ext'
+
+	  cat <<_LT_EOF >> conftest.$ac_ext
+
+/* The mapping between symbol names and symbols.  */
+LT_DLSYM_CONST struct {
+  const char *name;
+  void       *address;
+}
+lt__PROGRAM__LTX_preloaded_symbols[] =
+{
+  { "@PROGRAM@", (void *) 0 },
+_LT_EOF
+	  $SED "s/^$symcode$symcode* .* \(.*\)$/  {\"\1\", (void *) \&\1},/" < "$nlist" | $GREP -v main >> conftest.$ac_ext
+	  cat <<\_LT_EOF >> conftest.$ac_ext
+  {0, (void *) 0}
+};
+
+/* This works around a problem in FreeBSD linker */
+#ifdef FREEBSD_WORKAROUND
+static const void *lt_preloaded_setup() {
+  return lt__PROGRAM__LTX_preloaded_symbols;
+}
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+_LT_EOF
+	  # Now try linking the two files.
+	  mv conftest.$ac_objext conftstm.$ac_objext
+	  lt_globsym_save_LIBS=$LIBS
+	  lt_globsym_save_CFLAGS=$CFLAGS
+	  LIBS=conftstm.$ac_objext
+	  CFLAGS="$CFLAGS$lt_prog_compiler_no_builtin_flag"
+	  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5
+  (eval $ac_link) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && test -s conftest$ac_exeext; then
+	    pipe_works=yes
+	  fi
+	  LIBS=$lt_globsym_save_LIBS
+	  CFLAGS=$lt_globsym_save_CFLAGS
+	else
+	  echo "cannot find nm_test_func in $nlist" >&5
+	fi
+      else
+	echo "cannot find nm_test_var in $nlist" >&5
+      fi
+    else
+      echo "cannot run $lt_cv_sys_global_symbol_pipe" >&5
+    fi
+  else
+    echo "$progname: failed program was:" >&5
+    cat conftest.$ac_ext >&5
+  fi
+  rm -rf conftest* conftst*
+
+  # Do not use the global_symbol_pipe unless it works.
+  if test yes = "$pipe_works"; then
+    break
+  else
+    lt_cv_sys_global_symbol_pipe=
+  fi
+done
+
+fi
+
+if test -z "$lt_cv_sys_global_symbol_pipe"; then
+  lt_cv_sys_global_symbol_to_cdecl=
+fi
+if test -z "$lt_cv_sys_global_symbol_pipe$lt_cv_sys_global_symbol_to_cdecl"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: failed" >&5
+$as_echo "failed" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5
+$as_echo "ok" >&6; }
+fi
+
+# Response file support.
+if test "$lt_cv_nm_interface" = "MS dumpbin"; then
+  nm_file_list_spec='@'
+elif $NM --help 2>/dev/null | grep '[@]FILE' >/dev/null; then
+  nm_file_list_spec='@'
+fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sysroot" >&5
+$as_echo_n "checking for sysroot... " >&6; }
+
+# Check whether --with-sysroot was given.
+if test "${with_sysroot+set}" = set; then :
+  withval=$with_sysroot;
+else
+  with_sysroot=no
+fi
+
+
+lt_sysroot=
+case $with_sysroot in #(
+ yes)
+   if test yes = "$GCC"; then
+     lt_sysroot=`$CC --print-sysroot 2>/dev/null`
+   fi
+   ;; #(
+ /*)
+   lt_sysroot=`echo "$with_sysroot" | sed -e "$sed_quote_subst"`
+   ;; #(
+ no|'')
+   ;; #(
+ *)
+   { $as_echo "$as_me:${as_lineno-$LINENO}: result: $with_sysroot" >&5
+$as_echo "$with_sysroot" >&6; }
+   as_fn_error $? "The sysroot must be an absolute path." "$LINENO" 5
+   ;;
+esac
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${lt_sysroot:-no}" >&5
+$as_echo "${lt_sysroot:-no}" >&6; }
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a working dd" >&5
+$as_echo_n "checking for a working dd... " >&6; }
+if ${ac_cv_path_lt_DD+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  printf 0123456789abcdef0123456789abcdef >conftest.i
+cat conftest.i conftest.i >conftest2.i
+: ${lt_DD:=$DD}
+if test -z "$lt_DD"; then
+  ac_path_lt_DD_found=false
+  # Loop through the user's path and test for each of PROGNAME-LIST
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in dd; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      ac_path_lt_DD="$as_dir/$ac_prog$ac_exec_ext"
+      as_fn_executable_p "$ac_path_lt_DD" || continue
+if "$ac_path_lt_DD" bs=32 count=1 conftest.out 2>/dev/null; then
+  cmp -s conftest.i conftest.out \
+  && ac_cv_path_lt_DD="$ac_path_lt_DD" ac_path_lt_DD_found=:
+fi
+      $ac_path_lt_DD_found && break 3
+    done
+  done
+  done
+IFS=$as_save_IFS
+  if test -z "$ac_cv_path_lt_DD"; then
+    :
+  fi
+else
+  ac_cv_path_lt_DD=$lt_DD
+fi
+
+rm -f conftest.i conftest2.i conftest.out
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_lt_DD" >&5
+$as_echo "$ac_cv_path_lt_DD" >&6; }
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to truncate binary pipes" >&5
+$as_echo_n "checking how to truncate binary pipes... " >&6; }
+if ${lt_cv_truncate_bin+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  printf 0123456789abcdef0123456789abcdef >conftest.i
+cat conftest.i conftest.i >conftest2.i
+lt_cv_truncate_bin=
+if "$ac_cv_path_lt_DD" bs=32 count=1 conftest.out 2>/dev/null; then
+  cmp -s conftest.i conftest.out \
+  && lt_cv_truncate_bin="$ac_cv_path_lt_DD bs=4096 count=1"
+fi
+rm -f conftest.i conftest2.i conftest.out
+test -z "$lt_cv_truncate_bin" && lt_cv_truncate_bin="$SED -e 4q"
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_truncate_bin" >&5
+$as_echo "$lt_cv_truncate_bin" >&6; }
+
+
+
+
+
+
+
+# Calculate cc_basename.  Skip known compiler wrappers and cross-prefix.
+func_cc_basename ()
+{
+    for cc_temp in $*""; do
+      case $cc_temp in
+        compile | *[\\/]compile | ccache | *[\\/]ccache ) ;;
+        distcc | *[\\/]distcc | purify | *[\\/]purify ) ;;
+        \-*) ;;
+        *) break;;
+      esac
+    done
+    func_cc_basename_result=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"`
+}
+
+# Check whether --enable-libtool-lock was given.
+if test "${enable_libtool_lock+set}" = set; then :
+  enableval=$enable_libtool_lock;
+fi
+
+test no = "$enable_libtool_lock" || enable_libtool_lock=yes
+
+# Some flags need to be propagated to the compiler or linker for good
+# libtool support.
+case $host in
+ia64-*-hpux*)
+  # Find out what ABI is being produced by ac_compile, and set mode
+  # options accordingly.
+  echo 'int i;' > conftest.$ac_ext
+  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
+  (eval $ac_compile) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then
+    case `/usr/bin/file conftest.$ac_objext` in
+      *ELF-32*)
+	HPUX_IA64_MODE=32
+	;;
+      *ELF-64*)
+	HPUX_IA64_MODE=64
+	;;
+    esac
+  fi
+  rm -rf conftest*
+  ;;
+*-*-irix6*)
+  # Find out what ABI is being produced by ac_compile, and set linker
+  # options accordingly.
+  echo '#line '$LINENO' "configure"' > conftest.$ac_ext
+  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
+  (eval $ac_compile) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then
+    if test yes = "$lt_cv_prog_gnu_ld"; then
+      case `/usr/bin/file conftest.$ac_objext` in
+	*32-bit*)
+	  LD="${LD-ld} -melf32bsmip"
+	  ;;
+	*N32*)
+	  LD="${LD-ld} -melf32bmipn32"
+	  ;;
+	*64-bit*)
+	  LD="${LD-ld} -melf64bmip"
+	;;
+      esac
+    else
+      case `/usr/bin/file conftest.$ac_objext` in
+	*32-bit*)
+	  LD="${LD-ld} -32"
+	  ;;
+	*N32*)
+	  LD="${LD-ld} -n32"
+	  ;;
+	*64-bit*)
+	  LD="${LD-ld} -64"
+	  ;;
+      esac
+    fi
+  fi
+  rm -rf conftest*
+  ;;
+
+mips64*-*linux*)
+  # Find out what ABI is being produced by ac_compile, and set linker
+  # options accordingly.
+  echo '#line '$LINENO' "configure"' > conftest.$ac_ext
+  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
+  (eval $ac_compile) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then
+    emul=elf
+    case `/usr/bin/file conftest.$ac_objext` in
+      *32-bit*)
+	emul="${emul}32"
+	;;
+      *64-bit*)
+	emul="${emul}64"
+	;;
+    esac
+    case `/usr/bin/file conftest.$ac_objext` in
+      *MSB*)
+	emul="${emul}btsmip"
+	;;
+      *LSB*)
+	emul="${emul}ltsmip"
+	;;
+    esac
+    case `/usr/bin/file conftest.$ac_objext` in
+      *N32*)
+	emul="${emul}n32"
+	;;
+    esac
+    LD="${LD-ld} -m $emul"
+  fi
+  rm -rf conftest*
+  ;;
+
+x86_64-*kfreebsd*-gnu|x86_64-*linux*|powerpc*-*linux*| \
+s390*-*linux*|s390*-*tpf*|sparc*-*linux*)
+  # Find out what ABI is being produced by ac_compile, and set linker
+  # options accordingly.  Note that the listed cases only cover the
+  # situations where additional linker options are needed (such as when
+  # doing 32-bit compilation for a host where ld defaults to 64-bit, or
+  # vice versa); the common cases where no linker options are needed do
+  # not appear in the list.
+  echo 'int i;' > conftest.$ac_ext
+  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
+  (eval $ac_compile) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then
+    case `/usr/bin/file conftest.o` in
+      *32-bit*)
+	case $host in
+	  x86_64-*kfreebsd*-gnu)
+	    LD="${LD-ld} -m elf_i386_fbsd"
+	    ;;
+	  x86_64-*linux*)
+	    case `/usr/bin/file conftest.o` in
+	      *x86-64*)
+		LD="${LD-ld} -m elf32_x86_64"
+		;;
+	      *)
+		LD="${LD-ld} -m elf_i386"
+		;;
+	    esac
+	    ;;
+	  powerpc64le-*linux*)
+	    LD="${LD-ld} -m elf32lppclinux"
+	    ;;
+	  powerpc64-*linux*)
+	    LD="${LD-ld} -m elf32ppclinux"
+	    ;;
+	  s390x-*linux*)
+	    LD="${LD-ld} -m elf_s390"
+	    ;;
+	  sparc64-*linux*)
+	    LD="${LD-ld} -m elf32_sparc"
+	    ;;
+	esac
+	;;
+      *64-bit*)
+	case $host in
+	  x86_64-*kfreebsd*-gnu)
+	    LD="${LD-ld} -m elf_x86_64_fbsd"
+	    ;;
+	  x86_64-*linux*)
+	    LD="${LD-ld} -m elf_x86_64"
+	    ;;
+	  powerpcle-*linux*)
+	    LD="${LD-ld} -m elf64lppc"
+	    ;;
+	  powerpc-*linux*)
+	    LD="${LD-ld} -m elf64ppc"
+	    ;;
+	  s390*-*linux*|s390*-*tpf*)
+	    LD="${LD-ld} -m elf64_s390"
+	    ;;
+	  sparc*-*linux*)
+	    LD="${LD-ld} -m elf64_sparc"
+	    ;;
+	esac
+	;;
+    esac
+  fi
+  rm -rf conftest*
+  ;;
+
+*-*-sco3.2v5*)
+  # On SCO OpenServer 5, we need -belf to get full-featured binaries.
+  SAVE_CFLAGS=$CFLAGS
+  CFLAGS="$CFLAGS -belf"
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler needs -belf" >&5
+$as_echo_n "checking whether the C compiler needs -belf... " >&6; }
+if ${lt_cv_cc_needs_belf+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+     cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  lt_cv_cc_needs_belf=yes
+else
+  lt_cv_cc_needs_belf=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+     ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_cc_needs_belf" >&5
+$as_echo "$lt_cv_cc_needs_belf" >&6; }
+  if test yes != "$lt_cv_cc_needs_belf"; then
+    # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf
+    CFLAGS=$SAVE_CFLAGS
+  fi
+  ;;
+*-*solaris*)
+  # Find out what ABI is being produced by ac_compile, and set linker
+  # options accordingly.
+  echo 'int i;' > conftest.$ac_ext
+  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
+  (eval $ac_compile) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then
+    case `/usr/bin/file conftest.o` in
+    *64-bit*)
+      case $lt_cv_prog_gnu_ld in
+      yes*)
+        case $host in
+        i?86-*-solaris*|x86_64-*-solaris*)
+          LD="${LD-ld} -m elf_x86_64"
+          ;;
+        sparc*-*-solaris*)
+          LD="${LD-ld} -m elf64_sparc"
+          ;;
+        esac
+        # GNU ld 2.21 introduced _sol2 emulations.  Use them if available.
+        if ${LD-ld} -V | grep _sol2 >/dev/null 2>&1; then
+          LD=${LD-ld}_sol2
+        fi
+        ;;
+      *)
+	if ${LD-ld} -64 -r -o conftest2.o conftest.o >/dev/null 2>&1; then
+	  LD="${LD-ld} -64"
+	fi
+	;;
+      esac
+      ;;
+    esac
+  fi
+  rm -rf conftest*
+  ;;
+esac
+
+need_locks=$enable_libtool_lock
+
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}mt", so it can be a program name with args.
+set dummy ${ac_tool_prefix}mt; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_MANIFEST_TOOL+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$MANIFEST_TOOL"; then
+  ac_cv_prog_MANIFEST_TOOL="$MANIFEST_TOOL" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_MANIFEST_TOOL="${ac_tool_prefix}mt"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+MANIFEST_TOOL=$ac_cv_prog_MANIFEST_TOOL
+if test -n "$MANIFEST_TOOL"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MANIFEST_TOOL" >&5
+$as_echo "$MANIFEST_TOOL" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_MANIFEST_TOOL"; then
+  ac_ct_MANIFEST_TOOL=$MANIFEST_TOOL
+  # Extract the first word of "mt", so it can be a program name with args.
+set dummy mt; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_MANIFEST_TOOL+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_MANIFEST_TOOL"; then
+  ac_cv_prog_ac_ct_MANIFEST_TOOL="$ac_ct_MANIFEST_TOOL" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_MANIFEST_TOOL="mt"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_MANIFEST_TOOL=$ac_cv_prog_ac_ct_MANIFEST_TOOL
+if test -n "$ac_ct_MANIFEST_TOOL"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_MANIFEST_TOOL" >&5
+$as_echo "$ac_ct_MANIFEST_TOOL" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_MANIFEST_TOOL" = x; then
+    MANIFEST_TOOL=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    MANIFEST_TOOL=$ac_ct_MANIFEST_TOOL
+  fi
+else
+  MANIFEST_TOOL="$ac_cv_prog_MANIFEST_TOOL"
+fi
+
+test -z "$MANIFEST_TOOL" && MANIFEST_TOOL=mt
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $MANIFEST_TOOL is a manifest tool" >&5
+$as_echo_n "checking if $MANIFEST_TOOL is a manifest tool... " >&6; }
+if ${lt_cv_path_mainfest_tool+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_path_mainfest_tool=no
+  echo "$as_me:$LINENO: $MANIFEST_TOOL '-?'" >&5
+  $MANIFEST_TOOL '-?' 2>conftest.err > conftest.out
+  cat conftest.err >&5
+  if $GREP 'Manifest Tool' conftest.out > /dev/null; then
+    lt_cv_path_mainfest_tool=yes
+  fi
+  rm -f conftest*
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_path_mainfest_tool" >&5
+$as_echo "$lt_cv_path_mainfest_tool" >&6; }
+if test yes != "$lt_cv_path_mainfest_tool"; then
+  MANIFEST_TOOL=:
+fi
+
+
+
+
+
+
+  case $host_os in
+    rhapsody* | darwin*)
+    if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}dsymutil", so it can be a program name with args.
+set dummy ${ac_tool_prefix}dsymutil; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_DSYMUTIL+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$DSYMUTIL"; then
+  ac_cv_prog_DSYMUTIL="$DSYMUTIL" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_DSYMUTIL="${ac_tool_prefix}dsymutil"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+DSYMUTIL=$ac_cv_prog_DSYMUTIL
+if test -n "$DSYMUTIL"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DSYMUTIL" >&5
+$as_echo "$DSYMUTIL" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_DSYMUTIL"; then
+  ac_ct_DSYMUTIL=$DSYMUTIL
+  # Extract the first word of "dsymutil", so it can be a program name with args.
+set dummy dsymutil; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_DSYMUTIL+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_DSYMUTIL"; then
+  ac_cv_prog_ac_ct_DSYMUTIL="$ac_ct_DSYMUTIL" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_DSYMUTIL="dsymutil"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_DSYMUTIL=$ac_cv_prog_ac_ct_DSYMUTIL
+if test -n "$ac_ct_DSYMUTIL"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DSYMUTIL" >&5
+$as_echo "$ac_ct_DSYMUTIL" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_DSYMUTIL" = x; then
+    DSYMUTIL=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    DSYMUTIL=$ac_ct_DSYMUTIL
+  fi
+else
+  DSYMUTIL="$ac_cv_prog_DSYMUTIL"
+fi
+
+    if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}nmedit", so it can be a program name with args.
+set dummy ${ac_tool_prefix}nmedit; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_NMEDIT+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$NMEDIT"; then
+  ac_cv_prog_NMEDIT="$NMEDIT" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_NMEDIT="${ac_tool_prefix}nmedit"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+NMEDIT=$ac_cv_prog_NMEDIT
+if test -n "$NMEDIT"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $NMEDIT" >&5
+$as_echo "$NMEDIT" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_NMEDIT"; then
+  ac_ct_NMEDIT=$NMEDIT
+  # Extract the first word of "nmedit", so it can be a program name with args.
+set dummy nmedit; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_NMEDIT+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_NMEDIT"; then
+  ac_cv_prog_ac_ct_NMEDIT="$ac_ct_NMEDIT" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_NMEDIT="nmedit"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_NMEDIT=$ac_cv_prog_ac_ct_NMEDIT
+if test -n "$ac_ct_NMEDIT"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_NMEDIT" >&5
+$as_echo "$ac_ct_NMEDIT" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_NMEDIT" = x; then
+    NMEDIT=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    NMEDIT=$ac_ct_NMEDIT
+  fi
+else
+  NMEDIT="$ac_cv_prog_NMEDIT"
+fi
+
+    if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}lipo", so it can be a program name with args.
+set dummy ${ac_tool_prefix}lipo; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_LIPO+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$LIPO"; then
+  ac_cv_prog_LIPO="$LIPO" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_LIPO="${ac_tool_prefix}lipo"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+LIPO=$ac_cv_prog_LIPO
+if test -n "$LIPO"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIPO" >&5
+$as_echo "$LIPO" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_LIPO"; then
+  ac_ct_LIPO=$LIPO
+  # Extract the first word of "lipo", so it can be a program name with args.
+set dummy lipo; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_LIPO+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_LIPO"; then
+  ac_cv_prog_ac_ct_LIPO="$ac_ct_LIPO" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_LIPO="lipo"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_LIPO=$ac_cv_prog_ac_ct_LIPO
+if test -n "$ac_ct_LIPO"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_LIPO" >&5
+$as_echo "$ac_ct_LIPO" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_LIPO" = x; then
+    LIPO=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    LIPO=$ac_ct_LIPO
+  fi
+else
+  LIPO="$ac_cv_prog_LIPO"
+fi
+
+    if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}otool", so it can be a program name with args.
+set dummy ${ac_tool_prefix}otool; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_OTOOL+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$OTOOL"; then
+  ac_cv_prog_OTOOL="$OTOOL" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_OTOOL="${ac_tool_prefix}otool"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+OTOOL=$ac_cv_prog_OTOOL
+if test -n "$OTOOL"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL" >&5
+$as_echo "$OTOOL" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_OTOOL"; then
+  ac_ct_OTOOL=$OTOOL
+  # Extract the first word of "otool", so it can be a program name with args.
+set dummy otool; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_OTOOL+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_OTOOL"; then
+  ac_cv_prog_ac_ct_OTOOL="$ac_ct_OTOOL" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_OTOOL="otool"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_OTOOL=$ac_cv_prog_ac_ct_OTOOL
+if test -n "$ac_ct_OTOOL"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL" >&5
+$as_echo "$ac_ct_OTOOL" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_OTOOL" = x; then
+    OTOOL=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    OTOOL=$ac_ct_OTOOL
+  fi
+else
+  OTOOL="$ac_cv_prog_OTOOL"
+fi
+
+    if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}otool64", so it can be a program name with args.
+set dummy ${ac_tool_prefix}otool64; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_OTOOL64+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$OTOOL64"; then
+  ac_cv_prog_OTOOL64="$OTOOL64" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_OTOOL64="${ac_tool_prefix}otool64"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+OTOOL64=$ac_cv_prog_OTOOL64
+if test -n "$OTOOL64"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL64" >&5
+$as_echo "$OTOOL64" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_OTOOL64"; then
+  ac_ct_OTOOL64=$OTOOL64
+  # Extract the first word of "otool64", so it can be a program name with args.
+set dummy otool64; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_OTOOL64+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_OTOOL64"; then
+  ac_cv_prog_ac_ct_OTOOL64="$ac_ct_OTOOL64" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_OTOOL64="otool64"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_OTOOL64=$ac_cv_prog_ac_ct_OTOOL64
+if test -n "$ac_ct_OTOOL64"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL64" >&5
+$as_echo "$ac_ct_OTOOL64" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_OTOOL64" = x; then
+    OTOOL64=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    OTOOL64=$ac_ct_OTOOL64
+  fi
+else
+  OTOOL64="$ac_cv_prog_OTOOL64"
+fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -single_module linker flag" >&5
+$as_echo_n "checking for -single_module linker flag... " >&6; }
+if ${lt_cv_apple_cc_single_mod+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_apple_cc_single_mod=no
+      if test -z "$LT_MULTI_MODULE"; then
+	# By default we will add the -single_module flag. You can override
+	# by either setting the environment variable LT_MULTI_MODULE
+	# non-empty at configure time, or by adding -multi_module to the
+	# link flags.
+	rm -rf libconftest.dylib*
+	echo "int foo(void){return 1;}" > conftest.c
+	echo "$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \
+-dynamiclib -Wl,-single_module conftest.c" >&5
+	$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \
+	  -dynamiclib -Wl,-single_module conftest.c 2>conftest.err
+        _lt_result=$?
+	# If there is a non-empty error log, and "single_module"
+	# appears in it, assume the flag caused a linker warning
+        if test -s conftest.err && $GREP single_module conftest.err; then
+	  cat conftest.err >&5
+	# Otherwise, if the output was created with a 0 exit code from
+	# the compiler, it worked.
+	elif test -f libconftest.dylib && test 0 = "$_lt_result"; then
+	  lt_cv_apple_cc_single_mod=yes
+	else
+	  cat conftest.err >&5
+	fi
+	rm -rf libconftest.dylib*
+	rm -f conftest.*
+      fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_apple_cc_single_mod" >&5
+$as_echo "$lt_cv_apple_cc_single_mod" >&6; }
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -exported_symbols_list linker flag" >&5
+$as_echo_n "checking for -exported_symbols_list linker flag... " >&6; }
+if ${lt_cv_ld_exported_symbols_list+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_ld_exported_symbols_list=no
+      save_LDFLAGS=$LDFLAGS
+      echo "_main" > conftest.sym
+      LDFLAGS="$LDFLAGS -Wl,-exported_symbols_list,conftest.sym"
+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  lt_cv_ld_exported_symbols_list=yes
+else
+  lt_cv_ld_exported_symbols_list=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+	LDFLAGS=$save_LDFLAGS
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_exported_symbols_list" >&5
+$as_echo "$lt_cv_ld_exported_symbols_list" >&6; }
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -force_load linker flag" >&5
+$as_echo_n "checking for -force_load linker flag... " >&6; }
+if ${lt_cv_ld_force_load+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_ld_force_load=no
+      cat > conftest.c << _LT_EOF
+int forced_loaded() { return 2;}
+_LT_EOF
+      echo "$LTCC $LTCFLAGS -c -o conftest.o conftest.c" >&5
+      $LTCC $LTCFLAGS -c -o conftest.o conftest.c 2>&5
+      echo "$AR cru libconftest.a conftest.o" >&5
+      $AR cru libconftest.a conftest.o 2>&5
+      echo "$RANLIB libconftest.a" >&5
+      $RANLIB libconftest.a 2>&5
+      cat > conftest.c << _LT_EOF
+int main() { return 0;}
+_LT_EOF
+      echo "$LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a" >&5
+      $LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a 2>conftest.err
+      _lt_result=$?
+      if test -s conftest.err && $GREP force_load conftest.err; then
+	cat conftest.err >&5
+      elif test -f conftest && test 0 = "$_lt_result" && $GREP forced_load conftest >/dev/null 2>&1; then
+	lt_cv_ld_force_load=yes
+      else
+	cat conftest.err >&5
+      fi
+        rm -f conftest.err libconftest.a conftest conftest.c
+        rm -rf conftest.dSYM
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_force_load" >&5
+$as_echo "$lt_cv_ld_force_load" >&6; }
+    case $host_os in
+    rhapsody* | darwin1.[012])
+      _lt_dar_allow_undefined='$wl-undefined ${wl}suppress' ;;
+    darwin1.*)
+      _lt_dar_allow_undefined='$wl-flat_namespace $wl-undefined ${wl}suppress' ;;
+    darwin*) # darwin 5.x on
+      # if running on 10.5 or later, the deployment target defaults
+      # to the OS version, if on x86, and 10.4, the deployment
+      # target defaults to 10.4. Don't you love it?
+      case ${MACOSX_DEPLOYMENT_TARGET-10.0},$host in
+	10.0,*86*-darwin8*|10.0,*-darwin[91]*)
+	  _lt_dar_allow_undefined='$wl-undefined ${wl}dynamic_lookup' ;;
+	10.[012][,.]*)
+	  _lt_dar_allow_undefined='$wl-flat_namespace $wl-undefined ${wl}suppress' ;;
+	10.*)
+	  _lt_dar_allow_undefined='$wl-undefined ${wl}dynamic_lookup' ;;
+      esac
+    ;;
+  esac
+    if test yes = "$lt_cv_apple_cc_single_mod"; then
+      _lt_dar_single_mod='$single_module'
+    fi
+    if test yes = "$lt_cv_ld_exported_symbols_list"; then
+      _lt_dar_export_syms=' $wl-exported_symbols_list,$output_objdir/$libname-symbols.expsym'
+    else
+      _lt_dar_export_syms='~$NMEDIT -s $output_objdir/$libname-symbols.expsym $lib'
+    fi
+    if test : != "$DSYMUTIL" && test no = "$lt_cv_ld_force_load"; then
+      _lt_dsymutil='~$DSYMUTIL $lib || :'
+    else
+      _lt_dsymutil=
+    fi
+    ;;
+  esac
+
+# func_munge_path_list VARIABLE PATH
+# -----------------------------------
+# VARIABLE is name of variable containing _space_ separated list of
+# directories to be munged by the contents of PATH, which is string
+# having a format:
+# "DIR[:DIR]:"
+#       string "DIR[ DIR]" will be prepended to VARIABLE
+# ":DIR[:DIR]"
+#       string "DIR[ DIR]" will be appended to VARIABLE
+# "DIRP[:DIRP]::[DIRA:]DIRA"
+#       string "DIRP[ DIRP]" will be prepended to VARIABLE and string
+#       "DIRA[ DIRA]" will be appended to VARIABLE
+# "DIR[:DIR]"
+#       VARIABLE will be replaced by "DIR[ DIR]"
+func_munge_path_list ()
+{
+    case x$2 in
+    x)
+        ;;
+    *:)
+        eval $1=\"`$ECHO $2 | $SED 's/:/ /g'` \$$1\"
+        ;;
+    x:*)
+        eval $1=\"\$$1 `$ECHO $2 | $SED 's/:/ /g'`\"
+        ;;
+    *::*)
+        eval $1=\"\$$1\ `$ECHO $2 | $SED -e 's/.*:://' -e 's/:/ /g'`\"
+        eval $1=\"`$ECHO $2 | $SED -e 's/::.*//' -e 's/:/ /g'`\ \$$1\"
+        ;;
+    *)
+        eval $1=\"`$ECHO $2 | $SED 's/:/ /g'`\"
+        ;;
+    esac
+}
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
+$as_echo_n "checking how to run the C preprocessor... " >&6; }
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+  CPP=
+fi
+if test -z "$CPP"; then
+  if ${ac_cv_prog_CPP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+      # Double quotes because CPP needs to be expanded
+    for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
+    do
+      ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+  # Use a header file that comes with gcc, so configuring glibc
+  # with a fresh cross-compiler works.
+  # Prefer  to  if __STDC__ is defined, since
+  #  exists even on freestanding compilers.
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp. "Syntax error" is here to catch this case.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifdef __STDC__
+# include 
+#else
+# include 
+#endif
+		     Syntax error
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+
+else
+  # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+  # OK, works on sane cases.  Now check whether nonexistent headers
+  # can be detected and how.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+  # Broken: success on invalid input.
+continue
+else
+  # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.i conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+  break
+fi
+
+    done
+    ac_cv_prog_CPP=$CPP
+
+fi
+  CPP=$ac_cv_prog_CPP
+else
+  ac_cv_prog_CPP=$CPP
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
+$as_echo "$CPP" >&6; }
+ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+  # Use a header file that comes with gcc, so configuring glibc
+  # with a fresh cross-compiler works.
+  # Prefer  to  if __STDC__ is defined, since
+  #  exists even on freestanding compilers.
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp. "Syntax error" is here to catch this case.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifdef __STDC__
+# include 
+#else
+# include 
+#endif
+		     Syntax error
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+
+else
+  # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+  # OK, works on sane cases.  Now check whether nonexistent headers
+  # can be detected and how.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+  # Broken: success on invalid input.
+continue
+else
+  # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.i conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+
+else
+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details" "$LINENO" 5; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
+$as_echo_n "checking for ANSI C header files... " >&6; }
+if ${ac_cv_header_stdc+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+#include 
+#include 
+#include 
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_header_stdc=yes
+else
+  ac_cv_header_stdc=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+if test $ac_cv_header_stdc = yes; then
+  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "memchr" >/dev/null 2>&1; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "free" >/dev/null 2>&1; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+  if test "$cross_compiling" = yes; then :
+  :
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+#include 
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) \
+		   (('a' <= (c) && (c) <= 'i') \
+		     || ('j' <= (c) && (c) <= 'r') \
+		     || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
+#endif
+
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int
+main ()
+{
+  int i;
+  for (i = 0; i < 256; i++)
+    if (XOR (islower (i), ISLOWER (i))
+	|| toupper (i) != TOUPPER (i))
+      return 2;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+  conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
+$as_echo "$ac_cv_header_stdc" >&6; }
+if test $ac_cv_header_stdc = yes; then
+
+$as_echo "#define STDC_HEADERS 1" >>confdefs.h
+
+fi
+
+# On IRIX 5.3, sys/types and inttypes.h are conflicting.
+for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
+		  inttypes.h stdint.h unistd.h
+do :
+  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
+"
+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
+  cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
+for ac_header in dlfcn.h
+do :
+  ac_fn_c_check_header_compile "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default
+"
+if test "x$ac_cv_header_dlfcn_h" = xyes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_DLFCN_H 1
+_ACEOF
+
+fi
+
+done
+
+
+
+
+
+# Set options
+
+
+
+        enable_dlopen=no
+
+
+  enable_win32_dll=no
+
+
+            # Check whether --enable-shared was given.
+if test "${enable_shared+set}" = set; then :
+  enableval=$enable_shared; p=${PACKAGE-default}
+    case $enableval in
+    yes) enable_shared=yes ;;
+    no) enable_shared=no ;;
+    *)
+      enable_shared=no
+      # Look at the argument we got.  We use all the common list separators.
+      lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR,
+      for pkg in $enableval; do
+	IFS=$lt_save_ifs
+	if test "X$pkg" = "X$p"; then
+	  enable_shared=yes
+	fi
+      done
+      IFS=$lt_save_ifs
+      ;;
+    esac
+else
+  enable_shared=yes
+fi
+
+
+
+
+
+
+
+
+
+  # Check whether --enable-static was given.
+if test "${enable_static+set}" = set; then :
+  enableval=$enable_static; p=${PACKAGE-default}
+    case $enableval in
+    yes) enable_static=yes ;;
+    no) enable_static=no ;;
+    *)
+     enable_static=no
+      # Look at the argument we got.  We use all the common list separators.
+      lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR,
+      for pkg in $enableval; do
+	IFS=$lt_save_ifs
+	if test "X$pkg" = "X$p"; then
+	  enable_static=yes
+	fi
+      done
+      IFS=$lt_save_ifs
+      ;;
+    esac
+else
+  enable_static=yes
+fi
+
+
+
+
+
+
+
+
+
+
+# Check whether --with-pic was given.
+if test "${with_pic+set}" = set; then :
+  withval=$with_pic; lt_p=${PACKAGE-default}
+    case $withval in
+    yes|no) pic_mode=$withval ;;
+    *)
+      pic_mode=default
+      # Look at the argument we got.  We use all the common list separators.
+      lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR,
+      for lt_pkg in $withval; do
+	IFS=$lt_save_ifs
+	if test "X$lt_pkg" = "X$lt_p"; then
+	  pic_mode=yes
+	fi
+      done
+      IFS=$lt_save_ifs
+      ;;
+    esac
+else
+  pic_mode=default
+fi
+
+
+
+
+
+
+
+
+  # Check whether --enable-fast-install was given.
+if test "${enable_fast_install+set}" = set; then :
+  enableval=$enable_fast_install; p=${PACKAGE-default}
+    case $enableval in
+    yes) enable_fast_install=yes ;;
+    no) enable_fast_install=no ;;
+    *)
+      enable_fast_install=no
+      # Look at the argument we got.  We use all the common list separators.
+      lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR,
+      for pkg in $enableval; do
+	IFS=$lt_save_ifs
+	if test "X$pkg" = "X$p"; then
+	  enable_fast_install=yes
+	fi
+      done
+      IFS=$lt_save_ifs
+      ;;
+    esac
+else
+  enable_fast_install=yes
+fi
+
+
+
+
+
+
+
+
+  shared_archive_member_spec=
+case $host,$enable_shared in
+power*-*-aix[5-9]*,yes)
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking which variant of shared library versioning to provide" >&5
+$as_echo_n "checking which variant of shared library versioning to provide... " >&6; }
+
+# Check whether --with-aix-soname was given.
+if test "${with_aix_soname+set}" = set; then :
+  withval=$with_aix_soname; case $withval in
+    aix|svr4|both)
+      ;;
+    *)
+      as_fn_error $? "Unknown argument to --with-aix-soname" "$LINENO" 5
+      ;;
+    esac
+    lt_cv_with_aix_soname=$with_aix_soname
+else
+  if ${lt_cv_with_aix_soname+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_with_aix_soname=aix
+fi
+
+    with_aix_soname=$lt_cv_with_aix_soname
+fi
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $with_aix_soname" >&5
+$as_echo "$with_aix_soname" >&6; }
+  if test aix != "$with_aix_soname"; then
+    # For the AIX way of multilib, we name the shared archive member
+    # based on the bitwidth used, traditionally 'shr.o' or 'shr_64.o',
+    # and 'shr.imp' or 'shr_64.imp', respectively, for the Import File.
+    # Even when GNU compilers ignore OBJECT_MODE but need '-maix64' flag,
+    # the AIX toolchain works better with OBJECT_MODE set (default 32).
+    if test 64 = "${OBJECT_MODE-32}"; then
+      shared_archive_member_spec=shr_64
+    else
+      shared_archive_member_spec=shr
+    fi
+  fi
+  ;;
+*)
+  with_aix_soname=aix
+  ;;
+esac
+
+
+
+
+
+
+
+
+
+
+# This can be used to rebuild libtool when needed
+LIBTOOL_DEPS=$ltmain
+
+# Always use our own libtool.
+LIBTOOL='$(SHELL) $(top_builddir)/libtool'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+test -z "$LN_S" && LN_S="ln -s"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+if test -n "${ZSH_VERSION+set}"; then
+   setopt NO_GLOB_SUBST
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for objdir" >&5
+$as_echo_n "checking for objdir... " >&6; }
+if ${lt_cv_objdir+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  rm -f .libs 2>/dev/null
+mkdir .libs 2>/dev/null
+if test -d .libs; then
+  lt_cv_objdir=.libs
+else
+  # MS-DOS does not allow filenames that begin with a dot.
+  lt_cv_objdir=_libs
+fi
+rmdir .libs 2>/dev/null
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_objdir" >&5
+$as_echo "$lt_cv_objdir" >&6; }
+objdir=$lt_cv_objdir
+
+
+
+
+
+cat >>confdefs.h <<_ACEOF
+#define LT_OBJDIR "$lt_cv_objdir/"
+_ACEOF
+
+
+
+
+case $host_os in
+aix3*)
+  # AIX sometimes has problems with the GCC collect2 program.  For some
+  # reason, if we set the COLLECT_NAMES environment variable, the problems
+  # vanish in a puff of smoke.
+  if test set != "${COLLECT_NAMES+set}"; then
+    COLLECT_NAMES=
+    export COLLECT_NAMES
+  fi
+  ;;
+esac
+
+# Global variables:
+ofile=libtool
+can_build_shared=yes
+
+# All known linkers require a '.a' archive for static linking (except MSVC,
+# which needs '.lib').
+libext=a
+
+with_gnu_ld=$lt_cv_prog_gnu_ld
+
+old_CC=$CC
+old_CFLAGS=$CFLAGS
+
+# Set sane defaults for various variables
+test -z "$CC" && CC=cc
+test -z "$LTCC" && LTCC=$CC
+test -z "$LTCFLAGS" && LTCFLAGS=$CFLAGS
+test -z "$LD" && LD=ld
+test -z "$ac_objext" && ac_objext=o
+
+func_cc_basename $compiler
+cc_basename=$func_cc_basename_result
+
+
+# Only perform the check for file, if the check method requires it
+test -z "$MAGIC_CMD" && MAGIC_CMD=file
+case $deplibs_check_method in
+file_magic*)
+  if test "$file_magic_cmd" = '$MAGIC_CMD'; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${ac_tool_prefix}file" >&5
+$as_echo_n "checking for ${ac_tool_prefix}file... " >&6; }
+if ${lt_cv_path_MAGIC_CMD+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  case $MAGIC_CMD in
+[\\/*] |  ?:[\\/]*)
+  lt_cv_path_MAGIC_CMD=$MAGIC_CMD # Let the user override the test with a path.
+  ;;
+*)
+  lt_save_MAGIC_CMD=$MAGIC_CMD
+  lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR
+  ac_dummy="/usr/bin$PATH_SEPARATOR$PATH"
+  for ac_dir in $ac_dummy; do
+    IFS=$lt_save_ifs
+    test -z "$ac_dir" && ac_dir=.
+    if test -f "$ac_dir/${ac_tool_prefix}file"; then
+      lt_cv_path_MAGIC_CMD=$ac_dir/"${ac_tool_prefix}file"
+      if test -n "$file_magic_test_file"; then
+	case $deplibs_check_method in
+	"file_magic "*)
+	  file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"`
+	  MAGIC_CMD=$lt_cv_path_MAGIC_CMD
+	  if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
+	    $EGREP "$file_magic_regex" > /dev/null; then
+	    :
+	  else
+	    cat <<_LT_EOF 1>&2
+
+*** Warning: the command libtool uses to detect shared libraries,
+*** $file_magic_cmd, produces output that libtool cannot recognize.
+*** The result is that libtool may fail to recognize shared libraries
+*** as such.  This will affect the creation of libtool libraries that
+*** depend on shared libraries, but programs linked with such libtool
+*** libraries will work regardless of this problem.  Nevertheless, you
+*** may want to report the problem to your system manager and/or to
+*** bug-libtool@gnu.org
+
+_LT_EOF
+	  fi ;;
+	esac
+      fi
+      break
+    fi
+  done
+  IFS=$lt_save_ifs
+  MAGIC_CMD=$lt_save_MAGIC_CMD
+  ;;
+esac
+fi
+
+MAGIC_CMD=$lt_cv_path_MAGIC_CMD
+if test -n "$MAGIC_CMD"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5
+$as_echo "$MAGIC_CMD" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+
+
+
+if test -z "$lt_cv_path_MAGIC_CMD"; then
+  if test -n "$ac_tool_prefix"; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for file" >&5
+$as_echo_n "checking for file... " >&6; }
+if ${lt_cv_path_MAGIC_CMD+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  case $MAGIC_CMD in
+[\\/*] |  ?:[\\/]*)
+  lt_cv_path_MAGIC_CMD=$MAGIC_CMD # Let the user override the test with a path.
+  ;;
+*)
+  lt_save_MAGIC_CMD=$MAGIC_CMD
+  lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR
+  ac_dummy="/usr/bin$PATH_SEPARATOR$PATH"
+  for ac_dir in $ac_dummy; do
+    IFS=$lt_save_ifs
+    test -z "$ac_dir" && ac_dir=.
+    if test -f "$ac_dir/file"; then
+      lt_cv_path_MAGIC_CMD=$ac_dir/"file"
+      if test -n "$file_magic_test_file"; then
+	case $deplibs_check_method in
+	"file_magic "*)
+	  file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"`
+	  MAGIC_CMD=$lt_cv_path_MAGIC_CMD
+	  if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
+	    $EGREP "$file_magic_regex" > /dev/null; then
+	    :
+	  else
+	    cat <<_LT_EOF 1>&2
+
+*** Warning: the command libtool uses to detect shared libraries,
+*** $file_magic_cmd, produces output that libtool cannot recognize.
+*** The result is that libtool may fail to recognize shared libraries
+*** as such.  This will affect the creation of libtool libraries that
+*** depend on shared libraries, but programs linked with such libtool
+*** libraries will work regardless of this problem.  Nevertheless, you
+*** may want to report the problem to your system manager and/or to
+*** bug-libtool@gnu.org
+
+_LT_EOF
+	  fi ;;
+	esac
+      fi
+      break
+    fi
+  done
+  IFS=$lt_save_ifs
+  MAGIC_CMD=$lt_save_MAGIC_CMD
+  ;;
+esac
+fi
+
+MAGIC_CMD=$lt_cv_path_MAGIC_CMD
+if test -n "$MAGIC_CMD"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5
+$as_echo "$MAGIC_CMD" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  else
+    MAGIC_CMD=:
+  fi
+fi
+
+  fi
+  ;;
+esac
+
+# Use C for the default configuration in the libtool script
+
+lt_save_CC=$CC
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+# Source file extension for C test sources.
+ac_ext=c
+
+# Object file extension for compiled C test sources.
+objext=o
+objext=$objext
+
+# Code to be used in simple compile tests
+lt_simple_compile_test_code="int some_variable = 0;"
+
+# Code to be used in simple link tests
+lt_simple_link_test_code='int main(){return(0);}'
+
+
+
+
+
+
+
+# If no C compiler was specified, use CC.
+LTCC=${LTCC-"$CC"}
+
+# If no C compiler flags were specified, use CFLAGS.
+LTCFLAGS=${LTCFLAGS-"$CFLAGS"}
+
+# Allow CC to be a program name with arguments.
+compiler=$CC
+
+# Save the default compiler, since it gets overwritten when the other
+# tags are being tested, and _LT_TAGVAR(compiler, []) is a NOP.
+compiler_DEFAULT=$CC
+
+# save warnings/boilerplate of simple test code
+ac_outfile=conftest.$ac_objext
+echo "$lt_simple_compile_test_code" >conftest.$ac_ext
+eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
+_lt_compiler_boilerplate=`cat conftest.err`
+$RM conftest*
+
+ac_outfile=conftest.$ac_objext
+echo "$lt_simple_link_test_code" >conftest.$ac_ext
+eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
+_lt_linker_boilerplate=`cat conftest.err`
+$RM -r conftest*
+
+
+## CAVEAT EMPTOR:
+## There is no encapsulation within the following macros, do not change
+## the running order or otherwise move them around unless you know exactly
+## what you are doing...
+if test -n "$compiler"; then
+
+lt_prog_compiler_no_builtin_flag=
+
+if test yes = "$GCC"; then
+  case $cc_basename in
+  nvcc*)
+    lt_prog_compiler_no_builtin_flag=' -Xcompiler -fno-builtin' ;;
+  *)
+    lt_prog_compiler_no_builtin_flag=' -fno-builtin' ;;
+  esac
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -fno-rtti -fno-exceptions" >&5
+$as_echo_n "checking if $compiler supports -fno-rtti -fno-exceptions... " >&6; }
+if ${lt_cv_prog_compiler_rtti_exceptions+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler_rtti_exceptions=no
+   ac_outfile=conftest.$ac_objext
+   echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+   lt_compiler_flag="-fno-rtti -fno-exceptions"  ## exclude from sc_useless_quotes_in_assignment
+   # Insert the option either (1) after the last *FLAGS variable, or
+   # (2) before a word containing "conftest.", or (3) at the end.
+   # Note that $ac_compile itself does not contain backslashes and begins
+   # with a dollar sign (not a hyphen), so the echo should work correctly.
+   # The option is referenced via a variable to avoid confusing sed.
+   lt_compile=`echo "$ac_compile" | $SED \
+   -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
+   -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
+   -e 's:$: $lt_compiler_flag:'`
+   (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
+   (eval "$lt_compile" 2>conftest.err)
+   ac_status=$?
+   cat conftest.err >&5
+   echo "$as_me:$LINENO: \$? = $ac_status" >&5
+   if (exit $ac_status) && test -s "$ac_outfile"; then
+     # The compiler can only warn and ignore the option if not recognized
+     # So say no if there are warnings other than the usual output.
+     $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp
+     $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
+     if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then
+       lt_cv_prog_compiler_rtti_exceptions=yes
+     fi
+   fi
+   $RM conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_rtti_exceptions" >&5
+$as_echo "$lt_cv_prog_compiler_rtti_exceptions" >&6; }
+
+if test yes = "$lt_cv_prog_compiler_rtti_exceptions"; then
+    lt_prog_compiler_no_builtin_flag="$lt_prog_compiler_no_builtin_flag -fno-rtti -fno-exceptions"
+else
+    :
+fi
+
+fi
+
+
+
+
+
+
+  lt_prog_compiler_wl=
+lt_prog_compiler_pic=
+lt_prog_compiler_static=
+
+
+  if test yes = "$GCC"; then
+    lt_prog_compiler_wl='-Wl,'
+    lt_prog_compiler_static='-static'
+
+    case $host_os in
+      aix*)
+      # All AIX code is PIC.
+      if test ia64 = "$host_cpu"; then
+	# AIX 5 now supports IA64 processor
+	lt_prog_compiler_static='-Bstatic'
+      fi
+      lt_prog_compiler_pic='-fPIC'
+      ;;
+
+    amigaos*)
+      case $host_cpu in
+      powerpc)
+            # see comment about AmigaOS4 .so support
+            lt_prog_compiler_pic='-fPIC'
+        ;;
+      m68k)
+            # FIXME: we need at least 68020 code to build shared libraries, but
+            # adding the '-m68020' flag to GCC prevents building anything better,
+            # like '-m68040'.
+            lt_prog_compiler_pic='-m68020 -resident32 -malways-restore-a4'
+        ;;
+      esac
+      ;;
+
+    beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*)
+      # PIC is the default for these OSes.
+      ;;
+
+    mingw* | cygwin* | pw32* | os2* | cegcc*)
+      # This hack is so that the source file can tell whether it is being
+      # built for inclusion in a dll (and should export symbols for example).
+      # Although the cygwin gcc ignores -fPIC, still need this for old-style
+      # (--disable-auto-import) libraries
+      lt_prog_compiler_pic='-DDLL_EXPORT'
+      case $host_os in
+      os2*)
+	lt_prog_compiler_static='$wl-static'
+	;;
+      esac
+      ;;
+
+    darwin* | rhapsody*)
+      # PIC is the default on this platform
+      # Common symbols not allowed in MH_DYLIB files
+      lt_prog_compiler_pic='-fno-common'
+      ;;
+
+    haiku*)
+      # PIC is the default for Haiku.
+      # The "-static" flag exists, but is broken.
+      lt_prog_compiler_static=
+      ;;
+
+    hpux*)
+      # PIC is the default for 64-bit PA HP-UX, but not for 32-bit
+      # PA HP-UX.  On IA64 HP-UX, PIC is the default but the pic flag
+      # sets the default TLS model and affects inlining.
+      case $host_cpu in
+      hppa*64*)
+	# +Z the default
+	;;
+      *)
+	lt_prog_compiler_pic='-fPIC'
+	;;
+      esac
+      ;;
+
+    interix[3-9]*)
+      # Interix 3.x gcc -fpic/-fPIC options generate broken code.
+      # Instead, we relocate shared libraries at runtime.
+      ;;
+
+    msdosdjgpp*)
+      # Just because we use GCC doesn't mean we suddenly get shared libraries
+      # on systems that don't support them.
+      lt_prog_compiler_can_build_shared=no
+      enable_shared=no
+      ;;
+
+    *nto* | *qnx*)
+      # QNX uses GNU C++, but need to define -shared option too, otherwise
+      # it will coredump.
+      lt_prog_compiler_pic='-fPIC -shared'
+      ;;
+
+    sysv4*MP*)
+      if test -d /usr/nec; then
+	lt_prog_compiler_pic=-Kconform_pic
+      fi
+      ;;
+
+    *)
+      lt_prog_compiler_pic='-fPIC'
+      ;;
+    esac
+
+    case $cc_basename in
+    nvcc*) # Cuda Compiler Driver 2.2
+      lt_prog_compiler_wl='-Xlinker '
+      if test -n "$lt_prog_compiler_pic"; then
+        lt_prog_compiler_pic="-Xcompiler $lt_prog_compiler_pic"
+      fi
+      ;;
+    esac
+  else
+    # PORTME Check for flag to pass linker flags through the system compiler.
+    case $host_os in
+    aix*)
+      lt_prog_compiler_wl='-Wl,'
+      if test ia64 = "$host_cpu"; then
+	# AIX 5 now supports IA64 processor
+	lt_prog_compiler_static='-Bstatic'
+      else
+	lt_prog_compiler_static='-bnso -bI:/lib/syscalls.exp'
+      fi
+      ;;
+
+    darwin* | rhapsody*)
+      # PIC is the default on this platform
+      # Common symbols not allowed in MH_DYLIB files
+      lt_prog_compiler_pic='-fno-common'
+      case $cc_basename in
+      nagfor*)
+        # NAG Fortran compiler
+        lt_prog_compiler_wl='-Wl,-Wl,,'
+        lt_prog_compiler_pic='-PIC'
+        lt_prog_compiler_static='-Bstatic'
+        ;;
+      esac
+      ;;
+
+    mingw* | cygwin* | pw32* | os2* | cegcc*)
+      # This hack is so that the source file can tell whether it is being
+      # built for inclusion in a dll (and should export symbols for example).
+      lt_prog_compiler_pic='-DDLL_EXPORT'
+      case $host_os in
+      os2*)
+	lt_prog_compiler_static='$wl-static'
+	;;
+      esac
+      ;;
+
+    hpux9* | hpux10* | hpux11*)
+      lt_prog_compiler_wl='-Wl,'
+      # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but
+      # not for PA HP-UX.
+      case $host_cpu in
+      hppa*64*|ia64*)
+	# +Z the default
+	;;
+      *)
+	lt_prog_compiler_pic='+Z'
+	;;
+      esac
+      # Is there a better lt_prog_compiler_static that works with the bundled CC?
+      lt_prog_compiler_static='$wl-a ${wl}archive'
+      ;;
+
+    irix5* | irix6* | nonstopux*)
+      lt_prog_compiler_wl='-Wl,'
+      # PIC (with -KPIC) is the default.
+      lt_prog_compiler_static='-non_shared'
+      ;;
+
+    linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*)
+      case $cc_basename in
+      # old Intel for x86_64, which still supported -KPIC.
+      ecc*)
+	lt_prog_compiler_wl='-Wl,'
+	lt_prog_compiler_pic='-KPIC'
+	lt_prog_compiler_static='-static'
+        ;;
+      # icc used to be incompatible with GCC.
+      # ICC 10 doesn't accept -KPIC any more.
+      icc* | ifort*)
+	lt_prog_compiler_wl='-Wl,'
+	lt_prog_compiler_pic='-fPIC'
+	lt_prog_compiler_static='-static'
+        ;;
+      # Lahey Fortran 8.1.
+      lf95*)
+	lt_prog_compiler_wl='-Wl,'
+	lt_prog_compiler_pic='--shared'
+	lt_prog_compiler_static='--static'
+	;;
+      nagfor*)
+	# NAG Fortran compiler
+	lt_prog_compiler_wl='-Wl,-Wl,,'
+	lt_prog_compiler_pic='-PIC'
+	lt_prog_compiler_static='-Bstatic'
+	;;
+      tcc*)
+	# Fabrice Bellard et al's Tiny C Compiler
+	lt_prog_compiler_wl='-Wl,'
+	lt_prog_compiler_pic='-fPIC'
+	lt_prog_compiler_static='-static'
+	;;
+      pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*)
+        # Portland Group compilers (*not* the Pentium gcc compiler,
+	# which looks to be a dead project)
+	lt_prog_compiler_wl='-Wl,'
+	lt_prog_compiler_pic='-fpic'
+	lt_prog_compiler_static='-Bstatic'
+        ;;
+      ccc*)
+        lt_prog_compiler_wl='-Wl,'
+        # All Alpha code is PIC.
+        lt_prog_compiler_static='-non_shared'
+        ;;
+      xl* | bgxl* | bgf* | mpixl*)
+	# IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene
+	lt_prog_compiler_wl='-Wl,'
+	lt_prog_compiler_pic='-qpic'
+	lt_prog_compiler_static='-qstaticlink'
+	;;
+      *)
+	case `$CC -V 2>&1 | sed 5q` in
+	*Sun\ Ceres\ Fortran* | *Sun*Fortran*\ [1-7].* | *Sun*Fortran*\ 8.[0-3]*)
+	  # Sun Fortran 8.3 passes all unrecognized flags to the linker
+	  lt_prog_compiler_pic='-KPIC'
+	  lt_prog_compiler_static='-Bstatic'
+	  lt_prog_compiler_wl=''
+	  ;;
+	*Sun\ F* | *Sun*Fortran*)
+	  lt_prog_compiler_pic='-KPIC'
+	  lt_prog_compiler_static='-Bstatic'
+	  lt_prog_compiler_wl='-Qoption ld '
+	  ;;
+	*Sun\ C*)
+	  # Sun C 5.9
+	  lt_prog_compiler_pic='-KPIC'
+	  lt_prog_compiler_static='-Bstatic'
+	  lt_prog_compiler_wl='-Wl,'
+	  ;;
+        *Intel*\ [CF]*Compiler*)
+	  lt_prog_compiler_wl='-Wl,'
+	  lt_prog_compiler_pic='-fPIC'
+	  lt_prog_compiler_static='-static'
+	  ;;
+	*Portland\ Group*)
+	  lt_prog_compiler_wl='-Wl,'
+	  lt_prog_compiler_pic='-fpic'
+	  lt_prog_compiler_static='-Bstatic'
+	  ;;
+	esac
+	;;
+      esac
+      ;;
+
+    newsos6)
+      lt_prog_compiler_pic='-KPIC'
+      lt_prog_compiler_static='-Bstatic'
+      ;;
+
+    *nto* | *qnx*)
+      # QNX uses GNU C++, but need to define -shared option too, otherwise
+      # it will coredump.
+      lt_prog_compiler_pic='-fPIC -shared'
+      ;;
+
+    osf3* | osf4* | osf5*)
+      lt_prog_compiler_wl='-Wl,'
+      # All OSF/1 code is PIC.
+      lt_prog_compiler_static='-non_shared'
+      ;;
+
+    rdos*)
+      lt_prog_compiler_static='-non_shared'
+      ;;
+
+    solaris*)
+      lt_prog_compiler_pic='-KPIC'
+      lt_prog_compiler_static='-Bstatic'
+      case $cc_basename in
+      f77* | f90* | f95* | sunf77* | sunf90* | sunf95*)
+	lt_prog_compiler_wl='-Qoption ld ';;
+      *)
+	lt_prog_compiler_wl='-Wl,';;
+      esac
+      ;;
+
+    sunos4*)
+      lt_prog_compiler_wl='-Qoption ld '
+      lt_prog_compiler_pic='-PIC'
+      lt_prog_compiler_static='-Bstatic'
+      ;;
+
+    sysv4 | sysv4.2uw2* | sysv4.3*)
+      lt_prog_compiler_wl='-Wl,'
+      lt_prog_compiler_pic='-KPIC'
+      lt_prog_compiler_static='-Bstatic'
+      ;;
+
+    sysv4*MP*)
+      if test -d /usr/nec; then
+	lt_prog_compiler_pic='-Kconform_pic'
+	lt_prog_compiler_static='-Bstatic'
+      fi
+      ;;
+
+    sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*)
+      lt_prog_compiler_wl='-Wl,'
+      lt_prog_compiler_pic='-KPIC'
+      lt_prog_compiler_static='-Bstatic'
+      ;;
+
+    unicos*)
+      lt_prog_compiler_wl='-Wl,'
+      lt_prog_compiler_can_build_shared=no
+      ;;
+
+    uts4*)
+      lt_prog_compiler_pic='-pic'
+      lt_prog_compiler_static='-Bstatic'
+      ;;
+
+    *)
+      lt_prog_compiler_can_build_shared=no
+      ;;
+    esac
+  fi
+
+case $host_os in
+  # For platforms that do not support PIC, -DPIC is meaningless:
+  *djgpp*)
+    lt_prog_compiler_pic=
+    ;;
+  *)
+    lt_prog_compiler_pic="$lt_prog_compiler_pic -DPIC"
+    ;;
+esac
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5
+$as_echo_n "checking for $compiler option to produce PIC... " >&6; }
+if ${lt_cv_prog_compiler_pic+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler_pic=$lt_prog_compiler_pic
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic" >&5
+$as_echo "$lt_cv_prog_compiler_pic" >&6; }
+lt_prog_compiler_pic=$lt_cv_prog_compiler_pic
+
+#
+# Check to make sure the PIC flag actually works.
+#
+if test -n "$lt_prog_compiler_pic"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic works" >&5
+$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic works... " >&6; }
+if ${lt_cv_prog_compiler_pic_works+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler_pic_works=no
+   ac_outfile=conftest.$ac_objext
+   echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+   lt_compiler_flag="$lt_prog_compiler_pic -DPIC"  ## exclude from sc_useless_quotes_in_assignment
+   # Insert the option either (1) after the last *FLAGS variable, or
+   # (2) before a word containing "conftest.", or (3) at the end.
+   # Note that $ac_compile itself does not contain backslashes and begins
+   # with a dollar sign (not a hyphen), so the echo should work correctly.
+   # The option is referenced via a variable to avoid confusing sed.
+   lt_compile=`echo "$ac_compile" | $SED \
+   -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
+   -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
+   -e 's:$: $lt_compiler_flag:'`
+   (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
+   (eval "$lt_compile" 2>conftest.err)
+   ac_status=$?
+   cat conftest.err >&5
+   echo "$as_me:$LINENO: \$? = $ac_status" >&5
+   if (exit $ac_status) && test -s "$ac_outfile"; then
+     # The compiler can only warn and ignore the option if not recognized
+     # So say no if there are warnings other than the usual output.
+     $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp
+     $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
+     if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then
+       lt_cv_prog_compiler_pic_works=yes
+     fi
+   fi
+   $RM conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works" >&5
+$as_echo "$lt_cv_prog_compiler_pic_works" >&6; }
+
+if test yes = "$lt_cv_prog_compiler_pic_works"; then
+    case $lt_prog_compiler_pic in
+     "" | " "*) ;;
+     *) lt_prog_compiler_pic=" $lt_prog_compiler_pic" ;;
+     esac
+else
+    lt_prog_compiler_pic=
+     lt_prog_compiler_can_build_shared=no
+fi
+
+fi
+
+
+
+
+
+
+
+
+
+
+
+#
+# Check to make sure the static flag actually works.
+#
+wl=$lt_prog_compiler_wl eval lt_tmp_static_flag=\"$lt_prog_compiler_static\"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5
+$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; }
+if ${lt_cv_prog_compiler_static_works+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler_static_works=no
+   save_LDFLAGS=$LDFLAGS
+   LDFLAGS="$LDFLAGS $lt_tmp_static_flag"
+   echo "$lt_simple_link_test_code" > conftest.$ac_ext
+   if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then
+     # The linker can only warn and ignore the option if not recognized
+     # So say no if there are warnings
+     if test -s conftest.err; then
+       # Append any errors to the config.log.
+       cat conftest.err 1>&5
+       $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp
+       $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
+       if diff conftest.exp conftest.er2 >/dev/null; then
+         lt_cv_prog_compiler_static_works=yes
+       fi
+     else
+       lt_cv_prog_compiler_static_works=yes
+     fi
+   fi
+   $RM -r conftest*
+   LDFLAGS=$save_LDFLAGS
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works" >&5
+$as_echo "$lt_cv_prog_compiler_static_works" >&6; }
+
+if test yes = "$lt_cv_prog_compiler_static_works"; then
+    :
+else
+    lt_prog_compiler_static=
+fi
+
+
+
+
+
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5
+$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; }
+if ${lt_cv_prog_compiler_c_o+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler_c_o=no
+   $RM -r conftest 2>/dev/null
+   mkdir conftest
+   cd conftest
+   mkdir out
+   echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+
+   lt_compiler_flag="-o out/conftest2.$ac_objext"
+   # Insert the option either (1) after the last *FLAGS variable, or
+   # (2) before a word containing "conftest.", or (3) at the end.
+   # Note that $ac_compile itself does not contain backslashes and begins
+   # with a dollar sign (not a hyphen), so the echo should work correctly.
+   lt_compile=`echo "$ac_compile" | $SED \
+   -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
+   -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
+   -e 's:$: $lt_compiler_flag:'`
+   (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
+   (eval "$lt_compile" 2>out/conftest.err)
+   ac_status=$?
+   cat out/conftest.err >&5
+   echo "$as_me:$LINENO: \$? = $ac_status" >&5
+   if (exit $ac_status) && test -s out/conftest2.$ac_objext
+   then
+     # The compiler can only warn and ignore the option if not recognized
+     # So say no if there are warnings
+     $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp
+     $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2
+     if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then
+       lt_cv_prog_compiler_c_o=yes
+     fi
+   fi
+   chmod u+w . 2>&5
+   $RM conftest*
+   # SGI C++ compiler will create directory out/ii_files/ for
+   # template instantiation
+   test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files
+   $RM out/* && rmdir out
+   cd ..
+   $RM -r conftest
+   $RM conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5
+$as_echo "$lt_cv_prog_compiler_c_o" >&6; }
+
+
+
+
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5
+$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; }
+if ${lt_cv_prog_compiler_c_o+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler_c_o=no
+   $RM -r conftest 2>/dev/null
+   mkdir conftest
+   cd conftest
+   mkdir out
+   echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+
+   lt_compiler_flag="-o out/conftest2.$ac_objext"
+   # Insert the option either (1) after the last *FLAGS variable, or
+   # (2) before a word containing "conftest.", or (3) at the end.
+   # Note that $ac_compile itself does not contain backslashes and begins
+   # with a dollar sign (not a hyphen), so the echo should work correctly.
+   lt_compile=`echo "$ac_compile" | $SED \
+   -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
+   -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
+   -e 's:$: $lt_compiler_flag:'`
+   (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
+   (eval "$lt_compile" 2>out/conftest.err)
+   ac_status=$?
+   cat out/conftest.err >&5
+   echo "$as_me:$LINENO: \$? = $ac_status" >&5
+   if (exit $ac_status) && test -s out/conftest2.$ac_objext
+   then
+     # The compiler can only warn and ignore the option if not recognized
+     # So say no if there are warnings
+     $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp
+     $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2
+     if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then
+       lt_cv_prog_compiler_c_o=yes
+     fi
+   fi
+   chmod u+w . 2>&5
+   $RM conftest*
+   # SGI C++ compiler will create directory out/ii_files/ for
+   # template instantiation
+   test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files
+   $RM out/* && rmdir out
+   cd ..
+   $RM -r conftest
+   $RM conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5
+$as_echo "$lt_cv_prog_compiler_c_o" >&6; }
+
+
+
+
+hard_links=nottested
+if test no = "$lt_cv_prog_compiler_c_o" && test no != "$need_locks"; then
+  # do not overwrite the value of need_locks provided by the user
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5
+$as_echo_n "checking if we can lock with hard links... " >&6; }
+  hard_links=yes
+  $RM conftest*
+  ln conftest.a conftest.b 2>/dev/null && hard_links=no
+  touch conftest.a
+  ln conftest.a conftest.b 2>&5 || hard_links=no
+  ln conftest.a conftest.b 2>/dev/null && hard_links=no
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5
+$as_echo "$hard_links" >&6; }
+  if test no = "$hard_links"; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&5
+$as_echo "$as_me: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&2;}
+    need_locks=warn
+  fi
+else
+  need_locks=no
+fi
+
+
+
+
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5
+$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; }
+
+  runpath_var=
+  allow_undefined_flag=
+  always_export_symbols=no
+  archive_cmds=
+  archive_expsym_cmds=
+  compiler_needs_object=no
+  enable_shared_with_static_runtimes=no
+  export_dynamic_flag_spec=
+  export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols'
+  hardcode_automatic=no
+  hardcode_direct=no
+  hardcode_direct_absolute=no
+  hardcode_libdir_flag_spec=
+  hardcode_libdir_separator=
+  hardcode_minus_L=no
+  hardcode_shlibpath_var=unsupported
+  inherit_rpath=no
+  link_all_deplibs=unknown
+  module_cmds=
+  module_expsym_cmds=
+  old_archive_from_new_cmds=
+  old_archive_from_expsyms_cmds=
+  thread_safe_flag_spec=
+  whole_archive_flag_spec=
+  # include_expsyms should be a list of space-separated symbols to be *always*
+  # included in the symbol list
+  include_expsyms=
+  # exclude_expsyms can be an extended regexp of symbols to exclude
+  # it will be wrapped by ' (' and ')$', so one must not match beginning or
+  # end of line.  Example: 'a|bc|.*d.*' will exclude the symbols 'a' and 'bc',
+  # as well as any symbol that contains 'd'.
+  exclude_expsyms='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*'
+  # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out
+  # platforms (ab)use it in PIC code, but their linkers get confused if
+  # the symbol is explicitly referenced.  Since portable code cannot
+  # rely on this symbol name, it's probably fine to never include it in
+  # preloaded symbol tables.
+  # Exclude shared library initialization/finalization symbols.
+  extract_expsyms_cmds=
+
+  case $host_os in
+  cygwin* | mingw* | pw32* | cegcc*)
+    # FIXME: the MSVC++ port hasn't been tested in a loooong time
+    # When not using gcc, we currently assume that we are using
+    # Microsoft Visual C++.
+    if test yes != "$GCC"; then
+      with_gnu_ld=no
+    fi
+    ;;
+  interix*)
+    # we just hope/assume this is gcc and not c89 (= MSVC++)
+    with_gnu_ld=yes
+    ;;
+  openbsd* | bitrig*)
+    with_gnu_ld=no
+    ;;
+  linux* | k*bsd*-gnu | gnu*)
+    link_all_deplibs=no
+    ;;
+  esac
+
+  ld_shlibs=yes
+
+  # On some targets, GNU ld is compatible enough with the native linker
+  # that we're better off using the native interface for both.
+  lt_use_gnu_ld_interface=no
+  if test yes = "$with_gnu_ld"; then
+    case $host_os in
+      aix*)
+	# The AIX port of GNU ld has always aspired to compatibility
+	# with the native linker.  However, as the warning in the GNU ld
+	# block says, versions before 2.19.5* couldn't really create working
+	# shared libraries, regardless of the interface used.
+	case `$LD -v 2>&1` in
+	  *\ \(GNU\ Binutils\)\ 2.19.5*) ;;
+	  *\ \(GNU\ Binutils\)\ 2.[2-9]*) ;;
+	  *\ \(GNU\ Binutils\)\ [3-9]*) ;;
+	  *)
+	    lt_use_gnu_ld_interface=yes
+	    ;;
+	esac
+	;;
+      *)
+	lt_use_gnu_ld_interface=yes
+	;;
+    esac
+  fi
+
+  if test yes = "$lt_use_gnu_ld_interface"; then
+    # If archive_cmds runs LD, not CC, wlarc should be empty
+    wlarc='$wl'
+
+    # Set some defaults for GNU ld with shared library support. These
+    # are reset later if shared libraries are not supported. Putting them
+    # here allows them to be overridden if necessary.
+    runpath_var=LD_RUN_PATH
+    hardcode_libdir_flag_spec='$wl-rpath $wl$libdir'
+    export_dynamic_flag_spec='$wl--export-dynamic'
+    # ancient GNU ld didn't support --whole-archive et. al.
+    if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then
+      whole_archive_flag_spec=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive'
+    else
+      whole_archive_flag_spec=
+    fi
+    supports_anon_versioning=no
+    case `$LD -v | $SED -e 's/(^)\+)\s\+//' 2>&1` in
+      *GNU\ gold*) supports_anon_versioning=yes ;;
+      *\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11
+      *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ...
+      *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ...
+      *\ 2.11.*) ;; # other 2.11 versions
+      *) supports_anon_versioning=yes ;;
+    esac
+
+    # See if GNU ld supports shared libraries.
+    case $host_os in
+    aix[3-9]*)
+      # On AIX/PPC, the GNU linker is very broken
+      if test ia64 != "$host_cpu"; then
+	ld_shlibs=no
+	cat <<_LT_EOF 1>&2
+
+*** Warning: the GNU linker, at least up to release 2.19, is reported
+*** to be unable to reliably create shared libraries on AIX.
+*** Therefore, libtool is disabling shared libraries support.  If you
+*** really care for shared libraries, you may want to install binutils
+*** 2.20 or above, or modify your PATH so that a non-GNU linker is found.
+*** You will then need to restart the configuration process.
+
+_LT_EOF
+      fi
+      ;;
+
+    amigaos*)
+      case $host_cpu in
+      powerpc)
+            # see comment about AmigaOS4 .so support
+            archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+            archive_expsym_cmds=''
+        ;;
+      m68k)
+            archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
+            hardcode_libdir_flag_spec='-L$libdir'
+            hardcode_minus_L=yes
+        ;;
+      esac
+      ;;
+
+    beos*)
+      if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
+	allow_undefined_flag=unsupported
+	# Joseph Beckenbach  says some releases of gcc
+	# support --undefined.  This deserves some investigation.  FIXME
+	archive_cmds='$CC -nostart $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+      else
+	ld_shlibs=no
+      fi
+      ;;
+
+    cygwin* | mingw* | pw32* | cegcc*)
+      # _LT_TAGVAR(hardcode_libdir_flag_spec, ) is actually meaningless,
+      # as there is no search path for DLLs.
+      hardcode_libdir_flag_spec='-L$libdir'
+      export_dynamic_flag_spec='$wl--export-all-symbols'
+      allow_undefined_flag=unsupported
+      always_export_symbols=no
+      enable_shared_with_static_runtimes=yes
+      export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/;s/^.*[ ]__nm__\([^ ]*\)[ ][^ ]*/\1 DATA/;/^I[ ]/d;/^[AITW][ ]/s/.* //'\'' | sort | uniq > $export_symbols'
+      exclude_expsyms='[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname'
+
+      if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then
+        archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
+	# If the export-symbols file already is a .def file, use it as
+	# is; otherwise, prepend EXPORTS...
+	archive_expsym_cmds='if   test DEF = "`$SED -n     -e '\''s/^[	 ]*//'\''     -e '\''/^\(;.*\)*$/d'\''     -e '\''s/^\(EXPORTS\|LIBRARY\)\([	 ].*\)*$/DEF/p'\''     -e q     $export_symbols`" ; then
+          cp $export_symbols $output_objdir/$soname.def;
+        else
+          echo EXPORTS > $output_objdir/$soname.def;
+          cat $export_symbols >> $output_objdir/$soname.def;
+        fi~
+        $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
+      else
+	ld_shlibs=no
+      fi
+      ;;
+
+    haiku*)
+      archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+      link_all_deplibs=yes
+      ;;
+
+    os2*)
+      hardcode_libdir_flag_spec='-L$libdir'
+      hardcode_minus_L=yes
+      allow_undefined_flag=unsupported
+      shrext_cmds=.dll
+      archive_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~
+	$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~
+	$ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~
+	$ECHO EXPORTS >> $output_objdir/$libname.def~
+	emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~
+	$CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~
+	emximp -o $lib $output_objdir/$libname.def'
+      archive_expsym_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~
+	$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~
+	$ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~
+	$ECHO EXPORTS >> $output_objdir/$libname.def~
+	prefix_cmds="$SED"~
+	if test EXPORTS = "`$SED 1q $export_symbols`"; then
+	  prefix_cmds="$prefix_cmds -e 1d";
+	fi~
+	prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~
+	cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~
+	$CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~
+	emximp -o $lib $output_objdir/$libname.def'
+      old_archive_From_new_cmds='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def'
+      enable_shared_with_static_runtimes=yes
+      ;;
+
+    interix[3-9]*)
+      hardcode_direct=no
+      hardcode_shlibpath_var=no
+      hardcode_libdir_flag_spec='$wl-rpath,$libdir'
+      export_dynamic_flag_spec='$wl-E'
+      # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc.
+      # Instead, shared libraries are loaded at an image base (0x10000000 by
+      # default) and relocated if they conflict, which is a slow very memory
+      # consuming and fragmenting process.  To avoid this, we pick a random,
+      # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link
+      # time.  Moving up from 0x10000000 also allows more sbrk(2) space.
+      archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
+      archive_expsym_cmds='sed "s|^|_|" $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--retain-symbols-file,$output_objdir/$soname.expsym $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
+      ;;
+
+    gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu)
+      tmp_diet=no
+      if test linux-dietlibc = "$host_os"; then
+	case $cc_basename in
+	  diet\ *) tmp_diet=yes;;	# linux-dietlibc with static linking (!diet-dyn)
+	esac
+      fi
+      if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \
+	 && test no = "$tmp_diet"
+      then
+	tmp_addflag=' $pic_flag'
+	tmp_sharedflag='-shared'
+	case $cc_basename,$host_cpu in
+        pgcc*)				# Portland Group C compiler
+	  whole_archive_flag_spec='$wl--whole-archive`for conv in $convenience\"\"; do test  -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive'
+	  tmp_addflag=' $pic_flag'
+	  ;;
+	pgf77* | pgf90* | pgf95* | pgfortran*)
+					# Portland Group f77 and f90 compilers
+	  whole_archive_flag_spec='$wl--whole-archive`for conv in $convenience\"\"; do test  -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive'
+	  tmp_addflag=' $pic_flag -Mnomain' ;;
+	ecc*,ia64* | icc*,ia64*)	# Intel C compiler on ia64
+	  tmp_addflag=' -i_dynamic' ;;
+	efc*,ia64* | ifort*,ia64*)	# Intel Fortran compiler on ia64
+	  tmp_addflag=' -i_dynamic -nofor_main' ;;
+	ifc* | ifort*)			# Intel Fortran compiler
+	  tmp_addflag=' -nofor_main' ;;
+	lf95*)				# Lahey Fortran 8.1
+	  whole_archive_flag_spec=
+	  tmp_sharedflag='--shared' ;;
+        nagfor*)                        # NAGFOR 5.3
+          tmp_sharedflag='-Wl,-shared' ;;
+	xl[cC]* | bgxl[cC]* | mpixl[cC]*) # IBM XL C 8.0 on PPC (deal with xlf below)
+	  tmp_sharedflag='-qmkshrobj'
+	  tmp_addflag= ;;
+	nvcc*)	# Cuda Compiler Driver 2.2
+	  whole_archive_flag_spec='$wl--whole-archive`for conv in $convenience\"\"; do test  -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive'
+	  compiler_needs_object=yes
+	  ;;
+	esac
+	case `$CC -V 2>&1 | sed 5q` in
+	*Sun\ C*)			# Sun C 5.9
+	  whole_archive_flag_spec='$wl--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive'
+	  compiler_needs_object=yes
+	  tmp_sharedflag='-G' ;;
+	*Sun\ F*)			# Sun Fortran 8.3
+	  tmp_sharedflag='-G' ;;
+	esac
+	archive_cmds='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+
+        if test yes = "$supports_anon_versioning"; then
+          archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~
+            cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
+            echo "local: *; };" >> $output_objdir/$libname.ver~
+            $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-version-script $wl$output_objdir/$libname.ver -o $lib'
+        fi
+
+	case $cc_basename in
+	tcc*)
+	  export_dynamic_flag_spec='-rdynamic'
+	  ;;
+	xlf* | bgf* | bgxlf* | mpixlf*)
+	  # IBM XL Fortran 10.1 on PPC cannot create shared libs itself
+	  whole_archive_flag_spec='--whole-archive$convenience --no-whole-archive'
+	  hardcode_libdir_flag_spec='$wl-rpath $wl$libdir'
+	  archive_cmds='$LD -shared $libobjs $deplibs $linker_flags -soname $soname -o $lib'
+	  if test yes = "$supports_anon_versioning"; then
+	    archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~
+              cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
+              echo "local: *; };" >> $output_objdir/$libname.ver~
+              $LD -shared $libobjs $deplibs $linker_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib'
+	  fi
+	  ;;
+	esac
+      else
+        ld_shlibs=no
+      fi
+      ;;
+
+    netbsd* | netbsdelf*-gnu)
+      if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
+	archive_cmds='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib'
+	wlarc=
+      else
+	archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+	archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib'
+      fi
+      ;;
+
+    solaris*)
+      if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then
+	ld_shlibs=no
+	cat <<_LT_EOF 1>&2
+
+*** Warning: The releases 2.8.* of the GNU linker cannot reliably
+*** create shared libraries on Solaris systems.  Therefore, libtool
+*** is disabling shared libraries support.  We urge you to upgrade GNU
+*** binutils to release 2.9.1 or newer.  Another option is to modify
+*** your PATH or compiler configuration so that the native linker is
+*** used, and then restart.
+
+_LT_EOF
+      elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
+	archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+	archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib'
+      else
+	ld_shlibs=no
+      fi
+      ;;
+
+    sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*)
+      case `$LD -v 2>&1` in
+        *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*)
+	ld_shlibs=no
+	cat <<_LT_EOF 1>&2
+
+*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 cannot
+*** reliably create shared libraries on SCO systems.  Therefore, libtool
+*** is disabling shared libraries support.  We urge you to upgrade GNU
+*** binutils to release 2.16.91.0.3 or newer.  Another option is to modify
+*** your PATH or compiler configuration so that the native linker is
+*** used, and then restart.
+
+_LT_EOF
+	;;
+	*)
+	  # For security reasons, it is highly recommended that you always
+	  # use absolute paths for naming shared libraries, and exclude the
+	  # DT_RUNPATH tag from executables and libraries.  But doing so
+	  # requires that you compile everything twice, which is a pain.
+	  if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
+	    hardcode_libdir_flag_spec='$wl-rpath $wl$libdir'
+	    archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+	    archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib'
+	  else
+	    ld_shlibs=no
+	  fi
+	;;
+      esac
+      ;;
+
+    sunos4*)
+      archive_cmds='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+      wlarc=
+      hardcode_direct=yes
+      hardcode_shlibpath_var=no
+      ;;
+
+    *)
+      if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
+	archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+	archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib'
+      else
+	ld_shlibs=no
+      fi
+      ;;
+    esac
+
+    if test no = "$ld_shlibs"; then
+      runpath_var=
+      hardcode_libdir_flag_spec=
+      export_dynamic_flag_spec=
+      whole_archive_flag_spec=
+    fi
+  else
+    # PORTME fill in a description of your system's linker (not GNU ld)
+    case $host_os in
+    aix3*)
+      allow_undefined_flag=unsupported
+      always_export_symbols=yes
+      archive_expsym_cmds='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname'
+      # Note: this linker hardcodes the directories in LIBPATH if there
+      # are no directories specified by -L.
+      hardcode_minus_L=yes
+      if test yes = "$GCC" && test -z "$lt_prog_compiler_static"; then
+	# Neither direct hardcoding nor static linking is supported with a
+	# broken collect2.
+	hardcode_direct=unsupported
+      fi
+      ;;
+
+    aix[4-9]*)
+      if test ia64 = "$host_cpu"; then
+	# On IA64, the linker does run time linking by default, so we don't
+	# have to do anything special.
+	aix_use_runtimelinking=no
+	exp_sym_flag='-Bexport'
+	no_entry_flag=
+      else
+	# If we're using GNU nm, then we don't want the "-C" option.
+	# -C means demangle to GNU nm, but means don't demangle to AIX nm.
+	# Without the "-l" option, or with the "-B" option, AIX nm treats
+	# weak defined symbols like other global defined symbols, whereas
+	# GNU nm marks them as "W".
+	# While the 'weak' keyword is ignored in the Export File, we need
+	# it in the Import File for the 'aix-soname' feature, so we have
+	# to replace the "-B" option with "-P" for AIX nm.
+	if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then
+	  export_symbols_cmds='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { if (\$ 2 == "W") { print \$ 3 " weak" } else { print \$ 3 } } }'\'' | sort -u > $export_symbols'
+	else
+	  export_symbols_cmds='`func_echo_all $NM | $SED -e '\''s/B\([^B]*\)$/P\1/'\''` -PCpgl $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) && (substr(\$ 1,1,1) != ".")) { if ((\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) { print \$ 1 " weak" } else { print \$ 1 } } }'\'' | sort -u > $export_symbols'
+	fi
+	aix_use_runtimelinking=no
+
+	# Test if we are trying to use run time linking or normal
+	# AIX style linking. If -brtl is somewhere in LDFLAGS, we
+	# have runtime linking enabled, and use it for executables.
+	# For shared libraries, we enable/disable runtime linking
+	# depending on the kind of the shared library created -
+	# when "with_aix_soname,aix_use_runtimelinking" is:
+	# "aix,no"   lib.a(lib.so.V) shared, rtl:no,  for executables
+	# "aix,yes"  lib.so          shared, rtl:yes, for executables
+	#            lib.a           static archive
+	# "both,no"  lib.so.V(shr.o) shared, rtl:yes
+	#            lib.a(lib.so.V) shared, rtl:no,  for executables
+	# "both,yes" lib.so.V(shr.o) shared, rtl:yes, for executables
+	#            lib.a(lib.so.V) shared, rtl:no
+	# "svr4,*"   lib.so.V(shr.o) shared, rtl:yes, for executables
+	#            lib.a           static archive
+	case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*)
+	  for ld_flag in $LDFLAGS; do
+	  if (test x-brtl = "x$ld_flag" || test x-Wl,-brtl = "x$ld_flag"); then
+	    aix_use_runtimelinking=yes
+	    break
+	  fi
+	  done
+	  if test svr4,no = "$with_aix_soname,$aix_use_runtimelinking"; then
+	    # With aix-soname=svr4, we create the lib.so.V shared archives only,
+	    # so we don't have lib.a shared libs to link our executables.
+	    # We have to force runtime linking in this case.
+	    aix_use_runtimelinking=yes
+	    LDFLAGS="$LDFLAGS -Wl,-brtl"
+	  fi
+	  ;;
+	esac
+
+	exp_sym_flag='-bexport'
+	no_entry_flag='-bnoentry'
+      fi
+
+      # When large executables or shared objects are built, AIX ld can
+      # have problems creating the table of contents.  If linking a library
+      # or program results in "error TOC overflow" add -mminimal-toc to
+      # CXXFLAGS/CFLAGS for g++/gcc.  In the cases where that is not
+      # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS.
+
+      archive_cmds=''
+      hardcode_direct=yes
+      hardcode_direct_absolute=yes
+      hardcode_libdir_separator=':'
+      link_all_deplibs=yes
+      file_list_spec='$wl-f,'
+      case $with_aix_soname,$aix_use_runtimelinking in
+      aix,*) ;; # traditional, no import file
+      svr4,* | *,yes) # use import file
+	# The Import File defines what to hardcode.
+	hardcode_direct=no
+	hardcode_direct_absolute=no
+	;;
+      esac
+
+      if test yes = "$GCC"; then
+	case $host_os in aix4.[012]|aix4.[012].*)
+	# We only want to do this on AIX 4.2 and lower, the check
+	# below for broken collect2 doesn't work under 4.3+
+	  collect2name=`$CC -print-prog-name=collect2`
+	  if test -f "$collect2name" &&
+	   strings "$collect2name" | $GREP resolve_lib_name >/dev/null
+	  then
+	  # We have reworked collect2
+	  :
+	  else
+	  # We have old collect2
+	  hardcode_direct=unsupported
+	  # It fails to find uninstalled libraries when the uninstalled
+	  # path is not listed in the libpath.  Setting hardcode_minus_L
+	  # to unsupported forces relinking
+	  hardcode_minus_L=yes
+	  hardcode_libdir_flag_spec='-L$libdir'
+	  hardcode_libdir_separator=
+	  fi
+	  ;;
+	esac
+	shared_flag='-shared'
+	if test yes = "$aix_use_runtimelinking"; then
+	  shared_flag="$shared_flag "'$wl-G'
+	fi
+	# Need to ensure runtime linking is disabled for the traditional
+	# shared library, or the linker may eventually find shared libraries
+	# /with/ Import File - we do not want to mix them.
+	shared_flag_aix='-shared'
+	shared_flag_svr4='-shared $wl-G'
+      else
+	# not using gcc
+	if test ia64 = "$host_cpu"; then
+	# VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release
+	# chokes on -Wl,-G. The following line is correct:
+	  shared_flag='-G'
+	else
+	  if test yes = "$aix_use_runtimelinking"; then
+	    shared_flag='$wl-G'
+	  else
+	    shared_flag='$wl-bM:SRE'
+	  fi
+	  shared_flag_aix='$wl-bM:SRE'
+	  shared_flag_svr4='$wl-G'
+	fi
+      fi
+
+      export_dynamic_flag_spec='$wl-bexpall'
+      # It seems that -bexpall does not export symbols beginning with
+      # underscore (_), so it is better to generate a list of symbols to export.
+      always_export_symbols=yes
+      if test aix,yes = "$with_aix_soname,$aix_use_runtimelinking"; then
+	# Warning - without using the other runtime loading flags (-brtl),
+	# -berok will link without error, but may produce a broken library.
+	allow_undefined_flag='-berok'
+        # Determine the default libpath from the value encoded in an
+        # empty executable.
+        if test set = "${lt_cv_aix_libpath+set}"; then
+  aix_libpath=$lt_cv_aix_libpath
+else
+  if ${lt_cv_aix_libpath_+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+
+  lt_aix_libpath_sed='
+      /Import File Strings/,/^$/ {
+	  /^0/ {
+	      s/^0  *\([^ ]*\) *$/\1/
+	      p
+	  }
+      }'
+  lt_cv_aix_libpath_=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
+  # Check for a 64-bit object if we didn't find anything.
+  if test -z "$lt_cv_aix_libpath_"; then
+    lt_cv_aix_libpath_=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
+  fi
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+  if test -z "$lt_cv_aix_libpath_"; then
+    lt_cv_aix_libpath_=/usr/lib:/lib
+  fi
+
+fi
+
+  aix_libpath=$lt_cv_aix_libpath_
+fi
+
+        hardcode_libdir_flag_spec='$wl-blibpath:$libdir:'"$aix_libpath"
+        archive_expsym_cmds='$CC -o $output_objdir/$soname $libobjs $deplibs $wl'$no_entry_flag' $compiler_flags `if test -n "$allow_undefined_flag"; then func_echo_all "$wl$allow_undefined_flag"; else :; fi` $wl'$exp_sym_flag:\$export_symbols' '$shared_flag
+      else
+	if test ia64 = "$host_cpu"; then
+	  hardcode_libdir_flag_spec='$wl-R $libdir:/usr/lib:/lib'
+	  allow_undefined_flag="-z nodefs"
+	  archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\$wl$no_entry_flag"' $compiler_flags $wl$allow_undefined_flag '"\$wl$exp_sym_flag:\$export_symbols"
+	else
+	 # Determine the default libpath from the value encoded in an
+	 # empty executable.
+	 if test set = "${lt_cv_aix_libpath+set}"; then
+  aix_libpath=$lt_cv_aix_libpath
+else
+  if ${lt_cv_aix_libpath_+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+
+  lt_aix_libpath_sed='
+      /Import File Strings/,/^$/ {
+	  /^0/ {
+	      s/^0  *\([^ ]*\) *$/\1/
+	      p
+	  }
+      }'
+  lt_cv_aix_libpath_=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
+  # Check for a 64-bit object if we didn't find anything.
+  if test -z "$lt_cv_aix_libpath_"; then
+    lt_cv_aix_libpath_=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
+  fi
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+  if test -z "$lt_cv_aix_libpath_"; then
+    lt_cv_aix_libpath_=/usr/lib:/lib
+  fi
+
+fi
+
+  aix_libpath=$lt_cv_aix_libpath_
+fi
+
+	 hardcode_libdir_flag_spec='$wl-blibpath:$libdir:'"$aix_libpath"
+	  # Warning - without using the other run time loading flags,
+	  # -berok will link without error, but may produce a broken library.
+	  no_undefined_flag=' $wl-bernotok'
+	  allow_undefined_flag=' $wl-berok'
+	  if test yes = "$with_gnu_ld"; then
+	    # We only use this code for GNU lds that support --whole-archive.
+	    whole_archive_flag_spec='$wl--whole-archive$convenience $wl--no-whole-archive'
+	  else
+	    # Exported symbols can be pulled into shared objects from archives
+	    whole_archive_flag_spec='$convenience'
+	  fi
+	  archive_cmds_need_lc=yes
+	  archive_expsym_cmds='$RM -r $output_objdir/$realname.d~$MKDIR $output_objdir/$realname.d'
+	  # -brtl affects multiple linker settings, -berok does not and is overridden later
+	  compiler_flags_filtered='`func_echo_all "$compiler_flags " | $SED -e "s%-brtl\\([, ]\\)%-berok\\1%g"`'
+	  if test svr4 != "$with_aix_soname"; then
+	    # This is similar to how AIX traditionally builds its shared libraries.
+	    archive_expsym_cmds="$archive_expsym_cmds"'~$CC '$shared_flag_aix' -o $output_objdir/$realname.d/$soname $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$realname.d/$soname'
+	  fi
+	  if test aix != "$with_aix_soname"; then
+	    archive_expsym_cmds="$archive_expsym_cmds"'~$CC '$shared_flag_svr4' -o $output_objdir/$realname.d/$shared_archive_member_spec.o $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$STRIP -e $output_objdir/$realname.d/$shared_archive_member_spec.o~( func_echo_all "#! $soname($shared_archive_member_spec.o)"; if test shr_64 = "$shared_archive_member_spec"; then func_echo_all "# 64"; else func_echo_all "# 32"; fi; cat $export_symbols ) > $output_objdir/$realname.d/$shared_archive_member_spec.imp~$AR $AR_FLAGS $output_objdir/$soname $output_objdir/$realname.d/$shared_archive_member_spec.o $output_objdir/$realname.d/$shared_archive_member_spec.imp'
+	  else
+	    # used by -dlpreopen to get the symbols
+	    archive_expsym_cmds="$archive_expsym_cmds"'~$MV  $output_objdir/$realname.d/$soname $output_objdir'
+	  fi
+	  archive_expsym_cmds="$archive_expsym_cmds"'~$RM -r $output_objdir/$realname.d'
+	fi
+      fi
+      ;;
+
+    amigaos*)
+      case $host_cpu in
+      powerpc)
+            # see comment about AmigaOS4 .so support
+            archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib'
+            archive_expsym_cmds=''
+        ;;
+      m68k)
+            archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
+            hardcode_libdir_flag_spec='-L$libdir'
+            hardcode_minus_L=yes
+        ;;
+      esac
+      ;;
+
+    bsdi[45]*)
+      export_dynamic_flag_spec=-rdynamic
+      ;;
+
+    cygwin* | mingw* | pw32* | cegcc*)
+      # When not using gcc, we currently assume that we are using
+      # Microsoft Visual C++.
+      # hardcode_libdir_flag_spec is actually meaningless, as there is
+      # no search path for DLLs.
+      case $cc_basename in
+      cl*)
+	# Native MSVC
+	hardcode_libdir_flag_spec=' '
+	allow_undefined_flag=unsupported
+	always_export_symbols=yes
+	file_list_spec='@'
+	# Tell ltmain to make .lib files, not .a files.
+	libext=lib
+	# Tell ltmain to make .dll files, not .so files.
+	shrext_cmds=.dll
+	# FIXME: Setting linknames here is a bad hack.
+	archive_cmds='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~linknames='
+	archive_expsym_cmds='if   test DEF = "`$SED -n     -e '\''s/^[	 ]*//'\''     -e '\''/^\(;.*\)*$/d'\''     -e '\''s/^\(EXPORTS\|LIBRARY\)\([	 ].*\)*$/DEF/p'\''     -e q     $export_symbols`" ; then
+            cp "$export_symbols" "$output_objdir/$soname.def";
+            echo "$tool_output_objdir$soname.def" > "$output_objdir/$soname.exp";
+          else
+            $SED -e '\''s/^/-link -EXPORT:/'\'' < $export_symbols > $output_objdir/$soname.exp;
+          fi~
+          $CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~
+          linknames='
+	# The linker will not automatically build a static lib if we build a DLL.
+	# _LT_TAGVAR(old_archive_from_new_cmds, )='true'
+	enable_shared_with_static_runtimes=yes
+	exclude_expsyms='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*'
+	export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1,DATA/'\'' | $SED -e '\''/^[AITW][ ]/s/.*[ ]//'\'' | sort | uniq > $export_symbols'
+	# Don't use ranlib
+	old_postinstall_cmds='chmod 644 $oldlib'
+	postlink_cmds='lt_outputfile="@OUTPUT@"~
+          lt_tool_outputfile="@TOOL_OUTPUT@"~
+          case $lt_outputfile in
+            *.exe|*.EXE) ;;
+            *)
+              lt_outputfile=$lt_outputfile.exe
+              lt_tool_outputfile=$lt_tool_outputfile.exe
+              ;;
+          esac~
+          if test : != "$MANIFEST_TOOL" && test -f "$lt_outputfile.manifest"; then
+            $MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1;
+            $RM "$lt_outputfile.manifest";
+          fi'
+	;;
+      *)
+	# Assume MSVC wrapper
+	hardcode_libdir_flag_spec=' '
+	allow_undefined_flag=unsupported
+	# Tell ltmain to make .lib files, not .a files.
+	libext=lib
+	# Tell ltmain to make .dll files, not .so files.
+	shrext_cmds=.dll
+	# FIXME: Setting linknames here is a bad hack.
+	archive_cmds='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames='
+	# The linker will automatically build a .lib file if we build a DLL.
+	old_archive_from_new_cmds='true'
+	# FIXME: Should let the user specify the lib program.
+	old_archive_cmds='lib -OUT:$oldlib$oldobjs$old_deplibs'
+	enable_shared_with_static_runtimes=yes
+	;;
+      esac
+      ;;
+
+    darwin* | rhapsody*)
+
+
+  archive_cmds_need_lc=no
+  hardcode_direct=no
+  hardcode_automatic=yes
+  hardcode_shlibpath_var=unsupported
+  if test yes = "$lt_cv_ld_force_load"; then
+    whole_archive_flag_spec='`for conv in $convenience\"\"; do test  -n \"$conv\" && new_convenience=\"$new_convenience $wl-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`'
+
+  else
+    whole_archive_flag_spec=''
+  fi
+  link_all_deplibs=yes
+  allow_undefined_flag=$_lt_dar_allow_undefined
+  case $cc_basename in
+     ifort*|nagfor*) _lt_dar_can_shared=yes ;;
+     *) _lt_dar_can_shared=$GCC ;;
+  esac
+  if test yes = "$_lt_dar_can_shared"; then
+    output_verbose_link_cmd=func_echo_all
+    archive_cmds="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dsymutil"
+    module_cmds="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dsymutil"
+    archive_expsym_cmds="sed 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dar_export_syms$_lt_dsymutil"
+    module_expsym_cmds="sed -e 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dar_export_syms$_lt_dsymutil"
+
+  else
+  ld_shlibs=no
+  fi
+
+      ;;
+
+    dgux*)
+      archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+      hardcode_libdir_flag_spec='-L$libdir'
+      hardcode_shlibpath_var=no
+      ;;
+
+    # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor
+    # support.  Future versions do this automatically, but an explicit c++rt0.o
+    # does not break anything, and helps significantly (at the cost of a little
+    # extra space).
+    freebsd2.2*)
+      archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o'
+      hardcode_libdir_flag_spec='-R$libdir'
+      hardcode_direct=yes
+      hardcode_shlibpath_var=no
+      ;;
+
+    # Unfortunately, older versions of FreeBSD 2 do not have this feature.
+    freebsd2.*)
+      archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+      hardcode_direct=yes
+      hardcode_minus_L=yes
+      hardcode_shlibpath_var=no
+      ;;
+
+    # FreeBSD 3 and greater uses gcc -shared to do shared libraries.
+    freebsd* | dragonfly*)
+      archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
+      hardcode_libdir_flag_spec='-R$libdir'
+      hardcode_direct=yes
+      hardcode_shlibpath_var=no
+      ;;
+
+    hpux9*)
+      if test yes = "$GCC"; then
+	archive_cmds='$RM $output_objdir/$soname~$CC -shared $pic_flag $wl+b $wl$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib'
+      else
+	archive_cmds='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib'
+      fi
+      hardcode_libdir_flag_spec='$wl+b $wl$libdir'
+      hardcode_libdir_separator=:
+      hardcode_direct=yes
+
+      # hardcode_minus_L: Not really in the search PATH,
+      # but as the default location of the library.
+      hardcode_minus_L=yes
+      export_dynamic_flag_spec='$wl-E'
+      ;;
+
+    hpux10*)
+      if test yes,no = "$GCC,$with_gnu_ld"; then
+	archive_cmds='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
+      else
+	archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags'
+      fi
+      if test no = "$with_gnu_ld"; then
+	hardcode_libdir_flag_spec='$wl+b $wl$libdir'
+	hardcode_libdir_separator=:
+	hardcode_direct=yes
+	hardcode_direct_absolute=yes
+	export_dynamic_flag_spec='$wl-E'
+	# hardcode_minus_L: Not really in the search PATH,
+	# but as the default location of the library.
+	hardcode_minus_L=yes
+      fi
+      ;;
+
+    hpux11*)
+      if test yes,no = "$GCC,$with_gnu_ld"; then
+	case $host_cpu in
+	hppa*64*)
+	  archive_cmds='$CC -shared $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	ia64*)
+	  archive_cmds='$CC -shared $pic_flag $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	*)
+	  archive_cmds='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	esac
+      else
+	case $host_cpu in
+	hppa*64*)
+	  archive_cmds='$CC -b $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	ia64*)
+	  archive_cmds='$CC -b $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	*)
+
+	  # Older versions of the 11.00 compiler do not understand -b yet
+	  # (HP92453-01 A.11.01.20 doesn't, HP92453-01 B.11.X.35175-35176.GP does)
+	  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $CC understands -b" >&5
+$as_echo_n "checking if $CC understands -b... " >&6; }
+if ${lt_cv_prog_compiler__b+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler__b=no
+   save_LDFLAGS=$LDFLAGS
+   LDFLAGS="$LDFLAGS -b"
+   echo "$lt_simple_link_test_code" > conftest.$ac_ext
+   if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then
+     # The linker can only warn and ignore the option if not recognized
+     # So say no if there are warnings
+     if test -s conftest.err; then
+       # Append any errors to the config.log.
+       cat conftest.err 1>&5
+       $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp
+       $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
+       if diff conftest.exp conftest.er2 >/dev/null; then
+         lt_cv_prog_compiler__b=yes
+       fi
+     else
+       lt_cv_prog_compiler__b=yes
+     fi
+   fi
+   $RM -r conftest*
+   LDFLAGS=$save_LDFLAGS
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler__b" >&5
+$as_echo "$lt_cv_prog_compiler__b" >&6; }
+
+if test yes = "$lt_cv_prog_compiler__b"; then
+    archive_cmds='$CC -b $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
+else
+    archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags'
+fi
+
+	  ;;
+	esac
+      fi
+      if test no = "$with_gnu_ld"; then
+	hardcode_libdir_flag_spec='$wl+b $wl$libdir'
+	hardcode_libdir_separator=:
+
+	case $host_cpu in
+	hppa*64*|ia64*)
+	  hardcode_direct=no
+	  hardcode_shlibpath_var=no
+	  ;;
+	*)
+	  hardcode_direct=yes
+	  hardcode_direct_absolute=yes
+	  export_dynamic_flag_spec='$wl-E'
+
+	  # hardcode_minus_L: Not really in the search PATH,
+	  # but as the default location of the library.
+	  hardcode_minus_L=yes
+	  ;;
+	esac
+      fi
+      ;;
+
+    irix5* | irix6* | nonstopux*)
+      if test yes = "$GCC"; then
+	archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib'
+	# Try to use the -exported_symbol ld option, if it does not
+	# work, assume that -exports_file does not work either and
+	# implicitly export all symbols.
+	# This should be the same for all languages, so no per-tag cache variable.
+	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $host_os linker accepts -exported_symbol" >&5
+$as_echo_n "checking whether the $host_os linker accepts -exported_symbol... " >&6; }
+if ${lt_cv_irix_exported_symbol+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  save_LDFLAGS=$LDFLAGS
+	   LDFLAGS="$LDFLAGS -shared $wl-exported_symbol ${wl}foo $wl-update_registry $wl/dev/null"
+	   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+int foo (void) { return 0; }
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  lt_cv_irix_exported_symbol=yes
+else
+  lt_cv_irix_exported_symbol=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+           LDFLAGS=$save_LDFLAGS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_irix_exported_symbol" >&5
+$as_echo "$lt_cv_irix_exported_symbol" >&6; }
+	if test yes = "$lt_cv_irix_exported_symbol"; then
+          archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations $wl-exports_file $wl$export_symbols -o $lib'
+	fi
+	link_all_deplibs=no
+      else
+	archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib'
+	archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -exports_file $export_symbols -o $lib'
+      fi
+      archive_cmds_need_lc='no'
+      hardcode_libdir_flag_spec='$wl-rpath $wl$libdir'
+      hardcode_libdir_separator=:
+      inherit_rpath=yes
+      link_all_deplibs=yes
+      ;;
+
+    linux*)
+      case $cc_basename in
+      tcc*)
+	# Fabrice Bellard et al's Tiny C Compiler
+	ld_shlibs=yes
+	archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
+	;;
+      esac
+      ;;
+
+    netbsd* | netbsdelf*-gnu)
+      if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
+	archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'  # a.out
+      else
+	archive_cmds='$LD -shared -o $lib $libobjs $deplibs $linker_flags'      # ELF
+      fi
+      hardcode_libdir_flag_spec='-R$libdir'
+      hardcode_direct=yes
+      hardcode_shlibpath_var=no
+      ;;
+
+    newsos6)
+      archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+      hardcode_direct=yes
+      hardcode_libdir_flag_spec='$wl-rpath $wl$libdir'
+      hardcode_libdir_separator=:
+      hardcode_shlibpath_var=no
+      ;;
+
+    *nto* | *qnx*)
+      ;;
+
+    openbsd* | bitrig*)
+      if test -f /usr/libexec/ld.so; then
+	hardcode_direct=yes
+	hardcode_shlibpath_var=no
+	hardcode_direct_absolute=yes
+	if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then
+	  archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
+	  archive_expsym_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags $wl-retain-symbols-file,$export_symbols'
+	  hardcode_libdir_flag_spec='$wl-rpath,$libdir'
+	  export_dynamic_flag_spec='$wl-E'
+	else
+	  archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
+	  hardcode_libdir_flag_spec='$wl-rpath,$libdir'
+	fi
+      else
+	ld_shlibs=no
+      fi
+      ;;
+
+    os2*)
+      hardcode_libdir_flag_spec='-L$libdir'
+      hardcode_minus_L=yes
+      allow_undefined_flag=unsupported
+      shrext_cmds=.dll
+      archive_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~
+	$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~
+	$ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~
+	$ECHO EXPORTS >> $output_objdir/$libname.def~
+	emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~
+	$CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~
+	emximp -o $lib $output_objdir/$libname.def'
+      archive_expsym_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~
+	$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~
+	$ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~
+	$ECHO EXPORTS >> $output_objdir/$libname.def~
+	prefix_cmds="$SED"~
+	if test EXPORTS = "`$SED 1q $export_symbols`"; then
+	  prefix_cmds="$prefix_cmds -e 1d";
+	fi~
+	prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~
+	cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~
+	$CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~
+	emximp -o $lib $output_objdir/$libname.def'
+      old_archive_From_new_cmds='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def'
+      enable_shared_with_static_runtimes=yes
+      ;;
+
+    osf3*)
+      if test yes = "$GCC"; then
+	allow_undefined_flag=' $wl-expect_unresolved $wl\*'
+	archive_cmds='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib'
+      else
+	allow_undefined_flag=' -expect_unresolved \*'
+	archive_cmds='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib'
+      fi
+      archive_cmds_need_lc='no'
+      hardcode_libdir_flag_spec='$wl-rpath $wl$libdir'
+      hardcode_libdir_separator=:
+      ;;
+
+    osf4* | osf5*)	# as osf3* with the addition of -msym flag
+      if test yes = "$GCC"; then
+	allow_undefined_flag=' $wl-expect_unresolved $wl\*'
+	archive_cmds='$CC -shared$allow_undefined_flag $pic_flag $libobjs $deplibs $compiler_flags $wl-msym $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib'
+	hardcode_libdir_flag_spec='$wl-rpath $wl$libdir'
+      else
+	allow_undefined_flag=' -expect_unresolved \*'
+	archive_cmds='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib'
+	archive_expsym_cmds='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~
+          $CC -shared$allow_undefined_flag $wl-input $wl$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib~$RM $lib.exp'
+
+	# Both c and cxx compiler support -rpath directly
+	hardcode_libdir_flag_spec='-rpath $libdir'
+      fi
+      archive_cmds_need_lc='no'
+      hardcode_libdir_separator=:
+      ;;
+
+    solaris*)
+      no_undefined_flag=' -z defs'
+      if test yes = "$GCC"; then
+	wlarc='$wl'
+	archive_cmds='$CC -shared $pic_flag $wl-z ${wl}text $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags'
+	archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
+          $CC -shared $pic_flag $wl-z ${wl}text $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp'
+      else
+	case `$CC -V 2>&1` in
+	*"Compilers 5.0"*)
+	  wlarc=''
+	  archive_cmds='$LD -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $linker_flags'
+	  archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
+            $LD -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp'
+	  ;;
+	*)
+	  wlarc='$wl'
+	  archive_cmds='$CC -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $compiler_flags'
+	  archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
+            $CC -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp'
+	  ;;
+	esac
+      fi
+      hardcode_libdir_flag_spec='-R$libdir'
+      hardcode_shlibpath_var=no
+      case $host_os in
+      solaris2.[0-5] | solaris2.[0-5].*) ;;
+      *)
+	# The compiler driver will combine and reorder linker options,
+	# but understands '-z linker_flag'.  GCC discards it without '$wl',
+	# but is careful enough not to reorder.
+	# Supported since Solaris 2.6 (maybe 2.5.1?)
+	if test yes = "$GCC"; then
+	  whole_archive_flag_spec='$wl-z ${wl}allextract$convenience $wl-z ${wl}defaultextract'
+	else
+	  whole_archive_flag_spec='-z allextract$convenience -z defaultextract'
+	fi
+	;;
+      esac
+      link_all_deplibs=yes
+      ;;
+
+    sunos4*)
+      if test sequent = "$host_vendor"; then
+	# Use $CC to link under sequent, because it throws in some extra .o
+	# files that make .init and .fini sections work.
+	archive_cmds='$CC -G $wl-h $soname -o $lib $libobjs $deplibs $compiler_flags'
+      else
+	archive_cmds='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags'
+      fi
+      hardcode_libdir_flag_spec='-L$libdir'
+      hardcode_direct=yes
+      hardcode_minus_L=yes
+      hardcode_shlibpath_var=no
+      ;;
+
+    sysv4)
+      case $host_vendor in
+	sni)
+	  archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+	  hardcode_direct=yes # is this really true???
+	;;
+	siemens)
+	  ## LD is ld it makes a PLAMLIB
+	  ## CC just makes a GrossModule.
+	  archive_cmds='$LD -G -o $lib $libobjs $deplibs $linker_flags'
+	  reload_cmds='$CC -r -o $output$reload_objs'
+	  hardcode_direct=no
+        ;;
+	motorola)
+	  archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+	  hardcode_direct=no #Motorola manual says yes, but my tests say they lie
+	;;
+      esac
+      runpath_var='LD_RUN_PATH'
+      hardcode_shlibpath_var=no
+      ;;
+
+    sysv4.3*)
+      archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+      hardcode_shlibpath_var=no
+      export_dynamic_flag_spec='-Bexport'
+      ;;
+
+    sysv4*MP*)
+      if test -d /usr/nec; then
+	archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+	hardcode_shlibpath_var=no
+	runpath_var=LD_RUN_PATH
+	hardcode_runpath_var=yes
+	ld_shlibs=yes
+      fi
+      ;;
+
+    sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*)
+      no_undefined_flag='$wl-z,text'
+      archive_cmds_need_lc=no
+      hardcode_shlibpath_var=no
+      runpath_var='LD_RUN_PATH'
+
+      if test yes = "$GCC"; then
+	archive_cmds='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	archive_expsym_cmds='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+      else
+	archive_cmds='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	archive_expsym_cmds='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+      fi
+      ;;
+
+    sysv5* | sco3.2v5* | sco5v6*)
+      # Note: We CANNOT use -z defs as we might desire, because we do not
+      # link with -lc, and that would cause any symbols used from libc to
+      # always be unresolved, which means just about no library would
+      # ever link correctly.  If we're not using GNU ld we use -z text
+      # though, which does catch some bad symbols but isn't as heavy-handed
+      # as -z defs.
+      no_undefined_flag='$wl-z,text'
+      allow_undefined_flag='$wl-z,nodefs'
+      archive_cmds_need_lc=no
+      hardcode_shlibpath_var=no
+      hardcode_libdir_flag_spec='$wl-R,$libdir'
+      hardcode_libdir_separator=':'
+      link_all_deplibs=yes
+      export_dynamic_flag_spec='$wl-Bexport'
+      runpath_var='LD_RUN_PATH'
+
+      if test yes = "$GCC"; then
+	archive_cmds='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	archive_expsym_cmds='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+      else
+	archive_cmds='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	archive_expsym_cmds='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+      fi
+      ;;
+
+    uts4*)
+      archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+      hardcode_libdir_flag_spec='-L$libdir'
+      hardcode_shlibpath_var=no
+      ;;
+
+    *)
+      ld_shlibs=no
+      ;;
+    esac
+
+    if test sni = "$host_vendor"; then
+      case $host in
+      sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
+	export_dynamic_flag_spec='$wl-Blargedynsym'
+	;;
+      esac
+    fi
+  fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs" >&5
+$as_echo "$ld_shlibs" >&6; }
+test no = "$ld_shlibs" && can_build_shared=no
+
+with_gnu_ld=$with_gnu_ld
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#
+# Do we need to explicitly link libc?
+#
+case "x$archive_cmds_need_lc" in
+x|xyes)
+  # Assume -lc should be added
+  archive_cmds_need_lc=yes
+
+  if test yes,yes = "$GCC,$enable_shared"; then
+    case $archive_cmds in
+    *'~'*)
+      # FIXME: we may have to deal with multi-command sequences.
+      ;;
+    '$CC '*)
+      # Test whether the compiler implicitly links with -lc since on some
+      # systems, -lgcc has to come before -lc. If gcc already passes -lc
+      # to ld, don't add -lc before -lgcc.
+      { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5
+$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; }
+if ${lt_cv_archive_cmds_need_lc+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  $RM conftest*
+	echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+
+	if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
+  (eval $ac_compile) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } 2>conftest.err; then
+	  soname=conftest
+	  lib=conftest
+	  libobjs=conftest.$ac_objext
+	  deplibs=
+	  wl=$lt_prog_compiler_wl
+	  pic_flag=$lt_prog_compiler_pic
+	  compiler_flags=-v
+	  linker_flags=-v
+	  verstring=
+	  output_objdir=.
+	  libname=conftest
+	  lt_save_allow_undefined_flag=$allow_undefined_flag
+	  allow_undefined_flag=
+	  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5
+  (eval $archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+	  then
+	    lt_cv_archive_cmds_need_lc=no
+	  else
+	    lt_cv_archive_cmds_need_lc=yes
+	  fi
+	  allow_undefined_flag=$lt_save_allow_undefined_flag
+	else
+	  cat conftest.err 1>&5
+	fi
+	$RM conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc" >&5
+$as_echo "$lt_cv_archive_cmds_need_lc" >&6; }
+      archive_cmds_need_lc=$lt_cv_archive_cmds_need_lc
+      ;;
+    esac
+  fi
+  ;;
+esac
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5
+$as_echo_n "checking dynamic linker characteristics... " >&6; }
+
+if test yes = "$GCC"; then
+  case $host_os in
+    darwin*) lt_awk_arg='/^libraries:/,/LR/' ;;
+    *) lt_awk_arg='/^libraries:/' ;;
+  esac
+  case $host_os in
+    mingw* | cegcc*) lt_sed_strip_eq='s|=\([A-Za-z]:\)|\1|g' ;;
+    *) lt_sed_strip_eq='s|=/|/|g' ;;
+  esac
+  lt_search_path_spec=`$CC -print-search-dirs | awk $lt_awk_arg | $SED -e "s/^libraries://" -e $lt_sed_strip_eq`
+  case $lt_search_path_spec in
+  *\;*)
+    # if the path contains ";" then we assume it to be the separator
+    # otherwise default to the standard path separator (i.e. ":") - it is
+    # assumed that no part of a normal pathname contains ";" but that should
+    # okay in the real world where ";" in dirpaths is itself problematic.
+    lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED 's/;/ /g'`
+    ;;
+  *)
+    lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED "s/$PATH_SEPARATOR/ /g"`
+    ;;
+  esac
+  # Ok, now we have the path, separated by spaces, we can step through it
+  # and add multilib dir if necessary...
+  lt_tmp_lt_search_path_spec=
+  lt_multi_os_dir=/`$CC $CPPFLAGS $CFLAGS $LDFLAGS -print-multi-os-directory 2>/dev/null`
+  # ...but if some path component already ends with the multilib dir we assume
+  # that all is fine and trust -print-search-dirs as is (GCC 4.2? or newer).
+  case "$lt_multi_os_dir; $lt_search_path_spec " in
+  "/; "* | "/.; "* | "/./; "* | *"$lt_multi_os_dir "* | *"$lt_multi_os_dir/ "*)
+    lt_multi_os_dir=
+    ;;
+  esac
+  for lt_sys_path in $lt_search_path_spec; do
+    if test -d "$lt_sys_path$lt_multi_os_dir"; then
+      lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path$lt_multi_os_dir"
+    elif test -n "$lt_multi_os_dir"; then
+      test -d "$lt_sys_path" && \
+	lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path"
+    fi
+  done
+  lt_search_path_spec=`$ECHO "$lt_tmp_lt_search_path_spec" | awk '
+BEGIN {RS = " "; FS = "/|\n";} {
+  lt_foo = "";
+  lt_count = 0;
+  for (lt_i = NF; lt_i > 0; lt_i--) {
+    if ($lt_i != "" && $lt_i != ".") {
+      if ($lt_i == "..") {
+        lt_count++;
+      } else {
+        if (lt_count == 0) {
+          lt_foo = "/" $lt_i lt_foo;
+        } else {
+          lt_count--;
+        }
+      }
+    }
+  }
+  if (lt_foo != "") { lt_freq[lt_foo]++; }
+  if (lt_freq[lt_foo] == 1) { print lt_foo; }
+}'`
+  # AWK program above erroneously prepends '/' to C:/dos/paths
+  # for these hosts.
+  case $host_os in
+    mingw* | cegcc*) lt_search_path_spec=`$ECHO "$lt_search_path_spec" |\
+      $SED 's|/\([A-Za-z]:\)|\1|g'` ;;
+  esac
+  sys_lib_search_path_spec=`$ECHO "$lt_search_path_spec" | $lt_NL2SP`
+else
+  sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib"
+fi
+library_names_spec=
+libname_spec='lib$name'
+soname_spec=
+shrext_cmds=.so
+postinstall_cmds=
+postuninstall_cmds=
+finish_cmds=
+finish_eval=
+shlibpath_var=
+shlibpath_overrides_runpath=unknown
+version_type=none
+dynamic_linker="$host_os ld.so"
+sys_lib_dlsearch_path_spec="/lib /usr/lib"
+need_lib_prefix=unknown
+hardcode_into_libs=no
+
+# when you set need_version to no, make sure it does not cause -set_version
+# flags to be left without arguments
+need_version=unknown
+
+
+
+case $host_os in
+aix3*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  library_names_spec='$libname$release$shared_ext$versuffix $libname.a'
+  shlibpath_var=LIBPATH
+
+  # AIX 3 has no versioning support, so we append a major version to the name.
+  soname_spec='$libname$release$shared_ext$major'
+  ;;
+
+aix[4-9]*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_lib_prefix=no
+  need_version=no
+  hardcode_into_libs=yes
+  if test ia64 = "$host_cpu"; then
+    # AIX 5 supports IA64
+    library_names_spec='$libname$release$shared_ext$major $libname$release$shared_ext$versuffix $libname$shared_ext'
+    shlibpath_var=LD_LIBRARY_PATH
+  else
+    # With GCC up to 2.95.x, collect2 would create an import file
+    # for dependence libraries.  The import file would start with
+    # the line '#! .'.  This would cause the generated library to
+    # depend on '.', always an invalid library.  This was fixed in
+    # development snapshots of GCC prior to 3.0.
+    case $host_os in
+      aix4 | aix4.[01] | aix4.[01].*)
+      if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)'
+	   echo ' yes '
+	   echo '#endif'; } | $CC -E - | $GREP yes > /dev/null; then
+	:
+      else
+	can_build_shared=no
+      fi
+      ;;
+    esac
+    # Using Import Files as archive members, it is possible to support
+    # filename-based versioning of shared library archives on AIX. While
+    # this would work for both with and without runtime linking, it will
+    # prevent static linking of such archives. So we do filename-based
+    # shared library versioning with .so extension only, which is used
+    # when both runtime linking and shared linking is enabled.
+    # Unfortunately, runtime linking may impact performance, so we do
+    # not want this to be the default eventually. Also, we use the
+    # versioned .so libs for executables only if there is the -brtl
+    # linker flag in LDFLAGS as well, or --with-aix-soname=svr4 only.
+    # To allow for filename-based versioning support, we need to create
+    # libNAME.so.V as an archive file, containing:
+    # *) an Import File, referring to the versioned filename of the
+    #    archive as well as the shared archive member, telling the
+    #    bitwidth (32 or 64) of that shared object, and providing the
+    #    list of exported symbols of that shared object, eventually
+    #    decorated with the 'weak' keyword
+    # *) the shared object with the F_LOADONLY flag set, to really avoid
+    #    it being seen by the linker.
+    # At run time we better use the real file rather than another symlink,
+    # but for link time we create the symlink libNAME.so -> libNAME.so.V
+
+    case $with_aix_soname,$aix_use_runtimelinking in
+    # AIX (on Power*) has no versioning support, so currently we cannot hardcode correct
+    # soname into executable. Probably we can add versioning support to
+    # collect2, so additional links can be useful in future.
+    aix,yes) # traditional libtool
+      dynamic_linker='AIX unversionable lib.so'
+      # If using run time linking (on AIX 4.2 or later) use lib.so
+      # instead of lib.a to let people know that these are not
+      # typical AIX shared libraries.
+      library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+      ;;
+    aix,no) # traditional AIX only
+      dynamic_linker='AIX lib.a(lib.so.V)'
+      # We preserve .a as extension for shared libraries through AIX4.2
+      # and later when we are not doing run time linking.
+      library_names_spec='$libname$release.a $libname.a'
+      soname_spec='$libname$release$shared_ext$major'
+      ;;
+    svr4,*) # full svr4 only
+      dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o)"
+      library_names_spec='$libname$release$shared_ext$major $libname$shared_ext'
+      # We do not specify a path in Import Files, so LIBPATH fires.
+      shlibpath_overrides_runpath=yes
+      ;;
+    *,yes) # both, prefer svr4
+      dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o), lib.a(lib.so.V)"
+      library_names_spec='$libname$release$shared_ext$major $libname$shared_ext'
+      # unpreferred sharedlib libNAME.a needs extra handling
+      postinstall_cmds='test -n "$linkname" || linkname="$realname"~func_stripname "" ".so" "$linkname"~$install_shared_prog "$dir/$func_stripname_result.$libext" "$destdir/$func_stripname_result.$libext"~test -z "$tstripme" || test -z "$striplib" || $striplib "$destdir/$func_stripname_result.$libext"'
+      postuninstall_cmds='for n in $library_names $old_library; do :; done~func_stripname "" ".so" "$n"~test "$func_stripname_result" = "$n" || func_append rmfiles " $odir/$func_stripname_result.$libext"'
+      # We do not specify a path in Import Files, so LIBPATH fires.
+      shlibpath_overrides_runpath=yes
+      ;;
+    *,no) # both, prefer aix
+      dynamic_linker="AIX lib.a(lib.so.V), lib.so.V($shared_archive_member_spec.o)"
+      library_names_spec='$libname$release.a $libname.a'
+      soname_spec='$libname$release$shared_ext$major'
+      # unpreferred sharedlib libNAME.so.V and symlink libNAME.so need extra handling
+      postinstall_cmds='test -z "$dlname" || $install_shared_prog $dir/$dlname $destdir/$dlname~test -z "$tstripme" || test -z "$striplib" || $striplib $destdir/$dlname~test -n "$linkname" || linkname=$realname~func_stripname "" ".a" "$linkname"~(cd "$destdir" && $LN_S -f $dlname $func_stripname_result.so)'
+      postuninstall_cmds='test -z "$dlname" || func_append rmfiles " $odir/$dlname"~for n in $old_library $library_names; do :; done~func_stripname "" ".a" "$n"~func_append rmfiles " $odir/$func_stripname_result.so"'
+      ;;
+    esac
+    shlibpath_var=LIBPATH
+  fi
+  ;;
+
+amigaos*)
+  case $host_cpu in
+  powerpc)
+    # Since July 2007 AmigaOS4 officially supports .so libraries.
+    # When compiling the executable, add -use-dynld -Lsobjs: to the compileline.
+    library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+    ;;
+  m68k)
+    library_names_spec='$libname.ixlibrary $libname.a'
+    # Create ${libname}_ixlibrary.a entries in /sys/libs.
+    finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done'
+    ;;
+  esac
+  ;;
+
+beos*)
+  library_names_spec='$libname$shared_ext'
+  dynamic_linker="$host_os ld.so"
+  shlibpath_var=LIBRARY_PATH
+  ;;
+
+bsdi[45]*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib"
+  sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib"
+  # the default ld.so.conf also contains /usr/contrib/lib and
+  # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow
+  # libtool to hard-code these into programs
+  ;;
+
+cygwin* | mingw* | pw32* | cegcc*)
+  version_type=windows
+  shrext_cmds=.dll
+  need_version=no
+  need_lib_prefix=no
+
+  case $GCC,$cc_basename in
+  yes,*)
+    # gcc
+    library_names_spec='$libname.dll.a'
+    # DLL is installed to $(libdir)/../bin by postinstall_cmds
+    postinstall_cmds='base_file=`basename \$file`~
+      dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~
+      dldir=$destdir/`dirname \$dlpath`~
+      test -d \$dldir || mkdir -p \$dldir~
+      $install_prog $dir/$dlname \$dldir/$dlname~
+      chmod a+x \$dldir/$dlname~
+      if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then
+        eval '\''$striplib \$dldir/$dlname'\'' || exit \$?;
+      fi'
+    postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~
+      dlpath=$dir/\$dldll~
+       $RM \$dlpath'
+    shlibpath_overrides_runpath=yes
+
+    case $host_os in
+    cygwin*)
+      # Cygwin DLLs use 'cyg' prefix rather than 'lib'
+      soname_spec='`echo $libname | sed -e 's/^lib/cyg/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext'
+
+      sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/lib/w32api"
+      ;;
+    mingw* | cegcc*)
+      # MinGW DLLs use traditional 'lib' prefix
+      soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext'
+      ;;
+    pw32*)
+      # pw32 DLLs use 'pw' prefix rather than 'lib'
+      library_names_spec='`echo $libname | sed -e 's/^lib/pw/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext'
+      ;;
+    esac
+    dynamic_linker='Win32 ld.exe'
+    ;;
+
+  *,cl*)
+    # Native MSVC
+    libname_spec='$name'
+    soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext'
+    library_names_spec='$libname.dll.lib'
+
+    case $build_os in
+    mingw*)
+      sys_lib_search_path_spec=
+      lt_save_ifs=$IFS
+      IFS=';'
+      for lt_path in $LIB
+      do
+        IFS=$lt_save_ifs
+        # Let DOS variable expansion print the short 8.3 style file name.
+        lt_path=`cd "$lt_path" 2>/dev/null && cmd //C "for %i in (".") do @echo %~si"`
+        sys_lib_search_path_spec="$sys_lib_search_path_spec $lt_path"
+      done
+      IFS=$lt_save_ifs
+      # Convert to MSYS style.
+      sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | sed -e 's|\\\\|/|g' -e 's| \\([a-zA-Z]\\):| /\\1|g' -e 's|^ ||'`
+      ;;
+    cygwin*)
+      # Convert to unix form, then to dos form, then back to unix form
+      # but this time dos style (no spaces!) so that the unix form looks
+      # like /cygdrive/c/PROGRA~1:/cygdr...
+      sys_lib_search_path_spec=`cygpath --path --unix "$LIB"`
+      sys_lib_search_path_spec=`cygpath --path --dos "$sys_lib_search_path_spec" 2>/dev/null`
+      sys_lib_search_path_spec=`cygpath --path --unix "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"`
+      ;;
+    *)
+      sys_lib_search_path_spec=$LIB
+      if $ECHO "$sys_lib_search_path_spec" | $GREP ';[c-zC-Z]:/' >/dev/null; then
+        # It is most probably a Windows format PATH.
+        sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'`
+      else
+        sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"`
+      fi
+      # FIXME: find the short name or the path components, as spaces are
+      # common. (e.g. "Program Files" -> "PROGRA~1")
+      ;;
+    esac
+
+    # DLL is installed to $(libdir)/../bin by postinstall_cmds
+    postinstall_cmds='base_file=`basename \$file`~
+      dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~
+      dldir=$destdir/`dirname \$dlpath`~
+      test -d \$dldir || mkdir -p \$dldir~
+      $install_prog $dir/$dlname \$dldir/$dlname'
+    postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~
+      dlpath=$dir/\$dldll~
+       $RM \$dlpath'
+    shlibpath_overrides_runpath=yes
+    dynamic_linker='Win32 link.exe'
+    ;;
+
+  *)
+    # Assume MSVC wrapper
+    library_names_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext $libname.lib'
+    dynamic_linker='Win32 ld.exe'
+    ;;
+  esac
+  # FIXME: first we should search . and the directory the executable is in
+  shlibpath_var=PATH
+  ;;
+
+darwin* | rhapsody*)
+  dynamic_linker="$host_os dyld"
+  version_type=darwin
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$major$shared_ext $libname$shared_ext'
+  soname_spec='$libname$release$major$shared_ext'
+  shlibpath_overrides_runpath=yes
+  shlibpath_var=DYLD_LIBRARY_PATH
+  shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`'
+
+  sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/local/lib"
+  sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib'
+  ;;
+
+dgux*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  ;;
+
+freebsd* | dragonfly*)
+  # DragonFly does not have aout.  When/if they implement a new
+  # versioning mechanism, adjust this.
+  if test -x /usr/bin/objformat; then
+    objformat=`/usr/bin/objformat`
+  else
+    case $host_os in
+    freebsd[23].*) objformat=aout ;;
+    *) objformat=elf ;;
+    esac
+  fi
+  version_type=freebsd-$objformat
+  case $version_type in
+    freebsd-elf*)
+      library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+      soname_spec='$libname$release$shared_ext$major'
+      need_version=no
+      need_lib_prefix=no
+      ;;
+    freebsd-*)
+      library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix'
+      need_version=yes
+      ;;
+  esac
+  shlibpath_var=LD_LIBRARY_PATH
+  case $host_os in
+  freebsd2.*)
+    shlibpath_overrides_runpath=yes
+    ;;
+  freebsd3.[01]* | freebsdelf3.[01]*)
+    shlibpath_overrides_runpath=yes
+    hardcode_into_libs=yes
+    ;;
+  freebsd3.[2-9]* | freebsdelf3.[2-9]* | \
+  freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1)
+    shlibpath_overrides_runpath=no
+    hardcode_into_libs=yes
+    ;;
+  *) # from 4.6 on, and DragonFly
+    shlibpath_overrides_runpath=yes
+    hardcode_into_libs=yes
+    ;;
+  esac
+  ;;
+
+haiku*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_lib_prefix=no
+  need_version=no
+  dynamic_linker="$host_os runtime_loader"
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  shlibpath_var=LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/system/lib'
+  hardcode_into_libs=yes
+  ;;
+
+hpux9* | hpux10* | hpux11*)
+  # Give a soname corresponding to the major version so that dld.sl refuses to
+  # link against other versions.
+  version_type=sunos
+  need_lib_prefix=no
+  need_version=no
+  case $host_cpu in
+  ia64*)
+    shrext_cmds='.so'
+    hardcode_into_libs=yes
+    dynamic_linker="$host_os dld.so"
+    shlibpath_var=LD_LIBRARY_PATH
+    shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
+    library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+    soname_spec='$libname$release$shared_ext$major'
+    if test 32 = "$HPUX_IA64_MODE"; then
+      sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib"
+      sys_lib_dlsearch_path_spec=/usr/lib/hpux32
+    else
+      sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64"
+      sys_lib_dlsearch_path_spec=/usr/lib/hpux64
+    fi
+    ;;
+  hppa*64*)
+    shrext_cmds='.sl'
+    hardcode_into_libs=yes
+    dynamic_linker="$host_os dld.sl"
+    shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH
+    shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
+    library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+    soname_spec='$libname$release$shared_ext$major'
+    sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64"
+    sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
+    ;;
+  *)
+    shrext_cmds='.sl'
+    dynamic_linker="$host_os dld.sl"
+    shlibpath_var=SHLIB_PATH
+    shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH
+    library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+    soname_spec='$libname$release$shared_ext$major'
+    ;;
+  esac
+  # HP-UX runs *really* slowly unless shared libraries are mode 555, ...
+  postinstall_cmds='chmod 555 $lib'
+  # or fails outright, so override atomically:
+  install_override_mode=555
+  ;;
+
+interix[3-9]*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  hardcode_into_libs=yes
+  ;;
+
+irix5* | irix6* | nonstopux*)
+  case $host_os in
+    nonstopux*) version_type=nonstopux ;;
+    *)
+	if test yes = "$lt_cv_prog_gnu_ld"; then
+		version_type=linux # correct to gnu/linux during the next big refactor
+	else
+		version_type=irix
+	fi ;;
+  esac
+  need_lib_prefix=no
+  need_version=no
+  soname_spec='$libname$release$shared_ext$major'
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$release$shared_ext $libname$shared_ext'
+  case $host_os in
+  irix5* | nonstopux*)
+    libsuff= shlibsuff=
+    ;;
+  *)
+    case $LD in # libtool.m4 will add one of these switches to LD
+    *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ")
+      libsuff= shlibsuff= libmagic=32-bit;;
+    *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ")
+      libsuff=32 shlibsuff=N32 libmagic=N32;;
+    *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ")
+      libsuff=64 shlibsuff=64 libmagic=64-bit;;
+    *) libsuff= shlibsuff= libmagic=never-match;;
+    esac
+    ;;
+  esac
+  shlibpath_var=LD_LIBRARY${shlibsuff}_PATH
+  shlibpath_overrides_runpath=no
+  sys_lib_search_path_spec="/usr/lib$libsuff /lib$libsuff /usr/local/lib$libsuff"
+  sys_lib_dlsearch_path_spec="/usr/lib$libsuff /lib$libsuff"
+  hardcode_into_libs=yes
+  ;;
+
+# No shared lib support for Linux oldld, aout, or coff.
+linux*oldld* | linux*aout* | linux*coff*)
+  dynamic_linker=no
+  ;;
+
+linux*android*)
+  version_type=none # Android doesn't support versioned libraries.
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext'
+  soname_spec='$libname$release$shared_ext'
+  finish_cmds=
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+
+  # This implies no fast_install, which is unacceptable.
+  # Some rework will be needed to allow for fast_install
+  # before this can be enabled.
+  hardcode_into_libs=yes
+
+  dynamic_linker='Android linker'
+  # Don't embed -rpath directories since the linker doesn't support them.
+  hardcode_libdir_flag_spec='-L$libdir'
+  ;;
+
+# This must be glibc/ELF.
+linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+
+  # Some binutils ld are patched to set DT_RUNPATH
+  if ${lt_cv_shlibpath_overrides_runpath+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_shlibpath_overrides_runpath=no
+    save_LDFLAGS=$LDFLAGS
+    save_libdir=$libdir
+    eval "libdir=/foo; wl=\"$lt_prog_compiler_wl\"; \
+	 LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec\""
+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  if  ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then :
+  lt_cv_shlibpath_overrides_runpath=yes
+fi
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+    LDFLAGS=$save_LDFLAGS
+    libdir=$save_libdir
+
+fi
+
+  shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath
+
+  # This implies no fast_install, which is unacceptable.
+  # Some rework will be needed to allow for fast_install
+  # before this can be enabled.
+  hardcode_into_libs=yes
+
+  # Ideally, we could use ldconfig to report *all* directories which are
+  # searched for libraries, however this is still not possible.  Aside from not
+  # being certain /sbin/ldconfig is available, command
+  # 'ldconfig -N -X -v | grep ^/' on 64bit Fedora does not report /usr/lib64,
+  # even though it is searched at run-time.  Try to do the best guess by
+  # appending ld.so.conf contents (and includes) to the search path.
+  if test -f /etc/ld.so.conf; then
+    lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[	 ]*hwcap[	 ]/d;s/[:,	]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '`
+    sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra"
+  fi
+
+  # We used to test for /lib/ld.so.1 and disable shared libraries on
+  # powerpc, because MkLinux only supported shared libraries with the
+  # GNU dynamic linker.  Since this was broken with cross compilers,
+  # most powerpc-linux boxes support dynamic linking these days and
+  # people can always --disable-shared, the test was removed, and we
+  # assume the GNU/Linux dynamic linker is in use.
+  dynamic_linker='GNU/Linux ld.so'
+  ;;
+
+netbsdelf*-gnu)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  hardcode_into_libs=yes
+  dynamic_linker='NetBSD ld.elf_so'
+  ;;
+
+netbsd*)
+  version_type=sunos
+  need_lib_prefix=no
+  need_version=no
+  if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
+    library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix'
+    finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+    dynamic_linker='NetBSD (a.out) ld.so'
+  else
+    library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+    soname_spec='$libname$release$shared_ext$major'
+    dynamic_linker='NetBSD ld.elf_so'
+  fi
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  hardcode_into_libs=yes
+  ;;
+
+newsos6)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  ;;
+
+*nto* | *qnx*)
+  version_type=qnx
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  hardcode_into_libs=yes
+  dynamic_linker='ldqnx.so'
+  ;;
+
+openbsd* | bitrig*)
+  version_type=sunos
+  sys_lib_dlsearch_path_spec=/usr/lib
+  need_lib_prefix=no
+  if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then
+    need_version=no
+  else
+    need_version=yes
+  fi
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix'
+  finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  ;;
+
+os2*)
+  libname_spec='$name'
+  version_type=windows
+  shrext_cmds=.dll
+  need_version=no
+  need_lib_prefix=no
+  # OS/2 can only load a DLL with a base name of 8 characters or less.
+  soname_spec='`test -n "$os2dllname" && libname="$os2dllname";
+    v=$($ECHO $release$versuffix | tr -d .-);
+    n=$($ECHO $libname | cut -b -$((8 - ${#v})) | tr . _);
+    $ECHO $n$v`$shared_ext'
+  library_names_spec='${libname}_dll.$libext'
+  dynamic_linker='OS/2 ld.exe'
+  shlibpath_var=BEGINLIBPATH
+  sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib"
+  sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
+  postinstall_cmds='base_file=`basename \$file`~
+    dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; $ECHO \$dlname'\''`~
+    dldir=$destdir/`dirname \$dlpath`~
+    test -d \$dldir || mkdir -p \$dldir~
+    $install_prog $dir/$dlname \$dldir/$dlname~
+    chmod a+x \$dldir/$dlname~
+    if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then
+      eval '\''$striplib \$dldir/$dlname'\'' || exit \$?;
+    fi'
+  postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; $ECHO \$dlname'\''`~
+    dlpath=$dir/\$dldll~
+    $RM \$dlpath'
+  ;;
+
+osf3* | osf4* | osf5*)
+  version_type=osf
+  need_lib_prefix=no
+  need_version=no
+  soname_spec='$libname$release$shared_ext$major'
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  shlibpath_var=LD_LIBRARY_PATH
+  sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib"
+  sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
+  ;;
+
+rdos*)
+  dynamic_linker=no
+  ;;
+
+solaris*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  hardcode_into_libs=yes
+  # ldd complains unless libraries are executable
+  postinstall_cmds='chmod +x $lib'
+  ;;
+
+sunos4*)
+  version_type=sunos
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix'
+  finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  if test yes = "$with_gnu_ld"; then
+    need_lib_prefix=no
+  fi
+  need_version=yes
+  ;;
+
+sysv4 | sysv4.3*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  case $host_vendor in
+    sni)
+      shlibpath_overrides_runpath=no
+      need_lib_prefix=no
+      runpath_var=LD_RUN_PATH
+      ;;
+    siemens)
+      need_lib_prefix=no
+      ;;
+    motorola)
+      need_lib_prefix=no
+      need_version=no
+      shlibpath_overrides_runpath=no
+      sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib'
+      ;;
+  esac
+  ;;
+
+sysv4*MP*)
+  if test -d /usr/nec; then
+    version_type=linux # correct to gnu/linux during the next big refactor
+    library_names_spec='$libname$shared_ext.$versuffix $libname$shared_ext.$major $libname$shared_ext'
+    soname_spec='$libname$shared_ext.$major'
+    shlibpath_var=LD_LIBRARY_PATH
+  fi
+  ;;
+
+sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
+  version_type=sco
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  hardcode_into_libs=yes
+  if test yes = "$with_gnu_ld"; then
+    sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib'
+  else
+    sys_lib_search_path_spec='/usr/ccs/lib /usr/lib'
+    case $host_os in
+      sco3.2v5*)
+        sys_lib_search_path_spec="$sys_lib_search_path_spec /lib"
+	;;
+    esac
+  fi
+  sys_lib_dlsearch_path_spec='/usr/lib'
+  ;;
+
+tpf*)
+  # TPF is a cross-target only.  Preferred cross-host = GNU/Linux.
+  version_type=linux # correct to gnu/linux during the next big refactor
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  hardcode_into_libs=yes
+  ;;
+
+uts4*)
+  version_type=linux # correct to gnu/linux during the next big refactor
+  library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext'
+  soname_spec='$libname$release$shared_ext$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  ;;
+
+*)
+  dynamic_linker=no
+  ;;
+esac
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5
+$as_echo "$dynamic_linker" >&6; }
+test no = "$dynamic_linker" && can_build_shared=no
+
+variables_saved_for_relink="PATH $shlibpath_var $runpath_var"
+if test yes = "$GCC"; then
+  variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH"
+fi
+
+if test set = "${lt_cv_sys_lib_search_path_spec+set}"; then
+  sys_lib_search_path_spec=$lt_cv_sys_lib_search_path_spec
+fi
+
+if test set = "${lt_cv_sys_lib_dlsearch_path_spec+set}"; then
+  sys_lib_dlsearch_path_spec=$lt_cv_sys_lib_dlsearch_path_spec
+fi
+
+# remember unaugmented sys_lib_dlsearch_path content for libtool script decls...
+configure_time_dlsearch_path=$sys_lib_dlsearch_path_spec
+
+# ... but it needs LT_SYS_LIBRARY_PATH munging for other configure-time code
+func_munge_path_list sys_lib_dlsearch_path_spec "$LT_SYS_LIBRARY_PATH"
+
+# to be used as default LT_SYS_LIBRARY_PATH value in generated libtool
+configure_time_lt_sys_library_path=$LT_SYS_LIBRARY_PATH
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5
+$as_echo_n "checking how to hardcode library paths into programs... " >&6; }
+hardcode_action=
+if test -n "$hardcode_libdir_flag_spec" ||
+   test -n "$runpath_var" ||
+   test yes = "$hardcode_automatic"; then
+
+  # We can hardcode non-existent directories.
+  if test no != "$hardcode_direct" &&
+     # If the only mechanism to avoid hardcoding is shlibpath_var, we
+     # have to relink, otherwise we might link with an installed library
+     # when we should be linking with a yet-to-be-installed one
+     ## test no != "$_LT_TAGVAR(hardcode_shlibpath_var, )" &&
+     test no != "$hardcode_minus_L"; then
+    # Linking always hardcodes the temporary library directory.
+    hardcode_action=relink
+  else
+    # We can link without hardcoding, and we can hardcode nonexisting dirs.
+    hardcode_action=immediate
+  fi
+else
+  # We cannot hardcode anything, or else we can only hardcode existing
+  # directories.
+  hardcode_action=unsupported
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action" >&5
+$as_echo "$hardcode_action" >&6; }
+
+if test relink = "$hardcode_action" ||
+   test yes = "$inherit_rpath"; then
+  # Fast installation is not supported
+  enable_fast_install=no
+elif test yes = "$shlibpath_overrides_runpath" ||
+     test no = "$enable_shared"; then
+  # Fast installation is not necessary
+  enable_fast_install=needless
+fi
+
+
+
+
+
+
+  if test yes != "$enable_dlopen"; then
+  enable_dlopen=unknown
+  enable_dlopen_self=unknown
+  enable_dlopen_self_static=unknown
+else
+  lt_cv_dlopen=no
+  lt_cv_dlopen_libs=
+
+  case $host_os in
+  beos*)
+    lt_cv_dlopen=load_add_on
+    lt_cv_dlopen_libs=
+    lt_cv_dlopen_self=yes
+    ;;
+
+  mingw* | pw32* | cegcc*)
+    lt_cv_dlopen=LoadLibrary
+    lt_cv_dlopen_libs=
+    ;;
+
+  cygwin*)
+    lt_cv_dlopen=dlopen
+    lt_cv_dlopen_libs=
+    ;;
+
+  darwin*)
+    # if libdl is installed we need to link against it
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5
+$as_echo_n "checking for dlopen in -ldl... " >&6; }
+if ${ac_cv_lib_dl_dlopen+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldl  $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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char dlopen ();
+int
+main ()
+{
+return dlopen ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_dl_dlopen=yes
+else
+  ac_cv_lib_dl_dlopen=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5
+$as_echo "$ac_cv_lib_dl_dlopen" >&6; }
+if test "x$ac_cv_lib_dl_dlopen" = xyes; then :
+  lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-ldl
+else
+
+    lt_cv_dlopen=dyld
+    lt_cv_dlopen_libs=
+    lt_cv_dlopen_self=yes
+
+fi
+
+    ;;
+
+  tpf*)
+    # Don't try to run any link tests for TPF.  We know it's impossible
+    # because TPF is a cross-compiler, and we know how we open DSOs.
+    lt_cv_dlopen=dlopen
+    lt_cv_dlopen_libs=
+    lt_cv_dlopen_self=no
+    ;;
+
+  *)
+    ac_fn_c_check_func "$LINENO" "shl_load" "ac_cv_func_shl_load"
+if test "x$ac_cv_func_shl_load" = xyes; then :
+  lt_cv_dlopen=shl_load
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5
+$as_echo_n "checking for shl_load in -ldld... " >&6; }
+if ${ac_cv_lib_dld_shl_load+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldld  $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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char shl_load ();
+int
+main ()
+{
+return shl_load ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_dld_shl_load=yes
+else
+  ac_cv_lib_dld_shl_load=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5
+$as_echo "$ac_cv_lib_dld_shl_load" >&6; }
+if test "x$ac_cv_lib_dld_shl_load" = xyes; then :
+  lt_cv_dlopen=shl_load lt_cv_dlopen_libs=-ldld
+else
+  ac_fn_c_check_func "$LINENO" "dlopen" "ac_cv_func_dlopen"
+if test "x$ac_cv_func_dlopen" = xyes; then :
+  lt_cv_dlopen=dlopen
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5
+$as_echo_n "checking for dlopen in -ldl... " >&6; }
+if ${ac_cv_lib_dl_dlopen+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldl  $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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char dlopen ();
+int
+main ()
+{
+return dlopen ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_dl_dlopen=yes
+else
+  ac_cv_lib_dl_dlopen=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5
+$as_echo "$ac_cv_lib_dl_dlopen" >&6; }
+if test "x$ac_cv_lib_dl_dlopen" = xyes; then :
+  lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-ldl
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -lsvld" >&5
+$as_echo_n "checking for dlopen in -lsvld... " >&6; }
+if ${ac_cv_lib_svld_dlopen+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lsvld  $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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char dlopen ();
+int
+main ()
+{
+return dlopen ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_svld_dlopen=yes
+else
+  ac_cv_lib_svld_dlopen=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_svld_dlopen" >&5
+$as_echo "$ac_cv_lib_svld_dlopen" >&6; }
+if test "x$ac_cv_lib_svld_dlopen" = xyes; then :
+  lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-lsvld
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dld_link in -ldld" >&5
+$as_echo_n "checking for dld_link in -ldld... " >&6; }
+if ${ac_cv_lib_dld_dld_link+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldld  $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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char dld_link ();
+int
+main ()
+{
+return dld_link ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_dld_dld_link=yes
+else
+  ac_cv_lib_dld_dld_link=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_dld_link" >&5
+$as_echo "$ac_cv_lib_dld_dld_link" >&6; }
+if test "x$ac_cv_lib_dld_dld_link" = xyes; then :
+  lt_cv_dlopen=dld_link lt_cv_dlopen_libs=-ldld
+fi
+
+
+fi
+
+
+fi
+
+
+fi
+
+
+fi
+
+
+fi
+
+    ;;
+  esac
+
+  if test no = "$lt_cv_dlopen"; then
+    enable_dlopen=no
+  else
+    enable_dlopen=yes
+  fi
+
+  case $lt_cv_dlopen in
+  dlopen)
+    save_CPPFLAGS=$CPPFLAGS
+    test yes = "$ac_cv_header_dlfcn_h" && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H"
+
+    save_LDFLAGS=$LDFLAGS
+    wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\"
+
+    save_LIBS=$LIBS
+    LIBS="$lt_cv_dlopen_libs $LIBS"
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a program can dlopen itself" >&5
+$as_echo_n "checking whether a program can dlopen itself... " >&6; }
+if ${lt_cv_dlopen_self+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  	  if test yes = "$cross_compiling"; then :
+  lt_cv_dlopen_self=cross
+else
+  lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
+  lt_status=$lt_dlunknown
+  cat > conftest.$ac_ext <<_LT_EOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+#if HAVE_DLFCN_H
+#include 
+#endif
+
+#include 
+
+#ifdef RTLD_GLOBAL
+#  define LT_DLGLOBAL		RTLD_GLOBAL
+#else
+#  ifdef DL_GLOBAL
+#    define LT_DLGLOBAL		DL_GLOBAL
+#  else
+#    define LT_DLGLOBAL		0
+#  endif
+#endif
+
+/* We may have to define LT_DLLAZY_OR_NOW in the command line if we
+   find out it does not work in some platform. */
+#ifndef LT_DLLAZY_OR_NOW
+#  ifdef RTLD_LAZY
+#    define LT_DLLAZY_OR_NOW		RTLD_LAZY
+#  else
+#    ifdef DL_LAZY
+#      define LT_DLLAZY_OR_NOW		DL_LAZY
+#    else
+#      ifdef RTLD_NOW
+#        define LT_DLLAZY_OR_NOW	RTLD_NOW
+#      else
+#        ifdef DL_NOW
+#          define LT_DLLAZY_OR_NOW	DL_NOW
+#        else
+#          define LT_DLLAZY_OR_NOW	0
+#        endif
+#      endif
+#    endif
+#  endif
+#endif
+
+/* When -fvisibility=hidden is used, assume the code has been annotated
+   correspondingly for the symbols needed.  */
+#if defined __GNUC__ && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3))
+int fnord () __attribute__((visibility("default")));
+#endif
+
+int fnord () { return 42; }
+int main ()
+{
+  void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW);
+  int status = $lt_dlunknown;
+
+  if (self)
+    {
+      if (dlsym (self,"fnord"))       status = $lt_dlno_uscore;
+      else
+        {
+	  if (dlsym( self,"_fnord"))  status = $lt_dlneed_uscore;
+          else puts (dlerror ());
+	}
+      /* dlclose (self); */
+    }
+  else
+    puts (dlerror ());
+
+  return status;
+}
+_LT_EOF
+  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5
+  (eval $ac_link) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && test -s "conftest$ac_exeext" 2>/dev/null; then
+    (./conftest; exit; ) >&5 2>/dev/null
+    lt_status=$?
+    case x$lt_status in
+      x$lt_dlno_uscore) lt_cv_dlopen_self=yes ;;
+      x$lt_dlneed_uscore) lt_cv_dlopen_self=yes ;;
+      x$lt_dlunknown|x*) lt_cv_dlopen_self=no ;;
+    esac
+  else :
+    # compilation failed
+    lt_cv_dlopen_self=no
+  fi
+fi
+rm -fr conftest*
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self" >&5
+$as_echo "$lt_cv_dlopen_self" >&6; }
+
+    if test yes = "$lt_cv_dlopen_self"; then
+      wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $lt_prog_compiler_static\"
+      { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a statically linked program can dlopen itself" >&5
+$as_echo_n "checking whether a statically linked program can dlopen itself... " >&6; }
+if ${lt_cv_dlopen_self_static+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  	  if test yes = "$cross_compiling"; then :
+  lt_cv_dlopen_self_static=cross
+else
+  lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
+  lt_status=$lt_dlunknown
+  cat > conftest.$ac_ext <<_LT_EOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+#if HAVE_DLFCN_H
+#include 
+#endif
+
+#include 
+
+#ifdef RTLD_GLOBAL
+#  define LT_DLGLOBAL		RTLD_GLOBAL
+#else
+#  ifdef DL_GLOBAL
+#    define LT_DLGLOBAL		DL_GLOBAL
+#  else
+#    define LT_DLGLOBAL		0
+#  endif
+#endif
+
+/* We may have to define LT_DLLAZY_OR_NOW in the command line if we
+   find out it does not work in some platform. */
+#ifndef LT_DLLAZY_OR_NOW
+#  ifdef RTLD_LAZY
+#    define LT_DLLAZY_OR_NOW		RTLD_LAZY
+#  else
+#    ifdef DL_LAZY
+#      define LT_DLLAZY_OR_NOW		DL_LAZY
+#    else
+#      ifdef RTLD_NOW
+#        define LT_DLLAZY_OR_NOW	RTLD_NOW
+#      else
+#        ifdef DL_NOW
+#          define LT_DLLAZY_OR_NOW	DL_NOW
+#        else
+#          define LT_DLLAZY_OR_NOW	0
+#        endif
+#      endif
+#    endif
+#  endif
+#endif
+
+/* When -fvisibility=hidden is used, assume the code has been annotated
+   correspondingly for the symbols needed.  */
+#if defined __GNUC__ && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3))
+int fnord () __attribute__((visibility("default")));
+#endif
+
+int fnord () { return 42; }
+int main ()
+{
+  void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW);
+  int status = $lt_dlunknown;
+
+  if (self)
+    {
+      if (dlsym (self,"fnord"))       status = $lt_dlno_uscore;
+      else
+        {
+	  if (dlsym( self,"_fnord"))  status = $lt_dlneed_uscore;
+          else puts (dlerror ());
+	}
+      /* dlclose (self); */
+    }
+  else
+    puts (dlerror ());
+
+  return status;
+}
+_LT_EOF
+  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5
+  (eval $ac_link) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && test -s "conftest$ac_exeext" 2>/dev/null; then
+    (./conftest; exit; ) >&5 2>/dev/null
+    lt_status=$?
+    case x$lt_status in
+      x$lt_dlno_uscore) lt_cv_dlopen_self_static=yes ;;
+      x$lt_dlneed_uscore) lt_cv_dlopen_self_static=yes ;;
+      x$lt_dlunknown|x*) lt_cv_dlopen_self_static=no ;;
+    esac
+  else :
+    # compilation failed
+    lt_cv_dlopen_self_static=no
+  fi
+fi
+rm -fr conftest*
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self_static" >&5
+$as_echo "$lt_cv_dlopen_self_static" >&6; }
+    fi
+
+    CPPFLAGS=$save_CPPFLAGS
+    LDFLAGS=$save_LDFLAGS
+    LIBS=$save_LIBS
+    ;;
+  esac
+
+  case $lt_cv_dlopen_self in
+  yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;;
+  *) enable_dlopen_self=unknown ;;
+  esac
+
+  case $lt_cv_dlopen_self_static in
+  yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;;
+  *) enable_dlopen_self_static=unknown ;;
+  esac
+fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+striplib=
+old_striplib=
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stripping libraries is possible" >&5
+$as_echo_n "checking whether stripping libraries is possible... " >&6; }
+if test -n "$STRIP" && $STRIP -V 2>&1 | $GREP "GNU strip" >/dev/null; then
+  test -z "$old_striplib" && old_striplib="$STRIP --strip-debug"
+  test -z "$striplib" && striplib="$STRIP --strip-unneeded"
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+# FIXME - insert some real tests, host_os isn't really good enough
+  case $host_os in
+  darwin*)
+    if test -n "$STRIP"; then
+      striplib="$STRIP -x"
+      old_striplib="$STRIP -S"
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+    else
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+    fi
+    ;;
+  *)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+    ;;
+  esac
+fi
+
+
+
+
+
+
+
+
+
+
+
+
+  # Report what library types will actually be built
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if libtool supports shared libraries" >&5
+$as_echo_n "checking if libtool supports shared libraries... " >&6; }
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $can_build_shared" >&5
+$as_echo "$can_build_shared" >&6; }
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build shared libraries" >&5
+$as_echo_n "checking whether to build shared libraries... " >&6; }
+  test no = "$can_build_shared" && enable_shared=no
+
+  # On AIX, shared libraries and static libraries use the same namespace, and
+  # are all built from PIC.
+  case $host_os in
+  aix3*)
+    test yes = "$enable_shared" && enable_static=no
+    if test -n "$RANLIB"; then
+      archive_cmds="$archive_cmds~\$RANLIB \$lib"
+      postinstall_cmds='$RANLIB $lib'
+    fi
+    ;;
+
+  aix[4-9]*)
+    if test ia64 != "$host_cpu"; then
+      case $enable_shared,$with_aix_soname,$aix_use_runtimelinking in
+      yes,aix,yes) ;;			# shared object as lib.so file only
+      yes,svr4,*) ;;			# shared object as lib.so archive member only
+      yes,*) enable_static=no ;;	# shared object in lib.a archive as well
+      esac
+    fi
+    ;;
+  esac
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_shared" >&5
+$as_echo "$enable_shared" >&6; }
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build static libraries" >&5
+$as_echo_n "checking whether to build static libraries... " >&6; }
+  # Make sure either enable_shared or enable_static is yes.
+  test yes = "$enable_shared" || enable_static=yes
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_static" >&5
+$as_echo "$enable_static" >&6; }
+
+
+
+
+fi
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+CC=$lt_save_CC
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+        ac_config_commands="$ac_config_commands libtool"
+
+
+
+
+# Only expand once:
+
+
+host_os=$old_host_os
+
+# Extracting information from libtool's configuration
+if test -n "$RANLIB" ; then :
+  RANLIBCMD="$RANLIB"
+else
+  RANLIB="$AR rs"; RANLIBCMD=""
+
+fi
+
+case $host in #(
+  # In config/Makefile.mingw*, we had:
+  # TARGET=i686-w64-mingw32 and x86_64-w64-mingw32
+  # TOOLPREF=$(TARGET)-
+  # ARCMD=$(TOOLPREF)ar
+  # RANLIB=$(TOOLPREF)ranlib
+  # RANLIBCMD=$(TOOLPREF)ranlib
+  # However autoconf and libtool seem to use ar and ranlib
+  # So we let them do, at the moment
+  *-pc-windows) :
+
+      libext=lib
+      AR=""; RANLIB=echo; RANLIBCMD=""
+      if test "$host_cpu" = "x86_64" ; then :
+  machine="-machine:AMD64 "
+else
+  machine=""
+fi
+      mklib="link -lib -nologo $machine /out:\$(1) \$(2)"
+     ;; #(
+  *) :
+
+    mklib="rm -f \$(1) && ${AR} rc \$(1) \$(2) && ${RANLIB} \$(1)"
+   ;;
+esac
+
+## Find vendor of the C compiler
+
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking C compiler vendor" >&5
+$as_echo_n "checking C compiler vendor... " >&6; }
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+#if defined(_MSC_VER)
+msvc _MSC_VER
+#elif defined(__INTEL_COMPILER)
+icc __INTEL_COMPILER
+#elif defined(__clang_major__) && defined(__clang_minor__)
+clang __clang_major__ __clang_minor__
+#elif defined(__GNUC__) && defined(__GNUC_MINOR__)
+gcc __GNUC__ __GNUC_MINOR__
+#elif defined(__xlc__) && defined(__xlC__)
+xlc __xlC__ __xlC_ver__
+#else
+unknown
+#endif
+
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+  if ${ocaml_cv_cc_vendor+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ocaml_cv_cc_vendor=`grep '^[a-z]' conftest.i | tr -s ' ' '-'`
+fi
+
+else
+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "unexpected preprocessor failure
+See \`config.log' for more details" "$LINENO" 5; }
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ocaml_cv_cc_vendor" >&5
+$as_echo "$ocaml_cv_cc_vendor" >&6; }
+
+
+# Determine how to call the C preprocessor directly.
+# Most of the time, calling the C preprocessor through the C compiler is
+# desirable and even important.
+# In some cases, though, we want to use the C preprocessor only to
+# expand macros. In such cases, it is much more convenient to be able
+# to invoke it directly rather than through the C compiler, for instance
+# because, when invoked directly, the C preprocessor does not require
+# to be invoked on a file with a '.c' extension
+# We thus figure out how to invoke the C preprocessor directly but
+# let the CPP variable untouched, except for the MSVC port where we set it
+# manually to make sure the backward compatibility is preserved
+case $ocaml_cv_cc_vendor in #(
+  xlc-*) :
+    CPP="$CC -E -qnoppline" ;; #(
+  # suppress incompatible XLC line directives
+  msvc-*) :
+    CPP="$CC -nologo -EP" ;; #(
+  *) :
+     ;;
+esac
+
+# Libraries to build depending on the host
+
+case $host in #(
+  *-*-mingw32|*-pc-windows) :
+    unix_or_win32="win32"
+    unixlib="win32unix"
+     ;; #(
+  *) :
+    unix_or_win32="unix"
+  unixlib="unix" ;;
+esac
+case $host in #(
+  *-*-cygwin*|*-*-mingw32|*-pc-windows) :
+    exeext=".exe" ;; #(
+  *) :
+    exeext='' ;;
+esac
+
+otherlibraries="dynlink"
+if test x"$enable_unix_lib" != "xno"; then :
+  if test x"$enable_bigarray_lib" != "xno"; then :
+  otherlibraries="$otherlibraries $unixlib bigarray"
+else
+  otherlibraries="$otherlibraries $unixlib"
+fi
+fi
+if test x"$enable_str_lib" != "xno"; then :
+  otherlibraries="$otherlibraries str"
+fi
+
+# Checks for system services
+
+## Test whether #! scripts are supported
+## TODO: have two values, one for host and one for target
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether #! works in shell scripts" >&5
+$as_echo_n "checking whether #! works in shell scripts... " >&6; }
+if ${ac_cv_sys_interpreter+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  echo '#! /bin/cat
+exit 69
+' >conftest
+chmod u+x conftest
+(SHELL=/bin/sh; export SHELL; ./conftest >/dev/null 2>&1)
+if test $? -ne 69; then
+   ac_cv_sys_interpreter=yes
+else
+   ac_cv_sys_interpreter=no
+fi
+rm -f conftest
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_interpreter" >&5
+$as_echo "$ac_cv_sys_interpreter" >&6; }
+interpval=$ac_cv_sys_interpreter
+
+
+long_shebang=false
+if test "x$interpval" = "xyes"; then :
+  case $host in #(
+  *-cygwin|*-*-mingw32|*-pc-windows) :
+    shebangscripts=false ;; #(
+  *) :
+    shebangscripts=true
+       prev_exec_prefix="$exec_prefix"
+       if test "x$exec_prefix" = "xNONE"; then :
+  exec_prefix="$prefix"
+fi
+       eval "expanded_bindir=\"$bindir\""
+       exec_prefix="$prev_exec_prefix"
+       # Assume maximum shebang is 128 chars; less #!, /ocamlrun, an optional
+       # 1 char suffix and the \0 leaving 115 characters
+       if test "${#expanded_bindir}" -gt 115; then :
+  long_shebang=true
+fi
+
+     ;;
+esac
+else
+  shebangscripts=false
+
+fi
+
+# Are we building a cross-compiler
+
+if test x"$host" = x"$target"; then :
+  cross_compiler=false
+else
+  cross_compiler=true
+fi
+
+# Checks for programs
+
+## Check for the C compiler: done by libtool
+## AC_PROG_CC
+
+## Check for C99 support: done by libtool
+## AC_PROG_CC_C99
+
+## Determine which flags to use for the C compiler
+
+case $ocaml_cv_cc_vendor in #(
+  xlc-*) :
+    outputobj='-o $(EMPTY)'; gcc_warnings="-qflag=i:i" ;; #(
+  # all warnings enabled
+  msvc-*) :
+    outputobj=-Fo; gcc_warnings="" ;; #(
+  *) :
+    outputobj='-o $(EMPTY)'
+  gcc_warnings='-Wall -Wdeclaration-after-statement'
+  case 4.11.1 in #(
+  *+dev*) :
+    gcc_warnings="$gcc_warnings -Werror" ;; #(
+  *) :
+     ;;
+esac
+   ;;
+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
+#   (the OCaml runtime assumes Java-style behavior of signed integer arith.)
+# Concerning optimization level, -O3 is somewhat risky, so take -O2.
+# Concerning language version, gnu99 is ISO C99 plus GNU extensions
+# that are often used in standard headers.  Older GCC versions
+# defaults to gnu89, which is not C99.  Clang defaults to gnu99 or
+# gnu11, which is fine.
+
+# Note: the vendor macro can not recognize MinGW because it calls the
+# C preprocessor directly so no compiler specific macro like __MING32__
+# is defined. We thus catch MinGW first by looking at host and examine
+# the vendor only as a fall-back. We could put tis part of the logic
+# in the macro itself, too
+case $host in #(
+  *-*-mingw32) :
+    case $ocaml_cv_cc_vendor in #(
+  gcc-[01234]-*) :
+    as_fn_error $? "This version of Mingw GCC is too old. Please use GCC version 5 or above." "$LINENO" 5 ;; #(
+  gcc-*) :
+    internal_cflags="-Wno-unused $gcc_warnings \
+-fexcess-precision=standard"
+        # TODO: see whether the code can be fixed to avoid -Wno-unused
+        common_cflags="-O2 -fno-strict-aliasing -fwrapv -mms-bitfields"
+        internal_cppflags='-DUNICODE -D_UNICODE'
+        internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
+        internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)" ;; #(
+  *) :
+    as_fn_error $? "Unsupported C compiler for a Mingw build" "$LINENO" 5 ;;
+esac ;; #(
+  *) :
+    case $ocaml_cv_cc_vendor in #(
+  clang-*) :
+    common_cflags="-O2 -fno-strict-aliasing -fwrapv";
+      internal_cflags="$gcc_warnings -fno-common" ;; #(
+  gcc-[012]-*) :
+    # Some versions known to miscompile OCaml, e,g, 2.7.2.1, some 2.96.
+      # Plus: C99 support unknown.
+      as_fn_error $? "This version of GCC is too old. Please use GCC version 4.2 or above." "$LINENO" 5 ;; #(
+  gcc-3-*|gcc-4-[01]) :
+    # No -fwrapv option before GCC 3.4.
+      # Known problems with -fwrapv fixed in 4.2 only.
+      { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: This version of GCC is rather old. Reducing optimization level.\"" >&5
+$as_echo "$as_me: WARNING: This version of GCC is rather old. Reducing optimization level.\"" >&2;};
+      { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Consider using GCC version 4.2 or above." >&5
+$as_echo "$as_me: WARNING: Consider using GCC version 4.2 or above." >&2;};
+      common_cflags="-std=gnu99 -O";
+      internal_cflags="$gcc_warnings" ;; #(
+  gcc-4-[234]) :
+    # No -fexcess-precision option before GCC 4.5
+      common_cflags="-std=gnu99 -O2 -fno-strict-aliasing -fwrapv \
+-fno-builtin-memcmp";
+      internal_cflags="$gcc_warnings" ;; #(
+  gcc-4-*) :
+    common_cflags="-std=gnu99 -O2 -fno-strict-aliasing -fwrapv \
+-fno-builtin-memcmp";
+      internal_cflags="$gcc_warnings -fexcess-precision=standard" ;; #(
+  gcc-*) :
+    common_cflags="-O2 -fno-strict-aliasing -fwrapv";
+      internal_cflags="$gcc_warnings -fno-common \
+-fexcess-precision=standard" ;; #(
+  msvc-*) :
+    common_cflags="-nologo -O2 -Gy- -MD"
+      common_cppflags="-D_CRT_SECURE_NO_DEPRECATE"
+      internal_cppflags='-DUNICODE -D_UNICODE'
+      internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
+      internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)" ;; #(
+  xlc-*) :
+    common_cflags="-O5 -qtune=balanced -qnoipa -qinline $CFLAGS";
+      internal_cflags="$gcc_warnings" ;; #(
+  *) :
+    common_cflags="-O" ;;
+esac ;;
+esac
+
+internal_cppflags="-DCAML_NAME_SPACE $internal_cppflags"
+
+# Enable SSE2 on x86 mingw to avoid using 80-bit registers.
+case $host in #(
+  i686-*-mingw32) :
+    internal_cflags="$internal_cflags -mfpmath=sse -msse2" ;; #(
+  *) :
+     ;;
+esac
+
+# Use 64-bit file offset if possible
+# See also AC_SYS_LARGEFILE
+# Problem: flags are added to CC rather than CPPFLAGS
+case $host in #(
+  *-*-mingw32|*-pc-windows) :
+     ;; #(
+  *) :
+    common_cppflags="$common_cppflags -D_FILE_OFFSET_BITS=64" ;;
+esac
+
+# Adjust according to target
+
+# On Windows we do not take $enable_shared because it does not seem
+# to work. This should be better understood later
+#AS_CASE([$target],
+#  [*-pc-windows],
+#    [enable_shared=yes])
+
+if test x"$enable_shared" = "xno"; then :
+  with_sharedlibs=false
+fi
+
+case $CC,$host in #(
+  *,*-*-darwin*) :
+    mkexe="$mkexe -Wl,-no_compact_unwind";
+    $as_echo "#define HAS_ARCH_CODE32 1" >>confdefs.h
+ ;; #(
+  *,*-*-haiku*) :
+    mathlib="" ;; #(
+  *,*-*-cygwin*) :
+    case $target in #(
+  i686-*) :
+    flavor=cygwin ;; #(
+  x86_64-*) :
+    flavor=cygwin64 ;; #(
+  *) :
+    as_fn_error $? "unknown cygwin variant" "$LINENO" 5 ;;
+esac
+    common_cppflags="$common_cppflags -U_WIN32"
+    if $with_sharedlibs; then :
+  flexlink="flexlink -chain $flavor -merge-manifest -stack 16777216"
+      flexdir=`$flexlink -where | tr -d '\015'`
+      if test -z "$flexdir"; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: flexlink not found: native shared libraries won't be available.
+        " >&5
+$as_echo "$as_me: WARNING: flexlink not found: native shared libraries won't be available.
+        " >&2;}
+        with_sharedlibs=false
+else
+  iflexdir="-I\"$flexdir\""
+        mkexe="$flexlink -exe"
+        mkexedebugflag="-link -g"
+
+fi
+
+fi
+    if ! $with_sharedlibs; then :
+  mkexe="$mkexe -Wl,--stack,16777216"
+      oc_ldflags="-Wl,--stack,16777216"
+
+fi
+    ostype="Cygwin" ;; #(
+  *,*-*-mingw32) :
+    if $with_sharedlibs; then :
+  case $host in #(
+  i686-*-*) :
+    flexdll_chain="mingw" ;; #(
+  x86_64-*-*) :
+    flexdll_chain="mingw64" ;; #(
+  *) :
+     ;;
+esac
+      flexlink="flexlink -chain $flexdll_chain -merge-manifest -stack 16777216"
+      flexdir=`$flexlink -where | tr -d '\015'`
+      if test -z "$flexdir"; then :
+  flexdir='$(ROOTDIR)/flexdll'
+fi
+      iflexdir="-I\"$flexdir\""
+      mkexedebugflag="-link -g"
+fi
+    ostype="Win32"
+    toolchain="mingw"
+    mkexe='$(MKEXE_ANSI) $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
+    oc_ldflags='-municode'
+    SO="dll" ;; #(
+  *,*-pc-windows) :
+    toolchain=msvc
+    ostype="Win32"
+    mkexe='$(MKEXE_ANSI) $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
+    oc_ldflags='/ENTRY:wmainCRTStartup'
+    case $host in #(
+  i686-pc-windows) :
+    flexdll_chain=msvc ;; #(
+  x86_64-pc-windows) :
+    flexdll_chain=msvc64 ;; #(
+  *) :
+     ;;
+esac
+    if $with_sharedlibs; then :
+  flexlink="flexlink -chain $flexdll_chain -merge-manifest -stack 16777216"
+      flexdir=`$flexlink -where | tr -d '\015'`
+      if test -z "$flexdir"; then :
+  flexdir='$(ROOTDIR)/flexdll'
+fi
+      iflexdir="-I\"$flexdir\""
+      mkexedebugflag=''
+fi ;; #(
+  *,x86_64-*-linux*) :
+    $as_echo "#define HAS_ARCH_CODE32 1" >>confdefs.h
+ ;; #(
+  xlc*,powerpc-ibm-aix*) :
+    mkexe="$mkexe "
+     oc_ldflags="-brtl -bexpfull"
+    $as_echo "#define HAS_ARCH_CODE32 1" >>confdefs.h
+ ;; #(
+  *) :
+     ;;
+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
+# 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
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# OS/2's system install, which has a completely different semantic
+# ./install, which can be erroneously created by make from ./install.sh.
+# Reject install programs that cannot install multiple files.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5
+$as_echo_n "checking for a BSD-compatible install... " >&6; }
+if test -z "$INSTALL"; then
+if ${ac_cv_path_install+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    # Account for people who put trailing slashes in PATH elements.
+case $as_dir/ in #((
+  ./ | .// | /[cC]/* | \
+  /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \
+  ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \
+  /usr/ucb/* ) ;;
+  *)
+    # OSF1 and SCO ODT 3.0 have their own names for install.
+    # Don't use installbsd from OSF since it installs stuff as root
+    # by default.
+    for ac_prog in ginstall scoinst install; do
+      for ac_exec_ext in '' $ac_executable_extensions; do
+	if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then
+	  if test $ac_prog = install &&
+	    grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+	    # AIX install.  It has an incompatible calling convention.
+	    :
+	  elif test $ac_prog = install &&
+	    grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+	    # program-specific install script used by HP pwplus--don't use.
+	    :
+	  else
+	    rm -rf conftest.one conftest.two conftest.dir
+	    echo one > conftest.one
+	    echo two > conftest.two
+	    mkdir conftest.dir
+	    if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" &&
+	      test -s conftest.one && test -s conftest.two &&
+	      test -s conftest.dir/conftest.one &&
+	      test -s conftest.dir/conftest.two
+	    then
+	      ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"
+	      break 3
+	    fi
+	  fi
+	fi
+      done
+    done
+    ;;
+esac
+
+  done
+IFS=$as_save_IFS
+
+rm -rf conftest.one conftest.two conftest.dir
+
+fi
+  if test "${ac_cv_path_install+set}" = set; then
+    INSTALL=$ac_cv_path_install
+  else
+    # As a last resort, use the slow shell script.  Don't cache a
+    # value for INSTALL within a source directory, because that will
+    # break other packages using the cache if that directory is
+    # removed, or if the value is a relative name.
+    INSTALL=$ac_install_sh
+  fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5
+$as_echo "$INSTALL" >&6; }
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+
+# Checks for libraries
+
+## Mathematical library
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cos in -lm" >&5
+$as_echo_n "checking for cos in -lm... " >&6; }
+if ${ac_cv_lib_m_cos+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm  $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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char cos ();
+int
+main ()
+{
+return cos ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_m_cos=yes
+else
+  ac_cv_lib_m_cos=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cos" >&5
+$as_echo "$ac_cv_lib_m_cos" >&6; }
+if test "x$ac_cv_lib_m_cos" = xyes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_LIBM 1
+_ACEOF
+
+  LIBS="-lm $LIBS"
+
+fi
+
+
+if test "x$ac_cv_lib_m_cos" = xyes ; then :
+  mathlib="-lm"
+else
+  mathlib=""
+fi
+
+# Checks for header files
+
+ac_fn_c_check_header_mongrel "$LINENO" "math.h" "ac_cv_header_math_h" "$ac_includes_default"
+if test "x$ac_cv_header_math_h" = xyes; then :
+
+fi
+
+
+for ac_header in unistd.h
+do :
+  ac_fn_c_check_header_mongrel "$LINENO" "unistd.h" "ac_cv_header_unistd_h" "$ac_includes_default"
+if test "x$ac_cv_header_unistd_h" = xyes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_UNISTD_H 1
+_ACEOF
+ $as_echo "#define HAS_UNISTD 1" >>confdefs.h
+
+fi
+
+done
+
+ac_fn_c_check_header_mongrel "$LINENO" "stdint.h" "ac_cv_header_stdint_h" "$ac_includes_default"
+if test "x$ac_cv_header_stdint_h" = xyes; then :
+  $as_echo "#define HAS_STDINT_H 1" >>confdefs.h
+
+fi
+
+
+ac_fn_c_check_header_mongrel "$LINENO" "sys/shm.h" "ac_cv_header_sys_shm_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_shm_h" = xyes; then :
+  $as_echo "#define HAS_SYS_SHM_H 1" >>confdefs.h
+
+fi
+
+
+ac_fn_c_check_header_compile "$LINENO" "dirent.h" "ac_cv_header_dirent_h" "#include 
+"
+if test "x$ac_cv_header_dirent_h" = xyes; then :
+  $as_echo "#define HAS_DIRENT 1" >>confdefs.h
+
+fi
+
+
+
+ac_fn_c_check_header_compile "$LINENO" "sys/select.h" "ac_cv_header_sys_select_h" "#include 
+"
+if test "x$ac_cv_header_sys_select_h" = xyes; then :
+  $as_echo "#define HAS_SYS_SELECT_H 1" >>confdefs.h
+
+fi
+
+
+
+# Checks for types
+
+## off_t
+ac_fn_c_check_type "$LINENO" "off_t" "ac_cv_type_off_t" "$ac_includes_default"
+if test "x$ac_cv_type_off_t" = xyes; then :
+
+else
+
+cat >>confdefs.h <<_ACEOF
+#define off_t long int
+_ACEOF
+
+fi
+
+
+# Checks for structures
+
+# Checks for compiler characteristics
+
+# The cast to long int works around a bug in the HP C Compiler
+# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
+# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
+# This bug is HP SR number 8606223364.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of int" >&5
+$as_echo_n "checking size of int... " >&6; }
+if ${ac_cv_sizeof_int+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (int))" "ac_cv_sizeof_int"        "$ac_includes_default"; then :
+
+else
+  if test "$ac_cv_type_int" = yes; then
+     { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error 77 "cannot compute sizeof (int)
+See \`config.log' for more details" "$LINENO" 5; }
+   else
+     ac_cv_sizeof_int=0
+   fi
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_int" >&5
+$as_echo "$ac_cv_sizeof_int" >&6; }
+
+
+
+cat >>confdefs.h <<_ACEOF
+#define SIZEOF_INT $ac_cv_sizeof_int
+_ACEOF
+
+
+# The cast to long int works around a bug in the HP C Compiler
+# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
+# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
+# This bug is HP SR number 8606223364.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of long" >&5
+$as_echo_n "checking size of long... " >&6; }
+if ${ac_cv_sizeof_long+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (long))" "ac_cv_sizeof_long"        "$ac_includes_default"; then :
+
+else
+  if test "$ac_cv_type_long" = yes; then
+     { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error 77 "cannot compute sizeof (long)
+See \`config.log' for more details" "$LINENO" 5; }
+   else
+     ac_cv_sizeof_long=0
+   fi
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_long" >&5
+$as_echo "$ac_cv_sizeof_long" >&6; }
+
+
+
+cat >>confdefs.h <<_ACEOF
+#define SIZEOF_LONG $ac_cv_sizeof_long
+_ACEOF
+
+
+# The cast to long int works around a bug in the HP C Compiler
+# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
+# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
+# This bug is HP SR number 8606223364.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of long *" >&5
+$as_echo_n "checking size of long *... " >&6; }
+if ${ac_cv_sizeof_long_p+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (long *))" "ac_cv_sizeof_long_p"        "$ac_includes_default"; then :
+
+else
+  if test "$ac_cv_type_long_p" = yes; then
+     { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error 77 "cannot compute sizeof (long *)
+See \`config.log' for more details" "$LINENO" 5; }
+   else
+     ac_cv_sizeof_long_p=0
+   fi
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_long_p" >&5
+$as_echo "$ac_cv_sizeof_long_p" >&6; }
+
+
+
+cat >>confdefs.h <<_ACEOF
+#define SIZEOF_LONG_P $ac_cv_sizeof_long_p
+_ACEOF
+
+
+# The cast to long int works around a bug in the HP C Compiler
+# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
+# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
+# This bug is HP SR number 8606223364.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of short" >&5
+$as_echo_n "checking size of short... " >&6; }
+if ${ac_cv_sizeof_short+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (short))" "ac_cv_sizeof_short"        "$ac_includes_default"; then :
+
+else
+  if test "$ac_cv_type_short" = yes; then
+     { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error 77 "cannot compute sizeof (short)
+See \`config.log' for more details" "$LINENO" 5; }
+   else
+     ac_cv_sizeof_short=0
+   fi
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_short" >&5
+$as_echo "$ac_cv_sizeof_short" >&6; }
+
+
+
+cat >>confdefs.h <<_ACEOF
+#define SIZEOF_SHORT $ac_cv_sizeof_short
+_ACEOF
+
+
+# The cast to long int works around a bug in the HP C Compiler
+# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
+# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
+# This bug is HP SR number 8606223364.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of long long" >&5
+$as_echo_n "checking size of long long... " >&6; }
+if ${ac_cv_sizeof_long_long+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (long long))" "ac_cv_sizeof_long_long"        "$ac_includes_default"; then :
+
+else
+  if test "$ac_cv_type_long_long" = yes; then
+     { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error 77 "cannot compute sizeof (long long)
+See \`config.log' for more details" "$LINENO" 5; }
+   else
+     ac_cv_sizeof_long_long=0
+   fi
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_long_long" >&5
+$as_echo "$ac_cv_sizeof_long_long" >&6; }
+
+
+
+cat >>confdefs.h <<_ACEOF
+#define SIZEOF_LONG_LONG $ac_cv_sizeof_long_long
+_ACEOF
+
+
+
+if test "x$ac_cv_sizeof_long_p" = "x4" ; then :
+  bits=32; arch64=false
+elif test "x$ac_cv_sizeof_long_p" = "x8" ; then :
+  bits=64; arch64=true
+    $as_echo "#define ARCH_SIXTYFOUR 1" >>confdefs.h
+
+else
+  as_fn_error $? "Neither 32 nor 64 bits architecture." "$LINENO" 5
+
+fi
+
+if test "x$ac_cv_sizeof_int" != "x4" && test "x$ac_cv_sizeof_long" != "x4" \
+       && test "x$ac_cv_sizeof_short" != "x4"; then :
+  as_fn_error $? "Sorry, we can't find a 32-bit integer type." "$LINENO" 5
+
+fi
+
+if test "x$ac_cv_sizeof_long" != "x8" &&
+   test "x$ac_cv_sizeof_long_long" != "x8"; then :
+  as_fn_error $? "Sorry, we can't find a 64-bit integer type." "$LINENO" 5
+
+fi
+
+cat >>confdefs.h <<_ACEOF
+#define SIZEOF_PTR $ac_cv_sizeof_long_p
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define SIZEOF_LONGLONG $ac_cv_sizeof_long_long
+_ACEOF
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: Target is a $bits bits architecture" >&5
+$as_echo "$as_me: Target is a $bits bits architecture" >&6;}
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5
+$as_echo_n "checking whether byte ordering is bigendian... " >&6; }
+if ${ac_cv_c_bigendian+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_cv_c_bigendian=unknown
+    # See if we're dealing with a universal compiler.
+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifndef __APPLE_CC__
+	       not a universal capable compiler
+	     #endif
+	     typedef int dummy;
+
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+	# Check for potential -arch flags.  It is not universal unless
+	# there are at least two -arch flags with different values.
+	ac_arch=
+	ac_prev=
+	for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do
+	 if test -n "$ac_prev"; then
+	   case $ac_word in
+	     i?86 | x86_64 | ppc | ppc64)
+	       if test -z "$ac_arch" || test "$ac_arch" = "$ac_word"; then
+		 ac_arch=$ac_word
+	       else
+		 ac_cv_c_bigendian=universal
+		 break
+	       fi
+	       ;;
+	   esac
+	   ac_prev=
+	 elif test "x$ac_word" = "x-arch"; then
+	   ac_prev=arch
+	 fi
+       done
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+    if test $ac_cv_c_bigendian = unknown; then
+      # See if sys/param.h defines the BYTE_ORDER macro.
+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+	     #include 
+
+int
+main ()
+{
+#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \
+		     && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \
+		     && LITTLE_ENDIAN)
+	      bogus endian macros
+	     #endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  # It does; now see whether it defined to BIG_ENDIAN or not.
+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+		#include 
+
+int
+main ()
+{
+#if BYTE_ORDER != BIG_ENDIAN
+		 not big endian
+		#endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_c_bigendian=yes
+else
+  ac_cv_c_bigendian=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+    fi
+    if test $ac_cv_c_bigendian = unknown; then
+      # See if  defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris).
+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+
+int
+main ()
+{
+#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN)
+	      bogus endian macros
+	     #endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  # It does; now see whether it defined to _BIG_ENDIAN or not.
+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+
+int
+main ()
+{
+#ifndef _BIG_ENDIAN
+		 not big endian
+		#endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_c_bigendian=yes
+else
+  ac_cv_c_bigendian=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+    fi
+    if test $ac_cv_c_bigendian = unknown; then
+      # Compile a test program.
+      if test "$cross_compiling" = yes; then :
+  # Try to guess by grepping values from an object file.
+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+short int ascii_mm[] =
+		  { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 };
+		short int ascii_ii[] =
+		  { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 };
+		int use_ascii (int i) {
+		  return ascii_mm[i] + ascii_ii[i];
+		}
+		short int ebcdic_ii[] =
+		  { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 };
+		short int ebcdic_mm[] =
+		  { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 };
+		int use_ebcdic (int i) {
+		  return ebcdic_mm[i] + ebcdic_ii[i];
+		}
+		extern int foo;
+
+int
+main ()
+{
+return use_ascii (foo) == use_ebcdic (foo);
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then
+	      ac_cv_c_bigendian=yes
+	    fi
+	    if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then
+	      if test "$ac_cv_c_bigendian" = unknown; then
+		ac_cv_c_bigendian=no
+	      else
+		# finding both strings is unlikely to happen, but who knows?
+		ac_cv_c_bigendian=unknown
+	      fi
+	    fi
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$ac_includes_default
+int
+main ()
+{
+
+	     /* Are we little or big endian?  From Harbison&Steele.  */
+	     union
+	     {
+	       long int l;
+	       char c[sizeof (long int)];
+	     } u;
+	     u.l = 1;
+	     return u.c[sizeof (long int) - 1] == 1;
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+  ac_cv_c_bigendian=no
+else
+  ac_cv_c_bigendian=yes
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+  conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+    fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5
+$as_echo "$ac_cv_c_bigendian" >&6; }
+ case $ac_cv_c_bigendian in #(
+   yes)
+
+    $as_echo "#define ARCH_BIG_ENDIAN 1" >>confdefs.h
+,
+    endianness="be"
+  ;; #(
+   no)
+     endianness="le" ;; #(
+   universal)
+     as_fn_error $? "unable to handle universal endianness" "$LINENO" 5
+
+     ;; #(
+   *)
+     as_fn_error $? "could not determine endianness." "$LINENO" 5 ;;
+ esac
+
+
+# The cast to long int works around a bug in the HP C Compiler,
+# see AC_CHECK_SIZEOF for more information.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking alignment of double" >&5
+$as_echo_n "checking alignment of double... " >&6; }
+if ${ac_cv_alignof_double+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if ac_fn_c_compute_int "$LINENO" "(long int) offsetof (ac__type_alignof_, y)" "ac_cv_alignof_double"        "$ac_includes_default
+#ifndef offsetof
+# define offsetof(type, member) ((char *) &((type *) 0)->member - (char *) 0)
+#endif
+typedef struct { char x; double y; } ac__type_alignof_;"; then :
+
+else
+  if test "$ac_cv_type_double" = yes; then
+     { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error 77 "cannot compute alignment of double
+See \`config.log' for more details" "$LINENO" 5; }
+   else
+     ac_cv_alignof_double=0
+   fi
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_alignof_double" >&5
+$as_echo "$ac_cv_alignof_double" >&6; }
+
+
+
+cat >>confdefs.h <<_ACEOF
+#define ALIGNOF_DOUBLE $ac_cv_alignof_double
+_ACEOF
+
+
+# The cast to long int works around a bug in the HP C Compiler,
+# see AC_CHECK_SIZEOF for more information.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking alignment of long" >&5
+$as_echo_n "checking alignment of long... " >&6; }
+if ${ac_cv_alignof_long+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if ac_fn_c_compute_int "$LINENO" "(long int) offsetof (ac__type_alignof_, y)" "ac_cv_alignof_long"        "$ac_includes_default
+#ifndef offsetof
+# define offsetof(type, member) ((char *) &((type *) 0)->member - (char *) 0)
+#endif
+typedef struct { char x; long y; } ac__type_alignof_;"; then :
+
+else
+  if test "$ac_cv_type_long" = yes; then
+     { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error 77 "cannot compute alignment of long
+See \`config.log' for more details" "$LINENO" 5; }
+   else
+     ac_cv_alignof_long=0
+   fi
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_alignof_long" >&5
+$as_echo "$ac_cv_alignof_long" >&6; }
+
+
+
+cat >>confdefs.h <<_ACEOF
+#define ALIGNOF_LONG $ac_cv_alignof_long
+_ACEOF
+
+
+# The cast to long int works around a bug in the HP C Compiler,
+# see AC_CHECK_SIZEOF for more information.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking alignment of long long" >&5
+$as_echo_n "checking alignment of long long... " >&6; }
+if ${ac_cv_alignof_long_long+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if ac_fn_c_compute_int "$LINENO" "(long int) offsetof (ac__type_alignof_, y)" "ac_cv_alignof_long_long"        "$ac_includes_default
+#ifndef offsetof
+# define offsetof(type, member) ((char *) &((type *) 0)->member - (char *) 0)
+#endif
+typedef struct { char x; long long y; } ac__type_alignof_;"; then :
+
+else
+  if test "$ac_cv_type_long_long" = yes; then
+     { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error 77 "cannot compute alignment of long long
+See \`config.log' for more details" "$LINENO" 5; }
+   else
+     ac_cv_alignof_long_long=0
+   fi
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_alignof_long_long" >&5
+$as_echo "$ac_cv_alignof_long_long" >&6; }
+
+
+
+cat >>confdefs.h <<_ACEOF
+#define ALIGNOF_LONG_LONG $ac_cv_alignof_long_long
+_ACEOF
+
+
+
+if ! $arch64; then :
+  case $target_cpu in #(
+  i686) :
+     ;; #(
+  *) :
+    if test "$ac_cv_alignof_double" -gt 4; then :
+  $as_echo "#define ARCH_ALIGN_DOUBLE 1" >>confdefs.h
+
+fi
+     if test "x$ac_cv_sizeof_long" = "x8" &&
+            test "$ac_cv_alignof_long" -gt 4; then :
+  $as_echo "#define ARCH_ALIGN_INT64 1" >>confdefs.h
+
+else
+  if test "x$ac_cv_sizeof_long_long" = "x8" &&
+              test "$ac_cv_alignof_long_long" -gt 4; then :
+  $as_echo "#define ARCH_ALIGN_INT64 1" >>confdefs.h
+
+fi
+fi
+     ;;
+esac
+fi
+
+# Shared library support
+
+shared_libraries_supported=false
+sharedlib_cflags=''
+mksharedlib='shared-libs-not-available'
+rpath=''
+mksharedlibrpath=''
+natdynlinkopts=""
+
+if test x"$enable_shared" != "xno"; then :
+  case $host in #(
+  *-apple-darwin*) :
+    mksharedlib="$CC -shared -flat_namespace -undefined suppress \
+                   -Wl,-no_compact_unwind"
+      shared_libraries_supported=true ;; #(
+  *-*-mingw32) :
+    mksharedlib='$(FLEXLINK)'
+      mkmaindll='$(FLEXLINK) -maindll'
+      shared_libraries_supported=$with_sharedlibs ;; #(
+  *-pc-windows) :
+    mksharedlib='$(FLEXLINK)'
+      mkmaindll='$(FLEXLINK) -maindll'
+      shared_libraries_supported=$with_sharedlibs ;; #(
+  *-*-cygwin*) :
+    mksharedlib="$flexlink"
+      mkmaindll="$flexlink -maindll"
+      shared_libraries_supported=true ;; #(
+  powerpc-ibm-aix*) :
+    case $CC in #(
+  xlc*) :
+    mksharedlib="$CC -qmkshrobj -G"
+                shared_libraries_supported=true ;; #(
+  *) :
+     ;;
+esac ;; #(
+  *-*-linux*|*-*-freebsd[3-9]*|*-*-freebsd[1-9][0-9]*\
+    |*-*-openbsd*|*-*-netbsd*|*-*-dragonfly*|*-*-gnu*|*-*-haiku*) :
+    sharedlib_cflags="-fPIC"
+      mksharedlib="$CC -shared"
+      oc_ldflags="$oc_ldflags -Wl,-E"
+      rpath="-Wl,-rpath,"
+      mksharedlibrpath="-Wl,-rpath,"
+      natdynlinkopts="-Wl,-E"
+      shared_libraries_supported=true ;; #(
+  *) :
+     ;;
+esac
+fi
+
+if test -z "$mkmaindll"; then :
+  mkmaindll=$mksharedlib
+fi
+
+# Configure native dynlink
+
+natdynlink=false
+
+if test x"$enable_shared" != "xno"; then :
+  case "$host" in #(
+  *-*-cygwin*) :
+    natdynlink=true ;; #(
+  *-*-mingw32) :
+    natdynlink=true ;; #(
+  *-pc-windows) :
+    natdynlink=true ;; #(
+  i[3456]86-*-linux*) :
+    natdynlink=true ;; #(
+  i[3456]86-*-gnu*) :
+    natdynlink=true ;; #(
+  x86_64-*-linux*) :
+    natdynlink=true ;; #(
+  x86_64-*-darwin*) :
+    natdynlink=true ;; #(
+  s390x*-*-linux*) :
+    natdynlink=true ;; #(
+  powerpc*-*-linux*) :
+    natdynlink=true ;; #(
+  i686-*-kfreebsd*) :
+    natdynlink=true ;; #(
+  x86_64-*-kfreebsd*) :
+    natdynlink=true ;; #(
+  x86_64-*-dragonfly*) :
+    natdynlink=true ;; #(
+  i[3456]86-*-freebsd*) :
+    natdynlink=true ;; #(
+  x86_64-*-freebsd*) :
+    natdynlink=true ;; #(
+  i[3456]86-*-openbsd*) :
+    natdynlink=true ;; #(
+  x86_64-*-openbsd*) :
+    natdynlink=true ;; #(
+  i[3456]86-*-netbsd*) :
+    natdynlink=true ;; #(
+  x86_64-*-netbsd*) :
+    natdynlink=true ;; #(
+  i386-*-gnu0.3) :
+    natdynlink=true ;; #(
+  i[3456]86-*-haiku*) :
+    natdynlink=true ;; #(
+  arm*-*-linux*) :
+    natdynlink=true ;; #(
+  arm*-*-freebsd*) :
+    natdynlink=true ;; #(
+  earm*-*-netbsd*) :
+    natdynlink=true ;; #(
+  aarch64-*-linux*) :
+    natdynlink=true ;; #(
+  aarch64-*-freebsd*) :
+    natdynlink=true ;; #(
+  riscv*-*-linux*) :
+    natdynlink=true ;; #(
+  *) :
+     ;;
+esac
+fi
+
+# Try to work around the Skylake/Kaby Lake processor bug.
+case "$CC,$host" in #(
+  *gcc*,x86_64-*|*gcc*,i686-*) :
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports -fno-tree-vrp" >&5
+$as_echo_n "checking whether the C compiler supports -fno-tree-vrp... " >&6; }
+  saved_CFLAGS="$CFLAGS"
+  CFLAGS="-Werror -fno-tree-vrp $CFLAGS"
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+int main() { return 0; }
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  cc_has_fno_tree_vrp=true
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+  cc_has_fno_tree_vrp=false
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+  CFLAGS="$saved_CFLAGS"
+
+    if $cc_has_fno_tree_vrp; then :
+  internal_cflags="$internal_cflags -fno-tree-vrp"
+fi ;; #(
+  *) :
+     ;;
+esac
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports __attribute__((aligned(n)))" >&5
+$as_echo_n "checking whether the C compiler supports __attribute__((aligned(n)))... " >&6; }
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+typedef struct {__attribute__((aligned(8))) int t;} t;
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  $as_echo "#define SUPPORTS_ALIGNED_ATTRIBUTE 1" >>confdefs.h
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+# Configure the native-code compiler
+
+arch=none
+model=default
+system=unknown
+
+case $host in #(
+  i[3456]86-*-linux*) :
+    arch=i386; system=linux_elf ;; #(
+  i[3456]86-*-*bsd*) :
+    arch=i386; system=bsd_elf ;; #(
+  i[3456]86-*-haiku*) :
+    arch=i386; system=beos ;; #(
+  i[3456]86-*-cygwin) :
+    arch=i386; system=cygwin ;; #(
+  i[3456]86-*-gnu*) :
+    arch=i386; system=gnu ;; #(
+  i[3456]86-*-mingw32) :
+    arch=i386; system=mingw ;; #(
+  i686-pc-windows) :
+    arch=i386; system=win32 ;; #(
+  x86_64-pc-windows) :
+    arch=amd64; system=win64 ;; #(
+  powerpc64le*-*-linux*) :
+    arch=power; model=ppc64le; system=elf ;; #(
+  powerpc*-*-linux*) :
+    arch=power; if $arch64; then :
+  model=ppc64
+else
+  model=ppc
+fi; system=elf ;; #(
+  s390x*-*-linux*) :
+    arch=s390x; model=z10; system=elf ;; #(
+  armv6*-*-linux-gnueabihf) :
+    arch=arm; model=armv6; system=linux_eabihf ;; #(
+  armv7*-*-linux-gnueabihf) :
+    arch=arm; model=armv7; system=linux_eabihf ;; #(
+  armv8*-*-linux-gnueabihf) :
+    arch=arm; model=armv8; system=linux_eabihf ;; #(
+  armv8*-*-linux-gnueabi) :
+    arch=arm; model=armv8; system=linux_eabi ;; #(
+  armv7*-*-linux-gnueabi) :
+    arch=arm; model=armv7; system=linux_eabi ;; #(
+  armv6t2*-*-linux-gnueabi) :
+    arch=arm; model=armv6t2; system=linux_eabi ;; #(
+  armv6*-*-linux-gnueabi) :
+    arch=arm; model=armv6; system=linux_eabi ;; #(
+  armv6*-*-freebsd*) :
+    arch=arm; model=armv6; system=freebsd ;; #(
+  earmv6*-*-netbsd*) :
+    arch=arm; model=armv6; system=netbsd ;; #(
+  earmv7*-*-netbsd*) :
+    arch=arm; model=armv7; system=netbsd ;; #(
+  armv5te*-*-linux-gnueabi) :
+    arch=arm; model=armv5te; system=linux_eabi ;; #(
+  armv5*-*-linux-gnueabi) :
+    arch=arm; model=armv5; system=linux_eabi ;; #(
+  arm*-*-linux-gnueabihf) :
+    arch=arm; system=linux_eabihf ;; #(
+  arm*-*-linux-gnueabi) :
+    arch=arm; system=linux_eabi ;; #(
+  arm*-*-openbsd*) :
+    arch=arm; system=bsd ;; #(
+  zaurus*-*-openbsd*) :
+    arch=arm; system=bsd ;; #(
+  x86_64-*-linux*) :
+    arch=amd64; system=linux ;; #(
+  x86_64-*-gnu*) :
+    arch=amd64; system=gnu ;; #(
+  x86_64-*-dragonfly*) :
+    arch=amd64; system=dragonfly ;; #(
+  x86_64-*-freebsd*) :
+    arch=amd64; system=freebsd ;; #(
+  x86_64-*-netbsd*) :
+    arch=amd64; system=netbsd ;; #(
+  x86_64-*-openbsd*) :
+    arch=amd64; system=openbsd ;; #(
+  x86_64-*-darwin*) :
+    arch=amd64; system=macosx ;; #(
+  x86_64-*-mingw32) :
+    arch=amd64; system=mingw64 ;; #(
+  aarch64-*-linux*) :
+    arch=arm64; system=linux ;; #(
+  aarch64-*-freebsd*) :
+    arch=arm64; system=freebsd ;; #(
+  x86_64-*-cygwin*) :
+    arch=amd64; system=cygwin ;; #(
+  riscv64-*-linux*) :
+    arch=riscv; model=riscv64; system=linux
+ ;; #(
+  *) :
+     ;;
+esac
+
+if test x"$enable_native_compiler" = "xno"; then :
+  arch=none; model=default; system=unknown; native_compiler=false
+  { $as_echo "$as_me:${as_lineno-$LINENO}: the native compiler is disabled" >&5
+$as_echo "$as_me: the native compiler is disabled" >&6;}
+else
+  native_compiler=true
+fi
+
+if ! $native_compiler; then :
+  natdynlink=false
+fi
+
+if $natdynlink; then :
+  cmxs="cmxs"
+else
+  cmxs="cmx"
+fi
+
+cat >>confdefs.h <<_ACEOF
+#define OCAML_OS_TYPE "$ostype"
+_ACEOF
+
+
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}ld", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ld; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_DIRECT_LD+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$DIRECT_LD"; then
+  ac_cv_prog_DIRECT_LD="$DIRECT_LD" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_DIRECT_LD="${ac_tool_prefix}ld"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+DIRECT_LD=$ac_cv_prog_DIRECT_LD
+if test -n "$DIRECT_LD"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DIRECT_LD" >&5
+$as_echo "$DIRECT_LD" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_DIRECT_LD"; then
+  ac_ct_DIRECT_LD=$DIRECT_LD
+  # Extract the first word of "ld", so it can be a program name with args.
+set dummy ld; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_DIRECT_LD+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_DIRECT_LD"; then
+  ac_cv_prog_ac_ct_DIRECT_LD="$ac_ct_DIRECT_LD" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_DIRECT_LD="ld"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_DIRECT_LD=$ac_cv_prog_ac_ct_DIRECT_LD
+if test -n "$ac_ct_DIRECT_LD"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DIRECT_LD" >&5
+$as_echo "$ac_ct_DIRECT_LD" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_DIRECT_LD" = x; then
+    DIRECT_LD=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    DIRECT_LD=$ac_ct_DIRECT_LD
+  fi
+else
+  DIRECT_LD="$ac_cv_prog_DIRECT_LD"
+fi
+
+if test -z "$PARTIALLD"; then :
+  # The string for PACKLD must be capable of being concatenated with the
+  # output filename. Don't assume that all C compilers understand GNU -ofoo
+  # form, so ensure that the definition includes a space at the end (which is
+  # achieved using the $(EMPTY) expansion trick).
+  case "$arch,$CC,$system,$model" in #(
+  amd64,gcc*,macosx,*) :
+    PACKLD='ld -r -arch x86_64 -o $(EMPTY)' ;; #(
+  amd64,gcc*,solaris,*) :
+    PACKLD='ld -r -m elf_x86_64 -o $(EMPTY)' ;; #(
+  power,gcc*,elf,ppc) :
+    PACKLD='ld -r -m elf32ppclinux -o $(EMPTY)' ;; #(
+  power,gcc*,elf,ppc64) :
+    PACKLD='ld -r -m elf64ppc -o $(EMPTY)' ;; #(
+  power,gcc*,elf,ppc64le) :
+    PACKLD='ld -r -m elf64lppc -o $(EMPTY)' ;; #(
+  # For the Microsoft C compiler there must be no space at the end of the
+    # string.
+    *,cl,*,*) :
+    PACKLD="link -lib -nologo $machine -out:" ;; #(
+  *) :
+    PACKLD="$DIRECT_LD -r -o \$(EMPTY)" ;;
+esac
+else
+  PACKLD="$PARTIALLD -o \$(EMPTY)"
+fi
+
+if test $arch != "none" && $arch64 ; then :
+  otherlibraries="$otherlibraries raw_spacetime_lib"
+fi
+
+# Disable PIE at link time when ocamlopt does not produce position-independent
+# code and the system produces PIE executables by default and demands PIC
+# object files to do so.
+# This issue does not affect amd64 (x86_64) and s390x (Z systems),
+# since ocamlopt produces PIC object files by default.
+# Currently the problem is known for Alpine Linux on platforms other
+# than amd64 and s390x (issue #7562), and probably affects all Linux
+# distributions that use the musl standard library and dynamic loader.
+# Other systems have PIE by default but can cope with non-PIC object files,
+# e.g. Ubuntu >= 17.10 for i386, which uses the glibc dynamic loader.
+
+case $arch in #(
+  amd64|s390x|none) :
+    # ocamlopt generates PIC code or doesn't generate code at all
+     ;; #(
+  *) :
+    case $host in #(
+  *-linux-musl) :
+    # Alpine and other musl-based Linux distributions
+       common_cflags="-no-pie $common_cflags" ;; #(
+  *) :
+     ;;
+esac ;;
+esac
+
+# Assembler
+
+if test -n "$host_alias"; then :
+  toolpref="${host_alias}-"
+else
+  toolpref=""
+fi
+
+# We first compute default values for as and aspp
+# If values have been given by the user then they take precedence over
+# those just computed
+# One may want to check whether the user provided values first
+# and only compute values if none has been provided
+
+case "$arch,$system" in #(
+  i386,win32) :
+    default_as="ml -nologo -coff -Cp -c -Fo" ;; #(
+  amd64,win64) :
+    default_as="ml64 -nologo -Cp -c -Fo" ;; #(
+  amd64,macosx) :
+    case $ocaml_cv_cc_vendor in #(
+  clang-*) :
+    default_as='clang -arch x86_64 -Wno-trigraphs -c'
+        default_aspp='clang -arch x86_64 -Wno-trigraphs -c' ;; #(
+  *) :
+    default_as="${toolpref}as -arch x86_64"
+      default_aspp="${toolpref}gcc -arch x86_64 -c" ;;
+esac ;; #(
+  amd64,solaris) :
+    default_as="${toolpref}as --64"
+    default_aspp="${toolpref}gcc -m64 -c" ;; #(
+  i386,solaris) :
+    default_as="${toolpref}as"
+    default_aspp="${toolpref}gcc -c" ;; #(
+  power,elf) :
+    case $model in #(
+  ppc64le) :
+    default_as="${toolpref}as -a64 -mpower8"
+        default_aspp="${toolpref}gcc -m64 -mcpu=powerpc64le -c" ;; #(
+  ppc64) :
+    default_as="${toolpref}as -a64 -mppc64"
+        default_aspp="${toolpref}gcc -m64 -c" ;; #(
+  ppc) :
+    default_as="${toolpref}as -mppc"
+        default_aspp="${toolpref}gcc -m32 -c" ;; #(
+  *) :
+     ;;
+esac ;; #(
+  s390x,elf) :
+    default_as="${toolpref}as -m 64 -march=$model"
+    default_aspp="${toolpref}gcc -c -Wa,-march=$model" ;; #(
+  *,freebsd) :
+    default_as="${toolpref}cc -c -Wno-trigraphs"
+    default_aspp="${toolpref}cc -c -Wno-trigraphs" ;; #(
+  *,dragonfly) :
+    default_as="${toolpref}as"
+    default_aspp="${toolpref}cc -c" ;; #(
+  amd64,*|arm,*|arm64,*|i386,*|riscv,*) :
+    case $ocaml_cv_cc_vendor in #(
+  clang-*) :
+    default_as="${toolpref}clang -c -Wno-trigraphs"
+                  default_aspp="${toolpref}clang -c -Wno-trigraphs" ;; #(
+  *) :
+    default_as="${toolpref}as"
+      default_aspp="${toolpref}gcc -c" ;;
+esac ;; #(
+  *) :
+     ;;
+esac
+
+if test "$with_pic"; then :
+  fpic=true
+  $as_echo "#define CAML_WITH_FPIC 1" >>confdefs.h
+
+  internal_cflags="$internal_cflags $sharedlib_cflags"
+  default_aspp="$default_aspp $sharedlib_cflags"
+else
+  fpic=false
+fi
+
+if test -z "$AS"; then :
+  AS="$default_as"
+fi
+
+if test -z "$ASPP"; then :
+  ASPP="$default_aspp"
+fi
+
+# Checks for library functions
+
+## Check the semantics of signal handlers
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking semantics of signal handlers" >&5
+$as_echo "$as_me: checking semantics of signal handlers" >&6;}
+  ac_fn_c_check_func "$LINENO" "sigaction" "ac_cv_func_sigaction"
+if test "x$ac_cv_func_sigaction" = xyes; then :
+  has_sigaction=true
+else
+  has_sigaction=false
+fi
+
+  ac_fn_c_check_func "$LINENO" "sigprocmask" "ac_cv_func_sigprocmask"
+if test "x$ac_cv_func_sigprocmask" = xyes; then :
+  has_sigprocmask=true
+else
+  has_sigprocmask=false
+fi
+
+  if $has_sigaction && $has_sigprocmask; then :
+  $as_echo "#define POSIX_SIGNALS 1" >>confdefs.h
+
+      { $as_echo "$as_me:${as_lineno-$LINENO}: POSIX signal handling found." >&5
+$as_echo "$as_me: POSIX signal handling found." >&6;}
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: assuming signals have the System V semantics." >&5
+$as_echo "$as_me: assuming signals have the System V semantics." >&6;}
+
+
+fi
+
+
+## Check for C99 float ops
+
+# Note: this was disabled on Windows but the autoconf-generated script
+# does find the function it is looking for.
+# however the fma test does not pass so we disable the feature
+# for the moment, to be backward-compatible
+
+case $host in #(
+  *-*-mingw32|*-pc-windows) :
+     ;; #(
+  *) :
+    has_c99_float_ops=true
+  ac_fn_c_check_func "$LINENO" "expm1" "ac_cv_func_expm1"
+if test "x$ac_cv_func_expm1" = xyes; then :
+
+else
+  has_c99_float_ops=false
+fi
+
+  if $has_c99_float_ops; then :
+  ac_fn_c_check_func "$LINENO" "log1p" "ac_cv_func_log1p"
+if test "x$ac_cv_func_log1p" = xyes; then :
+
+else
+  has_c99_float_ops=false
+fi
+
+fi
+  if $has_c99_float_ops; then :
+  ac_fn_c_check_func "$LINENO" "hypot" "ac_cv_func_hypot"
+if test "x$ac_cv_func_hypot" = xyes; then :
+
+else
+  has_c99_float_ops=false
+fi
+
+fi
+  if $has_c99_float_ops; then :
+  ac_fn_c_check_func "$LINENO" "fma" "ac_cv_func_fma"
+if test "x$ac_cv_func_fma" = xyes; then :
+
+      case $target in #(
+  x86_64-*-cygwin) :
+     ;; #(
+  *) :
+    $as_echo "#define HAS_WORKING_FMA 1" >>confdefs.h
+ ;;
+esac
+else
+  has_c99_float_ops=false
+fi
+
+fi
+  if $has_c99_float_ops; then :
+  ac_fn_c_check_func "$LINENO" "copysign" "ac_cv_func_copysign"
+if test "x$ac_cv_func_copysign" = xyes; then :
+  $as_echo "#define HAS_C99_FLOAT_OPS 1" >>confdefs.h
+
+fi
+
+fi ;;
+esac
+
+## getrusage
+ac_fn_c_check_func "$LINENO" "getrusage" "ac_cv_func_getrusage"
+if test "x$ac_cv_func_getrusage" = xyes; then :
+  $as_echo "#define HAS_GETRUSAGE 1" >>confdefs.h
+
+fi
+
+
+## times
+ac_fn_c_check_func "$LINENO" "times" "ac_cv_func_times"
+if test "x$ac_cv_func_times" = xyes; then :
+  $as_echo "#define HAS_TIMES 1" >>confdefs.h
+
+fi
+
+
+## secure_getenv and __secure_getenv
+
+saved_CPPFLAGS="$CPPFLAGS"
+CPPFLAGS="-D_GNU_SOURCE $CPPFLAGS"
+
+ac_fn_c_check_func "$LINENO" "secure_getenv" "ac_cv_func_secure_getenv"
+if test "x$ac_cv_func_secure_getenv" = xyes; then :
+  $as_echo "#define HAS_SECURE_GETENV 1" >>confdefs.h
+
+else
+  ac_fn_c_check_func "$LINENO" "__secure_getenv" "ac_cv_func___secure_getenv"
+if test "x$ac_cv_func___secure_getenv" = xyes; then :
+  $as_echo "#define HAS___SECURE_GETENV 1" >>confdefs.h
+
+fi
+
+fi
+
+
+CPPFLAGS="$saved_CPPFLAGS"
+
+## issetugid
+
+ac_fn_c_check_func "$LINENO" "issetugid" "ac_cv_func_issetugid"
+if test "x$ac_cv_func_issetugid" = xyes; then :
+  $as_echo "#define HAS_ISSETUGID 1" >>confdefs.h
+
+fi
+
+
+## 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.
+
+case $host in #(
+  *-*-windows) :
+    has_monotonic_clock=true ;; #(
+  *-apple-darwin*) :
+
+    for ac_func in mach_timebase_info mach_absolute_time
+do :
+  as_ac_var=`$as_echo "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 `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+        has_monotonic_clock=true
+        $as_echo "#define HAS_MACH_ABSOLUTE_TIME 1" >>confdefs.h
+
+
+else
+  has_monotonic_clock=false
+fi
+done
+ ;; #(
+  *) :
+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+    #include 
+    #include 
+    int main(void)
+    {
+      #if !(defined(_POSIX_TIMERS) && defined(_POSIX_MONOTONIC_CLOCK)   \
+         && _POSIX_MONOTONIC_CLOCK != (-1))
+        #error "no monotonic clock source"
+      #endif
+        return 0;
+     }
+
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+      has_monotonic_clock=true
+      $as_echo "#define HAS_POSIX_MONOTONIC_CLOCK 1" >>confdefs.h
+
+
+else
+  has_monotonic_clock=false
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+ ;;
+esac
+
+# The instrumented runtime is built by default
+# if the proper clock source is found.
+# If asked via --enable-instrumented-runtime, configuration fails if the proper
+# clock source is missing.
+if test "x$enable_instrumented_runtime" != "xno" ; then :
+
+    case $host in #(
+  *-*-windows) :
+    instrumented_runtime=true ;; #(
+  *-apple-darwin*) :
+
+      case $enable_instrumented_runtime,$has_monotonic_clock in #(
+  *,true) :
+    instrumented_runtime=true ;; #(
+  yes,false) :
+
+          as_fn_error $? "Instrumented runtime support requested \
+but no proper monotonic clock source was found." "$LINENO" 5
+         ;; #(
+  auto,false) :
+    instrumented_runtime=false
+     ;; #(
+  *) :
+     ;;
+esac ;; #(
+  *) :
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing clock_gettime" >&5
+$as_echo_n "checking for library containing clock_gettime... " >&6; }
+if ${ac_cv_search_clock_gettime+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_func_search_save_LIBS=$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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char clock_gettime ();
+int
+main ()
+{
+return clock_gettime ();
+  ;
+  return 0;
+}
+_ACEOF
+for ac_lib in '' rt; do
+  if test -z "$ac_lib"; then
+    ac_res="none required"
+  else
+    ac_res=-l$ac_lib
+    LIBS="-l$ac_lib  $ac_func_search_save_LIBS"
+  fi
+  if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_search_clock_gettime=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext
+  if ${ac_cv_search_clock_gettime+:} false; then :
+  break
+fi
+done
+if ${ac_cv_search_clock_gettime+:} false; then :
+
+else
+  ac_cv_search_clock_gettime=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_clock_gettime" >&5
+$as_echo "$ac_cv_search_clock_gettime" >&6; }
+ac_res=$ac_cv_search_clock_gettime
+if test "$ac_res" != no; then :
+  test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+  has_clock_gettime=true
+else
+  has_clock_gettime=false
+fi
+
+      case $enable_instrumented_runtime,$has_clock_gettime,$has_monotonic_clock in #(
+  auto,false,*) :
+    instrumented_runtime=false ;; #(
+  auto,*,false) :
+    instrumented_runtime=false ;; #(
+  *,true,true) :
+
+            instrumented_runtime=true
+            if test "x$ac_cv_search_clock_gettime" = "xnone required"; then :
+  instrumented_runtime_ldlibs=""
+else
+  instrumented_runtime_ldlibs=$ac_cv_search_clock_gettime
+
+fi
+           ;; #(
+  yes,false,*) :
+
+           as_fn_error $? "Instrumented runtime support requested \
+but clock_gettime is missing." "$LINENO" 5
+           ;; #(
+  yes,*,false) :
+
+           as_fn_error $? "Instrumented runtime support requested \
+but no proper monotonic clock source was found." "$LINENO" 5
+
+       ;; #(
+  *) :
+     ;;
+esac
+     ;;
+esac
+
+fi
+
+## Sockets
+
+## TODO: check whether the different libraries are really useful
+
+sockets=false
+
+case $host in #(
+  *-*-mingw32|*-pc-windows) :
+    cclibs="$cclibs -lws2_32"
+    sockets=true ;; #(
+  *-*-haiku) :
+    cclibs="$cclibs -lnetwork"
+    sockets=true ;; #(
+  *) :
+
+    ac_fn_c_check_func "$LINENO" "socket" "ac_cv_func_socket"
+if test "x$ac_cv_func_socket" = xyes; then :
+
+fi
+
+    ac_fn_c_check_func "$LINENO" "socketpair" "ac_cv_func_socketpair"
+if test "x$ac_cv_func_socketpair" = xyes; then :
+
+fi
+
+    ac_fn_c_check_func "$LINENO" "bind" "ac_cv_func_bind"
+if test "x$ac_cv_func_bind" = xyes; then :
+
+fi
+
+    ac_fn_c_check_func "$LINENO" "listen" "ac_cv_func_listen"
+if test "x$ac_cv_func_listen" = xyes; then :
+
+fi
+
+    ac_fn_c_check_func "$LINENO" "accept" "ac_cv_func_accept"
+if test "x$ac_cv_func_accept" = xyes; then :
+
+fi
+
+    ac_fn_c_check_func "$LINENO" "connect" "ac_cv_func_connect"
+if test "x$ac_cv_func_connect" = xyes; then :
+
+fi
+
+    sockets=true
+
+ ;;
+esac
+
+if $sockets; then :
+  $as_echo "#define HAS_SOCKETS 1" >>confdefs.h
+
+fi
+
+## socklen_t in sys/socket.h
+
+ac_fn_c_check_type "$LINENO" "socklen_t" "ac_cv_type_socklen_t" "#include 
+"
+if test "x$ac_cv_type_socklen_t" = xyes; then :
+  $as_echo "#define HAS_SOCKLEN_T 1" >>confdefs.h
+
+fi
+
+
+ac_fn_c_check_func "$LINENO" "inet_aton" "ac_cv_func_inet_aton"
+if test "x$ac_cv_func_inet_aton" = xyes; then :
+  $as_echo "#define HAS_INET_ATON 1" >>confdefs.h
+
+fi
+
+
+## IPv6 support
+
+ipv6=true
+
+ac_fn_c_check_type "$LINENO" "struct sockaddr_in6" "ac_cv_type_struct_sockaddr_in6" "
+#include 
+#include 
+#include 
+
+
+"
+if test "x$ac_cv_type_struct_sockaddr_in6" = xyes; then :
+
+else
+  ipv6=false
+fi
+
+
+if $ipv6; then :
+  ac_fn_c_check_func "$LINENO" "getaddrinfo" "ac_cv_func_getaddrinfo"
+if test "x$ac_cv_func_getaddrinfo" = xyes; then :
+
+else
+  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
+  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; then :
+
+else
+  ipv6=false
+fi
+
+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 :
+  $as_echo "#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 :
+  $as_echo "#define HAS_REWINDDIR 1" >>confdefs.h
+
+fi
+
+
+ac_fn_c_check_func "$LINENO" "lockf" "ac_cv_func_lockf"
+if test "x$ac_cv_func_lockf" = xyes; then :
+  $as_echo "#define HAS_LOCKF 1" >>confdefs.h
+
+fi
+
+
+ac_fn_c_check_func "$LINENO" "mkfifo" "ac_cv_func_mkfifo"
+if test "x$ac_cv_func_mkfifo" = xyes; then :
+  $as_echo "#define HAS_MKFIFO 1" >>confdefs.h
+
+fi
+
+
+ac_fn_c_check_func "$LINENO" "getcwd" "ac_cv_func_getcwd"
+if test "x$ac_cv_func_getcwd" = xyes; then :
+  $as_echo "#define HAS_GETCWD 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
+# of HAS_UTIME on Windows but this will probably need to be clarified
+case $host in #(
+  *-*-mingw32|*-pc-windows) :
+    $as_echo "#define HAS_UTIME 1" >>confdefs.h
+ ;; #(
+  *) :
+    ac_fn_c_check_header_mongrel "$LINENO" "sys/types.h" "ac_cv_header_sys_types_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_types_h" = xyes; then :
+  ac_fn_c_check_header_mongrel "$LINENO" "utime.h" "ac_cv_header_utime_h" "$ac_includes_default"
+if test "x$ac_cv_header_utime_h" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "utime" "ac_cv_func_utime"
+if test "x$ac_cv_func_utime" = xyes; then :
+  $as_echo "#define HAS_UTIME 1" >>confdefs.h
+
+fi
+
+fi
+
+
+fi
+
+ ;;
+esac
+
+ac_fn_c_check_func "$LINENO" "utimes" "ac_cv_func_utimes"
+if test "x$ac_cv_func_utimes" = xyes; then :
+  $as_echo "#define HAS_UTIMES 1" >>confdefs.h
+
+fi
+
+
+ac_fn_c_check_func "$LINENO" "fchmod" "ac_cv_func_fchmod"
+if test "x$ac_cv_func_fchmod" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "fchown" "ac_cv_func_fchown"
+if test "x$ac_cv_func_fchown" = xyes; then :
+  $as_echo "#define HAS_FCHMOD 1" >>confdefs.h
+
+fi
+
+fi
+
+
+ac_fn_c_check_func "$LINENO" "truncate" "ac_cv_func_truncate"
+if test "x$ac_cv_func_truncate" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "ftruncate" "ac_cv_func_ftruncate"
+if test "x$ac_cv_func_ftruncate" = xyes; then :
+  $as_echo "#define HAS_TRUNCATE 1" >>confdefs.h
+
+fi
+
+fi
+
+
+## select
+ac_fn_c_check_func "$LINENO" "select" "ac_cv_func_select"
+if test "x$ac_cv_func_select" = xyes; then :
+  ac_fn_c_check_type "$LINENO" "fd_set" "ac_cv_type_fd_set" "
+#include 
+#include 
+
+"
+if test "x$ac_cv_type_fd_set" = xyes; then :
+  $as_echo "#define HAS_SELECT 1" >>confdefs.h
+
+    select=true
+else
+  select=false
+fi
+
+fi
+
+
+ac_fn_c_check_func "$LINENO" "nanosleep" "ac_cv_func_nanosleep"
+if test "x$ac_cv_func_nanosleep" = xyes; then :
+  $as_echo "#define HAS_NANOSLEEP 1" >>confdefs.h
+
+fi
+
+
+ac_fn_c_check_func "$LINENO" "symlink" "ac_cv_func_symlink"
+if test "x$ac_cv_func_symlink" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "readlink" "ac_cv_func_readlink"
+if test "x$ac_cv_func_readlink" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "lstat" "ac_cv_func_lstat"
+if test "x$ac_cv_func_lstat" = xyes; then :
+  $as_echo "#define HAS_SYMLINK 1" >>confdefs.h
+
+fi
+
+fi
+
+fi
+
+
+# wait
+ac_fn_c_check_func "$LINENO" "waitpid" "ac_cv_func_waitpid"
+if test "x$ac_cv_func_waitpid" = xyes; then :
+
+    wait=true
+    $as_echo "#define HAS_WAITPID 1" >>confdefs.h
+
+
+else
+  wait=false
+fi
+
+
+ac_fn_c_check_func "$LINENO" "wait4" "ac_cv_func_wait4"
+if test "x$ac_cv_func_wait4" = xyes; then :
+
+    has_wait=true
+    $as_echo "#define HAS_WAIT4 1" >>confdefs.h
+
+
+fi
+
+
+## getgroups
+ac_fn_c_check_func "$LINENO" "getgroups" "ac_cv_func_getgroups"
+if test "x$ac_cv_func_getgroups" = xyes; then :
+  $as_echo "#define HAS_GETGROUPS 1" >>confdefs.h
+
+fi
+
+
+## setgroups
+ac_fn_c_check_func "$LINENO" "setgroups" "ac_cv_func_setgroups"
+if test "x$ac_cv_func_setgroups" = xyes; then :
+  $as_echo "#define HAS_SETGROUPS 1" >>confdefs.h
+
+fi
+
+
+## initgroups
+ac_fn_c_check_func "$LINENO" "initgroups" "ac_cv_func_initgroups"
+if test "x$ac_cv_func_initgroups" = xyes; then :
+  $as_echo "#define HAS_INITGROUPS 1" >>confdefs.h
+
+fi
+
+
+## termios
+
+ac_fn_c_check_header_mongrel "$LINENO" "termios.h" "ac_cv_header_termios_h" "$ac_includes_default"
+if test "x$ac_cv_header_termios_h" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "tcgetattr" "ac_cv_func_tcgetattr"
+if test "x$ac_cv_func_tcgetattr" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "tcsetattr" "ac_cv_func_tcsetattr"
+if test "x$ac_cv_func_tcsetattr" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "tcsendbreak" "ac_cv_func_tcsendbreak"
+if test "x$ac_cv_func_tcsendbreak" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "tcflush" "ac_cv_func_tcflush"
+if test "x$ac_cv_func_tcflush" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "tcflow" "ac_cv_func_tcflow"
+if test "x$ac_cv_func_tcflow" = xyes; then :
+  $as_echo "#define HAS_TERMIOS 1" >>confdefs.h
+
+fi
+
+fi
+
+fi
+
+fi
+
+fi
+
+fi
+
+
+
+## setitimer
+
+ac_fn_c_check_func "$LINENO" "setitimer" "ac_cv_func_setitimer"
+if test "x$ac_cv_func_setitimer" = xyes; then :
+
+    setitimer=true
+    $as_echo "#define HAS_SETITIMER 1" >>confdefs.h
+
+
+else
+  setitimer=false
+fi
+
+
+## gethostname
+# Note: detection fails on Windows so hardcoding the result
+# (should be debugged later)
+case $host in #(
+  *-*-mingw32|*-pc-windows) :
+    $as_echo "#define HAS_GETHOSTNAME 1" >>confdefs.h
+ ;; #(
+  *) :
+    ac_fn_c_check_func "$LINENO" "gethostname" "ac_cv_func_gethostname"
+if test "x$ac_cv_func_gethostname" = xyes; then :
+  $as_echo "#define HAS_GETHOSTNAME 1" >>confdefs.h
+
+fi
+ ;;
+esac
+
+## uname
+
+ac_fn_c_check_header_mongrel "$LINENO" "sys/utsname.h" "ac_cv_header_sys_utsname_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_utsname_h" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "uname" "ac_cv_func_uname"
+if test "x$ac_cv_func_uname" = xyes; then :
+  $as_echo "#define HAS_UNAME 1" >>confdefs.h
+
+fi
+
+fi
+
+
+
+## gettimeofday
+
+ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday"
+if test "x$ac_cv_func_gettimeofday" = xyes; then :
+
+    gettimeofday=true
+    $as_echo "#define HAS_GETTIMEOFDAY 1" >>confdefs.h
+
+
+else
+  gettimeofday=false
+fi
+
+
+## mktime
+
+ac_fn_c_check_func "$LINENO" "mktime" "ac_cv_func_mktime"
+if test "x$ac_cv_func_mktime" = xyes; then :
+  $as_echo "#define HAS_MKTIME 1" >>confdefs.h
+
+fi
+
+
+## setsid
+
+case $host in #(
+  *-cygwin|*-*-mingw32|*-pc-windows) :
+     ;; #(
+  *) :
+    ac_fn_c_check_func "$LINENO" "setsid" "ac_cv_func_setsid"
+if test "x$ac_cv_func_setsid" = xyes; then :
+  $as_echo "#define HAS_SETSID 1" >>confdefs.h
+
+fi
+ ;;
+esac
+
+## putenv
+
+ac_fn_c_check_func "$LINENO" "putenv" "ac_cv_func_putenv"
+if test "x$ac_cv_func_putenv" = xyes; then :
+  $as_echo "#define HAS_PUTENV 1" >>confdefs.h
+
+fi
+
+
+## setenv and unsetenv
+
+ac_fn_c_check_func "$LINENO" "setenv" "ac_cv_func_setenv"
+if test "x$ac_cv_func_setenv" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "unsetenv" "ac_cv_func_unsetenv"
+if test "x$ac_cv_func_unsetenv" = xyes; then :
+  $as_echo "#define HAS_SETENV_UNSETENV 1" >>confdefs.h
+
+fi
+
+fi
+
+
+## newlocale() and 
+# Note: the detection fails on msvc so we hardcode the result
+# (should be debugged later)
+case $host in #(
+  *-pc-windows) :
+    $as_echo "#define HAS_LOCALE_H 1" >>confdefs.h
+ ;; #(
+  *) :
+    ac_fn_c_check_header_mongrel "$LINENO" "locale.h" "ac_cv_header_locale_h" "$ac_includes_default"
+if test "x$ac_cv_header_locale_h" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "newlocale" "ac_cv_func_newlocale"
+if test "x$ac_cv_func_newlocale" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "freelocale" "ac_cv_func_freelocale"
+if test "x$ac_cv_func_freelocale" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "uselocale" "ac_cv_func_uselocale"
+if test "x$ac_cv_func_uselocale" = xyes; then :
+  $as_echo "#define HAS_LOCALE_H 1" >>confdefs.h
+
+fi
+
+fi
+
+fi
+
+fi
+
+ ;;
+esac
+
+ac_fn_c_check_header_mongrel "$LINENO" "xlocale.h" "ac_cv_header_xlocale_h" "$ac_includes_default"
+if test "x$ac_cv_header_xlocale_h" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "newlocale" "ac_cv_func_newlocale"
+if test "x$ac_cv_func_newlocale" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "freelocale" "ac_cv_func_freelocale"
+if test "x$ac_cv_func_freelocale" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "uselocale" "ac_cv_func_uselocale"
+if test "x$ac_cv_func_uselocale" = xyes; then :
+  $as_echo "#define HAS_XLOCALE_H 1" >>confdefs.h
+
+fi
+
+fi
+
+fi
+
+fi
+
+
+
+## strtod_l
+# Note: not detected on MSVC so hardcoding the result
+# (should be debugged later)
+case $host in #(
+  *-pc-windows) :
+    $as_echo "#define HAS_STRTOD_L 1" >>confdefs.h
+ ;; #(
+  *) :
+    ac_fn_c_check_func "$LINENO" "strtod_l" "ac_cv_func_strtod_l"
+if test "x$ac_cv_func_strtod_l" = xyes; then :
+  $as_echo "#define HAS_STRTOD_L 1" >>confdefs.h
+
+fi
+ ;;
+esac
+
+## shared library support
+if $shared_libraries_supported; then :
+  case $host in #(
+  *-*-mingw32|*-pc-windows) :
+    supports_shared_libraries=$shared_libraries_supported; DLLIBS="" ;; #(
+  *) :
+    ac_fn_c_check_func "$LINENO" "dlopen" "ac_cv_func_dlopen"
+if test "x$ac_cv_func_dlopen" = xyes; then :
+  supports_shared_libraries=true DLLIBS=""
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5
+$as_echo_n "checking for dlopen in -ldl... " >&6; }
+if ${ac_cv_lib_dl_dlopen+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldl  $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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char dlopen ();
+int
+main ()
+{
+return dlopen ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_dl_dlopen=yes
+else
+  ac_cv_lib_dl_dlopen=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5
+$as_echo "$ac_cv_lib_dl_dlopen" >&6; }
+if test "x$ac_cv_lib_dl_dlopen" = xyes; then :
+  supports_shared_libraries=true DLLIBS="-ldl $DLLIBS"
+else
+  supports_shared_libraries=false
+fi
+
+fi
+ ;;
+esac
+else
+  supports_shared_libraries=false
+fi
+
+if $supports_shared_libraries; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: Dynamic loading of shared libraries is supported." >&5
+$as_echo "$as_me: Dynamic loading of shared libraries is supported." >&6;}
+  $as_echo "#define SUPPORT_DYNAMIC_LINKING 1" >>confdefs.h
+
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: Dynamic loading of shared libraries is not supported." >&5
+$as_echo "$as_me: Dynamic loading of shared libraries is not supported." >&6;}
+fi
+
+## mmap
+
+ac_fn_c_check_header_mongrel "$LINENO" "sys/mman.h" "ac_cv_header_sys_mman_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_mman_h" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "mmap" "ac_cv_func_mmap"
+if test "x$ac_cv_func_mmap" = xyes; then :
+  ac_fn_c_check_func "$LINENO" "munmap" "ac_cv_func_munmap"
+if test "x$ac_cv_func_munmap" = xyes; then :
+  $as_echo "#define HAS_MMAP 1" >>confdefs.h
+
+fi
+
+fi
+
+fi
+
+
+
+## pwrite
+
+ac_fn_c_check_func "$LINENO" "pwrite" "ac_cv_func_pwrite"
+if test "x$ac_cv_func_pwrite" = xyes; then :
+  $as_echo "#define HAS_PWRITE 1" >>confdefs.h
+
+fi
+
+
+## -fdebug-prefix-map support by the C compiler
+case $CC,$host in #(
+  *,*-*-mingw32) :
+    cc_has_debug_prefix_map=false ;; #(
+  *,*-pc-windows) :
+    cc_has_debug_prefix_map=false ;; #(
+  xlc*,powerpc-ibm-aix*) :
+    cc_has_debug_prefix_map=false ;; #(
+  *) :
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports -fdebug-prefix-map" >&5
+$as_echo_n "checking whether the C compiler supports -fdebug-prefix-map... " >&6; }
+  saved_CFLAGS="$CFLAGS"
+  CFLAGS="-fdebug-prefix-map=old=new $CFLAGS"
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+int main() { return 0; }
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  cc_has_debug_prefix_map=true
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+  cc_has_debug_prefix_map=false
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+  CFLAGS="$saved_CFLAGS"
+ ;;
+esac
+
+## Does stat support nanosecond precision
+
+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 
+
+"
+if test "x$ac_cv_member_struct_stat_st_atim_tv_nsec" = xyes; then :
+  stat_has_ns_precision=true
+  $as_echo "#define HAS_NANOSECOND_STAT 1" >>confdefs.h
+
+fi
+
+
+
+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 
+
+"
+if test "x$ac_cv_member_struct_stat_st_atimespec_tv_nsec" = xyes; then :
+  stat_has_ns_precision=true
+    $as_echo "#define HAS_NANOSECOND_STAT 2" >>confdefs.h
+
+fi
+
+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 
+
+"
+if test "x$ac_cv_member_struct_stat_st_atimensec" = xyes; then :
+  stat_has_ns_precision=true
+    $as_echo "#define HAS_NANOSECOND_STAT 3" >>confdefs.h
+
+fi
+
+fi
+
+if $stat_has_ns_precision; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: stat supports nanosecond precision" >&5
+$as_echo "$as_me: stat supports nanosecond precision" >&6;}
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: stat does not support nanosecond precision" >&5
+$as_echo "$as_me: stat does not support nanosecond precision" >&6;}
+fi
+
+# Number of arguments of gethostbyname_r
+
+
+
+    ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking how many arguments gethostbyname_r() takes" >&5
+$as_echo_n "checking how many arguments gethostbyname_r() takes... " >&6; }
+
+    if ${ac_cv_func_which_gethostbyname_r+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+
+
+################################################################
+
+ac_cv_func_which_gethostbyname_r=unknown
+
+#
+# ONE ARGUMENT (sanity check)
+#
+
+# This should fail, as there is no variant of gethostbyname_r() that takes
+# a single argument. If it actually compiles, then we can assume that
+# netdb.h is not declaring the function, and the compiler is thereby
+# assuming an implicit prototype. In which case, we're out of luck.
+#
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+int
+main ()
+{
+
+            char *name = "www.gnu.org";
+            (void)gethostbyname_r(name) /* ; */
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_func_which_gethostbyname_r=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+#
+# SIX ARGUMENTS
+# (e.g. Linux)
+#
+
+if test "$ac_cv_func_which_gethostbyname_r" = "unknown"; then
+
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+int
+main ()
+{
+
+            char *name = "www.gnu.org";
+            struct hostent ret, *retp;
+            char buf[1024];
+            int buflen = 1024;
+            int my_h_errno;
+            (void)gethostbyname_r(name, &ret, buf, buflen, &retp, &my_h_errno) /* ; */
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_func_which_gethostbyname_r=six
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+
+#
+# FIVE ARGUMENTS
+# (e.g. Solaris)
+#
+
+if test "$ac_cv_func_which_gethostbyname_r" = "unknown"; then
+
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+int
+main ()
+{
+
+            char *name = "www.gnu.org";
+            struct hostent ret;
+            char buf[1024];
+            int buflen = 1024;
+            int my_h_errno;
+            (void)gethostbyname_r(name, &ret, buf, buflen, &my_h_errno) /* ; */
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_func_which_gethostbyname_r=five
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+
+#
+# THREE ARGUMENTS
+# (e.g. AIX, HP-UX, Tru64)
+#
+
+if test "$ac_cv_func_which_gethostbyname_r" = "unknown"; then
+
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+int
+main ()
+{
+
+            char *name = "www.gnu.org";
+            struct hostent ret;
+            struct hostent_data data;
+            (void)gethostbyname_r(name, &ret, &data) /* ; */
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_func_which_gethostbyname_r=three
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+
+################################################################
+
+
+fi
+
+case "$ac_cv_func_which_gethostbyname_r" in
+    three|five|six)
+
+$as_echo "#define HAVE_GETHOSTBYNAME_R 1" >>confdefs.h
+
+    ;;
+esac
+
+case "$ac_cv_func_which_gethostbyname_r" in
+    three)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: three" >&5
+$as_echo "three" >&6; }
+
+$as_echo "#define HAVE_FUNC_GETHOSTBYNAME_R_3 1" >>confdefs.h
+
+    ;;
+
+    five)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: five" >&5
+$as_echo "five" >&6; }
+
+$as_echo "#define HAVE_FUNC_GETHOSTBYNAME_R_5 1" >>confdefs.h
+
+    ;;
+
+    six)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: six" >&5
+$as_echo "six" >&6; }
+
+$as_echo "#define HAVE_FUNC_GETHOSTBYNAME_R_6 1" >>confdefs.h
+
+    ;;
+
+    no)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot find function declaration in netdb.h" >&5
+$as_echo "cannot find function declaration in netdb.h" >&6; }
+    ;;
+
+    unknown)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: can't tell" >&5
+$as_echo "can't tell" >&6; }
+    ;;
+
+    *)
+    as_fn_error $? "internal error" "$LINENO" 5
+    ;;
+esac
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+
+case $ac_cv_func_which_gethostbyname_r in #(
+  six) :
+    $as_echo "#define HAS_GETHOSTBYNAME_R 6" >>confdefs.h
+ ;; #(
+  five) :
+    $as_echo "#define HAS_GETHOSTBYNAME_R 5" >>confdefs.h
+ ;; #(
+  three) :
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: OCaml does not support this variant" >&5
+$as_echo "$as_me: WARNING: OCaml does not support this variant" >&2;} ;; #(
+  *) :
+     ;;
+esac
+
+# Number of arguments of gethostbyaddr_r
+
+
+
+    ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking how many arguments gethostbyaddr_r() takes" >&5
+$as_echo_n "checking how many arguments gethostbyaddr_r() takes... " >&6; }
+
+    if ${ac_cv_func_which_gethostbyaddr_r+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+
+
+################################################################
+
+ac_cv_func_which_gethostbyaddr_r=unknown
+
+#
+# ONE ARGUMENT (sanity check)
+#
+
+# This should fail, as there is no variant of gethostbyaddr_r() that takes
+# a single argument. If it actually compiles, then we can assume that
+# netdb.h is not declaring the function, and the compiler is thereby
+# assuming an implicit prototype. In which case, we're out of luck.
+#
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+int
+main ()
+{
+
+            char *addr = "192.168.1.1";
+            (void)gethostbyaddr_r(addr) /* ; */
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_func_which_gethostbyaddr_r=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+#
+# EIGHT ARGUMENTS
+# (e.g. Linux)
+#
+
+if test "$ac_cv_func_which_gethostbyaddr_r" = "unknown"; then
+
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+int
+main ()
+{
+
+            char *addr = "192.168.1.1";
+            struct hostent ret, *retp;
+            char buf[1024];
+            int buflen = 1024;
+            int my_h_errno;
+            (void)gethostbyaddr_r(
+              addr, 10, 10, retp, buf, buflen, &retp, &my_h_errno) /* ; */
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_func_which_gethostbyaddr_r=eight
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+
+#
+# SEVEN ARGUMENTS
+# (e.g. Solaris)
+#
+
+if test "$ac_cv_func_which_gethostbyaddr_r" = "unknown"; then
+
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+int
+main ()
+{
+
+            char *addr = "192.168.1.1";
+            struct hostent ret;
+            char buf[1024];
+            int buflen = 1024;
+            int my_h_errno;
+            (void)gethostbyaddr_r(
+              addr, 10, 10, buf, buflen, &my_h_errno, 0) /* ; */
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_func_which_gethostbyaddr_r=seven
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+
+################################################################
+
+
+fi
+
+case "$ac_cv_func_which_gethostbyaddr_r" in
+    seven|eight)
+
+$as_echo "#define HAVE_GETHOSTBYADDR_R 1" >>confdefs.h
+
+    ;;
+esac
+
+case "$ac_cv_func_which_gethostbyaddr_r" in
+    eight)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: eight" >&5
+$as_echo "eight" >&6; }
+
+$as_echo "#define HAVE_FUNC_GETHOSTBYADDR_R_8 1" >>confdefs.h
+
+    ;;
+
+    seven)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: seven" >&5
+$as_echo "seven" >&6; }
+
+$as_echo "#define HAVE_FUNC_GETHOSTBYADDR_R_7 1" >>confdefs.h
+
+    ;;
+
+    no)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot find function declaration in netdb.h" >&5
+$as_echo "cannot find function declaration in netdb.h" >&6; }
+    ;;
+
+    unknown)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: can't tell" >&5
+$as_echo "can't tell" >&6; }
+    ;;
+
+    *)
+    as_fn_error $? "internal error" "$LINENO" 5
+    ;;
+esac
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+
+case $ac_cv_func_which_gethostbyaddr_r in #(
+  eight) :
+    $as_echo "#define HAS_GETHOSTBYADDR_R 8" >>confdefs.h
+ ;; #(
+  seven) :
+    $as_echo "#define HAS_GETHOSTBYADDR_R 7" >>confdefs.h
+ ;; #(
+  *) :
+     ;;
+esac
+
+## mkstemp
+
+ac_fn_c_check_func "$LINENO" "mkstemp" "ac_cv_func_mkstemp"
+if test "x$ac_cv_func_mkstemp" = xyes; then :
+  $as_echo "#define HAS_MKSTEMP 1" >>confdefs.h
+
+fi
+
+
+## nice
+
+ac_fn_c_check_func "$LINENO" "nice" "ac_cv_func_nice"
+if test "x$ac_cv_func_nice" = xyes; then :
+  $as_echo "#define HAS_NICE 1" >>confdefs.h
+
+fi
+
+
+## dup3
+
+ac_fn_c_check_func "$LINENO" "dup3" "ac_cv_func_dup3"
+if test "x$ac_cv_func_dup3" = xyes; then :
+  $as_echo "#define HAS_DUP3 1" >>confdefs.h
+
+fi
+
+
+## pipe2
+
+ac_fn_c_check_func "$LINENO" "pipe2" "ac_cv_func_pipe2"
+if test "x$ac_cv_func_pipe2" = xyes; then :
+  $as_echo "#define HAS_PIPE2 1" >>confdefs.h
+
+fi
+
+
+## accept4
+
+ac_fn_c_check_func "$LINENO" "accept4" "ac_cv_func_accept4"
+if test "x$ac_cv_func_accept4" = xyes; then :
+  $as_echo "#define HAS_ACCEPT4 1" >>confdefs.h
+
+fi
+
+
+## getauxval
+
+ac_fn_c_check_func "$LINENO" "getauxval" "ac_cv_func_getauxval"
+if test "x$ac_cv_func_getauxval" = xyes; then :
+  $as_echo "#define HAS_GETAUXVAL 1" >>confdefs.h
+
+fi
+
+
+## execvpe
+
+ac_fn_c_check_func "$LINENO" "execvpe" "ac_cv_func_execvpe"
+if test "x$ac_cv_func_execvpe" = xyes; then :
+  $as_echo "#define HAS_EXECVPE 1" >>confdefs.h
+
+fi
+
+
+## ffs or _BitScanForward
+
+ac_fn_c_check_func "$LINENO" "ffs" "ac_cv_func_ffs"
+if test "x$ac_cv_func_ffs" = xyes; then :
+  $as_echo "#define HAS_FFS 1" >>confdefs.h
+
+fi
+
+ac_fn_c_check_func "$LINENO" "_BitScanForward" "ac_cv_func__BitScanForward"
+if test "x$ac_cv_func__BitScanForward" = xyes; then :
+  $as_echo "#define HAS_BITSCANFORWARD 1" >>confdefs.h
+
+fi
+
+
+## Determine whether the debugger should/can be built
+
+case $enable_debugger in #(
+  no) :
+    with_debugger=""
+    { $as_echo "$as_me:${as_lineno-$LINENO}: replay debugger disabled" >&5
+$as_echo "$as_me: replay debugger disabled" >&6;} ;; #(
+  *) :
+    if $sockets; then :
+  with_debugger="ocamldebugger"
+    { $as_echo "$as_me:${as_lineno-$LINENO}: replay debugger supported" >&5
+$as_echo "$as_me: replay debugger supported" >&6;}
+else
+  with_debugger=""
+    { $as_echo "$as_me:${as_lineno-$LINENO}: replay debugger not supported" >&5
+$as_echo "$as_me: replay debugger not supported" >&6;}
+fi
+   ;;
+esac
+
+## Should the runtime with debugging support be built
+case $enable_debug_runtime in #(
+  no) :
+    debug_runtime=false ;; #(
+  *) :
+    debug_runtime=true ;;
+esac
+
+## Determine if system stack overflows can be detected
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stack overflows can be detected" >&5
+$as_echo_n "checking whether stack overflows can be detected... " >&6; }
+
+case $arch,$system in #(
+  i386,linux_elf|amd64,linux|amd64,macosx \
+    |amd64,openbsd|i386,bsd_elf) :
+    $as_echo "#define HAS_STACK_OVERFLOW_DETECTION 1" >>confdefs.h
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; } ;; #(
+  *) :
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; } ;;
+esac
+
+## Determine if the POSIX threads library is supported
+
+if test x"$enable_systhreads" = "xno"; then :
+  systhread_support=false
+  { $as_echo "$as_me:${as_lineno-$LINENO}: the Win32/POSIX threads library is disabled" >&5
+$as_echo "$as_me: the Win32/POSIX threads library is disabled" >&6;}
+else
+  case $host in #(
+  *-*-mingw32|*-pc-windows) :
+    systhread_support=true
+      otherlibraries="$otherlibraries systhreads"
+      { $as_echo "$as_me:${as_lineno-$LINENO}: the Win32 threads library is supported" >&5
+$as_echo "$as_me: the Win32 threads library is supported" >&6;} ;; #(
+  *) :
+
+
+
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+ax_pthread_ok=no
+
+# We used to check for pthread.h first, but this fails if pthread.h
+# requires special compiler flags (e.g. on Tru64 or Sequent).
+# It gets checked for in the link test anyway.
+
+# First of all, check if the user has set any of the PTHREAD_LIBS,
+# etcetera environment variables, and if threads linking works using
+# them:
+if test "x$PTHREAD_CFLAGS$PTHREAD_LIBS" != "x"; then
+        ax_pthread_save_CC="$CC"
+        ax_pthread_save_CFLAGS="$CFLAGS"
+        ax_pthread_save_LIBS="$LIBS"
+        if test "x$PTHREAD_CC" != "x"; then :
+  CC="$PTHREAD_CC"
+fi
+        CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+        LIBS="$PTHREAD_LIBS $LIBS"
+        { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_join using $CC $PTHREAD_CFLAGS $PTHREAD_LIBS" >&5
+$as_echo_n "checking for pthread_join using $CC $PTHREAD_CFLAGS $PTHREAD_LIBS... " >&6; }
+        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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char pthread_join ();
+int
+main ()
+{
+return pthread_join ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ax_pthread_ok=yes
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_pthread_ok" >&5
+$as_echo "$ax_pthread_ok" >&6; }
+        if test "x$ax_pthread_ok" = "xno"; then
+                PTHREAD_LIBS=""
+                PTHREAD_CFLAGS=""
+        fi
+        CC="$ax_pthread_save_CC"
+        CFLAGS="$ax_pthread_save_CFLAGS"
+        LIBS="$ax_pthread_save_LIBS"
+fi
+
+# We must check for the threads library under a number of different
+# names; the ordering is very important because some systems
+# (e.g. DEC) have both -lpthread and -lpthreads, where one of the
+# libraries is broken (non-POSIX).
+
+# Create a list of thread flags to try.  Items starting with a "-" are
+# C compiler flags, and other items are library names, except for "none"
+# which indicates that we try without any flags at all, and "pthread-config"
+# which is a program returning the flags for the Pth emulation library.
+
+ax_pthread_flags="pthreads none -Kthread -pthread -pthreads -mthreads pthread --thread-safe -mt pthread-config"
+
+# The ordering *is* (sometimes) important.  Some notes on the
+# individual items follow:
+
+# pthreads: AIX (must check this before -lpthread)
+# none: in case threads are in libc; should be tried before -Kthread and
+#       other compiler flags to prevent continual compiler warnings
+# -Kthread: Sequent (threads in libc, but -Kthread needed for pthread.h)
+# -pthread: Linux/gcc (kernel threads), BSD/gcc (userland threads), Tru64
+#           (Note: HP C rejects this with "bad form for `-t' option")
+# -pthreads: Solaris/gcc (Note: HP C also rejects)
+# -mt: Sun Workshop C (may only link SunOS threads [-lthread], but it
+#      doesn't hurt to check since this sometimes defines pthreads and
+#      -D_REENTRANT too), HP C (must be checked before -lpthread, which
+#      is present but should not be used directly; and before -mthreads,
+#      because the compiler interprets this as "-mt" + "-hreads")
+# -mthreads: Mingw32/gcc, Lynx/gcc
+# pthread: Linux, etcetera
+# --thread-safe: KAI C++
+# pthread-config: use pthread-config program (for GNU Pth library)
+
+case $host_os in
+
+        freebsd*)
+
+        # -kthread: FreeBSD kernel threads (preferred to -pthread since SMP-able)
+        # lthread: LinuxThreads port on FreeBSD (also preferred to -pthread)
+
+        ax_pthread_flags="-kthread lthread $ax_pthread_flags"
+        ;;
+
+        hpux*)
+
+        # From the cc(1) man page: "[-mt] Sets various -D flags to enable
+        # multi-threading and also sets -lpthread."
+
+        ax_pthread_flags="-mt -pthread pthread $ax_pthread_flags"
+        ;;
+
+        openedition*)
+
+        # IBM z/OS requires a feature-test macro to be defined in order to
+        # enable POSIX threads at all, so give the user a hint if this is
+        # not set. (We don't define these ourselves, as they can affect
+        # other portions of the system API in unpredictable ways.)
+
+        cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+#            if !defined(_OPEN_THREADS) && !defined(_UNIX03_THREADS)
+             AX_PTHREAD_ZOS_MISSING
+#            endif
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "AX_PTHREAD_ZOS_MISSING" >/dev/null 2>&1; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: IBM z/OS requires -D_OPEN_THREADS or -D_UNIX03_THREADS to enable pthreads support." >&5
+$as_echo "$as_me: WARNING: IBM z/OS requires -D_OPEN_THREADS or -D_UNIX03_THREADS to enable pthreads support." >&2;}
+fi
+rm -f conftest*
+
+        ;;
+
+        solaris*)
+
+        # On Solaris (at least, for some versions), libc contains stubbed
+        # (non-functional) versions of the pthreads routines, so link-based
+        # tests will erroneously succeed. (N.B.: The stubs are missing
+        # pthread_cleanup_push, or rather a function called by this macro,
+        # so we could check for that, but who knows whether they'll stub
+        # that too in a future libc.)  So we'll check first for the
+        # standard Solaris way of linking pthreads (-mt -lpthread).
+
+        ax_pthread_flags="-mt,pthread pthread $ax_pthread_flags"
+        ;;
+esac
+
+# GCC generally uses -pthread, or -pthreads on some platforms (e.g. SPARC)
+
+if test "x$GCC" = "xyes"; then :
+  ax_pthread_flags="-pthread -pthreads $ax_pthread_flags"
+fi
+
+# The presence of a feature test macro requesting re-entrant function
+# definitions is, on some systems, a strong hint that pthreads support is
+# correctly enabled
+
+case $host_os in
+        darwin* | hpux* | linux* | osf* | solaris*)
+        ax_pthread_check_macro="_REENTRANT"
+        ;;
+
+        aix*)
+        ax_pthread_check_macro="_THREAD_SAFE"
+        ;;
+
+        *)
+        ax_pthread_check_macro="--"
+        ;;
+esac
+if test "x$ax_pthread_check_macro" = "x--"; then :
+  ax_pthread_check_cond=0
+else
+  ax_pthread_check_cond="!defined($ax_pthread_check_macro)"
+fi
+
+# Are we compiling with Clang?
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC is Clang" >&5
+$as_echo_n "checking whether $CC is Clang... " >&6; }
+if ${ax_cv_PTHREAD_CLANG+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ax_cv_PTHREAD_CLANG=no
+     # Note that Autoconf sets GCC=yes for Clang as well as GCC
+     if test "x$GCC" = "xyes"; then
+        cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+/* Note: Clang 2.7 lacks __clang_[a-z]+__ */
+#            if defined(__clang__) && defined(__llvm__)
+             AX_PTHREAD_CC_IS_CLANG
+#            endif
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "AX_PTHREAD_CC_IS_CLANG" >/dev/null 2>&1; then :
+  ax_cv_PTHREAD_CLANG=yes
+fi
+rm -f conftest*
+
+     fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_cv_PTHREAD_CLANG" >&5
+$as_echo "$ax_cv_PTHREAD_CLANG" >&6; }
+ax_pthread_clang="$ax_cv_PTHREAD_CLANG"
+
+ax_pthread_clang_warning=no
+
+# Clang needs special handling, because older versions handle the -pthread
+# option in a rather... idiosyncratic way
+
+if test "x$ax_pthread_clang" = "xyes"; then
+
+        # Clang takes -pthread; it has never supported any other flag
+
+        # (Note 1: This will need to be revisited if a system that Clang
+        # supports has POSIX threads in a separate library.  This tends not
+        # to be the way of modern systems, but it's conceivable.)
+
+        # (Note 2: On some systems, notably Darwin, -pthread is not needed
+        # to get POSIX threads support; the API is always present and
+        # active.  We could reasonably leave PTHREAD_CFLAGS empty.  But
+        # -pthread does define _REENTRANT, and while the Darwin headers
+        # ignore this macro, third-party headers might not.)
+
+        PTHREAD_CFLAGS="-pthread"
+        PTHREAD_LIBS=
+
+        ax_pthread_ok=yes
+
+        # However, older versions of Clang make a point of warning the user
+        # that, in an invocation where only linking and no compilation is
+        # taking place, the -pthread option has no effect ("argument unused
+        # during compilation").  They expect -pthread to be passed in only
+        # when source code is being compiled.
+        #
+        # Problem is, this is at odds with the way Automake and most other
+        # C build frameworks function, which is that the same flags used in
+        # compilation (CFLAGS) are also used in linking.  Many systems
+        # supported by AX_PTHREAD require exactly this for POSIX threads
+        # support, and in fact it is often not straightforward to specify a
+        # flag that is used only in the compilation phase and not in
+        # linking.  Such a scenario is extremely rare in practice.
+        #
+        # Even though use of the -pthread flag in linking would only print
+        # a warning, this can be a nuisance for well-run software projects
+        # that build with -Werror.  So if the active version of Clang has
+        # this misfeature, we search for an option to squash it.
+
+        { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether Clang needs flag to prevent \"argument unused\" warning when linking with -pthread" >&5
+$as_echo_n "checking whether Clang needs flag to prevent \"argument unused\" warning when linking with -pthread... " >&6; }
+if ${ax_cv_PTHREAD_CLANG_NO_WARN_FLAG+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ax_cv_PTHREAD_CLANG_NO_WARN_FLAG=unknown
+             # Create an alternate version of $ac_link that compiles and
+             # links in two steps (.c -> .o, .o -> exe) instead of one
+             # (.c -> exe), because the warning occurs only in the second
+             # step
+             ax_pthread_save_ac_link="$ac_link"
+             ax_pthread_sed='s/conftest\.\$ac_ext/conftest.$ac_objext/g'
+             ax_pthread_link_step=`$as_echo "$ac_link" | sed "$ax_pthread_sed"`
+             ax_pthread_2step_ac_link="($ac_compile) && (echo ==== >&5) && ($ax_pthread_link_step)"
+             ax_pthread_save_CFLAGS="$CFLAGS"
+             for ax_pthread_try in '' -Qunused-arguments -Wno-unused-command-line-argument unknown; do
+                if test "x$ax_pthread_try" = "xunknown"; then :
+  break
+fi
+                CFLAGS="-Werror -Wunknown-warning-option $ax_pthread_try -pthread $ax_pthread_save_CFLAGS"
+                ac_link="$ax_pthread_save_ac_link"
+                cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+int main(void){return 0;}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_link="$ax_pthread_2step_ac_link"
+                     cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+int main(void){return 0;}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  break
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+             done
+             ac_link="$ax_pthread_save_ac_link"
+             CFLAGS="$ax_pthread_save_CFLAGS"
+             if test "x$ax_pthread_try" = "x"; then :
+  ax_pthread_try=no
+fi
+             ax_cv_PTHREAD_CLANG_NO_WARN_FLAG="$ax_pthread_try"
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_cv_PTHREAD_CLANG_NO_WARN_FLAG" >&5
+$as_echo "$ax_cv_PTHREAD_CLANG_NO_WARN_FLAG" >&6; }
+
+        case "$ax_cv_PTHREAD_CLANG_NO_WARN_FLAG" in
+                no | unknown) ;;
+                *) PTHREAD_CFLAGS="$ax_cv_PTHREAD_CLANG_NO_WARN_FLAG $PTHREAD_CFLAGS" ;;
+        esac
+
+fi # $ax_pthread_clang = yes
+
+if test "x$ax_pthread_ok" = "xno"; then
+for ax_pthread_try_flag in $ax_pthread_flags; do
+
+        case $ax_pthread_try_flag in
+                none)
+                { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pthreads work without any flags" >&5
+$as_echo_n "checking whether pthreads work without any flags... " >&6; }
+                ;;
+
+                -mt,pthread)
+                { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pthreads work with -mt -lpthread" >&5
+$as_echo_n "checking whether pthreads work with -mt -lpthread... " >&6; }
+                PTHREAD_CFLAGS="-mt"
+                PTHREAD_LIBS="-lpthread"
+                ;;
+
+                -*)
+                { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pthreads work with $ax_pthread_try_flag" >&5
+$as_echo_n "checking whether pthreads work with $ax_pthread_try_flag... " >&6; }
+                PTHREAD_CFLAGS="$ax_pthread_try_flag"
+                ;;
+
+                pthread-config)
+                # Extract the first word of "pthread-config", so it can be a program name with args.
+set dummy pthread-config; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ax_pthread_config+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ax_pthread_config"; then
+  ac_cv_prog_ax_pthread_config="$ax_pthread_config" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ax_pthread_config="yes"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+  test -z "$ac_cv_prog_ax_pthread_config" && ac_cv_prog_ax_pthread_config="no"
+fi
+fi
+ax_pthread_config=$ac_cv_prog_ax_pthread_config
+if test -n "$ax_pthread_config"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_pthread_config" >&5
+$as_echo "$ax_pthread_config" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+                if test "x$ax_pthread_config" = "xno"; then :
+  continue
+fi
+                PTHREAD_CFLAGS="`pthread-config --cflags`"
+                PTHREAD_LIBS="`pthread-config --ldflags` `pthread-config --libs`"
+                ;;
+
+                *)
+                { $as_echo "$as_me:${as_lineno-$LINENO}: checking for the pthreads library -l$ax_pthread_try_flag" >&5
+$as_echo_n "checking for the pthreads library -l$ax_pthread_try_flag... " >&6; }
+                PTHREAD_LIBS="-l$ax_pthread_try_flag"
+                ;;
+        esac
+
+        ax_pthread_save_CFLAGS="$CFLAGS"
+        ax_pthread_save_LIBS="$LIBS"
+        CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+        LIBS="$PTHREAD_LIBS $LIBS"
+
+        # Check for various functions.  We must include pthread.h,
+        # since some functions may be macros.  (On the Sequent, we
+        # need a special flag -Kthread to make this header compile.)
+        # We check for pthread_join because it is in -lpthread on IRIX
+        # while pthread_create is in libc.  We check for pthread_attr_init
+        # due to DEC craziness with -lpthreads.  We check for
+        # pthread_cleanup_push because it is one of the few pthread
+        # functions on Solaris that doesn't have a non-functional libc stub.
+        # We try pthread_create on general principles.
+
+        cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+#                       if $ax_pthread_check_cond
+#                        error "$ax_pthread_check_macro must be defined"
+#                       endif
+                        static void routine(void *a) { a = 0; }
+                        static void *start_routine(void *a) { return a; }
+int
+main ()
+{
+pthread_t th; pthread_attr_t attr;
+                        pthread_create(&th, 0, start_routine, 0);
+                        pthread_join(th, 0);
+                        pthread_attr_init(&attr);
+                        pthread_cleanup_push(routine, 0);
+                        pthread_cleanup_pop(0) /* ; */
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ax_pthread_ok=yes
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+
+        CFLAGS="$ax_pthread_save_CFLAGS"
+        LIBS="$ax_pthread_save_LIBS"
+
+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_pthread_ok" >&5
+$as_echo "$ax_pthread_ok" >&6; }
+        if test "x$ax_pthread_ok" = "xyes"; then :
+  break
+fi
+
+        PTHREAD_LIBS=""
+        PTHREAD_CFLAGS=""
+done
+fi
+
+# Various other checks:
+if test "x$ax_pthread_ok" = "xyes"; then
+        ax_pthread_save_CFLAGS="$CFLAGS"
+        ax_pthread_save_LIBS="$LIBS"
+        CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+        LIBS="$PTHREAD_LIBS $LIBS"
+
+        # Detect AIX lossage: JOINABLE attribute is called UNDETACHED.
+        { $as_echo "$as_me:${as_lineno-$LINENO}: checking for joinable pthread attribute" >&5
+$as_echo_n "checking for joinable pthread attribute... " >&6; }
+if ${ax_cv_PTHREAD_JOINABLE_ATTR+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ax_cv_PTHREAD_JOINABLE_ATTR=unknown
+             for ax_pthread_attr in PTHREAD_CREATE_JOINABLE PTHREAD_CREATE_UNDETACHED; do
+                 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+int
+main ()
+{
+int attr = $ax_pthread_attr; return attr /* ; */
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ax_cv_PTHREAD_JOINABLE_ATTR=$ax_pthread_attr; break
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+             done
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_cv_PTHREAD_JOINABLE_ATTR" >&5
+$as_echo "$ax_cv_PTHREAD_JOINABLE_ATTR" >&6; }
+        if test "x$ax_cv_PTHREAD_JOINABLE_ATTR" != "xunknown" && \
+               test "x$ax_cv_PTHREAD_JOINABLE_ATTR" != "xPTHREAD_CREATE_JOINABLE" && \
+               test "x$ax_pthread_joinable_attr_defined" != "xyes"; then :
+
+cat >>confdefs.h <<_ACEOF
+#define PTHREAD_CREATE_JOINABLE $ax_cv_PTHREAD_JOINABLE_ATTR
+_ACEOF
+
+               ax_pthread_joinable_attr_defined=yes
+
+fi
+
+        { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether more special flags are required for pthreads" >&5
+$as_echo_n "checking whether more special flags are required for pthreads... " >&6; }
+if ${ax_cv_PTHREAD_SPECIAL_FLAGS+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ax_cv_PTHREAD_SPECIAL_FLAGS=no
+             case $host_os in
+             solaris*)
+             ax_cv_PTHREAD_SPECIAL_FLAGS="-D_POSIX_PTHREAD_SEMANTICS"
+             ;;
+             esac
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_cv_PTHREAD_SPECIAL_FLAGS" >&5
+$as_echo "$ax_cv_PTHREAD_SPECIAL_FLAGS" >&6; }
+        if test "x$ax_cv_PTHREAD_SPECIAL_FLAGS" != "xno" && \
+               test "x$ax_pthread_special_flags_added" != "xyes"; then :
+  PTHREAD_CFLAGS="$ax_cv_PTHREAD_SPECIAL_FLAGS $PTHREAD_CFLAGS"
+               ax_pthread_special_flags_added=yes
+fi
+
+        { $as_echo "$as_me:${as_lineno-$LINENO}: checking for PTHREAD_PRIO_INHERIT" >&5
+$as_echo_n "checking for PTHREAD_PRIO_INHERIT... " >&6; }
+if ${ax_cv_PTHREAD_PRIO_INHERIT+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include 
+int
+main ()
+{
+int i = PTHREAD_PRIO_INHERIT;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ax_cv_PTHREAD_PRIO_INHERIT=yes
+else
+  ax_cv_PTHREAD_PRIO_INHERIT=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_cv_PTHREAD_PRIO_INHERIT" >&5
+$as_echo "$ax_cv_PTHREAD_PRIO_INHERIT" >&6; }
+        if test "x$ax_cv_PTHREAD_PRIO_INHERIT" = "xyes" && \
+               test "x$ax_pthread_prio_inherit_defined" != "xyes"; then :
+
+$as_echo "#define HAVE_PTHREAD_PRIO_INHERIT 1" >>confdefs.h
+
+               ax_pthread_prio_inherit_defined=yes
+
+fi
+
+        CFLAGS="$ax_pthread_save_CFLAGS"
+        LIBS="$ax_pthread_save_LIBS"
+
+        # More AIX lossage: compile with *_r variant
+        if test "x$GCC" != "xyes"; then
+            case $host_os in
+                aix*)
+                case "x/$CC" in #(
+  x*/c89|x*/c89_128|x*/c99|x*/c99_128|x*/cc|x*/cc128|x*/xlc|x*/xlc_v6|x*/xlc128|x*/xlc128_v6) :
+    #handle absolute path differently from PATH based program lookup
+                     case "x$CC" in #(
+  x/*) :
+    if as_fn_executable_p ${CC}_r; then :
+  PTHREAD_CC="${CC}_r"
+fi ;; #(
+  *) :
+    for ac_prog in ${CC}_r
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_PTHREAD_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$PTHREAD_CC"; then
+  ac_cv_prog_PTHREAD_CC="$PTHREAD_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_PTHREAD_CC="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+PTHREAD_CC=$ac_cv_prog_PTHREAD_CC
+if test -n "$PTHREAD_CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PTHREAD_CC" >&5
+$as_echo "$PTHREAD_CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$PTHREAD_CC" && break
+done
+test -n "$PTHREAD_CC" || PTHREAD_CC="$CC"
+ ;;
+esac ;; #(
+  *) :
+     ;;
+esac
+                ;;
+            esac
+        fi
+fi
+
+test -n "$PTHREAD_CC" || PTHREAD_CC="$CC"
+
+
+
+
+
+# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
+if test "x$ax_pthread_ok" = "xyes"; then
+        systhread_support=true
+      otherlibraries="$otherlibraries systhreads"
+      case $host in #(
+  *-*-solaris*) :
+    pthread_link="-lpthread -lposix4" ;; #(
+  *-*-haiku*) :
+    pthread_link="" ;; #(
+  *) :
+    pthread_link="-lpthread" ;;
+esac
+      common_cppflags="$common_cppflags -D_REENTRANT"
+      { $as_echo "$as_me:${as_lineno-$LINENO}: the POSIX threads library is supported" >&5
+$as_echo "$as_me: the POSIX threads library is supported" >&6;}
+      saved_CFLAGS="$CFLAGS"
+      saved_LIBS="$LIBS"
+      CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+      LIBS="$LIBS $pthread_link"
+      ac_fn_c_check_func "$LINENO" "sigwait" "ac_cv_func_sigwait"
+if test "x$ac_cv_func_sigwait" = xyes; then :
+  $as_echo "#define HAS_SIGWAIT 1" >>confdefs.h
+
+fi
+
+      LIBS="$saved_LIBS"
+      CFLAGS="$saved_CFLAGS"
+        :
+else
+        ax_pthread_ok=no
+        if test x"$enable_systhreads" = "xyes"; then :
+  as_fn_error $? "the POSIX thread library is not available" "$LINENO" 5
+else
+  systhread_support=false
+        { $as_echo "$as_me:${as_lineno-$LINENO}: the POSIX threads library is not supported" >&5
+$as_echo "$as_me: the POSIX threads library is not supported" >&6;}
+fi
+fi
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+ ;;
+esac
+fi
+
+## BFD (Binary File Description) library
+
+bfd_cppflags=""
+bfd_ldflags=""
+bfd_ldlibs=""
+
+if test x"$with_bfd" != "xno"; then :
+  bfd_available=false
+  case $host in #(
+  x86_64-*-darwin*) :
+    if test -z "$BFD_INCLUDE_DIR"; then :
+  BFD_INCLUDE_DIR="/opt/local/include"
+fi
+      if test -z "$BFD_LIB_DIR"; then :
+  BFD_LIB_DIR="/opt/local/lib"
+fi ;; #(
+  *-*-openbsd*|*-*-freebsd*) :
+    if test -z "$BFD_INCLUDE_DIR"; then :
+  BFD_INCLUDE_DIR="/usr/local/include"
+fi
+      if test -z "$BFD_LIB_DIR"; then :
+  BFD_LIB_DIR="/usr/local/lib"
+fi ;; #(
+  *) :
+     ;;
+esac
+  if test -n "$BFD_INCLUDE_DIR"; then :
+  bfd_cppflags="-I$BFD_INCLUDE_DIR"
+fi
+  if test -n "$BFD_LIB_DIR"; then :
+  bfd_ldflags="-L$BFD_LIB_DIR"
+fi
+  SAVED_CPPFLAGS="$CPPFLAGS"
+  SAVED_LDFLAGS="$LDFLAGS"
+  CPPFLAGS="$CPPFLAGS $bfd_cppflags"
+  LDFLAGS="$LDFLAGS $bfd_ldflags"
+  ac_fn_c_check_header_mongrel "$LINENO" "bfd.h" "ac_cv_header_bfd_h" "$ac_includes_default"
+if test "x$ac_cv_header_bfd_h" = xyes; then :
+  bfd_ldlibs=""
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_openr in -lbfd" >&5
+$as_echo_n "checking for bfd_openr in -lbfd... " >&6; }
+if ${ac_cv_lib_bfd_bfd_openr+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lbfd  $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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char bfd_openr ();
+int
+main ()
+{
+return bfd_openr ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_bfd_bfd_openr=yes
+else
+  ac_cv_lib_bfd_bfd_openr=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5
+$as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; }
+if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then :
+  bfd_ldlibs="-lbfd"
+fi
+
+    if test -z "$bfd_ldlibs"; then :
+  unset ac_cv_lib_bfd_bfd_openr
+      { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_openr in -lbfd" >&5
+$as_echo_n "checking for bfd_openr in -lbfd... " >&6; }
+if ${ac_cv_lib_bfd_bfd_openr+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lbfd $DLLIBS $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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char bfd_openr ();
+int
+main ()
+{
+return bfd_openr ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_bfd_bfd_openr=yes
+else
+  ac_cv_lib_bfd_bfd_openr=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5
+$as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; }
+if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then :
+  bfd_ldlibs="-lbfd $DLLIBS"
+fi
+
+fi
+    if test -z "$bfd_ldlibs"; then :
+  unset ac_cv_lib_bfd_bfd_openr
+      { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_openr in -lbfd" >&5
+$as_echo_n "checking for bfd_openr in -lbfd... " >&6; }
+if ${ac_cv_lib_bfd_bfd_openr+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lbfd $DLLIBS -liberty $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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char bfd_openr ();
+int
+main ()
+{
+return bfd_openr ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_bfd_bfd_openr=yes
+else
+  ac_cv_lib_bfd_bfd_openr=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5
+$as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; }
+if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then :
+  bfd_ldlibs="-lbfd $DLLIBS -liberty"
+fi
+
+fi
+    if test -z "$bfd_ldlibs"; then :
+  unset ac_cv_lib_bfd_bfd_openr
+      { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_openr in -lbfd" >&5
+$as_echo_n "checking for bfd_openr in -lbfd... " >&6; }
+if ${ac_cv_lib_bfd_bfd_openr+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lbfd $DLLIBS -liberty -lz $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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char bfd_openr ();
+int
+main ()
+{
+return bfd_openr ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_bfd_bfd_openr=yes
+else
+  ac_cv_lib_bfd_bfd_openr=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5
+$as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; }
+if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then :
+  bfd_ldlibs="-lbfd $DLLIBS -liberty -lz"
+fi
+
+fi
+    if test -z "$bfd_ldlibs"; then :
+  unset ac_cv_lib_bfd_bfd_openr
+      { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_openr in -lbfd" >&5
+$as_echo_n "checking for bfd_openr in -lbfd... " >&6; }
+if ${ac_cv_lib_bfd_bfd_openr+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lbfd $DLLIBS -liberty -lz -lintl $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.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char bfd_openr ();
+int
+main ()
+{
+return bfd_openr ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_bfd_bfd_openr=yes
+else
+  ac_cv_lib_bfd_bfd_openr=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5
+$as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; }
+if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then :
+  bfd_ldlibs="-lbfd $DLLIBS -liberty -lz -lintl"
+fi
+
+fi
+    if test -n "$bfd_ldlibs"; then :
+  bfd_available=true
+      $as_echo "#define HAS_LIBBFD 1" >>confdefs.h
+
+fi
+fi
+
+
+  if ! $bfd_available; then :
+  if test x"$with_bfd" = "xyes"; then :
+  as_fn_error $? "BFD library support requested but not available" "$LINENO" 5
+else
+  bfd_cppflags=""
+      bfd_ldflags=""
+      { $as_echo "$as_me:${as_lineno-$LINENO}: BFD library not found, 'ocamlobjinfo' will be unable to display info on .cmxs files." >&5
+$as_echo "$as_me: BFD library not found, 'ocamlobjinfo' will be unable to display info on .cmxs files." >&6;}
+fi
+fi
+  LDFLAGS="$SAVED_LDFLAGS"
+  CPP_FLAGS="$SAVED_CPPFLAGS"
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: Support for the BFD (Binary File Description) library disabled, 'ocamlobjinfo' will be unable to display info on .cmxs files." >&5
+$as_echo "$as_me: Support for the BFD (Binary File Description) library disabled, 'ocamlobjinfo' will be unable to display info on .cmxs files." >&6;}
+fi
+
+## Does the assembler support debug prefix map and CFI directives
+as_has_debug_prefix_map=false
+asm_cfi_supported=false
+if $native_compiler; then :
+  case $host in #(
+  *-*-mingw32|*-pc-windows) :
+     ;; #(
+  *) :
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the assembler supports --debug-prefix-map" >&5
+$as_echo_n "checking whether the assembler supports --debug-prefix-map... " >&6; }
+
+
+  saved_CC="$CC"
+  saved_CFLAGS="$CFLAGS"
+  saved_CPPFLAGS="$CPPFLAGS"
+  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
+
+
+  # Modify C-compiler variables to use the assembler
+  CC="$AS"
+  CFLAGS="--debug-prefix-map old=new -o conftest.$ac_objext"
+  CPPFLAGS=""
+  ac_ext="S"
+  ac_compile='$CC $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+camlPervasives__loop_1128:
+        .file   1       "pervasives.ml"
+        .loc    1       193
+
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  as_has_debug_prefix_map=true
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+  ashas_debug_prefix_map=false
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+rm -f core conftest.err conftest.$ac_objext 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"
+
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the assembler supports CFI directives" >&5
+$as_echo_n "checking whether the assembler supports CFI directives... " >&6; }
+
+  if test x"$enable_cfi" = "xno"; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: disabled" >&5
+$as_echo "disabled" >&6; }
+else
+
+  saved_CC="$CC"
+  saved_CFLAGS="$CFLAGS"
+  saved_CPPFLAGS="$CPPFLAGS"
+  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
+
+
+    # Modify C-compiler variables to use the assembler
+    CC="$ASPP"
+    CFLAGS="-o conftest.$ac_objext"
+    CPPFLAGS=""
+    ac_ext="S"
+    ac_compile='$CC $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+
+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+camlPervasives__loop_1128:
+        .file   1       "pervasives.ml"
+        .loc    1       193
+        .cfi_startproc
+        .cfi_adjust_cfa_offset 8
+        .cfi_endproc
+
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  aspp_ok=true
+else
+  aspp_ok=false
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+    if test "$AS" = "$ASPP"; then :
+  as_ok="$aspp_ok"
+else
+  CC="$AS"
+      ac_compile='$CC $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+camlPervasives__loop_1128:
+        .file   1       "pervasives.ml"
+        .loc    1       193
+        .cfi_startproc
+        .cfi_adjust_cfa_offset 8
+        .cfi_endproc
+
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  as_ok=true
+else
+  as_ok=false
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+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"
+
+
+    if $aspp_ok && $as_ok; then :
+  asm_cfi_supported=true
+      $as_echo "#define ASM_CFI_SUPPORTED 1" >>confdefs.h
+
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+  if test x"$enable_cfi" = "xyes"; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: requested but not available
+        as_fn_error $? "exiting" "$LINENO" 5" >&5
+$as_echo "requested but not available
+        as_fn_error $? "exiting" "$LINENO" 5" >&6; }
+else
+  asm_cfi_supported=false
+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+fi
+
+fi ;;
+esac
+fi
+
+## Frame pointers
+
+if test x"$enable_frame_pointers" = "xyes"; then :
+  case "$host,$CC" in #(
+  x86_64-*-linux*,gcc*|x86_64-*-linux*,clang*) :
+    common_cflags="$common_cflags -g  -fno-omit-frame-pointer"
+      frame_pointers=true
+      $as_echo "#define WITH_FRAME_POINTERS 1" >>confdefs.h
+
+      { $as_echo "$as_me:${as_lineno-$LINENO}: using frame pointers" >&5
+$as_echo "$as_me: using frame pointers" >&6;} ;; #(
+  *) :
+    as_fn_error $? "frame pointers not supported on this platform" "$LINENO" 5
+   ;;
+esac
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: not using frame pointers" >&5
+$as_echo "$as_me: not using frame pointers" >&6;}
+  frame_pointers=false
+fi
+
+## No naked pointers
+
+if test x"$enable_naked_pointers" = "xno" ; then :
+  $as_echo "#define NO_NAKED_POINTERS 1" >>confdefs.h
+
+fi
+
+## Check for mmap support for huge pages and contiguous heap
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether mmap supports huge pages" >&5
+$as_echo_n "checking whether mmap supports huge pages... " >&6; }
+  if test "$cross_compiling" = yes; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no assumed" >&5
+$as_echo "no assumed" >&6; }
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+#include 
+#include 
+#include 
+
+#define huge_page_size (4 * 1024 * 1024)
+
+/* Test for the possible availability of huge pages. Answer yes
+   if the OS knows about huge pages, even if they are not available
+   on the build machine at configure time, because (on Linux) huge
+   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;
+  block = mmap (NULL, huge_page_size, PROT_READ | PROT_WRITE,
+                MAP_PRIVATE | MAP_ANONYMOUS | MAP_HUGETLB,
+                -1, 0);
+  if (block == MAP_FAILED){
+    block = mmap (NULL, huge_page_size, PROT_READ | PROT_WRITE,
+                  MAP_PRIVATE | MAP_ANONYMOUS,
+                  -1, 0);
+  }
+  if (block == MAP_FAILED){
+    perror ("mmap");
+    return 3;
+  }
+  /*printf ("block = %p\n", block);*/
+  p = (char *) block;
+  for (i = 0; i < huge_page_size; i += 4096){
+    p[i] = (char) i;
+  }
+  return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+  $as_echo "#define HAS_HUGE_PAGES 1" >>confdefs.h
+
+    cat >>confdefs.h <<_ACEOF
+#define HUGE_PAGE_SIZE (4 * 1024 * 1024)
+_ACEOF
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+  conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+
+
+# Spacetime profiling, including libunwind detection
+
+# The number of bits used for profiling information is configurable here.
+# The more bits used for profiling, the smaller will be Max_wosize.
+# Note that PROFINFO_WIDTH must still be defined even if not configuring
+# for Spacetime (see comment in runtime/caml/mlvalues.h on [Profinfo_hd]).
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build spacetime" >&5
+$as_echo_n "checking whether to build spacetime... " >&6; }
+if test x"$enable_spacetime" != "xyes" ; then :
+  spacetime=false
+  call_counts=true # as in original script but should probably be false
+  libunwind_available=false
+  libunwind_include_flags=
+  libunwind_link_flags=
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+else
+  case $arch in #(
+  amd64) :
+    spacetime_supported=true ;; #(
+  *) :
+    spacetime_supported=false ;;
+esac
+  if $spacetime_supported; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+    spacetime=true
+    profinfo=true
+    profinfo_width=26
+    $as_echo "#define WITH_SPACETIME 1" >>confdefs.h
+
+    if test x"$enable_call_counts" != "xno"; then :
+  call_counts=true
+      $as_echo "#define ENABLE_CALL_COUNTS 1" >>confdefs.h
+
+else
+  call_counts=false
+fi
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use libunwind" >&5
+$as_echo_n "checking whether to use libunwind... " >&6; }
+    if test x"$with_libunwind" = "xno"; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: disabled" >&5
+$as_echo "disabled" >&6; }
+else
+  if test x"$with_libunwind" = "x"; then :
+  libunwind_requested=false
+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: if available" >&5
+$as_echo "if available" >&6; }
+else
+  libunwind_requested=true
+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: requested" >&5
+$as_echo "requested" >&6; }
+        if test x"$with_libunwind" != "xyes"; then :
+  if test x"$LIBUNWIND_INCLUDE_DIR" = "x"; then :
+  LIBUNWIND_INCLUDE_DIR="$with_libunwind/include"
+fi
+          if test x"$LIBUNWIND_LIB_DIR" = "x"; then :
+  LIBUNWIND_LIB_DIR="$with_libunwind/lib"
+fi
+
+fi
+
+fi
+      if test "$system" = "macosx"; then :
+  if test x"$LIBUNWIND_INCLUDE_DIR" != x -o \
+                     x"$LIBUNWIND_LIB_DIR" != x; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: On MacOSX, specifying paths for libunwind headers or libraries is strongly discouraged. It is recommended to rely on the defaults provided by the configure script" >&5
+$as_echo "$as_me: WARNING: On MacOSX, specifying paths for libunwind headers or libraries is strongly discouraged. It is recommended to rely on the defaults provided by the configure script" >&2;}
+fi
+fi
+
+      if test x"$LIBUNWIND_INCLUDE_DIR" != x; then :
+  libunwind_include_flags="-I$LIBUNWIND_INCLUDE_DIR"
+else
+  libunwind_include_flags=""
+fi
+
+      case "$system" in #(
+  "macosx") :
+    libunwind_link_flags="-framework System" ;; #(
+  *) :
+    libunwind_link_flags="-lunwind -lunwind-x86_64" ;;
+esac
+
+      if test x"$LIBUNWIND_LIB_DIR" != x; then :
+  libunwind_link_flags="-L$LIBUNWIND_LIB_DIR $libunwind_link_flags"
+fi
+
+
+  SAVED_CFLAGS="$CFLAGS"
+  SAVED_LDFLAGS="$LDFLAGS"
+  CFLAGS="$CFLAGS $libunwind_include_flags"
+  LDFLAGS="$LDFLAGS $libunwind_link_flags"
+  ac_fn_c_check_header_mongrel "$LINENO" "libunwind.h" "ac_cv_header_libunwind_h" "$ac_includes_default"
+if test "x$ac_cv_header_libunwind_h" = xyes; then :
+  $as_echo "#define HAS_LIBUNWIND 1" >>confdefs.h
+
+    libunwind_available=true
+else
+  libunwind_available=false
+fi
+
+
+  LDFLAGS="$SAVED_LDFLAGS"
+  CFLAGS="$SAVED_CFLAGS"
+
+
+      if $libunwind_requested && ! $libunwind_available; then :
+  as_fn_error $? "libunwind was requested but can not be found" "$LINENO" 5
+fi
+
+        # We need unwinding information at runtime, but since we use
+        # -no_compact_unwind, we also need -keep_dwarf_unwind otherwise
+        # the OS X linker will chuck away the DWARF-like (.eh_frame)
+        # information.  (Older versions of OS X don't provide this.)
+
+        if $libunwind_available && test x"$system" = "xmacosx"; then :
+  extra_flags="-Wl,-keep_dwarf_unwind"
+          mkexe="$mkexe $extra_flags"
+          mksharedlib="$mksharedlib $extra_flags"
+fi
+fi
+
+else
+  if test x"$enable_spacetime" = "xyes"; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: requested but not supported" >&5
+$as_echo "requested but not supported" >&6; }
+      as_fn_error $? "exiting" "$LINENO" 5
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+fi
+
+fi
+
+cat >>confdefs.h <<_ACEOF
+#define PROFINFO_WIDTH $profinfo_width
+_ACEOF
+
+if $profinfo; then :
+  $as_echo "#define WITH_PROFINFO 1" >>confdefs.h
+
+fi
+
+if test x"$enable_installing_bytecode_programs" = "xno"; then :
+  install_bytecode_programs=false
+else
+  install_bytecode_programs=true
+fi
+
+if test x"$enable_installing_source_artifacts" = "xno"; then :
+  install_source_artifacts=false
+else
+  install_source_artifacts=true
+fi
+
+if test x"$enable_ocamldoc" = "xno"; then :
+  ocamldoc=""
+else
+  ocamldoc=ocamldoc
+fi
+
+case $enable_ocamltest,4.11.1 in #(
+  yes,*|,*+dev*) :
+    ocamltest='ocamltest' ;; #(
+  *) :
+    ocamltest='' ;;
+esac
+
+if test x"$enable_flambda" = "xyes"; then :
+  flambda=true
+  if test x"$enable_flambda_invariants" = "xyes"; then :
+  flambda_invariants=true
+else
+  flambda_invariants=false
+fi
+else
+  flambda=false
+  flambda_invariants=false
+fi
+
+if test x"$enable_flat_float_array" = "xno"; then :
+  flat_float_array=false
+else
+  $as_echo "#define FLAT_FLOAT_ARRAY 1" >>confdefs.h
+
+  flat_float_array=true
+fi
+
+if test x"$enable_function_sections" = "xno"; then :
+  function_sections=false
+else
+  case $arch in #(
+  amd64|i386|arm64) :
+    # not supported on arm32, see issue #9124.
+     case $target in #(
+  *-cygwin*|*-mingw*|*-windows|*-apple-darwin*) :
+    function_sections=false;
+           { $as_echo "$as_me:${as_lineno-$LINENO}: No support for function sections on $target." >&5
+$as_echo "$as_me: No support for function sections on $target." >&6;} ;; #(
+  *) :
+    case $ocaml_cv_cc_vendor in #(
+  gcc-0123-*|gcc-4-01234567) :
+    function_sections=false;
+              { $as_echo "$as_me:${as_lineno-$LINENO}: Function sections are not
+              supported in GCC prior to version 4.8." >&5
+$as_echo "$as_me: Function sections are not
+              supported in GCC prior to version 4.8." >&6;} ;; #(
+  clang-012-*|clang-3-01234) :
+    function_sections=false;
+              { $as_echo "$as_me:${as_lineno-$LINENO}: Function sections are not supported
+              in Clang prior to version 3.5." >&5
+$as_echo "$as_me: Function sections are not supported
+              in Clang prior to version 3.5." >&6;} ;; #(
+  gcc-*|clang-*) :
+    function_sections=true;
+              internal_cflags="$internal_cflags -ffunction-sections";
+              $as_echo "#define FUNCTION_SECTIONS 1" >>confdefs.h
+ ;; #(
+  *) :
+    function_sections=false;
+              { $as_echo "$as_me:${as_lineno-$LINENO}: Function sections are not supported by
+              $ocaml_cv_cc_vendor." >&5
+$as_echo "$as_me: Function sections are not supported by
+              $ocaml_cv_cc_vendor." >&6;} ;; #(
+  *) :
+     ;;
+esac ;; #(
+  *) :
+     ;;
+esac ;; #(
+  *) :
+    function_sections=false ;;
+esac;
+  if test x"$function_sections" = "xfalse"; then :
+  if test x"$enable_function_sections" = "xyes"; then :
+  as_fn_error $? "Function sections are not supported." "$LINENO" 5
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: Disabling function sections." >&5
+$as_echo "$as_me: Disabling function sections." >&6;}
+fi
+fi
+fi
+
+if test x"$with_afl" = "xyes"; then :
+  afl=true
+else
+  afl=false
+fi
+
+if test x"$enable_force_safe_string" = "xno"; then :
+  force_safe_string=false
+else
+  $as_echo "#define CAML_SAFE_STRING 1" >>confdefs.h
+
+   force_safe_string=true
+fi
+
+if test x"$DEFAULT_STRING" = "xunsafe"; then :
+  default_safe_string=false
+else
+  default_safe_string=true
+fi
+
+oc_cflags="$common_cflags $internal_cflags"
+oc_cppflags="$common_cppflags $internal_cppflags"
+ocamlc_cflags="$common_cflags $sharedlib_cflags"
+ocamlc_cppflags="$common_cppflags"
+cclibs="$cclibs $mathlib"
+
+case $host in #(
+  *-*-mingw32) :
+    bytecclibs="-lws2_32 -lversion"
+    nativecclibs="-lws2_32 -lversion" ;; #(
+  *-pc-windows) :
+    bytecclibs="advapi32.lib ws2_32.lib version.lib"
+    nativecclibs="advapi32.lib ws2_32.lib version.lib" ;; #(
+  *) :
+    bytecclibs="$cclibs $DLLIBS $pthread_link $instrumented_runtime_ldlibs"
+  nativecclibs="$cclibs $DLLIBS" ;;
+esac
+
+if test x"$libdir" = x'${exec_prefix}/lib'; then :
+  libdir="$libdir"/ocaml
+fi
+
+if test x"$mandir" = x'${datarootdir}/man'; then :
+  mandir='${prefix}/man'
+fi
+
+case $host in #(
+  *-*-mingw32|*-pc-windows) :
+    max_testsuite_dir_retries=1
+    case $WINDOWS_UNICODE_MODE in #(
+  ansi) :
+    windows_unicode=0 ;; #(
+  compatible|"") :
+    windows_unicode=1 ;; #(
+  *) :
+    as_fn_error $? "unexpected windows unicode mode" "$LINENO" 5 ;;
+esac ;; #(
+  *) :
+    max_testsuite_dir_retries=0
+  windows_unicode=0 ;;
+esac
+
+# Define flexlink chain and flags correctly for the different Windows ports
+case $host in #(
+  i686-w64-mingw32) :
+    flexdll_chain='mingw'
+    flexlink_flags="-chain $flexdll_chain -stack 16777216" ;; #(
+  x86_64-w64-mingw32) :
+    flexdll_chain='mingw64'
+    flexlink_flags="-chain $flexdll_chain -stack 33554432" ;; #(
+  i686-pc-windows) :
+    flexdll_chain='msvc'
+    flexlink_flags="-merge-manifest -stack 16777216" ;; #(
+  x86_64-pc-windows) :
+    flexdll_chain='msvc64'
+    flexlink_flags="-x64 -merge-manifest -stack 33554432" ;; #(
+  *) :
+     ;;
+esac
+
+# Define default prefix correctly for the different Windows ports
+if test x"$prefix" = "xNONE"; then :
+  case $host in #(
+  i686-w64-mingw32) :
+    prefix='C:/ocamlmgw' ;; #(
+  x86_64-w64-mingw32) :
+    prefix='C:/ocamlmgw64' ;; #(
+  i686-pc-windows) :
+    prefix='C:/ocamlms' ;; #(
+  x86_64-pc-windows) :
+    prefix='C:/ocamlms64' ;; #(
+  *) :
+     ;;
+esac
+else
+  if test x"$unix_or_win32" = "xwin32" \
+          && test "$host_vendor-$host_os" != "$build_vendor-$build_os" ; then :
+  case $build in #(
+  *-pc-cygwin) :
+    prefix=`cygpath -m "$prefix"` ;; #(
+  *) :
+     ;;
+esac
+fi
+fi
+
+# Define a few macros that were defined in config/m-nt.h
+# but whose value is not guessed properly by configure
+# (all this should be understood and fixed)
+case $host in #(
+  *-*-mingw32|*-pc-windows) :
+    $as_echo "#define HAS_BROKEN_PRINTF 1" >>confdefs.h
+
+    $as_echo "#define HAS_STRERROR 1" >>confdefs.h
+
+    $as_echo "#define HAS_IPV6 1" >>confdefs.h
+
+    $as_echo "#define HAS_NICE 1" >>confdefs.h
+ ;; #(
+  *) :
+     ;;
+esac
+
+if test x"$enable_stdlib_manpages" != "xno"; then :
+  stdlib_manpages=true
+else
+  stdlib_manpages=false
+fi
+
+cat >confcache <<\_ACEOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs, see configure's option --config-cache.
+# It is not useful on other systems.  If it contains results you don't
+# want to keep, you may remove or edit it.
+#
+# config.status only pays attention to the cache file if you give it
+# the --recheck option to rerun configure.
+#
+# `ac_cv_env_foo' variables (set or unset) will be overridden when
+# loading this file, other *unset* `ac_cv_foo' will be assigned the
+# following values.
+
+_ACEOF
+
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, we kill variables containing newlines.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(
+  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
+    eval ac_val=\$$ac_var
+    case $ac_val in #(
+    *${as_nl}*)
+      case $ac_var in #(
+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+      esac
+      case $ac_var in #(
+      _ | IFS | as_nl) ;; #(
+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+      *) { eval $ac_var=; unset $ac_var;} ;;
+      esac ;;
+    esac
+  done
+
+  (set) 2>&1 |
+    case $as_nl`(ac_space=' '; set) 2>&1` in #(
+    *${as_nl}ac_space=\ *)
+      # `set' does not quote correctly, so add quotes: double-quote
+      # substitution turns \\\\ into \\, and sed turns \\ into \.
+      sed -n \
+	"s/'/'\\\\''/g;
+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
+      ;; #(
+    *)
+      # `set' quotes correctly as required by POSIX, so do not add quotes.
+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
+      ;;
+    esac |
+    sort
+) |
+  sed '
+     /^ac_cv_env_/b end
+     t clear
+     :clear
+     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
+     t end
+     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+     :end' >>confcache
+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
+  if test -w "$cache_file"; then
+    if test "x$cache_file" != "x/dev/null"; then
+      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
+$as_echo "$as_me: updating cache $cache_file" >&6;}
+      if test ! -f "$cache_file" || test -h "$cache_file"; then
+	cat confcache >"$cache_file"
+      else
+        case $cache_file in #(
+        */* | ?:*)
+	  mv -f confcache "$cache_file"$$ &&
+	  mv -f "$cache_file"$$ "$cache_file" ;; #(
+        *)
+	  mv -f confcache "$cache_file" ;;
+	esac
+      fi
+    fi
+  else
+    { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
+$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}
+  fi
+fi
+rm -f confcache
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+DEFS=-DHAVE_CONFIG_H
+
+ac_libobjs=
+ac_ltlibobjs=
+U=
+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
+  # 1. Remove the extension, and $U if already installed.
+  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
+  ac_i=`$as_echo "$ac_i" | sed "$ac_script"`
+  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR
+  #    will be set to the directory where LIBOBJS objects are built.
+  as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"
+  as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'
+done
+LIBOBJS=$ac_libobjs
+
+LTLIBOBJS=$ac_ltlibobjs
+
+
+
+: "${CONFIG_STATUS=./config.status}"
+ac_write_fail=0
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files $CONFIG_STATUS"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
+$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
+as_write_fail=0
+cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
+#! $SHELL
+# Generated by $as_me.
+# Run this file to recreate the current configuration.
+# Compiler output produced by configure, useful for debugging
+# configure, is in config.log if it exists.
+
+debug=false
+ac_cs_recheck=false
+ac_cs_silent=false
+
+SHELL=\${CONFIG_SHELL-$SHELL}
+export SHELL
+_ASEOF
+cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in #(
+  *posix*) :
+    set -o posix ;; #(
+  *) :
+     ;;
+esac
+fi
+
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='print -r --'
+  as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='printf %s\n'
+  as_echo_n='printf %s'
+else
+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+    as_echo_n='/usr/ucb/echo -n'
+  else
+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+    as_echo_n_body='eval
+      arg=$1;
+      case $arg in #(
+      *"$as_nl"*)
+	expr "X$arg" : "X\\(.*\\)$as_nl";
+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+      esac;
+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+    '
+    export as_echo_n_body
+    as_echo_n='sh -c $as_echo_n_body as_echo'
+  fi
+  export as_echo_body
+  as_echo='sh -c $as_echo_body as_echo'
+fi
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+  PATH_SEPARATOR=:
+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+      PATH_SEPARATOR=';'
+  }
+fi
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.  Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" ""	$as_nl"
+
+# Find who we are.  Look in the path if we contain no directory separator.
+as_myself=
+case $0 in #((
+  *[\\/]* ) as_myself=$0 ;;
+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+  done
+IFS=$as_save_IFS
+
+     ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+  as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+  exit 1
+fi
+
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there.  '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+
+# as_fn_error STATUS ERROR [LINENO LOG_FD]
+# ----------------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with STATUS, using 1 if that was 0.
+as_fn_error ()
+{
+  as_status=$1; test $as_status -eq 0 && as_status=1
+  if test "$4"; then
+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
+  fi
+  $as_echo "$as_me: error: $2" >&2
+  as_fn_exit $as_status
+} # as_fn_error
+
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+  return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+  set +e
+  as_fn_set_status $1
+  exit $1
+} # as_fn_exit
+
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+  { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+  eval 'as_fn_append ()
+  {
+    eval $1+=\$2
+  }'
+else
+  as_fn_append ()
+  {
+    eval $1=\$$1\$2
+  }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+  eval 'as_fn_arith ()
+  {
+    as_val=$(( $* ))
+  }'
+else
+  as_fn_arith ()
+  {
+    as_val=`expr "$@" || test $? -eq 1`
+  }
+fi # as_fn_arith
+
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+   test "X`expr 00001 : '.*\(...\)'`" = X001; then
+  as_expr=expr
+else
+  as_expr=false
+fi
+
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
+  as_basename=basename
+else
+  as_basename=false
+fi
+
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+  as_dirname=dirname
+else
+  as_dirname=false
+fi
+
+as_me=`$as_basename -- "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+	 X"$0" : 'X\(//\)$' \| \
+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+    sed '/^.*\/\([^/][^/]*\)\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+  case `echo 'xy\c'` in
+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
+  xy)  ECHO_C='\c';;
+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
+       ECHO_T='	';;
+  esac;;
+*)
+  ECHO_N='-n';;
+esac
+
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+  rm -f conf$$.dir/conf$$.file
+else
+  rm -f conf$$.dir
+  mkdir conf$$.dir 2>/dev/null
+fi
+if (echo >conf$$.file) 2>/dev/null; then
+  if ln -s conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s='ln -s'
+    # ... but there are two gotchas:
+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+    # In both cases, we have to default to `cp -pR'.
+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+      as_ln_s='cp -pR'
+  elif ln conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s=ln
+  else
+    as_ln_s='cp -pR'
+  fi
+else
+  as_ln_s='cp -pR'
+fi
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
+
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+  case $as_dir in #(
+  -*) as_dir=./$as_dir;;
+  esac
+  test -d "$as_dir" || eval $as_mkdir_p || {
+    as_dirs=
+    while :; do
+      case $as_dir in #(
+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+      *) as_qdir=$as_dir;;
+      esac
+      as_dirs="'$as_qdir' $as_dirs"
+      as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_dir" : 'X\(//\)[^/]' \| \
+	 X"$as_dir" : 'X\(//\)$' \| \
+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+      test -d "$as_dir" && break
+    done
+    test -z "$as_dirs" || eval "mkdir $as_dirs"
+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
+if mkdir -p . 2>/dev/null; then
+  as_mkdir_p='mkdir -p "$as_dir"'
+else
+  test -d ./-p && rmdir ./-p
+  as_mkdir_p=false
+fi
+
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+  test -f "$1" && test -x "$1"
+} # as_fn_executable_p
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+exec 6>&1
+## ----------------------------------- ##
+## Main body of $CONFIG_STATUS script. ##
+## ----------------------------------- ##
+_ASEOF
+test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# Save the log message, to keep $0 and so on meaningful, and to
+# 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 4.11.1, which was
+generated by GNU Autoconf 2.69.  Invocation command line was
+
+  CONFIG_FILES    = $CONFIG_FILES
+  CONFIG_HEADERS  = $CONFIG_HEADERS
+  CONFIG_LINKS    = $CONFIG_LINKS
+  CONFIG_COMMANDS = $CONFIG_COMMANDS
+  $ $0 $@
+
+on `(hostname || uname -n) 2>/dev/null | sed 1q`
+"
+
+_ACEOF
+
+case $ac_config_files in *"
+"*) set x $ac_config_files; shift; ac_config_files=$*;;
+esac
+
+case $ac_config_headers in *"
+"*) set x $ac_config_headers; shift; ac_config_headers=$*;;
+esac
+
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+# Files that config.status was made for.
+config_files="$ac_config_files"
+config_headers="$ac_config_headers"
+config_commands="$ac_config_commands"
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+ac_cs_usage="\
+\`$as_me' instantiates files and other configuration actions
+from templates according to the current configuration.  Unless the files
+and actions are specified as TAGs, all are instantiated by default.
+
+Usage: $0 [OPTION]... [TAG]...
+
+  -h, --help       print this help, then exit
+  -V, --version    print version number and configuration settings, then exit
+      --config     print configuration, then exit
+  -q, --quiet, --silent
+                   do not print progress messages
+  -d, --debug      don't remove temporary files
+      --recheck    update $as_me by reconfiguring in the same conditions
+      --file=FILE[:TEMPLATE]
+                   instantiate the configuration file FILE
+      --header=FILE[:TEMPLATE]
+                   instantiate the configuration header FILE
+
+Configuration files:
+$config_files
+
+Configuration headers:
+$config_headers
+
+Configuration commands:
+$config_commands
+
+Report bugs to .
+OCaml home page: ."
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
+ac_cs_version="\\
+OCaml config.status 4.11.1
+configured by $0, generated by GNU Autoconf 2.69,
+  with options \\"\$ac_cs_config\\"
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+This config.status script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it."
+
+ac_pwd='$ac_pwd'
+srcdir='$srcdir'
+INSTALL='$INSTALL'
+AWK='$AWK'
+test -n "\$AWK" || AWK=awk
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# The default lists apply if the user does not specify any file.
+ac_need_defaults=:
+while test $# != 0
+do
+  case $1 in
+  --*=?*)
+    ac_option=`expr "X$1" : 'X\([^=]*\)='`
+    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
+    ac_shift=:
+    ;;
+  --*=)
+    ac_option=`expr "X$1" : 'X\([^=]*\)='`
+    ac_optarg=
+    ac_shift=:
+    ;;
+  *)
+    ac_option=$1
+    ac_optarg=$2
+    ac_shift=shift
+    ;;
+  esac
+
+  case $ac_option in
+  # Handling of the options.
+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+    ac_cs_recheck=: ;;
+  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
+    $as_echo "$ac_cs_version"; exit ;;
+  --config | --confi | --conf | --con | --co | --c )
+    $as_echo "$ac_cs_config"; exit ;;
+  --debug | --debu | --deb | --de | --d | -d )
+    debug=: ;;
+  --file | --fil | --fi | --f )
+    $ac_shift
+    case $ac_optarg in
+    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
+    '') as_fn_error $? "missing file argument" ;;
+    esac
+    as_fn_append CONFIG_FILES " '$ac_optarg'"
+    ac_need_defaults=false;;
+  --header | --heade | --head | --hea )
+    $ac_shift
+    case $ac_optarg in
+    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
+    esac
+    as_fn_append CONFIG_HEADERS " '$ac_optarg'"
+    ac_need_defaults=false;;
+  --he | --h)
+    # Conflict between --help and --header
+    as_fn_error $? "ambiguous option: \`$1'
+Try \`$0 --help' for more information.";;
+  --help | --hel | -h )
+    $as_echo "$ac_cs_usage"; exit ;;
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil | --si | --s)
+    ac_cs_silent=: ;;
+
+  # This is an error.
+  -*) as_fn_error $? "unrecognized option: \`$1'
+Try \`$0 --help' for more information." ;;
+
+  *) as_fn_append ac_config_targets " $1"
+     ac_need_defaults=false ;;
+
+  esac
+  shift
+done
+
+ac_configure_extra_args=
+
+if $ac_cs_silent; then
+  exec 6>/dev/null
+  ac_configure_extra_args="$ac_configure_extra_args --silent"
+fi
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+if \$ac_cs_recheck; then
+  set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+  shift
+  \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
+  CONFIG_SHELL='$SHELL'
+  export CONFIG_SHELL
+  exec "\$@"
+fi
+
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+exec 5>>config.log
+{
+  echo
+  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+  $as_echo "$ac_log"
+} >&5
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+#
+# INIT-COMMANDS
+#
+
+
+# The HP-UX ksh and POSIX shell print the target directory to stdout
+# if CDPATH is set.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+sed_quote_subst='$sed_quote_subst'
+double_quote_subst='$double_quote_subst'
+delay_variable_subst='$delay_variable_subst'
+macro_version='`$ECHO "$macro_version" | $SED "$delay_single_quote_subst"`'
+macro_revision='`$ECHO "$macro_revision" | $SED "$delay_single_quote_subst"`'
+enable_shared='`$ECHO "$enable_shared" | $SED "$delay_single_quote_subst"`'
+enable_static='`$ECHO "$enable_static" | $SED "$delay_single_quote_subst"`'
+pic_mode='`$ECHO "$pic_mode" | $SED "$delay_single_quote_subst"`'
+enable_fast_install='`$ECHO "$enable_fast_install" | $SED "$delay_single_quote_subst"`'
+shared_archive_member_spec='`$ECHO "$shared_archive_member_spec" | $SED "$delay_single_quote_subst"`'
+SHELL='`$ECHO "$SHELL" | $SED "$delay_single_quote_subst"`'
+ECHO='`$ECHO "$ECHO" | $SED "$delay_single_quote_subst"`'
+PATH_SEPARATOR='`$ECHO "$PATH_SEPARATOR" | $SED "$delay_single_quote_subst"`'
+host_alias='`$ECHO "$host_alias" | $SED "$delay_single_quote_subst"`'
+host='`$ECHO "$host" | $SED "$delay_single_quote_subst"`'
+host_os='`$ECHO "$host_os" | $SED "$delay_single_quote_subst"`'
+build_alias='`$ECHO "$build_alias" | $SED "$delay_single_quote_subst"`'
+build='`$ECHO "$build" | $SED "$delay_single_quote_subst"`'
+build_os='`$ECHO "$build_os" | $SED "$delay_single_quote_subst"`'
+SED='`$ECHO "$SED" | $SED "$delay_single_quote_subst"`'
+Xsed='`$ECHO "$Xsed" | $SED "$delay_single_quote_subst"`'
+GREP='`$ECHO "$GREP" | $SED "$delay_single_quote_subst"`'
+EGREP='`$ECHO "$EGREP" | $SED "$delay_single_quote_subst"`'
+FGREP='`$ECHO "$FGREP" | $SED "$delay_single_quote_subst"`'
+LD='`$ECHO "$LD" | $SED "$delay_single_quote_subst"`'
+NM='`$ECHO "$NM" | $SED "$delay_single_quote_subst"`'
+LN_S='`$ECHO "$LN_S" | $SED "$delay_single_quote_subst"`'
+max_cmd_len='`$ECHO "$max_cmd_len" | $SED "$delay_single_quote_subst"`'
+ac_objext='`$ECHO "$ac_objext" | $SED "$delay_single_quote_subst"`'
+exeext='`$ECHO "$exeext" | $SED "$delay_single_quote_subst"`'
+lt_unset='`$ECHO "$lt_unset" | $SED "$delay_single_quote_subst"`'
+lt_SP2NL='`$ECHO "$lt_SP2NL" | $SED "$delay_single_quote_subst"`'
+lt_NL2SP='`$ECHO "$lt_NL2SP" | $SED "$delay_single_quote_subst"`'
+lt_cv_to_host_file_cmd='`$ECHO "$lt_cv_to_host_file_cmd" | $SED "$delay_single_quote_subst"`'
+lt_cv_to_tool_file_cmd='`$ECHO "$lt_cv_to_tool_file_cmd" | $SED "$delay_single_quote_subst"`'
+reload_flag='`$ECHO "$reload_flag" | $SED "$delay_single_quote_subst"`'
+reload_cmds='`$ECHO "$reload_cmds" | $SED "$delay_single_quote_subst"`'
+OBJDUMP='`$ECHO "$OBJDUMP" | $SED "$delay_single_quote_subst"`'
+deplibs_check_method='`$ECHO "$deplibs_check_method" | $SED "$delay_single_quote_subst"`'
+file_magic_cmd='`$ECHO "$file_magic_cmd" | $SED "$delay_single_quote_subst"`'
+file_magic_glob='`$ECHO "$file_magic_glob" | $SED "$delay_single_quote_subst"`'
+want_nocaseglob='`$ECHO "$want_nocaseglob" | $SED "$delay_single_quote_subst"`'
+DLLTOOL='`$ECHO "$DLLTOOL" | $SED "$delay_single_quote_subst"`'
+sharedlib_from_linklib_cmd='`$ECHO "$sharedlib_from_linklib_cmd" | $SED "$delay_single_quote_subst"`'
+AR='`$ECHO "$AR" | $SED "$delay_single_quote_subst"`'
+AR_FLAGS='`$ECHO "$AR_FLAGS" | $SED "$delay_single_quote_subst"`'
+archiver_list_spec='`$ECHO "$archiver_list_spec" | $SED "$delay_single_quote_subst"`'
+STRIP='`$ECHO "$STRIP" | $SED "$delay_single_quote_subst"`'
+RANLIB='`$ECHO "$RANLIB" | $SED "$delay_single_quote_subst"`'
+old_postinstall_cmds='`$ECHO "$old_postinstall_cmds" | $SED "$delay_single_quote_subst"`'
+old_postuninstall_cmds='`$ECHO "$old_postuninstall_cmds" | $SED "$delay_single_quote_subst"`'
+old_archive_cmds='`$ECHO "$old_archive_cmds" | $SED "$delay_single_quote_subst"`'
+lock_old_archive_extraction='`$ECHO "$lock_old_archive_extraction" | $SED "$delay_single_quote_subst"`'
+CC='`$ECHO "$CC" | $SED "$delay_single_quote_subst"`'
+CFLAGS='`$ECHO "$CFLAGS" | $SED "$delay_single_quote_subst"`'
+compiler='`$ECHO "$compiler" | $SED "$delay_single_quote_subst"`'
+GCC='`$ECHO "$GCC" | $SED "$delay_single_quote_subst"`'
+lt_cv_sys_global_symbol_pipe='`$ECHO "$lt_cv_sys_global_symbol_pipe" | $SED "$delay_single_quote_subst"`'
+lt_cv_sys_global_symbol_to_cdecl='`$ECHO "$lt_cv_sys_global_symbol_to_cdecl" | $SED "$delay_single_quote_subst"`'
+lt_cv_sys_global_symbol_to_import='`$ECHO "$lt_cv_sys_global_symbol_to_import" | $SED "$delay_single_quote_subst"`'
+lt_cv_sys_global_symbol_to_c_name_address='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address" | $SED "$delay_single_quote_subst"`'
+lt_cv_sys_global_symbol_to_c_name_address_lib_prefix='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address_lib_prefix" | $SED "$delay_single_quote_subst"`'
+lt_cv_nm_interface='`$ECHO "$lt_cv_nm_interface" | $SED "$delay_single_quote_subst"`'
+nm_file_list_spec='`$ECHO "$nm_file_list_spec" | $SED "$delay_single_quote_subst"`'
+lt_sysroot='`$ECHO "$lt_sysroot" | $SED "$delay_single_quote_subst"`'
+lt_cv_truncate_bin='`$ECHO "$lt_cv_truncate_bin" | $SED "$delay_single_quote_subst"`'
+objdir='`$ECHO "$objdir" | $SED "$delay_single_quote_subst"`'
+MAGIC_CMD='`$ECHO "$MAGIC_CMD" | $SED "$delay_single_quote_subst"`'
+lt_prog_compiler_no_builtin_flag='`$ECHO "$lt_prog_compiler_no_builtin_flag" | $SED "$delay_single_quote_subst"`'
+lt_prog_compiler_pic='`$ECHO "$lt_prog_compiler_pic" | $SED "$delay_single_quote_subst"`'
+lt_prog_compiler_wl='`$ECHO "$lt_prog_compiler_wl" | $SED "$delay_single_quote_subst"`'
+lt_prog_compiler_static='`$ECHO "$lt_prog_compiler_static" | $SED "$delay_single_quote_subst"`'
+lt_cv_prog_compiler_c_o='`$ECHO "$lt_cv_prog_compiler_c_o" | $SED "$delay_single_quote_subst"`'
+need_locks='`$ECHO "$need_locks" | $SED "$delay_single_quote_subst"`'
+MANIFEST_TOOL='`$ECHO "$MANIFEST_TOOL" | $SED "$delay_single_quote_subst"`'
+DSYMUTIL='`$ECHO "$DSYMUTIL" | $SED "$delay_single_quote_subst"`'
+NMEDIT='`$ECHO "$NMEDIT" | $SED "$delay_single_quote_subst"`'
+LIPO='`$ECHO "$LIPO" | $SED "$delay_single_quote_subst"`'
+OTOOL='`$ECHO "$OTOOL" | $SED "$delay_single_quote_subst"`'
+OTOOL64='`$ECHO "$OTOOL64" | $SED "$delay_single_quote_subst"`'
+libext='`$ECHO "$libext" | $SED "$delay_single_quote_subst"`'
+shrext_cmds='`$ECHO "$shrext_cmds" | $SED "$delay_single_quote_subst"`'
+extract_expsyms_cmds='`$ECHO "$extract_expsyms_cmds" | $SED "$delay_single_quote_subst"`'
+archive_cmds_need_lc='`$ECHO "$archive_cmds_need_lc" | $SED "$delay_single_quote_subst"`'
+enable_shared_with_static_runtimes='`$ECHO "$enable_shared_with_static_runtimes" | $SED "$delay_single_quote_subst"`'
+export_dynamic_flag_spec='`$ECHO "$export_dynamic_flag_spec" | $SED "$delay_single_quote_subst"`'
+whole_archive_flag_spec='`$ECHO "$whole_archive_flag_spec" | $SED "$delay_single_quote_subst"`'
+compiler_needs_object='`$ECHO "$compiler_needs_object" | $SED "$delay_single_quote_subst"`'
+old_archive_from_new_cmds='`$ECHO "$old_archive_from_new_cmds" | $SED "$delay_single_quote_subst"`'
+old_archive_from_expsyms_cmds='`$ECHO "$old_archive_from_expsyms_cmds" | $SED "$delay_single_quote_subst"`'
+archive_cmds='`$ECHO "$archive_cmds" | $SED "$delay_single_quote_subst"`'
+archive_expsym_cmds='`$ECHO "$archive_expsym_cmds" | $SED "$delay_single_quote_subst"`'
+module_cmds='`$ECHO "$module_cmds" | $SED "$delay_single_quote_subst"`'
+module_expsym_cmds='`$ECHO "$module_expsym_cmds" | $SED "$delay_single_quote_subst"`'
+with_gnu_ld='`$ECHO "$with_gnu_ld" | $SED "$delay_single_quote_subst"`'
+allow_undefined_flag='`$ECHO "$allow_undefined_flag" | $SED "$delay_single_quote_subst"`'
+no_undefined_flag='`$ECHO "$no_undefined_flag" | $SED "$delay_single_quote_subst"`'
+hardcode_libdir_flag_spec='`$ECHO "$hardcode_libdir_flag_spec" | $SED "$delay_single_quote_subst"`'
+hardcode_libdir_separator='`$ECHO "$hardcode_libdir_separator" | $SED "$delay_single_quote_subst"`'
+hardcode_direct='`$ECHO "$hardcode_direct" | $SED "$delay_single_quote_subst"`'
+hardcode_direct_absolute='`$ECHO "$hardcode_direct_absolute" | $SED "$delay_single_quote_subst"`'
+hardcode_minus_L='`$ECHO "$hardcode_minus_L" | $SED "$delay_single_quote_subst"`'
+hardcode_shlibpath_var='`$ECHO "$hardcode_shlibpath_var" | $SED "$delay_single_quote_subst"`'
+hardcode_automatic='`$ECHO "$hardcode_automatic" | $SED "$delay_single_quote_subst"`'
+inherit_rpath='`$ECHO "$inherit_rpath" | $SED "$delay_single_quote_subst"`'
+link_all_deplibs='`$ECHO "$link_all_deplibs" | $SED "$delay_single_quote_subst"`'
+always_export_symbols='`$ECHO "$always_export_symbols" | $SED "$delay_single_quote_subst"`'
+export_symbols_cmds='`$ECHO "$export_symbols_cmds" | $SED "$delay_single_quote_subst"`'
+exclude_expsyms='`$ECHO "$exclude_expsyms" | $SED "$delay_single_quote_subst"`'
+include_expsyms='`$ECHO "$include_expsyms" | $SED "$delay_single_quote_subst"`'
+prelink_cmds='`$ECHO "$prelink_cmds" | $SED "$delay_single_quote_subst"`'
+postlink_cmds='`$ECHO "$postlink_cmds" | $SED "$delay_single_quote_subst"`'
+file_list_spec='`$ECHO "$file_list_spec" | $SED "$delay_single_quote_subst"`'
+variables_saved_for_relink='`$ECHO "$variables_saved_for_relink" | $SED "$delay_single_quote_subst"`'
+need_lib_prefix='`$ECHO "$need_lib_prefix" | $SED "$delay_single_quote_subst"`'
+need_version='`$ECHO "$need_version" | $SED "$delay_single_quote_subst"`'
+version_type='`$ECHO "$version_type" | $SED "$delay_single_quote_subst"`'
+runpath_var='`$ECHO "$runpath_var" | $SED "$delay_single_quote_subst"`'
+shlibpath_var='`$ECHO "$shlibpath_var" | $SED "$delay_single_quote_subst"`'
+shlibpath_overrides_runpath='`$ECHO "$shlibpath_overrides_runpath" | $SED "$delay_single_quote_subst"`'
+libname_spec='`$ECHO "$libname_spec" | $SED "$delay_single_quote_subst"`'
+library_names_spec='`$ECHO "$library_names_spec" | $SED "$delay_single_quote_subst"`'
+soname_spec='`$ECHO "$soname_spec" | $SED "$delay_single_quote_subst"`'
+install_override_mode='`$ECHO "$install_override_mode" | $SED "$delay_single_quote_subst"`'
+postinstall_cmds='`$ECHO "$postinstall_cmds" | $SED "$delay_single_quote_subst"`'
+postuninstall_cmds='`$ECHO "$postuninstall_cmds" | $SED "$delay_single_quote_subst"`'
+finish_cmds='`$ECHO "$finish_cmds" | $SED "$delay_single_quote_subst"`'
+finish_eval='`$ECHO "$finish_eval" | $SED "$delay_single_quote_subst"`'
+hardcode_into_libs='`$ECHO "$hardcode_into_libs" | $SED "$delay_single_quote_subst"`'
+sys_lib_search_path_spec='`$ECHO "$sys_lib_search_path_spec" | $SED "$delay_single_quote_subst"`'
+configure_time_dlsearch_path='`$ECHO "$configure_time_dlsearch_path" | $SED "$delay_single_quote_subst"`'
+configure_time_lt_sys_library_path='`$ECHO "$configure_time_lt_sys_library_path" | $SED "$delay_single_quote_subst"`'
+hardcode_action='`$ECHO "$hardcode_action" | $SED "$delay_single_quote_subst"`'
+enable_dlopen='`$ECHO "$enable_dlopen" | $SED "$delay_single_quote_subst"`'
+enable_dlopen_self='`$ECHO "$enable_dlopen_self" | $SED "$delay_single_quote_subst"`'
+enable_dlopen_self_static='`$ECHO "$enable_dlopen_self_static" | $SED "$delay_single_quote_subst"`'
+old_striplib='`$ECHO "$old_striplib" | $SED "$delay_single_quote_subst"`'
+striplib='`$ECHO "$striplib" | $SED "$delay_single_quote_subst"`'
+
+LTCC='$LTCC'
+LTCFLAGS='$LTCFLAGS'
+compiler='$compiler_DEFAULT'
+
+# A function that is used when there is no print builtin or printf.
+func_fallback_echo ()
+{
+  eval 'cat <<_LTECHO_EOF
+\$1
+_LTECHO_EOF'
+}
+
+# Quote evaled strings.
+for var in SHELL \
+ECHO \
+PATH_SEPARATOR \
+SED \
+GREP \
+EGREP \
+FGREP \
+LD \
+NM \
+LN_S \
+lt_SP2NL \
+lt_NL2SP \
+reload_flag \
+OBJDUMP \
+deplibs_check_method \
+file_magic_cmd \
+file_magic_glob \
+want_nocaseglob \
+DLLTOOL \
+sharedlib_from_linklib_cmd \
+AR \
+AR_FLAGS \
+archiver_list_spec \
+STRIP \
+RANLIB \
+CC \
+CFLAGS \
+compiler \
+lt_cv_sys_global_symbol_pipe \
+lt_cv_sys_global_symbol_to_cdecl \
+lt_cv_sys_global_symbol_to_import \
+lt_cv_sys_global_symbol_to_c_name_address \
+lt_cv_sys_global_symbol_to_c_name_address_lib_prefix \
+lt_cv_nm_interface \
+nm_file_list_spec \
+lt_cv_truncate_bin \
+lt_prog_compiler_no_builtin_flag \
+lt_prog_compiler_pic \
+lt_prog_compiler_wl \
+lt_prog_compiler_static \
+lt_cv_prog_compiler_c_o \
+need_locks \
+MANIFEST_TOOL \
+DSYMUTIL \
+NMEDIT \
+LIPO \
+OTOOL \
+OTOOL64 \
+shrext_cmds \
+export_dynamic_flag_spec \
+whole_archive_flag_spec \
+compiler_needs_object \
+with_gnu_ld \
+allow_undefined_flag \
+no_undefined_flag \
+hardcode_libdir_flag_spec \
+hardcode_libdir_separator \
+exclude_expsyms \
+include_expsyms \
+file_list_spec \
+variables_saved_for_relink \
+libname_spec \
+library_names_spec \
+soname_spec \
+install_override_mode \
+finish_eval \
+old_striplib \
+striplib; do
+    case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in
+    *[\\\\\\\`\\"\\\$]*)
+      eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED \\"\\\$sed_quote_subst\\"\\\`\\\\\\"" ## exclude from sc_prohibit_nested_quotes
+      ;;
+    *)
+      eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\""
+      ;;
+    esac
+done
+
+# Double-quote double-evaled strings.
+for var in reload_cmds \
+old_postinstall_cmds \
+old_postuninstall_cmds \
+old_archive_cmds \
+extract_expsyms_cmds \
+old_archive_from_new_cmds \
+old_archive_from_expsyms_cmds \
+archive_cmds \
+archive_expsym_cmds \
+module_cmds \
+module_expsym_cmds \
+export_symbols_cmds \
+prelink_cmds \
+postlink_cmds \
+postinstall_cmds \
+postuninstall_cmds \
+finish_cmds \
+sys_lib_search_path_spec \
+configure_time_dlsearch_path \
+configure_time_lt_sys_library_path; do
+    case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in
+    *[\\\\\\\`\\"\\\$]*)
+      eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED -e \\"\\\$double_quote_subst\\" -e \\"\\\$sed_quote_subst\\" -e \\"\\\$delay_variable_subst\\"\\\`\\\\\\"" ## exclude from sc_prohibit_nested_quotes
+      ;;
+    *)
+      eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\""
+      ;;
+    esac
+done
+
+ac_aux_dir='$ac_aux_dir'
+
+# See if we are running on zsh, and set the options that allow our
+# commands through without removal of \ escapes INIT.
+if test -n "\${ZSH_VERSION+set}"; then
+   setopt NO_GLOB_SUBST
+fi
+
+
+    PACKAGE='$PACKAGE'
+    VERSION='$VERSION'
+    RM='$RM'
+    ofile='$ofile'
+
+
+
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+
+# Handling of arguments.
+for ac_config_target in $ac_config_targets
+do
+  case $ac_config_target in
+    "Makefile.common") CONFIG_FILES="$CONFIG_FILES Makefile.common" ;;
+    "Makefile.config") CONFIG_FILES="$CONFIG_FILES Makefile.config" ;;
+    "tools/eventlog_metadata") CONFIG_FILES="$CONFIG_FILES tools/eventlog_metadata" ;;
+    "runtime/caml/m.h") CONFIG_HEADERS="$CONFIG_HEADERS runtime/caml/m.h" ;;
+    "runtime/caml/s.h") CONFIG_HEADERS="$CONFIG_HEADERS runtime/caml/s.h" ;;
+    "libtool") CONFIG_COMMANDS="$CONFIG_COMMANDS libtool" ;;
+
+  *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
+  esac
+done
+
+
+# If the user did not use the arguments to specify the items to instantiate,
+# then the envvar interface is used.  Set only those that are not.
+# We use the long form for the default assignment because of an extremely
+# bizarre bug on SunOS 4.1.3.
+if $ac_need_defaults; then
+  test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
+  test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers
+  test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands
+fi
+
+# Have a temporary directory for convenience.  Make it in the build tree
+# simply because there is no reason against having it here, and in addition,
+# creating and moving files from /tmp can sometimes cause problems.
+# Hook for its removal unless debugging.
+# Note that there is a small window in which the directory will not be cleaned:
+# after its creation but before its name has been assigned to `$tmp'.
+$debug ||
+{
+  tmp= ac_tmp=
+  trap 'exit_status=$?
+  : "${ac_tmp:=$tmp}"
+  { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status
+' 0
+  trap 'as_fn_exit 1' 1 2 13 15
+}
+# Create a (secure) tmp directory for tmp files.
+
+{
+  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
+  test -d "$tmp"
+}  ||
+{
+  tmp=./conf$$-$RANDOM
+  (umask 077 && mkdir "$tmp")
+} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5
+ac_tmp=$tmp
+
+# Set up the scripts for CONFIG_FILES section.
+# No need to generate them if there are no CONFIG_FILES.
+# This happens for instance with `./config.status config.h'.
+if test -n "$CONFIG_FILES"; then
+
+
+ac_cr=`echo X | tr X '\015'`
+# On cygwin, bash can eat \r inside `` if the user requested igncr.
+# But we know of no other shell where ac_cr would be empty at this
+# point, so we can use a bashism as a fallback.
+if test "x$ac_cr" = x; then
+  eval ac_cr=\$\'\\r\'
+fi
+ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null`
+if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then
+  ac_cs_awk_cr='\\r'
+else
+  ac_cs_awk_cr=$ac_cr
+fi
+
+echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&
+_ACEOF
+
+
+{
+  echo "cat >conf$$subs.awk <<_ACEOF" &&
+  echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&
+  echo "_ACEOF"
+} >conf$$subs.sh ||
+  as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
+ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`
+ac_delim='%!_!# '
+for ac_last_try in false false false false false :; do
+  . ./conf$$subs.sh ||
+    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
+
+  ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`
+  if test $ac_delim_n = $ac_delim_num; then
+    break
+  elif $ac_last_try; then
+    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
+  else
+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
+  fi
+done
+rm -f conf$$subs.sh
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&
+_ACEOF
+sed -n '
+h
+s/^/S["/; s/!.*/"]=/
+p
+g
+s/^[^!]*!//
+:repl
+t repl
+s/'"$ac_delim"'$//
+t delim
+:nl
+h
+s/\(.\{148\}\)..*/\1/
+t more1
+s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/
+p
+n
+b repl
+:more1
+s/["\\]/\\&/g; s/^/"/; s/$/"\\/
+p
+g
+s/.\{148\}//
+t nl
+:delim
+h
+s/\(.\{148\}\)..*/\1/
+t more2
+s/["\\]/\\&/g; s/^/"/; s/$/"/
+p
+b
+:more2
+s/["\\]/\\&/g; s/^/"/; s/$/"\\/
+p
+g
+s/.\{148\}//
+t delim
+' >$CONFIG_STATUS || ac_write_fail=1
+rm -f conf$$subs.awk
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+_ACAWK
+cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&
+  for (key in S) S_is_set[key] = 1
+  FS = ""
+
+}
+{
+  line = $ 0
+  nfields = split(line, field, "@")
+  substed = 0
+  len = length(field[1])
+  for (i = 2; i < nfields; i++) {
+    key = field[i]
+    keylen = length(key)
+    if (S_is_set[key]) {
+      value = S[key]
+      line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)
+      len += length(value) + length(field[++i])
+      substed = 1
+    } else
+      len += 1 + keylen
+  }
+
+  print line
+}
+
+_ACAWK
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then
+  sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"
+else
+  cat
+fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \
+  || as_fn_error $? "could not setup config files machinery" "$LINENO" 5
+_ACEOF
+
+# VPATH may cause trouble with some makes, so we remove sole $(srcdir),
+# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and
+# trailing colons and then remove the whole line if VPATH becomes empty
+# (actually we leave an empty line to preserve line numbers).
+if test "x$srcdir" = x.; then
+  ac_vpsub='/^[	 ]*VPATH[	 ]*=[	 ]*/{
+h
+s///
+s/^/:/
+s/[	 ]*$/:/
+s/:\$(srcdir):/:/g
+s/:\${srcdir}:/:/g
+s/:@srcdir@:/:/g
+s/^:*//
+s/:*$//
+x
+s/\(=[	 ]*\).*/\1/
+G
+s/\n//
+s/^[^=]*=[	 ]*$//
+}'
+fi
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+fi # test -n "$CONFIG_FILES"
+
+# Set up the scripts for CONFIG_HEADERS section.
+# No need to generate them if there are no CONFIG_HEADERS.
+# This happens for instance with `./config.status Makefile'.
+if test -n "$CONFIG_HEADERS"; then
+cat >"$ac_tmp/defines.awk" <<\_ACAWK ||
+BEGIN {
+_ACEOF
+
+# Transform confdefs.h into an awk script `defines.awk', embedded as
+# here-document in config.status, that substitutes the proper values into
+# config.h.in to produce config.h.
+
+# Create a delimiter string that does not exist in confdefs.h, to ease
+# handling of long lines.
+ac_delim='%!_!# '
+for ac_last_try in false false :; do
+  ac_tt=`sed -n "/$ac_delim/p" confdefs.h`
+  if test -z "$ac_tt"; then
+    break
+  elif $ac_last_try; then
+    as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5
+  else
+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
+  fi
+done
+
+# For the awk script, D is an array of macro values keyed by name,
+# likewise P contains macro parameters if any.  Preserve backslash
+# newline sequences.
+
+ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]*
+sed -n '
+s/.\{148\}/&'"$ac_delim"'/g
+t rset
+:rset
+s/^[	 ]*#[	 ]*define[	 ][	 ]*/ /
+t def
+d
+:def
+s/\\$//
+t bsnl
+s/["\\]/\\&/g
+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\
+D["\1"]=" \3"/p
+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2"/p
+d
+:bsnl
+s/["\\]/\\&/g
+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\
+D["\1"]=" \3\\\\\\n"\\/p
+t cont
+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p
+t cont
+d
+:cont
+n
+s/.\{148\}/&'"$ac_delim"'/g
+t clear
+:clear
+s/\\$//
+t bsnlc
+s/["\\]/\\&/g; s/^/"/; s/$/"/p
+d
+:bsnlc
+s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p
+b cont
+' >$CONFIG_STATUS || ac_write_fail=1
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+  for (key in D) D_is_set[key] = 1
+  FS = ""
+}
+/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ {
+  line = \$ 0
+  split(line, arg, " ")
+  if (arg[1] == "#") {
+    defundef = arg[2]
+    mac1 = arg[3]
+  } else {
+    defundef = substr(arg[1], 2)
+    mac1 = arg[2]
+  }
+  split(mac1, mac2, "(") #)
+  macro = mac2[1]
+  prefix = substr(line, 1, index(line, defundef) - 1)
+  if (D_is_set[macro]) {
+    # Preserve the white space surrounding the "#".
+    print prefix "define", macro P[macro] D[macro]
+    next
+  } else {
+    # Replace #undef with comments.  This is necessary, for example,
+    # in the case of _POSIX_SOURCE, which is predefined and required
+    # on some systems where configure will not decide to define it.
+    if (defundef == "undef") {
+      print "/*", prefix defundef, macro, "*/"
+      next
+    }
+  }
+}
+{ print }
+_ACAWK
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+  as_fn_error $? "could not setup config headers machinery" "$LINENO" 5
+fi # test -n "$CONFIG_HEADERS"
+
+
+eval set X "  :F $CONFIG_FILES  :H $CONFIG_HEADERS    :C $CONFIG_COMMANDS"
+shift
+for ac_tag
+do
+  case $ac_tag in
+  :[FHLC]) ac_mode=$ac_tag; continue;;
+  esac
+  case $ac_mode$ac_tag in
+  :[FHL]*:*);;
+  :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;
+  :[FH]-) ac_tag=-:-;;
+  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
+  esac
+  ac_save_IFS=$IFS
+  IFS=:
+  set x $ac_tag
+  IFS=$ac_save_IFS
+  shift
+  ac_file=$1
+  shift
+
+  case $ac_mode in
+  :L) ac_source=$1;;
+  :[FH])
+    ac_file_inputs=
+    for ac_f
+    do
+      case $ac_f in
+      -) ac_f="$ac_tmp/stdin";;
+      *) # Look for the file first in the build tree, then in the source tree
+	 # (if the path is not absolute).  The absolute path cannot be DOS-style,
+	 # because $ac_f cannot contain `:'.
+	 test -f "$ac_f" ||
+	   case $ac_f in
+	   [\\/$]*) false;;
+	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
+	   esac ||
+	   as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;
+      esac
+      case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac
+      as_fn_append ac_file_inputs " '$ac_f'"
+    done
+
+    # Let's still pretend it is `configure' which instantiates (i.e., don't
+    # use $as_me), people would be surprised to read:
+    #    /* config.h.  Generated by config.status.  */
+    configure_input='Generated from '`
+	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
+	`' by configure.'
+    if test x"$ac_file" != x-; then
+      configure_input="$ac_file.  $configure_input"
+      { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
+$as_echo "$as_me: creating $ac_file" >&6;}
+    fi
+    # Neutralize special characters interpreted by sed in replacement strings.
+    case $configure_input in #(
+    *\&* | *\|* | *\\* )
+       ac_sed_conf_input=`$as_echo "$configure_input" |
+       sed 's/[\\\\&|]/\\\\&/g'`;; #(
+    *) ac_sed_conf_input=$configure_input;;
+    esac
+
+    case $ac_tag in
+    *:-:* | *:-) cat >"$ac_tmp/stdin" \
+      || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;
+    esac
+    ;;
+  esac
+
+  ac_dir=`$as_dirname -- "$ac_file" ||
+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$ac_file" : 'X\(//\)[^/]' \| \
+	 X"$ac_file" : 'X\(//\)$' \| \
+	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$ac_file" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+  as_dir="$ac_dir"; as_fn_mkdir_p
+  ac_builddir=.
+
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+  # A ".." for each directory in $ac_dir_suffix.
+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+  case $ac_top_builddir_sub in
+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+  esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
+
+case $srcdir in
+  .)  # We are building in place.
+    ac_srcdir=.
+    ac_top_srcdir=$ac_top_builddir_sub
+    ac_abs_top_srcdir=$ac_pwd ;;
+  [\\/]* | ?:[\\/]* )  # Absolute name.
+    ac_srcdir=$srcdir$ac_dir_suffix;
+    ac_top_srcdir=$srcdir
+    ac_abs_top_srcdir=$srcdir ;;
+  *) # Relative name.
+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+    ac_top_srcdir=$ac_top_build_prefix$srcdir
+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
+esac
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+
+  case $ac_mode in
+  :F)
+  #
+  # CONFIG_FILE
+  #
+
+  case $INSTALL in
+  [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;;
+  *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;;
+  esac
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# If the template does not know about datarootdir, expand it.
+# FIXME: This hack should be removed a few years after 2.60.
+ac_datarootdir_hack=; ac_datarootdir_seen=
+ac_sed_dataroot='
+/datarootdir/ {
+  p
+  q
+}
+/@datadir@/p
+/@docdir@/p
+/@infodir@/p
+/@localedir@/p
+/@mandir@/p'
+case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in
+*datarootdir*) ac_datarootdir_seen=yes;;
+*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
+$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+  ac_datarootdir_hack='
+  s&@datadir@&$datadir&g
+  s&@docdir@&$docdir&g
+  s&@infodir@&$infodir&g
+  s&@localedir@&$localedir&g
+  s&@mandir@&$mandir&g
+  s&\\\${datarootdir}&$datarootdir&g' ;;
+esac
+_ACEOF
+
+# Neutralize VPATH when `$srcdir' = `.'.
+# Shell code in configure.ac might set extrasub.
+# FIXME: do we really want to maintain this feature?
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_sed_extra="$ac_vpsub
+$extrasub
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+:t
+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
+s|@configure_input@|$ac_sed_conf_input|;t t
+s&@top_builddir@&$ac_top_builddir_sub&;t t
+s&@top_build_prefix@&$ac_top_build_prefix&;t t
+s&@srcdir@&$ac_srcdir&;t t
+s&@abs_srcdir@&$ac_abs_srcdir&;t t
+s&@top_srcdir@&$ac_top_srcdir&;t t
+s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t
+s&@builddir@&$ac_builddir&;t t
+s&@abs_builddir@&$ac_abs_builddir&;t t
+s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
+s&@INSTALL@&$ac_INSTALL&;t t
+$ac_datarootdir_hack
+"
+eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \
+  >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5
+
+test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
+  { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&
+  { ac_out=`sed -n '/^[	 ]*datarootdir[	 ]*:*=/p' \
+      "$ac_tmp/out"`; test -z "$ac_out"; } &&
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined.  Please make sure it is defined" >&5
+$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined.  Please make sure it is defined" >&2;}
+
+  rm -f "$ac_tmp/stdin"
+  case $ac_file in
+  -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;
+  *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;
+  esac \
+  || as_fn_error $? "could not create $ac_file" "$LINENO" 5
+ ;;
+  :H)
+  #
+  # CONFIG_HEADER
+  #
+  if test x"$ac_file" != x-; then
+    {
+      $as_echo "/* $configure_input  */" \
+      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs"
+    } >"$ac_tmp/config.h" \
+      || as_fn_error $? "could not create $ac_file" "$LINENO" 5
+    if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then
+      { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5
+$as_echo "$as_me: $ac_file is unchanged" >&6;}
+    else
+      rm -f "$ac_file"
+      mv "$ac_tmp/config.h" "$ac_file" \
+	|| as_fn_error $? "could not create $ac_file" "$LINENO" 5
+    fi
+  else
+    $as_echo "/* $configure_input  */" \
+      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \
+      || as_fn_error $? "could not create -" "$LINENO" 5
+  fi
+ ;;
+
+  :C)  { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5
+$as_echo "$as_me: executing $ac_file commands" >&6;}
+ ;;
+  esac
+
+
+  case $ac_file$ac_mode in
+    "libtool":C)
+
+    # See if we are running on zsh, and set the options that allow our
+    # commands through without removal of \ escapes.
+    if test -n "${ZSH_VERSION+set}"; then
+      setopt NO_GLOB_SUBST
+    fi
+
+    cfgfile=${ofile}T
+    trap "$RM \"$cfgfile\"; exit 1" 1 2 15
+    $RM "$cfgfile"
+
+    cat <<_LT_EOF >> "$cfgfile"
+#! $SHELL
+# Generated automatically by $as_me ($PACKAGE) $VERSION
+# NOTE: Changes made to this file will be lost: look at ltmain.sh.
+
+# Provide generalized library-building support services.
+# Written by Gordon Matzigkeit, 1996
+
+# Copyright (C) 2014 Free Software Foundation, Inc.
+# This is free software; see the source for copying conditions.  There is NO
+# warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+# GNU Libtool is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of of the License, or
+# (at your option) any later version.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program or library that is built
+# using GNU Libtool, you may include this file under the  same
+# distribution terms that you use for the rest of that program.
+#
+# GNU Libtool is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see .
+
+
+# The names of the tagged configurations supported by this script.
+available_tags=''
+
+# Configured defaults for sys_lib_dlsearch_path munging.
+: \${LT_SYS_LIBRARY_PATH="$configure_time_lt_sys_library_path"}
+
+# ### BEGIN LIBTOOL CONFIG
+
+# Which release of libtool.m4 was used?
+macro_version=$macro_version
+macro_revision=$macro_revision
+
+# Whether or not to build shared libraries.
+build_libtool_libs=$enable_shared
+
+# Whether or not to build static libraries.
+build_old_libs=$enable_static
+
+# What type of objects to build.
+pic_mode=$pic_mode
+
+# Whether or not to optimize for fast installation.
+fast_install=$enable_fast_install
+
+# Shared archive member basename,for filename based shared library versioning on AIX.
+shared_archive_member_spec=$shared_archive_member_spec
+
+# Shell to use when invoking shell scripts.
+SHELL=$lt_SHELL
+
+# An echo program that protects backslashes.
+ECHO=$lt_ECHO
+
+# The PATH separator for the build system.
+PATH_SEPARATOR=$lt_PATH_SEPARATOR
+
+# The host system.
+host_alias=$host_alias
+host=$host
+host_os=$host_os
+
+# The build system.
+build_alias=$build_alias
+build=$build
+build_os=$build_os
+
+# A sed program that does not truncate output.
+SED=$lt_SED
+
+# Sed that helps us avoid accidentally triggering echo(1) options like -n.
+Xsed="\$SED -e 1s/^X//"
+
+# A grep program that handles long lines.
+GREP=$lt_GREP
+
+# An ERE matcher.
+EGREP=$lt_EGREP
+
+# A literal string matcher.
+FGREP=$lt_FGREP
+
+# A BSD- or MS-compatible name lister.
+NM=$lt_NM
+
+# Whether we need soft or hard links.
+LN_S=$lt_LN_S
+
+# What is the maximum length of a command?
+max_cmd_len=$max_cmd_len
+
+# Object file suffix (normally "o").
+objext=$ac_objext
+
+# Executable file suffix (normally "").
+exeext=$exeext
+
+# whether the shell understands "unset".
+lt_unset=$lt_unset
+
+# turn spaces into newlines.
+SP2NL=$lt_lt_SP2NL
+
+# turn newlines into spaces.
+NL2SP=$lt_lt_NL2SP
+
+# convert \$build file names to \$host format.
+to_host_file_cmd=$lt_cv_to_host_file_cmd
+
+# convert \$build files to toolchain format.
+to_tool_file_cmd=$lt_cv_to_tool_file_cmd
+
+# An object symbol dumper.
+OBJDUMP=$lt_OBJDUMP
+
+# Method to check whether dependent libraries are shared objects.
+deplibs_check_method=$lt_deplibs_check_method
+
+# Command to use when deplibs_check_method = "file_magic".
+file_magic_cmd=$lt_file_magic_cmd
+
+# How to find potential files when deplibs_check_method = "file_magic".
+file_magic_glob=$lt_file_magic_glob
+
+# Find potential files using nocaseglob when deplibs_check_method = "file_magic".
+want_nocaseglob=$lt_want_nocaseglob
+
+# DLL creation program.
+DLLTOOL=$lt_DLLTOOL
+
+# Command to associate shared and link libraries.
+sharedlib_from_linklib_cmd=$lt_sharedlib_from_linklib_cmd
+
+# The archiver.
+AR=$lt_AR
+
+# Flags to create an archive.
+AR_FLAGS=$lt_AR_FLAGS
+
+# How to feed a file listing to the archiver.
+archiver_list_spec=$lt_archiver_list_spec
+
+# A symbol stripping program.
+STRIP=$lt_STRIP
+
+# Commands used to install an old-style archive.
+RANLIB=$lt_RANLIB
+old_postinstall_cmds=$lt_old_postinstall_cmds
+old_postuninstall_cmds=$lt_old_postuninstall_cmds
+
+# Whether to use a lock for old archive extraction.
+lock_old_archive_extraction=$lock_old_archive_extraction
+
+# A C compiler.
+LTCC=$lt_CC
+
+# LTCC compiler flags.
+LTCFLAGS=$lt_CFLAGS
+
+# Take the output of nm and produce a listing of raw symbols and C names.
+global_symbol_pipe=$lt_lt_cv_sys_global_symbol_pipe
+
+# Transform the output of nm in a proper C declaration.
+global_symbol_to_cdecl=$lt_lt_cv_sys_global_symbol_to_cdecl
+
+# Transform the output of nm into a list of symbols to manually relocate.
+global_symbol_to_import=$lt_lt_cv_sys_global_symbol_to_import
+
+# Transform the output of nm in a C name address pair.
+global_symbol_to_c_name_address=$lt_lt_cv_sys_global_symbol_to_c_name_address
+
+# Transform the output of nm in a C name address pair when lib prefix is needed.
+global_symbol_to_c_name_address_lib_prefix=$lt_lt_cv_sys_global_symbol_to_c_name_address_lib_prefix
+
+# The name lister interface.
+nm_interface=$lt_lt_cv_nm_interface
+
+# Specify filename containing input files for \$NM.
+nm_file_list_spec=$lt_nm_file_list_spec
+
+# The root where to search for dependent libraries,and where our libraries should be installed.
+lt_sysroot=$lt_sysroot
+
+# Command to truncate a binary pipe.
+lt_truncate_bin=$lt_lt_cv_truncate_bin
+
+# The name of the directory that contains temporary libtool files.
+objdir=$objdir
+
+# Used to examine libraries when file_magic_cmd begins with "file".
+MAGIC_CMD=$MAGIC_CMD
+
+# Must we lock files when doing compilation?
+need_locks=$lt_need_locks
+
+# Manifest tool.
+MANIFEST_TOOL=$lt_MANIFEST_TOOL
+
+# Tool to manipulate archived DWARF debug symbol files on Mac OS X.
+DSYMUTIL=$lt_DSYMUTIL
+
+# Tool to change global to local symbols on Mac OS X.
+NMEDIT=$lt_NMEDIT
+
+# Tool to manipulate fat objects and archives on Mac OS X.
+LIPO=$lt_LIPO
+
+# ldd/readelf like tool for Mach-O binaries on Mac OS X.
+OTOOL=$lt_OTOOL
+
+# ldd/readelf like tool for 64 bit Mach-O binaries on Mac OS X 10.4.
+OTOOL64=$lt_OTOOL64
+
+# Old archive suffix (normally "a").
+libext=$libext
+
+# Shared library suffix (normally ".so").
+shrext_cmds=$lt_shrext_cmds
+
+# The commands to extract the exported symbol list from a shared archive.
+extract_expsyms_cmds=$lt_extract_expsyms_cmds
+
+# Variables whose values should be saved in libtool wrapper scripts and
+# restored at link time.
+variables_saved_for_relink=$lt_variables_saved_for_relink
+
+# Do we need the "lib" prefix for modules?
+need_lib_prefix=$need_lib_prefix
+
+# Do we need a version for libraries?
+need_version=$need_version
+
+# Library versioning type.
+version_type=$version_type
+
+# Shared library runtime path variable.
+runpath_var=$runpath_var
+
+# Shared library path variable.
+shlibpath_var=$shlibpath_var
+
+# Is shlibpath searched before the hard-coded library search path?
+shlibpath_overrides_runpath=$shlibpath_overrides_runpath
+
+# Format of library name prefix.
+libname_spec=$lt_libname_spec
+
+# List of archive names.  First name is the real one, the rest are links.
+# The last name is the one that the linker finds with -lNAME
+library_names_spec=$lt_library_names_spec
+
+# The coded name of the library, if different from the real name.
+soname_spec=$lt_soname_spec
+
+# Permission mode override for installation of shared libraries.
+install_override_mode=$lt_install_override_mode
+
+# Command to use after installation of a shared archive.
+postinstall_cmds=$lt_postinstall_cmds
+
+# Command to use after uninstallation of a shared archive.
+postuninstall_cmds=$lt_postuninstall_cmds
+
+# Commands used to finish a libtool library installation in a directory.
+finish_cmds=$lt_finish_cmds
+
+# As "finish_cmds", except a single script fragment to be evaled but
+# not shown.
+finish_eval=$lt_finish_eval
+
+# Whether we should hardcode library paths into libraries.
+hardcode_into_libs=$hardcode_into_libs
+
+# Compile-time system search path for libraries.
+sys_lib_search_path_spec=$lt_sys_lib_search_path_spec
+
+# Detected run-time system search path for libraries.
+sys_lib_dlsearch_path_spec=$lt_configure_time_dlsearch_path
+
+# Explicit LT_SYS_LIBRARY_PATH set during ./configure time.
+configure_time_lt_sys_library_path=$lt_configure_time_lt_sys_library_path
+
+# Whether dlopen is supported.
+dlopen_support=$enable_dlopen
+
+# Whether dlopen of programs is supported.
+dlopen_self=$enable_dlopen_self
+
+# Whether dlopen of statically linked programs is supported.
+dlopen_self_static=$enable_dlopen_self_static
+
+# Commands to strip libraries.
+old_striplib=$lt_old_striplib
+striplib=$lt_striplib
+
+
+# The linker used to build libraries.
+LD=$lt_LD
+
+# How to create reloadable object files.
+reload_flag=$lt_reload_flag
+reload_cmds=$lt_reload_cmds
+
+# Commands used to build an old-style archive.
+old_archive_cmds=$lt_old_archive_cmds
+
+# A language specific compiler.
+CC=$lt_compiler
+
+# Is the compiler the GNU compiler?
+with_gcc=$GCC
+
+# Compiler flag to turn off builtin functions.
+no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag
+
+# Additional compiler flags for building library objects.
+pic_flag=$lt_lt_prog_compiler_pic
+
+# How to pass a linker flag through the compiler.
+wl=$lt_lt_prog_compiler_wl
+
+# Compiler flag to prevent dynamic linking.
+link_static_flag=$lt_lt_prog_compiler_static
+
+# Does compiler simultaneously support -c and -o options?
+compiler_c_o=$lt_lt_cv_prog_compiler_c_o
+
+# Whether or not to add -lc for building shared libraries.
+build_libtool_need_lc=$archive_cmds_need_lc
+
+# Whether or not to disallow shared libs when runtime libs are static.
+allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes
+
+# Compiler flag to allow reflexive dlopens.
+export_dynamic_flag_spec=$lt_export_dynamic_flag_spec
+
+# Compiler flag to generate shared objects directly from archives.
+whole_archive_flag_spec=$lt_whole_archive_flag_spec
+
+# Whether the compiler copes with passing no objects directly.
+compiler_needs_object=$lt_compiler_needs_object
+
+# Create an old-style archive from a shared archive.
+old_archive_from_new_cmds=$lt_old_archive_from_new_cmds
+
+# Create a temporary old-style archive to link instead of a shared archive.
+old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds
+
+# Commands used to build a shared archive.
+archive_cmds=$lt_archive_cmds
+archive_expsym_cmds=$lt_archive_expsym_cmds
+
+# Commands used to build a loadable module if different from building
+# a shared archive.
+module_cmds=$lt_module_cmds
+module_expsym_cmds=$lt_module_expsym_cmds
+
+# Whether we are building with GNU ld or not.
+with_gnu_ld=$lt_with_gnu_ld
+
+# Flag that allows shared libraries with undefined symbols to be built.
+allow_undefined_flag=$lt_allow_undefined_flag
+
+# Flag that enforces no undefined symbols.
+no_undefined_flag=$lt_no_undefined_flag
+
+# Flag to hardcode \$libdir into a binary during linking.
+# This must work even if \$libdir does not exist
+hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec
+
+# Whether we need a single "-rpath" flag with a separated argument.
+hardcode_libdir_separator=$lt_hardcode_libdir_separator
+
+# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes
+# DIR into the resulting binary.
+hardcode_direct=$hardcode_direct
+
+# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes
+# DIR into the resulting binary and the resulting library dependency is
+# "absolute",i.e impossible to change by setting \$shlibpath_var if the
+# library is relocated.
+hardcode_direct_absolute=$hardcode_direct_absolute
+
+# Set to "yes" if using the -LDIR flag during linking hardcodes DIR
+# into the resulting binary.
+hardcode_minus_L=$hardcode_minus_L
+
+# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR
+# into the resulting binary.
+hardcode_shlibpath_var=$hardcode_shlibpath_var
+
+# Set to "yes" if building a shared library automatically hardcodes DIR
+# into the library and all subsequent libraries and executables linked
+# against it.
+hardcode_automatic=$hardcode_automatic
+
+# Set to yes if linker adds runtime paths of dependent libraries
+# to runtime path list.
+inherit_rpath=$inherit_rpath
+
+# Whether libtool must link a program against all its dependency libraries.
+link_all_deplibs=$link_all_deplibs
+
+# Set to "yes" if exported symbols are required.
+always_export_symbols=$always_export_symbols
+
+# The commands to list exported symbols.
+export_symbols_cmds=$lt_export_symbols_cmds
+
+# Symbols that should not be listed in the preloaded symbols.
+exclude_expsyms=$lt_exclude_expsyms
+
+# Symbols that must always be exported.
+include_expsyms=$lt_include_expsyms
+
+# Commands necessary for linking programs (against libraries) with templates.
+prelink_cmds=$lt_prelink_cmds
+
+# Commands necessary for finishing linking programs.
+postlink_cmds=$lt_postlink_cmds
+
+# Specify filename containing input files.
+file_list_spec=$lt_file_list_spec
+
+# How to hardcode a shared library path into an executable.
+hardcode_action=$hardcode_action
+
+# ### END LIBTOOL CONFIG
+
+_LT_EOF
+
+    cat <<'_LT_EOF' >> "$cfgfile"
+
+# ### BEGIN FUNCTIONS SHARED WITH CONFIGURE
+
+# func_munge_path_list VARIABLE PATH
+# -----------------------------------
+# VARIABLE is name of variable containing _space_ separated list of
+# directories to be munged by the contents of PATH, which is string
+# having a format:
+# "DIR[:DIR]:"
+#       string "DIR[ DIR]" will be prepended to VARIABLE
+# ":DIR[:DIR]"
+#       string "DIR[ DIR]" will be appended to VARIABLE
+# "DIRP[:DIRP]::[DIRA:]DIRA"
+#       string "DIRP[ DIRP]" will be prepended to VARIABLE and string
+#       "DIRA[ DIRA]" will be appended to VARIABLE
+# "DIR[:DIR]"
+#       VARIABLE will be replaced by "DIR[ DIR]"
+func_munge_path_list ()
+{
+    case x$2 in
+    x)
+        ;;
+    *:)
+        eval $1=\"`$ECHO $2 | $SED 's/:/ /g'` \$$1\"
+        ;;
+    x:*)
+        eval $1=\"\$$1 `$ECHO $2 | $SED 's/:/ /g'`\"
+        ;;
+    *::*)
+        eval $1=\"\$$1\ `$ECHO $2 | $SED -e 's/.*:://' -e 's/:/ /g'`\"
+        eval $1=\"`$ECHO $2 | $SED -e 's/::.*//' -e 's/:/ /g'`\ \$$1\"
+        ;;
+    *)
+        eval $1=\"`$ECHO $2 | $SED 's/:/ /g'`\"
+        ;;
+    esac
+}
+
+
+# Calculate cc_basename.  Skip known compiler wrappers and cross-prefix.
+func_cc_basename ()
+{
+    for cc_temp in $*""; do
+      case $cc_temp in
+        compile | *[\\/]compile | ccache | *[\\/]ccache ) ;;
+        distcc | *[\\/]distcc | purify | *[\\/]purify ) ;;
+        \-*) ;;
+        *) break;;
+      esac
+    done
+    func_cc_basename_result=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"`
+}
+
+
+# ### END FUNCTIONS SHARED WITH CONFIGURE
+
+_LT_EOF
+
+  case $host_os in
+  aix3*)
+    cat <<\_LT_EOF >> "$cfgfile"
+# AIX sometimes has problems with the GCC collect2 program.  For some
+# reason, if we set the COLLECT_NAMES environment variable, the problems
+# vanish in a puff of smoke.
+if test set != "${COLLECT_NAMES+set}"; then
+  COLLECT_NAMES=
+  export COLLECT_NAMES
+fi
+_LT_EOF
+    ;;
+  esac
+
+
+ltmain=$ac_aux_dir/ltmain.sh
+
+
+  # We use sed instead of cat because bash on DJGPP gets confused if
+  # if finds mixed CR/LF and LF-only lines.  Since sed operates in
+  # text mode, it properly converts lines to CR/LF.  This bash problem
+  # is reportedly fixed, but why not run on old versions too?
+  sed '$q' "$ltmain" >> "$cfgfile" \
+     || (rm -f "$cfgfile"; exit 1)
+
+   mv -f "$cfgfile" "$ofile" ||
+    (rm -f "$ofile" && cp "$cfgfile" "$ofile" && rm -f "$cfgfile")
+  chmod +x "$ofile"
+
+ ;;
+
+  esac
+done # for ac_tag
+
+
+as_fn_exit 0
+_ACEOF
+ac_clean_files=$ac_clean_files_save
+
+test $ac_write_fail = 0 ||
+  as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5
+
+
+# configure is writing to config.log, and then calls config.status.
+# config.status does its own redirection, appending to config.log.
+# Unfortunately, on DOS this fails, as config.log is still kept open
+# by configure, so config.status won't be able to write to it; its
+# output is simply discarded.  So we exec the FD to /dev/null,
+# effectively closing config.log, so it can be properly (re)opened and
+# appended to by config.status.  When coming back to configure, we
+# need to make the FD available again.
+if test "$no_create" != yes; then
+  ac_cs_success=:
+  ac_config_status_args=
+  test "$silent" = yes &&
+    ac_config_status_args="$ac_config_status_args --quiet"
+  exec 5>/dev/null
+  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
+  exec 5>>config.log
+  # Use ||, not &&, to avoid exiting from the if with $? = 1, which
+  # would make configure fail if this is the last instruction.
+  $ac_cs_success || as_fn_exit 1
+fi
+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
+$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
+fi
+
diff --git a/configure.ac b/configure.ac
new file mode 100644
index 00000000..aa5f26f2
--- /dev/null
+++ b/configure.ac
@@ -0,0 +1,1937 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Sebastien Hinderer, projet Gallium, INRIA Paris             *
+#*                                                                        *
+#*   Copyright 2018 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.          *
+#*                                                                        *
+#**************************************************************************
+
+# Process this file with autoconf to produce a configure script.
+
+# Require Autoconf 2.69 for repeatability in CI
+AC_PREREQ([2.69])
+AC_INIT([OCaml],
+        m4_esyscmd([head -n1 VERSION | tr -d '\r\n']),
+        [caml-list@inria.fr],
+        [ocaml],
+        [http://www.ocaml.org])
+
+AC_MSG_NOTICE([Configuring OCaml version AC_PACKAGE_VERSION])
+
+# Configuration variables
+
+## Command-line arguments passed to configure
+CONFIGURE_ARGS="$*"
+
+# Command-line tools section of the Unix manual
+programs_man_section=1
+
+# Library section of the Unix manual
+libraries_man_section=3
+
+# Command to build executalbes
+mkexe="\$(CC) \$(OC_CFLAGS) \$(OC_CPPFLAGS) \$(OC_LDFLAGS)"
+
+# Flags for building executable files with debugging symbols
+mkexedebugflag="-g"
+common_cflags=""
+common_cppflags=""
+internal_cflags=""
+internal_cppflags=""
+ocamlc_cflags=""
+ocamlc_cppflags=""
+oc_ldflags=""
+with_sharedlibs=true
+ostype="Unix"
+iflexdir=""
+SO="so"
+toolchain="cc"
+profinfo=false
+profinfo_width=0
+extralibs=
+instrumented_runtime=false
+instrumented_runtime_ldlibs=""
+
+# Information about the package
+
+## Source directory
+AC_CONFIG_SRCDIR([runtime/interp.c])
+
+## Directory containing auxiliary scripts used dugring build
+AC_CONFIG_AUX_DIR([build-aux])
+
+## Output variables
+
+AC_SUBST([CONFIGURE_ARGS])
+AC_SUBST([native_compiler])
+AC_SUBST([VERSION], [AC_PACKAGE_VERSION])
+AC_SUBST([CC])
+# Note: This is present for the flexdll bootstrap where it exposed as the old
+# TOOLPREF variable. It would be better if flexdll where updated to require
+# WINDRES instead.
+AC_SUBST([DIRECT_CPP])
+AC_SUBST([ac_tool_prefix])
+AC_SUBST([exeext])
+AC_SUBST([OBJEXT])
+AC_SUBST([libext])
+AC_SUBST([S])
+AC_SUBST([SO])
+AC_SUBST([arch])
+AC_SUBST([arch64])
+AC_SUBST([model])
+AC_SUBST([system])
+AC_SUBST([systhread_support])
+AC_SUBST([unix_or_win32])
+AC_SUBST([unixlib])
+AC_SUBST([outputexe])
+AC_SUBST([outputobj])
+AC_SUBST([syslib])
+AC_SUBST([extralibs])
+AC_SUBST([programs_man_section])
+AC_SUBST([libraries_man_section])
+AC_SUBST([fpic])
+AC_SUBST([mkexe])
+AC_SUBST([mkexedebugflag])
+AC_SUBST([ccomptype])
+AC_SUBST([toolchain])
+AC_SUBST([oc_cflags])
+AC_SUBST([oc_cppflags])
+AC_SUBST([oc_ldflags])
+AC_SUBST([bytecclibs])
+AC_SUBST([nativecclibs])
+AC_SUBST([ocamlc_cflags])
+AC_SUBST([ocamlc_cppflags])
+AC_SUBST([iflexdir])
+AC_SUBST([long_shebang])
+AC_SUBST([shebangscripts])
+AC_SUBST([AR])
+AC_SUBST([RANLIB])
+AC_SUBST([RANLIBCMD])
+AC_SUBST([mklib])
+AC_SUBST([supports_shared_libraries])
+AC_SUBST([natdynlink])
+AC_SUBST([natdynlinkopts])
+AC_SUBST([cmxs])
+AC_SUBST([debug_runtime])
+AC_SUBST([instrumented_runtime])
+AC_SUBST([has_monotonic_clock])
+AC_SUBST([otherlibraries])
+AC_SUBST([cc_has_debug_prefix_map])
+AC_SUBST([as_has_debug_prefix_map])
+AC_SUBST([with_debugger]) # TODO: rename this variable
+AC_SUBST([with_camltex])
+AC_SUBST([ocamldoc])
+AC_SUBST([ocamltest])
+AC_SUBST([pthread_link])
+AC_SUBST([x_includes])
+AC_SUBST([x_libraries])
+AC_SUBST([bfd_cppflags])
+AC_SUBST([bfd_ldflags])
+AC_SUBST([bfd_ldlibs])
+AC_SUBST([ASPP])
+AC_SUBST([endianness])
+AC_SUBST([AS])
+AC_SUBST([asm_cfi_supported])
+AC_SUBST([sharedlib_cflags])
+AC_SUBST([rpath])
+AC_SUBST([mksharedlib])
+AC_SUBST([mkmaindll])
+AC_SUBST([mksharedlibrpath])
+AC_SUBST([install_bytecode_programs])
+AC_SUBST([install_source_artifacts])
+AC_SUBST([profinfo])
+AC_SUBST([profinfo_width])
+AC_SUBST([frame_pointers])
+AC_SUBST([spacetime])
+AC_SUBST([call_counts])
+AC_SUBST([libunwind_available])
+AC_SUBST([libunwind_include_flags])
+AC_SUBST([libunwind_link_flags])
+AC_SUBST([flambda])
+AC_SUBST([flambda_invariants])
+AC_SUBST([max_testsuite_dir_retries])
+AC_SUBST([windows_unicode])
+AC_SUBST([flat_float_array])
+AC_SUBST([function_sections])
+AC_SUBST([afl])
+AC_SUBST([force_safe_string])
+AC_SUBST([default_safe_string])
+AC_SUBST([flexdll_chain])
+AC_SUBST([flexlink_flags])
+AC_SUBST([PACKLD])
+AC_SUBST([stdlib_manpages])
+
+## Generated files
+
+AC_CONFIG_FILES([Makefile.common])
+AC_CONFIG_FILES([Makefile.config])
+AC_CONFIG_FILES([tools/eventlog_metadata])
+AC_CONFIG_HEADERS([runtime/caml/m.h])
+AC_CONFIG_HEADERS([runtime/caml/s.h])
+
+# Checks for system types
+
+AC_CANONICAL_BUILD
+AC_CANONICAL_HOST
+AC_CANONICAL_TARGET
+
+AS_CASE([$host],
+  [*-pc-windows],
+    [CC=cl
+    ccomptype=msvc
+    S=asm
+    SO=dll
+    outputexe=-Fe
+    syslib='$(1).lib'],
+  [ccomptype=cc
+  S=s
+  SO=so
+  outputexe='-o $(EMPTY)'
+  syslib='-l$(1)'])
+
+# Environment variables that are taken into account
+
+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])
+
+# Command-line arguments to configure
+
+AC_ARG_ENABLE([debug-runtime],
+  [AS_HELP_STRING([--disable-debug-runtime],
+    [do not build runtime with debugging support])])
+
+AC_ARG_ENABLE([debugger],
+  [AS_HELP_STRING([--enable-debugger],
+    [build the debugger @<:@default=auto@:>@])],
+  [],
+  [enable_debugger=auto])
+
+AC_ARG_VAR([DLLIBS],
+  [which libraries to use (in addition to -ldl) to load dynamic libs])
+
+AC_ARG_ENABLE([instrumented-runtime],
+  [AS_HELP_STRING([--enable-instrumented-runtime],
+    [build the instrumented runtime @<:@default=auto@:>@])],
+  [],
+  [enable_instrumented_runtime=auto])
+
+AC_ARG_ENABLE([vmthreads], [],
+  [AC_MSG_ERROR([The vmthreads library is no longer available. \
+It was deleted in OCaml 4.09.])],
+  [])
+
+AC_ARG_ENABLE([systhreads],
+  [AS_HELP_STRING([--disable-systhreads],
+    [disable the Win32/POSIX threads library])])
+
+AC_ARG_WITH([libunwind],
+  [AS_HELP_STRING([--without-libunwind],
+    [disable libunwind support for Spacetime profiling])])
+
+AC_ARG_VAR([LIBUNWIND_INCLUDE_DIR],
+  [location of header files for libunwind])
+
+AC_ARG_VAR([LIBUNWIND_LIB_DIR],
+  [location of library files for libunwind])
+
+AC_ARG_WITH([bfd],
+  [AS_HELP_STRING([--without-bfd],
+    [disable BFD (Binary File Description) library support])],
+    [],
+    [with_bfd=auto])
+
+AC_ARG_VAR([BFD_INCLUDE_DIR],
+  [location of header files for the BFD library])
+
+AC_ARG_VAR([BFD_LIB_DIR],
+  [location of library files for the BFD library])
+
+AC_ARG_ENABLE([graph-lib], [],
+  [AC_MSG_ERROR([The graphics library is no longer distributed with OCaml \
+since version 4.09. It is now distributed as a separate "graphics" package: \
+https://github.com/ocaml/graphics])],
+  [])
+
+AC_ARG_ENABLE([str-lib],
+  [AS_HELP_STRING([--disable-str-lib],
+    [do not build the str library])])
+
+AC_ARG_ENABLE([unix-lib],
+  [AS_HELP_STRING([--disable-unix-lib],
+    [do not build the unix library])])
+
+AC_ARG_ENABLE([bigarray-lib],
+  [AS_HELP_STRING([--disable-bigarray-lib],
+    [do not build the legacy separate bigarray library])])
+
+AC_ARG_ENABLE([ocamldoc],
+  [AS_HELP_STRING([--disable-ocamldoc],
+    [do not build the ocamldoc documentation system])],
+  [],
+  [ocamldoc=auto])
+
+AC_ARG_ENABLE([ocamltest],
+  [AS_HELP_STRING([--disable-ocamltest],
+    [do not build the ocamltest driver])])
+
+AC_ARG_ENABLE([frame-pointers],
+  [AS_HELP_STRING([--enable-frame-pointers],
+    [use frame pointers in runtime and generated code])])
+
+AC_ARG_ENABLE([naked-pointers],
+  [AS_HELP_STRING([--disable-naked-pointers],
+    [do not allow naked pointers])])
+
+AC_ARG_ENABLE([spacetime],
+  [AS_HELP_STRING([--enable-spacetime],
+    [build the spacetime profiler])])
+
+AC_ARG_ENABLE([call-counts],
+  [AS_HELP_STRING([--disable-call-counts],
+    [disable the call counts in spacetime])])
+
+AC_ARG_ENABLE([cfi],
+  [AS_HELP_STRING([--disable-cfi],
+    [disable the CFI directives in assembly files])])
+
+AC_ARG_ENABLE([installing-source-artifacts],
+  [AS_HELP_STRING([--enable-installing-source-artifacts],
+    [install *.cmt* and *.mli files])])
+AC_ARG_ENABLE([installing-bytecode-programs],
+  [AS_HELP_STRING([--enable-installing-bytecode-programs],
+    [also install the bytecode versions of programs])])
+
+AC_ARG_ENABLE([native-compiler],
+  [AS_HELP_STRING([--disable-native-compiler],
+    [do not build the native compiler])])
+
+AC_ARG_ENABLE([flambda],
+  [AS_HELP_STRING([--enable-flambda],
+    [enable flambda optimizations])])
+
+AC_ARG_ENABLE([flambda-invariants],
+  [AS_HELP_STRING([--enable-flambda-invariants],
+    [enable invariants checks in flambda])])
+
+AC_ARG_WITH([target-bindir],
+  [AS_HELP_STRING([--with-target-bindir],
+    [location of binary programs on target system])])
+
+AC_ARG_ENABLE([reserved-header-bits],
+  [AS_HELP_STRING([--enable-reserved-header-bits=BITS],
+  [reserve BITS (between 0 and 31) bits in block headers for profiling info])],
+  [AS_CASE([$enable_reserved_header_bits],
+    [0],
+      [with_profinfo=false
+      profinfo_width=0],
+    [[[1-9]]|1[[0-9]]|2[[0-1]]],
+      [with_profinfo=true
+      profinfo_width="$enable_reserved_header_bits"],
+    [AC_MSG_ERROR([invalid argument to --enable-reserved-header-bits])])])
+
+AC_ARG_ENABLE([stdlib-manpages],
+  [AS_HELP_STRING([--disable-stdlib-manpages],
+    [do not build or install the library man pages])])
+
+AC_ARG_VAR([WINDOWS_UNICODE_MODE],
+  [how to handle Unicode under Windows: ansi, compatible])
+
+# There are two configure-time string safety options,
+# --(enable|disable)-force-safe-string and
+# DEFAULT_STRING=safe|unsafe that
+# interact with a compile-time (un)safe-string option.
+#
+# If --enable-force-safe-string is set at configure time, then the compiler
+# will always enforce that string and bytes are distinct: the
+# compile-time -unsafe-string option is disabled. This lets us
+# assume pervasive string immutability, for code optimizations and
+# in the C layer.
+#
+# If --disable-force-safe-string is set at configure-time, the compiler
+# will use the compile-time (un)safe-string option to decide whether
+# string and bytes are compatible on a per-file basis. The
+# configuration variable DEFAULT_STRING=safe|unsafe decides which
+# setting will be chosen by default, if no compile-time option is
+# explicitly passed.
+#
+# The configure-time behavior of OCaml 4.05 and older was equivalent
+# to --disable-force-safe-string DEFAULT_STRING=unsafe. With OCaml 4.06
+# and older was equivalent to --disable-force-safe-string DEFAULT_STRING=safe.
+# With OCaml 4.10 and later use --enable-force-safe-string DEFAULT_STRING=safe.
+# We expect the --disable-force-safe-string and DEFAULT_STRING=unsafe options
+# to be removed in the future.
+
+AC_ARG_ENABLE([force-safe-string],
+  [AS_HELP_STRING([--disable-force-safe-string],
+    [do not force strings to be safe])])
+
+AC_ARG_VAR([DEFAULT_STRING],
+  [whether strings should be safe (default) or unsafe])
+
+AC_ARG_ENABLE([flat-float-array],
+  [AS_HELP_STRING([--disable-flat-float-array],
+    [do not use flat float arrays])])
+
+AC_ARG_ENABLE([function-sections],
+  [AS_HELP_STRING([--disable-function-sections],
+    [do not emit each function in a separate section])],
+  [],
+  [enable_function_sections=auto])
+
+AC_ARG_WITH([afl],
+  [AS_HELP_STRING([--with-afl],
+    [use the AFL fuzzer])])
+
+AS_IF([test x"$enable_unix_lib" = "xno"],
+  [AS_IF([test x"$enable_debugger" = "xyes"],
+    [AC_MSG_ERROR([replay debugger requires the unix library])],
+    [enable_debugger="no"])
+   AS_IF([test x"$enable_bigarray_lib" = "xyes"],
+    [AC_MSG_ERROR([legacy bigarray library requires the unix library])])])
+
+AS_IF([test x"$enable_unix_lib" = "xno" -o x"$enable_str_lib" = "xno"],
+  [AS_IF([test x"$enable_ocamldoc" = "xyes"],
+    [AC_MSG_ERROR([ocamldoc requires the unix and str libraries])],
+    [enable_ocamldoc="no"
+     with_camltex=""])],
+  [with_camltex="true"])
+
+# Initialization of libtool
+# Allow the MSVC linker to be found even if ld isn't installed.
+# User-specified LD still takes precedence.
+AC_CHECK_TOOLS([LD],[ld link])
+# libtool expects host_os=mingw for native Windows
+old_host_os=$host_os
+AS_IF([test x"$host_os" = "xwindows"],[host_os=mingw])
+LT_INIT
+host_os=$old_host_os
+
+# Extracting information from libtool's configuration
+AS_IF([test -n "$RANLIB" ],
+  [RANLIBCMD="$RANLIB"],
+  [RANLIB="$AR rs"; RANLIBCMD=""]
+)
+
+AS_CASE([$host],
+  # In config/Makefile.mingw*, we had:
+  # TARGET=i686-w64-mingw32 and x86_64-w64-mingw32
+  # TOOLPREF=$(TARGET)-
+  # ARCMD=$(TOOLPREF)ar
+  # RANLIB=$(TOOLPREF)ranlib
+  # RANLIBCMD=$(TOOLPREF)ranlib
+  # However autoconf and libtool seem to use ar and ranlib
+  # So we let them do, at the moment
+  [*-pc-windows],
+    [
+      libext=lib
+      AR=""; RANLIB=echo; RANLIBCMD=""
+      AS_IF([test "$host_cpu" = "x86_64" ],
+        [machine="-machine:AMD64 "],
+        [machine=""])
+      mklib="link -lib -nologo $machine /out:\$(1) \$(2)"
+    ],
+  [
+    mklib="rm -f \$(1) && ${AR} rc \$(1) \$(2) && ${RANLIB} \$(1)"
+  ])
+
+## Find vendor of the C compiler
+OCAML_CC_VENDOR
+
+# Determine how to call the C preprocessor directly.
+# Most of the time, calling the C preprocessor through the C compiler is
+# desirable and even important.
+# In some cases, though, we want to use the C preprocessor only to
+# expand macros. In such cases, it is much more convenient to be able
+# to invoke it directly rather than through the C compiler, for instance
+# because, when invoked directly, the C preprocessor does not require
+# to be invoked on a file with a '.c' extension
+# We thus figure out how to invoke the C preprocessor directly but
+# let the CPP variable untouched, except for the MSVC port where we set it
+# manually to make sure the backward compatibility is preserved
+AS_CASE([$ocaml_cv_cc_vendor],
+  [xlc-*],
+    [CPP="$CC -E -qnoppline"], # suppress incompatible XLC line directives
+  [msvc-*],
+    [CPP="$CC -nologo -EP"])
+
+# Libraries to build depending on the host
+
+AS_CASE([$host],
+  [*-*-mingw32|*-pc-windows],
+    [unix_or_win32="win32"
+    unixlib="win32unix"
+    ],
+  [unix_or_win32="unix"
+  unixlib="unix"])
+AS_CASE([$host],
+  [*-*-cygwin*|*-*-mingw32|*-pc-windows],
+    [exeext=".exe"],
+  [exeext=''])
+
+otherlibraries="dynlink"
+AS_IF([test x"$enable_unix_lib" != "xno"],
+  [AS_IF([test x"$enable_bigarray_lib" != "xno"],
+    [otherlibraries="$otherlibraries $unixlib bigarray"],
+    [otherlibraries="$otherlibraries $unixlib"])])
+AS_IF([test x"$enable_str_lib" != "xno"],
+  [otherlibraries="$otherlibraries str"])
+
+# Checks for system services
+
+## Test whether #! scripts are supported
+## TODO: have two values, one for host and one for target
+AC_SYS_INTERPRETER
+
+long_shebang=false
+AS_IF(
+  [test "x$interpval" = "xyes"],
+    [AS_CASE([$host],
+      [*-cygwin|*-*-mingw32|*-pc-windows],
+        [shebangscripts=false],
+      [shebangscripts=true
+       prev_exec_prefix="$exec_prefix"
+       AS_IF([test "x$exec_prefix" = "xNONE"],[exec_prefix="$prefix"])
+       eval "expanded_bindir=\"$bindir\""
+       exec_prefix="$prev_exec_prefix"
+       # Assume maximum shebang is 128 chars; less #!, /ocamlrun, an optional
+       # 1 char suffix and the \0 leaving 115 characters
+       AS_IF([test "${#expanded_bindir}" -gt 115],[long_shebang=true])
+      ]
+    )],
+  [shebangscripts=false]
+)
+
+# Are we building a cross-compiler
+
+AS_IF(
+  [test x"$host" = x"$target"],
+    [cross_compiler=false],
+    [cross_compiler=true])
+
+# Checks for programs
+
+## Check for the C compiler: done by libtool
+## AC_PROG_CC
+
+## Check for C99 support: done by libtool
+## AC_PROG_CC_C99
+
+## Determine which flags to use for the C compiler
+
+AS_CASE([$ocaml_cv_cc_vendor],
+  [xlc-*],
+    [outputobj='-o $(EMPTY)'; gcc_warnings="-qflag=i:i"], # all warnings enabled
+  [msvc-*],
+    [outputobj=-Fo; gcc_warnings=""],
+  [outputobj='-o $(EMPTY)'
+  gcc_warnings='-Wall -Wdeclaration-after-statement'
+  AS_CASE([AC_PACKAGE_VERSION],
+    [*+dev*],
+      [gcc_warnings="$gcc_warnings -Werror"])
+  ])
+
+# 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
+#   (the OCaml runtime assumes Java-style behavior of signed integer arith.)
+# Concerning optimization level, -O3 is somewhat risky, so take -O2.
+# Concerning language version, gnu99 is ISO C99 plus GNU extensions
+# that are often used in standard headers.  Older GCC versions
+# defaults to gnu89, which is not C99.  Clang defaults to gnu99 or
+# gnu11, which is fine.
+
+# Note: the vendor macro can not recognize MinGW because it calls the
+# C preprocessor directly so no compiler specific macro like __MING32__
+# is defined. We thus catch MinGW first by looking at host and examine
+# the vendor only as a fall-back. We could put tis part of the logic
+# in the macro itself, too
+AS_CASE([$host],
+  [*-*-mingw32],
+    [AS_CASE([$ocaml_cv_cc_vendor],
+      [gcc-[[01234]]-*],
+        [AC_MSG_ERROR(m4_normalize([This version of Mingw GCC is too old.
+          Please use GCC version 5 or above.]))],
+      [gcc-*],
+        [internal_cflags="-Wno-unused $gcc_warnings \
+-fexcess-precision=standard"
+        # TODO: see whether the code can be fixed to avoid -Wno-unused
+        common_cflags="-O2 -fno-strict-aliasing -fwrapv -mms-bitfields"
+        internal_cppflags='-DUNICODE -D_UNICODE'
+        internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
+        internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)"],
+      [AC_MSG_ERROR([Unsupported C compiler for a Mingw build])])],
+  [AS_CASE([$ocaml_cv_cc_vendor],
+    [clang-*],
+      [common_cflags="-O2 -fno-strict-aliasing -fwrapv";
+      internal_cflags="$gcc_warnings -fno-common"],
+    [gcc-[[012]]-*],
+      # Some versions known to miscompile OCaml, e,g, 2.7.2.1, some 2.96.
+      # Plus: C99 support unknown.
+      [AC_MSG_ERROR(m4_normalize([This version of GCC is too old.
+        Please use GCC version 4.2 or above.]))],
+    [gcc-3-*|gcc-4-[[01]]],
+      # No -fwrapv option before GCC 3.4.
+      # Known problems with -fwrapv fixed in 4.2 only.
+      [AC_MSG_WARN(m4_normalize([This version of GCC is rather old.
+        Reducing optimization level."]));
+      AC_MSG_WARN([Consider using GCC version 4.2 or above.]);
+      common_cflags="-std=gnu99 -O";
+      internal_cflags="$gcc_warnings"],
+    [gcc-4-[[234]]],
+      # No -fexcess-precision option before GCC 4.5
+      [common_cflags="-std=gnu99 -O2 -fno-strict-aliasing -fwrapv \
+-fno-builtin-memcmp";
+      internal_cflags="$gcc_warnings"],
+    [gcc-4-*],
+      [common_cflags="-std=gnu99 -O2 -fno-strict-aliasing -fwrapv \
+-fno-builtin-memcmp";
+      internal_cflags="$gcc_warnings -fexcess-precision=standard"],
+    [gcc-*],
+      [common_cflags="-O2 -fno-strict-aliasing -fwrapv";
+      internal_cflags="$gcc_warnings -fno-common \
+-fexcess-precision=standard"],
+    [msvc-*],
+      [common_cflags="-nologo -O2 -Gy- -MD"
+      common_cppflags="-D_CRT_SECURE_NO_DEPRECATE"
+      internal_cppflags='-DUNICODE -D_UNICODE'
+      internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
+      internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)"],
+    [xlc-*],
+      [common_cflags="-O5 -qtune=balanced -qnoipa -qinline $CFLAGS";
+      internal_cflags="$gcc_warnings"],
+    [common_cflags="-O"])])
+
+internal_cppflags="-DCAML_NAME_SPACE $internal_cppflags"
+
+# Enable SSE2 on x86 mingw to avoid using 80-bit registers.
+AS_CASE([$host],
+  [i686-*-mingw32],
+    [internal_cflags="$internal_cflags -mfpmath=sse -msse2"])
+
+# Use 64-bit file offset if possible
+# See also AC_SYS_LARGEFILE
+# Problem: flags are added to CC rather than CPPFLAGS
+AS_CASE([$host],
+  [*-*-mingw32|*-pc-windows], [],
+  [common_cppflags="$common_cppflags -D_FILE_OFFSET_BITS=64"])
+
+# Adjust according to target
+
+# On Windows we do not take $enable_shared because it does not seem
+# to work. This should be better understood later
+#AS_CASE([$target],
+#  [*-pc-windows],
+#    [enable_shared=yes])
+
+AS_IF([test x"$enable_shared" = "xno"],[with_sharedlibs=false])
+
+AS_CASE([$CC,$host],
+  [*,*-*-darwin*],
+    [mkexe="$mkexe -Wl,-no_compact_unwind";
+    AC_DEFINE([HAS_ARCH_CODE32], [1])],
+  [*,*-*-haiku*], [mathlib=""],
+  [*,*-*-cygwin*],
+    [AS_CASE([$target],
+      [i686-*], [flavor=cygwin],
+      [x86_64-*], [flavor=cygwin64],
+      [AC_MSG_ERROR([unknown cygwin variant])])
+    common_cppflags="$common_cppflags -U_WIN32"
+    AS_IF([$with_sharedlibs],
+      [flexlink="flexlink -chain $flavor -merge-manifest -stack 16777216"
+      flexdir=`$flexlink -where | tr -d '\015'`
+      AS_IF([test -z "$flexdir"],
+        [AC_MSG_WARN(
+          [flexlink not found: native shared libraries won't be available.]
+        )
+        with_sharedlibs=false],
+        [iflexdir="-I\"$flexdir\""
+        mkexe="$flexlink -exe"
+        mkexedebugflag="-link -g"]
+      )]
+    )
+    AS_IF([! $with_sharedlibs],
+      [mkexe="$mkexe -Wl,--stack,16777216"
+      oc_ldflags="-Wl,--stack,16777216"]
+    )
+    ostype="Cygwin"],
+  [*,*-*-mingw32],
+    [AS_IF([$with_sharedlibs],
+      [AS_CASE([$host],
+        [i686-*-*], [flexdll_chain="mingw"],
+        [x86_64-*-*], [flexdll_chain="mingw64"])
+      flexlink="flexlink -chain $flexdll_chain -merge-manifest -stack 16777216"
+      flexdir=`$flexlink -where | tr -d '\015'`
+      AS_IF([test -z "$flexdir"], [flexdir='$(ROOTDIR)/flexdll'])
+      iflexdir="-I\"$flexdir\""
+      mkexedebugflag="-link -g"])
+    ostype="Win32"
+    toolchain="mingw"
+    mkexe='$(MKEXE_ANSI) $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
+    oc_ldflags='-municode'
+    SO="dll"],
+  [*,*-pc-windows],
+    [toolchain=msvc
+    ostype="Win32"
+    mkexe='$(MKEXE_ANSI) $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
+    oc_ldflags='/ENTRY:wmainCRTStartup'
+    AS_CASE([$host],
+      [i686-pc-windows], [flexdll_chain=msvc],
+      [x86_64-pc-windows], [flexdll_chain=msvc64])
+    AS_IF([$with_sharedlibs],
+      [flexlink="flexlink -chain $flexdll_chain -merge-manifest -stack 16777216"
+      flexdir=`$flexlink -where | tr -d '\015'`
+      AS_IF([test -z "$flexdir"], [flexdir='$(ROOTDIR)/flexdll'])
+      iflexdir="-I\"$flexdir\""
+      mkexedebugflag=''])],
+  [*,x86_64-*-linux*],
+    AC_DEFINE([HAS_ARCH_CODE32], [1]),
+  [xlc*,powerpc-ibm-aix*],
+    [mkexe="$mkexe "
+     oc_ldflags="-brtl -bexpfull"
+    AC_DEFINE([HAS_ARCH_CODE32], [1])],
+)
+
+
+## Program to use to install files
+AC_PROG_INSTALL
+
+# Checks for libraries
+
+## Mathematical library
+AC_CHECK_LIB([m],[cos])
+
+AS_IF([test "x$ac_cv_lib_m_cos" = xyes ], [mathlib="-lm"], [mathlib=""])
+
+# Checks for header files
+
+AC_CHECK_HEADER([math.h])
+AC_CHECK_HEADERS([unistd.h],[AC_DEFINE([HAS_UNISTD])])
+AC_CHECK_HEADER([stdint.h],[AC_DEFINE([HAS_STDINT_H])])
+AC_CHECK_HEADER([sys/shm.h],[AC_DEFINE([HAS_SYS_SHM_H])])
+AC_CHECK_HEADER([dirent.h], [AC_DEFINE([HAS_DIRENT])], [],
+  [#include ])
+
+AC_CHECK_HEADER([sys/select.h], [AC_DEFINE([HAS_SYS_SELECT_H])], [],
+  [#include ])
+
+# Checks for types
+
+## off_t
+AC_TYPE_OFF_T
+
+# Checks for structures
+
+# Checks for compiler characteristics
+
+AC_CHECK_SIZEOF(int)
+AC_CHECK_SIZEOF(long)
+AC_CHECK_SIZEOF(long *)
+AC_CHECK_SIZEOF(short)
+AC_CHECK_SIZEOF(long long)
+
+AS_IF(
+  [test "x$ac_cv_sizeof_long_p" = "x4" ],
+    [bits=32; arch64=false],
+  [test "x$ac_cv_sizeof_long_p" = "x8" ],
+    [bits=64; arch64=true
+    AC_DEFINE([ARCH_SIXTYFOUR], [1])],
+  [AC_MSG_ERROR([Neither 32 nor 64 bits architecture.])]
+)
+
+AS_IF([test "x$ac_cv_sizeof_int" != "x4" && test "x$ac_cv_sizeof_long" != "x4" \
+       && test "x$ac_cv_sizeof_short" != "x4"],
+  [AC_MSG_ERROR([Sorry, we can't find a 32-bit integer type.])]
+)
+
+AS_IF(
+  [test "x$ac_cv_sizeof_long" != "x8" &&
+   test "x$ac_cv_sizeof_long_long" != "x8"],
+  [AC_MSG_ERROR([Sorry, we can't find a 64-bit integer type.])]
+)
+
+AC_DEFINE_UNQUOTED([SIZEOF_PTR], [$ac_cv_sizeof_long_p])
+AC_DEFINE_UNQUOTED([SIZEOF_LONGLONG], [$ac_cv_sizeof_long_long])
+
+AC_MSG_NOTICE([Target is a $bits bits architecture])
+
+AC_C_BIGENDIAN(
+  [
+    AC_DEFINE([ARCH_BIG_ENDIAN], [1]),
+    [endianness="be"]
+  ],
+  [endianness="le"],
+  [AC_MSG_ERROR([could not determine endianness.])],
+  [AC_MSG_ERROR([unable to handle universal endianness])]
+)
+
+AC_CHECK_ALIGNOF([double])
+AC_CHECK_ALIGNOF([long])
+AC_CHECK_ALIGNOF([long long])
+
+AS_IF([! $arch64],
+  [AS_CASE([$target_cpu],
+    [i686], [],
+    [AS_IF([test "$ac_cv_alignof_double" -gt 4],
+      [AC_DEFINE([ARCH_ALIGN_DOUBLE], [1])])
+     AS_IF([test "x$ac_cv_sizeof_long" = "x8" &&
+            test "$ac_cv_alignof_long" -gt 4],
+      [AC_DEFINE([ARCH_ALIGN_INT64], [1])],
+      [AS_IF([test "x$ac_cv_sizeof_long_long" = "x8" &&
+              test "$ac_cv_alignof_long_long" -gt 4],
+      [AC_DEFINE([ARCH_ALIGN_INT64], [1])])])
+    ])])
+
+# Shared library support
+
+shared_libraries_supported=false
+sharedlib_cflags=''
+mksharedlib='shared-libs-not-available'
+rpath=''
+mksharedlibrpath=''
+natdynlinkopts=""
+
+AS_IF([test x"$enable_shared" != "xno"],
+  [AS_CASE([$host],
+    [*-apple-darwin*],
+      [mksharedlib="$CC -shared -flat_namespace -undefined suppress \
+                   -Wl,-no_compact_unwind"
+      shared_libraries_supported=true],
+    [*-*-mingw32],
+      [mksharedlib='$(FLEXLINK)'
+      mkmaindll='$(FLEXLINK) -maindll'
+      shared_libraries_supported=$with_sharedlibs],
+    [*-pc-windows],
+      [mksharedlib='$(FLEXLINK)'
+      mkmaindll='$(FLEXLINK) -maindll'
+      shared_libraries_supported=$with_sharedlibs],
+    [*-*-cygwin*],
+      [mksharedlib="$flexlink"
+      mkmaindll="$flexlink -maindll"
+      shared_libraries_supported=true],
+    [powerpc-ibm-aix*],
+      [AS_CASE([$CC],
+               [xlc*],
+               [mksharedlib="$CC -qmkshrobj -G"
+                shared_libraries_supported=true])],
+    [[*-*-linux*|*-*-freebsd[3-9]*|*-*-freebsd[1-9][0-9]*\
+    |*-*-openbsd*|*-*-netbsd*|*-*-dragonfly*|*-*-gnu*|*-*-haiku*]],
+      [sharedlib_cflags="-fPIC"
+      mksharedlib="$CC -shared"
+      oc_ldflags="$oc_ldflags -Wl,-E"
+      rpath="-Wl,-rpath,"
+      mksharedlibrpath="-Wl,-rpath,"
+      natdynlinkopts="-Wl,-E"
+      shared_libraries_supported=true])])
+
+AS_IF([test -z "$mkmaindll"], [mkmaindll=$mksharedlib])
+
+# Configure native dynlink
+
+natdynlink=false
+
+AS_IF([test x"$enable_shared" != "xno"],
+  [AS_CASE(["$host"],
+    [*-*-cygwin*], [natdynlink=true],
+    [*-*-mingw32], [natdynlink=true],
+    [*-pc-windows], [natdynlink=true],
+    [[i[3456]86-*-linux*]], [natdynlink=true],
+    [[i[3456]86-*-gnu*]], [natdynlink=true],
+    [[x86_64-*-linux*]], [natdynlink=true],
+    [x86_64-*-darwin*], [natdynlink=true],
+    [s390x*-*-linux*], [natdynlink=true],
+    [powerpc*-*-linux*], [natdynlink=true],
+    [i686-*-kfreebsd*], [natdynlink=true],
+    [x86_64-*-kfreebsd*], [natdynlink=true],
+    [x86_64-*-dragonfly*], [natdynlink=true],
+    [[i[3456]86-*-freebsd*]], [natdynlink=true],
+    [x86_64-*-freebsd*], [natdynlink=true],
+    [[i[3456]86-*-openbsd*]], [natdynlink=true],
+    [x86_64-*-openbsd*], [natdynlink=true],
+    [[i[3456]86-*-netbsd*]], [natdynlink=true],
+    [x86_64-*-netbsd*], [natdynlink=true],
+    [i386-*-gnu0.3], [natdynlink=true],
+    [[i[3456]86-*-haiku*]], [natdynlink=true],
+    [arm*-*-linux*], [natdynlink=true],
+    [arm*-*-freebsd*], [natdynlink=true],
+    [earm*-*-netbsd*], [natdynlink=true],
+    [aarch64-*-linux*], [natdynlink=true],
+    [aarch64-*-freebsd*], [natdynlink=true],
+    [riscv*-*-linux*], [natdynlink=true])])
+
+# Try to work around the Skylake/Kaby Lake processor bug.
+AS_CASE(["$CC,$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
+
+# Configure the native-code compiler
+
+arch=none
+model=default
+system=unknown
+
+AS_CASE([$host],
+  [[i[3456]86-*-linux*]],
+    [arch=i386; system=linux_elf],
+  [[i[3456]86-*-*bsd*]],
+    [arch=i386; system=bsd_elf],
+  [[i[3456]86-*-haiku*]],
+    [arch=i386; system=beos],
+  [[i[3456]86-*-cygwin]],
+    [arch=i386; system=cygwin],
+  [[i[3456]86-*-gnu*]],
+    [arch=i386; system=gnu],
+  [[i[3456]86-*-mingw32]],
+    [arch=i386; system=mingw],
+  [i686-pc-windows],
+    [arch=i386; system=win32],
+  [x86_64-pc-windows],
+    [arch=amd64; system=win64],
+  [[powerpc64le*-*-linux*]],
+    [arch=power; model=ppc64le; system=elf],
+  [[powerpc*-*-linux*]],
+    [arch=power; AS_IF([$arch64],[model=ppc64],[model=ppc]); system=elf],
+  [[s390x*-*-linux*]],
+    [arch=s390x; model=z10; system=elf],
+  [armv6*-*-linux-gnueabihf],
+    [arch=arm; model=armv6; system=linux_eabihf],
+  [armv7*-*-linux-gnueabihf],
+    [arch=arm; model=armv7; system=linux_eabihf],
+  [armv8*-*-linux-gnueabihf],
+    [arch=arm; model=armv8; system=linux_eabihf],
+  [armv8*-*-linux-gnueabi],
+    [arch=arm; model=armv8; system=linux_eabi],
+  [armv7*-*-linux-gnueabi],
+    [arch=arm; model=armv7; system=linux_eabi],
+  [armv6t2*-*-linux-gnueabi],
+    [arch=arm; model=armv6t2; system=linux_eabi],
+  [armv6*-*-linux-gnueabi],
+    [arch=arm; model=armv6; system=linux_eabi],
+  [armv6*-*-freebsd*],
+    [arch=arm; model=armv6; system=freebsd],
+  [earmv6*-*-netbsd*],
+    [arch=arm; model=armv6; system=netbsd],
+  [earmv7*-*-netbsd*],
+    [arch=arm; model=armv7; system=netbsd],
+  [armv5te*-*-linux-gnueabi],
+    [arch=arm; model=armv5te; system=linux_eabi],
+  [armv5*-*-linux-gnueabi],
+    [arch=arm; model=armv5; system=linux_eabi],
+  [arm*-*-linux-gnueabihf],
+    [arch=arm; system=linux_eabihf],
+  [arm*-*-linux-gnueabi],
+    [arch=arm; system=linux_eabi],
+  [arm*-*-openbsd*],
+    [arch=arm; system=bsd],
+  [zaurus*-*-openbsd*],
+    [arch=arm; system=bsd],
+  [x86_64-*-linux*],
+    [arch=amd64; system=linux],
+  [x86_64-*-gnu*],
+    [arch=amd64; system=gnu],
+  [x86_64-*-dragonfly*],
+    [arch=amd64; system=dragonfly],
+  [x86_64-*-freebsd*],
+    [arch=amd64; system=freebsd],
+  [x86_64-*-netbsd*],
+    [arch=amd64; system=netbsd],
+  [x86_64-*-openbsd*],
+    [arch=amd64; system=openbsd],
+  [x86_64-*-darwin*],
+    [arch=amd64; system=macosx],
+  [x86_64-*-mingw32],
+    [arch=amd64; system=mingw64],
+  [aarch64-*-linux*],
+    [arch=arm64; system=linux],
+  [aarch64-*-freebsd*],
+    [arch=arm64; system=freebsd],
+  [x86_64-*-cygwin*],
+    [arch=amd64; system=cygwin],
+  [riscv64-*-linux*],
+    [arch=riscv; model=riscv64; system=linux]
+)
+
+AS_IF([test x"$enable_native_compiler" = "xno"],
+  [arch=none; model=default; system=unknown; native_compiler=false
+  AC_MSG_NOTICE([the native compiler is disabled])],
+  [native_compiler=true])
+
+AS_IF([! $native_compiler], [natdynlink=false])
+
+AS_IF([$natdynlink], [cmxs="cmxs"], [cmxs="cmx"])
+
+AC_DEFINE_UNQUOTED([OCAML_OS_TYPE], ["$ostype"])
+
+AC_CHECK_TOOL([DIRECT_LD],[ld])
+AS_IF([test -z "$PARTIALLD"],
+  # The string for PACKLD must be capable of being concatenated with the
+  # output filename. Don't assume that all C compilers understand GNU -ofoo
+  # form, so ensure that the definition includes a space at the end (which is
+  # achieved using the $(EMPTY) expansion trick).
+  [AS_CASE(["$arch,$CC,$system,$model"],
+    [amd64,gcc*,macosx,*], [PACKLD='ld -r -arch x86_64 -o $(EMPTY)'],
+    [amd64,gcc*,solaris,*], [PACKLD='ld -r -m elf_x86_64 -o $(EMPTY)'],
+    [power,gcc*,elf,ppc], [PACKLD='ld -r -m elf32ppclinux -o $(EMPTY)'],
+    [power,gcc*,elf,ppc64], [PACKLD='ld -r -m elf64ppc -o $(EMPTY)'],
+    [power,gcc*,elf,ppc64le], [PACKLD='ld -r -m elf64lppc -o $(EMPTY)'],
+    # For the Microsoft C compiler there must be no space at the end of the
+    # string.
+    [*,cl,*,*], [PACKLD="link -lib -nologo $machine -out:"],
+    [PACKLD="$DIRECT_LD -r -o \$(EMPTY)"])],
+  [PACKLD="$PARTIALLD -o \$(EMPTY)"])
+
+AS_IF([test $arch != "none" && $arch64 ],
+  [otherlibraries="$otherlibraries raw_spacetime_lib"])
+
+# Disable PIE at link time when ocamlopt does not produce position-independent
+# code and the system produces PIE executables by default and demands PIC
+# object files to do so.
+# This issue does not affect amd64 (x86_64) and s390x (Z systems),
+# since ocamlopt produces PIC object files by default.
+# Currently the problem is known for Alpine Linux on platforms other
+# than amd64 and s390x (issue #7562), and probably affects all Linux
+# distributions that use the musl standard library and dynamic loader.
+# Other systems have PIE by default but can cope with non-PIC object files,
+# e.g. Ubuntu >= 17.10 for i386, which uses the glibc dynamic loader.
+
+AS_CASE([$arch],
+  [amd64|s390x|none],
+    # ocamlopt generates PIC code or doesn't generate code at all
+    [],
+  [AS_CASE([$host],
+    [*-linux-musl],
+       # Alpine and other musl-based Linux distributions
+       [common_cflags="-no-pie $common_cflags"],
+    [])])
+
+# Assembler
+
+AS_IF([test -n "$host_alias"], [toolpref="${host_alias}-"], [toolpref=""])
+
+# We first compute default values for as and aspp
+# If values have been given by the user then they take precedence over
+# those just computed
+# One may want to check whether the user provided values first
+# and only compute values if none has been provided
+
+AS_CASE(["$arch,$system"],
+  [i386,win32],
+    [default_as="ml -nologo -coff -Cp -c -Fo"],
+  [amd64,win64],
+    [default_as="ml64 -nologo -Cp -c -Fo"],
+  [amd64,macosx],
+    [AS_CASE([$ocaml_cv_cc_vendor],
+      [clang-*],
+        [default_as='clang -arch x86_64 -Wno-trigraphs -c'
+        default_aspp='clang -arch x86_64 -Wno-trigraphs -c'],
+      [default_as="${toolpref}as -arch x86_64"
+      default_aspp="${toolpref}gcc -arch x86_64 -c"])],
+  [amd64,solaris],
+    [default_as="${toolpref}as --64"
+    default_aspp="${toolpref}gcc -m64 -c"],
+  [i386,solaris],
+    [default_as="${toolpref}as"
+    default_aspp="${toolpref}gcc -c"],
+  [power,elf],
+    [AS_CASE([$model],
+      [ppc64le],
+        [default_as="${toolpref}as -a64 -mpower8"
+        default_aspp="${toolpref}gcc -m64 -mcpu=powerpc64le -c"],
+      [ppc64],
+        [default_as="${toolpref}as -a64 -mppc64"
+        default_aspp="${toolpref}gcc -m64 -c"],
+      [ppc],
+        [default_as="${toolpref}as -mppc"
+        default_aspp="${toolpref}gcc -m32 -c"])],
+  [s390x,elf],
+    [default_as="${toolpref}as -m 64 -march=$model"
+    default_aspp="${toolpref}gcc -c -Wa,-march=$model"],
+  [*,freebsd],
+    [default_as="${toolpref}cc -c -Wno-trigraphs"
+    default_aspp="${toolpref}cc -c -Wno-trigraphs"],
+  [*,dragonfly],
+    [default_as="${toolpref}as"
+    default_aspp="${toolpref}cc -c"],
+  [amd64,*|arm,*|arm64,*|i386,*|riscv,*],
+    [AS_CASE([$ocaml_cv_cc_vendor],
+      [clang-*], [default_as="${toolpref}clang -c -Wno-trigraphs"
+                  default_aspp="${toolpref}clang -c -Wno-trigraphs"],
+      [default_as="${toolpref}as"
+      default_aspp="${toolpref}gcc -c"])])
+
+AS_IF([test "$with_pic"],
+  [fpic=true
+  AC_DEFINE([CAML_WITH_FPIC])
+  internal_cflags="$internal_cflags $sharedlib_cflags"
+  default_aspp="$default_aspp $sharedlib_cflags"],
+  [fpic=false])
+
+AS_IF([test -z "$AS"], [AS="$default_as"])
+
+AS_IF([test -z "$ASPP"], [ASPP="$default_aspp"])
+
+# Checks for library functions
+
+## Check the semantics of signal handlers
+OCAML_SIGNAL_HANDLERS_SEMANTICS
+
+## Check for C99 float ops
+
+# Note: this was disabled on Windows but the autoconf-generated script
+# does find the function it is looking for.
+# however the fma test does not pass so we disable the feature
+# for the moment, to be backward-compatible
+
+AS_CASE([$host],
+  [*-*-mingw32|*-pc-windows], [],
+  [has_c99_float_ops=true
+  AC_CHECK_FUNC([expm1], [], [has_c99_float_ops=false])
+  AS_IF([$has_c99_float_ops],
+    [AC_CHECK_FUNC([log1p], [], [has_c99_float_ops=false])])
+  AS_IF([$has_c99_float_ops],
+    [AC_CHECK_FUNC([hypot], [], [has_c99_float_ops=false])])
+  AS_IF([$has_c99_float_ops],
+    [AC_CHECK_FUNC([fma], [
+      AS_CASE([$target],[x86_64-*-cygwin],[],[AC_DEFINE([HAS_WORKING_FMA])])],
+      [has_c99_float_ops=false])])
+  AS_IF([$has_c99_float_ops],
+    [AC_CHECK_FUNC([copysign], [AC_DEFINE([HAS_C99_FLOAT_OPS])])])])
+
+## getrusage
+AC_CHECK_FUNC([getrusage], [AC_DEFINE([HAS_GETRUSAGE])])
+
+## times
+AC_CHECK_FUNC([times], [AC_DEFINE([HAS_TIMES])])
+
+## secure_getenv and __secure_getenv
+
+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])])])
+
+CPPFLAGS="$saved_CPPFLAGS"
+
+## issetugid
+
+AC_CHECK_FUNC([issetugid], [AC_DEFINE([HAS_ISSETUGID])])
+
+## 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],
+    [has_monotonic_clock=true],
+  [*-apple-darwin*], [
+    AC_CHECK_FUNCS([mach_timebase_info mach_absolute_time],
+      [
+        has_monotonic_clock=true
+        AC_DEFINE([HAS_MACH_ABSOLUTE_TIME])
+      ],
+      [has_monotonic_clock=false])],
+  [AC_COMPILE_IFELSE([AC_LANG_SOURCE([[
+    #include 
+    #include 
+    int main(void)
+    {
+      #if !(defined(_POSIX_TIMERS) && defined(_POSIX_MONOTONIC_CLOCK)   \
+         && _POSIX_MONOTONIC_CLOCK != (-1))
+        #error "no monotonic clock source"
+      #endif
+        return 0;
+     }
+    ]])],
+    [
+      has_monotonic_clock=true
+      AC_DEFINE([HAS_POSIX_MONOTONIC_CLOCK])
+    ],
+    [has_monotonic_clock=false])
+  ]
+)
+
+# The instrumented runtime is built by default
+# if the proper clock source is found.
+# If asked via --enable-instrumented-runtime, configuration fails if the proper
+# clock source is missing.
+AS_IF([test "x$enable_instrumented_runtime" != "xno" ],
+  [
+    AS_CASE([$host],
+    [*-*-windows],
+      [instrumented_runtime=true],
+    [*-apple-darwin*], [
+      AS_CASE([$enable_instrumented_runtime,$has_monotonic_clock],
+        [*,true],
+          [instrumented_runtime=true],
+        [yes,false], [
+          AC_MSG_ERROR([Instrumented runtime support requested \
+but no proper monotonic clock source was found.])
+        ],
+        [auto,false],
+          [instrumented_runtime=false]
+    )],
+    [AC_SEARCH_LIBS([clock_gettime], [rt],
+      [has_clock_gettime=true],
+      [has_clock_gettime=false])
+      AS_CASE(
+        [$enable_instrumented_runtime,$has_clock_gettime,$has_monotonic_clock],
+        [auto,false,*], [instrumented_runtime=false],
+        [auto,*,false], [instrumented_runtime=false],
+        [*,true,true],
+          [
+            instrumented_runtime=true
+            AS_IF([test "x$ac_cv_search_clock_gettime" = "xnone required"],
+              [instrumented_runtime_ldlibs=""],
+              [instrumented_runtime_ldlibs=$ac_cv_search_clock_gettime]
+            )
+          ],
+        [yes,false,*],
+          [
+           AC_MSG_ERROR([Instrumented runtime support requested \
+but clock_gettime is missing.])
+          ],
+        [yes,*,false],
+          [
+           AC_MSG_ERROR([Instrumented runtime support requested \
+but no proper monotonic clock source was found.])
+          ]
+      )]
+    )]
+)
+
+## Sockets
+
+## TODO: check whether the different libraries are really useful
+
+sockets=false
+
+AS_CASE([$host],
+  [*-*-mingw32|*-pc-windows],
+    [cclibs="$cclibs -lws2_32"
+    sockets=true],
+  [*-*-haiku],
+    [cclibs="$cclibs -lnetwork"
+    sockets=true],
+  [
+    AC_CHECK_FUNC([socket])
+    AC_CHECK_FUNC([socketpair])
+    AC_CHECK_FUNC([bind])
+    AC_CHECK_FUNC([listen])
+    AC_CHECK_FUNC([accept])
+    AC_CHECK_FUNC([connect])
+    sockets=true
+  ]
+)
+
+AS_IF([$sockets], [AC_DEFINE([HAS_SOCKETS])])
+
+## socklen_t in sys/socket.h
+
+AC_CHECK_TYPE(
+  [socklen_t],
+  [AC_DEFINE([HAS_SOCKLEN_T])], [],
+  [#include ])
+
+AC_CHECK_FUNC([inet_aton], [AC_DEFINE([HAS_INET_ATON])])
+
+## IPv6 support
+
+ipv6=true
+
+AC_CHECK_TYPE(
+  [struct sockaddr_in6], [], [ipv6=false],
+[
+#include 
+#include 
+#include 
+]
+)
+
+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])])
+
+AS_IF([$ipv6],
+  [AC_CHECK_FUNC([inet_ntop], [AC_DEFINE([HAS_IPV6])])])
+
+AC_CHECK_FUNC([rewinddir], [AC_DEFINE([HAS_REWINDDIR])])
+
+AC_CHECK_FUNC([lockf], [AC_DEFINE([HAS_LOCKF])])
+
+AC_CHECK_FUNC([mkfifo], [AC_DEFINE([HAS_MKFIFO])])
+
+AC_CHECK_FUNC([getcwd], [AC_DEFINE([HAS_GETCWD])])
+
+## 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])],
+  [AC_CHECK_HEADER([sys/types.h],
+    [AC_CHECK_HEADER([utime.h],
+      [AC_CHECK_FUNC([utime], [AC_DEFINE([HAS_UTIME])])])])])
+
+AC_CHECK_FUNC([utimes], [AC_DEFINE([HAS_UTIMES])])
+
+AC_CHECK_FUNC([fchmod],
+  [AC_CHECK_FUNC([fchown], [AC_DEFINE([HAS_FCHMOD])])])
+
+AC_CHECK_FUNC([truncate],
+  [AC_CHECK_FUNC([ftruncate], [AC_DEFINE([HAS_TRUNCATE])])])
+
+## select
+AC_CHECK_FUNC([select],
+  [AC_CHECK_TYPE([fd_set],
+    [AC_DEFINE([HAS_SELECT])
+    select=true], [select=false], [
+#include 
+#include 
+  ])])
+
+AC_CHECK_FUNC([nanosleep], [AC_DEFINE([HAS_NANOSLEEP])])
+
+AC_CHECK_FUNC([symlink],
+  [AC_CHECK_FUNC([readlink],
+    [AC_CHECK_FUNC([lstat], [AC_DEFINE([HAS_SYMLINK])])])])
+
+# wait
+AC_CHECK_FUNC(
+  [waitpid],
+  [
+    wait=true
+    AC_DEFINE([HAS_WAITPID])
+  ],
+  [wait=false])
+
+AC_CHECK_FUNC(
+  [wait4],
+  [
+    has_wait=true
+    AC_DEFINE([HAS_WAIT4])
+  ])
+
+## getgroups
+AC_CHECK_FUNC([getgroups], [AC_DEFINE([HAS_GETGROUPS])])
+
+## setgroups
+AC_CHECK_FUNC([setgroups], [AC_DEFINE([HAS_SETGROUPS])])
+
+## initgroups
+AC_CHECK_FUNC([initgroups], [AC_DEFINE([HAS_INITGROUPS])])
+
+## termios
+
+AC_CHECK_HEADER([termios.h],
+  [AC_CHECK_FUNC([tcgetattr],
+    [AC_CHECK_FUNC([tcsetattr],
+      [AC_CHECK_FUNC([tcsendbreak],
+        [AC_CHECK_FUNC([tcflush],
+          [AC_CHECK_FUNC([tcflow], [AC_DEFINE([HAS_TERMIOS])])])])])])])
+
+## setitimer
+
+AC_CHECK_FUNC([setitimer],
+  [
+    setitimer=true
+    AC_DEFINE([HAS_SETITIMER])
+  ],
+  [setitimer=false])
+
+## gethostname
+# 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])])])
+
+## uname
+
+AC_CHECK_HEADER([sys/utsname.h],
+  [AC_CHECK_FUNC([uname], [AC_DEFINE([HAS_UNAME])])])
+
+## gettimeofday
+
+AC_CHECK_FUNC([gettimeofday],
+  [
+    gettimeofday=true
+    AC_DEFINE([HAS_GETTIMEOFDAY])
+  ],
+  [gettimeofday=false])
+
+## mktime
+
+AC_CHECK_FUNC([mktime], [AC_DEFINE([HAS_MKTIME])])
+
+## setsid
+
+AS_CASE([$host],
+  [*-cygwin|*-*-mingw32|*-pc-windows], [],
+  [AC_CHECK_FUNC([setsid], [AC_DEFINE([HAS_SETSID])])])
+
+## putenv
+
+AC_CHECK_FUNC([putenv], [AC_DEFINE([HAS_PUTENV])])
+
+## setenv and unsetenv
+
+AC_CHECK_FUNC([setenv],
+  [AC_CHECK_FUNC([unsetenv], [AC_DEFINE([HAS_SETENV_UNSETENV])])])
+
+## newlocale() and 
+# 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])],
+  [AC_CHECK_HEADER([locale.h],
+    [AC_CHECK_FUNC([newlocale],
+      [AC_CHECK_FUNC([freelocale],
+        [AC_CHECK_FUNC([uselocale], [AC_DEFINE([HAS_LOCALE_H])])])])])])
+
+AC_CHECK_HEADER([xlocale.h],
+  [AC_CHECK_FUNC([newlocale],
+    [AC_CHECK_FUNC([freelocale],
+      [AC_CHECK_FUNC([uselocale], [AC_DEFINE([HAS_XLOCALE_H])])])])])
+
+## 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])])])
+
+## shared library support
+AS_IF([$shared_libraries_supported],
+  [AS_CASE([$host],
+    [*-*-mingw32|*-pc-windows],
+      [supports_shared_libraries=$shared_libraries_supported; DLLIBS=""],
+    [AC_CHECK_FUNC([dlopen],
+      [supports_shared_libraries=true DLLIBS=""],
+      [AC_CHECK_LIB([dl], [dlopen],
+        [supports_shared_libraries=true DLLIBS="-ldl $DLLIBS"],
+        [supports_shared_libraries=false])])])],
+  [supports_shared_libraries=false])
+
+AS_IF([$supports_shared_libraries],
+  [AC_MSG_NOTICE([Dynamic loading of shared libraries is supported.])
+  AC_DEFINE([SUPPORT_DYNAMIC_LINKING])],
+  [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])])])])
+
+## pwrite
+
+AC_CHECK_FUNC([pwrite], [AC_DEFINE([HAS_PWRITE])])
+
+## -fdebug-prefix-map support by the C compiler
+AS_CASE([$CC,$host],
+  [*,*-*-mingw32], [cc_has_debug_prefix_map=false],
+  [*,*-pc-windows], [cc_has_debug_prefix_map=false],
+  [xlc*,powerpc-ibm-aix*], [cc_has_debug_prefix_map=false],
+  [OCAML_CC_HAS_DEBUG_PREFIX_MAP])
+
+## Does stat support nanosecond precision
+
+AC_CHECK_MEMBER([struct stat.st_atim.tv_nsec],
+  [stat_has_ns_precision=true
+  AC_DEFINE([HAS_NANOSECOND_STAT], [1])],
+  [],
+  [
+    AC_INCLUDES_DEFAULT
+    #include 
+  ])
+
+
+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 
+    ])])
+
+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 
+    ])])
+
+AS_IF([$stat_has_ns_precision],
+  [AC_MSG_NOTICE([stat supports nanosecond precision])],
+  [AC_MSG_NOTICE([stat does not support nanosecond precision])])
+
+# Number of arguments of gethostbyname_r
+
+AX_FUNC_WHICH_GETHOSTBYNAME_R
+
+AS_CASE([$ac_cv_func_which_gethostbyname_r],
+  [six], [AC_DEFINE([HAS_GETHOSTBYNAME_R],[6])],
+  [five], [AC_DEFINE([HAS_GETHOSTBYNAME_R],[5])],
+  [three], [AC_MSG_WARN([OCaml does not support this variant])])
+
+# Number of arguments of gethostbyaddr_r
+
+AX_FUNC_WHICH_GETHOSTBYADDR_R
+
+AS_CASE([$ac_cv_func_which_gethostbyaddr_r],
+  [eight], [AC_DEFINE([HAS_GETHOSTBYADDR_R],[8])],
+  [seven], [AC_DEFINE([HAS_GETHOSTBYADDR_R],[7])])
+
+## mkstemp
+
+AC_CHECK_FUNC([mkstemp], [AC_DEFINE([HAS_MKSTEMP])])
+
+## nice
+
+AC_CHECK_FUNC([nice], [AC_DEFINE([HAS_NICE])])
+
+## dup3
+
+AC_CHECK_FUNC([dup3], [AC_DEFINE([HAS_DUP3])])
+
+## pipe2
+
+AC_CHECK_FUNC([pipe2], [AC_DEFINE([HAS_PIPE2])])
+
+## accept4
+
+AC_CHECK_FUNC([accept4], [AC_DEFINE([HAS_ACCEPT4])])
+
+## getauxval
+
+AC_CHECK_FUNC([getauxval], [AC_DEFINE([HAS_GETAUXVAL])])
+
+## execvpe
+
+AC_CHECK_FUNC([execvpe], [AC_DEFINE([HAS_EXECVPE])])
+
+## ffs or _BitScanForward
+
+AC_CHECK_FUNC([ffs], [AC_DEFINE([HAS_FFS])])
+AC_CHECK_FUNC([_BitScanForward], [AC_DEFINE([HAS_BITSCANFORWARD])])
+
+## Determine whether the debugger should/can be built
+
+AS_CASE([$enable_debugger],
+  [no],
+    [with_debugger=""
+    AC_MSG_NOTICE([replay debugger disabled])],
+  [AS_IF([$sockets],
+    [with_debugger="ocamldebugger"
+    AC_MSG_NOTICE([replay debugger supported])],
+    [with_debugger=""
+    AC_MSG_NOTICE([replay debugger not supported])])
+  ])
+
+## Should the runtime with debugging support be built
+AS_CASE([$enable_debug_runtime],
+  [no], [debug_runtime=false],
+  [debug_runtime=true])
+
+## Determine if system stack overflows can be detected
+
+AC_MSG_CHECKING([whether stack overflows can be detected])
+
+AS_CASE([$arch,$system],
+  [i386,linux_elf|amd64,linux|amd64,macosx \
+    |amd64,openbsd|i386,bsd_elf],
+    [AC_DEFINE([HAS_STACK_OVERFLOW_DETECTION])
+    AC_MSG_RESULT([yes])],
+  [AC_MSG_RESULT([no])])
+
+## Determine if the POSIX threads library is supported
+
+AS_IF([test x"$enable_systhreads" = "xno"],
+  [systhread_support=false
+  AC_MSG_NOTICE([the Win32/POSIX threads library is disabled])],
+  [AS_CASE([$host],
+    [*-*-mingw32|*-pc-windows],
+      [systhread_support=true
+      otherlibraries="$otherlibraries systhreads"
+      AC_MSG_NOTICE([the Win32 threads library is supported])],
+    [AX_PTHREAD(
+      [systhread_support=true
+      otherlibraries="$otherlibraries systhreads"
+      AS_CASE([$host],
+        [*-*-solaris*], [pthread_link="-lpthread -lposix4"],
+        [*-*-haiku*], [pthread_link=""],
+        [pthread_link="-lpthread"])
+      common_cppflags="$common_cppflags -D_REENTRANT"
+      AC_MSG_NOTICE([the POSIX threads library is supported])
+      saved_CFLAGS="$CFLAGS"
+      saved_LIBS="$LIBS"
+      CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+      LIBS="$LIBS $pthread_link"
+      AC_CHECK_FUNC([sigwait], [AC_DEFINE([HAS_SIGWAIT])])
+      LIBS="$saved_LIBS"
+      CFLAGS="$saved_CFLAGS"],
+      [AS_IF([test x"$enable_systhreads" = "xyes"],
+        [AC_MSG_ERROR([the POSIX thread library is not available])],
+        [systhread_support=false
+        AC_MSG_NOTICE([the POSIX threads library is not supported])])])])])
+
+## BFD (Binary File Description) library
+
+bfd_cppflags=""
+bfd_ldflags=""
+bfd_ldlibs=""
+
+AS_IF([test x"$with_bfd" != "xno"],
+  [bfd_available=false
+  AS_CASE([$host],
+    [x86_64-*-darwin*],
+      [AS_IF([test -z "$BFD_INCLUDE_DIR"],
+        [BFD_INCLUDE_DIR="/opt/local/include"])
+      AS_IF([test -z "$BFD_LIB_DIR"],
+        [BFD_LIB_DIR="/opt/local/lib"])],
+    [*-*-openbsd*|*-*-freebsd*],
+      [AS_IF([test -z "$BFD_INCLUDE_DIR"],
+        [BFD_INCLUDE_DIR="/usr/local/include"])
+      AS_IF([test -z "$BFD_LIB_DIR"],
+        [BFD_LIB_DIR="/usr/local/lib"])])
+  AS_IF([test -n "$BFD_INCLUDE_DIR"],
+    [bfd_cppflags="-I$BFD_INCLUDE_DIR"])
+  AS_IF([test -n "$BFD_LIB_DIR"],
+    [bfd_ldflags="-L$BFD_LIB_DIR"])
+  SAVED_CPPFLAGS="$CPPFLAGS"
+  SAVED_LDFLAGS="$LDFLAGS"
+  CPPFLAGS="$CPPFLAGS $bfd_cppflags"
+  LDFLAGS="$LDFLAGS $bfd_ldflags"
+  AC_CHECK_HEADER([bfd.h],
+    [bfd_ldlibs=""
+    AC_CHECK_LIB([bfd], [bfd_openr], [bfd_ldlibs="-lbfd"])
+    AS_IF([test -z "$bfd_ldlibs"],
+      [unset ac_cv_lib_bfd_bfd_openr
+      AC_CHECK_LIB([bfd], [bfd_openr],
+        [bfd_ldlibs="-lbfd $DLLIBS"], [], [$DLLIBS])])
+    AS_IF([test -z "$bfd_ldlibs"],
+      [unset ac_cv_lib_bfd_bfd_openr
+      AC_CHECK_LIB([bfd], [bfd_openr],
+        [bfd_ldlibs="-lbfd $DLLIBS -liberty"], [], [$DLLIBS -liberty])])
+    AS_IF([test -z "$bfd_ldlibs"],
+      [unset ac_cv_lib_bfd_bfd_openr
+      AC_CHECK_LIB([bfd], [bfd_openr],
+        [bfd_ldlibs="-lbfd $DLLIBS -liberty -lz"], [], [$DLLIBS -liberty -lz])])
+    AS_IF([test -z "$bfd_ldlibs"],
+      [unset ac_cv_lib_bfd_bfd_openr
+      AC_CHECK_LIB([bfd], [bfd_openr],
+        [bfd_ldlibs="-lbfd $DLLIBS -liberty -lz -lintl"], [],
+        [$DLLIBS -liberty -lz -lintl])])
+    AS_IF([test -n "$bfd_ldlibs"],
+      [bfd_available=true
+      AC_DEFINE([HAS_LIBBFD])])])
+  AS_IF([! $bfd_available],
+    [AS_IF([test x"$with_bfd" = "xyes"],
+      [AC_MSG_ERROR([BFD library support requested but not available])],
+      [bfd_cppflags=""
+      bfd_ldflags=""
+      AC_MSG_NOTICE(m4_normalize([
+        BFD library not found, 'ocamlobjinfo' will be unable to display
+        info on .cmxs files.
+      ]))])])
+  LDFLAGS="$SAVED_LDFLAGS"
+  CPP_FLAGS="$SAVED_CPPFLAGS"],
+  [AC_MSG_NOTICE(m4_normalize([
+    Support for the BFD (Binary File Description) library disabled,
+    'ocamlobjinfo' will be unable to display info on .cmxs files.
+    ]))])
+
+## Does the assembler support debug prefix map and CFI directives
+as_has_debug_prefix_map=false
+asm_cfi_supported=false
+AS_IF([$native_compiler],
+  [AS_CASE([$host],
+    [*-*-mingw32|*-pc-windows], [],
+    [OCAML_AS_HAS_DEBUG_PREFIX_MAP
+    OCAML_AS_HAS_CFI_DIRECTIVES])])
+
+## Frame pointers
+
+AS_IF([test x"$enable_frame_pointers" = "xyes"],
+  [AS_CASE(["$host,$CC"],
+    [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])],
+    [AC_MSG_ERROR([frame pointers not supported on this platform])]
+  )],
+  [AC_MSG_NOTICE([not using frame pointers])
+  frame_pointers=false])
+
+## No naked pointers
+
+AS_IF([test x"$enable_naked_pointers" = "xno" ],
+  [AC_DEFINE([NO_NAKED_POINTERS])])
+
+## Check for mmap support for huge pages and contiguous heap
+OCAML_MMAP_SUPPORTS_HUGE_PAGES
+
+# Spacetime profiling, including libunwind detection
+
+# The number of bits used for profiling information is configurable here.
+# The more bits used for profiling, the smaller will be Max_wosize.
+# Note that PROFINFO_WIDTH must still be defined even if not configuring
+# for Spacetime (see comment in runtime/caml/mlvalues.h on [Profinfo_hd]).
+AC_MSG_CHECKING([whether to build spacetime])
+AS_IF([test x"$enable_spacetime" != "xyes" ],
+  [spacetime=false
+  call_counts=true # as in original script but should probably be false
+  libunwind_available=false
+  libunwind_include_flags=
+  libunwind_link_flags=
+  AC_MSG_RESULT([no])],
+  [AS_CASE([$arch],
+    [amd64], [spacetime_supported=true],
+    [spacetime_supported=false])
+  AS_IF([$spacetime_supported],
+    [AC_MSG_RESULT([yes])
+    spacetime=true
+    profinfo=true
+    profinfo_width=26
+    AC_DEFINE([WITH_SPACETIME])
+    AS_IF([test x"$enable_call_counts" != "xno"],
+      [call_counts=true
+      AC_DEFINE([ENABLE_CALL_COUNTS])],
+      [call_counts=false])
+    AC_MSG_CHECKING([whether to use libunwind])
+    AS_IF([test x"$with_libunwind" = "xno"],
+      [AC_MSG_RESULT([disabled])],
+      [AS_IF([test x"$with_libunwind" = "x"],
+        [libunwind_requested=false
+        AC_MSG_RESULT([if available])],
+        [libunwind_requested=true
+        AC_MSG_RESULT([requested])
+        AS_IF([test x"$with_libunwind" != "xyes"],
+          [AS_IF([test x"$LIBUNWIND_INCLUDE_DIR" = "x"],
+            [LIBUNWIND_INCLUDE_DIR="$with_libunwind/include"])
+          AS_IF([test x"$LIBUNWIND_LIB_DIR" = "x"],
+            [LIBUNWIND_LIB_DIR="$with_libunwind/lib"])
+          ])
+        ])
+      AS_IF([test "$system" = "macosx"],
+        [AS_IF([test x"$LIBUNWIND_INCLUDE_DIR" != x -o \
+                     x"$LIBUNWIND_LIB_DIR" != x],
+          [AC_MSG_WARN(m4_normalize([
+            On MacOSX, specifying paths for libunwind headers or libraries
+            is strongly discouraged.  It is recommended to rely on the
+            defaults provided by the configure script
+          ]))])])
+
+      AS_IF([test x"$LIBUNWIND_INCLUDE_DIR" != x],
+        [libunwind_include_flags="-I$LIBUNWIND_INCLUDE_DIR"],
+        [libunwind_include_flags=""])
+
+      AS_CASE(["$system"],
+        ["macosx"], [libunwind_link_flags="-framework System"],
+        [libunwind_link_flags="-lunwind -lunwind-x86_64"])
+
+      AS_IF([test x"$LIBUNWIND_LIB_DIR" != x],
+        [libunwind_link_flags="-L$LIBUNWIND_LIB_DIR $libunwind_link_flags"])
+
+      OCAML_CHECK_LIBUNWIND
+
+      AS_IF([$libunwind_requested && ! $libunwind_available],
+        [AC_MSG_ERROR([libunwind was requested but can not be found])])
+
+        # We need unwinding information at runtime, but since we use
+        # -no_compact_unwind, we also need -keep_dwarf_unwind otherwise
+        # the OS X linker will chuck away the DWARF-like (.eh_frame)
+        # information.  (Older versions of OS X don't provide this.)
+
+        AS_IF([$libunwind_available && test x"$system" = "xmacosx"],
+          [extra_flags="-Wl,-keep_dwarf_unwind"
+          mkexe="$mkexe $extra_flags"
+          mksharedlib="$mksharedlib $extra_flags"])])
+    ],
+    [AS_IF([test x"$enable_spacetime" = "xyes"],
+      [AC_MSG_RESULT([requested but not supported])
+      AC_MSG_ERROR([exiting])],
+      [AC_MSG_RESULT([no])])
+    ])
+  ])
+
+AC_DEFINE_UNQUOTED([PROFINFO_WIDTH], [$profinfo_width])
+AS_IF([$profinfo], [AC_DEFINE([WITH_PROFINFO])])
+
+AS_IF([test x"$enable_installing_bytecode_programs" = "xno"],
+  [install_bytecode_programs=false],
+  [install_bytecode_programs=true])
+
+AS_IF([test x"$enable_installing_source_artifacts" = "xno"],
+  [install_source_artifacts=false],
+  [install_source_artifacts=true])
+
+AS_IF([test x"$enable_ocamldoc" = "xno"],
+  [ocamldoc=""],
+  [ocamldoc=ocamldoc])
+
+AS_CASE([$enable_ocamltest,AC_PACKAGE_VERSION],
+  [yes,*|,*+dev*],[ocamltest='ocamltest'],
+  [ocamltest=''])
+
+AS_IF([test x"$enable_flambda" = "xyes"],
+  [flambda=true
+  AS_IF([test x"$enable_flambda_invariants" = "xyes"],
+    [flambda_invariants=true],
+    [flambda_invariants=false])],
+  [flambda=false
+  flambda_invariants=false])
+
+AS_IF([test x"$enable_flat_float_array" = "xno"],
+  [flat_float_array=false],
+  [AC_DEFINE([FLAT_FLOAT_ARRAY])
+  flat_float_array=true])
+
+AS_IF([test x"$enable_function_sections" = "xno"],
+  [function_sections=false],
+  [AS_CASE([$arch],
+    [amd64|i386|arm64], # not supported on arm32, see issue #9124.
+     [AS_CASE([$target],
+        [*-cygwin*|*-mingw*|*-windows|*-apple-darwin*],
+          [function_sections=false;
+           AC_MSG_NOTICE([No support for function sections on $target.])],
+        [*],
+          [AS_CASE([$ocaml_cv_cc_vendor],
+            [gcc-[0123]-*|gcc-4-[01234567]],
+              [function_sections=false;
+              AC_MSG_NOTICE([Function sections are not
+              supported in GCC prior to version 4.8.])],
+            [clang-[012]-*|clang-3-[01234]],
+              [function_sections=false;
+              AC_MSG_NOTICE([Function sections are not supported
+              in Clang prior to version 3.5.])],
+            [gcc-*|clang-*],
+              [function_sections=true;
+              internal_cflags="$internal_cflags -ffunction-sections";
+              AC_DEFINE([FUNCTION_SECTIONS])],
+            [*],
+              [function_sections=false;
+              AC_MSG_NOTICE([Function sections are not supported by
+              $ocaml_cv_cc_vendor.])])])],
+    [function_sections=false]);
+  AS_IF([test x"$function_sections" = "xfalse"],
+    [AS_IF([test x"$enable_function_sections" = "xyes"],
+      [AC_MSG_ERROR([Function sections are not supported.])],
+      [AC_MSG_NOTICE([Disabling function sections.])])],
+    [])])
+
+AS_IF([test x"$with_afl" = "xyes"],
+  [afl=true],
+  [afl=false])
+
+AS_IF([test x"$enable_force_safe_string" = "xno"],
+  [force_safe_string=false],
+  [AC_DEFINE([CAML_SAFE_STRING])
+   force_safe_string=true])
+
+AS_IF([test x"$DEFAULT_STRING" = "xunsafe"],
+  [default_safe_string=false],
+  [default_safe_string=true])
+
+oc_cflags="$common_cflags $internal_cflags"
+oc_cppflags="$common_cppflags $internal_cppflags"
+ocamlc_cflags="$common_cflags $sharedlib_cflags"
+ocamlc_cppflags="$common_cppflags"
+cclibs="$cclibs $mathlib"
+
+AS_CASE([$host],
+  [*-*-mingw32],
+    [bytecclibs="-lws2_32 -lversion"
+    nativecclibs="-lws2_32 -lversion"],
+  [*-pc-windows],
+    [bytecclibs="advapi32.lib ws2_32.lib version.lib"
+    nativecclibs="advapi32.lib ws2_32.lib version.lib"],
+  [bytecclibs="$cclibs $DLLIBS $pthread_link $instrumented_runtime_ldlibs"
+  nativecclibs="$cclibs $DLLIBS"])
+
+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],
+    [max_testsuite_dir_retries=1
+    AS_CASE([$WINDOWS_UNICODE_MODE],
+      [ansi],
+        [windows_unicode=0],
+      [compatible|""],
+        [windows_unicode=1],
+      [AC_MSG_ERROR([unexpected windows unicode mode])])],
+  [max_testsuite_dir_retries=0
+  windows_unicode=0])
+
+# Define flexlink chain and flags correctly for the different Windows ports
+AS_CASE([$host],
+  [i686-w64-mingw32],
+    [flexdll_chain='mingw'
+    flexlink_flags="-chain $flexdll_chain -stack 16777216"],
+  [x86_64-w64-mingw32],
+    [flexdll_chain='mingw64'
+    flexlink_flags="-chain $flexdll_chain -stack 33554432"],
+  [i686-pc-windows],
+    [flexdll_chain='msvc'
+    flexlink_flags="-merge-manifest -stack 16777216"],
+  [x86_64-pc-windows],
+    [flexdll_chain='msvc64'
+    flexlink_flags="-x64 -merge-manifest -stack 33554432"])
+
+# Define default prefix correctly for the different Windows ports
+AS_IF([test x"$prefix" = "xNONE"],
+  [AS_CASE([$host],
+    [i686-w64-mingw32], [prefix='C:/ocamlmgw'],
+    [x86_64-w64-mingw32], [prefix='C:/ocamlmgw64'],
+    [i686-pc-windows], [prefix='C:/ocamlms'],
+    [x86_64-pc-windows], [prefix='C:/ocamlms64'])],
+  [AS_IF([test x"$unix_or_win32" = "xwin32" \
+          && test "$host_vendor-$host_os" != "$build_vendor-$build_os" ],
+    [AS_CASE([$build],
+      [*-pc-cygwin], [prefix=`cygpath -m "$prefix"`])])])
+
+# Define a few macros that were defined in config/m-nt.h
+# but whose value is not guessed properly by configure
+# (all this should be understood and fixed)
+AS_CASE([$host],
+  [*-*-mingw32|*-pc-windows],
+    [AC_DEFINE([HAS_BROKEN_PRINTF])
+    AC_DEFINE([HAS_STRERROR])
+    AC_DEFINE([HAS_IPV6])
+    AC_DEFINE([HAS_NICE])])
+
+AS_IF([test x"$enable_stdlib_manpages" != "xno"],
+  [stdlib_manpages=true],[stdlib_manpages=false])
+
+AC_OUTPUT
diff --git a/debugger/.depend b/debugger/.depend
new file mode 100644
index 00000000..1ba1295f
--- /dev/null
+++ b/debugger/.depend
@@ -0,0 +1,647 @@
+breakpoints.cmo : \
+    symbols.cmi \
+    pos.cmi \
+    parameters.cmi \
+    ../utils/misc.cmi \
+    ../bytecomp/instruct.cmi \
+    exec.cmi \
+    events.cmi \
+    debugger_config.cmi \
+    debugcom.cmi \
+    checkpoints.cmi \
+    breakpoints.cmi
+breakpoints.cmx : \
+    symbols.cmx \
+    pos.cmx \
+    parameters.cmx \
+    ../utils/misc.cmx \
+    ../bytecomp/instruct.cmx \
+    exec.cmx \
+    events.cmx \
+    debugger_config.cmx \
+    debugcom.cmx \
+    checkpoints.cmx \
+    breakpoints.cmi
+breakpoints.cmi : \
+    events.cmi \
+    debugcom.cmi
+checkpoints.cmo : \
+    primitives.cmi \
+    int64ops.cmi \
+    debugcom.cmi \
+    checkpoints.cmi
+checkpoints.cmx : \
+    primitives.cmx \
+    int64ops.cmx \
+    debugcom.cmx \
+    checkpoints.cmi
+checkpoints.cmi : \
+    primitives.cmi \
+    debugcom.cmi
+command_line.cmo : \
+    unix_tools.cmi \
+    $(UNIXDIR)/unix.cmi \
+    ../typing/types.cmi \
+    time_travel.cmi \
+    symbols.cmi \
+    source.cmi \
+    show_source.cmi \
+    show_information.cmi \
+    question.cmi \
+    program_management.cmi \
+    program_loading.cmi \
+    printval.cmi \
+    primitives.cmi \
+    pos.cmi \
+    parser_aux.cmi \
+    parameters.cmi \
+    ../parsing/longident.cmi \
+    ../parsing/location.cmi \
+    loadprinter.cmi \
+    ../utils/load_path.cmi \
+    int64ops.cmi \
+    ../bytecomp/instruct.cmi \
+    input_handling.cmi \
+    history.cmi \
+    frames.cmi \
+    events.cmi \
+    eval.cmi \
+    ../typing/envaux.cmi \
+    ../typing/env.cmi \
+    debugger_parser.cmi \
+    debugger_lexer.cmi \
+    debugger_config.cmi \
+    debugcom.cmi \
+    ../typing/ctype.cmi \
+    checkpoints.cmi \
+    breakpoints.cmi \
+    command_line.cmi
+command_line.cmx : \
+    unix_tools.cmx \
+    $(UNIXDIR)/unix.cmx \
+    ../typing/types.cmx \
+    time_travel.cmx \
+    symbols.cmx \
+    source.cmx \
+    show_source.cmx \
+    show_information.cmx \
+    question.cmx \
+    program_management.cmx \
+    program_loading.cmx \
+    printval.cmx \
+    primitives.cmx \
+    pos.cmx \
+    parser_aux.cmi \
+    parameters.cmx \
+    ../parsing/longident.cmx \
+    ../parsing/location.cmx \
+    loadprinter.cmx \
+    ../utils/load_path.cmx \
+    int64ops.cmx \
+    ../bytecomp/instruct.cmx \
+    input_handling.cmx \
+    history.cmx \
+    frames.cmx \
+    events.cmx \
+    eval.cmx \
+    ../typing/envaux.cmx \
+    ../typing/env.cmx \
+    debugger_parser.cmx \
+    debugger_lexer.cmx \
+    debugger_config.cmx \
+    debugcom.cmx \
+    ../typing/ctype.cmx \
+    checkpoints.cmx \
+    breakpoints.cmx \
+    command_line.cmi
+command_line.cmi :
+debugcom.cmo : \
+    primitives.cmi \
+    ../utils/misc.cmi \
+    int64ops.cmi \
+    ../bytecomp/instruct.cmi \
+    input_handling.cmi \
+    debugcom.cmi
+debugcom.cmx : \
+    primitives.cmx \
+    ../utils/misc.cmx \
+    int64ops.cmx \
+    ../bytecomp/instruct.cmx \
+    input_handling.cmx \
+    debugcom.cmi
+debugcom.cmi : \
+    primitives.cmi \
+    ../bytecomp/instruct.cmi
+debugger_config.cmo : \
+    int64ops.cmi \
+    debugger_config.cmi
+debugger_config.cmx : \
+    int64ops.cmx \
+    debugger_config.cmi
+debugger_config.cmi :
+debugger_lexer.cmo : \
+    debugger_parser.cmi \
+    debugger_lexer.cmi
+debugger_lexer.cmx : \
+    debugger_parser.cmx \
+    debugger_lexer.cmi
+debugger_lexer.cmi : \
+    debugger_parser.cmi
+debugger_parser.cmo : \
+    parser_aux.cmi \
+    ../parsing/longident.cmi \
+    int64ops.cmi \
+    input_handling.cmi \
+    debugcom.cmi \
+    debugger_parser.cmi
+debugger_parser.cmx : \
+    parser_aux.cmi \
+    ../parsing/longident.cmx \
+    int64ops.cmx \
+    input_handling.cmx \
+    debugcom.cmx \
+    debugger_parser.cmi
+debugger_parser.cmi : \
+    parser_aux.cmi \
+    ../parsing/longident.cmi
+eval.cmo : \
+    ../typing/types.cmi \
+    ../bytecomp/symtable.cmi \
+    ../typing/subst.cmi \
+    printval.cmi \
+    ../typing/printtyp.cmi \
+    ../typing/predef.cmi \
+    ../typing/path.cmi \
+    parser_aux.cmi \
+    ../utils/misc.cmi \
+    ../parsing/longident.cmi \
+    ../bytecomp/instruct.cmi \
+    ../typing/ident.cmi \
+    frames.cmi \
+    events.cmi \
+    ../typing/env.cmi \
+    debugcom.cmi \
+    ../typing/ctype.cmi \
+    ../typing/btype.cmi \
+    eval.cmi
+eval.cmx : \
+    ../typing/types.cmx \
+    ../bytecomp/symtable.cmx \
+    ../typing/subst.cmx \
+    printval.cmx \
+    ../typing/printtyp.cmx \
+    ../typing/predef.cmx \
+    ../typing/path.cmx \
+    parser_aux.cmi \
+    ../utils/misc.cmx \
+    ../parsing/longident.cmx \
+    ../bytecomp/instruct.cmx \
+    ../typing/ident.cmx \
+    frames.cmx \
+    events.cmx \
+    ../typing/env.cmx \
+    debugcom.cmx \
+    ../typing/ctype.cmx \
+    ../typing/btype.cmx \
+    eval.cmi
+eval.cmi : \
+    ../typing/types.cmi \
+    ../typing/path.cmi \
+    parser_aux.cmi \
+    ../parsing/longident.cmi \
+    ../typing/ident.cmi \
+    events.cmi \
+    ../typing/env.cmi \
+    debugcom.cmi
+events.cmo : \
+    ../parsing/location.cmi \
+    ../bytecomp/instruct.cmi \
+    events.cmi
+events.cmx : \
+    ../parsing/location.cmx \
+    ../bytecomp/instruct.cmx \
+    events.cmi
+events.cmi : \
+    ../bytecomp/instruct.cmi
+exec.cmo : \
+    exec.cmi
+exec.cmx : \
+    exec.cmi
+exec.cmi :
+frames.cmo : \
+    symbols.cmi \
+    ../utils/misc.cmi \
+    ../bytecomp/instruct.cmi \
+    events.cmi \
+    debugcom.cmi \
+    frames.cmi
+frames.cmx : \
+    symbols.cmx \
+    ../utils/misc.cmx \
+    ../bytecomp/instruct.cmx \
+    events.cmx \
+    debugcom.cmx \
+    frames.cmi
+frames.cmi : \
+    events.cmi
+history.cmo : \
+    primitives.cmi \
+    int64ops.cmi \
+    debugger_config.cmi \
+    checkpoints.cmi \
+    history.cmi
+history.cmx : \
+    primitives.cmx \
+    int64ops.cmx \
+    debugger_config.cmx \
+    checkpoints.cmx \
+    history.cmi
+history.cmi :
+input_handling.cmo : \
+    $(UNIXDIR)/unix.cmi \
+    primitives.cmi \
+    parameters.cmi \
+    input_handling.cmi
+input_handling.cmx : \
+    $(UNIXDIR)/unix.cmx \
+    primitives.cmx \
+    parameters.cmx \
+    input_handling.cmi
+input_handling.cmi : \
+    primitives.cmi
+int64ops.cmo : \
+    int64ops.cmi
+int64ops.cmx : \
+    int64ops.cmi
+int64ops.cmi :
+loadprinter.cmo : \
+    ../typing/types.cmi \
+    ../bytecomp/symtable.cmi \
+    printval.cmi \
+    ../typing/printtyp.cmi \
+    ../typing/path.cmi \
+    parameters.cmi \
+    ../utils/misc.cmi \
+    ../parsing/longident.cmi \
+    ../utils/load_path.cmi \
+    ../typing/ident.cmi \
+    ../typing/env.cmi \
+    ../otherlibs/dynlink/dynlink.cmi \
+    ../typing/ctype.cmi \
+    loadprinter.cmi
+loadprinter.cmx : \
+    ../typing/types.cmx \
+    ../bytecomp/symtable.cmx \
+    printval.cmx \
+    ../typing/printtyp.cmx \
+    ../typing/path.cmx \
+    parameters.cmx \
+    ../utils/misc.cmx \
+    ../parsing/longident.cmx \
+    ../utils/load_path.cmx \
+    ../typing/ident.cmx \
+    ../typing/env.cmx \
+    ../otherlibs/dynlink/dynlink.cmi \
+    ../typing/ctype.cmx \
+    loadprinter.cmi
+loadprinter.cmi : \
+    ../parsing/longident.cmi \
+    ../otherlibs/dynlink/dynlink.cmi
+main.cmo : \
+    unix_tools.cmi \
+    $(UNIXDIR)/unix.cmi \
+    time_travel.cmi \
+    show_information.cmi \
+    question.cmi \
+    program_management.cmi \
+    primitives.cmi \
+    ../typing/persistent_env.cmi \
+    parameters.cmi \
+    ../utils/misc.cmi \
+    loadprinter.cmi \
+    ../utils/load_path.cmi \
+    input_handling.cmi \
+    frames.cmi \
+    exec.cmi \
+    debugger_config.cmi \
+    ../utils/config.cmi \
+    command_line.cmi \
+    ../file_formats/cmi_format.cmi \
+    ../utils/clflags.cmi \
+    checkpoints.cmi
+main.cmx : \
+    unix_tools.cmx \
+    $(UNIXDIR)/unix.cmx \
+    time_travel.cmx \
+    show_information.cmx \
+    question.cmx \
+    program_management.cmx \
+    primitives.cmx \
+    ../typing/persistent_env.cmx \
+    parameters.cmx \
+    ../utils/misc.cmx \
+    loadprinter.cmx \
+    ../utils/load_path.cmx \
+    input_handling.cmx \
+    frames.cmx \
+    exec.cmx \
+    debugger_config.cmx \
+    ../utils/config.cmx \
+    command_line.cmx \
+    ../file_formats/cmi_format.cmx \
+    ../utils/clflags.cmx \
+    checkpoints.cmx
+parameters.cmo : \
+    ../utils/load_path.cmi \
+    ../typing/envaux.cmi \
+    debugger_config.cmi \
+    ../utils/config.cmi \
+    parameters.cmi
+parameters.cmx : \
+    ../utils/load_path.cmx \
+    ../typing/envaux.cmx \
+    debugger_config.cmx \
+    ../utils/config.cmx \
+    parameters.cmi
+parameters.cmi :
+parser_aux.cmi : \
+    ../parsing/longident.cmi \
+    debugcom.cmi
+pattern_matching.cmo : \
+    ../typing/typedtree.cmi \
+    parser_aux.cmi \
+    ../utils/misc.cmi \
+    debugger_config.cmi \
+    debugcom.cmi \
+    ../typing/ctype.cmi \
+    pattern_matching.cmi
+pattern_matching.cmx : \
+    ../typing/typedtree.cmx \
+    parser_aux.cmi \
+    ../utils/misc.cmx \
+    debugger_config.cmx \
+    debugcom.cmx \
+    ../typing/ctype.cmx \
+    pattern_matching.cmi
+pattern_matching.cmi : \
+    ../typing/typedtree.cmi \
+    parser_aux.cmi \
+    debugcom.cmi
+pos.cmo : \
+    ../parsing/location.cmi \
+    ../bytecomp/instruct.cmi \
+    events.cmi \
+    pos.cmi
+pos.cmx : \
+    ../parsing/location.cmx \
+    ../bytecomp/instruct.cmx \
+    events.cmx \
+    pos.cmi
+pos.cmi : \
+    events.cmi
+primitives.cmo : \
+    $(UNIXDIR)/unix.cmi \
+    primitives.cmi
+primitives.cmx : \
+    $(UNIXDIR)/unix.cmx \
+    primitives.cmi
+primitives.cmi : \
+    $(UNIXDIR)/unix.cmi
+printval.cmo : \
+    ../typing/types.cmi \
+    ../bytecomp/symtable.cmi \
+    ../typing/printtyp.cmi \
+    parser_aux.cmi \
+    ../typing/outcometree.cmi \
+    ../typing/oprint.cmi \
+    ../toplevel/genprintval.cmi \
+    ../typing/env.cmi \
+    debugcom.cmi \
+    printval.cmi
+printval.cmx : \
+    ../typing/types.cmx \
+    ../bytecomp/symtable.cmx \
+    ../typing/printtyp.cmx \
+    parser_aux.cmi \
+    ../typing/outcometree.cmi \
+    ../typing/oprint.cmx \
+    ../toplevel/genprintval.cmx \
+    ../typing/env.cmx \
+    debugcom.cmx \
+    printval.cmi
+printval.cmi : \
+    ../typing/types.cmi \
+    ../typing/path.cmi \
+    parser_aux.cmi \
+    ../typing/env.cmi \
+    debugcom.cmi
+program_loading.cmo : \
+    unix_tools.cmi \
+    $(UNIXDIR)/unix.cmi \
+    primitives.cmi \
+    parameters.cmi \
+    input_handling.cmi \
+    debugger_config.cmi \
+    program_loading.cmi
+program_loading.cmx : \
+    unix_tools.cmx \
+    $(UNIXDIR)/unix.cmx \
+    primitives.cmx \
+    parameters.cmx \
+    input_handling.cmx \
+    debugger_config.cmx \
+    program_loading.cmi
+program_loading.cmi : \
+    primitives.cmi
+program_management.cmo : \
+    unix_tools.cmi \
+    $(UNIXDIR)/unix.cmi \
+    time_travel.cmi \
+    symbols.cmi \
+    question.cmi \
+    program_loading.cmi \
+    primitives.cmi \
+    parameters.cmi \
+    ../utils/load_path.cmi \
+    int64ops.cmi \
+    input_handling.cmi \
+    history.cmi \
+    ../typing/envaux.cmi \
+    debugger_config.cmi \
+    breakpoints.cmi \
+    program_management.cmi
+program_management.cmx : \
+    unix_tools.cmx \
+    $(UNIXDIR)/unix.cmx \
+    time_travel.cmx \
+    symbols.cmx \
+    question.cmx \
+    program_loading.cmx \
+    primitives.cmx \
+    parameters.cmx \
+    ../utils/load_path.cmx \
+    int64ops.cmx \
+    input_handling.cmx \
+    history.cmx \
+    ../typing/envaux.cmx \
+    debugger_config.cmx \
+    breakpoints.cmx \
+    program_management.cmi
+program_management.cmi :
+question.cmo : \
+    primitives.cmi \
+    input_handling.cmi \
+    debugger_lexer.cmi \
+    question.cmi
+question.cmx : \
+    primitives.cmx \
+    input_handling.cmx \
+    debugger_lexer.cmx \
+    question.cmi
+question.cmi :
+show_information.cmo : \
+    symbols.cmi \
+    source.cmi \
+    show_source.cmi \
+    printval.cmi \
+    parameters.cmi \
+    ../utils/misc.cmi \
+    ../bytecomp/instruct.cmi \
+    frames.cmi \
+    events.cmi \
+    debugcom.cmi \
+    checkpoints.cmi \
+    breakpoints.cmi \
+    show_information.cmi
+show_information.cmx : \
+    symbols.cmx \
+    source.cmx \
+    show_source.cmx \
+    printval.cmx \
+    parameters.cmx \
+    ../utils/misc.cmx \
+    ../bytecomp/instruct.cmx \
+    frames.cmx \
+    events.cmx \
+    debugcom.cmx \
+    checkpoints.cmx \
+    breakpoints.cmx \
+    show_information.cmi
+show_information.cmi : \
+    events.cmi
+show_source.cmo : \
+    source.cmi \
+    primitives.cmi \
+    parameters.cmi \
+    ../parsing/location.cmi \
+    ../bytecomp/instruct.cmi \
+    events.cmi \
+    debugger_config.cmi \
+    show_source.cmi
+show_source.cmx : \
+    source.cmx \
+    primitives.cmx \
+    parameters.cmx \
+    ../parsing/location.cmx \
+    ../bytecomp/instruct.cmx \
+    events.cmx \
+    debugger_config.cmx \
+    show_source.cmi
+show_source.cmi : \
+    ../bytecomp/instruct.cmi
+source.cmo : \
+    primitives.cmi \
+    ../utils/misc.cmi \
+    ../utils/load_path.cmi \
+    debugger_config.cmi \
+    source.cmi
+source.cmx : \
+    primitives.cmx \
+    ../utils/misc.cmx \
+    ../utils/load_path.cmx \
+    debugger_config.cmx \
+    source.cmi
+source.cmi :
+symbols.cmo : \
+    ../bytecomp/symtable.cmi \
+    program_loading.cmi \
+    ../utils/misc.cmi \
+    ../bytecomp/instruct.cmi \
+    events.cmi \
+    debugger_config.cmi \
+    debugcom.cmi \
+    checkpoints.cmi \
+    ../bytecomp/bytesections.cmi \
+    symbols.cmi
+symbols.cmx : \
+    ../bytecomp/symtable.cmx \
+    program_loading.cmx \
+    ../utils/misc.cmx \
+    ../bytecomp/instruct.cmx \
+    events.cmx \
+    debugger_config.cmx \
+    debugcom.cmx \
+    checkpoints.cmx \
+    ../bytecomp/bytesections.cmx \
+    symbols.cmi
+symbols.cmi : \
+    ../bytecomp/instruct.cmi \
+    events.cmi \
+    debugcom.cmi
+time_travel.cmo : \
+    trap_barrier.cmi \
+    symbols.cmi \
+    question.cmi \
+    program_loading.cmi \
+    primitives.cmi \
+    ../utils/misc.cmi \
+    int64ops.cmi \
+    ../bytecomp/instruct.cmi \
+    input_handling.cmi \
+    exec.cmi \
+    events.cmi \
+    debugger_config.cmi \
+    debugcom.cmi \
+    checkpoints.cmi \
+    breakpoints.cmi \
+    time_travel.cmi
+time_travel.cmx : \
+    trap_barrier.cmx \
+    symbols.cmx \
+    question.cmx \
+    program_loading.cmx \
+    primitives.cmx \
+    ../utils/misc.cmx \
+    int64ops.cmx \
+    ../bytecomp/instruct.cmx \
+    input_handling.cmx \
+    exec.cmx \
+    events.cmx \
+    debugger_config.cmx \
+    debugcom.cmx \
+    checkpoints.cmx \
+    breakpoints.cmx \
+    time_travel.cmi
+time_travel.cmi : \
+    primitives.cmi
+trap_barrier.cmo : \
+    exec.cmi \
+    debugcom.cmi \
+    checkpoints.cmi \
+    trap_barrier.cmi
+trap_barrier.cmx : \
+    exec.cmx \
+    debugcom.cmx \
+    checkpoints.cmx \
+    trap_barrier.cmi
+trap_barrier.cmi :
+unix_tools.cmo : \
+    $(UNIXDIR)/unix.cmi \
+    ../utils/misc.cmi \
+    unix_tools.cmi
+unix_tools.cmx : \
+    $(UNIXDIR)/unix.cmx \
+    ../utils/misc.cmx \
+    unix_tools.cmi
+unix_tools.cmi : \
+    $(UNIXDIR)/unix.cmi
diff --git a/debugger/Makefile b/debugger/Makefile
new file mode 100644
index 00000000..9b8c11f0
--- /dev/null
+++ b/debugger/Makefile
@@ -0,0 +1,95 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+ROOTDIR = ..
+
+-include $(ROOTDIR)/Makefile.config
+-include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.best_binaries
+
+DYNLINKDIR=$(ROOTDIR)/otherlibs/dynlink
+UNIXDIR=$(ROOTDIR)/otherlibs/$(UNIXLIB)
+CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
+CAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc$(EXE)
+
+CAMLC=$(BEST_OCAMLC) -g -nostdlib -I $(ROOTDIR)/stdlib
+COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
+          -safe-string -strict-sequence -strict-formats
+LINKFLAGS=-linkall -I $(UNIXDIR) -I $(DYNLINKDIR)
+YACCFLAGS=
+CAMLLEX=$(BEST_OCAMLLEX)
+CAMLDEP=$(BEST_OCAMLDEP)
+DEPFLAGS=-slash
+DEPINCLUDES=$(INCLUDES)
+
+DIRECTORIES=$(UNIXDIR) $(DYNLINKDIR) $(addprefix $(ROOTDIR)/,\
+  utils parsing typing bytecomp toplevel driver file_formats lambda)
+
+INCLUDES=$(addprefix -I ,$(DIRECTORIES))
+
+compiler_modules := $(ROOTDIR)/toplevel/genprintval
+
+debugger_modules := \
+  int64ops primitives unix_tools debugger_config parameters debugger_lexer \
+  input_handling question debugcom exec source pos checkpoints events \
+  program_loading symbols breakpoints trap_barrier history printval \
+  show_source time_travel program_management frames eval \
+  show_information loadprinter debugger_parser command_line main
+
+all_modules := $(compiler_modules) $(debugger_modules)
+
+all_objects := $(addsuffix .cmo,$(all_modules))
+
+libraries = $(ROOTDIR)/compilerlibs/ocamlcommon.cma \
+  $(UNIXDIR)/unix.cma $(DYNLINKDIR)/dynlink.cma
+
+all: ocamldebug$(EXE)
+
+ocamldebug$(EXE): $(libraries) $(all_objects)
+	$(CAMLC) $(LINKFLAGS) -o $@ -linkall $^
+
+install:
+	$(INSTALL_PROG) ocamldebug$(EXE) "$(INSTALL_BINDIR)/ocamldebug$(EXE)"
+
+clean::
+	rm -f ocamldebug ocamldebug.exe
+	rm -f *.cmo *.cmi
+
+.SUFFIXES:
+.SUFFIXES: .ml .cmo .mli .cmi
+
+.ml.cmo:
+	$(CAMLC) -c $(COMPFLAGS) $<
+
+.mli.cmi:
+	$(CAMLC) -c $(COMPFLAGS) $<
+
+depend: beforedepend
+	$(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) *.mli *.ml \
+	| sed -e 's,$(UNIXDIR)/,$$(UNIXDIR)/,' > .depend
+
+debugger_lexer.ml: debugger_lexer.mll
+	$(CAMLLEX) $(OCAMLLEX_FLAGS) $<
+clean::
+	rm -f debugger_lexer.ml
+beforedepend:: debugger_lexer.ml
+
+debugger_parser.ml debugger_parser.mli: debugger_parser.mly
+	$(CAMLYACC) debugger_parser.mly
+clean::
+	rm -f debugger_parser.ml debugger_parser.mli
+beforedepend:: debugger_parser.ml debugger_parser.mli
+
+include .depend
diff --git a/debugger/breakpoints.ml b/debugger/breakpoints.ml
new file mode 100644
index 00000000..60059fcd
--- /dev/null
+++ b/debugger/breakpoints.ml
@@ -0,0 +1,209 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(******************************* Breakpoints ***************************)
+
+open Checkpoints
+open Debugcom
+open Instruct
+open Events
+open Printf
+
+(*** Debugging. ***)
+let debug_breakpoints = ref false
+
+(*** Data. ***)
+
+(* Number of the last added breakpoint. *)
+let breakpoint_number = ref 0
+
+(* Breakpoint number -> event. *)
+type breakpoint_id = int
+let breakpoints = ref ([] : (breakpoint_id * code_event) list)
+
+(* Program counter -> breakpoint count. *)
+let positions = ref ([] : (pc * int ref) list)
+
+(* Versions of the breakpoint list. *)
+let current_version = ref 0
+let max_version = ref 0
+
+(*** Miscellaneous. ***)
+
+(* Mark breakpoints as installed in current checkpoint. *)
+let copy_breakpoints () =
+  !current_checkpoint.c_breakpoints <- !positions;
+  !current_checkpoint.c_breakpoint_version <- !current_version
+
+(* Announce a new version of the breakpoint list. *)
+let new_version () =
+  incr max_version;
+  current_version := !max_version
+
+(*** Information about breakpoints. ***)
+
+let breakpoints_count () =
+  List.length !breakpoints
+
+(* List of breakpoints at `pc'. *)
+let rec breakpoints_at_pc pc =
+  begin match Symbols.event_at_pc pc with
+  | {ev_frag = frag; ev_ev = {ev_repr = Event_child {contents = pos}}} ->
+     breakpoints_at_pc {frag; pos}
+  | _ -> []
+  | exception Not_found -> []
+  end
+    @
+  List.map fst (List.filter
+                  (function (_, {ev_frag = frag; ev_ev = {ev_pos = pos}}) ->
+                            {frag; pos} = pc)
+                  !breakpoints)
+
+(* Is there a breakpoint at `pc' ? *)
+let breakpoint_at_pc pc =
+  breakpoints_at_pc pc <> []
+
+(*** Set and remove breakpoints ***)
+
+let print_pc out {frag;pos} = fprintf out "%d:%d" frag pos
+
+(* Remove all breakpoints. *)
+let remove_breakpoints pcs =
+  if !debug_breakpoints then
+    printf "Removing breakpoints...\n%!";
+  List.iter
+    (function (pc, _) ->
+       if !debug_breakpoints then printf "%a\n%!" print_pc pc;
+       reset_instr pc;
+       Symbols.set_event_at_pc pc)
+    pcs
+
+(* Set all breakpoints. *)
+let set_breakpoints pcs =
+  if !debug_breakpoints then
+    printf "Setting breakpoints...\n%!";
+  List.iter
+    (function (pc, _) ->
+       if !debug_breakpoints then printf "%a\n%!" print_pc pc;
+       set_breakpoint pc)
+    pcs
+
+(* Ensure the current version is installed in current checkpoint. *)
+let update_breakpoints () =
+  if !debug_breakpoints then begin
+    prerr_string "Updating breakpoints... ";
+    prerr_int !current_checkpoint.c_breakpoint_version;
+    prerr_string " ";
+    prerr_int !current_version;
+    prerr_endline ""
+  end;
+  if !current_checkpoint.c_breakpoint_version <> !current_version then
+    Exec.protect
+      (function () ->
+         remove_breakpoints !current_checkpoint.c_breakpoints;
+         set_breakpoints !positions;
+         copy_breakpoints ())
+
+(* Execute given function with no breakpoint in current checkpoint. *)
+(* --- `goto' runs faster this way (does not stop on each breakpoint). *)
+let execute_without_breakpoints f =
+  Misc.protect_refs [Misc.R (Debugger_config.break_on_load, false);
+                     Misc.R (current_version, 0);
+                     Misc.R (positions, []);
+                     Misc.R (breakpoints, []);
+                     Misc.R (breakpoint_number, 0)]
+                    f
+
+(* Add a position in the position list. *)
+(* Change version if necessary. *)
+let insert_position pos =
+  try
+    incr (List.assoc pos !positions)
+  with
+    Not_found ->
+      positions := (pos, ref 1) :: !positions;
+      new_version ()
+
+(* Remove a position in the position list. *)
+(* Change version if necessary. *)
+let remove_position pos =
+  let count = List.assoc pos !positions in
+    decr count;
+    if !count = 0 then begin
+      positions := List.remove_assoc pos !positions;
+      new_version ()
+    end
+
+(* Insert a new breakpoint in lists. *)
+let rec new_breakpoint event =
+  match event with
+    {ev_frag=frag; ev_ev={ev_repr=Event_child pos}} ->
+      new_breakpoint (Symbols.any_event_at_pc {frag; pos=(!pos)})
+  | {ev_frag=frag; ev_ev={ev_pos=pos}} ->
+    let pc = {frag; pos} in
+    Exec.protect
+      (function () ->
+         incr breakpoint_number;
+         insert_position pc;
+         breakpoints := (!breakpoint_number, event) :: !breakpoints);
+    if !Parameters.breakpoint then
+      printf "Breakpoint %d at %a: %s\n%!" !breakpoint_number print_pc pc
+             (Pos.get_desc event)
+
+(* Remove a breakpoint from lists. *)
+let remove_breakpoint number =
+  try
+    let ev = List.assoc number !breakpoints in
+    let pc = {frag = ev.ev_frag; pos=ev.ev_ev.ev_pos} in
+    Exec.protect
+      (function () ->
+         breakpoints := List.remove_assoc number !breakpoints;
+         remove_position pc;
+         if !Parameters.breakpoint then
+           printf "Removed breakpoint %d at %a: %s\n%!" number print_pc pc
+                  (Pos.get_desc ev))
+  with
+    Not_found ->
+      prerr_endline ("No breakpoint number " ^ (Int.to_string number) ^ ".");
+      raise Not_found
+
+let remove_all_breakpoints () =
+  List.iter (function (number, _) -> remove_breakpoint number) !breakpoints
+
+(*** Temporary breakpoints. ***)
+
+(* Temporary breakpoint position. *)
+let temporary_breakpoint_position = ref (None : pc option)
+
+(* Execute `funct' with a breakpoint added at `pc'. *)
+(* --- Used by `finish'. *)
+let exec_with_temporary_breakpoint pc funct =
+  let previous_version = !current_version in
+    let remove () =
+      temporary_breakpoint_position := None;
+      current_version := previous_version;
+      let count = List.assoc pc !positions in
+        decr count;
+        if !count = 0 then begin
+          positions := List.remove_assoc pc !positions;
+          reset_instr pc;
+          Symbols.set_event_at_pc pc
+        end
+
+    in
+      Exec.protect (function () -> insert_position pc);
+      temporary_breakpoint_position := Some pc;
+      Fun.protect ~finally:(fun () -> Exec.protect remove) funct
diff --git a/debugger/breakpoints.mli b/debugger/breakpoints.mli
new file mode 100644
index 00000000..d26d9b24
--- /dev/null
+++ b/debugger/breakpoints.mli
@@ -0,0 +1,60 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(******************************* Breakpoints ***************************)
+
+(*** Debugging. ***)
+val debug_breakpoints : bool ref
+
+(*** Information about breakpoints. ***)
+
+val breakpoints_count : unit -> int
+
+(* Breakpoint number -> code_event. *)
+type breakpoint_id = int
+val breakpoints : (breakpoint_id * Events.code_event) list ref
+
+(* Is there a breakpoint at `pc' ? *)
+val breakpoint_at_pc : Debugcom.pc -> bool
+
+(* List of breakpoints at `pc'. *)
+val breakpoints_at_pc : Debugcom.pc -> breakpoint_id list
+
+(*** Set and remove breakpoints ***)
+
+(* Ensure the current version is installed in current checkpoint. *)
+val update_breakpoints : unit -> unit
+
+(* Execute given function with no breakpoint in current checkpoint. *)
+(* --- `goto' run faster so (does not stop on each breakpoint). *)
+val execute_without_breakpoints : (unit -> unit) -> unit
+
+(* Insert a new breakpoint in lists. *)
+val new_breakpoint : Events.code_event -> unit
+
+(* Remove a breakpoint from lists. *)
+val remove_breakpoint : breakpoint_id -> unit
+
+val remove_all_breakpoints : unit -> unit
+
+(*** Temporary breakpoints. ***)
+
+(* Temporary breakpoint position. *)
+val temporary_breakpoint_position : Debugcom.pc option ref
+
+(* Execute `funct' with a breakpoint added at `pc'. *)
+(* --- Used by `finish'. *)
+val exec_with_temporary_breakpoint : Debugcom.pc -> (unit -> unit) -> unit
diff --git a/debugger/checkpoints.ml b/debugger/checkpoints.ml
new file mode 100644
index 00000000..b7896140
--- /dev/null
+++ b/debugger/checkpoints.ml
@@ -0,0 +1,90 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(*************************** Checkpoints *******************************)
+
+open Int64ops
+open Debugcom
+open Primitives
+
+(*** A type for checkpoints. ***)
+
+type checkpoint_state =
+    C_stopped
+  | C_running of int64
+
+(* `c_valid' is true if and only if the corresponding
+ * process is connected to the debugger.
+ * `c_parent' is the checkpoint whose process is parent
+ * of the checkpoint one (`root' if no parent).
+ * c_pid = -2 for root pseudo-checkpoint.
+ * c_pid =  0 for ghost checkpoints.
+ * c_pid = -1 for kill checkpoints.
+ *)
+type checkpoint = {
+  mutable c_time : int64;
+  mutable c_pid : int;
+  mutable c_fd : io_channel;
+  mutable c_valid : bool;
+  mutable c_report : report option;
+  mutable c_state : checkpoint_state;
+  mutable c_parent : checkpoint;
+  mutable c_breakpoint_version : int;
+  mutable c_breakpoints : (pc * int ref) list;
+  mutable c_trap_barrier : int;
+  mutable c_code_fragments : int list
+  }
+
+(*** Pseudo-checkpoint `root'. ***)
+(* --- Parents of all checkpoints which have no parent. *)
+let rec root = {
+  c_time = _0;
+  c_pid = -2;
+  c_fd = std_io;
+  c_valid = false;
+  c_report = None;
+  c_state = C_stopped;
+  c_parent = root;
+  c_breakpoint_version = 0;
+  c_breakpoints = [];
+  c_trap_barrier = 0;
+  c_code_fragments = [0]
+  }
+
+(*** Current state ***)
+let checkpoints =
+  ref ([] : checkpoint list)
+
+let current_checkpoint =
+  ref root
+
+let current_time () =
+  !current_checkpoint.c_time
+
+let current_report () =
+  !current_checkpoint.c_report
+
+let current_pc_sp () =
+  (* This pattern matching mimics the test used in debugger.c for
+     deciding whether or not PC/SP should be sent with the report.
+     See debugger.c, the [if] statement above the [command_loop]
+     label. *)
+  match current_report () with
+  | Some {rep_type = Event | Breakpoint;
+          rep_program_pointer = pc; rep_stack_pointer = sp } -> Some (pc, sp)
+  | _ -> None
+
+let current_pc () = Option.map fst (current_pc_sp ())
diff --git a/debugger/checkpoints.mli b/debugger/checkpoints.mli
new file mode 100644
index 00000000..d02240ee
--- /dev/null
+++ b/debugger/checkpoints.mli
@@ -0,0 +1,60 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(***************************** Checkpoints *****************************)
+
+open Primitives
+open Debugcom
+
+(*** A type for checkpoints. ***)
+
+type checkpoint_state =
+    C_stopped
+  | C_running of int64
+
+(* `c_valid' is true if and only if the corresponding
+ * process is connected to the debugger.
+ * `c_parent' is the checkpoint whose process is parent
+ * of the checkpoint one (`root' if no parent).
+ * c_pid =  2 for root pseudo-checkpoint.
+ * c_pid =  0 for ghost checkpoints.
+ * c_pid = -1 for kill checkpoints.
+ *)
+type checkpoint =
+  {mutable c_time : int64;
+   mutable c_pid : int;
+   mutable c_fd : io_channel;
+   mutable c_valid : bool;
+   mutable c_report : report option;
+   mutable c_state : checkpoint_state;
+   mutable c_parent : checkpoint;
+   mutable c_breakpoint_version : int;
+   mutable c_breakpoints : (pc * int ref) list;
+   mutable c_trap_barrier : int;
+   mutable c_code_fragments : int list}
+
+(*** Pseudo-checkpoint `root'. ***)
+(* --- Parents of all checkpoints which have no parent. *)
+val root : checkpoint
+
+(*** Current state ***)
+val checkpoints : checkpoint list ref
+val current_checkpoint : checkpoint ref
+
+val current_time : unit -> int64
+val current_report : unit -> report option
+val current_pc : unit -> pc option
+val current_pc_sp : unit -> (pc * int) option
diff --git a/debugger/command_line.ml b/debugger/command_line.ml
new file mode 100644
index 00000000..3884c3aa
--- /dev/null
+++ b/debugger/command_line.ml
@@ -0,0 +1,1241 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(************************ Reading and executing commands ***************)
+
+open Int64ops
+open Format
+open Instruct
+open Unix
+open Debugger_config
+open Types
+open Primitives
+open Unix_tools
+open Debugger_parser
+open Parser_aux
+open Debugger_lexer
+open Input_handling
+open Question
+open Debugcom
+open Program_loading
+open Program_management
+open Lexing
+open Parameters
+open Show_source
+open Show_information
+open Time_travel
+open Events
+open Symbols
+open Source
+open Breakpoints
+open Checkpoints
+open Frames
+open Printval
+
+module Lexer = Debugger_lexer
+
+(** Instructions, variables and infos lists. **)
+type dbg_instruction =
+  { instr_name: string;                 (* Name of command *)
+    instr_prio: bool;                   (* Has priority *)
+    instr_action: formatter -> lexbuf -> unit;
+                                        (* What to do *)
+    instr_repeat: bool;                 (* Can be repeated *)
+    instr_help: string }                (* Help message *)
+
+let instruction_list = ref ([] : dbg_instruction list)
+
+type dbg_variable =
+  { var_name: string;                   (* Name of variable *)
+    var_action: (lexbuf -> unit) * (formatter -> unit);
+                                        (* Reading, writing fns *)
+    var_help: string }                  (* Help message *)
+
+let variable_list = ref ([] : dbg_variable list)
+
+type dbg_info =
+  { info_name: string;                  (* Name of info *)
+    info_action: lexbuf -> unit;        (* What to do *)
+    info_help: string }                 (* Help message *)
+
+let info_list = ref ([] : dbg_info list)
+
+(** Utilities. **)
+let error text =
+  eprintf "%s@." text;
+  raise Toplevel
+
+let check_not_windows feature =
+  match Sys.os_type with
+  | "Win32" ->
+      error ("\'"^feature^"\' feature not supported on Windows")
+  | _ ->
+      ()
+
+let eol =
+  end_of_line Lexer.lexeme
+
+let matching_elements list name instr =
+  List.filter (function a -> isprefix instr (name a)) !list
+
+let all_matching_instructions =
+  matching_elements instruction_list (fun i -> i.instr_name)
+
+(* itz 04-21-96 don't do priority completion in emacs mode *)
+(* XL 25-02-97 why? I find it very confusing. *)
+
+let matching_instructions instr =
+  let all = all_matching_instructions instr in
+  let prio = List.filter (fun i -> i.instr_prio) all in
+  if prio = [] then all else prio
+
+let matching_variables =
+  matching_elements variable_list (fun v -> v.var_name)
+
+let matching_infos =
+  matching_elements info_list (fun i -> i.info_name)
+
+let find_ident name matcher action alternative ppf lexbuf =
+  match identifier_or_eol Lexer.lexeme lexbuf with
+  | None -> alternative ppf
+  | Some ident ->
+      match matcher ident with
+      | [] -> error ("Unknown " ^ name ^ ".")
+      | [a] -> action a ppf lexbuf
+      | _ -> error ("Ambiguous " ^ name ^ ".")
+
+let find_variable action alternative ppf lexbuf =
+  find_ident "variable name" matching_variables action alternative ppf lexbuf
+
+let find_info action alternative ppf lexbuf =
+  find_ident "info command" matching_infos action alternative ppf lexbuf
+
+let add_breakpoint_at_pc pc =
+  try
+    new_breakpoint (any_event_at_pc pc)
+  with
+  | Not_found ->
+    eprintf "Can\'t add breakpoint at pc %i:%i: no event there.@."
+            pc.frag pc.pos;
+    raise Toplevel
+
+let add_breakpoint_after_pc pc =
+  let rec try_add n =
+    if n < 3 then begin
+      try
+        new_breakpoint (any_event_at_pc {pc with pos = pc.pos + n * 4})
+      with
+      | Not_found ->
+        try_add (n+1)
+    end else begin
+      error
+        "Can\'t add breakpoint at beginning of function: no event there"
+    end
+  in try_add 0
+
+let module_of_longident id =
+  match id with
+  | Some x -> Some (String.concat "." (Longident.flatten x))
+  | None -> None
+
+let convert_module mdle =
+  match mdle with
+  | Some m ->
+      (* Strip .ml extension if any, and capitalize *)
+      String.capitalize_ascii(if Filename.check_suffix m ".ml"
+                              then Filename.chop_suffix m ".ml"
+                              else m)
+  | None ->
+      try (get_current_event ()).ev_ev.ev_module
+      with Not_found -> error "Not in a module."
+
+(** Toplevel. **)
+let current_line = ref ""
+
+let interprete_line ppf line =
+  current_line := line;
+  let lexbuf = Lexing.from_string line in
+    try
+      match identifier_or_eol Lexer.lexeme lexbuf with
+      | Some x ->
+          begin match matching_instructions x with
+          | [] ->
+              error "Unknown command."
+          | [i] ->
+              i.instr_action ppf lexbuf;
+              resume_user_input ();
+              i.instr_repeat
+          | _ ->
+              error "Ambiguous command."
+          end
+      | None ->
+          resume_user_input ();
+          false
+    with
+    | Parsing.Parse_error ->
+        error "Syntax error."
+    | Lexer.Int_overflow ->
+      error "Integer overflow"
+
+let line_loop ppf line_buffer =
+  resume_user_input ();
+  let previous_line = ref "" in
+    try
+      while true do
+        if !loaded then
+          History.add_current_time ();
+        let new_line = string_trim (line line_buffer) in
+          let line =
+            if new_line <> "" then
+              new_line
+            else
+              !previous_line
+          in
+            previous_line := "";
+            if interprete_line ppf line then
+              previous_line := line
+      done
+    with
+    | Exit ->
+        ()
+(*    | Sys_error s ->
+        error ("System error: " ^ s) *)
+
+(** Instructions. **)
+let instr_cd _ppf lexbuf =
+  let dir = argument_eol argument lexbuf in
+    if ask_kill_program () then
+      try
+        Sys.chdir (expand_path dir)
+      with
+      | Sys_error s ->
+          error s
+
+let instr_shell _ppf lexbuf =
+  let cmdarg = argument_list_eol argument lexbuf in
+  let cmd = String.concat " " cmdarg in
+  (* perhaps we should use $SHELL -c ? *)
+  let err = Sys.command cmd in
+  if (err != 0) then
+    eprintf "Shell command %S failed with exit code %d\n%!" cmd err
+
+let instr_env _ppf lexbuf =
+  let cmdarg = argument_list_eol argument lexbuf in
+  let cmdarg = string_trim (String.concat " " cmdarg) in
+  if cmdarg <> "" then
+    if ask_kill_program () then begin
+      try
+        let eqpos = String.index cmdarg '=' in
+        if eqpos = 0 then raise Not_found;
+        let name = String.sub cmdarg 0 eqpos in
+        let value =
+          String.sub cmdarg (eqpos + 1) (String.length cmdarg - eqpos - 1)
+        in
+        Debugger_config.environment :=
+          (name, value) :: List.remove_assoc name !Debugger_config.environment
+      with Not_found ->
+        eprintf "Environment variable must be in name=value format\n%!"
+    end
+  else
+    List.iter
+      (fun (vvar, vval) -> printf "%s=%s\n%!" vvar vval)
+      (List.rev !Debugger_config.environment)
+
+let instr_pwd ppf lexbuf =
+  eol lexbuf;
+  fprintf ppf "%s@." (Sys.getcwd ())
+
+let instr_dir ppf lexbuf =
+  let new_directory = argument_list_eol argument lexbuf in
+    if new_directory = [] then begin
+      if yes_or_no "Reinitialize directory list" then begin
+        Load_path.init !default_load_path;
+        Envaux.reset_cache ();
+        Hashtbl.clear Debugger_config.load_path_for;
+        flush_buffer_list ()
+        end
+      end
+    else begin
+      let new_directory' = List.rev new_directory in
+      match new_directory' with
+      | mdl :: for_keyw :: tl
+        when String.lowercase_ascii for_keyw = "for" && List.length tl > 0 ->
+          List.iter (function x -> add_path_for mdl (expand_path x)) tl
+      | _ ->
+          List.iter (function x -> add_path (expand_path x)) new_directory'
+    end;
+    let print_dirs ppf l = List.iter (function x -> fprintf ppf "@ %s" x) l in
+    fprintf ppf "@[<2>Directories: %a@]@." print_dirs (Load_path.get_paths ());
+    Hashtbl.iter
+      (fun mdl dirs ->
+         fprintf ppf "@[<2>Source directories for %s: %a@]@." mdl print_dirs
+                 dirs)
+      Debugger_config.load_path_for
+
+let instr_kill _ppf lexbuf =
+  eol lexbuf;
+  if not !loaded then error "The program is not being run.";
+  if (yes_or_no "Kill the program being debugged") then begin
+    kill_program ();
+    show_no_point()
+  end
+
+let instr_pid ppf lexbuf =
+  eol lexbuf;
+  if not !loaded then error "The program is not being run.";
+  fprintf ppf "@[%d@]@." !current_checkpoint.c_pid
+
+let instr_run ppf lexbuf =
+  eol lexbuf;
+  ensure_loaded ();
+  reset_named_values ();
+  run ();
+  show_current_event ppf
+
+let instr_reverse ppf lexbuf =
+  eol lexbuf;
+  check_not_windows "reverse";
+  ensure_loaded ();
+  reset_named_values();
+  back_run ();
+  show_current_event ppf
+
+let instr_step ppf lexbuf =
+  let step_count =
+    match opt_signed_int64_eol Lexer.lexeme lexbuf with
+    | None -> _1
+    | Some x -> x
+  in
+    ensure_loaded ();
+    reset_named_values();
+    step step_count;
+    show_current_event ppf
+
+let instr_back ppf lexbuf =
+  let step_count =
+    match opt_signed_int64_eol Lexer.lexeme lexbuf with
+    | None -> _1
+    | Some x -> x
+  in
+    check_not_windows "backstep";
+    ensure_loaded ();
+    reset_named_values();
+    step (_0 -- step_count);
+    show_current_event ppf
+
+let instr_finish ppf lexbuf =
+  eol lexbuf;
+  ensure_loaded ();
+  reset_named_values();
+  finish ();
+  show_current_event ppf
+
+let instr_next ppf lexbuf =
+  let step_count =
+    match opt_integer_eol Lexer.lexeme lexbuf with
+    | None -> 1
+    | Some x -> x
+  in
+    ensure_loaded ();
+    reset_named_values();
+    next step_count;
+    show_current_event ppf
+
+let instr_start ppf lexbuf =
+  eol lexbuf;
+  check_not_windows "start";
+  ensure_loaded ();
+  reset_named_values();
+  start ();
+  show_current_event ppf
+
+let instr_previous ppf lexbuf =
+  let step_count =
+    match opt_integer_eol Lexer.lexeme lexbuf with
+    | None -> 1
+    | Some x -> x
+  in
+    check_not_windows "previous";
+    ensure_loaded ();
+    reset_named_values();
+    previous step_count;
+    show_current_event ppf
+
+let instr_goto ppf lexbuf =
+  let time = int64_eol Lexer.lexeme lexbuf in
+    ensure_loaded ();
+    reset_named_values();
+    go_to time;
+    show_current_event ppf
+
+let instr_quit _ =
+  raise Exit
+
+let print_variable_list ppf =
+  let pr_vars ppf = List.iter (fun v -> fprintf ppf "%s@ " v.var_name) in
+  fprintf ppf "List of variables: %a@." pr_vars !variable_list
+
+let print_info_list ppf =
+  let pr_infos ppf = List.iter (fun i -> fprintf ppf "%s@ " i.info_name)  in
+  fprintf ppf "List of info commands: %a@." pr_infos !info_list
+
+let instr_complete _ppf lexbuf =
+  let ppf = Format.err_formatter in
+  let rec print_list l =
+    try
+      eol lexbuf;
+      List.iter (function i -> fprintf ppf "%s@." i) l
+    with _ ->
+      remove_file !user_channel
+  and match_list lexbuf =
+    match identifier_or_eol Lexer.lexeme lexbuf with
+    | None ->
+        List.map (fun i -> i.instr_name) !instruction_list
+    | Some x ->
+        match matching_instructions x with
+        | [ {instr_name = ("set" | "show" as i_full)} ] ->
+            if x = i_full then begin
+              match identifier_or_eol Lexer.lexeme lexbuf with
+              | Some ident ->
+                  begin match matching_variables ident with
+                  | [v] -> if v.var_name = ident then [] else [v.var_name]
+                  | l   -> List.map (fun v -> v.var_name) l
+                  end
+              | None ->
+                  List.map (fun v -> v.var_name) !variable_list
+            end
+            else [i_full]
+        | [ {instr_name = "info"} ] ->
+            if x = "info" then begin
+              match identifier_or_eol Lexer.lexeme lexbuf with
+              | Some ident ->
+                  begin match matching_infos ident with
+                  | [i] -> if i.info_name = ident then [] else [i.info_name]
+                  | l   -> List.map (fun i -> i.info_name) l
+                  end
+              | None ->
+                  List.map (fun i -> i.info_name) !info_list
+            end
+            else ["info"]
+        | [ {instr_name = "help"} ] ->
+            if x = "help" then match_list lexbuf else ["help"]
+        | [ i ] ->
+            if x = i.instr_name then [] else [i.instr_name]
+        | l ->
+            List.map (fun i -> i.instr_name) l
+  in
+    print_list(match_list lexbuf)
+
+let instr_help ppf lexbuf =
+  let pr_instrs ppf =
+      List.iter (fun i -> fprintf ppf "%s@ " i.instr_name) in
+  match identifier_or_eol Lexer.lexeme lexbuf with
+  | Some x ->
+      let print_help nm hlp =
+        eol lexbuf;
+        fprintf ppf "%s: %s@." nm hlp in
+      begin match matching_instructions x with
+      | [] ->
+          eol lexbuf;
+          fprintf ppf "No matching command.@."
+      | [ {instr_name = "set"} ] ->
+          find_variable
+            (fun v _ _ ->
+               print_help ("set " ^ v.var_name) ("set " ^ v.var_help))
+            (fun ppf ->
+               print_help "set" "set debugger variable.";
+               print_variable_list ppf)
+            ppf
+            lexbuf
+      | [ {instr_name = "show"} ] ->
+          find_variable
+            (fun v _ _ ->
+               print_help ("show " ^ v.var_name) ("show " ^ v.var_help))
+            (fun _v ->
+               print_help "show" "display debugger variable.";
+               print_variable_list ppf)
+            ppf
+            lexbuf
+      | [ {instr_name = "info"} ] ->
+          find_info
+            (fun i _ _ -> print_help ("info " ^ i.info_name) i.info_help)
+            (fun ppf ->
+               print_help "info"
+                 "display infos about the program being debugged.";
+               print_info_list ppf)
+            ppf
+            lexbuf
+      | [i] ->
+          print_help i.instr_name i.instr_help
+      | l ->
+          eol lexbuf;
+          fprintf ppf "Ambiguous command \"%s\": %a@." x pr_instrs l
+      end
+  | None ->
+      fprintf ppf "List of commands: %a@." pr_instrs !instruction_list
+
+(* Printing values *)
+
+let print_expr depth ev env ppf expr =
+  try
+    let (v, ty) = Eval.expression ev env expr in
+    print_named_value depth expr env v ppf ty
+  with
+  | Eval.Error msg ->
+    Eval.report_error ppf msg;
+    raise Toplevel
+
+let env_of_event =
+  function
+    None    -> Env.empty
+  | Some ev ->
+      Envaux.env_from_summary ev.ev_ev.ev_typenv ev.ev_ev.ev_typsubst
+
+let print_command depth ppf lexbuf =
+  let exprs = expression_list_eol Lexer.lexeme lexbuf in
+  ensure_loaded ();
+  let env =
+    try
+      env_of_event !selected_event
+    with
+    | Envaux.Error msg ->
+        Envaux.report_error ppf msg;
+        raise Toplevel
+  in
+  List.iter (print_expr depth !selected_event env ppf) exprs
+
+let instr_print ppf lexbuf = print_command !max_printer_depth ppf lexbuf
+
+let instr_display ppf lexbuf = print_command 1 ppf lexbuf
+
+let instr_address ppf lexbuf =
+  let exprs = expression_list_eol Lexer.lexeme lexbuf in
+  ensure_loaded ();
+  let env =
+    try
+      env_of_event !selected_event
+    with
+    | Envaux.Error msg ->
+        Envaux.report_error ppf msg;
+        raise Toplevel
+  in
+  let print_addr expr =
+    let (v, _ty) =
+      try Eval.expression !selected_event env expr
+      with Eval.Error msg ->
+        Eval.report_error ppf msg;
+        raise Toplevel
+    in
+    match Remote_value.pointer v with
+    | "" -> fprintf ppf "[not a remote value]@."
+    | s -> fprintf ppf "0x%s@." s
+  in
+  List.iter print_addr exprs
+
+(* Loading of command files *)
+
+let extract_filename arg =
+  (* Allow enclosing filename in quotes *)
+  let l = String.length arg in
+  let pos1 = if l > 0 && arg.[0] = '\"' then 1 else 0 in
+  let pos2 = if l > 0 && arg.[l-1] = '\"' then l-1 else l in
+  String.sub arg pos1 (pos2 - pos1)
+
+let instr_source ppf lexbuf =
+  let file = extract_filename(argument_eol argument lexbuf)
+  and old_state = !interactif
+  and old_channel = !user_channel in
+    let io_chan =
+      try
+        io_channel_of_descr
+          (openfile (Load_path.find (expand_path file))
+             [O_RDONLY] 0)
+      with
+      | Not_found -> error "Source file not found."
+      | (Unix_error _) as x  -> Unix_tools.report_error x; raise Toplevel
+    in
+      interactif := false;
+      user_channel := io_chan;
+      let loop () =
+        line_loop ppf (Lexing.from_function read_user_input)
+      and finally () =
+        stop_user_input ();
+        close_io io_chan;
+        interactif := old_state;
+        user_channel := old_channel
+      in
+      Fun.protect ~finally loop
+
+let instr_set =
+  find_variable
+    (fun {var_action = (funct, _)} _ppf lexbuf -> funct lexbuf)
+    (function _ppf -> error "Argument required.")
+
+let instr_show =
+  find_variable
+    (fun {var_action = (_, funct)} ppf lexbuf -> eol lexbuf; funct ppf)
+    (function ppf ->
+       List.iter
+         (function {var_name = nm; var_action = (_, funct)} ->
+              fprintf ppf "%s: " nm;
+              funct ppf)
+         !variable_list)
+
+let instr_info =
+  find_info
+    (fun i _ppf lexbuf -> i.info_action lexbuf)
+    (function _ppf ->
+       error "\"info\" must be followed by the name of an info command.")
+
+let instr_break ppf lexbuf =
+  let argument = break_argument_eol Lexer.lexeme lexbuf in
+    ensure_loaded ();
+    match argument with
+    |  BA_none ->                                (* break *)
+        (match !selected_event with
+         | Some ev ->
+             new_breakpoint ev
+         | None ->
+             error "Can\'t add breakpoint at this point.")
+    | BA_pc {frag; pos} ->                      (* break PC *)
+        add_breakpoint_at_pc {frag; pos}
+    | BA_function expr ->                       (* break FUNCTION *)
+        let env =
+          try
+            env_of_event !selected_event
+          with
+          | Envaux.Error msg ->
+              Envaux.report_error ppf msg;
+              raise Toplevel
+        in
+        begin try
+          let (v, ty) = Eval.expression !selected_event env expr in
+          match (Ctype.repr ty).desc with
+          | Tarrow _ ->
+              add_breakpoint_after_pc (Remote_value.closure_code v)
+          | _ ->
+              eprintf "Not a function.@.";
+              raise Toplevel
+        with
+        | Eval.Error msg ->
+            Eval.report_error ppf msg;
+            raise Toplevel
+        end
+    | BA_pos1 (mdle, line, column) ->         (* break @ [MODULE] LINE [COL] *)
+        let module_name = convert_module (module_of_longident mdle) in
+        new_breakpoint
+          (try
+            let ev =  event_at_pos module_name 0 in
+            let ev_pos =
+              {Lexing.dummy_pos with
+               pos_fname = (Events.get_pos ev.ev_ev).pos_fname} in
+             let buffer =
+               try get_buffer ev_pos module_name with
+               | Not_found ->
+                  eprintf "No source file for %s.@." module_name;
+                  raise Toplevel
+             in
+             match column with
+             | None ->
+                 event_at_pos module_name (fst (pos_of_line buffer line))
+             | Some col ->
+                 event_near_pos module_name (point_of_coord buffer line col)
+           with
+           | Not_found -> (* event_at_pos / event_near pos *)
+               eprintf "Can\'t find any event there.@.";
+               raise Toplevel
+           | Out_of_range -> (* pos_of_line / point_of_coord *)
+               eprintf "Position out of range.@.";
+               raise Toplevel)
+    | BA_pos2 (mdle, position) ->             (* break @ [MODULE] # POSITION *)
+        try
+          new_breakpoint
+            (event_near_pos (convert_module (module_of_longident mdle))
+                            position)
+        with
+        | Not_found ->
+            eprintf "Can\'t find any event there.@."
+
+let instr_delete _ppf lexbuf =
+  match integer_list_eol Lexer.lexeme lexbuf with
+  | [] ->
+      if breakpoints_count () <> 0 && yes_or_no "Delete all breakpoints"
+      then remove_all_breakpoints ()
+  | breakpoints ->
+      List.iter
+        (function x -> try remove_breakpoint x with | Not_found -> ())
+        breakpoints
+
+let instr_frame ppf lexbuf =
+  let frame_number =
+    match opt_integer_eol Lexer.lexeme lexbuf with
+    | None -> !current_frame
+    | Some x -> x
+  in
+    ensure_loaded ();
+    try
+      select_frame frame_number;
+      show_current_frame ppf true
+    with
+    | Not_found ->
+        error ("No frame number " ^ Int.to_string frame_number ^ ".")
+
+let instr_backtrace ppf lexbuf =
+  let number =
+    match opt_signed_integer_eol Lexer.lexeme lexbuf with
+    | None -> 0
+    | Some x -> x in
+  ensure_loaded ();
+  match current_report() with
+  | None | Some {rep_type = Exited | Uncaught_exc | Code_loaded _} -> ()
+  | Some _ ->
+      let frame_counter = ref 0 in
+      let print_frame first_frame last_frame = function
+      | None ->
+          fprintf ppf
+           "(Encountered a function with no debugging information)@.";
+          false
+      | Some event ->
+          if !frame_counter >= first_frame then
+            show_one_frame !frame_counter ppf event;
+          incr frame_counter;
+          if !frame_counter >= last_frame then begin
+            fprintf ppf "(More frames follow)@."
+          end;
+          !frame_counter < last_frame in
+      fprintf ppf "Backtrace:@.";
+      if number = 0 then
+        do_backtrace (print_frame 0 max_int)
+      else if number > 0 then
+        do_backtrace (print_frame 0 number)
+      else begin
+        let num_frames = stack_depth() in
+        if num_frames < 0 then
+          fprintf ppf
+            "(Encountered a function with no debugging information)@."
+        else
+          do_backtrace (print_frame (num_frames + number) max_int)
+      end
+
+let instr_up ppf lexbuf =
+  let offset =
+    match opt_signed_integer_eol Lexer.lexeme lexbuf with
+    | None -> 1
+    | Some x -> x
+  in
+    ensure_loaded ();
+    try
+      select_frame (!current_frame + offset);
+      show_current_frame ppf true
+    with
+    | Not_found -> error "No such frame."
+
+let instr_down ppf lexbuf =
+  let offset =
+    match opt_signed_integer_eol Lexer.lexeme lexbuf with
+    | None -> 1
+    | Some x -> x
+  in
+    ensure_loaded ();
+    try
+      select_frame (!current_frame - offset);
+      show_current_frame ppf true
+    with
+    | Not_found -> error "No such frame."
+
+let instr_last ppf lexbuf =
+  let count =
+    match opt_signed_int64_eol Lexer.lexeme lexbuf with
+    | None -> _1
+    | Some x -> x
+  in
+    check_not_windows "last";
+    reset_named_values();
+    go_to (History.previous_time count);
+    show_current_event ppf
+
+let instr_list _ppf lexbuf =
+  let (mo, beg, e) = list_arguments_eol Lexer.lexeme lexbuf in
+    let (curr_mod, line, column) =
+      try
+        selected_point ()
+      with
+      | Not_found ->
+          ("", -1, -1)
+    in
+      let mdle =
+        match mo with
+        | None -> curr_mod
+        | _ -> convert_module (module_of_longident mo)
+      in
+      let pos = Lexing.dummy_pos in
+      let buffer =
+        try get_buffer pos mdle with
+        | Not_found -> error ("No source file for " ^ mdle ^ ".") in
+      let point =
+        if column <> -1 then
+          try
+            (point_of_coord buffer line 1) + column
+          with Out_of_range ->
+            -1
+        else
+          -1 in
+        let beginning =
+          match beg with
+          | None when (mo <> None) || (line = -1) ->
+              1
+          | None ->
+              begin try
+                max 1 (line - 10)
+              with Out_of_range ->
+                1
+              end
+          | Some x -> x
+        in
+          let en =
+            match e with
+            | None -> beginning + 20
+            | Some x -> x
+          in
+            if mdle = curr_mod then
+              show_listing pos mdle beginning en point
+                (current_event_is_before ())
+            else
+              show_listing pos mdle beginning en (-1) true
+
+(** Variables. **)
+let raw_variable kill name =
+  (function lexbuf ->
+     let argument = argument_eol argument lexbuf in
+       if (not kill) || ask_kill_program () then name := argument),
+  function ppf -> fprintf ppf "%s@." !name
+
+let raw_line_variable kill name =
+  (function lexbuf ->
+     let argument = argument_eol line_argument lexbuf in
+       if (not kill) || ask_kill_program () then name := argument),
+  function ppf -> fprintf ppf "%s@." !name
+
+let integer_variable kill min msg name =
+  (function lexbuf ->
+     let argument = integer_eol Lexer.lexeme lexbuf in
+       if argument < min then print_endline msg
+       else if (not kill) || ask_kill_program () then name := argument),
+  function ppf -> fprintf ppf "%i@." !name
+
+let int64_variable kill min msg name =
+  (function lexbuf ->
+     let argument = int64_eol Lexer.lexeme lexbuf in
+       if argument < min then print_endline msg
+       else if (not kill) || ask_kill_program () then name := argument),
+  function ppf -> fprintf ppf "%Li@." !name
+
+let boolean_variable kill name =
+  (function lexbuf ->
+     let argument =
+       match identifier_eol Lexer.lexeme lexbuf with
+       | "on" -> true
+       | "of" | "off" -> false
+       | _ -> error "Syntax error."
+     in
+       if (not kill) || ask_kill_program () then name := argument),
+  function ppf -> fprintf ppf "%s@." (if !name then "on" else "off")
+
+let path_variable kill name =
+  (function lexbuf ->
+       let argument = argument_eol argument lexbuf in
+         if (not kill) || ask_kill_program () then
+           name := make_absolute (expand_path argument)),
+  function ppf -> fprintf ppf "%s@." !name
+
+let loading_mode_variable ppf =
+  (find_ident
+     "loading mode"
+     (matching_elements (ref loading_modes) fst)
+     (fun (_, mode) _ppf lexbuf ->
+        eol lexbuf; set_launching_function mode)
+     (function _ppf -> error "Syntax error.")
+     ppf),
+  function ppf ->
+    let rec find = function
+      | [] -> ()
+      | (name, funct) :: l ->
+          if funct == !launching_func then fprintf ppf "%s" name else find l
+    in
+      find loading_modes;
+      fprintf ppf "@."
+
+let follow_fork_variable =
+  (function lexbuf ->
+     let mode =
+       match identifier_eol Lexer.lexeme lexbuf with
+       | "child" -> Fork_child
+       | "parent" -> Fork_parent
+       | _ -> error "Syntax error."
+     in
+       fork_mode := mode;
+       if !loaded then update_follow_fork_mode ()),
+  function ppf ->
+    fprintf ppf "%s@."
+      (match !fork_mode with
+         Fork_child -> "child"
+       | Fork_parent -> "parent")
+
+(** Infos. **)
+
+let pr_modules ppf mods =
+ let pr_mods ppf = List.iter (function x -> fprintf ppf "%s@ " x) in
+ fprintf ppf "Used modules: @.%a@?" pr_mods mods
+
+let info_modules ppf lexbuf =
+  eol lexbuf;
+  ensure_loaded ();
+  pr_modules ppf !modules
+(********
+  print_endline "Opened modules: ";
+  if !opened_modules_names = [] then
+    print_endline "(no module opened)."
+  else
+    (List.iter (function x -> print_string x;print_space) !opened_modules_names;
+     print_newline ())
+*********)
+
+let info_checkpoints ppf lexbuf =
+  eol lexbuf;
+  if !checkpoints = [] then fprintf ppf "No checkpoint.@."
+  else
+    (if !debug_breakpoints then
+       (prerr_endline "               Time   Pid Version";
+        List.iter
+          (function
+             {c_time = time; c_pid = pid; c_breakpoint_version = version} ->
+               Printf.printf "%19Ld %5d %d\n" time pid version)
+          !checkpoints)
+     else
+       (print_endline "               Time   Pid";
+        List.iter
+          (function
+             {c_time = time; c_pid = pid} ->
+               Printf.printf "%19Ld %5d\n" time pid)
+          !checkpoints))
+
+let info_one_breakpoint ppf (num, ev) =
+  fprintf ppf "%3d %d:%10d  %s@." num ev.ev_frag ev.ev_ev.ev_pos
+          (Pos.get_desc ev)
+
+let info_breakpoints ppf lexbuf =
+  eol lexbuf;
+  if !breakpoints = [] then fprintf ppf "No breakpoints.@."
+  else begin
+    fprintf ppf "Num    Address  Where@.";
+    List.iter (info_one_breakpoint ppf) (List.rev !breakpoints);
+  end
+
+
+let info_events _ppf lexbuf =
+  ensure_loaded ();
+  let mdle =
+    convert_module (module_of_longident (opt_longident_eol Lexer.lexeme lexbuf))
+  in
+    print_endline ("Module: " ^ mdle);
+    print_endline "   Address  Characters        Kind      Repr.";
+    let frag, events = events_in_module mdle in
+    List.iter
+      (function ev ->
+        let start_char, end_char =
+          try
+            let buffer = get_buffer (Events.get_pos ev) ev.ev_module in
+            (snd (start_and_cnum buffer ev.ev_loc.Location.loc_start)),
+            (snd (start_and_cnum buffer ev.ev_loc.Location.loc_end))
+          with _ ->
+            ev.ev_loc.Location.loc_start.Lexing.pos_cnum,
+            ev.ev_loc.Location.loc_end.Lexing.pos_cnum in
+        Printf.printf
+           "%d:%10d %6d-%-6d  %10s %10s\n"
+           frag
+           ev.ev_pos
+           start_char
+           end_char
+           ((match ev.ev_kind with
+               Event_before   -> "before"
+             | Event_after _  -> "after"
+             | Event_pseudo   -> "pseudo")
+            ^
+            (match ev.ev_info with
+               Event_function -> "/fun"
+             | Event_return _ -> "/ret"
+             | Event_other    -> ""))
+           (match ev.ev_repr with
+              Event_none        -> ""
+            | Event_parent _    -> "(repr)"
+            | Event_child repr  -> Int.to_string !repr))
+      events
+
+(** User-defined printers **)
+
+let instr_load_printer ppf lexbuf =
+  let filename = extract_filename(argument_eol argument lexbuf) in
+  try
+    Loadprinter.loadfile ppf filename
+  with Loadprinter.Error e ->
+    Loadprinter.report_error ppf e; raise Toplevel
+
+let instr_install_printer ppf lexbuf =
+  let lid = longident_eol Lexer.lexeme lexbuf in
+  try
+    Loadprinter.install_printer ppf lid
+  with Loadprinter.Error e ->
+    Loadprinter.report_error ppf e; raise Toplevel
+
+let instr_remove_printer ppf lexbuf =
+  let lid = longident_eol Lexer.lexeme lexbuf in
+  try
+    Loadprinter.remove_printer lid
+  with Loadprinter.Error e ->
+    Loadprinter.report_error ppf e; raise Toplevel
+
+(** Initialization. **)
+let init ppf =
+  instruction_list := [
+     { instr_name = "cd"; instr_prio = false;
+       instr_action = instr_cd; instr_repeat = true; instr_help =
+"set working directory to DIR for debugger and program being debugged." };
+     { instr_name = "complete"; instr_prio = false;
+       instr_action = instr_complete; instr_repeat = false; instr_help =
+"complete word at cursor according to context. Useful for Emacs." };
+     { instr_name = "pwd"; instr_prio = false;
+       instr_action = instr_pwd; instr_repeat = true; instr_help =
+"print working directory." };
+     { instr_name = "directory"; instr_prio = false;
+       instr_action = instr_dir; instr_repeat = false; instr_help =
+"add directory DIR to beginning of search path for source and\n\
+interface files.\n\
+Forget cached info on source file locations and line positions.\n\
+With no argument, reset the search path." };
+     { instr_name = "kill"; instr_prio = false;
+       instr_action = instr_kill; instr_repeat = true; instr_help =
+"kill the program being debugged." };
+     { instr_name = "pid"; instr_prio = false;
+       instr_action = instr_pid; instr_repeat = true; instr_help =
+"print the process ID of the current active process." };
+     { instr_name = "address"; instr_prio = false;
+       instr_action = instr_address; instr_repeat = true; instr_help =
+"print the raw address of a value." };
+     { instr_name = "help"; instr_prio = false;
+       instr_action = instr_help; instr_repeat = true; instr_help =
+"print list of commands." };
+     { instr_name = "quit"; instr_prio = false;
+       instr_action = instr_quit; instr_repeat = false; instr_help =
+"exit the debugger." };
+     { instr_name = "shell"; instr_prio = false;
+       instr_action = instr_shell; instr_repeat = true; instr_help =
+"Execute a given COMMAND through the system shell." };
+     { instr_name = "environment"; instr_prio = false;
+       instr_action = instr_env; instr_repeat = false; instr_help =
+"environment variable to give to program being debugged when it is started." };
+      (* Displacements *)
+     { instr_name = "run"; instr_prio = true;
+       instr_action = instr_run; instr_repeat = true; instr_help =
+"run the program from current position." };
+     { instr_name = "reverse"; instr_prio = false;
+       instr_action = instr_reverse; instr_repeat = true; instr_help =
+"run the program backward from current position." };
+     { instr_name = "step"; instr_prio = true;
+       instr_action = instr_step; instr_repeat = true; instr_help =
+"step program until it reaches the next event.\n\
+Argument N means do this N times (or till program stops for another reason)." };
+     { instr_name = "backstep"; instr_prio = true;
+       instr_action = instr_back; instr_repeat = true; instr_help =
+"step program backward until it reaches the previous event.\n\
+Argument N means do this N times (or till program stops for another reason)." };
+     { instr_name = "goto"; instr_prio = false;
+       instr_action = instr_goto; instr_repeat = true; instr_help =
+"go to the given time." };
+     { instr_name = "finish"; instr_prio = true;
+       instr_action = instr_finish; instr_repeat = true; instr_help =
+"execute until topmost stack frame returns." };
+     { instr_name = "next"; instr_prio = true;
+       instr_action = instr_next; instr_repeat = true; instr_help =
+"step program until it reaches the next event.\n\
+Skip over function calls.\n\
+Argument N means do this N times (or till program stops for another reason)." };
+     { instr_name = "start"; instr_prio = false;
+       instr_action = instr_start; instr_repeat = true; instr_help =
+"execute backward until the current function is exited." };
+     { instr_name = "previous"; instr_prio = false;
+       instr_action = instr_previous; instr_repeat = true; instr_help =
+"step program until it reaches the previous event.\n\
+Skip over function calls.\n\
+Argument N means do this N times (or till program stops for another reason)." };
+     { instr_name = "print"; instr_prio = true;
+       instr_action = instr_print; instr_repeat = true; instr_help =
+"print value of expressions (deep printing)." };
+     { instr_name = "display"; instr_prio = true;
+       instr_action = instr_display; instr_repeat = true; instr_help =
+"print value of expressions (shallow printing)." };
+     { instr_name = "source"; instr_prio = false;
+       instr_action = instr_source; instr_repeat = true; instr_help =
+"read command from file FILE." };
+     (* 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" };
+     { instr_name = "delete"; instr_prio = false;
+       instr_action = instr_delete; instr_repeat = false; instr_help =
+"delete some breakpoints.\n\
+Arguments are breakpoint numbers with spaces in between.\n\
+To delete all breakpoints, give no argument." };
+     { instr_name = "set"; instr_prio = false;
+       instr_action = instr_set; instr_repeat = false; instr_help =
+"--unused--" };
+     { instr_name = "show"; instr_prio = false;
+       instr_action = instr_show; instr_repeat = true; instr_help =
+"--unused--" };
+     { instr_name = "info"; instr_prio = false;
+       instr_action = instr_info; instr_repeat = true; instr_help =
+"--unused--" };
+     (* Frames *)
+     { instr_name = "frame"; instr_prio = false;
+       instr_action = instr_frame; instr_repeat = true; instr_help =
+"select and print a stack frame.\n\
+With no argument, print the selected stack frame.\n\
+An argument specifies the frame to select." };
+     { instr_name = "backtrace"; instr_prio = false;
+       instr_action = instr_backtrace; instr_repeat = true; instr_help =
+"print backtrace of all stack frames, or innermost COUNT frames.\n\
+With a negative argument, print outermost -COUNT frames." };
+     { instr_name = "bt"; instr_prio = false;
+       instr_action = instr_backtrace; instr_repeat = true; instr_help =
+"print backtrace of all stack frames, or innermost COUNT frames.\n\
+With a negative argument, print outermost -COUNT frames." };
+     { instr_name = "up"; instr_prio = false;
+       instr_action = instr_up; instr_repeat = true; instr_help =
+"select and print stack frame that called this one.\n\
+An argument says how many frames up to go." };
+     { instr_name = "down"; instr_prio = false;
+       instr_action = instr_down; instr_repeat = true; instr_help =
+"select and print stack frame called by this one.\n\
+An argument says how many frames down to go." };
+     { instr_name = "last"; instr_prio = true;
+       instr_action = instr_last; instr_repeat = true; instr_help =
+"go back to previous time." };
+     { instr_name = "list"; instr_prio = false;
+       instr_action = instr_list; instr_repeat = true; instr_help =
+"list the source code." };
+     (* User-defined printers *)
+     { instr_name = "load_printer"; instr_prio = false;
+       instr_action = instr_load_printer; instr_repeat = false; instr_help =
+"load in the debugger a .cmo or .cma file containing printing functions." };
+     { instr_name = "install_printer"; instr_prio = false;
+       instr_action = instr_install_printer; instr_repeat = false; instr_help =
+"use the given function for printing values of its input type.\n\
+The code for the function must have previously been loaded in the debugger\n\
+using \"load_printer\"." };
+     { instr_name = "remove_printer"; instr_prio = false;
+       instr_action = instr_remove_printer; instr_repeat = false; instr_help =
+"stop using the given function for printing values of its input type." }
+];
+  variable_list := [
+    (* variable name, (writing, reading), help reading, help writing *)
+     { var_name = "arguments";
+       var_action = raw_line_variable true arguments;
+       var_help =
+"arguments to give program being debugged when it is started." };
+     { var_name = "program";
+       var_action = path_variable true program_name;
+       var_help =
+"name of program to be debugged." };
+     { var_name = "loadingmode";
+       var_action = loading_mode_variable ppf;
+       var_help =
+"mode of loading.\n\
+It can be either:\n\
+  direct: the program is directly called by the debugger.\n\
+  runtime: the debugger execute `ocamlrun programname arguments\'.\n\
+  manual: the program is not launched by the debugger,\n\
+    but manually by the user." };
+     { var_name = "processcount";
+       var_action = integer_variable false 1 "Must be >= 1."
+                                     checkpoint_max_count;
+       var_help =
+"maximum number of process to keep." };
+     { var_name = "checkpoints";
+       var_action = boolean_variable false make_checkpoints;
+       var_help =
+"whether to make checkpoints or not." };
+     { var_name = "bigstep";
+       var_action = int64_variable false _1 "Must be >= 1."
+                                     checkpoint_big_step;
+       var_help =
+"step between checkpoints during long displacements." };
+     { var_name = "smallstep";
+       var_action = int64_variable false _1 "Must be >= 1."
+                                     checkpoint_small_step;
+       var_help =
+"step between checkpoints during small displacements." };
+     { var_name = "socket";
+       var_action = raw_variable true socket_name;
+       var_help =
+"name of the socket used by communications debugger-runtime." };
+     { var_name = "history";
+       var_action = integer_variable false 0 "" history_size;
+       var_help =
+"history size." };
+     { var_name = "print_depth";
+       var_action = integer_variable false 1 "Must be at least 1"
+                                     max_printer_depth;
+       var_help =
+"maximal depth for printing of values." };
+     { var_name = "print_length";
+       var_action = integer_variable false 1 "Must be at least 1"
+                                     max_printer_steps;
+       var_help =
+"maximal number of value nodes printed." };
+     { var_name = "follow_fork_mode";
+       var_action = follow_fork_variable;
+       var_help =
+"process to follow after forking.\n\
+It can be either :\n\
+  child: the newly created process.\n\
+  parent: the process that called fork.\n" };
+     { var_name = "break_on_load";
+       var_action = boolean_variable false break_on_load;
+       var_help =
+"whether to stop after loading new code (e.g. with Dynlink)." }];
+
+  info_list :=
+    (* info name, function, help *)
+    [{ info_name = "modules";
+       info_action = info_modules ppf;
+       info_help = "list opened modules." };
+     { info_name = "checkpoints";
+       info_action = info_checkpoints ppf;
+       info_help = "list checkpoints." };
+     { info_name = "breakpoints";
+       info_action = info_breakpoints ppf;
+       info_help = "list breakpoints." };
+     { info_name = "events";
+       info_action = info_events ppf;
+       info_help = "list events in MODULE (default is current module)." }]
+
+let _ = init std_formatter
diff --git a/debugger/command_line.mli b/debugger/command_line.mli
new file mode 100644
index 00000000..dc3a8d51
--- /dev/null
+++ b/debugger/command_line.mli
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(************************ Reading and executing commands ***************)
+
+open Lexing;;
+open Format;;
+
+val interprete_line : formatter -> string -> bool;;
+val line_loop : formatter -> lexbuf -> unit;;
diff --git a/debugger/debugcom.ml b/debugger/debugcom.ml
new file mode 100644
index 00000000..f9f8164f
--- /dev/null
+++ b/debugger/debugcom.ml
@@ -0,0 +1,359 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Low-level communication with the debuggee *)
+
+open Int64ops
+open Primitives
+
+(* The current connection with the debuggee *)
+
+let conn = ref Primitives.std_io
+
+(* Set which process the debugger follows on fork. *)
+
+type follow_fork_mode =
+    Fork_child
+  | Fork_parent
+
+let fork_mode = ref Fork_parent
+
+let update_follow_fork_mode () =
+  let a = match !fork_mode with Fork_child -> 0 | Fork_parent -> 1 in
+  output_char !conn.io_out 'K';
+  output_binary_int !conn.io_out a
+
+(* Set the current connection, and update the fork mode in case it has
+ * changed. *)
+
+let set_current_connection io_chan =
+  conn := io_chan;
+  update_follow_fork_mode ()
+
+(* Modify the program code *)
+
+type pc =
+  { frag : int;
+    pos : int; }
+
+let set_event {frag; pos} =
+  output_char !conn.io_out 'e';
+  output_binary_int !conn.io_out frag;
+  output_binary_int !conn.io_out pos
+
+let set_breakpoint {frag; pos} =
+  output_char !conn.io_out 'B';
+  output_binary_int !conn.io_out frag;
+  output_binary_int !conn.io_out pos
+
+let reset_instr {frag; pos} =
+  output_char !conn.io_out 'i';
+  output_binary_int !conn.io_out frag;
+  output_binary_int !conn.io_out pos
+
+(* Basic commands for flow control *)
+
+type execution_summary =
+    Event
+  | Breakpoint
+  | Exited
+  | Trap_barrier
+  | Uncaught_exc
+  | Debug_info of Instruct.debug_event list array
+  | Code_loaded of int
+  | Code_unloaded of int
+
+type report = {
+  rep_type : execution_summary;
+  rep_event_count : int64;
+  rep_stack_pointer : int;
+  rep_program_pointer : pc
+}
+
+type checkpoint_report =
+    Checkpoint_done of int
+  | Checkpoint_failed
+
+(* Run the debuggee for N events *)
+
+let do_go_smallint n =
+  output_char !conn.io_out 'g';
+  output_binary_int !conn.io_out n;
+  flush !conn.io_out;
+  Input_handling.execute_with_other_controller
+    Input_handling.exit_main_loop
+    !conn
+    (function () ->
+       Input_handling.main_loop ();
+       let summary =
+         match input_char !conn.io_in with
+           'e' -> Event
+         | 'b' -> Breakpoint
+         | 'x' -> Exited
+         | 's' -> Trap_barrier
+         | 'u' -> Uncaught_exc
+         | 'D' -> Debug_info (input_value !conn.io_in :
+                                Instruct.debug_event list array)
+         | 'L' -> Code_loaded (input_binary_int !conn.io_in)
+         | 'U' -> Code_unloaded (input_binary_int !conn.io_in)
+         |  c  -> Misc.fatal_error (Printf.sprintf "Debugcom.do_go %c" c)
+       in
+       let event_counter = input_binary_int !conn.io_in in
+       let stack_pos = input_binary_int !conn.io_in in
+       let frag = input_binary_int !conn.io_in in
+       let pos = input_binary_int !conn.io_in in
+       { rep_type = summary;
+         rep_event_count = Int64.of_int event_counter;
+         rep_stack_pointer = stack_pos;
+         rep_program_pointer = {frag; pos} })
+
+let rec do_go n =
+  assert (n >= _0);
+  if n > max_small_int then
+    begin match do_go_smallint max_int with
+    | { rep_type = Event } ->
+      do_go (n -- max_small_int)
+    | report ->
+      { report with
+        rep_event_count = report.rep_event_count ++ (n -- max_small_int) }
+    end
+  else
+    do_go_smallint (Int64.to_int n)
+
+(* Perform a checkpoint *)
+
+let do_checkpoint () =
+  match Sys.os_type with
+    "Win32" -> failwith "do_checkpoint"
+  | _ ->
+      output_char !conn.io_out 'c';
+      flush !conn.io_out;
+      let pid = input_binary_int !conn.io_in in
+      if pid = -1 then Checkpoint_failed else Checkpoint_done pid
+
+(* Kill the given process. *)
+let stop chan =
+  try
+    output_char chan.io_out 's';
+    flush chan.io_out
+  with
+    Sys_error _ | End_of_file -> ()
+
+(* Ask a process to wait for its child which has been killed. *)
+(* (so as to eliminate zombies). *)
+let wait_child chan =
+  try
+    output_char chan.io_out 'w'
+  with
+    Sys_error _ | End_of_file -> ()
+
+(* Move to initial frame (that of current function). *)
+(* Return stack position and current pc *)
+
+let initial_frame () =
+  output_char !conn.io_out '0';
+  flush !conn.io_out;
+  let stack_pos = input_binary_int !conn.io_in in
+  let frag = input_binary_int !conn.io_in in
+  let pos = input_binary_int !conn.io_in in
+  (stack_pos, {frag; pos})
+
+let set_initial_frame () =
+  ignore(initial_frame ())
+
+(* Move up one frame *)
+(* Return stack position and current pc.
+   If there's no frame above, return (-1, 0). *)
+
+let up_frame stacksize =
+  output_char !conn.io_out 'U';
+  output_binary_int !conn.io_out stacksize;
+  flush !conn.io_out;
+  let stack_pos = input_binary_int !conn.io_in in
+  let frag, pos =
+    if stack_pos = -1
+    then 0, 0
+    else let frag = input_binary_int !conn.io_in in
+         let pos = input_binary_int !conn.io_in in
+         frag, pos
+  in
+  (stack_pos, { frag; pos })
+
+(* Get and set the current frame position *)
+
+let get_frame () =
+  output_char !conn.io_out 'f';
+  flush !conn.io_out;
+  let stack_pos = input_binary_int !conn.io_in in
+  let frag = input_binary_int !conn.io_in in
+  let pos = input_binary_int !conn.io_in in
+  (stack_pos, {frag; pos})
+
+let set_frame stack_pos =
+  output_char !conn.io_out 'S';
+  output_binary_int !conn.io_out stack_pos
+
+(* Set the trap barrier to given stack position. *)
+
+let set_trap_barrier pos =
+  output_char !conn.io_out 'b';
+  output_binary_int !conn.io_out pos
+
+(* Handling of remote values *)
+
+let value_size = if 1 lsl 31 = 0 then 4 else 8
+
+let input_remote_value ic =
+  really_input_string ic value_size
+
+let output_remote_value ic v =
+  output_substring ic v 0 value_size
+
+exception Marshalling_error
+
+module Remote_value =
+  struct
+    type t = Remote of string | Local of Obj.t
+
+    let repr x = Local (Obj.repr x)
+
+    let obj = function
+    | Local obj -> Obj.obj obj
+    | Remote v ->
+        output_char !conn.io_out 'M';
+        output_remote_value !conn.io_out v;
+        flush !conn.io_out;
+        try
+          input_value !conn.io_in
+        with End_of_file | Failure _ ->
+          raise Marshalling_error
+
+    let is_block = function
+    | Local obj -> Obj.is_block obj
+    | Remote v -> Obj.is_block (Array.unsafe_get (Obj.magic v : Obj.t array) 0)
+
+    let tag obj =
+      if not (is_block obj) then Obj.int_tag
+      else match obj with
+      | Local obj -> Obj.tag obj
+      | Remote v ->
+          output_char !conn.io_out 'H';
+          output_remote_value !conn.io_out v;
+          flush !conn.io_out;
+          let header = input_binary_int !conn.io_in in
+          header land 0xFF
+
+    let size = function
+    | Local obj -> Obj.size obj
+    | Remote v ->
+        output_char !conn.io_out 'H';
+        output_remote_value !conn.io_out v;
+        flush !conn.io_out;
+        let header = input_binary_int !conn.io_in in
+        if header land 0xFF = Obj.double_array_tag && Sys.word_size = 32
+        then header lsr 11
+        else header lsr 10
+
+    let field v n =
+      match v with
+      | Local obj -> Local(Obj.field obj n)
+      | Remote v ->
+          output_char !conn.io_out 'F';
+          output_remote_value !conn.io_out v;
+          output_binary_int !conn.io_out n;
+          flush !conn.io_out;
+          if input_byte !conn.io_in = 0 then
+            Remote(input_remote_value !conn.io_in)
+          else begin
+            let buf = really_input_string !conn.io_in 8 in
+            let floatbuf = float n (* force allocation of a new float *) in
+            String.unsafe_blit buf 0 (Obj.magic floatbuf) 0 8;
+            Local(Obj.repr floatbuf)
+          end
+
+    let double_field v n =
+      match v with
+      | Local obj -> Obj.double_field obj n
+      | Remote v ->
+          output_char !conn.io_out 'F';
+          output_remote_value !conn.io_out v;
+          output_binary_int !conn.io_out n;
+          flush !conn.io_out;
+          if input_byte !conn.io_in = 0 then
+            raise Marshalling_error
+          else begin
+            let buf = really_input_string !conn.io_in 8 in
+            let floatbuf = float n (* force allocation of a new float *) in
+            String.unsafe_blit buf 0 (Obj.magic floatbuf) 0 8;
+            floatbuf
+          end
+
+    let double_array_tag = Obj.double_array_tag
+
+    let of_int n =
+      Local(Obj.repr n)
+
+    let local pos =
+      output_char !conn.io_out 'L';
+      output_binary_int !conn.io_out pos;
+      flush !conn.io_out;
+      Remote(input_remote_value !conn.io_in)
+
+    let from_environment pos =
+      output_char !conn.io_out 'E';
+      output_binary_int !conn.io_out pos;
+      flush !conn.io_out;
+      Remote(input_remote_value !conn.io_in)
+
+    let global pos =
+      output_char !conn.io_out 'G';
+      output_binary_int !conn.io_out pos;
+      flush !conn.io_out;
+      Remote(input_remote_value !conn.io_in)
+
+    let accu () =
+      output_char !conn.io_out 'A';
+      flush !conn.io_out;
+      Remote(input_remote_value !conn.io_in)
+
+    let closure_code = function
+    | Local _ -> assert false
+    | Remote v ->
+        output_char !conn.io_out 'C';
+        output_remote_value !conn.io_out v;
+        flush !conn.io_out;
+        let frag = input_binary_int !conn.io_in in
+        let pos = input_binary_int !conn.io_in in
+        {frag;pos}
+
+    let same rv1 rv2 =
+      match (rv1, rv2) with
+        (Local obj1, Local obj2) -> obj1 == obj2
+      | (Remote v1, Remote v2) -> v1 = v2
+           (* string equality -> equality of remote pointers *)
+      | (_, _) -> false
+
+    let pointer rv =
+      match rv with
+      | Remote v ->
+        let bytes = ref [] in
+        String.iter (fun c -> bytes := c :: !bytes) v;
+        let obytes = if Sys.big_endian then List.rev !bytes else !bytes in
+        let to_hex c = Printf.sprintf "%02x" (Char.code c) in
+        String.concat "" (List.map to_hex obytes)
+      | Local _ -> ""
+
+  end
diff --git a/debugger/debugcom.mli b/debugger/debugcom.mli
new file mode 100644
index 00000000..0b6eb30f
--- /dev/null
+++ b/debugger/debugcom.mli
@@ -0,0 +1,124 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Low-level communication with the debuggee *)
+
+type pc =
+  { frag : int;
+    pos : int; }
+
+type execution_summary =
+    Event
+  | Breakpoint
+  | Exited
+  | Trap_barrier
+  | Uncaught_exc
+  | Debug_info of Instruct.debug_event list array
+  | Code_loaded of int
+  | Code_unloaded of int
+
+type report =
+  { rep_type : execution_summary;
+    rep_event_count : int64;
+    rep_stack_pointer : int;
+    rep_program_pointer : pc }
+
+type checkpoint_report =
+    Checkpoint_done of int
+  | Checkpoint_failed
+
+type follow_fork_mode =
+    Fork_child
+  | Fork_parent
+
+(* Set the current connection with the debuggee *)
+val set_current_connection : Primitives.io_channel -> unit
+
+(* Put an event at given pc *)
+val set_event : pc -> unit
+
+(* Put a breakpoint at given pc *)
+val set_breakpoint : pc -> unit
+
+(* Remove breakpoint or event at given pc *)
+val reset_instr : pc -> unit
+
+(* Create a new checkpoint (the current process forks). *)
+val do_checkpoint : unit -> checkpoint_report
+
+(* Step N events. *)
+val do_go : int64 -> report
+
+(* Tell given process to terminate *)
+val stop :  Primitives.io_channel -> unit
+
+(* Tell given process to wait for its children *)
+val wait_child : Primitives.io_channel -> unit
+
+(* Move to initial frame (that of current function). *)
+(* Return stack position and current pc *)
+val initial_frame : unit -> int * pc
+val set_initial_frame : unit -> unit
+
+(* Get the current frame position *)
+(* Return stack position and current pc *)
+val get_frame : unit -> int * pc
+
+(* Set the current frame *)
+val set_frame : int -> unit
+
+(* Move up one frame *)
+(* Return stack position and current pc.
+   If there's no frame above, return (-1, 0). *)
+val up_frame : int -> int * pc
+
+(* Set the trap barrier to given stack position. *)
+val set_trap_barrier : int -> unit
+
+(* Set whether the debugger follow the child or the parent process on fork *)
+val fork_mode : follow_fork_mode ref
+val update_follow_fork_mode : unit -> unit
+
+(* Handling of remote values *)
+
+exception Marshalling_error
+
+module Remote_value :
+  sig
+    type t
+
+    val repr : 'a -> t
+    val obj : t -> 'a
+    val is_block : t -> bool
+    val tag : t -> int
+    val size : t -> int
+    val field : t -> int -> t
+    val double_field : t -> int -> float
+    val double_array_tag : int
+    val same : t -> t -> bool
+
+    val of_int : int -> t
+
+    val local : int -> t
+    val from_environment : int -> t
+    val global : int -> t
+    val accu : unit -> t
+    val closure_code : t -> pc
+
+    (* Returns a hexadecimal representation of the remote address,
+       or [""] if the value is local. *)
+    val pointer : t -> string
+  end
diff --git a/debugger/debugger_config.ml b/debugger/debugger_config.ml
new file mode 100644
index 00000000..9677bb0c
--- /dev/null
+++ b/debugger/debugger_config.ml
@@ -0,0 +1,90 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(**************************** Configuration file ***********************)
+
+open Int64ops
+
+exception Toplevel
+
+(*** Miscellaneous parameters. ***)
+
+(*ISO 6429 color sequences
+00      to restore default color
+01      for brighter colors
+04      for underlined text
+05      for flashing text
+30      for black foreground
+31      for red foreground
+32      for green foreground
+33      for yellow (or brown) foreground
+34      for blue foreground
+35      for purple foreground
+36      for cyan foreground
+37      for white (or gray) foreground
+40      for black background
+41      for red background
+42      for green background
+43      for yellow (or brown) background
+44      for blue background
+45      for purple background
+46      for cyan background
+47      for white (or gray) background
+let debugger_prompt   = "\027[1;04m(ocd)\027[0m "
+and event_mark_before = "\027[1;31m$\027[0m"
+and event_mark_after  = "\027[1;34m$\027[0m"
+*)
+let debugger_prompt   = "(ocd) "
+let event_mark_before = "<|b|>"
+let event_mark_after  = "<|a|>"
+
+(* Name of shell used to launch the debuggee *)
+let shell =
+  match Sys.os_type with
+    "Win32" -> "cmd"
+  | _ -> "/bin/sh"
+
+(* Name of the OCaml runtime. *)
+let runtime_program = "ocamlrun"
+
+(* Time history size (for `last') *)
+let history_size = ref 30
+
+let load_path_for = Hashtbl.create 7
+
+(*** Time travel parameters. ***)
+
+(* Step between checkpoints for long displacements.*)
+let checkpoint_big_step = ref (~~ "10000")
+
+(* Idem for small ones. *)
+let checkpoint_small_step = ref (~~ "1000")
+
+(* Maximum number of checkpoints. *)
+let checkpoint_max_count = ref 15
+
+(* Whether to keep checkpoints or not. *)
+let make_checkpoints = ref
+  (match Sys.os_type with
+    "Win32" -> false
+  | _ -> true)
+
+(* Whether to break when new code is loaded. *)
+let break_on_load = ref true
+
+(*** Environment variables for debuggee. ***)
+
+let environment = ref []
diff --git a/debugger/debugger_config.mli b/debugger/debugger_config.mli
new file mode 100644
index 00000000..9db86e93
--- /dev/null
+++ b/debugger/debugger_config.mli
@@ -0,0 +1,41 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(********************** Configuration file *****************************)
+
+exception Toplevel
+
+(*** Miscellaneous parameters. ***)
+
+val debugger_prompt : string
+val event_mark_before : string
+val event_mark_after : string
+val shell : string
+val runtime_program : string
+val history_size : int ref
+val load_path_for : (string, string list) Hashtbl.t
+
+(*** Time travel parameters. ***)
+
+val checkpoint_big_step : int64 ref
+val checkpoint_small_step : int64 ref
+val checkpoint_max_count : int ref
+val make_checkpoints : bool ref
+val break_on_load : bool ref
+
+(*** Environment variables for debuggee. ***)
+
+val environment : (string * string) list ref
diff --git a/debugger/debugger_lexer.mli b/debugger/debugger_lexer.mli
new file mode 100644
index 00000000..0c364d68
--- /dev/null
+++ b/debugger/debugger_lexer.mli
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+exception Int_overflow
+
+val line: Lexing.lexbuf -> string
+val lexeme: Lexing.lexbuf -> Debugger_parser.token
+val argument: Lexing.lexbuf -> Debugger_parser.token
+val line_argument: Lexing.lexbuf -> Debugger_parser.token
diff --git a/debugger/debugger_lexer.mll b/debugger/debugger_lexer.mll
new file mode 100644
index 00000000..a1804272
--- /dev/null
+++ b/debugger/debugger_lexer.mll
@@ -0,0 +1,104 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+{
+
+open Debugger_parser
+
+exception Int_overflow
+
+}
+
+rule line =     (* Read a whole line *)
+  parse
+    ([ ^ '\n' '\r' ]* as s) ('\n' | '\r' | "\r\n")
+      { s }
+  | [ ^ '\n' '\r' ]*
+      { Lexing.lexeme lexbuf }
+  | eof
+      { raise Exit }
+
+and argument =  (* Read a raw argument *)
+  parse
+    [ ^ ' ' '\t' ]+
+      { ARGUMENT (Lexing.lexeme lexbuf) }
+  | [' ' '\t']+
+      { argument lexbuf }
+  | eof
+      { EOL }
+  | _
+      { raise Parsing.Parse_error }
+
+and line_argument =
+  parse
+    _ *
+      { ARGUMENT (Lexing.lexeme lexbuf) }
+  | eof
+      { EOL }
+
+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' ]) *
+      { LIDENT(Lexing.lexeme lexbuf) }
+  | ['A'-'Z' '\192'-'\214' '\216'-'\222' ]
+    (['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255'
+      '\'' '0'-'9' ]) *
+      { UIDENT(Lexing.lexeme lexbuf) }
+  | '"' [^ '"']* "\""
+      { let s = Lexing.lexeme lexbuf in
+        LIDENT(String.sub s 1 (String.length s - 2)) }
+  | ['0'-'9']+
+    | '0' ['x' 'X'] ['0'-'9' 'A'-'F' 'a'-'f']+
+    | '0' ['o' 'O'] ['0'-'7']+
+    | '0' ['b' 'B'] ['0'-'1']+
+      { try INTEGER (Int64.of_string (Lexing.lexeme lexbuf))
+        with Failure _ -> raise Int_overflow
+      }
+  | '*'
+      { STAR }
+  | "-"
+      { MINUS }
+  | "."
+      { DOT }
+  | "#"
+      { HASH }
+  | "@"
+      { AT }
+  | "$"
+      { DOLLAR }
+  | ":"
+      { COLON }
+  | "!"
+      { BANG }
+  | "("
+      { LPAREN }
+  | ")"
+      { RPAREN }
+  | "["
+      { LBRACKET }
+  | "]"
+      { RBRACKET }
+  | ['!' '?' '~' '=' '<' '>' '|' '&' '$' '@' '^' '+' '-' '*' '/' '%']
+    ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] *
+      { OPERATOR (Lexing.lexeme lexbuf) }
+  | eof
+      { EOL }
+  | _
+      { raise Parsing.Parse_error }
diff --git a/debugger/debugger_parser.mly b/debugger/debugger_parser.mly
new file mode 100644
index 00000000..b8789d94
--- /dev/null
+++ b/debugger/debugger_parser.mly
@@ -0,0 +1,260 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          */
+/*           OCaml port by John Malecki and Xavier Leroy                  */
+/*                                                                        */
+/*   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.          */
+/*                                                                        */
+/**************************************************************************/
+
+%{
+
+open Int64ops
+open Input_handling
+open Longident
+open Parser_aux
+open Debugcom
+
+%}
+
+%token  ARGUMENT
+%token  LIDENT
+%token  UIDENT
+%token  OPERATOR
+%token   INTEGER
+%token          STAR                    /* *  */
+%token          MINUS                   /* -  */
+%token          DOT                     /* . */
+%token          COLON                   /* : */
+%token          HASH                    /* #  */
+%token          AT                      /* @  */
+%token          DOLLAR                  /* $ */
+%token          BANG                    /* ! */
+%token          LPAREN                  /* (  */
+%token          RPAREN                  /* )  */
+%token          LBRACKET                /* [  */
+%token          RBRACKET                /* ]  */
+%token          EOL
+
+%right DOT
+%right BANG
+
+%start argument_list_eol
+%type  argument_list_eol
+
+%start argument_eol
+%type  argument_eol
+
+%start integer_list_eol
+%type  integer_list_eol
+
+%start integer_eol
+%type  integer_eol
+
+%start int64_eol
+%type  int64_eol
+
+%start integer
+%type  integer
+
+%start opt_integer_eol
+%type  opt_integer_eol
+
+%start opt_signed_integer_eol
+%type  opt_signed_integer_eol
+
+%start opt_signed_int64_eol
+%type  opt_signed_int64_eol
+
+%start identifier
+%type  identifier
+
+%start identifier_eol
+%type  identifier_eol
+
+%start identifier_or_eol
+%type  identifier_or_eol
+
+%start opt_identifier
+%type  opt_identifier
+
+%start opt_identifier_eol
+%type  opt_identifier_eol
+
+%start expression_list_eol
+%type  expression_list_eol
+
+%start break_argument_eol
+%type  break_argument_eol
+
+%start list_arguments_eol
+%type  list_arguments_eol
+
+%start end_of_line
+%type  end_of_line
+
+%start longident_eol
+%type  longident_eol
+
+%start opt_longident
+%type  opt_longident
+
+%start opt_longident_eol
+%type  opt_longident_eol
+
+%%
+
+/* Raw arguments */
+
+argument_list_eol :
+    ARGUMENT argument_list_eol
+      { $1::$2 }
+  | end_of_line
+      { [] };
+
+argument_eol :
+    ARGUMENT end_of_line
+      { $1 };
+
+/* Integer */
+
+integer_list_eol :
+    INTEGER integer_list_eol
+      { (to_int $1) :: $2 }
+  | end_of_line
+      { [] };
+
+integer_eol :
+    INTEGER end_of_line
+      { to_int $1 };
+
+int64_eol :
+    INTEGER end_of_line
+      { $1 };
+
+integer :
+    INTEGER
+      { to_int $1 };
+
+opt_integer_eol :
+    INTEGER end_of_line
+      { Some (to_int $1) }
+  | end_of_line
+      { None };
+
+opt_int64_eol :
+    INTEGER end_of_line
+      { Some $1 }
+  | end_of_line
+      { None };
+
+opt_signed_integer_eol :
+    MINUS integer_eol
+      { Some (- $2) }
+  | opt_integer_eol
+      { $1 };
+
+opt_signed_int64_eol :
+    MINUS int64_eol
+      { Some (Int64.neg $2) }
+  | opt_int64_eol
+      { $1 };
+
+/* Identifiers and long identifiers */
+
+longident :
+    LIDENT                      { Lident $1 }
+  | module_path DOT LIDENT      { Ldot($1, $3) }
+  | OPERATOR                    { Lident $1 }
+  | module_path DOT OPERATOR    { Ldot($1, $3) }
+  | module_path DOT LPAREN OPERATOR RPAREN { Ldot($1, $4) }
+;
+
+module_path :
+    UIDENT                      { Lident $1 }
+  | module_path DOT UIDENT      { Ldot($1, $3) }
+;
+
+longident_eol :
+    longident end_of_line       { $1 };
+
+opt_longident :
+    UIDENT                      { Some (Lident $1) }
+  | LIDENT                      { Some (Lident $1) }
+  | module_path DOT UIDENT      { Some (Ldot($1, $3)) }
+  |                             { None };
+
+opt_longident_eol :
+    opt_longident end_of_line   { $1 };
+
+identifier :
+    LIDENT                      { $1 }
+  | UIDENT                      { $1 };
+
+identifier_eol :
+    identifier end_of_line      { $1 };
+
+identifier_or_eol :
+    identifier                  { Some $1 }
+  | end_of_line                 { None };
+
+opt_identifier :
+    identifier                  { Some $1 }
+  |                             { None };
+
+opt_identifier_eol :
+    opt_identifier end_of_line  { $1 };
+
+/* Expressions */
+
+expression:
+    longident                                  { E_ident $1 }
+  | STAR                                        { E_result }
+  | DOLLAR INTEGER                              { E_name (to_int $2) }
+  | expression DOT INTEGER                      { E_item($1, (to_int $3)) }
+  | expression DOT LBRACKET INTEGER RBRACKET    { E_item($1, (to_int $4)) }
+  | expression DOT LPAREN INTEGER RPAREN        { E_item($1, (to_int $4)) }
+  | expression DOT LIDENT                       { E_field($1, $3) }
+  | BANG expression                             { E_field($2, "contents") }
+  | LPAREN expression RPAREN                    { $2 }
+;
+
+/* Lists of expressions */
+
+expression_list_eol :
+    expression expression_list_eol              { $1::$2 }
+  | end_of_line                                 { [] }
+;
+
+/* Arguments for breakpoint */
+
+break_argument_eol :
+    end_of_line                                 { BA_none }
+  | integer_eol                                 { BA_pc {frag = 0; pos = $1} }
+  | INTEGER COLON integer_eol                   { BA_pc {frag = to_int $1;
+                                                         pos = $3} }
+  | expression end_of_line                      { BA_function $1 }
+  | AT opt_longident INTEGER opt_integer_eol    { BA_pos1 ($2, (to_int $3), $4)}
+  | AT opt_longident HASH integer_eol           { BA_pos2 ($2, $4) }
+;
+
+/* Arguments for list */
+
+list_arguments_eol :
+    opt_longident integer opt_integer_eol
+      { ($1, Some $2, $3) }
+  | opt_longident_eol
+      { ($1, None, None) };
+
+/* End of line */
+
+end_of_line :
+    EOL { stop_user_input () }
+;
diff --git a/debugger/dune b/debugger/dune
new file mode 100644
index 00000000..60813e0c
--- /dev/null
+++ b/debugger/dune
@@ -0,0 +1,27 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+; mshinwell: Disabled for now -- otherlibs/dynlink/dune needs fixing first.
+
+;(ocamllex lexer)
+;(ocamlyacc parser)
+;
+;(executable
+; (name main)
+; (modes byte)
+; (flags (:standard -w -9))
+; (modules_without_implementation parser_aux)
+; (libraries ocamlcommon ocamltoplevel runtime stdlib unix))
+;
+;(rule (copy main.exe ocamldebug.byte))
diff --git a/debugger/eval.ml b/debugger/eval.ml
new file mode 100644
index 00000000..240ea882
--- /dev/null
+++ b/debugger/eval.ml
@@ -0,0 +1,218 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Misc
+open Path
+open Instruct
+open Types
+open Parser_aux
+open Events
+
+type error =
+    Unbound_identifier of Ident.t
+  | Not_initialized_yet of Path.t
+  | Unbound_long_identifier of Longident.t
+  | Unknown_name of int
+  | Tuple_index of type_expr * int * int
+  | Array_index of int * int
+  | List_index of int * int
+  | String_index of string * int * int
+  | Wrong_item_type of type_expr * int
+  | Wrong_label of type_expr * string
+  | Not_a_record of type_expr
+  | No_result
+
+exception Error of error
+
+let abstract_type =
+  Btype.newgenty (Tconstr (Pident (Ident.create_local ""), [], ref Mnil))
+
+let rec address path event = function
+  | Env.Aident id ->
+      if Ident.global id then
+        try
+          Debugcom.Remote_value.global (Symtable.get_global_position id)
+        with Symtable.Error _ -> raise(Error(Unbound_identifier id))
+      else
+        begin match event with
+          Some {ev_ev = ev} ->
+            begin try
+              let pos = Ident.find_same id ev.ev_compenv.ce_stack in
+              Debugcom.Remote_value.local (ev.ev_stacksize - pos)
+            with Not_found ->
+            try
+              let pos = Ident.find_same id ev.ev_compenv.ce_heap in
+              Debugcom.Remote_value.from_environment pos
+            with Not_found ->
+              raise(Error(Unbound_identifier id))
+            end
+        | None ->
+            raise(Error(Unbound_identifier id))
+        end
+  | Env.Adot(root, pos) ->
+      let v = address path event root in
+      if not (Debugcom.Remote_value.is_block v) then
+        raise(Error(Not_initialized_yet path));
+      Debugcom.Remote_value.field v pos
+
+let value_path event env path =
+  match Env.find_value_address path env with
+  | addr -> address path event addr
+  | exception Not_found ->
+      fatal_error ("Cannot find address for: " ^ (Path.name path))
+
+let rec expression event env = function
+  | E_ident lid -> begin
+      match Env.find_value_by_name lid env with
+      | (p, valdesc) ->
+          let v =
+            match valdesc.val_kind with
+            | Val_ivar (_, cl_num) ->
+                let (p0, _) =
+                  Env.find_value_by_name
+                    (Longident.Lident ("self-" ^ cl_num)) env
+                in
+                let v = value_path event env p0 in
+                let i = value_path event env p in
+                Debugcom.Remote_value.field v (Debugcom.Remote_value.obj i)
+            | _ ->
+                value_path event env p
+          in
+          let typ = Ctype.correct_levels valdesc.val_type in
+          v, typ
+      | exception Not_found ->
+          raise(Error(Unbound_long_identifier lid))
+    end
+  | E_result ->
+      begin match event with
+        Some {ev_ev = {ev_kind = Event_after ty; ev_typsubst = subst}}
+        when !Frames.current_frame = 0 ->
+          (Debugcom.Remote_value.accu(), Subst.type_expr subst ty)
+      | _ ->
+          raise(Error(No_result))
+      end
+  | E_name n ->
+      begin try
+        Printval.find_named_value n
+      with Not_found ->
+        raise(Error(Unknown_name n))
+      end
+  | E_item(arg, n) ->
+      let (v, ty) = expression event env arg in
+      begin match (Ctype.repr(Ctype.expand_head_opt env ty)).desc with
+        Ttuple ty_list ->
+          if n < 1 || n > List.length ty_list
+          then raise(Error(Tuple_index(ty, List.length ty_list, n)))
+          else (Debugcom.Remote_value.field v (n-1), List.nth ty_list (n-1))
+      | Tconstr(path, [ty_arg], _) when Path.same path Predef.path_array ->
+          let size = Debugcom.Remote_value.size v in
+          if n >= size
+          then raise(Error(Array_index(size, n)))
+          else (Debugcom.Remote_value.field v n, ty_arg)
+      | Tconstr(path, [ty_arg], _) when Path.same path Predef.path_list ->
+          let rec nth pos v =
+            if not (Debugcom.Remote_value.is_block v) then
+              raise(Error(List_index(pos, n)))
+            else if pos = n then
+              (Debugcom.Remote_value.field v 0, ty_arg)
+            else
+              nth (pos + 1) (Debugcom.Remote_value.field v 1)
+          in nth 0 v
+      | Tconstr(path, [], _) when Path.same path Predef.path_string ->
+          let s = (Debugcom.Remote_value.obj v : string) in
+          if n >= String.length s
+          then raise(Error(String_index(s, String.length s, n)))
+          else (Debugcom.Remote_value.of_int(Char.code s.[n]),
+                Predef.type_char)
+      | _ ->
+          raise(Error(Wrong_item_type(ty, n)))
+      end
+  | E_field(arg, lbl) ->
+      let (v, ty) = expression event env arg in
+      begin match (Ctype.repr(Ctype.expand_head_opt env ty)).desc with
+        Tconstr(path, _, _) ->
+          let tydesc = Env.find_type path env in
+          begin match tydesc.type_kind with
+            Type_record(lbl_list, _repr) ->
+              let (pos, ty_res) =
+                find_label lbl env ty path tydesc 0 lbl_list in
+              (Debugcom.Remote_value.field v pos, ty_res)
+          | _ -> raise(Error(Not_a_record ty))
+          end
+      | _ -> raise(Error(Not_a_record ty))
+      end
+
+and find_label lbl env ty path tydesc pos = function
+    [] ->
+      raise(Error(Wrong_label(ty, lbl)))
+  | {ld_id; ld_type} :: rem ->
+      if Ident.name ld_id = lbl then begin
+        let ty_res =
+          Btype.newgenty(Tconstr(path, tydesc.type_params, ref Mnil))
+        in
+        (pos,
+         try Ctype.apply env [ty_res] ld_type [ty] with Ctype.Cannot_apply ->
+           abstract_type)
+      end else
+        find_label lbl env ty path tydesc (pos + 1) rem
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+  | Unbound_identifier id ->
+      fprintf ppf "@[Unbound identifier %s@]@." (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.@]@."
+      Printtyp.path path
+  | Unbound_long_identifier lid ->
+      fprintf ppf "@[Unbound identifier %a@]@." 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 Printtyp.type_expr ty
+  | Array_index(len, pos) ->
+      fprintf ppf
+        "@[Cannot extract element number %i from an array of length %i@]@."
+        pos len
+  | List_index(len, pos) ->
+      fprintf ppf
+        "@[Cannot extract element number %i from a list of length %i@]@."
+        pos len
+  | String_index(s, len, pos) ->
+      fprintf ppf
+        "@[Cannot extract character number %i@ \
+           from the following string of length %i:@ %S@]@."
+        pos len s
+  | Wrong_item_type(ty, pos) ->
+      fprintf ppf
+        "@[Cannot extract item number %i from a value of type@ %a@]@."
+        pos Printtyp.type_expr ty
+  | Wrong_label(ty, lbl) ->
+      fprintf ppf
+        "@[The record type@ %a@ has no label named %s@]@."
+        Printtyp.type_expr ty lbl
+  | Not_a_record ty ->
+      fprintf ppf
+        "@[The type@ %a@ is not a record type@]@." Printtyp.type_expr ty
+  | No_result ->
+      fprintf ppf "@[No result available at current program event@]@."
diff --git a/debugger/eval.mli b/debugger/eval.mli
new file mode 100644
index 00000000..6aa8cb1f
--- /dev/null
+++ b/debugger/eval.mli
@@ -0,0 +1,41 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Types
+open Parser_aux
+open Format
+
+val expression :
+    Events.code_event option -> Env.t -> expression ->
+    Debugcom.Remote_value.t * type_expr
+
+type error =
+  | Unbound_identifier of Ident.t
+  | Not_initialized_yet of Path.t
+  | Unbound_long_identifier of Longident.t
+  | Unknown_name of int
+  | Tuple_index of type_expr * int * int
+  | Array_index of int * int
+  | List_index of int * int
+  | String_index of string * int * int
+  | Wrong_item_type of type_expr * int
+  | Wrong_label of type_expr * string
+  | Not_a_record of type_expr
+  | No_result
+
+exception Error of error
+
+val report_error: formatter -> error -> unit
diff --git a/debugger/events.ml b/debugger/events.ml
new file mode 100644
index 00000000..3bad8b2f
--- /dev/null
+++ b/debugger/events.ml
@@ -0,0 +1,53 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(********************************* Events ******************************)
+
+open Instruct
+
+type code_event =
+  { ev_frag : int;
+    ev_ev : Instruct.debug_event }
+
+let get_pos ev =
+  match ev.ev_kind with
+  | Event_before -> ev.ev_loc.Location.loc_start
+  | Event_after _ -> ev.ev_loc.Location.loc_end
+  | _ -> ev.ev_loc.Location.loc_start
+;;
+
+
+(*** Current events. ***)
+
+(* Event at current position *)
+let current_event =
+  ref (None : code_event option)
+
+(* Current position in source. *)
+(* Raise `Not_found' if not on an event (beginning or end of program). *)
+let get_current_event () =
+  match !current_event with
+  | None -> raise Not_found
+  | Some ev -> ev
+
+let current_event_is_before () =
+  match !current_event with
+    None ->
+      raise Not_found
+  | Some {ev_ev = {ev_kind = Event_before}} ->
+      true
+  | _ ->
+      false
diff --git a/debugger/events.mli b/debugger/events.mli
new file mode 100644
index 00000000..b095e50a
--- /dev/null
+++ b/debugger/events.mli
@@ -0,0 +1,35 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Instruct
+
+(* A debug event associated with a code fragment. *)
+type code_event =
+  { ev_frag : int;
+    ev_ev : Instruct.debug_event }
+
+val get_pos : debug_event -> Lexing.position;;
+
+(** Current events. **)
+
+(* The event at current position. *)
+val current_event : code_event option ref
+
+(* Current position in source. *)
+(* Raise `Not_found' if not on an event (beginning or end of program). *)
+val get_current_event : unit -> code_event
+
+val current_event_is_before : unit -> bool
diff --git a/debugger/exec.ml b/debugger/exec.ml
new file mode 100644
index 00000000..df940165
--- /dev/null
+++ b/debugger/exec.ml
@@ -0,0 +1,54 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Handling of keyboard interrupts *)
+
+let interrupted = ref false
+
+let is_protected = ref false
+
+let break _signum =
+  if !is_protected
+  then interrupted := true
+  else raise Sys.Break
+
+let _ =
+  match Sys.os_type with
+    "Win32" -> ()
+  | _ ->
+      Sys.set_signal Sys.sigint (Sys.Signal_handle break);
+      Sys.set_signal Sys.sigpipe (Sys.Signal_handle(fun _ -> raise End_of_file))
+
+let protect f =
+  if !is_protected then
+    f ()
+  else begin
+    is_protected := true;
+    if not !interrupted then
+       f ();
+    is_protected := false;
+    if !interrupted then begin interrupted := false; raise Sys.Break end
+  end
+
+let unprotect f =
+  if not !is_protected then
+    f ()
+  else begin
+    is_protected := false;
+    if !interrupted then begin interrupted := false; raise Sys.Break end;
+    f ();
+    is_protected := true
+  end
diff --git a/debugger/exec.mli b/debugger/exec.mli
new file mode 100644
index 00000000..05e2e5f8
--- /dev/null
+++ b/debugger/exec.mli
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Handling of keyboard interrupts *)
+
+val protect : (unit -> unit) -> unit
+val unprotect : (unit -> unit) -> unit
diff --git a/debugger/frames.ml b/debugger/frames.ml
new file mode 100644
index 00000000..e1edf231
--- /dev/null
+++ b/debugger/frames.ml
@@ -0,0 +1,130 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(***************************** Frames **********************************)
+
+open Instruct
+open Debugcom
+open Events
+open Symbols
+
+(* Current frame number *)
+let current_frame = ref 0
+
+(* Event at selected position *)
+let selected_event = ref (None : code_event option)
+
+(* Selected position in source. *)
+(* Raise `Not_found' if not on an event. *)
+let selected_point () =
+  match !selected_event with
+    None ->
+      raise Not_found
+  | Some {ev_ev=ev} ->
+      (ev.ev_module,
+       (Events.get_pos ev).Lexing.pos_lnum,
+       (Events.get_pos ev).Lexing.pos_cnum - (Events.get_pos ev).Lexing.pos_bol)
+
+let selected_event_is_before () =
+  match !selected_event with
+    None ->
+      raise Not_found
+  | Some {ev_ev={ev_kind = Event_before}} ->
+      true
+  | _ ->
+      false
+
+(* Move up `frame_count' frames, assuming current frame pointer
+   corresponds to event `event'. Return event of final frame. *)
+
+let rec move_up frame_count event =
+  if frame_count <= 0 then event else begin
+    let (sp, pc) = up_frame event.ev_ev.ev_stacksize in
+    if sp < 0 then raise Not_found;
+    move_up (frame_count - 1) (any_event_at_pc pc)
+  end
+
+(* Select a frame. *)
+(* Raise `Not_found' if no such frame. *)
+(* --- Assume the current events have already been updated. *)
+let select_frame frame_number =
+  if frame_number < 0 then raise Not_found;
+  let (initial_sp, _) = get_frame() in
+  try
+    match !current_event with
+      None ->
+        raise Not_found
+    | Some curr_event ->
+        match !selected_event with
+          Some sel_event when frame_number >= !current_frame ->
+            selected_event :=
+              Some(move_up (frame_number - !current_frame) sel_event);
+            current_frame := frame_number
+        | _ ->
+            set_initial_frame();
+            selected_event := Some(move_up frame_number curr_event);
+            current_frame := frame_number
+  with Not_found ->
+    set_frame initial_sp;
+    raise Not_found
+
+(* Select a frame. *)
+(* Same as `select_frame' but raise no exception if the frame is not found. *)
+(* --- Assume the currents events have already been updated. *)
+let try_select_frame frame_number =
+  try
+    select_frame frame_number
+  with
+    Not_found ->
+      ()
+
+(* Return to default frame (frame 0). *)
+let reset_frame () =
+  set_initial_frame();
+  selected_event := !current_event;
+  current_frame := 0
+
+(* Perform a stack backtrace.
+   Call the given function with the events for each stack frame,
+   or None if we've encountered a stack frame with no debugging info
+   attached. Stop when the function returns false, or frame with no
+   debugging info reached, or top of stack reached. *)
+
+let do_backtrace action =
+  match !current_event with
+    None -> Misc.fatal_error "Frames.do_backtrace"
+  | Some ev ->
+      let (initial_sp, _) = get_frame() in
+      set_initial_frame();
+      let event = ref ev in
+      begin try
+        while action (Some !event) do
+          let (sp, pc) = up_frame !event.ev_ev.ev_stacksize in
+          if sp < 0 then raise Exit;
+          event := any_event_at_pc pc
+        done
+      with Exit -> ()
+         | Not_found -> ignore (action None)
+      end;
+      set_frame initial_sp
+
+(* Return the number of frames in the stack *)
+
+let stack_depth () =
+  let num_frames = ref 0 in
+  do_backtrace (function Some _ev -> incr num_frames; true
+                       | None -> num_frames := -1; false);
+  !num_frames
diff --git a/debugger/frames.mli b/debugger/frames.mli
new file mode 100644
index 00000000..08fd326c
--- /dev/null
+++ b/debugger/frames.mli
@@ -0,0 +1,55 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(****************************** Frames *********************************)
+
+open Events
+
+(* Current frame number *)
+val current_frame : int ref
+
+(* Fragment and event at selected position. *)
+val selected_event : code_event option ref
+
+(* Selected position in source (module, line, column). *)
+(* Raise `Not_found' if not on an event. *)
+val selected_point : unit -> string * int * int
+
+val selected_event_is_before : unit -> bool
+
+(* Select a frame. *)
+(* Raise `Not_found' if no such frame. *)
+(* --- Assume the currents events have already been updated. *)
+val select_frame : int -> unit
+
+(* Select a frame. *)
+(* Same as `select_frame' but raise no exception if the frame is not found. *)
+(* --- Assume the currents events have already been updated. *)
+val try_select_frame : int -> unit
+
+(* Return to default frame (frame 0). *)
+val reset_frame : unit -> unit
+
+(* Perform a stack backtrace.
+   Call the given function with the events for each stack frame,
+   or None if we've encountered a stack frame with no debugging info
+   attached. Stop when the function returns false, or frame with no
+   debugging info reached, or top of stack reached. *)
+val do_backtrace : (code_event option -> bool) -> unit
+
+(* Return the number of frames in the stack, or (-1) if it can't be
+   determined because some frames have no debugging info. *)
+val stack_depth : unit -> int
diff --git a/debugger/history.ml b/debugger/history.ml
new file mode 100644
index 00000000..0ece812b
--- /dev/null
+++ b/debugger/history.ml
@@ -0,0 +1,44 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Int64ops
+open Checkpoints
+open Primitives
+open Debugger_config
+
+let history = ref ([] : int64 list)
+
+let empty_history () =
+  history := []
+
+let add_current_time () =
+  let time = current_time () in
+    if !history = [] then
+      history := [time]
+    else if time <> List.hd !history then
+      history := list_truncate !history_size (time::!history)
+
+let previous_time_1 () =
+  match !history with
+    _::((time::_) as hist) ->
+      history := hist; time
+  | _ ->
+      prerr_endline "No more information."; raise Toplevel
+
+let rec previous_time n =
+  if n = _1
+  then previous_time_1()
+  else begin ignore(previous_time_1()); previous_time(pre64 n) end
diff --git a/debugger/history.mli b/debugger/history.mli
new file mode 100644
index 00000000..a184e7b9
--- /dev/null
+++ b/debugger/history.mli
@@ -0,0 +1,21 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+val empty_history : unit -> unit
+
+val add_current_time : unit -> unit
+
+val previous_time : int64 -> int64
diff --git a/debugger/input_handling.ml b/debugger/input_handling.ml
new file mode 100644
index 00000000..5b43ba96
--- /dev/null
+++ b/debugger/input_handling.ml
@@ -0,0 +1,108 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(**************************** Input control ****************************)
+
+open Unix
+open Primitives
+
+(*** Actives files. ***)
+
+(* List of the actives files. *)
+let active_files =
+  ref ([] : (file_descr * ((io_channel -> unit) * io_channel)) list)
+
+(* Add a file to the list of actives files. *)
+let add_file file controller =
+  active_files := (file.io_fd, (controller, file))::!active_files
+
+(* Remove a file from the list of actives files. *)
+let remove_file file =
+  active_files := List.remove_assoc file.io_fd !active_files
+
+(* Change the controller for the given file. *)
+let change_controller file controller =
+  remove_file file; add_file file controller
+
+(* Return the controller currently attached to the given file. *)
+let current_controller file =
+  fst (List.assoc file.io_fd !active_files)
+
+(* Execute a function with `controller' attached to `file'. *)
+(* ### controller file funct *)
+let execute_with_other_controller controller file funct =
+  let old_controller = current_controller file in
+    change_controller file controller;
+    let finally () = change_controller file old_controller in
+    Fun.protect ~finally funct
+
+(*** The "Main Loop" ***)
+
+let continue_main_loop =
+  ref true
+
+let exit_main_loop _ =
+  continue_main_loop := false
+
+(* Handle active files until `continue_main_loop' is false. *)
+let main_loop () =
+  let finally =
+    let old_state = !continue_main_loop in
+    fun () -> continue_main_loop := old_state
+  in
+    Fun.protect ~finally @@ fun () ->
+      continue_main_loop := true;
+      while !continue_main_loop do
+        try
+          let (input, _, _) =
+            select (List.map fst !active_files) [] [] (-1.)
+          in
+            List.iter
+              (function fd ->
+                 let (funct, iochan) = (List.assoc fd !active_files) in
+                   funct iochan)
+              input
+        with
+          Unix_error (EINTR, _, _) -> ()
+      done
+
+(*** Managing user inputs ***)
+
+(* Are we in interactive mode ? *)
+let interactif = ref true
+
+let current_prompt = ref ""
+
+(* Where the user input come from. *)
+let user_channel = ref std_io
+
+let read_user_input buffer length =
+  main_loop ();
+  input !user_channel.io_in buffer 0 length
+
+(* Stop reading user input. *)
+let stop_user_input () =
+  remove_file !user_channel
+
+(* Resume reading user input. *)
+let resume_user_input () =
+  if not (List.mem_assoc !user_channel.io_fd !active_files) then begin
+    if !interactif && !Parameters.prompt then begin
+      print_string !current_prompt;
+      flush Stdlib.stdout
+      end;
+    add_file !user_channel exit_main_loop
+    end
diff --git a/debugger/input_handling.mli b/debugger/input_handling.mli
new file mode 100644
index 00000000..e333c785
--- /dev/null
+++ b/debugger/input_handling.mli
@@ -0,0 +1,61 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(***************************** Input control ***************************)
+
+open Primitives
+
+(*** Actives files. ***)
+
+(* Add a file to the list of active files. *)
+val add_file : io_channel -> (io_channel -> unit) -> unit
+
+(* Remove a file from the list of actives files. *)
+val remove_file : io_channel -> unit
+
+(* Return the controller currently attached to the given file. *)
+val current_controller : io_channel -> (io_channel -> unit)
+
+(* Execute a function with `controller' attached to `file'. *)
+(* ### controller file funct *)
+val execute_with_other_controller :
+  (io_channel -> unit) -> io_channel -> (unit -> 'a) -> 'a
+
+(*** The "Main Loop" ***)
+
+(* Call this function for exiting the main loop. *)
+val exit_main_loop : 'a -> unit
+
+(* Handle active files until `continue_main_loop' is false. *)
+val main_loop : unit -> unit
+
+(*** Managing user inputs ***)
+
+(* Are we in interactive mode ? *)
+val interactif : bool ref
+
+val current_prompt : string ref
+
+(* Where the user input come from. *)
+val user_channel : io_channel ref
+
+val read_user_input : bytes -> int -> int
+
+(* Stop reading user input. *)
+val stop_user_input : unit -> unit
+
+(* Resume reading user input. *)
+val resume_user_input : unit -> unit
diff --git a/debugger/int64ops.ml b/debugger/int64ops.ml
new file mode 100644
index 00000000..d6fb583e
--- /dev/null
+++ b/debugger/int64ops.ml
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Damien Doligez, projet Moscova, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(****************** arithmetic operators for Int64 *********************)
+
+let ( ++ ) = Int64.add;;
+let ( -- ) = Int64.sub;;
+let suc64 = Int64.succ;;
+let pre64 = Int64.pred;;
+let _0 = Int64.zero;;
+let _1 = Int64.one;;
+let _minus1 = Int64.minus_one;;
+let ( ~~ ) = Int64.of_string;;
+let max_small_int = Int64.of_int max_int;;
+let to_int = Int64.to_int;;
diff --git a/debugger/int64ops.mli b/debugger/int64ops.mli
new file mode 100644
index 00000000..7c7616c5
--- /dev/null
+++ b/debugger/int64ops.mli
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Damien Doligez, projet Moscova, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(****************** arithmetic operators for Int64 *********************)
+
+val ( ++ ) : int64 -> int64 -> int64;;
+val ( -- ) : int64 -> int64 -> int64;;
+val suc64 : int64 -> int64;;
+val pre64 : int64 -> int64;;
+val _0 : int64;;
+val _1 : int64;;
+val _minus1 : int64;;
+val ( ~~ ) : string -> int64;;
+val max_small_int : int64;;
+val to_int : int64 -> int;;
diff --git a/debugger/loadprinter.ml b/debugger/loadprinter.ml
new file mode 100644
index 00000000..3cb66a09
--- /dev/null
+++ b/debugger/loadprinter.ml
@@ -0,0 +1,175 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Loading and installation of user-defined printer functions *)
+
+open Misc
+open Longident
+open Types
+
+(* Error report *)
+
+type error =
+  | Load_failure of Dynlink.error
+  | Unbound_identifier of Longident.t
+  | Unavailable_module of string * Longident.t
+  | Wrong_type of Longident.t
+  | No_active_printer of Longident.t
+
+exception Error of error
+
+(* Load a .cmo or .cma file *)
+
+open Format
+
+let rec loadfiles ppf name =
+  try
+    let filename = Load_path.find name in
+    Dynlink.allow_unsafe_modules true;
+    Dynlink.loadfile filename;
+    let d = Filename.dirname name in
+    if d <> Filename.current_dir_name then begin
+      if not (List.mem d (Load_path.get_paths ())) then
+        Load_path.add_dir d;
+    end;
+    fprintf ppf "File %s loaded@."
+      (if d <> Filename.current_dir_name then
+         filename
+       else
+         Filename.basename filename);
+    true
+  with
+  | Dynlink.Error (Dynlink.Unavailable_unit unit) ->
+      loadfiles ppf (String.uncapitalize_ascii unit ^ ".cmo")
+        &&
+      loadfiles ppf name
+  | Not_found ->
+      fprintf ppf "Cannot find file %s@." name;
+      false
+  | Sys_error msg ->
+      fprintf ppf "%s: %s@." name msg;
+      false
+  | Dynlink.Error e ->
+      raise(Error(Load_failure e))
+
+let loadfile ppf name =
+  ignore(loadfiles ppf name)
+
+(* Return the value referred to by a path (as in toplevel/topdirs) *)
+(* Note: evaluation proceeds in the debugger memory space, not in
+   the debuggee. *)
+
+let rec eval_address = function
+  | Env.Aident id ->
+    assert (Ident.persistent id);
+    let bytecode_or_asm_symbol = Ident.name id in
+    begin match Dynlink.unsafe_get_global_value ~bytecode_or_asm_symbol with
+    | None ->
+      raise (Symtable.Error (Symtable.Undefined_global bytecode_or_asm_symbol))
+    | Some obj -> obj
+    end
+  | Env.Adot(addr, pos) -> Obj.field (eval_address addr) pos
+
+let eval_value_path env path =
+  match Env.find_value_address path env with
+  | addr -> eval_address addr
+  | exception Not_found ->
+      fatal_error ("Cannot find address for: " ^ (Path.name path))
+
+(* Install, remove a printer (as in toplevel/topdirs) *)
+
+(* since 4.00, "topdirs.cmi" is not in the same directory as the standard
+  library, so we load it beforehand as it cannot be found in the search path. *)
+let init () =
+  let topdirs =
+    Filename.concat !Parameters.topdirs_path "topdirs.cmi" in
+  ignore (Env.read_signature "Topdirs" topdirs)
+
+let match_printer_type desc typename =
+  let printer_type =
+    match
+      Env.find_type_by_name
+        (Ldot(Lident "Topdirs", typename)) Env.empty
+    with
+    | path, _ -> path
+    | exception Not_found ->
+        raise (Error(Unbound_identifier(Ldot(Lident "Topdirs", typename))))
+  in
+  Ctype.begin_def();
+  let ty_arg = Ctype.newvar() in
+  Ctype.unify Env.empty
+    (Ctype.newconstr printer_type [ty_arg])
+    (Ctype.instance desc.val_type);
+  Ctype.end_def();
+  Ctype.generalize ty_arg;
+  ty_arg
+
+let find_printer_type lid =
+  match Env.find_value_by_name lid Env.empty with
+  | (path, desc) -> begin
+      match match_printer_type desc "printer_type_new" with
+      | ty_arg -> (ty_arg, path, false)
+      | exception Ctype.Unify _ -> begin
+          match match_printer_type desc "printer_type_old" with
+          | ty_arg -> (ty_arg, path, true)
+          | exception Ctype.Unify _ -> raise(Error(Wrong_type lid))
+        end
+    end
+  | exception Not_found ->
+      raise(Error(Unbound_identifier lid))
+
+let install_printer ppf lid =
+  let (ty_arg, path, is_old_style) = find_printer_type lid in
+  let v =
+    try
+      eval_value_path Env.empty path
+    with Symtable.Error(Symtable.Undefined_global s) ->
+      raise(Error(Unavailable_module(s, lid))) in
+  let print_function =
+    if is_old_style then
+      (fun _formatter repr -> Obj.obj v (Obj.obj repr))
+    else
+      (fun formatter repr -> Obj.obj v formatter (Obj.obj repr)) in
+  Printval.install_printer path ty_arg ppf print_function
+
+let remove_printer lid =
+  let (_ty_arg, path, _is_old_style) = find_printer_type lid in
+  try
+    Printval.remove_printer path
+  with Not_found ->
+    raise(Error(No_active_printer lid))
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+  | Load_failure e ->
+      fprintf ppf "@[Error during code loading: %s@]@."
+        (Dynlink.error_message e)
+  | Unbound_identifier lid ->
+      fprintf ppf "@[Unbound identifier %a@]@."
+      Printtyp.longident lid
+  | Unavailable_module(md, lid) ->
+      fprintf ppf
+        "@[The debugger does not contain the code for@ %a.@ \
+           Please load an implementation of %s first.@]@."
+        Printtyp.longident lid md
+  | Wrong_type lid ->
+      fprintf ppf "@[%a has the wrong type for a printing function.@]@."
+      Printtyp.longident lid
+  | No_active_printer lid ->
+      fprintf ppf "@[%a is not currently active as a printing function.@]@."
+      Printtyp.longident lid
diff --git a/debugger/loadprinter.mli b/debugger/loadprinter.mli
new file mode 100644
index 00000000..f20345a4
--- /dev/null
+++ b/debugger/loadprinter.mli
@@ -0,0 +1,37 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Loading and installation of user-defined printer functions *)
+
+open Format
+
+val init : unit -> unit
+
+val loadfile : formatter -> string -> unit
+val install_printer : formatter -> Longident.t -> unit
+val remove_printer : Longident.t -> unit
+
+(* Error report *)
+
+type error =
+  | Load_failure of Dynlink.error
+  | Unbound_identifier of Longident.t
+  | Unavailable_module of string * Longident.t
+  | Wrong_type of Longident.t
+  | No_active_printer of Longident.t
+
+exception Error of error
+
+val report_error: formatter -> error -> unit
diff --git a/debugger/main.ml b/debugger/main.ml
new file mode 100644
index 00000000..ec99786e
--- /dev/null
+++ b/debugger/main.ml
@@ -0,0 +1,249 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Input_handling
+open Question
+open Command_line
+open Debugger_config
+open Checkpoints
+open Time_travel
+open Parameters
+open Program_management
+open Frames
+open Show_information
+open Format
+open Primitives
+
+let line_buffer = Lexing.from_function read_user_input
+
+let loop ppf = line_loop ppf line_buffer; stop_user_input ()
+
+let current_duration = ref (-1L)
+
+let rec protect ppf restart loop =
+  try
+    loop ppf
+  with
+  | End_of_file ->
+      protect ppf restart (function ppf ->
+        forget_process
+          !current_checkpoint.c_fd
+          !current_checkpoint.c_pid;
+        pp_print_flush ppf ();
+        stop_user_input ();
+        restart ppf)
+  | Toplevel ->
+      protect ppf restart (function ppf ->
+        pp_print_flush ppf ();
+        stop_user_input ();
+        restart ppf)
+  | Sys.Break ->
+      protect ppf restart (function ppf ->
+        fprintf ppf "Interrupted.@.";
+        Exec.protect (function () ->
+          stop_user_input ();
+          if !loaded then begin
+            try_select_frame 0;
+            show_current_event ppf;
+          end);
+        restart ppf)
+  | Current_checkpoint_lost ->
+      protect ppf restart (function ppf ->
+        fprintf ppf "Trying to recover...@.";
+        stop_user_input ();
+        recover ();
+        try_select_frame 0;
+        show_current_event ppf;
+        restart ppf)
+  | Current_checkpoint_lost_start_at (time, init_duration) ->
+      protect ppf restart (function ppf ->
+        let b =
+          if !current_duration = -1L then begin
+            let msg = sprintf "Restart from time %Ld and try to get \
+                               closer of the problem" time in
+            stop_user_input ();
+            if yes_or_no msg then
+              (current_duration := init_duration; true)
+            else
+              false
+            end
+          else
+            true in
+        if b then
+          begin
+            go_to time;
+            current_duration := Int64.div !current_duration 10L;
+            if !current_duration > 0L then
+              while true do
+                step !current_duration
+              done
+            else begin
+              current_duration := -1L;
+              stop_user_input ();
+              show_current_event ppf;
+              restart ppf;
+            end
+          end
+        else
+          begin
+            recover ();
+            show_current_event ppf;
+            restart ppf
+          end)
+  | x ->
+      cleanup x kill_program
+
+let execute_file_if_any () =
+  let buffer = Buffer.create 128 in
+  begin
+    try
+      let base = ".ocamldebug" in
+      let file =
+        if Sys.file_exists base then
+          base
+        else
+          Filename.concat (Sys.getenv "HOME") base in
+      let ch = open_in file in
+      fprintf Format.std_formatter "Executing file %s@." file;
+      while true do
+        let line = string_trim (input_line ch) in
+        if line <> ""  && line.[0] <> '#' then begin
+          Buffer.add_string buffer line;
+          Buffer.add_char buffer '\n'
+        end
+      done;
+    with _ -> ()
+  end;
+  let len = Buffer.length buffer in
+  if len > 0 then
+    let commands = Buffer.sub buffer 0 (pred len) in
+    line_loop Format.std_formatter (Lexing.from_string commands);
+    stop_user_input ()
+
+let toplevel_loop () =
+  interactif := false;
+  current_prompt := "";
+  execute_file_if_any ();
+  interactif := true;
+  current_prompt := debugger_prompt;
+  protect Format.std_formatter loop loop
+
+(* Parsing of command-line arguments *)
+
+exception Found_program_name
+
+let anonymous s =
+  program_name := Unix_tools.make_absolute s; raise Found_program_name
+let add_include d =
+  default_load_path :=
+    Misc.expand_directory Config.standard_library d :: !default_load_path
+let set_socket s =
+  socket_name := s
+let set_topdirs_path s =
+  topdirs_path := s
+let set_checkpoints n =
+  checkpoint_max_count := n
+let set_directory dir =
+  Sys.chdir dir
+let print_version () =
+  printf "The OCaml debugger, version %s@." Sys.ocaml_version;
+  exit 0;
+;;
+let print_version_num () =
+  printf "%s@." Sys.ocaml_version;
+  exit 0;
+;;
+
+let speclist = [
+   "-c", Arg.Int set_checkpoints,
+      "  Set max number of checkpoints kept";
+   "-cd", Arg.String set_directory,
+      "
  Change working directory";
+   "-emacs", Arg.Tuple [Arg.Set emacs; Arg.Set machine_readable],
+      "For running the debugger under emacs; implies -machine-readable";
+   "-I", Arg.String add_include,
+      "  Add  to the list of include directories";
+   "-machine-readable", Arg.Set machine_readable,
+      "Print information in a format more suitable for machines";
+   "-s", Arg.String set_socket,
+      "  Set the name of the communication socket";
+   "-version", Arg.Unit print_version,
+      " Print version and exit";
+   "-vnum", Arg.Unit print_version_num,
+      " Print version number and exit";
+   "-no-version", Arg.Clear Parameters.version,
+      " Do not print version at startup";
+   "-no-prompt", Arg.Clear Parameters.prompt,
+      " Suppress all prompts";
+   "-no-time", Arg.Clear Parameters.time,
+      " Do not print times";
+   "-no-breakpoint-message", Arg.Clear Parameters.breakpoint,
+      " Do not print message at breakpoint setup and removal";
+   "-topdirs-path", Arg.String set_topdirs_path,
+      " Set path to the directory containing topdirs.cmi";
+   ]
+
+let function_placeholder () =
+  raise Not_found
+
+let report report_error error =
+  eprintf "Debugger [version %s] environment error:@ @[@;%a@]@.;"
+    Config.version report_error error
+
+let main () =
+  Callback.register "Debugger.function_placeholder" function_placeholder;
+  try
+    socket_name :=
+      (match Sys.os_type with
+        "Win32" ->
+          (Unix.string_of_inet_addr Unix.inet_addr_loopback)^
+          ":"^
+          (Int.to_string (10000 + ((Unix.getpid ()) mod 10000)))
+      | _ -> Filename.concat (Filename.get_temp_dir_name ())
+                                ("camldebug" ^ (Int.to_string (Unix.getpid ())))
+      );
+    begin try
+      Arg.parse speclist anonymous "";
+      Arg.usage speclist
+        "No program name specified\n\
+         Usage: ocamldebug [options]  [arguments]\n\
+         Options are:";
+      exit 2
+    with Found_program_name ->
+      for j = !Arg.current + 1 to Array.length Sys.argv - 1 do
+        arguments := !arguments ^ " " ^ (Filename.quote Sys.argv.(j))
+      done
+    end;
+    if !Parameters.version
+    then printf "\tOCaml Debugger version %s@.@." Config.version;
+    Loadprinter.init();
+    Load_path.init !default_load_path;
+    Clflags.recursive_types := true;    (* Allow recursive types. *)
+    toplevel_loop ();                   (* Toplevel. *)
+    kill_program ();
+    exit 0
+  with
+  | Toplevel ->
+      exit 2
+  | Persistent_env.Error e ->
+      report Persistent_env.report_error e;
+      exit 2
+  | Cmi_format.Error e ->
+      report Cmi_format.report_error e;
+      exit 2
+
+let _ =
+  Unix.handle_unix_error main ()
diff --git a/debugger/parameters.ml b/debugger/parameters.ml
new file mode 100644
index 00000000..6b5b6c48
--- /dev/null
+++ b/debugger/parameters.ml
@@ -0,0 +1,46 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Miscellaneous parameters *)
+
+open Debugger_config
+
+let program_name = ref ""
+let socket_name = ref ""
+let arguments = ref ""
+
+let default_load_path =
+  ref [ Filename.current_dir_name; Config.standard_library ]
+
+let breakpoint = ref true
+let prompt = ref true
+let time = ref true
+let version = ref true
+
+let topdirs_path = ref (Filename.concat Config.standard_library "compiler-libs")
+
+let add_path dir =
+  Load_path.add_dir dir;
+  Envaux.reset_cache()
+
+let add_path_for mdl dir =
+  let old = try Hashtbl.find load_path_for mdl with Not_found -> [] in
+  Hashtbl.replace load_path_for mdl (dir :: old)
+
+(* Used by emacs ? *)
+let emacs = ref false
+
+let machine_readable = ref false
diff --git a/debugger/parameters.mli b/debugger/parameters.mli
new file mode 100644
index 00000000..d680e7f1
--- /dev/null
+++ b/debugger/parameters.mli
@@ -0,0 +1,35 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Miscellaneous parameters *)
+
+val program_name : string ref
+val socket_name : string ref
+val arguments : string ref
+val default_load_path : string list ref
+val breakpoint : bool ref
+val prompt : bool ref
+val time : bool ref
+val version : bool ref
+val topdirs_path : string ref
+
+val add_path : string -> unit
+val add_path_for : string -> string -> unit
+
+(* Used by emacs ? *)
+val emacs : bool ref
+
+val machine_readable : bool ref
diff --git a/debugger/parser_aux.mli b/debugger/parser_aux.mli
new file mode 100644
index 00000000..36c383e0
--- /dev/null
+++ b/debugger/parser_aux.mli
@@ -0,0 +1,30 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type expression =
+    E_ident of Longident.t              (* x or Mod.x *)
+  | E_name of int                       (* $xxx *)
+  | E_item of expression * int          (* x.1 x.[2] x.(3) *)
+  | E_field of expression * string      (* x.lbl !x *)
+  | E_result
+
+type break_arg =
+    BA_none                             (* break *)
+  | BA_pc of Debugcom.pc                (* break FRAG PC *)
+  | BA_function of expression           (* break FUNCTION *)
+  | BA_pos1 of Longident.t option * int * int option
+                                        (* break @ [MODULE] LINE [POS] *)
+  | BA_pos2 of Longident.t option * int (* break @ [MODULE] # OFFSET *)
diff --git a/debugger/pattern_matching.ml b/debugger/pattern_matching.ml
new file mode 100644
index 00000000..f44d16ee
--- /dev/null
+++ b/debugger/pattern_matching.ml
@@ -0,0 +1,254 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(************************ Simple pattern matching **********************)
+
+open Debugger_config
+(*open Primitives*)
+open Misc
+(*open Const*)
+(*open Globals*)
+(*open Builtins*)
+open Typedtree
+(*open Modules*)
+(*open Symtable*)
+(*open Value*)
+open Parser_aux
+
+(*
+let rec find_constr tag = function
+    [] ->
+      fatal_error "find_constr: unknown constructor for this type"
+  | constr::rest ->
+      match constr.info.cs_tag with
+        ConstrRegular(t, _) ->
+          if t == tag then constr else find_constr tag rest
+      | ConstrExtensible _ ->
+          fatal_error "find_constr: extensible"
+
+let find_exception tag =
+  let (qualid, stamp) = get_exn_of_num tag in
+  let rec select_exn = function
+    [] ->
+      raise Not_found
+  | constr :: rest ->
+      match constr.info.cs_tag with
+        ConstrExtensible(_,st) ->
+          if st == stamp then constr else select_exn rest
+      | ConstrRegular(_,_) ->
+          fatal_error "find_exception: regular" in
+  select_exn(hashtbl__find_all (find_module qualid.qual).mod_constrs qualid.id)
+*)
+
+let error_matching () =
+  prerr_endline "Pattern matching failed";
+  raise Toplevel
+
+(*
+let same_name {qualid = name1} =
+  function
+    GRname name2 ->
+      (name2 = "") || (name1.id = name2)
+  | GRmodname name2 ->
+      name1 = name2
+
+let check_same_constr constr constr2 =
+  try
+    if not (same_name constr constr2) then
+      error_matching ()
+  with
+    Desc_not_found ->
+      prerr_endline "Undefined constructor.";
+      raise Toplevel
+*)
+
+let rec pattern_matching pattern obj ty =
+  match pattern with
+    P_dummy ->
+      []
+  | P_variable var ->
+      [var, obj, ty]
+  | _ ->
+    match (Ctype.repr ty).desc with
+      Tvar | Tarrow _ ->
+        error_matching ()
+    | Ttuple(ty_list) ->
+        (match pattern with
+           P_tuple pattern_list ->
+             pattern_matching_list pattern_list obj ty_list
+         | P_nth (n, patt) ->
+             if n >= List.length ty_list then
+               (prerr_endline "Out of range."; raise Toplevel);
+             pattern_matching patt (Debugcom.get_field obj n)
+                              (List.nth ty_list n)
+         | _ ->
+             error_matching ())
+    | Tconstr(cstr, [ty_arg],_) when same_type_constr cstr constr_type_list ->
+        (match pattern with
+           P_list pattern_list ->
+             let (last, list) =
+               it_list
+                 (fun (current, list) pattern ->
+                    if value_tag current = 0 then error_matching ();
+                    (Debugcom.get_field current 1,
+                     (pattern, Debugcom.get_field current 0)::list))
+                 (obj, [])
+                 pattern_list
+             in
+               if value_tag last <> 0 then error_matching ();
+               flat_map
+                 (function (x, y) -> pattern_matching x y ty_arg)
+                 (rev list)
+         | P_nth (n, patt) ->
+             let rec find k current =
+               if value_tag current = 0 then
+                 (prerr_endline "Out of range."; raise Toplevel);
+               if k = 0 then
+                 pattern_matching patt (Debugcom.get_field current 0) ty_arg
+               else
+                 find (k - 1) (Debugcom.get_field current 1)
+             in
+               find n obj
+         | P_concat (pattern1, pattern2) ->
+             if value_tag obj == 0 then error_matching ();
+             (pattern_matching pattern1 (Debugcom.get_field obj 0) ty_arg)
+                @ (pattern_matching pattern2 (Debugcom.get_field obj 1) ty)
+         | _ ->
+             error_matching ())
+    | Tconstr(cstr, [ty_arg]) when same_type_constr cstr constr_type_vect ->
+        (match pattern with
+           P_nth (n, patt) ->
+             if n >= value_size obj then
+               (prerr_endline "Out of range."; raise Toplevel);
+             pattern_matching patt (Debugcom.get_field obj n) ty_arg
+         | _ ->
+             error_matching ())
+    | Tconstr(cstr, ty_list) ->
+        (match cstr.info.ty_abbr with
+           Tabbrev(params, body) ->
+             pattern_matching pattern obj (expand_abbrev params body ty_list)
+         | _ ->
+             match_concrete_type pattern obj cstr ty ty_list)
+
+and match_concrete_type pattern obj cstr ty ty_list =
+  let typ_descr =
+    type_descr_of_type_constr cstr in
+  match typ_descr.info.ty_desc with
+    Abstract_type ->
+      error_matching ()
+  | Variant_type constr_list ->
+      let tag = value_tag obj in
+        (try
+           let constr =
+             if same_type_constr cstr constr_type_exn then
+               find_exception tag
+             else
+               find_constr tag constr_list
+           in
+             let (ty_res, ty_arg) =
+               type_pair_instance (constr.info.cs_res, constr.info.cs_arg)
+             in
+               filter (ty_res, ty);
+               match constr.info.cs_kind with
+                 Constr_constant ->
+                   error_matching ()
+               | Constr_regular ->
+                   (match pattern with
+                      P_constr (constr2, patt) ->
+                        check_same_constr constr constr2;
+                        pattern_matching patt (Debugcom.get_field obj 0) ty_arg
+                    | _ ->
+                        error_matching ())
+               | Constr_superfluous n ->
+                   (match pattern with
+                      P_constr (constr2, patt) ->
+                        check_same_constr constr constr2;
+                        (match patt with
+                           P_tuple pattern_list ->
+                             pattern_matching_list
+                               pattern_list
+                               obj
+                               (filter_product n ty_arg)
+                         | P_nth (n2, patt) ->
+                             let ty_list = filter_product n ty_arg in
+                               if n2 >= n then
+                                 (prerr_endline "Out of range.";
+                                  raise Toplevel);
+                               pattern_matching
+                                 patt
+                                 (Debugcom.get_field obj n2)
+                                 (List.nth ty_list n2)
+                         | P_variable var ->
+                             [var,
+                              obj,
+                              {typ_desc = Tproduct (filter_product n ty_arg);
+                               typ_level = generic}]
+                         | P_dummy ->
+                             []
+                         | _ ->
+                             error_matching ())
+                    | _ ->
+                        error_matching ())
+         with
+           Not_found ->
+             error_matching ()
+         | Unify ->
+             fatal_error "pattern_matching: types should match")
+  | Record_type label_list ->
+      let match_field (label, patt) =
+        let lbl =
+          try
+            primitives__find
+              (function l -> same_name l label)
+              label_list
+          with Not_found ->
+              prerr_endline "Label not found.";
+              raise Toplevel
+        in
+          let (ty_res, ty_arg) =
+            type_pair_instance (lbl.info.lbl_res, lbl.info.lbl_arg)
+          in
+            (try
+               filter (ty_res, ty)
+             with Unify ->
+               fatal_error "pattern_matching: types should match");
+            pattern_matching patt (Debugcom.get_field obj lbl.info.lbl_pos)
+                             ty_arg
+      in
+        (match pattern with
+           P_record pattern_label_list ->
+             flat_map match_field pattern_label_list
+         | _ ->
+             error_matching ())
+  | Abbrev_type(_,_) ->
+      fatal_error "pattern_matching: abbrev type"
+
+and pattern_matching_list pattern_list obj ty_list =
+  let val_list =
+    try
+      pair__combine (pattern_list, ty_list)
+    with
+      Invalid_argument _ -> error_matching ()
+  in
+    flat_map
+      (function (x, y, z) -> pattern_matching x y z)
+      (rev
+         (snd
+            (it_list
+               (fun (num, list) (pattern, typ) ->
+                  (num + 1, (pattern, Debugcom.get_field obj num, typ)::list))
+               (0, [])
+               val_list)))
diff --git a/debugger/pattern_matching.mli b/debugger/pattern_matching.mli
new file mode 100644
index 00000000..35b541e6
--- /dev/null
+++ b/debugger/pattern_matching.mli
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(************************ Simple pattern matching **********************)
+
+open Parser_aux
+
+val pattern_matching :
+  pattern -> Debugcom.remote_value -> Typedtree.type_expr ->
+    (string * Debugcom.remote_value * Typedtree.type_expr) list;;
diff --git a/debugger/pos.ml b/debugger/pos.ml
new file mode 100644
index 00000000..2b5b0e2e
--- /dev/null
+++ b/debugger/pos.ml
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Damien Doligez, projet Moscova, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2003 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Instruct
+open Lexing
+open Location
+open Events
+
+let get_desc ev =
+  let loc = ev.ev_ev.ev_loc in
+  Printf.sprintf "file %s, line %d, characters %d-%d"
+                 loc.loc_start.pos_fname loc.loc_start.pos_lnum
+                 (loc.loc_start.pos_cnum - loc.loc_start.pos_bol + 1)
+                 (loc.loc_end.pos_cnum - loc.loc_start.pos_bol + 1)
diff --git a/debugger/pos.mli b/debugger/pos.mli
new file mode 100644
index 00000000..31bc341f
--- /dev/null
+++ b/debugger/pos.mli
@@ -0,0 +1,16 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Damien Doligez, projet Moscova, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2003 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+val get_desc : Events.code_event -> string;;
diff --git a/debugger/primitives.ml b/debugger/primitives.ml
new file mode 100644
index 00000000..4cf2fb8d
--- /dev/null
+++ b/debugger/primitives.ml
@@ -0,0 +1,127 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(*********************** Basic functions and types *********************)
+
+(*** Miscellaneous ***)
+exception Out_of_range
+
+let cleanup e f =
+  let bt = Printexc.get_raw_backtrace () in
+  let () = f () in
+  Printexc.raise_with_backtrace e bt
+
+let nothing _ = ()
+
+(*** Operations on lists. ***)
+
+(* Remove an element from a list *)
+let except e l =
+ let rec except_e = function
+     [] -> []
+   | elem::l -> if e = elem then l else elem::except_e l
+ in except_e l
+
+(* Position of an element in a list. Head of list has position 0. *)
+let index a l =
+ let rec index_rec i = function
+     []  -> raise Not_found
+  | b::l -> if a = b then i else index_rec (i + 1) l
+ in index_rec 0 l
+
+(* Return the `n' first elements of `l' *)
+(* ### n l -> l' *)
+let rec list_truncate =
+  fun
+    p0 p1 -> match (p0,p1) with (0, _)      -> []
+  | (_, [])     -> []
+  | (n, (a::l)) -> a::(list_truncate (n - 1) l)
+
+(* Separate the `n' first elements of `l' and the others *)
+(* ### n list -> (first, last) *)
+let rec list_truncate2 =
+  fun
+    p0 p1 -> match (p0,p1) with (0, l) ->
+      ([], l)
+  | (_, []) ->
+      ([], [])
+  | (n, (a::l)) ->
+      let (first, last) = (list_truncate2 (n - 1) l) in
+        (a::first, last)
+
+(* Replace x by y in list l *)
+(* ### x y l -> l' *)
+let list_replace x y =
+  let rec repl =
+    function
+      [] -> []
+    | a::l ->
+        if a == x then y::l
+        else a::(repl l)
+  in repl
+
+(*** Operations on strings. ***)
+
+(* Remove blanks (spaces and tabs) at beginning and end of a string. *)
+let is_space = function
+  | ' ' | '\t' -> true | _ -> false
+
+let string_trim s =
+  let l = String.length s and i = ref 0 in
+    while
+      !i < l && is_space (String.get s !i)
+    do
+      incr i
+    done;
+    let j = ref (l - 1) in
+      while
+        !j >= !i && is_space (String.get s !j)
+      do
+        decr j
+      done;
+      String.sub s !i (!j - !i + 1)
+
+(* isprefix s1 s2 returns true if s1 is a prefix of s2. *)
+
+let isprefix s1 s2 =
+  let l1 = String.length s1 and l2 = String.length s2 in
+  (l1 = l2 && s1 = s2) || (l1 < l2 && s1 = String.sub s2 0 l1)
+
+
+(*** I/O channels ***)
+
+type io_channel = {
+  io_in : in_channel;
+  io_out : out_channel;
+  io_fd : Unix.file_descr
+  }
+
+let io_channel_of_descr fd = {
+  io_in = Unix.in_channel_of_descr fd;
+  io_out = Unix.out_channel_of_descr fd;
+  io_fd = fd
+  }
+
+let close_io io_channel =
+  close_out_noerr io_channel.io_out;
+  close_in_noerr io_channel.io_in;
+;;
+
+let std_io = {
+  io_in = stdin;
+  io_out = stdout;
+  io_fd = Unix.stdin
+  }
diff --git a/debugger/primitives.mli b/debugger/primitives.mli
new file mode 100644
index 00000000..8b03d8d2
--- /dev/null
+++ b/debugger/primitives.mli
@@ -0,0 +1,67 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(********************* Basic functions and types ***********************)
+
+(*** Miscellaneous ***)
+val nothing : 'a -> unit
+
+(*** Types and exceptions. ***)
+exception Out_of_range
+
+(* [cleanup e f x] runs evaluates [f x] and reraises [e] with its original
+   backtrace. If [f x] raises, then [e] is not raised. *)
+val cleanup : exn -> (unit -> unit) -> 'a
+
+(*** Operations on lists. ***)
+
+(* Remove an element from a list *)
+val except : 'a -> 'a list -> 'a list
+
+(* Position of an element in a list. Head of list has position 0. *)
+val index : 'a -> 'a list -> int
+
+(* Return the `n' first elements of `l'. *)
+(* ### n l -> l' *)
+val list_truncate : int -> 'a list -> 'a list
+
+(* Separate the `n' first elements of `l' and the others. *)
+(* ### n list -> (first, last) *)
+val list_truncate2 : int -> 'a list -> 'a list * 'a list
+
+(* Replace x by y in list l *)
+(* ### x y l -> l' *)
+val list_replace : 'a -> 'a -> 'a list -> 'a list
+
+(*** Operations on strings. ***)
+
+(* Remove blanks (spaces and tabs) at beginning and end of a string. *)
+val string_trim : string -> string
+
+(* isprefix s1 s2 returns true if s1 is a prefix of s2. *)
+val isprefix : string -> string -> bool
+
+(*** I/O channels ***)
+
+type io_channel = {
+  io_in : in_channel;
+  io_out : out_channel;
+  io_fd : Unix.file_descr
+  }
+
+val io_channel_of_descr : Unix.file_descr -> io_channel
+val close_io : io_channel -> unit
+val std_io : io_channel
diff --git a/debugger/printval.ml b/debugger/printval.ml
new file mode 100644
index 00000000..6e634ad1
--- /dev/null
+++ b/debugger/printval.ml
@@ -0,0 +1,105 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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 print values *)
+
+open Format
+open Parser_aux
+open Types
+
+(* To name printed and ellipsed values *)
+
+let named_values =
+  (Hashtbl.create 29 : (int, Debugcom.Remote_value.t * type_expr) Hashtbl.t)
+let next_name = ref 1
+
+let reset_named_values () =
+  Hashtbl.clear named_values;
+  next_name := 1
+
+let name_value v ty =
+  let name = !next_name in
+  incr next_name;
+  Hashtbl.add named_values name (v, ty);
+  name
+
+let find_named_value name =
+  Hashtbl.find named_values name
+
+let check_depth depth obj ty =
+  if depth <= 0 then begin
+    let n = name_value obj ty in
+    Some (Outcometree.Oval_stuff ("$" ^ Int.to_string n))
+  end else None
+
+module EvalPath =
+  struct
+    type valu = Debugcom.Remote_value.t
+    exception Error
+    let rec eval_address = function
+    | Env.Aident id ->
+        begin try
+          Debugcom.Remote_value.global (Symtable.get_global_position id)
+        with Symtable.Error _ ->
+          raise Error
+        end
+    | Env.Adot(root, pos) ->
+        let v = eval_address root in
+        if not (Debugcom.Remote_value.is_block v)
+        then raise Error
+        else Debugcom.Remote_value.field v pos
+    let same_value = Debugcom.Remote_value.same
+  end
+
+module Printer = Genprintval.Make(Debugcom.Remote_value)(EvalPath)
+
+let install_printer path ty _ppf fn =
+  Printer.install_printer path ty
+    (fun ppf remote_val ->
+       try
+         fn ppf (Obj.repr (Debugcom.Remote_value.obj remote_val))
+       with
+         Debugcom.Marshalling_error ->
+           fprintf ppf "")
+
+let remove_printer = Printer.remove_printer
+
+let max_printer_depth = ref 20
+let max_printer_steps = ref 300
+
+let print_exception ppf obj =
+  let t = Printer.outval_of_untyped_exception obj in
+  !Oprint.out_value ppf t
+
+let print_value max_depth env obj (ppf : Format.formatter) ty =
+  let t =
+    Printer.outval_of_value !max_printer_steps max_depth
+      check_depth env obj ty in
+  !Oprint.out_value ppf t
+
+let print_named_value max_depth exp env obj ppf ty =
+  let print_value_name ppf = function
+  | E_ident lid ->
+      Printtyp.longident ppf lid
+  | E_name n ->
+      fprintf ppf "$%i" n
+  | _ ->
+      let n = name_value obj ty in
+      fprintf ppf "$%i" n in
+  fprintf ppf "@[<2>%a:@ %a@ =@ %a@]@."
+  print_value_name exp
+  Printtyp.type_expr ty
+  (print_value max_depth env obj) ty
diff --git a/debugger/printval.mli b/debugger/printval.mli
new file mode 100644
index 00000000..53c0ee4e
--- /dev/null
+++ b/debugger/printval.mli
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Format
+
+val max_printer_depth : int ref
+val max_printer_steps : int ref
+
+val print_exception: formatter -> Debugcom.Remote_value.t -> unit
+val print_named_value :
+  int -> Parser_aux.expression -> Env.t ->
+    Debugcom.Remote_value.t -> formatter -> Types.type_expr ->
+    unit
+
+val reset_named_values : unit -> unit
+val find_named_value : int -> Debugcom.Remote_value.t * Types.type_expr
+
+val install_printer :
+  Path.t -> Types.type_expr -> formatter ->
+    (formatter -> Obj.t -> unit) -> unit
+val remove_printer : Path.t -> unit
diff --git a/debugger/program_loading.ml b/debugger/program_loading.ml
new file mode 100644
index 00000000..c03dcfdc
--- /dev/null
+++ b/debugger/program_loading.ml
@@ -0,0 +1,190 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Program loading *)
+
+open Unix
+open Debugger_config
+open Parameters
+open Input_handling
+
+(*** Debugging. ***)
+
+let debug_loading = ref false
+
+(*** Load a program. ***)
+
+(* Function used for launching the program. *)
+let launching_func = ref (function () -> ())
+
+let load_program () =
+  !launching_func ();
+  main_loop ()
+
+(*** Launching functions. ***)
+
+(* Returns a command line prefix to set environment for the debuggee *)
+let get_unix_environment () =
+  let f (vname, vvalue) =
+    Printf.sprintf "%s=%s " vname (Filename.quote vvalue)
+  in
+  String.concat "" (List.map f !Debugger_config.environment)
+;;
+
+(* Notes:
+   1. This quoting is not the same as [Filename.quote] because the "set"
+      command is a shell built-in and its quoting rules are different
+      from regular commands.
+   2. Microsoft's documentation omits the double-quote from the list
+      of characters that need quoting, but that is a mistake (unquoted
+      quotes are included in the value, but they alter the quoting of
+      characters between them).
+   Reference: http://msdn.microsoft.com/en-us/library/bb490954.aspx
+ *)
+let quote_for_windows_shell s =
+  let b = Buffer.create (20 + String.length s) in
+  for i = 0 to String.length s - 1 do
+    begin match s.[i] with
+    | '<' | '>' | '|' | '&' | '^' | '\"' ->
+      Buffer.add_char b '^';
+    | _ -> ()
+    end;
+    Buffer.add_char b s.[i];
+  done;
+  Buffer.contents b
+;;
+
+(* Returns a command line prefix to set environment for the debuggee *)
+let get_win32_environment () =
+  (* Note: no space before the & or Windows will add it to the value *)
+  let f (vname, vvalue) =
+    Printf.sprintf "set %s=%s&" vname (quote_for_windows_shell vvalue)
+  in
+  String.concat "" (List.map f !Debugger_config.environment)
+
+(* A generic function for launching the program *)
+let generic_exec_unix cmdline = function () ->
+  if !debug_loading then
+    prerr_endline "Launching program...";
+  let child =
+    try
+      fork ()
+    with x ->
+      Unix_tools.report_error x;
+      raise Toplevel in
+  match child with
+    0 ->
+      begin try
+         match fork () with
+           0 -> (* Try to detach the process from the controlling terminal,
+                   so that it does not receive SIGINT on ctrl-C. *)
+                begin try ignore(setsid()) with Invalid_argument _ -> () end;
+                execv shell [| shell; "-c"; cmdline() |]
+         | _ -> exit 0
+       with x ->
+         Unix_tools.report_error x;
+         exit 1
+       end
+  | _ ->
+     match wait () with
+       (_, WEXITED 0) -> ()
+     | _ -> raise Toplevel
+
+let generic_exec_win cmdline = function () ->
+  if !debug_loading then
+    prerr_endline "Launching program...";
+  try ignore(create_process "cmd.exe" [| "/C"; cmdline() |] stdin stdout stderr)
+  with x ->
+    Unix_tools.report_error x;
+    raise Toplevel
+
+let generic_exec =
+  match Sys.os_type with
+    "Win32" -> generic_exec_win
+  | _ -> generic_exec_unix
+
+(* Execute the program by calling the runtime explicitly *)
+let exec_with_runtime =
+  generic_exec
+    (function () ->
+      match Sys.os_type with
+        "Win32" ->
+          (* This would fail on a file name with spaces
+             but quoting is even worse because Unix.create_process
+             thinks each command line parameter is a file.
+             So no good solution so far *)
+          Printf.sprintf "%sset CAML_DEBUG_SOCKET=%s& %s %s %s"
+                     (get_win32_environment ())
+                     !socket_name
+                     runtime_program
+                     !program_name
+                     !arguments
+      | _ ->
+          Printf.sprintf "%sCAML_DEBUG_SOCKET=%s %s %s %s"
+                     (get_unix_environment ())
+                     !socket_name
+                     (Filename.quote runtime_program)
+                     (Filename.quote !program_name)
+                     !arguments)
+
+(* Execute the program directly *)
+let exec_direct =
+  generic_exec
+    (function () ->
+      match Sys.os_type with
+        "Win32" ->
+          (* See the comment above *)
+          Printf.sprintf "%sset CAML_DEBUG_SOCKET=%s& %s %s"
+                     (get_win32_environment ())
+                     !socket_name
+                     !program_name
+                     !arguments
+      | _ ->
+          Printf.sprintf "%sCAML_DEBUG_SOCKET=%s %s %s"
+                     (get_unix_environment ())
+                     !socket_name
+                     (Filename.quote !program_name)
+                     !arguments)
+
+(* Ask the user. *)
+let exec_manual =
+  function () ->
+    print_newline ();
+    print_string "Waiting for connection...";
+    print_string ("(the socket is " ^ !socket_name ^ ")");
+    print_newline ()
+
+(*** Selection of the launching function. ***)
+
+type launching_function = (unit -> unit)
+
+let loading_modes =
+  ["direct", exec_direct;
+   "runtime", exec_with_runtime;
+   "manual", exec_manual]
+
+let set_launching_function func =
+  launching_func := func
+
+(* Initialization *)
+
+let _ =
+  set_launching_function exec_direct
+
+(*** Connection. ***)
+
+let connection = ref Primitives.std_io
+let connection_opened = ref false
diff --git a/debugger/program_loading.mli b/debugger/program_loading.mli
new file mode 100644
index 00000000..cb4c2161
--- /dev/null
+++ b/debugger/program_loading.mli
@@ -0,0 +1,35 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(*** Debugging. ***)
+
+val debug_loading : bool ref
+
+(*** Load program ***)
+
+(* Function used for launching the program. *)
+val launching_func : (unit -> unit) ref
+
+val load_program : unit -> unit
+
+type launching_function = (unit -> unit)
+
+val loading_modes : (string * launching_function) list
+val set_launching_function : launching_function -> unit
+
+(** Connection **)
+val connection : Primitives.io_channel ref
+val connection_opened : bool ref
diff --git a/debugger/program_management.ml b/debugger/program_management.ml
new file mode 100644
index 00000000..74cc3db3
--- /dev/null
+++ b/debugger/program_management.ml
@@ -0,0 +1,161 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Manage the loading of the program *)
+
+open Int64ops
+open Unix
+open Unix_tools
+open Debugger_config
+open Primitives
+open Parameters
+open Input_handling
+open Question
+open Program_loading
+open Time_travel
+
+(*** Connection opening and control. ***)
+
+(* Name of the file if the socket is in the unix domain.*)
+let file_name = ref (None : string option)
+
+(* Default connection handler. *)
+let buffer = Bytes.create 1024
+let control_connection pid fd =
+  if (read fd.io_fd buffer 0 1024) = 0 then
+    forget_process fd pid
+  else begin
+    prerr_string "Garbage data from process ";
+    prerr_int pid;
+    prerr_endline ""
+    end
+
+(* Accept a connection from another process. *)
+let accept_connection continue fd =
+  let (sock, _) = accept 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
+    let pid' = input_binary_int io_chan.io_in in
+    new_checkpoint pid' io_chan;
+    Input_handling.add_file io_chan (control_connection pid');
+    continue ()
+    end
+  else begin
+    if set_file_descriptor pid io_chan then
+      Input_handling.add_file io_chan (control_connection pid)
+    end
+
+(* Initialize the socket. *)
+let open_connection address continue =
+  try
+    let (sock_domain, sock_address) = 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
+        (try
+           bind sock sock_address;
+           setsockopt sock SO_REUSEADDR true;
+           listen sock 3;
+           connection := io_channel_of_descr sock;
+           Input_handling.add_file !connection (accept_connection continue);
+           connection_opened := true
+         with x -> cleanup x @@ fun () -> close sock)
+  with
+    Failure _ -> raise Toplevel
+  | (Unix_error _) as err -> report_error err; raise Toplevel
+
+(* Close the socket. *)
+let close_connection () =
+  if !connection_opened then begin
+    connection_opened := false;
+    Input_handling.remove_file !connection;
+    close_io !connection;
+    match !file_name with
+      Some file ->
+        unlink file
+    | None ->
+        ()
+    end
+
+(*** Kill program. ***)
+let loaded = ref false
+
+let kill_program () =
+  Breakpoints.remove_all_breakpoints ();
+  History.empty_history ();
+  kill_all_checkpoints ();
+  loaded := false;
+  close_connection ()
+
+let ask_kill_program () =
+  if not !loaded then
+    true
+  else
+    let answer = yes_or_no "A program is being debugged already. Kill it" in
+      if answer then
+        kill_program ();
+      answer
+
+(*** Program loading and initializations. ***)
+
+let initialize_loading () =
+  if !debug_loading then begin
+    prerr_endline "Loading debugging information...";
+    Printf.fprintf Stdlib.stderr "\tProgram: [%s]\n%!" !program_name;
+  end;
+  begin try access !program_name [F_OK]
+  with Unix_error _ ->
+    prerr_endline "Program not found.";
+    raise Toplevel;
+  end;
+  Symbols.clear_symbols ();
+  Symbols.read_symbols 0 !program_name;
+  Load_path.init (Load_path.get_paths () @ !Symbols.program_source_dirs);
+  Envaux.reset_cache ();
+  if !debug_loading then
+    prerr_endline "Opening a socket...";
+  open_connection !socket_name
+    (function () ->
+      go_to _0;
+      Symbols.set_all_events 0;
+      exit_main_loop ())
+
+(* Ensure the program is already loaded. *)
+let ensure_loaded () =
+  if not !loaded then begin
+    print_string "Loading program... ";
+    flush Stdlib.stdout;
+    if !program_name = "" then begin
+      prerr_endline "No program specified.";
+      raise Toplevel
+    end;
+    try
+      initialize_loading();
+      !launching_func ();
+      if !debug_loading then
+        prerr_endline "Waiting for connection...";
+      main_loop ();
+      loaded := true;
+      prerr_endline "done."
+    with
+      x ->
+        cleanup x kill_program
+  end
diff --git a/debugger/program_management.mli b/debugger/program_management.mli
new file mode 100644
index 00000000..38406783
--- /dev/null
+++ b/debugger/program_management.mli
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(*** Program loading and initializations. ***)
+
+val loaded : bool ref
+val ensure_loaded : unit -> unit
+
+(*** Kill program. ***)
+val kill_program : unit -> unit
+
+(* Ask whether to kill the program or not. *)
+(* If yes, kill it. *)
+(* Return true iff the program has been killed. *)
+val ask_kill_program : unit -> bool
diff --git a/debugger/question.ml b/debugger/question.ml
new file mode 100644
index 00000000..ed294bea
--- /dev/null
+++ b/debugger/question.ml
@@ -0,0 +1,48 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*        Nicolas Pouillard, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2006 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Input_handling
+open Primitives
+module Lexer = Debugger_lexer
+
+(* Ask user a yes or no question. *)
+let yes_or_no message =
+  if !interactif then
+    let finally =
+      let old_prompt = !current_prompt in
+      fun () -> stop_user_input (); current_prompt := old_prompt
+    in
+      Fun.protect ~finally @@ fun () ->
+        current_prompt := message ^ " ? (y or n) ";
+        let answer =
+          let rec ask () =
+            resume_user_input ();
+            let line =
+              string_trim (Lexer.line (Lexing.from_function read_user_input))
+            in
+              match (if String.length line > 0 then line.[0] else ' ') with
+                'y' -> true
+              | 'n' -> false
+              | _ ->
+                stop_user_input ();
+                print_string "Please answer y or n.";
+                print_newline ();
+                ask ()
+          in
+            ask ()
+        in
+          answer
+  else
+    false
diff --git a/debugger/question.mli b/debugger/question.mli
new file mode 100644
index 00000000..75f22555
--- /dev/null
+++ b/debugger/question.mli
@@ -0,0 +1,17 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*        Nicolas Pouillard, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2006 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Ask user a yes or no question. *)
+val yes_or_no : string -> bool
diff --git a/debugger/show_information.ml b/debugger/show_information.ml
new file mode 100644
index 00000000..27cdf5f6
--- /dev/null
+++ b/debugger/show_information.ml
@@ -0,0 +1,121 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Instruct
+open Format
+open Debugcom
+open Checkpoints
+open Events
+open Symbols
+open Frames
+open Source
+open Show_source
+open Breakpoints
+open Parameters
+
+(* Display information about the current event. *)
+let show_current_event ppf =
+  if !Parameters.time then begin
+    fprintf ppf "Time: %Li" (current_time ());
+    (match current_pc () with
+     | Some pc ->
+         fprintf ppf " - pc: %i:%i" pc.frag pc.pos
+     | _ -> ());
+  end;
+  update_current_event ();
+  reset_frame ();
+  match current_report ()  with
+  | None ->
+      if !Parameters.time then fprintf ppf "@.";
+      fprintf ppf "Beginning of program.@.";
+      show_no_point ()
+  | Some {rep_type = (Event | Breakpoint); rep_program_pointer = pc} ->
+        let ev = (get_current_event ()).ev_ev in
+        if !Parameters.time then fprintf ppf " - module %s@." ev.ev_module;
+        (match breakpoints_at_pc pc with
+         | [] ->
+             ()
+         | [breakpoint] ->
+             fprintf ppf "Breakpoint: %i@." breakpoint
+         | breakpoints ->
+             fprintf ppf "Breakpoints: %a@."
+             (fun ppf l ->
+               List.iter
+                (function x -> fprintf ppf "%i " x) l)
+             (List.sort compare breakpoints));
+        show_point ev true
+  | Some {rep_type = Exited} ->
+      if !Parameters.time then fprintf ppf "@.";
+      fprintf ppf "Program exit.@.";
+      show_no_point ()
+  | Some {rep_type = Uncaught_exc} ->
+      if !Parameters.time then fprintf ppf "@.";
+      fprintf ppf
+        "Program end.@.\
+         @[Uncaught exception:@ %a@]@."
+      Printval.print_exception (Debugcom.Remote_value.accu ());
+      show_no_point ()
+  | Some {rep_type = Code_loaded frag} ->
+      let mds = String.concat ", " (Symbols.modules_in_code_fragment frag) in
+      fprintf ppf "@.Module(s) %s loaded.@." mds;
+      show_no_point ()
+  | Some {rep_type = Trap_barrier}
+  | Some {rep_type = Debug_info _}
+  | Some {rep_type = Code_unloaded _} ->
+      (* Not visible outside *)
+      (* of module `time_travel'. *)
+      if !Parameters.time then fprintf ppf "@.";
+      Misc.fatal_error "Show_information.show_current_event"
+
+(* Display short information about one frame. *)
+
+let show_one_frame framenum ppf ev =
+  let pos = Events.get_pos ev.ev_ev in
+  let cnum =
+    try
+      let buffer = get_buffer pos ev.ev_ev.ev_module in
+      snd (start_and_cnum buffer pos)
+    with _ -> pos.Lexing.pos_cnum in
+  if !machine_readable then
+    fprintf ppf "#%i  Pc: %i:%i  %s char %i@."
+           framenum ev.ev_frag ev.ev_ev.ev_pos ev.ev_ev.ev_module
+           cnum
+  else
+    fprintf ppf "#%i %s %s:%i:%i@."
+           framenum ev.ev_ev.ev_module
+           pos.Lexing.pos_fname pos.Lexing.pos_lnum
+           (pos.Lexing.pos_cnum - pos.Lexing.pos_bol + 1)
+
+(* Display information about the current frame. *)
+(* --- `select frame' must have succeeded before calling this function. *)
+let show_current_frame ppf selected =
+  match !selected_event with
+  | None ->
+      fprintf ppf "@.No frame selected.@."
+  | Some sel_ev ->
+      show_one_frame !current_frame ppf sel_ev;
+      begin match breakpoints_at_pc
+                    {frag=sel_ev.ev_frag; pos = sel_ev.ev_ev.ev_pos} with
+      | [] -> ()
+      | [breakpoint] ->
+          fprintf ppf "Breakpoint: %i@." breakpoint
+      | breakpoints ->
+          fprintf ppf "Breakpoints: %a@."
+          (fun ppf l ->
+            List.iter (function x -> fprintf ppf "%i " x) l)
+          (List.sort compare breakpoints);
+      end;
+      show_point sel_ev.ev_ev selected
diff --git a/debugger/show_information.mli b/debugger/show_information.mli
new file mode 100644
index 00000000..bc5df9d9
--- /dev/null
+++ b/debugger/show_information.mli
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Format
+
+(* Display information about the current event. *)
+val show_current_event : formatter -> unit
+
+(* Display information about the current frame. *)
+(* --- `select frame' must have succeeded before calling this function. *)
+val show_current_frame : formatter -> bool -> unit
+
+(* Display short information about one frame. *)
+val show_one_frame : int -> formatter -> Events.code_event -> unit
diff --git a/debugger/show_source.ml b/debugger/show_source.ml
new file mode 100644
index 00000000..357132da
--- /dev/null
+++ b/debugger/show_source.ml
@@ -0,0 +1,94 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Debugger_config
+open Instruct
+open Parameters
+open Primitives
+open Printf
+open Source
+
+(* Print a line; return the beginning of the next line *)
+let print_line buffer line_number start point before =
+  let linefeed = next_linefeed buffer start
+  and content = buffer_content buffer
+  in
+    printf "%i " line_number;
+    let line_end =
+      if linefeed > 0 && content.[linefeed - 1] = '\r' then
+        linefeed - 1
+      else
+        linefeed in
+    if point <= line_end && point >= start then
+      (print_string (String.sub content start (point - start));
+       print_string (if before then event_mark_before else event_mark_after);
+       print_string (String.sub content point (line_end - point)))
+    else
+      print_string (String.sub content start (line_end - start));
+    print_newline ();
+    linefeed
+
+(* Tell Emacs we are nowhere in the source. *)
+let show_no_point () =
+  if !emacs then printf "\026\026H\n"
+
+(* Print the line containing the point *)
+let show_point ev selected =
+  let mdle = ev.ev_module in
+  let before = (ev.ev_kind = Event_before) in
+  if !emacs && selected then
+    begin try
+      let buffer = get_buffer (Events.get_pos ev) mdle in
+      let source = source_of_module ev.ev_loc.Location.loc_start mdle in
+      printf "\026\026M%s:%i:%i" source
+        (snd (start_and_cnum buffer ev.ev_loc.Location.loc_start))
+        (snd (start_and_cnum buffer ev.ev_loc.Location.loc_end));
+      printf "%s\n" (if before then ":before" else ":after")
+    with
+      Out_of_range -> (* point_of_coord *)
+        prerr_endline "Position out of range."
+    | Not_found    -> (* Events.get_pos || get_buffer *)
+        prerr_endline ("No source file for " ^ mdle ^ ".");
+        show_no_point ()
+    end
+  else
+    begin try
+      let pos = Events.get_pos ev in
+      let buffer = get_buffer pos mdle in
+      let start, point = start_and_cnum buffer pos in
+      ignore(print_line buffer pos.Lexing.pos_lnum start point before)
+    with
+      Out_of_range -> (* point_of_coord *)
+        prerr_endline "Position out of range."
+    | Not_found    -> (* Events.get_pos || get_buffer *)
+        prerr_endline ("No source file for " ^ mdle ^ ".")
+    end
+
+(* Display part of the source. *)
+let show_listing pos mdle start stop point before =
+  try
+    let buffer = get_buffer pos mdle in
+      let rec aff (line_start, line_number) =
+        if line_number <= stop then
+          aff (print_line buffer line_number line_start point before + 1,
+               line_number + 1)
+      in
+        aff (pos_of_line buffer start)
+  with
+    Out_of_range -> (* pos_of_line *)
+      prerr_endline "Position out of range."
+  | Not_found    -> (* get_buffer *)
+      prerr_endline ("No source file for " ^ mdle ^ ".")
diff --git a/debugger/show_source.mli b/debugger/show_source.mli
new file mode 100644
index 00000000..2d77caa8
--- /dev/null
+++ b/debugger/show_source.mli
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Print the line containing the point *)
+val show_point : Instruct.debug_event -> bool -> unit;;
+
+(* Tell Emacs we are nowhere in the source. *)
+val show_no_point : unit -> unit;;
+
+(* Display part of the source. *)
+val show_listing :
+  Lexing.position -> string -> int -> int -> int -> bool -> unit
+;;
diff --git a/debugger/source.ml b/debugger/source.ml
new file mode 100644
index 00000000..b1f9b2ea
--- /dev/null
+++ b/debugger/source.ml
@@ -0,0 +1,191 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(************************ Source management ****************************)
+
+open Misc
+open Primitives
+
+let source_extensions = [".ml"]
+
+(*** Conversion function. ***)
+
+let source_of_module pos mdle =
+  let pos_fname = pos.Lexing.pos_fname in
+  if Sys.file_exists pos_fname then pos_fname else
+  let is_submodule m m' =
+    let len' = String.length m' in
+    try
+      (String.sub m 0 len') = m' && (String.get m len') = '.'
+    with
+        Invalid_argument _ -> false in
+  let path =
+    Hashtbl.fold
+      (fun mdl dirs acc ->
+        if is_submodule mdle mdl then
+          dirs
+        else
+          acc)
+      Debugger_config.load_path_for
+      (Load_path.get_paths ()) in
+  let fname = pos.Lexing.pos_fname in
+  if fname = "" then
+    let innermost_module =
+      try
+        let dot_index = String.rindex mdle '.' in
+        String.sub mdle (succ dot_index) (pred (String.length mdle - dot_index))
+      with Not_found -> mdle in
+    let rec loop =
+      function
+        | [] -> raise Not_found
+        | ext :: exts ->
+          try find_in_path_uncap path (innermost_module ^ ext)
+          with Not_found -> loop exts
+    in loop source_extensions
+  else if Filename.is_relative fname then
+    find_in_path_rel path fname
+  else if Sys.file_exists fname then fname
+  else raise Not_found
+
+(*** Buffer cache ***)
+
+(* Buffer and cache (to associate lines and positions in the buffer). *)
+type buffer = string * (int * int) list ref
+
+let buffer_max_count = ref 10
+
+let buffer_list =
+  ref ([] : (string * buffer) list)
+
+let flush_buffer_list () =
+  buffer_list := []
+
+let get_buffer pos mdle =
+  try List.assoc mdle !buffer_list with
+    Not_found ->
+      let inchan = open_in_bin (source_of_module pos mdle) in
+      let content = really_input_string inchan (in_channel_length inchan) in
+      let buffer = (content, ref []) in
+      buffer_list :=
+        (list_truncate !buffer_max_count ((mdle, buffer)::!buffer_list));
+      buffer
+
+let buffer_content =
+  (fst : buffer -> string)
+
+let buffer_length x =
+  String.length (buffer_content x)
+
+(*** Position conversions. ***)
+
+type position = int * int
+
+(* Insert a new pair (position, line) in the cache of the given buffer. *)
+let insert_pos buffer ((position, line) as pair) =
+  let rec new_list =
+    function
+      [] ->
+        [(position, line)]
+    | ((_pos, lin) as a::l) as l' ->
+        if lin < line then
+          pair::l'
+        else if lin = line then
+          l'
+        else
+          a::(new_list l)
+  in
+    let buffer_cache = snd buffer in
+      buffer_cache := new_list !buffer_cache
+
+(* Position of the next linefeed after `pos'. *)
+(* Position just after the buffer end if no linefeed found. *)
+(* Raise `Out_of_range' if already there. *)
+let next_linefeed (buffer, _) pos =
+  let len = String.length buffer in
+    if pos >= len then
+      raise Out_of_range
+    else
+      let rec search p =
+        if p = len || String.get buffer p = '\n' then
+          p
+        else
+          search (succ p)
+      in
+        search pos
+
+(* Go to next line. *)
+let next_line buffer (pos, line) =
+  (next_linefeed buffer pos + 1, line + 1)
+
+(* Convert a position in the buffer to a line number. *)
+let line_of_pos buffer position =
+  let rec find =
+    function
+    | [] ->
+        if position < 0 then
+          raise Out_of_range
+        else
+          (0, 1)
+    | ((pos, _line) as pair)::l ->
+        if pos > position then
+          find l
+        else
+          pair
+  and find_line previous =
+    let (pos, _line) as next = next_line buffer previous in
+      if pos <= position then
+        find_line next
+      else
+        previous
+  in
+    let result = find_line (find !(snd buffer)) in
+      insert_pos buffer result;
+      result
+
+(* Convert a line number to a position. *)
+let pos_of_line buffer line =
+  let rec find =
+    function
+      [] ->
+        if line <= 0 then
+          raise Out_of_range
+        else
+          (0, 1)
+    | ((_pos, lin) as pair)::l ->
+        if lin > line then
+          find l
+        else
+          pair
+  and find_pos previous =
+    let (_, lin) as next = next_line buffer previous in
+      if lin <= line then
+        find_pos next
+      else
+        previous
+  in
+    let result = find_pos (find !(snd buffer)) in
+      insert_pos buffer result;
+      result
+
+(* Convert a coordinate (line / column) into a position. *)
+(* --- The first line and column are line 1 and column 1. *)
+let point_of_coord buffer line column =
+  fst (pos_of_line buffer line) + (pred column)
+
+let start_and_cnum buffer pos =
+  let line_number = pos.Lexing.pos_lnum in
+  let start = point_of_coord buffer line_number 1 in
+  start, start + (pos.Lexing.pos_cnum - pos.Lexing.pos_bol)
diff --git a/debugger/source.mli b/debugger/source.mli
new file mode 100644
index 00000000..119d6704
--- /dev/null
+++ b/debugger/source.mli
@@ -0,0 +1,62 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(************************ Source management ****************************)
+
+(*** Conversion function. ***)
+
+val source_of_module: Lexing.position -> string -> string
+
+(*** buffer cache ***)
+
+type buffer
+
+val buffer_max_count : int ref
+
+val flush_buffer_list : unit -> unit
+
+val get_buffer : Lexing.position -> string -> buffer
+
+val buffer_content : buffer -> string
+val buffer_length : buffer -> int
+
+(*** Position conversions. ***)
+
+(* Pair (position, line) where `position' is the position in character of *)
+(* the beginning of the line (first character is 0) and `line' is its *)
+(* number (first line number is 1). *)
+type position = int * int
+
+(* Position of the next linefeed after `pos'. *)
+(* Position just after the buffer end if no linefeed found. *)
+(* Raise `Out_of_range' if already there. *)
+val next_linefeed : buffer -> int -> int
+
+(* Go to next line. *)
+val next_line : buffer -> position -> position
+
+(* Convert a position in the buffer to a line number. *)
+val line_of_pos : buffer -> int -> position
+
+(* Convert a line number to a position. *)
+val pos_of_line : buffer -> int -> position
+
+(* Convert a coordinate (line / column) into a position. *)
+(* --- The first line and column are line 1 and column 1. *)
+val point_of_coord : buffer -> int -> int -> int
+
+(* Return the offsets of both line start and cnum for the passed position. *)
+val start_and_cnum : buffer -> Lexing.position -> (int * int)
diff --git a/debugger/symbols.ml b/debugger/symbols.ml
new file mode 100644
index 00000000..8ed9b9db
--- /dev/null
+++ b/debugger/symbols.ml
@@ -0,0 +1,257 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Handling of symbol tables (globals and events) *)
+
+open Instruct
+open Debugger_config (* Toplevel *)
+open Program_loading
+open Debugcom
+open Events
+module String = Misc.Stdlib.String
+
+let modules =
+  ref ([] : string list)
+
+let program_source_dirs =
+  ref ([] : string list)
+
+let events_by_pc =
+  (Hashtbl.create 257 : (pc, debug_event) Hashtbl.t)
+let events_by_module =
+  (Hashtbl.create 17 : (string, int * debug_event array) Hashtbl.t)
+let all_events_by_module =
+  (Hashtbl.create 17 : (string, int * debug_event list) Hashtbl.t)
+
+let partition_modules evl =
+  let rec partition_modules' ev evl =
+    match evl with
+      [] -> [ev],[]
+    | ev'::evl ->
+       let evl,evll = partition_modules' ev' evl in
+       if ev.ev_module = ev'.ev_module then ev::evl,evll else [ev],evl::evll
+  in
+  match evl with
+    [] -> []
+  | ev::evl -> let evl,evll = partition_modules' ev evl in evl::evll
+
+let relocate_event orig ev =
+  ev.ev_pos <- orig + ev.ev_pos;
+  match ev.ev_repr with
+    Event_parent repr -> repr := ev.ev_pos
+  | _                 -> ()
+
+let read_symbols' bytecode_file =
+  let ic = open_in_bin bytecode_file in
+  begin try
+    Bytesections.read_toc ic;
+    ignore(Bytesections.seek_section ic "SYMB");
+  with Bytesections.Bad_magic_number | Not_found ->
+    prerr_string bytecode_file; prerr_endline " is not a bytecode file.";
+    raise Toplevel
+  end;
+  Symtable.restore_state (input_value ic);
+  begin try
+    ignore (Bytesections.seek_section ic "DBUG")
+  with Not_found ->
+    prerr_string bytecode_file; prerr_endline " has no debugging info.";
+    raise Toplevel
+  end;
+  let num_eventlists = input_binary_int ic in
+  let dirs = ref String.Set.empty in
+  let eventlists = ref [] in
+  for _i = 1 to num_eventlists do
+    let orig = input_binary_int ic in
+    let evl = (input_value ic : debug_event list) in
+    (* Relocate events in event list *)
+    List.iter (relocate_event orig) evl;
+    let evll = partition_modules evl in
+    eventlists := evll @ !eventlists;
+    dirs :=
+      List.fold_left (fun s e -> String.Set.add e s) !dirs (input_value ic)
+  done;
+  begin try
+    ignore (Bytesections.seek_section ic "CODE")
+  with Not_found ->
+    (* The file contains only debugging info,
+       loading mode is forced to "manual" *)
+    set_launching_function (List.assoc "manual" loading_modes)
+  end;
+  close_in_noerr ic;
+  !eventlists, !dirs
+
+let clear_symbols () =
+  modules := [];
+  program_source_dirs := [];
+  Hashtbl.clear events_by_pc; Hashtbl.clear events_by_module;
+  Hashtbl.clear all_events_by_module
+
+let add_symbols frag all_events =
+  List.iter
+    (fun evl ->
+      List.iter
+        (fun ev ->
+          Hashtbl.add events_by_pc {frag; pos = ev.ev_pos} ev)
+        evl)
+    all_events;
+
+  List.iter
+    (function
+        [] -> ()
+      | ev :: _ as evl ->
+          let md = ev.ev_module in
+          let cmp ev1 ev2 = compare (Events.get_pos ev1).Lexing.pos_cnum
+                                    (Events.get_pos ev2).Lexing.pos_cnum
+          in
+          let sorted_evl = List.sort cmp evl in
+          modules := md :: !modules;
+          Hashtbl.add all_events_by_module md (frag, sorted_evl);
+          let real_evl =
+            List.filter
+              (function
+                 {ev_kind = Event_pseudo} -> false
+               | _                        -> true)
+              sorted_evl
+          in
+          Hashtbl.add events_by_module md (frag, Array.of_list real_evl))
+    all_events
+
+let read_symbols frag bytecode_file =
+  let all_events, all_dirs = read_symbols' bytecode_file in
+  program_source_dirs := !program_source_dirs @ (String.Set.elements all_dirs);
+  add_symbols frag all_events
+
+let erase_symbols frag =
+  let pcs = Hashtbl.fold (fun pc _ pcs ->
+      if pc.frag = frag then pc :: pcs else pcs)
+    events_by_pc []
+  in
+  List.iter (Hashtbl.remove events_by_pc) pcs;
+
+  let mds = Hashtbl.fold (fun md (frag', _) mds ->
+      if frag' = frag then md :: mds else mds)
+    events_by_module []
+  in
+  List.iter (Hashtbl.remove events_by_module) mds;
+  List.iter (Hashtbl.remove all_events_by_module) mds;
+  modules := List.filter (fun md -> not (List.mem md mds)) !modules
+
+let code_fragments () =
+  let frags =
+    Hashtbl.fold
+      (fun _ (frag, _) l -> frag :: l)
+      all_events_by_module []
+  in
+  List.sort_uniq compare frags
+
+let modules_in_code_fragment frag' =
+  Hashtbl.fold (fun md (frag, _) l ->
+      if frag' = frag then md :: l else l)
+    all_events_by_module []
+
+let any_event_at_pc pc =
+  { ev_frag = pc.frag; ev_ev = Hashtbl.find events_by_pc pc }
+
+let event_at_pc pc =
+  match any_event_at_pc pc with
+    { ev_ev = { ev_kind = Event_pseudo } } -> raise Not_found
+  | ev -> ev
+
+let set_event_at_pc pc =
+ try ignore(event_at_pc pc); set_event pc
+ with Not_found -> ()
+
+(* List all events in module *)
+let events_in_module mdle =
+  try
+    Hashtbl.find all_events_by_module mdle
+  with Not_found ->
+    0, []
+
+(* Binary search of event at or just after char *)
+let find_event ev char =
+  let rec bsearch lo hi =
+    if lo >= hi then begin
+      if (Events.get_pos ev.(hi)).Lexing.pos_cnum < char
+      then raise Not_found
+      else hi
+    end else begin
+      let pivot = (lo + hi) / 2 in
+      let e = ev.(pivot) in
+      if char <= (Events.get_pos e).Lexing.pos_cnum
+      then bsearch lo pivot
+      else bsearch (pivot + 1) hi
+    end
+  in
+  if Array.length ev = 0 then
+    raise Not_found
+  else
+    bsearch 0 (Array.length ev - 1)
+
+(* Return first event after the given position. *)
+(* Raise [Not_found] if module is unknown or no event is found. *)
+let event_at_pos md char =
+  let ev_frag, ev = Hashtbl.find events_by_module md in
+  { ev_frag; ev_ev = ev.(find_event ev char) }
+
+(* Return event closest to given position *)
+(* Raise [Not_found] if module is unknown or no event is found. *)
+let event_near_pos md char =
+  let ev_frag, ev = Hashtbl.find events_by_module md in
+  try
+    let pos = find_event ev char in
+    (* Desired event is either ev.(pos) or ev.(pos - 1),
+       whichever is closest *)
+    if pos > 0 && char - (Events.get_pos ev.(pos - 1)).Lexing.pos_cnum
+                  <= (Events.get_pos ev.(pos)).Lexing.pos_cnum - char
+    then { ev_frag; ev_ev = ev.(pos - 1) }
+    else { ev_frag; ev_ev = ev.(pos) }
+  with Not_found ->
+    let pos = Array.length ev - 1 in
+    if pos < 0 then raise Not_found;
+    { ev_frag; ev_ev = ev.(pos) }
+
+(* Flip "event" bit on all instructions *)
+let set_all_events frag =
+  Hashtbl.iter
+    (fun pc ev ->
+       match ev.ev_kind with
+         Event_pseudo -> ()
+       | _ when pc.frag = frag -> set_event pc
+       | _ -> ())
+    events_by_pc
+
+(* Previous `pc'. *)
+(* Save time if `update_current_event' is called *)
+(* several times at the same point. *)
+let old_pc = ref (None : pc option)
+
+(* Recompute the current event *)
+let update_current_event () =
+  match Checkpoints.current_pc () with
+    None ->
+      Events.current_event := None;
+      old_pc := None
+  | (Some pc) as opt_pc when opt_pc <> !old_pc ->
+      Events.current_event :=
+        begin try
+          Some (event_at_pc pc)
+        with Not_found ->
+          None
+        end;
+      old_pc := opt_pc
+  | _ ->
+      ()
diff --git a/debugger/symbols.mli b/debugger/symbols.mli
new file mode 100644
index 00000000..30728f55
--- /dev/null
+++ b/debugger/symbols.mli
@@ -0,0 +1,71 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Events
+
+(* Modules used by the program. *)
+val modules : string list ref
+
+(* Absolute directories containing source code on machine where source was
+ * compiled *)
+val program_source_dirs : string list ref
+
+(* Clear loaded symbols *)
+val clear_symbols : unit -> unit
+
+(* Read debugging info from executable or dynlinkable file
+   and associate with given code fragment *)
+val read_symbols : int -> string -> unit
+
+(* Add debugging info from memory and associate with given
+   code fragment *)
+val add_symbols : int -> Instruct.debug_event list list -> unit
+
+(* Erase debugging info associated with given code fragment *)
+val erase_symbols : int -> unit
+
+(* Return the list of all code fragments that have debug info associated *)
+val code_fragments : unit -> int list
+
+(* Flip "event" bit on all instructions in given fragment *)
+val set_all_events : int -> unit
+
+(* Return event at given PC, or raise Not_found *)
+(* Can also return pseudo-event at beginning of functions *)
+val any_event_at_pc : Debugcom.pc -> code_event
+
+(* Return event at given PC, or raise Not_found *)
+val event_at_pc : Debugcom.pc -> code_event
+
+(* Set event at given PC *)
+val set_event_at_pc : Debugcom.pc -> unit
+
+(* List the events in `module'. *)
+val events_in_module : string -> int * Instruct.debug_event list
+
+(* List the modules in given code fragment. *)
+val modules_in_code_fragment : int -> string list
+
+(* First event after the given position. *)
+(* --- Raise `Not_found' if no such event. *)
+val event_at_pos : string -> int -> code_event
+
+(* Closest event from given position. *)
+(* --- Raise `Not_found' if no such event. *)
+val event_near_pos : string -> int -> code_event
+
+(* Recompute the current event *)
+val update_current_event : unit -> unit
diff --git a/debugger/time_travel.ml b/debugger/time_travel.ml
new file mode 100644
index 00000000..4d3252fb
--- /dev/null
+++ b/debugger/time_travel.ml
@@ -0,0 +1,681 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(**************************** Time travel ******************************)
+
+open Int64ops
+open Instruct
+open Events
+open Debugcom
+open Primitives
+open Checkpoints
+open Breakpoints
+open Trap_barrier
+open Input_handling
+open Debugger_config
+open Program_loading
+open Question
+
+exception Current_checkpoint_lost
+exception Current_checkpoint_lost_start_at of int64 * int64
+
+let remove_1st key list =
+  let rec remove =
+    function
+      []   -> []
+    | a::l -> if a == key then l else a::(remove l)
+  in
+    remove list
+
+(*** Debugging. ***)
+
+let debug_time_travel = ref false
+
+(*** Internal utilities. ***)
+
+(* Insert a checkpoint in the checkpoint list.
+ * Raise `Exit' if there is already a checkpoint at the same time.
+ *)
+let insert_checkpoint ({c_time = time} as checkpoint) =
+  let rec traverse =
+    function
+      [] -> [checkpoint]
+    | (({c_time = t} as a)::l) as l' ->
+        if t > time then
+          a::(traverse l)
+        else if t = time then
+          raise Exit
+        else
+          checkpoint::l'
+  in
+    checkpoints := traverse !checkpoints
+
+(* Remove a checkpoint from the checkpoint list.
+ * --- No error if not found.
+ *)
+let remove_checkpoint checkpoint =
+  checkpoints := remove_1st checkpoint !checkpoints
+
+(* Wait for the process used by `checkpoint' to connect.
+ * --- Usually not called (the process is already connected).
+ *)
+let wait_for_connection checkpoint =
+  try
+    Exec.unprotect
+      (function () ->
+         let old_controller = Input_handling.current_controller !connection in
+           execute_with_other_controller
+             (function
+                fd ->
+                  old_controller fd;
+                  if checkpoint.c_valid = true then
+                    exit_main_loop ())
+             !connection
+             main_loop)
+  with
+    Sys.Break ->
+      checkpoint.c_parent <- root;
+      remove_checkpoint checkpoint;
+      checkpoint.c_pid <- -1;
+      raise Sys.Break
+
+(* Select a checkpoint as current. *)
+let set_current_checkpoint checkpoint =
+  if !debug_time_travel then
+    prerr_endline ("Select: " ^ (Int.to_string checkpoint.c_pid));
+  if not checkpoint.c_valid then
+    wait_for_connection checkpoint;
+  current_checkpoint := checkpoint;
+  let dead_frags = List.filter (fun frag ->
+      not (List.mem frag checkpoint.c_code_fragments))
+    (Symbols.code_fragments ())
+  in
+  List.iter Symbols.erase_symbols dead_frags;
+  set_current_connection checkpoint.c_fd
+
+(* Kill `checkpoint'. *)
+let kill_checkpoint checkpoint =
+  if !debug_time_travel then
+    prerr_endline ("Kill: " ^ (Int.to_string checkpoint.c_pid));
+  if checkpoint.c_pid > 0 then          (* Ghosts don't have to be killed ! *)
+    (if not checkpoint.c_valid then
+       wait_for_connection checkpoint;
+     stop checkpoint.c_fd;
+     if checkpoint.c_parent.c_pid > 0 then
+       wait_child checkpoint.c_parent.c_fd;
+     checkpoint.c_parent <- root;
+     close_io checkpoint.c_fd;
+     remove_file checkpoint.c_fd;
+     remove_checkpoint checkpoint);
+  checkpoint.c_pid <- -1                (* Don't exist anymore *)
+
+(*** Cleaning the checkpoint list. ***)
+
+(* Separate checkpoints before (<=) and after (>) `t'. *)
+(* ### t checkpoints -> (after, before) *)
+let cut t =
+  let rec cut_t =
+    function
+      [] -> ([], [])
+    | ({c_time = t'} as a::l) as l' ->
+        if t' <= t then
+          ([], l')
+        else
+          let (b, e) = cut_t l in
+            (a::b, e)
+  in
+    cut_t
+
+(* Partition the checkpoints list. *)
+let cut2 t0 t l =
+  let rec cut2_t0 t =
+    function
+      [] -> []
+    | l ->
+       let (after, before) = cut (t0 -- t -- _1) l in
+         let l = cut2_t0 (t ++ t) before in
+           after::l
+  in
+    let (after, before) = cut (t0 -- _1) l in
+      after::(cut2_t0 t before)
+
+(* Separate first elements and last element of a list of checkpoints. *)
+let chk_merge2 cont =
+  let rec chk_merge2_cont =
+    function
+      [] -> cont
+    | [a] ->
+        let (accepted, rejected) = cont in
+          (a::accepted, rejected)
+    | a::l ->
+        let (accepted, rejected) = chk_merge2_cont l in
+          (accepted, a::rejected)
+  in chk_merge2_cont
+
+(* Separate the checkpoint list. *)
+(* ### list -> accepted * rejected *)
+let rec chk_merge =
+  function
+    [] -> ([], [])
+  | l::tail ->
+       chk_merge2 (chk_merge tail) l
+
+let new_checkpoint_list checkpoint_count accepted rejected =
+  if List.length accepted >= checkpoint_count then
+    let (k, l) = list_truncate2 checkpoint_count accepted in
+      (k, l @ rejected)
+  else
+    let (k, l) =
+      list_truncate2 (checkpoint_count - List.length accepted) rejected
+    in
+      (List.merge (fun {c_time = t1} {c_time = t2} -> compare t2 t1) accepted k,
+       l)
+
+(* Clean the checkpoint list. *)
+(* Reference time is `time'. *)
+let clean_checkpoints time checkpoint_count =
+  let (after, before) = cut time !checkpoints in
+    let (accepted, rejected) =
+      chk_merge (cut2 time !checkpoint_small_step before)
+    in
+      let (kept, lost) =
+        new_checkpoint_list checkpoint_count accepted after
+      in
+        List.iter kill_checkpoint (lost @ rejected);
+        checkpoints := kept
+
+(*** Internal functions for moving. ***)
+
+(* Find the first checkpoint before (or at) `time'.
+ * Ask for reloading the program if necessary.
+ *)
+let find_checkpoint_before time =
+  let rec find =
+    function
+      [] ->
+        print_string "Can't go that far in the past !"; print_newline ();
+        if yes_or_no "Reload program" then begin
+          load_program ();
+          find !checkpoints
+          end
+        else
+          raise Toplevel
+    | { c_time = t } as a::l ->
+        if t > time then
+          find l
+        else
+          a
+  in find !checkpoints
+
+(* Make a copy of the current checkpoint and clean the checkpoint list. *)
+(* --- The new checkpoint is not put in the list. *)
+let duplicate_current_checkpoint () =
+  let checkpoint = !current_checkpoint in
+    if not checkpoint.c_valid then
+      wait_for_connection checkpoint;
+    let new_checkpoint =                        (* Ghost *)
+      {c_time = checkpoint.c_time;
+       c_pid = 0;
+       c_fd = checkpoint.c_fd;
+       c_valid = false;
+       c_report = checkpoint.c_report;
+       c_state = C_stopped;
+       c_parent = checkpoint;
+       c_breakpoint_version = checkpoint.c_breakpoint_version;
+       c_breakpoints = checkpoint.c_breakpoints;
+       c_trap_barrier = checkpoint.c_trap_barrier;
+       c_code_fragments = checkpoint.c_code_fragments}
+    in
+      checkpoints := list_replace checkpoint new_checkpoint !checkpoints;
+      set_current_checkpoint checkpoint;
+      clean_checkpoints (checkpoint.c_time ++ _1) (!checkpoint_max_count - 1);
+      if new_checkpoint.c_pid = 0 then  (* The ghost has not been killed *)
+        (match do_checkpoint () with    (* Duplicate checkpoint *)
+           Checkpoint_done pid ->
+             (new_checkpoint.c_pid <- pid;
+              if !debug_time_travel then
+                prerr_endline ("Waiting for connection: " ^ Int.to_string pid))
+         | Checkpoint_failed ->
+             prerr_endline
+               "A fork failed. Reducing maximum number of checkpoints.";
+             checkpoint_max_count := List.length !checkpoints - 1;
+             remove_checkpoint new_checkpoint)
+
+(* Was the movement interrupted ? *)
+(* --- An exception could have been used instead, *)
+(* --- but it is not clear where it should be caught. *)
+(* --- For instance, it should not be caught in `step' *)
+(* --- (as `step' is used in `next_1'). *)
+(* --- On the other side, other modules does not need to know *)
+(* --- about this exception. *)
+let interrupted = ref false
+
+(* Information about last breakpoint encountered *)
+let last_breakpoint = ref None
+
+(* Last debug info loaded *)
+let last_debug_info = ref None
+
+let rec do_go_dynlink steps =
+  match do_go steps with
+  | { rep_type = Code_loaded frag; rep_event_count = steps } as report ->
+    begin match !last_debug_info with
+    | Some di ->
+      Symbols.add_symbols frag di;
+      Symbols.set_all_events frag;
+      last_debug_info := None
+    | None -> assert false
+    end;
+    if !break_on_load then report
+    else do_go_dynlink steps
+  | { rep_type = Code_unloaded frag; rep_event_count = steps } ->
+    Symbols.erase_symbols frag;
+    do_go_dynlink steps
+  | { rep_type = Debug_info di; rep_event_count = steps } ->
+    last_debug_info := Some (Array.to_list di);
+    do_go_dynlink steps
+  | report -> report
+
+(* Ensure we stop on an event. *)
+let rec stop_on_event report =
+  match report with
+    {rep_type = Breakpoint; rep_program_pointer = pc;
+     rep_stack_pointer = sp} ->
+      last_breakpoint := Some (pc, sp);
+      Symbols.update_current_event ();
+      begin match !current_event with
+        None   -> find_event ()
+      | Some _ -> ()
+      end
+  | {rep_type = Trap_barrier} ->
+      (* No event at current position. *)
+      find_event ()
+  | _ ->
+      ()
+
+and find_event () =
+  if !debug_time_travel then begin
+    print_string "Searching next event...";
+    print_newline ()
+  end;
+  let report = do_go_dynlink _1 in
+  !current_checkpoint.c_report <- Some report;
+  stop_on_event report
+
+(* Internal function for running debugged program.
+ * Requires `duration > 0'.
+ *)
+let internal_step duration =
+  match current_report () with
+    Some {rep_type = Exited | Uncaught_exc} -> ()
+  | _ ->
+      Exec.protect
+        (function () ->
+           if !make_checkpoints then
+             duplicate_current_checkpoint ()
+           else
+             remove_checkpoint !current_checkpoint;
+           update_breakpoints ();
+           update_trap_barrier ();
+           !current_checkpoint.c_state <- C_running duration;
+           let report = do_go_dynlink duration in
+             !current_checkpoint.c_report <- Some report;
+             !current_checkpoint.c_state <- C_stopped;
+             !current_checkpoint.c_code_fragments <- Symbols.code_fragments ();
+             if report.rep_type = Event then begin
+               !current_checkpoint.c_time <-
+                 !current_checkpoint.c_time ++ duration;
+               interrupted := false;
+               last_breakpoint := None
+               end
+             else begin
+               !current_checkpoint.c_time <-
+                  !current_checkpoint.c_time ++ duration
+                  -- report.rep_event_count ++ _1;
+               interrupted := true;
+               last_breakpoint := None;
+               stop_on_event report
+               end;
+             (try
+                insert_checkpoint !current_checkpoint
+              with
+                Exit ->
+                  kill_checkpoint !current_checkpoint;
+                  set_current_checkpoint
+                    (find_checkpoint_before (current_time ()))));
+        if !debug_time_travel then begin
+          print_string "Checkpoints: pid(time)"; print_newline ();
+          List.iter
+            (function {c_time = time; c_pid = pid; c_valid = valid} ->
+              Printf.printf "%d(%Ld)%s " pid time
+                            (if valid then "" else "(invalid)"))
+            !checkpoints;
+          print_newline ()
+        end
+
+(*** Miscellaneous functions (exported). ***)
+
+(* Create a checkpoint at time 0 (new program). *)
+let new_checkpoint pid fd =
+  let new_checkpoint =
+    {c_time = _0;
+     c_pid = pid;
+     c_fd = fd;
+     c_valid = true;
+     c_report = None;
+     c_state = C_stopped;
+     c_parent = root;
+     c_breakpoint_version = 0;
+     c_breakpoints = [];
+     c_trap_barrier = 0;
+     c_code_fragments = [0]}
+  in
+    insert_checkpoint new_checkpoint
+
+(* Set the file descriptor of a checkpoint *)
+(* (a new process has connected with the debugger). *)
+(* --- Return `true' on success (close the connection otherwise). *)
+let set_file_descriptor pid fd =
+  let rec find =
+    function
+      [] ->
+        prerr_endline "Unexpected connection";
+        close_io fd;
+        false
+    | ({c_pid = pid'} as checkpoint)::l ->
+        if pid <> pid' then
+          find l
+        else
+          (checkpoint.c_fd <- fd;
+           checkpoint.c_valid <- true;
+           true)
+  in
+    if !debug_time_travel then
+      prerr_endline ("New connection: " ^(Int.to_string pid));
+    find (!current_checkpoint::!checkpoints)
+
+(* Kill all the checkpoints. *)
+let kill_all_checkpoints () =
+  List.iter kill_checkpoint (!current_checkpoint::!checkpoints)
+
+(* Kill a checkpoint without killing the process. *)
+(* (used when connection with the process is lost). *)
+(* --- Assume that the checkpoint is valid. *)
+let forget_process fd pid =
+  let checkpoint =
+    List.find (function c -> c.c_pid = pid) (!current_checkpoint::!checkpoints)
+  in
+  if pid > 0 then begin
+    Printf.eprintf "Lost connection with process %d" pid;
+    let kont =
+      if checkpoint == !current_checkpoint then begin
+        Printf.eprintf " (active process)\n";
+        match !current_checkpoint.c_state with
+          C_stopped ->
+            Printf.eprintf "at time %Ld" !current_checkpoint.c_time;
+            fun () -> raise Current_checkpoint_lost
+        | C_running duration ->
+            Printf.eprintf "between time %Ld and time %Ld"
+                          !current_checkpoint.c_time
+                          (!current_checkpoint.c_time ++ duration);
+            fun () -> raise (Current_checkpoint_lost_start_at
+                              (!current_checkpoint.c_time, duration))
+        end
+      else ignore in
+    Printf.eprintf "\n"; flush stderr;
+    Input_handling.remove_file fd;
+    close_io checkpoint.c_fd;
+    remove_file checkpoint.c_fd;
+    remove_checkpoint checkpoint;
+    checkpoint.c_pid <- -1;             (* Don't exist anymore *)
+    if checkpoint.c_parent.c_pid > 0 then
+      wait_child checkpoint.c_parent.c_fd;
+    kont ()
+  end
+
+(* Try to recover when the current checkpoint is lost. *)
+let recover () =
+  set_current_checkpoint
+    (find_checkpoint_before (current_time ()))
+
+(*** Simple movements. ***)
+
+(* Forward stepping.  Requires `duration >= 0'. *)
+let rec step_forward duration =
+  if duration > !checkpoint_small_step then begin
+    let first_step =
+      if duration > !checkpoint_big_step then
+        !checkpoint_big_step
+      else
+        !checkpoint_small_step
+    in
+      internal_step first_step;
+      if not !interrupted then
+        step_forward (duration -- first_step)
+    end
+  else if duration != _0 then
+    internal_step duration
+
+(* Go to time `time' from current checkpoint (internal). *)
+let internal_go_to time =
+  let duration = time -- (current_time ()) in
+    if duration > _0 then
+      execute_without_breakpoints (function () -> step_forward duration)
+
+(* Move to a given time. *)
+let go_to time =
+  let checkpoint = find_checkpoint_before time in
+    set_current_checkpoint checkpoint;
+    internal_go_to time
+
+(* Return the time of the last breakpoint *)
+(* between current time and `max_time'. *)
+let find_last_breakpoint max_time =
+  let rec find break =
+    let time = current_time () in
+    step_forward (max_time -- time);
+    match !last_breakpoint, !temporary_breakpoint_position with
+      (Some _, _) when current_time () < max_time ->
+        find !last_breakpoint
+    | (Some (pc, _), Some pc') when pc = pc' ->
+        (max_time, !last_breakpoint)
+    | _ ->
+        (time, break)
+  in
+    find
+      (match current_pc_sp () with
+         (Some (pc, _)) as state when breakpoint_at_pc pc -> state
+       | _                                                -> None)
+
+(* Run from `time_max' back to `time'. *)
+(* --- Assume 0 <= time < time_max *)
+let rec back_to time time_max =
+  let
+    {c_time = t} = find_checkpoint_before (pre64 time_max)
+  in
+    go_to (max time t);
+    let (new_time, break) = find_last_breakpoint time_max in
+    if break <> None || (new_time <= time) then begin
+      go_to new_time;
+      interrupted := break <> None;
+      last_breakpoint := break
+    end else
+      back_to time new_time
+
+(* Backward stepping. *)
+(* --- Assume duration > 1 *)
+let step_backward duration =
+  let time = current_time () in
+    if time > _0 then
+      back_to (max _0 (time -- duration)) time
+
+(* Run the program from current time. *)
+(* Stop at the first breakpoint, or at the end of the program. *)
+let rec run () =
+  internal_step !checkpoint_big_step;
+  if not !interrupted then
+    run ()
+
+(* Run the program backward from current time. *)
+(* Stop at the first breakpoint, or at the beginning of the program. *)
+let back_run () =
+  if current_time () > _0 then
+    back_to _0 (current_time ())
+
+(* Step in any direction. *)
+(* Stop at the first breakpoint, or after `duration' steps. *)
+let step duration =
+  if duration >= _0 then
+    step_forward duration
+  else
+    step_backward (_0 -- duration)
+
+(*** Next, finish. ***)
+
+(* Finish current function. *)
+let finish () =
+  Symbols.update_current_event ();
+  match !current_event with
+    None ->
+      prerr_endline "`finish' not meaningful in outermost frame.";
+      raise Toplevel
+  | Some {ev_ev={ev_stacksize}} ->
+      set_initial_frame();
+      let (frame, pc) = up_frame ev_stacksize in
+      if frame < 0 then begin
+        prerr_endline "`finish' not meaningful in outermost frame.";
+        raise Toplevel
+      end;
+      begin
+        try ignore(Symbols.any_event_at_pc pc)
+        with Not_found ->
+               prerr_endline "Calling function has no debugging information.";
+               raise Toplevel
+      end;
+      exec_with_trap_barrier
+        frame
+        (fun () ->
+           exec_with_temporary_breakpoint
+             pc
+             (fun () ->
+                while
+                  run ();
+                  match !last_breakpoint with
+                    Some (pc', frame') when pc = pc' ->
+                      interrupted := false;
+                      frame <> frame'
+                  | _ ->
+                      false
+                do
+                  ()
+                done))
+
+let next_1 () =
+  Symbols.update_current_event ();
+  match !current_event with
+    None ->                             (* Beginning of the program. *)
+      step _1
+  | Some {ev_ev={ev_stacksize=ev_stacksize1}} ->
+      let (frame1, _pc1) = initial_frame() in
+      step _1;
+      if not !interrupted then begin
+        Symbols.update_current_event ();
+        match !current_event with
+          None -> ()
+        | Some {ev_ev={ev_stacksize=ev_stacksize2}} ->
+            let (frame2, _pc2) = initial_frame() in
+            (* Call `finish' if we've entered a function. *)
+            if frame1 >= 0 && frame2 >= 0 &&
+               frame2 - ev_stacksize2 > frame1 - ev_stacksize1
+            then finish()
+      end
+
+(* Same as `step' (forward) but skip over function calls. *)
+let rec next =
+  function
+    0 -> ()
+  | n ->
+      next_1 ();
+      if not !interrupted then
+        next (n - 1)
+
+(* Run backward until just before current function. *)
+let start () =
+  Symbols.update_current_event ();
+  match !current_event with
+    None ->
+      prerr_endline "`start not meaningful in outermost frame.";
+      raise Toplevel
+  | Some {ev_ev={ev_stacksize}} ->
+      let (frame, _) = initial_frame() in
+      let (frame', pc) = up_frame ev_stacksize in
+      if frame' < 0 then begin
+        prerr_endline "`start not meaningful in outermost frame.";
+        raise Toplevel
+      end;
+      let nargs =
+        match
+          try Symbols.any_event_at_pc pc with Not_found ->
+            prerr_endline "Calling function has no debugging information.";
+            raise Toplevel
+        with
+          {ev_ev = {ev_info = Event_return nargs}} -> nargs
+        | _ ->  Misc.fatal_error "Time_travel.start"
+      in
+      let offset = if nargs < 4 then 1 else 2 in
+      let pc = { pc with pos = pc.pos - 4 * offset } in
+      while
+        exec_with_temporary_breakpoint pc back_run;
+        match !last_breakpoint with
+          Some (pc', frame') when pc = pc' ->
+            step _minus1;
+            (not !interrupted)
+              &&
+            (frame' - nargs > frame - ev_stacksize)
+        | _ ->
+            false
+      do
+        ()
+      done
+
+let previous_1 () =
+  Symbols.update_current_event ();
+  match !current_event with
+    None ->                             (* End of the program. *)
+      step _minus1
+  | Some {ev_ev={ev_stacksize=ev_stacksize1}} ->
+      let (frame1, _pc1) = initial_frame() in
+      step _minus1;
+      if not !interrupted then begin
+        Symbols.update_current_event ();
+        match !current_event with
+          None -> ()
+        | Some {ev_ev={ev_stacksize=ev_stacksize2}} ->
+            let (frame2, _pc2) = initial_frame() in
+            (* Call `start' if we've entered a function. *)
+            if frame1 >= 0 && frame2 >= 0 &&
+               frame2 - ev_stacksize2 > frame1 - ev_stacksize1
+            then start()
+      end
+
+(* Same as `step' (backward) but skip over function calls. *)
+let rec previous =
+  function
+    0 -> ()
+  | n ->
+      previous_1 ();
+      if not !interrupted then
+        previous (n - 1)
diff --git a/debugger/time_travel.mli b/debugger/time_travel.mli
new file mode 100644
index 00000000..e25bad9f
--- /dev/null
+++ b/debugger/time_travel.mli
@@ -0,0 +1,38 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(**************************** Time travel ******************************)
+
+open Primitives
+
+exception Current_checkpoint_lost
+exception Current_checkpoint_lost_start_at of int64 * int64
+
+val new_checkpoint : int -> io_channel -> unit
+val set_file_descriptor : int -> io_channel -> bool
+val kill_all_checkpoints : unit -> unit
+val forget_process : io_channel -> int -> unit
+val recover : unit -> unit
+
+val go_to : int64 -> unit
+
+val run : unit -> unit
+val back_run : unit -> unit
+val step : int64 -> unit
+val finish : unit -> unit
+val next : int -> unit
+val start : unit -> unit
+val previous : int -> unit
diff --git a/debugger/trap_barrier.ml b/debugger/trap_barrier.ml
new file mode 100644
index 00000000..0ae2b2c5
--- /dev/null
+++ b/debugger/trap_barrier.ml
@@ -0,0 +1,42 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(************************** Trap barrier *******************************)
+
+open Debugcom
+open Checkpoints
+
+let current_trap_barrier = ref 0
+
+let install_trap_barrier pos =
+  current_trap_barrier := pos
+
+let remove_trap_barrier () =
+  current_trap_barrier := 0
+
+(* Ensure the trap barrier state is up to date in current checkpoint. *)
+let update_trap_barrier () =
+  if !current_checkpoint.c_trap_barrier <> !current_trap_barrier then
+    Exec.protect
+      (function () ->
+         set_trap_barrier !current_trap_barrier;
+         !current_checkpoint.c_trap_barrier <- !current_trap_barrier)
+
+(* Execute `funct' with a trap barrier. *)
+(* --- Used by `finish'. *)
+let exec_with_trap_barrier trap_barrier funct =
+  install_trap_barrier trap_barrier;
+  Fun.protect ~finally:remove_trap_barrier funct
diff --git a/debugger/trap_barrier.mli b/debugger/trap_barrier.mli
new file mode 100644
index 00000000..7ff28631
--- /dev/null
+++ b/debugger/trap_barrier.mli
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(************************* Trap barrier ********************************)
+
+val install_trap_barrier : int -> unit
+
+val remove_trap_barrier : unit -> unit
+
+(* Ensure the trap barrier state is up to date in current checkpoint. *)
+val update_trap_barrier : unit -> unit
+
+(* Execute `funct' with a trap barrier. *)
+(* --- Used by `finish'. *)
+val exec_with_trap_barrier : int -> (unit -> unit) -> unit
diff --git a/debugger/unix_tools.ml b/debugger/unix_tools.ml
new file mode 100644
index 00000000..e9e3f85c
--- /dev/null
+++ b/debugger/unix_tools.ml
@@ -0,0 +1,145 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(****************** Tools for Unix *************************************)
+
+module Real_stdlib = Stdlib
+open Misc
+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)
+
+(*** Report a unix error. ***)
+let report_error = function
+  | Unix_error (err, fun_name, arg) ->
+     prerr_string "Unix error: '";
+     prerr_string fun_name;
+     prerr_string "' failed";
+     if String.length arg > 0 then
+       (prerr_string " on '";
+        prerr_string arg;
+        prerr_string "'");
+     prerr_string ": ";
+     prerr_endline (error_message err)
+  | _ -> fatal_error "report_error: not a Unix error"
+
+(* Find program `name' in `PATH'. *)
+(* Return the full path if found. *)
+(* Raise `Not_found' otherwise. *)
+let search_in_path name =
+  Printf.fprintf Real_stdlib.stderr "search_in_path [%s]\n%!" name;
+  let check name =
+    try access name [X_OK]; name with Unix_error _ -> raise Not_found
+  in
+    if not (Filename.is_implicit name) then
+      check name
+    else
+      let path = Sys.getenv "PATH" in
+        let length = String.length path in
+          let rec traverse pointer =
+            if (pointer >= length) || (path.[pointer] = ':') then
+              pointer
+            else
+              traverse (pointer + 1)
+          in
+            let rec find pos =
+              let pos2 = traverse pos in
+                let directory = (String.sub path pos (pos2 - pos)) in
+                  let fullname =
+                    if directory = "" then name else directory ^ "/" ^ name
+                  in
+                    try check fullname with
+                    | Not_found ->
+                        if pos2 < length then find (pos2 + 1)
+                        else raise Not_found
+          in
+            find 0
+
+(* Expand a path. *)
+(* ### path -> path' *)
+let rec expand_path ch =
+  let rec subst_variable ch =
+    try
+      let pos = String.index ch '$' in
+        if (pos + 1 < String.length ch) && (ch.[pos + 1] = '$') then
+          (String.sub ch 0 (pos + 1))
+            ^ (subst_variable
+                 (String.sub ch (pos + 2) (String.length ch - pos - 2)))
+        else
+          (String.sub ch 0 pos)
+            ^ (subst2 (String.sub ch (pos + 1) (String.length ch - pos - 1)))
+    with Not_found ->
+      ch
+  and subst2 ch =
+    let suiv =
+      let i = ref 0 in
+        while !i < String.length ch &&
+              (let c = ch.[!i] in (c >= 'a' && c <= 'z')
+                               || (c >= 'A' && c <= 'Z')
+                               || (c >= '0' && c <= '9')
+                               || c = '_')
+        do incr i done;
+        !i
+    in (Sys.getenv (String.sub ch 0 suiv))
+       ^ (subst_variable (String.sub ch suiv (String.length ch - suiv)))
+  in
+    let ch = subst_variable ch in
+      let concat_root nom ch2 =
+        try Filename.concat (getpwnam nom).pw_dir ch2
+        with Not_found ->
+          "~" ^ nom
+      in
+        if ch.[0] = '~' then
+          try
+            match String.index ch '/' with
+              1 ->
+                (let tail = String.sub ch 2 (String.length ch - 2)
+                 in
+                   try Filename.concat (Sys.getenv "HOME") tail
+                   with Not_found ->
+                     concat_root (Sys.getenv "LOGNAME") tail)
+            |  n -> concat_root
+                      (String.sub ch 1 (n - 1))
+                      (String.sub ch (n + 1) (String.length ch - n - 1))
+          with
+            Not_found ->
+              expand_path (ch ^ "/")
+        else ch
+
+let make_absolute name =
+  if Filename.is_relative name
+  then Filename.concat (getcwd ()) name
+  else name
+;;
diff --git a/debugger/unix_tools.mli b/debugger/unix_tools.mli
new file mode 100644
index 00000000..db3af072
--- /dev/null
+++ b/debugger/unix_tools.mli
@@ -0,0 +1,35 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(**************************** Tools for Unix ***************************)
+
+open Unix
+
+(* Convert a socket name into a socket address. *)
+val convert_address : string -> socket_domain * sockaddr
+
+(* Report an unix error. *)
+val report_error : exn -> unit
+
+(* Find program `name' in `PATH'. *)
+(* Return the full path if found. *)
+(* Raise `Not_found' otherwise. *)
+val search_in_path : string -> string
+
+(* Path expansion. *)
+val expand_path : string -> string
+
+val make_absolute : string -> string
diff --git a/driver/compenv.ml b/driver/compenv.ml
new file mode 100644
index 00000000..8c960915
--- /dev/null
+++ b/driver/compenv.ml
@@ -0,0 +1,679 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*       Fabrice Le Fessant, EPI Gallium, INRIA Paris-Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2013 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Clflags
+
+let output_prefix name =
+  let oname =
+    match !output_name with
+    | None -> name
+    | Some n -> if !compile_only then (output_name := None; n) else name in
+  Filename.remove_extension oname
+
+let print_version_and_library compiler =
+  Printf.printf "The OCaml %s, version " compiler;
+  print_string Config.version; print_newline();
+  print_string "Standard library directory: ";
+  print_string Config.standard_library; print_newline();
+  exit 0
+
+let print_version_string () =
+  print_string Config.version; print_newline(); exit 0
+
+let print_standard_library () =
+  print_string Config.standard_library; print_newline(); exit 0
+
+let fatal err =
+  prerr_endline err;
+  exit 2
+
+let extract_output = function
+  | Some s -> s
+  | None ->
+      fatal "Please specify the name of the output file, using option -o"
+
+let default_output = function
+  | Some s -> s
+  | None -> Config.default_executable_name
+
+let first_include_dirs = ref []
+let last_include_dirs = ref []
+let first_ccopts = ref []
+let last_ccopts = ref []
+let first_ppx = ref []
+let last_ppx = ref []
+let first_objfiles = ref []
+let last_objfiles = ref []
+let stop_early = ref false
+
+(* Check validity of module name *)
+let is_unit_name name =
+  try
+    if name = "" then raise Exit;
+    begin match name.[0] with
+    | 'A'..'Z' -> ()
+    | _ ->
+       raise Exit;
+    end;
+    for i = 1 to String.length name - 1 do
+      match name.[i] with
+      | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> ()
+      | _ ->
+         raise Exit;
+    done;
+    true
+  with Exit -> false
+;;
+
+let check_unit_name filename name =
+  if not (is_unit_name name) then
+    Location.prerr_warning (Location.in_file filename)
+      (Warnings.Bad_module_name name);;
+
+(* Compute name of module from output file name *)
+let module_of_filename inputfile outputprefix =
+  let basename = Filename.basename outputprefix in
+  let name =
+    try
+      let pos = String.index basename '.' in
+      String.sub basename 0 pos
+    with Not_found -> basename
+  in
+  let name = String.capitalize_ascii name in
+  check_unit_name inputfile name;
+  name
+;;
+
+type filename = string
+
+type readenv_position =
+  Before_args | Before_compile of filename | Before_link
+
+(* Syntax of OCAMLPARAM: SEP?(name=VALUE SEP)* _ (SEP name=VALUE)*
+   where VALUE should not contain SEP, and SEP is ',' if unspecified,
+   or ':', '|', ';', ' ' or ',' *)
+exception SyntaxError of string
+
+let print_error ppf msg =
+  Location.print_warning Location.none ppf
+    (Warnings.Bad_env_variable ("OCAMLPARAM", msg))
+
+let parse_args s =
+  let args =
+    let len = String.length s in
+    if len = 0 then []
+    else
+      (* allow first char to specify an alternative separator in ":|; ," *)
+      match s.[0] with
+      | ( ':' | '|' | ';' | ' ' | ',' ) as c ->
+         List.tl (String.split_on_char c s)
+      | _ -> String.split_on_char ',' s
+  in
+  let rec iter is_after args before after =
+    match args with
+      [] ->
+      if not is_after then
+        raise (SyntaxError "no '_' separator found")
+      else
+        (List.rev before, List.rev after)
+    | "" :: tail -> iter is_after tail before after
+    | "_" :: _ when is_after -> raise (SyntaxError "too many '_' separators")
+    | "_" :: tail -> iter true tail before after
+    | arg :: tail ->
+      let binding = try
+        Misc.cut_at arg '='
+      with Not_found ->
+        raise (SyntaxError ("missing '=' in " ^ arg))
+      in
+      if is_after then
+        iter is_after tail before (binding :: after)
+      else
+        iter is_after tail (binding :: before) after
+  in
+  iter false args [] []
+
+let setter ppf f name options s =
+  try
+    let bool = match s with
+      | "0" -> false
+      | "1" -> true
+      | _ -> raise Not_found
+    in
+    List.iter (fun b -> b := f bool) options
+  with Not_found ->
+    Printf.ksprintf (print_error ppf)
+      "bad value %s for %s" s name
+
+let int_setter ppf name option s =
+  try
+    option := int_of_string s
+  with _ ->
+    Printf.ksprintf (print_error ppf)
+      "non-integer parameter %s for %S" s name
+
+let int_option_setter ppf name option s =
+  try
+    option := Some (int_of_string s)
+  with _ ->
+    Printf.ksprintf (print_error ppf)
+      "non-integer parameter %s for %S" s name
+
+(*
+let float_setter ppf name option s =
+  try
+    option := float_of_string s
+  with _ ->
+    Location.print_warning Location.none ppf
+      (Warnings.Bad_env_variable
+         ("OCAMLPARAM", Printf.sprintf "non-float parameter for \"%s\"" name))
+*)
+
+let check_bool ppf name s =
+  match s with
+  | "0" -> false
+  | "1" -> true
+  | _ ->
+    Printf.ksprintf (print_error ppf)
+      "bad value %s for %s" s name;
+    false
+
+(* 'can-discard=' specifies which arguments can be discarded without warning
+   because they are not understood by some versions of OCaml. *)
+let can_discard = ref []
+
+let read_one_param ppf position name v =
+  let set name options s =  setter ppf (fun b -> b) name options s in
+  let clear name options s = setter ppf (fun b -> not b) name options s in
+  match name with
+  | "g" -> set "g" [ Clflags.debug ] v
+  | "bin-annot" -> set "bin-annot" [ Clflags.binary_annotations ] v
+  | "afl-instrument" -> set "afl-instrument" [ Clflags.afl_instrument ] v
+  | "afl-inst-ratio" ->
+      int_setter ppf "afl-inst-ratio" afl_inst_ratio v
+  | "annot" -> set "annot" [ Clflags.annotations ] v
+  | "absname" -> set "absname" [ Clflags.absname ] v
+  | "compat-32" -> set "compat-32" [ bytecode_compatible_32 ] v
+  | "noassert" -> set "noassert" [ noassert ] v
+  | "noautolink" -> set "noautolink" [ no_auto_link ] v
+  | "nostdlib" -> set "nostdlib" [ no_std_include ] v
+  | "linkall" -> set "linkall" [ link_everything ] v
+  | "nolabels" -> set "nolabels" [ classic ] v
+  | "principal" -> set "principal"  [ principal ] v
+  | "rectypes" -> set "rectypes" [ recursive_types ] v
+  | "safe-string" -> clear "safe-string" [ unsafe_string ] v
+  | "strict-sequence" -> set "strict-sequence" [ strict_sequence ] v
+  | "strict-formats" -> set "strict-formats" [ strict_formats ] v
+  | "thread" -> set "thread" [ use_threads ] v
+  | "unboxed-types" -> set "unboxed-types" [ unboxed_types ] v
+  | "unsafe" -> set "unsafe" [ unsafe ] v
+  | "verbose" -> set "verbose" [ verbose ] v
+  | "nopervasives" -> set "nopervasives" [ nopervasives ] v
+  | "slash" -> set "slash" [ force_slash ] v (* for ocamldep *)
+  | "keep-docs" -> set "keep-docs" [ Clflags.keep_docs ] v
+  | "keep-locs" -> set "keep-locs" [ Clflags.keep_locs ] v
+
+  | "compact" -> clear "compact" [ optimize_for_speed ] v
+  | "no-app-funct" -> clear "no-app-funct" [ applicative_functors ] v
+  | "nodynlink" -> clear "nodynlink" [ dlcode ] v
+  | "short-paths" -> clear "short-paths" [ real_paths ] v
+  | "trans-mod" -> set "trans-mod" [ transparent_modules ] v
+  | "opaque" -> set "opaque" [ opaque ] v
+
+  | "pp" -> preprocessor := Some v
+  | "runtime-variant" -> runtime_variant := v
+  | "with-runtime" -> set "with-runtime" [ with_runtime ] v
+  | "open" ->
+      open_modules := List.rev_append (String.split_on_char ',' v) !open_modules
+  | "cc" -> c_compiler := Some v
+
+  | "clambda-checks" -> set "clambda-checks" [ clambda_checks ] v
+
+  | "function-sections" ->
+    set "function-sections" [ Clflags.function_sections ] v
+  (* assembly sources *)
+  |  "s" ->
+    set "s" [ Clflags.keep_asm_file ; Clflags.keep_startup_file ] v
+  |  "S" -> set "S" [ Clflags.keep_asm_file ] v
+  |  "dstartup" -> set "dstartup" [ Clflags.keep_startup_file ] v
+
+  (* warn-errors *)
+  | "we" | "warn-error" -> Warnings.parse_options true v
+  (* warnings *)
+  |  "w"  ->               Warnings.parse_options false v
+  (* warn-errors *)
+  | "wwe" ->               Warnings.parse_options false v
+  (* alerts *)
+  | "alert" ->             Warnings.parse_alert_option v
+
+  (* inlining *)
+  | "inline" ->
+      let module F = Float_arg_helper in
+      begin match F.parse_no_error v inline_threshold with
+      | F.Ok -> ()
+      | F.Parse_failed exn ->
+          Printf.ksprintf (print_error ppf)
+            "bad syntax %s for \"inline\": %s" v (Printexc.to_string exn)
+      end
+
+  | "inline-toplevel" ->
+    Int_arg_helper.parse v
+      "Bad syntax in OCAMLPARAM for 'inline-toplevel'"
+      inline_toplevel_threshold
+
+  | "rounds" -> int_option_setter ppf "rounds" simplify_rounds v
+  | "inline-max-unroll" ->
+    Int_arg_helper.parse v "Bad syntax in OCAMLPARAM for 'inline-max-unroll'"
+      inline_max_unroll
+  | "inline-call-cost" ->
+    Int_arg_helper.parse v
+      "Bad syntax in OCAMLPARAM for 'inline-call-cost'"
+      inline_call_cost
+  | "inline-alloc-cost" ->
+    Int_arg_helper.parse v
+      "Bad syntax in OCAMLPARAM for 'inline-alloc-cost'"
+      inline_alloc_cost
+  | "inline-prim-cost" ->
+    Int_arg_helper.parse v
+      "Bad syntax in OCAMLPARAM for 'inline-prim-cost'"
+      inline_prim_cost
+  | "inline-branch-cost" ->
+    Int_arg_helper.parse v
+      "Bad syntax in OCAMLPARAM for 'inline-branch-cost'"
+      inline_branch_cost
+  | "inline-indirect-cost" ->
+    Int_arg_helper.parse v
+      "Bad syntax in OCAMLPARAM for 'inline-indirect-cost'"
+      inline_indirect_cost
+  | "inline-lifting-benefit" ->
+    Int_arg_helper.parse v
+      "Bad syntax in OCAMLPARAM for 'inline-lifting-benefit'"
+      inline_lifting_benefit
+  | "inline-branch-factor" ->
+    Float_arg_helper.parse v
+      "Bad syntax in OCAMLPARAM for 'inline-branch-factor'"
+      inline_branch_factor
+  | "inline-max-depth" ->
+    Int_arg_helper.parse v
+      "Bad syntax in OCAMLPARAM for 'inline-max-depth'"
+      inline_max_depth
+
+  | "Oclassic" ->
+      set "Oclassic" [ classic_inlining ] v
+  | "O2" ->
+    if check_bool ppf "O2" v then begin
+      default_simplify_rounds := 2;
+      use_inlining_arguments_set o2_arguments;
+      use_inlining_arguments_set ~round:0 o1_arguments
+    end
+
+  | "O3" ->
+    if check_bool ppf "O3" v then begin
+      default_simplify_rounds := 3;
+      use_inlining_arguments_set o3_arguments;
+      use_inlining_arguments_set ~round:1 o2_arguments;
+      use_inlining_arguments_set ~round:0 o1_arguments
+    end
+  | "unbox-closures" ->
+      set "unbox-closures" [ unbox_closures ] v
+  | "unbox-closures-factor" ->
+      int_setter ppf "unbox-closures-factor" unbox_closures_factor v
+  | "remove-unused-arguments" ->
+      set "remove-unused-arguments" [ remove_unused_arguments ] v
+
+  | "inlining-report" ->
+      if !native_code then
+        set "inlining-report" [ inlining_report ] v
+
+  | "flambda-verbose" ->
+      set "flambda-verbose" [ dump_flambda_verbose ] v
+  | "flambda-invariants" ->
+      set "flambda-invariants" [ flambda_invariant_checks ] v
+  | "linscan" ->
+      set "linscan" [ use_linscan ] v
+  | "insn-sched" -> set "insn-sched" [ insn_sched ] v
+  | "no-insn-sched" -> clear "insn-sched" [ insn_sched ] v
+
+  (* color output *)
+  | "color" ->
+      begin match color_reader.parse v with
+      | None ->
+        Printf.ksprintf (print_error ppf)
+          "bad value %s for \"color\", (%s)" v color_reader.usage
+      | Some setting -> color := Some setting
+      end
+
+  | "error-style" ->
+      begin match error_style_reader.parse v with
+      | None ->
+          Printf.ksprintf (print_error ppf)
+            "bad value %s for \"error-style\", (%s)" v error_style_reader.usage
+      | Some setting -> error_style := Some setting
+      end
+
+  | "intf-suffix" -> Config.interface_suffix := v
+
+  | "I" -> begin
+      match position with
+      | Before_args -> first_include_dirs := v :: !first_include_dirs
+      | Before_link | Before_compile _ ->
+        last_include_dirs := v :: !last_include_dirs
+    end
+
+  | "cclib" ->
+    begin
+      match position with
+      | Before_compile _ -> ()
+      | Before_link | Before_args ->
+        ccobjs := Misc.rev_split_words v @ !ccobjs
+    end
+
+  | "ccopt"
+  | "ccopts"
+    ->
+    begin
+      match position with
+      | Before_link | Before_compile _ ->
+        last_ccopts := v :: !last_ccopts
+      | Before_args ->
+        first_ccopts := v :: !first_ccopts
+    end
+
+  | "ppx" ->
+    begin
+      match position with
+      | Before_link | Before_compile _ ->
+        last_ppx := v :: !last_ppx
+      | Before_args ->
+        first_ppx := v :: !first_ppx
+    end
+
+
+  | "cmo" | "cma" ->
+    if not !native_code then
+    begin
+      match position with
+      | Before_link | Before_compile _ ->
+        last_objfiles := v ::! last_objfiles
+      | Before_args ->
+        first_objfiles := v :: !first_objfiles
+    end
+
+  | "cmx" | "cmxa" ->
+    if !native_code then
+    begin
+      match position with
+      | Before_link | Before_compile _ ->
+        last_objfiles := v ::! last_objfiles
+      | Before_args ->
+        first_objfiles := v :: !first_objfiles
+    end
+
+  | "pic" ->
+    if !native_code then
+      set "pic" [ pic_code ] v
+
+  | "can-discard" ->
+    can_discard := v ::!can_discard
+
+  | "timings" | "profile" ->
+     let if_on = if name = "timings" then [ `Time ] else Profile.all_columns in
+     profile_columns := if check_bool ppf name v then if_on else []
+
+  | "stop-after" ->
+    let module P = Clflags.Compiler_pass in
+    let passes = P.available_pass_names ~native:!native_code in
+    begin match List.find_opt (String.equal v) passes with
+    | None ->
+        Printf.ksprintf (print_error ppf)
+          "bad value %s for option \"stop-after\" (expected one of: %s)"
+          v (String.concat ", " passes)
+    | Some v ->
+        let pass = Option.get (P.of_string v)  in
+        Clflags.stop_after := Some pass
+    end
+  | _ ->
+    if not (List.mem name !can_discard) then begin
+      can_discard := name :: !can_discard;
+      Printf.ksprintf (print_error ppf)
+        "Warning: discarding value of variable %S in OCAMLPARAM\n%!"
+        name
+    end
+
+let read_OCAMLPARAM ppf position =
+  try
+    let s = Sys.getenv "OCAMLPARAM" in
+    let (before, after) =
+      try
+        parse_args s
+      with SyntaxError s ->
+        print_error ppf s;
+        [],[]
+    in
+    List.iter (fun (name, v) -> read_one_param ppf position name v)
+      (match position with
+         Before_args -> before
+       | Before_compile _ | Before_link -> after)
+  with Not_found -> ()
+
+(* OCAMLPARAM passed as file *)
+
+type pattern =
+  | Filename of string
+  | Any
+
+type file_option = {
+  pattern : pattern;
+  name : string;
+  value : string;
+}
+
+let scan_line ic =
+  Scanf.bscanf ic "%[0-9a-zA-Z_.*] : %[a-zA-Z_-] = %s "
+    (fun pattern name value ->
+       let pattern =
+         match pattern with
+         | "*" -> Any
+         | _ -> Filename pattern
+       in
+       { pattern; name; value })
+
+let load_config ppf filename =
+  match open_in_bin filename with
+  | exception e ->
+      Location.errorf ~loc:(Location.in_file filename)
+        "Cannot open file %s" (Printexc.to_string e)
+      |> Location.print_report ppf;
+      raise Exit
+  | ic ->
+      let sic = Scanf.Scanning.from_channel ic in
+      let rec read line_number line_start acc =
+        match scan_line sic with
+        | exception End_of_file ->
+            close_in ic;
+            acc
+        | exception Scanf.Scan_failure error ->
+            let position = Lexing.{
+                pos_fname = filename;
+                pos_lnum = line_number;
+                pos_bol = line_start;
+                pos_cnum = pos_in ic;
+              }
+            in
+            let loc = Location.{
+                loc_start = position;
+                loc_end = position;
+                loc_ghost = false;
+              }
+            in
+            Location.errorf ~loc "Configuration file error %s" error
+            |> Location.print_report ppf;
+            close_in ic;
+            raise Exit
+        | line ->
+            read (line_number + 1) (pos_in ic) (line :: acc)
+      in
+      let lines = read 0 0 [] in
+      lines
+
+let matching_filename filename { pattern } =
+  match pattern with
+  | Any -> true
+  | Filename pattern ->
+    let filename = String.lowercase_ascii filename in
+    let pattern = String.lowercase_ascii pattern in
+    filename = pattern
+
+let apply_config_file ppf position =
+  let config_file =
+    Filename.concat Config.standard_library "ocaml_compiler_internal_params"
+  in
+  let config =
+    if Sys.file_exists config_file then
+      load_config ppf config_file
+    else
+      []
+  in
+  let config =
+    match position with
+    | Before_compile filename ->
+      List.filter (matching_filename filename) config
+    | Before_args | Before_link ->
+      List.filter (fun { pattern } -> pattern = Any) config
+  in
+  List.iter (fun { name; value } -> read_one_param ppf position name value)
+    config
+
+let readenv ppf position =
+  last_include_dirs := [];
+  last_ccopts := [];
+  last_ppx := [];
+  last_objfiles := [];
+  apply_config_file ppf position;
+  read_OCAMLPARAM ppf position;
+  all_ccopts := !last_ccopts @ !first_ccopts;
+  all_ppx := !last_ppx @ !first_ppx
+
+let get_objfiles ~with_ocamlparam =
+  if with_ocamlparam then
+    List.rev (!last_objfiles @ !objfiles @ !first_objfiles)
+  else
+    List.rev !objfiles
+
+
+
+
+
+
+type deferred_action =
+  | ProcessImplementation of string
+  | ProcessInterface of string
+  | ProcessCFile of string
+  | ProcessOtherFile of string
+  | ProcessObjects of string list
+  | ProcessDLLs of string list
+
+let c_object_of_filename name =
+  Filename.chop_suffix (Filename.basename name) ".c" ^ Config.ext_obj
+
+let process_action
+    (ppf, implementation, interface, ocaml_mod_ext, ocaml_lib_ext) action =
+  match action with
+  | ProcessImplementation name ->
+      readenv ppf (Before_compile name);
+      let opref = output_prefix name in
+      implementation ~source_file:name ~output_prefix:opref;
+      objfiles := (opref ^ ocaml_mod_ext) :: !objfiles
+  | ProcessInterface name ->
+      readenv ppf (Before_compile name);
+      let opref = output_prefix name in
+      interface ~source_file:name ~output_prefix:opref;
+      if !make_package then objfiles := (opref ^ ".cmi") :: !objfiles
+  | ProcessCFile name ->
+      readenv ppf (Before_compile name);
+      Location.input_name := name;
+      if Ccomp.compile_file name <> 0 then exit 2;
+      ccobjs := c_object_of_filename name :: !ccobjs
+  | ProcessObjects names ->
+      ccobjs := names @ !ccobjs
+  | ProcessDLLs names ->
+      dllibs := names @ !dllibs
+  | ProcessOtherFile name ->
+      if Filename.check_suffix name ocaml_mod_ext
+      || Filename.check_suffix name ocaml_lib_ext then
+        objfiles := name :: !objfiles
+      else if Filename.check_suffix name ".cmi" && !make_package then
+        objfiles := name :: !objfiles
+      else if Filename.check_suffix name Config.ext_obj
+           || Filename.check_suffix name Config.ext_lib then
+        ccobjs := name :: !ccobjs
+      else if not !native_code && Filename.check_suffix name Config.ext_dll then
+        dllibs := name :: !dllibs
+      else
+        raise(Arg.Bad("don't know what to do with " ^ name))
+
+
+let action_of_file name =
+  if Filename.check_suffix name ".ml"
+  || Filename.check_suffix name ".mlt" then
+    ProcessImplementation name
+  else if Filename.check_suffix name !Config.interface_suffix then
+    ProcessInterface name
+  else if Filename.check_suffix name ".c" then
+    ProcessCFile name
+  else
+    ProcessOtherFile name
+
+let deferred_actions = ref []
+let defer action =
+  deferred_actions := action :: !deferred_actions
+
+let anonymous filename = defer (action_of_file filename)
+let impl filename = defer (ProcessImplementation filename)
+let intf filename = defer (ProcessInterface filename)
+
+let process_deferred_actions env =
+  let final_output_name = !output_name in
+  (* Make sure the intermediate products don't clash with the final one
+     when we're invoked like: ocamlopt -o foo bar.c baz.ml. *)
+  if not !compile_only then output_name := None;
+  begin
+    match final_output_name with
+    | None -> ()
+    | Some output_name ->
+        if !compile_only then begin
+          if List.filter (function
+              | ProcessCFile name -> c_object_of_filename name <> output_name
+              | _ -> false) !deferred_actions <> [] then
+            fatal "Options -c and -o are incompatible when compiling C files";
+
+          if List.length (List.filter (function
+              | ProcessImplementation _
+              | ProcessInterface _ -> true
+              | _ -> false) !deferred_actions) > 1 then
+            fatal "Options -c -o are incompatible with compiling multiple files"
+        end;
+  end;
+  if !make_archive && List.exists (function
+      | ProcessOtherFile name -> Filename.check_suffix name ".cmxa"
+      | _ -> false) !deferred_actions then
+    fatal "Option -a cannot be used with .cmxa input files.";
+  List.iter (process_action env) (List.rev !deferred_actions);
+  output_name := final_output_name;
+  stop_early :=
+    !compile_only ||
+    !print_types ||
+    match !stop_after with
+    | None -> false
+    | Some p -> Clflags.Compiler_pass.is_compilation_pass p;
diff --git a/driver/compenv.mli b/driver/compenv.mli
new file mode 100644
index 00000000..2afbdfae
--- /dev/null
+++ b/driver/compenv.mli
@@ -0,0 +1,78 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*       Fabrice Le Fessant, EPI Gallium, INRIA Paris-Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2013 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+val module_of_filename : string -> string -> string
+
+val output_prefix : string -> string
+val extract_output : string option -> string
+val default_output : string option -> string
+
+val print_version_and_library : string -> 'a
+val print_version_string : unit -> 'a
+val print_standard_library : unit -> 'a
+val fatal : string -> 'a
+
+val first_ccopts : string list ref
+val first_ppx : string list ref
+val first_include_dirs : string list ref
+val last_include_dirs : string list ref
+
+(* return the list of objfiles, after OCAMLPARAM and List.rev *)
+val get_objfiles : with_ocamlparam:bool -> string list
+val last_objfiles : string list ref
+val first_objfiles : string list ref
+
+val stop_early : bool ref
+
+type filename = string
+
+type readenv_position =
+  Before_args | Before_compile of filename | Before_link
+
+val readenv : Format.formatter -> readenv_position -> unit
+
+(* [is_unit_name name] returns true only if [name] can be used as a
+   correct module name *)
+val is_unit_name : string -> bool
+(* [check_unit_name ppf filename name] prints a warning in [filename]
+   on [ppf] if [name] should not be used as a module name. *)
+val check_unit_name : string -> string -> unit
+
+(* Deferred actions of the compiler, while parsing arguments *)
+
+type deferred_action =
+  | ProcessImplementation of string
+  | ProcessInterface of string
+  | ProcessCFile of string
+  | ProcessOtherFile of string
+  | ProcessObjects of string list
+  | ProcessDLLs of string list
+
+val c_object_of_filename : string -> string
+
+val defer : deferred_action -> unit
+val anonymous : string -> unit
+val impl : string -> unit
+val intf : string -> unit
+
+val process_deferred_actions :
+  Format.formatter *
+  (source_file:string -> output_prefix:string -> unit) *
+  (* compile implementation *)
+  (source_file:string -> output_prefix:string -> unit) *
+  (* compile interface *)
+  string * (* ocaml module extension *)
+  string -> (* ocaml library extension *)
+  unit
diff --git a/driver/compile.ml b/driver/compile.ml
new file mode 100644
index 00000000..c41a877f
--- /dev/null
+++ b/driver/compile.ml
@@ -0,0 +1,63 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Misc
+open Compile_common
+
+let tool_name = "ocamlc"
+
+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 ->
+  Compile_common.interface info
+
+(** Bytecode compilation backend for .ml files. *)
+
+let to_bytecode i (typedtree, coercion) =
+  (typedtree, coercion)
+  |> Profile.(record transl)
+    (Translmod.transl_implementation i.module_name)
+  |> Profile.(record ~accumulate:true generate)
+    (fun { Lambda.code = lambda; required_globals } ->
+       lambda
+       |> print_if i.ppf_dump Clflags.dump_rawlambda Printlambda.lambda
+       |> Simplif.simplify_lambda
+       |> print_if i.ppf_dump Clflags.dump_lambda Printlambda.lambda
+       |> Bytegen.compile_implementation i.module_name
+       |> print_if i.ppf_dump Clflags.dump_instr Printinstr.instrlist
+       |> fun bytecode -> bytecode, required_globals
+    )
+
+let emit_bytecode i (bytecode, required_globals) =
+  let cmofile = cmo i in
+  let oc = open_out_bin cmofile in
+  Misc.try_finally
+    ~always:(fun () -> close_out oc)
+    ~exceptionally:(fun () -> Misc.remove_file cmofile)
+    (fun () ->
+       bytecode
+       |> Profile.(record ~accumulate:true generate)
+         (Emitcode.to_file oc i.module_name cmofile ~required_globals);
+    )
+
+let implementation ~source_file ~output_prefix =
+  let backend info typed =
+    let bytecode = to_bytecode info typed in
+    emit_bytecode info bytecode
+  in
+  with_info ~source_file ~output_prefix ~dump_ext:"cmo" @@ fun info ->
+  Compile_common.implementation info ~backend
diff --git a/driver/compile.mli b/driver/compile.mli
new file mode 100644
index 00000000..7c564c3e
--- /dev/null
+++ b/driver/compile.mli
@@ -0,0 +1,35 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Bytecode compilation for .ml and .mli files. *)
+
+val interface:
+  source_file:string -> output_prefix:string -> unit
+val implementation:
+  source_file:string -> output_prefix:string -> unit
+
+(** {2 Internal functions} **)
+
+val to_bytecode :
+  Compile_common.info ->
+  Typedtree.structure * Typedtree.module_coercion ->
+  Instruct.instruction list * Ident.Set.t
+(** [to_bytecode info typed] takes a typechecked implementation
+    and returns its bytecode.
+*)
+
+val emit_bytecode :
+  Compile_common.info -> Instruct.instruction list * Ident.Set.t -> unit
+(** [emit_bytecode bytecode] output the bytecode executable. *)
diff --git a/driver/compile_common.ml b/driver/compile_common.ml
new file mode 100644
index 00000000..82b5f006
--- /dev/null
+++ b/driver/compile_common.ml
@@ -0,0 +1,126 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Misc
+open Compenv
+
+type info = {
+  source_file : string;
+  module_name : string;
+  output_prefix : string;
+  env : Env.t;
+  ppf_dump : Format.formatter;
+  tool_name : string;
+  native : bool;
+}
+
+let cmx i = i.output_prefix ^ ".cmx"
+let obj i = i.output_prefix ^ Config.ext_obj
+let cmo i = i.output_prefix ^ ".cmo"
+let annot i = i.output_prefix ^ ".annot"
+
+let with_info ~native ~tool_name ~source_file ~output_prefix ~dump_ext k =
+  Compmisc.init_path ();
+  let module_name = module_of_filename source_file output_prefix in
+  Env.set_unit_name module_name;
+  let env = Compmisc.initial_env() in
+  let dump_file = String.concat "." [output_prefix; dump_ext] in
+  Compmisc.with_ppf_dump ~file_prefix:dump_file @@ fun ppf_dump ->
+  k {
+    module_name;
+    output_prefix;
+    env;
+    source_file;
+    ppf_dump;
+    tool_name;
+    native;
+  }
+
+(** Compile a .mli file *)
+
+let parse_intf i =
+  Pparse.parse_interface ~tool_name:i.tool_name i.source_file
+  |> print_if i.ppf_dump Clflags.dump_parsetree Printast.interface
+  |> print_if i.ppf_dump Clflags.dump_source Pprintast.signature
+
+let typecheck_intf info ast =
+  Profile.(record_call typing) @@ fun () ->
+  let tsg =
+    ast
+    |> Typemod.type_interface info.env
+    |> print_if info.ppf_dump Clflags.dump_typedtree Printtyped.interface
+  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 info.source_file)
+          sg);
+  ignore (Includemod.signatures info.env ~mark:Mark_both sg sg);
+  Typecore.force_delayed_checks ();
+  Warnings.check_fatal ();
+  tsg
+
+let emit_signature info ast tsg =
+  let sg =
+    let alerts = Builtin_attributes.alerts_of_sig ast in
+    Env.save_signature ~alerts tsg.Typedtree.sig_type
+      info.module_name (info.output_prefix ^ ".cmi")
+  in
+  Typemod.save_signature info.module_name tsg
+    info.output_prefix info.source_file info.env sg
+
+let interface info =
+  Profile.record_call info.source_file @@ 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
+    if not !Clflags.print_types then begin
+      emit_signature info ast tsg
+    end
+  end
+
+
+(** Frontend for a .ml file *)
+
+let parse_impl i =
+  Pparse.parse_implementation ~tool_name:i.tool_name i.source_file
+  |> print_if i.ppf_dump Clflags.dump_parsetree Printast.implementation
+  |> print_if i.ppf_dump Clflags.dump_source Pprintast.structure
+
+let typecheck_impl i parsetree =
+  parsetree
+  |> Profile.(record typing)
+    (Typemod.type_implementation
+       i.source_file i.output_prefix i.module_name i.env)
+  |> print_if i.ppf_dump Clflags.dump_typedtree
+    Printtyped.implementation_with_coercion
+
+let implementation info ~backend =
+  Profile.record_call info.source_file @@ fun () ->
+  let exceptionally () =
+    let sufs = if info.native then [ cmx; obj ] else [ cmo ] in
+    List.iter (fun suf -> remove_file (suf info)) sufs;
+  in
+  Misc.try_finally ?always:None ~exceptionally (fun () ->
+    let parsed = parse_impl info in
+    if Clflags.(should_stop_after Compiler_pass.Parsing) then () else begin
+      let typed = typecheck_impl info parsed in
+      if Clflags.(should_stop_after Compiler_pass.Typing) then () else begin
+        backend info typed
+      end;
+    end;
+    Warnings.check_fatal ();
+  )
diff --git a/driver/compile_common.mli b/driver/compile_common.mli
new file mode 100644
index 00000000..b43125d6
--- /dev/null
+++ b/driver/compile_common.mli
@@ -0,0 +1,92 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                            Gabriel Radanne                             *)
+(*                                                                        *)
+(*   Copyright 2018 Gabriel Radanne                                       *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Common compilation pipeline between bytecode and native. *)
+
+(** {2 Initialization} *)
+
+type info = {
+  source_file : string;
+  module_name : string;
+  output_prefix : string;
+  env : Env.t;
+  ppf_dump : Format.formatter;
+  tool_name : string;
+  native : bool;
+}
+(** Information needed to compile a file. *)
+
+val with_info :
+  native:bool ->
+  tool_name:string ->
+  source_file:string ->
+  output_prefix:string ->
+  dump_ext:string ->
+  (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.
+
+   Due to current implementation limitations in the compiler, it is
+   unsafe to try to compile several distinct compilation units by
+   calling [with_info] several times.
+*)
+
+(** {2 Interfaces} *)
+
+val parse_intf : info -> Parsetree.signature
+(** [parse_intf info] parses an interface (usually an [.mli] file). *)
+
+val typecheck_intf : info -> Parsetree.signature -> 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
+(** [emit_signature info parsetree typedtree] emits the [.cmi] file
+    containing the given signature.
+*)
+
+val interface : info -> unit
+(** The complete compilation pipeline for interfaces. *)
+
+(** {2 Implementations} *)
+
+val parse_impl : info -> Parsetree.structure
+(** [parse_impl info] parses an implementation (usually an [.ml] file). *)
+
+val typecheck_impl :
+  info -> Parsetree.structure -> Typedtree.structure * Typedtree.module_coercion
+(** [typecheck_impl info parsetree] typechecks an implementation and returns
+    the typedtree of the associated module, along with a coercion against
+    its public interface.
+*)
+
+val implementation :
+  info ->
+  backend:(info -> Typedtree.structure * Typedtree.module_coercion -> unit) ->
+  unit
+(** The complete compilation pipeline for implementations. *)
+
+(** {2 Build artifacts} *)
+
+val cmo : info -> string
+val cmx : info -> string
+val obj : info -> string
+val annot : info -> string
+(** Return the filename of some compiler build artifacts associated
+    with the file being compiled.
+*)
diff --git a/driver/compmisc.ml b/driver/compmisc.ml
new file mode 100644
index 00000000..601d1269
--- /dev/null
+++ b/driver/compmisc.ml
@@ -0,0 +1,87 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*       Fabrice Le Fessant, EPI Gallium, INRIA Paris-Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2013 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Compenv
+
+(* Initialize the search path.
+   [dir] is always searched first (default: the current directory),
+   then the directories specified with the -I option (in command-line order),
+   then the standard library directory (unless the -nostdlib option is given).
+ *)
+
+let init_path ?(dir="") () =
+  let dirs =
+    if !Clflags.use_threads then "+threads" :: !Clflags.include_dirs
+    else
+      !Clflags.include_dirs
+  in
+  let dirs =
+    !last_include_dirs @ dirs @ Config.flexdll_dirs @ !first_include_dirs
+  in
+  let exp_dirs =
+    List.map (Misc.expand_directory Config.standard_library) dirs in
+  Load_path.init (dir :: List.rev_append exp_dirs (Clflags.std_include_dir ()));
+  Env.reset_cache ()
+
+(* Return the initial environment in which compilation proceeds. *)
+
+(* Note: do not do init_path() in initial_env, this breaks
+   toplevel initialization (PR#8227) *)
+
+let initial_env () =
+  Ident.reinit();
+  Types.Uid.reinit();
+  let initially_opened_module =
+    if !Clflags.nopervasives then
+      None
+    else
+      Some "Stdlib"
+  in
+  Typemod.initial_env
+    ~loc:(Location.in_file "command line")
+    ~safe_string:(Config.safe_string || not !Clflags.unsafe_string)
+    ~initially_opened_module
+    ~open_implicit_modules:(List.rev !Clflags.open_modules)
+
+let set_from_env flag Clflags.{ parse; usage; env_var } =
+  try
+    match parse (Sys.getenv env_var) with
+    | None ->
+        Location.prerr_warning Location.none
+          (Warnings.Bad_env_variable (env_var, usage))
+    | Some x -> match !flag with
+      | None -> flag := Some x
+      | Some _ -> ()
+  with
+    Not_found -> ()
+
+let read_clflags_from_env () =
+  set_from_env Clflags.color Clflags.color_reader;
+  set_from_env Clflags.error_style Clflags.error_style_reader;
+  ()
+
+let with_ppf_dump ~file_prefix f =
+  let ppf_dump, finally =
+    if not !Clflags.dump_into_file
+    then Format.err_formatter, ignore
+    else
+       let ch = open_out (file_prefix ^ ".dump") in
+       let ppf = Format.formatter_of_out_channel ch in
+       ppf,
+       (fun () ->
+         Format.pp_print_flush ppf ();
+         close_out ch)
+  in
+  Misc.try_finally (fun () -> f ppf_dump) ~always:finally
diff --git a/driver/compmisc.mli b/driver/compmisc.mli
new file mode 100644
index 00000000..bb4c292b
--- /dev/null
+++ b/driver/compmisc.mli
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*       Fabrice Le Fessant, EPI Gallium, INRIA Paris-Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2013 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+val init_path : ?dir:string -> unit -> unit
+val initial_env : unit -> Env.t
+
+(* Support for flags that can also be set from an environment variable *)
+val set_from_env : 'a option ref -> 'a Clflags.env_reader -> unit
+val read_clflags_from_env : unit -> unit
+
+val with_ppf_dump : file_prefix:string -> (Format.formatter -> 'a) -> 'a
diff --git a/driver/errors.ml b/driver/errors.ml
new file mode 100644
index 00000000..96fa0240
--- /dev/null
+++ b/driver/errors.ml
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* This module should be removed.  We keep it for now, to avoid
+   breaking external tools depending on it. *)
+
+let report_error = Location.report_exception
diff --git a/driver/errors.mli b/driver/errors.mli
new file mode 100644
index 00000000..f5608931
--- /dev/null
+++ b/driver/errors.mli
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Error report *)
+open Format
+
+val report_error: formatter -> exn -> unit
diff --git a/driver/main.ml b/driver/main.ml
new file mode 100644
index 00000000..449d91c9
--- /dev/null
+++ b/driver/main.ml
@@ -0,0 +1,116 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Clflags
+open Compenv
+
+let usage = "Usage: ocamlc  \nOptions are:"
+
+(* Error messages to standard error formatter *)
+let ppf = Format.err_formatter
+
+module Options = Main_args.Make_bytecomp_options (Main_args.Default.Main)
+
+let main () =
+  Clflags.add_arguments __LOC__ Options.list;
+  Clflags.add_arguments __LOC__
+    ["-depend", Arg.Unit Makedepend.main_from_option,
+     " Compute dependencies (use 'ocamlc -depend -help' for details)"];
+  try
+    readenv ppf Before_args;
+    Clflags.parse_arguments anonymous usage;
+    Compmisc.read_clflags_from_env ();
+    if !Clflags.plugin then
+      fatal "-plugin is only supported up to OCaml 4.08.0";
+    begin try
+      Compenv.process_deferred_actions
+        (ppf,
+         Compile.implementation,
+         Compile.interface,
+         ".cmo",
+         ".cma");
+    with Arg.Bad msg ->
+      begin
+        prerr_endline msg;
+        Clflags.print_arguments usage;
+        exit 2
+      end
+    end;
+    readenv ppf Before_link;
+    if
+      List.length
+        (List.filter (fun x -> !x)
+           [make_archive;make_package;stop_early;output_c_object])
+        > 1
+    then begin
+      let module P = Clflags.Compiler_pass in
+      match !stop_after with
+      | None ->
+        fatal "Please specify at most one of -pack, -a, -c, -output-obj";
+      | Some ((P.Parsing | P.Typing) as p) ->
+        assert (P.is_compilation_pass p);
+        Printf.ksprintf fatal
+          "Options -i and -stop-after (%s) \
+           are  incompatible with -pack, -a, -output-obj"
+          (String.concat "|"
+             (Clflags.Compiler_pass.available_pass_names ~native:false))
+      | Some P.Scheduling -> assert false (* native only *)
+    end;
+    if !make_archive then begin
+      Compmisc.init_path ();
+
+      Bytelibrarian.create_archive
+        (Compenv.get_objfiles ~with_ocamlparam:false)
+        (extract_output !output_name);
+      Warnings.check_fatal ();
+    end
+    else if !make_package then begin
+      Compmisc.init_path ();
+      let extracted_output = extract_output !output_name in
+      let revd = get_objfiles ~with_ocamlparam:false in
+      Compmisc.with_ppf_dump ~file_prefix:extracted_output (fun ppf_dump ->
+        Bytepackager.package_files ~ppf_dump (Compmisc.initial_env ())
+          revd (extracted_output));
+      Warnings.check_fatal ();
+    end
+    else if not !stop_early && !objfiles <> [] then begin
+      let target =
+        if !output_c_object && not !output_complete_executable then
+          let s = extract_output !output_name in
+          if (Filename.check_suffix s Config.ext_obj
+            || Filename.check_suffix s Config.ext_dll
+            || Filename.check_suffix s ".c")
+          then s
+          else
+            fatal
+              (Printf.sprintf
+                 "The extension of the output file must be .c, %s or %s"
+                 Config.ext_obj Config.ext_dll
+              )
+        else
+          default_output !output_name
+      in
+      Compmisc.init_path ();
+      Bytelink.link (get_objfiles ~with_ocamlparam:true) target;
+      Warnings.check_fatal ();
+    end;
+  with x ->
+    Location.report_exception ppf x;
+    exit 2
+
+let () =
+  main ();
+  Profile.print Format.std_formatter !Clflags.profile_columns;
+  exit 0
diff --git a/driver/main.mli b/driver/main.mli
new file mode 100644
index 00000000..ec43cbd7
--- /dev/null
+++ b/driver/main.mli
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Damien Doligez, projet Moscova, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2000 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 "empty" file is here to speed up garbage collection in ocamlc.opt
+*)
diff --git a/driver/main_args.ml b/driver/main_args.ml
new file mode 100644
index 00000000..5c28ded5
--- /dev/null
+++ b/driver/main_args.ml
@@ -0,0 +1,1986 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*              Damien Doligez, projet Para, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1998 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let mk_a f =
+  "-a", Arg.Unit f, " Build a library"
+;;
+
+let mk_alert f =
+  "-alert", Arg.String f,
+  Printf.sprintf
+    "  Enable or disable alerts according to :\n\
+    \        +  enable alert \n\
+    \        -  disable alert \n\
+    \        ++ treat  as fatal error\n\
+    \        -- treat  as non-fatal\n\
+    \        @  enable  and treat it as fatal error\n\
+    \     can be 'all' to refer to all alert names";;
+
+let mk_absname f =
+  "-absname", Arg.Unit f, " Show absolute filenames in error messages"
+;;
+
+let mk_annot f =
+  "-annot", Arg.Unit f, " (deprecated) Save information in .annot"
+;;
+
+let mk_binannot f =
+  "-bin-annot", Arg.Unit f, " Save typedtree in .cmt"
+;;
+
+let mk_c f =
+  "-c", Arg.Unit f, " Compile only (do not link)"
+;;
+
+let mk_cc f =
+  "-cc", Arg.String f, "  Use  as the C compiler and linker"
+;;
+
+let mk_cclib f =
+  "-cclib", Arg.String f, "  Pass option  to the C linker"
+;;
+
+let mk_ccopt f =
+  "-ccopt", Arg.String f,
+  "  Pass option  to the C compiler and linker"
+;;
+
+let mk_clambda_checks f =
+  "-clambda-checks", Arg.Unit f, " Instrument clambda code with closure and \
+    field access checks (for debugging the compiler)"
+;;
+
+let mk_compact f =
+  "-compact", Arg.Unit f, " Optimize code size rather than speed"
+;;
+
+let mk_compat_32 f =
+  "-compat-32", Arg.Unit f,
+  " Check that generated bytecode can run on 32-bit platforms"
+;;
+
+let mk_config f =
+  "-config", Arg.Unit f, " Print configuration values and exit"
+;;
+
+let mk_config_var f =
+  "-config-var", Arg.String f,
+  " Print the value of a configuration variable, a newline, and exit\n\
+\    (print nothing and exit with error value if the variable does not exist)"
+;;
+
+let mk_custom f =
+  "-custom", Arg.Unit f, " Link in custom mode"
+;;
+
+let mk_dllib f =
+  "-dllib", Arg.String f, "  Use the dynamically-loaded library "
+;;
+
+let mk_dllpath f =
+  "-dllpath", Arg.String f,
+  "  Add  to the run-time search path for shared libraries"
+;;
+
+let mk_function_sections f =
+  if Config.function_sections then
+    "-function-sections",  Arg.Unit f,
+    " Generate each function in a separate section if target supports it"
+  else
+    let err () =
+      raise (Arg.Bad "OCaml has been configured without support for \
+                      -function-sections")
+    in
+    "-function-sections", Arg.Unit err, " (option not available)"
+;;
+
+let mk_stop_after ~native f =
+  "-stop-after",
+  Arg.Symbol (Clflags.Compiler_pass.available_pass_names ~native, f),
+  " Stop after the given compilation pass."
+;;
+
+let mk_dtypes f =
+  "-dtypes", Arg.Unit f, " (deprecated) same as -annot"
+;;
+
+let mk_for_pack_byt f =
+  "-for-pack", Arg.String f,
+  "  Generate code that can later be `packed' with\n\
+  \     ocamlc -pack -o .cmo"
+;;
+
+let mk_for_pack_opt f =
+  "-for-pack", Arg.String f,
+  "  Generate code that can later be `packed' with\n\
+  \     ocamlopt -pack -o .cmx"
+;;
+
+let mk_g_byt f =
+  "-g", Arg.Unit f, " Save debugging information"
+;;
+
+let mk_g_opt f =
+  "-g", Arg.Unit f, " Record debugging information for exception backtrace"
+;;
+
+let mk_i f =
+  "-i", Arg.Unit f, " Print inferred interface"
+;;
+
+let mk_I f =
+  "-I", Arg.String f, "  Add  to the list of include directories"
+;;
+
+let mk_impl f =
+  "-impl", Arg.String f, "  Compile  as a .ml file"
+;;
+
+let mk_init f =
+  "-init", Arg.String f, "  Load  instead of default init file"
+;;
+
+let mk_inline f =
+  "-inline", Arg.String f,
+    Printf.sprintf "|=[,...]  Aggressiveness of inlining \
+        (default %.02f, higher numbers mean more aggressive)"
+      Clflags.default_inline_threshold
+;;
+
+let mk_inline_toplevel f =
+  "-inline-toplevel", Arg.String f,
+    Printf.sprintf "|=[,...]  Aggressiveness of inlining at \
+      toplevel (higher numbers mean more aggressive)"
+;;
+
+let mk_inlining_report f =
+  "-inlining-report", Arg.Unit f, " Emit `..inlining' file(s) (one per \
+      round) showing the inliner's decisions"
+;;
+
+let mk_dump_pass f =
+  "-dump-pass", Arg.String f,
+  Format.asprintf
+    " @[<4>Record transformations performed by these passes:@ @[%a@]@]"
+    (Format.pp_print_list
+       ~pp_sep:Format.pp_print_space
+       Format.pp_print_string)
+    !Clflags.all_passes
+;;
+
+let mk_o2 f =
+  "-O2", Arg.Unit f, " Apply increased optimization for speed"
+;;
+
+let mk_o3 f =
+  "-O3", Arg.Unit f, " Apply aggressive optimization for speed (may \
+    significantly increase code size and compilation time)"
+;;
+
+let mk_rounds f =
+  "-rounds", Arg.Int f,
+    Printf.sprintf "  Repeat tree optimization and inlining phases this \
+        many times (default %d).  Rounds are numbered starting from zero."
+      !Clflags.default_simplify_rounds
+;;
+
+let mk_inline_max_unroll f =
+  "-inline-max-unroll", Arg.String f,
+    Printf.sprintf "|=[,...]  Unroll recursive functions at most \
+      this many times (default %d)"
+      Clflags.default_inline_max_unroll
+;;
+
+let mk_classic_inlining f =
+  "-Oclassic", Arg.Unit f, " Make inlining decisions at function definition \
+     time rather than at the call site (replicates previous behaviour of the \
+     compiler)"
+;;
+
+let mk_inline_cost arg descr default f =
+  Printf.sprintf "-inline-%s-cost" arg,
+  Arg.String f,
+  Printf.sprintf "|=[,...]  The cost of not removing %s during \
+      inlining (default %d, higher numbers more costly)"
+    descr
+    default
+;;
+
+let mk_inline_call_cost =
+  mk_inline_cost "call" "a call" Clflags.default_inline_call_cost
+let mk_inline_alloc_cost =
+  mk_inline_cost "alloc" "an allocation" Clflags.default_inline_alloc_cost
+let mk_inline_prim_cost =
+  mk_inline_cost "prim" "a primitive" Clflags.default_inline_prim_cost
+let mk_inline_branch_cost =
+  mk_inline_cost "branch" "a conditional" Clflags.default_inline_branch_cost
+let mk_inline_indirect_cost =
+  mk_inline_cost "indirect" "an indirect call"
+    Clflags.default_inline_indirect_cost
+
+let mk_inline_lifting_benefit f =
+  "-inline-lifting-benefit",
+  Arg.String f,
+  Printf.sprintf "|=[,...]  The benefit of lifting definitions \
+    to toplevel during inlining (default %d, higher numbers more beneficial)"
+    Clflags.default_inline_lifting_benefit
+;;
+
+let mk_inline_branch_factor f =
+  "-inline-branch-factor", Arg.String f,
+    Printf.sprintf "|=[,...]  Estimate the probability of a \
+        branch being cold as 1/(1+n) (used for inlining) (default %.2f)"
+    Clflags.default_inline_branch_factor
+;;
+
+let mk_intf f =
+  "-intf", Arg.String f, "  Compile  as a .mli file"
+;;
+
+let mk_intf_suffix f =
+  "-intf-suffix", Arg.String f,
+  "  Suffix for interface files (default: .mli)"
+;;
+
+let mk_intf_suffix_2 f =
+  "-intf_suffix", Arg.String f, "  (deprecated) same as -intf-suffix"
+;;
+
+let mk_insn_sched f =
+  "-insn-sched", Arg.Unit f,
+  Printf.sprintf " Run the instruction scheduling pass%s"
+    (if Clflags.insn_sched_default then " (default)" else "")
+;;
+
+let mk_no_insn_sched f =
+  "-no-insn-sched", Arg.Unit f,
+  Printf.sprintf " Do not run the instruction scheduling pass%s"
+    (if not Clflags.insn_sched_default then " (default)" else "")
+;;
+
+let mk_keep_docs f =
+  "-keep-docs", Arg.Unit f, " Keep documentation strings in .cmi files"
+;;
+
+let mk_no_keep_docs f =
+  "-no-keep-docs", Arg.Unit f,
+  " Do not keep documentation strings in .cmi files (default)"
+;;
+
+let mk_keep_locs f =
+  "-keep-locs", Arg.Unit f, " Keep locations in .cmi files (default)"
+;;
+
+let mk_no_keep_locs f =
+  "-no-keep-locs", Arg.Unit f, " Do not keep locations in .cmi files"
+;;
+
+let mk_labels f =
+  "-labels", Arg.Unit f, " Use commuting label mode"
+;;
+
+let mk_linkall f =
+  "-linkall", Arg.Unit f, " Link all modules, even unused ones"
+;;
+
+let mk_linscan f =
+  "-linscan", Arg.Unit f, " Use the linear scan register allocator"
+;;
+
+let mk_make_runtime f =
+  "-make-runtime", Arg.Unit f,
+  " Build a runtime system with given C objects and libraries"
+;;
+
+let mk_make_runtime_2 f =
+  "-make_runtime", Arg.Unit f, " (deprecated) same as -make-runtime"
+;;
+
+let mk_inline_max_depth f =
+  "-inline-max-depth", Arg.String f,
+    Printf.sprintf "|=[,...]  Maximum depth of search for \
+      inlining opportunities inside inlined functions (default %d)"
+      Clflags.default_inline_max_depth
+;;
+
+let mk_modern f =
+  "-modern", Arg.Unit f, " (deprecated) same as -labels"
+;;
+
+let mk_alias_deps f =
+  "-alias-deps", Arg.Unit f,
+  " Do record dependencies for module aliases"
+;;
+
+let mk_no_alias_deps f =
+  "-no-alias-deps", Arg.Unit f,
+  " Do not record dependencies for module aliases"
+;;
+
+let mk_app_funct f =
+  "-app-funct", Arg.Unit f, " Activate applicative functors"
+;;
+
+let mk_no_app_funct f =
+  "-no-app-funct", Arg.Unit f, " Deactivate applicative functors"
+;;
+
+let mk_no_check_prims f =
+  "-no-check-prims", Arg.Unit f, " Do not check runtime for primitives"
+;;
+
+let mk_no_float_const_prop f =
+  "-no-float-const-prop", Arg.Unit f,
+  " Deactivate constant propagation for floating-point operations"
+;;
+
+let mk_noassert f =
+  "-noassert", Arg.Unit f, " Do not compile assertion checks"
+;;
+
+let mk_noautolink_byt f =
+  "-noautolink", Arg.Unit f,
+  " Do not automatically link C libraries specified in .cma files"
+;;
+
+let mk_noautolink_opt f =
+  "-noautolink", Arg.Unit f,
+  " Do not automatically link C libraries specified in .cmxa files"
+;;
+
+let mk_nodynlink f =
+  "-nodynlink", Arg.Unit f,
+  " Enable optimizations for code that will not be dynlinked"
+;;
+
+let mk_noinit f =
+  "-noinit", Arg.Unit f,
+  " Do not load any init file"
+
+let mk_nolabels f =
+  "-nolabels", Arg.Unit f, " Ignore non-optional labels in types"
+;;
+
+let mk_noprompt f =
+  "-noprompt", Arg.Unit f, " Suppress all prompts"
+;;
+
+let mk_nopromptcont f =
+  "-nopromptcont", Arg.Unit f,
+  " Suppress prompts for continuation lines of multi-line inputs"
+;;
+
+let mk_nostdlib f =
+  "-nostdlib", Arg.Unit f,
+  " Do not add default directory to the list of include directories"
+;;
+
+let mk_no_unbox_free_vars_of_closures f =
+  "-no-unbox-free-vars-of-closures", Arg.Unit f,
+  " Do not unbox variables that will appear inside function closures"
+;;
+
+let mk_no_unbox_specialised_args f =
+  "-no-unbox-specialised-args", Arg.Unit f,
+  " Do not unbox arguments to which functions have been specialised"
+;;
+
+let mk_o f =
+  "-o", Arg.String f, "  Set output file name to "
+;;
+
+let mk_open f =
+  "-open", Arg.String f, "  Opens the module  before typing"
+
+let mk_output_obj f =
+  "-output-obj", Arg.Unit f, " Output an object file instead of an executable"
+;;
+
+let mk_output_complete_obj f =
+  "-output-complete-obj", Arg.Unit f,
+  " Output an object file, including runtime, instead of an executable"
+;;
+
+let mk_output_complete_exe f =
+  "-output-complete-exe", Arg.Unit f,
+  " Output a self-contained executable, including runtime and C stubs"
+;;
+
+let mk_p f =
+  "-p", Arg.Unit f, " (no longer supported)"
+;;
+
+let mk_pack_byt f =
+  "-pack", Arg.Unit f, " Package the given .cmo files into one .cmo"
+;;
+
+let mk_pack_opt f =
+  "-pack", Arg.Unit f, " Package the given .cmx files into one .cmx"
+;;
+
+let mk_pp f =
+  "-pp", Arg.String f, "  Pipe sources through preprocessor "
+;;
+
+let mk_ppx f =
+  "-ppx", Arg.String f,
+  "  Pipe abstract syntax trees through preprocessor "
+;;
+
+let mk_plugin f =
+  "-plugin", Arg.String f,
+  "  (no longer supported)"
+;;
+
+let mk_principal f =
+  "-principal", Arg.Unit f, " Check principality of type inference"
+;;
+
+let mk_no_principal f =
+  "-no-principal", Arg.Unit f,
+  " Do not check principality of type inference (default)"
+;;
+
+let mk_rectypes f =
+  "-rectypes", Arg.Unit f, " Allow arbitrary recursive types"
+;;
+
+let mk_no_rectypes f =
+  "-no-rectypes", Arg.Unit f,
+  " Do not allow arbitrary recursive types (default)"
+;;
+
+let mk_remove_unused_arguments f =
+  "-remove-unused-arguments", Arg.Unit f,
+  " Remove unused function arguments"
+;;
+
+let mk_runtime_variant f =
+  "-runtime-variant", Arg.String f,
+  "  Use the  variant of the run-time system"
+;;
+
+let mk_with_runtime f =
+  "-with-runtime", Arg.Unit f,
+  "Include the runtime system in the generated program (default)"
+;;
+
+let mk_without_runtime f =
+  "-without-runtime", Arg.Unit f,
+  "Do not include the runtime system in the generated program."
+;;
+
+let mk_S f =
+  "-S", Arg.Unit f, " Keep intermediate assembly file"
+;;
+
+let mk_safe_string f =
+  "-safe-string", Arg.Unit f,
+  if Config.safe_string then " (was set when configuring the compiler)"
+  else if Config.default_safe_string then " Make strings immutable (default)"
+  else " Make strings immutable"
+;;
+
+let mk_shared f =
+  "-shared", Arg.Unit f, " Produce a dynlinkable plugin"
+;;
+
+let mk_short_paths f =
+  "-short-paths", Arg.Unit f, " Shorten paths in types"
+;;
+
+let mk_stdin f =
+  "-stdin", Arg.Unit f, " Read script from standard input"
+;;
+
+let mk_no_strict_sequence f =
+  "-no-strict-sequence", Arg.Unit f,
+  " Left-hand part of a sequence need not have type unit (default)"
+;;
+
+let mk_strict_sequence f =
+  "-strict-sequence", Arg.Unit f,
+  " Left-hand part of a sequence must have type unit"
+;;
+
+let mk_thread f =
+  "-thread", Arg.Unit f,
+  " (deprecated) same as -I +threads"
+;;
+
+let mk_dtimings f =
+  "-dtimings", Arg.Unit f, " Print timings information for each pass";
+;;
+
+let mk_dprofile f =
+  "-dprofile", Arg.Unit f, Profile.options_doc
+;;
+
+let mk_unbox_closures f =
+  "-unbox-closures", Arg.Unit f,
+  " Pass free variables via specialised arguments rather than closures"
+;;
+
+let mk_unbox_closures_factor f =
+  "-unbox-closures-factor", Arg.Int f,
+  Printf.sprintf " 0>  Scale the size threshold above which \
+      unbox-closures will slow down indirect calls rather than duplicating a \
+      function (default %d)"
+    Clflags.default_unbox_closures_factor
+;;
+
+let mk_unboxed_types f =
+  "-unboxed-types", Arg.Unit f,
+  " unannotated unboxable types will be unboxed"
+;;
+
+let mk_no_unboxed_types f =
+  "-no-unboxed-types", Arg.Unit f,
+  " unannotated unboxable types will not be unboxed (default)"
+;;
+
+let mk_unsafe f =
+  "-unsafe", Arg.Unit f,
+  " Do not compile bounds checking on array and string access"
+;;
+
+let mk_unsafe_string f =
+  if Config.safe_string then
+    let err () =
+      raise (Arg.Bad "OCaml has been configured with -force-safe-string: \
+                      -unsafe-string is not available")
+    in
+    "-unsafe-string", Arg.Unit err, " (option not available)"
+  else if Config.default_safe_string then
+    "-unsafe-string", Arg.Unit f, " Make strings mutable"
+  else
+    "-unsafe-string", Arg.Unit f, " Make strings mutable (default)"
+;;
+
+let mk_use_runtime f =
+  "-use-runtime", Arg.String f,
+  "  Generate bytecode for the given runtime system"
+;;
+
+let mk_use_runtime_2 f =
+  "-use_runtime", Arg.String f,
+  "  (deprecated) same as -use-runtime"
+;;
+
+let mk_v f =
+  "-v", Arg.Unit f,
+  " Print compiler version and location of standard library and exit"
+;;
+
+let mk_verbose f =
+  "-verbose", Arg.Unit f, " Print calls to external commands"
+;;
+
+let mk_version f =
+  "-version", Arg.Unit f, " Print version and exit"
+;;
+
+let mk__version f =
+  "--version", Arg.Unit f, " Print version and exit"
+;;
+
+let mk_no_version f =
+  "-no-version", Arg.Unit f, " Do not print version at startup"
+;;
+
+let mk_vmthread f =
+  "-vmthread", Arg.Unit f,
+  "  (no longer supported)"
+;;
+
+let mk_vnum f =
+  "-vnum", Arg.Unit f, " Print version number and exit"
+;;
+
+let mk_w f =
+  "-w", Arg.String f,
+  Printf.sprintf
+  "  Enable or disable warnings according to :\n\
+  \        +   enable warnings in \n\
+  \        -   disable warnings in \n\
+  \        @   enable warnings in  and treat them as errors\n\
+  \      can be:\n\
+  \                     a single warning number\n\
+  \        ..    a range of consecutive warning numbers\n\
+  \                  a predefined set\n\
+  \     default setting is %S" Warnings.defaults_w
+;;
+
+let mk_warn_error f =
+  "-warn-error", Arg.String f,
+  Printf.sprintf
+  "  Enable or disable error status for warnings according\n\
+  \     to .  See option -w for the syntax of .\n\
+  \     Default setting is %S" Warnings.defaults_warn_error
+;;
+
+let mk_warn_help f =
+  "-warn-help", Arg.Unit f, " Show description of warning numbers"
+;;
+
+let mk_color f =
+  "-color", Arg.Symbol (["auto"; "always"; "never"], f),
+  Printf.sprintf
+  "  Enable or disable colors in compiler messages\n\
+  \    The following settings are supported:\n\
+  \      auto    use heuristics to enable colors only if supported\n\
+  \      always  enable colors\n\
+  \      never   disable colors\n\
+  \    The default setting is 'auto', and the current heuristic\n\
+  \    checks that the TERM environment variable exists and is\n\
+  \    not empty or \"dumb\", and that isatty(stderr) holds.\n\
+  \  If the option is not specified, these setting can alternatively\n\
+  \  be set through the OCAML_COLOR environment variable."
+;;
+
+let mk_error_style f =
+  "-error-style", Arg.Symbol (["contextual"; "short"], f),
+  Printf.sprintf
+    "  Control the way error messages and warnings are printed\n\
+    \    The following settings are supported:\n\
+    \      short       only print the error and its location\n\
+    \      contextual  like \"short\", but also display the source code\n\
+    \                  snippet corresponding to the location of the error\n\
+    \    The default setting is 'contextual'.\n\
+    \  If the option is not specified, these setting can alternatively\n\
+    \  be set through the OCAML_ERROR_STYLE environment variable."
+;;
+
+let mk_where f =
+  "-where", Arg.Unit f, " Print location of standard library and exit"
+;;
+
+let mk_nopervasives f =
+  "-nopervasives", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_match_context_rows f =
+  "-match-context-rows", Arg.Int f,
+  let[@manual.ref "s:comp-options"] chapter, section = 9, 2 in
+  Printf.sprintf
+  "  (advanced, see manual section %d.%d.)" chapter section
+;;
+
+let mk_use_prims f =
+  "-use-prims", Arg.String f, "  (undocumented)"
+;;
+
+let mk_dump_into_file f =
+  "-dump-into-file", Arg.Unit f, " dump output like -dlambda into .dump"
+;;
+
+let mk_dparsetree f =
+  "-dparsetree", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dtypedtree f =
+  "-dtypedtree", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_drawlambda f =
+  "-drawlambda", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dno_unique_ids f =
+  "-dno-unique-ids", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dunique_ids f =
+  "-dunique-ids", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dno_locations f =
+  "-dno-locations", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dlocations f =
+  "-dlocations", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dsource f =
+  "-dsource", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dlambda f =
+  "-dlambda", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_drawclambda f =
+  "-drawclambda", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dclambda f =
+  "-dclambda", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dflambda f =
+  "-dflambda", Arg.Unit f, " Print Flambda terms"
+;;
+
+let mk_drawflambda f =
+  "-drawflambda", Arg.Unit f, " Print Flambda terms after closure conversion"
+;;
+
+let mk_dflambda_invariants f =
+  "-dflambda-invariants", Arg.Unit f, " Check Flambda invariants \
+      around each pass"
+;;
+
+let mk_dflambda_no_invariants f =
+  "-dflambda-no-invariants", Arg.Unit f, " Do not Check Flambda invariants \
+      around each pass"
+;;
+
+let mk_dflambda_let f =
+  "-dflambda-let", Arg.Int f, "  Print when the given Flambda [Let] \
+      is created"
+;;
+
+let mk_dflambda_verbose f =
+  "-dflambda-verbose", Arg.Unit f, " Print Flambda terms including around \
+      each pass"
+;;
+
+let mk_dinstr f =
+  "-dinstr", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dcamlprimc f =
+  "-dcamlprimc", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dcmm f =
+  "-dcmm", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dsel f =
+  "-dsel", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dcombine f =
+  "-dcombine", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dcse f =
+  "-dcse", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dlive f =
+  "-dlive", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_davail f =
+  "-davail", Arg.Unit f, " Print register availability info when printing \
+    liveness"
+;;
+
+let mk_drunavail f =
+  "-drunavail", Arg.Unit f, " Run register availability pass (for testing \
+    only; needs -g)"
+;;
+
+let mk_dspill f =
+  "-dspill", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dsplit f =
+  "-dsplit", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dinterf f =
+  "-dinterf", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dprefer f =
+  "-dprefer", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dalloc f =
+  "-dalloc", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dreload f =
+  "-dreload", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dscheduling f =
+  "-dscheduling", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dlinear f =
+  "-dlinear", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dinterval f =
+  "-dinterval", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_dstartup f =
+  "-dstartup", Arg.Unit f, " (undocumented)"
+;;
+
+let mk_opaque f =
+  "-opaque", Arg.Unit f,
+  " Does not generate cross-module optimization information\n\
+  \     (reduces necessary recompilation on module change)"
+;;
+
+let mk_strict_formats f =
+  "-strict-formats", Arg.Unit f,
+  " Reject invalid formats accepted by legacy implementations\n\
+  \     (Warning: Invalid formats may behave differently from\n\
+  \      previous OCaml versions, and will become always-rejected\n\
+  \      in future OCaml versions. You should always use this flag\n\
+  \      to detect invalid formats so you can fix them.)"
+
+let mk_no_strict_formats f =
+  "-no-strict-formats", Arg.Unit f,
+  " Accept invalid formats accepted by legacy implementations (default)\n\
+  \     (Warning: Invalid formats may behave differently from\n\
+  \      previous OCaml versions, and will become always-rejected\n\
+  \      in future OCaml versions. You should never use this flag\n\
+  \      and instead fix invalid formats.)"
+;;
+
+let mk_args f =
+  "-args", Arg.Expand f,
+  " Read additional newline-terminated command line arguments\n\
+  \      from "
+;;
+
+let mk_args0 f =
+  "-args0", Arg.Expand f,
+  " Read additional null character terminated command line arguments\n\
+          from "
+;;
+
+let mk_afl_instrument f =
+  "-afl-instrument", Arg.Unit f, "Enable instrumentation for afl-fuzz"
+;;
+
+let mk_afl_inst_ratio f =
+  "-afl-inst-ratio", Arg.Int f,
+  "Configure percentage of branches instrumented\n\
+  \     (advanced, see afl-fuzz docs for AFL_INST_RATIO)"
+;;
+
+let mk__ f =
+  "-", Arg.String f,
+  "  Treat  as a file name (even if it starts with `-')"
+;;
+
+module type Common_options = sig
+  val _absname : unit -> unit
+  val _alert : string -> unit
+  val _I : string -> unit
+  val _labels : unit -> unit
+  val _alias_deps : unit -> unit
+  val _no_alias_deps : unit -> unit
+  val _app_funct : unit -> unit
+  val _no_app_funct : unit -> unit
+  val _noassert : unit -> unit
+  val _nolabels : unit -> unit
+  val _nostdlib : unit -> unit
+  val _open : string -> unit
+  val _ppx : string -> unit
+  val _principal : unit -> unit
+  val _no_principal : unit -> unit
+  val _rectypes : unit -> unit
+  val _no_rectypes : unit -> unit
+  val _safe_string : unit -> unit
+  val _short_paths : unit -> unit
+  val _strict_sequence : unit -> unit
+  val _no_strict_sequence : unit -> unit
+  val _strict_formats : unit -> unit
+  val _no_strict_formats : unit -> unit
+  val _unboxed_types : unit -> unit
+  val _no_unboxed_types : unit -> unit
+  val _unsafe_string : unit -> unit
+  val _version : unit -> unit
+  val _vnum : unit -> unit
+  val _w : string -> unit
+
+  val anonymous : string -> unit
+end
+
+module type Core_options = sig
+  include Common_options
+
+  val _nopervasives : unit -> unit
+  val _unsafe : unit -> unit
+  val _warn_error : string -> unit
+  val _warn_help : unit -> unit
+
+  val _dno_unique_ids : unit -> unit
+  val _dunique_ids : unit -> unit
+  val _dno_locations : unit -> unit
+  val _dlocations : unit -> unit
+
+  val _dsource : unit -> unit
+  val _dparsetree : unit -> unit
+  val _dtypedtree : unit -> unit
+  val _drawlambda : unit -> unit
+  val _dlambda : unit -> unit
+
+end
+
+module type Compiler_options = sig
+  val _a : unit -> unit
+  val _annot : unit -> unit
+  val _binannot : unit -> unit
+  val _c : unit -> unit
+  val _cc : string -> unit
+  val _cclib : string -> unit
+  val _ccopt : string -> unit
+  val _config : unit -> unit
+  val _config_var : string -> unit
+  val _for_pack : string -> unit
+  val _g : unit -> unit
+  val _stop_after : string -> unit
+  val _i : unit -> unit
+  val _impl : string -> unit
+  val _intf : string -> unit
+  val _intf_suffix : string -> unit
+  val _keep_docs : unit -> unit
+  val _no_keep_docs : unit -> unit
+  val _keep_locs : unit -> unit
+  val _no_keep_locs : unit -> unit
+  val _linkall : unit -> unit
+  val _noautolink : unit -> unit
+  val _o : string -> unit
+  val _opaque :  unit -> unit
+  val _output_obj : unit -> unit
+  val _output_complete_obj : unit -> unit
+  val _pack : unit -> unit
+  val _plugin : string -> unit
+  val _pp : string -> unit
+  val _principal : unit -> unit
+  val _no_principal : unit -> unit
+  val _rectypes : unit -> unit
+  val _runtime_variant : string -> unit
+  val _with_runtime : unit -> unit
+  val _without_runtime : unit -> unit
+  val _safe_string : unit -> unit
+  val _short_paths : unit -> unit
+  val _thread : unit -> unit
+  val _v : unit -> unit
+  val _verbose : unit -> unit
+  val _where : unit -> unit
+  val _color : string -> unit
+  val _error_style : string -> unit
+
+  val _match_context_rows : int -> unit
+  val _dtimings : unit -> unit
+  val _dprofile : unit -> unit
+  val _dump_into_file : unit -> unit
+
+  val _args: string -> string array
+  val _args0: string -> string array
+end
+;;
+
+module type Toplevel_options = sig
+  include Core_options
+  val _init : string -> unit
+  val _noinit : unit -> unit
+  val _no_version : unit -> unit
+  val _noprompt : unit -> unit
+  val _nopromptcont : unit -> unit
+  val _stdin : unit -> unit
+  val _args : string -> string array
+  val _args0 : string -> string array
+  val _color : string -> unit
+  val _error_style : string -> unit
+end
+;;
+
+module type Bytecomp_options = sig
+  include Core_options
+  include Compiler_options
+  val _compat_32 : unit -> unit
+  val _custom : unit -> unit
+  val _no_check_prims : unit -> unit
+  val _dllib : string -> unit
+  val _dllpath : string -> unit
+  val _make_runtime : unit -> unit
+  val _vmthread : unit -> unit
+  val _use_runtime : string -> unit
+  val _output_complete_exe : unit -> unit
+
+  val _dinstr : unit -> unit
+  val _dcamlprimc : unit -> unit
+
+  val _use_prims : string -> unit
+end;;
+
+module type Bytetop_options = sig
+  include Toplevel_options
+  val _dinstr : unit -> unit
+
+end;;
+
+module type Optcommon_options = sig
+  val _compact : unit -> unit
+  val _inline : string -> unit
+  val _inline_toplevel : string -> unit
+  val _inlining_report : unit -> unit
+  val _dump_pass : string -> unit
+  val _inline_max_depth : string -> unit
+  val _rounds : int -> unit
+  val _inline_max_unroll : string -> unit
+  val _classic_inlining : unit -> unit
+  val _inline_call_cost : string -> unit
+  val _inline_alloc_cost : string -> unit
+  val _inline_prim_cost : string -> unit
+  val _inline_branch_cost : string -> unit
+  val _inline_indirect_cost : string -> unit
+  val _inline_lifting_benefit : string -> unit
+  val _unbox_closures : unit -> unit
+  val _unbox_closures_factor : int -> unit
+  val _inline_branch_factor : string -> unit
+  val _remove_unused_arguments : unit -> unit
+  val _no_unbox_free_vars_of_closures : unit -> unit
+  val _no_unbox_specialised_args : unit -> unit
+  val _o2 : unit -> unit
+  val _o3 : unit -> unit
+  val _insn_sched : unit -> unit
+  val _no_insn_sched : unit -> unit
+  val _linscan : unit -> unit
+  val _no_float_const_prop : unit -> unit
+
+  val _clambda_checks : unit -> unit
+  val _dflambda : unit -> unit
+  val _drawflambda : unit -> unit
+  val _dflambda_invariants : unit -> unit
+  val _dflambda_no_invariants : unit -> unit
+  val _dflambda_let : int -> unit
+  val _dflambda_verbose : unit -> unit
+  val _drawclambda : unit -> unit
+  val _dclambda : unit -> unit
+  val _dcmm : unit -> unit
+  val _dsel : unit -> unit
+  val _dcombine : unit -> unit
+  val _dcse : unit -> unit
+  val _dlive : unit -> unit
+  val _davail : unit -> unit
+  val _drunavail : unit -> unit
+  val _dspill : unit -> unit
+  val _dsplit : unit -> unit
+  val _dinterf : unit -> unit
+  val _dprefer : unit -> unit
+  val _dalloc : unit -> unit
+  val _dreload : unit -> unit
+  val _dscheduling :  unit -> unit
+  val _dlinear :  unit -> unit
+  val _dinterval : unit -> unit
+  val _dstartup :  unit -> unit
+end;;
+
+module type Optcomp_options = sig
+  include Core_options
+  include Compiler_options
+  include Optcommon_options
+  val _nodynlink : unit -> unit
+  val _p : unit -> unit
+  val _pp : string -> unit
+  val _S : unit -> unit
+  val _shared : unit -> unit
+  val _afl_instrument : unit -> unit
+  val _afl_inst_ratio : int -> unit
+  val _function_sections : unit -> unit
+end;;
+
+module type Opttop_options = sig
+  include Toplevel_options
+  include Optcommon_options
+  val _verbose : unit -> unit
+  val _S : unit -> unit
+end;;
+
+module type Ocamldoc_options = sig
+  include Common_options
+  val _impl : string -> unit
+  val _intf : string -> unit
+  val _intf_suffix : string -> unit
+  val _pp : string -> unit
+  val _thread : unit -> unit
+  val _v : unit -> unit
+  val _verbose : unit -> unit
+  val _vmthread : unit -> unit
+end
+
+module type Arg_list = sig
+    val list : (string * Arg.spec * string) list
+end;;
+
+module Make_bytecomp_options (F : Bytecomp_options) =
+struct
+  let list = [
+    mk_a F._a;
+    mk_alert F._alert;
+    mk_absname F._absname;
+    mk_annot F._annot;
+    mk_binannot F._binannot;
+    mk_c F._c;
+    mk_cc F._cc;
+    mk_cclib F._cclib;
+    mk_ccopt F._ccopt;
+    mk_color F._color;
+    mk_error_style F._error_style;
+    mk_compat_32 F._compat_32;
+    mk_config F._config;
+    mk_config_var F._config_var;
+    mk_custom F._custom;
+    mk_dllib F._dllib;
+    mk_dllpath F._dllpath;
+    mk_dtypes F._annot;
+    mk_for_pack_byt F._for_pack;
+    mk_g_byt F._g;
+    mk_stop_after ~native:false F._stop_after;
+    mk_i F._i;
+    mk_I F._I;
+    mk_impl F._impl;
+    mk_intf F._intf;
+    mk_intf_suffix F._intf_suffix;
+    mk_intf_suffix_2 F._intf_suffix;
+    mk_keep_docs F._keep_docs;
+    mk_no_keep_docs F._no_keep_docs;
+    mk_keep_locs F._keep_locs;
+    mk_no_keep_locs F._no_keep_locs;
+    mk_labels F._labels;
+    mk_linkall F._linkall;
+    mk_make_runtime F._make_runtime;
+    mk_make_runtime_2 F._make_runtime;
+    mk_modern F._labels;
+    mk_alias_deps F._alias_deps;
+    mk_no_alias_deps F._no_alias_deps;
+    mk_app_funct F._app_funct;
+    mk_no_app_funct F._no_app_funct;
+    mk_no_check_prims F._no_check_prims;
+    mk_noassert F._noassert;
+    mk_noautolink_byt F._noautolink;
+    mk_nolabels F._nolabels;
+    mk_nostdlib F._nostdlib;
+    mk_nopervasives F._nopervasives;
+    mk_o F._o;
+    mk_opaque F._opaque;
+    mk_open F._open;
+    mk_output_obj F._output_obj;
+    mk_output_complete_obj F._output_complete_obj;
+    mk_output_complete_exe F._output_complete_exe;
+    mk_pack_byt F._pack;
+    mk_pp F._pp;
+    mk_ppx F._ppx;
+    mk_plugin F._plugin;
+    mk_principal F._principal;
+    mk_no_principal F._no_principal;
+    mk_rectypes F._rectypes;
+    mk_no_rectypes F._no_rectypes;
+    mk_runtime_variant F._runtime_variant;
+    mk_with_runtime F._with_runtime;
+    mk_without_runtime F._without_runtime;
+    mk_safe_string F._safe_string;
+    mk_short_paths F._short_paths;
+    mk_strict_sequence F._strict_sequence;
+    mk_no_strict_sequence F._no_strict_sequence;
+    mk_strict_formats F._strict_formats;
+    mk_no_strict_formats F._no_strict_formats;
+    mk_thread F._thread;
+    mk_unboxed_types F._unboxed_types;
+    mk_no_unboxed_types F._no_unboxed_types;
+    mk_unsafe F._unsafe;
+    mk_unsafe_string F._unsafe_string;
+    mk_use_runtime F._use_runtime;
+    mk_use_runtime_2 F._use_runtime;
+    mk_v F._v;
+    mk_verbose F._verbose;
+    mk_version F._version;
+    mk__version F._version;
+    mk_vmthread F._vmthread;
+    mk_vnum F._vnum;
+    mk_w F._w;
+    mk_warn_error F._warn_error;
+    mk_warn_help F._warn_help;
+    mk_where F._where;
+    mk__ F.anonymous;
+
+    mk_match_context_rows F._match_context_rows;
+    mk_use_prims F._use_prims;
+    mk_dno_unique_ids F._dno_unique_ids;
+    mk_dunique_ids F._dunique_ids;
+    mk_dno_locations F._dno_locations;
+    mk_dlocations F._dlocations;
+    mk_dsource F._dsource;
+    mk_dparsetree F._dparsetree;
+    mk_dtypedtree F._dtypedtree;
+    mk_drawlambda F._drawlambda;
+    mk_dlambda F._dlambda;
+    mk_dinstr F._dinstr;
+    mk_dcamlprimc F._dcamlprimc;
+    mk_dtimings F._dtimings;
+    mk_dprofile F._dprofile;
+    mk_dump_into_file F._dump_into_file;
+
+    mk_args F._args;
+    mk_args0 F._args0;
+  ]
+end;;
+
+module Make_bytetop_options (F : Bytetop_options) =
+struct
+  let list = [
+    mk_absname F._absname;
+    mk_alert F._alert;
+    mk_I F._I;
+    mk_init F._init;
+    mk_labels F._labels;
+    mk_alias_deps F._alias_deps;
+    mk_no_alias_deps F._no_alias_deps;
+    mk_app_funct F._app_funct;
+    mk_no_app_funct F._no_app_funct;
+    mk_noassert F._noassert;
+    mk_noinit F._noinit;
+    mk_nolabels F._nolabels;
+    mk_noprompt F._noprompt;
+    mk_nopromptcont F._nopromptcont;
+    mk_nostdlib F._nostdlib;
+    mk_nopervasives F._nopervasives;
+    mk_open F._open;
+    mk_ppx F._ppx;
+    mk_principal F._principal;
+    mk_no_principal F._no_principal;
+    mk_rectypes F._rectypes;
+    mk_no_rectypes F._no_rectypes;
+    mk_safe_string F._safe_string;
+    mk_short_paths F._short_paths;
+    mk_stdin F._stdin;
+    mk_strict_sequence F._strict_sequence;
+    mk_no_strict_sequence F._no_strict_sequence;
+    mk_strict_formats F._strict_formats;
+    mk_no_strict_formats F._no_strict_formats;
+    mk_unboxed_types F._unboxed_types;
+    mk_no_unboxed_types F._no_unboxed_types;
+    mk_unsafe F._unsafe;
+    mk_unsafe_string F._unsafe_string;
+    mk_version F._version;
+    mk__version F._version;
+    mk_no_version F._no_version;
+    mk_vnum F._vnum;
+    mk_w F._w;
+    mk_warn_error F._warn_error;
+    mk_warn_help F._warn_help;
+    mk__ F.anonymous;
+    mk_color F._color;
+    mk_error_style F._error_style;
+
+    mk_dno_unique_ids F._dno_unique_ids;
+    mk_dunique_ids F._dunique_ids;
+    mk_dno_locations F._dno_locations;
+    mk_dlocations F._dlocations;
+    mk_dsource F._dsource;
+    mk_dparsetree F._dparsetree;
+    mk_dtypedtree F._dtypedtree;
+    mk_drawlambda F._drawlambda;
+    mk_dlambda F._dlambda;
+    mk_dinstr F._dinstr;
+
+    mk_args F._args;
+    mk_args0 F._args0;
+  ]
+end;;
+
+module Make_optcomp_options (F : Optcomp_options) =
+struct
+  let list = [
+    mk_a F._a;
+    mk_alert F._alert;
+    mk_absname F._absname;
+    mk_afl_instrument F._afl_instrument;
+    mk_afl_inst_ratio F._afl_inst_ratio;
+    mk_annot F._annot;
+    mk_binannot F._binannot;
+    mk_inline_branch_factor F._inline_branch_factor;
+    mk_c F._c;
+    mk_cc F._cc;
+    mk_cclib F._cclib;
+    mk_ccopt F._ccopt;
+    mk_clambda_checks F._clambda_checks;
+    mk_classic_inlining F._classic_inlining;
+    mk_color F._color;
+    mk_error_style F._error_style;
+    mk_compact F._compact;
+    mk_config F._config;
+    mk_config_var F._config_var;
+    mk_dtypes F._annot;
+    mk_for_pack_opt F._for_pack;
+    mk_g_opt F._g;
+    mk_function_sections F._function_sections;
+    mk_stop_after ~native:true F._stop_after;
+    mk_i F._i;
+    mk_I F._I;
+    mk_impl F._impl;
+    mk_inline F._inline;
+    mk_inline_toplevel F._inline_toplevel;
+    mk_inline_alloc_cost F._inline_alloc_cost;
+    mk_inline_branch_cost F._inline_branch_cost;
+    mk_inline_call_cost F._inline_call_cost;
+    mk_inline_prim_cost F._inline_prim_cost;
+    mk_inline_indirect_cost F._inline_indirect_cost;
+    mk_inline_lifting_benefit F._inline_lifting_benefit;
+    mk_inlining_report F._inlining_report;
+    mk_insn_sched F._insn_sched;
+    mk_intf F._intf;
+    mk_intf_suffix F._intf_suffix;
+    mk_keep_docs F._keep_docs;
+    mk_no_keep_docs F._no_keep_docs;
+    mk_keep_locs F._keep_locs;
+    mk_no_keep_locs F._no_keep_locs;
+    mk_labels F._labels;
+    mk_linkall F._linkall;
+    mk_inline_max_depth F._inline_max_depth;
+    mk_alias_deps F._alias_deps;
+    mk_no_alias_deps F._no_alias_deps;
+    mk_linscan F._linscan;
+    mk_app_funct F._app_funct;
+    mk_no_app_funct F._no_app_funct;
+    mk_no_float_const_prop F._no_float_const_prop;
+    mk_noassert F._noassert;
+    mk_noautolink_opt F._noautolink;
+    mk_nodynlink F._nodynlink;
+    mk_no_insn_sched F._no_insn_sched;
+    mk_nolabels F._nolabels;
+    mk_nostdlib F._nostdlib;
+    mk_nopervasives F._nopervasives;
+    mk_no_unbox_free_vars_of_closures F._no_unbox_free_vars_of_closures;
+    mk_no_unbox_specialised_args F._no_unbox_specialised_args;
+    mk_o F._o;
+    mk_o2 F._o2;
+    mk_o3 F._o3;
+    mk_opaque F._opaque;
+    mk_open F._open;
+    mk_output_obj F._output_obj;
+    mk_output_complete_obj F._output_complete_obj;
+    mk_p F._p;
+    mk_pack_opt F._pack;
+    mk_plugin F._plugin;
+    mk_pp F._pp;
+    mk_ppx F._ppx;
+    mk_principal F._principal;
+    mk_no_principal F._no_principal;
+    mk_rectypes F._rectypes;
+    mk_no_rectypes F._no_rectypes;
+    mk_remove_unused_arguments F._remove_unused_arguments;
+    mk_rounds F._rounds;
+    mk_runtime_variant F._runtime_variant;
+    mk_with_runtime F._with_runtime;
+    mk_without_runtime F._without_runtime;
+    mk_S F._S;
+    mk_safe_string F._safe_string;
+    mk_shared F._shared;
+    mk_short_paths F._short_paths;
+    mk_strict_sequence F._strict_sequence;
+    mk_no_strict_sequence F._no_strict_sequence;
+    mk_strict_formats F._strict_formats;
+    mk_no_strict_formats F._no_strict_formats;
+    mk_thread F._thread;
+    mk_unbox_closures F._unbox_closures;
+    mk_unbox_closures_factor F._unbox_closures_factor;
+    mk_inline_max_unroll F._inline_max_unroll;
+    mk_unboxed_types F._unboxed_types;
+    mk_no_unboxed_types F._no_unboxed_types;
+    mk_unsafe F._unsafe;
+    mk_unsafe_string F._unsafe_string;
+    mk_v F._v;
+    mk_verbose F._verbose;
+    mk_version F._version;
+    mk__version F._version;
+    mk_vnum F._vnum;
+    mk_w F._w;
+    mk_warn_error F._warn_error;
+    mk_warn_help F._warn_help;
+    mk_where F._where;
+    mk__ F.anonymous;
+
+    mk_match_context_rows F._match_context_rows;
+    mk_dno_unique_ids F._dno_unique_ids;
+    mk_dunique_ids F._dunique_ids;
+    mk_dno_locations F._dno_locations;
+    mk_dlocations F._dlocations;
+    mk_dsource F._dsource;
+    mk_dparsetree F._dparsetree;
+    mk_dtypedtree F._dtypedtree;
+    mk_drawlambda F._drawlambda;
+    mk_dlambda F._dlambda;
+    mk_drawclambda F._drawclambda;
+    mk_dclambda F._dclambda;
+    mk_dflambda F._dflambda;
+    mk_drawflambda F._drawflambda;
+    mk_dflambda_invariants F._dflambda_invariants;
+    mk_dflambda_no_invariants F._dflambda_no_invariants;
+    mk_dflambda_let F._dflambda_let;
+    mk_dflambda_verbose F._dflambda_verbose;
+    mk_dcmm F._dcmm;
+    mk_dsel F._dsel;
+    mk_dcombine F._dcombine;
+    mk_dcse F._dcse;
+    mk_dlive F._dlive;
+    mk_davail F._davail;
+    mk_drunavail F._drunavail;
+    mk_dspill F._dspill;
+    mk_dsplit F._dsplit;
+    mk_dinterf F._dinterf;
+    mk_dprefer F._dprefer;
+    mk_dalloc F._dalloc;
+    mk_dreload F._dreload;
+    mk_dscheduling F._dscheduling;
+    mk_dlinear F._dlinear;
+    mk_dinterval F._dinterval;
+    mk_dstartup F._dstartup;
+    mk_dtimings F._dtimings;
+    mk_dprofile F._dprofile;
+    mk_dump_into_file F._dump_into_file;
+    mk_dump_pass F._dump_pass;
+
+    mk_args F._args;
+    mk_args0 F._args0;
+  ]
+end;;
+
+module Make_opttop_options (F : Opttop_options) = struct
+  let list = [
+    mk_absname F._absname;
+    mk_alert F._alert;
+    mk_compact F._compact;
+    mk_I F._I;
+    mk_init F._init;
+    mk_inline F._inline;
+    mk_inline_toplevel F._inline_toplevel;
+    mk_inlining_report F._inlining_report;
+    mk_rounds F._rounds;
+    mk_inline_max_unroll F._inline_max_unroll;
+    mk_classic_inlining F._classic_inlining;
+    mk_inline_call_cost F._inline_call_cost;
+    mk_inline_alloc_cost F._inline_alloc_cost;
+    mk_inline_prim_cost F._inline_prim_cost;
+    mk_inline_branch_cost F._inline_branch_cost;
+    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_labels F._labels;
+    mk_alias_deps F._alias_deps;
+    mk_no_alias_deps F._no_alias_deps;
+    mk_linscan F._linscan;
+    mk_app_funct F._app_funct;
+    mk_no_app_funct F._no_app_funct;
+    mk_no_float_const_prop F._no_float_const_prop;
+    mk_noassert F._noassert;
+    mk_noinit F._noinit;
+    mk_nolabels F._nolabels;
+    mk_noprompt F._noprompt;
+    mk_nopromptcont F._nopromptcont;
+    mk_nostdlib F._nostdlib;
+    mk_nopervasives F._nopervasives;
+    mk_no_unbox_free_vars_of_closures F._no_unbox_free_vars_of_closures;
+    mk_no_unbox_specialised_args F._no_unbox_specialised_args;
+    mk_o2 F._o2;
+    mk_o3 F._o3;
+    mk_open F._open;
+    mk_ppx F._ppx;
+    mk_principal F._principal;
+    mk_no_principal F._no_principal;
+    mk_rectypes F._rectypes;
+    mk_no_rectypes F._no_rectypes;
+    mk_remove_unused_arguments F._remove_unused_arguments;
+    mk_S F._S;
+    mk_safe_string F._safe_string;
+    mk_short_paths F._short_paths;
+    mk_stdin F._stdin;
+    mk_strict_sequence F._strict_sequence;
+    mk_no_strict_sequence F._no_strict_sequence;
+    mk_strict_formats F._strict_formats;
+    mk_no_strict_formats F._no_strict_formats;
+    mk_unbox_closures F._unbox_closures;
+    mk_unbox_closures_factor F._unbox_closures_factor;
+    mk_unboxed_types F._unboxed_types;
+    mk_no_unboxed_types F._no_unboxed_types;
+    mk_unsafe F._unsafe;
+    mk_unsafe_string F._unsafe_string;
+    mk_verbose F._verbose;
+    mk_version F._version;
+    mk__version F._version;
+    mk_no_version F._no_version;
+    mk_vnum F._vnum;
+    mk_w F._w;
+    mk_warn_error F._warn_error;
+    mk_warn_help F._warn_help;
+    mk__ F.anonymous;
+    mk_color F._color;
+    mk_error_style F._error_style;
+
+    mk_dsource F._dsource;
+    mk_dparsetree F._dparsetree;
+    mk_dtypedtree F._dtypedtree;
+    mk_drawlambda F._drawlambda;
+    mk_drawclambda F._drawclambda;
+    mk_dclambda F._dclambda;
+    mk_drawflambda F._drawflambda;
+    mk_dflambda F._dflambda;
+    mk_dcmm F._dcmm;
+    mk_dsel F._dsel;
+    mk_dcombine F._dcombine;
+    mk_dcse F._dcse;
+    mk_dlive F._dlive;
+    mk_davail F._davail;
+    mk_drunavail F._drunavail;
+    mk_dspill F._dspill;
+    mk_dsplit F._dsplit;
+    mk_dinterf F._dinterf;
+    mk_dprefer F._dprefer;
+    mk_dalloc F._dalloc;
+    mk_dreload F._dreload;
+    mk_dscheduling F._dscheduling;
+    mk_dlinear F._dlinear;
+    mk_dinterval F._dinterval;
+    mk_dstartup F._dstartup;
+    mk_dump_pass F._dump_pass;
+  ]
+end;;
+
+module Make_ocamldoc_options (F : Ocamldoc_options) =
+struct
+  let list = [
+    mk_absname F._absname;
+    mk_alert F._alert;
+    mk_I F._I;
+    mk_impl F._impl;
+    mk_intf F._intf;
+    mk_intf_suffix F._intf_suffix;
+    mk_intf_suffix_2 F._intf_suffix;
+    mk_labels F._labels;
+    mk_modern F._labels;
+    mk_alias_deps F._alias_deps;
+    mk_no_alias_deps F._no_alias_deps;
+    mk_app_funct F._app_funct;
+    mk_no_app_funct F._no_app_funct;
+    mk_noassert F._noassert;
+    mk_nolabels F._nolabels;
+    mk_nostdlib F._nostdlib;
+    mk_open F._open;
+    mk_pp F._pp;
+    mk_ppx F._ppx;
+    mk_principal F._principal;
+    mk_no_principal F._no_principal;
+    mk_rectypes F._rectypes;
+    mk_no_rectypes F._no_rectypes;
+    mk_safe_string F._safe_string;
+    mk_short_paths F._short_paths;
+    mk_strict_sequence F._strict_sequence;
+    mk_no_strict_sequence F._no_strict_sequence;
+    mk_strict_formats F._strict_formats;
+    mk_no_strict_formats F._no_strict_formats;
+    mk_thread F._thread;
+    mk_unboxed_types F._unboxed_types;
+    mk_no_unboxed_types F._no_unboxed_types;
+    mk_unsafe_string F._unsafe_string;
+    mk_v F._v;
+    mk_verbose F._verbose;
+    mk_version F._version;
+    mk__version F._version;
+    mk_vmthread F._vmthread;
+    mk_vnum F._vnum;
+    mk_w F._w;
+    mk__ F.anonymous;
+  ]
+end;;
+
+[@@@ocaml.warning "-40"]
+let options_with_command_line_syntax_inner r after_rest =
+  let rec loop ~name_opt (spec : Arg.spec) : Arg.spec =
+    let option =
+      match name_opt with
+      | None -> ignore
+      | Some name -> (fun () -> r := name :: !r)
+    in
+    let arg a = r := Filename.quote a :: !r in
+    let option_with_arg a = option (); arg a in
+    let rest a =
+      if not !after_rest then (after_rest := true; option ());
+      arg a
+    in
+    match spec with
+    | Unit f -> Unit (fun a -> f a; option ())
+    | Bool f -> Bool (fun a -> f a; option_with_arg (string_of_bool a))
+    | Set r -> Unit (fun () -> r := true; option ())
+    | Clear r -> Unit (fun () -> r := false; option ())
+    | String f -> String (fun a -> f a; option_with_arg a)
+    | Set_string r -> String (fun a -> r := a; option_with_arg a)
+    | Int f -> Int (fun a -> f a; option_with_arg (string_of_int a))
+    | Set_int r -> Int (fun a -> r := a; option_with_arg (string_of_int a))
+    | Float f -> Float (fun a -> f a; option_with_arg (string_of_float a))
+    | Set_float r ->
+       Float (fun a -> r := a; option_with_arg (string_of_float a))
+    | Tuple [] -> Unit option
+    | Tuple (hd :: tl) ->
+       Tuple (loop ~name_opt hd :: List.map (loop ~name_opt:None) tl)
+    | Symbol (l, f) -> Symbol (l, (fun a -> f a; option_with_arg a))
+    | Rest f -> Rest (fun a -> f a; rest a)
+    | Expand f -> Expand f
+  in
+  loop
+
+let options_with_command_line_syntax options r =
+  let rest = ref false in
+  List.map (fun (name, spec, doc) ->
+    (name,
+     options_with_command_line_syntax_inner r rest
+       ~name_opt:(Some name) spec, doc)
+  ) options
+
+module Default = struct
+  open Clflags
+  open Compenv
+  let set r () = r := true
+  let clear r () = r := false
+
+  module Common = struct
+    let _absname = set Clflags.absname
+    let _alert = Warnings.parse_alert_option
+    let _alias_deps = clear transparent_modules
+    let _app_funct = set applicative_functors
+    let _labels = clear classic
+    let _no_alias_deps = set transparent_modules
+    let _no_app_funct = clear applicative_functors
+    let _no_principal = clear principal
+    let _no_rectypes = clear recursive_types
+    let _no_strict_formats = clear strict_formats
+    let _no_strict_sequence = clear strict_sequence
+    let _no_unboxed_types = clear unboxed_types
+    let _noassert = set noassert
+    let _nolabels = set classic
+    let _nostdlib = set no_std_include
+    let _open s = open_modules := (s :: (!open_modules))
+    let _principal = set principal
+    let _rectypes = set recursive_types
+    let _safe_string = clear unsafe_string
+    let _short_paths = clear real_paths
+    let _strict_formats = set strict_formats
+    let _strict_sequence = set strict_sequence
+    let _unboxed_types = set unboxed_types
+    let _unsafe_string = set unsafe_string
+    let _w s = Warnings.parse_options false s
+
+    let anonymous = anonymous
+
+  end
+
+  module Core = struct
+    include Common
+    let _I dir = include_dirs := (dir :: (!include_dirs))
+    let _color = Misc.set_or_ignore color_reader.parse color
+    let _dlambda = set dump_lambda
+    let _dparsetree = set dump_parsetree
+    let _drawlambda = set dump_rawlambda
+    let _dsource = set dump_source
+    let _dtypedtree = set dump_typedtree
+    let _dunique_ids = set unique_ids
+    let _dno_unique_ids = clear unique_ids
+    let _dlocations = set locations
+    let _dno_locations = clear locations
+    let _error_style =
+      Misc.set_or_ignore error_style_reader.parse error_style
+    let _nopervasives = set nopervasives
+    let _ppx s = first_ppx := (s :: (!first_ppx))
+    let _unsafe = set unsafe
+    let _warn_error s = Warnings.parse_options true s
+    let _warn_help = Warnings.help_warnings
+  end
+
+  module Native = struct
+    let _S = set keep_asm_file
+    let _clambda_checks () = clambda_checks := true
+    let _classic_inlining () = classic_inlining := true
+    let _compact = clear optimize_for_speed
+    let _dalloc = set dump_regalloc
+    let _davail () = dump_avail := true
+    let _dclambda = set dump_clambda
+    let _dcmm = set dump_cmm
+    let _dcombine = set dump_combine
+    let _dcse = set dump_cse
+    let _dflambda = set dump_flambda
+    let _dflambda_invariants = set flambda_invariant_checks
+    let _dflambda_let stamp = dump_flambda_let := (Some stamp)
+    let _dflambda_no_invariants = clear flambda_invariant_checks
+    let _dflambda_verbose () =
+      set dump_flambda (); set dump_flambda_verbose ()
+    let _dinterval = set dump_interval
+    let _dinterf = set dump_interf
+    let _dlinear = set dump_linear
+    let _dlive () = dump_live := true
+    let _dprefer = set dump_prefer
+    let _drawclambda = set dump_rawclambda
+    let _drawflambda = set dump_rawflambda
+    let _dreload = set dump_reload
+    let _drunavail () = debug_runavail := true
+    let _dscheduling = set dump_scheduling
+    let _dsel = set dump_selection
+    let _dspill = set dump_spill
+    let _dsplit = set dump_split
+    let _dstartup = set keep_startup_file
+    let _dump_pass pass = set_dumped_pass pass true
+    let _inline spec =
+      Float_arg_helper.parse spec "Syntax: -inline  | =[,...]"
+        inline_threshold
+    let _inline_alloc_cost spec =
+      Int_arg_helper.parse spec
+        "Syntax: -inline-alloc-cost  | =[,...]"
+        inline_alloc_cost
+    let _inline_branch_cost spec =
+      Int_arg_helper.parse spec
+        "Syntax: -inline-branch-cost  | =[,...]"
+        inline_branch_cost
+    let _inline_branch_factor spec =
+      Float_arg_helper.parse spec
+        "Syntax: -inline-branch-factor  | =[,...]"
+        inline_branch_factor
+    let _inline_call_cost spec =
+      Int_arg_helper.parse spec
+        "Syntax: -inline-call-cost  | =[,...]" inline_call_cost
+    let _inline_indirect_cost spec =
+      Int_arg_helper.parse spec
+        "Syntax: -inline-indirect-cost  | =[,...]"
+        inline_indirect_cost
+    let _inline_lifting_benefit spec =
+      Int_arg_helper.parse spec
+        "Syntax: -inline-lifting-benefit  | =[,...]"
+        inline_lifting_benefit
+    let _inline_max_depth spec =
+      Int_arg_helper.parse spec
+        "Syntax: -inline-max-depth  | =[,...]" inline_max_depth
+    let _inline_max_unroll spec =
+      Int_arg_helper.parse spec
+        "Syntax: -inline-max-unroll  | =[,...]"
+        inline_max_unroll
+    let _inline_prim_cost spec =
+      Int_arg_helper.parse spec
+        "Syntax: -inline-prim-cost  | =[,...]" inline_prim_cost
+    let _inline_toplevel spec =
+      Int_arg_helper.parse spec
+        "Syntax: -inline-toplevel  | =[,...]"
+        inline_toplevel_threshold
+    let _inlining_report () = inlining_report := true
+    let _insn_sched = set insn_sched
+    let _no_insn_sched = clear insn_sched
+    let _linscan = set use_linscan
+    let _no_float_const_prop = clear float_const_prop
+    let _no_unbox_free_vars_of_closures = clear unbox_free_vars_of_closures
+    let _no_unbox_specialised_args = clear unbox_specialised_args
+    (* CR-someday mshinwell: should stop e.g. -O2 -classic-inlining
+       lgesbert: could be done in main() below, like for -pack and -c, but that
+       would prevent overriding using OCAMLPARAM.
+       mshinwell: We're going to defer this for the moment and add a note in
+       the manual that the behaviour is unspecified in cases such as this.
+       We should refactor the code so that the user's requirements are
+       collected, then checked all at once for illegal combinations, and then
+       transformed into the settings of the individual parameters.
+    *)
+    let _o2 () =
+      default_simplify_rounds := 2;
+      use_inlining_arguments_set o2_arguments;
+      use_inlining_arguments_set ~round:0 o1_arguments
+    let _o3 () =
+      default_simplify_rounds := 3;
+      use_inlining_arguments_set o3_arguments;
+      use_inlining_arguments_set ~round:1 o2_arguments;
+      use_inlining_arguments_set ~round:0 o1_arguments
+    let _remove_unused_arguments = set remove_unused_arguments
+    let _rounds n = simplify_rounds := (Some n)
+    let _unbox_closures = set unbox_closures
+    let _unbox_closures_factor f = unbox_closures_factor := f
+    let _verbose = set verbose
+  end
+
+  module Compiler = struct
+    let _a = set make_archive
+    let _annot = set annotations
+    let _args = Arg.read_arg
+    let _args0 = Arg.read_arg0
+    let _binannot = set binary_annotations
+    let _c = set compile_only
+    let _cc s = c_compiler := (Some s)
+    let _cclib s = defer (ProcessObjects (Misc.rev_split_words s))
+    let _ccopt s = first_ccopts := (s :: (!first_ccopts))
+    let _config = Misc.show_config_and_exit
+    let _config_var = Misc.show_config_variable_and_exit
+    let _dprofile () = profile_columns := Profile.all_columns
+    let _dtimings () = profile_columns := [`Time]
+    let _dump_into_file = set dump_into_file
+    let _for_pack s = for_package := (Some s)
+    let _g = set debug
+    let _i = set print_types
+    let _impl = impl
+    let _intf = intf
+    let _intf_suffix s = Config.interface_suffix := s
+    let _keep_docs = set keep_docs
+    let _keep_locs = set keep_locs
+    let _linkall = set link_everything
+    let _match_context_rows n = match_context_rows := n
+    let _no_keep_docs = clear keep_docs
+    let _no_keep_locs = clear keep_locs
+    let _noautolink = set no_auto_link
+    let _o s = output_name := (Some s)
+    let _opaque = set opaque
+    let _pack = set make_package
+    let _plugin _p = plugin := true
+    let _pp s = preprocessor := (Some s)
+    let _runtime_variant s = runtime_variant := s
+    let _stop_after pass =
+      let module P = Compiler_pass in
+        match P.of_string pass with
+        | None -> () (* this should not occur as we use Arg.Symbol *)
+        | Some pass ->
+          match !stop_after with
+          | None -> stop_after := (Some pass)
+          | Some p ->
+            if not (p = pass) then
+              fatal "Please specify at most one -stop-after ."
+    let _thread = set use_threads
+    let _verbose = set verbose
+    let _version () = print_version_string ()
+    let _vnum () = print_version_string ()
+    let _where () = print_standard_library ()
+    let _with_runtime = set with_runtime
+    let _without_runtime = clear with_runtime
+  end
+
+  module Toplevel = struct
+
+    let print_version () =
+      Printf.printf "The OCaml toplevel, version %s\n" Sys.ocaml_version;
+      exit 0;
+    ;;
+
+    let print_version_num () =
+      Printf.printf "%s\n" Sys.ocaml_version;
+      exit 0;
+    ;;
+
+    let _args (_:string) = (* placeholder: wrap_expand Arg.read_arg *) [||]
+    let _args0 (_:string) = (* placeholder: wrap_expand Arg.read_arg0 *) [||]
+    let _init s = init_file := (Some s)
+    let _no_version = set noversion
+    let _noinit = set noinit
+    let _noprompt = set noprompt
+    let _nopromptcont = set nopromptcont
+    let _stdin () = (* placeholder: file_argument ""*) ()
+    let _version () = print_version ()
+    let _vnum () = print_version_num ()
+  end
+
+  module Topmain = struct
+    include Toplevel
+    include Core
+    let _dinstr = set dump_instr
+  end
+
+  module Opttopmain = struct
+    include Toplevel
+    include Native
+    include Core
+  end
+
+  module Optmain = struct
+    include Native
+    include Core
+    include Compiler
+    let _afl_inst_ratio n = afl_inst_ratio := n
+    let _afl_instrument = set afl_instrument
+    let _function_sections () =
+      assert Config.function_sections;
+      first_ccopts := ("-ffunction-sections" :: (!first_ccopts));
+      function_sections := true
+    let _nodynlink = clear dlcode
+    let _output_complete_obj () =
+      set output_c_object (); set output_complete_object ()
+    let _output_obj = set output_c_object
+    let _p () =
+      fatal
+        "Profiling with \"gprof\" (option `-p') is only supported up to \
+         OCaml 4.08.0"
+    let _shared () = shared := true; dlcode := true
+    let _v () = print_version_and_library "native-code compiler"
+  end
+
+  module Odoc_args = struct
+    include Common
+    let _I(_:string) =
+      (* placeholder:
+         Odoc_global.include_dirs := (s :: (!Odoc_global.include_dirs))
+      *) ()
+    let _impl (_:string) =
+      (* placeholder:
+         Odoc_global.files := ((!Odoc_global.files) @ [Odoc_global.Impl_file s])
+      *) ()
+    let _intf (_:string) = (* placeholder:
+      Odoc_global.files := ((!Odoc_global.files) @ [Odoc_global.Intf_file s])
+                  *) ()
+    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 _thread = set Clflags.use_threads
+    let _v () = Compenv.print_version_and_library "documentation generator"
+    let _verbose = set Clflags.verbose
+    let _version = Compenv.print_version_string
+    let _vmthread = ignore
+    let _vnum = Compenv.print_version_string
+  end
+
+  module Main = struct
+
+    let vmthread_removed_message = "\
+The -vmthread argument of ocamlc is no longer supported\n\
+since OCaml 4.09.0.  Please switch to system threads, which have the\n\
+same API. Lightweight threads with VM-level scheduling are provided by\n\
+third-party libraries such as Lwt, but with a different API."
+
+    include Core
+    include Compiler
+    let _compat_32 = set bytecode_compatible_32
+    let _custom = set custom_runtime
+    let _dcamlprimc = set keep_camlprimc_file
+    let _dinstr = set dump_instr
+    let _dllib s = defer (ProcessDLLs (Misc.rev_split_words s))
+    let _dllpath s = dllpaths := ((!dllpaths) @ [s])
+    let _make_runtime () =
+      custom_runtime := true; make_runtime := true; link_everything := true
+    let _no_check_prims = set no_check_prims
+    let _output_complete_obj () =
+      output_c_object := true;
+      output_complete_object := true;
+      custom_runtime := true
+    let _output_complete_exe () =
+      _output_complete_obj (); output_complete_executable := true
+    let _output_obj () = output_c_object := true; custom_runtime := true
+    let _use_prims s = use_prims := s
+    let _use_runtime s = use_runtime := s
+    let _v () = print_version_and_library "compiler"
+    let _vmthread () = fatal vmthread_removed_message
+  end
+
+end
diff --git a/driver/main_args.mli b/driver/main_args.mli
new file mode 100644
index 00000000..083a1827
--- /dev/null
+++ b/driver/main_args.mli
@@ -0,0 +1,284 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*              Damien Doligez, projet Para, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1998 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* ATTENTION ! When you add or modify a parsing or typing option, do not forget
+  to update ocamldoc options too, in odoc_args.ml. *)
+
+module type Common_options = sig
+  val _absname : unit -> unit
+  val _alert : string -> unit
+  val _I : string -> unit
+  val _labels : unit -> unit
+  val _alias_deps : unit -> unit
+  val _no_alias_deps : unit -> unit
+  val _app_funct : unit -> unit
+  val _no_app_funct : unit -> unit
+  val _noassert : unit -> unit
+  val _nolabels : unit -> unit
+  val _nostdlib : unit -> unit
+  val _open : string -> unit
+  val _ppx : string -> unit
+  val _principal : unit -> unit
+  val _no_principal : unit -> unit
+  val _rectypes : unit -> unit
+  val _no_rectypes : unit -> unit
+  val _safe_string : unit -> unit
+  val _short_paths : unit -> unit
+  val _strict_sequence : unit -> unit
+  val _no_strict_sequence : unit -> unit
+  val _strict_formats : unit -> unit
+  val _no_strict_formats : unit -> unit
+  val _unboxed_types : unit -> unit
+  val _no_unboxed_types : unit -> unit
+  val _unsafe_string : unit -> unit
+  val _version : unit -> unit
+  val _vnum : unit -> unit
+  val _w : string -> unit
+
+  val anonymous : string -> unit
+end
+
+module type Core_options = sig
+  include Common_options
+
+  val _nopervasives : unit -> unit
+  val _unsafe : unit -> unit
+  val _warn_error : string -> unit
+  val _warn_help : unit -> unit
+
+  val _dno_unique_ids : unit -> unit
+  val _dunique_ids : unit -> unit
+  val _dno_locations : unit -> unit
+  val _dlocations : unit -> unit
+  val _dsource : unit -> unit
+  val _dparsetree : unit -> unit
+  val _dtypedtree : unit -> unit
+  val _drawlambda : unit -> unit
+  val _dlambda : unit -> unit
+
+end
+
+module type Compiler_options = sig
+  val _a : unit -> unit
+  val _annot : unit -> unit
+  val _binannot : unit -> unit
+  val _c : unit -> unit
+  val _cc : string -> unit
+  val _cclib : string -> unit
+  val _ccopt : string -> unit
+  val _config : unit -> unit
+  val _config_var : string -> unit
+  val _for_pack : string -> unit
+  val _g : unit -> unit
+  val _stop_after : string -> unit
+  val _i : unit -> unit
+  val _impl : string -> unit
+  val _intf : string -> unit
+  val _intf_suffix : string -> unit
+  val _keep_docs : unit -> unit
+  val _no_keep_docs : unit -> unit
+  val _keep_locs : unit -> unit
+  val _no_keep_locs : unit -> unit
+  val _linkall : unit -> unit
+  val _noautolink : unit -> unit
+  val _o : string -> unit
+  val _opaque :  unit -> unit
+  val _output_obj : unit -> unit
+  val _output_complete_obj : unit -> unit
+  val _pack : unit -> unit
+  val _plugin : string -> unit
+  val _pp : string -> unit
+  val _principal : unit -> unit
+  val _no_principal : unit -> unit
+  val _rectypes : unit -> unit
+  val _runtime_variant : string -> unit
+  val _with_runtime : unit -> unit
+  val _without_runtime : unit -> unit
+  val _safe_string : unit -> unit
+  val _short_paths : unit -> unit
+  val _thread : unit -> unit
+  val _v : unit -> unit
+  val _verbose : unit -> unit
+  val _where : unit -> unit
+  val _color : string -> unit
+  val _error_style : string -> unit
+
+  val _match_context_rows : int -> unit
+  val _dtimings : unit -> unit
+  val _dprofile : unit -> unit
+  val _dump_into_file : unit -> unit
+
+  val _args: string -> string array
+  val _args0: string -> string array
+end
+;;
+
+module type Toplevel_options = sig
+  include Core_options
+  val _init : string -> unit
+  val _noinit : unit -> unit
+  val _no_version : unit -> unit
+  val _noprompt : unit -> unit
+  val _nopromptcont : unit -> unit
+  val _stdin : unit -> unit
+  val _args : string -> string array
+  val _args0 : string -> string array
+  val _color : string -> unit
+  val _error_style : string -> unit
+end
+;;
+
+module type Bytecomp_options = sig
+  include Core_options
+  include Compiler_options
+  val _compat_32 : unit -> unit
+  val _custom : unit -> unit
+  val _no_check_prims : unit -> unit
+  val _dllib : string -> unit
+  val _dllpath : string -> unit
+  val _make_runtime : unit -> unit
+  val _vmthread : unit -> unit
+  val _use_runtime : string -> unit
+  val _output_complete_exe : unit -> unit
+
+  val _dinstr : unit -> unit
+  val _dcamlprimc : unit -> unit
+
+  val _use_prims : string -> unit
+end;;
+
+module type Bytetop_options = sig
+  include Toplevel_options
+  val _dinstr : unit -> unit
+
+end;;
+
+module type Optcommon_options = sig
+  val _compact : unit -> unit
+  val _inline : string -> unit
+  val _inline_toplevel : string -> unit
+  val _inlining_report : unit -> unit
+  val _dump_pass : string -> unit
+  val _inline_max_depth : string -> unit
+  val _rounds : int -> unit
+  val _inline_max_unroll : string -> unit
+  val _classic_inlining : unit -> unit
+  val _inline_call_cost : string -> unit
+  val _inline_alloc_cost : string -> unit
+  val _inline_prim_cost : string -> unit
+  val _inline_branch_cost : string -> unit
+  val _inline_indirect_cost : string -> unit
+  val _inline_lifting_benefit : string -> unit
+  val _unbox_closures : unit -> unit
+  val _unbox_closures_factor : int -> unit
+  val _inline_branch_factor : string -> unit
+  val _remove_unused_arguments : unit -> unit
+  val _no_unbox_free_vars_of_closures : unit -> unit
+  val _no_unbox_specialised_args : unit -> unit
+  val _o2 : unit -> unit
+  val _o3 : unit -> unit
+  val _insn_sched : unit -> unit
+  val _no_insn_sched : unit -> unit
+  val _linscan : unit -> unit
+  val _no_float_const_prop : unit -> unit
+
+  val _clambda_checks : unit -> unit
+  val _dflambda : unit -> unit
+  val _drawflambda : unit -> unit
+  val _dflambda_invariants : unit -> unit
+  val _dflambda_no_invariants : unit -> unit
+  val _dflambda_let : int -> unit
+  val _dflambda_verbose : unit -> unit
+  val _drawclambda : unit -> unit
+  val _dclambda : unit -> unit
+  val _dcmm : unit -> unit
+  val _dsel : unit -> unit
+  val _dcombine : unit -> unit
+  val _dcse : unit -> unit
+  val _dlive : unit -> unit
+  val _davail : unit -> unit
+  val _drunavail : unit -> unit
+  val _dspill : unit -> unit
+  val _dsplit : unit -> unit
+  val _dinterf : unit -> unit
+  val _dprefer : unit -> unit
+  val _dalloc : unit -> unit
+  val _dreload : unit -> unit
+  val _dscheduling :  unit -> unit
+  val _dlinear :  unit -> unit
+  val _dinterval : unit -> unit
+  val _dstartup :  unit -> unit
+end;;
+
+module type Optcomp_options = sig
+  include Core_options
+  include Compiler_options
+  include Optcommon_options
+  val _nodynlink : unit -> unit
+  val _p : unit -> unit
+  val _pp : string -> unit
+  val _S : unit -> unit
+  val _shared : unit -> unit
+  val _afl_instrument : unit -> unit
+  val _afl_inst_ratio : int -> unit
+  val _function_sections : unit -> unit
+end;;
+
+module type Opttop_options = sig
+  include Toplevel_options
+  include Optcommon_options
+  val _verbose : unit -> unit
+  val _S : unit -> unit
+end;;
+
+module type Ocamldoc_options = sig
+  include Common_options
+  val _impl : string -> unit
+  val _intf : string -> unit
+  val _intf_suffix : string -> unit
+  val _pp : string -> unit
+  val _thread : unit -> unit
+  val _v : unit -> unit
+  val _verbose : unit -> unit
+  val _vmthread : unit -> unit
+end
+
+module type Arg_list = sig
+    val list : (string * Arg.spec * string) list
+end;;
+
+module Make_bytecomp_options : Bytecomp_options -> Arg_list;;
+module Make_bytetop_options : Bytetop_options -> Arg_list;;
+module Make_optcomp_options : Optcomp_options -> Arg_list;;
+module Make_opttop_options : Opttop_options -> Arg_list;;
+module Make_ocamldoc_options : Ocamldoc_options -> Arg_list;;
+
+(** [options_with_command_line_syntax options r] returns [options2] that behaves
+    like [options], but additionally pushes command line argument on [r] (quoted
+    by [Filename.quote] when necessary).
+    This is meant for ocaml{c,opt}p, which use this to forward most of their
+    arguments to ocaml{c,opt}. *)
+val options_with_command_line_syntax
+  : (string * Arg.spec * string) list
+  -> string list ref
+  -> (string * Arg.spec * string) list
+
+module Default: sig
+  module Topmain: Bytetop_options
+  module Opttopmain: Opttop_options
+  module Main: Bytecomp_options
+  module Optmain: Optcomp_options
+  module Odoc_args: Ocamldoc_options
+end
diff --git a/driver/makedepend.ml b/driver/makedepend.ml
new file mode 100644
index 00000000..c4a7cabc
--- /dev/null
+++ b/driver/makedepend.ml
@@ -0,0 +1,661 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1999 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Compenv
+open Parsetree
+module String = Misc.Stdlib.String
+
+let ppf = Format.err_formatter
+(* Print the dependencies *)
+
+type file_kind = ML | MLI;;
+
+let load_path = ref ([] : (string * string array) list)
+let ml_synonyms = ref [".ml"]
+let mli_synonyms = ref [".mli"]
+let shared = ref false
+let native_only = ref false
+let bytecode_only = ref false
+let raw_dependencies = ref false
+let sort_files = ref false
+let all_dependencies = ref false
+let nocwd = ref false
+let one_line = ref false
+let files =
+  ref ([] : (string * file_kind * String.Set.t * string list) list)
+let allow_approximation = ref false
+let map_files = ref []
+let module_map = ref String.Map.empty
+let debug = ref false
+
+module Error_occurred : sig
+  val set : unit -> unit
+  val get : unit -> bool
+end = struct
+  (* Once set to [true], [error_occurred] should never be set to
+     [false]. *)
+  let error_occurred = ref false
+  let get () = !error_occurred
+  let set () = error_occurred := true
+end
+
+(* Fix path to use '/' as directory separator instead of '\'.
+   Only under Windows. *)
+
+let fix_slash s =
+  if Sys.os_type = "Unix" then s else begin
+    String.map (function '\\' -> '/' | c -> c) s
+  end
+
+(* Since we reinitialize load_path after reading OCAMLCOMP,
+  we must use a cache instead of calling Sys.readdir too often. *)
+let dirs = ref String.Map.empty
+let readdir dir =
+  try
+    String.Map.find dir !dirs
+  with Not_found ->
+    let contents =
+      try
+        Sys.readdir dir
+      with Sys_error msg ->
+        Format.fprintf Format.err_formatter "@[Bad -I option: %s@]@." msg;
+        Error_occurred.set ();
+        [||]
+    in
+    dirs := String.Map.add dir contents !dirs;
+    contents
+
+let add_to_list li s =
+  li := s :: !li
+
+let add_to_load_path dir =
+  try
+    let dir = Misc.expand_directory Config.standard_library dir in
+    let contents = readdir dir in
+    add_to_list load_path (dir, contents)
+  with Sys_error msg ->
+    Format.fprintf Format.err_formatter "@[Bad -I option: %s@]@." msg;
+    Error_occurred.set ()
+
+let add_to_synonym_list synonyms suffix =
+  if (String.length suffix) > 1 && suffix.[0] = '.' then
+    add_to_list synonyms suffix
+  else begin
+    Format.fprintf Format.err_formatter "@[Bad suffix: '%s'@]@." suffix;
+    Error_occurred.set ()
+  end
+
+(* Find file 'name' (capitalized) in search path *)
+let find_module_in_load_path name =
+  let names = List.map (fun ext -> name ^ ext) (!mli_synonyms @ !ml_synonyms) in
+  let unames =
+    let uname = String.uncapitalize_ascii name in
+    List.map (fun ext -> uname ^ ext) (!mli_synonyms @ !ml_synonyms)
+  in
+  let rec find_in_array a pos =
+    if pos >= Array.length a then None else begin
+      let s = a.(pos) in
+      if List.mem s names || List.mem s unames then
+        Some s
+      else
+        find_in_array a (pos + 1)
+    end in
+  let rec find_in_path = function
+    [] -> raise Not_found
+  | (dir, contents) :: rem ->
+      match find_in_array contents 0 with
+        Some truename ->
+          if dir = "." then truename else Filename.concat dir truename
+      | None -> find_in_path rem in
+  find_in_path !load_path
+
+let find_dependency target_kind modname (byt_deps, opt_deps) =
+  try
+    let filename = find_module_in_load_path modname in
+    let basename = Filename.chop_extension filename in
+    let cmi_file = basename ^ ".cmi" in
+    let cmx_file = basename ^ ".cmx" in
+    let mli_exists =
+      List.exists (fun ext -> Sys.file_exists (basename ^ ext)) !mli_synonyms in
+    let ml_exists =
+      List.exists (fun ext -> Sys.file_exists (basename ^ ext)) !ml_synonyms in
+    if mli_exists then
+      let new_opt_dep =
+        if !all_dependencies then
+          match target_kind with
+          | MLI -> [ cmi_file ]
+          | ML  ->
+              cmi_file :: (if ml_exists then [ cmx_file ] else [])
+        else
+        (* this is a make-specific hack that makes .cmx to be a 'proxy'
+           target that would force the dependency on .cmi via transitivity *)
+        if ml_exists
+        then [ cmx_file ]
+        else [ cmi_file ]
+      in
+      ( cmi_file :: byt_deps, new_opt_dep @ opt_deps)
+    else
+      (* "just .ml" case *)
+      let bytenames =
+        if !all_dependencies then
+          match target_kind with
+          | MLI -> [ cmi_file ]
+          | ML  -> [ cmi_file ]
+        else
+          (* again, make-specific hack *)
+          [basename ^ (if !native_only then ".cmx" else ".cmo")] in
+      let optnames =
+        if !all_dependencies
+        then match target_kind with
+          | MLI -> [ cmi_file ]
+          | ML  -> [ cmi_file; cmx_file ]
+        else [ cmx_file ]
+      in
+      (bytenames @ byt_deps, optnames @  opt_deps)
+  with Not_found ->
+    (byt_deps, opt_deps)
+
+let (depends_on, escaped_eol) = (":", " \\\n    ")
+
+let print_filename s =
+  let s = if !Clflags.force_slash then fix_slash s else s in
+  if not (String.contains s ' ') then begin
+    print_string s;
+  end else begin
+    let rec count n i =
+      if i >= String.length s then n
+      else if s.[i] = ' ' then count (n+1) (i+1)
+      else count n (i+1)
+    in
+    let spaces = count 0 0 in
+    let result = Bytes.create (String.length s + spaces) in
+    let rec loop i j =
+      if i >= String.length s then ()
+      else if s.[i] = ' ' then begin
+        Bytes.set result j '\\';
+        Bytes.set result (j+1) ' ';
+        loop (i+1) (j+2);
+      end else begin
+        Bytes.set result j s.[i];
+        loop (i+1) (j+1);
+      end
+    in
+    loop 0 0;
+    print_bytes result;
+  end
+;;
+
+let print_dependencies target_files deps =
+  let pos = ref 0 in
+  let print_on_same_line item =
+    if !pos <> 0 then print_string " ";
+    print_filename item;
+    pos := !pos + String.length item + 1;
+  in
+  let print_on_new_line item =
+    print_string escaped_eol;
+    print_filename item;
+    pos := String.length item + 4;
+  in
+  let print_compact item =
+    if !one_line || (!pos + 1 + String.length item <= 77)
+    then print_on_same_line item
+    else print_on_new_line item
+  in
+  let print_dep item =
+    if !one_line
+    then print_on_same_line item
+    else print_on_new_line item
+  in
+  List.iter print_compact target_files;
+  print_string " "; print_string depends_on;
+  pos := !pos + String.length depends_on + 1;
+  List.iter print_dep deps;
+  print_string "\n"
+
+let print_raw_dependencies source_file deps =
+  print_filename source_file; print_string depends_on;
+  String.Set.iter
+    (fun dep ->
+       (* filter out "*predef*" *)
+      if (String.length dep > 0)
+          && (match dep.[0] with
+              | 'A'..'Z' | '\128'..'\255' -> true
+              | _ -> false) then
+        begin
+          print_char ' ';
+          print_string dep
+        end)
+    deps;
+  print_char '\n'
+
+
+(* Process one file *)
+
+let print_exception exn =
+  Location.report_exception Format.err_formatter exn
+
+let report_err exn =
+  Error_occurred.set ();
+  print_exception exn
+
+let tool_name = "ocamldep"
+
+let rec lexical_approximation lexbuf =
+  (* Approximation when a file can't be parsed.
+     Heuristic:
+     - first component of any path starting with an uppercase character is a
+       dependency.
+     - always skip the token after a dot, unless dot is preceded by a
+       lower-case identifier
+     - always skip the token after a backquote
+  *)
+  try
+    let rec process after_lident lexbuf =
+      match Lexer.token lexbuf with
+      | Parser.UIDENT name ->
+          Depend.free_structure_names :=
+            String.Set.add name !Depend.free_structure_names;
+          process false lexbuf
+      | Parser.LIDENT _ -> process true lexbuf
+      | Parser.DOT when after_lident -> process false lexbuf
+      | Parser.DOT | Parser.BACKQUOTE -> skip_one lexbuf
+      | Parser.EOF -> ()
+      | _ -> process false lexbuf
+    and skip_one lexbuf =
+      match Lexer.token lexbuf with
+      | Parser.DOT | Parser.BACKQUOTE -> skip_one lexbuf
+      | Parser.EOF -> ()
+      | _ -> process false lexbuf
+
+    in
+    process false lexbuf
+  with Lexer.Error _ -> lexical_approximation lexbuf
+
+let read_and_approximate inputfile =
+  Depend.free_structure_names := String.Set.empty;
+  let ic = open_in_bin inputfile in
+  try
+    seek_in ic 0;
+    Location.input_name := inputfile;
+    let lexbuf = Lexing.from_channel ic in
+    Location.init lexbuf inputfile;
+    lexical_approximation lexbuf;
+    close_in ic;
+    !Depend.free_structure_names
+  with exn ->
+    close_in ic;
+    report_err exn;
+    !Depend.free_structure_names
+
+let read_parse_and_extract parse_function extract_function def ast_kind
+    source_file =
+  Depend.pp_deps := [];
+  Depend.free_structure_names := String.Set.empty;
+  try
+    let input_file = Pparse.preprocess source_file in
+    begin try
+      let ast = Pparse.file ~tool_name input_file parse_function ast_kind in
+      let bound_vars =
+        List.fold_left
+          (fun bv modname ->
+             let lid =
+               let lexbuf = Lexing.from_string modname in
+               Location.init lexbuf
+                 (Printf.sprintf "command line argument: -open %S" modname);
+               Parse.simple_module_path lexbuf in
+             Depend.open_module bv lid)
+          !module_map ((* PR#7248 *) List.rev !Clflags.open_modules)
+      in
+      let r = extract_function bound_vars ast in
+      Pparse.remove_preprocessed input_file;
+      (!Depend.free_structure_names, r)
+    with x ->
+      Pparse.remove_preprocessed input_file;
+      raise x
+    end
+  with x -> begin
+    print_exception x;
+    if not !allow_approximation then begin
+      Error_occurred.set ();
+      (String.Set.empty, def)
+    end else
+      (read_and_approximate source_file, def)
+  end
+
+let print_ml_dependencies source_file extracted_deps pp_deps =
+  let basename = Filename.chop_extension source_file in
+  let byte_targets = [ basename ^ ".cmo" ] in
+  let native_targets =
+    if !all_dependencies
+    then [ basename ^ ".cmx"; basename ^ ".o" ]
+    else [ basename ^ ".cmx" ] in
+  let shared_targets = [ basename ^ ".cmxs" ] in
+  let init_deps = if !all_dependencies then [source_file] else [] in
+  let cmi_name = basename ^ ".cmi" in
+  let init_deps, extra_targets =
+    if List.exists (fun ext -> Sys.file_exists (basename ^ ext))
+        !mli_synonyms
+    then (cmi_name :: init_deps, cmi_name :: init_deps), []
+    else (init_deps, init_deps),
+         (if !all_dependencies then [cmi_name] else [])
+  in
+  let (byt_deps, native_deps) =
+    String.Set.fold (find_dependency ML)
+      extracted_deps init_deps in
+  if not !native_only then
+    print_dependencies (byte_targets @ extra_targets) (byt_deps @ pp_deps);
+  if not !bytecode_only then
+    begin
+      print_dependencies (native_targets @ extra_targets)
+        (native_deps @ pp_deps);
+      if !shared then
+        print_dependencies (shared_targets @ extra_targets)
+          (native_deps @ pp_deps)
+    end
+
+let print_mli_dependencies source_file extracted_deps pp_deps =
+  let basename = Filename.chop_extension source_file in
+  let (byt_deps, _opt_deps) =
+    String.Set.fold (find_dependency MLI)
+      extracted_deps ([], []) in
+  print_dependencies [basename ^ ".cmi"] (byt_deps @ pp_deps)
+
+let print_file_dependencies (source_file, kind, extracted_deps, pp_deps) =
+  if !raw_dependencies then begin
+    print_raw_dependencies source_file extracted_deps
+  end else
+    match kind with
+    | ML -> print_ml_dependencies source_file extracted_deps pp_deps
+    | MLI -> print_mli_dependencies source_file extracted_deps pp_deps
+
+
+let ml_file_dependencies source_file =
+  let parse_use_file_as_impl lexbuf =
+    let f x =
+      match x with
+      | Ptop_def s -> s
+      | Ptop_dir _ -> []
+    in
+    List.flatten (List.map f (Parse.use_file lexbuf))
+  in
+  let (extracted_deps, ()) =
+    read_parse_and_extract parse_use_file_as_impl Depend.add_implementation ()
+                           Pparse.Structure source_file
+  in
+  files := (source_file, ML, extracted_deps, !Depend.pp_deps) :: !files
+
+let mli_file_dependencies source_file =
+  let (extracted_deps, ()) =
+    read_parse_and_extract Parse.interface Depend.add_signature ()
+                           Pparse.Signature source_file
+  in
+  files := (source_file, MLI, extracted_deps, !Depend.pp_deps) :: !files
+
+let process_file_as process_fun def source_file =
+  Compenv.readenv ppf (Before_compile source_file);
+  load_path := [];
+  let cwd = if !nocwd then [] else [Filename.current_dir_name] in
+  List.iter add_to_load_path (
+      (!Compenv.last_include_dirs @
+       !Clflags.include_dirs @
+       !Compenv.first_include_dirs @
+       cwd
+      ));
+  Location.input_name := source_file;
+  try
+    if Sys.file_exists source_file then process_fun source_file else def
+  with x -> report_err x; def
+
+let process_file source_file ~ml_file ~mli_file ~def =
+  if List.exists (Filename.check_suffix source_file) !ml_synonyms then
+    process_file_as ml_file def source_file
+  else if List.exists (Filename.check_suffix source_file) !mli_synonyms then
+    process_file_as mli_file def source_file
+  else def
+
+let file_dependencies source_file =
+  process_file source_file ~def:()
+    ~ml_file:ml_file_dependencies
+    ~mli_file:mli_file_dependencies
+
+let file_dependencies_as kind =
+  match kind with
+  | ML -> process_file_as ml_file_dependencies ()
+  | MLI -> process_file_as mli_file_dependencies ()
+
+let sort_files_by_dependencies files =
+  let h = Hashtbl.create 31 in
+  let worklist = ref [] in
+
+(* Init Hashtbl with all defined modules *)
+  let files = List.map (fun (file, file_kind, deps, pp_deps) ->
+    let modname =
+      String.capitalize_ascii (Filename.chop_extension (Filename.basename file))
+    in
+    let key = (modname, file_kind) in
+    let new_deps = ref [] in
+    Hashtbl.add h key (file, new_deps);
+    worklist := key :: !worklist;
+    (modname, file_kind, deps, new_deps, pp_deps)
+  ) files in
+
+(* Keep only dependencies to defined modules *)
+  List.iter (fun (modname, file_kind, deps, new_deps, _pp_deps) ->
+    let add_dep modname kind =
+      new_deps := (modname, kind) :: !new_deps;
+    in
+    String.Set.iter (fun modname ->
+      match file_kind with
+          ML -> (* ML depends both on ML and MLI *)
+            if Hashtbl.mem h (modname, MLI) then add_dep modname MLI;
+            if Hashtbl.mem h (modname, ML) then add_dep modname ML
+        | MLI -> (* MLI depends on MLI if exists, or ML otherwise *)
+          if Hashtbl.mem h (modname, MLI) then add_dep modname MLI
+          else if Hashtbl.mem h (modname, ML) then add_dep modname ML
+    ) deps;
+    if file_kind = ML then (* add dep from .ml to .mli *)
+      if Hashtbl.mem h (modname, MLI) then add_dep modname MLI
+  ) files;
+
+(* Print and remove all files with no remaining dependency. Iterate
+   until all files have been removed (worklist is empty) or
+   no file was removed during a turn (cycle). *)
+  let printed = ref true in
+  while !printed && !worklist <> [] do
+    let files = !worklist in
+    worklist := [];
+    printed := false;
+    List.iter (fun key ->
+      let (file, deps) = Hashtbl.find h key in
+      let set = !deps in
+      deps := [];
+      List.iter (fun key ->
+        if Hashtbl.mem h key then deps := key :: !deps
+      ) set;
+      if !deps = [] then begin
+        printed := true;
+        Printf.printf "%s " file;
+        Hashtbl.remove h key;
+      end else
+        worklist := key :: !worklist
+    ) files
+  done;
+
+  if !worklist <> [] then begin
+    Location.error "cycle in dependencies. End of list is not sorted."
+    |> Location.print_report Format.err_formatter;
+    let sorted_deps =
+      let li = ref [] in
+      Hashtbl.iter (fun _ file_deps -> li := file_deps :: !li) h;
+      List.sort (fun (file1, _) (file2, _) -> String.compare file1 file2) !li
+    in
+    List.iter (fun (file, deps) ->
+      Format.fprintf Format.err_formatter "\t@[%s: " file;
+      List.iter (fun (modname, kind) ->
+        Format.fprintf Format.err_formatter "%s.%s " modname
+          (if kind=ML then "ml" else "mli");
+      ) !deps;
+      Format.fprintf Format.err_formatter "@]@.";
+      Printf.printf "%s " file) sorted_deps;
+    Error_occurred.set ()
+  end;
+  Printf.printf "\n%!";
+  ()
+
+(* Map *)
+
+let rec dump_map s0 ppf m =
+  let open Depend in
+  String.Map.iter
+    (fun key (Node(s1,m')) ->
+      let s = String.Set.diff s1 s0 in
+      if String.Set.is_empty s then
+        Format.fprintf ppf "@ @[module %s : sig%a@;<1 -2>end@]"
+          key (dump_map (String.Set.union s1 s0)) m'
+      else
+        Format.fprintf ppf "@ module %s = %s" key (String.Set.choose s))
+    m
+
+let process_ml_map =
+  read_parse_and_extract Parse.implementation Depend.add_implementation_binding
+                         String.Map.empty Pparse.Structure
+
+let process_mli_map =
+  read_parse_and_extract Parse.interface Depend.add_signature_binding
+                         String.Map.empty Pparse.Signature
+
+let parse_map fname =
+  map_files := fname :: !map_files ;
+  let old_transp = !Clflags.transparent_modules in
+  Clflags.transparent_modules := true;
+  let (deps, m) =
+    process_file fname ~def:(String.Set.empty, String.Map.empty)
+      ~ml_file:process_ml_map
+      ~mli_file:process_mli_map
+  in
+  Clflags.transparent_modules := old_transp;
+  let modname =
+    String.capitalize_ascii
+      (Filename.basename (Filename.chop_extension 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
+  if !debug then begin
+    Format.printf "@[%s:%t%a@]@." fname
+      (fun ppf -> String.Set.iter (Format.fprintf ppf " %s") deps)
+      (dump_map deps) (String.Map.add modname mm String.Map.empty)
+  end;
+  let mm = Depend.(weaken_map (String.Set.singleton modname) mm) in
+  module_map := String.Map.add modname mm !module_map
+;;
+
+
+(* Entry point *)
+
+let print_version () =
+  Format.printf "ocamldep, version %s@." Sys.ocaml_version;
+  exit 0;
+;;
+
+let print_version_num () =
+  Format.printf "%s@." Sys.ocaml_version;
+  exit 0;
+;;
+
+let main () =
+  Clflags.classic := false;
+  Compenv.readenv ppf Before_args;
+  Clflags.reset_arguments (); (* reset arguments from ocamlc/ocamlopt *)
+  Clflags.add_arguments __LOC__ [
+     "-absname", Arg.Set Clflags.absname,
+        " Show absolute filenames in error messages";
+     "-all", Arg.Set all_dependencies,
+        " Generate dependencies on all files";
+     "-allow-approx", Arg.Set allow_approximation,
+        " Fallback to a lexer-based approximation on unparsable files";
+     "-as-map", Arg.Set Clflags.transparent_modules,
+      " Omit delayed dependencies for module aliases (-no-alias-deps -w -49)";
+      (* "compiler uses -no-alias-deps, and no module is coerced"; *)
+     "-debug-map", Arg.Set debug,
+        " Dump the delayed dependency map for each map file";
+     "-I", Arg.String (add_to_list Clflags.include_dirs),
+        "  Add  to the list of include directories";
+     "-nocwd", Arg.Set nocwd,
+        " Do not add current working directory to \
+          the list of include directories";
+     "-impl", Arg.String (file_dependencies_as ML),
+        "  Process  as a .ml file";
+     "-intf", Arg.String (file_dependencies_as MLI),
+        "  Process  as a .mli file";
+     "-map", Arg.String parse_map,
+        "  Read  and propagate delayed dependencies to following files";
+     "-ml-synonym", Arg.String(add_to_synonym_list ml_synonyms),
+        "  Consider  as a synonym of the .ml extension";
+     "-mli-synonym", Arg.String(add_to_synonym_list mli_synonyms),
+        "  Consider  as a synonym of the .mli extension";
+     "-modules", Arg.Set raw_dependencies,
+        " Print module dependencies in raw form (not suitable for make)";
+     "-native", Arg.Set native_only,
+        " Generate dependencies for native-code only (no .cmo files)";
+     "-bytecode", Arg.Set bytecode_only,
+        " Generate dependencies for bytecode-code only (no .cmx files)";
+     "-one-line", Arg.Set one_line,
+        " Output one line per file, regardless of the length";
+     "-open", Arg.String (add_to_list Clflags.open_modules),
+        "  Opens the module  before typing";
+     "-plugin", Arg.String(fun _p -> Clflags.plugin := true),
+         "  (no longer supported)";
+     "-pp", Arg.String(fun s -> Clflags.preprocessor := Some s),
+         "  Pipe sources through preprocessor ";
+     "-ppx", Arg.String (add_to_list first_ppx),
+         "  Pipe abstract syntax trees through preprocessor ";
+     "-shared", Arg.Set shared,
+         " Generate dependencies for native plugin files (.cmxs targets)";
+     "-slash", Arg.Set Clflags.force_slash,
+         " (Windows) Use forward slash / instead of backslash \\ in file paths";
+     "-sort", Arg.Set sort_files,
+        " Sort files according to their dependencies";
+     "-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,
+         " Read additional newline separated command line arguments \n\
+         \      from ";
+     "-args0", Arg.Expand Arg.read_arg0,
+         " Read additional NUL separated command line arguments from \n\
+         \      "
+  ];
+  let usage =
+    Printf.sprintf "Usage: %s [options] \nOptions are:"
+                   (Filename.basename Sys.argv.(0))
+  in
+  Clflags.parse_arguments file_dependencies usage;
+  Compenv.readenv ppf Before_link;
+  if !sort_files then sort_files_by_dependencies !files
+  else List.iter print_file_dependencies (List.sort compare !files);
+  exit (if Error_occurred.get () then 2 else 0)
+
+let main_from_option () =
+  if Sys.argv.(1) <> "-depend" then begin
+    Printf.eprintf
+      "Fatal error: argument -depend must be used as first argument.\n%!";
+    exit 2;
+  end;
+  incr Arg.current;
+  Sys.argv.(0) <- Sys.argv.(0) ^ " -depend";
+  Sys.argv.(!Arg.current) <- Sys.argv.(0);
+  main ()
diff --git a/driver/makedepend.mli b/driver/makedepend.mli
new file mode 100644
index 00000000..5a0a8f17
--- /dev/null
+++ b/driver/makedepend.mli
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1999 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+val main : unit -> unit
+
+(* entry point when called from the -depend option of ocamlc/ocamlopt *)
+val main_from_option : unit -> unit
diff --git a/driver/optcompile.ml b/driver/optcompile.ml
new file mode 100644
index 00000000..9ca93c33
--- /dev/null
+++ b/driver/optcompile.ml
@@ -0,0 +1,96 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The batch compiler *)
+
+open Misc
+open Compile_common
+
+let tool_name = "ocamlopt"
+
+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 ->
+  Compile_common.interface info
+
+let (|>>) (x, y) f = (x, f y)
+
+(** Native compilation backend for .ml files. *)
+
+let flambda i backend typed =
+  if !Clflags.classic_inlining then begin
+    Clflags.default_simplify_rounds := 1;
+    Clflags.use_inlining_arguments_set Clflags.classic_arguments;
+    Clflags.unbox_free_vars_of_closures := false;
+    Clflags.unbox_specialised_args := false
+  end;
+  typed
+  |> Profile.(record transl)
+      (Translmod.transl_implementation_flambda i.module_name)
+  |> Profile.(record generate)
+    (fun {Lambda.module_ident; main_module_block_size;
+          required_globals; code } ->
+    ((module_ident, main_module_block_size), code)
+    |>> print_if i.ppf_dump Clflags.dump_rawlambda Printlambda.lambda
+    |>> Simplif.simplify_lambda
+    |>> print_if i.ppf_dump Clflags.dump_lambda Printlambda.lambda
+    |> (fun ((module_ident, main_module_block_size), code) ->
+      let program : Lambda.program =
+        { Lambda.
+          module_ident;
+          main_module_block_size;
+          required_globals;
+          code;
+        }
+      in
+      Asmgen.compile_implementation
+        ~backend
+        ~filename:i.source_file
+        ~prefixname:i.output_prefix
+        ~middle_end:Flambda_middle_end.lambda_to_clambda
+        ~ppf_dump:i.ppf_dump
+        program);
+    Compilenv.save_unit_info (cmx i))
+
+let clambda i backend typed =
+  Clflags.use_inlining_arguments_set Clflags.classic_arguments;
+  typed
+  |> Profile.(record transl)
+    (Translmod.transl_store_implementation i.module_name)
+  |> print_if i.ppf_dump Clflags.dump_rawlambda Printlambda.program
+  |> Profile.(record generate)
+    (fun program ->
+       let code = Simplif.simplify_lambda program.Lambda.code in
+       { program with Lambda.code }
+       |> print_if i.ppf_dump Clflags.dump_lambda Printlambda.program
+       |> Asmgen.compile_implementation
+            ~backend
+            ~filename:i.source_file
+            ~prefixname:i.output_prefix
+            ~middle_end:Closure_middle_end.lambda_to_clambda
+            ~ppf_dump:i.ppf_dump;
+       Compilenv.save_unit_info (cmx i))
+
+let implementation ~backend ~source_file ~output_prefix =
+  let backend info typed =
+    Compilenv.reset ?packname:!Clflags.for_package info.module_name;
+    if Config.flambda
+    then flambda info backend typed
+    else clambda info backend typed
+  in
+  with_info ~source_file ~output_prefix ~dump_ext:"cmx" @@ fun info ->
+  Compile_common.implementation info ~backend
diff --git a/driver/optcompile.mli b/driver/optcompile.mli
new file mode 100644
index 00000000..9a23b8b2
--- /dev/null
+++ b/driver/optcompile.mli
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Native compilation for .ml and .mli files. *)
+
+val interface: source_file:string -> output_prefix:string -> unit
+
+val implementation:
+   backend:(module Backend_intf.S)
+   -> source_file:string -> output_prefix:string -> unit
+
+(** {2 Internal functions} **)
+
+val clambda :
+  Compile_common.info ->
+  (module Backend_intf.S) ->
+  Typedtree.structure * Typedtree.module_coercion -> unit
+(** [clambda info typed] applies the regular compilation pipeline to the
+    given typechecked implementation and outputs the resulting files.
+*)
+
+val flambda :
+  Compile_common.info ->
+  (module Backend_intf.S) ->
+  Typedtree.structure * Typedtree.module_coercion -> unit
+(** [flambda info backend typed] applies the Flambda compilation pipeline to the
+    given typechecked implementation and outputs the resulting files.
+*)
diff --git a/driver/opterrors.ml b/driver/opterrors.ml
new file mode 100644
index 00000000..96fa0240
--- /dev/null
+++ b/driver/opterrors.ml
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* This module should be removed.  We keep it for now, to avoid
+   breaking external tools depending on it. *)
+
+let report_error = Location.report_exception
diff --git a/driver/opterrors.mli b/driver/opterrors.mli
new file mode 100644
index 00000000..75827239
--- /dev/null
+++ b/driver/opterrors.mli
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Error report *)
+
+val report_error: Format.formatter -> exn -> unit
diff --git a/driver/optmain.ml b/driver/optmain.ml
new file mode 100644
index 00000000..d7ef1c48
--- /dev/null
+++ b/driver/optmain.ml
@@ -0,0 +1,139 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Clflags
+open Compenv
+
+module Backend = struct
+  (* See backend_intf.mli. *)
+
+  let symbol_for_global' = Compilenv.symbol_for_global'
+  let closure_symbol = Compilenv.closure_symbol
+
+  let really_import_approx = Import_approx.really_import_approx
+  let import_symbol = Import_approx.import_symbol
+
+  let size_int = Arch.size_int
+  let big_endian = Arch.big_endian
+
+  let max_sensible_number_of_arguments =
+    (* The "-1" is to allow for a potential closure environment parameter. *)
+    Proc.max_arguments_for_tailcalls - 1
+end
+let backend = (module Backend : Backend_intf.S)
+
+let usage = "Usage: ocamlopt  \nOptions are:"
+
+module Options = Main_args.Make_optcomp_options (Main_args.Default.Optmain)
+let main () =
+  native_code := true;
+  let ppf = Format.err_formatter in
+  try
+    readenv ppf Before_args;
+    Clflags.add_arguments __LOC__ (Arch.command_line_options @ Options.list);
+    Clflags.add_arguments __LOC__
+      ["-depend", Arg.Unit Makedepend.main_from_option,
+       " Compute dependencies \
+        (use 'ocamlopt -depend -help' for details)"];
+    Clflags.parse_arguments anonymous usage;
+    Compmisc.read_clflags_from_env ();
+    if !Clflags.plugin then
+      fatal "-plugin is only supported up to OCaml 4.08.0";
+    begin try
+      Compenv.process_deferred_actions
+        (ppf,
+         Optcompile.implementation ~backend,
+         Optcompile.interface,
+         ".cmx",
+         ".cmxa");
+    with Arg.Bad msg ->
+      begin
+        prerr_endline msg;
+        Clflags.print_arguments usage;
+        exit 2
+      end
+    end;
+    readenv ppf Before_link;
+    if
+      List.length (List.filter (fun x -> !x)
+                     [make_package; make_archive; shared;
+                      stop_early; output_c_object]) > 1
+    then
+    begin
+      let module P = Clflags.Compiler_pass in
+      match !stop_after with
+      | None ->
+        fatal "Please specify at most one of -pack, -a, -shared, -c, \
+             -output-obj";
+      | Some ((P.Parsing | P.Typing | P.Scheduling) as p) ->
+        assert (P.is_compilation_pass p);
+        Printf.ksprintf fatal
+          "Options -i and -stop-after (%s) \
+           are  incompatible with -pack, -a, -shared, -output-obj"
+          (String.concat "|"
+             (Clflags.Compiler_pass.available_pass_names ~native:true))
+    end;
+    if !make_archive then begin
+      Compmisc.init_path ();
+      let target = extract_output !output_name in
+      Asmlibrarian.create_archive
+        (get_objfiles ~with_ocamlparam:false) target;
+      Warnings.check_fatal ();
+    end
+    else if !make_package then begin
+      Compmisc.init_path ();
+      let target = extract_output !output_name in
+      Compmisc.with_ppf_dump ~file_prefix:target (fun ppf_dump ->
+        Asmpackager.package_files ~ppf_dump (Compmisc.initial_env ())
+          (get_objfiles ~with_ocamlparam:false) target ~backend);
+      Warnings.check_fatal ();
+    end
+    else if !shared then begin
+      Compmisc.init_path ();
+      let target = extract_output !output_name in
+      Compmisc.with_ppf_dump ~file_prefix:target (fun ppf_dump ->
+        Asmlink.link_shared ~ppf_dump
+          (get_objfiles ~with_ocamlparam:false) target);
+      Warnings.check_fatal ();
+    end
+    else if not !stop_early && !objfiles <> [] then begin
+      let target =
+        if !output_c_object then
+          let s = extract_output !output_name in
+          if (Filename.check_suffix s Config.ext_obj
+            || Filename.check_suffix s Config.ext_dll)
+          then s
+          else
+            fatal
+              (Printf.sprintf
+                 "The extension of the output file must be %s or %s"
+                 Config.ext_obj Config.ext_dll
+              )
+        else
+          default_output !output_name
+      in
+      Compmisc.init_path ();
+      Compmisc.with_ppf_dump ~file_prefix:target (fun ppf_dump ->
+        Asmlink.link ~ppf_dump (get_objfiles ~with_ocamlparam:true) target);
+      Warnings.check_fatal ();
+    end;
+  with x ->
+      Location.report_exception ppf x;
+      exit 2
+
+let () =
+  main ();
+  Profile.print Format.std_formatter !Clflags.profile_columns;
+  exit 0
diff --git a/driver/optmain.mli b/driver/optmain.mli
new file mode 100644
index 00000000..f0911cea
--- /dev/null
+++ b/driver/optmain.mli
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Damien Doligez, projet Moscova, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2000 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 "empty" file is here to speed up garbage collection in ocamlopt.opt
+*)
diff --git a/driver/pparse.ml b/driver/pparse.ml
new file mode 100644
index 00000000..a5e98c0a
--- /dev/null
+++ b/driver/pparse.ml
@@ -0,0 +1,230 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*         Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt       *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Format
+
+type error =
+  | CannotRun of string
+  | WrongMagic of string
+
+exception Error of error
+
+(* Optionally preprocess a source file *)
+
+let call_external_preprocessor sourcefile pp =
+      let tmpfile = Filename.temp_file "ocamlpp" "" in
+      let comm = Printf.sprintf "%s %s > %s"
+                                pp (Filename.quote sourcefile) tmpfile
+      in
+      if Ccomp.command comm <> 0 then begin
+        Misc.remove_file tmpfile;
+        raise (Error (CannotRun comm));
+      end;
+      tmpfile
+
+let preprocess sourcefile =
+  match !Clflags.preprocessor with
+    None -> sourcefile
+  | Some pp ->
+      Profile.record "-pp"
+        (call_external_preprocessor sourcefile) pp
+
+
+let remove_preprocessed inputfile =
+  match !Clflags.preprocessor with
+    None -> ()
+  | Some _ -> Misc.remove_file inputfile
+
+type 'a ast_kind =
+| Structure : Parsetree.structure ast_kind
+| Signature : Parsetree.signature ast_kind
+
+let magic_of_kind : type a . a ast_kind -> string = function
+  | Structure -> Config.ast_impl_magic_number
+  | Signature -> Config.ast_intf_magic_number
+
+(* Note: some of the functions here should go to Ast_mapper instead,
+   which would encapsulate the "binary AST" protocol. *)
+
+let write_ast (type a) (kind : a ast_kind) fn (ast : a) =
+  let oc = open_out_bin fn in
+  output_string oc (magic_of_kind kind);
+  output_value oc (!Location.input_name : string);
+  output_value oc (ast : a);
+  close_out oc
+
+let apply_rewriter kind fn_in ppx =
+  let magic = magic_of_kind kind in
+  let fn_out = Filename.temp_file "camlppx" "" in
+  let comm =
+    Printf.sprintf "%s %s %s" ppx (Filename.quote fn_in) (Filename.quote fn_out)
+  in
+  let ok = Ccomp.command comm = 0 in
+  Misc.remove_file fn_in;
+  if not ok then begin
+    Misc.remove_file fn_out;
+    raise (Error (CannotRun comm));
+  end;
+  if not (Sys.file_exists fn_out) then
+    raise (Error (WrongMagic comm));
+  (* check magic before passing to the next ppx *)
+  let ic = open_in_bin fn_out in
+  let buffer =
+    try really_input_string ic (String.length magic) with End_of_file -> "" in
+  close_in ic;
+  if buffer <> magic then begin
+    Misc.remove_file fn_out;
+    raise (Error (WrongMagic comm));
+  end;
+  fn_out
+
+let read_ast (type a) (kind : a ast_kind) fn : a =
+  let ic = open_in_bin fn in
+  Misc.try_finally
+    ~always:(fun () -> close_in ic; Misc.remove_file fn)
+    (fun () ->
+       let magic = magic_of_kind kind in
+       let buffer = really_input_string ic (String.length magic) in
+       assert(buffer = magic); (* already checked by apply_rewriter *)
+       Location.input_name := (input_value ic : string);
+       (input_value ic : a)
+    )
+
+let rewrite kind ppxs ast =
+  let fn = Filename.temp_file "camlppx" "" in
+  write_ast kind fn ast;
+  let fn = List.fold_left (apply_rewriter kind) fn (List.rev ppxs) in
+  read_ast kind fn
+
+let apply_rewriters_str ?(restore = true) ~tool_name ast =
+  match !Clflags.all_ppx with
+  | [] -> ast
+  | ppxs ->
+      let ast =
+        ast
+        |> Ast_mapper.add_ppx_context_str ~tool_name
+        |> rewrite Structure ppxs
+        |> Ast_mapper.drop_ppx_context_str ~restore
+      in
+      Ast_invariants.structure ast; ast
+
+let apply_rewriters_sig ?(restore = true) ~tool_name ast =
+  match !Clflags.all_ppx with
+  | [] -> ast
+  | ppxs ->
+      let ast =
+        ast
+        |> Ast_mapper.add_ppx_context_sig ~tool_name
+        |> rewrite Signature ppxs
+        |> Ast_mapper.drop_ppx_context_sig ~restore
+      in
+      Ast_invariants.signature ast; ast
+
+let apply_rewriters ?restore ~tool_name
+    (type a) (kind : a ast_kind) (ast : a) : a =
+  match kind with
+  | Structure ->
+      apply_rewriters_str ?restore ~tool_name ast
+  | Signature ->
+      apply_rewriters_sig ?restore ~tool_name ast
+
+(* Parse a file or get a dumped syntax tree from it *)
+
+exception Outdated_version
+
+let open_and_check_magic inputfile ast_magic =
+  let ic = open_in_bin inputfile in
+  let is_ast_file =
+    try
+      let buffer = really_input_string ic (String.length ast_magic) in
+      if buffer = ast_magic then true
+      else if String.sub buffer 0 9 = String.sub ast_magic 0 9 then
+        raise Outdated_version
+      else false
+    with
+      Outdated_version ->
+        Misc.fatal_error "OCaml and preprocessor have incompatible versions"
+    | _ -> false
+  in
+  (ic, is_ast_file)
+
+let parse (type a) (kind : a ast_kind) lexbuf : a =
+  match kind with
+  | Structure -> Parse.implementation lexbuf
+  | Signature -> Parse.interface lexbuf
+
+let file_aux ~tool_name inputfile (type a) parse_fun invariant_fun
+             (kind : a ast_kind) : a =
+  let ast_magic = magic_of_kind kind in
+  let (ic, is_ast_file) = open_and_check_magic inputfile ast_magic in
+  let ast =
+    try
+      if is_ast_file then begin
+        Location.input_name := (input_value ic : string);
+        if !Clflags.unsafe then
+          Location.prerr_warning (Location.in_file !Location.input_name)
+            Warnings.Unsafe_without_parsing;
+        let ast = (input_value ic : a) in
+        if !Clflags.all_ppx = [] then invariant_fun ast;
+        (* if all_ppx <> [], invariant_fun will be called by apply_rewriters *)
+        ast
+      end else begin
+        seek_in ic 0;
+        let lexbuf = Lexing.from_channel ic in
+        Location.init lexbuf inputfile;
+        Location.input_lexbuf := Some lexbuf;
+        Profile.record_call "parser" (fun () -> parse_fun lexbuf)
+      end
+    with x -> close_in ic; raise x
+  in
+  close_in ic;
+  Profile.record_call "-ppx" (fun () ->
+      apply_rewriters ~restore:false ~tool_name kind ast
+    )
+
+let file ~tool_name inputfile parse_fun ast_kind =
+  file_aux ~tool_name inputfile parse_fun ignore ast_kind
+
+let report_error ppf = function
+  | CannotRun cmd ->
+      fprintf ppf "Error while running external preprocessor@.\
+                   Command line: %s@." cmd
+  | WrongMagic cmd ->
+      fprintf ppf "External preprocessor does not produce a valid file@.\
+                   Command line: %s@." cmd
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )
+
+let parse_file ~tool_name invariant_fun parse kind sourcefile =
+  Location.input_name := sourcefile;
+  let inputfile = preprocess sourcefile in
+  Misc.try_finally
+    (fun () ->
+       Profile.record_call "parsing" @@ fun () ->
+       file_aux ~tool_name inputfile parse invariant_fun kind)
+    ~always:(fun () -> remove_preprocessed inputfile)
+
+let parse_implementation ~tool_name sourcefile =
+  parse_file ~tool_name Ast_invariants.structure
+      (parse Structure) Structure sourcefile
+
+let parse_interface ~tool_name sourcefile =
+  parse_file ~tool_name Ast_invariants.signature
+    (parse Signature) Signature sourcefile
diff --git a/driver/pparse.mli b/driver/pparse.mli
new file mode 100644
index 00000000..40b77a8b
--- /dev/null
+++ b/driver/pparse.mli
@@ -0,0 +1,66 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*         Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt       *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Driver for the parser and external preprocessors.
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Format
+
+type error =
+  | CannotRun of string
+  | WrongMagic of string
+
+exception Error of error
+
+val preprocess : string -> string
+val remove_preprocessed : string -> unit
+
+type 'a ast_kind =
+| Structure : Parsetree.structure ast_kind
+| Signature : Parsetree.signature ast_kind
+
+val read_ast : 'a ast_kind -> string -> 'a
+val write_ast : 'a ast_kind -> string -> 'a -> unit
+
+val file : tool_name:string -> string ->
+  (Lexing.lexbuf -> 'a) -> 'a ast_kind -> 'a
+
+val apply_rewriters: ?restore:bool -> tool_name:string ->
+  'a ast_kind -> 'a -> 'a
+  (** If [restore = true] (the default), cookies set by external
+      rewriters will be kept for later calls. *)
+
+val apply_rewriters_str:
+  ?restore:bool -> tool_name:string -> Parsetree.structure ->
+  Parsetree.structure
+val apply_rewriters_sig:
+  ?restore:bool -> tool_name:string -> Parsetree.signature ->
+  Parsetree.signature
+
+val report_error : formatter -> error -> unit
+
+
+val parse_implementation:
+  tool_name:string -> string -> Parsetree.structure
+val parse_interface:
+  tool_name:string -> string -> Parsetree.signature
+
+(* [call_external_preprocessor sourcefile pp] *)
+val call_external_preprocessor : string -> string -> string
+val open_and_check_magic : string -> string -> in_channel * bool
diff --git a/dune b/dune
new file mode 100644
index 00000000..f80f6391
--- /dev/null
+++ b/dune
@@ -0,0 +1,222 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+(env
+ (dev     (flags (:standard -w +a-4-9-40-41-42-44-45-48)))
+ (release (flags (:standard -w +a-4-9-40-41-42-44-45-48))))
+
+;; Too annoying to get to work. Use (copy_files# ...) instead
+; (include_subdirs unqualified)
+; (ignored_subdirs (lex yacc testsuite ocamldoc ocamltest toplevel otherlibs))
+
+(copy_files# utils/*.ml{,i})
+(copy_files# parsing/*.ml{,i})
+(copy_files# typing/*.ml{,i})
+(copy_files# bytecomp/*.ml{,i})
+(copy_files# driver/*.ml{,i})
+(copy_files# asmcomp/*.ml{,i})
+(copy_files# asmcomp/debug/*.ml{,i})
+(copy_files# file_formats/*.ml{,i})
+(copy_files# lambda/*.ml{,i})
+(copy_files# middle_end/*.ml{,i})
+(copy_files# middle_end/closure/*.ml{,i})
+(copy_files# middle_end/flambda/*.ml{,i})
+(copy_files# middle_end/flambda/base_types/*.ml{,i})
+
+(library
+ (name ocamlcommon)
+ (wrapped false)
+ (flags (:standard -principal -nostdlib))
+ (libraries stdlib)
+ (modules_without_implementation
+   annot asttypes cmo_format outcometree parsetree)
+ (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
+
+   ;; PARSING
+   location longident docstrings syntaxerr ast_helper camlinternalMenhirLib
+   parser lexer parse printast pprintast ast_mapper ast_iterator attr_helper
+   builtin_attributes ast_invariants depend
+   ; manual update: mli only files
+   asttypes parsetree
+
+   ;; TYPING
+   ident path primitive types btype oprint subst predef datarepr
+   cmi_format persistent_env env type_immediacy
+   typedtree printtyped ctype printtyp includeclass mtype envaux includecore
+   tast_iterator tast_mapper cmt_format untypeast includemod
+   typetexp printpat parmatch stypes typedecl typeopt rec_check typecore
+   typeclass typemod typedecl_variance typedecl_properties typedecl_immediacy
+   typedecl_unboxed typedecl_separability cmt2annot
+   ; manual update: mli only files
+   annot outcometree
+
+   ;; lambda/
+   debuginfo lambda matching printlambda runtimedef simplif switch
+   translattribute translclass translcore translmod translobj translprim
+
+   ;; bytecomp/
+   meta opcodes bytesections dll symtable
+
+   ;; some of COMP
+   pparse main_args compenv compmisc makedepend compile_common
+   ; manual update: mli only files
+   cmo_format
+   ; manual update: this is required.
+   instruct
+ ))
+
+(library
+ (name ocamlbytecomp)
+ (wrapped false)
+ (flags (:standard -principal -nostdlib))
+ (libraries stdlib ocamlcommon)
+ (modules
+    ;; bytecomp/
+    bytegen bytelibrarian bytelink bytepackager emitcode printinstr
+
+    ;; driver/
+    errors compile
+ ))
+
+(library
+ (name ocamlmiddleend)
+ (wrapped false)
+ (flags (:standard -principal -nostdlib))
+ (libraries stdlib ocamlcommon)
+ (modules_without_implementation
+   cmx_format cmxs_format backend_intf inlining_decision_intf
+   simplify_boxed_integer_ops_intf)
+ (modules
+   ;; file_formats/
+   cmx_format cmxs_format
+
+   ;; middle_end/
+   backend_intf backend_var backend_var clambda clambda_primitives
+   compilation_unit compilenv convert_primitives internal_variable_names
+   linkage_name printclambda printclambda_primitives semantics_of_primitives
+   symbol variable
+
+   ;; middle_end/closure/
+   closure closure_middle_end
+
+   ;; middle_end/flambda/base_types/
+   closure_element closure_id closure_origin export_id id_types mutable_variable
+   set_of_closures_id set_of_closures_origin static_exception tag
+   var_within_closure
+
+   ;; middle_end/flambda/
+   alias_analysis allocated_const augment_specialised_args build_export_info
+   closure_conversion closure_conversion_aux closure_offsets effect_analysis
+   export_info export_info_for_pack extract_projections find_recursive_functions
+   flambda flambda_invariants flambda_iterators flambda_middle_end
+   flambda_to_clambda flambda_utils freshening import_approx inconstant_idents
+   initialize_symbol_to_let_symbol inline_and_simplify inline_and_simplify_aux
+   inlining_cost inlining_decision inlining_decision_intf inlining_stats
+   inlining_stats_types inlining_transforms invariant_params lift_code
+   lift_constants lift_let_to_initialize_symbol parameter pass_wrapper
+   projection ref_to_variables remove_free_vars_equal_to_args
+   remove_unused_arguments remove_unused_closure_vars
+   remove_unused_program_constructs share_constants simple_value_approx
+   simplify_boxed_integer_ops simplify_boxed_integer_ops_intf simplify_common
+   simplify_primitives traverse_for_exported_symbols un_anf unbox_closures
+   unbox_free_vars_of_closures unbox_specialised_args
+ )
+)
+
+(library
+ (name ocamloptcomp)
+ (wrapped false)
+ (flags (:standard -principal -nostdlib))
+ (libraries stdlib ocamlcommon ocamlmiddleend)
+ (modules_without_implementation x86_ast)
+ (modules
+   ;; asmcomp/
+   afl_instrument arch asmgen asmlibrarian asmlink asmpackager branch_relaxation
+   branch_relaxation_intf cmm_helpers cmm cmmgen cmmgen_state coloring comballoc
+   CSE CSEgen
+   deadcode domainstate emit emitaux interf interval linear linearize linscan
+   liveness mach printcmm printlinear printmach proc reg reload reloadgen
+   schedgen scheduling selectgen selection spacetime_profiling spill split
+   strmatch x86_ast x86_dsl x86_gas x86_masm x86_proc
+
+   ;; asmcomp/debug/
+   reg_availability_set compute_ranges_intf available_regs reg_with_debug_info
+   compute_ranges
+
+   ;; driver/
+   optcompile opterrors
+ )
+)
+
+;;;;;;;;;;;;;;
+;;; ocamlc ;;;
+;;;;;;;;;;;;;;
+
+(executable
+ (name main)
+ (modes byte)
+ (flags (:standard -principal -nostdlib))
+ (libraries ocamlbytecomp ocamlcommon runtime stdlib)
+ (modules main))
+
+(rule
+ (copy main.exe ocamlc.byte))
+
+;;;;;;;;;;;;;;;;
+;;; ocamlopt ;;;
+;;;;;;;;;;;;;;;;
+
+(executable
+ (name optmain)
+ (modes byte)
+ (flags (:standard -principal -nostdlib))
+ (libraries ocamloptcomp ocamlmiddleend ocamlcommon runtime stdlib)
+ (modules optmain))
+
+(rule
+ (copy optmain.exe ocamlopt.byte))
+
+;;;;;;;;;;;;;;;
+;;; aliases ;;;
+;;;;;;;;;;;;;;;
+
+; mshinwell: The debugger and ocamldoc are currently disabled as Dynlink is
+; not built correctly.
+(alias
+ (name world)
+ (deps ocamlc.byte
+       ocamlopt.byte
+;       debugger/ocamldebug.byte
+;       ocamldoc/ocamldoc.byte
+       ocamltest/ocamltest.byte
+       toplevel/ocaml.byte
+       toplevel/expunge.exe
+       ))
+
+(alias
+  (name libs)
+  (deps
+    ocamloptcomp.cma
+    ocamlmiddleend.cma
+    ocamlcommon.cma
+    runtime/runtime.cma
+    stdlib/stdlib.cma
+    ocamlbytecomp.cma
+    ocamltest/ocamltest_core_and_plugin.cma
+    toplevel/ocamltoplevel.cma
+  ))
diff --git a/dune-project b/dune-project
new file mode 100644
index 00000000..ce151941
--- /dev/null
+++ b/dune-project
@@ -0,0 +1,2 @@
+(lang dune 1.3)
+(using experimental_building_ocaml_compiler_with_dune 0.1)
diff --git a/file_formats/cmi_format.ml b/file_formats/cmi_format.ml
new file mode 100644
index 00000000..eadf676e
--- /dev/null
+++ b/file_formats/cmi_format.ml
@@ -0,0 +1,118 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Fabrice Le Fessant, INRIA Saclay                     *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Misc
+
+type pers_flags =
+  | Rectypes
+  | Alerts of alerts
+  | Opaque
+  | Unsafe_string
+
+type error =
+  | Not_an_interface of filepath
+  | Wrong_version_interface of filepath * string
+  | Corrupted_interface of filepath
+
+exception Error of error
+
+(* these type abbreviations are not exported;
+   they are used to provide consistency across
+   input_value and output_value usage. *)
+type signature = Types.signature_item list
+type flags = pers_flags list
+type header = modname * signature
+
+type cmi_infos = {
+    cmi_name : modname;
+    cmi_sign : signature;
+    cmi_crcs : crcs;
+    cmi_flags : flags;
+}
+
+let input_cmi ic =
+  let (name, sign) = (input_value ic : header) in
+  let crcs = (input_value ic : crcs) in
+  let flags = (input_value ic : flags) in
+  {
+      cmi_name = name;
+      cmi_sign = sign;
+      cmi_crcs = crcs;
+      cmi_flags = flags;
+    }
+
+let read_cmi filename =
+  let ic = open_in_bin filename in
+  try
+    let buffer =
+      really_input_string ic (String.length Config.cmi_magic_number)
+    in
+    if buffer <> Config.cmi_magic_number then begin
+      close_in ic;
+      let pre_len = String.length Config.cmi_magic_number - 3 in
+      if String.sub buffer 0 pre_len
+          = String.sub Config.cmi_magic_number 0 pre_len then
+      begin
+        let msg =
+          if buffer < Config.cmi_magic_number then "an older" else "a newer" in
+        raise (Error (Wrong_version_interface (filename, msg)))
+      end else begin
+        raise(Error(Not_an_interface filename))
+      end
+    end;
+    let cmi = input_cmi ic in
+    close_in ic;
+    cmi
+  with End_of_file | Failure _ ->
+      close_in ic;
+      raise(Error(Corrupted_interface(filename)))
+    | Error e ->
+      close_in ic;
+      raise (Error e)
+
+let output_cmi filename oc cmi =
+(* beware: the provided signature must have been substituted for saving *)
+  output_string oc Config.cmi_magic_number;
+  output_value oc ((cmi.cmi_name, cmi.cmi_sign) : header);
+  flush oc;
+  let crc = Digest.file filename in
+  let crcs = (cmi.cmi_name, Some crc) :: cmi.cmi_crcs in
+  output_value oc (crcs : crcs);
+  output_value oc (cmi.cmi_flags : flags);
+  crc
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+  | Not_an_interface filename ->
+      fprintf ppf "%a@ is not a compiled interface"
+        Location.print_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."
+        Location.print_filename filename older_newer
+  | Corrupted_interface filename ->
+      fprintf ppf "Corrupted compiled interface@ %a"
+        Location.print_filename filename
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )
diff --git a/file_formats/cmi_format.mli b/file_formats/cmi_format.mli
new file mode 100644
index 00000000..d4d665fd
--- /dev/null
+++ b/file_formats/cmi_format.mli
@@ -0,0 +1,51 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Fabrice Le Fessant, INRIA Saclay                     *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Misc
+
+type pers_flags =
+  | Rectypes
+  | Alerts of alerts
+  | Opaque
+  | Unsafe_string
+
+type cmi_infos = {
+    cmi_name : modname;
+    cmi_sign : Types.signature_item list;
+    cmi_crcs : crcs;
+    cmi_flags : pers_flags list;
+}
+
+(* write the magic + the cmi information *)
+val output_cmi : string -> out_channel -> cmi_infos -> Digest.t
+
+(* read the cmi information (the magic is supposed to have already been read) *)
+val input_cmi : in_channel -> cmi_infos
+
+(* read a cmi from a filename, checking the magic *)
+val read_cmi : string -> cmi_infos
+
+(* Error report *)
+
+type error =
+  | Not_an_interface of filepath
+  | Wrong_version_interface of filepath * string
+  | Corrupted_interface of filepath
+
+exception Error of error
+
+open Format
+
+val report_error: formatter -> error -> unit
diff --git a/file_formats/cmo_format.mli b/file_formats/cmo_format.mli
new file mode 100644
index 00000000..0952157b
--- /dev/null
+++ b/file_formats/cmo_format.mli
@@ -0,0 +1,68 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2006 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Symbol table information for .cmo and .cma files *)
+
+open Misc
+
+(* Relocation information *)
+
+type reloc_info =
+    Reloc_literal of Lambda.structured_constant    (* structured constant *)
+  | Reloc_getglobal of Ident.t              (* reference to a global *)
+  | Reloc_setglobal of Ident.t              (* definition of a global *)
+  | Reloc_primitive of string               (* C primitive number *)
+
+(* Descriptor for compilation units *)
+
+type compilation_unit =
+  { cu_name: modname;                   (* Name of compilation unit *)
+    mutable cu_pos: int;                (* Absolute position in file *)
+    cu_codesize: int;                   (* Size of code block *)
+    cu_reloc: (reloc_info * int) list;  (* Relocation information *)
+    cu_imports: crcs;                   (* Names and CRC of intfs imported *)
+    cu_required_globals: Ident.t list;  (* Compilation units whose
+                                           initialization side effects
+                                           must occur before this one. *)
+    cu_primitives: string list;         (* Primitives declared inside *)
+    mutable cu_force_link: bool;        (* Must be linked even if unref'ed *)
+    mutable cu_debug: int;              (* Position of debugging info, or 0 *)
+    cu_debugsize: int }                 (* Length of debugging info *)
+
+(* Format of a .cmo file:
+     magic number (Config.cmo_magic_number)
+     absolute offset of compilation unit descriptor
+     block of relocatable bytecode
+     debugging information if any
+     compilation unit descriptor *)
+
+(* Descriptor for libraries *)
+
+type library =
+  { lib_units: compilation_unit list;   (* List of compilation units *)
+    lib_custom: bool;                   (* Requires custom mode linking? *)
+    (* In the following fields the lists are reversed with respect to
+       how they end up being used on the command line. *)
+    lib_ccobjs: string list;            (* C object files needed for -custom *)
+    lib_ccopts: string list;            (* Extra opts to C compiler *)
+    lib_dllibs: string list }           (* DLLs needed *)
+
+(* Format of a .cma file:
+     magic number (Config.cma_magic_number)
+     absolute offset of library descriptor
+     object code for first library member
+     ...
+     object code for last library member
+     library descriptor *)
diff --git a/file_formats/cmt_format.ml b/file_formats/cmt_format.ml
new file mode 100644
index 00000000..709509a7
--- /dev/null
+++ b/file_formats/cmt_format.ml
@@ -0,0 +1,194 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Fabrice Le Fessant, INRIA Saclay                     *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Cmi_format
+open Typedtree
+
+(* Note that in Typerex, there is an awful hack to save a cmt file
+   together with the interface file that was generated by ocaml (this
+   is because the installed version of ocaml might differ from the one
+   integrated in Typerex).
+*)
+
+
+
+let read_magic_number ic =
+  let len_magic_number = String.length Config.cmt_magic_number in
+  really_input_string ic len_magic_number
+
+type binary_annots =
+  | Packed of Types.signature * string list
+  | Implementation of structure
+  | Interface of signature
+  | Partial_implementation of binary_part array
+  | Partial_interface of binary_part array
+
+and binary_part =
+| Partial_structure of structure
+| Partial_structure_item of structure_item
+| Partial_expression of expression
+| Partial_pattern : 'k pattern_category * 'k general_pattern -> binary_part
+| Partial_class_expr of class_expr
+| Partial_signature of signature
+| Partial_signature_item of signature_item
+| Partial_module_type of module_type
+
+type cmt_infos = {
+  cmt_modname : string;
+  cmt_annots : binary_annots;
+  cmt_value_dependencies :
+    (Types.value_description * Types.value_description) list;
+  cmt_comments : (string * Location.t) list;
+  cmt_args : string array;
+  cmt_sourcefile : string option;
+  cmt_builddir : string;
+  cmt_loadpath : string list;
+  cmt_source_digest : Digest.t option;
+  cmt_initial_env : Env.t;
+  cmt_imports : (string * Digest.t option) list;
+  cmt_interface_digest : Digest.t option;
+  cmt_use_summaries : bool;
+}
+
+type error =
+    Not_a_typedtree of string
+
+let need_to_clear_env =
+  try ignore (Sys.getenv "OCAML_BINANNOT_WITHENV"); false
+  with Not_found -> true
+
+let keep_only_summary = Env.keep_only_summary
+
+open Tast_mapper
+
+let cenv =
+  {Tast_mapper.default with env = fun _sub env -> keep_only_summary env}
+
+let clear_part = function
+  | Partial_structure s -> Partial_structure (cenv.structure cenv s)
+  | Partial_structure_item s ->
+      Partial_structure_item (cenv.structure_item cenv s)
+  | Partial_expression e -> Partial_expression (cenv.expr cenv e)
+  | Partial_pattern (category, p) -> Partial_pattern (category, cenv.pat cenv p)
+  | Partial_class_expr ce -> Partial_class_expr (cenv.class_expr cenv ce)
+  | Partial_signature s -> Partial_signature (cenv.signature cenv s)
+  | Partial_signature_item s ->
+      Partial_signature_item (cenv.signature_item cenv s)
+  | Partial_module_type s -> Partial_module_type (cenv.module_type cenv s)
+
+let clear_env binary_annots =
+  if need_to_clear_env then
+    match binary_annots with
+    | Implementation s -> Implementation (cenv.structure cenv s)
+    | Interface s -> Interface (cenv.signature cenv s)
+    | Packed _ -> binary_annots
+    | Partial_implementation array ->
+        Partial_implementation (Array.map clear_part array)
+    | Partial_interface array ->
+        Partial_interface (Array.map clear_part array)
+
+  else binary_annots
+
+exception Error of error
+
+let input_cmt ic = (input_value ic : cmt_infos)
+
+let output_cmt oc cmt =
+  output_string oc Config.cmt_magic_number;
+  output_value oc (cmt : cmt_infos)
+
+let read filename =
+(*  Printf.fprintf stderr "Cmt_format.read %s\n%!" filename; *)
+  let ic = open_in_bin filename in
+  Misc.try_finally
+    ~always:(fun () -> close_in ic)
+    (fun () ->
+       let magic_number = read_magic_number ic in
+       let cmi, cmt =
+         if magic_number = Config.cmt_magic_number then
+           None, Some (input_cmt ic)
+         else if magic_number = Config.cmi_magic_number then
+           let cmi = Cmi_format.input_cmi ic in
+           let cmt = try
+               let magic_number = read_magic_number ic in
+               if magic_number = Config.cmt_magic_number then
+                 let cmt = input_cmt ic in
+                 Some cmt
+               else None
+             with _ -> None
+           in
+           Some cmi, cmt
+         else
+           raise(Cmi_format.Error(Cmi_format.Not_an_interface filename))
+       in
+       cmi, cmt
+    )
+
+let read_cmt filename =
+  match read filename with
+      _, None -> raise (Error (Not_a_typedtree filename))
+    | _, Some cmt -> cmt
+
+let read_cmi filename =
+  match read filename with
+      None, _ ->
+        raise (Cmi_format.Error (Cmi_format.Not_an_interface filename))
+    | Some cmi, _ -> cmi
+
+let saved_types = ref []
+let value_deps = ref []
+
+let clear () =
+  saved_types := [];
+  value_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 save_cmt filename modname binary_annots sourcefile initial_env cmi =
+  if !Clflags.binary_annotations && not !Clflags.print_types then begin
+    Misc.output_to_file_via_temporary
+       ~mode:[Open_binary] filename
+       (fun temp_file_name oc ->
+         let this_crc =
+           match cmi with
+           | None -> None
+           | Some cmi -> Some (output_cmi temp_file_name oc cmi)
+         in
+         let source_digest = Option.map Digest.file sourcefile in
+         let cmt = {
+           cmt_modname = modname;
+           cmt_annots = clear_env binary_annots;
+           cmt_value_dependencies = !value_deps;
+           cmt_comments = Lexer.comments ();
+           cmt_args = Sys.argv;
+           cmt_sourcefile = sourcefile;
+           cmt_builddir = Location.rewrite_absolute_path (Sys.getcwd ());
+           cmt_loadpath = Load_path.get_paths ();
+           cmt_source_digest = source_digest;
+           cmt_initial_env = if need_to_clear_env then
+               keep_only_summary initial_env else initial_env;
+           cmt_imports = List.sort compare (Env.imports ());
+           cmt_interface_digest = this_crc;
+           cmt_use_summaries = need_to_clear_env;
+         } in
+         output_cmt oc cmt)
+  end;
+  clear ()
diff --git a/file_formats/cmt_format.mli b/file_formats/cmt_format.mli
new file mode 100644
index 00000000..8a52c4b2
--- /dev/null
+++ b/file_formats/cmt_format.mli
@@ -0,0 +1,123 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Fabrice Le Fessant, INRIA Saclay                     *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** cmt and cmti files format. *)
+
+open Misc
+
+(** The layout of a cmt file is as follows:
+       := \{\}  \{cmt infos\} \{\}
+    where  is the cmi file format:
+       :=  .
+    More precisely, the optional  part must be present if and only if
+    the file is:
+    - a cmti, or
+    - a cmt, for a ml file which has no corresponding mli (hence no
+    corresponding cmti).
+
+    Thus, we provide a common reading function for cmi and cmt(i)
+    files which returns an option for each of the three parts: cmi
+    info, cmt info, source info. *)
+
+open Typedtree
+
+type binary_annots =
+  | Packed of Types.signature * string list
+  | Implementation of structure
+  | Interface of signature
+  | Partial_implementation of binary_part array
+  | Partial_interface of binary_part array
+
+and binary_part =
+  | Partial_structure of structure
+  | Partial_structure_item of structure_item
+  | Partial_expression of expression
+  | Partial_pattern : 'k pattern_category * 'k general_pattern -> binary_part
+  | Partial_class_expr of class_expr
+  | Partial_signature of signature
+  | Partial_signature_item of signature_item
+  | Partial_module_type of module_type
+
+type cmt_infos = {
+  cmt_modname : modname;
+  cmt_annots : binary_annots;
+  cmt_value_dependencies :
+    (Types.value_description * Types.value_description) list;
+  cmt_comments : (string * Location.t) list;
+  cmt_args : string array;
+  cmt_sourcefile : string option;
+  cmt_builddir : string;
+  cmt_loadpath : string list;
+  cmt_source_digest : string option;
+  cmt_initial_env : Env.t;
+  cmt_imports : crcs;
+  cmt_interface_digest : Digest.t option;
+  cmt_use_summaries : bool;
+}
+
+type error =
+    Not_a_typedtree of string
+
+exception Error of error
+
+(** [read filename] opens filename, and extract both the cmi_infos, if
+    it exists, and the cmt_infos, if it exists. Thus, it can be used
+    with .cmi, .cmt and .cmti files.
+
+    .cmti files always contain a cmi_infos at the beginning. .cmt files
+    only contain a cmi_infos at the beginning if there is no associated
+    .cmti file.
+*)
+val read : string -> Cmi_format.cmi_infos option * cmt_infos option
+
+val read_cmt : string -> cmt_infos
+val read_cmi : string -> Cmi_format.cmi_infos
+
+(** [save_cmt filename modname binary_annots sourcefile initial_env cmi]
+    writes a cmt(i) file.  *)
+val save_cmt :
+  string ->  (* filename.cmt to generate *)
+  string ->  (* module name *)
+  binary_annots ->
+  string option ->  (* source file *)
+  Env.t -> (* initial env *)
+  Cmi_format.cmi_infos option -> (* if a .cmi was generated *)
+  unit
+
+(* Miscellaneous functions *)
+
+val read_magic_number : in_channel -> string
+
+val clear: unit -> unit
+
+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 is_magic_number : string -> bool
+  val read : in_channel -> Env.cmi_infos option * t
+  val write_magic_number : out_channel -> unit
+  val write : out_channel -> t -> unit
+
+  val find : string list -> string -> string
+  val read_signature : 'a -> string -> Types.signature * 'b list * 'c list
+
+*)
diff --git a/file_formats/cmx_format.mli b/file_formats/cmx_format.mli
new file mode 100644
index 00000000..91ad2d1f
--- /dev/null
+++ b/file_formats/cmx_format.mli
@@ -0,0 +1,58 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2010 Institut National de Recherche en Informatique et     *)
+(*     en Automatique                                                     *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Format of .cmx, .cmxa and .cmxs files *)
+
+open Misc
+
+(* Each .o file has a matching .cmx file that provides the following infos
+   on the compilation unit:
+     - list of other units imported, with MD5s of their .cmx files
+     - approximation of the structure implemented
+       (includes descriptions of known functions: arity and direct entry
+        points)
+     - list of currying functions and application functions needed
+   The .cmx file contains these infos (as an externed record) plus a MD5
+   of these infos *)
+
+type export_info =
+  | Clambda of Clambda.value_approximation
+  | Flambda of Export_info.t
+
+type unit_infos =
+  { mutable ui_name: modname;             (* Name of unit implemented *)
+    mutable ui_symbol: string;            (* Prefix for symbols *)
+    mutable ui_defines: string list;      (* Unit and sub-units implemented *)
+    mutable ui_imports_cmi: crcs;         (* Interfaces imported *)
+    mutable ui_imports_cmx: crcs;         (* Infos imported *)
+    mutable ui_curry_fun: int list;       (* Currying functions needed *)
+    mutable ui_apply_fun: int list;       (* Apply functions needed *)
+    mutable ui_send_fun: int list;        (* Send functions needed *)
+    mutable ui_export_info: export_info;
+    mutable ui_force_link: bool }         (* Always linked *)
+
+(* Each .a library has a matching .cmxa file that provides the following
+   infos on the library: *)
+
+type library_infos =
+  { lib_units: (unit_infos * Digest.t) list;  (* List of unit infos w/ MD5s *)
+    (* In the following fields the lists are reversed with respect to
+       how they end up being used on the command line. *)
+    lib_ccobjs: string list;            (* C object files needed *)
+    lib_ccopts: string list }           (* Extra opts to C compiler *)
diff --git a/file_formats/cmxs_format.mli b/file_formats/cmxs_format.mli
new file mode 100644
index 00000000..c670024f
--- /dev/null
+++ b/file_formats/cmxs_format.mli
@@ -0,0 +1,35 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2010 Institut National de Recherche en Informatique et     *)
+(*     en Automatique                                                     *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Format of .cmxs files *)
+
+open Misc
+
+(* Each .cmxs dynamically-loaded plugin contains a symbol
+   "caml_plugin_header" containing the following info
+   (as an externed record) *)
+
+type dynunit = {
+  dynu_name: modname;
+  dynu_crc: Digest.t;
+  dynu_imports_cmi: crcs;
+  dynu_imports_cmx: crcs;
+  dynu_defines: string list;
+}
+
+type dynheader = {
+  dynu_magic: string;
+  dynu_units: dynunit list;
+}
diff --git a/lambda/.ocamlformat b/lambda/.ocamlformat
new file mode 100644
index 00000000..e7acdb9b
--- /dev/null
+++ b/lambda/.ocamlformat
@@ -0,0 +1,5 @@
+profile=conventional
+if-then-else=k-r
+indicate-multiline-delimiters=closing-on-separate-line
+break-cases=all
+disable=true
diff --git a/lambda/.ocamlformat-enable b/lambda/.ocamlformat-enable
new file mode 100644
index 00000000..796b708c
--- /dev/null
+++ b/lambda/.ocamlformat-enable
@@ -0,0 +1 @@
+matching.ml
diff --git a/lambda/debuginfo.ml b/lambda/debuginfo.ml
new file mode 100644
index 00000000..c1195d72
--- /dev/null
+++ b/lambda/debuginfo.ml
@@ -0,0 +1,230 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2006 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open! Int_replace_polymorphic_compare
+open Lexing
+open Location
+
+module Scoped_location = struct
+  type scope_item =
+    | Sc_anonymous_function
+    | Sc_value_definition of string
+    | Sc_module_definition of string
+    | Sc_class_definition of string
+    | Sc_method_definition of string
+
+  type scopes = scope_item list
+
+  let add_parens_if_symbolic = function
+    | "" -> ""
+    | s ->
+       match s.[0] with
+       | 'a'..'z' | 'A'..'Z' | '_' | '0'..'9' -> s
+       | _ -> "(" ^ s ^ ")"
+
+  let string_of_scope_item = function
+    | Sc_anonymous_function ->
+       "(fun)"
+    | Sc_value_definition name
+    | Sc_module_definition name
+    | Sc_class_definition name
+    | Sc_method_definition name ->
+       add_parens_if_symbolic name
+
+  let string_of_scopes scopes =
+    let dot acc =
+      match acc with
+      | [] -> []
+      | acc -> "." :: acc in
+    let rec to_strings acc = function
+      | [] -> acc
+        (* Collapse nested anonymous function scopes *)
+      | Sc_anonymous_function :: ((Sc_anonymous_function :: _) as rest) ->
+        to_strings acc rest
+        (* Use class#meth syntax for classes *)
+      | (Sc_method_definition _ as meth) ::
+        (Sc_class_definition _ as cls) :: rest ->
+        to_strings (string_of_scope_item cls :: "#" ::
+                      string_of_scope_item meth :: dot acc) rest
+      | s :: rest ->
+        to_strings (string_of_scope_item s :: dot acc) rest in
+    match scopes with
+    | [] -> ""
+    | scopes -> String.concat "" (to_strings [] scopes)
+
+  let enter_anonymous_function ~scopes =
+    Sc_anonymous_function :: scopes
+  let enter_value_definition ~scopes id =
+    Sc_value_definition (Ident.name id) :: scopes
+  let enter_module_definition ~scopes id =
+    Sc_module_definition (Ident.name id) :: scopes
+  let enter_class_definition ~scopes id =
+    Sc_class_definition (Ident.name id) :: scopes
+  let enter_method_definition ~scopes (m : Asttypes.label) =
+    Sc_method_definition m :: scopes
+
+  type t =
+    | Loc_unknown
+    | Loc_known of
+        { loc : Location.t;
+          scopes : scopes; }
+
+  let of_location ~scopes loc =
+    if Location.is_none loc then
+      Loc_unknown
+    else
+      Loc_known { loc; scopes }
+
+  let to_location = function
+    | Loc_unknown -> Location.none
+    | Loc_known { loc; _ } -> loc
+
+  let string_of_scoped_location = function
+    | Loc_unknown -> "??"
+    | Loc_known { loc = _; scopes } -> string_of_scopes scopes
+end
+
+type item = {
+  dinfo_file: string;
+  dinfo_line: int;
+  dinfo_char_start: int;
+  dinfo_char_end: int;
+  dinfo_start_bol: int;
+  dinfo_end_bol: int;
+  dinfo_end_line: int;
+  dinfo_scopes: Scoped_location.scopes;
+}
+
+type t = item list
+
+type alloc_dbginfo_item =
+  { alloc_words : int;
+    alloc_dbg : t }
+type alloc_dbginfo = alloc_dbginfo_item list
+
+let none = []
+
+let is_none = function
+  | [] -> true
+  | _ :: _ -> false
+
+let to_string dbg =
+  match dbg with
+  | [] -> ""
+  | ds ->
+    let items =
+      List.map
+        (fun d ->
+           Printf.sprintf "%s:%d,%d-%d"
+             d.dinfo_file d.dinfo_line d.dinfo_char_start d.dinfo_char_end)
+        ds
+    in
+    "{" ^ String.concat ";" items ^ "}"
+
+let item_from_location ~scopes loc =
+  let valid_endpos =
+    String.equal loc.loc_end.pos_fname loc.loc_start.pos_fname in
+  { dinfo_file = loc.loc_start.pos_fname;
+    dinfo_line = loc.loc_start.pos_lnum;
+    dinfo_char_start = loc.loc_start.pos_cnum - loc.loc_start.pos_bol;
+    dinfo_char_end =
+      if valid_endpos
+      then loc.loc_end.pos_cnum - loc.loc_start.pos_bol
+      else loc.loc_start.pos_cnum - loc.loc_start.pos_bol;
+    dinfo_start_bol = loc.loc_start.pos_bol;
+    dinfo_end_bol =
+      if valid_endpos then loc.loc_end.pos_bol
+      else loc.loc_start.pos_bol;
+    dinfo_end_line =
+      if valid_endpos then loc.loc_end.pos_lnum
+      else loc.loc_start.pos_lnum;
+    dinfo_scopes = scopes
+  }
+
+let from_location = function
+  | Scoped_location.Loc_unknown -> []
+  | Scoped_location.Loc_known {scopes; loc} ->
+    assert (not (Location.is_none loc));
+    [item_from_location ~scopes loc]
+
+let to_location = function
+  | [] -> Location.none
+  | d :: _ ->
+    let loc_start =
+      { pos_fname = d.dinfo_file;
+        pos_lnum = d.dinfo_line;
+        pos_bol = d.dinfo_start_bol;
+        pos_cnum = d.dinfo_start_bol + d.dinfo_char_start;
+      } in
+    let loc_end =
+      { pos_fname = d.dinfo_file;
+        pos_lnum = d.dinfo_end_line;
+        pos_bol = d.dinfo_end_bol;
+        pos_cnum = d.dinfo_start_bol + d.dinfo_char_end;
+      } in
+    { loc_ghost = false; loc_start; loc_end; }
+
+let inline dbg1 dbg2 =
+  dbg1 @ dbg2
+
+(* CR-someday afrisch: FWIW, the current compare function does not seem very
+   good, since it reverses the two lists. I don't know how long the lists are,
+   nor if the specific currently implemented ordering is useful in other
+   contexts, but if one wants to use Map, a more efficient comparison should
+   be considered. *)
+let compare dbg1 dbg2 =
+  let rec loop ds1 ds2 =
+    match ds1, ds2 with
+    | [], [] -> 0
+    | _ :: _, [] -> 1
+    | [], _ :: _ -> -1
+    | d1 :: ds1, d2 :: ds2 ->
+      let c = String.compare d1.dinfo_file d2.dinfo_file in
+      if c <> 0 then c else
+      let c = compare d1.dinfo_line d2.dinfo_line in
+      if c <> 0 then c else
+      let c = compare d1.dinfo_char_end d2.dinfo_char_end in
+      if c <> 0 then c else
+      let c = compare d1.dinfo_char_start d2.dinfo_char_start in
+      if c <> 0 then c else
+      let c = compare d1.dinfo_start_bol d2.dinfo_start_bol in
+      if c <> 0 then c else
+      let c = compare d1.dinfo_end_bol d2.dinfo_end_bol in
+      if c <> 0 then c else
+      let c = compare d1.dinfo_end_line d2.dinfo_end_line in
+      if c <> 0 then c else
+      loop ds1 ds2
+  in
+  loop (List.rev dbg1) (List.rev dbg2)
+
+let hash t =
+  List.fold_left (fun hash item -> Hashtbl.hash (hash, item)) 0 t
+
+let rec print_compact ppf t =
+  let print_item item =
+    Format.fprintf ppf "%a:%i"
+      Location.print_filename item.dinfo_file
+      item.dinfo_line;
+    if item.dinfo_char_start >= 0 then begin
+      Format.fprintf ppf ",%i--%i" item.dinfo_char_start item.dinfo_char_end
+    end
+  in
+  match t with
+  | [] -> ()
+  | [item] -> print_item item
+  | item::t ->
+    print_item item;
+    Format.fprintf ppf ";";
+    print_compact ppf t
diff --git a/lambda/debuginfo.mli b/lambda/debuginfo.mli
new file mode 100644
index 00000000..4ce8d5f9
--- /dev/null
+++ b/lambda/debuginfo.mli
@@ -0,0 +1,85 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2006 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 Scoped_location : sig
+  type scope_item =
+    | Sc_anonymous_function
+    | Sc_value_definition of string
+    | Sc_module_definition of string
+    | Sc_class_definition of string
+    | Sc_method_definition of string
+
+  type scopes = scope_item list
+  val string_of_scope_item : scope_item -> string
+  val string_of_scopes : scopes -> string
+
+  val enter_anonymous_function : scopes:scopes -> scopes
+  val enter_value_definition : scopes:scopes -> Ident.t -> scopes
+  val enter_module_definition : scopes:scopes -> Ident.t -> scopes
+  val enter_class_definition : scopes:scopes -> Ident.t -> scopes
+  val enter_method_definition : scopes:scopes -> Asttypes.label -> scopes
+
+  type t =
+    | Loc_unknown
+    | Loc_known of
+        { loc : Location.t;
+          scopes : scopes; }
+
+  val of_location : scopes:scopes -> Location.t -> t
+  val to_location : t -> Location.t
+  val string_of_scoped_location : t -> string
+end
+
+type item = private {
+  dinfo_file: string;
+  dinfo_line: int;
+  dinfo_char_start: int;
+  dinfo_char_end: int;
+  dinfo_start_bol: int;
+  dinfo_end_bol: int;
+  dinfo_end_line: int;
+  dinfo_scopes: Scoped_location.scopes;
+}
+
+type t = item list
+
+type alloc_dbginfo_item =
+  { alloc_words : int;
+    alloc_dbg : t }
+(** Due to Comballoc, a single Ialloc instruction may combine several
+    unrelated allocations. Their Debuginfo.t (which may differ) are stored
+    as a list of alloc_dbginfo. This list is in order of increasing memory
+    address, which is the reverse of the original allocation order. Later
+    allocations are consed to the front of this list by Comballoc. *)
+
+type alloc_dbginfo = alloc_dbginfo_item list
+
+val none : t
+
+val is_none : t -> bool
+
+val to_string : t -> string
+
+val from_location : Scoped_location.t -> t
+
+val to_location : t -> Location.t
+
+val inline : t -> t -> t
+
+val compare : t -> t -> int
+
+val hash : t -> int
+
+val print_compact : Format.formatter -> t -> unit
diff --git a/lambda/dune b/lambda/dune
new file mode 100644
index 00000000..034cdc3b
--- /dev/null
+++ b/lambda/dune
@@ -0,0 +1,21 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+(rule
+ (targets runtimedef.ml)
+ (mode    fallback)
+ (deps    (:fail (file ../runtime/caml/fail.h))
+          (:prim (file ../runtime/primitives)))
+ (action  (with-stdout-to %{targets}
+            (run ./generate_runtimedef.sh %{fail} %{prim}))))
diff --git a/lambda/generate_runtimedef.sh b/lambda/generate_runtimedef.sh
new file mode 100755
index 00000000..d1bef18f
--- /dev/null
+++ b/lambda/generate_runtimedef.sh
@@ -0,0 +1,24 @@
+#!/bin/sh
+
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+echo 'let builtin_exceptions = [|'
+tr -d '\r' < "$1" | sed -n -e 's|.*/\* \("[A-Za-z_]*"\) \*/$|  \1;|p'
+echo '|]'
+
+echo 'let builtin_primitives = [|'
+sed -e 's/.*/  "&";/' "$2"
+echo '|]'
diff --git a/lambda/lambda.ml b/lambda/lambda.ml
new file mode 100644
index 00000000..3a776bee
--- /dev/null
+++ b/lambda/lambda.ml
@@ -0,0 +1,896 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Misc
+open Asttypes
+
+type compile_time_constant =
+  | Big_endian
+  | Word_size
+  | Int_size
+  | Max_wosize
+  | Ostype_unix
+  | Ostype_win32
+  | Ostype_cygwin
+  | Backend_type
+
+type immediate_or_pointer =
+  | Immediate
+  | Pointer
+
+type initialization_or_assignment =
+  | Assignment
+  | Heap_initialization
+  | Root_initialization
+
+type is_safe =
+  | Safe
+  | Unsafe
+
+type primitive =
+  | Pidentity
+  | Pbytes_to_string
+  | Pbytes_of_string
+  | Pignore
+  | Prevapply
+  | Pdirapply
+    (* Globals *)
+  | Pgetglobal of Ident.t
+  | Psetglobal of Ident.t
+  (* Operations on heap blocks *)
+  | Pmakeblock of int * mutable_flag * block_shape
+  | Pfield of int
+  | Pfield_computed
+  | Psetfield of int * immediate_or_pointer * initialization_or_assignment
+  | Psetfield_computed of immediate_or_pointer * initialization_or_assignment
+  | Pfloatfield of int
+  | Psetfloatfield of int * initialization_or_assignment
+  | Pduprecord of Types.record_representation * int
+  (* Force lazy values *)
+  (* External call *)
+  | Pccall of Primitive.description
+  (* Exceptions *)
+  | Praise of raise_kind
+  (* Boolean operations *)
+  | Psequand | Psequor | Pnot
+  (* Integer operations *)
+  | Pnegint | Paddint | Psubint | Pmulint
+  | Pdivint of is_safe | Pmodint of is_safe
+  | Pandint | Porint | Pxorint
+  | Plslint | Plsrint | Pasrint
+  | Pintcomp of integer_comparison
+  | Pcompare_ints | Pcompare_floats | Pcompare_bints of boxed_integer
+  | Poffsetint of int
+  | Poffsetref of int
+  (* Float operations *)
+  | Pintoffloat | Pfloatofint
+  | Pnegfloat | Pabsfloat
+  | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
+  | Pfloatcomp of float_comparison
+  (* String operations *)
+  | Pstringlength | Pstringrefu  | Pstringrefs
+  | Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
+  (* Array operations *)
+  | Pmakearray of array_kind * mutable_flag
+  | Pduparray of array_kind * mutable_flag
+  | Parraylength of array_kind
+  | Parrayrefu of array_kind
+  | Parraysetu of array_kind
+  | Parrayrefs of array_kind
+  | Parraysets of array_kind
+  (* Test if the argument is a block or an immediate integer *)
+  | Pisint
+  (* Test if the (integer) argument is outside an interval *)
+  | Pisout
+  (* Operations on boxed integers (Nativeint.t, Int32.t, Int64.t) *)
+  | Pbintofint of boxed_integer
+  | Pintofbint of boxed_integer
+  | Pcvtbint of boxed_integer (*source*) * boxed_integer (*destination*)
+  | Pnegbint of boxed_integer
+  | Paddbint of boxed_integer
+  | Psubbint of boxed_integer
+  | Pmulbint of boxed_integer
+  | Pdivbint of { size : boxed_integer; is_safe : is_safe }
+  | Pmodbint of { size : boxed_integer; is_safe : is_safe }
+  | Pandbint of boxed_integer
+  | Porbint of boxed_integer
+  | Pxorbint of boxed_integer
+  | Plslbint of boxed_integer
+  | Plsrbint of boxed_integer
+  | Pasrbint of boxed_integer
+  | Pbintcomp of boxed_integer * integer_comparison
+  (* Operations on Bigarrays: (unsafe, #dimensions, kind, layout) *)
+  | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
+  | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
+  (* size of the nth dimension of a Bigarray *)
+  | Pbigarraydim of int
+  (* load/set 16,32,64 bits from a string: (unsafe)*)
+  | Pstring_load_16 of bool
+  | Pstring_load_32 of bool
+  | Pstring_load_64 of bool
+  | Pbytes_load_16 of bool
+  | Pbytes_load_32 of bool
+  | Pbytes_load_64 of bool
+  | Pbytes_set_16 of bool
+  | Pbytes_set_32 of bool
+  | Pbytes_set_64 of bool
+  (* load/set 16,32,64 bits from a
+     (char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *)
+  | Pbigstring_load_16 of bool
+  | Pbigstring_load_32 of bool
+  | Pbigstring_load_64 of bool
+  | Pbigstring_set_16 of bool
+  | Pbigstring_set_32 of bool
+  | Pbigstring_set_64 of bool
+  (* Compile time constants *)
+  | Pctconst of compile_time_constant
+  (* byte swap *)
+  | Pbswap16
+  | Pbbswap of boxed_integer
+  (* Integer to external pointer *)
+  | Pint_as_pointer
+  (* Inhibition of optimisation *)
+  | Popaque
+
+and integer_comparison =
+    Ceq | Cne | Clt | Cgt | Cle | Cge
+
+and float_comparison =
+    CFeq | CFneq | CFlt | CFnlt | CFgt | CFngt | CFle | CFnle | CFge | CFnge
+
+and value_kind =
+    Pgenval | Pfloatval | Pboxedintval of boxed_integer | Pintval
+
+and block_shape =
+  value_kind list option
+
+and array_kind =
+    Pgenarray | Paddrarray | Pintarray | Pfloatarray
+
+and boxed_integer = Primitive.boxed_integer =
+    Pnativeint | Pint32 | Pint64
+
+and bigarray_kind =
+    Pbigarray_unknown
+  | Pbigarray_float32 | Pbigarray_float64
+  | Pbigarray_sint8 | Pbigarray_uint8
+  | Pbigarray_sint16 | Pbigarray_uint16
+  | Pbigarray_int32 | Pbigarray_int64
+  | Pbigarray_caml_int | Pbigarray_native_int
+  | Pbigarray_complex32 | Pbigarray_complex64
+
+and bigarray_layout =
+    Pbigarray_unknown_layout
+  | Pbigarray_c_layout
+  | Pbigarray_fortran_layout
+
+and raise_kind =
+  | Raise_regular
+  | Raise_reraise
+  | Raise_notrace
+
+let equal_boxed_integer x y =
+  match x, y with
+  | Pnativeint, Pnativeint
+  | Pint32, Pint32
+  | Pint64, Pint64 ->
+    true
+  | (Pnativeint | Pint32 | Pint64), _ ->
+    false
+
+let equal_primitive =
+  (* Should be implemented like [equal_value_kind] of [equal_boxed_integer],
+     i.e. by matching over the various constructors but the type has more
+     than 100 constructors... *)
+  (=)
+
+let equal_value_kind x y =
+  match x, y with
+  | Pgenval, Pgenval -> true
+  | Pfloatval, Pfloatval -> true
+  | Pboxedintval bi1, Pboxedintval bi2 -> equal_boxed_integer bi1 bi2
+  | Pintval, Pintval -> true
+  | (Pgenval | Pfloatval | Pboxedintval _ | Pintval), _ -> false
+
+
+type structured_constant =
+    Const_base of constant
+  | Const_pointer of int
+  | Const_block of int * structured_constant list
+  | Const_float_array of string list
+  | Const_immstring of string
+
+type inline_attribute =
+  | Always_inline (* [@inline] or [@inline always] *)
+  | Never_inline (* [@inline never] *)
+  | Hint_inline (* [@inlined hint] attribute *)
+  | Unroll of int (* [@unroll x] *)
+  | Default_inline (* no [@inline] attribute *)
+
+let equal_inline_attribute x y =
+  match x, y with
+  | Always_inline, Always_inline
+  | Never_inline, Never_inline
+  | Hint_inline, Hint_inline
+  | Default_inline, Default_inline
+    ->
+    true
+  | Unroll u, Unroll v ->
+    u = v
+  | (Always_inline | Never_inline
+    | Hint_inline | Unroll _ | Default_inline), _ ->
+    false
+
+type specialise_attribute =
+  | Always_specialise (* [@specialise] or [@specialise always] *)
+  | Never_specialise (* [@specialise never] *)
+  | Default_specialise (* no [@specialise] attribute *)
+
+let equal_specialise_attribute x y =
+  match x, y with
+  | Always_specialise, Always_specialise
+  | Never_specialise, Never_specialise
+  | Default_specialise, Default_specialise ->
+    true
+  | (Always_specialise | Never_specialise | Default_specialise), _ ->
+    false
+
+type local_attribute =
+  | Always_local (* [@local] or [@local always] *)
+  | Never_local (* [@local never] *)
+  | Default_local (* [@local maybe] or no [@local] attribute *)
+
+type function_kind = Curried | Tupled
+
+type let_kind = Strict | Alias | StrictOpt | Variable
+
+type meth_kind = Self | Public | Cached
+
+let equal_meth_kind x y =
+  match x, y with
+  | Self, Self -> true
+  | Public, Public -> true
+  | Cached, Cached -> true
+  | (Self | Public | Cached), _ -> false
+
+type shared_code = (int * int) list
+
+type function_attribute = {
+  inline : inline_attribute;
+  specialise : specialise_attribute;
+  local: local_attribute;
+  is_a_functor: bool;
+  stub: bool;
+}
+
+type scoped_location = Debuginfo.Scoped_location.t
+
+type lambda =
+    Lvar of Ident.t
+  | Lconst of structured_constant
+  | Lapply of lambda_apply
+  | Lfunction of lfunction
+  | Llet of let_kind * value_kind * Ident.t * lambda * lambda
+  | Lletrec of (Ident.t * lambda) list * lambda
+  | Lprim of primitive * lambda list * scoped_location
+  | Lswitch of lambda * lambda_switch * scoped_location
+  | Lstringswitch of
+      lambda * (string * lambda) list * lambda option * scoped_location
+  | Lstaticraise of int * lambda list
+  | Lstaticcatch of lambda * (int * (Ident.t * value_kind) list) * lambda
+  | Ltrywith of lambda * Ident.t * lambda
+  | Lifthenelse of lambda * lambda * lambda
+  | Lsequence of lambda * lambda
+  | Lwhile of lambda * lambda
+  | Lfor of Ident.t * lambda * lambda * direction_flag * lambda
+  | Lassign of Ident.t * lambda
+  | Lsend of meth_kind * lambda * lambda * lambda list * scoped_location
+  | Levent of lambda * lambda_event
+  | Lifused of Ident.t * lambda
+
+and lfunction =
+  { kind: function_kind;
+    params: (Ident.t * value_kind) list;
+    return: value_kind;
+    body: lambda;
+    attr: function_attribute; (* specified with [@inline] attribute *)
+    loc: scoped_location; }
+
+and lambda_apply =
+  { ap_func : lambda;
+    ap_args : lambda list;
+    ap_loc : scoped_location;
+    ap_should_be_tailcall : bool;
+    ap_inlined : inline_attribute;
+    ap_specialised : specialise_attribute; }
+
+and lambda_switch =
+  { sw_numconsts: int;
+    sw_consts: (int * lambda) list;
+    sw_numblocks: int;
+    sw_blocks: (int * lambda) list;
+    sw_failaction : lambda option}
+
+and lambda_event =
+  { lev_loc: scoped_location;
+    lev_kind: lambda_event_kind;
+    lev_repr: int ref option;
+    lev_env: Env.t }
+
+and lambda_event_kind =
+    Lev_before
+  | Lev_after of Types.type_expr
+  | Lev_function
+  | Lev_pseudo
+  | Lev_module_definition of Ident.t
+
+type program =
+  { module_ident : Ident.t;
+    main_module_block_size : int;
+    required_globals : Ident.Set.t;
+    code : lambda }
+
+let const_unit = Const_pointer 0
+
+let lambda_unit = Lconst const_unit
+
+let default_function_attribute = {
+  inline = Default_inline;
+  specialise = Default_specialise;
+  local = Default_local;
+  is_a_functor = false;
+  stub = false;
+}
+
+let default_stub_attribute =
+  { default_function_attribute with stub = true }
+
+(* Build sharing keys *)
+(*
+   Those keys are later compared with Stdlib.compare.
+   For that reason, they should not include cycles.
+*)
+
+exception Not_simple
+
+let max_raw = 32
+
+let make_key e =
+  let count = ref 0   (* Used for controlling size *)
+  and make_key = Ident.make_key_generator () in
+  (* make_key is used for normalizing let-bound variables *)
+  let rec tr_rec env e =
+    incr count ;
+    if !count > max_raw then raise Not_simple ; (* Too big ! *)
+    match e with
+    | Lvar id ->
+      begin
+        try Ident.find_same id env
+        with Not_found -> e
+      end
+    | Lconst  (Const_base (Const_string _)) ->
+        (* Mutable constants are not shared *)
+        raise Not_simple
+    | Lconst _ -> e
+    | Lapply ap ->
+        Lapply {ap with ap_func = tr_rec env ap.ap_func;
+                        ap_args = tr_recs env ap.ap_args;
+                        ap_loc = Loc_unknown}
+    | Llet (Alias,_k,x,ex,e) -> (* Ignore aliases -> substitute *)
+        let ex = tr_rec env ex in
+        tr_rec (Ident.add x ex env) e
+    | Llet ((Strict | StrictOpt),_k,x,ex,Lvar v) when Ident.same v x ->
+        tr_rec env ex
+    | Llet (str,k,x,ex,e) ->
+     (* Because of side effects, keep other lets with normalized names *)
+        let ex = tr_rec env ex in
+        let y = make_key x in
+        Llet (str,k,y,ex,tr_rec (Ident.add x (Lvar y) env) e)
+    | Lprim (p,es,_) ->
+        Lprim (p,tr_recs env es, Loc_unknown)
+    | Lswitch (e,sw,loc) ->
+        Lswitch (tr_rec env e,tr_sw env sw,loc)
+    | Lstringswitch (e,sw,d,_) ->
+        Lstringswitch
+          (tr_rec env e,
+           List.map (fun (s,e) -> s,tr_rec env e) sw,
+           tr_opt env d,
+          Loc_unknown)
+    | Lstaticraise (i,es) ->
+        Lstaticraise (i,tr_recs env es)
+    | Lstaticcatch (e1,xs,e2) ->
+        Lstaticcatch (tr_rec env e1,xs,tr_rec env e2)
+    | Ltrywith (e1,x,e2) ->
+        Ltrywith (tr_rec env e1,x,tr_rec env e2)
+    | Lifthenelse (cond,ifso,ifnot) ->
+        Lifthenelse (tr_rec env cond,tr_rec env ifso,tr_rec env ifnot)
+    | Lsequence (e1,e2) ->
+        Lsequence (tr_rec env e1,tr_rec env e2)
+    | Lassign (x,e) ->
+        Lassign (x,tr_rec env e)
+    | Lsend (m,e1,e2,es,_loc) ->
+        Lsend (m,tr_rec env e1,tr_rec env e2,tr_recs env es,Loc_unknown)
+    | Lifused (id,e) -> Lifused (id,tr_rec env e)
+    | Lletrec _|Lfunction _
+    | Lfor _ | Lwhile _
+(* Beware: (PR#6412) the event argument to Levent
+   may include cyclic structure of type Type.typexpr *)
+    | Levent _  ->
+        raise Not_simple
+
+  and tr_recs env es = List.map (tr_rec env) es
+
+  and tr_sw env sw =
+    { sw with
+      sw_consts = List.map (fun (i,e) -> i,tr_rec env e) sw.sw_consts ;
+      sw_blocks = List.map (fun (i,e) -> i,tr_rec env e) sw.sw_blocks ;
+      sw_failaction = tr_opt env sw.sw_failaction ; }
+
+  and tr_opt env = function
+    | None -> None
+    | Some e -> Some (tr_rec env e) in
+
+  try
+    Some (tr_rec Ident.empty e)
+  with Not_simple -> None
+
+(***************)
+
+let name_lambda strict arg fn =
+  match arg with
+    Lvar id -> fn id
+  | _ ->
+      let id = Ident.create_local "let" in
+      Llet(strict, Pgenval, id, arg, fn id)
+
+let name_lambda_list args fn =
+  let rec name_list names = function
+    [] -> fn (List.rev names)
+  | (Lvar _ as arg) :: rem ->
+      name_list (arg :: names) rem
+  | arg :: rem ->
+      let id = Ident.create_local "let" in
+      Llet(Strict, Pgenval, id, arg, name_list (Lvar id :: names) rem) in
+  name_list [] args
+
+
+let iter_opt f = function
+  | None -> ()
+  | Some e -> f e
+
+let shallow_iter ~tail ~non_tail:f = function
+    Lvar _
+  | Lconst _ -> ()
+  | Lapply{ap_func = fn; ap_args = args} ->
+      f fn; List.iter f args
+  | Lfunction{body} ->
+      f body
+  | Llet(_str, _k, _id, arg, body) ->
+      f arg; tail body
+  | Lletrec(decl, body) ->
+      tail body;
+      List.iter (fun (_id, exp) -> f exp) decl
+  | Lprim (Pidentity, [l], _) ->
+      tail l
+  | Lprim (Psequand, [l1; l2], _)
+  | Lprim (Psequor, [l1; l2], _) ->
+      f l1;
+      tail l2
+  | Lprim(_p, args, _loc) ->
+      List.iter f args
+  | Lswitch(arg, sw,_) ->
+      f arg;
+      List.iter (fun (_key, case) -> tail case) sw.sw_consts;
+      List.iter (fun (_key, case) -> tail case) sw.sw_blocks;
+      iter_opt tail sw.sw_failaction
+  | Lstringswitch (arg,cases,default,_) ->
+      f arg ;
+      List.iter (fun (_,act) -> tail act) cases ;
+      iter_opt tail default
+  | Lstaticraise (_,args) ->
+      List.iter f args
+  | Lstaticcatch(e1, _, e2) ->
+      tail e1; tail e2
+  | Ltrywith(e1, _, e2) ->
+      f e1; tail e2
+  | Lifthenelse(e1, e2, e3) ->
+      f e1; tail e2; tail e3
+  | Lsequence(e1, e2) ->
+      f e1; tail e2
+  | Lwhile(e1, e2) ->
+      f e1; f e2
+  | Lfor(_v, e1, e2, _dir, e3) ->
+      f e1; f e2; f e3
+  | Lassign(_, e) ->
+      f e
+  | Lsend (_k, met, obj, args, _) ->
+      List.iter f (met::obj::args)
+  | Levent (e, _evt) ->
+      tail e
+  | Lifused (_v, e) ->
+      tail e
+
+let iter_head_constructor f l =
+  shallow_iter ~tail:f ~non_tail:f l
+
+let rec free_variables = function
+  | Lvar id -> Ident.Set.singleton id
+  | Lconst _ -> Ident.Set.empty
+  | Lapply{ap_func = fn; ap_args = args} ->
+      free_variables_list (free_variables fn) args
+  | Lfunction{body; params} ->
+      Ident.Set.diff (free_variables body)
+        (Ident.Set.of_list (List.map fst params))
+  | Llet(_str, _k, id, arg, body) ->
+      Ident.Set.union
+        (free_variables arg)
+        (Ident.Set.remove id (free_variables body))
+  | Lletrec(decl, body) ->
+      let set = free_variables_list (free_variables body) (List.map snd decl) in
+      Ident.Set.diff set (Ident.Set.of_list (List.map fst decl))
+  | Lprim(_p, args, _loc) ->
+      free_variables_list Ident.Set.empty args
+  | Lswitch(arg, sw,_) ->
+      let set =
+        free_variables_list
+          (free_variables_list (free_variables arg)
+             (List.map snd sw.sw_consts))
+          (List.map snd sw.sw_blocks)
+      in
+      begin match sw.sw_failaction with
+      | None -> set
+      | Some failaction -> Ident.Set.union set (free_variables failaction)
+      end
+  | Lstringswitch (arg,cases,default,_) ->
+      let set =
+        free_variables_list (free_variables arg)
+          (List.map snd cases)
+      in
+      begin match default with
+      | None -> set
+      | Some default -> Ident.Set.union set (free_variables default)
+      end
+  | Lstaticraise (_,args) ->
+      free_variables_list Ident.Set.empty args
+  | Lstaticcatch(body, (_, params), handler) ->
+      Ident.Set.union
+        (Ident.Set.diff
+           (free_variables handler)
+           (Ident.Set.of_list (List.map fst params)))
+        (free_variables body)
+  | Ltrywith(body, param, handler) ->
+      Ident.Set.union
+        (Ident.Set.remove
+           param
+           (free_variables handler))
+        (free_variables body)
+  | Lifthenelse(e1, e2, e3) ->
+      Ident.Set.union
+        (Ident.Set.union (free_variables e1) (free_variables e2))
+        (free_variables e3)
+  | Lsequence(e1, e2) ->
+      Ident.Set.union (free_variables e1) (free_variables e2)
+  | Lwhile(e1, e2) ->
+      Ident.Set.union (free_variables e1) (free_variables e2)
+  | Lfor(v, lo, hi, _dir, body) ->
+      let set = Ident.Set.union (free_variables lo) (free_variables hi) in
+      Ident.Set.union set (Ident.Set.remove v (free_variables body))
+  | Lassign(id, e) ->
+      Ident.Set.add id (free_variables e)
+  | Lsend (_k, met, obj, args, _) ->
+      free_variables_list
+        (Ident.Set.union (free_variables met) (free_variables obj))
+        args
+  | Levent (lam, _evt) ->
+      free_variables lam
+  | Lifused (_v, e) ->
+      (* Shouldn't v be considered a free variable ? *)
+      free_variables e
+
+and free_variables_list set exprs =
+  List.fold_left (fun set expr -> Ident.Set.union (free_variables expr) set)
+    set exprs
+
+(* Check if an action has a "when" guard *)
+let raise_count = ref 0
+
+let next_raise_count () =
+  incr raise_count ;
+  !raise_count
+
+(* Anticipated staticraise, for guards *)
+let staticfail = Lstaticraise (0,[])
+
+let rec is_guarded = function
+  | Lifthenelse(_cond, _body, Lstaticraise (0,[])) -> true
+  | Llet(_str, _k, _id, _lam, body) -> is_guarded body
+  | Levent(lam, _ev) -> is_guarded lam
+  | _ -> false
+
+let rec patch_guarded patch = function
+  | Lifthenelse (cond, body, Lstaticraise (0,[])) ->
+      Lifthenelse (cond, body, patch)
+  | Llet(str, k, id, lam, body) ->
+      Llet (str, k, id, lam, patch_guarded patch body)
+  | Levent(lam, ev) ->
+      Levent (patch_guarded patch lam, ev)
+  | _ -> fatal_error "Lambda.patch_guarded"
+
+(* Translate an access path *)
+
+let rec transl_address loc = function
+  | Env.Aident id ->
+      if Ident.global id
+      then Lprim(Pgetglobal id, [], loc)
+      else Lvar id
+  | Env.Adot(addr, pos) ->
+      Lprim(Pfield pos, [transl_address loc addr], loc)
+
+let transl_path find loc env path =
+  match find path env with
+  | exception Not_found ->
+      fatal_error ("Cannot find address for: " ^ (Path.name path))
+  | addr -> transl_address loc addr
+
+(* Translation of identifiers *)
+
+let transl_module_path loc env path =
+  transl_path Env.find_module_address loc env path
+
+let transl_value_path loc env path =
+  transl_path Env.find_value_address loc env path
+
+let transl_extension_path loc env path =
+  transl_path Env.find_constructor_address loc env path
+
+let transl_class_path loc env path =
+  transl_path Env.find_class_address loc env path
+
+let transl_prim mod_name name =
+  let pers = Ident.create_persistent mod_name in
+  let env = Env.add_persistent_structure pers Env.empty in
+  let lid = Longident.Ldot (Longident.Lident mod_name, name) in
+  match Env.find_value_by_name lid env with
+  | path, _ -> transl_value_path Loc_unknown env path
+  | exception Not_found ->
+      fatal_error ("Primitive " ^ name ^ " not found.")
+
+(* Compile a sequence of expressions *)
+
+let rec make_sequence fn = function
+    [] -> lambda_unit
+  | [x] -> fn x
+  | x::rem ->
+      let lam = fn x in Lsequence(lam, make_sequence fn rem)
+
+(* Apply a substitution to a lambda-term.
+   Assumes that the image of the substitution is out of reach
+   of the bound variables of the lambda-term (no capture). *)
+
+let subst update_env s lam =
+  let rec subst s lam =
+    let remove_list l s =
+      List.fold_left (fun s (id, _kind) -> Ident.Map.remove id s) s l
+    in
+    match lam with
+    | Lvar id as l ->
+        begin try Ident.Map.find id s with Not_found -> l end
+    | Lconst _ as l -> l
+    | Lapply ap ->
+        Lapply{ap with ap_func = subst s ap.ap_func;
+                      ap_args = subst_list s ap.ap_args}
+    | Lfunction lf ->
+        let s =
+          List.fold_right
+            (fun (id, _) s -> Ident.Map.remove id s)
+            lf.params s
+        in
+        Lfunction {lf with body = subst s lf.body}
+    | Llet(str, k, id, arg, body) ->
+        Llet(str, k, id, subst s arg, subst (Ident.Map.remove id s) body)
+    | Lletrec(decl, body) ->
+        let s =
+          List.fold_left (fun s (id, _) -> Ident.Map.remove id s)
+            s decl
+        in
+        Lletrec(List.map (subst_decl s) decl, subst s body)
+    | Lprim(p, args, loc) -> Lprim(p, subst_list s args, loc)
+    | Lswitch(arg, sw, loc) ->
+        Lswitch(subst s arg,
+                {sw with sw_consts = List.map (subst_case s) sw.sw_consts;
+                        sw_blocks = List.map (subst_case s) sw.sw_blocks;
+                        sw_failaction = subst_opt s sw.sw_failaction; },
+                loc)
+    | Lstringswitch (arg,cases,default,loc) ->
+        Lstringswitch
+          (subst s arg,List.map (subst_strcase s) cases,subst_opt s default,loc)
+    | Lstaticraise (i,args) ->  Lstaticraise (i, subst_list s args)
+    | Lstaticcatch(body, (id, params), handler) ->
+        Lstaticcatch(subst s body, (id, params),
+                    subst (remove_list params s) handler)
+    | Ltrywith(body, exn, handler) ->
+        Ltrywith(subst s body, exn, subst (Ident.Map.remove exn s) handler)
+    | Lifthenelse(e1, e2, e3) -> Lifthenelse(subst s e1, subst s e2, subst s e3)
+    | Lsequence(e1, e2) -> Lsequence(subst s e1, subst s e2)
+    | Lwhile(e1, e2) -> Lwhile(subst s e1, subst s e2)
+    | Lfor(v, lo, hi, dir, body) ->
+        Lfor(v, subst s lo, subst s hi, dir,
+          subst (Ident.Map.remove v s) body)
+    | Lassign(id, e) ->
+        assert(not (Ident.Map.mem id s));
+        Lassign(id, subst s e)
+    | Lsend (k, met, obj, args, loc) ->
+        Lsend (k, subst s met, subst s obj, subst_list s args, loc)
+    | Levent (lam, evt) ->
+        let lev_env =
+          Ident.Map.fold (fun id _ env ->
+            match Env.find_value (Path.Pident id) evt.lev_env with
+            | exception Not_found -> env
+            | vd -> update_env id vd env
+          ) s evt.lev_env
+        in
+        Levent (subst s lam, { evt with lev_env })
+    | Lifused (v, e) -> Lifused (v, subst s e)
+  and subst_list s l = List.map (subst s) l
+  and subst_decl s (id, exp) = (id, subst s exp)
+  and subst_case s (key, case) = (key, subst s case)
+  and subst_strcase s (key, case) = (key, subst s case)
+  and subst_opt s = function
+    | None -> None
+    | Some e -> Some (subst s e)
+  in
+  subst s lam
+
+let rename idmap lam =
+  let update_env oldid vd env =
+    let newid = Ident.Map.find oldid idmap in
+    Env.add_value newid vd env
+  in
+  let s = Ident.Map.map (fun new_id -> Lvar new_id) idmap in
+  subst update_env s lam
+
+let shallow_map f = function
+  | Lvar _
+  | Lconst _ as lam -> lam
+  | Lapply { ap_func; ap_args; ap_loc; ap_should_be_tailcall;
+             ap_inlined; ap_specialised } ->
+      Lapply {
+        ap_func = f ap_func;
+        ap_args = List.map f ap_args;
+        ap_loc;
+        ap_should_be_tailcall;
+        ap_inlined;
+        ap_specialised;
+      }
+  | Lfunction { kind; params; return; body; attr; loc; } ->
+      Lfunction { kind; params; return; body = f body; attr; loc; }
+  | Llet (str, k, v, e1, e2) ->
+      Llet (str, k, v, f e1, f e2)
+  | Lletrec (idel, e2) ->
+      Lletrec (List.map (fun (v, e) -> (v, f e)) idel, f e2)
+  | Lprim (p, el, loc) ->
+      Lprim (p, List.map f el, loc)
+  | Lswitch (e, sw, loc) ->
+      Lswitch (f e,
+               { sw_numconsts = sw.sw_numconsts;
+                 sw_consts = List.map (fun (n, e) -> (n, f e)) sw.sw_consts;
+                 sw_numblocks = sw.sw_numblocks;
+                 sw_blocks = List.map (fun (n, e) -> (n, f e)) sw.sw_blocks;
+                 sw_failaction = Option.map f sw.sw_failaction;
+               },
+               loc)
+  | Lstringswitch (e, sw, default, loc) ->
+      Lstringswitch (
+        f e,
+        List.map (fun (s, e) -> (s, f e)) sw,
+        Option.map f default,
+        loc)
+  | Lstaticraise (i, args) ->
+      Lstaticraise (i, List.map f args)
+  | Lstaticcatch (body, id, handler) ->
+      Lstaticcatch (f body, id, f handler)
+  | Ltrywith (e1, v, e2) ->
+      Ltrywith (f e1, v, f e2)
+  | Lifthenelse (e1, e2, e3) ->
+      Lifthenelse (f e1, f e2, f e3)
+  | Lsequence (e1, e2) ->
+      Lsequence (f e1, f e2)
+  | Lwhile (e1, e2) ->
+      Lwhile (f e1, f e2)
+  | Lfor (v, e1, e2, dir, e3) ->
+      Lfor (v, f e1, f e2, dir, f e3)
+  | Lassign (v, e) ->
+      Lassign (v, f e)
+  | Lsend (k, m, o, el, loc) ->
+      Lsend (k, f m, f o, List.map f el, loc)
+  | Levent (l, ev) ->
+      Levent (f l, ev)
+  | Lifused (v, e) ->
+      Lifused (v, f e)
+
+let map f =
+  let rec g lam = f (shallow_map g lam) in
+  g
+
+(* To let-bind expressions to variables *)
+
+let bind_with_value_kind str (var, kind) exp body =
+  match exp with
+    Lvar var' when Ident.same var var' -> body
+  | _ -> Llet(str, kind, var, exp, body)
+
+let bind str var exp body =
+  bind_with_value_kind str (var, Pgenval) exp body
+
+let negate_integer_comparison = function
+  | Ceq -> Cne
+  | Cne -> Ceq
+  | Clt -> Cge
+  | Cle -> Cgt
+  | Cgt -> Cle
+  | Cge -> Clt
+
+let swap_integer_comparison = function
+  | Ceq -> Ceq
+  | Cne -> Cne
+  | Clt -> Cgt
+  | Cle -> Cge
+  | Cgt -> Clt
+  | Cge -> Cle
+
+let negate_float_comparison = function
+  | CFeq -> CFneq
+  | CFneq -> CFeq
+  | CFlt -> CFnlt
+  | CFnlt -> CFlt
+  | CFgt -> CFngt
+  | CFngt -> CFgt
+  | CFle -> CFnle
+  | CFnle -> CFle
+  | CFge -> CFnge
+  | CFnge -> CFge
+
+let swap_float_comparison = function
+  | CFeq -> CFeq
+  | CFneq -> CFneq
+  | CFlt -> CFgt
+  | CFnlt -> CFngt
+  | CFle -> CFge
+  | CFnle -> CFnge
+  | CFgt -> CFlt
+  | CFngt -> CFnlt
+  | CFge -> CFle
+  | CFnge -> CFnle
+
+let raise_kind = function
+  | Raise_regular -> "raise"
+  | Raise_reraise -> "reraise"
+  | Raise_notrace -> "raise_notrace"
+
+let merge_inline_attributes attr1 attr2 =
+  match attr1, attr2 with
+  | Default_inline, _ -> Some attr2
+  | _, Default_inline -> Some attr1
+  | _, _ ->
+    if attr1 = attr2 then Some attr1
+    else None
+
+let function_is_curried func =
+  match func.kind with
+  | Curried -> true
+  | Tupled -> false
+
+let reset () =
+  raise_count := 0
diff --git a/lambda/lambda.mli b/lambda/lambda.mli
new file mode 100644
index 00000000..d1816981
--- /dev/null
+++ b/lambda/lambda.mli
@@ -0,0 +1,435 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The "lambda" intermediate code *)
+
+open Asttypes
+
+type compile_time_constant =
+  | Big_endian
+  | Word_size
+  | Int_size
+  | Max_wosize
+  | Ostype_unix
+  | Ostype_win32
+  | Ostype_cygwin
+  | Backend_type
+
+type immediate_or_pointer =
+  | Immediate
+  | Pointer
+
+type initialization_or_assignment =
+  | Assignment
+  (* Initialization of in heap values, like [caml_initialize] C primitive.  The
+     field should not have been read before and initialization should happen
+     only once. *)
+  | Heap_initialization
+  (* Initialization of roots only. Compiles to a simple store.
+     No checks are done to preserve GC invariants.  *)
+  | Root_initialization
+
+type is_safe =
+  | Safe
+  | Unsafe
+
+type primitive =
+  | Pidentity
+  | Pbytes_to_string
+  | Pbytes_of_string
+  | Pignore
+  | Prevapply
+  | Pdirapply
+    (* Globals *)
+  | Pgetglobal of Ident.t
+  | Psetglobal of Ident.t
+  (* Operations on heap blocks *)
+  | Pmakeblock of int * mutable_flag * block_shape
+  | Pfield of int
+  | Pfield_computed
+  | Psetfield of int * immediate_or_pointer * initialization_or_assignment
+  | Psetfield_computed of immediate_or_pointer * initialization_or_assignment
+  | Pfloatfield of int
+  | Psetfloatfield of int * initialization_or_assignment
+  | Pduprecord of Types.record_representation * int
+  (* External call *)
+  | Pccall of Primitive.description
+  (* Exceptions *)
+  | Praise of raise_kind
+  (* Boolean operations *)
+  | Psequand | Psequor | Pnot
+  (* Integer operations *)
+  | Pnegint | Paddint | Psubint | Pmulint
+  | Pdivint of is_safe | Pmodint of is_safe
+  | Pandint | Porint | Pxorint
+  | Plslint | Plsrint | Pasrint
+  | Pintcomp of integer_comparison
+  (* Comparions that return int (not bool like above) for ordering *)
+  | Pcompare_ints | Pcompare_floats | Pcompare_bints of boxed_integer
+  | Poffsetint of int
+  | Poffsetref of int
+  (* Float operations *)
+  | Pintoffloat | Pfloatofint
+  | Pnegfloat | Pabsfloat
+  | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
+  | Pfloatcomp of float_comparison
+  (* String operations *)
+  | Pstringlength | Pstringrefu  | Pstringrefs
+  | Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
+  (* Array operations *)
+  | Pmakearray of array_kind * mutable_flag
+  | Pduparray of array_kind * mutable_flag
+  (** For [Pduparray], the argument must be an immutable array.
+      The arguments of [Pduparray] give the kind and mutability of the
+      array being *produced* by the duplication. *)
+  | Parraylength of array_kind
+  | Parrayrefu of array_kind
+  | Parraysetu of array_kind
+  | Parrayrefs of array_kind
+  | Parraysets of array_kind
+  (* Test if the argument is a block or an immediate integer *)
+  | Pisint
+  (* Test if the (integer) argument is outside an interval *)
+  | Pisout
+  (* Operations on boxed integers (Nativeint.t, Int32.t, Int64.t) *)
+  | Pbintofint of boxed_integer
+  | Pintofbint of boxed_integer
+  | Pcvtbint of boxed_integer (*source*) * boxed_integer (*destination*)
+  | Pnegbint of boxed_integer
+  | Paddbint of boxed_integer
+  | Psubbint of boxed_integer
+  | Pmulbint of boxed_integer
+  | Pdivbint of { size : boxed_integer; is_safe : is_safe }
+  | Pmodbint of { size : boxed_integer; is_safe : is_safe }
+  | Pandbint of boxed_integer
+  | Porbint of boxed_integer
+  | Pxorbint of boxed_integer
+  | Plslbint of boxed_integer
+  | Plsrbint of boxed_integer
+  | Pasrbint of boxed_integer
+  | Pbintcomp of boxed_integer * integer_comparison
+  (* Operations on Bigarrays: (unsafe, #dimensions, kind, layout) *)
+  | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
+  | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
+  (* size of the nth dimension of a Bigarray *)
+  | Pbigarraydim of int
+  (* load/set 16,32,64 bits from a string: (unsafe)*)
+  | Pstring_load_16 of bool
+  | Pstring_load_32 of bool
+  | Pstring_load_64 of bool
+  | Pbytes_load_16 of bool
+  | Pbytes_load_32 of bool
+  | Pbytes_load_64 of bool
+  | Pbytes_set_16 of bool
+  | Pbytes_set_32 of bool
+  | Pbytes_set_64 of bool
+  (* load/set 16,32,64 bits from a
+     (char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *)
+  | Pbigstring_load_16 of bool
+  | Pbigstring_load_32 of bool
+  | Pbigstring_load_64 of bool
+  | Pbigstring_set_16 of bool
+  | Pbigstring_set_32 of bool
+  | Pbigstring_set_64 of bool
+  (* Compile time constants *)
+  | Pctconst of compile_time_constant
+  (* byte swap *)
+  | Pbswap16
+  | Pbbswap of boxed_integer
+  (* Integer to external pointer *)
+  | Pint_as_pointer
+  (* Inhibition of optimisation *)
+  | Popaque
+
+and integer_comparison =
+    Ceq | Cne | Clt | Cgt | Cle | Cge
+
+and float_comparison =
+    CFeq | CFneq | CFlt | CFnlt | CFgt | CFngt | CFle | CFnle | CFge | CFnge
+
+and array_kind =
+    Pgenarray | Paddrarray | Pintarray | Pfloatarray
+
+and value_kind =
+    Pgenval | Pfloatval | Pboxedintval of boxed_integer | Pintval
+
+and block_shape =
+  value_kind list option
+
+and boxed_integer = Primitive.boxed_integer =
+    Pnativeint | Pint32 | Pint64
+
+and bigarray_kind =
+    Pbigarray_unknown
+  | Pbigarray_float32 | Pbigarray_float64
+  | Pbigarray_sint8 | Pbigarray_uint8
+  | Pbigarray_sint16 | Pbigarray_uint16
+  | Pbigarray_int32 | Pbigarray_int64
+  | Pbigarray_caml_int | Pbigarray_native_int
+  | Pbigarray_complex32 | Pbigarray_complex64
+
+and bigarray_layout =
+    Pbigarray_unknown_layout
+  | Pbigarray_c_layout
+  | Pbigarray_fortran_layout
+
+and raise_kind =
+  | Raise_regular
+  | Raise_reraise
+  | Raise_notrace
+
+val equal_primitive : primitive -> primitive -> bool
+
+val equal_value_kind : value_kind -> value_kind -> bool
+
+val equal_boxed_integer : boxed_integer -> boxed_integer -> bool
+
+type structured_constant =
+    Const_base of constant
+  | Const_pointer of int
+  | Const_block of int * structured_constant list
+  | Const_float_array of string list
+  | Const_immstring of string
+
+type inline_attribute =
+  | Always_inline (* [@inline] or [@inline always] *)
+  | Never_inline (* [@inline never] *)
+  | Hint_inline (* [@inline hint] *)
+  | Unroll of int (* [@unroll x] *)
+  | Default_inline (* no [@inline] attribute *)
+
+val equal_inline_attribute : inline_attribute -> inline_attribute -> bool
+
+type specialise_attribute =
+  | Always_specialise (* [@specialise] or [@specialise always] *)
+  | Never_specialise (* [@specialise never] *)
+  | Default_specialise (* no [@specialise] attribute *)
+
+val equal_specialise_attribute
+   : specialise_attribute
+  -> specialise_attribute
+  -> bool
+
+type local_attribute =
+  | Always_local (* [@local] or [@local always] *)
+  | Never_local (* [@local never] *)
+  | Default_local (* [@local maybe] or no [@local] attribute *)
+
+type function_kind = Curried | Tupled
+
+type let_kind = Strict | Alias | StrictOpt | Variable
+(* Meaning of kinds for let x = e in e':
+    Strict: e may have side-effects; always evaluate e first
+      (If e is a simple expression, e.g. a variable or constant,
+       we may still substitute e'[x/e].)
+    Alias: e is pure, we can substitute e'[x/e] if x has 0 or 1 occurrences
+      in e'
+    StrictOpt: e does not have side-effects, but depend on the store;
+      we can discard e if x does not appear in e'
+    Variable: the variable x is assigned later in e'
+ *)
+
+type meth_kind = Self | Public | Cached
+
+val equal_meth_kind : meth_kind -> meth_kind -> bool
+
+type shared_code = (int * int) list     (* stack size -> code label *)
+
+type function_attribute = {
+  inline : inline_attribute;
+  specialise : specialise_attribute;
+  local: local_attribute;
+  is_a_functor: bool;
+  stub: bool;
+}
+
+type scoped_location = Debuginfo.Scoped_location.t
+
+type lambda =
+    Lvar of Ident.t
+  | Lconst of structured_constant
+  | Lapply of lambda_apply
+  | Lfunction of lfunction
+  | Llet of let_kind * value_kind * Ident.t * lambda * lambda
+  | Lletrec of (Ident.t * lambda) list * lambda
+  | Lprim of primitive * lambda list * scoped_location
+  | Lswitch of lambda * lambda_switch * scoped_location
+(* switch on strings, clauses are sorted by string order,
+   strings are pairwise distinct *)
+  | Lstringswitch of
+      lambda * (string * lambda) list * lambda option * scoped_location
+  | Lstaticraise of int * lambda list
+  | Lstaticcatch of lambda * (int * (Ident.t * value_kind) list) * lambda
+  | Ltrywith of lambda * Ident.t * lambda
+(* Lifthenelse (e, t, f) evaluates t if e evaluates to 0, and
+   evaluates f if e evaluates to any other value *)
+  | Lifthenelse of lambda * lambda * lambda
+  | Lsequence of lambda * lambda
+  | Lwhile of lambda * lambda
+  | Lfor of Ident.t * lambda * lambda * direction_flag * lambda
+  | Lassign of Ident.t * lambda
+  | Lsend of meth_kind * lambda * lambda * lambda list * scoped_location
+  | Levent of lambda * lambda_event
+  | Lifused of Ident.t * lambda
+
+and lfunction =
+  { kind: function_kind;
+    params: (Ident.t * value_kind) list;
+    return: value_kind;
+    body: lambda;
+    attr: function_attribute; (* specified with [@inline] attribute *)
+    loc : scoped_location; }
+
+and lambda_apply =
+  { ap_func : lambda;
+    ap_args : lambda list;
+    ap_loc : scoped_location;
+    ap_should_be_tailcall : bool;       (* true if [@tailcall] was specified *)
+    ap_inlined : inline_attribute; (* specified with the [@inlined] attribute *)
+    ap_specialised : specialise_attribute; }
+
+and lambda_switch =
+  { sw_numconsts: int;                  (* Number of integer cases *)
+    sw_consts: (int * lambda) list;     (* Integer cases *)
+    sw_numblocks: int;                  (* Number of tag block cases *)
+    sw_blocks: (int * lambda) list;     (* Tag block cases *)
+    sw_failaction : lambda option}      (* Action to take if failure *)
+and lambda_event =
+  { lev_loc: scoped_location;
+    lev_kind: lambda_event_kind;
+    lev_repr: int ref option;
+    lev_env: Env.t }
+
+and lambda_event_kind =
+    Lev_before
+  | Lev_after of Types.type_expr
+  | Lev_function
+  | Lev_pseudo
+  | Lev_module_definition of Ident.t
+
+type program =
+  { module_ident : Ident.t;
+    main_module_block_size : int;
+    required_globals : Ident.Set.t;    (* Modules whose initializer side effects
+                                          must occur before [code]. *)
+    code : lambda }
+(* Lambda code for the middle-end.
+   * In the closure case the code is a sequence of assignments to a
+     preallocated block of size [main_module_block_size] using
+     (Setfield(Getglobal(module_ident))). The size is used to preallocate
+     the block.
+   * In the flambda case the code is an expression returning a block
+     value of size [main_module_block_size]. The size is used to build
+     the module root as an initialize_symbol
+     Initialize_symbol(module_name, 0,
+       [getfield 0; ...; getfield (main_module_block_size - 1)])
+*)
+
+(* Sharing key *)
+val make_key: lambda -> lambda option
+
+val const_unit: structured_constant
+val lambda_unit: lambda
+val name_lambda: let_kind -> lambda -> (Ident.t -> lambda) -> lambda
+val name_lambda_list: lambda list -> (lambda list -> lambda) -> lambda
+
+val iter_head_constructor: (lambda -> unit) -> lambda -> unit
+(** [iter_head_constructor f lam] apply [f] to only the first level of
+    sub expressions of [lam]. It does not recursively traverse the
+    expression.
+*)
+
+val shallow_iter:
+  tail:(lambda -> unit) ->
+  non_tail:(lambda -> unit) ->
+  lambda -> unit
+(** Same as [iter_head_constructor], but use a different callback for
+    sub-terms which are in tail position or not. *)
+
+val transl_prim: string -> string -> lambda
+(** Translate a value from a persistent module. For instance:
+
+    {[
+      transl_internal_value "CamlinternalLazy" "force"
+    ]}
+*)
+
+val free_variables: lambda -> Ident.Set.t
+
+val transl_module_path: scoped_location -> Env.t -> Path.t -> lambda
+val transl_value_path: scoped_location -> Env.t -> Path.t -> lambda
+val transl_extension_path: scoped_location -> Env.t -> Path.t -> lambda
+val transl_class_path: scoped_location -> Env.t -> Path.t -> lambda
+
+val make_sequence: ('a -> lambda) -> 'a list -> lambda
+
+val subst: (Ident.t -> Types.value_description -> Env.t -> Env.t) ->
+  lambda Ident.Map.t -> lambda -> lambda
+(** [subst env_update_fun s lt] applies a substitution [s] to the lambda-term
+    [lt].
+
+    Assumes that the image of the substitution is out of reach
+    of the bound variables of the lambda-term (no capture).
+
+    [env_update_fun] is used to refresh the environment contained in debug
+    events.  *)
+
+val rename : Ident.t Ident.Map.t -> lambda -> lambda
+(** A version of [subst] specialized for the case where we're just renaming
+    idents. *)
+
+val map : (lambda -> lambda) -> lambda -> lambda
+  (** Bottom-up rewriting, applying the function on
+      each node from the leaves to the root. *)
+
+val shallow_map  : (lambda -> lambda) -> lambda -> lambda
+  (** Rewrite each immediate sub-term with the function. *)
+
+val bind : let_kind -> Ident.t -> lambda -> lambda -> lambda
+val bind_with_value_kind:
+  let_kind -> (Ident.t * value_kind) -> lambda -> lambda -> lambda
+
+val negate_integer_comparison : integer_comparison -> integer_comparison
+val swap_integer_comparison : integer_comparison -> integer_comparison
+
+val negate_float_comparison : float_comparison -> float_comparison
+val swap_float_comparison : float_comparison -> float_comparison
+
+val default_function_attribute : function_attribute
+val default_stub_attribute : function_attribute
+
+val function_is_curried : lfunction -> bool
+
+(***********************)
+(* For static failures *)
+(***********************)
+
+(* Get a new static failure ident *)
+val next_raise_count : unit -> int
+
+val staticfail : lambda (* Anticipated static failure *)
+
+(* Check anticipated failure, substitute its final value *)
+val is_guarded: lambda -> bool
+val patch_guarded : lambda -> lambda -> lambda
+
+val raise_kind: raise_kind -> string
+
+val merge_inline_attributes
+   : inline_attribute
+  -> inline_attribute
+  -> inline_attribute option
+
+val reset: unit -> unit
diff --git a/lambda/matching.ml b/lambda/matching.ml
new file mode 100644
index 00000000..95f296f6
--- /dev/null
+++ b/lambda/matching.ml
@@ -0,0 +1,3793 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Compilation of pattern matching
+
+   Based upon Lefessant-Maranget ``Optimizing Pattern-Matching'' ICFP'2001.
+
+   A previous version was based on Peyton-Jones, ``The Implementation of
+   functional programming languages'', chapter 5.
+
+
+   Overview of the implementation
+   ==============================
+
+       1. Precompilation
+       -----------------
+
+     (split_and_precompile)
+   We first split the initial pattern matching (or "pm") along its first column
+   -- simplifying pattern heads in the process --, so that we obtain an ordered
+   list of pms.
+   For every pm in this list, and any two patterns in its first column, either
+   the patterns have the same head, or their heads match disjoint sets of
+   values. (In particular, two extension constructors that may or may not be
+   equal due to hidden rebinding cannot occur in the same simple pm.)
+
+       2. Compilation
+       --------------
+
+   The compilation of one of these pms obtained after precompiling is done as
+   follows:
+
+     (divide)
+   We split the match along the first column again, this time grouping rows
+   which start with the same head, and removing the first column.
+   As a result we get a "division", which is a list a "cells" of the form:
+         discriminating pattern head * specialized pm
+
+     (compile_list + compile_match)
+   We then map over the division to compile each cell: we simply restart the
+   whole process on the second element of each cell.
+   Each cell is now of the form:
+         discriminating pattern head * lambda
+
+     (combine_constant, combine_construct, combine_array, ...)
+   We recombine the cells using a switch or some ifs, and if the matching can
+   fail, introduce a jump to the next pm that could potentially match the
+   scrutiny.
+
+       3. Chaining of pms
+       ------------------
+
+     (comp_match_handlers)
+   Once the pms have been compiled, we stitch them back together in the order
+   produced by precompilation, resulting in the following structure:
+   {v
+       catch
+         catch
+           
+         with  ->
+           
+       with  ->
+         
+   v}
+
+   Additionally, bodies whose corresponding exit-number is never used are
+   discarded. So for instance, if in the pseudo-example above we know that exit
+   [i] is never taken, we would actually generate:
+   {v
+       catch
+         
+       with  ->
+         
+   v}
+
+*)
+
+open Misc
+open Asttypes
+open Types
+open Typedtree
+open Lambda
+open Parmatch
+open Printf
+open Printpat
+open Debuginfo.Scoped_location
+
+let dbg = false
+
+(*
+   Compatibility predicate that considers potential rebindings of constructors
+   of an extension type.
+
+   "may_compat p q" returns false when p and q never admit a common instance;
+   returns true when they may have a common instance.
+*)
+
+module MayCompat = Parmatch.Compat (struct
+  let equal = Types.may_equal_constr
+end)
+
+let may_compat = MayCompat.compat
+
+and may_compats = MayCompat.compats
+
+(*
+   Many functions on the various data structures of the algorithm :
+     - Pattern matrices.
+     - Default environments: mapping from matrices to exit numbers.
+     - Contexts:  matrices whose column are partitioned into
+       left and right.
+     - Jump summaries: mapping from exit numbers to contexts
+*)
+
+let string_of_lam lam =
+  Printlambda.lambda Format.str_formatter lam;
+  Format.flush_str_formatter ()
+
+let all_record_args lbls =
+  match lbls with
+  | (_, { lbl_all }, _) :: _ ->
+      let t =
+        Array.map
+          (fun lbl -> (mknoloc (Longident.Lident "?temp?"), lbl, omega))
+          lbl_all
+      in
+      List.iter (fun ((_, lbl, _) as x) -> t.(lbl.lbl_pos) <- x) lbls;
+      Array.to_list t
+  | _ -> fatal_error "Matching.all_record_args"
+
+type 'a clause = 'a * lambda
+
+module Non_empty_clause = struct
+  type 'a t = ('a * Typedtree.pattern list) clause
+
+  let of_initial = function
+    | [], _ -> assert false
+    | pat :: patl, act -> ((pat, patl), act)
+
+  let map_head f ((p, patl), act) = ((f p, patl), act)
+end
+
+type simple_view =
+  [ `Any
+  | `Constant of constant
+  | `Tuple of pattern list
+  | `Construct of Longident.t loc * constructor_description * pattern list
+  | `Variant of label * pattern option * row_desc ref
+  | `Record of
+    (Longident.t loc * label_description * pattern) list * closed_flag
+  | `Array of pattern list
+  | `Lazy of pattern ]
+
+type half_simple_view =
+  [ simple_view | `Or of pattern * pattern * row_desc option ]
+
+type general_view =
+  [ half_simple_view
+  | `Var of Ident.t * string loc
+  | `Alias of pattern * Ident.t * string loc ]
+
+module General : sig
+  type pattern = general_view pattern_data
+
+  type clause = pattern Non_empty_clause.t
+
+  val view : Typedtree.pattern -> pattern
+
+  val erase : [< general_view ] pattern_data -> Typedtree.pattern
+end = struct
+  type pattern = general_view pattern_data
+
+  type clause = pattern Non_empty_clause.t
+
+  let view_desc = function
+    | Tpat_any -> `Any
+    | Tpat_var (id, str) -> `Var (id, str)
+    | Tpat_alias (p, id, str) -> `Alias (p, id, str)
+    | Tpat_constant cst -> `Constant cst
+    | Tpat_tuple ps -> `Tuple ps
+    | Tpat_construct (cstr, cstr_descr, args) ->
+        `Construct (cstr, cstr_descr, args)
+    | Tpat_variant (cstr, arg, row_desc) -> `Variant (cstr, arg, row_desc)
+    | Tpat_record (fields, closed) -> `Record (fields, closed)
+    | Tpat_array ps -> `Array ps
+    | Tpat_or (p, q, row_desc) -> `Or (p, q, row_desc)
+    | Tpat_lazy p -> `Lazy p
+
+  let view p : pattern = { p with pat_desc = view_desc p.pat_desc }
+
+  let erase_desc = function
+    | `Any -> Tpat_any
+    | `Var (id, str) -> Tpat_var (id, str)
+    | `Alias (p, id, str) -> Tpat_alias (p, id, str)
+    | `Constant cst -> Tpat_constant cst
+    | `Tuple ps -> Tpat_tuple ps
+    | `Construct (cstr, cst_descr, args) ->
+        Tpat_construct (cstr, cst_descr, args)
+    | `Variant (cstr, arg, row_desc) -> Tpat_variant (cstr, arg, row_desc)
+    | `Record (fields, closed) -> Tpat_record (fields, closed)
+    | `Array ps -> Tpat_array ps
+    | `Or (p, q, row_desc) -> Tpat_or (p, q, row_desc)
+    | `Lazy p -> Tpat_lazy p
+
+  let erase p = { p with pat_desc = erase_desc p.pat_desc }
+end
+
+module Half_simple : sig
+  (** Half-simplified patterns are patterns where:
+        - records are expanded so that they possess all fields
+        - aliases are removed and replaced by bindings in actions.
+
+      Or-patterns are not removed, they are only "half-simplified":
+        - aliases under or-patterns are kept
+        - or-patterns whose right-hand-side is subsumed by their lhs
+          are simplified to their lhs.
+          For instance: [(_ :: _ | 1 :: _)] is changed into [_ :: _]
+        - or-patterns whose left-hand-side is not simplified
+          are preserved: (p|q) is changed into (simpl(p)|simpl(q))
+            {v
+                # match lazy (print_int 3; 3) with _ | lazy 2 -> ();;
+                - : unit = ()
+                # match lazy (print_int 3; 3) with lazy 2 | _ -> ();;
+                3- : unit = ()
+            v}
+
+      In particular, or-patterns may still occur in the leading column,
+      so this is only a "half-simplification". *)
+
+  type pattern = half_simple_view pattern_data
+
+  type clause = pattern Non_empty_clause.t
+
+  val of_clause : arg:lambda -> General.clause -> clause
+end = struct
+  type pattern = half_simple_view pattern_data
+
+  type clause = pattern Non_empty_clause.t
+
+  let rec simpl_under_orpat p =
+    match p.pat_desc with
+    | Tpat_any
+    | Tpat_var _ ->
+        p
+    | Tpat_alias (q, id, s) ->
+        { p with pat_desc = Tpat_alias (simpl_under_orpat q, id, s) }
+    | Tpat_or (p1, p2, o) ->
+        let p1, p2 = (simpl_under_orpat p1, simpl_under_orpat p2) in
+        if le_pat p1 p2 then
+          p1
+        else
+          { p with pat_desc = Tpat_or (p1, p2, o) }
+    | Tpat_record (lbls, closed) ->
+        let all_lbls = all_record_args lbls in
+        { p with pat_desc = Tpat_record (all_lbls, closed) }
+    | _ -> p
+
+  (* Explode or-patterns and turn aliases into bindings in actions *)
+  let of_clause ~arg cl =
+    let rec aux (((p, patl), action) : General.clause) : clause =
+      let continue p (view : general_view) : clause =
+        aux (({ p with pat_desc = view }, patl), action)
+      in
+      let stop p (view : half_simple_view) : clause =
+        (({ p with pat_desc = view }, patl), action)
+      in
+      match p.pat_desc with
+      | `Any -> stop p `Any
+      | `Var (id, s) -> continue p (`Alias (omega, id, s))
+      | `Alias (p, id, _) ->
+          let k = Typeopt.value_kind p.pat_env p.pat_type in
+          aux
+            ( (General.view p, patl),
+              bind_with_value_kind Alias (id, k) arg action )
+      | `Record ([], _) as view -> stop p view
+      | `Record (lbls, closed) ->
+          let full_view = `Record (all_record_args lbls, closed) in
+          stop p full_view
+      | `Or _ -> (
+          let orpat = General.view (simpl_under_orpat (General.erase p)) in
+          match orpat.pat_desc with
+          | `Or _ as or_view -> stop orpat or_view
+          | other_view -> continue orpat other_view
+        )
+      | ( `Constant _ | `Tuple _ | `Construct _ | `Variant _ | `Array _
+        | `Lazy _ ) as view ->
+          stop p view
+    in
+    aux cl
+end
+
+exception Cannot_flatten
+
+module Simple : sig
+  type pattern = simple_view pattern_data
+
+  type clause = pattern Non_empty_clause.t
+
+  val head : pattern -> Pattern_head.t
+
+  val explode_or_pat :
+    Half_simple.pattern * Typedtree.pattern list ->
+    arg:Ident.t option ->
+    mk_action:(vars:Ident.t list -> lambda) ->
+    vars:Ident.t list ->
+    clause list ->
+    clause list
+end = struct
+  type pattern = simple_view pattern_data
+
+  type clause = pattern Non_empty_clause.t
+
+  let head p =
+    fst (Pattern_head.deconstruct (General.erase (p :> General.pattern)))
+
+  let alpha env (p : pattern) : pattern =
+    let alpha_pat env p = Typedtree.alpha_pat env p in
+    let pat_desc =
+      match p.pat_desc with
+      | `Any -> `Any
+      | `Constant cst -> `Constant cst
+      | `Tuple ps -> `Tuple (List.map (alpha_pat env) ps)
+      | `Construct (cstr, cst_descr, args) ->
+          `Construct (cstr, cst_descr, List.map (alpha_pat env) args)
+      | `Variant (cstr, argo, row_desc) ->
+          `Variant (cstr, Option.map (alpha_pat env) argo, row_desc)
+      | `Record (fields, closed) ->
+          let alpha_field env (lid, l, p) = (lid, l, alpha_pat env p) in
+          `Record (List.map (alpha_field env) fields, closed)
+      | `Array ps -> `Array (List.map (alpha_pat env) ps)
+      | `Lazy p -> `Lazy (alpha_pat env p)
+    in
+    { p with pat_desc }
+
+  let mk_alpha_env arg aliases ids =
+    List.map
+      (fun id ->
+        ( id,
+          if List.mem id aliases then
+            match arg with
+            | Some v -> v
+            | _ -> raise Cannot_flatten
+          else
+            Ident.create_local (Ident.name id) ))
+      ids
+
+  let explode_or_pat ((p : Half_simple.pattern), patl) ~arg ~mk_action ~vars
+      (rem : clause list) : clause list =
+    let rec explode p aliases rem =
+      let split_explode p aliases rem = explode (General.view p) aliases rem in
+      match p.pat_desc with
+      | `Or (p1, p2, _) ->
+          split_explode p1 aliases (split_explode p2 aliases rem)
+      | `Alias (p, id, _) -> split_explode p (id :: aliases) rem
+      | `Var (id, str) ->
+          explode
+            { p with pat_desc = `Alias (Parmatch.omega, id, str) }
+            aliases rem
+      | #simple_view as view ->
+          let env = mk_alpha_env arg aliases vars in
+          ( (alpha env { p with pat_desc = view }, patl),
+            mk_action ~vars:(List.map snd env) )
+          :: rem
+    in
+    explode (p : Half_simple.pattern :> General.pattern) [] rem
+end
+
+type initial_clause = pattern list clause
+
+type matrix = pattern list list
+
+let add_omega_column pss = List.map (fun ps -> omega :: ps) pss
+
+let rec rev_split_at n ps =
+  if n <= 0 then
+    ([], ps)
+  else
+    match ps with
+    | p :: rem ->
+        let left, right = rev_split_at (n - 1) rem in
+        (p :: left, right)
+    | _ -> assert false
+
+exception NoMatch
+
+let ncols = function
+  | [] -> 0
+  | ps :: _ -> List.length ps
+
+module Context : sig
+  type t
+
+  val empty : t
+
+  val is_empty : t -> bool
+
+  val start : int -> t
+
+  val eprintf : t -> unit
+
+  val specialize : pattern -> t -> t
+
+  val lshift : t -> t
+
+  val rshift : t -> t
+
+  val rshift_num : int -> t -> t
+
+  val lub : pattern -> t -> t
+
+  val matches : t -> matrix -> bool
+
+  val combine : t -> t
+
+  val select_columns : matrix -> t -> t
+
+  val union : t -> t -> t
+end = struct
+  module Row = struct
+    type t = { left : pattern list; right : pattern list }
+
+    let eprintf { left; right } =
+      Format.eprintf "LEFT:%a RIGHT:%a\n" pretty_line left pretty_line right
+
+    let le c1 c2 = le_pats c1.left c2.left && le_pats c1.right c2.right
+
+    let lshift { left; right } =
+      match right with
+      | x :: xs -> { left = x :: left; right = xs }
+      | _ -> assert false
+
+    let lforget { left; right } =
+      match right with
+      | _ :: xs -> { left = omega :: left; right = xs }
+      | _ -> assert false
+
+    let rshift { left; right } =
+      match left with
+      | p :: ps -> { left = ps; right = p :: right }
+      | _ -> assert false
+
+    let rshift_num n { left; right } =
+      let shifted, left = rev_split_at n left in
+      { left; right = shifted @ right }
+
+    (** Recombination of contexts (eg: (_,_)::p1::p2::rem ->  (p1,p2)::rem)
+  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 }
+      | _ -> assert false
+  end
+
+  type t = Row.t list
+
+  let empty = []
+
+  let start n : t = [ { left = []; right = omegas n } ]
+
+  let is_empty = function
+    | [] -> true
+    | _ -> false
+
+  let eprintf ctx = List.iter Row.eprintf ctx
+
+  let lshift ctx =
+    if List.length ctx < !Clflags.match_context_rows then
+      List.map Row.lshift ctx
+    else
+      (* Context pruning *)
+      get_mins Row.le (List.map Row.lforget ctx)
+
+  let rshift ctx = List.map Row.rshift ctx
+
+  let rshift_num n ctx = List.map (Row.rshift_num n) ctx
+
+  let combine ctx = List.map Row.combine ctx
+
+  let ctx_matcher p q rem =
+    let rec expand_record p =
+      match p.pat_desc with
+      | Tpat_record (l, _) ->
+          { p with pat_desc = Tpat_record (all_record_args l, Closed) }
+      | Tpat_alias (p, _, _) -> expand_record p
+      | _ -> p
+    in
+    let ph, omegas =
+      let ph, p_args = Pattern_head.deconstruct (expand_record p) in
+      (ph, List.map (fun _ -> omega) p_args)
+    in
+    let qh, args = Pattern_head.deconstruct (expand_record q) in
+    let yes () = (p, args @ rem) in
+    let no () = raise NoMatch in
+    let yesif b =
+      if b then
+        yes ()
+      else
+        no ()
+    in
+    match (Pattern_head.desc ph, Pattern_head.desc qh) with
+    | Any, _ -> fatal_error "Matching.Context.matcher"
+    | _, Any -> (p, omegas @ rem)
+    | Construct cstr, Construct cstr' ->
+        (* NB: may_equal_constr considers (potential) constructor rebinding *)
+        yesif (Types.may_equal_constr cstr cstr')
+    | Construct _, _ -> no ()
+    | Constant cst, Constant cst' -> yesif (const_compare cst cst' = 0)
+    | Constant _, _ -> no ()
+    | Variant { tag; has_arg }, Variant { tag = tag'; has_arg = has_arg' } ->
+        yesif (tag = tag' && has_arg = has_arg')
+    | Variant _, _ -> no ()
+    | Array n1, Array n2 -> yesif (n1 = n2)
+    | Array _, _ -> no ()
+    | Tuple n1, Tuple n2 -> yesif (n1 = n2)
+    | Tuple _, _ -> no ()
+    | Record l, Record l' ->
+        (* we called expand_record on both arguments so l, l' are full *)
+        yesif (List.length l = List.length l')
+    | Record _, _ -> no ()
+    | Lazy, Lazy -> yes ()
+    | Lazy, _ -> no ()
+
+  let specialize q ctx =
+    let matcher = ctx_matcher q in
+    let rec filter_rec : t -> t = function
+      | ({ right = p :: ps } as l) :: rem -> (
+          match p.pat_desc with
+          | Tpat_or (p1, p2, _) ->
+              filter_rec
+                ({ l with right = p1 :: ps }
+                :: { l with
+                     Row.right (* disam not principal, OK *) = p2 :: ps
+                   }
+                :: rem
+                )
+          | Tpat_alias (p, _, _) ->
+              filter_rec ({ l with right = p :: ps } :: rem)
+          | Tpat_var _ -> filter_rec ({ l with right = omega :: ps } :: rem)
+          | _ -> (
+              let rem = filter_rec rem in
+              try
+                let to_left, right = matcher p ps in
+                { left = to_left :: l.left; right } :: rem
+              with NoMatch -> rem
+            )
+        )
+      | [] -> []
+      | _ -> fatal_error "Matching.Context.specialize"
+    in
+    filter_rec ctx
+
+  let select_columns pss ctx =
+    let n = ncols pss in
+    let lub_row ps { Row.left; right } =
+      let transfer, right = rev_split_at n right in
+      match lubs transfer ps with
+      | exception Empty -> None
+      | inter -> Some { Row.left = inter @ left; right }
+    in
+    let lub_with_ctx ps = List.filter_map (lub_row ps) ctx in
+    List.flatten (List.map lub_with_ctx pss)
+
+  let lub p ctx =
+    List.filter_map
+      (fun { Row.left; right } ->
+        match right with
+        | q :: rem -> (
+            try Some { Row.left; right = lub p q :: rem } with Empty -> None
+          )
+        | _ -> fatal_error "Matching.Context.lub")
+      ctx
+
+  let matches ctx pss =
+    List.exists
+      (fun { Row.right = qs } -> List.exists (fun ps -> may_compats qs ps) pss)
+      ctx
+
+  let union pss qss = get_mins Row.le (pss @ qss)
+end
+
+exception OrPat
+
+let rec flatten_pat_line size p k =
+  match p.pat_desc with
+  | Tpat_any -> omegas size :: k
+  | Tpat_tuple args -> args :: k
+  | Tpat_or (p1, p2, _) ->
+      flatten_pat_line size p1 (flatten_pat_line size p2 k)
+  | Tpat_alias (p, _, _) ->
+      (* Note: if this 'as' pat is here, then this is a
+                           useless binding, solves PR#3780 *)
+      flatten_pat_line size p k
+  | _ -> fatal_error "Matching.flatten_pat_line"
+
+let flatten_matrix size pss =
+  List.fold_right
+    (fun ps r ->
+      match ps with
+      | [ p ] -> flatten_pat_line size p r
+      | _ -> fatal_error "Matching.flatten_matrix")
+    pss []
+
+(** A default environment (referred to as "reachable trap handlers" in the
+    paper), is an ordered list of [matrix * raise_num] pairs, and is used to
+    decide where to jump next if none of the rows in a given matrix match the
+    input.
+
+    In such situations, one thing you can do is to jump to the first (leftmost)
+    [raise_num] in that list (by doing a raise to the static-cach handler number
+    [raise_num]); and you can assume that if the associated pm doesn't match
+    either, it will do the same thing, etc.
+    This is what [mk_failaction_neg] (and its callers) does.
+
+    A more sophisticated alternative is to use what you know about the input
+    (what you might already have matched) and the current pm (what you know you
+    can't match) to directly jump to a pm that might match it instead of the
+    next one; that is why we don't just keep [raise_num]s but also the
+    associated matrices.
+    [mk_failaction_pos] does (a slightly more sophisticated version of) this.
+*)
+module Default_environment : sig
+  type t
+
+  val is_empty : t -> bool
+
+  val pop : t -> ((matrix * int) * t) option
+
+  val empty : t
+
+  val cons : matrix -> int -> t -> t
+
+  val specialize : (pattern -> pattern list -> pattern list) -> t -> t
+
+  val pop_column : t -> t
+
+  val pop_compat : pattern -> t -> t
+
+  val flatten : int -> t -> t
+
+  val pp : t -> unit
+end = struct
+  type t = (matrix * int) list
+  (** 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 is_empty = function
+    | [] -> true
+    | _ -> false
+
+  let cons matrix raise_num default =
+    match matrix with
+    | [] -> default
+    | _ -> (matrix, raise_num) :: default
+
+  let specialize_matrix matcher pss =
+    let rec filter_rec = function
+      | (p :: ps) :: rem -> (
+          match p.pat_desc with
+          | Tpat_alias (p, _, _) -> filter_rec ((p :: ps) :: rem)
+          | Tpat_var _ -> filter_rec ((omega :: ps) :: rem)
+          | _ -> (
+              let rem = filter_rec rem in
+              try matcher p ps :: rem with
+              | NoMatch -> rem
+              | OrPat -> (
+                  match p.pat_desc with
+                  | Tpat_or (p1, p2, _) ->
+                      filter_rec [ p1 :: ps; p2 :: ps ] @ rem
+                  | _ -> assert false
+                )
+            )
+        )
+      | [] -> []
+      | _ ->
+          pretty_matrix Format.err_formatter pss;
+          fatal_error "Matching.Default_environment.specialize_matrix"
+    in
+    filter_rec pss
+
+  let specialize matcher env =
+    let rec make_rec = function
+      | [] -> []
+      | ([ [] ], i) :: _ -> [ ([ [] ], i) ]
+      | (pss, i) :: rem -> (
+          let rem = make_rec rem in
+          match specialize_matrix matcher pss with
+          | [] -> rem
+          | [] :: _ -> [ ([ [] ], i) ]
+          | pss -> (pss, i) :: rem
+        )
+    in
+    make_rec env
+
+  let pop_column def = specialize (fun _p rem -> rem) def
+
+  let pop_compat p def =
+    let compat_matcher q rem =
+      if may_compat p q then
+        rem
+      else
+        raise NoMatch
+    in
+    specialize compat_matcher def
+
+  let pop = function
+    | [] -> None
+    | def :: defs -> Some (def, defs)
+
+  let pp def =
+    Format.eprintf "+++++ Defaults +++++\n";
+    List.iter
+      (fun (pss, i) -> Format.eprintf "Matrix for %d\n%a" i pretty_matrix pss)
+      def;
+    Format.eprintf "+++++++++++++++++++++\n"
+
+  let flatten size def =
+    List.map (fun (pss, i) -> (flatten_matrix size pss, i)) def
+end
+
+module Jumps : sig
+  type t
+
+  val is_empty : t -> bool
+
+  val empty : t
+
+  val singleton : int -> Context.t -> t
+
+  val add : int -> Context.t -> t -> t
+
+  val union : t -> t -> t
+
+  val unions : t list -> t
+
+  val map : (Context.t -> Context.t) -> t -> t
+
+  val remove : int -> t -> t
+
+  val extract : int -> t -> Context.t * t
+
+  val eprintf : t -> unit
+end = struct
+  type t = (int * Context.t) list
+
+  let eprintf (env : t) =
+    List.iter
+      (fun (i, ctx) ->
+        Printf.eprintf "jump for %d\n" i;
+        Context.eprintf ctx)
+      env
+
+  let rec extract i = function
+    | [] -> (Context.empty, [])
+    | ((j, pss) as x) :: rem as all ->
+        if i = j then
+          (pss, rem)
+        else if j < i then
+          (Context.empty, all)
+        else
+          let r, rem = extract i rem in
+          (r, x :: rem)
+
+  let rec remove i = function
+    | [] -> []
+    | (j, _) :: rem when i = j -> rem
+    | x :: rem -> x :: remove i rem
+
+  let empty = []
+
+  and is_empty = function
+    | [] -> true
+    | _ -> false
+
+  let singleton i ctx =
+    if Context.is_empty ctx then
+      []
+    else
+      [ (i, ctx) ]
+
+  let add i ctx jumps =
+    let rec add = function
+      | [] -> [ (i, ctx) ]
+      | ((j, qss) as x) :: rem as all ->
+          if j > i then
+            x :: add rem
+          else if j < i then
+            (i, ctx) :: all
+          else
+            (i, Context.union ctx qss) :: rem
+    in
+    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
+
+  let rec merge = function
+    | env1 :: env2 :: rem -> union env1 env2 :: merge rem
+    | envs -> envs
+
+  let rec unions envs =
+    match envs with
+    | [] -> []
+    | [ env ] -> env
+    | _ -> unions (merge envs)
+
+  let map f env = List.map (fun (i, pss) -> (i, f pss)) env
+end
+
+(* Pattern matching before any compilation *)
+
+type '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). *)
+  default : Default_environment.t
+}
+
+type handler = {
+  provenance : matrix;
+  exit : int;
+  vars : (Ident.t * Lambda.value_kind) list;
+  pm : initial_clause pattern_matching
+}
+
+type 'head_pat pm_or_compiled = {
+  body : 'head_pat Non_empty_clause.t pattern_matching;
+  handlers : handler list;
+  or_matrix : matrix
+}
+
+(* Pattern matching after application of both the or-pat rule and the
+   mixture rule *)
+
+type pm_half_compiled =
+  | PmOr of Simple.pattern pm_or_compiled
+  | PmVar of { inside : pm_half_compiled }
+  | Pm of Simple.clause pattern_matching
+
+(* Only used inside the various split functions, we only keep [me] when we're
+   done splitting / precompiling. *)
+type pm_half_compiled_info = {
+  me : pm_half_compiled;
+  matrix : matrix;
+  (* the matrix matched by [me]. Is used to extend the list of reachable trap
+        handlers (aka "default environments") when returning from recursive
+        calls. *)
+  top_default : Default_environment.t
+}
+
+let erase_cases f cases =
+  List.map (fun ((p, ps), act) -> (f p :: ps, act)) cases
+
+let erase_pm pm =
+  { pm with cases = erase_cases General.erase pm.cases }
+
+let pretty_cases cases =
+  List.iter
+    (fun (ps, _l) ->
+      List.iter (fun p -> Format.eprintf " %a%!" top_pretty p) ps;
+      Format.eprintf "\n")
+    cases
+
+let pretty_pm pm =
+  pretty_cases pm.cases;
+  if not (Default_environment.is_empty pm.default) then
+    Default_environment.pp pm.default
+
+let rec pretty_precompiled = function
+  | Pm pm ->
+      Format.eprintf "++++ PM ++++\n";
+      pretty_pm (erase_pm pm)
+  | PmVar x ->
+      Format.eprintf "++++ VAR ++++\n";
+      pretty_precompiled x.inside
+  | PmOr x ->
+      Format.eprintf "++++ OR ++++\n";
+      pretty_pm (erase_pm x.body);
+      pretty_matrix Format.err_formatter x.or_matrix;
+      List.iter
+        (fun { exit = i; pm; _ } ->
+          eprintf "++ Handler %d ++\n" i;
+          pretty_pm pm)
+        x.handlers
+
+let pretty_precompiled_res first nexts =
+  pretty_precompiled first;
+  List.iter
+    (fun (e, pmh) ->
+      eprintf "** DEFAULT %d **\n" e;
+      pretty_precompiled pmh)
+    nexts
+
+(* Identifying some semantically equivalent lambda-expressions,
+   Our goal here is also to
+   find alpha-equivalent (simple) terms *)
+
+(* However, as shown by PR#6359 such sharing may hinders the
+   lambda-code invariant that all bound idents are unique,
+   when switches are compiled to test sequences.
+   The definitive fix is the systematic introduction of exit/catch
+   in case action sharing is present.
+*)
+
+module StoreExp = Switch.Store (struct
+  type t = lambda
+
+  type key = lambda
+
+  let compare_key = Stdlib.compare
+
+  let make_key = Lambda.make_key
+end)
+
+let make_exit i = Lstaticraise (i, [])
+
+(* Introduce a catch, if worth it *)
+let make_catch d k =
+  match d with
+  | Lstaticraise (_, []) -> k d
+  | _ ->
+      let e = next_raise_count () in
+      Lstaticcatch (k (make_exit e), (e, []), d)
+
+(* Introduce a catch, if worth it, delayed version *)
+let rec as_simple_exit = function
+  | Lstaticraise (i, []) -> Some i
+  | Llet (Alias, _k, _, _, e) -> as_simple_exit e
+  | _ -> None
+
+let make_catch_delayed handler =
+  match as_simple_exit handler with
+  | Some i -> (i, fun act -> act)
+  | None -> (
+      let i = next_raise_count () in
+      (*
+    Printf.eprintf "SHARE LAMBDA: %i\n%s\n" i (string_of_lam handler);
+*)
+      ( i,
+        fun body ->
+          match body with
+          | Lstaticraise (j, _) ->
+              if i = j then
+                handler
+              else
+                body
+          | _ -> Lstaticcatch (body, (i, []), handler) )
+    )
+
+let raw_action l =
+  match make_key l with
+  | Some l -> l
+  | None -> l
+
+let same_actions = function
+  | [] -> None
+  | [ (_, act) ] -> Some act
+  | (_, act0) :: rem -> (
+      match make_key act0 with
+      | None -> None
+      | key0_opt ->
+          let same_act (_, act) = make_key act = key0_opt in
+          if List.for_all same_act rem then
+            Some act0
+          else
+            None
+    )
+
+let safe_before ((p, ps), act_p) l =
+  (* Test for swapping two clauses *)
+  let same_actions act1 act2 =
+    match (make_key act1, make_key act2) with
+    | Some key1, Some key2 -> key1 = key2
+    | None, _
+    | _, None ->
+        false
+  in
+  List.for_all
+    (fun ((q, qs), act_q) ->
+      same_actions act_p act_q
+      || not (may_compats (General.erase p :: ps) (General.erase q :: qs)))
+    l
+
+let half_simplify_nonempty ~arg (cls : Typedtree.pattern Non_empty_clause.t) :
+    Half_simple.clause =
+  cls |> Non_empty_clause.map_head General.view |> Half_simple.of_clause ~arg
+
+let half_simplify_clause ~arg (cls : Typedtree.pattern list clause) =
+  cls |> Non_empty_clause.of_initial |> half_simplify_nonempty ~arg
+
+(* Once matchings are *fully* simplified, one can easily find
+   their nature. *)
+
+let rec what_is_cases ~skip_any cases =
+  match cases with
+  | [] -> Pattern_head.omega
+  | ((p, _), _) :: rem -> (
+      let head = Simple.head p in
+      match Pattern_head.desc head with
+      | Any when skip_any -> what_is_cases ~skip_any rem
+      | _ -> head
+    )
+
+let what_is_first_case = what_is_cases ~skip_any:false
+
+let what_is_cases = what_is_cases ~skip_any:true
+
+let pm_free_variables { cases } =
+  List.fold_right
+    (fun (_, act) r -> Ident.Set.union (free_variables act) r)
+    cases Ident.Set.empty
+
+(* Basic grouping predicates *)
+let pat_as_constr = function
+  | { pat_desc = Tpat_construct (_, cstr, _) } -> cstr
+  | _ -> fatal_error "Matching.pat_as_constr"
+
+let can_group discr pat =
+  match (Pattern_head.desc discr, Pattern_head.desc (Simple.head pat)) with
+  | Any, Any
+  | Constant (Const_int _), Constant (Const_int _)
+  | Constant (Const_char _), Constant (Const_char _)
+  | Constant (Const_string _), Constant (Const_string _)
+  | Constant (Const_float _), Constant (Const_float _)
+  | Constant (Const_int32 _), Constant (Const_int32 _)
+  | Constant (Const_int64 _), Constant (Const_int64 _)
+  | Constant (Const_nativeint _), Constant (Const_nativeint _) ->
+      true
+  | Construct { cstr_tag = Cstr_extension _ as discr_tag }, Construct pat_cstr
+    ->
+      (* Extension constructors with distinct names may be equal thanks to
+         constructor rebinding. So we need to produce a specialized
+         submatrix for each syntactically-distinct constructor (with a threading
+         of exits such that each submatrix falls back to the
+         potentially-compatible submatrices below it).  *)
+      Types.equal_tag discr_tag pat_cstr.cstr_tag
+  | Construct _, Construct _
+  | Tuple _, (Tuple _ | Any)
+  | Record _, (Record _ | Any)
+  | Array _, Array _
+  | Variant _, Variant _
+  | Lazy, Lazy ->
+      true
+  | ( _,
+      ( Any
+      | Constant
+          ( Const_int _ | Const_char _ | Const_string _ | Const_float _
+          | Const_int32 _ | Const_int64 _ | Const_nativeint _ )
+      | Construct _ | Tuple _ | Record _ | Array _ | Variant _ | Lazy ) ) ->
+      false
+
+let is_or p =
+  match p.pat_desc with
+  | Tpat_or _ -> true
+  | _ -> false
+
+let rec omega_like p =
+  match p.pat_desc with
+  | Tpat_any
+  | Tpat_var _ ->
+      true
+  | Tpat_alias (p, _, _) -> omega_like p
+  | Tpat_or (p1, p2, _) -> omega_like p1 || omega_like p2
+  | _ -> false
+
+let simple_omega_like p =
+  match Pattern_head.desc (Simple.head p) with
+  | Any -> true
+  | _ -> false
+
+let equiv_pat p q = le_pat p q && le_pat q p
+
+let rec extract_equiv_head p l =
+  match l with
+  | (((q, _), _) as cl) :: rem ->
+      if equiv_pat p (General.erase q) then
+        let others, rem = extract_equiv_head p rem in
+        (cl :: others, rem)
+      else
+        ([], l)
+  | _ -> ([], l)
+
+module Or_matrix = struct
+  (* Splitting a matrix uses an or-matrix that contains or-patterns (at
+     the head of some of its rows).
+
+     The property that we want to maintain for the rows of the
+     or-matrix is that if the row p::ps is before q::qs and p is an
+     or-pattern, and v::vs matches p but not ps, then we don't need to
+     try q::qs. This is necessary because the compilation of the
+     or-pattern p will exit to a sub-matrix and never come back.
+
+     For this to hold, (p::ps) and (q::qs) must satisfy one of:
+     - disjointness: p and q are not compatible
+     - ordering: if p and q are compatible, ps is more general than qs
+       (this only works if the row p::ps is not guarded; otherwise the
+        guard could fail and q::qs should still be tried)
+  *)
+
+  (* Conditions for appending to the Or matrix *)
+  let disjoint p q = not (may_compat p q)
+
+  let safe_below (ps, act) qs =
+    (not (is_guarded act)) && Parmatch.le_pats ps qs
+
+  let safe_below_or_matrix l (q, qs) =
+    List.for_all
+      (fun ((p, ps), act_p) ->
+        let p = General.erase p in
+        match p.pat_desc with
+        | Tpat_or _ -> disjoint p q || safe_below (ps, act_p) qs
+        | _ -> true)
+      l
+
+  (* Insert or append a clause in the Or matrix:
+     - insert: adding the clause in the middle of the or_matrix
+     - append: adding the clause at the bottom of the or_matrix
+
+     If neither are possible we add to the bottom of the No matrix.
+   *)
+  let insert_or_append (head, ps, act) rev_ors rev_no =
+    let safe_to_insert rem (p, ps) seen =
+      let _, not_e = extract_equiv_head p rem in
+      (* check append condition for head of O *)
+      safe_below_or_matrix not_e (p, ps)
+      && (* check insert condition for tail of O *)
+         List.for_all (fun ((q, _), _) -> disjoint p (General.erase q)) seen
+    in
+    let rec attempt seen = function
+      (* invariant: the new clause is safe to append at the end of
+         [seen] (but maybe not [rem] yet) *)
+      | [] -> (((head, ps), act) :: rev_ors, rev_no)
+      | (((q, qs), act_q) as cl) :: rem ->
+          let p = General.erase head in
+          let q = General.erase q in
+          if (not (is_or q)) || disjoint p q then
+            attempt (cl :: seen) rem
+          else if
+            Typedtree.pat_bound_idents p = []
+            && Typedtree.pat_bound_idents q = []
+            && equiv_pat p q
+          then
+            (* attempt insertion, for equivalent orpats with no variables *)
+            if safe_to_insert rem (p, ps) seen then
+              (List.rev_append seen (((head, ps), act) :: cl :: rem), rev_no)
+            else
+              (* fail to insert or append *)
+              (rev_ors, ((head, ps), act) :: rev_no)
+          else if safe_below (qs, act_q) ps then
+            attempt (cl :: seen) rem
+          else
+            (rev_ors, ((head, ps), act) :: rev_no)
+    in
+    attempt [] rev_ors
+end
+
+(* Reconstruct default information from half_compiled  pm list *)
+
+let as_matrix cases =
+  get_mins le_pats (List.map (fun ((p, ps), _) -> General.erase p :: ps) cases)
+
+(*
+  Split a matching along the first column.
+
+    Splitting is first directed by or-patterns, then by
+    tests (e.g. constructors)/variable transitions.
+
+    The approach is greedy, every split function attempts to
+    raise rows as much as possible in the top matrix,
+    then splitting applies again to the remaining rows.
+
+    Some precompilation of or-patterns and
+    variable pattern occurs. Mostly this means that bindings
+    are performed now,  being replaced by let-bindings
+    in actions (cf. Half_simple.of_clause).
+
+    Additionally, if the match argument is a variable, matchings whose
+    first column is made of variables only are split further
+    (cf. precompile_var).
+
+  ---
+
+  Note: we assume that the first column of each pattern is coherent -- all
+  patterns match values of the same type. This comes from the fact that
+  we make aggressive splitting decisions, splitting pattern heads that
+  may be different into different submatrices; in particular, in a given
+  submatrix the first column is formed of first arguments to the same
+  constructor.
+
+  GADTs are not an issue because we split columns left-to-right, and
+  GADT typing also introduces typing equations left-to-right. In
+  particular, a leftmost column in matching.ml will be well-typed under
+  a set of equations accepted by the type-checker, and those equations
+  are forced to remain consistent: they can equate known types to
+  abstract types, but they cannot equate two incompatible known types
+  together, and in particular incompatible pattern heads do not appear
+  in a leftmost column.
+
+  Parmatch has to be more conservative because it splits less
+  aggressively: submatrices will contain not just the arguments of
+  a given pattern head, but also other lines that may be compatible with
+  it, in particular those with a leftmost omega and those starting with
+  an extension constructor that may be equal to it.
+
+*)
+
+let rec split_or argo (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)
+    | cl :: rem when not (safe_before cl rev_no) ->
+        do_split rev_before rev_ors (cl :: rev_no) rem
+    | (((p, ps), act) as cl) :: rem -> (
+        match p.pat_desc with
+        | #simple_view as view when safe_before cl rev_ors ->
+            do_split
+              ((({ p with pat_desc = view }, ps), act) :: rev_before)
+              rev_ors rev_no rem
+        | _ ->
+            let rev_ors, rev_no =
+              Or_matrix.insert_or_append (p, ps, act) rev_ors rev_no
+            in
+            do_split rev_before rev_ors rev_no rem
+      )
+  and cons_next yes yesor no =
+    let def, nexts =
+      match no with
+      | [] -> (def, [])
+      | _ ->
+          let { me = next; matrix; top_default = def }, nexts =
+            do_split [] [] [] no
+          in
+          let idef = next_raise_count () in
+          (Default_environment.cons matrix idef def, (idef, next) :: nexts)
+    in
+    match yesor with
+    | [] -> split_no_or yes args def nexts
+    | _ -> precompile_or argo yes yesor args def nexts
+  in
+  do_split [] [] [] cls
+
+and split_no_or cls args def k =
+  (* We split the remaining clauses in as few pms as possible while maintaining
+     the property stated earlier (cf. {1. Precompilation}), i.e. for
+     any pm in the result, it is possible to decide for any two patterns
+     on the first column whether their heads are equal or not.
+
+     This generally means that we'll have two kinds of pms: ones where the first
+     column is made of variables only, and ones where the head is actually a
+     discriminating pattern.
+
+     There is some subtlety regarding the handling of extension constructors
+     (where it is not always possible to syntactically decide whether two
+     different heads match different values), but this is handled by the
+     [can_group] function. *)
+  let rec split (cls : Simple.clause list) =
+    let discr = what_is_first_case cls in
+    collect discr [] [] cls
+  and collect group_discr rev_yes rev_no = function
+    | [ (((p, ps), _) as cl) ]
+      when rev_yes <> [] && simple_omega_like p && List.for_all omega_like ps ->
+        (* This enables an extra division in some frequent cases:
+               last row is made of variables only
+
+           Splitting a matrix there creates two default environments (instead of
+           one for the non-split matrix), the first of which often gets
+           specialized away by further refinement, and the second one jumping
+           directly to the catch-all case -- this produces better code.
+
+           This optimisation is tested in the first part of
+           testsuite/tests/basic/patmatch_split_no_or.ml *)
+        collect group_discr rev_yes (cl :: rev_no) []
+    | (((p, _), _) as cl) :: rem ->
+        if can_group group_discr p && safe_before cl rev_no then
+          collect group_discr (cl :: rev_yes) rev_no rem
+        else if should_split group_discr then (
+          assert (rev_no = []);
+          let yes = List.rev rev_yes in
+          insert_split group_discr yes (cl :: rem) def k
+        ) else
+          collect group_discr rev_yes (cl :: rev_no) rem
+    | [] ->
+        let yes = List.rev rev_yes and no = List.rev rev_no in
+        insert_split group_discr yes no def k
+  and insert_split group_discr yes no def k =
+    let precompile_group =
+      match Pattern_head.desc group_discr with
+      | Any -> precompile_var
+      | _ -> do_not_precompile
+    in
+    match no with
+    | [] -> precompile_group args yes def k
+    | _ ->
+        let { me = next; matrix; top_default = def }, nexts = split no in
+        let idef = next_raise_count () in
+        precompile_group args yes
+          (Default_environment.cons matrix idef def)
+          ((idef, next) :: nexts)
+  and should_split group_discr =
+    match Pattern_head.desc group_discr with
+    | Construct { cstr_tag = Cstr_extension _ } ->
+        (* it is unlikely that we will raise anything, so we split now *)
+        true
+    | _ -> false
+  in
+  split cls
+
+and precompile_var args cls def k =
+  (* Strategy: pop the first column,
+     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 -> (
+      (* 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
+      | [ _ ] ->
+          (* as split as it can *)
+          do_not_precompile args cls def k
+      | _ -> (
+          (* Precompile *)
+          let var_args = arg :: 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))
+              cls
+          and var_def = Default_environment.pop_column def in
+          let { me = first; matrix }, nexts =
+            split_or (Some v) var_cls var_args var_def
+          in
+          (* Compute top information *)
+          match nexts with
+          | [] ->
+              (* If you need *)
+              do_not_precompile args cls def k
+          | _ ->
+              let rec rebuild_matrix pmh =
+                match pmh with
+                | Pm pm -> as_matrix pm.cases
+                | PmOr { or_matrix = m } -> m
+                | PmVar x -> add_omega_column (rebuild_matrix x.inside)
+              in
+              let rebuild_default nexts def =
+                (* We can't just do:
+                   {[
+                     List.map
+                       (fun (mat, e) -> add_omega_column mat, e)
+                       top_default (* assuming it'd been bound. *)
+                   ]}
+                   As we would be losing information: [def] is more precise
+                   than [add_omega_column (pop_column def)]. *)
+                List.fold_right
+                  (fun (e, pmh) ->
+                    Default_environment.cons
+                      (add_omega_column (rebuild_matrix pmh))
+                      e)
+                  nexts def
+              in
+              let rebuild_nexts nexts k =
+                map_end (fun (e, pm) -> (e, PmVar { inside = pm })) nexts k
+              in
+              let rfirst =
+                { me = PmVar { inside = first };
+                  matrix = add_omega_column matrix;
+                  top_default = rebuild_default nexts def
+                }
+              and rnexts = rebuild_nexts nexts k in
+              (rfirst, rnexts)
+        )
+    )
+  | _ -> do_not_precompile args cls def k
+
+and do_not_precompile args cls def k =
+  ( { me = Pm { cases = cls; args; default = def };
+      matrix = as_matrix cls;
+      top_default = def
+    },
+    k )
+
+and precompile_or argo (cls : Simple.clause list) ors args def k =
+  let rec do_cases = function
+    | [] -> ([], [])
+    | ((p, patl), action) :: rem -> (
+        match p.pat_desc with
+        | #simple_view as view ->
+            let new_ord, new_to_catch = do_cases rem in
+            ( (({ p with pat_desc = view }, patl), action) :: new_ord,
+              new_to_catch )
+        | `Or _ ->
+            let orp = General.erase p in
+            let others, rem = extract_equiv_head orp rem in
+            let orpm =
+              { cases =
+                  (patl, action)
+                  :: List.map (fun ((_, ps), action) -> (ps, action)) others;
+                args =
+                  ( match args with
+                  | _ :: r -> r
+                  | _ -> assert false
+                  );
+                default = Default_environment.pop_compat orp def
+              }
+            in
+            let pm_fv = pm_free_variables orpm in
+            let vars =
+              (* bound variables of the or-pattern and used in the orpm
+                 actions *)
+              Typedtree.pat_bound_idents_full orp
+              |> List.filter (fun (id, _, _) -> Ident.Set.mem id pm_fv)
+              |> List.map (fun (id, _, ty) ->
+                     (id, Typeopt.value_kind orp.pat_env ty))
+            in
+            let or_num = next_raise_count () in
+            let new_patl = Parmatch.omega_list patl in
+            let mk_new_action ~vars =
+              Lstaticraise (or_num, List.map (fun v -> Lvar v) vars)
+            in
+            let rem_cases, rem_handlers = do_cases rem in
+            let cases =
+              Simple.explode_or_pat (p, new_patl) ~arg:argo
+                ~mk_action:mk_new_action ~vars:(List.map fst vars) rem_cases
+            in
+            let handler =
+              { provenance = [ [ orp ] ];
+                exit = or_num;
+                vars;
+                pm = orpm
+              }
+            in
+            (cases, handler :: rem_handlers)
+      )
+  in
+  let cases, handlers = do_cases ors in
+  let matrix =
+    as_matrix
+      ((cls : Simple.clause list :> General.clause list)
+      @ (ors : Half_simple.clause list :> General.clause list)
+      )
+  and body = { cases = cls @ cases; args; default = def } in
+  ( { me = PmOr { body; handlers; or_matrix = matrix };
+      matrix;
+      top_default = def
+    },
+    k )
+
+let dbg_split_and_precompile pm next nexts =
+  if
+    dbg
+    && (nexts <> []
+       ||
+       match next with
+       | PmOr _ -> true
+       | _ -> false
+       )
+  then (
+    Format.eprintf "** SPLIT **\n";
+    pretty_pm (erase_pm pm);
+    pretty_precompiled_res next nexts
+  )
+
+let split_and_precompile_simplified pm =
+  let { me = next }, nexts = split_no_or pm.cases pm.args pm.default [] in
+  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
+  dbg_split_and_precompile pm next nexts;
+  (next, nexts)
+
+let split_and_precompile ~arg_id ~arg_lambda pm =
+  let pm =
+    { pm with cases = List.map (half_simplify_clause ~arg:arg_lambda) pm.cases }
+  in
+  split_and_precompile_half_simplified ~arg:arg_id pm
+
+(* General divide functions *)
+
+type cell = {
+  pm : initial_clause pattern_matching;
+  ctx : Context.t;
+  discr : pattern
+}
+(** a submatrix after specializing by discriminant pattern;
+    [ctx] is the context shared by all rows. *)
+
+type 'a division = {
+  args : (lambda * let_kind) list;
+  cells : ('a * cell) list
+}
+
+let add_in_div make_matching_fun eq_key key patl_action division =
+  let cells =
+    match List.find_opt (fun (k, _) -> eq_key key k) division.cells with
+    | None ->
+        let cell = make_matching_fun division.args in
+        cell.pm.cases <- [ patl_action ];
+        (key, cell) :: division.cells
+    | Some (_, cell) ->
+        cell.pm.cases <- patl_action :: cell.pm.cases;
+        division.cells
+  in
+  { division with cells }
+
+let divide make eq_key get_key get_args ctx
+    (pm : Simple.clause pattern_matching) =
+  let add ((p, patl), action) division =
+    let p = General.erase p in
+    add_in_div (make p pm.default ctx) eq_key (get_key p)
+      (get_args p patl, action)
+      division
+  in
+  List.fold_right add pm.cases { args = pm.args; cells = [] }
+
+let add_line patl_action pm =
+  pm.cases <- patl_action :: pm.cases;
+  pm
+
+let divide_line make_ctx make get_args discr ctx
+    (pm : Simple.clause pattern_matching) =
+  let add ((p, patl), action) submatrix =
+    let p = General.erase p in
+    add_line (get_args p patl, action) submatrix
+  in
+  let pm = List.fold_right add pm.cases (make pm.default pm.args) in
+  { pm; ctx = make_ctx ctx; discr }
+
+(* Then come various functions,
+   There is one set of functions per matching style
+   (constants, constructors etc.)
+
+   - matcher functions are arguments to Default_environment.specialize (for
+   default handlers)
+   They may raise NoMatch or OrPat and perform the full
+   matching (selection + arguments).
+
+   - get_args and get_key are for the compiled matrices, note that
+   selection and getting arguments are separated.
+
+   - make_*_matching combines the previous functions for producing
+   new  ``pattern_matching'' records.
+*)
+
+let rec matcher_const cst p rem =
+  match p.pat_desc with
+  | Tpat_or (p1, p2, _) -> (
+      try matcher_const cst p1 rem with NoMatch -> matcher_const cst p2 rem
+    )
+  | Tpat_constant c1 when const_compare c1 cst = 0 -> rem
+  | Tpat_any -> rem
+  | _ -> raise NoMatch
+
+let get_key_constant caller = function
+  | { pat_desc = Tpat_constant cst } -> cst
+  | p ->
+      Format.eprintf "BAD: %s" caller;
+      pretty_pat p;
+      assert false
+
+let get_args_constant _ rem = rem
+
+let make_constant_matching p def ctx = function
+  | [] -> fatal_error "Matching.make_constant_matching"
+  | _ :: argl ->
+      let def =
+        Default_environment.specialize
+          (matcher_const (get_key_constant "make" p))
+          def
+      and ctx = Context.specialize p ctx in
+      { pm = { cases = []; args = argl; default = def };
+        ctx;
+        discr = normalize_pat p
+      }
+
+let divide_constant ctx m =
+  divide make_constant_matching
+    (fun c d -> const_compare c d = 0)
+    (get_key_constant "divide")
+    get_args_constant ctx m
+
+(* Matching against a constructor *)
+
+let make_field_args loc binding_kind arg first_pos last_pos argl =
+  let rec make_args pos =
+    if pos > last_pos then
+      argl
+    else
+      (Lprim (Pfield pos, [ arg ], loc), binding_kind) :: make_args (pos + 1)
+  in
+  make_args first_pos
+
+let get_key_constr = function
+  | { pat_desc = Tpat_construct (_, cstr, _) } -> cstr.cstr_tag
+  | _ -> assert false
+
+let get_args_constr p rem =
+  match p with
+  | { pat_desc = Tpat_construct (_, _, args) } -> args @ rem
+  | _ -> assert false
+
+(* NB: matcher_constr applies to default matrices.
+
+       In that context, matching by constructors of extensible
+       types degrades to arity checking, due to potential rebinding.
+       This comparison is performed by Types.may_equal_constr.
+*)
+
+let matcher_constr cstr =
+  match cstr.cstr_arity with
+  | 0 ->
+      let rec matcher_rec q rem =
+        match q.pat_desc with
+        | Tpat_or (p1, p2, _) -> (
+            try matcher_rec p1 rem with NoMatch -> matcher_rec p2 rem
+          )
+        | Tpat_construct (_, cstr', []) when Types.may_equal_constr cstr cstr'
+          ->
+            rem
+        | Tpat_any -> rem
+        | _ -> raise NoMatch
+      in
+      matcher_rec
+  | 1 ->
+      let rec matcher_rec q rem =
+        match q.pat_desc with
+        | Tpat_or (p1, p2, _) -> (
+            (* if both sides of the or-pattern match the head constructor,
+            (K p1 | K p2) :: rem
+          return (p1 | p2) :: rem *)
+            let r1 = try Some (matcher_rec p1 rem) with NoMatch -> None
+            and r2 = try Some (matcher_rec p2 rem) with NoMatch -> None in
+            match (r1, r2) with
+            | None, None -> raise NoMatch
+            | Some r1, None -> r1
+            | None, Some r2 -> r2
+            | Some (a1 :: _), Some (a2 :: _) ->
+                { a1 with
+                  pat_loc = Location.none;
+                  pat_desc = Tpat_or (a1, a2, None)
+                }
+                :: rem
+            | _, _ -> assert false
+          )
+        | Tpat_construct (_, cstr', [ arg ])
+          when Types.may_equal_constr cstr cstr' ->
+            arg :: rem
+        | Tpat_any -> omega :: rem
+        | _ -> raise NoMatch
+      in
+      matcher_rec
+  | _ -> (
+      fun q rem ->
+        match q.pat_desc with
+        | Tpat_or (_, _, _) ->
+            (* we cannot preserve the or-pattern as in the arity-1 case,
+               because we cannot express
+                 (K (p1, .., pn) | K (q1, .. qn))
+               as (p1 .. pn | q1 .. qn) *)
+            raise OrPat
+        | Tpat_construct (_, cstr', args)
+          when Types.may_equal_constr cstr cstr' ->
+            args @ rem
+        | Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem
+        | _ -> raise NoMatch
+    )
+
+let make_constr_matching ~scopes p def ctx = function
+  | [] -> fatal_error "Matching.make_constr_matching"
+  | (arg, _mut) :: argl ->
+      let cstr = pat_as_constr p in
+      let newargs =
+        if cstr.cstr_inlined <> None then
+          (arg, Alias) :: argl
+        else
+          match cstr.cstr_tag with
+          | Cstr_constant _
+          | Cstr_block _ ->
+              make_field_args (of_location ~scopes p.pat_loc)
+                Alias arg 0 (cstr.cstr_arity - 1) argl
+          | Cstr_unboxed -> (arg, Alias) :: argl
+          | Cstr_extension _ ->
+              make_field_args (of_location ~scopes p.pat_loc)
+                Alias arg 1 cstr.cstr_arity argl
+      in
+      { pm =
+          { cases = [];
+            args = newargs;
+            default = Default_environment.specialize (matcher_constr cstr) def
+          };
+        ctx = Context.specialize p ctx;
+        discr = normalize_pat p
+      }
+
+let divide_constructor ~scopes ctx pm =
+  divide (make_constr_matching ~scopes) ( = )
+    get_key_constr get_args_constr ctx pm
+
+(* Matching against a variant *)
+
+let rec matcher_variant_const lab p rem =
+  match p.pat_desc with
+  | Tpat_or (p1, p2, _) -> (
+      try matcher_variant_const lab p1 rem
+      with NoMatch -> matcher_variant_const lab p2 rem
+    )
+  | Tpat_variant (lab1, _, _) when lab1 = lab -> rem
+  | Tpat_any -> rem
+  | _ -> raise NoMatch
+
+let make_variant_matching_constant p lab def ctx = function
+  | [] -> fatal_error "Matching.make_variant_matching_constant"
+  | _ :: argl ->
+      let def = Default_environment.specialize (matcher_variant_const lab) def
+      and ctx = Context.specialize p ctx in
+      { pm = { cases = []; args = argl; default = def };
+        ctx;
+        discr = normalize_pat p
+      }
+
+let matcher_variant_nonconst lab p rem =
+  match p.pat_desc with
+  | Tpat_or (_, _, _) -> raise OrPat
+  | Tpat_variant (lab1, Some arg, _) when lab1 = lab -> arg :: rem
+  | Tpat_any -> omega :: rem
+  | _ -> raise NoMatch
+
+let make_variant_matching_nonconst ~scopes p lab def ctx = function
+  | [] -> fatal_error "Matching.make_variant_matching_nonconst"
+  | (arg, _mut) :: argl ->
+      let def =
+        Default_environment.specialize (matcher_variant_nonconst lab) def
+      and ctx = Context.specialize p ctx
+      and loc = of_location ~scopes p.pat_loc in
+      { pm =
+          { cases = [];
+            args = (Lprim (Pfield 1, [ arg ], loc), Alias)
+                   :: argl;
+            default = def
+          };
+        ctx;
+        discr = normalize_pat p
+      }
+
+let divide_variant ~scopes row ctx { cases = cl; args; default = def } =
+  let row = Btype.row_repr row in
+  let rec divide = function
+    | [] -> { args; cells = [] }
+    | ((p, patl), action) :: rem
+      -> (
+        let lab, pato = match p.pat_desc with
+          | `Variant (lab, pato, _) -> lab, pato
+          | _ -> assert false
+        in
+        let p = General.erase p in
+        let variants = divide rem in
+        if
+          try Btype.row_field_repr (List.assoc lab row.row_fields) = Rabsent
+          with Not_found -> true
+        then
+          variants
+        else
+          let tag = Btype.hash_variant lab in
+          match pato with
+          | None ->
+              add_in_div
+                (make_variant_matching_constant p lab def ctx)
+                ( = ) (Cstr_constant tag) (patl, action) variants
+          | Some pat ->
+              add_in_div
+                (make_variant_matching_nonconst ~scopes p lab def ctx)
+                ( = ) (Cstr_block tag)
+                (pat :: patl, action)
+                variants
+      )
+  in
+  divide cl
+
+(*
+  Three ``no-test'' cases
+  *)
+
+(* Matching against a variable *)
+let get_args_var _p rem = rem
+
+let make_var_matching def = function
+  | [] -> fatal_error "Matching.make_var_matching"
+  | _ :: argl ->
+      { cases = [];
+        args = argl;
+        default = Default_environment.specialize get_args_var def
+      }
+
+let divide_var ctx pm =
+  divide_line Context.lshift make_var_matching get_args_var omega ctx pm
+
+(* Matching and forcing a lazy value *)
+
+let get_arg_lazy p rem =
+  match p with
+  | { pat_desc = Tpat_any } -> omega :: rem
+  | { pat_desc = Tpat_lazy arg } -> arg :: rem
+  | _ -> assert false
+
+let matcher_lazy p rem =
+  match p.pat_desc with
+  | Tpat_or (_, _, _) -> raise OrPat
+  | Tpat_any
+  | Tpat_var _ ->
+      omega :: rem
+  | Tpat_lazy arg -> arg :: rem
+  | _ -> raise NoMatch
+
+(* Inlining the tag tests before calling the primitive that works on
+   lazy blocks. This is also used in translcore.ml.
+   No other call than Obj.tag when the value has been forced before.
+*)
+
+let prim_obj_tag = Primitive.simple ~name:"caml_obj_tag" ~arity:1 ~alloc:false
+
+let get_mod_field modname field =
+  lazy
+    (let mod_ident = Ident.create_persistent modname in
+     let env =
+       Env.add_persistent_structure mod_ident Env.initial_safe_string
+     in
+     match Env.open_pers_signature modname env with
+     | Error `Not_found ->
+         fatal_error ("Module " ^ modname ^ " unavailable.")
+     | Ok env -> (
+         match Env.find_value_by_name (Longident.Lident field) env with
+         | exception Not_found ->
+             fatal_error ("Primitive " ^ modname ^ "." ^ field ^ " not found.")
+         | path, _ -> transl_value_path Loc_unknown env path
+       ))
+
+let code_force_lazy_block = get_mod_field "CamlinternalLazy" "force_lazy_block"
+
+let code_force_lazy = get_mod_field "CamlinternalLazy" "force"
+
+(* inline_lazy_force inlines the beginning of the code of Lazy.force. When
+   the value argument is tagged as:
+   - forward, take field 0
+   - lazy, call the primitive that forces (without testing again the tag)
+   - anything else, return it
+
+   Using Lswitch below relies on the fact that the GC does not shortcut
+   Forward(val_out_of_heap).
+*)
+
+let inline_lazy_force_cond arg loc =
+  let idarg = Ident.create_local "lzarg" in
+  let varg = Lvar idarg in
+  let tag = Ident.create_local "tag" in
+  let tag_var = Lvar tag in
+  let force_fun = Lazy.force code_force_lazy_block in
+  Llet
+    ( Strict,
+      Pgenval,
+      idarg,
+      arg,
+      Llet
+        ( Alias,
+          Pgenval,
+          tag,
+          Lprim (Pccall prim_obj_tag, [ varg ], loc),
+          Lifthenelse
+            (* if (tag == Obj.forward_tag) then varg.(0) else ... *)
+            ( Lprim
+                ( Pintcomp Ceq,
+                  [ tag_var; Lconst (Const_base (Const_int Obj.forward_tag)) ],
+                  loc ),
+              Lprim (Pfield 0, [ varg ], loc),
+              Lifthenelse
+                (* if (tag == Obj.lazy_tag) then Lazy.force varg else ... *)
+                ( Lprim
+                    ( Pintcomp Ceq,
+                      [ tag_var; Lconst (Const_base (Const_int Obj.lazy_tag)) ],
+                      loc ),
+                  Lapply
+                    { ap_should_be_tailcall = false;
+                      ap_loc = loc;
+                      ap_func = force_fun;
+                      ap_args = [ varg ];
+                      ap_inlined = Default_inline;
+                      ap_specialised = Default_specialise
+                    },
+                  (* ... arg *)
+                  varg ) ) ) )
+
+let inline_lazy_force_switch arg loc =
+  let idarg = Ident.create_local "lzarg" in
+  let varg = Lvar idarg in
+  let force_fun = Lazy.force code_force_lazy_block in
+  Llet
+    ( Strict,
+      Pgenval,
+      idarg,
+      arg,
+      Lifthenelse
+        ( Lprim (Pisint, [ varg ], loc),
+          varg,
+          Lswitch
+            ( varg,
+              { sw_numconsts = 0;
+                sw_consts = [];
+                sw_numblocks = 256;
+                (* PR#6033 - tag ranges from 0 to 255 *)
+                sw_blocks =
+                  [ (Obj.forward_tag, Lprim (Pfield 0, [ varg ], loc));
+                    ( Obj.lazy_tag,
+                      Lapply
+                        { ap_should_be_tailcall = false;
+                          ap_loc = loc;
+                          ap_func = force_fun;
+                          ap_args = [ varg ];
+                          ap_inlined = Default_inline;
+                          ap_specialised = Default_specialise
+                        } )
+                  ];
+                sw_failaction = Some varg
+              },
+              loc ) ) )
+
+let inline_lazy_force arg loc =
+  if !Clflags.afl_instrument then
+    (* Disable inlining optimisation if AFL instrumentation active,
+       so that the GC forwarding optimisation is not visible in the
+       instrumentation output.
+       (see https://github.com/stedolan/crowbar/issues/14) *)
+    Lapply
+      { ap_should_be_tailcall = false;
+        ap_loc = loc;
+        ap_func = Lazy.force code_force_lazy;
+        ap_args = [ arg ];
+        ap_inlined = Default_inline;
+        ap_specialised = Default_specialise
+      }
+  else if !Clflags.native_code then
+    (* Lswitch generates compact and efficient native code *)
+    inline_lazy_force_switch arg loc
+  else
+    (* generating bytecode: Lswitch would generate too many rather big
+         tables (~ 250 elts); conditionals are better *)
+    inline_lazy_force_cond arg loc
+
+let make_lazy_matching def = function
+  | [] -> fatal_error "Matching.make_lazy_matching"
+  | (arg, _mut) :: argl ->
+      { cases = [];
+        args = (inline_lazy_force arg Loc_unknown, Strict) :: argl;
+        default = Default_environment.specialize matcher_lazy def
+      }
+
+let divide_lazy p ctx pm =
+  divide_line (Context.specialize p) make_lazy_matching get_arg_lazy p ctx pm
+
+(* Matching against a tuple pattern *)
+
+let get_args_tuple arity p rem =
+  match p with
+  | { pat_desc = Tpat_any } -> omegas arity @ rem
+  | { pat_desc = Tpat_tuple args } -> args @ rem
+  | _ -> assert false
+
+let matcher_tuple arity p rem =
+  match p.pat_desc with
+  | Tpat_or (_, _, _) -> raise OrPat
+  | Tpat_any
+  | Tpat_var _ ->
+      omegas arity @ rem
+  | Tpat_tuple args when List.length args = arity -> args @ rem
+  | _ -> raise NoMatch
+
+let make_tuple_matching loc arity def = function
+  | [] -> fatal_error "Matching.make_tuple_matching"
+  | (arg, _mut) :: argl ->
+      let rec make_args pos =
+        if pos >= arity then
+          argl
+        else
+          (Lprim (Pfield pos, [ arg ], loc), Alias) :: make_args (pos + 1)
+      in
+      { cases = [];
+        args = make_args 0;
+        default = Default_environment.specialize (matcher_tuple arity) def
+      }
+
+let divide_tuple ~scopes arity p ctx pm =
+  divide_line (Context.specialize p)
+    (make_tuple_matching (of_location ~scopes p.pat_loc) arity)
+    (get_args_tuple arity) p ctx pm
+
+(* Matching against a record pattern *)
+
+let record_matching_line num_fields lbl_pat_list =
+  let patv = Array.make num_fields omega in
+  List.iter (fun (_, lbl, pat) -> patv.(lbl.lbl_pos) <- pat) lbl_pat_list;
+  Array.to_list patv
+
+let get_args_record num_fields p rem =
+  match p with
+  | { pat_desc = Tpat_any } -> record_matching_line num_fields [] @ rem
+  | { pat_desc = Tpat_record (lbl_pat_list, _) } ->
+      record_matching_line num_fields lbl_pat_list @ rem
+  | _ -> assert false
+
+let matcher_record num_fields p rem =
+  match p.pat_desc with
+  | Tpat_or (_, _, _) -> raise OrPat
+  | Tpat_any
+  | Tpat_var _ ->
+      record_matching_line num_fields [] @ rem
+  | Tpat_record ([], _) when num_fields = 0 -> rem
+  | Tpat_record (((_, lbl, _) :: _ as lbl_pat_list), _)
+    when Array.length lbl.lbl_all = num_fields ->
+      record_matching_line num_fields lbl_pat_list @ rem
+  | _ -> raise NoMatch
+
+let make_record_matching loc all_labels def = function
+  | [] -> fatal_error "Matching.make_record_matching"
+  | (arg, _mut) :: argl ->
+      let rec make_args pos =
+        if pos >= Array.length all_labels then
+          argl
+        else
+          let lbl = all_labels.(pos) in
+          let access =
+            match lbl.lbl_repres with
+            | Record_regular
+            | Record_inlined _ ->
+                Lprim (Pfield lbl.lbl_pos, [ arg ], loc)
+            | Record_unboxed _ -> arg
+            | Record_float -> Lprim (Pfloatfield lbl.lbl_pos, [ arg ], loc)
+            | Record_extension _ ->
+                Lprim (Pfield (lbl.lbl_pos + 1), [ arg ], loc)
+          in
+          let str =
+            match lbl.lbl_mut with
+            | Immutable -> Alias
+            | Mutable -> StrictOpt
+          in
+          (access, str) :: make_args (pos + 1)
+      in
+      let nfields = Array.length all_labels in
+      let def = Default_environment.specialize (matcher_record nfields) def in
+      { cases = []; args = make_args 0; default = def }
+
+let divide_record ~scopes all_labels p ctx pm =
+  let get_args = get_args_record (Array.length all_labels) in
+  divide_line (Context.specialize p)
+    (make_record_matching (of_location ~scopes p.pat_loc) all_labels)
+    get_args p ctx pm
+
+(* Matching against an array pattern *)
+
+let get_key_array = function
+  | { pat_desc = Tpat_array patl } -> List.length patl
+  | _ -> assert false
+
+let get_args_array p rem =
+  match p with
+  | { pat_desc = Tpat_array patl } -> patl @ rem
+  | _ -> assert false
+
+let matcher_array len p rem =
+  match p.pat_desc with
+  | Tpat_or (_, _, _) -> raise OrPat
+  | Tpat_array args when List.length args = len -> args @ rem
+  | Tpat_any -> Parmatch.omegas len @ rem
+  | _ -> raise NoMatch
+
+let make_array_matching ~scopes kind p def ctx = function
+  | [] -> fatal_error "Matching.make_array_matching"
+  | (arg, _mut) :: argl ->
+      let len = get_key_array p in
+      let rec make_args pos =
+        if pos >= len then
+          argl
+        else
+          ( Lprim
+              ( Parrayrefu kind,
+                [ arg; Lconst (Const_base (Const_int pos)) ],
+                (of_location ~scopes p.pat_loc) ),
+            StrictOpt )
+          :: make_args (pos + 1)
+      in
+      let def = Default_environment.specialize (matcher_array len) def
+      and ctx = Context.specialize p ctx in
+      { pm = { cases = []; args = make_args 0; default = def };
+        ctx;
+        discr = normalize_pat p
+      }
+
+let divide_array ~scopes kind ctx pm =
+  divide (make_array_matching ~scopes kind) ( = )
+    get_key_array get_args_array ctx pm
+
+(*
+   Specific string test sequence
+   Will be called by the bytecode compiler, from bytegen.ml.
+   The strategy is first dichotomic search (we perform 3-way tests
+   with compare_string), then sequence of equality tests
+   when there are less then T=strings_test_threshold static strings to match.
+
+  Increasing T entails (slightly) less code, decreasing T
+  (slightly) favors runtime speed.
+  T=8 looks a decent tradeoff.
+*)
+
+(* Utilities *)
+
+let strings_test_threshold = 8
+
+let prim_string_notequal =
+  Pccall (Primitive.simple ~name:"caml_string_notequal" ~arity:2 ~alloc:false)
+
+let prim_string_compare =
+  Pccall (Primitive.simple ~name:"caml_string_compare" ~arity:2 ~alloc:false)
+
+let bind_sw arg k =
+  match arg with
+  | Lvar _ -> k arg
+  | _ ->
+      let id = Ident.create_local "switch" in
+      Llet (Strict, Pgenval, id, arg, k (Lvar id))
+
+(* Sequential equality tests *)
+
+let make_string_test_sequence loc arg sw d =
+  let d, sw =
+    match d with
+    | None -> (
+        match sw with
+        | (_, d) :: sw -> (d, sw)
+        | [] -> assert false
+      )
+    | Some d -> (d, sw)
+  in
+  bind_sw arg (fun arg ->
+      List.fold_right
+        (fun (str, lam) k ->
+          Lifthenelse
+            ( Lprim
+                ( prim_string_notequal,
+                  [ arg; Lconst (Const_immstring str) ],
+                  loc ),
+              k,
+              lam ))
+        sw d)
+
+let rec split k xs =
+  match xs with
+  | [] -> assert false
+  | x0 :: xs ->
+      if k <= 1 then
+        ([], x0, xs)
+      else
+        let xs, y0, ys = split (k - 2) xs in
+        (x0 :: xs, y0, ys)
+
+let zero_lam = Lconst (Const_base (Const_int 0))
+
+let tree_way_test loc arg lt eq gt =
+  Lifthenelse
+    ( Lprim (Pintcomp Clt, [ arg; zero_lam ], loc),
+      lt,
+      Lifthenelse (Lprim (Pintcomp Clt, [ zero_lam; arg ], loc), gt, eq) )
+
+(* Dichotomic tree *)
+
+let rec do_make_string_test_tree loc arg sw delta d =
+  let len = List.length sw in
+  if len <= strings_test_threshold + delta then
+    make_string_test_sequence loc arg sw d
+  else
+    let lt, (s, act), gt = split len sw in
+    bind_sw
+      (Lprim (prim_string_compare, [ arg; Lconst (Const_immstring s) ], loc))
+      (fun r ->
+        tree_way_test loc r
+          (do_make_string_test_tree loc arg lt delta d)
+          act
+          (do_make_string_test_tree loc arg gt delta d))
+
+(* Entry point *)
+let expand_stringswitch loc arg sw d =
+  match d with
+  | None -> bind_sw arg (fun arg -> do_make_string_test_tree loc arg sw 0 None)
+  | Some e ->
+      bind_sw arg (fun arg ->
+          make_catch e (fun d ->
+              do_make_string_test_tree loc arg sw 1 (Some d)))
+
+(**********************)
+(* Generic test trees *)
+(**********************)
+
+(* Sharing *)
+
+(* Add handler, if shared *)
+let handle_shared () =
+  let hs = ref (fun x -> x) in
+  let handle_shared act =
+    match act with
+    | Switch.Single act -> act
+    | Switch.Shared act ->
+        let i, h = make_catch_delayed act in
+        let ohs = !hs in
+        (hs := fun act -> h (ohs act));
+        make_exit i
+  in
+  (hs, handle_shared)
+
+let share_actions_tree sw d =
+  let store = StoreExp.mk_store () in
+  (* Default action is always shared *)
+  let d =
+    match d with
+    | None -> None
+    | Some d -> Some (store.Switch.act_store_shared () d)
+  in
+  (* Store all other actions *)
+  let sw =
+    List.map (fun (cst, act) -> (cst, store.Switch.act_store () act)) sw
+  in
+  (* Retrieve all actions, including potential default *)
+  let acts = store.Switch.act_get_shared () in
+  (* Array of actual actions *)
+  let hs, handle_shared = handle_shared () in
+  let acts = Array.map handle_shared acts in
+  (* Reconstruct default and switch list *)
+  let d =
+    match d with
+    | None -> None
+    | Some d -> Some acts.(d)
+  in
+  let sw = List.map (fun (cst, j) -> (cst, acts.(j))) sw in
+  (!hs, sw, d)
+
+(* Note: dichotomic search requires sorted input with no duplicates *)
+let rec uniq_lambda_list sw =
+  match sw with
+  | []
+  | [ _ ] ->
+      sw
+  | ((c1, _) as p1) :: ((c2, _) :: sw2 as sw1) ->
+      if const_compare c1 c2 = 0 then
+        uniq_lambda_list (p1 :: sw2)
+      else
+        p1 :: uniq_lambda_list sw1
+
+let sort_lambda_list l =
+  let l = List.stable_sort (fun (x, _) (y, _) -> const_compare x y) l in
+  uniq_lambda_list l
+
+let rec do_tests_fail loc fail tst arg = function
+  | [] -> fail
+  | (c, act) :: rem ->
+      Lifthenelse
+        ( Lprim (tst, [ arg; Lconst (Const_base c) ], loc),
+          do_tests_fail loc fail tst arg rem,
+          act )
+
+let rec do_tests_nofail loc tst arg = function
+  | [] -> fatal_error "Matching.do_tests_nofail"
+  | [ (_, act) ] -> act
+  | (c, act) :: rem ->
+      Lifthenelse
+        ( Lprim (tst, [ arg; Lconst (Const_base c) ], loc),
+          do_tests_nofail loc tst arg rem,
+          act )
+
+let make_test_sequence loc fail tst lt_tst arg const_lambda_list =
+  let const_lambda_list = sort_lambda_list const_lambda_list in
+  let hs, const_lambda_list, fail =
+    share_actions_tree const_lambda_list fail
+  in
+  let rec make_test_sequence const_lambda_list =
+    if List.length const_lambda_list >= 4 && lt_tst <> Pignore then
+      split_sequence const_lambda_list
+    else
+      match fail with
+      | None -> do_tests_nofail loc tst arg const_lambda_list
+      | Some fail -> do_tests_fail loc fail tst arg const_lambda_list
+  and split_sequence const_lambda_list =
+    let list1, list2 =
+      rev_split_at (List.length const_lambda_list / 2) const_lambda_list
+    in
+    Lifthenelse
+      ( Lprim (lt_tst, [ arg; Lconst (Const_base (fst (List.hd list2))) ], loc),
+        make_test_sequence list1,
+        make_test_sequence list2 )
+  in
+  hs (make_test_sequence const_lambda_list)
+
+module SArg = struct
+  type primitive = Lambda.primitive
+
+  let eqint = Pintcomp Ceq
+
+  let neint = Pintcomp Cne
+
+  let leint = Pintcomp Cle
+
+  let ltint = Pintcomp Clt
+
+  let geint = Pintcomp Cge
+
+  let gtint = Pintcomp Cgt
+
+  type act = Lambda.lambda
+
+  type loc = Lambda.scoped_location
+
+  let make_prim p args = Lprim (p, args, Loc_unknown)
+
+  let make_offset arg n =
+    match n with
+    | 0 -> arg
+    | _ -> Lprim (Poffsetint n, [ arg ], Loc_unknown)
+
+  let bind arg body =
+    let newvar, newarg =
+      match arg with
+      | Lvar v -> (v, arg)
+      | _ ->
+          let newvar = Ident.create_local "switcher" in
+          (newvar, Lvar newvar)
+    in
+    bind Alias newvar arg (body newarg)
+
+  let make_const i = Lconst (Const_base (Const_int i))
+
+  let make_isout h arg = Lprim (Pisout, [ h; arg ], Loc_unknown)
+
+  let make_isin h arg = Lprim (Pnot, [ make_isout h arg ], Loc_unknown)
+
+  let make_if cond ifso ifnot = Lifthenelse (cond, ifso, ifnot)
+
+  let make_switch loc arg cases acts =
+    let l = ref [] in
+    for i = Array.length cases - 1 downto 0 do
+      l := (i, acts.(cases.(i))) :: !l
+    done;
+    Lswitch
+      ( arg,
+        { sw_numconsts = Array.length cases;
+          sw_consts = !l;
+          sw_numblocks = 0;
+          sw_blocks = [];
+          sw_failaction = None
+        },
+        loc )
+
+  let make_catch = make_catch_delayed
+
+  let make_exit = make_exit
+end
+
+(* Action sharing for Lswitch argument *)
+let share_actions_sw sw =
+  (* Attempt sharing on all actions *)
+  let store = StoreExp.mk_store () in
+  let fail =
+    match sw.sw_failaction with
+    | None -> None
+    | Some fail ->
+        (* Fail is translated to exit, whatever happens *)
+        Some (store.Switch.act_store_shared () fail)
+  in
+  let consts =
+    List.map (fun (i, e) -> (i, store.Switch.act_store () e)) sw.sw_consts
+  and blocks =
+    List.map (fun (i, e) -> (i, store.Switch.act_store () e)) sw.sw_blocks
+  in
+  let acts = store.Switch.act_get_shared () in
+  let hs, handle_shared = handle_shared () in
+  let acts = Array.map handle_shared acts in
+  let fail =
+    match fail with
+    | None -> None
+    | Some fail -> Some acts.(fail)
+  in
+  ( !hs,
+    { sw with
+      sw_consts = List.map (fun (i, j) -> (i, acts.(j))) consts;
+      sw_blocks = List.map (fun (i, j) -> (i, acts.(j))) blocks;
+      sw_failaction = fail
+    } )
+
+(* Reintroduce fail action in switch argument,
+   for the sake of avoiding carrying over huge switches *)
+
+let reintroduce_fail sw =
+  match sw.sw_failaction with
+  | None ->
+      let t = Hashtbl.create 17 in
+      let seen (_, l) =
+        match as_simple_exit l with
+        | Some i ->
+            let old = try Hashtbl.find t i with Not_found -> 0 in
+            Hashtbl.replace t i (old + 1)
+        | None -> ()
+      in
+      List.iter seen sw.sw_consts;
+      List.iter seen sw.sw_blocks;
+      let i_max = ref (-1) and max = ref (-1) in
+      Hashtbl.iter
+        (fun i c ->
+          if c > !max then (
+            i_max := i;
+            max := c
+          ))
+        t;
+      if !max >= 3 then
+        let default = !i_max in
+        let remove =
+          List.filter (fun (_, lam) ->
+              match as_simple_exit lam with
+              | Some j -> j <> default
+              | None -> true)
+        in
+        { sw with
+          sw_consts = remove sw.sw_consts;
+          sw_blocks = remove sw.sw_blocks;
+          sw_failaction = Some (make_exit default)
+        }
+      else
+        sw
+  | Some _ -> sw
+
+module Switcher = Switch.Make (SArg)
+open Switch
+
+let rec last def = function
+  | [] -> def
+  | [ (x, _) ] -> x
+  | _ :: rem -> last def rem
+
+let get_edges low high l =
+  match l with
+  | [] -> (low, high)
+  | (x, _) :: _ -> (x, last high l)
+
+let as_interval_canfail fail low high l =
+  let store = StoreExp.mk_store () in
+  let do_store _tag act =
+    let i = store.act_store () act in
+    (*
+    eprintf "STORE [%s] %i %s\n" tag i (string_of_lam act) ;
+*)
+    i
+  in
+  let rec nofail_rec cur_low cur_high cur_act = function
+    | [] ->
+        if cur_high = high then
+          [ (cur_low, cur_high, cur_act) ]
+        else
+          [ (cur_low, cur_high, cur_act); (cur_high + 1, high, 0) ]
+    | (i, act_i) :: rem as all ->
+        let act_index = do_store "NO" act_i in
+        if cur_high + 1 = i then
+          if act_index = cur_act then
+            nofail_rec cur_low i cur_act rem
+          else if act_index = 0 then
+            (cur_low, i - 1, cur_act) :: fail_rec i i rem
+          else
+            (cur_low, i - 1, cur_act) :: nofail_rec i i act_index rem
+        else if act_index = 0 then
+          (cur_low, cur_high, cur_act)
+          :: fail_rec (cur_high + 1) (cur_high + 1) all
+        else
+          (cur_low, cur_high, cur_act)
+          :: (cur_high + 1, i - 1, 0)
+          :: nofail_rec i i act_index rem
+  and fail_rec cur_low cur_high = function
+    | [] -> [ (cur_low, cur_high, 0) ]
+    | (i, act_i) :: rem ->
+        let index = do_store "YES" act_i in
+        if index = 0 then
+          fail_rec cur_low i rem
+        else
+          (cur_low, i - 1, 0) :: nofail_rec i i index rem
+  in
+  let init_rec = function
+    | [] -> [ (low, high, 0) ]
+    | (i, act_i) :: rem ->
+        let index = do_store "INIT" act_i in
+        if index = 0 then
+          fail_rec low i rem
+        else if low < i then
+          (low, i - 1, 0) :: nofail_rec i i index rem
+        else
+          nofail_rec i i index rem
+  in
+  assert (do_store "FAIL" fail = 0);
+
+  (* fail has action index 0 *)
+  let r = init_rec l in
+  (Array.of_list r, store)
+
+let as_interval_nofail l =
+  let store = StoreExp.mk_store () in
+  let rec some_hole = function
+    | []
+    | [ _ ] ->
+        false
+    | (i, _) :: ((j, _) :: _ as rem) -> j > i + 1 || some_hole rem
+  in
+  let rec i_rec cur_low cur_high cur_act = function
+    | [] -> [ (cur_low, cur_high, cur_act) ]
+    | (i, act) :: rem ->
+        let act_index = store.act_store () act in
+        if act_index = cur_act then
+          i_rec cur_low i cur_act rem
+        else
+          (cur_low, cur_high, cur_act) :: i_rec i i act_index rem
+  in
+  let inters =
+    match l with
+    | (i, act) :: rem ->
+        let act_index =
+          (* In case there is some hole and that a switch is emitted,
+             action 0 will be used as the action of unreachable
+             cases (cf. switch.ml, make_switch).
+             Hence, this action will be shared *)
+          if some_hole rem then
+            store.act_store_shared () act
+          else
+            store.act_store () act
+        in
+        assert (act_index = 0);
+        i_rec i i act_index rem
+    | _ -> assert false
+  in
+  (Array.of_list inters, store)
+
+let sort_int_lambda_list l =
+  List.sort
+    (fun (i1, _) (i2, _) ->
+      if i1 < i2 then
+        -1
+      else if i2 < i1 then
+        1
+      else
+        0)
+    l
+
+let as_interval fail low high l =
+  let l = sort_int_lambda_list l in
+  ( get_edges low high l,
+    match fail with
+    | None -> as_interval_nofail l
+    | Some act -> as_interval_canfail act low high l )
+
+let call_switcher loc fail arg low high int_lambda_list =
+  let edges, (cases, actions) = as_interval fail low high int_lambda_list in
+  Switcher.zyva loc edges arg cases actions
+
+let rec list_as_pat = function
+  | [] -> fatal_error "Matching.list_as_pat"
+  | [ pat ] -> pat
+  | pat :: rem -> { pat with pat_desc = Tpat_or (pat, list_as_pat rem, None) }
+
+let complete_pats_constrs = function
+  | p :: _ as pats ->
+      List.map (pat_of_constr p)
+        (complete_constrs p (List.map get_key_constr pats))
+  | _ -> assert false
+
+(*
+     Following two ``failaction'' function compute n, the trap handler
+    to jump to in case of failure of elementary tests
+*)
+
+let mk_failaction_neg partial ctx def =
+  match partial with
+  | Partial -> (
+      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 =
+  if dbg then (
+    Format.eprintf "**POS**\n";
+    Default_environment.pp defs;
+    ()
+  );
+  let rec scan_def env to_test defs =
+    match (to_test, Default_environment.pop defs) with
+    | [], _
+    | _, None ->
+        List.fold_left
+          (fun (klist, jumps) (pats, i) ->
+            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 ((pss, idef), 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 ((List.map fst now, idef) :: 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
+    if dbg then (
+      eprintf "POSITIVE JUMPS [%i]:\n" (List.length fail_pats);
+      Jumps.eprintf jmps
+    );
+    (None, fail, jmps)
+  ) else (
+    (* Too many non-matched constructors -> reduced information *)
+    if dbg then eprintf "POS->NEG!!!\n%!";
+    let fail, jumps = mk_failaction_neg partial ctx defs in
+    if dbg then
+      eprintf "FAIL: %s\n"
+        ( match fail with
+        | None -> ""
+        | Some lam -> string_of_lam lam
+        );
+    (fail, [], jumps)
+  )
+
+let combine_constant loc arg cst partial ctx def
+    (const_lambda_list, total, _pats) =
+  let fail, local_jumps = mk_failaction_neg partial ctx def in
+  let lambda1 =
+    match cst with
+    | Const_int _ ->
+        let int_lambda_list =
+          List.map
+            (function
+              | Const_int n, l -> (n, l)
+              | _ -> assert false)
+            const_lambda_list
+        in
+        call_switcher loc fail arg min_int max_int int_lambda_list
+    | Const_char _ ->
+        let int_lambda_list =
+          List.map
+            (function
+              | Const_char c, l -> (Char.code c, l)
+              | _ -> assert false)
+            const_lambda_list
+        in
+        call_switcher loc fail arg 0 255 int_lambda_list
+    | Const_string _ ->
+        (* Note as the bytecode compiler may resort to dichotomic search,
+   the clauses of stringswitch  are sorted with duplicates removed.
+   This partly applies to the native code compiler, which requires
+   no duplicates *)
+        let const_lambda_list = sort_lambda_list const_lambda_list in
+        let sw =
+          List.map
+            (fun (c, act) ->
+              match c with
+              | Const_string (s, _, _) -> (s, act)
+              | _ -> assert false)
+            const_lambda_list
+        in
+        let hs, sw, fail = share_actions_tree sw fail in
+        hs (Lstringswitch (arg, sw, fail, loc))
+    | Const_float _ ->
+        make_test_sequence loc fail (Pfloatcomp CFneq) (Pfloatcomp CFlt) arg
+          const_lambda_list
+    | Const_int32 _ ->
+        make_test_sequence loc fail
+          (Pbintcomp (Pint32, Cne))
+          (Pbintcomp (Pint32, Clt))
+          arg const_lambda_list
+    | Const_int64 _ ->
+        make_test_sequence loc fail
+          (Pbintcomp (Pint64, Cne))
+          (Pbintcomp (Pint64, Clt))
+          arg const_lambda_list
+    | Const_nativeint _ ->
+        make_test_sequence loc fail
+          (Pbintcomp (Pnativeint, Cne))
+          (Pbintcomp (Pnativeint, Clt))
+          arg const_lambda_list
+  in
+  (lambda1, Jumps.union local_jumps total)
+
+let split_cases tag_lambda_list =
+  let rec split_rec = function
+    | [] -> ([], [])
+    | (cstr, act) :: rem -> (
+        let consts, nonconsts = split_rec rem in
+        match cstr with
+        | Cstr_constant n -> ((n, act) :: consts, nonconsts)
+        | Cstr_block n -> (consts, (n, act) :: nonconsts)
+        | Cstr_unboxed -> (consts, (0, act) :: nonconsts)
+        | Cstr_extension _ -> assert false
+      )
+  in
+  let const, nonconst = split_rec tag_lambda_list in
+  (sort_int_lambda_list const, sort_int_lambda_list nonconst)
+
+let split_extension_cases tag_lambda_list =
+  let rec split_rec = function
+    | [] -> ([], [])
+    | (cstr, act) :: rem -> (
+        let consts, nonconsts = split_rec rem in
+        match cstr with
+        | Cstr_extension (path, true) -> ((path, act) :: consts, nonconsts)
+        | Cstr_extension (path, false) -> (consts, (path, act) :: nonconsts)
+        | _ -> assert false
+      )
+  in
+  split_rec tag_lambda_list
+
+let combine_constructor loc arg pat_env cstr partial ctx def
+    (tag_lambda_list, total1, pats) =
+  match cstr.cstr_tag with
+  | Cstr_extension _ ->
+      (* Special cases for extensions *)
+      let fail, local_jumps = mk_failaction_neg partial ctx def in
+      let lambda1 =
+        let consts, nonconsts = split_extension_cases tag_lambda_list in
+        let default, consts, nonconsts =
+          match fail with
+          | None -> (
+              match (consts, nonconsts) with
+              | _, (_, act) :: rem -> (act, consts, rem)
+              | (_, act) :: rem, _ -> (act, rem, nonconsts)
+              | _ -> assert false
+            )
+          | Some fail -> (fail, consts, nonconsts)
+        in
+        let nonconst_lambda =
+          match nonconsts with
+          | [] -> default
+          | _ ->
+              let tag = Ident.create_local "tag" in
+              let tests =
+                List.fold_right
+                  (fun (path, act) rem ->
+                    let ext = transl_extension_path loc pat_env path in
+                    Lifthenelse
+                      (Lprim (Pintcomp Ceq, [ Lvar tag; ext ], loc), act, rem))
+                  nonconsts default
+              in
+              Llet (Alias, Pgenval, tag, Lprim (Pfield 0, [ arg ], loc), tests)
+        in
+        List.fold_right
+          (fun (path, act) rem ->
+            let ext = transl_extension_path loc pat_env path in
+            Lifthenelse (Lprim (Pintcomp Ceq, [ arg; ext ], loc), act, rem))
+          consts nonconst_lambda
+      in
+      (lambda1, Jumps.union local_jumps total1)
+  | _ ->
+      (* Regular concrete type *)
+      let ncases = List.length tag_lambda_list
+      and nconstrs = cstr.cstr_consts + cstr.cstr_nonconsts in
+      let sig_complete = ncases = nconstrs in
+      let fail_opt, fails, local_jumps =
+        if sig_complete then
+          (None, [], Jumps.empty)
+        else
+          mk_failaction_pos partial pats ctx def
+      in
+      let tag_lambda_list = fails @ tag_lambda_list in
+      let consts, nonconsts = split_cases tag_lambda_list in
+      let lambda1 =
+        match (fail_opt, same_actions tag_lambda_list) with
+        | None, Some act -> act (* Identical actions, no failure *)
+        | _ -> (
+            match
+              (cstr.cstr_consts, cstr.cstr_nonconsts, consts, nonconsts)
+            with
+            | 1, 1, [ (0, act1) ], [ (0, act2) ] ->
+                (* Typically, match on lists, will avoid isint primitive in that
+              case *)
+                Lifthenelse (arg, act2, act1)
+            | n, 0, _, [] ->
+                (* The type defines constant constructors only *)
+                call_switcher loc fail_opt arg 0 (n - 1) consts
+            | n, _, _, _ -> (
+                let act0 =
+                  (* = Some act when all non-const constructors match to act *)
+                  match (fail_opt, nonconsts) with
+                  | Some a, [] -> Some a
+                  | Some _, _ ->
+                      if List.length nonconsts = cstr.cstr_nonconsts then
+                        same_actions nonconsts
+                      else
+                        None
+                  | None, _ -> same_actions nonconsts
+                in
+                match act0 with
+                | Some act ->
+                    Lifthenelse
+                      ( Lprim (Pisint, [ arg ], loc),
+                        call_switcher loc fail_opt arg 0 (n - 1) consts,
+                        act )
+                | None ->
+                    (* Emit a switch, as bytecode implements this sophisticated
+                      instruction *)
+                    let sw =
+                      { sw_numconsts = cstr.cstr_consts;
+                        sw_consts = consts;
+                        sw_numblocks = cstr.cstr_nonconsts;
+                        sw_blocks = nonconsts;
+                        sw_failaction = fail_opt
+                      }
+                    in
+                    let hs, sw = share_actions_sw sw in
+                    let sw = reintroduce_fail sw in
+                    hs (Lswitch (arg, sw, loc))
+              )
+          )
+      in
+      (lambda1, Jumps.union local_jumps total1)
+
+let make_test_sequence_variant_constant fail arg int_lambda_list =
+  let _, (cases, actions) = as_interval fail min_int max_int int_lambda_list in
+  Switcher.test_sequence arg cases actions
+
+let call_switcher_variant_constant loc fail arg int_lambda_list =
+  call_switcher loc fail arg min_int max_int int_lambda_list
+
+let call_switcher_variant_constr loc fail arg int_lambda_list =
+  let v = Ident.create_local "variant" in
+  Llet
+    ( Alias,
+      Pgenval,
+      v,
+      Lprim (Pfield 0, [ arg ], loc),
+      call_switcher loc fail (Lvar v) min_int max_int int_lambda_list )
+
+let combine_variant loc row arg partial ctx def (tag_lambda_list, total1, _pats)
+    =
+  let row = Btype.row_repr row in
+  let num_constr = ref 0 in
+  if row.row_closed then
+    List.iter
+      (fun (_, f) ->
+        match Btype.row_field_repr f with
+        | Rabsent
+        | Reither (true, _ :: _, _, _) ->
+            ()
+        | _ -> incr num_constr)
+      row.row_fields
+  else
+    num_constr := max_int;
+  let test_int_or_block arg if_int if_block =
+    Lifthenelse (Lprim (Pisint, [ arg ], loc), if_int, if_block)
+  in
+  let sig_complete = List.length tag_lambda_list = !num_constr
+  and one_action = same_actions tag_lambda_list in
+  let fail, local_jumps =
+    if
+      sig_complete
+      ||
+      match partial with
+      | Total -> true
+      | _ -> false
+    then
+      (None, Jumps.empty)
+    else
+      mk_failaction_neg partial ctx def
+  in
+  let consts, nonconsts = split_cases tag_lambda_list in
+  let lambda1 =
+    match (fail, one_action) with
+    | None, Some act -> act
+    | _, _ -> (
+        match (consts, nonconsts) with
+        | [ (_, act1) ], [ (_, act2) ] when fail = None ->
+            test_int_or_block arg act1 act2
+        | _, [] ->
+            (* One can compare integers and pointers *)
+            make_test_sequence_variant_constant fail arg consts
+        | [], _ -> (
+            let lam = call_switcher_variant_constr loc fail arg nonconsts in
+            (* One must not dereference integers *)
+            match fail with
+            | None -> lam
+            | Some fail -> test_int_or_block arg fail lam
+          )
+        | _, _ ->
+            let lam_const = call_switcher_variant_constant loc fail arg consts
+            and lam_nonconst =
+              call_switcher_variant_constr loc fail arg nonconsts
+            in
+            test_int_or_block arg lam_const lam_nonconst
+      )
+  in
+  (lambda1, Jumps.union local_jumps total1)
+
+let combine_array loc arg kind partial ctx def (len_lambda_list, total1, _pats)
+    =
+  let fail, local_jumps = mk_failaction_neg partial ctx def in
+  let lambda1 =
+    let newvar = Ident.create_local "len" in
+    let switch =
+      call_switcher loc fail (Lvar newvar) 0 max_int len_lambda_list
+    in
+    bind Alias newvar (Lprim (Parraylength kind, [ arg ], loc)) switch
+  in
+  (lambda1, Jumps.union local_jumps total1)
+
+(* Insertion of debugging events *)
+
+let rec event_branch repr lam =
+  match (lam, repr) with
+  | _, None -> lam
+  | Levent (lam', ev), Some r ->
+      incr r;
+      Levent
+        ( lam',
+          { lev_loc = ev.lev_loc;
+            lev_kind = ev.lev_kind;
+            lev_repr = repr;
+            lev_env = ev.lev_env
+          } )
+  | Llet (str, k, id, lam, body), _ ->
+      Llet (str, k, id, lam, event_branch repr body)
+  | Lstaticraise _, _ -> lam
+  | _, Some _ ->
+      Printlambda.lambda Format.str_formatter lam;
+      fatal_error ("Matching.event_branch: " ^ Format.flush_str_formatter ())
+
+(*
+   This exception is raised when the compiler cannot produce code
+   because control cannot reach the compiled clause,
+
+   Unused is raised initially in compile_test.
+
+   compile_list (for compiling switch results) catch Unused
+
+   comp_match_handlers (for compiling split matches)
+   may reraise Unused
+
+
+*)
+
+exception Unused
+
+let compile_list compile_fun division =
+  let rec c_rec totals = function
+    | [] -> ([], Jumps.unions totals, [])
+    | (key, cell) :: rem -> (
+        if Context.is_empty cell.ctx then
+          c_rec totals rem
+        else
+          try
+            let lambda1, total1 = compile_fun cell.ctx cell.pm in
+            let c_rem, total, new_discrs =
+              c_rec (Jumps.map Context.combine total1 :: totals) rem
+            in
+            ((key, lambda1) :: c_rem, total, cell.discr :: new_discrs)
+          with Unused -> c_rec totals rem
+      )
+  in
+  c_rec [] division
+
+let compile_orhandlers compile_fun lambda1 total1 ctx to_catch =
+  let rec do_rec r total_r = function
+    | [] -> (r, total_r)
+    | { provenance = mat; exit = i; vars; pm } :: rem -> (
+        try
+          let ctx = Context.select_columns mat ctx in
+          let handler_i, total_i = compile_fun ctx pm in
+          match raw_action r with
+          | Lstaticraise (j, args) ->
+              if i = j then
+                ( List.fold_right2
+                    (bind_with_value_kind Alias)
+                    vars args handler_i,
+                  Jumps.map (Context.rshift_num (ncols mat)) total_i )
+              else
+                do_rec r total_r rem
+          | _ ->
+              do_rec
+                (Lstaticcatch (r, (i, vars), handler_i))
+                (Jumps.union (Jumps.remove i total_r)
+                   (Jumps.map (Context.rshift_num (ncols mat)) total_i))
+                rem
+        with Unused ->
+          do_rec (Lstaticcatch (r, (i, vars), lambda_unit)) total_r rem
+      )
+  in
+  do_rec lambda1 total1 to_catch
+
+let compile_test compile_fun 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
+      | None, _ -> raise Unused
+      | Some l, total -> (l, total)
+    )
+  | _ -> combine ctx to_match.default c_div
+
+(* Attempt to avoid some useless bindings by lowering them *)
+
+(* Approximation of v present in lam *)
+let rec approx_present v = function
+  | Lconst _ -> false
+  | Lstaticraise (_, args) ->
+      List.exists (fun lam -> approx_present v lam) args
+  | Lprim (_, args, _) -> List.exists (fun lam -> approx_present v lam) args
+  | Llet (Alias, _k, _, l1, l2) -> approx_present v l1 || approx_present v l2
+  | Lvar vv -> Ident.same v vv
+  | _ -> true
+
+let rec lower_bind v arg lam =
+  match lam with
+  | Lifthenelse (cond, ifso, ifnot) -> (
+      let pcond = approx_present v cond
+      and pso = approx_present v ifso
+      and pnot = approx_present v ifnot in
+      match (pcond, pso, pnot) with
+      | false, false, false -> lam
+      | false, true, false -> Lifthenelse (cond, lower_bind v arg ifso, ifnot)
+      | false, false, true -> Lifthenelse (cond, ifso, lower_bind v arg ifnot)
+      | _, _, _ -> bind Alias v arg lam
+    )
+  | Lswitch (ls, ({ sw_consts = [ (i, act) ]; sw_blocks = [] } as sw), loc)
+    when not (approx_present v ls) ->
+      Lswitch (ls, { sw with sw_consts = [ (i, lower_bind v arg act) ] }, loc)
+  | Lswitch (ls, ({ sw_consts = []; sw_blocks = [ (i, act) ] } as sw), loc)
+    when not (approx_present v ls) ->
+      Lswitch (ls, { sw with sw_blocks = [ (i, lower_bind v arg act) ] }, loc)
+  | Llet (Alias, k, vv, lv, l) ->
+      if approx_present v lv then
+        bind Alias v arg lam
+      else
+        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
+  | 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"
+
+let rec comp_match_handlers comp_fun partial ctx first_match next_matchs =
+  match next_matchs with
+  | [] -> comp_fun partial ctx first_match
+  | rem -> (
+      let rec c_rec body total_body = function
+        | [] -> (body, total_body)
+        (* Hum, -1 means never taken
+        | (-1,pm)::rem -> c_rec body total_body rem *)
+        | (i, pm) :: rem -> (
+            let ctx_i, total_rem = Jumps.extract i total_body in
+            if Context.is_empty ctx_i then
+              c_rec body total_body rem
+            else
+              try
+                let li, total_i =
+                  comp_fun
+                    ( match rem with
+                    | [] -> partial
+                    | _ -> Partial
+                    )
+                    ctx_i pm
+                in
+                c_rec
+                  (Lstaticcatch (body, (i, []), li))
+                  (Jumps.union total_i total_rem)
+                  rem
+              with Unused ->
+                c_rec (Lstaticcatch (body, (i, []), lambda_unit)) total_rem rem
+          )
+      in
+      try
+        let first_lam, total = comp_fun Partial ctx first_match in
+        c_rec first_lam total rem
+      with Unused -> (
+        match next_matchs with
+        | [] -> raise Unused
+        | (_, x) :: xs -> comp_match_handlers comp_fun partial ctx x xs
+      )
+    )
+
+(* To find reasonable names for variables *)
+
+let rec name_pattern default = function
+  | ((pat, _), _) :: rem -> (
+      match pat.pat_desc with
+      | Tpat_var (id, _) -> id
+      | Tpat_alias (_, id, _) -> id
+      | _ -> name_pattern default rem
+    )
+  | _ -> Ident.create_local default
+
+let arg_to_var arg cls =
+  match arg with
+  | Lvar v -> (v, arg)
+  | _ ->
+      let v = name_pattern "*match*" cls in
+      (v, Lvar v)
+
+(*
+  The main compilation function.
+   Input:
+      repr=used for inserting debug events
+      partial=exhaustiveness information from Parmatch
+      ctx=a context
+      m=a pattern matching
+
+   Output: a lambda term, a jump summary {..., exit number -> context, .. }
+*)
+
+let rec compile_match ~scopes repr partial ctx
+    (m : initial_clause pattern_matching) =
+  match m.cases with
+  | ([], action) :: rem ->
+      if is_guarded action then
+        let lambda, total =
+          compile_match ~scopes None partial ctx { m with cases = rem }
+        in
+        (event_branch repr (patch_guarded lambda action), total)
+      else
+        (event_branch repr action, Jumps.empty)
+  | nonempty_cases ->
+      compile_match_nonempty ~scopes repr partial ctx
+        { m with cases = List.map Non_empty_clause.of_initial nonempty_cases }
+
+and compile_match_nonempty ~scopes repr partial ctx
+    (m : Typedtree.pattern Non_empty_clause.t 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:(Some v) m in
+      combine_handlers ~scopes repr partial ctx (v, str, arg) 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
+         do_compile_matching_pr ~scopes
+       else
+         do_compile_matching ~scopes
+       )
+         repr)
+      partial ctx first_match rem
+  in
+  (bind_check str v arg lam, total)
+
+(* verbose version of do_compile_matching, for debug *)
+and do_compile_matching_pr ~scopes repr partial ctx x =
+  Format.eprintf "COMPILE: %s\nMATCH\n"
+    ( match partial with
+    | Partial -> "Partial"
+    | Total -> "Total"
+    );
+  pretty_precompiled x;
+  Format.eprintf "CTX\n";
+  Context.eprintf ctx;
+  let ((_, jumps) as r) = do_compile_matching ~scopes repr partial ctx x in
+  Format.eprintf "JUMPS\n";
+  Jumps.eprintf jumps;
+  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
+      in
+      let ph = what_is_cases pm.cases in
+      let pomega = Pattern_head.to_omega_pattern ph in
+      let ploc = Pattern_head.loc ph in
+      match Pattern_head.desc ph with
+      | Any ->
+         compile_no_test ~scopes divide_var Context.rshift repr partial ctx pm
+      | Tuple l ->
+          compile_no_test ~scopes (divide_tuple ~scopes l pomega)
+            Context.combine repr partial ctx pm
+      | Record [] -> assert false
+      | Record (lbl :: _) ->
+          compile_no_test ~scopes
+            (divide_record ~scopes lbl.lbl_all pomega)
+            Context.combine repr partial ctx pm
+      | Constant cst ->
+          compile_test
+            (compile_match ~scopes repr partial)
+            partial divide_constant
+            (combine_constant (of_location ~scopes ploc) arg cst partial)
+            ctx pm
+      | Construct cstr ->
+          compile_test
+            (compile_match ~scopes repr partial)
+            partial (divide_constructor ~scopes)
+            (combine_constructor (of_location ~scopes ploc) arg
+               (Pattern_head.env ph) cstr partial)
+            ctx pm
+      | Array _ ->
+          let kind = Typeopt.array_pattern_kind pomega in
+          compile_test
+            (compile_match ~scopes repr partial)
+            partial (divide_array ~scopes kind)
+            (combine_array (of_location ~scopes ploc) arg kind partial)
+            ctx pm
+      | Lazy ->
+          compile_no_test ~scopes
+            (divide_lazy pomega)
+            Context.combine repr partial ctx pm
+      | Variant { cstr_row = row } ->
+          compile_test
+            (compile_match ~scopes repr partial)
+            partial (divide_variant ~scopes !row)
+            (combine_variant (of_location ~scopes ploc) !row arg partial)
+            ctx pm
+    )
+  | PmVar { inside = pmh } ->
+      let lam, total =
+        do_compile_matching ~scopes repr partial (Context.lshift ctx) pmh
+      in
+      (lam, Jumps.map Context.rshift total)
+  | PmOr { body; handlers } ->
+      let lam, total =
+        compile_match_simplified ~scopes repr partial ctx body in
+      compile_orhandlers (compile_match ~scopes repr partial)
+        lam total ctx handlers
+
+and compile_no_test ~scopes divide up_ctx repr partial ctx to_match =
+  let { pm = this_match; ctx = this_ctx } = divide ctx to_match in
+  let lambda, total =
+    compile_match ~scopes repr partial this_ctx this_match in
+  (lambda, Jumps.map up_ctx total)
+
+(* 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 *)
+
+let check_total total lambda i handler_fun =
+  if Jumps.is_empty total then
+    lambda
+  else
+    Lstaticcatch (lambda, (i, []), handler_fun ())
+
+let compile_matching ~scopes repr handler_fun arg pat_act_list partial =
+  let partial = check_partial pat_act_list partial in
+  match partial with
+  | Partial -> (
+      let raise_num = next_raise_count () in
+      let pm =
+        { cases = List.map (fun (pat, act) -> ([ pat ], act)) pat_act_list;
+          args = [ (arg, Strict) ];
+          default = Default_environment.(cons [ [ omega ] ] raise_num empty)
+        }
+      in
+      try
+        let lambda, total =
+          compile_match ~scopes repr partial (Context.start 1) pm in
+        check_total total lambda raise_num handler_fun
+      with Unused -> assert false
+      (* ; handler_fun() *)
+    )
+  | Total ->
+      let pm =
+        { cases = List.map (fun (pat, act) -> ([ pat ], act)) pat_act_list;
+          args = [ (arg, Strict) ];
+          default = Default_environment.empty
+        }
+      in
+      let lambda, total =
+        compile_match ~scopes repr partial (Context.start 1) pm in
+      assert (Jumps.is_empty total);
+      lambda
+
+let partial_function ~scopes loc () =
+  let sloc = of_location ~scopes loc in
+  let slot =
+    transl_extension_path sloc Env.initial_safe_string Predef.path_match_failure
+  in
+  let fname, line, char =
+    Location.get_pos_info loc.Location.loc_start in
+  Lprim
+    ( Praise Raise_regular,
+      [ Lprim
+          ( Pmakeblock (0, Immutable, None),
+            [ slot;
+              Lconst
+                (Const_block
+                   ( 0,
+                     [ Const_base (Const_string (fname, loc, None));
+                       Const_base (Const_int line);
+                       Const_base (Const_int char)
+                     ] ))
+            ],
+            sloc )
+      ],
+      sloc )
+
+let for_function ~scopes loc repr param pat_act_list partial =
+  let f () = partial_function ~scopes loc () in
+  compile_matching ~scopes repr f param pat_act_list partial
+
+(* In the following two cases, exhaustiveness info is not available! *)
+let for_trywith ~scopes param pat_act_list =
+  compile_matching ~scopes None
+    (fun () -> Lprim (Praise Raise_reraise, [ param ], Loc_unknown))
+    param pat_act_list Partial
+
+let simple_for_let ~scopes loc param pat body =
+  compile_matching ~scopes None (partial_function ~scopes loc)
+    param [ (pat, body) ] Partial
+
+(* Optimize binding of immediate tuples
+
+   The goal of the implementation of 'for_let' below, which replaces
+   'simple_for_let', is to avoid tuple allocation in cases such as
+   this one:
+
+     let (x,y) =
+        let foo = ... in
+        if foo then (1, 2) else (3,4)
+     in bar
+
+   The compiler easily optimizes the simple `let (x,y) = (1,2) in ...`
+   case (call to Matching.for_multiple_match from Translcore), but
+   didn't optimize situations where the rhs tuples are hidden under
+   a more complex context.
+
+   The idea comes from Alain Frisch who suggested and implemented
+   the following compilation method, based on Lassign:
+
+     let x = dummy in let y = dummy in
+     begin
+      let foo = ... in
+      if foo then
+        (let x1 = 1 in let y1 = 2 in x <- x1; y <- y1)
+      else
+        (let x2 = 3 in let y2 = 4 in x <- x2; y <- y2)
+     end;
+     bar
+
+   The current implementation from Gabriel Scherer uses Lstaticcatch /
+   Lstaticraise instead:
+
+     catch
+       let foo = ... in
+       if foo then
+         (let x1 = 1 in let y1 = 2 in exit x1 y1)
+       else
+        (let x2 = 3 in let y2 = 4 in exit x2 y2)
+     with x y ->
+       bar
+
+   The catch/exit is used to avoid duplication of the let body ('bar'
+   in the example), on 'if' branches for example; it is useless for
+   linear contexts such as 'let', but we don't need to be careful to
+   generate nice code because Simplif will remove such useless
+   catch/exit.
+*)
+
+let rec map_return f = function
+  | Llet (str, k, id, l1, l2) -> Llet (str, k, id, l1, map_return f l2)
+  | Lletrec (l1, l2) -> Lletrec (l1, map_return f l2)
+  | Lifthenelse (lcond, lthen, lelse) ->
+      Lifthenelse (lcond, map_return f lthen, map_return f lelse)
+  | Lsequence (l1, l2) -> Lsequence (l1, map_return f l2)
+  | Levent (l, ev) -> Levent (map_return f l, ev)
+  | Ltrywith (l1, id, l2) -> Ltrywith (map_return f l1, id, map_return f l2)
+  | Lstaticcatch (l1, b, l2) ->
+      Lstaticcatch (map_return f l1, b, map_return f l2)
+  | Lswitch (s, sw, loc) ->
+      let map_cases cases =
+        List.map (fun (i, l) -> (i, map_return f l)) cases
+      in
+      Lswitch
+        ( s,
+          { sw with
+            sw_consts = map_cases sw.sw_consts;
+            sw_blocks = map_cases sw.sw_blocks;
+            sw_failaction = Option.map (map_return f) sw.sw_failaction
+          },
+          loc )
+  | Lstringswitch (s, cases, def, loc) ->
+      Lstringswitch
+        ( s,
+          List.map (fun (s, l) -> (s, map_return f l)) cases,
+          Option.map (map_return f) def,
+          loc )
+  | (Lstaticraise _ | Lprim (Praise _, _, _)) as l -> l
+  | ( Lvar _ | Lconst _ | Lapply _ | Lfunction _ | Lsend _ | Lprim _ | Lwhile _
+    | Lfor _ | Lassign _ | Lifused _ ) as l ->
+      f l
+
+(* The 'opt' reference indicates if the optimization is worthy.
+
+   It is shared by the different calls to 'assign_pat' performed from
+   'map_return'. For example with the code
+     let (x, y) = if foo then z else (1,2)
+   the else-branch will activate the optimization for both branches.
+
+   That means that the optimization is activated if *there exists* an
+   interesting tuple in one hole of the let-rhs context. We could
+   choose to activate it only if *all* holes are interesting. We made
+   that choice because being optimistic is extremely cheap (one static
+   exit/catch overhead in the "wrong cases"), while being pessimistic
+   can be costly (one unnecessary tuple allocation).
+*)
+
+let assign_pat ~scopes opt nraise catch_ids loc pat lam =
+  let rec collect acc pat lam =
+    match (pat.pat_desc, lam) with
+    | Tpat_tuple patl, Lprim (Pmakeblock _, lams, _) ->
+        opt := true;
+        List.fold_left2 collect acc patl lams
+    | Tpat_tuple patl, Lconst (Const_block (_, scl)) ->
+        opt := true;
+        let collect_const acc pat sc = collect acc pat (Lconst sc) in
+        List.fold_left2 collect_const acc patl scl
+    | _ ->
+        (* pattern idents will be bound in staticcatch (let body), so we
+           refresh them here to guarantee binders uniqueness *)
+        let pat_ids = pat_bound_idents pat in
+        let fresh_ids = List.map (fun id -> (id, Ident.rename id)) pat_ids in
+        (fresh_ids, alpha_pat fresh_ids pat, lam) :: acc
+  in
+  (* sublets were accumulated by 'collect' with the leftmost tuple
+     pattern at the bottom of the list; to respect right-to-left
+     evaluation order for tuples, we must evaluate sublets
+     top-to-bottom. To preserve tail-rec, we will fold_left the
+     reversed list. *)
+  let rev_sublets = List.rev (collect [] pat lam) in
+  let exit =
+    (* build an Ident.tbl to avoid quadratic refreshing costs *)
+    let add t (id, fresh_id) = Ident.add id fresh_id t in
+    let add_ids acc (ids, _pat, _lam) = List.fold_left add acc ids in
+    let tbl = List.fold_left add_ids Ident.empty rev_sublets in
+    let fresh_var id = Lvar (Ident.find_same id tbl) in
+    Lstaticraise (nraise, List.map fresh_var catch_ids)
+  in
+  let push_sublet code (_ids, pat, lam) =
+    simple_for_let ~scopes loc lam pat code in
+  List.fold_left push_sublet exit rev_sublets
+
+let for_let ~scopes loc param pat body =
+  match pat.pat_desc with
+  | Tpat_any ->
+      (* This eliminates a useless variable (and stack slot in bytecode)
+         for "let _ = ...". See #6865. *)
+      Lsequence (param, body)
+  | Tpat_var (id, _) ->
+      (* fast path, and keep track of simple bindings to unboxable numbers *)
+      let k = Typeopt.value_kind pat.pat_env pat.pat_type in
+      Llet (Strict, k, id, param, body)
+  | _ ->
+      let opt = ref false in
+      let nraise = next_raise_count () in
+      let catch_ids = pat_bound_idents_full pat in
+      let ids_with_kinds =
+        List.map
+          (fun (id, _, typ) -> (id, Typeopt.value_kind pat.pat_env typ))
+          catch_ids
+      in
+      let ids = List.map (fun (id, _, _) -> id) catch_ids in
+      let bind =
+        map_return (assign_pat ~scopes opt nraise ids loc pat) param in
+      if !opt then
+        Lstaticcatch (bind, (nraise, ids_with_kinds), body)
+      else
+        simple_for_let ~scopes loc param pat body
+
+(* Handling of tupled functions and matchings *)
+
+(* 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 raise_num = next_raise_count () in
+  let omegas = [ List.map (fun _ -> omega) paraml ] in
+  let pm =
+    { cases = pats_act_list;
+      args = List.map (fun id -> (Lvar id, Strict)) paraml;
+      default = Default_environment.(cons omegas raise_num empty)
+    }
+  in
+  try
+    let lambda, total =
+      compile_match ~scopes None partial
+        (Context.start (List.length paraml)) pm
+    in
+    check_total total lambda raise_num (partial_function ~scopes loc)
+  with Unused -> partial_function ~scopes loc ()
+
+let flatten_pattern size p =
+  match p.pat_desc with
+  | Tpat_tuple args -> args
+  | Tpat_any -> omegas size
+  | _ -> raise Cannot_flatten
+
+let flatten_cases size cases =
+  List.map
+    (function
+      | (p, []), action -> (
+          match flatten_pattern size (General.erase p) with
+          | p :: ps -> ((p, ps), action)
+          | [] -> assert false
+        )
+      | _ -> fatal_error "Matching.flatten_hc_cases")
+    cases
+
+let flatten_pm size args pm =
+  { args;
+    cases = flatten_cases size pm.cases;
+    default = Default_environment.flatten size pm.default
+  }
+
+let flatten_handler size handler =
+  { handler with provenance = flatten_matrix size handler.provenance }
+
+type pm_flattened =
+  | FPmOr of pattern pm_or_compiled
+  | FPm of pattern Non_empty_clause.t pattern_matching
+
+let flatten_precompiled size args pmh =
+  match pmh with
+  | Pm pm -> FPm (flatten_pm size args pm)
+  | PmOr { body = b; handlers = hs; or_matrix = m } ->
+      FPmOr
+        { body = flatten_pm size args b;
+          handlers = List.map (flatten_handler size) hs;
+          or_matrix = flatten_matrix size m
+        }
+  | PmVar _ -> assert false
+
+(*
+   compiled_flattened is a ``comp_fun'' argument to comp_match_handlers.
+   Hence it needs a fourth argument, which it ignores
+*)
+
+let compile_flattened ~scopes repr partial ctx pmh =
+  match pmh with
+  | FPm pm -> compile_match_nonempty ~scopes repr partial ctx pm
+  | FPmOr { body = b; handlers = hs } ->
+      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 repr = None in
+  let partial = check_partial pat_act_list partial in
+  let raise_num, arg, pm1 =
+    let raise_num, default =
+      match partial with
+      | Partial ->
+          let raise_num = next_raise_count () in
+          (raise_num, Default_environment.(cons [ [ omega ] ] raise_num empty))
+      | Total -> (-1, Default_environment.empty)
+    in
+    let loc = of_location ~scopes loc in
+    let arg = Lprim (Pmakeblock (0, Immutable, None), paraml, loc) in
+    ( raise_num,
+      arg,
+      { cases = List.map (fun (pat, act) -> ([ pat ], act)) pat_act_list;
+        args = [ (arg, Strict) ];
+        default
+      } )
+  in
+  try
+    try
+      (* Once for checking that compilation is possible *)
+      let next, nexts =
+        split_and_precompile ~arg_id:None ~arg_lambda:arg pm1
+      in
+      let size = List.length paraml
+      and idl = List.map (fun _ -> Ident.create_local "*match*") paraml in
+      let args = List.map (fun id -> (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
+        ( match partial with
+        | Partial ->
+            check_total total lam raise_num (partial_function ~scopes loc)
+        | Total ->
+            assert (Jumps.is_empty total);
+            lam
+        )
+    with Cannot_flatten -> (
+      let lambda, total =
+        compile_match ~scopes None partial (Context.start 1) pm1 in
+      match partial with
+      | Partial ->
+          check_total total lambda raise_num (partial_function ~scopes loc)
+      | Total ->
+          assert (Jumps.is_empty total);
+          lambda
+    )
+  with Unused -> assert false
+
+(* ; partial_function loc () *)
+
+(* PR#4828: Believe it or not, the 'paraml' argument below
+   may not be side effect free. *)
+
+let param_to_var param =
+  match param with
+  | Lvar v -> (v, None)
+  | _ -> (Ident.create_local "*match*", Some param)
+
+let bind_opt (v, eo) k =
+  match eo with
+  | None -> k
+  | Some e -> Lambda.bind Strict v e 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
+  List.fold_right bind_opt v_paraml
+    (do_for_multiple_match ~scopes loc paraml pat_act_list partial)
diff --git a/lambda/matching.mli b/lambda/matching.mli
new file mode 100644
index 00000000..7b41a713
--- /dev/null
+++ b/lambda/matching.mli
@@ -0,0 +1,54 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Compilation of pattern-matching *)
+
+open Typedtree
+open Lambda
+open Debuginfo.Scoped_location
+
+(* Entry points to match compiler *)
+val for_function:
+        scopes:scopes -> Location.t ->
+        int ref option -> lambda -> (pattern * lambda) list -> partial ->
+        lambda
+val for_trywith:
+        scopes:scopes ->
+        lambda -> (pattern * lambda) list ->
+        lambda
+val for_let:
+        scopes:scopes -> Location.t ->
+        lambda -> pattern -> lambda ->
+        lambda
+val for_multiple_match:
+        scopes:scopes -> Location.t ->
+        lambda list -> (pattern * lambda) list -> partial ->
+        lambda
+
+val for_tupled_function:
+        scopes:scopes -> Location.t ->
+        Ident.t list -> (pattern list * lambda) list -> partial ->
+        lambda
+
+exception Cannot_flatten
+
+val flatten_pattern: int -> pattern -> pattern list
+
+(* Expand stringswitch to  string test tree *)
+val expand_stringswitch:
+    scoped_location -> lambda -> (string * lambda) list ->
+    lambda option -> lambda
+
+val inline_lazy_force : lambda -> scoped_location -> lambda
diff --git a/lambda/printlambda.ml b/lambda/printlambda.ml
new file mode 100644
index 00000000..87340608
--- /dev/null
+++ b/lambda/printlambda.ml
@@ -0,0 +1,667 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Format
+open Asttypes
+open Primitive
+open Types
+open Lambda
+
+
+let rec struct_const ppf = function
+  | Const_base(Const_int n) -> fprintf ppf "%i" n
+  | Const_base(Const_char c) -> fprintf ppf "%C" c
+  | Const_base(Const_string (s, _, _)) -> fprintf ppf "%S" s
+  | Const_immstring s -> fprintf ppf "#%S" s
+  | Const_base(Const_float f) -> fprintf ppf "%s" f
+  | Const_base(Const_int32 n) -> fprintf ppf "%lil" n
+  | Const_base(Const_int64 n) -> fprintf ppf "%LiL" n
+  | Const_base(Const_nativeint n) -> fprintf ppf "%nin" n
+  | Const_pointer n -> fprintf ppf "%ia" n
+  | Const_block(tag, []) ->
+      fprintf ppf "[%i]" tag
+  | Const_block(tag, sc1::scl) ->
+      let sconsts ppf scl =
+        List.iter (fun sc -> fprintf ppf "@ %a" struct_const sc) scl in
+      fprintf ppf "@[<1>[%i:@ @[%a%a@]]@]" tag struct_const sc1 sconsts scl
+  | Const_float_array [] ->
+      fprintf ppf "[| |]"
+  | Const_float_array (f1 :: fl) ->
+      let floats ppf fl =
+        List.iter (fun f -> fprintf ppf "@ %s" f) fl in
+      fprintf ppf "@[<1>[|@[%s%a@]|]@]" f1 floats fl
+
+let array_kind = function
+  | Pgenarray -> "gen"
+  | Paddrarray -> "addr"
+  | Pintarray -> "int"
+  | Pfloatarray -> "float"
+
+let boxed_integer_name = function
+  | Pnativeint -> "nativeint"
+  | Pint32 -> "int32"
+  | Pint64 -> "int64"
+
+let value_kind ppf = function
+  | Pgenval -> ()
+  | Pintval -> fprintf ppf "[int]"
+  | Pfloatval -> fprintf ppf "[float]"
+  | Pboxedintval bi -> fprintf ppf "[%s]" (boxed_integer_name bi)
+
+let return_kind ppf = function
+  | Pgenval -> ()
+  | Pintval -> fprintf ppf ": int@ "
+  | Pfloatval -> fprintf ppf ": float@ "
+  | Pboxedintval bi -> fprintf ppf ": %s@ " (boxed_integer_name bi)
+
+let field_kind = function
+  | Pgenval -> "*"
+  | Pintval -> "int"
+  | Pfloatval -> "float"
+  | Pboxedintval bi -> boxed_integer_name bi
+
+let print_boxed_integer_conversion ppf bi1 bi2 =
+  fprintf ppf "%s_of_%s" (boxed_integer_name bi2) (boxed_integer_name bi1)
+
+let boxed_integer_mark name = function
+  | Pnativeint -> Printf.sprintf "Nativeint.%s" name
+  | Pint32 -> Printf.sprintf "Int32.%s" name
+  | Pint64 -> Printf.sprintf "Int64.%s" name
+
+let print_boxed_integer name ppf bi =
+  fprintf ppf "%s" (boxed_integer_mark name bi);;
+
+let print_bigarray name unsafe kind ppf layout =
+  fprintf ppf "Bigarray.%s[%s,%s]"
+    (if unsafe then "unsafe_"^ name else name)
+    (match kind with
+     | Pbigarray_unknown -> "generic"
+     | Pbigarray_float32 -> "float32"
+     | Pbigarray_float64 -> "float64"
+     | Pbigarray_sint8 -> "sint8"
+     | Pbigarray_uint8 -> "uint8"
+     | Pbigarray_sint16 -> "sint16"
+     | Pbigarray_uint16 -> "uint16"
+     | Pbigarray_int32 -> "int32"
+     | Pbigarray_int64 -> "int64"
+     | Pbigarray_caml_int -> "camlint"
+     | Pbigarray_native_int -> "nativeint"
+     | Pbigarray_complex32 -> "complex32"
+     | Pbigarray_complex64 -> "complex64")
+    (match layout with
+    |  Pbigarray_unknown_layout -> "unknown"
+     | Pbigarray_c_layout -> "C"
+     | Pbigarray_fortran_layout -> "Fortran")
+
+let record_rep ppf r =
+  match r with
+  | Record_regular -> fprintf ppf "regular"
+  | Record_inlined i -> fprintf ppf "inlined(%i)" i
+  | Record_unboxed false -> fprintf ppf "unboxed"
+  | Record_unboxed true -> fprintf ppf "inlined(unboxed)"
+  | Record_float -> fprintf ppf "float"
+  | Record_extension path -> fprintf ppf "ext(%a)" Printtyp.path path
+;;
+
+let block_shape ppf shape = match shape with
+  | None | Some [] -> ()
+  | Some l when List.for_all ((=) Pgenval) l -> ()
+  | Some [elt] ->
+      Format.fprintf ppf " (%s)" (field_kind elt)
+  | Some (h :: t) ->
+      Format.fprintf ppf " (%s" (field_kind h);
+      List.iter (fun elt ->
+          Format.fprintf ppf ",%s" (field_kind elt))
+        t;
+      Format.fprintf ppf ")"
+
+let integer_comparison ppf = function
+  | Ceq -> fprintf ppf "=="
+  | Cne -> fprintf ppf "!="
+  | Clt -> fprintf ppf "<"
+  | Cle -> fprintf ppf "<="
+  | Cgt -> fprintf ppf ">"
+  | Cge -> fprintf ppf ">="
+
+let float_comparison ppf = function
+  | CFeq -> fprintf ppf "==."
+  | CFneq -> fprintf ppf "!=."
+  | CFlt -> fprintf ppf "<."
+  | CFnlt -> fprintf ppf "!<."
+  | CFle -> fprintf ppf "<=."
+  | CFnle -> fprintf ppf "!<=."
+  | CFgt -> fprintf ppf ">."
+  | CFngt -> fprintf ppf "!>."
+  | CFge -> fprintf ppf ">=."
+  | CFnge -> fprintf ppf "!>=."
+
+let primitive ppf = function
+  | Pidentity -> fprintf ppf "id"
+  | Pbytes_to_string -> fprintf ppf "bytes_to_string"
+  | Pbytes_of_string -> fprintf ppf "bytes_of_string"
+  | Pignore -> fprintf ppf "ignore"
+  | Prevapply -> fprintf ppf "revapply"
+  | Pdirapply -> fprintf ppf "dirapply"
+  | Pgetglobal id -> fprintf ppf "global %a" Ident.print id
+  | Psetglobal id -> fprintf ppf "setglobal %a" Ident.print id
+  | Pmakeblock(tag, Immutable, shape) ->
+      fprintf ppf "makeblock %i%a" tag block_shape shape
+  | Pmakeblock(tag, Mutable, shape) ->
+      fprintf ppf "makemutable %i%a" tag block_shape shape
+  | Pfield n -> fprintf ppf "field %i" n
+  | Pfield_computed -> fprintf ppf "field_computed"
+  | Psetfield(n, ptr, init) ->
+      let instr =
+        match ptr with
+        | Pointer -> "ptr"
+        | Immediate -> "imm"
+      in
+      let init =
+        match init with
+        | Heap_initialization -> "(heap-init)"
+        | Root_initialization -> "(root-init)"
+        | Assignment -> ""
+      in
+      fprintf ppf "setfield_%s%s %i" instr init n
+  | Psetfield_computed (ptr, init) ->
+      let instr =
+        match ptr with
+        | Pointer -> "ptr"
+        | Immediate -> "imm"
+      in
+      let init =
+        match init with
+        | Heap_initialization -> "(heap-init)"
+        | Root_initialization -> "(root-init)"
+        | Assignment -> ""
+      in
+      fprintf ppf "setfield_%s%s_computed" instr init
+  | Pfloatfield n -> fprintf ppf "floatfield %i" n
+  | Psetfloatfield (n, init) ->
+      let init =
+        match init with
+        | Heap_initialization -> "(heap-init)"
+        | Root_initialization -> "(root-init)"
+        | Assignment -> ""
+      in
+      fprintf ppf "setfloatfield%s %i" init n
+  | Pduprecord (rep, size) -> fprintf ppf "duprecord %a %i" record_rep rep size
+  | Pccall p -> fprintf ppf "%s" p.prim_name
+  | Praise k -> fprintf ppf "%s" (Lambda.raise_kind k)
+  | Psequand -> fprintf ppf "&&"
+  | Psequor -> fprintf ppf "||"
+  | Pnot -> fprintf ppf "not"
+  | Pnegint -> fprintf ppf "~"
+  | Paddint -> fprintf ppf "+"
+  | Psubint -> fprintf ppf "-"
+  | Pmulint -> fprintf ppf "*"
+  | Pdivint Safe -> fprintf ppf "/"
+  | Pdivint Unsafe -> fprintf ppf "/u"
+  | Pmodint Safe -> fprintf ppf "mod"
+  | Pmodint Unsafe -> fprintf ppf "mod_unsafe"
+  | Pandint -> fprintf ppf "and"
+  | Porint -> fprintf ppf "or"
+  | Pxorint -> fprintf ppf "xor"
+  | Plslint -> fprintf ppf "lsl"
+  | Plsrint -> fprintf ppf "lsr"
+  | Pasrint -> fprintf ppf "asr"
+  | Pintcomp(cmp) -> integer_comparison ppf cmp
+  | Pcompare_ints -> fprintf ppf "compare_ints"
+  | Pcompare_floats -> fprintf ppf "compare_floats"
+  | Pcompare_bints bi -> fprintf ppf "compare_bints %s" (boxed_integer_name bi)
+  | Poffsetint n -> fprintf ppf "%i+" n
+  | Poffsetref n -> fprintf ppf "+:=%i"n
+  | Pintoffloat -> fprintf ppf "int_of_float"
+  | Pfloatofint -> fprintf ppf "float_of_int"
+  | Pnegfloat -> fprintf ppf "~."
+  | Pabsfloat -> fprintf ppf "abs."
+  | Paddfloat -> fprintf ppf "+."
+  | Psubfloat -> fprintf ppf "-."
+  | Pmulfloat -> fprintf ppf "*."
+  | Pdivfloat -> fprintf ppf "/."
+  | Pfloatcomp(cmp) -> float_comparison ppf cmp
+  | Pstringlength -> fprintf ppf "string.length"
+  | Pstringrefu -> fprintf ppf "string.unsafe_get"
+  | Pstringrefs -> fprintf ppf "string.get"
+  | Pbyteslength -> fprintf ppf "bytes.length"
+  | Pbytesrefu -> fprintf ppf "bytes.unsafe_get"
+  | Pbytessetu -> fprintf ppf "bytes.unsafe_set"
+  | Pbytesrefs -> fprintf ppf "bytes.get"
+  | Pbytessets -> fprintf ppf "bytes.set"
+
+  | Parraylength k -> fprintf ppf "array.length[%s]" (array_kind k)
+  | Pmakearray (k, Mutable) -> fprintf ppf "makearray[%s]" (array_kind k)
+  | Pmakearray (k, Immutable) -> fprintf ppf "makearray_imm[%s]" (array_kind k)
+  | Pduparray (k, Mutable) -> fprintf ppf "duparray[%s]" (array_kind k)
+  | Pduparray (k, Immutable) -> fprintf ppf "duparray_imm[%s]" (array_kind k)
+  | Parrayrefu k -> fprintf ppf "array.unsafe_get[%s]" (array_kind k)
+  | Parraysetu k -> fprintf ppf "array.unsafe_set[%s]" (array_kind k)
+  | Parrayrefs k -> fprintf ppf "array.get[%s]" (array_kind k)
+  | Parraysets k -> fprintf ppf "array.set[%s]" (array_kind k)
+  | Pctconst c ->
+     let const_name = match c with
+       | Big_endian -> "big_endian"
+       | Word_size -> "word_size"
+       | Int_size -> "int_size"
+       | Max_wosize -> "max_wosize"
+       | Ostype_unix -> "ostype_unix"
+       | Ostype_win32 -> "ostype_win32"
+       | Ostype_cygwin -> "ostype_cygwin"
+       | Backend_type -> "backend_type" in
+     fprintf ppf "sys.constant_%s" const_name
+  | Pisint -> fprintf ppf "isint"
+  | Pisout -> fprintf ppf "isout"
+  | Pbintofint bi -> print_boxed_integer "of_int" ppf bi
+  | Pintofbint bi -> print_boxed_integer "to_int" ppf bi
+  | Pcvtbint (bi1, bi2) -> print_boxed_integer_conversion ppf bi1 bi2
+  | Pnegbint bi -> print_boxed_integer "neg" ppf bi
+  | Paddbint bi -> print_boxed_integer "add" ppf bi
+  | Psubbint bi -> print_boxed_integer "sub" ppf bi
+  | Pmulbint bi -> print_boxed_integer "mul" ppf bi
+  | Pdivbint { size = bi; is_safe = Safe } ->
+      print_boxed_integer "div" ppf bi
+  | Pdivbint { size = bi; is_safe = Unsafe } ->
+      print_boxed_integer "div_unsafe" ppf bi
+  | Pmodbint { size = bi; is_safe = Safe } ->
+      print_boxed_integer "mod" ppf bi
+  | Pmodbint { size = bi; is_safe = Unsafe } ->
+      print_boxed_integer "mod_unsafe" ppf bi
+  | Pandbint bi -> print_boxed_integer "and" ppf bi
+  | Porbint bi -> print_boxed_integer "or" ppf bi
+  | Pxorbint bi -> print_boxed_integer "xor" ppf bi
+  | Plslbint bi -> print_boxed_integer "lsl" ppf bi
+  | Plsrbint bi -> print_boxed_integer "lsr" ppf bi
+  | Pasrbint bi -> print_boxed_integer "asr" ppf bi
+  | Pbintcomp(bi, Ceq) -> print_boxed_integer "==" ppf bi
+  | Pbintcomp(bi, Cne) -> print_boxed_integer "!=" ppf bi
+  | Pbintcomp(bi, Clt) -> print_boxed_integer "<" ppf bi
+  | Pbintcomp(bi, Cgt) -> print_boxed_integer ">" ppf bi
+  | Pbintcomp(bi, Cle) -> print_boxed_integer "<=" ppf bi
+  | Pbintcomp(bi, Cge) -> print_boxed_integer ">=" ppf bi
+  | Pbigarrayref(unsafe, _n, kind, layout) ->
+      print_bigarray "get" unsafe kind ppf layout
+  | Pbigarrayset(unsafe, _n, kind, layout) ->
+      print_bigarray "set" unsafe kind ppf layout
+  | Pbigarraydim(n) -> fprintf ppf "Bigarray.dim_%i" n
+  | Pstring_load_16(unsafe) ->
+     if unsafe then fprintf ppf "string.unsafe_get16"
+     else fprintf ppf "string.get16"
+  | Pstring_load_32(unsafe) ->
+     if unsafe then fprintf ppf "string.unsafe_get32"
+     else fprintf ppf "string.get32"
+  | Pstring_load_64(unsafe) ->
+     if unsafe then fprintf ppf "string.unsafe_get64"
+     else fprintf ppf "string.get64"
+  | Pbytes_load_16(unsafe) ->
+     if unsafe then fprintf ppf "bytes.unsafe_get16"
+     else fprintf ppf "bytes.get16"
+  | Pbytes_load_32(unsafe) ->
+     if unsafe then fprintf ppf "bytes.unsafe_get32"
+     else fprintf ppf "bytes.get32"
+  | Pbytes_load_64(unsafe) ->
+     if unsafe then fprintf ppf "bytes.unsafe_get64"
+     else fprintf ppf "bytes.get64"
+  | Pbytes_set_16(unsafe) ->
+     if unsafe then fprintf ppf "bytes.unsafe_set16"
+     else fprintf ppf "bytes.set16"
+  | Pbytes_set_32(unsafe) ->
+     if unsafe then fprintf ppf "bytes.unsafe_set32"
+     else fprintf ppf "bytes.set32"
+  | Pbytes_set_64(unsafe) ->
+     if unsafe then fprintf ppf "bytes.unsafe_set64"
+     else fprintf ppf "bytes.set64"
+  | Pbigstring_load_16(unsafe) ->
+     if unsafe then fprintf ppf "bigarray.array1.unsafe_get16"
+     else fprintf ppf "bigarray.array1.get16"
+  | Pbigstring_load_32(unsafe) ->
+     if unsafe then fprintf ppf "bigarray.array1.unsafe_get32"
+     else fprintf ppf "bigarray.array1.get32"
+  | Pbigstring_load_64(unsafe) ->
+     if unsafe then fprintf ppf "bigarray.array1.unsafe_get64"
+     else fprintf ppf "bigarray.array1.get64"
+  | Pbigstring_set_16(unsafe) ->
+     if unsafe then fprintf ppf "bigarray.array1.unsafe_set16"
+     else fprintf ppf "bigarray.array1.set16"
+  | Pbigstring_set_32(unsafe) ->
+     if unsafe then fprintf ppf "bigarray.array1.unsafe_set32"
+     else fprintf ppf "bigarray.array1.set32"
+  | Pbigstring_set_64(unsafe) ->
+     if unsafe then fprintf ppf "bigarray.array1.unsafe_set64"
+     else fprintf ppf "bigarray.array1.set64"
+  | Pbswap16 -> fprintf ppf "bswap16"
+  | Pbbswap(bi) -> print_boxed_integer "bswap" ppf bi
+  | Pint_as_pointer -> fprintf ppf "int_as_pointer"
+  | Popaque -> fprintf ppf "opaque"
+
+let name_of_primitive = function
+  | Pidentity -> "Pidentity"
+  | Pbytes_of_string -> "Pbytes_of_string"
+  | Pbytes_to_string -> "Pbytes_to_string"
+  | Pignore -> "Pignore"
+  | Prevapply -> "Prevapply"
+  | Pdirapply -> "Pdirapply"
+  | Pgetglobal _ -> "Pgetglobal"
+  | Psetglobal _ -> "Psetglobal"
+  | Pmakeblock _ -> "Pmakeblock"
+  | Pfield _ -> "Pfield"
+  | Pfield_computed -> "Pfield_computed"
+  | Psetfield _ -> "Psetfield"
+  | Psetfield_computed _ -> "Psetfield_computed"
+  | Pfloatfield _ -> "Pfloatfield"
+  | Psetfloatfield _ -> "Psetfloatfield"
+  | Pduprecord _ -> "Pduprecord"
+  | Pccall _ -> "Pccall"
+  | Praise _ -> "Praise"
+  | Psequand -> "Psequand"
+  | Psequor -> "Psequor"
+  | Pnot -> "Pnot"
+  | Pnegint -> "Pnegint"
+  | Paddint -> "Paddint"
+  | Psubint -> "Psubint"
+  | Pmulint -> "Pmulint"
+  | Pdivint _ -> "Pdivint"
+  | Pmodint _ -> "Pmodint"
+  | Pandint -> "Pandint"
+  | Porint -> "Porint"
+  | Pxorint -> "Pxorint"
+  | Plslint -> "Plslint"
+  | Plsrint -> "Plsrint"
+  | Pasrint -> "Pasrint"
+  | Pintcomp _ -> "Pintcomp"
+  | Pcompare_ints -> "Pcompare_ints"
+  | Pcompare_floats -> "Pcompare_floats"
+  | Pcompare_bints _ -> "Pcompare"
+  | Poffsetint _ -> "Poffsetint"
+  | Poffsetref _ -> "Poffsetref"
+  | Pintoffloat -> "Pintoffloat"
+  | Pfloatofint -> "Pfloatofint"
+  | Pnegfloat -> "Pnegfloat"
+  | Pabsfloat -> "Pabsfloat"
+  | Paddfloat -> "Paddfloat"
+  | Psubfloat -> "Psubfloat"
+  | Pmulfloat -> "Pmulfloat"
+  | Pdivfloat -> "Pdivfloat"
+  | Pfloatcomp _ -> "Pfloatcomp"
+  | Pstringlength -> "Pstringlength"
+  | Pstringrefu -> "Pstringrefu"
+  | Pstringrefs -> "Pstringrefs"
+  | Pbyteslength -> "Pbyteslength"
+  | Pbytesrefu -> "Pbytesrefu"
+  | Pbytessetu -> "Pbytessetu"
+  | Pbytesrefs -> "Pbytesrefs"
+  | Pbytessets -> "Pbytessets"
+  | Parraylength _ -> "Parraylength"
+  | Pmakearray _ -> "Pmakearray"
+  | Pduparray _ -> "Pduparray"
+  | Parrayrefu _ -> "Parrayrefu"
+  | Parraysetu _ -> "Parraysetu"
+  | Parrayrefs _ -> "Parrayrefs"
+  | Parraysets _ -> "Parraysets"
+  | Pctconst _ -> "Pctconst"
+  | Pisint -> "Pisint"
+  | Pisout -> "Pisout"
+  | Pbintofint _ -> "Pbintofint"
+  | Pintofbint _ -> "Pintofbint"
+  | Pcvtbint _ -> "Pcvtbint"
+  | Pnegbint _ -> "Pnegbint"
+  | Paddbint _ -> "Paddbint"
+  | Psubbint _ -> "Psubbint"
+  | Pmulbint _ -> "Pmulbint"
+  | Pdivbint _ -> "Pdivbint"
+  | Pmodbint _ -> "Pmodbint"
+  | Pandbint _ -> "Pandbint"
+  | Porbint _ -> "Porbint"
+  | Pxorbint _ -> "Pxorbint"
+  | Plslbint _ -> "Plslbint"
+  | Plsrbint _ -> "Plsrbint"
+  | Pasrbint _ -> "Pasrbint"
+  | Pbintcomp _ -> "Pbintcomp"
+  | Pbigarrayref _ -> "Pbigarrayref"
+  | Pbigarrayset _ -> "Pbigarrayset"
+  | Pbigarraydim _ -> "Pbigarraydim"
+  | Pstring_load_16 _ -> "Pstring_load_16"
+  | Pstring_load_32 _ -> "Pstring_load_32"
+  | Pstring_load_64 _ -> "Pstring_load_64"
+  | Pbytes_load_16 _ -> "Pbytes_load_16"
+  | Pbytes_load_32 _ -> "Pbytes_load_32"
+  | Pbytes_load_64 _ -> "Pbytes_load_64"
+  | Pbytes_set_16 _ -> "Pbytes_set_16"
+  | Pbytes_set_32 _ -> "Pbytes_set_32"
+  | Pbytes_set_64 _ -> "Pbytes_set_64"
+  | Pbigstring_load_16 _ -> "Pbigstring_load_16"
+  | Pbigstring_load_32 _ -> "Pbigstring_load_32"
+  | Pbigstring_load_64 _ -> "Pbigstring_load_64"
+  | Pbigstring_set_16 _ -> "Pbigstring_set_16"
+  | Pbigstring_set_32 _ -> "Pbigstring_set_32"
+  | Pbigstring_set_64 _ -> "Pbigstring_set_64"
+  | Pbswap16 -> "Pbswap16"
+  | Pbbswap _ -> "Pbbswap"
+  | Pint_as_pointer -> "Pint_as_pointer"
+  | Popaque -> "Popaque"
+
+let function_attribute ppf { inline; specialise; local; is_a_functor; stub } =
+  if is_a_functor then
+    fprintf ppf "is_a_functor@ ";
+  if stub then
+    fprintf ppf "stub@ ";
+  begin match inline with
+  | Default_inline -> ()
+  | Always_inline -> fprintf ppf "always_inline@ "
+  | Hint_inline -> fprintf ppf "hint_inline@ "
+  | Never_inline -> fprintf ppf "never_inline@ "
+  | Unroll i -> fprintf ppf "unroll(%i)@ " i
+  end;
+  begin match specialise with
+  | Default_specialise -> ()
+  | Always_specialise -> fprintf ppf "always_specialise@ "
+  | Never_specialise -> fprintf ppf "never_specialise@ "
+  end;
+  begin match local with
+  | Default_local -> ()
+  | Always_local -> fprintf ppf "always_local@ "
+  | Never_local -> fprintf ppf "never_local@ "
+  end
+
+let apply_tailcall_attribute ppf tailcall =
+  if tailcall then
+    fprintf ppf " @@tailcall"
+
+let apply_inlined_attribute ppf = function
+  | Default_inline -> ()
+  | Always_inline -> fprintf ppf " always_inline"
+  | Never_inline -> fprintf ppf " never_inline"
+  | Hint_inline -> fprintf ppf " hint_inline"
+  | Unroll i -> fprintf ppf " never_inline(%i)" i
+
+let apply_specialised_attribute ppf = function
+  | Default_specialise -> ()
+  | Always_specialise -> fprintf ppf " always_specialise"
+  | Never_specialise -> fprintf ppf " never_specialise"
+
+let rec lam ppf = function
+  | Lvar id ->
+      Ident.print ppf id
+  | Lconst cst ->
+      struct_const ppf cst
+  | Lapply ap ->
+      let lams ppf largs =
+        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
+      fprintf ppf "@[<2>(apply@ %a%a%a%a%a)@]" lam ap.ap_func lams ap.ap_args
+        apply_tailcall_attribute ap.ap_should_be_tailcall
+        apply_inlined_attribute ap.ap_inlined
+        apply_specialised_attribute ap.ap_specialised
+  | Lfunction{kind; params; return; body; attr} ->
+      let pr_params ppf params =
+        match kind with
+        | Curried ->
+            List.iter (fun (param, k) ->
+                fprintf ppf "@ %a%a" Ident.print param value_kind k) params
+        | Tupled ->
+            fprintf ppf " (";
+            let first = ref true in
+            List.iter
+              (fun (param, k) ->
+                if !first then first := false else fprintf ppf ",@ ";
+                Ident.print ppf param;
+                value_kind ppf k)
+              params;
+            fprintf ppf ")" in
+      fprintf ppf "@[<2>(function%a@ %a%a%a)@]" pr_params params
+        function_attribute attr return_kind return lam body
+  | Llet(str, k, id, arg, body) ->
+      let kind = function
+          Alias -> "a" | Strict -> "" | StrictOpt -> "o" | Variable -> "v"
+      in
+      let rec letbody = function
+        | Llet(str, k, id, arg, body) ->
+            fprintf ppf "@ @[<2>%a =%s%a@ %a@]"
+              Ident.print id (kind str) value_kind k lam arg;
+            letbody body
+        | expr -> expr in
+      fprintf ppf "@[<2>(let@ @[(@[<2>%a =%s%a@ %a@]"
+        Ident.print id (kind str) value_kind k lam arg;
+      let expr = letbody body in
+      fprintf ppf ")@]@ %a)@]" lam expr
+  | Lletrec(id_arg_list, body) ->
+      let bindings ppf id_arg_list =
+        let spc = ref false in
+        List.iter
+          (fun (id, l) ->
+            if !spc then fprintf ppf "@ " else spc := true;
+            fprintf ppf "@[<2>%a@ %a@]" Ident.print id lam l)
+          id_arg_list in
+      fprintf ppf
+        "@[<2>(letrec@ (@[%a@])@ %a)@]" bindings id_arg_list lam body
+  | Lprim(prim, largs, _) ->
+      let lams ppf largs =
+        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
+      fprintf ppf "@[<2>(%a%a)@]" primitive prim lams largs
+  | Lswitch(larg, sw, _loc) ->
+      let switch ppf sw =
+        let spc = ref false in
+        List.iter
+         (fun (n, l) ->
+           if !spc then fprintf ppf "@ " else spc := true;
+           fprintf ppf "@[case int %i:@ %a@]" n lam l)
+         sw.sw_consts;
+        List.iter
+          (fun (n, l) ->
+            if !spc then fprintf ppf "@ " else spc := true;
+            fprintf ppf "@[case tag %i:@ %a@]" n lam l)
+          sw.sw_blocks ;
+        begin match sw.sw_failaction with
+        | None  -> ()
+        | Some l ->
+            if !spc then fprintf ppf "@ " else spc := true;
+            fprintf ppf "@[default:@ %a@]" lam l
+        end in
+      fprintf ppf
+       "@[<1>(%s %a@ @[%a@])@]"
+       (match sw.sw_failaction with None -> "switch*" | _ -> "switch")
+       lam larg switch sw
+  | Lstringswitch(arg, cases, default, _) ->
+      let switch ppf cases =
+        let spc = ref false in
+        List.iter
+         (fun (s, l) ->
+           if !spc then fprintf ppf "@ " else spc := true;
+           fprintf ppf "@[case \"%s\":@ %a@]" (String.escaped s) lam l)
+          cases;
+        begin match default with
+        | Some default ->
+            if !spc then fprintf ppf "@ " else spc := true;
+            fprintf ppf "@[default:@ %a@]" lam default
+        | None -> ()
+        end in
+      fprintf ppf
+       "@[<1>(stringswitch %a@ @[%a@])@]" lam arg switch cases
+  | Lstaticraise (i, ls)  ->
+      let lams ppf largs =
+        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
+      fprintf ppf "@[<2>(exit@ %d%a)@]" i lams ls;
+  | Lstaticcatch(lbody, (i, vars), lhandler) ->
+      fprintf ppf "@[<2>(catch@ %a@;<1 -1>with (%d%a)@ %a)@]"
+        lam lbody i
+        (fun ppf vars ->
+           List.iter
+             (fun (x, k) -> fprintf ppf " %a%a" Ident.print x value_kind k)
+             vars
+        )
+        vars
+        lam lhandler
+  | Ltrywith(lbody, param, lhandler) ->
+      fprintf ppf "@[<2>(try@ %a@;<1 -1>with %a@ %a)@]"
+        lam lbody Ident.print param lam lhandler
+  | Lifthenelse(lcond, lif, lelse) ->
+      fprintf ppf "@[<2>(if@ %a@ %a@ %a)@]" lam lcond lam lif lam lelse
+  | Lsequence(l1, l2) ->
+      fprintf ppf "@[<2>(seq@ %a@ %a)@]" lam l1 sequence l2
+  | Lwhile(lcond, lbody) ->
+      fprintf ppf "@[<2>(while@ %a@ %a)@]" lam lcond lam lbody
+  | Lfor(param, lo, hi, dir, body) ->
+      fprintf ppf "@[<2>(for %a@ %a@ %s@ %a@ %a)@]"
+       Ident.print param lam lo
+       (match dir with Upto -> "to" | Downto -> "downto")
+       lam hi lam body
+  | Lassign(id, expr) ->
+      fprintf ppf "@[<2>(assign@ %a@ %a)@]" Ident.print id lam expr
+  | Lsend (k, met, obj, largs, _) ->
+      let args ppf largs =
+        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
+      let kind =
+        if k = Self then "self" else if k = Cached then "cache" else "" in
+      fprintf ppf "@[<2>(send%s@ %a@ %a%a)@]" kind lam obj lam met args largs
+  | Levent(expr, ev) ->
+      let kind =
+       match ev.lev_kind with
+       | Lev_before -> "before"
+       | Lev_after _  -> "after"
+       | Lev_function -> "funct-body"
+       | Lev_pseudo -> "pseudo"
+       | Lev_module_definition ident ->
+         Format.asprintf "module-defn(%a)" Ident.print ident
+      in
+      (* -dno-locations also hides the placement of debug events;
+         this is good for the readability of the resulting output (usually
+         the end-user goal when using -dno-locations), as it strongly
+         reduces the nesting level of subterms. *)
+      if not !Clflags.locations then lam ppf expr
+      else begin match ev.lev_loc with
+      | Loc_unknown ->
+        fprintf ppf "@[<2>(%s @ %a)@]" kind lam expr
+      | Loc_known {scopes; loc} ->
+        fprintf ppf "@[<2>(%s %s %s(%i)%s:%i-%i@ %a)@]" kind
+                (Debuginfo.Scoped_location.string_of_scopes scopes)
+                loc.Location.loc_start.Lexing.pos_fname
+                loc.Location.loc_start.Lexing.pos_lnum
+                (if loc.Location.loc_ghost then "" else "")
+                loc.Location.loc_start.Lexing.pos_cnum
+                loc.Location.loc_end.Lexing.pos_cnum
+                lam expr
+      end
+  | Lifused(id, expr) ->
+      fprintf ppf "@[<2>(ifused@ %a@ %a)@]" Ident.print id lam expr
+
+and sequence ppf = function
+  | Lsequence(l1, l2) ->
+      fprintf ppf "%a@ %a" sequence l1 sequence l2
+  | l ->
+      lam ppf l
+
+let structured_constant = struct_const
+
+let lambda = lam
+
+let program ppf { code } = lambda ppf code
diff --git a/lambda/printlambda.mli b/lambda/printlambda.mli
new file mode 100644
index 00000000..7dab5229
--- /dev/null
+++ b/lambda/printlambda.mli
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Lambda
+
+open Format
+
+val integer_comparison: formatter -> integer_comparison -> unit
+val float_comparison: formatter -> float_comparison -> unit
+val structured_constant: formatter -> structured_constant -> unit
+val lambda: formatter -> lambda -> unit
+val program: formatter -> program -> unit
+val primitive: formatter -> primitive -> unit
+val name_of_primitive : primitive -> string
+val value_kind : formatter -> value_kind -> unit
+val block_shape : formatter -> value_kind list option -> unit
+val record_rep : formatter -> Types.record_representation -> unit
+val print_bigarray :
+  string -> bool -> Lambda.bigarray_kind -> formatter ->
+  Lambda.bigarray_layout -> unit
diff --git a/lambda/runtimedef.mli b/lambda/runtimedef.mli
new file mode 100644
index 00000000..3baabb64
--- /dev/null
+++ b/lambda/runtimedef.mli
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Values and functions known and/or provided by the runtime system *)
+
+val builtin_exceptions: string array
+val builtin_primitives: string array
diff --git a/lambda/simplif.ml b/lambda/simplif.ml
new file mode 100644
index 00000000..b8a3415b
--- /dev/null
+++ b/lambda/simplif.ml
@@ -0,0 +1,879 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Elimination of useless Llet(Alias) bindings.
+   Also transform let-bound references into variables. *)
+
+open Asttypes
+open Lambda
+open Debuginfo.Scoped_location
+
+(* To transform let-bound references into variables *)
+
+exception Real_reference
+
+let rec eliminate_ref id = function
+    Lvar v as lam ->
+      if Ident.same v id then raise Real_reference else lam
+  | Lconst _ as lam -> lam
+  | Lapply ap ->
+      Lapply{ap with ap_func = eliminate_ref id ap.ap_func;
+                     ap_args = List.map (eliminate_ref id) ap.ap_args}
+  | Lfunction _ as lam ->
+      if Ident.Set.mem id (free_variables lam)
+      then raise Real_reference
+      else lam
+  | Llet(str, kind, v, e1, e2) ->
+      Llet(str, kind, v, eliminate_ref id e1, eliminate_ref id e2)
+  | Lletrec(idel, e2) ->
+      Lletrec(List.map (fun (v, e) -> (v, eliminate_ref id e)) idel,
+              eliminate_ref id e2)
+  | Lprim(Pfield 0, [Lvar v], _) when Ident.same v id ->
+      Lvar id
+  | Lprim(Psetfield(0, _, _), [Lvar v; e], _) when Ident.same v id ->
+      Lassign(id, eliminate_ref id e)
+  | Lprim(Poffsetref delta, [Lvar v], loc) when Ident.same v id ->
+      Lassign(id, Lprim(Poffsetint delta, [Lvar id], loc))
+  | Lprim(p, el, loc) ->
+      Lprim(p, List.map (eliminate_ref id) el, loc)
+  | Lswitch(e, sw, loc) ->
+      Lswitch(eliminate_ref id e,
+        {sw_numconsts = sw.sw_numconsts;
+         sw_consts =
+            List.map (fun (n, e) -> (n, eliminate_ref id e)) sw.sw_consts;
+         sw_numblocks = sw.sw_numblocks;
+         sw_blocks =
+            List.map (fun (n, e) -> (n, eliminate_ref id e)) sw.sw_blocks;
+         sw_failaction =
+            Option.map (eliminate_ref id) sw.sw_failaction; },
+        loc)
+  | Lstringswitch(e, sw, default, loc) ->
+      Lstringswitch
+        (eliminate_ref id e,
+         List.map (fun (s, e) -> (s, eliminate_ref id e)) sw,
+         Option.map (eliminate_ref id) default, loc)
+  | Lstaticraise (i,args) ->
+      Lstaticraise (i,List.map (eliminate_ref id) args)
+  | Lstaticcatch(e1, i, e2) ->
+      Lstaticcatch(eliminate_ref id e1, i, eliminate_ref id e2)
+  | Ltrywith(e1, v, e2) ->
+      Ltrywith(eliminate_ref id e1, v, eliminate_ref id e2)
+  | Lifthenelse(e1, e2, e3) ->
+      Lifthenelse(eliminate_ref id e1,
+                  eliminate_ref id e2,
+                  eliminate_ref id e3)
+  | Lsequence(e1, e2) ->
+      Lsequence(eliminate_ref id e1, eliminate_ref id e2)
+  | Lwhile(e1, e2) ->
+      Lwhile(eliminate_ref id e1, eliminate_ref id e2)
+  | Lfor(v, e1, e2, dir, e3) ->
+      Lfor(v, eliminate_ref id e1, eliminate_ref id e2,
+           dir, eliminate_ref id e3)
+  | Lassign(v, e) ->
+      Lassign(v, eliminate_ref id e)
+  | Lsend(k, m, o, el, loc) ->
+      Lsend(k, eliminate_ref id m, eliminate_ref id o,
+            List.map (eliminate_ref id) el, loc)
+  | Levent(l, ev) ->
+      Levent(eliminate_ref id l, ev)
+  | Lifused(v, e) ->
+      Lifused(v, eliminate_ref id e)
+
+(* Simplification of exits *)
+
+type exit = {
+  mutable count: int;
+  mutable max_depth: int;
+}
+
+let simplify_exits lam =
+
+  (* Count occurrences of (exit n ...) statements *)
+  let exits = Hashtbl.create 17 in
+
+  let try_depth = ref 0 in
+
+  let get_exit i =
+    try Hashtbl.find exits i
+    with Not_found -> {count = 0; max_depth = 0}
+
+  and incr_exit i nb d =
+    match Hashtbl.find_opt exits i with
+    | Some r ->
+        r.count <- r.count + nb;
+        r.max_depth <- max r.max_depth d
+    | None ->
+        let r = {count = nb; max_depth = d} in
+        Hashtbl.add exits i r
+  in
+
+  let rec count = function
+  | (Lvar _| Lconst _) -> ()
+  | Lapply ap -> count ap.ap_func; List.iter count ap.ap_args
+  | Lfunction {body} -> count body
+  | Llet(_str, _kind, _v, l1, l2) ->
+      count l2; count l1
+  | Lletrec(bindings, body) ->
+      List.iter (fun (_v, l) -> count l) bindings;
+      count body
+  | Lprim(_p, ll, _) -> List.iter count ll
+  | Lswitch(l, sw, _loc) ->
+      count_default sw ;
+      count l;
+      List.iter (fun (_, l) -> count l) sw.sw_consts;
+      List.iter (fun (_, l) -> count l) sw.sw_blocks
+  | Lstringswitch(l, sw, d, _) ->
+      count l;
+      List.iter (fun (_, l) -> count l) sw;
+      begin match  d with
+      | None -> ()
+      | Some d -> match sw with
+        | []|[_] -> count d
+        | _ -> count d; count d (* default will get replicated *)
+      end
+  | Lstaticraise (i,ls) -> incr_exit i 1 !try_depth; List.iter count ls
+  | Lstaticcatch (l1,(i,[]),Lstaticraise (j,[])) ->
+      (* i will be replaced by j in l1, so each occurrence of i in l1
+         increases j's ref count *)
+      count l1 ;
+      let ic = get_exit i in
+      incr_exit j ic.count (max !try_depth ic.max_depth)
+  | Lstaticcatch(l1, (i,_), l2) ->
+      count l1;
+      (* If l1 does not contain (exit i),
+         l2 will be removed, so don't count its exits *)
+      if (get_exit i).count > 0 then
+        count l2
+  | Ltrywith(l1, _v, l2) -> incr try_depth; count l1; decr try_depth; count l2
+  | Lifthenelse(l1, l2, l3) -> count l1; count l2; count l3
+  | Lsequence(l1, l2) -> count l1; count l2
+  | Lwhile(l1, l2) -> count l1; count l2
+  | Lfor(_, l1, l2, _dir, l3) -> count l1; count l2; count l3
+  | Lassign(_v, l) -> count l
+  | Lsend(_k, m, o, ll, _) -> List.iter count (m::o::ll)
+  | Levent(l, _) -> count l
+  | Lifused(_v, l) -> count l
+
+  and count_default sw = match sw.sw_failaction with
+  | None -> ()
+  | Some al ->
+      let nconsts = List.length sw.sw_consts
+      and nblocks = List.length sw.sw_blocks in
+      if
+        nconsts < sw.sw_numconsts && nblocks < sw.sw_numblocks
+      then begin (* default action will occur twice in native code *)
+        count al ; count al
+      end else begin (* default action will occur once *)
+        assert (nconsts < sw.sw_numconsts || nblocks < sw.sw_numblocks) ;
+        count al
+      end
+  in
+  count lam;
+  assert(!try_depth = 0);
+
+  (*
+     Second pass simplify  ``catch body with (i ...) handler''
+      - if (exit i ...) does not occur in body, suppress catch
+      - if (exit i ...) occurs exactly once in body,
+        substitute it with handler
+      - If handler is a single variable, replace (exit i ..) with it
+   Note:
+    In ``catch body with (i x1 .. xn) handler''
+     Substituted expression is
+      let y1 = x1 and ... yn = xn in
+      handler[x1 <- y1 ; ... ; xn <- yn]
+     For the sake of preserving the uniqueness  of bound variables.
+     (No alpha conversion of ``handler'' is presently needed, since
+     substitution of several ``(exit i ...)''
+     occurs only when ``handler'' is a variable.)
+  *)
+
+  let subst = Hashtbl.create 17 in
+
+  let rec simplif = function
+  | (Lvar _|Lconst _) as l -> l
+  | Lapply ap ->
+      Lapply{ap with ap_func = simplif ap.ap_func;
+                     ap_args = List.map simplif ap.ap_args}
+  | Lfunction{kind; params; return; body = l; attr; loc} ->
+     Lfunction{kind; params; return; body = simplif l; attr; loc}
+  | Llet(str, kind, v, l1, l2) -> Llet(str, kind, v, simplif l1, simplif l2)
+  | Lletrec(bindings, body) ->
+      Lletrec(List.map (fun (v, l) -> (v, simplif l)) bindings, simplif body)
+  | Lprim(p, ll, loc) -> begin
+    let ll = List.map simplif ll in
+    match p, ll with
+        (* Simplify %revapply, for n-ary functions with n > 1 *)
+      | Prevapply, [x; Lapply ap]
+      | Prevapply, [x; Levent (Lapply ap,_)] ->
+        Lapply {ap with ap_args = ap.ap_args @ [x]; ap_loc = loc}
+      | Prevapply, [x; f] -> Lapply {ap_should_be_tailcall=false;
+                                     ap_loc=loc;
+                                     ap_func=f;
+                                     ap_args=[x];
+                                     ap_inlined=Default_inline;
+                                     ap_specialised=Default_specialise}
+
+        (* Simplify %apply, for n-ary functions with n > 1 *)
+      | Pdirapply, [Lapply ap; x]
+      | Pdirapply, [Levent (Lapply ap,_); x] ->
+        Lapply {ap with ap_args = ap.ap_args @ [x]; ap_loc = loc}
+      | Pdirapply, [f; x] -> Lapply {ap_should_be_tailcall=false;
+                                     ap_loc=loc;
+                                     ap_func=f;
+                                     ap_args=[x];
+                                     ap_inlined=Default_inline;
+                                     ap_specialised=Default_specialise}
+        (* Simplify %identity *)
+      | Pidentity, [e] -> e
+
+        (* Simplify Obj.with_tag *)
+      | Pccall { Primitive.prim_name = "caml_obj_with_tag"; _ },
+        [Lconst (Const_base (Const_int tag));
+         Lprim (Pmakeblock (_, mut, shape), fields, loc)] ->
+         Lprim (Pmakeblock(tag, mut, shape), fields, loc)
+      | Pccall { Primitive.prim_name = "caml_obj_with_tag"; _ },
+        [Lconst (Const_base (Const_int tag));
+         Lconst (Const_block (_, fields))] ->
+         Lconst (Const_block (tag, fields))
+
+      | _ -> Lprim(p, ll, loc)
+     end
+  | Lswitch(l, sw, loc) ->
+      let new_l = simplif l
+      and new_consts =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts
+      and new_blocks =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_blocks
+      and new_fail = Option.map simplif sw.sw_failaction in
+      Lswitch
+        (new_l,
+         {sw with sw_consts = new_consts ; sw_blocks = new_blocks;
+                  sw_failaction = new_fail},
+         loc)
+  | Lstringswitch(l,sw,d,loc) ->
+      Lstringswitch
+        (simplif l,List.map (fun (s,l) -> s,simplif l) sw,
+         Option.map simplif d,loc)
+  | Lstaticraise (i,[]) as l ->
+      begin try
+        let _,handler =  Hashtbl.find subst i in
+        handler
+      with
+      | Not_found -> l
+      end
+  | Lstaticraise (i,ls) ->
+      let ls = List.map simplif ls in
+      begin try
+        let xs,handler =  Hashtbl.find subst i in
+        let ys = List.map (fun (x, k) -> Ident.rename x, k) xs in
+        let env =
+          List.fold_right2
+            (fun (x, _) (y, _) env -> Ident.Map.add x y env)
+            xs ys Ident.Map.empty
+        in
+        List.fold_right2
+          (fun (y, kind) l r -> Llet (Strict, kind, y, l, r))
+          ys ls (Lambda.rename env handler)
+      with
+      | Not_found -> Lstaticraise (i,ls)
+      end
+  | Lstaticcatch (l1,(i,[]),(Lstaticraise (_j,[]) as l2)) ->
+      Hashtbl.add subst i ([],simplif l2) ;
+      simplif l1
+  | Lstaticcatch (l1,(i,xs),l2) ->
+      let {count; max_depth} = get_exit i in
+      if count = 0 then
+        (* Discard staticcatch: not matching exit *)
+        simplif l1
+      else if count = 1 && max_depth <= !try_depth then begin
+        (* Inline handler if there is a single occurrence and it is not
+           nested within an inner try..with *)
+        assert(max_depth = !try_depth);
+        Hashtbl.add subst i (xs,simplif l2);
+        simplif l1
+      end else
+        Lstaticcatch (simplif l1, (i,xs), simplif l2)
+  | Ltrywith(l1, v, l2) ->
+      incr try_depth;
+      let l1 = simplif l1 in
+      decr try_depth;
+      Ltrywith(l1, v, simplif l2)
+  | Lifthenelse(l1, l2, l3) -> Lifthenelse(simplif l1, simplif l2, simplif l3)
+  | Lsequence(l1, l2) -> Lsequence(simplif l1, simplif l2)
+  | Lwhile(l1, l2) -> Lwhile(simplif l1, simplif l2)
+  | Lfor(v, l1, l2, dir, l3) ->
+      Lfor(v, simplif l1, simplif l2, dir, simplif l3)
+  | Lassign(v, l) -> Lassign(v, simplif l)
+  | Lsend(k, m, o, ll, loc) ->
+      Lsend(k, simplif m, simplif o, List.map simplif ll, loc)
+  | Levent(l, ev) -> Levent(simplif l, ev)
+  | Lifused(v, l) -> Lifused (v,simplif l)
+  in
+  simplif lam
+
+(* Compile-time beta-reduction of functions immediately applied:
+      Lapply(Lfunction(Curried, params, body), args, loc) ->
+        let paramN = argN in ... let param1 = arg1 in body
+      Lapply(Lfunction(Tupled, params, body), [Lprim(Pmakeblock(args))], loc) ->
+        let paramN = argN in ... let param1 = arg1 in body
+   Assumes |args| = |params|.
+*)
+
+let exact_application {kind; params; _} args =
+  match kind with
+  | Curried ->
+      if List.length params <> List.length args
+      then None
+      else Some args
+  | Tupled ->
+      begin match args with
+      | [Lprim(Pmakeblock _, tupled_args, _)] ->
+          if List.length params <> List.length tupled_args
+          then None
+          else Some tupled_args
+      | [Lconst(Const_block (_, const_args))] ->
+          if List.length params <> List.length const_args
+          then None
+          else Some (List.map (fun cst -> Lconst cst) const_args)
+      | _ -> None
+      end
+
+let beta_reduce params body args =
+  List.fold_left2 (fun l (param, kind) arg -> Llet(Strict, kind, param, arg, l))
+                  body params args
+
+(* Simplification of lets *)
+
+let simplify_lets lam =
+
+  (* Disable optimisations for bytecode compilation with -g flag *)
+  let optimize = !Clflags.native_code || not !Clflags.debug in
+
+  (* First pass: count the occurrences of all let-bound identifiers *)
+
+  let occ = (Hashtbl.create 83: (Ident.t, int ref) Hashtbl.t) in
+  (* The global table [occ] associates to each let-bound identifier
+     the number of its uses (as a reference):
+     - 0 if never used
+     - 1 if used exactly once in and not under a lambda or within a loop
+     - > 1 if used several times or under a lambda or within a loop.
+     The local table [bv] associates to each locally-let-bound variable
+     its reference count, as above.  [bv] is enriched at let bindings
+     but emptied when crossing lambdas and loops. *)
+
+  (* Current use count of a variable. *)
+  let count_var v =
+    try
+      !(Hashtbl.find occ v)
+    with Not_found ->
+      0
+
+  (* Entering a [let].  Returns updated [bv]. *)
+  and bind_var bv v =
+    let r = ref 0 in
+    Hashtbl.add occ v r;
+    Ident.Map.add v r bv
+
+  (* Record a use of a variable *)
+  and use_var bv v n =
+    try
+      let r = Ident.Map.find v bv in r := !r + n
+    with Not_found ->
+      (* v is not locally bound, therefore this is a use under a lambda
+         or within a loop.  Increase use count by 2 -- enough so
+         that single-use optimizations will not apply. *)
+    try
+      let r = Hashtbl.find occ v in r := !r + 2
+    with Not_found ->
+      (* Not a let-bound variable, ignore *)
+      () in
+
+  let rec count bv = function
+  | Lconst _ -> ()
+  | Lvar v ->
+      use_var bv v 1
+  | Lapply{ap_func = ll; ap_args = args} ->
+      let no_opt () = count bv ll; List.iter (count bv) args in
+      begin match ll with
+      | Lfunction lf when optimize ->
+          begin match exact_application lf args with
+          | None -> no_opt ()
+          | Some exact_args ->
+              count bv (beta_reduce lf.params lf.body exact_args)
+          end
+      | _ -> no_opt ()
+      end
+  | Lfunction {body} ->
+      count Ident.Map.empty body
+  | Llet(_str, _k, v, Lvar w, l2) when optimize ->
+      (* v will be replaced by w in l2, so each occurrence of v in l2
+         increases w's refcount *)
+      count (bind_var bv v) l2;
+      use_var bv w (count_var v)
+  | Llet(str, _kind, v, l1, l2) ->
+      count (bind_var bv v) l2;
+      (* If v is unused, l1 will be removed, so don't count its variables *)
+      if str = Strict || count_var v > 0 then count bv l1
+  | Lletrec(bindings, body) ->
+      List.iter (fun (_v, l) -> count bv l) bindings;
+      count bv body
+  | Lprim(_p, ll, _) -> List.iter (count bv) ll
+  | Lswitch(l, sw, _loc) ->
+      count_default bv sw ;
+      count bv l;
+      List.iter (fun (_, l) -> count bv l) sw.sw_consts;
+      List.iter (fun (_, l) -> count bv l) sw.sw_blocks
+  | Lstringswitch(l, sw, d, _) ->
+      count bv l ;
+      List.iter (fun (_, l) -> count bv l) sw ;
+      begin match d with
+      | Some d ->
+          begin match sw with
+          | []|[_] -> count bv d
+          | _ -> count bv d ; count bv d
+          end
+      | None -> ()
+      end
+  | Lstaticraise (_i,ls) -> List.iter (count bv) ls
+  | Lstaticcatch(l1, _, l2) -> count bv l1; count bv l2
+  | Ltrywith(l1, _v, l2) -> count bv l1; count bv l2
+  | Lifthenelse(l1, l2, l3) -> count bv l1; count bv l2; count bv l3
+  | Lsequence(l1, l2) -> count bv l1; count bv l2
+  | Lwhile(l1, l2) -> count Ident.Map.empty l1; count Ident.Map.empty l2
+  | Lfor(_, l1, l2, _dir, l3) ->
+      count bv l1; count bv l2; count Ident.Map.empty l3
+  | Lassign(_v, l) ->
+      (* Lalias-bound variables are never assigned, so don't increase
+         v's refcount *)
+      count bv l
+  | Lsend(_, m, o, ll, _) -> List.iter (count bv) (m::o::ll)
+  | Levent(l, _) -> count bv l
+  | Lifused(v, l) ->
+      if count_var v > 0 then count bv l
+
+  and count_default bv sw = match sw.sw_failaction with
+  | None -> ()
+  | Some al ->
+      let nconsts = List.length sw.sw_consts
+      and nblocks = List.length sw.sw_blocks in
+      if
+        nconsts < sw.sw_numconsts && nblocks < sw.sw_numblocks
+      then begin (* default action will occur twice in native code *)
+        count bv al ; count bv al
+      end else begin (* default action will occur once *)
+        assert (nconsts < sw.sw_numconsts || nblocks < sw.sw_numblocks) ;
+        count bv al
+      end
+  in
+  count Ident.Map.empty lam;
+
+  (* Second pass: remove Lalias bindings of unused variables,
+     and substitute the bindings of variables used exactly once. *)
+
+  let subst = Hashtbl.create 83 in
+
+(* This (small)  optimisation is always legal, it may uncover some
+   tail call later on. *)
+
+  let mklet str kind v e1 e2  = match e2 with
+  | Lvar w when optimize && Ident.same v w -> e1
+  | _ -> Llet (str, kind,v,e1,e2) in
+
+
+  let rec simplif = function
+    Lvar v as l ->
+      begin try
+        Hashtbl.find subst v
+      with Not_found ->
+        l
+      end
+  | Lconst _ as l -> l
+  | Lapply ({ap_func = ll; ap_args = args} as ap) ->
+      let no_opt () =
+        Lapply {ap with ap_func = simplif ap.ap_func;
+                        ap_args = List.map simplif ap.ap_args} in
+      begin match ll with
+      | Lfunction lf when optimize ->
+          begin match exact_application lf args with
+          | None -> no_opt ()
+          | Some exact_args ->
+              simplif (beta_reduce lf.params lf.body exact_args)
+          end
+      | _ -> no_opt ()
+      end
+  | Lfunction{kind; params; return=return1; body = l; attr; loc} ->
+      begin match simplif l with
+        Lfunction{kind=Curried; params=params'; return=return2; body; attr; loc}
+        when kind = Curried && optimize ->
+          (* The return type is the type of the value returned after
+             applying all the parameters to the function. The return
+             type of the merged function taking [params @ params'] as
+             parameters is the type returned after applying [params']. *)
+          let return = return2 in
+          Lfunction{kind; params = params @ params'; return; body; attr; loc}
+      | body ->
+          Lfunction{kind; params; return = return1; body; attr; loc}
+      end
+  | Llet(_str, _k, v, Lvar w, l2) when optimize ->
+      Hashtbl.add subst v (simplif (Lvar w));
+      simplif l2
+  | Llet(Strict, kind, v,
+         Lprim(Pmakeblock(0, Mutable, kind_ref) as prim, [linit], loc), lbody)
+    when optimize ->
+      let slinit = simplif linit in
+      let slbody = simplif lbody in
+      begin try
+        let kind = match kind_ref with
+          | None -> Pgenval
+          | Some [field_kind] -> field_kind
+          | Some _ -> assert false
+        in
+        mklet Variable kind v slinit (eliminate_ref v slbody)
+      with Real_reference ->
+        mklet Strict kind v (Lprim(prim, [slinit], loc)) slbody
+      end
+  | Llet(Alias, kind, v, l1, l2) ->
+      begin match count_var v with
+        0 -> simplif l2
+      | 1 when optimize -> Hashtbl.add subst v (simplif l1); simplif l2
+      | _ -> Llet(Alias, kind, v, simplif l1, simplif l2)
+      end
+  | Llet(StrictOpt, kind, v, l1, l2) ->
+      begin match count_var v with
+        0 -> simplif l2
+      | _ -> mklet StrictOpt kind v (simplif l1) (simplif l2)
+      end
+  | Llet(str, kind, v, l1, l2) -> mklet str kind v (simplif l1) (simplif l2)
+  | Lletrec(bindings, body) ->
+      Lletrec(List.map (fun (v, l) -> (v, simplif l)) bindings, simplif body)
+  | Lprim(p, ll, loc) -> Lprim(p, List.map simplif ll, loc)
+  | Lswitch(l, sw, loc) ->
+      let new_l = simplif l
+      and new_consts =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts
+      and new_blocks =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_blocks
+      and new_fail = Option.map simplif sw.sw_failaction in
+      Lswitch
+        (new_l,
+         {sw with sw_consts = new_consts ; sw_blocks = new_blocks;
+                  sw_failaction = new_fail},
+         loc)
+  | Lstringswitch (l,sw,d,loc) ->
+      Lstringswitch
+        (simplif l,List.map (fun (s,l) -> s,simplif l) sw,
+         Option.map simplif d,loc)
+  | Lstaticraise (i,ls) ->
+      Lstaticraise (i, List.map simplif ls)
+  | Lstaticcatch(l1, (i,args), l2) ->
+      Lstaticcatch (simplif l1, (i,args), simplif l2)
+  | Ltrywith(l1, v, l2) -> Ltrywith(simplif l1, v, simplif l2)
+  | Lifthenelse(l1, l2, l3) -> Lifthenelse(simplif l1, simplif l2, simplif l3)
+  | Lsequence(Lifused(v, l1), l2) ->
+      if count_var v > 0
+      then Lsequence(simplif l1, simplif l2)
+      else simplif l2
+  | Lsequence(l1, l2) -> Lsequence(simplif l1, simplif l2)
+  | Lwhile(l1, l2) -> Lwhile(simplif l1, simplif l2)
+  | Lfor(v, l1, l2, dir, l3) ->
+      Lfor(v, simplif l1, simplif l2, dir, simplif l3)
+  | Lassign(v, l) -> Lassign(v, simplif l)
+  | Lsend(k, m, o, ll, loc) ->
+      Lsend(k, simplif m, simplif o, List.map simplif ll, loc)
+  | Levent(l, ev) -> Levent(simplif l, ev)
+  | Lifused(v, l) ->
+      if count_var v > 0 then simplif l else lambda_unit
+  in
+  simplif lam
+
+(* Tail call info in annotation files *)
+
+let is_tail_native_heuristic : (int -> bool) ref =
+  ref (fun _ -> true)
+
+let rec emit_tail_infos is_tail lambda =
+  match lambda with
+  | Lvar _ -> ()
+  | Lconst _ -> ()
+  | Lapply ap ->
+      if ap.ap_should_be_tailcall
+      && not is_tail
+      && Warnings.is_active Warnings.Expect_tailcall
+        then Location.prerr_warning (to_location ap.ap_loc)
+               Warnings.Expect_tailcall;
+      emit_tail_infos false ap.ap_func;
+      list_emit_tail_infos false ap.ap_args
+  | Lfunction {body = lam} ->
+      emit_tail_infos true lam
+  | Llet (_str, _k, _, lam, body) ->
+      emit_tail_infos false lam;
+      emit_tail_infos is_tail body
+  | Lletrec (bindings, body) ->
+      List.iter (fun (_, lam) -> emit_tail_infos false lam) bindings;
+      emit_tail_infos is_tail body
+  | Lprim (Pidentity, [arg], _) ->
+      emit_tail_infos is_tail arg
+  | Lprim ((Pbytes_to_string | Pbytes_of_string), [arg], _) ->
+      emit_tail_infos is_tail arg
+  | Lprim (Psequand, [arg1; arg2], _)
+  | Lprim (Psequor, [arg1; arg2], _) ->
+      emit_tail_infos false arg1;
+      emit_tail_infos is_tail arg2
+  | Lprim (_, l, _) ->
+      list_emit_tail_infos false l
+  | Lswitch (lam, sw, _loc) ->
+      emit_tail_infos false lam;
+      list_emit_tail_infos_fun snd is_tail sw.sw_consts;
+      list_emit_tail_infos_fun snd is_tail sw.sw_blocks;
+      Option.iter  (emit_tail_infos is_tail) sw.sw_failaction
+  | Lstringswitch (lam, sw, d, _) ->
+      emit_tail_infos false lam;
+      List.iter
+        (fun (_,lam) ->  emit_tail_infos is_tail lam)
+        sw ;
+      Option.iter (emit_tail_infos is_tail) d
+  | Lstaticraise (_, l) ->
+      list_emit_tail_infos false l
+  | Lstaticcatch (body, _, handler) ->
+      emit_tail_infos is_tail body;
+      emit_tail_infos is_tail handler
+  | Ltrywith (body, _, handler) ->
+      emit_tail_infos false body;
+      emit_tail_infos is_tail handler
+  | Lifthenelse (cond, ifso, ifno) ->
+      emit_tail_infos false cond;
+      emit_tail_infos is_tail ifso;
+      emit_tail_infos is_tail ifno
+  | Lsequence (lam1, lam2) ->
+      emit_tail_infos false lam1;
+      emit_tail_infos is_tail lam2
+  | Lwhile (cond, body) ->
+      emit_tail_infos false cond;
+      emit_tail_infos false body
+  | Lfor (_, low, high, _, body) ->
+      emit_tail_infos false low;
+      emit_tail_infos false high;
+      emit_tail_infos false body
+  | Lassign (_, lam) ->
+      emit_tail_infos false lam
+  | Lsend (_, meth, obj, args, _loc) ->
+      emit_tail_infos false meth;
+      emit_tail_infos false obj;
+      list_emit_tail_infos false args
+  | Levent (lam, _) ->
+      emit_tail_infos is_tail lam
+  | Lifused (_, lam) ->
+      emit_tail_infos is_tail lam
+and list_emit_tail_infos_fun f is_tail =
+  List.iter (fun x -> emit_tail_infos is_tail (f x))
+and list_emit_tail_infos is_tail =
+  List.iter (emit_tail_infos is_tail)
+
+(* Split a function with default parameters into a wrapper and an
+   inner function.  The wrapper fills in missing optional parameters
+   with their default value and tail-calls the inner function.  The
+   wrapper can then hopefully be inlined on most call sites to avoid
+   the overhead associated with boxing an optional argument with a
+   'Some' constructor, only to deconstruct it immediately in the
+   function's body. *)
+
+let split_default_wrapper ~id:fun_id ~kind ~params ~return ~body ~attr ~loc =
+  let rec aux map = function
+    | Llet(Strict, k, id, (Lifthenelse(Lvar optparam, _, _) as def), rest) when
+        Ident.name optparam = "*opt*" && List.mem_assoc optparam params
+          && not (List.mem_assoc optparam map)
+      ->
+        let wrapper_body, inner = aux ((optparam, id) :: map) rest in
+        Llet(Strict, k, id, def, wrapper_body), inner
+    | _ when map = [] -> raise Exit
+    | body ->
+        (* Check that those *opt* identifiers don't appear in the remaining
+           body. This should not appear, but let's be on the safe side. *)
+        let fv = Lambda.free_variables body in
+        List.iter (fun (id, _) -> if Ident.Set.mem id fv then raise Exit) map;
+
+        let inner_id = Ident.create_local (Ident.name fun_id ^ "_inner") in
+        let map_param p = try List.assoc p map with Not_found -> p in
+        let args = List.map (fun (p, _) -> Lvar (map_param p)) params in
+        let wrapper_body =
+          Lapply {
+            ap_func = Lvar inner_id;
+            ap_args = args;
+            ap_loc = Loc_unknown;
+            ap_should_be_tailcall = false;
+            ap_inlined = Default_inline;
+            ap_specialised = Default_specialise;
+          }
+        in
+        let inner_params = List.map map_param (List.map fst params) in
+        let new_ids = List.map Ident.rename inner_params in
+        let subst =
+          List.fold_left2 (fun s id new_id ->
+            Ident.Map.add id new_id s
+          ) Ident.Map.empty inner_params new_ids
+        in
+        let body = Lambda.rename subst body in
+        let inner_fun =
+          Lfunction { kind = Curried;
+            params = List.map (fun id -> id, Pgenval) new_ids;
+            return; body; attr; loc; }
+        in
+        (wrapper_body, (inner_id, inner_fun))
+  in
+  try
+    let body, inner = aux [] body in
+    let attr = default_stub_attribute in
+    [(fun_id, Lfunction{kind; params; return; body; attr; loc}); inner]
+  with Exit ->
+    [(fun_id, Lfunction{kind; params; return; body; attr; loc})]
+
+(* Simplify local let-bound functions: if all occurrences are
+   fully-applied function calls in the same "tail scope", replace the
+   function by a staticcatch handler (on that scope).
+
+   This handles as a special case functions used exactly once (in any
+   scope) for a full application.
+*)
+
+type slot =
+  {
+    func: lfunction;
+    mutable scope: lambda option;
+  }
+
+module LamTbl = Hashtbl.Make(struct
+    type t = lambda
+    let equal = (==)
+    let hash = Hashtbl.hash
+  end)
+
+let simplify_local_functions lam =
+  let slots = Hashtbl.create 16 in
+  let static_id = Hashtbl.create 16 in (* function id -> static id *)
+  let static = LamTbl.create 16 in (* scope -> static function on that scope *)
+  (* We keep track of the current "tail scope", identified
+     by the outermost lambda for which the the current lambda
+     is in tail position. *)
+  let current_scope = ref lam in
+  let check_static lf =
+    if lf.attr.local = Always_local then
+      Location.prerr_warning (to_location lf.loc)
+        (Warnings.Inlining_impossible
+           "This function cannot be compiled into a static continuation")
+  in
+  let enabled = function
+    | {local = Always_local; _}
+    | {local = Default_local; inline = (Never_inline | Default_inline); _}
+      -> true
+    | {local = Default_local;
+       inline = (Always_inline | Unroll _ | Hint_inline); _}
+    | {local = Never_local; _}
+      -> false
+  in
+  let rec tail = function
+    | Llet (_str, _kind, id, Lfunction lf, cont) when enabled lf.attr ->
+        let r = {func = lf; scope = None} in
+        Hashtbl.add slots id r;
+        tail cont;
+        begin match Hashtbl.find_opt slots id with
+        | Some {scope = Some scope; _} ->
+            let st = next_raise_count () in
+            let sc =
+              (* Do not move higher than current lambda *)
+              if scope == !current_scope then cont
+              else scope
+            in
+            Hashtbl.add static_id id st;
+            LamTbl.add static sc (st, lf);
+            (* The body of the function will become an handler
+               in that "scope". *)
+            with_scope ~scope lf.body
+        | _ ->
+            check_static lf;
+            (* note: if scope = None, the function is unused *)
+            non_tail lf.body
+        end
+    | Lapply {ap_func = Lvar id; ap_args; _} ->
+        begin match Hashtbl.find_opt slots id with
+        | Some {func; _}
+          when exact_application func ap_args = None ->
+            (* Wrong arity *)
+            Hashtbl.remove slots id
+        | Some {scope = Some scope; _} when scope != !current_scope ->
+            (* Different "tail scope" *)
+            Hashtbl.remove slots id
+        | Some ({scope = None; _} as slot) ->
+            (* First use of the function: remember the current tail scope *)
+            slot.scope <- Some !current_scope
+        | _ ->
+            ()
+        end;
+        List.iter non_tail ap_args
+    | Lvar id ->
+        Hashtbl.remove slots id
+    | Lfunction lf as lam ->
+        check_static lf;
+        Lambda.shallow_iter ~tail ~non_tail lam
+    | lam ->
+        Lambda.shallow_iter ~tail ~non_tail lam
+  and non_tail lam =
+    with_scope ~scope:lam lam
+  and with_scope ~scope lam =
+    let old_scope = !current_scope in
+    current_scope := scope;
+    tail lam;
+    current_scope := old_scope
+  in
+  tail lam;
+  let rec rewrite lam0 =
+    let lam =
+      match lam0 with
+      | Llet (_, _, id, _, cont) when Hashtbl.mem static_id id ->
+          rewrite cont
+      | Lapply {ap_func = Lvar id; ap_args; _} when Hashtbl.mem static_id id ->
+         let st = Hashtbl.find static_id id in
+         let slot = Hashtbl.find slots id in
+         begin match exact_application slot.func ap_args with
+           | None -> assert false
+           | Some exact_args ->
+              Lstaticraise (st, List.map rewrite exact_args)
+         end
+      | lam ->
+          Lambda.shallow_map rewrite lam
+    in
+    List.fold_right
+      (fun (st, lf) lam ->
+         Lstaticcatch (lam, (st, lf.params), rewrite lf.body)
+      )
+      (LamTbl.find_all static lam0)
+      lam
+  in
+  if LamTbl.length static = 0 then
+    lam
+  else
+    rewrite lam
+
+(* The entry point:
+   simplification + emission of tailcall annotations, if needed. *)
+
+let simplify_lambda lam =
+  let lam =
+    lam
+    |> (if !Clflags.native_code || not !Clflags.debug
+        then simplify_local_functions else Fun.id
+       )
+    |> simplify_exits
+    |> simplify_lets
+  in
+  if !Clflags.annotations || Warnings.is_active Warnings.Expect_tailcall
+    then emit_tail_infos true lam;
+  lam
diff --git a/lambda/simplif.mli b/lambda/simplif.mli
new file mode 100644
index 00000000..a8011a20
--- /dev/null
+++ b/lambda/simplif.mli
@@ -0,0 +1,44 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Lambda simplification.
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+(* Elimination of useless Llet(Alias) bindings.
+   Transformation of let-bound references into variables.
+   Simplification over staticraise/staticcatch constructs.
+   Generation of tail-call annotations if -annot is set. *)
+
+open Lambda
+
+val simplify_lambda: lambda -> lambda
+
+val split_default_wrapper
+   : id:Ident.t
+  -> kind:function_kind
+  -> params:(Ident.t * Lambda.value_kind) list
+  -> return:Lambda.value_kind
+  -> body:lambda
+  -> attr:function_attribute
+  -> loc:Lambda.scoped_location
+  -> (Ident.t * lambda) list
+
+(* To be filled by asmcomp/selectgen.ml *)
+val is_tail_native_heuristic: (int -> bool) ref
+                          (* # arguments -> can tailcall *)
diff --git a/lambda/switch.ml b/lambda/switch.ml
new file mode 100644
index 00000000..032f0390
--- /dev/null
+++ b/lambda/switch.ml
@@ -0,0 +1,878 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Luc Maranget, projet Moscova, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2000 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 'a shared = Shared of 'a | Single of 'a
+
+type ('a, 'ctx) t_store =
+  {act_get : unit -> 'a array ;
+   act_get_shared : unit -> 'a shared array ;
+   act_store : 'ctx -> 'a -> int ;
+   act_store_shared : 'ctx -> 'a -> int ; }
+
+exception Not_simple
+
+module type Stored = sig
+  type t
+  type key
+  val compare_key : key -> key -> int
+  val make_key : t -> key option
+end
+
+module type CtxStored = sig
+  include Stored
+  type context
+  val make_key : context -> t -> key option
+end
+
+module CtxStore(A:CtxStored) = struct
+  module AMap =
+    Map.Make(struct type t = A.key let compare = A.compare_key end)
+
+  type intern =
+    { mutable map : (bool * int)  AMap.t ;
+      mutable next : int ;
+      mutable acts : (bool * A.t) list; }
+
+  let mk_store () =
+    let st =
+      { map = AMap.empty ;
+        next = 0 ;
+        acts = [] ; } in
+
+    let add mustshare act =
+      let i = st.next in
+      st.acts <- (mustshare,act) :: st.acts ;
+      st.next <- i+1 ;
+      i in
+
+    let store mustshare ctx act = match A.make_key ctx act with
+      | Some key ->
+          begin try
+            let (shared,i) = AMap.find key st.map in
+            if not shared then st.map <- AMap.add key (true,i) st.map ;
+            i
+          with Not_found ->
+            let i = add mustshare act in
+            st.map <- AMap.add key (mustshare,i) st.map ;
+            i
+          end
+      | None ->
+          add mustshare act
+
+    and get () = Array.of_list (List.rev_map (fun (_,act) -> act) st.acts)
+
+    and get_shared () =
+      let acts =
+        Array.of_list
+          (List.rev_map
+             (fun (shared,act) ->
+                if shared then Shared act else Single act)
+             st.acts) in
+      AMap.iter
+        (fun _ (shared,i) ->
+           if shared then match acts.(i) with
+             | Single act -> acts.(i) <- Shared act
+             | Shared _ -> ())
+        st.map ;
+      acts in
+    {act_store = store false ; act_store_shared = store true ;
+     act_get = get; act_get_shared = get_shared; }
+end
+
+module Store(A:Stored) = struct
+  module Me =
+    CtxStore
+      (struct
+        include A
+        type context = unit
+        let make_key () = A.make_key
+      end)
+
+  let mk_store = Me.mk_store
+end
+
+
+
+module type S =
+sig
+  type primitive
+  val eqint : primitive
+  val neint : primitive
+  val leint : primitive
+  val ltint : primitive
+  val geint : primitive
+  val gtint : primitive
+  type act
+  type loc
+
+  val bind : act -> (act -> act) -> act
+  val make_const : int -> act
+  val make_offset : act -> int -> act
+  val make_prim : primitive -> act list -> act
+  val make_isout : act -> act -> act
+  val make_isin : act -> act -> act
+  val make_if : act -> act -> act -> act
+  val make_switch : loc -> act -> int array -> act array -> act
+  val make_catch : act -> int * (act -> act)
+  val make_exit : int -> act
+end
+
+(* The module will ``produce good code for the case statement'' *)
+(*
+  Adaptation of
+   R.L. Berstein
+   ``Producing good code for the case statement''
+   Software Practice and Experience, 15(10) (1985)
+ and
+   D.L. Spuler
+    ``Two-Way Comparison Search Trees, a Generalisation of Binary Search Trees
+      and Split Trees''
+    ``Compiler Code Generation for Multiway Branch Statement as
+      a Static Search Problem''
+   Technical Reports, James Cook University
+*)
+(*
+  Main adaptation is considering interval tests
+ (implemented as one addition + one unsigned test and branch)
+  which leads to exhaustive search for finding the optimal
+  test sequence in small cases and heuristics otherwise.
+*)
+module Make (Arg : S) =
+struct
+
+  type 'a inter =
+    {cases : (int * int * int) array ;
+     actions : 'a array}
+
+  type 'a t_ctx =  {off : int ; arg : 'a}
+
+  let cut = ref 8
+  and more_cut = ref 16
+
+(*
+let pint chan i =
+  if i = min_int then Printf.fprintf chan "-oo"
+  else if i=max_int then Printf.fprintf chan "oo"
+  else Printf.fprintf chan "%d" i
+
+let pcases chan cases =
+  for i =0 to Array.length cases-1 do
+    let l,h,act = cases.(i) in
+    if l=h then
+      Printf.fprintf chan "%d:%d " l act
+    else
+      Printf.fprintf chan "%a..%a:%d " pint l pint h act
+  done
+
+let prerr_inter i = Printf.fprintf stderr
+        "cases=%a" pcases i.cases
+*)
+
+  let get_act cases i =
+    let _,_,r = cases.(i) in
+    r
+  and get_low cases i =
+    let r,_,_ = cases.(i) in
+    r
+
+  type ctests = {
+    mutable n : int ;
+    mutable ni : int ;
+  }
+
+  let too_much = {n=max_int ; ni=max_int}
+
+(*
+let ptests chan {n=n ; ni=ni} =
+  Printf.fprintf chan "{n=%d ; ni=%d}" n ni
+
+let pta chan t =
+  for i =0 to Array.length t-1 do
+    Printf.fprintf chan "%d: %a\n" i ptests t.(i)
+  done
+*)
+
+  let less_tests c1 c2 =
+    if c1.n < c2.n then
+      true
+    else if c1.n = c2.n then begin
+      if c1.ni < c2.ni then
+        true
+      else
+        false
+    end else
+      false
+
+  and eq_tests c1 c2 = c1.n = c2.n && c1.ni=c2.ni
+
+  let less2tests (c1,d1) (c2,d2) =
+    if eq_tests c1 c2 then
+      less_tests d1 d2
+    else
+      less_tests c1 c2
+
+  let add_test t1 t2 =
+    t1.n <- t1.n + t2.n ;
+    t1.ni <- t1.ni + t2.ni ;
+
+  type t_ret = Inter of int * int  | Sep of int | No
+
+(*
+let pret chan = function
+  | Inter (i,j)-> Printf.fprintf chan "Inter %d %d" i j
+  | Sep i -> Printf.fprintf chan "Sep %d" i
+  | No -> Printf.fprintf chan "No"
+*)
+
+  let coupe cases i =
+    let l,_,_ = cases.(i) in
+    l,
+    Array.sub cases 0 i,
+    Array.sub cases i (Array.length cases-i)
+
+
+  let case_append c1 c2 =
+    let len1 = Array.length c1
+    and len2 = Array.length c2 in
+    match len1,len2 with
+    | 0,_ -> c2
+    | _,0 -> c1
+    | _,_ ->
+        let l1,h1,act1 = c1.(Array.length c1-1)
+        and l2,h2,act2 = c2.(0) in
+        if act1 = act2 then
+          let r = Array.make (len1+len2-1) c1.(0) in
+          for i = 0 to len1-2 do
+            r.(i) <- c1.(i)
+          done ;
+
+          let l =
+            if len1-2 >= 0 then begin
+              let _,h,_ = r.(len1-2) in
+              if h+1 < l1 then
+                h+1
+              else
+                l1
+            end else
+              l1
+          and h =
+            if 1 < len2-1 then begin
+              let l,_,_ = c2.(1) in
+              if h2+1 < l then
+                l-1
+              else
+                h2
+            end else
+              h2 in
+          r.(len1-1) <- (l,h,act1) ;
+          for i=1 to len2-1  do
+            r.(len1-1+i) <- c2.(i)
+          done ;
+          r
+        else if h1 > l1 then
+          let r = Array.make (len1+len2) c1.(0) in
+          for i = 0 to len1-2 do
+            r.(i) <- c1.(i)
+          done ;
+          r.(len1-1) <- (l1,l2-1,act1) ;
+          for i=0 to len2-1  do
+            r.(len1+i) <- c2.(i)
+          done ;
+          r
+        else if h2 > l2 then
+          let r = Array.make (len1+len2) c1.(0) in
+          for i = 0 to len1-1 do
+            r.(i) <- c1.(i)
+          done ;
+          r.(len1) <- (h1+1,h2,act2) ;
+          for i=1 to len2-1  do
+            r.(len1+i) <- c2.(i)
+          done ;
+          r
+        else
+          Array.append c1 c2
+
+
+  let coupe_inter i j cases =
+    let lcases = Array.length cases in
+    let low,_,_ = cases.(i)
+    and _,high,_ = cases.(j) in
+    low,high,
+    Array.sub cases i (j-i+1),
+    case_append (Array.sub cases 0 i) (Array.sub cases (j+1) (lcases-(j+1)))
+
+  type kind = Kvalue of int | Kinter of int | Kempty
+
+(*
+let pkind chan = function
+  | Kvalue i ->Printf.fprintf chan "V%d" i
+  | Kinter i -> Printf.fprintf chan "I%d" i
+  | Kempty -> Printf.fprintf chan "E"
+
+let rec pkey chan  = function
+  | [] -> ()
+  | [k] -> pkind chan k
+  | k::rem ->
+      Printf.fprintf chan "%a %a" pkey rem pkind k
+*)
+
+  let t = Hashtbl.create 17
+
+  let make_key  cases =
+    let seen = ref []
+    and count = ref 0 in
+    let rec got_it act = function
+      | [] ->
+          seen := (act,!count):: !seen ;
+          let r = !count in
+          incr count ;
+          r
+      | (act0,index) :: rem ->
+          if act0 = act then
+            index
+          else
+            got_it act rem in
+
+    let make_one l h act =
+      if l=h then
+        Kvalue (got_it act !seen)
+      else
+        Kinter (got_it act !seen) in
+
+    let rec make_rec i pl =
+      if i < 0 then
+        []
+      else
+        let l,h,act = cases.(i) in
+        if pl = h+1 then
+          make_one l h act::make_rec (i-1) l
+        else
+          Kempty::make_one l h act::make_rec (i-1) l in
+
+    let l,h,act = cases.(Array.length cases-1) in
+    make_one l h act::make_rec (Array.length cases-2) l
+
+
+  let same_act t =
+    let len = Array.length t in
+    let a = get_act t (len-1) in
+    let rec do_rec i =
+      if i < 0 then true
+      else
+        let b = get_act t i in
+        b=a && do_rec (i-1) in
+    do_rec (len-2)
+
+
+(*
+  Interval test x in [l,h] works by checking x-l in [0,h-l]
+   * This may be false for arithmetic modulo 2^31
+   * Subtracting l may change the relative ordering of values
+     and invalid the invariant that matched values are given in
+     increasing order
+
+   To avoid this, interval check is allowed only when the
+   integers indeed present in the whole case interval are
+   in [-2^16 ; 2^16]
+
+   This condition is checked by zyva
+*)
+
+  let inter_limit = 1 lsl 16
+
+  let ok_inter = ref false
+
+  let rec opt_count top cases =
+    let key = make_key cases in
+    try
+      Hashtbl.find t key
+    with
+    | Not_found ->
+        let r =
+          let lcases = Array.length cases in
+          match lcases with
+          | 0 -> assert false
+          | _ when same_act cases -> No, ({n=0; ni=0},{n=0; ni=0})
+          | _ ->
+              if lcases < !cut then
+                enum top cases
+              else if lcases < !more_cut then
+                heuristic cases
+              else
+                divide cases in
+        Hashtbl.add t key r ;
+        r
+
+  and divide cases =
+    let lcases = Array.length cases in
+    let m = lcases/2 in
+    let _,left,right = coupe cases m in
+    let ci = {n=1 ; ni=0}
+    and cm = {n=1 ; ni=0}
+    and _,(cml,cleft) = opt_count false left
+    and _,(cmr,cright) = opt_count false right in
+    add_test ci cleft ;
+    add_test ci cright ;
+    if less_tests cml cmr then
+      add_test cm cmr
+    else
+      add_test cm cml ;
+    Sep m,(cm, ci)
+
+  and heuristic cases =
+    let lcases = Array.length cases in
+
+    let sep,csep = divide cases
+
+    and inter,cinter =
+      if !ok_inter then begin
+        let _,_,act0 = cases.(0)
+        and _,_,act1 = cases.(lcases-1) in
+        if act0 = act1 then begin
+          let low, high, inside, outside = coupe_inter 1 (lcases-2) cases in
+          let _,(cmi,cinside) = opt_count false inside
+          and _,(cmo,coutside) = opt_count false outside
+          and cmij = {n=1 ; ni=(if low=high then 0 else 1)}
+          and cij = {n=1 ; ni=(if low=high then 0 else 1)} in
+          add_test cij cinside ;
+          add_test cij coutside ;
+          if less_tests cmi cmo then
+            add_test cmij cmo
+          else
+            add_test cmij cmi ;
+          Inter (1,lcases-2),(cmij,cij)
+        end else
+          Inter (-1,-1),(too_much, too_much)
+      end else
+        Inter (-1,-1),(too_much, too_much) in
+    if less2tests csep cinter then
+      sep,csep
+    else
+      inter,cinter
+
+
+  and enum top cases =
+    let lcases = Array.length cases in
+    let lim, with_sep =
+      let best = ref (-1) and best_cost = ref (too_much,too_much) in
+
+      for i = 1 to lcases-(1) do
+        let _,left,right = coupe cases i in
+        let ci = {n=1 ; ni=0}
+        and cm = {n=1 ; ni=0}
+        and _,(cml,cleft) = opt_count false left
+        and _,(cmr,cright) = opt_count false right in
+        add_test ci cleft ;
+        add_test ci cright ;
+        if less_tests cml cmr then
+          add_test cm cmr
+        else
+          add_test cm cml ;
+
+        if
+          less2tests (cm,ci) !best_cost
+        then begin
+          if top then
+            Printf.fprintf stderr "Get it: %d\n" i ;
+          best := i ;
+          best_cost := (cm,ci)
+        end
+      done ;
+      !best, !best_cost in
+
+    let ilow, ihigh, with_inter =
+      if not !ok_inter then
+        let rlow = ref (-1) and rhigh = ref (-1)
+        and best_cost= ref (too_much,too_much) in
+        for i=1 to lcases-2 do
+          let low, high, inside, outside = coupe_inter i i cases in
+          if low=high then begin
+            let _,(cmi,cinside) = opt_count false inside
+            and _,(cmo,coutside) = opt_count false outside
+            and cmij = {n=1 ; ni=0}
+            and cij = {n=1 ; ni=0} in
+            add_test cij cinside ;
+            add_test cij coutside ;
+            if less_tests cmi cmo then
+              add_test cmij cmo
+            else
+              add_test cmij cmi ;
+            if less2tests (cmij,cij) !best_cost then begin
+              rlow := i ;
+              rhigh := i ;
+              best_cost := (cmij,cij)
+            end
+          end
+        done ;
+        !rlow, !rhigh, !best_cost
+      else
+        let rlow = ref (-1) and rhigh = ref (-1)
+        and best_cost= ref (too_much,too_much) in
+        for i=1 to lcases-2 do
+          for j=i to lcases-2 do
+            let low, high, inside, outside = coupe_inter i j cases in
+            let _,(cmi,cinside) = opt_count false inside
+            and _,(cmo,coutside) = opt_count false outside
+            and cmij = {n=1 ; ni=(if low=high then 0 else 1)}
+            and cij = {n=1 ; ni=(if low=high then 0 else 1)} in
+            add_test cij cinside ;
+            add_test cij coutside ;
+            if less_tests cmi cmo then
+              add_test cmij cmo
+            else
+              add_test cmij cmi ;
+            if less2tests (cmij,cij) !best_cost then begin
+              rlow := i ;
+              rhigh := j ;
+              best_cost := (cmij,cij)
+            end
+          done
+        done ;
+        !rlow, !rhigh, !best_cost in
+    let r = ref (Inter (ilow,ihigh)) and rc = ref with_inter in
+    if less2tests with_sep !rc then begin
+      r := Sep lim ; rc := with_sep
+    end ;
+    !r, !rc
+
+  let make_if_test test arg i ifso ifnot =
+    Arg.make_if
+      (Arg.make_prim test [arg ; Arg.make_const i])
+      ifso ifnot
+
+  let make_if_lt arg i  ifso ifnot = match i with
+    | 1 ->
+        make_if_test Arg.leint arg 0 ifso ifnot
+    | _ ->
+        make_if_test Arg.ltint arg i ifso ifnot
+
+  and make_if_ge arg i  ifso ifnot = match i with
+    | 1 ->
+        make_if_test Arg.gtint arg 0 ifso ifnot
+    | _ ->
+        make_if_test Arg.geint arg i ifso ifnot
+
+  and make_if_eq  arg i ifso ifnot =
+    make_if_test Arg.eqint arg i ifso ifnot
+
+  and make_if_ne  arg i ifso ifnot =
+    make_if_test Arg.neint arg i ifso ifnot
+
+  let do_make_if_out h arg ifso ifno =
+    Arg.make_if (Arg.make_isout h arg) ifso ifno
+
+  let make_if_out ctx l d mk_ifso mk_ifno = match l with
+    | 0 ->
+        do_make_if_out
+          (Arg.make_const d) ctx.arg (mk_ifso ctx) (mk_ifno ctx)
+    | _ ->
+        Arg.bind
+          (Arg.make_offset ctx.arg (-l))
+          (fun arg ->
+             let ctx = {off= (-l+ctx.off) ; arg=arg} in
+             do_make_if_out
+               (Arg.make_const d) arg (mk_ifso ctx) (mk_ifno ctx))
+
+  let do_make_if_in h arg ifso ifno =
+    Arg.make_if (Arg.make_isin h arg) ifso ifno
+
+  let make_if_in ctx l d mk_ifso mk_ifno = match l with
+    | 0 ->
+        do_make_if_in
+          (Arg.make_const d) ctx.arg (mk_ifso ctx) (mk_ifno ctx)
+    | _ ->
+        Arg.bind
+          (Arg.make_offset ctx.arg (-l))
+          (fun arg ->
+             let ctx = {off= (-l+ctx.off) ; arg=arg} in
+             do_make_if_in
+               (Arg.make_const d) arg (mk_ifso ctx) (mk_ifno ctx))
+
+  let rec c_test ctx ({cases=cases ; actions=actions} as s) =
+    let lcases = Array.length cases in
+    assert(lcases > 0) ;
+    if lcases = 1 then
+      actions.(get_act cases 0) ctx
+
+    else begin
+
+      let w,_c = opt_count false cases in
+(*
+  Printf.fprintf stderr
+  "off=%d tactic=%a for %a\n"
+  ctx.off pret w pcases cases ;
+  *)
+      match w with
+      | No -> actions.(get_act cases 0) ctx
+      | Inter (i,j) ->
+          let low,high,inside, outside = coupe_inter i j cases in
+          let _,(cinside,_) = opt_count false inside
+          and _,(coutside,_) = opt_count false outside in
+          (* Costs are retrieved to put the code with more remaining tests
+             in the privileged (positive) branch of ``if'' *)
+          if low=high then begin
+            if less_tests coutside cinside then
+              make_if_eq
+                ctx.arg
+                (low+ctx.off)
+                (c_test ctx {s with cases=inside})
+                (c_test ctx {s with cases=outside})
+            else
+              make_if_ne
+                ctx.arg
+                (low+ctx.off)
+                (c_test ctx {s with cases=outside})
+                (c_test ctx {s with cases=inside})
+          end else begin
+            if less_tests coutside cinside then
+              make_if_in
+                ctx
+                (low+ctx.off)
+                (high-low)
+                (fun ctx -> c_test ctx {s with cases=inside})
+                (fun ctx -> c_test ctx {s with cases=outside})
+            else
+              make_if_out
+                ctx
+                (low+ctx.off)
+                (high-low)
+                (fun ctx -> c_test ctx {s with cases=outside})
+                (fun ctx -> c_test ctx {s with cases=inside})
+          end
+      | Sep i ->
+          let lim,left,right = coupe cases i in
+          let _,(cleft,_) = opt_count false left
+          and _,(cright,_) = opt_count false right in
+          let left = {s with cases=left}
+          and right = {s with cases=right} in
+
+          if i=1 && (lim+ctx.off)=1 && get_low cases 0+ctx.off=0 then
+            Arg.make_if
+              ctx.arg
+              (c_test ctx right) (c_test ctx left)
+          else if less_tests cright cleft then
+            make_if_lt
+              ctx.arg (lim+ctx.off)
+              (c_test ctx left) (c_test ctx right)
+          else
+            make_if_ge
+              ctx.arg (lim+ctx.off)
+              (c_test ctx right) (c_test ctx left)
+
+    end
+
+
+  (* Minimal density of switches *)
+  let theta = ref 0.33333
+
+  (* Minimal number of tests to make a switch *)
+  let switch_min = ref 3
+
+  (* Particular case 0, 1, 2 *)
+  let particular_case cases i j =
+    j-i = 2 &&
+    (let l1,_h1,act1 = cases.(i)
+     and  l2,_h2,_act2 = cases.(i+1)
+     and  l3,h3,act3 = cases.(i+2) in
+     l1+1=l2 && l2+1=l3 && l3=h3 &&
+     act1 <> act3)
+
+  let approx_count cases i j =
+    let l = j-i+1 in
+    if l < !cut then
+      let _,(_,{n=ntests}) = opt_count false (Array.sub cases i l) in
+      ntests
+    else
+      l-1
+
+  (* Sends back a boolean that says whether is switch is worth or not *)
+
+  let dense {cases} i j =
+    if i=j then true
+    else
+      let l,_,_ = cases.(i)
+      and _,h,_ = cases.(j) in
+      let ntests =  approx_count cases i j in
+(*
+  (ntests+1) >= theta * (h-l+1)
+*)
+      particular_case cases i j ||
+      (ntests >= !switch_min &&
+       float_of_int ntests +. 1.0 >=
+       !theta *. (float_of_int h -. float_of_int l +. 1.0))
+
+  (* Compute clusters by dynamic programming
+     Adaptation of the correction to Bernstein
+     ``Correction to `Producing Good Code for the Case Statement' ''
+     S.K. Kannan and T.A. Proebsting
+     Software Practice and Experience Vol. 24(2) 233 (Feb 1994)
+  *)
+
+  let comp_clusters s =
+    let len = Array.length s.cases in
+    let min_clusters = Array.make len max_int
+    and k = Array.make len 0 in
+    let get_min i = if i < 0 then 0 else min_clusters.(i) in
+
+    for i = 0 to len-1 do
+      for j = 0 to i do
+        if
+          dense s j i &&
+          get_min (j-1) + 1 < min_clusters.(i)
+        then begin
+          k.(i) <- j ;
+          min_clusters.(i) <- get_min (j-1) + 1
+        end
+      done ;
+    done ;
+    min_clusters.(len-1),k
+
+  (* Assume j > i *)
+  let make_switch loc {cases=cases ; actions=actions} i j =
+    let ll,_,_ = cases.(i)
+    and _,hh,_ = cases.(j) in
+    let tbl = Array.make (hh-ll+1) 0
+    and t = Hashtbl.create 17
+    and index = ref 0 in
+    let get_index act =
+      try
+        Hashtbl.find t act
+      with
+      | Not_found ->
+          let i = !index in
+          incr index ;
+          Hashtbl.add t act i ;
+          i in
+
+    for k=i to j do
+      let l,h,act = cases.(k) in
+      let index = get_index act in
+      for kk=l-ll to h-ll do
+        tbl.(kk) <- index
+      done
+    done ;
+    let acts = Array.make !index actions.(0) in
+    Hashtbl.iter
+      (fun act i -> acts.(i) <- actions.(act))
+      t ;
+    (fun ctx ->
+       match -ll-ctx.off with
+       | 0 -> Arg.make_switch loc ctx.arg tbl acts
+       | _ ->
+           Arg.bind
+             (Arg.make_offset ctx.arg (-ll-ctx.off))
+             (fun arg -> Arg.make_switch loc arg tbl acts))
+
+
+  let make_clusters loc ({cases=cases ; actions=actions} as s) n_clusters k =
+    let len = Array.length cases in
+    let r = Array.make n_clusters (0,0,0)
+    and t = Hashtbl.create 17
+    and index = ref 0
+    and bidon = ref (Array.length actions) in
+    let get_index act =
+      try
+        let i,_ = Hashtbl.find t act in
+        i
+      with
+      | Not_found ->
+          let i = !index in
+          incr index ;
+          Hashtbl.add
+            t act
+            (i,(fun _ -> actions.(act))) ;
+          i
+    and add_index act =
+      let i = !index in
+      incr index ;
+      incr bidon ;
+      Hashtbl.add t !bidon (i,act) ;
+      i in
+
+    let rec zyva j ir =
+      let i = k.(j) in
+      begin if i=j then
+          let l,h,act = cases.(i) in
+          r.(ir) <- (l,h,get_index act)
+        else (* assert i < j *)
+          let l,_,_ = cases.(i)
+          and _,h,_ = cases.(j) in
+          r.(ir) <- (l,h,add_index (make_switch loc s i j))
+      end ;
+      if i > 0 then zyva (i-1) (ir-1) in
+
+    zyva (len-1) (n_clusters-1) ;
+    let acts = Array.make !index (fun _ -> assert false) in
+    Hashtbl.iter (fun _ (i,act) -> acts.(i) <- act) t ;
+    {cases = r ; actions = acts}
+  ;;
+
+
+  let do_zyva loc (low,high) arg cases actions =
+    let old_ok = !ok_inter in
+    ok_inter := (abs low <= inter_limit && abs high <= inter_limit) ;
+    if !ok_inter <> old_ok then Hashtbl.clear t ;
+
+    let s = {cases=cases ; actions=actions} in
+
+(*
+  Printf.eprintf "ZYVA: %B [low=%i,high=%i]\n" !ok_inter low high ;
+  pcases stderr cases ;
+  prerr_endline "" ;
+*)
+    let n_clusters,k = comp_clusters s in
+    let clusters = make_clusters loc s n_clusters k in
+    c_test {arg=arg ; off=0} clusters
+
+  let abstract_shared actions =
+    let handlers = ref (fun x -> x) in
+    let actions =
+      Array.map
+        (fun act -> match  act with
+           | Single act -> act
+           | Shared act ->
+               let i,h = Arg.make_catch act in
+               let oh = !handlers in
+               handlers := (fun act -> h (oh act)) ;
+               Arg.make_exit i)
+        actions in
+    !handlers,actions
+
+  let zyva loc lh arg cases actions =
+    assert (Array.length cases > 0) ;
+    let actions = actions.act_get_shared () in
+    let hs,actions = abstract_shared actions in
+    hs (do_zyva loc lh arg cases actions)
+
+  and test_sequence arg cases actions =
+    assert (Array.length cases > 0) ;
+    let actions = actions.act_get_shared () in
+    let hs,actions = abstract_shared actions in
+    let old_ok = !ok_inter in
+    ok_inter := false ;
+    if !ok_inter <> old_ok then Hashtbl.clear t ;
+    let s =
+      {cases=cases ;
+       actions=Array.map (fun act -> (fun _ -> act)) actions} in
+(*
+  Printf.eprintf "SEQUENCE: %B\n" !ok_inter ;
+  pcases stderr cases ;
+  prerr_endline "" ;
+*)
+    hs (c_test {arg=arg ; off=0} s)
+  ;;
+
+end
diff --git a/lambda/switch.mli b/lambda/switch.mli
new file mode 100644
index 00000000..f71240b7
--- /dev/null
+++ b/lambda/switch.mli
@@ -0,0 +1,130 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Luc Maranget, projet Moscova, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2000 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 transforms generic switches in combinations
+  of if tests and switches.
+*)
+
+(* For detecting action sharing, object style *)
+
+(* Store for actions in object style:
+  act_store : store an action, returns index in table
+              In case an action with equal key exists, returns index
+              of the stored action. Otherwise add entry in table.
+  act_store_shared : This stored action will always be shared.
+  act_get   : retrieve table
+  act_get_shared : retrieve table, with sharing explicit
+*)
+
+type 'a shared = Shared of 'a | Single of 'a
+
+type ('a, 'ctx) t_store =
+    {act_get : unit -> 'a array ;
+     act_get_shared : unit -> 'a shared array ;
+     act_store : 'ctx -> 'a -> int ;
+     act_store_shared : 'ctx -> 'a -> int ; }
+
+exception Not_simple
+
+module type Stored = sig
+  type t
+  type key
+  val compare_key : key -> key -> int
+  val make_key : t -> key option
+end
+
+module type CtxStored = sig
+  include Stored
+  type context
+  val make_key : context -> t -> key option
+end
+
+module CtxStore(A:CtxStored) :
+    sig
+      val mk_store : unit -> (A.t, A.context) t_store
+    end
+
+module Store(A:Stored) :
+    sig
+      val mk_store : unit -> (A.t, unit) t_store
+    end
+
+(* Arguments to the Make functor *)
+module type S =
+  sig
+    (* type of basic tests *)
+    type primitive
+    (* basic tests themselves *)
+    val eqint : primitive
+    val neint : primitive
+    val leint : primitive
+    val ltint : primitive
+    val geint : primitive
+    val gtint : primitive
+    (* type of actions *)
+    type act
+    (* type of source locations *)
+    type loc
+
+    (* Various constructors, for making a binder,
+        adding one integer, etc. *)
+    val bind : act -> (act -> act) -> act
+    val make_const : int -> act
+    val make_offset : act -> int -> act
+    val make_prim : primitive -> act list -> act
+    val make_isout : act -> act -> act
+    val make_isin : act -> act -> act
+    val make_if : act -> act -> act -> act
+   (* construct an actual switch :
+      make_switch arg cases acts
+      NB:  cases is in the value form *)
+    val make_switch : loc -> act -> int array -> act array -> act
+   (* Build last minute sharing of action stuff *)
+   val make_catch : act -> int * (act -> act)
+   val make_exit : int -> act
+
+  end
+
+
+(*
+  Make.zyva arg low high cases actions where
+    - arg is the argument of the switch.
+    - low, high are the interval limits.
+    - cases is a list of sub-interval and action indices
+    - actions is an array of actions.
+
+  All these arguments specify a switch construct and zyva
+  returns an action that performs the switch.
+*)
+module Make :
+  functor (Arg : S) ->
+    sig
+(* Standard entry point, sharing is tracked *)
+      val zyva :
+          Arg.loc ->
+          (int * int) ->
+           Arg.act ->
+           (int * int * int) array ->
+           (Arg.act, _) t_store ->
+           Arg.act
+
+(* Output test sequence, sharing tracked *)
+     val test_sequence :
+           Arg.act ->
+           (int * int * int) array ->
+           (Arg.act, _) t_store ->
+           Arg.act
+    end
diff --git a/lambda/translattribute.ml b/lambda/translattribute.ml
new file mode 100644
index 00000000..d2d48c84
--- /dev/null
+++ b/lambda/translattribute.ml
@@ -0,0 +1,333 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                      Pierre Chambart, OCamlPro                         *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Typedtree
+open Lambda
+open Location
+
+let is_inline_attribute = function
+  | {txt=("inline"|"ocaml.inline")} -> true
+  | _ -> false
+
+let is_inlined_attribute = function
+  | {txt=("inlined"|"ocaml.inlined")} -> true
+  | {txt=("unrolled"|"ocaml.unrolled")} when Config.flambda -> true
+  | _ -> false
+
+let is_specialise_attribute = function
+  | {txt=("specialise"|"ocaml.specialise")} when Config.flambda -> true
+  | _ -> false
+
+let is_specialised_attribute = function
+  | {txt=("specialised"|"ocaml.specialised")} when Config.flambda -> true
+  | _ -> false
+
+let is_local_attribute = function
+  | {txt=("local"|"ocaml.local")} -> true
+  | _ -> false
+
+let find_attribute p attributes =
+  let inline_attribute, other_attributes =
+    List.partition (fun a -> p a.Parsetree.attr_name) attributes
+  in
+  let attr =
+    match inline_attribute with
+    | [] -> None
+    | [attr] -> Some attr
+    | _ :: {Parsetree.attr_name = {txt;loc}; _} :: _ ->
+      Location.prerr_warning loc (Warnings.Duplicated_attribute txt);
+      None
+  in
+  attr, other_attributes
+
+let is_unrolled = function
+  | {txt="unrolled"|"ocaml.unrolled"} -> true
+  | {txt="inline"|"ocaml.inline"|"inlined"|"ocaml.inlined"} -> false
+  | _ -> assert false
+
+let get_id_payload =
+  let open Parsetree in
+  function
+  | PStr [] -> Some ""
+  | PStr [{pstr_desc = Pstr_eval ({pexp_desc},[])}] ->
+      begin match pexp_desc with
+      | Pexp_ident { txt = Longident.Lident id } -> Some id
+      | _ -> None
+      end
+  | _ -> None
+
+let parse_id_payload txt loc ~default ~empty cases payload =
+  let[@local] warn () =
+    let ( %> ) f g x = g (f x) in
+    let msg =
+      cases
+      |> List.map (fst %> Printf.sprintf "'%s'")
+      |> String.concat ", "
+      |> Printf.sprintf "It must be either %s or empty"
+    in
+    Location.prerr_warning loc (Warnings.Attribute_payload (txt, msg));
+    default
+  in
+  match get_id_payload payload with
+  | Some "" -> empty
+  | None -> warn ()
+  | Some id ->
+      match List.assoc_opt id cases with
+      | Some r -> r
+      | None -> warn ()
+
+let parse_inline_attribute attr =
+  match attr with
+  | None -> Default_inline
+  | Some {Parsetree.attr_name = {txt;loc} as id; attr_payload = payload} ->
+    let open Parsetree in
+    if is_unrolled id then begin
+      (* the 'unrolled' attributes must be used as [@unrolled n]. *)
+      let warning txt = Warnings.Attribute_payload
+          (txt, "It must be an integer literal")
+      in
+      match payload with
+      | PStr [{pstr_desc = Pstr_eval ({pexp_desc},[])}] -> begin
+          match pexp_desc with
+          | Pexp_constant (Pconst_integer(s, None)) -> begin
+              try
+                Unroll (Misc.Int_literal_converter.int s)
+              with Failure _ ->
+                Location.prerr_warning loc (warning txt);
+                Default_inline
+            end
+          | _ ->
+            Location.prerr_warning loc (warning txt);
+            Default_inline
+        end
+      | _ ->
+        Location.prerr_warning loc (warning txt);
+        Default_inline
+    end else
+      parse_id_payload txt loc
+        ~default:Default_inline
+        ~empty:Always_inline
+        [
+          "never", Never_inline;
+          "always", Always_inline;
+          "hint", Hint_inline;
+        ]
+        payload
+
+let parse_specialise_attribute attr =
+  match attr with
+  | None -> Default_specialise
+  | Some {Parsetree.attr_name = {txt; loc}; attr_payload = payload} ->
+      parse_id_payload txt loc
+        ~default:Default_specialise
+        ~empty:Always_specialise
+        [
+          "never", Never_specialise;
+          "always", Always_specialise;
+        ]
+        payload
+
+let parse_local_attribute attr =
+  match attr with
+  | None -> Default_local
+  | Some {Parsetree.attr_name = {txt; loc}; attr_payload = payload} ->
+      parse_id_payload txt loc
+        ~default:Default_local
+        ~empty:Always_local
+        [
+          "never", Never_local;
+          "always", Always_local;
+          "maybe", Default_local;
+        ]
+        payload
+
+let get_inline_attribute l =
+  let attr, _ = find_attribute is_inline_attribute l in
+  parse_inline_attribute attr
+
+let get_specialise_attribute l =
+  let attr, _ = find_attribute is_specialise_attribute l in
+  parse_specialise_attribute attr
+
+let get_local_attribute l =
+  let attr, _ = find_attribute is_local_attribute l in
+  parse_local_attribute attr
+
+let check_local_inline loc attr =
+  match attr.local, attr.inline with
+  | Always_local, (Always_inline | Hint_inline | Unroll _) ->
+      Location.prerr_warning loc
+        (Warnings.Duplicated_attribute "local/inline")
+  | _ ->
+      ()
+
+let add_inline_attribute expr loc attributes =
+  match expr, get_inline_attribute attributes with
+  | expr, Default_inline -> expr
+  | Lfunction({ attr = { stub = false } as attr } as funct), inline ->
+      begin match attr.inline with
+      | Default_inline -> ()
+      | Always_inline | Hint_inline | Never_inline | Unroll _ ->
+          Location.prerr_warning loc
+            (Warnings.Duplicated_attribute "inline")
+      end;
+      let attr = { attr with inline } in
+      check_local_inline loc attr;
+      Lfunction { funct with attr = attr }
+  | expr, (Always_inline | Hint_inline | Never_inline | Unroll _) ->
+      Location.prerr_warning loc
+        (Warnings.Misplaced_attribute "inline");
+      expr
+
+let add_specialise_attribute expr loc attributes =
+  match expr, get_specialise_attribute attributes with
+  | expr, Default_specialise -> expr
+  | Lfunction({ attr = { stub = false } as attr } as funct), specialise ->
+      begin match attr.specialise with
+      | Default_specialise -> ()
+      | Always_specialise | Never_specialise ->
+          Location.prerr_warning loc
+            (Warnings.Duplicated_attribute "specialise")
+      end;
+      let attr = { attr with specialise } in
+      Lfunction { funct with attr }
+  | expr, (Always_specialise | Never_specialise) ->
+      Location.prerr_warning loc
+        (Warnings.Misplaced_attribute "specialise");
+      expr
+
+let add_local_attribute expr loc attributes =
+  match expr, get_local_attribute attributes with
+  | expr, Default_local -> expr
+  | Lfunction({ attr = { stub = false } as attr } as funct), local ->
+      begin match attr.local with
+      | Default_local -> ()
+      | Always_local | Never_local ->
+          Location.prerr_warning loc
+            (Warnings.Duplicated_attribute "local")
+      end;
+      let attr = { attr with local } in
+      check_local_inline loc attr;
+      Lfunction { funct with attr }
+  | expr, (Always_local | Never_local) ->
+      Location.prerr_warning loc
+        (Warnings.Misplaced_attribute "local");
+      expr
+
+(* Get the [@inlined] attribute payload (or default if not present).
+   It also returns the expression without this attribute. This is
+   used to ensure that this attribute is not misplaced: If it
+   appears on any expression, it is an error, otherwise it would
+   have been removed by this function *)
+let get_and_remove_inlined_attribute e =
+  let attr, exp_attributes =
+    find_attribute is_inlined_attribute e.exp_attributes
+  in
+  let inlined = parse_inline_attribute attr in
+  inlined, { e with exp_attributes }
+
+let get_and_remove_inlined_attribute_on_module e =
+  let rec get_and_remove mod_expr =
+    let attr, mod_attributes =
+      find_attribute is_inlined_attribute mod_expr.mod_attributes
+    in
+    let attr = parse_inline_attribute attr in
+    let attr, mod_desc =
+      match mod_expr.Typedtree.mod_desc with
+      | Tmod_constraint (me, mt, mtc, mc) ->
+        let inner_attr, me = get_and_remove me in
+        let attr =
+          match attr with
+          | Always_inline | Hint_inline | Never_inline | Unroll _ -> attr
+          | Default_inline -> inner_attr
+        in
+        attr, Tmod_constraint (me, mt, mtc, mc)
+      | md -> attr, md
+    in
+    attr, { mod_expr with mod_desc; mod_attributes }
+  in
+  get_and_remove e
+
+let get_and_remove_specialised_attribute e =
+  let attr, exp_attributes =
+    find_attribute is_specialised_attribute e.exp_attributes
+  in
+  let specialised = parse_specialise_attribute attr in
+  specialised, { e with exp_attributes }
+
+(* It also removes the attribute from the expression, like
+   get_inlined_attribute *)
+let get_tailcall_attribute e =
+  let is_tailcall_attribute = function
+    | {Parsetree.attr_name = {txt=("tailcall"|"ocaml.tailcall")}; _} -> true
+    | _ -> false
+  in
+  let tailcalls, exp_attributes =
+    List.partition is_tailcall_attribute e.exp_attributes
+  in
+  match tailcalls with
+  | [] -> false, e
+  | _ :: r ->
+      begin match r with
+      | [] -> ()
+      | {Parsetree.attr_name = {txt;loc}; _} :: _ ->
+          Location.prerr_warning loc (Warnings.Duplicated_attribute txt)
+      end;
+      true, { e with exp_attributes }
+
+let check_attribute e {Parsetree.attr_name = { txt; loc }; _} =
+  match txt with
+  | "inline" | "ocaml.inline"
+  | "specialise" | "ocaml.specialise" -> begin
+      match e.exp_desc with
+      | Texp_function _ -> ()
+      | _ ->
+          Location.prerr_warning loc
+            (Warnings.Misplaced_attribute txt)
+    end
+  | "inlined" | "ocaml.inlined"
+  | "specialised" | "ocaml.specialised"
+  | "tailcall" | "ocaml.tailcall" ->
+      (* Removed by the Texp_apply cases *)
+      Location.prerr_warning loc
+        (Warnings.Misplaced_attribute txt)
+  | _ -> ()
+
+let check_attribute_on_module e {Parsetree.attr_name = { txt; loc }; _} =
+  match txt with
+  | "inline" | "ocaml.inline" ->  begin
+      match e.mod_desc with
+      | Tmod_functor _ -> ()
+      | _ ->
+          Location.prerr_warning loc
+            (Warnings.Misplaced_attribute txt)
+    end
+  | "inlined" | "ocaml.inlined" ->
+      (* Removed by the Texp_apply cases *)
+      Location.prerr_warning loc
+        (Warnings.Misplaced_attribute txt)
+  | _ -> ()
+
+let add_function_attributes lam loc attr =
+  let lam =
+    add_inline_attribute lam loc attr
+  in
+  let lam =
+    add_specialise_attribute lam loc attr
+  in
+  let lam =
+    add_local_attribute lam loc attr
+  in
+  lam
diff --git a/lambda/translattribute.mli b/lambda/translattribute.mli
new file mode 100644
index 00000000..bf22fd1c
--- /dev/null
+++ b/lambda/translattribute.mli
@@ -0,0 +1,76 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                      Pierre Chambart, OCamlPro                         *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+val check_attribute
+   : Typedtree.expression
+  -> Parsetree.attribute
+  -> unit
+
+val check_attribute_on_module
+   : Typedtree.module_expr
+  -> Parsetree.attribute
+  -> unit
+
+val add_inline_attribute
+   : Lambda.lambda
+  -> Location.t
+  -> Parsetree.attributes
+  -> Lambda.lambda
+
+val get_inline_attribute
+   : Parsetree.attributes
+  -> Lambda.inline_attribute
+
+val add_specialise_attribute
+   : Lambda.lambda
+  -> Location.t
+  -> Parsetree.attributes
+  -> Lambda.lambda
+
+val get_specialise_attribute
+   : Parsetree.attributes
+  -> Lambda.specialise_attribute
+
+val add_local_attribute
+   : Lambda.lambda
+  -> Location.t
+  -> Parsetree.attributes
+  -> Lambda.lambda
+
+val get_local_attribute
+   : Parsetree.attributes
+  -> Lambda.local_attribute
+
+val get_and_remove_inlined_attribute
+   : Typedtree.expression
+  -> Lambda.inline_attribute * Typedtree.expression
+
+val get_and_remove_inlined_attribute_on_module
+   : Typedtree.module_expr
+  -> Lambda.inline_attribute * Typedtree.module_expr
+
+val get_and_remove_specialised_attribute
+   : Typedtree.expression
+  -> Lambda.specialise_attribute * Typedtree.expression
+
+val get_tailcall_attribute
+   : Typedtree.expression
+  -> bool * Typedtree.expression
+
+val add_function_attributes
+  : Lambda.lambda
+  -> Location.t
+  -> Parsetree.attributes
+  -> Lambda.lambda
diff --git a/lambda/translclass.ml b/lambda/translclass.ml
new file mode 100644
index 00000000..1f39ea10
--- /dev/null
+++ b/lambda/translclass.ml
@@ -0,0 +1,966 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Asttypes
+open Types
+open Typedtree
+open Lambda
+open Translobj
+open Translcore
+open Debuginfo.Scoped_location
+
+(* XXX Rajouter des evenements... | Add more events... *)
+
+type error = Tags of label * label
+
+exception Error of Location.t * error
+
+let lfunction params body =
+  if params = [] then body else
+  match body with
+  | Lfunction {kind = Curried; params = params'; body = body'; attr; loc} ->
+      Lfunction {kind = Curried; params = params @ params';
+                 return = Pgenval;
+                 body = body'; attr;
+                 loc}
+  |  _ ->
+      Lfunction {kind = Curried; params; return = Pgenval;
+                 body;
+                 attr = default_function_attribute;
+                 loc = Loc_unknown}
+
+let lapply ap =
+  match ap.ap_func with
+    Lapply ap' ->
+      Lapply {ap with ap_func = ap'.ap_func; ap_args = ap'.ap_args @ ap.ap_args}
+  | _ ->
+      Lapply ap
+
+let mkappl (func, args) =
+  Lapply {ap_should_be_tailcall=false;
+          ap_loc=Loc_unknown;
+          ap_func=func;
+          ap_args=args;
+          ap_inlined=Default_inline;
+          ap_specialised=Default_specialise};;
+
+let lsequence l1 l2 =
+  if l2 = lambda_unit then l1 else Lsequence(l1, l2)
+
+let lfield v i = Lprim(Pfield i, [Lvar v], Loc_unknown)
+
+let transl_label l = share (Const_immstring l)
+
+let transl_meth_list lst =
+  if lst = [] then Lconst (Const_pointer 0) else
+  share (Const_block
+            (0, List.map (fun lab -> Const_immstring lab) lst))
+
+let set_inst_var ~scopes obj id expr =
+  Lprim(Psetfield_computed (Typeopt.maybe_pointer expr, Assignment),
+    [Lvar obj; Lvar id; transl_exp ~scopes expr], Loc_unknown)
+
+let transl_val tbl create name =
+  mkappl (oo_prim (if create then "new_variable" else "get_variable"),
+          [Lvar tbl; transl_label name])
+
+let transl_vals tbl create strict vals rem =
+  List.fold_right
+    (fun (name, id) rem ->
+      Llet(strict, Pgenval, id, transl_val tbl create name, rem))
+    vals rem
+
+let meths_super tbl meths inh_meths =
+  List.fold_right
+    (fun (nm, id) rem ->
+       try
+         (nm, id,
+          mkappl(oo_prim "get_method", [Lvar tbl; Lvar (Meths.find nm meths)]))
+         :: rem
+       with Not_found -> rem)
+    inh_meths []
+
+let bind_super tbl (vals, meths) cl_init =
+  transl_vals tbl false StrictOpt vals
+    (List.fold_right (fun (_nm, id, def) rem ->
+         Llet(StrictOpt, Pgenval, id, def, rem))
+       meths cl_init)
+
+let create_object cl obj init =
+  let obj' = Ident.create_local "self" in
+  let (inh_init, obj_init, has_init) = init obj' in
+  if obj_init = lambda_unit then
+    (inh_init,
+     mkappl (oo_prim (if has_init then "create_object_and_run_initializers"
+                      else"create_object_opt"),
+             [obj; Lvar cl]))
+  else begin
+   (inh_init,
+    Llet(Strict, Pgenval, obj',
+            mkappl (oo_prim "create_object_opt", [obj; Lvar cl]),
+         Lsequence(obj_init,
+                   if not has_init then Lvar obj' else
+                   mkappl (oo_prim "run_initializers_opt",
+                           [obj; Lvar obj'; Lvar cl]))))
+  end
+
+let name_pattern default p =
+  match p.pat_desc with
+  | Tpat_var (id, _) -> id
+  | Tpat_alias(_, id, _) -> id
+  | _ -> Ident.create_local default
+
+let rec build_object_init ~scopes cl_table obj params inh_init obj_init cl =
+  match cl.cl_desc with
+    Tcl_ident (path, _, _) ->
+      let obj_init = Ident.create_local "obj_init" in
+      let envs, inh_init = inh_init in
+      let env =
+        match envs with None -> []
+        | Some envs ->
+            [Lprim(Pfield (List.length inh_init + 1),
+                   [Lvar envs],
+                   Loc_unknown)]
+      in
+      let loc = of_location ~scopes cl.cl_loc in
+      let path_lam = transl_class_path loc cl.cl_env path in
+      ((envs, (path, path_lam, obj_init) :: inh_init),
+       mkappl(Lvar obj_init, env @ [obj]))
+  | Tcl_structure str ->
+      create_object cl_table obj (fun obj ->
+        let (inh_init, obj_init, has_init) =
+          List.fold_right
+            (fun field (inh_init, obj_init, has_init) ->
+               match field.cf_desc with
+                 Tcf_inherit (_, cl, _, _, _) ->
+                   let (inh_init, obj_init') =
+                     build_object_init ~scopes cl_table (Lvar obj) [] inh_init
+                       (fun _ -> lambda_unit) cl
+                   in
+                   (inh_init, lsequence obj_init' obj_init, true)
+               | Tcf_val (_, _, id, Tcfk_concrete (_, exp), _) ->
+                   (inh_init,
+                    lsequence (set_inst_var ~scopes obj id exp) obj_init,
+                    has_init)
+               | Tcf_method _ | Tcf_val _ | Tcf_constraint _ | Tcf_attribute _->
+                   (inh_init, obj_init, has_init)
+               | Tcf_initializer _ ->
+                   (inh_init, obj_init, true)
+            )
+            str.cstr_fields
+            (inh_init, obj_init obj, false)
+        in
+        (inh_init,
+         List.fold_right
+           (fun (id, expr) rem ->
+              lsequence (Lifused (id, set_inst_var ~scopes obj id expr)) rem)
+           params obj_init,
+         has_init))
+  | Tcl_fun (_, pat, vals, cl, partial) ->
+      let (inh_init, obj_init) =
+        build_object_init ~scopes cl_table obj (vals @ params)
+          inh_init obj_init cl
+      in
+      (inh_init,
+       let build params rem =
+         let param = name_pattern "param" pat in
+         Lfunction {kind = Curried; params = (param, Pgenval)::params;
+                    return = Pgenval;
+                    attr = default_function_attribute;
+                    loc = of_location ~scopes pat.pat_loc;
+                    body = Matching.for_function ~scopes pat.pat_loc
+                             None (Lvar param) [pat, rem] partial}
+       in
+       begin match obj_init with
+         Lfunction {kind = Curried; params; body = rem} -> build params rem
+       | rem                                            -> build [] rem
+       end)
+  | Tcl_apply (cl, oexprs) ->
+      let (inh_init, obj_init) =
+        build_object_init ~scopes cl_table obj params inh_init obj_init cl
+      in
+      (inh_init, transl_apply ~scopes obj_init oexprs Loc_unknown)
+  | Tcl_let (rec_flag, defs, vals, cl) ->
+      let (inh_init, obj_init) =
+        build_object_init ~scopes cl_table obj (vals @ params)
+          inh_init obj_init cl
+      in
+      (inh_init, Translcore.transl_let ~scopes rec_flag defs obj_init)
+  | Tcl_open (_, cl)
+  | Tcl_constraint (cl, _, _, _, _) ->
+      build_object_init ~scopes cl_table obj params inh_init obj_init cl
+
+let rec build_object_init_0
+          ~scopes cl_table params cl copy_env subst_env top ids =
+  match cl.cl_desc with
+    Tcl_let (_rec_flag, _defs, vals, cl) ->
+      build_object_init_0
+        ~scopes cl_table (vals@params) cl copy_env subst_env top ids
+  | _ ->
+      let self = Ident.create_local "self" in
+      let env = Ident.create_local "env" in
+      let obj = if ids = [] then lambda_unit else Lvar self in
+      let envs = if top then None else Some env in
+      let ((_,inh_init), obj_init) =
+        build_object_init ~scopes cl_table obj params (envs,[]) copy_env cl in
+      let obj_init =
+        if ids = [] then obj_init else lfunction [self, Pgenval] obj_init in
+      (inh_init, lfunction [env, Pgenval] (subst_env env inh_init obj_init))
+
+
+let bind_method tbl lab id cl_init =
+  Llet(Strict, Pgenval, id, mkappl (oo_prim "get_method_label",
+                           [Lvar tbl; transl_label lab]),
+       cl_init)
+
+let bind_methods tbl meths vals cl_init =
+  let methl = Meths.fold (fun lab id tl -> (lab,id) :: tl) meths [] in
+  let len = List.length methl and nvals = List.length vals in
+  if len < 2 && nvals = 0 then Meths.fold (bind_method tbl) meths cl_init else
+  if len = 0 && nvals < 2 then transl_vals tbl true Strict vals cl_init else
+  let ids = Ident.create_local "ids" in
+  let i = ref (len + nvals) in
+  let getter, names =
+    if nvals = 0 then "get_method_labels", [] else
+    "new_methods_variables", [transl_meth_list (List.map fst vals)]
+  in
+  Llet(Strict, Pgenval, ids,
+       mkappl (oo_prim getter,
+               [Lvar tbl; transl_meth_list (List.map fst methl)] @ names),
+       List.fold_right
+         (fun (_lab,id) lam -> decr i; Llet(StrictOpt, Pgenval, id,
+                                           lfield ids !i, lam))
+         (methl @ vals) cl_init)
+
+let output_methods tbl methods lam =
+  match methods with
+    [] -> lam
+  | [lab; code] ->
+      lsequence (mkappl(oo_prim "set_method", [Lvar tbl; lab; code])) lam
+  | _ ->
+      lsequence (mkappl(oo_prim "set_methods",
+                        [Lvar tbl; Lprim(Pmakeblock(0,Immutable,None),
+                                         methods, Loc_unknown)]))
+        lam
+
+let rec ignore_cstrs cl =
+  match cl.cl_desc with
+    Tcl_constraint (cl, _, _, _, _) -> ignore_cstrs cl
+  | Tcl_apply (cl, _) -> ignore_cstrs cl
+  | _ -> cl
+
+let rec index a = function
+    [] -> raise Not_found
+  | b :: l ->
+      if b = a then 0 else 1 + index a l
+
+let bind_id_as_val (id, _) = ("", id)
+
+let rec build_class_init ~scopes cla cstr super inh_init cl_init msubst top cl =
+  match cl.cl_desc with
+  | Tcl_ident _ ->
+      begin match inh_init with
+      | (_, path_lam, obj_init)::inh_init ->
+          (inh_init,
+           Llet (Strict, Pgenval, obj_init,
+                 mkappl(Lprim(Pfield 1, [path_lam], Loc_unknown), Lvar cla ::
+                        if top then [Lprim(Pfield 3, [path_lam], Loc_unknown)]
+                        else []),
+                 bind_super cla super cl_init))
+      | _ ->
+          assert false
+      end
+  | Tcl_structure str ->
+      let cl_init = bind_super cla super cl_init in
+      let (inh_init, cl_init, methods, values) =
+        List.fold_right
+          (fun field (inh_init, cl_init, methods, values) ->
+            match field.cf_desc with
+              Tcf_inherit (_, cl, _, vals, meths) ->
+                let cl_init = output_methods cla methods cl_init in
+                let inh_init, cl_init =
+                  build_class_init ~scopes cla false
+                    (vals, meths_super cla str.cstr_meths meths)
+                    inh_init cl_init msubst top cl in
+                (inh_init, cl_init, [], values)
+            | Tcf_val (name, _, id, _, over) ->
+                let values =
+                  if over then values else (name.txt, id) :: values
+                in
+                (inh_init, cl_init, methods, values)
+            | Tcf_method (_, _, Tcfk_virtual _)
+            | Tcf_constraint _
+              ->
+                (inh_init, cl_init, methods, values)
+            | Tcf_method (name, _, Tcfk_concrete (_, exp)) ->
+                let scopes = enter_method_definition ~scopes name.txt in
+                let met_code =
+                  msubst true (transl_scoped_exp ~scopes exp) in
+                let met_code =
+                  if !Clflags.native_code && List.length met_code = 1 then
+                    (* Force correct naming of method for profiles *)
+                    let met = Ident.create_local ("method_" ^ name.txt) in
+                    [Llet(Strict, Pgenval, met, List.hd met_code, Lvar met)]
+                  else met_code
+                in
+                (inh_init, cl_init,
+                 Lvar(Meths.find name.txt str.cstr_meths) :: met_code @ methods,
+                 values)
+            | Tcf_initializer exp ->
+                (inh_init,
+                 Lsequence(mkappl (oo_prim "add_initializer",
+                                   Lvar cla :: msubst false
+                                                 (transl_exp ~scopes exp)),
+                           cl_init),
+                 methods, values)
+            | Tcf_attribute _ ->
+                (inh_init, cl_init, methods, values))
+          str.cstr_fields
+          (inh_init, cl_init, [], [])
+      in
+      let cl_init = output_methods cla methods cl_init in
+      (inh_init, bind_methods cla str.cstr_meths values cl_init)
+  | Tcl_fun (_, _pat, vals, cl, _) ->
+      let (inh_init, cl_init) =
+        build_class_init ~scopes cla cstr super inh_init cl_init msubst top cl
+      in
+      let vals = List.map bind_id_as_val vals in
+      (inh_init, transl_vals cla true StrictOpt vals cl_init)
+  | Tcl_apply (cl, _exprs) ->
+      build_class_init ~scopes cla cstr super inh_init cl_init msubst top cl
+  | Tcl_let (_rec_flag, _defs, vals, cl) ->
+      let (inh_init, cl_init) =
+        build_class_init ~scopes cla cstr super inh_init cl_init msubst top cl
+      in
+      let vals = List.map bind_id_as_val vals in
+      (inh_init, transl_vals cla true StrictOpt vals cl_init)
+  | Tcl_constraint (cl, _, vals, meths, concr_meths) ->
+      let virt_meths =
+        List.filter (fun lab -> not (Concr.mem lab concr_meths)) meths in
+      let concr_meths = Concr.elements concr_meths in
+      let narrow_args =
+        [Lvar cla;
+         transl_meth_list vals;
+         transl_meth_list virt_meths;
+         transl_meth_list concr_meths] in
+      let cl = ignore_cstrs cl in
+      begin match cl.cl_desc, inh_init with
+      | Tcl_ident (path, _, _), (path', path_lam, obj_init)::inh_init ->
+          assert (Path.same path path');
+          let inh = Ident.create_local "inh"
+          and ofs = List.length vals + 1
+          and valids, methids = super in
+          let cl_init =
+            List.fold_left
+              (fun init (nm, id, _) ->
+                Llet(StrictOpt, Pgenval, id,
+                     lfield inh (index nm concr_meths + ofs),
+                     init))
+              cl_init methids in
+          let cl_init =
+            List.fold_left
+              (fun init (nm, id) ->
+                Llet(StrictOpt, Pgenval, id,
+                     lfield inh (index nm vals + 1), init))
+              cl_init valids in
+          (inh_init,
+           Llet (Strict, Pgenval, inh,
+                 mkappl(oo_prim "inherits", narrow_args @
+                        [path_lam;
+                         Lconst(Const_pointer(if top then 1 else 0))]),
+                 Llet(StrictOpt, Pgenval, obj_init, lfield inh 0, cl_init)))
+      | _ ->
+          let core cl_init =
+            build_class_init
+              ~scopes cla true super inh_init cl_init msubst top cl
+          in
+          if cstr then core cl_init else
+          let (inh_init, cl_init) =
+            core (Lsequence (mkappl (oo_prim "widen", [Lvar cla]), cl_init))
+          in
+          (inh_init,
+           Lsequence(mkappl (oo_prim "narrow", narrow_args),
+                     cl_init))
+      end
+  | Tcl_open (_, cl) ->
+      build_class_init ~scopes cla cstr super inh_init cl_init msubst top cl
+
+let rec build_class_lets ~scopes cl =
+  match cl.cl_desc with
+    Tcl_let (rec_flag, defs, _vals, cl') ->
+      let env, wrap = build_class_lets ~scopes cl' in
+      (env, fun x ->
+          Translcore.transl_let ~scopes rec_flag defs (wrap x))
+  | _ ->
+      (cl.cl_env, fun x -> x)
+
+let rec get_class_meths cl =
+  match cl.cl_desc with
+    Tcl_structure cl ->
+      Meths.fold (fun _ -> Ident.Set.add) cl.cstr_meths Ident.Set.empty
+  | Tcl_ident _ -> Ident.Set.empty
+  | Tcl_fun (_, _, _, cl, _)
+  | Tcl_let (_, _, _, cl)
+  | Tcl_apply (cl, _)
+  | Tcl_open (_, cl)
+  | Tcl_constraint (cl, _, _, _, _) -> get_class_meths cl
+
+(*
+   XXX Il devrait etre peu couteux d'ecrire des classes :
+   |   Writing classes should be cheap
+     class c x y = d e f
+*)
+let rec transl_class_rebind ~scopes obj_init cl vf =
+  match cl.cl_desc with
+    Tcl_ident (path, _, _) ->
+      if vf = Concrete then begin
+        try if (Env.find_class path cl.cl_env).cty_new = None then raise Exit
+        with Not_found -> raise Exit
+      end;
+      let cl_loc = of_location ~scopes cl.cl_loc in
+      let path_lam = transl_class_path cl_loc cl.cl_env path in
+      (path, path_lam, obj_init)
+  | Tcl_fun (_, pat, _, cl, partial) ->
+      let path, path_lam, obj_init =
+        transl_class_rebind ~scopes obj_init cl vf in
+      let build params rem =
+        let param = name_pattern "param" pat in
+        Lfunction {kind = Curried; params = (param, Pgenval)::params;
+                   return = Pgenval;
+                   attr = default_function_attribute;
+                   loc = of_location ~scopes pat.pat_loc;
+                   body = Matching.for_function ~scopes pat.pat_loc
+                            None (Lvar param) [pat, rem] partial}
+      in
+      (path, path_lam,
+       match obj_init with
+         Lfunction {kind = Curried; params; body} -> build params body
+       | rem                                      -> build [] rem)
+  | Tcl_apply (cl, oexprs) ->
+      let path, path_lam, obj_init =
+        transl_class_rebind ~scopes obj_init cl vf in
+      (path, path_lam, transl_apply ~scopes obj_init oexprs Loc_unknown)
+  | Tcl_let (rec_flag, defs, _vals, cl) ->
+      let path, path_lam, obj_init =
+        transl_class_rebind ~scopes obj_init cl vf in
+      (path, path_lam, Translcore.transl_let ~scopes rec_flag defs obj_init)
+  | Tcl_structure _ -> raise Exit
+  | Tcl_constraint (cl', _, _, _, _) ->
+      let path, path_lam, obj_init =
+        transl_class_rebind ~scopes obj_init cl' vf in
+      let rec check_constraint = function
+          Cty_constr(path', _, _) when Path.same path path' -> ()
+        | Cty_arrow (_, _, cty) -> check_constraint cty
+        | _ -> raise Exit
+      in
+      check_constraint cl.cl_type;
+      (path, path_lam, obj_init)
+  | Tcl_open (_, cl) ->
+      transl_class_rebind ~scopes obj_init cl vf
+
+let rec transl_class_rebind_0 ~scopes (self:Ident.t) obj_init cl vf =
+  match cl.cl_desc with
+    Tcl_let (rec_flag, defs, _vals, cl) ->
+      let path, path_lam, obj_init =
+        transl_class_rebind_0 ~scopes self obj_init cl vf
+      in
+      (path, path_lam, Translcore.transl_let ~scopes rec_flag defs obj_init)
+  | _ ->
+      let path, path_lam, obj_init =
+        transl_class_rebind ~scopes obj_init cl vf in
+      (path, path_lam, lfunction [self, Pgenval] obj_init)
+
+let transl_class_rebind ~scopes cl vf =
+  try
+    let obj_init = Ident.create_local "obj_init"
+    and self = Ident.create_local "self" in
+    let obj_init0 =
+      lapply {ap_should_be_tailcall=false;
+              ap_loc=Loc_unknown;
+              ap_func=Lvar obj_init;
+              ap_args=[Lvar self];
+              ap_inlined=Default_inline;
+              ap_specialised=Default_specialise}
+    in
+    let _, path_lam, obj_init' =
+      transl_class_rebind_0 ~scopes self obj_init0 cl vf in
+    let id = (obj_init' = lfunction [self, Pgenval] obj_init0) in
+    if id then path_lam else
+
+    let cla = Ident.create_local "class"
+    and new_init = Ident.create_local "new_init"
+    and env_init = Ident.create_local "env_init"
+    and table = Ident.create_local "table"
+    and envs = Ident.create_local "envs" in
+    Llet(
+    Strict, Pgenval, new_init, lfunction [obj_init, Pgenval] obj_init',
+    Llet(
+    Alias, Pgenval, cla, path_lam,
+    Lprim(Pmakeblock(0, Immutable, None),
+          [mkappl(Lvar new_init, [lfield cla 0]);
+           lfunction [table, Pgenval]
+             (Llet(Strict, Pgenval, env_init,
+                   mkappl(lfield cla 1, [Lvar table]),
+                   lfunction [envs, Pgenval]
+                     (mkappl(Lvar new_init,
+                             [mkappl(Lvar env_init, [Lvar envs])]))));
+           lfield cla 2;
+           lfield cla 3],
+          Loc_unknown)))
+  with Exit ->
+    lambda_unit
+
+(* Rewrite a closure using builtins. Improves native code size. *)
+
+let rec module_path = function
+    Lvar id ->
+      let s = Ident.name id in s <> "" && s.[0] >= 'A' && s.[0] <= 'Z'
+  | Lprim(Pfield _, [p], _)    -> module_path p
+  | Lprim(Pgetglobal _, [], _) -> true
+  | _                          -> false
+
+let const_path local = function
+    Lvar id -> not (List.mem id local)
+  | Lconst _ -> true
+  | Lfunction {kind = Curried; body} ->
+      let fv = free_variables body in
+      List.for_all (fun x -> not (Ident.Set.mem x fv)) local
+  | p -> module_path p
+
+let rec builtin_meths self env env2 body =
+  let const_path = const_path (env::self) in
+  let conv = function
+    (* Lvar s when List.mem s self ->  "_self", [] *)
+    | p when const_path p -> "const", [p]
+    | Lprim(Parrayrefu _, [Lvar s; Lvar n], _) when List.mem s self ->
+        "var", [Lvar n]
+    | Lprim(Pfield n, [Lvar e], _) when Ident.same e env ->
+        "env", [Lvar env2; Lconst(Const_pointer n)]
+    | Lsend(Self, met, Lvar s, [], _) when List.mem s self ->
+        "meth", [met]
+    | _ -> raise Not_found
+  in
+  match body with
+  | Llet(_str, _k, s', Lvar s, body) when List.mem s self ->
+      builtin_meths (s'::self) env env2 body
+  | Lapply{ap_func = f; ap_args = [arg]} when const_path f ->
+      let s, args = conv arg in ("app_"^s, f :: args)
+  | Lapply{ap_func = f; ap_args = [arg; p]} when const_path f && const_path p ->
+      let s, args = conv arg in
+      ("app_"^s^"_const", f :: args @ [p])
+  | Lapply{ap_func = f; ap_args = [p; arg]} when const_path f && const_path p ->
+      let s, args = conv arg in
+      ("app_const_"^s, f :: p :: args)
+  | Lsend(Self, Lvar n, Lvar s, [arg], _) when List.mem s self ->
+      let s, args = conv arg in
+      ("meth_app_"^s, Lvar n :: args)
+  | Lsend(Self, met, Lvar s, [], _) when List.mem s self ->
+      ("get_meth", [met])
+  | Lsend(Public, met, arg, [], _) ->
+      let s, args = conv arg in
+      ("send_"^s, met :: args)
+  | Lsend(Cached, met, arg, [_;_], _) ->
+      let s, args = conv arg in
+      ("send_"^s, met :: args)
+  | Lfunction {kind = Curried; params = [x, _]; body} ->
+      let rec enter self = function
+        | Lprim(Parraysetu _, [Lvar s; Lvar n; Lvar x'], _)
+          when Ident.same x x' && List.mem s self ->
+            ("set_var", [Lvar n])
+        | Llet(_str, _k, s', Lvar s, body) when List.mem s self ->
+            enter (s'::self) body
+        | _ -> raise Not_found
+      in enter self body
+  | Lfunction _ -> raise Not_found
+  | _ ->
+      let s, args = conv body in ("get_"^s, args)
+
+module M = struct
+  open CamlinternalOO
+  let builtin_meths self env env2 body =
+    let builtin, args = builtin_meths self env env2 body in
+    (* if not arr then [mkappl(oo_prim builtin, args)] else *)
+    let tag = match builtin with
+      "get_const" -> GetConst
+    | "get_var"   -> GetVar
+    | "get_env"   -> GetEnv
+    | "get_meth"  -> GetMeth
+    | "set_var"   -> SetVar
+    | "app_const" -> AppConst
+    | "app_var"   -> AppVar
+    | "app_env"   -> AppEnv
+    | "app_meth"  -> AppMeth
+    | "app_const_const" -> AppConstConst
+    | "app_const_var"   -> AppConstVar
+    | "app_const_env"   -> AppConstEnv
+    | "app_const_meth"  -> AppConstMeth
+    | "app_var_const"   -> AppVarConst
+    | "app_env_const"   -> AppEnvConst
+    | "app_meth_const"  -> AppMethConst
+    | "meth_app_const"  -> MethAppConst
+    | "meth_app_var"    -> MethAppVar
+    | "meth_app_env"    -> MethAppEnv
+    | "meth_app_meth"   -> MethAppMeth
+    | "send_const" -> SendConst
+    | "send_var"   -> SendVar
+    | "send_env"   -> SendEnv
+    | "send_meth"  -> SendMeth
+    | _ -> assert false
+    in Lconst(Const_pointer(Obj.magic tag)) :: args
+end
+open M
+
+
+(*
+   Class translation.
+   Three subcases:
+    * reapplication of a known class -> transl_class_rebind
+    * 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)
+      (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.
+*)
+
+(*
+let prerr_ids msg ids =
+  let names = List.map Ident.unique_toplevel_name ids in
+  prerr_endline (String.concat " " (msg :: names))
+*)
+
+let free_methods l =
+  let fv = ref Ident.Set.empty in
+  let rec free l =
+    Lambda.iter_head_constructor free l;
+    match l with
+    | Lsend(Self, Lvar meth, _, _, _) ->
+        fv := Ident.Set.add meth !fv
+    | Lsend _ -> ()
+    | Lfunction{params} ->
+        List.iter (fun (param, _) -> fv := Ident.Set.remove param !fv) params
+    | Llet(_str, _k, id, _arg, _body) ->
+        fv := Ident.Set.remove id !fv
+    | Lletrec(decl, _body) ->
+        List.iter (fun (id, _exp) -> fv := Ident.Set.remove id !fv) decl
+    | Lstaticcatch(_e1, (_,vars), _e2) ->
+        List.iter (fun (id, _) -> fv := Ident.Set.remove id !fv) vars
+    | Ltrywith(_e1, exn, _e2) ->
+        fv := Ident.Set.remove exn !fv
+    | Lfor(v, _e1, _e2, _dir, _e3) ->
+        fv := Ident.Set.remove v !fv
+    | Lassign _
+    | Lvar _ | Lconst _ | Lapply _
+    | Lprim _ | Lswitch _ | Lstringswitch _ | Lstaticraise _
+    | Lifthenelse _ | Lsequence _ | Lwhile _
+    | Levent _ | Lifused _ -> ()
+  in free l; !fv
+
+let transl_class ~scopes ids cl_id pub_meths cl vflag =
+  (* First check if it is not only a rebind *)
+  let rebind = transl_class_rebind ~scopes cl vflag in
+  if rebind <> lambda_unit then rebind else
+
+  (* Prepare for heavy environment handling *)
+  let scopes = enter_class_definition ~scopes cl_id in
+  let tables = Ident.create_local (Ident.name cl_id ^ "_tables") in
+  let (top_env, req) = oo_add_class tables in
+  let top = not req in
+  let cl_env, llets = build_class_lets ~scopes cl in
+  let new_ids = if top then [] else Env.diff top_env cl_env in
+  let env2 = Ident.create_local "env" in
+  let meth_ids = get_class_meths cl in
+  let subst env lam i0 new_ids' =
+    let fv = free_variables lam in
+    (* prerr_ids "cl_id =" [cl_id]; prerr_ids "fv =" (Ident.Set.elements fv); *)
+    let fv = List.fold_right Ident.Set.remove !new_ids' fv in
+    (* We need to handle method ids specially, as they do not appear
+       in the typing environment (PR#3576, PR#4560) *)
+    (* very hacky: we add and remove free method ids on the fly,
+       depending on the visit order... *)
+    method_ids :=
+      Ident.Set.diff (Ident.Set.union (free_methods lam) !method_ids) meth_ids;
+    (* prerr_ids "meth_ids =" (Ident.Set.elements meth_ids);
+       prerr_ids "method_ids =" (Ident.Set.elements !method_ids); *)
+    let new_ids = List.fold_right Ident.Set.add new_ids !method_ids in
+    let fv = Ident.Set.inter fv new_ids in
+    new_ids' := !new_ids' @ Ident.Set.elements fv;
+    (* prerr_ids "new_ids' =" !new_ids'; *)
+    let i = ref (i0-1) in
+    List.fold_left
+      (fun subst id ->
+        incr i; Ident.Map.add id (lfield env !i)  subst)
+      Ident.Map.empty !new_ids'
+  in
+  let new_ids_meths = ref [] in
+  let no_env_update _ _ env = env in
+  let msubst arr = function
+      Lfunction {kind = Curried; params = (self, Pgenval) :: args; body} ->
+        let env = Ident.create_local "env" in
+        let body' =
+          if new_ids = [] then body else
+          Lambda.subst no_env_update (subst env body 0 new_ids_meths) body in
+        begin try
+          (* Doesn't seem to improve size for bytecode *)
+          (* if not !Clflags.native_code then raise Not_found; *)
+          if not arr || !Clflags.debug then raise Not_found;
+          builtin_meths [self] env env2 (lfunction args body')
+        with Not_found ->
+          [lfunction ((self, Pgenval) :: args)
+             (if not (Ident.Set.mem env (free_variables body')) then body' else
+              Llet(Alias, Pgenval, env,
+                   Lprim(Pfield_computed,
+                         [Lvar self; Lvar env2],
+                         Loc_unknown),
+                   body'))]
+        end
+      | _ -> assert false
+  in
+  let new_ids_init = ref [] in
+  let env1 = Ident.create_local "env" and env1' = Ident.create_local "env'" in
+  let copy_env self =
+    if top then lambda_unit else
+    Lifused(env2, Lprim(Psetfield_computed (Pointer, Assignment),
+                        [Lvar self; Lvar env2; Lvar env1'],
+                        Loc_unknown))
+  and subst_env envs l lam =
+    if top then lam else
+    (* must be called only once! *)
+    let lam = Lambda.subst no_env_update (subst env1 lam 1 new_ids_init) lam in
+    Llet(Alias, Pgenval, env1, (if l = [] then Lvar envs else lfield envs 0),
+    Llet(Alias, Pgenval, env1',
+         (if !new_ids_init = [] then Lvar env1 else lfield env1 0),
+         lam))
+  in
+
+  (* Now we start compiling the class *)
+  let cla = Ident.create_local "class" in
+  let (inh_init, obj_init) =
+    build_object_init_0 ~scopes cla [] cl copy_env subst_env top ids in
+  let inh_init' = List.rev inh_init in
+  let (inh_init', cl_init) =
+    build_class_init ~scopes cla true ([],[]) inh_init' obj_init msubst top cl
+  in
+  assert (inh_init' = []);
+  let table = Ident.create_local "table"
+  and class_init = Ident.create_local (Ident.name cl_id ^ "_init")
+  and env_init = Ident.create_local "env_init"
+  and obj_init = Ident.create_local "obj_init" in
+  let pub_meths =
+    List.sort
+      (fun s s' -> compare (Btype.hash_variant s) (Btype.hash_variant s'))
+      pub_meths in
+  let tags = List.map Btype.hash_variant pub_meths in
+  let rev_map = List.combine tags pub_meths in
+  List.iter2
+    (fun tag name ->
+      let name' = List.assoc tag rev_map in
+      if name' <> name then raise(Error(cl.cl_loc, Tags(name, name'))))
+    tags pub_meths;
+  let ltable table lam =
+    Llet(Strict, Pgenval, table,
+         mkappl (oo_prim "create_table", [transl_meth_list pub_meths]), lam)
+  and ldirect obj_init =
+    Llet(Strict, Pgenval, obj_init, cl_init,
+         Lsequence(mkappl (oo_prim "init_class", [Lvar cla]),
+                   mkappl (Lvar obj_init, [lambda_unit])))
+  in
+  (* Simplest case: an object defined at toplevel (ids=[]) *)
+  if top && ids = [] then llets (ltable cla (ldirect obj_init)) else
+
+  let concrete = (vflag = Concrete)
+  and lclass lam =
+    let cl_init = llets (Lfunction{kind = Curried;
+                                   attr = default_function_attribute;
+                                   loc = Loc_unknown;
+                                   return = Pgenval;
+                                   params = [cla, Pgenval]; body = cl_init}) in
+    Llet(Strict, Pgenval, class_init, cl_init, lam (free_variables cl_init))
+  and lbody fv =
+    if List.for_all (fun id -> not (Ident.Set.mem id fv)) ids then
+      mkappl (oo_prim "make_class",[transl_meth_list pub_meths;
+                                    Lvar class_init])
+    else
+      ltable table (
+      Llet(
+      Strict, Pgenval, env_init, mkappl (Lvar class_init, [Lvar table]),
+      Lsequence(
+      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],
+            Loc_unknown))))
+  and lbody_virt lenvs =
+    Lprim(Pmakeblock(0, Immutable, None),
+          [lambda_unit; Lfunction{kind = Curried;
+                                  attr = default_function_attribute;
+                                  loc = Loc_unknown;
+                                  return = Pgenval;
+                                  params = [cla, Pgenval]; body = cl_init};
+           lambda_unit; lenvs],
+         Loc_unknown)
+  in
+  (* Still easy: a class defined at toplevel *)
+  if top && concrete then lclass lbody else
+  if top then llets (lbody_virt lambda_unit) else
+
+  (* Now for the hard stuff: prepare for table caching *)
+  let envs = Ident.create_local "envs"
+  and cached = Ident.create_local "cached" in
+  let lenvs =
+    if !new_ids_meths = [] && !new_ids_init = [] && inh_init = []
+    then lambda_unit
+    else Lvar envs in
+  let lenv =
+    let menv =
+      if !new_ids_meths = [] then lambda_unit else
+      Lprim(Pmakeblock(0, Immutable, None),
+            List.map (fun id -> Lvar id) !new_ids_meths,
+            Loc_unknown) in
+    if !new_ids_init = [] then menv else
+    Lprim(Pmakeblock(0, Immutable, None),
+          menv :: List.map (fun id -> Lvar id) !new_ids_init,
+          Loc_unknown)
+  and linh_envs =
+    List.map
+      (fun (_, path_lam, _) -> Lprim(Pfield 3, [path_lam], Loc_unknown))
+      (List.rev inh_init)
+  in
+  let make_envs lam =
+    Llet(StrictOpt, Pgenval, envs,
+         (if linh_envs = [] then lenv else
+         Lprim(Pmakeblock(0, Immutable, None),
+               lenv :: linh_envs, Loc_unknown)),
+         lam)
+  and def_ids cla lam =
+    Llet(StrictOpt, Pgenval, env2,
+         mkappl (oo_prim "new_variable", [Lvar cla; transl_label ""]),
+         lam)
+  in
+  let inh_paths =
+    List.filter
+      (fun (path, _, _) -> List.mem (Path.head path) new_ids) inh_init
+  in
+  let inh_keys =
+    List.map
+      (fun (_, path_lam, _) -> Lprim(Pfield 1, [path_lam], Loc_unknown))
+      inh_paths
+  in
+  let lclass lam =
+    Llet(Strict, Pgenval, class_init,
+         Lfunction{kind = Curried; params = [cla, Pgenval];
+                   return = Pgenval;
+                   attr = default_function_attribute;
+                   loc = Loc_unknown;
+                   body = def_ids cla cl_init}, lam)
+  and lcache lam =
+    if inh_keys = [] then Llet(Alias, Pgenval, cached, Lvar tables, lam) else
+    Llet(Strict, Pgenval, cached,
+         mkappl (oo_prim "lookup_tables",
+                [Lvar tables; Lprim(Pmakeblock(0, Immutable, None),
+                                    inh_keys, Loc_unknown)]),
+         lam)
+  and lset cached i lam =
+    Lprim(Psetfield(i, Pointer, Assignment),
+          [Lvar cached; lam], Loc_unknown)
+  in
+  let ldirect () =
+    ltable cla
+      (Llet(Strict, Pgenval, env_init, def_ids cla cl_init,
+            Lsequence(mkappl (oo_prim "init_class", [Lvar cla]),
+                      lset cached 0 (Lvar env_init))))
+  and lclass_virt () =
+    lset cached 0
+      (Lfunction
+         {
+           kind = Curried;
+           attr = default_function_attribute;
+           loc = Loc_unknown;
+           return = Pgenval;
+           params = [cla, Pgenval];
+           body = def_ids cla cl_init;
+         }
+      )
+  in
+  let lupdate_cache =
+    if ids = [] then ldirect () else
+      if not concrete then lclass_virt () else
+        lclass (
+            mkappl (oo_prim "make_class_store",
+                    [transl_meth_list pub_meths;
+                     Lvar class_init; Lvar cached])) in
+  let lcheck_cache =
+    if !Clflags.native_code && !Clflags.afl_instrument then
+      (* When afl-fuzz instrumentation is enabled, ignore the cache
+         so that the program's behaviour does not change between runs *)
+      lupdate_cache
+    else
+      Lifthenelse(lfield cached 0, lambda_unit, lupdate_cache) in
+  llets (
+  lcache (
+  Lsequence(lcheck_cache,
+  make_envs (
+  if ids = [] then mkappl (lfield cached 0, [lenvs]) else
+  Lprim(Pmakeblock(0, Immutable, None),
+        (if concrete then
+          [mkappl (lfield cached 0, [lenvs]);
+           lfield cached 1;
+           lfield cached 0;
+           lenvs]
+        else [lambda_unit; lfield cached 0; lambda_unit; lenvs]),
+        Loc_unknown
+       )))))
+
+(* Wrapper for class compilation *)
+(*
+    let cl_id = ci.ci_id_class in
+(* TODO: cl_id is used somewhere else as typesharp ? *)
+  let _arity = List.length ci.ci_params in
+  let pub_meths = m in
+  let cl = ci.ci_expr in
+  let vflag = vf in
+*)
+
+let transl_class ~scopes ids id pub_meths cl vf =
+  oo_wrap cl.cl_env false (transl_class ~scopes ids id pub_meths cl) vf
+
+let () =
+  transl_object := (fun ~scopes id meths cl ->
+    transl_class ~scopes [] id meths cl Concrete)
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+  | Tags (lab1, lab2) ->
+      fprintf ppf "Method labels `%s' and `%s' are incompatible.@ %s"
+        lab1 lab2 "Change one of them."
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (loc, err) ->
+        Some (Location.error_of_printer ~loc report_error err)
+      | _ ->
+        None
+    )
diff --git a/lambda/translclass.mli b/lambda/translclass.mli
new file mode 100644
index 00000000..f2c5c1d5
--- /dev/null
+++ b/lambda/translclass.mli
@@ -0,0 +1,30 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Typedtree
+open Lambda
+open Debuginfo.Scoped_location
+
+val transl_class :
+  scopes:scopes -> Ident.t list -> Ident.t ->
+  string list -> class_expr -> Asttypes.virtual_flag -> lambda;;
+
+type error = Tags of string * string
+
+exception Error of Location.t * error
+
+open Format
+
+val report_error: formatter -> error -> unit
diff --git a/lambda/translcore.ml b/lambda/translcore.ml
new file mode 100644
index 00000000..5d479f3f
--- /dev/null
+++ b/lambda/translcore.ml
@@ -0,0 +1,1140 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Translation from typed abstract syntax to lambda terms,
+   for the core language *)
+
+open Misc
+open Asttypes
+open Primitive
+open Types
+open Typedtree
+open Typeopt
+open Lambda
+open Debuginfo.Scoped_location
+
+type error =
+    Free_super_var
+  | Unreachable_reached
+
+exception Error of Location.t * error
+
+let use_dup_for_constant_arrays_bigger_than = 4
+
+(* Forward declaration -- to be filled in by Translmod.transl_module *)
+let transl_module =
+  ref((fun ~scopes:_ _cc _rootpath _modl -> assert false) :
+      scopes:scopes -> module_coercion -> Path.t option ->
+      module_expr -> lambda)
+
+let transl_object =
+  ref (fun ~scopes:_ _id _s _cl -> assert false :
+       scopes:scopes -> Ident.t -> string list -> class_expr -> lambda)
+
+(* Compile an exception/extension definition *)
+
+let prim_fresh_oo_id =
+  Pccall (Primitive.simple ~name:"caml_fresh_oo_id" ~arity:1 ~alloc:false)
+
+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)
+  in
+  let name =
+    match path, !Clflags.for_package with
+      None, _ -> Ident.name ext.ext_id
+    | Some p, None -> Path.name p
+    | Some p, Some pack -> Printf.sprintf "%s.%s" pack (Path.name p)
+  in
+  let loc = of_location ~scopes ext.ext_loc in
+  match ext.ext_kind with
+    Text_decl _ ->
+      Lprim (Pmakeblock (Obj.object_tag, Immutable, None),
+        [Lconst (Const_base (Const_string (name, ext.ext_loc, None)));
+         Lprim (prim_fresh_oo_id, [Lconst (Const_base (Const_int 0))], loc)],
+        loc)
+  | Text_rebind(path, _lid) ->
+      transl_extension_path loc env path
+
+(* To propagate structured constants *)
+
+exception Not_constant
+
+let extract_constant = function
+    Lconst sc -> sc
+  | _ -> raise Not_constant
+
+let extract_float = function
+    Const_base(Const_float f) -> f
+  | _ -> fatal_error "Translcore.extract_float"
+
+(* Push the default values under the functional abstractions *)
+(* Also push bindings of module patterns, since this sound *)
+
+type binding =
+  | Bind_value of value_binding list
+  | Bind_module of Ident.t * string option loc * module_presence * module_expr
+
+let rec push_defaults loc bindings cases partial =
+  match cases with
+    [{c_lhs=pat; c_guard=None;
+      c_rhs={exp_desc = Texp_function { arg_label; param; cases; partial; } }
+        as exp}] ->
+      let cases = push_defaults exp.exp_loc bindings cases partial in
+      [{c_lhs=pat; c_guard=None;
+        c_rhs={exp with exp_desc = Texp_function { arg_label; param; cases;
+          partial; }}}]
+  | [{c_lhs=pat; c_guard=None;
+      c_rhs={exp_attributes=[{Parsetree.attr_name = {txt="#default"};_}];
+             exp_desc = Texp_let
+               (Nonrecursive, binds, ({exp_desc = Texp_function _} as e2))}}] ->
+      push_defaults loc (Bind_value binds :: bindings)
+                   [{c_lhs=pat;c_guard=None;c_rhs=e2}]
+                   partial
+  | [{c_lhs=pat; c_guard=None;
+      c_rhs={exp_attributes=[{Parsetree.attr_name = {txt="#modulepat"};_}];
+             exp_desc = Texp_letmodule
+               (Some id, name, pres, mexpr,
+                ({exp_desc = Texp_function _} as e2))}}] ->
+      push_defaults loc (Bind_module (id, name, pres, mexpr) :: bindings)
+                   [{c_lhs=pat;c_guard=None;c_rhs=e2}]
+                   partial
+  | [case] ->
+      let exp =
+        List.fold_left
+          (fun exp binds ->
+            {exp with exp_desc =
+             match binds with
+             | Bind_value binds -> Texp_let(Nonrecursive, binds, exp)
+             | Bind_module (id, name, pres, mexpr) ->
+                 Texp_letmodule (Some id, name, pres, mexpr, exp)})
+          case.c_rhs bindings
+      in
+      [{case with c_rhs=exp}]
+  | {c_lhs=pat; c_rhs=exp; c_guard=_} :: _ when bindings <> [] ->
+      let param = Typecore.name_cases "param" cases in
+      let desc =
+        {val_type = pat.pat_type; val_kind = Val_reg;
+         val_attributes = []; Types.val_loc = Location.none;
+         val_uid = Types.Uid.internal_not_actually_unique; }
+      in
+      let env = Env.add_value param desc exp.exp_env in
+      let name = Ident.name param in
+      let exp =
+        let cases =
+          let pure_case ({c_lhs; _} as case) =
+            {case with c_lhs = as_computation_pattern c_lhs} in
+          List.map pure_case cases in
+        { exp with exp_loc = loc; exp_env = env; exp_desc =
+          Texp_match
+            ({exp with exp_type = pat.pat_type; exp_env = env; exp_desc =
+              Texp_ident
+                (Path.Pident param, mknoloc (Longident.Lident name), desc)},
+             cases, partial) }
+      in
+      push_defaults loc bindings
+        [{c_lhs={pat with pat_desc = Tpat_var (param, mknoloc name)};
+          c_guard=None; c_rhs=exp}]
+        Total
+  | _ ->
+      cases
+
+(* Insertion of debugging events *)
+
+let event_before ~scopes exp lam =
+  Translprim.event_before (of_location ~scopes exp.exp_loc) exp lam
+
+let event_after ~scopes exp lam =
+  Translprim.event_after (of_location ~scopes exp.exp_loc) exp lam
+
+let event_function ~scopes exp lam =
+  if !Clflags.debug && not !Clflags.native_code then
+    let repr = Some (ref 0) in
+    let (info, body) = lam repr in
+    (info,
+     Levent(body, {lev_loc = of_location ~scopes exp.exp_loc;
+                   lev_kind = Lev_function;
+                   lev_repr = repr;
+                   lev_env = exp.exp_env}))
+  else
+    lam None
+
+(* Assertions *)
+
+let assert_failed ~scopes exp =
+  let slot =
+    transl_extension_path Loc_unknown
+      Env.initial_safe_string Predef.path_assert_failure
+  in
+  let loc = exp.exp_loc in
+  let (fname, line, char) =
+    Location.get_pos_info loc.Location.loc_start
+  in
+  let loc = of_location ~scopes exp.exp_loc in
+  Lprim(Praise Raise_regular, [event_after ~scopes exp
+    (Lprim(Pmakeblock(0, Immutable, None),
+          [slot;
+           Lconst(Const_block(0,
+              [Const_base(Const_string (fname, exp.exp_loc, None));
+               Const_base(Const_int line);
+               Const_base(Const_int char)]))], loc))], loc)
+;;
+
+let rec cut n l =
+  if n = 0 then ([],l) else
+  match l with [] -> failwith "Translcore.cut"
+  | a::l -> let (l1,l2) = cut (n-1) l in (a::l1,l2)
+
+(* Translation of expressions *)
+
+let rec iter_exn_names f pat =
+  match pat.pat_desc with
+  | Tpat_var (id, _) -> f id
+  | Tpat_alias (p, id, _) ->
+      f id;
+      iter_exn_names f p
+  | _ -> ()
+
+let transl_ident loc env ty path desc =
+  match desc.val_kind with
+  | Val_prim p ->
+      Translprim.transl_primitive loc p env ty (Some path)
+  | Val_anc _ ->
+      raise(Error(to_location loc, Free_super_var))
+  | Val_reg | Val_self _ ->
+      transl_value_path loc env path
+  |  _ -> fatal_error "Translcore.transl_exp: bad Texp_ident"
+
+let rec transl_exp ~scopes e =
+  List.iter (Translattribute.check_attribute e) e.exp_attributes;
+  let eval_once =
+    (* Whether classes for immediate objects must be cached *)
+    match e.exp_desc with
+      Texp_function _ | Texp_for _ | Texp_while _ -> false
+    | _ -> true
+  in
+  if eval_once then transl_exp0 ~scopes e else
+  Translobj.oo_wrap e.exp_env true (transl_exp0 ~scopes) e
+
+and transl_exp0 ~scopes e =
+  match e.exp_desc with
+  | Texp_ident(path, _, desc) ->
+      transl_ident (of_location ~scopes e.exp_loc)
+        e.exp_env e.exp_type path desc
+  | Texp_constant cst ->
+      Lconst(Const_base cst)
+  | Texp_let(rec_flag, pat_expr_list, body) ->
+      transl_let ~scopes rec_flag pat_expr_list
+        (event_before ~scopes body (transl_exp ~scopes body))
+  | Texp_function { arg_label = _; param; cases; partial; } ->
+      let scopes = enter_anonymous_function ~scopes in
+      transl_function ~scopes e param cases partial
+  | Texp_apply({ exp_desc = Texp_ident(path, _, {val_kind = Val_prim p});
+                exp_type = prim_type } as funct, oargs)
+    when List.length oargs >= p.prim_arity
+    && List.for_all (fun (_, arg) -> arg <> None) oargs ->
+      let argl, extra_args = cut p.prim_arity oargs in
+      let arg_exps =
+         List.map (function _, Some x -> x | _ -> assert false) argl
+      in
+      let args = transl_list ~scopes arg_exps in
+      let prim_exp = if extra_args = [] then Some e else None in
+      let lam =
+        Translprim.transl_primitive_application
+          (of_location ~scopes e.exp_loc) p e.exp_env prim_type path
+          prim_exp args arg_exps
+      in
+      if extra_args = [] then lam
+      else begin
+        let should_be_tailcall, funct =
+          Translattribute.get_tailcall_attribute funct
+        in
+        let inlined, funct =
+          Translattribute.get_and_remove_inlined_attribute funct
+        in
+        let specialised, funct =
+          Translattribute.get_and_remove_specialised_attribute funct
+        in
+        let e = { e with exp_desc = Texp_apply(funct, oargs) } in
+        event_after ~scopes e
+          (transl_apply ~scopes ~should_be_tailcall ~inlined ~specialised
+             lam extra_args (of_location ~scopes e.exp_loc))
+      end
+  | Texp_apply(funct, oargs) ->
+      let should_be_tailcall, funct =
+        Translattribute.get_tailcall_attribute funct
+      in
+      let inlined, funct =
+        Translattribute.get_and_remove_inlined_attribute funct
+      in
+      let specialised, funct =
+        Translattribute.get_and_remove_specialised_attribute funct
+      in
+      let e = { e with exp_desc = Texp_apply(funct, oargs) } in
+      event_after ~scopes e
+        (transl_apply ~scopes ~should_be_tailcall ~inlined ~specialised
+           (transl_exp ~scopes funct) oargs (of_location ~scopes e.exp_loc))
+  | Texp_match(arg, pat_expr_list, partial) ->
+      transl_match ~scopes e arg pat_expr_list partial
+  | 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 (Lvar id)
+                 (transl_cases_try ~scopes pat_expr_list))
+  | Texp_tuple el ->
+      let ll, shape = transl_list_with_shape ~scopes el in
+      begin try
+        Lconst(Const_block(0, List.map extract_constant ll))
+      with Not_constant ->
+        Lprim(Pmakeblock(0, Immutable, Some shape), ll,
+              (of_location ~scopes e.exp_loc))
+      end
+  | Texp_construct(_, cstr, args) ->
+      let ll, shape = transl_list_with_shape ~scopes args in
+      if cstr.cstr_inlined <> None then begin match ll with
+        | [x] -> x
+        | _ -> assert false
+      end else begin match cstr.cstr_tag with
+        Cstr_constant n ->
+          Lconst(Const_pointer n)
+      | Cstr_unboxed ->
+          (match ll with [v] -> v | _ -> assert false)
+      | Cstr_block n ->
+          begin try
+            Lconst(Const_block(n, List.map extract_constant ll))
+          with Not_constant ->
+            Lprim(Pmakeblock(n, Immutable, Some shape), ll,
+                  of_location ~scopes e.exp_loc)
+          end
+      | Cstr_extension(path, is_const) ->
+          let lam = transl_extension_path
+                      (of_location ~scopes e.exp_loc) e.exp_env path in
+          if is_const then lam
+          else
+            Lprim(Pmakeblock(0, Immutable, Some (Pgenval :: shape)),
+                  lam :: ll, of_location ~scopes e.exp_loc)
+      end
+  | Texp_extension_constructor (_, path) ->
+      transl_extension_path (of_location ~scopes e.exp_loc) e.exp_env path
+  | Texp_variant(l, arg) ->
+      let tag = Btype.hash_variant l in
+      begin match arg with
+        None -> Lconst(Const_pointer tag)
+      | Some arg ->
+          let lam = transl_exp ~scopes arg in
+          try
+            Lconst(Const_block(0, [Const_base(Const_int tag);
+                                   extract_constant lam]))
+          with Not_constant ->
+            Lprim(Pmakeblock(0, Immutable, None),
+                  [Lconst(Const_base(Const_int tag)); lam],
+                  of_location ~scopes e.exp_loc)
+      end
+  | Texp_record {fields; representation; extended_expression} ->
+      transl_record ~scopes e.exp_loc e.exp_env
+        fields representation extended_expression
+  | Texp_field(arg, _, lbl) ->
+      let targ = transl_exp ~scopes arg in
+      begin match lbl.lbl_repres with
+          Record_regular | Record_inlined _ ->
+          Lprim (Pfield lbl.lbl_pos, [targ],
+                 of_location ~scopes e.exp_loc)
+        | Record_unboxed _ -> targ
+        | Record_float ->
+          Lprim (Pfloatfield lbl.lbl_pos, [targ],
+                 of_location ~scopes e.exp_loc)
+        | Record_extension _ ->
+          Lprim (Pfield (lbl.lbl_pos + 1), [targ],
+                 of_location ~scopes e.exp_loc)
+      end
+  | Texp_setfield(arg, _, lbl, newval) ->
+      let access =
+        match lbl.lbl_repres with
+          Record_regular
+        | Record_inlined _ ->
+          Psetfield(lbl.lbl_pos, maybe_pointer newval, Assignment)
+        | Record_unboxed _ -> assert false
+        | Record_float -> Psetfloatfield (lbl.lbl_pos, Assignment)
+        | Record_extension _ ->
+          Psetfield (lbl.lbl_pos + 1, maybe_pointer newval, Assignment)
+      in
+      Lprim(access, [transl_exp ~scopes arg; transl_exp ~scopes newval],
+            of_location ~scopes e.exp_loc)
+  | Texp_array expr_list ->
+      let kind = array_kind e in
+      let ll = transl_list ~scopes expr_list in
+      begin try
+        (* For native code the decision as to which compilation strategy to
+           use is made later.  This enables the Flambda passes to lift certain
+           kinds of array definitions to symbols. *)
+        (* Deactivate constant optimization if array is small enough *)
+        if List.length ll <= use_dup_for_constant_arrays_bigger_than
+        then begin
+          raise Not_constant
+        end;
+        begin match List.map extract_constant ll with
+        | exception Not_constant when kind = Pfloatarray ->
+            (* We cannot currently lift [Pintarray] arrays safely in Flambda
+               because [caml_modify] might be called upon them (e.g. from
+               code operating on polymorphic arrays, or functions such as
+               [caml_array_blit].
+               To avoid having different Lambda code for
+               bytecode/Closure vs.  Flambda, we always generate
+               [Pduparray] here, and deal with it in [Bytegen] (or in
+               the case of Closure, in [Cmmgen], which already has to
+               handle [Pduparray Pmakearray Pfloatarray] in the case
+               where the array turned out to be inconstant).
+               When not [Pfloatarray], the exception propagates to the handler
+               below. *)
+            let imm_array =
+              Lprim (Pmakearray (kind, Immutable), ll,
+                     of_location ~scopes e.exp_loc)
+            in
+            Lprim (Pduparray (kind, Mutable), [imm_array],
+                   of_location ~scopes e.exp_loc)
+        | cl ->
+            let imm_array =
+              match kind with
+              | Paddrarray | Pintarray ->
+                  Lconst(Const_block(0, cl))
+              | Pfloatarray ->
+                  Lconst(Const_float_array(List.map extract_float cl))
+              | Pgenarray ->
+                  raise Not_constant    (* can this really happen? *)
+            in
+            Lprim (Pduparray (kind, Mutable), [imm_array],
+                   of_location ~scopes e.exp_loc)
+        end
+      with Not_constant ->
+        Lprim(Pmakearray (kind, Mutable), ll,
+              of_location ~scopes e.exp_loc)
+      end
+  | Texp_ifthenelse(cond, ifso, Some ifnot) ->
+      Lifthenelse(transl_exp ~scopes cond,
+                  event_before ~scopes ifso (transl_exp ~scopes ifso),
+                  event_before ~scopes ifnot (transl_exp ~scopes ifnot))
+  | Texp_ifthenelse(cond, ifso, None) ->
+      Lifthenelse(transl_exp ~scopes cond,
+                  event_before ~scopes ifso (transl_exp ~scopes ifso),
+                  lambda_unit)
+  | Texp_sequence(expr1, expr2) ->
+      Lsequence(transl_exp ~scopes expr1,
+                event_before ~scopes expr2 (transl_exp ~scopes expr2))
+  | Texp_while(cond, body) ->
+      Lwhile(transl_exp ~scopes cond,
+             event_before ~scopes body (transl_exp ~scopes body))
+  | Texp_for(param, _, low, high, dir, body) ->
+      Lfor(param, transl_exp ~scopes low, transl_exp ~scopes high, dir,
+           event_before ~scopes body (transl_exp ~scopes body))
+  | Texp_send(_, _, Some exp) -> transl_exp ~scopes exp
+  | Texp_send(expr, met, None) ->
+      let obj = transl_exp ~scopes expr in
+      let loc = of_location ~scopes e.exp_loc in
+      let lam =
+        match met with
+          Tmeth_val id -> Lsend (Self, Lvar id, obj, [], loc)
+        | Tmeth_name nm ->
+            let (tag, cache) = Translobj.meth obj nm in
+            let kind = if cache = [] then Public else Cached in
+            Lsend (kind, tag, obj, cache, loc)
+      in
+      event_after ~scopes e lam
+  | Texp_new (cl, {Location.loc=loc}, _) ->
+      let loc = of_location ~scopes loc in
+      Lapply{ap_should_be_tailcall=false;
+             ap_loc=loc;
+             ap_func=
+               Lprim(Pfield 0, [transl_class_path loc e.exp_env cl], loc);
+             ap_args=[lambda_unit];
+             ap_inlined=Default_inline;
+             ap_specialised=Default_specialise}
+  | Texp_instvar(path_self, path, _) ->
+      let loc = of_location ~scopes e.exp_loc in
+      let self = transl_value_path loc e.exp_env path_self in
+      let var = transl_value_path loc e.exp_env path in
+      Lprim(Pfield_computed, [self; var], loc)
+  | Texp_setinstvar(path_self, path, _, expr) ->
+      let loc = of_location ~scopes e.exp_loc in
+      let self = transl_value_path loc e.exp_env path_self in
+      let var = transl_value_path loc e.exp_env path in
+      transl_setinstvar ~scopes loc self var expr
+  | Texp_override(path_self, modifs) ->
+      let loc = of_location ~scopes e.exp_loc in
+      let self = transl_value_path loc e.exp_env path_self in
+      let cpy = Ident.create_local "copy" in
+      Llet(Strict, Pgenval, cpy,
+           Lapply{ap_should_be_tailcall=false;
+                  ap_loc=Loc_unknown;
+                  ap_func=Translobj.oo_prim "copy";
+                  ap_args=[self];
+                  ap_inlined=Default_inline;
+                  ap_specialised=Default_specialise},
+           List.fold_right
+             (fun (path, _, expr) rem ->
+               let var = transl_value_path loc e.exp_env path in
+                Lsequence(transl_setinstvar ~scopes Loc_unknown
+                            (Lvar cpy) var expr, rem))
+             modifs
+             (Lvar cpy))
+  | Texp_letmodule(None, loc, Mp_present, modl, body) ->
+      let lam = !transl_module ~scopes Tcoerce_none None modl in
+      Lsequence(Lprim(Pignore, [lam], of_location ~scopes loc.loc),
+                transl_exp ~scopes body)
+  | Texp_letmodule(Some id, loc, Mp_present, modl, body) ->
+      let defining_expr =
+        let mod_scopes = enter_module_definition ~scopes id in
+        Levent (!transl_module ~scopes:mod_scopes Tcoerce_none None modl, {
+          lev_loc = of_location ~scopes loc.loc;
+          lev_kind = Lev_module_definition id;
+          lev_repr = None;
+          lev_env = Env.empty;
+        })
+      in
+      Llet(Strict, Pgenval, id, defining_expr, transl_exp ~scopes body)
+  | Texp_letmodule(_, _, Mp_absent, _, body) ->
+      transl_exp ~scopes body
+  | Texp_letexception(cd, body) ->
+      Llet(Strict, Pgenval,
+           cd.ext_id, transl_extension_constructor ~scopes e.exp_env None cd,
+           transl_exp ~scopes body)
+  | Texp_pack modl ->
+      !transl_module ~scopes Tcoerce_none None modl
+  | Texp_assert {exp_desc=Texp_construct(_, {cstr_name="false"}, _)} ->
+      assert_failed ~scopes e
+  | Texp_assert (cond) ->
+      if !Clflags.noassert
+      then lambda_unit
+      else Lifthenelse (transl_exp ~scopes cond, lambda_unit,
+                        assert_failed ~scopes e)
+  | Texp_lazy e ->
+      (* when e needs no computation (constants, identifiers, ...), we
+         optimize the translation just as Lazy.lazy_from_val would
+         do *)
+      begin match Typeopt.classify_lazy_argument e with
+      | `Constant_or_function ->
+        (* A constant expr (of type <> float if [Config.flat_float_array] is
+           true) gets compiled as itself. *)
+         transl_exp ~scopes e
+      | `Float_that_cannot_be_shortcut ->
+          (* We don't need to wrap with Popaque: this forward
+             block will never be shortcutted since it points to a float
+             and Config.flat_float_array is true. *)
+          Lprim(Pmakeblock(Obj.forward_tag, Immutable, None),
+                [transl_exp ~scopes e], of_location ~scopes e.exp_loc)
+      | `Identifier `Forward_value ->
+         (* CR-someday mshinwell: Consider adding a new primitive
+            that expresses the construction of forward_tag blocks.
+            We need to use [Popaque] here to prevent unsound
+            optimisation in Flambda, but the concept of a mutable
+            block doesn't really match what is going on here.  This
+            value may subsequently turn into an immediate... *)
+         Lprim (Popaque,
+                [Lprim(Pmakeblock(Obj.forward_tag, Immutable, None),
+                       [transl_exp ~scopes e],
+                       of_location ~scopes e.exp_loc)],
+                of_location ~scopes e.exp_loc)
+      | `Identifier `Other ->
+         transl_exp ~scopes e
+      | `Other ->
+         (* other cases compile to a lazy block holding a function *)
+         let fn = Lfunction {kind = Curried;
+                             params= [Ident.create_local "param", Pgenval];
+                             return = Pgenval;
+                             attr = default_function_attribute;
+                             loc = of_location ~scopes e.exp_loc;
+                             body = transl_exp ~scopes e} in
+          Lprim(Pmakeblock(Config.lazy_tag, Mutable, None), [fn],
+                of_location ~scopes e.exp_loc)
+      end
+  | Texp_object (cs, meths) ->
+      let cty = cs.cstr_type in
+      let cl = Ident.create_local "object" in
+      !transl_object ~scopes cl meths
+        { cl_desc = Tcl_structure cs;
+          cl_loc = e.exp_loc;
+          cl_type = Cty_signature cty;
+          cl_env = e.exp_env;
+          cl_attributes = [];
+         }
+  | Texp_letop{let_; ands; param; body; partial} ->
+      event_after ~scopes e
+        (transl_letop ~scopes e.exp_loc e.exp_env let_ ands param body partial)
+  | Texp_unreachable ->
+      raise (Error (e.exp_loc, Unreachable_reached))
+  | Texp_open (od, e) ->
+      let pure = pure_module od.open_expr in
+      (* this optimization shouldn't be needed because Simplif would
+          actually remove the [Llet] when it's not used.
+          But since [scan_used_globals] runs before Simplif, we need to
+          do it. *)
+      begin match od.open_bound_items with
+      | [] when pure = Alias -> transl_exp ~scopes e
+      | _ ->
+          let oid = Ident.create_local "open" in
+          let body, _ =
+            List.fold_left (fun (body, pos) id ->
+              Llet(Alias, Pgenval, id,
+                   Lprim(Pfield pos, [Lvar oid],
+                         of_location ~scopes od.open_loc), body),
+              pos + 1
+            ) (transl_exp ~scopes e, 0)
+              (bound_value_identifiers od.open_bound_items)
+          in
+          Llet(pure, Pgenval, oid,
+               !transl_module ~scopes Tcoerce_none None od.open_expr, body)
+      end
+
+and pure_module m =
+  match m.mod_desc with
+    Tmod_ident _ -> Alias
+  | Tmod_constraint (m,_,_,_) -> pure_module m
+  | _ -> Strict
+
+and transl_list ~scopes expr_list =
+  List.map (transl_exp ~scopes) expr_list
+
+and transl_list_with_shape ~scopes expr_list =
+  let transl_with_shape e =
+    let shape = Typeopt.value_kind e.exp_env e.exp_type in
+    transl_exp ~scopes e, shape
+  in
+  List.split (List.map transl_with_shape expr_list)
+
+and transl_guard ~scopes guard rhs =
+  let expr = event_before ~scopes rhs (transl_exp ~scopes rhs) in
+  match guard with
+  | None -> expr
+  | Some cond ->
+      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_cases ~scopes cases =
+  let cases =
+    List.filter (fun c -> c.c_rhs.exp_desc <> Texp_unreachable) cases in
+  List.map (transl_case ~scopes) cases
+
+and transl_case_try ~scopes {c_lhs; c_guard; c_rhs} =
+  iter_exn_names Translprim.add_exception_ident c_lhs;
+  Misc.try_finally
+    (fun () -> c_lhs, transl_guard ~scopes c_guard c_rhs)
+    ~always:(fun () ->
+        iter_exn_names Translprim.remove_exception_ident c_lhs)
+
+and transl_cases_try ~scopes cases =
+  let cases =
+    List.filter (fun c -> c.c_rhs.exp_desc <> Texp_unreachable) cases in
+  List.map (transl_case_try ~scopes) cases
+
+and transl_tupled_cases ~scopes patl_expr_list =
+  let patl_expr_list =
+    List.filter (fun (_,_,e) -> e.exp_desc <> Texp_unreachable)
+      patl_expr_list in
+  List.map (fun (patl, guard, expr) -> (patl, transl_guard ~scopes guard expr))
+    patl_expr_list
+
+and transl_apply ~scopes ?(should_be_tailcall=false) ?(inlined = Default_inline)
+      ?(specialised = Default_specialise) lam sargs loc =
+  let lapply funct args =
+    match funct with
+      Lsend(k, lmet, lobj, largs, _) ->
+        Lsend(k, lmet, lobj, largs @ args, loc)
+    | Levent(Lsend(k, lmet, lobj, largs, _), _) ->
+        Lsend(k, lmet, lobj, largs @ args, loc)
+    | Lapply ap ->
+        Lapply {ap with ap_args = ap.ap_args @ args; ap_loc = loc}
+    | lexp ->
+        Lapply {ap_should_be_tailcall=should_be_tailcall;
+                ap_loc=loc;
+                ap_func=lexp;
+                ap_args=args;
+                ap_inlined=inlined;
+                ap_specialised=specialised;}
+  in
+  let rec build_apply lam args = function
+      (None, optional) :: l ->
+        let defs = ref [] in
+        let protect name lam =
+          match lam with
+            Lvar _ | Lconst _ -> lam
+          | _ ->
+              let id = Ident.create_local name in
+              defs := (id, lam) :: !defs;
+              Lvar id
+        in
+        let args, args' =
+          if List.for_all (fun (_,opt) -> opt) args then [], args
+          else args, []
+        in
+        let lam =
+          if args = [] then lam else lapply lam (List.rev_map fst args)
+        in
+        let handle = protect "func" lam in
+        let l =
+          List.map (fun (arg, opt) -> Option.map (protect "arg") arg, opt) l
+        in
+        let id_arg = Ident.create_local "param" in
+        let body =
+          match build_apply handle ((Lvar id_arg, optional)::args') l with
+            Lfunction{kind = Curried; params = ids; return;
+                      body = lam; attr; loc} ->
+              Lfunction{kind = Curried;
+                        params = (id_arg, Pgenval)::ids;
+                        return;
+                        body = lam; attr;
+                        loc}
+          | Levent(Lfunction{kind = Curried; params = ids; return;
+                             body = lam; attr; loc}, _) ->
+              Lfunction{kind = Curried; params = (id_arg, Pgenval)::ids;
+                        return;
+                        body = lam; attr;
+                        loc}
+          | lam ->
+              Lfunction{kind = Curried; params = [id_arg, Pgenval];
+                        return = Pgenval; body = lam;
+                        attr = default_stub_attribute; loc = loc}
+        in
+        List.fold_left
+          (fun body (id, lam) -> Llet(Strict, Pgenval, id, lam, body))
+          body !defs
+    | (Some arg, optional) :: l ->
+        build_apply lam ((arg, optional) :: args) l
+    | [] ->
+        lapply lam (List.rev_map fst args)
+  in
+  (build_apply lam [] (List.map (fun (l, x) ->
+                                   Option.map (transl_exp ~scopes) x,
+                                   Btype.is_optional l)
+                                sargs)
+     : Lambda.lambda)
+
+and transl_function0
+      ~scopes loc return untuplify_fn repr partial (param:Ident.t) cases =
+  match cases with
+    [{c_lhs=pat; c_guard=None;
+      c_rhs={exp_desc = Texp_function { arg_label = _; param = param'; cases;
+        partial = partial'; }; exp_env; exp_type} as exp}]
+    when Parmatch.inactive ~partial pat ->
+      let kind = value_kind pat.pat_env pat.pat_type in
+      let return_kind = function_return_value_kind exp_env exp_type in
+      let ((_, params, return), body) =
+        transl_function0 ~scopes exp.exp_loc return_kind false
+          repr partial' param' cases
+      in
+      ((Curried, (param, kind) :: params, return),
+       Matching.for_function ~scopes loc None (Lvar param)
+         [pat, body] partial)
+  | {c_lhs={pat_desc = Tpat_tuple pl}} :: _ when untuplify_fn ->
+      begin try
+        let size = List.length pl in
+        let pats_expr_list =
+          List.map
+            (fun {c_lhs; c_guard; c_rhs} ->
+              (Matching.flatten_pattern size c_lhs, c_guard, c_rhs))
+            cases in
+        let kinds =
+          (* All the patterns might not share the same types. We must take the
+             union of the patterns types *)
+          match pats_expr_list with
+          | [] -> assert false
+          | (pats, _, _) :: cases ->
+              let first_case_kinds =
+                List.map (fun pat -> value_kind pat.pat_env pat.pat_type) pats
+              in
+              List.fold_left
+                (fun kinds (pats, _, _) ->
+                   List.map2 (fun kind pat ->
+                       value_kind_union kind
+                         (value_kind pat.pat_env pat.pat_type))
+                     kinds pats)
+                first_case_kinds cases
+        in
+        let tparams =
+          List.map (fun kind -> Ident.create_local "param", kind) kinds
+        in
+        let params = List.map fst tparams in
+        ((Tupled, tparams, return),
+         Matching.for_tupled_function ~scopes loc params
+           (transl_tupled_cases ~scopes pats_expr_list) partial)
+      with Matching.Cannot_flatten ->
+        ((Curried, [param, Pgenval], return),
+         Matching.for_function ~scopes loc repr (Lvar param)
+           (transl_cases ~scopes cases) partial)
+      end
+  | {c_lhs=pat} :: other_cases ->
+      let kind =
+        (* All the patterns might not share the same types. We must take the
+           union of the patterns types *)
+        List.fold_left (fun k {c_lhs=pat} ->
+            Typeopt.value_kind_union k
+              (value_kind pat.pat_env pat.pat_type))
+          (value_kind pat.pat_env pat.pat_type) other_cases
+      in
+      ((Curried, [param, kind], return),
+       Matching.for_function ~scopes loc repr (Lvar param)
+         (transl_cases ~scopes cases) partial)
+  | [] ->
+      (* With Camlp4, a pattern matching might be empty *)
+      ((Curried, [param, Pgenval], return),
+       Matching.for_function ~scopes loc repr (Lvar param)
+         (transl_cases ~scopes cases) partial)
+
+and transl_function ~scopes e param cases partial =
+  let ((kind, params, return), body) =
+    event_function ~scopes e
+      (function repr ->
+         let pl = push_defaults e.exp_loc [] cases partial in
+         let return_kind = function_return_value_kind e.exp_env e.exp_type in
+         transl_function0 ~scopes e.exp_loc return_kind !Clflags.native_code
+           repr partial param pl)
+  in
+  let attr = default_function_attribute in
+  let loc = of_location ~scopes e.exp_loc in
+  let lam = Lfunction{kind; params; return; body; attr; loc} in
+  Translattribute.add_function_attributes lam e.exp_loc e.exp_attributes
+
+(* Like transl_exp, but used when introducing a new scope.
+   Goes to some trouble to avoid introducing many new anonymous function
+   scopes, as `let f a b = ...` is desugared to several Pexp_fun *)
+and transl_scoped_exp ~scopes expr =
+  match expr.exp_desc with
+  | Texp_function { arg_label = _; param; cases; partial } ->
+     transl_function ~scopes expr param cases partial
+  | _ ->
+     transl_exp ~scopes expr
+
+(* Calls transl_scoped_exp or transl_exp, according to whether a pattern
+   binding should introduce a new scope *)
+and transl_bound_exp ~scopes ~in_structure pat expr =
+  let should_introduce_scope =
+    match expr.exp_desc with
+    | Texp_function _ -> true
+    | _ when in_structure -> true
+    | _ -> false in
+  match pat_bound_idents pat with
+  | (id :: _) when should_introduce_scope ->
+     transl_scoped_exp ~scopes:(enter_value_definition ~scopes id) expr
+  | _ -> transl_exp ~scopes expr
+
+(*
+  Notice: transl_let consumes (ie compiles) its pat_expr_list argument,
+  and returns a function that will take the body of the lambda-let construct.
+  This complication allows choosing any compilation order for the
+  bindings and body of let constructs.
+*)
+and transl_let ~scopes ?(in_structure=false) rec_flag pat_expr_list =
+  match rec_flag with
+    Nonrecursive ->
+      let rec transl = function
+        [] ->
+          fun body -> body
+      | {vb_pat=pat; vb_expr=expr; vb_attributes=attr; vb_loc} :: rem ->
+          let lam = transl_bound_exp ~scopes ~in_structure pat expr in
+          let lam = Translattribute.add_function_attributes lam vb_loc attr in
+          let mk_body = transl rem in
+          fun body ->
+            Matching.for_let ~scopes pat.pat_loc lam pat (mk_body body)
+      in transl pat_expr_list
+  | Recursive ->
+      let idlist =
+        List.map
+          (fun {vb_pat=pat} -> match pat.pat_desc with
+              Tpat_var (id,_) -> id
+            | Tpat_alias ({pat_desc=Tpat_any}, id,_) -> id
+            | _ -> assert false)
+        pat_expr_list in
+      let transl_case {vb_expr=expr; vb_attributes; vb_loc; vb_pat} id =
+        let lam = transl_bound_exp ~scopes ~in_structure vb_pat expr in
+        let lam =
+          Translattribute.add_function_attributes lam vb_loc vb_attributes
+        in
+        (id, lam) in
+      let lam_bds = List.map2 transl_case pat_expr_list idlist in
+      fun body -> Lletrec(lam_bds, body)
+
+and transl_setinstvar ~scopes loc self var expr =
+  Lprim(Psetfield_computed (maybe_pointer expr, Assignment),
+    [self; var; transl_exp ~scopes expr], loc)
+
+and transl_record ~scopes loc env fields repres opt_init_expr =
+  let size = Array.length fields in
+  (* Determine if there are "enough" fields (only relevant if this is a
+     functional-style record update *)
+  let no_init = match opt_init_expr with None -> true | _ -> false in
+  if no_init || size < Config.max_young_wosize
+  then begin
+    (* Allocate new record with given fields (and remaining fields
+       taken from init_expr if any *)
+    let init_id = Ident.create_local "init" in
+    let lv =
+      Array.mapi
+        (fun i (_, definition) ->
+           match definition with
+           | Kept typ ->
+               let field_kind = value_kind env typ in
+               let access =
+                 match repres with
+                   Record_regular | Record_inlined _ -> Pfield i
+                 | Record_unboxed _ -> assert false
+                 | Record_extension _ -> Pfield (i + 1)
+                 | Record_float -> Pfloatfield i in
+               Lprim(access, [Lvar init_id],
+                     of_location ~scopes loc),
+               field_kind
+           | Overridden (_lid, expr) ->
+               let field_kind = value_kind expr.exp_env expr.exp_type in
+               transl_exp ~scopes expr, field_kind)
+        fields
+    in
+    let ll, shape = List.split (Array.to_list lv) in
+    let mut =
+      if Array.exists (fun (lbl, _) -> lbl.lbl_mut = Mutable) fields
+      then Mutable
+      else Immutable in
+    let lam =
+      try
+        if mut = Mutable then raise Not_constant;
+        let cl = List.map extract_constant ll in
+        match repres with
+        | Record_regular -> Lconst(Const_block(0, cl))
+        | Record_inlined tag -> Lconst(Const_block(tag, cl))
+        | Record_unboxed _ -> Lconst(match cl with [v] -> v | _ -> assert false)
+        | Record_float ->
+            Lconst(Const_float_array(List.map extract_float cl))
+        | Record_extension _ ->
+            raise Not_constant
+      with Not_constant ->
+        let loc = of_location ~scopes loc in
+        match repres with
+          Record_regular ->
+            Lprim(Pmakeblock(0, mut, Some shape), ll, loc)
+        | Record_inlined tag ->
+            Lprim(Pmakeblock(tag, mut, Some shape), ll, loc)
+        | Record_unboxed _ -> (match ll with [v] -> v | _ -> assert false)
+        | Record_float ->
+            Lprim(Pmakearray (Pfloatarray, mut), ll, loc)
+        | Record_extension path ->
+            let slot = transl_extension_path loc env path in
+            Lprim(Pmakeblock(0, mut, Some (Pgenval :: shape)), slot :: ll, loc)
+    in
+    begin match opt_init_expr with
+      None -> lam
+    | Some init_expr -> Llet(Strict, Pgenval, init_id,
+                             transl_exp ~scopes init_expr, lam)
+    end
+  end else begin
+    (* Take a shallow copy of the init record, then mutate the fields
+       of the copy *)
+    let copy_id = Ident.create_local "newrecord" in
+    let update_field cont (lbl, definition) =
+      match definition with
+      | Kept _type -> cont
+      | Overridden (_lid, expr) ->
+          let upd =
+            match repres with
+              Record_regular
+            | Record_inlined _ ->
+                Psetfield(lbl.lbl_pos, maybe_pointer expr, Assignment)
+            | Record_unboxed _ -> assert false
+            | Record_float -> Psetfloatfield (lbl.lbl_pos, Assignment)
+            | Record_extension _ ->
+                Psetfield(lbl.lbl_pos + 1, maybe_pointer expr, Assignment)
+          in
+          Lsequence(Lprim(upd, [Lvar copy_id; transl_exp ~scopes expr],
+                          of_location ~scopes loc),
+                    cont)
+    in
+    begin match opt_init_expr with
+      None -> assert false
+    | Some init_expr ->
+        Llet(Strict, Pgenval, copy_id,
+             Lprim(Pduprecord (repres, size), [transl_exp ~scopes init_expr],
+                   of_location ~scopes loc),
+             Array.fold_left update_field (Lvar copy_id) fields)
+    end
+  end
+
+and transl_match ~scopes e arg pat_expr_list partial =
+  let rewrite_case (val_cases, exn_cases, static_handlers as acc)
+        ({ c_lhs; c_guard; 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 ->
+        let val_case =
+          transl_case ~scopes { case with c_lhs = pv }
+        in
+        val_case :: val_cases, exn_cases, static_handlers
+    | None, Some pe ->
+        let exn_case = transl_case_try ~scopes { case with c_lhs = pe } in
+        val_cases, exn_case :: exn_cases, static_handlers
+    | Some pv, Some pe ->
+        assert (c_guard = None);
+        let lbl  = next_raise_count () in
+        let static_raise ids =
+          Lstaticraise (lbl, List.map (fun id -> Lvar id) ids)
+        in
+        (* Simplif doesn't like it if binders are not uniq, so we make sure to
+           use different names in the value and the exception branches. *)
+        let ids_full = Typedtree.pat_bound_idents_full pv in
+        let ids = List.map (fun (id, _, _) -> id) ids_full in
+        let ids_kinds =
+          List.map (fun (id, _, ty) -> id, Typeopt.value_kind pv.pat_env ty)
+            ids_full
+        in
+        let vids = List.map Ident.rename ids in
+        let pv = alpha_pat (List.combine ids vids) pv in
+        (* Also register the names of the exception so Re-raise happens. *)
+        iter_exn_names Translprim.add_exception_ident pe;
+        let rhs =
+          Misc.try_finally
+            (fun () -> event_before ~scopes c_rhs
+                         (transl_exp ~scopes c_rhs))
+            ~always:(fun () ->
+                iter_exn_names Translprim.remove_exception_ident pe)
+        in
+        (pv, static_raise vids) :: val_cases,
+        (pe, static_raise ids) :: exn_cases,
+        (lbl, ids_kinds, rhs) :: static_handlers
+  in
+  let val_cases, exn_cases, static_handlers =
+    let x, y, z = List.fold_left rewrite_case ([], [], []) pat_expr_list in
+    List.rev x, List.rev y, List.rev z
+  in
+  let static_catch body val_ids handler =
+    let id = Typecore.name_pattern "exn" (List.map fst exn_cases) in
+    let static_exception_id = next_raise_count () in
+    Lstaticcatch
+      (Ltrywith (Lstaticraise (static_exception_id, body), id,
+                 Matching.for_trywith ~scopes (Lvar id) exn_cases),
+       (static_exception_id, val_ids),
+       handler)
+  in
+  let classic =
+    match arg, exn_cases with
+    | {exp_desc = Texp_tuple argl}, [] ->
+      assert (static_handlers = []);
+      Matching.for_multiple_match ~scopes e.exp_loc
+        (transl_list ~scopes argl) val_cases partial
+    | {exp_desc = Texp_tuple argl}, _ :: _ ->
+        let val_ids =
+          List.map
+            (fun arg ->
+               Typecore.name_pattern "val" [],
+               Typeopt.value_kind arg.exp_env arg.exp_type
+            )
+            argl
+        in
+        let lvars = List.map (fun (id, _) -> Lvar id) val_ids in
+        static_catch (transl_list ~scopes argl) val_ids
+          (Matching.for_multiple_match ~scopes e.exp_loc
+             lvars val_cases partial)
+    | arg, [] ->
+      assert (static_handlers = []);
+      Matching.for_function ~scopes e.exp_loc
+        None (transl_exp ~scopes arg) val_cases partial
+    | arg, _ :: _ ->
+        let val_id = Typecore.name_pattern "val" (List.map fst val_cases) in
+        let k = Typeopt.value_kind arg.exp_env arg.exp_type in
+        static_catch [transl_exp ~scopes arg] [val_id, k]
+          (Matching.for_function ~scopes e.exp_loc
+             None (Lvar val_id) val_cases partial)
+  in
+  List.fold_left (fun body (static_exception_id, val_ids, handler) ->
+    Lstaticcatch (body, (static_exception_id, val_ids), handler)
+  ) classic static_handlers
+
+and transl_letop ~scopes loc env let_ ands param case partial =
+  let rec loop prev_lam = function
+    | [] -> prev_lam
+    | and_ :: rest ->
+        let left_id = Ident.create_local "left" in
+        let right_id = Ident.create_local "right" in
+        let op =
+          transl_ident (of_location ~scopes and_.bop_op_name.loc) env
+            and_.bop_op_type and_.bop_op_path and_.bop_op_val
+        in
+        let exp = transl_exp ~scopes and_.bop_exp in
+        let lam =
+          bind Strict right_id exp
+            (Lapply{ap_should_be_tailcall = false;
+                    ap_loc = of_location ~scopes and_.bop_loc;
+                    ap_func = op;
+                    ap_args=[Lvar left_id; Lvar right_id];
+                    ap_inlined=Default_inline;
+                    ap_specialised=Default_specialise})
+        in
+        bind Strict left_id prev_lam (loop lam rest)
+  in
+  let op =
+    transl_ident (of_location ~scopes let_.bop_op_name.loc) env
+      let_.bop_op_type let_.bop_op_path let_.bop_op_val
+  in
+  let exp = loop (transl_exp ~scopes let_.bop_exp) ands in
+  let func =
+    let return_kind = value_kind case.c_rhs.exp_env case.c_rhs.exp_type in
+    let (kind, params, return), body =
+      event_function ~scopes case.c_rhs
+        (function repr ->
+           transl_function0 ~scopes case.c_rhs.exp_loc return_kind
+             !Clflags.native_code repr partial param [case])
+    in
+    let attr = default_function_attribute in
+    let loc = of_location ~scopes case.c_rhs.exp_loc in
+    Lfunction{kind; params; return; body; attr; loc}
+  in
+  Lapply{ap_should_be_tailcall = false;
+         ap_loc = of_location ~scopes loc;
+         ap_func = op;
+         ap_args=[exp; func];
+         ap_inlined=Default_inline;
+         ap_specialised=Default_specialise}
+
+(* Wrapper for class compilation *)
+
+(*
+let transl_exp = transl_exp_wrap
+
+let transl_let rec_flag pat_expr_list body =
+  match pat_expr_list with
+    [] -> body
+  | (_, expr) :: _ ->
+      Translobj.oo_wrap expr.exp_env false
+        (transl_let rec_flag pat_expr_list) body
+*)
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+  | Free_super_var ->
+      fprintf ppf
+        "Ancestor names can only be used to select inherited methods"
+  | Unreachable_reached ->
+      fprintf ppf "Unreachable expression was reached"
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (loc, err) ->
+          Some (Location.error_of_printer ~loc report_error err)
+      | _ ->
+        None
+    )
diff --git a/lambda/translcore.mli b/lambda/translcore.mli
new file mode 100644
index 00000000..61b1a1d2
--- /dev/null
+++ b/lambda/translcore.mli
@@ -0,0 +1,58 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Translation from typed abstract syntax to lambda terms,
+   for the core language *)
+
+open Asttypes
+open Typedtree
+open Lambda
+open Debuginfo.Scoped_location
+
+val pure_module : module_expr -> let_kind
+
+val transl_exp: scopes:scopes -> expression -> lambda
+val transl_apply: scopes:scopes
+                  -> ?should_be_tailcall:bool
+                  -> ?inlined:inline_attribute
+                  -> ?specialised:specialise_attribute
+                  -> lambda -> (arg_label * expression option) list
+                  -> scoped_location -> lambda
+val transl_let: scopes:scopes -> ?in_structure:bool -> rec_flag
+                -> value_binding list -> lambda -> lambda
+
+val transl_extension_constructor: scopes:scopes ->
+  Env.t -> Path.t option ->
+  extension_constructor -> lambda
+
+val transl_scoped_exp : scopes:scopes -> expression -> lambda
+
+type error =
+    Free_super_var
+  | Unreachable_reached
+
+exception Error of Location.t * error
+
+open Format
+
+val report_error: formatter -> error -> unit
+
+(* Forward declaration -- to be filled in by Translmod.transl_module *)
+val transl_module :
+      (scopes:scopes -> module_coercion -> Path.t option ->
+       module_expr -> lambda) ref
+val transl_object :
+      (scopes:scopes -> Ident.t -> string list ->
+       class_expr -> lambda) ref
diff --git a/lambda/translmod.ml b/lambda/translmod.ml
new file mode 100644
index 00000000..e578ee7e
--- /dev/null
+++ b/lambda/translmod.ml
@@ -0,0 +1,1686 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Translation from typed abstract syntax to lambda terms,
+   for the module language *)
+
+open Misc
+open Asttypes
+open Path
+open Types
+open Typedtree
+open Lambda
+open Translobj
+open Translcore
+open Translclass
+open Debuginfo.Scoped_location
+
+type unsafe_component =
+  | Unsafe_module_binding
+  | Unsafe_functor
+  | Unsafe_non_function
+  | Unsafe_typext
+
+type unsafe_info =
+  | Unsafe of { reason:unsafe_component; loc:Location.t; subid:Ident.t }
+  | Unnamed
+type error =
+  Circular_dependency of (Ident.t * unsafe_info) list
+| Conflicting_inline_attributes
+
+exception Error of Location.t * error
+
+let cons_opt x_opt xs =
+  match x_opt with
+  | None -> xs
+  | Some x -> x :: xs
+
+(* Keep track of the root path (from the root of the namespace to the
+   currently compiled module expression).  Useful for naming extensions. *)
+
+let global_path glob = Some(Pident glob)
+let functor_path path param =
+  match path with
+    None -> None
+  | Some p -> Some(Papply(p, Pident param))
+let field_path path field =
+  match path with
+    None -> None
+  | Some p -> Some(Pdot(p, Ident.name field))
+
+(* Compile type extensions *)
+
+let transl_type_extension ~scopes env rootpath tyext body =
+  List.fold_right
+    (fun ext body ->
+      let lam =
+        transl_extension_constructor ~scopes env
+          (field_path rootpath ext.ext_id) ext
+      in
+      Llet(Strict, Pgenval, ext.ext_id, lam, body))
+    tyext.tyext_constructors
+    body
+
+(* Compile a coercion *)
+
+let rec apply_coercion loc strict restr arg =
+  match restr with
+    Tcoerce_none ->
+      arg
+  | Tcoerce_structure(pos_cc_list, id_pos_list) ->
+      name_lambda strict arg (fun id ->
+        let get_field pos =
+          if pos < 0 then lambda_unit
+          else Lprim(Pfield pos,[Lvar id], loc)
+        in
+        let lam =
+          Lprim(Pmakeblock(0, Immutable, None),
+                List.map (apply_coercion_field loc get_field) pos_cc_list,
+                loc)
+        in
+        wrap_id_pos_list loc id_pos_list get_field lam)
+  | Tcoerce_functor(cc_arg, cc_res) ->
+      let param = Ident.create_local "funarg" in
+      let carg = apply_coercion loc Alias cc_arg (Lvar param) in
+      apply_coercion_result loc strict arg [param, Pgenval] [carg] cc_res
+  | Tcoerce_primitive { pc_loc = _; pc_desc; pc_env; pc_type; } ->
+      Translprim.transl_primitive loc pc_desc pc_env pc_type None
+  | Tcoerce_alias (env, path, cc) ->
+      let lam = transl_module_path loc env path in
+      name_lambda strict arg
+        (fun _ -> apply_coercion loc Alias cc lam)
+
+and apply_coercion_field loc get_field (pos, cc) =
+  apply_coercion loc Alias cc (get_field pos)
+
+and apply_coercion_result loc strict funct params args cc_res =
+  match cc_res with
+  | Tcoerce_functor(cc_arg, cc_res) ->
+    let param = Ident.create_local "funarg" in
+    let arg = apply_coercion loc Alias cc_arg (Lvar param) in
+    apply_coercion_result loc strict funct
+      ((param, Pgenval) :: params) (arg :: args) cc_res
+  | _ ->
+      name_lambda strict funct
+        (fun id ->
+           Lfunction
+             {
+               kind = Curried;
+               params = List.rev params;
+               return = Pgenval;
+               attr = { default_function_attribute with
+                        is_a_functor = true;
+                        stub = true; };
+               loc = loc;
+               body = apply_coercion
+                   loc Strict cc_res
+                   (Lapply{ap_should_be_tailcall=false;
+                           ap_loc=loc;
+                           ap_func=Lvar id;
+                           ap_args=List.rev args;
+                           ap_inlined=Default_inline;
+                           ap_specialised=Default_specialise})})
+
+and wrap_id_pos_list loc id_pos_list get_field lam =
+  let fv = free_variables lam in
+  (*Format.eprintf "%a@." Printlambda.lambda lam;
+  Ident.Set.iter (fun id -> Format.eprintf "%a " Ident.print id) fv;
+  Format.eprintf "@.";*)
+  let (lam,s) =
+    List.fold_left (fun (lam, s) (id',pos,c) ->
+      if Ident.Set.mem id' fv then
+        let id'' = Ident.create_local (Ident.name id') in
+        (Llet(Alias, Pgenval, id'',
+             apply_coercion loc Alias c (get_field pos),lam),
+         Ident.Map.add id' id'' s)
+      else (lam, s))
+      (lam, Ident.Map.empty) id_pos_list
+  in
+  if s == Ident.Map.empty then lam else Lambda.rename s lam
+
+
+(* Compose two coercions
+   apply_coercion c1 (apply_coercion c2 e) behaves like
+   apply_coercion (compose_coercions c1 c2) e. *)
+
+let rec compose_coercions c1 c2 =
+  match (c1, c2) with
+    (Tcoerce_none, c2) -> c2
+  | (c1, Tcoerce_none) -> c1
+  | (Tcoerce_structure (pc1, ids1), Tcoerce_structure (pc2, ids2)) ->
+      let v2 = Array.of_list pc2 in
+      let ids1 =
+        List.map (fun (id,pos1,c1) ->
+          let (pos2,c2) = v2.(pos1) in (id, pos2, compose_coercions c1 c2))
+          ids1
+      in
+      Tcoerce_structure
+        (List.map
+           (fun pc ->
+              match pc with
+              | _, (Tcoerce_primitive _ | Tcoerce_alias _) ->
+                (* These cases do not take an argument (the position is -1),
+                   so they do not need adjusting. *)
+                pc
+              | (p1, c1) ->
+                let (p2, c2) = v2.(p1) in
+                (p2, compose_coercions c1 c2))
+          pc1,
+         ids1 @ ids2)
+  | (Tcoerce_functor(arg1, res1), Tcoerce_functor(arg2, res2)) ->
+      Tcoerce_functor(compose_coercions arg2 arg1,
+                      compose_coercions res1 res2)
+  | (c1, Tcoerce_alias (env, path, c2)) ->
+      Tcoerce_alias (env, path, compose_coercions c1 c2)
+  | (_, _) ->
+      fatal_error "Translmod.compose_coercions"
+
+(*
+let apply_coercion a b c =
+  Format.eprintf "@[<2>apply_coercion@ %a@]@." Includemod.print_coercion b;
+  apply_coercion a b c
+
+let compose_coercions c1 c2 =
+  let c3 = compose_coercions c1 c2 in
+  let open Includemod in
+  Format.eprintf "@[<2>compose_coercions@ (%a)@ (%a) =@ %a@]@."
+    print_coercion c1 print_coercion c2 print_coercion c3;
+  c3
+*)
+
+(* Record the primitive declarations occurring in the module compiled *)
+
+let primitive_declarations = ref ([] : Primitive.description list)
+let record_primitive = function
+  | {val_kind=Val_prim p;val_loc} ->
+      Translprim.check_primitive_arity val_loc p;
+      primitive_declarations := p :: !primitive_declarations
+  | _ -> ()
+
+(* Utilities for compiling "module rec" definitions *)
+
+let mod_prim = Lambda.transl_prim "CamlinternalMod"
+
+let undefined_location loc =
+  let (fname, line, char) = Location.get_pos_info loc.Location.loc_start in
+  Lconst(Const_block(0,
+                     [Const_base(Const_string (fname, loc, None));
+                      Const_base(Const_int line);
+                      Const_base(Const_int char)]))
+
+exception Initialization_failure of unsafe_info
+
+let init_shape id modl =
+  let rec init_shape_mod subid loc env mty =
+    match Mtype.scrape env mty with
+      Mty_ident _
+    | Mty_alias _ ->
+        raise (Initialization_failure
+                (Unsafe {reason=Unsafe_module_binding;loc;subid}))
+    | Mty_signature sg ->
+        Const_block(0, [Const_block(0, init_shape_struct env sg)])
+    | Mty_functor _ ->
+        (* can we do better? *)
+        raise (Initialization_failure
+                (Unsafe {reason=Unsafe_functor;loc;subid}))
+  and init_shape_struct env sg =
+    match sg with
+      [] -> []
+    | Sig_value(subid, {val_kind=Val_reg; val_type=ty; val_loc=loc},_) :: rem ->
+        let init_v =
+          match Ctype.expand_head env ty with
+            {desc = Tarrow(_,_,_,_)} ->
+              Const_pointer 0 (* camlinternalMod.Function *)
+          | {desc = Tconstr(p, _, _)} when Path.same p Predef.path_lazy_t ->
+              Const_pointer 1 (* camlinternalMod.Lazy *)
+          | _ ->
+              let not_a_function =
+                Unsafe {reason=Unsafe_non_function; loc; subid }
+              in
+              raise (Initialization_failure not_a_function) in
+        init_v :: init_shape_struct env rem
+    | Sig_value(_, {val_kind=Val_prim _}, _) :: rem ->
+        init_shape_struct env rem
+    | Sig_value _ :: _rem ->
+        assert false
+    | Sig_type(id, tdecl, _, _) :: rem ->
+        init_shape_struct (Env.add_type ~check:false id tdecl env) rem
+    | Sig_typext (subid, {ext_loc=loc},_,_) :: _ ->
+        raise (Initialization_failure (Unsafe {reason=Unsafe_typext;loc;subid}))
+    | Sig_module(id, Mp_present, md, _, _) :: rem ->
+        init_shape_mod id md.md_loc env md.md_type ::
+        init_shape_struct (Env.add_module_declaration ~check:false
+                             id Mp_present md env) rem
+    | Sig_module(id, Mp_absent, md, _, _) :: rem ->
+        init_shape_struct
+          (Env.add_module_declaration ~check:false
+                             id Mp_absent md env) rem
+    | Sig_modtype(id, minfo, _) :: rem ->
+        init_shape_struct (Env.add_modtype id minfo env) rem
+    | Sig_class _ :: rem ->
+        Const_pointer 2 (* camlinternalMod.Class *)
+        :: init_shape_struct env rem
+    | Sig_class_type _ :: rem ->
+        init_shape_struct env rem
+  in
+  try
+    Ok(undefined_location modl.mod_loc,
+       Lconst(init_shape_mod id modl.mod_loc modl.mod_env modl.mod_type))
+  with Initialization_failure reason -> Result.Error(reason)
+
+(* Reorder bindings to honor dependencies.  *)
+
+type binding_status =
+  | Undefined
+  | Inprogress of int option (** parent node *)
+  | Defined
+
+type id_or_ignore_loc =
+  | Id of Ident.t
+  | Ignore_loc of Lambda.scoped_location
+
+let extract_unsafe_cycle id status init cycle_start =
+  let info i = match init.(i) with
+    | Result.Error r ->
+        begin match id.(i) with
+        | Id id -> id, r
+        | Ignore_loc _ ->
+            assert false (* Can't refer to something without a name. *)
+        end
+    | Ok _ -> assert false in
+  let rec collect stop l i = match status.(i) with
+    | Inprogress None | Undefined | Defined -> assert false
+    | Inprogress Some i when i = stop -> info i :: l
+    | Inprogress Some i -> collect stop (info i::l) i in
+  collect cycle_start [] cycle_start
+
+let reorder_rec_bindings bindings =
+  let id = Array.of_list (List.map (fun (id,_,_,_) -> id) bindings)
+  and loc = Array.of_list (List.map (fun (_,loc,_,_) -> loc) bindings)
+  and init = Array.of_list (List.map (fun (_,_,init,_) -> init) bindings)
+  and rhs = Array.of_list (List.map (fun (_,_,_,rhs) -> rhs) bindings) in
+  let fv = Array.map Lambda.free_variables rhs in
+  let num_bindings = Array.length id in
+  let status = Array.make num_bindings Undefined in
+  let res = ref [] in
+  let is_unsafe i = match init.(i) with
+    | Ok _ -> false
+    | Result.Error _ -> true in
+  let init_res i = match init.(i) with
+    | Result.Error _ -> None
+    | Ok(a,b) -> Some(a,b) in
+  let rec emit_binding parent i =
+    match status.(i) with
+      Defined -> ()
+    | Inprogress _ ->
+        status.(i) <- Inprogress parent;
+        let cycle = extract_unsafe_cycle id status init i in
+        raise(Error(loc.(i), Circular_dependency cycle))
+    | Undefined ->
+        if is_unsafe i then begin
+          status.(i) <- Inprogress parent;
+          for j = 0 to num_bindings - 1 do
+            match id.(j) with
+            | Id id when Ident.Set.mem id fv.(i) -> emit_binding (Some i) j
+            | _ -> ()
+          done
+        end;
+        res := (id.(i), init_res i, rhs.(i)) :: !res;
+        status.(i) <- Defined in
+  for i = 0 to num_bindings - 1 do
+    match status.(i) with
+      Undefined -> emit_binding None i
+    | Inprogress _ -> assert false
+    | Defined -> ()
+  done;
+  List.rev !res
+
+(* Generate lambda-code for a reordered list of bindings *)
+
+let eval_rec_bindings bindings cont =
+  let rec bind_inits = function
+    [] ->
+      bind_strict bindings
+  | (Ignore_loc _, _, _) :: rem
+  | (_, None, _) :: rem ->
+      bind_inits rem
+  | (Id id, Some(loc, shape), _rhs) :: rem ->
+      Llet(Strict, Pgenval, id,
+           Lapply{ap_should_be_tailcall=false;
+                  ap_loc=Loc_unknown;
+                  ap_func=mod_prim "init_mod";
+                  ap_args=[loc; shape];
+                  ap_inlined=Default_inline;
+                  ap_specialised=Default_specialise},
+           bind_inits rem)
+  and bind_strict = function
+    [] ->
+      patch_forwards bindings
+  | (Ignore_loc loc, None, rhs) :: rem ->
+      Lsequence(Lprim(Pignore, [rhs], loc), bind_strict rem)
+  | (Id id, None, rhs) :: rem ->
+      Llet(Strict, Pgenval, id, rhs, bind_strict rem)
+  | (_id, Some _, _rhs) :: rem ->
+      bind_strict rem
+  and patch_forwards = function
+    [] ->
+      cont
+  | (Ignore_loc _, _, _rhs) :: rem
+  | (_, None, _rhs) :: rem ->
+      patch_forwards rem
+  | (Id id, Some(_loc, shape), rhs) :: rem ->
+      Lsequence(Lapply{ap_should_be_tailcall=false;
+                       ap_loc=Loc_unknown;
+                       ap_func=mod_prim "update_mod";
+                       ap_args=[shape; Lvar id; rhs];
+                       ap_inlined=Default_inline;
+                       ap_specialised=Default_specialise},
+                patch_forwards rem)
+  in
+    bind_inits bindings
+
+let compile_recmodule ~scopes compile_rhs bindings cont =
+  eval_rec_bindings
+    (reorder_rec_bindings
+       (List.map
+          (fun {mb_id=id; mb_name; mb_expr=modl; mb_loc=loc; _} ->
+             let id_or_ignore_loc, shape =
+               match id with
+               | None ->
+                 let loc = of_location ~scopes mb_name.loc in
+                 Ignore_loc loc, Result.Error Unnamed
+               | Some id -> Id id, init_shape id modl
+             in
+             (id_or_ignore_loc, modl.mod_loc, shape, compile_rhs id modl loc))
+          bindings))
+    cont
+
+(* Code to translate class entries in a structure *)
+
+let transl_class_bindings ~scopes cl_list =
+  let ids = List.map (fun (ci, _) -> ci.ci_id_class) cl_list in
+  (ids,
+   List.map
+     (fun ({ci_id_class=id; ci_expr=cl; ci_virt=vf}, meths) ->
+       (id, transl_class ~scopes ids id meths cl vf))
+     cl_list)
+
+(* Compile one or more functors, merging curried functors to produce
+   multi-argument functors.  Any [@inline] attribute on a functor that is
+   merged must be consistent with any other [@inline] attribute(s) on the
+   functor(s) being merged with.  Such an attribute will be placed on the
+   resulting merged functor. *)
+
+let merge_inline_attributes attr1 attr2 loc =
+  match Lambda.merge_inline_attributes attr1 attr2 with
+  | Some attr -> attr
+  | None -> raise (Error (to_location loc, Conflicting_inline_attributes))
+
+let merge_functors ~scopes mexp coercion root_path =
+  let rec merge ~scopes mexp coercion path acc inline_attribute =
+    let finished = acc, mexp, path, coercion, inline_attribute in
+    match mexp.mod_desc with
+    | Tmod_functor (param, body) ->
+      let inline_attribute' =
+        Translattribute.get_inline_attribute mexp.mod_attributes
+      in
+      let arg_coercion, res_coercion =
+        match coercion with
+        | Tcoerce_none -> Tcoerce_none, Tcoerce_none
+        | Tcoerce_functor (arg_coercion, res_coercion) ->
+          arg_coercion, res_coercion
+        | _ -> fatal_error "Translmod.merge_functors: bad coercion"
+      in
+      let loc = of_location ~scopes mexp.mod_loc in
+      let path, param =
+        match param with
+        | Unit -> None, Ident.create_local "*"
+        | Named (None, _, _) ->
+          let id = Ident.create_local "_" in
+          functor_path path id, id
+        | Named (Some id, _, _) -> functor_path path id, id
+      in
+      let inline_attribute =
+        merge_inline_attributes inline_attribute inline_attribute' loc
+      in
+      merge ~scopes body res_coercion path ((param, loc, arg_coercion) :: acc)
+        inline_attribute
+    | _ -> finished
+  in
+  merge ~scopes mexp coercion root_path [] Default_inline
+
+let rec compile_functor ~scopes mexp coercion root_path loc =
+  let functor_params_rev, body, body_path, res_coercion, inline_attribute =
+    merge_functors ~scopes mexp coercion root_path
+  in
+  assert (List.length functor_params_rev >= 1);  (* cf. [transl_module] *)
+  let params, body =
+    List.fold_left (fun (params, body) (param, loc, arg_coercion) ->
+        let param' = Ident.rename param in
+        let arg = apply_coercion loc Alias arg_coercion (Lvar param') in
+        let params = (param', Pgenval) :: params in
+        let body = Llet (Alias, Pgenval, param, arg, body) in
+        params, body)
+      ([], transl_module ~scopes res_coercion body_path body)
+      functor_params_rev
+  in
+  Lfunction {
+    kind = Curried;
+    params;
+    return = Pgenval;
+    attr = {
+      inline = inline_attribute;
+      specialise = Default_specialise;
+      local = Default_local;
+      is_a_functor = true;
+      stub = false;
+    };
+    loc;
+    body;
+  }
+
+(* Compile a module expression *)
+
+and transl_module ~scopes cc rootpath mexp =
+  List.iter (Translattribute.check_attribute_on_module mexp)
+    mexp.mod_attributes;
+  let loc = of_location ~scopes mexp.mod_loc in
+  match mexp.mod_desc with
+  | Tmod_ident (path,_) ->
+      apply_coercion loc Strict cc
+        (transl_module_path loc mexp.mod_env path)
+  | Tmod_structure str ->
+      fst (transl_struct ~scopes loc [] cc rootpath str)
+  | Tmod_functor _ ->
+      oo_wrap mexp.mod_env true (fun () ->
+        compile_functor ~scopes mexp cc rootpath loc) ()
+  | Tmod_apply(funct, arg, ccarg) ->
+      let inlined_attribute, funct =
+        Translattribute.get_and_remove_inlined_attribute_on_module funct
+      in
+      oo_wrap mexp.mod_env true
+        (apply_coercion loc Strict cc)
+        (Lapply{ap_should_be_tailcall=false;
+                ap_loc=loc;
+                ap_func=transl_module ~scopes Tcoerce_none None funct;
+                ap_args=[transl_module ~scopes ccarg None arg];
+                ap_inlined=inlined_attribute;
+                ap_specialised=Default_specialise})
+  | Tmod_constraint(arg, _, _, ccarg) ->
+      transl_module ~scopes (compose_coercions cc ccarg) rootpath arg
+  | Tmod_unpack(arg, _) ->
+      apply_coercion loc Strict cc (Translcore.transl_exp ~scopes arg)
+
+and transl_struct ~scopes loc fields cc rootpath {str_final_env; str_items; _} =
+  transl_structure ~scopes loc fields cc rootpath str_final_env str_items
+
+(* The function  transl_structure is called by  the bytecode compiler.
+   Some effort is made to compile in top to bottom order, in order to display
+   warning by increasing locations. *)
+and transl_structure ~scopes loc fields cc rootpath final_env = function
+    [] ->
+      let body, size =
+        match cc with
+          Tcoerce_none ->
+            Lprim(Pmakeblock(0, Immutable, None),
+                  List.map (fun id -> Lvar id) (List.rev fields), loc),
+              List.length fields
+        | Tcoerce_structure(pos_cc_list, id_pos_list) ->
+                (* Do not ignore id_pos_list ! *)
+            (*Format.eprintf "%a@.@[" Includemod.print_coercion cc;
+            List.iter (fun l -> Format.eprintf "%a@ " Ident.print l)
+              fields;
+            Format.eprintf "@]@.";*)
+            let v = Array.of_list (List.rev fields) in
+            let get_field pos =
+              if pos < 0 then lambda_unit
+              else Lvar v.(pos)
+            in
+            let ids = List.fold_right Ident.Set.add fields Ident.Set.empty in
+            let lam =
+              Lprim(Pmakeblock(0, Immutable, None),
+                  List.map
+                    (fun (pos, cc) ->
+                      match cc with
+                        Tcoerce_primitive p ->
+                          Translprim.transl_primitive
+                            (of_location ~scopes p.pc_loc)
+                            p.pc_desc p.pc_env p.pc_type None
+                      | _ -> apply_coercion loc Strict cc (get_field pos))
+                    pos_cc_list, loc)
+            and id_pos_list =
+              List.filter (fun (id,_,_) -> not (Ident.Set.mem id ids))
+                id_pos_list
+            in
+            wrap_id_pos_list loc id_pos_list get_field lam,
+              List.length pos_cc_list
+        | _ ->
+            fatal_error "Translmod.transl_structure"
+      in
+      (* This debugging event provides information regarding the structure
+         items. It is ignored by the OCaml debugger but is used by
+         Js_of_ocaml to preserve variable names. *)
+      (if !Clflags.debug && not !Clflags.native_code then
+         Levent(body,
+                {lev_loc = loc;
+                 lev_kind = Lev_pseudo;
+                 lev_repr = None;
+                 lev_env = final_env})
+       else
+         body),
+      size
+  | item :: rem ->
+      match item.str_desc with
+      | Tstr_eval (expr, _) ->
+          let body, size =
+            transl_structure ~scopes loc fields cc rootpath final_env rem
+          in
+          Lsequence(transl_exp ~scopes expr, body), size
+      | Tstr_value(rec_flag, pat_expr_list) ->
+          (* Translate bindings first *)
+          let mk_lam_let =
+            transl_let ~scopes ~in_structure:true rec_flag pat_expr_list in
+          let ext_fields =
+            List.rev_append (let_bound_idents pat_expr_list) fields in
+          (* Then, translate remainder of struct *)
+          let body, size =
+            transl_structure ~scopes loc ext_fields cc rootpath final_env rem
+          in
+          mk_lam_let body, size
+      | Tstr_primitive descr ->
+          record_primitive descr.val_val;
+          transl_structure ~scopes loc fields cc rootpath final_env rem
+      | Tstr_type _ ->
+          transl_structure ~scopes loc fields cc rootpath final_env rem
+      | Tstr_typext(tyext) ->
+          let ids = List.map (fun ext -> ext.ext_id) tyext.tyext_constructors in
+          let body, size =
+            transl_structure ~scopes loc (List.rev_append ids fields)
+              cc rootpath final_env rem
+          in
+          transl_type_extension ~scopes item.str_env rootpath tyext body, size
+      | Tstr_exception ext ->
+          let id = ext.tyexn_constructor.ext_id in
+          let path = field_path rootpath id in
+          let body, size =
+            transl_structure ~scopes loc (id::fields) cc rootpath final_env rem
+          in
+          Llet(Strict, Pgenval, id,
+               transl_extension_constructor ~scopes
+                                            item.str_env
+                                            path
+                                            ext.tyexn_constructor, body),
+          size
+      | Tstr_module ({mb_presence=Mp_present} as mb) ->
+          let id = mb.mb_id in
+          (* Translate module first *)
+          let subscopes = match id with
+            | None -> scopes
+            | Some id -> enter_module_definition ~scopes id in
+          let module_body =
+            transl_module ~scopes:subscopes Tcoerce_none
+              (Option.bind id (field_path rootpath)) mb.mb_expr
+          in
+          let module_body =
+            Translattribute.add_inline_attribute module_body mb.mb_loc
+                                                 mb.mb_attributes
+          in
+          (* Translate remainder second *)
+          let body, size =
+            transl_structure ~scopes loc (cons_opt id fields)
+              cc rootpath final_env rem
+          in
+          begin match id with
+          | None ->
+              Lsequence (Lprim(Pignore, [module_body],
+                               of_location ~scopes mb.mb_name.loc), body),
+              size
+          | Some id ->
+              let module_body =
+                Levent (module_body, {
+                  lev_loc = of_location ~scopes mb.mb_loc;
+                  lev_kind = Lev_module_definition id;
+                  lev_repr = None;
+                  lev_env = Env.empty;
+                })
+              in
+              Llet(pure_module mb.mb_expr, Pgenval, id, module_body, body), size
+          end
+      | Tstr_module {mb_presence=Mp_absent} ->
+          transl_structure ~scopes loc fields cc rootpath final_env rem
+      | Tstr_recmodule bindings ->
+          let ext_fields =
+            List.rev_append (List.filter_map (fun mb -> mb.mb_id) bindings)
+              fields
+          in
+          let body, size =
+            transl_structure ~scopes loc ext_fields cc rootpath final_env rem
+          in
+          let lam =
+            compile_recmodule ~scopes (fun id modl loc ->
+              match id with
+              | None -> transl_module ~scopes Tcoerce_none None modl
+              | Some id ->
+                  let module_body =
+                    transl_module
+                      ~scopes:(enter_module_definition ~scopes id)
+                      Tcoerce_none (field_path rootpath id) modl
+                  in
+                  Levent (module_body, {
+                    lev_loc = of_location ~scopes loc;
+                    lev_kind = Lev_module_definition id;
+                    lev_repr = None;
+                    lev_env = Env.empty;
+                  })
+            ) bindings body
+          in
+          lam, size
+      | Tstr_class cl_list ->
+          let (ids, class_bindings) = transl_class_bindings ~scopes cl_list in
+          let body, size =
+            transl_structure ~scopes loc (List.rev_append ids fields)
+              cc rootpath final_env rem
+          in
+          Lletrec(class_bindings, body), size
+      | Tstr_include incl ->
+          let ids = bound_value_identifiers incl.incl_type in
+          let modl = incl.incl_mod in
+          let mid = Ident.create_local "include" in
+          let rec rebind_idents pos newfields = function
+              [] ->
+                transl_structure ~scopes loc newfields cc rootpath final_env rem
+            | id :: ids ->
+                let body, size =
+                  rebind_idents (pos + 1) (id :: newfields) ids
+                in
+                Llet(Alias, Pgenval, id,
+                     Lprim(Pfield pos, [Lvar mid],
+                           of_location ~scopes incl.incl_loc), body),
+                size
+          in
+          let body, size = rebind_idents 0 fields ids in
+          Llet(pure_module modl, Pgenval, mid,
+               transl_module ~scopes Tcoerce_none None modl, body),
+          size
+
+      | Tstr_open od ->
+          let pure = pure_module od.open_expr in
+          (* this optimization shouldn't be needed because Simplif would
+             actually remove the [Llet] when it's not used.
+             But since [scan_used_globals] runs before Simplif, we need to do
+             it. *)
+          begin match od.open_bound_items with
+          | [] when pure = Alias ->
+              transl_structure ~scopes loc fields cc rootpath final_env rem
+          | _ ->
+              let ids = bound_value_identifiers od.open_bound_items in
+              let mid = Ident.create_local "open" in
+              let rec rebind_idents pos newfields = function
+                  [] -> transl_structure
+                          ~scopes loc newfields cc rootpath final_env rem
+                | id :: ids ->
+                  let body, size =
+                    rebind_idents (pos + 1) (id :: newfields) ids
+                  in
+                  Llet(Alias, Pgenval, id,
+                      Lprim(Pfield pos, [Lvar mid],
+                            of_location ~scopes od.open_loc), body),
+                  size
+              in
+              let body, size = rebind_idents 0 fields ids in
+              Llet(pure, Pgenval, mid,
+                   transl_module ~scopes Tcoerce_none None od.open_expr, body),
+              size
+          end
+      | Tstr_modtype _
+      | Tstr_class_type _
+      | Tstr_attribute _ ->
+          transl_structure ~scopes loc fields cc rootpath final_env rem
+
+(* Update forward declaration in Translcore *)
+let _ =
+  Translcore.transl_module := transl_module
+
+(* Introduce dependencies on modules referenced only by "external". *)
+
+let scan_used_globals lam =
+  let globals = ref Ident.Set.empty in
+  let rec scan lam =
+    Lambda.iter_head_constructor scan lam;
+    match lam with
+      Lprim ((Pgetglobal id | Psetglobal id), _, _) ->
+        globals := Ident.Set.add id !globals
+    | _ -> ()
+  in
+  scan lam; !globals
+
+let required_globals ~flambda body =
+  let globals = scan_used_globals body in
+  let add_global id req =
+    if not flambda && Ident.Set.mem id globals then
+      req
+    else
+      Ident.Set.add id req
+  in
+  let required =
+    List.fold_left
+      (fun acc path -> add_global (Path.head path) acc)
+      (if flambda then globals else Ident.Set.empty)
+      (Translprim.get_used_primitives ())
+  in
+  let required =
+    List.fold_right add_global (Env.get_required_globals ()) required
+  in
+  Env.reset_required_globals ();
+  Translprim.clear_used_primitives ();
+  required
+
+(* Compile an implementation *)
+
+let transl_implementation_flambda module_name (str, cc) =
+  reset_labels ();
+  primitive_declarations := [];
+  Translprim.clear_used_primitives ();
+  let module_id = Ident.create_persistent module_name in
+  let scopes = [Sc_module_definition module_name] in
+  let body, size =
+    Translobj.transl_label_init
+      (fun () -> transl_struct ~scopes Loc_unknown [] cc
+                   (global_path module_id) str)
+  in
+  { module_ident = module_id;
+    main_module_block_size = size;
+    required_globals = required_globals ~flambda:true body;
+    code = body }
+
+let transl_implementation module_name (str, cc) =
+  let implementation =
+    transl_implementation_flambda module_name (str, cc)
+  in
+  let code =
+    Lprim (Psetglobal implementation.module_ident, [implementation.code],
+           Loc_unknown)
+  in
+  { implementation with code }
+
+(* Build the list of value identifiers defined by a toplevel structure
+   (excluding primitive declarations). *)
+
+let rec defined_idents = function
+    [] -> []
+  | item :: rem ->
+    match item.str_desc with
+    | Tstr_eval _ -> defined_idents rem
+    | Tstr_value(_rec_flag, pat_expr_list) ->
+      let_bound_idents pat_expr_list @ defined_idents rem
+    | Tstr_primitive _ -> defined_idents rem
+    | Tstr_type _ -> defined_idents rem
+    | Tstr_typext tyext ->
+      List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
+      @ defined_idents rem
+    | Tstr_exception ext -> ext.tyexn_constructor.ext_id :: defined_idents rem
+    | Tstr_module {mb_id = Some id; mb_presence=Mp_present} ->
+      id :: defined_idents rem
+    | Tstr_module ({mb_id = None}
+                  |{mb_presence=Mp_absent}) -> defined_idents rem
+    | Tstr_recmodule decls ->
+      List.filter_map (fun mb -> mb.mb_id) decls @ defined_idents rem
+    | Tstr_modtype _ -> defined_idents rem
+    | Tstr_open od ->
+      bound_value_identifiers od.open_bound_items @ defined_idents rem
+    | Tstr_class cl_list ->
+      List.map (fun (ci, _) -> ci.ci_id_class) cl_list @ defined_idents rem
+    | Tstr_class_type _ -> defined_idents rem
+    | Tstr_include incl ->
+      bound_value_identifiers incl.incl_type @ defined_idents rem
+    | Tstr_attribute _ -> defined_idents rem
+
+(* second level idents (module M = struct ... let id = ... end),
+   and all sub-levels idents *)
+let rec more_idents = function
+    [] -> []
+  | item :: rem ->
+    match item.str_desc with
+    | Tstr_eval _ -> more_idents rem
+    | Tstr_value _ -> more_idents rem
+    | Tstr_primitive _ -> more_idents rem
+    | Tstr_type _ -> more_idents rem
+    | Tstr_typext _ -> more_idents rem
+    | Tstr_exception _ -> more_idents rem
+    | Tstr_recmodule _ -> more_idents rem
+    | Tstr_modtype _ -> more_idents rem
+    | Tstr_open od ->
+        let rest = more_idents rem in
+        begin match od.open_expr.mod_desc with
+        | Tmod_structure str -> all_idents str.str_items @ rest
+        | _ -> rest
+        end
+    | Tstr_class _ -> more_idents rem
+    | Tstr_class_type _ -> more_idents rem
+    | Tstr_include{incl_mod={mod_desc =
+                             Tmod_constraint ({mod_desc = Tmod_structure str},
+                                              _, _, _)}} ->
+        all_idents str.str_items @ more_idents rem
+    | Tstr_include _ -> more_idents rem
+    | Tstr_module
+        {mb_presence=Mp_present; mb_expr={mod_desc = Tmod_structure str}}
+    | Tstr_module
+        {mb_presence=Mp_present;
+         mb_expr={mod_desc=
+           Tmod_constraint ({mod_desc = Tmod_structure str}, _, _, _)}} ->
+        all_idents str.str_items @ more_idents rem
+    | Tstr_module _ -> more_idents rem
+    | Tstr_attribute _ -> more_idents rem
+
+and all_idents = function
+    [] -> []
+  | item :: rem ->
+    match item.str_desc with
+    | Tstr_eval _ -> all_idents rem
+    | Tstr_value(_rec_flag, pat_expr_list) ->
+      let_bound_idents pat_expr_list @ all_idents rem
+    | Tstr_primitive _ -> all_idents rem
+    | Tstr_type _ -> all_idents rem
+    | Tstr_typext tyext ->
+      List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
+      @ all_idents rem
+    | Tstr_exception ext -> ext.tyexn_constructor.ext_id :: all_idents rem
+    | Tstr_recmodule decls ->
+      List.filter_map (fun mb -> mb.mb_id) decls @ all_idents rem
+    | Tstr_modtype _ -> all_idents rem
+    | Tstr_open od ->
+        let rest = all_idents rem in
+        begin match od.open_expr.mod_desc with
+        | Tmod_structure str ->
+          bound_value_identifiers od.open_bound_items
+          @ all_idents str.str_items
+          @ rest
+        | _ -> bound_value_identifiers od.open_bound_items @ rest
+        end
+    | Tstr_class cl_list ->
+      List.map (fun (ci, _) -> ci.ci_id_class) cl_list @ all_idents rem
+    | Tstr_class_type _ -> all_idents rem
+
+    | Tstr_include{incl_type; incl_mod={mod_desc =
+                             Tmod_constraint ({mod_desc = Tmod_structure str},
+                                              _, _, _)}} ->
+        bound_value_identifiers incl_type
+        @ all_idents str.str_items
+        @ all_idents rem
+    | Tstr_include incl ->
+      bound_value_identifiers incl.incl_type @ all_idents rem
+
+    | Tstr_module
+        { mb_id = Some id;
+          mb_presence=Mp_present;
+          mb_expr={mod_desc = Tmod_structure str} }
+    | Tstr_module
+        { mb_id = Some id;
+          mb_presence = Mp_present;
+          mb_expr =
+            {mod_desc =
+               Tmod_constraint ({mod_desc = Tmod_structure str}, _, _, _)}} ->
+        id :: all_idents str.str_items @ all_idents rem
+    | Tstr_module {mb_id = Some id;mb_presence=Mp_present} ->
+        id :: all_idents rem
+    | Tstr_module ({mb_id = None} | {mb_presence=Mp_absent}) -> all_idents rem
+    | Tstr_attribute _ -> all_idents rem
+
+
+(* A variant of transl_structure used to compile toplevel structure definitions
+   for the native-code compiler. Store the defined values in the fields
+   of the global as soon as they are defined, in order to reduce register
+   pressure.  Also rewrites the defining expressions so that they
+   refer to earlier fields of the structure through the fields of
+   the global, not by their names.
+   "map" is a table from defined idents to (pos in global block, coercion).
+   "prim" is a list of (pos in global block, primitive declaration). *)
+
+let transl_store_subst = ref Ident.Map.empty
+  (** In the native toplevel, this reference is threaded through successive
+      calls of transl_store_structure *)
+
+let nat_toplevel_name id =
+  try match Ident.Map.find id !transl_store_subst with
+    | Lprim(Pfield pos, [Lprim(Pgetglobal glob, [], _)], _) -> (glob,pos)
+    | _ -> raise Not_found
+  with Not_found ->
+    fatal_error("Translmod.nat_toplevel_name: " ^ Ident.unique_name id)
+
+let field_of_str loc str =
+  let ids = Array.of_list (defined_idents str.str_items) in
+  fun (pos, cc) ->
+    match cc with
+    | Tcoerce_primitive { pc_loc = _; pc_desc; pc_env; pc_type; } ->
+        Translprim.transl_primitive loc pc_desc pc_env pc_type None
+    | Tcoerce_alias (env, path, cc) ->
+        let lam = transl_module_path loc env path in
+        apply_coercion loc Alias cc lam
+    | _ -> apply_coercion loc Strict cc (Lvar ids.(pos))
+
+
+let transl_store_structure ~scopes glob map prims aliases str =
+  let no_env_update _ _ env = env in
+  let rec transl_store ~scopes rootpath subst cont = function
+    [] ->
+      transl_store_subst := subst;
+      Lambda.subst no_env_update subst cont
+    | item :: rem ->
+        match item.str_desc with
+        | Tstr_eval (expr, _attrs) ->
+            Lsequence(Lambda.subst no_env_update subst
+                        (transl_exp ~scopes expr),
+                      transl_store ~scopes rootpath subst cont rem)
+        | Tstr_value(rec_flag, pat_expr_list) ->
+            let ids = let_bound_idents pat_expr_list in
+            let lam =
+              transl_let ~scopes ~in_structure:true rec_flag pat_expr_list
+                (store_idents Loc_unknown ids)
+            in
+            Lsequence(Lambda.subst no_env_update subst lam,
+                      transl_store ~scopes rootpath
+                        (add_idents false ids subst) cont rem)
+        | Tstr_primitive descr ->
+            record_primitive descr.val_val;
+            transl_store ~scopes rootpath subst cont rem
+        | Tstr_type _ ->
+            transl_store ~scopes rootpath subst cont rem
+        | Tstr_typext(tyext) ->
+            let ids =
+              List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
+            in
+            let lam =
+              transl_type_extension ~scopes item.str_env rootpath tyext
+                                    (store_idents Loc_unknown ids)
+            in
+            Lsequence(Lambda.subst no_env_update subst lam,
+                      transl_store ~scopes rootpath
+                        (add_idents false ids subst) cont rem)
+        | Tstr_exception ext ->
+            let id = ext.tyexn_constructor.ext_id in
+            let path = field_path rootpath id in
+            let loc = of_location ~scopes ext.tyexn_constructor.ext_loc in
+            let lam =
+              transl_extension_constructor ~scopes
+                                           item.str_env
+                                           path
+                                           ext.tyexn_constructor
+            in
+            Lsequence(Llet(Strict, Pgenval, id,
+                           Lambda.subst no_env_update subst lam,
+                           store_ident loc id),
+                      transl_store ~scopes rootpath
+                        (add_ident false id subst) cont rem)
+        | Tstr_module
+            {mb_id=None; mb_name; mb_presence=Mp_present; mb_expr=modl;
+             mb_loc=loc; mb_attributes} ->
+            let lam =
+              Translattribute.add_inline_attribute
+                (transl_module ~scopes Tcoerce_none None modl)
+                loc mb_attributes
+            in
+            Lsequence(
+              Lprim(Pignore,[Lambda.subst no_env_update subst lam],
+                    of_location ~scopes mb_name.loc),
+              transl_store ~scopes rootpath subst cont rem
+            )
+        | Tstr_module{mb_id=Some id;mb_loc=loc;mb_presence=Mp_present;
+                      mb_expr={mod_desc = Tmod_structure str} as mexp;
+                      mb_attributes} ->
+            List.iter (Translattribute.check_attribute_on_module mexp)
+              mb_attributes;
+            let loc = of_location ~scopes loc in
+            let lam =
+              transl_store
+                ~scopes:(enter_module_definition ~scopes id)
+                (field_path rootpath id) subst
+                lambda_unit str.str_items
+            in
+            (* Careful: see next case *)
+            let subst = !transl_store_subst in
+            Lsequence(lam,
+                      Llet(Strict, Pgenval, id,
+                           Lambda.subst no_env_update subst
+                             (Lprim(Pmakeblock(0, Immutable, None),
+                                    List.map (fun id -> Lvar id)
+                                      (defined_idents str.str_items), loc)),
+                           Lsequence(store_ident loc id,
+                                     transl_store ~scopes rootpath
+                                                  (add_ident true id subst)
+                                                  cont rem)))
+        | Tstr_module{
+            mb_id=Some id;mb_loc=loc;mb_presence=Mp_present;
+            mb_expr= {
+              mod_desc = Tmod_constraint (
+                  {mod_desc = Tmod_structure str} as mexp, _, _,
+                  (Tcoerce_structure (map, _) as _cc))};
+            mb_attributes
+          } ->
+            (*    Format.printf "coerc id %s: %a@." (Ident.unique_name id)
+                                Includemod.print_coercion cc; *)
+            List.iter (Translattribute.check_attribute_on_module mexp)
+              mb_attributes;
+            let loc = of_location ~scopes loc in
+            let lam =
+              transl_store
+                ~scopes:(enter_module_definition ~scopes id)
+                (field_path rootpath id) subst
+                lambda_unit str.str_items
+            in
+            (* Careful: see next case *)
+            let subst = !transl_store_subst in
+            let field = field_of_str loc str in
+            Lsequence(lam,
+                      Llet(Strict, Pgenval, id,
+                           Lambda.subst no_env_update subst
+                             (Lprim(Pmakeblock(0, Immutable, None),
+                                    List.map field map, loc)),
+                           Lsequence(store_ident loc id,
+                                     transl_store ~scopes rootpath
+                                                  (add_ident true id subst)
+                                                  cont rem)))
+        | Tstr_module
+            {mb_id=Some id; mb_presence=Mp_present; mb_expr=modl;
+             mb_loc=loc; mb_attributes} ->
+            let lam =
+              Translattribute.add_inline_attribute
+                (transl_module
+                   ~scopes:(enter_module_definition ~scopes id)
+                   Tcoerce_none (field_path rootpath id) modl)
+                loc mb_attributes
+            in
+            (* Careful: the module value stored in the global may be different
+               from the local module value, in case a coercion is applied.
+               If so, keep using the local module value (id) in the remainder of
+               the compilation unit (add_ident true returns subst unchanged).
+               If not, we can use the value from the global
+               (add_ident true adds id -> Pgetglobal... to subst). *)
+            Llet(Strict, Pgenval, id, Lambda.subst no_env_update subst lam,
+                 Lsequence(store_ident (of_location ~scopes loc) id,
+                           transl_store ~scopes rootpath
+                             (add_ident true id subst)
+                             cont rem))
+        | Tstr_module {mb_presence=Mp_absent} ->
+            transl_store ~scopes rootpath subst cont rem
+        | Tstr_recmodule bindings ->
+            let ids = List.filter_map (fun mb -> mb.mb_id) bindings in
+            compile_recmodule ~scopes
+              (fun id modl _loc ->
+                 Lambda.subst no_env_update subst
+                   (match id with
+                    | None ->
+                      transl_module ~scopes Tcoerce_none None modl
+                    | Some id ->
+                      transl_module
+                        ~scopes:(enter_module_definition ~scopes id)
+                        Tcoerce_none (field_path rootpath id) modl))
+              bindings
+              (Lsequence(store_idents Loc_unknown ids,
+                         transl_store ~scopes rootpath
+                           (add_idents true ids subst) cont rem))
+        | Tstr_class cl_list ->
+            let (ids, class_bindings) = transl_class_bindings ~scopes cl_list in
+            let lam =
+              Lletrec(class_bindings, store_idents Loc_unknown ids)
+            in
+            Lsequence(Lambda.subst no_env_update subst lam,
+                      transl_store ~scopes rootpath (add_idents false ids subst)
+                        cont rem)
+
+        | Tstr_include{
+            incl_loc=loc;
+            incl_mod= {
+              mod_desc = Tmod_constraint (
+                  ({mod_desc = Tmod_structure str} as mexp), _, _,
+                  (Tcoerce_structure (map, _)))};
+            incl_attributes;
+            incl_type;
+          } ->
+            List.iter (Translattribute.check_attribute_on_module mexp)
+              incl_attributes;
+            (* Shouldn't we use mod_attributes instead of incl_attributes?
+               Same question for the Tstr_module cases above, btw. *)
+            let lam =
+              transl_store ~scopes None subst lambda_unit str.str_items
+                (* It is tempting to pass rootpath instead of None
+                   in order to give a more precise name to exceptions
+                   in the included structured, but this would introduce
+                   a difference of behavior compared to bytecode. *)
+            in
+            let subst = !transl_store_subst in
+            let field = field_of_str (of_location ~scopes loc) str in
+            let ids0 = bound_value_identifiers incl_type in
+            let rec loop ids args =
+              match ids, args with
+              | [], [] ->
+                  transl_store ~scopes rootpath (add_idents true ids0 subst)
+                    cont rem
+              | id :: ids, arg :: args ->
+                  Llet(Alias, Pgenval, id,
+                       Lambda.subst no_env_update subst (field arg),
+                       Lsequence(store_ident (of_location ~scopes loc) id,
+                                 loop ids args))
+              | _ -> assert false
+            in
+            Lsequence(lam, loop ids0 map)
+
+
+        | Tstr_include incl ->
+            let ids = bound_value_identifiers incl.incl_type in
+            let modl = incl.incl_mod in
+            let mid = Ident.create_local "include" in
+            let loc = incl.incl_loc in
+            let rec store_idents pos = function
+              | [] -> transl_store
+                        ~scopes rootpath (add_idents true ids subst) cont rem
+              | id :: idl ->
+                  Llet(Alias, Pgenval, id, Lprim(Pfield pos, [Lvar mid],
+                                                 of_location ~scopes loc),
+                       Lsequence(store_ident (of_location ~scopes loc) id,
+                                 store_idents (pos + 1) idl))
+            in
+            Llet(Strict, Pgenval, mid,
+                 Lambda.subst no_env_update subst
+                   (transl_module ~scopes Tcoerce_none None modl),
+                 store_idents 0 ids)
+        | Tstr_open od ->
+            begin match od.open_expr.mod_desc with
+            | Tmod_structure str ->
+                let lam =
+                  transl_store ~scopes rootpath subst lambda_unit str.str_items
+                in
+                let loc = of_location ~scopes od.open_loc in
+                let ids = Array.of_list (defined_idents str.str_items) in
+                let ids0 = bound_value_identifiers od.open_bound_items in
+                let subst = !transl_store_subst in
+                let rec store_idents pos = function
+                  | [] -> transl_store ~scopes rootpath
+                            (add_idents true ids0 subst) cont rem
+                  | id :: idl ->
+                      Llet(Alias, Pgenval, id, Lvar ids.(pos),
+                           Lsequence(store_ident loc id,
+                                     store_idents (pos + 1) idl))
+                in
+                Lsequence(lam, Lambda.subst no_env_update subst
+                                 (store_idents 0 ids0))
+            | _ ->
+                let pure = pure_module od.open_expr in
+                (* this optimization shouldn't be needed because Simplif would
+                   actually remove the [Llet] when it's not used.
+                   But since [scan_used_globals] runs before Simplif, we need to
+                   do it. *)
+                match od.open_bound_items with
+                | [] when pure = Alias ->
+                  transl_store ~scopes rootpath subst cont rem
+                | _ ->
+                    let ids = bound_value_identifiers od.open_bound_items in
+                    let mid = Ident.create_local "open" in
+                    let loc = of_location ~scopes od.open_loc in
+                    let rec store_idents pos = function
+                        [] -> transl_store ~scopes rootpath
+                                (add_idents true ids subst) cont rem
+                      | id :: idl ->
+                          Llet(Alias, Pgenval, id, Lprim(Pfield pos, [Lvar mid],
+                                                         loc),
+                               Lsequence(store_ident loc id,
+                                         store_idents (pos + 1) idl))
+                    in
+                    Llet(
+                      pure, Pgenval, mid,
+                      Lambda.subst no_env_update subst
+                        (transl_module ~scopes Tcoerce_none None od.open_expr),
+                      store_idents 0 ids)
+          end
+        | Tstr_modtype _
+        | Tstr_class_type _
+        | Tstr_attribute _ ->
+            transl_store ~scopes rootpath subst cont rem
+
+  and store_ident loc id =
+    try
+      let (pos, cc) = Ident.find_same id map in
+      let init_val = apply_coercion loc Alias cc (Lvar id) in
+      Lprim(Psetfield(pos, Pointer, Root_initialization),
+            [Lprim(Pgetglobal glob, [], loc); init_val],
+            loc)
+    with Not_found ->
+      fatal_error("Translmod.store_ident: " ^ Ident.unique_name id)
+
+  and store_idents loc idlist =
+    make_sequence (store_ident loc) idlist
+
+  and add_ident may_coerce id subst =
+    try
+      let (pos, cc) = Ident.find_same id map in
+      match cc with
+        Tcoerce_none ->
+          Ident.Map.add id
+            (Lprim(Pfield pos,
+                   [Lprim(Pgetglobal glob, [], Loc_unknown)],
+                   Loc_unknown))
+            subst
+      | _ ->
+          if may_coerce then subst else assert false
+    with Not_found ->
+      assert false
+
+  and add_idents may_coerce idlist subst =
+    List.fold_right (add_ident may_coerce) idlist subst
+
+  and store_primitive (pos, prim) cont =
+    Lsequence(Lprim(Psetfield(pos, Pointer, Root_initialization),
+                    [Lprim(Pgetglobal glob, [], Loc_unknown);
+                     Translprim.transl_primitive Loc_unknown
+                       prim.pc_desc prim.pc_env prim.pc_type None],
+                    Loc_unknown),
+              cont)
+
+  and store_alias (pos, env, path, cc) =
+    let path_lam = transl_module_path Loc_unknown env path in
+    let init_val = apply_coercion Loc_unknown Strict cc path_lam in
+    Lprim(Psetfield(pos, Pointer, Root_initialization),
+          [Lprim(Pgetglobal glob, [], Loc_unknown);
+           init_val],
+          Loc_unknown)
+  in
+  let aliases = make_sequence store_alias aliases in
+  List.fold_right store_primitive prims
+    (transl_store ~scopes (global_path glob) !transl_store_subst aliases str)
+
+(* Transform a coercion and the list of value identifiers defined by
+   a toplevel structure into a table [id -> (pos, coercion)],
+   with [pos] being the position in the global block where the value of
+   [id] must be stored, and [coercion] the coercion to be applied to it.
+   A given identifier may appear several times
+   in the coercion (if it occurs several times in the signature); remember
+   to assign it the position of its last occurrence.
+   Identifiers that are not exported are assigned positions at the
+   end of the block (beyond the positions of all exported idents).
+   Also compute the total size of the global block,
+   and the list of all primitives exported as values. *)
+
+let build_ident_map restr idlist more_ids =
+  let rec natural_map pos map prims aliases = function
+    | [] ->
+        (map, prims, aliases, pos)
+    | id :: rem ->
+        natural_map (pos+1)
+          (Ident.add id (pos, Tcoerce_none) map) prims aliases rem
+  in
+  let (map, prims, aliases, pos) =
+    match restr with
+    | Tcoerce_none ->
+        natural_map 0 Ident.empty [] [] idlist
+    | Tcoerce_structure (pos_cc_list, _id_pos_list) ->
+        (* ignore _id_pos_list as the ids are already bound *)
+        let idarray = Array.of_list idlist in
+        let rec export_map pos map prims aliases undef = function
+          | [] ->
+              natural_map pos map prims aliases undef
+          | (_source_pos, Tcoerce_primitive p) :: rem ->
+              export_map (pos + 1) map
+                ((pos, p) :: prims) aliases undef rem
+          | (_source_pos, Tcoerce_alias(env, path, cc)) :: rem ->
+              export_map (pos + 1) map prims
+                ((pos, env, path, cc) :: aliases) undef rem
+          | (source_pos, cc) :: rem ->
+              let id = idarray.(source_pos) in
+              export_map (pos + 1) (Ident.add id (pos, cc) map)
+                prims aliases (list_remove id undef) rem
+        in
+        export_map 0 Ident.empty [] [] idlist pos_cc_list
+    | _ ->
+        fatal_error "Translmod.build_ident_map"
+  in
+  natural_map pos map prims aliases more_ids
+
+(* Compile an implementation using transl_store_structure
+   (for the native-code compiler). *)
+
+let transl_store_gen ~scopes module_name ({ str_items = str }, restr) topl =
+  reset_labels ();
+  primitive_declarations := [];
+  Translprim.clear_used_primitives ();
+  let module_id = Ident.create_persistent module_name in
+  let (map, prims, aliases, size) =
+    build_ident_map restr (defined_idents str) (more_idents str) in
+  let f = function
+    | [ { str_desc = Tstr_eval (expr, _attrs) } ] when topl ->
+        assert (size = 0);
+        Lambda.subst (fun _ _ env -> env) !transl_store_subst
+          (transl_exp ~scopes expr)
+    | str -> transl_store_structure ~scopes module_id map prims aliases str
+  in
+  transl_store_label_init module_id size f str
+  (*size, transl_label_init (transl_store_structure module_id map prims str)*)
+
+let transl_store_phrases module_name str =
+  let scopes = [Sc_module_definition module_name] in
+  transl_store_gen ~scopes module_name (str,Tcoerce_none) true
+
+let transl_store_implementation module_name (str, restr) =
+  let s = !transl_store_subst in
+  transl_store_subst := Ident.Map.empty;
+  let module_ident = Ident.create_persistent module_name in
+  let scopes = [Sc_module_definition module_name] in
+  let (i, code) = transl_store_gen ~scopes module_name (str, restr) false in
+  transl_store_subst := s;
+  { Lambda.main_module_block_size = i;
+    code;
+    (* module_ident is not used by closure, but this allow to share
+       the type with the flambda version *)
+    module_ident;
+    required_globals = required_globals ~flambda:true code }
+
+(* Compile a toplevel phrase *)
+
+let toploop_ident = Ident.create_persistent "Toploop"
+let toploop_getvalue_pos = 0 (* position of getvalue in module Toploop *)
+let toploop_setvalue_pos = 1 (* position of setvalue in module Toploop *)
+
+let aliased_idents = ref Ident.empty
+
+let set_toplevel_unique_name id =
+  aliased_idents :=
+    Ident.add id (Ident.unique_toplevel_name id) !aliased_idents
+
+let toplevel_name id =
+  try Ident.find_same id !aliased_idents
+  with Not_found -> Ident.name id
+
+let toploop_getvalue id =
+  Lapply{ap_should_be_tailcall=false;
+         ap_loc=Loc_unknown;
+         ap_func=Lprim(Pfield toploop_getvalue_pos,
+                       [Lprim(Pgetglobal toploop_ident, [], Loc_unknown)],
+                       Loc_unknown);
+         ap_args=[Lconst(Const_base(
+             Const_string (toplevel_name id, Location.none,None)))];
+         ap_inlined=Default_inline;
+         ap_specialised=Default_specialise}
+
+let toploop_setvalue id lam =
+  Lapply{ap_should_be_tailcall=false;
+         ap_loc=Loc_unknown;
+         ap_func=Lprim(Pfield toploop_setvalue_pos,
+                       [Lprim(Pgetglobal toploop_ident, [], Loc_unknown)],
+                       Loc_unknown);
+         ap_args=[Lconst(Const_base(
+             Const_string (toplevel_name id, Location.none, None)));
+                  lam];
+         ap_inlined=Default_inline;
+         ap_specialised=Default_specialise}
+
+let toploop_setvalue_id id = toploop_setvalue id (Lvar id)
+
+let close_toplevel_term (lam, ()) =
+  Ident.Set.fold (fun id l -> Llet(Strict, Pgenval, id,
+                                  toploop_getvalue id, l))
+                (free_variables lam) lam
+
+let transl_toplevel_item ~scopes item =
+  match item.str_desc with
+    Tstr_eval (expr, _)
+  | Tstr_value(Nonrecursive,
+               [{vb_pat = {pat_desc=Tpat_any};vb_expr = expr}]) ->
+      (* special compilation for toplevel "let _ = expr", so
+         that Toploop can display the result of the expression.
+         Otherwise, the normal compilation would result
+         in a Lsequence returning unit. *)
+      transl_exp ~scopes expr
+  | Tstr_value(rec_flag, pat_expr_list) ->
+      let idents = let_bound_idents pat_expr_list in
+      transl_let ~scopes ~in_structure:true rec_flag pat_expr_list
+        (make_sequence toploop_setvalue_id idents)
+  | Tstr_typext(tyext) ->
+      let idents =
+        List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
+      in
+      (* we need to use unique name in case of multiple
+         definitions of the same extension constructor in the toplevel *)
+      List.iter set_toplevel_unique_name idents;
+        transl_type_extension ~scopes item.str_env None tyext
+          (make_sequence toploop_setvalue_id idents)
+  | Tstr_exception ext ->
+      set_toplevel_unique_name ext.tyexn_constructor.ext_id;
+      toploop_setvalue ext.tyexn_constructor.ext_id
+        (transl_extension_constructor ~scopes
+           item.str_env None ext.tyexn_constructor)
+  | Tstr_module {mb_id=None; mb_presence=Mp_present; mb_expr=modl} ->
+      transl_module ~scopes Tcoerce_none None modl
+  | Tstr_module {mb_id=Some id; mb_presence=Mp_present; mb_expr=modl} ->
+      (* we need to use the unique name for the module because of issues
+         with "open" (PR#8133) *)
+      set_toplevel_unique_name id;
+      let lam = transl_module
+                  ~scopes:(enter_module_definition ~scopes id)
+                  Tcoerce_none (Some(Pident id)) modl in
+      toploop_setvalue id lam
+  | Tstr_recmodule bindings ->
+      let idents = List.filter_map (fun mb -> mb.mb_id) bindings in
+      compile_recmodule ~scopes
+        (fun id modl _loc ->
+           match id with
+           | None ->
+             transl_module ~scopes Tcoerce_none None modl
+           | Some id ->
+             transl_module
+               ~scopes:(enter_module_definition ~scopes id)
+               Tcoerce_none (Some (Pident id)) modl)
+        bindings
+        (make_sequence toploop_setvalue_id idents)
+  | Tstr_class cl_list ->
+      (* we need to use unique names for the classes because there might
+         be a value named identically *)
+      let (ids, class_bindings) = transl_class_bindings ~scopes cl_list in
+      List.iter set_toplevel_unique_name ids;
+      Lletrec(class_bindings, make_sequence toploop_setvalue_id ids)
+  | Tstr_include incl ->
+      let ids = bound_value_identifiers incl.incl_type in
+      let modl = incl.incl_mod in
+      let mid = Ident.create_local "include" in
+      let rec set_idents pos = function
+        [] ->
+          lambda_unit
+      | id :: ids ->
+          Lsequence(toploop_setvalue id
+                      (Lprim(Pfield pos, [Lvar mid], Loc_unknown)),
+                    set_idents (pos + 1) ids) in
+      Llet(Strict, Pgenval, mid,
+           transl_module ~scopes Tcoerce_none None modl, set_idents 0 ids)
+  | Tstr_primitive descr ->
+      record_primitive descr.val_val;
+      lambda_unit
+  | Tstr_open od ->
+      let pure = pure_module od.open_expr in
+      (* this optimization shouldn't be needed because Simplif would
+          actually remove the [Llet] when it's not used.
+          But since [scan_used_globals] runs before Simplif, we need to do
+          it. *)
+      begin match od.open_bound_items with
+      | [] when pure = Alias -> lambda_unit
+      | _ ->
+          let ids = bound_value_identifiers od.open_bound_items in
+          let mid = Ident.create_local "open" in
+          let rec set_idents pos = function
+              [] ->
+                lambda_unit
+            | id :: ids ->
+                Lsequence(toploop_setvalue id
+                            (Lprim(Pfield pos, [Lvar mid], Loc_unknown)),
+                          set_idents (pos + 1) ids)
+          in
+          Llet(pure, Pgenval, mid,
+               transl_module ~scopes Tcoerce_none None od.open_expr,
+               set_idents 0 ids)
+      end
+  | Tstr_modtype _
+  | Tstr_module {mb_presence=Mp_absent}
+  | Tstr_type _
+  | Tstr_class_type _
+  | Tstr_attribute _ ->
+      lambda_unit
+
+let transl_toplevel_item_and_close ~scopes itm =
+  close_toplevel_term
+    (transl_label_init (fun () -> transl_toplevel_item ~scopes itm, ()))
+
+let transl_toplevel_definition str =
+  reset_labels ();
+  Translprim.clear_used_primitives ();
+  make_sequence (transl_toplevel_item_and_close ~scopes:[]) str.str_items
+
+(* Compile the initialization code for a packed library *)
+
+let get_component = function
+    None -> Lconst const_unit
+  | Some id -> Lprim(Pgetglobal id, [], Loc_unknown)
+
+let transl_package_flambda component_names coercion =
+  let size =
+    match coercion with
+    | Tcoerce_none -> List.length component_names
+    | Tcoerce_structure (l, _) -> List.length l
+    | Tcoerce_functor _
+    | Tcoerce_primitive _
+    | Tcoerce_alias _ -> assert false
+  in
+  size,
+  apply_coercion Loc_unknown Strict coercion
+    (Lprim(Pmakeblock(0, Immutable, None),
+           List.map get_component component_names,
+           Loc_unknown))
+
+let transl_package component_names target_name coercion =
+  let components =
+    Lprim(Pmakeblock(0, Immutable, None),
+          List.map get_component component_names, Loc_unknown) in
+  Lprim(Psetglobal target_name,
+        [apply_coercion Loc_unknown Strict coercion components],
+        Loc_unknown)
+  (*
+  let components =
+    match coercion with
+      Tcoerce_none ->
+        List.map get_component component_names
+    | Tcoerce_structure (pos_cc_list, id_pos_list) ->
+              (* ignore id_pos_list as the ids are already bound *)
+        let g = Array.of_list component_names in
+        List.map
+          (fun (pos, cc) -> apply_coercion Strict cc (get_component g.(pos)))
+          pos_cc_list
+    | _ ->
+        assert false in
+  Lprim(Psetglobal target_name, [Lprim(Pmakeblock(0, Immutable), components)])
+   *)
+
+let transl_store_package component_names target_name coercion =
+  let rec make_sequence fn pos arg =
+    match arg with
+      [] -> lambda_unit
+    | hd :: tl -> Lsequence(fn pos hd, make_sequence fn (pos + 1) tl) in
+  match coercion with
+    Tcoerce_none ->
+      (List.length component_names,
+       make_sequence
+         (fun pos id ->
+           Lprim(Psetfield(pos, Pointer, Root_initialization),
+                 [Lprim(Pgetglobal target_name, [], Loc_unknown);
+                  get_component id],
+                 Loc_unknown))
+         0 component_names)
+  | Tcoerce_structure (pos_cc_list, _id_pos_list) ->
+      let components =
+        Lprim(Pmakeblock(0, Immutable, None),
+              List.map get_component component_names,
+              Loc_unknown)
+      in
+      let blk = Ident.create_local "block" in
+      (List.length pos_cc_list,
+       Llet (Strict, Pgenval, blk,
+             apply_coercion Loc_unknown Strict coercion components,
+             make_sequence
+               (fun pos _id ->
+                 Lprim(Psetfield(pos, Pointer, Root_initialization),
+                       [Lprim(Pgetglobal target_name, [], Loc_unknown);
+                        Lprim(Pfield pos, [Lvar blk], Loc_unknown)],
+                       Loc_unknown))
+               0 pos_cc_list))
+  (*
+              (* ignore id_pos_list as the ids are already bound *)
+      let id = Array.of_list component_names in
+      (List.length pos_cc_list,
+       make_sequence
+         (fun dst (src, cc) ->
+           Lprim(Psetfield(dst, false),
+                 [Lprim(Pgetglobal target_name, []);
+                  apply_coercion Strict cc (get_component id.(src))]))
+         0 pos_cc_list)
+  *)
+  | _ -> assert false
+
+(* Error report *)
+
+open Format
+
+let print_cycle ppf cycle =
+  let print_ident ppf (x,_) = Format.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
+    pp_sep ()
+    (Ident.name @@ fst @@ List.hd cycle)
+(* we repeat the first element to make the cycle more apparent *)
+
+let explanation_submsg (id, unsafe_info) =
+  match unsafe_info with
+  | Unnamed -> assert false (* can't be part of a cycle. *)
+  | Unsafe {reason;loc;subid} ->
+      let print fmt =
+        let printer = Format.dprintf fmt (Ident.name id) (Ident.name subid) in
+        Location.mkloc printer loc in
+      match reason with
+      | Unsafe_module_binding ->
+          print "Module %s defines an unsafe module, %s ."
+      | Unsafe_functor -> print "Module %s defines an unsafe functor, %s ."
+      | Unsafe_typext ->
+          print "Module %s defines an unsafe extension constructor, %s ."
+      | Unsafe_non_function -> print "Module %s defines an unsafe value, %s ."
+
+let report_error loc = function
+  | Circular_dependency cycle ->
+      let[@manual.ref "s:recursive-modules"] chapter, section = 8, 2 in
+      Location.errorf ~loc ~sub:(List.map explanation_submsg cycle)
+        "Cannot safely evaluate the definition of the following cycle@ \
+         of recursively-defined modules:@ %a.@ \
+         There are no safe modules in this cycle@ (see manual section %d.%d)."
+        print_cycle cycle chapter section
+  | Conflicting_inline_attributes ->
+      Location.errorf "@[Conflicting 'inline' attributes@]"
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (loc, err) -> Some (report_error loc err)
+      | _ ->
+        None
+    )
+
+let reset () =
+  primitive_declarations := [];
+  transl_store_subst := Ident.Map.empty;
+  aliased_idents := Ident.empty;
+  Env.reset_required_globals ();
+  Translprim.clear_used_primitives ()
diff --git a/lambda/translmod.mli b/lambda/translmod.mli
new file mode 100644
index 00000000..af042d6a
--- /dev/null
+++ b/lambda/translmod.mli
@@ -0,0 +1,63 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Translation from typed abstract syntax to lambda terms,
+   for the module language *)
+
+open Typedtree
+open Lambda
+
+val transl_implementation:
+      string -> structure * module_coercion -> Lambda.program
+val transl_store_phrases: string -> structure -> int * lambda
+val transl_store_implementation:
+      string -> structure * module_coercion -> Lambda.program
+
+val transl_implementation_flambda:
+  string -> structure * module_coercion -> Lambda.program
+
+val transl_toplevel_definition: structure -> lambda
+val transl_package:
+      Ident.t option list -> Ident.t -> module_coercion -> lambda
+val transl_store_package:
+      Ident.t option list -> Ident.t -> module_coercion -> int * lambda
+
+val transl_package_flambda:
+      Ident.t option list -> module_coercion -> int * lambda
+
+val toplevel_name: Ident.t -> string
+val nat_toplevel_name: Ident.t -> Ident.t * int
+
+val primitive_declarations: Primitive.description list ref
+
+type unsafe_component =
+  | Unsafe_module_binding
+  | Unsafe_functor
+  | Unsafe_non_function
+  | Unsafe_typext
+
+type unsafe_info =
+  | Unsafe of { reason:unsafe_component; loc:Location.t; subid:Ident.t }
+  | Unnamed
+
+type error =
+  Circular_dependency of (Ident.t * unsafe_info) list
+| Conflicting_inline_attributes
+
+exception Error of Location.t * error
+
+val report_error: Location.t -> error -> Location.error
+
+val reset: unit -> unit
diff --git a/lambda/translobj.ml b/lambda/translobj.ml
new file mode 100644
index 00000000..d7f11bea
--- /dev/null
+++ b/lambda/translobj.ml
@@ -0,0 +1,199 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Asttypes
+open Lambda
+
+(* Get oo primitives identifiers *)
+
+let oo_prim = Lambda.transl_prim "CamlinternalOO"
+
+(* Share blocks *)
+
+let consts : (structured_constant, Ident.t) Hashtbl.t = Hashtbl.create 17
+
+let share c =
+  match c with
+    Const_block (_n, l) when l <> [] ->
+      begin try
+        Lvar (Hashtbl.find consts c)
+      with Not_found ->
+        let id = Ident.create_local "shared" in
+        Hashtbl.add consts c id;
+        Lvar id
+      end
+  | _ -> Lconst c
+
+(* Collect labels *)
+
+let cache_required = ref false
+let method_cache = ref lambda_unit
+let method_count = ref 0
+let method_table = ref []
+
+let meth_tag s = Lconst(Const_base(Const_int(Btype.hash_variant s)))
+
+let next_cache tag =
+  let n = !method_count in
+  incr method_count;
+  (tag, [!method_cache; Lconst(Const_base(Const_int n))])
+
+let rec is_path = function
+    Lvar _ | Lprim (Pgetglobal _, [], _) | Lconst _ -> true
+  | Lprim (Pfield _, [lam], _) -> is_path lam
+  | Lprim ((Parrayrefu _ | Parrayrefs _), [lam1; lam2], _) ->
+      is_path lam1 && is_path lam2
+  | _ -> false
+
+let meth obj lab =
+  let tag = meth_tag lab in
+  if not (!cache_required && !Clflags.native_code) then (tag, []) else
+  if not (is_path obj) then next_cache tag else
+  try
+    let r = List.assoc obj !method_table in
+    try
+      (tag, List.assoc tag !r)
+    with Not_found ->
+      let p = next_cache tag in
+      r := p :: !r;
+      p
+  with Not_found ->
+    let p = next_cache tag in
+    method_table := (obj, ref [p]) :: !method_table;
+    p
+
+let reset_labels () =
+  Hashtbl.clear consts;
+  method_count := 0;
+  method_table := []
+
+(* Insert labels *)
+
+let int n = Lconst (Const_base (Const_int n))
+
+let prim_makearray =
+  Primitive.simple ~name:"caml_make_vect" ~arity:2 ~alloc:true
+
+(* Also use it for required globals *)
+let transl_label_init_general f =
+  let expr, size = f () in
+  let expr =
+    Hashtbl.fold
+      (fun c id expr -> Llet(Alias, Pgenval, id, Lconst c, expr))
+      consts expr
+  in
+  (*let expr =
+    List.fold_right
+      (fun id expr -> Lsequence(Lprim(Pgetglobal id, [], Location.none), expr))
+      (Env.get_required_globals ()) expr
+  in
+  Env.reset_required_globals ();*)
+  reset_labels ();
+  expr, size
+
+let transl_label_init_flambda f =
+  assert(Config.flambda);
+  let method_cache_id = Ident.create_local "method_cache" in
+  method_cache := Lvar method_cache_id;
+  (* Calling f (usually Translmod.transl_struct) requires the
+     method_cache variable to be initialised to be able to generate
+     method accesses. *)
+  let expr, size = f () in
+  let expr =
+    if !method_count = 0 then expr
+    else
+      Llet (Strict, Pgenval, method_cache_id,
+        Lprim (Pccall prim_makearray,
+               [int !method_count; int 0],
+               Loc_unknown),
+        expr)
+  in
+  transl_label_init_general (fun () -> expr, size)
+
+let transl_store_label_init glob size f arg =
+  assert(not Config.flambda);
+  assert(!Clflags.native_code);
+  method_cache := Lprim(Pfield size,
+                        [Lprim(Pgetglobal glob, [], Loc_unknown)],
+                        Loc_unknown);
+  let expr = f arg in
+  let (size, expr) =
+    if !method_count = 0 then (size, expr) else
+    (size+1,
+     Lsequence(
+     Lprim(Psetfield(size, Pointer, Root_initialization),
+           [Lprim(Pgetglobal glob, [], Loc_unknown);
+            Lprim (Pccall prim_makearray,
+                   [int !method_count; int 0],
+                   Loc_unknown)],
+           Loc_unknown),
+     expr))
+  in
+  let lam, size = transl_label_init_general (fun () -> (expr, size)) in
+  size, lam
+
+let transl_label_init f =
+  if !Clflags.native_code then
+    transl_label_init_flambda f
+  else
+    transl_label_init_general f
+
+(* Share classes *)
+
+let wrapping = ref false
+let top_env = ref Env.empty
+let classes = ref []
+let method_ids = ref Ident.Set.empty
+
+let oo_add_class id =
+  classes := id :: !classes;
+  (!top_env, !cache_required)
+
+let oo_wrap env req f x =
+  if !wrapping then
+    if !cache_required then f x else
+      Misc.protect_refs [Misc.R (cache_required, true)] (fun () ->
+          f x
+        )
+  else
+    Misc.protect_refs [Misc.R (wrapping, true); Misc.R (top_env, env)]
+      (fun () ->
+         cache_required := req;
+         classes := [];
+         method_ids := Ident.Set.empty;
+         let lambda = f x in
+         let lambda =
+           List.fold_left
+             (fun lambda id ->
+                Llet(StrictOpt, Pgenval, id,
+                     Lprim(Pmakeblock(0, Mutable, None),
+                           [lambda_unit; lambda_unit; lambda_unit],
+                           Loc_unknown),
+                     lambda))
+             lambda !classes
+         in
+         lambda
+      )
+
+let reset () =
+  Hashtbl.clear consts;
+  cache_required := false;
+  method_cache := lambda_unit;
+  method_count := 0;
+  method_table := [];
+  wrapping := false;
+  top_env := Env.empty;
+  classes := [];
+  method_ids := Ident.Set.empty
diff --git a/lambda/translobj.mli b/lambda/translobj.mli
new file mode 100644
index 00000000..c27053e9
--- /dev/null
+++ b/lambda/translobj.mli
@@ -0,0 +1,33 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Lambda
+
+val oo_prim: string -> lambda
+
+val share: structured_constant -> lambda
+val meth: lambda -> string -> lambda * lambda list
+
+val reset_labels: unit -> unit
+val transl_label_init: (unit -> lambda * 'a) -> lambda * 'a
+val transl_store_label_init:
+    Ident.t -> int -> ('a -> lambda) -> 'a -> int * lambda
+
+val method_ids: Ident.Set.t ref (* reset when starting a new wrapper *)
+
+val oo_wrap: Env.t -> bool -> ('a -> lambda) -> 'a -> lambda
+val oo_add_class: Ident.t -> Env.t * bool
+
+val reset: unit -> unit
diff --git a/lambda/translprim.ml b/lambda/translprim.ml
new file mode 100644
index 00000000..f4cb200e
--- /dev/null
+++ b/lambda/translprim.ml
@@ -0,0 +1,823 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Translation of primitives *)
+
+open Misc
+open Asttypes
+open Primitive
+open Types
+open Typedtree
+open Typeopt
+open Lambda
+open Debuginfo.Scoped_location
+
+type error =
+  | Unknown_builtin_primitive of string
+  | Wrong_arity_builtin_primitive of string
+
+exception Error of Location.t * error
+
+(* Insertion of debugging events *)
+
+let event_before loc exp lam = match lam with
+| Lstaticraise (_,_) -> lam
+| _ ->
+  if !Clflags.debug && not !Clflags.native_code
+  then Levent(lam, {lev_loc = loc;
+                    lev_kind = Lev_before;
+                    lev_repr = None;
+                    lev_env = exp.exp_env})
+  else lam
+
+let event_after loc exp lam =
+  if !Clflags.debug && not !Clflags.native_code
+  then Levent(lam, {lev_loc = loc;
+                    lev_kind = Lev_after exp.exp_type;
+                    lev_repr = None;
+                    lev_env = exp.exp_env})
+  else lam
+
+type comparison =
+  | Equal
+  | Not_equal
+  | Less_equal
+  | Less_than
+  | Greater_equal
+  | Greater_than
+  | Compare
+
+type comparison_kind =
+  | Compare_generic
+  | Compare_ints
+  | Compare_floats
+  | Compare_strings
+  | Compare_bytes
+  | Compare_nativeints
+  | Compare_int32s
+  | Compare_int64s
+
+type loc_kind =
+  | Loc_FILE
+  | Loc_LINE
+  | Loc_MODULE
+  | Loc_LOC
+  | Loc_POS
+
+type prim =
+  | Primitive of Lambda.primitive * int
+  | External of Primitive.description
+  | Comparison of comparison * comparison_kind
+  | Raise of Lambda.raise_kind
+  | Raise_with_backtrace
+  | Lazy_force
+  | Loc of loc_kind
+  | Send
+  | Send_self
+  | Send_cache
+
+let used_primitives = Hashtbl.create 7
+let add_used_primitive loc env path =
+  match path with
+    Some (Path.Pdot _ as path) ->
+      let path = Env.normalize_path_prefix (Some loc) env path in
+      let unit = Path.head path in
+      if Ident.global unit && not (Hashtbl.mem used_primitives path)
+      then Hashtbl.add used_primitives path loc
+  | _ -> ()
+
+let clear_used_primitives () = Hashtbl.clear used_primitives
+let get_used_primitives () =
+  Hashtbl.fold (fun path _ acc -> path :: acc) used_primitives []
+
+let gen_array_kind =
+  if Config.flat_float_array then Pgenarray else Paddrarray
+
+let prim_sys_argv =
+  Primitive.simple ~name:"caml_sys_argv" ~arity:1 ~alloc:true
+
+let primitives_table =
+  create_hashtable 57 [
+    "%identity", Primitive (Pidentity, 1);
+    "%bytes_to_string", Primitive (Pbytes_to_string, 1);
+    "%bytes_of_string", Primitive (Pbytes_of_string, 1);
+    "%ignore", Primitive (Pignore, 1);
+    "%revapply", Primitive (Prevapply, 2);
+    "%apply", Primitive (Pdirapply, 2);
+    "%loc_LOC", Loc Loc_LOC;
+    "%loc_FILE", Loc Loc_FILE;
+    "%loc_LINE", Loc Loc_LINE;
+    "%loc_POS", Loc Loc_POS;
+    "%loc_MODULE", Loc Loc_MODULE;
+    "%field0", Primitive ((Pfield 0), 1);
+    "%field1", Primitive ((Pfield 1), 1);
+    "%setfield0", Primitive ((Psetfield(0, Pointer, Assignment)), 2);
+    "%makeblock", Primitive ((Pmakeblock(0, Immutable, None)), 1);
+    "%makemutable", Primitive ((Pmakeblock(0, Mutable, None)), 1);
+    "%raise", Raise Raise_regular;
+    "%reraise", Raise Raise_reraise;
+    "%raise_notrace", Raise Raise_notrace;
+    "%raise_with_backtrace", Raise_with_backtrace;
+    "%sequand", Primitive (Psequand, 2);
+    "%sequor", Primitive (Psequor, 2);
+    "%boolnot", Primitive (Pnot, 1);
+    "%big_endian", Primitive ((Pctconst Big_endian), 1);
+    "%backend_type", Primitive ((Pctconst Backend_type), 1);
+    "%word_size", Primitive ((Pctconst Word_size), 1);
+    "%int_size", Primitive ((Pctconst Int_size), 1);
+    "%max_wosize", Primitive ((Pctconst Max_wosize), 1);
+    "%ostype_unix", Primitive ((Pctconst Ostype_unix), 1);
+    "%ostype_win32", Primitive ((Pctconst Ostype_win32), 1);
+    "%ostype_cygwin", Primitive ((Pctconst Ostype_cygwin), 1);
+    "%negint", Primitive (Pnegint, 1);
+    "%succint", Primitive ((Poffsetint 1), 1);
+    "%predint", Primitive ((Poffsetint(-1)), 1);
+    "%addint", Primitive (Paddint, 2);
+    "%subint", Primitive (Psubint, 2);
+    "%mulint", Primitive (Pmulint, 2);
+    "%divint", Primitive ((Pdivint Safe), 2);
+    "%modint", Primitive ((Pmodint Safe), 2);
+    "%andint", Primitive (Pandint, 2);
+    "%orint", Primitive (Porint, 2);
+    "%xorint", Primitive (Pxorint, 2);
+    "%lslint", Primitive (Plslint, 2);
+    "%lsrint", Primitive (Plsrint, 2);
+    "%asrint", Primitive (Pasrint, 2);
+    "%eq", Primitive ((Pintcomp Ceq), 2);
+    "%noteq", Primitive ((Pintcomp Cne), 2);
+    "%ltint", Primitive ((Pintcomp Clt), 2);
+    "%leint", Primitive ((Pintcomp Cle), 2);
+    "%gtint", Primitive ((Pintcomp Cgt), 2);
+    "%geint", Primitive ((Pintcomp Cge), 2);
+    "%incr", Primitive ((Poffsetref(1)), 1);
+    "%decr", Primitive ((Poffsetref(-1)), 1);
+    "%intoffloat", Primitive (Pintoffloat, 1);
+    "%floatofint", Primitive (Pfloatofint, 1);
+    "%negfloat", Primitive (Pnegfloat, 1);
+    "%absfloat", Primitive (Pabsfloat, 1);
+    "%addfloat", Primitive (Paddfloat, 2);
+    "%subfloat", Primitive (Psubfloat, 2);
+    "%mulfloat", Primitive (Pmulfloat, 2);
+    "%divfloat", Primitive (Pdivfloat, 2);
+    "%eqfloat", Primitive ((Pfloatcomp CFeq), 2);
+    "%noteqfloat", Primitive ((Pfloatcomp CFneq), 2);
+    "%ltfloat", Primitive ((Pfloatcomp CFlt), 2);
+    "%lefloat", Primitive ((Pfloatcomp CFle), 2);
+    "%gtfloat", Primitive ((Pfloatcomp CFgt), 2);
+    "%gefloat", Primitive ((Pfloatcomp CFge), 2);
+    "%string_length", Primitive (Pstringlength, 1);
+    "%string_safe_get", Primitive (Pstringrefs, 2);
+    "%string_safe_set", Primitive (Pbytessets, 3);
+    "%string_unsafe_get", Primitive (Pstringrefu, 2);
+    "%string_unsafe_set", Primitive (Pbytessetu, 3);
+    "%bytes_length", Primitive (Pbyteslength, 1);
+    "%bytes_safe_get", Primitive (Pbytesrefs, 2);
+    "%bytes_safe_set", Primitive (Pbytessets, 3);
+    "%bytes_unsafe_get", Primitive (Pbytesrefu, 2);
+    "%bytes_unsafe_set", Primitive (Pbytessetu, 3);
+    "%array_length", Primitive ((Parraylength gen_array_kind), 1);
+    "%array_safe_get", Primitive ((Parrayrefs gen_array_kind), 2);
+    "%array_safe_set", Primitive ((Parraysets gen_array_kind), 3);
+    "%array_unsafe_get", Primitive ((Parrayrefu gen_array_kind), 2);
+    "%array_unsafe_set", Primitive ((Parraysetu gen_array_kind), 3);
+    "%obj_size", Primitive ((Parraylength gen_array_kind), 1);
+    "%obj_field", Primitive ((Parrayrefu gen_array_kind), 2);
+    "%obj_set_field", Primitive ((Parraysetu gen_array_kind), 3);
+    "%floatarray_length", Primitive ((Parraylength Pfloatarray), 1);
+    "%floatarray_safe_get", Primitive ((Parrayrefs Pfloatarray), 2);
+    "%floatarray_safe_set", Primitive ((Parraysets Pfloatarray), 3);
+    "%floatarray_unsafe_get", Primitive ((Parrayrefu Pfloatarray), 2);
+    "%floatarray_unsafe_set", Primitive ((Parraysetu Pfloatarray), 3);
+    "%obj_is_int", Primitive (Pisint, 1);
+    "%lazy_force", Lazy_force;
+    "%nativeint_of_int", Primitive ((Pbintofint Pnativeint), 1);
+    "%nativeint_to_int", Primitive ((Pintofbint Pnativeint), 1);
+    "%nativeint_neg", Primitive ((Pnegbint Pnativeint), 1);
+    "%nativeint_add", Primitive ((Paddbint Pnativeint), 2);
+    "%nativeint_sub", Primitive ((Psubbint Pnativeint), 2);
+    "%nativeint_mul", Primitive ((Pmulbint Pnativeint), 2);
+    "%nativeint_div",
+    Primitive ((Pdivbint { size = Pnativeint; is_safe = Safe }), 2);
+    "%nativeint_mod",
+    Primitive ((Pmodbint { size = Pnativeint; is_safe = Safe }), 2);
+    "%nativeint_and", Primitive ((Pandbint Pnativeint), 2);
+    "%nativeint_or", Primitive ( (Porbint Pnativeint), 2);
+    "%nativeint_xor", Primitive ((Pxorbint Pnativeint), 2);
+    "%nativeint_lsl", Primitive ((Plslbint Pnativeint), 2);
+    "%nativeint_lsr", Primitive ((Plsrbint Pnativeint), 2);
+    "%nativeint_asr", Primitive ((Pasrbint Pnativeint), 2);
+    "%int32_of_int", Primitive ((Pbintofint Pint32), 1);
+    "%int32_to_int", Primitive ((Pintofbint Pint32), 1);
+    "%int32_neg", Primitive ((Pnegbint Pint32), 1);
+    "%int32_add", Primitive ((Paddbint Pint32), 2);
+    "%int32_sub", Primitive ((Psubbint Pint32), 2);
+    "%int32_mul", Primitive ((Pmulbint Pint32), 2);
+    "%int32_div", Primitive ((Pdivbint { size = Pint32; is_safe = Safe }), 2);
+    "%int32_mod", Primitive ((Pmodbint { size = Pint32; is_safe = Safe }), 2);
+    "%int32_and", Primitive ((Pandbint Pint32), 2);
+    "%int32_or", Primitive ( (Porbint Pint32), 2);
+    "%int32_xor", Primitive ((Pxorbint Pint32), 2);
+    "%int32_lsl", Primitive ((Plslbint Pint32), 2);
+    "%int32_lsr", Primitive ((Plsrbint Pint32), 2);
+    "%int32_asr", Primitive ((Pasrbint Pint32), 2);
+    "%int64_of_int", Primitive ((Pbintofint Pint64), 1);
+    "%int64_to_int", Primitive ((Pintofbint Pint64), 1);
+    "%int64_neg", Primitive ((Pnegbint Pint64), 1);
+    "%int64_add", Primitive ((Paddbint Pint64), 2);
+    "%int64_sub", Primitive ((Psubbint Pint64), 2);
+    "%int64_mul", Primitive ((Pmulbint Pint64), 2);
+    "%int64_div", Primitive ((Pdivbint { size = Pint64; is_safe = Safe }), 2);
+    "%int64_mod", Primitive ((Pmodbint { size = Pint64; is_safe = Safe }), 2);
+    "%int64_and", Primitive ((Pandbint Pint64), 2);
+    "%int64_or", Primitive ( (Porbint Pint64), 2);
+    "%int64_xor", Primitive ((Pxorbint Pint64), 2);
+    "%int64_lsl", Primitive ((Plslbint Pint64), 2);
+    "%int64_lsr", Primitive ((Plsrbint Pint64), 2);
+    "%int64_asr", Primitive ((Pasrbint Pint64), 2);
+    "%nativeint_of_int32", Primitive ((Pcvtbint(Pint32, Pnativeint)), 1);
+    "%nativeint_to_int32", Primitive ((Pcvtbint(Pnativeint, Pint32)), 1);
+    "%int64_of_int32", Primitive ((Pcvtbint(Pint32, Pint64)), 1);
+    "%int64_to_int32", Primitive ((Pcvtbint(Pint64, Pint32)), 1);
+    "%int64_of_nativeint", Primitive ((Pcvtbint(Pnativeint, Pint64)), 1);
+    "%int64_to_nativeint", Primitive ((Pcvtbint(Pint64, Pnativeint)), 1);
+    "%caml_ba_ref_1",
+    Primitive
+      ((Pbigarrayref(false, 1, Pbigarray_unknown, Pbigarray_unknown_layout)),
+       2);
+    "%caml_ba_ref_2",
+    Primitive
+      ((Pbigarrayref(false, 2, Pbigarray_unknown, Pbigarray_unknown_layout)),
+       3);
+    "%caml_ba_ref_3",
+    Primitive
+      ((Pbigarrayref(false, 3, Pbigarray_unknown, Pbigarray_unknown_layout)),
+       4);
+    "%caml_ba_set_1",
+    Primitive
+      ((Pbigarrayset(false, 1, Pbigarray_unknown, Pbigarray_unknown_layout)),
+       3);
+    "%caml_ba_set_2",
+    Primitive
+      ((Pbigarrayset(false, 2, Pbigarray_unknown, Pbigarray_unknown_layout)),
+       4);
+    "%caml_ba_set_3",
+    Primitive
+      ((Pbigarrayset(false, 3, Pbigarray_unknown, Pbigarray_unknown_layout)),
+       5);
+    "%caml_ba_unsafe_ref_1",
+    Primitive
+      ((Pbigarrayref(true, 1, Pbigarray_unknown, Pbigarray_unknown_layout)),
+       2);
+    "%caml_ba_unsafe_ref_2",
+    Primitive
+      ((Pbigarrayref(true, 2, Pbigarray_unknown, Pbigarray_unknown_layout)),
+       3);
+    "%caml_ba_unsafe_ref_3",
+    Primitive
+      ((Pbigarrayref(true, 3, Pbigarray_unknown, Pbigarray_unknown_layout)),
+       4);
+    "%caml_ba_unsafe_set_1",
+    Primitive
+      ((Pbigarrayset(true, 1, Pbigarray_unknown, Pbigarray_unknown_layout)),
+       3);
+    "%caml_ba_unsafe_set_2",
+    Primitive
+      ((Pbigarrayset(true, 2, Pbigarray_unknown, Pbigarray_unknown_layout)),
+       4);
+    "%caml_ba_unsafe_set_3",
+    Primitive
+      ((Pbigarrayset(true, 3, Pbigarray_unknown, Pbigarray_unknown_layout)),
+       5);
+    "%caml_ba_dim_1", Primitive ((Pbigarraydim(1)), 1);
+    "%caml_ba_dim_2", Primitive ((Pbigarraydim(2)), 1);
+    "%caml_ba_dim_3", Primitive ((Pbigarraydim(3)), 1);
+    "%caml_string_get16", Primitive ((Pstring_load_16(false)), 2);
+    "%caml_string_get16u", Primitive ((Pstring_load_16(true)), 2);
+    "%caml_string_get32", Primitive ((Pstring_load_32(false)), 2);
+    "%caml_string_get32u", Primitive ((Pstring_load_32(true)), 2);
+    "%caml_string_get64", Primitive ((Pstring_load_64(false)), 2);
+    "%caml_string_get64u", Primitive ((Pstring_load_64(true)), 2);
+    "%caml_string_set16", Primitive ((Pbytes_set_16(false)), 3);
+    "%caml_string_set16u", Primitive ((Pbytes_set_16(true)), 3);
+    "%caml_string_set32", Primitive ((Pbytes_set_32(false)), 3);
+    "%caml_string_set32u", Primitive ((Pbytes_set_32(true)), 3);
+    "%caml_string_set64", Primitive ((Pbytes_set_64(false)), 3);
+    "%caml_string_set64u", Primitive ((Pbytes_set_64(true)), 3);
+    "%caml_bytes_get16", Primitive ((Pbytes_load_16(false)), 2);
+    "%caml_bytes_get16u", Primitive ((Pbytes_load_16(true)), 2);
+    "%caml_bytes_get32", Primitive ((Pbytes_load_32(false)), 2);
+    "%caml_bytes_get32u", Primitive ((Pbytes_load_32(true)), 2);
+    "%caml_bytes_get64", Primitive ((Pbytes_load_64(false)), 2);
+    "%caml_bytes_get64u", Primitive ((Pbytes_load_64(true)), 2);
+    "%caml_bytes_set16", Primitive ((Pbytes_set_16(false)), 3);
+    "%caml_bytes_set16u", Primitive ((Pbytes_set_16(true)), 3);
+    "%caml_bytes_set32", Primitive ((Pbytes_set_32(false)), 3);
+    "%caml_bytes_set32u", Primitive ((Pbytes_set_32(true)), 3);
+    "%caml_bytes_set64", Primitive ((Pbytes_set_64(false)), 3);
+    "%caml_bytes_set64u", Primitive ((Pbytes_set_64(true)), 3);
+    "%caml_bigstring_get16", Primitive ((Pbigstring_load_16(false)), 2);
+    "%caml_bigstring_get16u", Primitive ((Pbigstring_load_16(true)), 2);
+    "%caml_bigstring_get32", Primitive ((Pbigstring_load_32(false)), 2);
+    "%caml_bigstring_get32u", Primitive ((Pbigstring_load_32(true)), 2);
+    "%caml_bigstring_get64", Primitive ((Pbigstring_load_64(false)), 2);
+    "%caml_bigstring_get64u", Primitive ((Pbigstring_load_64(true)), 2);
+    "%caml_bigstring_set16", Primitive ((Pbigstring_set_16(false)), 3);
+    "%caml_bigstring_set16u", Primitive ((Pbigstring_set_16(true)), 3);
+    "%caml_bigstring_set32", Primitive ((Pbigstring_set_32(false)), 3);
+    "%caml_bigstring_set32u", Primitive ((Pbigstring_set_32(true)), 3);
+    "%caml_bigstring_set64", Primitive ((Pbigstring_set_64(false)), 3);
+    "%caml_bigstring_set64u", Primitive ((Pbigstring_set_64(true)), 3);
+    "%bswap16", Primitive (Pbswap16, 1);
+    "%bswap_int32", Primitive ((Pbbswap(Pint32)), 1);
+    "%bswap_int64", Primitive ((Pbbswap(Pint64)), 1);
+    "%bswap_native", Primitive ((Pbbswap(Pnativeint)), 1);
+    "%int_as_pointer", Primitive (Pint_as_pointer, 1);
+    "%opaque", Primitive (Popaque, 1);
+    "%sys_argv", External prim_sys_argv;
+    "%send", Send;
+    "%sendself", Send_self;
+    "%sendcache", Send_cache;
+    "%equal", Comparison(Equal, Compare_generic);
+    "%notequal", Comparison(Not_equal, Compare_generic);
+    "%lessequal", Comparison(Less_equal, Compare_generic);
+    "%lessthan", Comparison(Less_than, Compare_generic);
+    "%greaterequal", Comparison(Greater_equal, Compare_generic);
+    "%greaterthan", Comparison(Greater_than, Compare_generic);
+    "%compare", Comparison(Compare, Compare_generic);
+  ]
+
+
+let lookup_primitive loc p =
+  match Hashtbl.find primitives_table p.prim_name with
+  | prim -> prim
+  | exception Not_found ->
+      if String.length p.prim_name > 0 && p.prim_name.[0] = '%' then
+        raise(Error(loc, Unknown_builtin_primitive p.prim_name));
+      External p
+
+let lookup_primitive_and_mark_used loc p env path =
+  match lookup_primitive loc p with
+  | External _ as e -> add_used_primitive loc env path; e
+  | x -> x
+
+let simplify_constant_constructor = function
+  | Equal -> true
+  | Not_equal -> true
+  | Less_equal -> false
+  | Less_than -> false
+  | Greater_equal -> false
+  | Greater_than -> false
+  | Compare -> false
+
+(* The following function computes the greatest lower bound in the
+   semilattice of array kinds:
+          gen
+         /   \
+      addr   float
+       |
+      int
+   Note that the GLB is not guaranteed to exist, in which case we return
+   our first argument instead of raising a fatal error because, although
+   it cannot happen in a well-typed program, (ab)use of Obj.magic can
+   probably trigger it.
+*)
+let glb_array_type t1 t2 =
+  match t1, t2 with
+  | Pfloatarray, (Paddrarray | Pintarray)
+  | (Paddrarray | Pintarray), Pfloatarray -> t1
+
+  | Pgenarray, x | x, Pgenarray -> x
+  | Paddrarray, x | x, Paddrarray -> x
+  | Pintarray, Pintarray -> Pintarray
+  | Pfloatarray, Pfloatarray -> Pfloatarray
+
+(* Specialize a primitive from available type information. *)
+
+let specialize_primitive env ty ~has_constant_constructor prim =
+  let param_tys =
+    match is_function_type env ty with
+    | None -> []
+    | Some (p1, rhs) ->
+      match is_function_type env rhs with
+      | None -> [p1]
+      | Some (p2, _) -> [p1;p2]
+  in
+  match prim, param_tys with
+  | Primitive (Psetfield(n, Pointer, init), arity), [_; p2] -> begin
+      match maybe_pointer_type env p2 with
+      | Pointer -> None
+      | Immediate -> Some (Primitive (Psetfield(n, Immediate, init), arity))
+    end
+  | Primitive (Parraylength t, arity), [p] -> begin
+      let array_type = glb_array_type t (array_type_kind env p) in
+      if t = array_type then None
+      else Some (Primitive (Parraylength array_type, arity))
+    end
+  | Primitive (Parrayrefu t, arity), p1 :: _ -> begin
+      let array_type = glb_array_type t (array_type_kind env p1) in
+      if t = array_type then None
+      else Some (Primitive (Parrayrefu array_type, arity))
+    end
+  | Primitive (Parraysetu t, arity), p1 :: _ -> begin
+      let array_type = glb_array_type t (array_type_kind env p1) in
+      if t = array_type then None
+      else Some (Primitive (Parraysetu array_type, arity))
+    end
+  | Primitive (Parrayrefs t, arity), p1 :: _ -> begin
+      let array_type = glb_array_type t (array_type_kind env p1) in
+      if t = array_type then None
+      else Some (Primitive (Parrayrefs array_type, arity))
+    end
+  | Primitive (Parraysets t, arity), p1 :: _ -> begin
+      let array_type = glb_array_type t (array_type_kind env p1) in
+      if t = array_type then None
+      else Some (Primitive (Parraysets array_type, arity))
+    end
+  | Primitive (Pbigarrayref(unsafe, n, Pbigarray_unknown,
+                            Pbigarray_unknown_layout), arity), p1 :: _ -> begin
+      let (k, l) = bigarray_type_kind_and_layout env p1 in
+      match k, l with
+      | Pbigarray_unknown, Pbigarray_unknown_layout -> None
+      | _, _ -> Some (Primitive (Pbigarrayref(unsafe, n, k, l), arity))
+    end
+  | Primitive (Pbigarrayset(unsafe, n, Pbigarray_unknown,
+                            Pbigarray_unknown_layout), arity), p1 :: _ -> begin
+      let (k, l) = bigarray_type_kind_and_layout env p1 in
+      match k, l with
+      | Pbigarray_unknown, Pbigarray_unknown_layout -> None
+      | _, _ -> Some (Primitive (Pbigarrayset(unsafe, n, k, l), arity))
+    end
+  | Primitive (Pmakeblock(tag, mut, None), arity), fields -> begin
+      let shape = List.map (Typeopt.value_kind env) fields in
+      let useful = List.exists (fun knd -> knd <> Pgenval) shape in
+      if useful then Some (Primitive (Pmakeblock(tag, mut, Some shape), arity))
+      else None
+    end
+  | Comparison(comp, Compare_generic), p1 :: _ ->
+    if (has_constant_constructor
+        && simplify_constant_constructor comp) then begin
+      Some (Comparison(comp, Compare_ints))
+    end else if (is_base_type env p1 Predef.path_int
+        || is_base_type env p1 Predef.path_char
+        || (maybe_pointer_type env p1 = Immediate)) then begin
+      Some (Comparison(comp, Compare_ints))
+    end else if is_base_type env p1 Predef.path_float then begin
+      Some (Comparison(comp, Compare_floats))
+    end else if is_base_type env p1 Predef.path_string then begin
+      Some (Comparison(comp, Compare_strings))
+    end else if is_base_type env p1 Predef.path_bytes then begin
+      Some (Comparison(comp, Compare_bytes))
+    end else if is_base_type env p1 Predef.path_nativeint then begin
+      Some (Comparison(comp, Compare_nativeints))
+    end else if is_base_type env p1 Predef.path_int32 then begin
+      Some (Comparison(comp, Compare_int32s))
+    end else if is_base_type env p1 Predef.path_int64 then begin
+      Some (Comparison(comp, Compare_int64s))
+    end else begin
+      None
+    end
+  | _ -> None
+
+let caml_equal =
+  Primitive.simple ~name:"caml_equal" ~arity:2 ~alloc:true
+let caml_string_equal =
+  Primitive.simple ~name:"caml_string_equal" ~arity:2 ~alloc:false
+let caml_bytes_equal =
+  Primitive.simple ~name:"caml_bytes_equal" ~arity:2 ~alloc:false
+let caml_notequal =
+  Primitive.simple ~name:"caml_notequal" ~arity:2 ~alloc:true
+let caml_string_notequal =
+  Primitive.simple ~name:"caml_string_notequal" ~arity:2 ~alloc:false
+let caml_bytes_notequal =
+  Primitive.simple ~name:"caml_bytes_notequal" ~arity:2 ~alloc:false
+let caml_lessequal =
+  Primitive.simple ~name:"caml_lessequal" ~arity:2 ~alloc:true
+let caml_string_lessequal =
+  Primitive.simple ~name:"caml_string_lessequal" ~arity:2 ~alloc:false
+let caml_bytes_lessequal =
+  Primitive.simple ~name:"caml_bytes_lessequal" ~arity:2 ~alloc:false
+let caml_lessthan =
+  Primitive.simple ~name:"caml_lessthan" ~arity:2 ~alloc:true
+let caml_string_lessthan =
+  Primitive.simple ~name:"caml_string_lessthan" ~arity:2 ~alloc:false
+let caml_bytes_lessthan =
+  Primitive.simple ~name:"caml_bytes_lessthan" ~arity:2 ~alloc:false
+let caml_greaterequal =
+  Primitive.simple ~name:"caml_greaterequal" ~arity:2 ~alloc:true
+let caml_string_greaterequal =
+  Primitive.simple ~name:"caml_string_greaterequal" ~arity:2 ~alloc:false
+let caml_bytes_greaterequal =
+  Primitive.simple ~name:"caml_bytes_greaterequal" ~arity:2 ~alloc:false
+let caml_greaterthan =
+  Primitive.simple ~name:"caml_greaterthan" ~arity:2 ~alloc:true
+let caml_string_greaterthan =
+  Primitive.simple ~name:"caml_string_greaterthan" ~arity:2 ~alloc: false
+let caml_bytes_greaterthan =
+  Primitive.simple ~name:"caml_bytes_greaterthan" ~arity:2 ~alloc: false
+let caml_compare =
+  Primitive.simple ~name:"caml_compare" ~arity:2 ~alloc:true
+let caml_string_compare =
+  Primitive.simple ~name:"caml_string_compare" ~arity:2 ~alloc:false
+let caml_bytes_compare =
+  Primitive.simple ~name:"caml_bytes_compare" ~arity:2 ~alloc:false
+
+let comparison_primitive comparison comparison_kind =
+  match comparison, comparison_kind with
+  | Equal, Compare_generic -> Pccall caml_equal
+  | Equal, Compare_ints -> Pintcomp Ceq
+  | Equal, Compare_floats -> Pfloatcomp CFeq
+  | Equal, Compare_strings -> Pccall caml_string_equal
+  | Equal, Compare_bytes -> Pccall caml_bytes_equal
+  | Equal, Compare_nativeints -> Pbintcomp(Pnativeint, Ceq)
+  | Equal, Compare_int32s -> Pbintcomp(Pint32, Ceq)
+  | Equal, Compare_int64s -> Pbintcomp(Pint64, Ceq)
+  | Not_equal, Compare_generic -> Pccall caml_notequal
+  | Not_equal, Compare_ints -> Pintcomp Cne
+  | Not_equal, Compare_floats -> Pfloatcomp CFneq
+  | Not_equal, Compare_strings -> Pccall caml_string_notequal
+  | Not_equal, Compare_bytes -> Pccall caml_bytes_notequal
+  | Not_equal, Compare_nativeints -> Pbintcomp(Pnativeint, Cne)
+  | Not_equal, Compare_int32s -> Pbintcomp(Pint32, Cne)
+  | Not_equal, Compare_int64s -> Pbintcomp(Pint64, Cne)
+  | Less_equal, Compare_generic -> Pccall caml_lessequal
+  | Less_equal, Compare_ints -> Pintcomp Cle
+  | Less_equal, Compare_floats -> Pfloatcomp CFle
+  | Less_equal, Compare_strings -> Pccall caml_string_lessequal
+  | Less_equal, Compare_bytes -> Pccall caml_bytes_lessequal
+  | Less_equal, Compare_nativeints -> Pbintcomp(Pnativeint, Cle)
+  | Less_equal, Compare_int32s -> Pbintcomp(Pint32, Cle)
+  | Less_equal, Compare_int64s -> Pbintcomp(Pint64, Cle)
+  | Less_than, Compare_generic -> Pccall caml_lessthan
+  | Less_than, Compare_ints -> Pintcomp Clt
+  | Less_than, Compare_floats -> Pfloatcomp CFlt
+  | Less_than, Compare_strings -> Pccall caml_string_lessthan
+  | Less_than, Compare_bytes -> Pccall caml_bytes_lessthan
+  | Less_than, Compare_nativeints -> Pbintcomp(Pnativeint, Clt)
+  | Less_than, Compare_int32s -> Pbintcomp(Pint32, Clt)
+  | Less_than, Compare_int64s -> Pbintcomp(Pint64, Clt)
+  | Greater_equal, Compare_generic -> Pccall caml_greaterequal
+  | Greater_equal, Compare_ints -> Pintcomp Cge
+  | Greater_equal, Compare_floats -> Pfloatcomp CFge
+  | Greater_equal, Compare_strings -> Pccall caml_string_greaterequal
+  | Greater_equal, Compare_bytes -> Pccall caml_bytes_greaterequal
+  | Greater_equal, Compare_nativeints -> Pbintcomp(Pnativeint, Cge)
+  | Greater_equal, Compare_int32s -> Pbintcomp(Pint32, Cge)
+  | Greater_equal, Compare_int64s -> Pbintcomp(Pint64, Cge)
+  | Greater_than, Compare_generic -> Pccall caml_greaterthan
+  | Greater_than, Compare_ints -> Pintcomp Cgt
+  | Greater_than, Compare_floats -> Pfloatcomp CFgt
+  | Greater_than, Compare_strings -> Pccall caml_string_greaterthan
+  | Greater_than, Compare_bytes -> Pccall caml_bytes_greaterthan
+  | Greater_than, Compare_nativeints -> Pbintcomp(Pnativeint, Cgt)
+  | Greater_than, Compare_int32s -> Pbintcomp(Pint32, Cgt)
+  | Greater_than, Compare_int64s -> Pbintcomp(Pint64, Cgt)
+  | Compare, Compare_generic -> Pccall caml_compare
+  | Compare, Compare_ints -> Pcompare_ints
+  | Compare, Compare_floats -> Pcompare_floats
+  | Compare, Compare_strings -> Pccall caml_string_compare
+  | Compare, Compare_bytes -> Pccall caml_bytes_compare
+  | Compare, Compare_nativeints -> Pcompare_bints Pnativeint
+  | Compare, Compare_int32s -> Pcompare_bints Pint32
+  | Compare, Compare_int64s -> Pcompare_bints Pint64
+
+let lambda_of_loc kind loc =
+  let loc = to_location loc in
+  let loc_start = loc.Location.loc_start in
+  let (file, lnum, cnum) = Location.get_pos_info loc_start in
+  let file =
+    if Filename.is_relative file then
+      file
+    else
+      Location.rewrite_absolute_path file in
+  let enum = loc.Location.loc_end.Lexing.pos_cnum -
+      loc_start.Lexing.pos_cnum + cnum in
+  match kind with
+  | Loc_POS ->
+    Lconst (Const_block (0, [
+          Const_immstring file;
+          Const_base (Const_int lnum);
+          Const_base (Const_int cnum);
+          Const_base (Const_int enum);
+        ]))
+  | Loc_FILE -> Lconst (Const_immstring file)
+  | Loc_MODULE ->
+    let filename = Filename.basename file in
+    let name = Env.get_unit_name () in
+    let module_name = if name = "" then "//"^filename^"//" else name in
+    Lconst (Const_immstring module_name)
+  | Loc_LOC ->
+    let loc = Printf.sprintf "File %S, line %d, characters %d-%d"
+        file lnum cnum enum in
+    Lconst (Const_immstring loc)
+  | Loc_LINE -> Lconst (Const_base (Const_int lnum))
+
+let caml_restore_raw_backtrace =
+  Primitive.simple ~name:"caml_restore_raw_backtrace" ~arity:2 ~alloc:false
+
+let try_ids = Hashtbl.create 8
+
+let add_exception_ident id =
+  Hashtbl.replace try_ids id ()
+
+let remove_exception_ident id =
+  Hashtbl.remove try_ids id
+
+let lambda_of_prim prim_name prim loc args arg_exps =
+  match prim, args with
+  | Primitive (prim, arity), args when arity = List.length args ->
+      Lprim(prim, args, loc)
+  | External prim, args when prim = prim_sys_argv ->
+      Lprim(Pccall prim, Lconst (Const_pointer 0) :: args, loc)
+  | External prim, args ->
+      Lprim(Pccall prim, args, loc)
+  | Comparison(comp, knd), ([_;_] as args) ->
+      let prim = comparison_primitive comp knd in
+      Lprim(prim, args, loc)
+  | Raise kind, [arg] ->
+      let kind =
+        match kind, arg with
+        | Raise_regular, Lvar argv when Hashtbl.mem try_ids argv ->
+            Raise_reraise
+        | _, _ ->
+            kind
+      in
+      let arg =
+        match arg_exps with
+        | None -> arg
+        | Some [arg_exp] -> event_after loc arg_exp arg
+        | Some _ -> assert false
+      in
+      Lprim(Praise kind, [arg], loc)
+  | Raise_with_backtrace, [exn; bt] ->
+      let vexn = Ident.create_local "exn" in
+      let raise_arg =
+        match arg_exps with
+        | None -> Lvar vexn
+        | Some [exn_exp; _] -> event_after loc exn_exp (Lvar vexn)
+        | Some _ -> assert false
+      in
+      Llet(Strict, Pgenval, vexn, exn,
+           Lsequence(Lprim(Pccall caml_restore_raw_backtrace,
+                           [Lvar vexn; bt],
+                           loc),
+                     Lprim(Praise Raise_reraise, [raise_arg], loc)))
+  | Lazy_force, [arg] ->
+      Matching.inline_lazy_force arg Loc_unknown
+  | Loc kind, [] ->
+      lambda_of_loc kind loc
+  | Loc kind, [arg] ->
+      let lam = lambda_of_loc kind loc in
+      Lprim(Pmakeblock(0, Immutable, None), [lam; arg], loc)
+  | Send, [obj; meth] ->
+      Lsend(Public, meth, obj, [], loc)
+  | Send_self, [obj; meth] ->
+      Lsend(Self, meth, obj, [], loc)
+  | Send_cache, [obj; meth; cache; pos] ->
+      Lsend(Cached, meth, obj, [cache; pos], loc)
+  | (Raise _ | Raise_with_backtrace
+    | Lazy_force | Loc _ | Primitive _ | Comparison _
+    | Send | Send_self | Send_cache), _ ->
+      raise(Error(to_location loc, Wrong_arity_builtin_primitive prim_name))
+
+let check_primitive_arity loc p =
+  let prim = lookup_primitive loc p in
+  let ok =
+    match prim with
+    | Primitive (_,arity) -> arity = p.prim_arity
+    | External _ -> true
+    | Comparison _ -> p.prim_arity = 2
+    | Raise _ -> p.prim_arity = 1
+    | Raise_with_backtrace -> p.prim_arity = 2
+    | Lazy_force -> p.prim_arity = 1
+    | Loc _ -> p.prim_arity = 1 || p.prim_arity = 0
+    | Send | Send_self -> p.prim_arity = 2
+    | Send_cache -> p.prim_arity = 4
+  in
+  if not ok then raise(Error(loc, Wrong_arity_builtin_primitive p.prim_name))
+
+(* Eta-expand a primitive *)
+
+let transl_primitive loc p env ty path =
+  let prim = lookup_primitive_and_mark_used (to_location loc) p env path in
+  let has_constant_constructor = false in
+  let prim =
+    match specialize_primitive env ty ~has_constant_constructor prim with
+    | None -> prim
+    | Some prim -> prim
+  in
+  let rec make_params n =
+    if n <= 0 then []
+    else (Ident.create_local "prim", Pgenval) :: make_params (n-1)
+  in
+  let params = make_params p.prim_arity in
+  let args = List.map (fun (id, _) -> Lvar id) params in
+  let body = lambda_of_prim p.prim_name prim loc args None in
+  match params with
+  | [] -> body
+  | _ ->
+      Lfunction{ kind = Curried;
+                 params;
+                 return = Pgenval;
+                 attr = default_stub_attribute;
+                 loc;
+                 body; }
+
+let lambda_primitive_needs_event_after = function
+  | Prevapply | Pdirapply (* PR#6920 *)
+  (* We add an event after any primitive resulting in a C call that
+     may raise an exception or allocate. These are places where we may
+     collect the call stack. *)
+  | Pduprecord _ | Pccall _ | Pfloatofint | Pnegfloat | Pabsfloat
+  | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat | Pstringrefs | Pbytesrefs
+  | Pbytessets | Pmakearray (Pgenarray, _) | Pduparray _
+  | Parrayrefu (Pgenarray | Pfloatarray) | Parraysetu (Pgenarray | Pfloatarray)
+  | Parrayrefs _ | Parraysets _ | Pbintofint _ | Pcvtbint _ | Pnegbint _
+  | Paddbint _ | Psubbint _ | Pmulbint _ | Pdivbint _ | Pmodbint _ | Pandbint _
+  | Porbint _ | Pxorbint _ | Plslbint _ | Plsrbint _ | Pasrbint _ | Pbintcomp _
+  | Pcompare_bints _
+  | Pbigarrayref _ | Pbigarrayset _ | Pbigarraydim _ | Pstring_load_16 _
+  | Pstring_load_32 _ | Pstring_load_64 _ | Pbytes_load_16 _ | Pbytes_load_32 _
+  | Pbytes_load_64 _ | Pbytes_set_16 _ | Pbytes_set_32 _ | Pbytes_set_64 _
+  | Pbigstring_load_16 _ | Pbigstring_load_32 _ | Pbigstring_load_64 _
+  | Pbigstring_set_16 _ | Pbigstring_set_32 _ | Pbigstring_set_64 _
+  | Pbbswap _ -> true
+
+  | Pidentity | Pbytes_to_string | Pbytes_of_string | Pignore | Psetglobal _
+  | Pgetglobal _ | Pmakeblock _ | Pfield _ | Pfield_computed | Psetfield _
+  | Psetfield_computed _ | Pfloatfield _ | Psetfloatfield _ | Praise _
+  | Psequor | Psequand | Pnot | Pnegint | Paddint | Psubint | Pmulint
+  | Pdivint _ | Pmodint _ | Pandint | Porint | Pxorint | Plslint | Plsrint
+  | Pasrint | Pintcomp _ | Poffsetint _ | Poffsetref _ | Pintoffloat
+  | Pcompare_ints | Pcompare_floats
+  | Pfloatcomp _ | Pstringlength | Pstringrefu | Pbyteslength | Pbytesrefu
+  | Pbytessetu | Pmakearray ((Pintarray | Paddrarray | Pfloatarray), _)
+  | Parraylength _ | Parrayrefu _ | Parraysetu _ | Pisint | Pisout
+  | Pintofbint _ | Pctconst _ | Pbswap16 | Pint_as_pointer | Popaque -> false
+
+(* Determine if a primitive should be surrounded by an "after" debug event *)
+let primitive_needs_event_after = function
+  | Primitive (prim,_) -> lambda_primitive_needs_event_after prim
+  | External _ -> true
+  | Comparison(comp, knd) ->
+      lambda_primitive_needs_event_after (comparison_primitive comp knd)
+  | Lazy_force | Send | Send_self | Send_cache -> true
+  | Raise _ | Raise_with_backtrace | Loc _ -> false
+
+let transl_primitive_application loc p env ty path exp args arg_exps =
+  let prim =
+    lookup_primitive_and_mark_used (to_location loc) p env (Some path) in
+  let has_constant_constructor =
+    match arg_exps with
+    | [_; {exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _)}]
+    | [{exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _)}; _]
+    | [_; {exp_desc = Texp_variant(_, None)}]
+    | [{exp_desc = Texp_variant(_, None)}; _] -> true
+    | _ -> false
+  in
+  let prim =
+    match specialize_primitive env ty ~has_constant_constructor prim with
+    | None -> prim
+    | Some prim -> prim
+  in
+  let lam = lambda_of_prim p.prim_name prim loc args (Some arg_exps) in
+  let lam =
+    if primitive_needs_event_after prim then begin
+      match exp with
+      | None -> lam
+      | Some exp -> event_after loc exp lam
+    end else begin
+      lam
+    end
+  in
+  lam
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+  | Unknown_builtin_primitive prim_name ->
+      fprintf ppf "Unknown builtin primitive \"%s\"" prim_name
+  | Wrong_arity_builtin_primitive prim_name ->
+      fprintf ppf "Wrong arity for builtin primitive \"%s\"" prim_name
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (loc, err) ->
+          Some (Location.error_of_printer ~loc report_error err)
+      | _ ->
+        None
+    )
diff --git a/lambda/translprim.mli b/lambda/translprim.mli
new file mode 100644
index 00000000..aa437014
--- /dev/null
+++ b/lambda/translprim.mli
@@ -0,0 +1,54 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Insertion of debugging events *)
+
+val event_before : Lambda.scoped_location -> Typedtree.expression
+                   -> Lambda.lambda -> Lambda.lambda
+
+val event_after : Lambda.scoped_location -> Typedtree.expression
+                  -> Lambda.lambda -> Lambda.lambda
+
+(* Translation of primitives *)
+
+val add_exception_ident : Ident.t -> unit
+val remove_exception_ident : Ident.t -> unit
+
+val clear_used_primitives : unit -> unit
+val get_used_primitives: unit -> Path.t list
+
+val check_primitive_arity :
+  Location.t -> Primitive.description -> unit
+
+val transl_primitive :
+  Lambda.scoped_location -> Primitive.description -> Env.t ->
+  Types.type_expr -> Path.t option -> Lambda.lambda
+
+val transl_primitive_application :
+  Lambda.scoped_location -> Primitive.description -> Env.t ->
+  Types.type_expr -> Path.t -> Typedtree.expression option ->
+  Lambda.lambda list -> Typedtree.expression list -> Lambda.lambda
+
+(* Errors *)
+
+type error =
+  | Unknown_builtin_primitive of string
+  | Wrong_arity_builtin_primitive of string
+
+exception Error of Location.t * error
+
+open Format
+
+val report_error : formatter -> error -> unit
diff --git a/lex/.depend b/lex/.depend
new file mode 100644
index 00000000..d6835394
--- /dev/null
+++ b/lex/.depend
@@ -0,0 +1,118 @@
+common.cmo : \
+    syntax.cmi \
+    lexgen.cmi \
+    common.cmi
+common.cmx : \
+    syntax.cmx \
+    lexgen.cmx \
+    common.cmi
+common.cmi : \
+    syntax.cmi \
+    lexgen.cmi
+compact.cmo : \
+    table.cmi \
+    lexgen.cmi \
+    compact.cmi
+compact.cmx : \
+    table.cmx \
+    lexgen.cmx \
+    compact.cmi
+compact.cmi : \
+    lexgen.cmi
+cset.cmo : \
+    cset.cmi
+cset.cmx : \
+    cset.cmi
+cset.cmi :
+lexer.cmo : \
+    syntax.cmi \
+    parser.cmi \
+    lexer.cmi
+lexer.cmx : \
+    syntax.cmx \
+    parser.cmx \
+    lexer.cmi
+lexer.cmi : \
+    parser.cmi
+lexgen.cmo : \
+    table.cmi \
+    syntax.cmi \
+    cset.cmi \
+    lexgen.cmi
+lexgen.cmx : \
+    table.cmx \
+    syntax.cmx \
+    cset.cmx \
+    lexgen.cmi
+lexgen.cmi : \
+    syntax.cmi
+main.cmo : \
+    syntax.cmi \
+    parser.cmi \
+    outputbis.cmi \
+    output.cmi \
+    lexgen.cmi \
+    lexer.cmi \
+    cset.cmi \
+    compact.cmi \
+    common.cmi
+main.cmx : \
+    syntax.cmx \
+    parser.cmx \
+    outputbis.cmx \
+    output.cmx \
+    lexgen.cmx \
+    lexer.cmx \
+    cset.cmx \
+    compact.cmx \
+    common.cmx
+output.cmo : \
+    lexgen.cmi \
+    compact.cmi \
+    common.cmi \
+    output.cmi
+output.cmx : \
+    lexgen.cmx \
+    compact.cmx \
+    common.cmx \
+    output.cmi
+output.cmi : \
+    syntax.cmi \
+    lexgen.cmi \
+    compact.cmi \
+    common.cmi
+outputbis.cmo : \
+    lexgen.cmi \
+    common.cmi \
+    outputbis.cmi
+outputbis.cmx : \
+    lexgen.cmx \
+    common.cmx \
+    outputbis.cmi
+outputbis.cmi : \
+    syntax.cmi \
+    lexgen.cmi \
+    common.cmi
+parser.cmo : \
+    syntax.cmi \
+    cset.cmi \
+    parser.cmi
+parser.cmx : \
+    syntax.cmx \
+    cset.cmx \
+    parser.cmi
+parser.cmi : \
+    syntax.cmi
+syntax.cmo : \
+    cset.cmi \
+    syntax.cmi
+syntax.cmx : \
+    cset.cmx \
+    syntax.cmi
+syntax.cmi : \
+    cset.cmi
+table.cmo : \
+    table.cmi
+table.cmx : \
+    table.cmi
+table.cmi :
diff --git a/lex/Makefile b/lex/Makefile
new file mode 100644
index 00000000..5ee94e66
--- /dev/null
+++ b/lex/Makefile
@@ -0,0 +1,86 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# The lexer generator
+
+ROOTDIR = ..
+
+-include $(ROOTDIR)/Makefile.config
+-include $(ROOTDIR)/Makefile.common
+
+CAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc
+
+CAMLC = $(BOOT_OCAMLC) -strict-sequence -nostdlib \
+        -I $(ROOTDIR)/boot -use-prims $(ROOTDIR)/runtime/primitives
+CAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
+COMPFLAGS = -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
+            -safe-string -strict-sequence -strict-formats -bin-annot
+LINKFLAGS =
+YACCFLAGS = -v
+CAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex
+CAMLDEP = $(BOOT_OCAMLC) -depend
+DEPFLAGS = -slash
+DEPINCLUDES =
+
+OBJS=cset.cmo syntax.cmo parser.cmo lexer.cmo table.cmo lexgen.cmo \
+     compact.cmo common.cmo output.cmo outputbis.cmo main.cmo
+
+.PHONY: all allopt opt.opt # allopt and opt.opt are synonyms
+all: ocamllex
+allopt: ocamllex.opt
+opt.opt: allopt
+
+ocamllex: $(OBJS)
+	$(CAMLC) $(LINKFLAGS) -compat-32 -o ocamllex $(OBJS)
+
+ocamllex.opt: $(OBJS:.cmo=.cmx)
+	$(CAMLOPT_CMD) -o ocamllex.opt $(OBJS:.cmo=.cmx)
+
+clean::
+	rm -f ocamllex ocamllex.opt
+	rm -f *.cmo *.cmi *.cmx *.cmt *.cmti *.o *.obj
+
+parser.ml parser.mli: parser.mly
+	$(CAMLYACC) $(YACCFLAGS) parser.mly
+
+clean::
+	rm -f parser.ml parser.mli parser.output
+
+beforedepend:: parser.ml parser.mli
+
+lexer.ml: lexer.mll
+	$(CAMLLEX) $(OCAMLLEX_FLAGS) $<
+
+clean::
+	rm -f lexer.ml
+
+beforedepend:: lexer.ml
+
+.SUFFIXES:
+.SUFFIXES: .ml .cmo .mli .cmi .cmx
+
+.ml.cmo:
+	$(CAMLC) -c $(COMPFLAGS) $<
+
+.mli.cmi:
+	$(CAMLC) -c $(COMPFLAGS) $<
+
+.ml.cmx:
+	$(CAMLOPT) -c $(COMPFLAGS) $<
+
+depend: beforedepend
+	$(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) *.mli *.ml > .depend
+
+include .depend
diff --git a/lex/common.ml b/lex/common.ml
new file mode 100644
index 00000000..82f74eda
--- /dev/null
+++ b/lex/common.ml
@@ -0,0 +1,174 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Luc Maranget, projet Moscova,                              *)
+(*                          INRIA Rocquencourt                            *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Printf
+open Syntax
+open Lexgen
+
+
+(* To copy the ML code fragments *)
+
+type line_tracker = {
+  file : string;
+  oc : out_channel;
+  ic : in_channel;
+  mutable cur_line : int;
+};;
+
+let open_tracker file oc = {
+  file = file;
+  oc = oc;
+  ic = open_in_bin file;
+  cur_line = 1;
+};;
+
+let close_tracker tr = close_in_noerr tr.ic;;
+
+let update_tracker tr =
+  fprintf tr.oc "\n";
+  flush tr.oc;
+  let cr_seen = ref false in
+  try while true do
+    match input_char tr.ic with
+    | '\010' when not !cr_seen -> tr.cur_line <- tr.cur_line + 1;
+    | '\013' -> cr_seen := true; tr.cur_line <- tr.cur_line + 1;
+    | _ -> cr_seen := false;
+  done with End_of_file ->
+  fprintf tr.oc "# %d \"%s\"\n" (tr.cur_line+1) tr.file;
+;;
+
+let copy_buffer = Bytes.create 1024
+
+let copy_chars_unix ic oc start stop =
+  let n = ref (stop - start) in
+  while !n > 0 do
+    let m = input ic copy_buffer 0 (min !n 1024) in
+    output oc copy_buffer 0 m;
+    n := !n - m
+  done
+
+let copy_chars_win32 ic oc start stop =
+  for _i = start to stop - 1 do
+    let c = input_char ic in
+    if c <> '\r' then output_char oc c
+  done
+
+let copy_chars =
+  match Sys.os_type with
+    "Win32" | "Cygwin" -> copy_chars_win32
+  | _       -> copy_chars_unix
+
+let copy_chunk ic oc trl loc add_parens =
+  if loc.start_pos < loc.end_pos || add_parens then begin
+    fprintf oc "# %d \"%s\"\n" loc.start_line loc.loc_file;
+    if add_parens then begin
+      for _i = 1 to loc.start_col - 1 do output_char oc ' ' done;
+      output_char oc '(';
+    end else begin
+      for _i = 1 to loc.start_col do output_char oc ' ' done;
+    end;
+    seek_in ic loc.start_pos;
+    copy_chars ic oc loc.start_pos loc.end_pos;
+    if add_parens then output_char oc ')';
+    update_tracker trl;
+  end
+
+(* Various memory actions *)
+
+let output_mem_access oc i = fprintf oc "lexbuf.Lexing.lex_mem.(%d)" i
+
+let output_memory_actions pref oc = function
+  | []  -> ()
+  | mvs ->
+      output_string oc "(* " ;
+  fprintf oc "L=%d " (List.length mvs) ;
+  List.iter
+    (fun mv -> match mv with
+    | Copy (tgt, src) ->
+        fprintf oc "[%d] <- [%d] ;" tgt src
+    | Set tgt ->
+        fprintf oc "[%d] <- p ; " tgt)
+    mvs ;
+  output_string oc " *)\n" ;
+  List.iter
+    (fun mv -> match mv with
+    | Copy (tgt, src) ->
+        fprintf oc
+          "%s%a <- %a ;\n"
+          pref output_mem_access tgt output_mem_access src
+    | Set tgt ->
+        fprintf oc "%s%a <- lexbuf.Lexing.lex_curr_pos ;\n"
+          pref output_mem_access tgt)
+    mvs
+
+let output_base_mem oc = function
+  | Mem i -> output_mem_access oc i
+  | Start -> fprintf oc "lexbuf.Lexing.lex_start_pos"
+  | End   -> fprintf oc  "lexbuf.Lexing.lex_curr_pos"
+
+let output_tag_access oc = function
+  | Sum (a,0) ->
+      output_base_mem oc a
+  | Sum (a,i) ->
+      fprintf oc "(%a + %d)" output_base_mem a i
+
+let output_env ic oc tr env =
+  let pref = ref "let" in
+  match env with
+  | [] -> ()
+  | _  ->
+      (* Probably, we are better with variables sorted
+         in apparition order *)
+      let env =
+        List.sort
+          (fun ((_,p1),_) ((_,p2),_) ->
+            Stdlib.compare p1.start_pos  p2.start_pos)
+          env in
+
+      List.iter
+        (fun ((_,pos),v) ->
+          fprintf oc "%s\n" !pref ;
+          copy_chunk ic oc tr pos false ;
+          begin match v with
+          | Ident_string (o,nstart,nend) ->
+              fprintf oc
+                "= Lexing.sub_lexeme%s lexbuf %a %a"
+                (if o then "_opt" else "")
+                output_tag_access nstart output_tag_access nend
+          | Ident_char (o,nstart) ->
+              fprintf oc
+                "= Lexing.sub_lexeme_char%s lexbuf %a"
+                (if o then "_opt" else "")
+                output_tag_access nstart
+          end ;
+          pref := "\nand")
+        env ;
+      fprintf oc " in\n"
+
+(* Output the user arguments *)
+let output_args oc args =
+  List.iter (fun x -> (output_string oc x; output_char oc ' ')) args
+
+let output_refill_handler ic oc oci = function
+  | None -> false
+  | Some location ->
+    output_string oc "let __ocaml_lex_refill : \
+                      (Lexing.lexbuf -> 'a) -> (Lexing.lexbuf -> 'a) =\n";
+    copy_chunk ic oc oci location true;
+    true
+
+(* quiet flag *)
+let quiet_mode = ref false;;
diff --git a/lex/common.mli b/lex/common.mli
new file mode 100644
index 00000000..f00b50d7
--- /dev/null
+++ b/lex/common.mli
@@ -0,0 +1,31 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          Damien Doligez, projet Moscova, INRIA Rocquencourt            *)
+(*                                                                        *)
+(*   Copyright 2002 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 line_tracker;;
+val open_tracker : string -> out_channel -> line_tracker
+val close_tracker : line_tracker -> unit
+val copy_chunk :
+  in_channel -> out_channel -> line_tracker -> Syntax.location -> bool -> unit
+val output_mem_access : out_channel -> int -> unit
+val output_memory_actions :
+  string -> out_channel -> Lexgen.memory_action list -> unit
+val output_env :
+    in_channel -> out_channel -> line_tracker ->
+      (Lexgen.ident * Lexgen.ident_info) list -> unit
+val output_args : out_channel -> string list -> unit
+val output_refill_handler :
+  in_channel -> out_channel -> line_tracker -> Syntax.location option -> bool
+
+val quiet_mode : bool ref;;
diff --git a/lex/compact.ml b/lex/compact.ml
new file mode 100644
index 00000000..14eda9f5
--- /dev/null
+++ b/lex/compact.ml
@@ -0,0 +1,232 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Compaction of an automata *)
+
+open Lexgen
+
+(* Code for memory actions  *)
+let code = Table.create 0
+
+(* instructions are 2 8-bits integers, a 0xff byte means return *)
+
+let emit_int i = Table.emit code i
+
+let ins_mem i c =  match i with
+  | Copy (dst, src) -> dst::src::c
+  | Set dst         -> dst::0xff::c
+
+
+let ins_tag i c = match i with
+  | SetTag (dst, src) -> dst::src::c
+  | EraseTag dst      -> dst::0xff::c
+
+
+let do_emit_code c =
+  let r = Table.size code in
+  List.iter emit_int c ;
+  emit_int 0xff ;
+  r
+
+let memory = Hashtbl.create 101
+
+let mem_emit_code c =
+  try Hashtbl.find memory c with
+  | Not_found ->
+      let r = do_emit_code c in
+      Hashtbl.add memory c r ;
+      r
+
+(* Code address 0 is the empty code (ie do nothing) *)
+let _ = mem_emit_code []
+
+let emit_tag_code c = mem_emit_code (List.fold_right ins_tag c [])
+and emit_mem_code c  =mem_emit_code (List.fold_right ins_mem c [])
+
+(*******************************************)
+(* Compact the transition and check arrays *)
+(*******************************************)
+
+
+(* Determine the integer occurring most frequently in an array *)
+
+let most_frequent_elt v =
+  let frequencies = Hashtbl.create 17 in
+  let max_freq = ref 0 in
+  let most_freq = ref (v.(0)) in
+  for i = 0 to Array.length v - 1 do
+    let e = v.(i) in
+    let r =
+      try
+        Hashtbl.find frequencies e
+      with Not_found ->
+        let r = ref 1 in Hashtbl.add frequencies e r; r in
+    incr r;
+    if !r > !max_freq then begin max_freq := !r; most_freq := e end
+  done;
+  !most_freq
+
+(* Transform an array into a list of (position, non-default element) *)
+
+let non_default_elements def v =
+  let rec nondef i =
+    if i >= Array.length v then [] else begin
+      let e = v.(i) in
+      if e = def then nondef(i+1) else (i, e) :: nondef(i+1)
+    end in
+  nondef 0
+
+
+type t_compact =
+ {mutable c_trans : int array ;
+  mutable c_check : int array ;
+  mutable c_last_used : int ; }
+
+let create_compact () =
+  { c_trans = Array.make 1024 0 ;
+    c_check = Array.make 1024 (-1) ;
+    c_last_used = 0 ; }
+
+let reset_compact c =
+  c.c_trans <- Array.make 1024 0 ;
+  c.c_check <- Array.make 1024 (-1) ;
+  c.c_last_used <- 0
+
+(* One compacted table for transitions, one other for memory actions *)
+let trans = create_compact ()
+and moves = create_compact ()
+
+
+let grow_compact c =
+  let old_trans = c.c_trans
+  and old_check = c.c_check in
+  let n = Array.length old_trans in
+  c.c_trans <- Array.make (2*n) 0;
+  Array.blit old_trans 0 c.c_trans 0 c.c_last_used;
+  c.c_check <- Array.make (2*n) (-1);
+  Array.blit old_check 0 c.c_check 0 c.c_last_used
+
+let do_pack state_num orig compact =
+  let default = most_frequent_elt orig in
+  let nondef = non_default_elements default orig in
+  let rec pack_from b =
+    while
+      b + 257 > Array.length compact.c_trans
+    do
+      grow_compact compact
+    done;
+    let rec try_pack = function
+      [] -> b
+    | (pos, _v) :: rem ->
+        if compact.c_check.(b + pos) = -1 then
+          try_pack rem
+        else pack_from (b+1) in
+    try_pack nondef in
+  let base = pack_from 0 in
+  List.iter
+    (fun (pos, v) ->
+      compact.c_trans.(base + pos) <- v;
+      compact.c_check.(base + pos) <- state_num)
+    nondef;
+  if base + 257 > compact.c_last_used then
+    compact.c_last_used <- base + 257;
+  (base, default)
+
+let pack_moves state_num move_t =
+  let move_v = Array.make 257 0
+  and move_m = Array.make 257 0 in
+  for i = 0 to 256 do
+    let act,c = move_t.(i) in
+    move_v.(i) <- (match act with Backtrack -> -1 | Goto n -> n) ;
+    move_m.(i) <- emit_mem_code c
+  done ;
+  let pk_trans = do_pack state_num move_v trans
+  and pk_moves = do_pack state_num move_m moves in
+  pk_trans, pk_moves
+
+
+(* Build the tables *)
+
+type lex_tables =
+  { tbl_base: int array;                 (* Perform / Shift *)
+    tbl_backtrk: int array;              (* No_remember / Remember *)
+    tbl_default: int array;              (* Default transition *)
+    tbl_trans: int array;                (* Transitions (compacted) *)
+    tbl_check: int array;                (* Check (compacted) *)
+(* code addresses are managed in a similar fashion as transitions *)
+    tbl_base_code : int array;           (* code ptr / base for Shift *)
+    tbl_backtrk_code : int array;        (* nothing / code when Remember *)
+(* moves to execute before transitions (compacted) *)
+    tbl_default_code : int array;
+    tbl_trans_code : int array;
+    tbl_check_code : int array;
+(* byte code itself *)
+    tbl_code: int array;}
+
+
+let compact_tables state_v =
+  let n = Array.length state_v in
+  let base = Array.make n 0
+  and backtrk = Array.make n (-1)
+  and default = Array.make n 0
+  and base_code = Array.make n 0
+  and backtrk_code = Array.make n 0
+  and default_code = Array.make n 0 in
+  for i = 0 to n - 1 do
+    match state_v.(i) with
+    | Perform (n,c) ->
+        base.(i) <- -(n+1) ;
+        base_code.(i) <- emit_tag_code c
+    | Shift(trans, move) ->
+        begin match trans with
+        | No_remember -> ()
+        | Remember (n,c) ->
+            backtrk.(i) <- n ;
+            backtrk_code.(i) <- emit_tag_code c
+        end;
+        let (b_trans, d_trans),(b_moves,d_moves) = pack_moves i move in
+        base.(i) <- b_trans; default.(i) <- d_trans ;
+        base_code.(i) <- b_moves; default_code.(i) <- d_moves ;
+  done;
+  let code = Table.trim code in
+  let tables =
+    if Array.length code > 1 then
+      { tbl_base = base;
+        tbl_backtrk = backtrk;
+        tbl_default = default;
+        tbl_trans = Array.sub trans.c_trans 0 trans.c_last_used;
+        tbl_check = Array.sub trans.c_check 0 trans.c_last_used;
+        tbl_base_code = base_code ;
+        tbl_backtrk_code = backtrk_code;
+        tbl_default_code = default_code;
+        tbl_trans_code = Array.sub moves.c_trans 0 moves.c_last_used;
+        tbl_check_code = Array.sub moves.c_check 0 moves.c_last_used;
+        tbl_code = code}
+    else (* when no memory moves, do not emit related tables *)
+       { tbl_base = base;
+        tbl_backtrk = backtrk;
+        tbl_default = default;
+        tbl_trans = Array.sub trans.c_trans 0 trans.c_last_used;
+        tbl_check = Array.sub trans.c_check 0 trans.c_last_used;
+        tbl_base_code = [||] ;
+        tbl_backtrk_code = [||];
+        tbl_default_code = [||];
+        tbl_trans_code = [||];
+        tbl_check_code = [||];
+        tbl_code = [||]}
+  in
+  reset_compact trans ;
+  reset_compact moves ;
+  tables
diff --git a/lex/compact.mli b/lex/compact.mli
new file mode 100644
index 00000000..936835eb
--- /dev/null
+++ b/lex/compact.mli
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Compaction of an automata *)
+type lex_tables =
+  { tbl_base: int array;                 (* Perform / Shift *)
+    tbl_backtrk: int array;              (* No_remember / Remember *)
+    tbl_default: int array;              (* Default transition *)
+    tbl_trans: int array;                (* Transitions (compacted) *)
+    tbl_check: int array;                (* Check (compacted) *)
+(* code addresses are managed in a similar fashion as transitions *)
+    tbl_base_code : int array;           (* code ptr / base for Shift *)
+    tbl_backtrk_code : int array;        (* nothing / code when Remember *)
+(* moves to execute before transitions (compacted) *)
+    tbl_default_code : int array;
+    tbl_trans_code : int array;
+    tbl_check_code : int array;
+(* byte code itself *)
+    tbl_code: int array;}
+
+
+val compact_tables: Lexgen.automata array -> lex_tables
diff --git a/lex/cset.ml b/lex/cset.ml
new file mode 100644
index 00000000..81515eae
--- /dev/null
+++ b/lex/cset.ml
@@ -0,0 +1,97 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Luc Maranget, Jerome Vouillon projet Cristal,              *)
+(*                          INRIA Rocquencourt                            *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+exception Bad
+
+type t = (int * int) list
+
+
+let empty = []
+let is_empty = function
+  | [] -> true
+  | _  -> false
+
+let singleton c = [c,c]
+
+let interval c1 c2 =
+  if c1 <= c2 then [c1,c2]
+  else [c2,c1]
+
+
+let rec union s1 s2 = match s1,s2 with
+| [],_ -> s2
+| _,[] -> s1
+| (c1,d1) as p1::r1, (c2,d2)::r2 ->
+    if c1 > c2 then
+      union s2 s1
+    else begin (* c1 <= c2 *)
+      if d1+1 < c2 then
+        p1::union r1 s2
+      else if d1 < d2 then
+        union ((c1,d2)::r2) r1
+      else
+        union s1 r2
+    end
+
+let rec inter l l' =  match l, l' with
+    _, [] -> []
+  | [], _ -> []
+  | (c1, c2)::r, (c1', c2')::r' ->
+      if c2 < c1' then
+        inter r l'
+      else if c2' < c1 then
+        inter l r'
+      else if c2 < c2' then
+        (max c1 c1', c2)::inter r l'
+      else
+        (max c1 c1', c2')::inter l r'
+
+let rec diff l l' =  match l, l' with
+    _, [] -> l
+  | [], _ -> []
+  | (c1, c2)::r, (c1', c2')::r' ->
+      if c2 < c1' then
+        (c1, c2)::diff r l'
+      else if c2' < c1 then
+        diff l r'
+      else
+        let r'' = if c2' < c2 then (c2' + 1, c2) :: r else r in
+        if c1 < c1' then
+          (c1, c1' - 1)::diff r'' r'
+        else
+          diff r'' r'
+
+
+let eof = singleton 256
+and all_chars = interval 0 255
+and all_chars_eof = interval 0 256
+
+let complement s = diff all_chars s
+
+let env_to_array env = match env with
+| []         -> assert false
+| (_,x)::rem ->
+    let res = Array.make 257 x in
+    List.iter
+      (fun (c,y) ->
+        List.iter
+          (fun (i,j) ->
+            for k=i to j do
+              res.(k) <- y
+            done)
+          c)
+      rem ;
+    res
diff --git a/lex/cset.mli b/lex/cset.mli
new file mode 100644
index 00000000..527d53d1
--- /dev/null
+++ b/lex/cset.mli
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Luc Maranget, Jerome Vouillon projet Cristal,              *)
+(*                          INRIA Rocquencourt                            *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Set of characters encoded as list of intervals *)
+
+type t
+
+val empty : t
+val is_empty : t -> bool
+val all_chars : t
+exception Bad
+
+val all_chars_eof : t
+val eof : t
+val singleton : int ->  t
+val interval : int -> int -> t
+val union : t -> t -> t
+val inter : t -> t -> t
+val diff : t -> t -> t
+val complement : t -> t
+val env_to_array : (t * 'a) list -> 'a array
diff --git a/lex/lexer.mli b/lex/lexer.mli
new file mode 100644
index 00000000..28d00eaa
--- /dev/null
+++ b/lex/lexer.mli
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+val main: Lexing.lexbuf -> Parser.token
+
+exception Lexical_error of string * string * int * int
+
+(*n
+val line_num: int ref
+val line_start_pos: int ref
+*)
diff --git a/lex/lexer.mll b/lex/lexer.mll
new file mode 100644
index 00000000..15dbd511
--- /dev/null
+++ b/lex/lexer.mll
@@ -0,0 +1,361 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The lexical analyzer for lexer definitions. Bootstrapped! *)
+
+{
+open Syntax
+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
+
+let reset_string_buffer () = Buffer.clear string_buff
+
+let store_string_char c = Buffer.add_char string_buff c
+let store_string_uchar u = Buffer.add_utf_8_uchar string_buff u
+let store_string_chars s = Buffer.add_string string_buff s
+
+let get_stored_string () = Buffer.contents string_buff
+
+let char_for_backslash = function
+    'n' -> '\010'
+  | 'r' -> '\013'
+  | 'b' -> '\008'
+  | 't' -> '\009'
+  | c   -> c
+
+let raise_lexical_error lexbuf msg =
+  let p = Lexing.lexeme_start_p lexbuf in
+  raise (Lexical_error (msg,
+                        p.Lexing.pos_fname,
+                        p.Lexing.pos_lnum,
+                        p.Lexing.pos_cnum - p.Lexing.pos_bol + 1))
+;;
+
+let handle_lexical_error fn lexbuf =
+  let p = Lexing.lexeme_start_p lexbuf in
+  let line = p.Lexing.pos_lnum
+  and column = p.Lexing.pos_cnum - p.Lexing.pos_bol + 1
+  and file = p.Lexing.pos_fname
+  in
+  try
+    fn lexbuf
+  with Lexical_error (msg, "", 0, 0) ->
+    raise(Lexical_error(msg, file, line, column))
+
+let warning lexbuf msg =
+  let p = Lexing.lexeme_start_p lexbuf in
+  Printf.eprintf "ocamllex warning:\nFile \"%s\", line %d, character %d: %s.\n"
+    p.Lexing.pos_fname p.Lexing.pos_lnum
+    (p.Lexing.pos_cnum - p.Lexing.pos_bol + 1) msg;
+  flush stderr
+
+let hex_digit_value d =
+  let d = Char.code d in
+  if d >= 97 then d - 87 else
+  if d >= 65 then d - 55 else
+  d - 48
+
+let decimal_code c d u =
+  100 * (Char.code c - 48) + 10 * (Char.code d - 48) + (Char.code u - 48)
+
+let hexadecimal_code s =
+  let rec loop acc i =
+    if i < String.length s then
+      let value = hex_digit_value s.[i] in
+      loop (16 * acc + value) (i + 1)
+    else acc in
+  loop 0 0
+
+let char_for_octal_code c d u =
+  let c = 64 * (Char.code c - 48) +
+           8 * (Char.code d - 48) +
+               (Char.code u - 48) in
+  Char.chr c
+
+let char_for_hexadecimal_code d u =
+  Char.chr (16 * (hex_digit_value d) + (hex_digit_value u))
+
+let incr_loc lexbuf delta =
+  let pos = lexbuf.Lexing.lex_curr_p in
+  lexbuf.Lexing.lex_curr_p <- { pos with
+    Lexing.pos_lnum = pos.Lexing.pos_lnum + 1;
+    Lexing.pos_bol = pos.Lexing.pos_cnum - delta;
+  }
+;;
+
+let update_loc lexbuf opt_file line =
+  let pos = lexbuf.Lexing.lex_curr_p in
+  let new_file = match opt_file with
+                 | None -> pos.Lexing.pos_fname
+                 | Some f -> f
+  in
+  lexbuf.Lexing.lex_curr_p <- { pos with
+    Lexing.pos_fname = new_file;
+    Lexing.pos_lnum = line;
+    Lexing.pos_bol = pos.Lexing.pos_cnum;
+  }
+;;
+
+}
+
+let identstart =
+  ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255']
+let identbody =
+  ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9']
+let backslash_escapes =
+  ['\\' '\'' '"' 'n' 't' 'b' 'r' ' ']
+
+let lowercase = ['a'-'z' '_']
+let ident = identstart identbody*
+let extattrident = ident ('.' ident)*
+let blank = [' ' '\009' '\012']
+
+rule main = parse
+    [' ' '\013' '\009' '\012' ] +
+    { main lexbuf }
+  | '\010'
+    { incr_loc lexbuf 0;
+      main lexbuf }
+  | "#" [' ' '\t']* (['0'-'9']+ as num) [' ' '\t']*
+    ('\"' ([^ '\010' '\013' '\"']* as name) '\"')?
+    [^ '\010' '\013']* '\010'
+    { update_loc lexbuf name (int_of_string num);
+      main lexbuf
+    }
+  | "(*"
+    { comment_depth := 1;
+      handle_lexical_error comment lexbuf;
+      main lexbuf }
+  | '_' { Tunderscore }
+  | ident
+    { match Lexing.lexeme lexbuf with
+        "rule" -> Trule
+      | "parse" -> Tparse
+      | "shortest" -> Tparse_shortest
+      | "and" -> Tand
+      | "eof" -> Teof
+      | "let" -> Tlet
+      | "as"  -> Tas
+      | "refill" -> Trefill
+      | s -> Tident s }
+  | '"'
+    { reset_string_buffer();
+      handle_lexical_error string lexbuf;
+      Tstring(get_stored_string()) }
+(* note: ''' is a valid character literal (by contrast with the compiler) *)
+  | "'" [^ '\\'] "'"
+    { Tchar(Char.code(Lexing.lexeme_char lexbuf 1)) }
+  | "'" '\\' backslash_escapes "'"
+    { Tchar(Char.code(char_for_backslash (Lexing.lexeme_char lexbuf 2))) }
+  | "'" '\\' (['0'-'9'] as c) (['0'-'9'] as d) (['0'-'9'] as u)"'"
+    { let v = decimal_code c d u in
+      if v > 255 then
+        raise_lexical_error lexbuf
+          (Printf.sprintf "illegal escape sequence \\%c%c%c" c d u)
+      else
+        Tchar v }
+  | "'" '\\' 'o' (['0'-'3'] as c) (['0'-'7'] as d) (['0'-'7'] as u) "'"
+    { Tchar(Char.code(char_for_octal_code c d u)) }
+  | "'" '\\' 'x'
+       (['0'-'9' 'a'-'f' 'A'-'F'] as d) (['0'-'9' 'a'-'f' 'A'-'F'] as u) "'"
+       { Tchar(Char.code(char_for_hexadecimal_code d u)) }
+  | "'" '\\' (_ as c)
+    { raise_lexical_error lexbuf
+        (Printf.sprintf "illegal escape sequence \\%c" c)
+    }
+  | '{'
+    { let p = Lexing.lexeme_end_p lexbuf in
+      let f = p.Lexing.pos_fname in
+      let n1 = p.Lexing.pos_cnum
+      and l1 = p.Lexing.pos_lnum
+      and s1 = p.Lexing.pos_bol in
+      brace_depth := 1;
+      let n2 = handle_lexical_error action lexbuf in
+      Taction({loc_file = f; start_pos = n1; end_pos = n2;
+               start_line = l1; start_col = n1 - s1}) }
+  | '='  { Tequal }
+  | '|'  { Tor }
+  | '['  { Tlbracket }
+  | ']'  { Trbracket }
+  | '*'  { Tstar }
+  | '?'  { Tmaybe }
+  | '+'  { Tplus }
+  | '('  { Tlparen }
+  | ')'  { Trparen }
+  | '^'  { Tcaret }
+  | '-'  { Tdash }
+  | '#'  { Thash }
+  | eof  { Tend }
+  | _
+    { raise_lexical_error lexbuf
+        ("illegal character " ^ String.escaped(Lexing.lexeme lexbuf))
+    }
+
+
+(* String parsing comes from the compiler lexer *)
+and string = parse
+    '"'
+    { () }
+  | '\\' ('\013'* '\010') ([' ' '\009'] * as spaces)
+    { incr_loc lexbuf (String.length spaces);
+      string lexbuf }
+  | '\\' (backslash_escapes as c)
+    { store_string_char(char_for_backslash c);
+      string 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 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 }
+  | '\\' '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 }
+  | '\\' '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 }
+  | '\\' 'u' '{' (['0'-'9' 'a'-'f' 'A'-'F'] + as s) '}'
+    { let v = hexadecimal_code s in
+      if in_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 }
+  | '\\' (_ as c)
+    {if in_pattern () then
+       warning lexbuf
+        (Printf.sprintf "illegal backslash escape in string: '\\%c'" c) ;
+      store_string_char '\\' ;
+      store_string_char c ;
+      string lexbuf }
+  | eof
+    { raise(Lexical_error("unterminated string", "", 0, 0)) }
+  | '\013'* '\010' as s
+    { if !comment_depth = 0 then
+        warning lexbuf (Printf.sprintf "unescaped newline in string") ;
+      store_string_chars s;
+      incr_loc lexbuf 0;
+      string lexbuf }
+  | _ as c
+    { store_string_char c;
+      string lexbuf }
+
+and quoted_string delim = parse
+  | '\013'* '\010'
+    { incr_loc lexbuf 0;
+      quoted_string delim lexbuf }
+  | eof
+    { raise (Lexical_error ("unterminated string", "", 0, 0)) }
+  | '|' (lowercase* as delim') '}'
+    { if delim <> delim' then
+      quoted_string delim lexbuf }
+  | _
+    { quoted_string delim lexbuf }
+
+(*
+   Lexers comment and action are quite similar.
+   They should lex strings, quoted strings and characters,
+   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 }
+  | '"'
+    { reset_string_buffer();
+      string lexbuf;
+      reset_string_buffer();
+      comment lexbuf }
+  | '{' ('%' '%'? extattrident blank*)? (lowercase* as delim) "|"
+    { quoted_string delim lexbuf;
+      comment lexbuf }
+  | "'"
+    { skip_char lexbuf ;
+      comment lexbuf }
+  | eof
+    { raise(Lexical_error("unterminated comment", "", 0, 0)) }
+  | '\010'
+    { incr_loc lexbuf 0;
+      comment lexbuf }
+  | ident
+    { comment lexbuf }
+  | _
+    { comment lexbuf }
+
+and action = parse
+    '{'
+    { incr brace_depth;
+      action lexbuf }
+  | '}'
+    { decr brace_depth;
+      if !brace_depth = 0 then Lexing.lexeme_start lexbuf else action lexbuf }
+  | '"'
+    { reset_string_buffer();
+      handle_lexical_error string lexbuf;
+      reset_string_buffer();
+      action lexbuf }
+  | '{' ('%' '%'? extattrident blank*)? (lowercase* as delim) "|"
+    { quoted_string delim lexbuf;
+      action lexbuf }
+  | "'"
+    { skip_char lexbuf ;
+      action lexbuf }
+  | "(*"
+    { comment_depth := 1;
+      comment lexbuf;
+      action lexbuf }
+  | eof
+    { raise (Lexical_error("unterminated action", "", 0, 0)) }
+  | '\010'
+    { incr_loc lexbuf 0;
+      action lexbuf }
+  | ident
+    { action lexbuf }
+  | _
+    { action lexbuf }
+
+and skip_char = parse
+  | '\\'? ('\013'* '\010') "'"
+     { incr_loc lexbuf 1;
+     }
+  | [^ '\\' '\'' '\010' '\013'] "'" (* regular character *)
+(* one character and numeric escape sequences *)
+  | '\\' _ "'"
+  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
+  | '\\' 'o' ['0'-'7'] ['0'-'7'] ['0'-'7'] "'"
+  | '\\' 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "'"
+     {()}
+(* Perilous *)
+  | "" {()}
diff --git a/lex/lexgen.ml b/lex/lexgen.ml
new file mode 100644
index 00000000..184a8066
--- /dev/null
+++ b/lex/lexgen.ml
@@ -0,0 +1,1185 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Xavier Leroy, projet Cristal, INRIA Rocquencourt             *)
+(*           Luc Maranget, projet Moscova, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Compiling a lexer definition *)
+
+open Syntax
+(*open Printf*)
+
+exception Memory_overflow
+
+(* Deep abstract syntax for regular expressions *)
+
+type ident = string *  Syntax.location
+
+type tag_info = {id : string ; start : bool ; action : int}
+
+type regexp =
+    Empty
+  | Chars of int * bool
+  | Action of int
+  | Tag of tag_info
+  | Seq of regexp * regexp
+  | Alt of regexp * regexp
+  | Star of regexp
+
+type tag_base = Start | End | Mem of int
+type tag_addr = Sum of (tag_base * int)
+type ident_info =
+  | Ident_string of bool * tag_addr * tag_addr
+  | Ident_char of bool * tag_addr
+type t_env = (ident * ident_info) list
+
+type ('args,'action) lexer_entry =
+  { lex_name: string;
+    lex_regexp: regexp;
+    lex_mem_tags: int ;
+    lex_actions: (int *  t_env * 'action) list }
+
+
+type automata =
+    Perform of int * tag_action list
+  | Shift of automata_trans * (automata_move * memory_action list) array
+
+and automata_trans =
+    No_remember
+  | Remember of int * tag_action list
+
+and automata_move =
+    Backtrack
+  | Goto of int
+
+and memory_action =
+  | Copy of int * int
+  | Set of int
+
+and tag_action = SetTag of int * int | EraseTag of int
+
+(* Representation of entry points *)
+
+type ('args,'action) automata_entry =
+  { auto_name: string;
+    auto_args: 'args ;
+    auto_mem_size : int ;
+    auto_initial_state: int * memory_action list;
+    auto_actions: (int * t_env * 'action) list }
+
+
+(* A lot of sets and map structures *)
+
+module Ints =
+  Set.Make(struct type t = int let compare (x:t) y = compare x y end)
+
+let id_compare (id1,_) (id2,_) = String.compare id1 id2
+
+let tag_compare t1 t2 = Stdlib.compare t1 t2
+
+module Tags = Set.Make(struct type t = tag_info let compare = tag_compare end)
+
+module TagMap =
+  Map.Make (struct type t = tag_info let compare = tag_compare end)
+
+module IdSet =
+  Set.Make (struct type t = ident let compare = id_compare end)
+
+(*********************)
+(* Variable cleaning *)
+(*********************)
+
+(* Silently eliminate nested variables *)
+
+let rec do_remove_nested to_remove = function
+  | Bind (e,x) ->
+      if IdSet.mem x to_remove then
+        do_remove_nested to_remove e
+      else
+        Bind (do_remove_nested (IdSet.add x to_remove) e, x)
+  | Epsilon|Eof|Characters _ as e -> e
+  | Sequence (e1, e2) ->
+      Sequence
+        (do_remove_nested to_remove  e1, do_remove_nested to_remove  e2)
+  | Alternative (e1, e2) ->
+      Alternative
+        (do_remove_nested to_remove  e1, do_remove_nested to_remove  e2)
+  | Repetition e ->
+      Repetition (do_remove_nested to_remove  e)
+
+let remove_nested_as e = do_remove_nested IdSet.empty e
+
+(*********************)
+(* Variable analysis *)
+(*********************)
+
+(*
+  Optional variables.
+   A variable is optional when matching of regexp does not
+   implies it binds.
+     The typical case is:
+       ("" | 'a' as x) -> optional
+       ("" as x | 'a' as x) -> non-optional
+*)
+
+let stringset_delta s1 s2 =
+  IdSet.union
+    (IdSet.diff s1 s2)
+    (IdSet.diff s2 s1)
+
+let rec find_all_vars = function
+  | Characters _|Epsilon|Eof ->
+      IdSet.empty
+  | Bind (e,x) ->
+      IdSet.add x (find_all_vars e)
+  | Sequence (e1,e2)|Alternative (e1,e2) ->
+      IdSet.union (find_all_vars e1) (find_all_vars e2)
+  | Repetition e -> find_all_vars e
+
+
+let rec do_find_opt = function
+  | Characters _|Epsilon|Eof -> IdSet.empty, IdSet.empty
+  | Bind (e,x) ->
+      let opt,all = do_find_opt e in
+      opt, IdSet.add x all
+  | Sequence (e1,e2) ->
+      let opt1,all1 = do_find_opt e1
+      and opt2,all2 = do_find_opt e2 in
+      IdSet.union opt1 opt2, IdSet.union all1 all2
+  | Alternative (e1,e2) ->
+      let opt1,all1 = do_find_opt e1
+      and opt2,all2 = do_find_opt e2 in
+      IdSet.union
+        (IdSet.union opt1 opt2)
+        (stringset_delta all1 all2),
+      IdSet.union all1 all2
+  | Repetition e  ->
+      let r = find_all_vars e in
+      r,r
+
+let find_optional e =
+  let r,_ = do_find_opt e in r
+
+(*
+   Double variables
+   A variable is double when it can be bound more than once
+   in a single matching
+     The typical case is:
+       (e1 as x) (e2 as x)
+
+*)
+
+let rec do_find_double = function
+  | Characters _|Epsilon|Eof -> IdSet.empty, IdSet.empty
+  | Bind (e,x) ->
+      let dbl,all = do_find_double e in
+      (if IdSet.mem x all then
+        IdSet.add x dbl
+      else
+        dbl),
+      IdSet.add x all
+  | Sequence (e1,e2) ->
+      let dbl1, all1 = do_find_double e1
+      and dbl2, all2 = do_find_double e2 in
+      IdSet.union
+        (IdSet.inter all1 all2)
+        (IdSet.union dbl1 dbl2),
+      IdSet.union all1 all2
+  | Alternative (e1,e2) ->
+      let dbl1, all1 = do_find_double e1
+      and dbl2, all2 = do_find_double e2 in
+      IdSet.union dbl1 dbl2,
+      IdSet.union all1 all2
+  | Repetition e ->
+      let r = find_all_vars e in
+      r,r
+
+let find_double e = do_find_double e
+
+(*
+   Type of variables:
+    A variable is bound to a char when all its occurrences
+    bind a pattern of length 1.
+     The typical case is:
+       (_ as x) -> char
+*)
+
+let add_some x = function
+  | Some i -> Some (x+i)
+  | None   -> None
+
+let add_some_some x y = match x,y with
+| Some i, Some j -> Some (i+j)
+| _,_            -> None
+
+let rec do_find_chars sz = function
+  | Epsilon|Eof    -> IdSet.empty, IdSet.empty, sz
+  | Characters _ -> IdSet.empty, IdSet.empty, add_some 1 sz
+  | Bind (e,x)   ->
+      let c,s,e_sz = do_find_chars (Some 0) e in
+      begin match e_sz  with
+      | Some 1 ->
+          IdSet.add x c,s,add_some 1 sz
+      | _ ->
+          c, IdSet.add x s, add_some_some sz e_sz
+      end
+  | Sequence (e1,e2) ->
+      let c1,s1,sz1 = do_find_chars sz e1 in
+      let c2,s2,sz2 = do_find_chars sz1 e2 in
+      IdSet.union c1 c2,
+      IdSet.union s1 s2,
+      sz2
+  | Alternative (e1,e2) ->
+      let c1,s1,sz1 = do_find_chars sz e1
+      and c2,s2,sz2 = do_find_chars sz e2 in
+      IdSet.union c1 c2,
+      IdSet.union s1 s2,
+      (if sz1 = sz2 then sz1 else None)
+  | Repetition e -> do_find_chars None e
+
+
+
+let find_chars e =
+  let c,s,_ = do_find_chars (Some 0) e in
+  IdSet.diff c s
+
+(*******************************)
+(* From shallow to deep syntax *)
+(*******************************)
+
+let chars = ref ([] : Cset.t list)
+let chars_count = ref 0
+
+
+let rec encode_regexp char_vars act = function
+    Epsilon -> Empty
+  | Characters cl ->
+      let n = !chars_count in
+      chars := cl :: !chars;
+      incr chars_count;
+      Chars(n,false)
+  | Eof ->
+      let n = !chars_count in
+      chars := Cset.eof :: !chars;
+      incr chars_count;
+      Chars(n,true)
+  | Sequence(r1,r2) ->
+      let r1 = encode_regexp char_vars act r1 in
+      let r2 = encode_regexp char_vars act r2 in
+      Seq (r1, r2)
+  | Alternative(r1,r2) ->
+      let r1 = encode_regexp char_vars act r1 in
+      let r2 = encode_regexp char_vars act r2 in
+      Alt(r1, r2)
+  | Repetition r ->
+      let r = encode_regexp char_vars act r in
+      Star r
+  | Bind (r,((name,_) as x)) ->
+      let r = encode_regexp char_vars act r in
+      if IdSet.mem x char_vars then
+        Seq (Tag {id=name ; start=true ; action=act},r)
+      else
+        Seq (Tag {id=name ; start=true ; action=act},
+          Seq (r, Tag {id=name ; start=false ; action=act}))
+
+
+(* Optimisation,
+    Static optimization :
+      Replace tags by offsets relative to the beginning
+      or end of matched string.
+    Dynamic optimization:
+      Replace some non-optional, non-double tags by offsets w.r.t
+      a previous similar tag.
+*)
+
+let opt = true
+
+let mk_seq r1 r2 = match r1,r2  with
+| Empty,_ -> r2
+| _,Empty -> r1
+| _,_     -> Seq (r1,r2)
+
+let add_pos p i = match p with
+| Some (Sum (a,n)) -> Some (Sum (a,n+i))
+| None -> None
+
+let mem_name name id_set =
+  IdSet.exists (fun (id_name,_) -> name = id_name) id_set
+
+let opt_regexp all_vars char_vars optional_vars double_vars r =
+
+(* From removed tags to their addresses *)
+  let env = Hashtbl.create 17 in
+
+(* First static optimizations, from start position *)
+  let rec size_forward pos = function
+    | Empty|Chars (_,true)|Tag _ -> Some pos
+    | Chars (_,false) -> Some (pos+1)
+    | Seq (r1,r2) ->
+        begin match size_forward pos r1 with
+        | None -> None
+        | Some pos  -> size_forward pos r2
+        end
+    | Alt (r1,r2) ->
+        let pos1 = size_forward pos r1
+        and pos2 = size_forward pos r2 in
+        if pos1=pos2 then pos1 else None
+    | Star _ -> None
+    | Action _ -> assert false in
+
+  let rec simple_forward pos r = match r with
+    | Tag n ->
+        if mem_name n.id double_vars then
+          r,Some pos
+        else begin
+          Hashtbl.add env (n.id,n.start) (Sum (Start, pos)) ;
+          Empty,Some pos
+        end
+    | Empty -> r, Some pos
+    | Chars (_,is_eof) ->
+        r,Some (if is_eof then  pos else pos+1)
+    | Seq (r1,r2) ->
+        let r1,pos = simple_forward pos r1 in
+        begin match pos with
+        | None -> mk_seq r1 r2,None
+        | Some pos ->
+            let r2,pos = simple_forward pos r2 in
+            mk_seq r1 r2,pos
+        end
+    | Alt (r1,r2) ->
+        let pos1 = size_forward pos r1
+        and pos2 = size_forward pos r2 in
+        r,(if pos1=pos2 then pos1 else None)
+    | Star _ -> r,None
+    | Action _ -> assert false in
+
+(* Then static optimizations, from end position *)
+  let rec size_backward pos = function
+    | Empty|Chars (_,true)|Tag _ -> Some pos
+    | Chars (_,false) -> Some (pos-1)
+    | Seq (r1,r2) ->
+        begin match size_backward pos r2 with
+        | None -> None
+        | Some pos  -> size_backward pos r1
+        end
+    | Alt (r1,r2) ->
+        let pos1 = size_backward pos r1
+        and pos2 = size_backward pos r2 in
+        if pos1=pos2 then pos1 else None
+    | Star _ -> None
+    | Action _ -> assert false in
+
+
+  let rec simple_backward pos r = match r with
+    | Tag n ->
+        if mem_name n.id double_vars then
+          r,Some pos
+        else begin
+          Hashtbl.add env (n.id,n.start) (Sum (End, pos)) ;
+          Empty,Some pos
+        end
+    | Empty -> r,Some pos
+    | Chars (_,is_eof) ->
+        r,Some (if is_eof then pos else pos-1)
+    | Seq (r1,r2) ->
+        let r2,pos = simple_backward pos r2 in
+        begin match pos with
+        | None -> mk_seq r1 r2,None
+        | Some pos ->
+            let r1,pos = simple_backward pos r1 in
+            mk_seq r1 r2,pos
+        end
+    | Alt (r1,r2) ->
+        let pos1 = size_backward pos r1
+        and pos2 = size_backward pos r2 in
+        r,(if pos1=pos2 then pos1 else None)
+    | Star _ -> r,None
+    | Action _ -> assert false in
+
+  let r =
+    if opt then
+      let r,_ = simple_forward 0 r in
+      let r,_ = simple_backward 0 r in
+      r
+    else
+      r in
+
+  let loc_count = ref 0 in
+  let get_tag_addr t =
+    try
+     Hashtbl.find env t
+    with
+    | Not_found ->
+        let n = !loc_count in
+        incr loc_count ;
+        Hashtbl.add env t (Sum (Mem n,0)) ;
+        Sum (Mem n,0) in
+
+  let rec alloc_exp pos r = match r with
+    | Tag n ->
+        if mem_name n.id double_vars then
+          r,pos
+        else begin match pos with
+        | Some a ->
+            Hashtbl.add env (n.id,n.start) a ;
+            Empty,pos
+        | None ->
+            let a = get_tag_addr (n.id,n.start) in
+            r,Some a
+        end
+
+    | Empty -> r,pos
+    | Chars (_,is_eof) -> r,(if is_eof then pos else add_pos pos 1)
+    | Seq (r1,r2) ->
+        let r1,pos = alloc_exp pos r1 in
+        let r2,pos = alloc_exp pos r2 in
+        mk_seq r1 r2,pos
+    | Alt (_,_) ->
+        let off = size_forward 0 r in
+        begin match off with
+        | Some i -> r,add_pos pos i
+        | None -> r,None
+        end
+    | Star _ -> r,None
+    | Action _ -> assert false in
+
+  let r,_ = alloc_exp None r in
+  let m =
+    IdSet.fold
+      (fun ((name,_) as x) r ->
+
+        let v =
+          if IdSet.mem x char_vars then
+            Ident_char
+              (IdSet.mem x optional_vars, get_tag_addr (name,true))
+          else
+            Ident_string
+              (IdSet.mem x optional_vars,
+               get_tag_addr (name,true),
+               get_tag_addr (name,false)) in
+        (x,v)::r)
+      all_vars [] in
+  m,r, !loc_count
+
+
+
+let encode_casedef casedef =
+  let r =
+    List.fold_left
+      (fun (reg,actions,count,ntags) (expr, act) ->
+        let expr = remove_nested_as expr in
+        let char_vars = find_chars expr in
+        let r = encode_regexp char_vars count expr
+        and opt_vars = find_optional expr
+        and double_vars,all_vars = find_double expr in
+        let m,r,loc_ntags =
+          opt_regexp all_vars char_vars opt_vars double_vars r in
+        Alt(reg, Seq(r, Action count)),
+        (count, m ,act) :: actions,
+        (succ count),
+        max loc_ntags ntags)
+      (Empty, [], 0, 0)
+      casedef in
+  r
+
+let encode_lexdef def =
+  chars := [];
+  chars_count := 0;
+  let entry_list =
+    List.map
+      (fun {name=entry_name; args=args; shortest=shortest; clauses=casedef} ->
+        let (re,actions,_,ntags) = encode_casedef casedef in
+        { lex_name = entry_name;
+          lex_regexp = re;
+          lex_mem_tags = ntags ;
+          lex_actions = List.rev actions },args,shortest)
+      def in
+  let chr = Array.of_list (List.rev !chars) in
+  chars := [];
+  (chr, entry_list)
+
+(* To generate directly a NFA from a regular expression.
+     Confer Aho-Sethi-Ullman, dragon book, chap. 3
+   Extension to tagged automata.
+     Confer
+       Ville Larikari
+       'NFAs with Tagged Transitions, their Conversion to Deterministic
+        Automata and Application to Regular Expressions'.
+       Symposium on String Processing and Information Retrieval (SPIRE 2000),
+     http://kouli.iki.fi/~vlaurika/spire2000-tnfa.ps
+(See also)
+     http://kouli.iki.fi/~vlaurika/regex-submatch.ps.gz
+*)
+
+type t_transition =
+    OnChars of int
+  | ToAction of int
+
+type transition = t_transition * Tags.t
+
+let trans_compare (t1,tags1) (t2,tags2) =
+  match Stdlib.compare  t1 t2 with
+  | 0 -> Tags.compare tags1 tags2
+  | r -> r
+
+
+module TransSet =
+  Set.Make(struct type t = transition let compare = trans_compare end)
+
+let rec nullable = function
+  | Empty|Tag _ -> true
+  | Chars (_,_)|Action _ -> false
+  | Seq(r1,r2) -> nullable r1 && nullable r2
+  | Alt(r1,r2) -> nullable r1 || nullable r2
+  | Star _     -> true
+
+let rec emptymatch = function
+  | Empty | Chars (_,_) | Action _ -> Tags.empty
+  | Tag t       -> Tags.add t Tags.empty
+  | Seq (r1,r2) -> Tags.union (emptymatch r1) (emptymatch r2)
+  | Alt(r1,r2)  ->
+      if nullable r1 then
+        emptymatch r1
+      else
+        emptymatch r2
+  | Star r ->
+      if nullable r then
+        emptymatch r
+      else
+        Tags.empty
+
+let addtags transs tags =
+  TransSet.fold
+    (fun (t,tags_t) r -> TransSet.add (t, Tags.union tags tags_t) r)
+    transs TransSet.empty
+
+
+let rec firstpos = function
+    Empty|Tag _ -> TransSet.empty
+  | Chars (pos,_) -> TransSet.add (OnChars pos,Tags.empty) TransSet.empty
+  | Action act -> TransSet.add (ToAction act,Tags.empty) TransSet.empty
+  | Seq(r1,r2) ->
+      if nullable r1 then
+        TransSet.union (firstpos r1) (addtags (firstpos r2) (emptymatch r1))
+      else
+        firstpos r1
+  | Alt(r1,r2) -> TransSet.union (firstpos r1) (firstpos r2)
+  | Star r     -> firstpos r
+
+
+(* Berry-Sethi followpos *)
+let followpos size entry_list =
+  let v = Array.make size TransSet.empty in
+  let rec fill s = function
+    | Empty|Action _|Tag _ -> ()
+    | Chars (n,_) -> v.(n) <- s
+    | Alt (r1,r2) ->
+        fill s r1 ; fill s r2
+    | Seq (r1,r2) ->
+        fill
+          (if nullable r2 then
+            TransSet.union (firstpos r2) (addtags s (emptymatch r2))
+          else
+            (firstpos r2))
+          r1 ;
+        fill s r2
+    | Star r ->
+        fill (TransSet.union (firstpos r) s) r in
+  List.iter (fun (entry,_,_) -> fill TransSet.empty entry.lex_regexp)
+            entry_list;
+  v
+
+(************************)
+(* The algorithm itself *)
+(************************)
+
+let no_action = max_int
+
+module StateSet =
+  Set.Make (struct type t = t_transition let compare = Stdlib.compare end)
+
+
+module MemMap =
+  Map.Make (struct type t = int
+                   let compare (x:t) y = Stdlib.compare x y end)
+
+type 'a dfa_state =
+  {final : int * ('a * int TagMap.t) ;
+   others : ('a * int TagMap.t) MemMap.t}
+
+
+(*
+let dtag oc t =
+  fprintf oc "%s<%s>" t.id (if t.start then "s" else "e")
+
+let dmem_map dp ds m =
+  MemMap.iter
+    (fun k x ->
+      eprintf "%d -> " k ; dp x ; ds ())
+    m
+
+and dtag_map dp ds m =
+  TagMap.iter
+    (fun t x ->
+      dtag stderr t ; eprintf " -> " ; dp x ; ds ())
+    m
+
+let dstate {final=(act,(_,m)) ; others=o} =
+  if act <> no_action then begin
+    eprintf "final=%d " act ;
+    dtag_map (fun x -> eprintf "%d" x) (fun () -> prerr_string " ,") m ;
+    prerr_endline ""
+  end ;
+  dmem_map
+    (fun (_,m) ->
+      dtag_map (fun x -> eprintf "%d" x) (fun () -> prerr_string " ,") m)
+    (fun () -> prerr_endline "")
+    o
+*)
+
+
+let dfa_state_empty =
+  {final=(no_action, (max_int,TagMap.empty)) ;
+   others=MemMap.empty}
+
+and dfa_state_is_empty {final=(act,_) ; others=o} =
+  act = no_action &&
+  o = MemMap.empty
+
+
+(* A key is an abstraction on a dfa state,
+   two states with the same key can be made the same by
+   copying some memory cells into others *)
+
+
+module StateSetSet =
+  Set.Make (struct type t = StateSet.t let compare = StateSet.compare end)
+
+type t_equiv = {tag:tag_info ; equiv:StateSetSet.t}
+
+module MemKey =
+  Set.Make
+   (struct
+     type t = t_equiv
+
+     let compare e1 e2 = match Stdlib.compare e1.tag e2.tag with
+     | 0 -> StateSetSet.compare e1.equiv e2.equiv
+     | r -> r
+   end)
+
+type dfa_key = {kstate : StateSet.t ; kmem : MemKey.t}
+
+(* Map a state to its key *)
+let env_to_class m =
+  let env1 =
+    MemMap.fold
+      (fun _ (tag,s) r ->
+         TagMap.update tag (function
+             | None -> Some (StateSetSet.singleton s)
+             | Some ss -> Some (StateSetSet.add s ss)
+           ) r)
+      m TagMap.empty in
+  TagMap.fold
+    (fun tag ss r -> MemKey.add {tag=tag ; equiv=ss} r)
+    env1 MemKey.empty
+
+
+(* trans is nfa_state, m is associated memory map *)
+let inverse_mem_map trans m r =
+  TagMap.fold
+    (fun tag addr r ->
+       MemMap.update addr (function
+           | None -> Some (tag, StateSet.singleton trans)
+           | Some (otag, s) ->
+               assert (tag = otag);
+               Some (tag, StateSet.add trans s)
+         ) r)
+    m r
+
+let inverse_mem_map_other n (_,m) r = inverse_mem_map (OnChars n) m r
+
+let get_key {final=(act,(_,m_act)) ; others=o} =
+  let env =
+    MemMap.fold inverse_mem_map_other
+      o
+      (if act = no_action then MemMap.empty
+      else inverse_mem_map (ToAction act) m_act MemMap.empty) in
+  let state_key =
+    MemMap.fold (fun n _ r -> StateSet.add (OnChars n) r) o
+      (if act=no_action then StateSet.empty
+      else StateSet.add (ToAction act) StateSet.empty) in
+  let mem_key = env_to_class  env in
+  {kstate = state_key ; kmem = mem_key}
+
+
+let key_compare k1 k2 = match StateSet.compare k1.kstate k2.kstate with
+| 0 -> MemKey.compare k1.kmem k2.kmem
+| r -> r
+
+(* Association dfa_state -> state_num *)
+
+module StateMap =
+  Map.Make(struct type t = dfa_key let compare = key_compare end)
+
+let state_map = ref (StateMap.empty : int StateMap.t)
+let todo = Stack.create()
+let next_state_num = ref 0
+let next_mem_cell = ref 0
+let temp_pending = ref false
+let tag_cells = Hashtbl.create 17
+let state_table = Table.create dfa_state_empty
+
+
+(* Initial reset of state *)
+let reset_state () =
+  Stack.clear todo;
+  next_state_num := 0 ;
+  let _ = Table.trim state_table in
+  ()
+
+(* Reset state before processing a given automata.
+   We clear both the memory mapping and
+   the state mapping, as state sharing between different
+   automata may lead to incorrect estimation of the cell memory size
+   BUG ID 0004517 *)
+
+
+let reset_state_partial ntags =
+  next_mem_cell := ntags ;
+  Hashtbl.clear tag_cells ;
+  temp_pending := false ;
+  state_map := StateMap.empty
+
+let do_alloc_temp () =
+  temp_pending := true ;
+  let n = !next_mem_cell in
+  n
+
+let do_alloc_cell used t =
+  let available =
+    try Hashtbl.find tag_cells t with Not_found -> Ints.empty in
+  try
+    Ints.choose (Ints.diff available used)
+  with
+  | Not_found ->
+      temp_pending := false ;
+      let n = !next_mem_cell in
+      if n >= 255 then raise Memory_overflow ;
+      Hashtbl.replace tag_cells t (Ints.add n available) ;
+      incr next_mem_cell ;
+      n
+
+let is_old_addr a = a >= 0
+and is_new_addr a = a < 0
+
+let old_in_map m r =
+  TagMap.fold
+    (fun _ addr r ->
+      if is_old_addr addr then
+        Ints.add addr r
+      else
+        r)
+    m r
+
+let alloc_map used m mvs =
+  TagMap.fold
+    (fun tag a (r,mvs) ->
+      let a,mvs =
+        if is_new_addr a then
+          let a = do_alloc_cell used tag in
+          a,Ints.add a mvs
+        else a,mvs in
+      TagMap.add tag a r,mvs)
+    m (TagMap.empty,mvs)
+
+let create_new_state {final=(act,(_,m_act)) ; others=o} =
+  let used =
+    MemMap.fold (fun _ (_,m) r -> old_in_map m r)
+      o (old_in_map m_act Ints.empty) in
+
+  let new_m_act,mvs  = alloc_map used m_act Ints.empty in
+  let new_o,mvs =
+    MemMap.fold (fun k (x,m) (r,mvs) ->
+      let m,mvs = alloc_map used m mvs in
+      MemMap.add k (x,m) r,mvs)
+      o (MemMap.empty,mvs) in
+  {final=(act,(0,new_m_act)) ; others=new_o},
+  Ints.fold (fun x r -> Set x::r) mvs []
+
+type new_addr_gen = {mutable count : int ; mutable env : int TagMap.t}
+
+let create_new_addr_gen () = {count = -1 ; env = TagMap.empty}
+
+let alloc_new_addr tag r =
+  try
+    TagMap.find tag r.env
+  with
+  | Not_found ->
+      let a = r.count in
+      r.count <- a-1 ;
+      r.env <- TagMap.add tag a r.env ;
+      a
+
+
+let create_mem_map tags gen =
+  Tags.fold
+    (fun tag r -> TagMap.add tag (alloc_new_addr tag gen) r)
+    tags TagMap.empty
+
+let create_init_state pos =
+  let gen = create_new_addr_gen () in
+  let st =
+    TransSet.fold
+      (fun (t,tags) st ->
+        match t with
+        | ToAction n ->
+            let on,_otags = st.final in
+            if n < on then
+              {st with final = (n, (0,create_mem_map tags gen))}
+            else
+              st
+        | OnChars n ->
+            try
+              let _ = MemMap.find n st.others in assert false
+            with
+            | Not_found ->
+                {st with others =
+                  MemMap.add n (0,create_mem_map tags gen) st.others})
+      pos dfa_state_empty in
+  st
+
+
+let get_map t st = match t with
+| ToAction _ -> let _,(_,m) = st.final in m
+| OnChars n  ->
+    let (_,m) = MemMap.find n st.others in
+    m
+
+let dest = function | Copy (d,_) | Set d  -> d
+and orig = function | Copy (_,o) -> o | Set _ -> -1
+
+(*
+let pmv oc mv = fprintf oc "%d <- %d" (dest mv) (orig mv)
+let pmvs oc mvs =
+  List.iter (fun mv -> fprintf oc "%a " pmv  mv) mvs ;
+  output_char oc '\n' ; flush oc
+*)
+
+
+(* Topological sort << a la louche >> *)
+let sort_mvs mvs =
+  let rec do_rec r mvs = match mvs with
+  | [] -> r
+  | _  ->
+      let dests =
+        List.fold_left
+          (fun r mv -> Ints.add (dest mv) r)
+          Ints.empty mvs in
+      let rem,here =
+        List.partition
+          (fun mv -> Ints.mem (orig mv) dests)
+          mvs in
+      match here with
+      | [] ->
+          begin match rem with
+          | Copy (d,_)::_ ->
+              let d' = do_alloc_temp () in
+              Copy (d',d)::
+              do_rec r
+                (List.map
+                   (fun mv ->
+                     if orig mv = d then
+                       Copy (dest mv,d')
+                     else
+                       mv)
+                   rem)
+          | _ -> assert false
+          end
+      | _  -> do_rec (here@r) rem  in
+  do_rec [] mvs
+
+let move_to mem_key src tgt =
+  let mvs =
+    MemKey.fold
+      (fun {tag=tag ; equiv=m} r ->
+        StateSetSet.fold
+          (fun s r ->
+            try
+              let t = StateSet.choose s  in
+              let src = TagMap.find tag (get_map t src)
+              and tgt = TagMap.find tag (get_map t tgt) in
+              if src <> tgt then begin
+                if is_new_addr src then
+                  Set tgt::r
+                else
+                  Copy (tgt, src)::r
+              end else
+                r
+            with
+            | Not_found -> assert false)
+          m r)
+      mem_key [] in
+(* Moves are topologically sorted *)
+  sort_mvs mvs
+
+
+let get_state st =
+  let key = get_key st in
+  try
+    let num = StateMap.find key !state_map in
+    num,move_to key.kmem st (Table.get state_table num)
+  with Not_found ->
+    let num = !next_state_num in
+    incr next_state_num;
+    let st,mvs = create_new_state st in
+    Table.emit state_table st ;
+    state_map := StateMap.add key num !state_map;
+    Stack.push (st, num) todo;
+    num,mvs
+
+let map_on_all_states f old_res =
+  let res = ref old_res in
+  begin try
+    while true do
+      let (st, i) = Stack.pop todo in
+      let r = f st in
+      res := (r, i) :: !res
+    done
+  with Stack.Empty -> ()
+  end;
+  !res
+
+let goto_state st =
+  if
+    dfa_state_is_empty st
+  then
+    Backtrack,[]
+  else
+    let n,moves = get_state st in
+    Goto n,moves
+
+(****************************)
+(* compute reachable states *)
+(****************************)
+
+let add_tags_to_map gen tags m =
+  Tags.fold
+    (fun tag m ->
+      let m = TagMap.remove tag m in
+      TagMap.add tag (alloc_new_addr tag gen) m)
+    tags m
+
+let apply_transition gen r pri m = function
+  | ToAction n,tags ->
+      let on,(opri,_) = r.final in
+      if n < on || (on=n && pri < opri) then
+        let m = add_tags_to_map gen tags m in
+        {r with final=n,(pri,m)}
+      else r
+  |  OnChars n,tags ->
+      try
+        let (opri,_) = MemMap.find n r.others in
+        if pri < opri then
+          let m = add_tags_to_map gen tags m in
+          {r with others=MemMap.add n (pri,m) (MemMap.remove n r.others)}
+        else
+          r
+      with
+      | Not_found ->
+          let m = add_tags_to_map gen tags m in
+          {r with others=MemMap.add n (pri,m) r.others}
+
+(* add transitions ts to new state r
+   transitions in ts start from state pri and memory map m
+*)
+let apply_transitions gen r pri m ts =
+  TransSet.fold
+    (fun t r -> apply_transition gen r pri m t)
+    ts r
+
+
+(* For a given nfa_state pos, refine char partition *)
+let rec split_env gen follow pos m s = function
+  | [] -> (* Can occur ! because of non-matching regexp ([^'\000'-'\255']) *)
+      []
+  | (s1,st1) as p::rem ->
+      let here = Cset.inter s s1 in
+      if Cset.is_empty here then
+        p::split_env gen follow pos m s rem
+      else
+        let rest = Cset.diff s here in
+        let rem =
+          if Cset.is_empty rest then
+            rem
+          else
+            split_env gen follow pos m rest rem
+        and new_st = apply_transitions gen st1 pos m follow in
+        let stay = Cset.diff s1 here in
+        if Cset.is_empty stay then
+          (here, new_st)::rem
+        else
+          (stay, st1)::(here, new_st)::rem
+
+
+(* For all nfa_state pos in a dfa state st *)
+let comp_shift gen chars follow st =
+  MemMap.fold
+    (fun pos (_,m) env -> split_env gen follow.(pos) pos m chars.(pos) env)
+    st [Cset.all_chars_eof,dfa_state_empty]
+
+
+let reachs chars follow st =
+  let gen = create_new_addr_gen () in
+(* build an association list (char set -> new state) *)
+  let env = comp_shift gen chars follow st in
+(* change it into (char set -> new state_num) *)
+  let env =
+    List.map
+      (fun (s,dfa_state) -> s,goto_state dfa_state) env in
+(* finally build the char indexed array -> new state num *)
+  let shift = Cset.env_to_array env in
+  shift
+
+
+let get_tag_mem n env t =
+  try
+    TagMap.find t env.(n)
+  with
+  | Not_found -> assert false
+
+let do_tag_actions n env  m =
+
+  let used,r =
+    TagMap.fold (fun t m (used,r) ->
+      let a = get_tag_mem n env t in
+      Ints.add a used,SetTag (a,m)::r) m (Ints.empty,[]) in
+  let _,r =
+    TagMap.fold
+      (fun tag m (used,r) ->
+        if not (Ints.mem m used) && tag.start then
+          Ints.add m used, EraseTag m::r
+        else
+          used,r)
+      env.(n) (used,r) in
+  r
+
+
+let translate_state shortest_match tags chars follow st =
+  let (n,(_,m)) = st.final in
+  if MemMap.empty = st.others then
+    Perform (n,do_tag_actions n tags m)
+  else if shortest_match then begin
+    if n=no_action then
+      Shift (No_remember,reachs chars follow st.others)
+    else
+      Perform(n, do_tag_actions n tags m)
+  end else begin
+    Shift (
+    (if n = no_action then
+      No_remember
+    else
+      Remember (n,do_tag_actions n tags m)),
+    reachs chars follow st.others)
+  end
+
+(*
+let dtags chan tags =
+  Tags.iter
+    (fun t -> fprintf chan " %a" dtag t)
+    tags
+
+let dtransset s =
+  TransSet.iter
+    (fun trans -> match trans with
+    | OnChars i,tags ->
+        eprintf " (-> %d,%a)" i dtags tags
+    | ToAction i,tags ->
+        eprintf " ([%d],%a)" i dtags tags)
+    s
+
+let dfollow t =
+  eprintf "follow=[" ;
+  for i = 0 to Array.length t-1 do
+    eprintf "%d:" i ;
+    dtransset t.(i)
+  done ;
+  prerr_endline "]"
+*)
+
+
+let make_tag_entry id start act a r = match a with
+  | Sum (Mem m,0) ->
+      TagMap.add {id=id ; start=start ; action=act} m r
+  | _ -> r
+
+let extract_tags l =
+  let envs = Array.make (List.length l) TagMap.empty in
+  List.iter
+    (fun (act,m,_) ->
+      envs.(act) <-
+         List.fold_right
+           (fun ((name,_),v) r -> match v with
+           | Ident_char (_,t) -> make_tag_entry name true act t r
+           | Ident_string (_,t1,t2) ->
+               make_tag_entry name true act t1
+               (make_tag_entry name false act t2 r))
+           m TagMap.empty)
+    l ;
+  envs
+
+
+let make_dfa lexdef =
+  let (chars, entry_list) = encode_lexdef lexdef in
+  let follow = followpos (Array.length chars) entry_list in
+(*
+  dfollow follow ;
+*)
+  reset_state () ;
+  let r_states = ref [] in
+  let initial_states =
+    List.map
+      (fun (le,args,shortest) ->
+        let tags = extract_tags le.lex_actions in
+        reset_state_partial le.lex_mem_tags ;
+        let pos_set = firstpos le.lex_regexp in
+(*
+        prerr_string "trans={" ; dtransset pos_set ; prerr_endline "}" ;
+*)
+        let init_state = create_init_state pos_set in
+        let init_num = get_state init_state in
+        r_states :=
+           map_on_all_states
+             (translate_state shortest tags chars follow) !r_states ;
+        { auto_name = le.lex_name;
+          auto_args = args ;
+          auto_mem_size =
+            (if !temp_pending then !next_mem_cell+1 else !next_mem_cell) ;
+          auto_initial_state = init_num ;
+          auto_actions = le.lex_actions })
+      entry_list in
+  let states = !r_states in
+(*
+  prerr_endline "** states **" ;
+  for i = 0 to !next_state_num-1 do
+    eprintf "+++ %d +++\n" i ;
+    dstate (Table.get state_table i) ;
+    prerr_endline ""
+  done ;
+  eprintf "%d states\n" !next_state_num ;
+*)
+  let actions = Array.make !next_state_num (Perform (0,[])) in
+  List.iter (fun (act, i) -> actions.(i) <- act) states;
+(* Useless state reset, so as to restrict GC roots *)
+  reset_state  () ;
+  reset_state_partial  0 ;
+  (initial_states, actions)
diff --git a/lex/lexgen.mli b/lex/lexgen.mli
new file mode 100644
index 00000000..306f475a
--- /dev/null
+++ b/lex/lexgen.mli
@@ -0,0 +1,60 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* raised when there are too many bindings (>= 254 memory cells) *)
+exception Memory_overflow
+
+
+(* Representation of automata *)
+
+
+type automata =
+    Perform of int * tag_action list
+  | Shift of automata_trans * (automata_move * memory_action list) array
+and automata_trans =
+    No_remember
+  | Remember of int * tag_action list
+and automata_move =
+    Backtrack
+  | Goto of int
+and memory_action =
+  | Copy of int * int
+  | Set of int
+
+and tag_action = SetTag of int * int | EraseTag of int
+
+type ident = string *  Syntax.location
+
+(* Representation of entry points *)
+type tag_base = Start | End | Mem of int
+type tag_addr = Sum of (tag_base * int)
+type ident_info =
+  | Ident_string of bool * tag_addr * tag_addr
+  | Ident_char of bool * tag_addr
+
+type t_env = (ident * ident_info) list
+
+type ('args,'action) automata_entry =
+  { auto_name: string;
+    auto_args: 'args ;
+    auto_mem_size : int ;
+    auto_initial_state: int * memory_action list ;
+    auto_actions: (int * t_env * 'action) list }
+
+(* The entry point *)
+
+val make_dfa :
+  ('args, 'action) Syntax.entry list ->
+  ('args, 'action) automata_entry list * automata array
diff --git a/lex/main.ml b/lex/main.ml
new file mode 100644
index 00000000..3155a38a
--- /dev/null
+++ b/lex/main.ml
@@ -0,0 +1,126 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The lexer generator. Command-line parsing. *)
+
+open Syntax
+
+let ml_automata = ref false
+let source_name = ref None
+let output_name = ref None
+
+let usage = "usage: ocamllex [options] sourcefile"
+
+let print_version_string () =
+  print_string "The OCaml lexer generator, version ";
+  print_string Sys.ocaml_version ; print_newline();
+  exit 0
+
+let print_version_num () =
+  print_endline Sys.ocaml_version;
+  exit 0;
+;;
+
+let specs =
+  ["-ml", Arg.Set ml_automata,
+    " Output code that does not use the Lexing module built-in automata \
+     interpreter";
+   "-o", Arg.String (fun x -> output_name := Some x),
+    "   Set output file name to ";
+   "-q", Arg.Set Common.quiet_mode, " Do not display informational messages";
+   "-v",  Arg.Unit print_version_string, " Print version and exit";
+   "-version",  Arg.Unit print_version_string, " Print version and exit";
+   "-vnum",  Arg.Unit print_version_num, " Print version number and exit";
+  ]
+
+let _ =
+  Arg.parse
+    specs
+    (fun name -> source_name := Some name)
+    usage
+
+
+let main () =
+
+  let source_name = match !source_name with
+  | None -> Arg.usage specs usage ; exit 2
+  | Some name -> name in
+  let dest_name = match !output_name with
+  | Some name -> name
+  | None ->
+      if Filename.check_suffix source_name ".mll" then
+        Filename.chop_suffix source_name ".mll" ^ ".ml"
+      else
+        source_name ^ ".ml" in
+
+  let ic = open_in_bin source_name in
+  let oc = open_out dest_name in
+  let tr = Common.open_tracker dest_name oc in
+  let lexbuf = Lexing.from_channel ic in
+  lexbuf.Lexing.lex_curr_p <-
+    {Lexing.pos_fname = source_name; Lexing.pos_lnum = 1;
+     Lexing.pos_bol = 0; Lexing.pos_cnum = 0};
+  try
+    let def = Parser.lexer_definition Lexer.main lexbuf in
+    let (entries, transitions) = Lexgen.make_dfa def.entrypoints in
+    if !ml_automata then begin
+      Outputbis.output_lexdef
+        ic oc tr
+        def.header def.refill_handler entries transitions def.trailer
+    end else begin
+       let tables = Compact.compact_tables transitions in
+       Output.output_lexdef ic oc tr
+         def.header def.refill_handler tables entries def.trailer
+    end;
+    close_in ic;
+    close_out oc;
+    Common.close_tracker tr;
+  with exn ->
+    let bt = Printexc.get_raw_backtrace () in
+    close_in ic;
+    close_out oc;
+    Common.close_tracker tr;
+    Sys.remove dest_name;
+    begin match exn with
+    | Cset.Bad ->
+        let p = Lexing.lexeme_start_p lexbuf in
+        Printf.fprintf stderr
+          "File \"%s\", line %d, character %d: character set expected.\n"
+          p.Lexing.pos_fname p.Lexing.pos_lnum
+          (p.Lexing.pos_cnum - p.Lexing.pos_bol)
+    | Parsing.Parse_error ->
+        let p = Lexing.lexeme_start_p lexbuf in
+        Printf.fprintf stderr
+          "File \"%s\", line %d, character %d: syntax error.\n"
+          p.Lexing.pos_fname p.Lexing.pos_lnum
+          (p.Lexing.pos_cnum - p.Lexing.pos_bol)
+    | Lexer.Lexical_error(msg, file, line, col) ->
+        Printf.fprintf stderr
+          "File \"%s\", line %d, character %d: %s.\n"
+          file line col msg
+    | Lexgen.Memory_overflow ->
+        Printf.fprintf stderr
+          "File \"%s\":\n Position memory overflow, too many bindings\n"
+          source_name
+    | Output.Table_overflow ->
+        Printf.fprintf stderr
+          "File \"%s\":\ntransition table overflow, automaton is too big\n"
+          source_name
+    | _ ->
+        Printexc.raise_with_backtrace exn bt
+    end;
+    exit 3
+
+let _ = (* Printexc.catch *) main (); exit 0
diff --git a/lex/output.ml b/lex/output.ml
new file mode 100644
index 00000000..d5ce76eb
--- /dev/null
+++ b/lex/output.ml
@@ -0,0 +1,157 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Output the DFA tables and its entry points *)
+
+open Printf
+open Lexgen
+open Compact
+open Common
+
+(* To output an array of short ints, encoded as a string *)
+
+let output_byte oc b =
+  output_char oc '\\';
+  output_char oc (Char.chr(48 + b / 100));
+  output_char oc (Char.chr(48 + (b / 10) mod 10));
+  output_char oc (Char.chr(48 + b mod 10))
+
+let output_array oc v =
+  output_string oc "   \"";
+  for i = 0 to Array.length v - 1 do
+    output_byte oc (v.(i) land 0xFF);
+    output_byte oc ((v.(i) asr 8) land 0xFF);
+    if i land 7 = 7 then output_string oc "\\\n    "
+  done;
+  output_string oc "\""
+
+let output_byte_array oc v =
+  output_string oc "   \"";
+  for i = 0 to Array.length v - 1 do
+    output_byte oc (v.(i) land 0xFF);
+    if i land 15 = 15 then output_string oc "\\\n    "
+  done;
+  output_string oc "\""
+
+(* Output the tables *)
+
+let output_tables oc tbl =
+  output_string oc "let __ocaml_lex_tables = {\n";
+
+  fprintf oc "  Lexing.lex_base =\n%a;\n" output_array tbl.tbl_base;
+  fprintf oc "  Lexing.lex_backtrk =\n%a;\n" output_array tbl.tbl_backtrk;
+  fprintf oc "  Lexing.lex_default =\n%a;\n" output_array tbl.tbl_default;
+  fprintf oc "  Lexing.lex_trans =\n%a;\n" output_array tbl.tbl_trans;
+  fprintf oc "  Lexing.lex_check =\n%a;\n" output_array tbl.tbl_check;
+  fprintf oc "  Lexing.lex_base_code =\n%a;\n" output_array tbl.tbl_base_code;
+
+  fprintf oc "  Lexing.lex_backtrk_code =\n%a;\n"
+    output_array tbl.tbl_backtrk_code;
+  fprintf oc "  Lexing.lex_default_code =\n%a;\n"
+    output_array tbl.tbl_default_code;
+  fprintf oc "  Lexing.lex_trans_code =\n%a;\n"
+    output_array tbl.tbl_trans_code;
+  fprintf oc "  Lexing.lex_check_code =\n%a;\n"
+    output_array tbl.tbl_check_code;
+  fprintf oc "  Lexing.lex_code =\n%a;\n" output_byte_array tbl.tbl_code;
+
+  output_string oc "}\n\n"
+
+
+(* Output the entries *)
+
+let output_entry some_mem_code ic oc has_refill oci e =
+  let init_num, init_moves = e.auto_initial_state in
+  (* Will use "memory" instructions when (1) some memory instructions are
+     here and (2) this entry point needs memory. *)
+  let some_mem_code = some_mem_code &&  e.auto_mem_size > 0 in
+  fprintf oc
+    "%s %alexbuf =\
+   \n  %a%a __ocaml_lex_%s_rec %alexbuf %d\n"
+    e.auto_name
+    output_args e.auto_args
+    (fun oc x ->
+      if some_mem_code then
+        fprintf oc "lexbuf.Lexing.lex_mem <- Array.make %d (-1);" x)
+    e.auto_mem_size
+    (output_memory_actions "  ") init_moves
+    e.auto_name
+    output_args e.auto_args
+    init_num;
+  fprintf oc "and __ocaml_lex_%s_rec %alexbuf __ocaml_lex_state =\n"
+    e.auto_name output_args e.auto_args;
+  fprintf oc "  match Lexing.%sengine"
+          (if some_mem_code then "new_" else "");
+  fprintf oc " __ocaml_lex_tables __ocaml_lex_state lexbuf with\n    ";
+  List.iter
+    (fun (num, env, loc) ->
+      fprintf oc "  | ";
+      fprintf oc "%d ->\n" num;
+      output_env ic oc oci env;
+      copy_chunk ic oc oci loc true;
+      fprintf oc "\n")
+    e.auto_actions;
+  if has_refill then
+    fprintf oc
+      "  | __ocaml_lex_state -> __ocaml_lex_refill\
+     \n      (fun lexbuf -> lexbuf.Lexing.refill_buff lexbuf;\
+     \n         __ocaml_lex_%s_rec %alexbuf __ocaml_lex_state) lexbuf\n\n"
+      e.auto_name output_args e.auto_args
+  else
+    fprintf oc
+      "  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf;\
+     \n      __ocaml_lex_%s_rec %alexbuf __ocaml_lex_state\n\n"
+      e.auto_name output_args e.auto_args
+
+(* Main output function *)
+
+exception Table_overflow
+
+let output_lexdef ic oc oci header rh tables entry_points trailer =
+  if not !Common.quiet_mode then
+    Printf.printf "%d states, %d transitions, table size %d bytes\n"
+      (Array.length tables.tbl_base)
+      (Array.length tables.tbl_trans)
+      (2 * (Array.length tables.tbl_base + Array.length tables.tbl_backtrk +
+            Array.length tables.tbl_default + Array.length tables.tbl_trans +
+            Array.length tables.tbl_check));
+  let size_groups =
+    (2 * (Array.length tables.tbl_base_code +
+          Array.length tables.tbl_backtrk_code +
+          Array.length tables.tbl_default_code +
+          Array.length tables.tbl_trans_code +
+          Array.length tables.tbl_check_code) +
+    Array.length tables.tbl_code) in
+  if size_groups > 0 && not !Common.quiet_mode then
+    Printf.printf "%d additional bytes used for bindings\n" size_groups;
+  flush stdout;
+  if Array.length tables.tbl_trans > 0x8000 then raise Table_overflow;
+  copy_chunk ic oc oci header false;
+  let has_refill = output_refill_handler ic oc oci rh in
+  output_tables oc tables;
+  let some_mem_code = Array.length tables.tbl_code > 0 in
+  begin match entry_points with
+    [] -> ()
+  | entry1 :: entries ->
+    output_string oc "let rec ";
+    output_entry some_mem_code ic oc has_refill oci entry1;
+      List.iter
+        (fun e ->
+           output_string oc "and ";
+           output_entry some_mem_code ic oc has_refill oci e)
+        entries;
+      output_string oc ";;\n\n";
+  end;
+  copy_chunk ic oc oci trailer false
diff --git a/lex/output.mli b/lex/output.mli
new file mode 100644
index 00000000..13956aa9
--- /dev/null
+++ b/lex/output.mli
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Output the DFA tables and its entry points *)
+
+val output_lexdef:
+      in_channel -> out_channel -> Common.line_tracker ->
+      Syntax.location ->
+      Syntax.location option ->
+      Compact.lex_tables ->
+      (string list, Syntax.location) Lexgen.automata_entry list ->
+      Syntax.location ->
+      unit
+
+exception Table_overflow
diff --git a/lex/outputbis.ml b/lex/outputbis.ml
new file mode 100644
index 00000000..97740b04
--- /dev/null
+++ b/lex/outputbis.ml
@@ -0,0 +1,385 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Output the DFA tables and its entry points *)
+
+open Printf
+open Lexgen
+open Common
+
+type ctx = {
+  oc: out_channel;
+  has_refill: bool;
+  goto_state: (ctx -> string -> int -> unit);
+  last_action: int option;
+}
+
+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";
+  end
+
+let output_memory_actions pref oc = function
+  | []  -> ()
+  | mvs ->
+    output_string oc pref;
+    output_string oc "(* " ;
+    fprintf oc "L=%d " (List.length mvs) ;
+    List.iter
+      (fun mv -> match mv with
+         | Copy (tgt, src) ->
+             fprintf oc "[%d] <- [%d] ;" tgt src
+         | Set tgt ->
+             fprintf oc "[%d] <- p ; " tgt)
+      mvs ;
+    output_string oc " *)\n" ;
+    List.iter
+      (fun mv -> match mv with
+         | Copy (tgt, src) ->
+             fprintf oc
+               "%s%a <- %a ;\n"
+               pref output_mem_access tgt output_mem_access src
+         | Set tgt ->
+             fprintf oc "%s%a <- _curr;\n"
+               pref output_mem_access tgt)
+      mvs
+
+let output_pats ctx = function
+  | [x] -> pr ctx "| %d" x
+  | pats -> List.iter (fun p -> pr ctx "|%d" p) pats
+
+let last_action ctx =
+  match ctx.last_action with
+  | None -> "_last_action"
+  | Some i -> Printf.sprintf "%i (* = last_action *)" i
+
+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;
+      if ctx.has_refill then
+        pr ctx "%sk lexbuf %s\n" pref (last_action ctx)
+      else
+        pr ctx "%s%s\n" pref (last_action ctx)
+  | Goto n ->
+      ctx.goto_state ctx pref n
+
+let output_pat ctx i =
+  if i >= 256 then
+    pr ctx "|eof"
+  else
+    pr ctx "|'%s'" (Char.escaped (Char.chr i))
+
+let output_clause ctx pref pats mems r =
+  pr ctx "%s(* " pref;
+  List.iter (output_pat ctx) pats;
+  pr ctx " *)\n%s" pref;
+  output_pats ctx pats;
+  pr ctx " ->\n";
+  output_action ctx ("  "^pref) mems r
+
+let output_default_clause ctx pref mems r =
+  pr ctx "%s| _ ->\n" pref;
+  output_action ctx ("  "^pref) mems r
+
+let output_moves ctx pref moves =
+  let t = Hashtbl.create 17 in
+  let add_move i (m,mems) =
+    let mems,r = try Hashtbl.find t m with Not_found -> mems,[] in
+    Hashtbl.replace t m (mems,(i::r)) in
+
+  for i = 0 to 256 do
+    add_move i moves.(i)
+  done ;
+
+  let most_frequent = ref Backtrack
+  and most_mems = ref []
+  and size = ref 0 in
+  Hashtbl.iter
+    (fun m (mems,pats) ->
+      let size_m = List.length pats in
+      if size_m > !size then begin
+        most_frequent := m ;
+        most_mems := mems ;
+        size := size_m
+      end)
+    t ;
+  Hashtbl.iter
+    (fun m (mems,pats) ->
+       if m <> !most_frequent then
+         output_clause ctx pref (List.rev pats) mems m)
+    t ;
+  output_default_clause ctx pref !most_mems !most_frequent
+
+
+let output_tag_actions pref ctx mvs =
+  pr ctx "%s(*" pref;
+  List.iter
+    (fun i -> match i with
+    | SetTag (t,m) -> pr ctx " t%d <- [%d] ;" t m
+    | EraseTag t -> pr ctx " t%d <- -1 ;" t)
+    mvs ;
+  pr ctx " *)\n" ;
+  List.iter
+    (fun i ->  match i with
+    | SetTag (t,m) ->
+        pr ctx "%s%a <- %a ;\n"
+          pref output_mem_access t output_mem_access m
+    | EraseTag t ->
+        pr ctx "%s%a <- -1 ;\n"
+          pref output_mem_access t)
+    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
+  | Shift (trans, move) ->
+      let ctx =
+        match trans with
+        | Remember (n,mvs) ->
+            output_tag_actions pref ctx mvs ;
+            pr ctx "%slet _last = _curr in\n" pref;
+            begin match ctx.last_action with
+            | Some i when i = n ->
+                pr ctx "%s(* let _last_action = %d in*)\n" pref n;
+                ctx
+            | _ ->
+                pr ctx "%slet _last_action = %d in\n" pref n;
+                {ctx with last_action = Some n}
+            end
+        | No_remember ->
+            ctx
+      in
+      if ctx.has_refill then begin
+        (* TODO: bind this 'state' function at toplevel instead *)
+        pr ctx
+          "%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
+      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;
+        output_moves ctx (pref ^ "  ") move;
+        pr ctx "%send\n" pref
+      end
+
+let output_automata ctx auto inline =
+  output_auto_defs ctx;
+  let n = Array.length auto in
+  let first = ref true in
+  for i = 0 to n-1 do
+    if not inline.(i) then begin
+      pr ctx
+        "%s __ocaml_lex_state%d lexbuf _last_action _buf _len _curr _last %s=\n"
+        (if !first then "let rec" else "\nand")
+        i
+        (if ctx.has_refill then "k " else "");
+      output_trans_body "  " ctx auto.(i);
+      first := false;
+    end
+  done;
+  pr ctx "\n\n"
+
+
+(* Output the entries *)
+
+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;
+  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;
+  List.iter
+    (fun (num, env, loc) ->
+      pr ctx "%s| %d ->\n" pref num;
+      output_env ic ctx.oc tr env;
+      copy_chunk ic ctx.oc tr loc true;
+      pr ctx "\n")
+    e.auto_actions;
+  pr ctx "%s| _ -> raise (Failure \"lexing: empty token\")\n" pref
+
+let output_entry ic ctx tr e =
+  let init_num, init_moves = e.auto_initial_state in
+  pr ctx "%s %alexbuf =\n" e.auto_name output_args e.auto_args;
+
+  if ctx.has_refill then begin
+    pr ctx "  let k lexbuf __ocaml_lex_result =\n";
+    output_rules ic ctx "    " tr e;
+    pr ctx "  in\n";
+    output_init ctx "  " e init_moves;
+    ctx.goto_state ctx "  " init_num
+  end else begin
+    pr ctx "  let __ocaml_lex_result =\n";
+    output_init ctx "    " e init_moves;
+    ctx.goto_state ctx "    " init_num;
+    pr ctx "  in\n";
+    output_rules ic ctx "  " tr e
+  end;
+  pr ctx "\n\n"
+
+
+(* Determine which states to inline *)
+
+let choose_inlining entry_points transitions =
+  let counters = Array.make (Array.length transitions) 0 in
+  let count i = counters.(i) <- counters.(i) + 1 in
+  List.iter (fun e -> count (fst e.auto_initial_state)) entry_points;
+  Array.iter
+    (function
+      | Shift (_, a) ->
+          let tbl = Hashtbl.create 8 in
+          Array.iter
+            (function
+              | (Goto i, _) when not (Hashtbl.mem tbl i) ->
+                  Hashtbl.add tbl i (); count i
+              | _ -> ()
+            )
+            a
+      | Perform _ -> ()
+    )
+    transitions;
+  Array.mapi
+    (fun i -> function
+       | Perform _ -> true
+       | Shift _ -> counters.(i) = 1
+    )
+    transitions
+
+let goto_state inline transitions ctx pref n =
+  if inline.(n) then
+    output_trans_body pref ctx transitions.(n)
+  else
+    pr ctx "%s__ocaml_lex_state%d lexbuf %s _buf _len _curr _last%s\n"
+      pref n
+      (last_action ctx)
+      (if ctx.has_refill then " k" else "")
+
+(* Main output function *)
+
+let output_lexdef ic oc tr header rh
+                  entry_points transitions trailer =
+
+  copy_chunk ic oc tr header false;
+  let has_refill = output_refill_handler ic oc tr rh in
+  let inline = choose_inlining entry_points transitions in
+  let ctx =
+    {
+      has_refill;
+      oc;
+      goto_state = goto_state inline transitions;
+      last_action = None;
+    }
+  in
+  output_automata ctx transitions inline;
+  begin match entry_points with
+    [] -> ()
+  | entry1 :: entries ->
+    output_string oc "let rec ";
+    output_entry ic ctx tr entry1;
+      List.iter
+        (fun e -> output_string oc "and ";
+          output_entry ic ctx tr e)
+        entries;
+      output_string oc ";;\n\n";
+  end;
+  copy_chunk ic oc tr trailer false
diff --git a/lex/outputbis.mli b/lex/outputbis.mli
new file mode 100644
index 00000000..44eb0e47
--- /dev/null
+++ b/lex/outputbis.mli
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Luc Maranget projet Moscova 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+val output_lexdef :
+  in_channel ->
+  out_channel ->
+  Common.line_tracker ->
+  Syntax.location ->
+  Syntax.location option ->
+  (string list, Syntax.location) Lexgen.automata_entry list ->
+  Lexgen.automata array -> Syntax.location -> unit
diff --git a/lex/parser.mly b/lex/parser.mly
new file mode 100644
index 00000000..0a1bb5d9
--- /dev/null
+++ b/lex/parser.mly
@@ -0,0 +1,202 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* The grammar for lexer definitions */
+
+%{
+open Syntax
+
+(* Auxiliaries for the parser. *)
+
+let named_regexps =
+  (Hashtbl.create 13 : (string, regular_expression) Hashtbl.t)
+
+let regexp_for_string s =
+  let rec re_string n =
+    if n >= String.length s then Epsilon
+    else if succ n = String.length s then
+      Characters (Cset.singleton (Char.code s.[n]))
+    else
+      Sequence
+        (Characters(Cset.singleton (Char.code s.[n])),
+         re_string (succ n))
+  in re_string 0
+
+let rec remove_as = function
+  | Bind (e,_) -> remove_as e
+  | Epsilon|Eof|Characters _ as e -> e
+  | Sequence (e1, e2) -> Sequence (remove_as e1, remove_as e2)
+  | Alternative (e1, e2) -> Alternative (remove_as e1, remove_as e2)
+  | Repetition e -> Repetition (remove_as e)
+
+let as_cset = function
+  | Characters s -> s
+  | _ -> raise Cset.Bad
+
+%}
+
+%token  Tident
+%token  Tchar
+%token  Tstring
+%token  Taction
+%token Trule Tparse Tparse_shortest Tand Tequal Tend Tor Tunderscore Teof
+       Tlbracket Trbracket Trefill
+%token Tstar Tmaybe Tplus Tlparen Trparen Tcaret Tdash Tlet Tas Thash
+
+%right Tas
+%left Tor
+%nonassoc CONCAT
+%nonassoc Tmaybe Tstar Tplus
+%left Thash
+%nonassoc Tident Tchar Tstring Tunderscore Teof Tlbracket Tlparen
+
+%start lexer_definition
+%type  lexer_definition
+
+%%
+
+lexer_definition:
+    header named_regexps refill_handler Trule definition other_definitions
+    header Tend
+        { {header = $1;
+           refill_handler = $3;
+           entrypoints = $5 :: List.rev $6;
+           trailer = $7} }
+;
+header:
+    Taction
+        { $1 }
+  | /*epsilon*/
+        { { loc_file = ""; start_pos = 0; end_pos = 0; start_line = 1;
+            start_col = 0 } }
+;
+named_regexps:
+    named_regexps Tlet Tident Tequal regexp
+        { Hashtbl.add named_regexps $3 $5 }
+  | /*epsilon*/
+        { () }
+;
+other_definitions:
+    other_definitions Tand definition
+        { $3::$1 }
+  | /*epsilon*/
+        { [] }
+;
+refill_handler:
+  | Trefill Taction { Some $2 }
+  | /*empty*/ { None }
+;
+definition:
+    Tident arguments Tequal Tparse entry
+        { {name=$1 ; shortest=false ; args=$2 ; clauses=$5} }
+  |  Tident arguments Tequal Tparse_shortest entry
+        { {name=$1 ; shortest=true ; args=$2 ; clauses=$5} }
+;
+
+arguments:
+    Tident arguments        { $1::$2 }
+|     /*epsilon*/           { [] }
+;
+
+
+entry:
+    case rest_of_entry
+        { $1::List.rev $2 }
+|   Tor case rest_of_entry
+        { $2::List.rev $3 }
+;
+
+rest_of_entry:
+    rest_of_entry Tor case
+        { $3::$1 }
+  |
+        { [] }
+;
+case:
+    regexp Taction
+        { ($1,$2) }
+;
+regexp:
+    Tunderscore
+        { Characters Cset.all_chars }
+  | Teof
+        { Eof }
+  | Tchar
+        { Characters (Cset.singleton $1) }
+  | Tstring
+        { regexp_for_string $1 }
+  | Tlbracket char_class Trbracket
+        { Characters $2 }
+  | regexp Tstar
+        { Repetition $1 }
+  | regexp Tmaybe
+        { Alternative(Epsilon, $1) }
+  | regexp Tplus
+        { Sequence(Repetition (remove_as $1), $1) }
+  | regexp Thash regexp
+        {
+          let s1 = as_cset $1
+          and s2 = as_cset $3 in
+          Characters (Cset.diff s1 s2)
+        }
+  | regexp Tor regexp
+        { Alternative($1,$3) }
+  | regexp regexp %prec CONCAT
+        { Sequence($1,$2) }
+  | Tlparen regexp Trparen
+        { $2 }
+  | Tident
+        { try
+            Hashtbl.find named_regexps $1
+          with Not_found ->
+            let p = Parsing.symbol_start_pos () in
+            Printf.eprintf "File \"%s\", line %d, character %d:\n\
+                             Reference to unbound regexp name `%s'.\n"
+                           p.Lexing.pos_fname p.Lexing.pos_lnum
+                           (p.Lexing.pos_cnum - p.Lexing.pos_bol)
+                           $1;
+            exit 2 }
+  | regexp Tas ident
+        {let p1 = Parsing.rhs_start_pos 3
+         and p2 = Parsing.rhs_end_pos 3 in
+         let p = {
+           loc_file = p1.Lexing.pos_fname ;
+           start_pos = p1.Lexing.pos_cnum ;
+           end_pos = p2.Lexing.pos_cnum ;
+           start_line = p1.Lexing.pos_lnum ;
+           start_col = p1.Lexing.pos_cnum - p1.Lexing.pos_bol ; } in
+         Bind ($1, ($3, p))}
+;
+
+ident:
+  Tident {$1}
+;
+
+char_class:
+    Tcaret char_class1
+        { Cset.complement $2 }
+  | char_class1
+        { $1 }
+;
+char_class1:
+    Tchar Tdash Tchar
+        { Cset.interval $1 $3 }
+  | Tchar
+        { Cset.singleton $1 }
+  | char_class1 char_class1 %prec CONCAT
+        { Cset.union $1 $2 }
+;
+
+%%
diff --git a/lex/syntax.ml b/lex/syntax.ml
new file mode 100644
index 00000000..61a9d793
--- /dev/null
+++ b/lex/syntax.ml
@@ -0,0 +1,49 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* This apparently useless implementation file is in fact required
+   by the pa_ocamllex syntax extension *)
+
+(* The shallow abstract syntax *)
+
+type location = {
+  loc_file : string;
+  start_pos : int;
+  end_pos : int;
+  start_line : int;
+  start_col : int;
+}
+
+type regular_expression =
+    Epsilon
+  | Characters of Cset.t
+  | Eof
+  | Sequence of regular_expression * regular_expression
+  | Alternative of regular_expression * regular_expression
+  | Repetition of regular_expression
+  | Bind of regular_expression * (string * location)
+
+type ('arg,'action) entry =
+  {name:string ;
+   shortest : bool ;
+   args : 'arg ;
+   clauses : (regular_expression * 'action) list}
+
+type lexer_definition = {
+  header: location;
+  entrypoints: ((string list, location) entry) list;
+  trailer: location;
+  refill_handler : location option;
+}
diff --git a/lex/syntax.mli b/lex/syntax.mli
new file mode 100644
index 00000000..eb0acefa
--- /dev/null
+++ b/lex/syntax.mli
@@ -0,0 +1,46 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The shallow abstract syntax *)
+
+type location = {
+  loc_file : string;
+  start_pos : int;
+  end_pos : int;
+  start_line : int;
+  start_col : int;
+}
+
+type regular_expression =
+    Epsilon
+  | Characters of Cset.t
+  | Eof
+  | Sequence of regular_expression * regular_expression
+  | Alternative of regular_expression * regular_expression
+  | Repetition of regular_expression
+  | Bind of regular_expression * (string * location)
+
+type ('arg,'action) entry =
+  {name:string ;
+   shortest : bool ;
+   args : 'arg ;
+   clauses : (regular_expression * 'action) list}
+
+type lexer_definition = {
+  header: location;
+  entrypoints: ((string list, location) entry) list;
+  trailer: location;
+  refill_handler : location option;
+}
diff --git a/lex/table.ml b/lex/table.ml
new file mode 100644
index 00000000..7e0b9d0c
--- /dev/null
+++ b/lex/table.ml
@@ -0,0 +1,59 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Luc Maranget, projet Moscova, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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 'a t = {mutable next : int ; mutable data : 'a array}
+
+let default_size = 32
+;;
+
+let create x = {next = 0 ; data = Array.make default_size x}
+and reset t = t.next <- 0
+;;
+
+let incr_table table new_size =
+  let t = Array.make new_size table.data.(0) in
+  Array.blit table.data 0 t 0 (Array.length table.data) ;
+  table.data <- t
+
+let emit table i =
+ let size = Array.length table.data in
+ if table.next >= size then
+    incr_table table (2*size);
+ table.data.(table.next) <- i ;
+ table.next <- table.next + 1
+;;
+
+
+exception Error
+
+let get t i =
+  if 0 <= i && i < t.next then
+    t.data.(i)
+  else
+    raise Error
+
+let trim t =
+  let r = Array.sub t.data 0 t.next in
+  reset t ;
+  r
+
+let iter t f =
+  let size = t.next
+  and data = t.data in
+  for i = 0 to size-1 do
+    f data.(i)
+  done
+
+let size t = t.next
diff --git a/lex/table.mli b/lex/table.mli
new file mode 100644
index 00000000..492626b9
--- /dev/null
+++ b/lex/table.mli
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Luc Maranget, projet Moscova, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Table used for code emission, ie extensible arrays *)
+type 'a t
+
+val create : 'a -> 'a t
+
+val emit : 'a t -> 'a -> unit
+
+val iter : 'a t -> ('a -> unit) -> unit
+
+val trim : 'a t -> 'a array
+
+
+exception Error
+
+val get : 'a t -> int -> 'a
+
+
+
+val size : 'a t -> int
diff --git a/man/Makefile b/man/Makefile
new file mode 100644
index 00000000..52d1c19f
--- /dev/null
+++ b/man/Makefile
@@ -0,0 +1,30 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+ROOTDIR = ..
+include $(ROOTDIR)/Makefile.config
+
+DESTDIR ?=
+INSTALL_DIR=$(DESTDIR)$(MANDIR)/man$(PROGRAMS_MAN_SECTION)
+
+install:
+	for i in *.m; do cp \
+	  $$i $(INSTALL_DIR)/`basename $$i .m`.$(PROGRAMS_MAN_SECTION); done
+	echo '.so man$(PROGRAMS_MAN_SECTION)/ocamlc.$(PROGRAMS_MAN_SECTION)' \
+	     > $(INSTALL_DIR)/ocamlc.opt.$(PROGRAMS_MAN_SECTION)
+	echo '.so man$(PROGRAMS_MAN_SECTION)/ocamlopt.$(PROGRAMS_MAN_SECTION)' \
+	     > $(INSTALL_DIR)/ocamlopt.opt.$(PROGRAMS_MAN_SECTION)
+	echo '.so man$(PROGRAMS_MAN_SECTION)/ocamlcp.$(PROGRAMS_MAN_SECTION)' \
+	     > $(INSTALL_DIR)/ocamloptp.$(PROGRAMS_MAN_SECTION)
diff --git a/man/ocaml.m b/man/ocaml.m
new file mode 100644
index 00000000..63b84a6b
--- /dev/null
+++ b/man/ocaml.m
@@ -0,0 +1,344 @@
+.\"**************************************************************************
+.\"*                                                                        *
+.\"*                                 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.          *
+.\"*                                                                        *
+.\"**************************************************************************
+.\"
+.TH OCAML 1
+
+.SH NAME
+ocaml \- The OCaml interactive toplevel
+
+.SH SYNOPSIS
+.B ocaml
+[
+.I options
+]
+[
+.I object-files
+]
+[
+.I script-file
+]
+.SH DESCRIPTION
+
+The
+.BR ocaml (1)
+command is the toplevel system for OCaml,
+that permits interactive use of the OCaml system through a
+read-eval-print loop. In this mode, the system repeatedly reads OCaml
+phrases from the input, then typechecks, compiles and evaluates
+them, then prints the inferred type and result value, if any. The
+system prints a # (hash) prompt before reading each phrase.
+
+A toplevel phrase can span several lines. It is terminated by ;; (a
+double-semicolon). The syntax of toplevel phrases is as follows.
+
+The toplevel system is started by the command
+.BR ocaml (1).
+Phrases are read on standard input, results are printed on standard
+output, errors on standard error. End-of-file on standard input
+terminates
+.BR ocaml (1).
+
+If one or more
+.I object-files
+(ending in .cmo or .cma) are given, they are loaded silently before
+starting the toplevel.
+
+If a
+.I script-file
+is given, phrases are read silently from the file, errors printed on
+standard error.
+.BR ocaml (1)
+exits after the execution of the last phrase.
+
+.SH OPTIONS
+
+The following command-line options are recognized by
+.BR ocaml (1).
+.TP
+.B \-absname
+Show absolute filenames in error messages.
+.TP
+.BI \-I \ directory
+Add the given directory to the list of directories searched for
+source and compiled files. By default, the current directory is
+searched first, then the standard library directory. Directories added
+with
+.B \-I
+are searched after the current directory, in the order in which they
+were given on the command line, but before the standard library
+directory.
+.IP
+If the given directory starts with
+.BR + ,
+it is taken relative to the
+standard library directory. For instance,
+.B \-I\ +compiler-libs
+adds the subdirectory
+.B compiler-libs
+of the standard library to the search path.
+.IP
+Directories can also be added to the search path once the toplevel
+is running with the
+.B #directory
+directive.
+.TP
+.BI \-init \ file
+Load the given file instead of the default initialization file.
+See the "Initialization file" section below.
+.TP
+.B \-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.
+.TP
+.B \-no\-app\-funct
+Deactivates the applicative behaviour of functors. With this option,
+each functor application generates new types in its result and
+applying the same functor twice to the same argument yields two
+incompatible structures.
+.TP
+.B \-noassert
+Do not compile assertion checks.  Note that the special form
+.B assert\ false
+is always compiled because it is typed specially.
+.TP
+.B \-noinit
+Do not load any initialization file.
+See the "Initialization file" section below.
+.TP
+.B \-nolabels
+Ignore non-optional labels in types. Labels cannot be used in
+applications, and parameter order becomes strict.
+.TP
+.B \-noprompt
+Do not display any prompt when waiting for input.
+.TP
+.B \-nopromptcont
+Do not display the secondary prompt when waiting for continuation lines in
+multi-line inputs.  This should be used e.g. when running
+.BR ocaml (1)
+in an
+.BR emacs (1)
+window.
+.TP
+.B \-nostdlib
+Do not include the standard library directory in the list of
+directories searched for source and compiled files.
+.TP
+.BI \-open \ module
+Opens the given module before starting the toplevel. If several
+.B \-open
+options are given, they are processed in order, just as if
+the statements open! module1;; ... open! moduleN;; were input.
+.TP
+.BI \-ppx \ command
+After parsing, pipe the abstract syntax tree through the preprocessor
+.IR command .
+The module
+.BR Ast_mapper (3)
+implements the external interface of a preprocessor.
+.TP
+.B \-principal
+Check information path during type-checking, to make sure that all
+types are derived in a principal way.  When using labelled arguments
+and/or polymorphic methods, this flag is required to ensure future
+versions of the compiler will be able to infer types correctly, even
+if internal algorithms change.
+All programs accepted in
+.B \-principal
+mode are also accepted in the
+default mode with equivalent types, but different binary signatures,
+and this may slow down type checking; yet it is a good idea to
+use it once before publishing source code.
+.TP
+.B \-rectypes
+Allow arbitrary recursive types during type-checking.  By default,
+only recursive types where the recursion goes through an object type
+are supported.
+.TP
+.B \-safe\-string
+Enforce the separation between types
+.BR string \ and\  bytes ,
+thereby making strings read-only. This is the default.
+.TP
+.B \-short\-paths
+When a type is visible under several module-paths, use the shortest
+one when printing the type's name in inferred interfaces and error and
+warning messages.
+.TP
+.B \-stdin
+Read the standard input as a script file rather than starting an
+interactive session.
+.TP
+.B \-strict\-sequence
+Force the left-hand part of each sequence to have type unit.
+.TP
+.B \-unboxed\-types
+When a type is unboxable (i.e. a record with a single argument or a
+concrete datatype with a single constructor of one argument) it will
+be unboxed unless annotated with
+.BR [@@ocaml.boxed] .
+.TP
+.B \-no-unboxed\-types
+When a type is unboxable  it will be boxed unless annotated with
+.BR [@@ocaml.unboxed] .
+This is the default.
+.TP
+.B \-unsafe
+Turn bound checking off on array and string accesses (the
+.BR v.(i) and s.[i]
+constructs). Programs compiled with
+.B \-unsafe
+are therefore slightly faster, but unsafe: anything can happen if the program
+accesses an array or string outside of its bounds.
+.TP
+.B \-unsafe\-string
+Identify the types
+.BR string \ and\  bytes ,
+thereby making strings writable.
+This is intended for compatibility with old source code and should not
+be used with new software.
+.TP
+.B \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+.TP
+.B \-no\-version
+Do not print the version banner at startup.
+.TP
+.BI \-w \ warning\-list
+Enable or disable warnings according to the argument
+.IR warning-list .
+See
+.BR ocamlc (1)
+for the syntax of the
+.I warning\-list
+argument.
+.TP
+.BI \-warn\-error \ warning\-list
+Mark as fatal the warnings described by the argument
+.IR warning\-list .
+Note that a warning is not triggered (and does not trigger an error) if
+it is disabled by the
+.B \-w
+option.  See
+.BR ocamlc (1)
+for the syntax of the
+.I warning\-list
+argument.
+.TP
+.BI \-color \ mode
+Enable or disable colors in compiler messages (especially warnings and errors).
+The following modes are supported:
+
+.B auto
+use heuristics to enable colors only if the output supports them (an
+ANSI-compatible tty terminal);
+
+.B always
+enable colors unconditionally;
+
+.B never
+disable color output.
+
+The default setting is
+.B auto,
+and the current heuristic
+checks that the "TERM" environment variable exists and is
+not empty or "dumb", and that isatty(stderr) holds.
+
+The environment variable "OCAML_COLOR" is considered if \-color is not
+provided. Its values are auto/always/never as above.
+
+.TP
+.BI \-error\-style \ mode
+Control the way error messages and warnings are printed.
+The following modes are supported:
+
+.B short
+only print the error and its location;
+
+.B contextual
+like "short", but also display the source code snippet corresponding
+to the location of the error.
+
+The default setting is
+.B contextual.
+
+The environment variable "OCAML_ERROR_STYLE" is considered if
+\-error\-style is not provided. Its values are short/contextual as
+above.
+
+.TP
+.B \-warn\-help
+Show the description of all available warning numbers.
+.TP
+.BI \- \ file
+Use
+.I file
+as a script file name, even when it starts with a hyphen (-).
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+
+.SH INITIALIZATION FILE
+
+When
+.BR ocaml (1)
+is invoked, it will read phrases from an initialization file before
+giving control to the user. The default file is
+.B .ocamlinit
+in the current directory if it exists, otherwise
+.B XDG_CONFIG_HOME/ocaml/init.ml
+according to the XDG base directory specification lookup if it exists (on
+Windows this is skipped), otherwise
+.B .ocamlinit
+in the user's home directory (
+.B HOME
+variable).
+You can specify a different initialization file
+by using the
+.BI \-init \ file
+option, and disable initialization files by using the
+.B \-noinit
+option.
+
+Note that you can also use the
+.B #use
+directive to read phrases from a file.
+
+.SH ENVIRONMENT VARIABLES
+.TP
+.B OCAMLTOP_UTF_8
+When printing string values, non-ascii bytes (>0x7E) are printed as
+decimal escape sequence if
+.B OCAMLTOP_UTF_8
+is set to false. Otherwise they are printed unescaped.
+.TP
+.B TERM
+When printing error messages, the toplevel system
+attempts to underline visually the location of the error. It
+consults the TERM variable to determines the type of output terminal
+and look up its capabilities in the terminal database.
+.TP
+.B XDG_CONFIG_HOME HOME
+.B .ocamlinit
+lookup procedure (see above).
+.SH SEE ALSO
+.BR ocamlc (1), \ ocamlopt (1), \ ocamlrun (1).
+.br
+.IR The\ OCaml\ user's\ manual ,
+chapter "The toplevel system".
diff --git a/man/ocamlc.m b/man/ocamlc.m
new file mode 100644
index 00000000..3f2b387d
--- /dev/null
+++ b/man/ocamlc.m
@@ -0,0 +1,1073 @@
+.\"**************************************************************************
+.\"*                                                                        *
+.\"*                                 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.          *
+.\"*                                                                        *
+.\"**************************************************************************
+.\"
+.TH OCAMLC 1
+
+.SH NAME
+ocamlc \- The OCaml bytecode compiler
+
+.SH SYNOPSIS
+.B ocamlc
+[
+.I options
+]
+.I filename ...
+
+.B ocamlc.opt
+[
+.I options
+]
+.I filename ...
+
+.SH DESCRIPTION
+
+The OCaml bytecode compiler
+.BR ocamlc (1)
+compiles OCaml source files to bytecode object files and links
+these object files to produce standalone bytecode executable files.
+These executable files are then run by the bytecode interpreter
+.BR ocamlrun (1).
+
+The
+.BR ocamlc (1)
+command has a command-line interface similar to the one of
+most C compilers. It accepts several types of arguments and processes them
+sequentially, after all options have been processed:
+
+Arguments ending in .mli are taken to be source files for
+compilation unit interfaces. Interfaces specify the names exported by
+compilation units: they declare value names with their types, define
+public data types, declare abstract data types, and so on. From the
+file
+.IR x \&.mli,
+the
+.BR ocamlc (1)
+compiler produces a compiled interface
+in the file
+.IR x \&.cmi.
+
+Arguments ending in .ml are taken to be source files for compilation
+unit implementations. Implementations provide definitions for the
+names exported by the unit, and also contain expressions to be
+evaluated for their side-effects.  From the file
+.IR x \&.ml,
+the
+.BR ocamlc (1)
+compiler produces compiled object bytecode in the file
+.IR x \&.cmo.
+
+If the interface file
+.IR x \&.mli
+exists, the implementation
+.IR x \&.ml
+is checked against the corresponding compiled interface
+.IR x \&.cmi,
+which is assumed to exist. If no interface
+.IR x \&.mli
+is provided, the compilation of
+.IR x \&.ml
+produces a compiled interface file
+.IR x \&.cmi
+in addition to the compiled object code file
+.IR x \&.cmo.
+The file
+.IR x \&.cmi
+produced
+corresponds to an interface that exports everything that is defined in
+the implementation
+.IR x \&.ml.
+
+Arguments ending in .cmo are taken to be compiled object bytecode.  These
+files are linked together, along with the object files obtained
+by compiling .ml arguments (if any), and the OCaml standard
+library, to produce a standalone executable program. The order in
+which .cmo and.ml arguments are presented on the command line is
+relevant: compilation units are initialized in that order at
+run-time, and it is a link-time error to use a component of a unit
+before having initialized it. Hence, a given
+.IR x \&.cmo
+file must come before all .cmo files that refer to the unit
+.IR x .
+
+Arguments ending in .cma are taken to be libraries of object bytecode.
+A library of object bytecode packs in a single file a set of object
+bytecode files (.cmo files). Libraries are built with
+.B ocamlc\ \-a
+(see the description of the
+.B \-a
+option below). The object files
+contained in the library are linked as regular .cmo files (see above),
+in the order specified when the .cma file was built. The only
+difference is that if an object file
+contained in a library is not referenced anywhere in the program, then
+it is not linked in.
+
+Arguments ending in .c are passed to the C compiler, which generates
+a .o object file. This object file is linked with the program if the
+.B \-custom
+flag is set (see the description of
+.B \-custom
+below).
+
+Arguments ending in .o or .a are assumed to be C object files and
+libraries. They are passed to the C linker when linking in
+.B \-custom
+mode (see the description of
+.B \-custom
+below).
+
+Arguments ending in .so
+are assumed to be C shared libraries (DLLs).  During linking, they are
+searched for external C functions referenced from the OCaml code,
+and their names are written in the generated bytecode executable.
+The run-time system
+.BR ocamlrun (1)
+then loads them dynamically at program start-up time.
+
+The output of the linking phase is a file containing compiled bytecode
+that can be executed by the OCaml bytecode interpreter:
+the command
+.BR ocamlrun (1).
+If
+.B caml.out
+is the name of the file produced by the linking phase, the command
+.B ocamlrun caml.out
+.IR arg1 \  \ arg2 \ ... \ argn
+executes the compiled code contained in
+.BR caml.out ,
+passing it as arguments the character strings
+.I arg1
+to
+.IR argn .
+(See
+.BR ocamlrun (1)
+for more details.)
+
+On most systems, the file produced by the linking
+phase can be run directly, as in:
+.B ./caml.out
+.IR arg1 \  \ arg2 \ ... \ argn .
+The produced file has the executable bit set, and it manages to launch
+the bytecode interpreter by itself.
+
+.B ocamlc.opt
+is the same compiler as
+.BR ocamlc ,
+but compiled with the native-code compiler
+.BR ocamlopt (1).
+Thus, it behaves exactly like
+.BR ocamlc ,
+but compiles faster.
+.B ocamlc.opt
+may not be available in all installations of OCaml.
+
+.SH OPTIONS
+
+The following command-line options are recognized by
+.BR ocamlc (1).
+.TP
+.B \-a
+Build a library (.cma file) with the object files (.cmo files) given
+on the command line, instead of linking them into an executable
+file. The name of the library must be set with the
+.B \-o
+option.
+.IP
+If
+.BR \-custom , \ \-cclib \ or \ \-ccopt
+options are passed on the command
+line, these options are stored in the resulting .cma library.  Then,
+linking with this library automatically adds back the
+.BR \-custom , \ \-cclib \ and \ \-ccopt
+options as if they had been provided on the
+command line, unless the
+.B \-noautolink
+option is given. Additionally, a substring
+.B $CAMLORIGIN
+inside a
+.BR \ \-ccopt
+options will be replaced by the full path to the .cma library,
+excluding the filename.
+.B \-absname
+Show absolute filenames in error messages.
+.TP
+.B \-annot
+Deprecated since 4.11. Please use
+.BR \-bin-annot
+instead.
+.TP
+.B \-bin\-annot
+Dump detailed information about the compilation (types, bindings,
+tail-calls, etc) in binary format. The information for file
+.IR src .ml
+is put into file
+.IR src .cmt.
+In case of a type error, dump
+all the information inferred by the type-checker before the error.
+The annotation files produced by
+.B \-bin\-annot
+contain more information
+and are much more compact than the files produced by
+.BR \-annot .
+.TP
+.B \-c
+Compile only. Suppress the linking phase of the
+compilation. Source code files are turned into compiled files, but no
+executable file is produced. This option is useful to
+compile modules separately.
+.TP
+.BI \-cc \ ccomp
+Use
+.I ccomp
+as the C linker when linking in "custom runtime" mode (see the
+.B \-custom
+option) and as the C compiler for compiling .c source files.
+.TP
+.BI \-cclib\ -l libname
+Pass the
+.BI \-l libname
+option to the C linker when linking in "custom runtime" mode (see the
+.B \-custom
+option). This causes the given C library to be linked with the program.
+.TP
+.BI \-ccopt \ option
+Pass the given
+.I option
+to the C compiler and linker, when linking in
+"custom runtime" mode (see the
+.B \-custom
+option). For instance,
+.BI \-ccopt\ \-L dir
+causes the C linker to search for C libraries in
+directory
+.IR dir .
+.TP
+.BI \-color \ mode
+Enable or disable colors in compiler messages (especially warnings and errors).
+The following modes are supported:
+
+.B auto
+use heuristics to enable colors only if the output supports them (an
+ANSI-compatible tty terminal);
+
+.B always
+enable colors unconditionally;
+
+.B never
+disable color output.
+
+The default setting is
+.B auto,
+and the current heuristic
+checks that the "TERM" environment variable exists and is
+not empty or "dumb", and that isatty(stderr) holds.
+
+The environment variable "OCAML_COLOR" is considered if \-color is not
+provided. Its values are auto/always/never as above.
+
+.TP
+.BI \-error\-style \ mode
+Control the way error messages and warnings are printed.
+The following modes are supported:
+
+.B short
+only print the error and its location;
+
+.B contextual
+like "short", but also display the source code snippet corresponding
+to the location of the error.
+
+The default setting is
+.B contextual.
+
+The environment variable "OCAML_ERROR_STYLE" is considered if
+\-error\-style is not provided. Its values are short/contextual as
+above.
+
+.TP
+.B \-compat\-32
+Check that the generated bytecode executable can run on 32-bit
+platforms and signal an error if it cannot. This is useful when
+compiling bytecode on a 64-bit machine.
+.TP
+.B \-config
+Print the version number of
+.BR ocamlc (1)
+and a detailed summary of its configuration, then exit.
+.TP
+.BI \-config-var
+Print the value of a specific configuration variable
+from the
+.B \-config
+output, then exit. If the variable does not exist,
+the exit code is non-zero.
+.TP
+.B \-custom
+Link in "custom runtime" mode. In the default linking mode, the
+linker produces bytecode that is intended to be executed with the
+shared runtime system,
+.BR ocamlrun (1).
+In the custom runtime mode, the
+linker produces an output file that contains both the runtime system
+and the bytecode for the program. The resulting file is larger, but it
+can be executed directly, even if the
+.BR ocamlrun (1)
+command is not
+installed. Moreover, the "custom runtime" mode enables linking OCaml
+code with user-defined C functions.
+
+Never use the
+.BR strip (1)
+command on executables produced by
+.BR ocamlc\ \-custom ,
+this would remove the bytecode part of the executable.
+
+Security warning: never set the "setuid" or "setgid" bits on
+executables produced by
+.BR ocamlc\ \-custom ,
+this would make them vulnerable to attacks.
+.TP
+.BI \-depend\ ocamldep-args
+Compute dependencies, as ocamldep would do.
+.TP
+.BI \-dllib\ \-l libname
+Arrange for the C shared library
+.BI dll libname .so
+to be loaded dynamically by the run-time system
+.BR ocamlrun (1)
+at program start-up time.
+.TP
+.BI \-dllpath \ dir
+Adds the directory
+.I dir
+to the run-time search path for shared
+C libraries.  At link-time, shared libraries are searched in the
+standard search path (the one corresponding to the
+.B \-I
+option).
+The
+.B \-dllpath
+option simply stores
+.I dir
+in the produced
+executable file, where
+.BR ocamlrun (1)
+can find it and use it.
+.TP
+.BI \-for\-pack \ module\-path
+Generate an object file (.cmo file) that can later be included
+as a sub-module (with the given access path) of a compilation unit
+constructed with
+.BR \-pack .
+For instance,
+.B ocamlc\ \-for\-pack\ P\ \-c\ A.ml
+will generate a.cmo that can later be used with
+.BR "ocamlc -pack -o P.cmo a.cmo" .
+Note: you can still pack a module that was compiled without
+.B \-for\-pack
+but in this case exceptions will be printed with the wrong names.
+.TP
+.B \-g
+Add debugging information while compiling and linking. This option is
+required in order to be able to debug the program with
+.BR ocamldebug (1)
+and to produce stack backtraces when
+the program terminates on an uncaught exception.
+.TP
+.B \-i
+Cause the compiler to print all defined names (with their inferred
+types or their definitions) when compiling an implementation (.ml
+file). No compiled files (.cmo and .cmi files) are produced.
+This can be useful to check the types inferred by the
+compiler. Also, since the output follows the syntax of interfaces, it
+can help in writing an explicit interface (.mli file) for a file: just
+redirect the standard output of the compiler to a .mli file, and edit
+that file to remove all declarations of unexported names.
+.TP
+.BI \-I \ directory
+Add the given directory to the list of directories searched for
+compiled interface files (.cmi), compiled object code files
+(.cmo), libraries (.cma), and C libraries specified with
+.BI \-cclib\ \-l xxx
+.RB .
+By default, the current directory is searched first, then the
+standard library directory. Directories added with
+.B \-I
+are searched
+after the current directory, in the order in which they were given on
+the command line, but before the standard library directory. See also
+option
+.BR \-nostdlib .
+
+If the given directory starts with
+.BR + ,
+it is taken relative to the
+standard library directory. For instance,
+.B \-I\ +compiler-libs
+adds the subdirectory
+.B compiler-libs
+of the standard library to the search path.
+.TP
+.BI \-impl \ filename
+Compile the file
+.I filename
+as an implementation file, even if its extension is not .ml.
+.TP
+.BI \-intf \ filename
+Compile the file
+.I filename
+as an interface file, even if its extension is not .mli.
+.TP
+.BI \-intf\-suffix \ string
+Recognize file names ending with
+.I string
+as interface files (instead of the default .mli).
+.TP
+.B \-keep-docs
+Keep documentation strings in generated .cmi files.
+.TP
+.B \-keep-locs
+Keep locations in generated .cmi files.
+.TP
+.B \-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.
+.TP
+.B \-linkall
+Force all modules contained in libraries to be linked in. If this
+flag is not given, unreferenced modules are not linked in. When
+building a library (option
+.BR \-a ),
+setting the
+.B \-linkall
+option forces all subsequent links of programs involving that library
+to link all the modules contained in the library.
+When compiling a module (option
+.BR \-c ),
+setting the
+.B \-linkall
+option ensures that this module will
+always be linked if it is put in a library and this library is linked.
+.TP
+.B \-make\-runtime
+Build a custom runtime system (in the file specified by option
+.BR \-o )
+incorporating the C object files and libraries given on the command
+line.  This custom runtime system can be used later to execute
+bytecode executables produced with the option
+.B ocamlc\ \-use\-runtime
+.IR runtime-name .
+.TP
+.B \-match\-context\-rows
+Set number of rows of context used during pattern matching
+compilation. Lower values cause faster compilation, but
+less optimized code. The default value is 32.
+.TP
+.B \-no-alias-deps
+Do not record dependencies for module aliases.
+.TP
+.B \-no\-app\-funct
+Deactivates the applicative behaviour of functors. With this option,
+each functor application generates new types in its result and
+applying the same functor twice to the same argument yields two
+incompatible structures.
+.TP
+.B \-noassert
+Do not compile assertion checks.  Note that the special form
+.B assert\ false
+is always compiled because it is typed specially.
+This flag has no effect when linking already-compiled files.
+.TP
+.B \-noautolink
+When linking .cma libraries, ignore
+.BR \-custom , \ \-cclib \ and \ \-ccopt
+options potentially contained in the libraries (if these options were
+given when building the libraries).  This can be useful if a library
+contains incorrect specifications of C libraries or C options; in this
+case, during linking, set
+.B \-noautolink
+and pass the correct C libraries and options on the command line.
+.TP
+.B \-nolabels
+Ignore non-optional labels in types. Labels cannot be used in
+applications, and parameter order becomes strict.
+.TP
+.B \-nostdlib
+Do not automatically add the standard library directory to the list of
+directories searched for compiled interface files (.cmi), compiled
+object code files (.cmo), libraries (.cma), and C libraries specified
+with
+.BI \-cclib\ \-l xxx
+.RB .
+See also option
+.BR \-I .
+.TP
+.BI \-o \ exec\-file
+Specify the name of the output file produced by the linker. The
+default output name is
+.BR a.out ,
+in keeping with the Unix tradition. If the
+.B \-a
+option is given, specify the name of the library
+produced.  If the
+.B \-pack
+option is given, specify the name of the
+packed object file produced.  If the
+.B \-output\-obj
+option is given,
+specify the name of the output file produced.
+This can also be used when compiling an interface or implementation
+file, without linking, in which case it sets the name of the cmi or
+cmo file, and also sets the module name to the file name up to the
+first dot.
+.TP
+.B \-opaque
+Interface file compiled with this option are marked so that other
+compilation units depending on it will not rely on any implementation
+details of the compiled implementation. The native compiler will not
+access the .cmx file of this unit -- nor warn if it is absent. This can
+improve speed of compilation, for both initial and incremental builds,
+at the expense of performance of the generated code.
+.TP
+.BI \-open \ module
+Opens the given module before processing the interface or
+implementation files. If several
+.B \-open
+options are given, they are processed in order, just as if
+the statements open! module1;; ... open! moduleN;; were added
+at the top of each file.
+.TP
+.B \-output\-obj
+Cause the linker to produce a C object file instead of a bytecode
+executable file. This is useful to wrap OCaml code as a C library,
+callable from any C program. The name of the output object file
+must be set with the
+.B \-o
+option. This
+option can also be used to produce a C source file (.c extension) or
+a compiled shared/dynamic library (.so extension).
+.TP
+.B \-pack
+Build a bytecode object file (.cmo file) and its associated compiled
+interface (.cmi) that combines the object
+files given on the command line, making them appear as sub-modules of
+the output .cmo file.  The name of the output .cmo file must be
+given with the
+.B \-o
+option.  For instance,
+.B ocamlc\ \-pack\ \-o\ p.cmo\ a.cmo\ b.cmo\ c.cmo
+generates compiled files p.cmo and p.cmi describing a compilation
+unit having three sub-modules A, B and C, corresponding to the
+contents of the object files a.cmo, b.cmo and c.cmo.  These
+contents can be referenced as P.A, P.B and P.C in the remainder
+of the program.
+.TP
+.BI \-pp \ command
+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.
+.TP
+.BI \-ppx \ command
+After parsing, pipe the abstract syntax tree through the preprocessor
+.IR command .
+The module
+.BR Ast_mapper (3)
+implements the external interface of a preprocessor.
+.TP
+.B \-principal
+Check information path during type-checking, to make sure that all
+types are derived in a principal way.  When using labelled arguments
+and/or polymorphic methods, this flag is required to ensure future
+versions of the compiler will be able to infer types correctly, even
+if internal algorithms change.
+All programs accepted in
+.B \-principal
+mode are also accepted in the
+default mode with equivalent types, but different binary signatures,
+and this may slow down type checking; yet it is a good idea to
+use it once before publishing source code.
+.TP
+.B \-rectypes
+Allow arbitrary recursive types during type-checking.  By default,
+only recursive types where the recursion goes through an object type
+are supported. Note that once you have created an interface using this
+flag, you must use it again for all dependencies.
+.TP
+.BI \-runtime\-variant \ suffix
+Add
+.I suffix
+to the name of the runtime library that will be used by the program.
+If OCaml was configured with option
+.BR \-with\-debug\-runtime ,
+then the
+.B d
+suffix is supported and gives a debug version of the runtime.
+.TP
+.BI \-stop\-after \ pass
+Stop compilation after the given compilation pass. The currently
+supported passes are:
+.BR parsing ,
+.BR typing .
+.TP
+.B \-safe\-string
+Enforce the separation between types
+.BR string \ and\  bytes ,
+thereby making strings read-only. This is the default.
+.TP
+.B \-short\-paths
+When a type is visible under several module-paths, use the shortest
+one when printing the type's name in inferred interfaces and error and
+warning messages.
+.TP
+.B \-strict\-sequence
+Force the left-hand part of each sequence to have type unit.
+.TP
+.B \-unboxed\-types
+When a type is unboxable (i.e. a record with a single argument or a
+concrete datatype with a single constructor of one argument) it will
+be unboxed unless annotated with
+.BR [@@ocaml.boxed] .
+.TP
+.B \-no-unboxed\-types
+When a type is unboxable  it will be boxed unless annotated with
+.BR [@@ocaml.unboxed] .
+This is the default.
+.TP
+.B \-unsafe
+Turn bound checking off for array and string accesses (the
+.BR v.(i) and s.[i]
+constructs). Programs compiled with
+.B \-unsafe
+are therefore
+slightly faster, but unsafe: anything can happen if the program
+accesses an array or string outside of its bounds.
+.TP
+.B \-unsafe\-string
+Identify the types
+.BR string \ and\  bytes ,
+thereby making strings writable.
+This is intended for compatibility with old source code and should not
+be used with new software.
+.TP
+.BI \-use\-runtime \ runtime\-name
+Generate a bytecode executable file that can be executed on the custom
+runtime system
+.IR runtime\-name ,
+built earlier with
+.B ocamlc\ \-make\-runtime
+.IR runtime\-name .
+.TP
+.B \-v
+Print the version number of the compiler and the location of the
+standard library directory, then exit.
+.TP
+.B \-verbose
+Print all external commands before they are executed, in particular
+invocations of the C compiler and linker in
+.B \-custom
+mode.  Useful to debug C library problems.
+.TP
+.BR \-vnum \ or\  \-version
+Print the version number of the compiler in short form (e.g. "3.11.0"),
+then exit.
+.TP
+.BI \-w \ warning\-list
+Enable, disable, or mark as fatal the warnings specified by the argument
+.IR warning\-list .
+
+Each warning can be
+.IR enabled \ or\  disabled ,
+and each warning can be
+.IR fatal \ or
+.IR non-fatal .
+If a warning is disabled, it isn't displayed and doesn't affect
+compilation in any way (even if it is fatal).  If a warning is enabled,
+it is displayed normally by the compiler whenever the source code
+triggers it.  If it is enabled and fatal, the compiler will also stop
+with an error after displaying it.
+
+The
+.I warning\-list
+argument is a sequence of warning specifiers, with no separators
+between them.  A warning specifier is one of the following:
+
+.BI + num
+\ \ Enable warning number
+.IR num .
+
+.BI \- num
+\ \ Disable warning number
+.IR num .
+
+.BI @ num
+\ \ Enable and mark as fatal warning number
+.IR num .
+
+.BI + num1 .. num2
+\ \ Enable all warnings between
+.I num1
+and
+.I num2
+(inclusive).
+
+.BI \- num1 .. num2
+\ \ Disable all warnings between
+.I num1
+and
+.I num2
+(inclusive).
+
+.BI @ num1 .. num2
+\ \ Enable and mark as fatal all warnings between
+.I num1
+and
+.I num2
+(inclusive).
+
+.BI + letter
+\ \ Enable the set of warnings corresponding to
+.IR letter .
+The letter may be uppercase or lowercase.
+
+.BI \- letter
+\ \ Disable the set of warnings corresponding to
+.IR letter .
+The letter may be uppercase or lowercase.
+
+.BI @ letter
+\ \ Enable and mark as fatal the set of warnings corresponding to
+.IR letter .
+The letter may be uppercase or lowercase.
+
+.I uppercase\-letter
+\ \ Enable the set of warnings corresponding to
+.IR uppercase\-letter .
+
+.I lowercase\-letter
+\ \ Disable the set of warnings corresponding to
+.IR lowercase\-letter .
+
+The warning numbers are as follows.
+
+1
+\ \ \ Suspicious-looking start-of-comment mark.
+
+2
+\ \ \ Suspicious-looking end-of-comment mark.
+
+3
+\ \ \ Deprecated feature.
+
+4
+\ \ \ Fragile pattern matching: matching that will remain
+complete even if additional constructors are added to one of the
+variant types matched.
+
+5
+\ \ \ Partially applied function: expression whose result has
+function type and is ignored.
+
+6
+\ \ \ Label omitted in function application.
+
+7
+\ \ \ Method overridden without using the "method!" keyword.
+
+8
+\ \ \ Partial match: missing cases in pattern-matching.
+
+9
+\ \ \ Missing fields in a record pattern.
+
+10
+\ \ Expression on the left-hand side of a sequence that doesn't
+have type
+.B unit
+(and that is not a function, see warning number 5).
+
+11
+\ \ Redundant case in a pattern matching (unused match case).
+
+12
+\ \ Redundant sub-pattern in a pattern-matching.
+
+13
+\ \ Override of an instance variable.
+
+14
+\ \ Illegal backslash escape in a string constant.
+
+15
+\ \ Private method made public implicitly.
+
+16
+\ \ Unerasable optional argument.
+
+17
+\ \ Undeclared virtual method.
+
+18
+\ \ Non-principal type.
+
+19
+\ \ Type without principality.
+
+20
+\ \ Unused function argument.
+
+21
+\ \ Non-returning statement.
+
+22
+\ \ Preprocessor warning.
+
+23
+\ \ Useless record
+.B with
+clause.
+
+24
+\ \ Bad module name: the source file name is not a valid OCaml module name.
+
+25
+\ \ Deprecated: now part of warning 8.
+
+26
+\ \ Suspicious unused variable: unused variable that is bound with
+.BR let \ or \ as ,
+and doesn't start with an underscore (_) character.
+
+27
+\ \ Innocuous unused variable: unused variable that is not bound with
+.BR let \ nor \ as ,
+and doesn't start with an underscore (_) character.
+
+28
+\ \ A pattern contains a constant constructor applied to the underscore (_)
+pattern.
+
+29
+\ \ A non-escaped end-of-line was found in a string constant.  This may
+cause portability problems between Unix and Windows.
+
+30
+\ \ Two labels or constructors of the same name are defined in two
+mutually recursive types.
+
+31
+\ \ A module is linked twice in the same executable.
+
+32
+\ \ Unused value declaration.
+
+33
+\ \ Unused open statement.
+
+34
+\ \ Unused type declaration.
+
+35
+\ \ Unused for-loop index.
+
+36
+\ \ Unused ancestor variable.
+
+37
+\ \ Unused constructor.
+
+38
+\ \ Unused extension constructor.
+
+39
+\ \ Unused rec flag.
+
+40
+\ \ Constructor or label name used out of scope.
+
+41
+\ \ Ambiguous constructor or label name.
+
+42
+\ \ Disambiguated constructor or label name.
+
+43
+\ \ Nonoptional label applied as optional.
+
+44
+\ \ Open statement shadows an already defined identifier.
+
+45
+\ \ Open statement shadows an already defined label or constructor.
+
+46
+\ \ Error in environment variable.
+
+47
+\ \ Illegal attribute payload.
+
+48
+\ \ Implicit elimination of optional arguments.
+
+49
+\ \ Missing cmi file when looking up module alias.
+
+50
+\ \ Unexpected documentation comment.
+
+59
+\ \ Assignment on non-mutable value.
+
+60
+\ \ Unused module declaration.
+
+61
+\ \ Unannotated unboxable type in primitive declaration.
+
+62
+\ \ Type constraint on GADT type declaration.
+
+63
+\ \ Erroneous printed signature.
+
+64
+\ \ -unsafe used with a preprocessor returning a syntax tree.
+
+65
+\ \ Type declaration defining a new '()' constructor.
+
+66
+\ \ Unused open! statement.
+
+67
+\ \ Unused functor parameter.
+
+The letters stand for the following sets of warnings.  Any letter not
+mentioned here corresponds to the empty set.
+
+.B A
+\ all warnings
+
+.B C
+\ 1, 2
+
+.B D
+\ 3
+
+.B E
+\ 4
+
+.B F
+\ 5
+
+.B K
+\ 32, 33, 34, 35, 36, 37, 38, 39
+
+.B L
+\ 6
+
+.B M
+\ 7
+
+.B P
+\ 8
+
+.B R
+\ 9
+
+.B S
+\ 10
+
+.B U
+\ 11, 12
+
+.B V
+\ 13
+
+.B X
+\ 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 30
+
+.B Y
+\ 26
+
+.B Z
+\ 27
+
+.IP
+The default setting is
+.BR \-w\ +a\-4\-6\-7\-9\-27\-29\-30\-32..42\-44\-45\-48\-50\-60\-66 .
+Note that warnings
+.BR 5 \ and \ 10
+are not always triggered, depending on the internals of the type checker.
+.TP
+.BI \-warn\-error \ warning\-list
+Mark as errors the warnings specified in the argument
+.IR warning\-list .
+The compiler will stop with an error when one of these
+warnings is emitted.  The
+.I warning\-list
+has the same meaning as for
+the
+.B \-w
+option: a
+.B +
+sign (or an uppercase letter) marks the corresponding warnings as fatal, a
+.B \-
+sign (or a lowercase letter) turns them back into non-fatal warnings, and a
+.B @
+sign both enables and marks as fatal the corresponding warnings.
+
+Note: it is not recommended to use the
+.B \-warn\-error
+option in production code, because it will almost certainly prevent
+compiling your program with later versions of OCaml when they add new
+warnings or modify existing warnings.
+
+The default setting is
+.B \-warn\-error \-a+31
+(only warning 31 is fatal).
+.TP
+.B \-warn\-help
+Show the description of all available warning numbers.
+.TP
+.B \-where
+Print the location of the standard library, then exit.
+.TP
+.B \-with-runtime
+Include the runtime system in the generated program. This is the default.
+.TP
+.B \-without-runtime
+The compiler does not include the runtime system (nor a reference to it) in the
+generated program; it must be supplied separately.
+.TP
+.BI \- \ file
+Process
+.I file
+as a file name, even if it starts with a dash (-) character.
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+
+.SH SEE ALSO
+.BR ocamlopt (1), \ ocamlrun (1), \ ocaml (1).
+.br
+.IR "The OCaml user's manual" ,
+chapter "Batch compilation".
diff --git a/man/ocamlcp.m b/man/ocamlcp.m
new file mode 100644
index 00000000..d6c983d1
--- /dev/null
+++ b/man/ocamlcp.m
@@ -0,0 +1,142 @@
+.\"**************************************************************************
+.\"*                                                                        *
+.\"*                                 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.          *
+.\"*                                                                        *
+.\"**************************************************************************
+.\"
+.TH "OCAMLCP" 1
+
+.SH NAME
+ocamlcp, ocamloptp \- The OCaml profiling compilers
+
+.SH SYNOPSIS
+.B ocamlcp
+[
+.I ocamlc options
+]
+[
+.BI \-P \ flags
+]
+.I filename ...
+
+.B ocamloptp
+[
+.I ocamlopt options
+]
+[
+.BI \-P \ flags
+]
+.I filename ...
+
+.SH DESCRIPTION
+The
+.B ocamlcp
+and
+.B ocamloptp
+commands are front-ends to
+.BR ocamlc (1)
+and
+.BR ocamlopt (1)
+that instrument the source code, adding code to record how many times
+functions are called, branches of conditionals are taken, etc.
+Execution of instrumented code produces an execution profile in the
+file ocamlprof.dump, which can be read using
+.BR ocamlprof (1).
+
+.B ocamlcp
+accepts the same arguments and options as
+.BR ocamlc (1)
+and
+.B ocamloptp
+accepts the same arguments and options as
+.BR ocamlopt (1).
+There is only one exception: in both cases, the
+.B \-pp
+option is not supported.  If you need to preprocess your source files,
+you will have to do it separately before calling
+.B ocamlcp
+or
+.BR ocamloptp .
+
+.SH OPTIONS
+
+In addition to the
+.BR ocamlc (1)
+or
+.BR ocamlopt (1)
+options,
+.B ocamlcp
+and
+.B ocamloptp
+accept one option to control the kind of profiling information, the
+.BI \-P \ letters
+option. The
+.I letters
+indicate which parts of the program should be profiled:
+.TP
+.B a
+all options
+.TP
+.B f
+function calls : a count point is set at the beginning of each function body
+.TP
+.B i
+.BR if \ ... \ then \ ... \ else :
+count points are set in both
+.BR then \ and \ else
+branches
+.TP
+.B l
+.BR while , \ for
+loops: a count point is set at the beginning of the loop body
+.TP
+.B m
+.B match
+branches: a count point is set at the beginning of the
+body of each branch of a pattern-matching
+.TP
+.B t
+.BR try \ ... \ with
+branches: a count point is set at the beginning of the body of each
+branch of an exception catcher
+
+.PP
+For instance, compiling with
+.B ocamlcp \-P film
+profiles function calls,
+.BR if \ ... \ then \ ... \ else \ ...,
+loops, and pattern matching.
+
+Calling
+.BR ocamlcp (1)
+or
+.BR ocamloptp (1)
+without the
+.B \-P
+option defaults to
+.BR \-P\ fm ,
+meaning that only function calls and pattern matching are profiled.
+
+Note: for compatibility with previous versions,
+.BR ocamlcp (1)
+also accepts the option
+.B \-p
+with the same argument and meaning as
+.BR \-P .
+
+.SH SEE ALSO
+.BR ocamlc (1),
+.BR ocamlopt (1),
+.BR ocamlprof (1).
+.br
+.IR "The OCaml user's manual" ,
+chapter "Profiling".
diff --git a/man/ocamldebug.m b/man/ocamldebug.m
new file mode 100644
index 00000000..f03ad60f
--- /dev/null
+++ b/man/ocamldebug.m
@@ -0,0 +1,124 @@
+.\"**************************************************************************
+.\"*                                                                        *
+.\"*                                 OCaml                                  *
+.\"*                                                                        *
+.\"*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *
+.\"*                                                                        *
+.\"*   Copyright 2001 Institut National de Recherche en Informatique et     *
+.\"*     en Automatique.                                                    *
+.\"*                                                                        *
+.\"*   All rights reserved.  This file is distributed under the terms of    *
+.\"*   the GNU Lesser General Public License version 2.1, with the          *
+.\"*   special exception on linking described in the file LICENSE.          *
+.\"*                                                                        *
+.\"**************************************************************************
+.\"
+.TH OCAMLDEBUG 1
+
+.SH NAME
+ocamldebug \- the OCaml source-level replay debugger.
+.SH SYNOPSIS
+.B ocamldebug
+.RI [\  options \ ]\  program \ [\  arguments \ ]
+.SH DESCRIPTION
+.B ocamldebug
+is the OCaml source-level replay debugger.
+
+Before the debugger can be used, the program must be compiled and
+linked with the
+.B \-g
+option: all .cmo and .cma files that are part
+of the program should have been created with
+.BR ocamlc\ \-g ,
+and they must be linked together with
+.BR ocamlc\ \-g .
+
+Compiling with
+.B \-g
+entails no penalty on the running time of
+programs: object files and bytecode executable files are bigger and
+take longer to produce, but the executable files run at
+exactly the same speed as if they had been compiled without
+.BR \-g .
+
+.SH OPTIONS
+A summary of options are included below.
+For a complete description, see the html documentation in the ocaml-doc
+package.
+.TP
+.BI \-c \ count
+Set the maximum number of simultaneously live checkpoints to
+.IR count .
+.TP
+.BI \-cd \ dir
+Run the debugger program from the working directory
+.IR dir ,
+instead of the current working directory. (See also the
+.B cd
+command.)
+.TP
+.B \-emacs
+Tell the debugger it is executed under Emacs.  (See
+.I "The OCaml user's manual"
+for information on how to run the debugger under Emacs.)
+Implies
+.BR \-machine-readable .
+.TP
+.BI \-I \ directory
+Add
+.I directory
+to the list of directories searched for source files and
+compiled files.  (See also the
+.B directory
+command.)
+.TP
+.BI -machine-readable
+Print information in a format more suitable for machines instead of human
+operators where applicable. For example, when describing a location in a
+program, such as when printing a backtrace, print the program counter and
+character offset in a file instead of the filename, line number, and character
+offset in that line.
+.TP
+.BI \-s \ socket
+Use
+.I socket
+for communicating with the debugged program. See the description
+of the command
+.B set\ socket
+in
+.I "The OCaml user's manual"
+for the format of
+.IR socket .
+.TP
+.B \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+
+.SH INITIALIZATION FILE
+
+When
+.BR ocamldebug (1)
+is invoked, it will read commands from an initialization file before
+giving control to the user. The default file is
+.B .ocamldebug
+in the current directory if it exists, otherwise
+.B .ocamldebug
+in the user's home directory.
+
+Note that you can also use the
+.B source file
+command to read commands from a file.
+
+.SH SEE ALSO
+.BR ocamlc (1)
+.br
+.IR "The OCaml user's manual" ,
+chapter "The debugger".
+.SH AUTHOR
+This manual page was written by Sven LUTHER ,
+for the Debian GNU/Linux system (but may be used by others).
diff --git a/man/ocamldep.m b/man/ocamldep.m
new file mode 100644
index 00000000..1c39e9d5
--- /dev/null
+++ b/man/ocamldep.m
@@ -0,0 +1,196 @@
+.\"**************************************************************************
+.\"*                                                                        *
+.\"*                                 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.          *
+.\"*                                                                        *
+.\"**************************************************************************
+.\"
+.TH OCAMLDEP 1
+
+.SH NAME
+ocamldep \- Dependency generator for OCaml
+
+.SH SYNOPSIS
+.B ocamldep
+[
+.I options
+]
+.I filename ...
+
+.SH DESCRIPTION
+
+The
+.BR ocamldep (1)
+command scans a set of OCaml source files
+(.ml and .mli files) for references to external compilation units,
+and outputs dependency lines in a format suitable for the
+.BR make (1)
+utility. This ensures that make will compile the source files in the
+correct order, and recompile those files that need to when a source
+file is modified.
+
+The typical usage is:
+.P
+ocamldep
+.I options
+*.mli *.ml > .depend
+.P
+where .depend is the file that should contain the
+dependencies.
+
+Dependencies are generated both for compiling with the bytecode
+compiler
+.BR ocamlc (1)
+and with the native-code compiler
+.BR ocamlopt (1).
+
+.SH OPTIONS
+
+The following command-line options are recognized by
+.BR ocamldep (1).
+.TP
+.B \-absname
+Show absolute filenames in error messages.
+.TP
+.B \-all
+Generate dependencies on all required files, rather than assuming
+implicit dependencies.
+.TP
+.B \-allow\-approx
+Allow falling back on a lexer-based approximation when parsing fails.
+.TP
+.B \-as\-map
+For the following files, do not include delayed dependencies for
+module aliases.
+This option assumes that they are compiled using options
+"\-no\-alias\-deps \-w \-49", and that those files or their interface are
+passed with the "\-map" option when computing dependencies for other
+files. Note also that for dependencies to be correct in the
+implementation of a map file, its interface should not coerce any of
+the aliases it contains.
+.TP
+.B \-debug\-map
+Dump the delayed dependency map for each map file.
+.TP
+.BI \-I \ directory
+Add the given directory to the list of directories searched for
+source files. If a source file foo.ml mentions an external
+compilation unit Bar, a dependency on that unit's interface
+bar.cmi is generated only if the source for bar is found in the
+current directory or in one of the directories specified with
+.BR \-I .
+Otherwise, Bar is assumed to be a module from the standard library,
+and no dependencies are generated. For programs that span multiple
+directories, it is recommended to pass
+.BR ocamldep (1)
+the same
+.B \-I
+options that are passed to the compiler.
+.TP
+.B \-nocwd
+Do not add current working directory to the list of include directories.
+.TP
+.BI \-impl \ file
+Process
+.IR file
+as a .ml file.
+.TP
+.BI \-intf \ file
+Process
+.IR file
+as a .mli file.
+.TP
+.BI \-map \ file
+Read an propagate the delayed dependencies for module aliases in
+.IR file ,
+so that the following files will depend on the
+exported aliased modules if they use them.
+.TP
+.BI \-ml\-synonym \ .ext
+Consider the given extension (with leading dot) to be a synonym for .ml.
+.TP
+.BI \-mli\-synonym \ .ext
+Consider the given extension (with leading dot) to be a synonym for .mli.
+.TP
+.B \-modules
+Output raw dependencies of the form
+.IR filename : \ Module1\ Module2 \ ... \ ModuleN
+where
+.IR Module1 ,\ ..., \ ModuleN
+are the names of the compilation
+units referenced within the file
+.IR filename ,
+but these names are not
+resolved to source file names.  Such raw dependencies cannot be used
+by
+.BR make (1),
+but can be post-processed by other tools such as
+.BR Omake (1).
+.TP
+.BI \-native
+Generate dependencies for a pure native-code program (no bytecode
+version).  When an implementation file (.ml file) has no explicit
+interface file (.mli file),
+.BR ocamldep (1)
+generates dependencies on the
+bytecode compiled file (.cmo file) to reflect interface changes.
+This can cause unnecessary bytecode recompilations for programs that
+are compiled to native-code only.  The flag
+.B \-native
+causes dependencies on native compiled files (.cmx) to be generated instead
+of on .cmo files.  (This flag makes no difference if all source files
+have explicit .mli interface files.)
+.TP
+.B \-one-line
+Output one line per file, regardless of the length.
+.TP
+.BI \-open \ module
+Assume that module
+.IR module
+is opened before parsing each of the
+following files.
+.TP
+.BI \-pp \ command
+Cause
+.BR ocamldep (1)
+to call the given
+.I command
+as a preprocessor for each source file.
+.TP
+.BI \-ppx \ command
+Pipe abstract syntax tree through preprocessor
+.IR command .
+.TP
+.B \-shared
+Generate dependencies for native plugin files (.cmxs) in addition to
+native compiled files (.cmx).
+.TP
+.B \-slash
+Under Unix, this option does nothing.
+.TP
+.B \-sort
+Sort files according to their dependencies.
+.TP
+.B \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+
+.SH SEE ALSO
+.BR ocamlc (1),
+.BR ocamlopt (1).
+.br
+.IR The\ OCaml\ user's\ manual ,
+chapter "Dependency generator".
diff --git a/man/ocamldoc.m b/man/ocamldoc.m
new file mode 100644
index 00000000..ffdee529
--- /dev/null
+++ b/man/ocamldoc.m
@@ -0,0 +1,477 @@
+.\"**************************************************************************
+.\"*                                                                        *
+.\"*                                 OCaml                                  *
+.\"*                                                                        *
+.\"*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *
+.\"*                                                                        *
+.\"*   Copyright 2004 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.          *
+.\"*                                                                        *
+.\"**************************************************************************
+.\"
+.TH OCAMLDOC 1
+
+\" .de Sh \" Subsection heading
+\" .br
+\" .if t .Sp
+\" .ne 5
+\" .PP
+\" \fB\\$1\fR
+\" .PP
+\" ..
+
+.SH NAME
+ocamldoc \- The OCaml documentation generator
+
+
+.SH SYNOPSIS
+.B ocamldoc
+[
+.I options
+]
+.IR filename \ ...
+
+.SH DESCRIPTION
+
+The OCaml documentation generator
+.BR ocamldoc (1)
+generates documentation from special comments embedded in source files. The
+comments used by
+.B ocamldoc
+are of the form
+.I (** ... *)
+and follow the format described in the
+.IR "The OCaml user's manual" .
+
+.B ocamldoc
+can produce documentation in various formats: HTML, LaTeX, TeXinfo,
+Unix man pages, and
+.BR dot (1)
+dependency graphs. Moreover, users can add their own
+custom generators.
+
+In this manpage, we use the word
+.I element
+to refer to any of the following parts of an OCaml source file: a type
+declaration, a value, a module, an exception, a module type, a type
+constructor, a record field, a class, a class type, a class method, a class
+value or a class inheritance clause.
+
+.SH OPTIONS
+
+The following command-line options determine the format for the generated
+documentation generated by
+.BR ocamldoc (1).
+.SS "Options for choosing the output format"
+.TP
+.B \-html
+Generate documentation in HTML default format. The generated HTML pages are
+stored in the current directory, or in the directory specified with the
+.B \-d
+option. You can customize the style of the generated pages by editing the
+generated
+.I style.css
+file, or by providing your own style sheet using option
+.BR \-css\-style .
+The file
+.I style.css
+is not generated if it already exists.
+.TP
+.B \-latex
+Generate documentation in LaTeX default format. The generated LaTeX document
+is saved in file
+.IR ocamldoc.out ,
+or in the file specified with the
+.B -o
+option. The document uses the style file
+.IR ocamldoc.sty .
+This file is generated when using the
+.B \-latex
+option, if it does not already exist. You can change this file to customize
+the style of your LaTeX documentation.
+.TP
+.B \-texi
+Generate documentation in TeXinfo default format. The generated LaTeX document
+is saved in file
+.IR ocamldoc.out ,
+or in the file specified with the
+.B -o
+option.
+.TP
+.B \-man
+Generate documentation as a set of Unix man pages. The generated pages are
+stored in the current directory, or in the directory specified with the
+.B \-d
+option.
+.TP
+.B \-dot
+Generate a dependency graph for the toplevel modules, in a format suitable for
+displaying and processing by
+.IR dot (1).
+The
+.IR dot (1)
+tool is available from
+.IR https://graphviz.org/ .
+The textual representation of the graph is written to the file
+.IR ocamldoc.out ,
+or to the file specified with the
+.B -o
+option. Use
+.BI dot \ ocamldoc.out
+to display it.
+.TP
+.BI \-g \ file
+Dynamically load the given file (which extension usually is .cmo or .cma),
+which defines a custom documentation generator.
+If the given file is a simple one and does not exist in
+the current directory, then
+.B ocamldoc
+looks for it in the custom
+generators default directory, and in the directories specified with the
+.B \-i
+option.
+.TP
+.BI \-customdir
+Display the custom generators default directory.
+.TP
+.BI \-i \ directory
+Add the given directory to the path where to look for custom generators.
+.SS "General options"
+.TP
+.BI \-d \ dir
+Generate files in directory
+.IR dir ,
+rather than the current directory.
+.TP
+.BI \-dump \ file
+Dump collected information into
+.IR file .
+This information can be read with the
+.B \-load
+option in a subsequent invocation of
+.BR ocamldoc (1).
+.TP
+.BI \-hide \ modules
+Hide the given complete module names in the generated documentation.
+.I modules
+is a list of complete module names are separated by commas (,),
+without blanks. For instance:
+.IR Stdlib,M2.M3 .
+.TP
+.B \-inv\-merge\-ml\-mli
+Reverse the precedence of implementations and interfaces when merging.
+All elements in implementation files are kept, and the
+.B \-m
+option indicates which parts of the comments in interface files are merged with
+the comments in implementation files.
+.TP
+.B \-keep\-code
+Always keep the source code for values, methods and instance variables, when
+available. The source code is always kept when a .ml
+file is given, but is by default discarded when a .mli
+is given. This option allows the source code to be always kept.
+.TP
+.BI \-load \ file
+Load information from
+.IR file ,
+which has been produced by
+.BR ocamldoc\ \-dump .
+Several
+.B -load
+options can be given.
+.TP
+.BI \-m \ flags
+Specify merge options between interfaces and implementations.
+.I flags
+can be one or several of the following characters:
+
+.B d
+merge description
+
+.B a
+merge @author
+
+.B v
+merge @version
+
+.B l
+merge @see
+
+.B s
+merge @since
+
+.B o
+merge @deprecated
+
+.B p
+merge @param
+
+.B e
+merge @raise
+
+.B r
+merge @return
+
+.B A
+merge everything
+.TP
+.B \-no\-custom\-tags
+Do not allow custom @-tags.
+.TP
+.B \-no\-stop
+Keep elements placed after the
+.B (**/**)
+special comment.
+.TP
+.BI \-o \ file
+Output the generated documentation to
+.I file
+instead of
+.IR ocamldoc.out .
+This option is meaningful only in conjunction with the
+.BR \-latex , \ \-texi ,\ or \ \-dot
+options.
+.TP
+.BI \-open \ module
+Opens
+.I module
+before typing.
+.TP
+.BI \-pp \ command
+Pipe sources through preprocessor
+.IR command .
+.TP
+.BI \-ppx \ command
+Pipe abstract syntax tree through preprocessor
+.IR command .
+.TP
+.BR \-show\-missed\-crossref
+Show missed cross-reference opportunities.
+.TP
+.B \-sort
+Sort the list of top-level modules before generating the documentation.
+.TP
+.B \-stars
+Remove blank characters until the first asterisk ('*') in each line of comments.
+.TP
+.BI \-t \ title
+Use
+.I title
+as the title for the generated documentation.
+.TP
+.BI \-text \ file
+Consider \fIfile\fR as a .txt file.
+.TP
+.BI \-intro \ file
+Use content of
+.I file
+as
+.B ocamldoc
+text to use as introduction (HTML, LaTeX and TeXinfo only).
+For HTML, the file is used to create the whole "index.html" file.
+.TP
+.B \-v
+Verbose mode. Display progress information.
+.TP
+.B \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+.TP
+.B \-warn\-error
+Treat
+.B ocamldoc
+warnings as errors.
+.TP
+.B \-hide\-warnings
+Do not print
+.B ocamldoc
+warnings.
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+.SS "Type-checking options"
+.BR ocamldoc (1)
+calls the OCaml type-checker to obtain type information. The
+following options impact the type-checking phase. They have the same meaning
+as for the
+.BR ocamlc (1)\ and \ ocamlopt (1)
+commands.
+.TP
+.BI \-I \ directory
+Add
+.I directory
+to the list of directories search for compiled interface files (.cmi files).
+.TP
+.B \-nolabels
+Ignore non-optional labels in types.
+.TP
+.B \-rectypes
+ Allow arbitrary recursive types. (See the
+.B \-rectypes
+option to
+.BR ocamlc (1).)
+.SS "Options for generating HTML pages"
+The following options apply in conjunction with the
+.B \-html
+option:
+.TP
+.B \-all\-params
+Display the complete list of parameters for functions and methods.
+.TP
+.BI \-charset \ s
+Add information about character encoding being \fIs\fR
+(default is \fBiso-8859-1\fR).
+.TP
+.BI \-css\-style \ filename
+Use
+.I filename
+as the Cascading Style Sheet file.
+.TP
+.B \-colorize\-code
+Colorize the OCaml code enclosed in [ ] and \\{[ ]\\}, using colors to emphasize
+keywords, etc. If the code fragments are not syntactically correct, no color
+is added.
+.TP
+.B \-index\-only
+Generate only index files.
+.TP
+.B \-short\-functors
+Use a short form to display functors:
+.B "module M : functor (A:Module) -> functor (B:Module2) -> sig .. end"
+is displayed as
+.BR "module M (A:Module) (B:Module2) : sig .. end" .
+.SS "Options for generating LaTeX files"
+The following options apply in conjunction with the
+.B \-latex
+option:
+.TP
+.B \-latex\-value\-prefix prefix
+Give a prefix to use for the labels of the values in the generated LaTeX
+document. The default prefix is the empty string. You can also use the options
+.BR -latex-type-prefix ,
+.BR -latex-exception-prefix ,
+.BR -latex-module-prefix ,
+.BR -latex-module-type-prefix ,
+.BR -latex-class-prefix ,
+.BR -latex-class-type-prefix ,
+.BR -latex-attribute-prefix ,\ and
+.BR -latex-method-prefix .
+
+These options are useful when you have, for example, a type and a value
+with the same name. If you do not specify prefixes, LaTeX will complain about
+multiply defined labels.
+.TP
+.BI \-latextitle \ n,style
+Associate style number
+.I n
+to the given LaTeX sectioning command
+.IR style ,
+e.g.
+.BR section or subsection .
+(LaTeX only.) This is useful when including the generated document in another
+LaTeX document, at a given sectioning level. The default association is 1 for
+section, 2 for subsection, 3 for subsubsection, 4 for paragraph and 5 for
+subparagraph.
+.TP
+.B \-noheader
+Suppress header in generated documentation.
+.TP
+.B \-notoc
+Do not generate a table of contents.
+.TP
+.B \-notrailer
+Suppress trailer in generated documentation.
+.TP
+.B \-sepfiles
+Generate one .tex file per toplevel module, instead of the global
+.I ocamldoc.out
+file.
+.SS "Options for generating TeXinfo files"
+The following options apply in conjunction with the
+.B -texi
+option:
+.TP
+.B \-esc8
+Escape accented characters in Info files.
+.TP
+.B
+\-info\-entry
+Specify Info directory entry.
+.TP
+.B \-info\-section
+Specify section of Info directory.
+.TP
+.B \-noheader
+Suppress header in generated documentation.
+.TP
+.B \-noindex
+Do not build index for Info files.
+.TP
+.B \-notrailer
+Suppress trailer in generated documentation.
+.SS "Options for generating dot graphs"
+The following options apply in conjunction with the
+.B \-dot
+option:
+.TP
+.BI \-dot\-colors \ colors
+Specify the colors to use in the generated dot code. When generating module
+dependencies,
+.BR ocamldoc (1)
+uses different colors for modules, depending on the directories in which they
+reside. When generating types dependencies,
+.BR ocamldoc (1)
+uses different colors for types, depending on the modules in which they are
+defined.
+.I colors
+is a list of color names separated by commas (,), as in
+.BR Red,Blue,Green .
+The available colors are the ones supported by the
+.BR dot (1)
+tool.
+.TP
+.B \-dot\-include\-all
+Include all modules in the
+.BR dot (1)
+output, not only modules given on the command line or loaded with the
+.B \-load
+option.
+.TP
+.B \-dot\-reduce
+Perform a transitive reduction of the dependency graph before outputting the
+dot code. This can be useful if there are a lot of transitive dependencies
+that clutter the graph.
+.TP
+.B \-dot\-types
+Output dot code describing the type dependency graph instead of the module
+dependency graph.
+.SS "Options for generating man files"
+The following options apply in conjunction with the
+.B \-man
+option:
+.TP
+.B \-man\-mini
+Generate man pages only for modules, module types, classes and class types,
+instead of pages for all elements.
+.TP
+.BI \-man\-suffix \ suffix
+Set the suffix used for generated man filenames. Default is o, as in
+.IR List.o .
+.TP
+.BI \-man\-section \ section
+Set the section number used for generated man filenames. Default is 3.
+
+
+.SH SEE ALSO
+.BR ocaml (1),
+.BR ocamlc (1),
+.BR ocamlopt (1).
+.br
+.IR "The OCaml user's manual",
+chapter "The documentation generator".
diff --git a/man/ocamllex.m b/man/ocamllex.m
new file mode 100644
index 00000000..58e03627
--- /dev/null
+++ b/man/ocamllex.m
@@ -0,0 +1,101 @@
+.\"**************************************************************************
+.\"*                                                                        *
+.\"*                                 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.          *
+.\"*                                                                        *
+.\"**************************************************************************
+.\"
+.TH OCAMLLEX 1
+
+.SH NAME
+ocamllex \- The OCaml lexer generator
+
+.SH SYNOPSIS
+.B ocamllex
+[
+.BI \-o \ output-file
+]
+[
+.B \-ml
+]
+.I filename.mll
+
+.SH DESCRIPTION
+
+The
+.BR ocamllex (1)
+command generates OCaml lexers from a set of regular
+expressions with associated semantic actions, in the style of
+.BR lex (1).
+
+Running
+.BR ocamllex (1)
+on the input file
+.IR lexer \&.mll
+produces OCaml code for a lexical analyzer in file
+.IR lexer \&.ml.
+
+This file defines one lexing function per entry point in the lexer
+definition. These functions have the same names as the entry
+points. Lexing functions take as argument a lexer buffer, and return
+the semantic attribute of the corresponding entry point.
+
+Lexer buffers are an abstract data type implemented in the standard
+library module Lexing. The functions Lexing.from_channel,
+Lexing.from_string and Lexing.from_function create
+lexer buffers that read from an input channel, a character string, or
+any reading function, respectively.
+
+When used in conjunction with a parser generated by
+.BR ocamlyacc (1),
+the semantic actions compute a value belonging to the type token defined
+by the generated parsing module.
+
+.SH OPTIONS
+
+The
+.BR ocamllex (1)
+command recognizes the following options:
+.TP
+.B \-ml
+Output code that does not use OCaml's built-in automata
+interpreter. Instead, the automaton is encoded by OCaml functions.
+This option is mainly useful for debugging
+.BR ocamllex (1),
+using it for production lexers is not recommended.
+.TP
+.BI \-o \ output\-file
+Specify the name of the output file produced by
+.BR ocamllex (1).
+The default is the input file name, with its extension replaced by .ml.
+.TP
+.B \-q
+Quiet mode.
+.BR ocamllex (1)
+normally outputs informational messages
+to standard output.  They are suppressed if option
+.B \-q
+is used.
+.TP
+.BR \-v \ or \ \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+
+.SH SEE ALSO
+.BR ocamlyacc (1).
+.br
+.IR "The OCaml user's manual" ,
+chapter "Lexer and parser generators".
diff --git a/man/ocamlmktop.m b/man/ocamlmktop.m
new file mode 100644
index 00000000..09a4126c
--- /dev/null
+++ b/man/ocamlmktop.m
@@ -0,0 +1,97 @@
+.\"**************************************************************************
+.\"*                                                                        *
+.\"*                                 OCaml                                  *
+.\"*                                                                        *
+.\"*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *
+.\"*                                                                        *
+.\"*   Copyright 1999 Institut National de Recherche en Informatique et     *
+.\"*     en Automatique.                                                    *
+.\"*                                                                        *
+.\"*   All rights reserved.  This file is distributed under the terms of    *
+.\"*   the GNU Lesser General Public License version 2.1, with the          *
+.\"*   special exception on linking described in the file LICENSE.          *
+.\"*                                                                        *
+.\"**************************************************************************
+.\"
+.TH OCAMLMKTOP 1
+
+.SH NAME
+ocamlmktop \- Building custom toplevel systems
+
+.SH SYNOPSIS
+.B ocamlmktop
+[
+.BR \-v | \-version | \-vnum
+]
+[
+.BI \-cclib \ libname
+]
+[
+.BI \-ccopt \ option
+]
+[
+.B \-custom
+[
+.BI \-o \ exec-file
+]
+[
+.BI \-I \ lib-dir
+]
+.I filename ...
+
+.SH DESCRIPTION
+
+The
+.BR ocamlmktop (1)
+command builds OCaml toplevels that
+contain user code preloaded at start-up.
+The
+.BR ocamlmktop (1)
+command takes as argument a set of
+.IR x .cmo
+and
+.IR x .cma
+files, and links them with the object files that implement the
+OCaml toplevel.  If the
+.B \-custom
+flag is given, C object files and libraries (.o and .a files) can also
+be given on the command line and are linked in the resulting toplevel.
+
+.SH OPTIONS
+
+The following command-line options are recognized by
+.BR ocamlmktop (1).
+.TP
+.B \-v
+Print the version string of the compiler and exit.
+.TP
+.BR \-vnum \ or\  \-version
+Print the version number of the compiler in short form and exit.
+.TP
+.BI \-cclib\ \-l libname
+Pass the
+.BI \-l libname
+option to the C linker when linking in
+``custom runtime'' mode (see the corresponding option for
+.BR ocamlc (1).
+.TP
+.B \-ccopt
+Pass the given option to the C compiler and linker, when linking in
+``custom runtime'' mode. See the corresponding option for
+.BR ocamlc (1).
+.TP
+.B \-custom
+Link in ``custom runtime'' mode. See the corresponding option for
+.BR ocamlc (1).
+.TP
+.BI \-I \ directory
+Add the given directory to the list of directories searched for
+compiled interface files (.cmo and .cma).
+.TP
+.BI \-o \ exec\-file
+Specify the name of the toplevel file produced by the linker.
+The default is is
+.BR a.out .
+
+.SH SEE ALSO
+.BR ocamlc (1).
diff --git a/man/ocamlopt.m b/man/ocamlopt.m
new file mode 100644
index 00000000..b7f6bb81
--- /dev/null
+++ b/man/ocamlopt.m
@@ -0,0 +1,779 @@
+.\"**************************************************************************
+.\"*                                                                        *
+.\"*                                 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.          *
+.\"*                                                                        *
+.\"**************************************************************************
+.\"
+.TH OCAMLOPT 1
+
+.SH NAME
+
+ocamlopt \- The OCaml native-code compiler
+
+.SH SYNOPSIS
+
+.B ocamlopt
+[
+.I options
+]
+.IR filename \ ...
+
+.B ocamlopt.opt
+(same options)
+
+.SH DESCRIPTION
+
+The OCaml high-performance
+native-code compiler
+.BR ocamlopt (1)
+compiles OCaml source files to native code object files and link these
+object files to produce standalone executables.
+
+The
+.BR ocamlopt (1)
+command has a command-line interface very close to that
+of
+.BR ocamlc (1).
+It accepts the same types of arguments and processes them
+sequentially, after all options have been processed:
+
+Arguments ending in .mli are taken to be source files for
+compilation unit interfaces. Interfaces specify the names exported by
+compilation units: they declare value names with their types, define
+public data types, declare abstract data types, and so on. From the
+file
+.IR x .mli,
+the
+.BR ocamlopt (1)
+compiler produces a compiled interface
+in the file
+.IR x .cmi.
+The interface produced is identical to that
+produced by the bytecode compiler
+.BR ocamlc (1).
+
+Arguments ending in .ml are taken to be source files for compilation
+unit implementations. Implementations provide definitions for the
+names exported by the unit, and also contain expressions to be
+evaluated for their side-effects.  From the file
+.IR x .ml,
+the
+.BR ocamlopt (1)
+compiler produces two files:
+.IR x .o,
+containing native object code, and
+.IR x .cmx,
+containing extra information for linking and
+optimization of the clients of the unit. The compiled implementation
+should always be referred to under the name
+.IR x .cmx
+(when given a .o file,
+.BR ocamlopt (1)
+assumes that it contains code compiled from C, not from OCaml).
+
+The implementation is checked against the interface file
+.IR x .mli
+(if it exists) as described in the manual for
+.BR ocamlc (1).
+
+Arguments ending in .cmx are taken to be compiled object code.  These
+files are linked together, along with the object files obtained
+by compiling .ml arguments (if any), and the OCaml standard
+library, to produce a native-code executable program. The order in
+which .cmx and .ml arguments are presented on the command line is
+relevant: compilation units are initialized in that order at
+run-time, and it is a link-time error to use a component of a unit
+before having initialized it. Hence, a given
+.IR x .cmx
+file must come
+before all .cmx files that refer to the unit
+.IR x .
+
+Arguments ending in .cmxa are taken to be libraries of object code.
+Such a library packs in two files
+.IR lib .cmxa
+and
+.IR lib .a
+a set of object files (.cmx/.o files). Libraries are build with
+.B ocamlopt \-a
+(see the description of the
+.B \-a
+option below). The object
+files contained in the library are linked as regular .cmx files (see
+above), in the order specified when the library was built. The only
+difference is that if an object file contained in a library is not
+referenced anywhere in the program, then it is not linked in.
+
+Arguments ending in .c are passed to the C compiler, which generates
+a .o object file. This object file is linked with the program.
+
+Arguments ending in .o or .a are assumed to be C object files and
+libraries. They are linked with the program.
+
+The output of the linking phase is a regular Unix executable file. It
+does not need
+.BR ocamlrun (1)
+to run.
+
+.B ocamlopt.opt
+is the same compiler as
+.BR ocamlopt ,
+but compiled with itself instead of with the bytecode compiler
+.BR ocamlc (1).
+Thus, it behaves exactly like
+.BR ocamlopt ,
+but compiles faster.
+.B ocamlopt.opt
+is not available in all installations of OCaml.
+
+.SH OPTIONS
+
+The following command-line options are recognized by
+.BR ocamlopt (1).
+.TP
+.B \-a
+Build a library (.cmxa/.a file) with the object files (.cmx/.o
+files) given on the command line, instead of linking them into an
+executable file. The name of the library must be set with the
+.B \-o
+option.
+
+If
+.BR \-cclib \ or \ \-ccopt
+options are passed on the command
+line, these options are stored in the resulting .cmxa library.  Then,
+linking with this library automatically adds back the
+.BR \-cclib \ and \ \-ccopt
+options as if they had been provided on the
+command line, unless the
+.B \-noautolink
+option is given. Additionally, a substring
+.B $CAMLORIGIN
+inside a
+.BR \ \-ccopt
+options will be replaced by the full path to the .cma library,
+excluding the filename.
+.TP
+.B \-absname
+Show absolute filenames in error messages.
+.TP
+.B \-annot
+Deprecated since OCaml 4.11. Please use
+.BR \-bin-annot
+instead.
+.TP
+.B \-bin\-annot
+Dump detailed information about the compilation (types, bindings,
+tail-calls, etc) in binary format. The information for file
+.IR src .ml
+is put into file
+.IR src .cmt.
+In case of a type error, dump
+all the information inferred by the type-checker before the error.
+The annotation files produced by
+.B \-bin\-annot
+contain more information
+and are much more compact than the files produced by
+.BR \-annot .
+.TP
+.B \-c
+Compile only. Suppress the linking phase of the
+compilation. Source code files are turned into compiled files, but no
+executable file is produced. This option is useful to
+compile modules separately.
+.TP
+.BI \-cc \ ccomp
+Use
+.I ccomp
+as the C linker called to build the final executable and as the C
+compiler for compiling .c source files.
+.TP
+.BI \-cclib\ \-l libname
+Pass the
+.BI \-l libname
+option to the linker. This causes the given C library to be linked
+with the program.
+.TP
+.BI \-ccopt \ option
+Pass the given option to the C compiler and linker. For instance,
+.BI \-ccopt\ \-L dir
+causes the C linker to search for C libraries in
+directory
+.IR dir .
+.TP
+.BI \-color \ mode
+Enable or disable colors in compiler messages (especially warnings and errors).
+The following modes are supported:
+
+.B auto
+use heuristics to enable colors only if the output supports them (an
+ANSI-compatible tty terminal);
+
+.B always
+enable colors unconditionally;
+
+.B never
+disable color output.
+
+The default setting is
+.B auto,
+and the current heuristic
+checks that the "TERM" environment variable exists and is
+not empty or "dumb", and that isatty(stderr) holds.
+
+The environment variable "OCAML_COLOR" is considered if \-color is not
+provided. Its values are auto/always/never as above.
+
+.TP
+.BI \-error\-style \ mode
+Control the way error messages and warnings are printed.
+The following modes are supported:
+
+.B short
+only print the error and its location;
+
+.B contextual
+like "short", but also display the source code snippet corresponding
+to the location of the error.
+
+The default setting is
+.B contextual.
+
+The environment variable "OCAML_ERROR_STYLE" is considered if
+\-error\-style is not provided. Its values are short/contextual as
+above.
+
+.TP
+.B \-compact
+Optimize the produced code for space rather than for time. This
+results in smaller but slightly slower programs. The default is to
+optimize for speed.
+.TP
+.B \-config
+Print the version number of
+.BR ocamlopt (1)
+and a detailed summary of its configuration, then exit.
+.TP
+.BI \-config-var
+Print the value of a specific configuration variable
+from the
+.B \-config
+output, then exit. If the variable does not exist,
+the exit code is non-zero.
+.TP
+.BI \-depend\ ocamldep-args
+Compute dependencies, as ocamldep would do.
+.TP
+.BI \-for\-pack \ module\-path
+Generate an object file (.cmx and .o files) that can later be included
+as a sub-module (with the given access path) of a compilation unit
+constructed with
+.BR \-pack .
+For instance,
+.B ocamlopt\ \-for\-pack\ P\ \-c\ A.ml
+will generate a.cmx and a.o files that can later be used with
+.BR "ocamlopt -pack -o P.cmx a.cmx" .
+.TP
+.B \-g
+Add debugging information while compiling and linking. This option is
+required in order to produce stack backtraces when
+the program terminates on an uncaught exception (see
+.BR ocamlrun (1)).
+.TP
+.B \-i
+Cause the compiler to print all defined names (with their inferred
+types or their definitions) when compiling an implementation (.ml
+file). No compiled files (.cmo and .cmi files) are produced.
+This can be useful to check the types inferred by the
+compiler. Also, since the output follows the syntax of interfaces, it
+can help in writing an explicit interface (.mli file) for a file:
+just redirect the standard output of the compiler to a .mli file,
+and edit that file to remove all declarations of unexported names.
+.TP
+.BI \-I \ directory
+Add the given directory to the list of directories searched for
+compiled interface files (.cmi), compiled object code files (.cmx),
+and libraries (.cmxa). By default, the current directory is searched
+first, then the standard library directory. Directories added with \-I
+are searched after the current directory, in the order in which they
+were given on the command line, but before the standard library
+directory. See also option
+.BR \-nostdlib .
+
+If the given directory starts with
+.BR + ,
+it is taken relative to the
+standard library directory. For instance,
+.B \-I\ +compiler-libs
+adds the subdirectory
+.B compiler-libs
+of the standard library to the search path.
+.TP
+.BI \-impl \ filename
+Compile the file
+.I filename
+as an implementation file, even if its extension is not .ml.
+.TP
+.BI \-inline \ n
+Set aggressiveness of inlining to
+.IR n ,
+where
+.I n
+is a positive
+integer. Specifying
+.B \-inline 0
+prevents all functions from being
+inlined, except those whose body is smaller than the call site. Thus,
+inlining causes no expansion in code size. The default aggressiveness,
+.BR \-inline\ 1 ,
+allows slightly larger functions to be inlined, resulting
+in a slight expansion in code size. Higher values for the
+.B \-inline
+option cause larger and larger functions to become candidate for
+inlining, but can result in a serious increase in code size.
+.TP
+.B \-insn\-sched
+Enables the instruction scheduling pass in the compiler backend.
+.TP
+.BI \-intf \ filename
+Compile the file
+.I filename
+as an interface file, even if its extension is not .mli.
+.TP
+.BI \-intf\-suffix \ string
+Recognize file names ending with
+.I string
+as interface files (instead of the default .mli).
+.TP
+.B \-keep-docs
+Keep documentation strings in generated .cmi files.
+.TP
+.B \-keep-locs
+Keep locations in generated .cmi files.
+.TP
+.B \-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.
+.TP
+.B \-linkall
+Force all modules contained in libraries to be linked in. If this
+flag is not given, unreferenced modules are not linked in. When
+building a library
+.RB ( \-a
+flag), setting the
+.B \-linkall
+flag forces all
+subsequent links of programs involving that library to link all the
+modules contained in the library.
+When compiling a module (option
+.BR \-c ),
+setting the
+.B \-linkall
+option ensures that this module will
+always be linked if it is put in a library and this library is linked.
+.TP
+.B \-linscan
+Use linear scan register allocation.  Compiling with this allocator is faster
+than with the usual graph coloring allocator, sometimes quite drastically so for
+long functions and modules. On the other hand, the generated code can be a bit
+slower.
+.TP
+.B \-match\-context\-rows
+Set number of rows of context used during pattern matching
+compilation. Lower values cause faster compilation, but
+less optimized code. The default value is 32.
+.TP
+.B \-no-alias-deps
+Do not record dependencies for module aliases.
+.TP
+.B \-no\-app\-funct
+Deactivates the applicative behaviour of functors. With this option,
+each functor application generates new types in its result and
+applying the same functor twice to the same argument yields two
+incompatible structures.
+.TP
+.B \-noassert
+Do not compile assertion checks.  Note that the special form
+.B assert\ false
+is always compiled because it is typed specially.
+This flag has no effect when linking already-compiled files.
+.TP
+.B \-noautolink
+When linking .cmxa libraries, ignore
+.BR \-cclib \ and \ \-ccopt
+options potentially contained in the libraries (if these options were
+given when building the libraries).  This can be useful if a library
+contains incorrect specifications of C libraries or C options; in this
+case, during linking, set
+.B -noautolink
+and pass the correct C libraries and options on the command line.
+.TP
+.B \-nodynlink
+Allow the compiler to use some optimizations that are valid only for code
+that is never dynlinked.
+.TP
+.B \-no\-insn\-sched
+Disables the instruction scheduling pass in the compiler backend.
+.TP
+.B -nostdlib
+Do not automatically add the standard library directory to the list of
+directories searched for compiled interface files (.cmi), compiled
+object code files (.cmx), and libraries (.cmxa). See also option
+.BR \-I .
+.TP
+.B \-nolabels
+Ignore non-optional labels in types. Labels cannot be used in
+applications, and parameter order becomes strict.
+.TP
+.BI \-o \ exec\-file
+Specify the name of the output file produced by the linker. The
+default output name is a.out, in keeping with the Unix tradition. If the
+.B \-a
+option is given, specify the name of the library produced. If the
+.B \-pack
+option is given, specify the name of the packed object file produced.
+If the
+.B \-output\-obj
+option is given, specify the name of the output file produced. If the
+.B \-shared
+option is given, specify the name of plugin file produced.
+This can also be used when compiling an interface or implementation
+file, without linking, in which case it sets the name of the cmi or
+cmo file, and also sets the module name to the file name up to the
+first dot.
+.TP
+.B \-opaque
+When compiling a .mli interface file, this has the same effect as the
+.B \-opaque
+option of the bytecode compiler. When compiling a .ml implementation
+file, this produces a .cmx file without cross-module optimization
+information, which reduces recompilation on module change.
+.TP
+.BI \-open \ module
+Opens the given module before processing the interface or
+implementation files. If several
+.B \-open
+options are given, they are processed in order, just as if
+the statements open! module1;; ... open! moduleN;; were added
+at the top of each file.
+.TP
+.B \-output\-obj
+Cause the linker to produce a C object file instead of an executable
+file. This is useful to wrap OCaml code as a C library,
+callable from any C program. The name of the output object file
+must be set with the
+.B \-o
+option.
+This option can also be used to produce a compiled shared/dynamic
+library (.so extension).
+.TP
+.B \-pack
+Build an object file (.cmx and .o files) and its associated compiled
+interface (.cmi) that combines the .cmx object
+files given on the command line, making them appear as sub-modules of
+the output .cmx file.  The name of the output .cmx file must be
+given with the
+.B \-o
+option.  For instance,
+.B ocamlopt\ -pack\ -o\ P.cmx\ A.cmx\ B.cmx\ C.cmx
+generates compiled files P.cmx, P.o and P.cmi describing a
+compilation unit having three sub-modules A, B and C,
+corresponding to the contents of the object files A.cmx, B.cmx and
+C.cmx.  These contents can be referenced as P.A, P.B and P.C
+in the remainder of the program.
+
+The .cmx object files being combined must have been compiled with
+the appropriate
+.B \-for\-pack
+option.  In the example above,
+A.cmx, B.cmx and C.cmx must have been compiled with
+.BR ocamlopt\ \-for\-pack\ P .
+
+Multiple levels of packing can be achieved by combining
+.B \-pack
+with
+.BR \-for\-pack .
+See
+.IR "The OCaml user's manual" ,
+chapter "Native-code compilation" for more details.
+.TP
+.BI \-pp \ command
+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.
+.TP
+.BI \-ppx \ command
+After parsing, pipe the abstract syntax tree through the preprocessor
+.IR command .
+The module
+.BR Ast_mapper (3)
+implements the external interface of a preprocessor.
+.TP
+.B \-principal
+Check information path during type-checking, to make sure that all
+types are derived in a principal way. All programs accepted in
+.B \-principal
+mode are also accepted in default mode with equivalent
+types, but different binary signatures.
+.TP
+.B \-rectypes
+Allow arbitrary recursive types during type-checking.  By default,
+only recursive types where the recursion goes through an object type
+are supported. Note that once you have created an interface using this
+flag, you must use it again for all dependencies.
+.TP
+.BI \-runtime\-variant \ suffix
+Add
+.I suffix
+to the name of the runtime library that will be used by the program.
+If OCaml was configured with option
+.BR \-with\-debug\-runtime ,
+then the
+.B d
+suffix is supported and gives a debug version of the runtime.
+.TP
+.B \-S
+Keep the assembly code produced during the compilation. The assembly
+code for the source file
+.IR x .ml
+is saved in the file
+.IR x .s.
+.TP
+.BI \-stop\-after \ pass
+Stop compilation after the given compilation pass. The currently
+supported passes are:
+.BR parsing ,
+.BR typing .
+.TP
+.B \-safe\-string
+Enforce the separation between types
+.BR string \ and\  bytes ,
+thereby making strings read-only. This is the default.
+.TP
+.B \-shared
+Build a plugin (usually .cmxs) that can be dynamically loaded with
+the
+.B Dynlink
+module. The name of the plugin must be
+set with the
+.B \-o
+option. A plugin can include a number of OCaml
+modules and libraries, and extra native objects (.o, .a files).
+Building native plugins is only supported for some
+operating system. Under some systems (currently,
+only Linux AMD 64), all the OCaml code linked in a plugin must have
+been compiled without the
+.B \-nodynlink
+flag. Some constraints might also
+apply to the way the extra native objects have been compiled (under
+Linux AMD 64, they must contain only position-independent code).
+.TP
+.B \-short\-paths
+When a type is visible under several module-paths, use the shortest
+one when printing the type's name in inferred interfaces and error and
+warning messages.
+.TP
+.B \-strict\-sequence
+The left-hand part of a sequence must have type unit.
+.TP
+.B \-unboxed\-types
+When a type is unboxable (i.e. a record with a single argument or a
+concrete datatype with a single constructor of one argument) it will
+be unboxed unless annotated with
+.BR [@@ocaml.boxed] .
+.TP
+.B \-no-unboxed\-types
+When a type is unboxable  it will be boxed unless annotated with
+.BR [@@ocaml.unboxed] .
+This is the default.
+.TP
+.B \-unsafe
+Turn bound checking off for array and string accesses (the
+.BR v.(i) and s.[i]
+constructs). Programs compiled with
+.B \-unsafe
+are therefore
+faster, but unsafe: anything can happen if the program accesses an
+array or string outside of its bounds. Additionally, turn off the
+check for zero divisor in integer division and modulus operations.
+With
+.BR \-unsafe ,
+an integer division (or modulus) by zero can halt the
+program or continue with an unspecified result instead of raising a
+.B Division_by_zero
+exception.
+.TP
+.B \-unsafe\-string
+Identify the types
+.BR string \ and\  bytes ,
+thereby making strings writable.
+This is intended for compatibility with old source code and should not
+be used with new software.
+.TP
+.B \-v
+Print the version number of the compiler and the location of the
+standard library directory, then exit.
+.TP
+.B \-verbose
+Print all external commands before they are executed, in particular
+invocations of the assembler, C compiler, and linker.
+.TP
+.BR \-version \ or\  \-vnum
+Print the version number of the compiler in short form (e.g. "3.11.0"),
+then exit.
+.TP
+.BI \-w \ warning\-list
+Enable, disable, or mark as fatal the warnings specified by the argument
+.IR warning\-list .
+See
+.BR ocamlc (1)
+for the syntax of
+.IR warning-list .
+.TP
+.BI \-warn\-error \ warning\-list
+Mark as fatal the warnings specified in the argument
+.IR warning\-list .
+The compiler will stop with an error when one of these
+warnings is emitted.  The
+.I warning\-list
+has the same meaning as for
+the
+.B \-w
+option: a
+.B +
+sign (or an uppercase letter) marks the corresponding warnings as fatal, a
+.B \-
+sign (or a lowercase letter) turns them back into non-fatal warnings, and a
+.B @
+sign both enables and marks as fatal the corresponding warnings.
+
+Note: it is not recommended to use the
+.B \-warn\-error
+option in production code, because it will almost certainly prevent
+compiling your program with later versions of OCaml when they add new
+warnings or modify existing warnings.
+
+The default setting is
+.B \-warn\-error \-a+31
+(only warning 31 is fatal).
+.TP
+.B \-warn\-help
+Show the description of all available warning numbers.
+.TP
+.B \-where
+Print the location of the standard library, then exit.
+.TP
+.B \-with-runtime
+Include the runtime system in the generated program. This is the default.
+.TP
+.B \-without-runtime
+The compiler does not include the runtime system (nor a reference to it) in the
+generated program; it must be supplied separately.
+.TP
+.BI \- \ file
+Process
+.I file
+as a file name, even if it starts with a dash (-) character.
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+
+.SH OPTIONS FOR THE IA32 ARCHITECTURE
+
+The IA32 code generator (Intel Pentium, AMD Athlon) supports the
+following additional option:
+.TP
+.B \-ffast\-math
+Use the IA32 instructions to compute
+trigonometric and exponential functions, instead of calling the
+corresponding library routines.  The functions affected are:
+.BR atan ,
+.BR atan2 ,
+.BR cos ,
+.BR log ,
+.BR log10 ,
+.BR sin ,
+.B sqrt
+and
+.BR tan .
+The resulting code runs faster, but the range of supported arguments
+and the precision of the result can be reduced.  In particular,
+trigonometric operations
+.BR cos ,
+.BR sin ,
+.B tan
+have their range reduced to [\-2^64, 2^64].
+
+.SH OPTIONS FOR THE AMD64 ARCHITECTURE
+
+The AMD64 code generator (64-bit versions of Intel Pentium and AMD
+Athlon) supports the following additional options:
+.TP
+.B \-fPIC
+Generate position-independent machine code.  This is the default.
+.TP
+.B \-fno\-PIC
+Generate position-dependent machine code.
+
+.SH OPTIONS FOR THE POWER ARCHITECTURE
+
+The PowerPC code generator supports the following additional options:
+.TP
+.B \-flarge\-toc
+Enables the PowerPC large model allowing the TOC (table of contents) to be
+arbitrarily large.  This is the default since 4.11.
+.TP
+.B \-fsmall\-toc
+Enables the PowerPC small model allowing the TOC to be up to 64 kbytes per
+compilation unit.  Prior to 4.11 this was the default behaviour.
+\end{options}
+
+.SH OPTIONS FOR THE ARM ARCHITECTURE
+The ARM code generator supports the following additional options:
+.TP
+.B \-farch=armv4|armv5|armv5te|armv6|armv6t2|armv7
+Select the ARM target architecture
+.TP
+.B \-ffpu=soft|vfpv2|vfpv3\-d16|vfpv3
+Select the floating-point hardware
+.TP
+.B \-fPIC
+Generate position-independent machine code.
+.TP
+.B \-fno\-PIC
+Generate position-dependent machine code.  This is the default.
+.TP
+.B \-fthumb
+Enable Thumb/Thumb-2 code generation
+.TP
+.B \-fno\-thumb
+Disable Thumb/Thumb-2 code generation
+.P
+The default values for target architecture, floating-point hardware
+and thumb usage were selected at configure-time when building
+.B ocamlopt
+itself. This configuration can be inspected using
+.BR ocamlopt\ \-config .
+Target architecture depends on the "model" setting, while
+floating-point hardware and thumb support are determined from the ABI
+setting in "system" (
+.BR linux_eabi or linux_eabihf ).
+
+.SH SEE ALSO
+.BR ocamlc (1).
+.br
+.IR "The OCaml user's manual" ,
+chapter "Native-code compilation".
diff --git a/man/ocamlprof.m b/man/ocamlprof.m
new file mode 100644
index 00000000..97d56714
--- /dev/null
+++ b/man/ocamlprof.m
@@ -0,0 +1,87 @@
+.\"**************************************************************************
+.\"*                                                                        *
+.\"*                                 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.          *
+.\"*                                                                        *
+.\"**************************************************************************
+.\"
+.TH OCAMLPROF 1
+
+.SH NAME
+ocamlprof \- The OCaml profiler
+
+.SH SYNOPSIS
+.B ocamlprof
+[
+.I options
+]
+.I filename ...
+
+.SH DESCRIPTION
+The
+.B ocamlprof
+command prints execution counts gathered during the execution of a
+OCaml program instrumented with
+.BR ocamlcp (1).
+
+It produces a source listing of the program modules given as arguments
+where execution counts have been inserted as comments. For instance,
+
+.B ocamlprof foo.ml
+
+prints the source code for the foo module, with comments indicating
+how many times the functions in this module have been called. Naturally,
+this information is accurate only if the source file has not been modified
+since the profiling execution took place.
+
+.SH OPTIONS
+
+.TP
+.BI \-f \ dumpfile
+Specifies an alternate dump file of profiling information.
+.TP
+.BI \-F \ string
+Specifies an additional string to be output with profiling information.
+By default,
+.BR ocamlprof (1)
+will annotate programs with comments of the form
+.BI (* \ n \ *)
+where
+.I n
+is the counter value for a profiling point. With option
+.BI \-F \ s
+the annotation will be
+.BI (* \ sn \ *)
+.TP
+.BI \-impl \ filename
+Compile the file
+.I filename
+as an implementation file, even if its extension is not .ml.
+.TP
+.BI \-intf \ filename
+Compile the file
+.I filename
+as an interface file, even if its extension is not .mli.
+.TP
+.B \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+
+.SH SEE ALSO
+.BR ocamlcp (1).
+.br
+.IR "The OCaml user's manual" ,
+chapter "Profiling".
diff --git a/man/ocamlrun.m b/man/ocamlrun.m
new file mode 100644
index 00000000..fea7ef8d
--- /dev/null
+++ b/man/ocamlrun.m
@@ -0,0 +1,276 @@
+.\"**************************************************************************
+.\"*                                                                        *
+.\"*                                 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.          *
+.\"*                                                                        *
+.\"**************************************************************************
+.\"
+.TH OCAMLRUN 1
+
+.SH NAME
+ocamlrun \- The OCaml bytecode interpreter
+
+.SH SYNOPSIS
+.B ocamlrun
+[
+.I options
+]
+.I filename argument ...
+
+.SH DESCRIPTION
+The
+.BR ocamlrun (1)
+command executes bytecode files produced by the
+linking phase of the
+.BR ocamlc (1)
+command.
+
+The first non-option argument is taken to be the name of the file
+containing the executable bytecode. (That file is searched in the
+executable path as well as in the current directory.) The remaining
+arguments are passed to the OCaml program, in the string array
+.BR Sys.argv .
+Element 0 of this array is the name of the
+bytecode executable file; elements 1 to
+.I n
+are the remaining arguments.
+
+In most cases, the bytecode
+executable files produced by the
+.BR ocamlc (1)
+command are self-executable,
+and manage to launch the
+.BR ocamlrun (1)
+command on themselves automatically.
+
+.SH OPTIONS
+
+The following command-line options are recognized by
+.BR ocamlrun (1).
+.TP
+.B \-b
+When the program aborts due to an uncaught exception, print a detailed
+"back trace" of the execution, showing where the exception was
+raised and which function calls were outstanding at this point.  The
+back trace is printed only if the bytecode executable contains
+debugging information, i.e. was compiled and linked with the
+.B \-g
+option to
+.BR ocamlc (1)
+set.  This option is equivalent to setting the
+.B b
+flag in the OCAMLRUNPARAM environment variable (see below).
+.TP
+.BI \-I \ dir
+Search the directory
+.I dir
+for dynamically-loaded libraries, in addition to the standard search path.
+.TP
+.B \-p
+Print the names of the primitives known to this version of
+.BR ocamlrun (1)
+and exit.
+.TP
+.B \-v
+Direct the memory manager to print verbose messages on standard error.
+This is equivalent to setting
+.B v=63
+in the OCAMLRUNPARAM environment variable (see below).
+.TP
+.B \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+
+.SH ENVIRONMENT VARIABLES
+
+The following environment variable are also consulted:
+.TP
+.B CAML_LD_LIBRARY_PATH
+Additional directories to search for dynamically-loaded libraries.
+.TP
+.B OCAMLLIB
+The directory containing the OCaml standard
+library.  (If
+.B OCAMLLIB
+is not set,
+.B CAMLLIB
+will be used instead.) Used to locate the ld.conf configuration file for
+dynamic loading.  If not set,
+default to the library directory specified when compiling OCaml.
+.TP
+.B OCAMLRUNPARAM
+Set the runtime system options and garbage collection parameters.
+(If OCAMLRUNPARAM is not set, CAMLRUNPARAM will be used instead.)
+This variable must be a sequence of parameter specifications separated
+by commas.
+A parameter specification is a letter, optionally followed by an =
+sign, a decimal number (or a hexadecimal number prefixed by
+.BR 0x ),
+and an optional multiplier. If the letter is followed by anything
+else, the corresponding option is set to 1. Unknown letters
+are ignored.
+The options are documented below; the
+last six correspond to the fields of the
+.B control
+record documented in
+.IR "The OCaml user's manual",
+chapter "Standard Library", section "Gc".
+\" FIXME missing: c, H, t, w, W see MPR#7870
+.TP
+.B b
+Trigger the printing of a stack backtrace
+when an uncaught exception aborts the program.
+This option takes no argument.
+.TP
+.B p
+Turn on debugging support for
+.BR ocamlyacc -generated
+parsers.  When this option is on,
+the pushdown automaton that executes the parsers prints a
+trace of its actions.  This option takes no argument.
+.TP
+.BR R
+Turn on randomization of all hash tables by default (see the
+.B Hashtbl
+module of the standard library). This option takes no
+argument.
+.TP
+.BR h
+The initial size of the major heap (in words).
+.TP
+.BR a \ (allocation_policy)
+The policy used for allocating in the OCaml heap.  Possible values
+are 0 for the next-fit policy, 1 for the first-fit
+policy, and 2 for the best-fit policy. Best-fit is still experimental,
+but probably the best of the three. The default is 0.
+See the Gc module documentation for details.
+.TP
+.BR s \ (minor_heap_size)
+The size of the minor heap (in words).
+.TP
+.BR i \ (major_heap_increment)
+The default size increment for the major heap (in words).
+.TP
+.BR o \ (space_overhead)
+The major GC speed setting.
+.TP
+.BR O \ (max_overhead)
+The heap compaction trigger setting.
+.TP
+.BR l \ (stack_limit)
+The limit (in words) of the stack size.
+.TP
+.BR M \ (custom_major_ratio)
+Target ratio of floating garbage to
+major heap size for out-of-heap memory held by custom values
+located in the major heap. The GC speed is adjusted
+to try to use this much memory for dead values that are not yet
+collected. Expressed as a percentage of major heap size.
+The default value keeps the out-of-heap floating garbage about the
+same size as the in-heap overhead.
+Note: this only applies to values allocated with
+.B caml_alloc_custom_mem
+(e.g. bigarrays).
+Default: 44.
+.TP
+.BR m \ (custom_minor_ratio)
+Bound on floating garbage for out-of-heap memory
+held by custom values in the minor heap. A minor GC is triggered
+when this much memory is held by custom values located in the minor
+heap. Expressed as a percentage of minor heap size.
+Note: this only applies to values allocated with
+.B caml_alloc_custom_mem
+(e.g. bigarrays).
+ Default: 100.
+.TP
+.BR n \ (custom_minor_max_size)
+Maximum amount of out-of-heap
+memory for each custom value allocated in the minor heap. When a custom
+value is allocated on the minor heap and holds more than this many
+bytes, only this value is counted against
+.B custom_minor_ratio
+and the rest is directly counted against
+.BR custom_major_ratio .
+Note: this only applies to values allocated with
+.B caml_alloc_custom_mem
+(e.g. bigarrays).
+Default: 8192 bytes.
+.TP
+.BR v \ (verbose)
+What GC messages to print to stderr.  This is a sum of values selected
+from the following:
+
+.B 0x001
+Start of major GC cycle.
+
+.B 0x002
+Minor collection and major GC slice.
+
+.B 0x004
+Growing and shrinking of the heap.
+
+.B 0x008
+Resizing of stacks and memory manager tables.
+
+.B 0x010
+Heap compaction.
+
+.BR 0x020
+Change of GC parameters.
+
+.BR 0x040
+Computation of major GC slice size.
+
+.BR 0x080
+Calling of finalisation functions.
+
+.BR 0x100
+Startup messages (loading the bytecode executable file, resolving
+shared libraries).
+
+.BR 0x200
+Computation of compaction-triggering condition.
+
+.BR 0x400
+Output GC statistics at program exit, in the same format as Gc.print_stat.
+
+The multiplier is
+.BR k ,
+.BR M ,\ or
+.BR G ,
+for multiplication by 2^10, 2^20, and 2^30 respectively.
+
+If the option letter is not recognized, the whole parameter is ignored;
+if the equal sign or the number is missing, the value is taken as 1;
+if the multiplier is not recognized, it is ignored.
+
+For example, on a 32-bit machine under bash, the command
+.B export OCAMLRUNPARAM='s=256k,v=1'
+tells a subsequent
+.B ocamlrun
+to set its initial minor heap size to 1 megabyte and to print
+a message at the start of each major GC cycle.
+.TP
+.B CAMLRUNPARAM
+If OCAMLRUNPARAM is not found in the environment, then CAMLRUNPARAM
+will be used instead.  If CAMLRUNPARAM is also not found, then the default
+values will be used.
+.TP
+.B PATH
+List of directories searched to find the bytecode executable file.
+
+.SH SEE ALSO
+.BR ocamlc (1).
+.br
+.IR "The OCaml user's manual" ,
+chapter "Runtime system".
diff --git a/man/ocamlyacc.m b/man/ocamlyacc.m
new file mode 100644
index 00000000..f522d5cc
--- /dev/null
+++ b/man/ocamlyacc.m
@@ -0,0 +1,112 @@
+.\"**************************************************************************
+.\"*                                                                        *
+.\"*                                 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.          *
+.\"*                                                                        *
+.\"**************************************************************************
+.\"
+.TH OCAMLYACC 1
+
+.SH NAME
+ocamlyacc \- The OCaml parser generator
+
+.SH SYNOPSIS
+.B ocamlyacc
+[
+.BI \-b prefix
+] [
+.B \-q
+] [
+.B \-v
+] [
+.B \-version
+] [
+.B \-vnum
+]
+.I filename.mly
+
+.SH DESCRIPTION
+
+The
+.BR ocamlyacc (1)
+command produces a parser from a LALR(1) context-free grammar
+specification with attached semantic actions, in the style of
+.BR yacc (1).
+Assuming the input file is
+.IR grammar \&.mly,
+running
+.B ocamlyacc
+produces OCaml code for a parser in the file
+.IR grammar \&.ml,
+and its interface in file
+.IR grammar \&.mli.
+
+The generated module defines one parsing function per entry point in
+the grammar. These functions have the same names as the entry points.
+Parsing functions take as arguments a lexical analyzer (a function
+from lexer buffers to tokens) and a lexer buffer, and return the
+semantic attribute of the corresponding entry point. Lexical analyzer
+functions are usually generated from a lexer specification by the
+.BR ocamllex (1)
+program. Lexer buffers are an abstract data type
+implemented in the standard library module Lexing. Tokens are values from
+the concrete type token, defined in the interface file
+.IR grammar \&.mli
+produced by
+.BR ocamlyacc (1).
+
+.SH OPTIONS
+
+The
+.BR ocamlyacc (1)
+command recognizes the following options:
+.TP
+.BI \-b prefix
+Name the output files
+.IR prefix \&.ml,
+.IR prefix \&.mli,
+.IR prefix \&.output,
+instead of the default naming convention.
+.TP
+.B \-q
+This option has no effect.
+.TP
+.B \--strict
+Reject grammars with conflicts.
+.TP
+.B \-v
+Generate a description of the parsing tables and a report on conflicts
+resulting from ambiguities in the grammar. The description is put in
+file
+.IR grammar .output.
+.TP
+.B \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+.TP
+.B \-
+Read the grammar specification from standard input.  The default
+output file names are stdin.ml and stdin.mli.
+.TP
+.BI \-\- \ file
+Process
+.I file
+as the grammar specification, even if its name
+starts with a dash (-) character.  This option must be the last on the
+command line.
+
+.SH SEE ALSO
+.BR ocamllex (1).
+.br
+.IR "The OCaml user's manual" ,
+chapter "Lexer and parser generators".
diff --git a/manual/LICENSE-for-the-manual b/manual/LICENSE-for-the-manual
new file mode 100644
index 00000000..a40dfa12
--- /dev/null
+++ b/manual/LICENSE-for-the-manual
@@ -0,0 +1,36 @@
+The OCaml documentation and user's manual is copyright
+Institut National de Recherche en Informatique et en Automatique (INRIA).
+
+The OCaml documentation and user's manual is licensed under a Creative
+Commons Attribution-ShareAlike 4.0 International License (CC BY-SA 4.0)
+https://creativecommons.org/licenses/by-sa/4.0/
+
+This is a human-readable summary of (and not a substitute for) the
+license, which is available at
+https://creativecommons.org/licenses/by-sa/4.0/legalcode
+
+You are free to:
+
+Share - copy and redistribute the material in any medium or format
+
+Adapt - remix, transform, and build upon the material
+        for any purpose, even commercially.
+
+The licensor cannot revoke these freedoms as long as you follow the
+license terms.
+
+Under the following terms:
+
+Attribution - You must give appropriate credit, provide a link to
+    the license, and indicate if changes were made. You may do so in
+    any reasonable manner, but not in any way that suggests the
+    licensor endorses you or your use.
+
+ShareAlike - If you remix, transform, or build upon the material,
+    you must distribute your contributions under the same license as
+    the original.
+
+No additional restrictions - You may not apply legal terms or
+    technological measures that legally restrict others from doing
+    anything the license permits.
+
diff --git a/manual/Makefile b/manual/Makefile
new file mode 100644
index 00000000..0ccbf188
--- /dev/null
+++ b/manual/Makefile
@@ -0,0 +1,42 @@
+all: tools manual tests
+
+
+# The tools and the tests are rebuilt each time in order to avoid issues with
+# different compiler versions
+tests: manual
+	$(MAKE) -C tests clean
+	$(MAKE) -C tests all
+
+tools:
+	$(MAKE) -C tools clean
+	$(MAKE) -C tools all
+	$(MAKE) -C tests tools
+
+manual: tools
+	$(MAKE) -C manual all
+
+html: tools
+	$(MAKE) -C manual html
+
+release:
+	$(MAKE) -C manual release
+
+# The pregen-etex target generates the latex files from the .etex
+# files to ensure that this phase of the manual build process, which
+# may execute OCaml fragments and expect certain outputs, is correct
+pregen-etex: tools
+	$(MAKE) -C manual etex-files
+
+# pregen builds both .etex files and the documentation of the standard library
+pregen: tools
+	$(MAKE) -C manual files
+
+
+.PHONY: tests manual tools
+
+
+.PHONY: clean
+clean:
+	$(MAKE) -C manual clean
+	$(MAKE) -C tools  clean
+	$(MAKE) -C tests  clean
diff --git a/manual/README.md b/manual/README.md
new file mode 100644
index 00000000..f6640338
--- /dev/null
+++ b/manual/README.md
@@ -0,0 +1,274 @@
+OCAML DOCUMENTATION
+===================
+
+Prerequisites
+-------------
+
+- Any prerequisites required to build OCaml from sources.
+
+- A LaTeX installation.
+
+- The HeVeA LaTeX-to-HTML converter (available in OPAM):
+  
+
+Note that you must make sure `hevea.sty` is installed into TeX properly. Your
+package manager may not do this for you. Run `kpsewhich hevea.sty` to check.
+
+
+Building
+--------
+
+0. Install the OCaml distribution.
+
+1. Run `make` in the manual.
+
+NB: If you already set `LD_LIBRARY_PATH` (OS X: `DYLD_LIBRARY_PATH`)
+ in your environment don't forget to add
+ `otherlibs/unix:otherlibs/str` to it in an absolute way.
+
+Outputs
+-------
+
+In the manual:
+
+- The HTML Manual is in directory `htmlman`. The main file is `index.html`.
+
+- The plain text manual is in directory `textman` as file `manual.txt`.
+
+- The Info manual is in directory `infoman`.
+
+- The PDF manual is in directory `texstuff` as file `manual.pdf`.
+
+Source files
+------------
+The manual is written in an extended dialect of latex and is split in many
+source files. During the build process, the sources files are converted into
+classical latex file using the tools available in `tools`. These files are
+then converted to the different output formats using either latex or hevea.
+
+Each part of the manual corresponds to a specific directory, and each distinct
+chapters (or sometimes sections) are mapped to a distinct `.etex` file:
+
+- Part I, Introduction to OCaml: `tutorials`
+  - The core language: `coreexamples.etex`
+  - The module system: `moduleexamples.etex`
+  - Objects in OCaml: `objectexamples.etex`
+  - Labels and variants: `lablexamples.etex`
+  - Advanced examples with classes and modules: `advexamples.etex`
+
+- Part II, The OCaml language: `refman`
+  This part is separated in two very distinct  chapters; the
+  `OCaml language` chapter and the `Language extensions` chapter.
+
+  - The OCaml language: `refman.etex`
+    This chapter consists in a technical description of the OCaml language.
+    Each section of this chapter is mapped to a separated latex file:
+     - `lex.etex`, `values.etex`, `names.etex`, `types.etex`, `const.etex`,
+     `patterns.etex`, `expr.etex`, `typedecl.etex`, `classes.etex`,
+     `modtypes.etex`, `compunit.etex`
+
+  - Language extensions: `exten.etex`
+  This chapter contains a description of all recent features of the OCaml
+  language.
+
+- Part III, The OCaml tools: 'cmds'
+    - Batch compilation (ocamlc): `comp.etex`
+    - The toplevel system (ocaml): `top.etex`
+    - The runtime system (ocamlrun): `runtime.etex`
+    - Native-code compilation (ocamlopt): `native.etex`
+    - Lexer and parser generators (ocamllex, ocamlyacc): `lexyacc.etex`
+    - Dependency generator (ocamldep): `ocamldep.etex`
+    - The browser/editor (ocamlbrowser): `browser.etex`
+    - The documentation generator (ocamldoc): `ocamldoc.etex`
+    - The debugger (ocamldebug): `debugger.etex`
+    - Profiling (ocamlprof): `profil.etex`
+    - The ocamlbuild compilation manager: `ocamlbuild.etex`
+    - Interfacing C with OCaml: `intf-c.etex`
+    - Optimisation with Flambda: `flambda.etex`
+    - Memory profiling with Spacetime: `spacetime-chapter.etex`
+    - Fuzzing with afl-fuzz: `afl-fuzz.etex`
+    - Runtime tracing with the instrumented runtime: `instrumented-runtime.etex`
+
+Note that ocamlc,ocamlopt and the toplevel options overlap a lot.
+Consequently, these options are described together in the file
+`unified-options.etex` and then included from `comp.etex`, `native.etex`,
+and `top.etex`. If you need to update this list of options, the top comment
+of `unified-options.etex` contains the relevant information.
+
+- Part IV, The OCaml library: 'library'
+ This parts contains an brief presentation of all libraries bundled with the
+ compilers and the api documentation generated for these libraries.
+    - The core library: `core.etex`
+    - The standard library: `stdlib-blurb.etex`
+    - The compiler front-end: `compilerlibs.etex`
+    - The unix library: Unix system calls: `libunix.etex`
+    - The legacy num library: this library has been removed from the core
+      distribution, see `libnum.etex`
+    - The str library: regular expressions and string processing: `libstr.etex`
+    - The threads library: `libthreads.etex`
+    - The graphics library: `libgraph.etex`
+    - The dynlink library: dynamic loading and linking of object files:
+      `libdynlink.etex`
+    - The bigarray library: `libbigarray.etex`
+
+Latex extensions
+----------------
+
+### Sections (and subsections, and subsubsections)
+
+In order to provide stable links to all part of the manual, the standard
+`\section`, `\subsection` and `\subsubsection` macros are replaced by
+variants that take the section label as their first argument.
+For instance, in the manual, you have to write
+```latex
+\section{s:basics}{Basics}
+```
+rather than
+```latex
+\section{Basics\label{s:basics}}
+```
+This restriction ensures that hevea picks the section label when generating the
+header ids.
+
+A similar macro, `\lparagraph`, is provided for paragraphs.
+
+### Caml environments
+
+The tool `tools/caml-tex` is used to generate the latex code for the examples
+in the introduction and language extension parts of the manual. It implements
+two pseudo-environments: `caml_example` and `caml_eval`.
+
+The pseudo-environment `caml_example` evaluates its contents using an ocaml
+interpreter and then translates both the input code and the interpreter output
+to latex code, e.g.
+```latex
+\begin{caml_example}{toplevel}
+let f x = x;;
+\end{caml_example}
+```
+Note that the toplevel output can be suppressed by using a `*` suffix:
+```latex
+\begin{caml_example*}{verbatim}
+let f x = x
+\end{caml_example*}
+```
+
+The {verbatim} or {toplevel} argument of the environment corresponds
+to the the mode of the example, three modes are available toplevel, verbatim and signature.
+The `toplevel` mode mimics the appearance and behavior of the toplevel.
+In particular, toplevel examples must end with a double semi-colon `;;`,
+otherwise an error would be raised.
+The `verbatim` does not require a final `;;` and is intended to be
+a lighter mode for code examples.
+If you want to declare a signature instead of ocaml code,
+you must use the `{signature}` argument to the `caml_example` environment.
+
+```latex
+\begin{caml_example*}{signature}
+val none : 'a option
+\end{caml_example*}
+```
+
+By default, `caml-tex` raises an error and stops if the output of one
+the `caml_example` environment contains an unexpected error or warning.
+If such an error or warning is, in fact, expected, it is necessary to
+indicate the expected output status to `caml-tex` by adding either
+an option to the `caml_example` environment:
+```latex
+\begin{caml_example}{toplevel}[error]
+1 + 2. ;;
+\end{caml_example}
+ or for warning
+\begin{caml_example}[warning=8]
+let f None = None;;
+\end{caml_example}
+```
+or an annotation to the concerned phrase:
+
+```latex
+\begin{caml_example}{toplevel}
+1 + 2. [@@expect error] ;;
+let f None = None [@@expect warning 8];;
+3 + 4 [@@expect ok];;
+\end{caml_example}
+```
+
+It is also possible to elide a code fragment by annotating it with
+an `[@ellipsis]` attribute
+
+```latex
+\begin{caml_example}{toplevel}
+let f: type a. a list -> int = List.length[@ellipsis] ;;
+\end{caml_example}
+```
+For module components, it might be easier to hide them by using
+`[@@@ellipsis.start]` and `[@@@ellipsis.stop]`:
+```latex
+\begin{caml_example*}{verbatim}
+module M = struct
+  [@@@ellipsis.start]
+  type t = T
+  let x = 0
+  [@@@ellipsis.stop]
+ end
+\end{caml_example*}
+```
+
+Another possibility to avoid displaying distracting code is to use
+the `caml_eval` environment. This environment is a companion environment
+to `caml_example` and can be used to evaluate OCaml expressions in the
+toplevel without printing anything:
+```latex
+\begin{caml_eval}
+let pi = 4. *. atan 1.;;
+\end{caml_eval}
+\begin{caml_example}{toplevel}
+let f x = x +. pi;;
+\end{caml_example}
+```
+Beware that the detection code for these pseudo-environments is quite brittle
+and the environments must start and end at the beginning of the line.
+
+### Quoting
+
+The tool `tools/texquote2` provides support for verbatim-like quotes using
+`\"` delimiters. More precisely, outside of caml environments and verbatim
+environments, `texquote2` translates double quotes `"text"` to
+`\machine{escaped_text}`.
+
+### BNF grammar notation
+
+The tool `tools/transf` provides support for BNF grammar notations and special
+quotes for non-terminal. When transf is used, the environment `syntax` can
+be used to describe grammars using BNF notation:
+```latex
+\begin{syntax}
+expr:
+    value-path
+  | constant
+  | '(' expr ')'
+  | 'begin' expr 'end'
+  | '(' expr ':' typexpr ')'
+  | expr {{',' expr}}
+  | constr expr
+  | "`"tag-name expr
+  | expr '::' expr
+  | '[' expr { ';' expr } [';'] ']'
+  | '[|' expr { ';' expr } [';'] '|]'
+  | '{' field [':' typexpr] '=' expr%
+    { ';' field [':' typexpr] '=' expr } [';'] '}'
+\end{syntax}
+```
+Notice that terminal symbols are quoted using `'` delimiters.
+Moreover, outside of the syntax environment, `@`-quotes can be used
+to introduce fragment of grammar: `@'(' module-expr ')'@`. As a consequence,
+when this extension is used `@` characters must be escaped as `\@`.
+This extension is used mainly in the language reference part of the manual.
+and a more complete description of the notation used is available in the
+first subsection of `refman/refman.etex`.
+
+Consistency tests
+-----------------
+
+The `tests` folder contains consistency tests that checks that the manual
+and the rest of the compiler sources stay synced.
diff --git a/manual/manual/.gitignore b/manual/manual/.gitignore
new file mode 100644
index 00000000..71605a70
--- /dev/null
+++ b/manual/manual/.gitignore
@@ -0,0 +1,8 @@
+allfiles.tex
+biblio.tex
+foreword.tex
+version.tex
+warnings.etex
+warnings.tex
+foreword.htex
+manual.html
diff --git a/manual/manual/Makefile b/manual/manual/Makefile
new file mode 100644
index 00000000..fbee1e02
--- /dev/null
+++ b/manual/manual/Makefile
@@ -0,0 +1,172 @@
+SRC = $(abspath ../..)
+
+export LD_LIBRARY_PATH   ?= "$(SRC)/otherlibs/unix/:$(SRC)/otherlibs/str/"
+export DYLD_LIBRARY_PATH ?= "$(SRC)/otherlibs/unix/:$(SRC)/otherlibs/str/"
+SET_LD_PATH = CAML_LD_LIBRARY_PATH=$(LD_LIBRARY_PATH)
+
+OCAMLDOC = $(if $(wildcard $(SRC)/ocamldoc/ocamldoc.opt),\
+  $(SRC)/ocamldoc/ocamldoc.opt,\
+  $(SET_LD_PATH) $(SRC)/runtime/ocamlrun $(SRC)/ocamldoc/ocamldoc)\
+  -hide Stdlib -lib Stdlib -nostdlib \
+  -pp "$(AWK) -v ocamldoc=true -f $(SRC)/stdlib/expand_module_aliases.awk"
+
+
+# Import the list of mli files for the library docs
+include $(SRC)/ocamldoc/Makefile.docfiles
+
+TEXQUOTE = $(SRC)/runtime/ocamlrun ../tools/texquote2
+
+
+FILES = allfiles.tex biblio.tex foreword.tex version.tex warnings-help.etex
+
+TEXINPUTS = ".:..:../refman:../library:../cmds:../tutorials:../../styles:"
+RELEASE = $$HOME/release/$${RELEASENAME}
+HEVEA = hevea
+HACHA = hacha
+# We suppress warnings in info and text mode (with -s) because hevea listings emit
+# DIV blocks that the text modes do not know how to interpret.
+INFO_FLAGS = -fix -exec xxdate.exe -info -w 79 -s
+HTML_FLAGS = -fix -exec xxdate.exe -O
+TEXT_FLAGS = -fix -exec xxdate.exe -text -w 79 -s
+
+
+manual: files
+	cd texstuff \
+	  && TEXINPUTS=$(TEXINPUTS) pdflatex manual.tex
+
+index:
+	cd texstuff \
+	  && sh ../../tools/fix_index.sh manual.idx \
+	  && makeindex manual.idx \
+	  && makeindex manual.kwd.idx
+
+
+# libref/style.css and comilerlibref/style.css are used as witness
+# for the generation of the html stdlib and compilerlibs reference.
+html: htmlman/libref/style.css htmlman/compilerlibref/style.css etex-files
+	cd htmlman \
+	  && $(HEVEA) $(HTML_FLAGS) \
+	    -I .. -I ../cmds -I ../library -I ../refman -I ../tutorials \
+	    -I ../../styles -I ../texstuff \
+	    manual.hva -e macros.tex ../manual.tex \
+	  && $(HACHA) -tocter manual.html
+
+htmlman/libref/style.css: style.css $(STDLIB_MLIS) $(DOC_STDLIB_TEXT)
+	mkdir -p htmlman/libref
+	$(OCAMLDOC) -colorize-code -sort -html \
+	  -d htmlman/libref \
+	  $(DOC_STDLIB_INCLUDES) \
+          $(DOC_STDLIB_TEXT:%=-text %) \
+          $(STDLIB_MLIS)
+	cp style.css $@
+
+COMPILERLIBS_MODULES=$(shell echo $(basename $(notdir $(COMPILERLIBS_MLIS))) \
+| sed "s/\<./\U&/g")
+
+library/compiler_libs.txt: library/compiler_libs.mld
+	cp $< $@ && echo "{!modules:$(COMPILERLIBS_MODULES)}" >> $@
+
+
+htmlman/compilerlibref/style.css: library/compiler_libs.txt style.css \
+  $(COMPILERLIBS_MLIS)
+	mkdir -p htmlman/compilerlibref
+	$(OCAMLDOC) -colorize-code -sort -html \
+	  -d htmlman/compilerlibref \
+	  -I $(SRC)/stdlib \
+	  $(DOC_COMPILERLIBS_INCLUDES) \
+          -intro library/compiler_libs.txt \
+          library/compiler_libs.txt \
+	  $(COMPILERLIBS_MLIS)
+	cp style.css $@
+
+
+info: files
+	cd infoman \
+	  && rm -f ocaml.info* \
+	  && $(HEVEA) $(INFO_FLAGS) -o ocaml.info.body \
+	    -I .. -I ../cmds -I ../library -I ../refman -I ../tutorials \
+	    -I ../../styles -I ../texstuff \
+	    ../manual.inf -e macros.tex ../manual.tex
+	cat manual.info.header infoman/ocaml.info.body > infoman/ocaml.info
+	cd infoman \
+	  && rm -f ocaml.info.tmp ocaml.info.body \
+	  && gzip -9 ocaml.info*
+
+text: files
+	cd textman \
+	  && $(HEVEA) $(TEXT_FLAGS) \
+	    -I .. -I ../cmds -I ../library -I ../refman -I ../tutorials \
+	    -I ../../styles -I ../texstuff \
+	    ../manual.inf -e macros.tex ../manual.tex
+
+
+all:
+	$(MAKE) html text info manual
+	$(MAKE) manual
+	$(MAKE) index
+	$(MAKE) manual
+
+release: all
+	cp htmlman/manual.html $(RELEASE)refman.html
+	rm -f htmlman/manual.{html,haux,hmanual*,htoc}
+	tar zcf $(RELEASE)refman-html.tar.gz \
+	  htmlman/*.* htmlman/libref htmlman/compilerlibref htmlman/fonts
+	zip -8 $(RELEASE)refman-html.zip \
+	  htmlman/*.* htmlman/libref/*.* htmlman/compilerlibref/*.* \
+	  htmlman/fonts/*.*
+	cp texstuff/manual.pdf $(RELEASE)refman.pdf
+	cp textman/manual.txt $(RELEASE)refman.txt
+	tar cf - infoman/ocaml.info* | gzip > $(RELEASE)refman.info.tar.gz
+
+
+files: $(FILES)
+	$(MAKE) -C cmds      all
+	$(MAKE) -C library   all
+	$(MAKE) -C refman    all
+	$(MAKE) -C tutorials all
+
+etex-files: $(FILES)
+	$(MAKE) -C cmds      etex-files
+	$(MAKE) -C library   etex-files
+	$(MAKE) -C refman    etex-files
+	$(MAKE) -C tutorials etex-files
+
+
+%.tex: %.etex
+	$(TEXQUOTE) < $< > $*.texquote_error.tex
+	mv $*.texquote_error.tex $@
+
+version.tex: $(SRC)/VERSION
+	sed -n -e '1s/^\([0-9]*\.[0-9]*\).*$$/\\def\\ocamlversion{\1}/p' $< > $@
+
+warnings-help.etex: $(SRC)/utils/warnings.ml $(SRC)/ocamlc
+	(echo "% This file is generated from (ocamlc -warn-help)";\
+	 echo "% according to a rule in manual/manual/Makefile.";\
+	 echo "% In particular, the reference to documentation sections";\
+	 echo "% are inserted through the Makefile, which should be updated";\
+	 echo "% when a new warning is documented.";\
+	 echo "%";\
+	 $(SET_LD_PATH) $(SRC)/boot/ocamlrun $(SRC)/ocamlc -warn-help \
+	 | sed -e 's/^ *\([0-9A-Z][0-9]*\)\(.*\)/\\item[\1] \2/'\
+	) >$@
+#	sed --inplace is not portable, emulate
+	for i in 52 57; do\
+	  sed\
+	    s'/\\item\['$$i'\]/\\item\['$$i' (see \\ref{ss:warn'$$i'})\]/'\
+	    $@ > $@.tmp;\
+	  mv $@.tmp $@;\
+	done
+
+
+.PHONY: clean
+clean:
+	rm -f $(FILES) *.texquote_error
+	$(MAKE) -C cmds      clean
+	$(MAKE) -C library   clean
+	$(MAKE) -C refman    clean
+	$(MAKE) -C tutorials clean
+	-rm -f texstuff/*
+	cd htmlman; rm -rf libref compilerlibref index.html \
+	manual*.html *.haux *.hind *.svg
+	cd textman; rm -f manual.txt *.haux *.hind
+	cd infoman; rm -f ocaml.info ocaml.info-*  *.haux *.hind
diff --git a/manual/manual/allfiles.etex b/manual/manual/allfiles.etex
new file mode 100644
index 00000000..5c8aea8b
--- /dev/null
+++ b/manual/manual/allfiles.etex
@@ -0,0 +1,107 @@
+\makeindex{\jobname}
+\makeindex{\jobname.kwd}
+
+\setlength{\emergencystretch}{50pt}  % pour que TeX resolve les overfull hbox lui-meme
+
+\begin{document}
+
+\thispagestyle{empty}
+\begin{maintitle}
+~\vfill
+\Huge           The OCaml system \\
+                release \ocamlversion \\[1cm]
+\Large          Documentation and user's manual \\[1cm]
+\large          Xavier Leroy, \\
+                Damien Doligez, Alain Frisch, Jacques Garrigue, Didier Rémy and Jérôme Vouillon \\[1cm]
+                \today \\
+                ~
+\vfill
+\normalsize     Copyright \copyright\ \number\year\ Institut National de
+                Recherche en Informatique et en Automatique
+\end{maintitle}
+\cleardoublepage
+\setcounter{page}{1}
+
+\begin{htmlonly}
+\begin{quote}
+\rule{}{}
+This manual is also available in
+\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman.pdf}{PDF}.
+\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman.txt}{plain text},
+as a
+\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman-html.tar.gz}{bundle of HTML files},
+and as a
+\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman.info.tar.gz}{bundle of Emacs Info files}.
+\rule{}{}
+\end{quote}
+\end{htmlonly}
+
+\tableofcontents
+
+\input{foreword.tex}
+
+\part{An introduction to OCaml}
+\label{p:tutorials}
+\input{coreexamples.tex}
+\input{moduleexamples.tex}
+\input{objectexamples.tex}
+\input{lablexamples.tex}
+\input{polymorphism.tex}
+\input{advexamples.tex}
+
+\part{The OCaml language}
+\label{p:refman}
+\input{refman.tex}
+\input{exten.tex}
+
+\part{The OCaml tools}
+\label{p:commands}
+
+\input{comp.tex}
+\input{top.tex}
+\input{runtime.tex}
+\input{native.tex}
+\input{lexyacc.tex}
+\input{ocamldep.tex}
+\input{browser.tex}
+\input{ocamldoc.tex}
+\input{debugger.tex}
+\input{profil.tex}
+\input{ocamlbuild.tex}
+% \input emacs.tex
+\input{intf-c.tex}
+\input{flambda.tex}
+\input{spacetime-chapter.tex}
+\input{afl-fuzz.tex}
+\input{instrumented-runtime.tex}
+
+\part{The OCaml library}
+\label{p:library}
+\input{core.tex}
+\input{stdlib-blurb.tex}
+\input{compilerlibs.tex}
+\input{libunix.tex}
+\input{libnum.tex}
+\input{libstr.tex}
+\input{libthreads.tex}
+\input{libgraph.tex}
+\input{libdynlink.tex}
+\input{libbigarray.tex}
+
+\part{Appendix}
+\label{p:appendix}
+
+\ifouthtml
+\begin{links}
+\item \ahref{libref/index_modules.html}{Index of modules}
+\item \ahref{libref/index_module_types.html}{Index of module types}
+\item \ahref{libref/index_types.html}{Index of types}
+\item \ahref{libref/index_exceptions.html}{Index of exceptions}
+\item \ahref{libref/index_values.html}{Index of values}
+\end{links}
+\else
+\printindex{\jobname}{Index to the library}
+\fi
+\printindex{\jobname.kwd}{Index of keywords}
+
+\end{document}
diff --git a/manual/manual/anchored_book.hva b/manual/manual/anchored_book.hva
new file mode 100644
index 00000000..093d3859
--- /dev/null
+++ b/manual/manual/anchored_book.hva
@@ -0,0 +1,30 @@
+%hevea book class with anchor links in headers
+\input{bookcommon.hva}
+\newcommand{\@book@attr}[1]{\@secid\envclass@attr{#1}}
+\newcommand{\@titlesecanchor}{\@open{a}{class="section-anchor" href="\#\@sec@id@attr" aria-hidden="true"}\@print@u{xfeff}\@close{a}}
+\@makesection
+  {\part}{-2}{part}
+  {\@opencell{class="center"}{}{}\@open{h1}{\@book@attr{part}}}%
+  {\partname~\thepart}{\\}%
+  {\@close{h1}\@closecell}
+\newstyle{.part}{margin:2ex auto;text-align:center}
+\@makesection
+  {\chapter}{-1}{chapter}
+   {\@open{h1}{\@book@attr{chapter}}}{\chaptername~\thechapter}{\quad}{\@close{h1}}
+\@makesection
+  {\section}{0}{section}
+  {\@open{h2}{\@book@attr{section}}\@titlesecanchor}{\thesection}{\quad}{\@close{h2}}%
+\@makesection
+  {\subsection}{1}{subsection}
+  {\@open{h3}{\@book@attr{subsection}}\@titlesecanchor}{\thesubsection}{\quad}{\@close{h3}}%
+\@makesection
+  {\subsubsection}{2}{subsubsection}
+  {\@open{h4}{\@book@attr{subsubsection}}\@titlesecanchor}{\thesubsubsection}{\quad}{\@close{h4}}%
+\@makesection
+  {\paragraph}{3}{paragraph}
+  {\@open{h5}{\@book@attr{paragraph}}\@titlesecanchor}{\theparagraph}{\quad}{\@close{h5}}%
+\@makesection
+  {\subparagraph}{4}{subparagraph}
+  {\@open{h6}{\@book@attr{subparagraph}}\@titlesecanchor}{\thesubparagraph}{\quad}{\@close{h6}}%
+\newcommand{\hacha@style}{book}%
+\styleloadedtrue
diff --git a/manual/manual/biblio.etex b/manual/manual/biblio.etex
new file mode 100644
index 00000000..c1677702
--- /dev/null
+++ b/manual/manual/biblio.etex
@@ -0,0 +1,240 @@
+\chapter{Further reading}
+
+For the interested reader, we list below some references to books and
+reports related (sometimes loosely) to Caml Light.
+
+\section{Programming in ML}
+
+The books below are programming courses taught in ML. Their main goal
+is to teach programming, not to describe ML in full details --- though
+most contain fairly good introductions to the ML language. Some of
+those books use the Standard ML dialect instead of the Caml dialect,
+so you will have to keep in mind the differences in syntax and in
+semantics.
+
+\begin{itemize}
+
+\item Pierre Weis and Xavier Leroy. {\it Le langage Caml.}
+InterÉditions, 1993.
+
+The natural companion to this manual, provided you read French. This
+book is a step-by-step introduction to programming in Caml, and
+presents many realistic examples of Caml programs.
+
+\item  Guy Cousineau and Michel Mauny. {\it Approche fonctionnelle de
+la programmation}. Ediscience, 1995.
+
+Another Caml programming course written in French, with many original
+examples.
+
+\item Lawrence C.\ Paulson. {\it ML for the working programmer.}
+Cambridge University Press, 1991.
+
+A good introduction to programming in Standard ML. Develops a
+theorem prover as a complete example. Contains a presentation of
+the module system of Standard ML.
+
+\item Jeffrey D.\ Ullman. {\it Elements of ML programming.}
+Prentice Hall, 1993.
+
+Another good introduction to programming in Standard ML. No realistic
+examples, but a very detailed presentation of the language constructs.
+
+\item Ryan Stansifer. {\em ML primer.} Prentice-Hall, 1992.
+
+A short, but nice introduction to programming in Standard ML.
+
+\item Thérèse Accart Hardin and Véronique Donzeau-Gouge Viguié. {\em
+Concepts et outils de la programmation. Du fonctionnel à
+l'impératif avec Caml et Ada.} InterÉditions, 1992.
+
+A first course in programming, that first introduces the main programming
+notions in Caml, then shows them underlying Ada. Intended for
+beginners; slow-paced for the others.
+
+\item Rachel Harrison. {\em Abstract Data Types in Standard ML}.
+John Wiley \& Sons, 1993.
+
+A presentation of Standard ML from the standpoint of abstract data
+types. Uses intensively the Standard ML module system.
+
+\item Harold Abelson and Gerald Jay Sussman.
+{\em Structure and Interpretation of Computer Programs.} The MIT
+press, 1985.  (French translation: {\em Structure et interprétation
+des programmes informatiques}, InterÉditions, 1989.)
+
+An outstanding course on programming, taught in Scheme, the modern
+dialect of Lisp. Well worth reading, even if you are more interested
+in ML than in Lisp.
+
+\end{itemize}
+
+\section{Descriptions of ML dialects}
+
+The books and reports below are descriptions of various programming
+languages from the ML family. They assume some familiarity with ML.
+
+\begin{itemize}
+
+\item Xavier Leroy and Pierre Weis. {\em Manuel de référence du
+langage Caml.} InterÉditions, 1993.
+
+The French edition of the present reference manual and user's manual.
+
+\item Robert Harper. {\em Introduction to Standard ML.} Technical
+report ECS-LFCS-86-14, University of Edinburgh, 1986.
+
+An overview of Standard ML, including the module system. Terse, but
+still readable.
+
+\item Robin Milner, Mads Tofte and Robert Harper. {\em The definition
+of Standard ML.} The MIT press, 1990.
+
+A complete formal definition of Standard ML, in the framework of
+structured operational semantics. This book is probably the most
+mathematically precise definition of a programming language ever
+written. It is heavy on formalism and extremely terse, so
+even readers who are thoroughly familiar with ML will have
+major difficulties with it.
+
+\item Robin Milner and Mads Tofte. {\em Commentary on Standard ML.}
+The MIT Press, 1991.
+
+A commentary on the book above, that attempts to explain the most
+delicate parts and motivate the design choices. Easier to read than the
+Definition, but still rather involving.
+
+\item Guy Cousineau and Gérard Huet. {\em The CAML primer.} Technical
+report~122, INRIA, 1990.
+
+A short description of the original Caml system, from which Caml Light
+has evolved. Some familiarity with Lisp is assumed.
+
+\item Pierre Weis et al. {\em The CAML reference manual, version
+2.6.1.} Technical report~121, INRIA, 1990.
+
+The manual for the original Caml system, from which Caml Light
+has evolved.  
+
+\item Michael J.\ Gordon, Arthur J.\ Milner and Christopher P.\ Wadsworth.
+{\em Edinburgh LCF.} Lecture Notes in Computer Science
+volume~78, Springer-Verlag, 1979.
+
+This is the first published description of the ML language, at the
+time when it was nothing more than the control language for the LCF
+system, a theorem prover. This book is now obsolete, since the ML
+language has much evolved since then; but it is still of historical
+interest.
+
+\item Paul Hudak, Simon Peyton-Jones and Philip Wadler. {\em
+Report on the programming language Haskell, version 1.1.} Technical
+report, Yale University, 1991.
+
+Haskell is a purely functional language with lazy semantics that
+shares many important points with ML (full functionality, polymorphic
+typing), but has interesting features of its own (dynamic overloading,
+also called type classes).
+
+\end{itemize}
+
+\section{Implementing functional programming languages}
+
+The references below are intended for those who are curious to learn
+how a language like Caml Light is compiled and implemented.
+
+\begin{itemize}
+
+\item Xavier Leroy. {\em The ZINC experiment: an economical
+implementation of the ML language.} Technical report~117, INRIA, 1990.
+(Available by anonymous FTP on "ftp.inria.fr".)
+
+A description of the ZINC implementation, the prototype ML
+implementation that has evolved into Caml Light. Large parts of this
+report still apply to the current Caml Light system, in particular the
+description of the execution model and abstract machine. Other parts
+are now obsolete. Yet this report still gives a complete overview of the
+implementation techniques used in Caml Light.
+
+\item Simon Peyton-Jones. {\em The implementation of functional
+programming languages.} Prentice-Hall, 1987. (French translation:
+{\em Mise en \oe uvre des langages fonctionnels de programmation},
+Masson, 1990.)
+
+An excellent description of the implementation of purely functional
+languages with lazy semantics, using the technique known as graph
+reduction. The part of the book that deals with the transformation
+from ML to enriched lambda-calculus directly applies to Caml Light.
+You will find a good description of how pattern-matching is compiled
+and how types are inferred. The remainder of the book does not apply
+directly to Caml Light, since Caml Light is not purely functional (it
+has side-effects), has strict semantics, and does not use graph
+reduction at all.
+
+\item Andrew W.\ Appel. {\em Compiling with continuations.} Cambridge
+University Press, 1992.
+
+A complete description of an optimizing compiler for Standard ML,
+based on an intermediate representation called continuation-passing
+style. Shows how many advanced program optimizations can be applied to
+ML. Not directly relevant to the Caml Light system, since Caml Light
+does not use continuation-passing style at all, and makes little
+attempts at optimizing programs.
+
+\end{itemize}
+
+\section{Applications of ML}
+
+The following reports show ML at work in various, sometimes
+unexpected, areas.
+
+\begin{itemize}
+
+\item Emmanuel Chailloux and Guy Cousineau. {\em The MLgraph primer.}
+Technical report 92-15, École Normale Supérieure, 1992. (Available by
+anonymous FTP on "ftp.ens.fr".)
+%, répertoire "biblio", fichier
+% "liens-92-15.A4.300dpi.ps.Z".)
+
+Describes a Caml Light library that produces Postscript pictures
+through high-level drawing functions.
+
+\item Xavier Leroy. {\em Programmation du système Unix en Caml Light.}
+Technical report~147, INRIA, 1992. (Available by anonymous FTP on
+"ftp.inria.fr".)
+%, répertoire "INRIA/publication", fichier "RT-0147.ps.Z".)
+
+A Unix systems programming course, demonstrating the use of the Caml
+Light library that gives access to Unix system calls.
+
+\item John H.\ Reppy. {\em Concurrent programming with events --- The
+concurrent ML manual.} Cornell University, 1990.
+(Available by anonymous FTP on "research.att.com".)
+%, répertoire "dist/ml", fichier "CML-0.9.8.tar.Z".)
+
+Concurrent ML extends Standard ML of New Jersey with concurrent
+processes that communicate through channels and events.
+
+\item Jeannette M. Wing, Manuel Faehndrich, J.\ Gregory Morrisett and
+Scottt Nettles. {\em Extensions to Standard ML to support
+transactions.} Technical report CMU-CS-92-132, Carnegie-Mellon
+University, 1992. (Available by anonymous FTP on
+"reports.adm.cs.cmu.edu".)
+% , répertoire "1992", fichier "CMU-CS-92-132.ps".)
+
+How to integrate the basic database operations to Standard ML.
+
+\item Emden R.\ Gansner and John H.\ Reppy. {\em eXene.} Bell Labs,
+1991. (Available by anonymous FTP on "research.att.com".)
+%, répertoire "dist/ml", fichier "eXene-0.4.tar.Z".)
+
+An interface between Standard ML of New Jersey and the X Windows
+windowing system.
+
+%% \item Daniel de Rauglaudre. {\em X toolkit in Caml Light.} INRIA,
+%% 1992. (Included in the Caml Light distribution.)
+%% % Disponible par FTP anonyme sur
+%% % "ftp.inria.fr", répertoire "lang/caml-light", fichier "rt5.tar.Z".)
+%% 
+%% An interface between Caml Light and the X Windows windowing system. 
+
+\end{itemize}
diff --git a/manual/manual/cmds/.gitignore b/manual/manual/cmds/.gitignore
new file mode 100644
index 00000000..0d45900b
--- /dev/null
+++ b/manual/manual/cmds/.gitignore
@@ -0,0 +1,3 @@
+*.tex
+*.htex
+warnings.etex
diff --git a/manual/manual/cmds/Makefile b/manual/manual/cmds/Makefile
new file mode 100644
index 00000000..b6522128
--- /dev/null
+++ b/manual/manual/cmds/Makefile
@@ -0,0 +1,52 @@
+TOPDIR = ../../..
+include $(TOPDIR)/Makefile.tools
+
+LD_PATH = "$(TOPDIR)/otherlibs/str:$(TOPDIR)/otherlibs/unix"
+
+TOOLS = ../../tools
+CAMLLATEX = $(SET_LD_PATH) \
+  $(OCAMLRUN) $(TOPDIR)/tools/caml-tex \
+  -repo-root $(TOPDIR) -n 80 -v false
+TEXQUOTE = $(OCAMLRUN) $(TOOLS)/texquote2
+TRANSF = $(SET_LD_PATH) $(OCAMLRUN) $(TOOLS)/transf
+
+FILES = comp.tex top.tex runtime.tex native.tex lexyacc.tex intf-c.tex \
+  ocamldep.tex profil.tex debugger.tex browser.tex ocamldoc.tex \
+  warnings-help.tex ocamlbuild.tex flambda.tex spacetime-chapter.tex \
+  afl-fuzz.tex instrumented-runtime.tex unified-options.tex
+
+WITH_TRANSF = top.tex intf-c.tex flambda.tex spacetime-chapter.tex \
+  afl-fuzz.tex lexyacc.tex debugger.tex
+
+WITH_CAMLEXAMPLE = instrumented-runtime.tex ocamldoc.tex
+
+
+etex-files: $(FILES)
+all: $(FILES)
+
+
+%.tex: %.etex
+	$(TEXQUOTE) < $< > $*.texquote_error.tex
+	mv $*.texquote_error.tex $@
+
+$(WITH_TRANSF): %.tex: %.etex
+	$(TRANSF) < $< > $*.transf_error.tex
+	mv $*.transf_error.tex $*.transf_gen.tex
+	$(TEXQUOTE) < $*.transf_gen.tex > $*.texquote_error.tex
+	mv $*.texquote_error.tex $@
+
+$(WITH_CAMLEXAMPLE): %.tex: %.etex
+	$(CAMLLATEX) $< -o $*.gen.tex
+	$(TRANSF) < $*.gen.tex > $*.transf_error.tex
+	mv $*.transf_error.tex $*.transf_gen.tex
+	$(TEXQUOTE) < $*.transf_gen.tex > $*.texquote_error.tex
+	mv $*.texquote_error.tex $@
+
+warnings-help.etex: ../warnings-help.etex
+	cp $< $@
+
+
+.PHONY: clean
+clean:
+	rm -f *.tex
+	rm -f warnings-help.etex
diff --git a/manual/manual/cmds/afl-fuzz.etex b/manual/manual/cmds/afl-fuzz.etex
new file mode 100644
index 00000000..5426918f
--- /dev/null
+++ b/manual/manual/cmds/afl-fuzz.etex
@@ -0,0 +1,73 @@
+\chapter{Fuzzing with afl-fuzz}
+%HEVEA\cutname{afl-fuzz.html}
+
+\section{s:afl-overview}{Overview}
+
+American fuzzy lop (``afl-fuzz'') is a {\em fuzzer}, a tool for
+testing software by providing randomly-generated inputs, searching for
+those inputs which cause the program to crash.
+
+Unlike most fuzzers, afl-fuzz observes the internal behaviour of the
+program being tested, and adjusts the test cases it generates to
+trigger unexplored execution paths. As a result, test cases generated
+by afl-fuzz cover more of the possible behaviours of the tested
+program than other fuzzers.
+
+This requires that programs to be tested are instrumented to
+communicate with afl-fuzz. The native-code compiler ``ocamlopt'' can
+generate such instrumentation, allowing afl-fuzz to be used against
+programs written in OCaml.
+
+For more information on afl-fuzz, see the website at
+\ifouthtml
+\ahref{http://lcamtuf.coredump.cx/afl/}{http://lcamtuf.coredump.cx/afl/}.
+\else
+{\tt http://lcamtuf.coredump.cx/afl/}
+\fi
+
+\section{s:afl-generate}{Generating instrumentation}
+
+The instrumentation that afl-fuzz requires is not generated by
+default, and must be explicitly enabled, by passing the {\tt
+  -afl-instrument} option to {\tt ocamlopt}.
+
+To fuzz a large system without modifying build tools, OCaml's {\tt
+  configure} script also accepts the {\tt afl-instrument} option. If
+OCaml is configured with {\tt afl-instrument}, then all programs
+compiled by {\tt ocamlopt} will be instrumented.
+
+\subsection{ss:afl-advanced}{Advanced options}
+
+In rare cases, it is useful to control the amount of instrumentation
+generated. By passing the {\tt -afl-inst-ratio N} argument to {\tt
+  ocamlopt} with {\tt N} less than 100, instrumentation can be
+generated for only N\% of branches. (See the afl-fuzz documentation on
+the parameter {\tt AFL\_INST\_RATIO} for the precise effect of this).
+
+\section{s:afl-example}{Example}
+
+As an example, we fuzz-test the following program, {\tt readline.ml}:
+
+\begin{verbatim}
+let _ =
+  let s = read_line () in
+  match Array.to_list (Array.init (String.length s) (String.get s)) with
+    ['s'; 'e'; 'c'; 'r'; 'e'; 't'; ' '; 'c'; 'o'; 'd'; 'e'] -> failwith "uh oh"
+  | _ -> ()
+\end{verbatim}
+
+There is a single input (the string ``secret code'') which causes this
+program to crash, but finding it by blind random search is infeasible.
+
+Instead, we compile with afl-fuzz instrumentation enabled:
+\begin{verbatim}
+ocamlopt -afl-instrument readline.ml -o readline
+\end{verbatim}
+Next, we run the program under afl-fuzz:
+\begin{verbatim}
+mkdir input
+echo asdf > input/testcase
+mkdir output
+afl-fuzz -i input -o output ./readline
+\end{verbatim}
+By inspecting instrumentation output, the fuzzer finds the crashing input quickly.
diff --git a/manual/manual/cmds/browser.etex b/manual/manual/cmds/browser.etex
new file mode 100644
index 00000000..0731e8a4
--- /dev/null
+++ b/manual/manual/cmds/browser.etex
@@ -0,0 +1,6 @@
+\chapter{The browser/editor (ocamlbrowser)} \label{c:browser}
+%HEVEA\cutname{browser.html}
+
+Since OCaml version 4.02, the OCamlBrowser tool and the Labltk library
+are distributed separately from the OCaml compiler. The project is now
+hosted at \url{https://forge.ocamlcore.org/projects/labltk/}.
diff --git a/manual/manual/cmds/comp.etex b/manual/manual/cmds/comp.etex
new file mode 100644
index 00000000..649c9d56
--- /dev/null
+++ b/manual/manual/cmds/comp.etex
@@ -0,0 +1,525 @@
+\chapter{Batch compilation (ocamlc)} \label{c:camlc}
+%HEVEA\cutname{comp.html}
+
+This chapter describes the OCaml batch compiler "ocamlc",
+which compiles OCaml source files to bytecode object files and links
+these object files to produce standalone bytecode executable files.
+These executable files are then run by the bytecode interpreter
+"ocamlrun".
+
+\section{s:comp-overview}{Overview of the compiler}
+
+The "ocamlc" command has a command-line interface similar to the one of
+most C compilers. It accepts several types of arguments and processes them
+sequentially, after all options have been processed:
+
+\begin{itemize}
+\item
+Arguments ending in ".mli" are taken to be source files for
+compilation unit interfaces. Interfaces specify the names exported by
+compilation units: they declare value names with their types, define
+public data types, declare abstract data types, and so on. From the
+file \var{x}".mli", the "ocamlc" compiler produces a compiled interface
+in the file \var{x}".cmi".
+
+\item
+Arguments ending in ".ml" are taken to be source files for compilation
+unit implementations. Implementations provide definitions for the
+names exported by the unit, and also contain expressions to be
+evaluated for their side-effects.  From the file \var{x}".ml", the "ocamlc"
+compiler produces compiled object bytecode in the file \var{x}".cmo".
+
+If the interface file \var{x}".mli" exists, the implementation
+\var{x}".ml" is checked against the corresponding compiled interface
+\var{x}".cmi", which is assumed to exist. If no interface
+\var{x}".mli" is provided, the compilation of \var{x}".ml" produces a
+compiled interface file \var{x}".cmi" in addition to the compiled
+object code file \var{x}".cmo". The file \var{x}".cmi" produced
+corresponds to an interface that exports everything that is defined in
+the implementation \var{x}".ml".
+
+\item
+Arguments ending in ".cmo" are taken to be compiled object bytecode.  These
+files are linked together, along with the object files obtained
+by compiling ".ml" arguments (if any), and the OCaml standard
+library, to produce a standalone executable program. The order in
+which ".cmo" and ".ml" arguments are presented on the command line is
+relevant: compilation units are initialized in that order at
+run-time, and it is a link-time error to use a component of a unit
+before having initialized it. Hence, a given \var{x}".cmo" file must come
+before all ".cmo" files that refer to the unit \var{x}.
+
+\item
+Arguments ending in ".cma" are taken to be libraries of object bytecode.
+A library of object bytecode packs in a single file a set of object
+bytecode files (".cmo" files). Libraries are built with "ocamlc -a"
+(see the description of the "-a" option below). The object files
+contained in the library are linked as regular ".cmo" files (see
+above), in the order specified when the ".cma" file was built. The
+only difference is that if an object file contained in a library is
+not referenced anywhere in the program, then it is not linked in.
+
+\item
+Arguments ending in ".c" are passed to the C compiler, which generates
+a ".o" object file (".obj" under Windows). This object file is linked
+with the program if the "-custom" flag is set (see the description of
+"-custom" below).
+
+\item
+Arguments ending in ".o" or ".a" (".obj" or ".lib" under Windows)
+are assumed to be C object files and libraries. They are passed to the
+C linker when linking in "-custom" mode (see the description of
+"-custom" below).
+
+\item
+Arguments ending in ".so" (".dll" under Windows)
+are assumed to be C shared libraries (DLLs).  During linking, they are
+searched for external C functions referenced from the OCaml code,
+and their names are written in the generated bytecode executable.
+The run-time system "ocamlrun" then loads them dynamically at program
+start-up time.
+
+\end{itemize}
+
+The output of the linking phase is a file containing compiled bytecode
+that can be executed by the OCaml bytecode interpreter:
+the command named "ocamlrun". If "a.out" is the name of the file
+produced by the linking phase, the command
+\begin{alltt}
+        ocamlrun a.out \nth{arg}{1} \nth{arg}{2} \ldots \nth{arg}{n}
+\end{alltt}
+executes the compiled code contained in "a.out", passing it as
+arguments the character strings \nth{arg}{1} to \nth{arg}{n}.
+(See chapter~\ref{c:runtime} for more details.)
+
+On most systems, the file produced by the linking
+phase can be run directly, as in:
+\begin{alltt}
+        ./a.out \nth{arg}{1} \nth{arg}{2} \ldots \nth{arg}{n}
+\end{alltt}
+The produced file has the executable bit set, and it manages to launch
+the bytecode interpreter by itself.
+
+The compiler is able to emit some information on its internal stages.
+It can output ".cmt" files for the implementation of the compilation unit
+and ".cmti" for signatures if the option "-bin-annot" is passed to it (see the
+description of "-bin-annot" below).
+Each such file contains a typed abstract syntax tree (AST), that is produced
+during the type checking procedure. This tree contains all available information
+about the location and the specific type of each term in the source file.
+The AST is partial if type checking was unsuccessful.
+
+These ".cmt" and ".cmti" files are typically useful for code inspection tools.
+
+\section{s:comp-options}{Options}
+
+The following command-line options are recognized by "ocamlc".
+The options "-pack", "-a", "-c" and "-output-obj" are mutually exclusive.
+% Define boolean variables used by the macros in unified-options.etex
+\newif\ifcomp \comptrue
+\newif\ifnat \natfalse
+\newif\iftop \topfalse
+% unified-options gathers all options across the native/bytecode
+% compilers and toplevel
+\input{unified-options.tex}
+
+\paragraph{contextual-cli-control}{Contextual control of command-line options}
+
+The compiler command line can be modified ``from the outside''
+with the following mechanisms. These are experimental
+and subject to change. They should be used only for experimental and
+development work, not in released packages.
+
+\begin{options}
+\item["OCAMLPARAM" \rm(environment variable)]
+A set of arguments that will be inserted before or after the arguments from
+the command line. Arguments are specified in a comma-separated list
+of "name=value" pairs. A "_" is used to specify the position of
+the command line arguments, i.e. "a=x,_,b=y" means that "a=x" should be
+executed before parsing the arguments, and "b=y" after. Finally,
+an alternative separator can be specified as the
+first character of the string, within the set ":|; ,".
+\item["ocaml_compiler_internal_params" \rm(file in the stdlib directory)]
+A mapping of file names to lists of arguments that
+will be added to the command line (and "OCAMLPARAM") arguments.
+\item["OCAML_FLEXLINK" \rm(environment variable)]
+Alternative executable to use on native
+Windows for "flexlink" instead of the
+configured value. Primarily used for bootstrapping.
+\end{options}
+
+\section{s:modules-file-system}{Modules and the file system}
+
+This short section is intended to clarify the relationship between the
+names of the modules corresponding to compilation units and the names
+of the files that contain their compiled interface and compiled
+implementation.
+
+The compiler always derives the module name by taking the capitalized
+base name of the source file (".ml" or ".mli" file).  That is, it
+strips the leading directory name, if any, as well as the ".ml" or
+".mli" suffix; then, it set the first letter to uppercase, in order to
+comply with the requirement that module names must be capitalized.
+For instance, compiling the file "mylib/misc.ml" provides an
+implementation for the module named "Misc". Other compilation units
+may refer to components defined in "mylib/misc.ml" under the names
+"Misc."\var{name}; they can also do "open Misc", then use unqualified
+names \var{name}.
+
+The ".cmi" and ".cmo" files produced by the compiler have the same
+base name as the source file. Hence, the compiled files always have
+their base name equal (modulo capitalization of the first letter) to
+the name of the module they describe (for ".cmi" files) or implement
+(for ".cmo" files).
+
+When the compiler encounters a reference to a free module identifier
+"Mod", it looks in the search path for a file named "Mod.cmi" or "mod.cmi"
+and loads the compiled interface
+contained in that file. As a consequence, renaming ".cmi" files is not
+advised: the name of a ".cmi" file must always correspond to the name
+of the compilation unit it implements. It is admissible to move them
+to another directory, if their base name is preserved, and the correct
+"-I" options are given to the compiler. The compiler will flag an
+error if it loads a ".cmi" file that has been renamed.
+
+Compiled bytecode files (".cmo" files), on the other hand, can be
+freely renamed once created. That's because the linker never attempts
+to find by itself the ".cmo" file that implements a module with a
+given name: it relies instead on the user providing the list of ".cmo"
+files by hand.
+
+\section{s:comp-errors}{Common errors}
+
+This section describes and explains the most frequently encountered
+error messages.
+
+\begin{options}
+
+\item[Cannot find file \var{filename}]
+The named file could not be found in the current directory, nor in the
+directories of the search path. The \var{filename} is either a
+compiled interface file (".cmi" file), or a compiled bytecode file
+(".cmo" file). If \var{filename} has the format \var{mod}".cmi", this
+means you are trying to compile a file that references identifiers
+from module \var{mod}, but you have not yet compiled an interface for
+module \var{mod}. Fix: compile \var{mod}".mli" or \var{mod}".ml"
+first, to create the compiled interface \var{mod}".cmi".
+
+If \var{filename} has the format \var{mod}".cmo", this
+means you are trying to link a bytecode object file that does not
+exist yet. Fix: compile \var{mod}".ml" first.
+
+If your program spans several directories, this error can also appear
+because you haven't specified the directories to look into. Fix: add
+the correct "-I" options to the command line.
+
+\item[Corrupted compiled interface \var{filename}]
+The compiler produces this error when it tries to read a compiled
+interface file (".cmi" file) that has the wrong structure. This means
+something went wrong when this ".cmi" file was written: the disk was
+full, the compiler was interrupted in the middle of the file creation,
+and so on. This error can also appear if a ".cmi" file is modified after
+its creation by the compiler. Fix: remove the corrupted ".cmi" file,
+and rebuild it.
+
+\item[This expression has type \nth{t}{1}, but is used with type \nth{t}{2}]
+This is by far the most common type error in programs. Type \nth{t}{1} is
+the type inferred for the expression (the part of the program that is
+displayed in the error message), by looking at the expression itself.
+Type \nth{t}{2} is the type expected by the context of the expression; it
+is deduced by looking at how the value of this expression is used in
+the rest of the program. If the two types \nth{t}{1} and \nth{t}{2} are not
+compatible, then the error above is produced.
+
+In some cases, it is hard to understand why the two types \nth{t}{1} and
+\nth{t}{2} are incompatible. For instance, the compiler can report that
+``expression of type "foo" cannot be used with type "foo"'', and it
+really seems that the two types "foo" are compatible. This is not
+always true. Two type constructors can have the same name, but
+actually represent different types. This can happen if a type
+constructor is redefined. Example:
+\begin{verbatim}
+        type foo = A | B
+        let f = function A -> 0 | B -> 1
+        type foo = C | D
+        f C
+\end{verbatim}
+This result in the error message ``expression "C" of type "foo" cannot
+be used with type "foo"''.
+
+\item[The type of this expression, \var{t}, contains type variables
+      that cannot be generalized]
+Type variables ("'a", "'b", \ldots) in a type \var{t} can be in either
+of two states: generalized (which means that the type \var{t} is valid
+for all possible instantiations of the variables) and not generalized
+(which means that the type \var{t} is valid only for one instantiation
+of the variables). In a "let" binding "let "\var{name}" = "\var{expr},
+the type-checker normally generalizes as many type variables as
+possible in the type of \var{expr}. However, this leads to unsoundness
+(a well-typed program can crash) in conjunction with polymorphic
+mutable data structures. To avoid this, generalization is performed at
+"let" bindings only if the bound expression \var{expr} belongs to the
+class of ``syntactic values'', which includes constants, identifiers,
+functions, tuples of syntactic values, etc. In all other cases (for
+instance, \var{expr} is a function application), a polymorphic mutable
+could have been created and generalization is therefore turned off for
+all variables occurring in contravariant or non-variant branches of the
+type. For instance, if the type of a non-value is "'a list" the
+variable is generalizable ("list" is a covariant type constructor),
+but not in "'a list -> 'a list" (the left branch of "->" is
+contravariant) or "'a ref" ("ref" is non-variant).
+
+Non-generalized type variables in a type cause no difficulties inside
+a given structure or compilation unit (the contents of a ".ml" file,
+or an interactive session), but they cannot be allowed inside
+signatures nor in compiled interfaces (".cmi" file), because they
+could be used inconsistently later. Therefore, the compiler
+flags an error when a structure or compilation unit defines a value
+\var{name} whose type contains non-generalized type variables. There
+are two ways to fix this error:
+\begin{itemize}
+\item Add a type constraint or a ".mli" file to give a monomorphic
+type (without type variables) to \var{name}. For instance, instead of
+writing
+\begin{verbatim}
+    let sort_int_list = List.sort Stdlib.compare
+    (* inferred type 'a list -> 'a list, with 'a not generalized *)
+\end{verbatim}
+write
+\begin{verbatim}
+    let sort_int_list = (List.sort Stdlib.compare : int list -> int list);;
+\end{verbatim}
+\item If you really need \var{name} to have a polymorphic type, turn
+its defining expression into a function by adding an extra parameter.
+For instance, instead of writing
+\begin{verbatim}
+    let map_length = List.map Array.length
+    (* inferred type 'a array list -> int list, with 'a not generalized *)
+\end{verbatim}
+write
+\begin{verbatim}
+    let map_length lv = List.map Array.length lv
+\end{verbatim}
+\end{itemize}
+
+\item[Reference to undefined global \var{mod}]
+This error appears when trying to link an incomplete or incorrectly
+ordered set of files. Either you have forgotten to provide an
+implementation for the compilation unit named \var{mod} on the command line
+(typically, the file named \var{mod}".cmo", or a library containing
+that file). Fix: add the missing ".ml" or ".cmo" file to the command
+line.  Or, you have provided an implementation for the module named
+\var{mod}, but it comes too late on the command line: the
+implementation of \var{mod} must come before all bytecode object files
+that reference \var{mod}. Fix: change the order of ".ml" and ".cmo"
+files on the command line.
+
+Of course, you will always encounter this error if you have mutually
+recursive functions across modules. That is, function "Mod1.f" calls
+function "Mod2.g", and function "Mod2.g" calls function "Mod1.f".
+In this case, no matter what permutations you perform on the command
+line, the program will be rejected at link-time. Fixes:
+\begin{itemize}
+\item Put "f" and "g" in the same module.
+\item Parameterize one function by the other.
+That is, instead of having
+\begin{verbatim}
+mod1.ml:    let f x = ... Mod2.g ...
+mod2.ml:    let g y = ... Mod1.f ...
+\end{verbatim}
+define
+\begin{verbatim}
+mod1.ml:    let f g x = ... g ...
+mod2.ml:    let rec g y = ... Mod1.f g ...
+\end{verbatim}
+and link "mod1.cmo" before "mod2.cmo".
+\item Use a reference to hold one of the two functions, as in :
+\begin{verbatim}
+mod1.ml:    let forward_g =
+                ref((fun x -> failwith "forward_g") : )
+            let f x = ... !forward_g ...
+mod2.ml:    let g y = ... Mod1.f ...
+            let _ = Mod1.forward_g := g
+\end{verbatim}
+\end{itemize}
+
+\item[The external function \var{f} is not available]
+This error appears when trying to link code that calls external
+functions written in C.  As explained in
+chapter~\ref{c:intf-c}, such code must be linked with C libraries that
+implement the required \var{f} C function.  If the C libraries in
+question are not shared libraries (DLLs), the code must be linked in
+``custom runtime'' mode.  Fix: add the required C libraries to the
+command line, and possibly the "-custom" option.
+
+\end{options}
+
+\section{s:comp-warnings}{Warning reference}
+
+This section describes and explains in detail some warnings:
+
+\subsection{ss:warn9}{Warning 9: missing fields in a record pattern}
+
+  When pattern matching on records, it can be useful to match only few
+  fields of a record. Eliding fields can be done either implicitly
+  or explicitly by ending the record pattern with "; _".
+  However, implicit field elision is at odd with pattern matching
+  exhaustiveness checks.
+  Enabling warning 9 prioritizes exhaustiveness checks over the
+  convenience of implicit field elision and will warn on implicit
+  field elision in record patterns. In particular, this warning can
+  help to spot exhaustive record pattern that may need to be updated
+  after the addition of new fields to a record type.
+
+\begin{verbatim}
+type 'a point = {x : 'a; y : 'a}
+let dx { x } = x (* implicit field elision: trigger warning 9 *)
+let dy { y; _ } = y (* explicit field elision: do not trigger warning 9 *)
+\end{verbatim}
+
+\subsection{ss:warn52}{Warning 52: fragile constant pattern}
+
+  Some constructors, such as the exception constructors "Failure" and
+  "Invalid_argument", take as parameter a "string" value holding
+  a text message intended for the user.
+
+  These text messages are usually not stable over time: call sites
+  building these constructors may refine the message in a future
+  version to make it more explicit, etc. Therefore, it is dangerous to
+  match over the precise value of the message. For example, until
+  OCaml 4.02, "Array.iter2" would raise the exception
+\begin{verbatim}
+  Invalid_argument "arrays must have the same length"
+\end{verbatim}
+  Since 4.03 it raises the more helpful message
+\begin{verbatim}
+  Invalid_argument "Array.iter2: arrays must have the same length"
+\end{verbatim}
+  but this means that any code of the form
+\begin{verbatim}
+  try ...
+  with Invalid_argument "arrays must have the same length" -> ...
+\end{verbatim}
+  is now broken and may suffer from uncaught exceptions.
+
+  Warning 52 is there to prevent users from writing such fragile code
+  in the first place. It does not occur on every matching on a literal
+  string, but only in the case in which library authors expressed
+  their intent to possibly change the constructor parameter value in
+  the future, by using the attribute "ocaml.warn_on_literal_pattern"
+  (see the manual section on builtin attributes in
+  \ref{ss:builtin-attributes}):
+\begin{verbatim}
+  type t =
+    | Foo of string [@ocaml.warn_on_literal_pattern]
+    | Bar of string
+
+  let no_warning = function
+    | Bar "specific value" -> 0
+    | _ -> 1
+
+  let warning = function
+    | Foo "specific value" -> 0
+    | _ -> 1
+
+>    | Foo "specific value" -> 0
+>          ^^^^^^^^^^^^^^^^
+> Warning 52: Code should not depend on the actual values of
+> this constructor's arguments. They are only for information
+> and may change in future versions. (See manual section 8.5)
+\end{verbatim}
+
+  In particular, all built-in exceptions with a string argument have
+  this attribute set: "Invalid_argument", "Failure", "Sys_error" will
+  all raise this warning if you match for a specific string argument.
+
+  Additionally, built-in exceptions with a structured argument that
+  includes a string also have the attribute set: "Assert_failure" and
+  "Match_failure" will raise the warning for a pattern that uses a
+  literal string to match the first element of their tuple argument.
+
+  If your code raises this warning, you should {\em not} change the
+  way you test for the specific string to avoid the warning (for
+  example using a string equality inside the right-hand-side instead
+  of a literal pattern), as your code would remain fragile. You should
+  instead enlarge the scope of the pattern by matching on all possible
+  values.
+
+\begin{verbatim}
+
+let warning = function
+  | Foo _ -> 0
+  | _ -> 1
+\end{verbatim}
+
+  This may require some care: if the scrutinee may return several
+  different cases of the same pattern, or raise distinct instances of
+  the same exception, you may need to modify your code to separate
+  those several cases.
+
+  For example,
+\begin{verbatim}
+try (int_of_string count_str, bool_of_string choice_str) with
+  | Failure "int_of_string" -> (0, true)
+  | Failure "bool_of_string" -> (-1, false)
+\end{verbatim}
+  should be rewritten into more atomic tests. For example,
+  using the "exception" patterns documented in Section~\ref{sss:exception-match},
+  one can write:
+\begin{verbatim}
+match int_of_string count_str with
+  | exception (Failure _) -> (0, true)
+  | count ->
+    begin match bool_of_string choice_str with
+    | exception (Failure _) -> (-1, false)
+    | choice -> (count, choice)
+    end
+\end{verbatim}
+
+The only case where that transformation is not possible is if a given
+function call may raise distinct exceptions with the same constructor
+but different string values. In this case, you will have to check for
+specific string values. This is dangerous API design and it should be
+discouraged: it's better to define more precise exception constructors
+than store useful information in strings.
+
+\subsection{ss:warn57}{Warning 57: Ambiguous or-pattern variables under guard}
+
+  The semantics of or-patterns in OCaml is specified with
+  a left-to-right bias: a value \var{v} matches the pattern \var{p} "|" \var{q}
+  if it matches \var{p} or \var{q}, but if it matches both,
+  the environment captured by the match is the environment captured by
+  \var{p}, never the one captured by \var{q}.
+
+  While this property is generally intuitive, there is at least one specific
+  case where a different semantics might be expected.
+  Consider a pattern followed by a when-guard:
+  "|"~\var{p}~"when"~\var{g}~"->"~\var{e}, for example:
+\begin{verbatim}
+     | ((Const x, _) | (_, Const x)) when is_neutral x -> branch
+\end{verbatim}
+  The semantics is clear:
+  match the scrutinee against the pattern, if it matches, test the guard,
+  and if the guard passes, take the branch.
+  In particular, consider the input "(Const"~\var{a}", Const"~\var{b}")", where
+  \var{a} fails the test "is_neutral"~\var{a}, while \var{b} passes the test
+  "is_neutral"~\var{b}.  With the left-to-right semantics, the clause above is
+  {\em not} taken by its input: matching "(Const"~\var{a}", Const"~\var{b}")"
+  against the or-pattern succeeds in the left branch, it returns the
+  environment \var{x}~"->"~\var{a}, and then the guard
+  "is_neutral"~\var{a} is tested and fails, the branch is not taken.
+
+  However, another semantics may be considered more natural here:
+  any pair that has one side passing the test will take the branch. With this
+  semantics the previous code fragment would be equivalent to
+\begin{verbatim}
+     | (Const x, _) when is_neutral x -> branch
+     | (_, Const x) when is_neutral x -> branch
+\end{verbatim}
+  This is {\em not} the semantics adopted by OCaml.
+
+ Warning 57 is dedicated to these confusing cases where the
+ specified left-to-right semantics is not equivalent to a non-deterministic
+ 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.
diff --git a/manual/manual/cmds/debugger.etex b/manual/manual/cmds/debugger.etex
new file mode 100644
index 00000000..d964a250
--- /dev/null
+++ b/manual/manual/cmds/debugger.etex
@@ -0,0 +1,704 @@
+\chapter{The debugger (ocamldebug)} \label{c:debugger}
+%HEVEA\cutname{debugger.html}
+
+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}
+
+\section{s:debugger-compilation}{Compiling for debugging}
+
+Before the debugger can be used, the program must be compiled and
+linked with the "-g" option: all ".cmo" and ".cma" files that are part
+of the program should have been created with "ocamlc -g", and they
+must be linked together with "ocamlc -g".
+
+Compiling with "-g" entails no penalty on the running time of
+programs: object files and bytecode executable files are bigger and
+take longer to produce, but the executable files run at
+exactly the same speed as if they had been compiled without "-g".
+
+\section{s:debugger-invocation}{Invocation}
+
+\subsection{ss:debugger-start}{Starting the debugger}
+
+The OCaml debugger is invoked by running the program
+"ocamldebug" with the name of the bytecode executable file as first
+argument:
+\begin{alltt}
+        ocamldebug \optvar{options} \var{program} \optvar{arguments}
+\end{alltt}
+The arguments following \var{program} are optional, and are passed as
+command-line arguments to the program being debugged. (See also the
+"set arguments" command.)
+
+The following command-line options are recognized:
+\begin{options}
+\item["-c " \var{count}]
+Set the maximum number of simultaneously live checkpoints to \var{count}.
+
+\item["-cd " \var{dir}]
+Run the debugger program from the working directory \var{dir},
+instead of the current directory. (See also the "cd" command.)
+
+\item["-emacs"]
+Tell the debugger it is executed under Emacs. (See
+section~\ref{s:inf-debugger} for information on how to run the
+debugger under Emacs.)
+
+\item["-I "\var{directory}]
+Add \var{directory} to the list of directories searched for source
+files and compiled files. (See also the "directory" command.)
+
+\item["-s "\var{socket}]
+Use \var{socket} for communicating with the debugged program. See the
+description of the command "set socket" (section~\ref{ss:debugger-communication})
+for the format of \var{socket}.
+
+\item["-version"]
+Print version string and exit.
+
+\item["-vnum"]
+Print short version number and exit.
+
+\item["-help" or "--help"]
+Display a short usage summary and exit.
+%
+\end{options}
+
+\subsection{ss:debugger-init-file}{Initialization file}
+
+On start-up, the debugger will read commands from an initialization
+file before giving control to the user. The default file is
+".ocamldebug" in the current directory if it exists, otherwise
+".ocamldebug" in the user's home directory.
+
+\subsection{ss:debugger-exut}{Exiting the debugger}
+
+The command "quit" exits the debugger. You can also exit the debugger
+by typing an end-of-file character (usually "ctrl-D").
+
+Typing an interrupt character (usually "ctrl-C") will not exit the
+debugger, but will terminate the action of any debugger command that is in
+progress and return to the debugger command level.
+
+\section{s:debugger-commands}{Commands}
+
+A debugger command is a single line of input. It starts with a command
+name, which is followed by arguments depending on this name. Examples:
+\begin{verbatim}
+        run
+        goto 1000
+        set arguments arg1 arg2
+\end{verbatim}
+
+A command name can be truncated as long as there is no ambiguity. For
+instance, "go 1000" is understood as "goto 1000", since there are no
+other commands whose name starts with "go". For the most frequently
+used commands, ambiguous abbreviations are allowed. For instance, "r"
+stands for "run" even though there are others commands starting with
+"r". You can test the validity of an abbreviation using the "help" command.
+
+If the previous command has been successful, a blank line (typing just
+"RET") will repeat it.
+
+\subsection{ss:debugger-help}{Getting help}
+
+The OCaml debugger has a simple on-line help system, which gives
+a brief description of each command and variable.
+
+\begin{options}
+\item["help"]
+Print the list of commands.
+
+\item["help "\var{command}]
+Give help about the command \var{command}.
+
+\item["help set "\var{variable}, "help show "\var{variable}]
+Give help about the variable \var{variable}. The list of all debugger
+variables can be obtained with "help set".
+
+\item["help info "\var{topic}]
+Give help about \var{topic}. Use "help info" to get a list of known topics.
+\end{options}
+
+\subsection{ss:debugger-state}{Accessing the debugger state}
+
+\begin{options}
+\item["set "\var{variable} \var{value}]
+Set the debugger variable \var{variable} to the value \var{value}.
+
+\item["show "\var{variable}]
+Print the value of the debugger variable \var{variable}.
+
+\item["info "\var{subject}]
+Give information about the given subject.
+For instance, "info breakpoints" will print the list of all breakpoints.
+\end{options}
+
+\section{s:debugger-execution}{Executing a program}
+
+\subsection{ss:debugger-events}{Events}
+
+Events are ``interesting'' locations in the source code, corresponding
+to the beginning or end of evaluation of ``interesting''
+sub-expressions. Events are the unit of single-stepping (stepping goes
+to the next or previous event encountered in the program execution).
+Also, breakpoints can only be set at events. Thus, events play the
+role of line numbers in debuggers for conventional languages.
+
+During program execution, a counter is incremented at each event
+encountered. The value of this counter is referred as the {\em current
+time}. Thanks to reverse execution, it is possible to jump back and
+forth to any time of the execution.
+
+Here is where the debugger events (written \event) are located in
+the source code:
+\begin{itemize}
+\item Following a function application:
+\begin{alltt}
+(f arg)\event
+\end{alltt}
+\item On entrance to a function:
+\begin{alltt}
+fun x y z -> \event ...
+\end{alltt}
+\item On each case of a pattern-matching definition (function,
+"match"\ldots"with" construct, "try"\ldots"with" construct):
+\begin{alltt}
+function pat1 -> \event expr1
+       | ...
+       | patN -> \event exprN
+\end{alltt}
+\item Between subexpressions of a sequence:
+\begin{alltt}
+expr1; \event expr2; \event ...; \event exprN
+\end{alltt}
+\item In the two branches of a conditional expression:
+\begin{alltt}
+if cond then \event expr1 else \event expr2
+\end{alltt}
+\item At the beginning of each iteration of a loop:
+\begin{alltt}
+while cond do \event body done
+for i = a to b do \event body done
+\end{alltt}
+\end{itemize}
+Exceptions: A function application followed by a function return is replaced
+by the compiler by a jump (tail-call optimization). In this case, no
+event is put after the function application.
+% Also, no event is put after a function application when the function
+% is external (written in C).
+
+\subsection{ss:debugger-starting-program}{Starting the debugged program}
+
+The debugger starts executing the debugged program only when needed.
+This allows setting breakpoints or assigning debugger variables before
+execution starts. There are several ways to start execution:
+\begin{options}
+\item["run"] Run the program until a breakpoint is hit, or the program
+terminates.
+\item["goto 0"] Load the program and stop on the first event.
+\item["goto "\var{time}] Load the program and execute it until the
+given time. Useful when you already know approximately at what time
+the problem appears. Also useful to set breakpoints on function values
+that have not been computed at time 0 (see section~\ref{s:breakpoints}).
+\end{options}
+
+The execution of a program is affected by certain information it
+receives when the debugger starts it, such as the command-line
+arguments to the program and its working directory. The debugger
+provides commands to specify this information ("set arguments" and "cd").
+These commands must be used before program execution starts. If you try
+to change the arguments or the working directory after starting your
+program, the debugger will kill the program (after asking for confirmation).
+
+\subsection{ss:debugger-running}{Running the program}
+
+The following commands execute the program forward or backward,
+starting at the current time. The execution will stop either when
+specified by the command or when a breakpoint is encountered.
+
+\begin{options}
+\item["run"] Execute the program forward from current time. Stops at
+next breakpoint or when the program terminates.
+\item["reverse"] Execute the program backward from current time.
+Mostly useful to go to the last breakpoint encountered before the
+current time.
+\item["step "\optvar{count}] Run the program and stop at the next
+event. With an argument, do it \var{count} times. If \var{count} is 0,
+run until the program terminates or a breakpoint is hit.
+\item["backstep "\optvar{count}] Run the program backward and stop at
+the previous event. With an argument, do it \var{count} times.
+\item["next "\optvar{count}] Run the program and stop at the next
+event, skipping over function calls. With an argument, do it
+\var{count} times.
+\item["previous "\optvar{count}] Run the program backward and stop at
+the previous event, skipping over function calls. With an argument, do
+it \var{count} times.
+\item["finish"] Run the program until the current function returns.
+\item["start"] Run the program backward and stop at the first event
+before the current function invocation.
+\end{options}
+
+\subsection{ss:debugger-time-travel}{Time travel}
+
+You can jump directly to a given time, without stopping on
+breakpoints, using the "goto" command.
+
+As you move through the program, the debugger maintains an history of
+the successive times you stop at. The "last" command can be used to
+revisit these times: each "last" command moves one step back through
+the history. That is useful mainly to undo commands such as "step"
+and "next".
+
+\begin{options}
+\item["goto "\var{time}]
+Jump to the given time.
+\item["last "\optvar{count}]
+Go back to the latest time recorded in the execution history. With an
+argument, do it \var{count} times.
+\item["set history "\var{size}]
+Set the size of the execution history.
+\end{options}
+
+\subsection{ss:debugger-kill}{Killing the program}
+
+\begin{options}
+\item["kill"] Kill the program being executed. This command is mainly
+useful if you wish to recompile the program without leaving the debugger.
+\end{options}
+
+\section{s:breakpoints}{Breakpoints}
+
+A breakpoint causes the program to stop whenever a certain point in
+the program is reached. It can be set in several ways using the
+"break" command. Breakpoints are assigned numbers when set, for
+further reference. The most comfortable way to set breakpoints is
+through the Emacs interface (see section~\ref{s:inf-debugger}).
+
+\begin{options}
+\item["break"]
+Set a breakpoint at the current position in the program execution. The
+current position must be on an event (i.e., neither at the beginning,
+nor at the end of the program).
+
+\item["break "\var{function}]
+Set a breakpoint at the beginning of \var{function}. This works only
+when the functional value of the identifier \var{function} has been
+computed and assigned to the identifier. Hence this command cannot be
+used at the very beginning of the program execution, when all
+identifiers are still undefined; use "goto" \var{time} to advance
+execution until the functional value is available.
+
+\item["break \@" \optvar{module} \var{line}]
+Set a breakpoint in module \var{module} (or in the current module if
+\var{module} is not given), at the first event of line \var{line}.
+
+\item["break \@" \optvar{module} \var{line} \var{column}]
+Set a breakpoint in module \var{module} (or in the current module if
+\var{module} is not given), at the event closest to line \var{line},
+column \var{column}.
+
+\item["break \@" \optvar{module} "#" \var{character}]
+Set a breakpoint in module \var{module} at the event closest to
+character number \var{character}.
+
+\item["break " \var{frag}":"\var{pc}, "break " \var{pc}]
+Set a breakpoint at code address \var{frag}":"\var{pc}.  The integer
+\var{frag} is the identifier of a code fragment, a set of modules that
+have been loaded at once, either initially or with the "Dynlink"
+module. The integer \var{pc} is the instruction counter within this
+code fragment.  If \var{frag} is omitted, it defaults to 0, which is
+the code fragment of the program loaded initially.
+
+\item["delete "\optvar{breakpoint-numbers}]
+Delete the specified breakpoints. Without argument, all breakpoints
+are deleted (after asking for confirmation).
+
+\item["info breakpoints"] Print the list of all breakpoints.
+\end{options}
+
+\section{s:debugger-callstack}{The call stack}
+
+Each time the program performs a function application, it saves the
+location of the application (the return address) in a block of data
+called a stack frame. The frame also contains the local variables of
+the caller function. All the frames are allocated in a region of
+memory called the call stack. The command "backtrace" (or "bt")
+displays parts of the call stack.
+
+At any time, one of the stack frames is ``selected'' by the debugger; several
+debugger commands refer implicitly to the selected frame. In particular,
+whenever you ask the debugger for the value of a local variable, the
+value is found in the selected frame. The commands "frame", "up" and "down"
+select whichever frame you are interested in.
+
+When the program stops, the debugger automatically selects the
+currently executing frame and describes it briefly as the "frame"
+command does.
+
+\begin{options}
+\item["frame"]
+Describe the currently selected stack frame.
+
+\item["frame" \var{frame-number}]
+Select a stack frame by number and describe it. The frame currently
+executing when the program stopped has number 0; its caller has number
+1; and so on up the call stack.
+
+\item["backtrace "\optvar{count}, "bt "\optvar{count}]
+Print the call stack. This is useful to see which sequence of function
+calls led to the currently executing frame. With a positive argument,
+print only the innermost \var{count} frames.
+With a negative argument, print only the outermost -\var{count} frames.
+
+\item["up" \optvar{count}]
+Select and display the stack frame just ``above'' the selected frame,
+that is, the frame that called the selected frame. An argument says how
+many frames to go up.
+
+\item["down "\optvar{count}]
+Select and display the stack frame just ``below'' the selected frame,
+that is, the frame that was called by the selected frame. An argument
+says how many frames to go down.
+\end{options}
+
+\section{s:debugger-examining-values}{Examining variable values}
+
+The debugger can print the current value of simple expressions. The
+expressions can involve program variables: all the identifiers that
+are in scope at the selected program point can be accessed.
+
+Expressions that can be printed are a subset of OCaml
+expressions, as described by the following grammar:
+\begin{syntax}
+simple-expr:
+    lowercase-ident
+  | { capitalized-ident '.' } lowercase-ident
+  | '*'
+  | '$' integer
+  | simple-expr '.' lowercase-ident
+  | simple-expr '.(' integer ')'
+  | simple-expr '.[' integer ']'
+  | '!' simple-expr
+  | '(' simple-expr ')'
+\end{syntax}
+The first two cases refer to a value identifier, either unqualified or
+qualified by the path to the structure that define it.
+"*" refers to the result just computed (typically, the value of a
+function application), and is valid only if the selected event is an
+``after'' event (typically, a function application).
+@'$' integer@ refer to a previously printed value. The remaining four
+forms select part of an expression: respectively, a record field, an
+array element, a string element, and the current contents of a
+reference.
+
+\begin{options}
+\item["print "\var{variables}]
+Print the values of the given variables. "print" can be abbreviated as
+"p".
+\item["display "\var{variables}]
+Same as "print", but limit the depth of printing to 1. Useful to
+browse large data structures without printing them in full.
+"display" can be abbreviated as "d".
+\end{options}
+
+When printing a complex expression, a name of the form "$"\var{integer}
+is automatically assigned to its value. Such names are also assigned
+to parts of the value that cannot be printed because the maximal
+printing depth is exceeded. Named values can be printed later on
+with the commands "p $"\var{integer} or "d $"\var{integer}.
+Named values are valid only as long as the program is stopped. They
+are forgotten as soon as the program resumes execution.
+
+\begin{options}
+\item["set print_depth" \var{d}]
+Limit the printing of values to a maximal depth of \var{d}.
+\item["set print_length" \var{l}]
+Limit the printing of values to at most \var{l} nodes printed.
+\end{options}
+
+\section{s:debugger-control}{Controlling the debugger}
+
+\subsection{ss:debugger-name-and-arguments}{Setting the program name and arguments}
+
+\begin{options}
+\item["set program" \var{file}]
+Set the program name to \var{file}.
+\item["set arguments" \var{arguments}]
+Give \var{arguments} as command-line arguments for the program.
+\end{options}
+
+A shell is used to pass the arguments to the debugged program. You can
+therefore use wildcards, shell variables, and file redirections inside
+the arguments. To debug programs that read from standard input, it is
+recommended to redirect their input from a file (using
+"set arguments < input-file"), otherwise input to the program and
+input to the debugger are not properly separated, and inputs are not
+properly replayed when running the program backwards.
+
+\subsection{ss:debugger-loading}{How programs are loaded}
+
+The "loadingmode" variable controls how the program is executed.
+
+\begin{options}
+\item["set loadingmode direct"]
+The program is run directly by the debugger. This is the default mode.
+\item["set loadingmode runtime"]
+The debugger execute the OCaml runtime "ocamlrun" on the program.
+Rarely useful; moreover it prevents the debugging of programs compiled
+in ``custom runtime'' mode.
+\item["set loadingmode manual"]
+The user starts manually the program, when asked by the debugger.
+Allows remote debugging (see section~\ref{ss:debugger-communication}).
+\end{options}
+
+\subsection{ss:debugger-search-path}{Search path for files}
+
+The debugger searches for source files and compiled interface files in
+a list of directories, the search path. The search path initially
+contains the current directory "." and the standard library directory.
+The "directory" command adds directories to the path.
+
+Whenever the search path is modified, the debugger will clear any
+information it may have cached about the files.
+
+\begin{options}
+\item["directory" \var{directorynames}]
+Add the given directories to the search path. These directories are
+added at the front, and will therefore be searched first.
+
+\item["directory" \var{directorynames} "for" \var{modulename}]
+Same as "directory" \var{directorynames}, but the given directories will be
+searched only when looking for the source file of a module that has 
+been packed into \var{modulename}.
+
+\item["directory"]
+Reset the search path. This requires confirmation.
+\end{options}
+
+\subsection{ss:debugger-working-dir}{Working directory}
+
+Each time a program is started in the debugger, it inherits its working
+directory from the current working directory of the debugger.  This
+working directory is initially whatever it inherited from its parent
+process (typically the shell), but you can specify a new working
+directory in the debugger with the "cd" command or the "-cd"
+command-line option.
+
+\begin{options}
+\item["cd" \var{directory}]
+Set the working directory for "ocamldebug" to \var{directory}.
+
+\item["pwd"]
+Print the working directory for "ocamldebug".
+\end{options}
+
+\subsection{ss:debugger-reverse-execution}{Turning reverse execution on and off}
+
+In some cases, you may want to turn reverse execution off. This speeds
+up the program execution, and is also sometimes useful for interactive
+programs.
+
+Normally, the debugger takes checkpoints of the program state from
+time to time. That is, it makes a copy of the current state of the
+program (using the Unix system call "fork"). If the variable
+\var{checkpoints} is set to "off", the debugger will not take any
+checkpoints.
+
+\begin{options}
+\item["set checkpoints" \var{on/off}]
+Select whether the debugger makes checkpoints or not.
+\end{options}
+
+\subsection{ss:debugger-fork}{Behavior of the debugger with respect to "fork"}
+
+When the program issues a call to "fork", the debugger can either
+follow the child or the parent. By default, the debugger follows the
+parent process. The variable \var{follow_fork_mode} controls this
+behavior:
+
+\begin{options}
+\item["set follow_fork_mode" \var{child/parent}]
+Select whether to follow the child or the parent in case of a call to
+"fork".
+\end{options}
+
+\subsection{ss:debugger-stop-at-new-load}{Stopping execution when new code is loaded}
+
+The debugger is compatible with the "Dynlink" module. However, when an
+external module is not yet loaded, it is impossible to set a
+breakpoint in its code. In order to facilitate setting breakpoints in
+dynamically loaded code, the debugger stops the program each time new
+modules are loaded. This behavior can be disabled using the
+\var{break_on_load} variable:
+
+\begin{options}
+\item["set break_on_load"  \var{on/off}]
+Select whether to stop after loading new code.
+\end{options}
+
+\subsection{ss:debugger-communication}{Communication between the debugger and the program}
+
+The debugger communicate with the program being debugged through a
+Unix socket. You may need to change the socket name, for example if
+you need to run the debugger on a machine and your program on another.
+
+\begin{options}
+\item["set socket" \var{socket}]
+Use \var{socket} for communication with the program. \var{socket} can be
+either a file name, or an Internet port specification
+\var{host}:\var{port}, where \var{host} is a host name or an Internet
+address in dot notation, and \var{port} is a port number on the host.
+\end{options}
+
+On the debugged program side, the socket name is passed through the
+"CAML_DEBUG_SOCKET" environment variable.
+
+\subsection{ss:debugger-fine-tuning}{Fine-tuning the debugger}
+
+Several variables enables to fine-tune the debugger. Reasonable
+defaults are provided, and you should normally not have to change them.
+
+\begin{options}
+\item["set processcount" \var{count}]
+Set the maximum number of checkpoints to \var{count}. More checkpoints
+facilitate going far back in time, but use more memory and create more
+Unix processes.
+\end{options}
+
+As checkpointing is quite expensive, it must not be done too often. On
+the other hand, backward execution is faster when checkpoints are
+taken more often. In particular, backward single-stepping is more
+responsive when many checkpoints have been taken just before the
+current time. To fine-tune the checkpointing strategy, the debugger
+does not take checkpoints at the same frequency for long displacements
+(e.g. "run") and small ones (e.g. "step"). The two variables "bigstep"
+and "smallstep" contain the number of events between two checkpoints
+in each case.
+
+\begin{options}
+\item["set bigstep" \var{count}]
+Set the number of events between two checkpoints for long displacements.
+\item["set smallstep" \var{count}]
+Set the number of events between two checkpoints for small
+displacements.
+\end{options}
+
+The following commands display information on checkpoints and events:
+
+\begin{options}
+\item["info checkpoints"]
+Print a list of checkpoints.
+\item["info events" \optvar{module}]
+Print the list of events in the given module (the current module, by default).
+\end{options}
+
+\subsection{ss:debugger-printers}{User-defined printers}
+
+Just as in the toplevel system (section~\ref{s:toplevel-directives}),
+the user can register functions for printing values of certain types.
+For technical reasons, the debugger cannot call printing functions
+that reside in the program being debugged. The code for the printing
+functions must therefore be loaded explicitly in the debugger.
+
+\begin{options}
+\item["load_printer \""\var{file-name}"\""]
+Load in the debugger the indicated ".cmo" or ".cma" object file.  The
+file is loaded in an environment consisting only of the OCaml
+standard library plus the definitions provided by object files
+previously loaded using "load_printer".  If this file depends on other
+object files not yet loaded, the debugger automatically loads them if
+it is able to find them in the search path.  The loaded file does not
+have direct access to the modules of the program being debugged.
+
+\item["install_printer "\var{printer-name}]
+Register the function named \var{printer-name} (a
+value path) as a printer for objects whose types match the argument
+type of the function. That is, the debugger will call
+\var{printer-name} when it has such an object to print.
+The printing function \var{printer-name} must use the "Format" library
+module to produce its output, otherwise its output will not be
+correctly located in the values printed by the toplevel loop.
+
+The value path \var{printer-name} must refer to one of the functions
+defined by the object files loaded using "load_printer". It cannot
+reference the functions of the program being debugged.
+
+\item["remove_printer "\var{printer-name}]
+Remove the named function from the table of value printers.
+\end{options}
+
+\section{s:debugger-misc-cmds}{Miscellaneous commands}
+
+\begin{options}
+\item["list" \optvar{module} \optvar{beginning} \optvar{end}]
+List the source of module \var{module}, from line number
+\var{beginning} to line number \var{end}. By default, 20 lines of the
+current module are displayed, starting 10 lines before the current
+position.
+\item["source" \var{filename}]
+Read debugger commands from the script \var{filename}.
+\end{options}
+
+\section{s:inf-debugger}{Running the debugger under Emacs}
+
+The most user-friendly way to use the debugger is to run it under Emacs.
+See the file "emacs/README" in the distribution for information on how
+to load the Emacs Lisp files for OCaml support.
+
+The OCaml debugger is started under Emacs by the command "M-x
+camldebug", with argument the name of the executable file
+\var{progname} to debug.  Communication with the debugger takes place
+in an Emacs buffer named  "*camldebug-"\var{progname}"*". The editing
+and history facilities of Shell mode are available for interacting
+with the debugger.
+
+In addition, Emacs displays the source files containing the current
+event (the current position in the program execution) and highlights
+the location of the event. This display is updated synchronously with
+the debugger action.
+
+The following bindings for the most common debugger commands are
+available in the "*camldebug-"\var{progname}"*" buffer:
+
+\begin{options}
+\item["C-c C-s"] (command "step"): execute the program one step forward.
+\item["C-c C-k"] (command "backstep"): execute the program one step backward.
+\item["C-c C-n"] (command "next"): execute the program one step
+forward, skipping over function calls.
+\item[Middle mouse button] (command "display"): display named value.
+"$"\var{n} under mouse cursor (support incremental browsing of large
+data structures).
+\item["C-c C-p"] (command "print"): print value of identifier at point.
+\item["C-c C-d"] (command "display"): display value of identifier at point.
+\item["C-c C-r"] (command "run"): execute the program forward to next
+breakpoint.
+\item["C-c C-v"] (command "reverse"): execute the program backward to
+latest breakpoint.
+\item["C-c C-l"] (command "last"): go back one step in the command history.
+\item["C-c C-t"] (command "backtrace"): display backtrace of function calls.
+\item["C-c C-f"] (command "finish"): run forward till the current
+function returns.
+\item["C-c <"]   (command "up"): select the stack frame below the
+current frame.
+\item["C-c >"]   (command "down"): select the stack frame above the
+current frame.
+\end{options}
+
+In all buffers in OCaml editing mode, the following debugger commands
+are also available:
+
+\begin{options}
+\item["C-x C-a C-b"] (command "break"): set a breakpoint at event closest
+to point
+\item["C-x C-a C-p"] (command "print"): print value of identifier at point
+\item["C-x C-a C-d"] (command "display"): display value of identifier at point
+\end{options}
diff --git a/manual/manual/cmds/flambda.etex b/manual/manual/cmds/flambda.etex
new file mode 100644
index 00000000..c5b2ac4a
--- /dev/null
+++ b/manual/manual/cmds/flambda.etex
@@ -0,0 +1,1344 @@
+\chapter{Optimisation with Flambda}
+%HEVEA\cutname{flambda.html}
+
+\section{s:flambda-overview}{Overview}
+
+{\em Flambda} is the term used to describe a series of optimisation passes
+provided by the native code compilers as of OCaml 4.03.
+
+Flambda aims to make it easier to write idiomatic OCaml code without
+incurring performance penalties.
+
+To use the Flambda optimisers it is necessary to pass the {\tt -flambda}
+option to the OCaml {\tt configure} script.  (There is no support for a
+single compiler that can operate in both Flambda and non-Flambda modes.)
+Code compiled with Flambda
+cannot be linked into the same program as code compiled without Flambda.
+Attempting to do this will result in a compiler error.
+
+Whether or not a particular {\tt ocamlopt} uses Flambda may be
+determined by invoking it with the {\tt -config} option and looking
+for any line starting with ``{\tt flambda:}''.  If such a line is present
+and says ``{\tt true}'', then Flambda is supported, otherwise it is not.
+
+Flambda provides full optimisation across different compilation units,
+so long as the {\tt .cmx} files for the dependencies of the unit currently
+being compiled are available.  (A compilation unit corresponds to a
+single {\tt .ml} source file.)  However it does not yet act entirely as
+a whole-program compiler: for example, elimination of dead code across
+a complete set of compilation units is not supported.
+
+Optimisation with Flambda is not currently supported when generating
+bytecode.
+
+Flambda should not in general affect the semantics of existing programs.
+Two exceptions to this rule are: possible elimination of pure code
+that is being benchmarked (see section\ \ref{s:flambda-inhibition}) and changes in
+behaviour of code using unsafe operations (see section\ \ref{s:flambda-unsafe}).
+
+Flambda does not yet optimise array or string bounds checks.  Neither
+does it take hints for optimisation from any assertions written by the
+user in the code.
+
+Consult the {\em Glossary} at the end of this chapter for definitions of
+technical terms used below.
+
+\section{s:flambda-cli}{Command-line flags}
+
+The Flambda optimisers provide a variety of command-line flags that may
+be used to control their behaviour.  Detailed descriptions of each flag
+are given in the referenced sections.  Those sections also describe any
+arguments which the particular flags take.
+
+Commonly-used options:
+\begin{options}
+\item[\machine{-O2}] Perform more optimisation than usual.  Compilation
+times may be lengthened.  (This flag is an abbreviation for a certain
+set of parameters described in section\ \ref{s:flambda-defaults}.)
+\item[\machine{-O3}] Perform even more optimisation than usual, possibly
+including unrolling of recursive functions.  Compilation times may be
+significantly lengthened.
+\item[\machine{-Oclassic}] Make inlining decisions at the point of
+definition of a function rather than at the call site(s).  This mirrors
+the behaviour of OCaml compilers not using Flambda.  Compared to compilation
+using the new Flambda inlining heuristics (for example at {\tt -O2}) it
+produces
+smaller {\tt .cmx} files, shorter compilation times and code that probably
+runs rather slower.  When using {\tt -Oclassic}, only the following options
+described in this section are relevant: {\tt -inlining-report} and
+{\tt -inline}.  If any other of the options described in this section are
+used, the behaviour is undefined and may cause an error in future versions
+of the compiler.
+\item[\machine{-inlining-report}] Emit {\tt .inlining} files (one per
+round of optimisation) showing all of the inliner's decisions.
+\end{options}
+
+Less commonly-used options:
+\begin{options}
+\item[\machine{-remove-unused-arguments}] Remove unused function arguments
+even when the argument is not specialised.  This may have a small
+performance penalty.
+See section\ \ref{ss:flambda-remove-unused-args}.
+\item[\machine{-unbox-closures}] Pass free variables via specialised arguments
+rather than closures (an optimisation for reducing allocation).  See
+section\ \ref{ss:flambda-unbox-closures}.  This may have a small performance penalty.
+\end{options}
+
+Advanced options, only needed for detailed tuning:
+\begin{options}
+\item[\machine{-inline}] The behaviour depends on whether {\tt -Oclassic}
+is used.
+\begin{itemize}
+\item When not in {\tt -Oclassic} mode, {\tt -inline} limits the total
+size of functions considered for inlining during any speculative inlining
+search.  (See section\ \ref{ss:flambda-speculation}.)  Note that
+this parameter does
+{\bf not} control the assessment as to whether any particular function may
+be inlined.  Raising it to excessive amounts will not necessarily cause
+more functions to be inlined.
+\item When in {\tt -Oclassic} mode, {\tt -inline} behaves as in
+previous versions of the compiler: it is the maximum size of function to
+be considered for inlining.  See section\ \ref{ss:flambda-classic}.
+\end{itemize}
+\item[\machine{-inline-toplevel}] The equivalent of {\tt -inline} but used
+when speculative inlining starts at toplevel.  See
+section\ \ref{ss:flambda-speculation}.
+Not used in {\tt -Oclassic} mode.
+\item[\machine{-inline-branch-factor}] Controls how the inliner assesses
+whether a code path is likely to be hot or cold.  See
+section\ \ref{ss:flambda-assessment-inlining}.
+\item[\machine{-inline-alloc-cost},
+  \machine{-inline-branch-cost},
+  \machine{-inline-call-cost}] Controls how the inliner assesses the runtime
+  performance penalties associated with various operations.  See
+  section\ \ref{ss:flambda-assessment-inlining}.
+\item[\machine{-inline-indirect-cost},
+  \machine{-inline-prim-cost}] Likewise.
+\item[\machine{-inline-lifting-benefit}] Controls inlining of functors
+at toplevel.  See section\ \ref{ss:flambda-assessment-inlining}.
+\item[\machine{-inline-max-depth}] The maximum depth of any
+speculative inlining search.  See section\ \ref{ss:flambda-speculation}.
+\item[\machine{-inline-max-unroll}] The maximum depth of any unrolling of
+recursive functions during any speculative inlining search.
+See section\ \ref{ss:flambda-speculation}.
+\item[\machine{-no-unbox-free-vars-of-closures}] %
+Do not unbox closure variables.  See section\ \ref{ss:flambda-unbox-fvs}.
+\item[\machine{-no-unbox-specialised-args}] %
+Do not unbox arguments to which functions have been specialised.  See
+section\ \ref{ss:flambda-unbox-spec-args}.
+\item[\machine{-rounds}] How many rounds of optimisation to perform.
+See section\ \ref{ss:flambda-rounds}.
+\item[\machine{-unbox-closures-factor}] Scaling factor for benefit
+calculation when using {\tt -unbox-closures}.  See
+section\ \ref{ss:flambda-unbox-closures}.
+\end{options}
+
+\paragraph{Notes}
+\begin{itemize}
+\item The set of command line flags relating to optimisation should typically
+be specified to be the same across an entire project.  Flambda does not
+currently record the requested flags in the {\tt .cmx} files.  As such,
+inlining of functions from previously-compiled units will subject their code
+to the optimisation parameters of the unit currently being compiled, rather
+than those specified when they were previously compiled.  It is hoped to
+rectify this deficiency in the future.
+
+\item Flambda-specific flags do not affect linking with the exception of
+affecting the optimisation of code in the startup file (containing
+generated functions such as currying helpers).  Typically such optimisation
+will not be significant, so eliding such flags at link time might be
+reasonable.
+
+\item Flambda-specific flags are silently accepted even when the
+{\tt -flambda} option was not provided to the {\tt configure} script.
+(There is no means provided to change this behaviour.)
+This is intended to make it more
+straightforward to run benchmarks with and without the Flambda optimisers
+in effect.
+\item Some of the Flambda flags may be subject to change in future
+releases.
+\end{itemize}
+
+\subsection{ss:flambda-rounds}{Specification of optimisation parameters by round}
+
+Flambda operates in {\em rounds}: one round consists of a certain sequence
+of transformations that may then be repeated in order to achieve more
+satisfactory results.  The number of rounds can be set manually using the
+{\tt -rounds} parameter (although this is not necessary when using
+predefined optimisation levels such as with {\tt -O2} and {\tt -O3}).
+For high optimisation the number of rounds might be set at 3 or 4.
+
+Command-line flags that may apply per round, for example those with
+{\tt "-cost"} in the name, accept arguments of the form:
+\begin{center}
+{\em n}{\tt\ |\ }{\em round}{\tt =}{\em n}[{\tt,}...]
+\end{center}
+\begin{itemize}
+\item If the first form is used, with a single integer specified,
+the value will apply to all rounds.
+\item If the second form is used, zero-based {\em round} integers specify
+values which are to be used only for those rounds.
+\end{itemize}
+
+The flags {\tt -Oclassic}, {\tt -O2} and {\tt -O3} are applied before all
+other flags, meaning that certain parameters may be overridden without
+having to specify every parameter usually invoked by the given optimisation
+level.
+
+\section{s:flambda-inlining}{Inlining}
+
+{\em Inlining} refers to the copying of the code of a function to a
+place where the function is called.
+The code of the function will be surrounded by bindings of its parameters
+to the corresponding arguments.
+
+The aims of inlining are:
+\begin{itemize}
+\item to reduce the runtime overhead caused by function calls (including
+setting up for such calls and returning afterwards);
+\item to reduce instruction cache misses by expressing frequently-taken
+paths through the program using fewer machine instructions; and
+\item to reduce the amount of allocation (especially of closures).
+\end{itemize}
+These goals are often reached not just by inlining itself but also by
+other optimisations that the compiler is able to perform as a result of
+inlining.
+
+When a recursive call to a function (within the definition of that function
+or another in the same mutually-recursive group) is inlined, the procedure is
+also known as {\em unrolling}.  This is somewhat akin to loop peeling.
+For example, given the following code:
+\begin{verbatim}
+let rec fact x =
+  if x = 0 then
+    1
+  else
+    x * fact (x - 1)
+
+let n = fact 4
+\end{verbatim}
+unrolling once at the call site {\tt fact 4} produces (with the body of
+{\tt fact} unchanged):
+\begin{verbatim}
+let n =
+  if 4 = 0 then
+    1
+  else
+    4 * fact (4 - 1)
+\end{verbatim}
+This simplifies to:
+\begin{verbatim}
+let n = 4 * fact 3
+\end{verbatim}
+
+%% CR pchambart: A specific section for unrolling might be worth (telling
+%% when this is beneficial)
+
+Flambda provides significantly enhanced inlining capabilities relative to
+previous versions of the compiler.
+
+\subsubsection{sss:flambda-inlining-aside}{Aside: when inlining is performed}
+
+Inlining is performed together with all of the other Flambda optimisation
+passes, that is to say, after closure conversion.  This has three particular
+advantages over a potentially more straightforward implementation prior to
+closure conversion:
+\begin{itemize}
+\item It permits higher-order inlining, for example when a non-inlinable
+function always returns the same function yet with different environments
+of definition.  Not all such cases are supported yet, but it is intended
+that such support will be improved in future.
+\item It is easier to integrate with cross-module optimisation, since
+imported information about other modules is already in the correct
+intermediate language.
+\item It becomes more straightforward to optimise closure allocations since
+the layout of closures does not have to be estimated in any way: it is
+known.  Similarly,
+it becomes more straightforward to control which variables end up
+in which closures, helping to avoid closure bloat.
+\end{itemize}
+
+\subsection{ss:flambda-classic}{Classic inlining heuristic}
+
+In {\tt -Oclassic} mode the behaviour of the Flambda inliner
+mimics previous versions
+of the compiler.  (Code may still be subject to further optimisations not
+performed by previous versions of the compiler: functors may be inlined,
+constants are lifted and unused code is eliminated all as described elsewhere
+in this chapter.  See sections \ref{sss:flambda-functors},\ \ref{ss:flambda-lift-const} %
+and\ \ref{s:flambda-remove-unused}.
+At the definition site of a function, the body of the
+function is measured.  It will then be marked as eligible for inlining
+(and hence inlined at every direct call site) if:
+\begin{itemize}
+\item the measured size (in unspecified units) is smaller than that of a
+function call plus the argument of the {\tt -inline} command-line flag; and
+\item the function is not recursive.
+\end{itemize}
+
+Non-Flambda versions of the compiler cannot inline functions that
+contain a definition of another function.  However {\tt -Oclassic} does
+permit this.  Further, non-Flambda versions also cannot inline functions
+that are only themselves exposed as a result of a previous pass of inlining,
+but again this is permitted by {\tt -Oclassic}.
+For example:
+\begin{verbatim}
+module M : sig
+  val i : int
+end = struct
+  let f x =
+    let g y = x + y in
+    g
+  let h = f 3
+  let i = h 4  (* h is correctly discovered to be g and inlined *)
+end
+\end{verbatim}
+
+All of this contrasts with the normal Flambda mode, that is to say
+without {\tt -Oclassic}, where:
+\begin{itemize}
+\item the inlining decision is made at the {\bf call site}; and
+\item recursive functions can be handled, by {\em specialisation} (see
+below).
+\end{itemize}
+The Flambda mode is described in the next section.
+
+\subsection{ss:flambda-inlining-overview}{Overview of ``Flambda'' inlining heuristics}
+
+The Flambda inlining heuristics, used whenever the compiler is configured
+for Flambda and {\tt -Oclassic} was not specified, make inlining decisions
+at call sites.  This helps in situations where the context is important.
+For example:
+\begin{verbatim}
+let f b x =
+  if b then
+    x
+  else
+    ... big expression ...
+
+let g x = f true x
+\end{verbatim}
+In this case, we would like to inline {\tt f} into {\tt g}, because a
+conditional jump can be eliminated and the code size should reduce.  If the
+inlining decision has been made after the declaration of {\tt f} without
+seeing the use, its size would have probably made it ineligible for
+inlining; but at the call site, its final size can be known.  Further,
+this function should probably not be inlined systematically: if {\tt b}
+is unknown, or indeed {\tt false}, there is little benefit to trade off
+against a large increase in code size.  In the existing non-Flambda inliner
+this isn't a great problem because chains of inlining were cut off fairly
+quickly.  However it has led to excessive use of overly-large inlining
+parameters such as {\tt -inline 10000}.
+
+In more detail, at each call site the following procedure is followed:
+\begin{itemize}
+\item Determine whether it is clear that inlining would be beneficial
+without, for the moment, doing any inlining within the function itself.
+(The exact assessment of {\em benefit} is described below.)  If so, the
+function is inlined.
+\item If inlining the function is not clearly beneficial, then inlining
+will be performed {\em speculatively} inside the function itself.  The
+search for speculative inlining possibilities is controlled by two
+parameters: the {\em inlining threshold} and the {\em inlining depth}.
+(These are described in more detail below.)
+\begin{itemize}
+\item If such speculation shows that performing some inlining inside the
+function would be beneficial, then such inlining is performed and the
+resulting function inlined at the original call site.
+\item Otherwise, nothing happens.
+\end{itemize}
+\end{itemize}
+Inlining within recursive functions of calls to other
+functions in the same mutually-recursive group is kept in check by
+an {\em unrolling depth}, described below.  This ensures that functions are
+not unrolled to excess.  (Unrolling is only enabled
+if {\tt -O3} optimisation level is selected and/or the
+{\tt -inline-max-unroll}
+flag is passed with an argument greater than zero.)
+
+\subsection{ss:flambda-by-constructs}{Handling of specific language constructs}
+
+\subsubsection{sss:flambda-functors}{Functors}
+
+There is nothing particular about functors that inhibits inlining compared
+to normal functions.  To the inliner, these both look the same, except
+that functors are marked as such.
+
+Applications of functors at toplevel are biased in favour of inlining.
+(This bias may be adjusted:
+see the documentation for {\tt -inline-lifting-benefit} below.)
+
+Applications of functors not at toplevel, for example in a local module
+inside some other expression, are treated by the inliner identically to
+normal function calls.
+
+\subsubsection{sss:flambda-first-class-modules}{First-class modules}
+
+The inliner will be able to consider inlining a call to a function in a first
+class module if it knows which particular function is going to be called.
+The presence of the first-class module record that wraps the set of functions
+in the module does not per se inhibit inlining.
+
+\subsubsection{sss:flambda-objects}{Objects}
+
+Method calls to objects are not at present inlined by Flambda.
+
+\subsection{ss:flambda-inlining-reports}{Inlining reports}
+
+If the {\tt -inlining-report} option is provided to the compiler then a file
+will be emitted corresponding to each round of optimisation.  For the
+OCaml source file {\em basename}{\tt .ml} the files
+are named {\em basename}{\tt .}{\em round}{\tt.inlining.org},
+with {\em round} a
+zero-based integer.  Inside the files, which are formatted as ``org mode'',
+will be found English prose describing the decisions that the inliner took.
+
+\subsection{ss:flambda-assessment-inlining}{Assessment of inlining benefit}
+
+Inlining typically
+results in an increase in code size, which if left unchecked, may not only
+lead to grossly large executables and excessive compilation times but also
+a decrease in performance due to worse locality.  As such, the
+Flambda inliner trades off the change in code size against
+the expected runtime performance benefit, with the benefit being computed
+based on the number of operations that the compiler observes may be removed
+as a result of inlining.
+
+For example given the following code:
+\begin{verbatim}
+let f b x =
+  if b then
+    x
+  else
+    ... big expression ...
+
+let g x = f true x
+\end{verbatim}
+it would be observed that inlining of {\tt f} would remove:
+\begin{itemize}
+\item one direct call;
+\item one conditional branch.
+\end{itemize}
+
+Formally, an estimate of runtime performance benefit is computed by
+first summing
+the cost of the operations that are known to be removed as a result of the
+inlining and subsequent simplification of the inlined body.
+The individual costs for the various kinds of operations may be adjusted
+using the various {\tt -inline-...-cost} flags as follows.  Costs are
+specified as integers.  All of these flags accept a single argument
+describing such integers using the conventions
+detailed in section\ \ref{ss:flambda-rounds}.
+\begin{options}
+\item[\machine{-inline-alloc-cost}] The cost of an allocation.
+\item[\machine{-inline-branch-cost}] The cost of a branch.
+\item[\machine{-inline-call-cost}] The cost of a direct function call.
+\item[\machine{-inline-indirect-cost}] The cost of an indirect function call.
+\item[\machine{-inline-prim-cost}] The cost of a {\em primitive}.  Primitives
+encompass operations including arithmetic and memory access.
+\end{options}
+(Default values are described in section\ \ref{s:flambda-defaults} below.)
+
+The initial benefit value is then scaled by a factor that attempts to
+compensate for the fact that the current point in the code, if under some
+number of conditional branches, may be cold.  (Flambda does not currently
+compute hot and cold paths.)  The factor---the estimated probability that
+the inliner really is on a {\em hot} path---is calculated as
+$\frac{1}{(1 + f)^{d}}$, where $f$ is set by
+{\tt -inline-branch-factor} and $d$ is the nesting depth of branches
+at the current point.  As the inliner descends into more deeply-nested
+branches, the benefit of inlining thus lessens.
+
+The resulting benefit value is known as the {\em estimated benefit}.
+
+The change in code size is also estimated: morally speaking it should be the
+change in machine code size, but since that is not available to the inliner,
+an approximation is used.
+
+If the estimated benefit exceeds the increase in code size then the inlined
+version of the function will be kept.  Otherwise the function will not be
+inlined.
+
+Applications of functors at toplevel will be given
+an additional benefit (which may be controlled by the
+{\tt -inline-lifting-benefit} flag) to bias inlining in such situations
+towards keeping the inlined version.
+
+\subsection{ss:flambda-speculation}{Control of speculation}
+
+As described above, there are three parameters that restrict the search
+for inlining opportunities during speculation:
+\begin{itemize}
+\item the {\em inlining threshold};
+\item the {\em inlining depth};
+\item the {\em unrolling depth}.
+\end{itemize}
+These parameters are ultimately bounded by the arguments provided to
+the corresponding command-line flags (or their default values):
+\begin{itemize}
+\item {\tt -inline} (or, if the call site that triggered speculation is
+at toplevel, {\tt -inline-toplevel});
+\item {\tt -inline-max-depth};
+\item {\tt -inline-max-unroll}.
+\end{itemize}
+{\bf Note in particular} that {\tt -inline} does not have the meaning that
+it has in the previous compiler or in {\tt -Oclassic} mode.  In both of those
+situations {\tt -inline} was effectively some kind of basic assessment of
+inlining benefit.  However in Flambda inlining mode it corresponds to a
+constraint on the search; the assessment of benefit is independent, as
+described above.
+
+When speculation starts the inlining threshold starts at the value set
+by {\tt -inline} (or {\tt -inline-toplevel} if appropriate, see above).
+Upon making a speculative inlining decision the
+threshold is reduced by the code size of the function being inlined.
+If the threshold becomes exhausted, at or below zero, no further speculation
+will be performed.
+
+The inlining depth starts at zero
+and is increased by one every time the inliner
+descends into another function.  It is then decreased by one every time the
+inliner leaves such function.  If the depth exceeds the value set by
+{\tt -inline-max-depth} then speculation stops.  This parameter is intended
+as a general backstop for situations where the inlining
+threshold does not control the search sufficiently.
+
+The unrolling depth applies to calls within the same mutually-recursive
+group of functions.  Each time an inlining of such a call is performed
+the depth is incremented by one when examining the resulting body.  If the
+depth reaches the limit set by {\tt -inline-max-unroll} then speculation
+stops.
+
+\section{s:flambda-specialisation}{Specialisation}
+
+The inliner may discover a call site to a recursive function where
+something is known about the arguments: for example, they may be equal to
+some other variables currently in scope.  In this situation it may be
+beneficial to {\em specialise} the function to those arguments.  This is
+done by copying the declaration of the function (and any others involved
+in any same mutually-recursive declaration) and noting the extra information
+about the arguments.  The arguments augmented by this information are known
+as {\em specialised arguments}.  In order to try to ensure that specialisation
+is not performed uselessly, arguments are only specialised if it can be shown
+that they are {\em invariant}: in other words, during the execution of the
+recursive function(s) themselves, the arguments never change.
+
+Unless overridden by an attribute (see below), specialisation of a function
+will not be attempted if:
+\begin{itemize}
+\item the compiler is in {\tt -Oclassic} mode;
+\item the function is not obviously recursive;
+\item the function is not closed.
+\end{itemize}
+
+The compiler can prove invariance of function arguments across multiple
+functions within a recursive group (although this has some limitations,
+as shown by the example below).
+
+It should be noted that the {\em unboxing of closures} pass (see below)
+can introduce specialised arguments on non-recursive functions.  (No other
+place in the compiler currently does this.)
+
+\paragraph{Example: the well-known {\tt List.iter} function}
+This function might be written like so:
+\begin{verbatim}
+let rec iter f l =
+  match l with
+  | [] -> ()
+  | h :: t ->
+    f h;
+    iter f t
+\end{verbatim}
+and used like this:
+\begin{verbatim}
+let print_int x =
+  print_endline (Int.to_string x)
+
+let run xs =
+  iter print_int (List.rev xs)
+\end{verbatim}
+The argument {\tt f} to {\tt iter} is invariant so the function may be
+specialised:
+\begin{verbatim}
+let run xs =
+  let rec iter' f l =
+    (* The compiler knows: f holds the same value as foo throughout iter'. *)
+    match l with
+    | [] -> ()
+    | h :: t ->
+      f h;
+      iter' f t
+  in
+  iter' print_int (List.rev xs)
+\end{verbatim}
+The compiler notes down that for the function {\tt iter'}, the argument
+{\tt f} is specialised to the constant closure {\tt print\_int}.  This
+means that the body of {\tt iter'} may be simplified:
+\begin{verbatim}
+let run xs =
+  let rec iter' f l =
+    (* The compiler knows: f holds the same value as foo throughout iter'. *)
+    match l with
+    | [] -> ()
+    | h :: t ->
+      print_int h;  (* this is now a direct call *)
+      iter' f t
+  in
+  iter' print_int (List.rev xs)
+\end{verbatim}
+The call to {\tt print\_int} can indeed be inlined:
+\begin{verbatim}
+let run xs =
+  let rec iter' f l =
+    (* The compiler knows: f holds the same value as foo throughout iter'. *)
+    match l with
+    | [] -> ()
+    | h :: t ->
+      print_endline (Int.to_string h);
+      iter' f t
+  in
+  iter' print_int (List.rev xs)
+\end{verbatim}
+The unused specialised argument {\tt f} may now be removed, leaving:
+\begin{verbatim}
+let run xs =
+  let rec iter' l =
+    match l with
+    | [] -> ()
+    | h :: t ->
+      print_endline (Int.to_string h);
+      iter' t
+  in
+  iter' (List.rev xs)
+\end{verbatim}
+
+\paragraph{Aside on invariant parameters.} The compiler cannot currently
+detect invariance in cases such as the following.
+\begin{verbatim}
+let rec iter_swap f g l =
+  match l with
+  | [] -> ()
+  | 0 :: t ->
+    iter_swap g f l
+  | h :: t ->
+    f h;
+    iter_swap f g t
+\end{verbatim}
+
+\subsection{ss:flambda-assessment-specialisation}{Assessment of specialisation benefit}
+
+The benefit of specialisation is assessed in a similar way as for inlining.
+Specialised argument information may mean that the body of the function
+being specialised can be simplified: the removed operations are accumulated
+into a benefit.  This, together with the size of the duplicated (specialised)
+function declaration, is then assessed against the size of the call to the
+original function.
+
+\section{s:flambda-defaults}{Default settings of parameters}
+
+The default settings (when not using {\tt -Oclassic}) are for one
+round of optimisation using the following parameters.
+% CR-soon mshinwell: for 4.04, let's autogenerate these.
+
+\begin{tableau}{|l|l|}{Parameter}{Setting}
+\entree{{\tt -inline}}{10}
+\entree{{\tt -inline-branch-factor}}{0.1}
+\entree{{\tt -inline-alloc-cost}}{7}
+\entree{{\tt -inline-branch-cost}}{5}
+\entree{{\tt -inline-call-cost}}{5}
+\entree{{\tt -inline-indirect-cost}}{4}
+\entree{{\tt -inline-prim-cost}}{3}
+\entree{{\tt -inline-lifting-benefit}}{1300}
+\entree{{\tt -inline-toplevel}}{160}
+\entree{{\tt -inline-max-depth}}{1}
+\entree{{\tt -inline-max-unroll}}{0}
+\entree{{\tt -unbox-closures-factor}}{10}
+\end{tableau}
+
+\subsection{ss:flambda-o2}{Settings at -O2 optimisation level}
+
+When {\tt -O2} is specified two rounds of optimisation are performed.
+The first round uses the default parameters (see above).  The second uses
+the following parameters.
+
+\begin{tableau}{|l|l|}{Parameter}{Setting}
+\entree{{\tt -inline}}{25}
+\entree{{\tt -inline-branch-factor}}{Same as default}
+\entree{{\tt -inline-alloc-cost}}{Double the default}
+\entree{{\tt -inline-branch-cost}}{Double the default}
+\entree{{\tt -inline-call-cost}}{Double the default}
+\entree{{\tt -inline-indirect-cost}}{Double the default}
+\entree{{\tt -inline-prim-cost}}{Double the default}
+\entree{{\tt -inline-lifting-benefit}}{Same as default}
+\entree{{\tt -inline-toplevel}}{400}
+\entree{{\tt -inline-max-depth}}{2}
+\entree{{\tt -inline-max-unroll}}{Same as default}
+\entree{{\tt -unbox-closures-factor}}{Same as default}
+\end{tableau}
+
+\subsection{ss:flambda-o3}{Settings at -O3 optimisation level}
+
+When {\tt -O3} is specified three rounds of optimisation are performed.
+The first two rounds are as for {\tt -O2}.  The third round uses
+the following parameters.
+
+\begin{tableau}{|l|l|}{Parameter}{Setting}
+\entree{{\tt -inline}}{50}
+\entree{{\tt -inline-branch-factor}}{Same as default}
+\entree{{\tt -inline-alloc-cost}}{Triple the default}
+\entree{{\tt -inline-branch-cost}}{Triple the default}
+\entree{{\tt -inline-call-cost}}{Triple the default}
+\entree{{\tt -inline-indirect-cost}}{Triple the default}
+\entree{{\tt -inline-prim-cost}}{Triple the default}
+\entree{{\tt -inline-lifting-benefit}}{Same as default}
+\entree{{\tt -inline-toplevel}}{800}
+\entree{{\tt -inline-max-depth}}{3}
+\entree{{\tt -inline-max-unroll}}{1}
+\entree{{\tt -unbox-closures-factor}}{Same as default}
+\end{tableau}
+
+\section{s:flambda-manual-control}{Manual control of inlining and specialisation}
+
+Should the inliner prove recalcitrant and refuse to inline a particular
+function, or if the observed inlining decisions are not to the programmer's
+satisfaction for some other reason, inlining behaviour can be dictated by the
+programmer directly in the source code.
+One example where this might be appropriate is when the programmer,
+but not the compiler, knows that a particular function call is on a cold
+code path.  It might be desirable to prevent inlining of the function so
+that the code size along the hot path is kept smaller, so as to increase
+locality.
+
+The inliner is directed using attributes.
+For non-recursive functions (and one-step unrolling of recursive functions,
+although {\tt \@unroll} is more clear for this purpose)
+the following are supported:
+\begin{options}
+\item[{\machine{\@\@inline always}} or {\machine{\@\@inline never}}] Attached
+to a {\em declaration} of a function or functor, these direct the inliner to
+either
+always or never inline, irrespective of the size/benefit calculation.  (If
+the function is recursive then the body is substituted and no special
+action is taken for the recursive call site(s).)
+{\machine{\@\@inline}} with no argument is equivalent to
+{\machine{\@\@inline always}}.
+\item[{\machine{\@inlined always}} or {\machine{\@inlined never}}] Attached
+to a function {\em application}, these direct the inliner likewise.  These
+attributes at call sites override any other attribute that may be present
+on the corresponding declaration.
+{\machine{\@inlined}} with no argument is equivalent to
+{\machine{\@inlined always}}. {\machine{\@\@inlined hint}} is equivalent to
+{\machine{\@\@inline always}} except that it will not trigger warning 55 if
+the function application cannot be inlined.
+\end{options}
+
+For recursive functions the relevant attributes are:
+\begin{options}
+\item[{\machine{\@\@specialise always}} or {\machine{\@\@specialise never}}]%
+Attached to a declaration of a function
+or functor, this directs the inliner to either always or never
+specialise the function so
+long as it has appropriate contextual knowledge, irrespective of the
+size/benefit calculation.
+{\machine{\@\@specialise}} with no argument is equivalent to
+{\machine{\@\@specialise always}}.
+\item[{\machine{\@specialised always}} or {\machine{\@specialised never}}]%
+Attached to a function application, this
+directs the inliner likewise.  This attribute at a call site overrides any
+other attribute that may be present on the corresponding declaration.
+(Note that the function will still only be specialised if there exist
+one or more invariant parameters whose values are known.)
+{\machine{\@specialised}} with no argument is equivalent to
+{\machine{\@specialised always}}.
+\item[{\machine{\@unrolled }}$n$] This attribute is attached to a function
+application and always takes an integer argument.  Each time the inliner sees
+the attribute it behaves as follows:
+\begin{itemize}
+\item If $n$ is zero or less, nothing happens.
+\item Otherwise the function being called is substituted at the call site
+with its body having been rewritten such that 
+any recursive calls to that function {\em or
+any others in the same mutually-recursive group} are annotated with the
+attribute {\tt unrolled(}$n - 1${\tt )}.  Inlining may continue on that body.
+\end{itemize}
+As such, $n$ behaves as the ``maximum depth of unrolling''.
+\end{options}
+
+A compiler warning will be emitted if it was found impossible to obey an
+annotation from an {\tt \@inlined} or {\tt \@specialised} attribute.
+
+\paragraph{Example showing correct placement of attributes}
+\begin{verbatim}
+module F (M : sig type t end) = struct
+  let[@inline never] bar x =
+    x * 3
+
+  let foo x =
+    (bar [@inlined]) (42 + x)
+end [@@inline never]
+
+module X = F [@inlined] (struct type t = int end)
+\end{verbatim}
+
+\section{s:flambda-simplification}{Simplification}
+
+Simplification, which is run in conjunction with inlining,
+propagates information (known as {\em approximations}) about which
+variables hold what values at runtime.  Certain relationships between
+variables and symbols are also tracked: for example, some variable may be
+known to always hold the same value as some other variable; or perhaps
+some variable may be known to always hold the value pointed to by some
+symbol.
+
+The propagation can help to eliminate allocations in cases such as:
+\begin{verbatim}
+let f x y =
+  ...
+  let p = x, y in
+  ...
+  ... (fst p) ... (snd p) ...
+\end{verbatim}
+The projections from {\tt p} may be replaced by uses of the variables
+{\tt x} and {\tt y}, potentially meaning that {\tt p} becomes unused.
+
+The propagation performed by the simplification pass is also important for
+discovering which functions flow to indirect call sites.  This can enable
+the transformation of such call sites into direct call sites, which makes
+them eligible for an inlining transformation.
+
+Note that no information is propagated about the contents of strings,
+even in {\tt safe-string} mode, because it cannot yet be guaranteed
+that they are immutable throughout a given program.
+
+\section{s:flambda-other-transfs}{Other code motion transformations}
+
+\subsection{ss:flambda-lift-const}{Lifting of constants}
+
+Expressions found to be constant will be lifted to symbol
+bindings---that is to say, they will be statically allocated in the
+object file---when
+they evaluate to boxed values.  Such constants may be straightforward numeric
+constants, such as the floating-point number {\tt 42.0}, or more complicated
+values such as constant closures.
+
+Lifting of constants to toplevel reduces allocation at runtime.
+
+The compiler aims to share constants lifted to toplevel such that there
+are no duplicate definitions.  However if {\tt .cmx} files are hidden
+from the compiler then maximal sharing may not be possible.
+
+\paragraph{Notes about float arrays} %
+The following language semantics apply specifically to constant float arrays.
+(By ``constant float array'' is meant an array consisting entirely of floating
+point numbers that are known at compile time.  A common case is a literal
+such as {\tt [| 42.0; 43.0; |]}.
+\begin{itemize}
+\item Constant float arrays at the toplevel are mutable and never shared.
+(That is to say, for each
+such definition there is a distinct symbol in the data section of the object
+file pointing at the array.)
+\item Constant float arrays not at toplevel are mutable and are created each
+time the expression is evaluated.  This can be thought of as an operation that
+takes an immutable array (which in the source code has no associated name; let
+us call it the {\em initialising array}) and
+duplicates it into a fresh mutable array.
+\begin{itemize}
+\item If the array is of size four or less, the expression will create a
+fresh block and write the values into it one by one.  There is no reference
+to the initialising array as a whole.
+
+\item Otherwise, the initialising array is lifted out and subject to the
+normal constant sharing procedure;
+creation of the array consists of bulk copying the initialising array
+into a fresh value on the OCaml heap.
+\end{itemize}
+\end{itemize}
+
+\subsection{ss:flambda-lift-toplevel-let}{Lifting of toplevel let bindings}
+
+Toplevel {\tt let}-expressions may be lifted to symbol bindings to ensure
+that the corresponding bound variables are not captured by closures.  If the
+defining expression of a given binding is found to be constant, it is bound
+as such (the technical term is a {\em let-symbol} binding).
+
+Otherwise, the symbol is bound to a (statically-allocated)
+{\em preallocated block} containing one field.  At runtime, the defining
+expression will be evaluated and the first field of the block filled with
+the resulting value.  This {\em initialise-symbol} binding
+causes one extra indirection but ensures, by
+virtue of the symbol's address being known at compile time, that uses of the
+value are not captured by closures.
+
+It should be noted that the blocks corresponding to initialise-symbol
+bindings are kept alive forever, by virtue of them occurring in a static
+table of GC roots within the object file.  This extended lifetime of
+expressions may on occasion be surprising.  If it is desired to create
+some non-constant value (for example when writing GC tests) that does not
+have this
+extended lifetime, then it may be created and used inside a function,
+with the application point of that function (perhaps at toplevel)---or
+indeed the function declaration itself---marked
+as to never be inlined.  This technique prevents lifting of the definition
+of the value in question (assuming of course that it is not constant).
+
+\section{s:flambda-unboxing}{Unboxing transformations}
+
+The transformations in this section relate to the splitting apart of
+{\em boxed} (that is to say, non-immediate) values.  They are largely
+intended to reduce allocation, which tends to result in a runtime
+performance profile with lower variance and smaller tails.
+
+\subsection{ss:flambda-unbox-fvs}{Unboxing of closure variables}
+
+This transformation is enabled unless
+{\tt -no-unbox-free-vars-of-closures} is provided.
+
+Variables that appear in closure environments may themselves be boxed
+values.  As such, they may be split into further closure variables, each
+of which corresponds to some projection from the original closure variable(s).
+This transformation is called {\em unboxing of closure variables} or
+{\em unboxing of free variables of closures}.  It is only applied when
+there is
+reasonable certainty that there are no uses of the boxed free variable itself
+within the corresponding function bodies.
+% CR-someday mshinwell: Actually, we probably don't check this carefully
+% enough.  It needs a global analysis in case there is an out-of-scope
+% projection.
+
+\paragraph{Example:} In the following code, the compiler observes that
+the closure returned from the function {\tt f} contains a variable {\tt pair}
+(free in the body of {\tt f}) that may be split into two separate variables.
+\begin{verbatim}
+let f x0 x1 =
+  let pair = x0, x1 in
+  Printf.printf "foo\n";
+  fun y ->
+    fst pair + snd pair + y
+\end{verbatim}
+After some simplification one obtains:
+\begin{verbatim}
+let f x0 x1 =
+  let pair_0 = x0 in
+  let pair_1 = x1 in
+  Printf.printf "foo\n";
+  fun y ->
+    pair_0 + pair_1 + y
+\end{verbatim}
+and then:
+\begin{verbatim}
+let f x0 x1 =
+  Printf.printf "foo\n";
+  fun y ->
+    x0 + x1 + y
+\end{verbatim}
+The allocation of the pair has been eliminated.
+
+This transformation does not operate if it would cause the closure to
+contain more than twice as many closure variables as it did beforehand.
+
+\subsection{ss:flambda-unbox-spec-args}{Unboxing of specialised arguments}
+
+This transformation is enabled unless
+{\tt -no-unbox-specialised-args} is provided.
+
+It may become the case during compilation that one or more invariant arguments
+to a function become specialised to a particular value.  When such values are
+themselves boxed the corresponding specialised arguments may be split into
+more specialised arguments corresponding to the projections out of the boxed
+value that occur within the function body.  This transformation is called
+{\em unboxing of specialised arguments}.  It is only applied when there is
+reasonable certainty that the boxed argument itself is unused within the
+function.
+
+If the function in question is involved in a recursive group then unboxing
+of specialised arguments may be immediately replicated across the group
+based on the dataflow between invariant arguments.
+
+\paragraph{Example:} Having been given the following code, the compiler
+will inline {\tt loop} into {\tt f}, and then observe {\tt inv}
+being invariant and always the pair formed by adding {\tt 42} and {\tt 43}
+to the argument {\tt x} of the function {\tt f}.
+\begin{verbatim}
+let rec loop inv xs =
+  match xs with
+  | [] -> fst inv + snd inv
+  | x::xs -> x + loop2 xs inv
+and loop2 ys inv =
+  match ys with
+  | [] -> 4
+  | y::ys -> y - loop inv ys
+
+let f x =
+  Printf.printf "%d\n" (loop (x + 42, x + 43) [1; 2; 3])
+\end{verbatim}
+Since the functions have sufficiently few arguments, more specialised
+arguments will be added.  After some simplification one obtains:
+\begin{verbatim}
+let f x =
+  let rec loop' xs inv_0 inv_1 =
+    match xs with
+    | [] -> inv_0 + inv_1
+    | x::xs -> x + loop2' xs inv_0 inv_1
+  and loop2' ys inv_0 inv_1 =
+    match ys with
+    | [] -> 4
+    | y::ys -> y - loop' ys inv_0 inv_1
+  in
+  Printf.printf "%d\n" (loop' [1; 2; 3] (x + 42) (x + 43))
+\end{verbatim}
+The allocation of the pair within {\tt f} has been removed.  (Since the
+two closures for {\tt loop'} and {\tt loop2'} are constant they will also be
+lifted to toplevel with no runtime allocation penalty.  This
+would also happen without having run the transformation to unbox
+specialise arguments.)
+
+The transformation to unbox specialised arguments never introduces extra
+allocation.
+
+The transformation will not unbox arguments if it would result in the
+original function having sufficiently many arguments so as to inhibit
+tail-call optimisation.
+
+The transformation is implemented by creating a wrapper function that
+accepts the original arguments.  Meanwhile, the original function is renamed
+and extra arguments are added corresponding to the unboxed specialised
+arguments; this new function
+is called from the wrapper.  The wrapper will then be inlined
+at direct call sites.  Indeed, all call sites will be direct unless
+{\tt -unbox-closures} is being used, since they will have been generated
+by the compiler when originally specialising the function.  (In the case
+of {\tt -unbox-closures} other functions may appear with specialised
+arguments; in this case there may be indirect calls and these will incur
+a small penalty owing to having to bounce through the wrapper.  The technique
+of {\em direct call surrogates} used for {\tt -unbox-closures} is not
+used by the transformation to unbox specialised arguments.)
+
+\subsection{ss:flambda-unbox-closures}{Unboxing of closures}
+
+This transformation is {\em not} enabled by default.  It may be enabled
+using the {\tt -unbox-closures} flag.
+
+The transformation replaces closure variables by specialised arguments.
+The aim is to cause more closures to become closed.  It is particularly
+applicable, as a means of reducing allocation, where the function concerned
+cannot be inlined or specialised.  For example, some non-recursive function
+might be too large to inline; or some recursive function might offer
+no opportunities for specialisation perhaps because its only argument is
+one of type {\tt unit}.
+
+At present there may be a small penalty in terms of actual runtime
+performance when this transformation is enabled, although more stable
+performance may be obtained due to reduced allocation.  It is recommended
+that developers experiment to determine whether the option is beneficial
+for their code.  (It is expected that in the future it will be possible
+for the performance degradation to be removed.)
+
+\paragraph{Simple example:} In the following code (which might typically
+occur when {\tt g} is too large to inline) the value of {\tt x} would usually
+be communicated to the application of the {\tt +} function via the closure
+of {\tt g}.
+\begin{verbatim}
+let f x =
+  let g y =
+    x + y
+  in
+  (g [@inlined never]) 42
+\end{verbatim}
+Unboxing of the closure causes the value for {\tt x} inside {\tt g} to
+be passed as an argument to {\tt g} rather than through its closure.  This
+means that the closure of {\tt g} becomes constant and may be lifted to
+toplevel, eliminating the runtime allocation.
+
+The transformation is implemented by adding a new wrapper function in the
+manner of that used when unboxing specialised arguments.  The closure
+variables are still free in the wrapper, but the intention is that when
+the wrapper is inlined at direct call sites, the relevant values are
+passed directly to the main function via the new specialised arguments.
+
+Adding such a wrapper will penalise indirect calls to the function
+(which might exist in arbitrary places; remember that this transformation
+is not for example applied only on functions the compiler has produced
+as a result of specialisation) since such calls will bounce through
+the wrapper.  To
+mitigate this, if a function is small enough when weighed up against
+the number of free variables being removed, it will be duplicated by the
+transformation to obtain two versions: the original (used for indirect calls,
+since we can do no better) and the wrapper/rewritten function pair as
+described in the previous paragraph.  The wrapper/rewritten function pair
+will only be used at direct call sites of the function.  (The wrapper in
+this case is known as a {\em direct call surrogate}, since
+it takes the place of another function---the unchanged version used for
+indirect calls---at direct call sites.)
+
+The {\tt -unbox-closures-factor} command line flag, which takes an
+integer, may be used to adjust the point at which a function is deemed
+large enough to be ineligible for duplication.  The benefit of
+duplication is scaled by the integer before being evaluated against the
+size.
+
+\paragraph{Harder example:} In the following code, there are two closure
+variables that would typically cause closure allocations.  One is called
+{\tt fv} and occurs inside the function {\tt baz}; the other is called
+{\tt z} and occurs inside the function {\tt bar}.
+In this toy (yet sophisticated) example we again use an attribute to
+simulate the typical situation where the first argument of {\tt baz} is
+too large to inline.
+\begin{verbatim}
+let foo c =
+  let rec bar zs fv =
+    match zs with
+    | [] -> []
+    | z::zs ->
+      let rec baz f = function
+        | [] -> []
+        | a::l -> let r = fv + ((f [@inlined never]) a) in r :: baz f l
+      in
+      (map2 (fun y -> z + y) [z; 2; 3; 4]) @ bar zs fv
+  in
+  Printf.printf "%d" (List.length (bar [1; 2; 3; 4] c))
+\end{verbatim}
+The code resulting from applying {\tt -O3 -unbox-closures} to this code
+passes the free variables via function arguments in
+order to eliminate all closure allocation in this example (aside from any
+that might be performed inside {\tt printf}).
+
+\section{s:flambda-remove-unused}{Removal of unused code and values}
+
+\subsection{ss:flambda-redundant-let}{Removal of redundant let expressions}
+
+The simplification pass removes unused {\tt let} bindings so long as
+their corresponding defining expressions have ``no effects''.  See
+the section ``Treatment of effects'' below for the precise definition of
+this term.
+
+\subsection{ss:flambda-redundant}{Removal of redundant program constructs}
+
+This transformation is analogous to the removal of {\tt let}-expressions
+whose defining expressions have no effects.  It operates instead on symbol
+bindings, removing those that have no effects.
+
+\subsection{ss:flambda-remove-unused-args}{Removal of unused arguments}
+
+This transformation is only enabled by default for specialised arguments.
+It may be enabled for all arguments using the {\tt -remove-unused-arguments}
+flag.
+
+The pass analyses functions to determine which arguments are unused.
+Removal is effected by creating a wrapper function, which will be inlined
+at every direct call site, that accepts the original arguments and then
+discards the unused ones before calling the original function.  As a
+consequence, this transformation may be detrimental if the original
+function is usually indirectly called, since such calls will now bounce
+through the wrapper.  (The technique of {\em direct call surrogates} used
+to reduce this penalty during unboxing of closure variables (see above)
+does not yet apply to the pass that removes unused arguments.)
+
+\subsection{ss:flambda-removal-closure-vars}{Removal of unused closure variables}
+
+This transformation performs an analysis across
+the whole compilation unit to determine whether there exist closure variables
+that are never used.  Such closure variables are then eliminated.  (Note that
+this has to be a whole-unit analysis because a projection of a closure
+variable from some particular closure may have propagated to an arbitrary
+location within the code due to inlining.)
+
+\section{s:flambda-other}{Other code transformations}
+
+\subsection{ss:flambda-non-escaping-refs}{Transformation of non-escaping references into mutable variables}
+
+Flambda performs a simple analysis analogous to that performed elsewhere
+in the compiler that can transform {\tt ref}s into mutable variables
+that may then be held in registers (or on the stack as appropriate) rather
+than being allocated on the OCaml heap.  This only happens so long as the
+reference concerned can be shown to not escape from its defining scope.
+
+\subsection{ss:flambda-subst-closure-vars}{Substitution of closure variables for specialised arguments}
+
+This transformation discovers closure variables that are known to be
+equal to specialised arguments.  Such closure variables are replaced by
+the specialised arguments; the closure variables may then be removed by
+the ``removal of unused closure variables'' pass (see below).
+
+\section{s:flambda-effects}{Treatment of effects}
+
+The Flambda optimisers classify expressions in order to determine whether
+an expression:
+\begin{itemize}
+\item does not need to be evaluated at all; and/or
+\item may be duplicated.
+\end{itemize}
+
+This is done by forming judgements on the {\em effects} and the {\em coeffects}
+that might be performed were the expression to be executed.  Effects talk
+about how the expression might affect the world; coeffects talk about how
+the world might affect the expression.
+
+Effects are classified as follows:
+\begin{options}
+\item[{\bf No effects:}] The expression does not change the observable state
+of the world.  For example, it must not write to any mutable storage,
+call arbitrary external functions or change control flow (e.g. by raising
+an exception).  Note that allocation is {\em not} classed as having
+``no effects'' (see below).
+\begin{itemize}
+\item It is assumed in the compiler that expressions with no
+effects, whose results are not used, may be eliminated.  (This typically
+happens where the expression in question is the defining expression of a
+{\tt let}; in such cases the {\tt let}-expression will be
+eliminated.) It is further
+assumed that such expressions with no effects may be
+duplicated (and thus possibly executed more than once).
+\item Exceptions arising from allocation points, for example
+``out of memory'' or
+exceptions propagated from finalizers or signal handlers, are treated as
+``effects out of the ether'' and thus ignored for our determination here
+of effectfulness.  The same goes for floating point operations that may
+cause hardware traps on some platforms.
+\end{itemize}
+\item[{\bf Only generative effects:}] The expression does not change the
+observable state of the world save for possibly affecting the state of
+the garbage collector by performing an allocation.  Expressions
+that only have generative effects and whose results are unused
+may be eliminated by the compiler.  However, unlike expressions with
+``no effects'', such expressions will never be eligible for duplication.
+\item[{\bf Arbitrary effects:}] All other expressions.
+\end{options}
+
+There is a single classification for coeffects:
+\begin{options}
+\item[{\bf No coeffects:}] The expression does not observe the effects (in
+the sense described above) of other expressions.  For example, it must not
+read from any mutable storage or call arbitrary external functions.
+\end{options}
+
+It is assumed in the compiler that, subject to data dependencies,
+expressions with neither effects nor coeffects may be reordered with
+respect to other expressions.
+
+\section{s:flambda-static-modules}{Compilation of statically-allocated modules}
+
+Compilation of modules that are able to be statically allocated (for example,
+the module corresponding to an entire compilation unit, as opposed to a first
+class module dependent on values computed at runtime) initially follows the
+strategy used for bytecode.  A sequence of {\tt let}-bindings, which may be
+interspersed with arbitrary effects, surrounds a record creation that becomes
+the module block.  The Flambda-specific transformation follows: these bindings
+are lifted to toplevel symbols, as described above.
+
+\section{s:flambda-inhibition}{Inhibition of optimisation}
+
+Especially when writing benchmarking suites that run non-side-effecting
+algorithms in loops, it may be found that the optimiser entirely
+elides the code being benchmarked.  This behaviour can be prevented by
+using the {\tt Sys.opaque\_identity} function (which indeed behaves as a
+normal OCaml function and does not possess any ``magic'' semantics).  The
+documentation of the {\tt Sys} module should be consulted for further details.
+
+\section{s:flambda-unsafe}{Use of unsafe operations}
+
+The behaviour of the Flambda simplification pass means that certain unsafe
+operations, which may without Flambda or when using previous versions of
+the compiler be safe, must not be used.  This specifically refers to
+functions found in the {\tt Obj} module.
+
+In particular, it is forbidden to change any value (for example using
+{\tt Obj.set\_field} or {\tt Obj.set\_tag}) that is not mutable.
+(Values returned from C stubs
+are always treated as mutable.)  The compiler will emit warning 59 if it
+detects such a write---but it cannot warn in all cases.  Here is an example
+of code that will trigger the warning:
+\begin{verbatim}
+let f x =
+  let a = 42, x in
+  (Obj.magic a : int ref) := 1;
+  fst a
+\end{verbatim}
+The reason this is unsafe is because the simplification pass believes that
+{\tt fst a} holds the value {\tt 42}; and indeed it must, unless type
+soundness has been broken via unsafe operations.
+
+If it must be the case that code has to be written that triggers warning 59,
+but the code is known to actually be correct (for some definition of
+correct), then {\tt Sys.opaque\_identity} may be used to wrap the value
+before unsafe operations are performed upon it.  Great care must be taken
+when doing this to ensure that the opacity is added at the correct place.
+It must be emphasised that this use of {\tt Sys.opaque\_identity} is only
+for {\bf exceptional} cases.  It should not be used in normal code or to
+try to guide the optimiser.
+
+As an example, this code will return the integer {\tt 1}:
+\begin{verbatim}
+let f x =
+  let a = Sys.opaque_identity (42, x) in
+  (Obj.magic a : int ref) := 1;
+  fst a
+\end{verbatim}
+However the following code will still return {\tt 42}:
+\begin{verbatim}
+let f x =
+  let a = 42, x in
+  Sys.opaque_identity (Obj.magic a : int ref) := 1;
+  fst a
+\end{verbatim}
+
+High levels of inlining performed by Flambda may expose bugs in code
+thought previously to be correct.  Take care, for example, not
+to add type annotations that claim some mutable value is always immediate
+if it might be possible for an unsafe operation to update it to a boxed
+value.
+
+\section{s:flambda-glossary}{Glossary}
+
+The following terminology is used in this chapter of the manual.
+
+\begin{options}
+\item[{\bf Call site}] See {\em direct call site} and %
+{\em indirect call site} below.
+\item[{\bf Closed function}] A function whose body has no free variables
+except its parameters and any to which are bound other functions within
+the same (possibly mutually-recursive) declaration.
+\item[{\bf Closure}] The runtime representation of a function.  This
+includes pointers to the code of the function
+together with the values of any variables that are used in the body of
+the function but actually defined outside of the function, in the
+enclosing scope.
+The values of such variables, collectively known as the
+{\em environment}, are required because the function may be
+invoked from a place where the original bindings of such variables are
+no longer in scope.  A group of possibly
+mutually-recursive functions defined using {\em let rec} all share a
+single closure.  (Note to developers: in the Flambda source code a
+{\em closure} always corresponds to a single function; a
+{\em set of closures} refers to a group of such.)
+\item[{\bf Closure variable}]  A member of the environment held within the
+closure of a given function.
+\item[{\bf Constant}]  Some entity (typically an expression) the value of which
+is known by the compiler at compile time.  Constantness may be explicit from
+the source code or inferred by the Flambda optimisers.
+\item[{\bf Constant closure}] A closure that is statically allocated in an
+object file.  It is almost always the case that the environment portion of
+such a closure is empty.
+\item[{\bf Defining expression}]  The expression {\tt e} in %
+{\tt let x = e in e'}.
+\item[{\bf Direct call site}]  A place in a program's code where a function is
+called and it is known at compile time which function it will always be.
+\item[{\bf Indirect call site}]  A place in a program's code where a function
+is called but is not known to be a {\em direct call site}.
+\item[{\bf Program}]  A collection of {\em symbol bindings} forming the
+definition of a single compilation unit (i.e. {\tt .cmx} file).
+\item[{\bf Specialised argument}]  An argument to a function that is known
+to always hold a particular value at runtime.  These are introduced by the
+inliner when specialising recursive functions; and the {\tt unbox-closures}
+pass.  (See section\ \ref{s:flambda-specialisation}.)
+\item[{\bf Symbol}]  A name referencing a particular place in an object file
+or executable image.  At that particular place will be some constant value.
+Symbols may be examined using operating system-specific tools (for
+example {\tt objdump} on Linux).
+\item[{\bf Symbol binding}]  Analogous to a {\tt let}-expression but working
+at the level of symbols defined in the object file.  The address of a symbol is
+fixed, but it may be bound to both constant and non-constant expressions.
+\item[{\bf Toplevel}]  An expression in the current program which is not
+enclosed within any function declaration.
+\item[{\bf Variable}]  A named entity to which some OCaml value is bound by a
+{\tt let} expression, pattern-matching construction, or similar.
+\end{options}
diff --git a/manual/manual/cmds/instrumented-runtime.etex b/manual/manual/cmds/instrumented-runtime.etex
new file mode 100644
index 00000000..6826f7c7
--- /dev/null
+++ b/manual/manual/cmds/instrumented-runtime.etex
@@ -0,0 +1,315 @@
+\chapter{Runtime tracing with the instrumented runtime}
+%HEVEA\cutname{instrumented-runtime.html}
+
+This chapter describes the OCaml instrumented runtime, a runtime variant
+allowing the collection of events and metrics.
+
+Collected metrics include time spent executing the {\em garbage collector}.
+The overall execution time of individual pauses are measured
+down to the time spent in specific parts of the garbage collection.
+Insight is also given on memory allocation and motion by recording
+the size of allocated memory blocks, as well as value promotions from the
+{\em minor heap} to the {\em major heap}.
+
+\section{s:instr-runtime-overview}{Overview}
+
+Once compiled and linked with the instrumented runtime, any OCaml program
+can generate {\em trace files} that can then be read
+and analyzed by users in order to understand specific runtime behaviors.
+
+The generated trace files are stored using the {\em Common Trace Format}, which
+is a general purpose binary tracing format.
+A complete trace consists of:
+\begin{itemize}
+\item a {\em metadata file}, part of the OCaml distribution
+\item and a {\em trace file}, generated by the runtime\
+  in the program being traced.
+\end{itemize}
+
+For more information on the {\em Common Trace Format}, see
+\href{https://diamon.org/ctf/}{https://diamon.org/ctf/}.
+
+\section{s:instr-runtime-enabling}{Enabling runtime instrumentation}
+
+
+For the following examples, we will use the following example program:
+
+\begin{caml_example*}{verbatim}
+module SMap = Map.Make(String)
+
+let s i = String.make 512 (Char.chr (i mod 256))
+
+let clear map = SMap.fold (fun k _ m -> SMap.remove k m) map map
+
+let rec seq i =
+  if i = 0 then Seq.empty else fun () -> (Seq.Cons (i, seq (i - 1)))
+
+let () =
+  seq 1_000_000
+  |> Seq.fold_left (fun m i -> SMap.add (s i) i m) SMap.empty
+  |> clear
+  |> ignore
+\end{caml_example*}
+
+The next step is to compile and link the program with the instrumented runtime.
+This can be done by using the "-runtime-variant" flag:
+
+\begin{verbatim}
+       ocamlopt -runtime-variant i program.ml -o program
+\end{verbatim}
+
+Note that the instrumented runtime is an alternative runtime for OCaml
+programs. It is only referenced during the linking stage of the final
+executable. This means that the compilation stage does not need to be altered
+to enable instrumentation.
+
+The resulting program can then be traced by running it with the environment
+variable "OCAML_EVENTLOG_ENABLED":
+
+\begin{verbatim}
+        OCAML_EVENTLOG_ENABLED=1 ./program
+\end{verbatim}
+
+During execution, a trace file will be generated in the
+program's current working directory.
+
+\subsubsection*{sss:instr-runtime-build-more}{More build examples}
+
+When using the {\em dune} build system, this compiler invocation can be
+replicated using the {\tt flags} {\tt stanza} when building an executable.
+
+\begin{verbatim}
+       (executable
+         (name program)
+         (flags "-runtime-variant=i"))
+\end{verbatim}
+
+The instrumented runtime can also be used with the OCaml bytecode interpreter.
+This can be done by either using the
+"-runtime-variant=i" flag when linking the program with {\tt ocamlc}, or by running the generated
+bytecode through {\tt ocamlruni}:
+
+\begin{verbatim}
+       ocamlc program.ml -o program.byte
+       OCAML_EVENTLOG_ENABLED=1 ocamlruni program.byte
+\end{verbatim}
+
+See chapter~\ref{c:camlc} and chapter~\ref{c:runtime} for more information about
+{\tt ocamlc} and {\tt ocamlrun}.
+
+\section{s:instr-runtime-read}{Reading traces}
+
+Traces generated by the instrumented runtime can be analyzed with tooling
+available outside of the OCaml distribution.
+
+A complete trace consists of a {\em metadata file} and a {\em trace file}.
+Two simple ways to work with the traces are the {\em eventlog-tools} and
+{\em babeltrace} libraries.
+
+\subsection{ss:instr-runtime-tools}{eventlog-tools}
+{\em eventlog-tools} is a library implementing a parser, as well as a
+a set of tools that allows to perform basic format conversions and analysis.
+
+For more information about {\em eventlog-tools}, refer to the project's
+main page: \href{https://github.com/ocaml-multicore/eventlog-tools}{https://github.com/ocaml-multicore/eventlog-tools}
+
+\subsection{ss:instr-runtime-babeltrace}{babeltrace}
+
+{\em babeltrace} is a C library, as well as a Python binding and set of tools
+that serve as the reference implementation for the {\em Common Trace Format}.
+The {\em babeltrace} command line utility allows for a basic rendering
+of a trace's content, while the high level Python API can be used to
+decode the trace and process them programmatically with libraries
+such as {\em numpy} or {\em Jupyter}.
+
+Unlike {\em eventlog-tools}, which possesses a specific knowledge of
+OCaml's {\em Common Trace Format} schema, it is required to provide
+the OCaml {\em metadata} file to {\em babeltrace}.
+
+The metadata file is available in the OCaml installation.
+Its location can be obtained using the following command:
+
+\begin{verbatim}
+        ocamlc -where
+\end{verbatim}
+
+The {\em eventlog_metadata} file can be found at this path and
+copied in the same directory as the generated trace file.
+However, {\em babeltrace} expects the file to be named
+{\tt metadata} in order to process the trace.
+Thus, it will need to be renamed when copied to the trace's directory.
+
+Here is a naive decoder example, using {\em babeltrace}'s Python
+library, and {\em Python 3.8}:
+
+\begin{verbatim}
+
+import subprocess
+import shutil
+import sys
+import babeltrace as bt
+
+def print_event(ev):
+    print(ev['timestamp'])
+    print(ev['pid'])
+    if ev.name == "entry":
+        print('entry_event')
+        print(ev['phase'])
+    if ev.name == "exit":
+        print('exit_event')
+        print(ev['phase'])
+    if ev.name == "alloc":
+        print(ev['count'])
+        print(ev['bucket'])
+    if ev.name == "counter":
+        print(ev['count'])
+        print(ev['kind'])
+    if ev.name == "flush":
+        print("flush")
+
+def get_ocaml_dir():
+    # Fetching OCaml's installation directory to extract the CTF metadata
+    ocamlc_where = subprocess.run(['ocamlc', '-where'], stdout=subprocess.PIPE)
+    ocaml_dir = ocamlc_where.stdout.decode('utf-8').rstrip('\n')
+    return(ocaml_dir)
+
+def main():
+    trace_dir = sys.argv[1]
+    ocaml_dir = get_ocaml_dir()
+    metadata_path = ocaml_dir + "/eventlog_metadata"
+    # copying the metadata to the trace's directory,
+    # and renaming it to 'metadata'.
+    shutil.copyfile(metadata_path, trace_dir + "/metadata")
+    tr = bt.TraceCollection()
+    tr.add_trace(trace_dir, 'ctf')
+    for event in tr.events:
+        print_event(event)
+
+if __name__ == '__main__':
+    main()
+
+\end{verbatim}
+
+This script expect to receive as an argument the directory containing the
+trace file. It will then copy the {\em CTF} metadata file to the trace's
+directory, and then decode the trace, printing each event in the process.
+
+For more information on {\em babeltrace}, see the website at:
+\href{https://babeltrace.org/}{https://babeltrace.org/}
+
+\section{s:instr-runtime-more}{Controlling instrumentation and limitations}
+
+\subsection{ss:instr-runtime-prefix}{Trace filename}
+
+The default trace filename is {\tt caml-\{PID\}.eventlog}, where {\tt \{PID\}}
+is the process identifier of the traced program.
+
+This filename can also be specified using the
+"OCAML_EVENTLOG_PREFIX" environment variable.
+The given path will be suffixed with {\tt \{.PID\}.eventlog}.
+
+\begin{verbatim}
+        OCAML_EVENTLOG_PREFIX=/tmp/a_prefix OCAML_EVENTLOG_ENABLED=1 ./program
+\end{verbatim}
+
+In this example, the trace will be available at path
+{\tt /tmp/a_prefix.\{PID\}.eventlog}.
+
+Note that this will only affect the prefix of the trace file, there is no
+option to specify the full effective file name.
+This restriction is in place to make room for future improvements to the
+instrumented runtime, where the single trace file per session design
+may be replaced.
+
+For scripting purpose, matching against `\{PID\}`, as well as the
+{\tt .eventlog} file extension should provide enough control over
+the generated files.
+
+Note as well that parent directories in the given path will not be created
+when opening the trace. The runtime assumes the path is
+accessible for creating and writing the trace. The program will
+fail to start if this requirement isn't met.
+
+\subsection{ss:instr-runtime-pause}{Pausing and resuming tracing}
+Mechanisms are available to control event collection at runtime.
+
+"OCAML_EVENTLOG_ENABLED" can be set to the {\tt p} flag in order
+to start the program with event collection paused.
+
+\begin{verbatim}
+        OCAML_EVENTLOG_ENABLED=p ./program
+\end{verbatim}
+
+The program will have to start event collection explicitly.
+Starting and stopping event collection programmatically can be done by calling
+{\tt Gc.eventlog_resume} and {\tt Gc.eventlog_pause}) from within the program.
+Refer to the {\stdmoduleref{Gc}} module documentation for more information.
+
+Running the program provided earlier with "OCAML_EVENTLOG_ENABLED=p"
+will for example yield the following result.
+
+\begin{verbatim}
+$ OCAML_EVENTLOG_ENABLED=p ./program
+$ ocaml-eventlog-report caml-{PID}.eventlog
+==== eventlog/flush
+median flush time: 58ns
+total flush time: 58ns
+flush count: 1
+\end{verbatim}
+
+The resulting trace contains only one event payload, namely a {\em flush} event,
+indicating how much time was spent flushing the trace file to disk.
+
+However, if the program is changed to include a call to
+{\tt Gc.eventlog_resume}, events payloads can be seen again
+in the trace file.
+
+\begin{caml_example*}{verbatim}
+       let () =
+         Gc.eventlog_resume();
+         seq 1_000_000
+         |> Seq.fold_left (fun m i -> SMap.add (s i) i m) SMap.empty
+         |> clear
+         |> ignore
+
+\end{caml_example*}
+
+The resulting trace will contain all events encountered during
+the program's execution:
+
+\begin{verbatim}
+        $ ocaml-eventlog-report caml-{PID}.eventlog
+        [..omitted..]
+        ==== force_minor/alloc_small
+        100.0K..200.0K: 174
+        20.0K..30.0K: 1
+        0..100: 1
+
+        ==== eventlog/flush
+        median flush time: 207.8us
+        total flush time: 938.1us
+        flush count: 5
+\end{verbatim}
+
+\subsection{ss:instr-runtime-limitations}{Limitations}
+
+The instrumented runtime does not support the {\tt fork} system call.
+A child process forked from an instrumented program will not be traced.
+
+The instrumented runtime aims to provide insight into the runtime's execution
+while maintaining a low overhead.
+However, this overhead may become more noticeable depending on how a program
+executes.
+The instrumented runtime currently puts a strong emphasis on
+tracing {\em garbage collection} events. This means that programs
+with heavy garbage collection activity may be more susceptible to
+tracing induced performance penalties.
+
+While providing an accurate estimate of potential performance loss is difficult,
+test on various OCaml programs showed a total running time increase ranging
+from 1\% to 8\%.
+
+For a program with an extended running time where the collection of only a
+small sample of events is required, using the {\em eventlog_resume} and
+{\em eventlog_pause} primitives may help relieve some of the
+tracing induced performance impact.
diff --git a/manual/manual/cmds/intf-c.etex b/manual/manual/cmds/intf-c.etex
new file mode 100644
index 00000000..d7174caa
--- /dev/null
+++ b/manual/manual/cmds/intf-c.etex
@@ -0,0 +1,2802 @@
+\chapter{Interfacing\label{c:intf-c} C with OCaml}
+%HEVEA\cutname{intfc.html}
+
+This chapter describes how user-defined primitives, written in C, can
+be linked with OCaml code and called from OCaml functions, and how
+these C functions can call back to OCaml code.
+
+\section{s:c-overview}{Overview and compilation information}
+
+\subsection{ss:c-prim-decl}{Declaring primitives}
+
+\begin{syntax}
+definition: ...
+            | 'external' value-name ':' typexpr '=' external-declaration
+;
+external-declaration: string-literal [ string-literal [ string-literal ] ]
+\end{syntax}
+
+User primitives are declared in an implementation file or
+@"struct"\ldots"end"@ module expression using the @"external"@ keyword:
+\begin{alltt}
+        external \var{name} : \var{type} = \var{C-function-name}
+\end{alltt}
+This defines the value name \var{name} as a function with type
+\var{type} that executes by calling the given C function.
+For instance, here is how the "int_of_string" primitive is declared in the
+standard library module "Stdlib":
+\begin{verbatim}
+        external int_of_string : string -> int = "caml_int_of_string"
+\end{verbatim}
+Primitives with several arguments are always curried. The C function
+does not necessarily have the same name as the ML function.
+
+External functions thus defined can be specified in interface files or
+@"sig"\ldots"end"@ signatures either as regular values
+\begin{alltt}
+        val \var{name} : \var{type}
+\end{alltt}
+thus hiding their implementation as C functions, or explicitly as
+``manifest'' external functions
+\begin{alltt}
+        external \var{name} : \var{type} = \var{C-function-name}
+\end{alltt}
+The latter is slightly more efficient, as it allows clients of the
+module to call directly the C function instead of going through the
+corresponding OCaml function. On the other hand, it should not be used
+in library modules if they have side-effects at toplevel, as this
+direct call interferes with the linker's algorithm for removing unused
+modules from libraries at link-time.
+
+The arity (number of arguments) of a primitive is automatically
+determined from its OCaml type in the "external" declaration, by
+counting the number of function arrows in the type.  For instance,
+"input" above has arity 4, and the "input" C function is called with
+four arguments.  Similarly,
+\begin{verbatim}
+    external input2 : in_channel * bytes * int * int -> int = "input2"
+\end{verbatim}
+has arity 1, and the "input2" C function receives one argument (which
+is a quadruple of OCaml values).
+
+Type abbreviations are not expanded when determining the arity of a
+primitive.  For instance,
+\begin{verbatim}
+        type int_endo = int -> int
+        external f : int_endo -> int_endo = "f"
+        external g : (int -> int) -> (int -> int) = "f"
+\end{verbatim}
+"f" has arity 1, but "g" has arity 2.  This allows a primitive to
+return a functional value (as in the "f" example above): just remember
+to name the functional return type in a type abbreviation.
+
+The language accepts external declarations with one or two
+flag strings in addition to the C function's name.  These flags are
+reserved for the implementation of the standard library.
+
+\subsection{ss:c-prim-impl}{Implementing primitives}
+
+User primitives with arity $n \leq 5$ are implemented by C functions
+that take $n$ arguments of type "value", and return a result of type
+"value". The type "value" is the type of the representations for OCaml
+values. It encodes objects of several base types (integers,
+floating-point numbers, strings,~\ldots) as well as OCaml data
+structures. The type "value" and the associated conversion
+functions and macros are described in detail below.  For instance,
+here is the declaration for the C function implementing the "input"
+primitive:
+\begin{verbatim}
+CAMLprim value input(value channel, value buffer, value offset, value length)
+{
+  ...
+}
+\end{verbatim}
+When the primitive function is applied in an OCaml program, the C
+function is called with the values of the expressions to which the
+primitive is applied as arguments. The value returned by the function is
+passed back to the OCaml program as the result of the function
+application.
+
+User primitives with arity greater than 5 should be implemented by two
+C functions. The first function, to be used in conjunction with the
+bytecode compiler "ocamlc", receives two arguments: a pointer to an
+array of OCaml values (the values for the arguments), and an
+integer which is the number of arguments provided. The other function,
+to be used in conjunction with the native-code compiler "ocamlopt",
+takes its arguments directly. For instance, here are the two C
+functions for the 7-argument primitive "Nat.add_nat":
+\begin{verbatim}
+CAMLprim value add_nat_native(value nat1, value ofs1, value len1,
+                              value nat2, value ofs2, value len2,
+                              value carry_in)
+{
+  ...
+}
+CAMLprim value add_nat_bytecode(value * argv, int argn)
+{
+  return add_nat_native(argv[0], argv[1], argv[2], argv[3],
+                        argv[4], argv[5], argv[6]);
+}
+\end{verbatim}
+The names of the two C functions must be given in the primitive
+declaration, as follows:
+\begin{alltt}
+        external \var{name} : \var{type} =
+                 \var{bytecode-C-function-name} \var{native-code-C-function-name}
+\end{alltt}
+For instance, in the case of "add_nat", the declaration is:
+\begin{verbatim}
+        external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int
+                        = "add_nat_bytecode" "add_nat_native"
+\end{verbatim}
+
+Implementing a user primitive is actually two separate tasks: on the
+one hand, decoding the arguments to extract C values from the given
+OCaml values, and encoding the return value as an OCaml
+value; on the other hand, actually computing the result from the arguments.
+Except for very simple primitives, it is often preferable to have two
+distinct C functions to implement these two tasks. The first function
+actually implements the primitive, taking native C values as
+arguments and returning a native C value. The second function,
+often called the ``stub code'', is a simple wrapper around the first
+function that converts its arguments from OCaml values to C values,
+call the first function, and convert the returned C value to OCaml
+value. For instance, here is the stub code for the "input"
+primitive:
+\begin{verbatim}
+CAMLprim value input(value channel, value buffer, value offset, value length)
+{
+  return Val_long(getblock((struct channel *) channel,
+                           &Byte(buffer, Long_val(offset)),
+                           Long_val(length)));
+}
+\end{verbatim}
+(Here, "Val_long", "Long_val" and so on are conversion macros for the
+type "value", that will be described later.  The "CAMLprim" macro
+expands to the required compiler directives to ensure that the
+function is exported and accessible from OCaml.)
+The hard work is performed by the function "getblock", which is
+declared as:
+\begin{verbatim}
+long getblock(struct channel * channel, char * p, long n)
+{
+  ...
+}
+\end{verbatim}
+
+To write C code that operates on OCaml values, the following
+include files are provided:
+\begin{tableau}{|l|p{12cm}|}{Include file}{Provides}
+\entree{"caml/mlvalues.h"}{definition of the "value" type, and conversion
+macros}
+\entree{"caml/alloc.h"}{allocation functions (to create structured OCaml
+objects)}
+\entree{"caml/memory.h"}{miscellaneous memory-related functions
+and macros (for GC interface, in-place modification of structures, etc).}
+\entree{"caml/fail.h"}{functions for raising exceptions
+(see section~\ref{ss:c-exceptions})}
+\entree{"caml/callback.h"}{callback from C to OCaml (see
+section~\ref{s:c-callback}).}
+\entree{"caml/custom.h"}{operations on custom blocks (see
+section~\ref{s:c-custom}).}
+\entree{"caml/intext.h"}{operations for writing user-defined
+serialization and deserialization functions for custom blocks
+(see section~\ref{s:c-custom}).}
+\entree{"caml/threads.h"}{operations for interfacing in the presence
+  of multiple threads (see section~\ref{s:C-multithreading}).}
+\end{tableau}
+Before including any of these files, you should define the "OCAML_NAME_SPACE"
+macro. For instance,
+\begin{verbatim}
+#define CAML_NAME_SPACE
+#include "caml/mlvalues.h"
+#include "caml/fail.h"
+\end{verbatim}
+These files reside in the "caml/" subdirectory of the OCaml
+standard library directory, which is returned by the command
+"ocamlc -where" (usually "/usr/local/lib/ocaml" or "/usr/lib/ocaml").
+
+{\bf Note:}
+Including the header files without first defining "CAML_NAME_SPACE"
+introduces in scope short names for most functions.
+Those short names are deprecated, and may be removed in the future
+because they usually produce clashes with names defined by other
+C libraries.
+
+\subsection{ss:staticlink-c-code}{Statically linking C code with OCaml code}
+
+The OCaml runtime system comprises three main parts: the bytecode
+interpreter, the memory manager, and a set of C functions that
+implement the primitive operations. Some bytecode instructions are
+provided to call these C functions, designated by their offset in a
+table of functions (the table of primitives).
+
+In the default mode, the OCaml linker produces bytecode for the
+standard runtime system, with a standard set of primitives. References
+to primitives that are not in this standard set result in the
+``unavailable C primitive'' error.  (Unless dynamic loading of C
+libraries is supported -- see section~\ref{ss:dynlink-c-code} below.)
+
+In the ``custom runtime'' mode, the OCaml linker scans the
+object files and determines the set of required primitives. Then, it
+builds a suitable runtime system, by calling the native code linker with:
+\begin{itemize}
+\item the table of the required primitives;
+\item a library that provides the bytecode interpreter, the
+memory manager, and the standard primitives;
+\item libraries and object code files (".o" files) mentioned on the
+command line for the OCaml linker, that provide implementations
+for the user's primitives.
+\end{itemize}
+This builds a runtime system with the required primitives. The OCaml
+linker generates bytecode for this custom runtime system. The
+bytecode is appended to the end of the custom runtime system, so that
+it will be automatically executed when the output file (custom
+runtime + bytecode) is launched.
+
+To link in ``custom runtime'' mode, execute the "ocamlc" command with:
+\begin{itemize}
+\item the "-custom" option;
+\item the names of the desired OCaml object files (".cmo" and ".cma" files) ;
+\item the names of the C object files and libraries (".o" and ".a"
+files) that implement the required primitives. Under Unix and Windows,
+a library named "lib"\var{name}".a" (respectively, ".lib") residing in one of
+the standard library directories can also be specified as "-cclib -l"\var{name}.
+\end{itemize}
+
+If you are using the native-code compiler "ocamlopt", the "-custom"
+flag is not needed, as the final linking phase of "ocamlopt" always
+builds a standalone executable.  To build a mixed OCaml/C executable,
+execute the "ocamlopt" command with:
+\begin{itemize}
+\item the names of the desired OCaml native object files (".cmx" and
+".cmxa" files);
+\item the names of the C object files and libraries (".o", ".a",
+".so" or ".dll" files) that implement the required primitives.
+\end{itemize}
+
+Starting with Objective Caml 3.00, it is possible to record the
+"-custom" option as well as the names of C libraries in an OCaml
+library file ".cma" or ".cmxa".  For instance, consider an OCaml library
+"mylib.cma", built from the OCaml object files "a.cmo" and "b.cmo",
+which reference C code in "libmylib.a".  If the library is
+built as follows:
+\begin{alltt}
+        ocamlc -a -o mylib.cma -custom a.cmo b.cmo -cclib -lmylib
+\end{alltt}
+users of the library can simply link with "mylib.cma":
+\begin{alltt}
+        ocamlc -o myprog mylib.cma ...
+\end{alltt}
+and the system will automatically add the "-custom" and "-cclib
+-lmylib" options, achieving the same effect as
+\begin{alltt}
+        ocamlc -o myprog -custom a.cmo b.cmo ... -cclib -lmylib
+\end{alltt}
+The alternative is of course to build the library without extra
+options:
+\begin{alltt}
+        ocamlc -a -o mylib.cma a.cmo b.cmo
+\end{alltt}
+and then ask users to provide the "-custom" and "-cclib -lmylib"
+options themselves at link-time:
+\begin{alltt}
+        ocamlc -o myprog -custom mylib.cma ... -cclib -lmylib
+\end{alltt}
+The former alternative is more convenient for the final users of the
+library, however.
+
+\subsection{ss:dynlink-c-code}{Dynamically linking C code with OCaml code}
+
+Starting with Objective Caml 3.03, an alternative to static linking of C code
+using the "-custom" code is provided.  In this mode, the OCaml linker
+generates a pure bytecode executable (no embedded custom runtime
+system) that simply records the names of dynamically-loaded libraries
+containing the C code.  The standard OCaml runtime system "ocamlrun"
+then loads dynamically these libraries, and resolves references to the
+required primitives, before executing the bytecode.
+
+This facility is currently available on all platforms supported by
+OCaml except Cygwin 64 bits.
+
+To dynamically link C code with OCaml code, the C code must first be
+compiled into a shared library (under Unix) or DLL (under Windows).
+This involves 1- compiling the C files with appropriate C compiler
+flags for producing position-independent code (when required by the
+operating system), and 2- building a
+shared library from the resulting object files.  The resulting shared
+library or DLL file must be installed in a place where "ocamlrun" can
+find it later at program start-up time (see
+section~\ref{s:ocamlrun-dllpath}).
+Finally (step 3), execute the "ocamlc" command with
+\begin{itemize}
+\item the names of the desired OCaml object files (".cmo" and ".cma" files) ;
+\item the names of the C shared libraries (".so" or ".dll" files) that
+implement the required primitives.  Under Unix and Windows,
+a library named "dll"\var{name}".so" (respectively, ".dll") residing
+in one of the standard library directories can also be specified as
+"-dllib -l"\var{name}.
+\end{itemize}
+Do {\em not} set the "-custom" flag, otherwise you're back to static linking
+as described in section~\ref{ss:staticlink-c-code}.
+The "ocamlmklib" tool (see section~\ref{s:ocamlmklib})
+automates steps 2 and 3.
+
+As in the case of static linking, it is possible (and recommended) to
+record the names of C libraries in an OCaml ".cma" library archive.
+Consider again an OCaml library
+"mylib.cma", built from the OCaml object files "a.cmo" and "b.cmo",
+which reference C code in "dllmylib.so".  If the library is
+built as follows:
+\begin{alltt}
+        ocamlc -a -o mylib.cma a.cmo b.cmo -dllib -lmylib
+\end{alltt}
+users of the library can simply link with "mylib.cma":
+\begin{alltt}
+        ocamlc -o myprog mylib.cma ...
+\end{alltt}
+and the system will automatically add the "-dllib -lmylib" option,
+achieving the same effect as
+\begin{alltt}
+        ocamlc -o myprog a.cmo b.cmo ... -dllib -lmylib
+\end{alltt}
+Using this mechanism, users of the library "mylib.cma" do not need to
+known that it references C code, nor whether this C code must be
+statically linked (using "-custom") or dynamically linked.
+
+\subsection{ss:c-static-vs-dynamic}{Choosing between static linking and dynamic linking}
+
+After having described two different ways of linking C code with OCaml
+code, we now review the pros and cons of each, to help developers of
+mixed OCaml/C libraries decide.
+
+The main advantage of dynamic linking is that it preserves the
+platform-independence of bytecode executables.  That is, the bytecode
+executable contains no machine code, and can therefore be compiled on
+platform $A$ and executed on other platforms $B$, $C$, \ldots, as long
+as the required shared libraries are available on all these
+platforms.  In contrast, executables generated by "ocamlc -custom" run
+only on the platform on which they were created, because they embark a
+custom-tailored runtime system specific to that platform.  In
+addition, dynamic linking results in smaller executables.
+
+Another advantage of dynamic linking is that the final users of the
+library do not need to have a C compiler, C linker, and C runtime
+libraries installed on their machines.  This is no big deal under
+Unix and Cygwin, but many Windows users are reluctant to install
+Microsoft Visual C just to be able to do "ocamlc -custom".
+
+There are two drawbacks to dynamic linking.  The first is that the
+resulting executable is not stand-alone: it requires the shared
+libraries, as well as "ocamlrun", to be installed on the machine
+executing the code.  If you wish to distribute a stand-alone
+executable, it is better to link it statically, using "ocamlc -custom
+-ccopt -static" or "ocamlopt -ccopt -static".  Dynamic linking also
+raises the ``DLL hell'' problem: some care must be taken to ensure
+that the right versions of the shared libraries are found at start-up
+time.
+
+The second drawback of dynamic linking is that it complicates the
+construction of the library.  The C compiler and linker flags to
+compile to position-independent code and build a shared library vary
+wildly between different Unix systems.  Also, dynamic linking is not
+supported on all Unix systems, requiring a fall-back case to static
+linking in the Makefile for the library.  The "ocamlmklib" command
+(see section~\ref{s:ocamlmklib}) tries to hide some of these system
+dependencies.
+
+In conclusion: dynamic linking is highly recommended under the native
+Windows port, because there are no portability problems and it is much
+more convenient for the end users.  Under Unix, dynamic linking should
+be considered for mature, frequently used libraries because it
+enhances platform-independence of bytecode executables.  For new or
+rarely-used libraries, static linking is much simpler to set up in a
+portable way.
+
+\subsection{ss:custom-runtime}{Building standalone custom runtime systems}
+
+It is sometimes inconvenient to build a custom runtime system each
+time OCaml code is linked with C libraries, like "ocamlc -custom" does.
+For one thing, the building of the runtime system is slow on some
+systems (that have bad linkers or slow remote file systems); for
+another thing, the platform-independence of bytecode files is lost,
+forcing to perform one "ocamlc -custom" link per platform of interest.
+
+An alternative to "ocamlc -custom" is to build separately a custom
+runtime system integrating the desired C libraries, then generate
+``pure'' bytecode executables (not containing their own runtime
+system) that can run on this custom runtime.  This is achieved by the
+"-make-runtime" and "-use-runtime" flags to "ocamlc".  For example,
+to build a custom runtime system integrating the C parts of the
+``Unix'' and ``Threads'' libraries, do:
+\begin{verbatim}
+        ocamlc -make-runtime -o /home/me/ocamlunixrun unix.cma threads.cma
+\end{verbatim}
+To generate a bytecode executable that runs on this runtime system,
+do:
+\begin{alltt}
+        ocamlc -use-runtime /home/me/ocamlunixrun -o myprog \char92
+                unix.cma threads.cma {\it{your .cmo and .cma files}}
+\end{alltt}
+The bytecode executable "myprog" can then be launched as usual:
+"myprog" \var{args} or "/home/me/ocamlunixrun myprog" \var{args}.
+
+Notice that the bytecode libraries "unix.cma" and "threads.cma" must
+be given twice: when building the runtime system (so that "ocamlc"
+knows which C primitives are required) and also when building the
+bytecode executable (so that the bytecode from "unix.cma" and
+"threads.cma" is actually linked in).
+
+\section{s:c-value}{The \texttt{value} type}
+
+All OCaml objects are represented by the C type "value",
+defined in the include file "caml/mlvalues.h", along with macros to
+manipulate values of that type. An object of type "value" is either:
+\begin{itemize}
+\item an unboxed integer;
+\item or a pointer to a block inside the heap,
+allocated through one of the \verb"caml_alloc_*" functions described
+in section~\ref{ss:c-block-allocation}.
+\end{itemize}
+
+\subsection{ss:c-int}{Integer values}
+
+Integer values encode 63-bit signed integers (31-bit on 32-bit
+architectures). They are unboxed (unallocated).
+
+\subsection{ss:c-blocks}{Blocks}
+
+Blocks in the heap are garbage-collected, and therefore have strict
+structure constraints. Each block includes a header containing the
+size of the block (in words), and the tag of the block.
+The tag governs how the contents of the blocks are structured. A tag
+lower than "No_scan_tag" indicates a structured block, containing
+well-formed values, which is recursively traversed by the garbage
+collector. A tag greater than or equal to "No_scan_tag" indicates a
+raw block, whose contents are not scanned by the garbage collector.
+For the benefit of ad-hoc polymorphic primitives such as equality and
+structured input-output, structured and raw blocks are further
+classified according to their tags as follows:
+\begin{tableau}{|l|p{10cm}|}{Tag}{Contents of the block}
+\entree{0 to $\hbox{"No_scan_tag"}-1$}{A structured block (an array of
+OCaml objects). Each field is a "value".}
+\entree{"Closure_tag"}{A closure representing a functional value. The first
+word is a pointer to a piece of code, the remaining words are
+"value" containing the environment.}
+\entree{"String_tag"}{A character string or a byte sequence.}
+\entree{"Double_tag"}{A double-precision floating-point number.}
+\entree{"Double_array_tag"}{An array or record of double-precision
+floating-point numbers.}
+\entree{"Abstract_tag"}{A block representing an abstract datatype.}
+\entree{"Custom_tag"}{A block representing an abstract datatype
+              with user-defined finalization, comparison, hashing,
+              serialization and deserialization functions attached.}
+\end{tableau}
+
+\subsection{ss:c-outside-head}{Pointers outside the heap}
+
+In earlier versions of OCaml, it was possible to use
+word-aligned pointers to addresses outside the heap as OCaml values,
+just by casting the pointer to type "value".  Starting with OCaml
+4.11, this usage is deprecated and will stop being supported in OCaml 5.00.
+
+A correct way to manipulate pointers to out-of-heap blocks from
+OCaml is to store those pointers in OCaml blocks with tag
+"Abstract_tag" or "Custom_tag", then use the blocks as the OCaml
+values.
+
+Here is an example of encapsulation of out-of-heap pointers of C type
+"ty *" inside "Abstract_tag" blocks.  Section~\ref{s:c-intf-example}
+gives a more complete example using "Custom_tag" blocks.
+\begin{verbatim}
+/* Create an OCaml value encapsulating the pointer p */
+static value val_of_typtr(ty * p)
+{
+  value v = caml_alloc(1, Abstract_tag);
+  *((ty **) Data_abstract_val(v)) = p;
+  return v;
+}
+
+/* Extract the pointer encapsulated in the given OCaml value */
+static ty * typtr_of_val(value v)
+{
+  return *((ty **) Data_abstract_val(v));
+}
+\end{verbatim}
+Alternatively, out-of-heap pointers can be treated as ``native''
+integers, that is, boxed 32-bit integers on a 32-bit platform and
+boxed 64-bit integers on a 64-bit platform.
+\begin{verbatim}
+/* Create an OCaml value encapsulating the pointer p */
+static value val_of_typtr(ty * p)
+{
+  return caml_copy_nativeint((intnat) p);
+}
+
+/* Extract the pointer encapsulated in the given OCaml value */
+static ty * typtr_of_val(value v)
+{
+  return (ty *) Nativeint_val(v);
+}
+\end{verbatim}
+For pointers that are at least 2-aligned (the low bit is guaranteed to
+be zero), we have yet another valid representation as an OCaml tagged
+integer.
+\begin{verbatim}
+/* Create an OCaml value encapsulating the pointer p */
+static value val_of_typtr(ty * p)
+{
+  assert (((uintptr_t) p & 1) == 0);  /* check correct alignment */
+  return (value) p | 1;
+}
+
+/* Extract the pointer encapsulated in the given OCaml value */
+static ty * typtr_of_val(value v)
+{
+  return (ty *) (v & ~1);
+}
+\end{verbatim}
+
+
+\section{s:c-ocaml-datatype-repr}{Representation of OCaml data types}
+
+This section describes how OCaml data types are encoded in the
+"value" type.
+
+\subsection{ss:c-atomic}{Atomic types}
+
+\begin{tableau}{|l|l|}{OCaml type}{Encoding}
+\entree{"int"}{Unboxed integer values.}
+\entree{"char"}{Unboxed integer values (ASCII code).}
+\entree{"float"}{Blocks with tag "Double_tag".}
+\entree{"bytes"}{Blocks with tag "String_tag".}
+\entree{"string"}{Blocks with tag "String_tag".}
+\entree{"int32"}{Blocks with tag "Custom_tag".}
+\entree{"int64"}{Blocks with tag "Custom_tag".}
+\entree{"nativeint"}{Blocks with tag "Custom_tag".}
+\end{tableau}
+
+\subsection{ss:c-tuples-and-records}{Tuples and records}
+
+Tuples are represented by pointers to blocks, with tag~0.
+
+Records are also represented by zero-tagged blocks. The ordering of
+labels in the record type declaration determines the layout of
+the record fields: the value associated to the label
+declared first is stored in field~0 of the block, the value associated
+to the second label goes in field~1, and so on.
+
+As an optimization, records whose fields all have static type "float"
+are represented as arrays of floating-point numbers, with tag
+"Double_array_tag". (See the section below on arrays.)
+
+As another optimization, unboxable record types are represented
+specially; unboxable record types are the immutable record types that
+have only one field. An unboxable type will be represented in one of
+two ways: boxed or unboxed. Boxed record types are represented as
+described above (by a block with tag 0 or "Double_array_tag"). An
+unboxed record type is represented directly by the value of its field
+(i.e. there is no block to represent the record itself).
+
+The representation is chosen according to the following, in decreasing
+order of priority:
+\begin{itemize}
+\item An attribute ("[\@\@boxed]" or "[\@\@unboxed]") on the type declaration.
+\item A compiler option ("-unboxed-types" or "-no-unboxed-types").
+\item The default representation. In the present version of OCaml, the
+default is the boxed representation.
+\end{itemize}
+
+\subsection{ss:c-arrays}{Arrays}
+
+Arrays of integers and pointers are represented like tuples,
+that is, as pointers to blocks tagged~0.  They are accessed with the
+"Field" macro for reading and the "caml_modify" function for writing.
+
+Arrays of floating-point numbers (type "float array")
+have a special, unboxed, more efficient representation.
+These arrays are represented by pointers to blocks with tag
+"Double_array_tag".  They should be accessed with the "Double_field"
+and "Store_double_field" macros.
+
+\subsection{ss:c-concrete-datatypes}{Concrete data types}
+
+Constructed terms are represented either by unboxed integers (for
+constant constructors) or by blocks whose tag encode the constructor
+(for non-constant constructors). The constant constructors and the
+non-constant constructors for a given concrete type are numbered
+separately, starting from 0, in the order in which they appear in the
+concrete type declaration. A constant constructor is represented by
+the unboxed integer equal to its constructor number. A non-constant
+constructor declared with $n$ arguments is represented by
+a block of size $n$, tagged with the constructor number; the $n$
+fields contain its arguments. Example:
+
+\begin{tableau}{|l|p{8cm}|}{Constructed term}{Representation}
+\entree{"()"}{"Val_int(0)"}
+\entree{"false"}{"Val_int(0)"}
+\entree{"true"}{"Val_int(1)"}
+\entree{"[]"}{"Val_int(0)"}
+\entree{"h::t"}{Block with size = 2 and tag = 0; first field
+contains "h", second field "t".}
+\end{tableau}
+
+As a convenience, "caml/mlvalues.h" defines the macros "Val_unit",
+"Val_false" and "Val_true" to refer to "()", "false" and "true".
+
+The following example illustrates the assignment of
+integers and block tags to constructors:
+\begin{verbatim}
+type t =
+  | A             (* First constant constructor -> integer "Val_int(0)" *)
+  | B of string   (* First non-constant constructor -> block with tag 0 *)
+  | C             (* Second constant constructor -> integer "Val_int(1)" *)
+  | D of bool     (* Second non-constant constructor -> block with tag 1 *)
+  | E of t * t    (* Third non-constant constructor -> block with tag 2 *)
+\end{verbatim}
+
+
+As an optimization, unboxable concrete data types are represented
+specially; a concrete data type is unboxable if it has exactly one
+constructor and this constructor has exactly one argument. Unboxable
+concrete data types are represented in the same ways as unboxable
+record types: see the description in
+section~\ref{ss:c-tuples-and-records}.
+
+\subsection{ss:c-objects}{Objects}
+
+Objects are represented as blocks with tag "Object_tag". The first
+field of the block refers to the object's class and associated method
+suite, in a format that cannot easily be exploited from C. The second
+field contains a unique object ID, used for comparisons. The remaining
+fields of the object contain the values of the instance variables of
+the object. It is unsafe to access directly instance variables, as the
+type system provides no guarantee about the instance variables
+contained by an object.
+% Instance variables are stored in the order in which they
+% appear in the class definition (taking inherited classes into
+% account).
+
+One may extract a public method from an object using the C function
+"caml_get_public_method" (declared in "".)
+Since public method tags are hashed in the same way as variant tags,
+and methods are functions taking self as first argument, if you want
+to do the method call "foo#bar" from the C side, you should call:
+\begin{verbatim}
+  callback(caml_get_public_method(foo, hash_variant("bar")), foo);
+\end{verbatim}
+
+\subsection{ss:c-polyvar}{Polymorphic variants}
+
+Like constructed terms, polymorphic variant values are represented either
+as integers (for polymorphic variants without argument), or as blocks
+(for polymorphic variants with an argument).  Unlike constructed
+terms, variant constructors are not numbered starting from 0, but
+identified by a hash value (an OCaml integer), as computed by the C function
+"hash_variant" (declared in ""):
+the hash value for a variant constructor named, say, "VConstr"
+is "hash_variant(\"VConstr\")".
+
+The variant value "`VConstr" is represented by
+"hash_variant(\"VConstr\")".  The variant value "`VConstr("\var{v}")" is
+represented by a block of size 2 and tag 0, with field number 0
+containing "hash_variant(\"VConstr\")" and field number 1 containing
+\var{v}.
+
+Unlike constructed values, polymorphic variant values taking several
+arguments are not flattened.
+That is, "`VConstr("\var{v}", "\var{w}")" is represented by a block
+of size 2, whose field number 1 contains the representation of the
+pair "("\var{v}", "\var{w}")", rather than a block of size 3
+containing \var{v} and \var{w} in fields 1 and 2.
+
+\section{s:c-ops-on-values}{Operations on values}
+
+\subsection{ss:c-kind-tests}{Kind tests}
+
+\begin{itemize}
+\item "Is_long("\var{v}")" is true if value \var{v} is an immediate integer,
+false otherwise
+\item "Is_block("\var{v}")" is true if value \var{v} is a pointer to a block,
+and false if it is an immediate integer.
+\end{itemize}
+
+\subsection{ss:c-int-ops}{Operations on integers}
+
+\begin{itemize}
+\item "Val_long("\var{l}")" returns the value encoding the "long int" \var{l}.
+\item "Long_val("\var{v}")" returns the "long int" encoded in value \var{v}.
+\item "Val_int("\var{i}")" returns the value encoding the "int" \var{i}.
+\item "Int_val("\var{v}")" returns the "int" encoded in value \var{v}.
+\item "Val_bool("\var{x}")" returns the OCaml boolean representing the
+truth value of the C integer \var{x}.
+\item "Bool_val("\var{v}")" returns 0 if \var{v} is the OCaml boolean
+"false", 1 if \var{v} is "true".
+\item "Val_true", "Val_false" represent the OCaml booleans "true" and "false".
+\end{itemize}
+
+\subsection{ss:c-block-access}{Accessing blocks}
+
+\begin{itemize}
+\item "Wosize_val("\var{v}")" returns the size of the block \var{v}, in words,
+excluding the header.
+\item "Tag_val("\var{v}")" returns the tag of the block \var{v}.
+\item "Field("\var{v}", "\var{n}")" returns the value contained in the
+$n\th$ field of the structured block \var{v}. Fields are numbered from 0 to
+$\hbox{"Wosize_val"}(v)-1$.
+\item "Store_field("\var{b}", "\var{n}", "\var{v}")" stores the value
+\var{v} in the field number \var{n} of value \var{b}, which must be a
+structured block.
+\item "Code_val("\var{v}")" returns the code part of the closure \var{v}.
+\item "caml_string_length("\var{v}")" returns the length (number of bytes)
+of the string or byte sequence \var{v}.
+\item "Byte("\var{v}", "\var{n}")" returns the $n\th$ byte of the string
+or byte sequence \var{v}, with type "char". Bytes are numbered from 0 to
+$\hbox{"string_length"}(v)-1$.
+\item "Byte_u("\var{v}", "\var{n}")" returns the $n\th$ byte of the string
+or byte sequence \var{v}, with type "unsigned char". Bytes are
+numbered from 0 to $\hbox{"string_length"}(v)-1$.
+\item "String_val("\var{v}")" returns a pointer to the first byte of the string
+\var{v}, with type "char *" or, when OCaml is configured with
+"-force-safe-string", 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.
+\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
+value \var{v}, with type "double".
+\item "Double_field("\var{v}", "\var{n}")" returns
+the $n\th$ element of the array of floating-point numbers \var{v} (a
+block tagged "Double_array_tag").
+\item "Store_double_field("\var{v}", "\var{n}",
+"\var{d}")" stores the double precision floating-point number \var{d}
+in the $n\th$ element of the array of floating-point numbers \var{v}.
+\item "Data_custom_val("\var{v}")" returns a pointer to the data part
+of the custom block \var{v}.  This pointer has type "void *" and must
+be cast to the type of the data contained in the custom block.
+\item "Int32_val("\var{v}")" returns the 32-bit integer contained
+in the "int32" \var{v}.
+\item "Int64_val("\var{v}")" returns the 64-bit integer contained
+in the "int64" \var{v}.
+\item "Nativeint_val("\var{v}")" returns the long integer contained
+in the "nativeint" \var{v}.
+\item "caml_field_unboxed("\var{v}")" returns the value of the field
+of a value \var{v} of any unboxed type (record or concrete data type).
+\item "caml_field_boxed("\var{v}")" returns the value of the field
+of a value \var{v} of any boxed type (record or concrete data type).
+\item "caml_field_unboxable("\var{v}")" calls either
+"caml_field_unboxed" or "caml_field_boxed" according to the default
+representation of unboxable types in the current version of OCaml.
+\end{itemize}
+The expressions "Field("\var{v}", "\var{n}")",
+"Byte("\var{v}", "\var{n}")" and
+"Byte_u("\var{v}", "\var{n}")"
+are valid l-values. Hence, they can be assigned to, resulting in an
+in-place modification of value \var{v}.
+Assigning directly to "Field("\var{v}", "\var{n}")" must
+be done with care to avoid confusing the garbage collector (see
+below).
+
+\subsection{ss:c-block-allocation}{Allocating blocks}
+
+\subsubsection{sss:c-simple-allocation}{Simple interface}
+
+\begin{itemize}
+\item
+"Atom("\var{t}")" returns an ``atom'' (zero-sized block) with tag \var{t}.
+Zero-sized blocks are preallocated outside of the heap. It is
+incorrect to try and allocate a zero-sized block using the functions below.
+For instance, "Atom(0)" represents the empty array.
+\item
+"caml_alloc("\var{n}", "\var{t}")" returns a fresh block of size \var{n}
+with tag \var{t}.  If \var{t} is less than "No_scan_tag", then the
+fields of the block are initialized with a valid value in order to
+satisfy the GC constraints.
+\item
+"caml_alloc_tuple("\var{n}")" returns a fresh block of size
+\var{n} words, with tag 0.
+\item
+"caml_alloc_string("\var{n}")" returns a byte sequence (or string) value of
+length \var{n} bytes. The sequence initially contains uninitialized bytes.
+\item
+"caml_alloc_initialized_string("\var{n}", "\var{p}")" returns a byte sequence
+(or string) value of length \var{n} bytes.  The value is initialized from the
+\var{n} bytes starting at address \var{p}.
+\item
+"caml_copy_string("\var{s}")" returns a string or byte sequence value
+containing a copy of the null-terminated C string \var{s} (a "char *").
+\item
+"caml_copy_double("\var{d}")" returns a floating-point value initialized
+with the "double" \var{d}.
+\item
+"caml_copy_int32("\var{i}")", "caml_copy_int64("\var{i}")" and
+"caml_copy_nativeint("\var{i}")" return a value of OCaml type "int32",
+"int64" and "nativeint", respectively, initialized with the integer
+\var{i}.
+\item
+"caml_alloc_array("\var{f}", "\var{a}")" allocates an array of values, calling
+function \var{f} over each element of the input array \var{a} to transform it
+into a value. The array \var{a} is an array of pointers terminated by the
+null pointer. The function \var{f} receives each pointer as argument, and
+returns a value. The zero-tagged block returned by
+"alloc_array("\var{f}", "\var{a}")" is filled with the values returned by the
+successive calls to \var{f}.  (This function must not be used to build
+an array of floating-point numbers.)
+\item
+"caml_copy_string_array("\var{p}")" allocates an array of strings or byte
+sequences, copied from the pointer to a string array \var{p}
+(a "char **").  \var{p} must be NULL-terminated.
+\item "caml_alloc_float_array("\var{n}")" allocates an array of floating point
+  numbers of size \var{n}. The array initially contains uninitialized values.
+\item "caml_alloc_unboxed("\var{v}")" returns the value (of any unboxed
+type) whose field is the value \var{v}.
+\item "caml_alloc_boxed("\var{v}")" allocates and returns a value  (of
+any boxed type) whose field is the value \var{v}.
+\item "caml_alloc_unboxable("\var{v}")" calls either
+"caml_alloc_unboxed" or "caml_alloc_boxed" according to the default
+representation of unboxable types in the current version of OCaml.
+\end{itemize}
+
+\subsubsection{sss:c-low-level-alloc}{Low-level interface}
+
+The following functions are slightly more efficient than "caml_alloc", but
+also much more difficult to use.
+
+From the standpoint of the allocation functions, blocks are divided
+according to their size as zero-sized blocks, small blocks (with size
+less than or equal to \verb"Max_young_wosize"), and large blocks (with
+size greater than \verb"Max_young_wosize"). The constant
+\verb"Max_young_wosize" is declared in the include file "mlvalues.h". It
+is guaranteed to be at least 64 (words), so that any block with
+constant size less than or equal to 64 can be assumed to be small. For
+blocks whose size is computed at run-time, the size must be compared
+against \verb"Max_young_wosize" to determine the correct allocation procedure.
+
+\begin{itemize}
+\item
+"caml_alloc_small("\var{n}", "\var{t}")" returns a fresh small block of size
+$n \leq \hbox{"Max_young_wosize"}$ words, with tag \var{t}.
+If this block is a structured block (i.e. if $t < \hbox{"No_scan_tag"}$), then
+the fields of the block (initially containing garbage) must be initialized
+with legal values (using direct assignment to the fields of the block)
+before the next allocation.
+\item
+"caml_alloc_shr("\var{n}", "\var{t}")" returns a fresh block of size
+\var{n}, with tag \var{t}.
+The size of the block can be greater than \verb"Max_young_wosize". (It
+can also be smaller, but in this case it is more efficient to call
+"caml_alloc_small" instead of "caml_alloc_shr".)
+If this block is a structured block (i.e. if $t < \hbox{"No_scan_tag"}$), then
+the fields of the block (initially containing garbage) must be initialized
+with legal values (using the "caml_initialize" function described below)
+before the next allocation.
+\end{itemize}
+
+\subsection{ss:c-exceptions}{Raising exceptions}
+
+Two functions are provided to raise two standard exceptions:
+\begin{itemize}
+\item "caml_failwith("\var{s}")", where \var{s} is a null-terminated C string (with
+type \verb"char *"), raises exception "Failure" with argument \var{s}.
+\item "caml_invalid_argument("\var{s}")", where \var{s} is a null-terminated C
+string (with type \verb"char *"), raises exception "Invalid_argument"
+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
+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
+functions actually raise the exception:
+\begin{itemize}
+\item "caml_raise_constant("\var{id}")" raises the exception \var{id} with
+no argument;
+\item "caml_raise_with_arg("\var{id}", "\var{v}")" raises the exception
+\var{id} with the OCaml value \var{v} as argument;
+\item "caml_raise_with_args("\var{id}", "\var{n}", "\var{v}")"
+raises the exception \var{id} with the OCaml values
+\var{v}"[0]", \ldots, \var{v}"["\var{n}"-1]" as arguments;
+\item "caml_raise_with_string("\var{id}", "\var{s}")", where \var{s} is a
+null-terminated C string, raises the exception \var{id} with a copy of
+the C string \var{s} as argument.
+\end{itemize}
+
+\section{s:c-gc-harmony}{Living in harmony with the garbage collector}
+
+Unused blocks in the heap are automatically reclaimed by the garbage
+collector. This requires some cooperation from C code that
+manipulates heap-allocated blocks.
+
+\subsection{ss:c-simple-gc-harmony}{Simple interface}
+
+All the macros described in this section are declared in the
+"memory.h" header file.
+
+\begin{gcrule}
+A function that has parameters or local variables of type "value" must
+begin with a call to one of the "CAMLparam" macros and return with
+"CAMLreturn", "CAMLreturn0", or "CAMLreturnT". In particular, "CAMLlocal"
+and "CAMLxparam" can only be called \emph{after} "CAMLparam".
+\end{gcrule}
+
+There are six "CAMLparam" macros: "CAMLparam0" to "CAMLparam5", which
+take zero to five arguments respectively.  If your function has no more
+than 5 parameters of type "value", use the corresponding macros
+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").
+
+The macros "CAMLreturn", "CAMLreturn0", and "CAMLreturnT" are used to
+replace the C
+keyword "return".  Every occurrence of "return x" must be replaced by
+"CAMLreturn (x)" if "x" has type "value", or "CAMLreturnT (t, x)"
+(where "t" is the type of "x"); every occurrence of "return" without
+argument must be
+replaced by "CAMLreturn0".  If your C function is a procedure (i.e. if
+it returns void), you must insert "CAMLreturn0" at the end (to replace
+C's implicit "return").
+
+\paragraph{Note:} some C compilers give bogus warnings about unused
+variables "caml__dummy_xxx" at each use of "CAMLparam" and
+"CAMLlocal".  You should ignore them.
+
+\goodbreak
+
+Example:
+\begin{verbatim}
+void foo (value v1, value v2, value v3)
+{
+  CAMLparam3 (v1, v2, v3);
+  ...
+  CAMLreturn0;
+}
+\end{verbatim}
+
+\paragraph{Note:} if your function is a primitive with more than 5 arguments
+for use with the byte-code runtime, its arguments are not "value"s and
+must not be declared (they have types "value *" and "int").
+
+\begin{gcrule}
+Local variables of type "value" must be declared with one of the
+"CAMLlocal" macros.  Arrays of "value"s are declared with
+"CAMLlocalN".  These macros must be used at the beginning of the
+function, not in a nested block.
+\end{gcrule}
+
+The macros "CAMLlocal1" to "CAMLlocal5" declare and initialize one to
+five local variables of type "value".  The variable names are given as
+arguments to the macros.  "CAMLlocalN("\var{x}", "\var{n}")" declares
+and initializes a local variable of type "value ["\var{n}"]".  You can
+use several calls to these macros if you have more than 5 local
+variables.
+
+Example:
+\begin{verbatim}
+value bar (value v1, value v2, value v3)
+{
+  CAMLparam3 (v1, v2, v3);
+  CAMLlocal1 (result);
+  result = caml_alloc (3, 0);
+  ...
+  CAMLreturn (result);
+}
+\end{verbatim}
+
+\begin{gcrule}
+Assignments to the fields of structured blocks must be done with the
+"Store_field" macro (for normal blocks) or "Store_double_field" macro
+(for arrays and records of floating-point numbers).  Other assignments
+must not use "Store_field" nor "Store_double_field".
+\end{gcrule}
+
+"Store_field ("\var{b}", "\var{n}", "\var{v}")" stores the value
+\var{v} in the field number \var{n} of value \var{b}, which must be a
+block (i.e. "Is_block("\var{b}")" must be true).
+
+Example:
+\begin{verbatim}
+value bar (value v1, value v2, value v3)
+{
+  CAMLparam3 (v1, v2, v3);
+  CAMLlocal1 (result);
+  result = caml_alloc (3, 0);
+  Store_field (result, 0, v1);
+  Store_field (result, 1, v2);
+  Store_field (result, 2, v3);
+  CAMLreturn (result);
+}
+\end{verbatim}
+
+\paragraph{Warning:} The first argument of "Store_field" and
+"Store_double_field" must be a variable declared by "CAMLparam*" or
+a parameter declared by "CAMLlocal*" to ensure that a garbage
+collection triggered by the evaluation of the other arguments will not
+invalidate the first argument after it is computed.
+
+\paragraph{Use with CAMLlocalN:} Arrays of values declared using
+"CAMLlocalN" must not be written to using "Store_field".
+Use the normal C array syntax instead.
+
+\begin{gcrule} Global variables containing values must be registered
+with the garbage collector using the "caml_register_global_root" function,
+save that global variables and locations that will only ever contain OCaml
+integers (and never pointers) do not have to be registered.
+
+The same is true for any memory location outside the OCaml heap that contains a
+value and is not guaranteed to be reachable---for as long as it contains such
+value---from either another registered global variable or location, local
+variable declared with "CAMLlocal" or function parameter declared with
+"CAMLparam".
+\end{gcrule}
+
+Registration of a global variable "v" is achieved by calling
+"caml_register_global_root(&v)" just before or just after a valid value is
+stored in "v" for the first time; likewise, registration of an arbitrary
+location "p" is achieved by calling "caml_register_global_root(p)".
+
+You must not call any of the OCaml runtime functions or macros between
+registering and storing the value. Neither must you store anything in the
+variable "v" (likewise, the location "p") that is not a valid value.
+
+The registration causes the contents of the variable or memory location to be
+updated by the garbage collector whenever the value in such variable or location
+is moved within the OCaml heap. In the presence of threads care must be taken to
+ensure appropriate synchronisation with the OCaml runtime to avoid a race
+condition against the garbage collector when reading or writing the value. (See
+section
+\ref{ss:parallel-execution-long-running-c-code}.)
+
+A registered global variable "v" can be un-registered by calling
+"caml_remove_global_root(&v)".
+
+If the contents of the global variable "v" are seldom modified after
+registration, better performance can be achieved by calling
+"caml_register_generational_global_root(&v)" to register "v" (after
+its initialization with a valid "value", but before any allocation or
+call to the GC functions),
+and "caml_remove_generational_global_root(&v)" to un-register it. In
+this case, you must not modify the value of "v" directly, but you must
+use "caml_modify_generational_global_root(&v,x)" to set it to "x".
+The garbage collector takes advantage of the guarantee that "v" is not
+modified between calls to "caml_modify_generational_global_root" to scan it
+less often. This improves performance if the
+modifications of "v" happen less often than minor collections.
+
+\paragraph{Note:} The "CAML" macros use identifiers (local variables, type
+identifiers, structure tags) that start with "caml__".  Do not use any
+identifier starting with "caml__" in your programs.
+
+\subsection{ss:c-low-level-gc-harmony}{Low-level interface}
+
+% Il faudrait simplifier violemment ce qui suit.
+% En gros, dire quand on n'a pas besoin de declarer les variables
+% et dans quels cas on peut se passer de "Store_field".
+
+We now give the GC rules corresponding to the low-level allocation
+functions "caml_alloc_small" and "caml_alloc_shr".  You can ignore those rules
+if you stick to the simplified allocation function "caml_alloc".
+
+\begin{gcrule} After a structured block (a block with tag less than
+"No_scan_tag") is allocated with the low-level functions, all fields
+of this block must be filled with well-formed values before the next
+allocation operation. If the block has been allocated with
+"caml_alloc_small", filling is performed by direct assignment to the fields
+of the block:
+\begin{alltt}
+        Field(\var{v}, \var{n}) = \nth{v}{n};
+\end{alltt}
+If the block has been allocated with "caml_alloc_shr", filling is performed
+through the "caml_initialize" function:
+\begin{alltt}
+        caml_initialize(&Field(\var{v}, \var{n}), \nth{v}{n});
+\end{alltt}
+\end{gcrule}
+
+The next allocation can trigger a garbage collection. The garbage
+collector assumes that all structured blocks contain well-formed
+values. Newly created blocks contain random data, which generally do
+not represent well-formed values.
+
+If you really need to allocate before the fields can receive their
+final value,  first initialize with a constant value (e.g.
+"Val_unit"), then allocate, then modify the fields with the correct
+value (see rule~6).
+
+%% \begin{gcrule} Local variables and function parameters containing
+%% values must be registered with the garbage collector (using the
+%% "Begin_roots" and "End_roots" macros), if they are to survive a call
+%% to an allocation function.
+%% \end{gcrule}
+%%
+%% Registration is performed with the "Begin_roots" set of macros.
+%% "Begin_roots1("\var{v}")" registers variable \var{v} with the garbage
+%% collector.  Generally, \var{v} will be a local variable or a
+%% parameter of your function.  It must be initialized to a valid value
+%% (e.g. "Val_unit") before the first allocation.  Likewise,
+%% "Begin_roots2", \ldots, "Begin_roots5"
+%% let you register up to 5 variables at the same time.  "Begin_root" is
+%% the same as "Begin_roots1".  "Begin_roots_block("\var{ptr}","\var{size}")"
+%% allows you to register an array of roots.  \var{ptr} is a pointer to
+%% the first element, and \var{size} is the number of elements in the
+%% array.
+%%
+%% Once registered, each of your variables (or array element) has the
+%% following properties: if it points to a heap-allocated block, this
+%% block (and its contents) will not be reclaimed; moreover, if this
+%% block is relocated by the garbage collector, the variable is updated
+%% to point to the new location for the block.
+%%
+%% Each of the "Begin_roots" macros open a C block that must be closed
+%% with a matching "End_roots" at the same nesting level.  The block must
+%% be exited normally (i.e. not with "return" or "goto").  However, the
+%% roots are automatically un-registered if an OCaml exception is raised,
+%% so you can exit the block with "failwith", "invalid_argument", or one
+%% of the "raise" functions.
+%%
+%% {\bf Note:} The "Begin_roots" macros use a local variable and a
+%% structure tag named "caml__roots_block".  Do not use this identifier
+%% in your programs.
+
+\begin{gcrule} Direct assignment to a field of a block, as in
+\begin{alltt}
+        Field(\var{v}, \var{n}) = \var{w};
+\end{alltt}
+is safe only if \var{v} is a block newly allocated by "caml_alloc_small";
+that is, if no allocation took place between the
+allocation of \var{v} and the assignment to the field. In all other cases,
+never assign directly. If the block has just been allocated by "caml_alloc_shr",
+use "caml_initialize" to assign a value to a field for the first time:
+\begin{alltt}
+        caml_initialize(&Field(\var{v}, \var{n}), \var{w});
+\end{alltt}
+Otherwise, you are updating a field that previously contained a
+well-formed value; then, call the "caml_modify" function:
+\begin{alltt}
+        caml_modify(&Field(\var{v}, \var{n}), \var{w});
+\end{alltt}
+\end{gcrule}
+
+To illustrate the rules above, here is a C function that builds and
+returns a list containing the two integers given as parameters.
+First, we write it using the simplified allocation functions:
+\begin{verbatim}
+value alloc_list_int(int i1, int i2)
+{
+  CAMLparam0 ();
+  CAMLlocal2 (result, r);
+
+  r = caml_alloc(2, 0);                   /* Allocate a cons cell */
+  Store_field(r, 0, Val_int(i2));         /* car = the integer i2 */
+  Store_field(r, 1, Val_int(0));          /* cdr = the empty list [] */
+  result = caml_alloc(2, 0);              /* Allocate the other cons cell */
+  Store_field(result, 0, Val_int(i1));    /* car = the integer i1 */
+  Store_field(result, 1, r);              /* cdr = the first cons cell */
+  CAMLreturn (result);
+}
+\end{verbatim}
+Here, the registering of "result" is not strictly needed, because no
+allocation takes place after it gets its value, but it's easier and
+safer to simply register all the local variables that have type "value".
+
+Here is the same function written using the low-level allocation
+functions.  We notice that the cons cells are small blocks and can be
+allocated with "caml_alloc_small", and filled by direct assignments on
+their fields.
+\begin{verbatim}
+value alloc_list_int(int i1, int i2)
+{
+  CAMLparam0 ();
+  CAMLlocal2 (result, r);
+
+  r = caml_alloc_small(2, 0);             /* Allocate a cons cell */
+  Field(r, 0) = Val_int(i2);              /* car = the integer i2 */
+  Field(r, 1) = Val_int(0);               /* cdr = the empty list [] */
+  result = caml_alloc_small(2, 0);        /* Allocate the other cons cell */
+  Field(result, 0) = Val_int(i1);         /* car = the integer i1 */
+  Field(result, 1) = r;                   /* cdr = the first cons cell */
+  CAMLreturn (result);
+}
+\end{verbatim}
+In the two examples above, the list is built bottom-up. Here is an
+alternate way, that proceeds top-down. It is less efficient, but
+illustrates the use of "caml_modify".
+\begin{verbatim}
+value alloc_list_int(int i1, int i2)
+{
+  CAMLparam0 ();
+  CAMLlocal2 (tail, r);
+
+  r = caml_alloc_small(2, 0);             /* Allocate a cons cell */
+  Field(r, 0) = Val_int(i1);              /* car = the integer i1 */
+  Field(r, 1) = Val_int(0);               /* A dummy value
+  tail = caml_alloc_small(2, 0);          /* Allocate the other cons cell */
+  Field(tail, 0) = Val_int(i2);           /* car = the integer i2 */
+  Field(tail, 1) = Val_int(0);            /* cdr = the empty list [] */
+  caml_modify(&Field(r, 1), tail);        /* cdr of the result = tail */
+  CAMLreturn (r);
+}
+\end{verbatim}
+It would be incorrect to perform
+"Field(r, 1) = tail" directly, because the allocation of "tail"
+has taken place since "r" was allocated.
+
+
+\subsection{ss:c-process-pending-actions}{Pending actions and asynchronous exceptions}
+
+Since 4.10, allocation functions are guaranteed not to call any OCaml
+callbacks from C, including finalisers and signal handlers, and delay
+their execution instead.
+
+The function \verb"caml_process_pending_actions" from
+"" executes any pending signal handlers and
+finalisers, Memprof callbacks, and requested minor and major garbage
+collections. In particular, it can raise asynchronous exceptions. 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:
+
+\begin{verbatim}
+    CAMLlocal1(exn);
+    ...
+    exn = caml_process_pending_actions_exn();
+    if(Is_exception_result(exn)) {
+      exn = Extract_exception(exn);
+      ...cleanup...
+      caml_raise(exn);
+    }
+\end{verbatim}
+
+Correct use of exceptional return, in particular in the presence of
+garbage collection, is further detailed in Section~\ref{ss:c-callbacks}.
+
+\section{s:c-intf-example}{A complete example}
+
+This section outlines how the functions from the Unix "curses" library
+can be made available to OCaml programs. First of all, here is
+the interface "curses.ml" that declares the "curses" primitives and
+data types:
+\begin{verbatim}
+(* File curses.ml -- declaration of primitives and data types *)
+type window                   (* The type "window" remains abstract *)
+external initscr: unit -> window = "caml_curses_initscr"
+external endwin: unit -> unit = "caml_curses_endwin"
+external refresh: unit -> unit = "caml_curses_refresh"
+external wrefresh : window -> unit = "caml_curses_wrefresh"
+external newwin: int -> int -> int -> int -> window = "caml_curses_newwin"
+external addch: char -> unit = "caml_curses_addch"
+external mvwaddch: window -> int -> int -> char -> unit = "caml_curses_mvwaddch"
+external addstr: string -> unit = "caml_curses_addstr"
+external mvwaddstr: window -> int -> int -> string -> unit
+         = "caml_curses_mvwaddstr"
+(* lots more omitted *)
+\end{verbatim}
+To compile this interface:
+\begin{verbatim}
+        ocamlc -c curses.ml
+\end{verbatim}
+
+To implement these functions, we just have to provide the stub code;
+the core functions are already implemented in the "curses" library.
+The stub code file, "curses_stubs.c", looks like this:
+\begin{verbatim}
+/* File curses_stubs.c -- stub code for curses */
+#include 
+#define CAML_NAME_SPACE
+#include 
+#include 
+#include 
+#include 
+
+/* Encapsulation of opaque window handles (of type WINDOW *)
+   as OCaml custom blocks. */
+
+static struct custom_operations curses_window_ops = {
+  "fr.inria.caml.curses_windows",
+  custom_finalize_default,
+  custom_compare_default,
+  custom_hash_default,
+  custom_serialize_default,
+  custom_deserialize_default,
+  custom_compare_ext_default,
+  custom_fixed_length_default
+};
+
+/* Accessing the WINDOW * part of an OCaml custom block */
+#define Window_val(v) (*((WINDOW **) Data_custom_val(v)))
+
+/* Allocating an OCaml custom block to hold the given WINDOW * */
+static value alloc_window(WINDOW * w)
+{
+  value v = caml_alloc_custom(&curses_window_ops, sizeof(WINDOW *), 0, 1);
+  Window_val(v) = w;
+  return v;
+}
+
+value caml_curses_initscr(value unit)
+{
+  CAMLparam1 (unit);
+  CAMLreturn (alloc_window(initscr()));
+}
+
+value caml_curses_endwin(value unit)
+{
+  CAMLparam1 (unit);
+  endwin();
+  CAMLreturn (Val_unit);
+}
+
+value caml_curses_refresh(value unit)
+{
+  CAMLparam1 (unit);
+  refresh();
+  CAMLreturn (Val_unit);
+}
+
+value caml_curses_wrefresh(value win)
+{
+  CAMLparam1 (win);
+  wrefresh(Window_val(win));
+  CAMLreturn (Val_unit);
+}
+
+value caml_curses_newwin(value nlines, value ncols, value x0, value y0)
+{
+  CAMLparam4 (nlines, ncols, x0, y0);
+  CAMLreturn (alloc_window(newwin(Int_val(nlines), Int_val(ncols),
+                                  Int_val(x0), Int_val(y0))));
+}
+
+value caml_curses_addch(value c)
+{
+  CAMLparam1 (c);
+  addch(Int_val(c));            /* Characters are encoded like integers */
+  CAMLreturn (Val_unit);
+}
+
+value caml_curses_mvwaddch(value win, value x, value y, value c)
+{
+  CAMLparam4 (win, x, y, c);
+  mvwaddch(Window_val(win), Int_val(x), Int_val(y), Int_val(c));
+  CAMLreturn (Val_unit);
+}
+
+value caml_curses_addstr(value s)
+{
+  CAMLparam1 (s);
+  addstr(String_val(s));
+  CAMLreturn (Val_unit);
+}
+
+value caml_curses_mvwaddstr(value win, value x, value y, value s)
+{
+  CAMLparam4 (win, x, y, s);
+  mvwaddstr(Window_val(win), Int_val(x), Int_val(y), String_val(s));
+  CAMLreturn (Val_unit);
+}
+
+/* This goes on for pages. */
+\end{verbatim}
+
+The file "curses_stubs.c" can be compiled with:
+\begin{verbatim}
+        cc -c -I`ocamlc -where` curses_stubs.c
+\end{verbatim}
+or, even simpler,
+\begin{verbatim}
+        ocamlc -c curses_stubs.c
+\end{verbatim}
+(When passed a ".c" file, the "ocamlc" command simply calls the C
+compiler on that file, with the right "-I" option.)
+
+Now, here is a sample OCaml program "prog.ml" that uses the "curses"
+module:
+\begin{verbatim}
+(* File prog.ml -- main program using curses *)
+open Curses;;
+let main_window = initscr () in
+let small_window = newwin 10 5 20 10 in
+  mvwaddstr main_window 10 2 "Hello";
+  mvwaddstr small_window 4 3 "world";
+  refresh();
+  Unix.sleep 5;
+  endwin()
+\end{verbatim}
+To compile and link this program, run:
+\begin{verbatim}
+       ocamlc -custom -o prog unix.cma curses.cmo prog.ml curses_stubs.o -cclib -lcurses
+\end{verbatim}
+(On some machines, you may need to put
+"-cclib -lcurses -cclib -ltermcap" or "-cclib -ltermcap"
+instead of "-cclib -lcurses".)
+
+%% Note by Damien: when I launch the program, it only displays "Hello"
+%% and not "world". Why?
+
+\section{s:c-callback}{Advanced topic: callbacks from C to OCaml}
+
+So far, we have described how to call C functions from OCaml. In this
+section, we show how C functions can call OCaml functions, either as
+callbacks (OCaml calls C which calls OCaml), or with the main program
+written in C.
+
+\subsection{ss:c-callbacks}{Applying OCaml closures from C}
+
+C functions can apply OCaml function values (closures) to OCaml values.
+The following functions are provided to perform the applications:
+\begin{itemize}
+\item "caml_callback("\var{f, a}")" applies the functional value \var{f} to
+the value \var{a} and returns the value returned by~\var{f}.
+\item "caml_callback2("\var{f, a, b}")" applies the functional value \var{f}
+(which is assumed to be a curried OCaml function with two arguments) to
+\var{a} and \var{b}.
+\item "caml_callback3("\var{f, a, b, c}")" applies the functional value \var{f}
+(a curried OCaml function with three arguments) to \var{a}, \var{b} and \var{c}.
+\item "caml_callbackN("\var{f, n, args}")" applies the functional value \var{f}
+to the \var{n} arguments contained in the array of values \var{args}.
+\end{itemize}
+If the function \var{f} does not return, but raises an exception that
+escapes the scope of the application, then this exception is
+propagated to the next enclosing OCaml code, skipping over the C
+code. That is, if an OCaml function \var{f} calls a C function \var{g} that
+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.
+
+Example:
+\begin{verbatim}
+    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);
+    }
+\end{verbatim}
+
+\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
+be passed to the "callback" functions described above.  One way is to
+pass the OCaml function as an argument to a primitive function.  For
+example, if the OCaml code contains the declaration
+\begin{verbatim}
+    external apply : ('a -> 'b) -> 'a -> 'b = "caml_apply"
+\end{verbatim}
+the corresponding C stub can be written as follows:
+\begin{verbatim}
+    CAMLprim value caml_apply(value vf, value vx)
+    {
+      CAMLparam2(vf, vx);
+      CAMLlocal1(vy);
+      vy = caml_callback(vf, vx);
+      CAMLreturn(vy);
+    }
+\end{verbatim}
+
+Another possibility is to use the registration mechanism provided by
+OCaml.  This registration mechanism enables OCaml code to register
+OCaml functions under some global name, and C code to retrieve the
+corresponding closure by this global name.
+
+On the OCaml side, registration is performed by evaluating
+"Callback.register" \var{n} \var{v}. Here, \var{n} is the global name
+(an arbitrary string) and \var{v} the OCaml value. For instance:
+\begin{verbatim}
+    let f x = print_string "f is applied to "; print_int x; print_newline()
+    let _ = Callback.register "test function" f
+\end{verbatim}
+
+On the C side, a pointer to the value registered under name \var{n} is
+obtained by calling "caml_named_value("\var{n}")". The returned
+pointer must then be dereferenced to recover the actual OCaml value.
+If no value is registered under the name \var{n}, the null pointer is
+returned. For example, here is a C wrapper that calls the OCaml function "f"
+above:
+\begin{verbatim}
+    void call_caml_f(int arg)
+    {
+        caml_callback(*caml_named_value("test function"), Val_int(arg));
+    }
+\end{verbatim}
+
+The pointer returned by "caml_named_value" is constant and can safely
+be cached in a C variable to avoid repeated name lookups. The value
+pointed to cannot be changed from C. However, it might change during
+garbage collection, so must always be recomputed at the point of
+use. Here is a more efficient variant of "call_caml_f" above that
+calls "caml_named_value" only once:
+\begin{verbatim}
+    void call_caml_f(int arg)
+    {
+        static const value * closure_f = NULL;
+        if (closure_f == NULL) {
+            /* First time around, look up by name */
+            closure_f = caml_named_value("test function");
+        }
+        caml_callback(*closure_f, Val_int(arg));
+    }
+\end{verbatim}
+
+\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
+"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:
+\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
+"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
+example, here is a C function that raises the "Error" exception with
+the given argument:
+\begin{verbatim}
+    void raise_error(char * msg)
+    {
+        caml_raise_with_string(*caml_named_value("test exception"), msg);
+    }
+\end{verbatim}
+
+\subsection{ss:main-c}{Main program in C}
+
+In normal operation, a mixed OCaml/C program starts by executing the
+OCaml initialization code, which then may proceed to call C
+functions. We say that the main program is the OCaml code. In some
+applications, it is desirable that the C code plays the role of the
+main program, calling OCaml functions when needed. This can be achieved as
+follows:
+\begin{itemize}
+\item The C part of the program must provide a "main" function,
+which will override the default "main" function provided by the OCaml
+runtime system. Execution will start in the user-defined "main" function
+just like for a regular C program.
+
+\item At some point, the C code must call "caml_main(argv)" to
+initialize the OCaml code. The "argv" argument is a C array of strings
+(type "char **"), terminated with a "NULL" pointer,
+which represents the command-line arguments, as
+passed as second argument to "main". The OCaml array "Sys.argv" will
+be initialized from this parameter. For the bytecode compiler,
+"argv[0]" and "argv[1]" are also consulted to find the file containing
+the bytecode.
+
+\item The call to "caml_main" initializes the OCaml runtime system,
+loads the bytecode (in the case of the bytecode compiler), and
+executes the initialization code of the OCaml program. Typically, this
+initialization code registers callback functions using "Callback.register".
+Once the OCaml initialization code is complete, control returns to the
+C code that called "caml_main".
+
+\item The C code can then invoke OCaml functions using the callback
+mechanism (see section~\ref{ss:c-callbacks}).
+\end{itemize}
+
+\subsection{ss:c-embedded-code}{Embedding the OCaml code in the C code}
+
+The bytecode compiler in custom runtime mode ("ocamlc -custom")
+normally appends the bytecode to the executable file containing the
+custom runtime. This has two consequences. First, the final linking
+step must be performed by "ocamlc". Second, the OCaml runtime library
+must be able to find the name of the executable file from the
+command-line arguments. When using "caml_main(argv)" as in
+section~\ref{ss:main-c}, this means that "argv[0]" or "argv[1]" must
+contain the executable file name.
+
+An alternative is to embed the bytecode in the C code. The
+"-output-obj" option to "ocamlc" is provided for this purpose.  It
+causes the "ocamlc" compiler to output a C object file (".o" file,
+".obj" under Windows) containing the bytecode for the OCaml part of the
+program, as well as a "caml_startup" function. The C object file
+produced by "ocamlc -output-obj" can then be linked with C code using
+the standard C compiler, or stored in a C library.
+
+The "caml_startup" function must be called from the main C program in
+order to initialize the OCaml runtime and execute the OCaml
+initialization code. Just like "caml_main", it takes one "argv"
+parameter containing the command-line parameters. Unlike "caml_main",
+this "argv" parameter is used only to initialize "Sys.argv", but not
+for finding the name of the executable file.
+
+The "caml_startup" function calls the uncaught exception handler (or
+enters the debugger, if running under ocamldebug) if an exception escapes
+from a top-level module initialiser.  Such exceptions may be caught in the
+C code by instead using the "caml_startup_exn" function and testing the result
+using {\tt Is_exception_result} (followed by {\tt Extract_exception} if
+appropriate).
+
+The "-output-obj" option can also be used to obtain the C source file.
+More interestingly, the same option can also produce directly a shared
+library (".so" file, ".dll" under Windows) that contains the OCaml
+code, the OCaml runtime system and any other static C code given to
+"ocamlc" (".o", ".a", respectively, ".obj", ".lib"). This use of
+"-output-obj" is very similar to a normal linking step, but instead of
+producing a main program that automatically runs the OCaml code, it
+produces a shared library that can run the OCaml code on demand. The
+three possible behaviors of "-output-obj" are selected according
+to the extension of the resulting file (given with "-o").
+
+The native-code compiler "ocamlopt" also supports the "-output-obj"
+option, causing it to output a C object file or a shared library
+containing the native code for all OCaml modules on the command-line,
+as well as the OCaml startup code. Initialization is performed by
+calling "caml_startup" (or "caml_startup_exn") as in the case of the
+bytecode compiler.
+
+For the final linking phase, in addition to the object file produced
+by "-output-obj", you will have to provide the OCaml runtime
+library ("libcamlrun.a" for bytecode, "libasmrun.a" for native-code),
+as well as all C libraries that are required by the OCaml libraries
+used.  For instance, assume the OCaml part of your program uses the
+Unix library.  With "ocamlc", you should do:
+\begin{alltt}
+        ocamlc -output-obj -o camlcode.o unix.cma {\it{other}} .cmo {\it{and}} .cma {\it{files}}
+        cc -o myprog {\it{C objects and libraries}} \char92
+           camlcode.o -L`ocamlc -where` -lunix -lcamlrun
+\end{alltt}
+With "ocamlopt", you should do:
+\begin{alltt}
+        ocamlopt -output-obj -o camlcode.o unix.cmxa {\it{other}} .cmx {\it{and}} .cmxa {\it{files}}
+        cc -o myprog {\it{C objects and libraries}} \char92
+           camlcode.o -L`ocamlc -where` -lunix -lasmrun
+\end{alltt}
+
+% -- This seems completely wrong -- Damien
+% The shared libraries produced by "ocamlc -output-obj" or by "ocamlopt
+% -output-obj" already contains the OCaml runtime library as
+% well as all the needed C libraries.
+
+\paragraph{Warning:} On some ports, special options are required on the final
+linking phase that links together the object file produced by the
+"-output-obj" option and the remainder of the program.  Those options
+are shown in the configuration file "Makefile.config" generated during
+compilation of OCaml, as the variable "OC_LDFLAGS".
+\begin{itemize}
+\item Windows with the MSVC compiler: the object file produced by
+OCaml have been compiled with the "/MD" flag, and therefore
+all other object files linked with it should also be compiled with
+"/MD".
+\item other systems: you may have to add one or more of "-lcurses",
+"-lm", "-ldl", depending on your OS and C compiler.
+\end{itemize}
+
+\paragraph{Stack backtraces.}  When OCaml bytecode produced by
+"ocamlc -g" is embedded in a C program, no debugging information is
+included, and therefore it is impossible to print stack backtraces on
+uncaught exceptions.  This is not the case when native code produced
+by "ocamlopt -g" is embedded in a C program: stack backtrace
+information is available, but the backtrace mechanism needs to be
+turned on programmatically.   This can be achieved from the OCaml side
+by calling "Printexc.record_backtrace true" in the initialization of
+one of the OCaml modules.  This can also be achieved from the C side
+by calling "caml_record_backtrace(Val_int(1));" in the OCaml-C glue code.
+
+\paragraph{Unloading the runtime.}
+
+In case the shared library produced with "-output-obj" is to be loaded and
+unloaded repeatedly by a single process, care must be taken to unload the
+OCaml runtime explicitly, in order to avoid various system resource leaks.
+
+Since 4.05, "caml_shutdown" function can be used to shut the runtime down
+gracefully, which equals the following:
+\begin{itemize}
+\item Running the functions that were registered with "Stdlib.at_exit".
+\item Triggering finalization of allocated custom blocks (see
+section~\ref{s:c-custom}). For example, "Stdlib.in_channel" and
+"Stdlib.out_channel" are represented by custom blocks that enclose file
+descriptors, which are to be released.
+\item Unloading the dependent shared libraries that were loaded by the runtime,
+including "dynlink" plugins.
+\item Freeing the memory blocks that were allocated by the runtime with
+"malloc". Inside C primitives, it is advised to use "caml_stat_*" functions
+from "memory.h" for managing static (that is, non-moving) blocks of heap
+memory, as all the blocks allocated with these functions are automatically
+freed by "caml_shutdown". For ensuring compatibility with legacy C stubs that
+have used "caml_stat_*" incorrectly, this behaviour is only enabled if the
+runtime is started with a specialized "caml_startup_pooled" function.
+\end{itemize}
+
+As a shared library may have several clients simultaneously, it is made for
+convenience that "caml_startup" (and "caml_startup_pooled") may be called
+multiple times, given that each such call is paired with a corresponding call
+to "caml_shutdown" (in a nested fashion). The runtime will be unloaded once
+there are no outstanding calls to "caml_startup".
+
+Once a runtime is unloaded, it cannot be started up again without reloading the
+shared library and reinitializing its static data. Therefore, at the moment, the
+facility is only useful for building reloadable shared libraries.
+
+
+\section{s:c-advexample}{Advanced example with callbacks}
+
+This section illustrates the callback facilities described in
+section~\ref{s:c-callback}. We are going to package some OCaml functions
+in such a way that they can be linked with C code and called from C
+just like any C functions. The OCaml functions are defined in the
+following "mod.ml" OCaml source:
+
+\begin{verbatim}
+(* File mod.ml -- some "useful" OCaml functions *)
+
+let rec fib n = if n < 2 then 1 else fib(n-1) + fib(n-2)
+
+let format_result n = Printf.sprintf "Result is: %d\n" n
+
+(* Export those two functions to C *)
+
+let _ = Callback.register "fib" fib
+let _ = Callback.register "format_result" format_result
+\end{verbatim}
+
+Here is the C stub code for calling these functions from C:
+
+\begin{verbatim}
+/* File modwrap.c -- wrappers around the OCaml functions */
+
+#include 
+#include 
+#include 
+#include 
+
+int fib(int n)
+{
+  static const value * fib_closure = NULL;
+  if (fib_closure == NULL) fib_closure = caml_named_value("fib");
+  return Int_val(caml_callback(*fib_closure, Val_int(n)));
+}
+
+char * format_result(int n)
+{
+  static const value * format_result_closure = NULL;
+  if (format_result_closure == NULL)
+    format_result_closure = caml_named_value("format_result");
+  return strdup(String_val(caml_callback(*format_result_closure, Val_int(n))));
+  /* We copy the C string returned by String_val to the C heap
+     so that it remains valid after garbage collection. */
+}
+\end{verbatim}
+
+We now compile the OCaml code to a C object file and put it in a C
+library along with the stub code in "modwrap.c" and the OCaml runtime system:
+\begin{verbatim}
+        ocamlc -custom -output-obj -o modcaml.o mod.ml
+        ocamlc -c modwrap.c
+        cp `ocamlc -where`/libcamlrun.a mod.a && chmod +w mod.a
+        ar r mod.a modcaml.o modwrap.o
+\end{verbatim}
+(One can also use "ocamlopt -output-obj" instead of "ocamlc -custom
+-output-obj".  In this case, replace "libcamlrun.a" (the bytecode
+runtime library) by "libasmrun.a" (the native-code runtime library).)
+
+Now, we can use the two functions "fib" and "format_result" in any C
+program, just like regular C functions. Just remember to call
+"caml_startup" (or "caml_startup_exn") once before.
+
+\begin{verbatim}
+/* File main.c -- a sample client for the OCaml functions */
+
+#include 
+#include 
+
+extern int fib(int n);
+extern char * format_result(int n);
+
+int main(int argc, char ** argv)
+{
+  int result;
+
+  /* Initialize OCaml code */
+  caml_startup(argv);
+  /* Do some computation */
+  result = fib(10);
+  printf("fib(10) = %s\n", format_result(result));
+  return 0;
+}
+\end{verbatim}
+
+To build the whole program, just invoke the C compiler as follows:
+\begin{verbatim}
+        cc -o prog -I `ocamlc -where` main.c mod.a -lcurses
+\end{verbatim}
+(On some machines, you may need to put "-ltermcap" or
+"-lcurses -ltermcap" instead of "-lcurses".)
+
+\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.
+
+\subsection{ss:c-custom-ops}{The "struct custom_operations"}
+
+The "struct custom_operations" is defined in "" and
+contains the following fields:
+\begin{itemize}
+\item "char *identifier" \\
+A zero-terminated character string serving as an identifier for
+serialization and deserialization operations.
+
+\item "void  (*finalize)(value v)" \\
+The "finalize" field contains a pointer to a C function that is called
+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.
+
+\item "int (*compare)(value v1, value v2)" \\
+The "compare" field contains a pointer to a C function that is
+called whenever two custom blocks are compared using OCaml's generic
+comparison operators ("=", "<>", "<=", ">=", "<", ">" and
+"compare").  The C function should return 0 if the data contained in
+the two blocks are structurally equal, a negative integer if the data
+from the first block is less than the data from the second block, and
+a positive integer if the data from the first block is greater than
+the data from the second block.
+
+The "compare" field can be set to "custom_compare_default"; this
+default comparison function simply raises "Failure".
+
+\item "int (*compare_ext)(value v1, value v2)" \\
+(Since 3.12.1)
+The "compare_ext" field contains a pointer to a C function that is
+called whenever one custom block and one unboxed integer are compared using OCaml's generic
+comparison operators ("=", "<>", "<=", ">=", "<", ">" and
+"compare").  As in the case of the "compare" field, the C function
+should return 0 if the two arguments are structurally equal, a
+negative integer if the first argument compares less than the second
+argument, and a positive integer if the first argument compares
+greater than the second argument.
+
+The "compare_ext" field can be set to "custom_compare_ext_default"; this
+default comparison function simply raises "Failure".
+
+\item "intnat (*hash)(value v)" \\
+The "hash" field contains a pointer to a C function that is called
+whenever OCaml's generic hash operator (see module \stdmoduleref{Hashtbl}) is
+applied to a custom block.  The C function can return an arbitrary
+integer representing the hash value of the data contained in the
+given custom block.  The hash value must be compatible with the
+"compare" function, in the sense that two structurally equal data
+(that is, two custom blocks for which "compare" returns 0) must have
+the same hash value.
+
+The "hash" field can be set to "custom_hash_default", in which case
+the custom block is ignored during hash computation.
+
+\item "void (*serialize)(value v, uintnat * bsize_32, uintnat * bsize_64)" \\
+The "serialize" field contains a pointer to a C function that is
+called whenever the custom block needs to be serialized (marshaled)
+using the OCaml functions "output_value" or "Marshal.to_...".
+For a custom block, those functions first write the identifier of the
+block (as given by the "identifier" field) to the output stream,
+then call the user-provided "serialize" function.  That function is
+responsible for writing the data contained in the custom block, using
+the "serialize_..." functions defined in "" and listed
+below.  The user-provided "serialize" function must then store in its
+"bsize_32" and "bsize_64" parameters the sizes in bytes of the data
+part of the custom block on a 32-bit architecture and on a 64-bit
+architecture, respectively.
+
+The "serialize" field can be set to "custom_serialize_default",
+in which case the "Failure" exception is raised when attempting to
+serialize the custom block.
+
+\item "uintnat (*deserialize)(void * dst)" \\
+The "deserialize" field contains a pointer to a C function that is
+called whenever a custom block with identifier "identifier" needs to
+be deserialized (un-marshaled) using the OCaml functions "input_value"
+or "Marshal.from_...".  This user-provided function is responsible for
+reading back the data written by the "serialize" operation, using the
+"deserialize_..." functions defined in "" and listed
+below. 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 64 bits.
+
+The "deserialize" field can be set to "custom_deserialize_default"
+to indicate that deserialization is not supported.  In this case,
+do not register the "struct custom_operations" with the deserializer
+using "register_custom_operations" (see below).
+
+\item "const struct custom_fixed_length* fixed_length" \\
+(Since 4.08.0)
+Normally, space in the serialized output is reserved to write the
+"bsize_32" and "bsize_64" fields returned by "serialize". However, for
+very short custom blocks, this space can be larger than the data
+itself! As a space optimisation, if "serialize" always returns the
+same values for "bsize_32" and "bsize_64", then these values may be
+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"
+functions attached to custom block descriptors must never trigger a
+garbage collection.  Within these functions, do not call any of the
+OCaml allocation functions, and do not perform a callback into OCaml
+code.  Do not use "CAMLparam" to register the parameters to these
+functions, and do not use "CAMLreturn" to return the result.
+
+\subsection{ss:c-custom-alloc}{Allocating custom blocks}
+
+Custom blocks must be allocated via "caml_alloc_custom" or
+"caml_alloc_custom_mem":
+\begin{center}
+"caml_alloc_custom("\var{ops}", "\var{size}", "\var{used}", "\var{max}")"
+\end{center}
+returns a fresh custom block, with room for \var{size} bytes of user
+data, and whose associated operations are given by \var{ops} (a
+pointer to a "struct custom_operations", usually statically allocated
+as a C global variable).
+
+The two parameters \var{used} and \var{max} are used to control the
+speed of garbage collection when the finalized object contains
+pointers to out-of-heap resources.  Generally speaking, the
+OCaml incremental major collector adjusts its speed relative to the
+allocation rate of the program.  The faster the program allocates, the
+harder the GC works in order to reclaim quickly unreachable blocks
+and avoid having large amount of ``floating garbage'' (unreferenced
+objects that the GC has not yet collected).
+
+Normally, the allocation rate is measured by counting the in-heap size
+of allocated blocks.  However, it often happens that finalized
+objects contain pointers to out-of-heap memory blocks and other resources
+(such as file descriptors, X Windows bitmaps, etc.).  For those
+blocks, the in-heap size of blocks is not a good measure of the
+quantity of resources allocated by the program.
+
+The two arguments \var{used} and \var{max} give the GC an idea of how
+much out-of-heap resources are consumed by the finalized block
+being allocated: you give the amount of resources allocated to this
+object as parameter \var{used}, and the maximum amount that you want
+to see in floating garbage as parameter \var{max}.  The units are
+arbitrary: the GC cares only about the ratio $\var{used} / \var{max}$.
+
+For instance, if you are allocating a finalized block holding an X
+Windows bitmap of \var{w} by \var{h} pixels, and you'd rather not
+have more than 1 mega-pixels of unreclaimed bitmaps, specify
+$\var{used} = \var{w} * \var{h}$ and $\var{max} = 1000000$.
+
+Another way to describe the effect of the \var{used} and \var{max}
+parameters is in terms of full GC cycles.  If you allocate many custom
+blocks with $\var{used} / \var{max} = 1 / \var{N}$, the GC will then do one
+full cycle (examining every object in the heap and calling
+finalization functions on those that are unreachable) every \var{N}
+allocations.  For instance, if $\var{used} = 1$ and $\var{max} = 1000$,
+the GC will do one full cycle at least every 1000 allocations of
+custom blocks.
+
+If your finalized blocks contain no pointers to out-of-heap resources,
+or if the previous discussion made little sense to you, just take
+$\var{used} = 0$ and $\var{max} = 1$.  But if you later find that the
+finalization functions are not called ``often enough'', consider
+increasing the $\var{used} / \var{max}$ ratio.
+
+\begin{center}
+"caml_alloc_custom_mem("\var{ops}", "\var{size}", "\var{used}")"
+\end{center}
+Use this function when your custom block holds only out-of-heap memory
+(memory allocated with "malloc" or "caml_stat_alloc") and no other
+resources. "used" should be the number of bytes of out-of-heap
+memory that are held by your custom block. This function works like
+"caml_alloc_custom" except that the "max" parameter is under the
+control of the user (via the "custom_major_ratio",
+"custom_minor_ratio", and "custom_minor_max_size" parameters) and
+proportional to the heap sizes.
+
+\subsection{ss:c-custom-access}{Accessing custom blocks}
+
+The data part of a custom block \var{v} can be
+accessed via the pointer "Data_custom_val("\var{v}")".  This pointer
+has type "void *" and should be cast to the actual type of the data
+stored in the custom block.
+
+The contents of custom blocks are not scanned by the garbage
+collector, and must therefore not contain any pointer inside the OCaml
+heap.  In other terms, never store an OCaml "value" in a custom block,
+and do not use "Field", "Store_field" nor "caml_modify" to access the data
+part of a custom block.  Conversely, any C data structure (not
+containing heap pointers) can be stored in a custom block.
+
+\subsection{ss:c-custom-serialization}{Writing custom serialization and deserialization functions}
+
+The following functions, defined in "", are provided to
+write and read back the contents of custom blocks in a portable way.
+Those functions handle endianness conversions when e.g. data is
+written on a little-endian machine and read back on a big-endian machine.
+
+\begin{tableau}{|l|p{10cm}|}{Function}{Action}
+\entree{"caml_serialize_int_1"}{Write a 1-byte integer}
+\entree{"caml_serialize_int_2"}{Write a 2-byte integer}
+\entree{"caml_serialize_int_4"}{Write a 4-byte integer}
+\entree{"caml_serialize_int_8"}{Write a 8-byte integer}
+\entree{"caml_serialize_float_4"}{Write a 4-byte float}
+\entree{"caml_serialize_float_8"}{Write a 8-byte float}
+\entree{"caml_serialize_block_1"}{Write an array of 1-byte quantities}
+\entree{"caml_serialize_block_2"}{Write an array of 2-byte quantities}
+\entree{"caml_serialize_block_4"}{Write an array of 4-byte quantities}
+\entree{"caml_serialize_block_8"}{Write an array of 8-byte quantities}
+\entree{"caml_deserialize_uint_1"}{Read an unsigned 1-byte integer}
+\entree{"caml_deserialize_sint_1"}{Read a signed 1-byte integer}
+\entree{"caml_deserialize_uint_2"}{Read an unsigned 2-byte integer}
+\entree{"caml_deserialize_sint_2"}{Read a signed 2-byte integer}
+\entree{"caml_deserialize_uint_4"}{Read an unsigned 4-byte integer}
+\entree{"caml_deserialize_sint_4"}{Read a signed 4-byte integer}
+\entree{"caml_deserialize_uint_8"}{Read an unsigned 8-byte integer}
+\entree{"caml_deserialize_sint_8"}{Read a signed 8-byte integer}
+\entree{"caml_deserialize_float_4"}{Read a 4-byte float}
+\entree{"caml_deserialize_float_8"}{Read an 8-byte float}
+\entree{"caml_deserialize_block_1"}{Read an array of 1-byte quantities}
+\entree{"caml_deserialize_block_2"}{Read an array of 2-byte quantities}
+\entree{"caml_deserialize_block_4"}{Read an array of 4-byte quantities}
+\entree{"caml_deserialize_block_8"}{Read an array of 8-byte quantities}
+\entree{"caml_deserialize_error"}{Signal an error during deserialization;
+"input_value" or "Marshal.from_..." raise a "Failure" exception after
+cleaning up their internal data structures}
+\end{tableau}
+
+Serialization functions are attached to the custom blocks to which
+they apply.  Obviously, deserialization functions cannot be attached
+this way, since the custom block does not exist yet when
+deserialization begins!  Thus, the "struct custom_operations" that
+contain deserialization functions must be registered with the
+deserializer in advance, using the "register_custom_operations"
+function declared in "".  Deserialization proceeds by
+reading the identifier off the input stream, allocating a custom block
+of the size specified in the input stream, searching the registered
+"struct custom_operation" blocks for one with the same identifier, and
+calling its "deserialize" function to fill the data part of the custom block.
+
+\subsection{ss:c-custom-idents}{Choosing identifiers}
+
+Identifiers in "struct custom_operations" must be chosen carefully,
+since they must identify uniquely the data structure for serialization
+and deserialization operations.  In particular, consider including a
+version number in the identifier; this way, the format of the data can
+be changed later, yet backward-compatible deserialisation functions
+can be provided.
+
+Identifiers starting with "_" (an underscore character) are reserved
+for the OCaml runtime system; do not use them for your custom
+data.  We recommend to use a URL
+("http://mymachine.mydomain.com/mylibrary/version-number")
+or a Java-style package name
+("com.mydomain.mymachine.mylibrary.version-number")
+as identifiers, to minimize the risk of identifier collision.
+
+\subsection{ss:c-finalized}{Finalized blocks}
+
+Custom blocks generalize the finalized blocks that were present in
+OCaml prior to version 3.00.  For backward compatibility, the
+format of custom blocks is compatible with that of finalized blocks,
+and the "alloc_final" function is still available to allocate a custom
+block with a given finalization function, but default comparison,
+hashing and serialization functions.  "caml_alloc_final("\var{n}",
+"\var{f}", "\var{used}", "\var{max}")" returns a fresh custom block of
+size \var{n}+1 words, with finalization function \var{f}.  The first
+word is reserved for storing the custom operations; the other
+\var{n} words are available for your data.  The two parameters
+\var{used} and \var{max} are used to control the speed of garbage
+collection, as described for "caml_alloc_custom".
+
+\section{s:C-Bigarrays}{Advanced topic: Bigarrays and the OCaml-C interface}
+
+This section explains how C stub code that interfaces C or Fortran
+code with OCaml code can use Bigarrays.
+
+\subsection{ss:C-Bigarrays-include}{Include file}
+
+The include file "" must be included in the C stub
+file.  It declares the functions, constants and macros discussed
+below.
+
+\subsection{ss:C-Bigarrays-access}{Accessing an OCaml bigarray from C or Fortran}
+
+If \var{v} is a OCaml "value" representing a Bigarray, the expression
+"Caml_ba_data_val("\var{v}")" returns a pointer to the data part of the array.
+This pointer is of type "void *" and can be cast to the appropriate C
+type for the array (e.g. "double []", "char [][10]", etc).
+
+Various characteristics of the OCaml Bigarray can be consulted from C
+as follows:
+\begin{tableau}{|l|l|}{C expression}{Returns}
+\entree{"Caml_ba_array_val("\var{v}")->num_dims"}{number of dimensions}
+\entree{"Caml_ba_array_val("\var{v}")->dim["\var{i}"]"}{\var{i}-th dimension}
+\entree{"Caml_ba_array_val("\var{v}")->flags & BIGARRAY_KIND_MASK"}{kind of array elements}
+\end{tableau}
+The kind of array elements is one of the following constants:
+\begin{tableau}{|l|l|}{Constant}{Element kind}
+\entree{"CAML_BA_FLOAT32"}{32-bit single-precision floats}
+\entree{"CAML_BA_FLOAT64"}{64-bit double-precision floats}
+\entree{"CAML_BA_SINT8"}{8-bit signed integers}
+\entree{"CAML_BA_UINT8"}{8-bit unsigned integers}
+\entree{"CAML_BA_SINT16"}{16-bit signed integers}
+\entree{"CAML_BA_UINT16"}{16-bit unsigned integers}
+\entree{"CAML_BA_INT32"}{32-bit signed integers}
+\entree{"CAML_BA_INT64"}{64-bit signed integers}
+\entree{"CAML_BA_CAML_INT"}{31- or 63-bit signed integers}
+\entree{"CAML_BA_NATIVE_INT"}{32- or 64-bit (platform-native) integers}
+\end{tableau}
+%
+The following example shows the passing of a two-dimensional Bigarray
+to a C function and a Fortran function.
+\begin{verbatim}
+    extern void my_c_function(double * data, int dimx, int dimy);
+    extern void my_fortran_function_(double * data, int * dimx, int * dimy);
+
+    value caml_stub(value bigarray)
+    {
+      int dimx = Caml_ba_array_val(bigarray)->dim[0];
+      int dimy = Caml_ba_array_val(bigarray)->dim[1];
+      /* C passes scalar parameters by value */
+      my_c_function(Caml_ba_data_val(bigarray), dimx, dimy);
+      /* Fortran passes all parameters by reference */
+      my_fortran_function_(Caml_ba_data_val(bigarray), &dimx, &dimy);
+      return Val_unit;
+    }
+\end{verbatim}
+
+\subsection{ss:C-Bigarrays-wrap}{Wrapping a C or Fortran array as an OCaml Bigarray}
+
+A pointer \var{p} to an already-allocated C or Fortran array can be
+wrapped and returned to OCaml as a Bigarray using the "caml_ba_alloc"
+or "caml_ba_alloc_dims" functions.
+\begin{itemize}
+\item
+"caml_ba_alloc("\var{kind} "|" \var{layout}, \var{numdims}, \var{p}, \var{dims}")"
+
+Return an OCaml Bigarray wrapping the data pointed to by \var{p}.
+\var{kind} is the kind of array elements (one of the "CAML_BA_"
+kind constants above).  \var{layout} is "CAML_BA_C_LAYOUT" for an
+array with C layout and "CAML_BA_FORTRAN_LAYOUT" for an array with
+Fortran layout.  \var{numdims} is the number of dimensions in the
+array.  \var{dims} is an array of \var{numdims} long integers, giving
+the sizes of the array in each dimension.
+
+\item
+"caml_ba_alloc_dims("\var{kind} "|" \var{layout}, \var{numdims},
+\var{p}, "(long) "\nth{dim}{1}, "(long) "\nth{dim}{2}, \ldots, "(long) "\nth{dim}{numdims}")"
+
+Same as "caml_ba_alloc", but the sizes of the array in each dimension
+are listed as extra arguments in the function call, rather than being
+passed as an array.
+\end{itemize}
+%
+The following example illustrates how statically-allocated C and
+Fortran arrays can be made available to OCaml.
+\begin{verbatim}
+    extern long my_c_array[100][200];
+    extern float my_fortran_array_[300][400];
+
+    value caml_get_c_array(value unit)
+    {
+      long dims[2];
+      dims[0] = 100; dims[1] = 200;
+      return caml_ba_alloc(CAML_BA_NATIVE_INT | CAML_BA_C_LAYOUT,
+                           2, my_c_array, dims);
+    }
+
+    value caml_get_fortran_array(value unit)
+    {
+      return caml_ba_alloc_dims(CAML_BA_FLOAT32 | CAML_BA_FORTRAN_LAYOUT,
+                                2, my_fortran_array_, 300L, 400L);
+    }
+\end{verbatim}
+
+\section{s:C-cheaper-call}{Advanced topic: cheaper C call}
+
+This section describe how to make calling C functions cheaper.
+
+{\bf Note:} this only applies to the native compiler. So whenever you
+use any of these methods, you have to provide an alternative byte-code
+stub that ignores all the special annotations.
+
+\subsection{ss:c-unboxed}{Passing unboxed values}
+
+We said earlier that all OCaml objects are represented by the C type
+"value", and one has to use macros such as "Int_val" to decode data from
+the "value" type.  It is however possible to tell the OCaml native-code
+compiler to do this for us and pass arguments unboxed to the C function.
+Similarly it is possible to tell OCaml to expect the result unboxed and box
+it for us.
+
+The motivation is that, by letting `ocamlopt` deal with boxing, it can
+often decide to suppress it entirely.
+
+For instance let's consider this example:
+
+\begin{verbatim}
+external foo : float -> float -> float = "foo"
+
+let f a b =
+  let len = Array.length a in
+  assert (Array.length b = len);
+  let res = Array.make len 0. in
+  for i = 0 to len - 1 do
+    res.(i) <- foo a.(i) b.(i)
+  done
+\end{verbatim}
+
+Float arrays are unboxed in OCaml, however the C function "foo" expect
+its arguments as boxed floats and returns a boxed float. Hence the
+OCaml compiler has no choice but to box "a.(i)" and "b.(i)" and unbox
+the result of "foo".  This results in the allocation of "3 * len"
+temporary float values.
+
+Now if we annotate the arguments and result with "[\@unboxed]", the
+native-code compiler will be able to avoid all these allocations:
+
+\begin{verbatim}
+external foo
+  :  (float [@unboxed])
+  -> (float [@unboxed])
+  -> (float [@unboxed])
+  = "foo_byte" "foo"
+\end{verbatim}
+
+In this case the C functions must look like:
+
+\begin{verbatim}
+CAMLprim double foo(double a, double b)
+{
+  ...
+}
+
+CAMLprim value foo_byte(value a, value b)
+{
+  return caml_copy_double(foo(Double_val(a), Double_val(b)))
+}
+\end{verbatim}
+
+For convenicence, when all arguments and the result are annotated with
+"[\@unboxed]", it is possible to put the attribute only once on the
+declaration itself. So we can also write instead:
+
+\begin{verbatim}
+external foo : float -> float -> float = "foo_byte" "foo" [@@unboxed]
+\end{verbatim}
+
+The following table summarize what OCaml types can be unboxed, and
+what C types should be used in correspondence:
+
+\begin{tableau}{|l|l|}{OCaml type}{C type}
+\entree{"float"}{"double"}
+\entree{"int32"}{"int32_t"}
+\entree{"int64"}{"int64_t"}
+\entree{"nativeint"}{"intnat"}
+\end{tableau}
+
+Similarly, it is possible to pass untagged OCaml integers between
+OCaml and C. This is done by annotating the arguments and/or result
+with "[\@untagged]":
+
+\begin{verbatim}
+external f : string -> (int [@untagged]) = "f_byte" "f"
+\end{verbatim}
+
+The corresponding C type must be "intnat".
+
+{\bf Note:} do not use the C "int" type in correspondence with "(int
+[\@untagged])". This is because they often differ in size.
+
+\subsection{ss:c-direct-call}{Direct C call}
+
+In order to be able to run the garbage collector in the middle of
+a C function, the OCaml native-code compiler generates some bookkeeping
+code around C calls.  Technically it wraps every C call with the C function
+"caml_c_call" which is part of the OCaml runtime.
+
+For small functions that are called repeatedly, this indirection can have
+a big impact on performances.  However this is not needed if we know that
+the C function doesn't allocate, doesn't raise exceptions, and doesn't release
+the master lock (see section~\ref{ss:parallel-execution-long-running-c-code}).  
+We can instruct the OCaml native-code compiler of this fact by annotating the
+external declaration with the attribute "[\@\@noalloc]":
+
+\begin{verbatim}
+external bar : int -> int -> int = "foo" [@@noalloc]
+\end{verbatim}
+
+In this case calling "bar" from OCaml is as cheap as calling any other
+OCaml function, except for the fact that the OCaml compiler can't
+inline C functions...
+
+\subsection{ss:c-direct-call-example}{Example: calling C library functions without indirection}
+
+Using these attributes, it is possible to call C library functions
+with no indirection. For instance many math functions are defined this
+way in the OCaml standard library:
+
+\begin{verbatim}
+external sqrt : float -> float = "caml_sqrt_float" "sqrt"
+  [@@unboxed] [@@noalloc]
+(** Square root. *)
+
+external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc]
+(** Exponential. *)
+
+external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc]
+(** Natural logarithm. *)
+\end{verbatim}
+
+\section{s:C-multithreading}{Advanced topic: multithreading}
+
+Using multiple threads (shared-memory concurrency) in a mixed OCaml/C
+application requires special precautions, which are described in this
+section.
+
+\subsection{ss:c-thread-register}{Registering threads created from C}
+
+Callbacks from C to OCaml are possible only if the calling thread is
+known to the OCaml run-time system.  Threads created from OCaml (through
+the "Thread.create" function of the system threads library) are
+automatically known to the run-time system.  If the application
+creates additional threads from C and wishes to callback into OCaml
+code from these threads, it must first register them with the run-time
+system.  The following functions are declared in the include file
+"".
+
+\begin{itemize}
+\item
+"caml_c_thread_register()" registers the calling thread with the OCaml
+run-time system.  Returns 1 on success, 0 on error.  Registering an
+already-registered thread does nothing and returns 0.
+\item
+"caml_c_thread_unregister()"  must be called before the thread
+  terminates, to unregister it from the OCaml run-time system.
+Returns 1 on success, 0 on error.  If the calling thread was not
+previously registered, does nothing and returns 0.
+\end{itemize}
+
+\subsection{ss:parallel-execution-long-running-c-code}{Parallel execution of long-running C code}
+
+The OCaml run-time system is not reentrant: at any time, at most one
+thread can be executing OCaml code or C code that uses the OCaml
+run-time system.  Technically, this is enforced by a ``master lock''
+that any thread must hold while executing such code.
+
+When OCaml calls the C code implementing a primitive, the master lock
+is held, therefore the C code has full access to the facilities of the
+run-time system.  However, no other thread can execute OCaml code
+concurrently with the C code of the primitive.
+
+If a C primitive runs for a long time or performs potentially blocking
+input-output operations, it can explicitly release the master lock,
+enabling other OCaml threads to run concurrently with its operations.
+The C code must re-acquire the master lock before returning to OCaml.
+This is achieved with the following functions, declared in
+the include file "".
+
+\begin{itemize}
+\item
+"caml_release_runtime_system()"
+The calling thread releases the master lock and other OCaml resources,
+enabling other threads to run OCaml code in parallel with the execution
+of the calling thread.
+\item
+"caml_acquire_runtime_system()"
+The calling thread re-acquires the master lock and other OCaml
+resources.  It may block until no other thread uses the OCaml run-time
+system.
+\end{itemize}
+
+These functions poll for pending signals by calling asynchronous
+callbacks (section~\ref{ss:c-process-pending-actions}) before releasing and
+after acquiring the lock. They can therefore execute arbitrary OCaml
+code including raising an asynchronous exception.
+
+After "caml_release_runtime_system()" was called and until
+"caml_acquire_runtime_system()" is called, the C code must not access
+any OCaml data, nor call any function of the run-time system, nor call
+back into OCaml code.  Consequently, arguments provided by OCaml to the
+C primitive must be copied into C data structures before calling
+"caml_release_runtime_system()", and results to be returned to OCaml
+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.
+\begin{verbatim}
+CAMLprim stub_gethostbyname(value vname)
+{
+  CAMLparam1 (vname);
+  CAMLlocal1 (vres);
+  struct hostent * h;
+  char * name;
+
+  /* Copy the string argument to a C string, allocated outside the
+     OCaml heap. */
+  name = caml_stat_strdup(String_val(vname));
+  /* Release the OCaml run-time system */
+  caml_release_runtime_system();
+  /* Resolve the name */
+  h = gethostbyname(name);
+  /* 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);
+  /* Re-acquire the OCaml run-time system */
+  caml_acquire_runtime_system();
+  /* Encode the relevant fields of h as the OCaml value vres */
+  ... /* Omitted */
+  /* Return to OCaml */
+  CAMLreturn (vres);
+}
+\end{verbatim}
+
+Callbacks from C to OCaml must be performed while holding the master
+lock to the OCaml run-time system.  This is naturally the case if the
+callback is performed by a C primitive that did not release the
+run-time system.  If the C primitive released the run-time system
+previously, or the callback is performed from other C code that was
+not invoked from OCaml (e.g. an event loop in a GUI application), the
+run-time system must be acquired before the callback and released
+after:
+\begin{verbatim}
+  caml_acquire_runtime_system();
+  /* Resolve OCaml function vfun to be invoked */
+  /* Build OCaml argument varg to the callback */
+  vres = callback(vfun, varg);
+  /* Copy relevant parts of result vres to C data structures */
+  caml_release_runtime_system();
+\end{verbatim}
+
+Note: the "acquire" and "release" functions described above were
+introduced in OCaml 3.12.  Older code uses the following historical
+names, declared in "":
+\begin{itemize}
+\item "caml_enter_blocking_section" as an alias for
+  "caml_release_runtime_system"
+\item "caml_leave_blocking_section" as an alias for
+  "caml_acquire_runtime_system"
+\end{itemize}
+Intuition: a ``blocking section'' is a piece of C code that does not
+use the OCaml run-time system, typically a blocking input/output operation.
+
+\section{s:interfacing-windows-unicode-apis}{Advanced topic: interfacing with Windows Unicode APIs}
+
+This section contains some general guidelines for writing C stubs that use
+Windows Unicode APIs.
+
+{\bf Note:} This is an experimental feature of OCaml: the set of APIs below, as
+well as their exact semantics are not final and subject to change in future
+releases.
+
+The OCaml system under Windows can be configured at build time in one of two
+modes:
+
+\begin{itemize}
+
+\item {\bf legacy mode:} All path names, environment variables, command line
+arguments, etc. on the OCaml side are assumed to be encoded using the current
+8-bit code page of the system.
+
+\item {\bf Unicode mode:} All path names, environment variables, command line
+arguments, etc. on the OCaml side are assumed to be encoded using UTF-8.
+
+\end{itemize}
+
+In what follows, we say that a string has the \emph{OCaml encoding} if it is
+encoded in UTF-8 when in Unicode mode, in the current code page in legacy mode,
+or is an arbitrary string under Unix. A string has the \emph{platform encoding}
+if it is encoded in UTF-16 under Windows or is an arbitrary string under Unix.
+
+From the point of view of the writer of C stubs, the challenges of interacting
+with Windows Unicode APIs are twofold:
+
+\begin{itemize}
+
+\item The Windows API uses the UTF-16 encoding to support Unicode. The runtime
+system performs the necessary conversions so that the OCaml programmer only
+needs to deal with the OCaml encoding. C stubs that call Windows Unicode APIs
+need to use specific runtime functions to perform the necessary conversions in a
+compatible way.
+
+\item When writing stubs that need to be compiled under both Windows and Unix,
+the stubs need to be written in a way that allow the necessary conversions under
+Windows but that also work under Unix, where typically nothing particular needs
+to be done to support Unicode.
+
+\end{itemize}
+
+The native C character type under Windows is "WCHAR", two bytes wide, while
+under Unix it is "char", one byte wide. A type "char_os" is defined in
+"" that stands for the concrete C character type of each
+platform. Strings in the platform encoding are of type "char_os *".
+
+The following functions are exposed to help write compatible C stubs. To use
+them, you need to include both "" and "".
+
+\begin{itemize}
+
+\item "char_os* caml_stat_strdup_to_os(const char *)" copies the argument while
+translating from OCaml encoding to the platform encoding. This function is
+typically used to convert the "char *" underlying an OCaml string before passing
+it to an operating system API that takes a Unicode argument. Under Unix, it is
+equivalent to "caml_stat_strdup".
+
+{\bf Note:} For maximum backwards compatibility in Unicode mode, if the argument
+is not a valid UTF-8 string, this function will fall back to assuming that it is
+encoded in the current code page.
+
+\item "char* caml_stat_strdup_of_os(const char_os *)" copies the argument while
+translating from the platform encoding to the OCaml encoding. It is the inverse
+of "caml_stat_strdup_to_os". This function is typically used to convert a string
+obtained from the operating system before passing it on to OCaml code. Under
+Unix, it is equivalent to "caml_stat_strdup".
+
+\item "value caml_copy_string_of_os(char_os *)" allocates an OCaml string with
+contents equal to the argument string converted to the OCaml encoding.  This
+function is essentially equivalent to "caml_stat_strdup_of_os" followed by
+"caml_copy_string", except that it avoids the allocation of the intermediate
+string returned by "caml_stat_strdup_of_os". Under Unix, it is equivalent to
+"caml_copy_string".
+
+\end{itemize}
+
+{\bf Note:} The strings returned by "caml_stat_strdup_to_os" and
+"caml_stat_strdup_of_os" are allocated using "caml_stat_alloc", so they need to
+be deallocated using "caml_stat_free" when they are no longer needed.
+
+\paragraph{Example} We want to bind the function "getenv" in a way that works
+both under Unix and Windows.  Under Unix this function has the prototype:
+
+\begin{verbatim}
+    char *getenv(const char *);
+\end{verbatim}
+While the Unicode version under Windows has the prototype:
+\begin{verbatim}
+    WCHAR *_wgetenv(const WCHAR *);
+\end{verbatim}
+
+In terms of "char_os", both functions take an argument of type "char_os *" and
+return a result of the same type. We begin by choosing the right implementation
+of the function to bind:
+
+\begin{verbatim}
+#ifdef _WIN32
+#define getenv_os _wgetenv
+#else
+#define getenv_os getenv
+#endif
+\end{verbatim}
+
+The rest of the binding is the same for both platforms:
+
+\begin{verbatim}
+/* The following define is necessary because the API is experimental */
+#define CAML_NAME_SPACE
+#define CAML_INTERNALS
+
+#include 
+#include 
+#include 
+#include 
+#include 
+#include 
+
+CAMLprim value stub_getenv(value var_name)
+{
+  CAMLparam1(var_name);
+  CAMLlocal1(var_value);
+  char_os *var_name_os, *var_value_os;
+
+  var_name_os = caml_stat_strdup_to_os(String_val(var_name));
+  var_value_os = getenv_os(var_name_os);
+  caml_stat_free(var_name_os);
+
+  if (var_value_os == NULL)
+    caml_raise_not_found();
+
+  var_value = caml_copy_string_of_os(var_value_os);
+
+  CAMLreturn(var_value);
+}
+\end{verbatim}
+
+\section{s:ocamlmklib}{Building mixed C/OCaml libraries: \texttt{ocamlmklib}}
+
+The "ocamlmklib" command facilitates the construction of libraries
+containing both OCaml code and C code, and usable both in static
+linking and dynamic linking modes.  This command is available under
+Windows since Objective Caml 3.11 and under other operating systems since
+Objective Caml 3.03.
+
+The "ocamlmklib" command takes three kinds of arguments:
+\begin{itemize}
+\item OCaml source files and object files (".cmo", ".cmx", ".ml")
+comprising the OCaml part of the library;
+\item C object files (".o", ".a", respectively, ".obj", ".lib")
+  comprising the C part of the library;
+\item Support libraries for the C part ("-l"\var{lib}).
+\end{itemize}
+It generates the following outputs:
+\begin{itemize}
+\item An OCaml bytecode library ".cma" incorporating the ".cmo" and
+".ml" OCaml files given as arguments, and automatically referencing the
+C library generated with the C object files.
+\item An OCaml native-code library ".cmxa" incorporating the ".cmx" and
+".ml" OCaml files given as arguments, and automatically referencing the
+C library generated with the C object files.
+\item If dynamic linking is supported on the target platform, a
+".so" (respectively, ".dll") shared library built from the C object files given as arguments,
+and automatically referencing the support libraries.
+\item A C static library ".a"(respectively, ".lib") built from the C object files.
+\end{itemize}
+In addition, the following options are recognized:
+\begin{options}
+\item["-cclib", "-ccopt", "-I", "-linkall"]
+These options are passed as is to "ocamlc" or "ocamlopt".
+See the documentation of these commands.
+\item["-rpath", "-R", "-Wl,-rpath", "-Wl,-R"]
+These options are passed as is to the C compiler.  Refer to the
+documentation of the C compiler.
+\item["-custom"] Force the construction of a statically linked library
+only, even if dynamic linking is supported.
+\item["-failsafe"] Fall back to building a statically linked library
+if a problem occurs while building the shared library (e.g. some of
+the support libraries are not available as shared libraries).
+\item["-L"\var{dir}] Add \var{dir} to the search path for support
+libraries ("-l"\var{lib}).
+\item["-ocamlc" \var{cmd}] Use \var{cmd} instead of "ocamlc" to call
+the bytecode compiler.
+\item["-ocamlopt" \var{cmd}] Use \var{cmd} instead of "ocamlopt" to call
+the native-code compiler.
+\item["-o" \var{output}] Set the name of the generated OCaml library.
+"ocamlmklib" will generate \var{output}".cma" and/or \var{output}".cmxa".
+If not specified, defaults to "a".
+\item["-oc" \var{outputc}] Set the name of the generated C library.
+"ocamlmklib" will generate "lib"\var{outputc}".so" (if shared
+libraries are supported) and "lib"\var{outputc}".a".
+If not specified, defaults to the output name given with "-o".
+\end{options}
+
+\noindent
+On native Windows, the following environment variable is also consulted:
+
+\begin{options}
+\item["OCAML_FLEXLINK"]  Alternative executable to use instead of the
+configured value. Primarily used for bootstrapping.
+\end{options}
+
+\paragraph{Example} Consider an OCaml interface to the standard "libz"
+C library for reading and writing compressed files.  Assume this
+library resides in "/usr/local/zlib".  This interface is
+composed of an OCaml part "zip.cmo"/"zip.cmx" and a C part "zipstubs.o"
+containing the stub code around the "libz" entry points.  The
+following command builds the OCaml libraries "zip.cma" and "zip.cmxa",
+as well as the companion C libraries "dllzip.so" and "libzip.a":
+\begin{verbatim}
+ocamlmklib -o zip zip.cmo zip.cmx zipstubs.o -lz -L/usr/local/zlib
+\end{verbatim}
+If shared libraries are supported, this performs the following
+commands:
+\begin{verbatim}
+ocamlc -a -o zip.cma zip.cmo -dllib -lzip \
+        -cclib -lzip -cclib -lz -ccopt -L/usr/local/zlib
+ocamlopt -a -o zip.cmxa zip.cmx -cclib -lzip \
+        -cclib -lzip -cclib -lz -ccopt -L/usr/local/zlib
+gcc -shared -o dllzip.so zipstubs.o -lz -L/usr/local/zlib
+ar rc libzip.a zipstubs.o
+\end{verbatim}
+Note: This example is on a Unix system. The exact command lines
+may be different on other systems.
+
+If shared libraries are not supported, the following commands are
+performed instead:
+\begin{verbatim}
+ocamlc -a -custom -o zip.cma zip.cmo -cclib -lzip \
+        -cclib -lz -ccopt -L/usr/local/zlib
+ocamlopt -a -o zip.cmxa zip.cmx -lzip \
+        -cclib -lz -ccopt -L/usr/local/zlib
+ar rc libzip.a zipstubs.o
+\end{verbatim}
+Instead of building simultaneously the bytecode library, the
+native-code library and the C libraries, "ocamlmklib" can be called
+three times to build each separately.  Thus,
+\begin{verbatim}
+ocamlmklib -o zip zip.cmo -lz -L/usr/local/zlib
+\end{verbatim}
+builds the bytecode library "zip.cma", and
+\begin{verbatim}
+ocamlmklib -o zip zip.cmx -lz -L/usr/local/zlib
+\end{verbatim}
+builds the native-code library "zip.cmxa", and
+\begin{verbatim}
+ocamlmklib -o zip zipstubs.o -lz -L/usr/local/zlib
+\end{verbatim}
+builds the C libraries "dllzip.so" and "libzip.a".  Notice that the
+support libraries ("-lz") and the corresponding options
+("-L/usr/local/zlib") must be given on all three invocations of "ocamlmklib",
+because they are needed at different times depending on whether shared
+libraries are supported.
+
+
+\section{s:c-internal-guidelines}{Cautionary words: the internal runtime API}
+
+Not all header available in the "caml/" directory were described in previous
+sections. All those unmentioned headers are part of the internal runtime API,
+for which there is \emph{no} stability guarantee. If you really need access
+to this internal runtime API, this section provides some guidelines
+that may help you to write code that might not break on every new version
+of OCaml.
+\paragraph{Note} Programmers which come to rely on the internal API
+for a use-case which they find realistic and useful are encouraged to open
+a request for improvement on the bug tracker.
+
+\subsection{ss:c-internals}{Internal variables and CAML_INTERNALS}
+Since OCaml 4.04, it is possible to get access to every part of the internal
+runtime API by defining the "CAML_INTERNALS" macro before loading caml header files.
+If this macro is not defined, parts of the internal runtime API are hidden.
+
+If you are using internal C variables, do not redefine them by hand. You should
+import those variables by including the corresponding header files. The
+representation of those variables has already changed once in OCaml 4.10, and is
+still under evolution.
+If your code relies on such internal and brittle properties, it will be broken
+at some point in time.
+
+For instance, rather than redefining "caml_young_limit":
+\begin{verbatim}
+extern int caml_young_limit;
+\end{verbatim}
+which breaks in OCaml $\ge$ 4.10, you should include the "minor_gc" header:
+\begin{verbatim}
+#include 
+\end{verbatim}
+
+\subsection{ss:c-internal-macros}{OCaml version macros}
+Finally, if including the right headers is not enough, or if you need to support
+version older than OCaml 4.04, the header file "caml/version.h" should help
+you to define your own compatibility layer.
+This file provides few macros defining the current OCaml version.
+In particular, the "OCAML_VERSION" macro describes the current version,
+its format is "MmmPP".
+For example, if you need some specific handling for versions older than 4.10.0,
+you could write
+\begin{verbatim}
+#include 
+#if OCAML_VERSION >= 41000
+...
+#else
+...
+#endif
+\end{verbatim}
diff --git a/manual/manual/cmds/lexyacc.etex b/manual/manual/cmds/lexyacc.etex
new file mode 100644
index 00000000..ad6d41ba
--- /dev/null
+++ b/manual/manual/cmds/lexyacc.etex
@@ -0,0 +1,727 @@
+\chapter{Lexer and parser generators (ocamllex, ocamlyacc)}
+\label{c:ocamlyacc}
+%HEVEA\cutname{lexyacc.html}
+
+This chapter describes two program generators: "ocamllex", that
+produces a lexical analyzer from a set of regular expressions with
+associated semantic actions, and "ocamlyacc", that produces a parser
+from a grammar with associated semantic actions.
+
+These program generators are very close to the well-known "lex" and
+"yacc" commands that can be found in most C programming environments.
+This chapter assumes a working knowledge of "lex" and "yacc": while
+it describes the input syntax for "ocamllex" and "ocamlyacc" and the
+main differences with "lex" and "yacc", it does not explain the basics
+of writing a lexer or parser description in "lex" and "yacc". Readers
+unfamiliar with "lex" and "yacc" are referred to  ``Compilers:
+principles, techniques, and tools'' by Aho, Sethi and Ullman
+(Addison-Wesley, 1986), or ``Lex $\&$ Yacc'', by Levine, Mason and
+Brown (O'Reilly, 1992).
+
+\section{s:ocamllex-overview}{Overview of \texttt{ocamllex}}
+
+The "ocamllex" command produces a lexical analyzer from a set of regular
+expressions with attached semantic actions, in the style of
+"lex". Assuming the input file is \var{lexer}".mll", executing
+\begin{alltt}
+        ocamllex \var{lexer}.mll
+\end{alltt}
+produces OCaml code for a lexical analyzer in file \var{lexer}".ml".
+This file defines one lexing function per entry point in the lexer
+definition. These functions have the same names as the entry
+points. Lexing functions take as argument a lexer buffer, and return
+the semantic attribute of the corresponding entry point.
+
+Lexer buffers are an abstract data type implemented in the standard
+library module "Lexing". The functions "Lexing.from_channel",
+"Lexing.from_string" and "Lexing.from_function" create
+lexer buffers that read from an input channel, a character string, or
+any reading function, respectively. (See the description of module
+"Lexing" in chapter~\ref{c:stdlib}.)
+
+When used in conjunction with a parser generated by "ocamlyacc", the
+semantic actions compute a value belonging to the type "token" defined
+by the generated parsing module. (See the description of "ocamlyacc"
+below.)
+
+\subsection{ss:ocamllex-options}{Options}
+The following command-line options are recognized by "ocamllex".
+
+\begin{options}
+
+\item["-ml"]
+Output code that does not use OCaml's built-in automata
+interpreter. Instead, the automaton is encoded by OCaml functions.
+This option improves performance when using the native compiler, but
+decreases it when using the bytecode compiler.
+
+\item["-o" \var{output-file}]
+Specify the name of the output file produced by "ocamllex".
+The default is the input file name with its extension replaced by ".ml".
+
+\item["-q"]
+Quiet mode.  "ocamllex" normally outputs informational messages
+to standard output.  They are suppressed if option "-q" is used.
+
+\item["-v" or "-version"]
+Print version string and exit.
+
+\item["-vnum"]
+Print short version number and exit.
+
+\item["-help" or "--help"]
+Display a short usage summary and exit.
+%
+\end{options}
+
+\section{s:ocamllex-syntax}{Syntax of lexer definitions}
+
+The format of lexer definitions is as follows:
+\begin{alltt}
+\{ \var{header} \}
+let \var{ident} = \var{regexp} \ldots
+[refill \{ \var{refill-handler} \}]
+rule \var{entrypoint} [\nth{arg}{1}\ldots{} \nth{arg}{n}] =
+  parse \var{regexp} \{ \var{action} \}
+      | \ldots
+      | \var{regexp} \{ \var{action} \}
+and \var{entrypoint} [\nth{arg}{1}\ldots{} \nth{arg}{n}] =
+  parse \ldots
+and \ldots
+\{ \var{trailer} \}
+\end{alltt}
+Comments are delimited by "(*" and "*)", as in OCaml.
+The "parse" keyword, can be replaced by the "shortest" keyword, with
+the semantic consequences explained below.
+
+Refill handlers are a recent (optional) feature introduced in 4.02,
+documented below in subsection~\ref{ss:refill-handlers}.
+
+\subsection{ss:ocamllex-header-trailer}{Header and trailer}
+The {\it header} and {\it trailer} sections are arbitrary OCaml
+text enclosed in curly braces. Either or both can be omitted. If
+present, the header text is copied as is at the beginning of the
+output file and the trailer text at the end. Typically, the
+header section contains the "open" directives required
+by the actions, and possibly some auxiliary functions used in the
+actions.
+
+\subsection{ss:ocamllex-named-regexp}{Naming regular expressions}
+
+Between the header and the entry points, one can give names to
+frequently-occurring regular expressions.  This is written
+@"let" ident "=" regexp@.
+In regular expressions that follow this declaration, the identifier
+\var{ident} can be used as shorthand for \var{regexp}.
+
+\subsection{ss:ocamllex-entry-points}{Entry points}
+
+The names of the entry points must be valid identifiers for OCaml
+values (starting with a lowercase letter).
+Similarly, the arguments \texttt{\var{arg$_1$}\ldots{}
+\var{arg$_n$}} must be valid identifiers for OCaml.
+Each entry point becomes an
+OCaml function that takes $n+1$ arguments,
+the extra implicit last argument being of type "Lexing.lexbuf".
+Characters are read from the "Lexing.lexbuf" argument and matched
+against the regular expressions provided in the rule, until a prefix
+of the input matches one of the rule.  The corresponding action is
+then evaluated and returned as the result of the function.
+
+
+If several regular expressions match a prefix of the input, the
+``longest match'' rule applies: the regular expression that matches
+the longest prefix of the input is selected.  In case of tie, the
+regular expression that occurs earlier in the rule is selected.
+
+However, if lexer rules are introduced with the "shortest" keyword in
+place of the "parse" keyword, then the ``shortest match'' rule applies:
+the shortest prefix of the input is selected. In case of tie, the
+regular expression that occurs earlier in the rule is still selected.
+This feature is not intended for use in ordinary lexical analyzers, it
+may facilitate the use of "ocamllex" as a simple text processing tool.
+
+
+
+\subsection{ss:ocamllex-regexp}{Regular expressions}
+
+The regular expressions are in the style of "lex", with a more
+OCaml-like syntax.
+\begin{syntax}
+regexp:
+  \ldots
+\end{syntax}
+\begin{options}
+
+\item[@"'" regular-char || escape-sequence "'"@]
+A character constant, with the same syntax as OCaml character
+constants. Match the denoted character.
+
+\item["_"]
+(underscore) Match any character.
+
+\item[@"eof"@]
+Match the end of the lexer input.\\
+{\bf Note:} On some systems, with interactive input, an end-of-file
+may be followed by more characters.  However, "ocamllex" will not
+correctly handle regular expressions that contain "eof" followed by
+something else.
+
+\item[@'"' { string-character } '"'@]
+A string constant, with the same syntax as OCaml string
+constants. Match the corresponding sequence of characters.
+
+\item[@'[' character-set ']'@]
+Match any single character belonging to the given
+character set. Valid character sets are: single
+character constants @"'" @c@ "'"@; ranges of characters
+@"'" @c@_1 "'" "-" "'" @c@_2 "'"@ (all characters between $c_1$ and $c_2$,
+inclusive); and the union of two or more character sets, denoted by
+concatenation.
+
+\item[@'[' '^' character-set ']'@]
+Match any single character not belonging to the given character set.
+
+
+\item[@regexp_1 '#' regexp_2@]
+(difference of character sets)
+Regular expressions @regexp_1@ and @regexp_2@ must be character sets
+defined with @'['\ldots ']'@ (or a single character expression or
+underscore "_").
+Match the difference of the two specified character sets.
+
+
+\item[@regexp '*'@]
+(repetition) Match the concatenation of zero or more
+strings that match @regexp@.
+
+\item[@regexp '+'@]
+(strict repetition) Match the concatenation of one or more
+strings that match @regexp@.
+
+\item[@regexp '?'@]
+(option) Match the empty string, or a string matching @regexp@.
+
+\item[@regexp_1 '|' regexp_2@]
+(alternative) Match any string that matches @regexp_1@ or @regexp_2@
+
+\item[@regexp_1 regexp_2@]
+(concatenation) Match the concatenation of two strings, the first
+matching @regexp_1@, the second matching @regexp_2@.
+
+\item[@'(' regexp ')'@]
+Match the same strings as @regexp@.
+
+\item[@ident@]
+Reference the regular expression bound to @ident@ by an earlier
+@"let" ident "=" regexp@ definition.
+
+\item[@regexp 'as' ident@]
+Bind the substring matched by @regexp@ to identifier @ident@.
+\end{options}
+
+Concerning the precedences of operators, "#" has the highest precedence,
+followed by "*", "+"  and "?",
+then concatenation, then "|" (alternation), then "as".
+
+\subsection{ss:ocamllex-actions}{Actions}
+
+The actions are arbitrary OCaml expressions. They are evaluated in
+a context where the identifiers defined by using the "as" construct
+are bound to subparts of the matched string.
+Additionally, "lexbuf" is bound to the current lexer
+buffer. Some typical uses for "lexbuf", in conjunction with the
+operations on lexer buffers provided by the "Lexing" standard library
+module, are listed below.
+
+\begin{options}
+\item["Lexing.lexeme lexbuf"]
+Return the matched string.
+
+\item["Lexing.lexeme_char lexbuf "$n$]
+Return the $n\th$
+character in the matched string. The first character corresponds to $n = 0$.
+
+\item["Lexing.lexeme_start lexbuf"]
+Return the absolute position in the input text of the beginning of the
+matched string (i.e. the offset of the first character of the matched
+string). The first character read from the input text has offset 0.
+
+\item["Lexing.lexeme_end lexbuf"]
+Return the absolute position in the input text of the end of the
+matched string (i.e. the offset of the first character after the
+matched string). The first character read from the input text has
+offset 0.
+
+\newcommand{\sub}[1]{$_{#1}$}%
+\item[\var{entrypoint} {[\var{exp\sub{1}}\ldots{} \var{exp\sub{n}}]} "lexbuf"]
+(Where \var{entrypoint} is the name of another entry point in the same
+lexer definition.) Recursively call the lexer on the given entry point.
+Notice that "lexbuf" is the last argument.
+Useful for lexing nested comments, for example.
+
+\end{options}
+
+\subsection{ss:ocamllex-variables}{Variables in regular expressions}
+The "as" construct is similar to ``\emph{groups}'' as provided by
+numerous regular expression packages.
+The type of these variables can be "string", "char", "string option"
+or "char option".
+
+We first consider the case of linear patterns, that is the case when
+all "as" bound variables are distinct.
+In @regexp 'as' ident@, the type of @ident@ normally is "string" (or
+"string option") except
+when @regexp@ is a character constant, an underscore, a string
+constant of length one, a character set specification, or an
+alternation of those. Then, the type of @ident@ is "char" (or "char
+option").
+Option types are introduced when overall rule matching does not
+imply matching of the bound sub-pattern. This is in particular the
+case of @'(' regexp 'as' ident ')' '?'@ and of
+@regexp_1 '|' '(' regexp_2 'as' ident ')'@.
+
+There is no linearity restriction over "as" bound variables.
+When a variable is bound more than once, the previous rules are to be
+extended as follows:
+\begin{itemize}
+\item A variable is a "char" variable when all its occurrences bind
+"char" occurrences in the previous sense.
+\item A variable is an "option" variable when the overall expression
+can be matched without binding this variable.
+\end{itemize}
+For instance, in
+"('a' as x) | ( 'a' (_ as x) )" the variable "x"  is of type
+"char", whereas in
+"(\"ab\" as x) | ( 'a' (_ as x) ? )" the variable "x"  is of type
+"string option".
+
+
+In some cases, a successful match may not yield a unique set of bindings.
+For instance the matching of \verb+aba+ by the regular expression
+"(('a'|\"ab\") as x) ((\"ba\"|'a') as y)" may result in binding
+either
+\verb+x+ to \verb+"ab"+ and \verb+y+ to \verb+"a"+, or
+\verb+x+ to \verb+"a"+ and \verb+y+ to \verb+"ba"+.
+The automata produced "ocamllex" on such ambiguous regular
+expressions will select one of the possible resulting sets of
+bindings.
+The selected set of bindings is purposely left unspecified.
+
+\subsection{ss:refill-handlers}{Refill handlers}
+
+By default, when ocamllex reaches the end of its lexing buffer, it
+will silently call the "refill_buff" function of "lexbuf" structure
+and continue lexing. It is sometimes useful to be able to take control
+of refilling action; typically, if you use a library for asynchronous
+computation, you may want to wrap the refilling action in a delaying
+function to avoid blocking synchronous operations.
+
+Since OCaml 4.02, it is possible to specify a \var{refill-handler},
+a function that will be called when refill happens. It is passed the
+continuation of the lexing, on which it has total control. The OCaml
+expression used as refill action should have a type that is an
+instance of
+\begin{verbatim}
+   (Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> 'a
+\end{verbatim}
+where the first argument is the continuation which captures the
+processing ocamllex would usually perform (refilling the buffer, then
+calling the lexing function again), and the result type that
+instantiates ['a] should unify with the result type of all lexing
+rules.
+
+As an example, consider the following lexer that is parametrized over
+an arbitrary monad:
+\begin{verbatim}
+{
+type token = EOL | INT of int | PLUS
+
+module Make (M : sig
+               type 'a t
+               val return: 'a -> 'a t
+               val bind: 'a t -> ('a -> 'b t) -> 'b t
+               val fail : string -> 'a t
+
+               (* Set up lexbuf *)
+               val on_refill : Lexing.lexbuf -> unit t
+             end)
+= struct
+
+let refill_handler k lexbuf =
+    M.bind (M.on_refill lexbuf) (fun () -> k lexbuf)
+
+}
+
+refill {refill_handler}
+
+rule token = parse
+| [' ' '\t']
+    { token lexbuf }
+| '\n'
+    { M.return EOL }
+| ['0'-'9']+ as i
+    { M.return (INT (int_of_string i)) }
+| '+'
+    { M.return PLUS }
+| _
+    { M.fail "unexpected character" }
+{
+end
+}
+\end{verbatim}
+
+\subsection{ss:ocamllex-reserved-ident}{Reserved identifiers}
+
+All identifiers starting with "__ocaml_lex" are reserved for use by
+"ocamllex"; do not use any such identifier in your programs.
+
+
+\section{s:ocamlyacc-overview}{Overview of \texttt{ocamlyacc}}
+
+The "ocamlyacc" command produces a parser from a context-free grammar
+specification with attached semantic actions, in the style of "yacc".
+Assuming the input file is \var{grammar}".mly", executing
+\begin{alltt}
+        ocamlyacc \var{options} \var{grammar}.mly
+\end{alltt}
+produces OCaml code for a parser in the file \var{grammar}".ml",
+and its interface in file \var{grammar}".mli".
+
+The generated module defines one parsing function per entry point in
+the grammar. These functions have the same names as the entry points.
+Parsing functions take as arguments a lexical analyzer (a function
+from lexer buffers to tokens) and a lexer buffer, and return the
+semantic attribute of the corresponding entry point. Lexical analyzer
+functions are usually generated from a lexer specification by the
+"ocamllex" program. Lexer buffers are an abstract data type
+implemented in the standard library module "Lexing". Tokens are values from
+the concrete type "token", defined in the interface file
+\var{grammar}".mli" produced by "ocamlyacc".
+
+\section{s:ocamlyacc-syntax}{Syntax of grammar definitions}
+
+Grammar definitions have the following format:
+\begin{alltt}
+\%\{
+  \var{header}
+\%\}
+  \var{declarations}
+\%\%
+  \var{rules}
+\%\%
+  \var{trailer}
+\end{alltt}
+
+Comments are enclosed between \verb|/*| and \verb|*/| (as in C) in the
+``declarations'' and ``rules'' sections, and between \verb|(*| and
+\verb|*)| (as in OCaml) in the ``header'' and ``trailer'' sections.
+
+\subsection{ss:ocamlyacc-header-trailer}{Header and trailer}
+
+The header and the trailer sections are OCaml code that is copied
+as is into file \var{grammar}".ml". Both sections are optional. The header
+goes at the beginning of the output file; it usually contains
+"open" directives and auxiliary functions required by the semantic
+actions of the rules. The trailer goes at the end of the output file.
+
+\subsection{ss:ocamlyacc-declarations}{Declarations}
+
+Declarations are given one per line. They all start with a \verb"%" sign.
+
+\begin{options}
+
+\item[@"%token" constr \ldots constr@]
+Declare the given symbols @constr \ldots constr@
+as tokens (terminal symbols).  These symbols
+are added as constant constructors for the "token" concrete type.
+
+\item[@"%token" "<" typexpr ">" constr \ldots constr@]
+Declare the given symbols @constr \ldots constr@ as tokens with an
+attached attribute of the
+given type. These symbols are added as constructors with arguments of
+the given type for the "token" concrete type. The @typexpr@ part is
+an arbitrary OCaml type expression, except that all type
+constructor names must be fully qualified (e.g. "Modname.typename")
+for all types except standard built-in types, even if the proper
+\verb|open| directives (e.g. \verb|open Modname|) were given in the
+header section. That's because the header is copied only to the ".ml"
+output file, but not to the ".mli" output file, while the @typexpr@ part
+of a \verb"%token" declaration is copied to both.
+
+\item[@"%start" symbol \ldots symbol@]
+Declare the given symbols as entry points for the grammar. For each
+entry point, a parsing function with the same name is defined in the
+output module. Non-terminals that are not declared as entry points
+have no such parsing function. Start symbols must be given a type with
+the \verb|%type| directive below.
+
+\item[@"%type" "<" typexpr ">" symbol \ldots symbol@]
+Specify the type of the semantic attributes for the given symbols.
+This is mandatory for start symbols only. Other nonterminal symbols
+need not be given types by hand: these types will be inferred when
+running the output files through the OCaml compiler (unless the
+\verb"-s" option is in effect). The @typexpr@ part is an arbitrary OCaml
+type expression, except that all type constructor names must be
+fully qualified, as explained above for "%token".
+
+\item[@"%left" symbol \ldots symbol@]
+\item[@"%right" symbol \ldots symbol@]
+\item[@"%nonassoc" symbol \ldots symbol@]
+
+Associate precedences and associativities to the given symbols. All
+symbols on the same line are given the same precedence. They have
+higher precedence than symbols declared before in a \verb"%left",
+\verb"%right" or \verb"%nonassoc" line. They have lower precedence
+than symbols declared after in a \verb"%left", \verb"%right" or
+\verb"%nonassoc" line. The symbols are declared to associate to the
+left (\verb"%left"), to the right (\verb"%right"), or to be
+non-associative (\verb"%nonassoc"). The symbols are usually tokens.
+They can also be dummy nonterminals, for use with the \verb"%prec"
+directive inside the rules.
+
+The precedence declarations are used in the following way to
+resolve reduce/reduce and shift/reduce conflicts:
+\begin{itemize}
+\item Tokens and rules have precedences.  By default, the precedence
+  of a rule is the precedence of its rightmost terminal.  You
+  can override this default by using the @"%prec"@ directive in the rule.
+\item A reduce/reduce conflict
+  is resolved in favor of the first rule (in the order given by the
+  source file), and "ocamlyacc" outputs a warning.
+\item A shift/reduce conflict
+  is resolved by comparing the precedence of the rule to be
+  reduced with the precedence of the token to be shifted.  If the
+  precedence of the rule is higher, then the rule will be reduced;
+  if the precedence of the token is higher, then the token will
+  be shifted.
+\item A shift/reduce conflict between a rule and a token with the
+  same precedence will be resolved using the associativity: if the
+  token is left-associative, then the parser will reduce; if the
+  token is right-associative, then the parser will shift.  If the
+  token is non-associative, then the parser will declare a syntax
+  error.
+\item When a shift/reduce conflict cannot be resolved using the above
+  method, then "ocamlyacc" will output a warning and the parser will
+  always shift.
+\end{itemize}
+
+\end{options}
+
+\subsection{ss:ocamlyacc-rules}{Rules}
+
+The syntax for rules is as usual:
+\begin{alltt}
+\var{nonterminal} :
+    \var{symbol} \ldots \var{symbol} \{ \var{semantic-action} \}
+  | \ldots
+  | \var{symbol} \ldots \var{symbol} \{ \var{semantic-action} \}
+;
+\end{alltt}
+%
+Rules can also contain the \verb"%prec "{\it symbol} directive in the
+right-hand side part, to override the default precedence and
+associativity of the rule with the precedence and associativity of the
+given symbol.
+
+Semantic actions are arbitrary OCaml expressions, that
+are evaluated to produce the semantic attribute attached to
+the defined nonterminal. The semantic actions can access the
+semantic attributes of the symbols in the right-hand side of
+the rule with the \verb"$" notation: \verb"$1" is the attribute for the
+first (leftmost) symbol, \verb"$2" is the attribute for the second
+symbol, etc.
+
+The rules may contain the special symbol "error" to indicate
+resynchronization points, as in "yacc".
+
+Actions occurring in the middle of rules are not supported.
+
+Nonterminal symbols are like regular OCaml symbols, except that they
+cannot end with "'" (single quote).
+
+\subsection{ss:ocamlyacc-error-handling}{Error handling}
+
+Error recovery is supported as follows: when the parser reaches an
+error state (no grammar rules can apply), it calls a function named
+"parse_error" with the string "\"syntax error\"" as argument. The default
+"parse_error" function does nothing and returns, thus initiating error
+recovery (see below). The user can define a customized "parse_error"
+function in the header section of the grammar file.
+
+The parser also enters error recovery mode if one of the grammar
+actions raises the "Parsing.Parse_error" exception.
+
+In error recovery mode, the parser discards states from the
+stack until it reaches a place where the error token can be shifted.
+It then discards tokens from the input until it finds three successive
+tokens that can be accepted, and starts processing with the first of
+these.  If no state can be uncovered where the error token can be
+shifted, then the parser aborts by raising the "Parsing.Parse_error"
+exception.
+
+Refer to documentation on "yacc" for more details and guidance in how
+to use error recovery.
+
+\section{s:ocamlyacc-options}{Options}
+
+The "ocamlyacc" command recognizes the following options:
+
+\begin{options}
+
+\item["-b"{\it prefix}]
+Name the output files {\it prefix}".ml", {\it prefix}".mli",
+{\it prefix}".output", instead of the default naming convention.
+
+\item["-q"]
+This option has no effect.
+
+\item["-v"]
+Generate a description of the parsing tables and a report on conflicts
+resulting from ambiguities in the grammar. The description is put in
+file \var{grammar}".output".
+
+\item["-version"]
+Print version string and exit.
+
+\item["-vnum"]
+Print short version number and exit.
+
+\item["-"]
+Read the grammar specification from standard input.  The default
+output file names are "stdin.ml" and "stdin.mli".
+
+\item["--" \var{file}]
+Process \var{file} as the grammar specification, even if its name
+starts with a dash (-) character.  This option must be the last on the
+command line.
+
+\end{options}
+
+At run-time, the "ocamlyacc"-generated parser can be debugged by
+setting the "p" option in the "OCAMLRUNPARAM" environment variable
+(see section~\ref{s:ocamlrun-options}).  This causes the pushdown
+automaton executing the parser to print a trace of its action (tokens
+shifted, rules reduced, etc).  The trace mentions rule numbers and
+state numbers that can be interpreted by looking at the file
+\var{grammar}".output" generated by "ocamlyacc -v".
+
+\section{s:lexyacc-example}{A complete example}
+
+The all-time favorite: a desk calculator. This program reads
+arithmetic expressions on standard input, one per line, and prints
+their values. Here is the grammar definition:
+\begin{verbatim}
+        /* File parser.mly */
+        %token  INT
+        %token PLUS MINUS TIMES DIV
+        %token LPAREN RPAREN
+        %token EOL
+        %left PLUS MINUS        /* lowest precedence */
+        %left TIMES DIV         /* medium precedence */
+        %nonassoc UMINUS        /* highest precedence */
+        %start main             /* the entry point */
+        %type  main
+        %%
+        main:
+            expr EOL                { $1 }
+        ;
+        expr:
+            INT                     { $1 }
+          | LPAREN expr RPAREN      { $2 }
+          | expr PLUS expr          { $1 + $3 }
+          | expr MINUS expr         { $1 - $3 }
+          | expr TIMES expr         { $1 * $3 }
+          | expr DIV expr           { $1 / $3 }
+          | MINUS expr %prec UMINUS { - $2 }
+        ;
+\end{verbatim}
+Here is the definition for the corresponding lexer:
+\begin{verbatim}
+        (* File lexer.mll *)
+        {
+        open Parser        (* The type token is defined in parser.mli *)
+        exception Eof
+        }
+        rule token = parse
+            [' ' '\t']     { token lexbuf }     (* skip blanks *)
+          | ['\n' ]        { EOL }
+          | ['0'-'9']+ as lxm { INT(int_of_string lxm) }
+          | '+'            { PLUS }
+          | '-'            { MINUS }
+          | '*'            { TIMES }
+          | '/'            { DIV }
+          | '('            { LPAREN }
+          | ')'            { RPAREN }
+          | eof            { raise Eof }
+\end{verbatim}
+Here is the main program, that combines the parser with the lexer:
+\begin{verbatim}
+        (* File calc.ml *)
+        let _ =
+          try
+            let lexbuf = Lexing.from_channel stdin in
+            while true do
+              let result = Parser.main Lexer.token lexbuf in
+                print_int result; print_newline(); flush stdout
+            done
+          with Lexer.Eof ->
+            exit 0
+\end{verbatim}
+To compile everything, execute:
+\begin{verbatim}
+        ocamllex lexer.mll       # generates lexer.ml
+        ocamlyacc parser.mly     # generates parser.ml and parser.mli
+        ocamlc -c parser.mli
+        ocamlc -c lexer.ml
+        ocamlc -c parser.ml
+        ocamlc -c calc.ml
+        ocamlc -o calc lexer.cmo parser.cmo calc.cmo
+\end{verbatim}
+
+\section{s:lexyacc-common-errors}{Common errors}
+
+\begin{options}
+
+\item[ocamllex: transition table overflow, automaton is too big]
+
+The deterministic automata generated by "ocamllex" are limited to at
+most 32767 transitions.  The message above indicates that your lexer
+definition is too complex and overflows this limit.  This is commonly
+caused by lexer definitions that have separate rules for each of the
+alphabetic keywords of the language, as in the following example.
+\begin{verbatim}
+rule token = parse
+  "keyword1"   { KWD1 }
+| "keyword2"   { KWD2 }
+| ...
+| "keyword100" { KWD100 }
+| ['A'-'Z' 'a'-'z'] ['A'-'Z' 'a'-'z' '0'-'9' '_'] * as id
+               { IDENT id}
+\end{verbatim}
+To keep the generated automata small, rewrite those definitions with
+only one general ``identifier'' rule, followed by a hashtable lookup
+to separate keywords from identifiers:
+\begin{verbatim}
+{ let keyword_table = Hashtbl.create 53
+  let _ =
+    List.iter (fun (kwd, tok) -> Hashtbl.add keyword_table kwd tok)
+              [ "keyword1", KWD1;
+                "keyword2", KWD2; ...
+                "keyword100", KWD100 ]
+}
+rule token = parse
+  ['A'-'Z' 'a'-'z'] ['A'-'Z' 'a'-'z' '0'-'9' '_'] * as id
+               { try
+                   Hashtbl.find keyword_table id
+                 with Not_found ->
+                   IDENT id }
+\end{verbatim}
+
+\item[ocamllex: Position memory overflow, too many bindings]
+The deterministic automata generated by "ocamllex" maintain a table of
+positions inside the scanned lexer buffer. The size of this table is
+limited to at most 255 cells. This error should not show up in normal
+situations.
+
+\end{options}
diff --git a/manual/manual/cmds/native.etex b/manual/manual/cmds/native.etex
new file mode 100644
index 00000000..a923b81c
--- /dev/null
+++ b/manual/manual/cmds/native.etex
@@ -0,0 +1,252 @@
+\chapter{Native-code compilation (ocamlopt)} \label{c:nativecomp}
+%HEVEA\cutname{native.html}
+
+This chapter describes the OCaml high-performance
+native-code compiler "ocamlopt", which compiles OCaml source files to
+native code object files and links these object files to produce
+standalone executables.
+
+The native-code compiler is only available on certain platforms.
+It produces code that runs faster than the bytecode produced by
+"ocamlc", at the cost of increased compilation time and executable code
+size. Compatibility with the bytecode compiler is extremely high: the
+same source code should run identically when compiled with "ocamlc" and
+"ocamlopt".
+
+It is not possible to mix native-code object files produced by "ocamlopt"
+with bytecode object files produced by "ocamlc": a program must be
+compiled entirely with "ocamlopt" or entirely with "ocamlc". Native-code
+object files produced by "ocamlopt" cannot be loaded in the toplevel
+system "ocaml".
+
+\section{s:native-overview}{Overview of the compiler}
+
+The "ocamlopt" command has a command-line interface very close to that
+of "ocamlc". It accepts the same types of arguments, and processes them
+sequentially, after all options have been processed:
+
+\begin{itemize}
+\item
+Arguments ending in ".mli" are taken to be source files for
+compilation unit interfaces. Interfaces specify the names exported by
+compilation units: they declare value names with their types, define
+public data types, declare abstract data types, and so on. From the
+file \var{x}".mli", the "ocamlopt" compiler produces a compiled interface
+in the file \var{x}".cmi". The interface produced is identical to that
+produced by the bytecode compiler "ocamlc".
+
+\item
+Arguments ending in ".ml" are taken to be source files for compilation
+unit implementations. Implementations provide definitions for the
+names exported by the unit, and also contain expressions to be
+evaluated for their side-effects.  From the file \var{x}".ml", the "ocamlopt"
+compiler produces two files: \var{x}".o", containing native object code,
+and \var{x}".cmx", containing extra information for linking and
+optimization of the clients of the unit. The compiled implementation
+should always be referred to under the name \var{x}".cmx" (when given
+a ".o" or ".obj" file, "ocamlopt" assumes that it contains code compiled from C,
+not from OCaml).
+
+The implementation is checked against the interface file \var{x}".mli"
+(if it exists) as described in the manual for "ocamlc"
+(chapter~\ref{c:camlc}).
+
+\item
+Arguments ending in ".cmx" are taken to be compiled object code.  These
+files are linked together, along with the object files obtained
+by compiling ".ml" arguments (if any), and the OCaml standard
+library, to produce a native-code executable program. The order in
+which ".cmx" and ".ml" arguments are presented on the command line is
+relevant: compilation units are initialized in that order at
+run-time, and it is a link-time error to use a component of a unit
+before having initialized it. Hence, a given \var{x}".cmx" file must come
+before all ".cmx" files that refer to the unit \var{x}.
+
+\item
+Arguments ending in ".cmxa" are taken to be libraries of object code.
+Such a library packs in two files (\var{lib}".cmxa" and \var{lib}".a"/".lib")
+a set of object files (".cmx" and ".o"/".obj" files). Libraries are build with
+"ocamlopt -a" (see the description of the "-a" option below). The object
+files contained in the library are linked as regular ".cmx" files (see
+above), in the order specified when the library was built. The only
+difference is that if an object file contained in a library is not
+referenced anywhere in the program, then it is not linked in.
+
+\item
+Arguments ending in ".c" are passed to the C compiler, which generates
+a ".o"/".obj" object file. This object file is linked with the program.
+
+\item
+Arguments ending in ".o", ".a" or ".so" (".obj", ".lib" and ".dll"
+under Windows) are assumed to be C object files and
+libraries. They are linked with the program.
+
+\end{itemize}
+
+The output of the linking phase is a regular Unix or Windows
+executable file. It does not need "ocamlrun" to run.
+
+%  The following two paragraphs are a duplicate from the description of the batch compiler.
+
+The compiler is able to emit some information on its internal stages.
+It can output ".cmt" files for the implementation of the compilation unit
+and ".cmti" for signatures if the option "-bin-annot" is passed to it (see the
+description of "-bin-annot" below).
+Each such file contains a typed abstract syntax tree (AST), that is produced
+during the type checking procedure. This tree contains all available information
+about the location and the specific type of each term in the source file.
+The AST is partial if type checking was unsuccessful.
+
+These ".cmt" and ".cmti" files are typically useful for code inspection tools.
+
+\section{s:native-options}{Options}
+
+The following command-line options are recognized by "ocamlopt".
+The options "-pack", "-a", "-shared", "-c" and "-output-obj" are mutually
+exclusive.
+
+% Configure boolean variables used by the macros in unified-options.etex
+\compfalse
+\nattrue
+\topfalse
+% unified-options gathers all options across the native/bytecode
+% compilers and toplevel
+\input{unified-options.tex}
+
+\paragraph{Options for the IA32 architecture}
+The IA32 code generator (Intel Pentium, AMD Athlon) supports the
+following additional option:
+
+\begin{options}
+\item["-ffast-math"] Use the IA32 instructions to compute
+trigonometric and exponential functions, instead of calling the
+corresponding library routines.  The functions affected are:
+"atan", "atan2", "cos", "log", "log10", "sin", "sqrt" and "tan".
+The resulting code runs faster, but the range of supported arguments
+and the precision of the result can be reduced.  In particular,
+trigonometric operations "cos", "sin", "tan" have their range reduced to
+$[-2^{64}, 2^{64}]$.
+\end{options}
+
+\paragraph{Options for the AMD64 architecture}
+The AMD64 code generator (64-bit versions of Intel Pentium and AMD
+Athlon) supports the following additional options:
+
+\begin{options}
+\item["-fPIC"] Generate position-independent machine code.  This is
+the default.
+\item["-fno-PIC"] Generate position-dependent machine code.
+\end{options}
+
+\paragraph{Options for the PowerPC architecture}
+The PowerPC code generator supports the following additional options:
+
+\begin{options}
+\item["-flarge-toc"] Enables the PowerPC large model allowing the TOC (table of
+contents) to be arbitrarily large.  This is the default since 4.11.
+\item["-fsmall-toc"] Enables the PowerPC small model allowing the TOC to be up
+to 64 kbytes per compilation unit.  Prior to 4.11 this was the default
+behaviour.
+\end{options}
+
+\paragraph{Contextual control of command-line options}
+
+The compiler command line can be modified ``from the outside''
+with the following mechanisms. These are experimental
+and subject to change. They should be used only for experimental and
+development work, not in released packages.
+
+\begin{options}
+\item["OCAMLPARAM" \rm(environment variable)]
+A set of arguments that will be inserted before or after the arguments from
+the command line. Arguments are specified in a comma-separated list
+of "name=value" pairs. A "_" is used to specify the position of
+the command line arguments, i.e. "a=x,_,b=y" means that "a=x" should be
+executed before parsing the arguments, and "b=y" after. Finally,
+an alternative separator can be specified as the
+first character of the string, within the set ":|; ,".
+\item["ocaml_compiler_internal_params" \rm(file in the stdlib directory)]
+A mapping of file names to lists of arguments that
+will be added to the command line (and "OCAMLPARAM") arguments.
+\item["OCAML_FLEXLINK" \rm(environment variable)]
+Alternative executable to use on native
+Windows for "flexlink" instead of the
+configured value. Primarily used for bootstrapping.
+\end{options}
+
+\section{s:native-common-errors}{Common errors}
+
+The error messages are almost identical to those of "ocamlc".
+See section~\ref{s:comp-errors}.
+
+\section{s:native:running-executable}{Running executables produced by ocamlopt}
+
+Executables generated by "ocamlopt" are native, stand-alone executable
+files that can be invoked directly.  They do
+not depend on the "ocamlrun" bytecode runtime system nor on
+dynamically-loaded C/OCaml stub libraries.
+
+During execution of an "ocamlopt"-generated executable,
+the following environment variables are also consulted:
+\begin{options}
+\item["OCAMLRUNPARAM"]  Same usage as in "ocamlrun"
+  (see section~\ref{s:ocamlrun-options}), except that option "l"
+  is ignored (the operating system's stack size limit
+  is used instead).
+\item["CAMLRUNPARAM"]  If "OCAMLRUNPARAM" is not found in the
+  environment, then "CAMLRUNPARAM" will be used instead.  If
+  "CAMLRUNPARAM" is not found, then the default values will be used.
+\end{options}
+
+\section{s:compat-native-bytecode}{Compatibility with the bytecode compiler}
+
+This section lists the known incompatibilities between the bytecode
+compiler and the native-code compiler. Except on those points, the two
+compilers should generate code that behave identically.
+
+\begin{itemize}
+
+\item Signals are detected only when the program performs an
+allocation in the heap. That is, if a signal is delivered while in a
+piece of code that does not allocate, its handler will not be called
+until the next heap allocation.
+
+\item On ARM and PowerPC processors (32 and 64 bits), fused
+  multiply-add (FMA) instructions can be generated for a
+  floating-point multiplication followed by a floating-point addition
+  or subtraction, as in "x *. y +. z".  The FMA instruction avoids
+  rounding the intermediate result "x *. y", which is generally
+  beneficial, but produces floating-point results that differ slightly
+  from those produced by the bytecode interpreter.
+
+\item On IA32 processors only (Intel and AMD x86 processors in 32-bit
+mode), some intermediate results in floating-point computations are
+kept in extended precision rather than being rounded to double
+precision like the bytecode compiler always does.  Floating-point
+results can therefore differ slightly between bytecode and native code.
+
+\item The native-code compiler performs a number of optimizations that
+the bytecode compiler does not perform, especially when the Flambda
+optimizer is active.  In particular, the native-code compiler
+identifies and eliminates ``dead code'', i.e.\ computations that do
+not contribute to the results of the program.  For example,
+\begin{verbatim}
+        let _ = ignore M.f
+\end{verbatim}
+contains a reference to compilation unit "M" when compiled to
+bytecode.  This reference forces "M" to be linked and its
+initialization code to be executed.  The native-code compiler
+eliminates the reference to "M", hence the compilation unit "M" may
+not be linked and executed.  A workaround is to compile "M" with the
+"-linkall" flag so that it will always be linked and executed, even if
+not referenced.  See also the "Sys.opaque_identity" function from the
+"Sys" standard library module.
+
+\item Before 4.10, stack overflows, typically caused by excessively
+  deep recursion, are not always turned into a "Stack_overflow"
+  exception like with the bytecode compiler. The runtime system makes
+  a best effort to trap stack overflows and raise the "Stack_overflow"
+  exception, but sometimes it fails and a ``segmentation fault'' or
+  another system fault occurs instead.
+
+\end{itemize}
diff --git a/manual/manual/cmds/ocamlbuild.etex b/manual/manual/cmds/ocamlbuild.etex
new file mode 100644
index 00000000..66c7101a
--- /dev/null
+++ b/manual/manual/cmds/ocamlbuild.etex
@@ -0,0 +1,5 @@
+\chapter{The ocamlbuild compilation manager} \label{c:ocamlbuild}
+
+Since OCaml version 4.03, the ocamlbuild compilation manager is
+distributed separately from the OCaml compiler. The project is now
+hosted at \url{https://github.com/ocaml/ocamlbuild/}.
diff --git a/manual/manual/cmds/ocamldep.etex b/manual/manual/cmds/ocamldep.etex
new file mode 100644
index 00000000..93892b74
--- /dev/null
+++ b/manual/manual/cmds/ocamldep.etex
@@ -0,0 +1,216 @@
+\chapter{Dependency generator (ocamldep)} \label{c:camldep}
+%HEVEA\cutname{depend.html}
+
+The "ocamldep" command scans a set of OCaml source files
+(".ml" and ".mli" files) for references to external compilation units,
+and outputs dependency lines in a format suitable for the "make"
+utility. This ensures that "make" will compile the source files in the
+correct order, and recompile those files that need to when a source
+file is modified.
+
+The typical usage is:
+\begin{alltt}
+        ocamldep \var{options} *.mli *.ml > .depend
+\end{alltt}
+where "*.mli *.ml" expands to all source files in the current
+directory and ".depend" is the file that should contain the
+dependencies. (See below for a typical "Makefile".)
+
+Dependencies are generated both for compiling with the bytecode
+compiler "ocamlc" and with the native-code compiler "ocamlopt".
+
+\section{s:ocamldep-options}{Options}
+
+The following command-line options are recognized by "ocamldep".
+
+\begin{options}
+
+\item["-absname"]
+Show absolute filenames in error messages.
+
+\item["-all"]
+Generate dependencies on all required files, rather than assuming
+implicit dependencies.
+
+\item["-allow-approx"]
+Allow falling back on a lexer-based approximation when parsing fails.
+
+\item["-args" \var{filename}]
+ Read additional newline-terminated command line arguments from \var{filename}.
+
+\item["-args0" \var{filename}]
+ Read additional null character terminated command line arguments from \var{filename}.
+
+\item["-as-map"]
+For the following files, do not include delayed dependencies for
+module aliases.
+This option assumes that they are compiled using options
+"-no-alias-deps -w -49", and that those files or their interface are
+passed with the "-map" option when computing dependencies for other
+files. Note also that for dependencies to be correct in the
+implementation of a map file, its interface should not coerce any of
+the aliases it contains.
+
+\item["-debug-map"]
+Dump the delayed dependency map for each map file.
+
+\item["-I" \var{directory}]
+Add the given directory to the list of directories searched for
+source files. If a source file "foo.ml" mentions an external
+compilation unit "Bar", a dependency on that unit's interface
+"bar.cmi" is generated only if the source for "bar" is found in the
+current directory or in one of the directories specified with "-I".
+Otherwise, "Bar" is assumed to be a module from the standard library,
+and no dependencies are generated. For programs that span multiple
+directories, it is recommended to pass "ocamldep" the same "-I" options
+that are passed to the compiler.
+
+\item["-nocwd"]
+Do not add current working directory to the list of include directories.
+
+\item["-impl" \var{file}]
+Process \var{file} as a ".ml" file.
+
+\item["-intf" \var{file}]
+Process \var{file} as a ".mli" file.
+
+\item["-map" \var{file}]
+Read an propagate the delayed dependencies for module aliases in
+\var{file}, so that the following files will depend on the
+exported aliased modules if they use them. See the example below.
+
+\item["-ml-synonym" \var{.ext}]
+Consider the given extension (with leading dot) to be a synonym for .ml.
+
+\item["-mli-synonym" \var{.ext}]
+Consider the given extension (with leading dot) to be a synonym for .mli.
+
+\item["-modules"]
+Output raw dependencies of the form
+\begin{verbatim}
+      filename: Module1 Module2 ... ModuleN
+\end{verbatim}
+where "Module1", \ldots, "ModuleN" are the names of the compilation
+units referenced within the file "filename", but these names are not
+resolved to source file names.  Such raw dependencies cannot be used
+by "make", but can be post-processed by other tools such as "Omake".
+
+\item["-native"]
+Generate dependencies for a pure native-code program (no bytecode
+version).  When an implementation file (".ml" file) has no explicit
+interface file (".mli" file), "ocamldep" generates dependencies on the
+bytecode compiled file (".cmo" file) to reflect interface changes.
+This can cause unnecessary bytecode recompilations for programs that
+are compiled to native-code only.  The flag "-native" causes
+dependencies on native compiled files (".cmx") to be generated instead
+of on ".cmo" files.  (This flag makes no difference if all source files
+have explicit ".mli" interface files.)
+
+\item["-one-line"]
+Output one line per file, regardless of the length.
+
+\item["-open" \var{module}]
+Assume that module \var{module} is opened before parsing each of the
+following files.
+
+\item["-pp" \var{command}]
+Cause "ocamldep" to call the given \var{command} as a preprocessor
+for each source file.
+
+\item["-ppx" \var{command}]
+Pipe abstract syntax trees through preprocessor \var{command}.
+
+\item["-shared"]
+Generate dependencies for native plugin files (.cmxs) in addition to
+native compiled files (.cmx).
+
+\item["-slash"]
+Under Windows, use a forward slash (/) as the path separator instead
+of the usual backward slash ($\backslash$).  Under Unix, this option does
+nothing.
+
+\item["-sort"]
+Sort files according to their dependencies.
+
+\item["-version"]
+Print version string and exit.
+
+\item["-vnum"]
+Print short version number and exit.
+
+\item["-help" or "--help"]
+Display a short usage summary and exit.
+%
+\end{options}
+
+\section{s:ocamldep-makefile}{A typical Makefile}
+
+Here is a template "Makefile" for a OCaml program.
+
+\begin{verbatim}
+OCAMLC=ocamlc
+OCAMLOPT=ocamlopt
+OCAMLDEP=ocamldep
+INCLUDES=                 # all relevant -I options here
+OCAMLFLAGS=$(INCLUDES)    # add other options for ocamlc here
+OCAMLOPTFLAGS=$(INCLUDES) # add other options for ocamlopt here
+
+# prog1 should be compiled to bytecode, and is composed of three
+# units: mod1, mod2 and mod3.
+
+# The list of object files for prog1
+PROG1_OBJS=mod1.cmo mod2.cmo mod3.cmo
+
+prog1: $(PROG1_OBJS)
+        $(OCAMLC) -o prog1 $(OCAMLFLAGS) $(PROG1_OBJS)
+
+# prog2 should be compiled to native-code, and is composed of two
+# units: mod4 and mod5.
+
+# The list of object files for prog2
+PROG2_OBJS=mod4.cmx mod5.cmx
+
+prog2: $(PROG2_OBJS)
+        $(OCAMLOPT) -o prog2 $(OCAMLFLAGS) $(PROG2_OBJS)
+
+# Common rules
+.SUFFIXES: .ml .mli .cmo .cmi .cmx
+
+.ml.cmo:
+        $(OCAMLC) $(OCAMLFLAGS) -c $<
+
+.mli.cmi:
+        $(OCAMLC) $(OCAMLFLAGS) -c $<
+
+.ml.cmx:
+        $(OCAMLOPT) $(OCAMLOPTFLAGS) -c $<
+
+# Clean up
+clean:
+        rm -f prog1 prog2
+        rm -f *.cm[iox]
+
+# Dependencies
+depend:
+        $(OCAMLDEP) $(INCLUDES) *.mli *.ml > .depend
+
+include .depend
+\end{verbatim}
+
+If you use module aliases to give shorter names to modules, you need
+to change the above definitions. Assuming that your map file is called
+"mylib.mli", here are minimal modifications.
+\begin{verbatim}
+OCAMLFLAGS=$(INCLUDES) -open Mylib
+
+mylib.cmi: mylib.mli
+        $(OCAMLC) $(INCLUDES) -no-alias-deps -w -49 -c $<
+
+depend:
+        $(OCAMLDEP) $(INCLUDES) -map mylib.mli $(PROG1_OBJS:.cmo=.ml) > .depend
+\end{verbatim}
+Note that in this case you should not compute dependencies for
+"mylib.mli" together with the other files, hence the need to pass
+explicitly the list of files to process.
+If "mylib.mli" itself has dependencies, you should compute them using
+"-as-map".
diff --git a/manual/manual/cmds/ocamldoc.etex b/manual/manual/cmds/ocamldoc.etex
new file mode 100644
index 00000000..65986611
--- /dev/null
+++ b/manual/manual/cmds/ocamldoc.etex
@@ -0,0 +1,1126 @@
+\chapter{The documentation generator (ocamldoc)} \label{c:ocamldoc}
+%HEVEA\cutname{ocamldoc.html}
+
+This chapter describes OCamldoc, a tool that generates documentation from
+special comments embedded in source files.  The comments used by OCamldoc
+are of the form "(**"\ldots"*)" and follow the format described
+in section \ref{s:ocamldoc-comments}.
+
+OCamldoc can produce documentation in various formats: HTML, \LaTeX ,
+TeXinfo, Unix man pages, and "dot" dependency graphs.  Moreover,
+users can add their own custom generators, as explained in
+section \ref{s:ocamldoc-custom-generators}.
+
+In this chapter, we use the word {\em element} to refer to any of the
+following parts of an OCaml source file: a type declaration, a value,
+a module, an exception, a module type, a type constructor, a record
+field, a class, a class type, a class method, a class value or a class
+inheritance clause.
+
+\section{s:ocamldoc-usage}{Usage}
+
+\subsection{ss:ocamldoc-invocation}{Invocation}
+
+OCamldoc is invoked via the command "ocamldoc", as follows:
+\begin{alltt}
+        ocamldoc \var{options} \var{sourcefiles}
+\end{alltt}
+
+\subsubsection*{sss:ocamldoc-output}{Options for choosing the output format}
+
+The following options determine the format for the generated
+documentation.
+
+\begin{options}
+\item["-html"]
+Generate documentation in HTML default format. The generated HTML pages
+are stored in the current directory, or in the directory specified
+with the {\bf\tt -d} option.   You can customize the style of the
+generated pages by editing the generated "style.css" file, or by providing
+your own style sheet using option "-css-style".
+The file "style.css" is not generated if it already exists or if -css-style is used.
+
+\item["-latex"]
+Generate documentation in \LaTeX\ default format.  The generated
+\LaTeX\ document is saved in file "ocamldoc.out", or in the file
+specified with the {\bf\tt -o} option.  The document uses the style file
+"ocamldoc.sty". This file is generated when using the "-latex" option,
+if it does not already exist.
+You can change this file to  customize the style of your \LaTeX\ documentation.
+
+\item["-texi"]
+Generate documentation in TeXinfo default format.  The generated
+\LaTeX\ document is saved in file "ocamldoc.out", or in the file
+specified with the {\bf\tt -o} option.
+
+\item["-man"]
+Generate documentation as a set of Unix "man" pages.  The generated pages
+are stored in the current directory, or in the directory specified
+with the {\bf\tt -d} option.
+
+\item["-dot"]
+Generate a dependency graph for the toplevel modules, in a format suitable
+for displaying and processing by "dot". The "dot" tool is available from
+\url{https://graphviz.org/}.
+The textual representation of the graph is written to the file
+"ocamldoc.out", or to the file specified with the {\bf\tt -o} option.
+Use "dot ocamldoc.out" to display it.
+
+\item["-g" \var{file.cm[o,a,xs]}]
+Dynamically load the given file, which defines a custom documentation
+generator.  See section \ref{ss:ocamldoc-compilation-and-usage}.  This
+option is supported by the "ocamldoc" command (to load ".cmo" and ".cma" files)
+and by its native-code version "ocamldoc.opt" (to load ".cmxs" files).
+If the given file is a simple one and does not exist in
+the current directory, then ocamldoc looks for it in the custom
+generators default directory, and in the directories specified with
+optional "-i" options.
+
+\item["-customdir"]
+Display the custom generators default directory.
+
+\item["-i" \var{directory}]
+Add the given directory to the path where to look for custom generators.
+
+\end{options}
+
+\subsubsection*{sss:ocamldoc-options}{General options}
+
+\begin{options}
+
+\item["-d" \var{dir}]
+Generate files in directory \var{dir}, rather than the current directory.
+
+\item["-dump" \var{file}]
+Dump collected information into \var{file}.  This information can be
+read with the "-load" option in a subsequent invocation of "ocamldoc".
+
+\item["-hide" \var{modules}]
+Hide the given complete module names in the generated documentation.
+\var{modules} is a list of complete module names separated
+ by '","', without blanks.  For instance: "Stdlib,M2.M3".
+
+\item["-inv-merge-ml-mli"]
+Reverse the precedence of implementations and interfaces when merging.
+All elements
+in implementation files are kept, and the {\bf\tt -m} option
+indicates which parts of the comments in interface files are merged
+with the comments in implementation files.
+
+\item["-keep-code"]
+Always keep the source code for values, methods and instance variables,
+when available.
+
+\item["-load" \var{file}]
+Load information from \var{file}, which has been produced by
+"ocamldoc -dump".  Several "-load" options can be given.
+
+\item["-m" \var{flags}]
+Specify merge options between interfaces and implementations.
+(see section \ref{ss:ocamldoc-merge} for details).
+\var{flags} can be one or several of the following characters:
+\begin{options}
+        \item["d"] merge description
+        \item["a"] merge "\@author"
+        \item["v"] merge "\@version"
+        \item["l"] merge "\@see"
+        \item["s"] merge "\@since"
+        \item["b"] merge "\@before"
+        \item["o"] merge "\@deprecated"
+        \item["p"] merge "\@param"
+        \item["e"] merge "\@raise"
+        \item["r"] merge "\@return"
+        \item["A"] merge everything
+\end{options}
+
+\item["-no-custom-tags"]
+Do not allow custom \@-tags (see section \ref{ss:ocamldoc-tags}).
+
+\item["-no-stop"]
+Keep elements placed after/between the "(**/**)" special comment(s)
+(see section \ref{s:ocamldoc-comments}).
+
+\item["-o" \var{file}]
+Output the generated documentation to \var{file} instead of "ocamldoc.out".
+This option is meaningful only in conjunction with the
+{\bf\tt -latex}, {\bf\tt -texi}, or {\bf\tt -dot} options.
+
+\item["-pp" \var{command}]
+Pipe sources through preprocessor \var{command}.
+
+\item["-impl" \var{filename}]
+Process the file \var{filename} as an implementation file, even if its
+extension is not ".ml".
+
+\item["-intf" \var{filename}]
+Process the file \var{filename} as an interface file, even if its
+extension is not ".mli".
+
+\item["-text" \var{filename}]
+Process the file \var{filename} as a text file, even if its
+extension is not ".txt".
+
+\item["-sort"]
+Sort the list of top-level modules before generating the documentation.
+
+\item["-stars"]
+Remove blank characters until the first asterisk ('"*"') in each
+line of comments.
+
+\item["-t" \var{title}]
+Use \var{title} as the title for the generated documentation.
+
+\item["-intro" \var{file}]
+Use content of \var{file} as ocamldoc text to use as introduction (HTML,
+\LaTeX{} and TeXinfo only).
+For HTML, the file is used to create the whole "index.html" file.
+
+\item["-v"]
+Verbose mode. Display progress information.
+
+\item["-version"]
+Print version string and exit.
+
+\item["-vnum"]
+Print short version number and exit.
+
+\item["-warn-error"]
+Treat Ocamldoc warnings as errors.
+
+\item["-hide-warnings"]
+Do not print OCamldoc warnings.
+
+\item["-help" or "--help"]
+Display a short usage summary and exit.
+%
+\end{options}
+
+\subsubsection*{sss:ocamldoc-type-checking}{Type-checking options}
+
+OCamldoc calls the OCaml type-checker to obtain type
+information.  The following options impact the type-checking phase.
+They have the same meaning as for the "ocamlc" and "ocamlopt" commands.
+
+\begin{options}
+
+\item["-I" \var{directory}]
+Add \var{directory} to the list of directories search for compiled
+interface files (".cmi" files).
+
+\item["-nolabels"]
+Ignore non-optional labels in types.
+
+\item["-rectypes"]
+Allow arbitrary recursive types.  (See the "-rectypes" option to "ocamlc".)
+
+\end{options}
+
+\subsubsection*{sss:ocamldoc-html}{Options for generating HTML pages}
+
+The following options apply in conjunction with the "-html" option:
+
+\begin{options}
+\item["-all-params"]
+Display the complete list of parameters for functions and methods.
+
+\item["-charset" \var{charset}]
+Add information about character encoding being \var{charset}
+(default is iso-8859-1).
+
+\item["-colorize-code"]
+Colorize the OCaml code enclosed in "[ ]" and "{[ ]}", using colors
+to emphasize keywords, etc.  If the code fragments are not
+syntactically correct, no color is added.
+
+\item["-css-style" \var{filename}]
+Use \var{filename} as the Cascading Style Sheet file.
+
+\item["-index-only"]
+Generate only index files.
+
+\item["-short-functors"]
+Use a short form to display functors:
+\begin{alltt}
+module M : functor (A:Module) -> functor (B:Module2) -> sig .. end
+\end{alltt}
+is displayed as:
+\begin{alltt}
+module M (A:Module) (B:Module2) : sig .. end
+\end{alltt}
+
+\end{options}
+
+\subsubsection*{sss:ocamldoc-latex}{Options for generating \LaTeX\ files}
+
+The following options apply in conjunction with the "-latex" option:
+
+\begin{options}
+\item["-latex-value-prefix" \var{prefix}]
+Give a prefix to use for the labels of the values in the generated
+\LaTeX\ document.
+The default prefix is the empty string. You can also use the options
+{\tt -latex-type-prefix}, {\tt -latex-exception-prefix},
+{\tt -latex-module-prefix},
+{\tt -latex-module-type-prefix}, {\tt -latex-class-prefix},
+{\tt -latex-class-type-prefix},
+{\tt -latex-attribute-prefix} and {\tt -latex-method-prefix}.
+
+These options are useful when you have, for example, a type and a value with
+ the same name. If you do not specify prefixes, \LaTeX\ will complain about
+multiply defined labels.
+
+\item["-latextitle" \var{n,style}]
+Associate style number \var{n} to the given \LaTeX\ sectioning command
+\var{style}, e.g. "section" or "subsection".  (\LaTeX\ only.)  This is
+useful when including the generated document in another \LaTeX\ document,
+at a given sectioning level.  The default association is 1 for "section",
+2 for "subsection", 3 for "subsubsection", 4 for "paragraph" and 5 for
+"subparagraph".
+
+\item["-noheader"]
+Suppress header in generated documentation.
+
+\item["-notoc"]
+Do not generate a table of contents.
+
+\item["-notrailer"]
+Suppress trailer in generated documentation.
+
+\item["-sepfiles"]
+Generate one ".tex" file per toplevel module, instead of the global
+"ocamldoc.out" file.
+\end{options}
+
+\subsubsection*{sss:ocamldoc-info}{Options for generating TeXinfo files}
+
+The following options apply in conjunction with the "-texi" option:
+
+\begin{options}
+\item["-esc8"]
+Escape accented characters in Info files.
+
+\item["-info-entry"]
+Specify Info directory entry.
+
+\item["-info-section"]
+Specify section of Info directory.
+
+\item["-noheader"]
+Suppress header in generated documentation.
+
+\item["-noindex"]
+Do not build index for Info files.
+
+\item["-notrailer"]
+Suppress trailer in generated documentation.
+\end{options}
+
+\subsubsection*{sss:ocamldoc-dot}{Options for generating "dot" graphs}
+
+The following options apply in conjunction with the "-dot" option:
+
+\begin{options}
+\item["-dot-colors" \var{colors}]
+Specify the colors to use in the generated "dot" code.
+When generating module dependencies, "ocamldoc" uses different colors
+for modules, depending on the directories in which they reside.
+When generating types dependencies, "ocamldoc" uses different colors
+for types, depending on the modules in which they are defined.
+\var{colors} is a list of color names separated by '","', as
+in "Red,Blue,Green". The available colors are the ones supported by
+the "dot" tool.
+
+\item["-dot-include-all"]
+Include all modules in the "dot" output, not only modules given
+on the command line or loaded with the {\bf\tt -load} option.
+
+\item["-dot-reduce"]
+Perform a transitive reduction of the dependency graph before
+outputting the "dot" code. This can be useful if there are
+a lot of transitive dependencies that clutter the graph.
+
+\item["-dot-types"]
+Output "dot" code describing the type dependency graph instead of
+the module dependency graph.
+\end{options}
+
+\subsubsection*{sss:ocamldoc-man}{Options for generating man files}
+
+The following options apply in conjunction with the "-man" option:
+
+\begin{options}
+\item["-man-mini"]
+Generate man pages only for modules, module types, classes and class
+types, instead of pages for all elements.
+
+\item["-man-suffix" \var{suffix}]
+Set the suffix used for generated man filenames. Default is '"3o"',
+as in "List.3o".
+
+\item["-man-section" \var{section}]
+Set the section number used for generated man filenames. Default is '"3"'.
+
+\end{options}
+
+\subsection{ss:ocamldoc-merge}{Merging of module information}
+
+Information on a module can be extracted either from the ".mli" or ".ml"
+file, or both, depending on the files given on the command line.
+When both ".mli" and ".ml" files are given for the same module,
+information extracted from these files is merged according to the
+following rules:
+\begin{itemize}
+\item Only elements (values, types, classes, ...) declared in the ".mli"
+file are kept.  In other terms, definitions from the ".ml" file that are
+not exported in the ".mli" file are not documented.
+\item Descriptions of elements and descriptions in \@-tags are handled
+as follows.  If a description for the same element or in the same
+\@-tag of the same element is present in both files, then the
+description of the ".ml" file is concatenated to the one in the ".mli" file,
+if the corresponding "-m" flag is given on the command line.
+If a description is present in the ".ml" file and not in the
+".mli" file, the ".ml" description is kept.
+In either case, all the information given in the ".mli" file is kept.
+\end{itemize}
+
+\subsection{ss:ocamldoc-rules}{Coding rules}
+The following rules must be respected in order to avoid name clashes
+resulting in cross-reference errors:
+\begin{itemize}
+\item In a module, there must not be two modules, two module types or
+  a module and a module type with the same name.
+  In the default HTML generator, modules "ab" and "AB" will be printed
+  to the same file on case insensitive file systems.
+\item In a module, there must not be two classes, two class types or
+  a class and a class type with the same name.
+\item In a module, there must not be two values, two types, or two
+  exceptions with the same name.
+\item Values defined in tuple, as in "let (x,y,z) = (1,2,3)"
+are not kept by OCamldoc.
+\item Avoid the following construction:
+\begin{caml_eval}
+module Foo = struct module Bar = struct let x = 1 end end;;
+\end{caml_eval}
+\begin{caml_example*}{verbatim}
+open Foo (* which has a module Bar with a value x *)
+module Foo =
+  struct
+    module Bar =
+      struct
+        let x = 1
+      end
+  end
+  let dummy = Bar.x
+\end{caml_example*}
+In this case, OCamldoc will associate "Bar.x" to the "x" of module
+"Foo" defined just above, instead of to the "Bar.x" defined in the
+opened module "Foo".
+\end{itemize}
+
+\section{s:ocamldoc-comments}{Syntax of documentation comments}
+
+Comments containing documentation material are called {\em special
+comments} and are written between "(**" and "*)". Special comments
+must start exactly with "(**".  Comments beginning with "(" and more
+than two "*" are ignored.
+
+\subsection{ss:ocamldoc-placement}{Placement of documentation comments}
+OCamldoc can associate comments to some elements of the language
+encountered in the source files.  The association is made according to
+the locations of comments with respect to the language elements.  The
+locations of comments in ".mli" and ".ml" files are different.
+
+%%%%%%%%%%%%%
+\subsubsection{sss:ocamldoc-mli}{Comments in ".mli" files}
+A special comment is associated to an element if it is placed before or
+after the element.\\
+A special comment before an element is associated to this element if~:
+\begin{itemize}
+\item There is no blank line or another special comment between the special
+comment and the element. However, a regular comment can occur between
+the special comment and the element.
+\item The special comment is not already associated to the previous element.
+\item The special comment is not the first one of a toplevel module.
+\end{itemize}
+
+A special comment after an element is associated to this element if
+there is no blank line or comment between the special comment and the
+element.
+
+There are two exceptions: for constructors and record fields in
+type definitions, the associated comment can only be placed after the
+constructor or field definition, without blank lines or other comments
+between them. The special comment for a constructor
+with another constructor following must be placed before the '"|"'
+character separating the two constructors.
+
+The following sample interface file "foo.mli" illustrates the
+placement rules for comments in ".mli" files.
+
+\begin{caml_eval}
+class cl = object end
+\end{caml_eval}
+\begin{caml_example*}{signature}
+(** The first special comment of the file is the comment associated
+    with the whole module.*)
+
+
+(** Special comments can be placed between elements and are kept
+    by the OCamldoc tool, but are not associated to any element.
+    @-tags in these comments are ignored.*)
+
+(*******************************************************************)
+(** Comments like the one above, with more than two asterisks,
+    are ignored. *)
+
+(** The comment for function f. *)
+val f : int -> int -> int
+(** The continuation of the comment for function f. *)
+
+(** Comment for exception My_exception, even with a simple comment
+    between the special comment and the exception.*)
+(* Hello, I'm a simple comment :-) *)
+exception My_exception of (int -> int) * int
+
+(** Comment for type weather  *)
+type weather =
+| Rain of int (** The comment for constructor Rain *)
+| Sun (** The comment for constructor Sun *)
+
+(** Comment for type weather2  *)
+type weather2 =
+| Rain of int (** The comment for constructor Rain *)
+| Sun (** The comment for constructor Sun *)
+(** I can continue the comment for type weather2 here
+  because there is already a comment associated to the last constructor.*)
+
+(** The comment for type my_record *)
+type my_record = {
+    foo : int ;    (** Comment for field foo *)
+    bar : string ; (** Comment for field bar *)
+  }
+  (** Continuation of comment for type my_record *)
+
+(** Comment for foo *)
+val foo : string
+(** This comment is associated to foo and not to bar. *)
+val bar : string
+(** This comment is associated to bar. *)
+
+(** The comment for class my_class *)
+class my_class :
+  object
+    (** A comment to describe inheritance from cl *)
+    inherit cl
+
+    (** The comment for attribute tutu *)
+    val mutable tutu : string
+
+    (** The comment for attribute toto. *)
+    val toto : int
+
+    (** This comment is not attached to titi since
+        there is a blank line before titi, but is kept
+        as a comment in the class. *)
+
+    val titi : string
+
+    (** Comment for method toto *)
+    method toto : string
+
+    (** Comment for method m *)
+    method m : float -> int
+  end
+
+(** The comment for the class type my_class_type *)
+class type my_class_type =
+  object
+    (** The comment for variable x. *)
+    val mutable x : int
+
+    (** The comment for method m. *)
+    method m : int -> int
+end
+
+(** The comment for module Foo *)
+module Foo :
+  sig
+    (** The comment for x *)
+    val x : int
+
+    (** A special comment that is kept but not associated to any element *)
+  end
+
+(** The comment for module type my_module_type. *)
+module type my_module_type =
+  sig
+    (** The comment for value x. *)
+    val x : int
+
+    (** The comment for module M. *)
+    module M :
+      sig
+        (** The comment for value y. *)
+        val y : int
+
+        (* ... *)
+      end
+
+  end
+
+\end{caml_example*}
+
+%%%%%%%%%%%%%
+\subsubsection{sss:ocamldoc-comments-ml}{Comments in {\tt .ml} files}
+
+A special comment is associated to an element if it is placed before
+the element and there is no blank line between the comment and the
+element. Meanwhile, there can be a simple comment between the special
+comment and the element. There are two exceptions, for
+constructors and record fields in type definitions, whose associated
+comment must be placed after the constructor or field definition,
+without blank line between them. The special comment for a constructor
+with another constructor following must be placed before the '"|"'
+character separating the two constructors.
+
+The following example of file "toto.ml" shows where to place comments
+in a ".ml" file.
+
+\begin{caml_example*}{verbatim}
+(** The first special comment of the file is the comment associated
+    to the whole module. *)
+
+(** The comment for function f *)
+let f x y = x + y
+
+(** This comment is not attached to any element since there is another
+    special comment just before the next element. *)
+
+(** Comment for exception My_exception, even with a simple comment
+    between the special comment and the exception.*)
+(* A simple comment. *)
+exception My_exception of (int -> int) * int
+
+(** Comment for type weather  *)
+type weather =
+| Rain of int (** The comment for constructor Rain *)
+| Sun (** The comment for constructor Sun *)
+
+(** The comment for type my_record *)
+type my_record = {
+    foo : int ;    (** Comment for field foo *)
+    bar : string ; (** Comment for field bar *)
+  }
+
+(** The comment for class my_class *)
+class my_class =
+    object
+      (** A comment to describe inheritance from cl *)
+      inherit cl
+
+      (** The comment for the instance variable tutu *)
+      val mutable tutu = "tutu"
+      (** The comment for toto *)
+      val toto = 1
+      val titi = "titi"
+      (** Comment for method toto *)
+      method toto = tutu ^ "!"
+      (** Comment for method m *)
+      method m (f : float) = 1
+    end
+
+(** The comment for class type my_class_type *)
+class type my_class_type =
+  object
+    (** The comment for the instance variable x. *)
+    val mutable x : int
+    (** The comment for method m. *)
+    method m : int -> int
+  end
+
+(** The comment for module Foo *)
+module Foo =
+  struct
+    (** The comment for x *)
+    let x = 0
+    (** A special comment in the class, but not associated to any element. *)
+  end
+
+(** The comment for module type my_module_type. *)
+module type my_module_type =
+  sig
+    (* Comment for value x. *)
+    val x : int
+    (* ... *)
+  end
+\end{caml_example}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{ss:ocamldoc-stop}{The Stop special comment}
+The special comment "(**/**)" tells OCamldoc to discard
+elements placed after this comment, up to the end of the current
+class, class type,  module or module type, or up to the next stop comment.
+For instance:
+\begin{caml_example*}{signature}
+class type foo =
+  object
+    (** comment for method m *)
+    method m : string
+
+    (**/**)
+
+    (** This method won't appear in the documentation *)
+    method bar : int
+  end
+
+(** This value appears in the documentation, since the Stop special comment
+    in the class does not affect the parent module of the class.*)
+val foo : string
+
+(**/**)
+(** The value bar does not appear in the documentation.*)
+val bar : string
+(**/**)
+
+(** The type t appears since in the documentation since the previous stop comment
+toggled off the "no documentation mode". *)
+type t = string
+\end{caml_example*}
+
+The {\bf\tt -no-stop} option to "ocamldoc" causes the Stop special
+comments to be ignored.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{ss:ocamldoc-syntax}{Syntax of documentation comments}
+
+The inside of documentation comments "(**"\ldots"*)" consists of
+free-form text with optional formatting annotations, followed by
+optional {\em tags} giving more specific information about parameters,
+version, authors, \ldots\ The tags are distinguished by a leading "\@"
+character.  Thus, a documentation comment has the following shape:
+\begin{verbatim}
+(** The comment begins with a description, which is text formatted
+   according to the rules described in the next section.
+   The description continues until the first non-escaped '@' character.
+   @author Mr Smith
+   @param x description for parameter x
+*)
+\end{verbatim}
+Some elements support only a subset of all \@-tags.  Tags that are not
+relevant to the documented element are simply ignored.  For instance,
+all tags are ignored when documenting type constructors, record
+fields, and class inheritance clauses.  Similarly, a "\@param" tag on a
+class instance variable is ignored.
+
+At last, "(**)" is the empty documentation comment.
+
+%%%%%%%%%%%%%
+
+% enable section numbering for subsubsections (PR#6189, item 3)
+\setcounter{secnumdepth}{3}
+
+\subsection{ss:ocamldoc-formatting}{Text formatting}
+
+Here is the BNF grammar for the simple markup language used to format
+text descriptions.
+
+\newpage
+
+\begin{syntax}
+text: {{text-element}}
+;
+\end{syntax}
+
+\noindent
+\begin{syntaxleft}
+\nonterm{text-element}\is{}
+\end{syntaxleft}
+
+\begin{tabular}{rlp{10cm}}
+@||@&@ '{' {{ "0" \ldots "9" }} text '}' @ & format @text@ as a section header;
+  the integer following "{" indicates the sectioning level. \\
+@||@&@ '{' {{ "0" \ldots "9" }} ':' @ \nt{label} @ text '}' @ &
+  same, but also associate the name \nt{label} to the current point.
+  This point can be referenced by its fully-qualified label in a
+  "{!" command, just like any other element. \\
+@||@&@ '{b' text '}' @ & set @text@ in bold. \\
+@||@&@ '{i' text '}' @ & set @text@ in italic. \\
+@||@&@ '{e' text '}' @ & emphasize @text@. \\
+@||@&@ '{C' text '}' @ & center @text@. \\
+@||@&@ '{L' text '}' @ & left align @text@. \\
+@||@&@ '{R' text '}' @ & right align @text@. \\
+@||@&@ '{ul' list '}' @ & build a list. \\
+@||@&@ '{ol' list '}' @ & build an enumerated list. \\
+@||@&@ '{{:' string '}' text '}' @ & put a link to the given address
+(given as @string@) on the given @text@. \\
+@||@&@ '[' string ']' @ & set the given @string@ in source code style. \\
+@||@&@ '{[' string ']}' @ & set the given @string@ in preformatted
+				source code style.\\
+@||@&@ '{v' string 'v}' @ & set the given @string@ in verbatim style. \\
+@||@&@ '{%' string '%}' @ & target-specific content
+        (\LaTeX\ code by default, see details
+        in \ref{sss:ocamldoc-target-specific-syntax}) \\
+@||@&@ '{!' string '}' @ & insert a cross-reference to an element
+        (see section \ref{sss:ocamldoc-crossref} for the syntax of cross-references).\\
+@||@&@ '{!modules:' string string ... '}' @ & insert an index table
+for the given module names. Used in HTML only.\\
+@||@&@ '{!indexlist}' @ & insert a table of links to the various indexes
+(types, values, modules, ...). Used in HTML only.\\
+@||@&@ '{^' text '}' @ & set text in superscript.\\
+@||@&@ '{_' text '}' @ & set text in subscript.\\
+@||@& \nt{escaped-string} & typeset the given string as is;
+special characters ('"{"', '"}"', '"["', '"]"' and '"\@"')
+must be	escaped by a '"\\"'\\
+@||@& \nt{blank-line} & force a new line.
+\end{tabular} \\
+
+\subsubsection{sss:ocamldoc-list}{List formatting}
+
+\begin{syntax}
+list:
+| {{ '{-' text '}' }}
+| {{ '{li' text '}' }}
+\end{syntax}
+
+A shortcut syntax exists for lists and enumerated lists:
+\begin{verbatim}
+(** Here is a {b list}
+- item 1
+- item 2
+- item 3
+
+The list is ended by the blank line.*)
+\end{verbatim}
+is equivalent to:
+\begin{verbatim}
+(** Here is a {b list}
+{ul {- item 1}
+{- item 2}
+{- item 3}}
+The list is ended by the blank line.*)
+\end{verbatim}
+
+The same shortcut is available for enumerated lists, using '"+"'
+instead of '"-"'.
+Note that only one list can be defined by this shortcut in nested lists.
+
+\subsubsection{sss:ocamldoc-crossref}{Cross-reference formatting}
+
+Cross-references are fully qualified element names, as in the example
+"{!Foo.Bar.t}". This is an ambiguous reference as it may designate
+a type name, a value name, a class name, etc. It is possible to make
+explicit the intended syntactic class, using "{!type:Foo.Bar.t}" to
+designate a type, and "{!val:Foo.Bar.t}" a value of the same name.
+
+The list of possible syntactic class is as follows:
+\begin{center}
+\begin{tabular}{rl}
+\multicolumn{1}{c}{"tag"} & \multicolumn{1}{c}{syntactic class}\\ \hline
+"module:" & module \\
+"modtype:" & module type \\
+"class:" & class \\
+"classtype:" & class type \\
+"val:" & value \\
+"type:" & type \\
+"exception:" & exception \\
+"attribute:" & attribute \\
+"method:" & class method \\
+"section:" & ocamldoc section \\
+"const:" & variant constructor \\
+"recfield:" & record field
+\end{tabular}
+\end{center}
+
+In the case of variant constructors or record field, the constructor
+or field name should be preceded by the name of the correspond type --
+to avoid the ambiguity of several types having the same constructor
+names. For example, the constructor "Node" of the type "tree" will be
+referenced as "{!tree.Node}" or "{!const:tree.Node}", or possibly
+"{!Mod1.Mod2.tree.Node}" from outside the module.
+
+\subsubsection{sss:ocamldoc-preamble}{First sentence}
+
+In the description of a value, type, exception, module, module type, class
+or class type, the {\em first sentence} is sometimes used in indexes, or
+when just a part of the description is needed. The first sentence
+is composed of the first characters of the description, until
+\begin{itemize}
+\item the first dot followed by a blank, or
+\item the first blank line
+\end{itemize}
+outside of the following text formatting :
+@ '{ul' list '}' @,
+@ '{ol' list '}' @,
+@ '[' string ']' @,
+@ '{[' string ']}' @,
+@ '{v' string 'v}' @,
+@ '{%' string '%}' @,
+@ '{!' string '}' @,
+@ '{^' text '}' @,
+@ '{_' text '}' @.
+
+\subsubsection{sss:ocamldoc-target-specific-syntax}{Target-specific formatting}
+
+The content inside "{%foo: ... %}" is target-specific and will only be
+interpreted by the backend "foo", and ignored by the others. The
+backends of the distribution are "latex", "html", "texi" and "man". If
+no target is specified (syntax "{% ... %}"), "latex" is chosen by
+default. Custom generators may support their own target prefix.
+
+\subsubsection{sss:ocamldoc-html-tags}{Recognized HTML tags}
+The HTML tags  "..",
+"..",
+"..",
+"
    ..
",
+"
    ..
",
+"
  • ..
    • ",
+"
    ..
    " and
+".." can be used instead of, respectively,
+@ '{b ..}' @,
+@ '[..]' @,
+@ '{i ..}' @,
+@ '{ul ..}' @,
+@ '{ol ..}' @,
+@ '{li ..}' @,
+@ '{C ..}' @ and
+"{[0-9] ..}".
+
+%disable section numbering for subsubsections
+\setcounter{secnumdepth}{2}
+
+%%%%%%%%%%%%%
+\subsection{ss:ocamldoc-tags}{Documentation tags (\@-tags)}
+
+
+\subsubsection{sss:ocamldoc-builtin-tags}{Predefined tags}
+The following table gives the list of predefined \@-tags, with their
+syntax and meaning.\\
+
+\begin{tabular}{|p{5cm}|p{10cm}|}\hline
+@ "@author" string @ & The author of the element. One author per
+"\@author" tag.
+There may be several "\@author" tags for the same element. \\ \hline
+
+@ "@deprecated" text @ & The @text@ should describe when the element was
+deprecated, what to use as a replacement, and possibly the reason
+for deprecation. \\ \hline
+
+@ "@param" id text @ & Associate the given description (@text@) to the
+given parameter name @id@. This tag is used for functions,
+methods, classes and functors. \\ \hline
+
+@ "@raise" Exc text @ & Explain that the element may raise
+ the exception @Exc@. \\ \hline
+
+@ "@return" text @ & Describe the return value and
+ its possible values. This tag is used for functions
+ and methods. \\ \hline
+
+@ "@see" '<' URL '>' text @ &  Add a reference to the @URL@
+with the given @text@ as comment. \\ \hline
+
+@ "@see" "'"@\nt{filename}@"'" text @ &  Add a reference to the given file name
+(written between single quotes), with the given @text@ as comment. \\ \hline
+
+@ "@see" '"'@\nt{document-name}@'"' text @ &  Add a reference to the given
+document name (written between double quotes), with the given @text@
+as comment. \\ \hline
+
+@ "@since" string @ & Indicate when the element was introduced. \\ \hline
+
+@ "@before" @ \nt{version} @ text @ & Associate the given description (@text@)
+to the given \nt{version} in order to document compatibility issues. \\ \hline
+
+@ "@version" string @ & The version number for the element. \\ \hline
+\end{tabular}
+
+\subsubsection{sss:ocamldoc-custom-tags}{Custom tags}
+You can use custom tags in the documentation comments, but they will
+have no effect if the generator used does not handle them. To use a
+custom tag,  for example "foo", just put "\@foo" with some text in your
+comment, as in:
+\begin{verbatim}
+(** My comment to show you a custom tag.
+@foo this is the text argument to the [foo] custom tag.
+*)
+\end{verbatim}
+
+To handle custom tags, you need to define a custom generator,
+as explained in section \ref{ss:ocamldoc-handling-custom-tags}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{s:ocamldoc-custom-generators}{Custom generators}
+
+OCamldoc operates in two steps:
+\begin{enumerate}
+\item analysis of the source files;
+\item generation of documentation, through a documentation generator,
+	which is an object of class "Odoc_args.class_generator".
+\end{enumerate}
+Users can provide their own documentation generator to be used during
+step 2 instead of the default generators.
+All the information retrieved during the analysis step is available through
+the "Odoc_info" module, which gives access to all the types and functions
+ representing the elements found in the given modules, with their associated
+description.
+
+The files you can use to define custom generators are installed in the
+"ocamldoc" sub-directory of the OCaml standard library.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{ss:ocamldoc-generators}{The generator modules}
+The type of a generator module depends on the kind of generated documentation.
+Here is the list of generator module types, with the name of the generator
+class in the module~:
+\begin{itemize}
+\item for HTML~: "Odoc_html.Html_generator" (class "html"),
+\item for \LaTeX~: "Odoc_latex.Latex_generator" (class "latex"),
+\item for TeXinfo~: "Odoc_texi.Texi_generator" (class "texi"),
+\item for man pages~: "Odoc_man.Man_generator" (class "man"),
+\item for graphviz (dot)~: "Odoc_dot.Dot_generator" (class "dot"),
+\item for other kinds~: "Odoc_gen.Base" (class "generator").
+\end{itemize}
+That is, to define a new generator, one must implement a module with
+the expected signature, and with the given generator class, providing
+the "generate" method as entry point to make the generator generates
+documentation for a given list of modules~:
+
+\begin{verbatim}
+        method generate : Odoc_info.Module.t_module list -> unit
+\end{verbatim}
+
+\noindent{}This method will be called with the list of analysed and possibly
+merged "Odoc_info.t_module" structures.
+
+It is recommended to inherit from the current generator of the same
+kind as the one you want to define. Doing so, it is possible to
+load various custom generators to combine improvements brought by each one.
+
+This is done using first class modules (see chapter \ref{s:first-class-modules}).
+
+The easiest way to define a custom generator is the following this example,
+here extending the current HTML generator. We don't have to know if this is
+the original HTML generator defined in ocamldoc or if it has been extended
+already by a previously loaded custom generator~:
+
+\begin{verbatim}
+module Generator (G : Odoc_html.Html_generator) =
+struct
+  class html =
+    object(self)
+      inherit G.html as html
+      (* ... *)
+
+      method generate module_list =
+        (* ... *)
+        ()
+
+      (* ... *)
+  end
+end;;
+
+let _ = Odoc_args.extend_html_generator (module Generator : Odoc_gen.Html_functor);;
+\end{verbatim}
+
+To know which methods to override and/or which methods are available,
+have a look at the different base implementations, depending on the
+kind of generator you are extending~:
+\newcommand\ocamldocsrc[2]{\href{https://github.com/ocaml/ocaml/blob/{\ocamlversion}/ocamldoc/odoc_#1.ml}{#2}}
+\begin{itemize}
+\item for HTML~: \ocamldocsrc{html}{"odoc_html.ml"},
+\item for \LaTeX~: \ocamldocsrc{latex}{"odoc_latex.ml"},
+\item for TeXinfo~: \ocamldocsrc{texi}{"odoc_texi.ml"},
+\item for man pages~: \ocamldocsrc{man}{"odoc_man.ml"},
+\item for graphviz (dot)~: \ocamldocsrc{dot}{"odoc_dot.ml"}.
+\end{itemize}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{ss:ocamldoc-handling-custom-tags}{Handling custom tags}
+
+Making a custom generator handle custom tags (see
+\ref{sss:ocamldoc-custom-tags}) is very simple.
+
+\subsubsection*{sss:ocamldoc-html-generator}{For HTML}
+Here is how to develop a HTML generator handling your custom tags.
+
+The class "Odoc_html.Generator.html" inherits
+from the class "Odoc_html.info", containing a field "tag_functions" which is a
+list pairs composed of a custom tag (e.g. "\"foo\"") and a function taking
+a "text" and returning HTML code (of type "string").
+To handle a new tag "bar", extend the current HTML generator
+ and complete the "tag_functions" field:
+\begin{verbatim}
+module Generator (G : Odoc_html.Html_generator) =
+struct
+  class html =
+    object(self)
+      inherit G.html
+
+      (** Return HTML code for the given text of a bar tag. *)
+      method html_of_bar t = (* your code here *)
+
+      initializer
+        tag_functions <- ("bar", self#html_of_bar) :: tag_functions
+  end
+end
+let _ = Odoc_args.extend_html_generator (module Generator : Odoc_gen.Html_functor);;
+\end{verbatim}
+
+Another method of the class "Odoc_html.info" will look for the
+function associated to a custom tag and apply it to the text given to
+the tag. If no function is associated to a custom tag, then the method
+prints a warning message on "stderr".
+
+\subsubsection{sss:ocamldoc-other-generators}{For other generators}
+You can act the same way for other kinds of generators.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{s:ocamldoc-adding-flags}{Adding command line options}
+The command line analysis is performed after loading the module containing the
+documentation generator, thus allowing command line options to be added to the
+ list of existing ones. Adding an option can be done with the function
+\begin{verbatim}
+        Odoc_args.add_option : string * Arg.spec * string -> unit
+\end{verbatim}
+\noindent{}Note: Existing command line options can be redefined using
+this function.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{ss:ocamldoc-compilation-and-usage}{Compilation and usage}
+
+%%%%%%%%%%%%%%
+\subsubsection{sss:ocamldoc-generator-class}{Defining a custom generator class in one file}
+Let "custom.ml" be the file defining a new generator class.
+Compilation of "custom.ml" can be performed by the following command~:
+\begin{alltt}
+        ocamlc -I +ocamldoc -c custom.ml
+\end{alltt}
+\noindent{}The file "custom.cmo" is created and can be used this way~:
+\begin{alltt}
+        ocamldoc -g custom.cmo \var{other-options} \var{source-files}
+\end{alltt}
+\noindent{}Options selecting a built-in generator to "ocamldoc", such as
+"-html", have no effect if a custom generator of the same kind is provided using
+"-g". If the kinds do not match, the selected built-in generator is used and the
+custom one is ignored.
+
+%%%%%%%%%%%%%%
+\subsubsection{sss:ocamldoc-modular-generator}{Defining a custom generator class in several files}
+It is possible to define a generator class in several modules, which
+are defined in several files \var{\nth{file}{1}}".ml"["i"],
+\var{\nth{file}{2}}".ml"["i"], ..., \var{\nth{file}{n}}".ml"["i"]. A ".cma"
+library file must be created, including all these files.
+
+The following commands create the "custom.cma" file from files
+\var{\nth{file}{1}}".ml"["i"], ..., \var{\nth{file}{n}}".ml"["i"]~:
+\begin{alltt}
+ocamlc -I +ocamldoc -c \var{\nth{file}{1}}.ml\textrm{[}i\textrm{]}
+ocamlc -I +ocamldoc -c \var{\nth{file}{2}}.ml\textrm{[}i\textrm{]}
+...
+ocamlc -I +ocamldoc -c \var{\nth{file}{n}}.ml\textrm{[}i\textrm{]}
+ocamlc -o custom.cma -a \var{\nth{file}{1}}.cmo \var{\nth{file}{2}}.cmo ... \var{\nth{file}{n}}.cmo
+\end{alltt}
+\noindent{}Then, the following command uses "custom.cma" as custom generator:
+\begin{alltt}
+        ocamldoc -g custom.cma \var{other-options} \var{source-files}
+\end{alltt}
diff --git a/manual/manual/cmds/profil.etex b/manual/manual/cmds/profil.etex
new file mode 100644
index 00000000..7826fab3
--- /dev/null
+++ b/manual/manual/cmds/profil.etex
@@ -0,0 +1,146 @@
+\chapter{Profiling (ocamlprof)} \label{c:profiler}
+%HEVEA\cutname{profil.html}
+
+This chapter describes how the execution of OCaml
+programs can be profiled, by recording how many times functions are
+called, branches of conditionals are taken, \ldots
+
+\section{s:ocamlprof-compiling}{Compiling for profiling}
+
+Before profiling an execution, the program must be compiled in
+profiling mode, using the "ocamlcp" front-end to the "ocamlc" compiler
+(see chapter~\ref{c:camlc}) or the "ocamloptp" front-end to the
+"ocamlopt" compiler (see chapter~\ref{c:nativecomp}). When compiling
+modules separately, "ocamlcp" or "ocamloptp" must be used when
+compiling the modules (production of ".cmo" or ".cmx" files), and can
+also be used (though this is not strictly necessary) when linking them
+together.
+
+\lparagraph{p:ocamlprof-warning}{Note} If a module (".ml" file) doesn't have a corresponding
+interface (".mli" file), then compiling it with "ocamlcp" will produce
+object files (".cmi" and ".cmo") that are not compatible with the ones
+produced by "ocamlc", which may lead to problems (if the ".cmi" or
+".cmo" is still around) when switching between profiling and
+non-profiling compilations.  To avoid this problem, you should always
+have a ".mli" file for each ".ml" file.  The same problem exists with
+"ocamloptp".
+
+\lparagraph{p:ocamlprof-reserved}{Note} To make sure your programs can be compiled in
+profiling mode, avoid using any identifier that begins with
+"__ocaml_prof".
+
+The amount of profiling information can be controlled through the "-P"
+option to "ocamlcp" or "ocamloptp", followed by one or several letters
+indicating which parts of the program should be profiled:
+
+%% description des options
+\begin{options}
+\item["a"] all options
+\item["f"] function calls : a count point is set at the beginning of
+each function body
+\item["i"] {\bf if \ldots then \ldots else \ldots} : count points are set in
+both {\bf then} branch and {\bf else} branch
+\item["l"] {\bf while, for} loops: a count point is set at the beginning of
+the loop body
+\item["m"] {\bf match} branches: a count point is set at the beginning of the
+body of each branch
+\item["t"] {\bf try \ldots with \ldots} branches: a count point is set at the
+beginning of the body of each branch
+\end{options}
+
+For instance, compiling with "ocamlcp -P film" profiles function calls,
+if\ldots then\ldots else\ldots, loops and pattern matching.
+
+Calling "ocamlcp" or "ocamloptp" without the "-P" option defaults to
+"-P fm", meaning that only function calls and pattern matching are
+profiled.
+
+\paragraph{Note} For compatibility with previous releases, "ocamlcp"
+also accepts the "-p" option, with the same arguments and behaviour as
+"-P".
+
+The "ocamlcp" and "ocamloptp" commands also accept all the options of
+the corresponding "ocamlc" or "ocamlopt" compiler, except the "-pp"
+(preprocessing) option.
+
+
+\section{s:ocamlprof-profiling}{Profiling an execution}
+
+Running an executable that has been compiled with "ocamlcp" or
+"ocamloptp" records the execution counts for the specified parts of
+the program and saves them in a file called "ocamlprof.dump" in the
+current directory.
+
+If the environment variable "OCAMLPROF_DUMP" is set when the program
+exits, its value is used as the file name instead of "ocamlprof.dump".
+
+The dump file is written only if the program terminates
+normally (by calling "exit" or by falling through). It is not written
+if the program terminates with an uncaught exception.
+
+If a compatible dump file already exists in the current directory, then the
+profiling information is accumulated in this dump file. This allows, for
+instance, the profiling of several executions of a program on
+different inputs.  Note that dump files produced by byte-code
+executables (compiled with "ocamlcp") are compatible with the dump
+files produced by native executables (compiled with "ocamloptp").
+
+\section{s:ocamlprof-printing}{Printing profiling information}
+
+The "ocamlprof" command produces a source listing of the program modules
+where execution counts have been inserted as comments. For instance,
+\begin{verbatim}
+        ocamlprof foo.ml
+\end{verbatim}
+prints the source code for the "foo" module, with comments indicating
+how many times the functions in this module have been called. Naturally,
+this information is accurate only if the source file has not been modified
+after it was compiled.
+
+The following options are recognized by "ocamlprof":
+
+\begin{options}
+
+\item["-args" \var{filename}]
+ Read additional newline-terminated command line arguments from \var{filename}.
+
+\item["-args0" \var{filename}]
+ Read additional null character terminated command line arguments from \var{filename}.
+
+\item["-f" \var{dumpfile}]
+Specifies an alternate dump file of profiling information to be read.
+
+\item["-F" \var{string}]
+Specifies an additional string to be output with profiling information.
+By default, "ocamlprof" will annotate programs with comments of the form
+{\tt (* \var{n} *)} where \var{n} is the counter value for a profiling
+point. With option {\tt -F \var{s}}, the annotation will be
+{\tt (* \var{s}\var{n} *)}.
+
+\item["-impl" \var{filename}]
+Process the file \var{filename} as an implementation file, even if its
+extension is not ".ml".
+
+\item["-intf" \var{filename}]
+Process the file \var{filename} as an interface file, even if its
+extension is not ".mli".
+
+\item["-version"]
+Print version string and exit.
+
+\item["-vnum"]
+Print short version number and exit.
+
+\item["-help" or "--help"]
+Display a short usage summary and exit.
+%
+\end{options}
+
+\section{s:ocamlprof-time-profiling}{Time profiling}
+
+Profiling with "ocamlprof" only records execution counts, not the actual
+time spent within each function. There is currently no way to perform
+time profiling on bytecode programs generated by "ocamlc".  For time
+profiling of native code, users are recommended to use standard tools
+such as perf (on Linux), Instruments (on macOS) and DTrace.  Profiling
+with "gprof" is no longer supported.
diff --git a/manual/manual/cmds/runtime.etex b/manual/manual/cmds/runtime.etex
new file mode 100644
index 00000000..ebaf6a68
--- /dev/null
+++ b/manual/manual/cmds/runtime.etex
@@ -0,0 +1,310 @@
+\chapter{The runtime system (ocamlrun)} \label{c:runtime}
+%HEVEA\cutname{runtime.html}
+
+The "ocamlrun" command executes bytecode files produced by the
+linking phase of the "ocamlc" command.
+
+\section{s:ocamlrun-overview}{Overview}
+
+The "ocamlrun" command comprises three main parts: the bytecode
+interpreter, that actually executes bytecode files; the memory
+allocator and garbage collector; and a set of C functions that
+implement primitive operations such as input/output.
+
+The usage for "ocamlrun" is:
+\begin{alltt}
+        ocamlrun \var{options} \var{bytecode-executable} \nth{arg}{1} ... \nth{arg}{n}
+\end{alltt}
+The first non-option argument is taken to be the name of the file
+containing the executable bytecode. (That file is searched in the
+executable path as well as in the current directory.) The remaining
+arguments are passed to the OCaml program, in the string array
+"Sys.argv". Element 0 of this array is the name of the
+bytecode executable file; elements 1 to \var{n} are the remaining
+arguments \nth{arg}{1} to \nth{arg}{n}.
+
+As mentioned in chapter~\ref{c:camlc}, the bytecode executable files
+produced by the "ocamlc" command are self-executable, and manage to
+launch the "ocamlrun" command on themselves automatically. That is,
+assuming "a.out" is a bytecode executable file,
+\begin{alltt}
+        a.out \nth{arg}{1} ... \nth{arg}{n}
+\end{alltt}
+works exactly as
+\begin{alltt}
+        ocamlrun a.out \nth{arg}{1} ... \nth{arg}{n}
+\end{alltt}
+Notice that it is not possible to pass options to "ocamlrun" when
+invoking "a.out" directly.
+
+\begin{windows}
+Under several versions of Windows, bytecode executable files are
+self-executable only if their name ends in ".exe".  It is recommended
+to always give ".exe" names to bytecode executables, e.g. compile
+with "ocamlc -o myprog.exe ..." rather than "ocamlc -o myprog ...".
+\end{windows}
+
+\section{s:ocamlrun-options}{Options}
+The following command-line options are recognized by "ocamlrun".
+
+\begin{options}
+
+\item["-b"]
+When the program aborts due to an uncaught exception, print a detailed
+``back trace'' of the execution, showing where the exception was
+raised and which function calls were outstanding at this point.  The
+back trace is printed only if the bytecode executable contains
+debugging information, i.e. was compiled and linked with the "-g"
+option to "ocamlc" set.  This is equivalent to setting the "b" flag
+in the "OCAMLRUNPARAM" environment variable (see below).
+\item["-I" \var{dir}]
+Search the directory \var{dir} for dynamically-loaded libraries,
+in addition to the standard search path (see
+section~\ref{s:ocamlrun-dllpath}).
+\item["-m"]
+Print the magic number of the bytecode executable given as argument
+and exit.
+\item["-M"]
+Print the magic number expected by this version of the runtime and exit.
+\item["-p"]
+Print the names of the primitives known to this version of
+"ocamlrun" and exit.
+\item["-v"]
+Direct the memory manager to print some progress messages on
+standard error.  This is equivalent to setting "v=63" in the
+"OCAMLRUNPARAM" environment variable (see below).
+\item["-version"]
+Print version string and exit.
+\item["-vnum"]
+Print short version number and exit.
+
+\end{options}
+
+\noindent
+The following environment variables are also consulted:
+
+\begin{options}
+\item["CAML_LD_LIBRARY_PATH"]  Additional directories to search for
+  dynamically-loaded libraries (see section~\ref{s:ocamlrun-dllpath}).
+
+\item["OCAMLLIB"] The directory containing the OCaml standard
+  library.  (If "OCAMLLIB" is not set, "CAMLLIB" will be used instead.)
+  Used to locate the "ld.conf" configuration file for
+  dynamic loading (see section~\ref{s:ocamlrun-dllpath}).  If not set,
+  default to the library directory specified when compiling OCaml.
+
+\item["OCAMLRUNPARAM"] Set the runtime system options
+  and garbage collection parameters.
+  (If "OCAMLRUNPARAM" is not set, "CAMLRUNPARAM" will be used instead.)
+  This variable must be a sequence of parameter specifications separated
+  by commas.
+  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 last six correspond to the fields of the
+  "control" record documented in
+\ifouthtml
+ \ahref{libref/Gc.html}{Module \texttt{Gc}}.
+\else
+ section~\ref{Gc}.
+\fi
+  \begin{options}
+  \item[b] (backtrace) Trigger the printing of a stack backtrace
+        when an uncaught exception aborts the program.
+        This option takes no argument.
+  \item[p] (parser trace) Turn on debugging support for
+        "ocamlyacc"-generated parsers.  When this option is on,
+        the pushdown automaton that executes the parsers prints a
+        trace of its actions.  This option takes no argument.
+  \item[R] (randomize) Turn on randomization of all hash tables by default
+        (see
+\ifouthtml
+  \ahref{libref/Hashtbl.html}{Module \texttt{Hashtbl}}).
+\else
+  section~\ref{Hashtbl}).
+\fi
+        This option takes no argument.
+  \item[h] The initial size of the major heap (in words).
+  \item[a] ("allocation_policy")
+    The policy used for allocating in the OCaml heap. Possible values
+    are "0" for the next-fit policy, "1" for the first-fit
+    policy, and "2" for the best-fit policy. Best-fit is still experimental,
+    but probably the best of the three. The default is "0" (next-fit).
+    See the Gc module documentation for details.
+  \item[s] ("minor_heap_size")  Size of the minor heap. (in words)
+  \item[i] ("major_heap_increment")  Default size increment for the
+  major heap. (in words)
+  \item[o] ("space_overhead")  The major GC speed setting.
+    See the Gc module documentation for details.
+  \item[O] ("max_overhead")  The heap compaction trigger setting.
+  \item[l] ("stack_limit") The limit (in words) of the stack size. This is only
+  relevant to the byte-code runtime, as the native code runtime uses the
+  operating system's stack.
+  \item[v] ("verbose")  What GC messages to print to stderr.  This
+  is a sum of values selected from the following:
+  \begin{options}
+        \item[1   (= 0x001)] Start of major GC cycle.
+        \item[2   (= 0x002)] Minor collection and major GC slice.
+        \item[4   (= 0x004)] Growing and shrinking of the heap.
+        \item[8   (= 0x008)] Resizing of stacks and memory manager tables.
+        \item[16  (= 0x010)] Heap compaction.
+        \item[32  (= 0x020)] Change of GC parameters.
+        \item[64  (= 0x040)] Computation of major GC slice size.
+        \item[128 (= 0x080)] Calling of finalization functions
+        \item[256 (= 0x100)] Startup messages (loading the bytecode
+           executable file, resolving shared libraries).
+        \item[512 (= 0x200)] Computation of compaction-triggering condition.
+        \item[1024 (= 0x400)] Output GC statistics at program exit.
+  \end{options}
+  \item[c] ("cleanup_on_exit") Shut the runtime down gracefully on exit (see
+  "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.
+  % FIXME missing: H, t, w, W see MPR#7870
+  \item[M] ("custom_major_ratio") Target ratio of floating garbage to
+  major heap size for out-of-heap memory held by custom values
+  (e.g. bigarrays) located in the major heap. The GC speed is adjusted
+  to try to use this much memory for dead values that are not yet
+  collected. Expressed as a percentage of major heap size. Default:
+  44. Note: this only applies to values allocated with
+  "caml_alloc_custom_mem".
+  \item[m] ("custom_minor_ratio") Bound on floating garbage for
+  out-of-heap memory
+  held by custom values in the minor heap. A minor GC is triggered
+  when this much memory is held by custom values located in the minor
+  heap. Expressed as a percentage of minor heap size. Default:
+  100. Note: this only applies to values allocated with
+  "caml_alloc_custom_mem".
+  \item[n] ("custom_minor_max_size") Maximum amount of out-of-heap
+  memory for each custom value allocated in the minor heap. When a custom
+  value is allocated on the minor heap and holds more than this many
+  bytes, only this value is counted against "custom_minor_ratio" and
+  the rest is directly counted against "custom_major_ratio".
+  Default: 8192 bytes. Note:
+  this only applies to values allocated with "caml_alloc_custom_mem".
+  \end{options}
+  The multiplier is "k", "M", or "G", for multiplication by $2^{10}$,
+  $2^{20}$, and $2^{30}$ respectively.
+
+  If the option letter is not recognized, the whole parameter is ignored;
+  if the equal sign or the number is missing, the value is taken as 1;
+  if the multiplier is not recognized, it is ignored.
+
+  For example, on a 32-bit machine, under "bash" the command
+\begin{verbatim}
+        export OCAMLRUNPARAM='b,s=256k,v=0x015'
+\end{verbatim}
+  tells a subsequent "ocamlrun" to print backtraces for uncaught exceptions,
+  set its initial minor heap size to 1~megabyte and
+  print a message at the start of each major GC cycle, when the heap
+  size changes, and when compaction is triggered.
+
+\item["CAMLRUNPARAM"]  If "OCAMLRUNPARAM" is not found in the
+  environment, then "CAMLRUNPARAM" will be used instead.  If
+  "CAMLRUNPARAM" is also not found, then the default values will be used.
+
+\item["PATH"] List of directories searched to find the bytecode
+executable file.
+\end{options}
+
+\section{s:ocamlrun-dllpath}{Dynamic loading of shared libraries}
+
+On platforms that support dynamic loading, "ocamlrun" can link
+dynamically with C shared libraries (DLLs) providing additional C primitives
+beyond those provided by the standard runtime system.  The names for
+these libraries are provided at link time as described in
+section~\ref{ss:dynlink-c-code}), and recorded in the bytecode executable
+file;  "ocamlrun", then, locates these libraries and resolves references
+to their primitives when the bytecode executable program starts.
+
+The "ocamlrun" command searches shared libraries in the following
+directories, in the order indicated:
+\begin{enumerate}
+\item Directories specified on the "ocamlrun" command line with the
+"-I" option.
+\item Directories specified in the "CAML_LD_LIBRARY_PATH" environment
+variable.
+\item Directories specified at link-time via the "-dllpath" option to
+"ocamlc".  (These directories are recorded in the bytecode executable
+file.)
+\item Directories specified in the file "ld.conf".  This file resides
+in the OCaml standard library directory, and lists directory
+names (one per line) to be searched.  Typically, it contains only one
+line naming the "stublibs" subdirectory of the OCaml standard
+library directory.  Users can add there the names of other directories
+containing frequently-used shared libraries; however, for consistency
+of installation, we recommend that shared libraries are installed
+directly in the system "stublibs" directory, rather than adding lines
+to the "ld.conf" file.
+\item Default directories searched by the system dynamic loader.
+Under Unix, these generally include "/lib" and "/usr/lib", plus the
+directories listed in the file "/etc/ld.so.conf" and the environment
+variable "LD_LIBRARY_PATH".  Under Windows, these include the Windows
+system directories, plus the directories listed in the "PATH"
+environment variable.
+\end{enumerate}
+
+\section{s:ocamlrun-common-errors}{Common errors}
+
+This section describes and explains the most frequently encountered
+error messages.
+
+\begin{options}
+
+\item[{\it filename}": no such file or directory"]
+If {\it filename} is the name of a self-executable bytecode file, this
+means that either that file does not exist, or that it failed to run
+the "ocamlrun" bytecode interpreter on itself. The second possibility
+indicates that OCaml has not been properly installed on your
+system.
+
+\item["Cannot exec ocamlrun"]
+(When launching a self-executable bytecode file.) The "ocamlrun"
+ could not be found in the executable path. Check that OCaml
+ has been properly installed on your system.
+
+\item["Cannot find the bytecode file"]
+The file that "ocamlrun" is trying to execute (e.g. the file given as
+first non-option argument to "ocamlrun") either does not exist, or is
+not a valid executable bytecode file.
+
+\item["Truncated bytecode file"]
+The file that "ocamlrun" is trying to execute is not a valid executable
+bytecode file. Probably it has been truncated or mangled since
+created. Erase and rebuild it.
+
+\item["Uncaught exception"]
+The program being executed contains a ``stray'' exception. That is,
+it raises an exception at some point, and this exception is never
+caught. This causes immediate termination of the program. The name of
+the exception is printed, along with its string, byte sequence, and
+integer arguments
+(arguments of more complex types are not correctly printed).
+To locate the context of the uncaught exception, compile the program
+with the "-g" option and either run it again under the "ocamldebug"
+debugger (see chapter~\ref{c:debugger}), or run it with "ocamlrun -b"
+or with the "OCAMLRUNPARAM" environment variable set to "b=1".
+
+\item["Out of memory"]
+The program being executed requires more memory than available. Either
+the program builds excessively large data structures; or the program
+contains too many nested function calls, and the stack overflows.  In
+some cases, your program is perfectly correct, it just requires more
+memory than your machine provides. In other cases, the ``out of
+memory'' message reveals an error in your program: non-terminating
+recursive function, allocation of an excessively large array,
+string or byte sequence, attempts to build an infinite list or other
+data structure, \ldots
+
+To help you diagnose this error, run your program with the "-v" option
+to "ocamlrun", or with the "OCAMLRUNPARAM" environment variable set to
+"v=63". If it displays lots of ``"Growing stack"\ldots''
+messages, this is probably a looping recursive function. If it
+displays lots of ``"Growing heap"\ldots'' messages, with the heap size
+growing slowly, this is probably an attempt to construct a data
+structure with too many (infinitely many?) cells. If it displays few
+``"Growing heap"\ldots'' messages, but with a huge increment in the
+heap size, this is probably an attempt to build an excessively large
+array, string or byte sequence.
+
+\end{options}
diff --git a/manual/manual/cmds/spacetime-chapter.etex b/manual/manual/cmds/spacetime-chapter.etex
new file mode 100644
index 00000000..5b75eb86
--- /dev/null
+++ b/manual/manual/cmds/spacetime-chapter.etex
@@ -0,0 +1,125 @@
+\chapter{Memory profiling with Spacetime}
+%HEVEA\cutname{spacetime.html}
+
+\section{s:spacetime-overview}{Overview}
+
+Spacetime is the name given to functionality within the OCaml compiler that
+provides for accurate profiling of the memory behaviour of a program.
+Using Spacetime it is possible to determine the source of memory leaks
+and excess memory allocation quickly and easily.  Excess allocation slows
+programs down both by imposing a higher load on the garbage collector and
+reducing the cache locality of the program's code.  Spacetime provides
+full backtraces for every allocation that occurred on the OCaml heap
+during the lifetime of the program including those in C stubs.
+
+Spacetime only analyses the memory behaviour of a program with respect to
+the OCaml heap allocators and garbage collector.  It does not analyse
+allocation on the C heap.  Spacetime does not affect the memory behaviour
+of a program being profiled with the exception of any change caused by the
+overhead of profiling (see section\ \ref{s:spacetime-runtimeoverhead})---for example
+the program running slower might cause it to allocate less memory in total.
+
+Spacetime is currently only available for x86-64 targets and has only been
+tested on Linux systems (although it is expected to work on most modern
+Unix-like systems and provision has been made for running under
+Windows). It is expected that the set of supported platforms will
+be extended in the future.
+
+\section{s:spacetime-howto}{How to use it}
+
+\subsection{ss:spacetime-building}{Building}
+
+To use Spacetime it is necessary to use an OCaml compiler that was
+configured with the {\tt -spacetime} option.  It is not possible to select
+Spacetime on a per-source-file basis or for a subset of files in a project;
+all files involved in the executable being profiled must be built with the
+Spacetime compiler.  Only native code compilation is supported (not
+bytecode).
+
+If the {\tt libunwind} library is not available on the system then it will
+not be possible for Spacetime to profile allocations occurring within
+C stubs.  If the {\tt libunwind} library is available but in an unusual
+location then that location may be specified to the {\tt configure} script
+using the {\tt -libunwinddir} option (or alternatively, using separate
+{\tt -libunwindinclude} and {\tt -libunwindlib} options).
+
+OPAM switches will be provided for Spacetime-configured compilers.
+
+Once the appropriate compiler has been selected the program should be
+built as normal (ensuring that all files are built with the Spacetime
+compiler---there is currently no protection to ensure this is the case, but
+it is essential).  For many uses it will not be necessary to change the
+code of the program to use the profiler.
+
+Spacetime-configured compilers run slower and occupy more memory than their
+counterparts.  It is hoped this will be fixed in the future as part of
+improved cross compilation support.
+
+\subsection{ss:spacetime-running}{Running}
+
+Programs built with Spacetime instrumentation have a dependency on
+the {\tt libunwind} library unless that was unavailable at configure time or
+the {\tt -disable-libunwind} option was specified
+(see section\ \ref{s:spacetime-runtimeoverhead}).
+
+Setting the {\tt OCAML\_SPACETIME\_INTERVAL} environment variable to an
+integer representing a number of milliseconds before running a program built
+with Spacetime will cause memory profiling to be in operation when the
+program is started.  The contents of the OCaml heap will be sampled each
+time the number of milliseconds that the program has spent executing since the
+last sample exceeds the given number.  (Note that the time base is combined
+user plus system time---{\em not} wall clock time.  This peculiarity may be
+changed in future.)
+
+The program being profiled must exit normally or be caused to exit using
+the {\tt SIGINT} signal (e.g. by pressing Ctrl+C).  When the program exits
+files will be written in the directory that was the working directory when
+the program was started.  One Spacetime file will be written for each
+process that was involved, indexed by process ID; there will normally only
+be one such.  The Spacetime files may be substantial.  The directory to which
+they are written may be overridden by setting
+the {\tt OCAML\_SPACETIME\_SNAPSHOT\_DIR} environment variable before the
+program is started.
+
+Instead of using the automatic snapshot facility described above it is also
+possible to manually control Spacetime profiling.  (The environment variables
+{\tt OCAML\_SPACETIME\_INTERVAL} and {\tt OCAML\_SPACETIME\_SNAPSHOT\_DIR}
+are then not relevant.)  Full documentation as regards this method of profiling
+is provided in the standard library documentation (section\ \ref{c:stdlib})
+for the {\tt Spacetime} module.
+
+\subsection{ss:spacetime-analysis}{Analysis}
+
+The compiler distribution does not itself provide the facility for analysing
+Spacetime output files; this is left to external tools.  The first such tool
+will appear in OPAM as a package called {\tt prof_spacetime}.  That tool will
+provide interactive graphical and terminal-based visualisation of
+the results of profiling.
+
+\section{s:spacetime-runtimeoverhead}{Runtime overhead}
+
+The runtime overhead imposed by Spacetime varies considerably depending on
+the particular program being profiled.  The overhead may be as low as
+ten percent---but more usually programs should be expected to run at perhaps
+a third or quarter of their normal speed.  It is expected that this overhead
+will be reduced in future versions of the compiler.
+
+Execution speed of instrumented programs may be increased by using a compiler
+configured with the {\tt -disable-libunwind} option.  This prevents collection
+of profiling information from C stubs.
+
+Programs running with Spacetime instrumentation consume significantly more
+memory than their non-instrumented counterparts.  It is expected that this
+memory overhead will also be reduced in the future.
+
+\section{s:spacetime-dev}{For developers}
+
+The compiler distribution provides an ``{\tt otherlibs}'' library called
+{\tt raw\_spacetime\_lib} for decoding Spacetime files.  This library
+provides facilities to read not only memory profiling information but also
+the full dynamic call graph of the profiled program which is written into
+Spacetime output files.
+
+A library package {\tt spacetime\_lib} will be provided in OPAM
+to provide an interface for decoding profiling information at a higher
+level than that provided by {\tt raw\_spacetime\_lib}.
diff --git a/manual/manual/cmds/top.etex b/manual/manual/cmds/top.etex
new file mode 100644
index 00000000..f8b3b1f2
--- /dev/null
+++ b/manual/manual/cmds/top.etex
@@ -0,0 +1,455 @@
+\chapter{The toplevel system or REPL (ocaml)} \label{c:camllight}
+%HEVEA\cutname{toplevel.html}
+
+This chapter describes the toplevel system for OCaml, that permits
+interactive use of the OCaml system
+through a read-eval-print loop (REPL). In this mode, the system repeatedly
+reads OCaml phrases from the input, then typechecks, compile and
+evaluate them, then prints the inferred type and result value, if
+any. The system prints a "#" (sharp) prompt before reading each
+phrase.
+
+Input to the toplevel can span several lines. It is terminated by @";;"@ (a
+double-semicolon). The toplevel input consists in one or several
+toplevel phrases, with the following syntax:
+
+\begin{syntax}
+toplevel-input:
+          {{ definition }} ';;'
+        | expr ';;'
+        | '#' ident [ directive-argument ] ';;'
+;
+directive-argument:
+          string-literal
+        | integer-literal
+        | value-path
+        | 'true' || 'false'
+\end{syntax}
+
+A phrase can consist of a definition, like those found in
+implementations of compilation units or in @'struct' \ldots 'end'@
+module expressions. The definition can bind value names, type names,
+an exception, a module name, or a module type name. The toplevel
+system performs the bindings, then prints the types and values (if
+any) for the names thus defined.
+
+A phrase may also consist in a value expression
+(section~\ref{s:value-expr}). It is simply evaluated
+without performing any bindings, and its value is
+printed.
+
+Finally, a phrase can also consist in a toplevel directive,
+starting with @"#"@ (the sharp sign). These directives control the
+behavior of the toplevel; they are listed below in
+section~\ref{s:toplevel-directives}.
+
+\begin{unix}
+The toplevel system is started by the command "ocaml", as follows:
+\begin{alltt}
+        ocaml \var{options} \var{objects}                # interactive mode
+        ocaml \var{options} \var{objects} \var{scriptfile}        # script mode
+\end{alltt}
+\var{options} are described below.
+\var{objects} are filenames ending in ".cmo" or ".cma"; they are
+loaded into the interpreter immediately after \var{options} are set.
+\var{scriptfile} is any file name not ending in ".cmo" or ".cma".
+
+If no \var{scriptfile} is given on the command line, the toplevel system
+enters interactive mode: phrases are read on standard input, results
+are printed on standard output, errors on standard error. End-of-file
+on standard input terminates "ocaml" (see also the "#quit" directive
+in section~\ref{s:toplevel-directives}).
+
+On start-up (before the first phrase is read), if the file
+".ocamlinit" exists in the current directory,
+its contents are read as a sequence of OCaml phrases
+and executed as per the "#use" directive
+described in section~\ref{s:toplevel-directives}.
+The evaluation outcode for each phrase are not displayed.
+If the current directory does not contain an ".ocamlinit" file,
+the file "XDG_CONFIG_HOME/ocaml/init.ml" is looked up according
+to the XDG base directory specification and used instead (on Windows
+this is skipped). If that file doesn't exist then an [.ocamlinit] file
+in the users' home directory (determined via environment variable "HOME") is
+used if existing.
+
+The toplevel system does not perform line editing, but it can
+easily be used in conjunction with an external line editor such as
+"ledit", or "rlwrap". An improved toplevel, "utop", is also available.
+Another option is to use "ocaml" under Gnu Emacs, which gives the
+full editing power of Emacs (command "run-caml" from library "inf-caml").
+
+At any point, the parsing, compilation or evaluation of the current
+phrase can be interrupted by pressing "ctrl-C" (or, more precisely,
+by sending the "INTR" signal to the "ocaml" process). The toplevel
+then immediately returns to the "#" prompt.
+
+If \var{scriptfile} is given on the command-line to "ocaml", the toplevel
+system enters script mode: the contents of the file are read as a
+sequence of OCaml phrases and executed, as per the "#use"
+directive (section~\ref{s:toplevel-directives}). The outcome of the
+evaluation is not printed.  On reaching the end of file, the "ocaml"
+command exits immediately.  No commands are read from standard input.
+"Sys.argv" is transformed, ignoring all OCaml parameters, and
+starting with the script file name in "Sys.argv.(0)".
+
+In script mode, the first line of the script is ignored if it starts
+with "#!".  Thus, it should be possible to make the script
+itself executable and put as first line "#!/usr/local/bin/ocaml",
+thus calling the toplevel system automatically when the script is
+run.  However, "ocaml" itself is a "#!" script on most installations
+of OCaml, and Unix kernels usually do not handle nested "#!"
+scripts.  A better solution is to put the following as the first line
+of the script:
+\begin{verbatim}
+        #!/usr/local/bin/ocamlrun /usr/local/bin/ocaml
+\end{verbatim}
+
+\end{unix}
+
+\section{s:toplevel-options}{Options}
+
+The following command-line options are recognized by the "ocaml" command.
+% Configure boolean variables used by the macros in unified-options.etex
+\compfalse
+\natfalse
+\toptrue
+% unified-options gathers all options across the native/bytecode
+% compilers and toplevel
+\input{unified-options.tex}
+
+\begin{unix}
+The following environment variables are also consulted:
+\begin{options}
+\item["OCAMLTOP_INCLUDE_PATH"] Additional directories to search for compiled
+  object code files (".cmi", ".cmo" and ".cma"). The specified directories are
+  considered from left to right, after the include directories specified on the
+  command line via "-I" have been searched. Available since OCaml 4.08.
+
+\item["OCAMLTOP_UTF_8"] When printing string values, non-ascii bytes
+($ {} > "\0x7E" $) are printed as decimal escape sequence if "OCAMLTOP_UTF_8" is
+set to false. Otherwise, they are printed unescaped.
+
+\item["TERM"] When printing error messages, the toplevel system
+attempts to underline visually the location of the error. It
+consults the "TERM" variable to determines the type of output terminal
+and look up its capabilities in the terminal database.
+
+\item["XDG_CONFIG_HOME", "HOME"]
+".ocamlinit" lookup procedure (see above).
+\end{options}
+\end{unix}
+
+\section{s:toplevel-directives}{Toplevel directives}
+
+The following directives control the toplevel behavior, load files in
+memory, and trace program execution.
+
+{\bf Note:} all directives start with a "#" (sharp) symbol.  This "#"
+must be typed before the directive, and must not be confused with the
+"#" prompt displayed by the interactive loop.  For instance,
+typing "#quit;;" will exit the toplevel loop, but typing "quit;;"
+will result in an ``unbound value "quit"'' error.
+
+%
+% Remark: this list of options should be kept synchronized with the documentation
+% in toplevel/topdirs.ml.
+%
+\begin{options}
+\item[General]
+  \begin{options}
+  \item["#help;;"]
+    Prints a list of all available directives, with corresponding argument type
+    if appropriate.
+  \item["#quit;;"]
+    Exit the toplevel loop and terminate the "ocaml" command.
+  \end{options}
+
+\item[Loading codes]
+  \begin{options}
+
+  \item["#cd \""\var{dir-name}"\";;"]
+    Change the current working directory.
+
+  \item["#directory \""\var{dir-name}"\";;"]
+    Add the given directory to the list of directories searched for
+    source and compiled files.
+
+  \item["#remove_directory \""\var{dir-name}"\";;"]
+    Remove the given directory from the list of directories searched for
+    source and compiled files.  Do nothing if the list does not contain
+    the given directory.
+
+  \item["#load \""\var{file-name}"\";;"]
+    Load in memory a bytecode object file (".cmo" file) or library file
+    (".cma" file) produced by the batch compiler "ocamlc".
+
+  \item["#load_rec \""\var{file-name}"\";;"]
+    Load in memory a bytecode object file (".cmo" file) or library file
+    (".cma" file) produced by the batch compiler "ocamlc".
+    When loading an object file that depends on other modules
+    which have not been loaded yet, the .cmo files for these modules
+    are searched and loaded as well, recursively. The loading order
+    is not specified.
+
+  \item["#use \""\var{file-name}"\";;"]
+    Read, compile and execute source phrases from the given file.
+    This is textual inclusion: phrases are processed just as if
+    they were typed on standard input. The reading of the file stops at
+    the first error encountered.
+
+  \item["#use_output \""\var{command}"\";;"]
+    Execute a command and evaluate its output as if it had been captured
+    to a file and passed to "#use".
+
+  \item["#mod_use \""\var{file-name}"\";;"]
+    Similar to "#use" but also wrap the code into a top-level module of the
+    same name as capitalized file name without extensions, following
+    semantics of the compiler.
+  \end{options}
+
+For directives that take file names as arguments, if the given file
+name specifies no directory, the file is searched in the following
+directories:
+\begin{enumerate}
+  \item In script mode, the directory containing the script currently
+    executing; in interactive mode, the current working directory.
+  \item Directories added with the "#directory" directive.
+  \item Directories given on the command line with "-I" options.
+  \item The standard library directory.
+\end{enumerate}
+
+\item[Environment queries]
+  \begin{options}
+  \item["#show_class "\var{class-path}";;"]\vspace{-4.7ex}
+  \item["#show_class_type "\var{class-path}";;"]\vspace{-4.7ex}
+  \item["#show_exception "\var{ident}";;"]\vspace{-4.7ex}
+  \item["#show_module "\var{module-path}";;"]\vspace{-4.7ex}
+  \item["#show_module_type "\var{modtype-path}";;"]\vspace{-4.7ex}
+  \item["#show_type "\var{typeconstr}";;"]\vspace{-4.7ex}
+  \item["#show_val "\var{value-path}";;"]
+    Print the signature of the corresponding component.
+
+  \item["#show "\var{ident}";;"]
+    Print the signatures of components with name \var{ident} in all the
+    above categories.
+    \end{options}
+
+\item[Pretty-printing]
+  \begin{options}
+
+  \item["#install_printer "\var{printer-name}";;"]
+    This directive registers the function named \var{printer-name} (a
+    value path) as a printer for values whose types match the argument
+    type of the function. That is, the toplevel loop will call
+    \var{printer-name} when it has such a value to print.
+
+    The printing function \var{printer-name} should have type
+    @"Format.formatter" "->" @t@ "->" "unit"@, where @@t@@ is the
+    type for the values to be printed, and should output its textual
+    representation for the value of type @@t@@ on the given formatter,
+    using the functions provided by the "Format" library.  For backward
+    compatibility, \var{printer-name} can also have type
+    @@t@ "->" "unit"@ and should then output on the standard
+    formatter, but this usage is deprecated.
+
+  \item["#print_depth "\var{n}";;"]
+    Limit the printing of values to a maximal depth of \var{n}.
+    The parts of values whose depth exceeds \var{n} are printed as "..."
+    (ellipsis).
+
+  \item["#print_length "\var{n}";;"]
+    Limit the number of value nodes printed to at most \var{n}.
+    Remaining parts of values are printed as "..." (ellipsis).
+
+  \item["#remove_printer "\var{printer-name}";;"]
+    Remove the named function from the table of toplevel printers.
+\end{options}
+
+\item[Tracing]
+  \begin{options}
+  \item["#trace "\var{function-name}";;"]
+    After executing this directive, all calls to the function named
+    \var{function-name} will be ``traced''. That is, the argument and the
+    result are displayed for each call, as well as the exceptions escaping
+    out of the function, raised either by the function itself or by
+    another function it calls. If the function is curried, each argument
+    is printed as it is passed to the function.
+
+  \item["#untrace "\var{function-name}";;"]
+    Stop tracing the given function.
+
+  \item["#untrace_all;;"]
+    Stop tracing all functions traced so far.
+  \end{options}
+
+\item[Compiler options]
+  \begin{options}
+  \item["#labels "\var{bool}";;"]
+    Ignore labels in function types if argument is "false", or switch back
+    to default behaviour (commuting style) if argument is "true".
+
+  \item["#ppx  \""\var{file-name}"\";;"]
+    After parsing, pipe the abstract syntax tree through the preprocessor
+    command.
+
+  \item["#principal "\var{bool}";;"]
+    If the argument is "true", check information paths during
+    type-checking, to make sure that all types are derived in a principal
+    way. If the argument is "false", do not check information paths.
+
+  \item["#rectypes;;"]
+    Allow arbitrary recursive types during type-checking. Note: once
+    enabled, this option cannot be disabled because that would lead to
+    unsoundness of the type system.
+
+  \item["#warn_error \""\var{warning-list}"\";;"]
+    Treat as errors the warnings enabled by the argument and as normal
+    warnings the warnings disabled by the argument.
+
+  \item["#warnings \""\var{warning-list}"\";;"]
+    Enable or disable warnings according to the argument.
+
+  \end{options}
+
+\end{options}
+
+\section{s:toplevel-modules}{The toplevel and the module system}
+
+Toplevel phrases can refer to identifiers defined in compilation units
+with the same mechanisms as for separately compiled units: either by
+using qualified names ("Modulename.localname"), or by using
+the "open" construct and unqualified names (see section~\ref{s:names}).
+
+However, before referencing another compilation unit, an
+implementation of that unit must be present in memory.
+At start-up, the toplevel system contains implementations for all the
+modules in the the standard library. Implementations for user modules
+can be entered with the "#load" directive described above. Referencing
+a unit for which no implementation has been provided
+results in the error "Reference to undefined global `...'".
+
+Note that entering "open "\var{Mod} merely accesses the compiled
+interface (".cmi" file) for \var{Mod}, but does not load the
+implementation of \var{Mod}, and does not cause any error if no
+implementation of \var{Mod} has been loaded. The error
+``reference to undefined global \var{Mod}'' will occur only when
+executing a value or module definition that refers to \var{Mod}.
+
+\section{s:toplevel-common-errors}{Common errors}
+
+This section describes and explains the most frequently encountered
+error messages.
+
+\begin{options}
+
+\item[Cannot find file \var{filename}]
+The named file could not be found in the current directory, nor in the
+directories of the search path.
+
+If \var{filename} has the format \var{mod}".cmi", this
+means you have referenced the compilation unit \var{mod}, but its
+compiled interface could not be found. Fix: compile \var{mod}".mli" or
+\var{mod}".ml" first, to create the compiled interface \var{mod}".cmi".
+
+If \var{filename} has the format \var{mod}".cmo", this
+means you are trying to load with "#load" a bytecode object file that
+does not exist yet. Fix: compile \var{mod}".ml" first.
+
+If your program spans several directories, this error can also appear
+because you haven't specified the directories to look into. Fix: use
+the "#directory" directive to add the correct directories to the
+search path.
+
+\item[This expression has type \nth{t}{1}, but is used with type \nth{t}{2}]
+See section~\ref{s:comp-errors}.
+
+\item[Reference to undefined global \var{mod}]
+You have neglected to load in memory an implementation for a module
+with "#load". See section~\ref{s:toplevel-modules} above.
+
+\end{options}
+
+\section{s:custom-toplevel}{Building custom toplevel systems: \texttt{ocamlmktop}}
+
+The "ocamlmktop" command builds OCaml toplevels that
+contain user code preloaded at start-up.
+
+The "ocamlmktop" command takes as argument a set of ".cmo" and ".cma"
+files, and links them with the object files that implement the OCaml toplevel.
+The typical use is:
+\begin{verbatim}
+        ocamlmktop -o mytoplevel foo.cmo bar.cmo gee.cmo
+\end{verbatim}
+This creates the bytecode file "mytoplevel", containing the OCaml toplevel
+system, plus the code from the three ".cmo"
+files. This toplevel is directly executable and is started by:
+\begin{verbatim}
+        ./mytoplevel
+\end{verbatim}
+This enters a regular toplevel loop, except that the code from
+"foo.cmo", "bar.cmo" and "gee.cmo" is already loaded in memory, just as
+if you had typed:
+\begin{verbatim}
+        #load "foo.cmo";;
+        #load "bar.cmo";;
+        #load "gee.cmo";;
+\end{verbatim}
+on entrance to the toplevel. The modules "Foo", "Bar" and "Gee" are
+not opened, though; you still have to do
+\begin{verbatim}
+        open Foo;;
+\end{verbatim}
+yourself, if this is what you wish.
+
+\subsection{ss:ocamlmktop-options}{Options}
+
+The following command-line options are recognized by "ocamlmktop".
+
+\begin{options}
+
+\item["-cclib" \var{libname}]
+Pass the "-l"\var{libname} option to the C linker when linking in
+``custom runtime'' mode. See the corresponding option for
+"ocamlc", in chapter~\ref{c:camlc}.
+
+\item["-ccopt" \var{option}]
+Pass the given option to the C compiler and linker, when linking in
+``custom runtime'' mode. See the corresponding option for
+"ocamlc", in chapter~\ref{c:camlc}.
+
+\item["-custom"]
+Link in ``custom runtime'' mode. See the corresponding option for
+"ocamlc", in chapter~\ref{c:camlc}.
+
+\item["-I" \var{directory}]
+Add the given directory to the list of directories searched for
+compiled object code files (".cmo" and ".cma").
+
+\item["-o" \var{exec-file}]
+Specify the name of the toplevel file produced by the linker.
+The default is "a.out".
+
+\end{options}
+
+\section{s:ocamlnat}{The native toplevel: \texttt{ocamlnat}\ (experimental)}
+
+{\bf This section describes a tool that is not yet officially supported %
+but may be found useful.}
+
+OCaml code executing in the traditional toplevel system uses the bytecode
+interpreter.  When increased performance is required, or for testing
+programs that will only execute correctly when compiled to native code,
+the {\em native toplevel} may be used instead.
+
+For the majority of installations the native toplevel will not have been
+installed along with the rest of the OCaml toolchain.  In such circumstances
+it will be necessary to build the OCaml distribution from source.
+From the built source tree of the distribution you may use
+{\tt make natruntop} to build and execute a native toplevel.  (Alternatively
+{\tt make ocamlnat} can be used, which just performs the build step.)
+
+If the {\tt make install} command is run after having built the native
+toplevel then the {\tt ocamlnat} program (either from the source or the
+installation directory) may be invoked directly rather than using
+{\tt make natruntop}.
diff --git a/manual/manual/cmds/unified-options.etex b/manual/manual/cmds/unified-options.etex
new file mode 100644
index 00000000..fe636112
--- /dev/null
+++ b/manual/manual/cmds/unified-options.etex
@@ -0,0 +1,814 @@
+%
+% This file describes the native/bytecode compiler and toplevel
+% options. Since specific options can exist in only a subset of
+% \{toplevel, bytecode compiler, native compiler \} and their description
+% might differ across this subset, this file uses macros to adapt the
+% description tool by tool:
+\long\def\comp#1{\ifcomp#1\else\fi}
+% \long is needed for multiparagraph macros
+\long\def\nat#1{\ifnat#1\else\fi}
+\long\def\top#1{\iftop#1\else\fi}
+\long\def\notop#1{\iftop\else#1\fi}
+% ( Note that the previous definitions relies on the three boolean values
+%   \top, \nat and \comp. The manual section must therefore
+%   set these boolean values accordingly.
+% )
+% The macros (\comp, \nat, \top) adds a supplementary text
+% if we are respectively in the (bytecode compiler, native compiler, toplevel)
+% section.
+% The toplevel options are quite different from the compilers' options.
+% It is therefore useful to have also a substractive \notop macro
+% that prints its content only outside of the topvel section
+%
+% For instance, to add an option "-foo" that applies to the native and
+% bytecode compiler, one can write
+% \notop{\item["-foo"]
+%   ...
+% }
+%
+% Similarly, an option "-bar" only available in the native compiler
+% can be introduced with
+% \nat{\item["-bar"]
+%   ...
+% }
+% These macros can be also used to add information that are only relevant to
+% some tools or differ slightly from one tool to another. For instance, we
+% define the following macro for the pairs cma/cmxa cmo/cmxo and ocamlc/ocamlopt
+%
+\def\cma{\comp{.cma}\nat{.cmxa}}
+\def\cmo{\comp{.cmo}\nat{.cmx}}
+\def\qcmo{{\machine\cmo}}
+\def\qcma{{\machine\cma}}
+\def\ocamlx{\comp{ocamlc}\nat{ocamlopt}}
+%
+%
+\begin{options}
+\notop{%
+\item["-a"]
+Build a library(\nat{".cmxa" and ".a"/".lib" files}\comp{".cma" file})
+with the object files (\nat{".cmx" and ".o"/".obj" files}\comp{ ".cmo" files})
+given on the command line, instead of linking them into an executable file.
+The name of the library must be set with the "-o" option.
+
+If \comp{"-custom", }"-cclib" or "-ccopt" options are passed on the command
+line, these options are stored in the resulting \qcma library. Then,
+linking with this library automatically adds back the \comp{"-custom", }
+"-cclib" and "-ccopt" options as if they had been provided on the
+command line, unless the "-noautolink" option is given.
+}%notop
+
+\item["-absname"]
+Force error messages to show absolute paths for file names.
+
+\notop{\item["-annot"]
+Deprecated since OCaml 4.11. Please use "-bin-annot" instead.
+}%notop
+
+\item["-args" \var{filename}]
+Read additional newline-terminated command line arguments from \var{filename}.
+\top{It is not possible to pass a \var{scriptfile} via file to the toplevel.
+}%top
+\item["-args0" \var{filename}]
+ Read additional null character terminated command line arguments from
+ \var{filename}.
+\top{It is not possible to pass a \var{scriptfile} via file to the toplevel.
+}%top
+
+
+\notop{\item["-bin-annot"]
+Dump detailed information about the compilation (types, bindings,
+tail-calls, etc) in binary format. The information for file \var{src}".ml"
+(resp. \var{src}".mli") is put into file \var{src}".cmt"
+(resp. \var{src}".cmti").  In case of a type error, dump
+all the information inferred by the type-checker before the error.
+The "*.cmt" and "*.cmti" files produced by "-bin-annot" contain
+more information and are much more compact than the files produced by
+"-annot".
+}%notop
+
+\notop{\item["-c"]
+Compile only. Suppress the linking phase of the
+compilation. Source code files are turned into compiled files, but no
+executable file is produced. This option is useful to
+compile modules separately.
+}%notop
+
+\notop{%
+\item["-cc" \var{ccomp}]
+Use \var{ccomp} as the C linker \nat{called to build the final executable }
+\comp{when linking in ``custom runtime'' mode (see the "-custom" option)}
+and as the C compiler for compiling ".c" source files.
+}%notop
+
+\notop{%
+\item["-cclib" "-l"\var{libname}]
+Pass the "-l"\var{libname} option to the \comp{C} linker
+\comp{when linking in ``custom runtime'' mode (see the "-custom" option)}.
+This causes the given C library to be linked with the program.
+}%notop
+
+\notop{%
+\item["-ccopt" \var{option}]
+Pass the given option to the C compiler and linker.
+\comp{When linking in ``custom runtime'' mode, for instance}%
+\nat{For instance,}%
+"-ccopt -L"\var{dir} causes the C linker to search for C libraries in
+directory \var{dir}.\comp{(See the "-custom" option.)}
+}%notop
+
+\notop{%
+\item["-color" \var{mode}]
+Enable or disable colors in compiler messages (especially warnings and errors).
+The following modes are supported:
+\begin{description}
+  \item["auto"] use heuristics to enable colors only if the output supports them
+   (an ANSI-compatible tty terminal);
+  \item["always"] enable colors unconditionally;
+  \item["never"] disable color output.
+\end{description}
+The default setting is 'auto', and the current heuristic
+checks that the "TERM" environment variable exists and is
+not empty or "dumb", and that 'isatty(stderr)' holds.
+
+The environment variable "OCAML_COLOR" is considered if "-color" is not
+provided. Its values are auto/always/never as above.
+}%notop
+
+\notop{%
+\item["-error-style" \var{mode}]
+Control the way error messages and warnings are printed.
+The following modes are supported:
+\begin{description}
+  \item["short"] only print the error and its location;
+  \item["contextual"] like "short", but also display the source code snippet
+   corresponding to the location of the error.
+  \end{description}
+The default setting is "contextual".
+
+The environment variable "OCAML_ERROR_STYLE" is considered if "-error-style" is
+not provided. Its values are short/contextual as above.
+}%notop
+
+\comp{%
+\item["-compat-32"]
+Check that the generated bytecode executable can run on 32-bit
+platforms and signal an error if it cannot. This is useful when
+compiling bytecode on a 64-bit machine.
+}%comp
+
+\nat{%
+\item["-compact"]
+Optimize the produced code for space rather than for time. This
+results in slightly smaller but slightly slower programs. The default is to
+optimize for speed.
+}%nat
+
+\notop{%
+\item["-config"]
+Print the version number of {\machine\ocamlx} and a detailed
+summary of its configuration, then exit.
+}%notop
+
+\notop{%
+\item["-config-var" \var{var}]
+Print the value of a specific configuration variable from the
+"-config" output, then exit. If the variable does not exist, the exit
+code is non-zero. This option is only available since OCaml 4.08,
+so script authors should have a fallback for older versions.
+}%notop
+
+\comp{%
+\item["-custom"]
+Link in ``custom runtime'' mode. In the default linking mode, the
+linker produces bytecode that is intended to be executed with the
+shared runtime system, "ocamlrun". In the custom runtime mode, the
+linker produces an output file that contains both the runtime system
+and the bytecode for the program. The resulting file is larger, but it
+can be executed directly, even if the "ocamlrun" command is not
+installed. Moreover, the ``custom runtime'' mode enables static
+linking of OCaml code with user-defined C functions, as described in
+chapter~\ref{c:intf-c}.
+\begin{unix}
+Never use the "strip" command on executables produced by "ocamlc -custom",
+this would remove the bytecode part of the executable.
+\end{unix}
+\begin{unix}
+Security warning: never set the ``setuid'' or ``setgid'' bits on executables
+produced by "ocamlc -custom", this would make them vulnerable to attacks.
+\end{unix}
+}%comp
+
+\notop{%
+\item["-depend" \var{ocamldep-args}]
+Compute dependencies, as the "ocamldep" command would do. The remaining
+arguments are interpreted as if they were given to the "ocamldep" command.
+}%notop
+
+\comp{
+\item["-dllib" "-l"\var{libname}]
+Arrange for the C shared library "dll"\var{libname}".so"
+("dll"\var{libname}".dll" under Windows) to be loaded dynamically
+by the run-time system "ocamlrun" at program start-up time.
+}%comp
+
+\comp{\item["-dllpath" \var{dir}]
+Adds the directory \var{dir} to the run-time search path for shared
+C libraries.  At link-time, shared libraries are searched in the
+standard search path (the one corresponding to the "-I" option).
+The "-dllpath" option simply stores \var{dir} in the produced
+executable file, where "ocamlrun" can find it and use it as
+described in section~\ref{s:ocamlrun-dllpath}.
+}%comp
+
+\notop{%
+\item["-for-pack" \var{module-path}]
+Generate an object file (\qcmo\nat{ and ".o"/".obj" files})
+that can later be included
+as a sub-module (with the given access path) of a compilation unit
+constructed with "-pack".  For instance,
+{\machine\ocamlx\ -for-pack\ P\ -c\ A.ml}
+will generate {\machine a.\cmo}\nat{ and "a.o" files} that can
+later be used with {\machine \ocamlx\ -pack\ -o\ P\cmo\ a\cmo}.
+Note: you can still pack a module that was compiled without
+"-for-pack" but in this case exceptions will be printed with the wrong
+names.
+}%notop
+
+\notop{%
+\item["-g"]
+Add debugging information while compiling and linking. This option is
+required in order to \comp{be able to debug the program with "ocamldebug"
+(see chapter~\ref{c:debugger}), and to} produce stack backtraces when
+the program terminates on an uncaught exception (see
+section~\ref{s:ocamlrun-options}).
+}%notop
+
+\notop{%
+\item["-i"]
+Cause the compiler to print all defined names (with their inferred
+types or their definitions) when compiling an implementation (".ml"
+file).  No compiled files (".cmo" and ".cmi" files) are produced.
+This can be useful to check the types inferred by the
+compiler. Also, since the output follows the syntax of interfaces, it
+can help in writing an explicit interface (".mli" file) for a file:
+just redirect the standard output of the compiler to a ".mli" file,
+and edit that file to remove all declarations of unexported names.
+}%notop
+
+\item["-I" \var{directory}]
+Add the given directory to the list of directories searched for
+\nat{compiled interface files (".cmi"), compiled object code files (".cmx"),
+and libraries (".cmxa").}
+\comp{compiled interface files (".cmi"), compiled object code files ".cmo",
+libraries (".cma") and C libraries specified with "-cclib -lxxx".}
+\top{source and compiled files.}
+By default, the current directory is searched first, then the standard
+library directory. Directories added with "-I" are searched after the
+current directory, in the order in which they were given on the command line,
+but before the standard library directory. See also option "-nostdlib".
+
+If the given directory starts with "+", it is taken relative to the
+standard library directory.  For instance, "-I +unix" adds the
+subdirectory "unix" of the standard library to the search path.
+
+\top{%
+Directories can also be added to the list once
+the toplevel is running with the "#directory" directive
+(section~\ref{s:toplevel-directives}).
+}%top
+
+\top{%
+\item["-init" \var{file}]
+Load the given file instead of the default initialization file.
+The default file is ".ocamlinit" in the current directory if it
+exists, otherwise "XDG_CONFIG_HOME/ocaml/init.ml" or
+".ocamlinit" in the user's home directory.
+}%top
+
+\notop{%
+\item["-impl" \var{filename}]
+Compile the file \var{filename} as an implementation file, even if its
+extension is not ".ml".
+}%notop
+
+\nat{%
+\item["-inline" \var{n}]
+Set aggressiveness of inlining to \var{n}, where \var{n} is a positive
+integer. Specifying "-inline 0" prevents all functions from being
+inlined, except those whose body is smaller than the call site. Thus,
+inlining causes no expansion in code size. The default aggressiveness,
+"-inline 1", allows slightly larger functions to be inlined, resulting
+in a slight expansion in code size. Higher values for the "-inline"
+option cause larger and larger functions to become candidate for
+inlining, but can result in a serious increase in code size.
+}%nat
+
+\notop{%
+\item["-intf" \var{filename}]
+Compile the file \var{filename} as an interface file, even if its
+extension is not ".mli".
+}%notop
+
+\notop{%
+\item["-intf-suffix" \var{string}]
+Recognize file names ending with \var{string} as interface files
+(instead of the default ".mli").
+}%\notop
+
+\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.
+
+\notop{%
+\item["-linkall"]
+Force all modules contained in libraries to be linked in. If this
+flag is not given, unreferenced modules are not linked in. When
+building a library (option "-a"), setting the "-linkall" option forces all
+subsequent links of programs involving that library to link all the
+modules contained in the library.  When compiling a module (option
+"-c"), setting the "-linkall" option ensures that this module will
+always be linked if it is put in a library and this library is linked.
+}%notop
+
+\nat{%
+\item["-linscan"]
+Use linear scan register allocation.  Compiling with this allocator is faster
+than with the usual graph coloring allocator, sometimes quite drastically so for
+long functions and modules. On the other hand, the generated code can be a bit
+slower.
+}%nat
+
+\comp{%
+\item["-make-runtime"]
+Build a custom runtime system (in the file specified by option "-o")
+incorporating the C object files and libraries given on the command
+line.  This custom runtime system can be used later to execute
+bytecode executables produced with the
+"ocamlc -use-runtime" \var{runtime-name} option.
+See section~\ref{ss:custom-runtime} for more information.
+}%comp
+
+\notop{%
+\item["-match-context-rows"]
+Set the number of rows of context used for optimization during
+pattern matching compilation. The default value is 32. Lower values
+cause faster compilation, but less optimized code. This advanced
+option is meant for use in the event that a pattern-match-heavy
+program leads to significant increases in compilation time.
+}%notop
+
+\notop{%
+\item["-no-alias-deps"]
+Do not record dependencies for module aliases. See
+section~\ref{s:module-alias} for more information.
+}%notop
+
+\item["-no-app-funct"]
+Deactivates the applicative behaviour of functors. With this option,
+each functor application generates new types in its result and
+applying the same functor twice to the same argument yields two
+incompatible structures.
+
+\nat{%
+\item["-no-float-const-prop"]
+Deactivates the constant propagation for floating-point operations.
+This option should be given if the program changes the float rounding
+mode during its execution.
+}%nat
+
+\item["-noassert"]
+Do not compile assertion checks.  Note that the special form
+"assert false" is always compiled because it is typed specially.
+\notop{This flag has no effect when linking already-compiled files.}
+
+\notop{%
+\item["-noautolink"]
+When linking \qcma libraries, ignore \comp{"-custom",} "-cclib" and "-ccopt"
+options potentially contained in the libraries (if these options were
+given when building the libraries).  This can be useful if a library
+contains incorrect specifications of C libraries or C options; in this
+case, during linking, set "-noautolink" and pass the correct C
+libraries and options on the command line.
+}%
+
+\nat{%
+\item["-nodynlink"]
+Allow the compiler to use some optimizations that are valid only for code
+that is never dynlinked.
+}%nat
+
+\item["-nolabels"]
+Ignore non-optional labels in types. Labels cannot be used in
+applications, and parameter order becomes strict.
+
+\top{%
+\item["-noprompt"]
+Do not display any prompt when waiting for input.
+}%top
+
+\top{%
+\item["-nopromptcont"]
+Do not display the secondary prompt when waiting for continuation
+lines in multi-line inputs.  This should be used e.g. when running
+"ocaml" in an "emacs" window.
+}%top
+
+\item["-nostdlib"]
+\top{%
+Do not include the standard library directory in the list of
+directories searched for source and compiled files.
+}%top
+\comp{%
+Do not include the standard library directory in the list of
+directories searched for
+compiled interface files (".cmi"), compiled object code files
+(".cmo"), libraries (".cma"), and C libraries specified with
+"-cclib -lxxx". See also option "-I".
+}%comp
+\nat{%
+Do not automatically add the standard library directory to the list of
+directories searched for compiled interface files (".cmi"), compiled
+object code files (".cmx"), and libraries (".cmxa"). See also option
+"-I".
+}%nat
+
+\notop{%
+\item["-o" \var{exec-file}]
+Specify the name of the output file produced by the
+\nat{linker}\comp{compiler}. The
+default output name is "a.out" under Unix and "camlprog.exe" under
+Windows. If the "-a" option is given, specify the name of the library
+produced.  If the "-pack" option is given, specify the name of the
+packed object file produced.  If the "-output-obj" option is given,
+specify the name of the output file produced.
+\nat{If the "-shared" option is given, specify the name of plugin
+file produced.}
+\comp{If the "-c" option is given, specify the name of the object
+file produced for the {\em next} source file that appears on the
+command line.}
+}%notop
+
+\notop{%
+\item["-opaque"]
+When the native compiler compiles an implementation, by default it
+produces a ".cmx" file containing information for cross-module
+optimization. It also expects ".cmx" files to be present for the
+dependencies of the currently compiled source, and uses them for
+optimization. Since OCaml 4.03, the compiler will emit a warning if it
+is unable to locate the ".cmx" file of one of those dependencies.
+
+The "-opaque" option, available since 4.04, disables cross-module
+optimization information for the currently compiled unit. When
+compiling ".mli" interface, using "-opaque" marks the compiled ".cmi"
+interface so that subsequent compilations of modules that depend on it
+will not rely on the corresponding ".cmx" file, nor warn if it is
+absent. When the native compiler compiles a ".ml" implementation,
+using "-opaque" generates a ".cmx" that does not contain any
+cross-module optimization information.
+
+Using this option may degrade the quality of generated code, but it
+reduces compilation time, both on clean and incremental
+builds. Indeed, with the native compiler, when the implementation of
+a compilation unit changes, all the units that depend on it may need
+to be recompiled -- because the cross-module information may have
+changed. If the compilation unit whose implementation changed was
+compiled with "-opaque", no such recompilation needs to occur. This
+option can thus be used, for example, to get faster edit-compile-test
+feedback loops.
+}%notop
+
+\notop{%
+\item["-open" \var{Module}]
+Opens the given module before processing the interface or
+implementation files. If several "-open" options are given,
+they are processed in order, just as if
+the statements "open!" \var{Module1}";;" "..." "open!" \var{ModuleN}";;"
+were added at the top of each file.
+}%notop
+
+\notop{%
+\item["-output-obj"]
+Cause the linker to produce a C object file instead of
+\comp{a bytecode executable file}\nat{an executable file}.
+This is useful to wrap OCaml code as a C library,
+callable from any C program. See chapter~\ref{c:intf-c},
+section~\ref{ss:c-embedded-code}. The name of the output object file
+must be set with the "-o" option.
+This option can also be used to produce a \comp{C source file (".c" extension)
+or a} compiled shared/dynamic library (".so" extension, ".dll" under Windows).
+}%notop
+
+\comp{%
+\item["-output-complete-exe"]
+Build a self-contained executable by linking a C object file containing the
+bytecode program, the OCaml runtime system and any other static C code given to
+"ocamlc". The resulting effect is similar to "-custom", except that the bytecode
+is embedded in the C code so it is no longer accessible to tools such as
+"ocamldebug". On the other hand, the resulting binary is resistant to "strip".
+}%comp
+
+\nat{%
+\item["-pack"]
+Build an object file (".cmx" and ".o"/".obj" files) and its associated compiled
+interface (".cmi") that combines the ".cmx" object
+files given on the command line, making them appear as sub-modules of
+the output ".cmx" file.  The name of the output ".cmx" file must be
+given with the "-o" option.  For instance,
+\begin{verbatim}
+        ocamlopt -pack -o P.cmx A.cmx B.cmx C.cmx
+\end{verbatim}
+generates compiled files "P.cmx", "P.o" and "P.cmi" describing a
+compilation unit having three sub-modules "A", "B" and "C",
+corresponding to the contents of the object files "A.cmx", "B.cmx" and
+"C.cmx".  These contents can be referenced as "P.A", "P.B" and "P.C"
+in the remainder of the program.
+
+The ".cmx" object files being combined must have been compiled with
+the appropriate "-for-pack" option.  In the example above,
+"A.cmx", "B.cmx" and "C.cmx" must have been compiled with
+"ocamlopt -for-pack P".
+
+Multiple levels of packing can be achieved by combining "-pack" with
+"-for-pack".  Consider the following example:
+\begin{verbatim}
+        ocamlopt -for-pack P.Q -c A.ml
+        ocamlopt -pack -o Q.cmx -for-pack P A.cmx
+        ocamlopt -for-pack P -c B.ml
+        ocamlopt -pack -o P.cmx Q.cmx B.cmx
+\end{verbatim}
+The resulting "P.cmx" object file has sub-modules "P.Q", "P.Q.A"
+and "P.B".
+}%nat
+
+\comp{%
+\item["-pack"]
+Build a bytecode object file (".cmo" file) and its associated compiled
+interface (".cmi") that combines the object
+files given on the command line, making them appear as sub-modules of
+the output ".cmo" file.  The name of the output ".cmo" file must be
+given with the "-o" option.  For instance,
+\begin{verbatim}
+        ocamlc -pack -o p.cmo a.cmo b.cmo c.cmo
+\end{verbatim}
+generates compiled files "p.cmo" and "p.cmi" describing a compilation
+unit having three sub-modules "A", "B" and "C", corresponding to the
+contents of the object files "a.cmo", "b.cmo" and "c.cmo".  These
+contents can be referenced as "P.A", "P.B" and "P.C" in the remainder
+of the program.
+}%comp
+
+\notop{%
+\item["-pp" \var{command}]
+Cause the compiler to call the given \var{command} as a preprocessor
+for each source file. The output of \var{command} is redirected to
+an intermediate file, which is compiled. If there are no compilation
+errors, the intermediate file is deleted afterwards.
+}%notop
+
+\item["-ppx" \var{command}]
+After parsing, pipe the abstract syntax tree through the preprocessor
+\var{command}. The module "Ast_mapper", described in
+\ifouthtml
+chapter~\ref{c:parsinglib}:
+\ahref{compilerlibref/Ast\_mapper.html}{ \texttt{Ast_mapper} }
+\else section~\ref{Ast-underscoremapper}\fi,
+implements the external interface of a preprocessor.
+
+\item["-principal"]
+Check information path during type-checking, to make sure that all
+types are derived in a principal way.  When using labelled arguments
+and/or polymorphic methods, this flag is required to ensure future
+versions of the compiler will be able to infer types correctly, even
+if internal algorithms change.
+All programs accepted in "-principal" mode are also accepted in the
+default mode with equivalent types, but different binary signatures,
+and this may slow down type checking; yet it is a good idea to
+use it once before publishing source code.
+
+\item["-rectypes"]
+Allow arbitrary recursive types during type-checking.  By default,
+only recursive types where the recursion goes through an object type
+are supported.\notop{Note that once you have created an interface using this
+flag, you must use it again for all dependencies.}
+
+\notop{%
+\item["-runtime-variant" \var{suffix}]
+Add the \var{suffix} string to the name of the runtime library used by
+the program.  Currently, only one such suffix is supported: "d", and
+only if the OCaml compiler was configured with option
+"-with-debug-runtime".  This suffix gives the debug version of the
+runtime, which is useful for debugging pointer problems in low-level
+code such as C stubs.
+}%notop
+
+\notop{
+\item["-stop-after" \var{pass}]
+Stop compilation after the given compilation pass. The currently
+supported passes are: "parsing", "typing".
+}%notop
+
+\nat{%
+\item["-S"]
+Keep the assembly code produced during the compilation. The assembly
+code for the source file \var{x}".ml" is saved in the file \var{x}".s".
+}%nat
+
+\nat{%
+\item["-shared"]
+Build a plugin (usually ".cmxs") that can be dynamically loaded with
+the "Dynlink" module. The name of the plugin must be
+set with the "-o" option. A plugin can include a number of OCaml
+modules and libraries, and extra native objects (".o", ".obj", ".a",
+".lib" files). Building native plugins is only supported for some
+operating system. Under some systems (currently,
+only Linux AMD 64), all the OCaml code linked in a plugin must have
+been compiled without the "-nodynlink" flag. Some constraints might also
+apply to the way the extra native objects have been compiled (under
+Linux AMD 64, they must contain only position-independent code).
+}%nat
+
+\item["-safe-string"]
+Enforce the separation between types "string" and "bytes",
+thereby making strings read-only. This is the default.
+
+\item["-short-paths"]
+When a type is visible under several module-paths, use the shortest
+one when printing the type's name in inferred interfaces and error and
+warning messages. Identifier names starting with an underscore "_" or
+containing double underscores "__" incur a penalty of $+10$ when computing
+their length.
+
+\top{
+\item["-stdin"]
+Read the standard input as a script file rather than starting an
+interactive session.
+}%top
+
+\item["-strict-sequence"]
+Force the left-hand part of each sequence to have type unit.
+
+\item["-strict-formats"]
+Reject invalid formats that were accepted in legacy format
+implementations. You should use this flag to detect and fix such
+invalid formats, as they will be rejected by future OCaml versions.
+
+\notop{%
+\item["-unboxed-types"]
+When a type is unboxable (i.e. a record with a single argument or a
+concrete datatype with a single constructor of one argument) it will
+be unboxed unless annotated with "[@@ocaml.boxed]".
+}%notop
+
+\notop{%
+\item["-no-unboxed-types"]
+When a type is unboxable  it will be boxed unless annotated with
+"[@@ocaml.unboxed]". This is the default.
+}%notop
+
+\item["-unsafe"]
+Turn bound checking off for array and string accesses (the "v.(i)" and
+"s.[i]" constructs). Programs compiled with "-unsafe" are therefore
+\comp{slightly} faster, but unsafe: anything can happen if the program
+accesses an array or string outside of its bounds.
+\notop{%
+Additionally, turn off the check for zero divisor in integer division
+ and modulus operations. With "-unsafe", an integer division
+(or modulus) by zero can halt the program or continue with an
+unspecified result instead of raising a "Division_by_zero" exception.
+}%notop
+
+\item["-unsafe-string"]
+Identify the types "string" and "bytes", thereby making strings writable.
+This is intended for compatibility with old source code and should not
+be used with new software.
+
+\comp{%
+\item["-use-runtime" \var{runtime-name}]
+Generate a bytecode executable file that can be executed on the custom
+runtime system \var{runtime-name}, built earlier with
+"ocamlc -make-runtime" \var{runtime-name}.
+See section~\ref{ss:custom-runtime} for more information.
+}%comp
+
+\item["-v"]
+Print the version number of the compiler and the location of the
+standard library directory, then exit.
+
+\item["-verbose"]
+Print all external commands before they are executed,
+\nat{in particular invocations of the assembler, C compiler, and linker.}
+\comp{in particular invocations of the C compiler and linker in "-custom" mode.}
+Useful to debug C library problems.
+
+\notop{%
+\item["-version" or "-vnum"]
+Print the version number of the compiler in short form (e.g. "3.11.0"),
+then exit.
+}%notop
+
+\top{%
+\item["-version"]
+Print version string and exit.
+
+\item["-vnum"]
+Print short version number and exit.
+
+\item["-no-version"]
+Do not print the version banner at startup.
+}%top
+
+\item["-w" \var{warning-list}]
+Enable, disable, or mark as fatal the warnings specified by the argument
+\var{warning-list}.
+Each warning can be {\em enabled} or {\em disabled}, and each warning
+can be {\em fatal} or {\em non-fatal}.
+If a warning is disabled, it isn't displayed and doesn't affect
+compilation in any way (even if it is fatal).  If a warning is
+enabled, it is displayed normally by the compiler whenever the source
+code triggers it.  If it is enabled and fatal, the compiler will also
+stop with an error after displaying it.
+
+The \var{warning-list} argument is a sequence of warning specifiers,
+with no separators between them.  A warning specifier is one of the
+following:
+
+\begin{options}
+\item["+"\var{num}] Enable warning number \var{num}.
+\item["-"\var{num}] Disable warning number \var{num}.
+\item["@"\var{num}] Enable and mark as fatal warning number \var{num}.
+\item["+"\var{num1}..\var{num2}] Enable warnings in the given range.
+\item["-"\var{num1}..\var{num2}] Disable warnings in the given range.
+\item["@"\var{num1}..\var{num2}] Enable and mark as fatal warnings in
+the given range.
+\item["+"\var{letter}] Enable the set of warnings corresponding to
+\var{letter}. The letter may be uppercase or lowercase.
+\item["-"\var{letter}] Disable the set of warnings corresponding to
+\var{letter}. The letter may be uppercase or lowercase.
+\item["@"\var{letter}] Enable and mark as fatal the set of warnings
+corresponding to \var{letter}. The letter may be uppercase or
+lowercase.
+\item[\var{uppercase-letter}] Enable the set of warnings corresponding
+to \var{uppercase-letter}.
+\item[\var{lowercase-letter}] Disable the set of warnings corresponding
+to \var{lowercase-letter}.
+\end{options}
+
+Warning numbers and letters which are out of the range of warnings
+that are currently defined are ignored. The warnings are as follows.
+\begin{options}
+\input{warnings-help.tex}
+\end{options}
+
+The default setting is "-w +a-4-6-7-9-27-29-32..42-44-45-48-50-60".
+It is displayed by {\machine\ocamlx\ -help}.
+Note that warnings 5 and 10 are not always triggered, depending on
+the internals of the type checker.
+
+
+\item["-warn-error" \var{warning-list}]
+Mark as fatal the warnings specified in the argument \var{warning-list}.
+The compiler will stop with an error when one of these warnings is
+emitted. The \var{warning-list} has the same meaning as for
+the "-w" option: a "+" sign (or an uppercase letter) marks the
+corresponding warnings as fatal, a "-"
+sign (or a lowercase letter) turns them back into non-fatal warnings,
+and a "@" sign both enables and marks as fatal the corresponding
+warnings.
+
+Note: it is not recommended to use warning sets (i.e. letters) as
+arguments to "-warn-error"
+in production code, because this can break your build when future versions
+of OCaml add some new warnings.
+
+The default setting is "-warn-error -a+31" (only warning 31 is fatal).
+
+\item["-warn-help"]
+Show the description of all available warning numbers.
+
+\notop{%
+\item["-where"]
+Print the location of the standard library, then exit.
+}%notop
+
+\notop{%
+\item["-with-runtime"]
+Include the runtime system in the generated program. This is the default.
+}
+
+\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.
+}
+
+\item["-" \var{file}]
+\notop{Process \var{file} as a file name, even if it starts with a dash ("-")
+character.}
+\top{Use \var{file} as a script file name, even when it starts with a
+hyphen (-).}
+
+\item["-help" or "--help"]
+Display a short usage summary and exit.
+
+\end{options}
+%
diff --git a/manual/manual/foreword.etex b/manual/manual/foreword.etex
new file mode 100644
index 00000000..c595abe6
--- /dev/null
+++ b/manual/manual/foreword.etex
@@ -0,0 +1,79 @@
+\chapter*{Foreword}
+\markboth{Foreword}{}
+%HEVEA\cutname{foreword.html}
+
+This manual documents the release \ocamlversion\ of the OCaml
+system. It is organized as follows.
+\begin{itemize}
+\item Part~\ref{p:tutorials}, ``An introduction to OCaml'',
+gives an overview of the language.
+\item Part~\ref{p:refman}, ``The OCaml language'', is the
+reference description of the language.
+\item Part~\ref{p:commands}, ``The OCaml tools'', documents
+the compilers, toplevel system, and programming utilities.
+\item Part~\ref{p:library}, ``The OCaml library'', describes the
+modules provided in the standard library.
+\begin{latexonly}
+\item Part~\ref{p:appendix}, ``Appendix'', contains an
+index of all identifiers defined in the standard library, and an
+index of keywords.
+\end{latexonly}
+\end{itemize}
+
+\section*{conventions}{Conventions}
+
+OCaml runs on several operating systems. The parts of
+this manual that are specific to one operating system are presented as
+shown below:
+
+\begin{unix} This is material specific to the Unix family of operating
+systems, including Linux and macOS.
+\end{unix}
+
+\begin{windows} This is material specific to Microsoft Windows
+  (XP, Vista, 7, 8, 10).
+\end{windows}
+
+\section*{license}{License}
+
+The OCaml system is copyright \copyright\ 1996--\number\year\
+Institut National de Recherche en Informatique et en
+Automatique (INRIA).
+INRIA holds all ownership rights to the OCaml system.
+
+The OCaml system is open source and can be freely
+redistributed.  See the file "LICENSE" in the distribution for
+licensing information.
+
+The OCaml documentation and user's manual is
+copyright \copyright\ \number\year\
+Institut National de Recherche en Informatique et en
+Automatique (INRIA).
+
+\begin{latexonly}
+The OCaml documentation and user's manual is licensed under a Creative
+Commons Attribution-ShareAlike 4.0 International License (CC BY-SA
+4.0), \url{https://creativecommons.org/licenses/by-sa/4.0/}.
+\end{latexonly}
+
+\begin{htmlonly}
+\begin{rawhtml}
+
+The OCaml documentation and user's manual is licensed under a
+    Creative Commons Attribution-ShareAlike 4.0 International License.
+\end{rawhtml}
+\end{htmlonly}
+
+\section*{availability}{Availability}
+
+\begin{latexonly}
+The complete OCaml distribution can be accessed via the website
+\url{https://ocaml.org/}.  This site contains a lot of additional
+information on OCaml.
+\end{latexonly}
+
+\begin{htmlonly}
+The complete OCaml distribution can be accessed via the
+\href{https://ocaml.org/}{ocaml.org website}.
+This site contains a lot of additional information on OCaml.
+\end{htmlonly}
diff --git a/manual/manual/htmlman/.gitignore b/manual/manual/htmlman/.gitignore
new file mode 100644
index 00000000..3500ccc3
--- /dev/null
+++ b/manual/manual/htmlman/.gitignore
@@ -0,0 +1,10 @@
+*.html
+*.haux
+*.hind
+compilerlibref
+libref
+manual.hmanual
+manual.hmanual.kwd
+manual.css
+*.htoc
+*.svg
diff --git a/manual/manual/htmlman/contents_motif.gif b/manual/manual/htmlman/contents_motif.gif
new file mode 100644
index 0000000000000000000000000000000000000000..5d3d016702478a74ae10ef900888bdd3c379aa3b
GIT binary patch
literal 316
zcmZ?wbhEHb6krfw_{abP1q~Da{|7M?|0yXbc;*)57nP)@D5MqT=PE=5_$p-PCZ?xa
zDU{?V>s1uwGARCJVPs%nX3zm?0h!{!^!$#Qv4ElRF^Oazg%$xP4gr?K20Vui7@8Cq
z96<~aYG7bFXduDE)_gF*K!Sm#!2w8tc?<#^EKH0F0@&nWDh*(OL4iR)0LC#eU{Fv%
q765UP1Rz|v0LZ;S{U8800mw%-4`?77pMe2nUBZC|MrJMs25SIR**_xy

literal 0
HcmV?d00001

diff --git a/manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.eot b/manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.eot
new file mode 100644
index 0000000000000000000000000000000000000000..487aa40a07b90c78d74205677641a6c5a4bbdf97
GIT binary patch
literal 24643
zcmZs=Wl$X64=%j8+v2_~uEpKm9f}us=%U5l-Q69EySqCShf>_#i-!
zjMuCtZ8W@oczDui@fUIOWO3uj^3s_?#eRT|ZS+DUsv_yH4C@u}%3FBI46)jh-FTSA
z=%xGPXHG^dRy9_5gHYJ;Y
z0Jfb}EaP5hfYOGHABlr&LkH15bJ~>g6$0TiML+R0$KR%`keO6M8$#Z0x*ea2oc^Cyb1zrT!OJJ
z?I6+(2KqCnn6NWmgzWGr3UP$HW-!(|ck3&AcR?dZ}HZg3=@uGg04ofOm
zk6k$LQqIGQdSToErR)(uYM3l;@y?!)mP9g)VcX
zjC&{|XHv#k(b9XlI^MnjWM2_`1M&y?u%A|}OmABGOAAg?JhGK?2?WVGgQ8-QS*kmZ
zH9eRpc~V+BFN
zpO@+T8lK(Espj2#*hQ|BVfJBcC(ffQQ;iohG5{$**9h9_Q05gAvYg=uvblLdqe*@@
zQ8NsdU=##&-4+>CkI8^tgG=ZG_@&{Dp>B6H2ftw)>`-M94)(>?nmY$YgHadF3VxW)
z2Wem9_R1RJ{$;rufUc@Hftzd_qWZ%SmoK^xwyQ=*X((plH1QvJhLP2aj<+)r3q5|t
zBJ-7xlx-nI!j->tW;$hlQ5!7#-V)xwSr&)Q&#I9v4>D*Z`B+7p%x`$zc!Kd|ml}}_
z|Gh5Qm|noqgJQHmZLCR`7{(>Edb5;E@<~&TH9|WgYHh9ZoZJ(mdV;j%JKlZH2(1?&
zImDADY?Z*v_^kvgSnzjCL_i8CFN&(T;w5s!rrd@vZ#Dy@gBUVlHQX*K^{ts#mpA1R
zfq>T)8QsHmf0vYv*^sUWfscdLst{pvShZkcv?O;uOyD-dqFsGxlycsg33@n+He!i61daq%dCTshQ+CYQ*5)0fc78~r7gA!
ztLNg-(wp+SI;E^NSTnh%)7cWWQjOW1L(+^YxZBK64iZ61teyNuNj?xPdUSzFkqdQz
z(omYE9w39!B1J%zl>>u7Ziy$c{@%BG45Z=O{MU9LJ|eJ1ct=2S?Faqh(19H|cBXzH
z$HA5@_b1BHfcyrL7W@}KRO(8Mw2&XO#FsL3cA!gFGn$!+S21-Q+5Bp{)d!Lr5gX}l
zlMok_Cmd6t4iKV)M#~uf*}V;E&sD^5MR9c`E`N}aw6@mA9l^QD;$=lSQ4}a*rk`T0
z$JEA@chu~ZR7DVD#Um4%YA?QwWT#Nfr$tcc)gKH)j)S4OH$TKu%s>U0B+SC@U11`gJ|ra#5!fP&o|l#=ip)97O6%3f&d#7X_E}JG>ZhnN2b5jm
z2t6s7Af~<0m6W2(u8zLfjN3sroi@nDx9m1T!DVxd-xhkC4&hLKU8O%6>uDGiqS&CS
zJC_iBg!Lgxmax-a9Ri@cgd)&3xKdXMoa;#cRBMVVO72-`HToPe0Nx0T{LmM
zVfjV1hI%D0RwJxzR?@wg2bz*B=!SzJj7O_L!Kl}zrz9q8SyNQVkX0C|avOmc
zY|yNL`@HF^z)3@CB@6qehvW{k4+IP@C_3@3xoy-jCYta+`l0!00tWu$qAp7#_1yLvt?p>W-;~*G#
z{MerIcU1_pEkcnxRQ*Zv>j>4g7v5)q12w`c%N;eMCQZSdu2Y09ON@oP_WlitF8qpK
zhlB^0&Dba3!G3=bS`MvF!@k6#)KoH~@Qs4#mSf7R<`{M#Z^&QckG6zFEZs^q5R`0Y
zg`*$yoPe|-j;^elIql)^As1ER4i$0PdJ=G={+;p;zgrNMIoV%$_HQ~Mu~nIzdkSu%
z9A1%T{IZQFr_~{C0>VP9a)%-AKoX3=I_Z>by>FpC-w`0jMweW+wR;5CA?i7nGQbe|
zjwK!)^0(fjMkmled--iaOkJiW@ct661%#s;;0*!9p>QwL?AQhpLUC<{5{-cWZ2p9k
z6lYxm<%dW-EAFO`Jsq}b7iPth<&uaNw1KlxL_^?fBG-vZyzJxjY%;%oQd&CMCpuX)
zvXBz^l*U1t5?~~qsm)f
zw%M0WCr<;Wi;O^kNE$u81+PFzxu{KL3@xHKK33{{kkn=jb_H}E;T#>!QQVF_DD6<=
zdTk()4O3b>>79(S1l@I^3i^n9LQv?mT&D<^CB+l!4C{#qe;^)ES+jb4ab#GSb;*wD
zY*%!w=pqpKFXC(jE7e$t(`3mO8cp<}^zFLBeOfq_nJI=6z6p{3eXz-|Tdc`IiyzGz
z9i+E1OgD<|iJLbUUM2*ek%S(D
zFSkhL2X~OmvzSARSV3hfk1or092(k}r#Q4lLs53L6~YF@KP;l6GBy_J;080{hf|A`
z8tjNLtuym`VfK2m0r<=ALk9{peoD^IyM~0e(X=lkfiKYN0EI2Fs|c=@cgP`qnePSUX}tHh=$+`DgNIN@SS?B^E}CQCIK4
z1(hZJa^B>PpEABHh41lUEiI@g;;NX1TJn`IkYu2=T`V(kO}R~u&6EEJTBeiZoHuUD
zExXA7yFblN$==~&ddK$078|OqQmf>2cvyWI#|5h^)n!b|6oD+IYmrstwOnTs>%os*
z@etlDas2!EX=1*Pr~hvW-q*yX3y=JO7?Kph&xi-c0uzl2>?iUMNl};O(^-4o+oyoO
z=vgM!WDb(OV@f&P(Fg`$ab!|9?+LUjcYbCdNAV`+O-GEiG^(X2Efq#v|0lk*X1#{
z1$I;KA}X(R`G9jWzX#eD_nA^K(slX?uK1j-1>%w+hIcpNr*+^L8@sMS_xmfLh>yhfm=k-sS-02HB
zn4F^j6srBWe}bFgl9{N{mpE{#X>eMYW#NxvX&;<5=yOMiiz#@_r`fz{ZK-zCZnmj1
zfaK{qO?-uRX>hI$JhA-dK*fueLjB&#aRzQW5!`tP&wJ!45Vj?adXUyb^Wr$}k>;#}
zM;!e$hbl|3`dR$)_L#?|%6W&Q_Oul(in`TzIlJq1X(!BwEC1FQ(ie|a`_sR30i`oID;#mmH)=i*d#?3l)uaI~lDt|UNPLV6f-0_to_b$vD;`M{
z1I-W^6#a7jXz?ugv5$l4lul;lDV}RvE6B@2vQfZ;&
z{m8VkRKc$zS9;^c=E>>3+J>)3f4pq{)j%J*lsiH+x)yqGVei7+T7SbqZsTCf0kL6(
z4M}Ot7XO=dU*S06FPlJ?CHz|P(Eywus5G}Z@r!OKrwp6rPJKVr_5zD|3TIX>l<2(b
zfRAPc&UkDf4^{%!;1+sCx4ks6t5T_
zE(&YcqQ&-D&5S2$GsEGWB_}-LoxYfFcS9I7@PL<5azHwj73s`?lC0UFHI$_lddnLT^h~%Cf&O5@YSq?~jEAKR
zlVIUUzX?vqy7eM}61!gT#kFKZ6o5KDhJwpEAzp%&cm0zph=VC8KRrYL?R6Db9~frm7ysyY_b$bPES+P)f6
zdLe|8lu0YKpMmD>`I$Bb_ET!NEI0_2$x0nNXeEb|MJ`O2TD#Fx!KiHt$6H5PM(aQ5n=t~uKf*KL3e;yP&RKeH+$FmSpIenC|Z!bk!6_!QHwNe#*m
zWa^2za^?2irLN^${;Oa)y3WVQS^y=AjkQ>(UALr_{|#{uzAjVzXQ!Zdi28ZmY}Gb->&*>nV?NF<~2
z=L%c1?i6Mz`fGV0WLDIg+I1|FBgt6Fz^u}p87~Deed<_5C`Q$y
zLqRxq6e&}JK#T0mhK%}Hu;htt`G$!C1Iqvoh+7EfTn_#tw_lHNzI!2P2+vxoPD>iV
zr%wP8nMG|%+Ee9Ui^|&&^lO4Qgw~ZkaNL)_27$1tM&Jny)+W5cuer-Wc%%YR6bKa)
zldetL(e2Mizf+B@N$57(80JDubGDl&t`Q)?#WT%N@Dal?Tld-^twfrjB&`riT$WF_BHhq#QK;Rzz8zE9U=TTK^iu{U?|>!vOSw3s%tk{C
z9j27&uo!!U-l8&hjF{xB1f~|pW_$2`gvtXLr3~FV|HPX4fepqNF%bEs0(*!qU@)k_
z9Z6LHv4WHe4By*dU|XdjRUbhTZjT5~+d~*PpjqN3mNQ(*^O74$hp}>
z#B)lPcWrJ$+_9xaL9@k3_i2~CW)`JkMbivYxj@H;{~Cj$ijpyB-8^3!_Oj@-Wwp_m
z;^R^>H7*vthca!6IoCD#J3@Z=x^hZ`NVIYBZquFdTOFvMCC7$+1~rsojERopLU;nDbb0DkSs9g%`MUqGGg2^&{CG)4PNW}oA}9i>ej=-BAfkQi
zI(3s>VwA4%{T}l+8CKBJ27^!xgFusGR3+v%QQBio+GDUl#q1E;8;@1RY)N9{67#7u
zg6My@muRmcZ(Y)=?K{?G3GCCa0imwByfKIUwI+#@xO9niq|18Pr!xe7hRLJwfTzhs
znL_r7dncUjC{|_^D1K<0KrT0~EiZ?%SBE9NOgoK)_JacbpY}G5(k4I8PEOaOzirH-
zp58~8d%PAtNIY`)PTd$n!I2Y-$0#WH+Q<=4CPcdrAg!1?6{<6pa3pqb2si^6xFMlNrtgfL
zjDj=Y+YH?doHL+*v=@^LA9_&^yYVn`olR;>ghC(`HODvrm7WfDpiy
z(ms3eBn8_q^cQJ|PX7TvyD0AcEfBsTxHOgWU*bcW_?Kiho;|>;=fyKH@sD*Ntlsj#
zt$@az@W=#>X
z;Tf?+Mme1ua+u;I7|@<4`K|(Xq)nu(+xZi_l5mNXIA1RuIu1-hio(rCGQC({lg_^y=+Y!JA4kY)s^~yNN#%*@Kl4ICUCdb`39S0O&
zuU^rr4d%_>!_(#!UTb$D)(iPu0|LiMFtzgLa4b$$eYL#_fp+uOoM5Z6)
z_%cj&@I~5+G=nb9xW4ILfVTq8Ump{c=mZKZM*;hX)Pxu^Fb
zCd=Ya1Ijnq-y_8?-hgTkQ{+p_J4yoOax?QwB1Jl~;UamIafY{NGfQchwy->m!%GS|
zPDrvrIBud9bA^__KCSf*oXH2Gnun~!g1~oXYD^?08mLUKm#n`9vFP$q{so13-F_7t
z4IZHT74CH#wv4cf2S~%ia_)F%Ii-}yOLTe-nm}L2)nlnv(;Y)4%IV=#g
z=LR?Zl4l`TiQkB|_VxO!XU+pYk>x6jm#fy_+~{3NrGiCV%Su
z<&p#Kj_i2u;6mQ|B7-C%H(@A~L_c0x%AVYNrQP&)i$Ezy>q>_AP%^KEo+;vnJ#-Wv
zpYfD*xK$~f3`HJKr_Lmb>qxgs+l@wvKO7w*=Yj|7m`CSl!CXAWjWR;hD
zB11E42IDTR*K8^G4`R#zj|^DNI)NSK$9Zdq&0mSizEzk2z~-%rIo)R
z4~40?L2*ANB=DEl-m6Nfw0MNS!5RN>v~^K>|6`AC3yfHrSHzfXxM}}7DpdZr4mx-~
z2<#8D+P!bFA2YbOWCytJ1zBNGMv`UCBz~IYgfJxn)Y2qq{^ELAS$f^-=so(HTbZ})
z9!OcKA#s6jUcW1MdHaiF2~^biLD*i2)UyA0s8Cd-0=oaHm1_ldn~O+Q6gB3J&$dCw
za(0Q?Io>RRvo`X6Km`#UR^j3JZ59y2>BtLCQDAfCzzQWpCmeb`Hu+vAQ
zP4GY|r^84WGN3wQ?Fd7vLO1~zM6_&}Kf5d&V_AW&93$FajMxOw{D8(-?6{mHMR6qq
zF}}Zauju>5?7gA|Qc^l-SAS!I_^F_D&R7W}sdr%`*-@xp9NU73>iQjkmPkki1tq%o=egcu}NvAd95Q<1%-s#BiPm#w4MKAZP-0*i?&Yd!v!
z@zhyjQ7Nrtr)QYa1}!4mxSCd~=#>HULRn8z-Kex+RNLd0$zT!xgt_F)%vv@>n6boq
zMru{OoQ5j>WT)%kz7%ncX|~h2M%2Q=WJ#yrK&Xj>+S-CIR6R|o=F*6EB2d_h7BJBa
zi}CA{uuZjh)MKTad87ymI1`OH54aoAZf3S0dJmn!_1e)LRN7dAqf%!fhyWs6A(ejmem$~Kb(0oxp)HP)g6>_CIgOl@KM=sX
zzE;dZ@caVDTj}!BC&_uibwgHiAgxBN$ZX%|@4R1Ny5wzos_%6KhkuBU8K7>s9Zd&y
z29t7a^XT`G=>SSbP7l_2-|4qw%WR{;MkX}hux{^Rh6IBsJt1}Y){=ZcC$XK_qFy*F
zf8(pUcUK86UBHn;P-cZ2+-$)dD
zyN2|N4Ycg};z1FihROX19X6CfviccpcCW*M34v#NDiKSE@0CpHOI4w0IiDu(!3OzB
zMQCk*w`$&qnS|5G>?W+VlL%CR%;eFR##Z1bT|_S(bC_%}5UI+SQD8BR))ad0_>E_mlP3icdXR8>A+kXEBuE`@Xcy?)Qs}X|VM?Sgxux6xY
zvqV+6oxcbu+%auM68vo-s2PdqLr^h?ayuLfDhX>y?ZWG0xwX=cOP{o|hDY;bHCo?2UMf^yk=cKyS6C8vMuoC-1Xw^xrg?)>H
zpR~_j9jUvf0p*QlL)mdDpRuZLLVMiwi{$Ze*yr&m>W8&1(1G&U{iTU^h4%<8ze`v|Qj1H!
zQ?^T<0@a52kTAikFO2lNN=6Q&C=4rzHz#Azg}F>r4O)&S+2lYUZY}CYvFbY@l9(py
z#-cz@@yN?j2^0rgFpS#TpYpG`IG
zin9fAGmXKf;d!C#asgIRrfM=7h$^F!L*C|hHF!dRSSGiasjA<`sTyG7ZU|DDhiD@~
z1(I}uj9ghAuaRMmt_Tdt-_m4p}uKc{psAwqy
z3;dU8=sH1>=4TOrprYQg!^CSiH`(~N4FD+j%Q*sDPb~M;U{RszkP-b-y1JXOtU43c6W?MF8emxp9dhdR0nf7&LDha%mrM3^m%Ebo9
zZA&Qv^ORgDHt?|;RrzsMA?3-{yDAK?mwC~r_0A
zkwD5uHL##%wTU1BWuK9kZ-UTvN!m@`vpA|vC96mH^_M^=ZwOn;d7effKE9yvk32M5
zPiEOPscCar=Z+ZqxQk8}mb*391fm-7DWKC$i1mA3aLS&^vuJw`SAo8wcaD=2Bx<}-
z)LREnRaR|z*l7!bs+x%`m~_p>w78iVi5
z2|yb0IfatDx!~T&ISUW(Y<0_2X3UtIoSp;?tg|}@|R5c$3$O2IMA-zR>Nd|W~(|zA1ZEG9=C1wZy+{TG2c`a)*
zl6+0rprdl06-%iOfDRmwu2b-1n8NUuM~Q>(q6RcMjutVLl&9JEPw^>H$e;?Ikjttm
za4T|7qLs+u*{7NE_6+k--M%$~brv3pU$<_#uWhv7vazrIpv~eSS`o!ko4Ou@OUlKPY6vj2zVnlCMNS((5C~lEV>(9FZDBc
zahh+bAXX@xg@u!g0-{;%^hYLW(n^sgTm036)OM_6aSCD|^EK?E5e|Nt5YwrZ#$6eF
zj=fB{KR!!S)rMxxHXA4a1C3ZOeDV?H{(gcU;kdHPoW(LmV>9s+B(4^SVDA7Ec*cVb
z+BF%1aJ4~5tl6^B?cpuvFwBw&UnGRW-2E7IX=VXkEuM$`X
z1|23nTBLovB(jdp*Q5FQXwWrb*UHbXds**h{LZU)xKJSyaWucPWaAlN(72pMdp$KF
zFH2Vb3{a`EKALC~<-N<AS;6I#d5>poRam)u!H47#;*)pe`BW)I%$OSsv0SiYVtv34W;CuUc%Bp&v2+@oax5
zlTvjS1QA3OB@pAVz)kkR>>WmfqDM~>b>9wruhOMtN)^G)acjwCRk;(_)8A9GHJ0xr
z>g%gBoxl=Sem^F^+WZrDU1nP?XI^RLmTe*g-e@e+6zR`uWm^-x_MxUOB(+a{uZPJo
zVa)S1nw@&hy73LXZ0})Vc>5zDkkh=JYMW4zN3_9j*rqzh)y(@>=S2df7vj#GlO2-a
zOsUu89wqW$*CJ-2o`oF$$&lKnOXMIdwoPZj#$6)J$G=jNije0H9cLUA;Imm7*RSc*e~q#SXOfQ=D>Dr*%$
z$9M4M?V0Ya&t;u9@r64)R4^_S(UFbb7o|^dQrn6aT=a6VuNtAmQ==hmKQwe8f@OdA=zudM
zwTI-i+)sy8oq)m19KQ^qQK|%*A5GpzkI-3$aSFAYBO}(}w_eM%n?NW+Xh7g_#SeF4
z$wBYL)A?J5J=8R+m1?AnpY4S8>wF~40|hlqY%!Qu@Ed2@!g7h0qwtn1M2@T$)usM7
z38FCJDLJJwQ@}Q6il>56H#MlVOi5L>ov5qfz`4}zHGg5ztDJ4E=!56ex<6scWa{rsmY)rD+w{7T-47JFT4W3Q@slGy!>D9{
zQj#8-32Qafuz#mv%|TJ&xy$VD>-i=zV$>u__uZF-^OfBSFRdXLjv1cZ+7
z+m*u=^S-ygOaiU2g7nGYD#kkd&}lDwcx3Q@iUXI>Q4dZ<%j(}xq*cYQ
zTDK@juLiLNZ;Ymw$w7NGzY;YFc+;Q~E*g@;kWr5!zo8v6&{k5!bE8_#U`(1KpqL1m
z_t8H`&Ynj~?Fm8ImS_smxsdPfX9@IG`Su*X
zST?NZE0829jz)1W>HoN$?x8$hRTwIX|3$w*;csXNL)L5oW~H3k-(m(ULzPhHey@PKFP%zW`*0sWk2`IH+H(VI)6-|YM*3yUO*
zWkm}>KB#h4(m^Qx)eTV=Wl(7e{53h^H=*xO2M59qxMAD?_gjY#a-GgqWK`G4@hayR
z)!y9~?j2yy^~>@3+6CDXg);_xjo>&Wbt5y!!=s`72aD)FvI3cj=3jVSQe9
zXd;Is6SM-eMTx8@dzHNA0@I3TUcyqWvO3wm?~MGcK{
zeSGHe1(~J`v}7M+@X%9{a=LJcMmz6IS7{_`_vRp(k|)@zPKfh3VNA1a-c*Vws>fh(
z-8j$@3c-s?3#7Io2@Mr^HSNtGHvY+kx_raa?ijGxsE#pHZJv+joeCXXrSMS!#hj?v$Epi!%%Bu2d2rOm~TCy4S}R`Ur4PcG0Lp>luznVLhb{@uMUsiY;&1($HS
z4adTFdvKC|M;r54m%&d*y~nu(^NMum>xj=?I6`3RfGIqF+^3IG6+-a1CUTMA(f|X$
zy=;>mCOJpfr#GLuJAFyO7Tu-=CBn&V3S!7^r%I4~B9ihRqNOnmIx!X6-ex-lt#uDF
z55}GYz+beWSlA1XcsBUR;us-tr2`V+QdTTxeXMF~LfvKuSV&hVwd&DTflkquVZ)Dg
zM4=Wv)V6yXlm+F8`nwi2?CfSH4N?x=s!<q(WXXr(8`rjhQUfSFQgp$BExdC>VxVG>50{Xt4R^5rIwu
zvi5c()v?|np*uR}WmMx4sX;;AmJP?fWs<}mu;fuBjnYnoUY1#BW3<#u4z}0uMEOCU
zM`09S7p<*Re*@z7-_u2DIb&)yVStO6cO1Zlb30VMDa?c^lIk&9k1gmaD04QEvNRC4
zI@Fp-38P!h#imR7Z<}GA=^OM^4h1urMD2^RQ$_RZ8r0}xqcI0S21g>vG_5(KP=pB}
z7_q3n?q9X+wF;wh*5pD7kVtsTT|1`@JT?@;+V^2Gj!u#6>QMuvfZPdWgohSF%|8_l
z@wt=|g|&x?H2uD`;>E@YTpRw2KWVk85sqb$6GQ{lUd
zY#ZI?kK6mrTtgaLsJNC4^~We<3!&2jqa+uH=sf|&TKF_8K`bsGrA~7I6EBj!6=b1E
zSc_>703I8HKU+c&@j+QBZq*_Wy0OWdI;yokDrsKcY`y2yTW2G@stPwycNr7lL-?UN8f7&7m$Xnjeu3i%2
z(gOx@C3P7u8Z45uN&f}f_m0F^wl;nRmV-lTXV=&8|3I@9%P7%Spuzy)?5v*ZakZ_o`lB_i~}A~J#_$8|vEaX%5?oSRf9
z&kI7m&!mzo_DMbO0vQFb)1ul|CoW$rhpQwiW%2D@0W~7Q5pPnu72PGxe>KVVrV(dF
zIDt*?9e}KH=948$GE|NqBE-&8@OEFJ=o(|dT4Y}#)Gu*MBx-%eOvg1c+E1Ad!nLE%
zFTaq8pUOhNudq~azo1UQT1}BGuYz|p3Y$D?}TBhkDQn(*Y$UZ&X
zx=;@Htt9i^r;spT&#;Ob#S@Y&q@m~+)n>Zujz%ad%P1fxad~S>zhuX?16%Z6F4P=R
z7ag-CR2y1er8Ftn2%xd1IYxm!_T#^D7<^DAL=*nqj7fqXYvy@Ek||HI-cu}47RVi#
z?cUcyeSbLb{7UB4|KqU}@(^nxM`o0uWQ^F>-I`7XlDH9w4{X*cl^z}X&KJY5`cISU
zOh#BXs&>J=k=zS)ssT!pqIIXah&LRUjo664$;1M;)oADx^cIp#PO_6*FnaFE8%jhQ
z_EkOjZwLeIS4T32v?=utRVR3+D0HS2QtKZ!%^zW?rs60=BEI!SI$n9@wixYWLq}z6
zg;IOmD=$~QuxUwL
z-9FJ`Qi+M&0Dg2^bJ4Q=t`Tg!D{S+JO275@W=MsRMg&*P=FWUm0(!<7BRGHgdORs2Rs~JlFxgB{V-Biih6G
zkXt}eZrp^Sob_#J%i=VU^VW6^tCsM!ZkcuhIF&+}L~x4e1$rz6EoO`A`y{lg1h1!!
ze|Xh<(ZpWWOMWSai^_&Jg+0wNTh89dUzI*H^w60-E}lW?)$!}y%Yn#5EIUTLwvwV(-MprBquq7Jm~||kp)e_qAs>b
z@;RwUXToKaA!do;$75LR4dl)8ycmH`34=Mk8MNq`+mZa8mBQ(@9w#3hY8m5&G@EEL
z!|9#G0Xtn$l){1AQJQKP2A@k!theE4nl@Xf=D9*0Z?LY8;-tc|)cQg(HaBW=Rz_!~
zJ=ozT9|(Wbd(rd=BkM@-_~}=M?K)3;Ya)-?(39i2*;E@d|A@>0$1N4p21nzo2lLEn
z74!Fj|4r)?iH!N>)J(X=*tFf$fKGGD>+z-s!{%-BZ#G#!!ng6Pu;qgnre91`r|2KFi}mOy^jTfk@n5%%0RpHiYH
z97l%B6`>XCOJ)jm&nxSmSlX*LzZz<(tU#BC9>r0p4^a81%dxXY#n(#RvgYeWS=@C!
zFuPB7%b5%md|O}=p!y9oI&E^~l(0j_I>*T!hUWi1yr`p(W1AmYj*mIw53ha%L*}An
zm6o!)j1V5ffBsE|x;;4%lZkXjRqC6o^DXHvH15wq-9ut)jEDxjBB>yd4P*bx^H5b%
z{I@eHsjv3>wNVN3wf#pKG~}yKH0j+4?ALs#J5siojz9K(90knq(&i4wuJulJVgx^u
zSvA$LDj&y|${8r4i%pf^#?Z{FFYa
zsUMnlUxFV6(sFFi8&)VPTln1_q{*{;J5%T$U^{%^R80N|hEawf<|RX8@;08U@C#_~0Sxb}$~0U;3-gaAKB#Xkcgc;mJ-sq$N3Z<-(!buNcY}Cwj+iX!SyYa?oj32&ab^vIdHPOH@v%l^H;!N@raa;j0Ku-bQ(F6)dy{rmZPMP!Zd?L4
zQeE2pNM!-S-;@~v#er}P)nbpY;qB-@@1Ys{Y>Vb8P0tr?&PN!kU4lZWx>k*u%`1Rd
z06@SY;vylvg5v0o8jR$UXoNL`Y=;t73!Lsto1$P?N?`Cp}RG>%4Fa4k0S5$H0Z92<}JemHS
zr|q-sXgKWKi|Su?4a7-^45S+<+ut;Q*P>7IIFeB{q4r?n6vlvL^_~j!W
z=8U3Soz{|vbTOQ%68{bJu9Cw{g8?sJEpSZQJ7162R|bLK_sv{v5w~eI#1(UVD^&$i
z`4fst)oE_hE7K{mhVVW!j^Iv1dh52TMRaUYNBNNba&4ZawE7tm9wUl>Cu}eNQs^T9
ztCFaGp}Gx>Q4tcPDc$tU6V9;IzX9-Dl$H7;Uyx^p1j?T@(N`Pi^2?wMHPTP
zUw==Ky0>j+;Vb_3l=&J;Gw_#2{X+j$IJV>>4C!14J^*W)E)GrClLzda7f!V57-e$mH!^YGnhLDZ>
z#U)BWT~zU0#-9KRaWkN5F`=L+;+GE$<|v4Sk*=ph)YyA|SH}7exZof&vYBFuxxRqC
z&JMN=F5_b8p+||dGpwV!z8S}po>Z;N|>f}1~>sWE8BTWjSX3CvOX9VgGU0%
zRewC{!ltR%{~`$Ay{KzpPl+VyePpu!u6=4iMj{s#_$Qi>?AtI1u=bujB!~l`RPj#c
zsEib5yI`HQ3|l?51kf1oLUaSYSy~HwZmp0n5u@GMFRwsyngSMO+4D4*CaIG+xLc+
z!R+@?;IgpIJia!a^k6E0mlE1WMEIb?GS8{h^Ru^e=%pvKooDXy~0xM8e&BJo~a#3zHn
zk%e?~33BLd^#vbcqy%JfQ(BM+2Dl@ODKL`mUr*fL7zMjKikv{EY3*=&nT`9!o4R|9
z`woQ{z$j_5twL#LV@Q=ATh`i4upz@YGpMD1Sk&125??$?K7*-(yc=2EXOCBjrM`ls
ztnz0(Sp~AedfOTln&Tf+EH|9Iwu+|!v0OHemlLIJRZbu)e{9B}=$$)llHHCo!tsCI
zcKwAY3@Zql!WBIfDy?&fe>(4$%cb`2CyV1-z-tKfS_JHVBR&ibB62=L9~H(rF~j6W
z4xZ7FrECeDE-RZM=kj5J49YL4Zz(&!+{!F@nROWElKI$2=I1eFVSPriWWF(`qcrz3
zVbJ=0%5h=p+Ht~IT6lFeo@WUnUKnNhJh_LL4Xc9LoTwp-u9pty`UzT1$#Wq8`F>g-(RuFQj
z;DHidF*?1WXdj%@{S(m$8)=EmxNo440k@KRicUs^)%7oz#57^0>jwP<)DJF;%)qre
zBAQ@+1pNeLq=XF{VE6@K!!*dTlv_d^wj*%MhBwW{XN(9MnsJIkco|sbXR)7L+JwUQ
zvVBxx4Slbeq|Wuv_{#2x^=}mwmn12hKp9m^OkjVSq+29DJrLQ2^)HQCeh!LjstM&Q
zTHOs9*SAvxl`@R-KccX1tZRx%*os|4{076c9d{U&9NkFZUE(9r#k`)Tq|`K=?y3Au
zrLEBbC0S9yTctE<62B)b7Le@HXwX){sAWx`a-fZ+oxmLr-K(76Q)H44!Qhze{$AWD2JW%o6K%#D4C2MvNsP)#ota9rmG
zTP=L)IxH*Riva(!u7>=WqZk+uIJaOC2#rubxcntYn`N|sLP`f%6So%hHvmEw2y@1$
zSSkkAJpoN9&QMZGSp+LF6ux23{=AZU?1>`6z=uVCg21t+$uSowM@W{ACGpEpvP7LY
zf+QMz88IWqYAgsTtCowo5Z@W}-FyyHk|Cj8$@B45aE)nh7@T{NtM;tqRTd47NfA}^
zsPwaB1aa10GWXCfZYY-vDw%+8n*mV(V2L*~o*E_5
zWOC7(!i#t-s2WCUkP$n6EPyt_eGK57dg_^-F(+WUmKmyUiO`V+a8_IZQoTbkB=aVR
z*h;^Gg=j5vXNIgr7xPYnLa-C7N1$V(*U>Fwi-kcz~eetg6yGAbrxH4z~CI-v~(@n72#J&vUHS|Di$m>VXtIL|<+k%dp-
zgifLeln_y|auyb(cL~7!L#Wlt&>wp#6eY%+B@teMWrx%gRXLm9N=ztB^ptAPi#xxk
zD9Td7+T5TRPsnCgySwfiJ^STFi%=4op(Ts0qa8NE94Lsh`Z*{$v23{UAmDzu?2eA2
z`*XFk+o!eFSPM({{9~;1Yimk6f2~b)Xrjgy5+Q{}c(2+DT1G1tLZ2GjI@S~>1ZpHP
zQpTBE;i`}$O<6wSEL9(YWWyKwli>wkOX|3g9rBwzyMz*iG*nZ)5R?rNcBbU%rD;v=
zy!{yfL54WyrGrJlH9j0rWYZF$-<^TIYM(nbEY1iKMBnw^C{<@8K*-_6{i80ZhBhW52*Xv)58*~($Pg$a7$-aB
zU|h-bK)n2eFD$SRZmNNZ5GlH!Cf>ZZNsIk_IK5KdBVFQRaog*OIG6+bAc9(Z5rBK(
z_(mNo(tZ@Uw5Z8?wE_7dS7U{AtQ(OL>J7sM5fsU2HD+c>v<&iIClw#%9Bwri{%=}6BTiJx6yYfQkhRF
zSv&|;5u7&w57^Wa!U`b=vZ6^_%ghOGb!9H$oe9i4h+HG}TH3MKv9r4A^69AkO)W5`
z^VWcnpxsJ6MWgncsj+?-y|vH03>d2`yi*tYK^6gKqys!tm$4hQj5HMjv@Yu-o0Li{PAr4&@
z`pbPS;hKRGBsm^Yy*!v^_6_D~5ZwY`82Y;1mZja=%MQi@U_FoWiXu^^tf}Z$7`Mz+
zyr+_fClj~Bb%d?knzhB!i~AXE_(>9LAX6d*9Rg65uO$is5<
z3|9q253)3~833xX$D?4srB$
zI~LOmg0hORi8PU2o(BE&cgk$t=Jhn|g>Rwx86fB;J{
z6=CCmJS627Fx~&qd@NG%
z-=e;`db0O_r=MfNA_VB;^uj>HQ9)XimmV9&YJ=liWJL5kmDnJQL&g;6v
z&9Sz`U9sKFAj#4FwyqByuK*O2a&|c^^RwpP(rzYR;EMdX!|!*o!6yQU*q%f+cQnae
zSRlr^%}x^<`Y_|!`*%1b*sdVdKZ9y%$9vEqqKFGrxvAT+Qh-x2w7cBkn31~ly3+Uj
zSU2iD{ZzM!D3at**a=*l#L0Um0ir_?>5u@;cP&5&Gh`?X`D|~EMgS?ugS29}o3C4f
zjZw{4rQ6+@=6123J35vSu}K$7zGVz0nTzIWrA}YeJNEnTL?E!}`a)w?8H-ZyF%osu
z9YwSTUV7AiaV<9{co>R+9@7w41h5fg8a3<1;f$6u`kBm51gzPf_%k71x0VK8lwe)}
z92Cf?0`*ns{Uhiy2}EGfE~0g%pG_&(uJe{AoH;;Y8!It^ljkTf!QrV`no<^y;et0YtYjFu-NmG&TV!}DHgd-Pg;SRr64HergH&t
zAaA0T=W%T2G`5q$LLT(d>y?TN;)(QWQEc9~VfjS8qFKSo?u{oGXb1C{c5py#&>D1C
zU?29R=T#r41nKZbl0?KS4c6v%0oDItQ7wVY33niuPxXZj
zy?SF;xytFCDX}_d_4TwBfhqLKDrBehGH3NJ<_AySGn5IrK{GR(U({fi(l<}H3D^=~
z{>}t4f$8gGd9=a|sWpXMBNRwIEyhVpRL8yjV^$2_`U=OAX$}r{$b6Z9-Th
z1X*Ic>L6Db5P)kygWw*E_Qq|gm{~<{h8M9wr*F=6$FkyUHc+sP+LA=EUTLo)Q~z`x
zY3Bwl&oQ#eZa8ar;~I)iIJT3xLY{&voIJdhyWl$-uw`N`*8>x12BBxwV)dtYv=~!C
zjQNUl7eM2xwzY$2L_!s4FxxB9D^I9b`%!xiq?`??c?K$
z2v9ajUxYr@;@Z&
zi8jh6!B?Sf+zFv)Ni(d5VKx_n>xAfWQBAK%0l-jdjnWyIy7cl5fLK~t^iUcjS_$z6
zJ{f0xi;sLJmyn2yOM|nQ))s`M`Fe#*2Vn_jNd9JKBeBG4aMWHe6+!_#
z=#@OcC2T}IN`q6F2|zEVF%i;;d%+?c%mWuS1qGmE*m*aMRb+eMn(rt)HM(HPFruH1
z!osv|=xAaQizN~b1t=iJB&IsH4JD5b8XgMQz7~O9Vg$4S8#Fuk%*(1d7~jbNdy1Kk
z{>D}F1ITViE(tEVz3rW2u*SFmU=`v|!9iK>C%#KkjdtGBEF6{;I!>BoP`1Q7G3>H#
zR;SB)>!#ZRY>Q53S>GJN$X?c*(ghBpouIO`)eM6?TouCzwiK80T7{VNCdn2O>gx&v
zVYTrwKWcj$*yiG1E;In!KXs?c)P?}}42=bfNB9flK#~D1?!W*EY^tc5&8D?cV67o+
zSbC97L#baOuj->Bq*ak_#*(2`8xe|k8HQatC7iliNq!xQ<09EnS&*12g}MYe1vX-2
z&q`L|tCRw?aerA60IljyMY&N`(_(R=hbrtW!C?Su%G*yY8fiHx{%i?K6$EI6@*h%n
zuO@6(N_!KqGSc!(wpG%g(1s?e?0oYZ8CqB;T=+P|0k>Bq#p0zJhUl=X+Uk}#c)8d>
z8Ick|hyWUEI8IANQWPSnVrznWu?o_-_yIfziI@#UD_x4TcDRuPe%V?$7vQ%c-){ZL9S3C2uDOS9BarMC)NBFRudI%mf`
zI6}ICO>HlVC_%`*F1yy!rz_jb+L~S%n%>Z)zqCDB*Z{N
zpbVGRJKq+k3V>m&<>Ob7s64nz-K4~|(Qpt1(!@?soLM2vTh+vL*~DHXkB}yn0)DYX
z%*b86+C1(4ZYfuIhUykhe>_pR$QmzsSoy2Ely-wjhONtTU;y3m#eflgD#7B)@5FxE
z-u7Jm*)t3IB_wdeA2wUreF@qaPXj8}E1}`tG1GUf4{?RX4BOI$53sk6jtY&t
z>UdhtP+Qnd?V9R5P$C$R&i^n2$XGK>D6R>BC_~UVCw?r;M6JMk?9ZeS@q5rl1U>m1Pssz|AYtE<}s>=WH=Va8M^%AL~3h{_xO5dt@kje#}E
zm?#qxogxJy5@?I!wuWuGyoR^|hEN1XUV%j@pkR=--%h*r=y>5MK~l7uK^$=!^}LU)
za3f6#)Vhm{p>WGl;*12Ty@N9`gMvp8kju&%OUdBTi^6&rYvgmELFOMv>41`C6c)^v
z@fR5xeE^u_Hi47kH0v{Y+3-wZ3=_bmM)#@-slRy1h*NDts?mp+TQULhVdo1bazZaG
z$`kXjvoj_J!Q2Nulu%t{i{B9uFb1ijgp`MW)PNsFNqxZB39wKlfVNHT_q|1>s@z<*
z3!;N7$N^BGW`ZGpe0m_Vp&EH53_>)M#8%q6XsH{z%xNyK0<|If3(hLzMFzg3h)4#o
zsHn#*apQeJqYajUOu|MD-m0o}Y8J;nlE86rMBHB)G2^nofGwr`pv#c5GTTc5O$Zw5
z_?8i3LmoK9RoRT0rvpz(KqnvtkL1&_3M11+EP4l4jWVuCD+tI?fF6yUdio=-o-ma6
z8Yg&NbU8fv6bc#ERC9q{V(k&J+-QO3f%|FP>
zjNOqN5V??+?+?j$cOV+4T^2uzXNq#fRJfGJRix8^YT^|L`J;~Z!&IK8IX$@n{z(un
zixvA>JjqXPLQsVdnFE2If^!Vm5@t}RSYblG{
zmp}x3npO$`*tfm-B0~i-!G*Wvtq33>>(%K92dlvZf=kR2uY_k{pt$Ec?Mf*LrC)r#
z(9DN~55c;JHp00HbyYn8G>EHd30lQB)d-Yy32&Ve7CsA5$Wzc5D}t6Rti!LvNqQ|9
z_I#)|$f!z`AJy3LKd&~@xWPMJGmnKps8Lm^4xtg{F@32ZG?CKHs&Y`q_RuH{KD%Le
zqz5vhaVFQYq@W-J*yX5GB0}K|LbY3DcttA)F=7}rei;T?^X==*yb%IU;nGe~B7&^wn|4Ja1ZRKDE7rU7PL1E|3Z
zcn4uQZYy~jWXuw=U4$20nopjfPZyy;juN|!7h&$z;Cbk&g0&*Uh}>bzNG9e
z?=-Bp_d+Hn7*8lhqHYsD+<*|##3qMTFw9e=q8!wV9|>_uPY7dZ8A{Xrz57VEuwr(R
zdKCTUTqH?WTy6D{0`k?^XC5LI0QCpidSZJ&)oWJ9iKfVgZ@`ukBqo?}lGLJzg*Er}
z&)dj;+x=`2k2l$xV=>CBLFISRqsJ+3G2q8>`b(MBW6Z$o1>x%O%2Ea-j1m-jMDTPi
zuR|{YRWo8<%Egaw7hxU{CWuCVn7kj-n5SPPbLOFpdi98_gFN3~2Jf&{uMc=?m%4YAaiP*w^bZWI>;>0E!AqMw$syaw}Q4r8H~h%G?k7g
zc3(P4Fc$7O5CJdxo9Z(as-f=AX}Q9|`zhsY@g(806_KWx$~a86NA01?^{$L(g>pMh82Nv=
z2GR8W3h9Hw&W~4RZXgEP4H43CVXHumqY(3$b(eLQ`+aYd-dOev;zP2`mtax5ADiadRkZ~PDp`{XqoHStQK^F@WqOuU?MGrJ2M7x1%K&bO0eWMa<$F2XT9#@GP`pm%t0iq(Ns0
z3(cNQqq!L|?CWB-xdDOs;r-!6>AXDdndN`pg8t-bGu&CXdW~VM;3oG-5_qOTp{2Y|
zJbRvHF-k;#N%5^Agi{=DWgC8IwErJL_R+%Tm>EiDL@<2m6aQEWcg3NA5mI&DNfQ|$
z0h0)TpTvP1_EQkBbb{&$2VX9R!ttn0?NTpyGu9
zPQf6BEEhOF*?^(akSehS(0g&Lv?f-hH-rnMgY(lA1#Lo|TM+xHML)z}~prT1jzF#N>C~})=UKE$g0e%jbdMt
ze?(%{)TETHMV$VpRjKLzSQZ$Q^)Z2ozjAWL)O6&NJP#3PLmgY=VYq;aDqWD75j=qXYI(u>5b~4A_Rx^J!R7z_VffYjBxkNp)-aH
zi{FSbxosPZ-5fBC~?Gob*Jc#y7U_c_~jGceUAZx)zgrUAM2Cp#Ug40RX
zRLUC1W9cfLP{N&eeH|7!iZ>d?G1oGC=lRmQf3$l5Y^sM
zQ8sh~A_F8&2Se?6WhP}zV5s6EjDeL4=(V+6D=^6oTR~Maj7nKODU@tdYW9mkD>`E6
z`6v~aCzp%_{YFKwdUvtJt%qz&yHq7mNSsFuOXOE~uV003dMfrn57VzkgrQg)lJI6R5uld;wmg^@?#GNid%#S$6J0hAu20*%Ynjc{2q
zbIWL;Mq}G-Bq8(DU!yI?leCGyvu3|WS7^0M7;@D`UIK@tV>p)(0E^J
zV1JmZk6aj{kj^54YA@4LdQsPHW*dlgke4dSe@T7kB3{)
z0;LYU66*%mo%pPF)G`#YAtnY2V?1IPCeGC&wHMnc%Z>0z*|<&#C)XQ71K)wPD&wBb
zi|a>ZK+UmB5K}NW9A1^39CjLT5|_V$yZ(Y(63Yc2F}4W-=nA_WuCLV&ATs_Bq_SQk
zAwHb;4pldgnzz)+RvQv5bsO<9t^E!l6uVyviR;$95{tEnCoXX_AIka5O9Prtc;sSuVZ#{+lP{Km8|t}fSC=j5dG%1U!qet66(3@Dyu@SOXKsK#$XO+Z2eA%$}Z
z%shQ2K1$@!$rBvraNLv90)o+3KOUTi5jcb+LTphf>ca!uz_KJ!aSe!-u~_4k%zX_W
z-nrQpqhB=hVjuGzPK^%nmRh6&Q07=bZI-mk?zUoX(IVa>fYEgZMEAL6@KB
zLa8!0p~jRMrFYU{uycW#oahB=mNQRF?^qyKnWB-^3QnBG7K=AXX;3k0(gss(=pt)B
c4Z65kK7P^C=W0PK
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.ttf b/manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.ttf
new file mode 100644
index 0000000000000000000000000000000000000000..a330a88d000a8ff83a608b4865e49f5f8c441db8
GIT binary patch
literal 54032
zcmb@v2Vfk<^*=tddqt;HJL#HqD%bBM-Km|VQ`f1>Dwb@?wq(neWJ#9gUcsiA4#p5{
z2q}<2LIQz=loJF3NerYXq?d1c2#}sol0ZTL`}F_3*}Jo3Op@>S_ZRH#?#%4Wn>TM>
zn>S;|8Dj?gs907{XIHnhLwc04YrlomvYz3gk*`e@Ea3eNV?EZMk#+4CJ=Ijq*td*~
zY2FwbDX-f6z4vTjZ0E;Oerjg-^gdVBnX4JwmByGfFmur%`_^bq3S*b`GR7;m?VI0y
z(d;$I-!sNox_N&3;68kph5EmYd&>N-quc)Z>nlr8HlMMXL)+)3XH)f;v@*8skI1jx
zjs%THU4-_ITurk>e%U~b>{r_JwW>{5d3e}I!qV;_==
zRC!EhTIOMuEIpE1;>}9Ys5nzqlyZZ^pmrD>lG$X`XmPom-kO@)+L~&w%c&J_)wQ8)
z%B37UOGU8>z9;q#9$p9qt1?qlGi$tgt^!MnTA$wN)EJGKnYdJWZyZ-2sea?H(urmRdOlb8m54NHrFFqH)&#i?8+@jk%LxQcCK
zk~Gz?mL<-o`2b_O6cp1M39s
zmVRwAUCV!q_NAp)@$&|Ho5`|SLnNHd)qE9z)TU^(b1VhuNRj54TCLj5RH~_de8M-&
zT=X8j7JpefeL<-wWD?!y4z0uDFuBwrS+e{l_C0^>)wXG#&A+LSeY1`&y%77!uSN$3
z2q6Q{4>a?gz``sb2myk0W@bgKDN>)VU|eD&Kdg^>6&Fp{A+q?C-0(JDdK+I14YmD&Tsc-?U
z$7hi*On}i03zta(t}63NkR>)!QxWX0&9BJJEp%9HCFT0T!)*YxWd;21Vs)9S+*whb
zuCLC@F_}zb+70j93DB4I2INGeJ&4gx0li^%sm183Kv5trNlJ{aPKUXbtuv&hqM+8T
z(VN8BYFrpxEykAs_PY3~)2DB^?^NaB)RC5{HfizJFF$z~2R+YtY%}23{CI
zmEa(vcEMR70R(4xOw4>Goj8kq_YrDMerFK{cX
zBzX>WFK`E@$WLG-LojAjl1~e2+eM<~ekK;4l5L@1s7NS@oD%1*|R7
zf;pv@xr~X$B_o)kst=q2b4c_6z0`mK6UH$Mc*5YJ>2~0
zr}o`567Q|lDaOhdaTBiwaC0h7>|di!u>Tcf1i@thdEz%@;J=GKGdanfle{B#T3U=f
z%k5`}6dbZIp;npYM$D*%s9vx$8ZjmtWDt4|YWdP6NepFNZD?CB#??xtfE;KHOG`^H
zAiYkeaaGdQe7#8jE7EIZ8doJ<;^+|Q!+>ZOBo7w2D^
zm-+9h9khED+6^%a#@)wyBV87wByo?sARi>IPXYUq`^+YZ_onJV@iejdBxq_o_?Rpw
z&|?zC|U`
z$jvjC6rBBsI*BP7S*3?siRP^sS-D?mCSLaO{-|+yEaJdy&}h|~IUSg>G)a`Ty+4KI
z+hm-+Z2eIS3f8PF2uj!vIY=@Qc$rc@5sH?06qs4y1GY$I;yb3(34I4tl>CY%D1e)pi8;A0XyhH;8hIJ%!8aK;L3xfXn2@(S{H$K_~(w1t+arBT7W
z$CyawjU_EjyC&9OO>-X{V0d-xG%2Z#ZH85})Xe2?G($4|wvLei9U
z{HjQ~9_AkJJ2xI`wX|8_C2m?|W|(p^%$a7h!;qx~H{?*f5?XzZOIGw%mx-6{oP6Y}
z>-zdXyFc1LFt~0VcgKDyEpDCe-Drt@lkaZsjMTpYuA95`Dt{e#DQ0DnQmaLlR1i`t
zwDtgnfT=CwBM*czT`l}`JL8;T05Dhi98ImWUzElm^E;|)$%Ym+nR&bDtHtX^9N
zSTjK-Zvs?y*5-2I~6oZq%<66RttA@Xs`s5^}!J4xll&02@MB50i+k{%O
znJr=^q=M4Var+!sj*EnhN8#@fF9uRM>LVh8_GEHpek
zw1$71__L^4@bgfdpM&g^>BP5{bhVVRES>nak}gS@YsvD&x0Q66{{;1MVIO+|xrX|$
zhDiefiP2fEC~25Rk@y?}7_wLL{&L$h+Y}?4M4|-Q4Qa<@2kJ><(BJeaAbE&dwF)yI
zvp&uY(O?=&%Qj>SU6pE6Dny;K
z1wCmdI*ro83Spj|oej+d^X
z1*=eMCAd?VD`MAT=r4qU6qb^mO*#*kK>z{=j%TKxS$N<9Fr%^9YdnR2H1;502Rsv$
z4l!Ph@$veoz;hvx{VTMiBU=PYw+zFG0dta+Bsi2HyIWDSpwt6Vg6d3Un|~23tGFty
zX8Y=mNB6F&t!o&yY#rS^abvLSwzA-+qLhf*?HwBH8QtistH|$gZyNnu``V+s$}5N_
z1=O+wGzpCmI>Z_NK0&KWx;2@8mVaYeI!mU%&cCuO{aih7^81#hcP7in_`8;+Ym(_p
z{AtlX+La4{ML#QNjqEf1Q7=TdsfepJu0lzruF6OO7Ikn%sQPRdO4qCU#+8ps;J->`
zs?>RmH{&`smjXmT9ue9fg@R%A8p@tTkK1?N#N~!E-}BI(p&~
z+v>F+c_mO$(InH5L;VGxG)gal>)P1WiVkJ4TGC;?q<}W1KA=YGwMCL?@JuObz$+`wPzeq
z{yD41EPM*|lbi5eWs>hI3k0*wceV38-&HQNy4`P)e#!AuTvw}Cy94<(_DD~6TT!*W
zq<4JhrFHW?lFe4wV9ePzJ3EbEUeV<0`4G#GL>MXB)q2@I1%W_$S>Rv23O!iFpyPd~@Q0jJyCb%9IUs>)k)70$
zBkAy$6d3aT9+x7D46fun!PKxAq}s4S_%{TPdu@#_Z*|3%1<=Eq=CP*yyhcxRM+->c
zY{4pj@b=5s9P4T0#WBgMY?NSrG6=|tL$iJgEac&%_En0HS8N~+0)t4I_>MW_gmAt
z4MlzBZD;S>F=O)jeD|)ONc7=FP_zk>B^0Shfy^TQ2e}0~C$#IhzjFmu8$2HHBBGy_
zyeRJOG{qSYe{ngp*>h>lOvl1Lg|{SG%Bf>(ujp0y2uTc@VJ`}aL0$=x7@rUvT}da2
zp`@SXzgU(|5<^LUowS|{)bl3)4C>?H*^J)=sx!0cNNNt(sEyE&q`v-WE|^aNv2XPx
zyz^W8NylT*6d9W#O>dg`xQ(e%f~ht0Z_OQ#K+#0CFf;I%lLFjiYfPq4T%&|^C6-K%
z;6J*rOucAg%a#qR-Sv)wV7YX!$G55{R>!~I)7v?cp3y;TCb>(cQVK?)j&-p2MfAZ`
z2`Wfm9oJ%B6amya#YSs5L6}G3Ym3O5yXVT&L4c!g9obNs?wW(`csq(IcS`
z%*p6Q?c05dW;H5FGq=2ob03aJvg_;XJL=p0rPZz+PmMcU4_O3+xyXWt0Z$ft2z^vu
zLChgzLalcxI!404H`msNRdEk~O|?r(DeSG@ylb<&C@rIFv}SGa*wJ+}B_r0B`jMWx
zs*#Sa!u+z*n$7hsqhWvS7xfJ_we|b?YpI%&O+&M(DYlGKZ+pq$h^sqn_v928d%X3f
zc@;U0wbIoIc8?{BNAZELMRjM0a4hW}N10a|=8Qj(=mmLo&?_CH*Xi!GiQZBfVUvnW3b=&f#8sJD8A8-n`6Z^}or3qMp~50_;$F^#oAYsZSBuS8Vw$k88Vl!lWV>3!@Z1SU
z8N78b0S7v=D9F!AzB^+5r1Q@tYzmc%9G%9vN77|bYoYvyKR3Z|`r=RbeE*BmOJ}pC
z-~8xLv7dAM%YcjQDQ-Z$>C6*x>M@CVUn;B=h814MC!v^e#VAc@X+H7}o8b)%3v&&N
zNv?M_PGn~1WLh2mwC1pMss8L`W}_yO4g65OJ5aBa-1EZkc|7*0**PQljRv_ADUgZG@d&LX
z6tP05A;*dTbb1>(%!n4_q?ovegvMvVDwwpmdZN!)TQt$UYBP`1^iP>R`kYEPY
za;}25rcx#6&3GgoAm^}bnme>&5r;Q1cL1m|c}j{)FnNYj@<*zcO`jkEwYsE&WRo91
zo29>DBpocOz@mp1$qRE~-bm2U@uo?<#q~#6VHjmCP`#B_e}HdTNQ7>X6!CC{(UV6v
zS&Fhz6v!9Kd!i(aMGy~z#Z1e!7b*fzoHYYRd4?my4vC*4FC
z>vpW#ds*F%z8jApzd^Fyeg#xx@zeM8H=h0mAQ3GJt}!DZIm16IxQvpn1B4=-o7nf4
zr4zSO%Ae(koJiI~+)7D*omSJ6>5gRjoBYe7o%*F?=;_wH4B3gcJ+4|RZgXXRQ=dWxhdXRtNk+6N1Q(W%iS<{#Yd(ENpq8b+tb;|X|5
zT?UWS%PWWc5)R@>g1g$`B^3zPzklEG}cA#kkDV?DUzivQ6wJn>q!_O-A3NTXxNiRZR?O
z3)TjwF7`#N#wNF9J9W)v?`?WRFa5U1UmA0N
zHeo>}Y;BlPJYhybjb}ZuwU?V#B5j$i9mjgY*jCUAtdj*U&@N1>mD#|$!GNGF*jH9F
zTF;^-W4O)?K10G6L1Yy^&&Ha_8!Q(l)@VdKch1JjJe#lQS-w(XW%V@1%9a^fic~rx
z=x0tLm9#W1%qa+U5IY~8H0olfm@0I6JgFE
zV?2_EG*Ax2mC*E*Pz}=Z6iGE@HCWA+O@@gfovF7%vS~JIdIw@ZlrncVHbH9ULMw;@
zK2O3UU_!IZNKo}HZ)}A>+{4_ilDBvSEOE^_89;K*8SY;1^SRsH!RpG$*oLDUjto_H
ztf_7`*H(}AS8k}4Y=wml7PH50cN@$D?W@;z)rCquHb-uTxv##s!y}|SBttQ@mk_&6
zK~ky(Fq(l#5~T4L=v@gMT7WKvvp|kQ4uY=;rWqHYw&mHf3=4zGpu@sblM9Ui%A87?
z$GlyU2ayTN0Tfl`Wr31Bs|hNC5h?=N3|g@ux_nVU2}@Cy1j6yCHKF`KgP2?saN4aV
zr^{RJtXx~(SZd4jmxRj8N`v_Yw!9kuu8D;y=_PNQzqlgLn3rR5TJuUeE2@V|Es^x<
z%3z(NsM_!FTFvePkME|lzmsgUdkIfEjOT)ME956uHcW`!;xx~tURvOl5U3@H=$uQ{
zg;ls52N}X1Aw4Oar6w$_K3V_>^M&g6j{b>>iOW+D7C4K1R`=j4-qLfi{_39CSBpKS
zxW4)a=+W7%>(MMyY!V7%HfbVa4zelIM1-ECXq_vX%I)83ic}Ft+P5uScr&!(3qmSpWL5K;dm_6sOLGb4v-uvk6i5nFI
zDAvJGqaGtBHrX5(Sc6E~3uy4|)*z(Ek6b=6dC8>{liTNKrl@BA`BP
z*W+1X)tt8mk*t5&8iWtgiN25}9OA{F*?ZMB+aLSzu04CV^Ss#afBkE2e*FvRJo*kU
zO?}UxRSgO$qW}fg15rnEO$=+c!75|*NsR?tgocF08cc{+744l*t#0vT6)kRk$B9XK
zVyC`W=d1|=-fI3WjE<;TjM}B~QM*};f|5?7qolvi5itu$u!6(i14!O(g+hSyZ&xU=
zGIo3HMQ+x|-odlqlrp>aFsC<-^J6*I`nEaX}-_yICktL~EHL#)(;!@Zi18B(@bfyj2PK4V
z%@c7^sK@bsIGePa;d{DSOO{qTihF=(26~^rz-KE8XZ&yK{x7Q?Ckw3r;V#8~pO@CY
z97X7&t<>d8O~+#Ixdks1yujq@j&n{>kvXycB_l$R*ZWH=Bj(k;cV$6MDAk+V{H?2I
zHsv}hb~uaf;74M|rF5&$ZfeQD;bRuFrdegnFD&c`M>;=WGu&HXkDVC=j^VN6pBJl}
zM$C~%6>Qp}#$j26&1+$pa75(^EUHv$gi@;2H>(q9EJO~9NLM2}D{21{9C(S!g}kQLon
zG?S16wuq6|%n{zDO!W8ywxTy~N$;Sg|yg=|DODy~u=xq9rIs=@~j@t{6-
z`1*YnO;yD$uBPJI7U}+qk?Q7sS05T&b<B=AvQmK`(D#UccZ~!380TIdyke4f<`B?U5Dp`${@I=XT*@&M4x+o^a;r0ZSU{|4k
z3N4fvEi`Z_Z(`tF;rIjWM=Xu=qVe*c#*Wdt?VZirykSRIacgg9Tb15f-PIKGwK*%+
z?U3#-TV2*Xl%W~zZP-#142GQco~HKNo|d}uaK1e}L?Z#u7XK&um_e~SWKHru7?P@9
za8uBkh>WG^qI1Cl88A?ckbMNL2QkvF8b?izMGl2SCjQS2G&
z8nBxon-YXkl!y+a2nZpQ;(HvDrbz){7t3+Ul41`;Jbyf5%!QVe>&kT&=A$Kx%i~o-
z$OLsK{9{#dBT-pTCf5Ra7UoB*>ZcnI?`l47V>=G4tCasi4)kmKdM>pjWnK4uquF4R1sKVt%}uf|2hk*VzcKo^*iWUqy3XF6FGavSWD$|^2C$gNe5{78
zkLb!Bd1)|}iO&c&NE%rjbIW}hV1tPC!xY3y=JIsdbAG?g=CAQr+k7@}09+6Yno3xg
zSkFwX`6%l`S}!g8Sm2Z)79m#Su@|*k%a&
z8*7_a<+s%3R#o)2@Ulz88!9W-hg(MTZG+XdtNq@=+N$1yH*2dZs!W=^hLZBSv%iSc
zxGOz5I_s+1a5Ibs^!v~J7wET%+1chunk7{jT3U^8K~cwz=oKMoMo^B}KOvU<@T3ro
zlD{F*d6^AC1encO^Rt_aY`Lh}7)Xi$VivVwA*~dbYIeBR3qldA&Aa#Xz4vO<^(WPq
z)s@wwl?~I4UA0nUq%qPIlJ39h=#BT!c)Pq;?{WufrrSDaYht&L?44fS+ucL`C|i1s
zZ{-gN$yE~Zy;U@|vw`#FlI}dYEuc`?8#k_AJurX^Q9)j>+wJ8K>|I#cw{Kx#Z)5Me
z^}W68*HchY8^|r2-vb##F=TPUlpsGu(hMZz51LBIpX|Y{&YSr?u}QwRzGeg!urPkc
z0J}xl)<(!5qI9Y6E%K#NL=9S)*=I1Tb;>Rz$d=Gb*%IP%zoW1BbV}@%(cU6=L7vxC
z8D7U9=&W|O4!5;5tQoA$FLWBM-cGb#4ZKaDZ4c{+L|j~@c5<*j&~pat`gF`UHKHfq
zMrHt|=pURm5E!l!t&Vm_kiX)5e~s&WVWD1C<`2}Z>)lWt^j3RHi+xU=#qM_(=9ZZJ
z4Fmjvrl7YfRaIRUUe#1m>~*+{>Kui6h1ofQYCv29Y|R1U|3XG6_)5wM0I0|a7i5H1
z$cVX`fzMvqzJG_d^ZiXzQ?)!h_mzbO8WROC_dq9Ti8PXgNar#_NFBHe%X&T_cg<{w-^3iVGY?r6E;ulg`yz?v$K9Ztjh=uiH7fa4fGfyEjt)
zyULO^!4C5Ibu9gh4~p4<83+m{UJa)one;&Ea<;5Y3!_Zaf_O6Q=fMy4-0@j{PdIjq
zm5(-q;gq1)+t6zxbFd)k1Adzk3zp!>Z)LdXrqgLMIfKrC$zie=yEHm;sT;JYbWvGr
zqP=<-;Im+}g8OV6>*-lvTHL<2v2jiBR+qz_mS=Vpxl7#T#@Z71I;%a^24|$Q
zsjjNgbsM~C1$uRs!;)JVd(xF(;Knw=Z7)^F5iRu)xvuW$7iafjFGbrtdl
zHuSCA)n=+Q^)wrE`&uFczX-P0mimf)@Q{=tXkx4MIM=dUFfs}}u0|CxKAqI6+a%&5|2L*4J$3=6Mza@2
z;RM?Du+B)^g}E9^;eXn;sA$S
zP+=uTX%cj&Ww&E2vf@;j6{o@u&?xQS)G&9%v5cF%l@Q;`N2J9#A3-Z6Xl0vd<=u%^
zG2TuP;@dEC$D}_a_tXV)t9dZn=Up&lOPXZA%Zy
zyHLi-?f^<$>?0gd;EPidxJW$z=mqj`i|1G4dnNyUE4~-`phqL0=O31S19~ipWM-tN
z>JXs;6$g$9TAf5#7`BtMtvkbP&a&5F31=`Ig`0sCd=Xp_7i;hG`wI*F{sMlPzo4MFxS)WHOVsr{
zXl!5oU)J@5NTi|y7yoJ-?sO4`tFWj2G$IU~jEqXH_}vE@!Hz$^FHXhYrH$+~y8;0P
zh`J%~A@5t>0}7d8h(Dr$0~7V2mV^{VM~Luv~1x5ZlK9X9PjeaO?
zOP@l$F0}eOzQ>*a9e0VKz;6h!J%QPSjjj~&fHaPvJ#v+hqMoo}#dgU|RYqzG3d#sv
z#CA#9B`-(g$5Pkm*Tzu^{$9hsdGocx4-ifQ@(fm8}`IA5C`Y`^w
ze$xG3{KbCrlb;Zs6K#S%^odBigr^;pKu);?t;IE@P-3=#&f=3rVukRMd;+_f^5K`k
zp7y+45f=y~!^N+Ha|BTpv>d)&L?#H)xgZaaTe-kr;Bz_1rCefDqRoYyfEF_0p}~;^
ziA76t9f>nI;&YalYzWxA_L7oK1z3c1*Om`AwvJvVC&=$~X>YMF?6eeA76+?Jo7|RM
zzr8rvTRC&~i%GCS2Zc+;{1bvE{S<%f^$44mJY&$`k5T9nM^9)CRy9Sj^m8i3H1wzW
z+)k@S;73d3C*~ljjT)CECZqtoCPZdDbw(^@A~^2ZIDnf0Js>LHln>}Vap?JM0=BbX
z0sQ{3)0|)KD=sT(aG9;e3j8#qoA`qqJN>{-9>W;P_@$Z5DV=>l%;b1Xq;PLe2^An2
z6Dfz}{>+(7RH2EzLA43KBY4xNP|1aP(_45ix5z%eX7wM2WMB4~YjUV{!_oo%+R_&Q
zk9Scs+ZnMTk+XGzpAaLX;7P$dh@ciVtkVLgw}JoumLb}Op1X7e`h6$#VByb`u@{e4
z5>;vj7bRGM3T}Jyt85U&gb|X4urJw=pG7Oj9BzTQIZ2o{!Mje*ks4U&qy=+RDB$+_
zU4hW-+9IE?Xzi?Yw#f5xD43p65_;KF)YCQmOo?;AUGmIu7xg3vSc(NKb&(n~fv#A#
zFz3Wd4V=m#2{4KcaVMWFk!UGoh4}!@-)BLxxxSOOB_)dH|v<8XumF2Bzm2+5rU
zf_uP8AoLJyB^l{K0UO|HTe_KN$rV`k!d`GP^%eIfp<^AP1ALQ9gxzJ^@WftCmw{&;
zIr3e(V(`pA2IPCGZ&j#^FRzQdz~qjE*+t`(6f?`}5+_W+@Z#S+azw5;Gch3R(Hdt5
zm#*SgtT|v+`r%A1bPvQ*q1P6za%xAITgysI%PM{4g@xrl{(SebiHT#~j{4C(-Q9ae
z>n~UX+(BZ>!1n`0`NH26-&Trx_|x$(9r2oodJnR9bE}NtF7^~EG{yBUQ(W&lmkYMP
zG8gdsm-g~}c@U=%XdX7`2>uLgr^L?RWC!xAn_aHv>W227%F3R0*)w?b&iQS3UOM34
za`dBn_kQ#!?YUb~3t=JI2jRs>C+-zrH^l3bUXFk3AGq|+ZS!{?9rU9XJG94tA{GG)
zhW~!%jc)sdD08PfHj
zcTy(B1F(l4vCoShH9bNbQWD)cx9BDMfKF$ir
z8=94&hs9A~fCR^yC>S%H)`I`ZeIS;BrlbM4*P0_X8RM`aSB>Iahl~~r*KyY}4n*Ql
z)wK?9+%~^)sI7L{jaDk?z2o4)cctHcyDpgAR7Mn3z{aE;X$1PDkL`#!tXR;*
zp3>Y*J>-^@nxc{*!sI^enL@auoOGDy2wt9Wm;)_4N%_q~&%`2ulDh#n5pXNqY9%B>eV%?-LAp#>dKC;
z>Y&rRiq93J0PRy_+R8Y
z7GSlJP@Y9n$%O?eT69h#ONFnZF}W5fN1QtZCD2YG4G69B6(GoqPAH*6o`Cm+a}&`5
z=f+^!Ac$@4{4Z1MhA&-P+dJF3Cby+wesb&ZaK)gj#<{Arro-CO)H)j4vpwUTr!>Qj
z-7WQwfHT{^p|5+3?zVTTJ&p!@eq~vK&ykZ;wmKeTDEY8<;bGTCvMCZcm#ejiOQ)lk
z7{z7K`b9AU25{g6);zI)N7h60Bgv@MY9^HhJ(}-Ihinla7!wY)&>|?~0^gh~3BKTQ
zyPOWY0U^W&91Y}1gBo8;&fTy{S&E0ty9O5)dda)GLcUz^+88<@Y!
zIF{MHF0;>id~#;Q?Tz>^b+e_+fBq)p2d9S2Im6k;%Pwx-*s|}^x>k$v11%eyF%D$H
z{uw=Xu&rXHT2@n6Y2A{#N~?U@cn5Ki8XaJC-ja0zv@S3=_58Aus4}^BtvBRgW1!iP
zoubb#txc|4*HH8xR4%bk3w@#eTW~o2Po9fM^s!AYXL@`4?09(0-DIuxRMvd&dw0|s
z2Un#Rl$RcE+B-5|TvC>wS6{QQ=_0fx_KD}fN;9*akC-TM8_?4xGY5DGb{0T0--d;4
zSWh6hIm8(1bm)XQ@yQl(&^yyzbD^S28LU)-)tQ+YXI&)zXmGep5Yy!ny+Mz}ZuXof
z_n$a%V#`f8-E`o|ZTEgyx+``XsJ`wxU>+wb{fxs~n)Jp<>?5d~vpzP;dw3V@1b8-S
zbwpCHgGq!K4FErf1aZiOS}1SHv$e4Jkh84)7dCC`*|dpwjkj&s&^E5r`XKLSFZ>5x
z0WRS%m|NeO2iw|+NAh*BeVE)m(nfIoUjnT2b+11D6z>LK(6V1$F!ws-HY4|$L@vB(
zLT>}!TG%Q6h@=JHd=d9KgaJt9T(TMAcuisqtOYuLa>Tgnw%bN;y;ah_d*EH~8hAI=
z$G!Yfe(*nIjI^s3euR4wYJ=~3*;V}GIK4-o&_cM-LKL?ZKU8<*NZpak#4rDSJ)SPZ
z%VqVK12-+q#UGU}W_}TqE>4?HT)h&>~Y@Xz}Zy3fm=@XJ-CHNwFRF%Dis1^K#DzK8umQ52sj>#{agVg
zYKg<)!r4_{;a6f7H3^%q(wGCbk1bem4CCAeFi_ZQkiv*wBLbtiaY-gy3A;SqE^!(m
zS%Pj71YmsPg#DR3nG0@k1c2~IM`FL=3%@)$NIg$P
zR!JB!*#58spOe$2uYqc4?}8U+gPw|Du~Wu>D(rZLPaN(|Avw@hhTV7AI;z$~x~R1X
z?W1Tk=w1|ZL|aV2bZ|x-BnQ%v39}0*IsdC=CC4L9pU-B?%2KI(mA;B#sm*KiIEu2c
z8^UZ2crT-LaQ{I?r7
z_Vywz{w{s3rAdPny`aC)8*J7YV@`7c*ktA^J-{i&_9
z({-)7oSxd@%}2JD^c6duI|gpwx#zyIb@v{aoX)MAX}$hC2M>Plx?+dJdrd`|bb9Bf
zcV7KKOL3t7$n3EjvdyuxEurV8PYum{YVY0$C!IaUoW0*Ue)SKIp1pPbYnfl_heal{
zHP|Px2y7IwQgi^TN;TD<+|0C8oHUmz(?U5mzGNVLnH*xuo);WgrKorm`){{1R#jmy
zwU?lV!W?*7lhOSaniWFj(_mbMZZ3X9qT}(15J_=1)rNh1cBHJoJ?b~Ech&A|pDx|i
z-9A^}-BndSIa*xdEe=&zl|Z9vEgx`w9R~q*mo~2RePqp8?x8gcwOh)|%huJkYz|Zm
zRCI3Wtnj+)eMQZllJeNcx&q-AxBE$&VjGu=rM2)kr895DMJEudIE6a!YcYG2NPisJ
zhi8}*IncXle+%sj(c;(u8a!$3$bpgld#^npEuOh9U2Z+|opk;;&7QI89fGDF=iim?
z1Luq&#wMo-Gp4z^+>TStIF5yZ0|dH233P#MG>HFa;+`03iuPw)Q2}}I;4(rcxs1rC
zi3I@cDRm<*$&I6i605#YMv31L1;w>d1-iI0CP)e_i57&-7PEq6lmrc$_~W}aO!v47
z+lm8q#!$^jZ?W5!w|!)~&*g~tgH<`zp^;SszxCCXx{c=SV9;gHF&}U47^-SE<~VVB
zTb{udsdu-Uvn!n)gS8DNqpQeTlyAsyujvXMaA#*^W&3liMY&n&8962Ju*qzK9hJU=
zz1Nwbj5;lc##(FGc7c69Ka@F$32k3z>i@Z0T~h-
zvfF8UmA%d$uBr%>c->h=S%uh*M2GF^<1RX7TSD1n3g@a*?Zq<{iy0g=LGl
zR(RZAI5{$Ma{c;Kqob$R_a1C-KiJztzdhbso6GAjuBt4_^%?Ee9eo=EeL?AkH77T2
zJUKi}ziX=7j|>c4)ZTv4z`&9A9;30`7HMxqv|2^k?8c_`0qCV2>?NrM>s5q@0INQS
z2{ktO!%eG(3NIfMkugwm=b`UlMM^i1{rzfHih52@9yECaZV9`J@K9Y<9xSCOXXxw8
zFhNX~MAZ41$d02R!E~SkTUN55%uO+|hBkr|VEh$DyuOo*fAQ%K
z?%2VNqa`J#9E@9-U(T-pf1wEAIza2t=Ue`N&AbO+^k5apfwLd$RlUSbhwj?~YUi#_M7q8JQ1q?4{!
zMn+I&>~_BE?62t;kocuc{;J#yt;i?vg0nf{8KuK4nRE?!fB*_A6PP*{dIZdMB(
z6JPUg=gNwPufXfHZ@B<_VE1~3)8oJB5Ql>p+5hOhsp!|R|ES#ci?01o4BdJbXD2xZr%9k!|xwx
zubc1Eqz*)UAOk6Omvqb0^Pq2v%dQq!C{}z_;Dh1;tdKldZ0P(LwQL7
zHx9#eyYuBVx6S5q*=%ln8~eL-40Sp{Pw_Qw8E%i?eJ%e-vg1JI`nN67Q~aZR*)h1j
zl1jW=x&(DtK^u7jE1A$rxQZbnkR8gV^=JZx`@$hq9Xsv2q4~J~m~=^S|Nh`8uo{#0
z;pvbX67R
z%IdV=`N~SfVE~m~Zoythpr<$$#{))_WDNSRt^LEPwuRQO+<8lffC*RpIYUUgF|sDehqcp1}eshAuA{t
z@Fl4C3IFlt8+=ztuLbw)2_o(r)cX>?`l9GDPS*SHDHoOg*Hrt(3sS9|ftIfY)#BXI
z|0TsD_VE8it#ZZ%s1?>-p>&LA2rhDl2gKS#q4Ww;Fd|S~<0(s->>r>@h*1ueOMLYj
z-vNxvnC-`v6giF0$j6{vz0R+~8KxISBK`crqYLpW-%DFg0W(y*VXaQ7|=I2Vk
z1hW4kYKn3D`86S|c9(oD@|O6C^S`?Ql$QWXoB_bjCZLpV0hAqLDfESQ$x&aZUdHoy7?F!xAVekTva8rlNI#WshIWTswpRRi6?+FFmhNMV
zh)?(iPvzr?@8?pTbcOUu>9f*Tr5{Mo$QpT_e5HJ+{1N#f`3d=H`A@1`RlTZTb*1VP
zs>fBYtJP|QxNo43NVBJHPdk)$W!lYY?@fCl{XOa5P5(vu
zKQeemdPZ)BC!;c>Ib(CijTw(*d@a+HxhM0@ENxaKYanYZYc^|N)@510&iadC*bp_u
zviD^_m1E3#Am=%w%UEt~H1-%rj29apFn-?{Go_l$rY_UnW|#SYEMu1US^i)(TNkXq
z$j!_>ocr56Yu@d7|FVT_>utB&Ud*@WZ_EE|{&NK_1t$ycF8D&hQsH>v&4oWGe6C1c
zWGr$ORTZ@r4Hr!o?Jv5j=+>fpihfk|dwZI_%HC<;XTQ?^Y5NKIp>wm
z+no10zvR-n*0?Tq-Q{}1^=sEluCs2tyTd){zSR95_rvZd-QRRS>;8v_dqzAvJRkBb
zdVb~k6#_`#<^8*Fr|;W-ufNPc?my(e%l~oz=loCm|6ZI?Tw2^!ys>zH@$urji+@w1
zE=e!B2hqxRm3}j@F7UJ9Snz|v$AiBs)0fSc-Cy?ovggZQDbFq+DZi`yv*rJ)sIKU$
zSYNTf;*%AxR-CQWRAyFME4`KFmCcp?mE)CLD|c2Ns=U1NmdX!QK2W(>i8E6K<)}ih
zbzb@9p2^Inf50UCBU0Iq%Is^!ecSV{vuUvpsE1X|(VJp4O
zC0D?*pJKC81q+MoT0Ea(MyyiKo`3PbAnjt5dw|VypSW!B5Wj%yuXs0boLUX9?<^v*
z#3iS)7U@BJL)WMA-M_iytB~J?a&$e6=gqh~SgxdInbN!2#cgbszw-(-+XIMR5(t5zxfV<%%#
zv~dCLlib5LA}(d4JPvgf-$|c=_D=U+)c$
z7k>fpeH&4Vze79^o|D%j_^uUs!$^CTwc)Ch22ghyY^+82Z(nA){1xETh}GABusq3x
z^v~lPA8?b-f{3Cl!_|f>jH?<~N&H@kdq@1e3itoE+={x`wM*j&+GvYk)i_bW2s|&a
zzakd36JA~1ae1ZZasL}mguo?fU>8#UH?i@Uu9K{Z{Q?)2!?(B$h)&JL6~xtstBT(Q
zZ}Rf16aB>{o0%Qu?fjjHEW!m`;Xo4fbu@mx8|B`OwPxJeZ()i5R^0t!E)mUCumULu
z_=@04!T4I?i9nzDtynoY6~C50zk>06Rb0LCJH1!MuNIthy}H{gme|_ko17>o$P~jf#&`4)wCKGy9=^t8h6A#iVHEmu^6t~aeW_odfZXw
zt@)6ah2lb#KBQ|QQ>Wr#n?_s3p?)A!S7)0W27!-8We
zOi27ME0^-N>{o(@
z@EP_n`w1}qG9nGW%)Y`thB%T>v9DwG<+JRQ>~Z!-_IvgR_6Va$X+3(G0WHsjWe5xQ
zC>CI>ikO2rnH&2@%F&-n%%~9bl6v&4ku|d?*n{jz_8R*fH)5rs8)oAw*3X978t5q_
zY$H5#o8eTOf*W!d+r##X>=K+Hag2Q)TIFf>XZ9mRocs^_8T&E&Ir}I3
z8>r^*>?-y&`wRO9dj+d3ud+X}53_rD3h3vr?Bm#P@ga6K`zCvU-OoPC9%b<8fi`r|
z|5I2haBoEHQa1Fcd_?Kz!5@^#T&$RRKpCZCE|#z`{9`q&7960A?Pu-q&`03RYJ(50
zi}fNRdH^xStJye$K-RMjSR>rZw&ULm*v58X#pZY5H5bEaa+qDjE@Qjd<)D$B>}%|+
z?7QrH>^o5wut(Xtv958uy&t;~*7Qd;BOAw})wZaAd}^Eh#JaJlsQM~8=z6dAYKqjmIDH$HA(R7y|JM*T>NzuBV|lwUz5pBf&s1DX@l_Gs$x
z*c4Lil$T0Rwe(awWt+mbeOr{5j*q*dYb)io29OB~4Tu%ED>Km&^vY7aWOW^8KM
zHobOy%r)*9w?`u*W5}~n*W&F5qv}9Z+fn)u=BvPz2CuGm7clN>pN>jfw?+93popqV
zf>CY2PN3>LW*$?qttbLuBU9s4WU5nuni6ga{rg0JYVm88Q)NTWi2`Di-uIWyt3H{rA9(Cg@e4Oms@{iJpgk0?p=~HD4w$0@j
zFL4B;>48N_>Wa=zcLt*w0d&A_kEV6>QNQruY9EiL)7x6SrQ0ws1}UdnvDD@SnvCdMPH8Y|3M_KEn}KJ#TLOzR-K~K|72R_K
zi)y;(1r{}Qw*?lpbk7egrqI10u&ASZaR69Q@E*mM_t7zzy)4Q%(*y}dOO|DtlbQRK
z%+h6<-el$hC9^QVqUojohyE3ze}#a{j{eczf&S6miT=^uh5pgqjsDTygZ|Ooi~iBw
zhyKyskN(j;5U@9i=@Se9t%fOk2gY`aXki-nXn<(7ED#NrMuV7z<(L3HpwtUaL)Ubj
zi#X!HEdeqNMk|s-%gxd9l0`K)b&Y|M(EwI1$IM%^s{-~K0dEN9c-LFG0hr7M!J~9$
z{Z@N_
z#9pS<6;c
zq>iasS5)qpo&_(HI;L%So*D-OIRBezfCcvM>YlE%xzIv4`iGln1@&E^5dcCQR|PJC
zK~RITARx|z1T{|MV~+p=zYto)D$lhA(r8HF!43%2-Z&myO+Zm&GAo(_Zeh1~yLzZm
z8oj1Op6E;*!)$b{%-#f%OVCS7A}T#M1R4+CRv{}X-Ic+6E5%K@;v)rkgVE+hYXbZ6
zp_(EU;QTHphPMTbqKvTE9nI<(8@54Y+MCA97R$I16SQ?j?poXMirmPG+{Cxb>pTC8
zwm`J5ba{cqM~Md81JU}@6CgdJuM?QkZwDI&v@D9F^r9W2%S673F(I;aVP2JCo+;hv
z1mA%OAzBx7{@)XE&xJ_p|3bHfVPa8Dt~#4z8HG5;<1luCx7L*=@X(F7di;xUaZJQ}
zlI(O3I&D%WIMfZy<(#r;HRf~g+oZ2TbvSf0T7xoufoK@Fe!?5hAuF?YL#`$;H4q>Y
zj`jnwg8@Wucj93+9ymP=1s>ueWf%`4Wet_-Le^R;Lk}ZVh8{+#3_Yw1JPf|qhNty-
z!fp#ZZ3sLJ(}yUl+C=5V(*%_hPn)UD4iwu$ZPLRewMh?C)FwSl
zQ<-i&Y^5^vFhgbNVV26!!<>Mt9Z%Z?T=XJY{la~LOK5=791@We$omltE<<;p4_+t%t>%
z_~Ihvk-oTCd8Fb;P*0;$vk#;>o8pmua?ZMm25fO4%)ms=gPb+;nb^TrCxrUaxbl{O-_4jIrfvK
zT4`B1_RLc7Lgl1I-i~q`!4(_=xox_rbmqi87GJ8KR<(b1~e}DX0
zf|~xx__GW<{qyl>6}%CDk3Xwf9{di#tRGBcJQL0>NL2d^G^-DG%|z5(yaR`v46u(sy{7TJ&K6V1?9l-x?_Cff4XheJ9jp~j2srF-b_Q9Vu
z01w(B_;R{Jf9cvLSDq}+<_VLD!gg`g!ikJeTm%w?_DOmb1L}FH1LKw
z;W1OgH&%!_){gbXDfsIm+{s-ymDD3Ve-Fb4m&LvCr+o~5y(i%-{51T6kHUlaW$wfN
zmDAW;;Ahvdck^Oi!b^F82YDGU$2@%*KDoz0-41vQ-wE2hmsenhyWo#I&aTG_<_W|N
zPr}pK2483u5AkYV!)tk%*WrAJ2Hwb(3D}|1;IV?A}8eL(?;d56zYB+B>src%WamAf86o_G=ICS*WNAg;l#yO221%
z-`<0V4(#2xeJ*3~iZ4XDPy2&_lcpdQ{p_
zo~R8`j@l6Als3ep(uOD~+Mp-VpNjVS_`NEA57E76yP$&>wzS&
z%d)Aq<=N+IZ|hWQZL3gq9X_yER9#hBquaOZ@Ij^byBGE(9_RKSp5CP(LgZ65sYY2y?fu>frHa~X3Gv9tPqe_gevMpo1u!ZZvMdZMRPNIcW>2+k))@1p3>V;
zMVs!>!me3SCZ1ER+^fQAL>H*7Y-al4Tt>1g|e6iikxUQ-o{q8ig?
z=4Kam?V1+pnKKIqW)AP(wrlQ)cu${Qm^(0caN(fxm1tZ%>UU4i9N4=@JnIfD?3q^z
zh*rd7`U;xOKG$A?@F8LmHME48&cRF5;!IY;OqaoFI5-Us835n85`6Y5c+5HY;J-v!
zDxV4-brDl_b`OlQyqTj1b}{e#fw`TmYS;9kJ>UJYrB1bl%cej0cl{s{(=^Fif~6&&%NdN0bPh&2>HID8$nxL$DE
zF>tNz;LS(SA5ktNrra~zm3zUn%H27p+=JQ5z5GM}Uvp;zV^?wA@%!Gs-S^&lcfB@i
zd;PsO#()7E9P=4K(1b(++R#9&1c4MFrL9U+8qtb2YD1%x(xjm(NfSgZwUq)$5Gn&H
zYH&-`;#S3NmM9cu`3`o2DK#H!tOa5#x4-{?X5PK;z1_7j#?6fGy>sW|%$ct<=bV{4
zH#|>0H$2b$<@mfkJkMGepWDOpgLj1Iho5Hu=zNv8XJgNeP|2gIkBNMDzL`sQD{ou!
z9o$)uc~_>N)Z2izJEY1V&&RPlcpoBU0vCBuL$ez8ie(|^e9CUp;lm|k42>7A=odl`
zd~YvLE*|XwCV!Y5?LZl&S-2O+G3qH6fQ$sQiY5-(4eah_rvKaK4t?tep-ULtlc@n1zqdktG9)g&W*k9qpNq^|)%
z6iQ#r{ton^4(~Ednv7LEt?c!|D|OouaGl9&C0CXYOn{QgF&axFS`-X_8-s^g4i~e+
zIVjC)IGSWQUyW7Kh3U2JIRphBz$ai9@>2wHxJzvHCextI3xX4jl3AQ_M6YnGU0?f0
zV67oQZPiqJsy%RR(WN(@n?q+}*DBdze<=o!>%Ug^y*>h<}~4mf3~2LUHV$^RX!x4ERyQI%IAx`%RxcrI7K?UjGT_(GG#5}Rz!2!-TAZfDc~?hCwVtLbcjaiET#x`EsWEy%r8KA0$WO3Kn&%|
zwd1gCy5}IbQT{e|ONgjH1p>c?PvI&9lDpOJ^ypGp*Phd6g?^KL3H1{{f7H6={_}rqp
z=3P5u!A)=6102B=?l^2iW@|3GU%+E7IX3?EjD?EeZNf;@t~3)8g#Ni?5;FCfWrO%pjD$ic@qm86AU>
zOdV>bE70mOTtiT3;l0d~rsU3UJ0A>ZvidWoY{fJ((b^uUa2=>iTYW}nrDafR{fR_5
zC`~5rESg^ExUT8UV#+s6K)@{IH(fkY?kW^rW)T>r8H0bQMxJm}&ux(>+?DSWr$HM{
zdM=$Rx8C%?yL|)Q%Kwet^0N9DS8H6vUZEbgJAb`9ZQ)b&VsLqdUe)ShF^*eMeO2#W
zp#>m??rD2Hgcs`Mwfr?D1RM3*ZS;EazT@2ghw^ELn=lq5!YSGv-V+t`^Vpe$L*9|^
zLWd}hgff&d54BbH=|vuPv_-v)8g*L=vzS)Ck=EEJ^rBW@D(BEjp;23dt1!%t
z7^F;maC=CiyNnZdFrw|r(DmGjTf4GWq2GEGPUhL{Mf7+&Tkwn61{$P4hN9ezt)r#-
z6R6HD*a|7XM9ME?YwU0T3Mp>QzCjz^4#a*#Y+7U1%>D(q{lI;m&=-K-A1TlZQr4jy
z8mYs;9VDOrX>2!5DtrpMAlk^@N1H|5mvQyB_`wlMl4WCD3!Q@?h#Dm`1m(~*ozb~C
zYK?$f$a}hY`g@%I2rsh=3YX~e63VMD0yth4P3c;+q8qdG&|dPtY2pk@Gm5mlm3O!z
z?ibQCdeGkuqSYHjucvPbF3cr6e~unjogtz12@iDCmfIN1B)Fy0pm@CqVego|GvrZBy@J|jg
z+fuSnTJnEA@HYwy;{Xb+xp;esY>Wamc+2knswLujJQ7#fA$ejSgCdLG3G+SCmv5V}
znmzWl(-7ykH|DVqXwLSA9Ep?=y;{uAY`S}Xirmq3bmnaYOH{2lyulk+6_P;*YF
zo>elbjTI|;69br4QEpQ2NOZvI$Mc8zgL9Z&l+$J?lsNL|@>g*Q>s?$EaG|FB`Hz6{
z9QFz0@C>2!KF3$zYnl92In^JyCp`3m0m4q-r>MtR?tH&P_RmDgo$zP>HXGHJ+;t50
zNSPB3M@HR!{GgzA)C0ZcK6=UnmRGmrUlokd3-cek$K9fLTrbe8;5&GG6<6S`-9tPk
zw$gLx!R|Xd;OuwNLp3%hnUyumqa}eCo6P@<7&}tW5@bVU4CCIPzoECXasS=t&@iH6
zAaOf-ZaGzQ7x^Tg*`7H%F-GQ#iql=U=9g4HMjdyJR`%KB+T(X~UM@d$K>i0Z)5i+*
zF@Hv>HP-!v1M--r9)eU8aoCpMZy9PTe=&cCy4}nr8EhXl{8;`Jcj3D)@J{%vJw#((
z;EAu|#T-iXK@{ox_
zu38jcu@z>UKZ-E-rA`{vk|BT<=F~yTHf8xo5~HM`)E51ec4wjwgs66`yTVZ)r
z%vAp_udx-43Oz}^Uo)g7qtGVpHPFH#U=qtm>NuKG>`(*bBpkLW&tS+m_DuEMw6PH>>y=RIT{|Y3@?vhlu$JFEbRzZ=Wtzyj))*t7hFe8cbMY`dbv3|k9^onwe
zLL__=H>uf4+*BAx(%wtrM>8f^V5AzNwM(tVfgeZ$=a9z_u^;4Zg{6=lB%L|P1Ck!J
z^JXq@I)$JIX=(v5I1LclN8beXA&)FY%HkXk+{>{IV5}hSN~EDCa>^eqlmj88N=dx$xbfl;=u=CleaVFB!S=bTqJR2;|
z!7eo3Ltxs&PKVJpyO>gG-JsL7`$!`%6SyYDZ?_6l3VuUP9?8}ytu#u#lvEN|*=_*u
zPOF_N8^C%axXYf+buv&lP}&VH?FjeIRQ$V|P~A82aR@yCDY4X(W1Js~tJI<~zR9%qRQYLx4YER8QvLbN|;ndNjt)JLZDk%74mu+6CRLl}1F$
z;ZUC)wC+&B94H-SVXhF~ltr$(a!vZuW2Mt(PSvVfuNSdO8*c?UBGUqe_%vCp8WvYQl$rK
zSD4NSO=&7lQ+1k}WA`{VC$kWz2WUsD^o&!{#)|1%m43aEFj2OeDO;~;LZ4|`ol$WC
zW9y@&KZ!3Vf02>=OY9mOV7J&OxobD*JaYXFLO+8&i5(EvGqyg9UBJ#ezNTkK#EsD9
z-@`6p58CfD;y%Ydw8h49x%FuVlgoqmUy4`WBrQf;NC{|S36+Ntj{`n4-=g>`%@`J(bM;BUvCz{2tIsEU^?8|fg)6KpT*>#ZJAwIQ>}l-v`(N%_kDlxG
z=(Vh4zfN1diEXeNy_c5Mdh{__wecy@pT^gk=Rp%ie>CPKVQRHh{adug>*jt}-@lvQ
zr!|`AaqlF~_u*PdGxHdjEyNr^lwec5(DQ*D`n%|Ys9xfwCdHpJ4kI6$;-%EHKS^h)
zB*~2h?EFckq$F=rK1rX>FX5sQ*9jSlPz&5kXUGwF*Gx8zF_s%WpRHgT-bUNfMjkHsxqhjuP+vid
zP}EZJRm`CIvP)dF;M#O^xhW()H9xl8MNV=_8xZ=-b1s4W_M#JR!%%5y=ct3^rImMr
zdIX+Bv*fYLJVOO5gWElw=TXQmqEXZ$cXautUoV6=Q%|%Q?dceCt`l<_)UD_#BZ>N?Cc3x`
z+AG#hfKrsSfSTGc)~9zC7=zcNjBV`f!w7Hh0Ri&@R;NomQ1TI@Fvu
zW!bzI#*0fGM&EwX0A>}JAz?>&%){_Y`31bWi$6V=ZxS+}p;2f4_#}P$3ciXMf#>@J
zsF-%~o)9^l-F!i?o;1sxhC`FtA6wP8L~xmxc3bemFvs%YEfE-Gkg03jFc*ry=0=-!Z1(>-MYR#Ij?$k;@=G2LD
zDNe~~W})1=xA>J1Oz(Rt@ja}9dIwY~VQ^NveBPx8trly!J)v`6ir)-)hu9%)7;R-Z
zGt;ATF3=#&%V|YGZgE(W#)F1TlI*mUjd)&(P&g2m$MNn~GgSY~;Net;Kz!R${#s9DJjFQL85?qveq#+6lCR-tHPB^pj43G7$U*H;)whgQWU+QY1SI^ksvU$J&E*R)ld
z`3t~adcLMwxAY8A
zlW;AJ14}}11=7Bo_bvLyY%cWnT1V3uWnYltNLxMqh-w2A^V|o7=gR@cM57mTFmOW5
zY3|dE)X=|U+&D5#3$$}wG(l@^JF-RKAiC<^Xd$*RQ91F22MTyWI}W0pN+0ElS){p$
zQ`^HBIWLc5t%r0O<7J&e7@b7~r%~&)a10uz;=PF5?xH0{HMXif9deNKwBz=NHQ(0!
zP-ERY(k9nK)WWzdL67qPz1y^kEYit)>FaHN-ef8fcrVE(l2XKfrxgHEiDe}!(KH8E
zUJaOQDshyl#Hgu6zp2DRQ;9{U5+jz}M!beGZ2GXs^q~%QxEju0YXzgG4~tA6Mok|U
znLf-jeOO}pu-NpWVfwJt^kKmCp<((k-}IqBt`BHkq;Br5ZtiU~YS~2}7E!)Y^JeSN
zmWGq6LkHoH5UsDo^o^Ll4y&2J?J!|!0?^J
zg9rVEgTT}cE6uU}P&4H!IVl-QQpxC>2wefQHOB1X?3>IH(_^OZTeZtMW1S`JX}*&*
z+6_I%y2hhOrP>XBEbxXLukQ7jKCj30mi9r{yb{w>+6Ue68cfr$8eSu5c#Wj#wT*_?
zHkuL7pnLvwb{q3uc_eC0E@;c5&Ytn5_uJS-cZQ0b#+^p9-!;2efD*p9qRE~P{r#!Rj=ptcqOODt29-w(p0@l!wlW$
zz3F{#)PEN_;Z(5Q9I!kR_je;R9tnI7Qy%5sahO2<41lSjBbJVJI}&7+BysJ-ZznqC
zU5p9IV8Q+jpnD(`v`%v*Od9>~e_o+P=9k9do3_I@ZBwq2tgw8KihCO^7Bo(*P?^ts
zo^bJ9f%n`(=%YwLk@K4#>mUzJA9lEXT`KKu6JL8bJ?;js2{hRK>|NdLo+!G@*NNa9
zI2ofLu8s2UD(D$JnD|DW0id;I^=0j$n2LKp1nY7FB*FDa>?h;GH$C=kX&b;nY>lynj5g%_}w{C6YI`g{AtZi&qB5s=3U2a}i
zUo2fhxwLL^k~v$QrF9kBadER7%*SphX&y(+!EQ7MyU-l$B6F~#=3p0^gI#P6cF>&G
z2fY7f*!A@-)^IMzDZ*8I-??ICzO+w_Ypj)6>m4q0%(rcdJdd;z>#dboX|2S1Yb92i7pj=wKH2?5
zC$~IFJ!s$NQuAH|))pUY&TrE+{E~LHtoDAE6+U0#ME9!`Xwgs5n&MEUmnm@oWjQZ@
zjB)ZbH0iF;JtTdFz4h_E*b`t6#;$ftCEoXD`mMg|t5UCb(tpGOuQUg|+8pp&LPERr
zxkYB@ed}(EhN0BW`_^5D4fDQr*MQDd2wY~xTxPY4%dEP_D_vY>#bd8xE;H;O?XO(i
z^QE?PaZdKRI3Mx3I9G%^<6In##{ndtHT2RCmwYRfZ85sqQ_%OgejQglzy6l19VMHx
z#`zz)h%@BQzx;x+?D7wtf7w{}nGb!O`xh=c|MIcy>l|t|mfdri{2$?1t169I<
z=;)ikV;Nl^wU17|A4aA;4wz@N3aD6hD8oEP=kajK=ddOi{P;H(v}GMDY3H(^E%?>Z
zXz72fr?ZdqqUhH^KR3qO!5L7Wi=$r?Id&D}@=SJd{(SW7hYGBw@1DgsgTD~{^mo0Z
z>7_cg?qk^{*Iaeo4V4{-;eO3;USE0Tn)iIyIbW4M@BM!5XRo@Z^7ebbU-#?3dR4W0
z815W{R&D4owCa%WBfc;3ea!c@zMts(Mjg9VJ>$LK>HlH3xSqrGIqjX+?4j>&!#M&P
z3-XoR9Zrt&|LbvU^n}x&!pST_q7EZaGUo^<0m`o9x|r*moCLU+v*IqP{90v8Wuo$S
z_2TLmtKYBcJ61sw1sGy9tj&H!r{v*NV+?+}(%^hO<)!&}4VcL_Lcf(BS}AqfKm|=}
z2w7rZePNqIzU6Su#~~MC-fO>0J-U^%UYW68yRdgml;F++ygt2=&f9|>?
z`zy}5rMm2L+
z%YRwRzly)U&Q@JkDAV8K5~T}uq1sbx=xgN9^Sm^>iTjoKR+!_9c*;w4r!#-5%v1`0
zu!YYu=X)c51wIMG)g?^$+hb*ztQXSeg4U$Pi_;Q)R$>RtYl(Gj3qpc8!|w;j~Cn>z{XPp!Ao*KTXr;O4uz3=SgPS{{ik?k7fV>

literal 0
HcmV?d00001

diff --git a/manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.woff b/manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.woff
new file mode 100644
index 0000000000000000000000000000000000000000..9c671f401f93cd8b0fe90b6393aea33d2cb84079
GIT binary patch
literal 25472
zcmYhBV{j%Il0Dy@O0Dz7I0FbY4y}Z;4DvT@u0QTSSIJIvX>dmHUm;j9&
z005ky-|;EmzOtk&?|~+6F2n!;?(DaZ+c#%2u0?}3cd!5g0C=bie(e|4+ykww~tS%oG6lS@3;6E{{9@G?r#Y-?sLDJ{14_?
z(ghzX_0rG$5K(VxGo#J+U<`2ySr_%f
zEw^&zV-XAXv;Fb^+A->ftJw5EDi=q^)9IbIY|&GuNA!M16F$-E>aCAtYimU|5hmJ-
zdk%4hTUmWxH`%PGU%l?LxacUoF_#6YYmKdgaF+LXnyN__YW_(BpK0}+y!nIr}3xO
zNBhFkS@1nTwJ6A_pk3*(65*jiDne*>ExfbGtT_`=
zPQj8S7pTe#Y4gmW6=luxjqk7(B&kWtEzmDy^MlkG8s0BA}~
zqN);s%=$?va>OY3@_@dyKqzvXiaqV(NfJxG!L7(Z75S48Bl-d22bh)44fS7cCk&1C
zZ+hYn7G+|~dh`q?JqDG8Ua=D4aA@jU(=MUf(I?hL)he>&?oo
zOd`=O^^OZvtS?wz=M9RE*`+(^ND-jL&vNo5kTV~)_S#<-cqe$64B-lFT|N&!C4;jN
zbLMb))5~E|WsW>+3&?7X*=P&uXw7=_^oR0Hho8COWxOV#Emh897<%3*D+x_r>w^@w
zE{Xt;kKU#no
z6fOa|6Xn(HAtWHjs|3E(bL
zy`(#eXAWd$!Y9Nm^p7o|>r>|ldIt404-JY)rSKm4H=Q_=ijvIiG8`c`ns8QZy6x3(
zcBIx2(i)T+SI^;T@WLl*w;R;f&mbpBrP5+~7nf(9>o~v?Yv&QxaS`InH^=9NXp~#~
zDa_1%Ry=qOzje6N{PIj?rS>$+yQOD}UTRAL2zQ{xPHtG(+tB5%=fxm^N6DE(M4hpu
zNC-;8l)vCufE+obJlnL!A`%|JG#e8}t;K>*y~~#F9|+>vPh)^i
zW1;Hy=1SgJNXcdmCX?}(JUfob$y|coz>)LmH40XNCvpwTpF)oT$)wsr#Sua5u_if|
zy>^f&vh=L()bkK6p@x5D%;MZZOX!q}!j!}Z{&yM8DVY0O5yj{JUMORj!1&`fqqrH<
zyg5^;jdRY9GMta!@aA=Pk_<_-gGv!9Pm#hZplYsh5AC?pN-ZA20db$CN|2hqVxlASW&thZM`9C(LQo+ZMFoWFrR%m
zvijF(E|5O(uI+m(w}xhh6dD{Wq78J;HJ~@vk73=Gb6sU7w-4lcj80$|%zF9_+jh{`
zgqAR%Nfc(^Q05i1;-0FyH~FQNe^$4C?JcJ_lj-dz9Ok`WI(_)UJHjPV?m7*n?N>3&
znLgxbV!Z4e3YeXnXI-UY@|Ej*8Fb@n`?g3Lbzhgq7*$(0P+0h$ye-i;wbm@2{`x9~
z8WQe#Vp<8Uqr3THE#^?{Xu8fVAZS@^+xF(OY}qWzcIxQTuy^el*b%>!+i*PejMB06
z4Z9$6Y+HR9qvbX969280NGO$@3p{e_y*vt(enanp+^aM=Pjd+chIMJ2Y`X=ip8>%%
zH~O!4h6hMFcYJLe&9*Xoij;>Q*A?4o?$7CR;Vy(Mp$r#>4|n{WV`ldFh
zm`yi<)gz6ant${v3gg-F7U|!fQ@3cTo?=^w^JBD1Rf}P_u!k;!bc#7_g5BvY45T^{
zP8*u2wyBu2>V}o0_%blc26c82;&o8H1l(%u#iqp9Z0X=>^ljd3W5_CehIVwh-kYGS
z%qMLS(TT|~4x!&=ID`C#%Kq6^#kMSsGcxI9v-1DRfCqpl1x%2-lw|wnw(|
zaT^?AKUP2Gv{Tc>>5jZeOQq4jJZ$x(=~5J`7b55CF~@lS(6mFNlPOD`a@R!L-YVfq
zLHIzWs!}nKRI85JDvN1ux9R|c!m#+zE@I!v8RcI^99wU(+4$2;IJB`g9rjV+C$j1#
zUX_~3W+Q_0!b}yb)Az8R3HgrAqA%0@n96ET%P&LQ(s*3MmeNDQuD$=hb`EE@&hJ6n
z{HF23>~YJUXnbc-Y`86LOGvR+g}NNr|JsF>=5r-Iw#;k6^Td^wbXh}f%~->-1hS>kPU@Cb7~&HOu@MH)R)SEAA8J3-xmr-
zVZIKSm~#d;W;IK5+y?A1s9>e@AJOIt`C|K(lQjN
z^UFqhI0b}BvMMN`6s#fE`6RqL_!ZzCb`~F0AcHGvHi-9%U(B@>~HB
zQA5t~M|+*gVB9XR(>NQdK_RGUu%}cv{fhP%1eiJAGWGp9Duf-mPGshDTzpqM41J{|
z*ZxNfzY)-sbP6*|Zr!qnm!3*}#-(khW!E^7Y*lPk;MTD;
zPU7+xk+Wp(qHoQl_M>=9Yfm2}(EBb$L2={67otv@`Dvrm9#%?d)}J8@mVe>%1CZcIA1ZRyF0g{LUlN%jYoJY@X?9F8cTg#=fkq@d
zC=@q(-80~L2k5>O=hHJG6uv*A_tW|{r%~N%Jy)D#YiW;Q3%L|lbM8XK-ym14cmA%Q
z{I8YydMP$ZDfP$N<`w{zVqkNqH!&^
z)1jh^-M;B#%YvK>;()#@w9(_Gea}nvF|iYKsb0#IQr4n;Gwi`vi{o~-kkF1P(x)Tl
zx$9aDwF|GycJpj#p((Jji@#&vg!xR#P6ssP3y~dh_e+5sqEQ)0PHW5AfFeX73t9mDJ^Srq*`_fNjvYOJ5DJ)&Sexfb>(<7xS3xiz28!*Vka
zua8}%VitU*WB;!QXkqVaGjPN05lf35Cq-pxX+MM4amPl_Ea&yg-C;?aOh@;OI
z1c%98dM;8wnE3QkTQ;Vs?LQSv$&?zCX^XhkY?$S`YZLb?m1DiW>xcbKH?JEoM#_=H
z$?1iyHqq=^q8*uEFUrs}7mN*0iAa@#M>*Vl%(hK9%&$vFecRrzwA-!LHeN^Wu@2QJl3%ZMicb4MV^9@dCGM5Y<
zIDyT<&VTBFuxAq%&Dgp!>93PCHA;7yA!fI>>MRm
zCvW2qU>}+g$y&=b(Q1ZM<-R6#0Y7b!EeQ5(1%JzhJHzkU9@h+?zGl_^wn1oHZU^m>
zkU*P|o_IZXElUI_+F$>WuH@|TViLRB5pgopk#^t(y$y|I<
zu2oSw&QUF8v!AGfw@uZiF~Efk
zsZK%OJsmWcq{_R))ExZ4hsMGdQUP3y)l4J+*C7+IQQg-`P$$7JWn
zTW%}cDdC6IDBZK)4|8_KwX4h~f(D#9Y2n7id0M;$T0FF@WYHSB8%fhQ6Ok&i^-5IW
z9#3Yy_`fpt^#W>sYL(|+G9^n%bX=5>;eRWqg9YTqbHSQyQbC@0~mt5
z!pV>IZgH3wqwp8WAsx5Rja^o~#&4UxM2SM`N8L9*epK?5kveV)NobFvaBDElV7R2j
z!2f!pedGJbA=tuwif7sj^}G>PY+13Amgw2qP%+>}@yNWQb5RaVdwFe_U~m}~{@{8>aZOdi;rJteJ&f9Lm9sicPem--miA#c4Du_nvTFPG(QmOa-A{2}*D+-Dx
z=U&y6jx8hZQ2o)NN?xc+TBy2`Fib)Kq+5;{9yd*3sh8x^DvG94W|%gq49bB#whGT_
zR$Ab|h+|fD#a9CsmIEc!NUgE%>_TVC^cLrqA=fkWs<_rOg{>Ci*P_W;)1zfgRCZXK
zWd&xD*iF=)M~2O3_jCm~If6)zYS-c0d7~K8@*BAp+XA^Yl#Xyub%nBZN}VIQ6+BOW
z!?}iTo1=$*5x@Bws;X$+ZAn7IcDn>bv9J5bmlbYB;O0&_=3vvan$5ffbM-Iz2#mm`
zZSycUE^Mvjc8-Aa7CwJr@-x%Z)VUNsoZMtHDKhrsJ-ia*eG<6-_}&d?LL-LvB)QgS8fT3xN!0peO$jOZs>4iydPCy_`y
z(gI2ce;1;1(d?>&ot6&%q?r>ZhgCI(O|i^JMJpWyr=}V0(?vM`}10f$$lf4P(B~M}7dg{~<=Ce4ih~kGxe@tO!&$PvVz%w{i!U
z_Ug2;#9EHo-GJ_npGdyU!mY>+;~Vy1!w6KgAfsPZNRn?D+%v^B=LCH+
z7I=2tTkn1af3dJp7+n>bT)G``H?2Fg
z97jC{At!oU1PcH7_^PSZ&z14W+B#&iC#Nr)Q)Q7tn12cUT&6Ah6~9I6ShADF+NJF7
znx`LuQa=01Eg7iDLQq1g_Jag?Y?=-9!Zi1opSmr|TDcfbo%5;1_kGC&Z7dh{(UQ%efBQ8%FZs9Lyhq?09+F>kj!LC*NTeXNZ5d3W3HzlMbUgZ?2RYA6e3k3dG
zpRUJ`
z&5@zi;c9OqZit$aFUO~7N`%Sa*m+eL64s+`j7rl{($>XP4mxR4`M0#}Q-UmR1+-fj
z)xa(`5#D-L%*dF=YRt{l!&7Vo8UWQx?P)?48O`)^dq`i|8uaYgtnB|}eVJc%kx9H6
z3Qu$ogPL;&`;*RbfrHcp`mazoo+Vzd46JdQ(X+%R_IFb|r}uSJv&KJAu^Iw}<5)z@
zd9S~l%b@1;9+-aI++iN;Rf%AgW>V;4D`ggMO~8%j8{z%$2qS@v#gYRMf2KiuoN3Dvs{YYp~g!#k|}2yA&%nuk&XA+GYgN-*JpU
z!QbU~J^CxhA;lcK
zd+F)p^33ymRBkT3RCF$G)U>F17nKU3aWjdgAp6cQ7Eu$Nj44(?j4DQ%yA)szRAQ3J
z05cadw&7c}!|`1$g|J?k`mK#_7mLaDP9`KP#HbYG)LjaR3M(;-C4ICPvOlAnwWDd+
z@(}p2d$EV*u{oXd&$}UhGuc$*SMyR%=djAiYvd#y#bps=(avNnlti;0VmeF*XHZni
z(%g-oj<=5wkEf15HegL<+PACcjT$Q$WlVt&;i4rIkX*
z?xKCCy4dG+h-xz%=2eErRbRw8#>H6Yd5xDdCsyGf_Wm#@6%mVFEQd#+riMSVh+2g!
zxO-}o5<-kx&vcwixvEw0P#RF38FrN3`CFSk(>8W4$62p9VqY$;`5JZY+tE?$@2ctV
zyKeuL+uj3i@9KT-`?=L7>B-xQDDw_2@D4Qaj@)(jMs*HOybtu)n&E9QKYIpK1{_op
zkJ~*WTl74U>(yw)mapvS%56nXHM@)Wc!y7Kq97Ch$skfYX0K~E7Z{qz>(KDP`rT1#
zX910R%YrT#jzYQvEGv#g)M*l@`T}QZM{=moeN9(KtL%@k_bsHtyCdKMu#&d
zEq|*VPou0>uBYK#Uwvkix-WlJi1qg{;JCu-_)yP}_EhZ1S+^9*;&NS^wI*q0=sM)`
zvYAJO;L=H7*rNQF7|F9@b6;*dc!iaQIYLG_GBG*12&H_l@JAQ5N&nRLW{kTFhNgi?
z9N_z#xrw3Cyvgt0-tpev#Ub>*-rm0m`8fO7(bz!$g3ZcFVkt<>yx-i&tSo{7&f!sL
z10az4lvKkx!qSt4%
z`OFt@?K>53zHl@#`+h_=n#I?CVl(uI6SsvUCq{)j@7f2HKBGP>*nxGznjxwo*u&+*
z=E5XGSp`M+#r4$)<>YD3(x=~<%oC|}{t5vH{hBc8$J09qlE*AUobOp^>shSH$;0h@
zjYvDt$Mnd^g`;g_dhAb!+h<^Fi+}0gIYP|Ypa>RF>gN|W@t+NM|Kc}-qiuh|pHbrH7sRND#$8SX5ml_>17TRZdua*t
zong62>*o%<7QsN*S39w5`XMtn$dVW{6BA9~l-H0Yj4Bp{3KW2>$YkZe^-!s{;#MS%
z45XkwGQ|rs_L9(#GUvFWftt1K)VjfU055ib8|yLbE{VU(5}0ZcEX4oqMvkHPvQ2}l
z9;$f}JQaStbXD%RkFnC+4gC@^^;Ga2Kc5{h^YAZDeyQy7@xJ=vXC;YxfIgpcDy;F2
z$pq6-7-1Ux1=?5JbjlcG?4{P0kaNvglliej8zImahkLzlA>PA>p!{HzA}96F2~|Pm
zwfy4?q3Q_b9+a^kK*1CNW~&Is@#z<~h=}o7>K}{Sd%EU*sz}@BO{)3I<$)lo+g4j>
zPnrktY_*_=_=@$T%*OyyW7@}7W470VkIMG5B+Vj|j$^@3CyC9?{o7joR#?}6qJtAUKWsVjn$Em***8&ICCXKq)CQE^GBvFPcIPjD=y)9mR;UoV
zV<)P61$OPwTBnhLF^(j(4pw+pWFM9mNx^l!a?(?hTHG4~
zency$2lcMUtnZ+Y)B0c;5@j3|{EeYJOh5qN;=w0z2^+;FlocUTrpAVm`kFz^rPEHp
zXW#yhJ8M$!CN(M`)N6vSfGrC<@_F!DuVAnG-km=!Pn6tagZ|4xn1F4J4QT8G6WXo+
zvVzL^ggh6n(S=1vEh%_U8wF@0=BvGsm#^vyJd=vGXi$~^(q4j@)=Q;$^tftS8^Nvr
zW7!zr`jK5s$Q`x#i$Q28-BOLWKup7K=7d1|Bf%^itSxEvhzUi5Xl#&00vZKvl=qA&
zM#5EACCx2Z(vs*p#ToKT{usBIuW3C)LN3nMVYUr3_VS|PnT@9qZw|K!z5uhY2KE-~
z@EF?uQ^<`;Ve8BX)-yjycibEnNUkK*v*RKon%v+PmIr}9c|Bq)++^z*XBbL#G*iFTQ^}7Z6mpayi%i}06nuCHMpsCs_T`gYL
z>wS@p;*ihREsK`J1L<;x8I4{44`h?3l_$M^k(Eq~i|{T3v?1I|AL|4z9z^j1B=ClK
zlg9P^pWP-#E0mQ8+SH#>PUr0qTrq}fK`@0qO@^3*nCm~NDPx~yY+9ehw+AE_gV~kN
z_Fb6H5GGx-O}geo?uF=sZvBD=9<7Tgv^y#1Ua3EqCcdiOOC%BAJ6pRugaVFbCOfH^nWf$%@V3jq7&%{ZxUV=
z%q=2gu6Qs(uK>MStoW@>5o{J8JWhVQF6awb=ykI^mV{#rEL_S#_zbYxMQ)q+08X_v
z;2Zl8M8UaC*W@PunFg>=sfZ{LS?CRQ1t~z|f1RMVeAaYfpgW08*=!11a12Jodf8^m
z%5?wY8Wj2kxGWz-3k==K49xt{hq0GK
zmbEF9UzhFTsPBJ2tsy+?Z#5#0EI5W0_AzCW1~VdrWo;OUMr3WpRSEKS@2Tu-;L(WQ
z(^Ph}lf=dXWlB&5g`x-n$j-sTEwCAeLQc;6w-ufKK1(|+?zQ<*2FcMvwYG_>=bw7g
zseat4e$u(TdYD(s0B#rr43zr;&|xF(=RjD^2kBrV9(mmKZ={6Kf3uxA6Rd9&X$KI@
zc@ivmX3u(NpW?flVqH(hN%QTs)oFD8EqYVR6;G4mlFXvDoMMj=U*5FbowluNiMEa4
zv6R^qnYhzdz~vQ$Bg}_Tu{7a;*C|OSLsQINuU`fk@y
zKBn(BGtOEkI!+hcX84{4zlw+lvR`eqx^xjxHHjf7@_9|{V>PtZaD*-`h3Jc@f6xzl
z>&IE=Ymnh96t{P%=-o)JlK8s1QtG)hJ!dbSsd&hKftDaq=!U*clPV{>YOpdw0vg%l#07Uxw^3CP@Hse)JU-(+QSbdteV;K4ZE|r~sH|
zU|g_0ZNA@pQN?pL>gxx^R$vb#iQWrm7oXHRcOQgLMk5@?reGMo`VtG2x}l+&a~{<#
z+vu$C&}-Iw&&ufor(KEC6AMy`9thu#!{
zvz@oG=TT_R(NRVT^*y6_Ln44oBKX1IpkK!`_o;Z87R0o&IVwtt4!Fn`PME6b>5%?>
zOnXlns?TR1u1$Tg1|gg%k(y&*g0s+Kji!G9iv3yV=&OzqPvM*q0_*u-7YQp{?i?#0
zF<>8f5-rnm@|7L@ajc{|{8QU}b%lOW`(s4+#jhKfej8kk&0mg!k_IoF6-H_Kxa}+x
zIDx7^<~q=Dq_yluJ7sSPMnOm>z)YalpaBHckz$3B@uT)XuFLh~;)12#)M9lJw=T)}
z?KkSH)kM&skYwp}2yEhVyO3VXW86^TLum5{=kkDu=
zteC%e_~owI+;h$ppWt!Q%7;Y9e;EZVTW@lcQ}|5Ry@K_0SQ7
zmYr_04DG#v)^GKG$>-G7>~=hC4#*ICybKfgIHrZxjOyt+Fq5#C2QXdFZjkX+!IyK@
zqnpwcgzVzCOf;qt@+URq4=H=wd2$JQx_YYhDkwP50TJb*)(L#?P7+j=Wng(>1U*ke
z7>|@?<@8#kWSH+GHEh|)`T~B~>Uo#NA7F`mf&OdXXOzT+YP3iN0ZobzgcHnAhgmZP
zNTE75OB@nA`HKvu4Jj=Jrp9|{j^fQo!X-9-&
z>XdWttjJq}Y2BYmi%I&1Z8R)olgE)ANtTG)*MV$RGtu%ixZGS!;dQ$}dcuR>!|gp$
zmKL2uXqILY(cON!jmC;3p!xL>^XjGH`&VzJ%e*p=UWe8@WmHs%BoW-1<@UaYCgk3)
zDz4PQ3MGcE1nX1$%Zfj4m$!P3vBCXJU?g;C3R2@4-7zJPX5R$z6yh2XPGN-#vL&a>
zpK^pTaBYJOAm}Fw2sFs@Ki2q^y(c^=kkW7vp8b-)Pi{1v$BA|1wiF#f!H!G
zgSgb-X=RbuGOo>eLlZBL50<*)1k+#cMRh
zt%3y`tRxvj)rifXl}`mR&9ZGM6_#oG-fF`f_*};8tKkO=#(Cx^v81T;73~XIGtdWm
z>MQ+@Q983I+5ah6w58}002)~`hDhW{R%w;npC{s%zS`*)-IdkIuuTLxk4b+`)^-SH
z=*77gc8{bh-HeO^30O@#ktJs{H^#us*r1poVE93I{ccCIH_w|R9m2yyGK8iqdaFsM
zf4e31cu?k_)Ma>!aqyYl!c`yuu5RBm?505AP0)oipiW%Bw*Y63}hXCtNshA*O_
z^vbBPyWuCYl;|2vBnzc##tX;H-33U3{T;voS)7Izgr*0A>!@%#oX@euX-QiQ{K0o&#>I_zC
z6y~hVGuufG+X;VT@+@PfOUP2{ES4;{$r3>3I_PI+FB|I7R*&Pdh^9J+{Z!I&@Ce5a>SOXgyI4D9ys7D^Z;tIYBjHx1%bbq2G7W~4A
z!W;c2w=ZWCt~S)koVhB==DTmpO&T&>(q1%l>WZCXVNhqee!F^>iTDBDac238?
zwR%!CPzcqig6TEIRIMDH6T#{6Go5b#8pF%PT*Q)UKInJ+FB&;8iH;?@h`oy1Ng;d~
z^Hi)Wu&gQvyma>fPc+S{AukF_R*X4^)v7jjdcyKXl^Sf=1Q5A>rP)_+UmBEhYZ$Sp
zDd;95W%-#9G#$*)Fsx>_;cI%tkB%FTgX}BC)Rw>NLvvj^BNn$C!;i^0>9lweJ3o07
zySh#WMUeD=`kmgt2-`(QOdf{D%2q^*qX|gN*IS7NXD5i`BLc!UcISV)ESHGUiz%qY
z#G#+^+4EhKA2Doq^L>5NZ?weO6}~$?&pwP`Qnwl;<4ja9`+<*9UvC`f84%F{oz
z!;LlGSwBP*!3
zscdJu-wecF@|)c5a-X@D@A)L>ZFd5eJV^U3c1O!U9c&htYMo71mN^6+K>w;3zrvfH
zVuMO9h(oZzA9l)y}U=`4EcNiKIc?R;enN1ujy~7^p1T~Ddj0y8o
zu4dgwQRo?Akl#ZjO{asU?vd_30RTh4aVf{ts(S)EGvcv3N|cm^*lGBcK}yyq_5^ai
zPCA)Q?-EDrH;(|yl7l}U>=7%-Zj>uV6IGRML5`g=WSnpG)f`x{=LM);E@PA2cYfKu
zK7%>`u|xk2g++7#gxHue@XrG<^&BIYvDTF(-d7r5I<>LcS-3b)+x6kD_}qy$<_%kFuGs^3~{g!&pc<*#Uvws66g2yt<7aAR`$%`6
z-~v+A6=e-{u7(TK8*y=NPxmozPq7LL*>-yFbycn!UF?OT`&sUlL^~PBC#70wTkM~4
zOFH%f^V>q{Y(=TU$e|!}BD^t-K^6D@QU-&J$+LY$0s*-J#m~GU_Eh;b>?hpadBN40
z_q5MqH&QNTsg31#H}`PCv-JWGN_ax)gpvx&z9g?))lsek!li-#Avi
zQk`m_jLc7VH%o^g>UKYia24@6*FgNR$hyBi4;XlD9dwV?C
z+Wzc@qa48sh3EP$9IM{lRxY8Xy)5XNmojK5je{zmYvb&i&Y@8kOquyNi`H{&C}pjR
zS46+lVxJXLBk4_Y^3f(lV{zH$QJsf&dP^`ctsE2{ax^s#MVTfa)0`zU$@Hm}9282x%7&?;f$wYJ>w87hk(C&*0{eSCame4I%zjicE8vn%;reW5h{;Sz6v|XbPze0b-?QNZ(af>Zs>^mJ+E}$?H7+s>0Mt=^j1vyo{*vzhkIFMulfXQ
zeIk_D8ZE9xUOxiU1Wy;Ate|{8T3+c}u8%9rJ~(kRoB1qJON#Bja@V$Leqqt3t}gf&
z|F4#h)UvIP7W>G@P-~rywKJ0lgtG_2_xIP`CX)jU8{Xd10Xrl0TVbTifHX7wDz{Me
z$;Z5qy@DLk3y|7XIzt_RmYS-T7J!zxVb7Om-8Pk1lP;{y@RY6eGzZ^`?DtQ~1kA0k
zGj+qfaoKEIGox)u*!EvuUMu(2cD5&xttMrq6GBbUFs
z;Krr!vv9jx)&1(>Ib9F9-Q=0OgTGtd}ZuY}g2LrK{=%&Ahc
z=kmF-)RGd}sl~-!JIvpsCrEp9InA+VuU3yT9iIchVBx+4T4kJIBi+1fsb@6*A5h-O
zTs3y|7HQkszAlkmSYLg=f2XC56r!_u^2MOkWxo^5B`Nn7G47RqCyB=wsOk5V4y5l2
z8R7a!{?n+R3Pu%w?^aXHuFV{MHFkL&A<^%Vk}MIs4^&M}Cb-~8mqO?*9H(A(kJ|$b
z3)Xm+YKyFaQx{vSCITBIicEN03
z3spQGlXe6iV-)Ip7}{5Bx<8;k!d9y4
zTN)U1NWz@xZt))jF;wK!HgKTXQ>$bfcnG50UwEyD%_cQG!k3{0m+(?xXI7`-Zl=tZ1^1t8>RW+*ag(&DH7p-P2mRGWCBS=|+yd
zZNhv*`PbJUSSQ;Y>l>PYTo6!PJPRGaNFGIu6O}bTFzeD2^CK6)Bd3pE+z^HdT?8D
z+_ju;UIAzxiRzpnM$h_{s};UFKVIKBxf^Y&q;})sEvooW9H*aI%1r?dfE|Y_uFpAS
zDtpWH)-fFd%je4mSrJY2Zq&OeS)=YB$9PM>xwPVguk|~!_;uT>kXgKFd8?%vfRpb%
zf(?OpqT5mtIJtfnGx-Q3SEpRbd_Jd(B6QF1NsG8qE$3K0*F%ihuBkX$Ce86F{Gf*O
zKr!xLyLjaH{+_-leg?u&NuS`KxP~yF3cG(^DCe*w7vTPeafjbUtj56?CS(#Di0^-`
ziro>`H^RVypYA`@3F_rNwz9fcXr;oC`KP3PMIX_NfJJ?o4K6|s}
zIX{mF!Pg|)7Tj4HYh(O623lrshrG0J%%ucghuHV|KYqKY@hmM~!hQ;Qqv~b;5LgyQ
zPj$QiwN#p@g6}h*#KlYqJp73tbz{+zf|y;WX{%L9UNF>O$JAsUYY`hWRQILTK+?u1
zdzoe~tkO;@Suxc^?KNBd@%e{(H|l+ADU=qM2ftBcQVdhg_S@Qi$C2zM7x
zAzvB_hBI|Vn`AmhA}*Ab;_d8uI?#Fh)#MG~p(D|J&E*V{Dup?Lx!O-#Ydax4Le^jm
zzv|clr7`70VKYQRO-ni)-WE4L_$rpEbu7%5qnKUep|
ze5^KEe})%h)e_{cP*~MXveH&#cYb{o0_{^1auLA$xvqLXb%HoK4bEtK{bC1pvQJE}
z;ez`W$mO-D`{*PBC3rAe)B7+3)svl%;)`9`CF)m+A9gFNahu8V^m6;4EO4T)6><23k}17i#>MHihzw
z7;l~Ee`ATS7f%!x{xC^lwodIIj!A^)*>AH5=F(db!_uV
z$uL`qEm~dKaz*_>TMg>PL+N(Oj;at`ms%4xMU=|Mf3n84^&;hDrP~
z@;-+vT%~(APtqGp^NWA%NzNv7IVm@8&Mf@==-INUSqp8G#*a%&p00(s*u2CjWs8B5lhC8+W$$tR5V+d@$Wrx+2od+50bxeBu#4)O
z^w3!^>7Y-l3y8#}#0^nzrQ?erid30+c&8%l>S*jJ(N5;cf8JrG0zh$0X^Q@pvsX({
zOO_otSuYXG^uT^V$a_$
zdDdJ_EDM()wbB6c{=Lpxu+QUmjTkUGPSwUXK4K_o}6ggUapd`pYXa9go#bhl)J_qO|!lre)@}uA&;CM
z)5a&f_Pa;0`cDesZc>QGhqqkN?_)A=^7dUvc4Hvp4}Y};^?gKrVr349&9}u613P)$
z2Nv&}R^;Ta(zDkF&4(2Zew~~vy_0kl*@AqATc#Znn=>Q?AzQf?U^f(fZ!Z4Von^n}
zcnIe8c)1b4-e&NA9cJmf@0`2eIupiqnPNNa1mhkYU|ge6(*UcAO+}tdO&$<6)%0dA
zvro`nzOJHk*<+!dzOI+L)QW}zYmfgGq?|P~S>}`dzH|vj)hLqxfxwGEZ02x{QqW}^
zYJ5n*ik<_`pY8=QW!Cnl^o2S1cw~onGH@ormGj%_s25g;wHRE8{(7yg^RIc^ugv1^
z7I-NPYnoWUzSZUhe!GQ9hKtlKVp>fX-sU|sJH>p&*}=%*$UwT)xudeE77Ebg+}D<}
zo0|uff4}u}%O0U#Po6%p2rW*|h%Aures6PK_j|Ew{|U;|9*UMM@+M~#;v}w@42NgW
zH@sQWPzGIygaDoM%SdPpjzVG_6=y63iNLjB6o`%*bLv5tylvBDFQwCKE!V_VP2AF$
zKZF}jWCO*+unLYS=(g+6b^;oHR!Z-z3-@QD+7lC5o$9D*Yy0kUWS)S4v;*P~_dMLF
zp?gNLm!L;kF632d;MKGPs4$Yr4$zhAMCE&DtQBEIhxR4_x@}wR;K@NXd7`ZfQ^(3e
zVQ&Bs@Zh!LIC^~D7lVv9J^7AUPfJ87K_=o?t;-2D8KuS$zMOg3@kOi!a*CvcIu#{`
zq2DupFpa{x=*jZ7iW1@2GU5Erz~b;r
zmBX>)B0d*rAtR2j!2+d}E9++W^l+8RVN)7LC?+jAb?Zyq2?Vti^ke0k65(b8t_WED
zf*n#aU5ekE934j1Z?OnE7Ul(W4L>F1FE&_w9KH@uf_$E~+zpza`h!SG{Wo*O3n1{K
zdbKhxv|_=baTe83Kp??I@oAsS(Nx*mt3brc*v}7gDf@cjB&Q&fGRrutw_KhlGTF^=
zLtKf^BUG)VIb>t1!sV+pmGnuMji`WiYa6(3N(=n%U+r?OlutkOSNfcgW|SN0n0W7n
zlW}hTVHp>GU+qL#+I6@
zxE|E(hOVd};I(Fz^}+OS)W0$~)*{#Tvy#qt0hzk$(3A|8Q$jH6Br!Hp{|w5QG}Ce*
z4k-`}6g1;tYRJu*T~jPujK#F=s?yv#F!ZBHGHld#r5$0aEGUdwIkn?7_CpRh)rY8{
z<6r~j*=*(7>GMS&CXu@1byuR=xkS$~lnEjv(=+vlDp}~1Q9Z(!gi2Kse4Ox}A?P$&
zMvLoAexkU02(mQ0IY3yE#{7;ns@>`%SvP6#_VrYYLbqAqMQ=J719XM@Gb~yj-e!dz
zvGFnbkNbVI{nH;^pT22ZdkyCdp6wM(w2n`<}H#>DV~5%TGq$&$eNcm75!JpZ4z4bWHO2>F`OIi
zo%9-1@<{15uQC-L;4e&&Tw)J`)9bnl_8(9|3|rc0#%N>S(giOce)p728Vi?f(f_BCVNt{A;uG~iZgk1)jMEZclg0AeQ{pR!F)w`B-@BuK_F+k*Ua2vMPp$o}
z6`D4zEFi;1ju^+B-4pC-c_NhgGd_mipVn>;Q>UslF02H8a&PVeWi3W92w10M`5uDU
zg)KO9tkxGf9n8)~2s>^?@B%Mly%1}rwz}PpHQ74dp`J*;A{FjZcCx950#m3MeY>w)
z!3}>N!;k>eM<)Qm34zc|PAG<`qCvC)3O!t(VVfS;t$+=B8$os%BZJF@52?nS?j$Gia>Klc{##
z^)tW0?^3)?PzP6J$}Oeb(Ne1j3`mF@DOQX?GlgKzCZ6(Bpv*8*|70F{0mi5bFq;9)
zb>>=IHJ#a5Ur+&D_N9uFy82YI5DB?*@8F}inC>{Hw2VgMHL1L*N-Rn?cBM4|IVHJTC)>tve`9j1^~HzsK@uo{+q0r3M#0z;J^u*
zi~2`Dvc-KLzArb8t6CC#2SAG6)>7Cl+_yFoAf;UYEYUBmT;^H8Eb7ckjU`Xg*h1YB
zLt)4@m_1vP`_p)~*6XP8o1&=+JlPv}cdqE_ShjK`X?MDfR(~%b#3|jT=(~N;lgW5c
zp>!h^X-I@hL{h=aB`&Kox#Po$0?UT+WLw1FT&jpSq?WgZf_|5`HtllOIQ545I3R=oa2uX{H#(wqp^nhx
zb%clN2sPIc+Y-ZncT@L)UFzN^+cs@VqQ3f1J9k2XF7JbC=*YA(4N-xDvK$F@f!;~#
zcN4l}&ExS>k*}d5-y@6sB8pJ!nmQ@i^&yu#-M2QoBHiGN`RlWGXUm&7yF;7p=vuKX
z90&(Twcla99i^~L<4Im^OJm*@NU#zGVnBspN2NkBczM}PKM`MwwPvTZ6g^&ViN;dQ
z_eE0M%wgj~yQXh-X2sCPRf(X(RU3{ef^8a4XQP|AMKotK-4nZ~cOI#U>a&@~pGQM0
zBRwqU*E9b*j_}n$S0Lu288EO^EazpiMwZE*1dhCa;IY5M_oZ@2tvKEe0)!~m+bPyY
za6yE9>wwKz$|dqrflJYJyGaHhQ**r
zBOwh~f?LSTsD`5esH53hAZJh~XKTB#3iagFLaA0zwaYFq)yS!0sYYj6OU{6Wc{D{*
z4Ok~`E?CuFBv=R$ABRU}Q8GU8G>LQctYguW$&YTVA>
z@^Jnwg8UZR+l+u4dG8~|Fvz`K*p0M`g7zMxz1^%A&tSLQo1(pI$!}=y@k{i^u?44i
z?}|`X7+{k;1}=Me<%=eIsyR)ULSBcf7w7s)CezeJFZ`!2`kP&xcjo_0
z;d&L^z?@1ozwehSUvR(7#s2yAa29Tqs&3Sri;LeXt3zIOV`6Vj(zo*J2pI=`Pj{d~
z8*tnhaMT7K`*5jK?+D26CePD(J@l<_0I=WqM_%jjaej|c*gnm7OKMrg179=>l)aaN
zcgnX*Y892GB^S3#3Lc>t^^cUUEL$a$lFIi4{`-Y56bQ=RlY~!G8kEuZtQdNsfz^#G
zPzplIp$Bh439MuTfu-)fqh}d5D23ty(~pg76*CUQKlGaG>#*uLN~c_0lOI_-9Qt-aPsEe2`7w?SVx(m=;*1wHDR
z$wNOnzY;Ni#nk)~Xd}KhZ0{K{jhY^(S7y-OHE0|)K2EQm)Aq;h_?d6^eSrS-eY5{j
z`jh+VH@^wUd6V&7nOsR%i1HM1c=8gf<;J3K>!d#M$H-Z*LxAmRuc;=IA%F@5#SuW1
zN)LAMBsf={JB48uR(1p&qQ}KT$|0Lncfj7n6PYFteOn=E$=`<)GEgJQ~UaYTcW=5U+WQXQxZMzYbF3!g85&EXE>$2d<0SpBiz
z$9-DnyC9+J4U~ukklE{sO$_vH3duDLl#5=s)xzncX6(mcl2sh>`}2S&VtHip#c@B9
z0lb1jPaz6!uv6%LGW57L58H)*r0@q)ZnM2n3^s(8dCb1*c@w
z2nyu&(+VYvu7iLIVHS`OoRn**k&KyiCY`;CWsZ@WxU${FC~cxF!k8vO4GqpKrdYjK
z40!5eTUXVJV(qG}_)y?1L5MIZJ8}YH>c9z3I|a$aB8>VxBpk3jBq_fP*a;bqSiL78dh26CF9X3l
z>}DVgFxWzs6%h^_Al1+JVU^GXYPJ_#f%3+GPL2scWP%aN$ii)SY_BH0uxf7Zi$c@L
z`M(ScALLq%&V@yD$p;#6w+o8ZOwn8{Pew1qFV4*gP3NbEg|ZPg?9lwpXe9z@DOYIK
zj4P!219b!8D*&wx;c!D#Y;-ysMf^$sk*TR8{jQerz5V@r$6GErgWg>5Vwl5~`gi_p
zl+T0zCO_$tXJXuY2p&eOU_~{27647Mb!4J^yRi3ji+cefFuxD&!U*W-+jSZSeEo-Y!JQw7UXuE=k5Q=+Ufl#Y(C!ZpzSJ3RfS~NGJ`Sk
zi`1QWrk*Dj|5v`^|5oSXk%BbR#O%tw&p%Jc63e$czeNYLcLnCR;x5=t-}P1YE_#2F
zTR`>r8{EsQWNk2f+RTas^GPGEbZP`p`~bEf3*r*wShEJ4=G}lSkjZO8ZIv}9Bd=gp
z<<&xpDrc@3niu@H%C9c%X$#bdHIEej!r%C6%BxLBA2vE`d_{jU*eQ&=D2yV5o!o(H
z20gh0^o*m)9h9R_q5KCR!w5dbF>3on2^P>PN_ufzbcGMd%epxpr2rg$VF~=JE)6G0
z(7_q<2UJVYfhG@?yw0{#9kpAsY)jtOvgNN$E-3tcpzzw=#c$<%xVGbG$w$G#qM=ol
zWdcEmjtE3a_)!YLqtPsUAf44jhP{5Pfp0Qasi}1#1=p#LUbIIGKb!7cv3~pP`mwHL
z(Wb11Na=|a<@X;t^iaiv4{9QXomc>bLa>$?$ZD{G2)i;aD-9eg2v%#$P$7`g5(QB(
zfGj#z?kE%j<_1Mkz?>He5?;(MM}4H;NkwtEyqp?{qTL^^mulbGl8~!yDKgBLlIv~F
zCKVH)GE(?E-*9R)(bF9tO^kXyBdO77PhWg2G3y*n!Z=D2D_Ykx#rC#jm%OqELnem}XR~Rnt;J58&dV6C$WUtyHOJFZE2(
zNGcb6UXR;Vr}Mh0I@SAJ<)+G9zGMG&=}wFBnU3}Ca(?tT
z6k```;hAbd$xtOlSw6K4tWwDjFj|zdb}(~?26<+SMi%F;%V=GVM`zaQOUmrwWFc#v
zD3sLXKPNvU>gzQg%#`Iec-$4;-CNhC)_U8lNnbSar7t~}HjXT>a5RRmYTLJZHW+HK
z*R&+|w_OeLzHyQUM1Ja1St)h8Ht{+j1%=rHZurcBd+xbs5$@`%6*Pt;x%%=%YChTd^S|!wyr#30N&P{};R9qns^NP}Z7QCJYjnZ#?9SQst0CbcVFEq+Z8()`c(gFWKq5KN?
z>6mF$(fiZV$Z2`x{L?ahn&A+Bo`^*@kJ6+ReZJMWFL%O)1G$%p_}s?l29F}ugEaRY3dc{-!r?fR`;G+23l5+PKdbH5v%P5;YNcRU`;xGGAtvkKz+yOxoq?_3+aOnJ4I_ilA_Ef~By<0^MP!
z-dZlY(#@0hklk2aVe(d_8Yka07|P3&j?H>~MY+x7+#qqx{gie)LCI_ku80IAh-5-Q
zN&gcZDL$DCc>xHXUY+|c?)=`d5sG=CvWmd1d}w6;$3g}9XC4`2CmKcJc%~9jKmiph
zrt=iCA`b$g;|a``qOuI>!cos^cr8?kRC1(J$!Ekd%|Y8Va>9AZQ$-`!W!$1@vsG0o
z6k=3tiiB-`o6l9tc0-trED{$eXHirOiu$FQX{P$&(#>RBCKt`zykSFjfC`p+y2)jw
zH-bM~zdoC#ZSw!*pFU%EZ$a`|s{ABrB<{af(u-
z7Q&EVS*1kWSFJ5C)u>ga0;%BXy-MV#Ad$kcXT|4x0W>$&h3i6e2B$$+RNZf3tAfd&
z;?j`9=an;+ByYxwxOH{IQ1=S~;~GzLfA{9_p8oD_E&YAXjnm`7CVwy%Zw^t5s{tFfO2i4xSn|E=ZdKte+J_L=Bfi)RJEefPP-dJZ*t58rOAgfmju@e7$c1{je
zZ(;#gD-%6PgjwD>35B3N-BaqNbxB?igNA2)m!6y?)3mwR9yRlXF#T;w$|G6D4Zgf*
za`S-4*%ho$8)J#p*`U`}vt#wBA!J~jH3ip@
zFOc7X7HT04GhE`Xb)!Pv;2}yyBVB01pd?+?C{U@Q28B{hEpa8Nh*HJH4VjdyTnLQS
z)v@hWb?LfPb5niD@2#q>a$3#&u)Q)lM7Q|By-FgjFo_BtZnR(WFpl3HTfO?&nl;DA
z$B(bc9_sEslpSFA0e{lw@dtv<(NMK$tc&*yuCE`Akl(F5wtoGw6)V_%WxRWCc=+n>
z?yHA~=eh@s#ztGFyOUO{H8pHq-?pY66wm|bNC!E`=}-^xi++Qy~GR}J(X?&&$)w`@Z!wqaR%eJr*t>|EJY7O?ODRAAl4+p=M{`<&!CTW-H?^I0LA`{!T(8e4!sfbJiiBfG&4B4je{tR$gCMHQHat}+BQE9Oyypim35
z`J8t*N*N8&;dj^3=j?j7iMmK-ni^(oR1%MSK^dQ9<#-Zamg#81_lNiYzk?rnV(Q+Z@bZSOS8CRczx3pAcY3x@
zRXUszBLF1#6gfKo69IU2TbxrN$YNAn4$85tX@X1^F0H-hBw0}JQ}lQ4RhP?J?Q&KB
zhF(_sw*W3H{atjieDr2=jK04d%H(hGwwY7@!s4t>x7X{id%bp{+-tLWJT{vb0CRsN
zN9dfci`fT(>cF4>v;Av=>tJ-vWk(DIzh)O)BWt2;#KYuTI>HJnsNryFsa1js7+|cb
zM;R0pQ!)Br?yPuc`(1$}A%36^&q&z04K`>O6XswlLL)uM_S5}mjnyvOgleU7Ct4tPq
zsGh>~W%9)QPsoozfI1G7X>l4sS4HH7Cb$wVXYN(hktg~9=ga1`^FM(qFcu^j5}_24
zXt-*Z%LkXJZ=KQWqwzaFqxuquF2$}}c(zhyYkI*kN{9Fg5y~kgkMM6<|E^aD^$p+s
z$~dxQWpEz-6MgTog*^Jpf3d(P!ZziY1j{3W?osHAVcjh|HiU*%X@;Pv0)
zR-y6|+)BMWCpm(ZTt=M7dH~+?C#+=jMn%45UJHMLD%yf*kjK1+yC}s4RN`Gyi%^a;
z!Vy%%8+bDufs#`|UN}M>;srAb`5A?3Y!o)4ng<&AXuLT391`L4bfz5EEuKlJ#67}o
zv~M2oDSqxUP+m)+wDSF>GL+;fg%UvEP{IQI-(s)<(v~jxf}km`9a4*TWN(cKn#RZM
z(ug0x7lo%6j<_>>TSR!e@q}HP^$BcbGJxYJwd_YiWu?Hdl3R{bTvQ-%T;Tr$=suCy
z0000100004GxtP*#7AEbJoNwr1Lyz%007i3AW{GT007ix;v@YG{+|U<1W*6~00#g9
z00000004N}V_;-pU|#<3I|BpjmcKmzBUuB0A}D}S3ILrs1}u2mjnV^*7(o~X;5YyF
zY}>Z4wr$&OoEkxG+jfK6v1l7$WJY
zZkfUI5_pRrvjp{uIi79yupDOzQgP;Mde5?l%7Bfu<^PXFh9m09e)iFhpn64&sm!Kq
zryXXwFEauGVgol>gJXg;HtdH=$czxhoQus#O8R2%d%dZNFyqT`6SvIS~Z#8|=Px-49i
zn#QrNaqf=Hk#LY^=v9(>&GlV?w|W8_T`q8x{pz!>1IwS$kZMR9j+=_=>L8-jI|Qgt
zJX3GPt1k!?AO1hXK5;x77o?~qNTr5Uow6x0FEgld-gjoz+ZAtv8D>vo2O1Lb-*I^J
zoJZn4+crTaQ;U^{%n!)Y#1?K={W*kM7NZVs5!>m$=k&i#>3WrnP>UDMp{aS_Z7H1Qm9E2UdQ-g3KMAteOaOS=
z9l-;1h6S;_Sa~dgt-`ip-*6n~
z@hEQMIq~WEVj?%ul~_akB=eKw$c^MZ@)h}w!YQ80NwuQJQQN3P)JM89U7v1Ecc%x_
zBj_oPGL9{dAI^r(-7eA9#?`}>aE)|Lb-i>?ai4MDaDQT8#?1s7jR8zSrXe$o*~A=S
zHMSG`gCn^jTm`NU*MjT94dCu@FZe3_TK;!Zm!!SPp5&#;_dJTn^5plF_Eh)u_AK?B
z^ZfQYygqM9?`)sqyX3FqpW%NJ@CDiiZUot2&)~yQAT%-bHJm+MD?Bm$Dk4T&MYc!o
zMGHm8L}y3$MgPR=#zw}@$L!z|GE3R5+)-XDzf@5zt~OTtt5ehs>K^rkdRP6V
z!CG~#oi<-vr`^(S>9Rgaf1lDm<&>ctaigx$!O6ggOy}ew`N(}t*>?tyQE#q
z?rN{LKia
z0A2tG00ICw07(Fg0001x4Hf_d00DT~EXJ`BKtK=xz&)NJ`M`)oMgc-4sp@M`fvQv>
zxs4W+TQACtMm{WBzEeH<-sQ~~hc7?aV$F~CIP>){gsia?2!JS9dy~o6-IDcW-H35_
zhtpHI!|T`jWrVYx51z=7GV5lS1aSg0;vR8|QKC$TDzZp>4LIS5W9$BCx?s=ipJ>AV
zuA(bDZ|J~_dxPT0GegNaaQ1>KHF-0MchMMX_~n3m^TkVbbWuT#AGs<0^cFdj<2!K5
zEsuIV@!&L8jWzoVs%6(;fe~`6dLO^-e|7y7PhQf3cUmro=z>
zd+PxZY)GsC004N}WWhsp8~^}C(f22|HLs%_i0?RAZ4o9s{S#Q*?}
zXE4zmG6Dw72;%|w=+6-baFjKK6Tv_t`A!srxX(i#5lsxS#POIXJmnejB#|hor=)fO3(uvM2
zr3+n|&0OX&hi-JI2R-@4MS5|a8*E{#Y;eOJ4?OY08y}4L;wM|#$zBd}l#`t0B3HS|
zT^{n3m%Qa8qkQEje+4K|K?>$Fb=1><0|ne-G5$Dl2y=E}i3=g@!~$CaaHW{u^d+A{
zg(y^E3dat6PH_@vMR0(FT;&>fIL#T(a*o@IWC2&OQWOi>q-ez`R&k0~f)a7$FaJ1C
z5Wxhpo__3B64r!b!x9#;oMp_X58o(KvP?=*s?wCM3}q@y*~(F_@|3Rv6|z!ADprX~
zRi<)PsFJU|XB8!?QZ*m>LX&O+m?DFnhG8IxUMhiGNdF`XNvpuI1x~F5Li~Vnwyh<{
z4t5+WzMgj0L^)
zPL#Rn2J5Qrv-l&fce;i=mpF9yz99;B?^pJExpIH}ZAj?Slc@|7^>+)eOIuirGzSZ_0={rgT#2hv}2l9M+`Z|+sM?Of~u98lp2Y&C2dY$0rptcJ`gOkiO?Cr3`j12PB14+tILbKp9_egJ3+Cs0BZD8b->
z3?UNC3@#g07&`(ZHaK)dY-CPx*{BBM?c!))U}SOVNDherDTxFE2Z0Wb5{?889}X*a
l9aaSvb{?%AjQ?9Vu=H+ZVsP2an!?85;sOA~l`_2m0081vI=cV>

literal 0
HcmV?d00001

diff --git a/manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.woff2 b/manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.woff2
new file mode 100644
index 0000000000000000000000000000000000000000..3d2169952f43b6b97d9105735b3561136f3aa2df
GIT binary patch
literal 21016
zcmV)0K+eB+Pew8T0RR9108$tL5dZ)H0Mq;c08z340RR9100000000000000000000
z0000QE*pW47#xjy24Db$ObCK737QrW2nvD7V1ccF3xqZR0X7081Bhq@AO(YH2a011
zfmIti!v~m~x>}s;PLOQ<*}c_r!fm*rcA~5L6l2>392p2UP5|Kc|DFB+pK;ufA+S*0
zs`mcFBC@in9XV@NRM}0-k(f1Sc4M9seKoS(Id2)ywuKiSQG4_bX-ivr>5D!)sEt#^
zlD72mFWy8~(SoT;H;m@2RSRGG@{(I@YWh6C6QM3-zi3W2+tfcJa8uG8$&t-D8Y8F5
zqaS?yXS0RHh6iu5y2XQD_XZ%85oHe}qFD7sYF2xPRie`R@L2B2vTv6tQZ-
zvRN3tC>LGvf8TU}XQguQ?nyE8sxv#2Hb4;16GyE5g-@4?BNnM5nnIi1JW+=hn+Krp
zV%N~d^Z$)KzkTj}F^{H>m?dal-KuzF5ouJhP&C7v0e+i(Or1D~(HI~~mVi_|;yoe-
zQADs2RE%DQo4KgKMS2~(=)e1$tGH?@s!=VgXP>+C7)$u?RSpZ%Av6+sN+UdhY~$IV
zcOOH7USEjFV5HO*SHk{xTGf|Blx@i|DA?8Iik+fn`z^}s<`6qV4zMF&CL_3rT><=G
zP0cY*BOuVhnIKeI1MmS&X9+!Qqs&}t-;{P=+PX-N_vZgDnsua;^{dFI@$*mpo;%pG
zZ;*azni;h#pFBn{#dTm>_CPWUtVUC#5!JkR}tMeC$ir`tE*j
zW-y?WA-T>P@^D6%s1)HqE)NUo8=w6uYqH?Njl=H+|DU>ED$0b_T;+v#>;Qdm$V)+x
zg3?k^r>NCcM-H21(?2tX70~Dm+NSc3`yf0{pVVE}#;mvT4MK|D|GeP{p9NkUU!NJ=wqC&uAXU9*pVX+3TH8&oEW
z*3x|()NIL)Hh>7WWWlXxi50d$q2pqME`w
zb(jkvfq{Wh0IL0P9h|I6sN*#A
zH=L&7_(K8e=|Qe0d7)r@P9KzHbem{+u;QHd){e#x7Vnl1GdIx;0j<$e6*Gtd9LMvN
zdBSyc%s2m=o+!!Iws!U|u5KQl-u{AC6jhQ$vdq@jN?UuSi;LRTRq*i8czPt%+cY$3n-E}wWPf&o08Z=BWZ(%1Tzf@>JQ@h|Z&2SXO;T*Y*hlGsZ!~ACgUWNp(do9x?4{KV#OL(O
zP&03G#_Vwt`lx6*ZoErcqWGq=E)G8R`Mw29T*xO39q-=K@50@Wvak;jVu*t)VAY8o
zQmU%QE~w09=tUefRu&!+APskLN9Lx8bL7lxHPsz6{gw2z{)?l}fU99|m8JZJ!9>5@
zUWUn`8l!4@%z8)hG%?LM99}0e+ra?K@d*(_Jd;aU=k+4dz-vBO5hq#cmVgrcn>XKq
z?3-cne?f87^hM^pi&9R#|PWjW*eAt8I4K
zZI6A9IOVi6&iag5%>gYE__(CW;sWpi@-q&EGywY0-pksY8}alxZ#hB%16t^(qibhl
z2i~?K8Q|GA-N5c`xI;Put`~s0>jmI_*3{j6jaj+b1OzgH#jLfOKoKaTDGokiZ3Z@#
zaU*14O$|w&Yz`yND*2`9r?0`Js+us_Ao?^1bAFrqWNVBLTExFUOsj0hMedC
zson$CULyO697RH^_a&xx7s}{2NKpE3%mo@1fP#~zEU%W7h!Paya*#l=^cu+J2KqM_
zdJ*U~Lf(L|fW>SUoNFJj@1b2-DAILMjy5AF4D{duwNLG^Oxf0z&ejOT30C?l`_AZ68p#BI)H8
zx{>297ediktw~6mFP)Cwh)yABa>*G?NhdAsP1cY76V1fQP5;KI!ZQzTz0%cfc31t>
zK_`&bw8~sJc54KSzZy1|W)IA{JR)A+wm%MWOaTg*!Ta5ZQdM(R_bQRwZnhzGYj-(8
z4$K{mRE$bFSg%IjBa38hhuFL%WmTKaFqwXpTcsA2UeUaKF}u{FY;BkEK=6XgI0Hcz
zPtxL+_>t4Wk2|Q$dBM40>>BEDYacDRkS2yWm#)Mg`czbAzx!at5r18`#q$ws<+qZ5<&
zae$<4_cG}?B{3-S6ENPeBFHw!SVOjc{$@zhK#VCi4%G^4HN({?a;reVY02SFmpuJA
zGnM#YNQxyIoAaM1h;MPVXo?8savDp{UwwGURtT-
zUm%z|k&vb7;)7Lgma()Ypck`N4SoK@^mj%=L8^MikP*@lniZrwmXpA-Adz?}7l<7q
zp$L$40!UE_$*`IklcbbFj>?EJRj$eMx)%WdEdNB)^K{YqLBe6B2}OKFN|%8lUzrLe
zOQm6J6-&p__taqInpPf$vj{8SPSNdQ2gH%@BybkG?2#*XsC%&oiN~IL@+|Wr_s{hZ
zqWiz{Tme8^aEZXF1|---bO`IM4UKM=H?%tDJJg%s;iIehRy#+}E&{qY~g^(+MJY2tcF2gzL1l&
zPTDYL1UKrr+YIm~TC;nHDHlu4#u&gApa}td@C3r`<+kUegzY&m0cS$W{Xw|
z1KLAAKz5H&iI5jtUD};7M}wI7+5F8kIUWdP#S7+=4X0ltXk9G7^D8)s%+d=KTOByLbk?d;|
zr~&~pT+qC{rEoy
z9+8U#!Sf@f6p{)qT4qM)cKlOtC-OFZ{FC0aHKt87Ys-U~wotb7a`Fsh1d??bIFDGb
z+ISZ>ljRGiE|QGGZ4QdRuCPQ@m1&j&3Y#PWQ0*gVc`H^tKVvjX(Q}F!j#-TGIRU2-!j!XORm141sO1SA
zitCa1-Bs?30-RbS4WdBQNqay=a=n1cQe?&qqjh>O6znRe+|6w0&uS{;_iR6p1q6j@21xM6AP~e0Q
zN&3>A5ea$f<%QXxJqhX@b=h
zqZw9<-*PRr!pV`32h0)Z074y!bVBPKF>IEkq$Ml)Nc9Ja0hC%?n9Xph1d?i>jD1eP
zpnr$`Wb<(Z{1W(hIx~Tnw*%Hm+I)OeK4-E%{@HYJua<5-t)794J`{;l;o;RM=M=z;
zrlH1=it0LRa=^?*Ac;}j6xiqmYyp&J8&~aS69yOsr0zBYtHdTNB${#xDsx5!pblou
zfk4n+vI8F^Y`=DV;)Fv0@DPACu>gfL014#Pe2Aq1#bO`qV7af`)5i2$ENB=orUo6v+P=1o?wVk#p}(bRmZ7ON_L#gdeetfZ8&NMtAq
zjfs>+!b(p(X)TS60|*EyZVKddEbH5eV_q5=dzlVrT%U*
zNaU4QmyJ-#tp`qe!R#EDWnC%>!2ytQkZZL6@JVw7hMqNK3*W@h(*YhN8lXM+?wYF<^;ifTnqTD8wCf>F)$>s=ar0
zM5mn8^T-F?xl3-QwY)H-#ikXTY1YQV}Rkd
zG`fUu`e{w$>Mbuh6CTHhUjsQ^-`NAbn{l8wG7s7!zJu
zDq%!wQi(@mk4D&sbcDbutkXDWu+GYEaz3UoAD2QfZM4mf$QhM_w$_GdTQDJOiX>8A
zMdQK%T69n*r#|9X5fUQPmdr=F^bB0(OVac39;Yo-uf1|Qs9r}k=$r(A1|x(JL7arl
z3=Np6)#R!-^ly5&#vy@z+~6Q!5<$h?t(EtgYB++mdP|vsrukH4=yu8QbE>d^S2we1NeEic|>69V9KFyT~PZtPv)K__$fu_+!XMB
zhPB*8vT~Gg;xJi>t|??qU~yP14ttXeQQd7XnuLwJYsYQS;G$8t?eA`H&lq^=;EH5<
z#=0@JcV<83r(EYw+blEY{SF=A*MABr&wA6AAds<)Jz5L0~=>8OhI`MsV
z1gNz8;~Ir)O_qEY6>-9dT3iC>h-svZ)`Wnju2`ScstV%yQA{NQ|S}$aHzq|M2~)L82RFzEv*1fh8PRh
z&IrZmbE#v_T~~;{$}tQ~7dYmN2N{MgC97}?DFOmCtV{`s%qcoz5``P#dga@hw*|Xv
zEooPa!)=e%Liq1_Jj!p}n9EJi&CP%off31w#WC>_#RIjm;%s6-Ha>)1>{A`1gjarQ
z8d_?)h#)I*B7jsFRU~K|F>r~ch^-e$;JS;b#XQ6ypdb~3EDlgk4Az8DBsk-`+!6t@
z-3;JP8+ciGW5J*x)J{x}1OYc+4A>PRa3vi2RtTU{ry9q8l_h2z%jBH;cP7D_A_4Ea
zfkR$~-uXKyhTYyp{>A%8%U8TNhcVbY7}gOR48I5#_TnN!e?pJJVlY_DZ5A-0$uT@R
zf}l&kiF0CVp7mk`ceN;c=Q1s)7?pNLMMQMM#H!r=F-%O)#V;s;-Sth6LU5N`g+geL
z%!WeyJr)}ZgN_VeL1EfSP>;f@v$OWzzO$BRzU1Id1POz1ajHChYmlUj+yc^6o!(86
zF^Lc_UA6ArG&!?K2{Kgg-px?3h>|E%jqcqnC97yjvefL}%~7%ONS3Wu_imn=omYwq
zYIpzF0vZlJsVb_Y?v1`+SM2TkEU#;8k9{o1|D%c-j{Rd!-__jci;F{c
z@TWf*mjo^g0ty!Sd}jXWZtINWJpdQQyLl)jTPQeysZl*3L<0tiLc<6EwG7OJ^;#rd
ztLc7!i4(p=n5m|s`6_=FI4kSp`ro>R@gm8kDB0zBnjfYxNr)SJ#dD7Pm6A6~lZL;W
zEq9~eS*$l%bH8oz(1H#%%r!thN9j7e$ICE?icieRkMjB!);0H(X{ZpZ5vP2x_zRpW_J$LgB
zbn*%<#U2#zQ~>;|d3)L3F5>`qtQ`2*I>SOhL-hY1kI{tskKVulSW5^}*M_{2)!Pg|
z;C(N$ITY2nLJtu{d;5Gi9FhW=R*s{G5*HT9$|$p}vdb;6e0NaXadG>GpEyED2WLKF
zfbc?`D;O~hjBQ*1G>(s1ng^+z!7A5$1X>-5S+vZ8;R&<`8Whcj?3WKeV*^7x5+ETG
zA$4#hK~jho!6`!n1^MPj&oz_fZ2|@K*{TF&Z+}b5HT)3*9ZeAwfFc1i0097SaaJjh
zIY6}Ng*iI-4$Mb^S)sQ8=y<#lkRkvIFn|^U0<@5o1XyH65)$!A*3bV=Y}R?Rey(2^
zw9?^pkdCL*>3({Nnxp;}`FOiH1Tm`^DHep0#qxw^+DrQ@>>;QqkAIaFC&B+m{}T_=
z!Ob_o&2u-SZYJO4e|o+l|9<1%F+hNMz_oKgo&^B%M7Fx=Yt3X@rbfWq-aI
zfVbqNygS$X>38qrep9Xys+!s}ce9LzviM7$`F4s$!4qK`rKkU>Jn|Ip;ZtDqjM=xe
zQF-DOwfsLwIuuJ=IPW2c3!4lGOnrlZG~F~Pv=ZN#u<_F{8@!9@a*B5d9%J#%=itq|
z^7IuC-+rb}-`ri<-L(4_RR!1P6|9wR&-Lf*>-n|
zA@2}h3Je|&Yx@P>V4$h6mRG{@RlsSFr@iw&B58w#dGlITm-k}w*xF7z-=*+VzZSFe
zg%nlfF5lnwy4sZ3_&TIlF29MvqL1SAAt3IOMY=U}VF!GU2GmN-GknUMfCn;~Z>(AP
z6mI7;K4j+b5|{sMl9#nPbDBoDX+o|lz~J}cw7=}_&O&cK*pY&?xaF=0Ye~~Gk!fYC
zIEg*ClAdvDp=~f`c@qB4lx~eNc>?h5u`*9g{h`z|SHU~;@v=9gVpOeN@nXl?h6=nP
zWXgPUt9BdIJ`z*#D8!`=RfyXC7^QzUDau54=Gjat&l;5?vwAf=eHW@NC-H21Yh^!-
zda~|yc=~n}bKa}XWgDneFWwu~bqtdAR6QnUP_3`!F~p;gl?h{$RqtFk_A^^PR+QRDaDV7Z>jtwgwOBA2=m4J;X
z;hH&^%?t3-r|-gRUyFQIj_^=D@6*_6_-((?INk8~X?lPyVow{4!T?eb7z2TE5SRdg
zNf4LUd_s_vT%X{{0
zIB~A!QqETO;ry~JxIbF3T!)Ww+eHUP7&!7&g(mGUC|=WAy1=_^DUB
zqgw~#ZXNqZbSR+8gkZ{MiKk>;v{FMxuNifeX=NDZ6>BfC?2MHfv9jW+Y~o|tXtTWM
zjDR!LHq@}sq@HcfrC}GI0cmGBmJN`>#?(kNAZUr2$#Hs&xODB?z*HvbB2w1v?Kd8{
z1UzE~9wE=Uu0u8^M7Qo}9uKWL^DYsi!-Tv4G0)y=9>20v#`zX$J(nyk*Ih>ow7fpG
z(#wC@gJS9>8EF_#6b4SZFChScyeK;D@LZi!CLHD-BQVegfPU
zl4>l~OpsP%na2VltHyH81bH>9pbxxCkvpukl%TA{Dj^6!Rf*M>64aGsBTnE^o1Cy#
zGeKKTcEAB$HP&k;=&NlV>?&Smo*Ys!97DqhoYwe`qXRBuvg?q~rU9z60NH#sUMqw}
z!)sVJyq1083OI+gK4+T%*)~9Pw=`bZH(WS0TsSsdIO$;L0NEu#^NPj?w}uDzh6j&^
z2TvXB6(D;DIO0S8s&>6mHGa8_RJHf@vw#2RHTVmC4+8Et0stNc0Nn-fKSmiC{||&Q
zVBf-p|Dqt(`^#Yj11%^@h9o>Ra>(nEcA2ZM%1bcnE|Ui&M)1)x6ixPCbGn5AxKT`Lc6hZ~a^zbKmT-hR+W)
zxCxH!lL!C67#@cw(@@S{58Cy(UDy1gyDOOo%6)t)HM>vMku9W;qexK&8%o(9_E{#
z(gDl*y?*b$cZ>V*CMBdIB&ch=d^+Y2tzE;e_lR*cTgZO-68?J*|Hl6pJ%@s=sZ+f}
z$VZrZ&?3|TIhq=vCv;JrWmPw+hEXlKgu&5EE7wx#s{{sal+WabMS!cR^cx${&^jHs
z<|C;BY)O=ngEzxtXrLeLC52tc5kPx?)S{%i2(sgFJ{qN`-i>f01eoM+_MLUPbjDgn
zevCL%iInw&@@-J-#I;e_>W@oQWTaAb*f$|&ecU*1Yl5MZZc>&KlbGMJ)Gx|mC`fU!
zcUN4hp`cERsgmZ^P?u#9E&?srn3=A>Ak6g}aN{PgW^zM!VW}fl;Hon2MlY3k$c0;N
z8*a^SIpHvl|6s>!Ttani>(x1aKe=Hn7c!ZBW2D8o*JpVv@J1zP;fl-TGpJW!+-)XFK)WGWu)?P^b62Z&xc+1@0&Ci@kt%IqEQWF8@46T*;aWDw+6nUV^2o
zHP~weV7;AXr>RFQ55*wY5YAS%V}qlHIZ`y6UZ7XmUt@Q44G}8Q-O(j_B
zMo%eS-VJVZE2yT|?t{%HH<-_0UsO*`zZo97XU39)m4}hJX!K13h)9O}0YmiP|7qJK
zPZlL%?Q3c)uC(y2Ft0Ai>C@=6Gin`<1K#)f4o8m%?zGFsYQ%q+FC6TD#0VWRu6
zsyO1PyoAIVogmUoPciUX6Bn%gW;KbQ-+@@EyjVjM>TtjLQSYY5@CuT=C(5<>f<)b7
zPu*u(M;vJeI$Iv6lP$S|;P|R4z|ev_p?+EmRgZP|wJ-Iz51w1wsPF?|LcQF?3s37u
zX^>JfE?HJjvdBcyWSA^uNTc{#OFY}$QunLoH3|xT4T3C5Ya$UY9&~mL%gOj)y?*}K
zHzE7MUNHSJauC4OP*uDgJGYU$n7QJ9T2?A`>9BlSljh8sLpMM&V$AfL{()7d>mE`x
zwB!y&O)xl(KZ<>QbO)2ngfA?9;>|$GIRZi{U${%UvGbFoQ~(5I2J={Mk_0{jp8N%gGE1sQ
z^7YZEn%^+fr6QA;=$8V598DXOYo9SSV1@7+>>Hb~hkOjxb7VTt0bf{S0v*2ty4WMH
zhO@^$1d?tp8mncx{z66_wX1&PNBd=QMM0G(%RHm?vXq9iYpgkSdwjmZZ9TJZyioSR
zWg(K5VN2*yFPtE`w3`!vz}sLG!Ywa(_&$3yvKC}y!E_EBKfHww9ap;8Zlemgg$LOe
z1c{DCc$!Xe=e8NVGpA2wW1Z&3+}AvJ>_Zs0-}=o)t{HXgq57n!U2Om3<9T+Ycb)lR
z<-ajfM~=>sf-h+_i)6{2g=P!@r}V9UIl%}l5TY8PM(nbz1{F+&uKY?GPxSh?-8n@IV<
zU^0pMQ911w1-l}-nr(1eI+Vho33sT_KzHMA|!A(V9$c2IzOR?PYu7TBJ-CCcu
zdJSL8zVOdiR3Im2M@jBXxO|x;Feod66`OdOZF!sXKe0Egm9>2g7`5ZePtLdVOLh%)
zo)}HpN?w-}v}^V-X*~qDC*MeRlfaKB-Q2pwt%%k|gBH{d`v4Yva@&$8-MKKHH-*c@
zwiq6ZQL01+9#?P4%s^!uCFF&-Vi#Q*j
zxpk=|Yq9wMB9AFu!9|s<#^S;nysel%Qjwdps(*H4C&}e8hc6%IAEZH9bx$#EFq4C{
zmrN8hEYWrH&lsJw7H*aw@n^S}zL%`$aBt18H+bRytSuGac%6FF>*+7f99*&9UMbWW-5>w?b(0X}bA%>}C6Hgq
zP%G^MRmUG*;nb`Rd0u#1?PyvtHP*P=L6#Ni9{=Dc$!yClntdG|`hCmHCieU&3tmb6
z`9m~a#VRlS=h2GqOL7lnXK$hor@ZlX0Uh#YFup5(5nqwp-JKdvkdj`F))XXL!ZS$N
z`<~o#_@!9irdZdmxZ#w8IW#vfx^&`~b-ygb150u>3ChGStI#zwgwPUT%gXy)#nIX2
z7R}zycFo@9R;P2hS+lnztl7W9=5Rs&H5223RjwCva$h7Z6I^%&e;OTfRz3-Uv%#d%j#pYc#FKrn&9ciU+s~Bx<>zWMhvnBPsJq}a5U1o{yZtYw
zW!8uNiXYMylFC&KdU2n$4X-{cO
zm>Dyp(SZ@^5^3*fv^rG1vbugvb!RnB8MzS&?xF9aH+&eHl?B(wjm9+~QPKY$h1Dkg
z?^yFu+fiHTcTvceVNW()0G(NE6YUjujnlX?^CH{OWNPS<3>zjN^t1SLhP@&9;+-Msb$<`xyWK;)zOXy?@=ew%Cj~!
zgw_qX5eAW2+yOiM`-z|Ar0<^#7lig3&&$UV%@fNljG=0!#L82xGtX5em+&A@!T*$X
zO|6m|ftqdpNBRbOIfQ@^qO0fSD5<(W5Kz^~kj!6p0(@8N!1xjycep_Xu$RVz36v_m
zjjM98f3#CzI$9XNxsd#Jd(NDs*$R>AHBHmQX2x)}T4EMTvz*aOm*OT5U_|oz`Ua7|
zqV}v+|KbKKf2dKZ6bJbHFeE0oxfQZ1uKYz_Z4RJ%uGMkh%T(FY{!?jd#L`%|uGycR
zy+w(o_8)R6swxCe=I`D2D>N`ZVquTe0gC3Zg}z;}?jL01v`b;?p0_=3*8nvdrNd$<
z+pxG${u<4<@VEDX1h$7zWo-3Vmp#1v4V2iYD=BU@^2Ax-;{y-t0&{y(`TN!^`E}-;7d&CW8^E(aGMsL
z;tp0Nugsat$h^BG7LS2N5s*VS;Av~n;XKcK4z2j=o7bCaTnJWFRx^~0Cr@>BmMhYs
z-2~!%koVIEbk#y*LL)z{Z{8v7fG(RbV&V_mJ)ndBhurW2;=9ZK8SIM7SUvTwBFEZ2
z5V@VHE{`qjpTMvnC<+clkQ%9ImTaV%(bk(d7lf3kN(+7^&V
zE1Mqxn?&6bxbeRO%e{#1G*@>HLja`dDV|hgQi~1{(CbSP_M*1ta%pxMg^fZj_(5hn
z^m0R=+1Y1ME|fFP>~}E*rb>}DTc_m{=yFF{IlJbm2}6?N3CKSq+RWT^oaOrEuDV`x
zeP96Ysrj(+!^XM~y&vN6`Iqv;OK&c}*>pMkz#qZ3mqRZ%AsKPSRiT!KWEjA^q5KCK
zh1YF(Z{2%d=fK8=#Sv>(k
zf{eg&^GOf5D25+j3^??_^}&-N#GG!!02(eyN5EG`rWF$o(}T
zy7a_JNLqxKXyjaJouVr5dc29=qA5Zmw=L*{`tCWRfl!^dp`*%EANF}0ul4=P4IBLa
z4H~+FG21#n(9orO#(blF(ec%i*nTyaRQl#$ql45Ick&%i#AP(my+KbEWz~`P=&@t%
zGvRR5Xu)V$su3@lm=G_ONhM1s#_^vwQc%8Yw@0wE1}FV+2_JdHO=DQtqVjOZvPguI
z43277tq(7ydAaOsOu`N9OUwNXvAOt2C4~x6MQX!od4kodso+*OvX!EGvZpRqi6lq>
zwNS3$$e77$G+Qa+(JrxY(gNgfHbYC(uTQnk!>+@{^0!|Ckr%eTxbVE`0`s6P;SB=M
z(b(>n^BbCYDv_7C&NlyUCP_6$tyU)EA+C*T%q?vVm#s90R|W8bwH1Qy)>GTtgoirZ
z2JkE46Q0JpZb3xk^cM|?oci$~Sxes$*CuY1hj;H%{pqt7{2;;W<$qEJxfPCPxb}3N{+9
zH3HHXh8I^@O#pbeu$WPVumTC?3OhCas764+-snFcp>k~+jZ^SWB^z_Nq-+d_UXzPz
zFGh%p^C#tl)1V@-Q^=_WYp<0rNtfld|J0J$q-t2pUl9+&GOqg^BMKnujg|YGioEqH6-QS_k
z-DbTeBGzBgvYko*uq)V@gG*&4QifR|5SX}30f6>Rk_!+i6&LoJa`P7>OQlnVMf7Lo
zE`IT388h`LFA$$l1gL^lhld2*5V1f>r^nhOVtBgn6S7
zzRL~Yy-`eD6v4q)3>h-uk>SKmgS|yXeZ?I1VLu9a;|+d
z4!`p>qg;qN9)-PYPS({7nJjtpvx6-5-Vprn$p;!>FPnaQ5iIyZp@Omw7_{6mN=a3^
z&jOiRm$}tIa)*;rTr4DG2U#bh5z2mX<`ZTeL=r&29Wnp5Yl1+jVv^pABvx`!1P{$r
z0sP-uHxwrlJzV&`pK?7FH~yIMM>>8T9m5f-sKl$C2~N$!SH3`Z0-oT9C*;GjGjUKl
zJTh#^NKD&kyl2E_{lj_@^PD9N4ii|tdFxPNP
z0yjLJFdP)#2wwUEI@GtQ5B%s5J}r}e=p*o@4usFWMNtulJ)Ri8j*8iBtwn8WHNtq&
zro?yOp{ip97Kk4#{WS~=6!xLFH#X?{!U2|ktE^hxM?V%0tFR6~XC)qdHZryr!wuo4
zSVLo@(RXOOt%=BV!xx6)mA%abO9}?==G3pgA$97{d?`t6%Q^Fvz$e@NGwnByhjma{`ScQsisG|oJ>Md);fJ_!Q3I$?~^!gX8pyg4U
zx6!tE+B7kcU^cn|RX}1A@k>T;Og12E96GhH+L$zDn*IeWLurwk0uo0~rxx{meD1cD
z!i0q7-;Wy&dYm+yX)*(u88QL4Mrz!nF6Oa
z+cr;vlUr~i4Ach|NAC9ZDszy{LDD$7y0ov6|EP+Il4dSl`~EJ{z|M_6l_
zubRa4l0Of8QZSf;OBiC*ItwRfgrkeID_(D-x}Cy{P2X9^F%Ty3=AR#4|8wb1cNGM=
zt2DsjSilQ<8Wkj)Td6|I9NIM*u6%>$37Qvm{|FXPCZ=a!YVn+EtXj&MxjCK;!;`b;ZTEe}w5
zHlA4JQIe2UJzZJju;CT+b6MqTst`jgCK~NDC7BC~Bs6_#>02)<&Cx+iilmciN%`@$
zgiu?hZ$)z__R1QOqSfH^sTt%?r5OZr2Qp7YkXjIcgkLts**}3+G=f&2mP3gDc|0Wp
znMW0%ECm`FN2O=Zb@)3@OBl|~yyCY%BL9naWjY=|9y3|S+-}R*n9<=FH(HU*bS}SJNV0256#uHHT}pYk
zS}pJDQUI!m0vc{mcSNb;f9Pg2s|5mPjhj=!b8(>I0jhSfdBI2JZ)-ah!sfgdewJat
zHby8eCuScgD)gTn(qSkX1|xe4eKnps}m$_FbR`205%9Cz9O!1koD|Juclr8^EB-|11T@7C#fHX=ns4V()eNm^Xl
zWc7`mI+wb$34~-?F0Mh9xE2=COL0%g(zJOf^J2<;(p)`~d7gUg_|g@RnS7p-X@8nz-5=9K?XDE}~-IM=cl5QrD@^FH_$
zio1LKDfy9hQCjy~gSc>M_DymL>DMGl*B66?LA0=FN4hEnBad{bi;oP`>+#W3J6+8kj
zufNlDQ2y)o=c(VmKfsOvn2=~Ipe%(RS&Z&m0{HS3kX;o>PI9wTx%|$xhh6dB^_D8}@e&+ke>{{&!C08tQPGHSjHK;7iuPWi&kcHx}4IjU+Io%04SPg&_Fkwad7Io5f)!@ZzE?o2Av}bJ$>|FXJdI#)6Z~#Xz>lpADj-7%+d3d?PTpofR-71~SY-UY
z^`3I3mE-i5TIQJ?Ab;zqhL#WHsJ#x5XxZxidnD|U$z%B5?e?z#%Sl4{b5(2>qMW%R
zQb}>)PYk-IoE>=?GbgcJIgbRw&r?N0>hI6)4^MEOLHZde`Fkal=e{^+^_P~DvCa%v
zzsP#L+_dDKJd_fJR}$9nnQwIWtF>rT&m)~5)$RCXzpxJ@%`?^0958NGyqxQal~rYt
z431o?UU$UjlM3{wi{fgZ%8qH}n(mRYF7ko|ZH9f|h~`&IqrmcYdtiUM?e
z#9Cygid@QqTp%H>Q)nI~=>n-UL!
zhA(i#gS_=HV~x1TY(hW{Sn_v^a2^SCQ3Dp42~lfC=7Yoz
z-tt!s1fyX@YK)9t5r|fc(xBj&hoSDB=NR-Ejioe2D?=Yzi!`)YUbZoAt_g>_I0j&_
zb)6$u6PXD!z=D4WeQVt~UQAX_-N;>ytiT%JS={P_p{QdyU?(`#cBjt
zt4NurP{r{4zb}|yi&PVy6J2YldWB$Cbux{4)P$KuVgn1#E^_|Wk&b0KF5_GdWxthH
zOxNE&rGI}^6F9^aVjJSF#vtux4k@8&pOG{{(ZP)cio2+p1!{Eg4Qn5x
z&K3p_=B-Zv7|?=GX0Uk@946ER6z5i4>LSb>GMMly>LRQHG#?ymssh^3o{v5Qb@YL=
zYFcmw3#8khI@LKz!sF;TpS)!c^Jl)6g)S}-K9W|~d2*UdFe~;l-D`9xb)@ABt5
zS%;QIpl$`>TB~yGHc!4Up`Bw|r8y`K=SIR^Z((nD)&9(dtQSd8HdhI>JiZ~dyCF3P
z{hTuDV6CI?rw&2S*fN2k>FOA|rUCs<_u%_Mxu{E!MssMK=<24bX6<>m)WQNan#xjb
zBq#{L6yT9k!Cu&=qwPj=`L*tQacj;Xm8wD4HdUEtY2q<=d%JhmP8y?O%sOlrIZIOz
zJtqg5$*IDQ0p}4I?uhn#L{UrY)$B^i2GkRtC=9yoH+I$H&Q|I$2!tP&jQPApT4gBXNA}pB4KN?V
zL3DA<0c;eT+BZP|0%LUCN?nnAS;U?-m1NDzc|R&NL5UUuGecLjcnzO<0Yp>(*5YjL
zToC{#V8Cd?WYCQx>kkeHhBCQKIg?$ol8Ic~tI&rhC>&x1L1q&g0^*WO6wc;Xg2yW@
zqbm8dB|D-CT2sWF3u~m=qa=1vNGi{)W;?vTrOdWBFvKSD{AVz
z{T+Uvw;Ioh(`7e(lmeD?OqoLsYEmXd@$7gc8NrG>Cl2?veH97`@t_*3qECK4+~nr)
z$?HwZ?JU2Ihf>Is&TA$g3uHtnu-1aR6ko+fJ!Db
zgeL%rfy|?($;-x;#e!F?`lLBTSGS!T#9g2O?!fx-u-n#UmRK=f)tVtE2RW|!MMAah
zs)Dd3H9-@xCchE?p*80gR;yxTSXN`<^_=_%44I!1<6`J%%o9G+@J4+ryISd0$E$3M
zIhqA#R{T?-K}$UjTy%1^j3-30E_lqM9zbfw5@FCZ7`&<#MD?@|T0UKuN08iq5W3W7
zS|S;vqU%m0MYvgysu_<*G7zSQIzTAg%bo&_m5ZI2iTETLafO0>b_MvL5<8sn(vrZ>
zF5Q*W{KUOWZNNywapb;9B31Az`-H!KS}o3arl||#is6(CG~lRz`P`1FX3{@WD(JbmMY)7}0_$lZL7b@YoC{coSoJ-3Eg
z&|>cKc4NyB!}W9qi1{O(qoFKZUs8f|^I*T4FuEZ0wHLnHVd@s;B<2Q-f>aQ2k?yb;
z3n>|~0Yv*xqKWHUPUf1s09Fl_K9FM)vxruw=a8%FOfRFsQWY3*i1Z%7GYIj5osRFTxW*cM6(v7n@!Vf
zZZ_A=(#$&%ab@v|=chLLS(s5Z(-T_(!zz%Gi>Xc0px0E?wL>{&*wTx}c@9j+d}u0Y
zLu(flPO}&XdtLT~wN1}
zVJD`%$=5_5+VbAyTf24e1e)^n!)QPYeaftoNA`MSopLS)Xie_{3=1}q*-?c3^h(Lt
zYZUe4hrI9OLO7jXwV;4uADAgqIpW#nj|76?GLiwk7oV4G5WB|dXz1!O>J?q2=eUU;~
zGWJTJZ8|tlwf)>G`a4p8+L`BAaI$L!Q0%cjo3Z;FJJ2KsWvzPJS3cJ;)*98&4)nsb
z60fiPs{r0yRWt`>F8+f!rw==~!F}hYwZcdr9Tx4Mtkn1><^QuYlrHM`8Y;MZ4bNTxnCP11{
zGamnm7rr<%K9(UY9yoUQZ7>GAuJ4+9O=ooyuXX{YrIm;U_Y8#b&}?fubYVK-ze1e6
zs=FxZH)qeRkq$Vv=@vdgAChfz)qg)r&Fs^r+16h{9|Zza+!tjNt+mpn7x9Z=WpNy|
zgW5s|jH0sCBlf(IyDR;y`1VpY0Eum-o&|o1ol)Se-et|XAjh0_DH#0)J0x)@8=$t@
zRNR)N@td3q!MK8D01f2B9^1hv&GuV><1lFHF^nv7(%>)@QdYK=y7tSNcp_l}H3JOq
z0K}%Rn#7xrWNGGxNP
zxNP#`pi9T4p5u>%=UEC<>|m4rl>E$>-tQ_>7J;mORYjWz4KmDn35*(bv>2Ut)alrj
zgkj<_dLUM6%}f%hC`-2n^-s=aGP12dm3d4I;h`w#&4Xp(^5b}y&elXV+<9|}!LYuM
zk~N?PyMpb;mtoV=&g*X3e37fV(9Di^PI0+Hm@E4Xh(8dxVo93d56yI(CP!Ah+;zo=
zkf%T>lJLN;=)xgn#wlak2xDGPfF@Y!PzuY!DtA-
ztebEg8(q8|4G{xinabkf_;!s1@y#+8!8`~e?|9=j_N7wHrl(J$BO%6zQ
zrsSiC0#~31N?kb*5|EM9`RC_~{Chl1d5Dcm>7h=V&<%FP+S-Itg>4J09BXMMZ&uKk
z2b`fz&~RAWq;`OpFTrNop8H@fEBn$rotQkuz?xV8^_K?krbJ76unx`7TIo7pnIKK(
zl#}1xFuEZBiC+Ru)BYaPbwSwk>HqI%vF{E5;rLda(?k;%Nd{FIrX5^oB*N;EZ5^s`
z1^)vCg0y6^91j;?VH*u?miXo2^o=TnCUKAQpY)j|j{*gP&^Z=LQVgjJN7QPNgB|}k
zz&Bdz?r)ER&r2?Qj+Lg+tDPJB}Ng=R$1FGzpE`
zGHZ6|9T>pqy`2T=<~k!CWYw
zU^AbqEOK&F^00EqsEX?}C0H;1{crwAOAR7`P;6xILbt=*`nteF;*t*T{qgnlx2ohfQJ!Z6xOLJT6;c^{3g%VDjgr)FB(G9{5%<&TLiw1pd@+uWXrR^0u80hE{R=}eVLS5g!w
zfxGfh>Di`9)iVL_W$0&1^9xv}0L)Zph8}QOOY`Roq*d^=f27yf>eWr5$`))yEozyH
zwFnY3ZGp2)6>_)b+kyYz02G(5&cA>cVF1swAKc;y-;dW%GP47ju+~{d0|cmP*0Y1&
z?8RIDR|5oOR$L0LFt8-mj0Su%HU|j-0>ubu2nWDt;BpcoH|HcwY~4wO1ba>**?l^R
zqEFUIG;64Hi3MU%Ntu!eU6${qNFi$|PnY?u3Uts>Pn`vzG-u^+?aT3;h9`(-)vy9Z
z^VQNpFJ;BY>BRF
zhdK-J>c8?hsVZuyk_u8K#9#^!{1i@Qb<>R%tIkX{1AyWQzvaI(WfnjYoK89}-&zIMnIMcyp>Qv`6*=LQ(;`HQ
z677t$&NuphE3xYTp-!`C~UV>9FBUBvvCWMw78ygu*kEtDu!!8M1<|w6ZV+gf`nm8myI8
z*=N6_w%BT$?T%!|5PLCk8){kz5hF#85;YpJ_ddAI%En@{JWE2ya^Q?G%xI$wmg9x&
zFk;4v9jEfR@#0sJAYr1!Ns<~HS@IMqQ>6|_?6)2m;O!
zI7T24C_>;M;2D8qOiPX~=T8Gng|&%E=d$5{kr4k;0tlIU9qlw!_>oEv#wkw9l!rJy
z{-=B5ypPG?z0WbLfn}58-u@hhZRy5IklVbKt(V_WI7wKFLNR^j>&P(s}Nl
zTv)dk*4F<8gA$gDe5SJIvtU2MfqYQ|NqNg_
zG((qod<`)fH+&5zPP=DV?6^x&)}GMf_ssya`vYwHiB_kA0Y>Ef+S8t@&WD-@-2?AV
zycS;;vQI7YRSeylZnm53$~a~7a3jULKf+3$3%|+zCgU6U>C?-@zro-bRC~l^tqAqS
zm`b0FMr%)1MibY%-&jByTW~FIDKz9Ww$8@sm`azz9g?QKRb3CY58y+^oqR=I778Q(
XaQ@nFa^oksTKt(FxW!c33jhEB@qd@P

literal 0
HcmV?d00001

diff --git a/manual/manual/htmlman/libgraph.gif b/manual/manual/htmlman/libgraph.gif
new file mode 100644
index 0000000000000000000000000000000000000000..b385985b13d8f91851761f15db95b0e26f47f204
GIT binary patch
literal 2149
zcmV-r2%7gtNk%v~VIcxm0e}Di00030|Nkri0000X0#*S40{)DTsmtvTqnxzbi?iOm
z`wxcVNS5Y_rs~SJ?hD8AOxN~}=lag~{tpZahs2`sh)gP%%%<}RjY_A~s`ZM^YPa03
z_X`e-$K-YS={|^`_I7nD%c!-#&xX9S(_y`#(IZ0V*
zd5M{+xyjk-`3V{-I!anXw&W@eT
z|2*wpzJY?&{Zls2Tf%L=ru!#VFFHRpK#y+EgjjsY)hNz1qYo
z)~!e+a{Zc9E7-9;ERsFT!z|jhI&`vqJHsv9xv}Wlje9rm3%PpxhT!WrFbBYb3tu2?
zII#r8iW@gz>^O2n$smRDx@Q?0<&T+T36!dNb6$g;(}^DEm7Pbm0Xw5}8W37(fTx$S
zhTR%mMZmB3nVb!|HY$V=S5vE}8iH<(zZnM?ZYs6B$Le+yCf-daaOlj$uFL+}dIVt2
z&pGFw3wcE52pL-Nj&1s4^tg7bPHjIoZu36=ji0A)%We7Pci(IjQCA#f&jBctWu&=f
zU4#-&NMVH*UWj3a8g9s8haP&km4wMTAdZ2wjRqHM*{xT>f+40TT?sB?HREYDQg!2I
zIYPCgWIZzVqhmoLHKbxi5_P0uNdmQ`U`_J$q+e0uG^Jiu+H~bzS<F~pL6&w@A^+jy)Eg8GCaV;IQ^zkeqt2FW}C8Kn*Dk+n+@^Baj%x}x5
z$jlkc`O;hp&Kv1G3eOk$9176g+U%~-pBNo3(R3o+3De~&t)|nPNS!X!XHuOB*6kj=
zu-2D&O|R8tg5Au^Tq8_2C212Zc9?5#W46K$zgfQ>
z=d91_E4J?K>!jFj;BS8oYPY3oO>~S|gif2_eFxfetgJrR-m@9OUrXtT=FC1lr`AA-
z8H=U%?t6jj9Y<@b32&BAV;2tX
z(C<|CcmQlh2ZQ~AqJ93m6a1n_J^JMjJ|jw>{RJz4VR57ftIz0b6&MWFtq@Zk5DLMBo?u`J#biN=U2t<{K;R1aVyqYDq=tFg
zPgm;2!=`brHc`w&{uQS-MH>x*K%!&ft5n1$FIo|dxgug9xOj&vY65g<45JwzLPk2M
zF>70l;~eJLkvb--jFg#{Y(50YKnik@B6^jLvIoR77KDoEOXNcqc}V=t2a=Cu&Jbq4giYz4+Nm;PqDbj@Ibf+|h={P-_Qj`LfrxOinLxcLzmByi^a8oKAm|8cdz5%Ly
zE9p;rid2y5^r%EFnpJ12(wb(}s71{xNu}xrs+Q!dHYKZ2xr)`U;xw*sE$dM0`qr@e
z6s%rFYa7%mIJS;;t9Hd}QpL(rj3ySbk`wG=-8$F8>eZ|!g{)TP+E2f-0kDmDDP=dR
z*)=rIi0%xn8b-@mM}C&Chuv#i37gm0W-Eq&wAOKMTcFf3Y_+c~ilidQ4+lPQfsS3O
z@3j8oo)RVRcEx>a_s%CL_>mTI&7EqWNNW`GDYt<9Gi@47w?_jGk6Fu+UX~tf^KV&XDAA>uexbnZyQ(QS<
zz;i%YB99^o>amG~^;;WCOC-Ouk8g!PIwNC<0^wW%t@dinT4xl-NaWpEL^ja*-S$cW`RKLRe+BXjx^r&L&Xaq;7MJkRokKksZTr*0g3y0RR9y>lH4J

literal 0
HcmV?d00001

diff --git a/manual/manual/htmlman/next_motif.gif b/manual/manual/htmlman/next_motif.gif
new file mode 100644
index 0000000000000000000000000000000000000000..3f84bacfb26ea6a4141ad407ff4fb77954171fea
GIT binary patch
literal 317
zcmZ?wbhEHb6krfw_{abP1q~Da{|AwZ|CALJJaY^3i%L>c6w-?Fa}^>2d=)Zt6Vp?z
z6!KClO7toUav2nVvM@3*Ff-_YG=q$BV0wPX%oqrcNic)NoH!IY7zB6@8}Kj-us9lk
z7$CL+2ZMnG4_ouW1Z2ulL4bpWfr*g;NHKx6GcYhUIw%M*FhEp-DFfUZHARYuTK(sM{cnnYuPzb0WB7s6C9B5!<=3-#51_0IeJqZ8+

literal 0
HcmV?d00001

diff --git a/manual/manual/htmlman/previous_motif.gif b/manual/manual/htmlman/previous_motif.gif
new file mode 100644
index 0000000000000000000000000000000000000000..8c8a3e6430050e67e2e71dbd1f99fb9caf6176bf
GIT binary patch
literal 317
zcmZ?wbhEHb6krfw_{abP1q~Da{|AwZ|CALJJaY^3i%L>c6w-?Fa}^>2d=)Zt6Vp?z
z6bgz`%k(M=av2nVvM@3*Ff-_YG=q$BV0wPX%oqrcNhmWYviw
rA^>J9009F?7$^Z^BLGMh0|ST;RSz`=t{-8nfkDE721aHs1_o;Y3u!(;

literal 0
HcmV?d00001

diff --git a/manual/manual/index.tex b/manual/manual/index.tex
new file mode 100644
index 00000000..aff78b9f
--- /dev/null
+++ b/manual/manual/index.tex
@@ -0,0 +1,20 @@
+\ifouthtml
+\begin{rawhtml}
+
+\end{rawhtml}
+\else
+\chapter*{Index to the library}
+\markright{Index to the library}
+\addcontentsline{toc}{chapter}{Index to the library}
+\myprintindex{\jobname.ind}
+\fi
+\chapter*{Index of keywords}
+\markright{Index of keywords}
+\addcontentsline{toc}{chapter}{Index of keywords}
+\myprintindex{\jobname.kwd.ind}
diff --git a/manual/manual/infoman/.gitignore b/manual/manual/infoman/.gitignore
new file mode 100644
index 00000000..916af019
--- /dev/null
+++ b/manual/manual/infoman/.gitignore
@@ -0,0 +1,5 @@
+*.haux
+*.hind
+*.info*.gz
+*.info.body*
+ocaml.hocaml.kwd
diff --git a/manual/manual/library/.gitignore b/manual/manual/library/.gitignore
new file mode 100644
index 00000000..40a8907a
--- /dev/null
+++ b/manual/manual/library/.gitignore
@@ -0,0 +1,7 @@
+*.tex
+*.htex
+arithstatus.mli
+ocamldoc.out
+ocamldoc.sty
+compiler_libs.txt
+
diff --git a/manual/manual/library/Makefile b/manual/manual/library/Makefile
new file mode 100644
index 00000000..a757ef53
--- /dev/null
+++ b/manual/manual/library/Makefile
@@ -0,0 +1,78 @@
+SRC = ../../..
+
+CSLDIR = $(SRC)
+
+LD_PATH := "$(SRC)/otherlibs/unix/:$(SRC)/otherlibs/str/"
+SET_LD_PATH = CAML_LD_LIBRARY_PATH=$(LD_PATH)
+
+
+OCAMLDOC = $(if $(wildcard $(CSLDIR)/ocamldoc/ocamldoc.opt),\
+  $(CSLDIR)/ocamldoc/ocamldoc.opt,\
+  $(SET_LD_PATH) $(CSLDIR)/runtime/ocamlrun $(CSLDIR)/ocamldoc/ocamldoc) \
+   -hide Stdlib -lib Stdlib -nostdlib \
+   -pp "$(AWK) -v ocamldoc=true -f $(SRC)/stdlib/expand_module_aliases.awk"
+
+
+#Import mli file lists
+include $(SRC)/ocamldoc/Makefile.docfiles
+
+
+TEXQUOTE = $(SRC)/runtime/ocamlrun ../../tools/texquote2
+
+CORE_INTF = Stdlib.tex
+
+STDLIB_INTF = $(STDLIB_MODs:%=%.tex)
+
+COMPILER_LIBS_PLUGIN_HOOKS = Pparse.tex Typemod.tex
+
+COMPILER_LIBS_INTF = Asthelper.tex Astmapper.tex Asttypes.tex \
+  Lexer.tex Location.tex Longident.tex Parse.tex Pprintast.tex Printast.tex \
+  $(COMPILER_LIBS_PLUGIN_HOOKS)
+
+OTHERLIB_INTF = Unix.tex UnixLabels.tex Str.tex \
+  Thread.tex Mutex.tex Condition.tex Event.tex ThreadUnix.tex \
+  Dynlink.tex Bigarray.tex
+
+INTF = $(CORE_INTF) $(STDLIB_INTF) $(COMPILER_LIBS_INTF) $(OTHERLIB_INTF)
+
+BLURB = core.tex builtin.tex stdlib-blurb.tex compilerlibs.tex \
+  libunix.tex libstr.tex libnum.tex libgraph.tex \
+  libthreads.tex libdynlink.tex libbigarray.tex
+
+FILES = $(BLURB) $(INTF)
+
+
+etex-files: $(BLURB)
+all: libs
+
+libs: $(FILES)
+
+
+# ocamldoc.out is used as witness for the generation of the stdlib tex files to
+# avoid issues with parallel make invocations.
+$(INTF): ocamldoc.out
+ocamldoc.out: $(DOC_ALL)
+	$(OCAMLDOC) -latex \
+	  $(DOC_ALL_INCLUDES) \
+	  $(DOC_ALL_MLIS) \
+          $(DOC_ALL_TEXT:%=-text %) \
+	  -sepfiles \
+	  -latextitle "1,subsection*" \
+	  -latextitle "2,subsubsection*" \
+	  -latex-type-prefix "TYP" \
+	  -latex-module-prefix "" \
+	  -latex-module-type-prefix "" \
+	  -latex-value-prefix ""
+	mv Ast_helper.tex Asthelper.tex
+	mv Ast_mapper.tex Astmapper.tex
+	mv Ocaml_operators.tex Ocamloperators.tex
+
+%.tex: %.etex
+	$(TEXQUOTE) < $< > $*.texquote_error.tex
+	mv $*.texquote_error.tex $@
+
+
+.PHONY: clean
+clean:
+	rm -f *.tex ocamldoc.out ocamldoc.sty
+	rm -f compiler_libs.txt
diff --git a/manual/manual/library/builtin.etex b/manual/manual/library/builtin.etex
new file mode 100644
index 00000000..4b1d8056
--- /dev/null
+++ b/manual/manual/library/builtin.etex
@@ -0,0 +1,283 @@
+\section{s:core-builtins}{Built-in types and predefined exceptions}
+
+The following built-in types and predefined exceptions are always
+defined in the
+compilation environment, but are not part of any module.  As a
+consequence, they can only be referred by their short names.
+
+%\vspace{0.1cm}
+\subsection*{ss:builtin-types}{Built-in types}
+%\vspace{0.1cm}
+
+\begin{ocamldoccode}
+ type int
+\end{ocamldoccode}
+\index{int@\verb`int`}
+\begin{ocamldocdescription}
+    The type of integer numbers.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type char
+\end{ocamldoccode}
+\index{char@\verb`char`}
+\begin{ocamldocdescription}
+   The type of characters.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type bytes
+\end{ocamldoccode}
+\index{bytes@\verb`bytes`}
+\begin{ocamldocdescription}
+ The type of (writable) byte sequences.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type string
+\end{ocamldoccode}
+\index{string@\verb`string`}
+\begin{ocamldocdescription}
+ The type of (read-only) character strings.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type float
+\end{ocamldoccode}
+\index{float@\verb`float`}
+\begin{ocamldocdescription}
+  The type of floating-point numbers.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type bool = false | true
+\end{ocamldoccode}
+\index{bool@\verb`bool`}
+\begin{ocamldocdescription}
+   The type of booleans (truth values).
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type unit = ()
+\end{ocamldoccode}
+\index{unit@\verb`unit`}
+\begin{ocamldocdescription}
+ The type of the unit value.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type exn
+\end{ocamldoccode}
+\index{exn@\verb`exn`}
+\begin{ocamldocdescription}
+    The type of exception values.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type 'a array
+\end{ocamldoccode}
+\index{array@\verb`array`}
+\begin{ocamldocdescription}
+  The type of arrays whose elements have type "'a".
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type 'a list = [] | :: of 'a * 'a list
+\end{ocamldoccode}
+\index{list@\verb`list`}
+\begin{ocamldocdescription}
+  The type of lists whose elements have type "'a".
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+type 'a option = None | Some of 'a
+\end{ocamldoccode}
+\index{option@\verb`option`}
+\begin{ocamldocdescription}
+  The type of optional values of type "'a".
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+type int32
+\end{ocamldoccode}
+\index{int32@\verb`int32`}
+\begin{ocamldocdescription}
+ The type of signed 32-bit integers.
+ Literals for 32-bit integers are suffixed by l.
+ See the \stdmoduleref{Int32} module.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+type int64
+\end{ocamldoccode}
+\index{int64@\verb`int64`}
+\begin{ocamldocdescription}
+ The type of signed 64-bit integers.
+ Literals for 64-bit integers are suffixed by L.
+ See the \stdmoduleref{Int64} module.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+type nativeint
+\end{ocamldoccode}
+\index{nativeint@\verb`nativeint`}
+\begin{ocamldocdescription}
+ The type of signed, platform-native integers (32 bits on 32-bit
+ processors, 64 bits on 64-bit processors).
+ Literals for native integers are suffixed by n.
+ See the \stdmoduleref{Nativeint} module.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+type ('a, 'b, 'c, 'd, 'e, 'f) format6
+\end{ocamldoccode}
+\index{format4@\verb`format4`}
+\begin{ocamldocdescription}
+  The type of format strings. "'a" is the type of the parameters of
+  the format, "'f" is the result type for the "printf"-style
+  functions, "'b" is the type of the first argument given to "%a" and
+  "%t" printing functions (see module \stdmoduleref{Printf}),
+  "'c" is the result type of these functions, and also the type of the
+  argument transmitted to the first argument of "kprintf"-style
+  functions, "'d" is the result type for the "scanf"-style functions
+  (see module \stdmoduleref{Scanf}), and "'e" is the type of the receiver function
+  for the "scanf"-style functions.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+type 'a lazy_t
+\end{ocamldoccode}
+\index{lazyt@\verb`lazy_t`}
+\begin{ocamldocdescription}
+ This type is used to implement the \stdmoduleref{Lazy} module.
+ It should not be used directly.
+\end{ocamldocdescription}
+
+%\vspace{0.1cm}
+\subsection*{ss:predef-exn}{Predefined exceptions}
+%\vspace{0.1cm}
+
+\begin{ocamldoccode}
+exception Match_failure of (string * int * int)
+\end{ocamldoccode}
+\index{Matchfailure@\verb`Match_failure`}
+\begin{ocamldocdescription}
+   Exception raised when none of the cases of a pattern-matching
+   apply. The arguments are the location of the "match" keyword
+   in the source code (file name, line number, column number).
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Assert_failure of (string * int * int)
+\end{ocamldoccode}
+\index{Assertfailure@\verb`Assert_failure`}
+\begin{ocamldocdescription}
+   Exception raised when an assertion fails.  The arguments are
+   the location of the "assert" keyword in the source code
+   (file name, line number, column number).
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Invalid_argument of string
+\end{ocamldoccode}
+\index{Invalidargument@\verb`Invalid_argument`}
+\begin{ocamldocdescription}
+   Exception raised by library functions to signal that the given
+   arguments do not make sense.  The string gives some information
+   to the programmer.  As a general rule, this exception should not
+   be caught, it denotes a programming error and the code should be
+   modified not to trigger it.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Failure of string
+\end{ocamldoccode}
+\index{Failure@\verb`Failure`}
+\begin{ocamldocdescription}
+  Exception raised by library functions to signal that they are
+  undefined on the given arguments.  The string is meant to give some
+  information to the programmer; you must \emph{not} pattern match on
+  the string literal because it may change in future versions (use
+  \verb`Failure _` instead).
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Not_found
+\end{ocamldoccode}
+\index{Notfound@\verb`Not_found`}
+\begin{ocamldocdescription}
+   Exception raised by search functions when the desired object
+   could not be found.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Out_of_memory
+\end{ocamldoccode}
+\index{Outofmemory@\verb`Out_of_memory`}
+\begin{ocamldocdescription}
+   Exception raised by the garbage collector when there is
+   insufficient memory to complete the computation. (Not reliable for
+   allocations on the minor heap.)
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Stack_overflow
+\end{ocamldoccode}
+\index{Stackoverflow@\verb`Stack_overflow`}
+\begin{ocamldocdescription}
+   Exception raised by the bytecode interpreter when the evaluation
+   stack reaches its maximal size. This often indicates infinite or
+   excessively deep recursion in the user's program. Before 4.10, it
+   was not fully implemented by the native-code compiler.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Sys_error of string
+\end{ocamldoccode}
+\index{Syserror@\verb`Sys_error`}
+\begin{ocamldocdescription}
+  Exception raised by the input/output functions to report an
+  operating system error.  The string is meant to give some
+  information to the programmer; you must \emph{not} pattern match on
+  the string literal because it may change in future versions (use
+  \verb`Sys_error _` instead).
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception End_of_file
+\end{ocamldoccode}
+\index{Endoffile@\verb`End_of_file`}
+\begin{ocamldocdescription}
+   Exception raised by input functions to signal that the
+   end of file has been reached.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Division_by_zero
+\end{ocamldoccode}
+\index{Divisionbyzero@\verb`Division_by_zero`}
+\begin{ocamldocdescription}
+   Exception raised by integer division and remainder operations
+   when their second argument is zero.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Sys_blocked_io
+\end{ocamldoccode}
+\index{Sysblockedio@\verb`Sys_blocked_io`}
+\begin{ocamldocdescription}
+   A special case of "Sys_error" raised when no I/O is possible
+   on a non-blocking I/O channel.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Undefined_recursive_module of (string * int * int)
+\end{ocamldoccode}
+\index{Undefinedrecursivemodule@\verb`Undefined_recursive_module`}
+\begin{ocamldocdescription}
+   Exception raised when an ill-founded recursive module definition
+   is evaluated.  (See section~\ref{s:recursive-modules}.)
+   The arguments are the location of the definition in the source code
+   (file name, line number, column number).
+\end{ocamldocdescription}
+
diff --git a/manual/manual/library/compiler_libs.mld b/manual/manual/library/compiler_libs.mld
new file mode 100644
index 00000000..6e77aa9a
--- /dev/null
+++ b/manual/manual/library/compiler_libs.mld
@@ -0,0 +1,9 @@
+{!indexlist}
+
+{1 Warning}
+  This library is part of the internal OCaml compiler API, and is
+not the language standard library.
+  There are no compatibility guarantees between releases, so code written
+against these modules must be willing to depend on specific OCaml compiler
+versions.
+
diff --git a/manual/manual/library/compilerlibs.etex b/manual/manual/library/compilerlibs.etex
new file mode 100644
index 00000000..84d9919a
--- /dev/null
+++ b/manual/manual/library/compilerlibs.etex
@@ -0,0 +1,59 @@
+\chapter{The compiler front-end} \label{c:parsinglib}\cutname{parsing.html}
+\label{Compiler-underscorelibs} % redirect references to compiler_libs.mld here
+
+This chapter describes the OCaml front-end, which declares the abstract
+syntax tree used by the compiler, provides a way to parse, print
+and pretty-print OCaml code, and ultimately allows one to write abstract
+syntax tree preprocessors invoked via the {\tt -ppx} flag (see chapters~\ref{c:camlc}
+and~\ref{c:nativecomp}).
+
+It is important to note that the exported front-end interface follows the evolution of the OCaml language and implementation, and thus does not provide {\bf any} backwards compatibility guarantees.
+
+The front-end is a part of "compiler-libs" library.
+Programs that use the "compiler-libs" library should be built as follows:
+\begin{alltt}
+        ocamlfind ocamlc \var{other options} -package compiler-libs.common \var{other files}
+        ocamlfind ocamlopt \var{other options} -package compiler-libs.common \var{other files}
+\end{alltt}
+Use of the {\tt ocamlfind} utility is recommended. However, if this is not possible, an alternative method may be used:
+\begin{alltt}
+        ocamlc \var{other options} -I +compiler-libs ocamlcommon.cma \var{other files}
+        ocamlopt \var{other options} -I +compiler-libs ocamlcommon.cmxa \var{other files}
+\end{alltt}
+For interactive use of the "compiler-libs" library, start "ocaml" and
+type\\*"#load \"compiler-libs/ocamlcommon.cma\";;".
+
+% Some of the files below are commented out as the documentation is too poor
+% or they are thought to be nonessential.
+
+\ifouthtml
+\begin{links}
+\item \ahref{compilerlibref/Ast\_helper.html}{Module \texttt{Ast_helper}: helper functions for AST construction}
+\item \ahref{compilerlibref/Ast\_mapper.html}{Module \texttt{Ast_mapper}: -ppx rewriter interface}
+\item \ahref{compilerlibref/Asttypes.html}{Module \texttt{Asttypes}: auxiliary types used by Parsetree}
+% \item \ahref{compilerlibref/Lexer.html}{Module \texttt{Lexer}: OCaml syntax lexing}
+\item \ahref{compilerlibref/Location.html}{Module \texttt{Location}: source code locations}
+\item \ahref{compilerlibref/Longident.html}{Module \texttt{Longident}: long identifiers}
+\item \ahref{compilerlibref/Parse.html}{Module \texttt{Parse}: OCaml syntax parsing}
+\item \ahref{compilerlibref/Parsetree.html}{Module \texttt{Parsetree}: OCaml syntax tree}
+\item \ahref{compilerlibref/Pprintast.html}{Module \texttt{Pprintast}: OCaml syntax printing}
+% \item \ahref{compilerlibref/Printast.html}{Module \texttt{Printast}: AST printing}
+\end{links}
+
+\else
+{\ocamldocinputstart
+% Ast_helper is excluded from the PDF and text manuals.
+% It is over 20 pages long and does not have doc-comments. It is expected
+% that Ast_helper will be only useful in the HTML manual (to look up signatures).
+% \input{Asthelper.tex}
+\input{Astmapper.tex}
+\input{Asttypes.tex}
+% \input{Lexer.tex}
+\input{Location.tex}
+\input{Longident.tex}
+\input{Parse.tex}
+\input{Parsetree.tex}
+\input{Pprintast.tex}
+}
+% \input{Printast.tex}
+\fi
diff --git a/manual/manual/library/core.etex b/manual/manual/library/core.etex
new file mode 100644
index 00000000..d30f0d4d
--- /dev/null
+++ b/manual/manual/library/core.etex
@@ -0,0 +1,38 @@
+\chapter{The core library} \label{c:corelib}\cutname{core.html}
+
+This chapter describes the OCaml core library, which is
+ composed of declarations for built-in types and exceptions, plus
+the module "Stdlib" that provides basic operations on these
+ built-in types.  The "Stdlib" module is special in two
+ways:
+\begin{itemize}
+\item It is automatically linked with the user's object code files by
+the "ocamlc" command (chapter~\ref{c:camlc}).
+
+\item It is automatically ``opened'' when a compilation starts, or
+when the toplevel system is launched. Hence, it is possible to use
+unqualified identifiers to refer to the functions provided by the
+"Stdlib" module, without adding a "open Stdlib" directive.
+\end{itemize}
+
+\section*{s:core-conventions}{Conventions}
+
+The declarations of the built-in types and the components of module
+"Stdlib" are printed one by one in typewriter font, followed by a
+short comment.  All library modules and the components they provide are
+indexed at the end of this report.
+
+\input{builtin.tex}
+\ifouthtml
+\section{s:stdlib-module}{Module {\tt Stdlib}: the initially opened module}
+\begin{links}
+\item \ahref{libref/Stdlib.html}{Module \texttt{Stdlib}: the initially opened module}
+\item Module \texttt{Pervasives}: deprecated alias for Stdlib
+\end{links}
+\else
+{
+\ocamldocinputstart
+\input{Stdlib.tex}
+}
+\fi
+
diff --git a/manual/manual/library/libbigarray.etex b/manual/manual/library/libbigarray.etex
new file mode 100644
index 00000000..8c8691f8
--- /dev/null
+++ b/manual/manual/library/libbigarray.etex
@@ -0,0 +1,36 @@
+\chapter{The bigarray library}
+%HEVEA\cutname{libbigarray.html}
+
+The "bigarray" library has now been integrated into OCaml's standard
+library.
+
+The "bigarray" functionality may now be found in the standard library
+\ifouthtml
+  \ahref{libref/Bigarray.html}{\texttt{Bigarray} module},
+\else
+  \texttt{Bigarray} module,
+\fi
+except for the "map_file" function which is now
+part of the \hyperref[c:unix]{Unix library}. The documentation has
+been integrated into the documentation for the standard library.
+
+The legacy "bigarray" library bundled with the compiler is a
+compatibility library with exactly the same interface as before,
+i.e. with "map_file" included.
+
+We strongly recommend that you port your code to use the standard
+library version instead, as the changes required are minimal.
+
+If you choose to use the compatibility library, you must link your
+programs as follows:
+\begin{alltt}
+        ocamlc \var{other options} bigarray.cma \var{other files}
+        ocamlopt \var{other options} bigarray.cmxa \var{other files}
+\end{alltt}
+For interactive use of the "bigarray" compatibility library, do:
+\begin{alltt}
+        ocamlmktop -o mytop bigarray.cma
+        ./mytop
+\end{alltt}
+or (if dynamic linking of C libraries is supported on your platform),
+start "ocaml" and type "#load \"bigarray.cma\";;".
diff --git a/manual/manual/library/libdynlink.etex b/manual/manual/library/libdynlink.etex
new file mode 100644
index 00000000..f7448b94
--- /dev/null
+++ b/manual/manual/library/libdynlink.etex
@@ -0,0 +1,32 @@
+\chapter{The dynlink library: dynamic loading and linking of object files}
+%HEVEA\cutname{libdynlink.html}
+
+The "dynlink" library supports type-safe dynamic loading and linking
+of bytecode object files (".cmo" and ".cma" files) in a running
+bytecode program, or of native plugins (usually ".cmxs" files) in a
+running native program.  Type safety is ensured by limiting the set of
+modules from the running program that the loaded object file can
+access, and checking that the running program and the loaded object
+file have been compiled against the same interfaces for these modules.
+In native code, there are also some compatibility checks on the
+implementations (to avoid errors with cross-module optimizations); it
+might be useful to hide ".cmx" files when building native plugins so
+that they remain independent of the implementation of modules in the
+main program.
+
+Programs that use the "dynlink" library simply need to link
+"dynlink.cma" or "dynlink.cmxa" with their object files and other libraries.
+
+\textbf{Note:} in order to insure that the dynamically-loaded modules have
+access to all the libraries that are visible to the main program (and not just
+to the parts of those libraries that are actually used in the main program),
+programs using the "dynlink" library should be linked with "-linkall".
+
+\ifouthtml
+\begin{links}
+\item \ahref{libref/Dynlink.html}{Module \texttt{Dynlink}: dynamic loading of bytecode object files}
+\end{links}
+
+\else
+\input{Dynlink.tex}
+\fi
diff --git a/manual/manual/library/libgraph.etex b/manual/manual/library/libgraph.etex
new file mode 100644
index 00000000..89568aec
--- /dev/null
+++ b/manual/manual/library/libgraph.etex
@@ -0,0 +1,18 @@
+\chapter{The graphics library}
+%HEVEA\cutname{libgraph.html}
+
+Since OCaml 4.09, the "graphics" library is distributed as an external
+package. Its new home is:
+
+\url{https://github.com/ocaml/graphics}
+
+If you are using the opam package manager, you should install the
+corresponding "graphics" package:
+
+\begin{alltt}
+        opam install graphics
+\end{alltt}
+
+Before OCaml 4.09, this package simply ensures that the "graphics"
+library was installed by the compiler, and starting from OCaml 4.09
+this package effectively provides the "graphics" library.
diff --git a/manual/manual/library/libnum.etex b/manual/manual/library/libnum.etex
new file mode 100644
index 00000000..5b5944af
--- /dev/null
+++ b/manual/manual/library/libnum.etex
@@ -0,0 +1,13 @@
+\chapter{The num library: arbitrary-precision rational arithmetic}
+%HEVEA\cutname{libnum.html}
+
+The "num" library implements integer arithmetic and rational
+arithmetic in arbitrary precision. It was split off the core
+OCaml distribution starting with the 4.06.0 release, and can now be found
+at \url{https://github.com/ocaml/num}.
+
+New applications that need arbitrary-precision arithmetic should use the
+"Zarith" library (\url{https://github.com/ocaml/Zarith}) instead of the "Num"
+library, and older applications that already use "Num" are encouraged to
+switch to "Zarith". "Zarith" delivers much better performance than "Num"
+and has a nicer API.
diff --git a/manual/manual/library/libstr.etex b/manual/manual/library/libstr.etex
new file mode 100644
index 00000000..180052fc
--- /dev/null
+++ b/manual/manual/library/libstr.etex
@@ -0,0 +1,32 @@
+\chapter{The str library: regular expressions and string processing}
+%HEVEA\cutname{libstr.html}
+
+The "str" library provides high-level string processing functions,
+some based on regular expressions. It is intended to support the kind
+of file processing that is usually performed with scripting languages
+such as "awk", "perl" or "sed".
+
+Programs that use the "str" library must be linked as follows:
+\begin{alltt}
+        ocamlc \var{other options} str.cma \var{other files}
+        ocamlopt \var{other options} str.cmxa \var{other files}
+\end{alltt}
+For interactive use of the "str" library, do:
+\begin{alltt}
+        ocamlmktop -o mytop str.cma
+        ./mytop
+\end{alltt}
+or (if dynamic linking of C libraries is supported on your platform),
+start "ocaml" and type "#load \"str.cma\";;".
+
+\ifouthtml
+\begin{links}
+\item \ahref{libref/Str.html}{Module \texttt{Str}: regular expressions and string processing}
+\end{links}
+
+\else
+\ocamldocinputstart
+\input{Str.tex}
+\fi
+
+
diff --git a/manual/manual/library/libthreads.etex b/manual/manual/library/libthreads.etex
new file mode 100644
index 00000000..31113c65
--- /dev/null
+++ b/manual/manual/library/libthreads.etex
@@ -0,0 +1,56 @@
+\chapter{The threads library}
+\label{c:threads}\cutname{threads.html}
+%HEVEA\cutname{libthreads.html}
+
+\textbf{Warning:} the "threads" library is deprecated since version
+4.08.0 of OCaml. Please switch to system threads, which have the same
+API. Lightweight threads with VM-level scheduling are provided by
+third-party libraries such as Lwt, but with a different API.
+
+The "threads" library allows concurrent programming in OCaml.
+It provides multiple threads of control (also called lightweight
+processes) that execute concurrently in the same memory space. Threads
+communicate by in-place modification of shared data structures, or by
+sending and receiving data on communication channels.
+
+The "threads" library is implemented by time-sharing on a single
+processor. It will not take advantage of multi-processor machines.
+Using this library will therefore never make programs run
+faster. However, many programs are easier to write when structured as
+several communicating processes.
+
+Two implementations of the "threads" library are available, depending
+on the capabilities of the operating system:
+\begin{itemize}
+\item System threads.  This implementation builds on the OS-provided threads
+facilities: POSIX 1003.1c threads for Unix, and Win32 threads for
+Windows.  When available, system threads support both bytecode and
+native-code programs.
+\item VM-level threads.  This implementation performs time-sharing and
+context switching at the level of the OCaml virtual machine (bytecode
+interpreter).  It is available on Unix systems, and supports only
+bytecode programs.  It cannot be used with native-code programs.
+\end{itemize}
+Programs that use system threads must be linked as follows:
+\begin{alltt}
+        ocamlc -I +threads \var{other options} unix.cma threads.cma \var{other files}
+        ocamlopt -I +threads \var{other options} unix.cmxa threads.cmxa \var{other files}
+\end{alltt}
+Compilation units that use the "threads" library must also be compiled with
+the "-I +threads" option (see chapter~\ref{c:camlc}).
+
+\ifouthtml
+\begin{links}
+\item \ahref{libref/Thread.html}{Module \texttt{Thread}: lightweight threads}
+\item \ahref{libref/Mutex.html}{Module \texttt{Mutex}: locks for mutual exclusion}
+\item \ahref{libref/Condition.html}{Module \texttt{Condition}: condition variables to synchronize between threads}
+\item \ahref{libref/Event.html}{Module \texttt{Event}: first-class synchronous communication}
+\item \ahref{libref/ThreadUnix.html}{Module \texttt{ThreadUnix}: thread-compatible system calls}
+\end{links}
+\else
+\input{Thread.tex}
+\input{Mutex.tex}
+\input{Condition.tex}
+\input{Event.tex}
+\input{ThreadUnix.tex}
+\fi
diff --git a/manual/manual/library/libunix.etex b/manual/manual/library/libunix.etex
new file mode 100644
index 00000000..ed79a74a
--- /dev/null
+++ b/manual/manual/library/libunix.etex
@@ -0,0 +1,99 @@
+\chapter{The unix library: Unix system calls}
+%HEVEA\cutname{libunix.html}
+\label{c:unix}
+
+The "unix" library makes many Unix
+system calls and system-related library functions available to
+OCaml programs. This chapter describes briefly the functions
+provided.  Refer to sections 2~and~3 of the Unix manual for more
+details on the behavior of these functions.
+
+\ifouthtml
+\begin{links}
+\item \ahref{libref/Unix.html}{Module \texttt{Unix}: Unix system calls}
+\item \ahref{libref/UnixLabels.html}{Module \texttt{UnixLabels}: Labeled
+   Unix system calls}
+\end{links}
+\fi
+
+Not all functions are provided by all Unix variants. If some functions
+are not available, they will raise "Invalid_arg" when called.
+
+Programs that use the "unix" library must be linked as follows:
+\begin{alltt}
+        ocamlc \var{other options} unix.cma \var{other files}
+        ocamlopt \var{other options} unix.cmxa \var{other files}
+\end{alltt}
+For interactive use of the "unix" library, do:
+\begin{alltt}
+        ocamlmktop -o mytop unix.cma
+        ./mytop
+\end{alltt}
+or (if dynamic linking of C libraries is supported on your platform),
+start "ocaml" and type "#load \"unix.cma\";;".
+
+\begin{windows}
+A fairly complete emulation of the Unix system calls is provided in
+the Windows version of OCaml. The end of this chapter gives
+more information on the functions that are not supported under Windows.
+\end{windows}
+
+\begin{latexonly}
+{
+\ocamldocinputstart
+\input{Unix.tex}
+
+\section{s:Module \texttt{UnixLabels}: labelized version of the interface}
+\label{UnixLabels}
+\index{UnixLabels (module)@\verb~UnixLabels~ (module)}%
+
+This module is identical to "Unix"~(\ref{Unix}), and only differs by
+the addition of labels. You may see these labels directly by looking
+at "unixLabels.mli", or by using the "ocamlbrowser" tool.
+
+\newpage
+}
+\end{latexonly}
+
+\begin{windows}
+The Cygwin port of OCaml fully implements all functions from
+the Unix module.  The native Win32 ports implement a subset of them.
+Below is a list of the functions that are not implemented, or only
+partially implemented, by the Win32 ports. Functions not mentioned are
+fully implemented and behave as described previously in this chapter.
+
+\begin{tableau}{|l|p{8cm}|}{Functions}{Comment}
+\entree{"fork"}{not implemented, use "create_process" or threads}
+\entree{"wait"}{not implemented, use "waitpid"}
+\entree{"waitpid"}{can only wait for a given PID, not any child process}
+\entree{"getppid"}{not implemented (meaningless under Windows)}
+\entree{"nice"}{not implemented}
+\entree{"truncate", "ftruncate"}{not implemented}
+\entree{"link"}{implemented (since 3.02)}
+\entree{"symlink", "readlink"}{implemented (since 4.03.0)}
+\entree{"access"}{execute permission "X_OK" cannot be tested,
+  it just tests for read permission instead}
+\entree{"fchmod"}{not implemented}
+\entree{"chown", "fchown"}{not implemented (make no sense on a DOS
+file system)}
+\entree{"umask"}{not implemented}
+\entree{"mkfifo"}{not implemented}
+\entree{"kill"}{partially implemented (since 4.00.0): only the "sigkill" signal
+is implemented}
+\entree{"pause"}{not implemented (no inter-process signals in Windows)}
+\entree{"alarm"}{not implemented}
+\entree{"times"}{partially implemented, will not report timings for child
+processes}
+\entree{"getitimer", "setitimer"}{not implemented}
+\entree{"getuid", "geteuid", "getgid", "getegid"}{always return 1}
+\entree{"getgroups"}{always returns "[|1|]" (since 2.00)}
+\entree{"setuid", "setgid", "setgroups"}{not implemented}
+\entree{"getpwnam", "getpwuid"}{always raise "Not_found"}
+\entree{"getgrnam", "getgrgid"}{always raise "Not_found"}
+\entree{type "socket_domain"}{"PF_INET" is fully supported;
+"PF_INET6" is fully supported (since 4.01.0); "PF_UNIX" is not supported }
+\entree{"establish_server"}{not implemented; use threads}
+\entree{terminal functions ("tc*")}{not implemented}
+\end{tableau}
+
+\end{windows}
diff --git a/manual/manual/library/stdlib-blurb.etex b/manual/manual/library/stdlib-blurb.etex
new file mode 100644
index 00000000..600177f4
--- /dev/null
+++ b/manual/manual/library/stdlib-blurb.etex
@@ -0,0 +1,219 @@
+\chapter{The standard library} \label{c:stdlib}\cutname{stdlib.html}
+
+This chapter describes the functions provided by the OCaml
+standard library. The modules from the standard library are
+automatically linked with the user's object code files by the "ocamlc"
+command. Hence, these modules can be used in standalone programs without
+having to add any ".cmo" file on the command line for the linking
+phase. Similarly, in interactive use, these globals can be used in
+toplevel phrases without having to load any ".cmo" file in memory.
+
+Unlike the core "Stdlib" module, submodules are not automatically
+``opened'' when compilation starts, or when the toplevel system is launched.
+Hence it is necessary to use qualified identifiers to refer to the functions
+provided by these modules, or to add "open" directives.
+
+\label{stdlib:top}
+
+\section*{s:stdlib-conv}{Conventions}
+
+For easy reference, the modules are listed below in alphabetical order
+of module names.
+For each module, the declarations from its signature are printed
+one by one in typewriter font, followed by a short comment.
+All modules and the identifiers they export are indexed at the end of
+this report.
+
+\begin{latexonly}
+\section*{s:stdlib-overview}{Overview}
+
+Here is a short listing, by theme, of the standard library modules.
+
+\subsubsection*{sss:stdlib-data-structures}{Data structures:}
+\begin{tabular}{lll}
+% Beware: these entries must be written in a very rigidly-defined
+% format, or the check-stdlib-modules script will complain.
+"String" & p.~\pageref{String} & string operations \\
+"Bytes" & p.~\pageref{Bytes} & operations on byte sequences\\
+"Array" & p.~\pageref{Array} & array operations \\
+"List" & p.~\pageref{List} & list operations \\
+"StdLabels" & p.~\pageref{StdLabels} & labelized versions of
+the above 4 modules \\
+"Unit" & p.~\pageref{Unit} & unit values \\
+"Bool" & p.~\pageref{Bool} & boolean values \\
+"Char" & p.~\pageref{Char} & character operations \\
+"Uchar" & p.~\pageref{Uchar} & Unicode characters \\
+"Int" & p.~\pageref{Int} & integer values \\
+"Option" & p.~\pageref{Option} & option values \\
+"Result" & p.~\pageref{Result} & result values \\
+"Hashtbl" & p.~\pageref{Hashtbl} & hash tables and hash functions \\
+"Random" & p.~\pageref{Random} & pseudo-random number generator \\
+"Set" & p.~\pageref{Set} & sets over ordered types \\
+"Map" & p.~\pageref{Map} & association tables over ordered types \\
+"MoreLabels" & p.~\pageref{MoreLabels} & labelized versions of
+"Hashtbl", "Set", and "Map" \\
+"Oo" & p.~\pageref{Oo} & useful functions on objects \\
+"Stack" & p.~\pageref{Stack} & last-in first-out stacks \\
+"Queue" & p.~\pageref{Queue} & first-in first-out queues \\
+"Buffer" & p.~\pageref{Buffer} & buffers that grow on demand \\
+"Seq" & p.~\pageref{Seq} & functional iterators \\
+"Lazy" & p.~\pageref{Lazy} & delayed evaluation \\
+"Weak" & p.~\pageref{Weak} & references that don't prevent objects
+from being garbage-collected \\
+"Ephemeron" & p.~\pageref{Ephemeron} & ephemerons and weak hash tables \\
+"Bigarray" & p.~\pageref{Bigarray} & large, multi-dimensional, numerical arrays
+\end{tabular}
+\subsubsection*{sss:stdlib-arith}{Arithmetic:}
+\begin{tabular}{lll}
+"Complex" & p.~\pageref{Complex} & Complex numbers \\
+"Float" & p.~\pageref{Float} & Floating-point numbers \\
+"Int32" & p.~\pageref{Int32} & operations on 32-bit integers \\
+"Int64" & p.~\pageref{Int64} & operations on 64-bit integers \\
+"Nativeint" & p.~\pageref{Nativeint} & operations on platform-native
+integers
+\end{tabular}
+\subsubsection{sss:stdlib-io}{Input/output:}
+\begin{tabular}{lll}
+"Format" & p.~\pageref{Format} & pretty printing with automatic
+indentation and line breaking \\
+"Marshal" & p.~\pageref{Marshal} & marshaling of data structures \\
+"Printf" & p.~\pageref{Printf} & formatting printing functions \\
+"Scanf" & p.~\pageref{Scanf} & formatted input functions \\
+"Digest" & p.~\pageref{Digest} & MD5 message digest \\
+\end{tabular}
+\subsubsection{sss:stdlib-parsing}{Parsing:}
+\begin{tabular}{lll}
+"Genlex" & p.~\pageref{Genlex} & a generic lexer over streams \\
+"Lexing" & p.~\pageref{Lexing} & the run-time library for lexers generated by "ocamllex" \\
+"Parsing" & p.~\pageref{Parsing} & the run-time library for parsers generated by "ocamlyacc" \\
+"Stream" & p.~\pageref{Stream} & basic functions over streams \\
+\end{tabular}
+\subsubsection{sss:stdlib-system}{System interface:}
+\begin{tabular}{lll}
+"Arg" & p.~\pageref{Arg} & parsing of command line arguments \\
+"Callback" & p.~\pageref{Callback} & registering OCaml functions to
+be called from C \\
+"Filename" & p.~\pageref{Filename} & operations on file names \\
+"Gc" & p.~\pageref{Gc} & memory management control and statistics \\
+"Printexc" & p.~\pageref{Printexc} & a catch-all exception handler \\
+"Spacetime" & p.~\pageref{Spacetime} & memory profiler \\
+"Sys" & p.~\pageref{Sys} & system interface \\
+\end{tabular}
+\subsubsection{sss:stdlib-misc}{Misc:}
+\begin{tabular}{lll}
+"Fun" & p.~\pageref{Fun} & function values \\
+\end{tabular}
+\end{latexonly}
+
+\ifouthtml
+\begin{links}
+\item \ahref{libref/Arg.html}{Module \texttt{Arg}: parsing of command line arguments}
+\item \ahref{libref/Array.html}{Module \texttt{Array}: array operations}
+\item \ahref{libref/ArrayLabels.html}{Module \texttt{ArrayLabels}: array operations (with labels)}
+\item \ahref{libref/Bigarray.html}{Module \texttt{Bigarray}: large, multi-dimensional, numerical arrays}
+\item \ahref{libref/Bool.html}{Module \texttt{Bool}: boolean values}
+\item \ahref{libref/Buffer.html}{Module \texttt{Buffer}: extensible buffers}
+\item \ahref{libref/Bytes.html}{Module \texttt{Bytes}: byte sequences}
+\item \ahref{libref/BytesLabels.html}{Module \texttt{BytesLabels}: byte sequences (with labels)}
+\item \ahref{libref/Callback.html}{Module \texttt{Callback}: registering OCaml values with the C runtime}
+\item \ahref{libref/Char.html}{Module \texttt{Char}: character operations}
+\item \ahref{libref/Complex.html}{Module \texttt{Complex}: Complex numbers}
+\item \ahref{libref/Digest.html}{Module \texttt{Digest}: MD5 message digest}
+\item \ahref{libref/Ephemeron.html}{Module \texttt{Ephemeron}: Ephemerons and weak hash table}
+\item \ahref{libref/Filename.html}{Module \texttt{Filename}: operations on file names}
+\item \ahref{libref/Float.html}{Module \texttt{Float}: Floating-point numbers}
+\item \ahref{libref/Format.html}{Module \texttt{Format}: pretty printing}
+\item \ahref{libref/Fun.html}{Module \texttt{Fun}: function values}
+\item \ahref{libref/Gc.html}{Module \texttt{Gc}: memory management control and statistics; finalized values}
+\item \ahref{libref/Genlex.html}{Module \texttt{Genlex}: a generic lexical analyzer}
+\item \ahref{libref/Hashtbl.html}{Module \texttt{Hashtbl}: hash tables and hash functions}
+\item \ahref{libref/Int.html}{Module \texttt{Int}: integers}
+\item \ahref{libref/Int32.html}{Module \texttt{Int32}: 32-bit integers}
+\item \ahref{libref/Int64.html}{Module \texttt{Int64}: 64-bit integers}
+\item \ahref{libref/Lazy.html}{Module \texttt{Lazy}: deferred computations}
+\item \ahref{libref/Lexing.html}{Module \texttt{Lexing}: the run-time library for lexers generated by \texttt{ocamllex}}
+\item \ahref{libref/List.html}{Module \texttt{List}: list operations}
+\item \ahref{libref/ListLabels.html}{Module \texttt{ListLabels}: list operations (with labels)}
+\item \ahref{libref/Map.html}{Module \texttt{Map}: association tables over ordered types}
+\item \ahref{libref/Marshal.html}{Module \texttt{Marshal}: marshaling of data structures}
+\item \ahref{libref/MoreLabels.html}{Module \texttt{MoreLabels}: Include modules \texttt{Hashtbl}, \texttt{Map} and \texttt{Set} with labels}
+\item \ahref{libref/Nativeint.html}{Module \texttt{Nativeint}: processor-native integers}
+\item \ahref{libref/Oo.html}{Module \texttt{Oo}: object-oriented extension}
+\item \ahref{libref/Option.html}{Module \texttt{Option}: option values}
+\item \ahref{libref/Parsing.html}{Module \texttt{Parsing}: the run-time library for parsers generated by \texttt{ocamlyacc}}
+\item \ahref{libref/Printexc.html}{Module \texttt{Printexc}: facilities for printing exceptions}
+\item \ahref{libref/Printf.html}{Module \texttt{Printf}: formatting printing functions}
+\item \ahref{libref/Queue.html}{Module \texttt{Queue}: first-in first-out queues}
+\item \ahref{libref/Random.html}{Module \texttt{Random}: pseudo-random number generator (PRNG)}
+\item \ahref{libref/Result.html}{Module \texttt{Result}: result values}
+\item \ahref{libref/Scanf.html}{Module \texttt{Scanf}: formatted input functions}
+\item \ahref{libref/Seq.html}{Module \texttt{Seq}: functional iterators}
+\item \ahref{libref/Set.html}{Module \texttt{Set}: sets over ordered types}
+\item \ahref{libref/Spacetime.html}{Module \texttt{Spacetime}: memory profiler}
+\item \ahref{libref/Stack.html}{Module \texttt{Stack}: last-in first-out stacks}
+\item \ahref{libref/StdLabels.html}{Module \texttt{StdLabels}: Include modules \texttt{Array}, \texttt{List} and \texttt{String} with labels}
+\item \ahref{libref/Stream.html}{Module \texttt{Stream}: streams and parsers}
+\item \ahref{libref/String.html}{Module \texttt{String}: string operations}
+\item \ahref{libref/StringLabels.html}{Module \texttt{StringLabels}: string operations (with labels)}
+\item \ahref{libref/Sys.html}{Module \texttt{Sys}: system interface}
+\item \ahref{libref/Uchar.html}{Module \texttt{Uchar}: Unicode characters}
+\item \ahref{libref/Unit.html}{Module \texttt{Unit}: unit values}
+\item \ahref{libref/Weak.html}{Module \texttt{Weak}: arrays of weak pointers}
+\end{links}
+\else
+{\ocamldocinputstart
+\input{Arg.tex}
+\input{Array.tex}
+\input{ArrayLabels.tex}
+\input{Bigarray.tex}
+\input{Bool.tex}
+\input{Buffer.tex}
+\input{Bytes.tex}
+\input{BytesLabels.tex}
+\input{Callback.tex}
+\input{Char.tex}
+\input{Complex.tex}
+\input{Digest.tex}
+\input{Ephemeron.tex}
+\input{Filename.tex}
+\input{Float.tex}
+\input{Format.tex}
+\input{Fun.tex}
+\input{Gc.tex}
+\input{Genlex.tex}
+\input{Hashtbl.tex}
+\input{Int.tex}
+\input{Int32.tex}
+\input{Int64.tex}
+\input{Lazy.tex}
+\input{Lexing.tex}
+\input{List.tex}
+\input{ListLabels.tex}
+\input{Map.tex}
+\input{Marshal.tex}
+\input{MoreLabels.tex}
+\input{Nativeint.tex}
+\input{Oo.tex}
+\input{Option.tex}
+\input{Parsing.tex}
+\input{Printexc.tex}
+\input{Printf.tex}
+\input{Queue.tex}
+\input{Random.tex}
+\input{Result.tex}
+\input{Scanf.tex}
+\input{Seq.tex}
+\input{Set.tex}
+\input{Spacetime.tex}
+\input{Stack.tex}
+\input{StdLabels.tex}
+\input{Stream.tex}
+\input{String.tex}
+\input{StringLabels.tex}
+\input{Sys.tex}
+\input{Uchar.tex}
+\input{Unit.tex}
+\input{Weak.tex}
+\input{Ocamloperators.tex}
+}
+\fi
diff --git a/manual/manual/macros.hva b/manual/manual/macros.hva
new file mode 100644
index 00000000..e0a323e0
--- /dev/null
+++ b/manual/manual/macros.hva
@@ -0,0 +1,295 @@
+% Section macros with mandatory labels
+% Note: hevea and normal latex are forked due to the use of \@ifstar on the latex side
+
+% First, we save the normal macros
+\let\@oldsection=\section
+\let\@oldsubsection=\subsection
+\let\@oldsubsubsection=\subsubsection
+% The *-version are distincts macros in hevea
+\let\@oldsection*=\section*
+\let\@oldsubsection*=\subsection*
+\let\@oldsubsubsection*=\subsubsection*
+
+%We go back to standard macros for ocamldoc generated files
+\newcommand{\ocamldocinputstart}{%
+\let\section=\@oldsection
+\let\subsection=\@oldsubsection
+\let\subsubsection=\@oldsubsubsection
+% The *-version are distincts macros in hevea
+\let\section*=\@oldsection*
+\let\subsection*=\@oldsubsection*
+\let\subsubsection*=\@oldsubsubsection*
+}
+
+\renewcommand{\section}[2]{\@oldsection{\label{#1}#2}}
+\renewcommand{\section*}[2]{\@oldsection*{\label{#1}#2}}
+\renewcommand{\subsection}[2]{\@oldsubsection{\label{#1}#2}}
+\renewcommand{\subsection*}[2]{\@oldsubsection*{\label{#1}#2}}
+\renewcommand{\subsubsection}[2]{\@oldsubsubsection{\label{#1}#2}}
+\renewcommand{\subsubsection*}[2]{\@oldsubsubsection*{\label{#1}#2}}
+
+% For paragraph, we do not make labels compulsory
+\newcommand{\lparagraph}[2]{\paragraph{\label{#1}#2}}
+
+% Colors for links
+
+\newstyle{a.section-anchor::after}{
+  content:"\@print@u{128279}";
+  font-size:smaller;
+  margin-left:-1.5em;
+  padding-right:0.5em;
+}
+
+
+\newstyle{a.section-anchor}{
+  visibility:hidden;
+  color:grey !important;
+  text-decoration:none !important;
+}
+
+\newstyle{*:hover>a.section-anchor}{
+  visibility:visible;
+}
+
+\def\visited@color{\#0d46a3}
+\def\link@color{\#4286f4}
+\newstyle{a:link}{color:\link@color;text-decoration:underline;}
+\newstyle{a:visited}{color:\visited@color;text-decoration:underline;}
+\newstyle{a:hover}{color:black;text-decoration:underline;}
+
+
+\newstyle{@media all}{@font-face \{
+/* fira-sans-regular - latin */
+  font-family: 'Fira Sans';
+  font-style: normal;
+  font-weight: 400;
+  src: url('fonts/fira-sans-v8-latin-regular.eot'); /* IE9 Compat Modes */
+  src: local('Fira Sans Regular'), local('FiraSans-Regular'),
+       url('fonts/fira-sans-v8-latin-regular.eot?\#iefix') format('embedded-opentype'), /* IE6-IE8 */
+       url('fonts/fira-sans-v8-latin-regular.woff2') format('woff2'), /* Super Modern Browsers */
+       url('fonts/fira-sans-v8-latin-regular.woff') format('woff'), /* Modern Browsers */
+       url('fonts/fira-sans-v8-latin-regular.ttf') format('truetype'), /* Safari, Android, iOS */
+       url('fonts/fira-sans-v8-latin-regular.svg\#FiraSans') format('svg'); /* Legacy iOS */
+\}}
+
+% Compact layout
+\newstyle{body}{
+  max-width:750px;
+  width: 85\%;
+  margin: auto;
+  background: \#f7f7f7;
+  margin-top: 80px;
+  font-size: 1rem;
+}
+
+% selects the index's title
+\newstyle{.maintitle}{
+  font-family: "Fira Sans", sans-serif;
+  text-align: center;
+}
+
+\newstyle{h1, h2, h3}{
+  font-family: "Fira Sans", sans-serif;
+  font-weight: normal;
+  border-bottom: 1px solid black;
+}
+
+
+\newstyle{div.ocaml}{
+  margin:2ex 0px;
+  font-size: 1rem;
+  background: beige;
+  border: 1px solid grey;
+  padding: 10px;
+  overflow-y:auto;
+  display:flex;
+  flex-direction: column;
+  flex-wrap: nowrap;
+}
+
+\newstyle{div.ocaml .pre}{
+  white-space: pre;
+  font-family: monospace;
+}
+
+
+
+\newstyle{.ocamlkeyword}{
+  font-weight:bold;
+}
+
+
+\newstyle{.ocamlhighlight}{
+  font-weight:bold;
+  text-decoration:underline;
+}
+
+\newstyle{.ocamlerror}{
+  font-weight:bold;
+  color:red;
+}
+
+\newstyle{.ocamlwarning}{
+  font-weight:bold;
+  color:purple;
+}
+
+\newstyle{.ocamlcomment}{
+  color:grey;
+}
+
+\newstyle{.ocamlstring}{
+  opacity:0.75;
+}
+
+% Creative commons license logo
+\newstyle{\#cc_license_logo}{
+  float:left;
+  margin-right: 1em;
+}
+
+% More spacing between lines and inside tables
+\newstyle{p,ul}{line-height:1.3em}
+\newstyle{.cellpadding1 tr td}{padding:1px 4px}
+
+%Styles for caml-example and friends
+\newstyle{div.caml-output}{color:maroon;}
+% Styles for toplevel mode only
+\newstyle{div.caml-example.toplevel div.caml-input::before}
+         {content:"\#"; color:black;}
+\newstyle{div.caml-example.toplevel div.caml-input}{color:\#006000;}
+
+%%% Code examples
+\newcommand{\input@color}{\htmlcolor{006000}}
+\newcommand{\output@color}{\maroon}
+\newcommand{\machine}{\tt}
+\newenvironment{machineenv}{\begin{alltt}}{\end{alltt}}
+\newcommand{\firstline}{\ }
+\newcommand{\examplespace}{\ }
+\newcommand{\nextline}{\examplespace\ }
+\newcommand{\@zyva}{\firstline\renewcommand{\?}{\nextline}}
+\let\?=\@zyva
+\renewcommand{\:}{\renewcommand{\?}{\@zyva}}
+\newcommand{\var}[1]{\textit{#1}}
+
+%% Caml-example environment
+\newcommand{\camlexample}[1]{
+  \ifthenelse{\equal{#1}{toplevel}}
+    {\renewcommand{\examplespace}{\ }}
+    {\renewcommand{\examplespace}{}}
+  \fi
+  \@open{div}{class="caml-example #1"}
+}
+\newcommand{\endcamlexample}{
+  \@close{div}
+  \renewcommand{\examplespace}{\ }
+}
+
+\newenvironment{caml}{\@open{div}{class=ocaml}}{\@close{div}}
+\newcommand{\ocamlkeyword}{\@span{class="ocamlkeyword"}}
+\newcommand{\ocamlhighlight}{\@span{class="ocamlhighlight"}}
+\newcommand{\ocamlerror}{\@span{class="ocamlerror"}}
+\newcommand{\ocamlwarning}{\@span{class="ocamlwarning"}}
+\newcommand{\ocamlcomment}{\@span{class="ocamlcomment"}}
+\newcommand{\ocamlstring}{\@span{class="ocamlstring"}}
+
+
+%%% End of code example
+
+\newenvironment{library}{}{}
+\newcounter{page}
+\newenvironment{comment}{\begin{quote}}{\end{quote}}
+\newcommand{\nth}[2]{\({#1}_{#2}\)}
+\newenvironment{options}{\begin{description}}{\end{description}}
+
+
+%%venant de macros.tex
+
+\def\versionspecific#1{\begin{quote}\textsf{#1:}\quad}
+\def\unix{\versionspecific{Unix}}
+\def\endunix{\end{quote}}
+\def\windows{\versionspecific{Windows}}
+\def\endwindows{\end{quote}}
+
+\def\requirements{\trivlist \item[\hskip\labelsep {\bf Requirements.}]}
+\def\endrequirements{\endtrivlist}
+\def\installation{\trivlist \item[\hskip\labelsep {\bf Installation.}]}
+\def\endinstallation{\endtrivlist}
+\def\troubleshooting{\trivlist \item[\hskip\labelsep {\bf Troubleshooting.}]}
+\def\endtroubleshooting{\endtrivlist}
+
+\newtheorem{gcrule}{Rule}
+
+% Pour les tables de priorites et autres tableaux a deux colonnes, encadres
+
+\def\entree#1#2{#1 & #2 \\}
+\def\tableau#1#2#3{%
+\par
+\@open{div}{class="tableau"}
+\begin{center}%
+\begin{tabular*}{.8\linewidth}{#1}%
+\multicolumn{1}{c}{\textbf{#2}} &
+\multicolumn{1}{c}{\textbf{#3}} \\
+%%#2 & #3 \\%
+}%
+\def\endtableau{\end{tabular*}\end{center}\@close{div}\par}
+
+\newstyle{.tableau, .syntax, .syntaxleft}{
+  /* same width as body */
+  max-width: 750px;
+  overflow-y: auto;
+}
+
+% L'environnement library (pour composer les descriptions des modules
+% de bibliotheque).
+
+
+\def\restoreindent{\begingroup\let\@listI=\@savedlistI}
+\def\endrestoreindent{\endgroup}
+
+
+% PDF stuff
+
+\def\pdfchapterfold#1#2{}
+\def\pdfsection#1{}
+\def\pdfchapter{\pdfchapterfold{0}}
+
+%%% Pour camlidl
+
+\def\transl#1{$[\![\mbox{#1}]\!]$}
+
+% Pour l'index
+\usepackage{multind}
+\let\indexentry=\index
+\renewcommand{\index}[1]{\indexentry{\jobname}{#1}}
+\def\ikwd#1{\indexentry{\jobname.kwd}{#1}}
+% nth
+
+\def\th{^{\mbox{\scriptsize th}}}
+\renewcommand{\hbox}[1]{\mbox{#1}}
+
+% Notations pour les metavariables
+\def\nmth#1#2#3{\({#1}_{#2}^{#3}\)}
+\def\optvar#1{[\var{#1}\/]}
+\def\event{§§}
+\def\fromoneto#1#2{$#1 = 1,\ldots{} , #2$}
+
+\newcommand{\vfill}{}
+\def\number{}
+\def\year{\arabic{year}}
+
+% Pour alltt
+\def\rminalltt#1{{\rm #1}}
+\def\goodbreak{\ \\}
+\def\@savedlistI{}
+
+%List of links with no space around items
+\newstyle{.li-links}{margin:0ex 0ex;}
+\newenvironment{links}
+{\setenvclass{itemize}{ftoc2}\setenvclass{li-itemize}{li-links}\itemize}
+{\enditemize}
+
+\newenvironment{maintitle}{\@open{div}{class="maintitle"}}{\@close{div}}
+
+%%% References to modules in the standard library
+\newcommand{\stdmoduleref}[1]{\ahref{libref/#1.html}{\texttt{#1}}}
diff --git a/manual/manual/macros.tex b/manual/manual/macros.tex
new file mode 100644
index 00000000..728f50ee
--- /dev/null
+++ b/manual/manual/macros.tex
@@ -0,0 +1,255 @@
+\makeatletter
+
+% Pour hevea
+\newif\ifouthtml\outhtmlfalse
+\newcommand{\cutname}[1]{}
+% Notations pour les metavariables
+\def\var#1{{\it#1}}
+\def\nth#1#2{${\it#1}_{#2}$}
+\def\nmth#1#2#3{${\it#1}_{#2}^{#3}$}
+\def\optvar#1{\textrm{[}\var{#1}\/\textrm{]}}
+\def\event{$\bowtie$}
+\def\fromoneto#1#2{$#1 = 1, \ldots, #2$}
+
+
+% Redefining sections macros to make label mandatory
+\let\@oldsection=\section
+\let\@oldsubsection=\subsection
+\let\@oldsubsubsection=\subsection
+
+\newcommand{\ocamldocinputstart}{
+\let\section=\@oldsection
+\let\subsection=\@oldsubsection
+\let\subsubsection=\@oldsubsubsection
+}
+
+\renewcommand{\section}{\@ifstar{\@lsectionstar}{\@lsection}}
+\renewcommand{\subsection}{\@ifstar{\@lsubsectionstar}{\@lsubsection}}
+\renewcommand{\subsubsection}{\@ifstar{\@lsubsubsectionstar}{\@lsubsubsection}}
+
+\newcommand{\@lsection}[2]{\@oldsection{\label{#1}#2}}
+\newcommand{\@lsectionstar}[2]{\@oldsection*{\label{#1}#2}}
+\newcommand{\@lsubsection}[2]{\@oldsubsection{\label{#1}#2}}
+\newcommand{\@lsubsectionstar}[2]{\@oldsubsection*{\label{#1}#2}}
+\newcommand{\@lsubsubsection}[2]{\@oldsubsubsection{\label{#1}#2}}
+\newcommand{\@lsubsubsectionstar}[2]{\@oldsubsubsection*{\label{#1}#2}}
+
+\newcommand{\lparagraph}[1]{\paragraph{\label{#1}#1}}
+
+% Numerotation
+\setcounter{secnumdepth}{2}     % Pour numeroter les \subsection
+\setcounter{tocdepth}{1}        % Pour ne pas mettre les \subsection
+                                % dans la table des matieres
+
+% Pour avoir "_" qui marche en mode math et en mode normal
+\catcode`\_=13
+\catcode`\=8
+\def\_{\hbox{\tt\char95}}
+\def_{\ifmmode\else\_\fi}
+
+\def\ttstretch{\tt\spaceskip=5.77pt plus 1.83pt minus 1.22pt}
+% La fonte cmr10 a normalement des espaces de 5.25pt non extensibles.
+% En 11 pt ca fait 5.77 pt. On lui ajoute la meme flexibilite que
+% cmr10 agrandie a 11 pt.
+
+% Pour la traduction "xxxx" -> {\machine{xxxx}} faite par texquote2
+\def\machine#1{\mbox{\ttstretch{#1}}}
+
+% Pour la traduction "\begin{verbatim}...\end{verbatim}"
+%                    -> "\begin{machineenv}...\end{machineenv}"
+% faite aussi par texquote2.
+\newenvironment{machineenv}{\alltt}{\endalltt}
+
+% Environnements
+
+\newlength{\versionwidth}
+\setbox0=\hbox{\bf Windows:} \setlength{\versionwidth}{\wd0}
+
+\def\versionspecific#1{
+  \begin{description}\item[#1:]~\\}
+
+\def\unix{\versionspecific{Unix}}
+\def\endunix{\end{description}}
+\def\windows{\versionspecific{Windows}}
+\def\endwindows{\end{description}}
+
+\def\requirements{\trivlist \item[\hskip\labelsep {\bf Requirements.}]}
+\def\endrequirements{\endtrivlist}
+\def\installation{\trivlist \item[\hskip\labelsep {\bf Installation.}]}
+\def\endinstallation{\endtrivlist}
+\def\troubleshooting{\trivlist \item[\hskip\labelsep {\bf Troubleshooting.}]}
+\def\endtroubleshooting{\endtrivlist}
+
+\newtheorem{gcrule}{Rule}
+
+% Pour les tables de priorites et autres tableaux a deux colonnes, encadres
+
+\def\tableau#1#2#3{%
+\begin{center}
+\begin{tabular}{#1}
+\hline
+#2 & #3 \\
+\hline
+}
+\def\endtableau{\hline\end{tabular}\end{center}}
+\def\entree#1#2{#1 & #2 \\}
+
+% L'environnement option
+
+\def\optionitem[#1]{\if@noparitem \@donoparitem
+  \else \if@inlabel \indent \par \fi
+         \ifhmode \unskip\unskip \par \fi
+         \if@newlist \if@nobreak \@nbitem \else
+                        \addpenalty\@beginparpenalty
+                        \addvspace\@topsep \addvspace{-\parskip}\fi
+           \else \addpenalty\@itempenalty \addvspace\itemsep
+          \fi
+    \global\@inlabeltrue
+\fi
+\everypar{\global\@minipagefalse\global\@newlistfalse
+          \if@inlabel\global\@inlabelfalse \hskip -\parindent \box\@labels
+             \penalty\z@ \fi
+          \everypar{}}\global\@nobreakfalse
+\if@noitemarg \@noitemargfalse \if@nmbrlist \refstepcounter{\@listctr}\fi \fi
+\setbox\@tempboxa\hbox{\makelabel{#1}}%
+\global\setbox\@labels
+\ifdim \wd\@tempboxa >\labelwidth
+ \hbox{\unhbox\@labels
+       \hskip -\leftmargin
+       \box\@tempboxa}\hfil\break
+ \else
+ \hbox{\unhbox\@labels
+       \hskip -\leftmargin
+       \hbox to\leftmargin {\makelabel{#1}\hfil}}
+ \fi
+ \ignorespaces}
+
+\def\optionlabel#1{\bf #1}
+\def\options{\list{}{\let\makelabel\optionlabel\let\@item\optionitem}}
+\def\endoptions{\endlist}
+
+% L'environnement library (pour composer les descriptions des modules
+% de bibliotheque).
+
+\def\comment{\penalty200\list{}{}\item[]}
+\def\endcomment{\endlist\penalty-100}
+
+\def\library{
+\begingroup
+\raggedright
+\let\@savedlistI=\@listI%
+\def\@listI{\leftmargin\leftmargini\parsep 0pt plus 1pt\topsep 0pt plus 2pt}%
+\itemsep 0pt
+\topsep 0pt plus 2pt
+\partopsep 0pt
+}
+
+\def\endlibrary{
+\endgroup
+}
+
+\def\restoreindent{\begingroup\let\@listI=\@savedlistI}
+\def\endrestoreindent{\endgroup}
+
+% ^^A...^^A: compose l'interieur en \tt, comme \verb
+
+\catcode`\^^A=\active
+\def{%
+\begingroup\catcode``=13\@noligs\ttstretch\let\do\@makeother\dospecials%
+\def\@xobeysp{\leavevmode\penalty100\ }%
+\@vobeyspaces\frenchspacing\catcode`\^^A=\active\def{\endgroup}}
+
+% Pour l'index
+
+\let\indexentry=\index
+\def\index{\indexentry{\jobname}}
+\def\ikwd{\indexentry{\jobname.kwd}}
+
+% Les en-tetes personnalises
+
+\pagestyle{myheadings}
+\def\partmark#1{\markboth{Part \thepart. \ #1}{}}
+\def\chaptermark#1{\markright{Chapter \thechapter. \ #1}}
+
+% nth
+
+\def\th{^{\hbox{\scriptsize th}}}
+
+% Pour annuler l'espacement vertical qui suit un "verbatim"
+\def\cancelverbatim{\vspace{-\topsep}\vspace{-\parskip}}% exact.
+
+% Pour annuler l'espacement vertical entre deux \item consecutifs dans \options
+\def\cancelitemspace{\vspace{-8mm}}% determine empiriquement
+
+% Pour faire la cesure apres _ dans les identificateurs
+\def\={\discretionary{}{}{}}
+\def\cuthere{\discretionary{}{}{}}
+
+% Pour la coupure en petits documents
+
+\let\mysection=\section
+
+%%% Augmenter l'espace entre numero de section
+%   et nom de section dans la table des matieres.
+
+\def\l@section{\@dottedtocline{1}{1.5em}{2.8em}}  % D'origine: 2.3
+
+% Pour alltt
+
+\def\rminalltt#1{{\rm #1}}
+
+% redefinition de l'environnement alltt pour que les {} \ et % soient
+% dans la bonne fonte
+
+\let\@oldalltt=\alltt
+\let\@oldendalltt=\endalltt
+\renewenvironment{alltt}{%
+\begingroup%
+\renewcommand{\{}{\char`\{}%
+\renewcommand{\}}{\char`\}}%
+\renewcommand{\\}{\char`\\}%
+\renewcommand{\%}{\char`\%}%
+\@oldalltt%
+}{%
+\@oldendalltt%
+\endgroup%
+}
+
+% Index stuff -- cf multind.sty
+
+\def\printindex#1#2{\@restonecoltrue\if@twocolumn\@restonecolfalse\fi
+  \columnseprule \z@ \columnsep 35pt
+  \newpage \phantomsection \twocolumn[{\Large\bf #2 \vskip4ex}]
+  \markright{\uppercase{#2}}
+  \addcontentsline{toc}{chapter}{#2}
+  \@input{#1.ind}}
+
+%%% References to modules in the standard library
+\newcommand{\stdmoduleref}[1]{\hyperref[#1]{\texttt{#1}}[\ref{#1}]}
+
+\newenvironment{maintitle}{\begin{center}}{\end{center}}
+
+
+
+% Caml-example related command
+\newenvironment{camlexample}[1]{
+  \ifnum\pdfstrcmp{#1}{toplevel}=0
+    \renewcommand{\hash}{\#}
+  \else
+    \renewcommand{\hash}{}
+  \fi
+}{}
+\newenvironment{caml}{}{}
+\newcommand{\ocamlkeyword}{\bfseries}
+\newcommand{\ocamlhighlight}{\bfseries\uline}
+\newcommand{\ocamlerror}{\bfseries}
+\newcommand{\ocamlwarning}{\bfseries}
+
+\definecolor{gray}{gray}{0.5}
+\newcommand{\ocamlcomment}{\color{gray}\normalfont\small}
+\newcommand{\ocamlstring}{\color{gray}\bfseries}
+
+\newcommand{\?}{\normalsize\tt\hash{} }
+\renewcommand{\:}{\small\ttfamily\slshape}
+
+\makeatother
diff --git a/manual/manual/manual.hva b/manual/manual/manual.hva
new file mode 100644
index 00000000..62e2dbc9
--- /dev/null
+++ b/manual/manual/manual.hva
@@ -0,0 +1,3 @@
+\input{anchored_book.hva}
+\input{macros.hva}
+\newif\ifouthtml\outhtmltrue
diff --git a/manual/manual/manual.inf b/manual/manual/manual.inf
new file mode 100644
index 00000000..e506905f
--- /dev/null
+++ b/manual/manual/manual.inf
@@ -0,0 +1,152 @@
+\input{book.hva}
+\renewcommand{\@indexsection}[1]{\chapter{#1}}
+\newcommand{\black}{\htmlcolor{#000000}}
+\newcommand{\machine}{\tt}
+\newenvironment{machineenv}{\begin{alltt}}{\end{alltt}}
+\newenvironment{camlunder}{\@style{U}}{}
+\newcommand{\?}{\black\#\blue }
+\renewcommand{\:}{\maroon}
+
+\newcommand{\ocamlkeyword}{\bfseries}
+\newcommand{\ocamlhighlight}{\bfseries\underline}
+\newcommand{\ocamlerror}{\bfseries}
+\newcommand{\ocamlwarning}{\bfseries}
+\newcommand{\ocamlcomment}{\normalfont\small}
+\newcommand{\ocamlstring}{\bfseries}
+
+\newenvironment{caml}{\begin{alltt}}{\\\end{alltt}}
+\newenvironment{camlexample}[1]{}{}
+
+\newcommand{\var}[1]{\textit{#1}}
+
+\newenvironment{library}{}{}
+\newcounter{page}
+\newenvironment{comment}{\begin{quote}}{\end{quote}}
+\newcommand{\nth}[2]{\({#1}_{#2}\)}
+\newenvironment{options}{\begin{description}}{\end{description}}
+
+% Section macros with mandatory labels
+% Note: hevea and normal latex are forked due to the use of \@ifstar on the latex side
+
+% First, we save the normal macros
+\let\@oldsection=\section
+\let\@oldsubsection=\subsection
+\let\@oldsubsubsection=\subsubsection
+% The *-version are distincts macros in hevea
+\let\@oldsection*=\section*
+\let\@oldsubsection*=\subsection*
+\let\@oldsubsubsection*=\subsubsection*
+
+%We go back to standard macros for ocamldoc generated files
+\newcommand{\ocamldocinputstart}{%
+\let\section=\@oldsection
+\let\subsection=\@oldsubsection
+\let\subsubsection=\@oldsubsubsection
+% The *-version are distincts macros in hevea
+\let\section*=\@oldsection*
+\let\subsection*=\@oldsubsection*
+\let\subsubsection*=\@oldsubsubsection*
+}
+
+\renewcommand{\section}[2]{\@oldsection{\label{#1}#2}}
+\renewcommand{\section*}[2]{\@oldsection*{\label{#1}#2}}
+\renewcommand{\subsection}[2]{\@oldsubsection{\label{#1}#2}}
+\renewcommand{\subsection*}[2]{\@oldsubsection*{\label{#1}#2}}
+\renewcommand{\subsubsection}[2]{\@oldsubsubsection{\label{#1}#2}}
+\renewcommand{\subsubsection*}[2]{\@oldsubsubsection*{\label{#1}#2}}
+
+% For paragraph, we do not make labels compulsory
+\newcommand{\lparagraph}[2]{\paragraph{\label{#1}#2}}
+
+%%venant de macros.tex
+\newif\ifouthtml\outhtmlfalse
+\def\versionspecific#1{
+\quad\textsf{#1:}
+\begin{quote}}
+
+\def\unix{\versionspecific{Unix}}
+\def\endunix{\end{quote}}
+\def\windows{\versionspecific{Windows}}
+\def\endwindows{\end{quote}}
+
+\def\requirements{\trivlist \item[\hskip\labelsep {\bf Requirements.}]}
+\def\endrequirements{\endtrivlist}
+\def\installation{\trivlist \item[\hskip\labelsep {\bf Installation.}]}
+\def\endinstallation{\endtrivlist}
+\def\troubleshooting{\trivlist \item[\hskip\labelsep {\bf Troubleshooting.}]}
+\def\endtroubleshooting{\endtrivlist}
+
+\newtheorem{gcrule}{Rule}
+
+% Pour les tables de priorites et autres tableaux a deux colonnes, encadres
+
+%\def\entree#1#2{#1 & #2 \\}
+%\def\tableau#1#2#3{%
+%\par\begin{center}%
+%\begin{tabular}{#1}%
+%\multicolumn{1}{c}{\textbf{#2}} &
+%\multicolumn{1}{c}{\textbf{#3}} \\
+%%#2 & #3 \\%
+%}%
+%\def\endtableau{\end{tabular}\end{center}\par}
+
+% Pour les tables de priorites et autres tableaux a deux colonnes, encadres
+
+\def\tableau#1#2#3{%
+\begin{center}
+\begin{tabular}{#1}
+\hline
+\multicolumn{1}{|c|}{\textbf{#2}} & \multicolumn{1}{c|}{\textbf{#3}} \\
+\hline
+}
+\def\endtableau{\hline\end{tabular}\end{center}}
+\def\entree#1#2{#1 & #2 \\}
+
+
+
+% L'environnement library (pour composer les descriptions des modules
+% de bibliotheque).
+
+
+\def\restoreindent{\begingroup\let\@listI=\@savedlistI}
+\def\endrestoreindent{\endgroup}
+
+
+% PDF stuff
+
+\def\pdfchapterfold#1#2{}
+\def\pdfsection#1{}
+\def\pdfchapter{\pdfchapterfold{0}}
+
+%%% Pour camlidl
+
+\def\transl#1{$[\![\mbox{#1}]\!]$}
+
+% Pour l'index
+\usepackage{multind}
+\let\indexentry=\index
+\renewcommand{\index}[1]{\indexentry{\jobname}{#1}}
+\def\ikwd#1{\indexentry{\jobname.kwd}{#1}}
+
+
+% nth
+\def\th{^{\mbox{\scriptsize th}}}
+\renewcommand{\hbox}[1]{\mbox{#1}}
+
+% Notations pour les metavariables
+\def\nmth#1#2#3{\({#1}_{#2}^{#3}\)}
+\def\optvar#1{[\var{#1}\/]}
+\def\event{§§}
+\def\fromoneto#1#2{$#1 = 1,\ldots{} , #2$}
+
+\newcommand{\vfill}{}
+\def\number{}
+\def\year{2013}
+
+% Pour alltt
+
+\def\rminalltt#1{{\rm #1}}
+
+\def\goodbreak{\ \\}
+
+\def\@savedlistI{}
diff --git a/manual/manual/manual.info.header b/manual/manual/manual.info.header
new file mode 100644
index 00000000..74665158
--- /dev/null
+++ b/manual/manual/manual.info.header
@@ -0,0 +1,4 @@
+INFO-DIR-SECTION OCaml Programming Language 
+START-INFO-DIR-ENTRY
+* ocaml: (ocaml). OCaml Reference Manual
+END-INFO-DIR-ENTRY
diff --git a/manual/manual/manual.tex b/manual/manual/manual.tex
new file mode 100644
index 00000000..5fce5c66
--- /dev/null
+++ b/manual/manual/manual.tex
@@ -0,0 +1,131 @@
+\documentclass[11pt]{book}
+\usepackage{ae}
+\usepackage[utf8]{inputenc}
+\usepackage[T1]{fontenc}
+% HEVEA\@def@charset{UTF-8}%
+\usepackage{fullpage}
+\usepackage{syntaxdef}
+\usepackage{multind}
+\usepackage{html}
+\usepackage{textcomp}
+\usepackage{ocamldoc}
+\usepackage{xspace}
+\usepackage{color}
+
+% Package for code examples:
+\usepackage{listings}
+\usepackage{alltt}
+\usepackage{lmodern}% for supporting bold ttfamily in code examples
+\usepackage[normalem]{ulem}% for underlining errors in code examples
+
+\input{macros.tex}
+\newcommand{\hash}{\#}
+\lstnewenvironment{camloutput}{
+  \lstset{
+    basicstyle=\small\ttfamily\slshape,
+    showstringspaces=false,
+    language=caml,
+    escapeinside={$}{$},
+    columns=fullflexible,
+    stringstyle=\ocamlstring,
+    keepspaces=true,
+    keywordstyle=\ocamlkeyword,
+    keywords={[2]{val}}, keywordstyle={[2]\ocamlkeyword},
+    aboveskip=0\baselineskip,
+  }
+\ifouthtml
+  \setenvclass{lstlisting}{pre caml-output ok}
+  \lstset {basicstyle=\ttfamily}
+\else
+  \lstset{
+    upquote=true,
+    literate={'"'}{\textquotesingle "\textquotesingle}3
+    {'\\"'}{\textquotesingle \textbackslash"\textquotesingle}4,
+}
+\fi
+}{}
+
+\lstnewenvironment{camlinput}{
+  \lstset{
+    basicstyle=\ttfamily,
+    showstringspaces=false,
+    language=caml,
+    escapeinside={$}{$},
+    columns=fullflexible,
+    stringstyle=\ocamlstring,
+    commentstyle=\ocamlcomment,
+    keepspaces=true,
+    keywordstyle=\ocamlkeyword,
+    moredelim=[is][\ocamlhighlight]{<<}{>>},
+    moredelim=[s][\ocamlstring]{\{|}{|\}},
+    moredelim=[s][\ocamlstring]{\{delimiter|}{|delimiter\}},
+    keywords={[2]{val,initializer,nonrec}}, keywordstyle={[2]\ocamlkeyword},
+    belowskip=0\baselineskip
+  }
+\ifouthtml
+  \setenvclass{lstlisting}{pre caml-input}
+\else
+%not implemented in hevea: upquote and literate
+  \lstset{
+    upquote=true,
+    literate={'"'}{\textquotesingle "\textquotesingle}3
+    {'\\"'}{\textquotesingle \textbackslash"\textquotesingle}4,
+}
+\fi
+}{}
+
+\lstnewenvironment{camlerror}{
+  \lstset{
+    escapeinside={$}{$},
+    showstringspaces=false,
+    basicstyle=\small\ttfamily\slshape,
+    emph={Error}, emphstyle={\ocamlerror},
+  }
+\ifouthtml
+  \setenvclass{lstlisting}{pre caml-output error}
+  \lstset { basicstyle=\ttfamily }
+\else
+\lstset{upquote=true}
+\fi
+}
+{}
+
+\lstnewenvironment{camlwarn}{
+  \lstset{
+    escapeinside={$}{$},
+    showstringspaces=false,
+    basicstyle=\small\ttfamily\slshape,
+    emph={Warning}, emphstyle={\ocamlwarning},
+  }
+\ifouthtml
+\setenvclass{lstlisting}{pre caml-output warn}
+\lstset { basicstyle=\ttfamily }
+\else
+\lstset{upquote=true}
+\fi
+}{}
+
+
+
+% Add meta tag to the generated head tag
+\ifouthtml
+\let\oldmeta=\@meta
+\renewcommand{\@meta}{
+\oldmeta
+\begin{rawhtml}
+  
+\end{rawhtml}
+}
+\fi
+
+\usepackage[colorlinks,linkcolor=blue]{hyperref}
+%\makeatletter \def\@wrindex#1#2{\xdef \@indexfile{\csname #1@idxfile\endcsname}\@@wrindex#2||\\}\makeatother
+\def\th{^{\hbox{\scriptsize th}}}
+
+
+\raggedbottom
+\input{version.tex}
+%HEVEA\tocnumber
+%HEVEA\setcounter{cuttingdepth}{1}
+%HEVEA\title{The OCaml system, release \ocamlversion}
+\input{allfiles.tex}
diff --git a/manual/manual/refman/.gitignore b/manual/manual/refman/.gitignore
new file mode 100644
index 00000000..81ccbe71
--- /dev/null
+++ b/manual/manual/refman/.gitignore
@@ -0,0 +1,2 @@
+*.tex
+*.htex
diff --git a/manual/manual/refman/Makefile b/manual/manual/refman/Makefile
new file mode 100644
index 00000000..2310e992
--- /dev/null
+++ b/manual/manual/refman/Makefile
@@ -0,0 +1,35 @@
+TOPDIR = ../../..
+include $(TOPDIR)/Makefile.tools
+
+LD_PATH = "$(TOPDIR)/otherlibs/str:$(TOPDIR)/otherlibs/unix"
+
+TOOLS = ../../tools
+CAMLLATEX = $(SET_LD_PATH) \
+  $(OCAMLRUN) $(TOPDIR)/tools/caml-tex \
+  -repo-root $(TOPDIR) -n 80 -v false
+TEXQUOTE = $(OCAMLRUN) $(TOOLS)/texquote2
+TRANSF = $(SET_LD_PATH) $(OCAMLRUN) $(TOOLS)/transf
+
+
+FILES = refman.tex lex.tex names.tex values.tex const.tex types.tex \
+  patterns.tex expr.tex typedecl.tex modtypes.tex modules.tex compunit.tex \
+  exten.tex classes.tex
+
+
+etex-files: $(FILES)
+all: $(FILES)
+
+
+%.gen.tex: %.etex
+	$(CAMLLATEX) $< -o $*_camltex.tex
+	$(TRANSF) < $*_camltex.tex > $*.transf_error.tex
+	mv $*.transf_error.tex $@
+
+%.tex: %.gen.tex
+	$(TEXQUOTE) < $< > $*.texquote_error.tex
+	mv $*.texquote_error.tex $@
+
+
+.PHONY: clean
+clean:
+	rm -f *.tex
diff --git a/manual/manual/refman/classes.etex b/manual/manual/refman/classes.etex
new file mode 100644
index 00000000..2a59f949
--- /dev/null
+++ b/manual/manual/refman/classes.etex
@@ -0,0 +1,526 @@
+\section{s:classes}{Classes}
+%HEVEA\cutname{classes.html}
+Classes are defined using a small language, similar to the module
+language.
+
+\subsection{ss:classes:class-types}{Class types}
+
+Class types are the class-level equivalent of type expressions: they
+specify the general shape and type properties of classes.
+
+\ikwd{object\@\texttt{object}}
+\ikwd{end\@\texttt{end}}
+\ikwd{inherit\@\texttt{inherit}}
+\ikwd{val\@\texttt{val}}
+\ikwd{mutable\@\texttt{mutable}}
+\ikwd{method\@\texttt{method}}
+\ikwd{private\@\texttt{private}}
+\ikwd{virtual\@\texttt{virtual}|see{\texttt{val}, \texttt{method}, \texttt{class}}}
+\ikwd{constraint\@\texttt{constraint}}
+
+\begin{syntax}
+class-type:
+      [['?']label-name':'] typexpr '->' class-type
+  |   class-body-type
+;
+class-body-type:
+      'object' ['(' typexpr ')'] {class-field-spec} 'end'
+   |  ['[' typexpr {',' typexpr} ']'] classtype-path
+   |  'let' 'open' module-path 'in' class-body-type
+;
+%\end{syntax} \begin{syntax}
+class-field-spec:
+      'inherit' class-body-type
+   |  'val' ['mutable'] ['virtual'] inst-var-name ':' typexpr
+   |  'val' 'virtual' 'mutable' inst-var-name ':' typexpr
+   |  'method' ['private'] ['virtual'] method-name ':' poly-typexpr
+   |  'method' 'virtual' 'private' method-name ':' poly-typexpr
+   |  'constraint' typexpr '=' typexpr
+\end{syntax}
+See also the following language extensions:
+\hyperref[s:attributes]{attributes} and
+\hyperref[s:extension-nodes]{extension nodes}.
+
+\subsubsection*{sss:clty:simple}{Simple class expressions}
+
+The expression @classtype-path@ is equivalent to the class type bound to
+the name @classtype-path@. Similarly, the expression
+@'[' typexpr_1 ',' \ldots typexpr_n ']' classtype-path@ is equivalent to
+the parametric class type bound to the name @classtype-path@, in which
+type parameters have been instantiated to respectively @typexpr_1@,
+\ldots @typexpr_n@.
+
+\subsubsection*{sss:clty-fun}{Class function type}
+
+The class type expression @typexpr '->' class-type@ is the type of
+class functions (functions from values to classes) that take as
+argument a value of type @typexpr@ and return as result a class of
+type @class-type@.
+
+\subsubsection*{sss:clty:body}{Class body type}
+
+The class type expression
+@'object' ['(' typexpr ')'] {class-field-spec} 'end'@
+is the type of a class body. It specifies its instance variables and
+methods. In this type, @typexpr@ is matched against the self type, therefore
+providing a name for the self type.
+
+A class body will match a class body type if it provides definitions
+for all the components specified in the class body type, and these
+definitions meet the type requirements given in the class body type.
+Furthermore, all methods either virtual or public present in the class
+body must also be present in the class body type (on the other hand, some
+instance variables and concrete private methods may be omitted).  A
+virtual method will match a concrete method, which makes it possible
+to forget its implementation. An immutable instance variable will match a
+mutable instance variable.
+
+\subsubsection*{sss:clty-open}{Local opens}
+
+Local opens are supported in class types since OCaml 4.06.
+
+\subsubsection*{sss:clty-inheritance}{Inheritance}
+
+\ikwd{inherit\@\texttt{inherit}}
+
+The inheritance construct @'inherit' class-body-type@ provides for inclusion of
+methods and instance variables from other class types.
+The instance variable and method types from @class-body-type@ are added
+into the current class type.
+
+\subsubsection*{sss:clty-variable}{Instance variable specification}
+
+\ikwd{val\@\texttt{val}}
+\ikwd{mutable\@\texttt{mutable}}
+
+A specification of an instance variable is written
+@'val' ['mutable'] ['virtual'] inst-var-name ':' typexpr@, where
+@inst-var-name@
+is the name of the instance variable and @typexpr@ its expected type.
+%
+The flag @'mutable'@ indicates whether this instance variable can be
+physically modified.
+%
+The flag @'virtual'@ indicates that this instance variable is not
+initialized. It can be initialized later through inheritance.
+
+An instance variable specification will hide any previous
+specification of an instance variable of the same name.
+
+\subsubsection*{sss:clty-meth}{Method specification}
+
+\ikwd{method\@\texttt{method}}
+\ikwd{private\@\texttt{private}}
+
+The specification of a method is written
+@'method' ['private'] method-name ':' poly-typexpr@, where
+@method-name@ is the name of the method and @poly-typexpr@ its
+expected type, possibly polymorphic.  The flag @'private'@ indicates
+that the method cannot be accessed from outside the object.
+
+The polymorphism may be left implicit in public method specifications:
+any type variable which is not bound to a class parameter and does not
+appear elsewhere inside the class specification will be assumed to be
+universal, and made polymorphic in the resulting method type.
+Writing an explicit polymorphic type will disable this behaviour.
+
+If several specifications are present for the same method, they
+must have compatible types.
+Any non-private specification of a method forces it to be public.
+
+\subsubsection*{sss:class-virtual-meth-spec}{Virtual method specification}
+
+\ikwd{method\@\texttt{method}}
+\ikwd{private\@\texttt{private}}
+
+A virtual method specification is written @'method' ['private']
+'virtual' method-name ':' poly-typexpr@, where @method-name@ is the
+name of the method and @poly-typexpr@ its expected type.
+
+\subsubsection*{sss:class-constraints}{Constraints on type parameters}
+
+\ikwd{constraint\@\texttt{constraint}}
+
+The construct @'constraint' typexpr_1 '=' typexpr_2@ forces the two
+type expressions to be equal. This is typically used to specify type
+parameters: in this way, they can be bound to specific type
+expressions.
+
+\subsection{ss:class-expr}{Class expressions}
+
+Class expressions are the class-level equivalent of value expressions:
+they evaluate to classes, thus providing implementations for the
+specifications expressed in class types.
+
+\ikwd{object\@\texttt{object}}
+\ikwd{end\@\texttt{end}}
+\ikwd{fun\@\texttt{fun}}
+\ikwd{let\@\texttt{let}}
+\ikwd{and\@\texttt{and}}
+\ikwd{inherit\@\texttt{inherit}}
+\ikwd{as\@\texttt{as}}
+\ikwd{val\@\texttt{val}}
+\ikwd{mutable\@\texttt{mutable}}
+\ikwd{method\@\texttt{method}}
+\ikwd{private\@\texttt{private}}
+\ikwd{constraint\@\texttt{constraint}}
+\ikwd{initializer\@\texttt{initializer}}
+
+\begin{syntax}
+class-expr:
+      class-path
+   |  '[' typexpr {',' typexpr} ']' class-path
+   |  '(' class-expr ')'
+   |  '(' class-expr ':' class-type ')'
+   |  class-expr {{argument}}
+   |  'fun' {{parameter}} '->' class-expr
+   |  'let' ['rec'] let-binding {'and' let-binding} 'in' class-expr
+   |  'object' class-body 'end'
+   |  'let' 'open' module-path 'in' class-expr
+;
+%BEGIN LATEX
+\end{syntax} \begin{syntax}
+%END LATEX
+class-field:
+      'inherit' class-expr ['as' lowercase-ident]
+   |  'inherit!' class-expr ['as' lowercase-ident]
+   |  'val' ['mutable'] inst-var-name [':' typexpr] '=' expr
+   |  'val!' ['mutable'] inst-var-name [':' typexpr] '=' expr
+   |  'val' ['mutable'] 'virtual' inst-var-name ':' typexpr
+   |  'val' 'virtual' 'mutable' inst-var-name ':' typexpr
+   |  'method' ['private'] method-name {parameter} [':' typexpr] '=' expr
+   |  'method!' ['private'] method-name {parameter} [':' typexpr] '=' expr
+   |  'method' ['private'] method-name ':' poly-typexpr '=' expr
+   |  'method!' ['private'] method-name ':' poly-typexpr '=' expr
+   |  'method' ['private'] 'virtual' method-name ':' poly-typexpr
+   |  'method' 'virtual' 'private' method-name ':' poly-typexpr
+   |  'constraint' typexpr '=' typexpr
+   |  'initializer' expr
+\end{syntax}
+See also the following language extensions:
+\hyperref[s:locally-abstract]{locally abstract types},
+\hyperref[s:attributes]{attributes} and
+\hyperref[s:extension-nodes]{extension nodes}.
+
+\subsubsection*{sss:class-simple}{Simple class expressions}
+
+The expression @class-path@ evaluates to the class bound to the name
+@class-path@. Similarly, the expression
+@'[' typexpr_1 ',' \ldots typexpr_n ']' class-path@
+evaluates to the parametric class bound to the name @class-path@,
+in which type parameters have been instantiated respectively to
+@typexpr_1@, \ldots @typexpr_n@.
+
+The expression @'(' class-expr ')'@ evaluates to the same module as
+@class-expr@.
+
+The expression @'(' class-expr ':' class-type ')'@ checks that
+@class-type@ matches the type of @class-expr@ (that is, that the
+implementation @class-expr@ meets the type specification
+@class-type@). The whole expression evaluates to the same class as
+@class-expr@, except that all components not specified in
+@class-type@ are hidden and can no longer be accessed.
+
+\subsubsection*{sss:class-app}{Class application}
+
+Class application is denoted by juxtaposition of (possibly labeled)
+expressions. It denotes the class whose constructor is the first
+expression applied to the given arguments. The arguments are
+evaluated as for expression application, but the constructor itself will
+only be evaluated when objects are created. In particular, side-effects
+caused by the application of the constructor will only occur at object
+creation time.
+
+\subsubsection*{sss:class-fun}{Class function}
+
+The expression @'fun' [['?']label-name':']pattern '->' class-expr@ evaluates
+to a function from values to classes.
+When this function is applied to a value \var{v}, this value is
+matched against the pattern @pattern@ and the result is the result of
+the evaluation of @class-expr@ in the extended environment.
+
+Conversion from functions with default values to functions with
+patterns only works identically for class functions as for normal
+functions.
+
+The expression
+\begin{center}
+@"fun" parameter_1 \ldots parameter_n "->" class-expr@
+\end{center}
+is a short form for
+\begin{center}
+@"fun" parameter_1 "->" \ldots "fun" parameter_n "->" expr@
+\end{center}
+
+\subsubsection*{sss:class-localdefs}{Local definitions}
+
+The {\tt let} and {\tt let rec} constructs bind value names locally,
+as for the core language expressions.
+
+If a local definition occurs at the very beginning of a class
+definition, it will be evaluated when the class is created (just as if
+the definition was outside of the class).
+Otherwise, it will be evaluated when the object constructor is called.
+
+\subsubsection*{sss:class-opens}{Local opens}
+
+Local opens are supported in class expressions since OCaml 4.06.
+
+\subsubsection*{sss:class-body}{Class body}
+\begin{syntax}
+class-body:  ['(' pattern [':' typexpr] ')'] { class-field }
+\end{syntax}
+The expression
+@'object' class-body 'end'@ denotes
+a class body. This is the prototype for an object : it lists the
+instance variables and methods of an object of this class.
+
+A class body is a class value: it is not evaluated at once. Rather,
+its components are evaluated each time an object is created.
+
+In a class body, the pattern @'(' pattern [':' typexpr] ')'@ is
+matched against self, therefore providing a binding for self and self
+type.  Self can only be used in method and initializers.
+
+Self type cannot be a closed object type, so that the class remains
+extensible.
+
+Since OCaml 4.01, it is an error if the same method or instance
+variable name is defined several times in the same class body.
+
+\subsubsection*{sss:class-inheritance}{Inheritance}
+
+\ikwd{inherit\@\texttt{inherit}}
+
+The inheritance construct @'inherit' class-expr@ allows reusing
+methods and instance variables from other classes. The class
+expression @class-expr@ must evaluate to a class body.  The instance
+variables, methods and initializers from this class body are added
+into the current class.  The addition of a method will override any
+previously defined method of the same name.
+
+\ikwd{as\@\texttt{as}}
+An ancestor can be bound by appending @'as' lowercase-ident@
+to the inheritance construct.  @lowercase-ident@ is not a true
+variable and can only be used to select a method, i.e. in an expression
+@lowercase-ident '#' method-name@.  This gives access to the
+method @method-name@ as it was defined in the parent class even if it is
+redefined in the current class.
+The scope of this ancestor binding is limited to the current class.
+The ancestor method may be called from a subclass but only indirectly.
+
+\subsubsection*{sss:class-variables}{Instance variable definition}
+
+\ikwd{val\@\texttt{val}}
+\ikwd{mutable\@\texttt{mutable}}
+
+The definition @'val' ['mutable'] inst-var-name '=' expr@ adds an
+instance variable @inst-var-name@ whose initial value is the value of
+expression @expr@.
+%
+The flag @'mutable'@ allows physical modification of this variable by
+methods.
+
+An instance variable can only be used in the methods and
+initializers that follow its definition.
+
+Since version 3.10, redefinitions of a visible instance variable with
+the same name do not create a new variable, but are merged, using the
+last value for initialization.  They must have identical types and
+mutability.
+However, if an instance variable is hidden by
+omitting it from an interface, it will be kept distinct from
+other instance variables with the same name.
+
+\subsubsection*{sss:class-virtual-variable}{Virtual instance variable definition}
+
+\ikwd{val\@\texttt{val}}
+\ikwd{mutable\@\texttt{mutable}}
+
+A variable specification is written @'val' ['mutable'] 'virtual'
+inst-var-name ':' typexpr@.  It specifies whether the variable is
+modifiable, and gives its type.
+
+Virtual instance variables were added in version 3.10.
+
+\subsubsection*{sss:class-method}{Method definition}
+
+\ikwd{method\@\texttt{method}}
+\ikwd{private\@\texttt{private}}
+
+A method definition is written @'method' method-name '=' expr@.  The
+definition of a method overrides any previous definition of this
+method.  The method will be public (that is, not private) if any of
+the definition states so.
+
+A private method, @'method' 'private' method-name '=' expr@, is a
+method that can only be invoked on self (from other methods of the
+same object, defined in this class or one of its subclasses).  This
+invocation is performed using the expression
+@value-name '#' method-name@, where @value-name@ is directly bound to
+self at the beginning of the class definition.  Private methods do
+not appear in object types.  A method may have both public and private
+definitions, but as soon as there is a public one, all subsequent
+definitions will be made public.
+
+Methods may have an explicitly polymorphic type, allowing them to be
+used polymorphically in programs (even for the same object). The
+explicit declaration may be done in one of three ways: (1) by giving an
+explicit polymorphic type in the method definition, immediately after
+the method name, {\em i.e.}
+@'method' ['private'] method-name ':' {{"'" ident}} '.' typexpr '='
+expr@; (2) by a forward declaration of the explicit polymorphic type
+through a virtual method definition; (3) by importing such a
+declaration through inheritance and/or constraining the type of {\em
+self}.
+
+Some special expressions are available in method bodies for
+manipulating instance variables and duplicating self:
+\begin{syntax}
+expr:
+    \ldots
+  | inst-var-name '<-' expr
+  | '{<' [ inst-var-name '=' expr { ';' inst-var-name '=' expr } [';'] ] '>}'
+\end{syntax}
+
+The expression @inst-var-name '<-' expr@ modifies in-place the current
+object by replacing the value associated to @inst-var-name@ by the
+value of @expr@. Of course, this instance variable must have been
+declared mutable.
+
+The expression
+@'{<' inst-var-name_1 '=' expr_1 ';' \ldots ';' inst-var-name_n '=' expr_n '>}'@
+evaluates to a copy of the current object in which the values of
+instance variables @inst-var-name_1, \ldots, inst-var-name_n@ have
+been replaced by the values of the corresponding expressions @expr_1,
+\ldots, expr_n@.
+
+\subsubsection*{sss:class-virtual-meth}{Virtual method definition}
+
+\ikwd{method\@\texttt{method}}
+\ikwd{private\@\texttt{private}}
+
+A method specification is written @'method' ['private'] 'virtual'
+method-name ':' poly-typexpr@.  It specifies whether the method is
+public or private, and gives its type. If the method is intended to be
+polymorphic, the type must be explicitly polymorphic.
+
+\subsubsection*{sss:class-explicit-overriding}{Explicit overriding}
+
+Since Ocaml 3.12, the keywords @"inherit!"@, @"val!"@ and @"method!"@
+have the same semantics as @"inherit"@, @"val"@ and @"method"@, but
+they additionally require the definition they introduce to be
+overriding. Namely, @"method!"@ requires @method-name@ to be already
+defined in this class, @"val!"@ requires @inst-var-name@ to be already
+defined in this class, and @"inherit!"@ requires @class-expr@ to
+override some definitions. If no such overriding occurs, an error is
+signaled.
+
+As a side-effect, these 3 keywords avoid the warnings~7
+(method override) and~13 (instance variable override).
+Note that warning~7 is disabled by default.
+
+\subsubsection*{sss:class-type-constraints}{Constraints on type parameters}
+
+\ikwd{constraint\@\texttt{constraint}}
+The construct @'constraint' typexpr_1 '=' typexpr_2@ forces the two
+type expressions to be equals. This is typically used to specify type
+parameters: in that way they can be bound to specific type
+expressions.
+
+\subsubsection*{sss:class-initializers}{Initializers}
+
+\ikwd{initializer\@\texttt{initializer}}
+
+A class initializer @'initializer' expr@ specifies an expression that
+will be evaluated whenever an object is created from the class, once
+all its instance variables have been initialized.
+
+\subsection{ss:class-def}{Class definitions}
+\label{s:classdef}
+
+\ikwd{class\@\texttt{class}}
+\ikwd{and\@\texttt{and}}
+
+\begin{syntax}
+class-definition:
+          'class' class-binding { 'and' class-binding }
+;
+class-binding:
+          ['virtual'] ['[' type-parameters ']'] class-name
+          {parameter} [':' class-type] \\ '=' class-expr
+;
+type-parameters:
+          "'" ident { "," "'" ident }
+\end{syntax}
+
+A class definition @'class' class-binding { 'and' class-binding }@ is
+recursive. Each @class-binding@ defines a @class-name@ that can be
+used in the whole expression except for inheritance. It can also be
+used for inheritance, but only in the definitions that follow its own.
+
+A class binding binds the class name @class-name@ to the value of
+expression @class-expr@. It also binds the class type @class-name@ to
+the type of the class, and defines two type abbreviations :
+@class-name@ and @'#' class-name@. The first one is the type of
+objects of this class, while the second is more general as it unifies
+with the type of any object belonging to a subclass (see
+section~\ref{sss:typexpr-sharp-types}).
+
+\subsubsection*{sss:class-virtual}{Virtual class}
+
+A class must be flagged virtual if one of its methods is virtual (that
+is, appears in the class type, but is not actually defined).
+Objects cannot be created from a virtual class.
+
+\subsubsection*{sss:class-type-params}{Type parameters}
+
+The class type parameters correspond to the ones of the class type and
+of the two type abbreviations defined by the class binding.  They must
+be bound to actual types in the class definition using type
+constraints.  So that the abbreviations are well-formed, type
+variables of the inferred type of the class must either be type
+parameters or be bound in the constraint clause.
+
+\subsection{ss:class-spec}{Class specifications}
+
+\ikwd{class\@\texttt{class}}
+\ikwd{and\@\texttt{and}}
+
+\begin{syntax}
+class-specification:
+           'class' class-spec { 'and' class-spec }
+;
+class-spec:
+           ['virtual'] ['[' type-parameters ']'] class-name ':'
+           class-type
+\end{syntax}
+
+This is the counterpart in signatures of class definitions.
+A class specification matches a class definition if they have the same
+type parameters and their types match.
+
+\subsection{ss:classtype}{Class type definitions}
+
+\ikwd{class\@\texttt{class}}
+\ikwd{type\@\texttt{type}}
+\ikwd{and\@\texttt{and}}
+
+\begin{syntax}
+classtype-definition:
+           'class' 'type' classtype-def
+                  { 'and' classtype-def }
+;
+classtype-def:
+    ['virtual'] ['[' type-parameters ']'] class-name '=' class-body-type
+\end{syntax}
+
+A class type definition @'class' class-name '=' class-body-type@
+defines an abbreviation @class-name@ for the class body type
+@class-body-type@.  As for class definitions, two type abbreviations
+@class-name@ and @'#' class-name@ are also defined. The definition can
+be parameterized by some type parameters. If any method in the class
+type body is virtual, the definition must be flagged @'virtual'@.
+
+Two class type definitions match if they have the same type parameters
+and they expand to matching types.
diff --git a/manual/manual/refman/compunit.etex b/manual/manual/refman/compunit.etex
new file mode 100644
index 00000000..2e85f890
--- /dev/null
+++ b/manual/manual/refman/compunit.etex
@@ -0,0 +1,41 @@
+\section{s:compilation-units}{Compilation units}
+%HEVEA\cutname{compunit.html}
+
+\begin{syntax}
+unit-interface: { specification [';;'] }
+;
+unit-implementation: [ module-items ]
+\end{syntax}
+
+Compilation units bridge the module system and the separate
+compilation system. A compilation unit is composed of two parts: an
+interface and an implementation. The interface contains a sequence of
+specifications, just as the inside of a @'sig' \ldots 'end'@
+signature expression. The implementation contains a sequence of
+definitions and expressions, just as the inside of a
+@'struct' \ldots 'end'@ module
+expression. A compilation unit also has a name @unit-name@, derived
+from the names of the files containing the interface and the
+implementation (see chapter~\ref{c:camlc} for more details). A
+compilation unit behaves roughly as the module definition
+\begin{center}
+@'module' unit-name ':' 'sig' unit-interface 'end' '='
+ 'struct' unit-implementation 'end'@
+\end{center}
+
+A compilation unit can refer to other compilation units by their
+names, as if they were regular modules. For instance, if "U" is a
+compilation unit that defines a type "t", other compilation units can
+refer to that type under the name "U.t"; they can also refer to "U" as
+a whole structure. Except for names of other compilation units, a unit
+interface or unit implementation must not have any other free variables.
+In other terms, the type-checking and compilation of an interface or
+implementation proceeds in the initial environment
+\begin{center}
+@name_1 ':' 'sig' specification_1 'end' \ldots
+ name_n ':' 'sig' specification_n 'end'@
+\end{center}
+where @name_1 \ldots name_n@ are the names of the other
+compilation units available in the search path (see
+chapter~\ref{c:camlc} for more details) and @specification_1 \ldots
+specification_n@ are their respective interfaces.
diff --git a/manual/manual/refman/const.etex b/manual/manual/refman/const.etex
new file mode 100644
index 00000000..eca507ed
--- /dev/null
+++ b/manual/manual/refman/const.etex
@@ -0,0 +1,36 @@
+\section{s:const}{Constants}
+%HEVEA\cutname{const.html}
+
+\ikwd{false\@\texttt{false}}
+\ikwd{true\@\texttt{true}}
+\ikwd{begin\@\texttt{begin}}
+\ikwd{end\@\texttt{end}}
+
+\begin{syntax}
+constant:
+    integer-literal
+  | int32-literal
+  | int64-literal
+  | nativeint-literal
+  | float-literal
+  | char-literal
+  | string-literal
+  | constr
+  | "false"
+  | "true"
+  | "("")"
+  | "begin" "end"
+  | "[""]"
+  | "[|""|]"
+  | "`"tag-name
+\end{syntax}
+See also the following language extension:
+\hyperref[ss:extension-literals]{extension literals}.
+
+The syntactic class of constants comprises literals from the four
+base types (integers, floating-point numbers, characters, character
+strings), the integer variants, and constant constructors
+from both normal and polymorphic variants, as well as the special
+constants @"false"@, @"true"@, @"("")"@,
+@"[""]"@, and @"[|""|]"@, which behave like constant constructors, and
+@"begin" "end"@, which is equivalent to @'('')'@.
diff --git a/manual/manual/refman/expr.etex b/manual/manual/refman/expr.etex
new file mode 100644
index 00000000..c51827c0
--- /dev/null
+++ b/manual/manual/refman/expr.etex
@@ -0,0 +1,1017 @@
+\section{s:value-expr}{Expressions}
+%HEVEA\cutname{expr.html}
+\ikwd{in\@\texttt{in}|see{\texttt{let}}}
+\ikwd{and\@\texttt{and}}
+\ikwd{rec\@\texttt{rec}|see{\texttt{let}, \texttt{module}}}
+\ikwd{let\@\texttt{let}}
+\ikwd{try\@\texttt{try}}
+\ikwd{function\@\texttt{function}}
+\ikwd{fun\@\texttt{fun}}
+\ikwd{with\@\texttt{with}}
+\ikwd{done\@\texttt{done}|see{\texttt{while}, \texttt{for}}}
+\ikwd{do\@\texttt{do}|see{\texttt{while}, \texttt{for}}}
+\ikwd{downto\@\texttt{downto}|see{\texttt{for}}}
+\ikwd{to\@\texttt{to}|see{\texttt{for}}}
+\ikwd{for\@\texttt{for}}
+\ikwd{else\@\texttt{else}|see{\texttt{if}}}
+\ikwd{then\@\texttt{then}|see{\texttt{if}}}
+\ikwd{if\@\texttt{if}}
+\ikwd{or\@\texttt{or}}
+\ikwd{match\@\texttt{match}}
+\ikwd{begin\@\texttt{begin}}
+\ikwd{end\@\texttt{end}}
+\ikwd{when\@\texttt{when}}
+\ikwd{new\@\texttt{new}}
+\ikwd{object\@\texttt{object}}
+\ikwd{lazy\@\texttt{lazy}}
+
+\begin{syntax}
+expr:
+    value-path
+  | constant
+  | '(' expr ')'
+  | 'begin' expr 'end'
+  | '(' expr ':' typexpr ')'
+  | expr {{',' expr}}
+  | constr expr
+  | "`"tag-name expr
+  | expr '::' expr
+  | '[' expr { ';' expr } [';'] ']'
+  | '[|' expr { ';' expr } [';'] '|]'
+  | '{' field [':' typexpr] ['=' expr]%
+    { ';' field [':' typexpr] ['=' expr] } [';'] '}'
+  | '{' expr 'with' field [':' typexpr] ['=' expr]%
+    { ';' field [':' typexpr] ['=' expr] } [';'] '}'
+  | expr {{ argument }}
+  | prefix-symbol expr
+  | '-' expr
+  | '-.' expr
+  | expr infix-op expr
+  | expr '.' field
+  | expr '.' field '<-' expr
+  | expr '.(' expr ')'
+  | expr '.(' expr ')' '<-' expr
+  | expr '.[' expr ']'
+  | expr '.[' expr ']' '<-' expr
+  | 'if' expr 'then' expr [ 'else' expr ]
+  | 'while' expr 'do' expr 'done'
+  | 'for' value-name '=' expr ( 'to' || 'downto' ) expr 'do' expr 'done'
+  | expr ';' expr
+  | 'match' expr 'with' pattern-matching
+  | 'function' pattern-matching
+  | 'fun' {{ parameter }} [ ':' typexpr ] '->' expr
+  | 'try' expr 'with' pattern-matching
+  | 'let' ['rec'] let-binding { 'and' let-binding } 'in' expr
+  | "let" "exception" constr-decl "in" expr
+  | 'let' 'module' module-name { '(' module-name ':' module-type ')' }
+    [ ':' module-type ] \\ '=' module-expr 'in' expr
+  | '(' expr ':>' typexpr ')'
+  | '(' expr ':' typexpr ':>' typexpr ')'
+  | 'assert' expr
+  | 'lazy' expr
+  | local-open
+  | object-expr
+;
+%BEGIN LATEX
+\end{syntax} \begin{syntax}
+%END LATEX
+argument:
+    expr
+  | '~' label-name
+  | '~' label-name ':' expr
+  | '?' label-name
+  | '?' label-name ':' expr
+;
+%\end{syntax} \begin{syntax}
+pattern-matching:
+    [ '|' ] pattern ['when' expr] '->' expr
+    { '|' pattern ['when' expr] '->' expr }
+;
+let-binding:
+    pattern '=' expr
+  | value-name { parameter } [':' typexpr] [':>' typexpr] '=' expr
+  | value-name ':' poly-typexpr '=' expr %since 3.12
+;
+parameter:
+    pattern
+  | '~' label-name
+  | '~' '(' label-name [':' typexpr] ')'
+  | '~' label-name ':' pattern
+  | '?' label-name
+  | '?' '(' label-name [':' typexpr] ['=' expr] ')'
+  | '?' label-name ':' pattern
+  | '?' label-name ':' '(' pattern [':' typexpr] ['=' expr] ')'
+;
+local-open:
+  | "let" "open" module-path "in" expr
+  | module-path '.(' expr ')'
+  | module-path '.[' expr ']'
+  | module-path '.[|' expr '|]'
+  | module-path '.{' expr '}'
+  | module-path '.{<' expr '>}'
+;
+object-expr:
+  | 'new' class-path
+  | 'object' class-body 'end'
+  | expr '#' method-name
+  | inst-var-name
+  | inst-var-name '<-' expr
+  | '{<' [ inst-var-name ['=' expr] { ';' inst-var-name ['=' expr] } [';'] ] '>}'
+\end{syntax}
+See also the following language extensions:
+\hyperref[s:first-class-modules]{first-class modules},
+\hyperref[s:explicit-overriding-open]{overriding in open statements},
+\hyperref[s:bigarray-access]{syntax for Bigarray access},
+\hyperref[s:attributes]{attributes},
+\hyperref[s:extension-nodes]{extension nodes} and
+\hyperref[s:index-operators]{extended indexing operators}.
+
+\subsection{ss:precedence-and-associativity}{Precedence and associativity}
+The table below shows the relative precedences and associativity of
+operators and non-closed constructions. The constructions with higher
+precedence come first. For infix and prefix symbols, we write
+``"*"\ldots'' to mean ``any symbol starting with "*"''.
+% Note that this table is duplicated in stdlib/ocaml_operators.mld,
+% these tables should be kept in sync with the one below.
+\ikwd{or\@\texttt{or}}%
+\ikwd{if\@\texttt{if}}%
+\ikwd{fun\@\texttt{fun}}%
+\ikwd{function\@\texttt{function}}%
+\ikwd{match\@\texttt{match}}%
+\ikwd{try\@\texttt{try}}%
+\ikwd{let\@\texttt{let}}%
+\ikwd{mod\@\texttt{mod}}
+\ikwd{land\@\texttt{land}}
+\ikwd{lor\@\texttt{lor}}
+\ikwd{lxor\@\texttt{lxor}}
+\ikwd{lsl\@\texttt{lsl}}
+\ikwd{lsr\@\texttt{lsr}}
+\ikwd{asr\@\texttt{asr}}
+\begin{tableau}{|l|l|}{Construction or operator}{Associativity}
+\entree{prefix-symbol}{--}
+\entree{".   .(   .[   .{" (see section~\ref{s:bigarray-access})}{--}
+\entree{"#"\ldots}{left}
+\entree{function application, constructor application, tag
+        application, "assert",
+        "lazy"}{left}
+\entree{"-   -." (prefix)}{--}
+\entree{"**"\ldots"   lsl   lsr   asr"}{right}
+\entree{"*"\ldots"   /"\ldots"   %"\ldots"   mod   land   lor   lxor"}{left}
+ %% "`"@ident@"`"
+\entree{"+"\ldots"   -"\ldots}{left}
+\entree{"::"}{right}
+\entree{{\tt \char64}\ldots "   ^"\ldots}{right}
+\entree{"="\ldots"   <"\ldots"   >"\ldots"   |"\ldots"   &"\ldots"   $"\ldots"   !="}{left}
+\entree{"&   &&"}{right}
+\entree{"or  ||"}{right}
+\entree{","}{--}
+\entree{"<-   :="}{right}
+\entree{"if"}{--}
+\entree{";"}{right}
+\entree{"let  match  fun  function  try"}{--}
+\end{tableau}
+
+\subsection{ss:expr-basic}{Basic expressions}
+
+\subsubsection*{sss:expr-constants}{Constants}
+
+An expression consisting in a constant evaluates to this constant.
+
+\subsubsection*{sss:expr-var}{Value paths}
+
+An expression consisting in an access path evaluates to the value bound to
+this path in the current evaluation environment. The path can
+be either a value name or an access path to a value component of a module.
+
+\subsubsection*{sss:expr-parenthesized}{Parenthesized expressions}
+\ikwd{begin\@\texttt{begin}}
+\ikwd{end\@\texttt{end}}
+
+The expressions @'(' expr ')'@ and @'begin' expr 'end'@ have the same
+value as @expr@. The two constructs are semantically equivalent, but it
+is good style to use @'begin' \ldots 'end'@ inside control structures:
+\begin{alltt}
+        if \ldots then begin \ldots ; \ldots end else begin \ldots ; \ldots end
+\end{alltt}
+and @'(' \ldots ')'@ for the other grouping situations.
+
+Parenthesized expressions can contain a type constraint, as in @'('
+expr ':' typexpr ')'@. This constraint forces the type of @expr@ to be
+compatible with @typexpr@.
+
+Parenthesized expressions can also contain coercions
+@'(' expr [':' typexpr] ':>' typexpr')'@ (see
+subsection~\ref{ss:expr-coercions} below).
+
+
+\subsubsection*{sss:expr-functions-application}{Function application}
+
+Function application is denoted by juxtaposition of (possibly labeled)
+expressions. The expression @expr argument_1 \ldots argument_n@
+evaluates the expression @expr@ and those appearing in @argument_1@
+to @argument_n@. The expression @expr@ must evaluate to a
+functional value $f$, which is then applied to the values of
+@argument_1, \ldots, argument_n@.
+
+The order in which the expressions @expr, argument_1, \ldots,
+argument_n@ are evaluated is not specified.
+
+Arguments and parameters are matched according to their respective
+labels. Argument order is irrelevant, except among arguments with the
+same label, or no label.
+
+If a parameter is specified as optional (label prefixed by @"?"@) in the
+type of @expr@, the corresponding argument will be automatically
+wrapped with the constructor "Some", except if the argument itself is
+also prefixed by @"?"@, in which case it is passed as is.
+%
+If a non-labeled argument is passed, and its corresponding parameter
+is preceded by one or several optional parameters, then these
+parameters are {\em defaulted}, {\em i.e.} the value "None" will be
+passed for them.
+%
+All other missing parameters (without corresponding argument), both
+optional and non-optional, will be kept, and the result of the
+function will still be a function of these missing parameters to the
+body of $f$.
+
+As a special case, if the function has a known arity, all the
+arguments are unlabeled, and their number matches the number of
+non-optional parameters, then labels are ignored and non-optional
+parameters are matched in their definition order. Optional arguments
+are defaulted.
+
+In all cases but exact match of order and labels, without optional
+parameters, the function type should be known at the application
+point.  This can be ensured by adding a type constraint.  Principality
+of the derivation can be checked in the "-principal" mode.
+
+\subsubsection*{sss:expr-function-definition}{Function definition}
+
+Two syntactic forms are provided to define functions. The first form
+is introduced by the keyword "function":
+\ikwd{function\@\texttt{function}}
+
+$$\begin{array}{rlll}
+\token{function} & \textsl{pattern}_1 & \token{->} & \textsl{expr}_1 \\
+\token{|}   & \ldots \\
+\token{|}   & \textsl{pattern}_n & \token{->} & \textsl{expr}_n
+\end{array}$$
+This expression evaluates to a functional value with one argument.
+When this function is applied to a value \var{v}, this value is
+matched against each pattern @pattern_1@ to @pattern_n@.
+If one of these matchings succeeds, that is, if the value \var{v}
+matches the pattern @pattern_i@ for some \var{i},
+then the expression @expr_i@ associated to the selected pattern
+is evaluated, and its value becomes the value of the function
+application. The evaluation of @expr_i@ takes place in an
+environment enriched by the bindings performed during the matching.
+
+If several patterns match the argument \var{v}, the one that occurs
+first in the function definition is selected. If none of the patterns
+matches the argument, the exception "Match_failure" is raised.
+%
+\index{Matchfailure\@\verb`Match_failure`}
+
+\medskip
+
+The other form of function definition is introduced by the keyword "fun":
+\ikwd{fun\@\texttt{fun}}
+\begin{center}
+@"fun" parameter_1 \ldots parameter_n "->" expr@
+\end{center}
+This expression is equivalent to:
+\begin{center}
+@"fun" parameter_1 "->" \ldots "fun" parameter_n "->" expr@
+\end{center}
+
+An optional type constraint @typexpr@ can be added before "->" to enforce
+the type of the result to be compatible with the constraint @typexpr@:
+\begin{center}
+@"fun" parameter_1 \ldots parameter_n ":" typexpr "->" expr@
+\end{center}
+is equivalent to
+\begin{center}
+  @"fun" parameter_1 "->" \ldots "fun" parameter_n "->" %
+  (expr ":" typexpr )@
+\end{center}
+Beware of the small syntactic difference between a type constraint on
+the last parameter
+\begin{center}
+  @"fun" parameter_1 \ldots (parameter_n":"typexpr)"->" expr @
+\end{center}
+and one on the result
+\begin{center}
+  @"fun" parameter_1 \ldots parameter_n":" typexpr "->" expr @
+\end{center}
+
+The parameter patterns @"~"lab@ and @"~("lab [":" typ]")"@
+are shorthands for respectively @"~"lab":"lab@ and
+@"~"lab":("lab [":" typ]")"@, and similarly for their optional
+counterparts.
+
+A function of the form @"fun" "?" lab ":(" pattern '=' expr_0 ')' '->'
+expr@ is equivalent to
+\begin{center}
+@"fun" "?" lab ":" ident '->'
+  "let" pattern '='
+    "match" ident "with" "Some" ident "->" ident '|' "None" '->' expr_0
+  "in" expr@
+\end{center}
+where @ident@
+is a fresh variable, except that it is unspecified when @expr_0@ is evaluated.
+
+After these two transformations, expressions are of the form
+\begin{center}
+@"fun" [label_1] pattern_1 "->" \ldots "fun" [label_n] pattern_n "->" expr@
+\end{center}
+If we ignore labels, which will only be meaningful at function
+application, this is equivalent to
+\begin{center}
+@"function" pattern_1 "->" \ldots "function" pattern_n "->" expr@
+\end{center}
+That is, the @"fun"@ expression above evaluates to a curried function
+with \var{n} arguments: after applying this function $n$ times to the
+values @@v@_1 \ldots @v@_n@, the values will be matched
+in parallel against the patterns @pattern_1 \ldots pattern_n@.
+If the matching succeeds, the function returns the value of @expr@ in
+an environment enriched by the bindings performed during the matchings.
+If the matching fails, the exception "Match_failure" is raised.
+
+\subsubsection*{sss:guards-in-pattern-matchings}{Guards in pattern-matchings}
+
+\ikwd{when\@\texttt{when}}
+The cases of a pattern matching (in the @"function"@, @"match"@ and
+@"try"@ constructs) can include guard expressions, which are
+arbitrary boolean expressions that must evaluate to "true" for the
+match case to be selected. Guards occur just before the @"->"@ token and
+are introduced by the @"when"@ keyword:
+
+$$\begin{array}{rlll}
+\token{function} & \nt{pattern}_1 \; [\token{when} \; \nt{cond}_1] & \token{->} & \nt{expr}_1 \\
+\token{|}   & \ldots \\
+\token{|}   & \nt{pattern}_n  \; [\token{when} \; \nt{cond}_n] & \token{->} & \nt{expr}_n
+\end{array}$$
+
+
+Matching proceeds as described before, except that if the value
+matches some pattern @pattern_i@ which has a guard @@cond@_i@, then the
+expression @@cond@_i@ is evaluated (in an environment enriched by the
+bindings performed during matching). If @@cond@_i@ evaluates to "true",
+then @expr_i@ is evaluated and its value returned as the result of the
+matching, as usual. But if @@cond@_i@ evaluates to "false", the matching
+is resumed against the patterns following @pattern_i@.
+
+\subsubsection*{sss:expr-localdef}{Local definitions}
+
+\ikwd{let\@\texttt{let}}
+
+The @"let"@ and @"let" "rec"@ constructs bind value names locally.
+The construct
+\begin{center}
+@"let" pattern_1 "=" expr_1 "and" \ldots "and" pattern_n "=" expr_n "in" expr@
+\end{center}
+evaluates @expr_1 \ldots expr_n@ in some unspecified order and matches
+their values against the patterns @pattern_1 \ldots pattern_n@. If the
+matchings succeed, @expr@ is evaluated in the environment enriched by
+the bindings performed during matching, and the value of @expr@ is
+returned as the value of the whole @"let"@ expression. If one of the
+matchings fails, the exception "Match_failure" is raised.
+%
+\index{Matchfailure\@\verb`Match_failure`}
+
+An alternate syntax is provided to bind variables to functional
+values: instead of writing
+\begin{center}
+@"let" ident "=" "fun" parameter_1 \ldots parameter_m "->" expr@
+\end{center}
+in a @"let"@ expression, one may instead write
+\begin{center}
+@"let" ident parameter_1 \ldots parameter_m "=" expr@
+\end{center}
+
+\medskip
+\noindent
+Recursive definitions of names are introduced by @"let" "rec"@:
+\begin{center}
+@"let" "rec" pattern_1 "=" expr_1 "and" \ldots "and" pattern_n "=" expr_n
+       "in" expr@
+\end{center}
+The only difference with the @"let"@ construct described above is
+that the bindings of names to values performed by the
+pattern-matching are considered already performed when the expressions
+@expr_1@ to @expr_n@ are evaluated. That is, the expressions @expr_1@
+to @expr_n@ can reference identifiers that are bound by one of the
+patterns @pattern_1, \ldots, pattern_n@, and expect them to have the
+same value as in @expr@, the body of the @"let" "rec"@ construct.
+
+The recursive definition is guaranteed to behave as described above if
+the expressions @expr_1@ to @expr_n@ are function definitions
+(@"fun" \ldots@ or @"function" \ldots@), and the patterns @pattern_1
+\ldots pattern_n@ are just value names, as in:
+\begin{center}
+@"let" "rec" name_1 "=" "fun" \ldots
+"and" \ldots
+"and" name_n "=" "fun" \ldots
+"in" expr@
+\end{center}
+This defines @name_1 \ldots name_n@ as mutually recursive functions
+local to @expr@.
+
+The behavior of other forms of @"let" "rec"@ definitions is
+implementation-dependent. The current implementation also supports
+a certain class of recursive definitions of non-functional values,
+as explained in section~\ref{s:letrecvalues}.
+\subsubsection{sss:expr-explicit-polytype}{Explicit polymorphic type annotations}
+(Introduced in OCaml 3.12)
+
+Polymorphic type annotations in @"let"@-definitions behave in a way
+similar to polymorphic methods:
+
+\begin{center}
+@"let" pattern_1 ":" typ_1 \ldots typ_n "." typeexpr "=" expr  @
+\end{center}
+
+These annotations explicitly require the defined value to be polymorphic,
+and allow one to use this polymorphism in recursive occurrences
+(when using @"let" "rec"@). Note however that this is a normal polymorphic
+type, unifiable with any instance of itself.
+
+It is possible to define local exceptions in expressions:
+@ "let" exception constr-decl "in" expr @ .
+The syntactic scope of the exception constructor is the inner
+expression, but nothing prevents exception values created with this
+constructor from escaping this scope.  Two executions of the definition
+above result in two incompatible exception constructors (as for any
+exception definition). For instance, the following assertion is
+true:
+\begin{verbatim}
+  let gen () = let exception A in A
+  let () = assert(gen () <> gen ())
+\end{verbatim}
+
+\subsection{ss:expr-control}{Control structures}
+
+\subsubsection*{sss:expr-sequence}{Sequence}
+
+The expression @expr_1 ";" expr_2@ evaluates @expr_1@ first, then
+@expr_2@, and returns the value of @expr_2@.
+
+\subsubsection*{sss:expr-conditional}{Conditional}
+\ikwd{if\@\texttt{if}}
+
+The expression @"if" expr_1 "then" expr_2 "else" expr_3@ evaluates to
+the value of @expr_2@ if @expr_1@ evaluates to the boolean @"true"@,
+and to the value of @expr_3@ if @expr_1@ evaluates to the boolean
+@"false"@.
+
+The @"else" expr_3@ part can be omitted, in which case it defaults to
+@"else" "()"@.
+
+\subsubsection*{sss:expr-case}{Case expression}\ikwd{match\@\texttt{match}}
+
+The expression
+$$\begin{array}{rlll}
+\token{match} & \textsl{expr} \\
+\token{with} & \textsl{pattern}_1 & \token{->} & \textsl{expr}_1 \\
+\token{|}     & \ldots \\
+\token{|}     & \textsl{pattern}_n & \token{->} & \textsl{expr}_n
+\end{array}$$
+matches the value of @expr@ against the patterns @pattern_1@ to
+@pattern_n@. If the matching against @pattern_i@ succeeds, the
+associated expression @expr_i@ is evaluated, and its value becomes the
+value of the whole @'match'@ expression. The evaluation of
+@expr_i@ takes place in an environment enriched by the bindings
+performed during matching. If several patterns match the value of
+@expr@, the one that occurs first in the @'match'@ expression is
+selected. If none of the patterns match the value of @expr@, the
+exception "Match_failure" is raised.
+%
+\index{Matchfailure\@\verb`Match_failure`}
+
+\subsubsection*{sss:expr-boolean-operators}{Boolean operators}
+
+The expression @expr_1 '&&' expr_2@ evaluates to @'true'@ if both
+@expr_1@ and @expr_2@ evaluate to @'true'@; otherwise, it evaluates to
+@'false'@. The first component, @expr_1@, is evaluated first. The
+second component, @expr_2@, is not evaluated if the first component
+evaluates to @'false'@. Hence, the expression @expr_1 '&&' expr_2@ behaves
+exactly as
+\begin{center}
+@'if' expr_1 'then' expr_2 'else' 'false'@.
+\end{center}
+
+The expression @expr_1 '||' expr_2@ evaluates to @'true'@ if one of
+the expressions
+@expr_1@ and @expr_2@ evaluates to @'true'@; otherwise, it evaluates to
+@'false'@. The first component, @expr_1@, is evaluated first. The
+second component, @expr_2@, is not evaluated if the first component
+evaluates to @'true'@. Hence, the expression @expr_1 '||' expr_2@ behaves
+exactly as
+\begin{center}
+@'if' expr_1 'then' 'true' 'else' expr_2@.
+\end{center}
+
+\ikwd{or\@\texttt{or}}
+The boolean operators @'&'@ and @'or'@ are deprecated synonyms for
+(respectively) @'&&'@ and @'||'@.
+
+\subsubsection*{sss:expr-loops}{Loops}
+
+\ikwd{while\@\texttt{while}}
+The expression @'while' expr_1 'do' expr_2 'done'@ repeatedly
+evaluates @expr_2@ while @expr_1@ evaluates to @'true'@. The loop
+condition @expr_1@ is evaluated and tested at the beginning of each
+iteration. The whole @'while' \ldots 'done'@ expression evaluates to
+the unit value @'()'@.
+
+\ikwd{for\@\texttt{for}}
+The expression @'for' name '=' expr_1 'to' expr_2 'do' expr_3 'done'@
+first evaluates the expressions @expr_1@ and @expr_2@ (the boundaries)
+into integer values \var{n} and \var{p}. Then, the loop body @expr_3@ is
+repeatedly evaluated in an environment where @name@ is successively
+bound to the values
+   $n$, $n+1$, \ldots, $p-1$, $p$.
+   The loop body is never evaluated if $n > p$.
+
+
+The expression @'for' name '=' expr_1 'downto' expr_2 'do' expr_3 'done'@
+evaluates similarly, except that @name@ is successively bound to the values
+   $n$, $n-1$, \ldots, $p+1$, $p$.
+   The loop body is never evaluated if $n < p$.
+
+
+In both cases, the whole @'for'@ expression evaluates to the unit
+value @'()'@.
+
+\subsubsection*{sss:expr-exception-handling}{Exception handling}
+\ikwd{try\@\texttt{try}}
+
+The expression
+$$\begin{array}{rlll}
+\token{try~} & \textsl{expr} \\
+\token{with} & \textsl{pattern}_1 & \token{->} & \textsl{expr}_1 \\
+\token{|}   & \ldots \\
+\token{|}   & \textsl{pattern}_n & \token{->} & \textsl{expr}_n
+\end{array}$$
+evaluates the expression @expr@ and returns its value if the
+evaluation of @expr@ does not raise any exception. If the evaluation
+of @expr@ raises an exception, the exception value is matched against
+the patterns @pattern_1@ to @pattern_n@. If the matching against
+@pattern_i@ succeeds, the associated expression @expr_i@ is evaluated,
+and its value becomes the value of the whole @'try'@ expression. The
+evaluation of @expr_i@ takes place in an environment enriched by the
+bindings performed during matching. If several patterns match the value of
+@expr@, the one that occurs first in the @'try'@ expression is
+selected. If none of the patterns matches the value of @expr@, the
+exception value is raised again, thereby transparently ``passing
+through'' the @'try'@ construct.
+
+\subsection{ss:expr-ops-on-data}{Operations on data structures}
+
+\subsubsection*{sss:expr-products}{Products}
+
+The expression @expr_1 ',' \ldots ',' expr_n@ evaluates to the
+\var{n}-tuple of the values of expressions @expr_1@ to @expr_n@. The
+evaluation order of the subexpressions is not specified.
+
+\subsubsection*{sss:expr-variants}{Variants}
+
+The expression @constr expr@ evaluates to the unary variant value
+whose constructor is @constr@, and whose argument is the value of
+@expr@. Similarly, the expression @constr '(' expr_1 ',' \ldots ','
+expr_n ')'@ evaluates to the n-ary variant value whose constructor is
+@constr@ and whose arguments are the values of @expr_1, \ldots,
+expr_n@.
+
+The expression @constr '('expr_1, \ldots, expr_n')'@ evaluates to the
+variant value whose constructor is @constr@, and whose arguments are
+the values of @expr_1 \ldots expr_n@.
+
+For lists, some syntactic sugar is provided. The expression
+@expr_1 '::' expr_2@ stands for the constructor @'(' '::' ')' @
+applied to the arguments @'(' expr_1 ',' expr_2 ')'@, and therefore
+evaluates to the list whose head is the value of @expr_1@ and whose tail
+is the value of @expr_2@. The expression @'[' expr_1 ';' \ldots ';'
+expr_n ']'@ is equivalent to @expr_1 '::' \ldots '::' expr_n '::'
+'[]'@, and therefore evaluates to the list whose elements are the
+values of @expr_1@ to @expr_n@.
+
+\subsubsection*{sss:expr-polyvars}{Polymorphic variants}
+
+The expression @"`"tag-name expr@ evaluates to the polymorphic variant
+value whose tag is @tag-name@, and whose argument is the value of @expr@.
+
+\subsubsection*{sss:expr-records}{Records}
+
+The expression @'{' field_1 ['=' expr_1] ';' \ldots ';' field_n ['='
+expr_n ']}'@ evaluates to the record value
+$\{ field_1 = v_1; \ldots; field_n = v_n \}$
+where $v_i$ is the value of @expr_i@ for \fromoneto{i}{n}.
+A single identifier @field_k@ stands for @field_k '=' field_k@,
+and a qualified identifier @module-path '.' field_k@ stands for
+@module-path '.' field_k '=' field_k@.
+The fields @field_1@ to @field_n@ must all belong to the same record
+type; each field of this record type must appear exactly
+once in the record expression, though they can appear in any
+order. The order in which @expr_1@ to @expr_n@ are evaluated is not
+specified. Optional type constraints can be added after each field
+@'{' field_1 ':' typexpr_1 '=' expr_1 ';'%
+ \ldots ';' field_n ':' typexpr_n '=' expr_n '}'@
+to force the type of @field_k@ to be compatible with @typexpr_k@.
+
+The expression
+@"{" expr "with" field_1 ["=" expr_1] ";" \ldots ";" field_n ["=" expr_n] "}"@
+builds a fresh record with fields @field_1 \ldots field_n@ equal to
+@expr_1 \ldots expr_n@, and all other fields having the same value as
+in the record @expr@.  In other terms, it returns a shallow copy of
+the record @expr@, except for the fields @field_1 \ldots field_n@,
+which are initialized to @expr_1 \ldots expr_n@. As previously,
+single identifier @field_k@ stands for @field_k '=' field_k@,
+a qualified identifier @module-path '.' field_k@ stands for
+@module-path '.' field_k '=' field_k@ and it is
+possible to add an optional type constraint on each field being updated
+with
+@"{" expr "with" field_1 ':' typexpr_1 "=" expr_1 ";" %
+ \ldots ";" field_n ':' typexpr_n "=" expr_n "}"@.
+
+The expression @expr_1 '.' field@ evaluates @expr_1@ to a record
+value, and returns the value associated to @field@ in this record
+value.
+
+The expression @expr_1 '.' field '<-' expr_2@ evaluates @expr_1@ to a record
+value, which is then modified in-place by replacing the value
+associated to @field@ in this record by the value of
+@expr_2@. This operation is permitted only if @field@ has been
+declared @'mutable'@ in the definition of the record type. The whole
+expression @expr_1 '.' field '<-' expr_2@ evaluates to the unit value
+@'()'@.
+
+\subsubsection*{sss:expr-arrays}{Arrays}
+
+The expression @'[|' expr_1 ';' \ldots ';' expr_n '|]'@ evaluates to
+a \var{n}-element array, whose elements are initialized with the values of
+@expr_1@ to @expr_n@ respectively. The order in which these
+expressions are evaluated is unspecified.
+
+The expression @expr_1 '.(' expr_2 ')'@ returns the value of element
+number @expr_2@ in the array denoted by @expr_1@. The first element
+has number 0; the last element has number $n-1$, where \var{n} is the
+size of the array. The exception "Invalid_argument" is raised if the
+access is out of bounds.
+
+The expression @expr_1 '.(' expr_2 ')' '<-' expr_3@ modifies in-place
+the array denoted by @expr_1@, replacing element number @expr_2@ by
+the value of @expr_3@. The exception "Invalid_argument" is raised if
+the access is out of bounds. The value of the whole expression is @'()'@.
+
+\subsubsection*{sss:expr-strings}{Strings}
+
+The expression @expr_1 '.[' expr_2 ']'@ returns the value of character
+number @expr_2@ in the string denoted by @expr_1@. The first character
+has number 0; the last character has number $n-1$, where \var{n} is the
+length of the string. The exception "Invalid_argument" is raised if the
+access is out of bounds.
+
+The expression @expr_1 '.[' expr_2 ']' '<-' expr_3@ modifies in-place
+the string denoted by @expr_1@, replacing character number @expr_2@ by
+the value of @expr_3@. The exception "Invalid_argument" is raised if
+the access is out of bounds. The value of the whole expression is @'()'@.
+
+{\bf Note:} this possibility is offered only for backward
+compatibility with older versions of OCaml and will be removed in a
+future version. New code should use byte sequences and the "Bytes.set"
+function.
+
+\subsection{ss:expr-operators}{Operators}
+\ikwd{mod\@\texttt{mod}}
+\ikwd{land\@\texttt{land}}
+\ikwd{lor\@\texttt{lor}}
+\ikwd{lxor\@\texttt{lxor}}
+\ikwd{lsl\@\texttt{lsl}}
+\ikwd{lsr\@\texttt{lsr}}
+\ikwd{asr\@\texttt{asr}}
+
+Symbols from the class @infix-symbol@, as well as the keywords
+@"*"@, @"+"@, @"-"@, @'-.'@, @"="@, @"!="@, @"<"@, @">"@, @"or"@, @"||"@,
+@"&"@, @"&&"@, @":="@, @"mod"@, @"land"@, @"lor"@, @"lxor"@, @"lsl"@, @"lsr"@,
+and @"asr"@ can appear in infix position (between two
+expressions). Symbols from the class @prefix-symbol@, as well as
+the keywords @"-"@ and @"-."@
+can appear in prefix position (in front of an expression).
+
+Infix and prefix symbols do not have a fixed meaning: they are simply
+interpreted as applications of functions bound to the names
+corresponding to the symbols.  The expression @prefix-symbol expr@ is
+interpreted as the application @'(' prefix-symbol ')'
+expr@. Similarly, the expression @expr_1 infix-symbol expr_2@ is
+interpreted as the application @'(' infix-symbol ')' expr_1 expr_2@.
+
+The table below lists the symbols defined in the initial environment
+and their initial meaning. (See the description of the core
+library module "Stdlib" in chapter~\ref{c:corelib} for more
+details). Their meaning may be changed at any time using
+@"let" "(" infix-op ")" name_1 name_2 "=" \ldots@
+
+Note: the operators @'&&'@, @'||'@, and @'~-'@ are handled specially
+and it is not advisable to change their meaning.
+
+The keywords @'-'@ and @'-.'@ can appear both as infix and
+prefix operators. When they appear as prefix operators, they are
+interpreted respectively as the functions @'(~-)'@ and @'(~-.)'@.
+
+%% Conversely, a regular function identifier can also be used as an infix
+%% operator by enclosing it in backquotes: @expr_1 '`' ident '`' expr_2@
+%% is interpreted as the application @ident expr_1 expr_2@.
+
+\ikwd{mod\@\texttt{mod}}%
+\ikwd{land\@\texttt{land}}%
+\ikwd{lor\@\texttt{lor}}%
+\ikwd{lxor\@\texttt{lxor}}%
+\ikwd{lsl\@\texttt{lsl}}%
+\ikwd{lsr\@\texttt{lsr}}%
+\ikwd{asr\@\texttt{asr}}%
+\begin{tableau}{|l|p{12cm}|}{Operator}{Initial meaning}
+\entree{"+"}{Integer addition.}
+\entree{"-" (infix)}{Integer subtraction.}
+\entree{"~-   -" (prefix)}{Integer negation.}
+\entree{"*"}{Integer multiplication.}
+\entree{"/"}{Integer division.
+        Raise "Division_by_zero" if second argument is zero.}
+\entree{"mod"}{Integer modulus. Raise
+        "Division_by_zero" if second argument is zero.}
+\entree{"land"}{Bitwise logical ``and'' on integers.}
+\entree{"lor"}{Bitwise logical ``or'' on integers.}
+\entree{"lxor"}{Bitwise logical ``exclusive or'' on integers.}
+\entree{"lsl"}{Bitwise logical shift left on integers.}
+\entree{"lsr"}{Bitwise logical shift right on integers.}
+\entree{"asr"}{Bitwise arithmetic shift right on integers.}
+\entree{"+."}{Floating-point addition.}
+\entree{"-." (infix)}{Floating-point subtraction.}
+\entree{"~-.   -." (prefix)}{Floating-point negation.}
+\entree{"*."}{Floating-point multiplication.}
+\entree{"/."}{Floating-point division.}
+\entree{"**"}{Floating-point exponentiation.}
+\entree{{\tt\char64} }{List concatenation.}
+\entree{"^" }{String concatenation.}
+\entree{"!" }{Dereferencing (return the current
+        contents of a reference).}
+\entree{":="}{Reference assignment (update the
+        reference given as first argument with the value of the second
+        argument).}
+\entree{"=" }{Structural equality test.}
+\entree{"<>" }{Structural inequality test.}
+\entree{"==" }{Physical equality test.}
+\entree{"!=" }{Physical inequality test.}
+\entree{"<" }{Test ``less than''.}
+\entree{"<=" }{Test ``less than or equal''.}
+\entree{">" }{Test ``greater than''.}
+\entree{">=" }{Test ``greater than or equal''.}
+\entree{"&&   &"}{Boolean conjunction.}
+\entree{"||   or"}{Boolean disjunction.}
+\end{tableau}
+
+\subsection{ss:expr-obj}{Objects}  \label{s:objects}
+
+\subsubsection*{sss:expr-obj-creation}{Object creation}
+
+\ikwd{new\@\texttt{new}}
+
+When @class-path@ evaluates to a class body, @'new' class-path@
+evaluates to a new object containing the instance variables and
+methods of this class.
+
+When @class-path@ evaluates to a class function, @'new' class-path@
+evaluates to a function expecting the same number of arguments and
+returning a new object of this class.
+
+\subsubsection*{sss:expr-obj-immediate}{Immediate object creation}
+
+\ikwd{object\@\texttt{object}}
+
+Creating directly an object through the @'object' class-body 'end'@
+construct is operationally equivalent to defining locally a @'class'
+class-name '=' 'object' class-body 'end'@ ---see sections
+\ref{sss:class-body} and following for the syntax of @class-body@---
+and immediately creating a single object from it by @'new' class-name@.
+
+The typing of immediate objects is slightly different from explicitly
+defining a class in two respects. First, the inferred object type may
+contain free type variables. Second, since the class body of an
+immediate object will never be extended, its self type can be unified
+with a closed object type.
+
+\subsubsection*{sss:expr-method}{Method invocation}
+
+The expression @expr '#' method-name@ invokes the method
+@method-name@ of the object denoted by @expr@.
+
+If @method-name@ is a polymorphic method, its type should be known at
+the invocation site.  This is true for instance if @expr@ is the name
+of a fresh object (@'let' ident = 'new' class-path \dots @) or if
+there is a type constraint.  Principality of the derivation can be
+checked in the "-principal" mode.
+
+\subsubsection*{sss:expr-obj-variables}{Accessing and modifying instance variables}
+
+The instance variables of a class are visible only in the body of the
+methods defined in the same class or a class that inherits from the
+class defining the instance variables.  The expression @inst-var-name@
+evaluates to the value of the given instance variable.  The expression
+@inst-var-name '<-' expr@ assigns the value of @expr@ to the instance
+variable @inst-var-name@, which must be mutable.  The whole expression
+@inst-var-name '<-' expr@ evaluates to @"()"@.
+
+
+\subsubsection*{sss:expr-obj-duplication}{Object duplication}
+
+An object can be duplicated using the library function "Oo.copy"
+(see module \stdmoduleref{Oo}). Inside a method, the expression
+@ '{<' [inst-var-name ['=' expr] { ';' inst-var-name ['=' expr] }] '>}'@
+returns a copy of self with the given instance variables replaced by
+the values of the associated expressions. A single instance variable
+name @id@ stands for @id '=' id@. Other instance variables have the same
+value in the returned object as in self.
+
+\subsection{ss:expr-coercions}{Coercions}
+
+Expressions whose type contains object or polymorphic variant types
+can be explicitly coerced (weakened) to a supertype.
+%
+The expression @'('expr ':>' typexpr')'@ coerces the expression @expr@
+to type @typexpr@.
+%
+The expression @'('expr ':' typexpr_1 ':>' typexpr_2')'@ coerces the
+expression @expr@ from type @typexpr_1@ to type @typexpr_2@.
+
+The former operator will sometimes fail to coerce an expression @expr@
+from a type @typ_1@ to a type @typ_2@
+even if type @typ_1@ is a subtype of type
+@typ_2@: in the current implementation it only expands two levels of
+type abbreviations containing objects and/or polymorphic variants,
+keeping only recursion when it is explicit in the class type (for objects).
+As an exception to the above algorithm, if both the inferred type of @expr@
+and @typ@ are ground ({\em i.e.} do not contain type variables), the
+former operator behaves as the latter one, taking the inferred type of
+@expr@ as @typ_1@. In case of failure with the former operator,
+the latter one should be used.
+
+It is only possible to coerce an expression @expr@ from type
+@typ_1@ to type @typ_2@, if the type of @expr@ is an instance of
+@typ_1@ (like for a type annotation), and @typ_1@ is a subtype
+of @typ_2@. The type of the coerced expression is an
+instance of @typ_2@. If the types contain variables,
+they may be instantiated by the subtyping algorithm, but this is only
+done after determining whether @typ_1@ is a potential subtype of
+@typ_2@. This means that typing may fail during this latter
+unification step, even if some instance of @typ_1@ is a subtype of
+some instance of @typ_2@.
+%
+In the following paragraphs we describe the subtyping relation used.
+
+\subsubsection*{sss:expr-obj-types}{Object types}
+
+A fixed object type admits as subtype any object type that includes all
+its methods. The types of the methods shall be subtypes of those in
+the supertype. Namely,
+\begin{center}
+@ '<' met_1 ':' typ_1 ';' \dots ';' met_n ':' typ_n '>' @
+\end{center}
+is a supertype of
+\begin{center}
+@ '<' met_1 ':' typ@$'_1$@ ';' \dots ';' met_n ':' typ@$'_n$@ ';'
+met@$_{n+1}$@ ':' typ@$'_{n+1}$@ ';' \dots ';' met@$_{n+m}$@ ':' typ@$'_{n+m}$@
+~[';' '..'] '>' @
+\end{center}
+which may contain an ellipsis ".." if every @typ_i@ is a supertype of
+the corresponding @typ@$'_i$.
+
+A monomorphic method type can be a supertype of a polymorphic method
+type. Namely, if @typ@ is an instance of @typ@$'$, then @ "'"@a@_1
+\dots "'"@a@_n '.' typ@$'$ is a subtype of @typ@.
+
+Inside a class definition, newly defined types are not available for
+subtyping, as the type abbreviations are not yet completely
+defined. There is an exception for coercing @@self@@ to the (exact)
+type of its class: this is allowed if the type of @@self@@ does not
+appear in a contravariant position in the class type, {\em i.e.} if
+there are no binary methods.
+
+\subsubsection*{sss:expr-polyvar-types}{Polymorphic variant types}
+
+A polymorphic variant type @typ@ is a subtype of another polymorphic
+variant type @typ@$'$ if the upper bound of @typ@ ({\em i.e.} the
+maximum set of constructors that may appear in an instance of @typ@)
+is included in the lower bound of @typ@$'$, and the types of arguments
+for the constructors of @typ@ are subtypes of those in
+@typ@$'$. Namely,
+\begin{center}
+@ "["["<"] "`"C_1 "of" typ_1 "|" \dots "|" "`"C_n "of" typ_n "]" @
+\end{center}
+which may be a shrinkable type, is a subtype of
+\begin{center}
+@ "["[">"] "`"C_1 "of" typ@$'_1$@ "|" \dots "|" "`"C_n "of" typ@$'_n$@
+ "|" "`"C@$_{n+1}$@ "of" typ@$'_{n+1}$@ "|" \dots "|" "`"C@$_{n+m}$@ "of"
+  typ@$'_{n+m}$@ "]" @
+\end{center}
+which may be an extensible type, if every @typ_i@ is a subtype of @typ@$'_i$.
+
+\subsubsection*{sss:expr-variance}{Variance}
+
+Other types do not introduce new subtyping, but they may propagate the
+subtyping of their arguments. For instance, @typ_1 "*" typ_2@ is a
+subtype of @typ@$'_1$@ "*" typ@$'_2$ when @typ_1@ and @typ_2@ are
+respectively subtypes of @typ@$'_1$ and @typ@$'_2$.
+For function types, the relation is more subtle:
+@typ_1 "->" typ_2@ is a subtype of @typ@$'_1$@~"->" typ@$'_2$
+if @typ_1@ is a supertype of @typ@$'_1$ and @typ_2@ is a
+subtype of @typ@$'_2$. For this reason, function types are covariant in
+their second argument (like tuples), but contravariant in their first
+argument. Mutable types, like "array" or "ref" are neither covariant
+nor contravariant, they are nonvariant, that is they do not propagate
+subtyping.
+
+For user-defined types, the variance is automatically inferred: a
+parameter is covariant if it has only covariant occurrences,
+contravariant if it has only contravariant occurrences,
+variance-free if it has no occurrences, and nonvariant otherwise.
+A variance-free parameter may change freely through subtyping, it does
+not have to be a subtype or a supertype.
+%
+For abstract and private types, the variance must be given explicitly
+(see section~\ref{ss:typedefs}),
+otherwise the default is nonvariant. This is also the case for
+constrained arguments in type definitions.
+
+
+\subsection{ss:expr-other}{Other}
+
+\subsubsection*{sss:expr-assertion}{Assertion checking}
+
+
+\ikwd{assert\@\texttt{assert}}
+
+OCaml supports the @"assert"@ construct to check debugging assertions.
+The expression @"assert" expr@ evaluates the expression @expr@ and
+returns @"()"@ if @expr@ evaluates to @"true"@.  If it evaluates to
+@"false"@ the exception
+"Assert_failure" is raised with the source file name and the
+location of @expr@ as arguments.  Assertion
+checking can be turned off with the "-noassert" compiler option.  In
+this case, @expr@ is not evaluated at all.
+
+As a special case, @"assert false"@ is reduced to
+@'raise' '('@"Assert_failure ..."@')'@, which gives it a polymorphic
+type.  This means that it can be used in place of any expression (for
+example as a branch of any pattern-matching).  It also means that
+the @"assert false"@ ``assertions'' cannot be turned off by the
+"-noassert" option.
+%
+\index{Assertfailure\@\verb`Assert_failure`}
+
+\subsubsection*{sss:expr-lazy}{Lazy expressions}
+\ikwd{lazy\@\texttt{lazy}}
+
+The expression @"lazy" expr@ returns a value \var{v} of type "Lazy.t" that
+encapsulates the computation of @expr@.  The argument @expr@ is not
+evaluated at this point in the program.  Instead, its evaluation will
+be performed the first time the function "Lazy.force" is applied to the value
+\var{v}, returning the actual value of @expr@. Subsequent applications
+of "Lazy.force" to \var{v} do not evaluate @expr@ again. Applications
+of "Lazy.force" may be implicit through pattern matching (see~\ref{sss:pat-lazy}).
+
+\subsubsection*{sss:expr-local-modules}{Local modules}
+\ikwd{let\@\texttt{let}}
+\ikwd{module\@\texttt{module}}
+
+The expression
+@"let" "module" module-name "=" module-expr "in" expr@
+locally binds the module expression @module-expr@ to the identifier
+@module-name@ during the evaluation of the expression @expr@.
+It then returns the value of @expr@.  For example:
+\begin{caml_example}{verbatim}
+let remove_duplicates comparison_fun string_list =
+  let module StringSet =
+    Set.Make(struct type t = string
+                    let compare = comparison_fun end) in
+  StringSet.elements
+    (List.fold_right StringSet.add string_list StringSet.empty)
+\end{caml_example}
+
+\subsubsection*{sss:local-opens}{Local opens}
+\ikwd{let\@\texttt{let}}
+\ikwd{module\@\texttt{open}}
+
+The expressions @"let" "open" module-path "in" expr@ and
+@module-path'.('expr')'@ are strictly equivalent. These
+constructions locally open the module referred to by the module path
+@module-path@ in the respective scope of the expression @expr@.
+
+When the body of a local open expression is delimited by
+@'[' ']'@,  @'[|' '|]'@,  or @'{' '}'@, the parentheses can be omitted.
+For expression, parentheses can also be omitted for @'{<' '>}'@.
+For example, @module-path'.['expr']'@ is equivalent to
+@module-path'.(['expr'])'@, and @module-path'.[|' expr '|]'@ is
+equivalent to @module-path'.([|' expr '|])'@.
+
+%% \newpage
diff --git a/manual/manual/refman/exten.etex b/manual/manual/refman/exten.etex
new file mode 100644
index 00000000..f894ae01
--- /dev/null
+++ b/manual/manual/refman/exten.etex
@@ -0,0 +1,2757 @@
+\chapter{Language extensions} \label{c:extensions}
+%HEVEA\cutname{extn.html}
+
+This chapter describes language extensions and convenience features
+that are implemented in OCaml, but not described in the
+OCaml reference manual.
+
+
+%HEVEA\cutdef{section}
+\section{s:letrecvalues}{Recursive definitions of values}
+%HEVEA\cutname{letrecvalues.html}
+
+(Introduced in Objective Caml 1.00)
+
+As mentioned in section~\ref{sss:expr-localdef}, the @'let' 'rec'@ binding
+construct, in addition to the definition of recursive functions,
+also supports a certain class of recursive definitions of
+non-functional values, such as
+\begin{center}
+@"let" "rec" name_1 "=" "1" "::" name_2
+"and" name_2 "=" "2" "::" name_1
+"in" expr@
+\end{center}
+which binds @name_1@ to the cyclic list "1::2::1::2::"\ldots, and
+@name_2@ to the cyclic list "2::1::2::1::"\ldots
+Informally, the class of accepted definitions consists of those
+definitions where the defined names occur only inside function
+bodies or as argument to a data constructor.
+
+More precisely, consider the expression:
+\begin{center}
+@"let" "rec" name_1 "=" expr_1 "and" \ldots "and" name_n "=" expr_n "in" expr@
+\end{center}
+It will be accepted if each one of @expr_1 \ldots expr_n@ is
+statically constructive with respect to @name_1 \ldots name_n@,
+is not immediately linked to any of @name_1 \ldots name_n@,
+and is not an array constructor whose arguments have abstract type.
+
+An expression @@e@@ is said to be {\em statically constructive
+with respect to} the variables @name_1 \ldots name_n@ if at least
+one of the following conditions is true:
+\begin{itemize}
+\item @@e@@ has no free occurrence of any of @name_1 \ldots name_n@
+\item @@e@@ is a variable
+\item @@e@@ has the form @"fun" \ldots "->" \ldots@
+\item @@e@@ has the form @"function" \ldots "->" \ldots@
+\item @@e@@ has the form @"lazy" "(" \ldots ")"@
+\item @@e@@ has one of the following forms, where each one of
+  @expr_1 \ldots expr_m@ is statically constructive with respect to
+  @name_1 \ldots name_n@, and @expr_0@ is statically constructive with
+  respect to @name_1 \ldots name_n, xname_1 \ldots xname_m@:
+  \begin{itemize}
+  \item @"let" ["rec"] xname_1 "=" expr_1 "and" \ldots
+         "and" xname_m "=" expr_m "in" expr_0@
+  \item @"let" "module" \ldots "in" expr_1@
+  \item @constr "("expr_1"," \ldots "," expr_m")"@
+  \item @"`"tag-name "("expr_1"," \ldots "," expr_m")"@
+  \item @"[|" expr_1";" \ldots ";" expr_m "|]"@
+  \item @"{" field_1 "=" expr_1";" \ldots ";" field_m = expr_m "}"@
+  \item @"{" expr_1 "with" field_2 "=" expr_2";" \ldots ";"
+             field_m = expr_m "}"@ where @expr_1@ is not immediately
+             linked to @name_1 \ldots name_n@
+  \item @"(" expr_1"," \ldots "," expr_m ")"@
+  \item @expr_1";" \ldots ";" expr_m@
+  \end{itemize}
+\end{itemize}
+
+An expression @@e@@ is said to be {\em immediately linked to} the variable
+@name@ in the following cases:
+\begin{itemize}
+\item @@e@@ is @name@
+\item @@e@@ has the form @expr_1";" \ldots ";" expr_m@ where @expr_m@
+   is immediately linked to @name@
+\item @@e@@ has the form @"let" ["rec"] xname_1 "=" expr_1 "and" \ldots
+   "and" xname_m "=" expr_m "in" expr_0@ where @expr_0@ is immediately
+   linked to @name@ or to one of the @xname_i@ such that @expr_i@
+   is immediately linked to @name@.
+\end{itemize}
+
+\section{s:recursive-modules}{Recursive modules}
+\ikwd{module\@\texttt{module}}
+\ikwd{and\@\texttt{and}}
+
+(Introduced in Objective Caml 3.07)
+
+% TODO: relaxed syntax
+
+\begin{syntax}
+definition:
+        ...
+      | 'module' 'rec' module-name ':' module-type '=' module-expr \\
+        { 'and' module-name ':' module-type '=' module-expr }
+;
+specification:
+        ...
+      | 'module' 'rec' module-name ':' module-type
+                 { 'and' module-name':' module-type }
+\end{syntax}
+
+Recursive module definitions, introduced by the @"module rec"@ \ldots
+@"and"@ \ldots\ construction, generalize regular module definitions
+@'module' module-name '=' module-expr@ and module specifications
+@'module' module-name ':' module-type@ by allowing the defining
+@module-expr@ and the @module-type@ to refer recursively to the module
+identifiers being defined.  A typical example of a recursive module
+definition is:
+\begin{caml_example*}{verbatim}
+module rec A : sig
+  type t = Leaf of string | Node of ASet.t
+  val compare: t -> t -> int
+end = struct
+  type t = Leaf of string | Node of ASet.t
+  let compare t1 t2 =
+    match (t1, t2) with
+    | (Leaf s1, Leaf s2) -> Stdlib.compare s1 s2
+    | (Leaf _, Node _) -> 1
+    | (Node _, Leaf _) -> -1
+    | (Node n1, Node n2) -> ASet.compare n1 n2
+end
+and ASet
+  : Set.S with type elt = A.t
+  = Set.Make(A)
+\end{caml_example*}
+It can be given the following specification:
+\begin{caml_example*}{signature}
+module rec A : sig
+  type t = Leaf of string | Node of ASet.t
+  val compare: t -> t -> int
+end
+and ASet : Set.S with type elt = A.t
+\end{caml_example*}
+
+This is an experimental extension of OCaml: the class of
+recursive definitions accepted, as well as its dynamic semantics are
+not final and subject to change in future releases.
+
+Currently, the compiler requires that all dependency cycles between
+the recursively-defined module identifiers go through at least one
+``safe'' module.  A module is ``safe'' if all value definitions that
+it contains have function types @typexpr_1 '->' typexpr_2@.  Evaluation of a
+recursive module definition proceeds by building initial values for
+the safe modules involved, binding all (functional) values to
+@'fun' '_' '->' 'raise' @"Undefined_recursive_module".  The defining
+module expressions are then evaluated, and the initial values
+for the safe modules are replaced by the values thus computed.  If a
+function component of a safe module is applied during this computation
+(which corresponds to an ill-founded recursive definition), the
+"Undefined_recursive_module" exception is raised at runtime:
+
+\begin{caml_example}{verbatim}
+module rec M: sig val f: unit -> int end = struct let f () = N.x end
+and N:sig val x: int end = struct let x = M.f () end
+\end{caml_example}
+
+If there are no safe modules along a dependency cycle, an error is raised
+
+\begin{caml_example}{verbatim}[error]
+module rec M: sig val x: int end = struct let x = N.y end
+and N:sig val x: int val y:int end = struct let x = M.x let y = 0 end
+\end{caml_example}
+
+Note that, in the @specification@ case, the @module-type@s must be
+parenthesized if they use the @'with' mod-constraint@ construct.
+
+\section{s:private-types}{Private types}
+%HEVEA\cutname{privatetypes.html}
+\ikwd{private\@\texttt{private}}
+
+Private type declarations in module signatures, of the form
+"type t = private ...", enable libraries to
+reveal some, but not all aspects of the implementation of a type to
+clients of the library.  In this respect, they strike a middle ground
+between abstract type declarations, where no information is revealed
+on the type implementation, and data type definitions and type
+abbreviations, where all aspects of the type implementation are
+publicized.  Private type declarations come in three flavors: for
+variant and record types (section~\ref{ss:private-types-variant}),
+for type abbreviations (section~\ref{ss:private-types-abbrev}),
+and for row types (section~\ref{ss:private-rows}).
+
+\subsection{ss:private-types-variant}{Private variant and record types}
+
+
+(Introduced in Objective Caml 3.07)
+
+\begin{syntax}
+type-representation:
+          ...
+        | '=' 'private' [ '|' ] constr-decl { '|' constr-decl }
+        | '=' 'private' record-decl
+\end{syntax}
+
+Values of a variant or record type declared @"private"@
+can be de-structured normally in pattern-matching or via
+the @expr '.' field@ notation for record accesses.  However, values of
+these types cannot be constructed directly by constructor application
+or record construction.  Moreover, assignment on a mutable field of a
+private record type is not allowed.
+
+The typical use of private types is in the export signature of a
+module, to ensure that construction of values of the private type always
+go through the functions provided by the module, while still allowing
+pattern-matching outside the defining module.  For example:
+\begin{caml_example*}{verbatim}
+module M : sig
+  type t = private A | B of int
+  val a : t
+  val b : int -> t
+end = struct
+  type t = A | B of int
+  let a = A
+  let b n = assert (n > 0); B n
+end
+\end{caml_example*}
+Here, the @"private"@ declaration ensures that in any value of type
+"M.t", the argument to the "B" constructor is always a positive integer.
+
+With respect to the variance of their parameters, private types are
+handled like abstract types. That is, if a private type has
+parameters, their variance is the one explicitly given by prefixing
+the parameter by a `"+"' or a `"-"', it is invariant otherwise.
+
+\subsection{ss:private-types-abbrev}{Private type abbreviations}
+
+(Introduced in Objective Caml 3.11)
+
+\begin{syntax}
+type-equation:
+          ...
+        | '=' 'private' typexpr
+\end{syntax}
+
+Unlike a regular type abbreviation, a private type abbreviation
+declares a type that is distinct from its implementation type @typexpr@.
+However, coercions from the type to @typexpr@ are permitted.
+Moreover, the compiler ``knows'' the implementation type and can take
+advantage of this knowledge to perform type-directed optimizations.
+
+The following example uses a private type abbreviation to define a
+module of nonnegative integers:
+\begin{caml_example*}{verbatim}
+module N : sig
+  type t = private int
+  val of_int: int -> t
+  val to_int: t -> int
+end = struct
+  type t = int
+  let of_int n = assert (n >= 0); n
+  let to_int n = n
+end
+\end{caml_example*}
+The type "N.t" is incompatible with "int", ensuring that nonnegative
+integers and regular integers are not confused.  However, if "x" has
+type "N.t", the coercion "(x :> int)" is legal and returns the
+underlying integer, just like "N.to_int x".  Deep coercions are also
+supported: if "l" has type "N.t list", the coercion "(l :> int list)"
+returns the list of underlying integers, like "List.map N.to_int l"
+but without copying the list "l".
+
+Note that the coercion @"(" expr ":>" typexpr ")"@ is actually an abbreviated
+form,
+and will only work in presence of private abbreviations if neither the
+type of @expr@ nor @typexpr@ contain any type variables. If they do,
+you must use the full form @"(" expr ":" typexpr_1 ":>" typexpr_2 ")"@ where
+@typexpr_1@ is the expected type of @expr@. Concretely, this would be "(x :
+N.t :> int)" and "(l : N.t list :> int list)" for the above examples.
+
+\subsection{ss:private-rows}{Private row types}
+\ikwd{private\@\texttt{private}}
+
+(Introduced in Objective Caml 3.09)
+
+\begin{syntax}
+type-equation:
+          ...
+        | '=' 'private' typexpr
+\end{syntax}
+
+Private row types are type abbreviations where part of the
+structure of the type is left abstract. Concretely @typexpr@ in the
+above should denote either an object type or a polymorphic variant
+type, with some possibility of refinement left. If the private
+declaration is used in an interface, the corresponding implementation
+may either provide a ground instance, or a refined private type.
+\begin{caml_example*}{verbatim}
+module M : sig type c = private < x : int; .. > val o : c end =
+struct
+  class c = object method x = 3 method y = 2 end
+  let o = new c
+end
+\end{caml_example*}
+This declaration does more than hiding the "y" method, it also makes
+the type "c" incompatible with any other closed object type, meaning
+that only "o" will be of type "c". In that respect it behaves
+similarly to private record types. But private row types are
+more flexible with respect to incremental refinement. This feature can
+be used in combination with functors.
+\begin{caml_example*}{verbatim}
+module F(X : sig type c = private < x : int; .. > end) =
+struct
+  let get_x (o : X.c) = o#x
+end
+module G(X : sig type c = private < x : int; y : int; .. > end) =
+struct
+  include F(X)
+  let get_y (o : X.c) = o#y
+end
+\end{caml_example*}
+
+A polymorphic variant type [t], for example
+\begin{caml_example*}{verbatim}
+type t = [ `A of int | `B of bool ]
+\end{caml_example*}
+can be refined in two ways. A definition [u] may add new field to [t],
+and the declaration
+\begin{caml_example*}{verbatim}
+type u = private [> t]
+\end{caml_example*}
+will keep those new fields abstract. Construction of values of type
+[u] is possible using the known variants of [t], but any
+pattern-matching will require a default case to handle the potential
+extra fields. Dually, a declaration [u] may restrict the fields of [t]
+through abstraction: the declaration
+\begin{caml_example*}{verbatim}
+type v = private [< t > `A]
+\end{caml_example*}
+corresponds to private variant types. One cannot create a value of the
+private type [v], except using the constructors that are explicitly
+listed as present, "(`A n)" in this example; yet, when
+patter-matching on a [v], one should assume that any of the
+constructors of [t] could be present.
+
+Similarly to abstract types, the variance of type parameters
+is not inferred, and must be given explicitly.
+
+\section{s:locally-abstract}{Locally abstract types}
+\ikwd{type\@\texttt{type}}
+\ikwd{fun\@\texttt{fun}}
+%HEVEA\cutname{locallyabstract.html}
+
+
+(Introduced in OCaml 3.12, short syntax added in 4.03)
+
+\begin{syntax}
+parameter:
+       ...
+     | '(' "type" {{typeconstr-name}} ')'
+\end{syntax}
+
+The expression @"fun" '(' "type" typeconstr-name ')' "->" expr@ introduces a
+type constructor named @typeconstr-name@ which is considered abstract
+in the scope of the sub-expression, but then replaced by a fresh type
+variable.  Note that contrary to what the syntax could suggest, the
+expression @"fun" '(' "type" typeconstr-name ')' "->" expr@ itself does not
+suspend the evaluation of @expr@ as a regular abstraction would.  The
+syntax has been chosen to fit nicely in the context of function
+declarations, where it is generally used. It is possible to freely mix
+regular function parameters with pseudo type parameters, as in:
+\begin{caml_example*}{verbatim}
+let f = fun (type t) (foo : t list) -> (assert false)[@ellipsis]
+\end{caml_example*}
+and even use the alternative syntax for declaring functions:
+\begin{caml_example*}{verbatim}
+let f (type t) (foo : t list) = (assert false)[@ellipsis]
+\end{caml_example*}
+If several locally abstract types need to be introduced, it is possible to use
+the syntax
+@"fun" '(' "type" typeconstr-name_1 \ldots typeconstr-name_n ')' "->" expr@
+as syntactic sugar for @"fun" '(' "type" typeconstr-name_1 ')' "->" \ldots "->"
+"fun" '(' "type" typeconstr-name_n ')' "->" expr@. For instance,
+\begin{caml_example*}{verbatim}
+let f = fun (type t u v) -> fun (foo : (t * u * v) list) -> (assert false)[@ellipsis]
+let f' (type t u v) (foo : (t * u * v) list) = (assert false)[@ellipsis]
+\end{caml_example}
+
+This construction is useful because the type constructors it introduces
+can be used in places where a type variable is not allowed. For
+instance, one can use it to define an exception in a local module
+within a polymorphic function.
+\begin{caml_example*}{verbatim}
+let f (type t) () =
+  let module M = struct exception E of t end in
+  (fun x -> M.E x), (function M.E x -> Some x | _ -> None)
+\end{caml_example*}
+
+Here is another example:
+\begin{caml_example*}{verbatim}
+let sort_uniq (type s) (cmp : s -> s -> int) =
+  let module S = Set.Make(struct type t = s let compare = cmp end) in
+  fun l ->
+    S.elements (List.fold_right S.add l S.empty)
+\end{caml_example*}
+
+It is also extremely useful for first-class modules (see
+section~\ref{s:first-class-modules}) and generalized algebraic datatypes
+(GADTs: see section~\ref{s:gadts}).
+
+\lparagraph{p:polymorpic-locally-abstract}{Polymorphic syntax} (Introduced in OCaml 4.00)
+
+\begin{syntax}
+let-binding:
+       ...
+     | value-name ':' 'type' {{ typeconstr-name }} '.' typexpr '=' expr
+;
+class-field:
+          ...
+        | 'method' ['private'] method-name ':' 'type'
+          {{ typeconstr-name }} '.' typexpr '=' expr
+        | 'method!' ['private'] method-name ':' 'type'
+          {{ typeconstr-name }} '.' typexpr '=' expr
+\end{syntax}
+
+The @"(type" typeconstr-name")"@ syntax construction by itself does not make
+polymorphic the type variable it introduces, but it can be combined
+with explicit polymorphic annotations where needed.
+The above rule is provided as syntactic sugar to make this easier:
+\begin{caml_example*}{verbatim}
+let rec f : type t1 t2. t1 * t2 list -> t1 = (assert false)[@ellipsis]
+\end{caml_example*}
+\noindent
+is automatically expanded into
+\begin{caml_example*}{verbatim}
+let rec f : 't1 't2. 't1 * 't2 list -> 't1 =
+  fun (type t1) (type t2) -> ( (assert false)[@ellipsis] : t1 * t2 list -> t1)
+\end{caml_example*}
+This syntax can be very useful when defining recursive functions involving
+GADTs, see the section~\ref{s:gadts} for a more detailed explanation.
+
+The same feature is provided for method definitions.
+
+\section{s:first-class-modules}{First-class modules}
+\ikwd{module\@\texttt{module}}
+\ikwd{val\@\texttt{val}}
+\ikwd{with\@\texttt{with}}
+\ikwd{and\@\texttt{and}}
+%HEVEA\cutname{firstclassmodules.html}
+
+
+(Introduced in OCaml 3.12; pattern syntax and package type inference
+introduced in 4.00; structural comparison of package types introduced in 4.02.;
+fewer parens required starting from 4.05)
+
+\begin{syntax}
+typexpr:
+      ...
+    | '(''module' package-type')'
+;
+module-expr:
+      ...
+    | '(''val' expr [':' package-type]')'
+;
+expr:
+      ...
+    | '(''module' module-expr [':' package-type]')'
+;
+pattern:
+      ...
+    | '(''module' module-name [':' package-type]')'
+;
+package-type:
+      modtype-path
+    | modtype-path 'with' package-constraint { 'and' package-constraint }
+;
+package-constraint:
+          'type' typeconstr '=' typexpr
+;
+\end{syntax}
+
+Modules are typically thought of as static components. This extension
+makes it possible to pack a module as a first-class value, which can
+later be dynamically unpacked into a module.
+
+The expression @'(' 'module' module-expr ':' package-type ')'@ converts the
+module (structure or functor) denoted by module expression @module-expr@
+to a value of the core language that encapsulates this module.  The
+type of this core language value is @'(' 'module' package-type ')'@.
+The @package-type@ annotation can be omitted if it can be inferred
+from the context.
+
+Conversely, the module expression @'(' 'val' expr ':' package-type ')'@
+evaluates the core language expression @expr@ to a value, which must
+have type @'module' package-type@, and extracts the module that was
+encapsulated in this value. Again @package-type@ can be omitted if the
+type of @expr@ is known.
+If the module expression is already parenthesized, like the arguments
+of functors are, no additional parens are needed: "Map.Make(val key)".
+
+The pattern @'(' 'module' module-name ':' package-type ')'@ matches a
+package with type @package-type@ and binds it to @module-name@.
+It is not allowed in toplevel let bindings.
+Again @package-type@ can be omitted if it can be inferred from the
+enclosing pattern.
+
+The @package-type@ syntactic class appearing in the  @'(' 'module'
+package-type ')'@ type expression and in the annotated forms represents a
+subset of module types.
+This subset consists of named module types with optional constraints
+of a limited form: only non-parametrized types can be specified.
+
+For type-checking purposes (and starting from OCaml 4.02), package types
+are compared using the structural comparison of module types.
+
+In general, the module expression @'(' "val" expr ":" package-type
+')'@ cannot be used in the body of a functor, because this could cause
+unsoundness in conjunction with applicative functors.
+Since OCaml 4.02, this is relaxed in two ways:
+if @package-type@ does not contain nominal type declarations ({\em
+  i.e.} types that are created with a proper identity), then this
+expression can be used anywhere, and even if it contains such types
+it can be used inside the body of a generative
+functor, described in section~\ref{s:generative-functors}.
+It can also be used anywhere in the context of a local module binding
+@'let' 'module' module-name '=' '(' "val" expr_1 ":" package-type ')'
+ "in" expr_2@.
+
+\lparagraph{p:fst-mod-example}{Basic example} A typical use of first-class modules is to
+select at run-time among several implementations of a signature.
+Each implementation is a structure that we can encapsulate as a
+first-class module, then store in a data structure such as a hash
+table:
+\begin{caml_example*}{verbatim}
+type picture = unit[@ellipsis]
+module type DEVICE = sig
+  val draw : picture -> unit
+  [@@@ellipsis]
+end
+let devices : (string, (module DEVICE)) Hashtbl.t = Hashtbl.create 17
+
+module SVG = struct let draw () = () [@@ellipsis] end
+let _ = Hashtbl.add devices "SVG" (module SVG : DEVICE)
+
+module PDF = struct let draw () = () [@@ellipsis] end
+let _ = Hashtbl.add devices "PDF" (module PDF : DEVICE)
+\end{caml_example*}
+
+We can then select one implementation based on command-line
+arguments, for instance:
+\begin{caml_example*}{verbatim}
+let parse_cmdline () = "SVG"[@ellipsis]
+module Device =
+  (val (let device_name = parse_cmdline () in
+        try Hashtbl.find devices device_name
+        with Not_found ->
+          Printf.eprintf "Unknown device %s\n" device_name;
+          exit 2)
+   : DEVICE)
+\end{caml_example*}
+Alternatively, the selection can be performed within a function:
+\begin{caml_example*}{verbatim}
+let draw_using_device device_name picture =
+  let module Device =
+    (val (Hashtbl.find devices device_name) : DEVICE)
+  in
+  Device.draw picture
+\end{caml_example*}
+
+\lparagraph{p:fst-mod-advexamples}{Advanced examples}
+With first-class modules, it is possible to parametrize some code over the
+implementation of a module without using a functor.
+
+\begin{caml_example}{verbatim}
+let sort (type s) (module Set : Set.S with type elt = s) l =
+  Set.elements (List.fold_right Set.add l Set.empty)
+\end{caml_example}
+
+To use this function, one can wrap the "Set.Make" functor:
+
+\begin{caml_example}{verbatim}
+let make_set (type s) cmp =
+  let module S = Set.Make(struct
+    type t = s
+    let compare = cmp
+  end) in
+  (module S : Set.S with type elt = s)
+\end{caml_example}
+
+\iffalse
+Another advanced use of first-class module is to encode existential
+types. In particular, they can be used to simulate generalized
+algebraic data types (GADT). To demonstrate this, we first define a type
+of witnesses for type equalities:
+
+\begin{caml_example*}{verbatim}
+module TypEq : sig
+  type ('a, 'b) t
+  val apply: ('a, 'b) t -> 'a -> 'b
+  val refl: ('a, 'a) t
+  val sym: ('a, 'b) t -> ('b, 'a) t
+end = struct
+  type ('a, 'b) t = ('a -> 'b) * ('b -> 'a)
+  let refl = (fun x -> x), (fun x -> x)
+  let apply (f, _) x = f x
+  let sym (f, g) = (g, f)
+end
+\end{caml_example*}
+
+We can then define a parametrized algebraic data type whose
+constructors provide some information about the type parameter:
+
+\begin{caml_example*}{verbatim}
+module rec Typ : sig
+  module type PAIR = sig
+    type t and t1 and t2
+    val eq: (t, t1 * t2) TypEq.t
+    val t1: t1 Typ.typ
+    val t2: t2 Typ.typ
+  end
+
+  type 'a typ =
+    | Int of ('a, int) TypEq.t
+    | String of ('a, string) TypEq.t
+    | Pair of (module PAIR with type t = 'a)
+end = Typ
+\end{caml_example*}
+
+Values of type "'a typ" are supposed to be runtime representations for
+the type "'a". The constructors "Int" and "String" are easy: they
+directly give a witness of type equality between the parameter "'a"
+and the ground types "int" (resp. "string"). The constructor "Pair" is
+more complex. One wants to give a witness of type equality between
+"'a" and a type of the form "t1 * t2" together with the representations
+for "t1" and "t2". However, these two types are unknown. The code above
+shows how to use first-class modules to simulate existentials.
+
+Here is how to construct values of type "'a typ":
+
+\begin{caml_example*}{verbatim}
+let int = Typ.Int TypEq.refl
+
+let str = Typ.String TypEq.refl
+
+let pair (type s1) (type s2) t1 t2 =
+  let module P = struct
+    type t = s1 * s2
+    type t1 = s1
+    type t2 = s2
+    let eq = TypEq.refl
+    let t1 = t1
+    let t2 = t2
+  end in
+  let pair = (module P : Typ.PAIR with type t = s1 * s2) in
+  Typ.Pair pair
+\end{caml_example*}
+
+And finally, here is an example of a polymorphic function that takes the
+runtime representation of some type "'a" and a value of the same type,
+then pretty-prints the value into a string:
+
+\begin{caml_example*}{verbatim}
+open Typ
+let rec to_string: 'a. 'a Typ.typ -> 'a -> string =
+  fun (type s) t x ->
+    match t with
+    | Int eq -> Int.to_string (TypEq.apply eq x)
+    | String eq -> Printf.sprintf "%S" (TypEq.apply eq x)
+    | Pair p ->
+        let module P = (val p : PAIR with type t = s) in
+        let (x1, x2) = TypEq.apply P.eq x in
+        Printf.sprintf "(%s,%s)" (to_string P.t1 x1) (to_string P.t2 x2)
+\end{caml_example*}
+
+Note that this function uses an explicit polymorphic annotation to obtain
+polymorphic recursion.
+\fi
+
+\section{s:module-type-of}{Recovering the type of a module}
+%HEVEA\cutname{moduletypeof.html}
+
+\ikwd{module\@\texttt{module}}
+\ikwd{type\@\texttt{type}}
+\ikwd{of\@\texttt{of}}
+\ikwd{include\@\texttt{include}}
+
+(Introduced in OCaml 3.12)
+
+\begin{syntax}
+module-type:
+     ...
+   | 'module' 'type' 'of' module-expr
+\end{syntax}
+
+The construction @'module' 'type' 'of' module-expr@ expands to the module type
+(signature or functor type) inferred for the module expression @module-expr@.
+To make this module type reusable in many situations, it is
+intentionally not strengthened: abstract types and datatypes are not
+explicitly related with the types of the original module.
+For the same reason, module aliases in the inferred type are expanded.
+
+A typical use, in conjunction with the signature-level @'include'@
+construct, is to extend the signature of an existing structure.
+In that case, one wants to keep the types equal to types in the
+original module. This can done using the following idiom.
+\begin{caml_example*}{verbatim}
+module type MYHASH = sig
+  include module type of struct include Hashtbl end
+  val replace: ('a, 'b) t -> 'a -> 'b -> unit
+end
+\end{caml_example*}
+The signature "MYHASH" then contains all the fields of the signature
+of the module "Hashtbl" (with strengthened type definitions), plus the
+new field "replace".  An implementation of this signature can be
+obtained easily by using the @'include'@ construct again, but this
+time at the structure level:
+\begin{caml_example*}{verbatim}
+module MyHash : MYHASH = struct
+  include Hashtbl
+  let replace t k v = remove t k; add t k v
+end
+\end{caml_example*}
+
+Another application where the absence of strengthening comes handy, is
+to provide an alternative implementation for an existing module.
+\begin{caml_example*}{verbatim}
+module MySet : module type of Set = struct
+  include Set[@@ellipsis]
+end
+\end{caml_example*}
+This idiom guarantees that "Myset" is compatible with Set, but allows
+it to represent sets internally in a different way.
+
+\section{s:signature-substitution}{Substituting inside a signature}
+\ikwd{with\@\texttt{with}}
+\ikwd{module\@\texttt{module}}
+\ikwd{type\@\texttt{type}}
+%HEVEA\cutname{signaturesubstitution.html}
+
+
+\subsection{ss:destructive-substitution}{Destructive substitutions}
+
+(Introduced in OCaml 3.12, generalized in 4.06)
+
+\begin{syntax}
+mod-constraint:
+          ...
+        | 'type' [type-params] typeconstr-name ':=' typexpr
+        | 'module' module-path ':=' extended-module-path
+\end{syntax}
+
+A ``destructive'' substitution (@'with' ... ':=' ...@) behaves essentially like
+normal signature constraints (@'with' ... '=' ...@), but it additionally removes
+the redefined type or module from the signature.
+
+Prior to OCaml 4.06, there were a number of restrictions: one could only remove
+types and modules at the outermost level (not inside submodules), and in the
+case of @'with type'@ the definition had to be another type constructor with the
+same type parameters.
+
+A natural application of destructive substitution is merging two
+signatures sharing a type name.
+\begin{caml_example*}{verbatim}
+module type Printable = sig
+  type t
+  val print : Format.formatter -> t -> unit
+end
+module type Comparable = sig
+  type t
+  val compare : t -> t -> int
+end
+module type PrintableComparable = sig
+  include Printable
+  include Comparable with type t := t
+end
+\end{caml_example*}
+
+One can also use this to completely remove a field:
+\begin{caml_example}{verbatim}
+module type S = Comparable with type t := int
+\end{caml_example}
+or to rename one:
+\begin{caml_example}{verbatim}
+module type S = sig
+  type u
+  include Comparable with type t := u
+end
+\end{caml_example}
+
+Note that you can also remove manifest types, by substituting with the
+same type.
+\begin{caml_example}{verbatim}
+module type ComparableInt = Comparable with type t = int ;;
+module type CompareInt = ComparableInt with type t := int
+\end{caml_example}
+
+\subsection{ss:local-substitution}{Local substitution declarations}
+
+(Introduced in OCaml 4.08)
+
+\begin{syntax}
+specification:
+          ...
+        | 'type' type-subst { 'and' type-subst }
+        | 'module' module-name ':=' extended-module-path
+;
+
+type-subst:
+          [type-params] typeconstr-name ':=' typexpr { type-constraint }
+\end{syntax}
+
+
+Local substitutions behave like destructive substitutions (@'with' ... ':=' ...@)
+but instead of being applied to a whole signature after the fact, they are
+introduced during the specification of the signature, and will apply to all the
+items that follow.
+
+This provides a convenient way to introduce local names for types and modules
+when defining a signature:
+
+\begin{caml_example}{verbatim}
+module type S = sig
+  type t
+  module Sub : sig
+    type outer := t
+    type t
+    val to_outer : t -> outer
+  end
+end
+\end{caml_example}
+
+Note that, unlike type declarations, type substitution declarations are not
+recursive, so substitutions like the following are rejected:
+
+\begin{caml_example}{toplevel}
+module type S = sig
+  type 'a poly_list := [ `Cons of 'a * 'a poly_list | `Nil ]
+end [@@expect error];;
+\end{caml_example}
+
+\section{s:module-alias}{Type-level module aliases}
+\ikwd{module\@\texttt{module}}
+%HEVEA\cutname{modulealias.html}
+
+(Introduced in OCaml 4.02)
+
+\begin{syntax}
+specification:
+          ...
+        | 'module' module-name '=' module-path
+\end{syntax}
+
+The above specification, inside a signature, only matches a module
+definition equal to @module-path@. Conversely, a type-level module
+alias can be matched by itself, or by any supertype of the type of the
+module it references.
+
+There are several restrictions on @module-path@:
+\begin{enumerate}
+\item it should be of the form \(M_0.M_1...M_n\) ({\em i.e.} without
+  functor applications);
+\item inside the body of a  functor, \(M_0\) should not be one of the
+  functor parameters;
+\item inside a recursive module definition, \(M_0\) should not be one of
+  the recursively defined modules.
+\end{enumerate}
+
+Such specifications are also inferred. Namely, when @P@ is a path
+satisfying the above constraints,
+\begin{caml_eval}
+module P = struct end
+\end{caml_eval}
+\begin{caml_example*}{verbatim}
+module N = P
+\end{caml_example*}
+has type
+\begin{caml_example*}{signature}
+module N = P
+\end{caml_example*}
+
+Type-level module aliases are used when checking module path
+equalities. That is, in a context where module name @N@ is known to be
+an alias for @P@, not only these two module paths check as equal, but
+@F(N)@ and @F(P)@ are also recognized as equal. In the default
+compilation mode, this is the only difference with the previous
+approach of module aliases having just the same module type as the
+module they reference.
+
+When the compiler flag @'-no-alias-deps'@ is enabled, type-level
+module aliases are also exploited to avoid introducing dependencies
+between compilation units. Namely, a module alias referring to a
+module inside another compilation unit does not introduce a link-time
+dependency on that compilation unit, as long as it is not
+dereferenced; it still introduces a compile-time dependency if the
+interface needs to be read, {\em i.e.}  if the module is a submodule
+of the compilation unit, or if some type components are referred to.
+Additionally, accessing a module alias introduces a link-time
+dependency on the compilation unit containing the module referenced by
+the alias, rather than the compilation unit containing the alias.
+Note that these differences in link-time behavior may be incompatible
+with the previous behavior, as some compilation units might not be
+extracted from libraries, and their side-effects ignored.
+
+These weakened dependencies make possible to use module aliases in
+place of the @'-pack'@ mechanism. Suppose that you have a library
+@'Mylib'@ composed of modules @'A'@ and @'B'@. Using @'-pack'@, one
+would issue the command line
+\begin{verbatim}
+ocamlc -pack a.cmo b.cmo -o mylib.cmo
+\end{verbatim}
+and as a result obtain a @'Mylib'@ compilation unit, containing
+physically @'A'@ and @'B'@ as submodules, and with no dependencies on
+their respective compilation units.
+Here is a concrete example of a possible alternative approach:
+\begin{enumerate}
+\item Rename the files containing @'A'@ and @'B'@ to @'Mylib__A'@ and
+  @'Mylib__B'@.
+\item Create a packing interface @'Mylib.ml'@, containing the
+  following lines.
+\begin{verbatim}
+module A = Mylib__A
+module B = Mylib__B
+\end{verbatim}
+\item Compile @'Mylib.ml'@ using @'-no-alias-deps'@, and the other
+  files using @'-no-alias-deps'@ and @'-open' 'Mylib'@ (the last one is
+  equivalent to adding the line @'open!' 'Mylib'@ at the top of each
+  file).
+\begin{verbatim}
+ocamlc -c -no-alias-deps Mylib.ml
+ocamlc -c -no-alias-deps -open Mylib Mylib__*.mli Mylib__*.ml
+\end{verbatim}
+\item Finally, create a library containing all the compilation units,
+  and export all the compiled interfaces.
+\begin{verbatim}
+ocamlc -a Mylib*.cmo -o Mylib.cma
+\end{verbatim}
+\end{enumerate}
+This approach lets you access @'A'@ and @'B'@ directly inside the
+library, and as @'Mylib.A'@ and @'Mylib.B'@ from outside.
+It also has the advantage that @'Mylib'@ is no longer monolithic: if
+you use @'Mylib.A'@, only @'Mylib__A'@ will be linked in, not
+@'Mylib__B'@.
+%Note that in the above @'Mylib.cmo'@ is actually empty, and one could
+%name the interface @'Mylib.mli'@, but this would require that all
+%clients are compiled with the @'-no-alias-deps'@ flag.
+
+Note the use of double underscores in @'Mylib__A'@ and
+@'Mylib__B'@. These were chosen on purpose; the compiler uses the
+following heuristic when printing paths: given a path @'Lib__fooBar'@,
+if @'Lib.FooBar'@ exists and is an alias for @'Lib__fooBar'@, then the
+compiler will always display @'Lib.FooBar'@ instead of
+@'Lib__fooBar'@. This way the long @'Mylib__'@ names stay hidden and
+all the user sees is the nicer dot names. This is how the OCaml
+standard library is compiled.
+
+\section{s:explicit-overriding-open}{Overriding in open statements}
+\ikwd{open.\@\texttt{open\char33}}
+%HEVEA\cutname{overridingopen.html}
+
+(Introduced in OCaml 4.01)
+
+\begin{syntax}
+definition:
+      ...
+   |  'open!' module-path
+;
+specification:
+      ...
+   |  'open!' module-path
+;
+expr:
+       ...
+     | 'let' 'open!' module-path 'in' expr
+;
+class-body-type:
+       ...
+   |  'let' 'open!' module-path 'in' class-body-type
+;
+class-expr:
+       ...
+   |  'let' 'open!' module-path 'in' class-expr
+;
+\end{syntax}
+
+Since OCaml 4.01, @"open"@ statements shadowing an existing identifier
+(which is later used) trigger the warning 44.  Adding a @"!"@
+character after the @"open"@ keyword indicates that such a shadowing is
+intentional and should not trigger the warning.
+
+This is also available (since OCaml 4.06) for local opens in class
+expressions and class type expressions.
+
+\section{s:gadts}{Generalized algebraic datatypes} \ikwd{type\@\texttt{type}}
+\ikwd{match\@\texttt{match}}
+%HEVEA\cutname{gadts.html}
+
+
+(Introduced in OCaml 4.00)
+
+\begin{syntax}
+constr-decl:
+          ...
+        | constr-name ':' [ constr-args '->' ] typexpr
+;
+type-param:
+          ...
+        | [variance] '_'
+\end{syntax}
+
+Generalized algebraic datatypes, or GADTs, extend usual sum types in
+two ways: constraints on type parameters may change depending on the
+value constructor, and some type variables may be existentially
+quantified.
+Adding constraints is done by giving an explicit return type
+(the rightmost @typexpr@ in the above syntax), where type parameters
+are instantiated.
+This return type must use the same type constructor as the type being
+defined, and have the same number of parameters.
+Variables are made existential when they appear inside a constructor's
+argument, but not in its return type.
+
+Since the use of a return type often eliminates the need to name type
+parameters in the left-hand side of a type definition, one can replace
+them with anonymous types @"_"@ in that case.
+
+The constraints associated to each constructor can be recovered
+through pattern-matching.
+Namely, if the type of the scrutinee of a pattern-matching contains
+a locally abstract type, this type can be refined according to the
+constructor used.
+These extra constraints are only valid inside the corresponding branch
+of the pattern-matching.
+If a constructor has some existential variables, fresh locally
+abstract types are generated, and they must not escape the
+scope of this branch.
+
+\lparagraph{p:gadts-recfun}{Recursive functions}
+
+Here is a concrete example:
+\begin{caml_example*}{verbatim}
+type _ term =
+  | Int : int -> int term
+  | Add : (int -> int -> int) term
+  | App : ('b -> 'a) term * 'b term -> 'a term
+
+let rec eval : type a. a term -> a = function
+  | Int n    -> n                 (* a = int *)
+  | Add      -> (fun x y -> x+y)  (* a = int -> int -> int *)
+  | App(f,x) -> (eval f) (eval x)
+          (* eval called at types (b->a) and b for fresh b *)
+\end{caml_example*}
+\begin{caml_example}{verbatim}
+let two = eval (App (App (Add, Int 1), Int 1))
+\end{caml_example}
+It is important to remark that the function "eval" is using the
+polymorphic syntax for locally abstract types. When defining a recursive
+function that manipulates a GADT, explicit polymorphic recursion should
+generally be used. For instance, the following definition fails with a
+type error:
+\begin{caml_example}{verbatim}[error]
+let rec eval (type a) : a term -> a = function
+  | Int n    -> n
+  | Add      -> (fun x y -> x+y)
+  | App(f,x) -> (eval f) (eval x)
+\end{caml_example}
+In absence of an explicit polymorphic annotation, a monomorphic type
+is inferred for the recursive function. If a recursive call occurs
+inside the function definition at a type that involves an existential
+GADT type variable, this variable flows to the type of the recursive
+function, and thus escapes its scope. In the above example, this happens
+in the branch "App(f,x)" when "eval" is called with "f" as an argument.
+In this branch, the type of "f" is "($App_ 'b-> a)". The prefix "$" in
+"$App_ 'b" denotes an existential type named by the compiler
+(see~\ref{p:existential-names}). Since the type of "eval" is
+"'a term -> 'a", the call "eval f" makes the existential type "$App_'b"
+flow to the type variable "'a" and escape its scope. This triggers the
+above error.
+
+\lparagraph{p:gadts-type-inference}{Type inference}
+
+Type inference for GADTs is notoriously hard.
+This is due to the fact some types may become ambiguous when escaping
+from a branch.
+For instance, in the "Int" case above, "n" could have either type "int"
+or "a", and they are not equivalent outside of that branch.
+As a first approximation, type inference will always work if a
+pattern-matching is annotated with types containing no free type
+variables (both on the scrutinee and the return type).
+This is the case in the above example, thanks to the type annotation
+containing only locally abstract types.
+
+In practice, type inference is a bit more clever than that: type
+annotations do not need to be immediately on the pattern-matching, and
+the types do not have to be always closed.
+As a result, it is usually enough to only annotate functions, as in
+the example above. Type annotations are
+propagated in two ways: for the scrutinee, they follow the flow of
+type inference, in a way similar to polymorphic methods; for the
+return type, they follow the structure of the program, they are split
+on functions, propagated to all branches of a pattern matching,
+and go through tuples, records, and sum types.
+Moreover, the notion of ambiguity used is stronger: a type is only
+seen as ambiguous if it was mixed with incompatible types (equated by
+constraints), without type annotations between them.
+For instance, the following program types correctly.
+\begin{caml_example}{verbatim}
+let rec sum : type a. a term -> _ = fun x ->
+  let y =
+    match x with
+    | Int n -> n
+    | Add   -> 0
+    | App(f,x) -> sum f + sum x
+  in y + 1
+\end{caml_example}
+Here the return type "int" is never mixed with "a", so it is seen as
+non-ambiguous, and can be inferred.
+When using such partial type annotations we strongly suggest
+specifying the "-principal" mode, to check that inference is
+principal.
+
+The exhaustiveness check is aware of GADT constraints, and can
+automatically infer that some cases cannot happen.
+For instance, the following pattern matching is correctly seen as
+exhaustive (the "Add" case cannot happen).
+\begin{caml_example*}{verbatim}
+let get_int : int term -> int = function
+  | Int n    -> n
+  | App(_,_) -> 0
+\end{caml_example*}
+
+
+\lparagraph{p:gadt-refutation-cases}{Refutation cases} (Introduced in OCaml 4.03)
+
+Usually, the exhaustiveness check only tries to check whether the
+cases omitted from the pattern matching are typable or not.
+However, you can force it to try harder by adding {\em refutation cases}:
+\begin{syntax}
+matching-case:
+     pattern ['when' expr] '->' expr
+   | pattern '->' '.'
+\end{syntax}
+In presence of a refutation case, the exhaustiveness check will first
+compute the intersection of the pattern with the complement of the
+cases preceding it. It then checks whether the resulting patterns can
+really match any concrete values by trying to type-check them.
+Wild cards in the generated patterns are handled in a special way: if
+their type is a variant type with only GADT constructors, then the
+pattern is split into the different constructors, in order to check whether
+any of them is possible (this splitting is not done for arguments of these
+constructors, to avoid non-termination). We also split tuples and
+variant types with only one case, since they may contain GADTs inside.
+For instance, the following code is deemed exhaustive:
+
+\begin{caml_example*}{verbatim}
+type _ t =
+  | Int : int t
+  | Bool : bool t
+
+let deep : (char t * int) option -> char = function
+  | None -> 'c'
+  | _ -> .
+\end{caml_example*}
+
+Namely, the inferred remaining case is "Some _", which is split into
+"Some (Int, _)" and "Some (Bool, _)", which are both untypable because
+"deep" expects a non-existing "char t" as the first element of the tuple.
+Note that the refutation case could be omitted here, because it is
+automatically added when there is only one case in the pattern
+matching.
+
+Another addition is that the redundancy check is now aware of GADTs: a
+case will be detected as redundant if it could be replaced by a
+refutation case using the same pattern.
+
+\lparagraph{p:gadts-advexamples}{Advanced examples}
+The "term" type we have defined above is an {\em indexed} type, where
+a type parameter reflects a property of the value contents.
+Another use of GADTs is {\em singleton} types, where a GADT value
+represents exactly one type. This value can be used as runtime
+representation for this type, and a function receiving it can have a
+polytypic behavior.
+
+Here is an example of a polymorphic function that takes the
+runtime representation of some type "t" and a value of the same type,
+then pretty-prints the value as a string:
+\begin{caml_example*}{verbatim}
+type _ typ =
+  | Int : int typ
+  | String : string typ
+  | Pair : 'a typ * 'b typ -> ('a * 'b) typ
+
+let rec to_string: type t. t typ -> t -> string =
+  fun t x ->
+  match t with
+  | Int -> Int.to_string x
+  | String -> Printf.sprintf "%S" x
+  | Pair(t1,t2) ->
+      let (x1, x2) = x in
+      Printf.sprintf "(%s,%s)" (to_string t1 x1) (to_string t2 x2)
+\end{caml_example*}
+
+Another frequent application of GADTs is equality witnesses.
+\begin{caml_example*}{verbatim}
+type (_,_) eq = Eq : ('a,'a) eq
+
+let cast : type a b. (a,b) eq -> a -> b = fun Eq x -> x
+\end{caml_example*}
+Here type "eq" has only one constructor, and by matching on it one
+adds a local constraint allowing the conversion between "a" and "b".
+By building such equality witnesses, one can make equal types which
+are syntactically different.
+
+Here is an example using both singleton types and equality witnesses
+to implement dynamic types.
+\begin{caml_example*}{verbatim}
+let rec eq_type : type a b. a typ -> b typ -> (a,b) eq option =
+  fun a b ->
+  match a, b with
+  | Int, Int -> Some Eq
+  | String, String -> Some Eq
+  | Pair(a1,a2), Pair(b1,b2) ->
+      begin match eq_type a1 b1, eq_type a2 b2 with
+      | Some Eq, Some Eq -> Some Eq
+      | _ -> None
+      end
+  | _ -> None
+
+type dyn = Dyn : 'a typ * 'a -> dyn
+
+let get_dyn : type a. a typ -> dyn -> a option =
+  fun a (Dyn(b,x)) ->
+  match eq_type a b with
+  | None -> None
+  | Some Eq -> Some x
+\end{caml_example*}
+
+\lparagraph{p:existential-names}{Existential type names in error messages}%
+(Updated in OCaml 4.03.0)
+
+The typing of pattern matching in presence of GADT can generate many
+existential types. When necessary, error messages refer to these
+existential types using compiler-generated names. Currently, the
+compiler generates these names according to the following nomenclature:
+\begin{itemize}
+\item First, types whose name starts with a "$" are existentials.
+\item "$Constr_'a" denotes an existential type introduced for the type
+variable "'a" of the GADT constructor "Constr":
+\begin{caml_example}{verbatim}[error]
+type any = Any : 'name -> any
+let escape (Any x) = x
+\end{caml_example}
+\item "$Constr" denotes an existential type introduced for an anonymous %$
+type variable in the GADT constructor "Constr":
+\begin{caml_example}{verbatim}[error]
+type any = Any : _ -> any
+let escape (Any x) = x
+\end{caml_example}
+\item "$'a" if the existential variable was unified with the type %$
+variable "'a" during typing:
+\begin{caml_example}{verbatim}[error]
+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 ->
+  match f with
+  | Fun f -> f x
+  | Mem1 (f,y,fy) -> if x = y then fy else f x
+\end{caml_example}
+\item "$n" (n a number) is an internally generated existential %$
+which could not be named using one of the previous schemes.
+\end{itemize}
+
+As shown by the last item, the current behavior is imperfect
+and may be improved in future versions.
+
+\lparagraph{p:gadt-equation-nonlocal-abstract}{Equations on non-local abstract types} (Introduced in OCaml
+4.04)
+
+GADT pattern-matching may also add type equations to non-local
+abstract types. The behaviour is the same as with local abstract
+types. Reusing the above "eq" type, one can write:
+\begin{caml_example*}{verbatim}
+module M : sig type t val x : t val e : (t,int) eq end = struct
+  type t = int
+  let x = 33
+  let e = Eq
+end
+
+let x : int = let Eq = M.e in M.x
+\end{caml_example*}
+
+Of course, not all abstract types can be refined, as this would
+contradict the exhaustiveness check. Namely, builtin types (those
+defined by the compiler itself, such as "int" or "array"), and
+abstract types defined by the local module, are non-instantiable, and
+as such cause a type error rather than introduce an equation.
+
+\section{s:bigarray-access}{Syntax for Bigarray access}
+%HEVEA\cutname{bigarray.html}
+
+(Introduced in Objective Caml 3.00)
+
+\begin{syntax}
+expr:
+          ...
+        | expr '.{' expr { ',' expr } '}'
+        | expr '.{' expr { ',' expr } '}' '<-' expr
+\end{syntax}
+
+This extension provides syntactic sugar for getting and setting
+elements in the arrays provided by the \stdmoduleref{Bigarray} module.
+
+The short expressions are translated into calls to functions of the
+"Bigarray" module as described in the following table.
+
+\begin{tableau}{|l|l|}{expression}{translation}
+\entree{@expr_0'.{'expr_1'}'@}
+       {"Bigarray.Array1.get "@expr_0 expr_1@}
+\entree{@expr_0'.{'expr_1'}' '<-'expr@}
+       {"Bigarray.Array1.set "@expr_0 expr_1 expr@}
+\entree{@expr_0'.{'expr_1',' expr_2'}'@}
+       {"Bigarray.Array2.get "@expr_0 expr_1 expr_2@}
+\entree{@expr_0'.{'expr_1',' expr_2'}' '<-'expr@}
+       {"Bigarray.Array2.set "@expr_0 expr_1 expr_2 expr@}
+\entree{@expr_0'.{'expr_1',' expr_2',' expr_3'}'@}
+       {"Bigarray.Array3.get "@expr_0 expr_1 expr_2 expr_3@}
+\entree{@expr_0'.{'expr_1',' expr_2',' expr_3'}' '<-'expr@}
+       {"Bigarray.Array3.set "@expr_0 expr_1 expr_2 expr_3 expr@}
+\entree{@expr_0'.{'expr_1',' \ldots',' expr_n'}'@}
+       {"Bigarray.Genarray.get "@ expr_0 '[|' expr_1',' \ldots ','
+        expr_n '|]'@}
+\entree{@expr_0'.{'expr_1',' \ldots',' expr_n'}' '<-'expr@}
+       {"Bigarray.Genarray.set "@ expr_0 '[|' expr_1',' \ldots ','
+        expr_n '|]' expr@}
+\end{tableau}
+
+The last two entries are valid for any $n > 3$.
+
+\section{s:attributes}{Attributes}
+%HEVEA\cutname{attributes.html}
+
+\ikwd{when\@\texttt{when}}
+
+(Introduced in OCaml 4.02,
+infix notations for constructs other than expressions added in 4.03)
+
+Attributes are ``decorations'' of the syntax tree which are mostly
+ignored by the type-checker but can be used by external tools.  An
+attribute is made of an identifier and a payload, which can be a
+structure, a type expression (prefixed with ":"), a signature
+(prefixed with ":") or a pattern (prefixed with "?") optionally
+followed by a "when" clause:
+
+
+\begin{syntax}
+attr-id:
+    lowercase-ident
+ |  capitalized-ident
+ |  attr-id '.' attr-id
+;
+attr-payload:
+    [ module-items ]
+ |  ':' typexpr
+ |  ':' [ specification ]
+ |  '?' pattern ['when' expr]
+;
+\end{syntax}
+
+The first form of attributes is attached with a postfix notation on
+``algebraic'' categories:
+
+\begin{syntax}
+attribute:
+    '[@' attr-id attr-payload ']'
+;
+expr: ...
+     | expr attribute
+;
+typexpr: ...
+     | typexpr attribute
+;
+pattern: ...
+     | pattern attribute
+;
+module-expr: ...
+     | module-expr attribute
+;
+module-type: ...
+     | module-type attribute
+;
+class-expr: ...
+     | class-expr attribute
+;
+class-type: ...
+     | class-type attribute
+;
+\end{syntax}
+
+This form of attributes can also be inserted after the @'`'tag-name@
+in polymorphic variant type expressions (@tag-spec-first@, @tag-spec@,
+@tag-spec-full@) or after the @method-name@ in @method-type@.
+
+The same syntactic form is also used to attach attributes to labels and
+constructors in type declarations:
+
+\begin{syntax}
+field-decl:
+          ['mutable'] field-name ':' poly-typexpr {attribute}
+;
+constr-decl:
+          (constr-name || '()') [ 'of' constr-args ] {attribute}
+;
+\end{syntax}
+
+Note: when a label declaration is followed by a semi-colon, attributes
+can also be put after the semi-colon (in which case they are merged to
+those specified before).
+
+
+The second form of attributes are attached to ``blocks'' such as type
+declarations, class fields, etc:
+
+\begin{syntax}
+item-attribute:
+    '[@@' attr-id attr-payload ']'
+;
+typedef: ...
+   | typedef item-attribute
+;
+exception-definition:
+        'exception' constr-decl
+      | 'exception' constr-name '=' constr
+;
+module-items:
+        [';;'] ( definition || expr { item-attribute } ) { [';;'] definition || ';;' expr { item-attribute } } [';;']
+;
+class-binding: ...
+   | class-binding item-attribute
+;
+class-spec: ...
+   | class-spec item-attribute
+;
+classtype-def: ...
+   | classtype-def item-attribute
+;
+definition:
+          'let' ['rec'] let-binding { 'and' let-binding }
+        | 'external' value-name ':' typexpr '=' external-declaration { item-attribute }
+        | type-definition
+        | exception-definition { item-attribute }
+        | class-definition
+        | classtype-definition
+        | 'module' module-name { '(' module-name ':' module-type ')' }
+                   [ ':' module-type ] \\ '=' module-expr { item-attribute }
+        | 'module' 'type' modtype-name '=' module-type { item-attribute }
+        | 'open' module-path { item-attribute }
+        | 'include' module-expr { item-attribute }
+        | 'module' 'rec' module-name ':' module-type '=' \\
+          module-expr { item-attribute } \\
+          { 'and' module-name ':' module-type '=' module-expr \\
+          { item-attribute } }
+;
+specification:
+          'val' value-name ':' typexpr { item-attribute }
+        | 'external' value-name ':' typexpr '=' external-declaration { item-attribute }
+        | type-definition
+        | 'exception' constr-decl { item-attribute }
+        | class-specification
+        | classtype-definition
+        | 'module' module-name ':' module-type { item-attribute }
+        | 'module' module-name { '(' module-name ':' module-type ')' }
+          ':' module-type { item-attribute }
+        | 'module' 'type' modtype-name { item-attribute }
+        | 'module' 'type' modtype-name '=' module-type { item-attribute }
+        | 'open' module-path { item-attribute }
+        | 'include' module-type { item-attribute }
+;
+class-field-spec: ...
+        | class-field-spec item-attribute
+;
+class-field: ...
+        | class-field item-attribute
+;
+\end{syntax}
+
+A third form of attributes appears as stand-alone structure or
+signature items in the module or class sub-languages.  They are not
+attached to any specific node in the syntax tree:
+
+\begin{syntax}
+floating-attribute:
+    '[@@@' attr-id attr-payload ']'
+;
+definition: ...
+   | floating-attribute
+;
+specification: ...
+   | floating-attribute
+;
+class-field-spec: ...
+   | floating-attribute
+;
+class-field: ...
+   | floating-attribute
+;
+\end{syntax}
+
+(Note: contrary to what the grammar above describes, @item-attributes@
+cannot be attached to these floating attributes in @class-field-spec@
+and @class-field@.)
+
+
+It is also possible to specify attributes using an infix syntax. For instance:
+
+\begin{verbatim}
+let[@foo] x = 2 in x + 1          === (let x = 2 [@@foo] in x + 1)
+begin[@foo][@bar x] ... end       === (begin ... end)[@foo][@bar x]
+module[@foo] M = ...              === module M = ... [@@foo]
+type[@foo] t = T                  === type t = T [@@foo]
+method[@foo] m = ...              === method m = ... [@@foo]
+\end{verbatim}
+
+For "let", the attributes are applied to each bindings:
+
+\begin{verbatim}
+let[@foo] x = 2 and y = 3 in x + y === (let x = 2 [@@foo] and y = 3 in x + y)
+let[@foo] x = 2
+and[@bar] y = 3 in x + y           === (let x = 2 [@@foo] and y = 3 [@@bar] in x + y)
+\end{verbatim}
+
+
+\subsection{ss:builtin-attributes}{Built-in attributes}
+
+Some attributes are understood by the type-checker:
+\begin{itemize}
+\item
+ ``ocaml.warning'' or ``warning'', with a string literal payload.
+ This can be used as floating attributes in a
+ signature/structure/object/object type.  The string is parsed and has
+ the same effect as the "-w" command-line option, in the scope between
+ the attribute and the end of the current
+ signature/structure/object/object type.  The attribute can also be
+ attached to any kind of syntactic item which support attributes
+ (such as an expression, or a type expression)
+ in which case its scope is limited to that item.
+ Note that it is not well-defined which scope is used for a specific
+ warning.  This is implementation dependent and can change between versions.
+ Some warnings are even completely outside the control of ``ocaml.warning''
+ (for instance, warnings 1, 2, 14, 29 and 50).
+
+\item
+ ``ocaml.warnerror'' or ``warnerror'', with a string literal payload.
+ Same as ``ocaml.warning'', for the "-warn-error" command-line option.
+
+\item
+ ``ocaml.alert'' or ``alert'': see section~\ref{s:alerts}.
+
+\item
+  ``ocaml.deprecated'' or ``deprecated'': alias for the
+  ``deprecated'' alert, see section~\ref{s:alerts}.
+\item
+  ``ocaml.deprecated_mutable'' or ``deprecated_mutable''.
+  Can be applied to a mutable record label.  If the label is later
+  used to modify the field (with ``expr.l <- expr''), the ``deprecated'' alert
+  will be triggered.  If the payload of the attribute is a string literal,
+  the alert message includes this text.
+\item
+  ``ocaml.ppwarning'' or ``ppwarning'', in any context, with
+  a string literal payload.  The text is reported as warning (22)
+  by the compiler (currently, the warning location is the location
+  of the string payload).  This is mostly useful for preprocessors which
+  need to communicate warnings to the user.  This could also be used
+  to mark explicitly some code location for further inspection.
+\item
+  ``ocaml.warn_on_literal_pattern'' or ``warn_on_literal_pattern'' annotate
+  constructors in type definition. A warning (52) is then emitted when this
+  constructor is pattern matched with a constant literal as argument. This
+  attribute denotes constructors whose argument is purely informative and
+  may change in the future. Therefore, pattern matching on this argument
+  with a constant literal is unreliable. For instance, all built-in exception
+  constructors are marked as ``warn_on_literal_pattern''.
+  Note that, due to an implementation limitation, this warning (52) is only
+  triggered for single argument constructor.
+\item
+  ``ocaml.tailcall'' or ``tailcall'' can be applied to function
+  application in order to check that the call is tailcall optimized.
+  If it it not the case, a warning (51) is emitted.
+\item
+  ``ocaml.inline'' or ``inline'' take either ``never'', ``always''
+  or nothing as payload on a function or functor definition. If no payload
+  is provided, the default value is ``always''. This payload controls when
+  applications of the annotated functions should be inlined.
+\item
+  ``ocaml.inlined'' or ``inlined'' can be applied to any function or functor
+  application to check that the call is inlined by the compiler. If the call
+  is not inlined, a warning (55) is emitted.
+\item
+  ``ocaml.noalloc'', ``ocaml.unboxed''and ``ocaml.untagged'' or
+  ``noalloc'', ``unboxed'' and ``untagged'' can be used on external
+  definitions to obtain finer control over the C-to-OCaml interface. See
+  \ref{s:C-cheaper-call} for more details.
+\item
+  ``ocaml.immediate'' or ``immediate'' applied on an abstract type mark the type as
+  having a non-pointer implementation (e.g. ``int'', ``bool'', ``char'' or
+  enumerated types). Mutation of these immediate types does not activate the
+  garbage collector's write barrier, which can significantly boost performance in
+  programs relying heavily on mutable state.
+\item
+  ``ocaml.immediate64'' or ``immediate64'' applied on an abstract type mark the
+  type as having a non-pointer implementation on 64 bit platforms. No assumption
+  is made on other platforms. In order to produce a type with the
+  ``immediate64`` attribute, one must use ``Sys.Immediate64.Make`` functor.
+\item
+  "ocaml.unboxed" or "unboxed" can be used on a type definition if the
+  type is a single-field record or a concrete type with a single
+  constructor that has a single argument. It tells the compiler to
+  optimize the representation of the type by removing the block that
+  represents the record or the constructor (i.e. a value of this type
+  is physically equal to its argument). In the case of GADTs, an
+  additional restriction applies: the argument must not be an
+  existential variable, represented by an existential type variable,
+  or an abstract type constructor applied to an existential type
+  variable.
+\item
+   "ocaml.boxed" or "boxed" can be used on type definitions to mean
+   the opposite of "ocaml.unboxed": keep the unoptimized
+   representation of the type. When there is no annotation, the
+   default is currently "boxed" but it may change in the future.
+ \item
+   "ocaml.local" or "local" take either "never", "always", "maybe" or
+   nothing as payload on a function definition.  If no payload is
+   provided, the default is "always".  The attribute controls an
+   optimization which consists in compiling a function into a static
+   continuation.  Contrary to inlining, this optimization does not
+   duplicate the function's body.  This is possible when all
+   references to the function are full applications, all sharing the
+   same continuation (for instance, the returned value of several
+   branches of a pattern matching). "never" disables the optimization,
+   "always" asserts that the optimization applies (otherwise a warning
+   55 is emitted) and "maybe" lets the optimization apply when
+   possible (this is the default behavior when the attribute is not
+   specified).  The optimization is implicitly disabled when using the
+   bytecode compiler in debug mode (-g), and for functions marked with
+   an "ocaml.inline always" or "ocaml.unrolled" attribute which
+   supersede "ocaml.local".
+\end{itemize}
+
+\begin{caml_example*}{verbatim}
+module X = struct
+  [@@@warning "+9"]  (* locally enable warning 9 in this structure *)
+  [@@@ellipsis]
+end
+[@@deprecated "Please use module 'Y' instead."]
+
+let x = begin[@warning "+9"] [()[@ellipsis]] end
+
+type t = A | B
+  [@@deprecated "Please use type 's' instead."]
+\end{caml_example*}
+
+\begin{caml_example*}{verbatim}[warning=22]
+let fires_warning_22 x =
+  assert (x >= 0) [@ppwarning "TODO: remove this later"]
+\end{caml_example*}
+
+\begin{caml_example*}{verbatim}[warning=51]
+let rec is_a_tail_call = function
+  | [] -> ()
+  | _ :: q -> (is_a_tail_call[@tailcall]) q
+
+let rec not_a_tail_call = function
+  | [] -> []
+  | x :: q -> x :: (not_a_tail_call[@tailcall]) q
+\end{caml_example*}
+
+\begin{caml_example*}{verbatim}
+let f x = x [@@inline]
+
+let () = (f[@inlined]) ()
+\end{caml_example}
+
+\begin{caml_example*}{verbatim}
+type fragile =
+  | Int of int [@warn_on_literal_pattern]
+  | String of string [@warn_on_literal_pattern]
+\end{caml_example*}
+
+\begin{caml_example}{verbatim}[warning=52]
+let fragile_match_1 = function
+| Int 0 -> ()
+| _ -> ()
+\end{caml_example}
+
+\begin{caml_example}{verbatim}[warning=52]
+let fragile_match_2 = function
+| String "constant" -> ()
+| _ -> ()
+\end{caml_example}
+
+\begin{caml_example*}{verbatim}
+module Immediate: sig
+  type t [@@immediate]
+  val x: t ref
+end = struct
+  type t = A | B
+  let x = ref A
+end
+\end{caml_example*}
+
+\begin{caml_example*}{verbatim}
+module Int_or_int64 : sig
+  type t [@@immediate64]
+  val zero : t
+  val one : t
+  val add : t -> t -> t
+end = struct
+
+  include Sys.Immediate64.Make(Int)(Int64)
+
+  module type S = sig
+    val zero : t
+    val one : t
+    val add : t -> t -> t
+  end
+
+  let impl : (module S) =
+    match repr with
+    | Immediate ->
+        (module Int : S)
+    | Non_immediate ->
+        (module Int64 : S)
+
+  include (val impl : S)
+end
+\end{caml_example*}
+
+\section{s:extension-nodes}{Extension nodes}
+%HEVEA\cutname{extensionnodes.html}
+
+(Introduced in OCaml 4.02,
+infix notations for constructs other than expressions added in 4.03,
+infix notation (e1 ;\%ext e2) added in 4.04.
+)
+
+Extension nodes are generic placeholders in the syntax tree. They are
+rejected by the type-checker and are intended to be ``expanded'' by external
+tools such as "-ppx" rewriters.
+
+Extension nodes share the same notion of identifier and payload as
+attributes~\ref{s:attributes}.
+
+The first form of extension node is used for ``algebraic'' categories:
+
+\begin{syntax}
+extension:
+    '[%' attr-id attr-payload ']'
+;
+expr: ...
+     | extension
+;
+typexpr: ...
+     | extension
+;
+pattern: ...
+     | extension
+;
+module-expr: ...
+     | extension
+;
+module-type: ...
+     | extension
+;
+class-expr: ...
+     | extension
+;
+class-type: ...
+     | extension
+;
+\end{syntax}
+
+A second form of extension node can be used in structures and
+signatures, both in the module and object languages:
+
+\begin{syntax}
+item-extension:
+    '[%%' attr-id attr-payload ']'
+;
+definition: ...
+   | item-extension
+;
+specification: ...
+   | item-extension
+;
+class-field-spec: ...
+   | item-extension
+;
+class-field: ...
+   | item-extension
+;
+\end{syntax}
+
+An infix form is available for extension nodes when
+the payload is of the same kind
+(expression with expression, pattern with pattern ...).
+
+Examples:
+
+\begin{verbatim}
+let%foo x = 2 in x + 1     === [%foo let x = 2 in x + 1]
+begin%foo ... end          === [%foo begin ... end]
+x ;%foo 2                  === [%foo x; 2]
+module%foo M = ..          === [%%foo module M = ... ]
+val%foo x : t              === [%%foo: val x : t]
+\end{verbatim}
+
+When this form is used together with the infix syntax for attributes,
+the attributes are considered to apply to the payload:
+
+\begin{verbatim}
+fun%foo[@bar] x -> x + 1 === [%foo (fun x -> x + 1)[@bar ] ];
+\end{verbatim}
+
+Furthermore, quoted strings "{|...|}" can be combined with extension nodes
+to embed foreign syntax fragments. Those fragments can be interpreted
+by a preprocessor and turned into OCaml code without requiring escaping
+quotes. A syntax shortcut is available for them:
+
+\begin{verbatim}
+{%%foo|...|}               === [%%foo{|...|}]
+let x = {%foo|...|}        === let x = [%foo{|...|}]
+let y = {%foo bar|...|bar} === let y = [%foo{bar|...|bar}]
+\end{verbatim}
+
+For instance, you can use "{%sql|...|}" to
+represent arbitrary SQL statements -- assuming you have a ppx-rewriter
+that recognizes the "%sql" extension.
+
+Note that the word-delimited form, for example "{sql|...|sql}", should
+not be used for signaling that an extension is in use.
+Indeed, the user cannot see from the code whether this string literal has
+different semantics than they expect. Moreover, giving semantics to a
+specific delimiter limits the freedom to change the delimiter to avoid
+escaping issues.
+
+\subsection{ss:builtin-extension-nodes}{Built-in extension nodes}
+
+(Introduced in OCaml 4.03)
+
+Some extension nodes are understood by the compiler itself:
+\begin{itemize}
+  \item
+    ``ocaml.extension_constructor'' or ``extension_constructor''
+    take as payload a constructor from an extensible variant type
+    (see \ref{s:extensible-variants}) and return its extension
+    constructor slot.
+\end{itemize}
+
+\begin{caml_example*}{verbatim}
+type t = ..
+type t += X of int | Y of string
+let x = [%extension_constructor X]
+let y = [%extension_constructor Y]
+\end{caml_example*}
+\begin{caml_example}{toplevel}
+ x <> y;;
+\end{caml_example}
+
+\section{s:extensible-variants}{Extensible variant types}
+%HEVEA\cutname{extensiblevariants.html}
+
+(Introduced in OCaml 4.02)
+
+\begin{syntax}
+type-representation:
+          ...
+        | '=' '..'
+;
+specification:
+        ...
+      | 'type' [type-params] typeconstr type-extension-spec
+;
+definition:
+        ...
+      | 'type' [type-params] typeconstr type-extension-def
+;
+type-extension-spec: '+=' ['private'] ['|'] constr-decl { '|' constr-decl }
+;
+type-extension-def: '+=' ['private'] ['|'] constr-def { '|' constr-def }
+;
+constr-def:
+          constr-decl
+        | constr-name '=' constr
+;
+\end{syntax}
+
+Extensible variant types are variant types which can be extended with
+new variant constructors. Extensible variant types are defined using
+"..". New variant constructors are added using "+=".
+\begin{caml_example*}{verbatim}
+module Expr = struct
+  type attr = ..
+
+  type attr += Str of string
+
+  type attr +=
+    | Int of int
+    | Float of float
+end
+\end{caml_example*}
+
+Pattern matching on an extensible variant type requires a default case
+to handle unknown variant constructors:
+\begin{caml_example*}{verbatim}
+let to_string = function
+  | Expr.Str s -> s
+  | Expr.Int i -> Int.to_string i
+  | Expr.Float f -> string_of_float f
+  | _ -> "?"
+\end{caml_example*}
+
+A preexisting example of an extensible variant type is the built-in
+"exn" type used for exceptions. Indeed, exception constructors can be
+declared using the type extension syntax:
+\begin{caml_example*}{verbatim}
+type exn += Exc of int
+\end{caml_example*}
+
+Extensible variant constructors can be rebound to a different name. This
+allows exporting variants from another module.
+\begin{caml_example}{toplevel}[error]
+let not_in_scope = Str "Foo";;
+\end{caml_example}
+\begin{caml_example*}{verbatim}
+type Expr.attr += Str = Expr.Str
+\end{caml_example*}
+\begin{caml_example}{toplevel}
+let now_works = Str "foo";;
+\end{caml_example}
+
+Extensible variant constructors can be declared "private". As with
+regular variants, this prevents them from being constructed directly by
+constructor application while still allowing them to be de-structured in
+pattern-matching.
+\begin{caml_example*}{verbatim}
+module B : sig
+  type Expr.attr += private Bool of int
+  val bool : bool -> Expr.attr
+end = struct
+  type Expr.attr += Bool of int
+  let bool p = if p then Bool 1 else Bool 0
+end
+\end{caml_example*}
+
+\begin{caml_example}{toplevel}
+let inspection_works = function
+  | B.Bool p -> (p = 1)
+  | _ -> true;;
+\end{caml_example}
+\begin{caml_example}{toplevel}[error]
+let construction_is_forbidden = B.Bool 1;;
+\end{caml_example}
+
+\subsection{ss:private-extensible}{Private extensible variant types}
+
+(Introduced in OCaml 4.06)
+
+\begin{syntax}
+type-representation:
+          ...
+        | '=' 'private' '..'
+;
+\end{syntax}
+
+Extensible variant types can be declared "private". This prevents new
+constructors from being declared directly, but allows extension
+constructors to be referred to in interfaces.
+\begin{caml_example*}{verbatim}
+module Msg : sig
+  type t = private ..
+  module MkConstr (X : sig type t end) : sig
+    type t += C of X.t
+  end
+end = struct
+  type t = ..
+  module MkConstr (X : sig type t end) = struct
+    type t += C of X.t
+  end
+end
+\end{caml_example*}
+
+\section{s:generative-functors}{Generative functors}
+%HEVEA\cutname{generativefunctors.html}
+
+(Introduced in OCaml 4.02)
+
+\begin{syntax}
+module-expr:
+          ...
+        | 'functor' '()' '->' module-expr
+        | module-expr '()'
+;
+definition:
+          ...
+        | 'module' module-name { '(' module-name ':' module-type ')' || '()' }
+                   [ ':' module-type ] \\ '=' module-expr
+;
+module-type:
+          ...
+        | 'functor' '()' '->' module-type
+;
+specification:
+          ...
+        | 'module' module-name { '(' module-name ':' module-type ')' || '()' }
+          ':' module-type
+;
+\end{syntax}
+
+A generative functor takes a unit "()" argument.
+In order to use it, one must necessarily apply it to this unit argument,
+ensuring that all type components in the result of the functor behave
+in a generative way, {\em i.e.} they are different from types obtained
+by other applications of the same functor.
+This is equivalent to taking an argument of signature "sig end", and always
+applying to "struct end", but not to some defined module (in the
+latter case, applying twice to the same module would return identical
+types).
+
+As a side-effect of this generativity, one is allowed to unpack
+first-class modules in the body of generative functors.
+
+\section{s:extension-syntax}{Extension-only syntax}
+%HEVEA\cutname{extensionsyntax.html}
+(Introduced in OCaml 4.02.2, extended in 4.03)
+
+Some syntactic constructions are accepted during parsing and rejected
+during type checking. These syntactic constructions can therefore not
+be used directly in vanilla OCaml. However, "-ppx" rewriters and other
+external tools can exploit this parser leniency to extend the language
+with these new syntactic constructions by rewriting them to
+vanilla constructions.
+\subsection{ss:extension-operators}{Extension operators} \label{s:ext-ops}
+(Introduced in OCaml 4.02.2)
+\begin{syntax}
+infix-symbol:
+          ...
+        | "#" {operator-chars} "#"  {operator-char '|' "#"}
+;
+\end{syntax}
+
+Operator names starting with a "#" character and containing more than
+one "#" character are reserved for extensions.
+
+\subsection{ss:extension-literals}{Extension literals}
+(Introduced in OCaml 4.03)
+\begin{syntax}
+float-literal:
+       ...
+     | ["-"] ("0"\ldots"9") { "0"\ldots"9"||"_" } ["." { "0"\ldots"9"||"_" }]
+       [("e"||"E") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
+       ["g"\ldots"z"||"G"\ldots"Z"]
+     | ["-"] ("0x"||"0X")
+       ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
+       { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }\\
+       ["." { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }]
+       [("p"||"P") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
+       ["g"\ldots"z"||"G"\ldots"Z"]
+;
+int-literal:
+           ...
+        | ["-"] ("0"\ldots"9") { "0"\ldots"9" || "_" }["g"\ldots"z"||"G"\ldots"Z"]
+        | ["-"] ("0x"||"0X") ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
+          { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }
+          ["g"\ldots"z"||"G"\ldots"Z"]
+        | ["-"] ("0o"||"0O") ("0"\ldots"7") { "0"\ldots"7"||"_" }
+          ["g"\ldots"z"||"G"\ldots"Z"]
+        | ["-"] ("0b"||"0B") ("0"\ldots"1") { "0"\ldots"1"||"_" }
+          ["g"\ldots"z"||"G"\ldots"Z"]
+;
+\end{syntax}
+Int and float literals followed by an one-letter identifier in the
+range @["g".."z"||"G".."Z"]@ are extension-only literals.
+
+\section{s:inline-records}{Inline records}
+%HEVEA\cutname{inlinerecords.html}
+(Introduced in OCaml 4.03)
+\begin{syntax}
+  constr-args:
+          ...
+          | record-decl
+;
+\end{syntax}
+
+The arguments of sum-type constructors can now be defined using the
+same syntax as records.  Mutable and polymorphic fields are allowed.
+GADT syntax is supported.  Attributes can be specified on individual
+fields.
+
+Syntactically, building or matching constructors with such an inline
+record argument is similar to working with a unary constructor whose
+unique argument is a declared record type.  A pattern can bind
+the inline record as a pseudo-value, but the record cannot escape the
+scope of the binding and can only be used with the dot-notation to
+extract or modify fields or to build new constructor values.
+
+\begin{caml_example*}{verbatim}
+type t =
+  | Point of {width: int; mutable x: float; mutable y: float}
+  | Other
+
+let v = Point {width = 10; x = 0.; y = 0.}
+
+let scale l = function
+  | Point p -> Point {p with x = l *. p.x; y = l *. p.y}
+  | Other -> Other
+
+let print = function
+  | Point {x; y; _} -> Printf.printf "%f/%f" x y
+  | Other -> ()
+
+let reset = function
+  | Point p -> p.x <- 0.; p.y <- 0.
+  | Other -> ()
+\end{caml_example*}
+
+\begin{caml_example}{verbatim}[error]
+let invalid = function
+  | Point p -> p
+\end{caml_example}
+
+\section{s:doc-comments}{Documentation comments}
+%HEVEA\cutname{doccomments.html}
+(Introduced in OCaml 4.03)
+
+Comments which start with "**" are treated specially by the
+compiler. They are automatically converted during parsing into
+attributes (see \ref{s:attributes}) to allow tools to process them as
+documentation.
+
+Such comments can take three forms: {\em floating comments}, {\em item
+comments} and {\em label comments}. Any comment starting with "**" which
+does not match one of these forms will cause the compiler to emit
+warning 50.
+
+Comments which start with "**" are also used by the ocamldoc
+documentation generator (see \ref{c:ocamldoc}). The three comment forms
+recognised by the compiler are a subset of the forms accepted by
+ocamldoc (see \ref{s:ocamldoc-comments}).
+
+\subsection{ss:floating-comments}{Floating comments}
+
+Comments surrounded by blank lines that appear within structures,
+signatures, classes or class types are converted into
+@floating-attribute@s. For example:
+
+\begin{caml_example*}{verbatim}
+type t = T
+
+(** Now some definitions for [t] *)
+
+let mkT = T
+\end{caml_example*}
+
+will be converted to:
+
+\begin{caml_example*}{verbatim}
+type t = T
+
+[@@@ocaml.text " Now some definitions for [t] "]
+
+let mkT = T
+\end{caml_example*}
+
+\subsection{ss:item-comments}{Item comments}
+
+Comments which appear {\em immediately before} or {\em immediately
+after} a structure item, signature item, class item or class type item
+are converted into @item-attribute@s. Immediately before or immediately
+after means that there must be no blank lines, ";;", or other
+documentation comments between them. For example:
+
+\begin{caml_example*}{verbatim}
+type t = T
+(** A description of [t] *)
+
+\end{caml_example*}
+
+or
+
+\begin{caml_example*}{verbatim}
+
+(** A description of [t] *)
+type t = T
+\end{caml_example*}
+
+will be converted to:
+
+\begin{caml_example*}{verbatim}
+type t = T
+[@@ocaml.doc " A description of [t] "]
+\end{caml_example*}
+
+Note that, if a comment appears immediately next to multiple items,
+as in:
+
+\begin{caml_example*}{verbatim}
+type t = T
+(** An ambiguous comment *)
+type s = S
+\end{caml_example*}
+
+then it will be attached to both items:
+
+\begin{caml_example*}{verbatim}
+type t = T
+[@@ocaml.doc " An ambiguous comment "]
+type s = S
+[@@ocaml.doc " An ambiguous comment "]
+\end{caml_example*}
+
+and the compiler will emit warning 50.
+
+\subsection{ss:label-comments}{Label comments}
+
+Comments which appear {\em immediately after} a labelled argument,
+record field, variant constructor, object method or polymorphic variant
+constructor are are converted into @attribute@s. Immediately
+after means that there must be no blank lines or other documentation
+comments between them. For example:
+
+\begin{caml_example*}{verbatim}
+type t1 = lbl:int (** Labelled argument *) -> unit
+
+type t2 = {
+  fld: int; (** Record field *)
+  fld2: float;
+}
+
+type t3 =
+  | Cstr of string (** Variant constructor *)
+  | Cstr2 of string
+
+type t4 = < meth: int * int; (** Object method *) >
+
+type t5 = [
+  `PCstr (** Polymorphic variant constructor *)
+]
+\end{caml_example*}
+
+will be converted to:
+
+\begin{caml_example*}{verbatim}
+type t1 = lbl:(int [@ocaml.doc " Labelled argument "]) -> unit
+
+type t2 = {
+  fld: int [@ocaml.doc " Record field "];
+  fld2: float;
+}
+
+type t3 =
+  | Cstr of string [@ocaml.doc " Variant constructor "]
+  | Cstr2 of string
+
+type t4 = < meth : int * int [@ocaml.doc " Object method "] >
+
+type t5 = [
+  `PCstr [@ocaml.doc " Polymorphic variant constructor "]
+]
+\end{caml_example*}
+
+Note that label comments take precedence over item comments, so:
+
+\begin{caml_example*}{verbatim}
+type t = T of string
+(** Attaches to T not t *)
+\end{caml_example*}
+
+will be converted to:
+
+\begin{caml_example*}{verbatim}
+type t =  T of string [@ocaml.doc " Attaches to T not t "]
+\end{caml_example*}
+
+whilst:
+
+\begin{caml_example*}{verbatim}
+type t = T of string
+(** Attaches to T not t *)
+(** Attaches to t *)
+\end{caml_example*}
+
+will be converted to:
+
+\begin{caml_example*}{verbatim}
+type t =  T of string [@ocaml.doc " Attaches to T not t "]
+[@@ocaml.doc " Attaches to t "]
+\end{caml_example*}
+
+In the absence of meaningful comment on the last constructor of
+a type, an empty comment~"(**)" can be used instead:
+
+\begin{caml_example*}{verbatim}
+type t = T of string
+(**)
+(** Attaches to t *)
+\end{caml_example*}
+
+will be converted directly to
+
+\begin{caml_example*}{verbatim}
+type t =  T of string
+[@@ocaml.doc " Attaches to t "]
+\end{caml_example*}
+
+\section{s:index-operators}{Extended indexing operators }
+%HEVEA\cutname{indexops.html}
+(Introduced in 4.06)
+
+\begin{syntax}
+
+dot-ext:
+   | dot-operator-char { operator-char }
+;
+dot-operator-char:
+  '!' ||  '?' || core-operator-char || '%' || ':'
+;
+expr:
+          ...
+        | expr '.' [module-path '.'] dot-ext ( '(' expr ')' || '[' expr ']' || '{' expr '}' ) [ '<-' expr ]
+;
+operator-name:
+          ...
+        | '.' dot-ext ('()' || '[]' || '{}') ['<-']
+;
+\end{syntax}
+
+
+This extension provides syntactic sugar for getting and setting elements
+for user-defined indexed types. For instance, we can define python-like
+dictionaries with
+\begin{caml_example*}{verbatim}
+module Dict = struct
+include Hashtbl
+let ( .%{} ) tabl index = find tabl index
+let ( .%{}<- ) tabl index value = add tabl index value
+end
+let dict =
+  let dict = Dict.create 10 in
+  let () =
+    dict.Dict.%{"one"} <- 1;
+    let open Dict in
+    dict.%{"two"} <- 2 in
+  dict
+\end{caml_example*}
+\begin{caml_example}{toplevel}
+dict.Dict.%{"one"};;
+let open Dict in dict.%{"two"};;
+\end{caml_example}
+
+\subsection{ss:multiindexing}{Multi-index notation}
+\begin{syntax}
+expr:
+          ...
+        | expr '.' [module-path '.'] dot-ext '(' expr {{';' expr }} ')' [ '<-' expr ]
+        | expr '.' [module-path '.'] dot-ext '[' expr {{';' expr }} ']' [ '<-' expr ]
+        | expr '.' [module-path '.'] dot-ext '{' expr {{';' expr }} '}' [ '<-' expr ]
+;
+operator-name:
+          ...
+        | '.' dot-ext ('(;..)' || '[;..]' || '{;..}') ['<-']
+;
+\end{syntax}
+
+Multi-index are also supported through a second variant of indexing operators
+
+\begin{caml_example*}{verbatim}
+let (.%[;..]) = Bigarray.Genarray.get
+let (.%{;..}) = Bigarray.Genarray.get
+let (.%(;..)) = Bigarray.Genarray.get
+\end{caml_example*}
+
+which is called when an index literals contain a semicolon separated list
+of expressions with two and more elements:
+
+\begin{caml_example*}{verbatim}
+let sum x y = x.%[1;2;3] + y.%[1;2]
+(* is equivalent to *)
+let sum x y = (.%[;..]) x [|1;2;3|] + (.%[;..]) y [|1;2|]
+\end{caml_example*}
+
+In particular this multi-index notation makes it possible to uniformly handle
+indexing Genarray and other implementations of multidimensional arrays.
+
+\begin{caml_example*}{verbatim}
+module A = Bigarray.Genarray
+let (.%{;..}) = A.get
+let (.%{;..}<- ) = A.set
+let (.%{ }) a k = A.get a [|k|]
+let (.%{ }<-) a k x = A.set a [|k|] x
+let syntax_compare vec mat t3 t4 =
+          vec.%{0} = A.get vec [|0|]
+   &&   mat.%{0;0} = A.get mat [|0;0|]
+   &&   t3.%{0;0;0} = A.get t3 [|0;0;0|]
+   && t4.%{0;0;0;0} = t4.{0,0,0,0}
+\end{caml_example*}
+
+
+
+\section{s:empty-variants}{Empty variant types}
+%HEVEA\cutname{emptyvariants.html}
+(Introduced in 4.07.0)
+
+\begin{syntax}
+type-representation:
+          ...
+        | '=' '|'
+\end{syntax}
+This extension allows user to define empty variants.
+Empty variant type can be eliminated by refutation case of pattern matching.
+\begin{caml_example*}{verbatim}
+type t = |
+let f (x: t) = match x with _ -> .
+\end{caml_example*}
+
+\section{s:alerts}{Alerts}
+%HEVEA\cutname{alerts.html}
+(Introduced in 4.08)
+
+Since OCaml 4.08, it is possible to mark components (such as value or
+type declarations) in signatures with ``alerts'' that will be reported
+when those components are referenced.  This generalizes the notion of
+``deprecated'' components which were previously reported as warning 3.
+Those alerts can be used for instance to report usage of unsafe
+features, or of features which are only available on some platforms,
+etc.
+
+Alert categories are identified by a symbolic identifier (a lowercase
+identifier, following the usual lexical rules) and an optional
+message.  The identifier is used to control which alerts are enabled,
+and which ones are turned into fatal errors.  The message is reported
+to the user when the alert is triggered (i.e. when the marked
+component is referenced).
+
+The "ocaml.alert" or "alert" attribute serves two purposes: (i) to
+mark component with an alert to be triggered when the component is
+referenced, and (ii) to control which alert names are enabled.  In the
+first form, the attribute takes an identifier possibly
+followed by a message. Here is an example of a value declaration marked
+with an alert:
+
+\begin{verbatim}
+module U: sig
+  val fork: unit -> bool
+    [@@alert unix "This function is only available under Unix."]
+end
+\end{verbatim}
+
+Here "unix" is the identifier for the alert.  If this alert category
+is enabled, any reference to "U.fork" will produce a message at
+compile time, which can be turned or not into a fatal error.
+
+And here is another example as a floating attribute on top
+of an ``.mli'' file (i.e. before any other non-attribute item)
+or on top of an ``.ml'' file without a corresponding interface file,
+so that any reference to that unit will trigger the alert:
+
+\begin{verbatim}
+[@@@alert unsafe "This module is unsafe!"]
+\end{verbatim}
+
+
+Controlling which alerts are enabled and whether they are turned into
+fatal errors is done either through the compiler's command-line option
+"-alert " or locally in the code through the "alert" or
+"ocaml.alert" attribute taking a single string payload "".  In
+both cases, the syntax for "" is a concatenation of items of the
+form:
+
+\begin{itemize}
+\item "+id" enables alert "id".
+\item "-id" disables alert "id".
+\item "++id" turns alert "id" into a fatal error.
+\item "--id" turns alert "id" into non-fatal mode.
+\item "\@id" equivalent to "++id+id" (enables "id" and turns it into a fatal-error)
+\end{itemize}
+
+As a special case, if "id" is "all", it stands for all alerts.
+
+Here are some examples:
+
+\begin{verbatim}
+
+(* Disable all alerts, reenables just unix (as a soft alert) and window
+   (as a fatal-error), for the rest of the current structure *)
+
+[@@@alert "-all--all+unix@window"]
+ ...
+
+let x =
+  (* Locally disable the window alert *)
+  begin[@alert "-window"]
+      ...
+  end
+\end{verbatim}
+
+Before OCaml 4.08, there was support for a single kind of deprecation
+alert.  It is now known as the "deprecated" alert, but legacy
+attributes to trigger it and the legacy ways to control it as warning
+3 are still supported. For instance, passing "-w +3" on the
+command-line is equivant to "-alert +deprecated", and:
+
+\begin{verbatim}
+val x: int
+  [@@@ocaml.deprecated "Please do something else"]
+\end{verbatim}
+
+is equivalent to:
+
+\begin{verbatim}
+val x: int
+  [@@@ocaml.alert deprecated "Please do something else"]
+\end{verbatim}
+
+\section{s:generalized-open}{Generalized open statements}
+%HEVEA\cutname{generalizedopens.html}
+
+(Introduced in 4.08)
+
+\begin{syntax}
+definition:
+      ...
+   |  'open'  module-expr
+   |  'open!' module-expr
+;
+specification:
+      ...
+   |  'open'  extended-module-path
+   |  'open!' extended-module-path
+;
+expr:
+       ...
+     | 'let' 'open'  module-expr 'in' expr
+     | 'let' 'open!' module-expr 'in' expr
+;
+\end{syntax}
+
+
+This extension makes it possible to open any module expression in
+module structures and expressions. A similar mechanism is also available
+inside module types, but only for extended module paths (e.g. "F(X).G(Y)").
+
+For instance, a module can be constrained when opened with
+
+\begin{caml_example*}{verbatim}[error]
+module M = struct let x = 0 let hidden = 1 end
+open (M:sig val x: int end)
+let y = hidden
+\end{caml_example*}
+
+
+Another possibility is to immediately open the result of a functor application
+
+\begin{caml_example}{verbatim}
+  let sort (type x) (x:x list) =
+    let open Set.Make(struct type t = x let compare=compare end) in
+    elements (of_list x)
+\end{caml_example}
+
+Going further, this construction can introduce local components inside a
+structure,
+
+\begin{caml_example}{verbatim}
+module M = struct
+  let x = 0
+  open! struct
+    let x = 0
+    let y = 1
+  end
+  let w = x + y
+end
+\end{caml_example}
+
+One important restriction is that types introduced by @'open' 'struct' ...
+'end'@ cannot appear in the signature of the enclosing structure, unless they
+are defined equal to some non-local type.
+So:
+
+\begin{caml_example}{verbatim}
+module M = struct
+  open struct type 'a t = 'a option = None | Some of 'a end
+  let x : int t = Some 1
+end
+\end{caml_example}
+is OK, but:
+
+\begin{caml_example}{verbatim}[error]
+module M = struct
+  open struct type t = A end
+  let x = A
+end
+\end{caml_example}
+is not because "x" cannot be given any type other than "t", which only exists
+locally. Although the above would be OK if "x" too was local:
+
+\begin{caml_example}{verbatim}
+module M: sig end = struct
+  open struct
+  type t = A
+  end
+  [@@@ellipsis]
+  open struct let x = A end
+  [@@@ellipsis]
+end
+\end{caml_example}
+
+Inside signatures, extended opens are limited to extended module paths,
+\begin{caml_example}{verbatim}
+module type S = sig
+  module F: sig end -> sig type t end
+  module X: sig end
+  open F(X)
+  val f: t
+end
+\end{caml_example}
+
+and not
+
+\begin{verbatim}
+  open struct type t = int end
+\end{verbatim}
+
+In those situations, local substitutions(see \ref{ss:local-substitution})
+can be used instead.
+
+Beware that this extension is not available inside class definitions:
+
+\begin{verbatim}
+class c =
+  let open Set.Make(Int) in
+  ...
+\end{verbatim}
+
+\section{s:binding-operators}{Binding operators}
+%HEVEA\cutname{bindingops.html}
+(Introduced in 4.08.0)
+
+\begin{syntax}
+let-operator:
+ | 'let' (core-operator-char || '<') { dot-operator-char }
+;
+and-operator:
+ | 'and' (core-operator-char || '<') { dot-operator-char }
+;
+operator-name :
+          ...
+        | let-operator
+        | and-operator
+;
+expr:
+          ...
+        | let-operator let-binding { and-operator let-binding } in expr
+;
+\end{syntax}
+
+Users can define {\em let operators}:
+
+\begin{caml_example}{verbatim}
+let ( let* ) o f =
+  match o with
+  | None -> None
+  | Some x -> f x
+
+let return x = Some x
+\end{caml_example}
+
+and then apply them using this convenient syntax:
+
+\begin{caml_example}{verbatim}
+let find_and_sum tbl k1 k2 =
+  let* x1 = Hashtbl.find_opt tbl k1 in
+  let* x2 = Hashtbl.find_opt tbl k2 in
+    return (x1 + x2)
+\end{caml_example}
+
+which is equivalent to this expanded form:
+
+\begin{caml_example}{verbatim}
+let find_and_sum tbl k1 k2 =
+  ( let* ) (Hashtbl.find_opt tbl k1)
+    (fun x1 ->
+       ( let* ) (Hashtbl.find_opt tbl k2)
+         (fun x2 -> return (x1 + x2)))
+\end{caml_example}
+
+Users can also define {\em and operators}:
+
+\begin{caml_example}{verbatim}
+module ZipSeq = struct
+
+  type 'a t = 'a Seq.t
+
+  open Seq
+
+  let rec return x =
+    fun () -> Cons(x, return x)
+
+  let rec prod a b =
+    fun () ->
+      match a (), b () with
+      | Nil, _ | _, Nil -> Nil
+      | Cons(x, a), Cons(y, b) -> Cons((x, y), prod a b)
+
+  let ( let+ ) f s = map s f
+  let ( and+ ) a b = prod a b
+
+end
+\end{caml_example}
+
+to support the syntax:
+
+\begin{caml_example}{verbatim}
+open ZipSeq
+let sum3 z1 z2 z3 =
+  let+ x1 = z1
+  and+ x2 = z2
+  and+ x3 = z3 in
+    x1 + x2 + x3
+\end{caml_example}
+
+which is equivalent to this expanded form:
+
+\begin{caml_example}{verbatim}
+open ZipSeq
+let sum3 z1 z2 z3 =
+  ( let+ ) (( and+ ) (( and+ ) z1 z2) z3)
+    (fun ((x1, x2), x3) -> x1 + x2 + x3)
+\end{caml_example}
+
+\subsection{ss:letops-rationale}{Rationale}
+
+This extension is intended to provide a convenient syntax for working
+with monads and applicatives.
+
+An applicative should provide a module implementing the following
+interface:
+
+\begin{caml_example*}{verbatim}
+module type Applicative_syntax = sig
+  type 'a t
+  val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
+  val ( and+ ): 'a t -> 'b t -> ('a * 'b) t
+end
+\end{caml_example*}
+
+where "(let+)" is bound to the "map" operation and "(and+)" is bound to
+the monoidal product operation.
+
+A monad should provide a module implementing the following interface:
+
+\begin{caml_example*}{verbatim}
+module type Monad_syntax = sig
+  include Applicative_syntax
+  val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
+  val ( and* ): 'a t -> 'b t -> ('a * 'b) t
+end
+\end{caml_example*}
+
+where "(let*)" is bound to the "bind" operation, and "(and*)" is also
+bound to the monoidal product operation.
+
+%HEVEA\cutend
diff --git a/manual/manual/refman/lex.etex b/manual/manual/refman/lex.etex
new file mode 100644
index 00000000..78d8b036
--- /dev/null
+++ b/manual/manual/refman/lex.etex
@@ -0,0 +1,324 @@
+\section{s:lexical-conventions}{Lexical conventions}
+%HEVEA\cutname{lex.html}
+\subsubsection*{sss:lex:blanks}{Blanks}
+
+The following characters are considered as blanks: space,
+horizontal tabulation, carriage return, line feed and form feed. Blanks are
+ignored, but they separate adjacent identifiers, literals and
+keywords that would otherwise be confused as one single identifier,
+literal or keyword.
+
+\subsubsection*{sss:lex:comments}{Comments}
+
+Comments are introduced by the two characters  @"(*"@, with no
+intervening blanks, and terminated by the characters @"*)"@, with
+no intervening blanks. Comments are treated as blank characters.
+Comments do not occur inside string or character literals. Nested
+comments are handled correctly.
+
+\subsubsection*{sss:lex:identifiers}{Identifiers}
+
+\begin{syntax}
+ident: ( letter || "_" ) { letter || "0" \ldots "9" || "_" || "'" } ;
+capitalized-ident: ("A" \ldots "Z") { letter || "0" \ldots "9" || "_" || "'" } ;
+lowercase-ident:
+   ("a" \ldots "z" || "_") { letter || "0" \ldots "9" || "_" || "'" } ;
+letter: "A" \ldots "Z" || "a" \ldots "z"
+\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.
+
+All characters in an identifier are
+meaningful. The current implementation accepts identifiers up to
+16000000 characters in length.
+
+In many places, OCaml makes a distinction between capitalized
+identifiers and identifiers that begin with a lowercase letter.  The
+underscore character is considered a lowercase letter for this
+purpose.
+
+\subsubsection*{sss:integer-literals}{Integer literals}
+
+\begin{syntax}
+integer-literal:
+          ["-"] ("0"\ldots"9") { "0"\ldots"9" || "_" }
+        | ["-"] ("0x"||"0X") ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
+                            { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }
+        | ["-"] ("0o"||"0O") ("0"\ldots"7") { "0"\ldots"7"||"_" }
+        | ["-"] ("0b"||"0B") ("0"\ldots"1") { "0"\ldots"1"||"_" }
+;
+int32-literal: integer-literal 'l'
+;
+int64-literal: integer-literal 'L'
+;
+nativeint-literal: integer-literal 'n'
+\end{syntax}
+
+An integer literal is a sequence of one or more digits, optionally
+preceded by a minus sign. By default, integer literals are in decimal
+(radix 10). The following prefixes select a different radix:
+\begin{tableau}{|l|l|}{Prefix}{Radix}
+\entree{"0x", "0X"}{hexadecimal (radix 16)}
+\entree{"0o", "0O"}{octal (radix 8)}
+\entree{"0b", "0B"}{binary (radix 2)}
+\end{tableau}
+(The initial @"0"@ is the digit zero; the @"O"@ for octal is the letter O.)
+An integer literal can be followed by one of the letters "l", "L" or "n"
+to indicate that this integer has type "int32", "int64" or "nativeint"
+respectively, instead of the default type "int" for integer literals.
+The interpretation of integer literals that fall outside the range of
+representable integer values is undefined.
+
+For convenience and readability, underscore characters (@"_"@) are accepted
+(and ignored) within integer literals.
+
+\subsubsection*{sss:floating-point-literals}{Floating-point literals}
+
+\begin{syntax}
+float-literal:
+          ["-"] ("0"\ldots"9") { "0"\ldots"9"||"_" } ["." { "0"\ldots"9"||"_" }]
+          [("e"||"E") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
+        | ["-"] ("0x"||"0X")
+          ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
+          { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" } \\
+          ["." { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }]
+          [("p"||"P") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
+\end{syntax}
+
+Floating-point decimal literals consist in an integer part, a
+fractional part and
+an exponent part. The integer part is a sequence of one or more
+digits, optionally preceded by a minus sign. The fractional part is a
+decimal point followed by zero, one or more digits.
+The exponent part is the character @"e"@ or @"E"@ followed by an
+optional @"+"@ or @"-"@ sign, followed by one or more digits.  It is
+interpreted as a power of 10.
+The fractional part or the exponent part can be omitted but not both, to
+avoid ambiguity with integer literals.
+The interpretation of floating-point literals that fall outside the
+range of representable floating-point values is undefined.
+
+Floating-point hexadecimal literals are denoted with the @"0x"@ or @"0X"@
+prefix.  The syntax is similar to that of floating-point decimal
+literals, with the following differences.
+The integer part and the fractional part use hexadecimal
+digits.  The exponent part starts with the character  @"p"@ or @"P"@.
+It is written in decimal and interpreted as a power of 2.
+
+For convenience and readability, underscore characters (@"_"@) are accepted
+(and ignored) within floating-point literals.
+
+\subsubsection*{sss:character-literals}{Character literals}
+\label{s:characterliteral}
+
+\begin{syntax}
+char-literal:
+          "'" regular-char "'"
+        | "'" escape-sequence "'"
+;
+escape-sequence:
+          "\" ( "\" || '"' || "'" || "n" || "t" || "b" || "r" || space )
+        | "\" ("0"\ldots"9") ("0"\ldots"9") ("0"\ldots"9")
+        | "\x" ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
+               ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
+        | "\o" ("0"\ldots"3") ("0"\ldots"7") ("0"\ldots"7")
+\end{syntax}
+
+Character literals are delimited by @"'"@ (single quote) characters.
+The two single quotes enclose either one character different from
+@"'"@ and @'\'@, or one of the escape sequences below:
+\begin{tableau}{|l|l|}{Sequence}{Character denoted}
+\entree{"\\\\"}{backslash ("\\")}
+\entree{"\\\""}{double quote ("\"")}
+\entree{"\\'"}{single quote ("'")}
+\entree{"\\n"}{linefeed (LF)}
+\entree{"\\r"}{carriage return (CR)}
+\entree{"\\t"}{horizontal tabulation (TAB)}
+\entree{"\\b"}{backspace (BS)}
+\entree{"\\"\var{space}}{space (SPC)}
+\entree{"\\"\var{ddd}}{the character with ASCII code \var{ddd} in decimal}
+\entree{"\\x"\var{hh}}{the character with ASCII code \var{hh} in hexadecimal}
+\entree{"\\o"\var{ooo}}{the character with ASCII code \var{ooo} in octal}
+\end{tableau}
+
+\subsubsection*{sss:stringliterals}{String literals}
+
+\begin{syntax}
+string-literal:
+          '"' { string-character } '"'
+       |  '{' quoted-string-id '|'  { any-char } '|' quoted-string-id '}'
+;
+quoted-string-id:
+     { 'a'...'z' || '_' }
+;
+;
+string-character:
+          regular-string-char
+        | escape-sequence
+        | "\u{" {{ "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f" }} "}"
+        | '\' newline { space || tab }
+\end{syntax}
+
+String literals are delimited by @'"'@ (double quote) characters.
+The two double quotes enclose a sequence of either characters
+different from @'"'@ and @'\'@, or escape sequences from the
+table given above for character literals, or a Unicode character
+escape sequence.
+
+A Unicode character escape sequence is substituted by the UTF-8
+encoding of the specified Unicode scalar value. The Unicode scalar
+value, an integer in the ranges 0x0000...0xD7FF or 0xE000...0x10FFFF,
+is defined using 1 to 6 hexadecimal digits; leading zeros are allowed.
+
+To allow splitting long string literals across lines, the sequence
+"\\"\var{newline}~\var{spaces-or-tabs} (a backslash at the end of a line
+followed by any number of spaces and horizontal tabulations at the
+beginning of the next line) is ignored inside string literals.
+
+Quoted string literals provide an alternative lexical syntax for
+string literals. They are useful to represent strings of arbitrary content
+without escaping. Quoted strings are delimited by a matching pair
+of @'{' quoted-string-id '|'@ and @'|' quoted-string-id '}'@ with
+the same @quoted-string-id@ on both sides. Quoted strings do not interpret
+any character in a special way but requires that the
+sequence @'|' quoted-string-id '}'@ does not occur in the string itself.
+The identifier @quoted-string-id@ is a (possibly empty) sequence of
+lowercase letters and underscores that can be freely chosen to avoid
+such issue (e.g. "{|hello|}", "{ext|hello {|world|}|ext}", ...).
+
+
+The current implementation places practically no restrictions on the
+length of string literals.
+
+\subsubsection*{sss:labelname}{Naming labels}
+
+To avoid ambiguities, naming labels in expressions cannot just be defined
+syntactically as the sequence of the three tokens "~", @ident@ and
+":", and have to be defined at the lexical level.
+
+\begin{syntax}
+label-name: lowercase-ident
+;
+label: "~" label-name ":"
+;
+optlabel: "?" label-name ":"
+\end{syntax}
+
+Naming labels come in two flavours: @label@ for normal arguments and
+@optlabel@ for optional ones. They are simply distinguished by their
+first character, either "~" or "?".
+
+Despite @label@ and @optlabel@ being lexical entities in expressions,
+their expansions @'~' label-name ':'@ and @'?' label-name ':'@ will be
+used in grammars, for the sake of readability. Note also that inside
+type expressions, this expansion can be taken literally, {\em i.e.}
+there are really 3 tokens, with optional blanks between them.
+
+\subsubsection*{sss:lex-ops-symbols}{Prefix and infix symbols}
+
+%%  || '`' lowercase-ident '`'
+
+\begin{syntax}
+infix-symbol:
+        ( core-operator-char || '%' || '<' ) { operator-char }
+      | "#" {{ operator-char }}
+;
+prefix-symbol:
+        '!' { operator-char }
+      | ('?' || '~') {{ operator-char }}
+;
+operator-char:
+        '~' || '!' || '?' || core-operator-char || '%' || '<' || ':' || '.'
+;
+core-operator-char:
+        '$' || '&' || '*' || '+' || '-' || '/' || '=' || '>' || '@' || '^' || '|'
+\end{syntax}
+See also the following language extensions:
+\hyperref[s:ext-ops]{extension operators},
+\hyperref[s:index-operators]{extended indexing operators},
+and \hyperref[s:binding-operators]{binding operators}.
+
+Sequences of ``operator characters'', such as "<=>" or "!!",
+are read as a single token from the @infix-symbol@ or @prefix-symbol@
+class. These symbols are parsed as prefix and infix operators inside
+expressions, but otherwise behave like normal identifiers.
+%% Identifiers starting with a lowercase letter and enclosed
+%% between backquote characters @'`' lowercase-ident '`'@ are also parsed
+%% as infix operators.
+
+\subsubsection*{sss:keywords}{Keywords}
+
+The identifiers below are reserved as keywords, and cannot be employed
+otherwise:
+\begin{verbatim}
+      and         as          assert      asr         begin       class
+      constraint  do          done        downto      else        end
+      exception   external    false       for         fun         function
+      functor     if          in          include     inherit     initializer
+      land        lazy        let         lor         lsl         lsr
+      lxor        match       method      mod         module      mutable
+      new         nonrec      object      of          open        or
+      private     rec         sig         struct      then        to
+      true        try         type        val         virtual     when
+      while       with
+\end{verbatim}
+%
+\goodbreak%
+%
+The following character sequences are also keywords:
+%
+%% FIXME the token >] is not used anywhere in the syntax
+%
+\begin{alltt}
+"    !=    #     &     &&    '     (     )     *     +     ,     -"
+"    -.    ->    .     ..    .~    :     ::    :=    :>    ;     ;;"
+"    <     <-    =     >     >]    >}    ?     [     [<    [>    [|"
+"    ]     _     `     {     {<    |     |]    ||    }     ~"
+\end{alltt}
+%
+Note that the following identifiers are keywords of the Camlp4
+extensions and should be avoided for compatibility reasons.
+%
+\begin{verbatim}
+    parser    value    $     $$    $:    <:    <<    >>    ??
+\end{verbatim}
+
+\subsubsection*{sss:lex-ambiguities}{Ambiguities}
+
+Lexical ambiguities are resolved according to the ``longest match''
+rule: when a character sequence can be decomposed into two tokens in
+several different ways, the decomposition retained is the one with the
+longest first token.
+
+\subsubsection*{sss:lex-linedir}{Line number directives}
+
+\begin{syntax}
+linenum-directive:
+        '#' {{"0" \ldots "9"}}
+      | '#' {{"0" \ldots "9"}} '"' { string-character } '"'
+\end{syntax}
+
+Preprocessors that generate OCaml source code can insert line number
+directives in their output so that error messages produced by the
+compiler contain line numbers and file names referring to the source
+file before preprocessing, instead of after preprocessing.
+A line number directive is composed of a @"#"@ (sharp sign), followed by
+a positive integer (the source line number), optionally followed by a
+character string (the source file name).
+Line number directives are treated as blanks during lexical
+analysis.
+
+% FIXME spaces and tabs are allowed before and after the number
+% FIXME ``string-character'' is inaccurate: everything is allowed except
+%       CR, LF, and doublequote; moreover, backslash escapes are not
+% interpreted (especially backslash-doublequote)
+% FIXME any number of random characters are allowed (and ignored) at the
+%       end of the line, except CR and LF.
diff --git a/manual/manual/refman/modtypes.etex b/manual/manual/refman/modtypes.etex
new file mode 100644
index 00000000..5d406db1
--- /dev/null
+++ b/manual/manual/refman/modtypes.etex
@@ -0,0 +1,302 @@
+\section{s:modtypes}{Module types (module specifications)}
+%HEVEA\cutname{modtypes.html}
+
+Module types are the module-level equivalent of type expressions: they
+specify the general shape and type properties of modules.
+
+\ikwd{sig\@\texttt{sig}}
+\ikwd{end\@\texttt{end}}
+\ikwd{functor\@\texttt{functor}}
+\ikwd{with\@\texttt{with}}
+\ikwd{and\@\texttt{and}}
+\ikwd{val\@\texttt{val}}
+\ikwd{external\@\texttt{external}}
+\ikwd{type\@\texttt{type}}
+\ikwd{exception\@\texttt{exception}}
+\ikwd{class\@\texttt{class}}
+\ikwd{module\@\texttt{module}}
+\ikwd{open\@\texttt{open}}
+\ikwd{include\@\texttt{include}}
+
+\begin{syntax}
+module-type:
+          modtype-path
+        | 'sig' { specification [';;'] } 'end'
+        | 'functor' '(' module-name ':' module-type ')' '->' module-type
+        | module-type '->' module-type
+        | module-type 'with' mod-constraint { 'and' mod-constraint }
+        | '(' module-type ')'
+;
+mod-constraint:
+          'type' [type-params] typeconstr type-equation { type-constraint }
+        | 'module' module-path '=' extended-module-path
+;
+%BEGIN LATEX
+\end{syntax}
+\begin{syntax}
+%END LATEX
+specification:
+          'val' value-name ':' typexpr
+        | 'external' value-name ':' typexpr '=' external-declaration
+        | type-definition
+        | 'exception' constr-decl
+        | class-specification
+        | classtype-definition
+        | 'module' module-name ':' module-type
+        | 'module' module-name { '(' module-name ':' module-type ')' }
+          ':' module-type
+        | 'module' 'type' modtype-name
+        | 'module' 'type' modtype-name '=' module-type
+        | 'open' module-path
+        | 'include' module-type
+\end{syntax}
+See also the following language extensions:
+\hyperref[s:module-type-of]{recovering the type of a module},
+\hyperref[s:signature-substitution]{substitution inside a signature},
+\hyperref[s:module-alias]{type-level module aliases},
+\hyperref[s:attributes]{attributes},
+\hyperref[s:extension-nodes]{extension nodes} and
+\hyperref[s:generative-functors]{generative functors}.
+
+\subsection{ss:mty-simple}{Simple module types}
+
+The expression @modtype-path@ is equivalent to the module type bound
+to the name @modtype-path@.
+The expression @'(' module-type ')'@ denotes the same type as
+@module-type@.
+
+\subsection{ss:mty-signatures}{Signatures}
+
+\ikwd{sig\@\texttt{sig}}
+\ikwd{end\@\texttt{end}}
+
+Signatures are type specifications for structures. Signatures
+@'sig' \ldots 'end'@ are collections of type specifications for value
+names, type names, exceptions, module names and module type names. A
+structure will match a signature if the structure provides definitions
+(implementations) for all the names specified in the signature (and
+possibly more), and these definitions meet the type requirements given
+in the signature.
+
+An optional @";;"@ is allowed after each specification in a
+signature. It serves as a syntactic separator with no semantic
+meaning.
+
+\subsubsection*{sss:mty-values}{Value specifications}
+
+\ikwd{val\@\texttt{val}}
+
+A specification of a value component in a signature is written
+@'val' value-name ':' typexpr@, where @value-name@ is the name of the
+value and @typexpr@ its expected type.
+
+\ikwd{external\@\texttt{external}}
+
+The form @'external' value-name ':' typexpr '=' external-declaration@
+is similar, except that it requires in addition the name to be
+implemented as the external function specified in @external-declaration@
+(see chapter~\ref{c:intf-c}).
+
+\subsubsection*{sss:mty-type}{Type specifications}
+
+\ikwd{type\@\texttt{type}}
+
+A specification of one or several type components in a signature is
+written @'type' typedef { 'and' typedef }@ and consists of a sequence
+of mutually recursive definitions of type names.
+
+Each type definition in the signature specifies an optional type
+equation @'=' typexpr@ and an optional type representation
+@'=' constr-decl \ldots@ or @'=' '{' field-decl \ldots '}'@.
+The implementation of the type name in a matching structure must
+be compatible with the type expression specified in the equation (if
+given), and have the specified representation (if given). Conversely,
+users of that signature will be able to rely on the type equation
+or type representation, if given. More precisely, we have the
+following four situations:
+
+\begin{description}
+\item[Abstract type: no equation, no representation.] ~ \\
+Names that are defined as abstract types in a signature can be
+implemented in a matching structure by any kind of type definition
+(provided it has the same number of type parameters). The exact
+implementation of the type will be hidden to the users of the
+structure. In particular, if the type is implemented as a variant type
+or record type, the associated constructors and fields will not be
+accessible to the users; if the type is implemented as an
+abbreviation, the type equality between the type name and the
+right-hand side of the abbreviation will be hidden from the users of the
+structure. Users of the structure consider that type as incompatible
+with any other type: a fresh type has been generated.
+
+\item[Type abbreviation: an equation @'=' typexpr@, no representation.] ~ \\
+The type name must be implemented by a type compatible with @typexpr@.
+All users of the structure know that the type name is
+compatible with @typexpr@.
+
+\item[New variant type or record type: no equation, a representation.] ~ \\
+The type name must be implemented by a variant type or record type
+with exactly the constructors or fields specified. All users of the
+structure have access to the constructors or fields, and can use them
+to create or inspect values of that type. However, users of the
+structure consider that type as incompatible with any other type: a
+fresh type has been generated.
+
+\item[Re-exported variant type or record type: an equation,
+a representation.] ~ \\
+This case combines the previous two: the representation of the type is
+made visible to all users, and no fresh type is generated.
+\end{description}
+
+\subsubsection*{sss:mty-exn}{Exception specification}
+
+\ikwd{exception\@\texttt{exception}}
+
+The specification @'exception' constr-decl@ in a signature requires the
+matching structure to provide an exception with the name and arguments
+specified in the definition, and makes the exception available to all
+users of the structure.
+
+\subsubsection*{sss:mty-class}{Class specifications}
+
+\ikwd{class\@\texttt{class}}
+
+A specification of one or several classes in a signature is written
+@'class' class-spec { 'and' class-spec }@ and consists of a sequence
+of mutually recursive definitions of class names.
+
+Class specifications are described more precisely in
+section~\ref{ss:class-spec}.
+
+\subsubsection*{sss:mty-classtype}{Class type specifications}
+
+\ikwd{class\@\texttt{class}}
+\ikwd{type\@\texttt{type}}
+
+A specification of one or several classe types in a signature is
+written @'class' 'type' classtype-def@ @{ 'and' classtype-def }@ and
+consists of a sequence of mutually recursive definitions of class type
+names. Class type specifications are described more precisely in
+section~\ref{ss:classtype}.
+
+\subsubsection*{sss:mty-module}{Module specifications}
+
+\ikwd{module\@\texttt{module}}
+
+A specification of a module component in a signature is written
+@'module' module-name ':' module-type@, where @module-name@ is the
+name of the module component and @module-type@ its expected type.
+Modules can be nested arbitrarily; in particular, functors can appear
+as components of structures and functor types as components of
+signatures.
+
+For specifying a module component that is a functor, one may write
+\begin{center}
+@'module' module-name '(' name_1 ':' module-type_1 ')'
+               \ldots '(' name_n ':' module-type_n ')'
+          ':' module-type@
+\end{center}
+instead of
+\begin{center}
+@'module' module-name ':'
+ 'functor' '(' name_1 ':' module-type_1 ')' '->' \ldots
+                                            '->' module-type@
+\end{center}
+
+\subsubsection*{sss:mty-mty}{Module type specifications}
+
+\ikwd{type\@\texttt{type}}
+\ikwd{module\@\texttt{module}}
+
+A module type component of a signature can be specified either as a
+manifest module type or as an abstract module type.
+
+An abstract module type specification
+@'module' 'type' modtype-name@ allows the name @modtype-name@ to be
+implemented by any module type in a matching signature, but hides the
+implementation of the module type to all users of the signature.
+
+A manifest module type specification
+@'module' 'type' modtype-name '=' module-type@
+requires the name @modtype-name@ to be implemented by the module type
+@module-type@ in a matching signature, but makes the equality between
+@modtype-name@ and @module-type@ apparent to all users of the signature.
+
+\subsubsection{sss:mty-open}{Opening a module path}
+
+\ikwd{open\@\texttt{open}}
+
+The expression @'open' module-path@ in a signature does not specify
+any components. It simply affects the parsing of the following items
+of the signature, allowing components of the module denoted by
+@module-path@ to be referred to by their simple names @name@ instead of
+path accesses @module-path '.' name@. The scope of the @"open"@
+stops at the end of the signature expression.
+
+\subsubsection{sss:mty-include}{Including a signature}
+
+\ikwd{include\@\texttt{include}}
+
+The expression @'include' module-type@ in a signature performs textual
+inclusion of the components of the signature denoted by @module-type@.
+It behaves as if the components of the included signature were copied
+at the location of the @'include'@.  The @module-type@ argument must
+refer to a module type that is a signature, not a functor type.
+
+\subsection{ss:mty-functors}{Functor types}
+
+\ikwd{functor\@\texttt{functor}}
+
+The module type expression
+@'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
+use the name @module-name@ to refer to type components of the actual
+argument of the functor. If the type @module-type_2@ does not
+depend on type components of @module-name@, the module type expression
+can be simplified with the alternative short syntax
+@ module-type_1 '->' module-type_2 @.
+No restrictions are placed on the type of the functor argument; in
+particular, a functor may take another functor as argument
+(``higher-order'' functor).
+
+\subsection{ss:mty-with}{The "with" operator}
+
+\ikwd{with\@\texttt{with}}
+
+Assuming @module-type@ denotes a signature, the expression
+@module-type 'with' mod-constraint@ @{ 'and' mod-constraint }@ denotes
+the same signature where type equations have been added to some of the
+type specifications, as described by the constraints following the
+"with" keyword. The constraint @'type' [type-parameters] typeconstr
+'=' typexpr@  adds the type equation @'=' typexpr@ to the specification
+of the type component named @typeconstr@ of the constrained signature.
+The constraint @'module' module-path '=' extended-module-path@ adds
+type equations to all type components of the sub-structure denoted by
+@module-path@, making them equivalent to the corresponding type
+components of the structure denoted by @extended-module-path@.
+
+For instance, if the module type name "S" is bound to the signature
+\begin{verbatim}
+        sig type t module M: (sig type u end) end
+\end{verbatim}
+then "S with type t=int" denotes the signature
+\begin{verbatim}
+        sig type t=int module M: (sig type u end) end
+\end{verbatim}
+and "S with module M = N" denotes the signature
+\begin{verbatim}
+        sig type t module M: (sig type u=N.u end) end
+\end{verbatim}
+A functor taking two arguments of type "S" that share their "t" component
+is written
+\begin{verbatim}
+        functor (A: S) (B: S with type t = A.t) ...
+\end{verbatim}
+
+Constraints are added left to right.  After each constraint has been
+applied, the resulting signature must be a subtype of the signature
+before the constraint was applied.  Thus, the @'with'@ operator can
+only add information on the type components of a signature, but never
+remove information.
diff --git a/manual/manual/refman/modules.etex b/manual/manual/refman/modules.etex
new file mode 100644
index 00000000..ca9aef39
--- /dev/null
+++ b/manual/manual/refman/modules.etex
@@ -0,0 +1,237 @@
+\section{s:module-expr}{Module expressions (module implementations)}
+%HEVEA\cutname{modules.html}
+
+Module expressions are the module-level equivalent of value
+expressions: they evaluate to modules, thus providing implementations
+for the specifications expressed in module types.
+
+\ikwd{struct\@\texttt{struct}}
+\ikwd{end\@\texttt{end}}
+\ikwd{functor\@\texttt{functor}}
+\ikwd{let\@\texttt{let}}
+\ikwd{and\@\texttt{and}}
+\ikwd{external\@\texttt{external}}
+\ikwd{type\@\texttt{type}}
+\ikwd{exception\@\texttt{exception}}
+\ikwd{class\@\texttt{class}}
+\ikwd{module\@\texttt{module}}
+\ikwd{open\@\texttt{open}}
+\ikwd{include\@\texttt{include}}
+
+\begin{syntax}
+module-expr:
+          module-path
+        | 'struct' [ module-items ] 'end'
+        | 'functor' '(' module-name ':' module-type ')' '->' module-expr
+        | module-expr '(' module-expr ')'
+        | '(' module-expr ')'
+        | '(' module-expr ':' module-type ')'
+;
+module-items:
+        {';;'} ( definition || expr ) { {';;'} ( definition || ';;' expr) } {';;'}
+;
+%\end{syntax} \begin{syntax}
+definition:
+          'let' ['rec'] let-binding { 'and' let-binding }
+        | 'external' value-name ':' typexpr '=' external-declaration
+        | type-definition
+        | exception-definition
+        | class-definition
+        | classtype-definition
+        | 'module' module-name { '(' module-name ':' module-type ')' }
+                   [ ':' module-type ] \\ '=' module-expr
+        | 'module' 'type' modtype-name '=' module-type
+        | 'open' module-path
+        | 'include' module-expr
+\end{syntax}
+See also the following language extensions:
+\hyperref[s:recursive-modules]{recursive modules},
+\hyperref[s:first-class-modules]{first-class modules},
+\hyperref[s:explicit-overriding-open]{overriding in open statements},
+\hyperref[s:attributes]{attributes},
+\hyperref[s:extension-nodes]{extension nodes} and
+\hyperref[s:generative-functors]{generative functors}.
+
+\subsection{ss:mexpr-simple}{Simple module expressions}
+
+The expression @module-path@ evaluates to the module bound to the name
+@module-path@.
+
+The expression @'(' module-expr ')'@ evaluates to the same module as
+@module-expr@.
+
+The expression @'(' module-expr ':' module-type ')'@ checks that the
+type of @module-expr@ is a subtype of @module-type@, that is, that all
+components specified in @module-type@ are implemented in
+@module-expr@, and their implementation meets the requirements given
+in @module-type@. In other terms, it checks that the implementation
+@module-expr@ meets the type specification @module-type@. The whole
+expression evaluates to the same module as @module-expr@, except that
+all components not specified in @module-type@ are hidden and can no
+longer be accessed.
+
+\subsection{ss:mexpr-structures}{Structures}
+
+\ikwd{struct\@\texttt{struct}}
+\ikwd{end\@\texttt{end}}
+
+Structures @'struct' \ldots 'end'@ are collections of definitions for
+value names, type names, exceptions, module names and module type
+names. The definitions are evaluated in the order in which they appear
+in the structure. The scopes of the bindings performed by the
+definitions extend to the end of the structure. As a consequence, a
+definition may refer to names bound by earlier definitions in the same
+structure.
+
+For compatibility with toplevel phrases (chapter~\ref{c:camllight}),
+optional @";;"@ are allowed after and before each definition in a structure. These
+@";;"@ have no semantic meanings. Similarly, an @expr@ preceded by ";;" is allowed as
+a component of a structure. It is equivalent to @'let' '_' '=' expr@, i.e. @expr@ is
+evaluated for its side-effects but is not bound to any identifier. If @expr@ is
+the first component of a structure, the preceding ";;" can be omitted.
+
+\subsubsection*{sss:mexpr-value-defs}{Value definitions}
+
+\ikwd{let\@\texttt{let}}
+
+A value definition @'let' ['rec'] let-binding  { 'and' let-binding }@
+bind value names in the same way as a @'let' \ldots 'in' \ldots@ expression
+(see section~\ref{sss:expr-localdef}). The value names appearing in the
+left-hand sides of the bindings are bound to the corresponding values
+in the right-hand sides.
+
+\ikwd{external\@\texttt{external}}
+
+A value definition @'external' value-name ':' typexpr '=' external-declaration@
+implements @value-name@ as the external function specified in
+@external-declaration@ (see chapter~\ref{c:intf-c}).
+
+\subsubsection*{sss:mexpr-type-defs}{Type definitions}
+
+\ikwd{type\@\texttt{type}}
+
+A definition of one or several type components is written
+@'type' typedef { 'and' typedef }@ and consists of a sequence
+of mutually recursive definitions of type names.
+
+\subsubsection*{sss:mexpr-exn-defs}{Exception definitions}
+
+\ikwd{exception\@\texttt{exception}}
+
+Exceptions are defined with the syntax @'exception' constr-decl@
+or @'exception' constr-name '=' constr@.
+
+\subsubsection*{sss:mexpr-class-defs}{Class definitions}
+
+\ikwd{class\@\texttt{class}}
+
+A definition of one or several classes is written @'class'
+class-binding { 'and' class-binding }@ and consists of a sequence of
+mutually recursive definitions of class names. Class definitions are
+described more precisely in section~\ref{ss:class-def}.
+
+\subsubsection*{sss:mexpr-classtype-defs}{Class type definitions}
+
+\ikwd{class\@\texttt{class}}
+\ikwd{type\@\texttt{type}}
+
+A definition of one or several classes is written
+@'class' 'type' classtype-def { 'and' classtype-def }@ and consists of
+a sequence of mutually recursive definitions of class type names.
+Class type definitions are described more precisely in
+section~\ref{ss:classtype}.
+
+\subsubsection*{sss:mexpr-module-defs}{Module definitions}
+
+\ikwd{module\@\texttt{module}}
+
+The basic form for defining a module component is
+@'module' module-name '=' module-expr@, which evaluates @module-expr@ and binds
+the result to the name @module-name@.
+
+One can write
+\begin{center}
+@'module' module-name ':' module-type '=' module-expr@
+\end{center}
+instead of
+\begin{center}
+@'module' module-name '=' '(' module-expr ':' module-type ')'@.
+\end{center}
+Another derived form is
+\begin{center}
+@'module' module-name '(' name_1 ':' module-type_1 ')' \ldots
+                      '(' name_n ':' module-type_n ')' '=' module-expr@
+\end{center}
+which is equivalent to
+\begin{center}
+@'module' module-name '='
+ 'functor' '(' name_1 ':' module-type_1 ')' '->' \ldots
+                                            '->' module-expr@
+\end{center}
+
+\subsubsection*{sss:mexpr-modtype-defs}{Module type definitions}
+
+\ikwd{type\@\texttt{type}}
+\ikwd{module\@\texttt{module}}
+
+A definition for a module type is written
+@'module' 'type' modtype-name '=' module-type@.
+It binds the name @modtype-name@ to the module type denoted by the
+expression @module-type@.
+
+\subsubsection*{sss:mexpr-open}{Opening a module path}
+
+\ikwd{open\@\texttt{open}}
+
+The expression @'open' module-path@ in a structure does not define any
+components nor perform any bindings. It simply affects the parsing of
+the following items of the structure, allowing components of the
+module denoted by @module-path@ to be referred to by their simple names
+@name@ instead of path accesses @module-path '.' name@.  The scope of
+the @"open"@ stops at the end of the structure expression.
+
+\subsubsection*{sss:mexpr-include}{Including the components of another structure}
+
+\ikwd{include\@\texttt{include}}
+
+The expression @'include' module-expr@ in a structure re-exports in
+the current structure all definitions of the structure denoted by
+@module-expr@.  For instance, if you define a module "S" as below
+\begin{caml_example*}{verbatim}
+module S = struct type t = int  let x = 2 end
+\end{caml_example}
+defining the module "B" as
+\begin{caml_example*}{verbatim}
+module B = struct include S  let y = (x + 1 : t) end
+\end{caml_example}
+is equivalent to defining it as
+\begin{caml_example*}{verbatim}
+module B = struct type t = S.t  let x = S.x  let y = (x + 1 : t) end
+\end{caml_example}
+The difference between @'open'@ and @'include'@ is that @'open'@
+simply provides short names for the components of the opened
+structure, without defining any components of the current structure,
+while @'include'@ also adds definitions for the components of the
+included structure.
+
+\subsection{ss:mexpr-functors}{Functors}
+
+\subsubsection*{sss:mexpr-functor-defs}{Functor definition}
+
+\ikwd{functor\@\texttt{functor}}
+
+The expression @'functor' '(' module-name ':' module-type ')' '->'
+module-expr@ evaluates to a functor that takes as argument modules of
+the type @module-type_1@, binds @module-name@ to these modules,
+evaluates @module-expr@ in the extended environment, and returns the
+resulting modules as results. No restrictions are placed on the type of the
+functor argument; in particular, a functor may take another functor as
+argument (``higher-order'' functor).
+
+\subsubsection*{sss:mexpr-functor-app}{Functor application}
+
+The expression @module-expr_1 '(' module-expr_2 ')'@ evaluates
+@module-expr_1@ to a functor and @module-expr_2@ to a module, and
+applies the former to the latter. The type of @module-expr_2@ must
+match the type expected for the arguments of the functor @module-expr_1@.
+
diff --git a/manual/manual/refman/names.etex b/manual/manual/refman/names.etex
new file mode 100644
index 00000000..1d06dc69
--- /dev/null
+++ b/manual/manual/refman/names.etex
@@ -0,0 +1,150 @@
+\section{s:names}{Names}
+%HEVEA\cutname{names.html}
+
+Identifiers are used to give names to several classes of language
+objects and refer to these objects by name later:
+\begin{itemize}
+\item value names (syntactic class @value-name@),
+\item value constructors and exception constructors (class @constr-name@),
+\item labels (@label-name@, defined in section~\ref{sss:labelname}),
+\item polymorphic variant tags (@tag-name@),
+\item type constructors (@typeconstr-name@),
+\item record fields (@field-name@),
+\item class names (@class-name@),
+\item method names (@method-name@),
+\item instance variable names (@inst-var-name@),
+\item module names (@module-name@),
+\item module type names (@modtype-name@).
+\end{itemize}
+These eleven name spaces are distinguished both by the context and by the
+capitalization of the identifier: whether the first letter of the
+identifier is in lowercase (written @lowercase-ident@ below) or in
+uppercase (written @capitalized-ident@).  Underscore is considered a
+lowercase letter for this purpose.
+
+\subsubsection*{sss:naming-objects}{Naming objects}
+\ikwd{mod\@\texttt{mod}}
+\ikwd{land\@\texttt{land}}
+\ikwd{lor\@\texttt{lor}}
+\ikwd{lxor\@\texttt{lxor}}
+\ikwd{lsl\@\texttt{lsl}}
+\ikwd{lsr\@\texttt{lsr}}
+\ikwd{asr\@\texttt{asr}}
+
+\begin{syntax}
+value-name:
+        lowercase-ident
+      | '(' operator-name ')'
+;
+operator-name:
+        prefix-symbol || infix-op
+;
+infix-op:
+    infix-symbol
+  | '*' || '+' || '-' || '-.' || '=' || '!=' || '<' || '>' || 'or' || '||'
+    || '&' || '&&' || ':='
+  | 'mod' || 'land' || 'lor' || 'lxor' || 'lsl' || 'lsr' || 'asr'
+;
+constr-name:
+        capitalized-ident
+;
+tag-name:
+        capitalized-ident
+;
+typeconstr-name:
+        lowercase-ident
+;
+field-name:
+        lowercase-ident
+;
+module-name:
+        capitalized-ident
+;
+modtype-name:
+        ident
+;
+class-name:
+    lowercase-ident
+;
+inst-var-name:
+    lowercase-ident
+;
+method-name:
+    lowercase-ident
+\end{syntax}
+See also the following language extension:
+\hyperref[s:index-operators]{extended indexing operators}.
+
+As shown above, prefix and infix symbols as well as some keywords can
+be used as value names, provided they are written between parentheses.
+The capitalization rules  are summarized in the table below.
+
+\begin{tableau}{|l|l|}{Name space}{Case of first letter}
+\entree{Values}{lowercase}
+\entree{Constructors}{uppercase}
+\entree{Labels}{lowercase}
+\entree{Polymorphic variant tags}{uppercase}
+\entree{Exceptions}{uppercase}
+\entree{Type constructors}{lowercase}
+\entree{Record fields}{lowercase}
+\entree{Classes}{lowercase}
+\entree{Instance variables}{lowercase}
+\entree{Methods}{lowercase}
+\entree{Modules}{uppercase}
+\entree{Module types}{any}
+\end{tableau}
+
+{\it Note on polymorphic variant tags:\/} the current implementation accepts
+lowercase variant tags in addition to capitalized variant tags, but we
+suggest you avoid lowercase variant tags for portability and
+compatibility with future OCaml versions.
+
+\subsubsection*{sss:refer-named}{Referring to named objects}
+
+\begin{syntax}
+value-path:
+        [ module-path '.' ] value-name
+;
+constr:
+        [ module-path '.' ] constr-name
+;
+typeconstr:
+        [ extended-module-path '.' ] typeconstr-name
+;
+field:
+        [ module-path '.' ] field-name
+;
+modtype-path:
+        [ extended-module-path '.' ] modtype-name
+;
+class-path:
+        [ module-path '.' ] class-name
+;
+classtype-path:
+        [ extended-module-path '.' ] class-name
+;
+module-path:
+        module-name { '.' module-name }
+;
+extended-module-path:
+        extended-module-name { '.' extended-module-name }
+;
+extended-module-name:
+        module-name { '(' extended-module-path ')' }
+\end{syntax}
+
+A named object can be referred to either by its name (following the
+usual static scoping rules for names) or by an access path @prefix '.' name@,
+where @prefix@ designates a module and @name@ is the name of an object
+defined in that module. The first component of the path, @prefix@, is
+either a simple module name or an access path @name_1 '.' name_2 \ldots@,
+in case the defining module is itself nested inside other modules.
+For referring to type constructors, module types, or class types,
+the @prefix@ can
+also contain simple functor applications (as in the syntactic class
+@extended-module-path@ above) in case the defining module is the
+result of a functor application.
+
+Label names, tag names, method names and instance variable names need
+not be qualified: the former three are global labels, while the latter
+are local to a class.
diff --git a/manual/manual/refman/patterns.etex b/manual/manual/refman/patterns.etex
new file mode 100644
index 00000000..5136ff64
--- /dev/null
+++ b/manual/manual/refman/patterns.etex
@@ -0,0 +1,245 @@
+\section{s:patterns}{Patterns}
+\ikwd{as\@\texttt{as}}
+%HEVEA\cutname{patterns.html}
+\begin{syntax}
+pattern:
+    value-name
+  | '_'
+  | constant
+  | pattern 'as' value-name
+  | '(' pattern ')'
+  | '(' pattern ':' typexpr ')'
+  | pattern '|' pattern
+  | constr pattern
+  | "`"tag-name pattern
+  | "#"typeconstr
+  | pattern {{ ',' pattern }}
+  | '{' field [':' typexpr] ['=' pattern]%
+    { ';' field [':' typexpr] ['=' pattern] } [';' '_' ] [ ';' ] '}'
+  | '[' pattern { ';' pattern } [ ';' ] ']'
+  | pattern '::' pattern
+  | '[|' pattern { ';' pattern } [ ';' ] '|]'
+  | char-literal '..' char-literal
+  | 'lazy' pattern
+  | 'exception' pattern
+  | module-path '.(' pattern ')'
+  | module-path '.[' pattern ']'
+  | module-path '.[|' pattern '|]'
+  | module-path '.{' 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}.
+
+The table below shows the relative precedences and associativity of
+operators and non-closed pattern constructions. The constructions with
+higher precedences come first.
+\ikwd{as\@\texttt{as}}
+\begin{tableau}{|l|l|}{Operator}{Associativity}
+\entree{".."}{--}
+\entree{"lazy" (see section~\ref{sss:pat-lazy})}{--}
+\entree{Constructor application, Tag application}{right}
+\entree{"::"}{right}
+\entree{","}{--}
+\entree{"|"}{left}
+\entree{"as"}{--}
+\end{tableau}
+
+Patterns are templates that allow selecting data structures of a
+given shape, and binding identifiers to components of the data
+structure. This selection operation is called pattern matching; its
+outcome is either ``this value does not match this pattern'', or
+``this value matches this pattern, resulting in the following bindings
+of names to values''.
+
+\subsubsection*{sss:pat-variable}{Variable patterns}
+
+A pattern that consists in a value name matches any value,
+binding the name to the value. The pattern @"_"@ also matches
+any value, but does not bind any name.
+
+Patterns are {\em linear\/}: a variable cannot be bound several times by
+a given pattern. In particular, there is no way to test for equality
+between two parts of a data structure using only a pattern (but
+@"when"@ guards can be used for this purpose).
+
+\subsubsection*{sss:pat-const}{Constant patterns}
+
+A pattern consisting in a constant matches the values that
+are equal to this constant.
+
+%% FIXME for negative numbers, blanks are allowed between the minus
+%% sign and the first digit.
+
+\subsubsection*{sss:pat-alias}{Alias patterns}
+\ikwd{as\@\texttt{as}}
+
+The pattern @pattern_1 "as" value-name@ matches the same values as
+@pattern_1@. If the matching against @pattern_1@ is successful,
+the name @value-name@ is bound to the matched value, in addition to the
+bindings performed by the matching against @pattern_1@.
+
+\subsubsection*{sss:pat-parenthesized}{Parenthesized patterns}
+
+The pattern @"(" pattern_1 ")"@ matches the same values as
+@pattern_1@. A type constraint can appear in a
+parenthesized pattern, as in @"(" pattern_1 ":" typexpr ")"@. This
+constraint forces the type of @pattern_1@ to be compatible with
+@typexpr@.
+
+\subsubsection*{sss:pat-or}{``Or'' patterns}
+
+The pattern @pattern_1 "|" pattern_2@ represents the logical ``or'' of
+the two patterns @pattern_1@ and @pattern_2@. A value matches
+@pattern_1 "|" pattern_2@ if it matches @pattern_1@ or
+@pattern_2@. The two sub-patterns @pattern_1@ and @pattern_2@
+must bind exactly the same identifiers to values having the same types.
+Matching is performed from left to right.
+More precisely,
+in case some value~$v$ matches @pattern_1 "|" pattern_2@, the bindings
+performed are those of @pattern_1@ when $v$ matches @pattern_1@.
+Otherwise, value~$v$ matches @pattern_2@ whose bindings are performed.
+
+
+\subsubsection*{sss:pat-variant}{Variant patterns}
+
+The pattern @constr '(' pattern_1 ',' \ldots ',' pattern_n ')'@ matches
+all variants whose
+constructor is equal to @constr@, and whose arguments match
+@pattern_1 \ldots pattern_n@.  It is a type error if $n$ is not the
+number of arguments expected by the constructor.
+
+The pattern @constr '_'@ matches all variants whose constructor is
+@constr@.
+
+The pattern @pattern_1 "::" pattern_2@ matches non-empty lists whose
+heads match @pattern_1@, and whose tails match @pattern_2@.
+
+The pattern @"[" pattern_1 ";" \ldots ";" pattern_n "]"@ matches lists
+of length $n$ whose elements match @pattern_1@ \ldots @pattern_n@,
+respectively. This pattern behaves like
+@pattern_1 "::" \ldots "::" pattern_n "::" "[]"@.
+
+\subsubsection*{sss:pat-polyvar}{Polymorphic variant patterns}
+
+The pattern @"`"tag-name pattern_1@ matches all polymorphic variants
+whose tag is equal to @tag-name@, and whose argument matches
+@pattern_1@.
+
+\subsubsection*{sss:pat-polyvar-abbrev}{Polymorphic variant abbreviation patterns}
+
+If the type @["('a,'b,"\ldots")"] typeconstr = "[" "`"tag-name_1 typexpr_1 "|"
+\ldots "|" "`"tag-name_n typexpr_n"]"@ is defined, then the pattern @"#"typeconstr@
+is a shorthand for the following or-pattern:
+@"(" "`"tag-name_1"(_" ":" typexpr_1")" "|" \ldots "|" "`"tag-name_n"(_"
+":" typexpr_n"))"@. It matches all values of type @"[<" typeconstr "]"@.
+
+\subsubsection*{sss:pat-tuple}{Tuple patterns}
+
+The pattern @pattern_1 "," \ldots "," pattern_n@ matches $n$-tuples
+whose components match the patterns @pattern_1@ through @pattern_n@. That
+is, the pattern matches the tuple values $(v_1, \ldots, v_n)$ such that
+@pattern_i@ matches $v_i$ for \fromoneto{i}{n}.
+
+\subsubsection*{sss:pat-record}{Record patterns}
+
+The pattern @"{" field_1 ["=" pattern_1] ";" \ldots ";" field_n ["="
+pattern_n] "}"@ matches records that define at least the fields
+@field_1@ through @field_n@, and such that the value associated to
+@field_i@ matches the pattern @pattern_i@, for \fromoneto{i}{n}.
+A single identifier @field_k@ stands for @field_k '=' field_k @,
+and a single qualified identifier @module-path '.' field_k@ stands
+for @module-path '.' field_k '=' field_k @.
+The record value can define more fields than @field_1@ \ldots
+@field_n@; the values associated to these extra fields are not taken
+into account for matching. Optionally, a record pattern can be terminated
+by @';' '_'@ to convey the fact that not all fields of the record type are
+listed in the record pattern and that it is intentional.
+Optional type constraints can be added field by field with
+@"{" field_1 ":" typexpr_1 "=" pattern_1 ";"%
+\ldots ";"field_n ":" typexpr_n "=" pattern_n "}"@ to force the type
+of @field_k@ to be compatible with @typexpr_k@.
+
+
+\subsubsection*{sss:pat-array}{Array patterns}
+
+The pattern @"[|" pattern_1 ";" \ldots ";" pattern_n "|]"@
+matches arrays of length $n$ such that the $i$-th array element
+matches the pattern @pattern_i@, for \fromoneto{i}{n}.
+
+\subsubsection*{sss:pat-range}{Range patterns}
+
+The pattern
+@"'" @c@ "'" ".." "'" @d@ "'"@ is a shorthand for the pattern
+\begin{center}
+@"'" @c@ "'" "|" "'" @c@_1 "'" "|" "'" @c@_2 "'" "|" \ldots
+        "|" "'" @c@_n "'" "|" "'" @d@ "'"@
+\end{center}
+where \nth{c}{1}, \nth{c}{2}, \ldots, \nth{c}{n} are the characters
+that occur between \var{c} and \var{d} in the ASCII character set. For
+instance, the pattern "'0'"@'..'@"'9'" matches all characters that are digits.
+
+\subsubsection{sss:pat-lazy}{Lazy patterns}
+
+\ikwd{lazy\@\texttt{lazy}}
+
+(Introduced in Objective Caml 3.11)
+
+\begin{syntax}
+pattern: ...
+\end{syntax}
+
+The pattern @"lazy" pattern@ matches a value \var{v} of type "Lazy.t",
+provided @pattern@ matches the result of forcing \var{v} with
+"Lazy.force". A successful match of a pattern containing @"lazy"@
+sub-patterns forces the corresponding parts of the value being matched, even
+those that imply no test such as @"lazy" value-name@ or @"lazy" "_"@.
+Matching a value with a @pattern-matching@ where some patterns
+contain @"lazy"@ sub-patterns may imply forcing parts of the value,
+even when the pattern selected in the end has no @"lazy"@ sub-pattern.
+
+For more information, see the description of module "Lazy" in the
+standard library (module \stdmoduleref{Lazy}).
+%
+\index{Lazy (module)\@\verb`Lazy` (module)}%
+\index{force\@\verb`force`}%
+
+\subsubsection*{sss:exception-match}{Exception patterns}
+(Introduced in OCaml 4.02)
+
+A new form of exception pattern, @ 'exception' pattern @, is allowed
+only as a toplevel pattern or inside a toplevel or-pattern under
+a "match"..."with" pattern-matching
+(other occurrences are rejected by the type-checker).
+
+Cases with such a toplevel pattern are called ``exception cases'',
+as opposed to regular ``value cases''.  Exception cases are applied
+when the evaluation of the matched expression raises an exception.
+The exception value is then matched against all the exception cases
+and re-raised if none of them accept the exception (as with a
+"try"..."with" block).  Since the bodies of all exception and value
+cases are outside the scope of the exception handler, they are all
+considered to be in tail-position: if the "match"..."with" block
+itself is in tail position in the current function, any function call
+in tail position in one of the case bodies results in an actual tail
+call.
+
+A pattern match must contain at least one value case. It is an error if
+all cases are exceptions, because there would be no code to handle
+the return of a value.
+
+\subsubsection*{sss:pat-open}{Local opens for patterns}
+\ikwd{open\@\texttt{open}}
+(Introduced in OCaml 4.04)
+
+For patterns, local opens are limited to the
+@module-path'.('pattern')'@ construction. This
+construction locally opens the module referred to by the module path
+@module-path@ in the scope of the pattern @pattern@.
+
+When the body of a local open pattern is delimited by
+@'[' ']'@,  @'[|' '|]'@,  or @'{' '}'@, the parentheses can be omitted.
+For example, @module-path'.['pattern']'@ is equivalent to
+@module-path'.(['pattern'])'@, and @module-path'.[|' pattern '|]'@ is
+equivalent to @module-path'.([|' pattern '|])'@.
diff --git a/manual/manual/refman/refman.etex b/manual/manual/refman/refman.etex
new file mode 100644
index 00000000..7124672c
--- /dev/null
+++ b/manual/manual/refman/refman.etex
@@ -0,0 +1,47 @@
+\chapter{The OCaml language} \label{c:refman}
+%HEVEA\cutname{language.html}
+
+%better html output that way, sniff.
+%HEVEA\subsection*{ss:foreword}{Foreword}
+%BEGIN LATEX
+\section*{s:foreword}{Foreword}
+%END LATEX
+
+This document is intended as a reference manual for the OCaml
+language. It lists the language constructs, and gives their precise
+syntax and informal semantics. It is by no means a tutorial
+introduction to the language: there is not a single example. A good
+working knowledge of OCaml is assumed.
+
+No attempt has been made at mathematical rigor: words are employed
+with their intuitive meaning, without further definition. As a
+consequence, the typing rules have been left out, by lack of the
+mathematical framework required to express them, while they are
+definitely part of a full formal definition of the language.
+
+
+\subsection*{ss:notations}{Notations}
+
+The syntax of the language is given in BNF-like notation. Terminal
+symbols are set in typewriter font (@'like' 'this'@).
+Non-terminal symbols are set in italic font (@like that@).
+Square brackets @[\ldots]@ denote optional components. Curly brackets
+@{\ldots}@ denotes zero, one or several repetitions of the enclosed
+components. Curly brackets with a trailing plus sign @{{\ldots}}@
+denote one or several repetitions of the enclosed components.
+Parentheses @(\ldots)@ denote grouping.
+
+%HEVEA\cutdef{section}
+\input{lex}
+\input{values}
+\input{names}
+\input{types}
+\input{const}
+\input{patterns}
+\input{expr}
+\input{typedecl}
+\input{classes}
+\input{modtypes}
+\input{modules}
+\input{compunit}
+%HEVEA\cutend
diff --git a/manual/manual/refman/typedecl.etex b/manual/manual/refman/typedecl.etex
new file mode 100644
index 00000000..b9892ca2
--- /dev/null
+++ b/manual/manual/refman/typedecl.etex
@@ -0,0 +1,227 @@
+\section{s:tydef}{Type and exception definitions}
+%HEVEA\cutname{typedecl.html}%
+
+\subsection{ss:typedefs}{Type definitions}
+
+Type definitions bind type constructors to data types: either
+variant types, record types, type abbreviations, or abstract data
+types. They also bind the value constructors and record fields
+associated with the definition.
+
+\ikwd{type\@\texttt{type}}
+\ikwd{and\@\texttt{and}}
+\ikwd{nonrec\@\texttt{nonrec}}
+\ikwd{of\@\texttt{of}}
+
+\begin{syntax}
+type-definition:
+          'type' ['nonrec'] typedef { 'and' typedef }
+;
+typedef:
+          [type-params] typeconstr-name type-information
+;
+type-information:
+          [type-equation] [type-representation] { type-constraint }
+;
+type-equation:
+          '=' typexpr
+;
+type-representation:
+          '=' ['|'] constr-decl { '|' constr-decl }
+        | '=' record-decl
+        | '=' '|'
+;
+type-params:
+          type-param
+        | '(' type-param { "," type-param } ')'
+;
+type-param:
+          [variance] "'" ident
+;
+variance:
+          '+'
+        | '-'
+;
+record-decl:
+         '{' field-decl { ';' field-decl } [';'] '}'
+;
+constr-decl:
+          (constr-name || '[]' || '(::)') [ 'of' constr-args ]
+;
+constr-args:
+          typexpr { '*' typexpr }
+;
+field-decl:
+          ['mutable'] field-name ':' poly-typexpr
+;
+type-constraint:
+    'constraint' "'" ident '=' typexpr
+\end{syntax}
+\ikwd{mutable\@\texttt{mutable}}
+\ikwd{constraint\@\texttt{constraint}}
+See also the following language extensions:
+\hyperref[s:private-types]{private types},
+\hyperref[s:gadts]{generalized algebraic datatypes},
+\hyperref[s:attributes]{attributes},
+\hyperref[s:extension-nodes]{extension nodes},
+\hyperref[s:extensible-variants]{extensible variant types} and
+\hyperref[s:inline-records]{inline records}.
+
+Type definitions are introduced by the "type" keyword, and
+consist in one or several simple definitions, possibly mutually
+recursive, separated by the "and" keyword. Each simple definition
+defines one type constructor.
+
+A simple definition consists in a lowercase identifier, possibly
+preceded by one or several type parameters, and followed by an
+optional type equation, then an optional type representation, and then
+a constraint clause. The identifier is the name of the type
+constructor being defined.
+
+In the right-hand side of type definitions, references to one of the
+type constructor name being defined are considered as recursive,
+unless "type" is followed by "nonrec". The "nonrec" keyword was
+introduced in OCaml 4.02.2.
+
+The optional type parameters are either one type variable @"'" ident@,
+for type constructors with one parameter, or a list of type variables
+@"('"ident_1,\ldots,"'"ident_n")"@, for type constructors with several
+parameters. Each type parameter may be prefixed by a variance
+constraint @"+"@ (resp. @"-"@) indicating that the parameter is
+covariant (resp. contravariant).  These type parameters can appear in
+the type expressions of the right-hand side of the definition,
+optionally restricted by a variance constraint ; {\em i.e.\/} a
+covariant parameter may only appear on the right side of a functional
+arrow (more precisely, follow the left branch of an even number of
+arrows), and a contravariant parameter only the left side (left branch of
+an odd number of arrows). If the type has a representation or
+an equation, and the parameter is free ({\em i.e.\/} not bound via a
+type constraint to a constructed type), its variance constraint is
+checked but subtyping {\em etc.\/} will use the inferred variance of the
+parameter, which may be less restrictive; otherwise ({\em i.e.\/} for abstract
+types or non-free parameters), the variance must be given explicitly,
+and the parameter is invariant if no variance is given.
+
+The optional type equation @'=' typexpr@ makes the defined type
+equivalent to the type expression @typexpr@:
+one can be substituted  for the other during typing.
+If no type equation is given, a new type is generated: the defined type
+is incompatible with any other type.
+
+The optional type representation describes the data structure
+representing the defined type, by giving the list of associated
+constructors (if it is a variant type) or associated fields (if it is
+a record type). If no type representation is given, nothing is
+assumed on the structure of the type besides what is stated in the
+optional type equation.
+
+The type representation @'=' ['|'] constr-decl { '|' constr-decl }@
+describes a variant type. The constructor declarations
+@constr-decl_1, \ldots, constr-decl_n@ describe the constructors
+associated to this variant type. The constructor
+declaration @constr-name 'of' typexpr_1 '*' \ldots '*' typexpr_n@
+declares the name @constr-name@ as a non-constant constructor, whose
+arguments have types @typexpr_1@ \ldots @typexpr_n@.
+The constructor declaration @constr-name@
+declares the name @constr-name@ as a constant
+constructor. Constructor names must be capitalized.
+
+The type representation @'=' '{' field-decl { ';' field-decl } [';'] '}'@
+describes a record type. The field declarations @field-decl_1, \ldots,
+field-decl_n@ describe the fields associated to this record type.
+The field declaration @field-name ':' poly-typexpr@ declares
+@field-name@ as a field whose argument has type @poly-typexpr@.
+The field declaration @'mutable' field-name ':' poly-typexpr@
+\ikwd{mutable\@\texttt{mutable}}
+behaves similarly; in addition, it allows physical modification of
+this field.
+Immutable fields are covariant, mutable fields are non-variant.
+Both mutable and immutable fields may have explicitly polymorphic
+types.  The polymorphism of the contents is statically checked whenever
+a record value is created or modified.  Extracted values may have their
+types instantiated.
+
+The two components of a type definition, the optional equation and the
+optional representation, can be combined independently, giving
+rise to four typical situations:
+
+\begin{description}
+\item[Abstract type: no equation, no representation.] ~\\
+When appearing in a module signature, this definition specifies
+nothing on the type constructor, besides its number of parameters:
+its representation is hidden and it is assumed incompatible with any
+other type.
+
+\item[Type abbreviation: an equation, no representation.] ~\\
+This defines the type constructor as an abbreviation for the type
+expression on the right of the @'='@ sign.
+
+\item[New variant type or record type: no equation, a representation.] ~\\
+This generates a new type constructor and defines associated
+constructors or fields, through which values of that type can be
+directly built or inspected.
+
+\item[Re-exported variant type or record type: an equation,
+a representation.] ~\\
+In this case, the type constructor is defined as an abbreviation for
+the type expression given in the equation, but in addition the
+constructors or fields given in the representation remain attached to
+the defined type constructor. The type expression in the equation part
+must agree with the representation: it must be of the same kind
+(record or variant) and have exactly the same constructors or fields,
+in the same order, with the same arguments. Moreover, the new type
+constructor must have the same arity and the same type constraints as the
+original type constructor.
+\end{description}
+
+The type variables appearing as type parameters can optionally be
+prefixed by "+" or "-" to indicate that the type constructor is
+covariant or contravariant with respect to this parameter.  This
+variance information is used to decide subtyping relations when
+checking the validity of @":>"@ coercions
+(see section \ref{ss:expr-coercions}).
+
+For instance, "type +'a t" declares "t" as an abstract type that is
+covariant in its parameter; this means that if the type $\tau$ is a
+subtype of the type $\sigma$, then $\tau " t"$ is a subtype of $\sigma
+" t"$.  Similarly, "type -'a t" declares that the abstract type "t" is
+contravariant in its parameter: if $\tau$ is a subtype of $\sigma$, then
+$\sigma " t"$ is a subtype of $\tau " t"$.  If no "+" or "-" variance
+annotation is given, the type constructor is assumed non-variant in the
+corresponding parameter.  For instance, the abstract type declaration
+"type 'a t" means that $\tau " t"$ is neither a subtype nor a
+supertype of $\sigma " t"$ if $\tau$ is subtype of $\sigma$.
+
+The variance indicated by the "+" and "-" annotations on parameters
+is enforced only for abstract and private types, or when there are
+type constraints.
+Otherwise, for abbreviations, variant and record types without type
+constraints, the variance properties of the type constructor
+are inferred from its definition, and the variance annotations are
+only checked for conformance with the definition.
+
+\ikwd{constraint\@\texttt{constraint}}
+The construct @ 'constraint' "'" ident '=' typexpr @ allows the
+specification of
+type parameters.  Any actual type argument corresponding to the type
+parameter @ident@ has to be an instance of @typexpr@ (more precisely,
+@ident@ and @typexpr@ are unified). Type variables of @typexpr@ can
+appear in the type equation and the type declaration.
+
+\subsection{ss:exndef}{Exception definitions}
+\ikwd{exception\@\texttt{exception}}
+
+\begin{syntax}
+exception-definition:
+        'exception' constr-decl
+      | 'exception' constr-name '=' constr
+\end{syntax}
+
+Exception definitions add new constructors to the built-in variant
+type \verb"exn" of exception values. The constructors are declared as
+for a definition of a variant type.
+
+The form @'exception' constr-decl@
+generates a new exception, distinct from all other exceptions in the system.
+The form @'exception' constr-name '=' constr@
+gives an alternate name to an existing exception.
diff --git a/manual/manual/refman/types.etex b/manual/manual/refman/types.etex
new file mode 100644
index 00000000..0983be69
--- /dev/null
+++ b/manual/manual/refman/types.etex
@@ -0,0 +1,241 @@
+\section{s:typexpr}{Type expressions}
+%HEVEA\cutname{types.html}
+\ikwd{as\@\texttt{as}}
+
+\begin{syntax}
+typexpr:
+        "'" ident
+      | "_"
+      | '(' typexpr ')'
+      | [['?']label-name':'] typexpr '->' typexpr
+      | typexpr {{ '*' typexpr }}
+      | typeconstr
+      | typexpr typeconstr
+      | '(' typexpr { ',' typexpr } ')' typeconstr
+      | typexpr 'as' "'" ident
+      | polymorphic-variant-type
+      | '<' ['..'] '>'
+      | '<' method-type { ';' method-type } [';' || ';' '..'] '>'
+      | '#' classtype-path
+      | typexpr '#' class-path
+      | '(' typexpr { ',' typexpr } ')' '#' class-path
+;
+poly-typexpr:
+        typexpr
+      | {{ "'" ident }} '.' typexpr
+;
+method-type:
+    method-name ':' poly-typexpr
+\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}.
+
+The table below shows the relative precedences and associativity of
+operators and non-closed type constructions. The constructions with
+higher precedences come first.
+\ikwd{as\@\texttt{as}}
+\begin{tableau}{|l|l|}{Operator}{Associativity}
+\entree{Type constructor application}{--}
+\entree{"#"}{--}
+\entree{"*"}{--}
+\entree{"->"}{right}
+\entree{"as"}{--}
+\end{tableau}
+
+Type expressions denote types in definitions of data types as well as
+in type constraints over patterns and expressions.
+
+\subsubsection*{sss:typexpr-variables}{Type variables}
+
+The type expression @"'" ident@ stands for the type variable named
+@ident@. The type expression @"_"@ stands for either an anonymous type
+variable or anonymous type parameters. In data type definitions, type
+variables are names for the data type parameters. In type constraints,
+they represent unspecified types that can be instantiated by any type
+to satisfy the type constraint.  In general the scope of a named type
+variable is the whole top-level phrase where it appears, and it can
+only be generalized when leaving this scope.  Anonymous variables have
+no such restriction. In the following cases, the scope of named type
+variables is restricted to the type expression where they appear:
+1) for universal (explicitly polymorphic) type variables;
+2) for type variables that only appear in public method specifications
+(as those variables will be made universal, as described in
+section~\ref{sss:clty-meth});
+3) for variables used as aliases, when the type they are aliased to
+would be invalid in the scope of the enclosing definition ({\it i.e.}
+when it contains free universal type variables, or locally
+defined types.)
+
+\subsubsection*{sss:typexr:parenthesized}{Parenthesized types}
+
+The type expression @"(" typexpr ")"@ denotes the same type as
+@typexpr@.
+
+\subsubsection*{sss:typexr-fun}{Function types}
+
+The type expression @typexpr_1 '->' typexpr_2@ denotes the type of
+functions mapping arguments of type @typexpr_1@ to results of type
+@typexpr_2@.
+
+@label-name ':' typexpr_1 '->' typexpr_2@ denotes the same function type, but
+the argument is labeled @label@.
+
+@'?' label-name ':' typexpr_1 '->' typexpr_2@ denotes the type of functions
+mapping an optional labeled argument of type @typexpr_1@ to results of
+type @typexpr_2@. That is, the physical type of the function will be
+@typexpr_1 "option" '->' typexpr_2@.
+
+\subsubsection*{sss:typexpr-tuple}{Tuple types}
+
+The type expression @typexpr_1 '*' \ldots '*' typexpr_n@
+denotes the type of tuples whose elements belong to types @typexpr_1,
+\ldots typexpr_n@ respectively.
+
+\subsubsection*{sss:typexpr-constructed}{Constructed types}
+
+Type constructors with no parameter, as in @typeconstr@, are type
+expressions.
+
+The type expression @typexpr typeconstr@, where @typeconstr@ is a type
+constructor with one parameter, denotes the application of the unary type
+constructor @typeconstr@ to the type @typexpr@.
+
+The type expression @(typexpr_1,\ldots,typexpr_n) typeconstr@, where
+@typeconstr@ is a type constructor with $n$ parameters, denotes the
+application of the $n$-ary type constructor @typeconstr@ to the types
+@typexpr_1@ through @typexpr_n@.
+
+In the type expression @ "_"  typeconstr @, the anonymous type expression
+@ "_" @ stands in for anonymous type parameters and is equivalent to
+@ ("_", \ldots,"_") @ with as many repetitions of "_" as the arity of
+@typeconstr@.
+
+\subsubsection*{sss:typexpr-aliased-recursive}{Aliased and recursive types}
+
+\ikwd{as\@\texttt{as}}
+
+The type expression @typexpr 'as' "'" ident@ denotes the same type as
+@typexpr@, and also binds the type variable @ident@ to type @typexpr@ both
+in @typexpr@ and in other types.  In general the scope of an alias is
+the same as for a named type variable, and covers the whole enclosing
+definition. If the type variable
+@ident@ actually occurs in @typexpr@, a recursive type is created. Recursive
+types for which  there exists a recursive path that does not contain
+an object or polymorphic variant type constructor are rejected, except
+when the "-rectypes" mode is selected.
+
+If @"'" ident@ denotes an explicit polymorphic variable, and @typexpr@
+denotes either an object or polymorphic variant type, the row variable
+of @typexpr@ is captured by @"'" ident@, and quantified upon.
+
+\subsubsection*{sss:typexpr-polyvar}{Polymorphic variant types}
+\ikwd{of\@\texttt{of}}
+
+\begin{syntax}
+polymorphic-variant-type:
+        '[' tag-spec-first { '|' tag-spec } ']'
+      | '[>' [ tag-spec ] { '|' tag-spec } ']'
+      | '[<' ['|'] tag-spec-full { '|' tag-spec-full }
+             [ '>' {{ '`'tag-name }} ] ']'
+;
+%\end{syntax} \begin{syntax}
+tag-spec-first:
+        '`'tag-name [ 'of' typexpr ]
+      | [ typexpr ] '|' tag-spec
+;
+tag-spec:
+        '`'tag-name [ 'of' typexpr ]
+      | typexpr
+;
+tag-spec-full:
+        '`'tag-name [ 'of' ['&'] typexpr { '&' typexpr } ]
+      | typexpr
+\end{syntax}
+
+Polymorphic variant types describe the values a polymorphic variant
+may take.
+
+The first case is an exact variant type: all possible tags are
+known, with their associated types, and they can all be present.
+Its structure is fully known.
+
+The second case is an open variant type, describing a polymorphic
+variant value: it gives the list of all tags the value could take,
+with their associated types. This type is still compatible with a
+variant type containing more tags. A special case is the unknown
+type, which does not define any tag, and is compatible with any
+variant type.
+
+The third case is a closed variant type. It gives information about
+all the possible tags and their associated types, and which tags are
+known to potentially appear in values. The exact variant type (first
+case) is
+just an abbreviation for a closed variant type where all possible tags
+are also potentially present.
+
+In all three cases, tags may be either specified directly in the
+@'`'tag-name ["of" typexpr]@ form, or indirectly through a type
+expression, which must expand to an
+exact variant type, whose tag specifications are inserted in its
+place.
+
+Full specifications of variant tags are only used for non-exact closed
+types. They can be understood as a conjunctive type for the argument:
+it is intended to have all the types enumerated in the
+specification.
+
+Such conjunctive constraints may be unsatisfiable. In such a case the
+corresponding tag may not be used in a value of this type. This
+does not mean that the whole type is not valid: one can still use
+other available tags.
+Conjunctive constraints are mainly intended as output from the type
+checker. When they are used in source programs, unsolvable constraints
+may cause early failures.
+
+\subsubsection*{sss:typexpr-obj}{Object types}
+
+An object type
+@'<' [method-type { ';' method-type }] '>'@
+is a record of method types.
+
+Each method may have an explicit polymorphic type: @{{ "'" ident }}
+'.' typexpr@. Explicit polymorphic variables have a local scope, and
+an explicit polymorphic type can only be unified to an
+equivalent one, where only the order and names of polymorphic
+variables may change.
+
+The type @'<' {method-type ';'} '..'  '>'@ is the
+type of an object whose method names and types are described by
+@method-type_1, \ldots, method-type_n@, and possibly some other
+methods represented by the ellipsis.  This ellipsis actually is
+a special kind of type variable (called {\em row variable} in the
+literature) that stands for any number of extra method types.
+
+\subsubsection*{sss:typexpr-sharp-types}{\#-types}
+
+The type @'#' classtype-path@ is a special kind of abbreviation. This
+abbreviation unifies with the type of any object belonging to a subclass
+of the class type @classtype-path@.
+%
+It is handled in a special way as it usually hides a type variable (an
+ellipsis, representing the methods that may be added in a subclass).
+In particular, it vanishes when the ellipsis gets instantiated.
+%
+Each type expression @'#' classtype-path@ defines a new type variable, so
+type @'#' classtype-path '->' '#' classtype-path@ is usually not the same as
+type @('#' classtype-path 'as' "'" ident) '->' "'" ident@.
+%
+
+Use of \#-types to abbreviate polymorphic variant types is deprecated.
+If @@t@@ is an exact variant type then @"#"@t@@ translates to @"[<" @t@"]"@,
+and @"#"@t@"[>" "`"tag_1 \dots"`"tag_k"]"@ translates to
+@"[<" @t@ ">" "`"tag_1 \dots"`"tag_k"]"@
+
+\subsubsection*{sss:typexpr-variant-record}{Variant and record types}
+
+There are no type expressions describing (defined) variant types nor
+record types, since those are always named, i.e. defined before use
+and referred to by name.  Type definitions are described in
+section~\ref{ss:typedefs}.
diff --git a/manual/manual/refman/values.etex b/manual/manual/refman/values.etex
new file mode 100644
index 00000000..d7e0b696
--- /dev/null
+++ b/manual/manual/refman/values.etex
@@ -0,0 +1,96 @@
+\section{s:values}{Values}
+%HEVEA\cutname{values.html}
+
+This section describes the kinds of values that are manipulated by
+OCaml programs.
+
+\subsection{ss:values:base}{Base values}
+
+\subsubsection*{sss:values:integer}{Integer numbers}
+
+Integer values are integer numbers from $-2^{30}$ to $2^{30}-1$, that
+is $-1073741824$ to $1073741823$. The implementation may support a
+wider range of integer values: on 64-bit platforms, the current
+implementation supports integers ranging from $-2^{62}$ to $2^{62}-1$.
+
+\subsubsection*{sss:values:float}{Floating-point numbers}
+
+Floating-point values are numbers in floating-point representation.
+The current implementation uses double-precision floating-point
+numbers conforming to the IEEE 754 standard, with 53 bits of mantissa
+and an exponent ranging from $-1022$ to $1023$.
+
+\subsubsection*{sss:values:char}{Characters}
+
+Character values are represented as 8-bit integers between 0 and 255.
+Character codes between 0 and 127 are interpreted following the ASCII
+standard. The current implementation interprets character codes
+between 128 and 255 following the ISO 8859-1 standard.
+
+\subsubsection*{sss:values:string}{Character strings}
+
+String values are finite sequences of characters. The current
+implementation supports strings containing up to $2^{24} - 5$
+characters (16777211 characters); on 64-bit platforms, the limit is
+$2^{57} - 9$.
+
+\subsection{ss:values:tuple}{Tuples}
+
+Tuples of values are written @'('@v@_1',' \ldots',' @v@_n')'@, standing for the
+$n$-tuple of values @@v@_1@ to @@v@_n@. The current implementation
+supports tuple of up to $2^{22} - 1$ elements (4194303 elements).
+
+\subsection{ss:values:records}{Records}
+
+Record values are labeled tuples of values. The record value written
+@'{' field_1 '=' @v@_1';' \ldots';' field_n '=' @v@_n '}'@ associates the value
+@@v@_i@ to the record field @field_i@, for $i = 1 \ldots n$. The current
+implementation supports records with up to $2^{22} - 1$ fields
+(4194303 fields).
+
+\subsection{ss:values:array}{Arrays}
+
+Arrays are finite, variable-sized sequences of values of the same
+type.  The current implementation supports arrays containing up to
+$2^{22} - 1$ elements (4194303 elements) unless the elements are
+floating-point numbers (2097151 elements in this case); on 64-bit
+platforms, the limit is $2^{54} - 1$ for all arrays.
+
+\subsection{ss:values:variant}{Variant values}
+
+Variant values are either a constant constructor, or a non-constant
+constructor applied to a number of values. The former case is written
+@constr@; the latter case is written @constr '('@v@_1',' ... ',' @v@_n
+')'@, where the @@v@_i@ are said to be the arguments of the non-constant
+constructor @constr@. The parentheses may be omitted if there is only
+one argument.
+
+The following constants are treated like built-in constant
+constructors:
+\begin{tableau}{|l|l|}{Constant}{Constructor}
+\entree{"false"}{the boolean false}
+\entree{"true"}{the boolean true}
+\entree{"()"}{the ``unit'' value}
+\entree{"[]"}{the empty list}
+\end{tableau}
+
+The current implementation limits each variant type to have at most
+246 non-constant constructors and $2^{30}-1$ constant constructors.
+
+\subsection{ss:values:polyvars}{Polymorphic variants}
+
+Polymorphic variants are an alternate form of variant values, not
+belonging explicitly to a predefined variant type, and following
+specific typing rules. They can be either constant, written
+@"`"tag-name@, or non-constant, written @"`"tag-name'('@v@')'@.
+
+\subsection{ss:values:fun}{Functions}
+
+Functional values are mappings from values to values.
+
+\subsection{ss:values:obj}{Objects}
+
+Objects are composed of a hidden internal state which is a
+record of instance variables, and a set of methods for accessing and
+modifying these variables.  The structure of an object is described by
+the toplevel class that created it.
diff --git a/manual/manual/style.css b/manual/manual/style.css
new file mode 100644
index 00000000..201f1118
--- /dev/null
+++ b/manual/manual/style.css
@@ -0,0 +1,80 @@
+/* fira-sans-regular - latin */
+@font-face {
+  font-family: 'Fira Sans';
+  font-style: normal;
+  font-weight: 400;
+  src: url('../fonts/fira-sans-v8-latin-regular.eot'); /* IE9 Compat Modes */
+  src: local('Fira Sans Regular'), local('FiraSans-Regular'),
+       url('../fonts/fira-sans-v8-latin-regular.eot?#iefix') format('embedded-opentype'), /* IE6-IE8 */
+       url('../fonts/fira-sans-v8-latin-regular.woff2') format('woff2'), /* Super Modern Browsers */
+       url('../fonts/fira-sans-v8-latin-regular.woff') format('woff'), /* Modern Browsers */
+       url('../fonts/fira-sans-v8-latin-regular.ttf') format('truetype'), /* Safari, Android, iOS */
+       url('../fonts/fira-sans-v8-latin-regular.svg#FiraSans') format('svg'); /* Legacy iOS */
+}
+
+
+a:visited {color : #416DFF; text-decoration : none; }
+a:link {color : #416DFF; text-decoration : none; }
+a:hover {color : Black; text-decoration : underline; }
+a:active {color : Black; text-decoration : underline; }
+.keyword { font-weight : bold ; color : Red }
+.keywordsign { color : #C04600 }
+.comment { color : Green }
+.constructor { color : Blue }
+.type { color : #5C6585 }
+.string { color : Maroon }
+.warning { color : Red ; font-weight : bold }
+.info { margin-left : 3em; margin-right : 3em }
+.code { color : #465F91 ; }
+h1 { font-size : 2rem ; text-align: center; }
+
+h2, h3, h4, h5, h6, div.h7, div.h8, div.h9 {
+  font-size: 1.75rem;
+  border: 1px solid #000;
+  margin-top: 20px;
+  margin-bottom: 2px;
+  text-align: center;
+  padding: 8px;
+  font-family: "Fira Sans", sans-serif;
+  font-weight: normal;
+}
+h1 {
+  font-family: "Fira Sans", sans-serif;
+  padding: 10px;
+}
+
+h2 { background-color: #90BDFF; }
+h3 { background-color: #90DDFF; }
+h4 { background-color: #90EDFF; }
+h5 { background-color: #90FDFF; }
+h6 { background-color: #90BDFF; }
+div.h7 { background-color: #90DDFF; }
+div.h8 { background-color: #F0FFFF; }
+div.h9 { background-color: #FFFFFF; }
+
+.typetable { border-style : hidden }
+.indextable { border-style : hidden }
+.paramstable { border-style : hidden ; padding: 5pt 5pt}
+body {
+  background-color : #f7f7f7;
+  font-size: 1rem;
+  max-width: 800px;
+  width: 85%;
+  margin: auto;
+  padding-bottom: 30px;
+}
+td {
+  font-size: 1rem;
+}
+.navbar { /* previous - up - next */
+  position: absolute;
+  left: 10px;
+  top: 10px;
+}
+tr { background-color : #f7f7f7 }
+td.typefieldcomment { background-color : #f7f7f7 }
+pre { margin-bottom: 4px; white-space: pre-wrap; }
+div.sig_block {margin-left: 2em}
+ul.info-attributes { list-style: none; margin: 0; padding: 0; }
+div.info > p:first-child{ margin-top:0; }
+div.info-desc > p:first-child { margin-top:0; margin-bottom:0; }
diff --git a/manual/manual/texstuff/.gitignore b/manual/manual/texstuff/.gitignore
new file mode 100644
index 00000000..4a604497
--- /dev/null
+++ b/manual/manual/texstuff/.gitignore
@@ -0,0 +1,13 @@
+*.aux
+*.dvi
+*.idx
+*.ilg
+*.ind
+*.log
+*.toc
+*.ipr
+*.txt
+*.pdf
+*.ps
+manual.out
+manual.out
diff --git a/manual/manual/textman/.gitignore b/manual/manual/textman/.gitignore
new file mode 100644
index 00000000..72475845
--- /dev/null
+++ b/manual/manual/textman/.gitignore
@@ -0,0 +1,5 @@
+manual.txt
+manual.hmanual.kwd
+*.haux
+*.hind
+*.htoc
diff --git a/manual/manual/tutorials/.gitignore b/manual/manual/tutorials/.gitignore
new file mode 100644
index 00000000..81ccbe71
--- /dev/null
+++ b/manual/manual/tutorials/.gitignore
@@ -0,0 +1,2 @@
+*.tex
+*.htex
diff --git a/manual/manual/tutorials/Makefile b/manual/manual/tutorials/Makefile
new file mode 100644
index 00000000..bf941a54
--- /dev/null
+++ b/manual/manual/tutorials/Makefile
@@ -0,0 +1,32 @@
+TOPDIR = ../../..
+include $(TOPDIR)/Makefile.tools
+
+LD_PATH = "$(TOPDIR)/otherlibs/str:$(TOPDIR)/otherlibs/unix"
+
+TOOLS = ../../tools
+CAMLLATEX = $(SET_LD_PATH) \
+  $(OCAMLRUN) $(TOPDIR)/tools/caml-tex \
+  -repo-root $(TOPDIR) -n 80 -v false
+TEXQUOTE = $(OCAMLRUN) $(TOOLS)/texquote2
+TRANSF = $(SET_LD_PATH) $(OCAMLRUN) $(TOOLS)/transf
+
+
+FILES = coreexamples.tex lablexamples.tex objectexamples.tex \
+  moduleexamples.tex advexamples.tex polymorphism.tex
+
+
+etex-files: $(FILES)
+all: $(FILES)
+
+
+%.gen.tex: %.etex
+	$(CAMLLATEX) $< -o $@
+
+%.tex: %.gen.tex
+	$(TEXQUOTE) < $< > $*.texquote_error.tex
+	mv $*.texquote_error.tex $@
+
+
+.PHONY: clean
+clean:
+	rm -f *.tex
diff --git a/manual/manual/tutorials/advexamples.etex b/manual/manual/tutorials/advexamples.etex
new file mode 100644
index 00000000..bd57a308
--- /dev/null
+++ b/manual/manual/tutorials/advexamples.etex
@@ -0,0 +1,636 @@
+\chapter{Advanced examples with classes and modules}
+%HEVEA\cutname{advexamples.html}
+\label{c:advexamples}
+
+{\it (Chapter written by Didier Rémy)}
+
+\bigskip
+
+\noindent
+
+In this chapter, we show some larger examples using objects, classes
+and modules.  We review many of the object features simultaneously on
+the example of a bank account.  We show how modules taken from the
+standard library can be expressed as classes.  Lastly, we describe a
+programming pattern known as {\em virtual types} through the example
+of window managers.
+
+\section{s:extended-bank-accounts}{Extended example: bank accounts}
+
+In this section, we illustrate most aspects of Object and inheritance
+by refining, debugging, and specializing the following
+initial naive definition of a simple bank account.  (We reuse the
+module "Euro" defined at the end of chapter~\ref{c:objectexamples}.)
+\begin{caml_eval}
+module type MONEY =
+  sig
+    type t
+    class c : float ->
+      object ('a)
+        val repr : t
+        method value : t
+        method print : unit
+        method times : float -> 'a
+        method leq : 'a -> bool
+        method plus : 'a -> 'a
+      end
+  end;;
+module Euro : MONEY =
+  struct
+    type t = float
+    class c x =
+      object (self : 'a)
+        val repr = x
+        method value = repr
+        method print = print_float repr
+        method times k = {< repr = k *. x >}
+        method leq (p : 'a) = repr <= p#value
+        method plus (p : 'a) = {< repr = x +. p#value >}
+      end
+  end;;
+\end{caml_eval}
+\begin{caml_example}{toplevel}
+let euro = new Euro.c;;
+let zero = euro 0.;;
+let neg x = x#times (-1.);;
+class account =
+  object
+    val mutable balance = zero
+    method balance = balance
+    method deposit x = balance <- balance # plus x
+    method withdraw x =
+      if x#leq balance then (balance <- balance # plus (neg x); x) else zero
+  end;;
+let c = new account in c # deposit (euro 100.); c # withdraw (euro 50.);;
+\end{caml_example}
+We now refine this definition with a method to compute interest.
+\begin{caml_example}{toplevel}
+class account_with_interests =
+  object (self)
+    inherit account
+    method private interest = self # deposit (self # balance # times 0.03)
+  end;;
+\end{caml_example}
+We make the method "interest" private, since clearly it should not be
+called freely from the outside. Here, it is only made accessible to subclasses
+that will manage monthly or yearly updates of the account.
+
+We should soon fix a bug in the current definition: the deposit method can
+be used for withdrawing money by depositing negative amounts. We can
+fix this directly:
+\begin{caml_example}{toplevel}
+class safe_account =
+  object
+    inherit account
+    method deposit x = if zero#leq x then balance <- balance#plus x
+  end;;
+\end{caml_example}
+However, the bug might be fixed more safely by  the following definition:
+\begin{caml_example}{toplevel}
+class safe_account =
+  object
+    inherit account as unsafe
+    method deposit x =
+      if zero#leq x then unsafe # deposit x
+      else raise (Invalid_argument "deposit")
+  end;;
+\end{caml_example}
+In particular, this does not require the knowledge of the implementation of
+the method "deposit".
+
+To keep track of operations, we extend the class with a mutable field
+"history" and a private method "trace" to add an operation in the
+log. Then each method to be traced is redefined.
+\begin{caml_example}{toplevel}
+type 'a operation = Deposit of 'a | Retrieval of 'a;;
+class account_with_history =
+  object (self)
+    inherit safe_account as super
+    val mutable history = []
+    method private trace x = history <- x :: history
+    method deposit x = self#trace (Deposit x);  super#deposit x
+    method withdraw x = self#trace (Retrieval x); super#withdraw x
+    method history = List.rev history
+  end;;
+\end{caml_example}
+%% \label{ss:bank:initializer}
+One may wish to open an account and simultaneously deposit some initial
+amount. Although the initial implementation did not address this
+requirement, it can be achieved by using an initializer.
+\begin{caml_example}{toplevel}
+class account_with_deposit x =
+  object
+    inherit account_with_history
+    initializer balance <- x
+  end;;
+\end{caml_example}
+A better alternative is:
+\begin{caml_example}{toplevel}
+class account_with_deposit x =
+  object (self)
+    inherit account_with_history
+    initializer self#deposit x
+  end;;
+\end{caml_example}
+Indeed, the latter is safer since the call to "deposit" will automatically
+benefit from safety checks and from the trace.
+Let's test it:
+\begin{caml_example}{toplevel}
+let ccp = new account_with_deposit (euro 100.) in
+let _balance = ccp#withdraw (euro 50.) in
+ccp#history;;
+\end{caml_example}
+Closing an account can be done with the following polymorphic function:
+\begin{caml_example}{toplevel}
+let close c = c#withdraw c#balance;;
+\end{caml_example}
+Of course, this applies to all sorts of accounts.
+
+Finally, we gather several versions of the account into a module "Account"
+abstracted over some currency.
+\begin{caml_example*}{toplevel}
+let today () = (01,01,2000) (* an approximation *)
+module Account (M:MONEY) =
+  struct
+    type m = M.c
+    let m = new M.c
+    let zero = m 0.
+
+    class bank =
+      object (self)
+        val mutable balance = zero
+        method balance = balance
+        val mutable history = []
+        method private trace x = history <- x::history
+        method deposit x =
+          self#trace (Deposit x);
+          if zero#leq x then balance <- balance # plus x
+          else raise (Invalid_argument "deposit")
+        method withdraw x =
+          if x#leq balance then
+            (balance <- balance # plus (neg x); self#trace (Retrieval x); x)
+          else zero
+        method history = List.rev history
+      end
+
+    class type client_view =
+      object
+        method deposit : m -> unit
+        method history : m operation list
+        method withdraw : m -> m
+        method balance : m
+      end
+
+    class virtual check_client x =
+      let y = if (m 100.)#leq x then x
+      else raise (Failure "Insufficient initial deposit") in
+      object (self)
+        initializer self#deposit y
+        method virtual deposit: m -> unit
+      end
+
+    module Client (B : sig class bank : client_view end) =
+      struct
+        class account x : client_view =
+          object
+            inherit B.bank
+            inherit check_client x
+          end
+
+        let discount x =
+          let c = new account x in
+          if today() < (1998,10,30) then c # deposit (m 100.); c
+      end
+  end;;
+\end{caml_example*}
+This shows the use of modules to group several class definitions that can in
+fact be thought of as a single unit.  This unit would be provided by a bank
+for both internal and external uses.
+This is implemented as a functor that abstracts over the currency so that
+the same code can be used to provide accounts in different currencies.
+
+The class "bank" is the {\em real} implementation of the bank account (it
+could have been inlined). This is the one that will be used for further
+extensions, refinements, etc.  Conversely, the client will only be given the client view.
+\begin{caml_example*}{toplevel}
+module Euro_account = Account(Euro);;
+module Client = Euro_account.Client (Euro_account);;
+new Client.account (new Euro.c 100.);;
+\end{caml_example*}
+Hence, the clients do not have direct access to the "balance", nor the
+"history" of their own accounts. Their only way to change their balance is
+to deposit or withdraw  money.  It is important to give the clients
+a class and not just the ability to create accounts (such as the
+promotional "discount" account), so that they can
+personalize their account.
+For instance, a client may refine the "deposit" and "withdraw" methods
+so as to do his own financial bookkeeping, automatically.  On the
+other hand, the function "discount" is given as such, with no
+possibility for further personalization.
+
+It is important to provide the client's view as a functor
+"Client" so that client accounts can still be built after a possible
+specialization of the "bank".
+The functor "Client" may remain unchanged and be passed
+the new definition to initialize a client's view of the extended account.
+\begin{caml_example*}{toplevel}
+module Investment_account (M : MONEY) =
+  struct
+    type m = M.c
+    module A = Account(M)
+
+    class bank =
+      object
+        inherit A.bank as super
+        method deposit x =
+          if (new M.c 1000.)#leq x then
+            print_string "Would you like to invest?";
+          super#deposit x
+      end
+
+    module Client = A.Client
+  end;;
+\end{caml_example*}
+\begin{caml_eval}
+module Euro_account = Investment_account (Euro);;
+module Client = Euro_account.Client (Euro_account);;
+new Client.account (new Euro.c 100.);;
+\end{caml_eval}
+The functor "Client" may also be redefined when some new features of the
+account can be given to the client.
+\begin{caml_example*}{toplevel}
+module Internet_account (M : MONEY) =
+  struct
+    type m = M.c
+    module A = Account(M)
+
+    class bank =
+      object
+        inherit A.bank
+        method mail s = print_string s
+      end
+
+    class type client_view =
+      object
+        method deposit : m -> unit
+        method history : m operation list
+        method withdraw : m -> m
+        method balance : m
+        method mail : string -> unit
+      end
+
+    module Client (B : sig class bank : client_view end) =
+      struct
+        class account x : client_view =
+          object
+            inherit B.bank
+            inherit A.check_client x
+          end
+      end
+  end;;
+\end{caml_example*}
+\begin{caml_eval}
+module Euro_account = Internet_account (Euro);;
+module Client = Euro_account.Client (Euro_account);;
+new Client.account (new Euro.c 100.);;
+\end{caml_eval}
+
+
+\section{s:modules-as-classes}{Simple modules as classes}
+
+One may wonder whether it is possible to treat primitive types such as
+integers and strings as objects. Although this is usually uninteresting
+for integers or strings, there may be some situations where
+this is desirable. The class "money"  above is such an example.
+We show here how to do it for strings.
+
+\subsection{ss:string-as-class}{Strings}
+
+A naive definition of strings as objects could be:
+\begin{caml_example}{toplevel}
+class ostring s =
+  object
+     method get n = String.get s n
+     method print = print_string s
+     method escaped = new ostring (String.escaped s)
+  end;;
+\end{caml_example}
+However, the method "escaped" returns an object of the class "ostring",
+and not an object of the current class. Hence, if the class is further
+extended, the method "escaped" will only return an object of the parent
+class.
+\begin{caml_example}{toplevel}
+class sub_string s =
+  object
+     inherit ostring s
+     method sub start len = new sub_string (String.sub s  start len)
+  end;;
+\end{caml_example}
+As seen in section~\ref{s:binary-methods}, the solution is to use
+functional update instead. We need to create an instance variable
+containing the representation "s" of the string.
+\begin{caml_example}{toplevel}
+class better_string s =
+  object
+     val repr = s
+     method get n = String.get repr n
+     method print = print_string repr
+     method escaped = {< repr = String.escaped repr >}
+     method sub start len = {< repr = String.sub s start len >}
+  end;;
+\end{caml_example}
+As shown in the inferred type, the methods "escaped" and "sub" now return
+objects of the same type as the one of the class.
+
+Another difficulty is the implementation of the method "concat".
+In order to concatenate a string with another string of the same class,
+one must be able to access the instance variable externally. Thus, a method
+"repr" returning s must be defined. Here is the correct definition of
+strings:
+\begin{caml_example}{toplevel}
+class ostring s =
+  object (self : 'mytype)
+     val repr = s
+     method repr = repr
+     method get n = String.get repr n
+     method print = print_string repr
+     method escaped = {< repr = String.escaped repr >}
+     method sub start len = {< repr = String.sub s start len >}
+     method concat (t : 'mytype) = {< repr = repr ^ t#repr >}
+  end;;
+\end{caml_example}
+Another constructor of the class string can be defined to return a new
+string of a given length:
+\begin{caml_example}{toplevel}
+class cstring n = ostring (String.make n ' ');;
+\end{caml_example}
+Here, exposing the representation of strings is probably harmless.  We do
+could also hide the representation of strings as we hid the currency in the
+class "money" of section~\ref{s:friends}.
+
+\subsubsection{sss:stack-as-class}{Stacks}
+
+There is sometimes an alternative between using modules or classes for
+parametric data types.
+Indeed, there are situations when the two approaches are quite similar.
+For instance, a stack can be  straightforwardly implemented as a class:
+\begin{caml_example}{toplevel}
+exception Empty;;
+class ['a] stack =
+  object
+    val mutable l = ([] : 'a list)
+    method push x = l <- x::l
+    method pop = match l with [] -> raise Empty | a::l' -> l <- l'; a
+    method clear = l <- []
+    method length = List.length l
+  end;;
+\end{caml_example}
+However, writing a method for iterating over a stack is more
+problematic.  A method "fold" would have type
+"('b -> 'a -> 'b) -> 'b -> 'b". Here "'a" is the parameter of the stack.
+The parameter "'b" is not related to the class "'a stack" but to the
+argument that will be passed to the method "fold".
+%The intuition is that method "fold" should be polymorphic, i.e. of type
+%"All ('a) ('b -> 'a -> 'b) -> 'b -> 'b".
+A naive approach is to make "'b" an extra parameter of class "stack":
+\begin{caml_example}{toplevel}
+class ['a, 'b] stack2 =
+  object
+    inherit ['a] stack
+    method fold f (x : 'b) = List.fold_left f x l
+  end;;
+\end{caml_example}
+However, the method "fold" of a given object can only be
+applied to functions that all have the same type:
+\begin{caml_example}{toplevel}
+let s = new stack2;;
+s#fold ( + ) 0;;
+s;;
+\end{caml_example}
+A better solution is to use polymorphic methods, which were
+introduced in OCaml version 3.05.  Polymorphic methods makes
+it possible to treat the type variable "'b" in the type of "fold" as
+universally quantified, giving "fold" the polymorphic type
+"Forall 'b. ('b -> 'a -> 'b) -> 'b -> 'b".
+An explicit type declaration on the method "fold" is required, since
+the type checker cannot infer the polymorphic type by itself.
+\begin{caml_example}{toplevel}
+class ['a] stack3 =
+  object
+    inherit ['a] stack
+    method fold : 'b. ('b -> 'a -> 'b) -> 'b -> 'b
+                = fun f x -> List.fold_left f x l
+  end;;
+\end{caml_example}
+
+% However, the nice correspondence between the implementations of stacks as
+% modules or classes is a very particular case.
+
+% XXX Maps
+
+\subsection{ss:hashtbl-as-class}{Hashtbl}
+
+A simplified version of object-oriented hash tables should have the
+following class type.
+\begin{caml_example}{toplevel}
+class type ['a, 'b] hash_table =
+  object
+    method find : 'a -> 'b
+    method add : 'a -> 'b -> unit
+  end;;
+\end{caml_example}
+A simple implementation, which is quite reasonable for small hash tables is
+to use an association list:
+\begin{caml_example}{toplevel}
+class ['a, 'b] small_hashtbl : ['a, 'b] hash_table =
+  object
+    val mutable table = []
+    method find key = List.assoc key table
+    method add key valeur = table <- (key, valeur) :: table
+  end;;
+\end{caml_example}
+A better implementation, and one that scales up better, is to use a
+true hash table\ldots\ whose elements are small hash tables!
+\begin{caml_example}{toplevel}
+class ['a, 'b] hashtbl size : ['a, 'b] hash_table =
+  object (self)
+    val table = Array.init size (fun i -> new small_hashtbl)
+    method private hash key =
+      (Hashtbl.hash key) mod (Array.length table)
+    method find key = table.(self#hash key) # find key
+    method add key = table.(self#hash key) # add key
+  end;;
+\end{caml_example}
+
+% problem
+
+% solution
+
+\subsection{ss:set-as-class}{Sets}
+
+Implementing sets leads to another difficulty.  Indeed, the method
+"union" needs to be able to access the internal representation of
+another object of the same class.
+
+This is another instance of friend functions as seen in
+section~\ref{s:friends}. Indeed, this is the same mechanism used in the module
+"Set" in the absence of objects.
+
+In the object-oriented version of sets, we only need to add an additional
+method "tag" to return the representation of a set. Since sets are
+parametric in the type of elements, the method "tag" has a parametric type
+"'a tag", concrete within
+the module definition but abstract in its signature.
+From outside, it will then be guaranteed that two objects with a method "tag"
+of the same type will share the same representation.
+\begin{caml_example*}{toplevel}
+module type SET =
+  sig
+    type 'a tag
+    class ['a] c :
+      object ('b)
+        method is_empty : bool
+        method mem : 'a -> bool
+        method add : 'a -> 'b
+        method union : 'b -> 'b
+        method iter : ('a -> unit) -> unit
+        method tag : 'a tag
+      end
+  end;;
+module Set : SET =
+  struct
+    let rec merge l1 l2 =
+      match l1 with
+        [] -> l2
+      | h1 :: t1 ->
+          match l2 with
+            [] -> l1
+          | h2 :: t2 ->
+              if h1 < h2 then h1 :: merge t1 l2
+              else if h1 > h2 then h2 :: merge l1 t2
+              else merge t1 l2
+    type 'a tag = 'a list
+    class ['a] c =
+      object (_ : 'b)
+        val repr = ([] : 'a list)
+        method is_empty = (repr = [])
+        method mem x = List.exists (( = ) x) repr
+        method add x = {< repr = merge [x] repr >}
+        method union (s : 'b) = {< repr = merge repr s#tag >}
+        method iter (f : 'a -> unit) = List.iter f repr
+        method tag = repr
+      end
+  end;;
+\end{caml_example*}
+
+\section{s:subject-observer}{The subject/observer pattern}
+
+The following example, known as the subject/observer pattern, is often
+presented in the literature as a difficult inheritance problem with
+inter-connected classes.
+The general pattern amounts to the definition a pair of two
+classes that recursively interact with one another.
+
+The class "observer"  has a distinguished method "notify" that requires
+two arguments, a subject and an event to execute an action.
+\begin{caml_example}{toplevel}
+class virtual ['subject, 'event] observer =
+  object
+    method virtual notify : 'subject ->  'event -> unit
+  end;;
+\end{caml_example}
+The class "subject" remembers a list of observers in an instance variable,
+and has a distinguished method "notify_observers" to broadcast the message
+"notify" to all observers with a particular event "e".
+\begin{caml_example}{toplevel}
+class ['observer, 'event] subject =
+  object (self)
+    val mutable observers = ([]:'observer list)
+    method add_observer obs = observers <- (obs :: observers)
+    method notify_observers (e : 'event) =
+        List.iter (fun x -> x#notify self e) observers
+  end;;
+\end{caml_example}
+The difficulty usually lies  in defining instances of the pattern above
+by inheritance. This can be done in a natural and obvious manner in
+OCaml, as shown on the following example manipulating windows.
+\begin{caml_example}{toplevel}
+type event = Raise | Resize | Move;;
+let string_of_event = function
+    Raise -> "Raise" | Resize -> "Resize" | Move -> "Move";;
+let count = ref 0;;
+class ['observer] window_subject =
+  let id = count := succ !count; !count in
+  object (self)
+    inherit ['observer, event] subject
+    val mutable position = 0
+    method identity = id
+    method move x = position <- position + x; self#notify_observers Move
+    method draw = Printf.printf "{Position = %d}\n"  position;
+  end;;
+class ['subject] window_observer =
+  object
+    inherit ['subject, event] observer
+    method notify s e = s#draw
+  end;;
+\end{caml_example}
+As can be expected, the type of "window" is recursive.
+\begin{caml_example}{toplevel}
+let window = new window_subject;;
+\end{caml_example}
+However, the two classes of "window_subject" and "window_observer" are not
+mutually recursive.
+\begin{caml_example}{toplevel}
+let window_observer = new window_observer;;
+window#add_observer window_observer;;
+window#move 1;;
+\end{caml_example}
+
+Classes "window_observer" and "window_subject" can still be extended by
+inheritance. For instance, one may enrich the "subject" with new
+behaviors and refine the behavior of the observer.
+\begin{caml_example}{toplevel}
+class ['observer] richer_window_subject =
+  object (self)
+    inherit ['observer] window_subject
+    val mutable size = 1
+    method resize x = size <- size + x; self#notify_observers Resize
+    val mutable top = false
+    method raise = top <- true; self#notify_observers Raise
+    method draw = Printf.printf "{Position = %d; Size = %d}\n"  position size;
+  end;;
+class ['subject] richer_window_observer =
+  object
+    inherit ['subject] window_observer as super
+    method notify s e = if e <> Raise then s#raise; super#notify s e
+  end;;
+\end{caml_example}
+We can also create a different kind of observer:
+\begin{caml_example}{toplevel}
+class ['subject] trace_observer =
+  object
+    inherit ['subject, event] observer
+    method notify s e =
+      Printf.printf
+        "\n" s#identity (string_of_event e)
+  end;;
+\end{caml_example}
+and attach several observers to the same object:
+\begin{caml_example}{toplevel}
+let window = new richer_window_subject;;
+window#add_observer (new richer_window_observer);;
+window#add_observer (new trace_observer);;
+window#move 1; window#resize 2;;
+\end{caml_example}
+
+%\subsection{ss:Classes used as modules with inheritance}
+%
+% to be filled for next release...
+%
+% an example of stateless objects used to provide inheritance in modules
+%
+
+
+% LocalWords:  objectexamples bsection init caml val int Oo succ incr ref
+% LocalWords:  typecheck leq bool cp eval sig struct ABSPOINT Abspoint iter neg
+% LocalWords:  accu mem rec repr Euro euro ccp inlined ostring len concat OCaml
diff --git a/manual/manual/tutorials/coreexamples.etex b/manual/manual/tutorials/coreexamples.etex
new file mode 100644
index 00000000..55726aba
--- /dev/null
+++ b/manual/manual/tutorials/coreexamples.etex
@@ -0,0 +1,978 @@
+\chapter{The core language} \label{c:core-xamples}
+%HEVEA\cutname{coreexamples.html}
+
+This part of the manual is a tutorial introduction to the
+OCaml language. A good familiarity with programming in a conventional
+languages (say, C or Java) is assumed, but no prior exposure to
+functional languages is required. The present chapter introduces the
+core language. Chapter~\ref{c:moduleexamples} deals with the
+module system, chapter~\ref{c:objectexamples} with the
+object-oriented features, chapter~\ref{c:labl-examples} with
+extensions to the core language (labeled arguments and polymorphic
+variants), and chapter~\ref{c:advexamples} gives some advanced examples.
+
+\section{s:basics}{Basics}
+
+For this overview of OCaml, we use the interactive system, which
+is started by running "ocaml" from the Unix shell, or by launching the
+"OCamlwin.exe" application under Windows. This tutorial is presented
+as the transcript of a session with the interactive system:
+lines starting with "#" represent user input; the system responses are
+printed below, without a leading "#".
+
+Under the interactive system, the user types OCaml phrases terminated
+by ";;" in response to the "#" prompt, and the system compiles them
+on the fly, executes them, and prints the outcome of evaluation.
+Phrases are either simple expressions, or "let" definitions of
+identifiers (either values or functions).
+\begin{caml_example}{toplevel}
+1+2*3;;
+let pi = 4.0 *. atan 1.0;;
+let square x = x *. x;;
+square (sin pi) +. square (cos pi);;
+\end{caml_example}
+The OCaml system computes both the value and the type for
+each phrase. Even function parameters need no explicit type declaration:
+the system infers their types from their usage in the
+function. Notice also that integers and floating-point numbers are
+distinct types, with distinct operators: "+" and "*" operate on
+integers, but "+." and "*."  operate on floats.
+\begin{caml_example}{toplevel}[error]
+1.0 * 2;;
+\end{caml_example}
+
+Recursive functions are defined with the "let rec" binding:
+\begin{caml_example}{toplevel}
+let rec fib n =
+  if n < 2 then n else fib (n-1) + fib (n-2);;
+fib 10;;
+\end{caml_example}
+
+\section{s:datatypes}{Data types}
+
+In addition to integers and floating-point numbers, OCaml offers the
+usual basic data types:
+\begin{itemize}%
+\item booleans
+\begin{caml_example}{toplevel}
+(1 < 2) = false;;
+let one = if true then 1 else 2;;
+\end{caml_example}
+\item characters
+\begin{caml_example}{toplevel}
+ 'a';;
+ int_of_char '\n';;
+\end{caml_example}
+\item immutable character strings
+\begin{caml_example}{toplevel}
+"Hello" ^ " " ^ "world";;
+{|This is a quoted string, here, neither \ nor " are special characters|};;
+{|"\\"|}="\"\\\\\"";;
+  {delimiter|the end of this|}quoted string is here|delimiter}
+=           "the end of this|}quoted string is here";;
+\end{caml_example}
+\end{itemize}
+
+Predefined data structures include tuples, arrays, and lists. There are also
+general mechanisms for defining your own data structures, such as records and
+variants, which will be covered in more detail later; for now, we concentrate
+on lists. Lists are either given in extension as a bracketed list of
+semicolon-separated elements, or built from the empty list "[]"
+(pronounce ``nil'') by adding elements in front using the "::"
+(``cons'') operator.
+\begin{caml_example}{toplevel}
+let l = ["is"; "a"; "tale"; "told"; "etc."];;
+"Life" :: l;;
+\end{caml_example}
+As with all other OCaml data structures, lists do not need to be
+explicitly allocated and deallocated from memory: all memory
+management is entirely automatic in OCaml. Similarly, there is no
+explicit handling of pointers: the OCaml compiler silently introduces
+pointers where necessary.
+
+As with most OCaml data structures, inspecting and destructuring lists
+is performed by pattern-matching. List patterns have exactly the same
+form as list expressions, with identifiers representing unspecified
+parts of the list. As an example, here is insertion sort on a list:
+\begin{caml_example}{toplevel}
+let rec sort lst =
+  match lst with
+    [] -> []
+  | head :: tail -> insert head (sort tail)
+and insert elt lst =
+  match lst with
+    [] -> [elt]
+  | head :: tail -> if elt <= head then elt :: lst else head :: insert elt tail
+;;
+sort l;;
+\end{caml_example}
+
+The type inferred for "sort", "'a list -> 'a list", means that "sort"
+can actually apply to lists of any type, and returns a list of the
+same type. The type "'a" is a {\em type variable}, and stands for any
+given type. The reason why "sort" can apply to lists of any type is
+that the comparisons ("=", "<=", etc.) are {\em polymorphic} in OCaml:
+they operate between any two values of the same type. This makes
+"sort" itself polymorphic over all list types.
+\begin{caml_example}{toplevel}
+sort [6;2;5;3];;
+sort [3.14; 2.718];;
+\end{caml_example}
+
+The "sort" function above does not modify its input list: it builds
+and returns a new list containing the same elements as the input list,
+in ascending order. There is actually no way in OCaml to modify
+a list in-place once it is built: we say that lists are  {\em immutable}
+data structures. Most OCaml data structures are immutable, but a few
+(most notably arrays) are {\em mutable}, meaning that they can be
+modified in-place at any time.
+
+The OCaml notation for the type of a function with multiple arguments is \\
+"arg1_type -> arg2_type -> ... -> return_type".  For example,
+the type inferred for "insert", "'a -> 'a list -> 'a list", means that "insert"
+takes two arguments, an element of any type "'a" and a list with elements of
+the same type "'a" and returns a list of the same type.
+\section{s:functions-as-values}{Functions as values}
+
+OCaml is a  functional language: functions in the full mathematical
+sense are supported and can be passed around freely just as any other
+piece of data. For instance, here is a "deriv" function that takes any
+float function as argument and returns an approximation of its
+derivative function:
+\begin{caml_example}{toplevel}
+let deriv f dx = function x -> (f (x +. dx) -. f x) /. dx;;
+let sin' = deriv sin 1e-6;;
+sin' pi;;
+\end{caml_example}
+Even function composition is definable:
+\begin{caml_example}{toplevel}
+let compose f g = function x -> f (g x);;
+let cos2 = compose square cos;;
+\end{caml_example}
+
+Functions that take other functions as arguments are called
+``functionals'', or ``higher-order functions''. Functionals are
+especially useful to provide iterators or similar generic operations
+over a data structure. For instance, the standard OCaml library
+provides a "List.map" functional that applies a given function to each
+element of a list, and returns the list of the results:
+\begin{caml_example}{toplevel}
+List.map (function n -> n * 2 + 1) [0;1;2;3;4];;
+\end{caml_example}
+This functional, along with a number of other list and array
+functionals, is predefined because it is often useful, but there is
+nothing magic with it: it can easily be defined as follows.
+\begin{caml_example}{toplevel}
+let rec map f l =
+  match l with
+    [] -> []
+  | hd :: tl -> f hd :: map f tl;;
+\end{caml_example}
+
+\section{s:tut-recvariants}{Records and variants}
+
+User-defined data structures include records and variants. Both are
+defined with the "type" declaration. Here, we declare a record type to
+represent rational numbers.
+\begin{caml_example}{toplevel}
+type ratio = {num: int; denom: int};;
+let add_ratio r1 r2 =
+  {num = r1.num * r2.denom + r2.num * r1.denom;
+   denom = r1.denom * r2.denom};;
+add_ratio {num=1; denom=3} {num=2; denom=5};;
+\end{caml_example}
+Record fields can also be accessed through pattern-matching:
+\begin{caml_example}{toplevel}
+let integer_part r =
+  match r with
+    {num=num; denom=denom} -> num / denom;;
+\end{caml_example}
+Since there is only one case in this pattern matching, it
+is safe to expand directly the argument "r" in a record pattern:
+\begin{caml_example}{toplevel}
+let integer_part {num=num; denom=denom} = num / denom;;
+\end{caml_example}
+Unneeded fields can be omitted:
+\begin{caml_example}{toplevel}
+let get_denom {denom=denom} = denom;;
+\end{caml_example}
+Optionally, missing fields can be made explicit by ending the list of
+fields with a trailing wildcard "_"::
+\begin{caml_example}{toplevel}
+let get_num {num=num; _ } = num;;
+\end{caml_example}
+When both sides of the "=" sign are the same, it is possible to avoid
+repeating the field name by eliding the "=field" part:
+\begin{caml_example}{toplevel}
+let integer_part {num; denom} = num / denom;;
+\end{caml_example}
+This short notation for fields also works when constructing records:
+\begin{caml_example}{toplevel}
+let ratio num denom = {num; denom};;
+\end{caml_example}
+At last, it is possible to update few fields of a record at once:
+\begin{caml_example}{toplevel}
+  let integer_product integer ratio = { ratio with num = integer * ratio.num };;
+\end{caml_example}
+With this functional update notation, the record on the left-hand side
+of "with" is copied except for the fields on the right-hand side which
+are updated.
+
+The declaration of a variant type lists all possible forms for values
+of that type. Each case is identified by a name, called a constructor,
+which serves both for constructing values of the variant type and
+inspecting them by pattern-matching. Constructor names are capitalized
+to distinguish them from variable names (which must start with a
+lowercase letter). For instance, here is a variant
+type for doing mixed arithmetic (integers and floats):
+\begin{caml_example}{toplevel}
+type number = Int of int | Float of float | Error;;
+\end{caml_example}
+This declaration expresses that a value of type "number" is either an
+integer, a floating-point number, or the constant "Error" representing
+the result of an invalid operation (e.g. a division by zero).
+
+Enumerated types are a special case of variant types, where all
+alternatives are constants:
+\begin{caml_example}{toplevel}
+type sign = Positive | Negative;;
+let sign_int n = if n >= 0 then Positive else Negative;;
+\end{caml_example}
+
+To define arithmetic operations for the "number" type, we use
+pattern-matching on the two numbers involved:
+\begin{caml_example}{toplevel}
+let add_num n1 n2 =
+  match (n1, n2) with
+    (Int i1, Int i2) ->
+      (* Check for overflow of integer addition *)
+      if sign_int i1 = sign_int i2 && sign_int (i1 + i2) <> sign_int i1
+      then Float(float i1 +. float i2)
+      else Int(i1 + i2)
+  | (Int i1, Float f2) -> Float(float i1 +. f2)
+  | (Float f1, Int i2) -> Float(f1 +. float i2)
+  | (Float f1, Float f2) -> Float(f1 +. f2)
+  | (Error, _) -> Error
+  | (_, Error) -> Error;;
+add_num (Int 123) (Float 3.14159);;
+\end{caml_example}
+
+Another interesting example of variant type is the built-in
+"'a option" type which represents either a value of type "'a" or an
+absence of value:
+\begin{caml_example}{toplevel}
+type 'a option = Some of 'a | None;;
+\end{caml_example}
+This type is particularly useful when defining function that can
+fail in common situations, for instance
+\begin{caml_example}{toplevel}
+let safe_square_root x = if x > 0. then Some(sqrt x) else None;;
+\end{caml_example}
+
+The most common usage of variant types is to describe recursive data
+structures. Consider for example the type of binary trees:
+\begin{caml_example}{toplevel}
+type 'a btree = Empty | Node of 'a * 'a btree * 'a btree;;
+\end{caml_example}
+This definition reads as follows: a binary tree containing values of
+type "'a" (an arbitrary type) is either empty, or is a node containing
+one value of type "'a" and two subtrees also containing values of type
+"'a", that is, two "'a btree".
+
+Operations on binary trees are naturally expressed as recursive functions
+following the same structure as the type definition itself. For
+instance, here are functions performing lookup and insertion in
+ordered binary trees (elements increase from left to right):
+\begin{caml_example}{toplevel}
+let rec member x btree =
+  match btree with
+    Empty -> false
+  | Node(y, left, right) ->
+      if x = y then true else
+      if x < y then member x left else member x right;;
+let rec insert x btree =
+  match btree with
+    Empty -> Node(x, Empty, Empty)
+  | Node(y, left, right) ->
+      if x <= y then Node(y, insert x left, right)
+                else Node(y, left, insert x right);;
+\end{caml_example}
+
+
+\subsection{ss:record-and-variant-disambiguation}{Record and variant disambiguation}
+( This subsection can be skipped on the first reading )
+
+Astute readers may have wondered what happens when two or more record
+fields or constructors share the same name
+
+\begin{caml_example*}{toplevel}
+type first_record  = { x:int; y:int; z:int }
+type middle_record = { x:int; z:int }
+type last_record   = { x:int };;
+type first_variant = A | B | C
+type last_variant  = A;;
+\end{caml_example*}
+
+The answer is that when confronted with multiple options, OCaml tries to
+use locally available information to disambiguate between the various fields
+and constructors. First, if the type of the record or variant is known,
+OCaml can pick unambiguously the corresponding field or constructor.
+For instance:
+
+\begin{caml_example}{toplevel}
+let look_at_x_then_z (r:first_record) =
+  let x = r.x in
+  x + r.z;;
+let permute (x:first_variant) = match x with
+  | A -> (B:first_variant)
+  | B -> A
+  | C -> C;;
+type wrapped = First of first_record
+let f (First r) = r, r.x;;
+\end{caml_example}
+
+In the first example, "(r:first_record)" is an explicit annotation
+telling OCaml that the type of "r" is "first_record". With this
+annotation, Ocaml knows that "r.x" refers to the "x" field of the first
+record type. Similarly, the type annotation in the second example makes
+it clear to OCaml that the constructors "A", "B" and "C" come from the
+first variant type. Contrarily, in the last example, OCaml has inferred
+by itself that the type of "r" can only be "first_record" and there are
+no needs for explicit type annotations.
+
+Those explicit type annotations can in fact be used anywhere.
+Most of the time they are unnecessary, but they are useful to guide
+disambiguation, to debug unexpected type errors, or combined with some
+of the more advanced features of OCaml described in later chapters.
+
+Secondly, for records, OCaml can also deduce the right record type by
+looking at the whole set of fields used in a expression or pattern:
+\begin{caml_example}{toplevel}
+let project_and_rotate {x;y; _ } = { x= - y; y = x ; z = 0} ;;
+\end{caml_example}
+Since the fields "x" and "y" can only appear simultaneously in the first
+record type, OCaml infers that the type of "project_and_rotate" is
+"first_record -> first_record".
+
+In last resort, if there is not enough information to disambiguate between
+different fields or constructors, Ocaml picks the last defined type
+amongst all locally valid choices:
+
+\begin{caml_example}{toplevel}
+let look_at_xz {x;z} = x;;
+\end{caml_example}
+
+Here, OCaml has inferred that the possible choices for the type of
+"{x;z}" are "first_record" and "middle_record", since the type
+"last_record" has no field "z". Ocaml then picks the type "middle_record"
+as the last defined type between the two possibilities.
+
+Beware that this last resort disambiguation is local: once Ocaml has
+chosen a disambiguation, it sticks to this choice, even if it leads to
+an ulterior type error:
+
+\begin{caml_example}{toplevel}[error]
+let look_at_x_then_y r =
+  let x = r.x in (* Ocaml deduces [r: last_record] *)
+  x + r.y;;
+let is_a_or_b x = match x with
+  | A -> true (* OCaml infers [x: last_variant] *)
+  | B -> true;;
+\end{caml_example}
+
+Moreover, being the last defined type is a quite unstable position that
+may change surreptitiously after adding or moving around a type
+definition, or after opening a module (see chapter \ref{c:moduleexamples}).
+Consequently, adding explicit type annotations to guide disambiguation is
+more robust than relying on the last defined type disambiguation.
+
+\section{s:imperative-features}{Imperative features}
+
+Though all examples so far were written in purely applicative style,
+OCaml is also equipped with full imperative features. This includes the
+usual "while" and "for" loops, as well as mutable data structures such
+as arrays. Arrays are either created by listing semicolon-separated element
+values between "[|" and "|]" brackets, or allocated and initialized with the
+"Array.make" function, then filled up later by assignments. For instance, the
+function below sums two vectors (represented as float arrays) componentwise.
+\begin{caml_example}{toplevel}
+let add_vect v1 v2 =
+  let len = min (Array.length v1) (Array.length v2) in
+  let res = Array.make len 0.0 in
+  for i = 0 to len - 1 do
+    res.(i) <- v1.(i) +. v2.(i)
+  done;
+  res;;
+add_vect [| 1.0; 2.0 |] [| 3.0; 4.0 |];;
+\end{caml_example}
+
+Record fields can also be modified by assignment, provided they are
+declared "mutable" in the definition of the record type:
+\begin{caml_example}{toplevel}
+type mutable_point = { mutable x: float; mutable y: float };;
+let translate p dx dy =
+  p.x <- p.x +. dx; p.y <- p.y +. dy;;
+let mypoint = { x = 0.0; y = 0.0 };;
+translate mypoint 1.0 2.0;;
+mypoint;;
+\end{caml_example}
+
+OCaml has no built-in notion of variable -- identifiers whose current
+value can be changed by assignment. (The "let" binding is not an
+assignment, it introduces a new identifier with a new scope.)
+However, the standard library provides references, which are mutable
+indirection cells, with operators "!" to fetch
+the current contents of the reference and ":=" to assign the contents.
+Variables can then be emulated by "let"-binding a reference. For
+instance, here is an in-place insertion sort over arrays:
+\begin{caml_example}{toplevel}
+let insertion_sort a =
+  for i = 1 to Array.length a - 1 do
+    let val_i = a.(i) in
+    let j = ref i in
+    while !j > 0 && val_i < a.(!j - 1) do
+      a.(!j) <- a.(!j - 1);
+      j := !j - 1
+    done;
+    a.(!j) <- val_i
+  done;;
+\end{caml_example}
+
+References are also useful to write functions that maintain a current
+state between two calls to the function. For instance, the following
+pseudo-random number generator keeps the last returned number in a
+reference:
+\begin{caml_example}{toplevel}
+let current_rand = ref 0;;
+let random () =
+  current_rand := !current_rand * 25713 + 1345;
+  !current_rand;;
+\end{caml_example}
+
+Again, there is nothing magical with references: they are implemented as
+a single-field mutable record, as follows.
+\begin{caml_example}{toplevel}
+type 'a ref = { mutable contents: 'a };;
+let ( ! ) r = r.contents;;
+let ( := ) r newval = r.contents <- newval;;
+\end{caml_example}
+
+In some special cases, you may need to store a polymorphic function in
+a data structure, keeping its polymorphism.  Doing this requires
+user-provided type annotations, since polymorphism is only introduced
+automatically for global definitions.  However, you can explicitly give
+polymorphic types to record fields.
+\begin{caml_example}{toplevel}
+type idref = { mutable id: 'a. 'a -> 'a };;
+let r = {id = fun x -> x};;
+let g s = (s.id 1, s.id true);;
+r.id <- (fun x -> print_string "called id\n"; x);;
+g r;;
+\end{caml_example}
+
+\section{s:exceptions}{Exceptions}
+
+OCaml provides exceptions for signalling and handling exceptional
+conditions. Exceptions can also be used as a general-purpose non-local
+control structure, although this should not be overused since it can
+make the code harder to understand. Exceptions are declared with the
+"exception" construct, and signalled with the "raise" operator. For instance,
+the function below for taking the head of a list uses an exception to
+signal the case where an empty list is given.
+\begin{caml_example}{toplevel}
+exception Empty_list;;
+let head l =
+  match l with
+    [] -> raise Empty_list
+  | hd :: tl -> hd;;
+head [1;2];;
+head [];;
+\end{caml_example}
+
+Exceptions are used throughout the standard library to signal cases
+where the library functions cannot complete normally. For instance,
+the "List.assoc" function, which returns the data associated with a
+given key in a list of (key, data) pairs, raises the predefined
+exception "Not_found" when the key does not appear in the list:
+\begin{caml_example}{toplevel}
+List.assoc 1 [(0, "zero"); (1, "one")];;
+List.assoc 2 [(0, "zero"); (1, "one")];;
+\end{caml_example}
+
+Exceptions can be trapped with the "try"\ldots"with" construct:
+\begin{caml_example}{toplevel}
+let name_of_binary_digit digit =
+  try
+    List.assoc digit [0, "zero"; 1, "one"]
+  with Not_found ->
+    "not a binary digit";;
+name_of_binary_digit 0;;
+name_of_binary_digit (-1);;
+\end{caml_example}
+
+The "with" part does pattern matching on the
+exception value with the same syntax and behavior as "match". Thus,
+several exceptions can be caught by one
+"try"\ldots"with" construct:
+\begin{caml_example}{toplevel}
+let rec first_named_value values names =
+  try
+    List.assoc (head values) names
+  with
+  | Empty_list -> "no named value"
+  | Not_found -> first_named_value (List.tl values) names;;
+first_named_value [ 0; 10 ] [ 1, "one"; 10, "ten"];;
+\end{caml_example}
+
+Also, finalization can be performed by
+trapping all exceptions, performing the finalization, then re-raising
+the exception:
+\begin{caml_example}{toplevel}
+let temporarily_set_reference ref newval funct =
+  let oldval = !ref in
+  try
+    ref := newval;
+    let res = funct () in
+    ref := oldval;
+    res
+  with x ->
+    ref := oldval;
+    raise x;;
+\end{caml_example}
+
+An alternative to "try"\ldots"with" is to catch the exception while
+pattern matching:
+\begin{caml_example}{toplevel}
+let assoc_may_map f x l =
+  match List.assoc x l with
+  | exception Not_found -> None
+  | y -> f y;;
+\end{caml_example}
+Note that this construction is only useful if the exception is raised
+between "match"\ldots"with". Exception patterns can be combined
+with ordinary patterns at the toplevel,
+\begin{caml_example}{toplevel}
+let flat_assoc_opt x l =
+  match List.assoc x l with
+  | None | exception Not_found -> None
+  | Some _ as v -> v;;
+\end{caml_example}
+but they cannot be nested inside other patterns. For instance,
+the pattern "Some (exception A)" is invalid.
+
+When exceptions are used as a control structure, it can be useful to make
+them as local as possible by using a locally defined exception.
+For instance, with
+\begin{caml_eval}
+  let ref x: _ ref = {contents=x};;
+\end{caml_eval}
+\begin{caml_example}{toplevel}
+let fixpoint f x =
+  let exception Done in
+  let x = ref x in
+  try while true do
+      let y = f !x in
+      if !x = y then raise Done else x := y
+    done; assert false
+  with Done -> !x;;
+\end{caml_example}
+the function "f" cannot raise a "Done" exception, which removes an
+entire class of misbehaving functions.
+
+\section{s:lazy-expr}{Lazy expressions}
+
+OCaml allows us to defer some computation until later when we need the result of
+ that computation. 
+
+We use "lazy (expr)" to delay the evaluation of some expression "expr". For 
+example, we can defer the computation of "1+1" until we need the result of that
+expression, "2". Let us see how we initialize a lazy expression. 
+
+\begin{caml_example}{toplevel}
+  let lazy_two = lazy ( print_endline "lazy_two evaluation"; 1 + 1 );;
+\end{caml_example}
+
+We added "print_endline \"lazy_two evaluation\"" to see when the lazy
+ expression is being evaluated.
+
+The value of "lazy_two" is displayed as "", which means the expression 
+has not been evaluated yet, and its final value is unknown.
+
+Note that "lazy_two" has type "int lazy_t". However, the type "'a lazy_t" is an 
+internal type name, so the type "'a Lazy.t" should be preferred when possible.
+
+When we finally need the result of a lazy expression, we can call "Lazy.force"  
+on that expression to force its evaluation. The function "force" comes from 
+standard-library module \stdmoduleref{Lazy}.
+
+\begin{caml_example}{toplevel}
+  Lazy.force lazy_two;;
+\end{caml_example}
+
+Notice that our function call above prints ``lazy_two evaluation'' and then 
+returns the plain value of the computation. 
+
+Now if we look at the value of "lazy_two", we see that it is not displayed as 
+"" anymore but as "lazy 2".
+
+\begin{caml_example}{toplevel}
+  lazy_two;;
+\end{caml_example}
+
+This is because "Lazy.force" memoizes the result of the forced expression. In other 
+words, every subsequent call of "Lazy.force" on that expression returns the 
+result of the first computation without recomputing the lazy expression. Let us 
+force "lazy_two" once again. 
+
+\begin{caml_example}{toplevel}
+  Lazy.force lazy_two;;
+\end{caml_example}
+
+The expression is not evaluated this time; notice that ``lazy_two evaluation'' is
+not printed. The result of the initial computation is simply returned. 
+
+Lazy patterns provide another way to force a lazy expression. 
+
+\begin{caml_example}{toplevel}
+  let lazy_l = lazy ([1; 2] @ [3; 4]);;
+  let lazy l = lazy_l;;
+\end{caml_example}
+
+We can also use lazy patterns in pattern matching.
+
+\begin{caml_example}{toplevel}
+  let maybe_eval lazy_guard lazy_expr = 
+    match lazy_guard, lazy_expr with
+    | lazy false, _ -> "matches if (Lazy.force lazy_guard = false); lazy_expr not forced"
+    | lazy true, lazy _ -> "matches if (Lazy.force lazy_guard = true); lazy_expr forced";;
+\end{caml_example}
+
+The lazy expression "lazy_expr" is forced only if the "lazy_guard" value yields 
+"true" once computed. Indeed, a simple wildcard pattern (not lazy) never forces 
+the lazy expression's evaluation. However, a pattern with keyword "lazy", even 
+if it is wildcard, always forces the evaluation of the deferred computation.
+
+\section{s:symb-expr}{Symbolic processing of expressions}
+
+We finish this introduction with a more complete example
+representative of the use of OCaml for symbolic processing: formal
+manipulations of arithmetic expressions containing variables. The
+following variant type describes the expressions we shall manipulate:
+\begin{caml_example}{toplevel}
+type expression =
+    Const of float
+  | Var of string
+  | Sum of expression * expression    (* e1 + e2 *)
+  | Diff of expression * expression   (* e1 - e2 *)
+  | Prod of expression * expression   (* e1 * e2 *)
+  | Quot of expression * expression   (* e1 / e2 *)
+;;
+\end{caml_example}
+
+We first define a function to evaluate an expression given an
+environment that maps variable names to their values. For simplicity,
+the environment is represented as an association list.
+\begin{caml_example}{toplevel}
+exception Unbound_variable of string;;
+let rec eval env exp =
+  match exp with
+    Const c -> c
+  | Var v ->
+      (try List.assoc v env with Not_found -> raise (Unbound_variable v))
+  | Sum(f, g) -> eval env f +. eval env g
+  | Diff(f, g) -> eval env f -. eval env g
+  | Prod(f, g) -> eval env f *. eval env g
+  | Quot(f, g) -> eval env f /. eval env g;;
+eval [("x", 1.0); ("y", 3.14)] (Prod(Sum(Var "x", Const 2.0), Var "y"));;
+\end{caml_example}
+
+Now for a real symbolic processing, we define the derivative of an
+expression with respect to a variable "dv":
+\begin{caml_example}{toplevel}
+let rec deriv exp dv =
+  match exp with
+    Const c -> Const 0.0
+  | Var v -> if v = dv then Const 1.0 else Const 0.0
+  | Sum(f, g) -> Sum(deriv f dv, deriv g dv)
+  | Diff(f, g) -> Diff(deriv f dv, deriv g dv)
+  | Prod(f, g) -> Sum(Prod(f, deriv g dv), Prod(deriv f dv, g))
+  | Quot(f, g) -> Quot(Diff(Prod(deriv f dv, g), Prod(f, deriv g dv)),
+                       Prod(g, g))
+;;
+deriv (Quot(Const 1.0, Var "x")) "x";;
+\end{caml_example}
+
+\section{s:pretty-printing}{Pretty-printing}
+
+As shown in the examples above, the internal representation (also
+called {\em abstract syntax\/}) of expressions quickly becomes hard to
+read and write as the expressions get larger. We need a printer and a
+parser to go back and forth between the abstract syntax and the {\em
+concrete syntax}, which in the case of expressions is the familiar
+algebraic notation (e.g. "2*x+1").
+
+For the printing function, we take into account the usual precedence
+rules (i.e. "*" binds tighter than "+") to avoid printing unnecessary
+parentheses. To this end, we maintain the current operator precedence
+and print parentheses around an operator only if its precedence is
+less than the current precedence.
+\begin{caml_example}{toplevel}
+let print_expr exp =
+  (* Local function definitions *)
+  let open_paren prec op_prec =
+    if prec > op_prec then print_string "(" in
+  let close_paren prec op_prec =
+    if prec > op_prec then print_string ")" in
+  let rec print prec exp =     (* prec is the current precedence *)
+    match exp with
+      Const c -> print_float c
+    | Var v -> print_string v
+    | Sum(f, g) ->
+        open_paren prec 0;
+        print 0 f; print_string " + "; print 0 g;
+        close_paren prec 0
+    | Diff(f, g) ->
+        open_paren prec 0;
+        print 0 f; print_string " - "; print 1 g;
+        close_paren prec 0
+    | Prod(f, g) ->
+        open_paren prec 2;
+        print 2 f; print_string " * "; print 2 g;
+        close_paren prec 2
+    | Quot(f, g) ->
+        open_paren prec 2;
+        print 2 f; print_string " / "; print 3 g;
+        close_paren prec 2
+  in print 0 exp;;
+let e = Sum(Prod(Const 2.0, Var "x"), Const 1.0);;
+print_expr e; print_newline ();;
+print_expr (deriv e "x"); print_newline ();;
+\end{caml_example}
+
+\section{s:printf}{Printf formats}
+
+There is a "printf" function in the \stdmoduleref{Printf} module
+(see chapter~\ref{c:moduleexamples}) that allows you to make formatted
+output more concisely.
+It follows the behavior of the "printf" function from the C standard library.
+The "printf" function takes a format string that describes the desired output
+as a text interspered with specifiers (for instance "%d", "%f").
+Next, the specifiers are substituted by the following arguments in their order
+of apparition in the format string:
+\begin{caml_example}{toplevel}
+Printf.printf "%i + %i is an integer value, %F * %F is a float, %S\n"
+3 2 4.5 1. "this is a string";;
+\end{caml_example}
+The OCaml type system checks that the type of the arguments and the specifiers are
+compatible. If you pass it an argument of a type that does not correspond to
+the format specifier, the compiler will display an error message:
+\begin{caml_example}{toplevel}[error]
+Printf.printf "Float value: %F" 42;;
+\end{caml_example}
+The "fprintf" function is like "printf" except that it takes an output channel as
+the first argument. The "%a" specifier can be useful to define custom printer
+(for custom types). For instance, we can create a printing template that converts
+an integer argument to signed decimal:
+\begin{caml_example}{toplevel}
+let pp_int ppf n = Printf.fprintf ppf "%d" n;;
+Printf.printf "Outputting an integer using a custom printer: %a " pp_int 42;;
+\end{caml_example}
+The advantage of those printers based on the "%a" specifier is that they can be
+composed together to create more complex printers step by step.
+We can define a combinator that can turn a printer for "'a" type into a printer
+for "'a optional":
+\begin{caml_example}{toplevel}
+let pp_option printer ppf = function
+  | None -> Printf.fprintf ppf "None"
+  | Some v -> Printf.fprintf ppf "Some(%a)" printer v;;
+Printf.fprintf stdout
+  "The current setting is %a. \nThere is only %a\n"
+  (pp_option pp_int) (Some 3)
+  (pp_option pp_int) None
+;;
+\end{caml_example}
+If the value of its argument its "None", the printer returned by pp_option
+printer prints "None" otherwise it uses the provided printer to print "Some ".
+
+Here is how to rewrite the pretty-printer using "fprintf":
+\begin{caml_example}{toplevel}
+let pp_expr ppf expr =
+  let open_paren prec op_prec output =
+    if prec > op_prec then Printf.fprintf output "%s" "(" in
+  let close_paren prec op_prec output =
+    if prec > op_prec then Printf.fprintf output "%s" ")" in
+  let rec print prec ppf expr =
+      match expr with
+      | Const c -> Printf.fprintf ppf "%F" c
+      | Var v -> Printf.fprintf ppf "%s" v
+      | Sum(f, g) ->
+          open_paren prec 0 ppf;
+          Printf.fprintf ppf "%a + %a" (print 0) f (print 0) g;
+          close_paren prec 0 ppf
+      | Diff(f, g) ->
+          open_paren prec 0 ppf;
+          Printf.fprintf ppf "%a - %a" (print 0) f (print 1) g;
+          close_paren prec 0 ppf
+      | Prod(f, g) ->
+          open_paren prec 2 ppf;
+          Printf.fprintf ppf "%a * %a" (print 2) f (print 2) g;
+          close_paren prec 2 ppf
+      | Quot(f, g) ->
+          open_paren prec 2 ppf;
+          Printf.fprintf ppf "%a / %a" (print 2) f (print 3) g;
+          close_paren prec 2 ppf
+  in print 0 ppf expr;;
+pp_expr stdout e; print_newline ();;
+pp_expr stdout (deriv e "x"); print_newline ();;
+\end{caml_example}
+
+Due to the way that format string are build, storing a format string requires
+an explicit type annotation:
+\begin{caml_example*}{toplevel}
+let str : _ format =
+    "%i is an integer value, %F is a float, %S\n";;
+\end{caml_example*}
+\begin{caml_example}{toplevel}
+Printf.printf str 3 4.5 "string value";;
+\end{caml_example}
+
+%%%%%%%%%%% Should be moved to the camlp4 documentation.
+%% Parsing (transforming concrete syntax into abstract syntax) is usually
+%% more delicate. OCaml offers several tools to help write parsers:
+%% on the one hand, OCaml versions of the lexer generator Lex and the
+%% parser generator Yacc (see chapter~\ref{c:ocamlyacc}), which handle
+%% LALR(1) languages using push-down automata; on the other hand, a
+%% predefined type of streams (of characters or tokens) and
+%% pattern-matching over streams, which facilitate the writing of
+%% recursive-descent parsers for LL(1) languages. An example using
+%% "ocamllex" and "ocamlyacc" is given in
+%% chapter~\ref{c:ocamlyacc}. Here, we will use stream parsers.
+%% The syntactic support for stream parsers is provided by the Camlp4
+%% preprocessor, which can be loaded into the interactive toplevel via
+%% the "#load" directives below.
+%%
+%% \begin{caml_example}
+%% #load "dynlink.cma";;
+%% #load "camlp4o.cma";;
+%% open Genlex;;
+%% let lexer = make_lexer ["("; ")"; "+"; "-"; "*"; "/"];;
+%% \end{caml_example}
+%% For the lexical analysis phase (transformation of the input text into
+%% a stream of tokens), we use a ``generic'' lexer provided in the
+%% standard library module "Genlex". The "make_lexer" function takes a
+%% list of keywords and returns a lexing function that ``tokenizes'' an
+%% input stream of characters. Tokens are either identifiers, keywords,
+%% or literals (integer, floats, characters, strings). Whitespace and
+%% comments are skipped.
+%% \begin{caml_example}
+%% let token_stream = lexer (Stream.of_string "1.0 +x");;
+%% Stream.next token_stream;;
+%% Stream.next token_stream;;
+%% Stream.next token_stream;;
+%% \end{caml_example}
+%%
+%% The parser itself operates by pattern-matching on the stream of
+%% tokens. As usual with recursive descent parsers, we use several
+%% intermediate parsing functions to reflect the precedence and
+%% associativity of operators. Pattern-matching over streams is more
+%% powerful than on regular data structures, as it allows recursive calls
+%% to parsing functions inside the patterns, for matching sub-components of
+%% the input stream. See the Camlp4 documentation for more details.
+%%
+%% %Already said above
+%% %In order to use stream parsers at toplevel, we must first load the
+%% %"camlp4" preprocessor.
+%% %\begin{caml_example}
+%% %#load"camlp4o.cma";;
+%% %\end{caml_example}
+%% %Then we are ready to define our parser.
+%% \begin{caml_example}{toplevel}
+%% let rec parse_expr = parser
+%%     [< e1 = parse_mult; e = parse_more_adds e1 >] -> e
+%% and parse_more_adds e1 = parser
+%%     [< 'Kwd "+"; e2 = parse_mult; e = parse_more_adds (Sum(e1, e2)) >] -> e
+%%   | [< 'Kwd "-"; e2 = parse_mult; e = parse_more_adds (Diff(e1, e2)) >] -> e
+%%   | [< >] -> e1
+%% and parse_mult = parser
+%%     [< e1 = parse_simple; e = parse_more_mults e1 >] -> e
+%% and parse_more_mults e1 = parser
+%%     [< 'Kwd "*"; e2 = parse_simple; e = parse_more_mults (Prod(e1, e2)) >] -> e
+%%   | [< 'Kwd "/"; e2 = parse_simple; e = parse_more_mults (Quot(e1, e2)) >] -> e
+%%   | [< >] -> e1
+%% and parse_simple = parser
+%%     [< 'Ident s >] -> Var s
+%%   | [< 'Int i >] -> Const(float i)
+%%   | [< 'Float f >] -> Const f
+%%   | [< 'Kwd "("; e = parse_expr; 'Kwd ")" >] -> e;;
+%% let parse_expression = parser [< e = parse_expr; _ = Stream.empty >] -> e;;
+%% \end{caml_example}
+%%
+%% Composing the lexer and parser, we finally obtain a function to read
+%% an expression from a character string:
+%% \begin{caml_example}
+%% let read_expression s = parse_expression (lexer (Stream.of_string s));;
+%% read_expression "2*(x+y)";;
+%% \end{caml_example}
+%% A small puzzle: why do we get different results in the following two
+%% examples?
+%% \begin{caml_example}
+%% read_expression "x - 1";;
+%% read_expression "x-1";;
+%% \end{caml_example}
+%% Answer: the generic lexer provided by "Genlex" recognizes negative
+%% integer literals as one integer token.  Hence, "x-1" is read as
+%% the token "Ident \"x\"" followed by the token "Int(-1)"; this sequence
+%% does not match any of the parser rules.  On the other hand,
+%% the second space in "x - 1" causes the lexer to return the three
+%% expected tokens: "Ident \"x\"", then "Kwd \"-\"", then "Int(1)".
+
+\section{s:standalone-programs}{Standalone OCaml programs}
+
+All examples given so far were executed under the interactive system.
+OCaml code can also be compiled separately and executed
+non-interactively using the batch compilers "ocamlc" and "ocamlopt".
+The source code must be put in a file with extension ".ml". It
+consists of a sequence of phrases, which will be evaluated at runtime
+in their order of appearance in the source file. Unlike in interactive
+mode, types and values are not printed automatically; the program must
+call printing functions explicitly to produce some output.  The ";;" used
+in the interactive examples is not required in
+source files created for use with OCaml compilers, but can be helpful
+to mark the end of a top-level expression unambiguously even when
+there are syntax errors.
+Here is a
+sample standalone program to print the greatest common divisor
+(gcd) of two numbers:
+\begin{verbatim}
+(* File gcd.ml *)
+let rec gcd a b =
+  if b = 0 then a
+  else gcd b (a mod b);;
+
+let main () =
+  let a = int_of_string Sys.argv.(1) in
+  let b = int_of_string Sys.argv.(2) in
+  Printf.printf "%d\n" (gcd a b);
+  exit 0;;
+main ();;
+\end{verbatim}
+"Sys.argv" is an array of strings containing the command-line
+parameters. "Sys.argv.(1)" is thus the first command-line parameter.
+The program above is compiled and executed with the following shell
+commands:
+\begin{verbatim}
+$ ocamlc -o gcd gcd.ml
+$ ./gcd 6 9
+3
+$ ./fib 7 11
+1
+\end{verbatim}
+
+More complex standalone OCaml programs are typically composed of
+multiple source files, and can link with precompiled libraries.
+Chapters~\ref{c:camlc} and~\ref{c:nativecomp} explain how to use the
+batch compilers "ocamlc" and "ocamlopt".  Recompilation of
+multi-file OCaml projects can be automated using third-party
+build systems, such as the
+\href{https://github.com/ocaml/ocamlbuild/}{ocamlbuild}
+compilation manager.
diff --git a/manual/manual/tutorials/lablexamples.etex b/manual/manual/tutorials/lablexamples.etex
new file mode 100644
index 00000000..773f0ecf
--- /dev/null
+++ b/manual/manual/tutorials/lablexamples.etex
@@ -0,0 +1,488 @@
+\chapter{Labels and variants} \label{c:labl-examples}
+%HEVEA\cutname{lablexamples.html}
+{\it (Chapter written by Jacques Garrigue)}
+
+\bigskip
+
+\noindent This chapter gives an overview of the new features in
+OCaml 3: labels, and polymorphic variants.
+
+\section{s:labels}{Labels}
+
+If you have a look at modules ending in "Labels" in the standard
+library, you will see that function types have annotations you did not
+have in the functions you defined yourself.
+
+\begin{caml_example}{toplevel}
+ListLabels.map;;
+StringLabels.sub;;
+\end{caml_example}
+
+Such annotations of the form "name:" are called {\em labels}. They are
+meant to document the code, allow more checking, and give more
+flexibility to function application.
+You can give such names to arguments in your programs, by prefixing them
+with a tilde "~".
+
+\begin{caml_example}{toplevel}
+let f ~x ~y = x - y;;
+let x = 3 and y = 2 in f ~x ~y;;
+\end{caml_example}
+
+When you want to use distinct names for the variable and the label
+appearing in the type, you can use a naming label of the form
+"~name:". This also applies when the argument is not a variable.
+
+\begin{caml_example}{toplevel}
+let f ~x:x1 ~y:y1 = x1 - y1;;
+f ~x:3 ~y:2;;
+\end{caml_example}
+
+Labels obey the same rules as other identifiers in OCaml, that is you
+cannot use a reserved keyword (like "in" or "to") as label.
+
+Formal parameters and arguments are matched according to their
+respective labels\footnote{This correspond to the commuting label mode
+of Objective Caml 3.00 through 3.02, with some additional flexibility
+on total applications. The so-called classic mode ("-nolabels"
+options) is now deprecated for normal use.}, the absence of label
+being interpreted as the empty label.
+%
+This allows commuting arguments in applications. One can also
+partially apply a function on any argument, creating a new function of
+the remaining parameters.
+
+\begin{caml_example}{toplevel}
+let f ~x ~y = x - y;;
+f ~y:2 ~x:3;;
+ListLabels.fold_left;;
+ListLabels.fold_left [1;2;3] ~init:0 ~f:( + );;
+ListLabels.fold_left ~init:0;;
+\end{caml_example}
+
+If several arguments of a function bear the same label (or no label),
+they will not commute among themselves, and order matters. But they
+can still commute with other arguments.
+
+\begin{caml_example}{toplevel}
+let hline ~x:x1 ~x:x2 ~y = (x1, x2, y);;
+hline ~x:3 ~y:2 ~x:5;;
+\end{caml_example}
+
+As an exception to the above parameter matching rules, if an
+application is total (omitting all optional arguments), labels may be
+omitted.
+In practice, many applications are total, so that labels can often be
+omitted.
+\begin{caml_example}{toplevel}
+f 3 2;;
+ListLabels.map succ [1;2;3];;
+\end{caml_example}
+But beware that functions like "ListLabels.fold_left" whose result
+type is a type variable will never be considered as totally applied.
+\begin{caml_example}{toplevel}[error]
+ListLabels.fold_left ( + ) 0 [1;2;3];;
+\end{caml_example}
+
+When a function is passed as an argument to a higher-order function,
+labels must match in both types. Neither adding nor removing labels
+are allowed.
+\begin{caml_example}{toplevel}
+let h g = g ~x:3 ~y:2;;
+h f;;
+h ( + ) [@@expect error];;
+\end{caml_example}
+Note that when you don't need an argument, you can still use a wildcard
+pattern, but you must prefix it with the label.
+\begin{caml_example}{toplevel}
+h (fun ~x:_ ~y -> y+1);;
+\end{caml_example}
+
+\subsection{ss:optional-arguments}{Optional arguments}
+
+An interesting feature of labeled arguments is that they can be made
+optional. For optional parameters, the question mark "?" replaces the
+tilde "~" of non-optional ones, and the label is also prefixed by "?"
+in the function type.
+Default values may be given for such optional parameters.
+
+\begin{caml_example}{toplevel}
+let bump ?(step = 1) x = x + step;;
+bump 2;;
+bump ~step:3 2;;
+\end{caml_example}
+
+A function taking some optional arguments must also take at least one
+non-optional argument. The criterion for deciding whether an optional
+argument has been omitted is the non-labeled application of an
+argument appearing after this optional argument in the function type.
+Note that if that argument is labeled, you will only be able to
+eliminate optional arguments by totally applying the function,
+omitting all optional arguments and omitting all labels for all
+remaining arguments.
+
+\begin{caml_example}{toplevel}
+let test ?(x = 0) ?(y = 0) () ?(z = 0) () = (x, y, z);;
+test ();;
+test ~x:2 () ~z:3 ();;
+\end{caml_example}
+
+Optional parameters may also commute with non-optional or unlabeled
+ones, as long as they are applied simultaneously. By nature, optional
+arguments do not commute with unlabeled arguments applied
+independently.
+\begin{caml_example}{toplevel}
+test ~y:2 ~x:3 () ();;
+test () () ~z:1 ~y:2 ~x:3;;
+(test () ()) ~z:1 [@@expect error];;
+\end{caml_example}
+Here "(test () ())" is already "(0,0,0)" and cannot be further
+applied.
+
+Optional arguments are actually implemented as option types. If
+you do not give a default value, you have access to their internal
+representation, "type 'a option = None | Some of 'a". You can then
+provide different behaviors when an argument is present or not.
+
+\begin{caml_example}{toplevel}
+let bump ?step x =
+  match step with
+  | None -> x * 2
+  | Some y -> x + y
+;;
+\end{caml_example}
+
+It may also be useful to relay an optional argument from a function
+call to another. This can be done by prefixing the applied argument
+with "?". This question mark disables the wrapping of optional
+argument in an option type.
+
+\begin{caml_example}{toplevel}
+let test2 ?x ?y () = test ?x ?y () ();;
+test2 ?x:None;;
+\end{caml_example}
+
+\subsection{ss:label-inference}{Labels and type inference}
+
+While they provide an increased comfort for writing function
+applications, labels and optional arguments have the pitfall that they
+cannot be inferred as completely as the rest of the language.
+
+You can see it in the following two examples.
+\begin{caml_example}{toplevel}
+let h' g = g ~y:2 ~x:3;;
+h' f [@@expect error];;
+let bump_it bump x =
+  bump ~step:2 x;;
+bump_it bump 1 [@@expect error];;
+\end{caml_example}
+The first case is simple: "g"  is passed "~y" and then "~x", but "f"
+expects "~x" and then "~y". This is correctly handled if we know the
+type of "g" to be "x:int -> y:int -> int" in advance, but otherwise
+this causes the above type clash. The simplest workaround is to apply
+formal parameters in a standard order.
+
+The second example is more subtle: while we intended the argument
+"bump" to be of type "?step:int -> int -> int", it is inferred as
+"step:int -> int -> 'a".
+%
+These two types being incompatible (internally normal and optional
+arguments are different), a type error occurs when applying "bump_it"
+to the real "bump".
+
+We will not try here to explain in detail how type inference works.
+One must just understand that there is not enough information in the
+above program to deduce the correct type of "g" or "bump". That is,
+there is no way to know whether an argument is optional or not, or
+which is the correct order, by looking only at how a function is
+applied. The strategy used by the compiler is to assume that there are
+no optional arguments, and that applications are done in the right
+order.
+
+The right way to solve this problem for optional parameters is to add
+a type annotation to the argument "bump".
+\begin{caml_example}{toplevel}
+let bump_it (bump : ?step:int -> int -> int) x =
+  bump ~step:2 x;;
+bump_it bump 1;;
+\end{caml_example}
+In practice, such problems appear mostly when using objects whose
+methods have optional arguments, so that writing the type of object
+arguments is often a good idea.
+
+Normally the compiler generates a type error if you attempt to pass to
+a function a parameter whose type is different from the expected one.
+However, in the specific case where the expected type is a non-labeled
+function type, and the argument is a function expecting optional
+parameters, the compiler will attempt to transform the argument to
+have it match the expected type, by passing "None" for all optional
+parameters.
+
+\begin{caml_example}{toplevel}
+let twice f (x : int) = f(f x);;
+twice bump 2;;
+\end{caml_example}
+
+This transformation is coherent with the intended semantics,
+including side-effects. That is, if the application of optional
+parameters shall produce side-effects, these are delayed until the
+received function is really applied to an argument.
+
+\subsection{ss:label-suggestions}{Suggestions for labeling}
+
+Like for names, choosing labels for functions is not an easy task. A
+good labeling is a labeling which
+
+\begin{itemize}
+\item makes programs more readable,
+\item is easy to remember,
+\item when possible, allows useful partial applications.
+\end{itemize}
+
+We explain here the rules we applied when labeling OCaml
+libraries.
+
+To speak in an ``object-oriented'' way, one can consider that each
+function has a main argument, its {\em object}, and other arguments
+related with its action, the {\em parameters}. To permit the
+combination of functions through functionals in commuting label mode, the
+object will not be labeled. Its role is clear from the function
+itself. The parameters are labeled with names reminding of
+their nature or their role. The best labels combine nature and
+role. When this is not possible the role is to be preferred, since the
+nature will
+often be given by the type itself. Obscure abbreviations should be
+avoided.
+\begin{alltt}
+"ListLabels.map : f:('a -> 'b) -> 'a list -> 'b list"
+UnixLabels.write : file_descr -> buf:bytes -> pos:int -> len:int -> unit
+\end{alltt}
+
+When there are several objects of same nature and role, they are all
+left unlabeled.
+\begin{alltt}
+"ListLabels.iter2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> unit"
+\end{alltt}
+
+When there is no preferable object, all arguments are labeled.
+\begin{alltt}
+BytesLabels.blit :
+  src:bytes -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int -> unit
+\end{alltt}
+
+However, when there is only one argument, it is often left unlabeled.
+\begin{alltt}
+BytesLabels.create : int -> bytes
+\end{alltt}
+This principle also applies to functions of several arguments whose
+return type is a type variable, as long as the role of each argument
+is not ambiguous. Labeling such functions may lead to awkward error
+messages when one attempts to omit labels in an application, as we
+have seen with "ListLabels.fold_left".
+
+Here are some of the label names you will find throughout the
+libraries.
+
+\begin{tableau}{|l|l|}{Label}{Meaning}
+\entree{"f:"}{a function to be applied}
+\entree{"pos:"}{a position in a string, array or byte sequence}
+\entree{"len:"}{a length}
+\entree{"buf:"}{a byte sequence or string used as buffer}
+\entree{"src:"}{the source of an operation}
+\entree{"dst:"}{the destination of an operation}
+\entree{"init:"}{the initial value for an iterator}
+\entree{"cmp:"}{a comparison function, {\it e.g.} "Stdlib.compare"}
+\entree{"mode:"}{an operation mode or a flag list}
+\end{tableau}
+
+All these are only suggestions, but keep in mind that the
+choice of labels is essential for readability. Bizarre choices will
+make the program harder to maintain.
+
+In the ideal, the right function name with right labels should be
+enough to understand the function's meaning. Since one can get this
+information with OCamlBrowser or the "ocaml" toplevel, the documentation
+is only used when a more detailed specification is needed.
+
+\begin{caml_eval}
+#label false;;
+\end{caml_eval}
+
+
+\section{s:polymorphic-variants}{Polymorphic variants}
+
+Variants as presented in section~\ref{s:tut-recvariants} are a
+powerful tool to build data structures and algorithms. However they
+sometimes lack flexibility when used in modular programming. This is
+due to the fact that every constructor is assigned to a unique type
+when defined and used. Even if the same name appears in the definition
+of multiple types, the constructor itself belongs to only one type.
+Therefore, one cannot decide that a given constructor belongs to
+multiple types, or consider a value of some type to belong to some
+other type with more constructors.
+
+With polymorphic variants, this original assumption is removed. That
+is, a variant tag does not belong to any type in particular, the type
+system will just check that it is an admissible value according to its
+use. You need not define a type before using a variant tag. A variant
+type will be inferred independently for each of its uses.
+
+\subsection*{ss:polyvariant:basic-use}{Basic use}
+
+In programs, polymorphic variants work like usual ones. You just have
+to prefix their names with a backquote character "`".
+\begin{caml_example}{toplevel}
+[`On; `Off];;
+`Number 1;;
+let f = function `On -> 1 | `Off -> 0 | `Number n -> n;;
+List.map f [`On; `Off];;
+\end{caml_example}
+"[>`Off|`On] list" means that to match this list, you should at
+least be able to match "`Off" and "`On", without argument.
+"[<`On|`Off|`Number of int]" means that "f" may be applied to "`Off",
+"`On" (both without argument), or "`Number" $n$ where
+$n$ is an integer.
+The ">" and "<" inside the variant types show that they may still be
+refined, either by defining more tags or by allowing less. As such, they
+contain an implicit type variable. Because each of the variant types
+appears only once in the whole type, their implicit type variables are
+not shown.
+
+The above variant types were polymorphic, allowing further refinement.
+When writing type annotations, one will most often describe fixed
+variant types, that is types that cannot be refined. This is
+also the case for type abbreviations. Such types do not contain "<" or
+">", but just an enumeration of the tags and their associated types,
+just like in a normal datatype definition.
+\begin{caml_example}{toplevel}
+type 'a vlist = [`Nil | `Cons of 'a * 'a vlist];;
+let rec map f : 'a vlist -> 'b vlist = function
+  | `Nil -> `Nil
+  | `Cons(a, l) -> `Cons(f a, map f l)
+;;
+\end{caml_example}
+
+\subsection*{ss:polyvariant-advanced}{Advanced use}
+
+Type-checking polymorphic variants is a subtle thing, and some
+expressions may result in more complex type information.
+
+\begin{caml_example}{toplevel}
+let f = function `A -> `C | `B -> `D | x -> x;;
+f `E;;
+\end{caml_example}
+Here we are seeing two phenomena. First, since this matching is open
+(the last case catches any tag), we obtain the type "[> `A | `B]"
+rather than "[< `A | `B]" in a closed matching. Then, since "x" is
+returned as is, input and return types are identical. The notation "as
+'a" denotes such type sharing. If we apply "f" to yet another tag
+"`E", it gets added to the list.
+
+\begin{caml_example}{toplevel}
+let f1 = function `A x -> x = 1 | `B -> true | `C -> false
+let f2 = function `A x -> x = "a" | `B -> true ;;
+let f x = f1 x && f2 x;;
+\end{caml_example}
+Here "f1" and "f2" both accept the variant tags "`A" and "`B", but the
+argument of "`A" is "int" for "f1" and "string" for "f2". In "f"'s
+type "`C", only accepted by "f1", disappears, but both argument types
+appear for "`A" as "int & string". This means that if we
+pass the variant tag "`A" to "f", its argument should be {\em both}
+"int" and "string". Since there is no such value, "f" cannot be
+applied to "`A", and "`B" is the only accepted input.
+
+Even if a value has a fixed variant type, one can still give it a
+larger type through coercions. Coercions are normally written with
+both the source type and the destination type, but in simple cases the
+source type may be omitted.
+\begin{caml_example}{toplevel}
+type 'a wlist = [`Nil | `Cons of 'a * 'a wlist | `Snoc of 'a wlist * 'a];;
+let wlist_of_vlist  l = (l : 'a vlist :> 'a wlist);;
+let open_vlist l = (l : 'a vlist :> [> 'a vlist]);;
+fun x -> (x :> [`A|`B|`C]);;
+\end{caml_example}
+
+You may also selectively coerce values through pattern matching.
+\begin{caml_example}{toplevel}
+let split_cases = function
+  | `Nil | `Cons _ as x -> `A x
+  | `Snoc _ as x -> `B x
+;;
+\end{caml_example}
+When an or-pattern composed of variant tags is wrapped inside an
+alias-pattern, the alias is given a type containing only the tags
+enumerated in the or-pattern. This allows for many useful idioms, like
+incremental definition of functions.
+
+\begin{caml_example}{toplevel}
+let num x = `Num x
+let eval1 eval (`Num x) = x
+let rec eval x = eval1 eval x ;;
+let plus x y = `Plus(x,y)
+let eval2 eval = function
+  | `Plus(x,y) -> eval x + eval y
+  | `Num _ as x -> eval1 eval x
+let rec eval x = eval2 eval x ;;
+\end{caml_example}
+
+To make this even more comfortable, you may use type definitions as
+abbreviations for or-patterns. That is, if you have defined "type
+myvariant = [`Tag1 of int | `Tag2 of bool]", then the pattern "#myvariant" is
+equivalent to writing "(`Tag1(_ : int) | `Tag2(_ : bool))".
+\begin{caml_eval}
+type myvariant = [`Tag1 of int | `Tag2 of bool];;
+\end{caml_eval}
+
+Such abbreviations may be used alone,
+\begin{caml_example}{toplevel}
+let f = function
+  | #myvariant -> "myvariant"
+  | `Tag3 -> "Tag3";;
+\end{caml_example}
+or combined with with aliases.
+\begin{caml_example}{toplevel}
+let g1 = function `Tag1 _ -> "Tag1" | `Tag2 _ -> "Tag2";;
+let g = function
+  | #myvariant as x -> g1 x
+  | `Tag3 -> "Tag3";;
+\end{caml_example}
+
+\subsection{ss:polyvariant-weaknesses}{Weaknesses of polymorphic variants}
+
+After seeing the power of polymorphic variants, one may wonder why
+they were added to core language variants, rather than replacing them.
+
+The answer is twofold. One first aspect is that while being pretty
+efficient, the lack of static type information allows for less
+optimizations, and makes polymorphic variants slightly heavier than
+core language ones. However noticeable differences would only
+appear on huge data structures.
+
+More important is the fact that polymorphic variants, while being
+type-safe, result in a weaker type discipline. That is, core language
+variants do actually much more than ensuring type-safety, they also
+check that you use only declared constructors, that all constructors
+present in a data-structure are compatible, and they enforce typing
+constraints to their parameters.
+
+For this reason, you must be more careful about making types explicit
+when you use polymorphic variants. When you write a library, this is
+easy since you can describe exact types in interfaces, but for simple
+programs you are probably better off with core language variants.
+
+Beware also that some idioms make trivial errors very hard to find.
+For instance, the following code is probably wrong but the compiler
+has no way to see it.
+\begin{caml_example}{toplevel}
+type abc = [`A | `B | `C] ;;
+let f = function
+  | `As -> "A"
+  | #abc -> "other" ;;
+let f : abc -> string = f ;;
+\end{caml_example}
+You can avoid such risks by annotating the definition itself.
+\begin{caml_example}{toplevel}[error]
+let f : abc -> string = function
+  | `As -> "A"
+  | #abc -> "other" ;;
+\end{caml_example}
diff --git a/manual/manual/tutorials/moduleexamples.etex b/manual/manual/tutorials/moduleexamples.etex
new file mode 100644
index 00000000..8b0a4753
--- /dev/null
+++ b/manual/manual/tutorials/moduleexamples.etex
@@ -0,0 +1,385 @@
+\chapter{The module system} \label{c:moduleexamples}
+%HEVEA\cutname{moduleexamples.html}
+
+This chapter introduces the module system of OCaml.
+
+\section{s:module:structures}{Structures}
+
+A primary motivation for modules is to package together related
+definitions (such as the definitions of a data type and associated
+operations over that type) and enforce a consistent naming scheme for
+these definitions. This avoids running out of names or accidentally
+confusing names. Such a package is called a {\em structure} and
+is introduced by the "struct"\ldots"end" construct, which contains an
+arbitrary sequence of definitions. The structure is usually given a
+name with the "module" binding. Here is for instance a structure
+packaging together a type of priority queues and their operations:
+\begin{caml_example}{toplevel}
+module PrioQueue =
+  struct
+    type priority = int
+    type 'a queue = Empty | Node of priority * 'a * 'a queue * 'a queue
+    let empty = Empty
+    let rec insert queue prio elt =
+      match queue with
+        Empty -> Node(prio, elt, Empty, Empty)
+      | Node(p, e, left, right) ->
+          if prio <= p
+          then Node(prio, elt, insert right p e, left)
+          else Node(p, e, insert right prio elt, left)
+    exception Queue_is_empty
+    let rec remove_top = function
+        Empty -> raise Queue_is_empty
+      | Node(prio, elt, left, Empty) -> left
+      | Node(prio, elt, Empty, right) -> right
+      | Node(prio, elt, (Node(lprio, lelt, _, _) as left),
+                        (Node(rprio, relt, _, _) as right)) ->
+          if lprio <= rprio
+          then Node(lprio, lelt, remove_top left, right)
+          else Node(rprio, relt, left, remove_top right)
+    let extract = function
+        Empty -> raise Queue_is_empty
+      | Node(prio, elt, _, _) as queue -> (prio, elt, remove_top queue)
+  end;;
+\end{caml_example}
+Outside the structure, its components can be referred to using the
+``dot notation'', that is, identifiers qualified by a structure name.
+For instance, "PrioQueue.insert" is the function "insert" defined
+inside the structure "PrioQueue" and "PrioQueue.queue" is the type
+"queue" defined in "PrioQueue".
+\begin{caml_example}{toplevel}
+PrioQueue.insert PrioQueue.empty 1 "hello";;
+\end{caml_example}
+
+Another possibility is to open the module, which brings all
+identifiers defined inside the module in the scope of the current
+structure.
+
+\begin{caml_example}{toplevel}
+  open PrioQueue;;
+  insert empty 1 "hello";;
+\end{caml_example}
+
+Opening a module enables lighter access to its components, at the
+cost of making it harder to identify in which module a identifier
+has been defined. In particular, opened modules can shadow
+identifiers present in the current scope, potentially leading
+to confusing errors:
+
+\begin{caml_example}{toplevel}
+  let empty = []
+  open PrioQueue;;
+  let x = 1 :: empty [@@expect error];;
+\end{caml_example}
+
+
+A partial solution to this conundrum is to open modules locally,
+making the components of the module available only in the
+concerned expression. This can also make the code easier to read
+-- the open statement is closer to where it is used-- and to refactor
+-- the code fragment is more self-contained.
+Two constructions are available for this purpose:
+\begin{caml_example}{toplevel}
+  let open PrioQueue in
+  insert empty 1 "hello";;
+\end{caml_example}
+and
+\begin{caml_example}{toplevel}
+  PrioQueue.(insert empty 1 "hello");;
+\end{caml_example}
+In the second form, when the body of a local open is itself delimited
+by parentheses, braces or bracket, the parentheses of the local open
+can be omitted. For instance,
+\begin{caml_example}{toplevel}
+  PrioQueue.[empty] = PrioQueue.([empty]);;
+  PrioQueue.[|empty|] = PrioQueue.([|empty|]);;
+   PrioQueue.{ contents = empty } = PrioQueue.({ contents = empty });;
+\end{caml_example}
+becomes
+\begin{caml_example}{toplevel}
+  PrioQueue.[insert empty 1 "hello"];;
+\end{caml_example}
+This second form also works for patterns:
+\begin{caml_example}{toplevel}
+  let at_most_one_element x = match x with
+  | PrioQueue.( Empty| Node (_,_, Empty,Empty) ) -> true
+  | _ -> false ;;
+\end{caml_example}
+
+It is also possible to copy the components of a module inside
+another module by using an "include" statement. This can be
+particularly useful to extend existing modules. As an illustration,
+we could add functions that returns an optional value rather than
+an exception when the priority queue is empty.
+\begin{caml_example}{toplevel}
+  module PrioQueueOpt =
+  struct
+    include PrioQueue
+
+    let remove_top_opt x =
+      try Some(remove_top x) with Queue_is_empty -> None
+
+    let extract_opt x =
+      try Some(extract x) with Queue_is_empty -> None
+  end;;
+\end{caml_example}
+
+\section{s:signature}{Signatures}
+
+Signatures are interfaces for structures. A signature specifies
+which components of a structure are accessible from the outside, and
+with which type. It can be used to hide some components of a structure
+(e.g. local function definitions) or export some components with a
+restricted type. For instance, the signature below specifies the three
+priority queue operations "empty", "insert" and "extract", but not the
+auxiliary function "remove_top". Similarly, it makes the "queue" type
+abstract (by not providing its actual representation as a concrete type).
+\begin{caml_example}{toplevel}
+module type PRIOQUEUE =
+  sig
+    type priority = int         (* still concrete *)
+    type 'a queue               (* now abstract *)
+    val empty : 'a queue
+    val insert : 'a queue -> int -> 'a -> 'a queue
+    val extract : 'a queue -> int * 'a * 'a queue
+    exception Queue_is_empty
+  end;;
+\end{caml_example}
+Restricting the "PrioQueue" structure by this signature results in
+another view of the "PrioQueue" structure where the "remove_top"
+function is not accessible and the actual representation of priority
+queues is hidden:
+\begin{caml_example}{toplevel}
+module AbstractPrioQueue = (PrioQueue : PRIOQUEUE);;
+AbstractPrioQueue.remove_top [@@expect error];;
+AbstractPrioQueue.insert AbstractPrioQueue.empty 1 "hello";;
+\end{caml_example}
+The restriction can also be performed during the definition of the
+structure, as in
+\begin{verbatim}
+module PrioQueue = (struct ... end : PRIOQUEUE);;
+\end{verbatim}
+An alternate syntax is provided for the above:
+\begin{verbatim}
+module PrioQueue : PRIOQUEUE = struct ... end;;
+\end{verbatim}
+
+Like for modules, it is possible to include a signature to copy
+its components inside the current signature. For instance, we
+can extend the PRIOQUEUE signature with the "extract_opt"
+function:
+
+\begin{caml_example}{toplevel}
+module type PRIOQUEUE_WITH_OPT =
+  sig
+    include PRIOQUEUE
+    val extract_opt : 'a queue -> (int * 'a * 'a queue) option
+  end;;
+\end{caml_example}
+
+
+\section{s:functors}{Functors}
+
+Functors are ``functions'' from modules to modules. Functors let you create
+parameterized modules and then provide other modules as parameter(s) to get
+a specific implementation.  For instance, a "Set" module implementing sets
+as sorted lists could be parameterized to work with any module that provides
+an element type and a comparison function "compare" (such as "OrderedString"):
+
+\begin{caml_example}{toplevel}
+type comparison = Less | Equal | Greater;;
+module type ORDERED_TYPE =
+  sig
+    type t
+    val compare: t -> t -> comparison
+  end;;
+module Set =
+  functor (Elt: ORDERED_TYPE) ->
+    struct
+      type element = Elt.t
+      type set = element list
+      let empty = []
+      let rec add x s =
+        match s with
+          [] -> [x]
+        | hd::tl ->
+           match Elt.compare x hd with
+             Equal   -> s         (* x is already in s *)
+           | Less    -> x :: s    (* x is smaller than all elements of s *)
+           | Greater -> hd :: add x tl
+      let rec member x s =
+        match s with
+          [] -> false
+        | hd::tl ->
+            match Elt.compare x hd with
+              Equal   -> true     (* x belongs to s *)
+            | Less    -> false    (* x is smaller than all elements of s *)
+            | Greater -> member x tl
+    end;;
+\end{caml_example}
+By applying the "Set" functor to a structure implementing an ordered
+type, we obtain set operations for this type:
+\begin{caml_example}{toplevel}
+module OrderedString =
+  struct
+    type t = string
+    let compare x y = if x = y then Equal else if x < y then Less else Greater
+  end;;
+module StringSet = Set(OrderedString);;
+StringSet.member "bar" (StringSet.add "foo" StringSet.empty);;
+\end{caml_example}
+
+\section{s:functors-and-abstraction}{Functors and type abstraction}
+
+As in the "PrioQueue" example, it would be good style to hide the
+actual implementation of the type "set", so that users of the
+structure will not rely on sets being lists, and we can switch later
+to another, more efficient representation of sets without breaking
+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) ->
+    sig
+      type element = Elt.t      (* concrete *)
+      type set                  (* abstract *)
+      val empty : set
+      val add : element -> set -> set
+      val member : element -> set -> bool
+    end;;
+module AbstractSet = (Set : SETFUNCTOR);;
+module AbstractStringSet = AbstractSet(OrderedString);;
+AbstractStringSet.add "gee" AbstractStringSet.empty;;
+\end{caml_example}
+
+In an attempt to write the type constraint above more elegantly,
+one may wish to name the signature of the structure
+returned by the functor, then use that signature in the constraint:
+\begin{caml_example}{toplevel}
+module type SET =
+  sig
+    type element
+    type set
+    val empty : set
+    val add : element -> set -> set
+    val member : element -> set -> bool
+  end;;
+module WrongSet = (Set : functor(Elt: ORDERED_TYPE) -> SET);;
+module WrongStringSet = WrongSet(OrderedString);;
+WrongStringSet.add "gee" WrongStringSet.empty [@@expect error];;
+\end{caml_example}
+The problem here is that "SET" specifies the type "element"
+abstractly, so that the type equality between "element" in the result
+of the functor and "t" in its argument is forgotten. Consequently,
+"WrongStringSet.element" is not the same type as "string", and the
+operations of "WrongStringSet" cannot be applied to strings.
+As demonstrated above, it is important that the type "element" in the
+signature "SET" be declared equal to "Elt.t"; unfortunately, this is
+impossible above since "SET" is defined in a context where "Elt" does
+not exist. To overcome this difficulty, OCaml provides a
+"with type" construct over signatures that allows enriching a signature
+with extra type equalities:
+\begin{caml_example}{toplevel}
+module AbstractSet2 =
+  (Set : functor(Elt: ORDERED_TYPE) -> (SET with type element = Elt.t));;
+\end{caml_example}
+
+As in the case of simple structures, an alternate syntax is provided
+for defining functors and restricting their result:
+\begin{verbatim}
+module AbstractSet2(Elt: ORDERED_TYPE) : (SET with type element = Elt.t) =
+  struct ... end;;
+\end{verbatim}
+
+Abstracting a type component in a functor result is a powerful
+technique that provides a high degree of type safety, as we now
+illustrate. Consider an ordering over character strings that is
+different from the standard ordering implemented in the
+"OrderedString" structure. For instance, we compare strings without
+distinguishing upper and lower case.
+\begin{caml_example}{toplevel}
+module NoCaseString =
+  struct
+    type t = string
+    let compare s1 s2 =
+      OrderedString.compare (String.lowercase_ascii s1) (String.lowercase_ascii s2)
+  end;;
+module NoCaseStringSet = AbstractSet(NoCaseString);;
+NoCaseStringSet.add "FOO" AbstractStringSet.empty [@@expect error];;
+\end{caml_example}
+Note that the two types "AbstractStringSet.set" and
+"NoCaseStringSet.set" are not compatible, and values of these
+two types do not match. This is the correct behavior: even though both
+set types contain elements of the same type (strings), they are built
+upon different orderings of that type, and different invariants need
+to be maintained by the operations (being strictly increasing for the
+standard ordering and for the case-insensitive ordering). Applying
+operations from "AbstractStringSet" to values of type
+"NoCaseStringSet.set" could give incorrect results, or build
+lists that violate the invariants of "NoCaseStringSet".
+
+\section{s:separate-compilation}{Modules and separate compilation}
+
+All examples of modules so far have been given in the context of the
+interactive system. However, modules are most useful for large,
+batch-compiled programs. For these programs, it is a practical
+necessity to split the source into several files, called compilation
+units, that can be compiled separately, thus minimizing recompilation
+after changes.
+
+In OCaml, compilation units are special cases of structures
+and signatures, and the relationship between the units can be
+explained easily in terms of the module system. A compilation unit \var{A}
+comprises two files:
+\begin{itemize}
+\item the implementation file \var{A}".ml", which contains a sequence
+of definitions, analogous to the inside of a "struct"\ldots"end"
+construct;
+\item the interface file \var{A}".mli", which contains a sequence of
+specifications, analogous to the inside of a "sig"\ldots"end"
+construct.
+\end{itemize}
+These two files together define a structure named \var{A} as if
+the following definition was entered at top-level:
+\begin{alltt}
+module \var{A}: sig (* \hbox{contents of file} \var{A}.mli *) end
+        = struct (* \hbox{contents of file} \var{A}.ml *) end;;
+\end{alltt}
+The files that define the compilation units can be compiled separately
+using the "ocamlc -c" command (the "-c" option means ``compile only, do
+not try to link''); this produces compiled interface files (with
+extension ".cmi") and compiled object code files (with extension
+".cmo"). When all units have been compiled, their ".cmo" files are
+linked together using the "ocamlc" command. For instance, the following
+commands compile and link a program composed of two compilation units
+"Aux" and "Main":
+\begin{verbatim}
+$ ocamlc -c Aux.mli                     # produces aux.cmi
+$ ocamlc -c Aux.ml                      # produces aux.cmo
+$ ocamlc -c Main.mli                    # produces main.cmi
+$ ocamlc -c Main.ml                     # produces main.cmo
+$ ocamlc -o theprogram Aux.cmo Main.cmo
+\end{verbatim}
+The program behaves exactly as if the following phrases were entered
+at top-level:
+\begin{alltt}
+module Aux: sig (* \rminalltt{contents of} Aux.mli *) end
+          = struct (* \rminalltt{contents of} Aux.ml *) end;;
+module Main: sig (* \rminalltt{contents of} Main.mli *) end
+           = struct (* \rminalltt{contents of} Main.ml *) end;;
+\end{alltt}
+In particular, "Main" can refer to "Aux": the definitions and
+declarations contained in "Main.ml" and "Main.mli" can refer to
+definition in "Aux.ml", using the "Aux."\var{ident} notation, provided
+these definitions are exported in "Aux.mli".
+
+The order in which the ".cmo" files are given to "ocamlc" during the
+linking phase determines the order in which the module definitions
+occur. Hence, in the example above, "Aux" appears first and "Main" can
+refer to it, but "Aux" cannot refer to "Main".
+
+Note that only top-level structures can be mapped to
+separately-compiled files, but neither functors nor module types.
+However, all module-class objects can appear as components of a
+structure, so the solution is to put the functor or module type
+inside a structure, which can then be mapped to a file.
diff --git a/manual/manual/tutorials/objectexamples.etex b/manual/manual/tutorials/objectexamples.etex
new file mode 100644
index 00000000..0f733023
--- /dev/null
+++ b/manual/manual/tutorials/objectexamples.etex
@@ -0,0 +1,1230 @@
+\chapter{Objects in OCaml}
+\label{c:objectexamples}
+%HEVEA\cutname{objectexamples.html}
+{\it (Chapter written by Jérôme Vouillon, Didier Rémy and Jacques Garrigue)}
+
+\bigskip
+
+\noindent This chapter gives an overview of the object-oriented features of
+OCaml.
+
+Note that the relationship between object, class and type in OCaml is
+different than in mainstream object-oriented languages such as Java and
+C++, so you shouldn't assume that similar keywords mean the same thing.
+Object-oriented features are used much less frequently in OCaml than
+in those languages.  OCaml has alternatives that are often more appropriate,
+such as modules and functors.  Indeed, many OCaml programs do not use objects
+at all.
+
+\section{s:classes-and-objects}{Classes and objects}
+
+The class "point" below defines one instance variable "x" and two methods
+"get_x" and "move". The initial value of the instance variable is "0".
+The variable "x" is declared mutable, so the method "move" can change
+its value.
+\begin{caml_example}{toplevel}
+class point =
+  object
+    val mutable x = 0
+    method get_x = x
+    method move d = x <- x + d
+  end;;
+\end{caml_example}
+
+We now create a new point "p", instance of the "point" class.
+\begin{caml_example}{toplevel}
+let p = new point;;
+\end{caml_example}
+Note that the type of "p" is "point". This is an abbreviation
+automatically defined by the class definition above. It stands for the
+object type " unit>", listing the methods
+of class "point" along with their types.
+
+We now invoke some methods of "p":
+\begin{caml_example}{toplevel}
+p#get_x;;
+p#move 3;;
+p#get_x;;
+\end{caml_example}
+
+The evaluation of the body of a class only takes place at object
+creation time.  Therefore, in the following example, the instance
+variable "x" is initialized to different values for two different
+objects.
+\begin{caml_example}{toplevel}
+let x0 = ref 0;;
+class point =
+  object
+    val mutable x = incr x0; !x0
+    method get_x = x
+    method move d = x <- x + d
+  end;;
+new point#get_x;;
+new point#get_x;;
+\end{caml_example}
+
+The class "point" can also be abstracted over the initial values of
+the "x" coordinate.
+\begin{caml_example}{toplevel}
+class point = fun x_init ->
+  object
+    val mutable x = x_init
+    method get_x = x
+    method move d = x <- x + d
+  end;;
+\end{caml_example}
+Like in function definitions, the definition above can be
+abbreviated as:
+\begin{caml_example}{toplevel}
+class point x_init =
+  object
+    val mutable x = x_init
+    method get_x = x
+    method move d = x <- x + d
+  end;;
+\end{caml_example}
+An instance of the class "point" is now a function that expects an
+initial parameter to create a point object:
+\begin{caml_example}{toplevel}
+new point;;
+let p = new point 7;;
+\end{caml_example}
+The parameter "x_init" is, of course, visible in the whole body of the
+definition, including methods. For instance, the method "get_offset"
+in the class below returns the position of the object relative to its
+initial position.
+\begin{caml_example}{toplevel}
+class point x_init =
+  object
+    val mutable x = x_init
+    method get_x = x
+    method get_offset = x - x_init
+    method move d = x <- x + d
+  end;;
+\end{caml_example}
+%Instance variables can only be used inside methods. For instance it would
+%not be possible to define
+%\begin{caml_example}{toplevel}
+%class point x_init =
+%  object
+%    val mutable x = x_init
+%    val origin = x
+%    method get_offset = x - origin
+%    method move d = x <- x + d
+%  end;;
+%\end{caml_example}
+Expressions can be evaluated and bound before defining the object body
+of the class. This is useful to enforce invariants. For instance,
+points can be automatically adjusted to the nearest point on a grid,
+as follows:
+\begin{caml_example}{toplevel}
+class adjusted_point x_init =
+  let origin = (x_init / 10) * 10 in
+  object
+    val mutable x = origin
+    method get_x = x
+    method get_offset = x - origin
+    method move d = x <- x + d
+  end;;
+\end{caml_example}
+(One could also raise an exception if the "x_init" coordinate is not
+on the grid.) In fact, the same effect could here be obtained by
+calling the definition of class "point" with the value of the
+"origin".
+\begin{caml_example}{toplevel}
+class adjusted_point x_init =  point ((x_init / 10) * 10);;
+\end{caml_example}
+An alternate solution would have been to define the adjustment in
+a special allocation function:
+\begin{caml_example}{toplevel}
+let new_adjusted_point x_init = new point ((x_init / 10) * 10);;
+\end{caml_example}
+However, the former pattern is generally more appropriate, since
+the code for adjustment is part of the definition of the class and will be
+inherited.
+
+This ability provides class constructors as can be found in other
+languages. Several constructors can be defined this way to build objects of
+the same class but with different initialization patterns; an
+alternative is to use initializers, as described below in
+section~\ref{s:initializers}.
+
+\section{s:immediate-objects}{Immediate objects}
+
+There is another, more direct way to create an object: create it
+without going through a class.
+
+The syntax is exactly the same as for class expressions, but the
+result is a single object rather than a class. All the constructs
+described in the rest of this section also apply to immediate objects.
+\begin{caml_example}{toplevel}
+let p =
+  object
+    val mutable x = 0
+    method get_x = x
+    method move d = x <- x + d
+  end;;
+p#get_x;;
+p#move 3;;
+p#get_x;;
+\end{caml_example}
+
+Unlike classes, which cannot be defined inside an expression,
+immediate objects can appear anywhere, using variables from their
+environment.
+\begin{caml_example}{toplevel}
+let minmax x y =
+  if x < y then object method min = x method max = y end
+  else object method min = y method max = x end;;
+\end{caml_example}
+
+Immediate objects have two weaknesses compared to classes: their types
+are not abbreviated, and you cannot inherit from them. But these two
+weaknesses can be advantages in some situations, as we will see
+in sections~\ref{s:reference-to-self} and~\ref{s:parameterized-classes}.
+
+\section{s:reference-to-self}{Reference to self}
+
+A method or an initializer can invoke methods on self (that is,
+the current object).  For that, self must be explicitly bound, here to
+the variable "s" ("s" could be any identifier, even though we will
+often choose the name "self".)
+\begin{caml_example}{toplevel}
+class printable_point x_init =
+  object (s)
+    val mutable x = x_init
+    method get_x = x
+    method move d = x <- x + d
+    method print = print_int s#get_x
+  end;;
+let p = new printable_point 7;;
+p#print;;
+\end{caml_example}
+Dynamically, the variable "s" is bound at the invocation of a method.  In
+particular, when the class "printable_point" is inherited, the variable
+"s" will be correctly bound to the object of the subclass.
+
+A common problem with self is that, as its type may be extended in
+subclasses, you cannot fix it in advance. Here is a simple example.
+\begin{caml_example}{toplevel}
+let ints = ref [];;
+class my_int =
+  object (self)
+    method n = 1
+    method register = ints := self :: !ints
+  end [@@expect error];;
+\end{caml_example}
+You can ignore the first two lines of the error message. What matters
+is the last one: putting self into an external reference would make it
+impossible to extend it through inheritance.
+We will see in section~\ref{s:using-coercions} a workaround to this
+problem.
+Note however that, since immediate objects are not extensible, the
+problem does not occur with them.
+\begin{caml_example}{toplevel}
+let my_int =
+  object (self)
+    method n = 1
+    method register = ints := self :: !ints
+  end;;
+\end{caml_example}
+
+\section{s:initializers}{Initializers}
+
+Let-bindings within class definitions are evaluated before the object
+is constructed. It is also possible to evaluate an expression
+immediately after the object has been built. Such code is written as
+an anonymous hidden method called an initializer. Therefore, it can
+access self and the instance variables.
+\begin{caml_example}{toplevel}
+class printable_point x_init =
+  let origin = (x_init / 10) * 10 in
+  object (self)
+    val mutable x = origin
+    method get_x = x
+    method move d = x <- x + d
+    method print = print_int self#get_x
+    initializer print_string "new point at "; self#print; print_newline ()
+  end;;
+let p = new printable_point 17;;
+\end{caml_example}
+Initializers cannot be overridden. On the contrary, all initializers are
+evaluated sequentially.
+Initializers are particularly useful to enforce invariants.
+Another example can be seen in section~\ref{s:extended-bank-accounts}.
+
+
+\section{s:virtual-methods}{Virtual methods}
+
+It is possible to declare a method without actually defining it, using
+the keyword "virtual".  This method will be provided later in
+subclasses. A class containing virtual methods must be flagged
+"virtual", and cannot be instantiated (that is, no object of this class
+can be created). It still defines type abbreviations (treating virtual methods
+as other methods.)
+\begin{caml_example}{toplevel}
+class virtual abstract_point x_init =
+  object (self)
+    method virtual get_x : int
+    method get_offset = self#get_x - x_init
+    method virtual move : int -> unit
+  end;;
+class point x_init =
+  object
+    inherit abstract_point x_init
+    val mutable x = x_init
+    method get_x = x
+    method move d = x <- x + d
+  end;;
+\end{caml_example}
+
+Instance variables can also be declared as virtual, with the same effect
+as with methods.
+\begin{caml_example}{toplevel}
+class virtual abstract_point2 =
+  object
+    val mutable virtual x : int
+    method move d = x <- x + d
+  end;;
+class point2 x_init =
+  object
+    inherit abstract_point2
+    val mutable x = x_init
+    method get_offset = x - x_init
+  end;;
+\end{caml_example}
+
+\section{s:private-methods}{Private methods}
+
+Private methods are methods that do not appear in object interfaces.
+They can only be invoked from other methods of the same object.
+\begin{caml_example}{toplevel}
+class restricted_point x_init =
+  object (self)
+    val mutable x = x_init
+    method get_x = x
+    method private move d = x <- x + d
+    method bump = self#move 1
+  end;;
+let p = new restricted_point 0;;
+p#move 10 [@@expect error] ;;
+p#bump;;
+\end{caml_example}
+Note that this is not the same thing as private and protected methods
+in Java or C++, which can be called from other objects of the same
+class. This is a direct consequence of the independence between types
+and classes in OCaml: two unrelated classes may produce
+objects of the same type, and there is no way at the type level to
+ensure that an object comes from a specific class. However a possible
+encoding of friend methods is given in section~\ref{s:friends}.
+
+Private methods are inherited (they are by default visible in subclasses),
+unless they are hidden by signature matching, as described below.
+
+Private methods can be made public in a subclass.
+\begin{caml_example}{toplevel}
+class point_again x =
+  object (self)
+    inherit restricted_point x
+    method virtual move : _
+  end;;
+\end{caml_example}
+The annotation "virtual" here is only used to mention a method without
+providing its definition. Since we didn't add the "private"
+annotation, this makes the method public, keeping the original
+definition.
+
+An alternative definition is
+\begin{caml_example}{toplevel}
+class point_again x =
+  object (self : < move : _; ..> )
+    inherit restricted_point x
+  end;;
+\end{caml_example}
+The constraint on self's type is requiring a public "move" method, and
+this is sufficient to override "private".
+
+One could think that a private method should remain private in a subclass.
+However, since the method is visible in a subclass, it is always possible
+to pick its code and define a method of the same name that runs that
+code, so yet another (heavier) solution would be:
+\begin{caml_example}{toplevel}
+class point_again x =
+  object
+    inherit restricted_point x as super
+    method move = super#move
+  end;;
+\end{caml_example}
+
+Of course, private methods can also be virtual. Then, the keywords must
+appear in this order "method private virtual".
+
+\section{s:class-interfaces}{Class interfaces}
+
+
+%XXX Differentiate class type and class interface ?
+
+Class interfaces are inferred from class definitions.  They may also
+be defined directly and used to restrict the type of a class.  Like class
+declarations, they also define a new type abbreviation.
+\begin{caml_example}{toplevel}
+class type restricted_point_type =
+  object
+    method get_x : int
+    method bump : unit
+end;;
+fun (x : restricted_point_type) -> x;;
+\end{caml_example}
+In addition to program documentation, class interfaces can be used to
+constrain the type of a class. Both concrete instance variables and concrete
+private methods can be hidden by a class type constraint. Public
+methods and virtual members, however, cannot.
+\begin{caml_example}{toplevel}
+class restricted_point' x = (restricted_point x : restricted_point_type);;
+\end{caml_example}
+Or, equivalently:
+\begin{caml_example}{toplevel}
+class restricted_point' = (restricted_point : int -> restricted_point_type);;
+\end{caml_example}
+The interface of a class can also be specified in a module
+signature, and used to restrict the inferred signature of a module.
+\begin{caml_example}{toplevel}
+module type POINT = sig
+  class restricted_point' : int ->
+    object
+      method get_x : int
+      method bump : unit
+    end
+end;;
+module Point : POINT = struct
+  class restricted_point' = restricted_point
+end;;
+\end{caml_example}
+
+\section{s:inheritance}{Inheritance}
+
+We illustrate inheritance by defining a class of colored points that
+inherits from the class of points.  This class has all instance
+variables and all methods of class "point", plus a new instance
+variable "c" and a new method "color".
+\begin{caml_example}{toplevel}
+class colored_point x (c : string) =
+  object
+    inherit point x
+    val c = c
+    method color = c
+  end;;
+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
+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.
+\begin{caml_example}{toplevel}
+let get_succ_x p = p#get_x + 1;;
+get_succ_x p + get_succ_x p';;
+\end{caml_example}
+Methods need not be declared previously, as shown by the example:
+\begin{caml_example}{toplevel}
+let set_x p = p#set_x;;
+let incr p = set_x p (get_succ_x p);;
+\end{caml_example}
+
+\section{s:multiple-inheritance}{Multiple inheritance}
+
+Multiple inheritance is allowed. Only the last definition of a method
+is kept: the redefinition in a subclass of a method that was visible in
+the parent class overrides the definition in the parent class.
+Previous definitions of a method can be reused by binding the related
+ancestor. Below, "super" is bound to the ancestor "printable_point".
+The name "super" is a pseudo value identifier that can only be used to
+invoke a super-class method, as in "super#print".
+\begin{caml_example}{toplevel}
+class printable_colored_point y c =
+  object (self)
+    val c = c
+    method color = c
+    inherit printable_point y as super
+    method! print =
+      print_string "(";
+      super#print;
+      print_string ", ";
+      print_string (self#color);
+      print_string ")"
+  end;;
+let p' = new printable_colored_point 17 "red";;
+p'#print;;
+\end{caml_example}
+A private method that has been hidden in the parent class is no longer
+visible, and is thus not overridden. Since initializers are treated as
+private methods, all initializers along the class hierarchy are evaluated,
+in the order they are introduced.
+
+Note that for clarity's sake, the method "print" is explicitly marked as
+overriding another definition by annotating the "method" keyword with
+an exclamation mark "!". If the method "print" were not overriding the
+"print" method of "printable_point", the compiler would raise an error:
+\begin{caml_example}{toplevel}[error]
+  object
+    method! m = ()
+  end;;
+\end{caml_example}
+
+This explicit overriding annotation also works
+for "val" and "inherit":
+\begin{caml_example}{toplevel}
+class another_printable_colored_point y c c' =
+  object (self)
+  inherit printable_point y
+  inherit! printable_colored_point y c
+  val! c = c'
+  end;;
+\end{caml_example}
+
+\section{s:parameterized-classes}{Parameterized classes}
+
+Reference cells can be implemented as objects.
+The naive definition fails to typecheck:
+\begin{caml_example}{toplevel}[error]
+class oref x_init =
+  object
+    val mutable x = x_init
+    method get = x
+    method set y = x <- y
+  end;;
+\end{caml_example}
+The reason is that at least one of the methods has a polymorphic type
+(here, the type of the value stored in the reference cell), thus
+either the class should be parametric, or the method type should be
+constrained to a monomorphic type.  A monomorphic instance of the class could
+be defined by:
+\begin{caml_example}{toplevel}
+class oref (x_init:int) =
+  object
+    val mutable x = x_init
+    method get = x
+    method set y = x <- y
+  end;;
+\end{caml_example}
+Note that since immediate objects do not define a class type, they have
+no such restriction.
+\begin{caml_example}{toplevel}
+let new_oref x_init =
+  object
+    val mutable x = x_init
+    method get = x
+    method set y = x <- y
+  end;;
+\end{caml_example}
+On the other hand, a class for polymorphic references must explicitly
+list the type parameters in its declaration. Class type parameters are
+listed between "[" and "]". The type parameters must also be
+bound somewhere in the class body by a type constraint.
+\begin{caml_example}{toplevel}
+class ['a] oref x_init =
+  object
+    val mutable x = (x_init : 'a)
+    method get = x
+    method set y = x <- y
+  end;;
+let r = new oref 1 in r#set 2; (r#get);;
+\end{caml_example}
+The type parameter in the declaration may actually be constrained in the
+body of the class definition. In the class type, the actual value of
+the type parameter is displayed in the "constraint" clause.
+\begin{caml_example}{toplevel}
+class ['a] oref_succ (x_init:'a) =
+  object
+    val mutable x = x_init + 1
+    method get = x
+    method set y = x <- y
+  end;;
+\end{caml_example}
+Let us consider a more complex example: define a circle, whose center
+may be any kind of point.  We put an additional type
+constraint in method "move", since no free variables must remain
+unaccounted for by the class type parameters.
+\begin{caml_example}{toplevel}
+class ['a] circle (c : 'a) =
+  object
+    val mutable center = c
+    method center = center
+    method set_center c = center <- c
+    method move = (center#move : int -> unit)
+  end;;
+\end{caml_example}
+An alternate definition of "circle", using a "constraint" clause in
+the class definition, is shown below. The type "#point" used below in
+the "constraint" clause is an abbreviation produced by the definition
+of class "point". This abbreviation unifies with the type of any
+object belonging to a subclass of class "point". It actually expands to
+"< get_x : int; move : int -> unit; .. >". This leads to the following
+alternate definition of "circle", which has slightly stronger
+constraints on its argument, as we now expect "center" to have a
+method "get_x".
+\begin{caml_example}{toplevel}
+class ['a] circle (c : 'a) =
+  object
+    constraint 'a = #point
+    val mutable center = c
+    method center = center
+    method set_center c = center <- c
+    method move = center#move
+  end;;
+\end{caml_example}
+The class "colored_circle" is a specialized version of class
+"circle" that requires the type of the center to unify with
+"#colored_point", and adds a method "color". Note that when specializing a
+parameterized class, the instance of type parameter must always be
+explicitly given. It is again written between "[" and "]".
+\begin{caml_example}{toplevel}
+class ['a] colored_circle c =
+  object
+    constraint 'a = #colored_point
+    inherit ['a] circle c
+    method color = center#color
+  end;;
+\end{caml_example}
+
+\section{s:polymorphic-methods}{Polymorphic methods}
+
+While parameterized classes may be polymorphic in their contents, they
+are not enough to allow polymorphism of method use.
+
+A classical example is defining an iterator.
+\begin{caml_example}{toplevel}
+List.fold_left;;
+class ['a] intlist (l : int list) =
+  object
+    method empty = (l = [])
+    method fold f (accu : 'a) = List.fold_left f accu l
+  end;;
+\end{caml_example}
+At first look, we seem to have a polymorphic iterator, however this
+does not work in practice.
+\begin{caml_example}{toplevel}
+let l = new intlist [1; 2; 3];;
+l#fold (fun x y -> x+y) 0;;
+l;;
+l#fold (fun s x -> s ^ Int.to_string x ^ " ") "" [@@expect error];;
+\end{caml_example}
+Our iterator works, as shows its first use for summation. However,
+since objects themselves are not polymorphic (only their constructors
+are), using the "fold" method fixes its type for this individual object.
+Our next attempt to use it as a string iterator fails.
+
+The problem here is that quantification was wrongly located: it is
+not the class we want to be polymorphic, but the "fold" method.
+This can be achieved by giving an explicitly polymorphic type in the
+method definition.
+\begin{caml_example}{toplevel}
+class intlist (l : int list) =
+  object
+    method empty = (l = [])
+    method fold : 'a. ('a -> int -> 'a) -> 'a -> 'a =
+      fun f accu -> List.fold_left f accu l
+  end;;
+let l = new intlist [1; 2; 3];;
+l#fold (fun x y -> x+y) 0;;
+l#fold (fun s x -> s ^ Int.to_string x ^ " ") "";;
+\end{caml_example}
+As you can see in the class type shown by the compiler, while
+polymorphic method types must be fully explicit in class definitions
+(appearing immediately after the method name), quantified type
+variables can be left implicit in class descriptions. Why require types
+to be explicit? The problem is that "(int -> int -> int) -> int ->
+int" would also be a valid type for "fold", and it happens to be
+incompatible with the polymorphic type we gave (automatic
+instantiation only works for toplevel types variables, not for inner
+quantifiers, where it becomes an undecidable problem.) So the compiler
+cannot choose between those two types, and must be helped.
+
+However, the type can be completely omitted in the class definition if
+it is already known, through inheritance or type constraints on self.
+Here is an example of method overriding.
+\begin{caml_example*}{toplevel}
+class intlist_rev l =
+  object
+    inherit intlist l
+    method! fold f accu = List.fold_left f accu (List.rev l)
+  end;;
+\end{caml_example*}
+The following idiom separates description and definition.
+\begin{caml_example*}{toplevel}
+class type ['a] iterator =
+  object method fold : ('b -> 'a -> 'b) -> 'b -> 'b end;;
+class intlist' l =
+  object (self : int #iterator)
+    method empty = (l = [])
+    method fold f accu = List.fold_left f accu l
+  end;;
+\end{caml_example*}
+Note here the "(self : int #iterator)" idiom, which ensures that this
+object implements the interface "iterator".
+
+Polymorphic methods are called in exactly the same way as normal
+methods, but you should be aware of some limitations of type
+inference.  Namely, a polymorphic method can only be called if its
+type is known at the call site.  Otherwise, the method will be assumed
+to be monomorphic, and given an incompatible type.
+\begin{caml_example}{toplevel}
+let sum lst = lst#fold (fun x y -> x+y) 0;;
+sum l [@@expect error];;
+\end{caml_example}
+The workaround is easy: you should put a type constraint on the
+parameter.
+\begin{caml_example}{toplevel}
+let sum (lst : _ #iterator) = lst#fold (fun x y -> x+y) 0;;
+\end{caml_example}
+Of course the constraint may also be an explicit method type.
+Only occurrences of quantified variables are required.
+\begin{caml_example}{toplevel}
+let sum lst =
+  (lst : < fold : 'a. ('a -> _ -> 'a) -> 'a -> 'a; .. >)#fold (+) 0;;
+\end{caml_example}
+
+Another use of polymorphic methods is to allow some form of implicit
+subtyping in method arguments. We have already seen in
+section~\ref{s:inheritance} how some functions may be polymorphic in the
+class of their argument. This can be extended to methods.
+\begin{caml_example}{toplevel}
+class type point0 = object method get_x : int end;;
+class distance_point x =
+  object
+    inherit point x
+    method distance : 'a. (#point0 as 'a) -> int =
+      fun other -> abs (other#get_x - x)
+  end;;
+let p = new distance_point 3 in
+(p#distance (new point 8), p#distance (new colored_point 1 "blue"));;
+\end{caml_example}
+Note here the special syntax "(#point0 as 'a)" we have to use to
+quantify the extensible part of "#point0". As for the variable binder,
+it can be omitted in class specifications. If you want polymorphism
+inside object field it must be quantified independently.
+\begin{caml_example}{toplevel}
+class multi_poly =
+  object
+    method m1 : 'a. (< n1 : 'b. 'b -> 'b; .. > as 'a) -> _ =
+      fun o -> o#n1 true, o#n1 "hello"
+    method m2 : 'a 'b. (< n2 : 'b -> bool; .. > as 'a) -> 'b -> _ =
+      fun o x -> o#n2 x
+  end;;
+\end{caml_example}
+In method "m1", "o" must be an object with at least a method "n1",
+itself polymorphic.  In method "m2", the argument of "n2" and "x" must
+have the same type, which is quantified at the same level as "'a".
+
+\section{s:using-coercions}{Using coercions}
+
+Subtyping is never implicit.  There are, however, two ways to perform
+subtyping.  The most general construction is fully explicit: both the
+domain and the codomain of the type coercion must be given.
+
+We have seen that points and colored points have incompatible types.
+For instance, they cannot be mixed in the same list. However, a
+colored point can be coerced to a point, hiding its "color" method:
+\begin{caml_example}{toplevel}
+let colored_point_to_point cp = (cp : colored_point :> point);;
+let p = new point 3 and q = new colored_point 4 "blue";;
+let l = [p; (colored_point_to_point q)];;
+\end{caml_example}
+An object of type "t" can be seen as an object of type "t'"
+only if "t" is a subtype of "t'". For instance, a point cannot be
+seen as a colored point.
+\begin{caml_example}{toplevel}[error]
+(p : point :> colored_point);;
+\end{caml_example}
+Indeed, narrowing coercions without runtime checks would be unsafe.
+Runtime type checks might raise exceptions, and they would require
+the presence of type information at runtime, which is not the case in
+the OCaml system.
+For these reasons, there is no such operation available in the language.
+
+Be aware that subtyping and inheritance are not related.  Inheritance is a
+syntactic relation between classes while subtyping is a semantic relation
+between types.  For instance, the class of colored points could have been
+defined directly, without inheriting from the class of points; the type of
+colored points would remain unchanged and thus still be a subtype of
+points.
+% Conversely, the class "int_comparable" inherits from class
+%"comparable", but type "int_comparable" is not a subtype of "comparable".
+%\begin{caml_example}{toplevel}
+%function x -> (x : int_comparable :> comparable);;
+%\end{caml_example}
+
+The domain of a coercion can often be omitted. For instance, one can
+define:
+\begin{caml_example}{toplevel}
+let to_point cp = (cp :> point);;
+\end{caml_example}
+In this case, the function "colored_point_to_point" is an instance of the
+function "to_point". This is not always true, however. The fully
+explicit coercion  is more precise and is sometimes  unavoidable.
+Consider, for example, the following class:
+\begin{caml_example}{toplevel}
+class c0 = object method m = {< >} method n = 0 end;;
+\end{caml_example}
+The object type "c0" is an abbreviation for " as 'a".
+Consider now the type declaration:
+\begin{caml_example}{toplevel}
+class type c1 =  object method m : c1 end;;
+\end{caml_example}
+The object type "c1" is an abbreviation for the type " as 'a".
+The coercion from an object of type "c0" to an object of type "c1" is
+correct:
+\begin{caml_example}{toplevel}
+fun (x:c0) -> (x : c0 :> c1);;
+\end{caml_example}
+%%% FIXME come up with a better example.
+% However, the domain of the coercion cannot be omitted here:
+% \begin{caml_example}{toplevel}
+% fun (x:c0) -> (x :> c1);;
+% \end{caml_example}
+However, the domain of the coercion cannot always be omitted.
+In that case, the solution is to use the explicit form.
+%
+Sometimes, a change in the class-type definition can also solve the problem
+\begin{caml_example}{toplevel}
+class type c2 = object ('a) method m : 'a end;;
+fun (x:c0) -> (x :> c2);;
+\end{caml_example}
+While class types "c1" and "c2" are different, both object types
+"c1" and "c2" expand to the same object type (same method names and types).
+Yet, when the domain of a coercion is left implicit and its co-domain
+is an abbreviation of a known class type, then the class type, rather
+than the object type, is used to derive the coercion function. This
+allows leaving the domain implicit in most cases when coercing form a
+subclass to its superclass.
+%
+The type of a coercion can always be seen as below:
+\begin{caml_example}{toplevel}
+let to_c1 x = (x :> c1);;
+let to_c2 x = (x :> c2);;
+\end{caml_example}
+Note the difference between these two coercions: in the case of "to_c2",
+the type
+"#c2 = < m : 'a; .. > as 'a" is polymorphically recursive (according
+to the explicit recursion in the class type of "c2"); hence the
+success of applying this coercion to an object of class "c0".
+On the other hand, in the first case, "c1" was only expanded and
+unrolled twice to obtain "< m : < m : c1; .. >; .. >" (remember "#c1 =
+< m : c1; .. >"), without introducing recursion.
+You may also note that the type of "to_c2" is "#c2 -> c2" while
+the type of "to_c1" is more general than "#c1 -> c1". This is not always true,
+since there are class types for which some instances of "#c" are not subtypes
+of "c", as explained in section~\ref{s:binary-methods}. Yet, for
+parameterless classes the coercion "(_ :> c)" is always more general than
+"(_ : #c :> c)".
+%If a class type exposes the type of self through one of its parameters, this
+%is no longer true. Here is a counter-example.
+%\begin{caml_example}{toplevel}
+%class type ['a] c = object ('a) method m : 'a end;;
+%let to_c x = (x :> _ c);;
+%\end{caml_example}
+
+
+A common problem may occur when one tries to define a coercion to a
+class "c" while defining class "c". The problem is due to the type
+abbreviation not being completely defined yet, and so its subtypes are not
+clearly known.  Then, a coercion "(_ :> c)" or "(_ : #c :> c)" is taken to be
+the identity function, as in
+\begin{caml_example}{toplevel}
+function x -> (x :> 'a);;
+\end{caml_example}
+As a consequence, if the coercion is applied to "self", as in the
+following example, the type of "self" is unified with the closed type
+"c" (a closed object type is an object type without ellipsis).  This
+would constrain the type of self be closed and is thus rejected.
+Indeed, the type of self cannot be closed: this would prevent any
+further extension of the class. Therefore, a type error is generated
+when the unification of this type with another type would result in a
+closed object type.
+\begin{caml_example}{toplevel}[error]
+class c = object method m = 1 end
+and d = object (self)
+  inherit c
+  method n = 2
+  method as_c = (self :> c)
+end;;
+\end{caml_example}
+However, the most common instance of this problem, coercing self to
+its current class, is detected as a special case by the type checker,
+and properly typed.
+\begin{caml_example}{toplevel}
+class c = object (self) method m = (self :> c) end;;
+\end{caml_example}
+This allows the following idiom, keeping a list of all objects
+belonging to a class or its subclasses:
+\begin{caml_example}{toplevel}
+let all_c = ref [];;
+class c (m : int) =
+  object (self)
+    method m = m
+    initializer all_c := (self :> c) :: !all_c
+  end;;
+\end{caml_example}
+This idiom can in turn be used to retrieve an object whose type has
+been weakened:
+\begin{caml_example}{toplevel}
+let rec lookup_obj obj = function [] -> raise Not_found
+  | obj' :: l ->
+     if (obj :> < >) = (obj' :> < >) then obj' else lookup_obj obj l ;;
+let lookup_c obj = lookup_obj obj !all_c;;
+\end{caml_example}
+The type "< m : int >" we see here is just the expansion of "c", due
+to the use of a reference; we have succeeded in getting back an object
+of type "c".
+
+\medskip
+The previous coercion problem can often be avoided by first
+defining the abbreviation, using a class type:
+\begin{caml_example}{toplevel}
+class type c' = object method m : int end;;
+class c : c' = object method m = 1 end
+and d = object (self)
+  inherit c
+  method n = 2
+  method as_c = (self :> c')
+end;;
+\end{caml_example}
+It is also possible to use a virtual class. Inheriting from this class
+simultaneously forces all methods of "c" to have the same
+type as the methods of "c'".
+\begin{caml_example}{toplevel}
+class virtual c' = object method virtual m : int end;;
+class c = object (self) inherit c' method m = 1 end;;
+\end{caml_example}
+One could think of defining the type abbreviation directly:
+\begin{caml_example*}{toplevel}
+type c' = ;;
+\end{caml_example*}
+However, the abbreviation "#c'" cannot be defined directly in a similar way.
+It can only be defined by a class or a class-type definition.
+This is because a "#"-abbreviation carries an implicit anonymous
+variable ".." that cannot be explicitly named.
+The closer you get to it is:
+\begin{caml_example*}{toplevel}
+type 'a c'_class = 'a constraint 'a = < m : int; .. >;;
+\end{caml_example*}
+with an extra type variable capturing the open object type.
+
+\section{s:functional-objects}{Functional objects}
+
+It is possible to write a version of class "point" without assignments
+on the instance variables. The override construct "{< ... >}" returns a copy of
+``self'' (that is, the current object), possibly changing the value of
+some instance variables.
+\begin{caml_example}{toplevel}
+class functional_point y =
+  object
+    val x = y
+    method get_x = x
+    method move d = {< x = x + d >}
+    method move_to x = {< x >}
+  end;;
+let p = new functional_point 7;;
+p#get_x;;
+(p#move 3)#get_x;;
+(p#move_to 15)#get_x;;
+p#get_x;;
+\end{caml_example}
+As with records, the form "{< x >}" is an elided version of
+"{< x = x >}" which avoids the repetition of the instance variable name.
+Note that the type abbreviation "functional_point" is recursive, which can
+be seen in the class type of "functional_point": the type of self is "'a"
+and "'a" appears inside the type of the method "move".
+
+The above definition of "functional_point" is not equivalent
+to the following:
+\begin{caml_example}{toplevel}
+class bad_functional_point y =
+  object
+    val x = y
+    method get_x = x
+    method move d = new bad_functional_point (x+d)
+    method move_to x = new bad_functional_point x
+  end;;
+\end{caml_example}
+While objects of either class will behave the same, objects of their
+subclasses will be different. In a subclass of "bad_functional_point",
+the method "move" will
+keep returning an object of the parent class.  On the contrary, in a
+subclass of "functional_point", the method "move" will return an
+object of the subclass.
+
+Functional update is often used in conjunction with binary methods
+as illustrated in section~\ref{ss:string-as-class}.
+
+\section{s:cloning-objects}{Cloning objects}
+
+Objects can also be cloned, whether they are functional or imperative.
+The library function "Oo.copy" makes a shallow copy of an object. That is,
+it returns a new object that has the same methods and instance
+variables as its argument. The
+instance variables are copied but their contents are shared.
+Assigning a new value to an instance variable of the copy (using a method
+call) will not affect instance variables of the original, and conversely.
+A deeper assignment (for example if the instance variable is a reference cell)
+will of course affect both the original and the copy.
+
+The type of "Oo.copy" is the following:
+\begin{caml_example}{toplevel}
+Oo.copy;;
+\end{caml_example}
+The keyword "as" in that type binds the type variable "'a" to
+the object type "< .. >".  Therefore, "Oo.copy" takes an object with
+any methods (represented by the ellipsis), and returns an object of
+the same type. The type of "Oo.copy" is different from type "< .. > ->
+< .. >" as each ellipsis represents a different set of methods.
+Ellipsis actually behaves as a type variable.
+\begin{caml_example}{toplevel}
+let p = new point 5;;
+let q = Oo.copy p;;
+q#move 7; (p#get_x, q#get_x);;
+\end{caml_example}
+In fact, "Oo.copy p" will behave as "p#copy" assuming that a public
+method "copy" with body "{< >}" has been defined in the class of "p".
+
+Objects can be compared using the generic comparison functions "=" and "<>".
+Two objects are equal if and only if they are physically equal. In
+particular, an object and its copy are not equal.
+\begin{caml_example}{toplevel}
+let q = Oo.copy p;;
+p = q, p = p;;
+\end{caml_example}
+Other generic comparisons such as ("<", "<=", ...) can also be used on
+objects.  The
+relation "<" defines an unspecified but strict ordering on objects.  The
+ordering relationship between two objects is fixed once for all after the
+two objects have been created and it is not affected by mutation of fields.
+
+Cloning and override have a non empty intersection.
+They are interchangeable when used within an object and without
+overriding any field:
+\begin{caml_example}{toplevel}
+class copy =
+  object
+    method copy = {< >}
+  end;;
+class copy =
+  object (self)
+    method copy = Oo.copy self
+  end;;
+\end{caml_example}
+Only the override can be used to actually override fields, and
+only the "Oo.copy" primitive can be used externally.
+
+Cloning can also be used to provide facilities for saving and
+restoring the state of objects.
+\begin{caml_example}{toplevel}
+class backup =
+  object (self : 'mytype)
+    val mutable copy = None
+    method save = copy <- Some {< copy = None >}
+    method restore = match copy with Some x -> x | None -> self
+  end;;
+\end{caml_example}
+The above definition will only backup one level.
+The backup facility can be added to any class by using multiple inheritance.
+\begin{caml_example}{toplevel}
+class ['a] backup_ref x = object inherit ['a] oref x inherit backup end;;
+let rec get p n = if n = 0 then p # get else get (p # restore) (n-1);;
+let p = new backup_ref 0  in
+p # save; p # set 1; p # save; p # set 2;
+[get p 0; get p 1; get p 2; get p 3; get p 4];;
+\end{caml_example}
+We can define a variant of backup that retains all copies. (We also
+add a method "clear" to manually erase all copies.)
+\begin{caml_example}{toplevel}
+class backup =
+  object (self : 'mytype)
+    val mutable copy = None
+    method save = copy <- Some {< >}
+    method restore = match copy with Some x -> x | None -> self
+    method clear = copy <- None
+  end;;
+\end{caml_example}
+\begin{caml_example}{toplevel}
+class ['a] backup_ref x = object inherit ['a] oref x inherit backup end;;
+let p = new backup_ref 0  in
+p # save; p # set 1; p # save; p # set 2;
+[get p 0; get p 1; get p 2; get p 3; get p 4];;
+\end{caml_example}
+
+
+
+\section{s:recursive-classes}{Recursive classes}
+
+Recursive classes can be used to define objects whose types are
+mutually recursive.
+\begin{caml_example}{toplevel}
+class window =
+  object
+    val mutable top_widget = (None : widget option)
+    method top_widget = top_widget
+  end
+and widget (w : window) =
+  object
+    val window = w
+    method window = window
+  end;;
+\end{caml_example}
+Although their types are mutually recursive, the classes "widget" and
+"window" are themselves independent.
+
+
+\section{s:binary-methods}{Binary methods}
+
+A binary method is a method which takes an argument of the same type
+as self. The class "comparable" below is a template for classes with a
+binary method "leq" of type "'a -> bool" where the type variable "'a"
+is bound to the type of self. Therefore, "#comparable" expands to "<
+leq : 'a -> bool; .. > as 'a".  We see here that the binder "as" also
+allows writing recursive types.
+\begin{caml_example}{toplevel}
+class virtual comparable =
+  object (_ : 'a)
+    method virtual leq : 'a -> bool
+  end;;
+\end{caml_example}
+We then define a subclass "money" of "comparable". The class "money"
+simply wraps floats as comparable objects. We will extend it below with
+more operations. We have to use a type constraint on the class parameter "x"
+because the primitive "<=" is a polymorphic function in
+OCaml.  The "inherit" clause ensures that the type of objects
+of this class is an instance of "#comparable".
+\begin{caml_example}{toplevel}
+class money (x : float) =
+  object
+    inherit comparable
+    val repr = x
+    method value = repr
+    method leq p = repr <= p#value
+  end;;
+\end{caml_example}
+% not explained: mutability can be hidden
+Note that the type "money" is not a subtype of type
+"comparable", as the self type appears in contravariant position
+in the type of method "leq".
+Indeed, an object "m" of class "money" has a method "leq"
+that expects an argument of type "money" since it accesses
+its "value" method.  Considering "m" of type "comparable" would allow a
+call to method "leq" on "m" with an argument that does not have a method
+"value", which would be an error.
+
+Similarly, the type "money2" below is not a subtype of type "money".
+\begin{caml_example}{toplevel}
+class money2 x =
+  object
+    inherit money x
+    method times k = {< repr = k *. repr >}
+  end;;
+\end{caml_example}
+It is however possible to define functions that manipulate objects of
+type either "money" or "money2": the function "min"
+will return the minimum of any two objects whose type unifies with
+"#comparable". The type of "min" is not the same as "#comparable ->
+#comparable -> #comparable", as the abbreviation "#comparable" hides a
+type variable (an ellipsis). Each occurrence of this abbreviation
+generates a new variable.
+\begin{caml_example}{toplevel}
+let min (x : #comparable) y =
+  if x#leq y then x else y;;
+\end{caml_example}
+This function can be applied to objects of type "money"
+or "money2".
+\begin{caml_example}{toplevel}
+(min (new money  1.3) (new money 3.1))#value;;
+(min (new money2 5.0) (new money2 3.14))#value;;
+\end{caml_example}
+
+More examples of binary methods can be found in
+sections~\ref{ss:string-as-class} and~\ref{ss:set-as-class}.
+
+Note the use of override for method "times".
+Writing  "new money2 (k *. repr)" instead of  "{< repr = k *. repr >}"
+would not behave well with inheritance: in a subclass "money3" of "money2"
+the "times" method would return an object of class "money2" but not of class
+"money3" as would be expected.
+
+The class "money" could naturally carry another binary method. Here is a
+direct definition:
+\begin{caml_example}{toplevel}
+class money x =
+  object (self : 'a)
+    val repr = x
+    method value = repr
+    method print = print_float repr
+    method times k = {< repr = k *. x >}
+    method leq (p : 'a) = repr <= p#value
+    method plus (p : 'a) = {< repr = x +. p#value >}
+  end;;
+\end{caml_example}
+
+\section{s:friends}{Friends}
+
+The above class "money" reveals a problem that often occurs with binary
+methods.  In order to interact with other objects of the same class, the
+representation of "money" objects must be revealed, using a method such as
+"value". If we remove all binary methods (here "plus" and "leq"),
+the representation can easily be hidden inside objects by removing the method
+"value" as well. However, this is not possible as soon as some binary
+method requires access to the representation of objects of the same
+class (other than self).
+\begin{caml_example}{toplevel}
+class safe_money x =
+  object (self : 'a)
+    val repr = x
+    method print = print_float repr
+    method times k = {< repr = k *. x >}
+  end;;
+\end{caml_example}
+Here, the representation of the object is known only to a particular object.
+To make it available to other objects of the same class, we are forced to
+make it available to the whole world. However we can easily restrict the
+visibility of the representation using the module system.
+\begin{caml_example*}{toplevel}
+module type MONEY =
+  sig
+    type t
+    class c : float ->
+      object ('a)
+        val repr : t
+        method value : t
+        method print : unit
+        method times : float -> 'a
+        method leq : 'a -> bool
+        method plus : 'a -> 'a
+      end
+  end;;
+module Euro : MONEY =
+  struct
+    type t = float
+    class c x =
+      object (self : 'a)
+        val repr = x
+        method value = repr
+        method print = print_float repr
+        method times k = {< repr = k *. x >}
+        method leq (p : 'a) = repr <= p#value
+        method plus (p : 'a) = {< repr = x +. p#value >}
+      end
+  end;;
+\end{caml_example*}
+Another example of friend functions may be found in section~\ref{ss:set-as-class}.
+These examples occur when a group of objects (here
+objects of the same class) and functions should see each others internal
+representation, while their representation should be hidden from the
+outside. The solution is always to define all friends in the same module,
+give access to the representation and use a signature constraint to make the
+representation abstract outside the module.
+
+
+
+% LocalWords:  typecheck monomorphic uncaptured Subtyping subtyping leq repr Oo
+% LocalWords:  val sig bool Euro struct OCaml Vouillon Didier int ref incr init
+% LocalWords:  succ mytype rec
+
diff --git a/manual/manual/tutorials/polymorphism.etex b/manual/manual/tutorials/polymorphism.etex
new file mode 100644
index 00000000..6fbfd494
--- /dev/null
+++ b/manual/manual/tutorials/polymorphism.etex
@@ -0,0 +1,475 @@
+
+\chapter{Polymorphism and its limitations}%
+\label{c:polymorphism}
+%HEVEA\cutname{polymorphism.html}
+
+\bigskip
+
+\noindent This chapter covers more advanced questions related to the
+limitations of polymorphic functions and types. There are some situations
+in OCaml where the type inferred by the type checker may be less generic
+than expected. Such non-genericity can stem either from interactions
+between side-effect and typing or the difficulties of implicit polymorphic
+recursion and higher-rank polymorphism.
+
+This chapter details each of these situations and, if it is possible,
+how to recover genericity.
+
+\section{s:weak-polymorphism}{Weak polymorphism and mutation}
+\subsection{ss:weak-types}{Weakly polymorphic types}
+Maybe the most frequent examples of non-genericity derive from the
+interactions between polymorphic types and mutation. A simple example
+appears when typing the following expression
+\begin{caml_example}{toplevel}
+let store = ref None ;;
+\end{caml_example}
+Since the type of "None" is "'a option" and the function "ref" has type
+"'b -> 'b ref", a natural deduction for the type of "store" would be
+"'a option ref". However, the inferred type, "'_weak1 option ref", is
+different. Type variables whose name starts with a "_weak" prefix like
+"'_weak1" are weakly polymorphic type variables, sometimes shortened as
+weak type variables.
+A weak type variable is a placeholder for a single type that is currently
+unknown. Once the specific type "t" behind the placeholder type "'_weak1"
+is known, all occurrences of "'_weak1" will be replaced by "t". For instance,
+we can define another option reference and store an "int" inside:
+\begin{caml_example}{toplevel}
+let another_store = ref None ;;
+another_store := Some 0;
+another_store ;;
+\end{caml_example}
+After storing an "int" inside "another_store", the type of "another_store" has
+been updated from "'_weak2 option ref" to "int option ref".
+This distinction between weakly and generic polymorphic type variable protects
+OCaml programs from unsoundness and runtime errors. To understand from where
+unsoundness might come, consider this simple function which swaps a value "x"
+with the value stored inside a "store" reference, if there is such value:
+\begin{caml_example}{toplevel}
+let swap store x = match !store with
+  | None -> store := Some x; x
+  | Some y -> store := Some x; y;;
+\end{caml_example}
+We can apply this function to our store
+\begin{caml_example}{toplevel}
+let one = swap store 1
+let one_again = swap store 2
+let two = swap store 3;;
+\end{caml_example}
+After these three swaps the stored value is "3". Everything is fine up to
+now. We can then try to swap "3" with a more interesting value, for
+instance a function:
+\begin{caml_example}{toplevel}[error]
+let error = swap store (fun x -> x);;
+\end{caml_example}
+At this point, the type checker rightfully complains that it is not
+possible to swap an integer and a function, and that an "int" should always
+be traded for another "int". Furthermore, the type checker prevents us to
+change manually the type of the value stored by "store":
+\begin{caml_example}{toplevel}[error]
+store := Some (fun x -> x);;
+\end{caml_example}
+Indeed, looking at the type of store, we see that the weak type "'_weak1" has
+been replaced by the type "int"
+\begin{caml_example}{toplevel}
+store;;
+\end{caml_example}
+Therefore, after placing an "int" in "store", we cannot use it to store any
+value other than an "int". More generally, weak types protect the program from
+undue mutation of values with a polymorphic type.
+
+%todo: fix indentation in manual.pdf
+Moreover, weak types cannot appear in the signature of toplevel modules:
+types must be known at compilation time. Otherwise, different compilation
+units could replace the weak type with different and incompatible types.
+For this reason, compiling the following small piece of code
+\begin{verbatim}
+let option_ref = ref None
+\end{verbatim}
+yields a compilation error
+\begin{verbatim}
+Error: The type of this expression, '_weak1 option ref,
+       contains type variables that cannot be generalized
+\end{verbatim}
+To solve this error, it is enough to add an explicit type annotation to
+specify the type at declaration time:
+\begin{verbatim}
+let option_ref: int option ref = ref None
+\end{verbatim}
+This is in any case a good practice for such global mutable variables.
+Otherwise, they will pick out the type of first use. If there is a mistake
+at this point, this can result in confusing type errors when later, correct
+uses are flagged as errors.
+
+\subsection{ss:valuerestriction}{The value restriction}
+
+Identifying the exact context in which polymorphic types should be
+replaced by weak types in a modular way is a difficult question. Indeed
+the type system must handle the possibility that functions may hide persistent
+mutable states. For instance, the following function uses an internal reference
+to implement a delayed identity function
+\begin{caml_example}{toplevel}
+let make_fake_id () =
+  let store = ref None in
+  fun x -> swap store x ;;
+let fake_id = make_fake_id();;
+\end{caml_example}
+It would be unsound to apply this "fake_id" function to values with different
+types. The function "fake_id" is therefore rightfully assigned the type
+"'_weak3 -> '_weak3" rather than "'a -> 'a". At the same time, it ought to
+be possible to use a local mutable state without impacting the type of a
+function.
+%todo: add an example?
+
+To circumvent these dual difficulties, the type checker considers that any value
+returned by a function might rely on persistent mutable states behind the scene
+and should be given a weak type. This restriction on the type of mutable
+values and the results of function application is called the value restriction.
+Note that this value restriction is conservative: there are situations where the
+value restriction is too cautious and gives a weak type to a value that could be
+safely generalized to a polymorphic type:
+\begin{caml_example}{toplevel}
+let not_id = (fun x -> x) (fun x -> x);;
+\end{caml_example}
+Quite often, this happens when defining function using higher order function.
+To avoid this problem, a solution is to add an explicit argument to the
+function:
+\begin{caml_example}{toplevel}
+let id_again = fun x -> (fun x -> x) (fun x -> x) x;;
+\end{caml_example}
+With this argument, "id_again" is seen as a function definition by the type
+checker and can therefore be generalized. This kind of manipulation is called
+eta-expansion in lambda calculus and is sometimes referred under this name.
+
+\subsection{ss:relaxed-value-restriction}{The relaxed value restriction}
+
+There is another partial solution to the problem of unnecessary weak type,
+which is implemented directly within the type checker. Briefly, it is possible
+to prove that weak types that only appear as type parameters in covariant
+positions --also called positive positions-- can be safely generalized to
+polymorphic types. For instance, the type "'a list" is covariant in "'a":
+\begin{caml_example}{toplevel}
+  let f () = [];;
+  let empty = f ();;
+\end{caml_example}
+Remark that the type inferred for "empty" is "'a list" and not "'_weak5 list"
+that should have occurred with the value restriction since "f ()" is a
+function application.
+
+The value restriction combined with this generalization for covariant type
+parameters is called the relaxed value restriction.
+
+%question: is here the best place for describing variance?
+\subsection{ss:variance-and-value-restriction}{Variance and value restriction}
+Variance describes how type constructors behave with respect to subtyping.
+Consider for instance a pair of type "x" and "xy" with "x" a subtype of "xy",
+denoted "x :> xy":
+\begin{caml_example}{toplevel}
+  type x = [ `X ];;
+  type xy = [ `X | `Y ];;
+\end{caml_example}
+As "x" is a subtype of "xy", we can convert a value of type "x"
+to a value of type "xy":
+\begin{caml_example}{toplevel}
+  let x:x = `X;;
+  let x' = ( x :> xy);;
+\end{caml_example}
+Similarly, if we have a value of type "x list", we can convert it to a value
+of type "xy list", since we could convert each element one by one:
+\begin{caml_example}{toplevel}
+  let l:x list = [`X; `X];;
+  let l' = ( l :> xy list);;
+\end{caml_example}
+In other words, "x :> xy" implies that "x list :> xy list", therefore
+the type constructor "'a list" is covariant (it preserves subtyping)
+in its parameter "'a".
+
+Contrarily, if we have a function that can handle values of type "xy"
+\begin{caml_example}{toplevel}
+  let f: xy -> unit = function
+  | `X -> ()
+  | `Y -> ();;
+\end{caml_example}
+it can also handle values of type "x":
+\begin{caml_example}{toplevel}
+  let f' = (f :> x -> unit);;
+\end{caml_example}
+Note that we can rewrite the type of "f" and "f'" as
+\begin{caml_example}{toplevel}
+  type 'a proc = 'a -> unit
+  let f' = (f: xy proc :> x proc);;
+\end{caml_example}
+In this case, we have "x :> xy" implies "xy proc :> x proc". Notice
+that the second subtyping relation reverse the order of "x" and "xy":
+the type constructor "'a proc" is contravariant in its parameter "'a".
+More generally, the function type constructor "'a -> 'b" is covariant in
+its return type "'b" and contravariant in its argument type "'a".
+
+A type constructor can also be invariant in some of its type parameters,
+neither covariant nor contravariant. A typical example is a reference:
+\begin{caml_example}{toplevel}
+  let x: x ref = ref `X;;
+\end{caml_example}
+If we were able to coerce "x" to the type "xy ref" as a variable "xy",
+we could use "xy" to store the value "`Y" inside the reference and then use
+the "x" value to read this content as a value of type "x",
+which would break the type system.
+
+More generally, as soon as a type variable appears in a position describing
+mutable state it becomes invariant. As a corollary, covariant variables will
+never denote mutable locations and can be safely generalized.
+For a better description, interested readers can consult the original
+article by Jacques Garrigue on
+\url{http://www.math.nagoya-u.ac.jp/~garrigue/papers/morepoly-long.pdf}
+
+Together, the relaxed value restriction and type parameter covariance
+help to avoid eta-expansion in many situations.
+
+\subsection{ss:variance:abstract-data-types}{Abstract data types}
+Moreover, when the type definitions are exposed, the type checker
+is able to infer variance information on its own and one can benefit from
+the relaxed value restriction even unknowingly. However, this is not the case
+anymore when defining new abstract types. As an illustration, we can define a
+module type collection as:
+\begin{caml_example}{toplevel}
+module type COLLECTION = sig
+  type 'a t
+  val empty: unit -> 'a t
+end
+
+module Implementation = struct
+  type 'a t = 'a list
+  let empty ()= []
+end;;
+
+module List2: COLLECTION = Implementation;;
+\end{caml_example}
+
+In this situation, when coercing the module "List2" to the module type
+"COLLECTION", the type checker forgets that "'a List2.t" was covariant
+in "'a". Consequently, the relaxed value restriction does not apply anymore:
+
+\begin{caml_example}{toplevel}
+  List2.empty ();;
+\end{caml_example}
+
+To keep the relaxed value restriction, we need to declare the abstract type
+"'a COLLECTION.t" as covariant in "'a":
+\begin{caml_example}{toplevel}
+module type COLLECTION = sig
+  type +'a t
+  val empty: unit -> 'a t
+end
+
+module List2: COLLECTION = Implementation;;
+\end{caml_example}
+
+We then recover polymorphism:
+
+\begin{caml_example}{toplevel}
+  List2.empty ();;
+\end{caml_example}
+
+\section{s:polymorphic-recursion}{Polymorphic recursion}
+
+The second major class of non-genericity is directly related to the problem
+of type inference for polymorphic functions. In some circumstances, the type
+inferred by OCaml might be not general enough to allow the definition of
+some recursive functions, in particular for recursive function acting on
+non-regular algebraic data type.
+
+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[]] ];;
+\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 classic recursive function
+\begin{caml_example}{toplevel}
+  let rec maximal_depth = function
+  | List _ -> 1
+  | Nested [] -> 0
+  | Nested (a::q) -> 1 + max (maximal_depth a) (maximal_depth (Nested q));;
+\end{caml_example}
+
+Non-regular recursive algebraic data types correspond to polymorphic algebraic
+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;;
+\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
+"k". As a first try, we may define
+\begin{caml_example}{toplevel}[error]
+let rec depth = function
+  | List _ -> 1
+  | Nested n -> 1 + depth n;;
+\end{caml_example}
+The type error here comes from the fact that during the definition of "depth",
+the type checker first assigns to "depth" the type "'a -> 'b ".
+When typing the pattern matching, "'a -> 'b" becomes "'a nested -> 'b", then
+"'a nested -> int" once the "List" branch is typed.
+However, when typing the application "depth n" in the "Nested" branch,
+the type checker encounters a problem: "depth n" is applied to
+"'a list nested", it must therefore have the type
+"'a list nested -> 'b". Unifying this constraint with the previous one
+leads to the impossible constraint "'a list nested = 'a nested".
+In other words, within its definition, the recursive function "depth" is
+applied to values of type "'a t" with different types "'a" due to the
+non-regularity of the type constructor "nested". This creates a problem because
+the type checker had introduced a new type variable "'a" only at the
+\emph{definition} of the function "depth" whereas, here, we need a
+different type variable for every \emph{application} of the function "depth".
+
+\subsection{ss:explicit-polymorphism}{Explicitly polymorphic annotations}
+The solution of this conundrum is to use an explicitly polymorphic type
+annotation for the type "'a":
+\begin{caml_example}{toplevel}
+let rec depth: 'a. 'a nested -> int = function
+  | List _ -> 1
+  | Nested n -> 1 + depth n;;
+depth ( Nested(List [ [7]; [8] ]) );;
+\end{caml_example}
+In the type of "depth",  "'a.'a nested -> int", the type variable "'a"
+is universally quantified. In other words, "'a.'a nested -> int" reads as
+``for all type "'a", "depth" maps "'a nested" values to integers''.
+Whereas the standard type "'a nested -> int" can be interpreted
+as ``let be a type variable "'a", then "depth" maps "'a nested" values
+to integers''. There are two major differences with these two type
+expressions. First, the explicit polymorphic annotation indicates to the
+type checker that it needs to introduce a new type variable every times
+the function "depth" is applied. This solves our problem with the definition
+of the function "depth".
+
+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;;
+\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;;
+\end{caml_example}
+
+An important remark here is that it is not needed to explicit fully
+the type of "depth": it is sufficient to add annotations only for the
+universally quantified type variables:
+\begin{caml_example}{toplevel}
+let rec depth: 'a. 'a nested -> _ = function
+  | List _ -> 1
+  | Nested n -> 1 + depth n;;
+depth ( Nested(List [ [7]; [8] ]) );;
+\end{caml_example}
+
+%todo: add a paragraph on the interaction with locally abstract type
+
+\subsection{ss:recursive-poly-examples}{More examples}
+With explicit polymorphic annotations, it becomes possible to implement
+any recursive function that depends only on the structure of the nested
+lists and not on the type of the elements. For instance, a more complex
+example would be to compute the total number of elements of the nested
+lists:
+\begin{caml_example}{toplevel}
+  let len nested =
+    let map_and_sum f = List.fold_left (fun acc x -> acc + f x) 0 in
+    let rec len: 'a. ('a list -> int ) -> 'a nested -> int =
+    fun nested_len n ->
+      match n with
+      | List l -> nested_len l
+      | Nested n -> len (map_and_sum nested_len) n
+    in
+  len List.length nested;;
+len (Nested(Nested(List [ [ [1;2]; [3] ]; [ []; [4]; [5;6;7]]; [[]] ])));;
+\end{caml_example}
+
+Similarly, it may be necessary to use more than one explicitly
+polymorphic type variables, like for computing the nested list of
+list lengths of the nested list:
+\begin{caml_example}{toplevel}
+let shape n =
+  let rec shape: 'a 'b. ('a nested -> int nested) ->
+    ('b list list -> 'a list) -> 'b nested -> int nested
+    = fun nest nested_shape ->
+      function
+      | List l -> raise
+       (Invalid_argument "shape requires nested_list of depth greater than 1")
+      | Nested (List l) -> nest @@ List (nested_shape l)
+      | Nested n ->
+        let nested_shape = List.map nested_shape in
+        let nest x = nest (Nested x) in
+        shape nest nested_shape n in
+  shape (fun n -> n ) (fun l -> List.map List.length l ) n;;
+
+shape (Nested(Nested(List [ [ [1;2]; [3] ]; [ []; [4]; [5;6;7]]; [[]] ])));;
+\end{caml_example}
+
+\section{s:higher-rank-poly}{Higher-rank polymorphic functions}
+
+Explicit polymorphic annotations are however not sufficient to cover all
+the cases where the inferred type of a function is less general than
+expected. A similar problem arises when using polymorphic functions as arguments
+of higher-order functions. For instance, we may want to compute the average
+depth or length of two nested lists:
+\begin{caml_example}{toplevel}
+  let average_depth x y = (depth x + depth y) / 2;;
+  let average_len x y = (len x + len y) / 2;;
+  let one = average_len (List [2]) (List [[]]);;
+\end{caml_example}
+It would be natural to factorize these two definitions as:
+\begin{caml_example}{toplevel}
+    let average f x y = (f x + f y) / 2;;
+\end{caml_example}
+However, the type of "average len" is less generic than the type of
+"average_len", since it requires the type of the first and second argument to
+be the same:
+\begin{caml_example}{toplevel}
+  average_len (List [2]) (List [[]]);;
+  average len (List [2]) (List [[]])[@@expect error];;
+\end{caml_example}
+
+As previously with polymorphic recursion, the problem stems from the fact that
+type variables are introduced only at the start of the "let" definitions. When
+we compute both "f x" and "f y", the type of "x" and "y" are unified together.
+To avoid this unification, we need to indicate to the type checker
+that f is polymorphic in its first argument. In some sense, we would want
+"average" to have type
+\begin{verbatim}
+val average: ('a. 'a nested -> int) -> 'a nested -> 'b nested -> int
+\end{verbatim}
+Note that this syntax is not valid within OCaml: "average" has an universally
+quantified type "'a" inside the type of one of its argument whereas for
+polymorphic recursion the universally quantified type was introduced before
+the rest of the type. This position of the universally quantified type means
+that "average" is a second-rank polymorphic function. This kind of higher-rank
+functions is not directly supported by OCaml: type inference for second-rank
+polymorphic function and beyond is undecidable; therefore using this kind of
+higher-rank functions requires to handle manually these universally quantified
+types.
+
+In OCaml, there are two ways to introduce this kind of explicit universally
+quantified types: universally quantified record fields,
+\begin{caml_example}{toplevel}
+  type 'a nested_reduction = { f:'elt. 'elt nested -> 'a };;
+  let boxed_len = { f = len };;
+\end{caml_example}
+and universally quantified object methods:
+\begin{caml_example}{toplevel}
+  let obj_len = object method f:'a. 'a nested -> 'b = len end;;
+\end{caml_example}
+To solve our problem, we can therefore use either the record solution:
+\begin{caml_example}{toplevel}
+  let average nsm x y = (nsm.f x + nsm.f y) / 2 ;;
+\end{caml_example}
+or the object one:
+\begin{caml_example}{toplevel}
+  let average (obj: _ > ) x y = (obj#f x + obj#f y) / 2 ;;
+\end{caml_example}
diff --git a/manual/styles/altindex.sty b/manual/styles/altindex.sty
new file mode 100644
index 00000000..d236e714
--- /dev/null
+++ b/manual/styles/altindex.sty
@@ -0,0 +1,39 @@
+%% An attempt to have several index files
+%%
+%% Defines      \altindex{filename}{word to index}
+%% and          \makealtindex{filename}
+%%
+%% It is possible to define a macro for each index as follows:
+%%              \newcommand{\myindex}{\altindex{myindexfile}}
+%%
+%% This code is not really clean, there are still a number of things
+%% that I don't understand... but it works.
+
+%% \makealtindex{filename} opens filename.idx for writing.
+
+\def\makealtindex#1{\if@filesw
+  \expandafter\newwrite\csname @#1altindexfile\endcsname
+  \immediate\openout\expandafter\csname @#1altindexfile\endcsname=#1.idx
+  \typeout{Writing alternate index file #1.idx}\fi}
+
+%% \@wraltindex makes the assumes that a trailing `\fi' will get bound
+%% to #2. So, it `eats' it as second parameter and reinserts it.
+%% Quick and dirty, I know...
+%% Writes the index entry #3 into #1.
+
+\def\@wraltindex#1#2#3{\let\thepage\relax
+   \xdef\@gtempa{\write#1{\string
+      \indexentry{#3}{\thepage}}}\fi\endgroup\@gtempa
+   \if@nobreak \ifvmode\nobreak\fi\fi\@esphack}
+
+%% \altindex{filename}{index entry} does nothing if
+%% \@altindexfile is \relax (i.e. filename.idx not open).
+%% Otherwise, writes the index entry, and closes the whole stuff (some
+%% groups, and some \if).
+
+\def\altindex#1{\@bsphack\begingroup
+   \def\protect##1{\string##1\space}\@sanitize
+   \@ifundefined{@#1altindexfile}%
+          {\endgroup\@esphack}%
+          {\@wraltindex{\expandafter\csname @#1altindexfile\endcsname}}
+}
diff --git a/manual/styles/doc.tfm b/manual/styles/doc.tfm
new file mode 100644
index 0000000000000000000000000000000000000000..d010f29eddf7b88418cd59ffefac0d790ae182ea
GIT binary patch
literal 772
zcmb7?ze)o^5XQgF!MVvnJc5mKK7gI&1#Ltlq>+Pg2x5`iE?Q_In8LWQ+CIgmAb--sDrtDil2?}5N|
z=0m8HZW2?XzT^|%e;Sd0jW{M2M7v6j^!}_fdbD3wEuBx^!peCq8f9quyFQDD``Dkr
z9wu3zrs5=*)PJAfr5}KYp1ZQD?n5~H*Kor=+>>{>{Uhjj6?)?Zx^)5Fn}B|5Ko2L8
zFP4$-1Squ5;ROxuH=mDpW_WgMOle?@`2wh4#Wf;^+MR{!Od}V*!U?wE9G1DKSx1o=
S=h)uE-`=sYJ)7=Dcl!ny2aYrV

literal 0
HcmV?d00001

diff --git a/manual/styles/docbf.tfm b/manual/styles/docbf.tfm
new file mode 100644
index 0000000000000000000000000000000000000000..d010f29eddf7b88418cd59ffefac0d790ae182ea
GIT binary patch
literal 772
zcmb7?ze)o^5XQgF!MVvnJc5mKK7gI&1#Ltlq>+Pg2x5`iE?Q_In8LWQ+CIgmAb--sDrtDil2?}5N|
z=0m8HZW2?XzT^|%e;Sd0jW{M2M7v6j^!}_fdbD3wEuBx^!peCq8f9quyFQDD``Dkr
z9wu3zrs5=*)PJAfr5}KYp1ZQD?n5~H*Kor=+>>{>{Uhjj6?)?Zx^)5Fn}B|5Ko2L8
zFP4$-1Squ5;ROxuH=mDpW_WgMOle?@`2wh4#Wf;^+MR{!Od}V*!U?wE9G1DKSx1o=
S=h)uE-`=sYJ)7=Dcl!ny2aYrV

literal 0
HcmV?d00001

diff --git a/manual/styles/docit.tfm b/manual/styles/docit.tfm
new file mode 100644
index 0000000000000000000000000000000000000000..d010f29eddf7b88418cd59ffefac0d790ae182ea
GIT binary patch
literal 772
zcmb7?ze)o^5XQgF!MVvnJc5mKK7gI&1#Ltlq>+Pg2x5`iE?Q_In8LWQ+CIgmAb--sDrtDil2?}5N|
z=0m8HZW2?XzT^|%e;Sd0jW{M2M7v6j^!}_fdbD3wEuBx^!peCq8f9quyFQDD``Dkr
z9wu3zrs5=*)PJAfr5}KYp1ZQD?n5~H*Kor=+>>{>{Uhjj6?)?Zx^)5Fn}B|5Ko2L8
zFP4$-1Squ5;ROxuH=mDpW_WgMOle?@`2wh4#Wf;^+MR{!Od}V*!U?wE9G1DKSx1o=
S=h)uE-`=sYJ)7=Dcl!ny2aYrV

literal 0
HcmV?d00001

diff --git a/manual/styles/docmi.tfm b/manual/styles/docmi.tfm
new file mode 100644
index 0000000000000000000000000000000000000000..d010f29eddf7b88418cd59ffefac0d790ae182ea
GIT binary patch
literal 772
zcmb7?ze)o^5XQgF!MVvnJc5mKK7gI&1#Ltlq>+Pg2x5`iE?Q_In8LWQ+CIgmAb--sDrtDil2?}5N|
z=0m8HZW2?XzT^|%e;Sd0jW{M2M7v6j^!}_fdbD3wEuBx^!peCq8f9quyFQDD``Dkr
z9wu3zrs5=*)PJAfr5}KYp1ZQD?n5~H*Kor=+>>{>{Uhjj6?)?Zx^)5Fn}B|5Ko2L8
zFP4$-1Squ5;ROxuH=mDpW_WgMOle?@`2wh4#Wf;^+MR{!Od}V*!U?wE9G1DKSx1o=
S=h)uE-`=sYJ)7=Dcl!ny2aYrV

literal 0
HcmV?d00001

diff --git a/manual/styles/docrm.tfm b/manual/styles/docrm.tfm
new file mode 100644
index 0000000000000000000000000000000000000000..d010f29eddf7b88418cd59ffefac0d790ae182ea
GIT binary patch
literal 772
zcmb7?ze)o^5XQgF!MVvnJc5mKK7gI&1#Ltlq>+Pg2x5`iE?Q_In8LWQ+CIgmAb--sDrtDil2?}5N|
z=0m8HZW2?XzT^|%e;Sd0jW{M2M7v6j^!}_fdbD3wEuBx^!peCq8f9quyFQDD``Dkr
z9wu3zrs5=*)PJAfr5}KYp1ZQD?n5~H*Kor=+>>{>{Uhjj6?)?Zx^)5Fn}B|5Ko2L8
zFP4$-1Squ5;ROxuH=mDpW_WgMOle?@`2wh4#Wf;^+MR{!Od}V*!U?wE9G1DKSx1o=
S=h)uE-`=sYJ)7=Dcl!ny2aYrV

literal 0
HcmV?d00001

diff --git a/manual/styles/doctt.tfm b/manual/styles/doctt.tfm
new file mode 100644
index 0000000000000000000000000000000000000000..d010f29eddf7b88418cd59ffefac0d790ae182ea
GIT binary patch
literal 772
zcmb7?ze)o^5XQgF!MVvnJc5mKK7gI&1#Ltlq>+Pg2x5`iE?Q_In8LWQ+CIgmAb--sDrtDil2?}5N|
z=0m8HZW2?XzT^|%e;Sd0jW{M2M7v6j^!}_fdbD3wEuBx^!peCq8f9quyFQDD``Dkr
z9wu3zrs5=*)PJAfr5}KYp1ZQD?n5~H*Kor=+>>{>{Uhjj6?)?Zx^)5Fn}B|5Ko2L8
zFP4$-1Squ5;ROxuH=mDpW_WgMOle?@`2wh4#Wf;^+MR{!Od}V*!U?wE9G1DKSx1o=
S=h)uE-`=sYJ)7=Dcl!ny2aYrV

literal 0
HcmV?d00001

diff --git a/manual/styles/fullpage.sty b/manual/styles/fullpage.sty
new file mode 100644
index 00000000..6ecbeb76
--- /dev/null
+++ b/manual/styles/fullpage.sty
@@ -0,0 +1,2 @@
+\marginparwidth 0pt \oddsidemargin 0pt \evensidemargin 0pt \marginparsep 0pt
+\topmargin 0pt \textwidth 6.5in \textheight 8.5 in 
diff --git a/manual/styles/html.sty b/manual/styles/html.sty
new file mode 100644
index 00000000..137fdf16
--- /dev/null
+++ b/manual/styles/html.sty
@@ -0,0 +1,222 @@
+% LaTeX2HTML Version 0.6.4 : html.sty
+%
+% This file contains definitions of LaTeX commands which are
+% processed in a special way by the translator. 
+% For example, there are commands for embedding external hypertext links,
+% for cross-references between documents or for including
+% raw HTML.
+% This file includes the comments.sty file v2.0 by Victor Eijkhout
+% In most cases these commands do nothing when processed by LaTeX.
+
+% Modifications:
+%
+%  nd = Nikos Drakos 
+%  jz = Jelle van Zeijl 
+
+% jz 22-APR-94 - Added support for htmlref
+% nd  - Created
+
+
+
+% Exit if the style file is already loaded
+% (suggested by Lee Shombert 
+\ifx \htmlstyloaded\relax \endinput\else\let\htmlstyloaded\relax\fi
+
+%%% LINKS TO EXTERNAL DOCUMENTS
+%
+% This can be used to provide links to arbitrary documents.
+% The first argumment should be the text that is going to be
+% highlighted and the second argument a URL.
+% The hyperlink will appear as a hyperlink in the HTML 
+% document and as a footnote in the dvi or ps files.
+%
+\newcommand{\htmladdnormallinkfoot}[2]{ #1\footnote{#2}} 
+
+% This is an alternative definition of the command above which
+% will ignore the URL in the dvi or ps files.
+\newcommand{\htmladdnormallink}[2]{ #1 }
+
+% This command takes as argument a URL pointing to an image.
+% The image will be embedded in the HTML document but will
+% be ignored in the dvi and ps files.
+%
+\newcommand{\htmladdimg}[1]{ }
+
+%%% CROSS-REFERENCES BETWEEN (LOCAL OR REMOTE) DOCUMENTS
+%
+% This can be used to refer to symbolic labels in other Latex 
+% documents that have already been processed by the translator.
+% The arguments should be:
+% #1 : the URL to the directory containing the external document
+% #2 : the path to the labels.pl file of the external document.
+% If the external document lives on a remote machine then labels.pl 
+% must be copied on the local machine.
+%
+%e.g. \externallabels{http://cbl.leeds.ac.uk/nikos/WWW/doc/tex2html/latex2html}
+%                    {/usr/cblelca/nikos/tmp/labels.pl}
+% The arguments are ignored in the dvi and ps files.
+%
+\newcommand{\externallabels}[2]{ }
+
+% This complements the \externallabels command above. The argument
+% should be a label defined in another latex document and will be
+% ignored in the dvi and ps files.
+%
+\newcommand{\externalref}[1]{ }
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Comment.sty   version 2.0, 19 June 1992
+% selectively in/exclude pieces of text: the user can define new
+% comment versions, and each is controlled separately.
+% This style can be used with plain TeX or LaTeX, and probably
+% most other packages too.
+%
+% Examples of use in LaTeX and TeX follow \endinput
+%
+% Author
+%    Victor Eijkhout
+%    Department of Computer Science
+%    University Tennessee at Knoxville
+%    104 Ayres Hall
+%    Knoxville, TN 37996
+%    USA
+%
+%    eijkhout@cs.utk.edu
+%
+% Usage: all text included in between
+%    \comment ... \endcomment
+% or \begin{comment} ... \end{comment}
+% is discarded. The closing command should appear on a line
+% of its own. No starting spaces, nothing after it.
+% This environment should work with arbitrary amounts
+% of comment.
+%
+% Other 'comment' environments are defined by
+% and are selected/deselected with
+% \includecomment{versiona}
+% \excludecoment{versionb}
+%
+% These environments are used as
+% \versiona ... \endversiona
+% or \begin{versiona} ... \end{versiona}
+% with the closing command again on a line of its own.
+%
+% Basic approach:
+% to comment something out, scoop up  every line in verbatim mode
+% as macro argument, then throw it away.
+% For inclusions, both the opening and closing comands
+% are defined as noop
+%
+% Changed \next to \html@next to prevent clashes with other sty files
+% (mike@emn.fr)
+% Changed \html@next to \htmlnext so the \makeatletter and
+% \makeatother commands could be removed (they were causing other
+% style files - changebar.sty - to crash) (nikos@cbl.leeds.ac.uk)
+
+
+\def\makeinnocent#1{\catcode`#1=12 }
+\def\csarg#1#2{\expandafter#1\csname#2\endcsname}
+
+\def\ThrowAwayComment#1{\begingroup
+    \def\CurrentComment{#1}%
+    \let\do\makeinnocent \dospecials
+    \makeinnocent\^^L% and whatever other special cases
+    \endlinechar`\^^M \catcode`\^^M=12 \xComment}
+{\catcode`\^^M=12 \endlinechar=-1 %
+ \gdef\xComment#1^^M{\def\test{#1}
+      \csarg\ifx{PlainEnd\CurrentComment Test}\test
+          \let\htmlnext\endgroup
+      \else \csarg\ifx{LaLaEnd\CurrentComment Test}\test
+            \edef\htmlnext{\endgroup\noexpand\end{\CurrentComment}}
+      \else \let\htmlnext\xComment
+      \fi \fi \htmlnext}
+}
+
+\def\includecomment
+ #1{\expandafter\def\csname#1\endcsname{}%
+    \expandafter\def\csname end#1\endcsname{}}
+\def\excludecomment
+ #1{\expandafter\def\csname#1\endcsname{\ThrowAwayComment{#1}}%
+    {\escapechar=-1\relax
+     \csarg\xdef{PlainEnd#1Test}{\string\\end#1}%
+     \csarg\xdef{LaLaEnd#1Test}{\string\\end\string\{#1\string\}}%
+    }}
+
+\excludecomment{comment}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% RAW HTML 
+% 
+% Enclose raw HTML between a \begin{rawhtml} and \end{rawhtml}.
+% The html environment ignores its body
+%
+\excludecomment{rawhtml}
+
+%%% HTML ONLY
+%
+% Enclose LaTeX constructs which will only appear in the 
+% HTML output and will be ignored by LaTeX with 
+% \begin{htmlonly} and \end{htmlonly}
+%
+\excludecomment{htmlonly}
+
+%%% LaTeX ONLY
+% Enclose LaTeX constructs which will only appear in the 
+% DVI output and will be ignored by latex2html with 
+%\begin{latexonly} and \end{latexonly}
+%
+\newenvironment{latexonly}{}{}
+
+%%% HYPERREF 
+% Suggested by Eric M. Carol 
+% Similar to \ref but accepts conditional text. 
+% The first argument is HTML text which will become ``hyperized''
+% (underlined).
+% The second and third arguments are text which will appear only in the paper
+% version (DVI file), enclosing the fourth argument which is a reference to a label.
+%
+%e.g. \hyperref{using the tracer}{using the tracer (see Section}{)}{trace}
+% where there is a corresponding \label{trace}
+%
+\newcommand{\hyperref}[4]{#2\ref{#4}#3}
+
+%%% HTMLREF
+% Reference in HTML version only.
+% Mix between \htmladdnormallink and \hyperref.
+% First arg is text for in both versions, second is label for use in HTML
+% version.
+\newcommand{\htmlref}[2]{#1}
+
+%%% HTMLIMAGE
+% This command can be used inside any environment that is converted
+% into an inlined image (eg a "figure" environment) in order to change
+% the way the image will be translated. The argument of \htmlimage
+% is really a string of options separated by commas ie 
+% [scale=],[external],[thumbnail=
+% The scale option allows control over the size of the final image.
+% The ``external'' option will cause the image not to be inlined 
+% (images are inlined by default). External images will be accessible
+% via a hypertext link. 
+% The ``thumbnail'' option will cause a small inlined image to be 
+% placed in the caption. The size of the thumbnail depends on the
+% reduction factor. The use of the ``thumbnail'' option implies
+% the ``external'' option.
+%
+% Example:
+% \htmlimage{scale=1.5,external,thumbnail=0.2}
+% will cause a small thumbnail image 1/5th of the original size to be
+% placed in the final document, pointing to an external image 1.5
+% times bigger than the original.
+% 
+\newcommand{\htmlimage}[1]{}
+
+%%% HTMLADDTONAVIGATION
+% This command appends its argument to the buttons in the navigation
+% panel. It is ignored by LaTeX.
+%
+% Example:
+% \htmladdtonavigation{\htmladdnormallink
+%              {\htmladdimg{http://server/path/to/gif}}
+%              {http://server/path}}
+\newcommand{\htmladdtonavigation}[1]{}
diff --git a/manual/styles/isolatin.sty b/manual/styles/isolatin.sty
new file mode 100644
index 00000000..9a685097
--- /dev/null
+++ b/manual/styles/isolatin.sty
@@ -0,0 +1,174 @@
+% 1-Jun-1992
+%
+% File  bases on iso1ibm.tex  Version 1.0 of May, 9 1990
+\message{ISO-latin-1 input coding, version 0.9 of 1-Jun-1992.}
+%
+% For input of 8 bits character.
+% This allows reading ISO-8859 Latin-1 codes.
+%
+\chardef \atcode = \the \catcode `\@
+\catcode `\@ = 11
+%
+\catcode160=13  \def^^a0{{\bf?}}      % 160 '240, "a0
+\catcode161=13  \def^^a1{!`}          % 161 '241, "a1
+\catcode162=13  \def^^a2{{\bf?}}      % 162 '242, "a2
+\catcode163=13  \def^^a3{\pounds{}}   % 163 '243, "a3
+\catcode164=13  \def^^a4{{\bf?}}      % 164 '244, "a4
+\catcode165=13  \def^^a5{{\bf?}}      % 165 '245, "a5
+\catcode166=13  \def^^a6{$\vert$}        % 166 '246, "a6
+\catcode167=13  \def^^a7{\S{}}        % 167 '247, "a7   \S{} ISO-1, 
+\catcode168=13  \def^^a8{\"{ }}       % 168 '250, "a8
+\catcode169=13  \def^^a9{\copyright{}}% 169, '251, "a9
+\catcode170=13  \def^^aa{{\bf?}}      % 170 '252, "aa
+\catcode171=13                        % 171 '253, "ab, 
+\@ifundefined{lguill}{\def^^ab{$<<$}}{\def^^ab{\lguill}}     
+\catcode172=13  \def^^ac{{\bf?}}      % 172 '254, "ac
+\catcode173=13  \def^^ad{{\bf?}}      % 173 '255 "ad
+\catcode174=13  \def^^ae{{\bf?}}      % 174 '256, "ae
+\catcode175=13  \def^^af{{\bf?}}      % 175 '257, "af
+\catcode176=13  \def^^b0{{\bf?}}      % 176 '260, "b0  ?? \No
+\catcode177=13  \def^^b1{$\pm$}       % 177 '261, "b1  ISO-1 plus-minus  
+\catcode178=13  \def^^b2{${}^2$}      % 178, '262, "b2
+\catcode179=13  \def^^b3{${}^3$}      % 179, '263, "b3
+\catcode180=13  \def^^b4{\'{ }}       % 180, '264, "b4
+\catcode181=13  \def^^b5{{\bf?}}      % 181, '265, "b5
+\catcode182=13  \def^^b6{\P{}}        % 182, '266, "b6
+\catcode183=13  \def^^b7{$\cdot$}     % 183, '267, "b7
+\catcode184=13  \def^^b8{\c{ }}       % 184, '270, "b8
+\catcode185=13  \def^^b9{${}^1$}      % 185, '271, "b9
+\catcode186=13  \def^^ba{{\bf?}}      % 186, '272, "ba
+\catcode187=13                        % 187, '273, "bb 
+\@ifundefined{rguill}{\def^^bb{$>>$}}{\def^^bb{\rguill}}     
+\catcode188=13  \def^^bc{$\frac 1 4$}      % 188, '274, "bc
+\catcode189=13  \def^^bd{$\frac 1 2$}      % 189, '275, "bd
+\catcode190=13  \def^^be{$\frac 3 4$}      % 190, '276, "be
+\catcode191=13  \def^^bf{?`}          % 191, '277, "bf
+\catcode192=13  \def^^c0{\`A}         % 192, '300, "c0
+\@ifundefined{@grave@A@grave@}{\def^^c0{\`A}}{\let^^c0=\@grave@A@grave@}
+\catcode193=13  \def^^c1{\'A}         % 193, '301, "c1
+\@ifundefined{@acute@A@acute@}{\def^^c1{\'A}}{\let^^c1=\@acute@A@acute@}
+\catcode194=13  \def^^c2{\^A}         %  194, '302, "c2
+\@ifundefined{@circflx@A@circflx@}{\def^^c2{\^A}}{\let^^c2=\@circflx@A@circflx@}
+\catcode195=13  \def^^c3{\~A}     % 195, '303, "c3
+\@ifundefined{@tileda@A@tilda@}{\def^^c3{\~A}}{\let^^c3=\@tileda@A@tilda@}
+\catcode196=13  \def^^c4{\"A}     % 196, '304, "c4
+\@ifundefined{@Umlaut@A@Umlaut@}{\def^^c4{\"A}}{\let^^c4=\@Umlaut@A@Umlaut@}
+\catcode197=13  \def^^c5{\AA{}}   % 197, '305, "c5
+\@ifundefined{@A@A@}{\def^^c5{\AA{}}}{\let^^c5=\@A@A@}
+\catcode198=13 \def^^c6{\AE{}}    % 198, '306, "c6
+\@ifundefined{@A@E@}{\def^^c6{\AE{}}}{\let^^c6=\@A@E@}
+\catcode199=13  \def^^c7{\c{C}}   % 199, '307, "c7
+\@ifundefined{@cedilla@C@cedilla}{\def^^c7{\c{C}}}{\let^^c7=\@cedilla@C@cedilla}
+\catcode200=13  \def^^c8{\`E}     % 200, '310, "c8
+\@ifundefined{@grave@E@grave@}{\def^^c8{\`E}}{\let^^c8=\@grave@E@grave@}
+\catcode201=13  \def^^c9{\'E}     % 201, '311, "c9
+\@ifundefined{@acute@E@acute@}{\def^^c9{\'E}}{\let^^c9=\@acute@E@acute@}
+\catcode202=13  \def^^ca{\^E}     % 202, '312, "ca
+\@ifundefined{@circflx@E@circflx@}{\def^^ca{\^E}}{\let^^ca=\@circflx@E@circflx@}
+\catcode203=13  \def^^cb{{\"E}}   % 203, '313, "cb
+\@ifundefined{@Umlaut@E@Umlaut@}{\def^^cb{\"E}}{\let^^cb=\@Umlaut@E@Umlaut@}
+\catcode204=13  \def^^cc{\`I}     % 204, '314, "cc
+\@ifundefined{@grave@I@grave@}{\def^^cc{\`I}}{\let^^cc=\@grave@I@grave@}
+\catcode205=13  \def^^cd{\'I}     % 205, '315, "cd
+\@ifundefined{@acute@I@acute@}{\def^^cd{\'I}}{\let^^cd=\@acute@I@acute@}
+\catcode206=13  \def^^ce{\^I}     % 206, '316, "ce
+\@ifundefined{@circflx@I@circflx@}{\def^^ce{\^I}}{\let^^ce=\@circflx@I@circflx@}
+\catcode207=13  \def^^cf{{\"I}}   % 207, '317, "cf
+\@ifundefined{@Umlaut@I@Umlaut@}{\def^^cf{\"I}}{\let^^cf=\@Umlaut@I@Umlaut@}
+\catcode208=13  \def^^d0{\rlap{\raise0.3ex\hbox{--}}D}      % 208, '320, "d0
+\@ifundefined{@Eth@}{}{\let^^d0=\@Eth@}
+\catcode209=13  \def^^d1{¥}       % 209, '321, "d1
+\@ifundefined{@tileda@N@tilda@}{\def^^d1{\~N}}{\let^^d1\@tileda@N@tilda@}
+\catcode210=13  \def^^d2{\`O}     % 210, '322, "d2
+\@ifundefined{@grave@O@grave@}{\def^^d2{\`O}}{\let^^d2=\@grave@O@grave@}
+\catcode211=13  \def^^d3{\'O}     % 211, '323, "d3
+\@ifundefined{@acute@O@acute@}{\def^^d3{\'O}}{\let^^d3\@acute@O@acute@}
+\catcode212=13  \def^^d4{\^O}     % 212, '324, "d4
+\@ifundefined{@circflx@O@circflx@}{\def^^d4{\^O}}{\let^^d4=\@circflx@O@circflx@}
+\catcode213=13  \def^^d5{\~O}     % 213, '325, "d5
+\@ifundefined{@tileda@O@tilda@}{\def^^d5{\~O}}{\let^^d5\@tileda@O@tilda@}
+\catcode214=13  \def^^d6{\"O}     % 214, '326, "d6
+\@ifundefined{@Umlaut@O@Umlaut@}{\def^^d6{\"O}}{\let^^d6=\@Umlaut@O@Umlaut@}
+\catcode215=13  \def^^d7{$\times$}% 215, '327, "d7
+\catcode216=13  \def^^d8{\O{}}    % 216, '330, "d8
+\@ifundefined{@OOO@}{\def^^d8{\O{}}}{\let^^d8=\@OOO@}
+\catcode217=13  \def^^d9{\`U}     % 217, '331, "d9
+\@ifundefined{@grave@U@grave@}{\def^^d9{\`U}}{\let^^d9=\@grave@U@grave@}
+\catcode218=13  \def^^da{\'U}     % 218, '332, "da
+\@ifundefined{@acute@U@acute@}{\def^^da{\'U}}{\let^^da=\@acute@U@acute@}
+\catcode219=13  \def^^db{\^U}     % 219, '333, "db
+\@ifundefined{@circflx@U@circflx@}{\def^^db{\^U}}{\let^^db=\@circflx@U@circflx@}
+\catcode220=13  \def^^dc{\"U}     % 220, '334, "dc
+\@ifundefined{@Umlaut@U@Umlaut@}{\def^^dc{\"U}}{\let^^dc=\@Umlaut@U@Umlaut@}
+\catcode221=13  \def^^dd{{\'Y}}   % 221, '335, "dd
+\@ifundefined{@acute@Y@acute@}{\def^^dd{\'Y}}{\let^^dd=\@acute@Y@acute@}
+\catcode222=13  \def^^de{\lower 0.7ex \hbox{l}\hskip-1ex\relax b} % 222, '336, "de
+\@ifundefined{@Thorn@}{}{\let^^de=\@Thorn@}
+\catcode223=13  \def^^df{\ss{}}   % 223, '337, "df
+\@ifundefined{@sss@}{\def^^df{\ss{}}}{\let^^df=\@sss@}
+\catcode224=13  \def^^e0{\`a}     % 224, '340, "e0
+\@ifundefined{@grave@a@grave@}{\def^^e0{\`a}}{\let^^e0=\@grave@a@grave@}
+\catcode225=13  \def^^e1{\'a}     % 225, '341, "e1
+\@ifundefined{@acute@a@acute@}{\def^^e1{\'a}}{\let^^e1=\@acute@a@acute@}
+\catcode226=13  \def^^e2{\^a}     % 226, '342, "e2
+\@ifundefined{@circflx@a@circflx@}{\def^^e2{\^a}}{\let^^e2=\@circflx@a@circflx@}
+\catcode227=13  \def^^e3{\~a}     % 227, '343, "e3
+\@ifundefined{@tileda@a@tilda@}{\def^^e3{\~a}}{\let^^e3=\@tileda@a@tilda@}
+\catcode228=13  \def^^e4{\"a}     % 228, '344, "e4
+\@ifundefined{@Umlaut@a@Umlaut@}{\def^^e4{\"a}}{\let^^e4=\@Umlaut@a@Umlaut@}
+\catcode229=13  \def^^e5{\aa{}}   % 229, '345, "e5
+\@ifundefined{@a@a@}{\def^^e5{\aa{}}}{\let^^e5=\@a@a@}
+\catcode230=13  \def^^e6{\ae{}}   % 230, '346, "e6
+\@ifundefined{@a@e@}{\def^^e6{\ae{}}}{\let^^e6=\@a@e@}
+\catcode231=13  \def^^e7{\c{c}}   % 231, '347, "e7
+\@ifundefined{@cedilla@c@cedilla}{\def^^e7{\c{c}}}{\let^^e7=\@cedilla@c@cedilla}
+\catcode232=13  \def^^e8{\`e}     % 232, '350, "e8
+\@ifundefined{@grave@e@grave@}{\def^^e8{\`e}}{\let^^e8=\@grave@e@grave@}
+\catcode233=13  \def^^e9{\'e}     % 233, '351, "e9
+\@ifundefined{@acute@e@acute@}{\def^^e9{\'e}}{\let^^e9=\@acute@e@acute@}
+\catcode234=13  \def^^ea{\^e}     % 234, '352, "ea
+\@ifundefined{@circflx@e@circflx@}{\def^^ea{\^e}}{\let^^ea=\@circflx@e@circflx@}
+\catcode235=13  \def^^eb{\"e}     % 235, '353, "eb
+\@ifundefined{@Umlaut@e@Umlaut@}{\def^^eb{\"e}}{\let^^eb=\@Umlaut@e@Umlaut@}
+\catcode236=13  \def^^ec{\`{\i}}  % 236, '354, "ec
+\@ifundefined{@grave@i@grave@}{\def^^ec{\`{\i}}}{\let^^ec=\@grave@i@grave@}
+\catcode237=13  \def^^ed{\'{\i}}  % 237, '355, "ed
+\@ifundefined{@acute@i@acute@}{\def^^ed{\'{\i}}}{\let^^ed=\@acute@i@acute@}
+\catcode238=13  \def^^ee{\^{\i}}  % 238, '356, "ee
+\@ifundefined{@circflx@i@circflx@}{\def^^ee{\^{\i}}}{\let^^ee=\@circflx@i@circflx@}
+\catcode239=13  \def^^ef{\"{\i}}  % 239, '357, "ef
+\@ifundefined{@Umlaut@i@Umlaut@}{\def^^ef{\"{\i}}}{\let^^ef=\@Umlaut@i@Umlaut@}
+\catcode240=13  \def^^f0{$\partial$}      % 240, '360, "f0
+\@ifundefined{@eth@}{\def^^f0{$\partial$}}{\let^^f0=\@eth@}
+\catcode241=13  \def^^f1{\~n}     % 241, '361, "f1
+\@ifundefined{@tileda@n@tilda@}{\def^^f1{\~n}}{\let^^f1\@tileda@n@tilda@}
+\catcode242=13  \def^^f2{\`o}     % 242, '362, "f2
+\@ifundefined{@grave@o@grave@}{\def^^f2{\`o}}{\let^^f2=\@grave@o@grave@}
+\catcode243=13  \def^^f3{\'o}     % 243, '363, "f3
+\@ifundefined{@acute@o@acute@}{\def^^f3{\'o}}{\let^^f3\@acute@o@acute@}
+\catcode244=13  \def^^f4{\^o}     % 244, '364, "f4
+\@ifundefined{@circflx@o@circflx@}{\def^^f4{\^o}}{\let^^f4=\@circflx@o@circflx@}
+\catcode245=13  \def^^f5{\~o}     % 245, '365, "f5
+\@ifundefined{@tileda@o@tilda@}{\def^^f5{\~o}}{\let^^f5\@tileda@o@tilda@}
+\catcode246=13  \def^^f6{\"o}     % 246, '366, "f6
+\@ifundefined{@Umlaut@o@Umlaut@}{\def^^f6{\"o}}{\let^^f6=\@Umlaut@o@Umlaut@}
+\catcode247=13  \def^^f7{$\div$}   % 247, '367, "f7
+\catcode248=13  \def^^f8{\o{}}    % 248, '370, "f8
+\@ifundefined{@ooo@}{\def^^f8{\o{}}}{\let^^f8=\@ooo@}
+\catcode249=13  \def^^f9{\`u}     % 249, '371, "f9
+\@ifundefined{@grave@u@grave@}{\def^^f9{\`u}}{\let^^f9=\@grave@u@grave@}
+\catcode250=13  \def^^fa{\'u}     % 250, '372, "fa
+\@ifundefined{@acute@u@acute@}{\def^^fa{\'u}}{\let^^fa=\@acute@u@acute@}
+\catcode251=13  \def^^fb{\^u}     % 251, '373, "fb
+\@ifundefined{@circflx@u@circflx@}{\def^^fb{\^u}}{\let^^fb=\@circflx@u@circflx@}
+\catcode252=13  \def^^fc{\"u}     % 252, '374, "fc
+\@ifundefined{@Umlaut@u@Umlaut@}{\def^^fc{\"u}}{\let^^fc=\@Umlaut@u@Umlaut@}
+\catcode253=13  \def^^fd{\'y}     % 253, '375, "fd
+\@ifundefined{@acute@y@acute@}{\def^^fd{\'y}}{\let^^fd=\@acute@y@acute@}
+\catcode254=13  \def^^fe{\lower 0.8ex\hbox{l}\hskip-1ex\relax b} % 254, '376, "fe
+\@ifundefined{@thorn@}{}{\let^^fe=\@thorn@}
+\catcode255=13  \def^^ff{\"y}     % 255, '377, "ff
+\@ifundefined{@Umlaut@y@Umlaut@}{\def^^ff{\"y}}{\let^^ff=\@Umlaut@y@Umlaut@}
+\catcode `\@ = \the \atcode
+\endinput
+% End of iso-latin-1.tex
diff --git a/manual/styles/multicols.sty b/manual/styles/multicols.sty
new file mode 100644
index 00000000..2d945488
--- /dev/null
+++ b/manual/styles/multicols.sty
@@ -0,0 +1,176 @@
+% Save file as: MULTICOLS.STY          Source: FILESERV@SHSU.BITNET  
+% multicols.sty version 1.0
+% Allows for multiple column typesetting
+% From TUGboat, voulme 10 (1989), No. 3
+%
+% Frank Mittelback
+% Electronic Data Systems
+% (Deutschland) GmbH
+% Eisenstrasse 56
+% D-6090 Russelsheim
+% Federal Republic of Germany
+% Bitnet: pzf5hz@drueds2
+%
+% Variables:
+%   \premulticols - If the space left on the page is less than this, a new
+%         page is started before the multiple columns.  Otherwise, a \vskip
+%         of \multicolsep is added.
+%   \postmulticols - analogous to \premulticols
+%   \columnseprule - the width of the rule separating the columns.
+%
+% Commands:
+%   \raggedcolumns - don't align bottom lines of columns
+%   \flushcolumns  - align bottom lines (default)
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\@ifundefined{mult@cols}{}{\endinput}
+
+\def\multicols#1{\col@number#1\relax
+  \ifnum\col@number<\@ne
+     \@warning{Using '\number\col@number' columns doesn't seem a good idea.^^J
+             I therefore use two columns instead}%
+     \col@number\tw@ \fi
+  \@ifnextchar[\mult@cols{\mult@cols[]}}
+
+\def\mult@cols[#1]{\@ifnextchar[%
+  {\mult@@cols{#1}}%
+  {\mult@@cols{#1}[\premulticols]}}
+
+\def\mult@@cols#1[#2]{%
+  \enough@room#2%
+  #1\par\addvspace\multicolsep
+  \begingroup
+  \prepare@multicols\ignorespaces}
+
+\def\enough@room#1{\par \penalty\z@
+   \page@free \pagegoal
+   \advance \page@free -\pagetotal
+   \ifdim \page@free <#1\newpage \fi}
+
+\def\prepare@multicols{%
+  \output{\global\setbox\partial@page
+  		 \vbox{\unvbox\@cclv}}\eject
+  \vbadness9999 \hbadness5000
+  \tolerance\multicoltolerance
+  \doublecol@number\col@number
+  \multiply\doublecol@number\tw@
+  \advance\baselineskip\multicolbaselineskip
+  \advance\@colroom-\ht\partial@page
+  \vsize\col@number\@colroom
+  \advance\vsize\c@collectmore\baselineskip
+  \hsize\columnwidth \advance\hsize\columnsep
+  \advance\hsize-\col@number\columnsep
+  \divide\hsize\col@number
+  \linewidth\hsize
+  \output{\multi@columnout}%
+  \multiply\count\footins\col@number
+  \multiply\skip \footins\col@number
+  \reinsert@footnotes}
+
+\def\endmulticols{\par\penalty\z@
+  \output{\balance@columns}\eject
+  \endgroup \reinsert@footnotes
+  \global\c@unbalance\z@
+  \enough@room\postmulticols
+  \addvspace\multicolsep}
+
+\newcount\c@unbalance      \c@unbalance   = 0
+\newcount\c@collectmore    \c@collectmore = 0
+\newcount\col@number
+\newcount\doublecol@number
+\newcount\multicoltolerance \multicoltolerance = 9999
+\newdimen\page@free
+\newdimen\premulticols \premulticols = 50pt
+\newdimen\postmulticols \postmulticols = 20pt
+\newskip\multicolsep \multicolsep = 12pt plus 4pt minus 3pt
+\newskip\multicolbaselineskip \multicolbaselineskip=0pt
+\newbox\partial@page
+
+\def\process@cols#1#2{\count@#1\relax
+    \loop #2%
+    \advance\count@\tw@
+    \ifnum\count@<\doublecol@number
+  \repeat}
+
+\def\page@sofar{\unvbox\partial@page
+  \process@cols\z@{\wd\count@\hsize}%
+  \hbox to\textwidth{%
+    \process@cols\tw@{\box\count@
+      \hss\vrule\@width\columnseprule\hss}%
+    \box\z@}}
+
+\def\reinsert@footnotes{\ifvoid\footins\else
+	\insert\footins{\unvbox\footins}\fi}
+
+\def\multi@columnout{%
+  \ifnum\outputpenalty <-\@Mi
+     \speci@ls \else
+     \splittopskip\topskip
+     \splitmaxdepth\maxdepth
+     \dimen@\@colroom
+     \divide\skip\footins\col@number
+     \ifvoid\footins \else
+       \advance\dimen@-\skip\footins
+       \advance\dimen@-\ht\footins \fi
+     \process@cols\tw@{\setbox\count@
+        \vsplit\@cclv to\dimen@}%
+     \setbox\z@\vsplit\@cclv to\dimen@
+     \ifvoid\@cclv \else
+       \unvbox\@cclv
+       \penalty\outputpenalty
+       \fi
+     \setbox\@cclv\vbox{\page@sofar}%
+     \@makecol\@outputpage
+     \global\@colroom\@colht
+     \process@deferreds
+     \global\vsize\col@number\@colroom
+     \global\advance\vsize
+       \c@collectmore\baselineskip
+     \multiply\skip\footins\col@number\fi}
+
+\def\speci@ls{%
+  \typeout{floats and marginpars not allowed inside `multicols' environment}%
+  \unvbox\@cclv\reinsert@footnotes
+  \gdef\@currlist{}}
+
+\def\process@deferreds{%
+  \@floatplacement
+  \begingroup
+   \let\@tempb\@deferlist
+   \gdef\@deferlist{}%
+   \let\@elt\@scolelt
+   \@tempb \endgroup}
+
+\newif\ifshr@nking
+
+\def\raggedcolumns{%
+  \@bsphack\shr@nkingtrue\@esphack}
+\def\flushcolumns{%
+  \@bsphack\shr@nkingfale\@esphack}
+
+\def\balance@columns{%
+  \splittopskip\topskip
+  \splitmaxdepth\maxdepth
+  \setbox\z@\vbox{\unvbox\@cclv}\dimen@\ht\z@
+  \advance\dimen@\col@number\topskip
+  \advance\dimen@-\col@number\baselineskip
+  \divide\dimen@\col@number
+  \advance\dimen@\c@unbalance\baselineskip
+  {\vbadness\@M \loop
+    {\process@cols\@ne{\global\setbox\count@\box\voidb@x}}%
+     \global\setbox\@ne\copy\z@
+     {\process@cols\thr@@{\global\setbox\count@\vsplit\@ne to\dimen@}}%
+     \ifshr@nking \global\setbox\thr@@\vbox{\unvbox\thr@@}%
+       \fi
+     \ifdim\ht\@ne >\ht\thr@@
+     \global\advance\dimen@\p@
+     \repeat}%
+    \dimen@\ht\thr@@
+    \process@cols\z@{\@tempcnta\count@
+      \advance\@tempcnta\@ne
+      \setbox\count@\vtop to\dimen@
+        {\unvbox\@tempcnta
+	 \ifshr@nking\vfill\fi}}%
+     \global\vsize\@colroom
+     \global\advance\vsize\ht\partial@page
+     \page@sofar}
diff --git a/manual/styles/multind.sty b/manual/styles/multind.sty
new file mode 100644
index 00000000..ef91c28d
--- /dev/null
+++ b/manual/styles/multind.sty
@@ -0,0 +1,65 @@
+% indexes document style option for producing multiple indexes
+% for use with the modified bbok style, CHbook.sty
+% Written by F.W. Long, Version 1.1, 12 August 1991.
+
+% Modified by F.W. Long, Version 1.1a, 29 August 1991
+% to get the index heading correctly spaced.
+
+% Modified by F.W. Long, Version 1.1b, 31 August 1991
+% to remove the abbreviation \ix (which should be in the document, not here).
+
+% Modified \makeindex and \index commands to allow multiple indexes
+% in both cases the first parameter is the index name.
+% They now work more like \@starttoc and \addcontentsline.
+% \index is no longer defined inside \makeindex but determines
+% whether the appropriate file is defined before writing to it.
+
+\def\makeindex#1{\begingroup
+  \makeatletter
+  \if@filesw \expandafter\newwrite\csname #1@idxfile\endcsname
+  \expandafter\immediate\openout \csname #1@idxfile\endcsname #1.idx\relax
+  \typeout{Writing index file #1.idx }\fi \endgroup}
+
+\def\index#1{\@bsphack\begingroup
+               \def\protect##1{\string##1\space}\@sanitize
+               \@wrindex{#1}}
+
+% \@wrindex now checks that the appropriate file is defined.
+
+\def\@wrindex#1#2{\let\thepage\relax
+   \xdef\@gtempa{\@ifundefined{#1@idxfile}{}{\expandafter
+      \write\csname #1@idxfile\endcsname{\string
+      \indexentry{#2}{\thepage}}}}\endgroup\@gtempa
+   \if@nobreak \ifvmode\nobreak\fi\fi\@esphack}
+
+% Modified \printindex command to allow multiple indexes.
+% This now takes over much of the work of \theindex.
+% Again, the first parameter is the index name.
+% The second parameter is the index title (as printed).
+
+\newif\if@restonecol
+\def\printindex#1#2{\@restonecoltrue\if@twocolumn\@restonecolfalse\fi
+  \columnseprule \z@ \columnsep 35pt
+  \newpage \twocolumn[{\Large\bf #2 \vskip4ex}]
+  \markright{\uppercase{#2}}
+  \addcontentsline{toc}{section}{#2}
+  \@input{#1.ind}}
+
+% The following index commands are taken from book.sty.
+% \theindex is modified to not start a chapter.
+
+\def\theindex{\parindent\z@
+ \parskip\z@ plus .3pt\relax\let\item\@idxitem}
+\def\@idxitem{\par\hangindent 40pt}
+\def\subitem{\par\hangindent 40pt \hspace*{20pt}}
+\def\subsubitem{\par\hangindent 40pt \hspace*{30pt}}
+\def\endtheindex{\if@restonecol\onecolumn\else\clearpage\fi}
+\def\indexspace{\par \vskip 10pt plus 5pt minus 3pt\relax}
+
+% the command \ix allows an abbreviation for the general index
+
+%\def\ix#1{#1\index{general}{#1}}
+
+% define the \see command from makeidx.sty
+
+\def\see#1#2{{\em see\/} #1}
diff --git a/manual/styles/ocamldoc.hva b/manual/styles/ocamldoc.hva
new file mode 100644
index 00000000..efabdbd4
--- /dev/null
+++ b/manual/styles/ocamldoc.hva
@@ -0,0 +1,18 @@
+\usepackage{alltt}
+\newenvironment{ocamldoccode}{\begin{alltt}}{\end{alltt}}
+\newenvironment{ocamldocdescription}{\begin{quote}}{\end{quote}}
+\newenvironment{ocamldoccomment}{\begin{quote}}{\end{quote}}
+
+
+\newenvironment{ocamldocindent}{\list{}{}\item\relax}{\endlist}
+\newenvironment{ocamldocsigend}
+     {\noindent\quad\texttt{sig}\ocamldocindent}
+     {\endocamldocindent
+      \noindent\quad\texttt{end}\medskip}
+\newenvironment{ocamldocobjectend}
+     {\noindent\quad\texttt{object}\ocamldocindent}
+     {\endocamldocindent
+      \noindent\quad\texttt{end}\medskip}
+
+# For processing .tex generated by ocamldoc (for text manual)
+\newcommand{\ocamldocvspace}[1]{\vspace{#1}}
\ No newline at end of file
diff --git a/manual/styles/ocamldoc.sty b/manual/styles/ocamldoc.sty
new file mode 100644
index 00000000..b176c9b1
--- /dev/null
+++ b/manual/styles/ocamldoc.sty
@@ -0,0 +1,75 @@
+
+%% 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/manual/styles/scroll.sty b/manual/styles/scroll.sty
new file mode 100644
index 00000000..a344b03d
--- /dev/null
+++ b/manual/styles/scroll.sty
@@ -0,0 +1,5 @@
+% Modification to plaintext.sty to suppress page headings
+% and make pages contiguous when processed with dvi2txt
+
+\pagestyle{empty}
+\advance\voffset by -2\baselineskip
diff --git a/manual/styles/syntaxdef.hva b/manual/styles/syntaxdef.hva
new file mode 100644
index 00000000..7266d7ef
--- /dev/null
+++ b/manual/styles/syntaxdef.hva
@@ -0,0 +1,157 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Hevea code for syntax definitions of the ocaml manual %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Important commands
+% \token, for typesetting grammar terminals
+% \nonterm, for typesetting grammar non-terminals
+%
+% Beware: \nonterm introduces either a local anchor or a local reference
+%   -Anchors are introduced when \nonterm occurs in the first column of
+%    syntax definitions (environment 'syntax')
+%   - References are introduced everywhere else
+%
+% For pure typesetting effect without links (eg. to typeset 'e' as 'expr') 
+% use the \nt command (eg. \nt{e}).
+% In syntax definitions, the tool 'transf' translates @word@ into \nt{word}.
+%
+% Warnings are produced
+%  - For references to non-defined non terminals
+%  - For multiple definitions of the same non-terminal
+% Warnings can be avoided for a given non-terminal 'expr' by issuing
+% the command \stx@silent{'expr'}
+%
+%It is also possible to alias a nonterminal:
+%\stx@alias{name}{othername}
+%will make reference to 'name' point to the definition of non-terminal
+%'othername'
+\newif\ifspace
+\def\addspace{\ifspace\;\spacefalse\fi}
+\ifhtml
+\newcommand{\token}[1]{\texttt{\blue#1}}
+\else
+\newcommand{\token}[1]{\texttt{#1}}
+\fi
+%%% warnings
+\def\stx@warning#1#2{\@ifundefined{stx@#1@silent}{\hva@warn{#2}}{}}
+\def\stx@silent#1{\def\csname stx@#1@silent\endcsname{}}
+%%% Do not warn about those
+%initial example
+\stx@silent{like}\stx@silent{that}%
+%Not defined
+\stx@silent{regular-char}%
+\stx@silent{regular-string-char}%
+%\stx@silent{regular-char-str}%
+\stx@silent{lowercase-ident}%
+\stx@silent{capitalized-ident}%
+\stx@silent{space}%
+\stx@silent{tab}%
+\stx@silent{newline}%
+%Used in many places
+\stx@silent{prefix}%
+\stx@silent{name}%
+\stx@silent{xname}%
+%Not defined
+\stx@silent{external-declaration}%
+\stx@silent{unit-name}%
+%%Redefined in exten.etex
+\stx@silent{parameter}%
+\stx@silent{pattern}%
+\stx@silent{constr-decl}%
+\stx@silent{type-param}%
+\stx@silent{let-binding}%
+\stx@silent{expr}%
+\stx@silent{typexpr}%
+\stx@silent{module-expr}%
+\stx@silent{type-representation}%
+\stx@silent{definition}%
+\stx@silent{specification}%
+\stx@silent{type-equation}%
+\stx@silent{class-field}%
+\stx@silent{mod-constraint}%
+\stx@silent{module-type}%
+\stx@silent{constant}%
+%%Redefined in names.etex
+\stx@silent{label-name}%
+%%Not really defined in lexyacc.etex
+\stx@silent{character-set}%
+\stx@silent{symbol}%
+%%Not defined in debugger.etex
+\stx@silent{integer}
+%%Not defined in ocamldoc.etex
+\stx@silent{string}
+\stx@silent{id}
+\stx@silent{Exc}
+\stx@silent{URL}
+%%%%%%%%%%%%%
+%% Aliases %%
+%%%%%%%%%%%%%
+\newcommand{\stx@alias}[2]{\def\csname stx@#1@alias\endcsname{#2}}
+\stx@alias{typ}{typexpr}%
+\stx@alias{met}{method-name}%
+\stx@alias{tag}{tag-name}%
+\stx@alias{lab}{label-name}%
+\stx@alias{C}{constr-name}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%special anchor
+\newstyle{a.syntax:link}{color:maroon;text-decoration:underline}
+\newstyle{a.syntax:visited}{color:maroon;text-decoration:underline}
+\newstyle{a.syntax:hover}{color:black;text-decoration:none;background-color:\#FF6060}
+%compatibility for hevea-1.1?/heeva-2.??
+\ifu\@tr@url
+\providecommand{\@tr@url}[1]{#1}\def\stx@id{NAME}\else
+\def\stx@id{id}\fi
+\newcommand{\@syntaxlocref}[2]
+{\@aelement{href="\@print{#}\@tr@url{#1}" class="syntax"}{#2}}
+\newcommand{\@syntaxaname}[2]
+{\@aelement{\stx@id="#1" class="syntax"}{#2}}
+%%Refer to anchor, internal :
+%#1 -> anchor #2 -> visible tag
+\def\@ref@anchor#1#2{%
+\@ifundefined{stx@#1@exists}
+{\stx@warning{#1}{Undefined non-terminal: '#1'}#2}
+{\@syntaxlocref{#1}{#2}}}
+%%Refer to anchor
+\def\ref@anchor#1{%
+\ifu\csname stx@#1@alias\endcsname
+\@ref@anchor{#1}{#1}\else
+\@ref@anchor{\csname stx@#1@alias\endcsname}{#1}\fi}
+\def\stx@exists#1{\def\csname stx@#1@exists\endcsname{}}
+%%Define anachor
+\def\def@anchor#1{%
+\@ifundefined{stx@#1}
+{{\@nostyle\@auxdowrite{\string\stx@exists\{#1\}}}%
+\gdef\csname stx@#1\endcsname{}\@syntaxaname{#1}{#1}}
+{\@ifundefined{stx@#1@silent}
+{\hva@warn{Redefinition of non-terminal '#1'}#1}
+{\ref@anchor{#1}}}}
+%%%Change \@anchor and initial definition, for html only, of course!
+\ifhtml
+\def\set@name{\let\@anchor\def@anchor}
+\let\@anchor\ref@anchor
+\else
+\def\set@name{}
+\def\@anchor{}
+\fi
+%%%Format non-terminal
+\def\nt#1{\textit{\maroon#1}}
+%%%Link for non-terminal and format
+\def\nonterm#1{\addspace\nt{\@anchor{#1}}\spacetrue}
+\def\brepet{\addspace\{}
+\def\erepet{\}}
+\def\boption{\addspace[}
+\def\eoption{]}
+\def\brepets{\addspace\{}
+\def\erepets{\}^+}
+\def\bparen{\addspace(}
+\def\eparen{)}
+\def\orelse{\mid \spacefalse}
+\def\is{ & ::= & \spacefalse }
+\def\alt{ \\ & \mid & \spacefalse }
+\def\sep{ \\ \\ \spacefalse }
+\def\cutline{}
+\def\emptystring{\epsilon}
+\def\syntax{\@open{div}{class="syntax"}$$\begin{array}{>{\set@name}rcl}\spacefalse}
+\def\endsyntax{\end{array}$$\@close{div}}
+\def\syntaxleft{\@open{div}{class="syntaxleft"}$\begin{array}{>{\set@name}rcl}\spacefalse}
+\def\endsyntaxleft{\end{array}$\@close{div}}
+\def\synt#1{$\spacefalse#1$}
diff --git a/manual/styles/syntaxdef.sty b/manual/styles/syntaxdef.sty
new file mode 100644
index 00000000..1db6f5bf
--- /dev/null
+++ b/manual/styles/syntaxdef.sty
@@ -0,0 +1,26 @@
+\newif\ifspace
+\def\addspace{\ifspace \; \spacefalse \fi}
+\def\token#1{\addspace\hbox{\tt #1} \spacetrue}
+\def\nonterm#1{\addspace\nt{#1} \spacetrue}
+\def\nt#1{\hbox{\sl #1\/}}
+\def\brepet{\addspace\{}
+\def\erepet{\}}
+\def\boption{\addspace[}
+\def\eoption{]}
+\def\brepets{\addspace\{}
+\def\erepets{\}^+}
+\def\bparen{\addspace(}
+\def\eparen{)}
+\def\orelse{\mid \spacefalse}
+\def\is{ & ::= & \spacefalse }
+\def\alt{ \\ & \mid & \spacefalse }
+\def\cutline{ \\ & & \spacefalse }
+\def\sep{ \\[2mm] \spacefalse }
+\def\emptystring{\epsilon}
+\def\syntax{$$\begin{array}{rrl}\spacefalse}
+\def\endsyntax{\end{array}$$}
+\def\syntaxleft{$\begin{array}{rrl}\spacefalse}
+\def\endsyntaxleft{\end{array}$}
+\let\oldldots=\ldots
+\def\ldots{\spacefalse\oldldots}
+\def\synt#1{$\spacefalse#1$}
diff --git a/manual/styles/syntaxdeftxt.sty b/manual/styles/syntaxdeftxt.sty
new file mode 100644
index 00000000..370b6580
--- /dev/null
+++ b/manual/styles/syntaxdeftxt.sty
@@ -0,0 +1,22 @@
+\newif\ifspace
+\def\addspace{\ifspace\  \spacefalse\fi}
+\def\token#1{\addspace\hbox{\tt #1}\spacetrue\ignorespaces}
+%%% \def\nonterm#1{\addspace\hbox{\tt <#1>}\spacetrue\ignorespaces}
+\def\nonterm#1{\addspace\hbox{\it #1}\spacetrue\ignorespaces}
+\def\brepet{\addspace\hbox to1em{$\{$\hfil}\ignorespaces}
+\def\erepet{\hbox to1em{$\}$\hfil}\ignorespaces}
+\def\boption{\addspace[\ignorespaces}
+\def\eoption{]\ignorespaces}
+\def\brepets{\brepet\ignorespaces}
+\def\erepets{\erepet+\ignorespaces}
+\def\bparen{\addspace(\ignorespaces}
+\def\eparen{)\ignorespaces}
+\def\orelse{~\hbox to1em{$|$\hfil}~\spacefalse\ignorespaces}
+\def\is{& ::= & \spacefalse\ignorespaces}
+\def\alt{\\ & \hbox to1em{$|$\hfil} & \spacefalse }
+\def\sep{\\[\baselineskip] \spacefalse}
+\def\emptystring{nothing}
+\def\syntax{\begin{center}\begin{tabular}{rrl}\spacefalse\ignorespaces}
+\def\endsyntax{\end{tabular}\end{center}}
+\def\ldots{\spacefalse...\ignorespaces}
+\def\synt#1{$\spacefalse#1$}
diff --git a/manual/tests/.gitignore b/manual/tests/.gitignore
new file mode 100644
index 00000000..0229a346
--- /dev/null
+++ b/manual/tests/.gitignore
@@ -0,0 +1 @@
+/cross-reference-checker
diff --git a/manual/tests/Makefile b/manual/tests/Makefile
new file mode 100644
index 00000000..d3315fff
--- /dev/null
+++ b/manual/tests/Makefile
@@ -0,0 +1,56 @@
+TOPDIR=$(abspath ../..)
+SRC=$(TOPDIR)
+include $(TOPDIR)/Makefile.tools
+include $(TOPDIR)/ocamldoc/Makefile.docfiles
+MANUAL=$(TOPDIR)/manual/manual
+
+.PHONY: all
+all: check-cross-references check-stdlib check-case-collision
+
+.PHONY: tools
+tools: cross-reference-checker
+
+cross-reference-checker: cross_reference_checker.ml
+	$(OCAMLC) $(TOPDIR)/compilerlibs/ocamlcommon.cma \
+	  -I $(TOPDIR)/parsing -I $(TOPDIR)/driver \
+	  $< -o $@
+
+# check cross-references between the manual and error messages
+.PHONY: check-cross-references
+check-cross-references: cross-reference-checker
+	$(SET_LD_PATH) \
+	  $(OCAMLRUN) ./cross-reference-checker \
+	  -auxfile $(MANUAL)/texstuff/manual.aux \
+	  $(TOPDIR)/utils/warnings.ml \
+	  $(TOPDIR)/driver/main_args.ml \
+	  $(TOPDIR)/lambda/translmod.ml
+
+# check that all standard library modules are referenced by the
+# standard library chapter of the manual
+.PHONY: check-stdlib
+check-stdlib:
+	./check-stdlib-modules $(TOPDIR)
+
+
+# check name collision between latex source file and module documentation
+# on case-insensitive file systems
+normalize = $(shell echo $(basename $(notdir $(1) )) | tr A-Z a-z)
+LOWER_MLIS= $(call normalize,$(DOC_ALL_MLIS))
+LOWER_ETEX= $(call normalize,$(wildcard $(MANUAL)/*/*.etex) $(wildcard *.etex))
+INTER = $(filter $(LOWER_ETEX), $(LOWER_MLIS))
+
+.PHONY: check-case-collision
+check-case-collision:
+ifeq ($(INTER),)
+else
+	@echo "The following names"
+	@echo "  $(INTER)"
+	@echo "are used by both an OCaml module and a latex source file."
+	@echo "This creates a conflict on case-insensitive file systems."
+	@false
+endif
+
+
+.PHONY: clean
+clean:
+	rm -f *.cm? *.cmx? cross-reference-checker
diff --git a/manual/tests/README.md b/manual/tests/README.md
new file mode 100644
index 00000000..2f580d47
--- /dev/null
+++ b/manual/tests/README.md
@@ -0,0 +1,9 @@
+These tests have for objective to test the consistency between the manual and
+the rest of the compiler sources:
+
+- `cross_reference_checker.ml` checks that reference to the manual from the
+  compiler sources are still accurate.
+
+- `check-stdlib-modules` checks that all stdlib modules are linked from the
+  main entry of the stdlib in the manual:
+  `manual/manual/library/stdlib-blurb.etex`
diff --git a/manual/tests/check-stdlib-modules b/manual/tests/check-stdlib-modules
new file mode 100755
index 00000000..ee8cc3dd
--- /dev/null
+++ b/manual/tests/check-stdlib-modules
@@ -0,0 +1,23 @@
+#!/bin/sh
+
+TMPDIR="${TMPDIR:-/tmp}"
+
+(cd $1/stdlib; ls -1 *.mli) | sed -e 's/\.mli//' >$TMPDIR/stdlib-$$-files
+cut -c 1 $TMPDIR/stdlib-$$-files | tr a-z A-Z >$TMPDIR/stdlib-$$-initials
+cut -c 2- $TMPDIR/stdlib-$$-files \
+| paste -d '\0' $TMPDIR/stdlib-$$-initials - >$TMPDIR/stdlib-$$-modules
+
+exitcode=0
+for i in `cat $TMPDIR/stdlib-$$-modules`; do
+  case $i in
+    Stdlib | Camlinternal* | *Labels | Obj | Pervasives) continue;;
+  esac
+  grep -q -e '"'$i'" & p\.~\\pageref{'$i'} &' $1/manual/manual/library/stdlib-blurb.etex || {
+    echo "Module $i is missing from stdlib-blurb.etex." >&2
+    exitcode=2
+  }
+done
+
+rm -f $TMPDIR/stdlib-$$-*
+
+exit $exitcode
diff --git a/manual/tests/cross_reference_checker.ml b/manual/tests/cross_reference_checker.ml
new file mode 100644
index 00000000..cdf7ed6d
--- /dev/null
+++ b/manual/tests/cross_reference_checker.ml
@@ -0,0 +1,243 @@
+(** Check reference to manual section in ml files
+
+    [cross-reference-cheker -auxfile tex.aux src.ml ]
+    checks that all expression and let bindings in [src.ml] annotated
+    with [[@manual.ref "tex_label"]] are integer tuple literals, e.g
+    {[
+      let[@manual.ref "sec:major"] ref = 1, 1
+      (* or *)
+      let ref = (3 [@manual.ref "ch:pentatonic"])
+    ]}
+    and that their values are consistent with the computed references for the
+    payload labels (e.g "sec:major", "ch:pentatonic") present in the TeX
+    auxiliary file [tex.aux]
+
+*)
+
+
+(** {1 Error printing } *)
+type error =
+  | Reference_mismatch of
+      {loc:Location.t; label:string; ocaml:int list; tex:int list}
+  | Unknown_label of Location.t * string
+  | Tuple_expected of Location.t
+  | 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 print_error error =
+  Location.print_report Format.std_formatter @@ match error with
+  | Tuple_expected loc ->
+      Location.errorf ~loc
+        "Integer tuple expected after manual reference annotation@."
+  | Unknown_label (loc,label) ->
+    Location.errorf ~loc
+      "@[Unknown manual label:@ %s@]@." label
+  | Reference_mismatch r ->
+    Location.errorf ~loc:r.loc
+      "@[References for label %S do not match:@,\
+       OCaml side %a,@,\
+       manual     %a@]@."
+      r.label
+      pp_ref r.ocaml
+      pp_ref r.tex
+  | No_aux_file ->
+      Location.errorf "No aux file provided@."
+  | Wrong_attribute_payload loc ->
+      Location.errorf ~loc "Wrong payload for \"@manual.ref\"@."
+
+
+(** {1 Main types} *)
+
+(** Maps of ocaml reference to manual labels *)
+module Refs = Map.Make(String)
+
+(** Reference extracted from TeX aux files *)
+type tex_reference =
+  { label: string;
+    pos: int list;
+    level: string
+  }
+
+type status = Ok | Bad | Unknown
+
+(** Reference extracted from OCaml source files *)
+type ml_reference = { loc: Location.t; pos: int list; status:status }
+
+(** {1 Consistency check } *)
+
+let check_consistency (ref:tex_reference) {loc; pos; _ } =
+  if ref.pos = pos then
+    { loc; pos; status = Ok }
+  else begin
+    print_error @@ Reference_mismatch {loc;label=ref.label;tex=ref.pos;ocaml=pos};
+    {loc; pos;  status = Bad }
+  end
+
+let rec check_final_status label error = function
+  | { status = Ok; _ } -> error
+  | { status = Bad; _ } -> true
+  | { status = Unknown; loc; _} ->
+      print_error (Unknown_label (loc,label));
+      true
+
+(** {1 Data extraction from TeX side} *)
+
+module TeX = struct
+
+  (** Read reference information from a line of the aux file *)
+  let scan s =
+    try
+      Scanf.sscanf s
+        "\\newlabel{%s@}{{%s@}{%_d}{%_s@}{%s@.%_s@}{%_s@}}"
+        (fun label position_string level ->
+           let pos =
+             List.map int_of_string (String.split_on_char '.' position_string) in
+           Some {label;level;pos} )
+    with
+    | Scanf.Scan_failure _ -> None
+    | Failure _ -> None
+
+  let check_line refs line =
+    match scan line with
+    | None -> refs
+    | Some ref ->
+        match Refs.find_opt ref.label refs with
+        | None -> refs
+        | Some l ->
+            Refs.add ref.label
+              (List.map (check_consistency ref)  l)
+              refs
+
+  let check_all aux refs =
+    let chan = open_in aux in
+    let rec lines refs =
+      let s = try Some (input_line chan)  with End_of_file -> None in
+      match s with
+      | None -> refs
+      | Some line ->
+          lines @@ check_line refs line in
+    let refs = lines refs in
+    close_in chan;
+    let error = Refs.fold (fun label ocaml_refs error ->
+        List.fold_left (check_final_status label) error ocaml_refs)
+        refs false in
+    if error then exit 2 else exit 0
+end
+
+(** {1 Extract references from Ocaml source files} *)
+module OCaml_refs = struct
+
+  let parse sourcefile  =
+    Pparse.parse_implementation ~tool_name:"manual_cross_reference_check"
+      sourcefile
+
+  (** search for an attribute [[@manual.ref "tex_label_name"]] *)
+  let manual_reference_attribute attr =
+    let open Parsetree in
+    if attr.attr_name.Location.txt <> "manual.ref"
+    then None
+    else begin match attr.attr_payload with
+      | PStr [{pstr_desc= Pstr_eval
+                 ({ pexp_desc = Pexp_constant Pconst_string (s,_,_) },_) } ] ->
+          Some s
+      | _ -> print_error (Wrong_attribute_payload attr.attr_loc);
+          Some "" (* triggers an error *)
+    end
+
+  let rec label_from_attributes = function
+    | [] -> None
+    | a :: q -> match manual_reference_attribute a with
+      | Some _ as x -> x
+      | None -> label_from_attributes q
+
+  let int e =
+    let open Parsetree in
+    match e.pexp_desc with
+    | Pexp_constant Pconst_integer (s, _ ) -> int_of_string s
+    | _ -> raise Exit
+
+  let int_list l =
+    try Some (List.map int l) with
+    | Exit -> None
+
+  (** We keep a list of OCaml-side references to the same label *)
+  let add_ref label ref refs =
+    let l = match Refs.find_opt label refs with
+      | None -> [ref]
+      | Some l -> ref :: l in
+    Refs.add label l refs
+
+  let inner_expr loc e =
+    let tuple_expected () = print_error (Tuple_expected loc) in
+    match e.Parsetree.pexp_desc with
+          | Parsetree.Pexp_tuple l ->
+              begin match int_list l with
+              | None -> tuple_expected (); []
+              | Some pos -> pos
+              end
+          | Parsetree.Pexp_constant Pconst_integer (n,_) ->
+              [int_of_string n]
+          | _ -> tuple_expected (); []
+
+  (** extract from [let[@manual.ref "label"] x= 1, 2] *)
+  let value_binding m iterator vb =
+    let open Parsetree in
+    begin match label_from_attributes vb.pvb_attributes with
+    | None -> ()
+    | Some label ->
+        let pos = inner_expr vb.pvb_loc vb.pvb_expr in
+        m := add_ref label {loc = vb.pvb_loc; pos; status = Unknown } !m
+    end;
+    iterator.Ast_iterator.expr iterator vb.pvb_expr
+
+
+  (** extract from [ (1,2)[@manual.ref "label"]] *)
+  let expr m iterator e =
+    let open Parsetree in
+    begin match label_from_attributes e.pexp_attributes with
+    | None -> ()
+    | Some label ->
+        let pos = inner_expr e.pexp_loc e in
+        m := add_ref label {loc = e.pexp_loc; pos; status = Unknown } !m
+    end;
+    Ast_iterator.default_iterator.expr iterator e
+
+  let from_ast m ast =
+    let iterator =
+      let value_binding = value_binding m in
+      let expr = expr m in
+      Ast_iterator.{ default_iterator with value_binding; expr } in
+    iterator.structure iterator ast
+
+  let from_file m f =
+    from_ast m @@ parse f
+end
+
+
+(** {1 Argument handling and main function } *)
+
+let usage =
+  "cross-reference-check -auxfile [file.aux] file_1 ... file_n checks that \
+   the cross reference annotated with [@manual_cross_reference] are consistent \
+   with the provided auxiliary TeX file"
+
+(** the auxiliary file containing reference to be checked *)
+let aux_file = ref None
+
+let args =
+  [
+    "-auxfile",Arg.String (fun s -> aux_file := Some s),
+    "set the reference file"
+  ]
+
+let () =
+  let m = ref Refs.empty in
+  Arg.parse args (OCaml_refs.from_file m) usage;
+  match !aux_file with
+  | None -> print_error No_aux_file; exit 2
+  |  Some aux ->
+      let error = TeX.check_all aux !m  in
+      if error then exit 2 else exit 0
diff --git a/manual/tools/.gitignore b/manual/tools/.gitignore
new file mode 100644
index 00000000..f59594f4
--- /dev/null
+++ b/manual/tools/.gitignore
@@ -0,0 +1,11 @@
+transf.ml
+texquote2
+htmltransf.ml
+transf
+htmlgen
+htmlquote
+latexscan.ml
+dvi2txt
+*.dSYM
+*.cm[io]
+*.o
diff --git a/manual/tools/Makefile b/manual/tools/Makefile
new file mode 100644
index 00000000..ea379824
--- /dev/null
+++ b/manual/tools/Makefile
@@ -0,0 +1,30 @@
+TOPDIR=../..
+COMPFLAGS=-I $(OTOPDIR)/otherlibs/str -I $(OTOPDIR)/otherlibs/unix
+include $(TOPDIR)/Makefile.tools
+
+all: texquote2 transf
+
+
+transf: transf.cmo htmltransf.cmo transfmain.cmo
+	$(OCAMLC) -o $@ -g $^
+
+transfmain.cmo: transf.cmo htmltransf.cmo
+
+texquote2: texquote2.ml
+	$(OCAMLC) -o $@ $<
+
+%.cmo: %.ml
+	$(OCAMLC) -c $<
+
+%.cmi: %.mli
+	$(OCAMLC) -c $<
+
+%.ml: %.mll
+	$(OCAMLLEX) $<
+
+
+.PHONY: clean
+clean:
+	rm -f *.o *.cm? *.cmx?
+	rm -f transf.ml htmltransf.ml
+	rm -f texquote2 transf
diff --git a/manual/tools/fix_index.sh b/manual/tools/fix_index.sh
new file mode 100755
index 00000000..1deea537
--- /dev/null
+++ b/manual/tools/fix_index.sh
@@ -0,0 +1,51 @@
+#!/bin/sh
+
+# usage: fix_index.sh .idx
+
+# This script works around a hyperref bug: hyperref does not handle
+# quotes in \index arguments properly.
+#
+# Symptom:
+# When \index{-pipe-pipe@\verb`("|"|)`} appears in your .tex, the hyperref
+# package mangles it and produces this line in your .idx:
+#   \indexentry{(-pipe-pipe)@\verb`("|hyperindexformat{\"}}{292}
+# instead of the expected:
+#   \indexentry{(-pipe-pipe)@\verb`("|"|)`|hyperpage}{292}
+#
+# This is because it fails to handle quoted characters correctly.
+#
+# The workaround:
+# Look for the buggy line in the given .idx file and change it.
+
+# Note: this bug will happen every time you have a | (pipe) character
+# in an index entry (properly quoted with a " (double-quote) before it).
+# We fix only the one case that appears in the OCaml documentation.
+# We do not attempt a general solution because hyperref erases part
+# of the argument, so we cannot recover the correct string from its
+# output.
+
+# Note 2013-06-19:
+# The above was for the || operator in the stdlib's Pervasives module.
+# Now we have the same problem with the |> operator that was added
+# to the same module in commit 13739, hence the second special case.
+
+usage(){
+  echo "usage: fix_index.sh .idx" >&2
+  exit 2
+}
+
+case $# in
+  1) ;;
+  *) usage;;
+esac
+
+sed < "$1" > "$1.new" \
+    -e 's/verb`("|hyperindexformat{\\"}/verb`("|"|)`|hyperpage/' \
+    -e 's/verb`("|hyperindexformat{\\>)`}/verb`("|>)`|hyperpage/'
+
+case $? in
+  0) echo "fix_index.sh: fixed $1 successfully.";;
+  *) echo "fix_index.sh: some error occurred."; exit 1;;
+esac
+
+mv "$1.new" "$1"
diff --git a/manual/tools/htmltransf.mll b/manual/tools/htmltransf.mll
new file mode 100644
index 00000000..3db5e31f
--- /dev/null
+++ b/manual/tools/htmltransf.mll
@@ -0,0 +1,117 @@
+{
+open Lexing;;
+
+let need_space =
+  ref false;;
+
+let addspace () =
+  if !need_space then begin print_char ' '; need_space := false end;;
+}
+
+rule main = parse
+    "\\begin{syntax}" {
+      print_string "\\begin{rawhtml}\n
    \n";
+      need_space := false;
+      syntax lexbuf;
+      print_string "
    \n\\end{rawhtml}\n";
+      main lexbuf }
+  | "\\@" {
+      print_string "@";
+      main lexbuf }
+  | "@" {
+      print_string "%\n\\begin{rawhtml}";
+      need_space := false;
+      syntax lexbuf;
+      print_string "\\end{rawhtml}%\n";
+      main lexbuf }
+  | _ {
+      print_char (lexeme_char lexbuf 0); main lexbuf }
+  | eof {
+      () }
+
+and syntax = parse
+    "\\end{syntax}" { () }
+  | "@" { () }
+  | '\'' {
+      addspace();
+      print_string "";
+      inquote lexbuf;
+      print_string "";
+      need_space := true;
+      syntax lexbuf }
+  | '\"' {
+      addspace();
+      print_string "";
+      indoublequote lexbuf;
+      print_string "";
+      need_space := true;
+      syntax lexbuf }
+  | ['a'-'z'] ['a'-'z' '0'-'9' '-'] * {
+      addspace();
+      print_string "";
+      print_string (lexeme lexbuf);
+      print_string "";
+      need_space := true;
+      syntax lexbuf }
+  | '\\' ['a'-'z''A'-'Z'] + {
+      begin match lexeme lexbuf with
+        "\\ldots" -> print_string "..."; need_space := false
+      | s -> Printf.eprintf "Warning: %s ignored.\n" s
+      end;
+      syntax lexbuf }
+  | '_' _ {
+      print_string "";
+      print_char(lexeme_char lexbuf 1);
+      print_string "";
+      syntax lexbuf }
+  | '^' _ {
+      print_string "";
+      print_char(lexeme_char lexbuf 1);
+      print_string "";
+      syntax lexbuf }
+  | ":" {
+      print_string ":\n      ";
+      need_space := false;
+      syntax lexbuf }
+  | "|" {
+      print_string "\n   |  ";
+      need_space := false;
+      syntax lexbuf }
+  | ";" {
+      print_string "\n\n";
+      need_space := false;
+      syntax lexbuf }
+  | [ '{' '[' '('] {
+      addspace(); print_string (lexeme lexbuf); syntax lexbuf }
+  | [ '}' ']' ')'] {
+      print_string (lexeme lexbuf); syntax lexbuf }
+  | "{{" {
+      addspace(); print_string "{"; syntax lexbuf }
+  | "}}" {
+      print_string "}+"; syntax lexbuf }
+  | "||" {
+      print_string " | "; need_space := false; syntax lexbuf }
+  | [ ' ' '\n' '\t' '~'] {
+      syntax lexbuf }
+  | [ ',' ] {
+      print_char(lexeme_char lexbuf 0); syntax lexbuf }
+  | _ {
+      Printf.eprintf "Warning: %s ignored at char %d.\n"
+                      (lexeme lexbuf) (lexeme_start lexbuf);
+      syntax lexbuf }
+
+and inquote = parse
+    '\'' { () }
+  | '&' { print_string "&"; inquote lexbuf }
+  | '<' { print_string "<"; inquote lexbuf }
+  | '>' { print_string ">"; inquote lexbuf }
+  | _   { print_char (lexeme_char lexbuf 0); inquote lexbuf }
+
+and indoublequote = parse
+    '"' { () }
+  | '&' { print_string "&"; indoublequote lexbuf }
+  | '<' { print_string "<"; indoublequote lexbuf }
+  | '>' { print_string ">"; indoublequote lexbuf }
+  | _   { print_char (lexeme_char lexbuf 0); indoublequote lexbuf }
+
+
diff --git a/manual/tools/texquote2.ml b/manual/tools/texquote2.ml
new file mode 100644
index 00000000..2a996615
--- /dev/null
+++ b/manual/tools/texquote2.ml
@@ -0,0 +1,137 @@
+type environment =
+  | Normal
+  | Caml
+  | Verbatim of string * string
+  | Verbatim_like
+
+let in_quotes = ref false
+
+let is_alpha c =
+  ('A' <= c && c <= 'Z') || ('a' <= c && c <= 'z')
+
+let is_prefix prefix str =
+  let length_prefix = String.length prefix in
+  let length_str = String.length str in
+  if length_prefix > length_str
+  then false
+  else (String.sub str 0 length_prefix) = prefix
+
+let escape = function
+  | ' ' | '\n' -> "\\ "
+  | '{' -> "{\\char123}"
+  | '}' -> "{\\char125}"
+  | '^' -> "{\\char94}"
+  | '_' -> "{\\char95}"
+  | '\\' -> "{\\char92}"
+  | '~' -> "{\\char126}"
+  | '$' -> "\\$"
+  | '&' -> "{\\char38}"
+  | '#' -> "\\#"
+  | '%' -> "\\%"
+  | '\'' -> "{\\textquotesingle}"
+  | '`' -> "{\\textasciigrave}"
+  | _ -> ""
+
+let process_normal_line line =
+  let (verb_mark : char option ref) = ref None in
+  let l = String.length line in
+  let i = ref 0 in
+  while !i
+      (match line.[!i] with
+      | '"' ->
+        let r = if !in_quotes then "}}" else "{\\machine{" in
+        print_string r;
+        in_quotes := not !in_quotes;
+        incr i;
+      | '\\' ->
+        if !in_quotes
+        then begin
+          if (!i < l-1) && (line.[!i+1] = '"' || line.[!i+1] = '\\')
+          then incr i;
+          let t = escape line.[!i] in
+          if t<>"" then print_string t else print_char line.[!i];
+          incr i;
+        end else if is_prefix "\\verb" (String.sub line !i (l - !i))
+                    && not (is_alpha line.[!i+5])
+        then begin
+          i := !i+5;
+          verb_mark := Some line.[!i];
+          print_string "\\verb";
+          print_char line.[!i];
+          incr i;
+        end else (print_char '\\'; incr i)
+      | _ ->
+        if !in_quotes && (escape line.[!i] <> "")
+        then print_string (escape line.[!i])
+        else print_char line.[!i];
+        incr i;
+      )
+    | Some mark ->
+      if line.[!i] = mark
+      then verb_mark := None
+      else if line.[!i] = '\'' || line.[!i] = '`'
+      then Printf.eprintf "Warning: %c found in \\verb\n" line.[!i];
+      print_char line.[!i];
+      incr i;
+  done
+
+let process_line line = function
+  | Normal ->
+    if is_prefix "\\begin{caml_" line || is_prefix "\\begin{rawhtml}" line
+    then (print_string line; Verbatim_like)
+    else if is_prefix "\\begin{camlexample}" line
+    then (print_endline line; Caml)
+    else if is_prefix "\\begin{verbatim}" line
+    then begin
+      print_string "\\begin{machineenv}";
+      (Verbatim ("\\end{verbatim}", "\\end{machineenv}"))
+    end else if is_prefix "\\begin{ocamldoccode}" line
+    then begin
+      print_string "\\begin{ocamldoccode}";
+      (Verbatim ("\\end{ocamldoccode}", "\\end{ocamldoccode}"))
+    end else begin
+      process_normal_line line;
+      if !in_quotes
+      then print_string (escape '\n')
+      else print_newline();
+      Normal
+    end
+  | Caml ->
+    print_endline line;
+    if is_prefix "\\end{camlexample}" line then Normal else Caml
+  | Verbatim (verbatim_end_in, verbatim_end_out) as env ->
+    if is_prefix verbatim_end_in line
+    then begin
+      print_string verbatim_end_out;
+      Normal
+    end else begin
+      for i=0 to (String.length line) - 1 do
+        let c = line.[i] in
+        let t = escape c in
+        if c=' ' || c='\n' || t=""
+        then print_char c
+        else print_string t
+      done;
+      print_newline();
+      env
+    end
+  | Verbatim_like ->
+    print_endline line;
+    if is_prefix "\\end{caml_" line || is_prefix "\\end{rawhtml}" line
+    then Normal
+    else Verbatim_like
+
+let rec process_input env = match input_line stdin with
+  | exception End_of_file -> ()
+  | line ->
+    let env = process_line line env in
+    process_input env
+
+let main() =
+  print_endline "% THIS FILE IS GENERATED.";
+  print_newline();
+  process_input Normal
+
+let _ = main()
diff --git a/manual/tools/transf.mll b/manual/tools/transf.mll
new file mode 100644
index 00000000..a9cc2671
--- /dev/null
+++ b/manual/tools/transf.mll
@@ -0,0 +1,107 @@
+{
+  open Lexing;;
+  open Printf;;
+
+  let print_char_repr c =
+  match c with
+  | '\'' -> printf "{\\textquotesingle}"
+  | '`' -> printf "{\\textasciigrave}"
+  | _ -> printf "\\char%d" (int_of_char c);
+  ;;
+}
+
+rule main = parse
+    "\\begin{syntax}" {
+      print_string "\\begin{syntax}";
+      syntax lexbuf }
+  | "\\begin{verbatim}" | "\\begin{camlexample}" as s {
+      print_string s;
+      verbatim lexbuf }
+  | "\\@" {
+      print_string "@";
+      main lexbuf }
+  | "@" {
+      print_string "\\synt{";
+      syntax lexbuf }
+  | _ {
+      print_char (lexeme_char lexbuf 0); main lexbuf }
+  | eof {
+      () }
+
+and syntax = parse
+    "\\end{syntax}" {
+      print_string "\\end{syntax}";
+      main lexbuf }
+  | "@" {
+      print_string "}";
+      main lexbuf }
+  | '\'' {
+      print_string "\\token{";
+      inquote lexbuf }
+  | '\"' {
+      print_string "\\token{";
+      indoublequote lexbuf }
+  | "epsilon" { print_string "\\emptystring"; syntax lexbuf }
+  | ['a'-'z' 'A'-'Z'] ['a'-'z' 'A'-'Z' '0'-'9' '-'] * as lxm {
+      print_string "\\nonterm{";
+      print_string lxm ;
+      print_string"}";
+      syntax lexbuf }
+  | '@' (['a'-'z' 'A'-'Z'] ['a'-'z' 'A'-'Z' '0'-'9' '-'] * as lxm) '@' {
+      print_string "\\nt{";
+      print_string lxm ;
+      print_string"}";
+      syntax lexbuf }
+
+  | '\\' ['a'-'z''A'-'Z'] + {
+      print_string (lexeme lexbuf);
+      syntax lexbuf }
+  | ['_' '^'] _ {
+      print_string (lexeme lexbuf);
+      syntax lexbuf }
+  | "{" { print_string "\\brepet{}"; syntax lexbuf }
+  | "}" { print_string "\\erepet{}"; syntax lexbuf }
+  | "{{" { print_string "\\brepets{}"; syntax lexbuf }
+  | "}}" { print_string "\\erepets{}"; syntax lexbuf }
+  | "[" { print_string "\\boption{}"; syntax lexbuf }
+  | "]" { print_string "\\eoption{}"; syntax lexbuf }
+  | "(" { print_string "\\bparen{}"; syntax lexbuf }
+  | ")" { print_string "\\eparen{}"; syntax lexbuf }
+  | "||" { print_string "\\orelse{}"; syntax lexbuf }
+  | ":" { print_string "\\is{}"; syntax lexbuf }
+  | "|" { print_string "\\alt{}"; syntax lexbuf }
+  | ";" { print_string "\\sep{}"; syntax lexbuf }
+  | "\\\\" { print_string "\\cutline{}"; syntax lexbuf }
+  | _ {
+      print_char (lexeme_char lexbuf 0);
+      syntax lexbuf }
+
+and inquote = parse
+    ['A'-'Z' 'a'-'z' '0'-'9'] {
+      print_char (lexeme_char lexbuf 0);
+      inquote lexbuf }
+  | '\'' {
+      print_string "}";
+      syntax lexbuf }
+  | _ {
+      print_char_repr (lexeme_char lexbuf 0);
+      inquote lexbuf }
+
+and indoublequote = parse
+    ['A'-'Z' 'a'-'z' '0'-'9'] {
+      print_char (lexeme_char lexbuf 0);
+      indoublequote lexbuf }
+  | '"' {
+      print_string "}";
+      syntax lexbuf }
+  | _ {
+      print_char_repr (lexeme_char lexbuf 0);
+      indoublequote lexbuf }
+
+and verbatim = parse
+    "\n\\end{verbatim}"|"\\end{camlexample}" as s {
+      print_string s;
+      main lexbuf }
+  | _ {
+      print_char (lexeme_char lexbuf 0);
+      verbatim lexbuf }
diff --git a/manual/tools/transfmain.ml b/manual/tools/transfmain.ml
new file mode 100644
index 00000000..49d9840d
--- /dev/null
+++ b/manual/tools/transfmain.ml
@@ -0,0 +1,8 @@
+let main() =
+  let lexbuf = Lexing.from_channel stdin in
+  if Array.length Sys.argv >= 2 && Sys.argv.(1) = "-html"
+  then Htmltransf.main lexbuf
+  else Transf.main lexbuf;
+  exit 0;;
+
+Printexc.print main ();;
diff --git a/middle_end/backend_intf.mli b/middle_end/backend_intf.mli
new file mode 100644
index 00000000..c9e00928
--- /dev/null
+++ b/middle_end/backend_intf.mli
@@ -0,0 +1,47 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Knowledge that the middle end needs about the backend. *)
+
+module type S = sig
+  (** Compute the symbol for the given identifier. *)
+  val symbol_for_global' : (Ident.t -> Symbol.t)
+
+  (** If the given approximation is that of a symbol (Value_symbol) or an
+      external (Value_extern), attempt to find a more informative
+      approximation from a previously-written compilation artifact.  In the
+      native code backend, for example, this might consult a .cmx file. *)
+  val really_import_approx : Simple_value_approx.t -> Simple_value_approx.t
+
+  val import_symbol : Symbol.t -> Simple_value_approx.t
+
+  val closure_symbol : Closure_id.t -> Symbol.t
+
+  (** The natural size of an integer on the target architecture
+      (cf. [Arch.size_int] in the native code backend). *)
+  val size_int : int
+
+  (** [true] iff the target architecture is big endian. *)
+  val big_endian : bool
+
+  (** The maximum number of arguments that is reasonable for a function
+      to have.  This should be fewer than the threshold that causes non-self
+      tail call optimization to be inhibited (in particular, if it would
+      entail passing arguments on the stack; see [Selectgen]). *)
+  val max_sensible_number_of_arguments : int
+end
diff --git a/middle_end/backend_var.ml b/middle_end/backend_var.ml
new file mode 100644
index 00000000..5f95d155
--- /dev/null
+++ b/middle_end/backend_var.ml
@@ -0,0 +1,89 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                  Mark Shinwell, Jane Street Europe                     *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+include Ident
+
+type backend_var = t
+
+module Provenance = struct
+  type t = {
+    module_path : Path.t;
+    location : Debuginfo.t;
+    original_ident : Ident.t;
+  }
+
+  let print ppf { module_path; location; original_ident; } =
+    let printf fmt = Format.fprintf ppf fmt in
+    printf "@[(";
+    printf "@[(module_path@ %a)@]@ "
+      Path.print module_path;
+    if !Clflags.locations then
+      printf "@[(location@ %a)@]@ "
+        Debuginfo.print_compact location;
+    printf "@[(original_ident@ %a)@]"
+      Ident.print original_ident;
+    printf ")@]"
+
+  let create ~module_path ~location ~original_ident =
+    { module_path;
+      location;
+      original_ident;
+    }
+
+  let module_path t = t.module_path
+  let location t = t.location
+  let original_ident t = t.original_ident
+end
+
+module With_provenance = struct
+  type t =
+    | Without_provenance of backend_var
+    | With_provenance of {
+        var : backend_var;
+        provenance : Provenance.t;
+      }
+
+  let create ?provenance var =
+    match provenance with
+    | None -> Without_provenance var
+    | Some provenance -> With_provenance { var; provenance; }
+
+  let var t =
+    match t with
+    | Without_provenance var
+    | With_provenance { var; provenance = _; } -> var
+
+  let provenance t =
+    match t with
+    | Without_provenance _ -> None
+    | With_provenance { var = _; provenance; } -> Some provenance
+
+  let name t = name (var t)
+
+  let rename t =
+    let var = rename (var t) in
+    match provenance t with
+    | None -> Without_provenance var
+    | Some provenance -> With_provenance { var; provenance; }
+
+  let print ppf t =
+    match provenance t with
+    | None -> print ppf (var t)
+    | Some provenance ->
+      Format.fprintf ppf "%a[%a]"
+        print (var t)
+        Provenance.print provenance
+end
diff --git a/middle_end/backend_var.mli b/middle_end/backend_var.mli
new file mode 100644
index 00000000..f236be1e
--- /dev/null
+++ b/middle_end/backend_var.mli
@@ -0,0 +1,54 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                  Mark Shinwell, Jane Street Europe                     *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Variables used in the backend, optionally equipped with "provenance"
+    information, used for the emission of debugging information. *)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+include module type of struct include Ident end
+
+type backend_var = t
+
+module Provenance : sig
+  type t
+
+  val create
+     : module_path:Path.t
+    -> location:Debuginfo.t
+    -> original_ident:Ident.t
+    -> t
+
+  val module_path : t -> Path.t
+  val location : t -> Debuginfo.t
+  val original_ident : t -> Ident.t
+
+  val print : Format.formatter -> t -> unit
+end
+
+module With_provenance : sig
+  (** Values of type [t] should be used for variables in binding position. *)
+  type t
+
+  val print : Format.formatter -> t -> unit
+
+  val create : ?provenance:Provenance.t -> backend_var -> t
+
+  val var : t -> backend_var
+  val provenance : t -> Provenance.t option
+
+  val name : t -> string
+
+  val rename : t -> t
+end
diff --git a/middle_end/clambda.ml b/middle_end/clambda.ml
new file mode 100644
index 00000000..59402629
--- /dev/null
+++ b/middle_end/clambda.ml
@@ -0,0 +1,206 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* A variant of the "lambda" code with direct / indirect calls explicit
+   and closures explicit too *)
+
+open Asttypes
+open Lambda
+
+type function_label = string
+
+type ustructured_constant =
+  | Uconst_float of float
+  | Uconst_int32 of int32
+  | Uconst_int64 of int64
+  | Uconst_nativeint of nativeint
+  | Uconst_block of int * uconstant list
+  | Uconst_float_array of float list
+  | Uconst_string of string
+  | Uconst_closure of ufunction list * string * uconstant list
+
+and uconstant =
+  | Uconst_ref of string * ustructured_constant option
+  | Uconst_int of int
+  | Uconst_ptr of int
+
+and uphantom_defining_expr =
+  | Uphantom_const of uconstant
+  | Uphantom_var of Backend_var.t
+  | Uphantom_offset_var of { var : Backend_var.t; offset_in_words : int; }
+  | Uphantom_read_field of { var : Backend_var.t; field : int; }
+  | Uphantom_read_symbol_field of { sym : string; field : int; }
+  | Uphantom_block of { tag : int; fields : Backend_var.t list; }
+
+and ulambda =
+    Uvar of Backend_var.t
+  | Uconst of uconstant
+  | Udirect_apply of function_label * ulambda list * Debuginfo.t
+  | Ugeneric_apply of ulambda * ulambda list * Debuginfo.t
+  | Uclosure of ufunction list * ulambda list
+  | Uoffset of ulambda * int
+  | Ulet of mutable_flag * value_kind * Backend_var.With_provenance.t
+      * ulambda * ulambda
+  | Uphantom_let of Backend_var.With_provenance.t
+      * uphantom_defining_expr option * ulambda
+  | Uletrec of (Backend_var.With_provenance.t * ulambda) list * ulambda
+  | Uprim of Clambda_primitives.primitive * ulambda list * Debuginfo.t
+  | Uswitch of ulambda * ulambda_switch * Debuginfo.t
+  | Ustringswitch of ulambda * (string * ulambda) list * ulambda option
+  | Ustaticfail of int * ulambda list
+  | Ucatch of
+      int *
+      (Backend_var.With_provenance.t * value_kind) list *
+      ulambda *
+      ulambda
+  | Utrywith of ulambda * Backend_var.With_provenance.t * ulambda
+  | Uifthenelse of ulambda * ulambda * ulambda
+  | Usequence of ulambda * ulambda
+  | Uwhile of ulambda * ulambda
+  | Ufor of Backend_var.With_provenance.t * ulambda * ulambda
+      * direction_flag * ulambda
+  | Uassign of Backend_var.t * ulambda
+  | Usend of meth_kind * ulambda * ulambda * ulambda list * Debuginfo.t
+  | Uunreachable
+
+and ufunction = {
+  label  : function_label;
+  arity  : int;
+  params : (Backend_var.With_provenance.t * value_kind) list;
+  return : value_kind;
+  body   : ulambda;
+  dbg    : Debuginfo.t;
+  env    : Backend_var.t option;
+}
+
+and ulambda_switch =
+  { us_index_consts: int array;
+    us_actions_consts : ulambda array;
+    us_index_blocks: int array;
+    us_actions_blocks: ulambda array}
+
+(* Description of known functions *)
+
+type function_description =
+  { fun_label: function_label;          (* Label of direct entry point *)
+    fun_arity: int;                     (* Number of arguments *)
+    mutable fun_closed: bool;           (* True if environment not used *)
+    mutable fun_inline: (Backend_var.With_provenance.t list * ulambda) option;
+    mutable fun_float_const_prop: bool  (* Can propagate FP consts *)
+  }
+
+(* Approximation of values *)
+
+type value_approximation =
+    Value_closure of function_description * value_approximation
+  | Value_tuple of value_approximation array
+  | Value_unknown
+  | Value_const of uconstant
+  | Value_global_field of string * int
+
+(* Preallocated globals *)
+
+type usymbol_provenance = {
+  original_idents : Ident.t list;
+  module_path : Path.t;
+}
+
+type uconstant_block_field =
+  | Uconst_field_ref of string
+  | Uconst_field_int of int
+
+type preallocated_block = {
+  symbol : string;
+  exported : bool;
+  tag : int;
+  fields : uconstant_block_field option list;
+  provenance : usymbol_provenance option;
+}
+
+type preallocated_constant = {
+  symbol : string;
+  exported : bool;
+  definition : ustructured_constant;
+  provenance : usymbol_provenance option;
+}
+
+type with_constants =
+  ulambda * preallocated_block list * preallocated_constant list
+
+(* Comparison functions for constants.  We must not use Stdlib.compare
+   because it compares "0.0" and "-0.0" equal.  (PR#6442) *)
+
+let compare_floats x1 x2 =
+  Int64.compare (Int64.bits_of_float x1) (Int64.bits_of_float x2)
+
+let rec compare_float_lists l1 l2 =
+  match l1, l2 with
+  | [], [] -> 0
+  | [], _::_ -> -1
+  | _::_, [] -> 1
+  | h1::t1, h2::t2 ->
+      let c = compare_floats h1 h2 in
+      if c <> 0 then c else compare_float_lists t1 t2
+
+let compare_constants c1 c2 =
+  match c1, c2 with
+  | Uconst_ref(lbl1, _c1), Uconst_ref(lbl2, _c2) -> String.compare lbl1 lbl2
+      (* Same labels -> same constants.
+         Different labels -> different constants, even if the contents
+           match, because of string constants that must not be
+           reshared. *)
+  | Uconst_int n1, Uconst_int n2 -> Stdlib.compare n1 n2
+  | Uconst_ptr n1, Uconst_ptr n2 -> Stdlib.compare n1 n2
+  | Uconst_ref _, _ -> -1
+  | Uconst_int _, Uconst_ref _ -> 1
+  | Uconst_int _, Uconst_ptr _ -> -1
+  | Uconst_ptr _, _ -> 1
+
+let rec compare_constant_lists l1 l2 =
+  match l1, l2 with
+  | [], [] -> 0
+  | [], _::_ -> -1
+  | _::_, [] -> 1
+  | h1::t1, h2::t2 ->
+      let c = compare_constants h1 h2 in
+      if c <> 0 then c else compare_constant_lists t1 t2
+
+let rank_structured_constant = function
+  | Uconst_float _ -> 0
+  | Uconst_int32 _ -> 1
+  | Uconst_int64 _ -> 2
+  | Uconst_nativeint _ -> 3
+  | Uconst_block _ -> 4
+  | Uconst_float_array _ -> 5
+  | Uconst_string _ -> 6
+  | Uconst_closure _ -> 7
+
+let compare_structured_constants c1 c2 =
+  match c1, c2 with
+  | Uconst_float x1, Uconst_float x2 -> compare_floats x1 x2
+  | Uconst_int32 x1, Uconst_int32 x2 -> Int32.compare x1 x2
+  | Uconst_int64 x1, Uconst_int64 x2 -> Int64.compare x1 x2
+  | Uconst_nativeint x1, Uconst_nativeint x2 -> Nativeint.compare x1 x2
+  | Uconst_block(t1, l1), Uconst_block(t2, l2) ->
+      let c = t1 - t2 (* no overflow possible here *) in
+      if c <> 0 then c else compare_constant_lists l1 l2
+  | Uconst_float_array l1, Uconst_float_array l2 ->
+      compare_float_lists l1 l2
+  | Uconst_string s1, Uconst_string s2 -> String.compare s1 s2
+  | Uconst_closure (_,lbl1,_), Uconst_closure (_,lbl2,_) ->
+      String.compare lbl1 lbl2
+  | _, _ ->
+    (* no overflow possible here *)
+    rank_structured_constant c1 - rank_structured_constant c2
diff --git a/middle_end/clambda.mli b/middle_end/clambda.mli
new file mode 100644
index 00000000..9d74eb66
--- /dev/null
+++ b/middle_end/clambda.mli
@@ -0,0 +1,156 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* A variant of the "lambda" code with direct / indirect calls explicit
+   and closures explicit too *)
+
+open Asttypes
+open Lambda
+
+type function_label = string
+
+type ustructured_constant =
+  | Uconst_float of float
+  | Uconst_int32 of int32
+  | Uconst_int64 of int64
+  | Uconst_nativeint of nativeint
+  | Uconst_block of int * uconstant list
+  | Uconst_float_array of float list
+  | Uconst_string of string
+  | Uconst_closure of ufunction list * string * uconstant list
+
+and uconstant =
+  | Uconst_ref of string * ustructured_constant option
+  | Uconst_int of int
+  | Uconst_ptr of int
+
+and uphantom_defining_expr =
+  | Uphantom_const of uconstant
+  (** The phantom-let-bound variable is a constant. *)
+  | Uphantom_var of Backend_var.t
+  (** The phantom-let-bound variable is an alias for another variable. *)
+  | Uphantom_offset_var of { var : Backend_var.t; offset_in_words : int; }
+  (** The phantom-let-bound-variable's value is defined by adding the given
+      number of words to the pointer contained in the given identifier. *)
+  | Uphantom_read_field of { var : Backend_var.t; field : int; }
+  (** The phantom-let-bound-variable's value is found by adding the given
+      number of words to the pointer contained in the given identifier, then
+      dereferencing. *)
+  | Uphantom_read_symbol_field of { sym : string; field : int; }
+  (** As for [Uphantom_read_var_field], but with the pointer specified by
+      a symbol. *)
+  | Uphantom_block of { tag : int; fields : Backend_var.t list; }
+  (** The phantom-let-bound variable points at a block with the given
+      structure. *)
+
+and ulambda =
+    Uvar of Backend_var.t
+  | Uconst of uconstant
+  | Udirect_apply of function_label * ulambda list * Debuginfo.t
+  | Ugeneric_apply of ulambda * ulambda list * Debuginfo.t
+  | Uclosure of ufunction list * ulambda list
+  | Uoffset of ulambda * int
+  | Ulet of mutable_flag * value_kind * Backend_var.With_provenance.t
+      * ulambda * ulambda
+  | Uphantom_let of Backend_var.With_provenance.t
+      * uphantom_defining_expr option * ulambda
+  | Uletrec of (Backend_var.With_provenance.t * ulambda) list * ulambda
+  | Uprim of Clambda_primitives.primitive * ulambda list * Debuginfo.t
+  | Uswitch of ulambda * ulambda_switch * Debuginfo.t
+  | Ustringswitch of ulambda * (string * ulambda) list * ulambda option
+  | Ustaticfail of int * ulambda list
+  | Ucatch of
+      int *
+      (Backend_var.With_provenance.t * value_kind) list *
+      ulambda *
+      ulambda
+  | Utrywith of ulambda * Backend_var.With_provenance.t * ulambda
+  | Uifthenelse of ulambda * ulambda * ulambda
+  | Usequence of ulambda * ulambda
+  | Uwhile of ulambda * ulambda
+  | Ufor of Backend_var.With_provenance.t * ulambda * ulambda
+      * direction_flag * ulambda
+  | Uassign of Backend_var.t * ulambda
+  | Usend of meth_kind * ulambda * ulambda * ulambda list * Debuginfo.t
+  | Uunreachable
+
+and ufunction = {
+  label  : function_label;
+  arity  : int;
+  params : (Backend_var.With_provenance.t * value_kind) list;
+  return : value_kind;
+  body   : ulambda;
+  dbg    : Debuginfo.t;
+  env    : Backend_var.t option;
+}
+
+and ulambda_switch =
+  { us_index_consts: int array;
+    us_actions_consts: ulambda array;
+    us_index_blocks: int array;
+    us_actions_blocks: ulambda array}
+
+(* Description of known functions *)
+
+type function_description =
+  { fun_label: function_label;          (* Label of direct entry point *)
+    fun_arity: int;                     (* Number of arguments *)
+    mutable fun_closed: bool;           (* True if environment not used *)
+    mutable fun_inline: (Backend_var.With_provenance.t list * ulambda) option;
+    mutable fun_float_const_prop: bool  (* Can propagate FP consts *)
+  }
+
+(* Approximation of values *)
+
+type value_approximation =
+    Value_closure of function_description * value_approximation
+  | Value_tuple of value_approximation array
+  | Value_unknown
+  | Value_const of uconstant
+  | Value_global_field of string * int
+
+(* Comparison functions for constants *)
+
+val compare_structured_constants:
+        ustructured_constant -> ustructured_constant -> int
+val compare_constants:
+        uconstant -> uconstant -> int
+
+type usymbol_provenance = {
+  original_idents : Ident.t list;
+  module_path : Path.t;
+}
+
+type uconstant_block_field =
+  | Uconst_field_ref of string
+  | Uconst_field_int of int
+
+type preallocated_block = {
+  symbol : string;
+  exported : bool;
+  tag : int;
+  fields : uconstant_block_field option list;
+  provenance : usymbol_provenance option;
+}
+
+type preallocated_constant = {
+  symbol : string;
+  exported : bool;
+  definition : ustructured_constant;
+  provenance : usymbol_provenance option;
+}
+
+type with_constants =
+  ulambda * preallocated_block list * preallocated_constant list
diff --git a/middle_end/clambda_primitives.ml b/middle_end/clambda_primitives.ml
new file mode 100644
index 00000000..3dd05879
--- /dev/null
+++ b/middle_end/clambda_primitives.ml
@@ -0,0 +1,156 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type mutable_flag = Asttypes.mutable_flag
+
+type immediate_or_pointer = Lambda.immediate_or_pointer
+
+type initialization_or_assignment = Lambda.initialization_or_assignment
+
+type is_safe = Lambda.is_safe
+
+type boxed =
+  | Boxed
+  | Unboxed
+
+type memory_access_size =
+  | Sixteen
+  | Thirty_two
+  | Sixty_four
+
+type primitive =
+  | Pread_symbol of string
+  (* Operations on heap blocks *)
+  | Pmakeblock of int * mutable_flag * block_shape
+  | Pfield of int
+  | Pfield_computed
+  | Psetfield of int * immediate_or_pointer * initialization_or_assignment
+  | Psetfield_computed of immediate_or_pointer * initialization_or_assignment
+  | Pfloatfield of int
+  | Psetfloatfield of int * initialization_or_assignment
+  | Pduprecord of Types.record_representation * int
+  (* External call *)
+  | Pccall of Primitive.description
+  (* Exceptions *)
+  | Praise of raise_kind
+  (* Boolean operations *)
+  | Psequand | Psequor | Pnot
+  (* Integer operations *)
+  | Pnegint | Paddint | Psubint | Pmulint
+  | Pdivint of is_safe | Pmodint of is_safe
+  | Pandint | Porint | Pxorint
+  | Plslint | Plsrint | Pasrint
+  | Pintcomp of integer_comparison
+  | Pcompare_ints | Pcompare_floats | Pcompare_bints of boxed_integer
+  | Poffsetint of int
+  | Poffsetref of int
+  (* Float operations *)
+  | Pintoffloat | Pfloatofint
+  | Pnegfloat | Pabsfloat
+  | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
+  | Pfloatcomp of float_comparison
+  (* String operations *)
+  | Pstringlength | Pstringrefu  | Pstringrefs
+  | Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
+  (* Array operations *)
+  | Pmakearray of array_kind * mutable_flag
+  | Pduparray of array_kind * mutable_flag
+  (** For [Pduparray], the argument must be an immutable array.
+      The arguments of [Pduparray] give the kind and mutability of the
+      array being *produced* by the duplication. *)
+  | Parraylength of array_kind
+  | Parrayrefu of array_kind
+  | Parraysetu of array_kind
+  | Parrayrefs of array_kind
+  | Parraysets of array_kind
+  (* Test if the argument is a block or an immediate integer *)
+  | Pisint
+  (* Test if the (integer) argument is outside an interval *)
+  | Pisout
+  (* Operations on boxed integers (Nativeint.t, Int32.t, Int64.t) *)
+  | Pbintofint of boxed_integer
+  | Pintofbint of boxed_integer
+  | Pcvtbint of boxed_integer (*source*) * boxed_integer (*destination*)
+  | Pnegbint of boxed_integer
+  | Paddbint of boxed_integer
+  | Psubbint of boxed_integer
+  | Pmulbint of boxed_integer
+  | Pdivbint of { size : boxed_integer; is_safe : is_safe }
+  | Pmodbint of { size : boxed_integer; is_safe : is_safe }
+  | Pandbint of boxed_integer
+  | Porbint of boxed_integer
+  | Pxorbint of boxed_integer
+  | Plslbint of boxed_integer
+  | Plsrbint of boxed_integer
+  | Pasrbint of boxed_integer
+  | Pbintcomp of boxed_integer * integer_comparison
+  (* Operations on big arrays: (unsafe, #dimensions, kind, layout) *)
+  | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
+  | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
+  (* size of the nth dimension of a big array *)
+  | Pbigarraydim of int
+  (* load/set 16,32,64 bits from a string: (unsafe)*)
+  | Pstring_load of (memory_access_size * is_safe)
+  | Pbytes_load of (memory_access_size * is_safe)
+  | Pbytes_set of (memory_access_size * is_safe)
+  (* load/set 16,32,64 bits from a
+     (char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *)
+  | Pbigstring_load of (memory_access_size * is_safe)
+  | Pbigstring_set of (memory_access_size * is_safe)
+  (* byte swap *)
+  | Pbswap16
+  | Pbbswap of boxed_integer
+  (* Integer to external pointer *)
+  | Pint_as_pointer
+  (* Inhibition of optimisation *)
+  | Popaque
+
+and integer_comparison = Lambda.integer_comparison =
+    Ceq | Cne | Clt | Cgt | Cle | Cge
+
+and float_comparison = Lambda.float_comparison =
+    CFeq | CFneq | CFlt | CFnlt | CFgt | CFngt | CFle | CFnle | CFge | CFnge
+
+and array_kind = Lambda.array_kind =
+    Pgenarray | Paddrarray | Pintarray | Pfloatarray
+
+and value_kind = Lambda.value_kind =
+  (* CR mshinwell: Pfloatval should be renamed to Pboxedfloatval *)
+    Pgenval | Pfloatval | Pboxedintval of boxed_integer | Pintval
+
+and block_shape = Lambda.block_shape
+and boxed_integer = Primitive.boxed_integer =
+    Pnativeint | Pint32 | Pint64
+
+and bigarray_kind = Lambda.bigarray_kind =
+    Pbigarray_unknown
+  | Pbigarray_float32 | Pbigarray_float64
+  | Pbigarray_sint8 | Pbigarray_uint8
+  | Pbigarray_sint16 | Pbigarray_uint16
+  | Pbigarray_int32 | Pbigarray_int64
+  | Pbigarray_caml_int | Pbigarray_native_int
+  | Pbigarray_complex32 | Pbigarray_complex64
+
+and bigarray_layout = Lambda.bigarray_layout =
+    Pbigarray_unknown_layout
+  | Pbigarray_c_layout
+  | Pbigarray_fortran_layout
+
+and raise_kind = Lambda.raise_kind =
+  | Raise_regular
+  | Raise_reraise
+  | Raise_notrace
+
+let equal (x: primitive) (y: primitive) = x = y
diff --git a/middle_end/clambda_primitives.mli b/middle_end/clambda_primitives.mli
new file mode 100644
index 00000000..a75cd048
--- /dev/null
+++ b/middle_end/clambda_primitives.mli
@@ -0,0 +1,159 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type mutable_flag = Asttypes.mutable_flag
+
+type immediate_or_pointer = Lambda.immediate_or_pointer
+
+type initialization_or_assignment = Lambda.initialization_or_assignment
+
+type is_safe = Lambda.is_safe
+
+type boxed =
+  | Boxed
+  | Unboxed
+
+type memory_access_size =
+  | Sixteen
+  | Thirty_two
+  | Sixty_four
+
+type primitive =
+  | Pread_symbol of string
+  (* Operations on heap blocks *)
+  | Pmakeblock of int * mutable_flag * block_shape
+  | Pfield of int
+  | Pfield_computed
+  | Psetfield of int * immediate_or_pointer * initialization_or_assignment
+  | Psetfield_computed of immediate_or_pointer * initialization_or_assignment
+  | Pfloatfield of int
+  | Psetfloatfield of int * initialization_or_assignment
+  | Pduprecord of Types.record_representation * int
+  (* External call *)
+  | Pccall of Primitive.description
+  (* Exceptions *)
+  | Praise of raise_kind
+  (* Boolean operations *)
+  | Psequand | Psequor | Pnot
+  (* Integer operations *)
+  | Pnegint | Paddint | Psubint | Pmulint
+  | Pdivint of is_safe | Pmodint of is_safe
+  | Pandint | Porint | Pxorint
+  | Plslint | Plsrint | Pasrint
+  | Pintcomp of integer_comparison
+  | Pcompare_ints | Pcompare_floats | Pcompare_bints of boxed_integer
+  | Poffsetint of int
+  | Poffsetref of int
+  (* Float operations *)
+  | Pintoffloat | Pfloatofint
+  | Pnegfloat | Pabsfloat
+  | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
+  | Pfloatcomp of float_comparison
+  (* String operations *)
+  | Pstringlength | Pstringrefu  | Pstringrefs
+  | Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
+  (* Array operations *)
+  | Pmakearray of array_kind * mutable_flag
+  (** For [Pmakearray], the list of arguments must not be empty.  The empty
+      array should be represented by a distinguished constant in the middle
+      end. *)
+  | Pduparray of array_kind * mutable_flag
+  (** For [Pduparray], the argument must be an immutable array.
+      The arguments of [Pduparray] give the kind and mutability of the
+      array being *produced* by the duplication. *)
+  | Parraylength of array_kind
+  | Parrayrefu of array_kind
+  | Parraysetu of array_kind
+  | Parrayrefs of array_kind
+  | Parraysets of array_kind
+  (* Test if the argument is a block or an immediate integer *)
+  | Pisint
+  (* Test if the (integer) argument is outside an interval *)
+  | Pisout
+  (* Operations on boxed integers (Nativeint.t, Int32.t, Int64.t) *)
+  | Pbintofint of boxed_integer
+  | Pintofbint of boxed_integer
+  | Pcvtbint of boxed_integer (*source*) * boxed_integer (*destination*)
+  | Pnegbint of boxed_integer
+  | Paddbint of boxed_integer
+  | Psubbint of boxed_integer
+  | Pmulbint of boxed_integer
+  | Pdivbint of { size : boxed_integer; is_safe : is_safe }
+  | Pmodbint of { size : boxed_integer; is_safe : is_safe }
+  | Pandbint of boxed_integer
+  | Porbint of boxed_integer
+  | Pxorbint of boxed_integer
+  | Plslbint of boxed_integer
+  | Plsrbint of boxed_integer
+  | Pasrbint of boxed_integer
+  | Pbintcomp of boxed_integer * integer_comparison
+  (* Operations on big arrays: (unsafe, #dimensions, kind, layout) *)
+  | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
+  | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
+  (* size of the nth dimension of a big array *)
+  | Pbigarraydim of int
+  (* load/set 16,32,64 bits from a string: (unsafe)*)
+  | Pstring_load of (memory_access_size * is_safe)
+  | Pbytes_load of (memory_access_size * is_safe)
+  | Pbytes_set of (memory_access_size * is_safe)
+  (* load/set 16,32,64 bits from a
+     (char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *)
+  | Pbigstring_load of (memory_access_size * is_safe)
+  | Pbigstring_set of (memory_access_size * is_safe)
+  (* byte swap *)
+  | Pbswap16
+  | Pbbswap of boxed_integer
+  (* Integer to external pointer *)
+  | Pint_as_pointer
+  (* Inhibition of optimisation *)
+  | Popaque
+
+and integer_comparison = Lambda.integer_comparison =
+    Ceq | Cne | Clt | Cgt | Cle | Cge
+
+and float_comparison = Lambda.float_comparison =
+    CFeq | CFneq | CFlt | CFnlt | CFgt | CFngt | CFle | CFnle | CFge | CFnge
+
+and array_kind = Lambda.array_kind =
+    Pgenarray | Paddrarray | Pintarray | Pfloatarray
+
+and value_kind = Lambda.value_kind =
+  (* CR mshinwell: Pfloatval should be renamed to Pboxedfloatval *)
+    Pgenval | Pfloatval | Pboxedintval of boxed_integer | Pintval
+
+and block_shape = Lambda.block_shape
+and boxed_integer = Primitive.boxed_integer =
+    Pnativeint | Pint32 | Pint64
+
+and bigarray_kind = Lambda.bigarray_kind =
+    Pbigarray_unknown
+  | Pbigarray_float32 | Pbigarray_float64
+  | Pbigarray_sint8 | Pbigarray_uint8
+  | Pbigarray_sint16 | Pbigarray_uint16
+  | Pbigarray_int32 | Pbigarray_int64
+  | Pbigarray_caml_int | Pbigarray_native_int
+  | Pbigarray_complex32 | Pbigarray_complex64
+
+and bigarray_layout = Lambda.bigarray_layout =
+    Pbigarray_unknown_layout
+  | Pbigarray_c_layout
+  | Pbigarray_fortran_layout
+
+and raise_kind = Lambda.raise_kind =
+  | Raise_regular
+  | Raise_reraise
+  | Raise_notrace
+
+val equal : primitive -> primitive -> bool
diff --git a/middle_end/closure/closure.ml b/middle_end/closure/closure.ml
new file mode 100644
index 00000000..4ab57790
--- /dev/null
+++ b/middle_end/closure/closure.ml
@@ -0,0 +1,1502 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Introduction of closures, uncurrying, recognition of direct calls *)
+
+open Misc
+open Asttypes
+open Primitive
+open Lambda
+open Switch
+open Clambda
+module P = Clambda_primitives
+
+module Int = Numbers.Int
+module Storer =
+  Switch.Store
+    (struct
+      type t = lambda
+      type key = lambda
+      let make_key =  Lambda.make_key
+      let compare_key = Stdlib.compare
+    end)
+
+module V = Backend_var
+module VP = Backend_var.With_provenance
+
+(* The current backend *)
+
+let no_phantom_lets () =
+  Misc.fatal_error "Closure does not support phantom let generation"
+
+(* Auxiliaries for compiling functions *)
+
+let rec split_list n l =
+  if n <= 0 then ([], l) else begin
+    match l with
+      [] -> fatal_error "Closure.split_list"
+    | a::l -> let (l1, l2) = split_list (n-1) l in (a::l1, l2)
+  end
+
+let rec build_closure_env env_param pos = function
+    [] -> V.Map.empty
+  | id :: rem ->
+      V.Map.add id
+        (Uprim(P.Pfield pos, [Uvar env_param], Debuginfo.none))
+          (build_closure_env env_param (pos+1) rem)
+
+(* Auxiliary for accessing globals.  We change the name of the global
+   to the name of the corresponding asm symbol.  This is done here
+   and no longer in Cmmgen so that approximations stored in .cmx files
+   contain the right names if the -for-pack option is active. *)
+
+let getglobal dbg id =
+  Uprim(P.Pread_symbol (Compilenv.symbol_for_global id), [], dbg)
+
+(* Check if a variable occurs in a [clambda] term. *)
+
+let occurs_var var u =
+  let rec occurs = function
+      Uvar v -> v = var
+    | Uconst _ -> false
+    | Udirect_apply(_lbl, args, _) -> List.exists occurs args
+    | Ugeneric_apply(funct, args, _) -> occurs funct || List.exists occurs args
+    | Uclosure(_fundecls, clos) -> List.exists occurs clos
+    | Uoffset(u, _ofs) -> occurs u
+    | Ulet(_str, _kind, _id, def, body) -> occurs def || occurs body
+    | Uphantom_let _ -> no_phantom_lets ()
+    | Uletrec(decls, body) ->
+        List.exists (fun (_id, u) -> occurs u) decls || occurs body
+    | Uprim(_p, args, _) -> List.exists occurs args
+    | Uswitch(arg, s, _dbg) ->
+        occurs arg ||
+        occurs_array s.us_actions_consts || occurs_array s.us_actions_blocks
+    | Ustringswitch(arg,sw,d) ->
+        occurs arg ||
+        List.exists (fun (_,e) -> occurs e) sw ||
+        (match d with None -> false | Some d -> occurs d)
+    | Ustaticfail (_, args) -> List.exists occurs args
+    | Ucatch(_, _, body, hdlr) -> occurs body || occurs hdlr
+    | Utrywith(body, _exn, hdlr) -> occurs body || occurs hdlr
+    | Uifthenelse(cond, ifso, ifnot) ->
+        occurs cond || occurs ifso || occurs ifnot
+    | Usequence(u1, u2) -> occurs u1 || occurs u2
+    | Uwhile(cond, body) -> occurs cond || occurs body
+    | Ufor(_id, lo, hi, _dir, body) -> occurs lo || occurs hi || occurs body
+    | Uassign(id, u) -> id = var || occurs u
+    | Usend(_, met, obj, args, _) ->
+        occurs met || occurs obj || List.exists occurs args
+    | Uunreachable -> false
+  and occurs_array a =
+    try
+      for i = 0 to Array.length a - 1 do
+        if occurs a.(i) then raise Exit
+      done;
+      false
+    with Exit ->
+      true
+  in occurs u
+
+(* Determine whether the estimated size of a clambda term is below
+   some threshold *)
+
+let prim_size prim args =
+  let open Clambda_primitives in
+  match prim with
+  | Pread_symbol _ -> 1
+  | Pmakeblock _ -> 5 + List.length args
+  | Pfield _ -> 1
+  | Psetfield(_f, isptr, init) ->
+    begin match init with
+    | Root_initialization -> 1  (* never causes a write barrier hit *)
+    | Assignment | Heap_initialization ->
+      match isptr with
+      | Pointer -> 4
+      | Immediate -> 1
+    end
+  | Pfloatfield _ -> 1
+  | Psetfloatfield _ -> 1
+  | Pduprecord _ -> 10 + List.length args
+  | Pccall p -> (if p.prim_alloc then 10 else 4) + List.length args
+  | Praise _ -> 4
+  | Pstringlength -> 5
+  | Pbyteslength -> 5
+  | Pstringrefs  -> 6
+  | Pbytesrefs | Pbytessets -> 6
+  | Pmakearray _ -> 5 + List.length args
+  | Parraylength kind -> if kind = Pgenarray then 6 else 2
+  | Parrayrefu kind -> if kind = Pgenarray then 12 else 2
+  | Parraysetu kind -> if kind = Pgenarray then 16 else 4
+  | Parrayrefs kind -> if kind = Pgenarray then 18 else 8
+  | Parraysets kind -> if kind = Pgenarray then 22 else 10
+  | Pbigarrayref(_, ndims, _, _) -> 4 + ndims * 6
+  | Pbigarrayset(_, ndims, _, _) -> 4 + ndims * 6
+  | _ -> 2 (* arithmetic and comparisons *)
+
+(* Very raw approximation of switch cost *)
+
+let lambda_smaller lam threshold =
+  let size = ref 0 in
+  let rec lambda_size lam =
+    if !size > threshold then raise Exit;
+    match lam with
+      Uvar _ -> ()
+    | Uconst _ -> incr size
+    | Udirect_apply(_, args, _) ->
+        size := !size + 4; lambda_list_size args
+    | Ugeneric_apply(fn, args, _) ->
+        size := !size + 6; lambda_size fn; lambda_list_size args
+    | Uclosure _ ->
+        raise Exit (* inlining would duplicate function definitions *)
+    | Uoffset(lam, _ofs) ->
+        incr size; lambda_size lam
+    | Ulet(_str, _kind, _id, lam, body) ->
+        lambda_size lam; lambda_size body
+    | Uphantom_let _ -> no_phantom_lets ()
+    | Uletrec _ ->
+        raise Exit (* usually too large *)
+    | Uprim(prim, args, _) ->
+        size := !size + prim_size prim args;
+        lambda_list_size args
+    | Uswitch(lam, cases, _dbg) ->
+        if Array.length cases.us_actions_consts > 1 then size := !size + 5 ;
+        if Array.length cases.us_actions_blocks > 1 then size := !size + 5 ;
+        lambda_size lam;
+        lambda_array_size cases.us_actions_consts ;
+        lambda_array_size cases.us_actions_blocks
+    | Ustringswitch (lam,sw,d) ->
+        lambda_size lam ;
+       (* as ifthenelse *)
+        List.iter
+          (fun (_,lam) ->
+            size := !size+2 ;
+            lambda_size lam)
+          sw ;
+        Option.iter lambda_size d
+    | Ustaticfail (_,args) -> lambda_list_size args
+    | Ucatch(_, _, body, handler) ->
+        incr size; lambda_size body; lambda_size handler
+    | Utrywith(body, _id, handler) ->
+        size := !size + 8; lambda_size body; lambda_size handler
+    | Uifthenelse(cond, ifso, ifnot) ->
+        size := !size + 2;
+        lambda_size cond; lambda_size ifso; lambda_size ifnot
+    | Usequence(lam1, lam2) ->
+        lambda_size lam1; lambda_size lam2
+    | Uwhile(cond, body) ->
+        size := !size + 2; lambda_size cond; lambda_size body
+    | Ufor(_id, low, high, _dir, body) ->
+        size := !size + 4; lambda_size low; lambda_size high; lambda_size body
+    | Uassign(_id, lam) ->
+        incr size;  lambda_size lam
+    | Usend(_, met, obj, args, _) ->
+        size := !size + 8;
+        lambda_size met; lambda_size obj; lambda_list_size args
+    | Uunreachable -> ()
+  and lambda_list_size l = List.iter lambda_size l
+  and lambda_array_size a = Array.iter lambda_size a in
+  try
+    lambda_size lam; !size <= threshold
+  with Exit ->
+    false
+
+let is_pure_prim p =
+  let open Semantics_of_primitives in
+  match Semantics_of_primitives.for_primitive p with
+  | (No_effects | Only_generative_effects), _ -> true
+  | Arbitrary_effects, _ -> false
+
+(* Check if a clambda term is ``pure'',
+   that is without side-effects *and* not containing function definitions *)
+
+let rec is_pure = function
+    Uvar _ -> true
+  | Uconst _ -> true
+  | Uprim(p, args, _) -> is_pure_prim p && List.for_all is_pure args
+  | Uoffset(arg, _) -> is_pure arg
+  | Ulet(Immutable, _, _var, def, body) ->
+      is_pure def && is_pure body
+  | _ -> false
+
+(* Simplify primitive operations on known arguments *)
+
+let make_const c = (Uconst c, Value_const c)
+let make_const_ref c =
+  make_const(Uconst_ref(Compilenv.new_structured_constant ~shared:true c,
+    Some c))
+let make_const_int n = make_const (Uconst_int n)
+let make_const_ptr n = make_const (Uconst_ptr n)
+let make_const_bool b = make_const_ptr(if b then 1 else 0)
+
+let make_integer_comparison cmp x y =
+  let open Clambda_primitives in
+  make_const_bool
+    (match cmp with
+       Ceq -> x = y
+     | Cne -> x <> y
+     | Clt -> x < y
+     | Cgt -> x > y
+     | Cle -> x <= y
+     | Cge -> x >= y)
+
+let make_float_comparison cmp x y =
+  make_const_bool
+    (match cmp with
+     | CFeq -> x = y
+     | CFneq -> not (x = y)
+     | CFlt -> x < y
+     | CFnlt -> not (x < y)
+     | CFgt -> x > y
+     | CFngt -> not (x > y)
+     | CFle -> x <= y
+     | CFnle -> not (x <= y)
+     | CFge -> x >= y
+     | CFnge -> not (x >= y))
+
+let make_const_float n = make_const_ref (Uconst_float n)
+let make_const_natint n = make_const_ref (Uconst_nativeint n)
+let make_const_int32 n = make_const_ref (Uconst_int32 n)
+let make_const_int64 n = make_const_ref (Uconst_int64 n)
+
+(* The [fpc] parameter is true if constant propagation of
+   floating-point computations is allowed *)
+
+let simplif_arith_prim_pure ~backend fpc p (args, approxs) dbg =
+  let module B = (val backend : Backend_intf.S) in
+  let open Clambda_primitives in
+  let default = (Uprim(p, args, dbg), Value_unknown) in
+  match approxs with
+  (* int (or enumerated type) *)
+  | [ Value_const(Uconst_int n1 | Uconst_ptr n1) ] ->
+      begin match p with
+      | Pnot -> make_const_bool (n1 = 0)
+      | Pnegint -> make_const_int (- n1)
+      | Poffsetint n -> make_const_int (n + n1)
+      | Pfloatofint when fpc -> make_const_float (float_of_int n1)
+      | Pbintofint Pnativeint -> make_const_natint (Nativeint.of_int n1)
+      | Pbintofint Pint32 -> make_const_int32 (Int32.of_int n1)
+      | Pbintofint Pint64 -> make_const_int64 (Int64.of_int n1)
+      | Pbswap16 -> make_const_int (((n1 land 0xff) lsl 8)
+                                    lor ((n1 land 0xff00) lsr 8))
+      | _ -> default
+      end
+  (* int (or enumerated type), int (or enumerated type) *)
+  | [ Value_const(Uconst_int n1 | Uconst_ptr n1);
+      Value_const(Uconst_int n2 | Uconst_ptr n2) ] ->
+      begin match p with
+      | Psequand -> make_const_bool (n1 <> 0 && n2 <> 0)
+      | Psequor -> make_const_bool (n1 <> 0 || n2 <> 0)
+      | Paddint -> make_const_int (n1 + n2)
+      | Psubint -> make_const_int (n1 - n2)
+      | Pmulint -> make_const_int (n1 * n2)
+      | Pdivint _ when n2 <> 0 -> make_const_int (n1 / n2)
+      | Pmodint _ when n2 <> 0 -> make_const_int (n1 mod n2)
+      | Pandint -> make_const_int (n1 land n2)
+      | Porint -> make_const_int (n1 lor n2)
+      | Pxorint -> make_const_int (n1 lxor n2)
+      | Plslint when 0 <= n2 && n2 < 8 * B.size_int ->
+          make_const_int (n1 lsl n2)
+      | Plsrint when 0 <= n2 && n2 < 8 * B.size_int ->
+          make_const_int (n1 lsr n2)
+      | Pasrint when 0 <= n2 && n2 < 8 * B.size_int ->
+          make_const_int (n1 asr n2)
+      | Pintcomp c -> make_integer_comparison c n1 n2
+      | _ -> default
+      end
+  (* float *)
+  | [Value_const(Uconst_ref(_, Some (Uconst_float n1)))] when fpc ->
+      begin match p with
+      | Pintoffloat -> make_const_int (int_of_float n1)
+      | Pnegfloat -> make_const_float (-. n1)
+      | Pabsfloat -> make_const_float (abs_float n1)
+      | _ -> default
+      end
+  (* float, float *)
+  | [Value_const(Uconst_ref(_, Some (Uconst_float n1)));
+     Value_const(Uconst_ref(_, Some (Uconst_float n2)))] when fpc ->
+      begin match p with
+      | Paddfloat -> make_const_float (n1 +. n2)
+      | Psubfloat -> make_const_float (n1 -. n2)
+      | Pmulfloat -> make_const_float (n1 *. n2)
+      | Pdivfloat -> make_const_float (n1 /. n2)
+      | Pfloatcomp c  -> make_float_comparison c n1 n2
+      | _ -> default
+      end
+  (* nativeint *)
+  | [Value_const(Uconst_ref(_, Some (Uconst_nativeint n)))] ->
+      begin match p with
+      | Pintofbint Pnativeint -> make_const_int (Nativeint.to_int n)
+      | Pcvtbint(Pnativeint, Pint32) -> make_const_int32 (Nativeint.to_int32 n)
+      | Pcvtbint(Pnativeint, Pint64) -> make_const_int64 (Int64.of_nativeint n)
+      | Pnegbint Pnativeint -> make_const_natint (Nativeint.neg n)
+      | _ -> default
+      end
+  (* nativeint, nativeint *)
+  | [Value_const(Uconst_ref(_, Some (Uconst_nativeint n1)));
+     Value_const(Uconst_ref(_, Some (Uconst_nativeint n2)))] ->
+      begin match p with
+      | Paddbint Pnativeint -> make_const_natint (Nativeint.add n1 n2)
+      | Psubbint Pnativeint -> make_const_natint (Nativeint.sub n1 n2)
+      | Pmulbint Pnativeint -> make_const_natint (Nativeint.mul n1 n2)
+      | Pdivbint {size=Pnativeint} when n2 <> 0n ->
+          make_const_natint (Nativeint.div n1 n2)
+      | Pmodbint {size=Pnativeint} when n2 <> 0n ->
+          make_const_natint (Nativeint.rem n1 n2)
+      | Pandbint Pnativeint -> make_const_natint (Nativeint.logand n1 n2)
+      | Porbint Pnativeint ->  make_const_natint (Nativeint.logor n1 n2)
+      | Pxorbint Pnativeint -> make_const_natint (Nativeint.logxor n1 n2)
+      | Pbintcomp(Pnativeint, c)  -> make_integer_comparison c n1 n2
+      | _ -> default
+      end
+  (* nativeint, int *)
+  | [Value_const(Uconst_ref(_, Some (Uconst_nativeint n1)));
+     Value_const(Uconst_int n2)] ->
+      begin match p with
+      | Plslbint Pnativeint when 0 <= n2 && n2 < 8 * B.size_int ->
+          make_const_natint (Nativeint.shift_left n1 n2)
+      | Plsrbint Pnativeint when 0 <= n2 && n2 < 8 * B.size_int ->
+          make_const_natint (Nativeint.shift_right_logical n1 n2)
+      | Pasrbint Pnativeint when 0 <= n2 && n2 < 8 * B.size_int ->
+          make_const_natint (Nativeint.shift_right n1 n2)
+      | _ -> default
+      end
+  (* int32 *)
+  | [Value_const(Uconst_ref(_, Some (Uconst_int32 n)))] ->
+      begin match p with
+      | Pintofbint Pint32 -> make_const_int (Int32.to_int n)
+      | Pcvtbint(Pint32, Pnativeint) -> make_const_natint (Nativeint.of_int32 n)
+      | Pcvtbint(Pint32, Pint64) -> make_const_int64 (Int64.of_int32 n)
+      | Pnegbint Pint32 -> make_const_int32 (Int32.neg n)
+      | _ -> default
+      end
+  (* int32, int32 *)
+  | [Value_const(Uconst_ref(_, Some (Uconst_int32 n1)));
+     Value_const(Uconst_ref(_, Some (Uconst_int32 n2)))] ->
+      begin match p with
+      | Paddbint Pint32 -> make_const_int32 (Int32.add n1 n2)
+      | Psubbint Pint32 -> make_const_int32 (Int32.sub n1 n2)
+      | Pmulbint Pint32 -> make_const_int32 (Int32.mul n1 n2)
+      | Pdivbint {size=Pint32} when n2 <> 0l ->
+          make_const_int32 (Int32.div n1 n2)
+      | Pmodbint {size=Pint32} when n2 <> 0l ->
+          make_const_int32 (Int32.rem n1 n2)
+      | Pandbint Pint32 -> make_const_int32 (Int32.logand n1 n2)
+      | Porbint Pint32 -> make_const_int32 (Int32.logor n1 n2)
+      | Pxorbint Pint32 -> make_const_int32 (Int32.logxor n1 n2)
+      | Pbintcomp(Pint32, c) -> make_integer_comparison c n1 n2
+      | _ -> default
+      end
+  (* int32, int *)
+  | [Value_const(Uconst_ref(_, Some (Uconst_int32 n1)));
+     Value_const(Uconst_int n2)] ->
+      begin match p with
+      | Plslbint Pint32 when 0 <= n2 && n2 < 32 ->
+          make_const_int32 (Int32.shift_left n1 n2)
+      | Plsrbint Pint32 when 0 <= n2 && n2 < 32 ->
+          make_const_int32 (Int32.shift_right_logical n1 n2)
+      | Pasrbint Pint32 when 0 <= n2 && n2 < 32 ->
+          make_const_int32 (Int32.shift_right n1 n2)
+      | _ -> default
+      end
+  (* int64 *)
+  | [Value_const(Uconst_ref(_, Some (Uconst_int64 n)))] ->
+      begin match p with
+      | Pintofbint Pint64 -> make_const_int (Int64.to_int n)
+      | Pcvtbint(Pint64, Pint32) -> make_const_int32 (Int64.to_int32 n)
+      | Pcvtbint(Pint64, Pnativeint) -> make_const_natint (Int64.to_nativeint n)
+      | Pnegbint Pint64 -> make_const_int64 (Int64.neg n)
+      | _ -> default
+      end
+  (* int64, int64 *)
+  | [Value_const(Uconst_ref(_, Some (Uconst_int64 n1)));
+     Value_const(Uconst_ref(_, Some (Uconst_int64 n2)))] ->
+      begin match p with
+      | Paddbint Pint64 -> make_const_int64 (Int64.add n1 n2)
+      | Psubbint Pint64 -> make_const_int64 (Int64.sub n1 n2)
+      | Pmulbint Pint64 -> make_const_int64 (Int64.mul n1 n2)
+      | Pdivbint {size=Pint64} when n2 <> 0L ->
+          make_const_int64 (Int64.div n1 n2)
+      | Pmodbint {size=Pint64} when n2 <> 0L ->
+          make_const_int64 (Int64.rem n1 n2)
+      | Pandbint Pint64 -> make_const_int64 (Int64.logand n1 n2)
+      | Porbint Pint64 -> make_const_int64 (Int64.logor n1 n2)
+      | Pxorbint Pint64 -> make_const_int64 (Int64.logxor n1 n2)
+      | Pbintcomp(Pint64, c) -> make_integer_comparison c n1 n2
+      | _ -> default
+      end
+  (* int64, int *)
+  | [Value_const(Uconst_ref(_, Some (Uconst_int64 n1)));
+     Value_const(Uconst_int n2)] ->
+      begin match p with
+      | Plslbint Pint64 when 0 <= n2 && n2 < 64 ->
+          make_const_int64 (Int64.shift_left n1 n2)
+      | Plsrbint Pint64 when 0 <= n2 && n2 < 64 ->
+          make_const_int64 (Int64.shift_right_logical n1 n2)
+      | Pasrbint Pint64 when 0 <= n2 && n2 < 64 ->
+          make_const_int64 (Int64.shift_right n1 n2)
+      | _ -> default
+      end
+  (* TODO: Pbbswap *)
+  (* Catch-all *)
+  | _ ->
+     default
+
+let field_approx n = function
+  | Value_tuple a when n < Array.length a -> a.(n)
+  | Value_const (Uconst_ref(_, Some (Uconst_block(_, l))))
+    when n < List.length l ->
+      Value_const (List.nth l n)
+  | _ -> Value_unknown
+
+let simplif_prim_pure ~backend fpc p (args, approxs) dbg =
+  let open Clambda_primitives in
+  match p, args, approxs with
+  (* Block construction *)
+  | Pmakeblock(tag, Immutable, _kind), _, _ ->
+      let field = function
+        | Value_const c -> c
+        | _ -> raise Exit
+      in
+      begin try
+        let cst = Uconst_block (tag, List.map field approxs) in
+        let name =
+          Compilenv.new_structured_constant cst ~shared:true
+        in
+        make_const (Uconst_ref (name, Some cst))
+      with Exit ->
+        (Uprim(p, args, dbg), Value_tuple (Array.of_list approxs))
+      end
+  (* Field access *)
+  | Pfield n, _, [ Value_const(Uconst_ref(_, Some (Uconst_block(_, l)))) ]
+    when n < List.length l ->
+      make_const (List.nth l n)
+  | Pfield n, [ Uprim(P.Pmakeblock _, ul, _) ], [approx]
+    when n < List.length ul ->
+      (List.nth ul n, field_approx n approx)
+  (* Strings *)
+  | (Pstringlength | Pbyteslength),
+     _,
+     [ Value_const(Uconst_ref(_, Some (Uconst_string s))) ] ->
+      make_const_int (String.length s)
+  (* Kind test *)
+  | Pisint, _, [a1] ->
+      begin match a1 with
+      | Value_const(Uconst_int _ | Uconst_ptr _) -> make_const_bool true
+      | Value_const(Uconst_ref _) -> make_const_bool false
+      | Value_closure _ | Value_tuple _ -> make_const_bool false
+      | _ -> (Uprim(p, args, dbg), Value_unknown)
+      end
+  (* Catch-all *)
+  | _ ->
+      simplif_arith_prim_pure ~backend fpc p (args, approxs) dbg
+
+let simplif_prim ~backend fpc p (args, approxs as args_approxs) dbg =
+  if List.for_all is_pure args
+  then simplif_prim_pure ~backend fpc p args_approxs dbg
+  else
+    (* XXX : always return the same approxs as simplif_prim_pure? *)
+    let approx =
+      match p with
+      | P.Pmakeblock(_, Immutable, _kind) ->
+          Value_tuple (Array.of_list approxs)
+      | _ ->
+          Value_unknown
+    in
+    (Uprim(p, args, dbg), approx)
+
+(* Substitute variables in a [ulambda] term (a body of an inlined function)
+   and perform some more simplifications on integer primitives.
+   Also perform alpha-conversion on let-bound identifiers to avoid
+   clashes with locally-generated identifiers, and refresh raise counts
+   in order to avoid clashes with inlined code from other modules.
+   The variables must not be assigned in the term.
+   This is used to substitute "trivial" arguments for parameters
+   during inline expansion, and also for the translation of let rec
+   over functions. *)
+
+let approx_ulam = function
+    Uconst c -> Value_const c
+  | _ -> Value_unknown
+
+let find_action idxs acts tag =
+  if 0 <= tag && tag < Array.length idxs then begin
+    let idx = idxs.(tag) in
+    assert(0 <= idx && idx < Array.length acts);
+    Some acts.(idx)
+  end else
+    (* Can this happen? *)
+    None
+
+let subst_debuginfo loc dbg =
+  if !Clflags.debug then
+    Debuginfo.inline loc dbg
+  else
+    dbg
+
+let rec substitute loc ((backend, fpc) as st) sb rn ulam =
+  match ulam with
+    Uvar v ->
+      begin try V.Map.find v sb with Not_found -> ulam end
+  | Uconst _ -> ulam
+  | Udirect_apply(lbl, args, dbg) ->
+      let dbg = subst_debuginfo loc dbg in
+      Udirect_apply(lbl, List.map (substitute loc st sb rn) args, dbg)
+  | Ugeneric_apply(fn, args, dbg) ->
+      let dbg = subst_debuginfo loc dbg in
+      Ugeneric_apply(substitute loc st sb rn fn,
+                     List.map (substitute loc st sb rn) args, dbg)
+  | Uclosure(defs, env) ->
+      (* Question: should we rename function labels as well?  Otherwise,
+         there is a risk that function labels are not globally unique.
+         This should not happen in the current system because:
+         - Inlined function bodies contain no Uclosure nodes
+           (cf. function [lambda_smaller])
+         - When we substitute offsets for idents bound by let rec
+           in [close], case [Lletrec], we discard the original
+           let rec body and use only the substituted term. *)
+      Uclosure(defs, List.map (substitute loc st sb rn) env)
+  | Uoffset(u, ofs) -> Uoffset(substitute loc st sb rn u, ofs)
+  | Ulet(str, kind, id, u1, u2) ->
+      let id' = VP.rename id in
+      Ulet(str, kind, id', substitute loc st sb rn u1,
+           substitute loc st
+             (V.Map.add (VP.var id) (Uvar (VP.var id')) sb) rn u2)
+  | Uphantom_let _ -> no_phantom_lets ()
+  | Uletrec(bindings, body) ->
+      let bindings1 =
+        List.map (fun (id, rhs) ->
+          (VP.var id, VP.rename id, rhs)) bindings
+      in
+      let sb' =
+        List.fold_right (fun (id, id', _) s ->
+            V.Map.add id (Uvar (VP.var id')) s)
+          bindings1 sb
+      in
+      Uletrec(
+        List.map
+           (fun (_id, id', rhs) -> (id', substitute loc st sb' rn rhs))
+           bindings1,
+        substitute loc st sb' rn body)
+  | Uprim(p, args, dbg) ->
+      let sargs = List.map (substitute loc st sb rn) args in
+      let dbg = subst_debuginfo loc dbg in
+      let (res, _) =
+        simplif_prim ~backend fpc p (sargs, List.map approx_ulam sargs) dbg in
+      res
+  | Uswitch(arg, sw, dbg) ->
+      let sarg = substitute loc st sb rn arg in
+      let action =
+        (* Unfortunately, we cannot easily deal with the
+           case of a constructed block (makeblock) bound to a local
+           identifier.  This would require to keep track of
+           local let bindings (at least their approximations)
+           in this substitute function.
+        *)
+        match sarg with
+        | Uconst (Uconst_ref (_,  Some (Uconst_block (tag, _)))) ->
+            find_action sw.us_index_blocks sw.us_actions_blocks tag
+        | Uconst (Uconst_ptr tag) ->
+            find_action sw.us_index_consts sw.us_actions_consts tag
+        | _ -> None
+      in
+      begin match action with
+      | Some u -> substitute loc st sb rn u
+      | None ->
+          Uswitch(sarg,
+                  { sw with
+                    us_actions_consts =
+                      Array.map (substitute loc st sb rn) sw.us_actions_consts;
+                    us_actions_blocks =
+                      Array.map (substitute loc st sb rn) sw.us_actions_blocks;
+                  },
+                  dbg)
+      end
+  | Ustringswitch(arg,sw,d) ->
+      Ustringswitch
+        (substitute loc st sb rn arg,
+         List.map (fun (s,act) -> s,substitute loc st sb rn act) sw,
+         Option.map (substitute loc st sb rn) d)
+  | Ustaticfail (nfail, args) ->
+      let nfail =
+        match rn with
+        | Some rn ->
+          begin try
+            Int.Map.find nfail rn
+          with Not_found ->
+            fatal_errorf "Closure.split_list: invalid nfail (%d)" nfail
+          end
+        | None -> nfail in
+      Ustaticfail (nfail, List.map (substitute loc st sb rn) args)
+  | Ucatch(nfail, ids, u1, u2) ->
+      let nfail, rn =
+        match rn with
+        | Some rn ->
+          let new_nfail = next_raise_count () in
+          new_nfail, Some (Int.Map.add nfail new_nfail rn)
+        | None -> nfail, rn in
+      let ids' = List.map (fun (id, k) -> VP.rename id, k) ids in
+      let sb' =
+        List.fold_right2
+          (fun (id, _) (id', _) s ->
+             V.Map.add (VP.var id) (Uvar (VP.var id')) s
+          )
+          ids ids' sb
+      in
+      Ucatch(nfail, ids', substitute loc st sb rn u1,
+                          substitute loc st sb' rn u2)
+  | Utrywith(u1, id, u2) ->
+      let id' = VP.rename id in
+      Utrywith(substitute loc st sb rn u1, id',
+               substitute loc st
+                 (V.Map.add (VP.var id) (Uvar (VP.var id')) sb) rn u2)
+  | Uifthenelse(u1, u2, u3) ->
+      begin match substitute loc st sb rn u1 with
+        Uconst (Uconst_ptr n) ->
+          if n <> 0 then
+            substitute loc st sb rn u2
+          else
+            substitute loc st sb rn u3
+      | Uprim(P.Pmakeblock _, _, _) ->
+          substitute loc st sb rn u2
+      | su1 ->
+          Uifthenelse(su1, substitute loc st sb rn u2,
+                           substitute loc st sb rn u3)
+      end
+  | Usequence(u1, u2) ->
+      Usequence(substitute loc st sb rn u1, substitute loc st sb rn u2)
+  | Uwhile(u1, u2) ->
+      Uwhile(substitute loc st sb rn u1, substitute loc st sb rn u2)
+  | Ufor(id, u1, u2, dir, u3) ->
+      let id' = VP.rename id in
+      Ufor(id', substitute loc st sb rn u1, substitute loc st sb rn u2, dir,
+           substitute loc st
+           (V.Map.add (VP.var id) (Uvar (VP.var id')) sb) rn u3)
+  | Uassign(id, u) ->
+      let id' =
+        try
+          match V.Map.find id sb with Uvar i -> i | _ -> assert false
+        with Not_found ->
+          id in
+      Uassign(id', substitute loc st sb rn u)
+  | Usend(k, u1, u2, ul, dbg) ->
+      let dbg = subst_debuginfo loc dbg in
+      Usend(k, substitute loc st sb rn u1, substitute loc st sb rn u2,
+            List.map (substitute loc st sb rn) ul, dbg)
+  | Uunreachable ->
+      Uunreachable
+
+type env = {
+  backend : (module Backend_intf.S);
+  cenv : ulambda V.Map.t;
+  fenv : value_approximation V.Map.t;
+  mutable_vars : V.Set.t;
+}
+
+(* Perform an inline expansion:
+
+   If [f p = body], substitute [f a] by [let p = a in body].
+
+   Under certain conditions, further simplifications are possible (we use the
+   terminology of [Semantics_of_primitives], applied to terms of the Clambda
+   language):
+
+   - [f a] is equivalent to [body[a/p]] if [a] has no effects and no coeffects.
+     However, we only want to do this rewriting if [body[a/p]] does not increase
+     the size of [body]. Since this is hard to decide in general, as an
+     approximation, only consider the case when [a] is an immutable variable or
+     a constant.
+
+   - [f a] is equivalent to [body] if [p] does not occur in [body] and [a] has
+     only generative effects.
+
+   - In general [f a] is equivalent to [a; body] if [p] does not occur in
+     [body].
+*)
+
+(* Approximates "no effects and no coeffects" *)
+let is_substituable ~mutable_vars = function
+  | Uvar v -> not (V.Set.mem v mutable_vars)
+  | Uconst _ -> true
+  | _ -> false
+
+(* Approximates "only generative effects" *)
+let is_erasable = function
+  | Uclosure _ -> true
+  | u -> is_pure u
+
+let bind_params { backend; mutable_vars; _ } loc fpc params args body =
+  let rec aux subst pl al body =
+    match (pl, al) with
+      ([], []) -> substitute (Debuginfo.from_location loc) (backend, fpc)
+                    subst (Some Int.Map.empty) body
+    | (p1 :: pl, a1 :: al) ->
+        if is_substituable ~mutable_vars a1 then
+          aux (V.Map.add (VP.var p1) a1 subst) pl al body
+        else begin
+          let p1' = VP.rename p1 in
+          let u1, u2 =
+            match VP.name p1, a1 with
+            | "*opt*", Uprim(P.Pmakeblock(0, Immutable, kind), [a], dbg) ->
+                a, Uprim(P.Pmakeblock(0, Immutable, kind),
+                         [Uvar (VP.var p1')], dbg)
+            | _ ->
+                a1, Uvar (VP.var p1')
+          in
+          let body' = aux (V.Map.add (VP.var p1) u2 subst) pl al body in
+          if occurs_var (VP.var p1) body then
+            Ulet(Immutable, Pgenval, p1', u1, body')
+          else if is_erasable a1 then body'
+          else Usequence(a1, body')
+        end
+    | (_, _) -> assert false
+  in
+  (* Reverse parameters and arguments to preserve right-to-left
+     evaluation order (PR#2910). *)
+  aux V.Map.empty (List.rev params) (List.rev args) body
+
+(* Check if a lambda term is ``pure'',
+   that is without side-effects *and* not containing function definitions *)
+
+let warning_if_forced_inline ~loc ~attribute warning =
+  if attribute = Always_inline then
+    Location.prerr_warning (Debuginfo.Scoped_location.to_location loc)
+      (Warnings.Inlining_impossible warning)
+
+(* Generate a direct application *)
+
+let direct_apply env fundesc ufunct uargs ~loc ~attribute =
+  let app_args =
+    if fundesc.fun_closed then uargs else uargs @ [ufunct] in
+  let app =
+    match fundesc.fun_inline, attribute with
+    | _, Never_inline | None, _ ->
+      let dbg = Debuginfo.from_location loc in
+        warning_if_forced_inline ~loc ~attribute
+          "Function information unavailable";
+        Udirect_apply(fundesc.fun_label, app_args, dbg)
+    | Some(params, body), _  ->
+        bind_params env loc fundesc.fun_float_const_prop params app_args
+          body
+  in
+  (* If ufunct can contain side-effects or function definitions,
+     we must make sure that it is evaluated exactly once.
+     If the function is not closed, we evaluate ufunct as part of the
+     arguments.
+     If the function is closed, we force the evaluation of ufunct first. *)
+  if not fundesc.fun_closed || is_pure ufunct
+  then app
+  else Usequence(ufunct, app)
+
+(* Add [Value_integer] or [Value_constptr] info to the approximation
+   of an application *)
+
+let strengthen_approx appl approx =
+  match approx_ulam appl with
+    (Value_const _) as intapprox ->
+      intapprox
+  | _ -> approx
+
+(* If a term has approximation Value_integer or Value_constptr and is pure,
+   replace it by an integer constant *)
+
+let check_constant_result ulam approx =
+  match approx with
+    Value_const c when is_pure ulam -> make_const c
+  | Value_global_field (id, i) when is_pure ulam ->
+      begin match ulam with
+      | Uprim(P.Pfield _, [Uprim(P.Pread_symbol _, _, _)], _) -> (ulam, approx)
+      | _ ->
+          let glb =
+            Uprim(P.Pread_symbol id, [], Debuginfo.none)
+          in
+          Uprim(P.Pfield i, [glb], Debuginfo.none), approx
+      end
+  | _ -> (ulam, approx)
+
+(* Evaluate an expression with known value for its side effects only,
+   or discard it if it's pure *)
+
+let sequence_constant_expr ulam1 (ulam2, approx2 as res2) =
+  if is_pure ulam1 then res2 else (Usequence(ulam1, ulam2), approx2)
+
+(* Maintain the approximation of the global structure being defined *)
+
+let global_approx = ref([||] : value_approximation array)
+
+(* Maintain the nesting depth for functions *)
+
+let function_nesting_depth = ref 0
+let excessive_function_nesting_depth = 5
+
+(* Uncurry an expression and explicitate closures.
+   Also return the approximation of the expression.
+   The approximation environment [fenv] maps idents to approximations.
+   Idents not bound in [fenv] approximate to [Value_unknown].
+   The closure environment [cenv] maps idents to [ulambda] terms.
+   It is used to substitute environment accesses for free identifiers. *)
+
+exception NotClosed
+
+let close_approx_var { fenv; cenv } id =
+  let approx = try V.Map.find id fenv with Not_found -> Value_unknown in
+  match approx with
+    Value_const c -> make_const c
+  | approx ->
+      let subst = try V.Map.find id cenv with Not_found -> Uvar id in
+      (subst, approx)
+
+let close_var env id =
+  let (ulam, _app) = close_approx_var env id in ulam
+
+let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
+  let module B = (val backend : Backend_intf.S) in
+  match lam with
+  | Lvar id ->
+      close_approx_var env id
+  | Lconst cst ->
+      let str ?(shared = true) cst =
+        let name =
+          Compilenv.new_structured_constant cst ~shared
+        in
+        Uconst_ref (name, Some cst)
+      in
+      let rec transl = function
+        | Const_base(Const_int n) -> Uconst_int n
+        | Const_base(Const_char c) -> Uconst_int (Char.code c)
+        | Const_pointer n -> Uconst_ptr n
+        | Const_block (tag, fields) ->
+            str (Uconst_block (tag, List.map transl fields))
+        | Const_float_array sl ->
+            (* constant float arrays are really immutable *)
+            str (Uconst_float_array (List.map float_of_string sl))
+        | Const_immstring s ->
+            str (Uconst_string s)
+        | Const_base (Const_string (s, _, _)) ->
+              (* Strings (even literal ones) must be assumed to be mutable...
+                 except when OCaml has been configured with
+                 -safe-string.  Passing -safe-string at compilation
+                 time is not enough, since the unit could be linked
+                 with another one compiled without -safe-string, and
+                 that one could modify our string literal.  *)
+            str ~shared:Config.safe_string (Uconst_string s)
+        | Const_base(Const_float x) -> str (Uconst_float (float_of_string x))
+        | Const_base(Const_int32 x) -> str (Uconst_int32 x)
+        | Const_base(Const_int64 x) -> str (Uconst_int64 x)
+        | Const_base(Const_nativeint x) -> str (Uconst_nativeint x)
+      in
+      make_const (transl cst)
+  | Lfunction _ as funct ->
+      close_one_function env (Ident.create_local "fun") funct
+
+    (* We convert [f a] to [let a' = a in let f' = f in fun b c -> f' a' b c]
+       when fun_arity > nargs *)
+  | Lapply{ap_func = funct; ap_args = args; ap_loc = loc;
+        ap_inlined = attribute} ->
+      let nargs = List.length args in
+      begin match (close env funct, close_list env args) with
+        ((ufunct, Value_closure(fundesc, approx_res)),
+         [Uprim(P.Pmakeblock _, uargs, _)])
+        when List.length uargs = - fundesc.fun_arity ->
+          let app =
+            direct_apply env ~loc ~attribute fundesc ufunct uargs in
+          (app, strengthen_approx app approx_res)
+      | ((ufunct, Value_closure(fundesc, approx_res)), uargs)
+        when nargs = fundesc.fun_arity ->
+          let app =
+            direct_apply env ~loc ~attribute fundesc ufunct uargs in
+          (app, strengthen_approx app approx_res)
+
+      | ((ufunct, (Value_closure(fundesc, _) as fapprox)), uargs)
+          when nargs < fundesc.fun_arity ->
+        let first_args = List.map (fun arg ->
+          (V.create_local "arg", arg) ) uargs in
+        let final_args =
+          Array.to_list (Array.init (fundesc.fun_arity - nargs)
+                                    (fun _ -> V.create_local "arg")) in
+        let rec iter args body =
+          match args with
+              [] -> body
+            | (arg1, arg2) :: args ->
+              iter args
+                (Ulet (Immutable, Pgenval, VP.create arg1, arg2, body))
+        in
+        let internal_args =
+          (List.map (fun (arg1, _arg2) -> Lvar arg1) first_args)
+          @ (List.map (fun arg -> Lvar arg ) final_args)
+        in
+        let funct_var = V.create_local "funct" in
+        let fenv = V.Map.add funct_var fapprox fenv in
+        let (new_fun, approx) = close { backend; fenv; cenv; mutable_vars }
+          (Lfunction{
+               kind = Curried;
+               return = Pgenval;
+               params = List.map (fun v -> v, Pgenval) final_args;
+               body = Lapply{ap_should_be_tailcall=false;
+                             ap_loc=loc;
+                             ap_func=(Lvar funct_var);
+                             ap_args=internal_args;
+                             ap_inlined=Default_inline;
+                             ap_specialised=Default_specialise};
+               loc;
+               attr = default_function_attribute})
+        in
+        let new_fun =
+          iter first_args
+            (Ulet (Immutable, Pgenval, VP.create funct_var, ufunct, new_fun))
+        in
+        warning_if_forced_inline ~loc ~attribute "Partial application";
+        (new_fun, approx)
+
+      | ((ufunct, Value_closure(fundesc, _approx_res)), uargs)
+        when fundesc.fun_arity > 0 && nargs > fundesc.fun_arity ->
+          let args = List.map (fun arg -> V.create_local "arg", arg) uargs in
+          let (first_args, rem_args) = split_list fundesc.fun_arity args in
+          let first_args = List.map (fun (id, _) -> Uvar id) first_args in
+          let rem_args = List.map (fun (id, _) -> Uvar id) rem_args in
+          let dbg = Debuginfo.from_location loc in
+          warning_if_forced_inline ~loc ~attribute "Over-application";
+          let body =
+            Ugeneric_apply(direct_apply env ~loc ~attribute
+                              fundesc ufunct first_args,
+                           rem_args, dbg)
+          in
+          let result =
+            List.fold_left (fun body (id, defining_expr) ->
+                Ulet (Immutable, Pgenval, VP.create id, defining_expr, body))
+              body
+              args
+          in
+          result, Value_unknown
+      | ((ufunct, _), uargs) ->
+          let dbg = Debuginfo.from_location loc in
+          warning_if_forced_inline ~loc ~attribute "Unknown function";
+          (Ugeneric_apply(ufunct, uargs, dbg), Value_unknown)
+      end
+  | Lsend(kind, met, obj, args, loc) ->
+      let (umet, _) = close env met in
+      let (uobj, _) = close env obj in
+      let dbg = Debuginfo.from_location loc in
+      (Usend(kind, umet, uobj, close_list env args, dbg),
+       Value_unknown)
+  | Llet(str, kind, id, lam, body) ->
+      let (ulam, alam) = close_named env id lam in
+      begin match (str, alam) with
+        (Variable, _) ->
+          let env = {env with mutable_vars = V.Set.add id env.mutable_vars} in
+          let (ubody, abody) = close env body in
+          (Ulet(Mutable, kind, VP.create id, ulam, ubody), abody)
+      | (_, Value_const _)
+        when str = Alias || is_pure ulam ->
+          close { backend; fenv = (V.Map.add id alam fenv); cenv; mutable_vars }
+            body
+      | (_, _) ->
+          let (ubody, abody) =
+            close
+              { backend; fenv = (V.Map.add id alam fenv); cenv; mutable_vars }
+              body
+          in
+          (Ulet(Immutable, kind, VP.create id, ulam, ubody), abody)
+      end
+  | Lletrec(defs, body) ->
+      if List.for_all
+           (function (_id, Lfunction _) -> true | _ -> false)
+           defs
+      then begin
+        (* Simple case: only function definitions *)
+        let (clos, infos) = close_functions env defs in
+        let clos_ident = V.create_local "clos" in
+        let fenv_body =
+          List.fold_right
+            (fun (id, _pos, approx) fenv -> V.Map.add id approx fenv)
+            infos fenv in
+        let (ubody, approx) =
+          close { backend; fenv = fenv_body; cenv; mutable_vars } body in
+        let sb =
+          List.fold_right
+            (fun (id, pos, _approx) sb ->
+              V.Map.add id (Uoffset(Uvar clos_ident, pos)) sb)
+            infos V.Map.empty in
+        (Ulet(Immutable, Pgenval, VP.create clos_ident, clos,
+              substitute Debuginfo.none (backend, !Clflags.float_const_prop) sb
+                None ubody),
+         approx)
+      end else begin
+        (* General case: recursive definition of values *)
+        let rec clos_defs = function
+          [] -> ([], fenv)
+        | (id, lam) :: rem ->
+            let (udefs, fenv_body) = clos_defs rem in
+            let (ulam, approx) = close_named env id lam in
+            ((VP.create id, ulam) :: udefs, V.Map.add id approx fenv_body) in
+        let (udefs, fenv_body) = clos_defs defs in
+        let (ubody, approx) =
+          close { backend; fenv = fenv_body; cenv; mutable_vars } body in
+        (Uletrec(udefs, ubody), approx)
+      end
+  (* Compile-time constants *)
+  | Lprim(Pctconst c, [arg], _loc) ->
+      let cst, approx =
+        match c with
+        | Big_endian -> make_const_bool B.big_endian
+        | Word_size -> make_const_int (8*B.size_int)
+        | Int_size -> make_const_int (8*B.size_int - 1)
+        | Max_wosize -> make_const_int ((1 lsl ((8*B.size_int) - 10)) - 1 )
+        | Ostype_unix -> make_const_bool (Sys.os_type = "Unix")
+        | Ostype_win32 -> make_const_bool (Sys.os_type = "Win32")
+        | Ostype_cygwin -> make_const_bool (Sys.os_type = "Cygwin")
+        | Backend_type ->
+            make_const_ptr 0 (* tag 0 is the same as Native here *)
+      in
+      let arg, _approx = close env arg in
+      let id = Ident.create_local "dummy" in
+      Ulet(Immutable, Pgenval, VP.create id, arg, cst), approx
+  | Lprim(Pignore, [arg], _loc) ->
+      let expr, approx = make_const_ptr 0 in
+      Usequence(fst (close env arg), expr), approx
+  | Lprim((Pidentity | Pbytes_to_string | Pbytes_of_string), [arg], _loc) ->
+      close env arg
+  | Lprim(Pdirapply,[funct;arg], loc)
+  | Lprim(Prevapply,[arg;funct], loc) ->
+      close env       (Lapply{ap_should_be_tailcall=false;
+                              ap_loc=loc;
+                              ap_func=funct;
+                              ap_args=[arg];
+                              ap_inlined=Default_inline;
+                              ap_specialised=Default_specialise})
+  | Lprim(Pgetglobal id, [], loc) ->
+      let dbg = Debuginfo.from_location loc in
+      check_constant_result (getglobal dbg id)
+                            (Compilenv.global_approx id)
+  | Lprim(Pfield n, [lam], loc) ->
+      let (ulam, approx) = close env lam in
+      let dbg = Debuginfo.from_location loc in
+      check_constant_result (Uprim(P.Pfield n, [ulam], dbg))
+                            (field_approx n approx)
+  | Lprim(Psetfield(n, is_ptr, init), [Lprim(Pgetglobal id, [], _); lam], loc)->
+      let (ulam, approx) = close env lam in
+      if approx <> Value_unknown then
+        (!global_approx).(n) <- approx;
+      let dbg = Debuginfo.from_location loc in
+      (Uprim(P.Psetfield(n, is_ptr, init), [getglobal dbg id; ulam], dbg),
+       Value_unknown)
+  | Lprim(Praise k, [arg], loc) ->
+      let (ulam, _approx) = close env arg in
+      let dbg = Debuginfo.from_location loc in
+      (Uprim(P.Praise k, [ulam], dbg),
+       Value_unknown)
+  | Lprim (Pmakearray _, [], _loc) -> make_const_ref (Uconst_block (0, []))
+  | Lprim(p, args, loc) ->
+      let p = Convert_primitives.convert p in
+      let dbg = Debuginfo.from_location loc in
+      simplif_prim ~backend !Clflags.float_const_prop
+                   p (close_list_approx env args) dbg
+  | Lswitch(arg, sw, dbg) ->
+      let fn fail =
+        let (uarg, _) = close env arg in
+        let const_index, const_actions, fconst =
+          close_switch env sw.sw_consts sw.sw_numconsts fail
+        and block_index, block_actions, fblock =
+          close_switch env sw.sw_blocks sw.sw_numblocks fail in
+        let ulam =
+          Uswitch
+            (uarg,
+             {us_index_consts = const_index;
+              us_actions_consts = const_actions;
+              us_index_blocks = block_index;
+              us_actions_blocks = block_actions},
+             Debuginfo.from_location dbg)
+        in
+        (fconst (fblock ulam),Value_unknown) in
+(* NB: failaction might get copied, thus it should be some Lstaticraise *)
+      let fail = sw.sw_failaction in
+      begin match fail with
+      | None|Some (Lstaticraise (_,_)) -> fn fail
+      | Some lamfail ->
+          if
+            (sw.sw_numconsts - List.length sw.sw_consts) +
+            (sw.sw_numblocks - List.length sw.sw_blocks) > 1
+          then
+            let i = next_raise_count () in
+            let ubody,_ = fn (Some (Lstaticraise (i,[])))
+            and uhandler,_ = close env lamfail in
+            Ucatch (i,[],ubody,uhandler),Value_unknown
+          else fn fail
+      end
+  | Lstringswitch(arg,sw,d,_) ->
+      let uarg,_ = close env arg in
+      let usw =
+        List.map
+          (fun (s,act) ->
+            let uact,_ = close env act in
+            s,uact)
+          sw in
+      let ud =
+        Option.map
+          (fun d ->
+            let ud,_ = close env d in
+            ud) d in
+      Ustringswitch (uarg,usw,ud),Value_unknown
+  | Lstaticraise (i, args) ->
+      (Ustaticfail (i, close_list env args), Value_unknown)
+  | Lstaticcatch(body, (i, vars), handler) ->
+      let (ubody, _) = close env body in
+      let (uhandler, _) = close env handler in
+      let vars = List.map (fun (var, k) -> VP.create var, k) vars in
+      (Ucatch(i, vars, ubody, uhandler), Value_unknown)
+  | Ltrywith(body, id, handler) ->
+      let (ubody, _) = close env body in
+      let (uhandler, _) = close env handler in
+      (Utrywith(ubody, VP.create id, uhandler), Value_unknown)
+  | Lifthenelse(arg, ifso, ifnot) ->
+      begin match close env arg with
+        (uarg, Value_const (Uconst_ptr n)) ->
+          sequence_constant_expr uarg
+            (close env (if n = 0 then ifnot else ifso))
+      | (uarg, _ ) ->
+          let (uifso, _) = close env ifso in
+          let (uifnot, _) = close env ifnot in
+          (Uifthenelse(uarg, uifso, uifnot), Value_unknown)
+      end
+  | Lsequence(lam1, lam2) ->
+      let (ulam1, _) = close env lam1 in
+      let (ulam2, approx) = close env lam2 in
+      (Usequence(ulam1, ulam2), approx)
+  | Lwhile(cond, body) ->
+      let (ucond, _) = close env cond in
+      let (ubody, _) = close env body in
+      (Uwhile(ucond, ubody), Value_unknown)
+  | Lfor(id, lo, hi, dir, body) ->
+      let (ulo, _) = close env lo in
+      let (uhi, _) = close env hi in
+      let (ubody, _) = close env body in
+      (Ufor(VP.create id, ulo, uhi, dir, ubody), Value_unknown)
+  | Lassign(id, lam) ->
+      let (ulam, _) = close env lam in
+      (Uassign(id, ulam), Value_unknown)
+  | Levent(lam, _) ->
+      close env lam
+  | Lifused _ ->
+      assert false
+
+and close_list env = function
+    [] -> []
+  | lam :: rem ->
+      let (ulam, _) = close env lam in
+      ulam :: close_list env rem
+
+and close_list_approx env = function
+    [] -> ([], [])
+  | lam :: rem ->
+      let (ulam, approx) = close env lam in
+      let (ulams, approxs) = close_list_approx env rem in
+      (ulam :: ulams, approx :: approxs)
+
+and close_named env id = function
+    Lfunction _ as funct ->
+      close_one_function env id funct
+  | lam ->
+      close env lam
+
+(* Build a shared closure for a set of mutually recursive functions *)
+
+and close_functions { backend; fenv; cenv; mutable_vars } fun_defs =
+  let fun_defs =
+    List.flatten
+      (List.map
+         (function
+           | (id, Lfunction{kind; params; return; body; attr; loc}) ->
+               Simplif.split_default_wrapper ~id ~kind ~params
+                 ~body ~attr ~loc ~return
+           | _ -> assert false
+         )
+         fun_defs)
+  in
+  let inline_attribute = match fun_defs with
+    | [_, Lfunction{attr = { inline; }}] -> inline
+    | _ -> Default_inline (* recursive functions can't be inlined *)
+  in
+  (* Update and check nesting depth *)
+  incr function_nesting_depth;
+  let initially_closed =
+    !function_nesting_depth < excessive_function_nesting_depth in
+  (* Determine the free variables of the functions *)
+  let fv =
+    V.Set.elements (free_variables (Lletrec(fun_defs, lambda_unit))) in
+  (* Build the function descriptors for the functions.
+     Initially all functions are assumed not to need their environment
+     parameter. *)
+  let uncurried_defs =
+    List.map
+      (function
+          (id, Lfunction{kind; params; return; body; loc}) ->
+            let label = Compilenv.make_symbol (Some (V.unique_name id)) in
+            let arity = List.length params in
+            let fundesc =
+              {fun_label = label;
+               fun_arity = (if kind = Tupled then -arity else arity);
+               fun_closed = initially_closed;
+               fun_inline = None;
+               fun_float_const_prop = !Clflags.float_const_prop } in
+            let dbg = Debuginfo.from_location loc in
+            (id, params, return, body, fundesc, dbg)
+        | (_, _) -> fatal_error "Closure.close_functions")
+      fun_defs in
+  (* Build an approximate fenv for compiling the functions *)
+  let fenv_rec =
+    List.fold_right
+      (fun (id, _params, _return, _body, fundesc, _dbg) fenv ->
+        V.Map.add id (Value_closure(fundesc, Value_unknown)) fenv)
+      uncurried_defs fenv in
+  (* Determine the offsets of each function's closure in the shared block *)
+  let env_pos = ref (-1) in
+  let clos_offsets =
+    List.map
+      (fun (_id, _params, _return, _body, fundesc, _dbg) ->
+        let pos = !env_pos + 1 in
+        env_pos := !env_pos + 1 + (if fundesc.fun_arity <> 1 then 3 else 2);
+        pos)
+      uncurried_defs in
+  let fv_pos = !env_pos in
+  (* This reference will be set to false if the hypothesis that a function
+     does not use its environment parameter is invalidated. *)
+  let useless_env = ref initially_closed in
+  (* Translate each function definition *)
+  let clos_fundef (id, params, return, body, fundesc, dbg) env_pos =
+    let env_param = V.create_local "env" in
+    let cenv_fv =
+      build_closure_env env_param (fv_pos - env_pos) fv in
+    let cenv_body =
+      List.fold_right2
+        (fun (id, _params, _return, _body, _fundesc, _dbg) pos env ->
+          V.Map.add id (Uoffset(Uvar env_param, pos - env_pos)) env)
+        uncurried_defs clos_offsets cenv_fv in
+    let (ubody, approx) =
+      close { backend; fenv = fenv_rec; cenv = cenv_body; mutable_vars } body
+    in
+    if !useless_env && occurs_var env_param ubody then raise NotClosed;
+    let fun_params =
+      if !useless_env
+      then params
+      else params @ [env_param, Pgenval]
+    in
+    let f =
+      {
+        label  = fundesc.fun_label;
+        arity  = fundesc.fun_arity;
+        params = List.map (fun (var, kind) -> VP.create var, kind) fun_params;
+        return;
+        body   = ubody;
+        dbg;
+        env = Some env_param;
+      }
+    in
+    (* give more chance of function with default parameters (i.e.
+       their wrapper functions) to be inlined *)
+    let n =
+      List.fold_left
+        (fun n (id, _) -> n + if V.name id = "*opt*" then 8 else 1)
+        0
+        fun_params
+    in
+    let threshold =
+      match inline_attribute with
+      | Default_inline ->
+          let inline_threshold =
+            Clflags.Float_arg_helper.get ~key:0 !Clflags.inline_threshold
+          in
+          let magic_scale_constant = 8. in
+          int_of_float (inline_threshold *. magic_scale_constant) + n
+      | Always_inline | Hint_inline -> max_int
+      | Never_inline -> min_int
+      | Unroll _ -> assert false
+    in
+    let fun_params = List.map (fun (var, _) -> VP.create var) fun_params in
+    if lambda_smaller ubody threshold
+    then fundesc.fun_inline <- Some(fun_params, ubody);
+
+    (f, (id, env_pos, Value_closure(fundesc, approx))) in
+  (* Translate all function definitions. *)
+  let clos_info_list =
+    if initially_closed then begin
+      let snap = Compilenv.snapshot () in
+      try List.map2 clos_fundef uncurried_defs clos_offsets
+      with NotClosed ->
+      (* If the hypothesis that the environment parameters are useless has been
+         invalidated, then set [fun_closed] to false in all descriptions and
+         recompile *)
+        Compilenv.backtrack snap; (* PR#6337 *)
+        List.iter
+          (fun (_id, _params, _return, _body, fundesc, _dbg) ->
+             fundesc.fun_closed <- false;
+             fundesc.fun_inline <- None;
+          )
+          uncurried_defs;
+        useless_env := false;
+        List.map2 clos_fundef uncurried_defs clos_offsets
+    end else
+      (* Excessive closure nesting: assume environment parameter is used *)
+        List.map2 clos_fundef uncurried_defs clos_offsets
+    in
+  (* Update nesting depth *)
+  decr function_nesting_depth;
+  (* Return the Uclosure node and the list of all identifiers defined,
+     with offsets and approximations. *)
+  let (clos, infos) = List.split clos_info_list in
+  let fv = if !useless_env then [] else fv in
+  (Uclosure(clos,
+            List.map (close_var { backend; fenv; cenv; mutable_vars }) fv),
+   infos)
+
+(* Same, for one non-recursive function *)
+
+and close_one_function env id funct =
+  match close_functions env [id, funct] with
+  | (clos, (i, _, approx) :: _) when id = i -> (clos, approx)
+  | _ -> fatal_error "Closure.close_one_function"
+
+(* Close a switch *)
+
+and close_switch env cases num_keys default =
+  let ncases = List.length cases in
+  let index = Array.make num_keys 0
+  and store = Storer.mk_store () in
+
+  (* First default case *)
+  begin match default with
+  | Some def when ncases < num_keys ->
+      assert (store.act_store () def = 0)
+  | _ -> ()
+  end ;
+  (* Then all other cases *)
+  List.iter
+    (fun (key,lam) ->
+     index.(key) <- store.act_store () lam)
+    cases ;
+
+  (*  Explicit sharing with catch/exit, as switcher compilation may
+      later unshare *)
+  let acts = store.act_get_shared () in
+  let hs = ref (fun e -> e) in
+
+  (* Compile actions *)
+  let actions =
+    Array.map
+      (function
+        | Single lam|Shared (Lstaticraise (_,[]) as lam) ->
+            let ulam,_ = close env lam in
+            ulam
+        | Shared lam ->
+            let ulam,_ = close env lam in
+            let i = next_raise_count () in
+(*
+            let string_of_lambda e =
+              Printlambda.lambda Format.str_formatter e ;
+              Format.flush_str_formatter () in
+            Printf.eprintf "SHARE CLOSURE %i [%s]\n%s\n" i
+                (string_of_lambda arg)
+                (string_of_lambda lam) ;
+*)
+            let ohs = !hs in
+            hs := (fun e -> Ucatch (i,[],ohs e,ulam)) ;
+            Ustaticfail (i,[]))
+      acts in
+  match actions with
+  | [| |] -> [| |], [| |], !hs (* May happen when default is None *)
+  | _     -> index, actions, !hs
+
+
+(* Collect exported symbols for structured constants *)
+
+let collect_exported_structured_constants a =
+  let rec approx = function
+    | Value_closure (fd, a) ->
+        approx a;
+        begin match fd.fun_inline with
+        | Some (_, u) -> ulam u
+        | None -> ()
+        end
+    | Value_tuple a -> Array.iter approx a
+    | Value_const c -> const c
+    | Value_unknown | Value_global_field _ -> ()
+  and const = function
+    | Uconst_ref (s, (Some c)) ->
+        Compilenv.add_exported_constant s;
+        structured_constant c
+    | Uconst_ref (_s, None) -> assert false (* Cannot be generated *)
+    | Uconst_int _ | Uconst_ptr _ -> ()
+  and structured_constant = function
+    | Uconst_block (_, ul) -> List.iter const ul
+    | Uconst_float _ | Uconst_int32 _
+    | Uconst_int64 _ | Uconst_nativeint _
+    | Uconst_float_array _ | Uconst_string _ -> ()
+    | Uconst_closure _ -> assert false (* Cannot be generated *)
+  and ulam = function
+    | Uvar _ -> ()
+    | Uconst c -> const c
+    | Udirect_apply (_, ul, _) -> List.iter ulam ul
+    | Ugeneric_apply (u, ul, _) -> ulam u; List.iter ulam ul
+    | Uclosure (fl, ul) ->
+        List.iter (fun f -> ulam f.body) fl;
+        List.iter ulam ul
+    | Uoffset(u, _) -> ulam u
+    | Ulet (_str, _kind, _, u1, u2) -> ulam u1; ulam u2
+    | Uphantom_let _ -> no_phantom_lets ()
+    | Uletrec (l, u) -> List.iter (fun (_, u) -> ulam u) l; ulam u
+    | Uprim (_, ul, _) -> List.iter ulam ul
+    | Uswitch (u, sl, _dbg) ->
+        ulam u;
+        Array.iter ulam sl.us_actions_consts;
+        Array.iter ulam sl.us_actions_blocks
+    | Ustringswitch (u,sw,d) ->
+        ulam u ;
+        List.iter (fun (_,act) -> ulam act) sw ;
+        Option.iter ulam d
+    | Ustaticfail (_, ul) -> List.iter ulam ul
+    | Ucatch (_, _, u1, u2)
+    | Utrywith (u1, _, u2)
+    | Usequence (u1, u2)
+    | Uwhile (u1, u2)  -> ulam u1; ulam u2
+    | Uifthenelse (u1, u2, u3)
+    | Ufor (_, u1, u2, _, u3) -> ulam u1; ulam u2; ulam u3
+    | Uassign (_, u) -> ulam u
+    | Usend (_, u1, u2, ul, _) -> ulam u1; ulam u2; List.iter ulam ul
+    | Uunreachable -> ()
+  in
+  approx a
+
+let reset () =
+  global_approx := [||];
+  function_nesting_depth := 0
+
+(* The entry point *)
+
+let intro ~backend ~size lam =
+  reset ();
+  let id = Compilenv.make_symbol None in
+  global_approx := Array.init size (fun i -> Value_global_field (id, i));
+  Compilenv.set_global_approx(Value_tuple !global_approx);
+  let (ulam, _approx) =
+    close { backend; fenv = V.Map.empty;
+            cenv = V.Map.empty; mutable_vars = V.Set.empty } lam
+  in
+  let opaque =
+    !Clflags.opaque
+    || Env.is_imported_opaque (Compilenv.current_unit_name ())
+  in
+  if opaque
+  then Compilenv.set_global_approx(Value_unknown)
+  else collect_exported_structured_constants (Value_tuple !global_approx);
+  global_approx := [||];
+  ulam
diff --git a/middle_end/closure/closure.mli b/middle_end/closure/closure.mli
new file mode 100644
index 00000000..92c74732
--- /dev/null
+++ b/middle_end/closure/closure.mli
@@ -0,0 +1,24 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Introduction of closures, uncurrying, recognition of direct calls *)
+
+val intro
+   : backend:(module Backend_intf.S)
+  -> size:int
+  -> Lambda.lambda
+  -> Clambda.ulambda
+
+val reset : unit -> unit
diff --git a/middle_end/closure/closure_middle_end.ml b/middle_end/closure/closure_middle_end.ml
new file mode 100644
index 00000000..cb593eb0
--- /dev/null
+++ b/middle_end/closure/closure_middle_end.ml
@@ -0,0 +1,58 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+let raw_clambda_dump_if ppf
+      ((ulambda, _, structured_constants) : Clambda.with_constants) =
+  if !Clflags.dump_rawclambda || !Clflags.dump_clambda then
+    begin
+      Format.fprintf ppf "@.clambda:@.";
+      Printclambda.clambda ppf ulambda;
+      List.iter (fun { Clambda. symbol; definition; _ } ->
+          Format.fprintf ppf "%s:@ %a@."
+            symbol
+            Printclambda.structured_constant definition)
+        structured_constants
+    end;
+  if !Clflags.dump_cmm then Format.fprintf ppf "@.cmm:@."
+
+let lambda_to_clambda ~backend ~filename:_ ~prefixname:_ ~ppf_dump
+      (lambda : Lambda.program) =
+  let clambda =
+    Closure.intro ~backend ~size:lambda.main_module_block_size lambda.code
+  in
+  let provenance : Clambda.usymbol_provenance =
+    { original_idents = [];
+      module_path =
+        Path.Pident (Ident.create_persistent (Compilenv.current_unit_name ()));
+    }
+  in
+  let preallocated_block =
+    Clambda.{
+      symbol = Compilenv.make_symbol None;
+      exported = true;
+      tag = 0;
+      fields = List.init lambda.main_module_block_size (fun _ -> None);
+      provenance = Some provenance;
+    }
+  in
+  let constants = Compilenv.structured_constants () in
+  Compilenv.clear_structured_constants ();
+  let clambda_and_constants =
+    clambda, [preallocated_block], constants
+  in
+  raw_clambda_dump_if ppf_dump clambda_and_constants;
+  clambda_and_constants
diff --git a/middle_end/closure/closure_middle_end.mli b/middle_end/closure/closure_middle_end.mli
new file mode 100644
index 00000000..e0ebb1de
--- /dev/null
+++ b/middle_end/closure/closure_middle_end.mli
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+val lambda_to_clambda
+   : backend:(module Backend_intf.S)
+  -> filename:string
+  -> prefixname:string
+  -> ppf_dump:Format.formatter
+  -> Lambda.program
+  -> Clambda.with_constants
diff --git a/middle_end/compilation_unit.ml b/middle_end/compilation_unit.ml
new file mode 100644
index 00000000..7fb48167
--- /dev/null
+++ b/middle_end/compilation_unit.ml
@@ -0,0 +1,78 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+type t = {
+  id : Ident.t;
+  linkage_name : Linkage_name.t;
+  hash : int;
+}
+
+let string_for_printing t = Ident.name t.id
+
+include Identifiable.Make (struct
+  type nonrec t = t
+
+  (* Multiple units can have the same [id] if they come from different packs.
+     To distinguish these we also keep the linkage name, which contains the
+     name of the pack. *)
+  let compare v1 v2 =
+    if v1 == v2 then 0
+    else
+      let c = compare v1.hash v2.hash in
+      if c = 0 then
+        let v1_id = Ident.name v1.id in
+        let v2_id = Ident.name v2.id in
+        let c = String.compare v1_id v2_id in
+        if c = 0 then
+          Linkage_name.compare v1.linkage_name v2.linkage_name
+        else
+          c
+      else c
+
+  let equal x y =
+    if x == y then true
+    else compare x y = 0
+
+  let print ppf t = Format.pp_print_string ppf (string_for_printing t)
+
+  let output oc x = output_string oc (Ident.name x.id)
+  let hash x = x.hash
+end)
+
+let create (id : Ident.t) linkage_name =
+  if not (Ident.persistent id) then begin
+    Misc.fatal_error "Compilation_unit.create with non-persistent Ident.t"
+  end;
+  { id; linkage_name; hash = Hashtbl.hash (Ident.name id); }
+
+let get_persistent_ident cu = cu.id
+let get_linkage_name cu = cu.linkage_name
+
+let current = ref None
+let is_current arg =
+  match !current with
+  | None -> Misc.fatal_error "Current compilation unit is not set!"
+  | Some cur -> equal cur arg
+let set_current t = current := Some t
+let get_current () = !current
+let get_current_exn () =
+  match !current with
+  | Some current -> current
+  | None -> Misc.fatal_error "Compilation_unit.get_current_exn"
+let get_current_id_exn () = get_persistent_ident (get_current_exn ())
diff --git a/middle_end/compilation_unit.mli b/middle_end/compilation_unit.mli
new file mode 100644
index 00000000..fc7d3bfd
--- /dev/null
+++ b/middle_end/compilation_unit.mli
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+include Identifiable.S
+
+(* The [Ident.t] must be persistent.  This function raises an exception
+   if that is not the case. *)
+val create : Ident.t -> Linkage_name.t -> t
+
+val get_persistent_ident : t -> Ident.t
+val get_linkage_name : t -> Linkage_name.t
+
+val is_current : t -> bool
+val set_current : t -> unit
+val get_current : unit -> t option
+val get_current_exn : unit -> t
+val get_current_id_exn : unit -> Ident.t
+
+val string_for_printing : t -> string
diff --git a/middle_end/compilenv.ml b/middle_end/compilenv.ml
new file mode 100644
index 00000000..247b0694
--- /dev/null
+++ b/middle_end/compilenv.ml
@@ -0,0 +1,457 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2010 Institut National de Recherche en Informatique et     *)
+(*     en Automatique                                                     *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Compilation environments for compilation units *)
+
+[@@@ocaml.warning "+a-4-9-40-41-42"]
+
+open Config
+open Cmx_format
+
+type error =
+    Not_a_unit_info of string
+  | Corrupted_unit_info of string
+  | Illegal_renaming of string * string * string
+
+exception Error of error
+
+let global_infos_table =
+  (Hashtbl.create 17 : (string, unit_infos option) Hashtbl.t)
+let export_infos_table =
+  (Hashtbl.create 10 : (string, Export_info.t) Hashtbl.t)
+
+let imported_sets_of_closures_table =
+  (Set_of_closures_id.Tbl.create 10
+   : Simple_value_approx.function_declarations option
+       Set_of_closures_id.Tbl.t)
+
+module CstMap =
+  Map.Make(struct
+    type t = Clambda.ustructured_constant
+    let compare = Clambda.compare_structured_constants
+    (* PR#6442: it is incorrect to use Stdlib.compare on values of type t
+       because it compares "0.0" and "-0.0" equal. *)
+  end)
+
+module SymMap = Misc.Stdlib.String.Map
+
+type structured_constants =
+  {
+    strcst_shared: string CstMap.t;
+    strcst_all: Clambda.ustructured_constant SymMap.t;
+  }
+
+let structured_constants_empty  =
+  {
+    strcst_shared = CstMap.empty;
+    strcst_all = SymMap.empty;
+  }
+
+let structured_constants = ref structured_constants_empty
+
+
+let exported_constants = Hashtbl.create 17
+
+let merged_environment = ref Export_info.empty
+
+let default_ui_export_info =
+  if Config.flambda then
+    Cmx_format.Flambda Export_info.empty
+  else
+    Cmx_format.Clambda Value_unknown
+
+let current_unit =
+  { ui_name = "";
+    ui_symbol = "";
+    ui_defines = [];
+    ui_imports_cmi = [];
+    ui_imports_cmx = [];
+    ui_curry_fun = [];
+    ui_apply_fun = [];
+    ui_send_fun = [];
+    ui_force_link = false;
+    ui_export_info = default_ui_export_info }
+
+let symbolname_for_pack pack name =
+  match pack with
+  | None -> name
+  | Some p ->
+      let b = Buffer.create 64 in
+      for i = 0 to String.length p - 1 do
+        match p.[i] with
+        | '.' -> Buffer.add_string b "__"
+        |  c  -> Buffer.add_char b c
+      done;
+      Buffer.add_string b "__";
+      Buffer.add_string b name;
+      Buffer.contents b
+
+let unit_id_from_name name = Ident.create_persistent name
+
+let concat_symbol unitname id =
+  unitname ^ "__" ^ id
+
+let make_symbol ?(unitname = current_unit.ui_symbol) idopt =
+  let prefix = "caml" ^ unitname in
+  match idopt with
+  | None -> prefix
+  | Some id -> concat_symbol prefix id
+
+let current_unit_linkage_name () =
+  Linkage_name.create (make_symbol ~unitname:current_unit.ui_symbol None)
+
+let reset ?packname name =
+  Hashtbl.clear global_infos_table;
+  Set_of_closures_id.Tbl.clear imported_sets_of_closures_table;
+  let symbol = symbolname_for_pack packname name in
+  current_unit.ui_name <- name;
+  current_unit.ui_symbol <- symbol;
+  current_unit.ui_defines <- [symbol];
+  current_unit.ui_imports_cmi <- [];
+  current_unit.ui_imports_cmx <- [];
+  current_unit.ui_curry_fun <- [];
+  current_unit.ui_apply_fun <- [];
+  current_unit.ui_send_fun <- [];
+  current_unit.ui_force_link <- !Clflags.link_everything;
+  Hashtbl.clear exported_constants;
+  structured_constants := structured_constants_empty;
+  current_unit.ui_export_info <- default_ui_export_info;
+  merged_environment := Export_info.empty;
+  Hashtbl.clear export_infos_table;
+  let compilation_unit =
+    Compilation_unit.create
+      (Ident.create_persistent name)
+      (current_unit_linkage_name ())
+  in
+  Compilation_unit.set_current compilation_unit
+
+let current_unit_infos () =
+  current_unit
+
+let current_unit_name () =
+  current_unit.ui_name
+
+let symbol_in_current_unit name =
+  let prefix = "caml" ^ current_unit.ui_symbol in
+  name = prefix ||
+  (let lp = String.length prefix in
+   String.length name >= 2 + lp
+   && String.sub name 0 lp = prefix
+   && name.[lp] = '_'
+   && name.[lp + 1] = '_')
+
+let read_unit_info filename =
+  let ic = open_in_bin filename in
+  try
+    let buffer = really_input_string ic (String.length cmx_magic_number) in
+    if buffer <> cmx_magic_number then begin
+      close_in ic;
+      raise(Error(Not_a_unit_info filename))
+    end;
+    let ui = (input_value ic : unit_infos) in
+    let crc = Digest.input ic in
+    close_in ic;
+    (ui, crc)
+  with End_of_file | Failure _ ->
+    close_in ic;
+    raise(Error(Corrupted_unit_info(filename)))
+
+let read_library_info filename =
+  let ic = open_in_bin filename in
+  let buffer = really_input_string ic (String.length cmxa_magic_number) in
+  if buffer <> cmxa_magic_number then
+    raise(Error(Not_a_unit_info filename));
+  let infos = (input_value ic : library_infos) in
+  close_in ic;
+  infos
+
+
+(* Read and cache info on global identifiers *)
+
+let get_global_info global_ident = (
+  let modname = Ident.name global_ident in
+  if modname = current_unit.ui_name then
+    Some current_unit
+  else begin
+    try
+      Hashtbl.find global_infos_table modname
+    with Not_found ->
+      let (infos, crc) =
+        if Env.is_imported_opaque modname then (None, None)
+        else begin
+          try
+            let filename =
+              Load_path.find_uncap (modname ^ ".cmx") in
+            let (ui, crc) = read_unit_info filename in
+            if ui.ui_name <> modname then
+              raise(Error(Illegal_renaming(modname, ui.ui_name, filename)));
+            (Some ui, Some crc)
+          with Not_found ->
+            let warn = Warnings.No_cmx_file modname in
+              Location.prerr_warning Location.none warn;
+              (None, None)
+          end
+      in
+      current_unit.ui_imports_cmx <-
+        (modname, crc) :: current_unit.ui_imports_cmx;
+      Hashtbl.add global_infos_table modname infos;
+      infos
+  end
+)
+
+let cache_unit_info ui =
+  Hashtbl.add global_infos_table ui.ui_name (Some ui)
+
+(* Return the approximation of a global identifier *)
+
+let get_clambda_approx ui =
+  assert(not Config.flambda);
+  match ui.ui_export_info with
+  | Flambda _ -> assert false
+  | Clambda approx -> approx
+
+let toplevel_approx :
+  (string, Clambda.value_approximation) Hashtbl.t = Hashtbl.create 16
+
+let record_global_approx_toplevel () =
+  Hashtbl.add toplevel_approx current_unit.ui_name
+    (get_clambda_approx current_unit)
+
+let global_approx id =
+  if Ident.is_predef id then Clambda.Value_unknown
+  else try Hashtbl.find toplevel_approx (Ident.name id)
+  with Not_found ->
+    match get_global_info id with
+      | None -> Clambda.Value_unknown
+      | Some ui -> get_clambda_approx ui
+
+(* Return the symbol used to refer to a global identifier *)
+
+let symbol_for_global id =
+  if Ident.is_predef id then
+    "caml_exn_" ^ Ident.name id
+  else begin
+    let unitname = Ident.name id in
+    match
+      try ignore (Hashtbl.find toplevel_approx unitname); None
+      with Not_found -> get_global_info id
+    with
+    | None -> make_symbol ~unitname:(Ident.name id) None
+    | Some ui -> make_symbol ~unitname:ui.ui_symbol None
+  end
+
+(* Register the approximation of the module being compiled *)
+
+let unit_for_global id =
+  let sym_label = Linkage_name.create (symbol_for_global id) in
+  Compilation_unit.create id sym_label
+
+let predefined_exception_compilation_unit =
+  Compilation_unit.create (Ident.create_persistent "__dummy__")
+    (Linkage_name.create "__dummy__")
+
+let is_predefined_exception sym =
+  Compilation_unit.equal
+    predefined_exception_compilation_unit
+    (Symbol.compilation_unit sym)
+
+let symbol_for_global' id =
+  let sym_label = Linkage_name.create (symbol_for_global id) in
+  if Ident.is_predef id then
+    Symbol.of_global_linkage predefined_exception_compilation_unit sym_label
+  else
+    Symbol.of_global_linkage (unit_for_global id) sym_label
+
+let set_global_approx approx =
+  assert(not Config.flambda);
+  current_unit.ui_export_info <- Clambda approx
+
+(* Exporting and importing cross module information *)
+
+let get_flambda_export_info ui =
+  assert(Config.flambda);
+  match ui.ui_export_info with
+  | Clambda _ -> assert false
+  | Flambda ei -> ei
+
+let set_export_info export_info =
+  assert(Config.flambda);
+  current_unit.ui_export_info <- Flambda export_info
+
+let approx_for_global comp_unit =
+  let id = Compilation_unit.get_persistent_ident comp_unit in
+  if (Compilation_unit.equal
+      predefined_exception_compilation_unit
+      comp_unit)
+     || Ident.is_predef id
+     || not (Ident.global id)
+  then invalid_arg (Format.asprintf "approx_for_global %a" Ident.print id);
+  let modname = Ident.name id in
+  match Hashtbl.find export_infos_table modname with
+  | otherwise -> Some otherwise
+  | exception Not_found ->
+    match get_global_info id with
+    | None -> None
+    | Some ui ->
+      let exported = get_flambda_export_info ui in
+      Hashtbl.add export_infos_table modname exported;
+      merged_environment := Export_info.merge !merged_environment exported;
+      Some exported
+
+let approx_env () = !merged_environment
+
+(* Record that a currying function or application function is needed *)
+
+let need_curry_fun n =
+  if not (List.mem n current_unit.ui_curry_fun) then
+    current_unit.ui_curry_fun <- n :: current_unit.ui_curry_fun
+
+let need_apply_fun n =
+  assert(n > 0);
+  if not (List.mem n current_unit.ui_apply_fun) then
+    current_unit.ui_apply_fun <- n :: current_unit.ui_apply_fun
+
+let need_send_fun n =
+  if not (List.mem n current_unit.ui_send_fun) then
+    current_unit.ui_send_fun <- n :: current_unit.ui_send_fun
+
+(* Write the description of the current unit *)
+
+let write_unit_info info filename =
+  let oc = open_out_bin filename in
+  output_string oc cmx_magic_number;
+  output_value oc info;
+  flush oc;
+  let crc = Digest.file filename in
+  Digest.output oc crc;
+  close_out oc
+
+let save_unit_info filename =
+  current_unit.ui_imports_cmi <- Env.imports();
+  write_unit_info current_unit filename
+
+let current_unit () =
+  match Compilation_unit.get_current () with
+  | Some current_unit -> current_unit
+  | None -> Misc.fatal_error "Compilenv.current_unit"
+
+let current_unit_symbol () =
+  Symbol.of_global_linkage (current_unit ()) (current_unit_linkage_name ())
+
+let const_label = ref 0
+
+let new_const_symbol () =
+  incr const_label;
+  make_symbol (Some (Int.to_string !const_label))
+
+let snapshot () = !structured_constants
+let backtrack s = structured_constants := s
+
+let new_structured_constant cst ~shared =
+  let {strcst_shared; strcst_all} = !structured_constants in
+  if shared then
+    try
+      CstMap.find cst strcst_shared
+    with Not_found ->
+      let lbl = new_const_symbol() in
+      structured_constants :=
+        {
+          strcst_shared = CstMap.add cst lbl strcst_shared;
+          strcst_all = SymMap.add lbl cst strcst_all;
+        };
+      lbl
+  else
+    let lbl = new_const_symbol() in
+    structured_constants :=
+      {
+        strcst_shared;
+        strcst_all = SymMap.add lbl cst strcst_all;
+      };
+    lbl
+
+let add_exported_constant s =
+  Hashtbl.replace exported_constants s ()
+
+let clear_structured_constants () =
+  structured_constants := structured_constants_empty
+
+let structured_constant_of_symbol s =
+  SymMap.find_opt s (!structured_constants).strcst_all
+
+let structured_constants () =
+  let provenance : Clambda.usymbol_provenance =
+    { original_idents = [];
+      module_path =
+        Path.Pident (Ident.create_persistent (current_unit_name ()));
+    }
+  in
+  SymMap.bindings (!structured_constants).strcst_all
+  |> List.map
+    (fun (symbol, definition) ->
+       {
+         Clambda.symbol;
+         exported = Hashtbl.mem exported_constants symbol;
+         definition;
+         provenance = Some provenance;
+       })
+
+let closure_symbol fv =
+  let compilation_unit = Closure_id.get_compilation_unit fv in
+  let unitname =
+    Linkage_name.to_string (Compilation_unit.get_linkage_name compilation_unit)
+  in
+  let linkage_name =
+    concat_symbol unitname ((Closure_id.unique_name fv) ^ "_closure")
+  in
+  Symbol.of_global_linkage compilation_unit (Linkage_name.create linkage_name)
+
+let function_label fv =
+  let compilation_unit = Closure_id.get_compilation_unit fv in
+  let unitname =
+    Linkage_name.to_string
+      (Compilation_unit.get_linkage_name compilation_unit)
+  in
+  (concat_symbol unitname (Closure_id.unique_name fv))
+
+let require_global global_ident =
+  if not (Ident.is_predef global_ident) then
+    ignore (get_global_info global_ident : Cmx_format.unit_infos option)
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+  | Not_a_unit_info filename ->
+      fprintf ppf "%a@ is not a compilation unit description."
+        Location.print_filename filename
+  | Corrupted_unit_info filename ->
+      fprintf ppf "Corrupted compilation unit description@ %a"
+        Location.print_filename filename
+  | Illegal_renaming(name, modname, filename) ->
+      fprintf ppf "%a@ contains the description for unit\
+                   @ %s when %s was expected"
+        Location.print_filename filename name modname
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )
diff --git a/middle_end/compilenv.mli b/middle_end/compilenv.mli
new file mode 100644
index 00000000..8f1ef284
--- /dev/null
+++ b/middle_end/compilenv.mli
@@ -0,0 +1,157 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2010 Institut National de Recherche en Informatique et     *)
+(*     en Automatique                                                     *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Compilation environments for compilation units *)
+
+open Cmx_format
+
+(* CR-soon mshinwell: this is a bit ugly
+   mshinwell: deferred CR, this has been addressed in the export info
+   improvement feature.
+*)
+val imported_sets_of_closures_table
+  : Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.t
+        (* flambda-only *)
+
+val reset: ?packname:string -> string -> unit
+        (* Reset the environment and record the name of the unit being
+           compiled (arg).  Optional argument is [-for-pack] prefix. *)
+
+val unit_id_from_name: string -> Ident.t
+        (* flambda-only *)
+
+val current_unit_infos: unit -> unit_infos
+        (* Return the infos for the unit being compiled *)
+
+val current_unit_name: unit -> string
+        (* Return the name of the unit being compiled
+           clambda-only *)
+
+val current_unit_linkage_name: unit -> Linkage_name.t
+        (* Return the linkage_name of the unit being compiled.
+           flambda-only *)
+
+val current_unit: unit -> Compilation_unit.t
+        (* flambda-only *)
+
+val current_unit_symbol: unit -> Symbol.t
+        (* flambda-only *)
+
+val make_symbol: ?unitname:string -> string option -> string
+        (* [make_symbol ~unitname:u None] returns the asm symbol that
+           corresponds to the compilation unit [u] (default: the current unit).
+           [make_symbol ~unitname:u (Some id)] returns the asm symbol that
+           corresponds to symbol [id] in the compilation unit [u]
+           (or the current unit). *)
+
+val symbol_in_current_unit: string -> bool
+        (* Return true if the given asm symbol belongs to the
+           current compilation unit, false otherwise. *)
+
+val is_predefined_exception: Symbol.t -> bool
+        (* flambda-only *)
+
+val unit_for_global: Ident.t -> Compilation_unit.t
+        (* flambda-only *)
+
+val symbol_for_global: Ident.t -> string
+        (* Return the asm symbol that refers to the given global identifier
+           flambda-only *)
+val symbol_for_global': Ident.t -> Symbol.t
+        (* flambda-only *)
+val global_approx: Ident.t -> Clambda.value_approximation
+        (* Return the approximation for the given global identifier
+           clambda-only *)
+val set_global_approx: Clambda.value_approximation -> unit
+        (* Record the approximation of the unit being compiled
+           clambda-only *)
+val record_global_approx_toplevel: unit -> unit
+        (* Record the current approximation for the current toplevel phrase
+           clambda-only *)
+
+val set_export_info: Export_info.t -> unit
+        (* Record the information of the unit being compiled
+           flambda-only *)
+val approx_env: unit -> Export_info.t
+        (* Returns all the information loaded from external compilation units
+           flambda-only *)
+val approx_for_global: Compilation_unit.t -> Export_info.t option
+        (* Loads the exported information declaring the compilation_unit
+           flambda-only *)
+
+val need_curry_fun: int -> unit
+val need_apply_fun: int -> unit
+val need_send_fun: int -> unit
+        (* Record the need of a currying (resp. application,
+           message sending) function with the given arity *)
+
+val new_const_symbol : unit -> string
+val closure_symbol : Closure_id.t -> Symbol.t
+        (* Symbol of a function if the function is
+           closed (statically allocated)
+           flambda-only *)
+val function_label : Closure_id.t -> string
+        (* linkage name of the code of a function
+           flambda-only *)
+
+val new_structured_constant:
+  Clambda.ustructured_constant ->
+  shared:bool -> (* can be shared with another structurally equal constant *)
+  string
+val structured_constants:
+  unit -> Clambda.preallocated_constant list
+val clear_structured_constants: unit -> unit
+
+val structured_constant_of_symbol:
+  string -> Clambda.ustructured_constant option
+
+val add_exported_constant: string -> unit
+        (* clambda-only *)
+type structured_constants
+        (* clambda-only *)
+val snapshot: unit -> structured_constants
+        (* clambda-only *)
+val backtrack: structured_constants -> unit
+        (* clambda-only *)
+
+val read_unit_info: string -> unit_infos * Digest.t
+        (* Read infos and MD5 from a [.cmx] file. *)
+val write_unit_info: unit_infos -> string -> unit
+        (* Save the given infos in the given file *)
+val save_unit_info: string -> unit
+        (* Save the infos for the current unit in the given file *)
+val cache_unit_info: unit_infos -> unit
+        (* Enter the given infos in the cache.  The infos will be
+           honored by [symbol_for_global] and [global_approx]
+           without looking at the corresponding .cmx file. *)
+
+val require_global: Ident.t -> unit
+        (* Enforce a link dependency of the current compilation
+           unit to the required module *)
+
+val read_library_info: string -> library_infos
+
+type error =
+    Not_a_unit_info of string
+  | Corrupted_unit_info of string
+  | Illegal_renaming of string * string * string
+
+exception Error of error
+
+val report_error: Format.formatter -> error -> unit
diff --git a/middle_end/convert_primitives.ml b/middle_end/convert_primitives.ml
new file mode 100644
index 00000000..4ea17739
--- /dev/null
+++ b/middle_end/convert_primitives.ml
@@ -0,0 +1,156 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2017 OCamlPro SAS                                          *)
+(*   Copyright 2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+let convert_unsafety is_unsafe : Clambda_primitives.is_safe =
+  if is_unsafe then
+    Unsafe
+  else
+    Safe
+
+let convert (prim : Lambda.primitive) : Clambda_primitives.primitive =
+  match prim with
+  | Pmakeblock (tag, mutability, shape) ->
+      Pmakeblock (tag, mutability, shape)
+  | Pfield field -> Pfield field
+  | Pfield_computed -> Pfield_computed
+  | Psetfield (field, imm_or_pointer, init_or_assign) ->
+      Psetfield (field, imm_or_pointer, init_or_assign)
+  | Psetfield_computed (imm_or_pointer, init_or_assign) ->
+      Psetfield_computed (imm_or_pointer, init_or_assign)
+  | Pfloatfield field -> Pfloatfield field
+  | Psetfloatfield (field, init_or_assign) ->
+      Psetfloatfield (field, init_or_assign)
+  | Pduprecord (repr, size) -> Pduprecord (repr, size)
+  | Pccall prim -> Pccall prim
+  | Praise kind -> Praise kind
+  | Psequand -> Psequand
+  | Psequor -> Psequor
+  | Pnot -> Pnot
+  | Pnegint -> Pnegint
+  | Paddint -> Paddint
+  | Psubint -> Psubint
+  | Pmulint -> Pmulint
+  | Pdivint is_safe -> Pdivint is_safe
+  | Pmodint is_safe -> Pmodint is_safe
+  | Pandint -> Pandint
+  | Porint -> Porint
+  | Pxorint -> Pxorint
+  | Plslint -> Plslint
+  | Plsrint -> Plsrint
+  | Pasrint -> Pasrint
+  | Pintcomp comp -> Pintcomp comp
+  | Pcompare_ints -> Pcompare_ints
+  | Pcompare_floats -> Pcompare_floats
+  | Pcompare_bints bi -> Pcompare_bints bi
+  | Poffsetint offset -> Poffsetint offset
+  | Poffsetref offset -> Poffsetref offset
+  | Pintoffloat -> Pintoffloat
+  | Pfloatofint -> Pfloatofint
+  | Pnegfloat -> Pnegfloat
+  | Pabsfloat -> Pabsfloat
+  | Paddfloat -> Paddfloat
+  | Psubfloat -> Psubfloat
+  | Pmulfloat -> Pmulfloat
+  | Pdivfloat -> Pdivfloat
+  | Pfloatcomp comp -> Pfloatcomp comp
+  | Pstringlength -> Pstringlength
+  | Pstringrefu -> Pstringrefu
+  | Pstringrefs -> Pstringrefs
+  | Pbyteslength -> Pbyteslength
+  | Pbytesrefu -> Pbytesrefu
+  | Pbytessetu -> Pbytessetu
+  | Pbytesrefs -> Pbytesrefs
+  | Pbytessets -> Pbytessets
+  | Pmakearray (kind, mutability) -> Pmakearray (kind, mutability)
+  | Pduparray (kind, mutability) -> Pduparray (kind, mutability)
+  | Parraylength kind -> Parraylength kind
+  | Parrayrefu kind -> Parrayrefu kind
+  | Parraysetu kind -> Parraysetu kind
+  | Parrayrefs kind -> Parrayrefs kind
+  | Parraysets kind -> Parraysets kind
+  | Pisint -> Pisint
+  | Pisout -> Pisout
+  | Pcvtbint (src, dest) -> Pcvtbint (src, dest)
+  | Pnegbint bi -> Pnegbint bi
+  | Paddbint bi -> Paddbint bi
+  | Psubbint bi -> Psubbint bi
+  | Pmulbint bi -> Pmulbint bi
+  | Pbintofint bi -> Pbintofint bi
+  | Pintofbint bi -> Pintofbint bi
+  | Pandbint bi -> Pandbint bi
+  | Porbint bi -> Porbint bi
+  | Pxorbint bi -> Pxorbint bi
+  | Plslbint bi -> Plslbint bi
+  | Plsrbint bi -> Plsrbint bi
+  | Pasrbint bi -> Pasrbint bi
+  | Pbbswap bi -> Pbbswap bi
+  | Pdivbint { size; is_safe } -> Pdivbint { size; is_safe }
+  | Pmodbint { size; is_safe } -> Pmodbint { size; is_safe }
+  | Pbintcomp (bi, comp) -> Pbintcomp (bi, comp)
+  | Pbigarrayref (safe, dims, kind, layout) ->
+      Pbigarrayref (safe, dims, kind, layout)
+  | Pbigarrayset (safe, dims, kind, layout) ->
+      Pbigarrayset (safe, dims, kind, layout)
+  | Pstring_load_16 is_unsafe ->
+      Pstring_load (Sixteen, convert_unsafety is_unsafe)
+  | Pstring_load_32 is_unsafe ->
+      Pstring_load (Thirty_two, convert_unsafety is_unsafe)
+  | Pstring_load_64 is_unsafe ->
+      Pstring_load (Sixty_four, convert_unsafety is_unsafe)
+  | Pbytes_load_16 is_unsafe ->
+      Pbytes_load (Sixteen, convert_unsafety is_unsafe)
+  | Pbytes_load_32 is_unsafe ->
+      Pbytes_load (Thirty_two, convert_unsafety is_unsafe)
+  | Pbytes_load_64 is_unsafe ->
+      Pbytes_load (Sixty_four, convert_unsafety is_unsafe)
+  | Pbytes_set_16 is_unsafe ->
+      Pbytes_set (Sixteen, convert_unsafety is_unsafe)
+  | Pbytes_set_32 is_unsafe ->
+      Pbytes_set (Thirty_two, convert_unsafety is_unsafe)
+  | Pbytes_set_64 is_unsafe ->
+      Pbytes_set (Sixty_four, convert_unsafety is_unsafe)
+  | Pbigstring_load_16 is_unsafe ->
+      Pbigstring_load (Sixteen, convert_unsafety is_unsafe)
+  | Pbigstring_load_32 is_unsafe ->
+      Pbigstring_load (Thirty_two, convert_unsafety is_unsafe)
+  | Pbigstring_load_64 is_unsafe ->
+      Pbigstring_load (Sixty_four, convert_unsafety is_unsafe)
+  | Pbigstring_set_16 is_unsafe ->
+      Pbigstring_set (Sixteen, convert_unsafety is_unsafe)
+  | Pbigstring_set_32 is_unsafe ->
+      Pbigstring_set (Thirty_two, convert_unsafety is_unsafe)
+  | Pbigstring_set_64 is_unsafe ->
+      Pbigstring_set (Sixty_four, convert_unsafety is_unsafe)
+  | Pbigarraydim dim -> Pbigarraydim dim
+  | Pbswap16 -> Pbswap16
+  | Pint_as_pointer -> Pint_as_pointer
+  | Popaque -> Popaque
+
+  | Pbytes_to_string
+  | Pbytes_of_string
+  | Pctconst _
+  | Pignore
+  | Prevapply
+  | Pdirapply
+  | Pidentity
+  | Pgetglobal _
+  | Psetglobal _
+    ->
+      Misc.fatal_errorf "lambda primitive %a can't be converted to \
+                         clambda primitive"
+        Printlambda.primitive prim
diff --git a/middle_end/convert_primitives.mli b/middle_end/convert_primitives.mli
new file mode 100644
index 00000000..8c369126
--- /dev/null
+++ b/middle_end/convert_primitives.mli
@@ -0,0 +1,17 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2017 OCamlPro SAS                                          *)
+(*   Copyright 2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+val convert : Lambda.primitive -> Clambda_primitives.primitive
diff --git a/middle_end/flambda/alias_analysis.ml b/middle_end/flambda/alias_analysis.ml
new file mode 100644
index 00000000..fe97a36f
--- /dev/null
+++ b/middle_end/flambda/alias_analysis.ml
@@ -0,0 +1,168 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+type allocation_point =
+  | Symbol of Symbol.t
+  | Variable of Variable.t
+
+type allocated_const =
+  | Normal of Allocated_const.t
+  | Array of Lambda.array_kind * Asttypes.mutable_flag * Variable.t list
+  | Duplicate_array of Lambda.array_kind * Asttypes.mutable_flag * Variable.t
+
+type constant_defining_value =
+  | Allocated_const of allocated_const
+  | Block of Tag.t * Variable.t list
+  | Set_of_closures of Flambda.set_of_closures
+  | Project_closure of Flambda.project_closure
+  | Move_within_set_of_closures of Flambda.move_within_set_of_closures
+  | Project_var of Flambda.project_var
+  | Field of Variable.t * int
+  | Symbol_field of Symbol.t * int
+  | Const of Flambda.const
+  | Symbol of Symbol.t
+  | Variable of Variable.t
+
+type initialize_symbol_field = Variable.t option
+
+type definitions = {
+  variable : constant_defining_value Variable.Tbl.t;
+  initialize_symbol : initialize_symbol_field list Symbol.Tbl.t;
+  symbol : Flambda.constant_defining_value Symbol.Tbl.t;
+}
+
+let print_constant_defining_value ppf = function
+  | Allocated_const (Normal const) -> Allocated_const.print ppf const
+  | Allocated_const (Array (_, _, vars)) ->
+    Format.fprintf ppf "[| %a |]"
+      (Format.pp_print_list Variable.print) vars
+  | Allocated_const (Duplicate_array (_, _, var)) ->
+    Format.fprintf ppf "dup_array(%a)" Variable.print var
+  | Block (tag, vars) ->
+    Format.fprintf ppf "[|%a: %a|]"
+      Tag.print tag
+      (Format.pp_print_list Variable.print) vars
+  | Set_of_closures set -> Flambda.print_set_of_closures ppf set
+  | Project_closure project -> Flambda.print_project_closure ppf project
+  | Move_within_set_of_closures move ->
+    Flambda.print_move_within_set_of_closures ppf move
+  | Project_var project -> Flambda.print_project_var ppf project
+  | Field (var, field) -> Format.fprintf ppf "%a.(%d)" Variable.print var field
+  | Symbol_field (sym, field) ->
+    Format.fprintf ppf "%a.(%d)" Symbol.print sym field
+  | Const const -> Flambda.print_const ppf const
+  | Symbol symbol -> Symbol.print ppf symbol
+  | Variable var -> Variable.print ppf var
+
+let rec resolve_definition
+    (definitions: definitions)
+    (var: Variable.t)
+    (def: constant_defining_value)
+    ~the_dead_constant : allocation_point =
+  match def with
+  | Allocated_const _
+  | Block _
+  | Set_of_closures _
+  | Project_closure _
+  | Const _
+  | Move_within_set_of_closures _ ->
+    Variable var
+  | Project_var {var} ->
+    fetch_variable definitions (Var_within_closure.unwrap var)
+      ~the_dead_constant
+  | Variable v ->
+    fetch_variable definitions v
+      ~the_dead_constant
+  | Symbol sym -> Symbol sym
+  | Field (v, n) ->
+    begin match fetch_variable definitions v ~the_dead_constant with
+    | Symbol s ->
+      fetch_symbol_field definitions s n ~the_dead_constant
+    | Variable v ->
+      fetch_variable_field definitions v n ~the_dead_constant
+    end
+  | Symbol_field (symbol, field) ->
+    fetch_symbol_field definitions symbol field ~the_dead_constant
+
+and fetch_variable
+    (definitions: definitions)
+    (var: Variable.t)
+    ~the_dead_constant : allocation_point =
+  match Variable.Tbl.find definitions.variable var with
+  | exception Not_found -> Variable var
+  | def -> resolve_definition definitions var def ~the_dead_constant
+
+and fetch_variable_field
+    (definitions: definitions)
+    (var: Variable.t)
+    (field: int)
+    ~the_dead_constant : allocation_point =
+  match Variable.Tbl.find definitions.variable var with
+  | Block (_, fields) ->
+    begin match List.nth fields field with
+    | exception Not_found -> Symbol the_dead_constant
+    | v -> fetch_variable definitions v ~the_dead_constant
+    end
+  | exception Not_found ->
+    Misc.fatal_errorf "No definition for field access to %a" Variable.print var
+  | Symbol _ | Variable _ | Project_var _ | Field _ | Symbol_field _ ->
+    (* Must have been resolved *)
+    assert false
+  | Const _ | Allocated_const _
+  | Set_of_closures _ | Project_closure _ | Move_within_set_of_closures _ ->
+    Symbol the_dead_constant
+
+and fetch_symbol_field
+    (definitions: definitions)
+    (sym: Symbol.t)
+    (field: int)
+    ~the_dead_constant : allocation_point =
+  match Symbol.Tbl.find definitions.symbol sym with
+  | Block (_, fields) ->
+    begin match List.nth fields field with
+    | exception Not_found -> Symbol the_dead_constant
+    | Symbol s -> Symbol s
+    | Const _ -> Symbol sym
+    end
+  | exception Not_found ->
+    begin match Symbol.Tbl.find definitions.initialize_symbol sym with
+      | fields ->
+        begin match List.nth fields field with
+        | None ->
+          Misc.fatal_errorf "Constant field access to an inconstant %a"
+            Symbol.print sym
+        | Some v ->
+          fetch_variable definitions v ~the_dead_constant
+        end
+      | exception Not_found ->
+        Misc.fatal_errorf "No definition for field access to %a"
+          Symbol.print sym
+    end
+  | Allocated_const _ | Set_of_closures _ | Project_closure _ ->
+    Symbol the_dead_constant
+
+let run variable initialize_symbol symbol ~the_dead_constant =
+  let definitions = { variable; initialize_symbol; symbol; } in
+  Variable.Tbl.fold (fun var definition result ->
+      let definition =
+        resolve_definition definitions var definition ~the_dead_constant
+      in
+      Variable.Map.add var definition result)
+    definitions.variable
+    Variable.Map.empty
diff --git a/middle_end/flambda/alias_analysis.mli b/middle_end/flambda/alias_analysis.mli
new file mode 100644
index 00000000..515daeff
--- /dev/null
+++ b/middle_end/flambda/alias_analysis.mli
@@ -0,0 +1,63 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+type allocation_point =
+  | Symbol of Symbol.t
+  | Variable of Variable.t
+
+type allocated_const =
+  | Normal of Allocated_const.t
+  | Array of Lambda.array_kind * Asttypes.mutable_flag * Variable.t list
+  | Duplicate_array of Lambda.array_kind * Asttypes.mutable_flag * Variable.t
+
+type constant_defining_value =
+  | Allocated_const of allocated_const
+  | Block of Tag.t * Variable.t list
+  | Set_of_closures of Flambda.set_of_closures
+  | Project_closure of Flambda.project_closure
+  | Move_within_set_of_closures of Flambda.move_within_set_of_closures
+  | Project_var of Flambda.project_var
+  | Field of Variable.t * int
+  | Symbol_field of Symbol.t * int
+  | Const of Flambda.const
+  | Symbol of Symbol.t
+  | Variable of Variable.t
+
+type initialize_symbol_field = Variable.t option
+
+(** Simple alias analysis working over information about which
+    symbols have been assigned to variables; and which constants have
+    been assigned to symbols.  The return value gives the assignment
+    of the defining values of constants to variables.
+    Also see comments for [Lift_constants], whose input feeds this
+    pass.
+
+    Variables found to be ill-typed accesses to other constants, for
+    example arising from dead code, will be pointed at [the_dead_constant].
+*)
+val run
+   : constant_defining_value Variable.Tbl.t
+  -> initialize_symbol_field list Symbol.Tbl.t
+  -> Flambda.constant_defining_value Symbol.Tbl.t
+  -> the_dead_constant:Symbol.t
+  -> allocation_point Variable.Map.t
+
+val print_constant_defining_value
+   : Format.formatter
+  -> constant_defining_value
+  -> unit
diff --git a/middle_end/flambda/allocated_const.ml b/middle_end/flambda/allocated_const.ml
new file mode 100644
index 00000000..78dc4ee1
--- /dev/null
+++ b/middle_end/flambda/allocated_const.ml
@@ -0,0 +1,86 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+type t =
+  | Float of float
+  | Int32 of int32
+  | Int64 of int64
+  | Nativeint of nativeint
+  | Float_array of float list
+  | Immutable_float_array of float list
+  | String of string
+  | Immutable_string of string
+
+let compare_floats x1 x2 =
+  (* It is important to compare the bit patterns here, so as not to
+     be subject to bugs such as GPR#295. *)
+  Int64.compare (Int64.bits_of_float x1) (Int64.bits_of_float x2)
+
+let compare (x : t) (y : t) =
+  let rec compare_float_lists l1 l2 =
+    match l1, l2 with
+    | [], [] -> 0
+    | [], _::_ -> -1
+    | _::_, [] -> 1
+    | h1::t1, h2::t2 ->
+      let c = compare_floats h1 h2 in
+      if c <> 0 then c else compare_float_lists t1 t2
+  in
+  match x, y with
+  | Float x, Float y -> compare_floats x y
+  | Int32 x, Int32 y -> Int32.compare x y
+  | Int64 x, Int64 y -> Int64.compare x y
+  | Nativeint x, Nativeint y -> Nativeint.compare x y
+  | Float_array x, Float_array y -> compare_float_lists x y
+  | Immutable_float_array x, Immutable_float_array y -> compare_float_lists x y
+  | String x, String y -> String.compare x y
+  | Immutable_string x, Immutable_string y -> String.compare x y
+  | Float _, _ -> -1
+  | _, Float _ -> 1
+  | Int32 _, _ -> -1
+  | _, Int32 _ -> 1
+  | Int64 _, _ -> -1
+  | _, Int64 _ -> 1
+  | Nativeint _, _ -> -1
+  | _, Nativeint _ -> 1
+  | Float_array _, _ -> -1
+  | _, Float_array _ -> 1
+  | Immutable_float_array _, _ -> -1
+  | _, Immutable_float_array _ -> 1
+  | String _, _ -> -1
+  | _, String _ -> 1
+
+let print ppf (t : t) =
+  let fprintf = Format.fprintf in
+  let floats ppf fl =
+    List.iter (fun f -> fprintf ppf "@ %f" f) fl
+  in
+  match t with
+  | String s -> fprintf ppf "%S" s
+  | Immutable_string s -> fprintf ppf "#%S" s
+  | Int32 n -> fprintf ppf "%lil" n
+  | Int64 n -> fprintf ppf "%LiL" n
+  | Nativeint n -> fprintf ppf "%nin" n
+  | Float f -> fprintf ppf "%f" f
+  | Float_array [] -> fprintf ppf "[| |]"
+  | Float_array (f1 :: fl) ->
+    fprintf ppf "@[<1>[|@[%f%a@]|]@]" f1 floats fl
+  | Immutable_float_array [] -> fprintf ppf "[|# |]"
+  | Immutable_float_array (f1 :: fl) ->
+    fprintf ppf "@[<1>[|# @[%f%a@]|]@]" f1 floats fl
diff --git a/middle_end/flambda/allocated_const.mli b/middle_end/flambda/allocated_const.mli
new file mode 100644
index 00000000..0bdbe49e
--- /dev/null
+++ b/middle_end/flambda/allocated_const.mli
@@ -0,0 +1,38 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Constants that are always allocated (possibly statically).  Blocks
+    are not included here since they are always encoded using
+    [Prim (Pmakeblock, ...)]. *)
+
+type t =
+  | Float of float
+  | Int32 of int32
+  | Int64 of int64
+  | Nativeint of nativeint
+  (* CR-someday mshinwell: consider using "float array" *)
+  | Float_array of float list
+  | Immutable_float_array of float list
+  | String of string
+  | Immutable_string of string
+
+val compare_floats : float -> float -> int
+
+val compare : t -> t -> int
+
+val print : Format.formatter -> t -> unit
diff --git a/middle_end/flambda/augment_specialised_args.ml b/middle_end/flambda/augment_specialised_args.ml
new file mode 100644
index 00000000..c3a30785
--- /dev/null
+++ b/middle_end/flambda/augment_specialised_args.ml
@@ -0,0 +1,762 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module E = Inline_and_simplify_aux.Env
+module B = Inlining_cost.Benefit
+
+module Definition = struct
+  type t =
+    | Existing_inner_free_var of Variable.t
+    | Projection_from_existing_specialised_arg of Projection.t
+
+  include Identifiable.Make (struct
+    type nonrec t = t
+
+    let compare t1 t2 =
+      match t1, t2 with
+      | Existing_inner_free_var var1, Existing_inner_free_var var2 ->
+        Variable.compare var1 var2
+      | Projection_from_existing_specialised_arg proj1,
+          Projection_from_existing_specialised_arg proj2 ->
+        Projection.compare proj1 proj2
+      | Existing_inner_free_var _, _ -> -1
+      | _, Existing_inner_free_var _ -> 1
+
+    let equal t1 t2 =
+      (compare t1 t2) = 0
+
+    let hash = Hashtbl.hash
+
+    let print ppf t =
+      match t with
+      | Existing_inner_free_var var ->
+        Format.fprintf ppf "Existing_inner_free_var %a"
+          Variable.print var
+      | Projection_from_existing_specialised_arg projection ->
+        Format.fprintf ppf "Projection_from_existing_specialised_arg %a"
+          Projection.print projection
+
+    let output _ _ = failwith "Definition.output not yet implemented"
+  end)
+end
+
+module What_to_specialise = struct
+  type t = {
+    (* [definitions] is indexed by (fun_var, group) *)
+    definitions : Definition.t list Variable.Pair.Map.t;
+    set_of_closures : Flambda.set_of_closures;
+    make_direct_call_surrogates_for : Variable.Set.t;
+  }
+
+  let create ~set_of_closures =
+    { definitions = Variable.Pair.Map.empty;
+      set_of_closures;
+      make_direct_call_surrogates_for = Variable.Set.empty;
+    }
+
+  let new_specialised_arg t ~fun_var ~group ~definition =
+    let key = fun_var, group in
+    let definitions =
+      match Variable.Pair.Map.find key t.definitions with
+      | exception Not_found -> []
+      | definitions -> definitions
+    in
+    let definitions =
+      Variable.Pair.Map.add (fun_var, group) (definition :: definitions)
+        t.definitions
+    in
+    { t with definitions; }
+
+  let make_direct_call_surrogate_for t ~fun_var =
+    match Variable.Map.find fun_var t.set_of_closures.function_decls.funs with
+    | exception Not_found ->
+      Misc.fatal_errorf "use_direct_call_surrogate_for: %a is not a fun_var \
+          from the given set of closures"
+        Variable.print fun_var
+    | _ ->
+      { t with
+        make_direct_call_surrogates_for =
+          Variable.Set.add fun_var t.make_direct_call_surrogates_for;
+      }
+end
+
+module W = What_to_specialise
+
+module type S = sig
+  val pass_name : string
+
+  val what_to_specialise
+     : env:Inline_and_simplify_aux.Env.t
+    -> set_of_closures:Flambda.set_of_closures
+    -> What_to_specialise.t
+end
+
+module Processed_what_to_specialise = struct
+  type for_one_function = {
+    fun_var : Variable.t;
+    function_decl : Flambda.function_declaration;
+    make_direct_call_surrogates : bool;
+    new_definitions_indexed_by_new_inner_vars : Definition.t Variable.Map.t;
+    all_new_definitions : Definition.Set.t;
+    new_inner_to_new_outer_vars : Variable.t Variable.Map.t;
+    total_number_of_args : int;
+    existing_specialised_args : Flambda.specialised_to Variable.Map.t;
+  }
+
+  type t = {
+    set_of_closures : Flambda.set_of_closures;
+    existing_definitions_via_spec_args_indexed_by_fun_var
+      : Definition.Set.t Variable.Map.t;
+    (* The following two maps' definitions have already been rewritten
+       into their lifted form (i.e. they reference outer rather than inner
+       variables). *)
+    new_lifted_defns_indexed_by_new_outer_vars : Projection.t Variable.Map.t;
+    new_outer_vars_indexed_by_new_lifted_defns : Variable.t Projection.Map.t;
+    functions : for_one_function Variable.Map.t;
+    make_direct_call_surrogates_for : Variable.Set.t;
+  }
+
+  let lift_projection t ~(projection : Projection.t) =
+    (* The lifted definition must be in terms of outer variables,
+       not inner variables. *)
+    let find_outer_var inner_var =
+      match Variable.Map.find inner_var t.set_of_closures.specialised_args with
+      | (outer_var : Flambda.specialised_to) -> outer_var.var
+      | exception Not_found ->
+        Misc.fatal_errorf "find_outer_var: expected %a \
+            to be in [specialised_args], but it is \
+            not.  The projection was: %a.  Set of closures: %a"
+          Variable.print inner_var
+          Projection.print projection
+          Flambda.print_set_of_closures t.set_of_closures
+    in
+    Projection.map_projecting_from projection ~f:find_outer_var
+
+  let really_add_new_specialised_arg t ~group ~(definition : Definition.t)
+        ~(for_one_function : for_one_function) =
+    let fun_var = for_one_function.fun_var in
+    (* We know here that a new specialised argument must be added.  This
+       needs a "new inner var" and a "new outer var".  However if there
+       is already a lifted projection being introduced around the set
+       of closures (corresponding to another new specialised argument),
+       we should re-use its "new outer var" to avoid duplication of
+       projection definitions.  Likewise if the definition is just
+       [Existing_inner_free_var], in which case we can use the
+       corresponding existing outer free variable. *)
+    let new_outer_var, t =
+      let existing_outer_var =
+        match definition with
+        | Existing_inner_free_var _ -> None
+        | Projection_from_existing_specialised_arg projection ->
+          let projection = lift_projection t ~projection in
+          match
+            Projection.Map.find projection
+              t.new_outer_vars_indexed_by_new_lifted_defns
+          with
+          | new_outer_var -> Some new_outer_var
+          | exception Not_found -> None
+      in
+      match existing_outer_var with
+      | Some existing_outer_var -> existing_outer_var, t
+      | None ->
+        match definition with
+        | Existing_inner_free_var existing_inner_var ->
+          begin match
+            Variable.Map.find existing_inner_var
+              t.set_of_closures.free_vars
+          with
+          | exception Not_found ->
+            Misc.fatal_errorf "really_add_new_specialised_arg: \
+                Existing_inner_free_var %a is not an inner free variable \
+                of %a in %a"
+              Variable.print existing_inner_var
+              Variable.print fun_var
+              Flambda.print_set_of_closures t.set_of_closures
+          | existing_outer_var -> existing_outer_var.var, t
+          end
+        | Projection_from_existing_specialised_arg projection ->
+          let new_outer_var = Variable.rename group in
+          let projection = lift_projection t ~projection in
+          let new_outer_vars_indexed_by_new_lifted_defns =
+            Projection.Map.add
+              projection new_outer_var
+              t.new_outer_vars_indexed_by_new_lifted_defns
+          in
+          let new_lifted_defns_indexed_by_new_outer_vars =
+            Variable.Map.add
+              new_outer_var projection
+              t.new_lifted_defns_indexed_by_new_outer_vars
+          in
+          let t =
+            { t with
+              new_outer_vars_indexed_by_new_lifted_defns;
+              new_lifted_defns_indexed_by_new_outer_vars;
+            }
+          in
+          new_outer_var, t
+    in
+    let new_inner_var = Variable.rename group in
+    let new_inner_to_new_outer_vars =
+      Variable.Map.add new_inner_var new_outer_var
+        for_one_function.new_inner_to_new_outer_vars
+    in
+    let for_one_function : for_one_function =
+      { for_one_function with
+        new_definitions_indexed_by_new_inner_vars =
+          Variable.Map.add new_inner_var definition
+            for_one_function.new_definitions_indexed_by_new_inner_vars;
+        all_new_definitions =
+          Definition.Set.add definition
+            for_one_function.all_new_definitions;
+        new_inner_to_new_outer_vars;
+        total_number_of_args = for_one_function.total_number_of_args + 1;
+      }
+    in
+    { t with
+      functions = Variable.Map.add fun_var for_one_function t.functions;
+    }
+
+  let new_specialised_arg t ~fun_var ~group ~definition =
+    let for_one_function : for_one_function =
+      match Variable.Map.find fun_var t.functions with
+      | exception Not_found ->
+        begin
+          match Variable.Map.find fun_var t.set_of_closures.function_decls.funs
+        with
+        | exception Not_found -> assert false
+        | (function_decl : Flambda.function_declaration) ->
+          let params = Parameter.Set.vars function_decl.params in
+          let existing_specialised_args =
+            Variable.Map.filter (fun inner_var _spec_to ->
+                Variable.Set.mem inner_var params)
+              t.set_of_closures.specialised_args
+          in
+          let make_direct_call_surrogates =
+            Variable.Set.mem fun_var t.make_direct_call_surrogates_for
+          in
+          { fun_var;
+            function_decl;
+            make_direct_call_surrogates;
+            new_definitions_indexed_by_new_inner_vars = Variable.Map.empty;
+            all_new_definitions = Definition.Set.empty;
+            new_inner_to_new_outer_vars = Variable.Map.empty;
+            (* The "+ 1" is just in case there is a closure environment
+               parameter added later. *)
+            total_number_of_args = List.length function_decl.params + 1;
+            existing_specialised_args;
+          }
+        end
+      | for_one_function -> for_one_function
+    in
+    (* Determine whether there already exists an existing specialised argument
+       that is known to be equal to the one proposed to this function.  If so,
+       use that instead.  (Note that we also desire to dedup against any
+       new specialised arguments added to the current function; but that
+       happens automatically since [Extract_projections] returns a set.) *)
+    let exists_already =
+      match
+        Variable.Map.find fun_var
+          t.existing_definitions_via_spec_args_indexed_by_fun_var
+      with
+      | exception Not_found -> false
+      | definitions -> Definition.Set.mem definition definitions
+    in
+    if exists_already then t
+    else really_add_new_specialised_arg t ~group ~definition ~for_one_function
+
+  let create ~env ~(what_to_specialise : W.t) =
+    let existing_definitions_via_spec_args_indexed_by_fun_var =
+      Variable.Map.map (fun (function_decl : Flambda.function_declaration) ->
+          if function_decl.stub then
+            Definition.Set.empty
+          else
+            let params = Parameter.Set.vars function_decl.params in
+            Variable.Map.fold (fun inner_var
+                      (spec_to : Flambda.specialised_to) definitions ->
+                if not (Variable.Set.mem inner_var params) then
+                  definitions
+                else
+                  let definition : Definition.t =
+                    match spec_to.projection with
+                    | None -> Existing_inner_free_var inner_var
+                    | Some projection ->
+                      Projection_from_existing_specialised_arg projection
+                  in
+                  Definition.Set.add definition definitions)
+              what_to_specialise.set_of_closures.specialised_args
+              Definition.Set.empty)
+          what_to_specialise.set_of_closures.function_decls.funs
+    in
+    let t : t =
+      { set_of_closures = what_to_specialise.set_of_closures;
+        existing_definitions_via_spec_args_indexed_by_fun_var;
+        new_lifted_defns_indexed_by_new_outer_vars = Variable.Map.empty;
+        new_outer_vars_indexed_by_new_lifted_defns = Projection.Map.empty;
+        functions = Variable.Map.empty;
+        make_direct_call_surrogates_for =
+          what_to_specialise.make_direct_call_surrogates_for;
+      }
+    in
+    (* It is important to limit the number of arguments added: if arguments
+       end up being passed on the stack, tail call optimization will be
+       disabled (see asmcomp/selectgen.ml).
+       For each group of new specialised args provided by [T], either all or
+       none of them will be added.  (This is to avoid the situation where we
+       add extra arguments but yet fail to eliminate an original one by
+       stopping part-way through the specialised args addition.) *)
+    let by_group =
+      Variable.Pair.Map.fold (fun (fun_var, group) definitions by_group ->
+          let fun_vars_and_definitions =
+            match Variable.Map.find group by_group with
+            | exception Not_found -> []
+            | fun_vars_and_definitions -> fun_vars_and_definitions
+          in
+          Variable.Map.add group
+            ((fun_var, definitions)::fun_vars_and_definitions)
+            by_group)
+        what_to_specialise.definitions
+        Variable.Map.empty
+    in
+    let module Backend = (val (E.backend env) : Backend_intf.S) in
+    Variable.Map.fold (fun group fun_vars_and_definitions t ->
+        let original_t = t in
+        let t =
+          (* Try adding all specialised args in the current group. *)
+          List.fold_left (fun t (fun_var, definitions) ->
+              List.fold_left (fun t definition ->
+                  new_specialised_arg t ~fun_var ~group ~definition)
+                t
+                definitions)
+            t
+            fun_vars_and_definitions
+        in
+        let some_function_has_too_many_args =
+          Variable.Map.exists (fun _ (for_one_function : for_one_function) ->
+              for_one_function.total_number_of_args
+                > Backend.max_sensible_number_of_arguments)
+            t.functions
+        in
+        if some_function_has_too_many_args then
+          original_t  (* drop this group *)
+        else
+          t)
+      by_group
+      t
+end
+
+module P = Processed_what_to_specialise
+
+let check_invariants ~pass_name ~(set_of_closures : Flambda.set_of_closures)
+      ~original_set_of_closures =
+  if !Clflags.flambda_invariant_checks then begin
+    Variable.Map.iter (fun fun_var
+              (function_decl : Flambda.function_declaration) ->
+        let params = Parameter.Set.vars function_decl.params in
+        Variable.Map.iter (fun inner_var
+                    (outer_var : Flambda.specialised_to) ->
+              if Variable.Set.mem inner_var params then begin
+                assert (not (Variable.Set.mem outer_var.var
+                  function_decl.free_variables));
+                match outer_var.projection with
+                | None -> ()
+                | Some projection ->
+                  let from = Projection.projecting_from projection in
+                  if not (Variable.Set.mem from params) then begin
+                    Misc.fatal_errorf "Augment_specialised_args (%s): \
+                        specialised argument (%a -> %a) references a \
+                        projection variable that is not a specialised \
+                        argument of the function %a. @ The set of closures \
+                        before the transformation was:@  %a. @ The set of \
+                        closures after the transformation was:@ %a."
+                      pass_name
+                      Variable.print inner_var
+                      Flambda.print_specialised_to outer_var
+                      Variable.print fun_var
+                      Flambda.print_set_of_closures original_set_of_closures
+                      Flambda.print_set_of_closures set_of_closures
+                  end
+              end)
+          set_of_closures.specialised_args)
+      set_of_closures.function_decls.funs
+  end
+
+module Make (T : S) = struct
+  let () = Pass_wrapper.register ~pass_name:T.pass_name
+
+  let rename_function_and_parameters ~fun_var
+        ~(function_decl : Flambda.function_declaration) =
+    let new_fun_var = Variable.rename fun_var in
+    let params_renaming_list =
+      List.map (fun param ->
+          let new_param = Parameter.rename param in
+          param, new_param)
+        function_decl.params
+    in
+    let renamed_params = List.map snd params_renaming_list in
+    let params_renaming =
+      Variable.Map.of_list
+        (List.map (fun (param, new_param) ->
+             Parameter.var param, Parameter.var new_param)
+           params_renaming_list)
+    in
+    new_fun_var, params_renaming, renamed_params
+
+  let create_wrapper ~(for_one_function : P.for_one_function) ~benefit =
+    let fun_var = for_one_function.fun_var in
+    let function_decl = for_one_function.function_decl in
+    (* To avoid increasing the free variables of the wrapper, for
+       general cleanliness, we restate the definitions of the
+       newly-specialised arguments in the wrapper itself in terms of the
+       original specialised arguments.  The variables bound to these
+       definitions are called the "specialised args bound in the wrapper".
+       Note that the domain of [params_renaming] is a (non-strict) superset
+       of the "inner vars" of the original specialised args. *)
+    let params = Parameter.Set.vars function_decl.params in
+    let new_fun_var, params_renaming, wrapper_params =
+      rename_function_and_parameters ~fun_var ~function_decl
+    in
+    let find_wrapper_param param =
+      assert (Variable.Set.mem param params);
+      match Variable.Map.find param params_renaming with
+      | wrapper_param -> wrapper_param
+      | exception Not_found ->
+        Misc.fatal_errorf "find_wrapper_param: expected %a \
+            to be in [params_renaming], but it is not."
+          Variable.print param
+    in
+    let new_inner_vars_to_spec_args_bound_in_the_wrapper_renaming =
+      Variable.Map.mapi (fun new_inner_var _ ->
+          Variable.rename new_inner_var)
+        for_one_function.new_definitions_indexed_by_new_inner_vars
+    in
+    let spec_args_bound_in_the_wrapper =
+      (* N.B.: in the order matching the new specialised argument parameters
+         to the main function. *)
+      Variable.Map.data
+        new_inner_vars_to_spec_args_bound_in_the_wrapper_renaming
+    in
+    (* New definitions that project from existing specialised args need
+       to be rewritten to use the corresponding specialised args of
+       the wrapper.  Definitions that are just equality to existing
+       inner free variables do not need to be changed.  Once this has
+       been done the wrapper body can be constructed.
+       We also need to rewrite definitions for any existing specialised
+       args; these now have corresponding wrapper parameters that must
+       also be specialised. *)
+    let wrapper_body, benefit =
+      let apply : Flambda.expr =
+        Apply {
+          func = new_fun_var;
+          args =
+            (Parameter.List.vars wrapper_params) @
+            spec_args_bound_in_the_wrapper;
+          kind = Direct (Closure_id.wrap new_fun_var);
+          dbg = Debuginfo.none;
+          inline = Default_inline;
+          specialise = Default_specialise;
+        }
+      in
+      Variable.Map.fold (fun new_inner_var definition (wrapper_body, benefit) ->
+          let definition : Definition.t =
+            match (definition : Definition.t) with
+            | Existing_inner_free_var _ -> definition
+            | Projection_from_existing_specialised_arg projection ->
+              Projection_from_existing_specialised_arg
+                (Projection.map_projecting_from projection
+                  ~f:find_wrapper_param)
+          in
+          let benefit =
+            match (definition : Definition.t) with
+            | Existing_inner_free_var _ -> benefit
+            | Projection_from_existing_specialised_arg projection ->
+              B.add_projection projection benefit
+          in
+          match
+            Variable.Map.find new_inner_var
+              new_inner_vars_to_spec_args_bound_in_the_wrapper_renaming
+          with
+          | exception Not_found -> assert false
+          | new_inner_var_of_wrapper ->
+            let named : Flambda.named =
+              match definition with
+              | Existing_inner_free_var existing_inner_var ->
+                Expr (Var existing_inner_var)
+              | Projection_from_existing_specialised_arg projection ->
+                Flambda_utils.projection_to_named projection
+            in
+            let wrapper_body =
+              Flambda.create_let new_inner_var_of_wrapper named wrapper_body
+            in
+            (wrapper_body, benefit))
+      for_one_function.new_definitions_indexed_by_new_inner_vars
+      (apply, benefit)
+    in
+    let rewritten_existing_specialised_args =
+      Variable.Map.fold (fun inner_var (spec_to : Flambda.specialised_to)
+                result ->
+          let inner_var = find_wrapper_param inner_var in
+          let projection =
+            match spec_to.projection with
+            | None -> None
+            | Some projection ->
+              Some (Projection.map_projecting_from projection
+                ~f:find_wrapper_param)
+          in
+          let spec_to : Flambda.specialised_to =
+            { var = spec_to.var;
+              projection;
+            }
+          in
+          Variable.Map.add inner_var spec_to result)
+        for_one_function.existing_specialised_args
+        Variable.Map.empty
+    in
+    let new_function_decl =
+      Flambda.create_function_declaration
+        ~params:wrapper_params
+        ~body:wrapper_body
+        ~stub:true
+        ~dbg:Debuginfo.none
+        ~inline:Default_inline
+        ~specialise:Default_specialise
+        ~is_a_functor:false
+        ~closure_origin:function_decl.closure_origin
+    in
+    new_fun_var, new_function_decl, rewritten_existing_specialised_args,
+      benefit
+
+  let rewrite_function_decl (t : P.t) ~env ~duplicate_function
+      ~(for_one_function : P.for_one_function) ~benefit =
+    let set_of_closures = t.set_of_closures in
+    let fun_var = for_one_function.fun_var in
+    let function_decl = for_one_function.function_decl in
+    let num_definitions =
+      Variable.Map.cardinal for_one_function.
+        new_definitions_indexed_by_new_inner_vars
+    in
+    if function_decl.stub
+      || num_definitions < 1
+      || Variable.Map.mem fun_var set_of_closures.direct_call_surrogates
+    then
+      None
+    else
+      let new_fun_var, wrapper, rewritten_existing_specialised_args, benefit =
+        create_wrapper ~for_one_function ~benefit
+      in
+      let new_specialised_args =
+        Variable.Map.mapi (fun new_inner_var (definition : Definition.t)
+                : Flambda.specialised_to ->
+            assert (not (Variable.Map.mem new_inner_var
+              set_of_closures.specialised_args));
+            match
+              Variable.Map.find new_inner_var
+                for_one_function.new_inner_to_new_outer_vars
+            with
+            | exception Not_found -> assert false
+            | new_outer_var ->
+              match definition with
+              | Existing_inner_free_var _ ->
+                { var = new_outer_var;
+                  projection = None;
+                }
+              | Projection_from_existing_specialised_arg projection ->
+                let projecting_from = Projection.projecting_from projection in
+                assert (Variable.Map.mem projecting_from
+                  set_of_closures.specialised_args);
+                assert (Variable.Set.mem projecting_from
+                  (Parameter.Set.vars function_decl.params));
+                { var = new_outer_var;
+                  projection = Some projection;
+                })
+          for_one_function.new_definitions_indexed_by_new_inner_vars
+      in
+      let specialised_args =
+        Variable.Map.disjoint_union rewritten_existing_specialised_args
+          new_specialised_args
+      in
+      let specialised_args, existing_function_decl =
+        if not for_one_function.make_direct_call_surrogates then
+          specialised_args, None
+        else
+          let function_decl, new_specialised_args =
+            duplicate_function ~env ~set_of_closures ~fun_var ~new_fun_var
+          in
+          let specialised_args =
+            Variable.Map.disjoint_union specialised_args new_specialised_args
+          in
+          specialised_args, Some function_decl
+      in
+      let all_params =
+        let new_params =
+          Variable.Set.elements (Variable.Map.keys
+            for_one_function.new_inner_to_new_outer_vars)
+        in
+        let new_params =
+          List.map Parameter.wrap new_params
+        in
+        function_decl.params @ new_params
+      in
+      let closure_origin =
+        Closure_origin.create (Closure_id.wrap new_fun_var)
+      in
+      let rewritten_function_decl =
+        Flambda.create_function_declaration
+          ~params:all_params
+          ~body:function_decl.body
+          ~stub:function_decl.stub
+          ~dbg:function_decl.dbg
+          ~inline:function_decl.inline
+          ~specialise:function_decl.specialise
+          ~is_a_functor:function_decl.is_a_functor
+          ~closure_origin
+      in
+      let funs, direct_call_surrogates =
+        if for_one_function.make_direct_call_surrogates then
+          let surrogate = Variable.rename fun_var in
+          let funs =
+            (* In this case, the original function declaration remains
+               untouched up to alpha-equivalence.  Direct calls to it
+               (including inside the rewritten original function) will be
+               replaced by calls to the surrogate (i.e. the wrapper) which
+               will then be inlined. *)
+            let existing_function_decl =
+              match existing_function_decl with
+              | Some decl -> decl
+              | None -> assert false
+            in
+            Variable.Map.add new_fun_var rewritten_function_decl
+              (Variable.Map.add surrogate wrapper
+                (Variable.Map.add fun_var existing_function_decl
+                  Variable.Map.empty))
+          in
+          let direct_call_surrogates =
+            Variable.Map.add fun_var surrogate Variable.Map.empty
+          in
+          funs, direct_call_surrogates
+        else
+          let funs =
+            Variable.Map.add new_fun_var rewritten_function_decl
+              (Variable.Map.add fun_var wrapper Variable.Map.empty)
+          in
+          funs, Variable.Map.empty
+      in
+      let free_vars = Variable.Map.empty in
+      Some (funs, free_vars, specialised_args, direct_call_surrogates, benefit)
+
+  let add_lifted_projections_around_set_of_closures
+        ~(set_of_closures : Flambda.set_of_closures) ~benefit
+        ~new_lifted_defns_indexed_by_new_outer_vars =
+    let body =
+      Flambda_utils.name_expr
+        ~name:Internal_variable_names.set_of_closures
+        (Set_of_closures set_of_closures)
+    in
+    Variable.Map.fold (fun new_outer_var (projection : Projection.t)
+          (expr, benefit) ->
+        let named = Flambda_utils.projection_to_named projection in
+        let benefit = B.add_projection projection benefit in
+        let expr = Flambda.create_let new_outer_var named expr in
+        expr, benefit)
+      new_lifted_defns_indexed_by_new_outer_vars
+      (body, benefit)
+
+  let rewrite_set_of_closures_core ~env ~duplicate_function ~benefit
+        ~(set_of_closures : Flambda.set_of_closures) =
+    let what_to_specialise =
+      P.create ~env
+        ~what_to_specialise:(T.what_to_specialise ~env ~set_of_closures)
+    in
+    let original_set_of_closures = set_of_closures in
+    let funs, free_vars, specialised_args, direct_call_surrogates,
+        done_something, benefit =
+      Variable.Map.fold (fun fun_var function_decl
+                (funs, free_vars, specialised_args, direct_call_surrogates,
+                  done_something, benefit) ->
+          match Variable.Map.find fun_var what_to_specialise.functions with
+          | exception Not_found ->
+            let funs = Variable.Map.add fun_var function_decl funs in
+            funs, free_vars, specialised_args, direct_call_surrogates,
+              done_something, benefit
+          | (for_one_function : P.for_one_function) ->
+            assert (Variable.equal fun_var for_one_function.fun_var);
+            match
+              rewrite_function_decl what_to_specialise ~env
+                ~duplicate_function ~for_one_function ~benefit
+            with
+            | None ->
+              let function_decl = for_one_function.function_decl in
+              let funs = Variable.Map.add fun_var function_decl funs in
+              funs, free_vars, specialised_args, direct_call_surrogates,
+                done_something, benefit
+            | Some (funs', free_vars', specialised_args',
+                direct_call_surrogates', benefit) ->
+              let funs = Variable.Map.disjoint_union funs funs' in
+              let direct_call_surrogates =
+                Variable.Map.disjoint_union direct_call_surrogates
+                  direct_call_surrogates'
+              in
+              let free_vars =
+                Variable.Map.disjoint_union free_vars free_vars'
+              in
+              let specialised_args =
+                Variable.Map.disjoint_union specialised_args specialised_args'
+              in
+              funs, free_vars, specialised_args, direct_call_surrogates, true,
+                benefit)
+        set_of_closures.function_decls.funs
+        (Variable.Map.empty, set_of_closures.free_vars,
+          set_of_closures.specialised_args,
+          set_of_closures.direct_call_surrogates, false, benefit)
+    in
+    if not done_something then
+      None
+    else
+      let function_decls =
+        Flambda.update_function_declarations set_of_closures.function_decls
+          ~funs
+      in
+      assert (Variable.Map.cardinal specialised_args
+        >= Variable.Map.cardinal original_set_of_closures.specialised_args);
+      let set_of_closures =
+        Flambda.create_set_of_closures
+          ~function_decls
+          ~free_vars
+          ~specialised_args
+          ~direct_call_surrogates
+      in
+      if !Clflags.flambda_invariant_checks then begin
+        check_invariants ~set_of_closures ~original_set_of_closures
+          ~pass_name:T.pass_name
+      end;
+      let expr, benefit =
+        add_lifted_projections_around_set_of_closures ~set_of_closures ~benefit
+          ~new_lifted_defns_indexed_by_new_outer_vars:
+            what_to_specialise.new_lifted_defns_indexed_by_new_outer_vars
+      in
+      Some (expr, benefit)
+
+  let rewrite_set_of_closures ~env ~duplicate_function ~set_of_closures =
+    Pass_wrapper.with_dump ~ppf_dump:(Inline_and_simplify_aux.Env.ppf_dump env)
+      ~pass_name:T.pass_name ~input:set_of_closures
+      ~print_input:Flambda.print_set_of_closures
+      ~print_output:(fun ppf (expr, _) -> Flambda.print ppf expr)
+      ~f:(fun () ->
+        rewrite_set_of_closures_core ~env ~duplicate_function
+          ~benefit:B.zero ~set_of_closures)
+end
diff --git a/middle_end/flambda/augment_specialised_args.mli b/middle_end/flambda/augment_specialised_args.mli
new file mode 100644
index 00000000..910a2d15
--- /dev/null
+++ b/middle_end/flambda/augment_specialised_args.mli
@@ -0,0 +1,65 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Helper module for adding specialised arguments to sets of closures. *)
+
+module Definition : sig
+  type t =
+    | Existing_inner_free_var of Variable.t
+    | Projection_from_existing_specialised_arg of Projection.t
+end
+
+module What_to_specialise : sig
+  type t
+
+  val create
+     : set_of_closures:Flambda.set_of_closures
+    -> t
+
+  val new_specialised_arg
+     : t
+    -> fun_var:Variable.t
+    -> group:Variable.t
+    -> definition:Definition.t  (* [projecting_from] "existing inner vars" *)
+    -> t
+
+  val make_direct_call_surrogate_for : t -> fun_var:Variable.t -> t
+end
+
+module type S = sig
+  val pass_name : string
+
+  val what_to_specialise
+     : env:Inline_and_simplify_aux.Env.t
+    -> set_of_closures:Flambda.set_of_closures
+    -> What_to_specialise.t
+end
+
+module Make (_ : S) : sig
+  (** [duplicate_function] should be
+      [Inline_and_simplify.duplicate_function]. *)
+  val rewrite_set_of_closures
+     : env:Inline_and_simplify_aux.Env.t
+    -> duplicate_function:(
+         env:Inline_and_simplify_aux.Env.t
+      -> set_of_closures:Flambda.set_of_closures
+      -> fun_var:Variable.t
+      -> new_fun_var:Variable.t
+      -> Flambda.function_declaration
+        * Flambda.specialised_to Variable.Map.t)
+    -> set_of_closures:Flambda.set_of_closures
+    -> (Flambda.expr * Inlining_cost.Benefit.t) option
+end
diff --git a/middle_end/flambda/base_types/closure_element.ml b/middle_end/flambda/base_types/closure_element.ml
new file mode 100644
index 00000000..561e0803
--- /dev/null
+++ b/middle_end/flambda/base_types/closure_element.ml
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+include Variable
+
+let wrap t = t
+let unwrap t = t
+
+let wrap_map t = t
+let unwrap_set t = t
diff --git a/middle_end/flambda/base_types/closure_element.mli b/middle_end/flambda/base_types/closure_element.mli
new file mode 100644
index 00000000..d78dd9b3
--- /dev/null
+++ b/middle_end/flambda/base_types/closure_element.mli
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+include Identifiable.S
+
+val wrap : Variable.t -> t
+val unwrap : t -> Variable.t
+
+val wrap_map : 'a Variable.Map.t -> 'a Map.t
+val unwrap_set : Set.t -> Variable.Set.t
+
+val in_compilation_unit : t -> Compilation_unit.t -> bool
+val get_compilation_unit : t -> Compilation_unit.t
+
+val unique_name : t -> string
+
+val output_full : out_channel -> t -> unit
diff --git a/middle_end/flambda/base_types/closure_id.ml b/middle_end/flambda/base_types/closure_id.ml
new file mode 100644
index 00000000..466f59a2
--- /dev/null
+++ b/middle_end/flambda/base_types/closure_id.ml
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+include Closure_element
diff --git a/middle_end/flambda/base_types/closure_id.mli b/middle_end/flambda/base_types/closure_id.mli
new file mode 100644
index 00000000..853a07f7
--- /dev/null
+++ b/middle_end/flambda/base_types/closure_id.mli
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** CR-someday lwhite: "Closure_id" is quite a generic name.  I wonder
+    whether something like "Closure_label" would better capture that it is
+    the label of a projection. *)
+
+(** An identifier, unique across the whole program (not just one compilation
+    unit), that identifies a closure within a particular set of closures
+    (viz. [Project_closure]). *)
+
+include module type of Closure_element
diff --git a/middle_end/flambda/base_types/closure_origin.ml b/middle_end/flambda/base_types/closure_origin.ml
new file mode 100644
index 00000000..2285c687
--- /dev/null
+++ b/middle_end/flambda/base_types/closure_origin.ml
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*     Mark Shinwell, Leo White and Fu Yong Quah, Jane Street Europe      *)
+(*                                                                        *)
+(*   Copyright 2013--2017 OCamlPro SAS                                    *)
+(*   Copyright 2014--2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+include Closure_id
+
+let create t = t
diff --git a/middle_end/flambda/base_types/closure_origin.mli b/middle_end/flambda/base_types/closure_origin.mli
new file mode 100644
index 00000000..86fcd56c
--- /dev/null
+++ b/middle_end/flambda/base_types/closure_origin.mli
@@ -0,0 +1,21 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*     Mark Shinwell, Leo White and Fu Yong Quah, Jane Street Europe      *)
+(*                                                                        *)
+(*   Copyright 2013--2017 OCamlPro SAS                                    *)
+(*   Copyright 2014--2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+include Identifiable.S
+
+val create : Closure_id.t -> t
+
+val get_compilation_unit : t -> Compilation_unit.t
diff --git a/middle_end/flambda/base_types/export_id.ml b/middle_end/flambda/base_types/export_id.ml
new file mode 100644
index 00000000..681ac955
--- /dev/null
+++ b/middle_end/flambda/base_types/export_id.ml
@@ -0,0 +1,29 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module Id : Id_types.Id = Id_types.Id (struct end)
+module Unit_id = Id_types.UnitId (Id) (Compilation_unit)
+
+type t = Unit_id.t
+
+include Identifiable.Make (Unit_id)
+
+let create = Unit_id.create
+let get_compilation_unit = Unit_id.unit
+let name = Unit_id.name
diff --git a/middle_end/flambda/base_types/export_id.mli b/middle_end/flambda/base_types/export_id.mli
new file mode 100644
index 00000000..54c14418
--- /dev/null
+++ b/middle_end/flambda/base_types/export_id.mli
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(* Keys representing value descriptions that may be written into
+   intermediate files and loaded by a dependent compilation unit.
+   These keys are used to ensure maximal sharing of value descriptions,
+   which may be substantial. *)
+
+include Identifiable.S
+
+val create : ?name:string -> Compilation_unit.t -> t
+val name : t -> string option
+val get_compilation_unit : t -> Compilation_unit.t
diff --git a/middle_end/flambda/base_types/id_types.ml b/middle_end/flambda/base_types/id_types.ml
new file mode 100644
index 00000000..c9a77adc
--- /dev/null
+++ b/middle_end/flambda/base_types/id_types.ml
@@ -0,0 +1,93 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module type BaseId = sig
+  type t
+  val equal : t -> t -> bool
+  val compare : t -> t -> int
+  val hash : t -> int
+  val name : t -> string option
+  val to_string : t -> string
+  val output : out_channel -> t -> unit
+  val print : Format.formatter -> t -> unit
+end
+
+module type Id = sig
+  include BaseId
+  val create : ?name:string -> unit -> t
+end
+
+module type UnitId = sig
+  module Compilation_unit : Identifiable.Thing
+  include BaseId
+  val create : ?name:string -> Compilation_unit.t -> t
+  val unit : t -> Compilation_unit.t
+end
+
+module Id() : Id = struct
+  type t = int * string
+  let empty_string = ""
+  let create = let r = ref 0 in
+    fun  ?(name=empty_string) () -> incr r; !r, name
+  let equal (t1,_) (t2,_) = (t1:int) = t2
+  let compare (t1,_) (t2,_) = t1 - t2
+  let hash (t,_) = t
+  let name (_,name) =
+    if name == empty_string
+    then None
+    else Some name
+  let to_string (t,name) =
+    if name == empty_string
+    then Int.to_string t
+    else Printf.sprintf "%s_%i" name t
+  let output fd t = output_string fd (to_string t)
+  let print ppf v = Format.pp_print_string ppf (to_string v)
+end
+
+module UnitId(Innerid:Id)(Compilation_unit:Identifiable.Thing) :
+  UnitId with module Compilation_unit := Compilation_unit = struct
+  type t = {
+    id : Innerid.t;
+    unit : Compilation_unit.t;
+  }
+  let compare x y =
+    let c = Innerid.compare x.id y.id in
+    if c <> 0
+    then c
+    else Compilation_unit.compare x.unit y.unit
+  let output oc x =
+    Printf.fprintf oc "%a.%a"
+      Compilation_unit.output x.unit
+      Innerid.output x.id
+  let print ppf x =
+    Format.fprintf ppf "%a.%a"
+      Compilation_unit.print x.unit
+      Innerid.print x.id
+  let hash off = Hashtbl.hash off
+  let equal o1 o2 = compare o1 o2 = 0
+  let name o = Innerid.name o.id
+  let to_string x =
+    Format.asprintf "%a.%a"
+      Compilation_unit.print x.unit
+      Innerid.print x.id
+  let create ?name unit =
+    let id = Innerid.create ?name () in
+    { id; unit }
+  let unit x = x.unit
+end
diff --git a/middle_end/flambda/base_types/id_types.mli b/middle_end/flambda/base_types/id_types.mli
new file mode 100644
index 00000000..78ca75a8
--- /dev/null
+++ b/middle_end/flambda/base_types/id_types.mli
@@ -0,0 +1,54 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(* CR-soon mshinwell: This module should be removed. *)
+
+(** Generic identifier type *)
+module type BaseId =
+sig
+  type t
+  val equal : t -> t -> bool
+  val compare : t -> t -> int
+  val hash : t -> int
+  val name : t -> string option
+  val to_string : t -> string
+  val output : out_channel -> t -> unit
+  val print : Format.formatter -> t -> unit
+end
+
+module type Id =
+sig
+  include BaseId
+  val create : ?name:string -> unit -> t
+end
+
+(** Fully qualified identifiers *)
+module type UnitId =
+sig
+  module Compilation_unit : Identifiable.Thing
+  include BaseId
+  val create : ?name:string -> Compilation_unit.t -> t
+  val unit : t -> Compilation_unit.t
+end
+
+module Id () : Id
+
+module UnitId :
+  Id ->
+  functor (Compilation_unit : Identifiable.Thing) ->
+    UnitId with module Compilation_unit := Compilation_unit
diff --git a/middle_end/flambda/base_types/mutable_variable.ml b/middle_end/flambda/base_types/mutable_variable.ml
new file mode 100644
index 00000000..07fe3152
--- /dev/null
+++ b/middle_end/flambda/base_types/mutable_variable.ml
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+include Variable
+
+let create_from_variable = rename
diff --git a/middle_end/flambda/base_types/mutable_variable.mli b/middle_end/flambda/base_types/mutable_variable.mli
new file mode 100644
index 00000000..17fe208f
--- /dev/null
+++ b/middle_end/flambda/base_types/mutable_variable.mli
@@ -0,0 +1,47 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+include Identifiable.S
+
+val create
+   : ?current_compilation_unit:Compilation_unit.t
+  -> Internal_variable_names.t
+  -> t
+
+val create_with_same_name_as_ident : Ident.t -> t
+
+val create_from_variable
+  : ?current_compilation_unit:Compilation_unit.t
+  -> Variable.t
+  -> t
+
+val rename
+   : ?current_compilation_unit:Compilation_unit.t
+  -> t
+  -> t
+
+val in_compilation_unit : t -> Compilation_unit.t -> bool
+
+val name : t -> string
+
+val unique_name : t -> string
+
+val print_list : Format.formatter -> t list -> unit
+val print_opt : Format.formatter -> t option -> unit
+
+val output_full : out_channel -> t -> unit
diff --git a/middle_end/flambda/base_types/set_of_closures_id.ml b/middle_end/flambda/base_types/set_of_closures_id.ml
new file mode 100644
index 00000000..681ac955
--- /dev/null
+++ b/middle_end/flambda/base_types/set_of_closures_id.ml
@@ -0,0 +1,29 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module Id : Id_types.Id = Id_types.Id (struct end)
+module Unit_id = Id_types.UnitId (Id) (Compilation_unit)
+
+type t = Unit_id.t
+
+include Identifiable.Make (Unit_id)
+
+let create = Unit_id.create
+let get_compilation_unit = Unit_id.unit
+let name = Unit_id.name
diff --git a/middle_end/flambda/base_types/set_of_closures_id.mli b/middle_end/flambda/base_types/set_of_closures_id.mli
new file mode 100644
index 00000000..811cb661
--- /dev/null
+++ b/middle_end/flambda/base_types/set_of_closures_id.mli
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** An identifier, unique across the whole program, that identifies a set
+    of closures (viz. [Set_of_closures]). *)
+
+include Identifiable.S
+
+val create : ?name:string -> Compilation_unit.t -> t
+val name : t -> string option
+val get_compilation_unit : t -> Compilation_unit.t
diff --git a/middle_end/flambda/base_types/set_of_closures_origin.ml b/middle_end/flambda/base_types/set_of_closures_origin.ml
new file mode 100644
index 00000000..a5ef8c7c
--- /dev/null
+++ b/middle_end/flambda/base_types/set_of_closures_origin.ml
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+include Set_of_closures_id
+
+let create t = t
+let rename f t = f t
diff --git a/middle_end/flambda/base_types/set_of_closures_origin.mli b/middle_end/flambda/base_types/set_of_closures_origin.mli
new file mode 100644
index 00000000..4c9cfdcf
--- /dev/null
+++ b/middle_end/flambda/base_types/set_of_closures_origin.mli
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+include Identifiable.S
+
+val create : Set_of_closures_id.t -> t
+
+val get_compilation_unit : t -> Compilation_unit.t
+val rename : (Set_of_closures_id.t -> Set_of_closures_id.t) -> t -> t
diff --git a/middle_end/flambda/base_types/static_exception.ml b/middle_end/flambda/base_types/static_exception.ml
new file mode 100644
index 00000000..6cecae63
--- /dev/null
+++ b/middle_end/flambda/base_types/static_exception.ml
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+include Numbers.Int
+
+let create () = Lambda.next_raise_count ()
+let to_int t = t
diff --git a/middle_end/flambda/base_types/static_exception.mli b/middle_end/flambda/base_types/static_exception.mli
new file mode 100644
index 00000000..88f690aa
--- /dev/null
+++ b/middle_end/flambda/base_types/static_exception.mli
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** An identifier that is used to label static exceptions.  Its
+    uniqueness properties are unspecified. *)
+
+include Identifiable.S
+
+val create : unit -> t
+
+val to_int : t -> int
diff --git a/middle_end/flambda/base_types/tag.ml b/middle_end/flambda/base_types/tag.ml
new file mode 100644
index 00000000..cfa51ddb
--- /dev/null
+++ b/middle_end/flambda/base_types/tag.ml
@@ -0,0 +1,35 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+type t = int
+
+include Identifiable.Make (Numbers.Int)
+
+let create_exn tag =
+  if tag < 0 || tag > 255 then
+    Misc.fatal_error (Printf.sprintf "Tag.create_exn %d" tag)
+  else
+    tag
+
+let to_int t = t
+
+let zero = 0
+let object_tag = Obj.object_tag
+
+let compare : t -> t -> int = Stdlib.compare
diff --git a/middle_end/flambda/base_types/tag.mli b/middle_end/flambda/base_types/tag.mli
new file mode 100644
index 00000000..12ce5525
--- /dev/null
+++ b/middle_end/flambda/base_types/tag.mli
@@ -0,0 +1,29 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Tags on runtime boxed values. *)
+
+include Identifiable.S
+
+val create_exn : int -> t
+val to_int : t -> int
+
+val zero : t
+val object_tag : t
+
+val compare : t -> t -> int
diff --git a/middle_end/flambda/base_types/var_within_closure.ml b/middle_end/flambda/base_types/var_within_closure.ml
new file mode 100644
index 00000000..466f59a2
--- /dev/null
+++ b/middle_end/flambda/base_types/var_within_closure.ml
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+include Closure_element
diff --git a/middle_end/flambda/base_types/var_within_closure.mli b/middle_end/flambda/base_types/var_within_closure.mli
new file mode 100644
index 00000000..56f0af0a
--- /dev/null
+++ b/middle_end/flambda/base_types/var_within_closure.mli
@@ -0,0 +1,24 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** An identifier, unique across the whole program, that identifies a
+    particular variable within a particular closure.  Only
+    [Project_var], and not [Var], nodes are tagged with these
+    identifiers. *)
+
+include module type of Closure_element
diff --git a/middle_end/flambda/build_export_info.ml b/middle_end/flambda/build_export_info.ml
new file mode 100644
index 00000000..2025fedd
--- /dev/null
+++ b/middle_end/flambda/build_export_info.ml
@@ -0,0 +1,728 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+module Env : sig
+  type t
+
+  val new_descr : t -> Export_info.descr -> Export_id.t
+
+  val record_descr : t -> Export_id.t -> Export_info.descr -> unit
+  val new_value_closure_descr
+    : t
+    -> closure_id:Closure_id.t
+    -> set_of_closures: Export_info.value_set_of_closures
+    -> Export_id.t
+
+  val get_descr : t -> Export_info.approx -> Export_info.descr option
+
+  val add_approx : t -> Variable.t -> Export_info.approx -> t
+  val add_approx_maps : t -> Export_info.approx Variable.Map.t list -> t
+  val find_approx : t -> Variable.t -> Export_info.approx
+
+  val get_symbol_descr : t -> Symbol.t -> Export_info.descr option
+
+  val new_unit_descr : t -> Export_id.t
+
+  val is_symbol_being_defined : t -> Symbol.t -> bool
+
+  module Global : sig
+    (* "Global" as in "without local variable bindings". *)
+    type t
+
+    val create_empty : unit -> t
+
+    val add_symbol : t -> Symbol.t -> Export_id.t -> t
+    val new_symbol : t -> Symbol.t -> Export_id.t * t
+
+    val symbol_to_export_id_map : t -> Export_id.t Symbol.Map.t
+    val export_id_to_descr_map : t -> Export_info.descr Export_id.Map.t
+  end
+
+  (** Creates a new environment, sharing the mapping from export IDs to
+      export descriptions with the given global environment. *)
+  val empty_of_global : symbols_being_defined:Symbol.Set.t -> Global.t -> t
+end = struct
+  let fresh_id () = Export_id.create (Compilenv.current_unit ())
+
+  module Global = struct
+    type t =
+      { sym : Export_id.t Symbol.Map.t;
+        (* Note that [ex_table]s themselves are shared (hence [ref] and not
+           [mutable]). *)
+        ex_table : Export_info.descr Export_id.Map.t ref;
+        closure_table : Export_id.t Closure_id.Map.t ref;
+      }
+
+    let create_empty () =
+      { sym = Symbol.Map.empty;
+        ex_table = ref Export_id.Map.empty;
+        closure_table = ref Closure_id.Map.empty;
+      }
+
+    let add_symbol t sym export_id =
+      if Symbol.Map.mem sym t.sym then begin
+        Misc.fatal_errorf "Build_export_info.Env.Global.add_symbol: cannot \
+            rebind symbol %a in environment"
+          Symbol.print sym
+      end;
+      { t with sym = Symbol.Map.add sym export_id t.sym }
+
+    let new_symbol t sym =
+      let export_id = fresh_id () in
+      export_id, add_symbol t sym export_id
+
+    let symbol_to_export_id_map t = t.sym
+    let export_id_to_descr_map t = !(t.ex_table)
+  end
+
+  (* CR-someday mshinwell: The half-mutable nature of [t] with sharing of
+     the [ex_table] is kind of nasty.  Consider making it immutable. *)
+  type t =
+    { var : Export_info.approx Variable.Map.t;
+      sym : Export_id.t Symbol.Map.t;
+      symbols_being_defined : Symbol.Set.t;
+      ex_table : Export_info.descr Export_id.Map.t ref;
+      closure_table: Export_id.t Closure_id.Map.t ref;
+    }
+
+  let empty_of_global ~symbols_being_defined (env : Global.t) =
+    { var = Variable.Map.empty;
+      sym = env.sym;
+      symbols_being_defined;
+      ex_table = env.ex_table;
+      closure_table = env.closure_table;
+    }
+
+  let extern_id_descr export_id =
+    let export = Compilenv.approx_env () in
+    try Some (Export_info.find_description export export_id)
+    with Not_found -> None
+
+  let extern_symbol_descr sym =
+    if Compilenv.is_predefined_exception sym
+    then None
+    else
+      match
+        Compilenv.approx_for_global (Symbol.compilation_unit sym)
+      with
+      | None -> None
+      | Some export ->
+        try
+          let id = Symbol.Map.find sym export.symbol_id in
+          let descr = Export_info.find_description export id in
+          Some descr
+        with
+        | Not_found -> None
+
+  let get_id_descr t export_id =
+    try Some (Export_id.Map.find export_id !(t.ex_table))
+    with Not_found -> extern_id_descr export_id
+
+  let get_symbol_descr t sym =
+    try
+      let export_id = Symbol.Map.find sym t.sym in
+      Some (Export_id.Map.find export_id !(t.ex_table))
+    with
+    | Not_found -> extern_symbol_descr sym
+
+  let get_descr t (approx : Export_info.approx) =
+    match approx with
+    | Value_unknown -> None
+    | Value_id export_id -> get_id_descr t export_id
+    | Value_symbol sym -> get_symbol_descr t sym
+
+  let record_descr t id (descr : Export_info.descr) =
+    if Export_id.Map.mem id !(t.ex_table) then begin
+      Misc.fatal_errorf "Build_export_info.Env.record_descr: cannot rebind \
+          export ID %a in environment"
+        Export_id.print id
+    end;
+    t.ex_table := Export_id.Map.add id descr !(t.ex_table)
+
+  let new_descr t (descr : Export_info.descr) =
+    let id = fresh_id () in
+    record_descr t id descr;
+    id
+
+  let new_value_closure_descr t ~closure_id ~set_of_closures =
+    match Closure_id.Map.find closure_id !(t.closure_table) with
+    | exception Not_found ->
+      let export_id =
+        new_descr t (Value_closure { closure_id; set_of_closures })
+      in
+      t.closure_table :=
+        Closure_id.Map.add closure_id export_id !(t.closure_table);
+      export_id
+    | export_id -> export_id
+
+  let new_unit_descr t =
+    new_descr t (Value_constptr 0)
+
+  let add_approx t var approx =
+    if Variable.Map.mem var t.var then begin
+      Misc.fatal_errorf "Build_export_info.Env.add_approx: cannot rebind \
+          variable %a in environment"
+        Variable.print var
+    end;
+    { t with var = Variable.Map.add var approx t.var; }
+
+  let add_approx_map t vars_to_approxs =
+    Variable.Map.fold (fun var approx t -> add_approx t var approx)
+      vars_to_approxs
+      t
+
+  let add_approx_maps t vars_to_approxs_list =
+    List.fold_left add_approx_map t vars_to_approxs_list
+
+  let find_approx t var : Export_info.approx =
+    try Variable.Map.find var t.var with
+    | Not_found -> Value_unknown
+
+  let is_symbol_being_defined t sym =
+    Symbol.Set.mem sym t.symbols_being_defined
+end
+
+let descr_of_constant (c : Flambda.const) : Export_info.descr =
+  match c with
+  (* [Const_pointer] is an immediate value of a type whose values may be
+     boxed (typically a variant type with both constant and non-constant
+     constructors). *)
+  | Int i -> Value_int i
+  | Char c -> Value_char c
+  | Const_pointer i -> Value_constptr i
+
+let descr_of_allocated_constant (c : Allocated_const.t) : Export_info.descr =
+  match c with
+  | Float f -> Value_float f
+  | Int32 i -> Value_boxed_int (Int32, i)
+  | Int64 i -> Value_boxed_int (Int64, i)
+  | Nativeint i -> Value_boxed_int (Nativeint, i)
+  | String s ->
+    let v_string : Export_info.value_string =
+      { size = String.length s; contents = Unknown_or_mutable; }
+    in
+    Value_string v_string
+  | Immutable_string s ->
+    let v_string : Export_info.value_string =
+      { size = String.length s; contents = Contents s; }
+    in
+    Value_string v_string
+  | Immutable_float_array fs ->
+    Value_float_array {
+      contents = Contents (Array.map (fun x -> Some x) (Array.of_list fs));
+      size = List.length fs;
+    }
+  | Float_array fs ->
+    Value_float_array {
+      contents = Unknown_or_mutable;
+      size = List.length fs;
+    }
+
+let rec approx_of_expr (env : Env.t) (flam : Flambda.t) : Export_info.approx =
+  match flam with
+  | Var var -> Env.find_approx env var
+  | Let { var; defining_expr; body; _ } ->
+    let approx = descr_of_named env defining_expr in
+    let env = Env.add_approx env var approx in
+    approx_of_expr env body
+  | Let_mutable { body } ->
+    approx_of_expr env body
+  | Let_rec (defs, body) ->
+    let env =
+      List.fold_left (fun env (var, defining_expr) ->
+          let approx = descr_of_named env defining_expr in
+          Env.add_approx env var approx)
+        env defs
+    in
+    approx_of_expr env body
+  | Apply { func; kind; _ } ->
+    begin match kind with
+    | Indirect -> Value_unknown
+    | Direct closure_id' ->
+      match Env.get_descr env (Env.find_approx env func) with
+      | Some (Value_closure
+          { closure_id; set_of_closures = { results; _ }; }) ->
+        assert (Closure_id.equal closure_id closure_id');
+        assert (Closure_id.Map.mem closure_id results);
+        Closure_id.Map.find closure_id results
+      | _ -> Value_unknown
+    end
+  | Assign _ -> Value_id (Env.new_unit_descr env)
+  | For _ -> Value_id (Env.new_unit_descr env)
+  | While _ -> Value_id (Env.new_unit_descr env)
+  | Static_raise _ | Static_catch _ | Try_with _ | If_then_else _
+  | Switch _ | String_switch _ | Send _ | Proved_unreachable ->
+    Value_unknown
+
+and descr_of_named (env : Env.t) (named : Flambda.named)
+      : Export_info.approx =
+  match named with
+  | Expr expr -> approx_of_expr env expr
+  | Symbol sym -> Value_symbol sym
+  | Read_mutable _ -> Value_unknown
+  | Read_symbol_field (sym, i) ->
+    begin match Env.get_symbol_descr env sym with
+    | Some (Value_block (_, fields)) when Array.length fields > i -> fields.(i)
+    | _ -> Value_unknown
+    end
+  | Const const ->
+    Value_id (Env.new_descr env (descr_of_constant const))
+  | Allocated_const const ->
+    Value_id (Env.new_descr env (descr_of_allocated_constant const))
+  | Prim (Pmakeblock (tag, Immutable, _value_kind), args, _dbg) ->
+    let approxs = List.map (Env.find_approx env) args in
+    let descr : Export_info.descr =
+      Value_block (Tag.create_exn tag, Array.of_list approxs)
+    in
+    Value_id (Env.new_descr env descr)
+  | Prim (Pfield i, [arg], _) ->
+    begin match Env.get_descr env (Env.find_approx env arg) with
+    | Some (Value_block (_, fields)) when Array.length fields > i -> fields.(i)
+    | _ -> Value_unknown
+    end
+  | Prim _ -> Value_unknown
+  | Set_of_closures set ->
+    let descr : Export_info.descr =
+      Value_set_of_closures (describe_set_of_closures env set)
+    in
+    Value_id (Env.new_descr env descr)
+  | Project_closure { set_of_closures; closure_id; } ->
+    begin match Env.get_descr env (Env.find_approx env set_of_closures) with
+    | Some (Value_set_of_closures set_of_closures) ->
+      if not (Closure_id.Map.mem closure_id set_of_closures.results) then begin
+        Misc.fatal_errorf "Could not build export description for \
+            [Project_closure]: closure ID %a not in set of closures"
+          Closure_id.print closure_id
+      end;
+      Value_id (
+        Env.new_value_closure_descr env ~closure_id ~set_of_closures
+      )
+    | _ ->
+      (* It would be nice if this were [assert false], but owing to the fact
+         that this pass may propagate less information than for example
+         [Inline_and_simplify], we might end up here. *)
+      Value_unknown
+    end
+  | Move_within_set_of_closures { closure; start_from; move_to; } ->
+    begin match Env.get_descr env (Env.find_approx env closure) with
+    | Some (Value_closure { set_of_closures; closure_id; }) ->
+      assert (Closure_id.equal closure_id start_from);
+      Value_id (
+        Env.new_value_closure_descr env ~closure_id:move_to ~set_of_closures
+      )
+    | _ -> Value_unknown
+    end
+  | Project_var { closure; closure_id = closure_id'; var; } ->
+    begin match Env.get_descr env (Env.find_approx env closure) with
+    | Some (Value_closure
+        { set_of_closures = { bound_vars; _ }; closure_id; }) ->
+      assert (Closure_id.equal closure_id closure_id');
+      if not (Var_within_closure.Map.mem var bound_vars) then begin
+        Misc.fatal_errorf "Project_var from %a (closure ID %a) of \
+            variable %a that is not bound by the closure.  \
+            Variables bound by the closure are: %a"
+          Variable.print closure
+          Closure_id.print closure_id
+          Var_within_closure.print var
+          (Var_within_closure.Map.print (fun _ _ -> ())) bound_vars
+      end;
+      Var_within_closure.Map.find var bound_vars
+    | _ -> Value_unknown
+    end
+
+and describe_set_of_closures env (set : Flambda.set_of_closures)
+      : Export_info.value_set_of_closures =
+  let bound_vars_approx =
+    Variable.Map.map (fun (external_var : Flambda.specialised_to) ->
+        Env.find_approx env external_var.var)
+      set.free_vars
+  in
+  let specialised_args_approx =
+    Variable.Map.map (fun (spec_to : Flambda.specialised_to) ->
+        Env.find_approx env spec_to.var)
+      set.specialised_args
+  in
+  let closures_approx =
+    (* To build an approximation of the results, we need an
+       approximation of the functions. The first one we can build is
+       one where every function returns something unknown.
+    *)
+    (* CR-someday pchambart: we could improve a bit on that by building a
+       recursive approximation of the closures: The value_closure
+       description contains a [value_set_of_closures]. We could replace
+       this field by a [Expr_id.t] or an [approx].
+       mshinwell: Deferred for now.
+    *)
+    let initial_value_set_of_closures =
+      { Export_info.
+        set_of_closures_id = set.function_decls.set_of_closures_id;
+        bound_vars = Var_within_closure.wrap_map bound_vars_approx;
+        free_vars = set.free_vars;
+        results =
+          Closure_id.wrap_map
+            (Variable.Map.map (fun _ -> Export_info.Value_unknown)
+              set.function_decls.funs);
+        aliased_symbol = None;
+      }
+    in
+    Variable.Map.mapi (fun fun_var _function_decl ->
+        let export_id =
+          let closure_id = Closure_id.wrap fun_var in
+          let set_of_closures = initial_value_set_of_closures in
+          Env.new_value_closure_descr env ~closure_id ~set_of_closures
+        in
+        Export_info.Value_id export_id)
+      set.function_decls.funs
+  in
+  let closure_env =
+    Env.add_approx_maps env
+      [closures_approx; bound_vars_approx; specialised_args_approx]
+  in
+  let results =
+    let result_approx _var (function_decl : Flambda.function_declaration) =
+      approx_of_expr closure_env function_decl.body
+    in
+    Variable.Map.mapi result_approx set.function_decls.funs
+  in
+  { set_of_closures_id = set.function_decls.set_of_closures_id;
+    bound_vars = Var_within_closure.wrap_map bound_vars_approx;
+    free_vars = set.free_vars;
+    results = Closure_id.wrap_map results;
+    aliased_symbol = None;
+  }
+
+let approx_of_constant_defining_value_block_field env
+      (c : Flambda.constant_defining_value_block_field) : Export_info.approx =
+  match c with
+  | Symbol s ->
+      if Env.is_symbol_being_defined env s
+      then Value_unknown
+      else Value_symbol s
+  | Const c -> Value_id (Env.new_descr env (descr_of_constant c))
+
+let describe_constant_defining_value env export_id symbol
+      ~symbols_being_defined (const : Flambda.constant_defining_value) =
+  let env =
+    (* Assignments of variables to export IDs are local to each constant
+       defining value. *)
+    Env.empty_of_global ~symbols_being_defined env
+  in
+  match const with
+  | Allocated_const alloc_const ->
+    let descr = descr_of_allocated_constant alloc_const in
+    Env.record_descr env export_id descr
+  | Block (tag, fields) ->
+    let approxs =
+      List.map (approx_of_constant_defining_value_block_field env) fields
+    in
+    Env.record_descr env export_id (Value_block (tag, Array.of_list approxs))
+  | Set_of_closures set_of_closures ->
+    let descr : Export_info.descr =
+      Value_set_of_closures
+        { (describe_set_of_closures env set_of_closures) with
+          aliased_symbol = Some symbol;
+        }
+    in
+    Env.record_descr env export_id descr
+  | Project_closure (sym, closure_id) ->
+    begin match Env.get_symbol_descr env sym with
+    | Some (Value_set_of_closures set_of_closures) ->
+      if not (Closure_id.Map.mem closure_id set_of_closures.results) then begin
+        Misc.fatal_errorf "Could not build export description for \
+            [Project_closure] constant defining value: closure ID %a not in \
+            set of closures"
+          Closure_id.print closure_id
+      end;
+      let descr =
+        Export_info.Value_closure
+          { closure_id = closure_id; set_of_closures; }
+      in
+      Env.record_descr env export_id descr
+    | None ->
+      Misc.fatal_errorf
+        "Cannot project symbol %a to closure_id %a.  \
+          No available export description@."
+        Symbol.print sym
+        Closure_id.print closure_id
+    | Some (Value_closure _) ->
+      Misc.fatal_errorf
+        "Cannot project symbol %a to closure_id %a.  \
+          The symbol is a closure instead of a set of closures.@."
+        Symbol.print sym
+        Closure_id.print closure_id
+    | Some _ ->
+      Misc.fatal_errorf
+        "Cannot project symbol %a to closure_id %a.  \
+          The symbol is not a set of closures.@."
+        Symbol.print sym
+        Closure_id.print closure_id
+    end
+
+let describe_program (env : Env.Global.t) (program : Flambda.program) =
+  let rec loop env (program : Flambda.program_body) =
+    match program with
+    | Let_symbol (symbol, constant_defining_value, program) ->
+      let id, env = Env.Global.new_symbol env symbol in
+      describe_constant_defining_value env id symbol
+        ~symbols_being_defined:(Symbol.Set.singleton symbol)
+        constant_defining_value;
+      loop env program
+    | Let_rec_symbol (defs, program) ->
+      let env, defs =
+        List.fold_left (fun (env, defs) (symbol, def) ->
+            let id, env = Env.Global.new_symbol env symbol in
+            env, ((id, symbol, def) :: defs))
+          (env, []) defs
+      in
+      (* [Project_closure]s are separated to be handled last.  They are the
+         only values that need a description for their argument. *)
+      let project_closures, other_constants =
+        List.partition (function
+            | _, _, Flambda.Project_closure _ -> true
+            | _ -> false)
+          defs
+      in
+      let symbols_being_defined =
+        Symbol.Set.of_list (List.map (fun (_, sym, _) -> sym) defs)
+      in
+      List.iter (fun (id, symbol, def) ->
+          describe_constant_defining_value env id symbol
+            ~symbols_being_defined def)
+        other_constants;
+      List.iter (fun (id, symbol, def) ->
+          describe_constant_defining_value env id symbol
+            ~symbols_being_defined def)
+        project_closures;
+      loop env program
+    | Initialize_symbol (symbol, tag, fields, program) ->
+      let id =
+        let env =
+          (* Assignments of variables to export IDs are local to each
+             [Initialize_symbol] construction. *)
+          Env.empty_of_global
+            ~symbols_being_defined:(Symbol.Set.singleton symbol) env
+        in
+        let field_approxs = List.map (approx_of_expr env) fields in
+        let descr : Export_info.descr =
+          Value_block (tag, Array.of_list field_approxs)
+        in
+        Env.new_descr env descr
+      in
+      let env = Env.Global.add_symbol env symbol id in
+      loop env program
+    | Effect (_expr, program) -> loop env program
+    | End symbol -> symbol, env
+  in
+  loop env program.program_body
+
+
+let build_transient ~(backend : (module Backend_intf.S))
+      (program : Flambda.program) : Export_info.transient =
+  if !Clflags.opaque then
+    let compilation_unit = Compilenv.current_unit () in
+    let root_symbol = Compilenv.current_unit_symbol () in
+    Export_info.opaque_transient ~root_symbol ~compilation_unit
+  else
+    (* CR-soon pchambart: Should probably use that instead of the ident of
+       the module as global identifier.
+       mshinwell: Is "that" the variable "_global_symbol"?
+       Yes it is.  We are just assuming that the symbol produced from
+       the identifier of the module is the right one. *)
+    let _global_symbol, env =
+      describe_program (Env.Global.create_empty ()) program
+    in
+    let sets_of_closures_map =
+      Flambda_utils.all_sets_of_closures_map program
+    in
+    let function_declarations_map =
+      let set_of_closures_approx { Flambda. function_decls; _ } =
+        let recursive =
+          lazy
+            (Find_recursive_functions.in_function_declarations
+               function_decls ~backend)
+        in
+        let keep_body =
+          Inline_and_simplify_aux.keep_body_check
+            ~is_classic_mode:function_decls.is_classic_mode ~recursive
+        in
+        Simple_value_approx.function_declarations_approx
+          ~keep_body function_decls
+      in
+      Set_of_closures_id.Map.map set_of_closures_approx sets_of_closures_map
+    in
+    let unnested_values =
+      Env.Global.export_id_to_descr_map env
+    in
+    let invariant_params =
+      let invariant_params =
+        Set_of_closures_id.Map.map
+          (fun { Flambda. function_decls; _ } ->
+             if function_decls.is_classic_mode then begin
+               Variable.Map.empty
+             end else begin
+               Invariant_params.invariant_params_in_recursion
+                 ~backend function_decls
+             end)
+          (Flambda_utils.all_sets_of_closures_map program)
+      in
+      let export = Compilenv.approx_env () in
+      Export_id.Map.fold
+        (fun _eid (descr:Export_info.descr) invariant_params ->
+          match (descr : Export_info.descr) with
+          | Value_closure { set_of_closures }
+          | Value_set_of_closures set_of_closures ->
+            let { Export_info.set_of_closures_id } = set_of_closures in
+            begin match
+              Set_of_closures_id.Map.find set_of_closures_id
+                export.invariant_params
+            with
+            | exception Not_found ->
+              invariant_params
+            | (set : Variable.Set.t Variable.Map.t) ->
+              Set_of_closures_id.Map.add
+                set_of_closures_id set invariant_params
+            end
+          | Export_info.Value_boxed_int (_, _)
+          | Value_block _
+          | Value_mutable_block _
+          | Value_int _
+          | Value_char _
+          | Value_constptr _
+          | Value_float _
+          | Value_float_array _
+          | Value_string _
+          | Value_unknown_descr ->
+            invariant_params)
+        unnested_values invariant_params
+    in
+    let recursive =
+      let recursive =
+        Set_of_closures_id.Map.map
+          (fun { Flambda. function_decls; _ } ->
+             if function_decls.is_classic_mode then begin
+               Variable.Set.empty
+             end else begin
+               Find_recursive_functions.in_function_declarations
+                 ~backend function_decls
+             end)
+          (Flambda_utils.all_sets_of_closures_map program)
+      in
+      let export = Compilenv.approx_env () in
+      Export_id.Map.fold
+        (fun _eid (descr:Export_info.descr) recursive ->
+          match (descr : Export_info.descr) with
+          | Value_closure { set_of_closures }
+          | Value_set_of_closures set_of_closures ->
+            let { Export_info.set_of_closures_id } = set_of_closures in
+            begin match
+              Set_of_closures_id.Map.find set_of_closures_id
+                export.recursive
+            with
+            | exception Not_found ->
+              recursive
+            | (set : Variable.Set.t) ->
+              Set_of_closures_id.Map.add
+                set_of_closures_id set recursive
+            end
+          | Export_info.Value_boxed_int (_, _)
+          | Value_block _
+          | Value_mutable_block _
+          | Value_int _
+          | Value_char _
+          | Value_constptr _
+          | Value_float _
+          | Value_float_array _
+          | Value_string _
+          | Value_unknown_descr ->
+            recursive)
+        unnested_values recursive
+    in
+    let values = Export_info.nest_eid_map unnested_values in
+    let symbol_id = Env.Global.symbol_to_export_id_map env in
+    let { Traverse_for_exported_symbols.
+          set_of_closure_ids = relevant_set_of_closures;
+          symbols = relevant_symbols;
+          export_ids = relevant_export_ids;
+          set_of_closure_ids_keep_declaration =
+            relevant_set_of_closures_declaration_only;
+          relevant_local_closure_ids;
+          relevant_imported_closure_ids;
+          relevant_local_vars_within_closure;
+          relevant_imported_vars_within_closure;
+        } =
+      let closure_id_to_set_of_closures_id =
+        Set_of_closures_id.Map.fold
+          (fun set_of_closure_id
+            (function_declarations : Simple_value_approx.function_declarations)
+            acc ->
+              Variable.Map.fold
+                (fun fun_var _ acc ->
+                  let closure_id = Closure_id.wrap fun_var in
+                  Closure_id.Map.add closure_id set_of_closure_id acc)
+                function_declarations.funs
+                acc)
+          function_declarations_map
+          Closure_id.Map.empty
+      in
+      Traverse_for_exported_symbols.traverse
+        ~sets_of_closures_map
+        ~closure_id_to_set_of_closures_id
+        ~function_declarations_map
+        ~values:(Compilation_unit.Map.find (Compilenv.current_unit ()) values)
+        ~symbol_id
+        ~root_symbol:(Compilenv.current_unit_symbol ())
+    in
+    let sets_of_closures =
+      function_declarations_map |> Set_of_closures_id.Map.filter_map
+        (fun key (fun_decls : Simple_value_approx.function_declarations) ->
+          if Set_of_closures_id.Set.mem key relevant_set_of_closures then
+            Some fun_decls
+          else if begin
+            Set_of_closures_id.Set.mem key
+              relevant_set_of_closures_declaration_only
+          end then begin
+            if fun_decls.is_classic_mode then
+              Some (Simple_value_approx.clear_function_bodies fun_decls)
+            else
+              Some fun_decls
+          end else begin
+            None
+          end)
+    in
+
+    let values =
+      Compilation_unit.Map.map (fun map ->
+          Export_id.Map.filter (fun key _ ->
+              Export_id.Set.mem key relevant_export_ids)
+            map)
+        values
+    in
+    let symbol_id =
+      Symbol.Map.filter
+        (fun key _ -> Symbol.Set.mem key relevant_symbols)
+        symbol_id
+    in
+    Export_info.create_transient ~values
+      ~symbol_id
+      ~sets_of_closures
+      ~invariant_params
+      ~recursive
+      ~relevant_local_closure_ids
+      ~relevant_imported_closure_ids
+      ~relevant_local_vars_within_closure
+      ~relevant_imported_vars_within_closure
diff --git a/middle_end/flambda/build_export_info.mli b/middle_end/flambda/build_export_info.mli
new file mode 100644
index 00000000..0380604b
--- /dev/null
+++ b/middle_end/flambda/build_export_info.mli
@@ -0,0 +1,25 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Construct export information, for emission into .cmx files, from an
+    Flambda program. *)
+
+val build_transient :
+  backend:(module Backend_intf.S) ->
+  Flambda.program ->
+  Export_info.transient
diff --git a/middle_end/flambda/closure_conversion.ml b/middle_end/flambda/closure_conversion.ml
new file mode 100644
index 00000000..31da98ac
--- /dev/null
+++ b/middle_end/flambda/closure_conversion.ml
@@ -0,0 +1,737 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module Env = Closure_conversion_aux.Env
+module Function_decls = Closure_conversion_aux.Function_decls
+module Function_decl = Function_decls.Function_decl
+module Names = Internal_variable_names
+
+let name_expr = Flambda_utils.name_expr
+let name_expr_from_var = Flambda_utils.name_expr_from_var
+
+type t = {
+  current_unit_id : Ident.t;
+  symbol_for_global' : (Ident.t -> Symbol.t);
+  filename : string;
+  backend : (module Backend_intf.S);
+  mutable imported_symbols : Symbol.Set.t;
+  mutable declared_symbols : (Symbol.t * Flambda.constant_defining_value) list;
+}
+
+let add_default_argument_wrappers lam =
+  let defs_are_all_functions (defs : (_ * Lambda.lambda) list) =
+    List.for_all (function (_, Lambda.Lfunction _) -> true | _ -> false) defs
+  in
+  let f (lam : Lambda.lambda) : Lambda.lambda =
+    match lam with
+    | Llet (( Strict | Alias | StrictOpt), _k, id,
+        Lfunction {kind; params; body = fbody; attr; loc}, body) ->
+      begin match
+        Simplif.split_default_wrapper ~id ~kind ~params
+          ~body:fbody ~return:Pgenval ~attr ~loc
+      with
+      | [fun_id, def] -> Llet (Alias, Pgenval, fun_id, def, body)
+      | [fun_id, def; inner_fun_id, def_inner] ->
+        Llet (Alias, Pgenval, inner_fun_id, def_inner,
+              Llet (Alias, Pgenval, fun_id, def, body))
+      | _ -> assert false
+      end
+    | Lletrec (defs, body) as lam ->
+      if defs_are_all_functions defs then
+        let defs =
+          List.flatten
+            (List.map
+               (function
+                 | (id, Lambda.Lfunction {kind; params; body; attr; loc}) ->
+                   Simplif.split_default_wrapper ~id ~kind ~params ~body
+                     ~return:Pgenval ~attr ~loc
+                 | _ -> assert false)
+               defs)
+        in
+        Lletrec (defs, body)
+      else lam
+    | lam -> lam
+  in
+  Lambda.map f lam
+
+(** Generate a wrapper ("stub") function that accepts a tuple argument and
+    calls another function with arguments extracted in the obvious
+    manner from the tuple. *)
+let tupled_function_call_stub original_params unboxed_version ~closure_bound_var
+      : Flambda.function_declaration =
+  let tuple_param_var = Variable.rename unboxed_version in
+  let params = List.map (fun p -> Variable.rename p) original_params in
+  let call : Flambda.t =
+    Apply ({
+        func = unboxed_version;
+        args = params;
+        (* CR-someday mshinwell for mshinwell: investigate if there is some
+           redundancy here (func is also unboxed_version) *)
+        kind = Direct (Closure_id.wrap unboxed_version);
+        dbg = Debuginfo.none;
+        inline = Default_inline;
+        specialise = Default_specialise;
+      })
+  in
+  let _, body =
+    List.fold_left (fun (pos, body) param ->
+        let lam : Flambda.named =
+          Prim (Pfield pos, [tuple_param_var], Debuginfo.none)
+        in
+        pos + 1, Flambda.create_let param lam body)
+      (0, call) params
+  in
+  let tuple_param = Parameter.wrap tuple_param_var in
+  Flambda.create_function_declaration ~params:[tuple_param]
+    ~body ~stub:true ~dbg:Debuginfo.none ~inline:Default_inline
+    ~specialise:Default_specialise ~is_a_functor:false
+    ~closure_origin:(Closure_origin.create (Closure_id.wrap closure_bound_var))
+
+let register_const t (constant:Flambda.constant_defining_value) name
+    : Flambda.constant_defining_value_block_field * Internal_variable_names.t =
+  let var = Variable.create name in
+  let symbol = Symbol.of_variable var in
+  t.declared_symbols <- (symbol, constant) :: t.declared_symbols;
+  Symbol symbol, name
+
+let rec declare_const t (const : Lambda.structured_constant)
+    : Flambda.constant_defining_value_block_field * Internal_variable_names.t =
+  match const with
+  | Const_base (Const_int c) -> (Const (Int c), Names.const_int)
+  | Const_base (Const_char c) -> (Const (Char c), Names.const_char)
+  | Const_base (Const_string (s, _, _)) ->
+    let const, name =
+      if Config.safe_string then
+        (Flambda.Allocated_const (Immutable_string s),
+         Names.const_immstring)
+      else
+        (Flambda.Allocated_const (String s),
+         Names.const_string)
+    in
+    register_const t const name
+  | Const_base (Const_float c) ->
+    register_const t
+      (Allocated_const (Float (float_of_string c)))
+      Names.const_float
+  | Const_base (Const_int32 c) ->
+    register_const t (Allocated_const (Int32 c))
+      Names.const_int32
+  | Const_base (Const_int64 c) ->
+    register_const t (Allocated_const (Int64 c))
+      Names.const_int64
+  | Const_base (Const_nativeint c) ->
+    register_const t (Allocated_const (Nativeint c)) Names.const_nativeint
+  | Const_pointer c -> Const (Const_pointer c), Names.const_ptr
+  | Const_immstring c ->
+    register_const t (Allocated_const (Immutable_string c))
+      Names.const_immstring
+  | Const_float_array c ->
+    register_const t
+      (Allocated_const (Immutable_float_array (List.map float_of_string c)))
+      Names.const_float_array
+  | Const_block (tag, consts) ->
+    let const : Flambda.constant_defining_value =
+      Block (Tag.create_exn tag,
+             List.map (fun c -> fst (declare_const t c)) consts)
+    in
+    register_const t const Names.const_block
+
+let close_const t (const : Lambda.structured_constant)
+      : Flambda.named * Internal_variable_names.t =
+  match declare_const t const with
+  | Const c, name ->
+    Const c, name
+  | Symbol s, name ->
+    Symbol s, name
+
+let lambda_const_bool b : Lambda.structured_constant =
+  if b then
+    Const_pointer 1
+  else
+    Const_pointer 0
+
+let lambda_const_int i : Lambda.structured_constant =
+  Const_base (Const_int i)
+
+let rec close t env (lam : Lambda.lambda) : Flambda.t =
+  match lam with
+  | Lvar id ->
+    begin match Env.find_var_exn env id with
+    | var -> Var var
+    | exception Not_found ->
+      match Env.find_mutable_var_exn env id with
+      | mut_var ->
+        name_expr (Read_mutable mut_var) ~name:Names.read_mutable
+      | exception Not_found ->
+        Misc.fatal_errorf "Closure_conversion.close: unbound identifier %a"
+          Ident.print id
+    end
+  | Lconst cst ->
+    let cst, name = close_const t cst in
+    name_expr cst ~name
+  | Llet ((Strict | Alias | StrictOpt), _value_kind, id, defining_expr, body) ->
+    (* TODO: keep value_kind in flambda *)
+    let var = Variable.create_with_same_name_as_ident id in
+    let defining_expr =
+      close_let_bound_expression t var env defining_expr
+    in
+    let body = close t (Env.add_var env id var) body in
+    Flambda.create_let var defining_expr body
+  | Llet (Variable, block_kind, id, defining_expr, body) ->
+    let mut_var = Mutable_variable.create_with_same_name_as_ident id in
+    let var = Variable.create_with_same_name_as_ident id in
+    let defining_expr =
+      close_let_bound_expression t var env defining_expr
+    in
+    let body = close t (Env.add_mutable_var env id mut_var) body in
+    Flambda.create_let var defining_expr
+      (Let_mutable
+         { var = mut_var;
+           initial_value = var;
+           body;
+           contents_kind = block_kind })
+  | Lfunction { kind; params; body; attr; loc; } ->
+    let name = Names.anon_fn_with_loc loc in
+    let closure_bound_var = Variable.create name in
+    (* CR-soon mshinwell: some of this is now very similar to the let rec case
+       below *)
+    let set_of_closures_var = Variable.create Names.set_of_closures in
+    let set_of_closures =
+      let decl =
+        Function_decl.create ~let_rec_ident:None ~closure_bound_var ~kind
+          ~params:(List.map fst params) ~body ~attr ~loc
+      in
+      close_functions t env (Function_decls.create [decl])
+    in
+    let project_closure : Flambda.project_closure =
+      { set_of_closures = set_of_closures_var;
+        closure_id = Closure_id.wrap closure_bound_var;
+      }
+    in
+    Flambda.create_let set_of_closures_var set_of_closures
+      (name_expr (Project_closure (project_closure)) ~name)
+  | Lapply { ap_func; ap_args; ap_loc; ap_should_be_tailcall = _;
+        ap_inlined; ap_specialised; } ->
+    Lift_code.lifting_helper (close_list t env ap_args)
+      ~evaluation_order:`Right_to_left
+      ~name:Names.apply_arg
+      ~create_body:(fun args ->
+        let func = close t env ap_func in
+        let func_var = Variable.create Names.apply_funct in
+        Flambda.create_let func_var (Expr func)
+          (Apply ({
+              func = func_var;
+              args;
+              kind = Indirect;
+              dbg = Debuginfo.from_location ap_loc;
+              inline = ap_inlined;
+              specialise = ap_specialised;
+            })))
+  | Lletrec (defs, body) ->
+    let env =
+      List.fold_right (fun (id,  _) env ->
+          Env.add_var env id (Variable.create_with_same_name_as_ident id))
+        defs env
+    in
+    let function_declarations =
+      (* Identify any bindings in the [let rec] that are functions.  These
+         will be named after the corresponding identifier in the [let rec]. *)
+      List.map (function
+          | (let_rec_ident,
+             Lambda.Lfunction { kind; params; body; attr; loc }) ->
+            let closure_bound_var =
+              Variable.create_with_same_name_as_ident let_rec_ident
+            in
+            let function_declaration =
+              Function_decl.create ~let_rec_ident:(Some let_rec_ident)
+                ~closure_bound_var ~kind ~params:(List.map fst params) ~body
+                ~attr ~loc
+            in
+            Some function_declaration
+          | _ -> None)
+        defs
+    in
+    begin match
+      Misc.Stdlib.List.some_if_all_elements_are_some function_declarations
+    with
+    | Some function_declarations ->
+      (* When all the bindings are (syntactically) functions, we can
+         eliminate the [let rec] construction, instead producing a normal
+         [Let] that binds a set of closures containing all of the functions.
+      *)
+      (* CR-someday lwhite: This is a very syntactic criteria. Adding an
+         unused value to a set of recursive bindings changes how
+         functions are represented at runtime. *)
+      let set_of_closures_var = Variable.create (Names.set_of_closures) in
+      let set_of_closures =
+        close_functions t env (Function_decls.create function_declarations)
+      in
+      let body =
+        List.fold_left (fun body decl ->
+            let let_rec_ident = Function_decl.let_rec_ident decl in
+            let closure_bound_var = Function_decl.closure_bound_var decl in
+            let let_bound_var = Env.find_var env let_rec_ident in
+            (* Inside the body of the [let], each function is referred to by
+               a [Project_closure] expression, which projects from the set of
+               closures. *)
+            (Flambda.create_let let_bound_var
+              (Project_closure {
+                set_of_closures = set_of_closures_var;
+                closure_id = Closure_id.wrap closure_bound_var;
+              })
+              body))
+          (close t env body) function_declarations
+      in
+      Flambda.create_let set_of_closures_var set_of_closures body
+    | None ->
+      (* If the condition above is not satisfied, we build a [Let_rec]
+         expression; any functions bound by it will have their own
+         individual closures. *)
+      let defs =
+        List.map (fun (id, def) ->
+            let var = Env.find_var env id in
+            var, close_let_bound_expression t ~let_rec_ident:id var env def)
+          defs
+      in
+      Let_rec (defs, close t env body)
+    end
+  | Lsend (kind, meth, obj, args, loc) ->
+    let meth_var = Variable.create Names.meth in
+    let obj_var = Variable.create Names.obj in
+    let dbg = Debuginfo.from_location loc in
+    Flambda.create_let meth_var (Expr (close t env meth))
+      (Flambda.create_let obj_var (Expr (close t env obj))
+        (Lift_code.lifting_helper (close_list t env args)
+          ~evaluation_order:`Right_to_left
+          ~name:Names.send_arg
+          ~create_body:(fun args ->
+              Send { kind; meth = meth_var; obj = obj_var; args; dbg; })))
+  | Lprim ((Pdivint Safe | Pmodint Safe
+           | Pdivbint { is_safe = Safe } | Pmodbint { is_safe = Safe }) as prim,
+           [arg1; arg2], loc)
+      when not !Clflags.unsafe ->
+    let arg2 = close t env arg2 in
+    let arg1 = close t env arg1 in
+    let numerator = Variable.create Names.numerator in
+    let denominator = Variable.create Names.denominator in
+    let zero = Variable.create Names.zero in
+    let is_zero = Variable.create Names.is_zero in
+    let exn = Variable.create Names.division_by_zero in
+    let exn_symbol =
+      t.symbol_for_global' Predef.ident_division_by_zero
+    in
+    let dbg = Debuginfo.from_location loc in
+    let zero_const : Flambda.named =
+      match prim with
+      | Pdivint _ | Pmodint _ ->
+        Const (Int 0)
+      | Pdivbint { size = Pint32 } | Pmodbint { size = Pint32 } ->
+        Allocated_const (Int32 0l)
+      | Pdivbint { size = Pint64 } | Pmodbint { size = Pint64 } ->
+        Allocated_const (Int64 0L)
+      | Pdivbint { size = Pnativeint } | Pmodbint { size = Pnativeint } ->
+        Allocated_const (Nativeint 0n)
+      | _ -> assert false
+    in
+    let prim : Clambda_primitives.primitive =
+      match prim with
+      | Pdivint _ -> Pdivint Unsafe
+      | Pmodint _ -> Pmodint Unsafe
+      | Pdivbint { size } -> Pdivbint { size; is_safe = Unsafe }
+      | Pmodbint { size } -> Pmodbint { size; is_safe = Unsafe }
+      | _ -> assert false
+    in
+    let comparison : Clambda_primitives.primitive =
+      match prim with
+      | Pdivint _ | Pmodint _ -> Pintcomp Ceq
+      | Pdivbint { size } | Pmodbint { size } -> Pbintcomp (size,Ceq)
+      | _ -> assert false
+    in
+    t.imported_symbols <- Symbol.Set.add exn_symbol t.imported_symbols;
+    Flambda.create_let zero zero_const
+      (Flambda.create_let exn (Symbol exn_symbol)
+        (Flambda.create_let denominator (Expr arg2)
+          (Flambda.create_let numerator (Expr arg1)
+            (Flambda.create_let is_zero
+              (Prim (comparison, [zero; denominator], dbg))
+                (If_then_else (is_zero,
+                  name_expr (Prim (Praise Raise_regular, [exn], dbg))
+                    ~name:Names.dummy,
+                  (* CR-someday pchambart: find the right event.
+                     mshinwell: I briefly looked at this, and couldn't
+                     figure it out.
+                     lwhite: I don't think any of the existing events
+                     are suitable. I had to add a new one for a similar
+                     case in the array data types work.
+                     mshinwell: deferred CR *)
+                  name_expr ~name:Names.result
+                    (Prim (prim, [numerator; denominator], dbg))))))))
+  | Lprim ((Pdivint Safe | Pmodint Safe
+           | Pdivbint { is_safe = Safe } | Pmodbint { is_safe = Safe }), _, _)
+      when not !Clflags.unsafe ->
+    Misc.fatal_error "Pdivint / Pmodint must have exactly two arguments"
+  | Lprim (Psequor, [arg1; arg2], _) ->
+    let arg1 = close t env arg1 in
+    let arg2 = close t env arg2 in
+    let const_true = Variable.create Names.const_true in
+    let cond = Variable.create Names.cond_sequor in
+    Flambda.create_let const_true (Const (Const_pointer 1))
+      (Flambda.create_let cond (Expr arg1)
+        (If_then_else (cond, Var const_true, arg2)))
+  | Lprim (Psequand, [arg1; arg2], _) ->
+    let arg1 = close t env arg1 in
+    let arg2 = close t env arg2 in
+    let const_false = Variable.create Names.const_false in
+    let cond = Variable.create Names.const_sequand in
+    Flambda.create_let const_false (Const (Const_pointer 0))
+      (Flambda.create_let cond (Expr arg1)
+        (If_then_else (cond, arg2, Var const_false)))
+  | Lprim ((Psequand | Psequor), _, _) ->
+    Misc.fatal_error "Psequand / Psequor must have exactly two arguments"
+  | Lprim ((Pidentity | Pbytes_to_string | Pbytes_of_string), [arg], _) ->
+    close t env arg
+  | Lprim (Pignore, [arg], _) ->
+    let var = Variable.create Names.ignore in
+    let defining_expr =
+      close_let_bound_expression t var env arg
+    in
+    Flambda.create_let var defining_expr
+      (name_expr (Const (Const_pointer 0)) ~name:Names.unit)
+  | Lprim (Pdirapply, [funct; arg], loc)
+  | Lprim (Prevapply, [arg; funct], loc) ->
+    let apply : Lambda.lambda_apply =
+      { ap_func = funct;
+        ap_args = [arg];
+        ap_loc = loc;
+        ap_should_be_tailcall = false;
+        (* CR-someday lwhite: it would be nice to be able to give
+           inlined attributes to functions applied with the application
+           operators. *)
+        ap_inlined = Default_inline;
+        ap_specialised = Default_specialise;
+      }
+    in
+    close t env (Lambda.Lapply apply)
+  | Lprim (Praise kind, [arg], loc) ->
+    let arg_var = Variable.create Names.raise_arg in
+    let dbg = Debuginfo.from_location loc in
+    Flambda.create_let arg_var (Expr (close t env arg))
+      (name_expr
+        (Prim (Praise kind, [arg_var], dbg))
+        ~name:Names.raise)
+  | Lprim (Pctconst c, [arg], _loc) ->
+      let module Backend = (val t.backend) in
+      let const =
+        begin match c with
+        | Big_endian -> lambda_const_bool Backend.big_endian
+        | Word_size -> lambda_const_int (8*Backend.size_int)
+        | Int_size -> lambda_const_int (8*Backend.size_int - 1)
+        | Max_wosize ->
+            lambda_const_int ((1 lsl ((8*Backend.size_int) - 10)) - 1)
+        | Ostype_unix -> lambda_const_bool (String.equal Sys.os_type "Unix")
+        | Ostype_win32 -> lambda_const_bool (String.equal Sys.os_type "Win32")
+        | Ostype_cygwin -> lambda_const_bool (String.equal Sys.os_type "Cygwin")
+        | Backend_type ->
+            Lambda.Const_pointer 0 (* tag 0 is the same as Native *)
+        end
+      in
+      close t env
+        (Lambda.Llet(Strict, Pgenval, Ident.create_local "dummy",
+                     arg, Lconst const))
+  | Lprim (Pfield _, [Lprim (Pgetglobal id, [],_)], _)
+      when Ident.same id t.current_unit_id ->
+    Misc.fatal_errorf "[Pfield (Pgetglobal ...)] for the current compilation \
+        unit is forbidden upon entry to the middle end"
+  | Lprim (Psetfield (_, _, _), [Lprim (Pgetglobal _, [], _); _], _) ->
+    Misc.fatal_errorf "[Psetfield (Pgetglobal ...)] is \
+        forbidden upon entry to the middle end"
+  | Lprim (Pgetglobal id, [], _) when Ident.is_predef id ->
+    let symbol = t.symbol_for_global' id in
+    t.imported_symbols <- Symbol.Set.add symbol t.imported_symbols;
+    name_expr (Symbol symbol) ~name:Names.predef_exn
+  | Lprim (Pgetglobal id, [], _) ->
+    assert (not (Ident.same id t.current_unit_id));
+    let symbol = t.symbol_for_global' id in
+    t.imported_symbols <- Symbol.Set.add symbol t.imported_symbols;
+    name_expr (Symbol symbol) ~name:Names.pgetglobal
+  | Lprim (lambda_p, args, loc) ->
+    (* One of the important consequences of the ANF-like representation
+       here is that we obtain names corresponding to the components of
+       blocks being made (with [Pmakeblock]).  This information can be used
+       by the simplification pass to increase the likelihood of eliminating
+       the allocation, since some field accesses can be tracked back to known
+       field values. *)
+    let dbg = Debuginfo.from_location loc in
+    let p = Convert_primitives.convert lambda_p in
+    Lift_code.lifting_helper (close_list t env args)
+      ~evaluation_order:`Right_to_left
+      ~name:(Names.of_primitive_arg lambda_p)
+      ~create_body:(fun args ->
+        name_expr (Prim (p, args, dbg))
+          ~name:(Names.of_primitive lambda_p))
+  | Lswitch (arg, sw, _loc) ->
+    let scrutinee = Variable.create Names.switch in
+    let aux (i, lam) = i, close t env lam in
+    let nums sw_num cases default =
+      let module I = Numbers.Int in
+      match default with
+      | Some _ ->
+          I.zero_to_n (sw_num - 1)
+      | None ->
+          List.fold_left (fun set (i, _) -> I.Set.add i set) I.Set.empty cases
+    in
+    Flambda.create_let scrutinee (Expr (close t env arg))
+      (Switch (scrutinee,
+        { numconsts = nums sw.sw_numconsts sw.sw_consts sw.sw_failaction;
+          consts = List.map aux sw.sw_consts;
+          numblocks = nums sw.sw_numblocks sw.sw_blocks sw.sw_failaction;
+          blocks = List.map aux sw.sw_blocks;
+          failaction = Option.map (close t env) sw.sw_failaction;
+        }))
+  | Lstringswitch (arg, sw, def, _) ->
+    let scrutinee = Variable.create Names.string_switch in
+    Flambda.create_let scrutinee (Expr (close t env arg))
+      (String_switch (scrutinee,
+        List.map (fun (s, e) -> s, close t env e) sw,
+        Option.map (close t env) def))
+  | Lstaticraise (i, args) ->
+    Lift_code.lifting_helper (close_list t env args)
+      ~evaluation_order:`Right_to_left
+      ~name:Names.staticraise_arg
+      ~create_body:(fun args ->
+        let static_exn = Env.find_static_exception env i in
+        Static_raise (static_exn, args))
+  | Lstaticcatch (body, (i, ids), handler) ->
+    let st_exn = Static_exception.create () in
+    let env = Env.add_static_exception env i st_exn in
+    let ids = List.map fst ids in
+    let vars = List.map Variable.create_with_same_name_as_ident ids in
+    Static_catch (st_exn, vars, close t env body,
+      close t (Env.add_vars env ids vars) handler)
+  | Ltrywith (body, id, handler) ->
+    let var = Variable.create_with_same_name_as_ident id in
+    Try_with (close t env body, var, close t (Env.add_var env id var) handler)
+  | Lifthenelse (cond, ifso, ifnot) ->
+    let cond = close t env cond in
+    let cond_var = Variable.create Names.cond in
+    Flambda.create_let cond_var (Expr cond)
+      (If_then_else (cond_var, close t env ifso, close t env ifnot))
+  | Lsequence (lam1, lam2) ->
+    let var = Variable.create Names.sequence in
+    let lam1 = Flambda.Expr (close t env lam1) in
+    let lam2 = close t env lam2 in
+    Flambda.create_let var lam1 lam2
+  | Lwhile (cond, body) -> While (close t env cond, close t env body)
+  | Lfor (id, lo, hi, direction, body) ->
+    let bound_var = Variable.create_with_same_name_as_ident id in
+    let from_value = Variable.create Names.for_from in
+    let to_value = Variable.create Names.for_to in
+    let body = close t (Env.add_var env id bound_var) body in
+    Flambda.create_let from_value (Expr (close t env lo))
+      (Flambda.create_let to_value (Expr (close t env hi))
+        (For { bound_var; from_value; to_value; direction; body; }))
+  | Lassign (id, new_value) ->
+    let being_assigned =
+      match Env.find_mutable_var_exn env id with
+      | being_assigned -> being_assigned
+      | exception Not_found ->
+        Misc.fatal_errorf "Closure_conversion.close: unbound mutable \
+            variable %s in assignment"
+          (Ident.unique_name id)
+    in
+    let new_value_var = Variable.create Names.new_value in
+    Flambda.create_let new_value_var (Expr (close t env new_value))
+      (Assign { being_assigned; new_value = new_value_var; })
+  | Levent (lam, _) -> close t env lam
+  | Lifused _ ->
+    (* [Lifused] is used to mark that this expression should be alive only if
+       an identifier is.  Every use should have been removed by
+       [Simplif.simplify_lets], either by replacing by the inner expression,
+       or by completely removing it (replacing by unit). *)
+    Misc.fatal_error "[Lifused] should have been removed by \
+        [Simplif.simplify_lets]"
+
+(** Perform closure conversion on a set of function declarations, returning a
+    set of closures.  (The set will often only contain a single function;
+    the only case where it cannot is for "let rec".) *)
+and close_functions t external_env function_declarations : Flambda.named =
+  let closure_env_without_parameters =
+    Function_decls.closure_env_without_parameters
+      external_env function_declarations
+  in
+  let all_free_idents = Function_decls.all_free_idents function_declarations in
+  let close_one_function map decl =
+    let body = Function_decl.body decl in
+    let loc = Function_decl.loc decl in
+    let dbg = Debuginfo.from_location loc in
+    let params = Function_decl.params decl in
+    (* Create fresh variables for the elements of the closure (cf.
+       the comment on [Function_decl.closure_env_without_parameters], above).
+       This induces a renaming on [Function_decl.free_idents]; the results of
+       that renaming are stored in [free_variables]. *)
+    let closure_env =
+      List.fold_right (fun id env ->
+          Env.add_var env id (Variable.create_with_same_name_as_ident id))
+        params closure_env_without_parameters
+    in
+    (* If the function is the wrapper for a function with an optional
+       argument with a default value, make sure it always gets inlined.
+       CR-someday pchambart: eta-expansion wrapper for a primitive are
+       not marked as stub but certainly should *)
+    let stub = Function_decl.stub decl in
+    let param_vars = List.map (Env.find_var closure_env) params in
+    let params = List.map Parameter.wrap param_vars in
+    let closure_bound_var = Function_decl.closure_bound_var decl in
+    let unboxed_version = Variable.rename closure_bound_var in
+    let body = close t closure_env body in
+    let closure_origin =
+      Closure_origin.create (Closure_id.wrap unboxed_version)
+    in
+    let fun_decl =
+      Flambda.create_function_declaration ~params ~body ~stub ~dbg
+        ~inline:(Function_decl.inline decl)
+        ~specialise:(Function_decl.specialise decl)
+        ~is_a_functor:(Function_decl.is_a_functor decl)
+        ~closure_origin
+    in
+    match Function_decl.kind decl with
+    | Curried -> Variable.Map.add closure_bound_var fun_decl map
+    | Tupled ->
+      let unboxed_version = Variable.rename closure_bound_var in
+      let generic_function_stub =
+        tupled_function_call_stub param_vars unboxed_version ~closure_bound_var
+      in
+      Variable.Map.add unboxed_version fun_decl
+        (Variable.Map.add closure_bound_var generic_function_stub map)
+  in
+  let function_decls =
+    let is_classic_mode = !Clflags.classic_inlining in
+    let funs =
+      List.fold_left close_one_function Variable.Map.empty
+        (Function_decls.to_list function_declarations)
+    in
+    Flambda.create_function_declarations ~is_classic_mode ~funs
+  in
+  (* The closed representation of a set of functions is a "set of closures".
+     (For avoidance of doubt, the runtime representation of the *whole set* is
+     a single block with tag [Closure_tag].) *)
+  let set_of_closures =
+    let free_vars =
+      Ident.Set.fold (fun var map ->
+          let internal_var =
+            Env.find_var closure_env_without_parameters var
+          in
+          let external_var : Flambda.specialised_to =
+            { var = Env.find_var external_env var;
+              projection = None;
+            }
+          in
+          Variable.Map.add internal_var external_var map)
+        all_free_idents Variable.Map.empty
+    in
+    Flambda.create_set_of_closures ~function_decls ~free_vars
+      ~specialised_args:Variable.Map.empty
+      ~direct_call_surrogates:Variable.Map.empty
+  in
+  Set_of_closures set_of_closures
+
+and close_list t sb l = List.map (close t sb) l
+
+and close_let_bound_expression t ?let_rec_ident let_bound_var env
+      (lam : Lambda.lambda) : Flambda.named =
+  match lam with
+  | Lfunction { kind; params; body; attr; loc; } ->
+    (* Ensure that [let] and [let rec]-bound functions have appropriate
+       names. *)
+    let closure_bound_var = Variable.rename let_bound_var in
+    let decl =
+      Function_decl.create ~let_rec_ident ~closure_bound_var ~kind
+        ~params:(List.map fst params) ~body ~attr ~loc
+    in
+    let set_of_closures_var = Variable.rename let_bound_var in
+    let set_of_closures =
+      close_functions t env (Function_decls.create [decl])
+    in
+    let project_closure : Flambda.project_closure =
+      { set_of_closures = set_of_closures_var;
+        closure_id = Closure_id.wrap closure_bound_var;
+      }
+    in
+    Expr (Flambda.create_let set_of_closures_var set_of_closures
+      (name_expr_from_var (Project_closure (project_closure))
+        ~var:let_bound_var))
+  | lam -> Expr (close t env lam)
+
+let lambda_to_flambda ~backend ~module_ident ~size ~filename lam
+      : Flambda.program =
+  let lam = add_default_argument_wrappers lam in
+  let module Backend = (val backend : Backend_intf.S) in
+  let compilation_unit = Compilation_unit.get_current_exn () in
+  let t =
+    { current_unit_id = Compilation_unit.get_persistent_ident compilation_unit;
+      symbol_for_global' = Backend.symbol_for_global';
+      filename;
+      backend;
+      imported_symbols = Symbol.Set.empty;
+      declared_symbols = [];
+    }
+  in
+  let module_symbol = Backend.symbol_for_global' module_ident in
+  let block_symbol =
+    let var = Variable.create Internal_variable_names.module_as_block in
+    Symbol.of_variable var
+  in
+  (* The global module block is built by accessing the fields of all the
+     introduced symbols. *)
+  (* CR-soon mshinwell for mshinwell: Add a comment describing how modules are
+     compiled. *)
+  let fields =
+    Array.init size (fun pos ->
+      let sym_v = Variable.create Names.block_symbol in
+      let result_v = Variable.create Names.block_symbol_get in
+      let value_v = Variable.create Names.block_symbol_get_field in
+      Flambda.create_let
+        sym_v (Symbol block_symbol)
+         (Flambda.create_let result_v
+            (Prim (Pfield 0, [sym_v], Debuginfo.none))
+            (Flambda.create_let value_v
+              (Prim (Pfield pos, [result_v], Debuginfo.none))
+              (Var value_v))))
+  in
+  let module_initializer : Flambda.program_body =
+    Initialize_symbol (
+      block_symbol,
+      Tag.create_exn 0,
+      [close t Env.empty lam],
+      Initialize_symbol (
+        module_symbol,
+        Tag.create_exn 0,
+        Array.to_list fields,
+        End module_symbol))
+  in
+  let program_body =
+    List.fold_left
+      (fun program_body (symbol, constant) : Flambda.program_body ->
+         Let_symbol (symbol, constant, program_body))
+      module_initializer
+      t.declared_symbols
+  in
+  { imported_symbols = t.imported_symbols;
+    program_body;
+  }
diff --git a/middle_end/flambda/closure_conversion.mli b/middle_end/flambda/closure_conversion.mli
new file mode 100644
index 00000000..f5fab0a7
--- /dev/null
+++ b/middle_end/flambda/closure_conversion.mli
@@ -0,0 +1,53 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Generation of [Flambda] intermediate language code from [Lambda] code
+  by performing a form of closure conversion.
+
+  Function declarations (which may bind one or more variables identifying
+  functions, possibly with mutual recursion) are transformed to
+  [Set_of_closures] expressions.  [Project_closure] expressions are then
+  used to select a closure for a particular function from a [Set_of_closures]
+  expression.  The [Set_of_closures] expressions say nothing about the
+  actual runtime layout of the closures; this is handled when [Flambda] code
+  is translated to [Clambda] code.
+
+  The following transformations are also performed during closure
+  conversion:
+  - Constant blocks (by which is meant things wrapped in [Lambda.Const_block])
+    are converted to applications of the [Pmakeblock] primitive.
+  - [Levent] debugging event nodes are removed and the information within
+    them attached to function, method and [raise] calls.
+  - Tuplified functions are converted to curried functions and a stub
+    function emitted to call the curried version.  For example:
+      let rec f (x, y) = f (x + 1, y + 1)
+    is transformed to:
+      let rec internal_f x y = f (x + 1,y + 1)
+      and f (x, y) = internal_f x y  (* [f] is marked as a stub function *)
+  - The [Pdirapply] and [Prevapply] application primitives are removed and
+    converted to normal [Flambda] application nodes.
+
+  The [lambda_to_flambda] function is not re-entrant.
+*)
+val lambda_to_flambda
+   : backend:(module Backend_intf.S)
+  -> module_ident:Ident.t
+  -> size:int
+  -> filename:string
+  -> Lambda.lambda
+  -> Flambda.program
diff --git a/middle_end/flambda/closure_conversion_aux.ml b/middle_end/flambda/closure_conversion_aux.ml
new file mode 100644
index 00000000..38566c30
--- /dev/null
+++ b/middle_end/flambda/closure_conversion_aux.ml
@@ -0,0 +1,184 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module Env = struct
+  type t = {
+    variables : Variable.t Ident.tbl;
+    mutable_variables : Mutable_variable.t Ident.tbl;
+    static_exceptions : Static_exception.t Numbers.Int.Map.t;
+    globals : Symbol.t Numbers.Int.Map.t;
+    at_toplevel : bool;
+  }
+
+  let empty = {
+    variables = Ident.empty;
+    mutable_variables = Ident.empty;
+    static_exceptions = Numbers.Int.Map.empty;
+    globals = Numbers.Int.Map.empty;
+    at_toplevel = true;
+  }
+
+  let clear_local_bindings env =
+    { empty with globals = env.globals }
+
+  let add_var t id var = { t with variables = Ident.add id var t.variables }
+  let add_vars t ids vars = List.fold_left2 add_var t ids vars
+
+  let find_var t id =
+    try Ident.find_same id t.variables
+    with Not_found ->
+      Misc.fatal_errorf "Closure_conversion.Env.find_var: %s@ %s"
+        (Ident.unique_name id)
+        (Printexc.raw_backtrace_to_string (Printexc.get_callstack 42))
+
+  let find_var_exn t id =
+    Ident.find_same id t.variables
+
+  let add_mutable_var t id mutable_var =
+    { t with mutable_variables = Ident.add id mutable_var t.mutable_variables }
+
+  let find_mutable_var_exn t id =
+    Ident.find_same id t.mutable_variables
+
+  let add_static_exception t st_exn fresh_st_exn =
+    { t with
+      static_exceptions =
+        Numbers.Int.Map.add st_exn fresh_st_exn t.static_exceptions }
+
+  let find_static_exception t st_exn =
+    try Numbers.Int.Map.find st_exn t.static_exceptions
+    with Not_found ->
+      Misc.fatal_error ("Closure_conversion.Env.find_static_exception: exn "
+        ^ Int.to_string st_exn)
+
+  let add_global t pos symbol =
+    { t with globals = Numbers.Int.Map.add pos symbol t.globals }
+
+  let find_global t pos =
+    try Numbers.Int.Map.find pos t.globals
+    with Not_found ->
+      Misc.fatal_error ("Closure_conversion.Env.find_global: global "
+        ^ Int.to_string pos)
+
+  let at_toplevel t = t.at_toplevel
+
+  let not_at_toplevel t = { t with at_toplevel = false; }
+end
+
+module Function_decls = struct
+  module Function_decl = struct
+    type t = {
+      let_rec_ident : Ident.t;
+      closure_bound_var : Variable.t;
+      kind : Lambda.function_kind;
+      params : Ident.t list;
+      body : Lambda.lambda;
+      free_idents_of_body : Ident.Set.t;
+      attr : Lambda.function_attribute;
+      loc : Lambda.scoped_location
+    }
+
+    let create ~let_rec_ident ~closure_bound_var ~kind ~params ~body
+        ~attr ~loc =
+      let let_rec_ident =
+        match let_rec_ident with
+        | None -> Ident.create_local "unnamed_function"
+        | Some let_rec_ident -> let_rec_ident
+      in
+      { let_rec_ident;
+        closure_bound_var;
+        kind;
+        params;
+        body;
+        free_idents_of_body = Lambda.free_variables body;
+        attr;
+        loc;
+      }
+
+    let let_rec_ident t = t.let_rec_ident
+    let closure_bound_var t = t.closure_bound_var
+    let kind t = t.kind
+    let params t = t.params
+    let body t = t.body
+    let free_idents t = t.free_idents_of_body
+    let inline t = t.attr.inline
+    let specialise t = t.attr.specialise
+    let is_a_functor t = t.attr.is_a_functor
+    let stub t = t.attr.stub
+    let loc t = t.loc
+
+  end
+
+  type t = {
+    function_decls : Function_decl.t list;
+    all_free_idents : Ident.Set.t;
+  }
+
+  (* All identifiers free in the bodies of the given function declarations,
+     indexed by the identifiers corresponding to the functions themselves. *)
+  let free_idents_by_function function_decls =
+    List.fold_right (fun decl map ->
+        Variable.Map.add (Function_decl.closure_bound_var decl)
+          (Function_decl.free_idents decl) map)
+      function_decls Variable.Map.empty
+
+  let all_free_idents function_decls =
+    Variable.Map.fold (fun _ -> Ident.Set.union)
+      (free_idents_by_function function_decls) Ident.Set.empty
+
+  (* All identifiers of simultaneously-defined functions in [ts]. *)
+  let let_rec_idents function_decls =
+    List.map Function_decl.let_rec_ident function_decls
+
+  (* All parameters of functions in [ts]. *)
+  let all_params function_decls =
+    List.concat (List.map Function_decl.params function_decls)
+
+  let set_diff (from : Ident.Set.t) (idents : Ident.t list) =
+    List.fold_right Ident.Set.remove idents from
+
+  (* CR-someday lwhite: use a different name from above or explain the
+     difference *)
+  let all_free_idents function_decls =
+    set_diff (set_diff (all_free_idents function_decls)
+        (all_params function_decls))
+      (let_rec_idents function_decls)
+
+  let create function_decls =
+    { function_decls;
+      all_free_idents = all_free_idents function_decls;
+    }
+
+  let to_list t = t.function_decls
+
+  let all_free_idents t = t.all_free_idents
+
+  let closure_env_without_parameters external_env t =
+    let closure_env =
+      (* For "let rec"-bound functions. *)
+      List.fold_right (fun function_decl env ->
+          Env.add_var env (Function_decl.let_rec_ident function_decl)
+            (Function_decl.closure_bound_var function_decl))
+        t.function_decls (Env.clear_local_bindings external_env)
+    in
+    (* For free variables. *)
+    Ident.Set.fold (fun id env ->
+        Env.add_var env id (Variable.create_with_same_name_as_ident id))
+      t.all_free_idents closure_env
+end
diff --git a/middle_end/flambda/closure_conversion_aux.mli b/middle_end/flambda/closure_conversion_aux.mli
new file mode 100644
index 00000000..633292ec
--- /dev/null
+++ b/middle_end/flambda/closure_conversion_aux.mli
@@ -0,0 +1,94 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Environments and auxiliary structures used during closure conversion. *)
+
+(** Used to remember which [Variable.t] values correspond to which
+    [Ident.t] values during closure conversion, and similarly for
+     static exception identifiers. *)
+module Env : sig
+  type t
+
+  val empty : t
+
+  val add_var : t -> Ident.t -> Variable.t -> t
+  val add_vars : t -> Ident.t list -> Variable.t list -> t
+
+  val find_var : t -> Ident.t -> Variable.t
+  val find_var_exn : t -> Ident.t -> Variable.t
+
+  val add_mutable_var : t -> Ident.t -> Mutable_variable.t -> t
+  val find_mutable_var_exn : t -> Ident.t -> Mutable_variable.t
+
+  val add_static_exception : t -> int -> Static_exception.t -> t
+  val find_static_exception : t -> int -> Static_exception.t
+
+  val add_global : t -> int -> Symbol.t -> t
+  val find_global : t -> int -> Symbol.t
+
+  val at_toplevel : t -> bool
+  val not_at_toplevel : t -> t
+end
+
+(** Used to represent information about a set of function declarations
+    during closure conversion.  (The only case in which such a set may
+    contain more than one declaration is when processing "let rec".) *)
+module Function_decls : sig
+  module Function_decl : sig
+    type t
+
+    val create
+       : let_rec_ident:Ident.t option
+      -> closure_bound_var:Variable.t
+      -> kind:Lambda.function_kind
+      -> params:Ident.t list
+      -> body:Lambda.lambda
+      -> attr:Lambda.function_attribute
+      -> loc:Lambda.scoped_location
+      -> t
+
+    val let_rec_ident : t -> Ident.t
+    val closure_bound_var : t -> Variable.t
+    val kind : t -> Lambda.function_kind
+    val params : t -> Ident.t list
+    val body : t -> Lambda.lambda
+    val inline : t -> Lambda.inline_attribute
+    val specialise : t -> Lambda.specialise_attribute
+    val is_a_functor : t -> bool
+    val stub : t -> bool
+    val loc : t -> Lambda.scoped_location
+
+    (* Like [all_free_idents], but for just one function. *)
+    val free_idents : t -> Ident.Set.t
+  end
+
+  type t
+
+  val create : Function_decl.t list -> t
+  val to_list : t -> Function_decl.t list
+
+  (* All identifiers free in the given function declarations after the binding
+     of parameters and function identifiers has been performed. *)
+  val all_free_idents : t -> Ident.Set.t
+
+  (* A map from identifiers to their corresponding [Variable.t]s whose domain
+     is the set of all identifiers free in the bodies of the declarations that
+     are not bound as parameters.
+     It also contains the globals bindings of the provided environment. *)
+  val closure_env_without_parameters : Env.t -> t -> Env.t
+end
diff --git a/middle_end/flambda/closure_offsets.ml b/middle_end/flambda/closure_offsets.ml
new file mode 100644
index 00000000..51a09f02
--- /dev/null
+++ b/middle_end/flambda/closure_offsets.ml
@@ -0,0 +1,89 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+type result = {
+  function_offsets : int Closure_id.Map.t;
+  free_variable_offsets : int Var_within_closure.Map.t;
+}
+
+let add_closure_offsets
+      { function_offsets; free_variable_offsets }
+      ({ function_decls; free_vars } : Flambda.set_of_closures) =
+  (* Build the table mapping the functions declared by the set of closures
+     to the positions of their individual "infix" closures inside the runtime
+     closure block.  (All of the environment entries will come afterwards.) *)
+  let assign_function_offset id function_decl (map, env_pos) =
+    let pos = env_pos + 1 in
+    let env_pos =
+      let arity = Flambda_utils.function_arity function_decl in
+      env_pos
+        + 1  (* GC header; either [Closure_tag] or [Infix_tag] *)
+        + 1  (* full application code pointer *)
+        + 1  (* arity *)
+        + (if arity > 1 then 1 else 0)  (* partial application code pointer *)
+    in
+    let closure_id = Closure_id.wrap id in
+    if Closure_id.Map.mem closure_id map then begin
+      Misc.fatal_errorf "Closure_offsets.add_closure_offsets: function \
+          offset for %a would be defined multiple times"
+        Closure_id.print closure_id
+    end;
+    let map = Closure_id.Map.add closure_id pos map in
+    (map, env_pos)
+  in
+  let function_offsets, free_variable_pos =
+    Variable.Map.fold assign_function_offset
+      function_decls.funs (function_offsets, -1)
+  in
+  (* Adds the mapping of free variables to their offset.  Recall that
+     projections of [Var_within_closure]s are only currently used when
+     compiling accesses to the closure of a function from outside that
+     function (in particular, as a result of inlining).  Accesses to
+     a function's own closure are compiled directly via normal [Var]
+     accesses. *)
+  (* CR-someday mshinwell: As discussed with lwhite, maybe this isn't
+     ideal, and the self accesses should be explicitly marked too. *)
+  let assign_free_variable_offset var _ (map, pos) =
+    let var_within_closure = Var_within_closure.wrap var in
+    if Var_within_closure.Map.mem var_within_closure map then begin
+      Misc.fatal_errorf "Closure_offsets.add_closure_offsets: free variable \
+          offset for %a would be defined multiple times"
+        Var_within_closure.print var_within_closure
+    end;
+    let map = Var_within_closure.Map.add var_within_closure pos map in
+    (map, pos + 1)
+  in
+  let free_variable_offsets, _ =
+    Variable.Map.fold assign_free_variable_offset
+      free_vars (free_variable_offsets, free_variable_pos)
+  in
+  { function_offsets;
+    free_variable_offsets;
+  }
+
+let compute (program:Flambda.program) =
+  let init : result =
+    { function_offsets = Closure_id.Map.empty;
+      free_variable_offsets = Var_within_closure.Map.empty;
+    }
+  in
+  let r =
+    List.fold_left add_closure_offsets
+      init (Flambda_utils.all_sets_of_closures program)
+  in
+  r
diff --git a/middle_end/flambda/closure_offsets.mli b/middle_end/flambda/closure_offsets.mli
new file mode 100644
index 00000000..7ecf9c27
--- /dev/null
+++ b/middle_end/flambda/closure_offsets.mli
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Assign numerical offsets, within closure blocks, for code pointers and
+    environment entries. *)
+
+type result = private {
+  function_offsets : int Closure_id.Map.t;
+  free_variable_offsets : int Var_within_closure.Map.t;
+}
+
+val compute : Flambda.program -> result
diff --git a/middle_end/flambda/effect_analysis.ml b/middle_end/flambda/effect_analysis.ml
new file mode 100644
index 00000000..2ddba764
--- /dev/null
+++ b/middle_end/flambda/effect_analysis.ml
@@ -0,0 +1,58 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+let no_effects_prim (prim : Clambda_primitives.primitive) =
+  match Semantics_of_primitives.for_primitive prim with
+  | (No_effects | Only_generative_effects), (No_coeffects | Has_coeffects) ->
+    true
+  | _ -> false
+
+let rec no_effects (flam : Flambda.t) =
+  match flam with
+  | Var _ -> true
+  | Let { defining_expr; body; _ } ->
+    no_effects_named defining_expr && no_effects body
+  | Let_mutable { body } -> no_effects body
+  | Let_rec (defs, body) ->
+    no_effects body
+      && List.for_all (fun (_, def) -> no_effects_named def) defs
+  | If_then_else (_, ifso, ifnot) -> no_effects ifso && no_effects ifnot
+  | Switch (_, sw) ->
+    let aux (_, flam) = no_effects flam in
+    List.for_all aux sw.blocks
+      && List.for_all aux sw.consts
+      && Option.fold ~some:no_effects ~none:true sw.failaction
+  | String_switch (_, sw, def) ->
+    List.for_all (fun (_, lam) -> no_effects lam) sw
+      && Option.fold ~some:no_effects ~none:true def
+  | Static_catch (_, _, body, _) | Try_with (body, _, _) ->
+    (* If there is a [raise] in [body], the whole [Try_with] may have an
+       effect, so there is no need to test the handler. *)
+    no_effects body
+  | While _ | For _ | Apply _ | Send _ | Assign _ | Static_raise _ -> false
+  | Proved_unreachable -> true
+
+and no_effects_named (named : Flambda.named) =
+  match named with
+  | Symbol _ | Const _ | Allocated_const _ | Read_mutable _
+  | Read_symbol_field _
+  | Set_of_closures _ | Project_closure _ | Project_var _
+  | Move_within_set_of_closures _ -> true
+  | Prim (prim, _, _) -> no_effects_prim prim
+  | Expr flam -> no_effects flam
diff --git a/middle_end/flambda/effect_analysis.mli b/middle_end/flambda/effect_analysis.mli
new file mode 100644
index 00000000..b025bf0f
--- /dev/null
+++ b/middle_end/flambda/effect_analysis.mli
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Simple side effect analysis. *)
+
+(* CR-someday pchambart: Replace by call to [Purity] module.
+   mshinwell: Where is the [Purity] module? *)
+(** Conservative approximation as to whether a given Flambda expression may
+    have any side effects. *)
+val no_effects : Flambda.t -> bool
+
+val no_effects_named : Flambda.named -> bool
diff --git a/middle_end/flambda/export_info.ml b/middle_end/flambda/export_info.ml
new file mode 100644
index 00000000..22dbb6c5
--- /dev/null
+++ b/middle_end/flambda/export_info.ml
@@ -0,0 +1,555 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+module A = Simple_value_approx
+
+type value_string_contents =
+  | Contents of string
+  | Unknown_or_mutable
+
+type value_string = {
+  contents : value_string_contents;
+  size : int;
+}
+
+type value_float_array_contents =
+  | Contents of float option array
+  | Unknown_or_mutable
+
+type value_float_array = {
+  contents : value_float_array_contents;
+  size : int;
+}
+
+type descr =
+  | Value_block of Tag.t * approx array
+  | Value_mutable_block of Tag.t * int
+  | Value_int of int
+  | Value_char of char
+  | Value_constptr of int
+  | Value_float of float
+  | Value_float_array of value_float_array
+  | Value_boxed_int : 'a A.boxed_int * 'a -> descr
+  | Value_string of value_string
+  | Value_closure of value_closure
+  | Value_set_of_closures of value_set_of_closures
+  | Value_unknown_descr
+
+and value_closure = {
+  closure_id : Closure_id.t;
+  set_of_closures : value_set_of_closures;
+}
+
+and value_set_of_closures = {
+  set_of_closures_id : Set_of_closures_id.t;
+  bound_vars : approx Var_within_closure.Map.t;
+  free_vars : Flambda.specialised_to Variable.Map.t;
+  results : approx Closure_id.Map.t;
+  aliased_symbol : Symbol.t option;
+}
+
+and approx =
+  | Value_unknown
+  | Value_id of Export_id.t
+  | Value_symbol of Symbol.t
+
+let equal_approx (a1:approx) (a2:approx) =
+  match a1, a2 with
+  | Value_unknown, Value_unknown ->
+    true
+  | Value_id id1, Value_id id2 ->
+    Export_id.equal id1 id2
+  | Value_symbol s1, Value_symbol s2 ->
+    Symbol.equal s1 s2
+  | (Value_unknown | Value_symbol _ | Value_id _),
+    (Value_unknown | Value_symbol _ | Value_id _) ->
+    false
+
+let equal_array eq a1 a2 =
+  Array.length a1 = Array.length a2 &&
+  try
+    Array.iteri (fun i v1 -> if not (eq a2.(i) v1) then raise Exit) a1;
+    true
+  with Exit -> false
+
+let equal_option eq o1 o2 =
+  match o1, o2 with
+  | None, None -> true
+  | Some v1, Some v2 -> eq v1 v2
+  | Some _, None | None, Some _ -> false
+
+let equal_set_of_closures (s1:value_set_of_closures)
+      (s2:value_set_of_closures) =
+  Set_of_closures_id.equal s1.set_of_closures_id s2.set_of_closures_id &&
+  Var_within_closure.Map.equal equal_approx s1.bound_vars s2.bound_vars &&
+  Closure_id.Map.equal equal_approx s1.results s2.results &&
+  equal_option Symbol.equal s1.aliased_symbol s2.aliased_symbol
+
+let equal_descr (d1:descr) (d2:descr) : bool =
+  match d1, d2 with
+  | Value_unknown_descr, Value_unknown_descr ->
+    true
+  | Value_block (t1, f1), Value_block (t2, f2) ->
+    Tag.equal t1 t2 && equal_array equal_approx f1 f2
+  | Value_mutable_block (t1, s1), Value_mutable_block (t2, s2) ->
+    Tag.equal t1 t2 &&
+    s1 = s2
+  | Value_int i1, Value_int i2 ->
+    i1 = i2
+  | Value_char c1, Value_char c2 ->
+    c1 = c2
+  | Value_constptr i1, Value_constptr i2 ->
+    i1 = i2
+  | Value_float f1, Value_float f2 ->
+    f1 = f2
+  | Value_float_array s1, Value_float_array s2 ->
+    s1 = s2
+  | Value_boxed_int (t1, v1), Value_boxed_int (t2, v2) ->
+    A.equal_boxed_int t1 v1 t2 v2
+  | Value_string s1, Value_string s2 ->
+    s1 = s2
+  | Value_closure c1, Value_closure c2 ->
+    Closure_id.equal c1.closure_id c2.closure_id &&
+    equal_set_of_closures c1.set_of_closures c2.set_of_closures
+  | Value_set_of_closures s1, Value_set_of_closures s2 ->
+    equal_set_of_closures s1 s2
+  | ( Value_block (_, _) | Value_mutable_block (_, _) | Value_int _
+    | Value_char _ | Value_constptr _ | Value_float _ | Value_float_array _
+    | Value_boxed_int _ | Value_string _ | Value_closure _
+    | Value_set_of_closures _
+    | Value_unknown_descr ),
+    ( Value_block (_, _) | Value_mutable_block (_, _) | Value_int _
+    | Value_char _ | Value_constptr _ | Value_float _ | Value_float_array _
+    | Value_boxed_int _ | Value_string _ | Value_closure _
+    | Value_set_of_closures _
+    | Value_unknown_descr ) ->
+    false
+
+type t = {
+  sets_of_closures : A.function_declarations Set_of_closures_id.Map.t;
+  values : descr Export_id.Map.t Compilation_unit.Map.t;
+  symbol_id : Export_id.t Symbol.Map.t;
+  offset_fun : int Closure_id.Map.t;
+  offset_fv : int Var_within_closure.Map.t;
+  constant_closures : Closure_id.Set.t;
+  invariant_params : Variable.Set.t Variable.Map.t Set_of_closures_id.Map.t;
+  recursive : Variable.Set.t Set_of_closures_id.Map.t;
+}
+
+type transient = {
+  sets_of_closures : A.function_declarations Set_of_closures_id.Map.t;
+  values : descr Export_id.Map.t Compilation_unit.Map.t;
+  symbol_id : Export_id.t Symbol.Map.t;
+  invariant_params : Variable.Set.t Variable.Map.t Set_of_closures_id.Map.t;
+  recursive : Variable.Set.t Set_of_closures_id.Map.t;
+  relevant_local_closure_ids : Closure_id.Set.t;
+  relevant_imported_closure_ids : Closure_id.Set.t;
+  relevant_local_vars_within_closure  : Var_within_closure.Set.t;
+  relevant_imported_vars_within_closure : Var_within_closure.Set.t;
+}
+
+let empty : t = {
+  sets_of_closures = Set_of_closures_id.Map.empty;
+  values = Compilation_unit.Map.empty;
+  symbol_id = Symbol.Map.empty;
+  offset_fun = Closure_id.Map.empty;
+  offset_fv = Var_within_closure.Map.empty;
+  constant_closures = Closure_id.Set.empty;
+  invariant_params = Set_of_closures_id.Map.empty;
+  recursive = Set_of_closures_id.Map.empty;
+}
+
+let opaque_transient ~compilation_unit ~root_symbol : transient =
+  let export_id = Export_id.create compilation_unit in
+  let values =
+    let map = Export_id.Map.singleton export_id Value_unknown_descr in
+    Compilation_unit.Map.singleton compilation_unit map
+  in
+  let symbol_id = Symbol.Map.singleton root_symbol export_id in
+  { sets_of_closures = Set_of_closures_id.Map.empty;
+    values;
+    symbol_id;
+    invariant_params = Set_of_closures_id.Map.empty;
+    recursive = Set_of_closures_id.Map.empty;
+    relevant_local_closure_ids = Closure_id.Set.empty;
+    relevant_imported_closure_ids = Closure_id.Set.empty;
+    relevant_local_vars_within_closure = Var_within_closure.Set.empty;
+    relevant_imported_vars_within_closure = Var_within_closure.Set.empty;
+  }
+
+let create ~sets_of_closures ~values ~symbol_id
+      ~offset_fun ~offset_fv ~constant_closures
+      ~invariant_params ~recursive =
+  { sets_of_closures;
+    values;
+    symbol_id;
+    offset_fun;
+    offset_fv;
+    constant_closures;
+    invariant_params;
+    recursive;
+  }
+
+let create_transient
+      ~sets_of_closures ~values ~symbol_id ~invariant_params ~recursive
+      ~relevant_local_closure_ids ~relevant_imported_closure_ids
+      ~relevant_local_vars_within_closure
+      ~relevant_imported_vars_within_closure =
+  { sets_of_closures;
+    values;
+    symbol_id;
+    invariant_params;
+    recursive;
+    relevant_local_closure_ids;
+    relevant_imported_closure_ids;
+    relevant_local_vars_within_closure;
+    relevant_imported_vars_within_closure;
+  }
+
+let t_of_transient transient
+      ~program:_
+      ~local_offset_fun ~local_offset_fv
+      ~imported_offset_fun ~imported_offset_fv
+      ~constant_closures =
+  let offset_fun =
+    let fold_map set =
+      Closure_id.Map.fold (fun key value unchanged ->
+        if Closure_id.Set.mem key set then
+          Closure_id.Map.add key value unchanged
+        else
+          unchanged)
+    in
+    Closure_id.Map.empty
+    |> fold_map transient.relevant_local_closure_ids local_offset_fun
+    |> fold_map transient.relevant_imported_closure_ids imported_offset_fun
+  in
+  let offset_fv =
+    let fold_map set =
+      Var_within_closure.Map.fold (fun key value unchanged ->
+        if Var_within_closure.Set.mem key set then
+          Var_within_closure.Map.add key value unchanged
+        else
+          unchanged)
+    in
+    Var_within_closure.Map.empty
+    |> fold_map transient.relevant_local_vars_within_closure local_offset_fv
+    |> fold_map transient.relevant_imported_vars_within_closure
+         imported_offset_fv
+  in
+  { sets_of_closures = transient.sets_of_closures;
+    values = transient.values;
+    symbol_id = transient.symbol_id;
+    invariant_params = transient.invariant_params;
+    recursive = transient.recursive;
+    offset_fun;
+    offset_fv;
+    constant_closures;
+  }
+
+let merge (t1 : t) (t2 : t) : t =
+  let eidmap_disjoint_union ?eq map1 map2 =
+    Compilation_unit.Map.merge (fun _id map1 map2 ->
+        match map1, map2 with
+        | None, None -> None
+        | None, Some map
+        | Some map, None -> Some map
+        | Some map1, Some map2 ->
+          Some (Export_id.Map.disjoint_union ?eq map1 map2))
+      map1 map2
+  in
+  let int_eq (i : int) j = i = j in
+  { values = eidmap_disjoint_union ~eq:equal_descr t1.values t2.values;
+    sets_of_closures =
+      Set_of_closures_id.Map.disjoint_union t1.sets_of_closures
+        t2.sets_of_closures;
+    symbol_id =
+      Symbol.Map.disjoint_union ~print:Export_id.print t1.symbol_id
+        t2.symbol_id;
+    offset_fun = Closure_id.Map.disjoint_union
+        ~eq:int_eq t1.offset_fun t2.offset_fun;
+    offset_fv = Var_within_closure.Map.disjoint_union
+        ~eq:int_eq t1.offset_fv t2.offset_fv;
+    constant_closures =
+      Closure_id.Set.union t1.constant_closures t2.constant_closures;
+    invariant_params =
+      Set_of_closures_id.Map.disjoint_union
+        ~print:(Variable.Map.print Variable.Set.print)
+        ~eq:(Variable.Map.equal Variable.Set.equal)
+        t1.invariant_params t2.invariant_params;
+    recursive =
+      Set_of_closures_id.Map.disjoint_union
+        ~print:Variable.Set.print
+        ~eq:Variable.Set.equal
+        t1.recursive t2.recursive;
+  }
+
+let find_value eid map =
+  let unit_map =
+    Compilation_unit.Map.find (Export_id.get_compilation_unit eid) map
+  in
+  Export_id.Map.find eid unit_map
+
+let find_description (t : t) eid =
+  find_value eid t.values
+
+let nest_eid_map map =
+  let add_map eid v map =
+    let unit = Export_id.get_compilation_unit eid in
+    let m =
+      try Compilation_unit.Map.find unit map
+      with Not_found -> Export_id.Map.empty
+    in
+    Compilation_unit.Map.add unit (Export_id.Map.add eid v m) map
+  in
+  Export_id.Map.fold add_map map Compilation_unit.Map.empty
+
+let print_raw_approx ppf approx =
+  let fprintf = Format.fprintf in
+  match approx with
+  | Value_unknown -> fprintf ppf "(Unknown)"
+  | Value_id export_id -> fprintf ppf "(Id %a)" Export_id.print export_id
+  | Value_symbol symbol -> fprintf ppf "(Symbol %a)" Symbol.print symbol
+
+let print_value_set_of_closures ppf (t : value_set_of_closures) =
+  let print_bound_vars ppf bound_vars =
+    Format.fprintf ppf "(%a)"
+      (Var_within_closure.Map.print print_raw_approx)
+      bound_vars
+  in
+  let print_free_vars ppf free_vars =
+    Format.fprintf ppf "(%a)"
+      (Variable.Map.print Flambda.print_specialised_to)
+      free_vars
+  in
+  let print_results ppf results =
+    Format.fprintf ppf "(%a)" (Closure_id.Map.print print_raw_approx) results
+  in
+  let print_aliased_symbol ppf aliased_symbol =
+    match aliased_symbol with
+    | None -> Format.fprintf ppf ""
+    | Some symbol -> Format.fprintf ppf "(%a)" Symbol.print symbol
+  in
+  Format.fprintf ppf
+    "((set_of_closures_id %a) \
+     (bound_vars %a) \
+     (free_vars %a) \
+     (results %a) \
+     (aliased_symbol %a))"
+    Set_of_closures_id.print t.set_of_closures_id
+    print_bound_vars t.bound_vars
+    print_free_vars t.free_vars
+    print_results t.results
+    print_aliased_symbol t.aliased_symbol
+
+let print_value_closure ppf (t : value_closure) =
+  Format.fprintf ppf "((closure_id %a) (set_of_closures %a))"
+    Closure_id.print t.closure_id
+    print_value_set_of_closures t.set_of_closures
+
+let print_value_float_array_contents
+      ppf (value : value_float_array_contents) =
+  match value with
+  | Unknown_or_mutable -> Format.fprintf ppf "(Unknown_or_mutable)"
+  | Contents _ -> Format.fprintf ppf "(Contents ...)"
+
+let print_value_float_array ppf (value : value_float_array) =
+  Format.fprintf ppf "((size %d) (contents %a))"
+    value.size
+    print_value_float_array_contents value.contents
+
+let print_value_string_contents ppf (value : value_string_contents) =
+  match value with
+  | Unknown_or_mutable -> Format.fprintf ppf "(Unknown_or_mutable)"
+  | Contents _ -> Format.fprintf ppf "(Contents ...)"
+
+let print_value_string ppf (value : value_string) =
+  Format.fprintf ppf "((size %d) (contents %a))"
+    value.size
+    print_value_string_contents value.contents
+
+let print_raw_descr ppf descr =
+  let fprintf = Format.fprintf in
+  let print_approx_array ppf arr =
+    Array.iter (fun approx -> fprintf ppf "%a " print_raw_approx approx) arr
+  in
+  match descr with
+  | Value_block (tag, approx_array) ->
+    fprintf ppf "(Value_block (%a %a))"
+      Tag.print tag
+      print_approx_array approx_array
+  | Value_mutable_block (tag, i) ->
+    fprintf ppf "(Value_mutable-block (%a %d))" Tag.print tag i
+  | Value_int i -> fprintf ppf "(Value_int %d)" i
+  | Value_char c -> fprintf ppf "(Value_char %c)" c
+  | Value_constptr p -> fprintf ppf "(Value_constptr  %d)" p
+  | Value_float f -> fprintf ppf "(Value_float %.3f)" f
+  | Value_float_array value_float_array ->
+    fprintf ppf "(Value_float_array %a)"
+      print_value_float_array value_float_array
+  | Value_boxed_int _ ->
+    fprintf ppf "(Value_Boxed_int)"
+  | Value_string value_string ->
+    fprintf ppf "(Value_string %a)" print_value_string value_string
+  | Value_closure value_closure ->
+    fprintf ppf "(Value_closure %a)"
+      print_value_closure value_closure
+  | Value_set_of_closures value_set_of_closures ->
+    fprintf ppf "(Value_set_of_closures %a)"
+    print_value_set_of_closures value_set_of_closures
+  | Value_unknown_descr -> fprintf ppf "(Value_unknown_descr)"
+
+let print_approx_components ppf ~symbol_id ~values
+      (root_symbols : Symbol.t list) =
+  let fprintf = Format.fprintf in
+  let printed = ref Export_id.Set.empty in
+  let recorded_symbol = ref Symbol.Set.empty in
+  let symbols_to_print = Queue.create () in
+  let printed_set_of_closures = ref Set_of_closures_id.Set.empty in
+  let rec print_approx ppf (approx : approx) =
+    match approx with
+    | Value_unknown -> fprintf ppf "?"
+    | Value_id id ->
+      if Export_id.Set.mem id !printed then
+        fprintf ppf "(%a: _)" Export_id.print id
+      else begin
+        try
+          let descr = find_value id values in
+          printed := Export_id.Set.add id !printed;
+          fprintf ppf "@[(%a:@ %a)@]"
+            Export_id.print id print_descr descr
+        with Not_found ->
+          fprintf ppf "(%a: Not available)" Export_id.print id
+      end
+    | Value_symbol sym ->
+      if not (Symbol.Set.mem sym !recorded_symbol) then begin
+        recorded_symbol := Symbol.Set.add sym !recorded_symbol;
+        Queue.push sym symbols_to_print;
+      end;
+      Symbol.print ppf sym
+  and print_descr ppf (descr : descr) =
+    match descr with
+    | Value_int i -> Format.pp_print_int ppf i
+    | Value_char c -> fprintf ppf "%c" c
+    | Value_constptr i -> fprintf ppf "%ip" i
+    | Value_block (tag, fields) ->
+      fprintf ppf "[%a:%a]" Tag.print tag print_fields fields
+    | Value_mutable_block (tag, size) ->
+      fprintf ppf "[mutable %a:%i]" Tag.print tag size
+    | Value_closure {closure_id; set_of_closures} ->
+      fprintf ppf "(closure %a, %a)" Closure_id.print closure_id
+        print_set_of_closures set_of_closures
+    | Value_set_of_closures set_of_closures ->
+      fprintf ppf "(set_of_closures %a)" print_set_of_closures set_of_closures
+    | Value_string { contents; size } ->
+      begin match contents with
+      | Unknown_or_mutable -> Format.fprintf ppf "string %i" size
+      | Contents s ->
+        let s =
+          if size > 10
+          then String.sub s 0 8 ^ "..."
+          else s
+        in
+        Format.fprintf ppf "string %i %S" size s
+      end
+    | Value_float f -> Format.pp_print_float ppf f
+    | Value_float_array float_array ->
+      Format.fprintf ppf "float_array%s %i"
+        (match float_array.contents with
+          | Unknown_or_mutable -> ""
+          | Contents _ -> "_imm")
+        float_array.size
+    | Value_boxed_int (t, i) ->
+      begin match t with
+      | A.Int32 -> Format.fprintf ppf "%li" i
+      | A.Int64 -> Format.fprintf ppf "%Li" i
+      | A.Nativeint -> Format.fprintf ppf "%ni" i
+      end
+    | Value_unknown_descr -> Format.fprintf ppf "?"
+  and print_fields ppf fields =
+    Array.iter (fun approx -> fprintf ppf "%a@ " print_approx approx) fields
+  and print_set_of_closures ppf
+      { set_of_closures_id; bound_vars; aliased_symbol; results } =
+    if Set_of_closures_id.Set.mem set_of_closures_id !printed_set_of_closures
+    then fprintf ppf "%a" Set_of_closures_id.print set_of_closures_id
+    else begin
+      printed_set_of_closures :=
+        Set_of_closures_id.Set.add set_of_closures_id !printed_set_of_closures;
+      let print_alias ppf = function
+        | None -> ()
+        | Some symbol ->
+          Format.fprintf ppf "@ (alias: %a)" Symbol.print symbol
+      in
+      fprintf ppf "{%a: %a%a => %a}"
+        Set_of_closures_id.print set_of_closures_id
+        print_binding bound_vars
+        print_alias aliased_symbol
+        (Closure_id.Map.print print_approx) results
+    end
+  and print_binding ppf bound_vars =
+    Var_within_closure.Map.iter (fun clos_id approx ->
+        fprintf ppf "%a -> %a,@ "
+          Var_within_closure.print clos_id
+          print_approx approx)
+      bound_vars
+  in
+  let rec print_recorded_symbols () =
+    if not (Queue.is_empty symbols_to_print) then begin
+      let sym = Queue.pop symbols_to_print in
+      begin match Symbol.Map.find sym symbol_id with
+      | exception Not_found -> ()
+      | id ->
+        fprintf ppf "@[%a:@ %a@];@ "
+          Symbol.print sym
+          print_approx (Value_id id)
+      end;
+      print_recorded_symbols ();
+    end
+  in
+  List.iter (fun s -> Queue.push s symbols_to_print) root_symbols;
+  fprintf ppf "@[Globals:@ ";
+  fprintf ppf "@]@ @[Symbols:@ ";
+  print_recorded_symbols ();
+  fprintf ppf "@]"
+
+let print_approx ppf ((t : t), symbols) =
+  let symbol_id = t.symbol_id in
+  let values = t.values in
+  print_approx_components ppf ~symbol_id ~values symbols
+
+let print_offsets ppf (t : t) =
+  Format.fprintf ppf "@[offset_fun:@ ";
+  Closure_id.Map.iter (fun cid off ->
+      Format.fprintf ppf "%a -> %i@ "
+        Closure_id.print cid off) t.offset_fun;
+  Format.fprintf ppf "@]@ @[offset_fv:@ ";
+  Var_within_closure.Map.iter (fun vid off ->
+      Format.fprintf ppf "%a -> %i@ "
+        Var_within_closure.print vid off) t.offset_fv;
+  Format.fprintf ppf "@]@ "
+
+let print_functions ppf (t : t) =
+  Set_of_closures_id.Map.print
+    A.print_function_declarations ppf
+    t.sets_of_closures
+
+let print_all ppf ((t, root_symbols) : t * Symbol.t list) =
+  let fprintf = Format.fprintf in
+  fprintf ppf "approxs@ %a@.@."
+    print_approx (t, root_symbols);
+  fprintf ppf "functions@ %a@.@."
+    print_functions t
diff --git a/middle_end/flambda/export_info.mli b/middle_end/flambda/export_info.mli
new file mode 100644
index 00000000..f93698be
--- /dev/null
+++ b/middle_end/flambda/export_info.mli
@@ -0,0 +1,195 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Exported information (that is to say, information written into a .cmx
+    file) about a compilation unit. *)
+
+module A = Simple_value_approx
+
+type value_string_contents =
+  | Contents of string
+  | Unknown_or_mutable
+
+type value_string = {
+  contents : value_string_contents;
+  size : int;
+}
+
+type value_float_array_contents =
+  | Contents of float option array
+  | Unknown_or_mutable
+
+type value_float_array = {
+  contents : value_float_array_contents;
+  size : int;
+}
+
+type descr =
+  | Value_block of Tag.t * approx array
+  | Value_mutable_block of Tag.t * int
+  | Value_int of int
+  | Value_char of char
+  | Value_constptr of int
+  | Value_float of float
+  | Value_float_array of value_float_array
+  | Value_boxed_int : 'a A.boxed_int * 'a -> descr
+  | Value_string of value_string
+  | Value_closure of value_closure
+  | Value_set_of_closures of value_set_of_closures
+  | Value_unknown_descr
+
+and value_closure = {
+  closure_id : Closure_id.t;
+  set_of_closures : value_set_of_closures;
+}
+
+and value_set_of_closures = {
+  set_of_closures_id : Set_of_closures_id.t;
+  bound_vars : approx Var_within_closure.Map.t;
+  free_vars : Flambda.specialised_to Variable.Map.t;
+  results : approx Closure_id.Map.t;
+  aliased_symbol : Symbol.t option;
+}
+
+(* CR-soon mshinwell: Fix the export information so we can correctly
+   propagate "unresolved due to..." in the manner of [Simple_value_approx].
+   Unfortunately this seems to be complicated by the fact that, during
+   [Import_approx], resolution can fail not only due to missing symbols but
+   also due to missing export IDs.  The argument type of
+   [Simple_value_approx.t] may need updating to reflect this (make the
+   symbol optional?  It's only for debugging anyway.) *)
+and approx =
+  | Value_unknown
+  | Value_id of Export_id.t
+  | Value_symbol of Symbol.t
+
+(** A structure that describes what a single compilation unit exports. *)
+type t = private {
+  sets_of_closures : A.function_declarations Set_of_closures_id.Map.t;
+  (** Code of exported functions indexed by set of closures IDs. *)
+  values : descr Export_id.Map.t Compilation_unit.Map.t;
+  (** Structure of exported values. *)
+  symbol_id : Export_id.t Symbol.Map.t;
+  (** Associates symbols and values. *)
+  offset_fun : int Closure_id.Map.t;
+  (** Positions of function pointers in their closures. *)
+  offset_fv : int Var_within_closure.Map.t;
+  (** Positions of value pointers in their closures. *)
+  constant_closures : Closure_id.Set.t;
+  (* CR-soon mshinwell for pchambart: Add comment *)
+  invariant_params : Variable.Set.t Variable.Map.t Set_of_closures_id.Map.t;
+  (* Function parameters known to be invariant (see [Invariant_params])
+     indexed by set of closures ID. *)
+  recursive : Variable.Set.t Set_of_closures_id.Map.t;
+}
+
+type transient = private {
+  sets_of_closures : A.function_declarations Set_of_closures_id.Map.t;
+  values : descr Export_id.Map.t Compilation_unit.Map.t;
+  symbol_id : Export_id.t Symbol.Map.t;
+  invariant_params : Variable.Set.t Variable.Map.t Set_of_closures_id.Map.t;
+  recursive : Variable.Set.t Set_of_closures_id.Map.t;
+  relevant_local_closure_ids : Closure_id.Set.t;
+  relevant_imported_closure_ids : Closure_id.Set.t;
+  relevant_local_vars_within_closure  : Var_within_closure.Set.t;
+  relevant_imported_vars_within_closure : Var_within_closure.Set.t;
+}
+
+(** Export information for a compilation unit that exports nothing. *)
+val empty : t
+
+val opaque_transient
+  : compilation_unit:Compilation_unit.t
+  -> root_symbol:Symbol.t
+  -> transient
+
+(** Create a new export information structure. *)
+val create
+   : sets_of_closures:(A.function_declarations Set_of_closures_id.Map.t)
+  -> values:descr Export_id.Map.t Compilation_unit.Map.t
+  -> symbol_id:Export_id.t Symbol.Map.t
+  -> offset_fun:int Closure_id.Map.t
+  -> offset_fv:int Var_within_closure.Map.t
+  -> constant_closures:Closure_id.Set.t
+  -> invariant_params:Variable.Set.t Variable.Map.t Set_of_closures_id.Map.t
+  -> recursive:Variable.Set.t Set_of_closures_id.Map.t
+  -> t
+
+val create_transient
+   : sets_of_closures:(A.function_declarations Set_of_closures_id.Map.t)
+  -> values:descr Export_id.Map.t Compilation_unit.Map.t
+  -> symbol_id:Export_id.t Symbol.Map.t
+  -> invariant_params:Variable.Set.t Variable.Map.t Set_of_closures_id.Map.t
+  -> recursive:Variable.Set.t Set_of_closures_id.Map.t
+  -> relevant_local_closure_ids: Closure_id.Set.t
+  -> relevant_imported_closure_ids : Closure_id.Set.t
+  -> relevant_local_vars_within_closure : Var_within_closure.Set.t
+  -> relevant_imported_vars_within_closure : Var_within_closure.Set.t
+  -> transient
+
+(* CR-someday pchambart: Should we separate [t] in 2 types: one created by the
+   current [create] function, returned by [Build_export_info]. And
+   another built using t and offset_informations returned by
+   [flambda_to_clambda] ?
+   mshinwell: I think we should, but after we've done the first release.
+*)
+(** Record information about the layout of closures and which sets of
+    closures are constant.  These are all worked out during the
+    [Flambda_to_clambda] pass. *)
+val t_of_transient
+   : transient
+  -> program: Flambda.program
+  -> local_offset_fun:int Closure_id.Map.t
+  -> local_offset_fv:int Var_within_closure.Map.t
+  -> imported_offset_fun:int Closure_id.Map.t
+  -> imported_offset_fv:int Var_within_closure.Map.t
+  -> constant_closures:Closure_id.Set.t
+  -> t
+
+(** Union of export information.  Verifies that there are no identifier
+    clashes. *)
+val merge : t -> t -> t
+
+(** Look up the description of an exported value given its export ID. *)
+val find_description
+   : t
+  -> Export_id.t
+  -> descr
+
+(** Partition a mapping from export IDs by compilation unit. *)
+val nest_eid_map
+   : 'a Export_id.Map.t
+  -> 'a Export_id.Map.t Compilation_unit.Map.t
+
+(**/**)
+(* Debug printing functions. *)
+val print_approx_components
+  : Format.formatter
+  -> symbol_id: Export_id.t Symbol.Map.t
+  -> values: descr Export_id.Map.t Compilation_unit.Map.t
+  -> Symbol.t list
+  -> unit
+val print_approx : Format.formatter -> t * Symbol.t list -> unit
+val print_functions : Format.formatter -> t -> unit
+val print_offsets : Format.formatter -> t -> unit
+val print_all : Format.formatter -> t * Symbol.t list -> unit
+
+(** Prints approx and descr as it is, without recursively looking up
+    [Export_id.t] *)
+val print_raw_approx : Format.formatter -> approx -> unit
+val print_raw_descr  : Format.formatter -> descr -> unit
diff --git a/middle_end/flambda/export_info_for_pack.ml b/middle_end/flambda/export_info_for_pack.ml
new file mode 100644
index 00000000..ebed5593
--- /dev/null
+++ b/middle_end/flambda/export_info_for_pack.ml
@@ -0,0 +1,231 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+module A = Simple_value_approx
+
+let rename_id_state = Export_id.Tbl.create 100
+let rename_set_of_closures_id_state = Set_of_closures_id.Tbl.create 10
+let imported_function_declarations_table =
+  (Set_of_closures_id.Tbl.create 10
+   : A.function_declarations Set_of_closures_id.Tbl.t)
+
+(* Rename export identifiers' compilation units to denote that they now
+   live within a pack. *)
+let import_eid_for_pack units pack id =
+  try Export_id.Tbl.find rename_id_state id
+  with Not_found ->
+    let unit_id = Export_id.get_compilation_unit id in
+    let id' =
+      if Compilation_unit.Set.mem unit_id units
+      then Export_id.create ?name:(Export_id.name id) pack
+      else id
+    in
+    Export_id.Tbl.add rename_id_state id id';
+    id'
+
+(* Similar to [import_eid_for_pack], but for symbols. *)
+let import_symbol_for_pack units pack symbol =
+  let compilation_unit = Symbol.compilation_unit symbol in
+  if Compilation_unit.Set.mem compilation_unit units
+  then Symbol.import_for_pack ~pack symbol
+  else symbol
+
+let import_approx_for_pack units pack (approx : Export_info.approx)
+      : Export_info.approx =
+  match approx with
+  | Value_symbol sym -> Value_symbol (import_symbol_for_pack units pack sym)
+  | Value_id eid -> Value_id (import_eid_for_pack units pack eid)
+  | Value_unknown -> Value_unknown
+
+let import_set_of_closures_id_for_pack units pack
+    (set_of_closures_id : Set_of_closures_id.t)
+      : Set_of_closures_id.t =
+  let compilation_unit =
+    Set_of_closures_id.get_compilation_unit set_of_closures_id
+  in
+  if Compilation_unit.Set.mem compilation_unit units then
+    Set_of_closures_id.Tbl.memoize
+      rename_set_of_closures_id_state
+      (fun _ ->
+         Set_of_closures_id.create
+           ?name:(Set_of_closures_id.name set_of_closures_id)
+           pack)
+      set_of_closures_id
+  else set_of_closures_id
+
+let import_set_of_closures_origin_for_pack units pack
+    (set_of_closures_origin : Set_of_closures_origin.t)
+    : Set_of_closures_origin.t =
+  Set_of_closures_origin.rename
+    (import_set_of_closures_id_for_pack units pack)
+    set_of_closures_origin
+
+let import_set_of_closures units pack
+      (set_of_closures : Export_info.value_set_of_closures)
+      : Export_info.value_set_of_closures =
+  { set_of_closures_id =
+      import_set_of_closures_id_for_pack units pack
+        set_of_closures.set_of_closures_id;
+    bound_vars =
+      Var_within_closure.Map.map (import_approx_for_pack units pack)
+        set_of_closures.bound_vars;
+    free_vars = set_of_closures.free_vars;
+    results =
+      Closure_id.Map.map (import_approx_for_pack units pack)
+        set_of_closures.results;
+    aliased_symbol =
+      Option.map
+        (import_symbol_for_pack units pack)
+        set_of_closures.aliased_symbol;
+  }
+
+let import_descr_for_pack units pack (descr : Export_info.descr)
+      : Export_info.descr =
+  match descr with
+  | Value_int _
+  | Value_char _
+  | Value_constptr _
+  | Value_string _
+  | Value_float _
+  | Value_float_array _
+  | Export_info.Value_boxed_int _
+  | Value_mutable_block _ as desc -> desc
+  | Value_block (tag, fields) ->
+    Value_block (tag, Array.map (import_approx_for_pack units pack) fields)
+  | Value_closure { closure_id; set_of_closures } ->
+    Value_closure {
+      closure_id;
+      set_of_closures = import_set_of_closures units pack set_of_closures;
+    }
+  | Value_set_of_closures set_of_closures ->
+    Value_set_of_closures (import_set_of_closures units pack set_of_closures)
+  | Value_unknown_descr -> Value_unknown_descr
+
+let rec import_code_for_pack units pack expr =
+  Flambda_iterators.map_named (function
+      | Symbol sym -> Symbol (import_symbol_for_pack units pack sym)
+      | Read_symbol_field (sym, field) ->
+        Read_symbol_field (import_symbol_for_pack units pack sym, field)
+      | Set_of_closures set_of_closures ->
+        let set_of_closures =
+          Flambda.create_set_of_closures
+            ~free_vars:set_of_closures.free_vars
+            ~specialised_args:set_of_closures.specialised_args
+            ~direct_call_surrogates:set_of_closures.direct_call_surrogates
+            ~function_decls:
+              (import_function_declarations_for_pack_aux units pack
+                 set_of_closures.function_decls)
+        in
+        Set_of_closures set_of_closures
+      | e -> e)
+    expr
+
+and import_function_declarations_for_pack_aux units pack
+      (function_decls : Flambda.function_declarations) =
+  let funs =
+    Variable.Map.map
+      (fun (function_decl : Flambda.function_declaration) ->
+        Flambda.create_function_declaration ~params:function_decl.params
+          ~body:(import_code_for_pack units pack function_decl.body)
+          ~stub:function_decl.stub ~dbg:function_decl.dbg
+          ~inline:function_decl.inline
+          ~specialise:function_decl.specialise
+          ~is_a_functor:function_decl.is_a_functor
+          ~closure_origin:function_decl.closure_origin)
+      function_decls.funs
+  in
+  Flambda.import_function_declarations_for_pack
+    (Flambda.update_function_declarations function_decls ~funs)
+    (import_set_of_closures_id_for_pack units pack)
+    (import_set_of_closures_origin_for_pack units pack)
+
+let import_function_declarations_for_pack_aux units pack
+      (function_decls : A.function_declarations) : A.function_declarations =
+  let funs =
+    Variable.Map.map
+      (fun (function_decl : A.function_declaration) ->
+         A.update_function_declaration_body function_decl
+           (fun body -> import_code_for_pack units pack body))
+      function_decls.funs
+  in
+  A.import_function_declarations_for_pack
+    (A.update_function_declarations function_decls ~funs)
+    (import_set_of_closures_id_for_pack units pack)
+    (import_set_of_closures_origin_for_pack units pack)
+
+let import_function_declarations_approx_for_pack units pack
+      (function_decls: A.function_declarations) =
+  let original_set_of_closures_id = function_decls.set_of_closures_id in
+  try
+    Set_of_closures_id.Tbl.find imported_function_declarations_table
+      original_set_of_closures_id
+  with Not_found ->
+    let function_decls =
+      import_function_declarations_for_pack_aux units pack function_decls
+    in
+    Set_of_closures_id.Tbl.add
+      imported_function_declarations_table
+      original_set_of_closures_id
+      function_decls;
+    function_decls
+
+let import_eidmap_for_pack units pack f map =
+  Export_info.nest_eid_map
+    (Compilation_unit.Map.fold
+      (fun _ map acc -> Export_id.Map.disjoint_union map acc)
+      (Compilation_unit.Map.map (fun map ->
+          Export_id.Map.map_keys (import_eid_for_pack units pack)
+            (Export_id.Map.map f map))
+        map)
+      Export_id.Map.empty)
+
+let import_for_pack ~pack_units ~pack (exp : Export_info.t) =
+  let import_sym = import_symbol_for_pack pack_units pack in
+  let import_descr = import_descr_for_pack pack_units pack in
+  let import_eid = import_eid_for_pack pack_units pack in
+  let import_eidmap f map = import_eidmap_for_pack pack_units pack f map in
+  let import_set_of_closures_id =
+    import_set_of_closures_id_for_pack pack_units pack
+  in
+  let import_function_declarations =
+    import_function_declarations_approx_for_pack pack_units pack
+  in
+  let sets_of_closures =
+    Set_of_closures_id.Map.map_keys import_set_of_closures_id
+      (Set_of_closures_id.Map.map
+         import_function_declarations
+         exp.sets_of_closures)
+  in
+  Export_info.create ~sets_of_closures
+    ~offset_fun:exp.offset_fun
+    ~offset_fv:exp.offset_fv
+    ~values:(import_eidmap import_descr exp.values)
+    ~symbol_id:(Symbol.Map.map_keys import_sym
+      (Symbol.Map.map import_eid exp.symbol_id))
+    ~constant_closures:exp.constant_closures
+    ~invariant_params:
+      (Set_of_closures_id.Map.map_keys import_set_of_closures_id
+         exp.invariant_params)
+    ~recursive:
+      (Set_of_closures_id.Map.map_keys import_set_of_closures_id
+         exp.recursive)
+
+let clear_import_state () =
+  Set_of_closures_id.Tbl.clear imported_function_declarations_table;
+  Set_of_closures_id.Tbl.clear rename_set_of_closures_id_state;
+  Export_id.Tbl.clear rename_id_state
diff --git a/middle_end/flambda/export_info_for_pack.mli b/middle_end/flambda/export_info_for_pack.mli
new file mode 100644
index 00000000..2ba3a35d
--- /dev/null
+++ b/middle_end/flambda/export_info_for_pack.mli
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Transformations on export information that are only used for the
+    building of packs. *)
+
+(** Transform the information from [exported] to be
+    suitable to be reexported as the information for a pack named [pack]
+    containing units [pack_units].
+    It mainly changes symbols of units [pack_units] to refer to
+    [pack] instead. *)
+val import_for_pack
+   : pack_units:Compilation_unit.Set.t
+  -> pack:Compilation_unit.t
+  -> Export_info.t
+  -> Export_info.t
+
+(** Drops the state after importing several units in the same pack. *)
+val clear_import_state : unit -> unit
diff --git a/middle_end/flambda/extract_projections.ml b/middle_end/flambda/extract_projections.ml
new file mode 100644
index 00000000..33cd473e
--- /dev/null
+++ b/middle_end/flambda/extract_projections.ml
@@ -0,0 +1,190 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module A = Simple_value_approx
+module E = Inline_and_simplify_aux.Env
+
+(* CR-soon pchambart: should we restrict only to cases
+  when the field is aliased to a variable outside
+  of the closure (i.e. when we can certainly remove
+  the allocation of the block) ?
+  Note that this may prevent cases with imbricated
+  closures from benefiting from this transformations.
+  mshinwell: What word was "imbricated" supposed to be?
+  (The code this referred to has been deleted, but the same thing is
+  probably still happening).
+*)
+
+let known_valid_projections ~env ~projections ~which_variables =
+  Projection.Set.filter (fun projection ->
+      let from = Projection.projecting_from projection in
+      let outer_var =
+        match Variable.Map.find from which_variables with
+        | exception Not_found -> assert false
+        | (outer_var : Flambda.specialised_to) ->
+          Freshening.apply_variable (E.freshening env) outer_var.var
+      in
+      let approx = E.find_exn env outer_var in
+      match projection with
+      | Project_var project_var ->
+        begin match A.check_approx_for_closure approx with
+        | Ok (_value_closure, _approx_var, _approx_sym,
+              value_set_of_closures) ->
+          Var_within_closure.Map.mem project_var.var
+            value_set_of_closures.bound_vars
+        | Wrong -> false
+        end
+      | Project_closure project_closure ->
+        begin match A.strict_check_approx_for_set_of_closures approx with
+        | Ok (_var, value_set_of_closures) ->
+          Variable.Set.mem (Closure_id.unwrap project_closure.closure_id)
+            (Variable.Map.keys value_set_of_closures.function_decls.funs)
+        | Wrong -> false
+        end
+      | Move_within_set_of_closures move ->
+        begin match A.check_approx_for_closure approx with
+        | Ok (value_closure, _approx_var, _approx_sym,
+              _value_set_of_closures) ->
+          (* We could check that [move.move_to] is in [value_set_of_closures],
+             but this is unnecessary, since [Closure_id]s are unique. *)
+          Closure_id.equal value_closure.closure_id move.start_from
+        | Wrong -> false
+        end
+      | Field (field_index, _) ->
+        match A.check_approx_for_block approx with
+        | Wrong -> false
+        | Ok (_tag, fields) ->
+          field_index >= 0 && field_index < Array.length fields)
+    projections
+
+let rec analyse_expr ~which_variables expr =
+  let projections = ref Projection.Set.empty in
+  let used_which_variables = ref Variable.Set.empty in
+  let check_free_variable var =
+    if Variable.Map.mem var which_variables then begin
+      used_which_variables := Variable.Set.add var !used_which_variables
+    end
+  in
+  let for_expr (expr : Flambda.expr) =
+    match expr with
+    | Var var
+    | Let_mutable { initial_value = var } ->
+      check_free_variable var
+    (* CR-soon mshinwell: We don't handle [Apply] for the moment to
+       avoid disabling unboxing optimizations whenever we see a recursive
+       call.  We should improve this analysis.  Leo says this can be
+       done by a similar thing to the unused argument analysis. *)
+    | Apply _ -> ()
+    | Send { meth; obj; args; _ } ->
+      check_free_variable meth;
+      check_free_variable obj;
+      List.iter check_free_variable args
+    | Assign { new_value; _ } ->
+      check_free_variable new_value
+    | If_then_else (var, _, _)
+    | Switch (var, _)
+    | String_switch (var, _, _) ->
+      check_free_variable var
+    | Static_raise (_, args) ->
+      List.iter check_free_variable args
+    | For { from_value; to_value; _ } ->
+      check_free_variable from_value;
+      check_free_variable to_value
+    | Let _ | Let_rec _ | Static_catch _ | While _ | Try_with _
+    | Proved_unreachable -> ()
+  in
+  let for_named (named : Flambda.named) =
+    match named with
+    | Project_var project_var
+        when Variable.Map.mem project_var.closure which_variables ->
+      projections :=
+        Projection.Set.add (Project_var project_var) !projections
+    | Project_closure project_closure
+        when Variable.Map.mem project_closure.set_of_closures
+          which_variables ->
+      projections :=
+        Projection.Set.add (Project_closure project_closure) !projections
+    | Move_within_set_of_closures move
+        when Variable.Map.mem move.closure which_variables ->
+      projections :=
+        Projection.Set.add (Move_within_set_of_closures move) !projections
+    | Prim (Pfield field_index, [var], _dbg)
+        when Variable.Map.mem var which_variables ->
+      projections :=
+        Projection.Set.add (Field (field_index, var)) !projections
+    | Set_of_closures set_of_closures ->
+      let aliasing_free_vars =
+        Variable.Map.filter (fun _ (spec_to : Flambda.specialised_to) ->
+            Variable.Map.mem spec_to.var which_variables)
+          set_of_closures.free_vars
+      in
+      let aliasing_specialised_args =
+        Variable.Map.filter (fun _ (spec_to : Flambda.specialised_to) ->
+            Variable.Map.mem spec_to.var which_variables)
+          set_of_closures.specialised_args
+      in
+      let aliasing_vars =
+        Variable.Map.disjoint_union
+          aliasing_free_vars aliasing_specialised_args
+      in
+      if not (Variable.Map.is_empty aliasing_vars) then begin
+        Variable.Map.iter (fun _ (fun_decl : Flambda.function_declaration) ->
+          (* We ignore projections from within nested sets of closures. *)
+          let _, used =
+            analyse_expr fun_decl.body ~which_variables:aliasing_vars
+          in
+          Variable.Set.iter (fun var ->
+            match Variable.Map.find var aliasing_vars with
+            | exception Not_found -> assert false
+            | spec_to -> check_free_variable spec_to.var)
+            used)
+          set_of_closures.function_decls.funs
+      end
+    | Prim (_, vars, _) ->
+      List.iter check_free_variable vars
+    | Symbol _ | Const _ | Allocated_const _ | Read_mutable _
+    | Read_symbol_field _ | Project_var _ | Project_closure _
+    | Move_within_set_of_closures _
+    | Expr _ -> ()
+  in
+  Flambda_iterators.iter_toplevel for_expr for_named expr;
+  let projections = !projections in
+  let used_which_variables = !used_which_variables in
+  projections, used_which_variables
+
+let from_function_decl ~env ~which_variables
+      ~(function_decl : Flambda.function_declaration) =
+  let projections, used_which_variables =
+    analyse_expr ~which_variables function_decl.body
+  in
+  (* We must use approximation information to determine which projections
+     are actually valid in the current environment, other we might lift
+     expressions too far. *)
+  let projections =
+    known_valid_projections ~env ~projections ~which_variables
+  in
+  (* Don't extract projections whose [projecting_from] variable is also
+     used boxed.  We could in the future consider being more sophisticated
+     about this based on the uses in the body, but given we are not doing
+     that yet, it seems safest in performance terms not to (e.g.) unbox a
+     specialised argument whose boxed version is used. *)
+  Projection.Set.filter (fun projection ->
+      let projecting_from = Projection.projecting_from projection in
+      not (Variable.Set.mem projecting_from used_which_variables))
+    projections
diff --git a/middle_end/flambda/extract_projections.mli b/middle_end/flambda/extract_projections.mli
new file mode 100644
index 00000000..47456bda
--- /dev/null
+++ b/middle_end/flambda/extract_projections.mli
@@ -0,0 +1,33 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Identify projections from variables used in function bodies (free
+    variables or specialised args, for example, according to [which_variables]
+    below).  Projections from variables that are also used boxed are not
+    returned. *)
+
+(** [which_variables] maps (existing) inner variables to (existing) outer
+    variables in the manner of [free_vars] and [specialised_args] in
+    [Flambda.set_of_closures].
+
+    The returned projections are [projecting_from] (cf. projection.mli)
+    the "existing inner vars".
+*)
+val from_function_decl
+   : env:Inline_and_simplify_aux.Env.t
+  -> which_variables:Flambda.specialised_to Variable.Map.t
+  -> function_decl:Flambda.function_declaration
+  -> Projection.Set.t
diff --git a/middle_end/flambda/find_recursive_functions.ml b/middle_end/flambda/find_recursive_functions.ml
new file mode 100644
index 00000000..e6943303
--- /dev/null
+++ b/middle_end/flambda/find_recursive_functions.ml
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+let in_function_declarations (function_decls : Flambda.function_declarations)
+      ~backend =
+  let module VCC = Strongly_connected_components.Make (Variable) in
+  let directed_graph =
+    let module B = (val backend : Backend_intf.S) in
+    Flambda_utils.fun_vars_referenced_in_decls function_decls
+      ~closure_symbol:B.closure_symbol
+  in
+  let connected_components =
+    VCC.connected_components_sorted_from_roots_to_leaf directed_graph
+  in
+  Array.fold_left (fun rec_fun -> function
+      | VCC.No_loop _ -> rec_fun
+      | VCC.Has_loop elts -> List.fold_right Variable.Set.add elts rec_fun)
+    Variable.Set.empty connected_components
diff --git a/middle_end/flambda/find_recursive_functions.mli b/middle_end/flambda/find_recursive_functions.mli
new file mode 100644
index 00000000..3c2dd5b1
--- /dev/null
+++ b/middle_end/flambda/find_recursive_functions.mli
@@ -0,0 +1,37 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** "Recursive functions" are those functions [f] that might call either:
+    - themselves, or
+    - another function that in turn might call [f].
+
+    For example in the following simultaneous definition of [f] [g] and [h],
+    [f] and [g] are recursive functions, but not [h]:
+      [let rec f x = g x
+       and g x = f x
+       and h x = g x]
+*)
+
+(** Determine the recursive functions, if any, bound by the given set of
+    function declarations.
+    This is only intended to be used by [Flambda.create_function_declarations].
+*)
+val in_function_declarations
+   : Flambda.function_declarations
+  -> backend:(module Backend_intf.S)
+  -> Variable.Set.t
diff --git a/middle_end/flambda/flambda.ml b/middle_end/flambda/flambda.ml
new file mode 100644
index 00000000..2866c697
--- /dev/null
+++ b/middle_end/flambda/flambda.ml
@@ -0,0 +1,1275 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+type call_kind =
+  | Indirect
+  | Direct of Closure_id.t
+
+type const =
+  | Int of int
+  | Char of char
+  | Const_pointer of int
+
+type apply = {
+  func : Variable.t;
+  args : Variable.t list;
+  kind : call_kind;
+  dbg : Debuginfo.t;
+  inline : Lambda.inline_attribute;
+  specialise : Lambda.specialise_attribute;
+}
+
+type assign = {
+  being_assigned : Mutable_variable.t;
+  new_value : Variable.t;
+}
+
+type send = {
+  kind : Lambda.meth_kind;
+  meth : Variable.t;
+  obj : Variable.t;
+  args : Variable.t list;
+  dbg : Debuginfo.t;
+}
+
+type project_closure = Projection.project_closure
+type move_within_set_of_closures = Projection.move_within_set_of_closures
+type project_var = Projection.project_var
+
+type specialised_to = {
+  var : Variable.t;
+  projection : Projection.t option;
+}
+
+type t =
+  | Var of Variable.t
+  | Let of let_expr
+  | Let_mutable of let_mutable
+  | Let_rec of (Variable.t * named) list * t
+  | Apply of apply
+  | Send of send
+  | Assign of assign
+  | If_then_else of Variable.t * t * t
+  | Switch of Variable.t * switch
+  | String_switch of Variable.t * (string * t) list * t option
+  | Static_raise of Static_exception.t * Variable.t list
+  | Static_catch of Static_exception.t * Variable.t list * t * t
+  | Try_with of t * Variable.t * t
+  | While of t * t
+  | For of for_loop
+  | Proved_unreachable
+
+and named =
+  | Symbol of Symbol.t
+  | Const of const
+  | Allocated_const of Allocated_const.t
+  | Read_mutable of Mutable_variable.t
+  | Read_symbol_field of Symbol.t * int
+  | Set_of_closures of set_of_closures
+  | Project_closure of project_closure
+  | Move_within_set_of_closures of move_within_set_of_closures
+  | Project_var of project_var
+  | Prim of Clambda_primitives.primitive * Variable.t list * Debuginfo.t
+  | Expr of t
+
+and let_expr = {
+  var : Variable.t;
+  defining_expr : named;
+  body : t;
+  free_vars_of_defining_expr : Variable.Set.t;
+  free_vars_of_body : Variable.Set.t;
+}
+
+and let_mutable = {
+  var : Mutable_variable.t;
+  initial_value : Variable.t;
+  contents_kind : Lambda.value_kind;
+  body : t;
+}
+
+and set_of_closures = {
+  function_decls : function_declarations;
+  free_vars : specialised_to Variable.Map.t;
+  specialised_args : specialised_to Variable.Map.t;
+  direct_call_surrogates : Variable.t Variable.Map.t;
+}
+
+and function_declarations = {
+  is_classic_mode : bool;
+  set_of_closures_id : Set_of_closures_id.t;
+  set_of_closures_origin : Set_of_closures_origin.t;
+  funs : function_declaration Variable.Map.t;
+}
+
+and function_declaration = {
+  closure_origin: Closure_origin.t;
+  params : Parameter.t list;
+  body : t;
+  free_variables : Variable.Set.t;
+  free_symbols : Symbol.Set.t;
+  stub : bool;
+  dbg : Debuginfo.t;
+  inline : Lambda.inline_attribute;
+  specialise : Lambda.specialise_attribute;
+  is_a_functor : bool;
+}
+
+and switch = {
+  numconsts : Numbers.Int.Set.t;
+  consts : (int * t) list;
+  numblocks : Numbers.Int.Set.t;
+  blocks : (int * t) list;
+  failaction : t option;
+}
+
+and for_loop = {
+  bound_var : Variable.t;
+  from_value : Variable.t;
+  to_value : Variable.t;
+  direction : Asttypes.direction_flag;
+  body : t
+}
+
+and constant_defining_value =
+  | Allocated_const of Allocated_const.t
+  | Block of Tag.t * constant_defining_value_block_field list
+  | Set_of_closures of set_of_closures  (* [free_vars] must be empty *)
+  | Project_closure of Symbol.t * Closure_id.t
+
+and constant_defining_value_block_field =
+  | Symbol of Symbol.t
+  | Const of const
+
+type expr = t
+
+type program_body =
+  | Let_symbol of Symbol.t * constant_defining_value * program_body
+  | Let_rec_symbol of (Symbol.t * constant_defining_value) list * program_body
+  | Initialize_symbol of Symbol.t * Tag.t * t list * program_body
+  | Effect of t * program_body
+  | End of Symbol.t
+
+type program = {
+  imported_symbols : Symbol.Set.t;
+  program_body : program_body;
+}
+
+let fprintf = Format.fprintf
+module Int = Numbers.Int
+
+let print_specialised_to ppf (spec_to : specialised_to) =
+  match spec_to.projection with
+  | None -> fprintf ppf "%a" Variable.print spec_to.var
+  | Some projection ->
+    fprintf ppf "%a(= %a)"
+      Variable.print spec_to.var
+      Projection.print projection
+
+(* CR-soon mshinwell: delete uses of old names *)
+let print_project_var = Projection.print_project_var
+let print_move_within_set_of_closures =
+  Projection.print_move_within_set_of_closures
+let print_project_closure = Projection.print_project_closure
+
+(** CR-someday lwhite: use better name than this *)
+let rec lam ppf (flam : t) =
+  match flam with
+  | Var (id) ->
+      Variable.print ppf id
+  | Apply({func; args; kind; inline; dbg}) ->
+    let direct ppf () =
+      match kind with
+      | Indirect -> ()
+      | Direct closure_id -> fprintf ppf "*[%a]" Closure_id.print closure_id
+    in
+    let inline ppf () =
+      match inline with
+      | Always_inline -> fprintf ppf ""
+      | Never_inline -> fprintf ppf ""
+      | Hint_inline -> fprintf ppf ""
+      | Unroll i -> fprintf ppf "" i
+      | Default_inline -> ()
+    in
+    fprintf ppf "@[<2>(apply%a%a<%s>@ %a%a)@]" direct () inline ()
+      (Debuginfo.to_string dbg)
+      Variable.print func Variable.print_list args
+  | Assign { being_assigned; new_value; } ->
+    fprintf ppf "@[<2>(assign@ %a@ %a)@]"
+      Mutable_variable.print being_assigned
+      Variable.print new_value
+  | Send { kind; meth; obj; args; dbg = _; } ->
+    let print_args ppf args =
+      List.iter (fun l -> fprintf ppf "@ %a" Variable.print l) args
+    in
+    let kind =
+      match kind with
+      | Self -> "self"
+      | Public -> "public"
+      | Cached -> "cached"
+    in
+    fprintf ppf "@[<2>(send%s@ %a@ %a%a)@]" kind
+      Variable.print obj Variable.print meth
+      print_args args
+  | Proved_unreachable ->
+      fprintf ppf "unreachable"
+  | Let { var = id; defining_expr = arg; body; _ } ->
+      let rec letbody (ul : t) =
+        match ul with
+        | Let { var = id; defining_expr = arg; body; _ } ->
+            fprintf ppf "@ @[<2>%a@ %a@]" Variable.print id print_named arg;
+            letbody body
+        | _ -> ul
+      in
+      fprintf ppf "@[<2>(let@ @[(@[<2>%a@ %a@]"
+        Variable.print id print_named arg;
+      let expr = letbody body in
+      fprintf ppf ")@]@ %a)@]" lam expr
+  | Let_mutable { var = mut_var; initial_value = var; body; contents_kind } ->
+    let print_kind ppf (kind : Lambda.value_kind) =
+      match kind with
+      | Pgenval -> ()
+      | _ -> Format.fprintf ppf " %a" Printlambda.value_kind kind
+    in
+    fprintf ppf "@[<2>(let_mutable%a@ @[<2>%a@ %a@]@ %a)@]"
+      print_kind contents_kind
+      Mutable_variable.print mut_var
+      Variable.print var
+      lam body
+  | Let_rec(id_arg_list, body) ->
+      let bindings ppf id_arg_list =
+        let spc = ref false in
+        List.iter
+          (fun (id, l) ->
+             if !spc then fprintf ppf "@ " else spc := true;
+             fprintf ppf "@[<2>%a@ %a@]" Variable.print id print_named l)
+          id_arg_list in
+      fprintf ppf
+        "@[<2>(letrec@ (@[%a@])@ %a)@]" bindings id_arg_list lam body
+  | Switch(larg, sw) ->
+      let switch ppf (sw : switch) =
+        let spc = ref false in
+        List.iter
+          (fun (n, l) ->
+             if !spc then fprintf ppf "@ " else spc := true;
+             fprintf ppf "@[case int %i:@ %a@]" n lam l)
+          sw.consts;
+        List.iter
+          (fun (n, l) ->
+             if !spc then fprintf ppf "@ " else spc := true;
+             fprintf ppf "@[case tag %i:@ %a@]" n lam l)
+          sw.blocks ;
+        begin match sw.failaction with
+        | None  -> ()
+        | Some l ->
+            if !spc then fprintf ppf "@ " else spc := true;
+            fprintf ppf "@[default:@ %a@]" lam l
+        end in
+      fprintf ppf
+        "@[<1>(%s(%i,%i) %a@ @[%a@])@]"
+        (match sw.failaction with None -> "switch*" | _ -> "switch")
+        (Int.Set.cardinal sw.numconsts)
+        (Int.Set.cardinal sw.numblocks)
+        Variable.print larg switch sw
+  | String_switch(arg, cases, default) ->
+      let switch ppf cases =
+        let spc = ref false in
+        List.iter
+         (fun (s, l) ->
+           if !spc then fprintf ppf "@ " else spc := true;
+           fprintf ppf "@[case \"%s\":@ %a@]" (String.escaped s) lam l)
+          cases;
+        begin match default with
+        | Some default ->
+            if !spc then fprintf ppf "@ " else spc := true;
+            fprintf ppf "@[default:@ %a@]" lam default
+        | None -> ()
+        end in
+      fprintf ppf
+       "@[<1>(stringswitch %a@ @[%a@])@]" Variable.print arg switch cases
+  | Static_raise (i, ls)  ->
+      let lams ppf largs =
+        List.iter (fun l -> fprintf ppf "@ %a" Variable.print l) largs in
+      fprintf ppf "@[<2>(exit@ %a%a)@]" Static_exception.print i lams ls;
+  | Static_catch(i, vars, lbody, lhandler) ->
+      fprintf ppf "@[<2>(catch@ %a@;<1 -1>with (%a%a)@ %a)@]"
+        lam lbody Static_exception.print i
+        (fun ppf vars -> match vars with
+           | [] -> ()
+           | _ ->
+               List.iter
+                 (fun x -> fprintf ppf " %a" Variable.print x)
+                 vars)
+        vars
+        lam lhandler
+  | Try_with(lbody, param, lhandler) ->
+      fprintf ppf "@[<2>(try@ %a@;<1 -1>with %a@ %a)@]"
+        lam lbody Variable.print param lam lhandler
+  | If_then_else(lcond, lif, lelse) ->
+      fprintf ppf "@[<2>(if@ %a@ then begin@ %a@ end else begin@ %a@ end)@]"
+        Variable.print lcond
+        lam lif lam lelse
+  | While(lcond, lbody) ->
+      fprintf ppf "@[<2>(while@ %a@ %a)@]" lam lcond lam lbody
+  | For { bound_var; from_value; to_value; direction; body; } ->
+    fprintf ppf "@[<2>(for %a@ %a@ %s@ %a@ %a)@]"
+      Variable.print bound_var Variable.print from_value
+      (match direction with
+        Asttypes.Upto -> "to" | Asttypes.Downto -> "downto")
+      Variable.print to_value lam body
+and print_named ppf (named : named) =
+  match named with
+  | Symbol (symbol) -> Symbol.print ppf symbol
+  | Const (cst) -> fprintf ppf "Const(%a)" print_const cst
+  | Allocated_const (cst) -> fprintf ppf "Aconst(%a)" Allocated_const.print cst
+  | Read_mutable mut_var ->
+    fprintf ppf "Read_mut(%a)" Mutable_variable.print mut_var
+  | Read_symbol_field (symbol, field) ->
+    fprintf ppf "%a.(%d)" Symbol.print symbol field
+  | Project_closure (project_closure) ->
+    print_project_closure ppf project_closure
+  | Project_var (project_var) -> print_project_var ppf project_var
+  | Move_within_set_of_closures (move_within_set_of_closures) ->
+    print_move_within_set_of_closures ppf move_within_set_of_closures
+  | Set_of_closures (set_of_closures) ->
+    print_set_of_closures ppf set_of_closures
+  | Prim(prim, args, dbg) ->
+    fprintf ppf "@[<2>(%a<%s>%a)@]" Printclambda_primitives.primitive prim
+      (Debuginfo.to_string dbg)
+      Variable.print_list args
+  | Expr expr ->
+    fprintf ppf "*%a" lam expr
+    (* lam ppf expr *)
+
+and print_function_declaration ppf var (f : function_declaration) =
+  let param ppf p =
+    Variable.print ppf (Parameter.var p)
+  in
+  let params ppf =
+    List.iter (fprintf ppf "@ %a" param) in
+  let stub =
+    if f.stub then
+      " *stub*"
+    else
+      ""
+  in
+  let is_a_functor =
+    if f.is_a_functor then
+      " *functor*"
+    else
+      ""
+  in
+  let inline =
+    match f.inline with
+    | Always_inline | Hint_inline -> " *inline*"
+    | Never_inline -> " *never_inline*"
+    | Unroll _ -> " *unroll*"
+    | Default_inline -> ""
+  in
+  let specialise =
+    match f.specialise with
+    | Always_specialise -> " *specialise*"
+    | Never_specialise -> " *never_specialise*"
+    | Default_specialise -> ""
+  in
+  fprintf ppf "@[<2>(%a%s%s%s%s@ =@ fun@[<2>%a@] ->@ @[<2>%a@])@]@ "
+    Variable.print var stub is_a_functor inline specialise
+    params f.params lam f.body
+
+and print_set_of_closures ppf (set_of_closures : set_of_closures) =
+  match set_of_closures with
+  | { function_decls; free_vars; specialised_args} ->
+    let funs ppf =
+      Variable.Map.iter (print_function_declaration ppf)
+    in
+    let vars ppf =
+      Variable.Map.iter (fun id v ->
+          fprintf ppf "@ %a -rename-> %a"
+            Variable.print id print_specialised_to v)
+    in
+    let spec ppf spec_args =
+      if not (Variable.Map.is_empty spec_args)
+      then begin
+        fprintf ppf "@ ";
+        Variable.Map.iter (fun id (spec_to : specialised_to) ->
+            fprintf ppf "@ %a := %a"
+              Variable.print id print_specialised_to spec_to)
+          spec_args
+      end
+    in
+    fprintf ppf "@[<2>(set_of_closures id=%a@ %a@ @[<2>free_vars={%a@ }@]@ \
+        @[<2>specialised_args={%a})@]@ \
+        @[<2>direct_call_surrogates=%a@]@ \
+        @[<2>set_of_closures_origin=%a@]@]]"
+      Set_of_closures_id.print function_decls.set_of_closures_id
+      funs function_decls.funs
+      vars free_vars
+      spec specialised_args
+      (Variable.Map.print Variable.print)
+      set_of_closures.direct_call_surrogates
+      Set_of_closures_origin.print function_decls.set_of_closures_origin
+
+and print_const ppf (c : const) =
+  match c with
+  | Int n -> fprintf ppf "%i" n
+  | Char c -> fprintf ppf "%C" c
+  | Const_pointer n -> fprintf ppf "%ia" n
+
+let print_function_declarations ppf (fd : function_declarations) =
+  let funs ppf =
+    Variable.Map.iter (print_function_declaration ppf)
+  in
+  fprintf ppf "@[<2>(%a)(origin = %a)@]" funs fd.funs
+    Set_of_closures_origin.print fd.set_of_closures_origin
+
+let print ppf flam =
+  fprintf ppf "%a@." lam flam
+
+let print_function_declaration ppf (var, decl) =
+  print_function_declaration ppf var decl
+
+let print_constant_defining_value ppf (const : constant_defining_value) =
+  match const with
+  | Allocated_const const ->
+    fprintf ppf "(Allocated_const %a)" Allocated_const.print const
+  | Block (tag, []) -> fprintf ppf "(Atom (tag %d))" (Tag.to_int tag)
+  | Block (tag, fields) ->
+    let print_field ppf (field : constant_defining_value_block_field) =
+      match field with
+      | Symbol symbol -> Symbol.print ppf symbol
+      | Const const -> print_const ppf const
+    in
+    let print_fields ppf =
+      List.iter (fprintf ppf "@ %a" print_field)
+    in
+    fprintf ppf "(Block (tag %d, %a))" (Tag.to_int tag)
+      print_fields fields
+  | Set_of_closures set_of_closures ->
+    fprintf ppf "@[<2>(Set_of_closures (@ %a))@]" print_set_of_closures
+      set_of_closures
+  | Project_closure (set_of_closures, closure_id) ->
+    fprintf ppf "(Project_closure (%a, %a))" Symbol.print set_of_closures
+      Closure_id.print closure_id
+
+let rec print_program_body ppf (program : program_body) =
+  let symbol_binding ppf (symbol, constant_defining_value) =
+    fprintf ppf "@[<2>(%a@ %a)@]"
+      Symbol.print symbol
+      print_constant_defining_value constant_defining_value
+  in
+  match program with
+  | Let_symbol (symbol, constant_defining_value, body) ->
+    let rec extract acc (ul : program_body) =
+      match ul with
+      | Let_symbol (symbol, constant_defining_value, body) ->
+        extract ((symbol, constant_defining_value) :: acc) body
+      | _ ->
+        List.rev acc,  ul
+    in
+    let defs, program = extract [symbol, constant_defining_value] body in
+    fprintf ppf
+      "@[<2>let_symbol@ @[%a@]@]@."
+      (Format.pp_print_list symbol_binding) defs;
+    print_program_body ppf program
+  | Let_rec_symbol (defs, program) ->
+    fprintf ppf
+      "@[<2>let_rec_symbol@ @[%a@]@]@."
+      (Format.pp_print_list symbol_binding) defs;
+    print_program_body ppf program
+  | Initialize_symbol (symbol, tag, fields, program) ->
+    fprintf ppf "@[<2>initialize_symbol@ (@[<2>%a@ %a@ %a@])@]@."
+      Symbol.print symbol
+      Tag.print tag
+      (Format.pp_print_list lam) fields;
+    print_program_body ppf program
+  | Effect (expr, program) ->
+    fprintf ppf "@[<2>effect@ %a@]@."
+      lam expr;
+    print_program_body ppf program;
+  | End root -> fprintf ppf "End %a" Symbol.print root
+
+let print_program ppf program =
+  Symbol.Set.iter (fun symbol ->
+      fprintf ppf "@[import_symbol@ %a@]@." Symbol.print symbol)
+    program.imported_symbols;
+  print_program_body ppf program.program_body
+
+let rec variables_usage ?ignore_uses_as_callee ?ignore_uses_as_argument
+    ?ignore_uses_in_project_var ~all_used_variables tree =
+  match tree with
+  | Var var -> Variable.Set.singleton var
+  | _ ->
+    let free = ref Variable.Set.empty in
+    let bound = ref Variable.Set.empty in
+    let free_variables ids = free := Variable.Set.union ids !free in
+    let free_variable fv = free := Variable.Set.add fv !free in
+    let bound_variable id = bound := Variable.Set.add id !bound in
+    (* N.B. This function assumes that all bound identifiers are distinct. *)
+    let rec aux (flam : t) : unit =
+      match flam with
+      | Var var -> free_variable var
+      | Apply { func; args; kind = _; dbg = _} ->
+        begin match ignore_uses_as_callee with
+        | None -> free_variable func
+        | Some () -> ()
+        end;
+        begin match ignore_uses_as_argument with
+        | None -> List.iter free_variable args
+        | Some () -> ()
+        end
+      | Let { var; free_vars_of_defining_expr; free_vars_of_body;
+              defining_expr; body; _ } ->
+        bound_variable var;
+        if all_used_variables
+           || Option.is_some ignore_uses_as_callee
+           || Option.is_some ignore_uses_as_argument
+           || Option.is_some ignore_uses_in_project_var
+        then begin
+          (* In these cases we can't benefit from the pre-computed free
+             variable sets. *)
+          free_variables
+            (variables_usage_named ?ignore_uses_in_project_var
+                ?ignore_uses_as_callee ?ignore_uses_as_argument
+                ~all_used_variables defining_expr);
+          aux body
+        end else begin
+          free_variables free_vars_of_defining_expr;
+          free_variables free_vars_of_body
+        end
+      | Let_mutable { initial_value = var; body; _ } ->
+        free_variable var;
+        aux body
+      | Let_rec (bindings, body) ->
+        List.iter (fun (var, defining_expr) ->
+            bound_variable var;
+            free_variables
+              (variables_usage_named ?ignore_uses_in_project_var
+                 ~all_used_variables defining_expr))
+          bindings;
+        aux body
+      | Switch (scrutinee, switch) ->
+        free_variable scrutinee;
+        List.iter (fun (_, e) -> aux e) switch.consts;
+        List.iter (fun (_, e) -> aux e) switch.blocks;
+        Option.iter aux switch.failaction
+      | String_switch (scrutinee, cases, failaction) ->
+        free_variable scrutinee;
+        List.iter (fun (_, e) -> aux e) cases;
+        Option.iter aux failaction
+      | Static_raise (_, es) ->
+        List.iter free_variable es
+      | Static_catch (_, vars, e1, e2) ->
+        List.iter bound_variable vars;
+        aux e1;
+        aux e2
+      | Try_with (e1, var, e2) ->
+        aux e1;
+        bound_variable var;
+        aux e2
+      | If_then_else (var, e1, e2) ->
+        free_variable var;
+        aux e1;
+        aux e2
+      | While (e1, e2) ->
+        aux e1;
+        aux e2
+      | For { bound_var; from_value; to_value; direction = _; body; } ->
+        bound_variable bound_var;
+        free_variable from_value;
+        free_variable to_value;
+        aux body
+      | Assign { being_assigned = _; new_value; } ->
+        free_variable new_value
+      | Send { kind = _; meth; obj; args; dbg = _ } ->
+        free_variable meth;
+        free_variable obj;
+        List.iter free_variable args;
+      | Proved_unreachable -> ()
+    in
+    aux tree;
+    if all_used_variables then
+      !free
+    else
+      Variable.Set.diff !free !bound
+
+and variables_usage_named ?ignore_uses_in_project_var
+    ?ignore_uses_as_callee ?ignore_uses_as_argument
+    ~all_used_variables named =
+  let free = ref Variable.Set.empty in
+  let free_variable fv = free := Variable.Set.add fv !free in
+  begin match named with
+  | Symbol _ | Const _ | Allocated_const _ | Read_mutable _
+  | Read_symbol_field _ -> ()
+  | Set_of_closures { free_vars; specialised_args; _ } ->
+    (* Sets of closures are, well, closed---except for the free variable and
+       specialised argument lists, which may identify variables currently in
+       scope outside of the closure. *)
+    Variable.Map.iter (fun _ (renamed_to : specialised_to) ->
+        (* We don't need to do anything with [renamed_to.projectee.var], if
+           it is present, since it would only be another free variable
+           in the same set of closures. *)
+        free_variable renamed_to.var)
+      free_vars;
+    Variable.Map.iter (fun _ (spec_to : specialised_to) ->
+        (* We don't need to do anything with [spec_to.projectee.var], if
+           it is present, since it would only be another specialised arg
+           in the same set of closures. *)
+        free_variable spec_to.var)
+      specialised_args
+  | Project_closure { set_of_closures; closure_id = _ } ->
+    free_variable set_of_closures
+  | Project_var { closure; closure_id = _; var = _ } ->
+    begin match ignore_uses_in_project_var with
+    | None -> free_variable closure
+    | Some () -> ()
+    end
+  | Move_within_set_of_closures { closure; start_from = _; move_to = _ } ->
+    free_variable closure
+  | Prim (_, args, _) -> List.iter free_variable args
+  | Expr flam ->
+    free := Variable.Set.union
+        (variables_usage ?ignore_uses_as_callee ?ignore_uses_as_argument
+           ~all_used_variables flam) !free
+  end;
+  !free
+
+let free_variables ?ignore_uses_as_callee ?ignore_uses_as_argument
+    ?ignore_uses_in_project_var tree =
+  variables_usage ?ignore_uses_as_callee ?ignore_uses_as_argument
+    ?ignore_uses_in_project_var ~all_used_variables:false tree
+
+let free_variables_named ?ignore_uses_in_project_var named =
+  variables_usage_named ?ignore_uses_in_project_var
+    ~all_used_variables:false named
+
+let used_variables ?ignore_uses_as_callee ?ignore_uses_as_argument
+    ?ignore_uses_in_project_var tree =
+  variables_usage ?ignore_uses_as_callee ?ignore_uses_as_argument
+    ?ignore_uses_in_project_var ~all_used_variables:true tree
+
+let used_variables_named ?ignore_uses_in_project_var named =
+  variables_usage_named ?ignore_uses_in_project_var
+    ~all_used_variables:true named
+
+let create_let var defining_expr body : t =
+  begin match !Clflags.dump_flambda_let with
+  | None -> ()
+  | Some stamp ->
+    Variable.debug_when_stamp_matches var ~stamp ~f:(fun () ->
+      Printf.eprintf "Creation of [Let] with stamp %d:\n%s\n%!"
+        stamp
+        (Printexc.raw_backtrace_to_string (Printexc.get_callstack max_int)))
+  end;
+  let defining_expr, free_vars_of_defining_expr =
+    match defining_expr with
+    | Expr (Let { var = var1; defining_expr; body = Var var2;
+          free_vars_of_defining_expr; _ }) when Variable.equal var1 var2 ->
+      defining_expr, free_vars_of_defining_expr
+    | _ -> defining_expr, free_variables_named defining_expr
+  in
+  Let {
+    var;
+    defining_expr;
+    body;
+    free_vars_of_defining_expr;
+    free_vars_of_body = free_variables body;
+  }
+
+let map_defining_expr_of_let let_expr ~f =
+  let defining_expr = f let_expr.defining_expr in
+  if defining_expr == let_expr.defining_expr then
+    Let let_expr
+  else
+    let free_vars_of_defining_expr =
+      free_variables_named defining_expr
+    in
+    Let {
+      var = let_expr.var;
+      defining_expr;
+      body = let_expr.body;
+      free_vars_of_defining_expr;
+      free_vars_of_body = let_expr.free_vars_of_body;
+    }
+
+let iter_lets t ~for_defining_expr ~for_last_body ~for_each_let =
+  let rec loop (t : t) =
+    match t with
+    | Let { var; defining_expr; body; _ } ->
+      for_each_let t;
+      for_defining_expr var defining_expr;
+      loop body
+    | t ->
+      for_last_body t
+  in
+  loop t
+
+let map_lets t ~for_defining_expr ~for_last_body ~after_rebuild =
+  let rec loop (t : t) ~rev_lets =
+    match t with
+    | Let { var; defining_expr; body; _ } ->
+      let new_defining_expr =
+        for_defining_expr var defining_expr
+      in
+      let original =
+        if new_defining_expr == defining_expr then
+          Some t
+        else
+          None
+      in
+      let rev_lets = (var, new_defining_expr, original) :: rev_lets in
+      loop body ~rev_lets
+    | t ->
+      let last_body = for_last_body t in
+      (* As soon as we see a change, we have to rebuild that [Let] and every
+         outer one. *)
+      let seen_change = ref (not (last_body == t)) in
+      List.fold_left (fun t (var, defining_expr, original) ->
+          let let_expr =
+            match original with
+            | Some original when not !seen_change -> original
+            | Some _ | None ->
+              seen_change := true;
+              create_let var defining_expr t
+          in
+          let new_let = after_rebuild let_expr in
+          if not (new_let == let_expr) then begin
+            seen_change := true
+          end;
+          new_let)
+        last_body
+        rev_lets
+  in
+  loop t ~rev_lets:[]
+
+(** CR-someday lwhite: Why not use two functions? *)
+type maybe_named =
+  | Is_expr of t
+  | Is_named of named
+
+let iter_general ~toplevel f f_named maybe_named =
+  let rec aux (t : t) =
+    match t with
+    | Let _ ->
+      iter_lets t
+        ~for_defining_expr:(fun _var named -> aux_named named)
+        ~for_last_body:aux
+        ~for_each_let:f
+    | _ ->
+      f t;
+      match t with
+      | Var _ | Apply _ | Assign _ | Send _ | Proved_unreachable
+      | Static_raise _ -> ()
+      | Let _ -> assert false
+      | Let_mutable { body; _ } ->
+        aux body
+      | Let_rec (defs, body) ->
+        List.iter (fun (_,l) -> aux_named l) defs;
+        aux body
+      | Try_with (f1,_,f2)
+      | While (f1,f2)
+      | Static_catch (_,_,f1,f2) ->
+        aux f1; aux f2
+      | For { body; _ } -> aux body
+      | If_then_else (_, f1, f2) ->
+        aux f1; aux f2
+      | Switch (_, sw) ->
+        List.iter (fun (_,l) -> aux l) sw.consts;
+        List.iter (fun (_,l) -> aux l) sw.blocks;
+        Option.iter aux sw.failaction
+      | String_switch (_, sw, def) ->
+        List.iter (fun (_,l) -> aux l) sw;
+        Option.iter aux def
+  and aux_named (named : named) =
+    f_named named;
+    match named with
+    | Symbol _ | Const _ | Allocated_const _ | Read_mutable _
+    | Read_symbol_field _
+    | Project_closure _ | Project_var _ | Move_within_set_of_closures _
+    | Prim _ -> ()
+    | Set_of_closures ({ function_decls = funcs; free_vars = _;
+          specialised_args = _}) ->
+      if not toplevel then begin
+        Variable.Map.iter (fun _ (decl : function_declaration) ->
+            aux decl.body)
+          funcs.funs
+      end
+    | Expr flam -> aux flam
+  in
+  match maybe_named with
+  | Is_expr expr -> aux expr
+  | Is_named named -> aux_named named
+
+module With_free_variables = struct
+  type 'a t =
+    | Expr : expr * Variable.Set.t -> expr t
+    | Named : named * Variable.Set.t -> named t
+
+  let of_defining_expr_of_let let_expr =
+    Named (let_expr.defining_expr, let_expr.free_vars_of_defining_expr)
+
+  let of_body_of_let let_expr =
+    Expr (let_expr.body, let_expr.free_vars_of_body)
+
+  let of_expr expr =
+    Expr (expr, free_variables expr)
+
+  let of_named named =
+    Named (named, free_variables_named named)
+
+  let create_let_reusing_defining_expr var (t : named t) body =
+    match t with
+    | Named (defining_expr, free_vars_of_defining_expr) ->
+      Let {
+        var;
+        defining_expr;
+        body;
+        free_vars_of_defining_expr;
+        free_vars_of_body = free_variables body;
+      }
+
+  let create_let_reusing_body var defining_expr (t : expr t) =
+    match t with
+    | Expr (body, free_vars_of_body) ->
+      Let {
+        var;
+        defining_expr;
+        body;
+        free_vars_of_defining_expr = free_variables_named defining_expr;
+        free_vars_of_body;
+      }
+
+  let create_let_reusing_both var (t1 : named t) (t2 : expr t) =
+    match t1, t2 with
+    | Named (defining_expr, free_vars_of_defining_expr),
+        Expr (body, free_vars_of_body) ->
+      Let {
+        var;
+        defining_expr;
+        body;
+        free_vars_of_defining_expr;
+        free_vars_of_body;
+      }
+
+  let expr (t : expr t) =
+    match t with
+    | Expr (expr, free_vars) -> Named (Expr expr, free_vars)
+
+  let contents (type a) (t : a t) : a =
+    match t with
+    | Expr (expr, _) -> expr
+    | Named (named, _) -> named
+
+  let free_variables (type a) (t : a t) =
+    match t with
+    | Expr (_, free_vars) -> free_vars
+    | Named (_, free_vars) -> free_vars
+end
+
+let fold_lets_option
+    t ~init
+    ~(for_defining_expr:('a -> Variable.t -> named -> 'a * Variable.t * named))
+    ~for_last_body
+    ~(filter_defining_expr:('b -> Variable.t -> named -> Variable.Set.t ->
+                            'b * Variable.t * named option)) =
+  let finish ~last_body ~acc ~rev_lets =
+    let module W = With_free_variables in
+    let acc, t =
+      List.fold_left (fun (acc, t) (var, defining_expr) ->
+          let free_vars_of_body = W.free_variables t in
+          let acc, var, defining_expr =
+            filter_defining_expr acc var defining_expr free_vars_of_body
+          in
+          match defining_expr with
+          | None -> acc, t
+          | Some defining_expr ->
+            let let_expr =
+              W.create_let_reusing_body var defining_expr t
+            in
+            acc, W.of_expr let_expr)
+        (acc, W.of_expr last_body)
+        rev_lets
+    in
+    W.contents t, acc
+  in
+  let rec loop (t : t) ~acc ~rev_lets =
+    match t with
+    | Let { var; defining_expr; body; _ } ->
+      let acc, var, defining_expr =
+        for_defining_expr acc var defining_expr
+      in
+      let rev_lets = (var, defining_expr) :: rev_lets in
+      loop body ~acc ~rev_lets
+    | t ->
+      let last_body, acc = for_last_body acc t in
+      finish ~last_body ~acc ~rev_lets
+  in
+  loop t ~acc:init ~rev_lets:[]
+
+let free_symbols_helper symbols (named : named) =
+  match named with
+  | Symbol symbol
+  | Read_symbol_field (symbol, _) -> symbols := Symbol.Set.add symbol !symbols
+  | Set_of_closures set_of_closures ->
+    Variable.Map.iter (fun _ (function_decl : function_declaration) ->
+        symbols := Symbol.Set.union function_decl.free_symbols !symbols)
+      set_of_closures.function_decls.funs
+  | _ -> ()
+
+let free_symbols expr =
+  let symbols = ref Symbol.Set.empty in
+  iter_general ~toplevel:true
+    (fun (_ : t) -> ())
+    (fun (named : named) -> free_symbols_helper symbols named)
+    (Is_expr expr);
+  !symbols
+
+let free_symbols_named named =
+  let symbols = ref Symbol.Set.empty in
+  iter_general ~toplevel:true
+    (fun (_ : t) -> ())
+    (fun (named : named) -> free_symbols_helper symbols named)
+    (Is_named named);
+  !symbols
+
+let free_symbols_allocated_constant_helper symbols
+      (const : constant_defining_value) =
+  match const with
+  | Allocated_const _ -> ()
+  | Block (_, fields) ->
+    List.iter
+      (function
+        | (Symbol s : constant_defining_value_block_field) ->
+          symbols := Symbol.Set.add s !symbols
+        | (Const _ : constant_defining_value_block_field) -> ())
+      fields
+  | Set_of_closures set_of_closures ->
+    symbols := Symbol.Set.union !symbols
+      (free_symbols_named (Set_of_closures set_of_closures))
+  | Project_closure (s, _) ->
+    symbols := Symbol.Set.add s !symbols
+
+let free_symbols_program (program : program) =
+  let symbols = ref Symbol.Set.empty in
+  let rec loop (program : program_body) =
+    match program with
+    | Let_symbol (_, const, program) ->
+      free_symbols_allocated_constant_helper symbols const;
+      loop program
+    | Let_rec_symbol (defs, program) ->
+      List.iter (fun (_, const) ->
+          free_symbols_allocated_constant_helper symbols const)
+        defs;
+      loop program
+    | Initialize_symbol (_, _, fields, program) ->
+      List.iter (fun field ->
+          symbols := Symbol.Set.union !symbols (free_symbols field))
+        fields;
+      loop program
+    | Effect (expr, program) ->
+      symbols := Symbol.Set.union !symbols (free_symbols expr);
+      loop program
+    | End symbol -> symbols := Symbol.Set.add symbol !symbols
+  in
+  (* Note that there is no need to count the [imported_symbols]. *)
+  loop program.program_body;
+  !symbols
+
+let update_body_of_function_declaration (func_decl: function_declaration)
+      ~body : function_declaration =
+  { closure_origin = func_decl.closure_origin;
+    params = func_decl.params;
+    body;
+    free_variables = free_variables body;
+    free_symbols = free_symbols body;
+    stub = func_decl.stub;
+    dbg = func_decl.dbg;
+    inline = func_decl.inline;
+    specialise = func_decl.specialise;
+    is_a_functor = func_decl.is_a_functor;
+  }
+
+let update_function_decl's_params_and_body
+      (func_decl : function_declaration) ~params ~body =
+  { closure_origin = func_decl.closure_origin;
+    params;
+    body;
+    free_variables = free_variables body;
+    free_symbols = free_symbols body;
+    stub = func_decl.stub;
+    dbg = func_decl.dbg;
+    inline = func_decl.inline;
+    specialise = func_decl.specialise;
+    is_a_functor = func_decl.is_a_functor;
+  }
+
+
+let create_function_declaration ~params ~body ~stub ~dbg
+      ~(inline : Lambda.inline_attribute)
+      ~(specialise : Lambda.specialise_attribute) ~is_a_functor
+      ~closure_origin
+      : function_declaration =
+  begin match stub, inline with
+  | true, (Never_inline | Default_inline)
+  | false, (Never_inline | Default_inline
+           | Always_inline | Hint_inline | Unroll _) -> ()
+  | true, (Always_inline | Hint_inline | Unroll _) ->
+    Misc.fatal_errorf
+      "Stubs may not be annotated as [Always_inline], \
+       [Hint_inline] or [Unroll]: %a"
+      print body
+  end;
+  begin match stub, specialise with
+  | true, (Never_specialise | Default_specialise)
+  | false, (Never_specialise | Default_specialise | Always_specialise) -> ()
+  | true, Always_specialise ->
+    Misc.fatal_errorf
+      "Stubs may not be annotated as [Always_specialise]: %a"
+      print body
+  end;
+  { closure_origin;
+    params;
+    body;
+    free_variables = free_variables body;
+    free_symbols = free_symbols body;
+    stub;
+    dbg;
+    inline;
+    specialise;
+    is_a_functor;
+  }
+
+let update_function_declaration fun_decl ~params ~body =
+  let free_variables = free_variables body in
+  let free_symbols = free_symbols body in
+  { fun_decl with params; body; free_variables; free_symbols }
+
+let create_function_declarations ~is_classic_mode ~funs =
+  let compilation_unit = Compilation_unit.get_current_exn () in
+  let set_of_closures_id = Set_of_closures_id.create compilation_unit in
+  let set_of_closures_origin =
+    Set_of_closures_origin.create set_of_closures_id
+  in
+  { is_classic_mode;
+    set_of_closures_id;
+    set_of_closures_origin;
+    funs;
+  }
+
+let create_function_declarations_with_origin
+      ~is_classic_mode ~funs ~set_of_closures_origin =
+  let compilation_unit = Compilation_unit.get_current_exn () in
+  let set_of_closures_id = Set_of_closures_id.create compilation_unit in
+  { is_classic_mode;
+    set_of_closures_id;
+    set_of_closures_origin;
+    funs;
+  }
+
+let update_function_declarations function_decls ~funs =
+  let is_classic_mode = function_decls.is_classic_mode in
+  let compilation_unit = Compilation_unit.get_current_exn () in
+  let set_of_closures_id = Set_of_closures_id.create compilation_unit in
+  let set_of_closures_origin = function_decls.set_of_closures_origin in
+  { is_classic_mode;
+    set_of_closures_id;
+    set_of_closures_origin;
+    funs;
+  }
+
+let create_function_declarations_with_closures_origin
+      ~is_classic_mode ~funs ~set_of_closures_origin =
+  let compilation_unit = Compilation_unit.get_current_exn () in
+  let set_of_closures_id = Set_of_closures_id.create compilation_unit in
+  { is_classic_mode;
+    set_of_closures_id;
+    set_of_closures_origin;
+    funs
+  }
+
+let import_function_declarations_for_pack function_decls
+      import_set_of_closures_id import_set_of_closures_origin =
+  let is_classic_mode = function_decls.is_classic_mode in
+  let set_of_closures_id =
+    import_set_of_closures_id function_decls.set_of_closures_id
+  in
+  let set_of_closures_origin =
+    import_set_of_closures_origin function_decls.set_of_closures_origin
+  in
+  let funs = function_decls.funs in
+  { is_classic_mode;
+    set_of_closures_id;
+    set_of_closures_origin;
+    funs;
+  }
+
+let create_set_of_closures ~function_decls ~free_vars ~specialised_args
+      ~direct_call_surrogates =
+  if !Clflags.flambda_invariant_checks then begin
+    let all_fun_vars = Variable.Map.keys function_decls.funs in
+    let expected_free_vars =
+      Variable.Map.fold (fun _fun_var function_decl expected_free_vars ->
+          let free_vars =
+            Variable.Set.diff function_decl.free_variables
+              (Variable.Set.union (Parameter.Set.vars function_decl.params)
+                all_fun_vars)
+          in
+          Variable.Set.union free_vars expected_free_vars)
+        function_decls.funs
+        Variable.Set.empty
+    in
+    (* CR-soon pchambart: We do not seem to be able to maintain the
+       invariant that if a variable is not used inside the closure, it
+       is not used outside either. This would be a nice property for
+       better dead code elimination during inline_and_simplify, but it
+       is not obvious how to ensure that.
+
+       This would be true when the function is known never to have
+       been inlined.
+
+       Note that something like that may maybe enforceable in
+       inline_and_simplify, but there is no way to do that on other
+       passes.
+
+       mshinwell: see CR in Flambda_invariants about this too
+    *)
+    let free_vars_domain = Variable.Map.keys free_vars in
+    if not (Variable.Set.subset expected_free_vars free_vars_domain) then begin
+      Misc.fatal_errorf "create_set_of_closures: [free_vars] mapping of \
+          variables bound by the closure(s) is wrong.  (Must map at least \
+          %a but only maps %a.)@ \nfunction_decls:@ %a"
+        Variable.Set.print expected_free_vars
+        Variable.Set.print free_vars_domain
+        print_function_declarations function_decls
+    end;
+    let all_params =
+      Variable.Map.fold (fun _fun_var function_decl all_params ->
+          Variable.Set.union (Parameter.Set.vars function_decl.params)
+            all_params)
+        function_decls.funs
+        Variable.Set.empty
+    in
+    let spec_args_domain = Variable.Map.keys specialised_args in
+    if not (Variable.Set.subset spec_args_domain all_params) then begin
+      Misc.fatal_errorf "create_set_of_closures: [specialised_args] \
+          maps variable(s) that are not parameters of the given function \
+          declarations.  specialised_args domain=%a all_params=%a \n\
+          function_decls:@ %a"
+        Variable.Set.print spec_args_domain
+        Variable.Set.print all_params
+        print_function_declarations function_decls
+    end
+  end;
+  { function_decls;
+    free_vars;
+    specialised_args;
+    direct_call_surrogates;
+  }
+
+let used_params function_decl =
+  Variable.Set.filter
+    (fun param -> Variable.Set.mem param function_decl.free_variables)
+    (Parameter.Set.vars function_decl.params)
+
+let compare_const (c1:const) (c2:const) =
+  match c1, c2 with
+  | Int i1, Int i2 -> compare i1 i2
+  | Char i1, Char i2 -> Char.compare i1 i2
+  | Const_pointer i1, Const_pointer i2 -> compare i1 i2
+  | Int _, (Char _ | Const_pointer _) -> -1
+  | (Char _ | Const_pointer _), Int _ -> 1
+  | Char _, Const_pointer _ -> -1
+  | Const_pointer _, Char _ -> 1
+
+let compare_constant_defining_value_block_field
+    (c1:constant_defining_value_block_field)
+    (c2:constant_defining_value_block_field) =
+  match c1, c2 with
+  | Symbol s1, Symbol s2 -> Symbol.compare s1 s2
+  | Const c1, Const c2 -> compare_const c1 c2
+  | Symbol _, Const _ -> -1
+  | Const _, Symbol _ -> 1
+
+module Constant_defining_value = struct
+  type t = constant_defining_value
+
+  include Identifiable.Make (struct
+    type nonrec t = t
+
+    let compare (t1 : t) (t2 : t) =
+      match t1, t2 with
+      | Allocated_const c1, Allocated_const c2 ->
+        Allocated_const.compare c1 c2
+      | Block (tag1, fields1), Block (tag2, fields2) ->
+        let c = Tag.compare tag1 tag2 in
+        if c <> 0 then c
+        else
+          Misc.Stdlib.List.compare compare_constant_defining_value_block_field
+            fields1 fields2
+      | Set_of_closures set1, Set_of_closures set2 ->
+        Set_of_closures_id.compare set1.function_decls.set_of_closures_id
+          set2.function_decls.set_of_closures_id
+      | Project_closure (set1, closure_id1),
+          Project_closure (set2, closure_id2) ->
+        let c = Symbol.compare set1 set2 in
+        if c <> 0 then c
+        else Closure_id.compare closure_id1 closure_id2
+      | Allocated_const _, Block _ -> -1
+      | Allocated_const _, Set_of_closures _ -> -1
+      | Allocated_const _, Project_closure _ -> -1
+      | Block _, Allocated_const _ -> 1
+      | Block _, Set_of_closures _ -> -1
+      | Block _, Project_closure _ -> -1
+      | Set_of_closures _, Allocated_const _ -> 1
+      | Set_of_closures _, Block _ -> 1
+      | Set_of_closures _, Project_closure _ -> -1
+      | Project_closure _, Allocated_const _ -> 1
+      | Project_closure _, Block _ -> 1
+      | Project_closure _, Set_of_closures _ -> 1
+
+    let equal t1 t2 =
+      t1 == t2 || compare t1 t2 = 0
+
+    let hash = Hashtbl.hash
+
+    let print = print_constant_defining_value
+
+    let output o v =
+      output_string o (Format.asprintf "%a" print v)
+  end)
+end
+
+let equal_call_kind (call_kind1 : call_kind) (call_kind2 : call_kind) =
+  match call_kind1, call_kind2 with
+  | Indirect, Indirect -> true
+  | Direct cid1, Direct cid2 -> Closure_id.equal cid1 cid2
+  | (Indirect | Direct _), _ -> false
+
+let equal_specialised_to (spec_to1 : specialised_to)
+      (spec_to2 : specialised_to) =
+  Variable.equal spec_to1.var spec_to2.var
+    && begin
+      match spec_to1.projection, spec_to2.projection with
+      | None, None -> true
+      | Some _, None | None, Some _ -> false
+      | Some proj1, Some proj2 -> Projection.equal proj1 proj2
+    end
+
+let compare_project_var = Projection.compare_project_var
+let compare_project_closure = Projection.compare_project_closure
+let compare_move_within_set_of_closures =
+  Projection.compare_move_within_set_of_closures
diff --git a/middle_end/flambda/flambda.mli b/middle_end/flambda/flambda.mli
new file mode 100644
index 00000000..325c15ee
--- /dev/null
+++ b/middle_end/flambda/flambda.mli
@@ -0,0 +1,713 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Intermediate language used for tree-based analysis and optimization. *)
+
+(** Whether the callee in a function application is known at compile time. *)
+type call_kind =
+  | Indirect
+  | Direct of Closure_id.t
+
+(** Simple constants.  ("Structured constants" are rewritten to invocations
+    of [Pmakeblock] so that they easily take part in optimizations.) *)
+type const =
+  | Int of int
+  | Char of char
+  (** [Char] is kept separate from [Int] to improve printing *)
+  | Const_pointer of int
+  (** [Const_pointer] is an immediate value of a type whose values may be
+     boxed (typically a variant type with both constant and non-constant
+     constructors). *)
+
+(** The application of a function to a list of arguments. *)
+type apply = {
+  (* CR-soon mshinwell: rename func -> callee, and
+     lhs_of_application -> callee *)
+  func : Variable.t;
+  args : Variable.t list;
+  kind : call_kind;
+  dbg : Debuginfo.t;
+  inline : Lambda.inline_attribute;
+  (** Instructions from the source code as to whether the callee should
+      be inlined. *)
+  specialise : Lambda.specialise_attribute;
+  (** Instructions from the source code as to whether the callee should
+      be specialised. *)
+}
+
+(** The update of a mutable variable.  Mutable variables are distinct from
+    immutable variables in Flambda. *)
+type assign = {
+  being_assigned : Mutable_variable.t;
+  new_value : Variable.t;
+}
+
+(** The invocation of a method. *)
+type send = {
+  kind : Lambda.meth_kind;
+  meth : Variable.t;
+  obj : Variable.t;
+  args : Variable.t list;
+  dbg : Debuginfo.t;
+}
+
+(** For details on these types, see projection.mli. *)
+type project_closure = Projection.project_closure
+type move_within_set_of_closures = Projection.move_within_set_of_closures
+type project_var = Projection.project_var
+
+(** See [free_vars] and [specialised_args], below. *)
+(* CR-someday mshinwell: move to separate module and make [Identifiable].
+  (Or maybe nearly Identifiable; having a special map that enforces invariants
+  might be good.) *)
+type specialised_to = {
+  var : Variable.t;
+  (** The "outer variable". *)
+  projection : Projection.t option;
+  (** The [projecting_from] value (see projection.mli) of any [projection]
+      must be another free variable or specialised argument (depending on
+      whether this record type is involved in [free_vars] or
+      [specialised_args] respectively) in the same set of closures.
+      As such, this field describes a relation of projections between
+      either the [free_vars] or the [specialised_args]. *)
+}
+
+(** Flambda terms are partitioned in a pseudo-ANF manner; many terms are
+    required to be [let]-bound.  This in particular ensures there is always
+    a variable name for an expression that may be lifted out (for example
+    if it is found to be constant).
+    Note: All bound variables in Flambda terms must be distinct.
+    [Flambda_invariants] verifies this. *)
+type t =
+  | Var of Variable.t
+  | Let of let_expr
+  | Let_mutable of let_mutable
+  | Let_rec of (Variable.t * named) list * t
+  (** CR-someday lwhite: give Let_rec the same fields as Let. *)
+  | Apply of apply
+  | Send of send
+  | Assign of assign
+  | If_then_else of Variable.t * t * t
+  | Switch of Variable.t * switch
+  | String_switch of Variable.t * (string * t) list * t option
+  (** Restrictions on [Lambda.Lstringswitch] also apply to [String_switch]. *)
+  | Static_raise of Static_exception.t * Variable.t list
+  | Static_catch of Static_exception.t * Variable.t list * t * t
+  | Try_with of t * Variable.t * t
+  | While of t * t
+  | For of for_loop
+  | Proved_unreachable
+
+(** Values of type [named] will always be [let]-bound to a [Variable.t]. *)
+and named =
+  | Symbol of Symbol.t
+  | Const of const
+  | Allocated_const of Allocated_const.t
+  | Read_mutable of Mutable_variable.t
+  | Read_symbol_field of Symbol.t * int
+  (** During the lifting of [let] bindings to [program] constructions after
+      closure conversion, we generate symbols and their corresponding
+      definitions (which may or may not be constant), together with field
+      accesses to such symbols.  We would like it to be the case that such
+      field accesses are simplified to the relevant component of the
+      symbol concerned.  (The rationale is to generate efficient code and
+      share constants as expected: see e.g. tests/asmcomp/staticalloc.ml.)
+      The components of the symbol would be identified by other symbols.
+      This sort of access pattern is feasible because the top-level structure
+      of symbols is statically allocated and fixed at compile time.
+      It may seem that [Prim (Pfield, ...)] expressions could be used to
+      perform the field accesses.  However for simplicity, to avoid having to
+      keep track of properties of individual fields of blocks,
+      [Inconstant_idents] never deems a [Prim (Pfield, ...)] expression to be
+      constant.  This would in general prevent field accesses to symbols from
+      being simplified in the way we would like, since [Lift_constants] would
+      not assign new symbols (i.e. the things we would like to simplify to)
+      to the various projections from the symbols in question.
+      To circumvent this problem we use [Read_symbol_field] when generating
+      projections from the top level of symbols.  Owing to the properties of
+      symbols described above, such expressions may be eligible for declaration
+      as constant by [Inconstant_idents] (and thus themselves lifted to another
+      symbol), without any further complication.
+      [Read_symbol_field] may only be used when the definition of the symbol
+      is in scope in the [program].  For external unresolved symbols, [Pfield]
+      may still be used; it will be changed to [Read_symbol_field] by
+      [Inline_and_simplify] when (and if) the symbol is imported. *)
+  | Set_of_closures of set_of_closures
+  | Project_closure of project_closure
+  | Move_within_set_of_closures of move_within_set_of_closures
+  | Project_var of project_var
+  | Prim of Clambda_primitives.primitive * Variable.t list * Debuginfo.t
+  | Expr of t  (** ANF escape hatch. *)
+
+(* CR-someday mshinwell: use [letcont]-style construct to remove e.g.
+   [While] and [For]. *)
+(* CR-someday mshinwell: try to produce a tighter definition of a "switch"
+   (and translate to that earlier) so that middle- and back-end code for
+   these can be reduced. *)
+(* CR-someday mshinwell: remove [Expr], but to do this easily would probably
+   require a continuation-binding construct. *)
+(* CR-someday mshinwell: Since we lack expression identifiers on every term,
+   we should probably introduce [Mutable_var] into [named] if we introduce
+   more complicated analyses on these in the future.  Alternatively, maybe
+   consider removing mutable variables altogether. *)
+
+and let_expr = private {
+  var : Variable.t;
+  defining_expr : named;
+  body : t;
+  (* CR-someday mshinwell: we could consider having these be keys into some
+     kind of global cache, to reduce memory usage. *)
+  free_vars_of_defining_expr : Variable.Set.t;
+  (** A cache of the free variables in the defining expression of the [let]. *)
+  free_vars_of_body : Variable.Set.t;
+  (** A cache of the free variables of the body of the [let].  This is an
+      important optimization. *)
+}
+
+and let_mutable = {
+  var : Mutable_variable.t;
+  initial_value : Variable.t;
+  contents_kind : Lambda.value_kind;
+  body : t;
+}
+
+(** The representation of a set of function declarations (possibly mutually
+    recursive).  Such a set encapsulates the declarations themselves,
+    information about their defining environment, and information used
+    specifically for optimization.
+    Before a function can be applied it must be "projected" from a set of
+    closures to yield a "closure".  This is done using [Project_closure]
+    (see above).  Given a closure, not only can it be applied, but information
+    about its defining environment can be retrieved (using [Project_var],
+    see above).
+    At runtime, a [set_of_closures] corresponds to an OCaml value with tag
+    [Closure_tag] (possibly with inline [Infix_tag](s)).  As an optimization,
+    an operation ([Move_within_set_of_closures]) is provided (see above)
+    which enables one closure within a set to be located given another
+    closure in the same set.  This avoids keeping a pointer to the whole set
+    of closures alive when compiling, for example, mutually-recursive
+    functions.
+*)
+and set_of_closures = private {
+  function_decls : function_declarations;
+  (* CR-soon mshinwell: consider renaming [free_vars].  Also, it's still really
+     confusing which side of this map to use when.  "Vars bound by the
+     closure" is the domain.
+     Another example of when this is confusing:
+      let bound_vars_approx =
+        Variable.Map.map (Env.find_approx env) set.free_vars
+      in
+     in [Build_export_info]. *)
+  (* CR-soon mshinwell: I'd like to arrange these maps so that it's impossible
+     to put invalid projection information into them (in particular, so that
+     we enforce that the relation stays within the domain of the map). *)
+  free_vars : specialised_to Variable.Map.t;
+  (** Mapping from all variables free in the body of the [function_decls] to
+      variables in scope at the definition point of the [set_of_closures].
+      The domain of this map is sometimes known as the "variables bound by
+      the closure". *)
+  specialised_args : specialised_to Variable.Map.t;
+  (** Parameters whose corresponding arguments are known to always alias a
+      particular value.  These are the only parameters that may, during
+      [Inline_and_simplify], have non-unknown approximations.
+
+      An argument may only be specialised to a variable in the scope of the
+      corresponding set of closures declaration.  Usually, that variable
+      itself also appears in the position of the specialised argument at
+      all call sites of the function.  However it may also be the case (for
+      example in code generated as a result of [Augment_specialised_args])
+      that the various call sites of such a function have differing
+      variables in the position of the specialised argument.  This is
+      permissible *so long as it is certain they all alias the same value*.
+      Great care must be taken in transformations that result in this
+      situation since there are no invariant checks for correctness.
+
+      As an example, supposing all call sites of f are represented here:
+        [let x = ... in
+         let f a b c = ... in
+         let y = ... in
+         f x y 1;
+         f x y 1]
+      the specialised arguments of f can (but does not necessarily) contain
+      the association [a] -> [x], but cannot contain [b] -> [y] because [f]
+      is not in the scope of [y]. If f were the recursive function
+      [let rec f a b c = f a 1 2 in], [a] -> [x] would still be a valid
+      specialised argument because all recursive calls maintain the invariant.
+
+      This information is used for optimization purposes, if such a binding is
+      known, it is possible to specialise the body of the function according
+      to its parameter. This is usually introduced when specialising a
+      recursive function, for instance.
+        [let rec map f = function
+           | [] -> []
+           | h :: t -> f h :: map f t
+         let map_succ l =
+           let succ x = x + 1 in
+           map succ l]
+      [map] can be duplicated in [map_succ] to be specialised for the argument
+      [f]. This will result in
+        [let map_succ l =
+           let succ x = x + 1 in
+           let rec map f = function
+             | [] -> []
+             | h :: t -> f h :: map f t in
+           map succ l]
+      with map having [f] -> [succ] in its [specialised_args] field.
+
+      Specialised argument information for arguments that are used must
+      never be erased.  This ensures that specialised arguments whose
+      approximations describe closures maintain those approximations, which
+      is essential to transport the closure freshening information to the
+      point of use (e.g. a [Project_var] from such an argument).
+  *)
+  direct_call_surrogates : Variable.t Variable.Map.t;
+  (** If [direct_call_surrogates] maps [fun_var1] to [fun_var2] then direct
+      calls to [fun_var1] should be redirected to [fun_var2].  This is used
+      to reduce the overhead of transformations that introduce wrapper
+      functions (which will be inlined at direct call sites, but will
+      penalise indirect call sites).
+      [direct_call_surrogates] may not be transitively closed. *)
+}
+
+and function_declarations = private {
+  is_classic_mode: bool;
+  (** Indicates whether this [function_declarations] was compiled
+      with -Oclassic. *)
+  set_of_closures_id : Set_of_closures_id.t;
+  (** An identifier (unique across all Flambda trees currently in memory)
+      of the set of closures associated with this set of function
+      declarations. *)
+  set_of_closures_origin : Set_of_closures_origin.t;
+  (** An identifier of the original set of closures on which this set of
+      function declarations is based.  Used to prevent different
+      specialisations of the same functions from being inlined/specialised
+      within each other. *)
+  funs : function_declaration Variable.Map.t;
+  (** The function(s) defined by the set of function declarations.  The
+      keys of this map are often referred to in the code as "fun_var"s. *)
+}
+
+and function_declaration = private {
+  closure_origin: Closure_origin.t;
+  params : Parameter.t list;
+  body : t;
+  (* CR-soon mshinwell: inconsistent naming free_variables/free_vars here and
+     above *)
+  free_variables : Variable.Set.t;
+  (** All variables free in the *body* of the function.  For example, a
+      variable that is bound as one of the function's parameters will still
+      be included in this set.  This field is present as an optimization. *)
+  free_symbols : Symbol.Set.t;
+  (** All symbols that occur in the function's body.  (Symbols can never be
+      bound in a function's body; the only thing that binds symbols is the
+      [program] constructions below.) *)
+  stub : bool;
+  (** A stub function is a generated function used to prepare arguments or
+      return values to allow indirect calls to functions with a special calling
+      convention.  For instance indirect calls to tuplified functions must go
+      through a stub.  Stubs will be unconditionally inlined. *)
+  dbg : Debuginfo.t;
+  (** Debug info for the function declaration. *)
+  inline : Lambda.inline_attribute;
+  (** Inlining requirements from the source code. *)
+  specialise : Lambda.specialise_attribute;
+  (** Specialising requirements from the source code. *)
+  is_a_functor : bool;
+  (** Whether the function is known definitively to be a functor. *)
+}
+
+(** Equivalent to the similar type in [Lambda]. *)
+and switch = {
+  numconsts : Numbers.Int.Set.t; (** Integer cases *)
+  consts : (int * t) list; (** Integer cases *)
+  numblocks : Numbers.Int.Set.t; (** Number of tag block cases *)
+  blocks : (int * t) list; (** Tag block cases *)
+  failaction : t option; (** Action to take if none matched *)
+}
+
+(** Equivalent to the similar type in [Lambda]. *)
+and for_loop = {
+  bound_var : Variable.t;
+  from_value : Variable.t;
+  to_value : Variable.t;
+  direction : Asttypes.direction_flag;
+  body : t
+}
+
+(** Like a subset of [Flambda.named], except that instead of [Variable.t]s we
+    have [Symbol.t]s, and everything is a constant (i.e. with a fixed value
+    known at compile time).  Values of this type describe constants that will
+    be directly assigned to symbols in the object file (see below). *)
+and constant_defining_value =
+  | Allocated_const of Allocated_const.t
+    (** A single constant.  These are never "simple constants" (type [const])
+        but instead more complicated constructions. *)
+  | Block of Tag.t * constant_defining_value_block_field list
+    (** A pre-allocated block full of constants (either simple constants
+        or references to other constants, see below). *)
+  | Set_of_closures of set_of_closures
+    (** A closed (and thus constant) set of closures.  (That is to say,
+        [free_vars] must be empty.) *)
+  | Project_closure of Symbol.t * Closure_id.t
+    (** Selection of one closure from a constant set of closures.
+        Analogous to the equivalent operation on expressions. *)
+
+and constant_defining_value_block_field =
+  | Symbol of Symbol.t
+  | Const of const
+
+module Constant_defining_value :
+  Identifiable.S with type t = constant_defining_value
+
+type expr = t
+
+(** A "program" is the contents of one compilation unit.  It describes the
+    various values that are assigned to symbols (and in some cases fields of
+    such symbols) in the object file.  As such, it is closely related to
+    the compilation of toplevel modules. *)
+type program_body =
+  | Let_symbol of Symbol.t * constant_defining_value * program_body
+  (** Define the given symbol to have the given constant value. *)
+  | Let_rec_symbol of (Symbol.t * constant_defining_value) list * program_body
+  (** As for [Let_symbol], but recursive.  This is needed to treat examples
+      like this, where a constant set of closures is lifted to toplevel:
+
+        let rec f x = f x
+
+      After lifting this produces (in pseudo-Flambda):
+
+        Let_rec_symbol set_of_closures_symbol =
+          (Set_of_closures { f x ->
+            let applied_function = Symbol f_closure in
+            Apply (applied_function, x) })
+        and f_closure = Project_closure (set_of_closures_symbol, f)
+
+      Use of [Let_rec_symbol], by virtue of the special handling in
+      [Inline_and_simplify.define_let_rec_symbol_approx], enables the
+      approximation of the set of closures to be present in order to
+      correctly simplify the [Project_closure] construction.  (See
+      [Inline_and_simplify.simplify_project_closure] for that part.) *)
+  | Initialize_symbol of Symbol.t * Tag.t * t list * program_body
+  (** Define the given symbol as a constant block of the given size and
+      tag; but with a possibly non-constant initializer.  The initializer
+      will be executed at most once (from the entry point of the compilation
+      unit). *)
+  | Effect of t * program_body
+  (** Cause the given expression, which may have a side effect, to be
+      executed.  The resulting value is discarded.  [Effect] constructions
+      are never re-ordered. *)
+  | End of Symbol.t
+  (** [End] accepts the root symbol: the only symbol that can never be
+      eliminated. *)
+
+type program = {
+  imported_symbols : Symbol.Set.t;
+  program_body : program_body;
+}
+
+(** Compute the free variables of a term.  (This is O(1) for [Let]s).
+    If [ignore_uses_as_callee], all free variables inside [Apply] expressions
+    are ignored.  Likewise [ignore_uses_in_project_var] for [Project_var]
+    expressions.
+*)
+val free_variables
+   : ?ignore_uses_as_callee:unit
+  -> ?ignore_uses_as_argument:unit
+  -> ?ignore_uses_in_project_var:unit
+  -> t
+  -> Variable.Set.t
+
+(** Compute the free variables of a named expression. *)
+val free_variables_named
+   : ?ignore_uses_in_project_var:unit
+  -> named
+  -> Variable.Set.t
+
+(** Compute _all_ variables occurring inside an expression. *)
+val used_variables
+   : ?ignore_uses_as_callee:unit
+  -> ?ignore_uses_as_argument:unit
+  -> ?ignore_uses_in_project_var:unit
+  -> t
+  -> Variable.Set.t
+
+(** Compute _all_ variables occurring inside a named expression. *)
+val used_variables_named
+   : ?ignore_uses_in_project_var:unit
+  -> named
+  -> Variable.Set.t
+
+val free_symbols : expr -> Symbol.Set.t
+
+val free_symbols_named : named -> Symbol.Set.t
+
+val free_symbols_program : program -> Symbol.Set.t
+
+(** Used to avoid exceeding the stack limit when handling expressions with
+    multiple consecutive nested [Let]-expressions.  This saves rewriting large
+    simplification functions in CPS.  This function provides for the
+    rewriting or elimination of expressions during the fold. *)
+val fold_lets_option
+   : t
+  -> init:'a
+  -> for_defining_expr:('a -> Variable.t -> named -> 'a * Variable.t * named)
+  -> for_last_body:('a -> t -> t * 'b)
+  (* CR-someday mshinwell: consider making [filter_defining_expr]
+     optional *)
+  -> filter_defining_expr:('b -> Variable.t -> named -> Variable.Set.t ->
+                           'b * Variable.t * named option)
+  -> t * 'b
+
+(** Like [fold_lets_option], but just a map. *)
+val map_lets
+   : t
+  -> for_defining_expr:(Variable.t -> named -> named)
+  -> for_last_body:(t -> t)
+  -> after_rebuild:(t -> t)
+  -> t
+
+(** Like [map_lets], but just an iterator. *)
+val iter_lets
+   : t
+  -> for_defining_expr:(Variable.t -> named -> unit)
+  -> for_last_body:(t -> unit)
+  -> for_each_let:(t -> unit)
+  -> unit
+
+(** Creates a [Let] expression.  (This computes the free variables of the
+    defining expression and the body.) *)
+val create_let : Variable.t -> named -> t -> t
+
+(** Apply the specified function [f] to the defining expression of the given
+    [Let]-expression, returning a new [Let]. *)
+val map_defining_expr_of_let : let_expr -> f:(named -> named) -> t
+
+(** A module for the manipulation of terms where the recomputation of free
+    variable sets is to be kept to a minimum. *)
+module With_free_variables : sig
+  type 'a t
+
+  (** O(1) time. *)
+  val of_defining_expr_of_let : let_expr -> named t
+
+  (** O(1) time. *)
+  val of_body_of_let : let_expr -> expr t
+
+  (** Takes the time required to calculate the free variables of the given
+      term (proportional to the size of the term, except that the calculation
+      for [Let] is O(1)). *)
+  val of_expr : expr -> expr t
+
+  val of_named : named -> named t
+
+  (** Takes the time required to calculate the free variables of the given
+      [expr]. *)
+  val create_let_reusing_defining_expr
+     : Variable.t
+    -> named t
+    -> expr
+    -> expr
+
+  (** Takes the time required to calculate the free variables of the given
+      [named]. *)
+  val create_let_reusing_body
+     : Variable.t
+    -> named
+    -> expr t
+    -> expr
+
+  (** O(1) time. *)
+  val create_let_reusing_both
+     : Variable.t
+    -> named t
+    -> expr t
+    -> expr
+
+  (** The equivalent of the [Expr] constructor. *)
+  val expr : expr t -> named t
+
+  val contents : 'a t -> 'a
+
+  (** O(1) time. *)
+  val free_variables : _ t -> Variable.Set.t
+end
+
+(** Create a function declaration.  This calculates the free variables and
+    symbols occurring in the specified [body]. *)
+val create_function_declaration
+   : params:Parameter.t list
+  -> body:t
+  -> stub:bool
+  -> dbg:Debuginfo.t
+  -> inline:Lambda.inline_attribute
+  -> specialise:Lambda.specialise_attribute
+  -> is_a_functor:bool
+  -> closure_origin:Closure_origin.t
+  -> function_declaration
+
+(** Create a function declaration based on another function declaration *)
+val update_function_declaration
+  : function_declaration
+  -> params:Parameter.t list
+  -> body:t
+  -> function_declaration
+
+(** Create a set of function declarations given the individual declarations. *)
+val create_function_declarations
+   : is_classic_mode:bool
+  -> funs:function_declaration Variable.Map.t
+  -> function_declarations
+
+(** Create a set of function declarations with a given set of closures
+    origin. *)
+val create_function_declarations_with_origin
+   : is_classic_mode:bool
+  -> funs:function_declaration Variable.Map.t
+  -> set_of_closures_origin:Set_of_closures_origin.t
+  -> function_declarations
+
+(** Change only the code of a function declaration. *)
+val update_body_of_function_declaration
+   : function_declaration
+  -> body:expr
+  -> function_declaration
+
+(** Change only the code and parameters of a function declaration. *)
+(* CR-soon mshinwell: rename this to match new update function above *)
+val update_function_decl's_params_and_body
+   : function_declaration
+  -> params:Parameter.t list
+  -> body:expr
+  -> function_declaration
+
+(** Create a set of function declarations based on another set of function
+    declarations. *)
+val update_function_declarations
+   : function_declarations
+  -> funs:function_declaration Variable.Map.t
+  -> function_declarations
+
+val create_function_declarations_with_closures_origin
+   : is_classic_mode: bool
+  -> funs:function_declaration Variable.Map.t
+  -> set_of_closures_origin:Set_of_closures_origin.t
+  -> function_declarations
+
+val import_function_declarations_for_pack
+   : function_declarations
+  -> (Set_of_closures_id.t -> Set_of_closures_id.t)
+  -> (Set_of_closures_origin.t -> Set_of_closures_origin.t)
+  -> function_declarations
+
+(** Create a set of closures.  Checks are made to ensure that [free_vars]
+    and [specialised_args] are reasonable. *)
+val create_set_of_closures
+   : function_decls:function_declarations
+  -> free_vars:specialised_to Variable.Map.t
+  -> specialised_args:specialised_to Variable.Map.t
+  -> direct_call_surrogates:Variable.t Variable.Map.t
+  -> set_of_closures
+
+(** Given a function declaration, find which of its parameters (if any)
+    are used in the body. *)
+val used_params : function_declaration -> Variable.Set.t
+
+type maybe_named =
+  | Is_expr of t
+  | Is_named of named
+
+(** This function is designed for the internal use of [Flambda_iterators].
+    See that module for iterators to be used over Flambda terms. *)
+val iter_general
+   : toplevel:bool
+  -> (t -> unit)
+  -> (named -> unit)
+  -> maybe_named
+  -> unit
+
+val print : Format.formatter -> t -> unit
+
+val print_named : Format.formatter -> named -> unit
+
+val print_program : Format.formatter -> program -> unit
+
+val print_const : Format.formatter -> const -> unit
+
+val print_constant_defining_value
+   : Format.formatter
+  -> constant_defining_value
+  -> unit
+
+val print_function_declaration
+   : Format.formatter
+  -> Variable.t * function_declaration
+  -> unit
+
+val print_function_declarations
+   : Format.formatter
+  -> function_declarations
+  -> unit
+
+val print_project_closure
+   : Format.formatter
+  -> project_closure
+  -> unit
+
+val print_move_within_set_of_closures
+   : Format.formatter
+  -> move_within_set_of_closures
+  -> unit
+
+val print_project_var
+   : Format.formatter
+  -> project_var
+  -> unit
+
+val print_set_of_closures
+   : Format.formatter
+  -> set_of_closures
+  -> unit
+
+val print_specialised_to
+   : Format.formatter
+  -> specialised_to
+  -> unit
+
+val equal_call_kind
+   : call_kind
+  -> call_kind
+  -> bool
+
+val equal_specialised_to
+   : specialised_to
+  -> specialised_to
+  -> bool
+
+val compare_const
+   : const
+  -> const
+  -> int
+
+val compare_project_var : project_var -> project_var -> int
+
+val compare_move_within_set_of_closures
+   : move_within_set_of_closures
+  -> move_within_set_of_closures
+  -> int
+
+val compare_project_closure : project_closure -> project_closure -> int
diff --git a/middle_end/flambda/flambda_invariants.ml b/middle_end/flambda/flambda_invariants.ml
new file mode 100644
index 00000000..6c2b572d
--- /dev/null
+++ b/middle_end/flambda/flambda_invariants.ml
@@ -0,0 +1,800 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+type flambda_kind =
+  | Normal
+  | Lifted
+
+(* Explicit "ignore" functions.  We name every pattern variable, avoiding
+   underscores, to try to avoid accidentally failing to handle (for example)
+   a particular variable.
+   We also avoid explicit record field access during the checking functions,
+   preferring instead to use exhaustive record matches.
+*)
+(* CR-someday pchambart: for sum types, we should probably add an exhaustive
+   pattern in ignores functions to be reminded if a type change *)
+let already_added_bound_variable_to_env (_ : Variable.t) = ()
+let will_traverse_named_expression_later (_ : Flambda.named) = ()
+let ignore_variable (_ : Variable.t) = ()
+let ignore_call_kind (_ : Flambda.call_kind) = ()
+let ignore_debuginfo (_ : Debuginfo.t) = ()
+let ignore_meth_kind (_ : Lambda.meth_kind) = ()
+let ignore_int (_ : int) = ()
+let ignore_int_set (_ : Numbers.Int.Set.t) = ()
+let ignore_bool (_ : bool) = ()
+let ignore_string (_ : string) = ()
+let ignore_static_exception (_ : Static_exception.t) = ()
+let ignore_direction_flag (_ : Asttypes.direction_flag) = ()
+let ignore_primitive ( _ : Clambda_primitives.primitive) = ()
+let ignore_const (_ : Flambda.const) = ()
+let ignore_allocated_const (_ : Allocated_const.t) = ()
+let ignore_set_of_closures_id (_ : Set_of_closures_id.t) = ()
+let ignore_set_of_closures_origin (_ : Set_of_closures_origin.t) = ()
+let ignore_closure_id (_ : Closure_id.t) = ()
+let ignore_var_within_closure (_ : Var_within_closure.t) = ()
+let ignore_tag (_ : Tag.t) = ()
+let ignore_inline_attribute (_ : Lambda.inline_attribute) = ()
+let ignore_specialise_attribute (_ : Lambda.specialise_attribute) = ()
+let ignore_value_kind (_ : Lambda.value_kind) = ()
+
+exception Binding_occurrence_not_from_current_compilation_unit of Variable.t
+exception Mutable_binding_occurrence_not_from_current_compilation_unit of
+  Mutable_variable.t
+exception Binding_occurrence_of_variable_already_bound of Variable.t
+exception Binding_occurrence_of_mutable_variable_already_bound of
+  Mutable_variable.t
+exception Binding_occurrence_of_symbol_already_bound of Symbol.t
+exception Unbound_variable of Variable.t
+exception Unbound_mutable_variable of Mutable_variable.t
+exception Unbound_symbol of Symbol.t
+exception Vars_in_function_body_not_bound_by_closure_or_params of
+  Variable.Set.t * Flambda.set_of_closures * Variable.t
+exception Function_decls_have_overlapping_parameters of Variable.Set.t
+exception Specialised_arg_that_is_not_a_parameter of Variable.t
+exception Projection_must_be_a_free_var of Projection.t
+exception Projection_must_be_a_specialised_arg of Projection.t
+exception Free_variables_set_is_lying of
+  Variable.t * Variable.Set.t * Variable.Set.t * Flambda.function_declaration
+exception Set_of_closures_free_vars_map_has_wrong_range of Variable.Set.t
+exception Static_exception_not_caught of Static_exception.t
+exception Static_exception_caught_in_multiple_places of Static_exception.t
+exception Sequential_logical_operator_primitives_must_be_expanded of
+  Clambda_primitives.primitive
+exception Var_within_closure_bound_multiple_times of Var_within_closure.t
+exception Declared_closure_from_another_unit of Compilation_unit.t
+exception Closure_id_is_bound_multiple_times of Closure_id.t
+exception Set_of_closures_id_is_bound_multiple_times of Set_of_closures_id.t
+exception Unbound_closure_ids of Closure_id.Set.t
+exception Unbound_vars_within_closures of Var_within_closure.Set.t
+exception Move_to_a_closure_not_in_the_free_variables
+  of Variable.t * Variable.Set.t
+
+exception Flambda_invariants_failed
+
+(* CR-someday mshinwell: We should make "direct applications should not have
+   overapplication" be an invariant throughout.  At the moment I think this is
+   only true after [Inline_and_simplify] has split overapplications. *)
+
+(* CR-someday mshinwell: What about checks for shadowed variables and
+   symbols? *)
+
+let variable_and_symbol_invariants (program : Flambda.program) =
+  let all_declared_variables = ref Variable.Set.empty in
+  let declare_variable var =
+    if Variable.Set.mem var !all_declared_variables then
+      raise (Binding_occurrence_of_variable_already_bound var);
+    all_declared_variables := Variable.Set.add var !all_declared_variables
+  in
+  let declare_variables vars =
+    Variable.Set.iter declare_variable vars
+  in
+  let all_declared_mutable_variables = ref Mutable_variable.Set.empty in
+  let declare_mutable_variable mut_var =
+    if Mutable_variable.Set.mem mut_var !all_declared_mutable_variables then
+      raise (Binding_occurrence_of_mutable_variable_already_bound mut_var);
+    all_declared_mutable_variables :=
+      Mutable_variable.Set.add mut_var !all_declared_mutable_variables
+  in
+  let add_binding_occurrence (var_env, mut_var_env, sym_env) var =
+    let compilation_unit = Compilation_unit.get_current_exn () in
+    if not (Variable.in_compilation_unit var compilation_unit) then
+      raise (Binding_occurrence_not_from_current_compilation_unit var);
+    declare_variable var;
+    Variable.Set.add var var_env, mut_var_env, sym_env
+  in
+  let add_mutable_binding_occurrence (var_env, mut_var_env, sym_env) mut_var =
+    let compilation_unit = Compilation_unit.get_current_exn () in
+    if not (Mutable_variable.in_compilation_unit mut_var compilation_unit) then
+      raise (Mutable_binding_occurrence_not_from_current_compilation_unit
+        mut_var);
+    declare_mutable_variable mut_var;
+    var_env, Mutable_variable.Set.add mut_var mut_var_env, sym_env
+  in
+  let add_binding_occurrence_of_symbol (var_env, mut_var_env, sym_env) sym =
+    if Symbol.Set.mem sym sym_env then
+      raise (Binding_occurrence_of_symbol_already_bound sym)
+    else
+      var_env, mut_var_env, Symbol.Set.add sym sym_env
+  in
+  let add_binding_occurrences env vars =
+    List.fold_left (fun env var -> add_binding_occurrence env var) env vars
+  in
+  let check_variable_is_bound (var_env, _, _) var =
+    if not (Variable.Set.mem var var_env) then raise (Unbound_variable var)
+  in
+  let check_symbol_is_bound (_, _, sym_env) sym =
+    if not (Symbol.Set.mem sym sym_env) then raise (Unbound_symbol sym)
+  in
+  let check_variables_are_bound env vars =
+    List.iter (check_variable_is_bound env) vars
+  in
+  let check_mutable_variable_is_bound (_, mut_var_env, _) mut_var =
+    if not (Mutable_variable.Set.mem mut_var mut_var_env) then begin
+      raise (Unbound_mutable_variable mut_var)
+    end
+  in
+  let rec loop env (flam : Flambda.t) =
+    match flam with
+    (* Expressions that can bind [Variable.t]s: *)
+    | Let { var; defining_expr; body; _ } ->
+      loop_named env defining_expr;
+      loop (add_binding_occurrence env var) body
+    | Let_mutable { var = mut_var; initial_value = var;
+                    body; contents_kind } ->
+      ignore_value_kind contents_kind;
+      check_variable_is_bound env var;
+      loop (add_mutable_binding_occurrence env mut_var) body
+    | Let_rec (defs, body) ->
+      let env =
+        List.fold_left (fun env (var, def) ->
+            will_traverse_named_expression_later def;
+            add_binding_occurrence env var)
+          env defs
+      in
+      List.iter (fun (var, def) ->
+        already_added_bound_variable_to_env var;
+        loop_named env def) defs;
+      loop env body
+    | For { bound_var; from_value; to_value; direction; body; } ->
+      ignore_direction_flag direction;
+      check_variable_is_bound env from_value;
+      check_variable_is_bound env to_value;
+      loop (add_binding_occurrence env bound_var) body
+    | Static_catch (static_exn, vars, body, handler) ->
+      ignore_static_exception static_exn;
+      loop env body;
+      loop (add_binding_occurrences env vars) handler
+    | Try_with (body, var, handler) ->
+      loop env body;
+      loop (add_binding_occurrence env var) handler
+    (* Everything else: *)
+    | Var var -> check_variable_is_bound env var
+    | Apply { func; args; kind; dbg; inline; specialise; } ->
+      check_variable_is_bound env func;
+      check_variables_are_bound env args;
+      ignore_call_kind kind;
+      ignore_debuginfo dbg;
+      ignore_inline_attribute inline;
+      ignore_specialise_attribute specialise
+    | Assign { being_assigned; new_value; } ->
+      check_mutable_variable_is_bound env being_assigned;
+      check_variable_is_bound env new_value
+    | Send { kind; meth; obj; args; dbg; } ->
+      ignore_meth_kind kind;
+      check_variable_is_bound env meth;
+      check_variable_is_bound env obj;
+      check_variables_are_bound env args;
+      ignore_debuginfo dbg
+    | If_then_else (cond, ifso, ifnot) ->
+      check_variable_is_bound env cond;
+      loop env ifso;
+      loop env ifnot
+    | Switch (arg, { numconsts; consts; numblocks; blocks; failaction; }) ->
+      check_variable_is_bound env arg;
+      ignore_int_set numconsts;
+      ignore_int_set numblocks;
+      List.iter (fun (n, e) ->
+          ignore_int n;
+          loop env e)
+        (consts @ blocks);
+      Option.iter (loop env) failaction
+    | String_switch (arg, cases, e_opt) ->
+      check_variable_is_bound env arg;
+      List.iter (fun (label, case) ->
+          ignore_string label;
+          loop env case)
+        cases;
+      Option.iter (loop env) e_opt
+    | Static_raise (static_exn, es) ->
+      ignore_static_exception static_exn;
+      List.iter (check_variable_is_bound env) es
+    | While (e1, e2) ->
+      loop env e1;
+      loop env e2
+    | Proved_unreachable -> ()
+  and loop_named env (named : Flambda.named) =
+    match named with
+    | Symbol symbol -> check_symbol_is_bound env symbol
+    | Const const -> ignore_const const
+    | Allocated_const const -> ignore_allocated_const const
+    | Read_mutable mut_var ->
+      check_mutable_variable_is_bound env mut_var
+    | Read_symbol_field (symbol, index) ->
+      check_symbol_is_bound env symbol;
+      assert (index >= 0)  (* CR-someday mshinwell: add proper error *)
+    | Set_of_closures set_of_closures ->
+      loop_set_of_closures env set_of_closures
+    | Project_closure { set_of_closures; closure_id; } ->
+      check_variable_is_bound env set_of_closures;
+      ignore_closure_id closure_id
+    | Move_within_set_of_closures { closure; start_from; move_to; } ->
+      check_variable_is_bound env closure;
+      ignore_closure_id start_from;
+      ignore_closure_id move_to;
+    | Project_var { closure; closure_id; var; } ->
+      check_variable_is_bound env closure;
+      ignore_closure_id closure_id;
+      ignore_var_within_closure var
+    | Prim (prim, args, dbg) ->
+      ignore_primitive prim;
+      check_variables_are_bound env args;
+      ignore_debuginfo dbg
+    | Expr expr ->
+      loop env expr
+  and loop_set_of_closures env
+      ({ Flambda.function_decls; free_vars; specialised_args;
+          direct_call_surrogates = _; } as set_of_closures) =
+      (* CR-soon mshinwell: check [direct_call_surrogates] *)
+    let { Flambda. is_classic_mode;
+          set_of_closures_id; set_of_closures_origin; funs; } =
+        function_decls
+      in
+      ignore (is_classic_mode : bool);
+      ignore_set_of_closures_id set_of_closures_id;
+      ignore_set_of_closures_origin set_of_closures_origin;
+      let functions_in_closure = Variable.Map.keys funs in
+      let variables_in_closure =
+        Variable.Map.fold (fun var (var_in_closure : Flambda.specialised_to)
+                  variables_in_closure ->
+            (* [var] may occur in the body, but will effectively be renamed
+               to [var_in_closure], so the latter is what we check to make
+               sure it's bound. *)
+            ignore_variable var;
+            check_variable_is_bound env var_in_closure.var;
+            Variable.Set.add var variables_in_closure)
+          free_vars Variable.Set.empty
+      in
+      let all_params, all_free_vars =
+        Variable.Map.fold (fun fun_var function_decl acc ->
+            let all_params, all_free_vars = acc in
+            (* CR-soon mshinwell: check function_decl.all_symbols *)
+            let { Flambda.params; body; free_variables; stub; dbg; _ } =
+              function_decl
+            in
+            assert (Variable.Set.mem fun_var functions_in_closure);
+            ignore_bool stub;
+            ignore_debuginfo dbg;
+            (* Check that [free_variables], which is only present as an
+               optimization, is not lying. *)
+            let free_variables' = Flambda.free_variables body in
+            if not (Variable.Set.subset free_variables' free_variables) then
+              raise (Free_variables_set_is_lying (fun_var,
+                free_variables, free_variables', function_decl));
+            (* Check that every variable free in the body of the function is
+               bound by either the set of closures or the parameter list. *)
+            let acceptable_free_variables =
+              Variable.Set.union
+                (Variable.Set.union variables_in_closure functions_in_closure)
+                (Parameter.Set.vars params)
+            in
+            let bad =
+              Variable.Set.diff free_variables acceptable_free_variables
+            in
+            if not (Variable.Set.is_empty bad) then begin
+              raise (Vars_in_function_body_not_bound_by_closure_or_params
+                (bad, set_of_closures, fun_var))
+            end;
+            (* Check that parameters are unique across all functions in the
+               declaration. *)
+            let old_all_params_size = Variable.Set.cardinal all_params in
+            let params = Parameter.Set.vars params in
+            let params_size = Variable.Set.cardinal params in
+            let all_params = Variable.Set.union all_params params in
+            let all_params_size = Variable.Set.cardinal all_params in
+            if all_params_size <> old_all_params_size + params_size then begin
+              raise (Function_decls_have_overlapping_parameters all_params)
+            end;
+            (* Check that parameters and function variables are not
+               bound somewhere else in the program *)
+            declare_variables params;
+            declare_variable fun_var;
+            (* Check that the body of the functions is correctly structured *)
+            let body_env =
+              let (var_env, _, sym_env) = env in
+              let var_env =
+                Variable.Set.fold (fun var -> Variable.Set.add var)
+                  free_variables var_env
+              in
+              (* Mutable variables cannot be captured by closures *)
+              let mut_env = Mutable_variable.Set.empty in
+              (var_env, mut_env, sym_env)
+            in
+            loop body_env body;
+            all_params, Variable.Set.union free_variables all_free_vars)
+          funs (Variable.Set.empty, Variable.Set.empty)
+      in
+      (* CR-soon pchambart: This is not a property that we can certainly
+         ensure.
+         If the function get inlined, it is possible for the inlined version
+         to still use that variable. To be able to ensure that, we need to
+         also ensure that the inlined version will certainly be transformed
+         in a same way that can drop the dependency.
+         mshinwell: This should get some thought after the first release to
+         decide for sure what to do. *)
+      (* Check that the free variables rewriting map in the set of closures
+         does not contain variables in its domain that are not actually free
+         variables of any of the function bodies. *)
+      let bad_free_vars =
+        Variable.Set.diff (Variable.Map.keys free_vars) all_free_vars
+      in
+(*
+      if not (Variable.Set.is_empty bad_free_vars) then begin
+        raise (Set_of_closures_free_vars_map_has_wrong_range bad_free_vars)
+      end;
+*)
+      (* CR-someday pchambart: Ignore it to avoid the warning: get rid of that
+         when the case is settled *)
+      ignore (Set_of_closures_free_vars_map_has_wrong_range bad_free_vars);
+      (* Check that free variables are not bound somewhere
+         else in the program *)
+      declare_variables (Variable.Map.keys free_vars);
+      (* Check that every "specialised arg" is a parameter of one of the
+         functions being declared, and that the variable to which the
+         parameter is being specialised is bound. *)
+      Variable.Map.iter (fun _inner_var
+                (specialised_to : Flambda.specialised_to) ->
+          check_variable_is_bound env specialised_to.var;
+          match specialised_to.projection with
+          | None -> ()
+          | Some projection ->
+            let projecting_from = Projection.projecting_from projection in
+            if not (Variable.Map.mem projecting_from free_vars)
+            then begin
+              raise (Projection_must_be_a_free_var projection)
+            end)
+        free_vars;
+      Variable.Map.iter (fun being_specialised
+                (specialised_to : Flambda.specialised_to) ->
+          if not (Variable.Set.mem being_specialised all_params) then begin
+            raise (Specialised_arg_that_is_not_a_parameter being_specialised)
+          end;
+          check_variable_is_bound env specialised_to.var;
+          match specialised_to.projection with
+          | None -> ()
+          | Some projection ->
+            let projecting_from = Projection.projecting_from projection in
+            if not (Variable.Map.mem projecting_from specialised_args)
+            then begin
+              raise (Projection_must_be_a_specialised_arg projection)
+            end)
+        specialised_args
+  in
+  let loop_constant_defining_value env
+        (const : Flambda.constant_defining_value) =
+    match const with
+    | Flambda.Allocated_const c ->
+      ignore_allocated_const c
+    | Flambda.Block (tag,fields) ->
+      ignore_tag tag;
+      List.iter (fun (fields : Flambda.constant_defining_value_block_field) ->
+          match fields with
+          | Const c -> ignore_const c
+          | Symbol s -> check_symbol_is_bound env s)
+        fields
+    | Flambda.Set_of_closures set_of_closures ->
+      loop_set_of_closures env set_of_closures;
+      (* Constant set of closures must not have free variables *)
+      if not (Variable.Map.is_empty set_of_closures.free_vars) then
+        assert false; (* TODO: correct error *)
+      if not (Variable.Map.is_empty set_of_closures.specialised_args) then
+        assert false; (* TODO: correct error *)
+    | Flambda.Project_closure (symbol,closure_id) ->
+      ignore_closure_id closure_id;
+      check_symbol_is_bound env symbol
+  in
+  let rec loop_program_body env (program : Flambda.program_body) =
+    match program with
+    | Let_rec_symbol (defs, program) ->
+      let env =
+        List.fold_left (fun env (symbol, _) ->
+            add_binding_occurrence_of_symbol env symbol)
+          env defs
+      in
+      List.iter (fun (_, def) ->
+          loop_constant_defining_value env def)
+        defs;
+      loop_program_body env program
+    | Let_symbol (symbol, def, program) ->
+      loop_constant_defining_value env def;
+      let env = add_binding_occurrence_of_symbol env symbol in
+      loop_program_body env program
+    | Initialize_symbol (symbol, _tag, fields, program) ->
+      List.iter (loop env) fields;
+      let env = add_binding_occurrence_of_symbol env symbol in
+      loop_program_body env program
+    | Effect (expr, program) ->
+      loop env expr;
+      loop_program_body env program
+    | End root ->
+      check_symbol_is_bound env root
+  in
+  let env =
+    Symbol.Set.fold (fun symbol env ->
+        add_binding_occurrence_of_symbol env symbol)
+      program.imported_symbols
+      (Variable.Set.empty, Mutable_variable.Set.empty, Symbol.Set.empty)
+  in
+  loop_program_body env program.program_body
+
+let primitive_invariants flam =
+  Flambda_iterators.iter_named (function
+      | Prim (prim, _, _) ->
+        begin match prim with
+        | Psequand | Psequor ->
+          raise (Sequential_logical_operator_primitives_must_be_expanded prim)
+        | _ -> ()
+        end
+      | _ -> ())
+    flam
+
+let declared_var_within_closure (flam:Flambda.program) =
+  let bound = ref Var_within_closure.Set.empty in
+  let bound_multiple_times = ref None in
+  let add_and_check var =
+    if Var_within_closure.Set.mem var !bound then begin
+      bound_multiple_times := Some var
+    end;
+    bound := Var_within_closure.Set.add var !bound
+  in
+  Flambda_iterators.iter_on_set_of_closures_of_program
+    ~f:(fun ~constant:_ { Flambda. free_vars; _ } ->
+      Variable.Map.iter (fun id _ ->
+          let var = Var_within_closure.wrap id in
+          add_and_check var)
+        free_vars)
+    flam;
+  !bound, !bound_multiple_times
+
+let no_var_within_closure_is_bound_multiple_times (flam:Flambda.program) =
+  match declared_var_within_closure flam with
+  | _, Some var -> raise (Var_within_closure_bound_multiple_times var)
+  | _, None -> ()
+
+let every_declared_closure_is_from_current_compilation_unit flam =
+  let current_compilation_unit = Compilation_unit.get_current_exn () in
+  Flambda_iterators.iter_on_sets_of_closures (fun
+        { Flambda. function_decls; _ } ->
+      let compilation_unit =
+        Set_of_closures_id.get_compilation_unit
+          function_decls.set_of_closures_id
+      in
+      if not (Compilation_unit.equal compilation_unit current_compilation_unit)
+      then raise (Declared_closure_from_another_unit compilation_unit))
+    flam
+
+let declared_closure_ids program =
+  let bound = ref Closure_id.Set.empty in
+  let bound_multiple_times = ref None in
+  let add_and_check var =
+    if Closure_id.Set.mem var !bound
+    then bound_multiple_times := Some var;
+    bound := Closure_id.Set.add var !bound
+  in
+  Flambda_iterators.iter_on_set_of_closures_of_program program
+    ~f:(fun ~constant:_ { Flambda. function_decls; _; } ->
+        Variable.Map.iter (fun id _ ->
+            let var = Closure_id.wrap id in
+            add_and_check var)
+          function_decls.funs);
+  !bound, !bound_multiple_times
+
+let no_closure_id_is_bound_multiple_times program =
+  match declared_closure_ids program with
+  | _, Some closure_id ->
+    raise (Closure_id_is_bound_multiple_times closure_id)
+  | _, None -> ()
+
+let declared_set_of_closures_ids program =
+  let bound = ref Set_of_closures_id.Set.empty in
+  let bound_multiple_times = ref None in
+  let add_and_check var =
+    if Set_of_closures_id.Set.mem var !bound
+    then bound_multiple_times := Some var;
+    bound := Set_of_closures_id.Set.add var !bound
+  in
+  Flambda_iterators.iter_on_set_of_closures_of_program program
+    ~f:(fun ~constant:_ { Flambda. function_decls; _; } ->
+        add_and_check function_decls.set_of_closures_id);
+  !bound, !bound_multiple_times
+
+let no_set_of_closures_id_is_bound_multiple_times program =
+  match declared_set_of_closures_ids program with
+  | _, Some set_of_closures_id ->
+    raise (Set_of_closures_id_is_bound_multiple_times set_of_closures_id)
+  | _, None -> ()
+
+let used_closure_ids (program:Flambda.program) =
+  let used = ref Closure_id.Set.empty in
+  let f (flam : Flambda.named) =
+    match flam with
+    | Project_closure { closure_id; _} ->
+      used := Closure_id.Set.add closure_id !used;
+    | Move_within_set_of_closures { closure = _; start_from; move_to; } ->
+      used := Closure_id.Set.add start_from !used;
+      used := Closure_id.Set.add move_to !used
+    | Project_var { closure = _; closure_id; var = _ } ->
+      used := Closure_id.Set.add closure_id !used
+    | Set_of_closures _ | Symbol _ | Const _ | Allocated_const _
+    | Prim _ | Expr _ | Read_mutable _ | Read_symbol_field _ -> ()
+  in
+  (* CR-someday pchambart: check closure_ids of constant_defining_values'
+     project_closures *)
+  Flambda_iterators.iter_named_of_program ~f program;
+  !used
+
+let used_vars_within_closures (flam:Flambda.program) =
+  let used = ref Var_within_closure.Set.empty in
+  let f (flam : Flambda.named) =
+    match flam with
+    | Project_var { closure = _; closure_id = _; var; } ->
+      used := Var_within_closure.Set.add var !used
+    | _ -> ()
+  in
+  Flambda_iterators.iter_named_of_program ~f flam;
+  !used
+
+let every_used_function_from_current_compilation_unit_is_declared
+      (program:Flambda.program) =
+  let current_compilation_unit = Compilation_unit.get_current_exn () in
+  let declared, _ = declared_closure_ids program in
+  let used = used_closure_ids program in
+  let used_from_current_unit =
+    Closure_id.Set.filter (fun cu ->
+        Closure_id.in_compilation_unit cu current_compilation_unit)
+      used
+  in
+  let counter_examples =
+    Closure_id.Set.diff used_from_current_unit declared
+  in
+  if Closure_id.Set.is_empty counter_examples
+  then ()
+  else raise (Unbound_closure_ids counter_examples)
+
+let every_used_var_within_closure_from_current_compilation_unit_is_declared
+      (flam:Flambda.program) =
+  let current_compilation_unit = Compilation_unit.get_current_exn () in
+  let declared, _ = declared_var_within_closure flam in
+  let used = used_vars_within_closures flam in
+  let used_from_current_unit =
+    Var_within_closure.Set.filter (fun cu ->
+        Var_within_closure.in_compilation_unit cu current_compilation_unit)
+      used
+  in
+  let counter_examples =
+    Var_within_closure.Set.diff used_from_current_unit declared in
+  if Var_within_closure.Set.is_empty counter_examples
+  then ()
+  else raise (Unbound_vars_within_closures counter_examples)
+
+let every_static_exception_is_caught flam =
+  let check env (flam : Flambda.t) =
+    match flam with
+    | Static_raise (exn, _) ->
+      if not (Static_exception.Set.mem exn env)
+      then raise (Static_exception_not_caught exn)
+    | _ -> ()
+  in
+  let rec loop env (flam : Flambda.t) =
+    match flam with
+    | Static_catch (i, _, body, handler) ->
+      let env = Static_exception.Set.add i env in
+      loop env handler;
+      loop env body
+    | exp ->
+      check env exp;
+      Flambda_iterators.apply_on_subexpressions (loop env)
+        (fun (_ : Flambda.named) -> ()) exp
+  in
+  loop Static_exception.Set.empty flam
+
+let every_static_exception_is_caught_at_a_single_position flam =
+  let caught = ref Static_exception.Set.empty in
+  let f (flam : Flambda.t) =
+    match flam with
+    | Static_catch (i, _, _body, _handler) ->
+      if Static_exception.Set.mem i !caught then
+        raise (Static_exception_caught_in_multiple_places i);
+      caught := Static_exception.Set.add i !caught
+    | _ -> ()
+  in
+  Flambda_iterators.iter f (fun (_ : Flambda.named) -> ()) flam
+
+let _every_move_within_set_of_closures_is_to_a_function_in_the_free_vars
+      program =
+  let moves = ref Closure_id.Map.empty in
+  Flambda_iterators.iter_named_of_program program
+    ~f:(function
+        | Move_within_set_of_closures { start_from; move_to; _ } ->
+          let moved_to =
+            try Closure_id.Map.find start_from !moves with
+            | Not_found -> Closure_id.Set.empty
+          in
+          moves :=
+            Closure_id.Map.add start_from
+              (Closure_id.Set.add move_to moved_to)
+              !moves
+        | _ -> ());
+  Flambda_iterators.iter_on_set_of_closures_of_program program
+    ~f:(fun ~constant:_ { Flambda.function_decls = { funs; _ }; _ } ->
+        Variable.Map.iter (fun fun_var { Flambda.free_variables; _ } ->
+            match Closure_id.Map.find (Closure_id.wrap fun_var) !moves with
+            | exception Not_found -> ()
+            | moved_to ->
+              let missing_dependencies =
+                Variable.Set.diff (Closure_id.unwrap_set moved_to)
+                  free_variables
+              in
+              if not (Variable.Set.is_empty missing_dependencies) then
+                raise (Move_to_a_closure_not_in_the_free_variables
+                         (fun_var, missing_dependencies)))
+          funs)
+
+let check_exn ?(kind=Normal) (flam:Flambda.program) =
+  ignore kind;
+  try
+    variable_and_symbol_invariants flam;
+    no_closure_id_is_bound_multiple_times flam;
+    no_set_of_closures_id_is_bound_multiple_times flam;
+    every_used_function_from_current_compilation_unit_is_declared flam;
+    no_var_within_closure_is_bound_multiple_times flam;
+    every_used_var_within_closure_from_current_compilation_unit_is_declared
+      flam;
+    (* CR-soon pchambart: This invariant is not maintained. It should be
+       either relaxed or reformulated. Currently, it is safe to disable it as
+       the potential related errors would result in fatal errors, not in
+       miscompilations *)
+    (* every_move_within_set_of_closures_is_to_a_function_in_the_free_vars
+        flam; *)
+    Flambda_iterators.iter_exprs_at_toplevel_of_program flam ~f:(fun flam ->
+      primitive_invariants flam;
+      every_static_exception_is_caught flam;
+      every_static_exception_is_caught_at_a_single_position flam;
+      every_declared_closure_is_from_current_compilation_unit flam)
+  with exn -> begin
+  (* CR-someday split printing code into its own function *)
+    begin match exn with
+    | Binding_occurrence_not_from_current_compilation_unit var ->
+      Format.eprintf ">> Binding occurrence of variable marked as not being \
+          from the current compilation unit: %a"
+        Variable.print var
+    | Mutable_binding_occurrence_not_from_current_compilation_unit mut_var ->
+      Format.eprintf ">> Binding occurrence of mutable variable marked as not \
+          being from the current compilation unit: %a"
+        Mutable_variable.print mut_var
+    | Binding_occurrence_of_variable_already_bound var ->
+      Format.eprintf ">> Binding occurrence of variable that was already \
+            bound: %a"
+        Variable.print var
+    | Binding_occurrence_of_mutable_variable_already_bound mut_var ->
+      Format.eprintf ">> Binding occurrence of mutable variable that was \
+            already bound: %a"
+        Mutable_variable.print mut_var
+    | Binding_occurrence_of_symbol_already_bound sym ->
+      Format.eprintf ">> Binding occurrence of symbol that was already \
+            bound: %a"
+        Symbol.print sym
+    | Unbound_variable var ->
+      Format.eprintf ">> Unbound variable: %a" Variable.print var
+    | Unbound_mutable_variable mut_var ->
+      Format.eprintf ">> Unbound mutable variable: %a"
+        Mutable_variable.print mut_var
+    | Unbound_symbol sym ->
+      Format.eprintf ">> Unbound symbol: %a %s"
+        Symbol.print sym
+        (Printexc.raw_backtrace_to_string (Printexc.get_callstack 100))
+    | Vars_in_function_body_not_bound_by_closure_or_params
+        (vars, set_of_closures, fun_var) ->
+      Format.eprintf ">> Variable(s) (%a) in the body of a function \
+          declaration (fun_var = %a) that is not bound by either the closure \
+          or the function's parameter list.  Set of closures: %a"
+        Variable.Set.print vars
+        Variable.print fun_var
+        Flambda.print_set_of_closures set_of_closures
+    | Function_decls_have_overlapping_parameters vars ->
+      Format.eprintf ">> Function declarations whose parameters overlap: \
+          %a"
+        Variable.Set.print vars
+    | Specialised_arg_that_is_not_a_parameter var ->
+      Format.eprintf ">> Variable in [specialised_args] that is not a \
+          parameter of any of the function(s) in the corresponding \
+          declaration(s): %a"
+        Variable.print var
+    | Projection_must_be_a_free_var var ->
+      Format.eprintf ">> Projection %a in [free_vars] from a variable that is \
+          not a (inner) free variable of the set of closures"
+        Projection.print var
+    | Projection_must_be_a_specialised_arg var ->
+      Format.eprintf ">> Projection %a in [specialised_args] from a variable \
+          that is not a (inner) specialised argument variable of the set of \
+          closures"
+        Projection.print var
+    | Free_variables_set_is_lying (var, claimed, calculated, function_decl) ->
+      Format.eprintf ">> Function declaration whose [free_variables] set (%a) \
+          is not a superset of the result of [Flambda.free_variables] \
+          applied to the body of the function (%a).  Declaration: %a"
+        Variable.Set.print claimed
+        Variable.Set.print calculated
+        Flambda.print_function_declaration (var, function_decl)
+    | Set_of_closures_free_vars_map_has_wrong_range vars ->
+      Format.eprintf ">> [free_vars] map in set of closures has in its range \
+          variables that are not free variables of the corresponding \
+          functions: %a"
+        Variable.Set.print vars
+    | Sequential_logical_operator_primitives_must_be_expanded prim ->
+      Format.eprintf ">> Sequential logical operator primitives must be \
+          expanded (see closure_conversion.ml): %a"
+        Printclambda_primitives.primitive prim
+    | Var_within_closure_bound_multiple_times var ->
+      Format.eprintf ">> Variable within a closure is bound multiple times: \
+          %a"
+        Var_within_closure.print var
+    | Closure_id_is_bound_multiple_times closure_id ->
+      Format.eprintf ">> Closure ID is bound multiple times: %a"
+        Closure_id.print closure_id
+    | Set_of_closures_id_is_bound_multiple_times set_of_closures_id ->
+      Format.eprintf ">> Set of closures ID is bound multiple times: %a"
+        Set_of_closures_id.print set_of_closures_id
+    | Declared_closure_from_another_unit compilation_unit ->
+      Format.eprintf ">> Closure declared as being from another compilation \
+          unit: %a"
+        Compilation_unit.print compilation_unit
+    | Unbound_closure_ids closure_ids ->
+      Format.eprintf ">> Unbound closure ID(s) from the current compilation \
+          unit: %a"
+        Closure_id.Set.print closure_ids
+    | Unbound_vars_within_closures vars_within_closures ->
+      Format.eprintf ">> Unbound variable(s) within closure(s) from the \
+          current compilation_unit: %a"
+        Var_within_closure.Set.print vars_within_closures
+    | Static_exception_not_caught static_exn ->
+      Format.eprintf ">> Uncaught static exception: %a"
+        Static_exception.print static_exn
+    | Static_exception_caught_in_multiple_places static_exn ->
+      Format.eprintf ">> Static exception caught in multiple places: %a"
+        Static_exception.print static_exn
+    | Move_to_a_closure_not_in_the_free_variables (start_from, move_to) ->
+      Format.eprintf ">> A Move_within_set_of_closures from the closure %a \
+        to closures that are not parts of its free variables: %a"
+          Variable.print start_from
+          Variable.Set.print move_to
+    | exn -> raise exn
+    end;
+    Format.eprintf "\n@?";
+    raise Flambda_invariants_failed
+  end
diff --git a/middle_end/flambda/flambda_invariants.mli b/middle_end/flambda/flambda_invariants.mli
new file mode 100644
index 00000000..252578e8
--- /dev/null
+++ b/middle_end/flambda/flambda_invariants.mli
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+type flambda_kind =
+  | Normal
+  | Lifted
+
+(** Checking of invariants on Flambda expressions.  Raises an exception if
+    a check fails. *)
+val check_exn
+   : ?kind:flambda_kind
+  -> Flambda.program
+  -> unit
diff --git a/middle_end/flambda/flambda_iterators.ml b/middle_end/flambda/flambda_iterators.ml
new file mode 100644
index 00000000..6edc4bba
--- /dev/null
+++ b/middle_end/flambda/flambda_iterators.ml
@@ -0,0 +1,808 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+let apply_on_subexpressions f f_named (flam : Flambda.t) =
+  match flam with
+  | Var _ | Apply _ | Assign _ | Send _ | Proved_unreachable
+  | Static_raise _ -> ()
+  | Let { defining_expr; body; _ } ->
+    f_named defining_expr;
+    f body
+  | Let_mutable { body; _ } ->
+    f body
+  | Let_rec (defs, body) ->
+    List.iter (fun (_,l) -> f_named l) defs;
+    f body
+  | Switch (_, sw) ->
+    List.iter (fun (_,l) -> f l) sw.consts;
+    List.iter (fun (_,l) -> f l) sw.blocks;
+    Option.iter f sw.failaction
+  | String_switch (_, sw, def) ->
+    List.iter (fun (_,l) -> f l) sw;
+    Option.iter f def
+  | Static_catch (_,_,f1,f2) ->
+    f f1; f f2;
+  | Try_with (f1,_,f2) ->
+    f f1; f f2
+  | If_then_else (_,f1, f2) ->
+    f f1;f f2
+  | While (f1,f2) ->
+    f f1; f f2
+  | For { body; _ } -> f body
+
+let rec list_map_sharing f l =
+  match l with
+  | [] -> l
+  | h :: t ->
+    let new_t = list_map_sharing f t in
+    let new_h = f h in
+    if h == new_h && t == new_t then
+      l
+    else
+      new_h :: new_t
+
+let may_map_sharing f v =
+  match v with
+  | None -> v
+  | Some s ->
+    let new_s = f s in
+    if s == new_s then
+      v
+    else
+      Some new_s
+
+let map_snd_sharing f ((a, b) as cpl) =
+  let new_b = f a b in
+  if b == new_b then
+    cpl
+  else
+    (a, new_b)
+
+let map_subexpressions f f_named (tree:Flambda.t) : Flambda.t =
+  match tree with
+  | Var _ | Apply _ | Assign _ | Send _ | Proved_unreachable
+  | Static_raise _ -> tree
+  | Let { var; defining_expr; body; _ } ->
+    let new_named = f_named var defining_expr in
+    let new_body = f body in
+    if new_named == defining_expr && new_body == body then
+      tree
+    else
+      Flambda.create_let var new_named new_body
+  | Let_rec (defs, body) ->
+    let new_defs =
+      list_map_sharing (map_snd_sharing f_named) defs
+    in
+    let new_body = f body in
+    if new_defs == defs && new_body == body then
+      tree
+    else
+      Let_rec (new_defs, new_body)
+  | Let_mutable mutable_let ->
+    let new_body = f mutable_let.body in
+    if new_body == mutable_let.body then
+      tree
+    else
+      Let_mutable { mutable_let with body = new_body }
+  | Switch (arg, sw) ->
+    let aux = map_snd_sharing (fun _ v -> f v) in
+    let new_consts = list_map_sharing aux sw.consts in
+    let new_blocks = list_map_sharing aux sw.blocks in
+    let new_failaction = may_map_sharing f sw.failaction in
+    if sw.failaction == new_failaction &&
+       new_consts == sw.consts &&
+       new_blocks == sw.blocks then
+      tree
+    else
+      let sw =
+        { sw with
+          failaction = new_failaction;
+          consts = new_consts;
+          blocks = new_blocks;
+        }
+      in
+      Switch (arg, sw)
+  | String_switch (arg, sw, def) ->
+    let new_sw = list_map_sharing (map_snd_sharing (fun _ v -> f v)) sw in
+    let new_def = may_map_sharing f def in
+    if sw == new_sw && def == new_def then
+      tree
+    else
+      String_switch(arg, new_sw, new_def)
+  | Static_catch (i, vars, body, handler) ->
+    let new_body = f body in
+    let new_handler = f handler in
+    if new_body == body && new_handler == handler then
+      tree
+    else
+      Static_catch (i, vars, new_body, new_handler)
+  | Try_with(body, id, handler) ->
+    let new_body = f body in
+    let new_handler = f handler in
+    if body == new_body && handler == new_handler then
+      tree
+    else
+      Try_with(new_body, id, new_handler)
+  | If_then_else(arg, ifso, ifnot) ->
+    let new_ifso = f ifso in
+    let new_ifnot = f ifnot in
+    if new_ifso == ifso && new_ifnot == ifnot then
+      tree
+    else
+      If_then_else(arg, new_ifso, new_ifnot)
+  | While(cond, body) ->
+    let new_cond = f cond in
+    let new_body = f body in
+    if new_cond == cond && new_body == body then
+      tree
+    else
+      While(new_cond, new_body)
+  | For { bound_var; from_value; to_value; direction; body; } ->
+    let new_body = f body in
+    if new_body == body then
+      tree
+    else
+      For { bound_var; from_value; to_value; direction; body = new_body; }
+
+let iter_general = Flambda.iter_general
+
+let iter f f_named t = iter_general ~toplevel:false f f_named (Is_expr t)
+let iter_expr f t = iter f (fun _ -> ()) t
+let iter_on_named f f_named t =
+  iter_general ~toplevel:false f f_named (Is_named t)
+let iter_named f_named t = iter (fun (_ : Flambda.t) -> ()) f_named t
+let iter_named_on_named f_named named =
+  iter_general ~toplevel:false (fun (_ : Flambda.t) -> ()) f_named
+    (Is_named named)
+
+let iter_toplevel f f_named t =
+  iter_general ~toplevel:true f f_named (Is_expr t)
+let iter_named_toplevel f f_named named =
+  iter_general ~toplevel:true f f_named (Is_named named)
+
+let iter_all_immutable_let_and_let_rec_bindings t ~f =
+  iter_expr (function
+      | Let { var; defining_expr; _ } -> f var defining_expr
+      | Let_rec (defs, _) -> List.iter (fun (var, named) -> f var named) defs
+      | _ -> ())
+    t
+
+let iter_all_toplevel_immutable_let_and_let_rec_bindings t ~f =
+  iter_general ~toplevel:true
+    (function
+      | Let { var; defining_expr; _ } -> f var defining_expr
+      | Let_rec (defs, _) -> List.iter (fun (var, named) -> f var named) defs
+      | _ -> ())
+    (fun _ -> ())
+    (Is_expr t)
+
+let iter_on_sets_of_closures f t =
+  iter_named (function
+      | Set_of_closures clos -> f clos
+      | Symbol _ | Const _ | Allocated_const _ | Read_mutable _
+      | Read_symbol_field _
+      | Project_closure _ | Move_within_set_of_closures _ | Project_var _
+      | Prim _ | Expr _ -> ())
+    t
+
+let iter_exprs_at_toplevel_of_program (program : Flambda.program) ~f =
+  let rec loop (program : Flambda.program_body) =
+    match program with
+    | Let_symbol (_, Set_of_closures set_of_closures, program) ->
+      Variable.Map.iter (fun _ (function_decl : Flambda.function_declaration) ->
+          f function_decl.body)
+        set_of_closures.function_decls.funs;
+      loop program
+    | Let_rec_symbol (defs, program) ->
+      List.iter (function
+          | (_, Flambda.Set_of_closures set_of_closures) ->
+            Variable.Map.iter
+              (fun _ (function_decl : Flambda.function_declaration) ->
+                f function_decl.body)
+              set_of_closures.function_decls.funs
+          | _ -> ()) defs;
+      loop program
+    | Let_symbol (_, _, program) ->
+      loop program
+    | Initialize_symbol (_, _, fields, program) ->
+      List.iter f fields;
+      loop program
+    | Effect (expr, program) ->
+      f expr;
+      loop program
+    | End _ -> ()
+  in
+  loop program.program_body
+
+let iter_named_of_program program ~f =
+  iter_exprs_at_toplevel_of_program program ~f:(iter_named f)
+
+let iter_on_set_of_closures_of_program (program : Flambda.program) ~f =
+  let rec loop (program : Flambda.program_body) =
+    match program with
+    | Let_symbol (_, Set_of_closures set_of_closures, program) ->
+      f ~constant:true set_of_closures;
+      Variable.Map.iter (fun _ (function_decl : Flambda.function_declaration) ->
+          iter_on_sets_of_closures (f ~constant:false) function_decl.body)
+        set_of_closures.function_decls.funs;
+      loop program
+    | Let_rec_symbol (defs, program) ->
+      List.iter (function
+          | (_, Flambda.Set_of_closures set_of_closures) ->
+            f ~constant:true set_of_closures;
+            Variable.Map.iter
+              (fun _ (function_decl : Flambda.function_declaration) ->
+                iter_on_sets_of_closures (f ~constant:false) function_decl.body)
+              set_of_closures.function_decls.funs
+          | _ -> ()) defs;
+      loop program
+    | Let_symbol (_, _, program) ->
+      loop program
+    | Initialize_symbol (_, _, fields, program) ->
+      List.iter (iter_on_sets_of_closures (f ~constant:false)) fields;
+      loop program
+    | Effect (expr, program) ->
+      iter_on_sets_of_closures (f ~constant:false) expr;
+      loop program
+    | End _ -> ()
+  in
+  loop program.program_body
+
+let iter_constant_defining_values_on_program (program : Flambda.program) ~f =
+  let rec loop (program : Flambda.program_body) =
+    match program with
+    | Let_symbol (_, const, program) ->
+      f const;
+      loop program
+    | Let_rec_symbol (defs, program) ->
+      List.iter (fun (_, const) -> f const) defs;
+      loop program
+    | Initialize_symbol (_, _, _, program) ->
+      loop program
+    | Effect (_, program) ->
+      loop program
+    | End _ -> ()
+  in
+  loop program.program_body
+
+let map_general ~toplevel f f_named tree =
+  let rec aux (tree : Flambda.t) =
+    match tree with
+    | Let _ ->
+      Flambda.map_lets tree ~for_defining_expr:aux_named ~for_last_body:aux
+        ~after_rebuild:f
+    | _ ->
+      let exp : Flambda.t =
+        match tree with
+        | Var _ | Apply _ | Assign _ | Send _ | Proved_unreachable
+        | Static_raise _ -> tree
+        | Let _ -> assert false
+        | Let_mutable mutable_let ->
+          let new_body = aux mutable_let.body in
+          if new_body == mutable_let.body then
+            tree
+          else
+            Let_mutable { mutable_let with body = new_body }
+        | Let_rec (defs, body) ->
+          let done_something = ref false in
+          let defs =
+            List.map (fun (id, lam) ->
+                id, aux_named_done_something id lam done_something)
+              defs
+          in
+          let body = aux_done_something body done_something in
+          if not !done_something then
+            tree
+          else
+            Let_rec (defs, body)
+        | Switch (arg, sw) ->
+          let done_something = ref false in
+          let sw =
+            { sw with
+              failaction =
+                begin match sw.failaction with
+                | None -> None
+                | Some failaction ->
+                  Some (aux_done_something failaction done_something)
+                end;
+              consts =
+                List.map (fun (i, v) ->
+                    i, aux_done_something v done_something)
+                  sw.consts;
+              blocks =
+                List.map (fun (i, v) ->
+                    i, aux_done_something v done_something)
+                  sw.blocks;
+            }
+          in
+          if not !done_something then
+            tree
+          else
+            Switch (arg, sw)
+        | String_switch (arg, sw, def) ->
+          let done_something = ref false in
+          let sw =
+            List.map (fun (i, v) -> i, aux_done_something v done_something) sw
+          in
+          let def =
+            match def with
+            | None -> None
+            | Some def -> Some (aux_done_something def done_something)
+          in
+          if not !done_something then
+            tree
+          else
+            String_switch(arg, sw, def)
+        | Static_catch (i, vars, body, handler) ->
+          let new_body = aux body in
+          let new_handler = aux handler in
+          if new_body == body && new_handler == handler then
+            tree
+          else
+            Static_catch (i, vars, new_body, new_handler)
+        | Try_with(body, id, handler) ->
+          let new_body = aux body in
+          let new_handler = aux handler in
+          if new_body == body && new_handler == handler then
+            tree
+          else
+            Try_with (new_body, id, new_handler)
+        | If_then_else (arg, ifso, ifnot) ->
+          let new_ifso = aux ifso in
+          let new_ifnot = aux ifnot in
+          if new_ifso == ifso && new_ifnot == ifnot then
+            tree
+          else
+            If_then_else (arg, new_ifso, new_ifnot)
+        | While (cond, body) ->
+          let new_cond = aux cond in
+          let new_body = aux body in
+          if new_cond == cond && new_body == body then
+            tree
+          else
+            While (new_cond, new_body)
+        | For { bound_var; from_value; to_value; direction; body; } ->
+          let new_body = aux body in
+          if new_body == body then
+            tree
+          else
+            For { bound_var; from_value; to_value; direction;
+              body = new_body; }
+      in
+      f exp
+  and aux_done_something expr done_something =
+    let new_expr = aux expr in
+    if not (new_expr == expr) then begin
+      done_something := true
+    end;
+    new_expr
+  and aux_named (id : Variable.t) (named : Flambda.named) =
+    let named : Flambda.named =
+      match named with
+      | Symbol _ | Const _ | Allocated_const _ | Read_mutable _
+      | Project_closure _ | Move_within_set_of_closures _ | Project_var _
+      | Prim _ | Read_symbol_field _ -> named
+      | Set_of_closures ({ function_decls; free_vars; specialised_args;
+          direct_call_surrogates }) ->
+        if toplevel then named
+        else begin
+          let done_something = ref false in
+          let funs =
+            Variable.Map.map (fun (func_decl : Flambda.function_declaration) ->
+                let new_body = aux func_decl.body in
+                if new_body == func_decl.body then begin
+                  func_decl
+                end else begin
+                  done_something := true;
+                  Flambda.update_function_declaration func_decl
+                    ~params:func_decl.params ~body:new_body
+                end)
+              function_decls.funs
+          in
+          if not !done_something then
+            named
+          else
+            let function_decls =
+              Flambda.update_function_declarations function_decls ~funs
+            in
+            let set_of_closures =
+              Flambda.create_set_of_closures ~function_decls ~free_vars
+                ~specialised_args ~direct_call_surrogates
+            in
+            Set_of_closures set_of_closures
+        end
+      | Expr expr ->
+        let new_expr = aux expr in
+        if new_expr == expr then named
+        else Expr new_expr
+    in
+    f_named id named
+  and aux_named_done_something id named done_something =
+    let new_named = aux_named id named in
+    if not (new_named == named) then begin
+      done_something := true
+    end;
+    new_named
+  in
+  aux tree
+
+let iter_apply_on_program program ~f =
+  iter_exprs_at_toplevel_of_program program ~f:(fun expr ->
+    iter (function
+        | Apply apply -> f apply
+        | _ -> ())
+      (fun _ -> ())
+      expr)
+
+let map f f_named tree =
+  map_general ~toplevel:false f (fun _ n -> f_named n) tree
+let map_expr f tree = map f (fun named -> named) tree
+let map_named f_named tree = map (fun expr -> expr) f_named tree
+let map_named_with_id f_named tree =
+  map_general ~toplevel:false (fun expr -> expr) f_named tree
+let map_toplevel f f_named tree =
+  map_general ~toplevel:true f (fun _ n -> f_named n) tree
+let map_toplevel_expr f_expr tree =
+  map_toplevel f_expr (fun named -> named) tree
+let map_toplevel_named f_named tree =
+  map_toplevel (fun tree -> tree) f_named tree
+
+let map_symbols tree ~f =
+  map_named (function
+      | (Symbol sym) as named ->
+        let new_sym = f sym in
+        if new_sym == sym then
+          named
+        else
+          Symbol new_sym
+      | ((Read_symbol_field (sym, field)) as named) ->
+        let new_sym = f sym in
+        if new_sym == sym then
+          named
+        else
+          Read_symbol_field (new_sym, field)
+      | (Const _ | Allocated_const _ | Set_of_closures _ | Read_mutable _
+      | Project_closure _ | Move_within_set_of_closures _ | Project_var _
+      | Prim _ | Expr _) as named -> named)
+    tree
+
+let map_symbols_on_set_of_closures
+    ({ Flambda.function_decls; free_vars; specialised_args;
+        direct_call_surrogates; } as
+      set_of_closures)
+    ~f =
+  let done_something = ref false in
+  let funs =
+    Variable.Map.map (fun (func_decl : Flambda.function_declaration) ->
+        let body = map_symbols func_decl.body ~f in
+        if not (body == func_decl.body) then begin
+          done_something := true;
+        end;
+        Flambda.update_function_declaration func_decl
+          ~params:func_decl.params ~body)
+      function_decls.funs
+  in
+  if not !done_something then
+    set_of_closures
+  else
+    let function_decls =
+      Flambda.update_function_declarations function_decls ~funs
+    in
+    Flambda.create_set_of_closures ~function_decls ~free_vars
+      ~specialised_args ~direct_call_surrogates
+
+let map_toplevel_sets_of_closures tree ~f =
+  map_toplevel_named (function
+      | (Set_of_closures set_of_closures) as named ->
+        let new_set_of_closures = f set_of_closures in
+        if new_set_of_closures == set_of_closures then
+          named
+        else
+          Set_of_closures new_set_of_closures
+      | (Symbol _ | Const _ | Allocated_const _ | Read_mutable _
+      | Read_symbol_field _
+      | Project_closure _ | Move_within_set_of_closures _ | Project_var _
+      | Prim _ | Expr _) as named -> named)
+    tree
+
+let map_apply tree ~f =
+  map (function
+      | (Apply apply) as expr ->
+        let new_apply = f apply in
+        if new_apply == apply then
+          expr
+        else
+          Apply new_apply
+      | expr -> expr)
+    (fun named -> named)
+    tree
+
+let map_sets_of_closures tree ~f =
+  map_named (function
+      | (Set_of_closures set_of_closures) as named ->
+        let new_set_of_closures = f set_of_closures in
+        if new_set_of_closures == set_of_closures then
+          named
+        else
+          Set_of_closures new_set_of_closures
+      | (Symbol _ | Const _ | Allocated_const _ | Project_closure _
+      | Move_within_set_of_closures _ | Project_var _
+      | Prim _ | Expr _ | Read_mutable _
+      | Read_symbol_field _) as named -> named)
+    tree
+
+let map_project_var_to_expr_opt tree ~f =
+  map_named (function
+      | (Project_var project_var) as named ->
+        begin match f project_var with
+        | None -> named
+        | Some expr -> Expr expr
+        end
+      | (Symbol _ | Const _ | Allocated_const _
+      | Set_of_closures _ | Project_closure _ | Move_within_set_of_closures _
+      | Prim _ | Expr _ | Read_mutable _ | Read_symbol_field _)
+          as named -> named)
+    tree
+
+let map_project_var_to_named_opt tree ~f =
+  map_named (function
+      | (Project_var project_var) as named ->
+        begin match f project_var with
+        | None -> named
+        | Some named -> named
+        end
+      | (Symbol _ | Const _ | Allocated_const _
+      | Set_of_closures _ | Project_closure _ | Move_within_set_of_closures _
+      | Prim _ | Expr _ | Read_mutable _ | Read_symbol_field _)
+          as named -> named)
+    tree
+
+let map_function_bodies (set_of_closures : Flambda.set_of_closures) ~f =
+  let done_something = ref false in
+  let funs =
+    Variable.Map.map (fun (function_decl : Flambda.function_declaration) ->
+        let new_body = f function_decl.body in
+        if new_body == function_decl.body then
+          function_decl
+        else begin
+          done_something := true;
+          Flambda.update_function_declaration function_decl
+            ~body:new_body ~params:function_decl.params
+        end)
+      set_of_closures.function_decls.funs
+  in
+  if not !done_something then
+    set_of_closures
+  else
+    let function_decls =
+      Flambda.update_function_declarations set_of_closures.function_decls ~funs
+    in
+    Flambda.create_set_of_closures
+      ~function_decls
+      ~free_vars:set_of_closures.free_vars
+      ~specialised_args:set_of_closures.specialised_args
+      ~direct_call_surrogates:set_of_closures.direct_call_surrogates
+
+let map_sets_of_closures_of_program (program : Flambda.program)
+    ~(f : Flambda.set_of_closures -> Flambda.set_of_closures) =
+  let rec loop (program : Flambda.program_body) : Flambda.program_body =
+    let map_constant_set_of_closures (set_of_closures:Flambda.set_of_closures) =
+      let done_something = ref false in
+      let function_decls =
+        let funs =
+          Variable.Map.map (fun
+                  (function_decl : Flambda.function_declaration) ->
+              let body = map_sets_of_closures ~f function_decl.body in
+              if body == function_decl.body then
+                function_decl
+              else begin
+                done_something := true;
+                Flambda.update_function_declaration function_decl
+                  ~body ~params:function_decl.params
+              end)
+            set_of_closures.function_decls.funs
+        in
+        if not !done_something then
+          set_of_closures.function_decls
+        else
+          Flambda.update_function_declarations set_of_closures.function_decls
+            ~funs
+      in
+      let new_set_of_closures = f set_of_closures in
+      if new_set_of_closures == set_of_closures then
+        set_of_closures
+      else
+        Flambda.create_set_of_closures ~function_decls
+          ~free_vars:set_of_closures.free_vars
+          ~specialised_args:set_of_closures.specialised_args
+          ~direct_call_surrogates:set_of_closures.direct_call_surrogates
+    in
+    match program with
+    | Let_symbol (symbol, Set_of_closures set_of_closures, program') ->
+      let new_set_of_closures = map_constant_set_of_closures set_of_closures in
+      let new_program' = loop program' in
+      if new_set_of_closures == set_of_closures
+          && new_program' == program' then
+        program
+      else
+        Let_symbol (symbol, Set_of_closures new_set_of_closures, new_program')
+    | Let_symbol (symbol, const, program') ->
+      let new_program' = loop program' in
+      if new_program' == program' then
+        program
+      else
+        Let_symbol (symbol, const, new_program')
+    | Let_rec_symbol (defs, program') ->
+      let done_something = ref false in
+      let defs =
+        List.map (function
+            | (var, Flambda.Set_of_closures set_of_closures) ->
+              let new_set_of_closures =
+                map_constant_set_of_closures set_of_closures
+              in
+              if not (new_set_of_closures == set_of_closures) then begin
+                done_something := true
+              end;
+              var, Flambda.Set_of_closures new_set_of_closures
+            | def -> def)
+          defs
+      in
+      let new_program' = loop program' in
+      if new_program' == program' && not !done_something then
+        program
+      else
+        Let_rec_symbol (defs, loop program')
+    | Initialize_symbol (symbol, tag, fields, program') ->
+      let done_something = ref false in
+      let fields =
+        List.map (fun field ->
+            let new_field = map_sets_of_closures field ~f in
+            if not (new_field == field) then begin
+              done_something := true
+            end;
+            new_field)
+          fields
+      in
+      let new_program' = loop program' in
+      if new_program' == program' && not !done_something then
+        program
+      else
+        Initialize_symbol (symbol, tag, fields, new_program')
+    | Effect (expr, program') ->
+      let new_expr = map_sets_of_closures expr ~f in
+      let new_program' = loop program' in
+      if new_expr == expr && new_program' == program' then
+        program
+      else
+        Effect (new_expr, new_program')
+    | End _ -> program
+  in
+  { program with
+    program_body = loop program.program_body;
+  }
+
+let map_exprs_at_toplevel_of_program (program : Flambda.program)
+    ~(f : Flambda.t -> Flambda.t) =
+  let rec loop (program : Flambda.program_body) : Flambda.program_body =
+    let map_constant_set_of_closures (set_of_closures:Flambda.set_of_closures) =
+      let done_something = ref false in
+      let funs =
+        Variable.Map.map (fun (function_decl : Flambda.function_declaration) ->
+            let body = f function_decl.body in
+            if body == function_decl.body then
+              function_decl
+            else begin
+              done_something := true;
+              Flambda.update_function_declaration function_decl
+                ~body ~params:function_decl.params
+            end)
+          set_of_closures.function_decls.funs
+      in
+      if not !done_something then
+        set_of_closures
+      else
+        let function_decls =
+          Flambda.update_function_declarations set_of_closures.function_decls
+            ~funs
+        in
+        Flambda.create_set_of_closures ~function_decls
+          ~free_vars:set_of_closures.free_vars
+          ~specialised_args:set_of_closures.specialised_args
+          ~direct_call_surrogates:set_of_closures.direct_call_surrogates
+    in
+    (* CR-soon mshinwell: code very similar to the above function *)
+    match program with
+    | Let_symbol (symbol, Set_of_closures set_of_closures, program') ->
+      let new_set_of_closures = map_constant_set_of_closures set_of_closures in
+      let new_program' = loop program' in
+      if new_set_of_closures == set_of_closures
+          && new_program' == program' then
+        program
+      else
+        Let_symbol (symbol, Set_of_closures new_set_of_closures, new_program')
+    | Let_symbol (symbol, const, program') ->
+      let new_program' = loop program' in
+      if new_program' == program' then
+        program
+      else
+        Let_symbol (symbol, const, new_program')
+    | Let_rec_symbol (defs, program') ->
+      let done_something = ref false in
+      let defs =
+        List.map (function
+            | (var, Flambda.Set_of_closures set_of_closures) ->
+              let new_set_of_closures =
+                map_constant_set_of_closures set_of_closures
+              in
+              if not (new_set_of_closures == set_of_closures) then begin
+                done_something := true
+              end;
+              var, Flambda.Set_of_closures new_set_of_closures
+            | def -> def)
+          defs
+      in
+      let new_program' = loop program' in
+      if new_program' == program' && not !done_something then
+        program
+      else
+        Let_rec_symbol (defs, new_program')
+    | Initialize_symbol (symbol, tag, fields, program') ->
+      let done_something = ref false in
+      let fields =
+        List.map (fun field ->
+            let new_field = f field in
+            if not (new_field == field) then begin
+              done_something := true
+            end;
+            new_field)
+          fields
+      in
+      let new_program' = loop program' in
+      if new_program' == program' && not !done_something then
+        program
+      else
+        Initialize_symbol (symbol, tag, fields, new_program')
+    | Effect (expr, program') ->
+      let new_expr = f expr in
+      let new_program' = loop program' in
+      if new_expr == expr && new_program' == program' then
+        program
+      else
+        Effect (new_expr, new_program')
+    | End _ -> program
+  in
+  { program with
+    program_body = loop program.program_body;
+  }
+
+let map_named_of_program (program : Flambda.program)
+      ~(f : Variable.t -> Flambda.named -> Flambda.named) : Flambda.program =
+  map_exprs_at_toplevel_of_program program
+      ~f:(fun expr -> map_named_with_id f expr)
+
+let map_all_immutable_let_and_let_rec_bindings (expr : Flambda.t)
+      ~(f : Variable.t -> Flambda.named -> Flambda.named) : Flambda.t =
+  map_named_with_id f expr
+
+let fold_function_decls_ignoring_stubs
+      (set_of_closures : Flambda.set_of_closures) ~init ~f =
+  Variable.Map.fold (fun fun_var function_decl acc ->
+      f ~fun_var ~function_decl acc)
+    set_of_closures.function_decls.funs
+    init
diff --git a/middle_end/flambda/flambda_iterators.mli b/middle_end/flambda/flambda_iterators.mli
new file mode 100644
index 00000000..02fe6850
--- /dev/null
+++ b/middle_end/flambda/flambda_iterators.mli
@@ -0,0 +1,227 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(* CR-soon mshinwell: we need to document whether these iterators follow any
+   particular order. *)
+
+(** Apply the given functions to the immediate subexpressions of the given
+    Flambda expression.  For avoidance of doubt, if a subexpression is
+    [Expr], it is passed to the function taking [Flambda.named], rather
+    than being followed and passed to the function taking [Flambda.t]. *)
+val apply_on_subexpressions
+   : (Flambda.t -> unit)
+  -> (Flambda.named -> unit)
+  -> Flambda.t
+  -> unit
+
+val map_subexpressions
+   : (Flambda.t -> Flambda.t)
+  -> (Variable.t -> Flambda.named -> Flambda.named)
+  -> Flambda.t
+  -> Flambda.t
+
+(* CR-soon lwhite: add comment to clarify that these recurse unlike the
+   ones above *)
+val iter
+   : (Flambda.t -> unit)
+  -> (Flambda.named -> unit)
+  -> Flambda.t
+  -> unit
+
+val iter_expr
+   : (Flambda.t -> unit)
+  -> Flambda.t
+  -> unit
+
+val iter_on_named
+   : (Flambda.t -> unit)
+  -> (Flambda.named -> unit)
+  -> Flambda.named
+  -> unit
+
+(* CR-someday mshinwell: we might need to add the corresponding variable to
+   the parameters of the user function for [iter_named] *)
+val iter_named
+   : (Flambda.named -> unit)
+  -> Flambda.t
+  -> unit
+
+(* CR-someday lwhite: These names are pretty indecipherable, perhaps
+   create submodules for the normal and "on_named" variants of each
+   function. *)
+
+val iter_named_on_named
+   : (Flambda.named -> unit)
+  -> Flambda.named
+  -> unit
+
+(** [iter_toplevel f t] applies [f] on every toplevel subexpression of [t].
+    In particular, it never applies [f] to the body of a function (which
+    will always be contained within an [Set_of_closures] expression). *)
+val iter_toplevel
+   : (Flambda.t -> unit)
+  -> (Flambda.named -> unit)
+  -> Flambda.t
+  -> unit
+
+val iter_named_toplevel
+   : (Flambda.t -> unit)
+  -> (Flambda.named -> unit)
+  -> Flambda.named
+  -> unit
+
+val iter_on_sets_of_closures
+   : (Flambda.set_of_closures -> unit)
+  -> Flambda.t
+  -> unit
+
+val iter_on_set_of_closures_of_program
+   : Flambda.program
+  -> f:(constant:bool -> Flambda.set_of_closures -> unit)
+  -> unit
+
+val iter_all_immutable_let_and_let_rec_bindings
+   : Flambda.t
+  -> f:(Variable.t -> Flambda.named -> unit)
+  -> unit
+
+val iter_all_toplevel_immutable_let_and_let_rec_bindings
+   : Flambda.t
+  -> f:(Variable.t -> Flambda.named -> unit)
+  -> unit
+
+val iter_exprs_at_toplevel_of_program
+   : Flambda.program
+  -> f:(Flambda.t -> unit)
+  -> unit
+
+val iter_named_of_program
+   : Flambda.program
+  -> f:(Flambda.named -> unit)
+  -> unit
+
+val iter_constant_defining_values_on_program
+  : Flambda.program
+  -> f:(Flambda.constant_defining_value -> unit)
+  -> unit
+
+val iter_apply_on_program
+   : Flambda.program
+  -> f:(Flambda.apply -> unit)
+  -> unit
+
+val map
+   : (Flambda.t -> Flambda.t)
+  -> (Flambda.named -> Flambda.named)
+  -> Flambda.t
+  -> Flambda.t
+
+val map_expr
+   : (Flambda.t -> Flambda.t)
+  -> Flambda.t
+  -> Flambda.t
+
+val map_named
+   : (Flambda.named -> Flambda.named)
+  -> Flambda.t
+  -> Flambda.t
+
+val map_toplevel
+   : (Flambda.t -> Flambda.t)
+  -> (Flambda.named -> Flambda.named)
+  -> Flambda.t
+  -> Flambda.t
+
+val map_toplevel_expr
+   : (Flambda.t -> Flambda.t)
+  -> Flambda.t
+  -> Flambda.t
+
+val map_toplevel_named
+   : (Flambda.named -> Flambda.named)
+  -> Flambda.t
+  -> Flambda.t
+
+val map_symbols
+   : Flambda.t
+  -> f:(Symbol.t -> Symbol.t)
+  -> Flambda.t
+
+val map_symbols_on_set_of_closures
+  : Flambda.set_of_closures
+  -> f:(Symbol.t -> Symbol.t)
+  -> Flambda.set_of_closures
+
+val map_toplevel_sets_of_closures
+   : Flambda.t
+  -> f:(Flambda.set_of_closures -> Flambda.set_of_closures)
+  -> Flambda.t
+
+val map_apply
+   : Flambda.t
+  -> f:(Flambda.apply -> Flambda.apply)
+  -> Flambda.t
+
+val map_function_bodies
+   : Flambda.set_of_closures
+  -> f:(Flambda.t -> Flambda.t)
+  -> Flambda.set_of_closures
+
+val map_sets_of_closures
+   : Flambda.t
+  -> f:(Flambda.set_of_closures -> Flambda.set_of_closures)
+  -> Flambda.t
+
+val map_sets_of_closures_of_program
+   : Flambda.program
+  -> f:(Flambda.set_of_closures -> Flambda.set_of_closures)
+  -> Flambda.program
+
+val map_project_var_to_expr_opt
+   : Flambda.t
+  -> f:(Flambda.project_var -> Flambda.t option)
+  -> Flambda.t
+
+val map_project_var_to_named_opt
+   : Flambda.t
+  -> f:(Flambda.project_var -> Flambda.named option)
+  -> Flambda.t
+
+val map_exprs_at_toplevel_of_program
+   : Flambda.program
+  -> f:(Flambda.t -> Flambda.t)
+  -> Flambda.program
+
+val map_named_of_program
+   : Flambda.program
+  -> f:(Variable.t -> Flambda.named -> Flambda.named)
+  -> Flambda.program
+
+val map_all_immutable_let_and_let_rec_bindings
+   : Flambda.t
+  -> f:(Variable.t -> Flambda.named -> Flambda.named)
+  -> Flambda.t
+
+val fold_function_decls_ignoring_stubs
+   : Flambda.set_of_closures
+  -> init:'a
+  -> f:(fun_var:Variable.t
+    -> function_decl:Flambda.function_declaration
+    -> 'a
+    -> 'a)
+  -> 'a
diff --git a/middle_end/flambda/flambda_middle_end.ml b/middle_end/flambda/flambda_middle_end.ml
new file mode 100644
index 00000000..0675855f
--- /dev/null
+++ b/middle_end/flambda/flambda_middle_end.ml
@@ -0,0 +1,248 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+let _dump_function_sizes flam ~backend =
+  let module Backend = (val backend : Backend_intf.S) in
+  let than = max_int in
+  Flambda_iterators.iter_on_set_of_closures_of_program flam
+    ~f:(fun ~constant:_ (set_of_closures : Flambda.set_of_closures) ->
+      Variable.Map.iter (fun fun_var
+            (function_decl : Flambda.function_declaration) ->
+          let closure_id = Closure_id.wrap fun_var in
+          let symbol = Backend.closure_symbol closure_id in
+          match Inlining_cost.lambda_smaller' function_decl.body ~than with
+          | Some size -> Format.eprintf "%a %d\n" Symbol.print symbol size
+          | None -> assert false)
+        set_of_closures.function_decls.funs)
+
+let lambda_to_flambda ~ppf_dump ~prefixname ~backend ~size ~filename
+      ~module_ident ~module_initializer =
+  Profile.record_call "flambda" (fun () ->
+    let previous_warning_reporter = !Location.warning_reporter in
+    let module WarningSet =
+      Set.Make (struct
+        type t = Location.t * Warnings.t
+        let compare = Stdlib.compare
+      end)
+    in
+    let warning_set = ref WarningSet.empty in
+    let flambda_warning_reporter loc w =
+      let elt = loc, w in
+      if not (WarningSet.mem elt !warning_set) then begin
+        warning_set := WarningSet.add elt !warning_set;
+        previous_warning_reporter loc w
+      end else None
+    in
+    Misc.protect_refs
+      [Misc.R (Location.warning_reporter, flambda_warning_reporter)]
+      (fun () ->
+         let pass_number = ref 0 in
+         let round_number = ref 0 in
+         let check flam =
+           if !Clflags.flambda_invariant_checks then begin
+             try Flambda_invariants.check_exn flam
+             with exn ->
+               Misc.fatal_errorf "After Flambda pass %d, round %d:@.%s:@.%a"
+                 !pass_number !round_number (Printexc.to_string exn)
+                 Flambda.print_program flam
+           end
+         in
+         let (+-+) flam (name, pass) =
+           incr pass_number;
+           if !Clflags.dump_flambda_verbose then begin
+             Format.fprintf ppf_dump "@.PASS: %s@." name;
+             Format.fprintf ppf_dump "Before pass %d, round %d:@ %a@."
+               !pass_number !round_number Flambda.print_program flam;
+             Format.fprintf ppf_dump "\n@?"
+           end;
+           let flam = Profile.record ~accumulate:true name pass flam in
+           if !Clflags.flambda_invariant_checks then begin
+             Profile.record ~accumulate:true "check" check flam
+           end;
+           flam
+         in
+         Profile.record_call ~accumulate:true "middle_end" (fun () ->
+           let flam =
+             Profile.record_call ~accumulate:true "closure_conversion"
+               (fun () ->
+                  module_initializer
+                  |> Closure_conversion.lambda_to_flambda ~backend
+                       ~module_ident ~size ~filename)
+           in
+           if !Clflags.dump_rawflambda
+           then
+             Format.fprintf ppf_dump "After closure conversion:@ %a@."
+               Flambda.print_program flam;
+           check flam;
+           let fast_mode flam =
+             pass_number := 0;
+             let round = 0 in
+             flam
+             +-+ ("lift_lets 1", Lift_code.lift_lets)
+             +-+ ("Lift_constants", Lift_constants.lift_constants ~backend)
+             +-+ ("Share_constants", Share_constants.share_constants)
+             +-+ ("Lift_let_to_initialize_symbol",
+                  Lift_let_to_initialize_symbol.lift ~backend)
+             +-+ ("Inline_and_simplify",
+                  Inline_and_simplify.run ~never_inline:false ~backend
+                    ~prefixname ~round ~ppf_dump)
+             +-+ ("Remove_unused_closure_vars 2",
+                  Remove_unused_closure_vars.remove_unused_closure_variables
+                    ~remove_direct_call_surrogates:false)
+             +-+ ("Ref_to_variables",
+                  Ref_to_variables.eliminate_ref)
+             +-+ ("Initialize_symbol_to_let_symbol",
+                  Initialize_symbol_to_let_symbol.run)
+           in
+           let rec loop flam =
+             pass_number := 0;
+             let round = !round_number in
+             incr round_number;
+             if !round_number > (Clflags.rounds ()) then flam
+             else
+               flam
+               (* Beware: [Lift_constants] must be run before any pass that
+                  might duplicate strings. *)
+               +-+ ("lift_lets 1", Lift_code.lift_lets)
+               +-+ ("Lift_constants", Lift_constants.lift_constants ~backend)
+               +-+ ("Share_constants", Share_constants.share_constants)
+               +-+ ("Remove_unused_program_constructs",
+              Remove_unused_program_constructs.remove_unused_program_constructs)
+               +-+ ("Lift_let_to_initialize_symbol",
+                    Lift_let_to_initialize_symbol.lift ~backend)
+               +-+ ("lift_lets 2", Lift_code.lift_lets)
+               +-+ ("Remove_unused_closure_vars 1",
+                    Remove_unused_closure_vars.remove_unused_closure_variables
+                      ~remove_direct_call_surrogates:false)
+               +-+ ("Inline_and_simplify",
+                    Inline_and_simplify.run ~never_inline:false ~backend
+                      ~prefixname ~round ~ppf_dump)
+               +-+ ("Remove_unused_closure_vars 2",
+                    Remove_unused_closure_vars.remove_unused_closure_variables
+                      ~remove_direct_call_surrogates:false)
+               +-+ ("lift_lets 3", Lift_code.lift_lets)
+               +-+ ("Inline_and_simplify noinline",
+                    Inline_and_simplify.run ~never_inline:true ~backend
+                      ~prefixname ~round ~ppf_dump)
+               +-+ ("Remove_unused_closure_vars 3",
+                    Remove_unused_closure_vars.remove_unused_closure_variables
+                      ~remove_direct_call_surrogates:false)
+               +-+ ("Ref_to_variables",
+                    Ref_to_variables.eliminate_ref)
+               +-+ ("Initialize_symbol_to_let_symbol",
+                    Initialize_symbol_to_let_symbol.run)
+               |> loop
+           in
+           let back_end flam =
+             flam
+             +-+ ("Remove_unused_closure_vars",
+                  Remove_unused_closure_vars.remove_unused_closure_variables
+                    ~remove_direct_call_surrogates:true)
+             +-+ ("Lift_constants", Lift_constants.lift_constants ~backend)
+             +-+ ("Share_constants", Share_constants.share_constants)
+             +-+ ("Remove_unused_program_constructs",
+              Remove_unused_program_constructs.remove_unused_program_constructs)
+           in
+           let flam =
+             if !Clflags.classic_inlining then
+               fast_mode flam
+             else
+               loop flam
+           in
+           let flam = back_end flam in
+           (* Check that there aren't any unused "always inline" attributes. *)
+           Flambda_iterators.iter_apply_on_program flam ~f:(fun apply ->
+             match apply.inline with
+             | Default_inline | Never_inline | Hint_inline -> ()
+             | Always_inline ->
+               (* CR-someday mshinwell: consider a different error message if
+                  this triggers as a result of the propagation of a user's
+                  attribute into the second part of an over application
+                  (inline_and_simplify.ml line 710). *)
+               Location.prerr_warning (Debuginfo.to_location apply.dbg)
+                 (Warnings.Inlining_impossible
+                    "[@inlined] attribute was not used on this function \
+                     application (the optimizer did not know what function \
+                     was being applied)")
+             | Unroll _ ->
+               Location.prerr_warning (Debuginfo.to_location apply.dbg)
+                 (Warnings.Inlining_impossible
+                    "[@unrolled] attribute was not used on this function \
+                     application (the optimizer did not know what function \
+                     was being applied)"));
+           if !Clflags.dump_flambda
+           then
+             Format.fprintf ppf_dump "End of middle end:@ %a@."
+               Flambda.print_program flam;
+           check flam;
+           (* CR-someday mshinwell: add -d... option for this *)
+           (* dump_function_sizes flam ~backend; *)
+           flam))
+      )
+
+let flambda_raw_clambda_dump_if ppf
+      ({ Flambda_to_clambda. expr = ulambda; preallocated_blocks = _;
+        structured_constants; exported = _; } as input) =
+  if !Clflags.dump_rawclambda then
+    begin
+      Format.fprintf ppf "@.clambda (before Un_anf):@.";
+      Printclambda.clambda ppf ulambda;
+      Symbol.Map.iter (fun sym cst ->
+          Format.fprintf ppf "%a:@ %a@."
+            Symbol.print sym
+            Printclambda.structured_constant cst)
+        structured_constants
+    end;
+  if !Clflags.dump_cmm then Format.fprintf ppf "@.cmm:@.";
+  input
+
+let lambda_to_clambda ~backend ~filename ~prefixname ~ppf_dump
+      (program : Lambda.program) =
+  let program =
+    lambda_to_flambda ~ppf_dump ~prefixname ~backend
+      ~size:program.main_module_block_size
+      ~filename
+      ~module_ident:program.module_ident
+      ~module_initializer:program.code
+  in
+  let export = Build_export_info.build_transient ~backend program in
+  let clambda, preallocated_blocks, constants =
+    Profile.record_call "backend" (fun () ->
+      (program, export)
+      |> Flambda_to_clambda.convert ~ppf_dump
+      |> flambda_raw_clambda_dump_if ppf_dump
+      |> (fun { Flambda_to_clambda. expr; preallocated_blocks;
+                structured_constants; exported; } ->
+           Compilenv.set_export_info exported;
+           let clambda =
+             Un_anf.apply ~what:(Compilenv.current_unit_symbol ())
+               ~ppf_dump expr
+           in
+           clambda, preallocated_blocks, structured_constants))
+  in
+  let constants =
+    List.map (fun (symbol, definition) ->
+        { Clambda.symbol = Linkage_name.to_string (Symbol.label symbol);
+          exported = true;
+          definition;
+          provenance = None;
+        })
+      (Symbol.Map.bindings constants)
+  in
+  clambda, preallocated_blocks, constants
diff --git a/middle_end/flambda/flambda_middle_end.mli b/middle_end/flambda/flambda_middle_end.mli
new file mode 100644
index 00000000..e7bb7478
--- /dev/null
+++ b/middle_end/flambda/flambda_middle_end.mli
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Translate Lambda code to Flambda code, optimize it, and produce Clambda. *)
+
+val lambda_to_clambda
+   : backend:(module Backend_intf.S)
+  -> filename:string
+  -> prefixname:string
+  -> ppf_dump:Format.formatter
+  -> Lambda.program
+  -> Clambda.with_constants
diff --git a/middle_end/flambda/flambda_to_clambda.ml b/middle_end/flambda/flambda_to_clambda.ml
new file mode 100644
index 00000000..d53034c8
--- /dev/null
+++ b/middle_end/flambda/flambda_to_clambda.ml
@@ -0,0 +1,777 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+module V = Backend_var
+module VP = Backend_var.With_provenance
+
+type 'a for_one_or_more_units = {
+  fun_offset_table : int Closure_id.Map.t;
+  fv_offset_table : int Var_within_closure.Map.t;
+  constant_closures : Closure_id.Set.t;
+  closures: Closure_id.Set.t;
+}
+
+type t = {
+  current_unit :
+    Set_of_closures_id.t for_one_or_more_units;
+  imported_units :
+    Simple_value_approx.function_declarations for_one_or_more_units;
+  ppf_dump : Format.formatter;
+  mutable constants_for_instrumentation :
+    Clambda.ustructured_constant Symbol.Map.t;
+}
+
+let get_fun_offset t closure_id =
+  let fun_offset_table =
+    if Closure_id.in_compilation_unit closure_id (Compilenv.current_unit ())
+    then
+      t.current_unit.fun_offset_table
+    else
+      t.imported_units.fun_offset_table
+  in
+  try Closure_id.Map.find closure_id fun_offset_table
+  with Not_found ->
+    Misc.fatal_errorf "Flambda_to_clambda: missing offset for closure %a"
+      Closure_id.print closure_id
+
+let get_fv_offset t var_within_closure =
+  let fv_offset_table =
+    if Var_within_closure.in_compilation_unit var_within_closure
+        (Compilenv.current_unit ())
+    then t.current_unit.fv_offset_table
+    else t.imported_units.fv_offset_table
+  in
+  try Var_within_closure.Map.find var_within_closure fv_offset_table
+  with Not_found ->
+    Misc.fatal_errorf "Flambda_to_clambda: missing offset for variable %a"
+      Var_within_closure.print var_within_closure
+
+let is_function_constant t closure_id =
+  if Closure_id.Set.mem closure_id t.current_unit.closures then
+    Closure_id.Set.mem closure_id t.current_unit.constant_closures
+  else if Closure_id.Set.mem closure_id t.imported_units.closures then
+    Closure_id.Set.mem closure_id t.imported_units.constant_closures
+  else
+    Misc.fatal_errorf "Flambda_to_clambda: missing closure %a"
+      Closure_id.print closure_id
+
+(* Instrumentation of closure and field accesses to try to catch compiler
+   bugs. *)
+
+let check_closure t ulam named : Clambda.ulambda =
+  if not !Clflags.clambda_checks then ulam
+  else
+    let desc =
+      Primitive.simple ~name:"caml_check_value_is_closure"
+        ~arity:2 ~alloc:false
+    in
+    let str = Format.asprintf "%a" Flambda.print_named named in
+    let sym = Compilenv.new_const_symbol () in
+    let sym' =
+      Symbol.of_global_linkage (Compilation_unit.get_current_exn ())
+        (Linkage_name.create sym)
+    in
+    t.constants_for_instrumentation <-
+      Symbol.Map.add sym' (Clambda.Uconst_string str)
+        t.constants_for_instrumentation;
+    Uprim (Pccall desc,
+           [ulam; Clambda.Uconst (Uconst_ref (sym, None))],
+           Debuginfo.none)
+
+let check_field t ulam pos named_opt : Clambda.ulambda =
+  if not !Clflags.clambda_checks then ulam
+  else
+    let desc =
+      Primitive.simple ~name:"caml_check_field_access"
+        ~arity:3 ~alloc:false
+    in
+    let str =
+      match named_opt with
+      | None -> ""
+      | Some named -> Format.asprintf "%a" Flambda.print_named named
+    in
+    let sym = Compilenv.new_const_symbol () in
+    let sym' =
+      Symbol.of_global_linkage (Compilation_unit.get_current_exn ())
+        (Linkage_name.create sym)
+    in
+    t.constants_for_instrumentation <-
+      Symbol.Map.add sym' (Clambda.Uconst_string str)
+        t.constants_for_instrumentation;
+    Uprim (Pccall desc, [ulam; Clambda.Uconst (Uconst_int pos);
+        Clambda.Uconst (Uconst_ref (sym, None))],
+      Debuginfo.none)
+
+module Env : sig
+  type t
+
+  val empty : t
+
+  val add_subst : t -> Variable.t -> Clambda.ulambda -> t
+  val find_subst_exn : t -> Variable.t -> Clambda.ulambda
+
+  val add_fresh_ident : t -> Variable.t -> V.t * t
+  val ident_for_var_exn : t -> Variable.t -> V.t
+
+  val add_fresh_mutable_ident : t -> Mutable_variable.t -> V.t * t
+  val ident_for_mutable_var_exn : t -> Mutable_variable.t -> V.t
+
+  val add_allocated_const : t -> Symbol.t -> Allocated_const.t -> t
+  val allocated_const_for_symbol : t -> Symbol.t -> Allocated_const.t option
+
+  val keep_only_symbols : t -> t
+end = struct
+  type t =
+    { subst : Clambda.ulambda Variable.Map.t;
+      var : V.t Variable.Map.t;
+      mutable_var : V.t Mutable_variable.Map.t;
+      toplevel : bool;
+      allocated_constant_for_symbol : Allocated_const.t Symbol.Map.t;
+    }
+
+  let empty =
+    { subst = Variable.Map.empty;
+      var = Variable.Map.empty;
+      mutable_var = Mutable_variable.Map.empty;
+      toplevel = false;
+      allocated_constant_for_symbol = Symbol.Map.empty;
+    }
+
+  let add_subst t id subst =
+    { t with subst = Variable.Map.add id subst t.subst }
+
+  let find_subst_exn t id = Variable.Map.find id t.subst
+
+  let ident_for_var_exn t id = Variable.Map.find id t.var
+
+  let add_fresh_ident t var =
+    let id = V.create_local (Variable.name var) in
+    id, { t with var = Variable.Map.add var id t.var }
+
+  let ident_for_mutable_var_exn t mut_var =
+    Mutable_variable.Map.find mut_var t.mutable_var
+
+  let add_fresh_mutable_ident t mut_var =
+    let id = V.create_local (Mutable_variable.name mut_var) in
+    let mutable_var = Mutable_variable.Map.add mut_var id t.mutable_var in
+    id, { t with mutable_var; }
+
+  let add_allocated_const t sym cons =
+    { t with
+      allocated_constant_for_symbol =
+        Symbol.Map.add sym cons t.allocated_constant_for_symbol;
+    }
+
+  let allocated_const_for_symbol t sym =
+    try
+      Some (Symbol.Map.find sym t.allocated_constant_for_symbol)
+    with Not_found -> None
+
+  let keep_only_symbols t =
+    { empty with
+      allocated_constant_for_symbol = t.allocated_constant_for_symbol;
+    }
+end
+
+let subst_var env var : Clambda.ulambda =
+  try Env.find_subst_exn env var
+  with Not_found ->
+    try Uvar (Env.ident_for_var_exn env var)
+    with Not_found ->
+      Misc.fatal_errorf "Flambda_to_clambda: unbound variable %a@."
+        Variable.print var
+
+let subst_vars env vars = List.map (subst_var env) vars
+
+let build_uoffset ulam offset : Clambda.ulambda =
+  if offset = 0 then ulam
+  else Uoffset (ulam, offset)
+
+let to_clambda_allocated_constant (const : Allocated_const.t)
+      : Clambda.ustructured_constant =
+  match const with
+  | Float f -> Uconst_float f
+  | Int32 i -> Uconst_int32 i
+  | Int64 i -> Uconst_int64 i
+  | Nativeint i -> Uconst_nativeint i
+  | Immutable_string s | String s -> Uconst_string s
+  | Immutable_float_array a | Float_array a -> Uconst_float_array a
+
+let to_uconst_symbol env symbol : Clambda.ustructured_constant option =
+  match Env.allocated_const_for_symbol env symbol with
+  | Some ((Float _ | Int32 _ | Int64 _ | Nativeint _) as const) ->
+    Some (to_clambda_allocated_constant const)
+  | None  (* CR-soon mshinwell: Try to make this an error. *)
+  | Some _ -> None
+
+let to_clambda_symbol' env sym : Clambda.uconstant =
+  let lbl = Linkage_name.to_string (Symbol.label sym) in
+  Uconst_ref (lbl, to_uconst_symbol env sym)
+
+let to_clambda_symbol env sym : Clambda.ulambda =
+  Uconst (to_clambda_symbol' env sym)
+
+let to_clambda_const env (const : Flambda.constant_defining_value_block_field)
+      : Clambda.uconstant =
+  match const with
+  | Symbol symbol -> to_clambda_symbol' env symbol
+  | Const (Int i) -> Uconst_int i
+  | Const (Char c) -> Uconst_int (Char.code c)
+  | Const (Const_pointer i) -> Uconst_ptr i
+
+let rec to_clambda t env (flam : Flambda.t) : Clambda.ulambda =
+  match flam with
+  | Var var -> subst_var env var
+  | Let { var; defining_expr; body; _ } ->
+    (* TODO: synthesize proper value_kind *)
+    let id, env_body = Env.add_fresh_ident env var in
+    Ulet (Immutable, Pgenval, VP.create id,
+      to_clambda_named t env var defining_expr,
+      to_clambda t env_body body)
+  | Let_mutable { var = mut_var; initial_value = var; body; contents_kind } ->
+    let id, env_body = Env.add_fresh_mutable_ident env mut_var in
+    let def = subst_var env var in
+    Ulet (Mutable, contents_kind, VP.create id, def, to_clambda t env_body body)
+  | Let_rec (defs, body) ->
+    let env, defs =
+      List.fold_right (fun (var, def) (env, defs) ->
+          let id, env = Env.add_fresh_ident env var in
+          env, (id, var, def) :: defs)
+        defs (env, [])
+    in
+    let defs =
+      List.map (fun (id, var, def) ->
+          VP.create id, to_clambda_named t env var def)
+        defs
+    in
+    Uletrec (defs, to_clambda t env body)
+  | Apply { func; args; kind = Direct direct_func; dbg = dbg } ->
+    (* The closure _parameter_ of the function is added by cmmgen.
+       At the call site, for a direct call, the closure argument must be
+       explicitly added (by [to_clambda_direct_apply]); there is no special
+       handling of such in the direct call primitive.
+       For an indirect call, we do not need to do anything here; Cmmgen will
+       do the equivalent of the previous paragraph when it generates a direct
+       call to [caml_apply]. *)
+    to_clambda_direct_apply t func args direct_func dbg env
+  | Apply { func; args; kind = Indirect; dbg = dbg } ->
+    let callee = subst_var env func in
+    Ugeneric_apply (check_closure t callee (Flambda.Expr (Var func)),
+      subst_vars env args, dbg)
+  | Switch (arg, sw) ->
+    let aux () : Clambda.ulambda =
+      let const_index, const_actions =
+        to_clambda_switch t env sw.consts sw.numconsts sw.failaction
+      in
+      let block_index, block_actions =
+        to_clambda_switch t env sw.blocks sw.numblocks sw.failaction
+      in
+      Uswitch (subst_var env arg,
+        { us_index_consts = const_index;
+          us_actions_consts = const_actions;
+          us_index_blocks = block_index;
+          us_actions_blocks = block_actions;
+        },
+        Debuginfo.none)  (* debug info will be added by GPR#855 *)
+    in
+    (* Check that the [failaction] may be duplicated.  If this is not the
+       case, share it through a static raise / static catch. *)
+    (* CR-someday pchambart for pchambart: This is overly simplified.
+       We should verify that this does not generates too bad code.
+       If it the case, handle some let cases.
+    *)
+    begin match sw.failaction with
+    | None -> aux ()
+    | Some (Static_raise _) -> aux ()
+    | Some failaction ->
+      let exn = Static_exception.create () in
+      let sw =
+        { sw with
+          failaction = Some (Flambda.Static_raise (exn, []));
+        }
+      in
+      let expr : Flambda.t =
+        Static_catch (exn, [], Switch (arg, sw), failaction)
+      in
+      to_clambda t env expr
+    end
+  | String_switch (arg, sw, def) ->
+    let arg = subst_var env arg in
+    let sw = List.map (fun (s, e) -> s, to_clambda t env e) sw in
+    let def = Option.map (to_clambda t env) def in
+    Ustringswitch (arg, sw, def)
+  | Static_raise (static_exn, args) ->
+    Ustaticfail (Static_exception.to_int static_exn,
+      List.map (subst_var env) args)
+  | Static_catch (static_exn, vars, body, handler) ->
+    let env_handler, ids =
+      List.fold_right (fun var (env, ids) ->
+          let id, env = Env.add_fresh_ident env var in
+          env, (VP.create id, Lambda.Pgenval) :: ids)
+        vars (env, [])
+    in
+    Ucatch (Static_exception.to_int static_exn, ids,
+      to_clambda t env body, to_clambda t env_handler handler)
+  | Try_with (body, var, handler) ->
+    let id, env_handler = Env.add_fresh_ident env var in
+    Utrywith (to_clambda t env body, VP.create id,
+      to_clambda t env_handler handler)
+  | If_then_else (arg, ifso, ifnot) ->
+    Uifthenelse (subst_var env arg, to_clambda t env ifso,
+      to_clambda t env ifnot)
+  | While (cond, body) ->
+    Uwhile (to_clambda t env cond, to_clambda t env body)
+  | For { bound_var; from_value; to_value; direction; body } ->
+    let id, env_body = Env.add_fresh_ident env bound_var in
+    Ufor (VP.create id, subst_var env from_value, subst_var env to_value,
+      direction, to_clambda t env_body body)
+  | Assign { being_assigned; new_value } ->
+    let id =
+      try Env.ident_for_mutable_var_exn env being_assigned
+      with Not_found ->
+        Misc.fatal_errorf "Unbound mutable variable %a in [Assign]: %a"
+          Mutable_variable.print being_assigned
+          Flambda.print flam
+    in
+    Uassign (id, subst_var env new_value)
+  | Send { kind; meth; obj; args; dbg } ->
+    Usend (kind, subst_var env meth, subst_var env obj,
+      subst_vars env args, dbg)
+  | Proved_unreachable -> Uunreachable
+
+and to_clambda_named t env var (named : Flambda.named) : Clambda.ulambda =
+  match named with
+  | Symbol sym -> to_clambda_symbol env sym
+  | Const (Const_pointer n) -> Uconst (Uconst_ptr n)
+  | Const (Int n) -> Uconst (Uconst_int n)
+  | Const (Char c) -> Uconst (Uconst_int (Char.code c))
+  | Allocated_const _ ->
+    Misc.fatal_errorf "[Allocated_const] should have been lifted to a \
+        [Let_symbol] construction before [Flambda_to_clambda]: %a = %a"
+      Variable.print var
+      Flambda.print_named named
+  | Read_mutable mut_var ->
+    begin try Uvar (Env.ident_for_mutable_var_exn env mut_var)
+    with Not_found ->
+      Misc.fatal_errorf "Unbound mutable variable %a in [Read_mutable]: %a"
+        Mutable_variable.print mut_var
+        Flambda.print_named named
+    end
+  | Read_symbol_field (symbol, field) ->
+    Uprim (Pfield field, [to_clambda_symbol env symbol], Debuginfo.none)
+  | Set_of_closures set_of_closures ->
+    to_clambda_set_of_closures t env set_of_closures
+  | Project_closure { set_of_closures; closure_id } ->
+    (* Note that we must use [build_uoffset] to ensure that we do not generate
+       a [Uoffset] construction in the event that the offset is zero, otherwise
+       we might break pattern matches in Cmmgen (in particular for the
+       compilation of "let rec"). *)
+    check_closure t (
+      build_uoffset
+        (check_closure t (subst_var env set_of_closures)
+           (Flambda.Expr (Var set_of_closures)))
+        (get_fun_offset t closure_id))
+      named
+  | Move_within_set_of_closures { closure; start_from; move_to } ->
+    check_closure t (build_uoffset
+      (check_closure t (subst_var env closure)
+         (Flambda.Expr (Var closure)))
+      ((get_fun_offset t move_to) - (get_fun_offset t start_from)))
+      named
+  | Project_var { closure; var; closure_id } ->
+    let ulam = subst_var env closure in
+    let fun_offset = get_fun_offset t closure_id in
+    let var_offset = get_fv_offset t var in
+    let pos = var_offset - fun_offset in
+    Uprim (Pfield pos,
+      [check_field t (check_closure t ulam (Expr (Var closure)))
+         pos (Some named)],
+      Debuginfo.none)
+  | Prim (Pfield index, [block], dbg) ->
+    Uprim (Pfield index, [check_field t (subst_var env block) index None], dbg)
+  | Prim (Psetfield (index, maybe_ptr, init), [block; new_value], dbg) ->
+    Uprim (Psetfield (index, maybe_ptr, init), [
+        check_field t (subst_var env block) index None;
+        subst_var env new_value;
+      ], dbg)
+  | Prim (Popaque, args, dbg) ->
+    Uprim (Popaque, subst_vars env args, dbg)
+  | Prim (p, args, dbg) ->
+    Uprim (p, subst_vars env args, dbg)
+  | Expr expr -> to_clambda t env expr
+
+and to_clambda_switch t env cases num_keys default =
+  let num_keys =
+    if Numbers.Int.Set.cardinal num_keys = 0 then 0
+    else Numbers.Int.Set.max_elt num_keys + 1
+  in
+  let store = Flambda_utils.Switch_storer.mk_store () in
+  let default_action =
+    match default with
+    | Some def when List.length cases < num_keys ->
+      store.act_store () def
+    | _ -> -1
+  in
+  let index = Array.make num_keys default_action in
+  let smallest_key = ref num_keys in
+  List.iter
+    (fun (key, lam) ->
+      index.(key) <- store.act_store () lam;
+      smallest_key := min key !smallest_key
+    )
+    cases;
+  if !smallest_key < num_keys then begin
+    let action = ref index.(!smallest_key) in
+    Array.iteri
+      (fun i act ->
+         if act >= 0 then action := act else index.(i) <- !action)
+      index
+  end;
+  let actions = Array.map (to_clambda t env) (store.act_get ()) in
+  match actions with
+  | [| |] -> [| |], [| |]  (* May happen when [default] is [None]. *)
+  | _ -> index, actions
+
+and to_clambda_direct_apply t func args direct_func dbg env : Clambda.ulambda =
+  let closed = is_function_constant t direct_func in
+  let label = Compilenv.function_label direct_func in
+  let uargs =
+    let uargs = subst_vars env args in
+    (* Remove the closure argument if the closure is closed.  (Note that the
+       closure argument is always a variable, so we can be sure we are not
+       dropping any side effects.) *)
+    if closed then uargs else uargs @ [subst_var env func]
+  in
+  Udirect_apply (label, uargs, dbg)
+
+(* Describe how to build a runtime closure block that corresponds to the
+   given Flambda set of closures.
+
+   For instance the closure for the following set of closures:
+
+     let rec fun_a x =
+       if x <= 0 then 0 else fun_b (x-1) v1
+     and fun_b x y =
+       if x <= 0 then 0 else v1 + v2 + y + fun_a (x-1)
+
+   will be represented in memory as:
+
+     [ closure header; fun_a;
+       1; infix header; fun caml_curry_2;
+       2; fun_b; v1; v2 ]
+
+   fun_a and fun_b will take an additional parameter 'env' to
+   access their closure.  It will be arranged such that in the body
+   of each function the env parameter points to its own code
+   pointer.  For example, in fun_b it will be shifted by 3 words.
+
+   Hence accessing v1 in the body of fun_a is accessing the
+   6th field of 'env' and in the body of fun_b the 1st field.
+*)
+and to_clambda_set_of_closures t env
+      (({ function_decls; free_vars } : Flambda.set_of_closures)
+        as set_of_closures) : Clambda.ulambda =
+  let all_functions = Variable.Map.bindings function_decls.funs in
+  let env_var = V.create_local "env" in
+  let to_clambda_function
+        (closure_id, (function_decl : Flambda.function_declaration))
+        : Clambda.ufunction =
+    let closure_id = Closure_id.wrap closure_id in
+    let fun_offset =
+      Closure_id.Map.find closure_id t.current_unit.fun_offset_table
+    in
+    let env =
+      (* Inside the body of the function, we cannot access variables
+         declared outside, so start with a suitably clean environment.
+         Note that we must not forget the information about which allocated
+         constants contain which unboxed values. *)
+      let env = Env.keep_only_symbols env in
+      (* Add the Clambda expressions for the free variables of the function
+         to the environment. *)
+      let add_env_free_variable id _ env =
+        let var_offset =
+          try
+            Var_within_closure.Map.find
+              (Var_within_closure.wrap id) t.current_unit.fv_offset_table
+          with Not_found ->
+            Misc.fatal_errorf "Clambda.to_clambda_set_of_closures: offset for \
+                free variable %a is unknown.  Set of closures: %a"
+              Variable.print id
+              Flambda.print_set_of_closures set_of_closures
+        in
+        let pos = var_offset - fun_offset in
+        Env.add_subst env id
+          (Uprim (Pfield pos, [Clambda.Uvar env_var], Debuginfo.none))
+      in
+      let env = Variable.Map.fold add_env_free_variable free_vars env in
+      (* Add the Clambda expressions for all functions defined in the current
+         set of closures to the environment.  The various functions may be
+         retrieved by moving within the runtime closure, starting from the
+         current function's closure. *)
+      let add_env_function pos env (id, _) =
+        let offset =
+          Closure_id.Map.find (Closure_id.wrap id)
+            t.current_unit.fun_offset_table
+        in
+        let exp : Clambda.ulambda = Uoffset (Uvar env_var, offset - pos) in
+        Env.add_subst env id exp
+      in
+      List.fold_left (add_env_function fun_offset) env all_functions
+    in
+    let env_body, params =
+      List.fold_right (fun var (env, params) ->
+          let id, env = Env.add_fresh_ident env (Parameter.var var) in
+          env, id :: params)
+        function_decl.params (env, [])
+    in
+    { label = Compilenv.function_label closure_id;
+      arity = Flambda_utils.function_arity function_decl;
+      params =
+        List.map
+          (fun var -> VP.create var, Lambda.Pgenval)
+          (params @ [env_var]);
+      return = Lambda.Pgenval;
+      body = to_clambda t env_body function_decl.body;
+      dbg = function_decl.dbg;
+      env = Some env_var;
+    }
+  in
+  let funs = List.map to_clambda_function all_functions in
+  let free_vars =
+    Variable.Map.bindings (Variable.Map.map (
+      fun (free_var : Flambda.specialised_to) ->
+        subst_var env free_var.var) free_vars)
+  in
+  Uclosure (funs, List.map snd free_vars)
+
+and to_clambda_closed_set_of_closures t env symbol
+      ({ function_decls; } : Flambda.set_of_closures)
+      : Clambda.ustructured_constant =
+  let functions = Variable.Map.bindings function_decls.funs in
+  let to_clambda_function (id, (function_decl : Flambda.function_declaration))
+        : Clambda.ufunction =
+    (* All that we need in the environment, for translating one closure from
+       a closed set of closures, is the substitutions for variables bound to
+       the various closures in the set.  Such closures will always be
+       referenced via symbols. *)
+    let env =
+      List.fold_left (fun env (var, _) ->
+          let closure_id = Closure_id.wrap var in
+          let symbol = Compilenv.closure_symbol closure_id in
+          Env.add_subst env var (to_clambda_symbol env symbol))
+        (Env.keep_only_symbols env)
+        functions
+    in
+    let env_body, params =
+      List.fold_right (fun var (env, params) ->
+          let id, env = Env.add_fresh_ident env (Parameter.var var) in
+          env, id :: params)
+        function_decl.params (env, [])
+    in
+    let body =
+      Un_anf.apply ~ppf_dump:t.ppf_dump ~what:symbol
+        (to_clambda t env_body function_decl.body)
+    in
+    { label = Compilenv.function_label (Closure_id.wrap id);
+      arity = Flambda_utils.function_arity function_decl;
+      params = List.map (fun var -> VP.create var, Lambda.Pgenval) params;
+      return = Lambda.Pgenval;
+      body;
+      dbg = function_decl.dbg;
+      env = None;
+    }
+  in
+  let ufunct = List.map to_clambda_function functions in
+  let closure_lbl = Linkage_name.to_string (Symbol.label symbol) in
+  Uconst_closure (ufunct, closure_lbl, [])
+
+let to_clambda_initialize_symbol t env symbol fields : Clambda.ulambda =
+  let fields =
+    List.map (fun (index, expr) -> index, to_clambda t env expr) fields
+  in
+  let build_setfield (index, field) : Clambda.ulambda =
+    (* Note that this will never cause a write barrier hit, owing to
+       the [Initialization]. *)
+    Uprim (Psetfield (index, Pointer, Root_initialization),
+      [to_clambda_symbol env symbol; field],
+      Debuginfo.none)
+  in
+  match fields with
+  | [] -> Uconst (Uconst_ptr 0)
+  | h :: t ->
+    List.fold_left (fun acc (p, field) ->
+        Clambda.Usequence (build_setfield (p, field), acc))
+      (build_setfield h) t
+
+let accumulate_structured_constants t env symbol
+      (c : Flambda.constant_defining_value) acc =
+  match c with
+  | Allocated_const c ->
+    Symbol.Map.add symbol (to_clambda_allocated_constant c) acc
+  | Block (tag, fields) ->
+    let fields = List.map (to_clambda_const env) fields in
+    Symbol.Map.add symbol (Clambda.Uconst_block (Tag.to_int tag, fields)) acc
+  | Set_of_closures set_of_closures ->
+    let to_clambda_set_of_closures =
+      to_clambda_closed_set_of_closures t env symbol set_of_closures
+    in
+    Symbol.Map.add symbol to_clambda_set_of_closures acc
+  | Project_closure _ -> acc
+
+let to_clambda_program t env constants (program : Flambda.program) =
+  let rec loop env constants (program : Flambda.program_body)
+        : Clambda.ulambda *
+          Clambda.ustructured_constant Symbol.Map.t *
+          Clambda.preallocated_block list =
+    match program with
+    | Let_symbol (symbol, alloc, program) ->
+      (* Useful only for unboxing. Since floats and boxed integers will
+         never be part of a Let_rec_symbol, handling only the Let_symbol
+         is sufficient. *)
+      let env =
+        match alloc with
+        | Allocated_const const -> Env.add_allocated_const env symbol const
+        | _ -> env
+      in
+      let constants =
+        accumulate_structured_constants t env symbol alloc constants
+      in
+      loop env constants program
+    | Let_rec_symbol (defs, program) ->
+      let constants =
+        List.fold_left (fun constants (symbol, alloc) ->
+            accumulate_structured_constants t env symbol alloc constants)
+          constants defs
+      in
+      loop env constants program
+    | Initialize_symbol (symbol, tag, fields, program) ->
+      let fields =
+        List.mapi (fun i field ->
+            i, field,
+            Initialize_symbol_to_let_symbol.constant_field field)
+          fields
+      in
+      let init_fields =
+        List.filter_map (function
+            | (i, field, None) -> Some (i, field)
+            | (_, _, Some _) -> None)
+          fields
+      in
+      let constant_fields =
+        List.map (fun (_, _, constant_field) ->
+            match constant_field with
+            | None -> None
+            | Some (Flambda.Const const) ->
+                let n =
+                  match const with
+                  | Int i -> i
+                  | Char c -> Char.code c
+                  | Const_pointer i -> i
+                in
+                Some (Clambda.Uconst_field_int n)
+            | Some (Flambda.Symbol sym) ->
+                let lbl = Linkage_name.to_string (Symbol.label sym) in
+                Some (Clambda.Uconst_field_ref lbl))
+          fields
+      in
+      let e1 = to_clambda_initialize_symbol t env symbol init_fields in
+      let preallocated_block : Clambda.preallocated_block =
+        { symbol = Linkage_name.to_string (Symbol.label symbol);
+          exported = true;
+          tag = Tag.to_int tag;
+          fields = constant_fields;
+          provenance = None;
+        }
+      in
+      let e2, constants, preallocated_blocks = loop env constants program in
+      Usequence (e1, e2), constants, preallocated_block :: preallocated_blocks
+    | Effect (expr, program) ->
+      let e1 = to_clambda t env expr in
+      let e2, constants, preallocated_blocks = loop env constants program in
+      Usequence (e1, e2), constants, preallocated_blocks
+    | End _ ->
+      Uconst (Uconst_ptr 0), constants, []
+  in
+  loop env constants program.program_body
+
+type result = {
+  expr : Clambda.ulambda;
+  preallocated_blocks : Clambda.preallocated_block list;
+  structured_constants : Clambda.ustructured_constant Symbol.Map.t;
+  exported : Export_info.t;
+}
+
+let convert ~ppf_dump (program, exported_transient) : result =
+  let current_unit =
+    let closures =
+      Closure_id.Map.keys (Flambda_utils.make_closure_map program)
+    in
+    let constant_closures =
+      Flambda_utils.all_lifted_constant_closures program
+    in
+    let offsets = Closure_offsets.compute program in
+    { fun_offset_table = offsets.function_offsets;
+      fv_offset_table = offsets.free_variable_offsets;
+      constant_closures;
+      closures;
+    }
+  in
+  let imported_units =
+    let imported = Compilenv.approx_env () in
+    let closures =
+      Set_of_closures_id.Map.fold
+        (fun (_ : Set_of_closures_id.t) fun_decls acc ->
+           Variable.Map.fold
+             (fun var (_ : Simple_value_approx.function_declaration) acc ->
+               let closure_id = Closure_id.wrap var in
+               Closure_id.Set.add closure_id acc)
+             fun_decls.Simple_value_approx.funs
+             acc)
+        imported.sets_of_closures
+        Closure_id.Set.empty
+    in
+    { fun_offset_table = imported.offset_fun;
+      fv_offset_table = imported.offset_fv;
+      constant_closures = imported.constant_closures;
+      closures;
+    }
+  in
+  let t =
+    { current_unit;
+      imported_units;
+      constants_for_instrumentation = Symbol.Map.empty;
+      ppf_dump;
+    }
+  in
+  let expr, structured_constants, preallocated_blocks =
+    to_clambda_program t Env.empty Symbol.Map.empty program
+  in
+  let structured_constants =
+    Symbol.Map.disjoint_union structured_constants
+      t.constants_for_instrumentation
+  in
+  let exported =
+    Export_info.t_of_transient exported_transient
+      ~program
+      ~local_offset_fun:current_unit.fun_offset_table
+      ~local_offset_fv:current_unit.fv_offset_table
+      ~imported_offset_fun:imported_units.fun_offset_table
+      ~imported_offset_fv:imported_units.fv_offset_table
+      ~constant_closures:current_unit.constant_closures
+  in
+  { expr; preallocated_blocks; structured_constants; exported; }
diff --git a/middle_end/flambda/flambda_to_clambda.mli b/middle_end/flambda/flambda_to_clambda.mli
new file mode 100644
index 00000000..d08af3e2
--- /dev/null
+++ b/middle_end/flambda/flambda_to_clambda.mli
@@ -0,0 +1,41 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+type result = {
+  expr : Clambda.ulambda;
+  preallocated_blocks : Clambda.preallocated_block list;
+  structured_constants : Clambda.ustructured_constant Symbol.Map.t;
+  exported : Export_info.t;
+}
+
+(** Convert an Flambda program, with associated proto-export information,
+    to Clambda.
+    This yields a Clambda expression together with augmented export
+    information and details about required statically-allocated values
+    (preallocated blocks, for [Initialize_symbol], and structured
+    constants).
+
+    It is during this process that accesses to variables within
+    closures are transformed to field accesses within closure values.
+    For direct calls, the hidden closure parameter is added.  Switch
+    tables are also built.
+*)
+val convert
+   : ppf_dump:Format.formatter
+  -> Flambda.program * Export_info.transient
+  -> result
diff --git a/middle_end/flambda/flambda_utils.ml b/middle_end/flambda/flambda_utils.ml
new file mode 100644
index 00000000..c204f5e6
--- /dev/null
+++ b/middle_end/flambda/flambda_utils.ml
@@ -0,0 +1,929 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+let name_expr ~name (named : Flambda.named) : Flambda.t =
+  let var =
+    Variable.create
+      ~current_compilation_unit:(Compilation_unit.get_current_exn ())
+      name
+  in
+  Flambda.create_let var named (Var var)
+
+let name_expr_from_var ~var (named : Flambda.named) : Flambda.t =
+  let var =
+    Variable.rename
+      ~current_compilation_unit:(Compilation_unit.get_current_exn ())
+      var
+  in
+  Flambda.create_let var named (Var var)
+
+let find_declaration cf ({ funs } : Flambda.function_declarations) =
+  Variable.Map.find (Closure_id.unwrap cf) funs
+
+let find_declaration_variable cf ({ funs } : Flambda.function_declarations) =
+  let var = Closure_id.unwrap cf in
+  if not (Variable.Map.mem var funs)
+  then raise Not_found
+  else var
+
+let find_free_variable cv ({ free_vars } : Flambda.set_of_closures) =
+  let var : Flambda.specialised_to =
+    Variable.Map.find (Var_within_closure.unwrap cv) free_vars
+  in
+  var.var
+
+let function_arity (f : Flambda.function_declaration) = List.length f.params
+
+let variables_bound_by_the_closure cf
+      (decls : Flambda.function_declarations) =
+  let func = find_declaration cf decls in
+  let params = Parameter.Set.vars func.params in
+  let functions = Variable.Map.keys decls.funs in
+  Variable.Set.diff
+    (Variable.Set.diff func.free_variables params)
+    functions
+
+let description_of_toplevel_node (expr : Flambda.t) =
+  match expr with
+  | Var id -> Format.asprintf "var %a" Variable.print id
+  | Apply _ -> "apply"
+  | Assign _ -> "assign"
+  | Send _ -> "send"
+  | Proved_unreachable -> "unreachable"
+  | Let { var; _ } -> Format.asprintf "let %a" Variable.print var
+  | Let_mutable _ -> "let_mutable"
+  | Let_rec _ -> "letrec"
+  | If_then_else _ -> "if"
+  | Switch _ -> "switch"
+  | String_switch _ -> "stringswitch"
+  | Static_raise  _ -> "staticraise"
+  | Static_catch  _ -> "catch"
+  | Try_with _ -> "trywith"
+  | While _ -> "while"
+  | For _ -> "for"
+
+let equal_direction_flag
+      (x : Asttypes.direction_flag)
+      (y : Asttypes.direction_flag) =
+  match x, y with
+  | Upto, Upto -> true
+  | Downto, Downto -> true
+  | (Upto | Downto), _ -> false
+
+let rec same (l1 : Flambda.t) (l2 : Flambda.t) =
+  l1 == l2 || (* it is ok for the string case: if they are physically the same,
+                 it is the same original branch *)
+  match (l1, l2) with
+  | Var v1 , Var v2  -> Variable.equal v1 v2
+  | Var _, _ | _, Var _ -> false
+  | Apply a1 , Apply a2  ->
+    Flambda.equal_call_kind a1.kind a2.kind
+      && Variable.equal a1.func a2.func
+      && Misc.Stdlib.List.equal Variable.equal a1.args a2.args
+  | Apply _, _ | _, Apply _ -> false
+  | Let { var = var1; defining_expr = defining_expr1; body = body1; _ },
+      Let { var = var2; defining_expr = defining_expr2; body = body2; _ } ->
+    Variable.equal var1 var2 && same_named defining_expr1 defining_expr2
+      && same body1 body2
+  | Let _, _ | _, Let _ -> false
+  | Let_mutable {var = mv1; initial_value = v1; contents_kind = ck1; body = b1},
+    Let_mutable {var = mv2; initial_value = v2; contents_kind = ck2; body = b2}
+    ->
+    Mutable_variable.equal mv1 mv2
+      && Variable.equal v1 v2
+      && Lambda.equal_value_kind ck1 ck2
+      && same b1 b2
+  | Let_mutable _, _ | _, Let_mutable _ -> false
+  | Let_rec (bl1, a1), Let_rec (bl2, a2) ->
+    Misc.Stdlib.List.equal samebinding bl1 bl2 && same a1 a2
+  | Let_rec _, _ | _, Let_rec _ -> false
+  | Switch (a1, s1), Switch (a2, s2) ->
+    Variable.equal a1 a2 && sameswitch s1 s2
+  | Switch _, _ | _, Switch _ -> false
+  | String_switch (a1, s1, d1), String_switch (a2, s2, d2) ->
+    Variable.equal a1 a2
+      && Misc.Stdlib.List.equal
+        (fun (s1, e1) (s2, e2) -> String.equal s1 s2 && same e1 e2) s1 s2
+      && Option.equal same d1 d2
+  | String_switch _, _ | _, String_switch _ -> false
+  | Static_raise (e1, a1), Static_raise (e2, a2) ->
+    Static_exception.equal e1 e2 && Misc.Stdlib.List.equal Variable.equal a1 a2
+  | Static_raise _, _ | _, Static_raise _ -> false
+  | Static_catch (s1, v1, a1, b1), Static_catch (s2, v2, a2, b2) ->
+    Static_exception.equal s1 s2
+      && Misc.Stdlib.List.equal Variable.equal v1 v2
+      && same a1 a2
+      && same b1 b2
+  | Static_catch _, _ | _, Static_catch _ -> false
+  | Try_with (a1, v1, b1), Try_with (a2, v2, b2) ->
+    same a1 a2 && Variable.equal v1 v2 && same b1 b2
+  | Try_with _, _ | _, Try_with _ -> false
+  | If_then_else (a1, b1, c1), If_then_else (a2, b2, c2) ->
+    Variable.equal a1 a2 && same b1 b2 && same c1 c2
+  | If_then_else _, _ | _, If_then_else _ -> false
+  | While (a1, b1), While (a2, b2) ->
+    same a1 a2 && same b1 b2
+  | While _, _ | _, While _ -> false
+  | For { bound_var = bound_var1; from_value = from_value1;
+          to_value = to_value1; direction = direction1; body = body1; },
+    For { bound_var = bound_var2; from_value = from_value2;
+          to_value = to_value2; direction = direction2; body = body2; } ->
+    Variable.equal bound_var1 bound_var2
+      && Variable.equal from_value1 from_value2
+      && Variable.equal to_value1 to_value2
+      && equal_direction_flag direction1 direction2
+      && same body1 body2
+  | For _, _ | _, For _ -> false
+  | Assign { being_assigned = being_assigned1; new_value = new_value1; },
+    Assign { being_assigned = being_assigned2; new_value = new_value2; } ->
+    Mutable_variable.equal being_assigned1 being_assigned2
+      && Variable.equal new_value1 new_value2
+  | Assign _, _ | _, Assign _ -> false
+  | Send { kind = kind1; meth = meth1; obj = obj1; args = args1; dbg = _; },
+    Send { kind = kind2; meth = meth2; obj = obj2; args = args2; dbg = _; } ->
+    Lambda.equal_meth_kind kind1 kind2
+      && Variable.equal meth1 meth2
+      && Variable.equal obj1 obj2
+      && Misc.Stdlib.List.equal Variable.equal args1 args2
+  | Send _, _ | _, Send _ -> false
+  | Proved_unreachable, Proved_unreachable -> true
+
+and same_named (named1 : Flambda.named) (named2 : Flambda.named) =
+  match named1, named2 with
+  | Symbol s1 , Symbol s2  -> Symbol.equal s1 s2
+  | Symbol _, _ | _, Symbol _ -> false
+  | Const c1, Const c2 -> Flambda.compare_const c1 c2 = 0
+  | Const _, _ | _, Const _ -> false
+  | Allocated_const c1, Allocated_const c2 ->
+    Allocated_const.compare c1 c2 = 0
+  | Allocated_const _, _ | _, Allocated_const _ -> false
+  | Read_mutable mv1, Read_mutable mv2 -> Mutable_variable.equal mv1 mv2
+  | Read_mutable _, _ | _, Read_mutable _ -> false
+  | Read_symbol_field (s1, i1), Read_symbol_field (s2, i2) ->
+    Symbol.equal s1 s2 && i1 = i2
+  | Read_symbol_field _, _ | _, Read_symbol_field _ -> false
+  | Set_of_closures s1, Set_of_closures s2 -> same_set_of_closures s1 s2
+  | Set_of_closures _, _ | _, Set_of_closures _ -> false
+  | Project_closure f1, Project_closure f2 -> same_project_closure f1 f2
+  | Project_closure _, _ | _, Project_closure _ -> false
+  | Project_var v1, Project_var v2 ->
+    Variable.equal v1.closure v2.closure
+      && Closure_id.equal v1.closure_id v2.closure_id
+      && Var_within_closure.equal v1.var v2.var
+  | Project_var _, _ | _, Project_var _ -> false
+  | Move_within_set_of_closures m1, Move_within_set_of_closures m2 ->
+    same_move_within_set_of_closures m1 m2
+  | Move_within_set_of_closures _, _ | _, Move_within_set_of_closures _ ->
+    false
+  | Prim (p1, al1, _), Prim (p2, al2, _) ->
+    Clambda_primitives.equal p1 p2
+      && Misc.Stdlib.List.equal Variable.equal al1 al2
+  | Prim _, _ | _, Prim _ -> false
+  | Expr e1, Expr e2 -> same e1 e2
+
+and sameclosure (c1 : Flambda.function_declaration)
+      (c2 : Flambda.function_declaration) =
+  Misc.Stdlib.List.equal Parameter.equal c1.params c2.params
+    && same c1.body c2.body
+
+and same_set_of_closures (c1 : Flambda.set_of_closures)
+      (c2 : Flambda.set_of_closures) =
+  Variable.Map.equal sameclosure c1.function_decls.funs c2.function_decls.funs
+    && Variable.Map.equal Flambda.equal_specialised_to
+        c1.free_vars c2.free_vars
+    && Variable.Map.equal Flambda.equal_specialised_to c1.specialised_args
+        c2.specialised_args
+
+and same_project_closure (s1 : Flambda.project_closure)
+      (s2 : Flambda.project_closure) =
+  Variable.equal s1.set_of_closures s2.set_of_closures
+    && Closure_id.equal s1.closure_id s2.closure_id
+
+and same_move_within_set_of_closures (m1 : Flambda.move_within_set_of_closures)
+      (m2 : Flambda.move_within_set_of_closures) =
+  Variable.equal m1.closure m2.closure
+    && Closure_id.equal m1.start_from m2.start_from
+    && Closure_id.equal m1.move_to m2.move_to
+
+and samebinding (v1, n1) (v2, n2) =
+  Variable.equal v1 v2 && same_named n1 n2
+
+and sameswitch (fs1 : Flambda.switch) (fs2 : Flambda.switch) =
+  let samecase (n1, a1) (n2, a2) = n1 = n2 && same a1 a2 in
+  Numbers.Int.Set.equal fs1.numconsts fs2.numconsts
+    && Numbers.Int.Set.equal fs1.numblocks fs2.numblocks
+    && Misc.Stdlib.List.equal samecase fs1.consts fs2.consts
+    && Misc.Stdlib.List.equal samecase fs1.blocks fs2.blocks
+    && Option.equal same fs1.failaction fs2.failaction
+
+let can_be_merged = same
+
+(* CR-soon mshinwell: this should use the explicit ignore functions *)
+let toplevel_substitution sb tree =
+  let sb' = sb in
+  let sb v = try Variable.Map.find v sb with Not_found -> v in
+  let aux (flam : Flambda.t) : Flambda.t =
+    match flam with
+    | Var var ->
+      let var = sb var in
+      Var var
+    | Let_mutable mutable_let ->
+      let initial_value = sb mutable_let.initial_value in
+      Let_mutable { mutable_let with initial_value }
+    | Assign { being_assigned; new_value; } ->
+      let new_value = sb new_value in
+      Assign { being_assigned; new_value; }
+    | Apply { func; args; kind; dbg; inline; specialise; } ->
+      let func = sb func in
+      let args = List.map sb args in
+      Apply { func; args; kind; dbg; inline; specialise; }
+    | If_then_else (cond, e1, e2) ->
+      let cond = sb cond in
+      If_then_else (cond, e1, e2)
+    | Switch (cond, sw) ->
+      let cond = sb cond in
+      Switch (cond, sw)
+    | String_switch (cond, branches, def) ->
+      let cond = sb cond in
+      String_switch (cond, branches, def)
+    | Send { kind; meth; obj; args; dbg } ->
+      let meth = sb meth in
+      let obj = sb obj in
+      let args = List.map sb args in
+      Send { kind; meth; obj; args; dbg }
+    | For { bound_var; from_value; to_value; direction; body } ->
+      let from_value = sb from_value in
+      let to_value = sb to_value in
+      For { bound_var; from_value; to_value; direction; body }
+    | Static_raise (static_exn, args) ->
+      let args = List.map sb args in
+      Static_raise (static_exn, args)
+    | Static_catch _ | Try_with _ | While _
+    | Let _ | Let_rec _ | Proved_unreachable -> flam
+  in
+  let aux_named (named : Flambda.named) : Flambda.named =
+    match named with
+    | Symbol _ | Const _ | Expr _ -> named
+    | Allocated_const _ | Read_mutable _ -> named
+    | Read_symbol_field _ -> named
+    | Set_of_closures set_of_closures ->
+      let set_of_closures =
+        Flambda.create_set_of_closures
+          ~function_decls:set_of_closures.function_decls
+          ~free_vars:
+            (Variable.Map.map (fun (spec_to : Flambda.specialised_to) ->
+                { spec_to with var = sb spec_to.var; })
+              set_of_closures.free_vars)
+          ~specialised_args:
+            (Variable.Map.map (fun (spec_to : Flambda.specialised_to) ->
+                { spec_to with var = sb spec_to.var; })
+              set_of_closures.specialised_args)
+          ~direct_call_surrogates:set_of_closures.direct_call_surrogates
+      in
+      Set_of_closures set_of_closures
+    | Project_closure project_closure ->
+      Project_closure {
+        project_closure with
+        set_of_closures = sb project_closure.set_of_closures;
+      }
+    | Move_within_set_of_closures move_within_set_of_closures ->
+      Move_within_set_of_closures {
+        move_within_set_of_closures with
+        closure = sb move_within_set_of_closures.closure;
+      }
+    | Project_var project_var ->
+      Project_var {
+        project_var with
+        closure = sb project_var.closure;
+      }
+    | Prim (prim, args, dbg) ->
+      Prim (prim, List.map sb args, dbg)
+  in
+  if Variable.Map.is_empty sb' then tree
+  else Flambda_iterators.map_toplevel aux aux_named tree
+
+(* CR-someday mshinwell: Fix [Flambda_iterators] so this can be implemented
+   properly. *)
+let toplevel_substitution_named sb named =
+  let name = Internal_variable_names.toplevel_substitution_named in
+  let expr = name_expr named ~name in
+  match toplevel_substitution sb expr with
+  | Let let_expr -> let_expr.defining_expr
+  | _ -> assert false
+
+let make_closure_declaration
+      ~is_classic_mode ~id ~body ~params ~stub : Flambda.t =
+  let free_variables = Flambda.free_variables body in
+  let param_set = Parameter.Set.vars params in
+  if not (Variable.Set.subset param_set free_variables) then begin
+    Misc.fatal_error "Flambda_utils.make_closure_declaration"
+  end;
+  let sb =
+    Variable.Set.fold
+      (fun id sb -> Variable.Map.add id (Variable.rename id) sb)
+      free_variables Variable.Map.empty
+  in
+  (* CR-soon mshinwell: try to eliminate this [toplevel_substitution].  This
+     function is only called from [Inline_and_simplify], so we should be able
+     to do something similar to what happens in [Inlining_transforms] now. *)
+  let body = toplevel_substitution sb body in
+  let subst id = Variable.Map.find id sb in
+  let subst_param param = Parameter.map_var subst param in
+  let function_declaration =
+    Flambda.create_function_declaration ~params:(List.map subst_param params)
+      ~body ~stub ~dbg:Debuginfo.none ~inline:Default_inline
+      ~specialise:Default_specialise ~is_a_functor:false
+      ~closure_origin:(Closure_origin.create (Closure_id.wrap id))
+  in
+  assert (Variable.Set.equal (Variable.Set.map subst free_variables)
+    function_declaration.free_variables);
+  let free_vars =
+    Variable.Map.fold (fun id id' fv' ->
+        let spec_to : Flambda.specialised_to =
+          { var = id;
+            projection = None;
+          }
+        in
+        Variable.Map.add id' spec_to fv')
+      (Variable.Map.filter
+        (fun id _ -> not (Variable.Set.mem id param_set))
+        sb)
+      Variable.Map.empty
+  in
+  let compilation_unit = Compilation_unit.get_current_exn () in
+  let set_of_closures_var =
+    Variable.create Internal_variable_names.set_of_closures
+      ~current_compilation_unit:compilation_unit
+  in
+  let set_of_closures =
+    let function_decls =
+      Flambda.create_function_declarations
+        ~is_classic_mode
+        ~funs:(Variable.Map.singleton id function_declaration)
+    in
+    Flambda.create_set_of_closures ~function_decls ~free_vars
+      ~specialised_args:Variable.Map.empty
+      ~direct_call_surrogates:Variable.Map.empty
+  in
+  let project_closure : Flambda.named =
+    Project_closure {
+        set_of_closures = set_of_closures_var;
+        closure_id = Closure_id.wrap id;
+      }
+  in
+  let project_closure_var =
+    Variable.create Internal_variable_names.project_closure
+      ~current_compilation_unit:compilation_unit
+  in
+  Flambda.create_let set_of_closures_var (Set_of_closures set_of_closures)
+    (Flambda.create_let project_closure_var project_closure
+      (Var (project_closure_var)))
+
+let bind ~bindings ~body =
+  List.fold_left (fun expr (var, var_def) ->
+      Flambda.create_let var var_def expr)
+    body bindings
+
+let all_lifted_constants (program : Flambda.program) =
+  let rec loop (program : Flambda.program_body) =
+    match program with
+    | Let_symbol (symbol, decl, program) -> (symbol, decl) :: (loop program)
+    | Let_rec_symbol (decls, program) ->
+      List.fold_left (fun l (symbol, decl) -> (symbol, decl) :: l)
+        (loop program)
+        decls
+    | Initialize_symbol (_, _, _, program)
+    | Effect (_, program) -> loop program
+    | End _ -> []
+  in
+  loop program.program_body
+
+let all_lifted_constants_as_map program =
+  Symbol.Map.of_list (all_lifted_constants program)
+
+let initialize_symbols (program : Flambda.program) =
+  let rec loop (program : Flambda.program_body) =
+    match program with
+    | Initialize_symbol (symbol, tag, fields, program) ->
+      (symbol, tag, fields) :: (loop program)
+    | Effect (_, program)
+    | Let_symbol (_, _, program)
+    | Let_rec_symbol (_, program) -> loop program
+    | End _ -> []
+  in
+  loop program.program_body
+
+let imported_symbols (program : Flambda.program) =
+  program.imported_symbols
+
+let needed_import_symbols (program : Flambda.program) =
+  let dependencies = Flambda.free_symbols_program program in
+  let defined_symbol =
+    Symbol.Set.union
+      (Symbol.Set.of_list
+         (List.map fst (all_lifted_constants program)))
+      (Symbol.Set.of_list
+         (List.map (fun (s, _, _) -> s) (initialize_symbols program)))
+  in
+  Symbol.Set.diff dependencies defined_symbol
+
+let introduce_needed_import_symbols program : Flambda.program =
+  { program with
+    imported_symbols = needed_import_symbols program;
+  }
+
+let root_symbol (program : Flambda.program) =
+  let rec loop (program : Flambda.program_body) =
+    match program with
+    | Effect (_, program)
+    | Let_symbol (_, _, program)
+    | Let_rec_symbol (_, program)
+    | Initialize_symbol (_, _, _, program) -> loop program
+    | End root ->
+      root
+  in
+  loop program.program_body
+
+let might_raise_static_exn flam stexn =
+  try
+    Flambda_iterators.iter_on_named
+      (function
+        | Flambda.Static_raise (ex, _) when Static_exception.equal ex stexn ->
+          raise Exit
+        | _ -> ())
+      (fun _ -> ())
+      flam;
+    false
+  with Exit -> true
+
+let make_closure_map program =
+  let map = ref Closure_id.Map.empty in
+  let add_set_of_closures ~constant:_ : Flambda.set_of_closures -> unit = fun
+    { function_decls } ->
+    Variable.Map.iter (fun var _ ->
+        let closure_id = Closure_id.wrap var in
+        let set_of_closures_id = function_decls.set_of_closures_id in
+        map := Closure_id.Map.add closure_id set_of_closures_id !map)
+      function_decls.funs
+  in
+  Flambda_iterators.iter_on_set_of_closures_of_program
+    program
+    ~f:add_set_of_closures;
+  !map
+
+let all_lifted_constant_closures program =
+  List.fold_left (fun unchanged flambda ->
+      match flambda with
+      | (_, Flambda.Set_of_closures { function_decls = { funs } }) ->
+        Variable.Map.fold
+          (fun key (_ : Flambda.function_declaration) acc ->
+             Closure_id.Set.add (Closure_id.wrap key) acc)
+          funs
+          unchanged
+      | _ -> unchanged)
+    Closure_id.Set.empty
+    (all_lifted_constants program)
+
+let all_lifted_constant_sets_of_closures program =
+  let set = ref Set_of_closures_id.Set.empty in
+  List.iter (function
+      | (_, Flambda.Set_of_closures {
+          function_decls = { set_of_closures_id } }) ->
+        set := Set_of_closures_id.Set.add set_of_closures_id !set
+      | _ -> ())
+    (all_lifted_constants program);
+  !set
+
+let all_sets_of_closures program =
+  let list = ref [] in
+  Flambda_iterators.iter_on_set_of_closures_of_program program
+    ~f:(fun ~constant:_ set_of_closures ->
+        list := set_of_closures :: !list);
+  !list
+
+let all_sets_of_closures_map program =
+  let r = ref Set_of_closures_id.Map.empty in
+  Flambda_iterators.iter_on_set_of_closures_of_program program
+    ~f:(fun ~constant:_ set_of_closures ->
+      r := Set_of_closures_id.Map.add
+          set_of_closures.function_decls.set_of_closures_id
+          set_of_closures !r);
+  !r
+
+let substitute_read_symbol_field_for_variables
+    (substitution : (Symbol.t * int list) Variable.Map.t)
+    (expr : Flambda.t) =
+  let bind var fresh_var (expr:Flambda.t) : Flambda.t =
+    let symbol, path = Variable.Map.find var substitution in
+    let rec make_named (path:int list) : Flambda.named =
+      match path with
+      | [] -> Symbol symbol
+      | [i] -> Read_symbol_field (symbol, i)
+      | h :: t ->
+          let block_name = Internal_variable_names.symbol_field_block in
+          let block = Variable.create block_name in
+          let field_name = Internal_variable_names.get_symbol_field in
+          let field = Variable.create field_name in
+          Expr (
+            Flambda.create_let block (make_named t)
+              (Flambda.create_let field
+                 (Prim (Pfield h, [block], Debuginfo.none))
+                 (Var field)))
+    in
+    Flambda.create_let fresh_var (make_named path) expr
+  in
+  let substitute_named bindings (named:Flambda.named) : Flambda.named =
+    let sb to_substitute =
+      try Variable.Map.find to_substitute bindings with
+      | Not_found ->
+        to_substitute
+    in
+    match named with
+    | Symbol _ | Const _ | Expr _ -> named
+    | Allocated_const _ | Read_mutable _ -> named
+    | Read_symbol_field _ -> named
+    | Set_of_closures set_of_closures ->
+      let set_of_closures =
+        Flambda.create_set_of_closures
+          ~function_decls:set_of_closures.function_decls
+          ~free_vars:
+            (Variable.Map.map (fun (spec_to : Flambda.specialised_to) ->
+                { spec_to with var = sb spec_to.var; })
+              set_of_closures.free_vars)
+          ~specialised_args:
+            (Variable.Map.map (fun (spec_to : Flambda.specialised_to) ->
+                { spec_to with var = sb spec_to.var; })
+              set_of_closures.specialised_args)
+          ~direct_call_surrogates:set_of_closures.direct_call_surrogates
+      in
+      Set_of_closures set_of_closures
+    | Project_closure project_closure ->
+      Project_closure {
+        project_closure with
+        set_of_closures = sb project_closure.set_of_closures;
+      }
+    | Move_within_set_of_closures move_within_set_of_closures ->
+      Move_within_set_of_closures {
+        move_within_set_of_closures with
+        closure = sb move_within_set_of_closures.closure;
+      }
+    | Project_var project_var ->
+      Project_var {
+        project_var with
+        closure = sb project_var.closure;
+      }
+    | Prim (prim, args, dbg) ->
+      Prim (prim, List.map sb args, dbg)
+  in
+  let make_var_subst var =
+    if Variable.Map.mem var substitution then
+      let fresh = Variable.rename var in
+      fresh, (fun expr -> bind var fresh expr)
+    else
+      var, (fun x -> x)
+  in
+  let f (expr:Flambda.t) : Flambda.t =
+    match expr with
+    | Var v when Variable.Map.mem v substitution ->
+      let fresh = Variable.rename v in
+      bind v fresh (Var fresh)
+    | Var _ -> expr
+    | Let ({ var = v; defining_expr = named; _ } as let_expr) ->
+      let to_substitute =
+        Variable.Set.filter
+          (fun v -> Variable.Map.mem v substitution)
+          (Flambda.free_variables_named named)
+      in
+      if Variable.Set.is_empty to_substitute then
+        expr
+      else
+        let bindings =
+          Variable.Map.of_set (fun var -> Variable.rename var) to_substitute
+        in
+        let named =
+          substitute_named bindings named
+        in
+        let expr =
+          let module W = Flambda.With_free_variables in
+          W.create_let_reusing_body v named (W.of_body_of_let let_expr)
+        in
+        Variable.Map.fold (fun to_substitute fresh expr ->
+            bind to_substitute fresh expr)
+          bindings expr
+    | Let_mutable let_mutable when
+        Variable.Map.mem let_mutable.initial_value substitution ->
+      let fresh = Variable.rename let_mutable.initial_value in
+      bind let_mutable.initial_value fresh
+        (Let_mutable { let_mutable with initial_value = fresh })
+    | Let_mutable _ ->
+      expr
+    | Let_rec (defs, body) ->
+      let free_variables_of_defs =
+        List.fold_left (fun set (_, named) ->
+            Variable.Set.union set (Flambda.free_variables_named named))
+          Variable.Set.empty defs
+      in
+      let to_substitute =
+        Variable.Set.filter
+          (fun v -> Variable.Map.mem v substitution)
+          free_variables_of_defs
+      in
+      if Variable.Set.is_empty to_substitute then
+        expr
+      else begin
+        let bindings =
+          Variable.Map.of_set (fun var -> Variable.rename var) to_substitute
+        in
+        let defs =
+          List.map (fun (var, named) ->
+              var, substitute_named bindings named)
+            defs
+        in
+        let expr =
+          Flambda.Let_rec (defs, body)
+        in
+        Variable.Map.fold (fun to_substitute fresh expr ->
+            bind to_substitute fresh expr)
+          bindings expr
+      end
+    | If_then_else (cond, ifso, ifnot)
+        when Variable.Map.mem cond substitution ->
+      let fresh = Variable.rename cond in
+      bind cond fresh (If_then_else (fresh, ifso, ifnot))
+    | If_then_else _ ->
+      expr
+    | Switch (cond, sw) when Variable.Map.mem cond substitution ->
+      let fresh = Variable.rename cond in
+      bind cond fresh (Switch (fresh, sw))
+    | Switch _ ->
+      expr
+    | String_switch (cond, sw, def) when Variable.Map.mem cond substitution ->
+      let fresh = Variable.rename cond in
+      bind cond fresh (String_switch (fresh, sw, def))
+    | String_switch _ ->
+      expr
+    | Assign { being_assigned; new_value }
+        when Variable.Map.mem new_value substitution ->
+      let fresh = Variable.rename new_value in
+      bind new_value fresh (Assign { being_assigned; new_value = fresh })
+    | Assign _ ->
+      expr
+    | Static_raise (exn, args) ->
+      let args, bind_args =
+        List.split (List.map make_var_subst args)
+      in
+      List.fold_right (fun f expr -> f expr) bind_args @@
+        Flambda.Static_raise (exn, args)
+    | For { bound_var; from_value; to_value; direction; body } ->
+      let from_value, bind_from_value = make_var_subst from_value in
+      let to_value, bind_to_value = make_var_subst to_value in
+      bind_from_value @@
+      bind_to_value @@
+      Flambda.For { bound_var; from_value; to_value; direction; body }
+    | Apply { func; args; kind; dbg; inline; specialise } ->
+      let func, bind_func = make_var_subst func in
+      let args, bind_args =
+        List.split (List.map make_var_subst args)
+      in
+      bind_func @@
+      List.fold_right (fun f expr -> f expr) bind_args @@
+      Flambda.Apply { func; args; kind; dbg; inline; specialise }
+    | Send { kind; meth; obj; args; dbg } ->
+      let meth, bind_meth = make_var_subst meth in
+      let obj, bind_obj = make_var_subst obj in
+      let args, bind_args =
+        List.split (List.map make_var_subst args)
+      in
+      bind_meth @@
+      bind_obj @@
+      List.fold_right (fun f expr -> f expr) bind_args @@
+      Flambda.Send { kind; meth; obj; args; dbg }
+    | Proved_unreachable
+    | While _
+    | Try_with _
+    | Static_catch _ ->
+      (* No variables directly used in those expressions *)
+      expr
+  in
+  Flambda_iterators.map_toplevel f (fun v -> v) expr
+
+module Switch_storer = Switch.Store (struct
+  type t = Flambda.t
+
+  (* An easily-comparable subset of [Flambda.t]: currently this only
+     supports that required to share switch branches. *)
+  type key =
+    | Var of Variable.t
+    | Let of Variable.t * key_named * key
+    | Static_raise of Static_exception.t * Variable.t list
+  and key_named =
+    | Symbol of Symbol.t
+    | Const of Flambda.const
+    | Prim of Clambda_primitives.primitive * Variable.t list
+    | Expr of key
+
+  exception Not_comparable
+
+  let rec make_expr_key (expr : Flambda.t) : key =
+    match expr with
+    | Var v -> Var v
+    | Let { var; defining_expr; body; } ->
+      Let (var, make_named_key defining_expr, make_expr_key body)
+    | Static_raise (e, args) -> Static_raise (e, args)
+    | _ -> raise Not_comparable
+  and make_named_key (named:Flambda.named) : key_named =
+    match named with
+    | Symbol s -> Symbol s
+    | Const c -> Const c
+    | Expr e -> Expr (make_expr_key e)
+    | Prim (prim, args, _dbg) -> Prim (prim, args)
+    | _ -> raise Not_comparable
+
+  let make_key expr =
+    match make_expr_key expr with
+    | exception Not_comparable -> None
+    | key -> Some key
+
+  let compare_key e1 e2 =
+    (* The environment [env] maps variables bound in [e2] to the corresponding
+       bound variables in [e1]. Every variable to compare in [e2] must have an
+       equivalent in [e1], otherwise the comparison wouldn't have gone
+       past the [Let] binding.  Hence [Variable.Map.find] is safe here. *)
+    let compare_var env v1 v2 =
+      match Variable.Map.find v2 env with
+      | exception Not_found ->
+        (* The variable is free in the expression [e2], hence we can
+           compare it with [v1] directly. *)
+        Variable.compare v1 v2
+      | bound ->
+        Variable.compare v1 bound
+    in
+    let rec compare_expr env (e1 : key) (e2 : key) : int =
+      match e1, e2 with
+      | Var v1, Var v2 ->
+        compare_var env v1 v2
+      | Var _, (Let _| Static_raise _) -> -1
+      | (Let _| Static_raise _), Var _ ->  1
+      | Let (v1, n1, b1), Let (v2, n2, b2) ->
+        let comp_named = compare_named env n1 n2 in
+        if comp_named <> 0 then comp_named
+        else
+          let env = Variable.Map.add v2 v1 env in
+          compare_expr env b1 b2
+      | Let _, Static_raise _ -> -1
+      | Static_raise _, Let _ ->  1
+      | Static_raise (sexn1, args1), Static_raise (sexn2, args2) ->
+        let comp_sexn = Static_exception.compare sexn1 sexn2 in
+        if comp_sexn <> 0 then comp_sexn
+        else Misc.Stdlib.List.compare (compare_var env) args1 args2
+    and compare_named env (n1:key_named) (n2:key_named) : int =
+      match n1, n2 with
+      | Symbol s1, Symbol s2 -> Symbol.compare s1 s2
+      | Symbol _, (Const _ | Expr _ | Prim _) -> -1
+      | (Const _ | Expr _ | Prim _), Symbol _ ->  1
+      | Const c1, Const c2 -> Flambda.compare_const c1 c2
+      | Const _, (Expr _ | Prim _) -> -1
+      | (Expr _ | Prim _), Const _ ->  1
+      | Expr e1, Expr e2 -> compare_expr env e1 e2
+      | Expr _, Prim _ -> -1
+      | Prim _, Expr _ ->  1
+      | Prim (prim1, args1), Prim (prim2, args2) ->
+        let comp_prim = Stdlib.compare prim1 prim2 in
+        if comp_prim <> 0 then comp_prim
+        else Misc.Stdlib.List.compare (compare_var env) args1 args2
+    in
+    compare_expr Variable.Map.empty e1 e2
+end)
+
+let fun_vars_referenced_in_decls
+      (function_decls : Flambda.function_declarations) ~closure_symbol =
+  let fun_vars = Variable.Map.keys function_decls.funs in
+  let symbols_to_fun_vars =
+    Variable.Set.fold (fun fun_var symbols_to_fun_vars ->
+        let closure_id = Closure_id.wrap fun_var in
+        let symbol = closure_symbol closure_id in
+        Symbol.Map.add symbol fun_var symbols_to_fun_vars)
+      fun_vars
+      Symbol.Map.empty
+  in
+  Variable.Map.map (fun (func_decl : Flambda.function_declaration) ->
+      let from_symbols =
+        Symbol.Set.fold (fun symbol fun_vars' ->
+            match Symbol.Map.find symbol symbols_to_fun_vars with
+            | exception Not_found -> fun_vars'
+            | fun_var ->
+              assert (Variable.Set.mem fun_var fun_vars);
+              Variable.Set.add fun_var fun_vars')
+          func_decl.free_symbols
+          Variable.Set.empty
+      in
+      let from_variables =
+        Variable.Set.inter func_decl.free_variables fun_vars
+      in
+      Variable.Set.union from_symbols from_variables)
+    function_decls.funs
+
+let closures_required_by_entry_point ~(entry_point : Closure_id.t)
+      ~closure_symbol (function_decls : Flambda.function_declarations) =
+  let dependencies =
+    fun_vars_referenced_in_decls function_decls ~closure_symbol
+  in
+  let set = ref Variable.Set.empty in
+  let queue = Queue.create () in
+  let add v =
+    if not (Variable.Set.mem v !set) then begin
+      set := Variable.Set.add v !set;
+      Queue.push v queue
+    end
+  in
+  add (Closure_id.unwrap entry_point);
+  while not (Queue.is_empty queue) do
+    let fun_var = Queue.pop queue in
+    match Variable.Map.find fun_var dependencies with
+    | exception Not_found -> ()
+    | fun_dependencies ->
+      Variable.Set.iter (fun dep ->
+          if Variable.Map.mem dep function_decls.funs then
+            add dep)
+        fun_dependencies
+  done;
+  !set
+
+let all_functions_parameters (function_decls : Flambda.function_declarations) =
+  Variable.Map.fold (fun _ ({ params } : Flambda.function_declaration) set ->
+      Variable.Set.union set (Parameter.Set.vars params))
+    function_decls.funs Variable.Set.empty
+
+let all_free_symbols (function_decls : Flambda.function_declarations) =
+  Variable.Map.fold (fun _ (function_decl : Flambda.function_declaration)
+          syms ->
+      Symbol.Set.union syms function_decl.free_symbols)
+    function_decls.funs Symbol.Set.empty
+
+let contains_stub (fun_decls : Flambda.function_declarations) =
+  let number_of_stub_functions =
+    Variable.Map.cardinal
+      (Variable.Map.filter (fun _ { Flambda.stub } -> stub)
+         fun_decls.funs)
+  in
+  number_of_stub_functions > 0
+
+let clean_projections ~which_variables =
+  Variable.Map.map (fun (spec_to : Flambda.specialised_to) ->
+      match spec_to.projection with
+      | None -> spec_to
+      | Some projection ->
+        let from = Projection.projecting_from projection in
+        if Variable.Map.mem from which_variables then
+          spec_to
+        else
+          ({ spec_to with projection = None; } : Flambda.specialised_to))
+    which_variables
+
+let projection_to_named (projection : Projection.t) : Flambda.named =
+  match projection with
+  | Project_var project_var -> Project_var project_var
+  | Project_closure project_closure -> Project_closure project_closure
+  | Move_within_set_of_closures move -> Move_within_set_of_closures move
+  | Field (field_index, var) ->
+    Prim (Pfield field_index, [var], Debuginfo.none)
+
+type specialised_to_same_as =
+  | Not_specialised
+  | Specialised_and_aliased_to of Variable.Set.t
+
+let parameters_specialised_to_the_same_variable
+      ~(function_decls : Flambda.function_declarations)
+      ~(specialised_args : Flambda.specialised_to Variable.Map.t) =
+  let specialised_arg_aliasing =
+    (* For each external variable involved in a specialisation, which
+       internal variable(s) it maps to via that specialisation. *)
+    Variable.Map.transpose_keys_and_data_set
+      (Variable.Map.map (fun ({ var; _ } : Flambda.specialised_to) -> var)
+        specialised_args)
+  in
+  Variable.Map.map (fun ({ params; _ } : Flambda.function_declaration) ->
+      List.map (fun param ->
+          match Variable.Map.find (Parameter.var param) specialised_args with
+          | exception Not_found -> Not_specialised
+          | { var; _ } ->
+            Specialised_and_aliased_to
+              (Variable.Map.find var specialised_arg_aliasing))
+        params)
+    function_decls.funs
diff --git a/middle_end/flambda/flambda_utils.mli b/middle_end/flambda/flambda_utils.mli
new file mode 100644
index 00000000..0f7b3186
--- /dev/null
+++ b/middle_end/flambda/flambda_utils.mli
@@ -0,0 +1,220 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Utility functions for the Flambda intermediate language. *)
+
+(** Access functions *)
+
+(** [find_declaration f decl] raises [Not_found] if [f] is not in [decl]. *)
+val find_declaration :
+  Closure_id.t -> Flambda.function_declarations -> Flambda.function_declaration
+
+(** [find_declaration_variable f decl] raises [Not_found] if [f] is not in
+    [decl]. *)
+val find_declaration_variable :
+  Closure_id.t -> Flambda.function_declarations -> Variable.t
+
+(** [find_free_variable v clos] raises [Not_found] if [c] is not in [clos]. *)
+val find_free_variable :
+  Var_within_closure.t -> Flambda.set_of_closures -> Variable.t
+
+(** Utility functions *)
+
+val function_arity : Flambda.function_declaration -> int
+
+(** Variables "bound by a closure" are those variables free in the
+    corresponding function's body that are neither:
+    - bound as parameters of that function; nor
+    - bound by the [let] binding that introduces the function declaration(s).
+    In particular, if [f], [g] and [h] are being introduced by a
+    simultaneous, possibly mutually-recursive [let] binding then none of
+    [f], [g] or [h] are bound in any of the closures for [f], [g] and [h].
+*)
+val variables_bound_by_the_closure :
+  Closure_id.t -> Flambda.function_declarations -> Variable.Set.t
+
+(** If [can_be_merged f1 f2] is [true], it is safe to merge switch
+    branches containing [f1] and [f2]. *)
+val can_be_merged : Flambda.t -> Flambda.t -> bool
+
+val description_of_toplevel_node : Flambda.t -> string
+
+(* Given an expression, freshen all variables within it, and form a function
+   whose body is the resulting expression.  The variables specified by
+   [params] will become the parameters of the function; the closure will be
+   identified by [id].  [params] must only reference variables that are
+   free variables of [body]. *)
+(* CR-soon mshinwell: consider improving name and names of arguments
+   lwhite: the params restriction seems odd, perhaps give a reason
+   in the comment. *)
+val make_closure_declaration
+   : is_classic_mode:bool
+  -> id:Variable.t
+  -> body:Flambda.t
+  -> params:Parameter.t list
+  -> stub:bool
+  -> Flambda.t
+
+val toplevel_substitution
+   : Variable.t Variable.Map.t
+  -> Flambda.expr
+  -> Flambda.expr
+
+val toplevel_substitution_named
+   : Variable.t Variable.Map.t
+  -> Flambda.named
+  -> Flambda.named
+
+(** [bind [var1, expr1; ...; varN, exprN] body] binds using
+    [Immutable] [Let] expressions the given [(var, expr)] pairs around the
+    body. *)
+val bind
+   : bindings:(Variable.t * Flambda.named) list
+  -> body:Flambda.t
+  -> Flambda.t
+
+val name_expr
+    : name:Internal_variable_names.t
+   -> Flambda.named
+   -> Flambda.t
+
+val name_expr_from_var
+    : var:Variable.t
+   -> Flambda.named
+   -> Flambda.t
+
+val initialize_symbols
+   : Flambda.program
+  -> (Symbol.t * Tag.t * Flambda.t list) list
+
+val imported_symbols : Flambda.program -> Symbol.Set.t
+
+val needed_import_symbols : Flambda.program -> Symbol.Set.t
+
+val introduce_needed_import_symbols : Flambda.program -> Flambda.program
+
+val root_symbol : Flambda.program -> Symbol.t
+
+(** Returns [true] iff the given term might raise the given static
+    exception. *)
+val might_raise_static_exn : Flambda.named -> Static_exception.t -> bool
+
+(** Creates a map from closure IDs to set_of_closure IDs by iterating over
+    all sets of closures in the given program. *)
+val make_closure_map
+   : Flambda.program
+  -> Set_of_closures_id.t Closure_id.Map.t
+
+(** The definitions of all constants that have been lifted out to [Let_symbol]
+    or [Let_rec_symbol] constructions. *)
+val all_lifted_constants
+   : Flambda.program
+  -> (Symbol.t * Flambda.constant_defining_value) list
+
+(** Like [all_lifted_constant_symbols], but returns a map instead of a list. *)
+val all_lifted_constants_as_map
+   : Flambda.program
+  -> Flambda.constant_defining_value Symbol.Map.t
+
+(** The identifiers of all constant sets of closures that have been lifted out
+    to [Let_symbol] or [Let_rec_symbol] constructions. *)
+val all_lifted_constant_sets_of_closures
+   : Flambda.program
+  -> Set_of_closures_id.Set.t
+
+val all_lifted_constant_closures : Flambda.program -> Closure_id.Set.t
+
+(** All sets of closures in the given program (whether or not bound to a
+    symbol.) *)
+val all_sets_of_closures : Flambda.program -> Flambda.set_of_closures list
+
+val all_sets_of_closures_map
+   : Flambda.program
+  -> Flambda.set_of_closures Set_of_closures_id.Map.t
+
+
+(* CR-someday pchambart: A more general version of this function might
+   take a [named] instead of a symbol and be called with
+   [Read_symbol_field (symbol, 0)]. *)
+val substitute_read_symbol_field_for_variables
+   : (Symbol.t * int list) Variable.Map.t
+  -> Flambda.t
+  -> Flambda.t
+
+(** For the compilation of switch statements. *)
+module Switch_storer : sig
+  val mk_store : unit -> (Flambda.t, unit) Switch.t_store
+end
+
+(** Within a set of function declarations there is a set of function bodies,
+    each of which may (or may not) reference one of the other functions in
+    the same set.  Initially such intra-set references are by [Var]s (known
+    as "fun_var"s) but if the function is lifted by [Lift_constants] then the
+    references will be translated to [Symbol]s.  This means that optimization
+    passes that need to identify whether a given "fun_var" (i.e. a key in the
+    [funs] map in a value of type [function_declarations]) is used in one of
+    the function bodies need to examine the [free_symbols] as well as the
+    [free_variables] members of [function_declarations].  This function makes
+    that process easier by computing all used "fun_var"s in the bodies of
+    the given set of function declarations, including the cases where the
+    references are [Symbol]s.  The returned value is a map from "fun_var"s
+    to the "fun_var"s (if any) used in the body of the function associated
+    with that "fun_var".
+*)
+val fun_vars_referenced_in_decls
+   : Flambda.function_declarations
+  -> closure_symbol:(Closure_id.t -> Symbol.t)
+  -> Variable.Set.t Variable.Map.t
+
+(** Computes the set of closure_id in the set of closures that are
+    required used (transitively) the entry_point *)
+val closures_required_by_entry_point
+   : entry_point:Closure_id.t
+  -> closure_symbol:(Closure_id.t -> Symbol.t)
+  -> Flambda.function_declarations
+  -> Variable.Set.t
+
+val all_functions_parameters : Flambda.function_declarations -> Variable.Set.t
+
+val all_free_symbols : Flambda.function_declarations -> Symbol.Set.t
+
+val contains_stub : Flambda.function_declarations -> bool
+
+(* Ensure that projection information is suitably erased from
+   free_vars and specialised_args if we have deleted the variable being
+   projected from. *)
+val clean_projections
+   : which_variables : Flambda.specialised_to Variable.Map.t
+  -> Flambda.specialised_to Variable.Map.t
+
+val projection_to_named : Projection.t -> Flambda.named
+
+type specialised_to_same_as =
+  | Not_specialised
+  | Specialised_and_aliased_to of Variable.Set.t
+
+(** For each parameter in a given set of function declarations and the usual
+    specialised-args mapping, determine which other parameters are specialised
+    to the same variable as that parameter.
+    The result is presented as a map from [fun_vars] to lists, corresponding
+    componentwise to the usual [params] list in the corresponding function
+    declaration. *)
+val parameters_specialised_to_the_same_variable
+   : function_decls:Flambda.function_declarations
+  -> specialised_args:Flambda.specialised_to Variable.Map.t
+  -> specialised_to_same_as list Variable.Map.t
diff --git a/middle_end/flambda/freshening.ml b/middle_end/flambda/freshening.ml
new file mode 100644
index 00000000..891861a3
--- /dev/null
+++ b/middle_end/flambda/freshening.ml
@@ -0,0 +1,458 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+type tbl = {
+  sb_var : Variable.t Variable.Map.t;
+  sb_mutable_var : Mutable_variable.t Mutable_variable.Map.t;
+  sb_exn : Static_exception.t Static_exception.Map.t;
+  (* Used to handle substitution sequences: we cannot call the substitution
+     recursively because there can be name clashes. *)
+  back_var : Variable.t list Variable.Map.t;
+  back_mutable_var : Mutable_variable.t list Mutable_variable.Map.t;
+}
+
+type t =
+  | Inactive
+  | Active of tbl
+
+type subst = t
+
+let empty_tbl = {
+  sb_var = Variable.Map.empty;
+  sb_mutable_var = Mutable_variable.Map.empty;
+  sb_exn = Static_exception.Map.empty;
+  back_var = Variable.Map.empty;
+  back_mutable_var = Mutable_variable.Map.empty;
+}
+
+let print ppf = function
+  | Inactive -> Format.fprintf ppf "Inactive"
+  | Active tbl ->
+    Format.fprintf ppf "Active:@ ";
+    Variable.Map.iter (fun var1 var2 ->
+        Format.fprintf ppf "%a -> %a@ "
+          Variable.print var1
+          Variable.print var2)
+      tbl.sb_var;
+    Mutable_variable.Map.iter (fun mut_var1 mut_var2 ->
+        Format.fprintf ppf "(mutable) %a -> %a@ "
+          Mutable_variable.print mut_var1
+          Mutable_variable.print mut_var2)
+      tbl.sb_mutable_var;
+    Variable.Map.iter (fun var vars ->
+        Format.fprintf ppf "%a -> %a@ "
+          Variable.print var
+          Variable.Set.print (Variable.Set.of_list vars))
+      tbl.back_var;
+    Mutable_variable.Map.iter (fun mut_var mut_vars ->
+        Format.fprintf ppf "(mutable) %a -> %a@ "
+          Mutable_variable.print mut_var
+          Mutable_variable.Set.print (Mutable_variable.Set.of_list mut_vars))
+      tbl.back_mutable_var
+
+let empty = Inactive
+
+let is_empty = function
+  | Inactive -> true
+  | Active _ -> false
+
+let empty_preserving_activation_state = function
+  | Inactive -> Inactive
+  | Active _ -> Active empty_tbl
+
+let activate = function
+  | Inactive -> Active empty_tbl
+  | Active _ as t -> t
+
+let rec add_sb_var sb id id' =
+  let sb = { sb with sb_var = Variable.Map.add id id' sb.sb_var } in
+  let sb =
+    try let pre_vars = Variable.Map.find id sb.back_var in
+      List.fold_left (fun sb pre_id -> add_sb_var sb pre_id id') sb pre_vars
+    with Not_found -> sb in
+  let back_var =
+    let l = try Variable.Map.find id' sb.back_var with Not_found -> [] in
+    Variable.Map.add id' (id :: l) sb.back_var in
+  { sb with back_var }
+
+let rec add_sb_mutable_var sb id id' =
+  let sb =
+    { sb with
+      sb_mutable_var = Mutable_variable.Map.add id id' sb.sb_mutable_var;
+    }
+  in
+  let sb =
+    try
+      let pre_vars = Mutable_variable.Map.find id sb.back_mutable_var in
+      List.fold_left (fun sb pre_id -> add_sb_mutable_var sb pre_id id')
+        sb pre_vars
+    with Not_found -> sb in
+  let back_mutable_var =
+    let l =
+      try Mutable_variable.Map.find id' sb.back_mutable_var
+      with Not_found -> []
+    in
+    Mutable_variable.Map.add id' (id :: l) sb.back_mutable_var
+  in
+  { sb with back_mutable_var }
+
+let apply_static_exception t i =
+  match t with
+  | Inactive ->
+    i
+  | Active t ->
+    try Static_exception.Map.find i t.sb_exn
+    with Not_found -> i
+
+let add_static_exception t i =
+  match t with
+  | Inactive -> i, t
+  | Active t ->
+    let i' = Static_exception.create () in
+    let sb_exn =
+      Static_exception.Map.add i i' t.sb_exn
+    in
+    i', Active { t with sb_exn; }
+
+let active_add_variable t id =
+  let id' = Variable.rename id in
+  let t = add_sb_var t id id' in
+  id', t
+
+let active_add_parameter t param =
+  let param' = Parameter.rename param in
+  let t = add_sb_var t (Parameter.var param) (Parameter.var param') in
+  param', t
+
+let add_variable t id =
+  match t with
+  | Inactive -> id, t
+  | Active t ->
+     let id', t = active_add_variable t id in
+     id', Active t
+
+let active_add_parameters' t (params:Parameter.t list) =
+  List.fold_right (fun param (params, t) ->
+      let param', t = active_add_parameter t param in
+      param' :: params, t)
+    params ([], t)
+
+let add_variables t defs =
+  List.fold_right (fun (id, data) (defs, t) ->
+      let id', t = add_variable t id in
+      (id', data) :: defs, t) defs ([], t)
+
+let add_variables' t ids =
+  List.fold_right (fun id (ids, t) ->
+      let id', t = add_variable t id in
+      id' :: ids, t) ids ([], t)
+
+let active_add_mutable_variable t id =
+  let id' = Mutable_variable.rename id in
+  let t = add_sb_mutable_var t id id' in
+  id', t
+
+let add_mutable_variable t id =
+  match t with
+  | Inactive -> id, t
+  | Active t ->
+     let id', t = active_add_mutable_variable t id in
+     id', Active t
+
+let active_find_var_exn t id =
+  try Variable.Map.find id t.sb_var with
+  | Not_found ->
+      Misc.fatal_error (Format.asprintf "find_var: can't find %a@."
+          Variable.print id)
+
+let apply_variable t var =
+  match t with
+  | Inactive -> var
+  | Active t ->
+   try Variable.Map.find var t.sb_var with
+   | Not_found -> var
+
+let apply_mutable_variable t mut_var =
+  match t with
+  | Inactive -> mut_var
+  | Active t ->
+   try Mutable_variable.Map.find mut_var t.sb_mutable_var with
+   | Not_found -> mut_var
+
+let rewrite_recursive_calls_with_symbols t
+      (function_declarations : Flambda.function_declarations)
+      ~make_closure_symbol =
+  match t with
+  | Inactive -> function_declarations
+  | Active _ ->
+    let all_free_symbols =
+      Variable.Map.fold
+        (fun _ (function_decl : Flambda.function_declaration)
+            syms ->
+          Symbol.Set.union syms function_decl.free_symbols)
+        function_declarations.funs Symbol.Set.empty
+    in
+    let closure_symbols_used = ref false in
+    let closure_symbols =
+      Variable.Map.fold (fun var _ map ->
+        let closure_id = Closure_id.wrap var in
+        let sym = make_closure_symbol closure_id in
+        if Symbol.Set.mem sym all_free_symbols then begin
+          closure_symbols_used := true;
+          Symbol.Map.add sym var map
+        end else begin
+          map
+        end)
+      function_declarations.funs Symbol.Map.empty
+    in
+    if not !closure_symbols_used then begin
+      (* Don't waste time rewriting the function declaration(s) if there
+         are no occurrences of any of the closure symbols. *)
+      function_declarations
+    end else begin
+      let funs =
+        Variable.Map.map (fun (ffun : Flambda.function_declaration) ->
+          let body =
+            Flambda_iterators.map_toplevel_named
+              (* CR-someday pchambart: This may be worth deep substituting
+                 below the closures, but that means that we need to take care
+                 of functions' free variables. *)
+              (function
+                | Symbol sym when Symbol.Map.mem sym closure_symbols ->
+                  Expr (Var (Symbol.Map.find sym closure_symbols))
+                | e -> e)
+              ffun.body
+          in
+          Flambda.update_body_of_function_declaration ffun ~body)
+          function_declarations.funs
+      in
+      Flambda.update_function_declarations function_declarations ~funs
+    end
+
+module Project_var = struct
+  type t =
+    { vars_within_closure : Var_within_closure.t Var_within_closure.Map.t;
+      closure_id : Closure_id.t Closure_id.Map.t }
+
+  let empty =
+    { vars_within_closure = Var_within_closure.Map.empty;
+      closure_id = Closure_id.Map.empty;
+    }
+
+  let print ppf t =
+    Format.fprintf ppf "{ vars_within_closure %a, closure_id %a }"
+      (Var_within_closure.Map.print Var_within_closure.print)
+      t.vars_within_closure
+      (Closure_id.Map.print Closure_id.print)
+      t.closure_id
+
+  let new_subst_fv t id subst =
+    match subst with
+    | Inactive -> id, subst, t
+    | Active subst ->
+      let id' = Variable.rename id in
+      let subst = add_sb_var subst id id' in
+      let off = Var_within_closure.wrap id in
+      let off' = Var_within_closure.wrap id' in
+      let off_sb = Var_within_closure.Map.add off off' t.vars_within_closure in
+      id', Active subst, { t with vars_within_closure = off_sb; }
+
+  let new_subst_fun t id subst =
+    let id' = Variable.rename id in
+    let subst = add_sb_var subst id id' in
+    let off = Closure_id.wrap id in
+    let off' = Closure_id.wrap id' in
+    let off_sb = Closure_id.Map.add off off' t.closure_id in
+    id', subst, { t with closure_id = off_sb; }
+
+  (** Returns :
+      * The map of new_identifiers -> expression
+      * The new environment with added substitution
+      * a fresh ffunction_subst with only the substitution of free variables
+   *)
+  let subst_free_vars fv subst ~only_freshen_parameters
+      : (Flambda.specialised_to * _) Variable.Map.t * _ * _ =
+    Variable.Map.fold (fun id lam (fv, subst, t) ->
+        let id, subst, t =
+          if only_freshen_parameters then
+            id, subst, t
+          else
+            new_subst_fv t id subst
+        in
+        Variable.Map.add id lam fv, subst, t)
+      fv
+      (Variable.Map.empty, subst, empty)
+
+  (** Returns :
+      * The function_declaration with renamed function identifiers
+      * The new environment with added substitution
+      * The ffunction_subst completed with function substitution
+
+      subst_free_vars must have been used to build off_sb
+   *)
+  let func_decls_subst t (subst : subst)
+        (func_decls : Flambda.function_declarations)
+        ~only_freshen_parameters =
+    match subst with
+    | Inactive -> func_decls, subst, t
+    | Active subst ->
+      let subst_func_decl _fun_id (func_decl : Flambda.function_declaration)
+          subst =
+        let params, subst = active_add_parameters' subst func_decl.params in
+        (* Since all parameters are distinct, even between functions, we can
+           just use a single substitution. *)
+        let body =
+          Flambda_utils.toplevel_substitution subst.sb_var func_decl.body
+        in
+        let function_decl =
+          Flambda.create_function_declaration ~params ~body
+            ~stub:func_decl.stub ~dbg:func_decl.dbg
+            ~inline:func_decl.inline ~specialise:func_decl.specialise
+            ~is_a_functor:func_decl.is_a_functor
+            ~closure_origin:func_decl.closure_origin
+        in
+        function_decl, subst
+      in
+      let subst, t =
+        if only_freshen_parameters then
+          subst, t
+        else
+          Variable.Map.fold (fun orig_id _func_decl (subst, t) ->
+              let _id, subst, t = new_subst_fun t orig_id subst in
+              subst, t)
+            func_decls.funs
+            (subst, t)
+      in
+      let funs, subst =
+        Variable.Map.fold (fun orig_id func_decl (funs, subst) ->
+            let func_decl, subst = subst_func_decl orig_id func_decl subst in
+            let id =
+              if only_freshen_parameters then orig_id
+              else active_find_var_exn subst orig_id
+            in
+            let funs = Variable.Map.add id func_decl funs in
+            funs, subst)
+          func_decls.funs
+          (Variable.Map.empty, subst)
+      in
+      let function_decls =
+        Flambda.update_function_declarations func_decls ~funs
+      in
+      function_decls, Active subst, t
+
+  let apply_closure_id t closure_id =
+    try Closure_id.Map.find closure_id t.closure_id
+    with Not_found -> closure_id
+
+  let apply_var_within_closure t var_in_closure =
+    try Var_within_closure.Map.find var_in_closure t.vars_within_closure
+    with Not_found -> var_in_closure
+
+  module Compose (T : Identifiable.S) = struct
+    let compose ~earlier ~later =
+      if (T.Map.equal T.equal) earlier later
+        || T.Map.cardinal later = 0
+      then
+        earlier
+      else
+        T.Map.mapi (fun src_var var ->
+            if T.Map.mem src_var later then begin
+              Misc.fatal_errorf "Freshening.Project_var.compose: domains \
+                  of substitutions must be disjoint.  earlier=%a later=%a"
+                (T.Map.print T.print) earlier
+                (T.Map.print T.print) later
+            end;
+            match T.Map.find var later with
+            | exception Not_found -> var
+            | var -> var)
+          earlier
+  end
+
+  module V = Compose (Var_within_closure)
+  module C = Compose (Closure_id)
+
+  let compose ~earlier ~later : t =
+    { vars_within_closure =
+        V.compose ~earlier:earlier.vars_within_closure
+          ~later:later.vars_within_closure;
+      closure_id =
+        C.compose ~earlier:earlier.closure_id
+          ~later:later.closure_id;
+    }
+end
+
+let apply_function_decls_and_free_vars t fv func_decls
+      ~only_freshen_parameters =
+  let module I = Project_var in
+  let fv, t, of_closures = I.subst_free_vars fv t ~only_freshen_parameters in
+  let func_decls, t, of_closures =
+    I.func_decls_subst of_closures t func_decls ~only_freshen_parameters
+  in
+  fv, func_decls, t, of_closures
+
+let does_not_freshen t vars =
+  match t with
+  | Inactive -> true
+  | Active subst ->
+    not (List.exists (fun var -> Variable.Map.mem var subst.sb_var) vars)
+
+let freshen_projection (projection : Projection.t) ~freshening
+      ~closure_freshening : Projection.t =
+  match projection with
+  | Project_var { closure; closure_id; var; } ->
+    Project_var {
+      closure = apply_variable freshening closure;
+      closure_id = Project_var.apply_closure_id closure_freshening closure_id;
+      var = Project_var.apply_var_within_closure closure_freshening var;
+    }
+  | Project_closure { set_of_closures; closure_id; } ->
+    Project_closure {
+      set_of_closures = apply_variable freshening set_of_closures;
+      closure_id = Project_var.apply_closure_id closure_freshening closure_id;
+    }
+  | Move_within_set_of_closures { closure; start_from; move_to; } ->
+    Move_within_set_of_closures {
+      closure = apply_variable freshening closure;
+      start_from = Project_var.apply_closure_id closure_freshening start_from;
+      move_to = Project_var.apply_closure_id closure_freshening move_to;
+    }
+  | Field (field_index, var) ->
+    Field (field_index, apply_variable freshening var)
+
+let freshen_projection_relation relation ~freshening ~closure_freshening =
+  Variable.Map.map (fun (spec_to : Flambda.specialised_to) ->
+      let projection =
+        match spec_to.projection with
+        | None -> None
+        | Some projection ->
+          Some (freshen_projection projection ~freshening ~closure_freshening)
+      in
+      { spec_to with projection; })
+    relation
+
+let freshen_projection_relation' relation ~freshening ~closure_freshening =
+  Variable.Map.map (fun ((spec_to : Flambda.specialised_to), data) ->
+      let projection =
+        match spec_to.projection with
+        | None -> None
+        | Some projection ->
+          Some (freshen_projection projection ~freshening ~closure_freshening)
+      in
+      { spec_to with projection; }, data)
+    relation
diff --git a/middle_end/flambda/freshening.mli b/middle_end/flambda/freshening.mli
new file mode 100644
index 00000000..1550797a
--- /dev/null
+++ b/middle_end/flambda/freshening.mli
@@ -0,0 +1,167 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Freshening of various identifiers. *)
+
+(** A table used for freshening variables and static exception identifiers. *)
+type t
+type subst = t
+
+(** The freshening that does nothing.  This is the unique inactive
+    freshening. *)
+val empty : t
+
+val is_empty : t -> bool
+
+(** Activate the freshening.  Without activation, operations to request
+    freshenings have no effect (cf. the documentation below for
+    [add_variable]).  As such, the inactive renaming is unique. *)
+val activate : t -> t
+
+(** Given the inactive freshening, return the same; otherwise, return an
+    empty active freshening. *)
+val empty_preserving_activation_state : t -> t
+
+(** [add_variable t var]
+    If [t] is active:
+      It returns a fresh variable [new_var] and adds [var] -> [new_var]
+      to the freshening.
+      If a renaming [other_var] -> [var] or [symbol] -> [var] was already
+      present in [t], it will also add [other_var] -> [new_var] and
+      [symbol] -> [new_var].
+    If [t] is inactive, this is the identity.
+*)
+val add_variable : t -> Variable.t -> Variable.t * t
+
+(** Like [add_variable], but for multiple variables, each freshened
+    separately. *)
+val add_variables'
+   : t
+  -> Variable.t list
+  -> Variable.t list * t
+
+(** Like [add_variables'], but passes through the second component of the
+    input list unchanged. *)
+val add_variables
+   : t
+  -> (Variable.t * 'a) list
+  -> (Variable.t * 'a) list * t
+
+(** Like [add_variable], but for mutable variables. *)
+val add_mutable_variable : t -> Mutable_variable.t -> Mutable_variable.t * t
+
+(** As for [add_variable], but for static exception identifiers. *)
+val add_static_exception : t -> Static_exception.t -> Static_exception.t * t
+
+(** [apply_variable t var] applies the freshening [t] to [var].
+    If no renaming is specified in [t] for [var] it is returned unchanged. *)
+val apply_variable : t -> Variable.t -> Variable.t
+
+(** As for [apply_variable], but for mutable variables. *)
+val apply_mutable_variable : t -> Mutable_variable.t -> Mutable_variable.t
+
+(** As for [apply_variable], but for static exception identifiers. *)
+val apply_static_exception : t -> Static_exception.t -> Static_exception.t
+
+(** Replace recursive accesses to the closures in the set through
+    [Symbol] by the corresponding [Var]. This is used to recover
+    the recursive call when importing code from another compilation unit.
+
+    If the renaming is inactive, this is the identity.
+*)
+val rewrite_recursive_calls_with_symbols
+   : t
+  -> Flambda.function_declarations
+  -> make_closure_symbol:(Closure_id.t -> Symbol.t)
+  -> Flambda.function_declarations
+
+(* CR-soon mshinwell for mshinwell: maybe inaccurate module name, it freshens
+   closure IDs as well.  Check use points though *)
+module Project_var : sig
+  (** A table used for freshening of identifiers in [Project_closure] and
+      [Move_within_set_of_closures] ("ids of closures"); and [Project_var]
+      ("bound vars of closures") expressions.
+
+      This information is propagated bottom up and populated when inlining a
+      function containing a closure declaration.
+
+      For instance,
+        [let f x =
+           let g y = ... x ... in
+           ... g.x ...           (Project_var x)
+           ... g 1 ...           (Apply (Project_closure g ...))
+           ]
+
+      If f is inlined, g is renamed. The approximation of g will carry this
+      table such that later the access to the field x of g and selection of
+      g in the closure can be substituted.
+   *)
+  type t
+
+  (* The freshening that does nothing. *)
+  val empty : t
+
+  (** Composition of two freshenings. *)
+  val compose : earlier:t -> later:t -> t
+
+  (** Freshen a closure ID based on the given renaming.  The same ID is
+      returned if the renaming does not affect it.
+      If dealing with approximations, you probably want to use
+      [Simple_value_approx.freshen_and_check_closure_id] instead of this
+      function.
+  *)
+  val apply_closure_id : t -> Closure_id.t -> Closure_id.t
+
+  (** Like [apply_closure_id], but for variables within closures. *)
+  val apply_var_within_closure
+     : t
+    -> Var_within_closure.t
+    -> Var_within_closure.t
+
+  val print : Format.formatter -> t -> unit
+end
+
+(* CR-soon mshinwell for mshinwell: add comment *)
+val apply_function_decls_and_free_vars
+   : t
+  -> (Flambda.specialised_to * 'a) Variable.Map.t
+  -> Flambda.function_declarations
+  -> only_freshen_parameters:bool
+  -> (Flambda.specialised_to * 'a) Variable.Map.t
+    * Flambda.function_declarations
+    * t
+    * Project_var.t
+
+val does_not_freshen : t -> Variable.t list -> bool
+
+val print : Format.formatter -> t -> unit
+
+(** N.B. This does not freshen the domain of the supplied map, only the
+    range. *)
+(* CR-someday mshinwell: consider fixing that *)
+val freshen_projection_relation
+   : Flambda.specialised_to Variable.Map.t
+  -> freshening:t
+  -> closure_freshening:Project_var.t
+  -> Flambda.specialised_to Variable.Map.t
+
+val freshen_projection_relation'
+   : (Flambda.specialised_to * 'a) Variable.Map.t
+  -> freshening:t
+  -> closure_freshening:Project_var.t
+  -> (Flambda.specialised_to * 'a) Variable.Map.t
diff --git a/middle_end/flambda/import_approx.ml b/middle_end/flambda/import_approx.ml
new file mode 100644
index 00000000..64fbbb8b
--- /dev/null
+++ b/middle_end/flambda/import_approx.ml
@@ -0,0 +1,222 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+module A = Simple_value_approx
+
+let import_set_of_closures =
+  let import_function_declarations (clos : A.function_declarations)
+        : A.function_declarations =
+    (* CR-soon mshinwell for pchambart: Do we still need to do this
+       rewriting?  I'm wondering if maybe we don't have to any more. *)
+    let sym_to_fun_var_map (clos : A.function_declarations) =
+      Variable.Map.fold (fun fun_var _ acc ->
+           let closure_id = Closure_id.wrap fun_var in
+           let sym = Compilenv.closure_symbol closure_id in
+           Symbol.Map.add sym fun_var acc)
+        clos.funs Symbol.Map.empty
+    in
+    let sym_map = sym_to_fun_var_map clos in
+    let f_named (named : Flambda.named) =
+      match named with
+      | Symbol sym ->
+        begin try Flambda.Expr (Var (Symbol.Map.find sym sym_map)) with
+        | Not_found -> named
+        end
+      | named -> named
+    in
+    let funs =
+      Variable.Map.map (fun (function_decl : A.function_declaration) ->
+        A.update_function_declaration_body function_decl
+          (Flambda_iterators.map_toplevel_named f_named))
+        clos.funs
+    in
+    A.update_function_declarations clos ~funs
+  in
+  let aux set_of_closures_id =
+    match
+      Compilenv.approx_for_global
+        (Set_of_closures_id.get_compilation_unit set_of_closures_id)
+    with
+    | None -> None
+    | Some ex_info ->
+      try
+        let function_declarations =
+          Set_of_closures_id.Map.find set_of_closures_id
+            ex_info.sets_of_closures
+        in
+        Some (import_function_declarations function_declarations)
+      with Not_found ->
+        Misc.fatal_error "Cannot find set of closures"
+  in
+  Set_of_closures_id.Tbl.memoize Compilenv.imported_sets_of_closures_table aux
+
+let rec import_ex ex =
+  let import_value_set_of_closures ~set_of_closures_id ~bound_vars ~free_vars
+        ~(ex_info : Export_info.t) ~what : A.value_set_of_closures option =
+    let bound_vars = Var_within_closure.Map.map import_approx bound_vars in
+    match import_set_of_closures set_of_closures_id with
+    | None -> None
+    | Some function_decls ->
+      (* CR-someday xclerc: add a test to the test suite to ensure that
+         classic mode behaves as expected. *)
+      let is_classic_mode = function_decls.is_classic_mode in
+      let invariant_params =
+        match
+          Set_of_closures_id.Map.find set_of_closures_id
+            ex_info.invariant_params
+        with
+        | exception Not_found ->
+          if is_classic_mode then
+            Variable.Map.empty
+          else
+            Misc.fatal_errorf "Set of closures ID %a not found in \
+                               invariant_params (when importing [%a: %s])"
+              Set_of_closures_id.print set_of_closures_id
+              Export_id.print ex
+              what
+        | found -> found
+      in
+      let recursive =
+        match
+          Set_of_closures_id.Map.find set_of_closures_id ex_info.recursive
+        with
+        | exception Not_found ->
+          if is_classic_mode then
+            Variable.Set.empty
+          else
+            Misc.fatal_errorf "Set of closures ID %a not found in \
+                               recursive (when importing [%a: %s])"
+              Set_of_closures_id.print set_of_closures_id
+              Export_id.print ex
+              what
+        | found -> found
+      in
+      Some (A.create_value_set_of_closures
+        ~function_decls
+        ~bound_vars
+        ~free_vars
+        ~invariant_params:(lazy invariant_params)
+        ~recursive:(lazy recursive)
+        ~specialised_args:Variable.Map.empty
+        ~freshening:Freshening.Project_var.empty
+        ~direct_call_surrogates:Closure_id.Map.empty)
+  in
+  let compilation_unit = Export_id.get_compilation_unit ex in
+  match Compilenv.approx_for_global compilation_unit with
+  | None -> A.value_unknown Other
+  | Some ex_info ->
+    match Export_info.find_description ex_info ex with
+    | exception Not_found ->
+      Misc.fatal_errorf "Cannot find export id %a" Export_id.print ex
+    | Value_unknown_descr -> A.value_unknown Other
+    | Value_int i -> A.value_int i
+    | Value_char c -> A.value_char c
+    | Value_constptr i -> A.value_constptr i
+    | Value_float f -> A.value_float f
+    | Value_float_array float_array ->
+      begin match float_array.contents with
+      | Unknown_or_mutable ->
+        A.value_mutable_float_array ~size:float_array.size
+      | Contents contents ->
+        A.value_immutable_float_array
+          (Array.map (function
+             | None -> A.value_any_float
+             | Some f -> A.value_float f)
+             contents)
+      end
+    | Export_info.Value_boxed_int (t, i) -> A.value_boxed_int t i
+    | Value_string { size; contents } ->
+      let contents =
+        match contents with
+        | Unknown_or_mutable -> None
+        | Contents contents -> Some contents
+      in
+      A.value_string size contents
+    | Value_mutable_block _ -> A.value_unknown Other
+    | Value_block (tag, fields) ->
+      A.value_block tag (Array.map import_approx fields)
+    | Value_closure { closure_id;
+          set_of_closures =
+            { set_of_closures_id; bound_vars; free_vars; aliased_symbol } } ->
+      let value_set_of_closures =
+        import_value_set_of_closures
+          ~set_of_closures_id ~bound_vars ~free_vars ~ex_info
+          ~what:(Format.asprintf "Value_closure %a" Closure_id.print closure_id)
+      in
+      begin match value_set_of_closures with
+      | None -> A.value_unresolved (Set_of_closures_id set_of_closures_id)
+      | Some value_set_of_closures ->
+        A.value_closure ?set_of_closures_symbol:aliased_symbol
+          value_set_of_closures closure_id
+      end
+    | Value_set_of_closures
+        { set_of_closures_id; bound_vars; free_vars; aliased_symbol } ->
+      let value_set_of_closures =
+        import_value_set_of_closures ~set_of_closures_id
+          ~bound_vars ~free_vars ~ex_info ~what:"Value_set_of_closures"
+      in
+      match value_set_of_closures with
+      | None ->
+        A.value_unresolved (Set_of_closures_id set_of_closures_id)
+      | Some value_set_of_closures ->
+        let approx = A.value_set_of_closures value_set_of_closures in
+        match aliased_symbol with
+        | None -> approx
+        | Some symbol -> A.augment_with_symbol approx symbol
+
+and import_approx (ap : Export_info.approx) =
+  match ap with
+  | Value_unknown -> A.value_unknown Other
+  | Value_id ex -> A.value_extern ex
+  | Value_symbol sym -> A.value_symbol sym
+
+let import_symbol sym =
+  if Compilenv.is_predefined_exception sym then
+    A.value_unknown Other
+  else begin
+    let compilation_unit = Symbol.compilation_unit sym in
+    match Compilenv.approx_for_global compilation_unit with
+    | None -> A.value_unresolved (Symbol sym)
+    | Some export_info ->
+      match Symbol.Map.find sym export_info.symbol_id with
+      | approx -> A.augment_with_symbol (import_ex approx) sym
+      | exception Not_found ->
+        Misc.fatal_errorf
+          "Compilation unit = %a Cannot find symbol %a"
+          Compilation_unit.print compilation_unit
+          Symbol.print sym
+  end
+
+(* Note for code reviewers: Observe that [really_import] iterates until
+   the approximation description is fully resolved (or a necessary .cmx
+   file is missing). *)
+
+let rec really_import (approx : A.descr) =
+  match approx with
+  | Value_extern ex -> really_import_ex ex
+  | Value_symbol sym -> really_import_symbol sym
+  | r -> r
+
+and really_import_ex ex =
+  really_import (import_ex ex).descr
+
+and really_import_symbol sym =
+  really_import (import_symbol sym).descr
+
+let really_import_approx (approx : Simple_value_approx.t) =
+  A.replace_description approx (really_import approx.descr)
diff --git a/middle_end/flambda/import_approx.mli b/middle_end/flambda/import_approx.mli
new file mode 100644
index 00000000..23d9d294
--- /dev/null
+++ b/middle_end/flambda/import_approx.mli
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Create simple value approximations from the export information in
+    .cmx files. *)
+
+(** Given an approximation description, load .cmx files (possibly more
+    than one) until the description is fully resolved.  If a necessary .cmx
+    file cannot be found, "unresolved" will be returned. *)
+val really_import : Simple_value_approx.descr -> Simple_value_approx.descr
+
+(** Maps the description of the given approximation through [really_import]. *)
+val really_import_approx : Simple_value_approx.t -> Simple_value_approx.t
+
+(** Read and convert the approximation of a given symbol from the
+    relevant .cmx file.  Unlike the "really_" functions, this does not
+    continue to load .cmx files until the approximation is fully
+    resolved. *)
+val import_symbol : Symbol.t -> Simple_value_approx.t
diff --git a/middle_end/flambda/inconstant_idents.ml b/middle_end/flambda/inconstant_idents.ml
new file mode 100644
index 00000000..28efb3e9
--- /dev/null
+++ b/middle_end/flambda/inconstant_idents.ml
@@ -0,0 +1,502 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+(* This cannot be done in a single simple pass due to expressions like:
+
+  let rec ... =
+    ...
+    let rec f1 x =
+      let f2 y =
+        f1 rec_list
+      in
+      f2 v
+    and rec_list = f1 :: rec_list in
+    ...
+
+  and v = ...
+
+  f1, f2 and rec_list are constants iff v is a constant.
+
+  To handle this we populate both a 'not constant' set NC and a set of
+  implications between variables.
+
+  For example, the above code would generate the implications:
+
+      f1 in NC => rec_list in NC
+      f2 in NC => f1 in NC
+      rec_list in NC => f2 in NC
+      v in NC => f1 in NC
+
+   then if v is found to be in NC this will be propagated to place
+   f1, f2 and rec_list in NC as well.
+
+*)
+
+(* CR-someday lwhite: I think this pass could be combined with
+   alias_analysis and other parts of lift_constants into a single
+   type-based analysis which infers a "type" for each variable that is
+   either an allocated_constant expression or "not constant".  Recursion
+   would be handled with unification variables. *)
+
+module Int = Numbers.Int
+module Symbol_field = struct
+  type t = Symbol.t * Int.t
+  include Identifiable.Make (Identifiable.Pair (Symbol) (Int))
+end
+
+type dep =
+  | Closure of Set_of_closures_id.t
+  | Var of Variable.t
+  | Symbol of Symbol.t
+  | Symbol_field of Symbol_field.t
+
+type state =
+  | Not_constant
+  | Implication of dep list
+
+type result = {
+  id : state Variable.Tbl.t;
+  closure : state Set_of_closures_id.Tbl.t;
+}
+
+module type Param = sig
+  val program : Flambda.program
+  val compilation_unit : Compilation_unit.t
+end
+
+(* CR-soon mshinwell: consider removing functor *)
+module Inconstants (P:Param) (Backend:Backend_intf.S) = struct
+  let program = P.program
+  let compilation_unit = P.compilation_unit
+  let imported_symbols = Flambda_utils.imported_symbols program
+
+  (* Sets representing NC *)
+  let variables : state Variable.Tbl.t = Variable.Tbl.create 42
+  let closures : state Set_of_closures_id.Tbl.t =
+    Set_of_closures_id.Tbl.create 42
+  let symbols : state Symbol.Tbl.t = Symbol.Tbl.create 42
+  let symbol_fields : state Symbol_field.Tbl.t = Symbol_field.Tbl.create 42
+
+  let mark_queue = Queue.create ()
+
+  (* CR-soon pchambart: We could probably improve that quite a lot by adding
+     (the future annotation) [@unrolled] at the right call sites.  Or more
+     directly mark mark_dep as [@inline] and call it instead of mark_curr in
+     some situations.
+  *)
+
+  (* adds 'dep in NC' *)
+  let rec mark_dep = function
+    | Var id -> begin
+      match Variable.Tbl.find variables id with
+      | Not_constant -> ()
+      | Implication deps ->
+        Variable.Tbl.replace variables id Not_constant;
+        Queue.push deps mark_queue
+      | exception Not_found ->
+        Variable.Tbl.add variables id Not_constant
+      end
+    | Closure cl -> begin
+      match Set_of_closures_id.Tbl.find closures cl with
+      | Not_constant -> ()
+      | Implication deps ->
+        Set_of_closures_id.Tbl.replace closures cl Not_constant;
+        Queue.push deps mark_queue
+      | exception Not_found ->
+        Set_of_closures_id.Tbl.add closures cl Not_constant
+      end
+    | Symbol s -> begin
+      match Symbol.Tbl.find symbols s with
+      | Not_constant -> ()
+      | Implication deps ->
+        Symbol.Tbl.replace symbols s Not_constant;
+        Queue.push deps mark_queue
+      | exception Not_found ->
+        Symbol.Tbl.add symbols s Not_constant
+      end
+    | Symbol_field s -> begin
+      match Symbol_field.Tbl.find symbol_fields s with
+      | Not_constant -> ()
+      | Implication deps ->
+        Symbol_field.Tbl.replace symbol_fields s Not_constant;
+        Queue.push deps mark_queue
+      | exception Not_found ->
+        Symbol_field.Tbl.add symbol_fields s Not_constant
+      end
+
+  and mark_deps deps =
+    List.iter mark_dep deps
+
+  and complete_marking () =
+    while not (Queue.is_empty mark_queue) do
+      let deps =
+        try
+          Queue.take mark_queue
+        with Not_found -> []
+      in
+      mark_deps deps;
+    done
+
+  (* adds 'curr in NC' *)
+  let mark_curr curr =
+    mark_deps curr;
+    complete_marking ()
+
+  (* adds in the tables 'dep in NC => curr in NC' *)
+  let register_implication ~in_nc:dep ~implies_in_nc:curr =
+    match dep with
+    | Var id -> begin
+      match Variable.Tbl.find variables id with
+      | Not_constant ->
+        mark_deps curr;
+        complete_marking ();
+      | Implication deps ->
+        let deps = List.rev_append curr deps in
+        Variable.Tbl.replace variables id (Implication deps)
+      | exception Not_found ->
+        Variable.Tbl.add variables id (Implication curr);
+      end
+    | Closure cl -> begin
+      match Set_of_closures_id.Tbl.find closures cl with
+      | Not_constant ->
+        mark_deps curr;
+        complete_marking ();
+      | Implication deps ->
+        let deps = List.rev_append curr deps in
+        Set_of_closures_id.Tbl.replace closures cl (Implication deps)
+      | exception Not_found ->
+        Set_of_closures_id.Tbl.add closures cl (Implication curr);
+      end
+    | Symbol symbol -> begin
+      match Symbol.Tbl.find symbols symbol with
+      | Not_constant ->
+        mark_deps curr;
+        complete_marking ();
+      | Implication deps ->
+        let deps = List.rev_append curr deps in
+        Symbol.Tbl.replace symbols symbol (Implication deps)
+      | exception Not_found ->
+        Symbol.Tbl.add symbols symbol (Implication curr);
+      end
+    | Symbol_field ((symbol, _) as field) -> begin
+      match Symbol_field.Tbl.find symbol_fields field with
+      | Not_constant ->
+        mark_deps curr;
+        complete_marking ();
+      | Implication deps ->
+        let deps = List.rev_append curr deps in
+        Symbol_field.Tbl.replace symbol_fields field (Implication deps)
+      | exception Not_found ->
+        (* There is no information available about the contents of imported
+           symbols, so we must consider all their fields as inconstant. *)
+        (* CR-someday pchambart: recover that from the cmx information *)
+        if Symbol.Set.mem symbol imported_symbols then begin
+          Symbol_field.Tbl.add symbol_fields field Not_constant;
+          mark_deps curr;
+          complete_marking ();
+        end else begin
+          Symbol_field.Tbl.add symbol_fields field (Implication curr)
+        end
+      end
+
+  (* First loop: iterates on the tree to mark dependencies.
+
+     curr is the variables or closures to which we add constraints like
+     '... in NC => curr in NC' or 'curr in NC'
+
+     It can be empty when no constraint can be added like in the toplevel
+     expression or in the body of a function.
+  *)
+  let rec mark_loop ~toplevel (curr : dep list) (flam : Flambda.t) =
+    match flam with
+    | Let { var; defining_expr = lam; body; _ } ->
+      mark_named ~toplevel [Var var] lam;
+      (* adds 'var in NC => curr in NC'
+         This is not really necessary, but compiling this correctly is
+         trickier than eliminating that earlier. *)
+      mark_var var curr;
+      mark_loop ~toplevel curr body
+    | Let_mutable { initial_value = var; body } ->
+      mark_var var curr;
+      mark_loop ~toplevel curr body
+    | Let_rec(defs, body) ->
+      List.iter (fun (var, def) ->
+          mark_named ~toplevel [Var var] def;
+          (* adds 'var in NC => curr in NC' same remark as let case *)
+          mark_var var curr)
+        defs;
+      mark_loop ~toplevel curr body
+    | Var var -> mark_var var curr
+    (* Not constant cases: we mark directly 'curr in NC' and mark
+       bound variables as in NC also *)
+    | Assign _ ->
+      mark_curr curr
+    | Try_with (f1,id,f2) ->
+      mark_curr [Var id];
+      mark_curr curr;
+      mark_loop ~toplevel [] f1;
+      mark_loop ~toplevel [] f2
+    | Static_catch (_,ids,f1,f2) ->
+      List.iter (fun id -> mark_curr [Var id]) ids;
+      mark_curr curr;
+      mark_loop ~toplevel [] f1;
+      mark_loop ~toplevel [] f2
+      (* CR-someday pchambart: If recursive staticcatch is introduced:
+         this becomes ~toplevel:false *)
+    | For { bound_var; from_value; to_value; direction = _; body; } ->
+      mark_curr [Var bound_var];
+      mark_var from_value curr;
+      mark_var to_value curr;
+      mark_curr curr;
+      mark_loop ~toplevel:false [] body
+    | While (f1,body) ->
+      mark_curr curr;
+      mark_loop ~toplevel [] f1;
+      mark_loop ~toplevel:false [] body
+    | If_then_else (f1,f2,f3) ->
+      mark_curr curr;
+      mark_curr [Var f1];
+      mark_loop ~toplevel [] f2;
+      mark_loop ~toplevel [] f3
+    | Static_raise (_,l) ->
+      mark_curr curr;
+      List.iter (fun v -> mark_var v curr) l
+    | Apply ({func; args; _ }) ->
+      mark_curr curr;
+      mark_var func curr;
+      mark_vars args curr;
+    | Switch (arg,sw) ->
+      mark_curr curr;
+      mark_var arg curr;
+      List.iter (fun (_,l) -> mark_loop ~toplevel [] l) sw.consts;
+      List.iter (fun (_,l) -> mark_loop ~toplevel [] l) sw.blocks;
+      Option.iter (fun l -> mark_loop ~toplevel [] l) sw.failaction
+    | String_switch (arg,sw,def) ->
+      mark_curr curr;
+      mark_var arg curr;
+      List.iter (fun (_,l) -> mark_loop ~toplevel [] l) sw;
+      Option.iter (fun l -> mark_loop ~toplevel [] l) def
+    | Send { kind = _; meth; obj; args; dbg = _; } ->
+      mark_curr curr;
+      mark_var meth curr;
+      mark_var obj curr;
+      List.iter (fun arg -> mark_var arg curr) args
+    | Proved_unreachable ->
+      mark_curr curr
+
+  and mark_named ~toplevel curr (named : Flambda.named) =
+    match named with
+    | Set_of_closures (set_of_closures) ->
+      mark_loop_set_of_closures ~toplevel curr set_of_closures
+    | Const _ | Allocated_const _ -> ()
+    | Read_mutable _ -> mark_curr curr
+    | Symbol symbol -> begin
+        let current_unit = Compilation_unit.get_current_exn () in
+        if Compilation_unit.equal current_unit (Symbol.compilation_unit symbol)
+        then
+          ()
+        else
+          match (Backend.import_symbol symbol).descr with
+          | Value_unresolved _ ->
+            (* Constant when 'for_clambda' means: can be a symbol (which is
+               obviously the case here) with a known approximation.  If this
+               condition is not satisfied we mark as inconstant to reflect
+               the fact that the symbol's contents are unknown and thus
+               prevent attempts to examine it.  (This is a bit of a hack.) *)
+            mark_curr curr
+          | _ ->
+            ()
+      end
+    | Read_symbol_field (symbol, index) ->
+      register_implication ~in_nc:(Symbol_field (symbol, index))
+        ~implies_in_nc:curr
+    (* Constant constructors: those expressions are constant if all their
+       parameters are:
+       - makeblock is compiled to a constant block
+       - offset is compiled to a pointer inside a constant closure.
+         See Cmmgen for the details
+
+       makeblock(Mutable) can be a 'constant' if it is allocated at
+       toplevel: if this expression is evaluated only once.
+    *)
+    | Prim (Pmakeblock (_tag, Asttypes.Immutable, _value_kind), args,
+            _dbg) ->
+      mark_vars args curr
+(*  (* CR-someday pchambart: If global mutables are allowed: *)
+    | Prim(Lambda.Pmakeblock(_tag, Asttypes.Mutable), args, _dbg, _)
+      when toplevel ->
+      List.iter (mark_loop ~toplevel curr) args
+*)
+    | Prim (Pmakearray (Pfloatarray, Immutable), args, _) ->
+      mark_vars args curr
+    | Prim (Pmakearray (Pfloatarray, Mutable), args, _) ->
+      (* CR-someday pchambart: Toplevel float arrays could always be
+         statically allocated using an equivalent of the
+         Initialize_symbol construction.
+         Toplevel non-float arrays could also be turned into an
+         Initialize_symbol, but only when declared as immutable since
+         preallocated symbols does not allow mutation after
+         initialisation
+      *)
+      if toplevel then mark_vars args curr
+      else mark_curr curr
+    | Prim (Pduparray (Pfloatarray, Immutable), [arg], _) ->
+      mark_var arg curr
+    | Prim (Pduparray (Pfloatarray, Mutable), [arg], _) ->
+      if toplevel then mark_var arg curr
+      else mark_curr curr
+    | Prim (Pduparray _, _, _) ->
+      (* See Lift_constants *)
+      mark_curr curr
+    | Project_closure ({ set_of_closures; closure_id; }) ->
+      if Closure_id.in_compilation_unit closure_id compilation_unit then
+        mark_var set_of_closures curr
+      else
+        mark_curr curr
+    | Move_within_set_of_closures ({ closure; start_from; move_to; }) ->
+      (* CR-someday mshinwell: We should be able to deem these projections
+         (same for the cases below) as constant when from another
+         compilation unit, but there isn't code to handle this yet.  (Note
+         that for Project_var we cannot yet generate a projection from a
+         closure in another compilation unit, since we only lift closed
+         closures.) *)
+      if Closure_id.in_compilation_unit start_from compilation_unit then begin
+        assert (Closure_id.in_compilation_unit move_to compilation_unit);
+        mark_var closure curr
+      end else begin
+        mark_curr curr
+      end
+    | Project_var ({ closure; closure_id; var = _ }) ->
+      if Closure_id.in_compilation_unit closure_id compilation_unit then
+        mark_var closure curr
+      else
+        mark_curr curr
+    | Prim (Pfield _, [f1], _) ->
+      mark_curr curr;
+      mark_var f1 curr
+    | Prim (_, args, _) ->
+      mark_curr curr;
+      mark_vars args curr
+    | Expr flam ->
+      mark_loop ~toplevel curr flam
+
+  and mark_var var curr =
+    (* adds 'id in NC => curr in NC' *)
+    register_implication ~in_nc:(Var var) ~implies_in_nc:curr
+
+  and mark_vars vars curr =
+    (* adds 'id in NC => curr in NC' *)
+    List.iter (fun var -> mark_var var curr) vars
+
+  (* [toplevel] is intended for allowing static allocations of mutable
+     blocks.  This feature should be available in a future release once the
+     necessary GC changes have been merged. (See GPR#178.) *)
+  and mark_loop_set_of_closures ~toplevel:_ curr
+        { Flambda. function_decls; free_vars; specialised_args } =
+    (* If a function in the set of closures is specialised, do not consider
+       it constant, unless all specialised args are also constant. *)
+    Variable.Map.iter (fun _ (spec_arg : Flambda.specialised_to) ->
+          register_implication
+            ~in_nc:(Var spec_arg.var)
+            ~implies_in_nc:[Closure function_decls.set_of_closures_id])
+        specialised_args;
+    (* adds 'function_decls in NC => curr in NC' *)
+    register_implication ~in_nc:(Closure function_decls.set_of_closures_id)
+      ~implies_in_nc:curr;
+    (* a closure is constant if its free variables are constants. *)
+    Variable.Map.iter (fun inner_id (var : Flambda.specialised_to) ->
+        register_implication ~in_nc:(Var var.var)
+          ~implies_in_nc:[
+            Var inner_id;
+            Closure function_decls.set_of_closures_id
+          ])
+      free_vars;
+    Variable.Map.iter (fun fun_id (ffunc : Flambda.function_declaration) ->
+        (* for each function f in a closure c 'c in NC => f' *)
+        register_implication ~in_nc:(Closure function_decls.set_of_closures_id)
+          ~implies_in_nc:[Var fun_id];
+        (* function parameters are in NC unless specialised *)
+        List.iter (fun param ->
+            match Variable.Map.find param specialised_args with
+            | exception Not_found -> mark_curr [Var param]
+            | outer_var ->
+              register_implication ~in_nc:(Var outer_var.var)
+                ~implies_in_nc:[Var param])
+          (Parameter.List.vars ffunc.params);
+        mark_loop ~toplevel:false [] ffunc.body)
+      function_decls.funs
+
+  let mark_constant_defining_value (const:Flambda.constant_defining_value) =
+    match const with
+    | Allocated_const _
+    | Block _
+    | Project_closure _ -> ()
+    | Set_of_closures set_of_closure ->
+      mark_loop_set_of_closures ~toplevel:true [] set_of_closure
+
+  let mark_program (program : Flambda.program) =
+    let rec loop (program : Flambda.program_body) =
+      match program with
+      | End _ -> ()
+      | Initialize_symbol (symbol,_tag,fields,program) ->
+        List.iteri (fun i field ->
+            mark_loop ~toplevel:true
+              [Symbol symbol; Symbol_field (symbol,i)] field)
+          fields;
+        loop program
+      | Effect (expr, program) ->
+        mark_loop ~toplevel:true [] expr;
+        loop program
+      | Let_symbol (_, def, program) ->
+        mark_constant_defining_value def;
+        loop program
+      | Let_rec_symbol (defs, program) ->
+        List.iter (fun (_, def) -> mark_constant_defining_value def) defs;
+        loop program
+    in
+    loop program.program_body
+
+  let res =
+    mark_program program;
+    { id = variables;
+      closure = closures;
+    }
+end
+
+let inconstants_on_program ~compilation_unit ~backend
+    (program : Flambda.program) =
+  let module P = struct
+    let program = program
+    let compilation_unit = compilation_unit
+  end in
+  let module Backend = (val backend : Backend_intf.S) in
+  let module I = Inconstants (P) (Backend) in
+  I.res
+
+let variable var { id; _ } =
+  match Variable.Tbl.find id var with
+  | Not_constant -> true
+  | Implication _ -> false
+  | exception Not_found -> false
+
+let closure cl { closure; _ } =
+  match Set_of_closures_id.Tbl.find closure cl with
+  | Not_constant -> true
+  | Implication _ -> false
+  | exception Not_found -> false
diff --git a/middle_end/flambda/inconstant_idents.mli b/middle_end/flambda/inconstant_idents.mli
new file mode 100644
index 00000000..2c5309e0
--- /dev/null
+++ b/middle_end/flambda/inconstant_idents.mli
@@ -0,0 +1,36 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+type result
+
+(** [inconstants_on_program] finds those variables and set-of-closures
+    identifiers that cannot be compiled to constants by [Flambda_to_clambda].
+*)
+val inconstants_on_program
+   : compilation_unit:Compilation_unit.t
+  -> backend:(module Backend_intf.S)
+  -> Flambda.program
+  -> result
+
+(** [variable var res] returns [true] if [var] is marked as inconstant
+    in [res]. *)
+val variable : Variable.t -> result -> bool
+
+(** [closure cl res] returns [true] if [cl] is marked as inconstant
+    in [res]. *)
+val closure : Set_of_closures_id.t -> result -> bool
diff --git a/middle_end/flambda/initialize_symbol_to_let_symbol.ml b/middle_end/flambda/initialize_symbol_to_let_symbol.ml
new file mode 100644
index 00000000..31246b0d
--- /dev/null
+++ b/middle_end/flambda/initialize_symbol_to_let_symbol.ml
@@ -0,0 +1,57 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+let constant_field (expr:Flambda.t)
+  : Flambda.constant_defining_value_block_field option =
+  match expr with
+  | Let { var; defining_expr = Const c; body = Var var' ; _ } ->
+    assert(Variable.equal var var');
+    (* This must be true since var is the only variable in scope *)
+    Some (Flambda.Const c)
+  | Let { var; defining_expr = Symbol s; body = Var var' ; _ } ->
+    assert(Variable.equal var var');
+    Some (Flambda.Symbol s)
+  | _ ->
+    None
+
+let rec loop (program : Flambda.program_body) : Flambda.program_body =
+  match program with
+  | Initialize_symbol (symbol, tag, fields, program) ->
+    let constant_fields = List.map constant_field fields in
+    begin
+      match Misc.Stdlib.List.some_if_all_elements_are_some constant_fields
+    with
+    | None ->
+      Initialize_symbol (symbol, tag, fields, loop program)
+    | Some fields ->
+      Let_symbol (symbol, Block (tag, fields), loop program)
+    end
+  | Let_symbol (symbol, const, program) ->
+    Let_symbol (symbol, const, loop program)
+  | Let_rec_symbol (defs, program) ->
+    Let_rec_symbol (defs, loop program)
+  | Effect (expr, program) ->
+    Effect (expr, loop program)
+  | End symbol ->
+    End symbol
+
+let run (program : Flambda.program) =
+  { program with
+    program_body = loop program.program_body;
+  }
diff --git a/middle_end/flambda/initialize_symbol_to_let_symbol.mli b/middle_end/flambda/initialize_symbol_to_let_symbol.mli
new file mode 100644
index 00000000..fc54f760
--- /dev/null
+++ b/middle_end/flambda/initialize_symbol_to_let_symbol.mli
@@ -0,0 +1,25 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+val constant_field
+   : Flambda.t
+  -> Flambda.constant_defining_value_block_field option
+
+(** Transform Initialize_symbol with only constant fields to
+    let_symbol construction. *)
+val run : Flambda.program -> Flambda.program
diff --git a/middle_end/flambda/inline_and_simplify.ml b/middle_end/flambda/inline_and_simplify.ml
new file mode 100644
index 00000000..a4b3a568
--- /dev/null
+++ b/middle_end/flambda/inline_and_simplify.ml
@@ -0,0 +1,1702 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module A = Simple_value_approx
+module B = Inlining_cost.Benefit
+module E = Inline_and_simplify_aux.Env
+module R = Inline_and_simplify_aux.Result
+
+(** Values of two types hold the information propagated during simplification:
+    - [E.t] "environments", top-down, almost always called "env";
+    - [R.t] "results", bottom-up approximately following the evaluation order,
+      almost always called "r".  These results come along with rewritten
+      Flambda terms.
+    The environments map variables to approximations, which enable various
+    simplifications to be performed; for example, some variable may be known
+    to always hold a particular constant.
+*)
+
+let ret = R.set_approx
+
+type simplify_variable_result =
+  | No_binding of Variable.t
+  | Binding of Variable.t * (Flambda.named Flambda.With_free_variables.t)
+
+let simplify_free_variable_internal env original_var =
+  let var = Freshening.apply_variable (E.freshening env) original_var in
+  let original_var = var in
+  (* In the case where an approximation is useful, we introduce a [let]
+     to bind (e.g.) the constant or symbol replacing [var], unless this
+     would introduce a useless [let] as a consequence of [var] already being
+     in the current scope.
+
+     Even when the approximation is not useful, this simplification helps.
+     In particular, it squashes aliases of the form:
+      let var1 = var2 in ... var2 ...
+     by replacing [var2] in the body with [var1].  Simplification can then
+     eliminate the [let].
+  *)
+  let var =
+    let approx = E.find_exn env var in
+    match approx.var with
+    | Some var when E.mem env var -> var
+    | Some _ | None -> var
+  in
+  (* CR-soon mshinwell: Should we update [r] when we *add* code?
+     Aside from that, it looks like maybe we don't need [r] in this function,
+     because the approximation within it wouldn't be used by any of the
+     call sites. *)
+  match E.find_with_scope_exn env var with
+  | Current, approx -> No_binding var, approx  (* avoid useless [let] *)
+  | Outer, approx ->
+    match A.simplify_var approx with
+    | None -> No_binding var, approx
+    | Some (named, approx) ->
+      let module W = Flambda.With_free_variables in
+      Binding (original_var, W.of_named named), approx
+
+let simplify_free_variable env var ~f : Flambda.t * R.t =
+  match simplify_free_variable_internal env var with
+  | No_binding var, approx -> f env var approx
+  | Binding (var, named), approx ->
+    let module W = Flambda.With_free_variables in
+    let var = Variable.rename var in
+    let env = E.add env var approx in
+    let body, r = f env var approx in
+    (W.create_let_reusing_defining_expr var named body), r
+
+let simplify_free_variables env vars ~f : Flambda.t * R.t =
+  let rec collect_bindings vars env bound_vars approxs : Flambda.t * R.t =
+    match vars with
+    | [] -> f env (List.rev bound_vars) (List.rev approxs)
+    | var::vars ->
+      match simplify_free_variable_internal env var with
+      | No_binding var, approx ->
+        collect_bindings vars env (var::bound_vars) (approx::approxs)
+      | Binding (var, named), approx ->
+        let module W = Flambda.With_free_variables in
+        let var = Variable.rename var in
+        let env = E.add env var approx in
+        let body, r =
+          collect_bindings vars env (var::bound_vars) (approx::approxs)
+        in
+        (W.create_let_reusing_defining_expr var named body), r
+  in
+  collect_bindings vars env [] []
+
+let simplify_free_variables_named env vars ~f : Flambda.named * R.t =
+  let rec collect_bindings vars env bound_vars approxs
+        : Flambda.maybe_named * R.t =
+    match vars with
+    | [] ->
+      let named, r = f env (List.rev bound_vars) (List.rev approxs) in
+      Is_named named, r
+    | var::vars ->
+      match simplify_free_variable_internal env var with
+      | No_binding var, approx ->
+        collect_bindings vars env (var::bound_vars) (approx::approxs)
+      | Binding (var, named), approx ->
+        let module W = Flambda.With_free_variables in
+        let var = Variable.rename var in
+        let env = E.add env var approx in
+        let body, r =
+          collect_bindings vars env (var::bound_vars) (approx::approxs)
+        in
+        let body =
+          match body with
+          | Is_named body ->
+            let name = Internal_variable_names.simplify_fv in
+            Flambda_utils.name_expr body ~name
+          | Is_expr body -> body
+        in
+        Is_expr (W.create_let_reusing_defining_expr var named body), r
+  in
+  let named_or_expr, r = collect_bindings vars env [] [] in
+  match named_or_expr with
+  | Is_named named -> named, r
+  | Is_expr expr -> Expr expr, r
+
+(* CR-soon mshinwell: tidy this up *)
+let simplify_free_variable_named env var ~f : Flambda.named * R.t =
+  simplify_free_variables_named env [var] ~f:(fun env vars vars_approxs ->
+    match vars, vars_approxs with
+    | [var], [approx] -> f env var approx
+    | _ -> assert false)
+
+let simplify_named_using_approx r lam approx =
+  let lam, _summary, approx = A.simplify_named approx lam in
+  lam, R.set_approx r approx
+
+let simplify_using_approx_and_env env r original_lam approx =
+  let lam, summary, approx =
+    A.simplify_using_env approx ~is_present_in_env:(E.mem env) original_lam
+  in
+  let r =
+    let r = ret r approx in
+    match summary with
+    (* CR-soon mshinwell: Why is [r] not updated with the cost of adding the
+       new code?
+       mshinwell: similar to CR above *)
+    | Replaced_term -> R.map_benefit r (B.remove_code original_lam)
+    | Nothing_done -> r
+  in
+  lam, r
+
+let simplify_named_using_approx_and_env env r original_named approx =
+  let named, summary, approx =
+    A.simplify_named_using_env approx ~is_present_in_env:(E.mem env)
+      original_named
+  in
+  let r =
+    let r = ret r approx in
+    match summary with
+    | Replaced_term -> R.map_benefit r (B.remove_code_named original_named)
+    | Nothing_done -> r
+  in
+  named, r
+
+let simplify_const (const : Flambda.const) =
+  match const with
+  | Int i -> A.value_int i
+  | Char c -> A.value_char c
+  | Const_pointer i -> A.value_constptr i
+
+let approx_for_allocated_const (const : Allocated_const.t) =
+  match const with
+  | String s -> A.value_string (String.length s) None
+  | Immutable_string s -> A.value_string (String.length s) (Some s)
+  | Int32 i -> A.value_boxed_int Int32 i
+  | Int64 i -> A.value_boxed_int Int64 i
+  | Nativeint i -> A.value_boxed_int Nativeint i
+  | Float f -> A.value_float f
+  | Float_array a -> A.value_mutable_float_array ~size:(List.length a)
+  | Immutable_float_array a ->
+      A.value_immutable_float_array
+        (Array.map A.value_float (Array.of_list a))
+
+type filtered_switch_branches =
+  | Must_be_taken of Flambda.t
+  | Can_be_taken of (int * Flambda.t) list
+
+(* Determine whether a given closure ID corresponds directly to a variable
+   (bound to a closure) in the given environment.  This happens when the body
+   of a [let rec]-bound function refers to another in the same set of closures.
+   If we succeed in this process, we can change [Project_closure]
+   expressions into [Var] expressions, thus sharing closure projections. *)
+let reference_recursive_function_directly env closure_id =
+  let closure_id = Closure_id.unwrap closure_id in
+  match E.find_opt env closure_id with
+  | None -> None
+  | Some approx -> Some (Flambda.Expr (Var closure_id), approx)
+
+(* Simplify an expression that takes a set of closures and projects an
+   individual closure from it. *)
+let simplify_project_closure env r ~(project_closure : Flambda.project_closure)
+      : Flambda.named * R.t =
+  simplify_free_variable_named env project_closure.set_of_closures
+    ~f:(fun _env set_of_closures set_of_closures_approx ->
+    match A.check_approx_for_set_of_closures set_of_closures_approx with
+    | Wrong ->
+      Misc.fatal_errorf "Wrong approximation when projecting closure: %a"
+        Flambda.print_project_closure project_closure
+    | Unresolved value ->
+      (* A set of closures coming from another compilation unit, whose .cmx is
+         missing; as such, we cannot have rewritten the function and don't
+         need to do any freshening. *)
+      Project_closure {
+        set_of_closures;
+        closure_id = project_closure.closure_id;
+      }, ret r (A.value_unresolved value)
+    | Unknown ->
+      (* CR-soon mshinwell: see CR comment in e.g. simple_value_approx.ml
+         [check_approx_for_closure_allowing_unresolved] *)
+      Project_closure {
+        set_of_closures;
+        closure_id = project_closure.closure_id;
+      }, ret r (A.value_unknown Other)
+    | Unknown_because_of_unresolved_value value ->
+      Project_closure {
+        set_of_closures;
+        closure_id = project_closure.closure_id;
+      }, ret r (A.value_unknown (Unresolved_value value))
+    | Ok (set_of_closures_var, value_set_of_closures) ->
+      let closure_id =
+        A.freshen_and_check_closure_id value_set_of_closures
+          project_closure.closure_id
+      in
+      let projecting_from =
+        match set_of_closures_var with
+        | None -> None
+        | Some set_of_closures_var ->
+          let projection : Projection.t =
+            Project_closure {
+              set_of_closures = set_of_closures_var;
+              closure_id;
+            }
+          in
+          match E.find_projection env ~projection with
+          | None -> None
+          | Some var -> Some (var, projection)
+      in
+      match projecting_from with
+      | Some (var, projection) ->
+        simplify_free_variable_named env var ~f:(fun _env var var_approx ->
+          let r = R.map_benefit r (B.remove_projection projection) in
+          Expr (Var var), ret r var_approx)
+      | None ->
+        match reference_recursive_function_directly env closure_id with
+        | Some (flam, approx) -> flam, ret r approx
+        | None ->
+          let set_of_closures_var =
+            match set_of_closures_var with
+            | Some set_of_closures_var' when E.mem env set_of_closures_var' ->
+              set_of_closures_var
+            | Some _ | None -> None
+          in
+          let approx =
+            A.value_closure ?set_of_closures_var value_set_of_closures
+              closure_id
+          in
+          Project_closure { set_of_closures; closure_id; }, ret r approx)
+
+(* Simplify an expression that, given one closure within some set of
+   closures, returns another closure (possibly the same one) within the
+   same set. *)
+let simplify_move_within_set_of_closures env r
+      ~(move_within_set_of_closures : Flambda.move_within_set_of_closures)
+      : Flambda.named * R.t =
+  simplify_free_variable_named env move_within_set_of_closures.closure
+    ~f:(fun _env closure closure_approx ->
+    match A.check_approx_for_closure_allowing_unresolved closure_approx with
+    | Wrong ->
+      Misc.fatal_errorf "Wrong approximation when moving within set of \
+          closures.  Approximation: %a  Term: %a"
+        A.print closure_approx
+        Flambda.print_move_within_set_of_closures move_within_set_of_closures
+    | Unresolved sym ->
+      Move_within_set_of_closures {
+          closure;
+          start_from = move_within_set_of_closures.start_from;
+          move_to = move_within_set_of_closures.move_to;
+        },
+        ret r (A.value_unresolved sym)
+    | Unknown ->
+      Move_within_set_of_closures {
+          closure;
+          start_from = move_within_set_of_closures.start_from;
+          move_to = move_within_set_of_closures.move_to;
+        },
+        ret r (A.value_unknown Other)
+    | Unknown_because_of_unresolved_value value ->
+      (* For example: a move upon a (move upon a closure whose .cmx file
+         is missing). *)
+      Move_within_set_of_closures {
+          closure;
+          start_from = move_within_set_of_closures.start_from;
+          move_to = move_within_set_of_closures.move_to;
+        },
+        ret r (A.value_unknown (Unresolved_value value))
+    | Ok (_value_closure, set_of_closures_var, set_of_closures_symbol,
+          value_set_of_closures) ->
+      let freshen =
+        (* CR-soon mshinwell: potentially misleading name---not freshening with
+           new names, but with previously fresh names *)
+        A.freshen_and_check_closure_id value_set_of_closures
+      in
+      let move_to = freshen move_within_set_of_closures.move_to in
+      let start_from = freshen move_within_set_of_closures.start_from in
+      let projection : Projection.t =
+        Move_within_set_of_closures {
+          closure;
+          start_from;
+          move_to;
+        }
+      in
+      match E.find_projection env ~projection with
+      | Some var ->
+        simplify_free_variable_named env var ~f:(fun _env var var_approx ->
+          let r = R.map_benefit r (B.remove_projection projection) in
+          Expr (Var var), ret r var_approx)
+      | None ->
+        match reference_recursive_function_directly env move_to with
+        | Some (flam, approx) -> flam, ret r approx
+        | None ->
+          if Closure_id.equal start_from move_to then
+            (* Moving from one closure to itself is a no-op.  We can return an
+               [Var] since we already have a variable bound to the closure. *)
+            Expr (Var closure), ret r closure_approx
+          else
+            match set_of_closures_var with
+            | Some set_of_closures_var when E.mem env set_of_closures_var ->
+              (* A variable bound to the set of closures is in scope,
+                 meaning we can rewrite the [Move_within_set_of_closures] to a
+                 [Project_closure]. *)
+              let project_closure : Flambda.project_closure =
+                { set_of_closures = set_of_closures_var;
+                  closure_id = move_to;
+                }
+              in
+              let approx =
+                A.value_closure ~set_of_closures_var value_set_of_closures
+                  move_to
+              in
+              Project_closure project_closure, ret r approx
+            | Some _ | None ->
+              match set_of_closures_symbol with
+              | Some set_of_closures_symbol ->
+                let set_of_closures_var =
+                  Variable.create Internal_variable_names.symbol
+                in
+                let project_closure : Flambda.project_closure =
+                  { set_of_closures = set_of_closures_var;
+                    closure_id = move_to;
+                  }
+                in
+                let project_closure_var =
+                  Variable.create Internal_variable_names.project_closure
+                in
+                let let1 =
+                  Flambda.create_let project_closure_var
+                    (Project_closure project_closure)
+                    (Var project_closure_var)
+                in
+                let expr =
+                  Flambda.create_let set_of_closures_var
+                    (Symbol set_of_closures_symbol)
+                    let1
+                in
+                let approx =
+                  A.value_closure ~set_of_closures_var ~set_of_closures_symbol
+                    value_set_of_closures move_to
+                in
+                Expr expr, ret r approx
+              | None ->
+                (* The set of closures is not available in scope, and we
+                   have no other information by which to simplify the move. *)
+                let move_within : Flambda.move_within_set_of_closures =
+                  { closure; start_from; move_to; }
+                in
+                let approx = A.value_closure value_set_of_closures move_to in
+                Move_within_set_of_closures move_within, ret r approx)
+
+(* Transform an expression denoting an access to a variable bound in
+   a closure.  Variables in the closure ([project_var.closure]) may
+   have been freshened since [expr] was constructed; as such, we
+   must ensure the same happens to [expr].  The renaming information is
+   contained within the approximation deduced from [closure] (as
+   such, that approximation *must* identify which closure it is).
+
+   For instance in some imaginary syntax for flambda:
+
+     [let f x =
+        let g y ~closure:{a} = a + y in
+        let closure = { a = x } in
+          g 12 ~closure]
+
+   when [f] is traversed, [g] can be inlined, resulting in the
+   expression
+
+     [let f z =
+        let g y ~closure:{a} = a + y in
+        let closure = { a = x } in
+          closure.a + 12]
+
+   [closure.a] being a notation for:
+
+     [Project_var{closure = closure; closure_id = g; var = a}]
+
+   If [f] is inlined later, the resulting code will be
+
+     [let x = ... in
+      let g' y' ~closure':{a'} = a' + y' in
+      let closure' = { a' = x } in
+        closure'.a' + 12]
+
+   in particular the field [a] of the closure has been alpha renamed to [a'].
+   This information must be carried from the declaration to the use.
+
+   If the function is declared outside of the alpha renamed part, there is
+   no need for renaming in the [Ffunction] and [Project_var].
+   This is not usually the case, except when the closure declaration is a
+   symbol.
+
+   What ensures that this information is available at [Project_var]
+   point is that those constructions can only be introduced by inlining,
+   which requires that same information. For this to still be valid,
+   other transformation must avoid transforming the information flow in
+   a way that the inline function can't propagate it.
+*)
+let rec simplify_project_var env r ~(project_var : Flambda.project_var)
+      : Flambda.named * R.t =
+  simplify_free_variable_named env project_var.closure
+    ~f:(fun _env closure approx ->
+    match A.check_approx_for_closure_allowing_unresolved approx with
+    | Ok (value_closure, _set_of_closures_var, _set_of_closures_symbol,
+          value_set_of_closures) ->
+      let module F = Freshening.Project_var in
+      let freshening = value_set_of_closures.freshening in
+      let var = F.apply_var_within_closure freshening project_var.var in
+      let closure_id = F.apply_closure_id freshening project_var.closure_id in
+      let closure_id_in_approx = value_closure.closure_id in
+      if not (Closure_id.equal closure_id closure_id_in_approx) then begin
+        Misc.fatal_errorf "When simplifying [Project_var], the closure ID %a \
+            in the approximation of the set of closures did not match the \
+            closure ID %a in the [Project_var] term.  Approximation: %a@. \
+            Var-within-closure being projected: %a@."
+          Closure_id.print closure_id_in_approx
+          Closure_id.print closure_id
+          Simple_value_approx.print approx
+          Var_within_closure.print var
+      end;
+      let projection : Projection.t =
+        Project_var {
+          closure;
+          closure_id;
+          var;
+        }
+      in
+      begin match E.find_projection env ~projection with
+      | Some var ->
+        simplify_free_variable_named env var ~f:(fun _env var var_approx ->
+          let r = R.map_benefit r (B.remove_projection projection) in
+          Expr (Var var), ret r var_approx)
+      | None ->
+        let approx = A.approx_for_bound_var value_set_of_closures var in
+        let expr : Flambda.named = Project_var { closure; closure_id; var; } in
+        let unwrapped = Var_within_closure.unwrap var in
+        let expr =
+          if E.mem env unwrapped then
+            Flambda.Expr (Var unwrapped)
+          else
+            expr
+        in
+        simplify_named_using_approx_and_env env r expr approx
+      end
+    | Unresolved symbol ->
+      (* This value comes from a symbol for which we couldn't find any
+         approximation, telling us that names within the closure couldn't
+         have been renamed.  So we don't need to change the variable or
+         closure ID in the [Project_var] expression. *)
+      Project_var { project_var with closure },
+        ret r (A.value_unresolved symbol)
+    | Unknown ->
+      Project_var { project_var with closure },
+        ret r (A.value_unknown Other)
+    | Unknown_because_of_unresolved_value value ->
+      Project_var { project_var with closure },
+        ret r (A.value_unknown (Unresolved_value value))
+    | Wrong ->
+      (* We must have the correct approximation of the value to ensure
+         we take account of all freshenings. *)
+      Misc.fatal_errorf "[Project_var] from a value with wrong \
+          approximation: %a@.closure=%a@.approx of closure=%a@."
+        Flambda.print_project_var project_var
+        Variable.print closure
+        Simple_value_approx.print approx)
+
+(* Transforms closure definitions by applying [loop] on the code of every
+   one of the set and on the expressions of the free variables.
+   If the substitution is activated, alpha renaming also occur on everything
+   defined by the set of closures:
+   * Variables bound by a closure of the set
+   * closure identifiers
+   * parameters
+
+   The rewriting occurs in a clean environment without any of the variables
+   defined outside reachable.  This helps increase robustness against
+   accidental, potentially unsound simplification of variable accesses by
+   [simplify_using_approx_and_env].
+
+   The rewriting occurs in an environment filled with:
+   * The approximation of the free variables
+   * An explicitly unknown approximation for function parameters,
+     except for those where it is known to be safe: those present in the
+     [specialised_args] set.
+   * An approximation for the closures in the set. It contains the code of
+     the functions before rewriting.
+
+   The approximation of the currently defined closures is available to
+   allow marking recursives calls as direct and in some cases, allow
+   inlining of one closure from the set inside another one. For this to
+   be correct an alpha renaming is first applied on the expressions by
+   [apply_function_decls_and_free_vars].
+
+   For instance when rewriting the declaration
+
+     [let rec f_1 x_1 =
+        let y_1 = x_1 + 1 in
+        g_1 y_1
+      and g_1 z_1 = f_1 (f_1 z_1)]
+
+   When rewriting this function, the first substitution will contain
+   some mapping:
+   { f_1 -> f_2;
+     g_1 -> g_2;
+     x_1 -> x_2;
+     z_1 -> z_2 }
+
+   And the approximation for the closure will contain
+
+   { f_2:
+       fun x_2 ->
+         let y_1 = x_2 + 1 in
+         g_2 y_1
+     g_2:
+       fun z_2 -> f_2 (f_2 z_2) }
+
+   Note that no substitution is applied to the let-bound variable [y_1].
+   If [f_2] where to be inlined inside [g_2], we known that a new substitution
+   will be introduced in the current scope for [y_1] each time.
+
+
+   If the function where a recursive one coming from another compilation
+   unit, the code already went through [Flambdasym] that could have
+   replaced the function variable by the symbol identifying the function
+   (this occur if the function contains only constants in its closure).
+   To handle that case, we first replace those symbols by the original
+   variable.
+*)
+and simplify_set_of_closures original_env r
+      (set_of_closures : Flambda.set_of_closures)
+      : Flambda.set_of_closures * R.t * Freshening.Project_var.t =
+  let function_decls =
+    let module Backend = (val (E.backend original_env) : Backend_intf.S) in
+    (* CR-soon mshinwell: Does this affect
+       [reference_recursive_function_directly]?
+       mshinwell: This should be thought about as part of the wider issue of
+       references to functions via symbols or variables. *)
+    Freshening.rewrite_recursive_calls_with_symbols (E.freshening original_env)
+      set_of_closures.function_decls
+      ~make_closure_symbol:Backend.closure_symbol
+  in
+  let env = E.increase_closure_depth original_env in
+  let free_vars, specialised_args, function_decls, parameter_approximations,
+      internal_value_set_of_closures, set_of_closures_env =
+    Inline_and_simplify_aux.prepare_to_simplify_set_of_closures ~env
+      ~set_of_closures ~function_decls ~only_for_function_decl:None
+      ~freshen:true
+  in
+  let simplify_function fun_var (function_decl : Flambda.function_declaration)
+        (funs, used_params, r)
+        : Flambda.function_declaration Variable.Map.t * Variable.Set.t * R.t =
+    let closure_env =
+      Inline_and_simplify_aux.prepare_to_simplify_closure ~function_decl
+        ~free_vars ~specialised_args ~parameter_approximations
+        ~set_of_closures_env
+    in
+    let body, r =
+      E.enter_closure closure_env ~closure_id:(Closure_id.wrap fun_var)
+        ~inline_inside:
+          (Inlining_decision.should_inline_inside_declaration function_decl)
+        ~dbg:function_decl.dbg
+        ~f:(fun body_env ->
+          assert (E.inside_set_of_closures_declaration
+            function_decls.set_of_closures_origin body_env);
+          simplify body_env r function_decl.body)
+    in
+    let function_decl =
+      Flambda.create_function_declaration ~params:function_decl.params
+        ~body ~stub:function_decl.stub ~dbg:function_decl.dbg
+        ~inline:function_decl.inline ~specialise:function_decl.specialise
+        ~is_a_functor:function_decl.is_a_functor
+        ~closure_origin:function_decl.closure_origin
+    in
+    let used_params' = Flambda.used_params function_decl in
+    Variable.Map.add fun_var function_decl funs,
+      Variable.Set.union used_params used_params', r
+  in
+  let funs, _used_params, r =
+    Variable.Map.fold simplify_function function_decls.funs
+      (Variable.Map.empty, Variable.Set.empty, r)
+  in
+  let function_decls =
+    Flambda.update_function_declarations function_decls ~funs
+  in
+  let invariant_params =
+    lazy (Invariant_params.invariant_params_in_recursion function_decls
+      ~backend:(E.backend env))
+  in
+  let recursive =
+    lazy (Find_recursive_functions.in_function_declarations function_decls
+      ~backend:(E.backend env))
+  in
+  let keep_body =
+    Inline_and_simplify_aux.keep_body_check
+      ~is_classic_mode:function_decls.is_classic_mode ~recursive
+  in
+  let function_decls_approx =
+    A.function_declarations_approx ~keep_body function_decls
+  in
+  let value_set_of_closures =
+    A.create_value_set_of_closures
+      ~function_decls:function_decls_approx
+      ~bound_vars:internal_value_set_of_closures.bound_vars
+      ~invariant_params
+      ~recursive
+      ~specialised_args:internal_value_set_of_closures.specialised_args
+      ~free_vars:internal_value_set_of_closures.free_vars
+      ~freshening:internal_value_set_of_closures.freshening
+      ~direct_call_surrogates:
+        internal_value_set_of_closures.direct_call_surrogates
+  in
+  let direct_call_surrogates =
+    Closure_id.Map.fold (fun existing surrogate surrogates ->
+        Variable.Map.add (Closure_id.unwrap existing)
+          (Closure_id.unwrap surrogate) surrogates)
+      internal_value_set_of_closures.direct_call_surrogates
+      Variable.Map.empty
+  in
+  let set_of_closures =
+    Flambda.create_set_of_closures ~function_decls
+      ~free_vars:(Variable.Map.map fst free_vars)
+      ~specialised_args
+      ~direct_call_surrogates
+  in
+  let r = ret r (A.value_set_of_closures value_set_of_closures) in
+  set_of_closures, r, value_set_of_closures.freshening
+
+and simplify_apply env r ~(apply : Flambda.apply) : Flambda.t * R.t =
+  let {
+    Flambda. func = lhs_of_application; args; kind = _; dbg;
+    inline = inline_requested; specialise = specialise_requested;
+  } = apply in
+  let dbg = E.add_inlined_debuginfo env ~dbg in
+  simplify_free_variable env lhs_of_application
+    ~f:(fun env lhs_of_application lhs_of_application_approx ->
+      simplify_free_variables env args ~f:(fun env args args_approxs ->
+        (* By using the approximation of the left-hand side of the
+           application, attempt to determine which function is being applied
+           (even if the application is currently [Indirect]).  If
+           successful---in which case we then have a direct
+           application---consider inlining. *)
+        match A.check_approx_for_closure lhs_of_application_approx with
+        | Ok (value_closure, set_of_closures_var,
+              set_of_closures_symbol, value_set_of_closures) ->
+          let lhs_of_application, closure_id_being_applied,
+                value_set_of_closures, env, wrap =
+            let closure_id_being_applied = value_closure.closure_id in
+            (* If the call site is a direct call to a function that has a
+               "direct call surrogate" (see inline_and_simplify_aux.mli),
+               repoint the call to the surrogate. *)
+            let surrogates = value_set_of_closures.direct_call_surrogates in
+            match Closure_id.Map.find closure_id_being_applied surrogates with
+            | exception Not_found ->
+              lhs_of_application, closure_id_being_applied,
+                value_set_of_closures, env, (fun expr -> expr)
+            | surrogate ->
+              let rec find_transitively surrogate =
+                match Closure_id.Map.find surrogate surrogates with
+                | exception Not_found -> surrogate
+                | surrogate -> find_transitively surrogate
+              in
+              let surrogate = find_transitively surrogate in
+              let surrogate_var = Variable.rename lhs_of_application in
+              let move_to_surrogate : Projection.move_within_set_of_closures =
+                { closure = lhs_of_application;
+                  start_from = closure_id_being_applied;
+                  move_to = surrogate;
+                }
+              in
+              let approx_for_surrogate =
+                A.value_closure ~closure_var:surrogate_var
+                  ?set_of_closures_var ?set_of_closures_symbol
+                  value_set_of_closures surrogate
+              in
+              let env = E.add env surrogate_var approx_for_surrogate in
+              let wrap expr =
+                Flambda.create_let surrogate_var
+                  (Move_within_set_of_closures move_to_surrogate)
+                  expr
+              in
+              surrogate_var, surrogate, value_set_of_closures, env, wrap
+          in
+          let function_decls = value_set_of_closures.function_decls in
+          let function_decl =
+            try
+              Variable.Map.find
+                (Closure_id.unwrap closure_id_being_applied)
+                function_decls.funs
+            with
+            | Not_found ->
+              Misc.fatal_errorf "When handling application expression, \
+                  approximation references non-existent closure %a@."
+                Closure_id.print closure_id_being_applied
+          in
+          let r =
+            match apply.kind with
+            | Indirect ->
+              R.map_benefit r Inlining_cost.Benefit.direct_call_of_indirect
+            | Direct _ -> r
+          in
+          let nargs = List.length args in
+          let arity = A.function_arity function_decl in
+          let result, r =
+            if nargs = arity then
+              simplify_full_application env r ~function_decls
+                ~lhs_of_application ~closure_id_being_applied ~function_decl
+                ~value_set_of_closures ~args ~args_approxs ~dbg
+                ~inline_requested ~specialise_requested
+            else if nargs > arity then
+              simplify_over_application env r ~args ~args_approxs
+                ~function_decls ~lhs_of_application ~closure_id_being_applied
+                ~function_decl ~value_set_of_closures ~dbg ~inline_requested
+                ~specialise_requested
+            else if nargs > 0 && nargs < arity then
+              simplify_partial_application env r ~lhs_of_application
+                ~closure_id_being_applied ~function_decl ~args ~dbg
+                ~inline_requested ~specialise_requested
+            else
+              Misc.fatal_errorf "Function with arity %d when simplifying \
+                  application expression: %a"
+                arity Flambda.print (Flambda.Apply apply)
+          in
+          wrap result, r
+        | Wrong ->  (* Insufficient approximation information to simplify. *)
+          Apply ({ func = lhs_of_application; args; kind = Indirect; dbg;
+              inline = inline_requested; specialise = specialise_requested; }),
+            ret r (A.value_unknown Other)))
+
+and simplify_full_application env r ~function_decls ~lhs_of_application
+      ~closure_id_being_applied ~function_decl ~value_set_of_closures ~args
+      ~args_approxs ~dbg ~inline_requested ~specialise_requested =
+  Inlining_decision.for_call_site ~env ~r ~function_decls
+    ~lhs_of_application ~closure_id_being_applied ~function_decl
+    ~value_set_of_closures ~args ~args_approxs ~dbg ~simplify
+    ~inline_requested ~specialise_requested
+
+and simplify_partial_application env r ~lhs_of_application
+      ~closure_id_being_applied ~function_decl ~args ~dbg
+      ~inline_requested ~specialise_requested =
+  let arity = A.function_arity function_decl in
+  assert (arity > List.length args);
+  (* For simplicity, we disallow [@inline] attributes on partial
+     applications.  The user may always write an explicit wrapper instead
+     with such an attribute. *)
+  (* CR-someday mshinwell: Pierre noted that we might like a function to be
+     inlined when applied to its first set of arguments, e.g. for some kind
+     of type class like thing. *)
+  begin match (inline_requested : Lambda.inline_attribute) with
+  | Always_inline | Never_inline ->
+    Location.prerr_warning (Debuginfo.to_location dbg)
+      (Warnings.Inlining_impossible "[@inlined] attributes may not be used \
+        on partial applications")
+  | Unroll _ ->
+    Location.prerr_warning (Debuginfo.to_location dbg)
+      (Warnings.Inlining_impossible "[@unrolled] attributes may not be used \
+        on partial applications")
+  | Hint_inline | Default_inline -> ()
+  end;
+  begin match (specialise_requested : Lambda.specialise_attribute) with
+  | Always_specialise | Never_specialise ->
+    Location.prerr_warning (Debuginfo.to_location dbg)
+      (Warnings.Inlining_impossible "[@specialised] attributes may not be used \
+        on partial applications")
+  | Default_specialise -> ()
+  end;
+  let freshened_params =
+    List.map (fun p -> Parameter.rename p) function_decl.A.params
+  in
+  let applied_args, remaining_args =
+    Misc.Stdlib.List.map2_prefix (fun arg id' -> id', arg)
+      args freshened_params
+  in
+  let wrapper_accepting_remaining_args =
+    let body : Flambda.t =
+      Apply {
+        func = lhs_of_application;
+        args = Parameter.List.vars freshened_params;
+        kind = Direct closure_id_being_applied;
+        dbg;
+        inline = Default_inline;
+        specialise = Default_specialise;
+      }
+    in
+    let closure_variable =
+      Variable.rename
+        (Closure_id.unwrap closure_id_being_applied)
+    in
+    Flambda_utils.make_closure_declaration ~id:closure_variable
+      ~is_classic_mode:false
+      ~body
+      ~params:remaining_args
+      ~stub:true
+  in
+  let with_known_args =
+    Flambda_utils.bind
+      ~bindings:(List.map (fun (param, arg) ->
+          Parameter.var param, Flambda.Expr (Var arg)) applied_args)
+      ~body:wrapper_accepting_remaining_args
+  in
+  simplify env r with_known_args
+
+and simplify_over_application env r ~args ~args_approxs ~function_decls
+      ~lhs_of_application ~closure_id_being_applied ~function_decl
+      ~value_set_of_closures ~dbg ~inline_requested ~specialise_requested =
+  let arity = A.function_arity function_decl in
+  assert (arity < List.length args);
+  assert (List.length args = List.length args_approxs);
+  let full_app_args, remaining_args =
+    Misc.Stdlib.List.split_at arity args
+  in
+  let full_app_approxs, _ =
+    Misc.Stdlib.List.split_at arity args_approxs
+  in
+  let expr, r =
+    simplify_full_application env r ~function_decls ~lhs_of_application
+      ~closure_id_being_applied ~function_decl ~value_set_of_closures
+      ~args:full_app_args ~args_approxs:full_app_approxs ~dbg
+      ~inline_requested ~specialise_requested
+  in
+  let func_var = Variable.create Internal_variable_names.full_apply in
+  let expr : Flambda.t =
+    Flambda.create_let func_var (Expr expr)
+      (Apply { func = func_var; args = remaining_args; kind = Indirect; dbg;
+        inline = inline_requested; specialise = specialise_requested; })
+  in
+  let expr = Lift_code.lift_lets_expr expr ~toplevel:true in
+  simplify (E.set_never_inline env) r expr
+
+and simplify_named env r (tree : Flambda.named) : Flambda.named * R.t =
+  match tree with
+  | Symbol sym ->
+    (* New Symbol construction could have been introduced during
+       transformation (by simplify_named_using_approx_and_env).
+       When this comes from another compilation unit, we must load it. *)
+    let approx = E.find_or_load_symbol env sym in
+    simplify_named_using_approx r tree approx
+  | Const cst -> tree, ret r (simplify_const cst)
+  | Allocated_const cst -> tree, ret r (approx_for_allocated_const cst)
+  | Read_mutable mut_var ->
+    (* See comment on the [Assign] case. *)
+    let mut_var =
+      Freshening.apply_mutable_variable (E.freshening env) mut_var
+    in
+    Read_mutable mut_var, ret r (A.value_unknown Other)
+  | Read_symbol_field (symbol, field_index) ->
+    let approx = E.find_or_load_symbol env symbol in
+    begin match A.get_field approx ~field_index with
+    (* CR-someday mshinwell: Think about [Unreachable] vs. [Value_bottom]. *)
+    | Unreachable -> (Flambda.Expr Proved_unreachable), r
+    | Ok approx ->
+      let approx = A.augment_with_symbol_field approx symbol field_index in
+      simplify_named_using_approx_and_env env r tree approx
+    end
+  | Set_of_closures set_of_closures -> begin
+    let backend = E.backend env in
+    let set_of_closures, r, first_freshening =
+      simplify_set_of_closures env r set_of_closures
+    in
+    let simplify env r expr ~pass_name : Flambda.named * R.t =
+      (* If simplifying a set of closures more than once during any given round
+         of simplification, the [Freshening.Project_var] substitutions arising
+         from each call to [simplify_set_of_closures] must be composed.
+         Note that this function only composes with [first_freshening] owing
+         to the structure of the code below (this new [simplify] is always
+         in tail position). *)
+      (* CR-someday mshinwell: It was mooted that maybe we could try
+         structurally-typed closures (i.e. where we would never rename the
+         closure elements), or something else, to try to remove
+         the "closure freshening" thing in the approximation which is hard
+         to deal with. *)
+      let expr, r = simplify (E.set_never_inline env) r expr in
+      let approx = R.approx r in
+      let value_set_of_closures =
+        match A.strict_check_approx_for_set_of_closures approx with
+        | Wrong ->
+          Misc.fatal_errorf "Unexpected approximation returned from \
+              simplification of [%s] result: %a"
+            pass_name A.print approx
+        | Ok (_var, value_set_of_closures) ->
+          let freshening =
+            Freshening.Project_var.compose ~earlier:first_freshening
+              ~later:value_set_of_closures.freshening
+          in
+          A.update_freshening_of_value_set_of_closures value_set_of_closures
+            ~freshening
+      in
+      Expr expr, (ret r (A.value_set_of_closures value_set_of_closures))
+    in
+    (* This does the actual substitutions of specialised args introduced
+       by [Unbox_closures] for free variables.  (Apart from simplifying
+       the [Unbox_closures] output, this also prevents applying
+       [Unbox_closures] over and over.) *)
+    let set_of_closures =
+      let ppf_dump = Inline_and_simplify_aux.Env.ppf_dump env in
+      match Remove_free_vars_equal_to_args.run ~ppf_dump set_of_closures with
+      | None -> set_of_closures
+      | Some set_of_closures -> set_of_closures
+    in
+    (* Do [Unbox_closures] next to try to decide which things are
+       free variables and which things are specialised arguments before
+       unboxing them. *)
+    match
+      Unbox_closures.rewrite_set_of_closures ~env
+        ~duplicate_function ~set_of_closures
+    with
+    | Some (expr, benefit) ->
+      let r = R.add_benefit r benefit in
+      simplify env r expr ~pass_name:"Unbox_closures"
+    | None ->
+      match Unbox_free_vars_of_closures.run ~env ~set_of_closures with
+      | Some (expr, benefit) ->
+        let r = R.add_benefit r benefit in
+        simplify env r expr ~pass_name:"Unbox_free_vars_of_closures"
+      | None ->
+        (* CR-soon mshinwell: should maybe add one allocation for the stub *)
+        match
+          Unbox_specialised_args.rewrite_set_of_closures ~env
+            ~duplicate_function ~set_of_closures
+        with
+        | Some (expr, benefit) ->
+          let r = R.add_benefit r benefit in
+          simplify env r expr ~pass_name:"Unbox_specialised_args"
+        | None ->
+          match
+            Remove_unused_arguments.
+                separate_unused_arguments_in_set_of_closures
+              set_of_closures ~backend
+          with
+          | Some set_of_closures ->
+            let expr =
+              Flambda_utils.name_expr (Set_of_closures set_of_closures)
+                ~name:Internal_variable_names.remove_unused_arguments
+            in
+            simplify env r expr ~pass_name:"Remove_unused_arguments"
+          | None ->
+            Set_of_closures set_of_closures, r
+    end
+  | Project_closure project_closure ->
+    simplify_project_closure env r ~project_closure
+  | Project_var project_var -> simplify_project_var env r ~project_var
+  | Move_within_set_of_closures move_within_set_of_closures ->
+    simplify_move_within_set_of_closures env r ~move_within_set_of_closures
+  | Prim (prim, args, dbg) ->
+    let dbg = E.add_inlined_debuginfo env ~dbg in
+    simplify_free_variables_named env args ~f:(fun env args args_approxs ->
+      let tree = Flambda.Prim (prim, args, dbg) in
+      begin match prim, args, args_approxs with
+      (* CR-someday mshinwell: Optimise [Pfield_computed]. *)
+      | Pfield field_index, [arg], [arg_approx] ->
+        let projection : Projection.t = Field (field_index, arg) in
+        begin match E.find_projection env ~projection with
+        | Some var ->
+          simplify_free_variable_named env var ~f:(fun _env var var_approx ->
+            let r = R.map_benefit r (B.remove_projection projection) in
+            Expr (Var var), ret r var_approx)
+        | None ->
+          begin match A.get_field arg_approx ~field_index with
+          | Unreachable -> (Flambda.Expr Proved_unreachable, r)
+          | Ok approx ->
+            let tree, approx =
+              match arg_approx.symbol with
+              (* If the [Pfield] is projecting directly from a symbol, rewrite
+                 the expression to [Read_symbol_field]. *)
+              | Some (symbol, None) ->
+                let approx =
+                  A.augment_with_symbol_field approx symbol field_index
+                in
+                Flambda.Read_symbol_field (symbol, field_index), approx
+              | None | Some (_, Some _ ) ->
+                (* This [Pfield] is either not projecting from a symbol at all,
+                   or it is the projection of a projection from a symbol. *)
+                let approx' = E.really_import_approx env approx in
+                tree, approx'
+            in
+            simplify_named_using_approx_and_env env r tree approx
+          end
+        end
+      | Pfield _, _, _ -> Misc.fatal_error "Pfield arity error"
+      | (Parraysetu kind | Parraysets kind),
+        [_block; _field; _value],
+        [block_approx; _field_approx; value_approx] ->
+        if A.warn_on_mutation block_approx then begin
+          Location.prerr_warning (Debuginfo.to_location dbg)
+            Warnings.Assignment_to_non_mutable_value
+        end;
+        let kind =
+          let check () =
+            match kind with
+            | Pfloatarray | Pgenarray -> ()
+            | Paddrarray | Pintarray ->
+              (* CR pchambart: Do a proper warning here *)
+              Misc.fatal_errorf "Assignment of a float to a specialised \
+                                 non-float array: %a"
+                Flambda.print_named tree
+          in
+          match A.descr block_approx, A.descr value_approx with
+          | (Value_float_array _, _) -> check (); Lambda.Pfloatarray
+          | (_, Value_float _) when Config.flat_float_array ->
+            check (); Lambda.Pfloatarray
+            (* CR pchambart: This should be accounted by the benefit *)
+          | _ ->
+            kind
+        in
+        let prim : Clambda_primitives.primitive = match prim with
+          | Parraysetu _ -> Parraysetu kind
+          | Parraysets _ -> Parraysets kind
+          | _ -> assert false
+        in
+        Prim (prim, args, dbg), ret r (A.value_unknown Other)
+      | Psetfield _, _block::_, block_approx::_ ->
+        if A.warn_on_mutation block_approx then begin
+          Location.prerr_warning (Debuginfo.to_location dbg)
+            Warnings.Assignment_to_non_mutable_value
+        end;
+        tree, ret r (A.value_unknown Other)
+      | (Psetfield _ | Parraysetu _ | Parraysets _), _, _ ->
+        Misc.fatal_error "Psetfield / Parraysetu / Parraysets arity error"
+      | (Psequand | Psequor), _, _ ->
+        Misc.fatal_error "Psequand and Psequor must be expanded (see handling \
+            in closure_conversion.ml)"
+      | p, args, args_approxs ->
+        let expr, approx, benefit =
+          let module Backend = (val (E.backend env) : Backend_intf.S) in
+          Simplify_primitives.primitive p (args, args_approxs) tree dbg
+            ~size_int:Backend.size_int
+        in
+        let r = R.map_benefit r (B.(+) benefit) in
+        let approx =
+          match p with
+          | Popaque -> A.value_unknown Other
+          | _ -> approx
+        in
+        expr, ret r approx
+      end)
+  | Expr expr ->
+    let expr, r = simplify env r expr in
+    Expr expr, r
+
+and simplify env r (tree : Flambda.t) : Flambda.t * R.t =
+  match tree with
+  | Var var ->
+    let var = Freshening.apply_variable (E.freshening env) var in
+    (* If from the approximations we can simplify [var], then we will be
+       forced to insert [let]-expressions (done using [name_expr], in
+       [Simple_value_approx]) to bind a [named].  This has an important
+       consequence: it brings bindings of constants closer to their use
+       points. *)
+    simplify_using_approx_and_env env r (Var var) (E.find_exn env var)
+  | Apply apply ->
+    simplify_apply env r ~apply
+  | Let _ ->
+    let for_defining_expr (env, r) var defining_expr =
+      let defining_expr, r = simplify_named env r defining_expr in
+      let var, sb = Freshening.add_variable (E.freshening env) var in
+      let env = E.set_freshening env sb in
+      let env = E.add env var (R.approx r) in
+      (env, r), var, defining_expr
+    in
+    let for_last_body (env, r) body =
+      simplify env r body
+    in
+    let filter_defining_expr r var defining_expr free_vars_of_body =
+      if Variable.Set.mem var free_vars_of_body then
+        r, var, Some defining_expr
+      else if Effect_analysis.no_effects_named defining_expr then
+        let r = R.map_benefit r (B.remove_code_named defining_expr) in
+        r, var, None
+      else
+        r, var, Some defining_expr
+    in
+    Flambda.fold_lets_option tree
+      ~init:(env, r)
+      ~for_defining_expr
+      ~for_last_body
+      ~filter_defining_expr
+  | Let_mutable { var = mut_var; initial_value = var; body; contents_kind } ->
+    (* CR-someday mshinwell: add the dead let elimination, as above. *)
+    simplify_free_variable env var ~f:(fun env var _var_approx ->
+      let mut_var, sb =
+        Freshening.add_mutable_variable (E.freshening env) mut_var
+      in
+      let env = E.set_freshening env sb in
+      let body, r =
+        simplify (E.add_mutable env mut_var (A.value_unknown Other)) r body
+      in
+      Flambda.Let_mutable
+        { var = mut_var;
+          initial_value = var;
+          body;
+          contents_kind },
+      r)
+  | Let_rec (defs, body) ->
+    let defs, sb = Freshening.add_variables (E.freshening env) defs in
+    let env = E.set_freshening env sb in
+    let def_env =
+      List.fold_left (fun env_acc (id, _lam) ->
+          E.add env_acc id (A.value_unknown Other))
+        env defs
+    in
+    let defs, body_env, r =
+      List.fold_right (fun (id, lam) (defs, env_acc, r) ->
+          let lam, r = simplify_named def_env r lam in
+          let defs = (id, lam) :: defs in
+          let env_acc = E.add env_acc id (R.approx r) in
+          defs, env_acc, r)
+        defs ([], env, r)
+    in
+    let body, r = simplify body_env r body in
+    Let_rec (defs, body), r
+  | Static_raise (i, args) ->
+    let i = Freshening.apply_static_exception (E.freshening env) i in
+    simplify_free_variables env args ~f:(fun _env args _args_approxs ->
+      let r = R.use_static_exception r i in
+      Static_raise (i, args), ret r A.value_bottom)
+  | Static_catch (i, vars, body, handler) ->
+    begin
+      match body with
+      | Let { var; defining_expr = def; body; _ }
+          when not (Flambda_utils.might_raise_static_exn def i) ->
+        simplify env r
+          (Flambda.create_let var def (Static_catch (i, vars, body, handler)))
+      | _ ->
+        let i, sb = Freshening.add_static_exception (E.freshening env) i in
+        let env = E.set_freshening env sb in
+        let body, r = simplify env r body in
+        (* CR-soon mshinwell: for robustness, R.used_static_exceptions should
+           maybe be removed. *)
+        if not (Static_exception.Set.mem i (R.used_static_exceptions r)) then
+          (* If the static exception is not used, we can drop the declaration *)
+          body, r
+        else begin
+          match (body : Flambda.t) with
+          | Static_raise (j, args) ->
+            assert (Static_exception.equal i j);
+            let handler =
+              List.fold_left2 (fun body var arg ->
+                  Flambda.create_let var (Expr (Var arg)) body)
+                handler vars args
+            in
+            let r = R.exit_scope_catch r i in
+            simplify env r handler
+          | _ ->
+            let vars, sb = Freshening.add_variables' (E.freshening env) vars in
+            let approx = R.approx r in
+            let env =
+              List.fold_left (fun env id ->
+                  E.add env id (A.value_unknown Other))
+                (E.set_freshening env sb) vars
+            in
+            let env = E.inside_branch env in
+            let handler, r = simplify env r handler in
+            let r = R.exit_scope_catch r i in
+            Static_catch (i, vars, body, handler),
+              R.meet_approx r env approx
+        end
+    end
+  | Try_with (body, id, handler) ->
+    let body, r = simplify env r body in
+    let id, sb = Freshening.add_variable (E.freshening env) id in
+    let env = E.add (E.set_freshening env sb) id (A.value_unknown Other) in
+    let env = E.inside_branch env in
+    let handler, r = simplify env r handler in
+    Try_with (body, id, handler), ret r (A.value_unknown Other)
+  | If_then_else (arg, ifso, ifnot) ->
+    (* When arg is the constant false or true (or something considered
+       as true), we can drop the if and replace it by a sequence.
+       if arg is not effectful we can also drop it. *)
+    simplify_free_variable env arg ~f:(fun env arg arg_approx ->
+      begin match arg_approx.descr with
+      | Value_constptr 0 | Value_int 0 ->  (* Constant [false]: keep [ifnot] *)
+        let ifnot, r = simplify env r ifnot in
+        ifnot, R.map_benefit r B.remove_branch
+      | Value_constptr _ | Value_int _
+      | Value_block _ ->  (* Constant [true]: keep [ifso] *)
+        let ifso, r = simplify env r ifso in
+        ifso, R.map_benefit r B.remove_branch
+      | _ ->
+        let env = E.inside_branch env in
+        let ifso, r = simplify env r ifso in
+        let ifso_approx = R.approx r in
+        let ifnot, r = simplify env r ifnot in
+        If_then_else (arg, ifso, ifnot),
+          R.meet_approx r env ifso_approx
+      end)
+  | While (cond, body) ->
+    let cond, r = simplify env r cond in
+    let body, r = simplify env r body in
+    While (cond, body), ret r (A.value_unknown Other)
+  | Send { kind; meth; obj; args; dbg; } ->
+    let dbg = E.add_inlined_debuginfo env ~dbg in
+    simplify_free_variable env meth ~f:(fun env meth _meth_approx ->
+      simplify_free_variable env obj ~f:(fun env obj _obj_approx ->
+        simplify_free_variables env args ~f:(fun _env args _args_approx ->
+          Send { kind; meth; obj; args; dbg; },
+            ret r (A.value_unknown Other))))
+  | For { bound_var; from_value; to_value; direction; body; } ->
+    simplify_free_variable env from_value ~f:(fun env from_value _approx ->
+      simplify_free_variable env to_value ~f:(fun env to_value _approx ->
+        let bound_var, sb =
+          Freshening.add_variable (E.freshening env) bound_var
+        in
+        let env =
+          E.add (E.set_freshening env sb) bound_var
+            (A.value_unknown Other)
+        in
+        let body, r = simplify env r body in
+        For { bound_var; from_value; to_value; direction; body; },
+          ret r (A.value_unknown Other)))
+  | Assign { being_assigned; new_value; } ->
+    (* No need to use something like [simplify_free_variable]: the
+       approximation of [being_assigned] is always unknown. *)
+    let being_assigned =
+      Freshening.apply_mutable_variable (E.freshening env) being_assigned
+    in
+    simplify_free_variable env new_value ~f:(fun _env new_value _approx ->
+      Assign { being_assigned; new_value; }, ret r (A.value_unknown Other))
+  | Switch (arg, sw) ->
+    (* When [arg] is known to be a variable whose approximation is that of a
+       block with a fixed tag or a fixed integer, we can eliminate the
+       [Switch].  (This should also make the [Let] that binds [arg] redundant,
+       meaning that it too can be eliminated.) *)
+    simplify_free_variable env arg ~f:(fun env arg arg_approx ->
+      let rec filter_branches filter branches compatible_branches =
+        match branches with
+        | [] -> Can_be_taken compatible_branches
+        | (c, lam) as branch :: branches ->
+          match filter arg_approx c with
+          | A.Cannot_be_taken ->
+            filter_branches filter branches compatible_branches
+          | A.Can_be_taken ->
+            filter_branches filter branches (branch :: compatible_branches)
+          | A.Must_be_taken ->
+            Must_be_taken lam
+      in
+      let filtered_consts =
+        filter_branches A.potentially_taken_const_switch_branch sw.consts []
+      in
+      let filtered_blocks =
+        filter_branches A.potentially_taken_block_switch_branch sw.blocks []
+      in
+      begin match filtered_consts, filtered_blocks with
+      | Must_be_taken _, Must_be_taken _ ->
+        assert false
+      | Must_be_taken branch, _
+      | _, Must_be_taken branch ->
+        let lam, r = simplify env r branch in
+        lam, R.map_benefit r B.remove_branch
+      | Can_be_taken consts, Can_be_taken blocks ->
+        match consts, blocks, sw.failaction with
+        | [], [], None ->
+        (* If the switch is applied to a statically-known value that does not
+           match any case:
+           * if there is a default action take that case;
+           * otherwise this is something that is guaranteed not to
+             be reachable by the type checker.  For example:
+             [type 'a t = Int : int -> int t | Float : float -> float t
+              match Int 1 with
+              | Int _ -> ...
+              | Float f as v ->
+                match v with   <-- This match is unreachable
+                | Float f -> ...]
+         *)
+          Proved_unreachable, ret r A.value_bottom
+        | [_, branch], [], None
+        | [], [_, branch], None
+        | [], [], Some branch ->
+          let lam, r = simplify env r branch in
+          lam, R.map_benefit r B.remove_branch
+        | _ ->
+          let env = E.inside_branch env in
+          let f (i, v) (acc, r) =
+            let approx = R.approx r in
+            let lam, r = simplify env r v in
+            (i, lam)::acc,
+            R.meet_approx r env approx
+          in
+          let r = R.set_approx r A.value_bottom in
+          let consts, r = List.fold_right f consts ([], r) in
+          let blocks, r = List.fold_right f blocks ([], r) in
+          let failaction, r =
+            match sw.failaction with
+            | None -> None, r
+            | Some l ->
+              let approx = R.approx r in
+              let l, r = simplify env r l in
+              Some l,
+              R.meet_approx r env approx
+          in
+          let sw = { sw with failaction; consts; blocks; } in
+          Switch (arg, sw), r
+      end)
+  | String_switch (arg, sw, def) ->
+    simplify_free_variable env arg ~f:(fun env arg arg_approx ->
+      match A.check_approx_for_string arg_approx with
+      | None ->
+        let env = E.inside_branch env in
+        let sw, r =
+          List.fold_right (fun (str, lam) (sw, r) ->
+              let approx = R.approx r in
+              let lam, r = simplify env r lam in
+              (str, lam)::sw,
+                R.meet_approx r env approx)
+            sw
+            ([], r)
+        in
+        let def, r =
+          match def with
+          | None -> def, r
+          | Some def ->
+            let approx = R.approx r in
+            let def, r = simplify env r def in
+            Some def,
+              R.meet_approx r env approx
+        in
+        String_switch (arg, sw, def), ret r (A.value_unknown Other)
+      | Some arg_string ->
+        let branch =
+          match List.find (fun (str, _) -> String.equal str arg_string) sw with
+          | (_, branch) -> branch
+          | exception Not_found ->
+            match def with
+            | None ->
+              Flambda.Proved_unreachable
+            | Some def ->
+              def
+        in
+        let branch, r = simplify env r branch in
+        branch, R.map_benefit r B.remove_branch)
+  | Proved_unreachable -> tree, ret r A.value_bottom
+
+and simplify_list env r l =
+  match l with
+  | [] -> [], [], r
+  | h::t ->
+    let t', approxs, r = simplify_list env r t in
+    let h', r = simplify env r h in
+    let approxs = (R.approx r) :: approxs in
+    if t' == t && h' == h
+    then l, approxs, r
+    else h' :: t', approxs, r
+
+and duplicate_function ~env ~(set_of_closures : Flambda.set_of_closures)
+      ~fun_var ~new_fun_var =
+  let function_decl =
+    match Variable.Map.find fun_var set_of_closures.function_decls.funs with
+    | exception Not_found ->
+      Misc.fatal_errorf "duplicate_function: cannot find function %a"
+        Variable.print fun_var
+    | function_decl -> function_decl
+  in
+  let env = E.activate_freshening (E.set_never_inline env) in
+  let free_vars, specialised_args, function_decls, parameter_approximations,
+      _internal_value_set_of_closures, set_of_closures_env =
+    Inline_and_simplify_aux.prepare_to_simplify_set_of_closures ~env
+      ~set_of_closures ~function_decls:set_of_closures.function_decls
+      ~freshen:false ~only_for_function_decl:(Some function_decl)
+  in
+  let function_decl =
+    match Variable.Map.find fun_var function_decls.funs with
+    | exception Not_found ->
+      Misc.fatal_errorf "duplicate_function: cannot find function %a (2)"
+        Variable.print fun_var
+    | function_decl -> function_decl
+  in
+  let closure_env =
+    Inline_and_simplify_aux.prepare_to_simplify_closure ~function_decl
+      ~free_vars ~specialised_args ~parameter_approximations
+      ~set_of_closures_env
+  in
+  let body, _r =
+    E.enter_closure closure_env
+      ~closure_id:(Closure_id.wrap fun_var)
+      ~inline_inside:false
+      ~dbg:function_decl.dbg
+      ~f:(fun body_env ->
+        assert (E.inside_set_of_closures_declaration
+          function_decls.set_of_closures_origin body_env);
+        simplify body_env (R.create ()) function_decl.body)
+  in
+  let function_decl =
+    Flambda.create_function_declaration ~params:function_decl.params
+      ~body ~stub:function_decl.stub ~dbg:function_decl.dbg
+      ~inline:function_decl.inline ~specialise:function_decl.specialise
+      ~is_a_functor:function_decl.is_a_functor
+      ~closure_origin:(Closure_origin.create (Closure_id.wrap new_fun_var))
+  in
+  function_decl, specialised_args
+
+let constant_defining_value_approx
+    env
+    (constant_defining_value:Flambda.constant_defining_value) =
+  match constant_defining_value with
+  | Allocated_const const ->
+    approx_for_allocated_const const
+  | Block (tag, fields) ->
+    let fields =
+      List.map
+        (function
+          | Flambda.Symbol sym -> begin
+              match E.find_symbol_opt env sym with
+              | Some approx -> approx
+              | None -> A.value_unresolved (Symbol sym)
+            end
+          | Flambda.Const cst -> simplify_const cst)
+        fields
+    in
+    A.value_block tag (Array.of_list fields)
+  | Set_of_closures { function_decls; free_vars; specialised_args } ->
+    (* At toplevel, there is no freshening currently happening (this
+       cannot be the body of a currently inlined function), so we can
+       keep the original set_of_closures in the approximation. *)
+    assert(Freshening.is_empty (E.freshening env));
+    assert(Variable.Map.is_empty free_vars);
+    assert(Variable.Map.is_empty specialised_args);
+    let invariant_params =
+      lazy (Invariant_params.invariant_params_in_recursion function_decls
+        ~backend:(E.backend env))
+    in
+    let recursive =
+      lazy (Find_recursive_functions.in_function_declarations function_decls
+        ~backend:(E.backend env))
+    in
+    let value_set_of_closures =
+      let keep_body =
+        Inline_and_simplify_aux.keep_body_check
+          ~is_classic_mode:function_decls.is_classic_mode ~recursive
+      in
+      let function_decls =
+        A.function_declarations_approx ~keep_body function_decls
+      in
+      A.create_value_set_of_closures ~function_decls
+        ~bound_vars:Var_within_closure.Map.empty
+        ~invariant_params
+        ~recursive
+        ~specialised_args:Variable.Map.empty
+        ~free_vars:Variable.Map.empty
+        ~freshening:Freshening.Project_var.empty
+        ~direct_call_surrogates:Closure_id.Map.empty
+    in
+    A.value_set_of_closures value_set_of_closures
+  | Project_closure (set_of_closures_symbol, closure_id) -> begin
+      match E.find_symbol_opt env set_of_closures_symbol with
+      | None ->
+        A.value_unresolved (Symbol set_of_closures_symbol)
+      | Some set_of_closures_approx ->
+        let checked_approx =
+          A.check_approx_for_set_of_closures set_of_closures_approx
+        in
+        match checked_approx with
+        | Ok (_, value_set_of_closures) ->
+          let closure_id =
+            A.freshen_and_check_closure_id value_set_of_closures closure_id
+          in
+          A.value_closure value_set_of_closures closure_id
+        | Unresolved sym -> A.value_unresolved sym
+        | Unknown -> A.value_unknown Other
+        | Unknown_because_of_unresolved_value value ->
+          A.value_unknown (Unresolved_value value)
+        | Wrong ->
+          Misc.fatal_errorf "Wrong approximation for [Project_closure] \
+                             when being used as a [constant_defining_value]: %a"
+            Flambda.print_constant_defining_value constant_defining_value
+    end
+
+(* See documentation on [Let_rec_symbol] in flambda.mli. *)
+let define_let_rec_symbol_approx orig_env defs =
+  (* First declare an empty version of the symbols *)
+  let init_env =
+    List.fold_left (fun building_env (symbol, _) ->
+        E.add_symbol building_env symbol (A.value_unresolved (Symbol symbol)))
+      orig_env defs
+  in
+  let rec loop times lookup_env =
+    if times <= 0 then
+      lookup_env
+    else
+      let env =
+        List.fold_left (fun building_env (symbol, constant_defining_value) ->
+            let approx =
+              constant_defining_value_approx lookup_env constant_defining_value
+            in
+            let approx = A.augment_with_symbol approx symbol in
+            E.add_symbol building_env symbol approx)
+          orig_env defs
+      in
+      loop (times-1) env
+  in
+  loop 2 init_env
+
+let simplify_constant_defining_value
+    env r symbol
+    (constant_defining_value:Flambda.constant_defining_value) =
+  let r, constant_defining_value, approx =
+    match constant_defining_value with
+    (* No simplifications are possible for [Allocated_const] or [Block]. *)
+    | Allocated_const const ->
+      r, constant_defining_value, approx_for_allocated_const const
+    | Block (tag, fields) ->
+      let fields = List.map
+          (function
+            | Flambda.Symbol sym -> E.find_symbol_exn env sym
+            | Flambda.Const cst -> simplify_const cst)
+          fields
+      in
+      r, constant_defining_value, A.value_block tag (Array.of_list fields)
+    | Set_of_closures set_of_closures ->
+      if Variable.Map.cardinal set_of_closures.free_vars <> 0 then begin
+        Misc.fatal_errorf "Set of closures bound by [Let_symbol] is not \
+                           closed: %a"
+          Flambda.print_set_of_closures set_of_closures
+      end;
+      let set_of_closures, r, _freshening =
+        simplify_set_of_closures env r set_of_closures
+      in
+      r, ((Set_of_closures set_of_closures) : Flambda.constant_defining_value),
+        R.approx r
+    | Project_closure (set_of_closures_symbol, closure_id) ->
+      (* No simplifications are necessary here. *)
+      let set_of_closures_approx =
+        E.find_symbol_exn env set_of_closures_symbol
+      in
+      let closure_approx =
+        match A.check_approx_for_set_of_closures set_of_closures_approx with
+        | Ok (_, value_set_of_closures) ->
+          let closure_id =
+            A.freshen_and_check_closure_id value_set_of_closures closure_id
+          in
+          A.value_closure value_set_of_closures closure_id
+        | Unresolved sym -> A.value_unresolved sym
+        | Unknown -> A.value_unknown Other
+        | Unknown_because_of_unresolved_value value ->
+          A.value_unknown (Unresolved_value value)
+        | Wrong ->
+          Misc.fatal_errorf "Wrong approximation for [Project_closure] \
+                             when being used as a [constant_defining_value]: %a"
+            Flambda.print_constant_defining_value constant_defining_value
+      in
+      r, constant_defining_value, closure_approx
+  in
+  let approx = A.augment_with_symbol approx symbol in
+  let r = ret r approx in
+  r, constant_defining_value, approx
+
+let rec simplify_program_body env r (program : Flambda.program_body)
+  : Flambda.program_body * R.t =
+  match program with
+  | Let_rec_symbol (defs, program) ->
+    let set_of_closures_defs, other_defs =
+      List.partition
+        (function
+          | (_, Flambda.Set_of_closures _) -> true
+          | _ -> false)
+        defs in
+    let process_defs ~lookup_env ~env r defs =
+      List.fold_left (fun (building_env, r, defs) (symbol, def) ->
+        let r, def, approx =
+          simplify_constant_defining_value lookup_env r symbol def
+        in
+        let approx = A.augment_with_symbol approx symbol in
+        let building_env = E.add_symbol building_env symbol approx in
+        (building_env, r, (symbol, def) :: defs))
+        (env, r, []) defs
+    in
+    let env, r, set_of_closures_defs =
+      let lookup_env = define_let_rec_symbol_approx env defs in
+      process_defs ~lookup_env ~env r set_of_closures_defs
+    in
+    let env, r, other_defs =
+      let lookup_env = define_let_rec_symbol_approx env other_defs in
+      process_defs ~lookup_env ~env r other_defs
+    in
+    let program, r = simplify_program_body env r program in
+    Let_rec_symbol (set_of_closures_defs @ other_defs, program), r
+  | Let_symbol (symbol, constant_defining_value, program) ->
+    let r, constant_defining_value, approx =
+      simplify_constant_defining_value env r symbol constant_defining_value
+    in
+    let approx = A.augment_with_symbol approx symbol in
+    let env = E.add_symbol env symbol approx in
+    let program, r = simplify_program_body env r program in
+    Let_symbol (symbol, constant_defining_value, program), r
+  | Initialize_symbol (symbol, tag, fields, program) ->
+    let fields, approxs, r = simplify_list env r fields in
+    let approx =
+      A.augment_with_symbol (A.value_block tag (Array.of_list approxs)) symbol
+    in
+    let env = E.add_symbol env symbol approx in
+    let program, r = simplify_program_body env r program in
+    Initialize_symbol (symbol, tag, fields, program), r
+  | Effect (expr, program) ->
+    let expr, r = simplify env r expr in
+    let program, r = simplify_program_body env r program in
+    Effect (expr, program), r
+  | End root -> End root, r
+
+let simplify_program env r (program : Flambda.program) =
+  let env, r =
+    Symbol.Set.fold (fun symbol (env, r) ->
+        let env, approx =
+          match E.find_symbol_exn env symbol with
+          | exception Not_found ->
+            let module Backend = (val (E.backend env) : Backend_intf.S) in
+            (* CR-someday mshinwell for mshinwell: Is there a reason we cannot
+               use [simplify_named_using_approx_and_env] here? *)
+            let approx = Backend.import_symbol symbol in
+            E.add_symbol env symbol approx, approx
+          | approx -> env, approx
+        in
+        env, ret r approx)
+      program.imported_symbols
+      (env, r)
+  in
+  let program_body, r = simplify_program_body env r program.program_body in
+  let program = { program with program_body; } in
+  program, r
+
+let add_predef_exns_to_environment ~env ~backend =
+  let module Backend = (val backend : Backend_intf.S) in
+  List.fold_left (fun env predef_exn ->
+      assert (Ident.is_predef predef_exn);
+      let symbol = Backend.symbol_for_global' predef_exn in
+      let name = Ident.name predef_exn in
+      let approx =
+        A.value_block Tag.object_tag
+          [| A.value_string (String.length name) (Some name);
+             A.value_unknown Other;
+          |]
+      in
+      E.add_symbol env symbol (A.augment_with_symbol approx symbol))
+    env
+    Predef.all_predef_exns
+
+let run ~never_inline ~backend ~prefixname ~round ~ppf_dump program =
+  let r = R.create () in
+  let report = !Clflags.inlining_report in
+  if never_inline then Clflags.inlining_report := false;
+  let initial_env =
+    add_predef_exns_to_environment
+      ~env:(E.create ~never_inline ~backend ~round ~ppf_dump)
+      ~backend
+  in
+  let result, r = simplify_program initial_env r program in
+  let result = Flambda_utils.introduce_needed_import_symbols result in
+  if not (Static_exception.Set.is_empty (R.used_static_exceptions r))
+  then begin
+    Misc.fatal_error (Format.asprintf "Remaining static exceptions: %a@.%a@."
+      Static_exception.Set.print (R.used_static_exceptions r)
+      Flambda.print_program result)
+  end;
+  assert (Static_exception.Set.is_empty (R.used_static_exceptions r));
+  if !Clflags.inlining_report then begin
+    let output_prefix = Printf.sprintf "%s.%d" prefixname round in
+    Inlining_stats.save_then_forget_decisions ~output_prefix
+  end;
+  Clflags.inlining_report := report;
+  result
diff --git a/middle_end/flambda/inline_and_simplify.mli b/middle_end/flambda/inline_and_simplify.mli
new file mode 100644
index 00000000..9a8e6e8b
--- /dev/null
+++ b/middle_end/flambda/inline_and_simplify.mli
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Simplification of Flambda programs combined with function inlining:
+    for the most part a beta-reduction pass.
+
+    Readers interested in the inlining strategy should read the
+    [Inlining_decision] module first.
+*)
+val run
+   : never_inline:bool
+  -> backend:(module Backend_intf.S)
+  -> prefixname:string
+  -> round:int
+  -> ppf_dump:Format.formatter
+  -> Flambda.program
+  -> Flambda.program
+
+val duplicate_function
+   : env:Inline_and_simplify_aux.Env.t
+  -> set_of_closures:Flambda.set_of_closures
+  -> fun_var:Variable.t
+  -> new_fun_var:Variable.t
+  -> Flambda.function_declaration
+    * Flambda.specialised_to Variable.Map.t  (* new specialised arguments *)
diff --git a/middle_end/flambda/inline_and_simplify_aux.ml b/middle_end/flambda/inline_and_simplify_aux.ml
new file mode 100644
index 00000000..ac29db17
--- /dev/null
+++ b/middle_end/flambda/inline_and_simplify_aux.ml
@@ -0,0 +1,738 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module Env = struct
+  type scope = Current | Outer
+
+  type t = {
+    backend : (module Backend_intf.S);
+    round : int;
+    ppf_dump : Format.formatter;
+    approx : (scope * Simple_value_approx.t) Variable.Map.t;
+    approx_mutable : Simple_value_approx.t Mutable_variable.Map.t;
+    approx_sym : Simple_value_approx.t Symbol.Map.t;
+    projections : Variable.t Projection.Map.t;
+    current_functions : Set_of_closures_origin.Set.t;
+    (* The functions currently being declared: used to avoid inlining
+       recursively *)
+    inlining_level : int;
+    (* Number of times "inline" has been called recursively *)
+    inside_branch : int;
+    freshening : Freshening.t;
+    never_inline : bool ;
+    never_inline_inside_closures : bool;
+    never_inline_outside_closures : bool;
+    unroll_counts : int Set_of_closures_origin.Map.t;
+    inlining_counts : int Closure_origin.Map.t;
+    actively_unrolling : int Set_of_closures_origin.Map.t;
+    closure_depth : int;
+    inlining_stats_closure_stack : Inlining_stats.Closure_stack.t;
+    inlined_debuginfo : Debuginfo.t;
+  }
+
+  let create ~never_inline ~backend ~round ~ppf_dump =
+    { backend;
+      round;
+      ppf_dump;
+      approx = Variable.Map.empty;
+      approx_mutable = Mutable_variable.Map.empty;
+      approx_sym = Symbol.Map.empty;
+      projections = Projection.Map.empty;
+      current_functions = Set_of_closures_origin.Set.empty;
+      inlining_level = 0;
+      inside_branch = 0;
+      freshening = Freshening.empty;
+      never_inline;
+      never_inline_inside_closures = false;
+      never_inline_outside_closures = false;
+      unroll_counts = Set_of_closures_origin.Map.empty;
+      inlining_counts = Closure_origin.Map.empty;
+      actively_unrolling = Set_of_closures_origin.Map.empty;
+      closure_depth = 0;
+      inlining_stats_closure_stack =
+        Inlining_stats.Closure_stack.create ();
+      inlined_debuginfo = Debuginfo.none;
+    }
+
+  let backend t = t.backend
+  let round t = t.round
+  let ppf_dump t = t.ppf_dump
+
+  let local env =
+    { env with
+      approx = Variable.Map.empty;
+      projections = Projection.Map.empty;
+      freshening = Freshening.empty_preserving_activation_state env.freshening;
+      inlined_debuginfo = Debuginfo.none;
+    }
+
+  let inlining_level_up env =
+    let max_level =
+      Clflags.Int_arg_helper.get ~key:(env.round) !Clflags.inline_max_depth
+    in
+    if (env.inlining_level + 1) > max_level then
+      Misc.fatal_error "Inlining level increased above maximum";
+    { env with inlining_level = env.inlining_level + 1 }
+
+  let print ppf t =
+    Format.fprintf ppf
+      "Environment maps: %a@.Projections: %a@.Freshening: %a@."
+      Variable.Set.print (Variable.Map.keys t.approx)
+      (Projection.Map.print Variable.print) t.projections
+      Freshening.print t.freshening
+
+  let mem t var = Variable.Map.mem var t.approx
+
+  let add_internal t var (approx : Simple_value_approx.t) ~scope =
+    let approx =
+      (* The semantics of this [match] are what preserve the property
+         described at the top of simple_value_approx.mli, namely that when a
+         [var] is mem on an approximation (amongst many possible [var]s),
+         it is the one with the outermost scope. *)
+      match approx.var with
+      | Some var when mem t var -> approx
+      | _ -> Simple_value_approx.augment_with_variable approx var
+    in
+    { t with approx = Variable.Map.add var (scope, approx) t.approx }
+
+  let add t var approx = add_internal t var approx ~scope:Current
+  let add_outer_scope t var approx = add_internal t var approx ~scope:Outer
+
+  let add_mutable t mut_var approx =
+    { t with approx_mutable =
+        Mutable_variable.Map.add mut_var approx t.approx_mutable;
+    }
+
+  let really_import_approx t =
+    let module Backend = (val (t.backend) : Backend_intf.S) in
+    Backend.really_import_approx
+
+  let really_import_approx_with_scope t (scope, approx) =
+    scope, really_import_approx t approx
+
+  let find_symbol_exn t symbol =
+    really_import_approx t
+      (Symbol.Map.find symbol t.approx_sym)
+
+  let find_symbol_opt t symbol =
+    try Some (really_import_approx t
+                (Symbol.Map.find symbol t.approx_sym))
+    with Not_found -> None
+
+  let find_symbol_fatal t symbol =
+    match find_symbol_exn t symbol with
+    | exception Not_found ->
+      Misc.fatal_errorf "Symbol %a is unbound.  Maybe there is a missing \
+          [Let_symbol], [Import_symbol] or similar?"
+        Symbol.print symbol
+    | approx -> approx
+
+  let find_or_load_symbol t symbol =
+    match find_symbol_exn t symbol with
+    | exception Not_found ->
+      if Compilation_unit.equal
+          (Compilation_unit.get_current_exn ())
+          (Symbol.compilation_unit symbol)
+      then
+        Misc.fatal_errorf "Symbol %a from the current compilation unit is \
+            unbound.  Maybe there is a missing [Let_symbol] or similar?"
+          Symbol.print symbol;
+      let module Backend = (val (t.backend) : Backend_intf.S) in
+      Backend.import_symbol symbol
+    | approx -> approx
+
+  let add_projection t ~projection ~bound_to =
+    { t with
+      projections =
+        Projection.Map.add projection bound_to t.projections;
+    }
+
+  let find_projection t ~projection =
+    match Projection.Map.find projection t.projections with
+    | exception Not_found -> None
+    | var -> Some var
+
+  let does_not_bind t vars =
+    not (List.exists (mem t) vars)
+
+  let does_not_freshen t vars =
+    Freshening.does_not_freshen t.freshening vars
+
+  let add_symbol t symbol approx =
+    match find_symbol_exn t symbol with
+    | exception Not_found ->
+      { t with
+        approx_sym = Symbol.Map.add symbol approx t.approx_sym;
+      }
+    | _ ->
+      Misc.fatal_errorf "Attempt to redefine symbol %a (to %a) in environment \
+          for [Inline_and_simplify]"
+        Symbol.print symbol
+        Simple_value_approx.print approx
+
+  let redefine_symbol t symbol approx =
+    match find_symbol_exn t symbol with
+    | exception Not_found ->
+      assert false
+    | _ ->
+      { t with
+        approx_sym = Symbol.Map.add symbol approx t.approx_sym;
+      }
+
+  let find_with_scope_exn t id =
+    try
+      really_import_approx_with_scope t
+        (Variable.Map.find id t.approx)
+    with Not_found ->
+      Misc.fatal_errorf "Env.find_with_scope_exn: Unbound variable \
+          %a@.%s@. Environment: %a@."
+        Variable.print id
+        (Printexc.raw_backtrace_to_string (Printexc.get_callstack max_int))
+        print t
+
+  let find_exn t id =
+    snd (find_with_scope_exn t id)
+
+  let find_mutable_exn t mut_var =
+    try Mutable_variable.Map.find mut_var t.approx_mutable
+    with Not_found ->
+      Misc.fatal_errorf "Env.find_mutable_exn: Unbound variable \
+          %a@.%s@. Environment: %a@."
+        Mutable_variable.print mut_var
+        (Printexc.raw_backtrace_to_string (Printexc.get_callstack max_int))
+        print t
+
+  let find_list_exn t vars =
+    List.map (fun var -> find_exn t var) vars
+
+  let find_opt t id =
+    try Some (really_import_approx t
+                (snd (Variable.Map.find id t.approx)))
+    with Not_found -> None
+
+  let activate_freshening t =
+    { t with freshening = Freshening.activate t.freshening }
+
+  let enter_set_of_closures_declaration t origin =
+    { t with
+      current_functions =
+        Set_of_closures_origin.Set.add origin t.current_functions; }
+
+  let inside_set_of_closures_declaration origin t =
+    Set_of_closures_origin.Set.mem origin t.current_functions
+
+  let at_toplevel t =
+    t.closure_depth = 0
+
+  let is_inside_branch env = env.inside_branch > 0
+
+  let branch_depth env = env.inside_branch
+
+  let inside_branch t =
+    { t with inside_branch = t.inside_branch + 1 }
+
+  let set_freshening t freshening  =
+    { t with freshening; }
+
+  let increase_closure_depth t =
+    let approx =
+      Variable.Map.map (fun (_scope, approx) -> Outer, approx) t.approx
+    in
+    { t with
+      approx;
+      closure_depth = t.closure_depth + 1;
+    }
+
+  let set_never_inline t =
+    if t.never_inline then t
+    else { t with never_inline = true }
+
+  let set_never_inline_inside_closures t =
+    if t.never_inline_inside_closures then t
+    else { t with never_inline_inside_closures = true }
+
+  let unset_never_inline_inside_closures t =
+    if t.never_inline_inside_closures then
+      { t with never_inline_inside_closures = false }
+    else t
+
+  let set_never_inline_outside_closures t =
+    if t.never_inline_outside_closures then t
+    else { t with never_inline_outside_closures = true }
+
+  let unset_never_inline_outside_closures t =
+    if t.never_inline_outside_closures then
+      { t with never_inline_outside_closures = false }
+    else t
+
+  let actively_unrolling t origin =
+    match Set_of_closures_origin.Map.find origin t.actively_unrolling with
+    | count -> Some count
+    | exception Not_found -> None
+
+  let start_actively_unrolling t origin i =
+    let actively_unrolling =
+      Set_of_closures_origin.Map.add origin i t.actively_unrolling
+    in
+    { t with actively_unrolling }
+
+  let continue_actively_unrolling t origin =
+    let unrolling =
+      try
+        Set_of_closures_origin.Map.find origin t.actively_unrolling
+      with Not_found ->
+        Misc.fatal_error "Unexpected actively unrolled function"
+    in
+    let actively_unrolling =
+      Set_of_closures_origin.Map.add origin (unrolling - 1) t.actively_unrolling
+    in
+    { t with actively_unrolling }
+
+  let unrolling_allowed t origin =
+    let unroll_count =
+      try
+        Set_of_closures_origin.Map.find origin t.unroll_counts
+      with Not_found ->
+        Clflags.Int_arg_helper.get
+          ~key:t.round !Clflags.inline_max_unroll
+    in
+    unroll_count > 0
+
+  let inside_unrolled_function t origin =
+    let unroll_count =
+      try
+        Set_of_closures_origin.Map.find origin t.unroll_counts
+      with Not_found ->
+        Clflags.Int_arg_helper.get
+          ~key:t.round !Clflags.inline_max_unroll
+    in
+    let unroll_counts =
+      Set_of_closures_origin.Map.add
+        origin (unroll_count - 1) t.unroll_counts
+    in
+    { t with unroll_counts }
+
+  let inlining_allowed t id =
+    let inlining_count =
+      try
+        Closure_origin.Map.find id t.inlining_counts
+      with Not_found ->
+        max 1 (Clflags.Int_arg_helper.get
+                 ~key:t.round !Clflags.inline_max_unroll)
+    in
+    inlining_count > 0
+
+  let inside_inlined_function t id =
+    let inlining_count =
+      try
+        Closure_origin.Map.find id t.inlining_counts
+      with Not_found ->
+        max 1 (Clflags.Int_arg_helper.get
+                 ~key:t.round !Clflags.inline_max_unroll)
+    in
+    let inlining_counts =
+      Closure_origin.Map.add id (inlining_count - 1) t.inlining_counts
+    in
+    { t with inlining_counts }
+
+  let inlining_level t = t.inlining_level
+  let freshening t = t.freshening
+  let never_inline t = t.never_inline || t.never_inline_outside_closures
+
+  let note_entering_closure t ~closure_id ~dbg =
+    if t.never_inline then t
+    else
+      { t with
+        inlining_stats_closure_stack =
+          Inlining_stats.Closure_stack.note_entering_closure
+            t.inlining_stats_closure_stack ~closure_id ~dbg;
+      }
+
+  let note_entering_call t ~closure_id ~dbg =
+    if t.never_inline then t
+    else
+      { t with
+        inlining_stats_closure_stack =
+          Inlining_stats.Closure_stack.note_entering_call
+            t.inlining_stats_closure_stack ~closure_id ~dbg;
+      }
+
+  let note_entering_inlined t =
+    if t.never_inline then t
+    else
+      { t with
+        inlining_stats_closure_stack =
+          Inlining_stats.Closure_stack.note_entering_inlined
+            t.inlining_stats_closure_stack;
+      }
+
+  let note_entering_specialised t ~closure_ids =
+    if t.never_inline then t
+    else
+      { t with
+        inlining_stats_closure_stack =
+          Inlining_stats.Closure_stack.note_entering_specialised
+            t.inlining_stats_closure_stack ~closure_ids;
+      }
+
+  let enter_closure t ~closure_id ~inline_inside ~dbg ~f =
+    let t =
+      if inline_inside && not t.never_inline_inside_closures then t
+      else set_never_inline t
+    in
+    let t = unset_never_inline_outside_closures t in
+    f (note_entering_closure t ~closure_id ~dbg)
+
+  let record_decision t decision =
+    Inlining_stats.record_decision decision
+      ~closure_stack:t.inlining_stats_closure_stack
+
+  let set_inline_debuginfo t ~dbg =
+    { t with inlined_debuginfo = dbg }
+
+  let add_inlined_debuginfo t ~dbg =
+    Debuginfo.inline t.inlined_debuginfo dbg
+end
+
+let initial_inlining_threshold ~round : Inlining_cost.Threshold.t =
+  let unscaled =
+    Clflags.Float_arg_helper.get ~key:round !Clflags.inline_threshold
+  in
+  (* CR-soon pchambart: Add a warning if this is too big
+     mshinwell: later *)
+  Can_inline_if_no_larger_than
+    (int_of_float
+      (unscaled *. float_of_int Inlining_cost.scale_inline_threshold_by))
+
+let initial_inlining_toplevel_threshold ~round : Inlining_cost.Threshold.t =
+  let ordinary_threshold =
+    Clflags.Float_arg_helper.get ~key:round !Clflags.inline_threshold
+  in
+  let toplevel_threshold =
+    Clflags.Int_arg_helper.get ~key:round !Clflags.inline_toplevel_threshold
+  in
+  let unscaled =
+    (int_of_float ordinary_threshold) + toplevel_threshold
+  in
+  (* CR-soon pchambart: Add a warning if this is too big
+     mshinwell: later *)
+  Can_inline_if_no_larger_than
+    (unscaled * Inlining_cost.scale_inline_threshold_by)
+
+module Result = struct
+  type t =
+    { approx : Simple_value_approx.t;
+      used_static_exceptions : Static_exception.Set.t;
+      inlining_threshold : Inlining_cost.Threshold.t option;
+      benefit : Inlining_cost.Benefit.t;
+      num_direct_applications : int;
+    }
+
+  let create () =
+    { approx = Simple_value_approx.value_unknown Other;
+      used_static_exceptions = Static_exception.Set.empty;
+      inlining_threshold = None;
+      benefit = Inlining_cost.Benefit.zero;
+      num_direct_applications = 0;
+    }
+
+  let approx t = t.approx
+  let set_approx t approx = { t with approx }
+
+  let meet_approx t env approx =
+    let really_import_approx = Env.really_import_approx env in
+    let meet =
+      Simple_value_approx.meet ~really_import_approx t.approx approx
+    in
+    set_approx t meet
+
+  let use_static_exception t i =
+    { t with
+      used_static_exceptions =
+        Static_exception.Set.add i t.used_static_exceptions;
+    }
+
+  let used_static_exceptions t = t.used_static_exceptions
+
+  let exit_scope_catch t i =
+    { t with
+      used_static_exceptions =
+        Static_exception.Set.remove i t.used_static_exceptions;
+    }
+
+  let map_benefit t f =
+    { t with benefit = f t.benefit }
+
+  let add_benefit t b =
+    { t with benefit = Inlining_cost.Benefit.(+) t.benefit b }
+
+  let benefit t = t.benefit
+
+  let reset_benefit t =
+    { t with benefit = Inlining_cost.Benefit.zero; }
+
+  let set_inlining_threshold t inlining_threshold =
+    { t with inlining_threshold }
+
+  let add_inlining_threshold t j =
+    match t.inlining_threshold with
+    | None -> t
+    | Some i ->
+      let inlining_threshold = Some (Inlining_cost.Threshold.add i j) in
+      { t with inlining_threshold }
+
+  let sub_inlining_threshold t j =
+    match t.inlining_threshold with
+    | None -> t
+    | Some i ->
+      let inlining_threshold = Some (Inlining_cost.Threshold.sub i j) in
+      { t with inlining_threshold }
+
+  let inlining_threshold t = t.inlining_threshold
+
+  let seen_direct_application t =
+    { t with num_direct_applications = t.num_direct_applications + 1; }
+
+  let num_direct_applications t =
+    t.num_direct_applications
+end
+
+module A = Simple_value_approx
+module E = Env
+
+let keep_body_check ~is_classic_mode ~recursive =
+  if not is_classic_mode then begin
+      fun _ _ -> true
+  end else begin
+    let can_inline_non_rec_function (fun_decl : Flambda.function_declaration) =
+      (* In classic-inlining mode, the inlining decision is taken at
+         definition site (here). If the function is small enough
+         (below the -inline threshold) it will always be inlined.
+
+         Closure gives a bonus of [8] to optional arguments. In classic
+         mode, however, we would inline functions with the "*opt*" argument
+         in all cases, as it is a stub. (This is ensured by
+         [middle_end/closure_conversion.ml]).
+      *)
+      let inlining_threshold = initial_inlining_threshold ~round:0 in
+      let bonus = Flambda_utils.function_arity fun_decl in
+      Inlining_cost.can_inline fun_decl.body inlining_threshold ~bonus
+    in
+    fun (var : Variable.t) (fun_decl : Flambda.function_declaration) ->
+      if fun_decl.stub then begin
+        true
+      end else if Variable.Set.mem var (Lazy.force recursive) then begin
+        false
+      end else begin
+        match fun_decl.inline with
+        | Default_inline -> can_inline_non_rec_function fun_decl
+        | Unroll factor -> factor > 0
+        | Always_inline | Hint_inline -> true
+        | Never_inline -> false
+      end
+    end
+
+let prepare_to_simplify_set_of_closures ~env
+      ~(set_of_closures : Flambda.set_of_closures)
+      ~function_decls ~freshen
+      ~(only_for_function_decl : Flambda.function_declaration option) =
+  let free_vars =
+    Variable.Map.map (fun (external_var : Flambda.specialised_to) ->
+        let var =
+          let var =
+            Freshening.apply_variable (E.freshening env) external_var.var
+          in
+          match
+            A.simplify_var_to_var_using_env (E.find_exn env var)
+              ~is_present_in_env:(fun var -> E.mem env var)
+          with
+          | None -> var
+          | Some var -> var
+        in
+        let approx = E.find_exn env var in
+        (* The projections are freshened below in one step, once we know
+           the closure freshening substitution. *)
+        let projection = external_var.projection in
+        ({ var; projection; } : Flambda.specialised_to), approx)
+      set_of_closures.free_vars
+  in
+  let specialised_args =
+    set_of_closures.specialised_args |> Variable.Map.filter_map
+      (fun param (spec_to : Flambda.specialised_to) ->
+        let keep =
+          match only_for_function_decl with
+          | None -> true
+          | Some function_decl ->
+            Variable.Set.mem param (Parameter.Set.vars function_decl.params)
+        in
+        if not keep then None
+        else
+          let external_var = spec_to.var in
+          let var =
+            Freshening.apply_variable (E.freshening env) external_var
+          in
+          let var =
+            match
+              A.simplify_var_to_var_using_env (E.find_exn env var)
+                ~is_present_in_env:(fun var -> E.mem env var)
+            with
+            | None -> var
+            | Some var -> var
+          in
+          let projection = spec_to.projection in
+          Some ({ var; projection; } : Flambda.specialised_to))
+  in
+  let environment_before_cleaning = env in
+  (* [E.local] helps us to catch bugs whereby variables escape their scope. *)
+  let env = E.local env in
+  let free_vars, function_decls, sb, freshening =
+    Freshening.apply_function_decls_and_free_vars (E.freshening env) free_vars
+      function_decls ~only_freshen_parameters:(not freshen)
+  in
+  let env = E.set_freshening env sb in
+  let free_vars =
+    Freshening.freshen_projection_relation' free_vars
+      ~freshening:(E.freshening env)
+      ~closure_freshening:freshening
+  in
+  let specialised_args =
+    let specialised_args =
+      Variable.Map.map_keys (Freshening.apply_variable (E.freshening env))
+        specialised_args
+    in
+    Freshening.freshen_projection_relation specialised_args
+      ~freshening:(E.freshening env)
+      ~closure_freshening:freshening
+  in
+  let parameter_approximations =
+    (* Approximations of parameters that are known to always hold the same
+       argument throughout the body of the function. *)
+    Variable.Map.map_keys (Freshening.apply_variable (E.freshening env))
+      (Variable.Map.mapi (fun _id' (spec_to : Flambda.specialised_to) ->
+          E.find_exn environment_before_cleaning spec_to.var)
+        specialised_args)
+  in
+  let direct_call_surrogates =
+    Variable.Map.fold (fun existing surrogate surrogates ->
+        let existing =
+          Freshening.Project_var.apply_closure_id freshening
+            (Closure_id.wrap existing)
+        in
+        let surrogate =
+          Freshening.Project_var.apply_closure_id freshening
+            (Closure_id.wrap surrogate)
+        in
+        assert (not (Closure_id.Map.mem existing surrogates));
+        Closure_id.Map.add existing surrogate surrogates)
+      set_of_closures.direct_call_surrogates
+      Closure_id.Map.empty
+  in
+  let env =
+    E.enter_set_of_closures_declaration env
+      function_decls.set_of_closures_origin
+  in
+  (* we use the previous closure for evaluating the functions *)
+  let internal_value_set_of_closures =
+    let bound_vars =
+      Variable.Map.fold (fun id (_, desc) map ->
+          Var_within_closure.Map.add (Var_within_closure.wrap id) desc map)
+        free_vars Var_within_closure.Map.empty
+    in
+    let free_vars = Variable.Map.map fst free_vars in
+    let invariant_params = lazy Variable.Map.empty in
+    let recursive = lazy (Variable.Map.keys function_decls.funs) in
+    let is_classic_mode = function_decls.is_classic_mode in
+    let keep_body = keep_body_check ~is_classic_mode ~recursive in
+    let function_decls =
+      A.function_declarations_approx ~keep_body function_decls
+    in
+    A.create_value_set_of_closures ~function_decls ~bound_vars
+      ~free_vars ~invariant_params ~recursive ~specialised_args
+      ~freshening ~direct_call_surrogates
+  in
+  (* Populate the environment with the approximation of each closure.
+     This part of the environment is shared between all of the closures in
+     the set of closures. *)
+  let set_of_closures_env =
+    Variable.Map.fold (fun closure _ env ->
+        let approx =
+          A.value_closure ~closure_var:closure internal_value_set_of_closures
+            (Closure_id.wrap closure)
+        in
+        E.add env closure approx
+      )
+      function_decls.funs env
+  in
+  free_vars, specialised_args, function_decls, parameter_approximations,
+    internal_value_set_of_closures, set_of_closures_env
+
+(* This adds only the minimal set of approximations to the closures.
+   It is not strictly necessary to have this restriction, but it helps
+   to catch potential substitution bugs. *)
+let populate_closure_approximations
+      ~(function_decl : Flambda.function_declaration)
+      ~(free_vars : (_ * A.t) Variable.Map.t)
+      ~(parameter_approximations : A.t Variable.Map.t)
+      ~set_of_closures_env =
+  (* Add approximations of free variables *)
+  let env =
+    Variable.Map.fold (fun id (_, desc) env ->
+        E.add_outer_scope env id desc)
+      free_vars set_of_closures_env
+  in
+  (* Add known approximations of function parameters *)
+  let env =
+    List.fold_left (fun env id ->
+        let approx =
+          try Variable.Map.find id parameter_approximations
+          with Not_found -> (A.value_unknown Other)
+        in
+        E.add env id approx)
+      env (Parameter.List.vars function_decl.params)
+  in
+  env
+
+let prepare_to_simplify_closure ~(function_decl : Flambda.function_declaration)
+      ~free_vars ~specialised_args ~parameter_approximations
+      ~set_of_closures_env =
+  let closure_env =
+    populate_closure_approximations ~function_decl ~free_vars
+      ~parameter_approximations ~set_of_closures_env
+  in
+  (* Add definitions of known projections to the environment. *)
+  let add_projections ~closure_env ~which_variables ~map =
+    Variable.Map.fold (fun inner_var spec_arg env ->
+        let (spec_arg : Flambda.specialised_to) = map spec_arg in
+        match spec_arg.projection with
+        | None -> env
+        | Some projection ->
+          let from = Projection.projecting_from projection in
+          if Variable.Set.mem from function_decl.free_variables then
+            E.add_projection env ~projection ~bound_to:inner_var
+          else
+            env)
+      which_variables
+      closure_env
+  in
+  let closure_env =
+    add_projections ~closure_env ~which_variables:specialised_args
+      ~map:(fun spec_to -> spec_to)
+  in
+  add_projections ~closure_env ~which_variables:free_vars
+    ~map:(fun (spec_to, _approx) -> spec_to)
diff --git a/middle_end/flambda/inline_and_simplify_aux.mli b/middle_end/flambda/inline_and_simplify_aux.mli
new file mode 100644
index 00000000..79d84a31
--- /dev/null
+++ b/middle_end/flambda/inline_and_simplify_aux.mli
@@ -0,0 +1,368 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Environments and result structures used during inlining and
+    simplification.  (See inline_and_simplify.ml.) *)
+
+module Env : sig
+  (** Environments follow the lexical scopes of the program. *)
+  type t
+
+  (** Create a new environment.  If [never_inline] is true then the returned
+      environment will prevent [Inline_and_simplify] from inlining.  The
+      [backend] parameter is used for passing information about the compiler
+      backend being used.
+      Newly-created environments have inactive [Freshening]s (see below) and do
+      not initially hold any approximation information. *)
+  val create
+     : never_inline:bool
+    -> backend:(module Backend_intf.S)
+    -> round:int
+    -> ppf_dump:Format.formatter
+    -> t
+
+  (** Obtain the first-class module that gives information about the
+      compiler backend being used for compilation. *)
+  val backend : t -> (module Backend_intf.S)
+
+  (** Obtain the really_import_approx function from the backend module. *)
+  val really_import_approx
+     : t
+    -> (Simple_value_approx.t -> Simple_value_approx.t)
+
+  (** Which simplification round we are currently in. *)
+  val round : t -> int
+
+  (** Where to print intermediate asts and similar debug information *)
+  val ppf_dump : t -> Format.formatter
+
+  (** Add the approximation of a variable---that is to say, some knowledge
+      about the value(s) the variable may take on at runtime---to the
+      environment. *)
+  val add : t -> Variable.t -> Simple_value_approx.t -> t
+
+  val add_outer_scope : t -> Variable.t -> Simple_value_approx.t -> t
+
+  (** Like [add], but for mutable variables. *)
+  val add_mutable : t -> Mutable_variable.t -> Simple_value_approx.t -> t
+
+  (** Find the approximation of a given variable, raising a fatal error if
+      the environment does not know about the variable.  Use [find_opt]
+      instead if you need to catch the failure case. *)
+  val find_exn : t -> Variable.t -> Simple_value_approx.t
+
+  (** Like [find_exn], but for mutable variables. *)
+  val find_mutable_exn : t -> Mutable_variable.t -> Simple_value_approx.t
+
+  type scope = Current | Outer
+
+  val find_with_scope_exn : t -> Variable.t -> scope * Simple_value_approx.t
+
+  (** Like [find_exn], but intended for use where the "not present in
+      environment" case is to be handled by the caller. *)
+  val find_opt : t -> Variable.t -> Simple_value_approx.t option
+
+  (** Like [find_exn], but for a list of variables. *)
+  val find_list_exn : t -> Variable.t list -> Simple_value_approx.t list
+
+  val does_not_bind : t -> Variable.t list -> bool
+
+  val does_not_freshen : t -> Variable.t list -> bool
+
+  val add_symbol : t -> Symbol.t -> Simple_value_approx.t -> t
+  val redefine_symbol : t -> Symbol.t -> Simple_value_approx.t -> t
+  val find_symbol_exn : t -> Symbol.t -> Simple_value_approx.t
+  val find_symbol_opt : t -> Symbol.t -> Simple_value_approx.t option
+  val find_symbol_fatal : t -> Symbol.t -> Simple_value_approx.t
+
+  (* Like [find_symbol_exn], but load the symbol approximation using
+     the backend if not available in the environment. *)
+  val find_or_load_symbol : t -> Symbol.t -> Simple_value_approx.t
+
+  (** Note that the given [bound_to] holds the given [projection]. *)
+  val add_projection
+     : t
+    -> projection:Projection.t
+    -> bound_to:Variable.t
+    -> t
+
+  (** Determine if the environment knows about a variable that is bound
+      to the given [projection]. *)
+  val find_projection
+     : t
+    -> projection:Projection.t
+    -> Variable.t option
+
+  (** Whether the environment has an approximation for the given variable. *)
+  val mem : t -> Variable.t -> bool
+
+  (** Return the freshening that should be applied to variables when
+      rewriting code (in [Inline_and_simplify], etc.) using the given
+      environment. *)
+  val freshening : t -> Freshening.t
+
+  (** Set the freshening that should be used as per [freshening], above. *)
+  val set_freshening : t -> Freshening.t -> t
+
+  (** Causes every bound variable in code rewritten during inlining and
+      simplification, using the given environment, to be freshened.  This is
+      used when descending into subexpressions substituted into existing
+      expressions. *)
+  val activate_freshening : t -> t
+
+  (** Erase all variable approximation information and freshening information
+      from the given environment.  However, the freshening activation state
+      is preserved.  This function is used when rewriting inside a function
+      declaration, to avoid (due to a compiler bug) accidental use of
+      variables from outer scopes that are not accessible. *)
+  val local : t -> t
+
+  (** Determine whether the inliner is currently inside a function body from
+      the given set of closures.  This is used to detect whether a given
+      function call refers to a function which exists somewhere on the current
+      inlining stack. *)
+  val inside_set_of_closures_declaration : Set_of_closures_origin.t -> t -> bool
+
+  (** Not inside a closure declaration.
+      Toplevel code is the one evaluated when the compilation unit is
+      loaded *)
+  val at_toplevel : t -> bool
+
+  val is_inside_branch : t -> bool
+  val branch_depth : t -> int
+  val inside_branch : t -> t
+
+  val increase_closure_depth : t -> t
+
+  (** Mark that call sites contained within code rewritten using the given
+      environment should never be replaced by inlined (or unrolled) versions
+      of the callee(s). *)
+  val set_never_inline : t -> t
+
+  (** Equivalent to [set_never_inline] but only applies to code inside
+      a set of closures. *)
+  val set_never_inline_inside_closures : t -> t
+
+  (** Unset the restriction from [set_never_inline_inside_closures] *)
+  val unset_never_inline_inside_closures : t -> t
+
+  (** Equivalent to [set_never_inline] but does not apply to code inside
+      a set of closures. *)
+  val set_never_inline_outside_closures : t -> t
+
+  (** Unset the restriction from [set_never_inline_outside_closures] *)
+  val unset_never_inline_outside_closures : t -> t
+
+  (** Return whether [set_never_inline] is currently in effect on the given
+      environment. *)
+  val never_inline : t -> bool
+
+  val inlining_level : t -> int
+
+  (** Mark that this environment is used to rewrite code for inlining. This is
+      used by the inlining heuristics to decide whether to continue.
+      Unconditionally inlined does not take this into account. *)
+  val inlining_level_up : t -> t
+
+  (** Whether we are actively unrolling a given function. *)
+  val actively_unrolling : t -> Set_of_closures_origin.t -> int option
+
+  (** Start actively unrolling a given function [n] times. *)
+  val start_actively_unrolling : t -> Set_of_closures_origin.t -> int -> t
+
+  (** Unroll a function currently actively being unrolled. *)
+  val continue_actively_unrolling : t -> Set_of_closures_origin.t -> t
+
+  (** Whether it is permissible to unroll a call to a recursive function
+      in the given environment. *)
+  val unrolling_allowed : t -> Set_of_closures_origin.t -> bool
+
+  (** Whether the given environment is currently being used to rewrite the
+      body of an unrolled recursive function. *)
+  val inside_unrolled_function : t -> Set_of_closures_origin.t -> t
+
+  (** Whether it is permissible to inline a call to a function in the given
+      environment. *)
+  val inlining_allowed : t -> Closure_origin.t -> bool
+
+  (** Whether the given environment is currently being used to rewrite the
+      body of an inlined function. *)
+  val inside_inlined_function : t -> Closure_origin.t -> t
+
+  (** If collecting inlining statistics, record that the inliner is about to
+      descend into [closure_id].  This information enables us to produce a
+      stack of closures that form a kind of context around an inlining
+      decision point. *)
+  val note_entering_closure
+     : t
+    -> closure_id:Closure_id.t
+    -> dbg:Debuginfo.t
+    -> t
+
+   (** If collecting inlining statistics, record that the inliner is about to
+       descend into a call to [closure_id].  This information enables us to
+       produce a stack of closures that form a kind of context around an
+       inlining decision point. *)
+  val note_entering_call
+     : t
+    -> closure_id:Closure_id.t
+    -> dbg:Debuginfo.t
+    -> t
+
+   (** If collecting inlining statistics, record that the inliner is about to
+       descend into an inlined function call.  This requires that the inliner
+       has already entered the call with [note_entering_call]. *)
+  val note_entering_inlined : t -> t
+
+   (** If collecting inlining statistics, record that the inliner is about to
+       descend into a specialised function definition.  This requires that the
+       inliner has already entered the call with [note_entering_call]. *)
+  val note_entering_specialised : t -> closure_ids:Closure_id.Set.t -> t
+
+  (** Update a given environment to record that the inliner is about to
+      descend into [closure_id] and pass the resulting environment to [f].
+      If [inline_inside] is [false] then the environment passed to [f] will be
+      marked as [never_inline] (see above). *)
+  val enter_closure
+     : t
+    -> closure_id:Closure_id.t
+    -> inline_inside:bool
+    -> dbg:Debuginfo.t
+    -> f:(t -> 'a)
+    -> 'a
+
+   (** If collecting inlining statistics, record an inlining decision for the
+       call at the top of the closure stack stored inside the given
+       environment. *)
+  val record_decision
+     : t
+    -> Inlining_stats_types.Decision.t
+    -> unit
+
+  (** Print a human-readable version of the given environment. *)
+  val print : Format.formatter -> t -> unit
+
+  (** The environment stores the call-site being inlined to produce
+      precise location information. This function sets the current
+      call-site being inlined.  *)
+  val set_inline_debuginfo : t -> dbg:Debuginfo.t -> t
+
+  (** Appends the locations of inlined call-sites to the [~dbg] argument *)
+  val add_inlined_debuginfo : t -> dbg:Debuginfo.t -> Debuginfo.t
+end
+
+module Result : sig
+  (** Result structures approximately follow the evaluation order of the
+      program.  They are returned by the simplification algorithm acting on
+      an Flambda subexpression. *)
+  type t
+
+  val create : unit -> t
+
+  (** The approximation of the subexpression that has just been
+      simplified. *)
+  val approx : t -> Simple_value_approx.t
+
+  (** Set the approximation of the subexpression that has just been
+      simplified.  Typically used just before returning from a case of the
+      simplification algorithm. *)
+  val set_approx : t -> Simple_value_approx.t -> t
+
+  (** Set the approximation of the subexpression to the meet of the
+      current return approximation and the provided one. Typically
+      used just before returning from a branch case of the
+      simplification algorithm. *)
+  val meet_approx : t -> Env.t -> Simple_value_approx.t -> t
+
+  (** All static exceptions for which [use_staticfail] has been called on
+      the given result structure. *)
+  val used_static_exceptions : t -> Static_exception.Set.t
+
+  (** Mark that the given static exception has been used. *)
+  val use_static_exception : t -> Static_exception.t -> t
+
+  (** Mark that we are moving up out of the scope of a static-catch block
+      that catches the given static exception identifier.  This has the effect
+      of removing the identifier from the [used_staticfail] set. *)
+  val exit_scope_catch : t -> Static_exception.t -> t
+
+  (** The benefit to be gained by inlining the subexpression whose
+      simplification yielded the given result structure. *)
+  val benefit : t -> Inlining_cost.Benefit.t
+
+  (** Apply a transformation to the inlining benefit stored within the
+      given result structure. *)
+  val map_benefit
+    : t
+    -> (Inlining_cost.Benefit.t -> Inlining_cost.Benefit.t)
+    -> t
+
+  (** Add some benefit to the inlining benefit stored within the
+      given result structure. *)
+  val add_benefit : t -> Inlining_cost.Benefit.t -> t
+
+  (** Set the benefit of inlining the subexpression corresponding to the
+      given result structure to zero. *)
+  val reset_benefit : t -> t
+
+  val set_inlining_threshold :
+    t -> Inlining_cost.Threshold.t option -> t
+  val add_inlining_threshold :
+    t -> Inlining_cost.Threshold.t -> t
+  val sub_inlining_threshold :
+    t -> Inlining_cost.Threshold.t -> t
+  val inlining_threshold : t -> Inlining_cost.Threshold.t option
+
+  val seen_direct_application : t -> t
+  val num_direct_applications : t -> int
+end
+
+(** Command line argument -inline *)
+val initial_inlining_threshold : round:int -> Inlining_cost.Threshold.t
+
+(** Command line argument -inline-toplevel *)
+val initial_inlining_toplevel_threshold
+  : round:int -> Inlining_cost.Threshold.t
+
+val prepare_to_simplify_set_of_closures
+   : env:Env.t
+  -> set_of_closures:Flambda.set_of_closures
+  -> function_decls:Flambda.function_declarations
+  -> freshen:bool
+  -> only_for_function_decl:Flambda.function_declaration option
+  -> (Flambda.specialised_to * Simple_value_approx.t) Variable.Map.t  (* fvs *)
+    * Flambda.specialised_to Variable.Map.t         (* specialised arguments *)
+    * Flambda.function_declarations
+    * Simple_value_approx.t Variable.Map.t       (* parameter approximations *)
+    * Simple_value_approx.value_set_of_closures
+    * Env.t
+
+val prepare_to_simplify_closure
+   : function_decl:Flambda.function_declaration
+  -> free_vars:(Flambda.specialised_to * Simple_value_approx.t) Variable.Map.t
+  -> specialised_args:Flambda.specialised_to Variable.Map.t
+  -> parameter_approximations:Simple_value_approx.t Variable.Map.t
+  -> set_of_closures_env:Env.t
+  -> Env.t
+
+val keep_body_check
+   : is_classic_mode:bool
+  -> recursive:Variable.Set.t Lazy.t
+  -> Variable.t
+  -> Flambda.function_declaration
+  -> bool
diff --git a/middle_end/flambda/inlining_cost.ml b/middle_end/flambda/inlining_cost.ml
new file mode 100644
index 00000000..3ca1d222
--- /dev/null
+++ b/middle_end/flambda/inlining_cost.ml
@@ -0,0 +1,700 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+(* Simple approximation of the space cost of a primitive. *)
+
+let prim_size (prim : Clambda_primitives.primitive) args =
+  match prim with
+  | Pmakeblock _ -> 5 + List.length args
+  | Pfield _ -> 1
+  | Psetfield (_, isptr, init) ->
+    begin match init with
+    | Root_initialization -> 1  (* never causes a write barrier hit *)
+    | Assignment | Heap_initialization ->
+      match isptr with
+      | Pointer -> 4
+      | Immediate -> 1
+    end
+  | Pfloatfield _ -> 1
+  | Psetfloatfield _ -> 1
+  | Pduprecord _ -> 10 + List.length args
+  | Pccall p -> (if p.Primitive.prim_alloc then 10 else 4) + List.length args
+  | Praise _ -> 4
+  | Pstringlength -> 5
+  | Pbyteslength -> 5
+  | Pstringrefs -> 6
+  | Pbytesrefs | Pbytessets -> 6
+  | Pmakearray _ -> 5 + List.length args
+  | Parraylength Pgenarray -> 6
+  | Parraylength _ -> 2
+  | Parrayrefu Pgenarray -> 12
+  | Parrayrefu _ -> 2
+  | Parraysetu Pgenarray -> 16
+  | Parraysetu _ -> 4
+  | Parrayrefs Pgenarray -> 18
+  | Parrayrefs _ -> 8
+  | Parraysets Pgenarray -> 22
+  | Parraysets _ -> 10
+  | Pbigarrayref (_, ndims, _, _) -> 4 + ndims * 6
+  | Pbigarrayset (_, ndims, _, _) -> 4 + ndims * 6
+  | Psequand | Psequor ->
+    Misc.fatal_error "Psequand and Psequor are not allowed in Prim \
+        expressions; translate out instead (cf. closure_conversion.ml)"
+  (* CR-soon mshinwell: This match must be made exhaustive.
+     mshinwell: Let's do this when we have the new size computation. *)
+  | _ -> 2 (* arithmetic and comparisons *)
+
+(* Simple approximation of the space cost of an Flambda expression. *)
+
+(* CR-soon mshinwell: Investigate revised size numbers. *)
+
+let direct_call_size = 4
+let project_size = 1
+
+let lambda_smaller' lam ~than:threshold =
+  let size = ref 0 in
+  let rec lambda_size (lam : Flambda.t) =
+    if !size > threshold then raise Exit;
+    match lam with
+    | Var _ -> ()
+    | Apply ({ func = _; args = _; kind = direct }) ->
+      let call_cost =
+        match direct with Indirect -> 6 | Direct _ -> direct_call_size
+      in
+      size := !size + call_cost
+    | Assign _ -> incr size
+    | Send _ -> size := !size + 8
+    | Proved_unreachable -> ()
+    | Let { defining_expr; body; _ } ->
+      lambda_named_size defining_expr;
+      lambda_size body
+    | Let_mutable { body } -> lambda_size body
+    | Let_rec (bindings, body) ->
+      List.iter (fun (_, lam) -> lambda_named_size lam) bindings;
+      lambda_size body
+    | Switch (_, sw) ->
+      let aux = function _::_::_ -> size := !size + 5 | _ -> () in
+      aux sw.consts; aux sw.blocks;
+      List.iter (fun (_, lam) -> lambda_size lam) sw.consts;
+      List.iter (fun (_, lam) -> lambda_size lam) sw.blocks;
+      Option.iter lambda_size sw.failaction
+    | String_switch (_, sw, def) ->
+      List.iter (fun (_, lam) ->
+          size := !size + 2;
+          lambda_size lam)
+        sw;
+      Option.iter lambda_size def
+    | Static_raise _ -> ()
+    | Static_catch (_, _, body, handler) ->
+      incr size; lambda_size body; lambda_size handler
+    | Try_with (body, _, handler) ->
+      size := !size + 8; lambda_size body; lambda_size handler
+    | If_then_else (_, ifso, ifnot) ->
+      size := !size + 2;
+      lambda_size ifso; lambda_size ifnot
+    | While (cond, body) ->
+      size := !size + 2; lambda_size cond; lambda_size body
+    | For { body; _ } ->
+      size := !size + 4; lambda_size body
+  and lambda_named_size (named : Flambda.named) =
+    if !size > threshold then raise Exit;
+    match named with
+    | Symbol _ | Read_mutable _ -> ()
+    | Const _ | Allocated_const _ -> incr size
+    | Read_symbol_field _ -> incr size
+    | Set_of_closures ({ function_decls = ffuns }) ->
+      Variable.Map.iter (fun _ (ffun : Flambda.function_declaration) ->
+          lambda_size ffun.body)
+        ffuns.funs
+    | Project_closure _ | Project_var _ ->
+      size := !size + project_size
+    | Move_within_set_of_closures _ ->
+      incr size
+    | Prim (prim, args, _) ->
+      size := !size + prim_size prim args
+    | Expr expr -> lambda_size expr
+  in
+  try
+    lambda_size lam;
+    if !size <= threshold then Some !size
+    else None
+  with Exit ->
+    None
+
+let lambda_size lam =
+  match lambda_smaller' lam ~than:max_int with
+  | Some size ->
+      size
+  | None ->
+      (* There is no way that an expression of size max_int could fit in
+         memory. *)
+      assert false
+
+module Threshold = struct
+
+  type t =
+    | Never_inline
+    | Can_inline_if_no_larger_than of int
+
+  let add t1 t2 =
+    match t1, t2 with
+    | Never_inline, t -> t
+    | t, Never_inline -> t
+    | Can_inline_if_no_larger_than i1, Can_inline_if_no_larger_than i2 ->
+        Can_inline_if_no_larger_than (i1 + i2)
+
+  let sub t1 t2 =
+    match t1, t2 with
+    | Never_inline, _ -> Never_inline
+    | t, Never_inline -> t
+    | Can_inline_if_no_larger_than i1, Can_inline_if_no_larger_than i2 ->
+        if i1 > i2 then Can_inline_if_no_larger_than (i1 - i2)
+        else Never_inline
+
+  let min t1 t2 =
+    match t1, t2 with
+    | Never_inline, _ -> Never_inline
+    | _, Never_inline -> Never_inline
+    | Can_inline_if_no_larger_than i1, Can_inline_if_no_larger_than i2 ->
+      Can_inline_if_no_larger_than (min i1 i2)
+
+  let equal t1 t2 =
+    match t1, t2 with
+    | Never_inline, Never_inline -> true
+    | Can_inline_if_no_larger_than i1, Can_inline_if_no_larger_than i2 ->
+      i1 = i2
+    | (Never_inline | Can_inline_if_no_larger_than _), _ ->
+      false
+
+end
+
+let can_try_inlining lam inlining_threshold ~number_of_arguments
+      ~size_from_approximation =
+  match inlining_threshold with
+  | Threshold.Never_inline -> Threshold.Never_inline
+  | Threshold.Can_inline_if_no_larger_than inlining_threshold ->
+    let bonus =
+      (* removing a call will reduce the size by at least the number
+         of arguments *)
+      number_of_arguments
+    in
+    let size =
+      let than = inlining_threshold + bonus in
+      match size_from_approximation with
+      | Some size -> if size <= than then Some size else None
+      | None -> lambda_smaller' lam ~than
+    in
+    match size with
+    | None -> Threshold.Never_inline
+    | Some size ->
+      Threshold.Can_inline_if_no_larger_than
+        (inlining_threshold - size + bonus)
+
+let lambda_smaller lam ~than =
+  match lambda_smaller' lam ~than with
+  | Some _ -> true
+  | None -> false
+
+let can_inline lam inlining_threshold ~bonus =
+  match inlining_threshold with
+  | Threshold.Never_inline -> false
+  | Threshold.Can_inline_if_no_larger_than inlining_threshold ->
+     lambda_smaller
+       lam
+       ~than:(inlining_threshold + bonus)
+
+let cost (flag : Clflags.Int_arg_helper.parsed) ~round =
+  Clflags.Int_arg_helper.get ~key:round flag
+
+let benefit_factor = 1
+
+module Benefit = struct
+  type t = {
+    remove_call : int;
+    remove_alloc : int;
+    remove_prim : int;
+    remove_branch : int;
+    (* CR-someday pchambart: branch_benefit : t list; *)
+    direct_call_of_indirect : int;
+    requested_inline : int;
+    (* Benefit to compensate the size of functions marked for inlining *)
+  }
+
+  let zero = {
+    remove_call = 0;
+    remove_alloc = 0;
+    remove_prim = 0;
+    remove_branch = 0;
+    direct_call_of_indirect = 0;
+    requested_inline = 0;
+  }
+
+  let remove_call t = { t with remove_call = t.remove_call + 1; }
+  let remove_alloc t = { t with remove_alloc = t.remove_alloc + 1; }
+  let remove_prim t = { t with remove_prim = t.remove_prim + 1; }
+  let remove_prims t n = { t with remove_prim = t.remove_prim + n; }
+  let remove_branch t = { t with remove_branch = t.remove_branch + 1; }
+  let direct_call_of_indirect t =
+    { t with direct_call_of_indirect = t.direct_call_of_indirect + 1; }
+  let requested_inline t ~size_of =
+    let size = lambda_size size_of in
+    { t with requested_inline = t.requested_inline + size; }
+
+  let remove_code_helper b (flam : Flambda.t) =
+    match flam with
+    | Assign _ -> b := remove_prim !b
+    | Switch _ | String_switch _ | Static_raise _ | Try_with _
+    | If_then_else _ | While _ | For _ -> b := remove_branch !b
+    | Apply _ | Send _ -> b := remove_call !b
+    | Let _ | Let_mutable _ | Let_rec _ | Proved_unreachable | Var _
+    | Static_catch _ -> ()
+
+  let remove_code_helper_named b (named : Flambda.named) =
+    match named with
+    | Set_of_closures _
+    | Prim ((Pmakearray _ | Pmakeblock _ | Pduprecord _), _, _) ->
+      b := remove_alloc !b
+      (* CR-soon pchambart: should we consider that boxed integer and float
+         operations are allocations ? *)
+    | Prim _ | Project_closure _ | Project_var _
+    | Move_within_set_of_closures _
+    | Read_symbol_field _ -> b := remove_prim !b
+    | Symbol _ | Read_mutable _ | Allocated_const _ | Const _ | Expr _ -> ()
+
+  let remove_code lam b =
+    let b = ref b in
+    Flambda_iterators.iter_toplevel (remove_code_helper b)
+      (remove_code_helper_named b) lam;
+    !b
+
+  let remove_code_named lam b =
+    let b = ref b in
+    Flambda_iterators.iter_named_toplevel (remove_code_helper b)
+      (remove_code_helper_named b) lam;
+    !b
+
+  let remove_projection (_proj : Projection.t) b =
+    (* They are all primitives for the moment.  The [Projection.t] argument
+       is here for future expansion. *)
+    remove_prim b
+
+  let print ppf b =
+    Format.fprintf ppf "@[remove_call: %i@ remove_alloc: %i@ \
+                        remove_prim: %i@ remove_branch: %i@ \
+                        direct: %i@ requested: %i@]"
+      b.remove_call
+      b.remove_alloc
+      b.remove_prim
+      b.remove_branch
+      b.direct_call_of_indirect
+      b.requested_inline
+
+  let evaluate t ~round : int =
+    benefit_factor *
+      (t.remove_call * (cost !Clflags.inline_call_cost ~round)
+       + t.remove_alloc * (cost !Clflags.inline_alloc_cost ~round)
+       + t.remove_prim * (cost !Clflags.inline_prim_cost ~round)
+       + t.remove_branch * (cost !Clflags.inline_branch_cost ~round)
+       + (t.direct_call_of_indirect
+         * (cost !Clflags.inline_indirect_cost ~round)))
+    + t.requested_inline
+
+  let (+) t1 t2 = {
+    remove_call = t1.remove_call + t2.remove_call;
+    remove_alloc = t1.remove_alloc + t2.remove_alloc;
+    remove_prim = t1.remove_prim + t2.remove_prim;
+    remove_branch = t1.remove_branch + t2.remove_branch;
+    direct_call_of_indirect =
+      t1.direct_call_of_indirect + t2.direct_call_of_indirect;
+    requested_inline = t1.requested_inline + t2.requested_inline;
+  }
+
+  let (-) t1 t2 = {
+    remove_call = t1.remove_call - t2.remove_call;
+    remove_alloc = t1.remove_alloc - t2.remove_alloc;
+    remove_prim = t1.remove_prim - t2.remove_prim;
+    remove_branch = t1.remove_branch - t2.remove_branch;
+    direct_call_of_indirect =
+      t1.direct_call_of_indirect - t2.direct_call_of_indirect;
+    requested_inline = t1.requested_inline - t2.requested_inline;
+  }
+
+  let max ~round t1 t2 =
+    let c1 = evaluate ~round t1 in
+    let c2 = evaluate ~round t2 in
+    if c1 > c2 then t1 else t2
+
+  let add_code lam b =
+    b - (remove_code lam zero)
+
+  let add_code_named lam b =
+    b - (remove_code_named lam zero)
+
+  let add_projection proj b =
+    b - (remove_projection proj zero)
+
+  (* Print out a benefit as a table *)
+
+  let benefit_table =
+    [ "Calls", (fun b -> b.remove_call);
+      "Allocs", (fun b -> b.remove_alloc);
+      "Prims", (fun b -> b.remove_prim);
+      "Branches", (fun b -> b.remove_branch);
+      "Indirect calls", (fun b -> b.direct_call_of_indirect);
+    ]
+
+  let benefits_table =
+    lazy begin
+      List.map
+        (fun (header, accessor) -> (header, accessor, String.length header))
+        benefit_table
+    end
+
+  let table_line =
+    lazy begin
+      let benefits_table = Lazy.force benefits_table in
+      let dashes =
+        List.map (fun (_, _, n) -> String.make n '-') benefits_table
+      in
+      "|-" ^ String.concat "-+-" dashes ^ "-|"
+    end
+
+  let table_headers =
+    lazy begin
+      let benefits_table = Lazy.force benefits_table in
+      let headers = List.map (fun (head, _, _) -> head) benefits_table in
+      "| " ^ String.concat " | " headers ^ " |"
+    end
+
+  let print_table_values ppf b =
+    let rec loop ppf = function
+      | [] -> Format.fprintf ppf "|"
+      | (_, accessor, width) :: rest ->
+        Format.fprintf ppf "| %*d %a" width (accessor b) loop rest
+    in
+    loop ppf (Lazy.force benefits_table)
+
+  let print_table ppf b =
+    let table_line = Lazy.force table_line in
+    let table_headers = Lazy.force table_headers in
+    Format.fprintf ppf
+      "@[@[%s@]@;@[%s@]@;@[%s@]@;@[%a@]@;@[%s@]@]"
+      table_line table_headers table_line
+      print_table_values b
+      table_line
+end
+
+module Whether_sufficient_benefit = struct
+  type t = {
+    round : int;
+    benefit : Benefit.t;
+    toplevel : bool;
+    branch_depth : int;
+    lifting : bool;
+    original_size : int;
+    new_size : int;
+    evaluated_benefit : int;
+    estimate : bool;
+  }
+
+  let create ~original ~toplevel ~branch_depth lam ~benefit ~lifting ~round =
+    let evaluated_benefit = Benefit.evaluate benefit ~round in
+    { round; benefit; toplevel; branch_depth; lifting;
+      original_size = lambda_size original;
+      new_size = lambda_size lam;
+      evaluated_benefit;
+      estimate = false;
+    }
+
+  let create_estimate ~original_size ~toplevel ~branch_depth ~new_size
+        ~benefit ~lifting ~round =
+    let evaluated_benefit = Benefit.evaluate benefit ~round in
+    { round; benefit; toplevel; branch_depth; lifting; original_size;
+      new_size; evaluated_benefit; estimate = true;
+    }
+
+  let is_nan f =
+    match Float.classify_float f with
+    | FP_nan -> true
+    | FP_normal | FP_subnormal | FP_zero | FP_infinite -> false
+
+  let correct_branch_factor f =
+    (not (is_nan f))
+    && (Float.compare f 0. >= 0)
+
+  let estimated_benefit t =
+    if t.toplevel && t.lifting && t.branch_depth = 0 then begin
+      let lifting_benefit =
+        Clflags.Int_arg_helper.get ~key:t.round !Clflags.inline_lifting_benefit
+      in
+        float (t.evaluated_benefit + lifting_benefit)
+    end else begin
+      (* The estimated benefit is the evaluated benefit times an
+         estimation of the probability that the branch does actually matter
+         for performance (i.e. is hot).  The probability is very roughly
+         estimated by considering that under every branch the
+         sub-expressions have the same [1 / (1 + factor)] probability
+         [p] of being hot.  Hence the probability for the current
+         call to be hot is [p ^ number of nested branches].
+         The probability is expressed as [1 / (1 + factor)] rather
+         than letting the user directly provide [p], since for every
+         positive value of [factor] [p] is in [0, 1]. *)
+      let branch_taken_estimated_probability =
+        let inline_branch_factor =
+          let factor =
+            Clflags.Float_arg_helper.get ~key:t.round
+              !Clflags.inline_branch_factor
+          in
+          if is_nan factor then
+            Clflags.default_inline_branch_factor
+          else if Float.compare factor 0. < 0 then
+            0.
+          else
+            factor
+        in
+        assert (correct_branch_factor inline_branch_factor);
+        1. /. (1. +. inline_branch_factor)
+      in
+      let call_estimated_probability =
+        branch_taken_estimated_probability ** float t.branch_depth
+      in
+      float t.evaluated_benefit *. call_estimated_probability
+    end
+
+  let evaluate t =
+    Float.compare
+      (float t.new_size -. estimated_benefit t)
+      (float t.original_size) <= 0
+
+  let to_string t =
+    let lifting = t.toplevel && t.lifting && t.branch_depth = 0 in
+    let evaluated_benefit =
+      if lifting then
+        let lifting_benefit =
+          Clflags.Int_arg_helper.get ~key:t.round
+            !Clflags.inline_lifting_benefit
+        in
+        t.evaluated_benefit + lifting_benefit
+      else t.evaluated_benefit
+    in
+    let estimate = if t.estimate then "<" else "=" in
+      Printf.sprintf "{benefit%s{call=%d,alloc=%d,prim=%i,branch=%i,\
+          indirect=%i,req=%i,\
+          lifting=%B}, orig_size=%d,new_size=%d,eval_size=%d,\
+          eval_benefit%s%d,\
+          branch_depth=%d}=%s"
+        estimate
+        t.benefit.remove_call
+        t.benefit.remove_alloc
+        t.benefit.remove_prim
+        t.benefit.remove_branch
+        t.benefit.direct_call_of_indirect
+        t.benefit.requested_inline
+        lifting
+        t.original_size
+        t.new_size
+        (t.original_size - t.new_size)
+        estimate
+        evaluated_benefit
+        t.branch_depth
+        (if evaluate t then "yes" else "no")
+
+  let print_description ~subfunctions ppf t =
+    let pr_intro ppf =
+      let estimate = if t.estimate then " at most" else "" in
+      Format.pp_print_text ppf
+        "Specialisation of the function body";
+      if subfunctions then
+        Format.pp_print_text ppf
+          ", including speculative inlining of other functions,";
+      Format.pp_print_text ppf " removed";
+      Format.pp_print_text ppf estimate;
+      Format.pp_print_text ppf " the following operations:"
+    in
+    let lifting = t.toplevel && t.lifting && t.branch_depth = 0 in
+    let requested = t.benefit.requested_inline in
+    let pr_requested ppf =
+      if requested > 0 then begin
+        Format.pp_open_box ppf 0;
+        Format.pp_print_text ppf
+            "and inlined user-annotated functions worth ";
+        Format.fprintf ppf "%d." requested;
+        Format.pp_close_box ppf ();
+        Format.pp_print_cut ppf ();
+        Format.pp_print_cut ppf ()
+      end
+    in
+    let pr_lifting ppf =
+      if lifting then begin
+        Format.pp_open_box ppf 0;
+        Format.pp_print_text ppf
+          "Inlining the function would also \
+           lift some definitions to toplevel.";
+        Format.pp_close_box ppf ();
+        Format.pp_print_cut ppf ();
+        Format.pp_print_cut ppf ()
+      end
+    in
+    let total_benefit =
+      if lifting then
+        let lifting_benefit =
+          Clflags.Int_arg_helper.get ~key:t.round
+            !Clflags.inline_lifting_benefit
+        in
+         t.evaluated_benefit + lifting_benefit
+      else t.evaluated_benefit
+    in
+    let expected_benefit = estimated_benefit t in
+    let size_change = t.new_size - t.original_size in
+    let result = if evaluate t then "less" else "greater" in
+    let pr_conclusion ppf =
+      Format.pp_print_text ppf "This gives a total benefit of ";
+      Format.pp_print_int ppf total_benefit;
+      Format.pp_print_text ppf ".  At a branch depth of ";
+      Format.pp_print_int ppf t.branch_depth;
+      Format.pp_print_text ppf " this produces an expected benefit of ";
+      Format.fprintf ppf "%.1f" expected_benefit;
+      Format.pp_print_text ppf ".  The new code has size ";
+      Format.pp_print_int ppf t.new_size;
+      Format.pp_print_text ppf ", giving a change in code size of ";
+      Format.pp_print_int ppf size_change;
+      Format.pp_print_text ppf ".  The change in code size is ";
+      Format.pp_print_text ppf result;
+      Format.pp_print_text ppf " than the expected benefit."
+    in
+    Format.fprintf ppf "%t@,@[@[@;%a@]@;@;%t%t@]%t"
+      pr_intro Benefit.print_table t.benefit pr_requested pr_lifting
+      pr_conclusion
+end
+
+let scale_inline_threshold_by = 8
+
+let default_toplevel_multiplier = 8
+
+  (* CR-soon mshinwell for mshinwell: hastily-written comment, to review *)
+  (* We may in [Inlining_decision] need to measure the size of functions
+     that are below the inlining threshold.  We also need to measure with
+     regard to benefit (see [Inlining_decision.inline_non_recursive).  The
+     intuition for having a cached size in the second case is as follows.
+     If a function's body exceeds some maximum size and its argument
+     approximations are unknown (meaning that we cannot materially simplify
+     it further), we can infer without examining the function's body that
+     it cannot be inlined.  The aim is to speed up [Inlining_decision].
+
+     The "original size" is [Inlining_cost.direct_call_size].  The "new size" is
+     the size of the function's body plus [Inlining_cost.project_size] for each
+     free variable and mutually recursive function accessed through the closure.
+
+     To be inlined we need:
+
+       body_size
+       + (closure_accesses * project_size)            <=   direct_call_size
+       - (evaluated_benefit * call_prob)
+
+     i.e.:
+
+       body_size <= direct_call_size
+                    + (evaluated_benefit * call_prob)
+                    - (closure_accesses * project_size)
+
+     In this case we would be removing a single call and a projection for each
+     free variable that can be accessed directly (i.e. not via the closure
+     or the internal variable).
+
+       evaluated_benefit =
+         benefit_factor
+         * (inline_call_cost
+         + ((free_variables - indirect_accesses) * inline_prim_cost))
+
+     (For [inline_call_cost] and [inline_prim_cost], we use the maximum these
+     might be across any round.)
+
+     Substituting:
+
+       body_size <= direct_call_size
+                      + (benefit_factor
+                          * (inline_call_cost
+                             + ((free_variables - indirect_accesses)
+                                * inline_prim_cost)))
+                        * call_prob
+                      - (closure_accesses * project_size)
+
+     Rearranging:
+
+       body_size <= direct_call_size
+                      + (inline_call_cost * benefit_factor * call_prob)
+                      + (free_variables * inline_prim_cost
+                           * benefit_factor * call_prob)
+                      - (indirect_accesses * inline_prim_cost
+                           * benefit_factor * call_prob)
+                      - (closure_accesses * project_size)
+
+     The upper bound for the right-hand side is when call_prob = 1.0,
+     indirect_accesses = 0 and closure_accesses = 0, giving:
+
+       direct_call_size
+         + (inline_call_cost * benefit_factor)
+         + (free_variables * inline_prim_cost * benefit_factor)
+
+     So we should measure all functions at or below this size, but also record
+     the size discovered, so we can later re-check (without examining the body)
+     when we know [call_prob], [indirect_accesses] and [closure_accesses].
+
+     This number is split into parts dependent and independent of the
+     number of free variables:
+
+       base = direct_call_size + (inline_call_cost * benefit_factor)
+
+       multiplier = inline_prim_cost * benefit_factor
+
+       body_size <= base + free_variables * multiplier
+
+  *)
+let maximum_interesting_size_of_function_body_base =
+  lazy begin
+    let max_cost = ref 0 in
+    for round = 0 to (Clflags.rounds ()) - 1 do
+      let max_size =
+        let inline_call_cost = cost !Clflags.inline_call_cost ~round in
+        direct_call_size + (inline_call_cost * benefit_factor)
+      in
+      max_cost := max !max_cost max_size
+    done;
+    !max_cost
+  end
+
+let maximum_interesting_size_of_function_body_multiplier =
+  lazy begin
+    let max_cost = ref 0 in
+    for round = 0 to (Clflags.rounds ()) - 1 do
+      let max_size =
+        let inline_prim_cost = cost !Clflags.inline_prim_cost ~round in
+        inline_prim_cost * benefit_factor
+      in
+      max_cost := max !max_cost max_size
+    done;
+    !max_cost
+  end
+
+let maximum_interesting_size_of_function_body num_free_variables =
+  let base = Lazy.force maximum_interesting_size_of_function_body_base in
+  let multiplier =
+    Lazy.force maximum_interesting_size_of_function_body_multiplier
+  in
+  base + (num_free_variables * multiplier)
diff --git a/middle_end/flambda/inlining_cost.mli b/middle_end/flambda/inlining_cost.mli
new file mode 100644
index 00000000..345f67ab
--- /dev/null
+++ b/middle_end/flambda/inlining_cost.mli
@@ -0,0 +1,142 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Measurement of the cost (including cost in space) of Flambda terms
+    in the context of inlining. *)
+
+module Threshold : sig
+
+  (** The maximum size, in some abstract measure of space cost, that an
+     Flambda expression may be in order to be inlined. *)
+  type t =
+    | Never_inline
+    | Can_inline_if_no_larger_than of int
+
+  val add : t -> t -> t
+  val sub : t -> t -> t
+  val min : t -> t -> t
+  val equal : t -> t -> bool
+
+end
+
+(* Determine whether the given Flambda expression has a sufficiently low space
+   cost so as to fit under the given [inlining_threshold].  The [bonus] is
+   added to the threshold before evaluation. *)
+val can_inline
+    : Flambda.t
+  -> Threshold.t
+  -> bonus:int
+  -> bool
+
+(* CR-soon mshinwell for pchambart: I think the name of this function might be
+   misleading.  It should probably reflect the functionality it provides,
+   not the use to which it is put in another module. *)
+(* As for [can_inline], but returns the decision as an inlining threshold.
+   If [Never_inline] is returned, the expression was too large for the
+   input [inlining_threshold].  Otherwise, [Can_inline_if_no_larger_than] is
+   returned, with the constructor argument being the measured estimated size
+   of the expression. *)
+val can_try_inlining
+    : Flambda.t
+  -> Threshold.t
+  -> number_of_arguments:int
+  -> size_from_approximation:int option
+  -> Threshold.t
+
+module Benefit : sig
+  (* A model of the benefit we gain by removing a particular combination
+     of operations.  Such removals are typically performed by inlining (for
+     example, [remove_call]) and simplification (for example, [remove_alloc])
+     passes. *)
+
+  type t
+
+  val zero : t
+  val (+) : t -> t -> t
+  val max : round:int -> t -> t -> t
+
+  val remove_call : t -> t
+  (* CR-soon mshinwell: [remove_alloc] should take the size of the block
+     (to account for removal of initializing writes). *)
+  val remove_alloc : t -> t
+  val remove_prim : t -> t
+  val remove_prims : t -> int -> t
+  val remove_branch : t -> t
+  val direct_call_of_indirect : t -> t
+  val requested_inline : t -> size_of:Flambda.t -> t
+
+  val remove_code : Flambda.t -> t -> t
+  val remove_code_named : Flambda.named -> t -> t
+  val remove_projection : Projection.t -> t -> t
+
+  val add_code : Flambda.t -> t -> t
+  val add_code_named : Flambda.named -> t -> t
+  val add_projection : Projection.t -> t -> t
+
+  val print : Format.formatter -> t -> unit
+end
+
+module Whether_sufficient_benefit : sig
+  (* Evaluation of the benefit of removing certain operations against an
+     inlining threshold. *)
+
+  type t
+
+  val create
+     : original:Flambda.t
+    -> toplevel:bool
+    -> branch_depth:int
+    -> Flambda.t
+    -> benefit:Benefit.t
+    -> lifting:bool
+    -> round:int
+    -> t
+
+  val create_estimate
+     : original_size:int
+    -> toplevel:bool
+    -> branch_depth: int
+    -> new_size:int
+    -> benefit:Benefit.t
+    -> lifting:bool
+    -> round:int
+    -> t
+
+  val evaluate : t -> bool
+
+  val to_string : t -> string
+
+  val print_description : subfunctions:bool -> Format.formatter -> t -> unit
+end
+
+val scale_inline_threshold_by : int
+
+val default_toplevel_multiplier : int
+
+val direct_call_size : int
+
+(** If a function body exceeds this size, we can make a fast decision not
+    to inline it (see [Inlining_decision]). *)
+val maximum_interesting_size_of_function_body : int -> int
+
+(** Measure the given expression to determine whether its size is at or
+    below the given threshold.  [None] is returned if it is too big; otherwise
+    [Some] is returned with the measured size. *)
+val lambda_smaller' : Flambda.expr -> than:int -> int option
+
+val lambda_size : Flambda.expr -> int
diff --git a/middle_end/flambda/inlining_decision.ml b/middle_end/flambda/inlining_decision.ml
new file mode 100644
index 00000000..900b2562
--- /dev/null
+++ b/middle_end/flambda/inlining_decision.ml
@@ -0,0 +1,742 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module A = Simple_value_approx
+module E = Inline_and_simplify_aux.Env
+module R = Inline_and_simplify_aux.Result
+module W = Inlining_cost.Whether_sufficient_benefit
+module T = Inlining_cost.Threshold
+module S = Inlining_stats_types
+module D = S.Decision
+
+let get_function_body (function_decl : A.function_declaration) =
+  match function_decl.function_body with
+  | None -> assert false
+  | Some function_body -> function_body
+
+type ('a, 'b) inlining_result =
+  | Changed of (Flambda.t * R.t) * 'a
+  | Original of 'b
+
+type 'b good_idea =
+  | Try_it
+  | Don't_try_it of 'b
+
+let inline env r ~lhs_of_application
+    ~closure_id_being_applied
+    ~(function_decl : A.function_declaration)
+    ~(function_body : A.function_body)
+    ~value_set_of_closures ~only_use_of_function ~original ~recursive
+    ~(args : Variable.t list) ~size_from_approximation ~dbg ~simplify
+    ~(inline_requested : Lambda.inline_attribute)
+    ~(specialise_requested : Lambda.specialise_attribute)
+    ~fun_vars ~set_of_closures_origin
+    ~self_call ~fun_cost ~inlining_threshold =
+  let toplevel = E.at_toplevel env in
+  let branch_depth = E.branch_depth env in
+  let unrolling, always_inline, never_inline, env =
+    let unrolling = E.actively_unrolling env set_of_closures_origin in
+    match unrolling with
+    | Some count ->
+      if count > 0 then
+        let env = E.continue_actively_unrolling env set_of_closures_origin in
+        true, true, false, env
+      else false, false, true, env
+    | None -> begin
+        let inline_annotation =
+          (* Merge call site annotation and function annotation.
+             The call site annotation takes precedence *)
+          match (inline_requested : Lambda.inline_attribute) with
+          | Always_inline | Hint_inline | Never_inline | Unroll _ ->
+              inline_requested
+          | Default_inline -> function_body.inline
+        in
+        match inline_annotation with
+        | Always_inline | Hint_inline -> false, true, false, env
+        | Never_inline -> false, false, true, env
+        | Default_inline -> false, false, false, env
+        | Unroll count ->
+          if count > 0 then
+            let env =
+              E.start_actively_unrolling
+                env set_of_closures_origin (count - 1)
+            in
+            true, true, false, env
+          else false, false, true, env
+      end
+  in
+  let remaining_inlining_threshold : Inlining_cost.Threshold.t =
+    if always_inline then inlining_threshold
+    else Lazy.force fun_cost
+  in
+  let try_inlining =
+    if unrolling then
+      Try_it
+    else if self_call then
+      Don't_try_it S.Not_inlined.Self_call
+    else if not (E.inlining_allowed env function_decl.closure_origin) then
+      Don't_try_it S.Not_inlined.Unrolling_depth_exceeded
+    else if only_use_of_function || always_inline then
+      Try_it
+    else if never_inline then
+      Don't_try_it S.Not_inlined.Annotation
+    else if not (E.unrolling_allowed env set_of_closures_origin)
+         && (Lazy.force recursive) then
+      Don't_try_it S.Not_inlined.Unrolling_depth_exceeded
+    else if T.equal remaining_inlining_threshold T.Never_inline then
+      let threshold =
+        match inlining_threshold with
+        | T.Never_inline -> assert false
+        | T.Can_inline_if_no_larger_than threshold -> threshold
+      in
+      Don't_try_it (S.Not_inlined.Above_threshold threshold)
+    else if not (toplevel && branch_depth = 0)
+         && A.all_not_useful (E.find_list_exn env args) then
+      (* When all of the arguments to the function being inlined are unknown,
+         then we cannot materially simplify the function.  As such, we know
+         what the benefit of inlining it would be: just removing the call.
+         In this case we may be able to prove the function cannot be inlined
+         without traversing its body.
+         Note that if the function is sufficiently small, we still have to call
+         [simplify], because the body needs freshening before substitution.
+      *)
+      (* CR-someday mshinwell: (from GPR#8): pchambart writes:
+
+          We may need to think a bit about that. I can't see a lot of
+          meaningful examples right now, but there are some cases where some
+          optimization can happen even if we don't know anything about the
+          shape of the arguments.
+
+          For instance
+
+          let f x y = x
+
+          let g x =
+            let y = (x,x) in
+            f x y
+          let f x y =
+            if x = y then ... else ...
+
+          let g x = f x x
+      *)
+      match size_from_approximation with
+      | Some body_size ->
+        let wsb =
+          let benefit = Inlining_cost.Benefit.zero in
+          let benefit = Inlining_cost.Benefit.remove_call benefit in
+          let benefit =
+            Variable.Set.fold (fun v acc ->
+                try
+                  let t =
+                    Var_within_closure.Map.find (Var_within_closure.wrap v)
+                      value_set_of_closures.A.bound_vars
+                  in
+                  match t.A.var with
+                  | Some v ->
+                    if (E.mem env v) then Inlining_cost.Benefit.remove_prim acc
+                    else acc
+                  | None -> acc
+                with Not_found -> acc)
+              function_body.free_variables benefit
+          in
+          W.create_estimate
+            ~original_size:Inlining_cost.direct_call_size
+            ~new_size:body_size
+            ~toplevel:(E.at_toplevel env)
+            ~branch_depth:(E.branch_depth env)
+            ~lifting:function_body.A.is_a_functor
+            ~round:(E.round env)
+            ~benefit
+        in
+        if (not (W.evaluate wsb)) then begin
+          Don't_try_it
+            (S.Not_inlined.Without_subfunctions wsb)
+        end else Try_it
+      | None ->
+        (* The function is definitely too large to inline given that we don't
+           have any approximations for its arguments.  Further, the body
+           should already have been simplified (inside its declaration), so
+           we also expect no gain from the code below that permits inlining
+           inside the body. *)
+        Don't_try_it S.Not_inlined.No_useful_approximations
+    else begin
+      (* There are useful approximations, so we should simplify. *)
+      Try_it
+    end
+  in
+  match try_inlining with
+  | Don't_try_it decision -> Original decision
+  | Try_it ->
+    let r =
+      R.set_inlining_threshold r (Some remaining_inlining_threshold)
+    in
+    let body, r_inlined =
+      (* First we construct the code that would result from copying the body of
+         the function, without doing any further inlining upon it, to the call
+         site. *)
+      Inlining_transforms.inline_by_copying_function_body ~env
+        ~r:(R.reset_benefit r) ~lhs_of_application
+        ~closure_id_being_applied ~specialise_requested ~inline_requested
+        ~function_decl ~function_body ~fun_vars ~args ~dbg ~simplify
+    in
+    let num_direct_applications_seen =
+      (R.num_direct_applications r_inlined) - (R.num_direct_applications r)
+    in
+    assert (num_direct_applications_seen >= 0);
+    let keep_inlined_version decision =
+      (* Inlining the body of the function was sufficiently beneficial that we
+         will keep it, replacing the call site.  We continue by allowing
+         further inlining within the inlined copy of the body. *)
+      let r_inlined =
+        (* The meaning of requesting inlining is that the user ensure
+           that the function has a benefit of at least its size. It is not
+           added to the benefit exposed by the inlining because the user should
+           have taken that into account before annotating the function. *)
+        if always_inline then
+          R.map_benefit r_inlined
+            (Inlining_cost.Benefit.max ~round:(E.round env)
+               Inlining_cost.Benefit.(requested_inline ~size_of:body zero))
+        else r_inlined
+      in
+      let r =
+        R.map_benefit r_inlined (Inlining_cost.Benefit.(+) (R.benefit r))
+      in
+      let env = E.note_entering_inlined env in
+      let env =
+        (* We decrement the unrolling count even if the function is not
+           recursive to avoid having to check whether or not it is recursive *)
+        E.inside_unrolled_function env set_of_closures_origin
+      in
+      let env = E.inside_inlined_function env function_decl.closure_origin in
+      let env =
+        if E.inlining_level env = 0
+           (* If the function was considered for inlining without considering
+              its sub-functions, and it is not below another inlining choice,
+              then we are certain that this code will be kept. *)
+        then env
+        else E.inlining_level_up env
+      in
+      Changed ((simplify env r body), decision)
+    in
+    if always_inline then
+      keep_inlined_version S.Inlined.Annotation
+    else if only_use_of_function then
+      keep_inlined_version S.Inlined.Decl_local_to_application
+    else begin
+      let wsb =
+        W.create ~original body
+          ~toplevel:(E.at_toplevel env)
+          ~branch_depth:(E.branch_depth env)
+          ~lifting:function_body.is_a_functor
+          ~round:(E.round env)
+          ~benefit:(R.benefit r_inlined)
+      in
+      if W.evaluate wsb then
+        keep_inlined_version (S.Inlined.Without_subfunctions wsb)
+      else if num_direct_applications_seen < 1 then begin
+      (* Inlining the body of the function did not appear sufficiently
+         beneficial; however, it may become so if we inline within the body
+         first.  We try that next, unless it is known that there were
+         no direct applications in the simplified body computed above, meaning
+         no opportunities for inlining. *)
+        Original (S.Not_inlined.Without_subfunctions wsb)
+      end else begin
+        let env = E.inlining_level_up env in
+        let env = E.note_entering_inlined env in
+        let env =
+          (* We decrement the unrolling count even if the function is recursive
+             to avoid having to check whether or not it is recursive *)
+          E.inside_unrolled_function env set_of_closures_origin
+        in
+        let body, r_inlined = simplify env r_inlined body in
+        let wsb_with_subfunctions =
+          W.create ~original body
+            ~toplevel:(E.at_toplevel env)
+            ~branch_depth:(E.branch_depth env)
+            ~lifting:function_body.is_a_functor
+            ~round:(E.round env)
+            ~benefit:(R.benefit r_inlined)
+        in
+        if W.evaluate wsb_with_subfunctions then begin
+          let res =
+            (body, R.map_benefit r_inlined
+                     (Inlining_cost.Benefit.(+) (R.benefit r)))
+          in
+          let decision =
+            S.Inlined.With_subfunctions (wsb, wsb_with_subfunctions)
+          in
+          Changed (res, decision)
+        end
+        else begin
+          (* r_inlined contains an approximation that may be invalid for the
+             untransformed expression: it may reference functions that only
+             exists if the body of the function is in fact inlined.
+             If the function approximation contained an approximation that
+             does not depend on the actual values of its arguments, it
+             could be returned instead of [A.value_unknown]. *)
+          let decision =
+            S.Not_inlined.With_subfunctions (wsb, wsb_with_subfunctions)
+          in
+          Original decision
+        end
+      end
+    end
+
+let specialise env r ~lhs_of_application
+      ~(function_decls : A.function_declarations)
+      ~(function_decl : A.function_declaration)
+      ~closure_id_being_applied
+      ~(value_set_of_closures : A.value_set_of_closures)
+      ~args ~args_approxs ~dbg ~simplify ~original ~recursive ~self_call
+      ~inlining_threshold ~fun_cost
+      ~inline_requested ~specialise_requested =
+  let invariant_params = value_set_of_closures.invariant_params in
+  let free_vars = value_set_of_closures.free_vars in
+  let has_no_useful_approxes =
+    lazy
+      (List.for_all2
+         (fun id approx ->
+            not ((A.useful approx)
+                 && Variable.Map.mem id (Lazy.force invariant_params)))
+         (Parameter.List.vars function_decl.params) args_approxs)
+  in
+  let always_specialise, never_specialise =
+    (* Merge call site annotation and function annotation.
+       The call site annotation takes precedence *)
+    match (specialise_requested : Lambda.specialise_attribute) with
+    | Always_specialise -> true, false
+    | Never_specialise -> false, true
+    | Default_specialise -> begin
+        match function_decl.function_body with
+        | None -> false, true
+        | Some { specialise } ->
+          match (specialise : Lambda.specialise_attribute) with
+          | Always_specialise -> true, false
+          | Never_specialise -> false, true
+          | Default_specialise -> false, false
+      end
+  in
+  let remaining_inlining_threshold : Inlining_cost.Threshold.t =
+    if always_specialise then inlining_threshold
+    else Lazy.force fun_cost
+  in
+  let try_specialising =
+    (* Try specialising if the function:
+       - is recursive; and
+       - is closed (it and all other members of the set of closures on which
+         it depends); and
+       - has useful approximations for some invariant parameters. *)
+    if function_decls.is_classic_mode then
+      Don't_try_it S.Not_specialised.Classic_mode
+    else if self_call then
+      Don't_try_it S.Not_specialised.Self_call
+    else if always_specialise && not (Lazy.force has_no_useful_approxes) then
+      Try_it
+    else if never_specialise then
+      Don't_try_it S.Not_specialised.Annotation
+    else if T.equal remaining_inlining_threshold T.Never_inline then
+      let threshold =
+        match inlining_threshold with
+        | T.Never_inline -> assert false
+        | T.Can_inline_if_no_larger_than threshold -> threshold
+      in
+      Don't_try_it (S.Not_specialised.Above_threshold threshold)
+    else if not (Variable.Map.is_empty free_vars) then
+      Don't_try_it S.Not_specialised.Not_closed
+    else if not (Lazy.force recursive) then
+      Don't_try_it S.Not_specialised.Not_recursive
+    else if Variable.Map.is_empty (Lazy.force invariant_params) then
+      Don't_try_it S.Not_specialised.No_invariant_parameters
+    else if Lazy.force has_no_useful_approxes then
+      Don't_try_it S.Not_specialised.No_useful_approximations
+    else Try_it
+  in
+  match try_specialising with
+  | Don't_try_it decision -> Original decision
+  | Try_it -> begin
+      let r =
+        R.set_inlining_threshold r (Some remaining_inlining_threshold)
+      in
+      let copied_function_declaration =
+        Inlining_transforms.inline_by_copying_function_declaration ~env
+          ~r:(R.reset_benefit r) ~lhs_of_application
+          ~function_decls ~closure_id_being_applied ~function_decl
+          ~args ~args_approxs
+          ~invariant_params:invariant_params
+          ~specialised_args:value_set_of_closures.specialised_args
+          ~free_vars:value_set_of_closures.free_vars
+          ~direct_call_surrogates:value_set_of_closures.direct_call_surrogates
+          ~dbg ~simplify ~inline_requested
+      in
+      match copied_function_declaration with
+      | Some (expr, r_inlined) ->
+        let wsb =
+          W.create ~original expr
+            ~toplevel:false
+            ~branch_depth:(E.branch_depth env)
+            ~lifting:false
+            ~round:(E.round env)
+            ~benefit:(R.benefit r_inlined)
+        in
+        let env =
+          (* CR-someday lwhite: could avoid calculating this if stats is turned
+             off *)
+          let closure_ids =
+            Closure_id.Set.of_list (
+              List.map Closure_id.wrap
+                (Variable.Set.elements (Variable.Map.keys function_decls.funs)))
+          in
+          E.note_entering_specialised env ~closure_ids
+        in
+        if always_specialise || W.evaluate wsb then begin
+          let r_inlined =
+            if always_specialise then
+              R.map_benefit r_inlined
+                (Inlining_cost.Benefit.max ~round:(E.round env)
+                   Inlining_cost.Benefit.(requested_inline ~size_of:expr zero))
+            else r_inlined
+          in
+          let r =
+            R.map_benefit r_inlined (Inlining_cost.Benefit.(+) (R.benefit r))
+          in
+          let closure_env =
+            let env =
+              if E.inlining_level env = 0
+               (* If the function was considered for specialising without
+                  considering its sub-functions, and it is not below another
+                  inlining choice, then we are certain that this code will
+                  be kept. *)
+              then env
+              else E.inlining_level_up env
+            in
+              E.set_never_inline_outside_closures env
+          in
+          let application_env = E.set_never_inline_inside_closures env in
+          let expr, r = simplify closure_env r expr in
+          let res = simplify application_env r expr in
+          let decision =
+            if always_specialise then S.Specialised.Annotation
+            else S.Specialised.Without_subfunctions wsb
+          in
+          Changed (res, decision)
+        end else begin
+          let closure_env =
+            let env = E.inlining_level_up env in
+            E.set_never_inline_outside_closures env
+          in
+          let expr, r_inlined = simplify closure_env r_inlined expr in
+          let wsb_with_subfunctions =
+            W.create ~original expr
+              ~toplevel:false
+              ~branch_depth:(E.branch_depth env)
+              ~lifting:false
+              ~round:(E.round env)
+              ~benefit:(R.benefit r_inlined)
+          in
+          if W.evaluate wsb_with_subfunctions then begin
+             let r =
+               R.map_benefit r_inlined
+                        (Inlining_cost.Benefit.(+) (R.benefit r))
+             in
+             let application_env = E.set_never_inline_inside_closures env in
+             let res = simplify application_env r expr in
+             let decision =
+               S.Specialised.With_subfunctions (wsb, wsb_with_subfunctions)
+             in
+             Changed (res, decision)
+          end else begin
+            let decision =
+              S.Not_specialised.Not_beneficial (wsb, wsb_with_subfunctions)
+            in
+            Original decision
+          end
+        end
+      | None ->
+        let decision = S.Not_specialised.No_useful_approximations in
+        Original decision
+    end
+
+let for_call_site ~env ~r ~(function_decls : A.function_declarations)
+      ~lhs_of_application ~closure_id_being_applied
+      ~(function_decl : A.function_declaration)
+      ~(value_set_of_closures : A.value_set_of_closures)
+      ~args ~args_approxs ~dbg ~simplify ~inline_requested
+      ~specialise_requested =
+  if List.length args <> List.length args_approxs then begin
+    Misc.fatal_error "Inlining_decision.for_call_site: inconsistent lengths \
+        of [args] and [args_approxs]"
+  end;
+  (* Remove unroll attributes from functions we are already actively
+     unrolling, otherwise they'll be unrolled again next round. *)
+  let inline_requested : Lambda.inline_attribute =
+    match (inline_requested : Lambda.inline_attribute) with
+    | Unroll _ -> begin
+        let unrolling =
+          E.actively_unrolling env function_decls.set_of_closures_origin
+        in
+        match unrolling with
+        | Some _ -> Default_inline
+        | None -> inline_requested
+      end
+    | Always_inline | Hint_inline | Default_inline | Never_inline ->
+        inline_requested
+  in
+  let original =
+    Flambda.Apply {
+      func = lhs_of_application;
+      args;
+      kind = Direct closure_id_being_applied;
+      dbg;
+      inline = inline_requested;
+      specialise = specialise_requested;
+    }
+  in
+  let original_r =
+    R.set_approx (R.seen_direct_application r) (A.value_unknown Other)
+  in
+  match function_decl.function_body with
+  | None -> original, original_r
+  | Some { stub; _ } ->
+    if stub then begin
+      let fun_vars = Variable.Map.keys function_decls.funs in
+      let function_body = get_function_body function_decl in
+      let body, r =
+        Inlining_transforms.inline_by_copying_function_body ~env
+          ~r ~fun_vars ~lhs_of_application
+          ~closure_id_being_applied ~specialise_requested ~inline_requested
+          ~function_decl ~function_body ~args ~dbg ~simplify
+      in
+      simplify env r body
+    end else if E.never_inline env then
+      (* This case only occurs when examining the body of a stub function
+         but not in the context of inlining said function.  As such, there
+         is nothing to do here (and no decision to report). *)
+      original, original_r
+    else if function_decls.is_classic_mode then begin
+      let env =
+        E.note_entering_call env
+          ~closure_id:closure_id_being_applied ~dbg:dbg
+      in
+      let simpl =
+        match function_decl.function_body with
+        | None -> Original S.Not_inlined.Classic_mode
+        | Some function_body ->
+          let self_call =
+            E.inside_set_of_closures_declaration
+              function_decls.set_of_closures_origin env
+          in
+          let try_inlining =
+            if self_call then
+              Don't_try_it S.Not_inlined.Self_call
+            else
+              if not (E.inlining_allowed env function_decl.closure_origin) then
+                Don't_try_it S.Not_inlined.Unrolling_depth_exceeded
+              else
+                Try_it
+          in
+          match try_inlining with
+          | Don't_try_it decision -> Original decision
+          | Try_it ->
+            let fun_vars = Variable.Map.keys function_decls.funs in
+            let body, r =
+              Inlining_transforms.inline_by_copying_function_body ~env
+                ~r ~function_body ~lhs_of_application
+                ~closure_id_being_applied ~specialise_requested
+                ~inline_requested ~function_decl ~fun_vars ~args ~dbg ~simplify
+            in
+            let env = E.note_entering_inlined env in
+            let env =
+              (* We decrement the unrolling count even if the function is not
+                 recursive to avoid having to check whether or not it is
+                 recursive *)
+              E.inside_unrolled_function env
+                                         function_decls.set_of_closures_origin
+            in
+            let env =
+              E.inside_inlined_function env function_decl.closure_origin
+            in
+            Changed ((simplify env r body), S.Inlined.Classic_mode)
+      in
+      let res, decision =
+        match simpl with
+        | Original decision ->
+          let decision =
+            S.Decision.Unchanged (S.Not_specialised.Classic_mode, decision)
+          in
+          (original, original_r), decision
+        | Changed ((expr, r), decision) ->
+          let max_inlining_threshold =
+            if E.at_toplevel env then
+              Inline_and_simplify_aux.initial_inlining_toplevel_threshold
+                ~round:(E.round env)
+            else
+              Inline_and_simplify_aux.initial_inlining_threshold
+                ~round:(E.round env)
+          in
+          let raw_inlining_threshold = R.inlining_threshold r in
+          let unthrottled_inlining_threshold =
+            match raw_inlining_threshold with
+            | None -> max_inlining_threshold
+            | Some inlining_threshold -> inlining_threshold
+          in
+          let inlining_threshold =
+            T.min unthrottled_inlining_threshold max_inlining_threshold
+          in
+          let inlining_threshold_diff =
+            T.sub unthrottled_inlining_threshold inlining_threshold
+          in
+          let res =
+            if E.inlining_level env = 0
+            then expr, R.set_inlining_threshold r raw_inlining_threshold
+            else expr, R.add_inlining_threshold r inlining_threshold_diff
+          in
+          res, S.Decision.Inlined (S.Not_specialised.Classic_mode, decision)
+      in
+      E.record_decision env decision;
+      res
+    end else begin
+      let function_body = get_function_body function_decl in
+      let env = E.unset_never_inline_inside_closures env in
+      let env =
+        E.note_entering_call env
+          ~closure_id:closure_id_being_applied ~dbg:dbg
+      in
+      let max_level =
+        Clflags.Int_arg_helper.get ~key:(E.round env) !Clflags.inline_max_depth
+      in
+      let raw_inlining_threshold = R.inlining_threshold r in
+      let max_inlining_threshold =
+        if E.at_toplevel env then
+          Inline_and_simplify_aux.initial_inlining_toplevel_threshold
+            ~round:(E.round env)
+        else
+          Inline_and_simplify_aux.initial_inlining_threshold
+            ~round:(E.round env)
+      in
+      let unthrottled_inlining_threshold =
+        match raw_inlining_threshold with
+        | None -> max_inlining_threshold
+        | Some inlining_threshold -> inlining_threshold
+      in
+      let inlining_threshold =
+        T.min unthrottled_inlining_threshold max_inlining_threshold
+      in
+      let inlining_threshold_diff =
+        T.sub unthrottled_inlining_threshold inlining_threshold
+      in
+      let inlining_prevented =
+        match inlining_threshold with
+        | Never_inline -> true
+        | Can_inline_if_no_larger_than _ -> false
+      in
+      let simpl =
+        if inlining_prevented then
+          Original (D.Prevented Function_prevented_from_inlining)
+        else if E.inlining_level env >= max_level then
+          Original (D.Prevented Level_exceeded)
+        else begin
+          let self_call =
+            E.inside_set_of_closures_declaration
+              function_decls.set_of_closures_origin env
+          in
+          let fun_cost =
+            lazy
+              (Inlining_cost.can_try_inlining function_body.body
+                 inlining_threshold
+                 ~number_of_arguments:(List.length function_decl.params)
+                 (* CR-someday mshinwell: for the moment, this is None, since
+                    the Inlining_cost code isn't checking sizes up to the max
+                    inlining threshold---this seems to take too long. *)
+                 ~size_from_approximation:None)
+          in
+          let recursive =
+            lazy
+              (let fun_var = Closure_id.unwrap closure_id_being_applied in
+               Variable.Set.mem fun_var
+                 (Lazy.force value_set_of_closures.recursive))
+          in
+          let specialise_result =
+            specialise env r
+              ~function_decls ~function_decl
+              ~lhs_of_application ~recursive ~closure_id_being_applied
+              ~value_set_of_closures ~args ~args_approxs ~dbg ~simplify
+              ~original ~inline_requested ~specialise_requested ~fun_cost
+              ~self_call ~inlining_threshold
+          in
+          match specialise_result with
+          | Changed (res, spec_reason) ->
+            Changed (res, D.Specialised spec_reason)
+          | Original spec_reason ->
+            let only_use_of_function = false in
+            (* If we didn't specialise then try inlining *)
+            let size_from_approximation =
+              let fun_var = Closure_id.unwrap closure_id_being_applied in
+              match
+                Variable.Map.find fun_var
+                                  (Lazy.force value_set_of_closures.size)
+              with
+              | size -> size
+              | exception Not_found ->
+                Misc.fatal_errorf "Approximation does not give a size for the \
+                                   function having fun_var %a.  \
+                                   value_set_of_closures: %a"
+                  Variable.print fun_var
+                  A.print_value_set_of_closures value_set_of_closures
+            in
+            let fun_vars = Variable.Map.keys function_decls.funs in
+            let set_of_closures_origin =
+              function_decls.set_of_closures_origin
+            in
+            let inline_result =
+              inline env r ~lhs_of_application
+                ~closure_id_being_applied ~function_decl ~value_set_of_closures
+                ~only_use_of_function ~original ~recursive
+                ~inline_requested ~specialise_requested
+                ~fun_vars ~set_of_closures_origin ~args
+                ~size_from_approximation ~dbg ~simplify ~fun_cost ~self_call
+                ~inlining_threshold ~function_body
+            in
+            match inline_result with
+            | Changed (res, inl_reason) ->
+              Changed (res, D.Inlined (spec_reason, inl_reason))
+            | Original inl_reason ->
+              Original (D.Unchanged (spec_reason, inl_reason))
+        end
+      in
+      let res, decision =
+        match simpl with
+        | Original decision -> (original, original_r), decision
+        | Changed ((expr, r), decision) ->
+          let res =
+            if E.inlining_level env = 0
+            then expr, R.set_inlining_threshold r raw_inlining_threshold
+            else expr, R.add_inlining_threshold r inlining_threshold_diff
+          in
+          res, decision
+      in
+      E.record_decision env decision;
+      res
+    end
+
+(* We do not inline inside stubs, which are always inlined at their call site.
+   Inlining inside the declaration of a stub could result in more code than
+   expected being inlined (e.g. the body of a function that was transformed
+   by adding the stub). *)
+let should_inline_inside_declaration (decl : Flambda.function_declaration) =
+  not decl.stub
diff --git a/middle_end/flambda/inlining_decision.mli b/middle_end/flambda/inlining_decision.mli
new file mode 100644
index 00000000..3694e303
--- /dev/null
+++ b/middle_end/flambda/inlining_decision.mli
@@ -0,0 +1,43 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** See the Flambda manual chapter for an explanation in prose of the
+    inlining decision procedure. *)
+
+(** Try to inline a full application of a known function, guided by various
+    heuristics. *)
+val for_call_site
+   : env:Inline_and_simplify_aux.Env.t
+  -> r:Inline_and_simplify_aux.Result.t
+  -> function_decls:Simple_value_approx.function_declarations
+  -> lhs_of_application:Variable.t
+  -> closure_id_being_applied:Closure_id.t
+  -> function_decl:Simple_value_approx.function_declaration
+  -> value_set_of_closures:Simple_value_approx.value_set_of_closures
+  -> args:Variable.t list
+  -> args_approxs:Simple_value_approx.t list
+  -> dbg:Debuginfo.t
+  -> simplify:Inlining_decision_intf.simplify
+  -> inline_requested:Lambda.inline_attribute
+  -> specialise_requested:Lambda.specialise_attribute
+  -> Flambda.t * Inline_and_simplify_aux.Result.t
+
+(** When a function declaration is encountered by [for_call_site], the body
+    may be subject to inlining immediately, thus changing the declaration.
+    This function must return [true] for that to be able to happen. *)
+val should_inline_inside_declaration : Flambda.function_declaration -> bool
diff --git a/middle_end/flambda/inlining_decision_intf.mli b/middle_end/flambda/inlining_decision_intf.mli
new file mode 100644
index 00000000..15a08031
--- /dev/null
+++ b/middle_end/flambda/inlining_decision_intf.mli
@@ -0,0 +1,49 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(* CR-someday mshinwell: name of this source file could now be improved *)
+
+type 'a by_copying_function_body =
+     env:Inline_and_simplify_aux.Env.t
+  -> r:Inline_and_simplify_aux.Result.t
+  -> clos:Flambda.function_declarations
+  -> lfunc:Flambda.t
+  -> fun_id:Closure_id.t
+  -> func:Flambda.function_declaration
+  -> args:Flambda.t list
+  -> Flambda.t * Inline_and_simplify_aux.Result.t
+
+type 'a by_copying_function_declaration =
+     env:Inline_and_simplify_aux.Env.t
+  -> r:Inline_and_simplify_aux.Result.t
+  -> funct:Flambda.t
+  -> clos:Flambda.function_declarations
+  -> fun_id:Closure_id.t
+  -> func:Flambda.function_declaration
+  -> args_with_approxs:
+      (Flambda.t list) * (Simple_value_approx.t list)
+  -> invariant_params:Variable.Set.t
+  -> specialised_args:Variable.Set.t
+  -> dbg:Debuginfo.t
+  -> (Flambda.t * Inline_and_simplify_aux.Result.t) option
+
+type simplify =
+     Inline_and_simplify_aux.Env.t
+  -> Inline_and_simplify_aux.Result.t
+  -> Flambda.t
+  -> Flambda.t * Inline_and_simplify_aux.Result.t
diff --git a/middle_end/flambda/inlining_stats.ml b/middle_end/flambda/inlining_stats.ml
new file mode 100644
index 00000000..6809d4cb
--- /dev/null
+++ b/middle_end/flambda/inlining_stats.ml
@@ -0,0 +1,252 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module Closure_stack = struct
+  type t = node list
+
+  and node =
+    | Closure of Closure_id.t * Debuginfo.t
+    | Call of Closure_id.t * Debuginfo.t
+    | Inlined
+    | Specialised of Closure_id.Set.t
+
+  let create () = []
+
+  let note_entering_closure t ~closure_id ~dbg =
+    if not !Clflags.inlining_report then t
+    else
+      match t with
+      | [] | (Closure _ | Inlined | Specialised _)  :: _->
+        (Closure (closure_id, dbg)) :: t
+      | (Call _) :: _ ->
+        Misc.fatal_errorf "note_entering_closure: unexpected Call node"
+
+  (* CR-someday lwhite: since calls do not have a unique id it is possible
+     some calls will end up sharing nodes. *)
+  let note_entering_call t ~closure_id ~dbg =
+    if not !Clflags.inlining_report then t
+    else
+      match t with
+      | [] | (Closure _ | Inlined | Specialised _) :: _ ->
+        (Call (closure_id, dbg)) :: t
+      | (Call _) :: _ ->
+        Misc.fatal_errorf "note_entering_call: unexpected Call node"
+
+  let note_entering_inlined t =
+    if not !Clflags.inlining_report then t
+    else
+      match t with
+      | [] | (Closure _ | Inlined | Specialised _) :: _->
+        Misc.fatal_errorf "note_entering_inlined: missing Call node"
+      | (Call _) :: _ -> Inlined :: t
+
+  let note_entering_specialised t ~closure_ids =
+    if not !Clflags.inlining_report then t
+    else
+      match t with
+      | [] | (Closure _ | Inlined | Specialised _) :: _ ->
+        Misc.fatal_errorf "note_entering_specialised: missing Call node"
+      | (Call _) :: _ -> Specialised closure_ids :: t
+
+end
+
+let log
+  : (Closure_stack.t * Inlining_stats_types.Decision.t) list ref
+  = ref []
+
+let record_decision decision ~closure_stack =
+  if !Clflags.inlining_report then begin
+    match closure_stack with
+    | []
+    | Closure_stack.Closure _ :: _
+    | Closure_stack.Inlined :: _
+    | Closure_stack.Specialised _ :: _ ->
+      Misc.fatal_errorf "record_decision: missing Call node"
+    | Closure_stack.Call _ :: _ ->
+      log := (closure_stack, decision) :: !log
+  end
+
+module Inlining_report = struct
+
+  module Place = struct
+    type kind =
+      | Closure
+      | Call
+
+    type t = Debuginfo.t * Closure_id.t * kind
+
+    let compare ((d1, cl1, k1) : t) ((d2, cl2, k2) : t) =
+      let c = Debuginfo.compare d1 d2 in
+      if c <> 0 then c else
+      let c = Closure_id.compare cl1 cl2 in
+      if c <> 0 then c else
+        match k1, k2 with
+        | Closure, Closure -> 0
+        | Call, Call -> 0
+        | Closure, Call -> 1
+        | Call, Closure -> -1
+  end
+
+  module Place_map = Map.Make(Place)
+
+  type t = node Place_map.t
+
+  and node =
+    | Closure of t
+    | Call of call
+
+  and call =
+    { decision: Inlining_stats_types.Decision.t option;
+      inlined: t option;
+      specialised: t option; }
+
+  let empty_call =
+    { decision = None;
+      inlined = None;
+      specialised = None; }
+
+  (* Prevented or unchanged decisions may be overridden by a later look at the
+     same call. Other decisions may also be "overridden" because calls are not
+     uniquely identified. *)
+  let add_call_decision call (decision : Inlining_stats_types.Decision.t) =
+    match call.decision, decision with
+    | None, _ -> { call with decision = Some decision }
+    | Some _, Prevented _ -> call
+    | Some (Prevented _), _ -> { call with decision = Some decision }
+    | Some (Specialised _), _ -> call
+    | Some _, Specialised _ -> { call with decision = Some decision }
+    | Some (Inlined _), _ -> call
+    | Some _, Inlined _ -> { call with decision = Some decision }
+    | Some Unchanged _, Unchanged _ -> call
+
+  let add_decision t (stack, decision) =
+    let rec loop t : Closure_stack.t -> _ = function
+      | Closure(cl, dbg) :: rest ->
+          let key : Place.t = (dbg, cl, Closure) in
+          let v =
+            try
+              match Place_map.find key t with
+              | Closure v -> v
+              | Call _ -> assert false
+            with Not_found -> Place_map.empty
+          in
+          let v = loop v rest in
+          Place_map.add key (Closure v) t
+      | Call(cl, dbg) :: rest ->
+          let key : Place.t = (dbg, cl, Call) in
+          let v =
+            try
+              match Place_map.find key t with
+              | Call v -> v
+              | Closure _ -> assert false
+            with Not_found -> empty_call
+          in
+          let v =
+            match rest with
+            | [] -> add_call_decision v decision
+            | Inlined :: rest ->
+                let inlined =
+                  match v.inlined with
+                  | None -> Place_map.empty
+                  | Some inlined -> inlined
+                in
+                let inlined = loop inlined rest in
+                { v with inlined = Some inlined }
+            | Specialised _ :: rest ->
+                let specialised =
+                  match v.specialised with
+                  | None -> Place_map.empty
+                  | Some specialised -> specialised
+                in
+                let specialised = loop specialised rest in
+                { v with specialised = Some specialised }
+            | Call _ :: _ -> assert false
+            | Closure _ :: _ -> assert false
+          in
+          Place_map.add key (Call v) t
+      | [] -> assert false
+      | Inlined :: _ -> assert false
+      | Specialised _ :: _ -> assert false
+    in
+    loop t (List.rev stack)
+
+  let build log =
+    List.fold_left add_decision Place_map.empty log
+
+  let print_stars ppf n =
+    let s = String.make n '*' in
+    Format.fprintf ppf "%s" s
+
+  let rec print ~depth ppf t =
+    Place_map.iter (fun (dbg, cl, _) v ->
+       match v with
+       | Closure t ->
+         Format.fprintf ppf "@[%a Definition of %a%s@]@."
+           print_stars (depth + 1)
+           Closure_id.print cl
+           (Debuginfo.to_string dbg);
+         print ppf ~depth:(depth + 1) t;
+         if depth = 0 then Format.pp_print_newline ppf ()
+       | Call c ->
+         match c.decision with
+         | None ->
+           Misc.fatal_error "Inlining_report.print: missing call decision"
+         | Some decision ->
+           Format.pp_open_vbox ppf (depth + 2);
+           Format.fprintf ppf "@[%a Application of %a%s@]@;@;@[%a@]"
+             print_stars (depth + 1)
+             Closure_id.print cl
+             (Debuginfo.to_string dbg)
+             Inlining_stats_types.Decision.summary decision;
+           Format.pp_close_box ppf ();
+           Format.pp_print_newline ppf ();
+           Format.pp_print_newline ppf ();
+           Inlining_stats_types.Decision.calculation ~depth:(depth + 1)
+             ppf decision;
+           begin
+             match c.specialised with
+             | None -> ()
+             | Some specialised ->
+               print ppf ~depth:(depth + 1) specialised
+           end;
+           begin
+             match c.inlined with
+             | None -> ()
+             | Some inlined ->
+               print ppf ~depth:(depth + 1) inlined
+           end;
+           if depth = 0 then Format.pp_print_newline ppf ())
+      t
+
+  let print ppf t = print ~depth:0 ppf t
+
+end
+
+let really_save_then_forget_decisions ~output_prefix =
+  let report = Inlining_report.build !log in
+  let out_channel = open_out (output_prefix ^ ".inlining.org") in
+  let ppf = Format.formatter_of_out_channel out_channel in
+  Inlining_report.print ppf report;
+  close_out out_channel;
+  log := []
+
+let save_then_forget_decisions ~output_prefix =
+  if !Clflags.inlining_report then begin
+    really_save_then_forget_decisions ~output_prefix
+  end
diff --git a/middle_end/flambda/inlining_stats.mli b/middle_end/flambda/inlining_stats.mli
new file mode 100644
index 00000000..f1e84fdc
--- /dev/null
+++ b/middle_end/flambda/inlining_stats.mli
@@ -0,0 +1,46 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+module Closure_stack : sig
+  type t
+
+  val create : unit -> t
+
+  val note_entering_closure
+     : t
+    -> closure_id:Closure_id.t
+    -> dbg:Debuginfo.t
+    -> t
+
+  val note_entering_call
+    : t
+    -> closure_id:Closure_id.t
+    -> dbg:Debuginfo.t
+    -> t
+
+  val note_entering_inlined : t -> t
+  val note_entering_specialised : t -> closure_ids:Closure_id.Set.t -> t
+
+end
+
+val record_decision
+   : Inlining_stats_types.Decision.t
+  -> closure_stack:Closure_stack.t
+  -> unit
+
+val save_then_forget_decisions : output_prefix:string -> unit
diff --git a/middle_end/flambda/inlining_stats_types.ml b/middle_end/flambda/inlining_stats_types.ml
new file mode 100644
index 00000000..7aef0796
--- /dev/null
+++ b/middle_end/flambda/inlining_stats_types.ml
@@ -0,0 +1,290 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module Wsb = Inlining_cost.Whether_sufficient_benefit
+
+let print_stars ppf n =
+  let s = String.make n '*' in
+  Format.fprintf ppf "%s" s
+
+let print_calculation ~depth ~title ~subfunctions ppf wsb =
+  Format.pp_open_vbox ppf (depth + 2);
+  Format.fprintf ppf "@[%a %s@]@;@;@[%a@]"
+    print_stars (depth + 1)
+    title
+    (Wsb.print_description ~subfunctions) wsb;
+  Format.pp_close_box ppf ();
+  Format.pp_print_newline ppf ();
+  Format.pp_print_newline ppf ()
+
+module Inlined = struct
+
+  type t =
+    | Classic_mode
+    | Annotation
+    | Decl_local_to_application
+    | Without_subfunctions of Wsb.t
+    | With_subfunctions of Wsb.t * Wsb.t
+
+  let summary ppf = function
+    | Classic_mode ->
+        Format.pp_print_text ppf
+        "This function was inlined because it was small enough \
+         to be inlined in `-Oclassic'"
+    | Annotation ->
+      Format.pp_print_text ppf
+        "This function was inlined because of an annotation."
+    | Decl_local_to_application ->
+      Format.pp_print_text ppf
+        "This function was inlined because it was local to this application."
+    | Without_subfunctions _ ->
+      Format.pp_print_text ppf
+        "This function was inlined because \
+         the expected benefit outweighed the change in code size."
+    | With_subfunctions _ ->
+      Format.pp_print_text ppf
+        "This function was inlined because \
+         the expected benefit outweighed the change in code size."
+
+  let calculation ~depth ppf = function
+    | Classic_mode -> ()
+    | Annotation -> ()
+    | Decl_local_to_application -> ()
+    | Without_subfunctions wsb ->
+      print_calculation
+        ~depth ~title:"Inlining benefit calculation"
+        ~subfunctions:false ppf wsb
+    | With_subfunctions(_, wsb) ->
+      print_calculation
+        ~depth ~title:"Inlining benefit calculation"
+        ~subfunctions:true ppf wsb
+
+end
+
+module Not_inlined = struct
+  type t =
+    | Classic_mode
+    | Above_threshold of int
+    | Annotation
+    | No_useful_approximations
+    | Unrolling_depth_exceeded
+    | Self_call
+    | Without_subfunctions of Wsb.t
+    | With_subfunctions of Wsb.t * Wsb.t
+
+
+  let summary ppf = function
+    | Classic_mode ->
+      Format.pp_print_text ppf
+        "This function was not inlined because it was too \
+         large to be inlined in `-Oclassic'."
+    | Above_threshold size ->
+      Format.pp_print_text ppf
+        "This function was not inlined because \
+         it was larger than the current size threshold";
+        Format.fprintf ppf "(%i)" size
+    | Annotation ->
+      Format.pp_print_text ppf
+        "This function was not inlined because \
+         of an annotation."
+    | No_useful_approximations ->
+      Format.pp_print_text ppf
+        "This function was not inlined because \
+         there was no useful information about any of its parameters, \
+         and it was not particularly small."
+    | Unrolling_depth_exceeded ->
+      Format.pp_print_text ppf
+        "This function was not inlined because \
+         its unrolling depth was exceeded."
+    | Self_call ->
+      Format.pp_print_text ppf
+        "This function was not inlined because \
+         it was a self call."
+    | Without_subfunctions _ ->
+      Format.pp_print_text ppf
+        "This function was not inlined because \
+         the expected benefit did not outweigh the change in code size."
+    | With_subfunctions _ ->
+      Format.pp_print_text ppf
+        "This function was not inlined because \
+         the expected benefit did not outweigh the change in code size."
+
+  let calculation ~depth ppf = function
+    | Classic_mode
+    | Above_threshold _
+    | Annotation
+    | No_useful_approximations
+    | Unrolling_depth_exceeded
+    | Self_call -> ()
+    | Without_subfunctions wsb ->
+      print_calculation
+        ~depth ~title:"Inlining benefit calculation"
+        ~subfunctions:false ppf wsb
+    | With_subfunctions(_, wsb) ->
+      print_calculation
+        ~depth ~title:"Inlining benefit calculation"
+        ~subfunctions:true ppf wsb
+
+end
+
+module Specialised = struct
+  type t =
+    | Annotation
+    | Without_subfunctions of Wsb.t
+    | With_subfunctions of Wsb.t * Wsb.t
+
+  let summary ppf = function
+    | Annotation ->
+      Format.pp_print_text ppf
+        "This function was specialised because of an annotation."
+    | Without_subfunctions _ ->
+      Format.pp_print_text ppf
+        "This function was specialised because the expected benefit \
+         outweighed the change in code size."
+    | With_subfunctions _ ->
+      Format.pp_print_text ppf
+        "This function was specialised because the expected benefit \
+         outweighed the change in code size."
+
+
+  let calculation ~depth ppf = function
+    | Annotation -> ()
+    | Without_subfunctions wsb ->
+        print_calculation
+          ~depth ~title:"Specialising benefit calculation"
+          ~subfunctions:false ppf wsb
+    | With_subfunctions(_, wsb) ->
+        print_calculation
+          ~depth ~title:"Specialising benefit calculation"
+          ~subfunctions:true ppf wsb
+end
+
+module Not_specialised = struct
+  type t =
+    | Classic_mode
+    | Above_threshold of int
+    | Annotation
+    | Not_recursive
+    | Not_closed
+    | No_invariant_parameters
+    | No_useful_approximations
+    | Self_call
+    | Not_beneficial of Wsb.t * Wsb.t
+
+  let summary ppf = function
+    | Classic_mode ->
+      Format.pp_print_text ppf
+        "This function was not specialised because it was \
+         compiled with `-Oclassic'."
+    | Above_threshold size ->
+      Format.pp_print_text ppf
+        "This function was not specialised because \
+         it was larger than the current size threshold";
+        Format.fprintf ppf "(%i)" size
+    | Annotation ->
+      Format.pp_print_text ppf
+        "This function was not specialised because \
+         of an annotation."
+    | Not_recursive ->
+      Format.pp_print_text ppf
+        "This function was not specialised because \
+         it is not recursive."
+    | Not_closed ->
+      Format.pp_print_text ppf
+        "This function was not specialised because \
+         it is not closed."
+    | No_invariant_parameters ->
+      Format.pp_print_text ppf
+        "This function was not specialised because \
+          it has no invariant parameters."
+    | No_useful_approximations ->
+      Format.pp_print_text ppf
+        "This function was not specialised because \
+         there was no useful information about any of its invariant \
+         parameters."
+    | Self_call ->
+      Format.pp_print_text ppf
+        "This function was not specialised because \
+         it was a self call."
+    | Not_beneficial _ ->
+      Format.pp_print_text ppf
+        "This function was not specialised because \
+          the expected benefit did not outweigh the change in code size."
+
+  let calculation ~depth ppf = function
+    | Classic_mode
+    | Above_threshold _
+    | Annotation
+    | Not_recursive
+    | Not_closed
+    | No_invariant_parameters
+    | No_useful_approximations
+    | Self_call -> ()
+    | Not_beneficial(_, wsb) ->
+      print_calculation
+        ~depth ~title:"Specialising benefit calculation"
+        ~subfunctions:true ppf wsb
+
+end
+
+module Prevented = struct
+  type t =
+    | Function_prevented_from_inlining
+    | Level_exceeded
+
+  let summary ppf = function
+    | Function_prevented_from_inlining ->
+      Format.pp_print_text ppf
+        "This function was prevented from inlining or specialising."
+    | Level_exceeded ->
+      Format.pp_print_text ppf
+        "This function was prevented from inlining or specialising \
+         because the inlining depth was exceeded."
+end
+
+module Decision = struct
+  type t =
+    | Prevented of Prevented.t
+    | Specialised of Specialised.t
+    | Inlined of Not_specialised.t * Inlined.t
+    | Unchanged of Not_specialised.t * Not_inlined.t
+
+  let summary ppf = function
+    | Prevented p ->
+      Prevented.summary ppf p
+    | Specialised s ->
+      Specialised.summary ppf s
+    | Inlined (s, i) ->
+      Format.fprintf ppf "@[@[%a@]@;@;@[%a@]@]"
+        Not_specialised.summary s Inlined.summary i
+    | Unchanged (s, i) ->
+      Format.fprintf ppf "@[@[%a@]@;@;@[%a@]@]"
+        Not_specialised.summary s Not_inlined.summary i
+
+  let calculation ~depth ppf = function
+    | Prevented _ -> ()
+    | Specialised s ->
+      Specialised.calculation ~depth ppf s
+    | Inlined (s, i) ->
+      Not_specialised.calculation ~depth ppf s;
+      Inlined.calculation ~depth ppf i
+    | Unchanged (s, i) ->
+      Not_specialised.calculation ~depth ppf s;
+      Not_inlined.calculation ~depth ppf i
+end
diff --git a/middle_end/flambda/inlining_stats_types.mli b/middle_end/flambda/inlining_stats_types.mli
new file mode 100644
index 00000000..9d476c89
--- /dev/null
+++ b/middle_end/flambda/inlining_stats_types.mli
@@ -0,0 +1,89 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(* Types used for producing statistics about inlining. *)
+
+module Inlined : sig
+  type t =
+    | Classic_mode
+    | Annotation
+    | Decl_local_to_application
+    | Without_subfunctions of
+        Inlining_cost.Whether_sufficient_benefit.t
+    | With_subfunctions of
+        Inlining_cost.Whether_sufficient_benefit.t
+        * Inlining_cost.Whether_sufficient_benefit.t
+end
+
+module Not_inlined : sig
+  type t =
+    | Classic_mode
+    | Above_threshold of int
+    | Annotation
+    | No_useful_approximations
+    | Unrolling_depth_exceeded
+    | Self_call
+    | Without_subfunctions of
+        Inlining_cost.Whether_sufficient_benefit.t
+    | With_subfunctions of
+        Inlining_cost.Whether_sufficient_benefit.t
+        * Inlining_cost.Whether_sufficient_benefit.t
+end
+
+module Specialised : sig
+  type t =
+    | Annotation
+    | Without_subfunctions of
+        Inlining_cost.Whether_sufficient_benefit.t
+    | With_subfunctions of
+        Inlining_cost.Whether_sufficient_benefit.t
+        * Inlining_cost.Whether_sufficient_benefit.t
+end
+
+module Not_specialised : sig
+  type t =
+    | Classic_mode
+    | Above_threshold of int
+    | Annotation
+    | Not_recursive
+    | Not_closed
+    | No_invariant_parameters
+    | No_useful_approximations
+    | Self_call
+    | Not_beneficial of
+        Inlining_cost.Whether_sufficient_benefit.t
+        * Inlining_cost.Whether_sufficient_benefit.t
+end
+
+module Prevented : sig
+  type t =
+    | Function_prevented_from_inlining
+    | Level_exceeded
+end
+
+module Decision : sig
+
+  type t =
+    | Prevented of Prevented.t
+    | Specialised of Specialised.t
+    | Inlined of Not_specialised.t * Inlined.t
+    | Unchanged of Not_specialised.t * Not_inlined.t
+
+  val summary : Format.formatter -> t -> unit
+  val calculation : depth:int -> Format.formatter -> t -> unit
+end
diff --git a/middle_end/flambda/inlining_transforms.ml b/middle_end/flambda/inlining_transforms.ml
new file mode 100644
index 00000000..c46a6cbe
--- /dev/null
+++ b/middle_end/flambda/inlining_transforms.ml
@@ -0,0 +1,668 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module B = Inlining_cost.Benefit
+module E = Inline_and_simplify_aux.Env
+module R = Inline_and_simplify_aux.Result
+module A = Simple_value_approx
+
+let new_var name =
+  Variable.create name
+    ~current_compilation_unit:(Compilation_unit.get_current_exn ())
+
+(** Fold over all variables bound by the given closure, which is bound to the
+    variable [lhs_of_application], and corresponds to the given
+    [function_decls].  Each variable bound by the closure is passed to the
+    user-specified function as an [Flambda.named] value that projects the
+    variable from its closure. *)
+let fold_over_projections_of_vars_bound_by_closure ~closure_id_being_applied
+      ~lhs_of_application ~bound_variables ~init ~f =
+  Variable.Set.fold (fun var acc ->
+      let expr : Flambda.named =
+        Project_var {
+          closure = lhs_of_application;
+          closure_id = closure_id_being_applied;
+          var = Var_within_closure.wrap var;
+        }
+      in
+      f ~acc ~var ~expr)
+    bound_variables
+    init
+
+let set_inline_attribute_on_all_apply body inline specialise =
+  Flambda_iterators.map_toplevel_expr (function
+      | Apply apply -> Apply { apply with inline; specialise }
+      | expr -> expr)
+    body
+
+(** Assign fresh names for a function's parameters and rewrite the body to
+    use these new names. *)
+let copy_of_function's_body_with_freshened_params env
+      ~(function_decl : A.function_declaration)
+      ~(function_body : A.function_body) =
+  let params = function_decl.params in
+  let param_vars = Parameter.List.vars params in
+  (* We cannot avoid the substitution in the case where we are inlining
+     inside the function itself.  This can happen in two ways: either
+     (a) we are inlining the function itself directly inside its declaration;
+     or (b) we are inlining the function into an already-inlined copy.
+     For (a) we cannot short-cut the substitution by freshening since the
+     original [params] may still be referenced; for (b) we cannot do it
+     either since the freshening may already be renaming the parameters for
+     the first inlining of the function. *)
+  if E.does_not_bind env param_vars
+    && E.does_not_freshen env param_vars
+  then
+    params, function_body.body
+  else
+    let freshened_params = List.map (fun p -> Parameter.rename p) params in
+    let subst =
+      Variable.Map.of_list
+        (List.combine param_vars (Parameter.List.vars freshened_params))
+    in
+    let body = Flambda_utils.toplevel_substitution subst function_body.body in
+    freshened_params, body
+
+(* CR-soon mshinwell: Add a note somewhere to explain why "bound by the closure"
+   does not include the function identifiers for other functions in the same
+   set of closures.
+   mshinwell: The terminology may be used inconsistently. *)
+
+(** Inline a function by copying its body into a context where it becomes
+    closed.  That is to say, we bind the free variables of the body
+    (= "variables bound by the closure"), and any function identifiers
+    introduced by the corresponding set of closures. *)
+let inline_by_copying_function_body ~env ~r
+      ~lhs_of_application
+      ~(inline_requested : Lambda.inline_attribute)
+      ~(specialise_requested : Lambda.specialise_attribute)
+      ~closure_id_being_applied
+      ~(function_decl : A.function_declaration)
+      ~(function_body : A.function_body)
+      ~fun_vars
+      ~args ~dbg ~simplify =
+  assert (E.mem env lhs_of_application);
+  assert (List.for_all (E.mem env) args);
+  let r =
+    if function_body.stub then r
+    else R.map_benefit r B.remove_call
+  in
+  let freshened_params, body =
+    copy_of_function's_body_with_freshened_params env
+      ~function_decl ~function_body
+  in
+  let body =
+    let default_inline =
+      Lambda.equal_inline_attribute inline_requested Default_inline
+    in
+    let default_specialise =
+      Lambda.equal_specialise_attribute specialise_requested Default_specialise
+    in
+    if function_body.stub
+    && ((not default_inline) || (not default_specialise)) then
+      (* When the function inlined function is a stub, the annotation
+         is reported to the function applications inside the stub.
+         This allows reporting the annotation to the application the
+         original programmer really intended: the stub is not visible
+         in the source. *)
+      set_inline_attribute_on_all_apply body
+        inline_requested specialise_requested
+    else
+      body
+  in
+  let bindings_for_params_to_args =
+    (* Bind the function's parameters to the arguments from the call site. *)
+    let args = List.map (fun arg -> Flambda.Expr (Var arg)) args in
+    Flambda_utils.bind ~body
+      ~bindings:(List.combine (Parameter.List.vars freshened_params) args)
+  in
+  (* Add bindings for the variables bound by the closure. *)
+  let bindings_for_vars_bound_by_closure_and_params_to_args =
+    let bound_variables =
+      let params = Parameter.Set.vars function_decl.params in
+      Variable.Set.diff
+        (Variable.Set.diff function_body.free_variables params)
+        fun_vars
+    in
+    fold_over_projections_of_vars_bound_by_closure ~closure_id_being_applied
+      ~lhs_of_application ~bound_variables ~init:bindings_for_params_to_args
+      ~f:(fun ~acc:body ~var ~expr -> Flambda.create_let var expr body)
+  in
+  (* Add bindings for variables corresponding to the functions introduced by
+     the whole set of closures.  Each such variable will be bound to a closure;
+     each such closure is in turn produced by moving from the closure being
+     applied to another closure in the same set.
+  *)
+  let expr =
+    Variable.Set.fold (fun another_closure_in_the_same_set expr ->
+      let used =
+        Variable.Set.mem another_closure_in_the_same_set
+           function_body.free_variables
+      in
+      if used then
+        Flambda.create_let another_closure_in_the_same_set
+          (Move_within_set_of_closures {
+            closure = lhs_of_application;
+            start_from = closure_id_being_applied;
+            move_to = Closure_id.wrap another_closure_in_the_same_set;
+          })
+          expr
+      else expr)
+      fun_vars
+      bindings_for_vars_bound_by_closure_and_params_to_args
+  in
+  let env = E.set_never_inline env in
+  let env = E.activate_freshening env in
+  let env = E.set_inline_debuginfo ~dbg env in
+  simplify env r expr
+
+type state = {
+  old_inside_to_new_inside : Variable.t Variable.Map.t;
+    (* Map from old inner vars to new inner vars *)
+  old_outside_to_new_outside : Variable.t Variable.Map.t;
+    (* Map from old outer vars to new outer vars *)
+  old_params_to_new_outside : Variable.t Variable.Map.t;
+    (* Map from old parameters to new outer vars. These are params
+       that should be specialised if they are copied to the new set of
+       closures. *)
+  old_fun_var_to_new_fun_var : Variable.t Variable.Map.t;
+    (* Map from old fun vars to new fun vars. These are the functions
+       that will be copied into the new set of closures *)
+  let_bindings : (Variable.t * Flambda.named) list;
+    (* Let bindings that will surround the definition of the new set
+       of closures *)
+  to_copy : Variable.t list;
+    (* List of functions that still need to be copied to the new set
+       of closures *)
+  new_funs : Flambda.function_declaration Variable.Map.t;
+    (* The function declarations for the new set of closures *)
+  new_free_vars_with_old_projections : Flambda.specialised_to Variable.Map.t;
+    (* The free variables for the new set of closures, but the projection
+       fields still point to old free variables. *)
+  new_specialised_args_with_old_projections :
+    Flambda.specialised_to Variable.Map.t;
+    (* The specialised parameters for the new set of closures, but the
+       projection fields still point to old specialised parameters. *)
+}
+
+let empty_state =
+  { to_copy = [];
+    old_inside_to_new_inside   = Variable.Map.empty;
+    old_outside_to_new_outside = Variable.Map.empty;
+    old_params_to_new_outside = Variable.Map.empty;
+    old_fun_var_to_new_fun_var = Variable.Map.empty;
+    let_bindings = [];
+    new_funs = Variable.Map.empty;
+    new_free_vars_with_old_projections = Variable.Map.empty;
+    new_specialised_args_with_old_projections = Variable.Map.empty; }
+
+(* Add let bindings for the free vars in the set_of_closures and
+   add them to [old_outside_to_new_outside] *)
+let bind_free_vars ~lhs_of_application ~closure_id_being_applied
+      ~state ~free_vars =
+  Variable.Map.fold
+    (fun free_var (spec : Flambda.specialised_to) state ->
+       let var_clos = new_var Internal_variable_names.from_closure in
+       let expr : Flambda.named =
+         Project_var {
+           closure = lhs_of_application;
+           closure_id = closure_id_being_applied;
+           var = Var_within_closure.wrap free_var;
+         }
+       in
+       let let_bindings = (var_clos, expr) :: state.let_bindings in
+       let old_outside_to_new_outside =
+         Variable.Map.add spec.var var_clos state.old_outside_to_new_outside
+       in
+       { state with let_bindings; old_outside_to_new_outside })
+    free_vars state
+
+(* For arguments of specialised parameters:
+   - Add them to [old_outside_to_new_outside]
+   - Add them and their invariant aliases to [old_params_to_new_outside]
+   For other arguments that are also worth specialising:
+   - Add them and their invariant aliases to [old_params_to_new_outside] *)
+let register_arguments ~specialised_args ~invariant_params
+      ~state ~params ~args ~args_approxs =
+  let rec loop ~state ~params ~args ~args_approxs =
+    match params, args, args_approxs with
+    | [], [], [] -> state
+    | param :: params, arg :: args, arg_approx :: args_approxs -> begin
+        let param = Parameter.var param in
+        let worth_specialising, old_outside_to_new_outside =
+          match Variable.Map.find_opt param specialised_args with
+          | Some (spec : Flambda.specialised_to) ->
+              let old_outside_to_new_outside =
+                Variable.Map.add spec.var arg state.old_outside_to_new_outside
+              in
+              true, old_outside_to_new_outside
+          | None ->
+              let worth_specialising =
+                A.useful arg_approx
+                && Variable.Map.mem param (Lazy.force invariant_params)
+              in
+              worth_specialising, state.old_outside_to_new_outside
+        in
+        let old_params_to_new_outside =
+          if worth_specialising then begin
+            let old_params_to_new_outside =
+              Variable.Map.add param arg state.old_params_to_new_outside
+            in
+            match Variable.Map.find_opt param (Lazy.force invariant_params) with
+            | Some set ->
+                Variable.Set.fold
+                  (fun elem acc -> Variable.Map.add elem arg acc)
+                  set old_params_to_new_outside
+            | None ->
+                old_params_to_new_outside
+          end else begin
+            state.old_params_to_new_outside
+          end
+        in
+        let state =
+          { state with old_outside_to_new_outside; old_params_to_new_outside }
+        in
+        loop ~state ~params ~args ~args_approxs
+      end
+    | _, _, _ -> assert false
+  in
+  loop ~state ~params ~args ~args_approxs
+
+(* Add an old parameter to [old_inside_to_new_inside]. If it appears in
+   [old_params_to_new_outside] then also add it to the new specialised args. *)
+let add_param ~specialised_args ~state ~param =
+  let param = Parameter.var param in
+  let new_param = Variable.rename param in
+  let old_inside_to_new_inside =
+    Variable.Map.add param new_param state.old_inside_to_new_inside
+  in
+  let new_specialised_args_with_old_projections =
+    match Variable.Map.find_opt param specialised_args with
+    | Some (spec : Flambda.specialised_to) ->
+        let new_outside_var =
+          Variable.Map.find spec.var state.old_outside_to_new_outside
+        in
+        let new_spec : Flambda.specialised_to =
+          { spec with var = new_outside_var }
+        in
+        Variable.Map.add new_param new_spec
+          state.new_specialised_args_with_old_projections
+    | None -> begin
+        match Variable.Map.find_opt param state.old_params_to_new_outside with
+        | None -> state.new_specialised_args_with_old_projections
+        | Some new_outside_var ->
+            let new_spec : Flambda.specialised_to =
+              { var = new_outside_var; projection = None }
+            in
+            Variable.Map.add new_param new_spec
+              state.new_specialised_args_with_old_projections
+      end
+  in
+  let state =
+    { state with old_inside_to_new_inside;
+                 new_specialised_args_with_old_projections }
+  in
+  state, Parameter.wrap new_param
+
+(* Add a let binding for an old fun_var, add it to the new free variables, and
+   add it to [old_inside_to_new_inside] *)
+let add_fun_var ~lhs_of_application ~closure_id_being_applied ~state ~fun_var =
+  if Variable.Map.mem fun_var state.old_inside_to_new_inside then state
+  else begin
+    let inside_var = Variable.rename fun_var in
+    let outside_var = Variable.create Internal_variable_names.closure in
+    let expr =
+      Flambda.Move_within_set_of_closures
+        { closure    = lhs_of_application;
+          start_from = closure_id_being_applied;
+          move_to    = Closure_id.wrap fun_var; }
+    in
+    let let_bindings = (outside_var, expr) :: state.let_bindings in
+    let spec : Flambda.specialised_to =
+      { var = outside_var; projection = None; }
+    in
+    let new_free_vars_with_old_projections =
+      Variable.Map.add inside_var spec state.new_free_vars_with_old_projections
+    in
+    let old_inside_to_new_inside =
+      Variable.Map.add fun_var inside_var state.old_inside_to_new_inside
+    in
+    { state with
+        old_inside_to_new_inside; let_bindings;
+        new_free_vars_with_old_projections }
+  end
+
+(* Add an old free_var to the new free variables and add it to
+   [old_inside_to_new_inside]. *)
+let add_free_var ~free_vars ~state ~free_var =
+  if Variable.Map.mem free_var state.old_inside_to_new_inside then state
+  else begin
+    let spec : Flambda.specialised_to = Variable.Map.find free_var free_vars in
+    let outside_var = spec.var in
+    let new_outside_var =
+      Variable.Map.find outside_var state.old_outside_to_new_outside
+    in
+    let new_spec : Flambda.specialised_to =
+      { spec with var = new_outside_var }
+    in
+    let new_inside_var = Variable.rename free_var in
+    let new_free_vars_with_old_projections =
+      Variable.Map.add new_inside_var new_spec
+        state.new_free_vars_with_old_projections
+    in
+    let old_inside_to_new_inside =
+      Variable.Map.add free_var new_inside_var state.old_inside_to_new_inside
+    in
+    { state with old_inside_to_new_inside; new_free_vars_with_old_projections }
+  end
+
+(* Add a function to the new set of closures iff:
+   1) All it's specialised parameters are available in
+      [old_outside_to_new_outside]
+   2) At least one more parameter will become specialised *)
+let add_function ~specialised_args ~state ~fun_var ~function_decl =
+  match function_decl.A.function_body with
+  | None -> None
+  | Some _ -> begin
+    let rec loop worth_specialising = function
+      | [] -> worth_specialising
+      | param :: params -> begin
+          let param = Parameter.var param in
+          match Variable.Map.find_opt param specialised_args with
+          | Some (spec : Flambda.specialised_to) ->
+              Variable.Map.mem spec.var state.old_outside_to_new_outside
+              && loop worth_specialising params
+          | None ->
+              let worth_specialising =
+                worth_specialising
+                || Variable.Map.mem param state.old_params_to_new_outside
+              in
+              loop worth_specialising params
+        end
+    in
+    let worth_specialising = loop false function_decl.A.params in
+    if not worth_specialising then None
+    else begin
+      let new_fun_var = Variable.rename fun_var in
+      let old_fun_var_to_new_fun_var =
+        Variable.Map.add fun_var new_fun_var state.old_fun_var_to_new_fun_var
+      in
+      let to_copy = fun_var :: state.to_copy in
+      let state = { state with old_fun_var_to_new_fun_var; to_copy } in
+      Some (state, new_fun_var)
+    end
+  end
+
+(* Lookup a function in the new set of closures, trying to add it if
+   necessary. *)
+let lookup_function ~specialised_args ~state ~fun_var ~function_decl =
+  match Variable.Map.find_opt fun_var state.old_fun_var_to_new_fun_var with
+  | Some new_fun_var -> Some (state, new_fun_var)
+  | None -> add_function ~specialised_args ~state ~fun_var ~function_decl
+
+(* A direct call to a function in the new set of closures can be specialised
+   if all the function's newly specialised parameters are passed arguments
+   that are specialised to the same outside variable *)
+let specialisable_call ~specialised_args ~state ~args ~params =
+  List.for_all2
+    (fun arg param ->
+       let param = Parameter.var param in
+       if Variable.Map.mem param specialised_args then true
+       else begin
+         let old_params_to_new_outside = state.old_params_to_new_outside in
+         match Variable.Map.find_opt param old_params_to_new_outside with
+         | None -> true
+         | Some outside_var -> begin
+             match Variable.Map.find_opt arg old_params_to_new_outside with
+             | Some outside_var' ->
+               Variable.equal outside_var outside_var'
+             | None -> false
+           end
+       end)
+    args params
+
+(* Rewrite a call iff:
+   1) It is to a function in the old set of closures that can be specialised
+   2) All the newly specialised parameters of that function are passed values
+      known to be equal to their new specialisation. *)
+let rec rewrite_direct_call ~specialised_args ~funs ~direct_call_surrogates
+      ~state ~closure_id ~(apply : Flambda.apply) =
+  match Closure_id.Map.find_opt closure_id direct_call_surrogates with
+  | Some closure_id ->
+      rewrite_direct_call ~specialised_args ~funs ~direct_call_surrogates
+        ~state ~closure_id ~apply
+  | None -> begin
+      let fun_var = Closure_id.unwrap closure_id in
+      match Variable.Map.find_opt fun_var funs with
+      | None -> None
+      | Some function_decl -> begin
+          match
+            lookup_function ~specialised_args ~state ~fun_var ~function_decl
+          with
+          | None -> None
+          | Some (state, new_fun_var) -> begin
+              let args = apply.args in
+              let params = function_decl.A.params in
+              let specialisable =
+                specialisable_call ~specialised_args ~state ~args ~params
+              in
+              if not specialisable then None
+              else begin
+                let kind = Flambda.Direct (Closure_id.wrap new_fun_var) in
+                let apply = { apply with func = new_fun_var; kind } in
+                Some (state, Flambda.Apply apply)
+              end
+            end
+        end
+    end
+
+(* Rewrite the body a function declaration for use in the new set of
+   closures. *)
+let rewrite_function ~lhs_of_application ~closure_id_being_applied
+      ~direct_call_surrogates ~specialised_args ~free_vars ~funs
+      ~state fun_var =
+  let function_decl : A.function_declaration =
+    Variable.Map.find fun_var funs
+  in
+  let function_body =
+    match function_decl.function_body with
+    | None -> assert false
+    | Some function_body -> function_body
+  in
+  let new_fun_var =
+    Variable.Map.find fun_var state.old_fun_var_to_new_fun_var
+  in
+  let state, params =
+    List.fold_right
+      (fun param (state, params) ->
+         let state, param = add_param ~specialised_args ~state ~param in
+         (state, param :: params))
+      function_decl.params (state, [])
+  in
+  let state =
+    Variable.Set.fold
+      (fun var state ->
+         if Variable.Map.mem var funs then
+           add_fun_var ~lhs_of_application ~closure_id_being_applied
+             ~state ~fun_var:var
+         else if Variable.Map.mem var free_vars then
+           add_free_var ~free_vars ~state ~free_var:var
+         else
+           state)
+      function_body.free_variables state
+  in
+  let state_ref = ref state in
+  let body =
+    Flambda_iterators.map_toplevel_expr
+      (fun (expr : Flambda.t) ->
+         match expr with
+         | Apply ({ kind = Direct closure_id } as apply) -> begin
+             match
+               rewrite_direct_call ~specialised_args ~funs
+                 ~direct_call_surrogates ~state:!state_ref ~closure_id ~apply
+             with
+             | None -> expr
+             | Some (state, expr) ->
+                 state_ref := state;
+                 expr
+           end
+         | _ -> expr)
+      function_body.body
+  in
+  let body =
+    Flambda_utils.toplevel_substitution state.old_inside_to_new_inside body
+  in
+  let new_function_decl =
+    Flambda.create_function_declaration
+      ~params ~body
+      ~stub:function_body.stub
+      ~dbg:function_body.dbg
+      ~inline:function_body.inline
+      ~specialise:function_body.specialise
+      ~is_a_functor:function_body.is_a_functor
+      ~closure_origin:(Closure_origin.create (Closure_id.wrap new_fun_var))
+  in
+  let new_funs =
+    Variable.Map.add new_fun_var new_function_decl state.new_funs
+  in
+  let state = { !state_ref with new_funs } in
+  state
+
+let update_projections ~state projections =
+  let old_to_new = state.old_inside_to_new_inside in
+  Variable.Map.map
+    (fun (spec_to : Flambda.specialised_to) ->
+       let projection : Projection.t option =
+         match spec_to.projection with
+         | None -> None
+         | Some (Project_var proj) -> begin
+             match Variable.Map.find_opt proj.closure old_to_new with
+             | None -> None
+             | Some closure ->
+                 let proj = { proj with closure } in
+                 Some (Projection.Project_var proj)
+           end
+         | Some (Project_closure proj) -> begin
+             match Variable.Map.find_opt proj.set_of_closures old_to_new with
+             | None -> None
+             | Some set_of_closures ->
+                 let proj = { proj with set_of_closures } in
+                 Some (Projection.Project_closure proj)
+           end
+         | Some (Move_within_set_of_closures proj) -> begin
+             match Variable.Map.find_opt proj.closure old_to_new with
+             | None -> None
+             | Some closure ->
+                 let proj = { proj with closure } in
+                 Some (Projection.Move_within_set_of_closures proj)
+           end
+         | Some (Field (index, var)) -> begin
+             match Variable.Map.find_opt var old_to_new with
+             | None -> None
+             | Some var -> Some (Projection.Field(index, var))
+           end
+      in
+      { spec_to with projection })
+    projections
+
+let inline_by_copying_function_declaration
+    ~(env : Inline_and_simplify_aux.Env.t)
+    ~(r : Inline_and_simplify_aux.Result.t)
+    ~(function_decls : A.function_declarations)
+    ~(lhs_of_application : Variable.t)
+    ~(inline_requested : Lambda.inline_attribute)
+    ~(closure_id_being_applied : Closure_id.t)
+    ~(function_decl : A.function_declaration)
+    ~(args : Variable.t list)
+    ~(args_approxs : A.t list)
+    ~(invariant_params : Variable.Set.t Variable.Map.t lazy_t)
+    ~(specialised_args : Flambda.specialised_to Variable.Map.t)
+    ~(free_vars : Flambda.specialised_to Variable.Map.t)
+    ~(direct_call_surrogates : Closure_id.t Closure_id.Map.t)
+    ~(dbg : Debuginfo.t)
+    ~(simplify : Inlining_decision_intf.simplify) =
+  let state = empty_state in
+  let state =
+    bind_free_vars ~lhs_of_application ~closure_id_being_applied
+      ~state ~free_vars
+  in
+  let params = function_decl.params in
+  let state =
+    register_arguments ~specialised_args ~invariant_params
+      ~state ~params ~args ~args_approxs
+  in
+  let fun_var = Closure_id.unwrap closure_id_being_applied in
+  match add_function ~specialised_args ~state ~fun_var ~function_decl with
+  | None -> None
+  | Some (state, new_fun_var) -> begin
+      let funs = function_decls.funs in
+      let rec loop state =
+        match state.to_copy with
+        | [] -> state
+        | next :: rest ->
+          let state = { state with to_copy = rest } in
+          let state =
+            rewrite_function ~lhs_of_application ~closure_id_being_applied
+              ~direct_call_surrogates ~specialised_args ~free_vars ~funs
+              ~state next
+          in
+          loop state
+      in
+      let state = loop state in
+      let closure_id = Closure_id.wrap new_fun_var in
+      let function_decls =
+        Flambda.create_function_declarations_with_origin
+          ~funs:state.new_funs
+          ~set_of_closures_origin:function_decls.set_of_closures_origin
+          ~is_classic_mode:function_decls.is_classic_mode
+      in
+      let free_vars =
+        update_projections ~state
+          state.new_free_vars_with_old_projections
+      in
+      let specialised_args =
+        update_projections ~state
+          state.new_specialised_args_with_old_projections
+      in
+      let direct_call_surrogates = Variable.Map.empty in
+      let set_of_closures =
+        Flambda.create_set_of_closures ~function_decls
+          ~free_vars ~specialised_args ~direct_call_surrogates
+      in
+      let closure_var = new_var Internal_variable_names.dup_func in
+      let set_of_closures_var =
+        new_var Internal_variable_names.dup_set_of_closures
+      in
+      let project : Flambda.project_closure =
+        {set_of_closures = set_of_closures_var; closure_id}
+      in
+      let apply : Flambda.apply =
+        { func = closure_var; args; kind = Direct closure_id; dbg;
+          inline = inline_requested; specialise = Default_specialise; }
+      in
+      let body =
+        Flambda.create_let
+          set_of_closures_var (Set_of_closures set_of_closures)
+          (Flambda.create_let closure_var (Project_closure project)
+             (Apply apply))
+      in
+      let expr = Flambda_utils.bind ~body ~bindings:state.let_bindings in
+      let env = E.activate_freshening (E.set_never_inline env) in
+      Some (simplify env r expr)
+    end
diff --git a/middle_end/flambda/inlining_transforms.mli b/middle_end/flambda/inlining_transforms.mli
new file mode 100644
index 00000000..e31d1b08
--- /dev/null
+++ b/middle_end/flambda/inlining_transforms.mli
@@ -0,0 +1,105 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Source code transformations used during inlining. *)
+
+(** Inline a function by substituting its body (which may be subject to
+    further transformation) at a call site.  The function's declaration is
+    not copied.
+
+    This transformation is used when:
+    - inlining a call to a non-recursive function;
+    - inlining a call, within a recursive or mutually-recursive function, to
+      the same or another function being defined simultaneously ("unrolling").
+      The maximum depth of unrolling is bounded (see [E.unrolling_allowed]).
+
+    In both cases, the body of the function is copied, within a sequence of
+    [let]s that bind the function parameters, the variables "bound by the
+    closure" (see flambda.mli), and any function identifiers introduced by the
+    set of closures.  These stages are delimited below by comments.
+
+    As an example, suppose we are inlining the following function:
+
+     let f x = x + y
+     ...
+     let p = f, f in
+     (fst p) 42
+
+    The call site [ (fst p) 42] will be transformed to:
+
+      let clos_id = fst p in  (* must eventually yield a closure *)
+      let y =  in
+      let x' = 42 in
+      let x = x' in
+      x + y
+
+    When unrolling a recursive function we rename the arguments to the
+    recursive call in order to avoid clashes with existing bindings.  For
+    example, suppose we are inlining the following call to [f], which lies
+    within its own declaration:
+
+      let rec f x y =
+        f (fst x) (y + snd x)
+
+    This will be transformed to:
+
+      let rec f x y =
+        let clos_id = f in (* not used this time, since [f] has no free vars *)
+        let x' = fst x in
+        let y' = y + snd x in
+        f (fst x') (y' + snd x')  (* body of [f] with parameters freshened *)
+*)
+val inline_by_copying_function_body
+   : env:Inline_and_simplify_aux.Env.t
+  -> r:Inline_and_simplify_aux.Result.t
+  -> lhs_of_application:Variable.t
+  -> inline_requested:Lambda.inline_attribute
+  -> specialise_requested:Lambda.specialise_attribute
+  -> closure_id_being_applied:Closure_id.t
+  -> function_decl:Simple_value_approx.function_declaration
+  -> function_body:Simple_value_approx.function_body
+  -> fun_vars:Variable.Set.t
+  -> args:Variable.t list
+  -> dbg:Debuginfo.t
+  -> simplify:Inlining_decision_intf.simplify
+  -> Flambda.t * Inline_and_simplify_aux.Result.t
+
+(** Inlining of recursive function(s) yields a copy of the functions'
+    definitions (not just their bodies, unlike the non-recursive case) and
+    a direct application of the new body.
+    Note: the function really does need to be recursive (but possibly only via
+    some mutual recursion) to end up in here; a simultaneous binding [that is
+    non-recursive] is not sufficient.
+*)
+val inline_by_copying_function_declaration
+   : env:Inline_and_simplify_aux.Env.t
+  -> r:Inline_and_simplify_aux.Result.t
+  -> function_decls:Simple_value_approx.function_declarations
+  -> lhs_of_application:Variable.t
+  -> inline_requested:Lambda.inline_attribute
+  -> closure_id_being_applied:Closure_id.t
+  -> function_decl:Simple_value_approx.function_declaration
+  -> args:Variable.t list
+  -> args_approxs:Simple_value_approx.t list
+  -> invariant_params:Variable.Set.t Variable.Map.t lazy_t
+  -> specialised_args:Flambda.specialised_to Variable.Map.t
+  -> free_vars:Flambda.specialised_to Variable.Map.t
+  -> direct_call_surrogates:Closure_id.t Closure_id.Map.t
+  -> dbg:Debuginfo.t
+  -> simplify:Inlining_decision_intf.simplify
+  -> (Flambda.t * Inline_and_simplify_aux.Result.t) option
diff --git a/middle_end/flambda/invariant_params.ml b/middle_end/flambda/invariant_params.ml
new file mode 100644
index 00000000..a43cfdac
--- /dev/null
+++ b/middle_end/flambda/invariant_params.ml
@@ -0,0 +1,420 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+(* CR-someday pchambart to pchambart: in fact partial application doesn't
+   work because there are no 'known' partial application left: they are
+   converted to applications new partial function declaration.
+   That can be improved (and many other cases) by keeping track of aliases in
+   closure of functions. *)
+
+(* These analyses are computed in two steps:
+   * accumulate the atomic <- relations
+   * compute the least-fixed point
+
+  The <- relation is represented by the type
+
+     t Variable.Pair.Map.t
+
+  if [Variable.Pair.Map.find (f, x) relation = Top] then (f, x) <- Top
+  is in the relation.
+
+  if [Variable.Pair.Map.find (f, x) relation = Implication s] and
+  [Variable.Pair.Set.mem (g, y) s] then (f, x) <- (g, y) is in the
+  relation.
+*)
+
+type t =
+  | Top
+  | Implication of Variable.Pair.Set.t
+
+let _print ppf = function
+  | Top -> Format.fprintf ppf "Top"
+  | Implication args ->
+      Format.fprintf ppf "Implication: @[%a@]"
+        Variable.Pair.Set.print args
+
+let top relation p =
+  Variable.Pair.Map.add p Top relation
+
+let implies relation from to_ =
+  match Variable.Pair.Map.find to_ relation with
+  | Top -> relation
+  | Implication set ->
+    Variable.Pair.Map.add to_
+      (Implication (Variable.Pair.Set.add from set))
+      relation
+  | exception Not_found ->
+    Variable.Pair.Map.add to_
+      (Implication (Variable.Pair.Set.singleton from))
+      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)
+  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
+
+(* CR-soon pchambart: to move to Flambda_utils and document
+   mshinwell: I think this calculation is basically the same as
+   [Flambda_utils.fun_vars_referenced_in_decls], so we should try
+   to share code.  However let's defer until after 4.03.  (And note CR
+   below.)
+*)
+(* Finds variables that represent the functions.
+   In a construction like:
+     let f x =
+       let g = Symbol f_closure in
+       ..
+   the variable g is bound to the symbol f_closure which
+   is the current closure.
+   The result of [function_variable_alias] will contain
+   the association [g -> f]
+*)
+let function_variable_alias
+    (function_decls : Flambda.function_declarations)
+    ~backend =
+  let fun_vars = Variable.Map.keys function_decls.funs in
+  let symbols_to_fun_vars =
+    let module Backend = (val backend : Backend_intf.S) in
+    Variable.Set.fold (fun fun_var symbols_to_fun_vars ->
+        let closure_id = Closure_id.wrap fun_var in
+        let symbol = Backend.closure_symbol closure_id in
+        Symbol.Map.add symbol fun_var symbols_to_fun_vars)
+      fun_vars
+      Symbol.Map.empty
+  in
+  let fun_var_bindings = ref Variable.Map.empty in
+  Variable.Map.iter (fun _ ( function_decl : Flambda.function_declaration ) ->
+      Flambda_iterators.iter_all_toplevel_immutable_let_and_let_rec_bindings
+        ~f:(fun var named ->
+           (* CR-soon mshinwell: consider having the body passed to this
+              function and using fv calculation instead of used_variables.
+              Need to be careful of "let rec" *)
+           match named with
+           | Symbol sym ->
+             begin match Symbol.Map.find sym symbols_to_fun_vars with
+             | exception Not_found -> ()
+             | fun_var ->
+               fun_var_bindings :=
+                 Variable.Map.add var fun_var !fun_var_bindings
+             end
+           | _ -> ())
+        function_decl.body)
+    function_decls.funs;
+  !fun_var_bindings
+
+let analyse_functions ~backend ~param_to_param
+      ~anything_to_param ~param_to_anywhere
+      (decls : Flambda.function_declarations) =
+  let function_variable_alias = function_variable_alias ~backend decls in
+  let param_indexes_by_fun_vars =
+    Variable.Map.map (fun (decl : Flambda.function_declaration) ->
+      Array.of_list (Parameter.List.vars decl.params))
+      decls.funs
+  in
+  let find_callee_arg ~callee ~callee_pos =
+    match Variable.Map.find callee param_indexes_by_fun_vars with
+    | exception Not_found -> None (* not a recursive call *)
+    | arr ->
+      (* Ignore overapplied parameters: they are applied to a different
+         function. *)
+      if callee_pos < Array.length arr then Some arr.(callee_pos)
+      else None
+  in
+  let escaping_functions = Variable.Tbl.create 13 in
+  let escaping_function fun_var =
+    let fun_var =
+      match Variable.Map.find fun_var function_variable_alias with
+      | exception Not_found -> fun_var
+      | fun_var -> fun_var
+    in
+    if Variable.Map.mem fun_var decls.funs
+    then Variable.Tbl.add escaping_functions fun_var ();
+  in
+  let used_variables = Variable.Tbl.create 42 in
+  let used_variable var = Variable.Tbl.add used_variables var () in
+  let relation = ref Variable.Pair.Map.empty in
+  (* If the called closure is in the current set of closures, record the
+     relation (callee, callee_arg) <- (caller, caller_arg) *)
+  let check_argument ~caller ~callee ~callee_pos ~caller_arg =
+    escaping_function caller_arg;
+    match find_callee_arg ~callee ~callee_pos with
+    | None -> used_variable caller_arg (* not a recursive call *)
+    | Some callee_arg ->
+      match Variable.Map.find caller decls.funs with
+      | exception Not_found ->
+        assert false
+      | { params } ->
+        let new_relation =
+          (* We only track dataflow for parameters of functions, not
+             arbitrary variables. *)
+          if List.exists
+              (fun param -> Variable.equal (Parameter.var param) caller_arg)
+              params
+          then
+            param_to_param ~caller ~caller_arg ~callee ~callee_arg !relation
+          else begin
+            used_variable caller_arg;
+            anything_to_param ~callee ~callee_arg !relation
+          end
+        in
+        relation := new_relation
+  in
+  let arity ~callee =
+    match Variable.Map.find callee decls.funs with
+    | exception Not_found -> 0
+    | func -> Flambda_utils.function_arity func
+  in
+  let check_expr ~caller (expr : Flambda.t) =
+    match expr with
+    | Apply { func; args } ->
+      used_variable func;
+      let callee =
+        match Variable.Map.find func function_variable_alias with
+        | exception Not_found -> func
+        | callee -> callee
+      in
+      let num_args = List.length args in
+      for callee_pos = num_args to (arity ~callee) - 1 do
+        (* If a function is partially applied, consider all missing
+           arguments as "anything". *)
+        match find_callee_arg ~callee ~callee_pos with
+        | None -> ()
+        | Some callee_arg ->
+          relation := anything_to_param ~callee ~callee_arg !relation
+      done;
+      List.iteri (fun callee_pos caller_arg ->
+          check_argument ~caller ~callee ~callee_pos ~caller_arg)
+        args
+    | _ -> ()
+  in
+  Variable.Map.iter (fun caller (decl : Flambda.function_declaration) ->
+      Flambda_iterators.iter (check_expr ~caller)
+        (fun (_ : Flambda.named) -> ())
+        decl.body;
+      Variable.Set.iter
+        (fun var -> escaping_function var; used_variable var)
+        (* CR-soon mshinwell: we should avoid recomputing this, cache in
+           [function_declaration].  See also comment on
+           [only_via_symbols] in [Flambda_utils]. *)
+        (Flambda.free_variables ~ignore_uses_as_callee:()
+           ~ignore_uses_as_argument:() decl.body))
+    decls.funs;
+  Variable.Map.iter
+    (fun func_var ({ params } : Flambda.function_declaration) ->
+       List.iter
+         (fun (param : Parameter.t) ->
+            if Variable.Tbl.mem used_variables (Parameter.var param) then
+              relation :=
+                param_to_anywhere ~caller:func_var
+                  ~caller_arg:(Parameter.var param) !relation;
+            if Variable.Tbl.mem escaping_functions func_var then
+              relation :=
+                anything_to_param ~callee:func_var
+                  ~callee_arg:(Parameter.var param) !relation)
+         params)
+    decls.funs;
+  transitive_closure !relation
+
+
+(* A parameter [x] of the function [f] is considered as unchanging if
+   during an 'external' (call from outside the set of closures) call of
+   [f], every recursive call of [f] all the instances of [x] are aliased
+   to the original one.  This function computes an underapproximation of
+   that set by computing the flow of parameters between the different
+   functions of the set of closures.
+
+   We record [(f, x) <- (g, y)] when the function g calls f and
+   the y parameter of g is used as argument for the x parameter of f. For
+   instance in
+
+     let rec f x = ...
+     and g y = f x
+
+   We record [(f, x) <- Top] when some unknown values can flow to the
+   [y] parameter.
+
+     let rec f x = f 1
+
+   We record also [(f, x) <- Top] if [f] could escape. This is over
+   approximated by considering that a function escape when its variable is used
+   for something else than an application:
+
+     let rec f x = (f, f)
+
+   [x] is not unchanging if either
+      (f, x) <- Top
+   or (f, x) <- (f, y) with x != y
+
+   Notice that having (f, x) <- (g, a) and (f, x) <- (g, b) does not make
+   x not unchanging. This is because (g, a) and (g, b) represent necessarily
+   different values only if g is the externaly called function. If some
+   value where created during the execution of the function that could
+   flow to (g, a), then (g, a) <- Top, so (f, x) <- Top.
+
+ *)
+
+let invariant_params_in_recursion (decls : Flambda.function_declarations)
+      ~backend =
+  let param_to_param ~caller ~caller_arg ~callee ~callee_arg relation =
+    implies relation (caller, caller_arg) (callee, callee_arg)
+  in
+  let anything_to_param ~callee ~callee_arg relation =
+    top relation (callee, callee_arg)
+  in
+  let param_to_anywhere ~caller:_ ~caller_arg:_ relation = relation in
+  let relation =
+    analyse_functions ~backend ~param_to_param
+      ~anything_to_param ~param_to_anywhere
+      decls
+  in
+  let not_unchanging =
+    Variable.Pair.Map.fold (fun (func, var) set not_unchanging ->
+        match set with
+        | Top -> Variable.Set.add var not_unchanging
+        | Implication set ->
+          if Variable.Pair.Set.exists (fun (func', var') ->
+              Variable.equal func func' && not (Variable.equal var var'))
+              set
+          then Variable.Set.add var not_unchanging
+          else not_unchanging)
+      relation Variable.Set.empty
+  in
+  let params = Variable.Map.fold (fun _
+        ({ params } : Flambda.function_declaration) set ->
+      Variable.Set.union (Parameter.Set.vars params) set)
+    decls.funs Variable.Set.empty
+  in
+  let unchanging = Variable.Set.diff params not_unchanging in
+  let aliased_to =
+    Variable.Pair.Map.fold (fun (_, var) set aliases ->
+        match set with
+        | Implication set
+          when Variable.Set.mem var unchanging ->
+            Variable.Pair.Set.fold (fun (_, caller_args) aliases ->
+                if Variable.Set.mem caller_args unchanging then
+                  let alias_set =
+                    match Variable.Map.find caller_args aliases with
+                    | exception Not_found ->
+                      Variable.Set.singleton var
+                    | alias_set ->
+                      Variable.Set.add var alias_set
+                  in
+                  Variable.Map.add caller_args alias_set aliases
+                else
+                  aliases)
+              set aliases
+        | Top | Implication _ -> aliases)
+      relation Variable.Map.empty
+  in
+  (* We complete the set of aliases such that there does not miss any
+     unchanging param *)
+  Variable.Map.of_set (fun var ->
+      match Variable.Map.find var aliased_to with
+      | exception Not_found -> Variable.Set.empty
+      | set -> set)
+    unchanging
+
+let invariant_param_sources decls ~backend =
+  let param_to_param ~caller ~caller_arg ~callee ~callee_arg relation =
+    implies relation (caller, caller_arg) (callee, callee_arg)
+  in
+  let anything_to_param ~callee:_ ~callee_arg:_ relation = relation in
+  let param_to_anywhere ~caller:_ ~caller_arg:_ relation = relation in
+  let relation =
+    analyse_functions ~backend ~param_to_param
+      ~anything_to_param ~param_to_anywhere
+      decls
+  in
+  Variable.Pair.Map.fold (fun (_, var) set relation ->
+      match set with
+      | Top -> relation
+      | Implication set -> Variable.Map.add var set relation)
+    relation Variable.Map.empty
+
+let pass_name = "unused-arguments"
+let () = Clflags.all_passes := pass_name :: !Clflags.all_passes
+
+let unused_arguments (decls : Flambda.function_declarations) ~backend =
+  let dump = Clflags.dumped_pass pass_name in
+  let param_to_param ~caller ~caller_arg ~callee ~callee_arg relation =
+    implies relation (callee, callee_arg) (caller, caller_arg)
+  in
+  let anything_to_param ~callee:_ ~callee_arg:_ relation = relation in
+  let param_to_anywhere ~caller ~caller_arg relation =
+    top relation (caller, caller_arg)
+  in
+  let relation =
+    analyse_functions ~backend ~param_to_param
+      ~anything_to_param ~param_to_anywhere
+      decls
+  in
+  let arguments =
+    Variable.Map.fold
+      (fun fun_var decl acc ->
+         List.fold_left
+           (fun acc param ->
+              match Variable.Pair.Map.find (fun_var, param) relation with
+              | exception Not_found -> Variable.Set.add param acc
+              | Implication _ -> Variable.Set.add param acc
+              | Top -> acc)
+           acc (Parameter.List.vars decl.Flambda.params))
+      decls.funs Variable.Set.empty
+  in
+  if dump then begin
+    Format.printf "Unused arguments: %a@." Variable.Set.print arguments
+  end;
+  arguments
diff --git a/middle_end/flambda/invariant_params.mli b/middle_end/flambda/invariant_params.mli
new file mode 100644
index 00000000..c6851420
--- /dev/null
+++ b/middle_end/flambda/invariant_params.mli
@@ -0,0 +1,57 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(* [invariant_params_in_recursion] calculates the set of parameters whose
+   values are known not to change during the execution of a recursive
+   function.  As such, occurrences of the parameters may always be replaced
+   by the corresponding values.
+
+   For example, [x] would be in [invariant_params] for both of the following
+   functions:
+
+     let rec f x y = (f x y) + (f x (y+1))
+
+     let rec f x l = List.iter (f x) l
+
+   For invariant parameters it also computes the set of parameters of functions
+   in the set of closures that are always aliased to it. For example in the set
+   of closures:
+
+     let rec f x y = (f x y) + (f x (y+1)) + g x
+     and g z = z + 1
+
+   The map of aliases is
+
+     x -> { x; z }
+*)
+val invariant_params_in_recursion
+   : Flambda.function_declarations
+  -> backend:(module Backend_intf.S)
+  -> Variable.Set.t Variable.Map.t
+
+val invariant_param_sources
+   : Flambda.function_declarations
+  -> backend:(module Backend_intf.S)
+  -> Variable.Pair.Set.t Variable.Map.t
+
+(* CR-soon mshinwell: think about whether this function should
+   be in this file.  Should it be called "unused_parameters"? *)
+val unused_arguments
+   : Flambda.function_declarations
+  -> backend:(module Backend_intf.S)
+  -> Variable.Set.t
diff --git a/middle_end/flambda/lift_code.ml b/middle_end/flambda/lift_code.ml
new file mode 100644
index 00000000..3474b06b
--- /dev/null
+++ b/middle_end/flambda/lift_code.ml
@@ -0,0 +1,182 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+type lifter = Flambda.program -> Flambda.program
+
+type def =
+  | Immutable of Variable.t * Flambda.named Flambda.With_free_variables.t
+  | Mutable of Mutable_variable.t * Variable.t * Lambda.value_kind
+
+let rebuild_let (defs : def list) (body : Flambda.t) =
+  let module W = Flambda.With_free_variables in
+  List.fold_left (fun body def ->
+    match def with
+    | Immutable(var, def) ->
+        W.create_let_reusing_defining_expr var def body
+    | Mutable(var, initial_value, contents_kind) ->
+        Flambda.Let_mutable {var; initial_value; contents_kind; body})
+    body defs
+
+let rec extract_let_expr (acc:def list) (let_expr:Flambda.let_expr) :
+  def list * Flambda.t Flambda.With_free_variables.t =
+  let module W = Flambda.With_free_variables in
+  let acc =
+    match let_expr with
+    | { var = v1; defining_expr = Expr (Let let2); _ } ->
+        let acc, body2 = extract_let_expr acc let2 in
+        Immutable(v1, W.expr body2) :: acc
+    | { var = v1; defining_expr = Expr (Let_mutable let_mut); _ } ->
+        let acc, body2 = extract_let_mutable acc let_mut in
+        Immutable(v1, W.expr body2) :: acc
+    | { var = v; _ } ->
+        Immutable(v, W.of_defining_expr_of_let let_expr) :: acc
+  in
+  let body = W.of_body_of_let let_expr in
+  extract acc body
+
+and extract_let_mutable acc (let_mut : Flambda.let_mutable) =
+  let module W = Flambda.With_free_variables in
+  let { Flambda.var; initial_value; contents_kind; body } = let_mut in
+  let acc = Mutable(var, initial_value, contents_kind) :: acc in
+  extract acc (W.of_expr body)
+
+and extract acc (expr : Flambda.t Flambda.With_free_variables.t) =
+  let module W = Flambda.With_free_variables in
+  match W.contents expr with
+  | Let let_expr ->
+    extract_let_expr acc let_expr
+  | Let_mutable let_mutable ->
+    extract_let_mutable acc let_mutable
+  | _ ->
+    acc, expr
+
+let rec lift_lets_expr (expr:Flambda.t) ~toplevel : Flambda.t =
+  let module W = Flambda.With_free_variables in
+  match expr with
+  | Let let_expr ->
+    let defs, body = extract_let_expr [] let_expr in
+    let rev_defs = List.rev_map (lift_lets_def ~toplevel) defs in
+    let body = lift_lets_expr (W.contents body) ~toplevel in
+    rebuild_let (List.rev rev_defs) body
+  | Let_mutable let_mut ->
+    let defs, body = extract_let_mutable [] let_mut in
+    let rev_defs = List.rev_map (lift_lets_def ~toplevel) defs in
+    let body = lift_lets_expr (W.contents body) ~toplevel in
+    rebuild_let (List.rev rev_defs) body
+  | e ->
+    Flambda_iterators.map_subexpressions
+      (lift_lets_expr ~toplevel)
+      (lift_lets_named ~toplevel)
+      e
+
+and lift_lets_def def ~toplevel =
+  let module W = Flambda.With_free_variables in
+  match def with
+  | Mutable _ -> def
+  | Immutable(var, named) ->
+    let named =
+      match W.contents named with
+      | Expr e -> W.expr (W.of_expr (lift_lets_expr e ~toplevel))
+      | Set_of_closures set when not toplevel ->
+        W.of_named
+          (Set_of_closures
+             (Flambda_iterators.map_function_bodies
+                ~f:(lift_lets_expr ~toplevel) set))
+      | Symbol _ | Const _ | Allocated_const _ | Read_mutable _
+      | Read_symbol_field (_, _) | Project_closure _
+      | Move_within_set_of_closures _ | Project_var _
+      | Prim _ | Set_of_closures _ ->
+        named
+    in
+    Immutable(var, named)
+
+and lift_lets_named _var (named:Flambda.named) ~toplevel : Flambda.named =
+  match named with
+  | Expr e ->
+    Expr (lift_lets_expr e ~toplevel)
+  | Set_of_closures set when not toplevel ->
+    Set_of_closures
+      (Flambda_iterators.map_function_bodies ~f:(lift_lets_expr ~toplevel) set)
+  | Symbol _ | Const _ | Allocated_const _ | Read_mutable _
+  | Read_symbol_field (_, _) | Project_closure _ | Move_within_set_of_closures _
+  | Project_var _ | Prim _ | Set_of_closures _ ->
+    named
+
+module Sort_lets = Strongly_connected_components.Make (Variable)
+
+let rebuild_let_rec (defs:(Variable.t * Flambda.named) list) body =
+  let map = Variable.Map.of_list defs in
+  let graph =
+    Variable.Map.map
+      (fun named ->
+         Variable.Set.filter (fun v -> Variable.Map.mem v map)
+           (Flambda.free_variables_named named))
+      map
+  in
+  let components =
+    Sort_lets.connected_components_sorted_from_roots_to_leaf graph
+  in
+  Array.fold_left (fun body (component:Sort_lets.component) ->
+      match component with
+      | No_loop v ->
+          let def = Variable.Map.find v map in
+          Flambda.create_let v def body
+      | Has_loop l ->
+          Flambda.Let_rec
+            (List.map (fun v -> v, Variable.Map.find v map) l,
+             body))
+    body components
+
+let lift_let_rec program =
+  Flambda_iterators.map_exprs_at_toplevel_of_program program
+    ~f:(Flambda_iterators.map_expr
+          (fun expr -> match expr with
+             | Let_rec (defs, body) ->
+                 rebuild_let_rec defs body
+             | expr -> expr))
+
+let lift_lets program =
+  let program = lift_let_rec program in
+  Flambda_iterators.map_exprs_at_toplevel_of_program program
+    ~f:(lift_lets_expr ~toplevel:false)
+
+let lifting_helper exprs ~evaluation_order ~create_body ~name =
+  let vars, lets =
+    (* [vars] corresponds elementwise to [exprs]; the order is unchanged. *)
+    List.fold_right (fun (flam : Flambda.t) (vars, lets) ->
+        match flam with
+        | Var v ->
+          (* Note that [v] is (statically) always an immutable variable. *)
+          v::vars, lets
+        | expr ->
+          let v =
+            Variable.create name ~current_compilation_unit:
+                (Compilation_unit.get_current_exn ())
+          in
+          v::vars, (v, expr)::lets)
+      exprs ([], [])
+  in
+  let lets =
+    match evaluation_order with
+    | `Right_to_left -> lets
+    | `Left_to_right -> List.rev lets
+  in
+  List.fold_left (fun body (v, expr) ->
+      Flambda.create_let v (Expr expr) body)
+    (create_body vars) lets
diff --git a/middle_end/flambda/lift_code.mli b/middle_end/flambda/lift_code.mli
new file mode 100644
index 00000000..92ecda01
--- /dev/null
+++ b/middle_end/flambda/lift_code.mli
@@ -0,0 +1,43 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+type lifter = Flambda.program -> Flambda.program
+
+(** Lift [let] bindings to attempt to increase the length of scopes, as an
+    aid to further optimizations.  For example:
+      let c = let b =  in b, b in fst c
+    would be transformed to:
+      let b =  in let c = b, b in fst c
+    which is then clearly just:
+      
+*)
+val lift_lets : lifter
+
+val lift_lets_expr : Flambda.t -> toplevel:bool -> Flambda.t
+
+(* CR-someday mshinwell: Rename to [bind]?  Also see Flambda_utils.bind. *)
+(* [create_body] always receives the variables corresponding to [evaluate]
+   in the same order.  However [evaluation_order] specifies in which order
+   the (possibly complex) expressions bound to those variables are
+   evaluated. *)
+val lifting_helper
+   : Flambda.t list
+  -> evaluation_order:[ `Left_to_right | `Right_to_left ]
+  -> create_body:(Variable.t list -> Flambda.t)
+  -> name:Internal_variable_names.t
+  -> Flambda.t
diff --git a/middle_end/flambda/lift_constants.ml b/middle_end/flambda/lift_constants.ml
new file mode 100644
index 00000000..dd60de9c
--- /dev/null
+++ b/middle_end/flambda/lift_constants.ml
@@ -0,0 +1,1019 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+(* CR-someday mshinwell: move to Flambda_utils *)
+let rec tail_variable : Flambda.t -> Variable.t option = function
+  | Var v -> Some v
+  | Let_rec (_, e)
+  | Let_mutable { body = e }
+  | Let { body = e; _ } -> tail_variable e
+  | _ -> None
+
+let closure_symbol ~(backend : (module Backend_intf.S)) closure_id =
+  let module Backend = (val backend) in
+  Backend.closure_symbol closure_id
+
+(** Traverse the given expression assigning symbols to [let]- and [let rec]-
+    bound constant variables.  At the same time collect the definitions of
+    such variables. *)
+let assign_symbols_and_collect_constant_definitions
+    ~(backend : (module Backend_intf.S))
+    ~(program : Flambda.program)
+    ~(inconstants : Inconstant_idents.result) =
+  let var_to_symbol_tbl = Variable.Tbl.create 42 in
+  let var_to_definition_tbl = Variable.Tbl.create 42 in
+  let module AA = Alias_analysis in
+  let assign_symbol var (named : Flambda.named) =
+    if not (Inconstant_idents.variable var inconstants) then begin
+      let assign_symbol () =
+        let symbol = Symbol.of_variable (Variable.rename var) in
+        Variable.Tbl.add var_to_symbol_tbl var symbol
+      in
+      let assign_existing_symbol = Variable.Tbl.add var_to_symbol_tbl var in
+      let record_definition = Variable.Tbl.add var_to_definition_tbl var in
+      match named with
+      | Symbol symbol ->
+        assign_existing_symbol symbol;
+        record_definition (AA.Symbol symbol)
+      | Const const -> record_definition (AA.Const const)
+      | Allocated_const const ->
+        assign_symbol ();
+        record_definition (AA.Allocated_const (Normal const))
+      | Read_mutable _ ->
+        (* [Inconstant_idents] always marks these expressions as
+           inconstant, so we should never get here. *)
+        assert false
+      | Prim (Pmakeblock (tag, _, _value_kind), fields, _) ->
+        assign_symbol ();
+        record_definition (AA.Block (Tag.create_exn tag, fields))
+      | Read_symbol_field (symbol, field) ->
+        record_definition (AA.Symbol_field (symbol, field))
+      | Set_of_closures (
+          { function_decls = { funs; set_of_closures_id; _ };
+            _ } as set) ->
+        assert (not (Inconstant_idents.closure set_of_closures_id
+                       inconstants));
+        assign_symbol ();
+        record_definition (AA.Set_of_closures set);
+        Variable.Map.iter (fun fun_var _ ->
+            let closure_id = Closure_id.wrap fun_var in
+            let closure_symbol = closure_symbol ~backend closure_id in
+            Variable.Tbl.add var_to_symbol_tbl fun_var closure_symbol;
+            let project_closure =
+              Alias_analysis.Project_closure
+                { set_of_closures = var; closure_id }
+            in
+            Variable.Tbl.add var_to_definition_tbl fun_var
+              project_closure)
+          funs
+      | Move_within_set_of_closures ({ closure = _; start_from = _; move_to; }
+          as move) ->
+        assign_existing_symbol (closure_symbol ~backend  move_to);
+        record_definition (AA.Move_within_set_of_closures move)
+      | Project_closure ({ closure_id } as project_closure) ->
+        assign_existing_symbol (closure_symbol ~backend  closure_id);
+        record_definition (AA.Project_closure project_closure)
+      | Prim (Pfield index, [block], _) ->
+        record_definition (AA.Field (block, index))
+      | Prim (Pfield _, _, _) ->
+        Misc.fatal_errorf "[Pfield] with the wrong number of arguments"
+          Flambda.print_named named
+      | Prim (Pmakearray (Pfloatarray as kind, mutability), args, _) ->
+        assign_symbol ();
+        record_definition (AA.Allocated_const (Array (kind, mutability, args)))
+      | Prim (Pduparray (kind, mutability), [arg], _) ->
+        assign_symbol ();
+        record_definition (AA.Allocated_const (
+          Duplicate_array (kind, mutability, arg)))
+      | Prim _ ->
+        Misc.fatal_errorf "Primitive not expected to be constant: @.%a@."
+          Flambda.print_named named
+      | Project_var project_var ->
+        record_definition (AA.Project_var project_var)
+      | Expr e ->
+        match tail_variable e with
+        | None -> assert false  (* See [Inconstant_idents]. *)
+        | Some v -> record_definition (AA.Variable v)
+    end
+  in
+  let assign_symbol_program expr =
+    Flambda_iterators.iter_all_immutable_let_and_let_rec_bindings expr
+      ~f:assign_symbol
+  in
+  Flambda_iterators.iter_exprs_at_toplevel_of_program program
+    ~f:assign_symbol_program;
+  let let_symbol_to_definition_tbl = Symbol.Tbl.create 42 in
+  let initialize_symbol_to_definition_tbl = Symbol.Tbl.create 42 in
+  let rec collect_let_and_initialize_symbols (program : Flambda.program_body) =
+    match program with
+    | Let_symbol (symbol, decl, program) ->
+      Symbol.Tbl.add let_symbol_to_definition_tbl symbol decl;
+      collect_let_and_initialize_symbols program
+    | Let_rec_symbol (decls, program) ->
+      List.iter (fun (symbol, decl) ->
+          Symbol.Tbl.add let_symbol_to_definition_tbl symbol decl)
+        decls;
+      collect_let_and_initialize_symbols program
+    | Effect (_, program) -> collect_let_and_initialize_symbols program
+    | Initialize_symbol (symbol,_tag,fields,program) ->
+      collect_let_and_initialize_symbols program;
+      let fields = List.map tail_variable fields in
+      Symbol.Tbl.add initialize_symbol_to_definition_tbl symbol fields
+    | End _ -> ()
+  in
+  collect_let_and_initialize_symbols program.program_body;
+  let record_set_of_closure_equalities
+        (set_of_closures : Flambda.set_of_closures) =
+    Variable.Map.iter (fun arg (var : Flambda.specialised_to) ->
+        if not (Inconstant_idents.variable arg inconstants) then
+          Variable.Tbl.add var_to_definition_tbl arg (AA.Variable var.var))
+      set_of_closures.free_vars;
+    Variable.Map.iter (fun arg (spec_to : Flambda.specialised_to) ->
+        if not (Inconstant_idents.variable arg inconstants) then
+          Variable.Tbl.add var_to_definition_tbl arg
+            (AA.Variable spec_to.var))
+      set_of_closures.specialised_args
+  in
+  Flambda_iterators.iter_on_set_of_closures_of_program program
+    ~f:(fun ~constant set_of_closures ->
+      record_set_of_closure_equalities set_of_closures;
+      if constant then begin
+        Variable.Map.iter (fun fun_var _ ->
+            let closure_id = Closure_id.wrap fun_var in
+            let closure_symbol = closure_symbol ~backend closure_id in
+            Variable.Tbl.add var_to_definition_tbl fun_var
+              (AA.Symbol closure_symbol);
+            Variable.Tbl.add var_to_symbol_tbl fun_var closure_symbol)
+          set_of_closures.Flambda.function_decls.funs
+      end);
+  var_to_symbol_tbl, var_to_definition_tbl,
+    let_symbol_to_definition_tbl, initialize_symbol_to_definition_tbl
+
+let variable_field_definition
+    (var_to_symbol_tbl : Symbol.t Variable.Tbl.t)
+    (var_to_definition_tbl :
+      Alias_analysis.constant_defining_value Variable.Tbl.t)
+    (var : Variable.t) : Flambda.constant_defining_value_block_field =
+  try
+    Symbol (Variable.Tbl.find var_to_symbol_tbl var)
+  with Not_found ->
+    match Variable.Tbl.find var_to_definition_tbl var with
+    | Const c -> Const c
+    | const_defining_value ->
+      Misc.fatal_errorf "Unexpected pattern for a constant: %a: %a"
+        Variable.print var
+        Alias_analysis.print_constant_defining_value const_defining_value
+    | exception Not_found ->
+      Misc.fatal_errorf "No associated symbol for the constant %a"
+        Variable.print var
+
+let resolve_variable
+    (aliases : Alias_analysis.allocation_point Variable.Map.t)
+    (var_to_symbol_tbl : Symbol.t Variable.Tbl.t)
+    (var_to_definition_tbl :
+      Alias_analysis.constant_defining_value Variable.Tbl.t)
+    (var : Variable.t) : Flambda.constant_defining_value_block_field =
+  match Variable.Map.find var aliases with
+  | exception Not_found ->
+    variable_field_definition var_to_symbol_tbl var_to_definition_tbl var
+  | Symbol s -> Symbol s
+  | Variable aliased_variable ->
+    variable_field_definition var_to_symbol_tbl var_to_definition_tbl
+      aliased_variable
+
+let translate_set_of_closures
+    (inconstants : Inconstant_idents.result)
+    (aliases : Alias_analysis.allocation_point Variable.Map.t)
+    (var_to_symbol_tbl : Symbol.t Variable.Tbl.t)
+    (var_to_definition_tbl:
+      Alias_analysis.constant_defining_value Variable.Tbl.t)
+    (set_of_closures : Flambda.set_of_closures) =
+  let f var (named : Flambda.named) : Flambda.named =
+    if Inconstant_idents.variable var inconstants then
+      named
+    else
+      let resolved =
+        resolve_variable
+          aliases
+          var_to_symbol_tbl
+          var_to_definition_tbl
+          var
+      in
+      match resolved with
+      | Symbol s -> Symbol s
+      | Const c -> Const c
+  in
+  Flambda_iterators.map_function_bodies set_of_closures
+    ~f:(Flambda_iterators.map_all_immutable_let_and_let_rec_bindings ~f)
+
+let translate_constant_set_of_closures
+    (inconstants : Inconstant_idents.result)
+    (aliases : Alias_analysis.allocation_point Variable.Map.t)
+    (var_to_symbol_tbl : Symbol.t Variable.Tbl.t)
+    (var_to_definition_tbl:
+      Alias_analysis.constant_defining_value Variable.Tbl.t)
+    (constant_defining_values : Flambda.constant_defining_value Symbol.Map.t) =
+  Symbol.Map.map (fun (const : Flambda.constant_defining_value) ->
+      match const with
+      | Flambda.Allocated_const _
+      | Flambda.Block _
+      | Flambda.Project_closure _ ->
+        const
+      | Flambda.Set_of_closures set_of_closures ->
+        let set_of_closures =
+          translate_set_of_closures
+            (inconstants : Inconstant_idents.result)
+            (aliases : Alias_analysis.allocation_point Variable.Map.t)
+            (var_to_symbol_tbl : Symbol.t Variable.Tbl.t)
+            (var_to_definition_tbl:
+              Alias_analysis.constant_defining_value Variable.Tbl.t)
+            (set_of_closures : Flambda.set_of_closures)
+        in
+        Flambda.Set_of_closures set_of_closures)
+    constant_defining_values
+
+let find_original_set_of_closure
+    (aliases : Alias_analysis.allocation_point Variable.Map.t)
+    (var_to_symbol_tbl : Symbol.t Variable.Tbl.t)
+    (var_to_definition_tbl:
+      Alias_analysis.constant_defining_value Variable.Tbl.t)
+    project_closure_map
+    var =
+  let rec loop var =
+    match Variable.Map.find var aliases with
+    | Variable var ->
+      begin match Variable.Tbl.find var_to_definition_tbl var with
+        | Project_closure { set_of_closures = var }
+        | Move_within_set_of_closures { closure = var } ->
+          loop var
+        | Set_of_closures _ -> begin
+            match Variable.Tbl.find var_to_symbol_tbl var with
+            | s ->
+              s
+            | exception Not_found ->
+              Format.eprintf "var: %a@." Variable.print var;
+              assert false
+          end
+        | _ -> assert false
+      end
+    | Symbol s ->
+      match Symbol.Map.find s project_closure_map with
+      | exception Not_found ->
+        Misc.fatal_errorf "find_original_set_of_closure: cannot find \
+            symbol %a in the project-closure map"
+          Symbol.print s
+      | s -> s
+  in
+  loop var
+
+let translate_definition_and_resolve_alias inconstants
+    (aliases : Alias_analysis.allocation_point Variable.Map.t)
+    (var_to_symbol_tbl : Symbol.t Variable.Tbl.t)
+    (var_to_definition_tbl :
+      Alias_analysis.constant_defining_value Variable.Tbl.t)
+    (symbol_definition_map : Flambda.constant_defining_value Symbol.Map.t)
+    (project_closure_map : Symbol.t Symbol.Map.t)
+    (definition : Alias_analysis.constant_defining_value)
+    ~(backend : (module Backend_intf.S))
+    : Flambda.constant_defining_value option =
+  let resolve_float_array_involving_variables
+        ~(mutability : Asttypes.mutable_flag) ~vars =
+    (* Resolve an [Allocated_const] of the form:
+        [Array (Pfloatarray, _, _)]
+       (which references its contents via variables; it does not contain
+        manifest floats). *)
+    let find_float_var_definition var =
+      match Variable.Tbl.find var_to_definition_tbl var with
+      | Allocated_const (Normal (Float f)) -> f
+      | const_defining_value ->
+          Misc.fatal_errorf "Bad definition for float array member %a: %a"
+            Variable.print var
+            Alias_analysis.print_constant_defining_value
+            const_defining_value
+    in
+    let find_float_symbol_definition sym =
+      match Symbol.Map.find sym symbol_definition_map with
+      | Allocated_const (Float f) -> f
+      | const_defining_value ->
+          Misc.fatal_errorf "Bad definition for float array member %a: %a"
+            Symbol.print sym
+            Flambda.print_constant_defining_value
+            const_defining_value
+    in
+    let floats =
+      List.map (fun var ->
+          match Variable.Map.find var aliases with
+          | exception Not_found -> find_float_var_definition var
+          | Variable var -> find_float_var_definition var
+          | Symbol sym -> find_float_symbol_definition sym)
+        vars
+    in
+    let const : Allocated_const.t =
+      match mutability with
+      | Immutable -> Immutable_float_array floats
+      | Mutable -> Float_array floats
+    in
+    Some (Flambda.Allocated_const const)
+  in
+  match definition with
+  | Block (tag, fields) ->
+    Some (Flambda.Block (tag,
+      List.map (resolve_variable aliases var_to_symbol_tbl
+          var_to_definition_tbl)
+        fields))
+  | Allocated_const (Normal const) -> Some (Flambda.Allocated_const const)
+  | Allocated_const (Duplicate_array (Pfloatarray, mutability, var)) ->
+    (* CR-someday mshinwell: This next section could do with cleanup.
+       What happens is:
+        - Duplicate contains a variable, which is resolved to
+        a float array thing full of variables;
+        - We send that value back through this function again so the
+        individual members of that array are resolved from variables to
+        floats.
+        - Then we can build the Flambda.name term containing the
+        Allocated_const (full of floats).
+       We should maybe factor out the code from the
+       Allocated_const (Array (...)) case below so this function doesn't have
+       to be recursive. *)
+    let (constant_defining_value : Alias_analysis.constant_defining_value) =
+      match Variable.Map.find var aliases with
+      | exception Not_found ->
+        Variable.Tbl.find var_to_definition_tbl var
+      | Variable var ->
+        Variable.Tbl.find var_to_definition_tbl var
+      | Symbol sym ->
+        match Symbol.Map.find sym symbol_definition_map with
+        | Allocated_const ((Immutable_float_array _) as const) ->
+          Alias_analysis.Allocated_const (Normal const)
+        | (Allocated_const _ | Block _ | Set_of_closures _
+            | Project_closure _) as wrong ->
+          Misc.fatal_errorf
+            "Lift_constants.translate_definition_and_resolve_alias: \
+              Duplicate Pfloatarray %a with symbol %a mapping to \
+              wrong constant defining value %a"
+            Variable.print var
+            Alias_analysis.print_constant_defining_value definition
+            Flambda.print_constant_defining_value wrong
+        | exception Not_found ->
+          let module Backend = (val backend) in
+          match (Backend.import_symbol sym).descr with
+          | Value_unresolved _ ->
+            Misc.fatal_errorf
+              "Lift_constants.translate_definition_and_resolve_alias: \
+               Duplicate Pfloatarray %a with unknown symbol: %a"
+              Variable.print var
+              Alias_analysis.print_constant_defining_value definition
+          | Value_float_array value_float_array ->
+            let contents =
+              Simple_value_approx.float_array_as_constant value_float_array
+            in
+            begin match contents with
+            | None ->
+              Misc.fatal_errorf
+                "Lift_constants.translate_definition_and_resolve_alias: \
+                 Duplicate Pfloatarray %a with not completely known float \
+                 array from symbol: %a"
+                Variable.print var
+                Alias_analysis.print_constant_defining_value definition
+            | Some l ->
+              Alias_analysis.Allocated_const (Normal (Immutable_float_array l))
+            end
+          | wrong ->
+            (* CR-someday mshinwell: we might hit this if we ever duplicate
+               a mutable array across compilation units (e.g. "snapshotting"
+               an array).  We do not currently generate such code. *)
+            Misc.fatal_errorf
+              "Lift_constants.translate_definition_and_resolve_alias: \
+               Duplicate Pfloatarray %a with symbol %a that does not \
+               have an export description of an immutable array"
+              Variable.print var
+              Alias_analysis.print_constant_defining_value definition
+              Simple_value_approx.print_descr wrong
+    in
+    begin match constant_defining_value with
+    | Allocated_const (Normal (Float_array _)) ->
+      (* This example from pchambart illustrates why we do not allow
+         the duplication of mutable arrays:
+
+         {|
+         let_symbol a = Allocated_const (Immutable_float_array [|0.|])
+         initialize_symbol b = Duparray(Mutable, a)
+         effect b.(0) <- 1.
+         initialize_symbol c = Duparray(Mutable, b)
+         |}
+
+         This will be converted to:
+         {|
+         let_symbol a = Allocated_const (Immutable_float_array [|0.|])
+         let_symbol b = Allocated_const (Float_array [|0.|])
+         effect b.(0) <- 1.
+         let_symbol c = Allocated_const (Float_array [|0.|])
+         |}
+
+         We can't encounter that currently, but it's scary.
+      *)
+      Misc.fatal_error "Pduparray is not allowed on mutable arrays"
+    | Allocated_const (Normal (Immutable_float_array floats)) ->
+      let const : Allocated_const.t =
+        match mutability with
+        | Immutable -> Immutable_float_array floats
+        | Mutable -> Float_array floats
+      in
+      Some (Flambda.Allocated_const const)
+    | Allocated_const (Array (Pfloatarray, _, vars)) ->
+      (* Important: [mutability] is from the [Duplicate_array]
+         construction above. *)
+      resolve_float_array_involving_variables ~mutability ~vars
+    | const ->
+      Misc.fatal_errorf
+        "Lift_constants.translate_definition_and_resolve_alias: \
+          Duplicate Pfloatarray %a with wrong argument: %a"
+        Variable.print var
+        Alias_analysis.print_constant_defining_value const
+    end
+  | Allocated_const (Duplicate_array (_, _, _)) ->
+    Misc.fatal_errorf "Lift_constants.translate_definition_and_resolve_alias: \
+        Duplicate_array with non-Pfloatarray kind: %a"
+      Alias_analysis.print_constant_defining_value definition
+  | Allocated_const (Array (Pfloatarray, mutability, vars)) ->
+    resolve_float_array_involving_variables ~mutability ~vars
+  | Allocated_const (Array (_, _, _)) ->
+    Misc.fatal_errorf "Lift_constants.translate_definition_and_resolve_alias: \
+        Array with non-Pfloatarray kind: %a"
+      Alias_analysis.print_constant_defining_value definition
+  | Project_closure { set_of_closures; closure_id } ->
+    begin match Variable.Map.find set_of_closures aliases with
+    | Symbol s ->
+      Some (Flambda.Project_closure (s, closure_id))
+    (* If a closure projection is a constant, the set of closures must
+       be assigned to a symbol. *)
+    | exception Not_found ->
+      assert false
+    | Variable v ->
+      match Variable.Tbl.find var_to_symbol_tbl v with
+      | s ->
+        Some (Flambda.Project_closure (s, closure_id))
+      | exception Not_found ->
+        Format.eprintf "var: %a@." Variable.print v;
+        assert false
+    end
+  | Move_within_set_of_closures { closure; move_to } ->
+    let set_of_closure_symbol =
+      find_original_set_of_closure
+        aliases
+        var_to_symbol_tbl
+        var_to_definition_tbl
+        project_closure_map
+        closure
+    in
+    Some (Flambda.Project_closure (set_of_closure_symbol, move_to))
+  | Set_of_closures set_of_closures ->
+    let set_of_closures =
+      translate_set_of_closures
+        inconstants
+        aliases
+        var_to_symbol_tbl
+        var_to_definition_tbl
+        set_of_closures
+    in
+    Some (Flambda.Set_of_closures set_of_closures)
+  | Project_var _ -> None
+  | Field (_,_) | Symbol_field _ -> None
+  | Const _ -> None
+  | Symbol _ -> None
+  | Variable _ -> None
+
+let translate_definitions_and_resolve_alias
+    inconstants
+    (aliases : Alias_analysis.allocation_point Variable.Map.t)
+    (var_to_symbol_tbl : Symbol.t Variable.Tbl.t)
+    (var_to_definition_tbl:
+      Alias_analysis.constant_defining_value Variable.Tbl.t)
+    symbol_definition_map
+    project_closure_map
+    ~backend =
+  Variable.Tbl.fold (fun var def map ->
+      match
+        translate_definition_and_resolve_alias inconstants aliases ~backend
+          var_to_symbol_tbl var_to_definition_tbl symbol_definition_map
+          project_closure_map def
+      with
+      | None -> map
+      | Some def ->
+        let symbol = Variable.Tbl.find var_to_symbol_tbl var in
+        Symbol.Map.add symbol def map)
+    var_to_definition_tbl Symbol.Map.empty
+
+(* Resorting of graph including Initialize_symbol *)
+let constant_dependencies ~backend:_
+        (const : Flambda.constant_defining_value) =
+  match const with
+  | Allocated_const _ -> Symbol.Set.empty
+  | Block (_, fields) ->
+    let symbol_fields =
+      List.filter_map
+        (function
+          | (Symbol s : Flambda.constant_defining_value_block_field) -> Some s
+          | Flambda.Const _ -> None)
+        fields
+    in
+    Symbol.Set.of_list symbol_fields
+  | Set_of_closures set_of_closures ->
+    Flambda.free_symbols_named (Set_of_closures set_of_closures)
+  | Project_closure (s, _) ->
+    Symbol.Set.singleton s
+
+module Symbol_SCC = Strongly_connected_components.Make (Symbol)
+
+let program_graph ~backend imported_symbols symbol_to_constant
+    (initialize_symbol_tbl :
+      (Tag.t * Flambda.t list * Symbol.t option) Symbol.Tbl.t)
+    (effect_tbl : (Flambda.t * Symbol.t option) Symbol.Tbl.t) =
+  let expression_symbol_dependencies expr = Flambda.free_symbols expr in
+  let graph_with_only_constant_parts =
+    Symbol.Map.map (fun const ->
+        Symbol.Set.diff (constant_dependencies ~backend const)
+          imported_symbols)
+      symbol_to_constant
+  in
+  let graph_with_initialisation =
+    Symbol.Tbl.fold (fun sym (_tag, fields, previous) ->
+        let order_dep =
+          match previous with
+          | None -> Symbol.Set.empty
+          | Some previous -> Symbol.Set.singleton previous
+        in
+        let deps = List.fold_left (fun set field ->
+            Symbol.Set.union (expression_symbol_dependencies field) set)
+            order_dep fields
+        in
+        let deps = Symbol.Set.diff deps imported_symbols in
+        Symbol.Map.add sym deps)
+      initialize_symbol_tbl graph_with_only_constant_parts
+  in
+  let graph =
+    Symbol.Tbl.fold (fun sym (expr, previous) ->
+        let order_dep =
+          match previous with
+          | None -> Symbol.Set.empty
+          | Some previous -> Symbol.Set.singleton previous
+        in
+        let deps =
+          Symbol.Set.union (expression_symbol_dependencies expr) order_dep
+        in
+        let deps = Symbol.Set.diff deps imported_symbols in
+        Symbol.Map.add sym deps
+      )
+      effect_tbl graph_with_initialisation
+  in
+  let components =
+    Symbol_SCC.connected_components_sorted_from_roots_to_leaf
+      graph
+  in
+  components
+
+(* rebuilding the program *)
+let add_definition_of_symbol constant_definitions
+    (initialize_symbol_tbl :
+      (Tag.t * Flambda.t list * Symbol.t option) Symbol.Tbl.t)
+    (effect_tbl : (Flambda.t * Symbol.t option) Symbol.Tbl.t)
+    (program : Flambda.program_body) component : Flambda.program_body =
+  let symbol_declaration sym =
+    (* A symbol declared through an Initialize_symbol construct
+       cannot be recursive, this is not allowed in the construction.
+       This also couldn't have been introduced by this pass, so we can
+       safely assert that this is not possible here *)
+    assert(not (Symbol.Tbl.mem initialize_symbol_tbl sym));
+    (sym, Symbol.Map.find sym constant_definitions)
+  in
+  match component with
+  | Symbol_SCC.Has_loop l ->
+    let l = List.map symbol_declaration l in
+    Let_rec_symbol (l, program)
+  | Symbol_SCC.No_loop sym ->
+    match Symbol.Tbl.find initialize_symbol_tbl sym with
+    | (tag, fields, _previous) ->
+      Initialize_symbol (sym, tag, fields, program)
+    | exception Not_found ->
+      match Symbol.Tbl.find effect_tbl sym with
+      | (expr, _previous) ->
+        Effect (expr, program)
+      | exception Not_found ->
+        let decl = Symbol.Map.find sym constant_definitions in
+        Let_symbol (sym, decl, program)
+
+let add_definitions_of_symbols constant_definitions initialize_symbol_tbl
+    effect_tbl program components =
+  Array.fold_left
+    (add_definition_of_symbol constant_definitions initialize_symbol_tbl
+      effect_tbl)
+    program components
+
+let introduce_free_variables_in_set_of_closures
+    (var_to_block_field_tbl :
+      Flambda.constant_defining_value_block_field Variable.Tbl.t)
+    ({ Flambda.function_decls; free_vars; specialised_args;
+        direct_call_surrogates; }
+      as set_of_closures) =
+  let add_definition_and_make_substitution var (expr, subst) =
+    let searched_var =
+      match Variable.Map.find var specialised_args with
+      | exception Not_found -> var
+      | external_var ->
+        (* specialised arguments bound to constant can be rewritten *)
+        external_var.var
+    in
+    match Variable.Tbl.find var_to_block_field_tbl searched_var with
+    | def ->
+      let fresh = Variable.rename var in
+      let named : Flambda.named = match def with
+        | Symbol sym -> Symbol sym
+        | Const c -> Const c
+      in
+      (Flambda.create_let fresh named expr), Variable.Map.add var fresh subst
+    | exception Not_found ->
+      (* The variable is bound by the closure or the arguments or not
+         constant. In either case it does not need to be bound *)
+      expr, subst
+  in
+  let done_something = ref false in
+  let function_decls : Flambda.function_declarations =
+    Flambda.update_function_declarations function_decls
+      ~funs:(Variable.Map.map
+          (fun (func_decl : Flambda.function_declaration) ->
+             let variables_to_bind =
+               (* Closures from the same set must not be bound. *)
+               Variable.Set.diff func_decl.free_variables
+                 (Variable.Map.keys function_decls.funs)
+             in
+             let body, subst =
+               Variable.Set.fold add_definition_and_make_substitution
+                 variables_to_bind
+                 (func_decl.body, Variable.Map.empty)
+             in
+             if Variable.Map.is_empty subst then begin
+               func_decl
+             end else begin
+               done_something := true;
+               let body = Flambda_utils.toplevel_substitution subst body in
+               Flambda.update_body_of_function_declaration func_decl ~body
+             end)
+          function_decls.funs)
+  in
+  let free_vars =
+    (* Keep only those that are not rewritten to constants. *)
+    Variable.Map.filter (fun v _ ->
+        let keep = not (Variable.Tbl.mem var_to_block_field_tbl v) in
+        if not keep then done_something := true;
+        keep)
+      free_vars
+  in
+  let free_vars =
+    Flambda_utils.clean_projections ~which_variables:free_vars
+  in
+  let specialised_args =
+    (* Keep only those that are not rewritten to constants. *)
+    Variable.Map.filter (fun _ (spec_to : Flambda.specialised_to) ->
+        let keep =
+          not (Variable.Tbl.mem var_to_block_field_tbl spec_to.var)
+        in
+        if not keep then begin
+          done_something := true
+        end;
+        keep)
+      specialised_args
+  in
+  let specialised_args =
+    Flambda_utils.clean_projections ~which_variables:specialised_args
+  in
+  if not !done_something then
+    set_of_closures
+  else
+    Flambda.create_set_of_closures ~function_decls ~free_vars
+      ~specialised_args ~direct_call_surrogates
+
+let rewrite_project_var
+      (var_to_block_field_tbl
+        : Flambda.constant_defining_value_block_field Variable.Tbl.t)
+      (project_var : Flambda.project_var) ~original : Flambda.named =
+  let var = Var_within_closure.unwrap project_var.var in
+  match Variable.Tbl.find var_to_block_field_tbl var with
+  | exception Not_found -> original
+  | Symbol sym -> Symbol sym
+  | Const const -> Const const
+
+let introduce_free_variables_in_sets_of_closures
+    (var_to_block_field_tbl:
+      Flambda.constant_defining_value_block_field Variable.Tbl.t)
+    (translate_definition : Flambda.constant_defining_value Symbol.Map.t) =
+  Symbol.Map.map (fun (def : Flambda.constant_defining_value) ->
+      match def with
+      | Allocated_const _
+      | Block _
+      | Project_closure _ -> def
+      | Set_of_closures set_of_closures ->
+        Flambda.Set_of_closures
+          (introduce_free_variables_in_set_of_closures
+             var_to_block_field_tbl
+             set_of_closures))
+    translate_definition
+
+let var_to_block_field
+    (aliases : Alias_analysis.allocation_point Variable.Map.t)
+    (var_to_symbol_tbl : Symbol.t Variable.Tbl.t)
+    (var_to_definition_tbl :
+      Alias_analysis.constant_defining_value Variable.Tbl.t) =
+  let var_to_block_field_tbl = Variable.Tbl.create 42 in
+  Variable.Tbl.iter (fun var _ ->
+      let def =
+        resolve_variable aliases var_to_symbol_tbl var_to_definition_tbl var
+      in
+      Variable.Tbl.add var_to_block_field_tbl var def)
+    var_to_definition_tbl;
+  var_to_block_field_tbl
+
+let program_symbols ~backend (program : Flambda.program) =
+  let new_fake_symbol () =
+    let var = Variable.create Internal_variable_names.fake_effect_symbol in
+    Symbol.of_variable var
+  in
+  let initialize_symbol_tbl = Symbol.Tbl.create 42 in
+  let effect_tbl = Symbol.Tbl.create 42 in
+  let symbol_definition_tbl = Symbol.Tbl.create 42 in
+  let add_project_closure_definitions def_symbol
+        (const : Flambda.constant_defining_value) =
+    match const with
+    | Set_of_closures { function_decls = { funs } } ->
+        Variable.Map.iter (fun fun_var _ ->
+            let closure_id = Closure_id.wrap fun_var in
+            let closure_symbol = closure_symbol ~backend closure_id in
+            let project_closure =
+              Flambda.Project_closure (def_symbol, closure_id)
+            in
+            Symbol.Tbl.add symbol_definition_tbl closure_symbol
+              project_closure)
+          funs
+    | Project_closure _
+    | Allocated_const _
+    | Block _ -> ()
+  in
+  let rec loop (program : Flambda.program_body) previous_effect =
+    match program with
+    | Flambda.Let_symbol (symbol, def, program) ->
+      add_project_closure_definitions symbol def;
+      Symbol.Tbl.add symbol_definition_tbl symbol def;
+      loop program previous_effect
+    | Flambda.Let_rec_symbol (defs, program) ->
+      List.iter (fun (symbol, def) ->
+          add_project_closure_definitions symbol def;
+          Symbol.Tbl.add symbol_definition_tbl symbol def)
+        defs;
+      loop program previous_effect
+    | Flambda.Initialize_symbol (symbol, tag, fields, program) ->
+      (* previous_effect is used to keep the order of initialize and effect
+         values. Their effects order must be kept ordered.
+         it is used as an extra dependency when sorting the symbols. *)
+      (* CR-someday pchambart: if the fields expressions are pure, we could
+         drop this dependency
+         mshinwell: deferred CR *)
+      Symbol.Tbl.add initialize_symbol_tbl symbol
+        (tag, fields, previous_effect);
+      loop program (Some symbol)
+    | Flambda.Effect (expr, program) ->
+      (* Used to ensure that effects are correctly ordered *)
+      let fake_effect_symbol = new_fake_symbol () in
+      Symbol.Tbl.add effect_tbl fake_effect_symbol (expr, previous_effect);
+      loop program (Some fake_effect_symbol)
+    | Flambda.End _ -> ()
+  in
+  loop program.program_body None;
+  initialize_symbol_tbl, symbol_definition_tbl, effect_tbl
+
+let replace_definitions_in_initialize_symbol_and_effects
+    (inconstants : Inconstant_idents.result)
+    (aliases : Alias_analysis.allocation_point Variable.Map.t)
+    (var_to_symbol_tbl : Symbol.t Variable.Tbl.t)
+    (var_to_definition_tbl :
+      Alias_analysis.constant_defining_value Variable.Tbl.t)
+    (initialize_symbol_tbl :
+      (Tag.t * Flambda.t list * Symbol.t option) Symbol.Tbl.t)
+    (effect_tbl : (Flambda.t * Symbol.t option) Symbol.Tbl.t) =
+  let rewrite_expr expr =
+    Flambda_iterators.map_all_immutable_let_and_let_rec_bindings expr
+      ~f:(fun var (named : Flambda.named) : Flambda.named ->
+        if Inconstant_idents.variable var inconstants then
+          named
+        else
+          let resolved =
+            resolve_variable
+              aliases
+              var_to_symbol_tbl
+              var_to_definition_tbl
+              var
+          in
+          match named, resolved with
+          | Symbol s1, Symbol s2 ->
+            assert (s1 == s2);  (* physical equality for speed *)
+            named;
+          | Const c1, Const c2 ->
+            assert (c1 == c2);
+            named
+          | _, Symbol s -> Symbol s
+          | _, Const c -> Const c)
+  in
+  (* This is safe because we only [replace] the current key during
+     iteration (cf. https://github.com/ocaml/ocaml/pull/337) *)
+  Symbol.Tbl.iter
+    (fun symbol (tag, fields, previous) ->
+      let fields = List.map rewrite_expr fields in
+      Symbol.Tbl.replace initialize_symbol_tbl symbol (tag, fields, previous))
+    initialize_symbol_tbl;
+  Symbol.Tbl.iter
+    (fun symbol (expr, previous) ->
+      Symbol.Tbl.replace effect_tbl symbol (rewrite_expr expr, previous))
+    effect_tbl
+
+(* CR-soon mshinwell: Update the name of [project_closure_map]. *)
+let project_closure_map symbol_definition_map =
+  Symbol.Map.fold (fun sym (const : Flambda.constant_defining_value) acc ->
+      match const with
+      | Project_closure (set_of_closures, _) ->
+        Symbol.Map.add sym set_of_closures acc
+      | Set_of_closures _ ->
+        Symbol.Map.add sym sym acc
+      | Allocated_const _
+      | Block _ -> acc)
+    symbol_definition_map
+    Symbol.Map.empty
+
+let lift_constants (program : Flambda.program) ~backend =
+  let the_dead_constant =
+    let var = Variable.create Internal_variable_names.the_dead_constant in
+    Symbol.of_variable var
+  in
+  let program_body : Flambda.program_body =
+    Let_symbol (the_dead_constant, Allocated_const (Nativeint 0n),
+      program.program_body)
+  in
+  let program : Flambda.program =
+    { program with program_body; }
+  in
+  let inconstants =
+    Inconstant_idents.inconstants_on_program program ~backend
+      ~compilation_unit:(Compilation_unit.get_current_exn ())
+  in
+  let initialize_symbol_tbl, symbol_definition_tbl, effect_tbl =
+    program_symbols ~backend program
+  in
+  let var_to_symbol_tbl, var_to_definition_tbl, let_symbol_to_definition_tbl,
+      initialize_symbol_to_definition_tbl =
+    assign_symbols_and_collect_constant_definitions ~backend ~program
+      ~inconstants
+  in
+  let aliases =
+    Alias_analysis.run var_to_definition_tbl
+      initialize_symbol_to_definition_tbl
+      let_symbol_to_definition_tbl
+      ~the_dead_constant
+  in
+  replace_definitions_in_initialize_symbol_and_effects
+      (inconstants : Inconstant_idents.result)
+      (aliases : Alias_analysis.allocation_point Variable.Map.t)
+      (var_to_symbol_tbl : Symbol.t Variable.Tbl.t)
+      (var_to_definition_tbl
+        : Alias_analysis.constant_defining_value Variable.Tbl.t)
+      initialize_symbol_tbl
+      effect_tbl;
+  let symbol_definition_map =
+    translate_constant_set_of_closures
+      (inconstants : Inconstant_idents.result)
+      (aliases : Alias_analysis.allocation_point Variable.Map.t)
+      (var_to_symbol_tbl : Symbol.t Variable.Tbl.t)
+      (var_to_definition_tbl
+        : Alias_analysis.constant_defining_value Variable.Tbl.t)
+      (Symbol.Tbl.to_map symbol_definition_tbl)
+  in
+  let project_closure_map = project_closure_map symbol_definition_map in
+  let translated_definitions =
+    translate_definitions_and_resolve_alias
+      inconstants
+      (aliases : Alias_analysis.allocation_point Variable.Map.t)
+      (var_to_symbol_tbl : Symbol.t Variable.Tbl.t)
+      (var_to_definition_tbl
+        : Alias_analysis.constant_defining_value Variable.Tbl.t)
+      symbol_definition_map
+      project_closure_map
+      ~backend
+  in
+  let var_to_block_field_tbl =
+    var_to_block_field
+      (aliases : Alias_analysis.allocation_point Variable.Map.t)
+      (var_to_symbol_tbl : Symbol.t Variable.Tbl.t)
+      (var_to_definition_tbl
+        : Alias_analysis.constant_defining_value Variable.Tbl.t)
+  in
+  let translated_definitions =
+    introduce_free_variables_in_sets_of_closures var_to_block_field_tbl
+      translated_definitions
+  in
+  let constant_definitions =
+    (* Add previous Let_symbol to the newly discovered ones *)
+    Symbol.Map.union
+      (fun _sym
+        (c1:Flambda.constant_defining_value)
+        (c2:Flambda.constant_defining_value) ->
+        match c1, c2 with
+        | Project_closure (s1, closure_id1),
+          Project_closure (s2, closure_id2) when
+            Symbol.equal s1 s2 &&
+            Closure_id.equal closure_id1 closure_id2 ->
+          Some c1
+        | Project_closure (s1, closure_id1),
+          Project_closure (s2, closure_id2) ->
+          Format.eprintf "not equal project closure@. s %a %a@. cid %a %a@."
+            Symbol.print s1 Symbol.print s2
+            Closure_id.print closure_id1 Closure_id.print closure_id2;
+          assert false
+        | _ ->
+          assert false
+      )
+      symbol_definition_map
+      translated_definitions
+  in
+  (* Upon the [Initialize_symbol]s, the [Effect]s and the constant definitions,
+     do the following:
+     1. Introduce [Let]s to bind variables that are going to be replaced
+     by constants.
+     2. If a variable bound by a closure gets replaced by a symbol and
+     thus eliminated from the [free_vars] set of the closure, we need to
+     rewrite any subsequent [Project_var] expressions that project that
+     variable. *)
+  let rewrite_expr expr =
+    Flambda_iterators.map_named (function
+        | (Set_of_closures set_of_closures) as named ->
+          let new_set_of_closures =
+            introduce_free_variables_in_set_of_closures
+              var_to_block_field_tbl set_of_closures
+          in
+          if new_set_of_closures == set_of_closures then
+            named
+          else
+            Set_of_closures new_set_of_closures
+        | (Project_var project_var) as original ->
+          rewrite_project_var var_to_block_field_tbl project_var ~original
+        | (Symbol _ | Const _ | Allocated_const _ | Project_closure _
+        | Move_within_set_of_closures _ | Prim _ | Expr _
+        | Read_mutable _ | Read_symbol_field _) as named -> named)
+      expr
+  in
+  let constant_definitions =
+    Symbol.Map.map (fun (const : Flambda.constant_defining_value) ->
+        match const with
+        | Allocated_const _ | Block _ | Project_closure _ -> const
+        | Set_of_closures set_of_closures ->
+          let set_of_closures =
+            Flambda_iterators.map_function_bodies set_of_closures
+              ~f:rewrite_expr
+          in
+          Flambda.Set_of_closures
+            (introduce_free_variables_in_set_of_closures
+              var_to_block_field_tbl set_of_closures))
+    constant_definitions
+  in
+  let effect_tbl =
+    Symbol.Tbl.map effect_tbl (fun (effect, dep) -> rewrite_expr effect, dep)
+  in
+  let initialize_symbol_tbl =
+    Symbol.Tbl.map initialize_symbol_tbl (fun (tag, fields, dep) ->
+      let fields = List.map rewrite_expr fields in
+      tag, fields, dep)
+  in
+  let imported_symbols = Flambda_utils.imported_symbols program in
+  let components =
+    program_graph ~backend imported_symbols constant_definitions
+      initialize_symbol_tbl effect_tbl
+  in
+  let program_body =
+    add_definitions_of_symbols constant_definitions
+      initialize_symbol_tbl
+      effect_tbl
+      (End (Flambda_utils.root_symbol program))
+      components
+  in
+  Flambda_utils.introduce_needed_import_symbols { program with program_body; }
diff --git a/middle_end/flambda/lift_constants.mli b/middle_end/flambda/lift_constants.mli
new file mode 100644
index 00000000..969c365e
--- /dev/null
+++ b/middle_end/flambda/lift_constants.mli
@@ -0,0 +1,65 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** The aim of this pass is to assign symbols to values known to be
+    constant (in other words, whose values we know at compile time), with
+    appropriate sharing of constants, and replace the occurrences of the
+    constants with their corresponding symbols.
+
+    This pass uses the results of two other passes, [Inconstant_idents] and
+    [Alias_analysis].  The relationship between these two deserves some
+    attention.
+
+    [Inconstant_idents] is a "backwards" analysis that propagates implications
+    about inconstantness of variables and set of closures IDs.
+
+    [Alias_analysis] is a "forwards" analysis that is analogous to the
+    propagation of [Simple_value_approx.t] values during [Inline_and_simplify].
+    It gives us information about relationships between values but not actually
+    about their constantness.
+
+    Combining these two into a single pass has been attempted previously,
+    but was not thought to be successful; this experiment could be repeated in
+    the future.  (If "constant" is considered as "top" and "inconstant" is
+    considered as "bottom", then [Alias_analysis] corresponds to a least fixed
+    point and [Inconstant_idents] corresponds to a greatest fixed point.)
+
+    At a high level, this pass operates as follows.  Symbols are assigned to
+    variables known to be constant and their defining expressions examined.
+    Based on the results of [Alias_analysis], we simplify the destructive
+    elements within the defining expressions (specifically, projection of
+    fields from blocks), to eventually yield [Flambda.constant_defining_value]s
+    that are entirely constructive.  These will be bound to symbols in the
+    resulting program.
+
+    Another approach to this pass could be to only use the results of
+    [Inconstant_idents] and then repeatedly lift constants and run
+    [Inline_and_simplify] until a fixpoint.  It was thought more robust to
+    instead use [Alias_analysis], where the fixpointing involves a less
+    complicated function.
+
+    We still run [Inline_and_simplify] once after this pass since the lifting
+    of constants may enable more functions to become closed; the simplification
+    pass provides an easy way of cleaning up (e.g. making sure [free_vars]
+    maps in sets of closures are correct).
+*)
+
+val lift_constants
+   : Flambda.program
+  -> backend:(module Backend_intf.S)
+  -> Flambda.program
diff --git a/middle_end/flambda/lift_let_to_initialize_symbol.ml b/middle_end/flambda/lift_let_to_initialize_symbol.ml
new file mode 100644
index 00000000..ccef0d8a
--- /dev/null
+++ b/middle_end/flambda/lift_let_to_initialize_symbol.ml
@@ -0,0 +1,298 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+type ('a, 'b) kind =
+  | Initialisation of (Symbol.t * Tag.t * Flambda.t list)
+  | Effect of 'b
+
+let should_copy (named:Flambda.named) =
+  match named with
+  | Symbol _ | Read_symbol_field _ | Const _ -> true
+  | _ -> false
+
+type extracted =
+  | Expr of Variable.t * Flambda.t
+  | Exprs of Variable.t list * Flambda.t
+  | Block of Variable.t * Tag.t * Variable.t list
+
+type accumulated = {
+  copied_lets : (Variable.t * Flambda.named) list;
+  extracted_lets : extracted list;
+  terminator : Flambda.expr;
+}
+
+let rec accumulate ~substitution ~copied_lets ~extracted_lets
+      (expr : Flambda.t) =
+  match expr with
+  | Let { var; body = Var var'; _ } | Let_rec ([var, _], Var var')
+    when Variable.equal var var' ->
+    { copied_lets; extracted_lets;
+      terminator = Flambda_utils.toplevel_substitution substitution expr;
+    }
+  (* If the pattern is what lifting let_rec generates, prevent it from being
+     lifted again. *)
+  | Let_rec (defs,
+             Let { var; body = Var var';
+                   defining_expr = Prim (Pmakeblock _, fields, _); })
+    when
+      Variable.equal var var'
+      && List.for_all (fun field ->
+          List.exists (fun (def_var, _) -> Variable.equal def_var field) defs)
+      fields ->
+    { copied_lets; extracted_lets;
+      terminator = Flambda_utils.toplevel_substitution substitution expr;
+    }
+  | Let { var; defining_expr = Expr (Var alias); body; _ }
+  | Let_rec ([var, Expr (Var alias)], body) ->
+    let alias =
+      match Variable.Map.find alias substitution with
+      | exception Not_found -> alias
+      | original_alias -> original_alias
+    in
+    accumulate
+      ~substitution:(Variable.Map.add var alias substitution)
+      ~copied_lets
+      ~extracted_lets
+      body
+  | Let { var; defining_expr = named; body; _ }
+  | Let_rec ([var, named], body)
+    when should_copy named ->
+      accumulate body
+        ~substitution
+        ~copied_lets:((var, named)::copied_lets)
+        ~extracted_lets
+  | Let { var; defining_expr = named; body; _ } ->
+    let extracted =
+      let renamed = Variable.rename var in
+      match named with
+      | Prim (Pmakeblock (tag, Asttypes.Immutable, _value_kind), args, _dbg) ->
+        let tag = Tag.create_exn tag in
+        let args =
+          List.map (fun v ->
+              try Variable.Map.find v substitution
+              with Not_found -> v)
+            args
+        in
+        Block (var, tag, args)
+      | named ->
+        let expr =
+          Flambda_utils.toplevel_substitution substitution
+            (Flambda.create_let renamed named (Var renamed))
+        in
+        Expr (var, expr)
+    in
+    accumulate body
+      ~substitution
+      ~copied_lets
+      ~extracted_lets:(extracted::extracted_lets)
+  | Let_rec ([var, named], body) ->
+    let renamed = Variable.rename var in
+    let def_substitution = Variable.Map.add var renamed substitution in
+    let expr =
+      Flambda_utils.toplevel_substitution def_substitution
+        (Let_rec ([renamed, named], Var renamed))
+    in
+    let extracted = Expr (var, expr) in
+    accumulate body
+      ~substitution
+      ~copied_lets
+      ~extracted_lets:(extracted::extracted_lets)
+  | Let_rec (defs, body) ->
+    let renamed_defs, def_substitution =
+      List.fold_right (fun (var, def) (acc, substitution) ->
+          let new_var = Variable.rename var in
+          (new_var, def) :: acc,
+          Variable.Map.add var new_var substitution)
+        defs ([], substitution)
+    in
+    let extracted =
+      let expr =
+        let name = Internal_variable_names.lifted_let_rec_block in
+        Flambda_utils.toplevel_substitution def_substitution
+          (Let_rec (renamed_defs,
+                    Flambda_utils.name_expr ~name
+                      (Prim (Pmakeblock (0, Immutable, None),
+                             List.map fst renamed_defs,
+                             Debuginfo.none))))
+      in
+      Exprs (List.map fst defs, expr)
+    in
+    accumulate body
+      ~substitution
+      ~copied_lets
+      ~extracted_lets:(extracted::extracted_lets)
+  | _ ->
+  { copied_lets;
+    extracted_lets;
+    terminator = Flambda_utils.toplevel_substitution substitution expr;
+  }
+
+let rebuild_expr
+      ~(extracted_definitions : (Symbol.t * int list) Variable.Map.t)
+      ~(copied_definitions : Flambda.named Variable.Map.t)
+      ~(substitute : bool)
+      (expr : Flambda.t) =
+  let expr_with_read_symbols =
+    Flambda_utils.substitute_read_symbol_field_for_variables
+      extracted_definitions expr
+  in
+  let free_variables = Flambda.free_variables expr_with_read_symbols in
+  let substitution =
+    if substitute then
+      Variable.Map.of_set (fun x -> Variable.rename x) free_variables
+    else
+      Variable.Map.of_set (fun x -> x) free_variables
+  in
+  let expr_with_read_symbols =
+    Flambda_utils.toplevel_substitution substitution
+      expr_with_read_symbols
+  in
+  Variable.Map.fold (fun var declaration body ->
+      let definition = Variable.Map.find var copied_definitions in
+      Flambda.create_let declaration definition body)
+    substitution expr_with_read_symbols
+
+let rebuild (used_variables:Variable.Set.t) (accumulated:accumulated) =
+  let copied_definitions = Variable.Map.of_list accumulated.copied_lets in
+  let accumulated_extracted_lets =
+    List.map (fun decl ->
+        match decl with
+        | Block (var, _, _) | Expr (var, _) ->
+          Symbol.of_variable (Variable.rename var), decl
+        | Exprs _ ->
+          let name = Internal_variable_names.lifted_let_rec_block in
+          let var = Variable.create name in
+          Symbol.of_variable var, decl)
+      accumulated.extracted_lets
+  in
+  let extracted_definitions =
+    (* Blocks are lifted to direct top-level Initialize_block:
+         accessing the value be done directly through the symbol.
+       Other let bound variables are initialized inside a size
+       one static block:
+         accessing the value is done directly through the field 0
+         of the symbol.
+       let rec of size more than one is represented as a block of
+       all the bound variables allocated inside a size one static
+       block:
+         accessing the value is done directly through the right
+         field of the field 0 of the symbol. *)
+    List.fold_left (fun map (symbol, decl) ->
+        match decl with
+        | Block (var, _tag, _fields) ->
+          Variable.Map.add var (symbol, []) map
+        | Expr (var, _expr) ->
+          Variable.Map.add var (symbol, [0]) map
+        | Exprs (vars, _expr) ->
+          let map, _ =
+            List.fold_left (fun (map, field) var ->
+                Variable.Map.add var (symbol, [field; 0]) map,
+                field + 1)
+              (map, 0) vars
+          in
+          map)
+      Variable.Map.empty accumulated_extracted_lets
+  in
+  let extracted =
+    List.map (fun (symbol, decl) ->
+        match decl with
+        | Expr (var, decl) ->
+          let expr =
+            rebuild_expr ~extracted_definitions ~copied_definitions
+              ~substitute:true decl
+          in
+          if Variable.Set.mem var used_variables then
+            Initialisation
+              (symbol,
+               Tag.create_exn 0,
+               [expr])
+          else
+            Effect expr
+        | Exprs (_vars, decl) ->
+          let expr =
+            rebuild_expr ~extracted_definitions ~copied_definitions
+              ~substitute:true decl
+          in
+          Initialisation (symbol, Tag.create_exn 0, [expr])
+        | Block (_var, tag, fields) ->
+          let fields =
+            List.map (fun var ->
+                rebuild_expr ~extracted_definitions ~copied_definitions
+                  ~substitute:true (Var var))
+              fields
+          in
+          Initialisation (symbol, tag, fields))
+      accumulated_extracted_lets
+  in
+  let terminator =
+    (* We don't need to substitute the variables in the terminator, we
+       suppose that we did for every other occurrence.  Avoiding this
+       substitution allows this transformation to be idempotent. *)
+    rebuild_expr ~extracted_definitions ~copied_definitions
+      ~substitute:false accumulated.terminator
+  in
+  List.rev extracted, terminator
+
+let introduce_symbols expr =
+  let accumulated =
+    accumulate expr
+      ~substitution:Variable.Map.empty
+      ~copied_lets:[] ~extracted_lets:[]
+  in
+  let used_variables = Flambda.used_variables expr in
+  let extracted, terminator = rebuild used_variables accumulated in
+  extracted, terminator
+
+let add_extracted introduced program =
+  List.fold_right (fun extracted program ->
+      match extracted with
+      | Initialisation (symbol, tag, def) ->
+        Flambda.Initialize_symbol (symbol, tag, def, program)
+      | Effect effect ->
+        Flambda.Effect (effect, program))
+    introduced program
+
+let rec split_program (program : Flambda.program_body) : Flambda.program_body =
+  match program with
+  | End s -> End s
+  | Let_symbol (s, def, program) ->
+    Let_symbol (s, def, split_program program)
+  | Let_rec_symbol (defs, program) ->
+    Let_rec_symbol (defs, split_program program)
+  | Effect (expr, program) ->
+    let program = split_program program in
+    let introduced, expr = introduce_symbols expr in
+    add_extracted introduced (Flambda.Effect (expr, program))
+  | Initialize_symbol (symbol, tag, ((_::_::_) as fields), program) ->
+    (* CR-someday pchambart: currently the only initialize_symbol with more
+       than 1 field is the module block. This could evolve, in that case
+       this pattern should be handled properly. *)
+    Initialize_symbol (symbol, tag, fields, split_program program)
+  | Initialize_symbol (sym, tag, [], program) ->
+    Let_symbol (sym, Block (tag, []), split_program program)
+  | Initialize_symbol (symbol, tag, [field], program) ->
+    let program = split_program program in
+    let introduced, field = introduce_symbols field in
+    add_extracted introduced
+      (Flambda.Initialize_symbol (symbol, tag, [field], program))
+
+let lift ~backend:_ (program : Flambda.program) =
+  { program with
+    program_body = split_program program.program_body;
+  }
diff --git a/middle_end/flambda/lift_let_to_initialize_symbol.mli b/middle_end/flambda/lift_let_to_initialize_symbol.mli
new file mode 100644
index 00000000..afb1c60f
--- /dev/null
+++ b/middle_end/flambda/lift_let_to_initialize_symbol.mli
@@ -0,0 +1,38 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Lift toplevel [Let]-expressions to Flambda [program] constructions such
+    that the results of evaluation of such expressions may be accessed
+    directly, through symbols, rather than through closures.  The
+    [Let]-expressions typically come from the compilation of modules (using
+    the bytecode strategy) in [Translmod].
+
+    This means of compilation supersedes the old "transl_store_" methodology
+    for native code.
+
+    An [Initialize_symbol] construction generated by this pass may be
+    subsequently rewritten to [Let_symbol] if it is discovered that the
+    initializer is in fact constant.  (See [Initialize_symbol_to_let_symbol].)
+
+    The [program] constructions generated by this pass will be joined by
+    others that arise from the lifting of constants (see [Lift_constants]).
+*)
+val lift
+   : backend:(module Backend_intf.S)
+  -> Flambda.program
+  -> Flambda.program
diff --git a/middle_end/flambda/parameter.ml b/middle_end/flambda/parameter.ml
new file mode 100644
index 00000000..0c916dd7
--- /dev/null
+++ b/middle_end/flambda/parameter.ml
@@ -0,0 +1,69 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+[@@@ocaml.warning "+9"]
+(* Warning 9 is enabled to ensure correct update of each function when
+   a field is added to type parameter *)
+
+type parameter = {
+  var : Variable.t;
+}
+
+let wrap var = { var }
+
+let var p = p.var
+
+module M =
+  Identifiable.Make (struct
+    type t = parameter
+
+    let compare { var = var1 } { var = var2 } =
+      Variable.compare var1 var2
+
+    let equal { var = var1 } { var = var2 } =
+      Variable.equal var1 var2
+
+    let hash { var } =
+      Variable.hash var
+
+    let print ppf { var } =
+      Variable.print ppf var
+
+    let output o { var } =
+      Variable.output o var
+  end)
+
+module T = M.T
+include T
+
+module Map = M.Map
+module Tbl = M.Tbl
+module Set = struct
+  include M.Set
+  let vars l = Variable.Set.of_list (List.map var l)
+end
+
+let rename ?current_compilation_unit p =
+  { var = Variable.rename ?current_compilation_unit p.var }
+
+let map_var f { var } = { var = f var }
+
+module List = struct
+  let vars params = List.map (fun { var } -> var) params
+end
diff --git a/middle_end/flambda/parameter.mli b/middle_end/flambda/parameter.mli
new file mode 100644
index 00000000..ceed1678
--- /dev/null
+++ b/middle_end/flambda/parameter.mli
@@ -0,0 +1,52 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** [Parameter.t] carries a unique [Variable.t] used as function parameter.
+    It can also carry annotations about the usage of the variable. *)
+
+type t
+type parameter = t
+
+(** Make a parameter from a variable with default attributes *)
+val wrap : Variable.t -> t
+
+val var : t -> Variable.t
+
+(** Rename the inner variable of the parameter *)
+val rename
+   : ?current_compilation_unit:Compilation_unit.t
+  -> t
+  -> t
+
+val map_var : (Variable.t -> Variable.t) -> t -> t
+
+module T : Identifiable.Thing with type t = t
+
+module Set : sig
+  include Identifiable.Set with module T := T
+  val vars : parameter list -> Variable.Set.t
+end
+
+include Identifiable.S with type t := t
+                        and module T := T
+                        and module Set := Set
+
+module List : sig
+  (** extract variables from a list of parameters, preserving the order *)
+  val vars : t list -> Variable.t list
+end
diff --git a/middle_end/flambda/pass_wrapper.ml b/middle_end/flambda/pass_wrapper.ml
new file mode 100644
index 00000000..a2005332
--- /dev/null
+++ b/middle_end/flambda/pass_wrapper.ml
@@ -0,0 +1,35 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+let register ~pass_name =
+  Clflags.all_passes := pass_name :: !Clflags.all_passes
+
+let with_dump ~ppf_dump ~pass_name ~f ~input ~print_input ~print_output =
+  let dump = Clflags.dumped_pass pass_name in
+  let result = f () in
+  match result with
+  | None ->
+    if dump then Format.fprintf ppf_dump "%s: no-op.\n\n%!" pass_name;
+    None
+  | Some result ->
+    if dump then begin
+      Format.fprintf ppf_dump "Before %s:@ %a@.@." pass_name print_input input;
+      Format.fprintf ppf_dump "After %s:@ %a@.@." pass_name print_output result;
+    end;
+    Some result
diff --git a/middle_end/flambda/pass_wrapper.mli b/middle_end/flambda/pass_wrapper.mli
new file mode 100644
index 00000000..3a30e61d
--- /dev/null
+++ b/middle_end/flambda/pass_wrapper.mli
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+val register : pass_name:string -> unit
+
+val with_dump
+   : ppf_dump:Format.formatter
+  -> pass_name:string
+  -> f:(unit -> 'b option)
+  -> input:'a
+  -> print_input:(Format.formatter -> 'a -> unit)
+  -> print_output:(Format.formatter -> 'b -> unit)
+  -> 'b option
diff --git a/middle_end/flambda/projection.ml b/middle_end/flambda/projection.ml
new file mode 100644
index 00000000..2c660a2a
--- /dev/null
+++ b/middle_end/flambda/projection.ml
@@ -0,0 +1,170 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+(* CR-someday mshinwell: Move these three types into their own modules. *)
+
+type project_closure = {
+  set_of_closures : Variable.t;
+  closure_id : Closure_id.t;
+}
+
+type move_within_set_of_closures = {
+  closure : Variable.t;
+  start_from : Closure_id.t;
+  move_to : Closure_id.t;
+}
+
+type project_var = {
+  closure : Variable.t;
+  closure_id : Closure_id.t;
+  var : Var_within_closure.t;
+}
+
+let compare_project_var
+      ({ closure = closure1; closure_id = closure_id1; var = var1; }
+        : project_var)
+      ({ closure = closure2; closure_id = closure_id2; var = var2; }
+        : project_var) =
+  let c = Variable.compare closure1 closure2 in
+  if c <> 0 then c
+  else
+    let c = Closure_id.compare closure_id1 closure_id2 in
+    if c <> 0 then c
+    else
+      Var_within_closure.compare var1 var2
+
+let compare_move_within_set_of_closures
+      ({ closure = closure1; start_from = start_from1; move_to = move_to1; }
+        : move_within_set_of_closures)
+      ({ closure = closure2; start_from = start_from2; move_to = move_to2; }
+        : move_within_set_of_closures) =
+  let c = Variable.compare closure1 closure2 in
+  if c <> 0 then c
+  else
+    let c = Closure_id.compare start_from1 start_from2 in
+    if c <> 0 then c
+    else
+      Closure_id.compare move_to1 move_to2
+
+let compare_project_closure
+      ({ set_of_closures = set_of_closures1; closure_id = closure_id1; }
+        : project_closure)
+      ({ set_of_closures = set_of_closures2; closure_id = closure_id2; }
+        : project_closure) =
+  let c = Variable.compare set_of_closures1 set_of_closures2 in
+  if c <> 0 then c
+  else
+    Closure_id.compare closure_id1 closure_id2
+
+let print_project_closure ppf (project_closure : project_closure) =
+  Format.fprintf ppf "@[<2>(project_closure@ %a@ from@ %a)@]"
+    Closure_id.print project_closure.closure_id
+    Variable.print project_closure.set_of_closures
+
+let print_move_within_set_of_closures ppf
+      (move_within_set_of_closures : move_within_set_of_closures) =
+  Format.fprintf ppf
+    "@[<2>(move_within_set_of_closures@ %a <-- %a@ (closure = %a))@]"
+    Closure_id.print move_within_set_of_closures.move_to
+    Closure_id.print move_within_set_of_closures.start_from
+    Variable.print move_within_set_of_closures.closure
+
+let print_project_var ppf (project_var : project_var) =
+  Format.fprintf ppf "@[<2>(project_var@ %a@ from %a=%a)@]"
+    Var_within_closure.print project_var.var
+    Closure_id.print project_var.closure_id
+    Variable.print project_var.closure
+
+type t =
+  | Project_var of project_var
+  | Project_closure of project_closure
+  | Move_within_set_of_closures of move_within_set_of_closures
+  | Field of int * Variable.t
+
+include Identifiable.Make (struct
+  type nonrec t = t
+
+  let compare t1 t2 =
+    match t1, t2 with
+    | Project_var project_var1, Project_var project_var2 ->
+      compare_project_var project_var1 project_var2
+    | Project_closure project_closure1, Project_closure project_closure2 ->
+      compare_project_closure project_closure1 project_closure2
+    | Move_within_set_of_closures move1, Move_within_set_of_closures move2 ->
+      compare_move_within_set_of_closures move1 move2
+    | Field (index1, var1), Field (index2, var2) ->
+      let c = compare index1 index2 in
+      if c <> 0 then c
+      else Variable.compare var1 var2
+    | Project_var _, _ -> -1
+    | _, Project_var _ -> 1
+    | Project_closure _, _ -> -1
+    | _, Project_closure _ -> 1
+    | Move_within_set_of_closures _, _ -> -1
+    | _, Move_within_set_of_closures _ -> 1
+
+  let equal t1 t2 =
+    (compare t1 t2) = 0
+
+  let hash = Hashtbl.hash
+
+  let print ppf t =
+    match t with
+    | Project_closure (project_closure) ->
+      print_project_closure ppf project_closure
+    | Project_var (project_var) -> print_project_var ppf project_var
+    | Move_within_set_of_closures (move_within_set_of_closures) ->
+      print_move_within_set_of_closures ppf move_within_set_of_closures
+    | Field (field_index, var) ->
+      Format.fprintf ppf "Field %d of %a" field_index Variable.print var
+
+  let output _ _ = failwith "Projection.output: not yet implemented"
+end)
+
+let projecting_from t =
+  match t with
+  | Project_var { closure; _ } -> closure
+  | Project_closure { set_of_closures; _ } -> set_of_closures
+  | Move_within_set_of_closures { closure; _ } -> closure
+  | Field (_, var) -> var
+
+let map_projecting_from t ~f : t =
+  match t with
+  | Project_var project_var ->
+    let project_var : project_var =
+      { project_var with
+        closure = f project_var.closure;
+      }
+    in
+    Project_var project_var
+  | Project_closure project_closure ->
+    let project_closure : project_closure =
+      { project_closure with
+        set_of_closures = f project_closure.set_of_closures;
+      }
+    in
+    Project_closure project_closure
+  | Move_within_set_of_closures move ->
+    let move : move_within_set_of_closures =
+      { move with
+        closure = f move.closure;
+      }
+    in
+    Move_within_set_of_closures move
+  | Field (field_index, var) -> Field (field_index, f var)
diff --git a/middle_end/flambda/projection.mli b/middle_end/flambda/projection.mli
new file mode 100644
index 00000000..1b251ca2
--- /dev/null
+++ b/middle_end/flambda/projection.mli
@@ -0,0 +1,80 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Representation of projections from closures and blocks. *)
+
+(** The selection of one closure given a set of closures, required before
+    a function defined by said set of closures can be applied.  See more
+    detailed documentation below on [set_of_closures]. *)
+type project_closure = {
+  set_of_closures : Variable.t; (** must yield a set of closures *)
+  closure_id : Closure_id.t;
+}
+
+(** The selection of one closure given another closure in the same set of
+    closures.  See more detailed documentation below on [set_of_closures].
+    The [move_to] closure must be part of the free variables of
+    [start_from]. *)
+type move_within_set_of_closures = {
+  closure : Variable.t;  (** must yield a closure *)
+  start_from : Closure_id.t;
+  move_to : Closure_id.t;
+}
+
+(** The selection from a closure of a variable bound by said closure.
+    In other words, access to a function's environment.  Also see more
+    detailed documentation below on [set_of_closures]. *)
+type project_var = {
+  closure : Variable.t;  (** must yield a closure *)
+  closure_id : Closure_id.t;
+  var : Var_within_closure.t;
+}
+
+val print_project_closure
+   : Format.formatter
+  -> project_closure
+  -> unit
+
+val print_move_within_set_of_closures
+   : Format.formatter
+  -> move_within_set_of_closures
+  -> unit
+
+val print_project_var
+   : Format.formatter
+  -> project_var
+  -> unit
+
+val compare_project_var : project_var -> project_var -> int
+val compare_project_closure : project_closure -> project_closure -> int
+val compare_move_within_set_of_closures
+   : move_within_set_of_closures
+  -> move_within_set_of_closures
+  -> int
+
+type t =
+  | Project_var of project_var
+  | Project_closure of project_closure
+  | Move_within_set_of_closures of move_within_set_of_closures
+  | Field of int * Variable.t
+
+include Identifiable.S with type t := t
+
+(** Return which variable the given projection projects from. *)
+val projecting_from : t -> Variable.t
+
+(** Change the variable that the given projection projects from. *)
+val map_projecting_from : t -> f:(Variable.t -> Variable.t) -> t
diff --git a/middle_end/flambda/ref_to_variables.ml b/middle_end/flambda/ref_to_variables.ml
new file mode 100644
index 00000000..aa2a73c6
--- /dev/null
+++ b/middle_end/flambda/ref_to_variables.ml
@@ -0,0 +1,199 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+let variables_not_used_as_local_reference (tree:Flambda.t) =
+  let set = ref Variable.Set.empty in
+  let rec loop_named (flam : Flambda.named) =
+    match flam with
+    (* Directly used block: does not prevent use as a variable *)
+    | Prim(Pfield _, [_], _)
+    | Prim(Poffsetref _, [_], _) -> ()
+    | Prim(Psetfield _, [_block; v], _) ->
+      (* block is not prevented to be used as a local reference, but v is *)
+      set := Variable.Set.add v !set
+    | Prim(_, _, _)
+    | Symbol _ |Const _ | Allocated_const _ | Read_mutable _
+    | Read_symbol_field _ | Project_closure _
+    | Move_within_set_of_closures _ | Project_var _ ->
+      set := Variable.Set.union !set (Flambda.free_variables_named flam)
+    | Set_of_closures set_of_closures ->
+      set := Variable.Set.union !set (Flambda.free_variables_named flam);
+      Variable.Map.iter (fun _ (function_decl : Flambda.function_declaration) ->
+          loop function_decl.body)
+        set_of_closures.function_decls.funs
+    | Expr e ->
+      loop e
+  and loop (flam : Flambda.t) =
+    match flam with
+    | Let { defining_expr; body; _ } ->
+      loop_named defining_expr;
+      loop body
+    | Let_rec (defs, body) ->
+      List.iter (fun (_var, named) -> loop_named named) defs;
+      loop body
+    | Var v ->
+      set := Variable.Set.add v !set
+    | Let_mutable { initial_value = v; body } ->
+      set := Variable.Set.add v !set;
+      loop body
+    | If_then_else (cond, ifso, ifnot) ->
+      set := Variable.Set.add cond !set;
+      loop ifso;
+      loop ifnot
+    | Switch (cond, { consts; blocks; failaction }) ->
+      set := Variable.Set.add cond !set;
+      List.iter (fun (_, branch) -> loop branch) consts;
+      List.iter (fun (_, branch) -> loop branch) blocks;
+      Option.iter loop failaction
+    | String_switch (cond, branches, default) ->
+      set := Variable.Set.add cond !set;
+      List.iter (fun (_, branch) -> loop branch) branches;
+      Option.iter loop default
+    | Static_catch (_, _, body, handler) ->
+      loop body;
+      loop handler
+    | Try_with (body, _, handler) ->
+      loop body;
+      loop handler
+    | While (cond, body) ->
+      loop cond;
+      loop body
+    | For { bound_var = _; from_value; to_value; direction = _; body; } ->
+      set := Variable.Set.add from_value !set;
+      set := Variable.Set.add to_value !set;
+      loop body
+    | Static_raise (_, args) ->
+      set := Variable.Set.union (Variable.Set.of_list args) !set
+    | Proved_unreachable | Apply _ | Send _ | Assign _ ->
+      set := Variable.Set.union !set (Flambda.free_variables flam)
+  in
+  loop tree;
+  !set
+
+let variables_containing_ref (flam:Flambda.t) =
+  let map = ref Variable.Map.empty in
+  let aux (flam : Flambda.t) =
+    match flam with
+    | Let { var;
+            defining_expr = Prim(Pmakeblock(0, Asttypes.Mutable, _), l, _);
+          } ->
+      map := Variable.Map.add var (List.length l) !map
+    | _ -> ()
+  in
+  Flambda_iterators.iter aux (fun _ -> ()) flam;
+  !map
+
+let eliminate_ref_of_expr flam =
+  let variables_not_used_as_local_reference =
+    variables_not_used_as_local_reference flam
+  in
+  let convertible_variables =
+    Variable.Map.filter
+      (fun v _ ->
+        not (Variable.Set.mem v variables_not_used_as_local_reference))
+      (variables_containing_ref flam)
+  in
+  if Variable.Map.cardinal convertible_variables = 0 then flam
+  else
+    let convertible_variables =
+      Variable.Map.mapi (fun v size ->
+          Array.init size (fun _ -> Mutable_variable.create_from_variable v))
+        convertible_variables
+    in
+    let convertible_variable v = Variable.Map.mem v convertible_variables in
+    let get_variable v field =
+      let arr = try Variable.Map.find v convertible_variables
+        with Not_found -> assert false in
+      if Array.length arr <= field
+      then None (* This case could apply when inlining code containing GADTS *)
+      else Some (arr.(field), Array.length arr)
+    in
+    let aux (flam : Flambda.t) : Flambda.t =
+      match flam with
+      | Let { var;
+              defining_expr = Prim(Pmakeblock(0, Asttypes.Mutable, shape), l,_);
+              body }
+        when convertible_variable var ->
+        let shape = match shape with
+          | None -> List.map (fun _ -> Lambda.Pgenval) l
+          | Some shape -> shape
+        in
+        let _, expr =
+          List.fold_left2 (fun (field,body) init kind ->
+              match get_variable var field with
+              | None -> assert false
+              | Some (field_var, _) ->
+                field+1,
+                (Let_mutable { var = field_var;
+                               initial_value = init;
+                               body;
+                               contents_kind = kind } : Flambda.t))
+            (0,body) l shape in
+        expr
+      | Let _ | Let_mutable _
+      | Assign _ | Var _ | Apply _
+      | Let_rec _ | Switch _ | String_switch _
+      | Static_raise _ | Static_catch _
+      | Try_with _ | If_then_else _
+      | While _ | For _ | Send _ | Proved_unreachable ->
+        flam
+    and aux_named (named : Flambda.named) : Flambda.named =
+      match named with
+      | Prim(Pfield field, [v], _)
+        when convertible_variable v ->
+        (match get_variable v field with
+         | None -> Expr Proved_unreachable
+         | Some (var,_) -> Read_mutable var)
+      | Prim(Poffsetref delta, [v], dbg)
+        when convertible_variable v ->
+        (match get_variable v 0 with
+         | None -> Expr Proved_unreachable
+         | Some (var,size) ->
+           if size = 1
+           then begin
+             let mut_name = Internal_variable_names.read_mutable in
+             let mut = Variable.create mut_name in
+             let new_value_name = Internal_variable_names.offsetted in
+             let new_value = Variable.create new_value_name in
+             let expr =
+               Flambda.create_let mut (Read_mutable var)
+                 (Flambda.create_let new_value
+                    (Prim(Poffsetint delta, [mut], dbg))
+                    (Assign { being_assigned = var; new_value }))
+             in
+             Expr expr
+           end
+           else
+             Expr Proved_unreachable)
+      | Prim(Psetfield (field, _, _), [v; new_value], _)
+        when convertible_variable v ->
+        (match get_variable v field with
+         | None -> Expr Proved_unreachable
+         | Some (being_assigned,_) ->
+           Expr (Assign { being_assigned; new_value }))
+      | Prim _ | Symbol _ | Const _ | Allocated_const _ | Read_mutable _
+      | Read_symbol_field _ | Set_of_closures _ | Project_closure _
+      | Move_within_set_of_closures _ | Project_var _ | Expr _ ->
+        named
+    in
+    Flambda_iterators.map aux aux_named flam
+
+let eliminate_ref (program:Flambda.program) =
+  Flambda_iterators.map_exprs_at_toplevel_of_program program
+    ~f:eliminate_ref_of_expr
diff --git a/middle_end/flambda/ref_to_variables.mli b/middle_end/flambda/ref_to_variables.mli
new file mode 100644
index 00000000..38d36889
--- /dev/null
+++ b/middle_end/flambda/ref_to_variables.mli
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Transform [let]-bound references into variables. *)
+
+val eliminate_ref
+   : Flambda.program
+  -> Flambda.program
diff --git a/middle_end/flambda/remove_free_vars_equal_to_args.ml b/middle_end/flambda/remove_free_vars_equal_to_args.ml
new file mode 100644
index 00000000..6327d30c
--- /dev/null
+++ b/middle_end/flambda/remove_free_vars_equal_to_args.ml
@@ -0,0 +1,99 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+let pass_name = "remove-free-vars-equal-to-args"
+let () = Pass_wrapper.register ~pass_name
+
+let rewrite_one_function_decl ~(function_decl : Flambda.function_declaration)
+      ~back_free_vars ~specialised_args =
+  let params_for_equal_free_vars =
+    List.fold_left (fun subst param ->
+        match Variable.Map.find param specialised_args with
+        | exception Not_found ->
+          (* param is not specialised *)
+          subst
+        | (spec_to : Flambda.specialised_to) ->
+          let outside_var = spec_to.var in
+          match Variable.Map.find outside_var back_free_vars with
+          | exception Not_found ->
+            (* No free variables equal to the param *)
+            subst
+          | set ->
+            (* Replace the free variables equal to a parameter *)
+            Variable.Set.fold (fun free_var subst ->
+                Variable.Map.add free_var param subst)
+              set subst)
+      Variable.Map.empty (Parameter.List.vars function_decl.params)
+  in
+  if Variable.Map.is_empty params_for_equal_free_vars then
+    function_decl
+  else
+    let body =
+      Flambda_utils.toplevel_substitution
+        params_for_equal_free_vars
+        function_decl.body
+    in
+    Flambda.update_function_declaration function_decl
+      ~params:function_decl.params ~body:body
+
+let rewrite_one_set_of_closures (set_of_closures : Flambda.set_of_closures) =
+  let back_free_vars =
+    Variable.Map.fold (fun var (outside_var : Flambda.specialised_to) map ->
+        let set =
+          match Variable.Map.find outside_var.var map with
+          | exception Not_found -> Variable.Set.singleton var
+          | set -> Variable.Set.add var set
+        in
+        Variable.Map.add outside_var.var set map)
+      set_of_closures.free_vars Variable.Map.empty
+  in
+  let done_something = ref false in
+  let funs =
+    Variable.Map.map (fun function_decl ->
+        let new_function_decl =
+          rewrite_one_function_decl ~function_decl ~back_free_vars
+            ~specialised_args:set_of_closures.specialised_args
+        in
+        if not (new_function_decl == function_decl) then begin
+          done_something := true
+        end;
+        new_function_decl)
+      set_of_closures.function_decls.funs
+  in
+  if not !done_something then
+    None
+  else
+    let function_decls =
+      Flambda.update_function_declarations
+        set_of_closures.function_decls ~funs
+    in
+    let set_of_closures =
+      Flambda.create_set_of_closures
+        ~function_decls
+        ~free_vars:set_of_closures.free_vars
+        ~specialised_args:set_of_closures.specialised_args
+        ~direct_call_surrogates:set_of_closures.direct_call_surrogates
+    in
+    Some set_of_closures
+
+let run ~ppf_dump set_of_closures =
+  Pass_wrapper.with_dump ~ppf_dump ~pass_name ~input:set_of_closures
+    ~print_input:Flambda.print_set_of_closures
+    ~print_output:Flambda.print_set_of_closures
+    ~f:(fun () -> rewrite_one_set_of_closures set_of_closures)
diff --git a/middle_end/flambda/remove_free_vars_equal_to_args.mli b/middle_end/flambda/remove_free_vars_equal_to_args.mli
new file mode 100644
index 00000000..49f25ac1
--- /dev/null
+++ b/middle_end/flambda/remove_free_vars_equal_to_args.mli
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Replace free variables in closures known to be equal to specialised
+    arguments of such closures with those specialised arguments. *)
+
+val run
+  : ppf_dump:Format.formatter
+  -> Flambda.set_of_closures
+  -> Flambda.set_of_closures option
diff --git a/middle_end/flambda/remove_unused_arguments.ml b/middle_end/flambda/remove_unused_arguments.ml
new file mode 100644
index 00000000..f70da729
--- /dev/null
+++ b/middle_end/flambda/remove_unused_arguments.ml
@@ -0,0 +1,242 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+let pass_name = "remove-unused-arguments"
+let () = Clflags.all_passes := pass_name :: !Clflags.all_passes
+
+let rename_var var =
+  Variable.rename var
+    ~current_compilation_unit:(Compilation_unit.get_current_exn ())
+
+let remove_params unused (fun_decl: Flambda.function_declaration)
+      ~new_fun_var =
+  let unused_params, used_params =
+    List.partition (fun v -> Variable.Set.mem (Parameter.var v) unused)
+      fun_decl.params
+  in
+  let unused_params = List.filter (fun v ->
+      Variable.Set.mem (Parameter.var v) fun_decl.free_variables) unused_params
+  in
+  let body =
+    List.fold_left (fun body param ->
+        Flambda.create_let (Parameter.var param) (Const (Const_pointer 0)) body)
+      fun_decl.body
+      unused_params
+  in
+  Flambda.create_function_declaration ~params:used_params ~body
+    ~stub:fun_decl.stub ~dbg:fun_decl.dbg ~inline:fun_decl.inline
+    ~specialise:fun_decl.specialise ~is_a_functor:fun_decl.is_a_functor
+    ~closure_origin:(Closure_origin.create (Closure_id.wrap new_fun_var))
+
+let make_stub unused var (fun_decl : Flambda.function_declaration)
+    ~specialised_args ~additional_specialised_args =
+  let renamed = rename_var var in
+  let args' =
+    List.map (fun param -> param, Parameter.rename param) fun_decl.params
+  in
+  let used_args' =
+    List.filter (fun (param, _) ->
+      not (Variable.Set.mem (Parameter.var param) unused)) args'
+  in
+  let args'_var =
+    List.map (fun (p1, p2) -> Parameter.var p1, Parameter.var p2) args'
+  in
+  let args_renaming = Variable.Map.of_list args'_var in
+  let additional_specialised_args =
+    List.fold_left (fun additional_specialised_args (original_arg,arg) ->
+        match Variable.Map.find original_arg specialised_args with
+        | exception Not_found -> additional_specialised_args
+        | (outer_var : Flambda.specialised_to) ->
+          (* CR-soon mshinwell: share with Augment_specialised_args *)
+          let outer_var : Flambda.specialised_to =
+            match outer_var.projection with
+            | None -> outer_var
+            | Some projection ->
+              let projection =
+                Projection.map_projecting_from projection ~f:(fun var ->
+                  match Variable.Map.find var args_renaming with
+                  | exception Not_found ->
+                    (* Must always be a parameter of this
+                       [function_decl]. *)
+                    assert false
+                  | wrapper_arg -> wrapper_arg)
+              in
+              { outer_var with
+                projection = Some projection;
+              }
+          in
+          Variable.Map.add arg outer_var additional_specialised_args)
+      additional_specialised_args args'_var
+  in
+  let args = List.map (fun (_, var) -> var) used_args' in
+  let kind = Flambda.Direct (Closure_id.wrap renamed) in
+  let body : Flambda.t =
+    Apply {
+      func = renamed;
+      args = Parameter.List.vars args;
+      kind;
+      dbg = fun_decl.dbg;
+      inline = Default_inline;
+      specialise = Default_specialise;
+    }
+  in
+  let function_decl =
+    Flambda.create_function_declaration ~params:(List.map snd args') ~body
+      ~stub:true ~dbg:fun_decl.dbg ~inline:Default_inline
+      ~specialise:Default_specialise ~is_a_functor:fun_decl.is_a_functor
+      ~closure_origin:fun_decl.closure_origin
+  in
+  function_decl, renamed, additional_specialised_args
+
+let separate_unused_arguments ~only_specialised
+      ~backend ~(set_of_closures : Flambda.set_of_closures) =
+  let function_decls = set_of_closures.function_decls in
+  let unused = Invariant_params.unused_arguments ~backend function_decls in
+  let non_stub_arguments =
+    Variable.Map.fold (fun _ (decl : Flambda.function_declaration) acc ->
+        if decl.stub then
+          acc
+        else
+          Variable.Set.union acc (Parameter.Set.vars decl.Flambda.params))
+      function_decls.funs Variable.Set.empty
+  in
+  let unused = Variable.Set.inter non_stub_arguments unused in
+  let specialised_args = Variable.Map.keys set_of_closures.specialised_args in
+  let unused =
+    if only_specialised then Variable.Set.inter specialised_args unused
+    else unused
+  in
+  if Variable.Set.is_empty unused
+  then None
+  else begin
+    let funs, additional_specialised_args =
+      Variable.Map.fold (fun fun_id (fun_decl : Flambda.function_declaration)
+                          (funs, additional_specialised_args) ->
+          if List.exists (fun v -> Variable.Set.mem (Parameter.var v) unused)
+              fun_decl.params
+          then begin
+            let stub, renamed_fun_id, additional_specialised_args =
+              make_stub unused fun_id fun_decl
+                ~specialised_args:set_of_closures.specialised_args
+                ~additional_specialised_args
+            in
+            let cleaned =
+              remove_params unused fun_decl ~new_fun_var:renamed_fun_id
+            in
+            Variable.Map.add fun_id stub
+              (Variable.Map.add renamed_fun_id cleaned funs),
+            additional_specialised_args
+          end
+          else
+            Variable.Map.add fun_id fun_decl funs,
+            additional_specialised_args
+        )
+        function_decls.funs (Variable.Map.empty, Variable.Map.empty)
+    in
+    let specialised_args =
+      Variable.Map.disjoint_union additional_specialised_args
+        (Variable.Map.filter (fun param _ ->
+            not (Variable.Set.mem param unused))
+          set_of_closures.specialised_args)
+    in
+    let specialised_args =
+      Flambda_utils.clean_projections ~which_variables:specialised_args
+    in
+    let function_decls =
+      Flambda.update_function_declarations function_decls ~funs
+    in
+    let set_of_closures =
+      Flambda.create_set_of_closures ~function_decls
+        ~free_vars:set_of_closures.free_vars ~specialised_args
+        (* CR-soon mshinwell: Use direct_call_surrogates for this
+           transformation. *)
+        ~direct_call_surrogates:set_of_closures.direct_call_surrogates
+    in
+    Some set_of_closures
+  end
+
+(* Splitting is not always beneficial.  For instance when a function
+   is only indirectly called, suppressing unused arguments does not
+   benefit, and introduce an useless intermediate call.  Specialised
+   args should always be beneficial since they should not be used in
+   indirect calls. *)
+let should_split_only_specialised_args
+    (fun_decls : Flambda.function_declarations)
+    ~backend =
+  if not !Clflags.remove_unused_arguments then begin
+    true
+  end else begin
+    let no_recursive_functions =
+      Variable.Set.is_empty
+        (Find_recursive_functions.in_function_declarations fun_decls ~backend)
+    in
+    let number_of_non_stub_functions =
+      Variable.Map.cardinal
+        (Variable.Map.filter (fun _ { Flambda.stub } -> not stub)
+           fun_decls.funs)
+    in
+    (* CR-soon lwhite: this criteria could use some justification.
+       mshinwell: pchambart cannot remember how these criteria arose,
+       but we're going to leave this as-is for 4.03. *)
+    no_recursive_functions && (number_of_non_stub_functions <= 1)
+  end
+
+let separate_unused_arguments_in_set_of_closures set_of_closures ~backend =
+  let dump = Clflags.dumped_pass pass_name in
+  let only_specialised =
+    should_split_only_specialised_args
+       set_of_closures.Flambda.function_decls
+       ~backend
+  in
+  match separate_unused_arguments
+          ~only_specialised ~backend ~set_of_closures with
+  | None ->
+    if dump then
+      Format.eprintf "No change for Remove_unused_arguments:@ %a@.@."
+        Flambda.print_set_of_closures set_of_closures;
+    None
+  | Some result ->
+    if dump then
+      Format.eprintf "Before Remove_unused_arguments:@ %a@.@.\
+                      After Remove_unused_arguments:@ %a@.@."
+        Flambda.print_set_of_closures set_of_closures
+        Flambda.print_set_of_closures result;
+    Some result
+
+let separate_unused_arguments_in_closures_expr tree ~backend =
+  let aux_named (named : Flambda.named) : Flambda.named =
+    match named with
+    | Set_of_closures set_of_closures -> begin
+        let only_specialised =
+          should_split_only_specialised_args
+            set_of_closures.function_decls
+            ~backend
+        in
+        match separate_unused_arguments
+                ~only_specialised ~backend ~set_of_closures with
+        | None -> named
+        | Some set_of_closures -> Set_of_closures set_of_closures
+      end
+    | e -> e
+  in
+  Flambda_iterators.map_named aux_named tree
+
+let separate_unused_arguments_in_closures program ~backend =
+  Flambda_iterators.map_exprs_at_toplevel_of_program program ~f:(fun expr ->
+    separate_unused_arguments_in_closures_expr expr ~backend)
diff --git a/middle_end/flambda/remove_unused_arguments.mli b/middle_end/flambda/remove_unused_arguments.mli
new file mode 100644
index 00000000..759b32f2
--- /dev/null
+++ b/middle_end/flambda/remove_unused_arguments.mli
@@ -0,0 +1,39 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Introduce a stub function to avoid depending on unused arguments.
+
+    For instance, it turns
+      [let rec fact n unused =
+         if n = 0 then 1
+         else n * fact (n-1) unused]
+    into
+      [let rec fact' n =
+         if n = 0 then 1
+         else n * fact' (n-1)
+       and fact n unused = fact' n]
+*)
+val separate_unused_arguments_in_closures
+   : Flambda.program
+  -> backend:(module Backend_intf.S)
+  -> Flambda.program
+
+val separate_unused_arguments_in_set_of_closures
+   : Flambda.set_of_closures
+  -> backend:(module Backend_intf.S)
+  -> Flambda.set_of_closures option
diff --git a/middle_end/flambda/remove_unused_closure_vars.ml b/middle_end/flambda/remove_unused_closure_vars.ml
new file mode 100644
index 00000000..0d4ad621
--- /dev/null
+++ b/middle_end/flambda/remove_unused_closure_vars.ml
@@ -0,0 +1,125 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+(** A variable in a closure can either be used by the closure itself
+    or by an inlined version of the function. *)
+let remove_unused_closure_variables ~remove_direct_call_surrogates program =
+  let used_vars_within_closure, used_closure_ids =
+    let used = Var_within_closure.Tbl.create 13 in
+    let used_fun = Closure_id.Tbl.create 13 in
+    let aux_named (named : Flambda.named) =
+      match named with
+      | Project_closure { set_of_closures = _; closure_id } ->
+        Closure_id.Tbl.add used_fun closure_id ()
+      | Project_var { closure_id; var } ->
+        Var_within_closure.Tbl.add used var ();
+        Closure_id.Tbl.add used_fun closure_id ()
+      | Move_within_set_of_closures { closure = _; start_from; move_to } ->
+        Closure_id.Tbl.add used_fun start_from ();
+        Closure_id.Tbl.add used_fun move_to ()
+      | Symbol _ | Const _ | Set_of_closures _ | Prim _ | Expr _
+      | Allocated_const _ | Read_mutable _ | Read_symbol_field _ -> ()
+    in
+    Flambda_iterators.iter_named_of_program ~f:aux_named program;
+    used, used_fun
+  in
+  let aux_named _ (named : Flambda.named) : Flambda.named =
+    match named with
+    | Set_of_closures ({ function_decls; free_vars; _ } as set_of_closures) ->
+      let direct_call_surrogates =
+        if remove_direct_call_surrogates then Variable.Set.empty
+        else
+          Variable.Set.of_list
+            (Variable.Map.data set_of_closures.direct_call_surrogates)
+      in
+      let rec add_needed needed_funs remaining_funs free_vars_of_kept_funs =
+        let new_needed_funs, remaining_funs =
+          (* Keep a function if it is used either by the rest of the code,
+             (in used_closure_ids), or by any other kept function
+             (in free_vars_of_kept_funs) *)
+          Variable.Map.partition (fun fun_id _ ->
+              Variable.Set.mem fun_id free_vars_of_kept_funs
+              || Closure_id.Tbl.mem used_closure_ids
+                (Closure_id.wrap fun_id)
+              || Variable.Set.mem fun_id direct_call_surrogates)
+            remaining_funs
+        in
+        if Variable.Map.is_empty new_needed_funs then
+          (* If no new function is needed, we reached fixpoint *)
+          needed_funs, free_vars_of_kept_funs
+        else begin
+          let needed_funs =
+            Variable.Map.disjoint_union needed_funs new_needed_funs
+          in
+          let free_vars_of_kept_funs =
+            Variable.Map.fold (fun _ { Flambda. free_variables } acc ->
+                Variable.Set.union free_variables acc)
+              new_needed_funs
+              free_vars_of_kept_funs
+          in
+          add_needed needed_funs remaining_funs free_vars_of_kept_funs
+        end
+      in
+      let funs, free_vars_of_kept_funs =
+        add_needed Variable.Map.empty function_decls.funs Variable.Set.empty
+      in
+      let free_vars =
+        Variable.Map.filter (fun id _var ->
+            Variable.Set.mem id free_vars_of_kept_funs
+            || Var_within_closure.Tbl.mem
+                 used_vars_within_closure
+                 (Var_within_closure.wrap id))
+          free_vars
+      in
+      let function_decls =
+        Flambda.update_function_declarations function_decls ~funs
+      in
+      let specialised_args =
+        (* Remove specialised args that are used by removed functions *)
+        let all_remaining_arguments =
+          Variable.Map.fold (fun _ { Flambda.params } set ->
+              Variable.Set.union set (Parameter.Set.vars params))
+            funs Variable.Set.empty
+        in
+        Variable.Map.filter (fun arg _ ->
+            Variable.Set.mem arg all_remaining_arguments)
+          set_of_closures.specialised_args
+      in
+      let free_vars =
+        Flambda_utils.clean_projections ~which_variables:free_vars
+      in
+      let direct_call_surrogates =
+        (* Remove direct call surrogates where either the existing function
+           or the surrogate has been eliminated. *)
+        Variable.Map.fold (fun existing surrogate surrogates ->
+            if not (Variable.Map.mem existing funs)
+              || not (Variable.Map.mem surrogate funs)
+            then surrogates
+            else Variable.Map.add existing surrogate surrogates)
+          set_of_closures.direct_call_surrogates
+          Variable.Map.empty
+      in
+      let set_of_closures =
+        Flambda.create_set_of_closures ~function_decls
+          ~free_vars ~specialised_args ~direct_call_surrogates
+      in
+      Set_of_closures set_of_closures
+    | e -> e
+  in
+  Flambda_iterators.map_named_of_program ~f:aux_named program
diff --git a/middle_end/flambda/remove_unused_closure_vars.mli b/middle_end/flambda/remove_unused_closure_vars.mli
new file mode 100644
index 00000000..225697a8
--- /dev/null
+++ b/middle_end/flambda/remove_unused_closure_vars.mli
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(* CR-soon mshinwell: Rename this module. *)
+
+(** Eliminate variables bound by sets of closures that are not required.
+    Also eliminate functions within sets of closures that are not required. *)
+val remove_unused_closure_variables
+   : remove_direct_call_surrogates:bool
+  -> Flambda.program
+  -> Flambda.program
diff --git a/middle_end/flambda/remove_unused_program_constructs.ml b/middle_end/flambda/remove_unused_program_constructs.ml
new file mode 100644
index 00000000..059d68bc
--- /dev/null
+++ b/middle_end/flambda/remove_unused_program_constructs.ml
@@ -0,0 +1,111 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+let dependency (expr:Flambda.t) = Flambda.free_symbols expr
+
+(* CR-soon pchambart: copied from lift_constant.  Needs remerging *)
+let constant_dependencies (const:Flambda.constant_defining_value) =
+  let closure_dependencies (set_of_closures:Flambda.set_of_closures) =
+    Flambda.free_symbols_named (Set_of_closures set_of_closures)
+  in
+  match const with
+  | Allocated_const _ -> Symbol.Set.empty
+  | Block (_, fields) ->
+    let symbol_fields =
+      List.filter_map (function
+          | (Symbol s : Flambda.constant_defining_value_block_field) ->
+            Some s
+          | Flambda.Const _ -> None)
+        fields
+    in
+    Symbol.Set.of_list symbol_fields
+  | Set_of_closures set_of_closures -> closure_dependencies set_of_closures
+  | Project_closure (s, _) -> Symbol.Set.singleton s
+
+let let_rec_dep defs dep =
+  let add_deps l dep =
+    List.fold_left (fun dep (sym, sym_dep) ->
+        if Symbol.Set.mem sym dep then Symbol.Set.union dep sym_dep
+        else dep)
+      dep l
+  in
+  let defs_deps =
+    List.map (fun (sym, def) -> sym, constant_dependencies def) defs
+  in
+  let rec fixpoint dep =
+    let new_dep = add_deps defs_deps dep in
+    if Symbol.Set.equal dep new_dep then dep
+    else fixpoint new_dep
+  in
+  fixpoint dep
+
+let rec loop (program : Flambda.program_body)
+      : Flambda.program_body * Symbol.Set.t =
+  match program with
+  | Let_symbol (sym, def, program) ->
+    let program, dep = loop program in
+    if Symbol.Set.mem sym dep then
+      Let_symbol (sym, def, program),
+      Symbol.Set.union dep (constant_dependencies def)
+    else
+      program, dep
+  | Let_rec_symbol (defs, program) ->
+    let program, dep = loop program in
+    let dep = let_rec_dep defs dep in
+    let defs =
+      List.filter (fun (sym, _) -> Symbol.Set.mem sym dep) defs
+    in begin match defs with
+      | [] -> program, dep
+      | _ -> Let_rec_symbol (defs, program), dep
+    end
+  | Initialize_symbol (sym, tag, fields, program) ->
+    let program, dep = loop program in
+    if Symbol.Set.mem sym dep then
+      let dep =
+        List.fold_left (fun dep field ->
+            Symbol.Set.union dep (dependency field))
+          dep fields
+      in
+      Initialize_symbol (sym, tag, fields, program), dep
+    else begin
+      List.fold_left
+        (fun (program, dep) field ->
+           if Effect_analysis.no_effects field then
+             program, dep
+           else
+             let new_dep = dependency field in
+             let dep = Symbol.Set.union new_dep dep in
+             Flambda.Effect (field, program), dep)
+        (program, dep) fields
+    end
+  | Effect (effect, program) ->
+    let program, dep = loop program in
+    if Effect_analysis.no_effects effect then begin
+      program, dep
+    end else begin
+      let new_dep = dependency effect in
+      let dep = Symbol.Set.union new_dep dep in
+      Effect (effect, program), dep
+    end
+  | End symbol -> program, Symbol.Set.singleton symbol
+
+let remove_unused_program_constructs (program : Flambda.program) =
+  { program with
+    program_body = fst (loop program.program_body);
+  }
diff --git a/middle_end/flambda/remove_unused_program_constructs.mli b/middle_end/flambda/remove_unused_program_constructs.mli
new file mode 100644
index 00000000..3a722011
--- /dev/null
+++ b/middle_end/flambda/remove_unused_program_constructs.mli
@@ -0,0 +1,24 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(* Remove unused [Flambda.program] constructs from the given program.
+   - Symbols (whose defining expressions have no effects) are eliminated
+     if unused.
+   - [Effect] constructs that turn out to have no effects are eliminated.
+*)
+val remove_unused_program_constructs : Flambda.program -> Flambda.program
diff --git a/middle_end/flambda/share_constants.ml b/middle_end/flambda/share_constants.ml
new file mode 100644
index 00000000..2bbd7134
--- /dev/null
+++ b/middle_end/flambda/share_constants.ml
@@ -0,0 +1,130 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module Constant_defining_value = Flambda.Constant_defining_value
+
+let update_constant_for_sharing sharing_symbol_tbl const
+      : Flambda.constant_defining_value =
+  let substitute_symbol sym =
+    match Symbol.Tbl.find sharing_symbol_tbl sym with
+    | exception Not_found -> sym
+    | symbol -> symbol
+  in
+  match (const:Flambda.constant_defining_value) with
+  | Allocated_const _ -> const
+  | Block (tag, fields) ->
+    let subst_field (field:Flambda.constant_defining_value_block_field) :
+      Flambda.constant_defining_value_block_field =
+      match field with
+      | Const _ -> field
+      | Symbol sym ->
+        Symbol (substitute_symbol sym)
+    in
+    let fields = List.map subst_field fields in
+    Block (tag, fields)
+  | Set_of_closures set_of_closures ->
+    Set_of_closures (
+      Flambda_iterators.map_symbols_on_set_of_closures
+        ~f:substitute_symbol set_of_closures
+    )
+  | Project_closure (sym, closure_id) ->
+    Project_closure (substitute_symbol sym, closure_id)
+
+let cannot_share (const : Flambda.constant_defining_value) =
+  match const with
+  (* Strings and float arrays are mutable; we never share them. *)
+  | Allocated_const ((String _) | (Float_array _)) -> true
+  | Allocated_const _ | Set_of_closures _ | Project_closure _ | Block _ ->
+    false
+
+let share_definition constant_to_symbol_tbl sharing_symbol_tbl
+    symbol def end_symbol =
+  let def = update_constant_for_sharing sharing_symbol_tbl def in
+  if cannot_share def || Symbol.equal symbol end_symbol then
+    (* The symbol exported by the unit (end_symbol), cannot be removed
+       from the module. We prevent it from being shared to avoid that. *)
+    Some def
+  else
+    begin match Constant_defining_value.Tbl.find constant_to_symbol_tbl def with
+    | exception Not_found ->
+      Constant_defining_value.Tbl.add constant_to_symbol_tbl def symbol;
+      Some def
+    | equal_symbol ->
+      Symbol.Tbl.add sharing_symbol_tbl symbol equal_symbol;
+      None
+    end
+
+let rec end_symbol (program : Flambda.program_body) =
+  match program with
+  | End symbol -> symbol
+  | Let_symbol (_, _, program)
+  | Let_rec_symbol (_, program)
+  | Initialize_symbol (_, _, _, program)
+  | Effect (_, program) ->
+    end_symbol program
+
+let share_constants (program : Flambda.program) =
+  let end_symbol = end_symbol program.program_body in
+  let sharing_symbol_tbl = Symbol.Tbl.create 42 in
+  let constant_to_symbol_tbl = Constant_defining_value.Tbl.create 42 in
+  let rec loop (program : Flambda.program_body) : Flambda.program_body =
+    match program with
+    | Let_symbol (symbol,def,program) ->
+      begin match
+        share_definition constant_to_symbol_tbl sharing_symbol_tbl symbol
+          def end_symbol
+      with
+      | None ->
+        loop program
+      | Some def' ->
+        Let_symbol (symbol,def',loop program)
+      end
+    | Let_rec_symbol (defs,program) ->
+      let defs =
+        List.map (fun (symbol, def) ->
+            let def = update_constant_for_sharing sharing_symbol_tbl def in
+            symbol, def)
+          defs
+      in
+      Let_rec_symbol (defs, loop program)
+    | Initialize_symbol (symbol,tag,fields,program) ->
+      let fields =
+        List.map (fun field ->
+            Flambda_iterators.map_symbols
+              ~f:(fun symbol ->
+                  try Symbol.Tbl.find sharing_symbol_tbl symbol with
+                  | Not_found -> symbol)
+              field)
+          fields
+      in
+      Initialize_symbol (symbol,tag,fields,loop program)
+    | Effect (expr,program) ->
+      let expr =
+        Flambda_iterators.map_symbols
+          ~f:(fun symbol ->
+              try Symbol.Tbl.find sharing_symbol_tbl symbol with
+              | Not_found -> symbol)
+          expr
+      in
+      Effect (expr, loop program)
+    | End root -> End root
+  in
+  { program with
+    program_body = loop program.program_body;
+  }
diff --git a/middle_end/flambda/share_constants.mli b/middle_end/flambda/share_constants.mli
new file mode 100644
index 00000000..7fec22bc
--- /dev/null
+++ b/middle_end/flambda/share_constants.mli
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Share lifted constants that are eligible for sharing (e.g. not strings)
+    and have equal definitions. *)
+
+val share_constants : Flambda.program -> Flambda.program
diff --git a/middle_end/flambda/simple_value_approx.ml b/middle_end/flambda/simple_value_approx.ml
new file mode 100644
index 00000000..d527674f
--- /dev/null
+++ b/middle_end/flambda/simple_value_approx.ml
@@ -0,0 +1,1043 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module U = Flambda_utils
+
+type 'a boxed_int =
+  | Int32 : int32 boxed_int
+  | Int64 : int64 boxed_int
+  | Nativeint : nativeint boxed_int
+
+type value_string = {
+  (* CR-soon mshinwell: use variant *)
+  contents : string option; (* None if unknown or mutable *)
+  size : int;
+}
+
+type unresolved_value =
+  | Set_of_closures_id of Set_of_closures_id.t
+  | Symbol of Symbol.t
+
+type unknown_because_of =
+  | Unresolved_value of unresolved_value
+  | Other
+
+type t = {
+  descr : descr;
+  var : Variable.t option;
+  symbol : (Symbol.t * int option) option;
+}
+
+and descr =
+  | Value_block of Tag.t * t array
+  | Value_int of int
+  | Value_char of char
+  | Value_constptr of int
+  | Value_float of float option
+  | Value_boxed_int : 'a boxed_int * 'a -> descr
+  | Value_set_of_closures of value_set_of_closures
+  | Value_closure of value_closure
+  | Value_string of value_string
+  | Value_float_array of value_float_array
+  | Value_unknown of unknown_because_of
+  | Value_bottom
+  | Value_extern of Export_id.t
+  | Value_symbol of Symbol.t
+  | Value_unresolved of unresolved_value
+    (* No description was found for this value *)
+
+and value_closure = {
+  set_of_closures : t;
+  closure_id : Closure_id.t;
+}
+
+and function_declarations = {
+  is_classic_mode : bool;
+  set_of_closures_id : Set_of_closures_id.t;
+  set_of_closures_origin : Set_of_closures_origin.t;
+  funs : function_declaration Variable.Map.t;
+}
+
+and function_body = {
+  free_variables : Variable.Set.t;
+  free_symbols : Symbol.Set.t;
+  stub : bool;
+  dbg : Debuginfo.t;
+  inline : Lambda.inline_attribute;
+  specialise : Lambda.specialise_attribute;
+  is_a_functor : bool;
+  body : Flambda.t;
+}
+
+and function_declaration = {
+  closure_origin : Closure_origin.t;
+  params : Parameter.t list;
+  function_body : function_body option;
+}
+
+and value_set_of_closures = {
+  function_decls : function_declarations;
+  bound_vars : t Var_within_closure.Map.t;
+  free_vars  : Flambda.specialised_to Variable.Map.t;
+  invariant_params : Variable.Set.t Variable.Map.t Lazy.t;
+  recursive : Variable.Set.t Lazy.t;
+  size : int option Variable.Map.t Lazy.t;
+  specialised_args : Flambda.specialised_to Variable.Map.t;
+  freshening : Freshening.Project_var.t;
+  direct_call_surrogates : Closure_id.t Closure_id.Map.t;
+}
+
+and value_float_array_contents =
+  | Contents of t array
+  | Unknown_or_mutable
+
+and value_float_array = {
+  contents : value_float_array_contents;
+  size : int;
+}
+
+let descr t = t.descr
+
+let print_value_set_of_closures ppf
+      { function_decls = { funs }; invariant_params; freshening; size; _ } =
+  Format.fprintf ppf
+    "(set_of_closures:@ %a invariant_params=%a freshening=%a size=%a)"
+    (fun ppf -> Variable.Map.iter (fun id _ -> Variable.print ppf id)) funs
+    (Variable.Map.print Variable.Set.print) (Lazy.force invariant_params)
+    Freshening.Project_var.print freshening
+    (Variable.Map.print (fun ppf some_size ->
+       match some_size with
+       | None -> Format.fprintf ppf "None"
+       | Some size -> Format.fprintf ppf "Some %d" size))
+    (Lazy.force size)
+
+let print_unresolved_value ppf = function
+  | Set_of_closures_id set ->
+    Format.fprintf ppf "Set_of_closures_id %a" Set_of_closures_id.print set
+  | Symbol symbol ->
+    Format.fprintf ppf "Symbol %a" Symbol.print symbol
+
+let print_function_declaration ppf var (f : function_declaration) =
+  let param ppf p = Variable.print ppf (Parameter.var p) in
+  let params ppf = List.iter (Format.fprintf ppf "@ %a" param) in
+  match f.function_body with
+  | None ->
+    Format.fprintf ppf "@[<2>(%a@ =@ fun@[<2>%a@])@]@ "
+      Variable.print var params f.params
+  | Some (b : function_body) ->
+    let stub = if b.stub then " *stub*" else "" in
+    let is_a_functor = if b.is_a_functor then " *functor*" else "" in
+    let inline =
+      match b.inline with
+      | Always_inline | Hint_inline -> " *inline*"
+      | Never_inline -> " *never_inline*"
+      | Unroll _ -> " *unroll*"
+      | Default_inline -> ""
+    in
+    let specialise =
+      match b.specialise with
+      | Always_specialise -> " *specialise*"
+      | Never_specialise -> " *never_specialise*"
+      | Default_specialise -> ""
+    in
+    let print_body ppf _ =
+      Format.fprintf ppf ""
+    in
+    Format.fprintf ppf "@[<2>(%a%s%s%s%s@ =@ fun@[<2>%a@] ->@ @[<2><%a>@])@]@ "
+      Variable.print var stub is_a_functor inline specialise
+      params f.params
+      print_body b
+
+let print_function_declarations ppf (fd : function_declarations) =
+  let funs ppf = Variable.Map.iter (print_function_declaration ppf) in
+  Format.fprintf ppf "@[<2>(%a)@]" funs fd.funs
+
+let rec print_descr ppf = function
+  | Value_int i -> Format.pp_print_int ppf i
+  | Value_char c -> Format.fprintf ppf "%c" c
+  | Value_constptr i -> Format.fprintf ppf "%ia" i
+  | Value_block (tag,fields) ->
+    let p ppf fields =
+      Array.iter (fun v -> Format.fprintf ppf "%a@ " print v) fields in
+    Format.fprintf ppf "[%i:@ @[<1>%a@]]" (Tag.to_int tag) p fields
+  | Value_unknown reason ->
+    begin match reason with
+    | Unresolved_value value ->
+      Format.fprintf ppf "?(due to unresolved %a)" print_unresolved_value value
+    | Other -> Format.fprintf ppf "?"
+    end;
+  | Value_bottom -> Format.fprintf ppf "bottom"
+  | Value_extern id -> Format.fprintf ppf "_%a_" Export_id.print id
+  | Value_symbol sym -> Format.fprintf ppf "%a" Symbol.print sym
+  | Value_closure { set_of_closures; closure_id; } ->
+    Format.fprintf ppf "(closure:@ %a from@ %a)" Closure_id.print closure_id
+      print set_of_closures
+  | Value_set_of_closures set_of_closures ->
+    print_value_set_of_closures ppf set_of_closures
+  | Value_unresolved value ->
+    Format.fprintf ppf "(unresolved %a)" print_unresolved_value value
+  | Value_float (Some f) -> Format.pp_print_float ppf f
+  | Value_float None -> Format.pp_print_string ppf "float"
+  | Value_string { contents; size } -> begin
+      match contents with
+      | None ->
+          Format.fprintf ppf "string %i" size
+      | Some s ->
+          let s =
+            if size > 10
+            then String.sub s 0 8 ^ "..."
+            else s
+          in
+          Format.fprintf ppf "string %i %S" size s
+    end
+  | Value_float_array float_array ->
+    begin match float_array.contents with
+    | Unknown_or_mutable ->
+      Format.fprintf ppf "float_array %i" float_array.size
+    | Contents _ ->
+      Format.fprintf ppf "float_array_imm %i" float_array.size
+    end
+  | Value_boxed_int (t, i) ->
+    match t with
+    | Int32 -> Format.fprintf ppf "%li" i
+    | Int64 -> Format.fprintf ppf "%Li" i
+    | Nativeint -> Format.fprintf ppf "%ni" i
+
+and print ppf { descr; var; symbol; } =
+  let print ppf = function
+    | None -> Symbol.print_opt ppf None
+    | Some (sym, None) -> Symbol.print ppf sym
+    | Some (sym, Some field) ->
+        Format.fprintf ppf "%a.(%i)" Symbol.print sym field
+  in
+  Format.fprintf ppf "{ descr=%a var=%a symbol=%a }"
+    print_descr descr
+    Variable.print_opt var
+    print symbol
+
+let approx descr = { descr; var = None; symbol = None }
+
+let augment_with_variable t var = { t with var = Some var }
+let augment_with_symbol t symbol = { t with symbol = Some (symbol, None) }
+let augment_with_symbol_field t symbol field =
+  match t.symbol with
+  | None -> { t with symbol = Some (symbol, Some field) }
+  | Some _ -> t
+let replace_description t descr = { t with descr }
+
+let augment_with_kind t (kind:Lambda.value_kind) =
+  match kind with
+  | Pgenval -> t
+  | Pfloatval ->
+    begin match t.descr with
+    | Value_float _ ->
+      t
+    | Value_unknown _ | Value_unresolved _ ->
+      { t with descr = Value_float None }
+    | Value_block _
+    | Value_int _
+    | Value_char _
+    | Value_constptr _
+    | Value_boxed_int _
+    | Value_set_of_closures _
+    | Value_closure _
+    | Value_string _
+    | Value_float_array _
+    | Value_bottom ->
+      (* Unreachable *)
+      { t with descr = Value_bottom }
+    | Value_extern _ | Value_symbol _ ->
+      (* We don't know yet *)
+      t
+    end
+  | _ -> t
+
+let augment_kind_with_approx t (kind:Lambda.value_kind) : Lambda.value_kind =
+  match t.descr with
+  | Value_float _ -> Pfloatval
+  | Value_int _ -> Pintval
+  | Value_boxed_int (Int32, _) -> Pboxedintval Pint32
+  | Value_boxed_int (Int64, _) -> Pboxedintval Pint64
+  | Value_boxed_int (Nativeint, _) -> Pboxedintval Pnativeint
+  | _ -> kind
+
+let value_unknown reason = approx (Value_unknown reason)
+let value_int i = approx (Value_int i)
+let value_char i = approx (Value_char i)
+let value_constptr i = approx (Value_constptr i)
+let value_float f = approx (Value_float (Some f))
+let value_any_float = approx (Value_float None)
+let value_boxed_int bi i = approx (Value_boxed_int (bi,i))
+
+let value_closure ?closure_var ?set_of_closures_var ?set_of_closures_symbol
+      value_set_of_closures closure_id =
+  let approx_set_of_closures =
+    { descr = Value_set_of_closures value_set_of_closures;
+      var = set_of_closures_var;
+      symbol = Option.map (fun s -> s, None) set_of_closures_symbol;
+    }
+  in
+  let value_closure =
+    { set_of_closures = approx_set_of_closures;
+      closure_id;
+    }
+  in
+  { descr = Value_closure value_closure;
+    var = closure_var;
+    symbol = None;
+  }
+
+let create_value_set_of_closures
+      ~(function_decls : function_declarations) ~bound_vars ~free_vars
+      ~invariant_params ~recursive ~specialised_args ~freshening
+      ~direct_call_surrogates =
+  let size =
+    lazy (
+      let functions = Variable.Map.keys function_decls.funs in
+      Variable.Map.fold
+        (fun fun_var function_decl sizes ->
+          match function_decl.function_body with
+          | None -> sizes
+          | Some function_body ->
+              let params = Parameter.Set.vars function_decl.params in
+              let free_vars =
+                Variable.Set.diff
+                  (Variable.Set.diff function_body.free_variables params)
+                  functions
+              in
+              let num_free_vars = Variable.Set.cardinal free_vars in
+              let max_size =
+                Inlining_cost.maximum_interesting_size_of_function_body
+                  num_free_vars
+              in
+              let size =
+                Inlining_cost.lambda_smaller' function_body.body ~than:max_size
+              in
+              Variable.Map.add fun_var size sizes)
+        function_decls.funs Variable.Map.empty)
+  in
+  { function_decls;
+    bound_vars;
+    free_vars;
+    invariant_params;
+    recursive;
+    size;
+    specialised_args;
+    freshening;
+    direct_call_surrogates;
+  }
+
+let update_freshening_of_value_set_of_closures value_set_of_closures
+      ~freshening =
+  (* CR-someday mshinwell: We could maybe check that [freshening] is
+     reasonable. *)
+  { value_set_of_closures with freshening; }
+
+let value_set_of_closures ?set_of_closures_var value_set_of_closures =
+  { descr = Value_set_of_closures value_set_of_closures;
+    var = set_of_closures_var;
+    symbol = None;
+  }
+
+let value_block t b = approx (Value_block (t, b))
+let value_extern ex = approx (Value_extern ex)
+let value_symbol sym =
+  { (approx (Value_symbol sym)) with symbol = Some (sym, None) }
+let value_bottom = approx Value_bottom
+let value_unresolved value = approx (Value_unresolved value)
+
+let value_string size contents = approx (Value_string {size; contents })
+let value_mutable_float_array ~size =
+  approx (Value_float_array { contents = Unknown_or_mutable; size; } )
+let value_immutable_float_array (contents:t array) =
+  let size = Array.length contents in
+  let contents =
+    Array.map (fun t -> augment_with_kind t Pfloatval) contents
+  in
+  approx (Value_float_array { contents = Contents contents; size; } )
+
+let name_expr_fst (named, thing) ~name =
+  (Flambda_utils.name_expr named ~name), thing
+
+let make_const_int_named n : Flambda.named * t =
+  Const (Int n), value_int n
+let make_const_int (n : int) =
+  let name =
+    match n with
+    | 0 -> Internal_variable_names.const_zero
+    | 1 -> Internal_variable_names.const_one
+    | _ -> Internal_variable_names.const_int
+  in
+  name_expr_fst (make_const_int_named n) ~name
+
+let make_const_char_named n : Flambda.named * t =
+  Const (Char n), value_char n
+let make_const_char n =
+  let name = Internal_variable_names.const_char in
+  name_expr_fst (make_const_char_named n) ~name
+
+let make_const_ptr_named n : Flambda.named * t =
+  Const (Const_pointer n), value_constptr n
+let make_const_ptr (n : int) =
+  let name =
+    match n with
+    | 0 -> Internal_variable_names.const_ptr_zero
+    | 1 -> Internal_variable_names.const_ptr_one
+    | _ -> Internal_variable_names.const_ptr
+  in
+  name_expr_fst (make_const_ptr_named n) ~name
+
+let make_const_bool_named b : Flambda.named * t =
+  make_const_ptr_named (if b then 1 else 0)
+let make_const_bool b =
+  name_expr_fst (make_const_bool_named b)
+    ~name:Internal_variable_names.const_bool
+
+let make_const_float_named f : Flambda.named * t =
+  Allocated_const (Float f), value_float f
+let make_const_float f =
+  name_expr_fst (make_const_float_named f)
+    ~name:Internal_variable_names.const_float
+
+let make_const_boxed_int_named (type bi) (t:bi boxed_int) (i:bi)
+      : Flambda.named * t =
+  let c : Allocated_const.t =
+    match t with
+    | Int32 -> Int32 i
+    | Int64 -> Int64 i
+    | Nativeint -> Nativeint i
+  in
+  Allocated_const c, value_boxed_int t i
+let make_const_boxed_int t i =
+  name_expr_fst (make_const_boxed_int_named t i)
+    ~name:Internal_variable_names.const_boxed_int
+
+type simplification_summary =
+  | Nothing_done
+  | Replaced_term
+
+type simplification_result = Flambda.t * simplification_summary * t
+type simplification_result_named = Flambda.named * simplification_summary * t
+
+let simplify t (lam : Flambda.t) : simplification_result =
+  if Effect_analysis.no_effects lam then
+    match t.descr with
+    | Value_int n ->
+      let const, approx = make_const_int n in
+      const, Replaced_term, approx
+    | Value_char n ->
+      let const, approx = make_const_char n in
+      const, Replaced_term, approx
+    | Value_constptr n ->
+      let const, approx = make_const_ptr n in
+      const, Replaced_term, approx
+    | Value_float (Some f) ->
+      let const, approx = make_const_float f in
+      const, Replaced_term, approx
+    | Value_boxed_int (t, i) ->
+      let const, approx = make_const_boxed_int t i in
+      const, Replaced_term, approx
+    | Value_symbol sym ->
+      let name = Internal_variable_names.symbol in
+      U.name_expr (Symbol sym) ~name, Replaced_term, t
+    | Value_string _ | Value_float_array _ | Value_float None
+    | Value_block _ | Value_set_of_closures _ | Value_closure _
+    | Value_unknown _ | Value_bottom | Value_extern _ | Value_unresolved _ ->
+      lam, Nothing_done, t
+  else
+    lam, Nothing_done, t
+
+let simplify_named t (named : Flambda.named) : simplification_result_named =
+  if Effect_analysis.no_effects_named named then
+    match t.descr with
+    | Value_int n ->
+      let const, approx = make_const_int_named n in
+      const, Replaced_term, approx
+    | Value_char n ->
+      let const, approx = make_const_char_named n in
+      const, Replaced_term, approx
+    | Value_constptr n ->
+      let const, approx = make_const_ptr_named n in
+      const, Replaced_term, approx
+    | Value_float (Some f) ->
+      let const, approx = make_const_float_named f in
+      const, Replaced_term, approx
+    | Value_boxed_int (t, i) ->
+      let const, approx = make_const_boxed_int_named t i in
+      const, Replaced_term, approx
+    | Value_symbol sym ->
+      Symbol sym, Replaced_term, t
+    | Value_string _ | Value_float_array _ | Value_float None
+    | Value_block _ | Value_set_of_closures _ | Value_closure _
+    | Value_unknown _ | Value_bottom | Value_extern _ | Value_unresolved _ ->
+      named, Nothing_done, t
+  else
+    named, Nothing_done, t
+
+(* CR-soon mshinwell: bad name.  This function and its call site in
+   [Inline_and_simplify] is also messy. *)
+let simplify_var t : (Flambda.named * t) option =
+  match t.descr with
+  | Value_int n -> Some (make_const_int_named n)
+  | Value_char n -> Some (make_const_char_named n)
+  | Value_constptr n -> Some (make_const_ptr_named n)
+  | Value_float (Some f) -> Some (make_const_float_named f)
+  | Value_boxed_int (t, i) -> Some (make_const_boxed_int_named t i)
+  | Value_symbol sym -> Some (Symbol sym, t)
+  | Value_string _ | Value_float_array _ | Value_float None
+  | Value_block _ | Value_set_of_closures _ | Value_closure _
+  | Value_unknown _ | Value_bottom | Value_extern _
+  | Value_unresolved _ ->
+    match t.symbol with
+    | Some (sym, None) -> Some (Symbol sym, t)
+    | Some (sym, Some field) -> Some (Read_symbol_field (sym, field), t)
+    | None -> None
+
+let join_summaries summary ~replaced_by_var_or_symbol =
+  match replaced_by_var_or_symbol, summary with
+  | true, Nothing_done
+  | true, Replaced_term
+  | false, Replaced_term -> Replaced_term
+  | false, Nothing_done -> Nothing_done
+
+let simplify_using_env t ~is_present_in_env flam =
+  let replaced_by_var_or_symbol, flam =
+    match t.var with
+    | Some var when is_present_in_env var -> true, Flambda.Var var
+    | _ ->
+      match t.symbol with
+      | Some (sym, None) ->
+        let name = Internal_variable_names.symbol in
+        (true, U.name_expr (Symbol sym) ~name)
+      | Some (sym, Some field) ->
+        let name = Internal_variable_names.symbol_field in
+        (true, U.name_expr (Read_symbol_field (sym, field)) ~name)
+      | None -> false, flam
+  in
+  let const, summary, approx = simplify t flam in
+  const, join_summaries summary ~replaced_by_var_or_symbol, approx
+
+let simplify_named_using_env t ~is_present_in_env named =
+  let replaced_by_var_or_symbol, named =
+    match t.var with
+    | Some var when is_present_in_env var ->
+      true, Flambda.Expr (Var var)
+    | _ ->
+      match t.symbol with
+      | Some (sym, None) -> true, (Flambda.Symbol sym:Flambda.named)
+      | Some (sym, Some field) ->
+        true, Flambda.Read_symbol_field (sym, field)
+      | None -> false, named
+  in
+  let const, summary, approx = simplify_named t named in
+  const, join_summaries summary ~replaced_by_var_or_symbol, approx
+
+let simplify_var_to_var_using_env t ~is_present_in_env =
+  match t.var with
+  | Some var when is_present_in_env var -> Some var
+  | _ -> None
+
+let known t =
+  match t.descr with
+  | Value_unresolved _
+  | Value_unknown _ -> false
+  | Value_string _ | Value_float_array _
+  | Value_bottom | Value_block _ | Value_int _ | Value_char _
+  | Value_constptr _ | Value_set_of_closures _ | Value_closure _
+  | Value_extern _ | Value_float _ | Value_boxed_int _ | Value_symbol _ -> true
+
+let useful t =
+  match t.descr with
+  | Value_unresolved _ | Value_unknown _ | Value_bottom -> false
+  | Value_string _ | Value_float_array _ | Value_block _ | Value_int _
+  | Value_char _ | Value_constptr _ | Value_set_of_closures _
+  | Value_float _ | Value_boxed_int _ | Value_closure _ | Value_extern _
+  | Value_symbol _ -> true
+
+let all_not_useful ts = List.for_all (fun t -> not (useful t)) ts
+
+let warn_on_mutation t =
+  match t.descr with
+  | Value_block(_, fields) -> Array.length fields > 0
+  | Value_string { contents = Some _ }
+  | Value_int _ | Value_char _ | Value_constptr _
+  | Value_set_of_closures _ | Value_float _ | Value_boxed_int _
+  | Value_closure _ -> true
+  | Value_string { contents = None } | Value_float_array _
+  | Value_unresolved _ | Value_unknown _ | Value_bottom -> false
+  | Value_extern _ | Value_symbol _ -> assert false
+
+type get_field_result =
+  | Ok of t
+  | Unreachable
+
+let get_field t ~field_index:i : get_field_result =
+  match t.descr with
+  | Value_block (_tag, fields) ->
+    if i >= 0 && i < Array.length fields then begin
+      Ok fields.(i)
+    end else begin
+      (* This (unfortunately) cannot be a fatal error; it can happen if a
+         .cmx file is missing.  However for debugging the compiler this can
+         be a useful point to put a [Misc.fatal_errorf]. *)
+      Unreachable
+    end
+  (* CR-someday mshinwell: This should probably return Unreachable in more
+     cases.  I added a couple more. *)
+  | Value_bottom
+  | Value_int _ | Value_char _ | Value_constptr _ ->
+    (* Something seriously wrong is happening: either the user is doing
+       something exceptionally unsafe, or it is an unreachable branch.
+       We consider this as unreachable and mark the result accordingly. *)
+    Ok value_bottom
+  | Value_float_array _ ->
+    (* For the moment we return "unknown" even for immutable arrays, since
+       it isn't possible for user code to project from an immutable array. *)
+    (* CR-someday mshinwell: If Leo's array's patch lands, then we can
+       change this, although it's probably not Pfield that is used to
+       do the projection. *)
+    Ok (value_unknown Other)
+  | Value_string _ | Value_float _ | Value_boxed_int _ ->
+    (* The user is doing something unsafe. *)
+    Unreachable
+  | Value_set_of_closures _ | Value_closure _
+    (* This is used by [CamlinternalMod]. *)
+  | Value_symbol _ | Value_extern _ ->
+    (* These should have been resolved. *)
+    Ok (value_unknown Other)
+  | Value_unknown reason ->
+    Ok (value_unknown reason)
+  | Value_unresolved value ->
+    (* We don't know anything, but we must remember that it comes
+       from another compilation unit in case it contains a closure. *)
+    Ok (value_unknown (Unresolved_value value))
+
+type checked_approx_for_block =
+  | Wrong
+  | Ok of Tag.t * t array
+
+let check_approx_for_block t =
+  match t.descr with
+  | Value_block (tag, fields) ->
+    Ok (tag, fields)
+  | Value_bottom
+  | Value_int _ | Value_char _ | Value_constptr _
+  | Value_float_array _
+  | Value_string _ | Value_float _ | Value_boxed_int _
+  | Value_set_of_closures _ | Value_closure _
+  | Value_symbol _ | Value_extern _
+  | Value_unknown _
+  | Value_unresolved _ ->
+    Wrong
+
+let descrs approxs = List.map (fun v -> v.descr) approxs
+
+let equal_boxed_int (type t1) (type t2)
+    (bi1:t1 boxed_int) (i1:t1)
+    (bi2:t2 boxed_int) (i2:t2) =
+  match bi1, bi2 with
+  | Int32, Int32 -> Int32.equal i1 i2
+  | Int64, Int64 -> Int64.equal i1 i2
+  | Nativeint, Nativeint -> Nativeint.equal i1 i2
+  | _ -> false
+
+let equal_floats f1 f2 =
+  match f1, f2 with
+  | None, None -> true
+  | None, Some _ | Some _, None -> false
+  | Some f1, Some f2 -> Allocated_const.compare_floats f1 f2 = 0
+
+(* Closures and set of closures descriptions cannot be merged.
+
+   let f x =
+     let g y -> x + y in
+     g
+   in
+   let v =
+     if ...
+     then f 1
+     else f 2
+   in
+   v 3
+
+   The approximation for [f 1] and [f 2] could both contain the
+   description of [g]. But if [f] where inlined, a new [g] would
+   be created in each branch, leading to incompatible description.
+   And we must never make the description for a function less
+   precise that it used to be: its information are needed for
+   rewriting [Project_var] and [Project_closure] constructions
+   in [Flambdainline.loop]
+*)
+let rec meet_descr ~really_import_approx d1 d2 = match d1, d2 with
+  | Value_int i, Value_int j when i = j ->
+      d1
+  | Value_constptr i, Value_constptr j when i = j ->
+      d1
+  | Value_symbol s1, Value_symbol s2 when Symbol.equal s1 s2 ->
+      d1
+  | Value_extern e1, Value_extern e2 when Export_id.equal e1 e2 ->
+      d1
+  | Value_float i, Value_float j when equal_floats i j ->
+      d1
+  | Value_boxed_int (bi1, i1), Value_boxed_int (bi2, i2) when
+      equal_boxed_int bi1 i1 bi2 i2 ->
+      d1
+  | Value_block (tag1, a1), Value_block (tag2, a2)
+    when Tag.compare tag1 tag2 = 0 && Array.length a1 = Array.length a2 ->
+    let fields =
+      Array.mapi (fun i v -> meet ~really_import_approx v a2.(i)) a1
+    in
+    Value_block (tag1, fields)
+  | _ -> Value_unknown Other
+
+and meet ~really_import_approx a1 a2 =
+  match a1, a2 with
+  | { descr = Value_bottom }, a
+  | a, { descr = Value_bottom } -> a
+  | { descr = (Value_symbol _ | Value_extern _) }, _
+  | _, { descr = (Value_symbol _ | Value_extern _) } ->
+    meet ~really_import_approx
+      (really_import_approx a1) (really_import_approx a2)
+  | _ ->
+      let var =
+        match a1.var, a2.var with
+        | None, _ | _, None -> None
+        | Some v1, Some v2 ->
+            if Variable.equal v1 v2
+            then Some v1
+            else None
+      in
+      let symbol =
+        match a1.symbol, a2.symbol with
+        | None, _ | _, None -> None
+        | Some (v1, field1), Some (v2, field2) ->
+            if Symbol.equal v1 v2
+            then match field1, field2 with
+              | None, None -> a1.symbol
+              | Some f1, Some f2 when f1 = f2 ->
+                  a1.symbol
+              | _ -> None
+            else None
+      in
+      { descr = meet_descr ~really_import_approx a1.descr a2.descr;
+        var;
+        symbol }
+
+(* Given a set-of-closures approximation and a closure ID, apply any
+   freshening specified in the approximation to the closure ID, and return
+   that new closure ID.  A fatal error is produced if the new closure ID
+   does not correspond to a function declaration in the given approximation. *)
+let freshen_and_check_closure_id
+      (value_set_of_closures : value_set_of_closures) closure_id =
+  let closure_id =
+    Freshening.Project_var.apply_closure_id
+      value_set_of_closures.freshening closure_id
+  in
+  try
+    ignore (
+      Variable.Map.find (Closure_id.unwrap closure_id)
+        value_set_of_closures.function_decls.funs
+    );
+    closure_id
+  with Not_found ->
+    Misc.fatal_error (Format.asprintf
+      "Function %a not found in the set of closures@ %a@.%a@."
+      Closure_id.print closure_id
+      print_value_set_of_closures value_set_of_closures
+      print_function_declarations value_set_of_closures.function_decls)
+
+type checked_approx_for_set_of_closures =
+  | Wrong
+  | Unresolved of unresolved_value
+  | Unknown
+  | Unknown_because_of_unresolved_value of unresolved_value
+  | Ok of Variable.t option * value_set_of_closures
+
+let check_approx_for_set_of_closures t : checked_approx_for_set_of_closures =
+  match t.descr with
+  | Value_unresolved value -> Unresolved value
+  | Value_unknown (Unresolved_value value) ->
+    Unknown_because_of_unresolved_value value
+  | Value_set_of_closures value_set_of_closures ->
+    (* Note that [var] might be [None]; we might be reaching the set of
+       closures via approximations only, with the variable originally bound
+       to the set now out of scope. *)
+    Ok (t.var, value_set_of_closures)
+  | Value_closure _ | Value_block _ | Value_int _ | Value_char _
+  | Value_constptr _ | Value_float _ | Value_boxed_int _ | Value_unknown _
+  | Value_bottom | Value_extern _ | Value_string _ | Value_float_array _
+  | Value_symbol _ ->
+    Wrong
+
+type strict_checked_approx_for_set_of_closures =
+  | Wrong
+  | Ok of Variable.t option * value_set_of_closures
+
+let strict_check_approx_for_set_of_closures t
+      : strict_checked_approx_for_set_of_closures =
+  match check_approx_for_set_of_closures t with
+  | Ok (var, value_set_of_closures) -> Ok (var, value_set_of_closures)
+  | Wrong | Unresolved _
+  | Unknown | Unknown_because_of_unresolved_value _ -> Wrong
+
+type checked_approx_for_closure_allowing_unresolved =
+  | Wrong
+  | Unresolved of unresolved_value
+  | Unknown
+  | Unknown_because_of_unresolved_value of unresolved_value
+  | Ok of value_closure * Variable.t option
+          * Symbol.t option * value_set_of_closures
+
+let check_approx_for_closure_allowing_unresolved t
+      : checked_approx_for_closure_allowing_unresolved =
+  match t.descr with
+  | Value_closure value_closure ->
+    begin match value_closure.set_of_closures.descr with
+    | Value_set_of_closures value_set_of_closures ->
+      let symbol = match value_closure.set_of_closures.symbol with
+        | Some (symbol, None) -> Some symbol
+        | None | Some (_, Some _) -> None
+      in
+      Ok (value_closure, value_closure.set_of_closures.var,
+          symbol, value_set_of_closures)
+    | Value_unresolved _
+    | Value_closure _ | Value_block _ | Value_int _ | Value_char _
+    | Value_constptr _ | Value_float _ | Value_boxed_int _ | Value_unknown _
+    | Value_bottom | Value_extern _ | Value_string _ | Value_float_array _
+    | Value_symbol _ ->
+      Wrong
+    end
+  | Value_unknown (Unresolved_value value) ->
+    Unknown_because_of_unresolved_value value
+  | Value_unresolved symbol -> Unresolved symbol
+  | Value_set_of_closures _ | Value_block _ | Value_int _ | Value_char _
+  | Value_constptr _ | Value_float _ | Value_boxed_int _
+  | Value_bottom | Value_extern _ | Value_string _ | Value_float_array _
+  | Value_symbol _ ->
+    Wrong
+  (* CR-soon mshinwell: This should be unwound once the reason for a value
+     being unknown can be correctly propagated through the export info. *)
+  | Value_unknown Other -> Unknown
+
+type checked_approx_for_closure =
+  | Wrong
+  | Ok of value_closure * Variable.t option
+          * Symbol.t option * value_set_of_closures
+
+let check_approx_for_closure t : checked_approx_for_closure =
+  match check_approx_for_closure_allowing_unresolved t with
+  | Ok (value_closure, set_of_closures_var, set_of_closures_symbol,
+      value_set_of_closures) ->
+    Ok (value_closure, set_of_closures_var, set_of_closures_symbol,
+      value_set_of_closures)
+  | Wrong | Unknown | Unresolved _ | Unknown_because_of_unresolved_value _ ->
+    Wrong
+
+let approx_for_bound_var value_set_of_closures var =
+  try
+    Var_within_closure.Map.find var value_set_of_closures.bound_vars
+  with
+  | Not_found ->
+    Misc.fatal_errorf "The set-of-closures approximation %a@ does not \
+        bind the variable %a@.%s@."
+      print_value_set_of_closures value_set_of_closures
+      Var_within_closure.print var
+      (Printexc.raw_backtrace_to_string (Printexc.get_callstack max_int))
+
+let check_approx_for_float t : float option =
+  match t.descr with
+  | Value_float f -> f
+  | Value_unresolved _
+  | Value_unknown _ | Value_string _ | Value_float_array _
+  | Value_bottom | Value_block _ | Value_int _ | Value_char _
+  | Value_constptr _ | Value_set_of_closures _ | Value_closure _
+  | Value_extern _ | Value_boxed_int _ | Value_symbol _ ->
+      None
+
+let float_array_as_constant (t:value_float_array) : float list option =
+  match t.contents with
+  | Unknown_or_mutable -> None
+  | Contents contents ->
+    Array.fold_right (fun elt acc ->
+      match acc, elt.descr with
+      | Some acc, Value_float (Some f) ->
+        Some (f :: acc)
+      | None, _
+      | Some _,
+        (Value_float None | Value_unresolved _
+        | Value_unknown _ | Value_string _ | Value_float_array _
+        | Value_bottom | Value_block _ | Value_int _ | Value_char _
+        | Value_constptr _ | Value_set_of_closures _ | Value_closure _
+        | Value_extern _ | Value_boxed_int _ | Value_symbol _)
+        -> None)
+      contents (Some [])
+
+let check_approx_for_string t : string option =
+  match t.descr with
+  | Value_string { contents } -> contents
+  | Value_float _
+  | Value_unresolved _
+  | Value_unknown _ | Value_float_array _
+  | Value_bottom | Value_block _ | Value_int _ | Value_char _
+  | Value_constptr _ | Value_set_of_closures _ | Value_closure _
+  | Value_extern _ | Value_boxed_int _ | Value_symbol _ ->
+      None
+
+type switch_branch_selection =
+  | Cannot_be_taken
+  | Can_be_taken
+  | Must_be_taken
+
+let potentially_taken_const_switch_branch t branch =
+  match t.descr with
+  | Value_unresolved _
+  | Value_unknown _
+  | Value_extern _
+  | Value_symbol _ ->
+    (* In theory symbol cannot contain integers but this shouldn't
+       matter as this will always be an imported approximation *)
+    Can_be_taken
+  | Value_constptr i | Value_int i when i = branch ->
+    Must_be_taken
+  | Value_char c when Char.code c = branch ->
+    Must_be_taken
+  | Value_constptr _ | Value_int _ | Value_char _ ->
+    Cannot_be_taken
+  | Value_block _ | Value_float _ | Value_float_array _
+  | Value_string _ | Value_closure _ | Value_set_of_closures _
+  | Value_boxed_int _ | Value_bottom ->
+    Cannot_be_taken
+
+let potentially_taken_block_switch_branch t tag =
+  match t.descr with
+  | (Value_unresolved _
+    | Value_unknown _
+    | Value_extern _
+    | Value_symbol _) ->
+    Can_be_taken
+  | (Value_constptr _ | Value_int _| Value_char _) ->
+    Cannot_be_taken
+  | Value_block (block_tag, _) when Tag.to_int block_tag = tag ->
+    Must_be_taken
+  | Value_float _ when tag = Obj.double_tag ->
+    Must_be_taken
+  | Value_float_array _ when tag = Obj.double_array_tag ->
+    Must_be_taken
+  | Value_string _ when tag = Obj.string_tag ->
+    Must_be_taken
+  | (Value_closure _ | Value_set_of_closures _)
+    when tag = Obj.closure_tag || tag = Obj.infix_tag ->
+    Can_be_taken
+  | Value_boxed_int _ when tag = Obj.custom_tag ->
+    Must_be_taken
+  | Value_block _ | Value_float _ | Value_set_of_closures _ | Value_closure _
+  | Value_string _ | Value_float_array _ | Value_boxed_int _ ->
+    Cannot_be_taken
+  | Value_bottom ->
+    Cannot_be_taken
+
+let function_arity (fun_decl : function_declaration) =
+  List.length fun_decl.params
+
+let function_declaration_approx ~keep_body fun_var
+      (fun_decl : Flambda.function_declaration) =
+  let function_body =
+    if not (keep_body fun_var fun_decl) then None
+    else begin
+      Some { body = fun_decl.body;
+             stub = fun_decl.stub;
+             inline = fun_decl.inline;
+             dbg = fun_decl.dbg;
+             specialise = fun_decl.specialise;
+             is_a_functor = fun_decl.is_a_functor;
+             free_variables = fun_decl.free_variables;
+             free_symbols = fun_decl.free_symbols; }
+    end
+  in
+  { function_body;
+    params = fun_decl.params;
+    closure_origin = fun_decl.closure_origin;  }
+
+let function_declarations_approx ~keep_body
+  (fun_decls : Flambda.function_declarations) =
+  let funs =
+    Variable.Map.mapi (function_declaration_approx ~keep_body) fun_decls.funs
+  in
+  { funs;
+    is_classic_mode = fun_decls.is_classic_mode;
+    set_of_closures_id = fun_decls.set_of_closures_id;
+    set_of_closures_origin = fun_decls.set_of_closures_origin; }
+
+let import_function_declarations_for_pack function_decls
+    import_set_of_closures_id import_set_of_closures_origin =
+  { set_of_closures_id =
+      import_set_of_closures_id function_decls.set_of_closures_id;
+    set_of_closures_origin =
+      import_set_of_closures_origin function_decls.set_of_closures_origin;
+    funs = function_decls.funs;
+    is_classic_mode = function_decls.is_classic_mode;
+  }
+
+let update_function_declarations function_decls ~funs =
+  let compilation_unit = Compilation_unit.get_current_exn () in
+  let is_classic_mode = function_decls.is_classic_mode in
+  let set_of_closures_id = Set_of_closures_id.create compilation_unit in
+  let set_of_closures_origin = function_decls.set_of_closures_origin in
+  { is_classic_mode;
+    set_of_closures_id;
+    set_of_closures_origin;
+    funs;
+  }
+
+let clear_function_bodies (function_decls : function_declarations) =
+  let funs =
+    Variable.Map.map (fun (fun_decl : function_declaration) ->
+      match fun_decl.function_body with
+      | None | Some { stub = true; _ } ->
+        fun_decl
+      | Some _ ->
+        { fun_decl with function_body = None })
+      function_decls.funs
+  in
+  { function_decls with funs }
+
+let update_function_declaration_body
+      (function_decl : function_declaration)
+      (f : Flambda.t -> Flambda.t) =
+  match function_decl.function_body with
+  | None -> function_decl
+  | Some function_body ->
+    let new_function_body =
+      let body = f function_body.body in
+      let free_variables = Flambda.free_variables body in
+      let free_symbols = Flambda.free_symbols body in
+      { function_body with free_variables; free_symbols; body; }
+    in
+    { function_decl with function_body = Some new_function_body }
+
+let make_closure_map input =
+  let map = ref Closure_id.Map.empty in
+  let add_set_of_closures _ (function_decls : function_declarations) =
+    Variable.Map.iter (fun var _ ->
+        let closure_id = Closure_id.wrap var in
+        map := Closure_id.Map.add closure_id function_decls !map)
+      function_decls.funs
+  in
+  Set_of_closures_id.Map.iter add_set_of_closures input;
+  !map
diff --git a/middle_end/flambda/simple_value_approx.mli b/middle_end/flambda/simple_value_approx.mli
new file mode 100644
index 00000000..dd38652f
--- /dev/null
+++ b/middle_end/flambda/simple_value_approx.mli
@@ -0,0 +1,501 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Simple approximations to the runtime results of computations.
+    This pass is designed for speed rather than accuracy; the performance
+    is important since it is used heavily during inlining. *)
+
+type 'a boxed_int =
+  | Int32 : int32 boxed_int
+  | Int64 : int64 boxed_int
+  | Nativeint : nativeint boxed_int
+
+type value_string = {
+  contents : string option;  (* [None] if unknown or mutable *)
+  size : int;
+}
+
+type unresolved_value =
+  | Set_of_closures_id of Set_of_closures_id.t
+  | Symbol of Symbol.t
+
+type unknown_because_of =
+  | Unresolved_value of unresolved_value
+  | Other
+
+(** A value of type [t] corresponds to an "approximation" of the result of
+    a computation in the program being compiled.  That is to say, it
+    represents what knowledge we have about such a result at compile time.
+    The simplification pass exploits this information to partially evaluate
+    computations.
+
+    At a high level, an approximation for a value [v] has three parts:
+    - the "description" (for example, "the constant integer 42");
+    - an optional variable;
+    - an optional symbol or symbol field.
+    If the variable (resp. symbol) is present then that variable (resp.
+    symbol) may be used to obtain the value [v].
+
+    The exact semantics of the variable and symbol fields follows.
+
+    Approximations are deduced at particular points in an expression tree,
+    but may subsequently be propagated to other locations.
+
+    At the point at which an approximation is built for some value [v], we can
+    construct a set of variables (call the set [S]) that are known to alias the
+    same value [v].  Each member of [S] will have the same or a more precise
+    [descr] field in its approximation relative to the approximation for [v].
+    (An increase in precision may currently be introduced for pattern
+    matches.)  If [S] is non-empty then it is guaranteed that there is a
+    unique member of [S] that was declared in a scope further out ("earlier")
+    than all other members of [S].  If such a member exists then it is
+    recorded in the [var] field.  Otherwise [var] is [None].
+
+    Analogous to the construction of the set [S], we can construct a set [T]
+    consisting of all symbols that are known to alias the value whose
+    approximation is being constructed.  If [T] is non-empty then the
+    [symbol] field is set to some member of [T]; it does not matter which
+    one.  (There is no notion of scope for symbols.)
+
+    Note about mutable blocks:
+
+    Mutable blocks are always represented by [Value_unknown] or
+    [Value_bottom].  Any other approximation could leave the door open to
+    a miscompilation.   Such bad scenarios are most likely a user using
+    [Obj.magic] or [Obj.set_field] in an inappropriate situation.
+    Such a situation might be:
+    [let x = (1, 1) in
+     Obj.set_field (Obj.repr x) 0 (Obj.repr 2);
+     assert(fst x = 2)]
+    The user would probably expect the assertion to be true, but the
+    compiler could in fact propagate the value of [x] across the
+    [Obj.set_field].
+
+    Insisting that mutable blocks have [Value_unknown] or [Value_bottom]
+    approximations certainly won't always prevent this kind of error, but
+    should help catch many of them.
+
+    It is possible that there may be some false positives, with correct
+    but unreachable code causing this check to fail.  However the likelihood
+    of this seems sufficiently low, especially compared to the advantages
+    gained by performing the check, that we include it.
+
+    An example of a pattern that might trigger a false positive is:
+    [type a = { a : int }
+     type b = { mutable b : int }
+     type _ t =
+       | A : a t
+       | B : b t
+     let f (type x) (v:x t) (r:x) =
+       match v with
+       | A -> r.a
+       | B -> r.b <- 2; 3
+
+    let v =
+    let r =
+      ref A in
+      r := A; (* Some pattern that the compiler can't understand *)
+      f !r { a = 1 }]
+    When inlining [f], the B branch is unreachable, yet the compiler
+    cannot prove it and must therefore keep it.
+*)
+type t = private {
+  descr : descr;
+  var : Variable.t option;
+  symbol : (Symbol.t * int option) option;
+}
+
+and descr = private
+  | Value_block of Tag.t * t array
+  | Value_int of int
+  | Value_char of char
+  | Value_constptr of int
+  | Value_float of float option
+  | Value_boxed_int : 'a boxed_int * 'a -> descr
+  | Value_set_of_closures of value_set_of_closures
+  | Value_closure of value_closure
+  | Value_string of value_string
+  | Value_float_array of value_float_array
+  | Value_unknown of unknown_because_of
+  | Value_bottom
+  | Value_extern of Export_id.t
+  | Value_symbol of Symbol.t
+  | Value_unresolved of unresolved_value
+    (* No description was found for this value *)
+
+and value_closure = {
+  set_of_closures : t;
+  closure_id : Closure_id.t;
+}
+
+and function_declarations = private {
+  is_classic_mode: bool;
+  set_of_closures_id : Set_of_closures_id.t;
+  set_of_closures_origin : Set_of_closures_origin.t;
+  funs : function_declaration Variable.Map.t;
+}
+
+and function_body = private {
+  free_variables : Variable.Set.t;
+  free_symbols : Symbol.Set.t;
+  stub : bool;
+  dbg : Debuginfo.t;
+  inline : Lambda.inline_attribute;
+  specialise : Lambda.specialise_attribute;
+  is_a_functor : bool;
+  body : Flambda.t;
+}
+
+and function_declaration = private {
+  closure_origin : Closure_origin.t;
+  params : Parameter.t list;
+  function_body : function_body option;
+}
+
+
+(* CR-soon mshinwell: add support for the approximations of the results, so we
+   can do all of the tricky higher-order cases. *)
+(* when [is_classic_mode] is [false], functions in [function_declarations]
+   are guaranteed to have function bodies (ie:
+   [function_declaration.function_body] will be of the [Some] variant).
+
+   When it [is_classic_mode] is [true], however, no guarantees about the
+   function_bodies are given.
+*)
+and value_set_of_closures = private {
+  function_decls : function_declarations;
+  bound_vars : t Var_within_closure.Map.t;
+  free_vars : Flambda.specialised_to Variable.Map.t;
+  invariant_params : Variable.Set.t Variable.Map.t Lazy.t;
+  recursive : Variable.Set.t Lazy.t;
+  size : int option Variable.Map.t Lazy.t;
+  (** For functions that are very likely to be inlined, the size of the
+      function's body. *)
+  specialised_args : Flambda.specialised_to Variable.Map.t;
+  (* Any freshening that has been applied to [function_decls]. *)
+  freshening : Freshening.Project_var.t;
+  direct_call_surrogates : Closure_id.t Closure_id.Map.t;
+}
+
+and value_float_array_contents =
+  | Contents of t array
+  | Unknown_or_mutable
+
+and value_float_array = {
+  contents : value_float_array_contents;
+  size : int;
+}
+
+(** Extraction of the description of approximation(s). *)
+val descr : t -> descr
+val descrs : t list -> descr list
+
+(** Pretty-printing of approximations to a formatter. *)
+val print : Format.formatter -> t -> unit
+val print_descr : Format.formatter -> descr -> unit
+val print_value_set_of_closures
+   : Format.formatter
+  -> value_set_of_closures
+  -> unit
+val print_function_declarations
+  : Format.formatter
+  -> function_declarations
+  -> unit
+
+val function_declarations_approx
+   : keep_body:(Variable.t -> Flambda.function_declaration -> bool)
+  -> Flambda.function_declarations
+  -> function_declarations
+
+val create_value_set_of_closures
+   : function_decls:function_declarations
+  -> bound_vars:t Var_within_closure.Map.t
+  -> free_vars:Flambda.specialised_to Variable.Map.t
+  -> invariant_params:Variable.Set.t Variable.Map.t lazy_t
+  -> recursive:Variable.Set.t Lazy.t
+  -> specialised_args:Flambda.specialised_to Variable.Map.t
+  -> freshening:Freshening.Project_var.t
+  -> direct_call_surrogates:Closure_id.t Closure_id.Map.t
+  -> value_set_of_closures
+
+val update_freshening_of_value_set_of_closures
+   : value_set_of_closures
+  -> freshening:Freshening.Project_var.t
+  -> value_set_of_closures
+
+(** Basic construction of approximations. *)
+val value_unknown : unknown_because_of -> t
+val value_int : int -> t
+val value_char : char -> t
+val value_float : float -> t
+val value_any_float : t
+val value_mutable_float_array : size:int -> t
+val value_immutable_float_array : t array -> t
+val value_string : int -> string option -> t
+val value_boxed_int : 'i boxed_int -> 'i -> t
+val value_constptr : int -> t
+val value_block : Tag.t -> t array -> t
+val value_extern : Export_id.t -> t
+val value_symbol : Symbol.t -> t
+val value_bottom : t
+val value_unresolved : unresolved_value -> t
+
+(** Construct a closure approximation given the approximation of the
+    corresponding set of closures and the closure ID of the closure to
+    be projected from such set.  [closure_var] and/or [set_of_closures_var]
+    may be specified to augment the approximation with variables that may
+    be used to access the closure value itself, so long as they are in
+    scope at the proposed point of use. *)
+val value_closure
+   : ?closure_var:Variable.t
+  -> ?set_of_closures_var:Variable.t
+  -> ?set_of_closures_symbol:Symbol.t
+  -> value_set_of_closures
+  -> Closure_id.t
+  -> t
+
+(** Construct a set of closures approximation.  [set_of_closures_var] is as for
+    the parameter of the same name in [value_closure], above. *)
+val value_set_of_closures
+   : ?set_of_closures_var:Variable.t
+  -> value_set_of_closures
+  -> t
+
+(** Take the given constant and produce an appropriate approximation for it
+    together with an Flambda expression representing it. *)
+val make_const_int : int -> Flambda.t * t
+val make_const_char : char -> Flambda.t * t
+val make_const_ptr : int -> Flambda.t * t
+val make_const_bool : bool -> Flambda.t * t
+val make_const_float : float -> Flambda.t * t
+val make_const_boxed_int : 'i boxed_int -> 'i -> Flambda.t * t
+
+val make_const_int_named : int -> Flambda.named * t
+val make_const_char_named : char -> Flambda.named * t
+val make_const_ptr_named : int -> Flambda.named * t
+val make_const_bool_named : bool -> Flambda.named * t
+val make_const_float_named : float -> Flambda.named * t
+val make_const_boxed_int_named : 'i boxed_int -> 'i -> Flambda.named * t
+
+(** Augment an approximation with a given variable (see comment above).
+    If the approximation was already augmented with a variable, the one
+    passed to this function replaces it within the approximation. *)
+val augment_with_variable : t -> Variable.t -> t
+
+(** Like [augment_with_variable], but for symbol information. *)
+val augment_with_symbol : t -> Symbol.t -> t
+
+(** Like [augment_with_symbol], but for symbol field information. *)
+val augment_with_symbol_field : t -> Symbol.t -> int -> t
+
+(** Replace the description within an approximation. *)
+val replace_description : t -> descr -> t
+
+(** Improve the description by taking the kind into account *)
+val augment_with_kind : t -> Lambda.value_kind -> t
+
+(** Improve the kind by taking the description into account *)
+val augment_kind_with_approx : t -> Lambda.value_kind -> Lambda.value_kind
+
+val equal_boxed_int : 'a boxed_int -> 'a -> 'b boxed_int -> 'b -> bool
+
+(* CR-soon mshinwell for pchambart: Add comment describing semantics.  (Maybe
+   we should move the comment from the .ml file into here.) *)
+val meet : really_import_approx:(t -> t) -> t -> t -> t
+
+(** An approximation is "known" iff it is not [Value_unknown]. *)
+val known : t -> bool
+
+(** An approximation is "useful" iff it is neither unknown nor bottom. *)
+val useful : t -> bool
+
+(** Whether all approximations in the given list do *not* satisfy [useful]. *)
+val all_not_useful : t list -> bool
+
+(** Whether to warn on attempts to mutate a value.
+    It must have been resolved (it cannot be [Value_extern] or
+    [Value_symbol]).  (See comment above for further explanation.) *)
+val warn_on_mutation : t -> bool
+
+type simplification_summary =
+  | Nothing_done
+  | Replaced_term
+
+type simplification_result = Flambda.t * simplification_summary * t
+type simplification_result_named = Flambda.named * simplification_summary * t
+
+(** Given an expression and its approximation, attempt to simplify the
+    expression to a constant (with associated approximation), taking into
+    account whether the expression has any side effects. *)
+val simplify : t -> Flambda.t -> simplification_result
+
+(** As for [simplify], but also enables us to simplify based on equalities
+    between variables.  The caller must provide a function that tells us
+    whether, if we simplify to a given variable, the value of that variable
+    will be accessible in the current environment. *)
+val simplify_using_env
+   : t
+  -> is_present_in_env:(Variable.t -> bool)
+  -> Flambda.t
+  -> simplification_result
+
+val simplify_named : t -> Flambda.named -> simplification_result_named
+
+val simplify_named_using_env
+   : t
+  -> is_present_in_env:(Variable.t -> bool)
+  -> Flambda.named
+  -> simplification_result_named
+
+(** If the given approximation identifies another variable and
+    [is_present_in_env] deems it to be in scope, return that variable (wrapped
+    in a [Some]), otherwise return [None]. *)
+val simplify_var_to_var_using_env
+   : t
+  -> is_present_in_env:(Variable.t -> bool)
+  -> Variable.t option
+
+val simplify_var : t -> (Flambda.named * t) option
+
+type get_field_result =
+  | Ok of t
+  | Unreachable
+
+(** Given the approximation [t] of a value, expected to correspond to a block
+    (in the [Pmakeblock] sense of the word), and a field index then return
+    an appropriate approximation for that field of the block (or
+    [Unreachable] if the code with the approximation [t] is unreachable).
+    N.B. Not all cases of unreachable code are returned as [Unreachable].
+*)
+val get_field : t -> field_index:int -> get_field_result
+
+type checked_approx_for_block =
+  | Wrong
+  | Ok of Tag.t * t array
+
+(** Try to prove that a value with the given approximation may be used
+    as a block. *)
+val check_approx_for_block : t -> checked_approx_for_block
+
+(** Find the approximation for a bound variable in a set-of-closures
+    approximation.  A fatal error is produced if the variable is not bound in
+    the given approximation. *)
+val approx_for_bound_var : value_set_of_closures -> Var_within_closure.t -> t
+
+(** Given a set-of-closures approximation and a closure ID, apply any
+    freshening specified by the approximation to the closure ID, and return
+    the resulting ID.  Causes a fatal error if the resulting closure ID does
+    not correspond to any function declaration in the approximation. *)
+val freshen_and_check_closure_id
+   : value_set_of_closures
+  -> Closure_id.t
+  -> Closure_id.t
+
+type strict_checked_approx_for_set_of_closures =
+  | Wrong
+  | Ok of Variable.t option * value_set_of_closures
+
+val strict_check_approx_for_set_of_closures
+   : t
+  -> strict_checked_approx_for_set_of_closures
+
+type checked_approx_for_set_of_closures =
+  | Wrong
+  | Unresolved of unresolved_value
+  | Unknown
+  | Unknown_because_of_unresolved_value of unresolved_value
+  (* In the [Ok] case, there may not be a variable associated with the set of
+     closures; it might be out of scope. *)
+  | Ok of Variable.t option * value_set_of_closures
+
+(** Try to prove that a value with the given approximation may be used as a
+    set of closures.  Values coming from external compilation units with
+    unresolved approximations are permitted. *)
+val check_approx_for_set_of_closures : t -> checked_approx_for_set_of_closures
+
+type checked_approx_for_closure =
+  | Wrong
+  | Ok of value_closure * Variable.t option
+          * Symbol.t option * value_set_of_closures
+
+(** Try to prove that a value with the given approximation may be used as a
+    closure.  Values coming from external compilation units with unresolved
+    approximations are not permitted. *)
+(* CR-someday mshinwell: naming is inconsistent: this is as "strict"
+   as "strict_check_approx_for_set_of_closures" *)
+val check_approx_for_closure : t -> checked_approx_for_closure
+
+type checked_approx_for_closure_allowing_unresolved =
+  | Wrong
+  | Unresolved of unresolved_value
+  | Unknown
+  | Unknown_because_of_unresolved_value of unresolved_value
+  | Ok of value_closure * Variable.t option
+          * Symbol.t option * value_set_of_closures
+
+(** As for [check_approx_for_closure], but values coming from external
+    compilation units with unresolved approximations are permitted. *)
+val check_approx_for_closure_allowing_unresolved
+   : t
+  -> checked_approx_for_closure_allowing_unresolved
+
+(** Returns the value if it can be proved to be a constant float *)
+val check_approx_for_float : t -> float option
+
+(** Returns the value if it can be proved to be a constant float array *)
+val float_array_as_constant : value_float_array -> float list option
+
+(** Returns the value if it can be proved to be a constant string *)
+val check_approx_for_string : t -> string option
+
+type switch_branch_selection =
+  | Cannot_be_taken
+  | Can_be_taken
+  | Must_be_taken
+
+(** Check that the branch is compatible with the approximation *)
+val potentially_taken_const_switch_branch : t -> int -> switch_branch_selection
+val potentially_taken_block_switch_branch : t -> int -> switch_branch_selection
+
+val function_arity : function_declaration -> int
+
+(** Create a set of function declarations based on another set of function
+    declarations. *)
+val update_function_declarations
+   : function_declarations
+  -> funs:function_declaration Variable.Map.t
+  -> function_declarations
+
+val import_function_declarations_for_pack
+   : function_declarations
+  -> (Set_of_closures_id.t -> Set_of_closures_id.t)
+  -> (Set_of_closures_origin.t -> Set_of_closures_origin.t)
+  -> function_declarations
+
+val update_function_declaration_body
+    : function_declaration
+   -> (Flambda.t -> Flambda.t)
+   -> function_declaration
+
+(** Creates a map from closure IDs to function declarations by iterating over
+    all sets of closures in the given map. *)
+val make_closure_map
+   : function_declarations Set_of_closures_id.Map.t
+  -> function_declarations Closure_id.Map.t
+
+val clear_function_bodies : function_declarations -> function_declarations
diff --git a/middle_end/flambda/simplify_boxed_integer_ops.ml b/middle_end/flambda/simplify_boxed_integer_ops.ml
new file mode 100644
index 00000000..f1a8fab8
--- /dev/null
+++ b/middle_end/flambda/simplify_boxed_integer_ops.ml
@@ -0,0 +1,118 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module S = Simplify_common
+
+(* Simplification of operations on boxed integers (nativeint, Int32, Int64). *)
+module Simplify_boxed_integer_operator (I : sig
+  type t
+  val kind : Lambda.boxed_integer
+  val zero : t
+  val add : t -> t -> t
+  val sub : t -> t -> t
+  val mul : t -> t -> t
+  val div : t -> t -> t
+  val rem : t -> t -> t
+  val logand : t -> t -> t
+  val logor : t -> t -> t
+  val logxor : t -> t -> t
+  val shift_left : t -> int -> t
+  val shift_right : t -> int -> t
+  val shift_right_logical : t -> int -> t
+  val to_int : t -> int
+  val to_int32 : t -> Int32.t
+  val to_int64 : t -> Int64.t
+  val neg : t -> t
+  val swap : t -> t
+  val compare : t -> t -> int
+end) : Simplify_boxed_integer_ops_intf.S with type t := I.t = struct
+  module A = Simple_value_approx
+  module C = Inlining_cost
+
+  let equal_kind = Lambda.equal_boxed_integer
+
+  let simplify_unop (p : Clambda_primitives.primitive)
+        (kind : I.t A.boxed_int) expr (n : I.t) =
+    let eval op = S.const_boxed_int_expr expr kind (op n) in
+    let eval_conv kind op = S.const_boxed_int_expr expr kind (op n) in
+    let eval_unboxed op = S.const_int_expr expr (op n) in
+    match p with
+    | Pintofbint kind when equal_kind kind I.kind -> eval_unboxed I.to_int
+    | Pcvtbint (kind, Pint32) when equal_kind kind I.kind ->
+      eval_conv A.Int32 I.to_int32
+    | Pcvtbint (kind, Pint64) when equal_kind kind I.kind ->
+      eval_conv A.Int64 I.to_int64
+    | Pnegbint kind when equal_kind kind I.kind -> eval I.neg
+    | Pbbswap kind when equal_kind kind I.kind -> eval I.swap
+    | _ -> expr, A.value_unknown Other, C.Benefit.zero
+
+  let simplify_binop (p : Clambda_primitives.primitive)
+        (kind : I.t A.boxed_int) expr (n1 : I.t) (n2 : I.t) =
+    let eval op = S.const_boxed_int_expr expr kind (op n1 n2) in
+    let non_zero n = (I.compare I.zero n) <> 0 in
+    match p with
+    | Paddbint kind when equal_kind kind I.kind -> eval I.add
+    | Psubbint kind when equal_kind kind I.kind -> eval I.sub
+    | Pmulbint kind when equal_kind kind I.kind -> eval I.mul
+    | Pdivbint {size=kind} when equal_kind kind I.kind && non_zero n2 ->
+      eval I.div
+    | Pmodbint {size=kind} when equal_kind kind I.kind && non_zero n2 ->
+      eval I.rem
+    | Pandbint kind when equal_kind kind I.kind -> eval I.logand
+    | Porbint kind when equal_kind kind I.kind -> eval I.logor
+    | Pxorbint kind when equal_kind kind I.kind -> eval I.logxor
+    | Pbintcomp (kind, c) when equal_kind kind I.kind ->
+      S.const_integer_comparison_expr expr c n1 n2
+    | Pcompare_bints kind when equal_kind kind I.kind ->
+      S.const_int_expr expr (I.compare n1 n2)
+    | _ -> expr, A.value_unknown Other, C.Benefit.zero
+
+  let simplify_binop_int (p : Clambda_primitives.primitive)
+        (kind : I.t A.boxed_int) expr (n1 : I.t) (n2 : int) ~size_int =
+    let eval op = S.const_boxed_int_expr expr kind (op n1 n2) in
+    let precond = 0 <= n2 && n2 < 8 * size_int in
+    match p with
+    | Plslbint kind when equal_kind kind I.kind && precond -> eval I.shift_left
+    | Plsrbint kind when equal_kind kind I.kind && precond ->
+      eval I.shift_right_logical
+    | Pasrbint kind when equal_kind kind I.kind && precond -> eval I.shift_right
+    | _ -> expr, A.value_unknown Other, C.Benefit.zero
+end
+
+module Simplify_boxed_nativeint = Simplify_boxed_integer_operator (struct
+  include Nativeint
+  let to_int64 = Int64.of_nativeint
+  let swap = S.swapnative
+  let kind = Lambda.Pnativeint
+end)
+
+module Simplify_boxed_int32 = Simplify_boxed_integer_operator (struct
+  include Int32
+  let to_int32 i = i
+  let to_int64 = Int64.of_int32
+  let swap = S.swap32
+  let kind = Lambda.Pint32
+end)
+
+module Simplify_boxed_int64 = Simplify_boxed_integer_operator (struct
+  include Int64
+  let to_int64 i = i
+  let swap = S.swap64
+  let kind = Lambda.Pint64
+end)
diff --git a/middle_end/flambda/simplify_boxed_integer_ops.mli b/middle_end/flambda/simplify_boxed_integer_ops.mli
new file mode 100644
index 00000000..f3461043
--- /dev/null
+++ b/middle_end/flambda/simplify_boxed_integer_ops.mli
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(* Simplification of operations on boxed integers (nativeint, Int32, Int64). *)
+
+module Simplify_boxed_nativeint : Simplify_boxed_integer_ops_intf.S
+  with type t := Nativeint.t
+
+module Simplify_boxed_int32 : Simplify_boxed_integer_ops_intf.S
+  with type t := Int32.t
+
+module Simplify_boxed_int64 : Simplify_boxed_integer_ops_intf.S
+  with type t := Int64.t
diff --git a/middle_end/flambda/simplify_boxed_integer_ops_intf.mli b/middle_end/flambda/simplify_boxed_integer_ops_intf.mli
new file mode 100644
index 00000000..f30987ae
--- /dev/null
+++ b/middle_end/flambda/simplify_boxed_integer_ops_intf.mli
@@ -0,0 +1,45 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+module type S = sig
+  type t
+
+  val simplify_unop
+     : Clambda_primitives.primitive
+    -> t Simple_value_approx.boxed_int
+    -> Flambda.named
+    -> t
+    -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
+
+  val simplify_binop
+     : Clambda_primitives.primitive
+    -> t Simple_value_approx.boxed_int
+    -> Flambda.named
+    -> t
+    -> t
+    -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
+
+  val simplify_binop_int
+     : Clambda_primitives.primitive
+    -> t Simple_value_approx.boxed_int
+    -> Flambda.named
+    -> t
+    -> int
+    -> size_int:int
+    -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
+end
diff --git a/middle_end/flambda/simplify_common.ml b/middle_end/flambda/simplify_common.ml
new file mode 100644
index 00000000..fcbbcfbc
--- /dev/null
+++ b/middle_end/flambda/simplify_common.ml
@@ -0,0 +1,86 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module A = Simple_value_approx
+module C = Inlining_cost
+
+external swap16 : int -> int = "%bswap16"
+external swap32 : int32 -> int32 = "%bswap_int32"
+external swap64 : int64 -> int64 = "%bswap_int64"
+external swapnative : nativeint -> nativeint = "%bswap_native"
+
+let const_int_expr expr n =
+  if Effect_analysis.no_effects_named expr then
+    let (new_expr, approx) = A.make_const_int_named n in
+    new_expr, approx, C.Benefit.remove_code_named expr C.Benefit.zero
+  else expr, A.value_int n, C.Benefit.zero
+let const_char_expr expr c =
+  if Effect_analysis.no_effects_named expr then
+    let (new_expr, approx) = A.make_const_char_named c in
+    new_expr, approx, C.Benefit.remove_code_named expr C.Benefit.zero
+  else expr, A.value_char c, C.Benefit.zero
+let const_ptr_expr expr n =
+  if Effect_analysis.no_effects_named expr then
+    let (new_expr, approx) = A.make_const_ptr_named n in
+    new_expr, approx, C.Benefit.remove_code_named expr C.Benefit.zero
+  else expr, A.value_constptr n, C.Benefit.zero
+let const_bool_expr expr b =
+  const_int_expr expr (if b then 1 else 0)
+let const_float_expr expr f =
+  if Effect_analysis.no_effects_named expr then
+    let (new_expr, approx) = A.make_const_float_named f in
+    new_expr, approx, C.Benefit.remove_code_named expr C.Benefit.zero
+  else expr, A.value_float f, C.Benefit.zero
+let const_boxed_int_expr expr t i =
+  if Effect_analysis.no_effects_named expr then
+    let (new_expr, approx) = A.make_const_boxed_int_named t i in
+    new_expr, approx, C.Benefit.remove_code_named expr C.Benefit.zero
+  else expr, A.value_boxed_int t i, C.Benefit.zero
+
+let const_integer_comparison_expr expr (cmp : Lambda.integer_comparison) x y =
+  (* Using the [Stdlib] comparison functions here in the compiler
+     coincides with the definitions of such functions in the code
+     compiled by the user, and is thus correct. *)
+  let open! Stdlib in
+  const_bool_expr expr
+    (match cmp with
+     | Ceq -> x = y
+     | Cne -> x <> y
+     | Clt -> x < y
+     | Cgt -> x > y
+     | Cle -> x <= y
+     | Cge -> x >= y)
+
+let const_float_comparison_expr expr (cmp : Lambda.float_comparison) x y =
+  (* Using the [Stdlib] comparison functions here in the compiler
+     coincides with the definitions of such functions in the code
+     compiled by the user, and is thus correct. *)
+  let open! Stdlib in
+  const_bool_expr expr
+    (match cmp with
+     | CFeq -> x = y
+     | CFneq -> not (x = y)
+     | CFlt -> x < y
+     | CFnlt -> not (x < y)
+     | CFgt -> x > y
+     | CFngt -> not (x > y)
+     | CFle -> x <= y
+     | CFnle -> not (x <= y)
+     | CFge -> x >= y
+     | CFnge -> not (x >= y))
diff --git a/middle_end/flambda/simplify_common.mli b/middle_end/flambda/simplify_common.mli
new file mode 100644
index 00000000..c667bfff
--- /dev/null
+++ b/middle_end/flambda/simplify_common.mli
@@ -0,0 +1,80 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** [const_*_expr expr v annot], where the expression [expr] is known to
+    evaluate to the value [v], attempt to produce a more simple expression
+    together with its approximation and the benefit gained by replacing [expr]
+    with this new expression.  This simplification is only performed if [expr]
+    is known to have no side effects.  Otherwise, [expr] itself is returned,
+    with an appropriate approximation but zero benefit.
+
+    [const_boxed_int_expr] takes an additional argument specifying the kind of
+    boxed integer to which the given expression evaluates.
+*)
+
+val const_int_expr
+   : Flambda.named
+  -> int
+  -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
+
+val const_char_expr
+   : Flambda.named
+  -> char
+  -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
+
+val const_bool_expr
+   : Flambda.named
+  -> bool
+  -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
+
+val const_ptr_expr
+   : Flambda.named
+  -> int
+  -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
+
+val const_float_expr
+   : Flambda.named
+  -> float
+  -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
+
+val const_boxed_int_expr
+   : Flambda.named
+  -> 'a Simple_value_approx.boxed_int
+  -> 'a
+  -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
+
+val const_integer_comparison_expr
+   : Flambda.named
+  -> Lambda.integer_comparison
+  -> 'a
+  -> 'a
+  -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
+
+val const_float_comparison_expr
+   : Flambda.named
+  -> Lambda.float_comparison
+  -> float
+  -> float
+  -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
+
+(** Functions for transposing the order of bytes within words of various
+    sizes. *)
+val swap16 : int -> int
+val swap32 : int32 -> int32
+val swap64 : int64 -> int64
+val swapnative : nativeint -> nativeint
diff --git a/middle_end/flambda/simplify_primitives.ml b/middle_end/flambda/simplify_primitives.ml
new file mode 100644
index 00000000..a228fe82
--- /dev/null
+++ b/middle_end/flambda/simplify_primitives.ml
@@ -0,0 +1,305 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module A = Simple_value_approx
+module C = Inlining_cost
+module I = Simplify_boxed_integer_ops
+module S = Simplify_common
+
+let phys_equal (approxs:A.t list) =
+  match approxs with
+  | [] | [_] | _ :: _ :: _ :: _ ->
+      Misc.fatal_error "wrong number of arguments for equality"
+  | [a1; a2] ->
+    (* N.B. The following would be incorrect if the variables are not
+       bound in the environment:
+       match a1.var, a2.var with
+       | Some v1, Some v2 when Variable.equal v1 v2 -> true
+       | _ -> ...
+    *)
+    match a1.symbol, a2.symbol with
+    | Some (s1, None), Some (s2, None) -> Symbol.equal s1 s2
+    | Some (s1, Some f1), Some (s2, Some f2) -> Symbol.equal s1 s2 && f1 = f2
+    | _ -> false
+
+let is_known_to_be_some_kind_of_int (arg:A.descr) =
+  match arg with
+  | Value_int _ | Value_char _ | Value_constptr _ -> true
+  | Value_block (_, _) | Value_float _ | Value_set_of_closures _
+  | Value_closure _ | Value_string _ | Value_float_array _
+  | A.Value_boxed_int _ | Value_unknown _ | Value_extern _
+  | Value_symbol _ | Value_unresolved _ | Value_bottom -> false
+
+let is_known_to_be_some_kind_of_block (arg:A.descr) =
+  match arg with
+  | Value_block _ | Value_float _ | Value_float_array _ | A.Value_boxed_int _
+  | Value_closure _ | Value_string _ -> true
+  | Value_set_of_closures _ | Value_int _ | Value_char _ | Value_constptr _
+  | Value_unknown _ | Value_extern _ | Value_symbol _
+  | Value_unresolved _ | Value_bottom -> false
+
+let rec structurally_different (arg1:A.t) (arg2:A.t) =
+  match arg1.descr, arg2.descr with
+  | (Value_int n1 | Value_constptr n1), (Value_int n2 | Value_constptr n2)
+    when n1 <> n2 ->
+    true
+  | Value_block (tag1, fields1), Value_block (tag2, fields2) ->
+    not (Tag.equal tag1 tag2)
+    || (Array.length fields1 <> Array.length fields2)
+    || Misc.Stdlib.Array.exists2 structurally_different fields1 fields2
+  | descr1, descr2 ->
+    (* This is not very precise as this won't allow to distinguish
+       blocks from strings for instance. This can be improved if it
+       is deemed valuable. *)
+    (is_known_to_be_some_kind_of_int descr1
+     && is_known_to_be_some_kind_of_block descr2)
+    || (is_known_to_be_some_kind_of_block descr1
+        && is_known_to_be_some_kind_of_int descr2)
+
+let phys_different (approxs:A.t list) =
+  match approxs with
+  | [] | [_] | _ :: _ :: _ :: _ ->
+    Misc.fatal_error "wrong number of arguments for equality"
+  | [a1; a2] ->
+    structurally_different a1 a2
+
+let is_empty = function
+  | [] -> true
+  | _ :: _ -> false
+
+let is_pisint = function
+  | Clambda_primitives.Pisint -> true
+  | _ -> false
+
+let is_pstring_length = function
+  | Clambda_primitives.Pstringlength -> true
+  | _ -> false
+
+let is_pbytes_length = function
+  | Clambda_primitives.Pbyteslength -> true
+  | _ -> false
+
+let is_pstringrefs = function
+  | Clambda_primitives.Pstringrefs -> true
+  | _ -> false
+
+let is_pbytesrefs = function
+  | Clambda_primitives.Pbytesrefs -> true
+  | _ -> false
+
+let primitive (p : Clambda_primitives.primitive) (args, approxs)
+      expr dbg ~size_int
+    : Flambda.named * A.t * Inlining_cost.Benefit.t =
+  let fpc = !Clflags.float_const_prop in
+  match p with
+  | Pmakeblock(tag_int, Asttypes.Immutable, shape) ->
+    let tag = Tag.create_exn tag_int in
+    let shape = match shape with
+      | None -> List.map (fun _ -> Lambda.Pgenval) args
+      | Some shape -> shape
+    in
+    let approxs = List.map2 A.augment_with_kind approxs shape in
+    let shape = List.map2 A.augment_kind_with_approx approxs shape in
+    Prim (Pmakeblock(tag_int, Asttypes.Immutable, Some shape), args, dbg),
+    A.value_block tag (Array.of_list approxs), C.Benefit.zero
+  | Praise _ ->
+    expr, A.value_bottom, C.Benefit.zero
+  | Pmakearray(_, _) when is_empty approxs ->
+    Prim (Pmakeblock(0, Asttypes.Immutable, Some []), [], dbg),
+    A.value_block (Tag.create_exn 0) [||], C.Benefit.zero
+  | Pmakearray (Pfloatarray, Mutable) ->
+      let approx =
+        A.value_mutable_float_array ~size:(List.length args)
+      in
+      expr, approx, C.Benefit.zero
+  | Pmakearray (Pfloatarray, Immutable) ->
+      let approx =
+        A.value_immutable_float_array (Array.of_list approxs)
+      in
+      expr, approx, C.Benefit.zero
+  | Pintcomp Ceq when phys_equal approxs ->
+    S.const_bool_expr expr true
+  | Pintcomp Cne when phys_equal approxs ->
+    S.const_bool_expr expr false
+    (* N.B. Having [not (phys_equal approxs)] would not on its own tell us
+       anything about whether the two values concerned are unequal.  To judge
+       that, it would be necessary to prove that the approximations are
+       different, which would in turn entail them being completely known.
+
+       It may seem that in the case where we have two approximations each
+       annotated with a symbol that we should be able to judge inequality
+       even if part of the approximation description(s) are unknown.  This is
+       unfortunately not the case.  Here is an example:
+
+         let a = f 1
+         let b = f 1
+         let c = a, a
+         let d = b, b
+
+       If [Share_constants] is run before [f] is completely inlined (assuming
+       [f] always generates the same result; effects of [f] aren't in fact
+       relevant) then [c] and [d] will not be shared.  However if [f] is
+       inlined later, [a] and [b] could be shared and thus [c] and [d] could
+       be too.  As such, any intermediate non-aliasing judgement would be
+       invalid. *)
+  | Pintcomp Ceq when phys_different approxs ->
+    S.const_bool_expr expr false
+  | Pintcomp Cne when phys_different approxs ->
+    S.const_bool_expr expr true
+    (* If two values are structurally different we are certain they can never
+       be shared*)
+  | _ ->
+    match A.descrs approxs with
+    | [Value_int x] ->
+      begin match p with
+      | Pnot -> S.const_bool_expr expr (x = 0)
+      | Pnegint -> S.const_int_expr expr (-x)
+      | Pbswap16 -> S.const_int_expr expr (S.swap16 x)
+      | Poffsetint y -> S.const_int_expr expr (x + y)
+      | Pfloatofint when fpc -> S.const_float_expr expr (float_of_int x)
+      | Pbintofint Pnativeint ->
+        S.const_boxed_int_expr expr Nativeint (Nativeint.of_int x)
+      | Pbintofint Pint32 -> S.const_boxed_int_expr expr Int32 (Int32.of_int x)
+      | Pbintofint Pint64 -> S.const_boxed_int_expr expr Int64 (Int64.of_int x)
+      | _ -> expr, A.value_unknown Other, C.Benefit.zero
+      end
+    | [(Value_int x | Value_constptr x); (Value_int y | Value_constptr y)] ->
+      let shift_precond = 0 <= y && y < 8 * size_int in
+      begin match p with
+      | Paddint -> S.const_int_expr expr (x + y)
+      | Psubint -> S.const_int_expr expr (x - y)
+      | Pmulint -> S.const_int_expr expr (x * y)
+      | Pdivint _ when y <> 0 -> S.const_int_expr expr (x / y)
+      | Pmodint _ when y <> 0 -> S.const_int_expr expr (x mod y)
+      | Pandint -> S.const_int_expr expr (x land y)
+      | Porint -> S.const_int_expr expr (x lor y)
+      | Pxorint -> S.const_int_expr expr (x lxor y)
+      | Plslint when shift_precond -> S.const_int_expr expr (x lsl y)
+      | Plsrint when shift_precond -> S.const_int_expr expr (x lsr y)
+      | Pasrint when shift_precond -> S.const_int_expr expr (x asr y)
+      | Pintcomp cmp -> S.const_integer_comparison_expr expr cmp x y
+      | Pcompare_ints -> S.const_int_expr expr (compare x y)
+      | Pisout -> S.const_bool_expr expr (y > x || y < 0)
+      | _ -> expr, A.value_unknown Other, C.Benefit.zero
+      end
+    | [Value_char x; Value_char y] ->
+      begin match p with
+      | Pintcomp cmp -> S.const_integer_comparison_expr expr cmp x y
+      | Pcompare_ints -> S.const_int_expr expr (Char.compare x y)
+      | _ -> expr, A.value_unknown Other, C.Benefit.zero
+      end
+    | [Value_constptr x] ->
+      begin match p with
+      (* [Pidentity] should probably never appear, but is here for
+         completeness. *)
+      | Pnot -> S.const_bool_expr expr (x = 0)
+      | Pisint -> S.const_bool_expr expr true
+      | Poffsetint y -> S.const_ptr_expr expr (x + y)
+      | _ -> expr, A.value_unknown Other, C.Benefit.zero
+      end
+    | [Value_float (Some x)] when fpc ->
+      begin match p with
+      | Pintoffloat -> S.const_int_expr expr (int_of_float x)
+      | Pnegfloat -> S.const_float_expr expr (-. x)
+      | Pabsfloat -> S.const_float_expr expr (abs_float x)
+      | _ -> expr, A.value_unknown Other, C.Benefit.zero
+      end
+    | [Value_float (Some n1); Value_float (Some n2)] when fpc ->
+      begin match p with
+      | Paddfloat -> S.const_float_expr expr (n1 +. n2)
+      | Psubfloat -> S.const_float_expr expr (n1 -. n2)
+      | Pmulfloat -> S.const_float_expr expr (n1 *. n2)
+      | Pdivfloat -> S.const_float_expr expr (n1 /. n2)
+      | Pfloatcomp c  -> S.const_float_comparison_expr expr c n1 n2
+      | Pcompare_floats -> S.const_int_expr expr (Float.compare n1 n2)
+      | _ -> expr, A.value_unknown Other, C.Benefit.zero
+      end
+    | [A.Value_boxed_int(A.Nativeint, n)] ->
+      I.Simplify_boxed_nativeint.simplify_unop p Nativeint expr n
+    | [A.Value_boxed_int(A.Int32, n)] ->
+      I.Simplify_boxed_int32.simplify_unop p Int32 expr n
+    | [A.Value_boxed_int(A.Int64, n)] ->
+      I.Simplify_boxed_int64.simplify_unop p Int64 expr n
+    | [A.Value_boxed_int(A.Nativeint, n1);
+       A.Value_boxed_int(A.Nativeint, n2)] ->
+      I.Simplify_boxed_nativeint.simplify_binop p Nativeint expr n1 n2
+    | [A.Value_boxed_int(A.Int32, n1); A.Value_boxed_int(A.Int32, n2)] ->
+      I.Simplify_boxed_int32.simplify_binop p Int32 expr n1 n2
+    | [A.Value_boxed_int(A.Int64, n1); A.Value_boxed_int(A.Int64, n2)] ->
+      I.Simplify_boxed_int64.simplify_binop p Int64 expr n1 n2
+    | [A.Value_boxed_int(A.Nativeint, n1); Value_int n2] ->
+      I.Simplify_boxed_nativeint.simplify_binop_int p Nativeint expr n1 n2
+        ~size_int
+    | [A.Value_boxed_int(A.Int32, n1); Value_int n2] ->
+      I.Simplify_boxed_int32.simplify_binop_int p Int32 expr n1 n2
+        ~size_int
+    | [A.Value_boxed_int(A.Int64, n1); Value_int n2] ->
+      I.Simplify_boxed_int64.simplify_binop_int p Int64 expr n1 n2
+        ~size_int
+    | [Value_block _] when is_pisint p ->
+      S.const_bool_expr expr false
+    | [Value_string { size }]
+      when (is_pstring_length p || is_pbytes_length p) ->
+      S.const_int_expr expr size
+    | [Value_string { size; contents = Some s };
+       (Value_int x | Value_constptr x)] when x >= 0 && x < size ->
+        begin match p with
+        | Pstringrefu
+        | Pstringrefs
+        | Pbytesrefu
+        | Pbytesrefs ->
+          S.const_char_expr (Prim(Pstringrefu, args, dbg)) s.[x]
+        | _ -> expr, A.value_unknown Other, C.Benefit.zero
+        end
+    | [Value_string { size; contents = None };
+       (Value_int x | Value_constptr x)]
+      when x >= 0 && x < size && is_pstringrefs p ->
+        Flambda.Prim (Pstringrefu, args, dbg),
+          A.value_unknown Other,
+          (* we improved it, but there is no way to account for that: *)
+          C.Benefit.zero
+    | [Value_string { size; contents = None };
+       (Value_int x | Value_constptr x)]
+      when x >= 0 && x < size && is_pbytesrefs p ->
+        Flambda.Prim (Pbytesrefu, args, dbg),
+          A.value_unknown Other,
+          (* we improved it, but there is no way to account for that: *)
+          C.Benefit.zero
+
+    | [Value_float_array { size; contents }] ->
+        begin match p with
+        | Parraylength _ -> S.const_int_expr expr size
+        | Pfloatfield i ->
+          begin match contents with
+          | A.Contents a when i >= 0 && i < size ->
+            begin match A.check_approx_for_float a.(i) with
+            | None -> expr, a.(i), C.Benefit.zero
+            | Some v -> S.const_float_expr expr v
+            end
+          | Contents _ | Unknown_or_mutable ->
+            expr, A.value_unknown Other, C.Benefit.zero
+          end
+        | _ -> expr, A.value_unknown Other, C.Benefit.zero
+        end
+    | _ ->
+      match Semantics_of_primitives.return_type_of_primitive p with
+      | Float ->
+        expr, A.value_any_float, C.Benefit.zero
+      | Other ->
+        expr, A.value_unknown Other, C.Benefit.zero
diff --git a/middle_end/flambda/simplify_primitives.mli b/middle_end/flambda/simplify_primitives.mli
new file mode 100644
index 00000000..a6b6330c
--- /dev/null
+++ b/middle_end/flambda/simplify_primitives.mli
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Simplifies an application of a primitive based on approximation
+    information. *)
+val primitive
+   : Clambda_primitives.primitive
+  -> (Variable.t list * (Simple_value_approx.t list))
+  -> Flambda.named
+  -> Debuginfo.t
+  -> size_int:int
+  -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
diff --git a/middle_end/flambda/traverse_for_exported_symbols.ml b/middle_end/flambda/traverse_for_exported_symbols.ml
new file mode 100644
index 00000000..1b7ce57f
--- /dev/null
+++ b/middle_end/flambda/traverse_for_exported_symbols.ml
@@ -0,0 +1,267 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                     Fu Yong Quah, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+module A = Simple_value_approx
+
+type queue_elem =
+  | Q_symbol of Symbol.t
+  | Q_set_of_closures_id of Set_of_closures_id.t
+  | Q_export_id of Export_id.t
+
+type symbols_to_export =
+  { symbols                               : Symbol.Set.t;
+    export_ids                            : Export_id.Set.t;
+    set_of_closure_ids                    : Set_of_closures_id.Set.t;
+    set_of_closure_ids_keep_declaration   : Set_of_closures_id.Set.t;
+    relevant_imported_closure_ids         : Closure_id.Set.t;
+    relevant_local_closure_ids            : Closure_id.Set.t;
+    relevant_imported_vars_within_closure : Var_within_closure.Set.t;
+    relevant_local_vars_within_closure    : Var_within_closure.Set.t;
+  }
+
+let traverse
+      ~(sets_of_closures_map :
+          Flambda.set_of_closures Set_of_closures_id.Map.t)
+      ~(closure_id_to_set_of_closures_id :
+          Set_of_closures_id.t Closure_id.Map.t)
+      ~(function_declarations_map :
+          A.function_declarations Set_of_closures_id.Map.t)
+      ~(values : Export_info.descr Export_id.Map.t)
+      ~(symbol_id : Export_id.t Symbol.Map.t)
+      ~(root_symbol: Symbol.t) =
+  let relevant_set_of_closures_declaration_only =
+    ref Set_of_closures_id.Set.empty
+  in
+  let relevant_symbols = ref (Symbol.Set.singleton root_symbol) in
+  let relevant_set_of_closures = ref Set_of_closures_id.Set.empty in
+  let relevant_export_ids = ref Export_id.Set.empty in
+  let relevant_imported_closure_ids = ref Closure_id.Set.empty in
+  let relevant_local_closure_ids = ref Closure_id.Set.empty in
+  let relevant_imported_vars_within_closure =
+    ref Var_within_closure.Set.empty
+  in
+  let relevant_local_vars_with_closure = ref Var_within_closure.Set.empty in
+  let (queue : queue_elem Queue.t) = Queue.create () in
+  let conditionally_add_symbol symbol =
+    if not (Symbol.Set.mem symbol !relevant_symbols) then begin
+      relevant_symbols :=
+        Symbol.Set.add symbol !relevant_symbols;
+      Queue.add (Q_symbol symbol) queue
+    end
+  in
+  let conditionally_add_set_of_closures_id set_of_closures_id =
+    if not (Set_of_closures_id.Set.mem
+         set_of_closures_id !relevant_set_of_closures) then begin
+      relevant_set_of_closures :=
+        Set_of_closures_id.Set.add set_of_closures_id
+          !relevant_set_of_closures;
+      Queue.add (Q_set_of_closures_id set_of_closures_id) queue
+    end
+  in
+  let conditionally_add_export_id export_id =
+    if not (Export_id.Set.mem export_id !relevant_export_ids) then begin
+      relevant_export_ids :=
+        Export_id.Set.add export_id !relevant_export_ids;
+      Queue.add (Q_export_id export_id) queue
+    end
+  in
+  let process_approx (approx : Export_info.approx) =
+    match approx with
+    | Value_id export_id ->
+      conditionally_add_export_id export_id
+    | Value_symbol symbol ->
+      conditionally_add_symbol symbol
+    | Value_unknown -> ()
+  in
+  let process_value_set_of_closures
+        (soc : Export_info.value_set_of_closures) =
+    conditionally_add_set_of_closures_id soc.set_of_closures_id;
+    Var_within_closure.Map.iter
+      (fun _ value -> process_approx value) soc.bound_vars;
+    Closure_id.Map.iter
+      (fun _ value -> process_approx value) soc.results;
+    begin match soc.aliased_symbol with
+    | None -> ()
+    | Some symbol -> conditionally_add_symbol symbol
+    end
+  in
+  let process_function_body (function_body : A.function_body) =
+    Flambda_iterators.iter
+      (fun (term : Flambda.t) ->
+         match term with
+         | Flambda.Apply { kind ; _ } ->
+           begin match kind with
+           | Indirect -> ()
+           | Direct closure_id ->
+             begin match
+               Closure_id.Map.find
+                 closure_id
+                 closure_id_to_set_of_closures_id
+             with
+             | exception Not_found ->
+               relevant_imported_closure_ids :=
+                 Closure_id.Set.add closure_id
+                   !relevant_imported_closure_ids
+             | set_of_closures_id ->
+               relevant_local_closure_ids :=
+                 Closure_id.Set.add closure_id
+                   !relevant_local_closure_ids;
+               conditionally_add_set_of_closures_id
+                 set_of_closures_id
+             end
+           end
+         | _ -> ())
+      (fun (named : Flambda.named) ->
+         let process_closure_id closure_id =
+           match
+             Closure_id.Map.find closure_id closure_id_to_set_of_closures_id
+           with
+           | exception Not_found ->
+             relevant_imported_closure_ids :=
+               Closure_id.Set.add closure_id !relevant_imported_closure_ids
+           | set_of_closure_id ->
+             relevant_local_closure_ids :=
+               Closure_id.Set.add closure_id !relevant_local_closure_ids;
+             relevant_set_of_closures_declaration_only :=
+               Set_of_closures_id.Set.add
+                 set_of_closure_id
+                 !relevant_set_of_closures_declaration_only
+         in
+         match named with
+         | Symbol symbol
+         | Read_symbol_field (symbol, _) ->
+           conditionally_add_symbol symbol
+         | Set_of_closures soc ->
+           conditionally_add_set_of_closures_id
+             soc.function_decls.set_of_closures_id
+         | Project_closure { closure_id; _ } ->
+           process_closure_id closure_id
+         | Move_within_set_of_closures { start_from; move_to; _ } ->
+           process_closure_id start_from;
+           process_closure_id move_to
+         | Project_var { closure_id ; var; _ } ->
+           begin match
+             Closure_id.Map.find
+               closure_id closure_id_to_set_of_closures_id
+           with
+           | exception Not_found ->
+             relevant_imported_closure_ids :=
+               Closure_id.Set.add closure_id
+                 !relevant_imported_closure_ids;
+             relevant_imported_vars_within_closure :=
+               Var_within_closure.Set.add var
+                 !relevant_imported_vars_within_closure
+           | set_of_closure_id ->
+             relevant_local_closure_ids :=
+               Closure_id.Set.add closure_id
+                 !relevant_local_closure_ids;
+             relevant_local_vars_with_closure :=
+               Var_within_closure.Set.add var
+                 !relevant_local_vars_with_closure;
+             relevant_set_of_closures_declaration_only :=
+               Set_of_closures_id.Set.add
+                 set_of_closure_id
+                 !relevant_set_of_closures_declaration_only
+           end
+         | Prim _
+         | Expr _
+         | Const _
+         | Allocated_const _
+         | Read_mutable _ -> ())
+      function_body.body
+  in
+  let rec loop () =
+    if Queue.is_empty queue then
+      ()
+    else begin
+      begin match Queue.pop queue with
+      | Q_export_id export_id ->
+        begin match Export_id.Map.find export_id values with
+        | exception Not_found -> ()
+        | Value_block (_, approxes) ->
+          Array.iter process_approx approxes
+        | Value_closure value_closure ->
+          process_value_set_of_closures value_closure.set_of_closures
+        | Value_set_of_closures soc ->
+          process_value_set_of_closures soc
+        | _ -> ()
+        end
+      | Q_symbol symbol ->
+        let compilation_unit = Symbol.compilation_unit symbol in
+        if Compilation_unit.is_current compilation_unit then begin
+          match Symbol.Map.find symbol symbol_id with
+          | exception Not_found ->
+            Misc.fatal_errorf "cannot find symbol's export id %a\n"
+              Symbol.print symbol
+          | export_id ->
+            conditionally_add_export_id export_id
+        end
+      | Q_set_of_closures_id set_of_closures_id ->
+        begin match
+          Set_of_closures_id.Map.find
+            set_of_closures_id function_declarations_map
+        with
+        | exception Not_found -> ()
+        | function_declarations ->
+          Variable.Map.iter
+            (fun (_ : Variable.t) (fun_decl : A.function_declaration) ->
+               match fun_decl.function_body with
+               | None -> ()
+               | Some function_body -> process_function_body function_body)
+            function_declarations.funs
+        end
+      end;
+      loop ()
+    end
+  in
+  Queue.add (Q_symbol root_symbol) queue;
+  loop ();
+
+  Closure_id.Map.iter (fun closure_id set_of_closure_id ->
+      if Set_of_closures_id.Set.mem
+           set_of_closure_id !relevant_set_of_closures
+      then begin
+        relevant_local_closure_ids :=
+          Closure_id.Set.add closure_id !relevant_local_closure_ids
+      end)
+    closure_id_to_set_of_closures_id;
+
+  Set_of_closures_id.Set.iter (fun set_of_closures_id ->
+      match
+        Set_of_closures_id.Map.find set_of_closures_id sets_of_closures_map
+      with
+      | exception Not_found -> ()
+      | set_of_closures ->
+        Variable.Map.iter (fun var _ ->
+            relevant_local_vars_with_closure :=
+              Var_within_closure.Set.add
+                (Var_within_closure.wrap var)
+                !relevant_local_vars_with_closure)
+          set_of_closures.free_vars)
+    !relevant_set_of_closures;
+
+  { symbols                             = !relevant_symbols;
+    export_ids                          = !relevant_export_ids;
+    set_of_closure_ids                  = !relevant_set_of_closures;
+    set_of_closure_ids_keep_declaration =
+      !relevant_set_of_closures_declaration_only;
+    relevant_imported_closure_ids       = !relevant_imported_closure_ids;
+    relevant_local_closure_ids          = !relevant_local_closure_ids;
+    relevant_imported_vars_within_closure =
+      !relevant_imported_vars_within_closure;
+    relevant_local_vars_within_closure =
+      !relevant_local_vars_with_closure;
+  }
diff --git a/middle_end/flambda/traverse_for_exported_symbols.mli b/middle_end/flambda/traverse_for_exported_symbols.mli
new file mode 100644
index 00000000..2825a386
--- /dev/null
+++ b/middle_end/flambda/traverse_for_exported_symbols.mli
@@ -0,0 +1,41 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                     Fu Yong Quah, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+type symbols_to_export =
+  { symbols                               : Symbol.Set.t;
+    export_ids                            : Export_id.Set.t;
+    set_of_closure_ids                    : Set_of_closures_id.Set.t;
+    set_of_closure_ids_keep_declaration   : Set_of_closures_id.Set.t;
+    relevant_imported_closure_ids         : Closure_id.Set.t;
+    relevant_local_closure_ids            : Closure_id.Set.t;
+    relevant_imported_vars_within_closure : Var_within_closure.Set.t;
+    relevant_local_vars_within_closure    : Var_within_closure.Set.t;
+  }
+
+(** Computes the transitive closure in [Symbol.t], [Closure_id.t] and
+    [Set_of_closures_id.t] and determines which ones of those should be
+    exported (i.e: included in the cmx files).
+**)
+val traverse
+   : sets_of_closures_map: Flambda.set_of_closures Set_of_closures_id.Map.t
+  -> closure_id_to_set_of_closures_id:
+        Set_of_closures_id.t Closure_id.Map.t
+  -> function_declarations_map:
+        Simple_value_approx.function_declarations Set_of_closures_id.Map.t
+  -> values: Export_info.descr Export_id.Map.t
+  -> symbol_id: Export_id.t Symbol.Map.t
+  -> root_symbol: Symbol.t
+  -> symbols_to_export
diff --git a/middle_end/flambda/un_anf.ml b/middle_end/flambda/un_anf.ml
new file mode 100644
index 00000000..7ce8d299
--- /dev/null
+++ b/middle_end/flambda/un_anf.ml
@@ -0,0 +1,853 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+(* CR-someday vlaviron for mshinwell: I believe that the phantom lets introduced
+   in un_anf (when the new debug_full flag is enabled) bind mostly variables
+   that were created in the middle-end. Is it relevant to generate debugging
+   information for such variables ? I expect later pull requests to refine the
+   generation of these phantom constructions anyway, but maybe it would already
+   make sense to restrict the phantom let generation to variables with an actual
+   provenance.
+*)
+
+module V = Backend_var
+module VP = Backend_var.With_provenance
+
+(* We say that an [V.t] is "linear" iff:
+   (a) it is used exactly once;
+   (b) it is never assigned to (using [Uassign]).
+*)
+type var_info =
+  { used_let_bound_vars : V.Set.t;
+    linear_let_bound_vars : V.Set.t;
+    assigned : V.Set.t;
+    closure_environment : V.Set.t;
+    let_bound_vars_that_can_be_moved : V.Set.t;
+  }
+
+let ignore_uconstant (_ : Clambda.uconstant) = ()
+let ignore_ulambda (_ : Clambda.ulambda) = ()
+let ignore_ulambda_list (_ : Clambda.ulambda list) = ()
+let ignore_uphantom_defining_expr_option
+      (_ : Clambda.uphantom_defining_expr option) = ()
+let ignore_function_label (_ : Clambda.function_label) = ()
+let ignore_debuginfo (_ : Debuginfo.t) = ()
+let ignore_int (_ : int) = ()
+let ignore_var (_ : V.t) = ()
+let ignore_var_option (_ : V.t option) = ()
+let ignore_primitive (_ : Clambda_primitives.primitive) = ()
+let ignore_string (_ : string) = ()
+let ignore_int_array (_ : int array) = ()
+let ignore_var_with_provenance (_ : VP.t) = ()
+let ignore_params_with_value_kind (_ : (VP.t * Lambda.value_kind) list) = ()
+let ignore_direction_flag (_ : Asttypes.direction_flag) = ()
+let ignore_meth_kind (_ : Lambda.meth_kind) = ()
+let ignore_value_kind (_ : Lambda.value_kind) = ()
+
+(* CR-soon mshinwell: check we aren't traversing function bodies more than
+   once (need to analyse exactly what the calls are from Cmmgen into this
+   module). *)
+
+let closure_environment_var (ufunction:Clambda.ufunction) =
+  (* The argument after the arity is the environment *)
+  if List.length ufunction.params = ufunction.arity + 1 then
+    let (env_var, _) = List.nth ufunction.params ufunction.arity in
+    assert (VP.name env_var = "env");
+    Some env_var
+  else
+    (* closed function, no environment *)
+    None
+
+type var_uses =
+  | Zero
+  | One
+  | More_than_one
+  | Assigned
+
+type var =
+  { definition_depth : int;
+    uses : var_uses; }
+
+let incr_uses { definition_depth; uses } depth =
+  assert (definition_depth <= depth);
+  let uses =
+    match uses with
+    | Zero ->
+        if definition_depth < depth then More_than_one
+        else One
+    | One -> More_than_one
+    | More_than_one -> More_than_one
+    | Assigned -> Assigned
+  in
+  { definition_depth; uses }
+
+let assign_uses r = { r with uses = Assigned }
+
+let zero definition_depth = { definition_depth; uses = Zero }
+
+let add_definition t var depth =
+  V.Tbl.add t var (zero depth)
+
+let add_use t var depth =
+  match V.Tbl.find t var with
+  | info -> V.Tbl.replace t var (incr_uses info depth)
+  | exception Not_found -> () (* Variable is not let-bound *)
+
+let add_assignment t var =
+  match V.Tbl.find t var with
+  | info -> V.Tbl.replace t var (assign_uses info)
+  | exception Not_found ->
+    Misc.fatal_errorf
+      "make_var_info: Assigned variable %a not let-bound"
+      V.print var
+
+let make_var_info (clam : Clambda.ulambda) : var_info =
+  let t : var V.Tbl.t = V.Tbl.create 42 in
+  let environment_vars = ref V.Set.empty in
+  let rec loop ~depth : Clambda.ulambda -> unit = function
+    (* No underscores in the pattern match, to reduce the chance of failing
+       to traverse some subexpression. *)
+    | Uvar var -> add_use t var depth
+    | Uconst const ->
+      (* The only variables that might occur in [const] are those in constant
+         closures---and those are all bound by such closures.  It follows that
+         [const] cannot contain any variables that are bound in the current
+         scope, so we do not need to count them here.  (The function bodies
+         of the closures will be traversed when this function is called from
+         [Flambda_to_clambda.to_clambda_closed_set_of_closures].) *)
+      ignore_uconstant const
+    | Udirect_apply (label, args, dbg) ->
+      ignore_function_label label;
+      List.iter (loop ~depth) args;
+      ignore_debuginfo dbg
+    | Ugeneric_apply (func, args, dbg) ->
+      loop ~depth func;
+      List.iter (loop ~depth) args;
+      ignore_debuginfo dbg
+    | Uclosure (functions, captured_variables) ->
+      List.iter (loop ~depth) captured_variables;
+      List.iter (fun (
+        { Clambda. label; arity; params; return; body; dbg; env; } as clos) ->
+          (match closure_environment_var clos with
+           | None -> ()
+           | Some env_var ->
+             environment_vars :=
+               V.Set.add (VP.var env_var) !environment_vars);
+          ignore_function_label label;
+          ignore_int arity;
+          ignore_params_with_value_kind params;
+          ignore_value_kind return;
+          loop ~depth:(depth + 1) body;
+          ignore_debuginfo dbg;
+          ignore_var_option env)
+        functions
+    | Uoffset (expr, offset) ->
+      loop ~depth expr;
+      ignore_int offset
+    | Ulet (_let_kind, _value_kind, var, def, body) ->
+      add_definition t (VP.var var) depth;
+      loop ~depth def;
+      loop ~depth body
+    | Uphantom_let (var, defining_expr_opt, body) ->
+      ignore_var_with_provenance var;
+      ignore_uphantom_defining_expr_option defining_expr_opt;
+      loop ~depth body
+    | Uletrec (defs, body) ->
+      List.iter (fun (var, def) ->
+          ignore_var_with_provenance var;
+          loop ~depth def)
+        defs;
+      loop ~depth body
+    | Uprim (prim, args, dbg) ->
+      ignore_primitive prim;
+      List.iter (loop ~depth) args;
+      ignore_debuginfo dbg
+    | Uswitch (cond, { us_index_consts; us_actions_consts;
+          us_index_blocks; us_actions_blocks }, dbg) ->
+      loop ~depth cond;
+      ignore_int_array us_index_consts;
+      Array.iter (loop ~depth) us_actions_consts;
+      ignore_int_array us_index_blocks;
+      Array.iter (loop ~depth) us_actions_blocks;
+      ignore_debuginfo dbg
+    | Ustringswitch (cond, branches, default) ->
+      loop ~depth cond;
+      List.iter (fun (str, branch) ->
+          ignore_string str;
+          loop ~depth branch)
+        branches;
+      Option.iter (loop ~depth) default
+    | Ustaticfail (static_exn, args) ->
+      ignore_int static_exn;
+      List.iter (loop ~depth) args
+    | Ucatch (static_exn, vars, body, handler) ->
+      ignore_int static_exn;
+      ignore_params_with_value_kind vars;
+      loop ~depth body;
+      loop ~depth handler
+    | Utrywith (body, var, handler) ->
+      loop ~depth body;
+      ignore_var_with_provenance var;
+      loop ~depth handler
+    | Uifthenelse (cond, ifso, ifnot) ->
+      loop ~depth cond;
+      loop ~depth ifso;
+      loop ~depth ifnot
+    | Usequence (e1, e2) ->
+      loop ~depth e1;
+      loop ~depth e2
+    | Uwhile (cond, body) ->
+      loop ~depth:(depth + 1) cond;
+      loop ~depth:(depth + 1) body
+    | Ufor (var, low, high, direction_flag, body) ->
+      ignore_var_with_provenance var;
+      loop ~depth low;
+      loop ~depth high;
+      ignore_direction_flag direction_flag;
+      loop ~depth:(depth + 1) body
+    | Uassign (var, expr) ->
+      add_assignment t var;
+      loop ~depth expr
+    | Usend (meth_kind, e1, e2, args, dbg) ->
+      ignore_meth_kind meth_kind;
+      loop ~depth e1;
+      loop ~depth e2;
+      List.iter (loop ~depth) args;
+      ignore_debuginfo dbg
+    | Uunreachable ->
+      ()
+  in
+  loop ~depth:0 clam;
+  let linear_let_bound_vars, used_let_bound_vars, assigned =
+    V.Tbl.fold (fun var desc ((linear, used, assigned) as acc) ->
+      match desc.uses with
+      | Zero -> acc
+      | One -> (V.Set.add var linear, V.Set.add var used, assigned)
+      | More_than_one -> (linear, V.Set.add var used, assigned)
+      | Assigned -> (linear, V.Set.add var used, V.Set.add var assigned))
+      t (V.Set.empty, V.Set.empty, V.Set.empty)
+  in
+  { used_let_bound_vars; linear_let_bound_vars; assigned;
+    closure_environment = !environment_vars;
+    let_bound_vars_that_can_be_moved = V.Set.empty;
+  }
+
+(* When sequences of [let]-bindings match the evaluation order in a subsequent
+   primitive or function application whose arguments are linearly-used
+   non-assigned variables bound by such lets (possibly interspersed with other
+   variables that are known to be constant), and it is known that there were no
+   intervening side-effects during the evaluation of the [let]-bindings,
+   permit substitution of the variables for their defining expressions. *)
+let let_bound_vars_that_can_be_moved var_info (clam : Clambda.ulambda) =
+  let obviously_constant = ref V.Set.empty in
+  let can_move = ref V.Set.empty in
+  let let_stack = ref [] in
+  let examine_argument_list args =
+    let rec loop let_bound_vars (args : Clambda.ulambda list) =
+      match let_bound_vars, args with
+      | _, [] ->
+        (* We've matched all arguments and will not substitute (in the
+           current application being considered) any of the remaining
+           [let_bound_vars].  As such they may stay on the stack. *)
+        let_bound_vars
+      | [], _ ->
+        (* There are no more [let]-bindings to consider, so the stack
+           is left empty. *)
+        []
+      | let_bound_vars, (Uvar arg)::args
+          when V.Set.mem arg !obviously_constant ->
+        loop let_bound_vars args
+      | let_bound_var::let_bound_vars, (Uvar arg)::args
+          when V.same let_bound_var arg
+            && not (V.Set.mem arg var_info.assigned) ->
+        assert (V.Set.mem arg var_info.used_let_bound_vars);
+        assert (V.Set.mem arg var_info.linear_let_bound_vars);
+        can_move := V.Set.add arg !can_move;
+        loop let_bound_vars args
+      | _::_, _::_ ->
+        (* The [let] sequence has ceased to match the evaluation order
+           or we have encountered some complicated argument.  In this case
+           we empty the stack to ensure that we do not end up moving an
+           outer [let] across a side effect. *)
+        []
+    in
+    (* Start at the most recent let binding and the leftmost argument
+       (the last argument to be evaluated). *)
+    let_stack := loop !let_stack args
+  in
+  let rec loop : Clambda.ulambda -> unit = function
+    | Uvar var ->
+      if V.Set.mem var var_info.assigned then begin
+        let_stack := []
+      end
+    | Uconst const ->
+      ignore_uconstant const
+    | Udirect_apply (label, args, dbg) ->
+      ignore_function_label label;
+      examine_argument_list args;
+      (* We don't currently traverse [args]; they should all be variables
+         anyway.  If this is added in the future, take care to traverse [args]
+         following the evaluation order. *)
+      ignore_debuginfo dbg
+    | Ugeneric_apply (func, args, dbg) ->
+      examine_argument_list (args @ [func]);
+      ignore_debuginfo dbg
+    | Uclosure (functions, captured_variables) ->
+      ignore_ulambda_list captured_variables;
+      (* Start a new let stack for speed. *)
+      List.iter (fun {Clambda. label; arity; params; return; body; dbg; env} ->
+          ignore_function_label label;
+          ignore_int arity;
+          ignore_params_with_value_kind params;
+          ignore_value_kind return;
+          let_stack := [];
+          loop body;
+          let_stack := [];
+          ignore_debuginfo dbg;
+          ignore_var_option env)
+        functions
+    | Uoffset (expr, offset) ->
+      (* [expr] should usually be a variable. *)
+      examine_argument_list [expr];
+      ignore_int offset
+    | Ulet (_let_kind, _value_kind, var, def, body) ->
+      let var = VP.var var in
+      begin match def with
+      | Uconst _ ->
+        (* The defining expression is obviously constant, so we don't
+           have to put this [let] on the stack, and we don't have to
+           traverse the defining expression either. *)
+        obviously_constant := V.Set.add var !obviously_constant;
+        loop body
+      | _ ->
+        loop def;
+        if V.Set.mem var var_info.linear_let_bound_vars then begin
+          let_stack := var::!let_stack
+        end else begin
+          (* If we encounter a non-linear [let]-binding then we must clear
+             the let stack, since we cannot now move any previous binding
+             across the non-linear one. *)
+          let_stack := []
+        end;
+        loop body
+      end
+    | Uphantom_let (var, _defining_expr, body) ->
+      ignore_var_with_provenance var;
+      loop body
+    | Uletrec (defs, body) ->
+      (* Evaluation order for [defs] is not defined, and this case
+         probably isn't important for [Cmmgen] anyway. *)
+      let_stack := [];
+      List.iter (fun (var, def) ->
+          ignore_var_with_provenance var;
+          loop def;
+          let_stack := [])
+        defs;
+      loop body
+    | Uprim (prim, args, dbg) ->
+      ignore_primitive prim;
+      examine_argument_list args;
+      ignore_debuginfo dbg
+    | Uswitch (cond, { us_index_consts; us_actions_consts;
+          us_index_blocks; us_actions_blocks }, dbg) ->
+      examine_argument_list [cond];
+      ignore_int_array us_index_consts;
+      Array.iter (fun action ->
+          let_stack := [];
+          loop action)
+        us_actions_consts;
+      ignore_int_array us_index_blocks;
+      Array.iter (fun action ->
+          let_stack := [];
+          loop action)
+        us_actions_blocks;
+      ignore_debuginfo dbg;
+      let_stack := []
+    | Ustringswitch (cond, branches, default) ->
+      examine_argument_list [cond];
+      List.iter (fun (str, branch) ->
+          ignore_string str;
+          let_stack := [];
+          loop branch)
+        branches;
+      let_stack := [];
+      Option.iter loop default;
+      let_stack := []
+    | Ustaticfail (static_exn, args) ->
+      ignore_int static_exn;
+      examine_argument_list args
+    | Ucatch (static_exn, vars, body, handler) ->
+      ignore_int static_exn;
+      ignore_params_with_value_kind vars;
+      let_stack := [];
+      loop body;
+      let_stack := [];
+      loop handler;
+      let_stack := []
+    | Utrywith (body, var, handler) ->
+      let_stack := [];
+      loop body;
+      let_stack := [];
+      ignore_var_with_provenance var;
+      loop handler;
+      let_stack := []
+    | Uifthenelse (cond, ifso, ifnot) ->
+      examine_argument_list [cond];
+      let_stack := [];
+      loop ifso;
+      let_stack := [];
+      loop ifnot;
+      let_stack := []
+    | Usequence (e1, e2) ->
+      loop e1;
+      let_stack := [];
+      loop e2;
+      let_stack := []
+    | Uwhile (cond, body) ->
+      let_stack := [];
+      loop cond;
+      let_stack := [];
+      loop body;
+      let_stack := []
+    | Ufor (var, low, high, direction_flag, body) ->
+      ignore_var_with_provenance var;
+      (* Cmmgen generates code that evaluates low before high,
+         but we don't do anything here at the moment anyway. *)
+      ignore_ulambda low;
+      ignore_ulambda high;
+      ignore_direction_flag direction_flag;
+      let_stack := [];
+      loop body;
+      let_stack := []
+    | Uassign (var, expr) ->
+      ignore_var var;
+      ignore_ulambda expr;
+      let_stack := []
+    | Usend (meth_kind, e1, e2, args, dbg) ->
+      ignore_meth_kind meth_kind;
+      ignore_ulambda e1;
+      ignore_ulambda e2;
+      ignore_ulambda_list args;
+      let_stack := [];
+      ignore_debuginfo dbg
+    | Uunreachable ->
+      let_stack := []
+  in
+  loop clam;
+  !can_move
+
+(* Substitution of an expression for a let-moveable variable can cause the
+   surrounding expression to become fixed.  To avoid confusion, do the
+   let-moveable substitutions first. *)
+let rec substitute_let_moveable is_let_moveable env (clam : Clambda.ulambda)
+      : Clambda.ulambda =
+  match clam with
+  | Uvar var ->
+    if not (V.Set.mem var is_let_moveable) then
+      clam
+    else
+      begin match V.Map.find var env with
+      | clam -> clam
+      | exception Not_found ->
+        Misc.fatal_errorf "substitute_let_moveable: Unbound variable %a"
+          V.print var
+      end
+  | Uconst _ -> clam
+  | Udirect_apply (label, args, dbg) ->
+    let args = substitute_let_moveable_list is_let_moveable env args in
+    Udirect_apply (label, args, dbg)
+  | Ugeneric_apply (func, args, dbg) ->
+    let func = substitute_let_moveable is_let_moveable env func in
+    let args = substitute_let_moveable_list is_let_moveable env args in
+    Ugeneric_apply (func, args, dbg)
+  | Uclosure (functions, variables_bound_by_the_closure) ->
+    let functions =
+      List.map (fun (ufunction : Clambda.ufunction) ->
+          { ufunction with
+            body = substitute_let_moveable is_let_moveable env ufunction.body;
+          })
+        functions
+    in
+    let variables_bound_by_the_closure =
+      substitute_let_moveable_list is_let_moveable env
+        variables_bound_by_the_closure
+    in
+    Uclosure (functions, variables_bound_by_the_closure)
+  | Uoffset (clam, n) ->
+    let clam = substitute_let_moveable is_let_moveable env clam in
+    Uoffset (clam, n)
+  | Ulet (let_kind, value_kind, var, def, body) ->
+    let def = substitute_let_moveable is_let_moveable env def in
+    if V.Set.mem (VP.var var) is_let_moveable then
+      let env = V.Map.add (VP.var var) def env in
+      let body = substitute_let_moveable is_let_moveable env body in
+      (* If we are about to delete a [let] in debug mode, keep it for the
+         debugger. *)
+      (* CR-someday mshinwell: find out why some closure constructions were
+         not leaving phantom lets behind after substitution. *)
+      if not !Clflags.debug_full then
+        body
+      else
+        match def with
+        | Uconst const ->
+          Uphantom_let (var, Some (Clambda.Uphantom_const const), body)
+        | Uvar alias_of ->
+          Uphantom_let (var, Some (Clambda.Uphantom_var alias_of), body)
+        | _ ->
+          Uphantom_let (var, None, body)
+    else
+      Ulet (let_kind, value_kind,
+            var, def, substitute_let_moveable is_let_moveable env body)
+  | Uphantom_let (var, defining_expr, body) ->
+    let body = substitute_let_moveable is_let_moveable env body in
+    Uphantom_let (var, defining_expr, body)
+  | Uletrec (defs, body) ->
+    let defs =
+      List.map (fun (var, def) ->
+          var, substitute_let_moveable is_let_moveable env def)
+        defs
+    in
+    let body = substitute_let_moveable is_let_moveable env body in
+    Uletrec (defs, body)
+  | Uprim (prim, args, dbg) ->
+    let args = substitute_let_moveable_list is_let_moveable env args in
+    Uprim (prim, args, dbg)
+  | Uswitch (cond, sw, dbg) ->
+    let cond = substitute_let_moveable is_let_moveable env cond in
+    let sw =
+      { sw with
+        us_actions_consts =
+          substitute_let_moveable_array is_let_moveable env
+            sw.us_actions_consts;
+        us_actions_blocks =
+          substitute_let_moveable_array is_let_moveable env
+            sw.us_actions_blocks;
+      }
+    in
+    Uswitch (cond, sw, dbg)
+  | Ustringswitch (cond, branches, default) ->
+    let cond = substitute_let_moveable is_let_moveable env cond in
+    let branches =
+      List.map (fun (s, branch) ->
+          s, substitute_let_moveable is_let_moveable env branch)
+        branches
+    in
+    let default =
+      Option.map (substitute_let_moveable is_let_moveable env) default
+    in
+    Ustringswitch (cond, branches, default)
+  | Ustaticfail (n, args) ->
+    let args = substitute_let_moveable_list is_let_moveable env args in
+    Ustaticfail (n, args)
+  | Ucatch (n, vars, body, handler) ->
+    let body = substitute_let_moveable is_let_moveable env body in
+    let handler = substitute_let_moveable is_let_moveable env handler in
+    Ucatch (n, vars, body, handler)
+  | Utrywith (body, var, handler) ->
+    let body = substitute_let_moveable is_let_moveable env body in
+    let handler = substitute_let_moveable is_let_moveable env handler in
+    Utrywith (body, var, handler)
+  | Uifthenelse (cond, ifso, ifnot) ->
+    let cond = substitute_let_moveable is_let_moveable env cond in
+    let ifso = substitute_let_moveable is_let_moveable env ifso in
+    let ifnot = substitute_let_moveable is_let_moveable env ifnot in
+    Uifthenelse (cond, ifso, ifnot)
+  | Usequence (e1, e2) ->
+    let e1 = substitute_let_moveable is_let_moveable env e1 in
+    let e2 = substitute_let_moveable is_let_moveable env e2 in
+    Usequence (e1, e2)
+  | Uwhile (cond, body) ->
+    let cond = substitute_let_moveable is_let_moveable env cond in
+    let body = substitute_let_moveable is_let_moveable env body in
+    Uwhile (cond, body)
+  | Ufor (var, low, high, direction, body) ->
+    let low = substitute_let_moveable is_let_moveable env low in
+    let high = substitute_let_moveable is_let_moveable env high in
+    let body = substitute_let_moveable is_let_moveable env body in
+    Ufor (var, low, high, direction, body)
+  | Uassign (var, expr) ->
+    let expr = substitute_let_moveable is_let_moveable env expr in
+    Uassign (var, expr)
+  | Usend (kind, e1, e2, args, dbg) ->
+    let e1 = substitute_let_moveable is_let_moveable env e1 in
+    let e2 = substitute_let_moveable is_let_moveable env e2 in
+    let args = substitute_let_moveable_list is_let_moveable env args in
+    Usend (kind, e1, e2, args, dbg)
+  | Uunreachable ->
+    Uunreachable
+
+and substitute_let_moveable_list is_let_moveable env clams =
+  List.map (substitute_let_moveable is_let_moveable env) clams
+
+and substitute_let_moveable_array is_let_moveable env clams =
+  Array.map (substitute_let_moveable is_let_moveable env) clams
+
+(* We say that an expression is "moveable" iff it has neither effects nor
+   coeffects.  (See semantics_of_primitives.mli.)
+*)
+type moveable = Fixed | Constant | Moveable
+
+let both_moveable a b =
+  match a, b with
+  | Constant, Constant -> Constant
+  | Constant, Moveable
+  | Moveable, Constant
+  | Moveable, Moveable -> Moveable
+  | Constant, Fixed
+  | Moveable, Fixed
+  | Fixed, Constant
+  | Fixed, Moveable
+  | Fixed, Fixed -> Fixed
+
+let primitive_moveable (prim : Clambda_primitives.primitive)
+    (args : Clambda.ulambda list)
+    (var_info : var_info) =
+  match prim, args with
+  | Pfield _, [Uconst (Uconst_ref (_, _))] ->
+    (* CR-someday mshinwell: Actually, maybe this shouldn't be needed; these
+       should have been simplified to [Read_symbol_field], which doesn't yield
+       a Clambda let.  This might be fixed when Inline_and_simplify can
+       turn Pfield into Read_symbol_field. *)
+    (* Allow field access of symbols to be moveable.  (The comment in
+       flambda.mli on [Read_symbol_field] may be helpful to the reader.) *)
+    Moveable
+  | Pfield _, [Uvar var] when V.Set.mem var var_info.closure_environment ->
+    (* accesses to the function environment is coeffect free: this block
+       is never mutated *)
+    Moveable
+  | _ ->
+    match Semantics_of_primitives.for_primitive prim with
+    | No_effects, No_coeffects -> Moveable
+    | No_effects, Has_coeffects
+    | Only_generative_effects, No_coeffects
+    | Only_generative_effects, Has_coeffects
+    | Arbitrary_effects, No_coeffects
+    | Arbitrary_effects, Has_coeffects -> Fixed
+
+type moveable_for_env = Constant | Moveable
+
+(** Eliminate, through substitution, [let]-bindings of linear variables with
+    moveable defining expressions. *)
+let rec un_anf_and_moveable var_info env (clam : Clambda.ulambda)
+      : Clambda.ulambda * moveable =
+  match clam with
+  | Uvar var ->
+    begin match V.Map.find var env with
+    | Constant, def -> def, Constant
+    | Moveable, def -> def, Moveable
+    | exception Not_found ->
+      let moveable : moveable =
+        if V.Set.mem var var_info.assigned then
+          Fixed
+        else
+          Moveable
+      in
+      clam, moveable
+    end
+  | Uconst _ ->
+    (* Constant closures are rewritten separately. *)
+    clam, Constant
+  | Udirect_apply (label, args, dbg) ->
+    let args = un_anf_list var_info env args in
+    Udirect_apply (label, args, dbg), Fixed
+  | Ugeneric_apply (func, args, dbg) ->
+    let func = un_anf var_info env func in
+    let args = un_anf_list var_info env args in
+    Ugeneric_apply (func, args, dbg), Fixed
+  | Uclosure (functions, variables_bound_by_the_closure) ->
+    let functions =
+      List.map (fun (ufunction : Clambda.ufunction) ->
+          { ufunction with
+            body = un_anf var_info env ufunction.body;
+          })
+        functions
+    in
+    let variables_bound_by_the_closure =
+      un_anf_list var_info env variables_bound_by_the_closure
+    in
+    Uclosure (functions, variables_bound_by_the_closure), Fixed
+  | Uoffset (clam, n) ->
+    let clam, moveable = un_anf_and_moveable var_info env clam in
+    Uoffset (clam, n), both_moveable Moveable moveable
+  | Ulet (_let_kind, _value_kind, var, def, Uvar var')
+      when V.same (VP.var var) var' ->
+    un_anf_and_moveable var_info env def
+  | Ulet (let_kind, value_kind, var, def, body) ->
+    let def, def_moveable = un_anf_and_moveable var_info env def in
+    let is_linear = V.Set.mem (VP.var var) var_info.linear_let_bound_vars in
+    let is_used = V.Set.mem (VP.var var) var_info.used_let_bound_vars in
+    let is_assigned =
+      V.Set.mem (VP.var var) var_info.assigned
+    in
+    let maybe_for_debugger (body, moveable) : Clambda.ulambda * moveable =
+      if not !Clflags.debug_full then
+        body, moveable
+      else
+        match def with
+        | Uconst const ->
+          Uphantom_let (var, Some (Clambda.Uphantom_const const),
+            body), moveable
+        | Uvar alias_of ->
+          Uphantom_let (var, Some (Clambda.Uphantom_var alias_of), body),
+            moveable
+        | _ ->
+          Uphantom_let (var, None, body), moveable
+    in
+    begin match def_moveable, is_linear, is_used, is_assigned with
+    | (Constant | Moveable), _, false, _ ->
+      (* A moveable expression that is never used may be eliminated.
+         However, if in debug mode and the defining expression is
+         appropriate, keep the let (as a phantom let) for the debugger. *)
+      maybe_for_debugger (un_anf_and_moveable var_info env body)
+    | Constant, _, true, false
+    (* A constant expression bound to an unassigned variable can replace any
+       occurrences of the variable.  The same comment as above concerning
+       phantom lets applies. *)
+    | Moveable, true, true, false  ->
+      (* A moveable expression bound to a linear unassigned [V.t]
+         may replace the single occurrence of the variable.  The same comment
+         as above concerning phantom lets applies. *)
+      let def_moveable =
+        match def_moveable with
+        | Moveable -> Moveable
+        | Constant -> Constant
+        | Fixed -> assert false
+      in
+      let env = V.Map.add (VP.var var) (def_moveable, def) env in
+      maybe_for_debugger (un_anf_and_moveable var_info env body)
+    | (Constant | Moveable), _, _, true
+        (* Constant or Moveable but assigned. *)
+    | Moveable, false, _, _
+        (* Moveable but not used linearly. *)
+    | Fixed, _, _, _ ->
+      let body, body_moveable = un_anf_and_moveable var_info env body in
+      Ulet (let_kind, value_kind, var, def, body),
+      both_moveable def_moveable body_moveable
+    end
+  | Uphantom_let (var, defining_expr, body) ->
+    let body, body_moveable = un_anf_and_moveable var_info env body in
+    Uphantom_let (var, defining_expr, body), body_moveable
+  | Uletrec (defs, body) ->
+    let defs =
+      List.map (fun (var, def) -> var, un_anf var_info env def) defs
+    in
+    let body = un_anf var_info env body in
+    Uletrec (defs, body), Fixed
+  | Uprim (prim, args, dbg) ->
+    let args, args_moveable = un_anf_list_and_moveable var_info env args in
+    let moveable =
+      both_moveable args_moveable (primitive_moveable prim args var_info)
+    in
+    Uprim (prim, args, dbg), moveable
+  | Uswitch (cond, sw, dbg) ->
+    let cond = un_anf var_info env cond in
+    let sw =
+      { sw with
+        us_actions_consts = un_anf_array var_info env sw.us_actions_consts;
+        us_actions_blocks = un_anf_array var_info env sw.us_actions_blocks;
+      }
+    in
+    Uswitch (cond, sw, dbg), Fixed
+  | Ustringswitch (cond, branches, default) ->
+    let cond = un_anf var_info env cond in
+    let branches =
+      List.map (fun (s, branch) -> s, un_anf var_info env branch)
+        branches
+    in
+    let default = Option.map (un_anf var_info env) default in
+    Ustringswitch (cond, branches, default), Fixed
+  | Ustaticfail (n, args) ->
+    let args = un_anf_list var_info env args in
+    Ustaticfail (n, args), Fixed
+  | Ucatch (n, vars, body, handler) ->
+    let body = un_anf var_info env body in
+    let handler = un_anf var_info env handler in
+    Ucatch (n, vars, body, handler), Fixed
+  | Utrywith (body, var, handler) ->
+    let body = un_anf var_info env body in
+    let handler = un_anf var_info env handler in
+    Utrywith (body, var, handler), Fixed
+  | Uifthenelse (cond, ifso, ifnot) ->
+    let cond, cond_moveable = un_anf_and_moveable var_info env cond in
+    let ifso, ifso_moveable = un_anf_and_moveable var_info env ifso in
+    let ifnot, ifnot_moveable = un_anf_and_moveable var_info env ifnot in
+    let moveable =
+      both_moveable cond_moveable
+        (both_moveable ifso_moveable ifnot_moveable)
+    in
+    Uifthenelse (cond, ifso, ifnot), moveable
+  | Usequence (e1, e2) ->
+    let e1 = un_anf var_info env e1 in
+    let e2 = un_anf var_info env e2 in
+    Usequence (e1, e2), Fixed
+  | Uwhile (cond, body) ->
+    let cond = un_anf var_info env cond in
+    let body = un_anf var_info env body in
+    Uwhile (cond, body), Fixed
+  | Ufor (var, low, high, direction, body) ->
+    let low = un_anf var_info env low in
+    let high = un_anf var_info env high in
+    let body = un_anf var_info env body in
+    Ufor (var, low, high, direction, body), Fixed
+  | Uassign (var, expr) ->
+    let expr = un_anf var_info env expr in
+    Uassign (var, expr), Fixed
+  | Usend (kind, e1, e2, args, dbg) ->
+    let e1 = un_anf var_info env e1 in
+    let e2 = un_anf var_info env e2 in
+    let args = un_anf_list var_info env args in
+    Usend (kind, e1, e2, args, dbg), Fixed
+  | Uunreachable ->
+    Uunreachable, Fixed
+
+and un_anf var_info env clam : Clambda.ulambda =
+  let clam, _moveable = un_anf_and_moveable var_info env clam in
+  clam
+
+and un_anf_list_and_moveable var_info env clams
+      : Clambda.ulambda list * moveable =
+  List.fold_right (fun clam (l, acc_moveable) ->
+      let clam, moveable = un_anf_and_moveable var_info env clam in
+      clam :: l, both_moveable moveable acc_moveable)
+    clams ([], (Moveable : moveable))
+
+and un_anf_list var_info env clams : Clambda.ulambda list =
+  let clams, _moveable = un_anf_list_and_moveable var_info env clams in
+  clams
+
+and un_anf_array var_info env clams : Clambda.ulambda array =
+  Array.map (un_anf var_info env) clams
+
+let apply ~what ~ppf_dump clam =
+  let var_info = make_var_info clam in
+  let let_bound_vars_that_can_be_moved =
+    let_bound_vars_that_can_be_moved var_info clam
+  in
+  let clam =
+    substitute_let_moveable let_bound_vars_that_can_be_moved
+      V.Map.empty clam
+  in
+  let var_info = make_var_info clam in
+  let clam = un_anf var_info V.Map.empty clam in
+  if !Clflags.dump_clambda then begin
+    Format.fprintf ppf_dump
+      "@.un-anf (%a):@ %a@."
+        Symbol.print what
+        Printclambda.clambda clam
+  end;
+  clam
diff --git a/middle_end/flambda/un_anf.mli b/middle_end/flambda/un_anf.mli
new file mode 100644
index 00000000..a7d5e94e
--- /dev/null
+++ b/middle_end/flambda/un_anf.mli
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Expand ANF-like constructs so that pattern matches in [Cmmgen] will
+    work correctly. *)
+val apply
+   : what:Symbol.t
+  -> ppf_dump:Format.formatter
+  -> Clambda.ulambda
+  -> Clambda.ulambda
diff --git a/middle_end/flambda/unbox_closures.ml b/middle_end/flambda/unbox_closures.ml
new file mode 100644
index 00000000..5c86bed3
--- /dev/null
+++ b/middle_end/flambda/unbox_closures.ml
@@ -0,0 +1,87 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module ASA = Augment_specialised_args
+module W = ASA.What_to_specialise
+module E = Inline_and_simplify_aux.Env
+
+module Transform = struct
+  let pass_name = "unbox-closures"
+
+  let precondition ~env ~(set_of_closures : Flambda.set_of_closures) =
+    !Clflags.unbox_closures
+      && not (E.at_toplevel env)
+      && not (Variable.Map.is_empty set_of_closures.free_vars)
+
+  let what_to_specialise ~env ~(set_of_closures : Flambda.set_of_closures) =
+    let what_to_specialise = W.create ~set_of_closures in
+    if not (precondition ~env ~set_of_closures) then
+      what_to_specialise
+    else begin
+      let round = E.round env in
+      let num_closure_vars = Variable.Map.cardinal set_of_closures.free_vars in
+      let module B = Inlining_cost.Benefit in
+      let saved_by_not_building_closure =
+        (* For the moment assume that we're going to cause all functions in the
+           set to become closed. *)
+        B.remove_prims (B.remove_call B.zero) num_closure_vars
+      in
+      Flambda_iterators.fold_function_decls_ignoring_stubs set_of_closures
+        ~init:what_to_specialise
+        ~f:(fun ~fun_var ~(function_decl : Flambda.function_declaration)
+              what_to_specialise ->
+          let body_size = Inlining_cost.lambda_size function_decl.body in
+          (* If the function is small enough, make a direct call surrogate
+             for it, so that indirect calls are not penalised by having to
+             bounce through the stub.  (Making such a surrogate involves
+             duplicating the function.) *)
+          let small_enough_to_duplicate =
+            let module W = Inlining_cost.Whether_sufficient_benefit in
+            let wsb =
+              W.create_estimate ~original_size:0
+                ~toplevel:false
+                ~branch_depth:0
+                ~new_size:((body_size / !Clflags.unbox_closures_factor) + 1)
+                ~benefit:saved_by_not_building_closure
+                ~lifting:false
+                ~round
+            in
+            W.evaluate wsb
+          in
+          let what_to_specialise =
+            if small_enough_to_duplicate then
+              W.make_direct_call_surrogate_for what_to_specialise ~fun_var
+            else
+              what_to_specialise
+          in
+          let bound_by_the_closure =
+            Flambda_utils.variables_bound_by_the_closure
+              (Closure_id.wrap fun_var)
+              set_of_closures.function_decls
+          in
+          Variable.Set.fold (fun inner_free_var what_to_specialise ->
+              W.new_specialised_arg what_to_specialise
+                ~fun_var ~group:inner_free_var
+                ~definition:(Existing_inner_free_var inner_free_var))
+            bound_by_the_closure
+            what_to_specialise)
+    end
+end
+
+include ASA.Make (Transform)
diff --git a/middle_end/flambda/unbox_closures.mli b/middle_end/flambda/unbox_closures.mli
new file mode 100644
index 00000000..fb935a62
--- /dev/null
+++ b/middle_end/flambda/unbox_closures.mli
@@ -0,0 +1,33 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Turn free variables of closures into specialised arguments.
+    The aim is to cause the closure to become closed. *)
+
+val rewrite_set_of_closures
+   : env:Inline_and_simplify_aux.Env.t
+  (* CR-soon mshinwell: eliminate superfluous parameter *)
+  -> duplicate_function:(
+       env:Inline_and_simplify_aux.Env.t
+    -> set_of_closures:Flambda.set_of_closures
+    -> fun_var:Variable.t
+    -> new_fun_var:Variable.t
+    -> Flambda.function_declaration
+      * Flambda.specialised_to Variable.Map.t)
+  -> set_of_closures:Flambda.set_of_closures
+  -> (Flambda.expr * Inlining_cost.Benefit.t) option
diff --git a/middle_end/flambda/unbox_free_vars_of_closures.ml b/middle_end/flambda/unbox_free_vars_of_closures.ml
new file mode 100644
index 00000000..7a4e48ed
--- /dev/null
+++ b/middle_end/flambda/unbox_free_vars_of_closures.ml
@@ -0,0 +1,170 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module B = Inlining_cost.Benefit
+
+let pass_name = "unbox-free-vars-of-closures"
+let () = Pass_wrapper.register ~pass_name
+
+(* CR-someday mshinwell: Nearly but not quite the same as something that
+   Augment_specialised_args uses. *)
+let add_lifted_projections_around_set_of_closures
+      ~set_of_closures ~existing_inner_to_outer_vars ~benefit
+      ~definitions_indexed_by_new_inner_vars =
+  let body =
+    Flambda_utils.name_expr (Set_of_closures set_of_closures)
+      ~name:Internal_variable_names.unbox_free_vars_of_closures
+  in
+  Variable.Map.fold (fun new_inner_var (projection : Projection.t)
+            (expr, benefit) ->
+      let find_outer_var inner_var =
+        match
+          Variable.Map.find inner_var existing_inner_to_outer_vars
+        with
+        | (outer_var : Flambda.specialised_to) -> outer_var.var
+        | exception Not_found ->
+          Misc.fatal_errorf "(UFV) find_outer_var: expected %a \
+              to be in [existing_inner_to_outer_vars], but it is \
+              not.  (The projection was: %a)"
+            Variable.print inner_var
+            Projection.print projection
+      in
+      let benefit = B.add_projection projection benefit in
+      let named : Flambda.named =
+        (* The lifted projection must be in terms of outer variables,
+           not inner variables. *)
+        let projection =
+          Projection.map_projecting_from projection ~f:find_outer_var
+        in
+        Flambda_utils.projection_to_named projection
+      in
+      let expr =
+        Flambda.create_let (find_outer_var new_inner_var) named expr
+      in
+      (expr, benefit))
+    definitions_indexed_by_new_inner_vars
+    (body, benefit)
+
+let run ~env ~(set_of_closures : Flambda.set_of_closures) =
+  if not !Clflags.unbox_free_vars_of_closures then
+    None
+  else
+    let definitions_indexed_by_new_inner_vars, _, free_vars, done_something =
+      let all_existing_definitions =
+        Variable.Map.fold (fun _inner_var (outer_var : Flambda.specialised_to)
+              all_existing_definitions ->
+            match outer_var.projection with
+            | None -> all_existing_definitions
+            | Some projection ->
+              Projection.Set.add projection all_existing_definitions)
+          set_of_closures.free_vars
+          Projection.Set.empty
+      in
+      Flambda_iterators.fold_function_decls_ignoring_stubs set_of_closures
+        ~init:(Variable.Map.empty, all_existing_definitions,
+          set_of_closures.free_vars, false)
+        ~f:(fun ~fun_var:_ ~function_decl result ->
+          let extracted =
+            Extract_projections.from_function_decl ~env ~function_decl
+              ~which_variables:set_of_closures.free_vars
+          in
+          Projection.Set.fold (fun projection
+                ((definitions_indexed_by_new_inner_vars,
+                  all_existing_definitions_including_added_ones,
+                  additional_free_vars, _done_something) as result) ->
+              (* Don't add a new free variable if there already exists a
+                 free variable with the desired projection.  We need to
+                 dedup not only across the existing free variables but
+                 also across newly-added ones (unlike in
+                 [Augment_specialised_args]), since free variables are
+                 not local to a function declaration but rather to a
+                 set of closures. *)
+              if Projection.Set.mem projection
+                all_existing_definitions_including_added_ones
+              then begin
+                result
+              end else begin
+                (* Add a new free variable.  This needs both a fresh
+                   "new inner" and a fresh "new outer" var, since we know
+                   the definition is not a duplicate. *)
+                let projecting_from = Projection.projecting_from projection in
+                let new_inner_var = Variable.rename projecting_from in
+                let new_outer_var = Variable.rename projecting_from in
+                let definitions_indexed_by_new_inner_vars =
+                  Variable.Map.add new_inner_var projection
+                    definitions_indexed_by_new_inner_vars
+                in
+                let all_existing_definitions_including_added_ones =
+                  Projection.Set.add projection
+                    all_existing_definitions_including_added_ones
+                in
+                let new_outer_var : Flambda.specialised_to =
+                  { var = new_outer_var;
+                    projection = Some projection;
+                  }
+                in
+                let additional_free_vars =
+                  Variable.Map.add new_inner_var new_outer_var
+                    additional_free_vars
+                in
+                definitions_indexed_by_new_inner_vars,
+                  all_existing_definitions_including_added_ones,
+                  additional_free_vars,
+                  true
+              end)
+            extracted
+            result)
+    in
+    if not done_something then
+      None
+    else
+      (* CR-someday mshinwell: could consider doing the grouping thing
+         similar to Augment_specialised_args *)
+      let num_free_vars_before =
+        Variable.Map.cardinal set_of_closures.free_vars
+      in
+      let num_free_vars_after =
+        Variable.Map.cardinal free_vars
+      in
+      assert (num_free_vars_after > num_free_vars_before);
+      (* Don't let the closure grow too large. *)
+      if num_free_vars_after > 2 * num_free_vars_before then
+        None
+      else
+        let set_of_closures =
+          Flambda.create_set_of_closures
+            ~function_decls:set_of_closures.function_decls
+            ~free_vars
+            ~specialised_args:set_of_closures.specialised_args
+            ~direct_call_surrogates:set_of_closures.direct_call_surrogates
+        in
+        let expr, benefit =
+          add_lifted_projections_around_set_of_closures ~set_of_closures
+            ~benefit:B.zero
+            ~existing_inner_to_outer_vars:set_of_closures.free_vars
+            ~definitions_indexed_by_new_inner_vars
+        in
+        Some (expr, benefit)
+
+let run ~env ~set_of_closures =
+  Pass_wrapper.with_dump ~ppf_dump:(Inline_and_simplify_aux.Env.ppf_dump env)
+    ~pass_name ~input:set_of_closures
+    ~print_input:Flambda.print_set_of_closures
+    ~print_output:(fun ppf (expr, _) -> Flambda.print ppf expr)
+    ~f:(fun () -> run ~env ~set_of_closures)
diff --git a/middle_end/flambda/unbox_free_vars_of_closures.mli b/middle_end/flambda/unbox_free_vars_of_closures.mli
new file mode 100644
index 00000000..3ee181ee
--- /dev/null
+++ b/middle_end/flambda/unbox_free_vars_of_closures.mli
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** When approximations of free variables of closures indicate that they
+    are closures or blocks, rewrite projections from such blocks to new
+    variables (which become free in the closures), with the defining
+    expressions of the projections lifted out of the corresponding sets
+    of closures. *)
+
+val run
+   : env:Inline_and_simplify_aux.Env.t
+  -> set_of_closures:Flambda.set_of_closures
+  -> (Flambda.expr * Inlining_cost.Benefit.t) option
diff --git a/middle_end/flambda/unbox_specialised_args.ml b/middle_end/flambda/unbox_specialised_args.ml
new file mode 100644
index 00000000..20d69c1d
--- /dev/null
+++ b/middle_end/flambda/unbox_specialised_args.ml
@@ -0,0 +1,103 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+module ASA = Augment_specialised_args
+module W = ASA.What_to_specialise
+
+module Transform = struct
+  let pass_name = "unbox-specialised-args"
+
+  let precondition ~env:_ ~(set_of_closures : Flambda.set_of_closures) =
+    !Clflags.unbox_specialised_args
+      && not (Variable.Map.is_empty set_of_closures.specialised_args)
+
+  let what_to_specialise ~env ~(set_of_closures : Flambda.set_of_closures) =
+    let what_to_specialise = W.create ~set_of_closures in
+    if not (precondition ~env ~set_of_closures) then
+      what_to_specialise
+    else
+      let projections_by_function =
+        set_of_closures.function_decls.funs |> Variable.Map.filter_map
+          (fun _fun_var (function_decl : Flambda.function_declaration) ->
+              if function_decl.stub then None
+              else
+                Some (Extract_projections.from_function_decl ~env
+                  ~function_decl
+                  ~which_variables:set_of_closures.specialised_args))
+      in
+      (* CR-soon mshinwell: consider caching the Invariant_params *relation*
+         as well as the "_in_recursion" map *)
+      let invariant_params_flow =
+        Invariant_params.invariant_param_sources set_of_closures.function_decls
+          ~backend:(Inline_and_simplify_aux.Env.backend env)
+      in
+      Variable.Map.fold (fun fun_var extractions what_to_specialise ->
+          Projection.Set.fold (fun (projection : Projection.t)
+                  what_to_specialise ->
+              let group = Projection.projecting_from projection in
+              assert (Variable.Map.mem group set_of_closures.specialised_args);
+              let what_to_specialise =
+                W.new_specialised_arg what_to_specialise ~fun_var ~group
+                  ~definition:(Projection_from_existing_specialised_arg
+                      projection)
+              in
+              match Variable.Map.find group invariant_params_flow with
+              | exception Not_found -> what_to_specialise
+              | flow ->
+                (* If for function [f] we would extract a projection expression
+                   [e] from some specialised argument [x] of [f], and we know
+                   from [Invariant_params] that a specialised argument [y] of
+                   another function [g] flows to [x], we will add [e] with
+                   [y] substituted for [x] throughout as a newly-specialised
+                   argument for [g].  This should help reduce the number of
+                   simplification rounds required for mutually-recursive
+                   functions. *)
+                Variable.Pair.Set.fold (fun (target_fun_var, target_spec_arg)
+                          what_to_specialise ->
+                    if Variable.equal fun_var target_fun_var
+                      || not (Variable.Map.mem target_spec_arg
+                          set_of_closures.specialised_args)
+                    then begin
+                      what_to_specialise
+                    end else begin
+                      (* Rewrite the projection (that was in terms of an inner
+                         specialised arg of [fun_var]) to be in terms of the
+                         corresponding inner specialised arg of
+                         [target_fun_var].  (The outer vars referenced in the
+                         projection remain unchanged.) *)
+                      let projection =
+                        Projection.map_projecting_from projection
+                          ~f:(fun var ->
+                            assert (Variable.equal var group);
+                            target_spec_arg)
+                      in
+                      W.new_specialised_arg what_to_specialise
+                        ~fun_var:target_fun_var ~group
+                        ~definition:
+                          (Projection_from_existing_specialised_arg projection)
+                    end)
+                  flow
+                  what_to_specialise)
+            extractions
+            what_to_specialise)
+        projections_by_function
+        what_to_specialise
+end
+
+include ASA.Make (Transform)
diff --git a/middle_end/flambda/unbox_specialised_args.mli b/middle_end/flambda/unbox_specialised_args.mli
new file mode 100644
index 00000000..f0191764
--- /dev/null
+++ b/middle_end/flambda/unbox_specialised_args.mli
@@ -0,0 +1,50 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** When approximations of specialised arguments indicate that they are
+    closures or blocks, add more specialised arguments corresponding to
+    the projections from such blocks (with definitions of such projections
+    lifted out), such that the original specialised arguments may later be
+    eliminated.
+
+    This in particular enables elimination of closure allocations in
+    examples such as:
+
+      let rec map f = function
+        | [] -> []
+        | a::l -> let r = f a in r :: map f l
+
+      let g x =
+        map (fun y -> x + y) [1; 2; 3; 4]
+
+    Here, the specialised version of [map] initially has a specialised
+    argument [f]; and upon inlining there will be a projection of [x] from
+    the closure of [f].  This pass adds a new specialised argument to carry
+    that projection, at which point the closure of [f] is redundant.
+*)
+
+val rewrite_set_of_closures
+   : env:Inline_and_simplify_aux.Env.t
+  (* CR-soon mshinwell: eliminate superfluous parameter *)
+  -> duplicate_function:(
+       env:Inline_and_simplify_aux.Env.t
+    -> set_of_closures:Flambda.set_of_closures
+    -> fun_var:Variable.t
+    -> new_fun_var:Variable.t
+    -> Flambda.function_declaration
+      * Flambda.specialised_to Variable.Map.t)
+  -> set_of_closures:Flambda.set_of_closures
+  -> (Flambda.expr * Inlining_cost.Benefit.t) option
diff --git a/middle_end/internal_variable_names.ml b/middle_end/internal_variable_names.ml
new file mode 100644
index 00000000..d139dbb2
--- /dev/null
+++ b/middle_end/internal_variable_names.ml
@@ -0,0 +1,522 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                     Fu Yong Quah, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+type t = string
+
+let apply_arg = "apply_arg"
+let apply_funct = "apply_funct"
+let block_symbol = "block_symbol"
+let block_symbol_get = "block_symbol_get"
+let block_symbol_get_field = "block_symbol_get_field"
+let closure = "closure"
+let cond = "cond"
+let cond_sequor = "cond_sequor"
+let const_block = "const_block"
+let const_bool = "const_bool"
+let const_boxed_int = "const_boxed_int"
+let const_char = "const_char"
+let const_false = "const_false"
+let const_float = "const_float"
+let const_int = "const_int"
+let const_one = "const_one"
+let const_ptr = "const_ptr"
+let const_ptr_one = "const_ptr_one"
+let const_ptr_zero = "const_ptr_zero"
+let const_sequand = "const_sequand"
+let const_string = "const_string"
+let const_true = "const_true"
+let const_zero = "const_zero"
+let denominator = "denominator"
+let division_by_zero = "division_by_zero"
+let dummy = "dummy"
+let dup_func = "dup_func"
+let dup_set_of_closures = "dup_set_of_closures"
+let const_float_array = "const_float_array"
+let fake_effect_symbol = "fake_effect_symbol"
+let for_from = "for_from"
+let for_to = "for_to"
+let from_closure = "from_closure"
+let full_apply = "full_apply"
+let get_symbol_field = "get_symbol_field"
+let const_immstring = "const_immstring"
+let const_int32 = "const_int32"
+let const_int64 = "const_int64"
+let ignore = "ignore"
+let is_zero = "is_zero"
+let lifted_let_rec_block = "lifted_let_rec_block"
+let meth = "meth"
+let module_as_block = "module_as_block"
+let const_nativeint = "const_nativeint"
+let new_value = "new_value"
+let numerator = "numerator"
+let obj = "obj"
+let offsetted = "offsetted"
+let pabsfloat = "Pabsfloat"
+let paddbint = "Paddbint"
+let paddfloat = "Paddfloat"
+let paddint = "Paddint"
+let pandbint = "Pandbint"
+let pandint = "Pandint"
+let parraylength = "Parraylength"
+let parrayrefs = "Parrayrefs"
+let parrayrefu = "Parrayrefu"
+let parraysets = "Parraysets"
+let parraysetu = "Parraysetu"
+let pasrbint = "Pasrbint"
+let pasrint = "Pasrint"
+let pbbswap = "Pbbswap"
+let pbigarraydim = "Pbigarraydim"
+let pbigarrayref = "Pbigarrayref"
+let pbigarrayset = "Pbigarrayset"
+let pbigstring_load_16 = "Pbigstring_load_16"
+let pbigstring_load_32 = "Pbigstring_load_32"
+let pbigstring_load_64 = "Pbigstring_load_64"
+let pbigstring_set_16 = "Pbigstring_set_16"
+let pbigstring_set_32 = "Pbigstring_set_32"
+let pbigstring_set_64 = "Pbigstring_set_64"
+let pbintcomp = "Pbintcomp"
+let pbintofint = "Pbintofint"
+let pbswap16 = "Pbswap16"
+let pbytes_of_string = "Pbytes_of_string"
+let pbytes_load_16 = "Pbytes_load_16"
+let pbytes_load_32 = "Pbytes_load_32"
+let pbytes_load_64 = "Pbytes_load_64"
+let pbytes_set_16 = "Pbytes_set_16"
+let pbytes_set_32 = "Pbytes_set_32"
+let pbytes_set_64 = "Pbytes_set_64"
+let pbytes_to_string = "Pbytes_to_string"
+let pbyteslength = "Pbyteslength"
+let pbytesrefs = "Pbytesrefs"
+let pbytesrefu = "Pbytesrefu"
+let pbytessets = "Pbytessets"
+let pbytessetu = "Pbytessetu"
+let pccall = "Pccall"
+let pctconst = "Pctconst"
+let pcvtbint = "Pcvtbint"
+let pdirapply = "Pdirapply"
+let pdivbint = "Pdivbint"
+let pdivfloat = "Pdivfloat"
+let pdivint = "Pdivint"
+let pduparray = "Pduparray"
+let pduprecord = "Pduprecord"
+let pfield = "Pfield"
+let pfield_computed = "Pfield_computed"
+let pfloatcomp = "Pfloatcomp"
+let pfloatfield = "Pfloatfield"
+let pfloatofint = "Pfloatofint"
+let pgetglobal = "Pgetglobal"
+let pidentity = "Pidentity"
+let pignore = "Pignore"
+let pint_as_pointer = "Pint_as_pointer"
+let pintcomp = "Pintcomp"
+let pcompare_ints = "Pcompare_ints"
+let pcompare_floats = "Pcompare_floats"
+let pcompare_bints = "Pcompare_bints"
+let pintofbint = "Pintofbint"
+let pintoffloat = "Pintoffloat"
+let pisint = "Pisint"
+let pisout = "Pisout"
+let plslbint = "Plslbint"
+let plslint = "Plslint"
+let plsrbint = "Plsrbint"
+let plsrint = "Plsrint"
+let pmakearray = "Pmakearray"
+let pmakeblock = "Pmakeblock"
+let pmodbint = "Pmodbint"
+let pmodint = "Pmodint"
+let pmulbint = "Pmulbint"
+let pmulfloat = "Pmulfloat"
+let pmulint = "Pmulint"
+let pnegbint = "Pnegbint"
+let pnegfloat = "Pnegfloat"
+let pnegint = "Pnegint"
+let pnot = "Pnot"
+let poffsetint = "Poffsetint"
+let poffsetref = "Poffsetref"
+let pointer = "pointer"
+let popaque = "Popaque"
+let porbint = "Porbint"
+let porint = "Porint"
+let praise = "Praise"
+let predef_exn = "predef_exn"
+let prevapply = "Prevapply"
+let project_closure = "project_closure"
+let psequand = "Psequand"
+let psequor = "Psequor"
+let psetfield = "Psetfield"
+let psetfield_computed = "Psetfield_computed"
+let psetfloatfield = "Psetfloatfield"
+let psetglobal = "Psetglobal"
+let pstring_load_16 = "Pstring_load_16"
+let pstring_load_32 = "Pstring_load_32"
+let pstring_load_64 = "Pstring_load_64"
+let pstringlength = "Pstringlength"
+let pstringrefs = "Pstringrefs"
+let pstringrefu = "Pstringrefu"
+let psubbint = "Psubbint"
+let psubfloat = "Psubfloat"
+let psubint = "Psubint"
+let pxorbint = "Pxorbint"
+let pxorint = "Pxorint"
+let pabsfloat_arg = "Pabsfloat_arg"
+let paddbint_arg = "Paddbint_arg"
+let paddfloat_arg = "Paddfloat_arg"
+let paddint_arg = "Paddint_arg"
+let pandbint_arg = "Pandbint_arg"
+let pandint_arg = "Pandint_arg"
+let parraylength_arg = "Parraylength_arg"
+let parrayrefs_arg = "Parrayrefs_arg"
+let parrayrefu_arg = "Parrayrefu_arg"
+let parraysets_arg = "Parraysets_arg"
+let parraysetu_arg = "Parraysetu_arg"
+let partial_fun = "partial_fun"
+let pasrbint_arg = "Pasrbint_arg"
+let pasrint_arg = "Pasrint_arg"
+let pbbswap_arg = "Pbbswap_arg"
+let pbigarraydim_arg = "Pbigarraydim_arg"
+let pbigarrayref_arg = "Pbigarrayref_arg"
+let pbigarrayset_arg = "Pbigarrayset_arg"
+let pbigstring_load_16_arg = "Pbigstring_load_16_arg"
+let pbigstring_load_32_arg = "Pbigstring_load_32_arg"
+let pbigstring_load_64_arg = "Pbigstring_load_64_arg"
+let pbigstring_set_16_arg = "Pbigstring_set_16_arg"
+let pbigstring_set_32_arg = "Pbigstring_set_32_arg"
+let pbigstring_set_64_arg = "Pbigstring_set_64_arg"
+let pbintcomp_arg = "Pbintcomp_arg"
+let pbintofint_arg = "Pbintofint_arg"
+let pbswap16_arg = "Pbswap16_arg"
+let pbytes_of_string_arg = "Pbytes_of_string_arg"
+let pbytes_to_string_arg = "Pbytes_to_string_arg"
+let pbyteslength_arg = "Pbyteslength_arg"
+let pbytesrefs_arg = "Pbytesrefs_arg"
+let pbytesrefu_arg = "Pbytesrefu_arg"
+let pbytessets_arg = "Pbytessets_arg"
+let pbytessetu_arg = "Pbytessetu_arg"
+let pccall_arg = "Pccall_arg"
+let pctconst_arg = "Pctconst_arg"
+let pcvtbint_arg = "Pcvtbint_arg"
+let pdirapply_arg = "Pdirapply_arg"
+let pdivbint_arg = "Pdivbint_arg"
+let pdivfloat_arg = "Pdivfloat_arg"
+let pdivint_arg = "Pdivint_arg"
+let pduparray_arg = "Pduparray_arg"
+let pduprecord_arg = "Pduprecord_arg"
+let pfield_arg = "Pfield_arg"
+let pfield_computed_arg = "Pfield_computed_arg"
+let pfloatcomp_arg = "Pfloatcomp_arg"
+let pfloatfield_arg = "Pfloatfield_arg"
+let pfloatofint_arg = "Pfloatofint_arg"
+let pgetglobal_arg = "Pgetglobal_arg"
+let pidentity_arg = "Pidentity_arg"
+let pignore_arg = "Pignore_arg"
+let pint_as_pointer_arg = "Pint_as_pointer_arg"
+let pintcomp_arg = "Pintcomp_arg"
+let pcompare_ints_arg = "Pcompare_ints_arg"
+let pcompare_floats_arg = "Pcompare_floats_arg"
+let pcompare_bints_arg = "Pcompare_bints_arg"
+let pintofbint_arg = "Pintofbint_arg"
+let pintoffloat_arg = "Pintoffloat_arg"
+let pisint_arg = "Pisint_arg"
+let pisout_arg = "Pisout_arg"
+let plslbint_arg = "Plslbint_arg"
+let plslint_arg = "Plslint_arg"
+let plsrbint_arg = "Plsrbint_arg"
+let plsrint_arg = "Plsrint_arg"
+let pmakearray_arg = "Pmakearray_arg"
+let pmakeblock_arg = "Pmakeblock_arg"
+let pmodbint_arg = "Pmodbint_arg"
+let pmodint_arg = "Pmodint_arg"
+let pmulbint_arg = "Pmulbint_arg"
+let pmulfloat_arg = "Pmulfloat_arg"
+let pmulint_arg = "Pmulint_arg"
+let pnegbint_arg = "Pnegbint_arg"
+let pnegfloat_arg = "Pnegfloat_arg"
+let pnegint_arg = "Pnegint_arg"
+let pnot_arg = "Pnot_arg"
+let poffsetint_arg = "Poffsetint_arg"
+let poffsetref_arg = "Poffsetref_arg"
+let popaque_arg = "Popaque_arg"
+let porbint_arg = "Porbint_arg"
+let porint_arg = "Porint_arg"
+let praise_arg = "Praise_arg"
+let prevapply_arg = "Prevapply_arg"
+let psequand_arg = "Psequand_arg"
+let psequor_arg = "Psequor_arg"
+let psetfield_arg = "Psetfield_arg"
+let psetfield_computed_arg = "Psetfield_computed_arg"
+let psetfloatfield_arg = "Psetfloatfield_arg"
+let psetglobal_arg = "Psetglobal_arg"
+let pstring_load_16_arg = "Pstring_load_16_arg"
+let pstring_load_32_arg = "Pstring_load_32_arg"
+let pstring_load_64_arg = "Pstring_load_64_arg"
+let pbytes_load_16_arg = "Pbytes_load_16_arg"
+let pbytes_load_32_arg = "Pbytes_load_32_arg"
+let pbytes_load_64_arg = "Pbytes_load_64_arg"
+let pbytes_set_16_arg = "Pbytes_set_16_arg"
+let pbytes_set_32_arg = "Pbytes_set_32_arg"
+let pbytes_set_64_arg = "Pbytes_set_64_arg"
+let pstringlength_arg = "Pstringlength_arg"
+let pstringrefs_arg = "Pstringrefs_arg"
+let pstringrefu_arg = "Pstringrefu_arg"
+let psubbint_arg = "Psubbint_arg"
+let psubfloat_arg = "Psubfloat_arg"
+let psubint_arg = "Psubint_arg"
+let pxorbint_arg = "Pxorbint_arg"
+let pxorint_arg = "Pxorint_arg"
+let raise = "raise"
+let raise_arg = "raise_arg"
+let read_mutable = "read_mutable"
+let remove_unused_arguments = "remove_unused_arguments"
+let result = "result"
+let send_arg = "send_arg"
+let sequence = "sequence"
+let set_of_closures = "set_of_closures"
+let simplify_fv = "simplify_fv"
+let staticraise_arg = "staticraise_arg"
+let string_switch = "string_switch"
+let switch = "switch"
+let symbol = "symbol"
+let symbol_field = "symbol_field"
+let symbol_field_block = "symbol_field_block"
+let the_dead_constant = "the_dead_constant"
+let toplevel_substitution_named = "toplevel_substitution_named"
+let unbox_free_vars_of_closures = "unbox_free_vars_of_closures"
+let unit = "unit"
+let zero = "zero"
+
+let anon_fn_with_loc (sloc: Lambda.scoped_location) =
+  let loc = Debuginfo.Scoped_location.to_location sloc in
+  let (file, line, startchar) = Location.get_pos_info loc.loc_start in
+  let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_bol in
+  let pp_chars ppf =
+    if startchar >= 0 then Format.fprintf ppf ",%i--%i" startchar endchar in
+  if loc.Location.loc_ghost then "anon_fn"
+  else
+    Format.asprintf "anon_fn[%s:%i%t]"
+      (Filename.basename file) line pp_chars
+
+let of_primitive : Lambda.primitive -> string = function
+  | Pidentity -> pidentity
+  | Pbytes_of_string -> pbytes_of_string
+  | Pbytes_to_string -> pbytes_to_string
+  | Pignore -> pignore
+  | Prevapply -> prevapply
+  | Pdirapply -> pdirapply
+  | Pgetglobal _ -> pgetglobal
+  | Psetglobal _ -> psetglobal
+  | Pmakeblock _ -> pmakeblock
+  | Pfield _ -> pfield
+  | Pfield_computed -> pfield_computed
+  | Psetfield _ -> psetfield
+  | Psetfield_computed _ -> psetfield_computed
+  | Pfloatfield _ -> pfloatfield
+  | Psetfloatfield _ -> psetfloatfield
+  | Pduprecord _ -> pduprecord
+  | Pccall _ -> pccall
+  | Praise _ -> praise
+  | Psequand -> psequand
+  | Psequor -> psequor
+  | Pnot -> pnot
+  | Pnegint -> pnegint
+  | Paddint -> paddint
+  | Psubint -> psubint
+  | Pmulint -> pmulint
+  | Pdivint _ -> pdivint
+  | Pmodint _ -> pmodint
+  | Pandint -> pandint
+  | Porint -> porint
+  | Pxorint -> pxorint
+  | Plslint -> plslint
+  | Plsrint -> plsrint
+  | Pasrint -> pasrint
+  | Pintcomp _ -> pintcomp
+  | Pcompare_ints -> pcompare_ints
+  | Pcompare_floats -> pcompare_floats
+  | Pcompare_bints _ -> pcompare_bints
+  | Poffsetint _ -> poffsetint
+  | Poffsetref _ -> poffsetref
+  | Pintoffloat -> pintoffloat
+  | Pfloatofint -> pfloatofint
+  | Pnegfloat -> pnegfloat
+  | Pabsfloat -> pabsfloat
+  | Paddfloat -> paddfloat
+  | Psubfloat -> psubfloat
+  | Pmulfloat -> pmulfloat
+  | Pdivfloat -> pdivfloat
+  | Pfloatcomp _ -> pfloatcomp
+  | Pstringlength -> pstringlength
+  | Pstringrefu -> pstringrefu
+  | Pstringrefs -> pstringrefs
+  | Pbyteslength -> pbyteslength
+  | Pbytesrefu -> pbytesrefu
+  | Pbytessetu -> pbytessetu
+  | Pbytesrefs -> pbytesrefs
+  | Pbytessets -> pbytessets
+  | Parraylength _ -> parraylength
+  | Pmakearray _ -> pmakearray
+  | Pduparray _ -> pduparray
+  | Parrayrefu _ -> parrayrefu
+  | Parraysetu _ -> parraysetu
+  | Parrayrefs _ -> parrayrefs
+  | Parraysets _ -> parraysets
+  | Pctconst _ -> pctconst
+  | Pisint -> pisint
+  | Pisout -> pisout
+  | Pbintofint _ -> pbintofint
+  | Pintofbint _ -> pintofbint
+  | Pcvtbint _ -> pcvtbint
+  | Pnegbint _ -> pnegbint
+  | Paddbint _ -> paddbint
+  | Psubbint _ -> psubbint
+  | Pmulbint _ -> pmulbint
+  | Pdivbint _ -> pdivbint
+  | Pmodbint _ -> pmodbint
+  | Pandbint _ -> pandbint
+  | Porbint _ -> porbint
+  | Pxorbint _ -> pxorbint
+  | Plslbint _ -> plslbint
+  | Plsrbint _ -> plsrbint
+  | Pasrbint _ -> pasrbint
+  | Pbintcomp _ -> pbintcomp
+  | Pbigarrayref _ -> pbigarrayref
+  | Pbigarrayset _ -> pbigarrayset
+  | Pbigarraydim _ -> pbigarraydim
+  | Pstring_load_16 _ -> pstring_load_16
+  | Pstring_load_32 _ -> pstring_load_32
+  | Pstring_load_64 _ -> pstring_load_64
+  | Pbytes_load_16 _ -> pbytes_load_16
+  | Pbytes_load_32 _ -> pbytes_load_32
+  | Pbytes_load_64 _ -> pbytes_load_64
+  | Pbytes_set_16 _ -> pbytes_set_16
+  | Pbytes_set_32 _ -> pbytes_set_32
+  | Pbytes_set_64 _ -> pbytes_set_64
+  | Pbigstring_load_16 _ -> pbigstring_load_16
+  | Pbigstring_load_32 _ -> pbigstring_load_32
+  | Pbigstring_load_64 _ -> pbigstring_load_64
+  | Pbigstring_set_16 _ -> pbigstring_set_16
+  | Pbigstring_set_32 _ -> pbigstring_set_32
+  | Pbigstring_set_64 _ -> pbigstring_set_64
+  | Pbswap16 -> pbswap16
+  | Pbbswap _ -> pbbswap
+  | Pint_as_pointer -> pint_as_pointer
+  | Popaque -> popaque
+
+let of_primitive_arg : Lambda.primitive -> string = function
+  | Pidentity -> pidentity_arg
+  | Pbytes_of_string -> pbytes_of_string_arg
+  | Pbytes_to_string -> pbytes_to_string_arg
+  | Pignore -> pignore_arg
+  | Prevapply -> prevapply_arg
+  | Pdirapply -> pdirapply_arg
+  | Pgetglobal _ -> pgetglobal_arg
+  | Psetglobal _ -> psetglobal_arg
+  | Pmakeblock _ -> pmakeblock_arg
+  | Pfield _ -> pfield_arg
+  | Pfield_computed -> pfield_computed_arg
+  | Psetfield _ -> psetfield_arg
+  | Psetfield_computed _ -> psetfield_computed_arg
+  | Pfloatfield _ -> pfloatfield_arg
+  | Psetfloatfield _ -> psetfloatfield_arg
+  | Pduprecord _ -> pduprecord_arg
+  | Pccall _ -> pccall_arg
+  | Praise _ -> praise_arg
+  | Psequand -> psequand_arg
+  | Psequor -> psequor_arg
+  | Pnot -> pnot_arg
+  | Pnegint -> pnegint_arg
+  | Paddint -> paddint_arg
+  | Psubint -> psubint_arg
+  | Pmulint -> pmulint_arg
+  | Pdivint _ -> pdivint_arg
+  | Pmodint _ -> pmodint_arg
+  | Pandint -> pandint_arg
+  | Porint -> porint_arg
+  | Pxorint -> pxorint_arg
+  | Plslint -> plslint_arg
+  | Plsrint -> plsrint_arg
+  | Pasrint -> pasrint_arg
+  | Pintcomp _ -> pintcomp_arg
+  | Pcompare_ints -> pcompare_ints_arg
+  | Pcompare_floats -> pcompare_floats_arg
+  | Pcompare_bints _ -> pcompare_bints_arg
+  | Poffsetint _ -> poffsetint_arg
+  | Poffsetref _ -> poffsetref_arg
+  | Pintoffloat -> pintoffloat_arg
+  | Pfloatofint -> pfloatofint_arg
+  | Pnegfloat -> pnegfloat_arg
+  | Pabsfloat -> pabsfloat_arg
+  | Paddfloat -> paddfloat_arg
+  | Psubfloat -> psubfloat_arg
+  | Pmulfloat -> pmulfloat_arg
+  | Pdivfloat -> pdivfloat_arg
+  | Pfloatcomp _ -> pfloatcomp_arg
+  | Pstringlength -> pstringlength_arg
+  | Pstringrefu -> pstringrefu_arg
+  | Pstringrefs -> pstringrefs_arg
+  | Pbyteslength -> pbyteslength_arg
+  | Pbytesrefu -> pbytesrefu_arg
+  | Pbytessetu -> pbytessetu_arg
+  | Pbytesrefs -> pbytesrefs_arg
+  | Pbytessets -> pbytessets_arg
+  | Parraylength _ -> parraylength_arg
+  | Pmakearray _ -> pmakearray_arg
+  | Pduparray _ -> pduparray_arg
+  | Parrayrefu _ -> parrayrefu_arg
+  | Parraysetu _ -> parraysetu_arg
+  | Parrayrefs _ -> parrayrefs_arg
+  | Parraysets _ -> parraysets_arg
+  | Pctconst _ -> pctconst_arg
+  | Pisint -> pisint_arg
+  | Pisout -> pisout_arg
+  | Pbintofint _ -> pbintofint_arg
+  | Pintofbint _ -> pintofbint_arg
+  | Pcvtbint _ -> pcvtbint_arg
+  | Pnegbint _ -> pnegbint_arg
+  | Paddbint _ -> paddbint_arg
+  | Psubbint _ -> psubbint_arg
+  | Pmulbint _ -> pmulbint_arg
+  | Pdivbint _ -> pdivbint_arg
+  | Pmodbint _ -> pmodbint_arg
+  | Pandbint _ -> pandbint_arg
+  | Porbint _ -> porbint_arg
+  | Pxorbint _ -> pxorbint_arg
+  | Plslbint _ -> plslbint_arg
+  | Plsrbint _ -> plsrbint_arg
+  | Pasrbint _ -> pasrbint_arg
+  | Pbintcomp _ -> pbintcomp_arg
+  | Pbigarrayref _ -> pbigarrayref_arg
+  | Pbigarrayset _ -> pbigarrayset_arg
+  | Pbigarraydim _ -> pbigarraydim_arg
+  | Pstring_load_16 _ -> pstring_load_16_arg
+  | Pstring_load_32 _ -> pstring_load_32_arg
+  | Pstring_load_64 _ -> pstring_load_64_arg
+  | Pbytes_load_16 _ -> pbytes_load_16_arg
+  | Pbytes_load_32 _ -> pbytes_load_32_arg
+  | Pbytes_load_64 _ -> pbytes_load_64_arg
+  | Pbytes_set_16 _ -> pbytes_set_16_arg
+  | Pbytes_set_32 _ -> pbytes_set_32_arg
+  | Pbytes_set_64 _ -> pbytes_set_64_arg
+  | Pbigstring_load_16 _ -> pbigstring_load_16_arg
+  | Pbigstring_load_32 _ -> pbigstring_load_32_arg
+  | Pbigstring_load_64 _ -> pbigstring_load_64_arg
+  | Pbigstring_set_16 _ -> pbigstring_set_16_arg
+  | Pbigstring_set_32 _ -> pbigstring_set_32_arg
+  | Pbigstring_set_64 _ -> pbigstring_set_64_arg
+  | Pbswap16 -> pbswap16_arg
+  | Pbbswap _ -> pbbswap_arg
+  | Pint_as_pointer -> pint_as_pointer_arg
+  | Popaque -> popaque_arg
diff --git a/middle_end/internal_variable_names.mli b/middle_end/internal_variable_names.mli
new file mode 100644
index 00000000..455ad404
--- /dev/null
+++ b/middle_end/internal_variable_names.mli
@@ -0,0 +1,97 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                     Fu Yong Quah, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+type t = private string
+
+val apply_arg : t
+val apply_funct : t
+val block_symbol : t
+val block_symbol_get : t
+val block_symbol_get_field : t
+val closure : t
+val cond : t
+val cond_sequor : t
+val const_block : t
+val const_bool : t
+val const_boxed_int : t
+val const_char : t
+val const_false : t
+val const_float : t
+val const_int : t
+val const_one : t
+val const_ptr : t
+val const_ptr_one : t
+val const_ptr_zero : t
+val const_sequand : t
+val const_string : t
+val const_true : t
+val const_zero : t
+val denominator : t
+val division_by_zero : t
+val dummy : t
+val dup_func : t
+val dup_set_of_closures : t
+val const_float_array : t
+val fake_effect_symbol : t
+val for_from : t
+val for_to : t
+val from_closure : t
+val full_apply : t
+val get_symbol_field : t
+val const_immstring : t
+val const_int32 : t
+val const_int64 : t
+val ignore : t
+val is_zero : t
+val lifted_let_rec_block : t
+val meth : t
+val module_as_block : t
+val const_nativeint : t
+val new_value : t
+val numerator : t
+val obj : t
+val offsetted : t
+val partial_fun : t
+val pgetglobal : t
+val pointer : t
+val predef_exn : t
+val project_closure : t
+val raise : t
+val raise_arg : t
+val read_mutable : t
+val remove_unused_arguments : t
+val result : t
+val send_arg : t
+val sequence : t
+val set_of_closures : t
+val staticraise_arg : t
+val simplify_fv : t
+val string_switch : t
+val switch : t
+val symbol : t
+val symbol_field : t
+val symbol_field_block : t
+val the_dead_constant : t
+val toplevel_substitution_named : t
+val unbox_free_vars_of_closures : t
+val unit : t
+val zero : t
+
+val of_primitive : Lambda.primitive -> t
+
+val of_primitive_arg : Lambda.primitive -> t
+
+val anon_fn_with_loc : Lambda.scoped_location -> t
diff --git a/middle_end/linkage_name.ml b/middle_end/linkage_name.ml
new file mode 100644
index 00000000..46febfba
--- /dev/null
+++ b/middle_end/linkage_name.ml
@@ -0,0 +1,30 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+type t = string
+
+include Identifiable.Make (struct
+  include String
+  let hash = Hashtbl.hash
+  let print ppf t = Format.pp_print_string ppf t
+  let output chan t = output_string chan t
+end)
+
+let create t = t
+let to_string t = t
diff --git a/middle_end/linkage_name.mli b/middle_end/linkage_name.mli
new file mode 100644
index 00000000..58731917
--- /dev/null
+++ b/middle_end/linkage_name.mli
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+include Identifiable.S
+
+val create : string -> t
+val to_string : t -> string
diff --git a/middle_end/printclambda.ml b/middle_end/printclambda.ml
new file mode 100644
index 00000000..fceb3485
--- /dev/null
+++ b/middle_end/printclambda.ml
@@ -0,0 +1,272 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open Format
+open Asttypes
+open Clambda
+
+module V = Backend_var
+module VP = Backend_var.With_provenance
+
+let mutable_flag = function
+  | Mutable-> "[mut]"
+  | Immutable -> ""
+
+let value_kind =
+  let open Lambda in
+  function
+  | Pgenval -> ""
+  | Pintval -> ":int"
+  | Pfloatval -> ":float"
+  | Pboxedintval Pnativeint -> ":nativeint"
+  | Pboxedintval Pint32 -> ":int32"
+  | Pboxedintval Pint64 -> ":int64"
+
+let rec structured_constant ppf = function
+  | Uconst_float x -> fprintf ppf "%F" x
+  | Uconst_int32 x -> fprintf ppf "%ldl" x
+  | Uconst_int64 x -> fprintf ppf "%LdL" x
+  | Uconst_nativeint x -> fprintf ppf "%ndn" x
+  | Uconst_block (tag, l) ->
+      fprintf ppf "block(%i" tag;
+      List.iter (fun u -> fprintf ppf ",%a" uconstant u) l;
+      fprintf ppf ")"
+  | Uconst_float_array [] ->
+      fprintf ppf "floatarray()"
+  | Uconst_float_array (f1 :: fl) ->
+      fprintf ppf "floatarray(%F" f1;
+      List.iter (fun f -> fprintf ppf ",%F" f) fl;
+      fprintf ppf ")"
+  | Uconst_string s -> fprintf ppf "%S" s
+  | Uconst_closure(clos, sym, fv) ->
+      let funs ppf =
+        List.iter (fprintf ppf "@ %a" one_fun) in
+      let sconsts ppf scl =
+        List.iter (fun sc -> fprintf ppf "@ %a" uconstant sc) scl in
+      fprintf ppf "@[<2>(const_closure%a %s@ %a)@]" funs clos sym sconsts fv
+
+and one_fun ppf f =
+  let idents ppf =
+    List.iter
+      (fun (x, k) ->
+         fprintf ppf "@ %a%a"
+           VP.print x
+           Printlambda.value_kind k
+      )
+  in
+  fprintf ppf "(fun@ %s%s@ %d@ @[<2>%a@]@ @[<2>%a@])"
+    f.label (value_kind f.return) f.arity idents f.params lam f.body
+
+and phantom_defining_expr ppf = function
+  | Uphantom_const const -> uconstant ppf const
+  | Uphantom_var var -> Ident.print ppf var
+  | Uphantom_offset_var { var; offset_in_words; } ->
+    Format.fprintf ppf "%a+(%d)" Backend_var.print var offset_in_words
+  | Uphantom_read_field { var; field; } ->
+    Format.fprintf ppf "%a[%d]" Backend_var.print var field
+  | Uphantom_read_symbol_field { sym; field; } ->
+    Format.fprintf ppf "%s[%d]" sym field
+  | Uphantom_block { tag; fields; } ->
+    Format.fprintf ppf "[%d: " tag;
+    List.iter (fun field ->
+        Format.fprintf ppf "%a; " Backend_var.print field)
+      fields;
+    Format.fprintf ppf "]"
+
+and phantom_defining_expr_opt ppf = function
+  | None -> Format.fprintf ppf "DEAD"
+  | Some expr -> phantom_defining_expr ppf expr
+
+and uconstant ppf = function
+  | Uconst_ref (s, Some c) ->
+      fprintf ppf "%S=%a" s structured_constant c
+  | Uconst_ref (s, None) -> fprintf ppf "%S"s
+  | Uconst_int i -> fprintf ppf "%i" i
+  | Uconst_ptr i -> fprintf ppf "%ia" i
+
+and lam ppf = function
+  | Uvar id ->
+      V.print ppf id
+  | Uconst c -> uconstant ppf c
+  | Udirect_apply(f, largs, _) ->
+      let lams ppf largs =
+        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
+      fprintf ppf "@[<2>(apply*@ %s %a)@]" f lams largs
+  | Ugeneric_apply(lfun, largs, _) ->
+      let lams ppf largs =
+        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
+      fprintf ppf "@[<2>(apply@ %a%a)@]" lam lfun lams largs
+  | Uclosure(clos, fv) ->
+      let funs ppf =
+        List.iter (fprintf ppf "@ @[<2>%a@]" one_fun) in
+      let lams ppf =
+        List.iter (fprintf ppf "@ %a" lam) in
+      fprintf ppf "@[<2>(closure@ %a %a)@]" funs clos lams fv
+  | Uoffset(l,i) -> fprintf ppf "@[<2>(offset %a %d)@]" lam l i
+  | Ulet(mut, kind, id, arg, body) ->
+      let rec letbody ul = match ul with
+        | Ulet(mut, kind, id, arg, body) ->
+            fprintf ppf "@ @[<2>%a%s%s@ %a@]"
+              VP.print id
+              (mutable_flag mut) (value_kind kind) lam arg;
+            letbody body
+        | _ -> ul in
+      fprintf ppf "@[<2>(let@ @[(@[<2>%a%s%s@ %a@]"
+        VP.print id (mutable_flag mut)
+          (value_kind kind) lam arg;
+      let expr = letbody body in
+      fprintf ppf ")@]@ %a)@]" lam expr
+  | Uphantom_let (id, defining_expr, body) ->
+      let rec letbody ul = match ul with
+        | Uphantom_let (id, defining_expr, body) ->
+            fprintf ppf "@ @[<2>%a@ %a@]"
+              Backend_var.With_provenance.print id
+              phantom_defining_expr_opt defining_expr;
+            letbody body
+        | _ -> ul in
+      fprintf ppf "@[<2>(phantom_let@ @[(@[<2>%a@ %a@]"
+        Backend_var.With_provenance.print id
+        phantom_defining_expr_opt defining_expr;
+      let expr = letbody body in
+      fprintf ppf ")@]@ %a)@]" lam expr
+  | Uletrec(id_arg_list, body) ->
+      let bindings ppf id_arg_list =
+        let spc = ref false in
+        List.iter
+          (fun (id, l) ->
+            if !spc then fprintf ppf "@ " else spc := true;
+            fprintf ppf "@[<2>%a@ %a@]"
+              VP.print id
+              lam l)
+          id_arg_list in
+      fprintf ppf
+        "@[<2>(letrec@ (@[%a@])@ %a)@]" bindings id_arg_list lam body
+  | Uprim(prim, largs, _) ->
+      let lams ppf largs =
+        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
+      fprintf ppf "@[<2>(%a%a)@]"
+        Printclambda_primitives.primitive prim lams largs
+  | Uswitch(larg, sw, _dbg) ->
+      let print_case tag index i ppf =
+        for j = 0 to Array.length index - 1 do
+          if index.(j) = i then fprintf ppf "case %s %i:" tag j
+        done in
+      let print_cases tag index cases ppf =
+        for i = 0 to Array.length cases - 1 do
+          fprintf ppf "@ @[<2>%t@ %a@]"
+            (print_case tag index i) sequence cases.(i)
+        done in
+      let switch ppf sw =
+        print_cases "int" sw.us_index_consts sw.us_actions_consts ppf ;
+        print_cases "tag" sw.us_index_blocks sw.us_actions_blocks ppf  in
+      fprintf ppf
+       "@[@[<2>(switch@ %a@ @]%a)@]"
+        lam larg switch sw
+  | Ustringswitch(larg,sw,d) ->
+      let switch ppf sw =
+        let spc = ref false in
+        List.iter
+          (fun (s,l) ->
+            if !spc then fprintf ppf "@ " else spc := true;
+            fprintf ppf "@[case \"%s\":@ %a@]"
+              (String.escaped s) lam l)
+          sw ;
+        begin match d with
+        | Some d ->
+            if !spc then fprintf ppf "@ " else spc := true;
+            fprintf ppf "@[default:@ %a@]" lam d
+        | None -> ()
+        end in
+      fprintf ppf
+        "@[<1>(switch %a@ @[%a@])@]" lam larg switch sw
+  | Ustaticfail (i, ls)  ->
+      let lams ppf largs =
+        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
+      fprintf ppf "@[<2>(exit@ %d%a)@]" i lams ls;
+  | Ucatch(i, vars, lbody, lhandler) ->
+      fprintf ppf "@[<2>(catch@ %a@;<1 -1>with (%d%a)@ %a)@]"
+        lam lbody i
+        (fun ppf vars ->
+           List.iter
+             (fun (x, k) ->
+                fprintf ppf " %a%a"
+                 VP.print x
+                 Printlambda.value_kind k
+             )
+             vars
+        )
+        vars
+        lam lhandler
+  | Utrywith(lbody, param, lhandler) ->
+      fprintf ppf "@[<2>(try@ %a@;<1 -1>with %a@ %a)@]"
+        lam lbody VP.print param lam lhandler
+  | Uifthenelse(lcond, lif, lelse) ->
+      fprintf ppf "@[<2>(if@ %a@ %a@ %a)@]" lam lcond lam lif lam lelse
+  | Usequence(l1, l2) ->
+      fprintf ppf "@[<2>(seq@ %a@ %a)@]" lam l1 sequence l2
+  | Uwhile(lcond, lbody) ->
+      fprintf ppf "@[<2>(while@ %a@ %a)@]" lam lcond lam lbody
+  | Ufor(param, lo, hi, dir, body) ->
+      fprintf ppf "@[<2>(for %a@ %a@ %s@ %a@ %a)@]"
+       VP.print param lam lo
+       (match dir with Upto -> "to" | Downto -> "downto")
+       lam hi lam body
+  | Uassign(id, expr) ->
+      fprintf ppf "@[<2>(assign@ %a@ %a)@]" V.print id lam expr
+  | Usend (k, met, obj, largs, _) ->
+      let args ppf largs =
+        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
+      let kind =
+        if k = Lambda.Self then "self"
+        else if k = Lambda.Cached then "cache"
+        else "" in
+      fprintf ppf "@[<2>(send%s@ %a@ %a%a)@]" kind lam obj lam met args largs
+  | Uunreachable ->
+      fprintf ppf "unreachable"
+
+and sequence ppf ulam = match ulam with
+  | Usequence(l1, l2) ->
+      fprintf ppf "%a@ %a" sequence l1 sequence l2
+  | _ -> lam ppf ulam
+
+let clambda ppf ulam =
+  fprintf ppf "%a@." lam ulam
+
+
+let rec approx ppf = function
+    Value_closure(fundesc, a) ->
+      Format.fprintf ppf "@[<2>function %s@ arity %i"
+        fundesc.fun_label fundesc.fun_arity;
+      if fundesc.fun_closed then begin
+        Format.fprintf ppf "@ (closed)"
+      end;
+      if fundesc.fun_inline <> None then begin
+        Format.fprintf ppf "@ (inline)"
+      end;
+      Format.fprintf ppf "@ -> @ %a@]" approx a
+  | Value_tuple a ->
+      let tuple ppf a =
+        for i = 0 to Array.length a - 1 do
+          if i > 0 then Format.fprintf ppf ";@ ";
+          Format.fprintf ppf "%i: %a" i approx a.(i)
+        done in
+      Format.fprintf ppf "@[(%a)@]" tuple a
+  | Value_unknown ->
+      Format.fprintf ppf "_"
+  | Value_const c ->
+      fprintf ppf "@[const(%a)@]" uconstant c
+  | Value_global_field (s, i) ->
+      fprintf ppf "@[global(%s,%i)@]" s i
diff --git a/middle_end/printclambda.mli b/middle_end/printclambda.mli
new file mode 100644
index 00000000..121667e2
--- /dev/null
+++ b/middle_end/printclambda.mli
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Clambda
+open Format
+
+val clambda: formatter -> ulambda -> unit
+val approx: formatter -> value_approximation -> unit
+val structured_constant: formatter -> ustructured_constant -> unit
+
+val phantom_defining_expr_opt
+   : formatter
+  -> uphantom_defining_expr option
+  -> unit
diff --git a/middle_end/printclambda_primitives.ml b/middle_end/printclambda_primitives.ml
new file mode 100644
index 00000000..2e949891
--- /dev/null
+++ b/middle_end/printclambda_primitives.ml
@@ -0,0 +1,205 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open Format
+open Asttypes
+
+let boxed_integer_name = function
+  | Lambda.Pnativeint -> "nativeint"
+  | Lambda.Pint32 -> "int32"
+  | Lambda.Pint64 -> "int64"
+
+let boxed_integer_mark name = function
+  | Lambda.Pnativeint -> Printf.sprintf "Nativeint.%s" name
+  | Lambda.Pint32 -> Printf.sprintf "Int32.%s" name
+  | Lambda.Pint64 -> Printf.sprintf "Int64.%s" name
+
+let print_boxed_integer name ppf bi =
+  fprintf ppf "%s" (boxed_integer_mark name bi);;
+
+let array_kind array_kind =
+  let open Lambda in
+  match array_kind with
+  | Pgenarray -> "gen"
+  | Paddrarray -> "addr"
+  | Pintarray -> "int"
+  | Pfloatarray -> "float"
+
+let access_size size =
+  let open Clambda_primitives in
+  match size with
+  | Sixteen -> "16"
+  | Thirty_two -> "32"
+  | Sixty_four -> "64"
+
+let access_safety safety =
+  let open Lambda in
+  match safety with
+  | Safe -> ""
+  | Unsafe -> "unsafe_"
+
+let primitive ppf (prim:Clambda_primitives.primitive) =
+  let open Lambda in
+  let open Clambda_primitives in
+  match prim with
+  | Pread_symbol sym ->
+      fprintf ppf "read_symbol %s" sym
+  | Pmakeblock(tag, Immutable, shape) ->
+      fprintf ppf "makeblock %i%a" tag Printlambda.block_shape shape
+  | Pmakeblock(tag, Mutable, shape) ->
+      fprintf ppf "makemutable %i%a" tag Printlambda.block_shape shape
+  | Pfield n -> fprintf ppf "field %i" n
+  | Pfield_computed -> fprintf ppf "field_computed"
+  | Psetfield(n, ptr, init) ->
+      let instr =
+        match ptr with
+        | Pointer -> "ptr"
+        | Immediate -> "imm"
+      in
+      let init =
+        match init with
+        | Heap_initialization -> "(heap-init)"
+        | Root_initialization -> "(root-init)"
+        | Assignment -> ""
+      in
+      fprintf ppf "setfield_%s%s %i" instr init n
+  | Psetfield_computed (ptr, init) ->
+      let instr =
+        match ptr with
+        | Pointer -> "ptr"
+        | Immediate -> "imm"
+      in
+      let init =
+        match init with
+        | Heap_initialization -> "(heap-init)"
+        | Root_initialization -> "(root-init)"
+        | Assignment -> ""
+      in
+      fprintf ppf "setfield_%s%s_computed" instr init
+  | Pfloatfield n -> fprintf ppf "floatfield %i" n
+  | Psetfloatfield (n, init) ->
+      let init =
+        match init with
+        | Heap_initialization -> "(heap-init)"
+        | Root_initialization -> "(root-init)"
+        | Assignment -> ""
+      in
+      fprintf ppf "setfloatfield%s %i" init n
+  | Pduprecord (rep, size) ->
+      fprintf ppf "duprecord %a %i" Printlambda.record_rep rep size
+  | Pccall p -> fprintf ppf "%s" p.Primitive.prim_name
+  | Praise k -> fprintf ppf "%s" (Lambda.raise_kind k)
+  | Psequand -> fprintf ppf "&&"
+  | Psequor -> fprintf ppf "||"
+  | Pnot -> fprintf ppf "not"
+  | Pnegint -> fprintf ppf "~"
+  | Paddint -> fprintf ppf "+"
+  | Psubint -> fprintf ppf "-"
+  | Pmulint -> fprintf ppf "*"
+  | Pdivint Safe -> fprintf ppf "/"
+  | Pdivint Unsafe -> fprintf ppf "/u"
+  | Pmodint Safe -> fprintf ppf "mod"
+  | Pmodint Unsafe -> fprintf ppf "mod_unsafe"
+  | Pandint -> fprintf ppf "and"
+  | Porint -> fprintf ppf "or"
+  | Pxorint -> fprintf ppf "xor"
+  | Plslint -> fprintf ppf "lsl"
+  | Plsrint -> fprintf ppf "lsr"
+  | Pasrint -> fprintf ppf "asr"
+  | Pintcomp(cmp) -> Printlambda.integer_comparison ppf cmp
+  | Pcompare_ints -> fprintf ppf "compare_ints"
+  | Pcompare_floats -> fprintf ppf "compare_floats"
+  | Pcompare_bints bi -> fprintf ppf "compare_bints %s" (boxed_integer_name bi)
+  | Poffsetint n -> fprintf ppf "%i+" n
+  | Poffsetref n -> fprintf ppf "+:=%i"n
+  | Pintoffloat -> fprintf ppf "int_of_float"
+  | Pfloatofint -> fprintf ppf "float_of_int"
+  | Pnegfloat -> fprintf ppf "~."
+  | Pabsfloat -> fprintf ppf "abs."
+  | Paddfloat -> fprintf ppf "+."
+  | Psubfloat -> fprintf ppf "-."
+  | Pmulfloat -> fprintf ppf "*."
+  | Pdivfloat -> fprintf ppf "/."
+  | Pfloatcomp(cmp) -> Printlambda.float_comparison ppf cmp
+  | Pstringlength -> fprintf ppf "string.length"
+  | Pstringrefu -> fprintf ppf "string.unsafe_get"
+  | Pstringrefs -> fprintf ppf "string.get"
+  | Pbyteslength -> fprintf ppf "bytes.length"
+  | Pbytesrefu -> fprintf ppf "bytes.unsafe_get"
+  | Pbytessetu -> fprintf ppf "bytes.unsafe_set"
+  | Pbytesrefs -> fprintf ppf "bytes.get"
+  | Pbytessets -> fprintf ppf "bytes.set"
+
+  | Parraylength k -> fprintf ppf "array.length[%s]" (array_kind k)
+  | Pmakearray (k, Mutable) -> fprintf ppf "makearray[%s]" (array_kind k)
+  | Pmakearray (k, Immutable) -> fprintf ppf "makearray_imm[%s]" (array_kind k)
+  | Pduparray (k, Mutable) -> fprintf ppf "duparray[%s]" (array_kind k)
+  | Pduparray (k, Immutable) -> fprintf ppf "duparray_imm[%s]" (array_kind k)
+  | Parrayrefu k -> fprintf ppf "array.unsafe_get[%s]" (array_kind k)
+  | Parraysetu k -> fprintf ppf "array.unsafe_set[%s]" (array_kind k)
+  | Parrayrefs k -> fprintf ppf "array.get[%s]" (array_kind k)
+  | Parraysets k -> fprintf ppf "array.set[%s]" (array_kind k)
+  | Pisint -> fprintf ppf "isint"
+  | Pisout -> fprintf ppf "isout"
+  | Pbintofint bi -> print_boxed_integer "of_int" ppf bi
+  | Pintofbint bi -> print_boxed_integer "to_int" ppf bi
+  | Pcvtbint (bi1, bi2) ->
+      fprintf ppf "%s_of_%s" (boxed_integer_name bi2) (boxed_integer_name bi1)
+  | Pnegbint bi -> print_boxed_integer "neg" ppf bi
+  | Paddbint bi -> print_boxed_integer "add" ppf bi
+  | Psubbint bi -> print_boxed_integer "sub" ppf bi
+  | Pmulbint bi -> print_boxed_integer "mul" ppf bi
+  | Pdivbint { size = bi; is_safe = Safe } ->
+      print_boxed_integer "div" ppf bi
+  | Pdivbint { size = bi; is_safe = Unsafe } ->
+      print_boxed_integer "div_unsafe" ppf bi
+  | Pmodbint { size = bi; is_safe = Safe } ->
+      print_boxed_integer "mod" ppf bi
+  | Pmodbint { size = bi; is_safe = Unsafe } ->
+      print_boxed_integer "mod_unsafe" ppf bi
+  | Pandbint bi -> print_boxed_integer "and" ppf bi
+  | Porbint bi -> print_boxed_integer "or" ppf bi
+  | Pxorbint bi -> print_boxed_integer "xor" ppf bi
+  | Plslbint bi -> print_boxed_integer "lsl" ppf bi
+  | Plsrbint bi -> print_boxed_integer "lsr" ppf bi
+  | Pasrbint bi -> print_boxed_integer "asr" ppf bi
+  | Pbintcomp(bi, Ceq) -> print_boxed_integer "==" ppf bi
+  | Pbintcomp(bi, Cne) -> print_boxed_integer "!=" ppf bi
+  | Pbintcomp(bi, Clt) -> print_boxed_integer "<" ppf bi
+  | Pbintcomp(bi, Cgt) -> print_boxed_integer ">" ppf bi
+  | Pbintcomp(bi, Cle) -> print_boxed_integer "<=" ppf bi
+  | Pbintcomp(bi, Cge) -> print_boxed_integer ">=" ppf bi
+  | Pbigarrayref(unsafe, _n, kind, layout) ->
+      Printlambda.print_bigarray "get" unsafe kind ppf layout
+  | Pbigarrayset(unsafe, _n, kind, layout) ->
+      Printlambda.print_bigarray "set" unsafe kind ppf layout
+  | Pbigarraydim(n) -> fprintf ppf "Bigarray.dim_%i" n
+  | Pstring_load(size, safety) ->
+      fprintf ppf "string.%sget%s" (access_safety safety) (access_size size)
+  | Pbytes_load(size, safety) ->
+      fprintf ppf "bytes.%sget%s" (access_safety safety) (access_size size)
+  | Pbytes_set(size, safety) ->
+      fprintf ppf "bytes.%sset%s" (access_safety safety) (access_size size)
+  | Pbigstring_load(size, safety) ->
+      fprintf ppf "bigarray.array1.%sget%s"
+        (access_safety safety) (access_size size)
+  | Pbigstring_set(size, safety) ->
+      fprintf ppf "bigarray.array1.%sset%s"
+        (access_safety safety) (access_size size)
+  | Pbswap16 -> fprintf ppf "bswap16"
+  | Pbbswap(bi) -> print_boxed_integer "bswap" ppf bi
+  | Pint_as_pointer -> fprintf ppf "int_as_pointer"
+  | Popaque -> fprintf ppf "opaque"
diff --git a/middle_end/printclambda_primitives.mli b/middle_end/printclambda_primitives.mli
new file mode 100644
index 00000000..07db5a1c
--- /dev/null
+++ b/middle_end/printclambda_primitives.mli
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Format
+
+val primitive: formatter -> Clambda_primitives.primitive -> unit
diff --git a/middle_end/semantics_of_primitives.ml b/middle_end/semantics_of_primitives.ml
new file mode 100644
index 00000000..47ed8c3e
--- /dev/null
+++ b/middle_end/semantics_of_primitives.ml
@@ -0,0 +1,155 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+type effects = No_effects | Only_generative_effects | Arbitrary_effects
+type coeffects = No_coeffects | Has_coeffects
+
+let for_primitive (prim : Clambda_primitives.primitive) =
+  match prim with
+  | Pmakeblock _
+  | Pmakearray (_, Mutable) -> Only_generative_effects, No_coeffects
+  | Pmakearray (_, Immutable) -> No_effects, No_coeffects
+  | Pduparray (_, Immutable) ->
+      No_effects, No_coeffects  (* Pduparray (_, Immutable) is allowed only on
+                                   immutable arrays. *)
+  | Pduparray (_, Mutable) | Pduprecord _ ->
+      Only_generative_effects, Has_coeffects
+  | Pccall { prim_name =
+               ( "caml_format_float" | "caml_format_int" | "caml_int32_format"
+               | "caml_nativeint_format" | "caml_int64_format" ) } ->
+      No_effects, No_coeffects
+  | Pccall _ -> Arbitrary_effects, Has_coeffects
+  | Praise _ -> Arbitrary_effects, No_coeffects
+  | Pnot
+  | Pnegint
+  | Paddint
+  | Psubint
+  | Pmulint
+  | Pandint
+  | Porint
+  | Pxorint
+  | Plslint
+  | Plsrint
+  | Pasrint
+  | Pintcomp _ -> No_effects, No_coeffects
+  | Pcompare_ints | Pcompare_floats | Pcompare_bints _
+    -> No_effects, No_coeffects
+  | Pdivbint { is_safe = Unsafe }
+  | Pmodbint { is_safe = Unsafe }
+  | Pdivint Unsafe
+  | Pmodint Unsafe ->
+      No_effects, No_coeffects  (* Will not raise [Division_by_zero]. *)
+  | Pdivbint { is_safe = Safe }
+  | Pmodbint { is_safe = Safe }
+  | Pdivint Safe
+  | Pmodint Safe ->
+      Arbitrary_effects, No_coeffects
+  | Poffsetint _ -> No_effects, No_coeffects
+  | Poffsetref _ -> Arbitrary_effects, Has_coeffects
+  | Pintoffloat
+  | Pfloatofint
+  | Pnegfloat
+  | Pabsfloat
+  | Paddfloat
+  | Psubfloat
+  | Pmulfloat
+  | Pdivfloat
+  | Pfloatcomp _ -> No_effects, No_coeffects
+  | Pstringlength | Pbyteslength
+  | Parraylength _ ->
+      No_effects, Has_coeffects  (* That old chestnut: [Obj.truncate]. *)
+  | Pisint
+  | Pisout
+  | Pbintofint _
+  | Pintofbint _
+  | Pcvtbint _
+  | Pnegbint _
+  | Paddbint _
+  | Psubbint _
+  | Pmulbint _
+  | Pandbint _
+  | Porbint _
+  | Pxorbint _
+  | Plslbint _
+  | Plsrbint _
+  | Pasrbint _
+  | Pbintcomp _ -> No_effects, No_coeffects
+  | Pbigarraydim _ ->
+      No_effects, Has_coeffects  (* Some people resize bigarrays in place. *)
+  | Pread_symbol _
+  | Pfield _
+  | Pfield_computed
+  | Pfloatfield _
+  | Parrayrefu _
+  | Pstringrefu
+  | Pbytesrefu
+  | Pstring_load (_, Unsafe)
+  | Pbytes_load (_, Unsafe)
+  | Pbigarrayref (true, _, _, _)
+  | Pbigstring_load (_, Unsafe) ->
+      No_effects, Has_coeffects
+  | Parrayrefs _
+  | Pstringrefs
+  | Pbytesrefs
+  | Pstring_load (_, Safe)
+  | Pbytes_load (_, Safe)
+  | Pbigarrayref (false, _, _, _)
+  | Pbigstring_load (_, Safe) ->
+      (* May trigger a bounds check exception. *)
+      Arbitrary_effects, Has_coeffects
+  | Psetfield _
+  | Psetfield_computed _
+  | Psetfloatfield _
+  | Parraysetu _
+  | Parraysets _
+  | Pbytessetu
+  | Pbytessets
+  | Pbytes_set _
+  | Pbigarrayset _
+  | Pbigstring_set _ ->
+      (* Whether or not some of these are "unsafe" is irrelevant; they always
+         have an effect. *)
+      Arbitrary_effects, No_coeffects
+  | Pbswap16
+  | Pbbswap _ -> No_effects, No_coeffects
+  | Pint_as_pointer -> No_effects, No_coeffects
+  | Popaque -> Arbitrary_effects, Has_coeffects
+  | Psequand
+  | Psequor ->
+      (* Removed by [Closure_conversion] in the flambda pipeline. *)
+      No_effects, No_coeffects
+
+type return_type =
+  | Float
+  | Other
+
+let return_type_of_primitive (prim:Clambda_primitives.primitive) =
+  match prim with
+  | Pfloatofint
+  | Pnegfloat
+  | Pabsfloat
+  | Paddfloat
+  | Psubfloat
+  | Pmulfloat
+  | Pdivfloat
+  | Pfloatfield _
+  | Parrayrefu Pfloatarray
+  | Parrayrefs Pfloatarray ->
+      Float
+  | _ ->
+      Other
diff --git a/middle_end/semantics_of_primitives.mli b/middle_end/semantics_of_primitives.mli
new file mode 100644
index 00000000..78407df7
--- /dev/null
+++ b/middle_end/semantics_of_primitives.mli
@@ -0,0 +1,69 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** Description of the semantics of primitives, to be used for optimization
+    purposes.
+
+    "No effects" means that the primitive does not change the observable state
+    of the world.  For example, it must not write to any mutable storage,
+    call arbitrary external functions or change control flow (e.g. by raising
+    an exception).  Note that allocation is not "No effects" (see below).
+
+    It is assumed in the compiler that applications of primitives with no
+    effects, whose results are not used, may be eliminated.  It is further
+    assumed that applications of primitives with no effects may be
+    duplicated (and thus possibly executed more than once).
+
+    (Exceptions arising from allocation points, for example "out of memory" or
+    exceptions propagated from finalizers or signal handlers, are treated as
+    "effects out of the ether" and thus ignored for our determination here
+    of effectfulness.  The same goes for floating point operations that may
+    cause hardware traps on some platforms.)
+
+    "Only generative effects" means that a primitive does not change the
+    observable state of the world save for possibly affecting the state of
+    the garbage collector by performing an allocation.  Applications of
+    primitives that only have generative effects and whose results are unused
+    may be eliminated by the compiler.  However, unlike "No effects"
+    primitives, such applications will never be eligible for duplication.
+
+    "Arbitrary effects" covers all other primitives.
+
+    "No coeffects" means that the primitive does not observe the effects (in
+    the sense described above) of other expressions.  For example, it must not
+    read from any mutable storage or call arbitrary external functions.
+
+    It is assumed in the compiler that, subject to data dependencies,
+    expressions with neither effects nor coeffects may be reordered with
+    respect to other expressions.
+*)
+
+type effects = No_effects | Only_generative_effects | Arbitrary_effects
+type coeffects = No_coeffects | Has_coeffects
+
+(** Describe the semantics of a primitive.  This does not take into account of
+    the (non-)(co)effectfulness of the arguments in a primitive application.
+    To determine whether such an application is (co)effectful, the arguments
+    must also be analysed. *)
+val for_primitive: Clambda_primitives.primitive -> effects * coeffects
+
+type return_type =
+  | Float
+  | Other
+
+val return_type_of_primitive: Clambda_primitives.primitive -> return_type
diff --git a/middle_end/symbol.ml b/middle_end/symbol.ml
new file mode 100644
index 00000000..22a2e0a7
--- /dev/null
+++ b/middle_end/symbol.ml
@@ -0,0 +1,105 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+
+type t =
+  | Linkage of
+      { compilation_unit : Compilation_unit.t;
+        label : Linkage_name.t;
+        hash : int; }
+  | Variable of
+      { compilation_unit : Compilation_unit.t;
+        variable : Variable.t; }
+
+let label t =
+  match t with
+  | Linkage { label; _ } -> label
+  | Variable { variable; _ } ->
+      (* Use the variable's compilation unit for the label, since the
+         symbol's compilation unit might be a pack *)
+      let compilation_unit = Variable.get_compilation_unit variable in
+      let unit_linkage_name =
+        Linkage_name.to_string
+          (Compilation_unit.get_linkage_name compilation_unit)
+      in
+      let label = unit_linkage_name ^ "__" ^ Variable.unique_name variable in
+      Linkage_name.create label
+
+include Identifiable.Make (struct
+
+  type nonrec t = t
+
+  let compare t1 t2 =
+    if t1 == t2 then 0
+    else begin
+      match t1, t2 with
+      | Linkage _, Variable _ -> 1
+      | Variable _, Linkage _ -> -1
+      | Linkage l1, Linkage l2 ->
+        let c = compare l1.hash l2.hash in
+        if c <> 0 then c else begin
+          (* Linkage names are unique across a whole project, so just comparing
+             those is sufficient. *)
+          Linkage_name.compare l1.label l2.label
+        end
+      | Variable v1, Variable v2 ->
+        Variable.compare v1.variable v2.variable
+    end
+
+  let equal x y =
+    if x == y then true
+    else compare x y = 0
+
+  let output chan t =
+    Linkage_name.output chan (label t)
+
+  let hash t =
+    match t with
+    | Linkage { hash; _ } -> hash
+    | Variable { variable } -> Variable.hash variable
+
+  let print ppf t =
+    Linkage_name.print ppf (label t)
+
+end)
+
+let of_global_linkage compilation_unit label =
+  let hash = Linkage_name.hash label in
+  Linkage { compilation_unit; hash; label }
+
+let of_variable variable =
+  let compilation_unit = Variable.get_compilation_unit variable in
+  Variable { variable; compilation_unit }
+
+let import_for_pack ~pack:compilation_unit symbol =
+  match symbol with
+  | Linkage l -> Linkage { l with compilation_unit }
+  | Variable v -> Variable { v with compilation_unit }
+
+let compilation_unit t =
+  match t with
+  | Linkage { compilation_unit; _ } -> compilation_unit
+  | Variable { compilation_unit; _ } -> compilation_unit
+
+let print_opt ppf = function
+  | None -> Format.fprintf ppf ""
+  | Some t -> print ppf t
+
+let compare_lists l1 l2 =
+  Misc.Stdlib.List.compare compare l1 l2
diff --git a/middle_end/symbol.mli b/middle_end/symbol.mli
new file mode 100644
index 00000000..d2771af2
--- /dev/null
+++ b/middle_end/symbol.mli
@@ -0,0 +1,44 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** A symbol identifies a constant provided by either:
+    - another compilation unit; or
+    - a top-level module.
+
+    * [sym_unit] is the compilation unit containing the value.
+    * [sym_label] is the linkage name of the variable.
+
+    The label must be globally unique: two compilation units linked in the
+    same program must not share labels. *)
+
+include Identifiable.S
+
+val of_variable : Variable.t -> t
+
+(* Create the symbol without prefixing with the compilation unit.
+   Used for global symbols like predefined exceptions *)
+val of_global_linkage : Compilation_unit.t -> Linkage_name.t -> t
+
+val import_for_pack : pack:Compilation_unit.t -> t -> t
+
+val compilation_unit : t -> Compilation_unit.t
+val label : t -> Linkage_name.t
+
+val print_opt : Format.formatter -> t option -> unit
+
+val compare_lists : t list -> t list -> int
diff --git a/middle_end/variable.ml b/middle_end/variable.ml
new file mode 100644
index 00000000..64099a73
--- /dev/null
+++ b/middle_end/variable.ml
@@ -0,0 +1,119 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
+open! Int_replace_polymorphic_compare
+
+type t = {
+  compilation_unit : Compilation_unit.t;
+  name : string;
+  name_stamp : int;
+  (** [name_stamp]s are unique within any given compilation unit. *)
+}
+
+include Identifiable.Make (struct
+  type nonrec t = t
+
+  let compare t1 t2 =
+    if t1 == t2 then 0
+    else
+      let c = t1.name_stamp - t2.name_stamp in
+      if c <> 0 then c
+      else Compilation_unit.compare t1.compilation_unit t2.compilation_unit
+
+  let equal t1 t2 =
+    if t1 == t2 then true
+    else
+      t1.name_stamp = t2.name_stamp
+        && Compilation_unit.equal t1.compilation_unit t2.compilation_unit
+
+  let output chan t =
+    output_string chan t.name;
+    output_string chan "_";
+    output_string chan (Int.to_string t.name_stamp)
+
+  let hash t = t.name_stamp lxor (Compilation_unit.hash t.compilation_unit)
+
+  let print ppf t =
+    if Compilation_unit.equal t.compilation_unit
+        (Compilation_unit.get_current_exn ())
+    then begin
+      Format.fprintf ppf "%s/%d"
+        t.name t.name_stamp
+    end else begin
+      Format.fprintf ppf "%a.%s/%d"
+        Compilation_unit.print t.compilation_unit
+        t.name t.name_stamp
+    end
+end)
+
+let previous_name_stamp = ref (-1)
+
+let create_with_name_string ?current_compilation_unit name =
+  let compilation_unit =
+    match current_compilation_unit with
+    | Some compilation_unit -> compilation_unit
+    | None -> Compilation_unit.get_current_exn ()
+  in
+  let name_stamp =
+    incr previous_name_stamp;
+    !previous_name_stamp
+  in
+  { compilation_unit;
+    name;
+    name_stamp;
+  }
+
+let create ?current_compilation_unit name =
+  let name = (name : Internal_variable_names.t :> string) in
+  create_with_name_string ?current_compilation_unit name
+
+let create_with_same_name_as_ident ident =
+  create_with_name_string (Ident.name ident)
+
+let rename ?current_compilation_unit t =
+  create_with_name_string ?current_compilation_unit t.name
+
+let in_compilation_unit t cu =
+  Compilation_unit.equal cu t.compilation_unit
+
+let get_compilation_unit t = t.compilation_unit
+
+let name t = t.name
+
+let unique_name t =
+  t.name ^ "_" ^ (Int.to_string t.name_stamp)
+
+let print_list ppf ts =
+  List.iter (fun t -> Format.fprintf ppf "@ %a" print t) ts
+
+let debug_when_stamp_matches t ~stamp ~f =
+  if t.name_stamp = stamp then f ()
+
+let print_opt ppf = function
+  | None -> Format.fprintf ppf ""
+  | Some t -> print ppf t
+
+type pair = t * t
+module Pair = Identifiable.Make (Identifiable.Pair (T) (T))
+
+let compare_lists l1 l2 =
+  Misc.Stdlib.List.compare compare l1 l2
+
+let output_full chan t =
+  Compilation_unit.output chan t.compilation_unit;
+  output_string chan ".";
+  output chan t
diff --git a/middle_end/variable.mli b/middle_end/variable.mli
new file mode 100644
index 00000000..b5d3f136
--- /dev/null
+++ b/middle_end/variable.mli
@@ -0,0 +1,63 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-9-30-40-41-42"]
+
+(** [Variable.t] is the equivalent of a non-persistent [Ident.t] in
+    the [Flambda] tree.  It wraps an [Ident.t] together with its source
+    [compilation_unit].  As such, it is unique within a whole program,
+    not just one compilation unit.
+
+    Introducing a new type helps in tracing the source of identifiers
+    when debugging the inliner.  It also avoids Ident renaming when
+    importing cmx files.
+*)
+
+include Identifiable.S
+
+val create
+   : ?current_compilation_unit:Compilation_unit.t
+  -> Internal_variable_names.t
+  -> t
+val create_with_same_name_as_ident : Ident.t -> t
+
+val rename
+   : ?current_compilation_unit:Compilation_unit.t
+  -> t
+  -> t
+
+val in_compilation_unit : t -> Compilation_unit.t -> bool
+
+val name : t -> string
+
+val unique_name : t -> string
+
+val get_compilation_unit : t -> Compilation_unit.t
+
+val print_list : Format.formatter -> t list -> unit
+val print_opt : Format.formatter -> t option -> unit
+
+(** If the given variable has the given stamp, call the user-supplied
+    function.  For debugging purposes only. *)
+val debug_when_stamp_matches : t -> stamp:int -> f:(unit -> unit) -> unit
+
+type pair = t * t
+module Pair : Identifiable.S with type t := pair
+
+val compare_lists : t list -> t list -> int
+
+val output_full : out_channel -> t -> unit
+(** Unlike [output], [output_full] includes the compilation unit. *)
diff --git a/ocaml-variants.opam b/ocaml-variants.opam
new file mode 100644
index 00000000..f6b0abc8
--- /dev/null
+++ b/ocaml-variants.opam
@@ -0,0 +1,28 @@
+opam-version: "2.0"
+version: "4.11.1"
+synopsis: "OCaml 4.11.1, official release"
+depends: [
+  "ocaml" {= "4.11.1" & post}
+  "base-unix" {post}
+  "base-bigarray" {post}
+  "base-threads" {post}
+]
+conflict-class: "ocaml-core-compiler"
+flags: compiler
+setenv: CAML_LD_LIBRARY_PATH = "%{lib}%/stublibs"
+build: [
+  ["./configure" "--prefix=%{prefix}%"]
+  [make "-j%{jobs}%"]
+]
+install: [make "install"]
+maintainer: "caml-list@inria.fr"
+homepage: "https://github.com/ocaml/ocaml/"
+bug-reports: "https://github.com/ocaml/ocaml/issues"
+authors: [
+  "Xavier Leroy"
+  "Damien Doligez"
+  "Alain Frisch"
+  "Jacques Garrigue"
+  "Didier Rémy"
+  "Jérôme Vouillon"
+]
diff --git a/ocamldoc/.depend b/ocamldoc/.depend
new file mode 100644
index 00000000..4bc98ad3
--- /dev/null
+++ b/ocamldoc/.depend
@@ -0,0 +1,863 @@
+odoc.cmo : \
+    odoc_messages.cmo \
+    odoc_info.cmi \
+    odoc_global.cmi \
+    odoc_gen.cmi \
+    odoc_config.cmi \
+    odoc_args.cmi \
+    odoc_analyse.cmi
+odoc.cmx : \
+    odoc_messages.cmx \
+    odoc_info.cmx \
+    odoc_global.cmx \
+    odoc_gen.cmx \
+    odoc_config.cmx \
+    odoc_args.cmx \
+    odoc_analyse.cmx
+odoc_analyse.cmo : \
+    ../utils/warnings.cmi \
+    ../typing/types.cmi \
+    ../typing/typemod.cmi \
+    ../typing/typedtree.cmi \
+    ../parsing/syntaxerr.cmi \
+    ../driver/pparse.cmi \
+    ../parsing/parse.cmi \
+    odoc_types.cmi \
+    odoc_text.cmi \
+    odoc_sig.cmi \
+    odoc_module.cmo \
+    odoc_misc.cmi \
+    odoc_messages.cmo \
+    odoc_merge.cmi \
+    odoc_global.cmi \
+    odoc_dep.cmo \
+    odoc_cross.cmi \
+    odoc_comments.cmi \
+    odoc_class.cmo \
+    odoc_ast.cmi \
+    ../parsing/location.cmi \
+    ../parsing/lexer.cmi \
+    ../typing/env.cmi \
+    ../utils/config.cmi \
+    ../driver/compmisc.cmi \
+    ../utils/clflags.cmi \
+    odoc_analyse.cmi
+odoc_analyse.cmx : \
+    ../utils/warnings.cmx \
+    ../typing/types.cmx \
+    ../typing/typemod.cmx \
+    ../typing/typedtree.cmx \
+    ../parsing/syntaxerr.cmx \
+    ../driver/pparse.cmx \
+    ../parsing/parse.cmx \
+    odoc_types.cmx \
+    odoc_text.cmx \
+    odoc_sig.cmx \
+    odoc_module.cmx \
+    odoc_misc.cmx \
+    odoc_messages.cmx \
+    odoc_merge.cmx \
+    odoc_global.cmx \
+    odoc_dep.cmx \
+    odoc_cross.cmx \
+    odoc_comments.cmx \
+    odoc_class.cmx \
+    odoc_ast.cmx \
+    ../parsing/location.cmx \
+    ../parsing/lexer.cmx \
+    ../typing/env.cmx \
+    ../utils/config.cmx \
+    ../driver/compmisc.cmx \
+    ../utils/clflags.cmx \
+    odoc_analyse.cmi
+odoc_analyse.cmi : \
+    odoc_module.cmo \
+    odoc_global.cmi
+odoc_args.cmo : \
+    odoc_types.cmi \
+    odoc_texi.cmo \
+    odoc_messages.cmo \
+    odoc_man.cmo \
+    odoc_latex.cmo \
+    odoc_html.cmo \
+    odoc_global.cmi \
+    odoc_gen.cmi \
+    odoc_dot.cmo \
+    odoc_config.cmi \
+    ../driver/main_args.cmi \
+    ../utils/config.cmi \
+    odoc_args.cmi
+odoc_args.cmx : \
+    odoc_types.cmx \
+    odoc_texi.cmx \
+    odoc_messages.cmx \
+    odoc_man.cmx \
+    odoc_latex.cmx \
+    odoc_html.cmx \
+    odoc_global.cmx \
+    odoc_gen.cmx \
+    odoc_dot.cmx \
+    odoc_config.cmx \
+    ../driver/main_args.cmx \
+    ../utils/config.cmx \
+    odoc_args.cmi
+odoc_args.cmi : \
+    odoc_gen.cmi
+odoc_ast.cmo : \
+    ../typing/types.cmi \
+    ../typing/typedtree.cmi \
+    ../typing/predef.cmi \
+    ../typing/path.cmi \
+    ../parsing/parsetree.cmi \
+    odoc_value.cmo \
+    odoc_types.cmi \
+    odoc_type.cmo \
+    odoc_sig.cmi \
+    odoc_parameter.cmo \
+    odoc_module.cmo \
+    odoc_messages.cmo \
+    odoc_global.cmi \
+    odoc_extension.cmo \
+    odoc_exception.cmo \
+    odoc_env.cmi \
+    odoc_class.cmo \
+    ../parsing/location.cmi \
+    ../typing/ident.cmi \
+    ../parsing/asttypes.cmi \
+    odoc_ast.cmi
+odoc_ast.cmx : \
+    ../typing/types.cmx \
+    ../typing/typedtree.cmx \
+    ../typing/predef.cmx \
+    ../typing/path.cmx \
+    ../parsing/parsetree.cmi \
+    odoc_value.cmx \
+    odoc_types.cmx \
+    odoc_type.cmx \
+    odoc_sig.cmx \
+    odoc_parameter.cmx \
+    odoc_module.cmx \
+    odoc_messages.cmx \
+    odoc_global.cmx \
+    odoc_extension.cmx \
+    odoc_exception.cmx \
+    odoc_env.cmx \
+    odoc_class.cmx \
+    ../parsing/location.cmx \
+    ../typing/ident.cmx \
+    ../parsing/asttypes.cmi \
+    odoc_ast.cmi
+odoc_ast.cmi : \
+    ../typing/types.cmi \
+    ../typing/typedtree.cmi \
+    ../parsing/parsetree.cmi \
+    odoc_sig.cmi \
+    odoc_name.cmi \
+    odoc_module.cmo
+odoc_class.cmo : \
+    ../typing/types.cmi \
+    odoc_value.cmo \
+    odoc_types.cmi \
+    odoc_parameter.cmo \
+    odoc_name.cmi
+odoc_class.cmx : \
+    ../typing/types.cmx \
+    odoc_value.cmx \
+    odoc_types.cmx \
+    odoc_parameter.cmx \
+    odoc_name.cmx
+odoc_comments.cmo : \
+    odoc_types.cmi \
+    odoc_text.cmi \
+    odoc_see_lexer.cmo \
+    odoc_parser.cmi \
+    odoc_misc.cmi \
+    odoc_messages.cmo \
+    odoc_merge.cmi \
+    odoc_lexer.cmo \
+    odoc_global.cmi \
+    odoc_cross.cmi \
+    odoc_comments_global.cmi \
+    odoc_comments.cmi
+odoc_comments.cmx : \
+    odoc_types.cmx \
+    odoc_text.cmx \
+    odoc_see_lexer.cmx \
+    odoc_parser.cmx \
+    odoc_misc.cmx \
+    odoc_messages.cmx \
+    odoc_merge.cmx \
+    odoc_lexer.cmx \
+    odoc_global.cmx \
+    odoc_cross.cmx \
+    odoc_comments_global.cmx \
+    odoc_comments.cmi
+odoc_comments.cmi : \
+    odoc_types.cmi \
+    odoc_module.cmo
+odoc_comments_global.cmo : \
+    odoc_comments_global.cmi
+odoc_comments_global.cmx : \
+    odoc_comments_global.cmi
+odoc_comments_global.cmi :
+odoc_config.cmo : \
+    ../utils/config.cmi \
+    odoc_config.cmi
+odoc_config.cmx : \
+    ../utils/config.cmx \
+    odoc_config.cmi
+odoc_config.cmi :
+odoc_control.cmo :
+odoc_control.cmx :
+odoc_cross.cmo : \
+    odoc_value.cmo \
+    odoc_types.cmi \
+    odoc_type.cmo \
+    odoc_search.cmi \
+    odoc_scan.cmo \
+    odoc_parameter.cmo \
+    odoc_name.cmi \
+    odoc_module.cmo \
+    odoc_misc.cmi \
+    odoc_messages.cmo \
+    odoc_global.cmi \
+    odoc_extension.cmo \
+    odoc_exception.cmo \
+    odoc_class.cmo \
+    ../utils/misc.cmi \
+    odoc_cross.cmi
+odoc_cross.cmx : \
+    odoc_value.cmx \
+    odoc_types.cmx \
+    odoc_type.cmx \
+    odoc_search.cmx \
+    odoc_scan.cmx \
+    odoc_parameter.cmx \
+    odoc_name.cmx \
+    odoc_module.cmx \
+    odoc_misc.cmx \
+    odoc_messages.cmx \
+    odoc_global.cmx \
+    odoc_extension.cmx \
+    odoc_exception.cmx \
+    odoc_class.cmx \
+    ../utils/misc.cmx \
+    odoc_cross.cmi
+odoc_cross.cmi : \
+    odoc_types.cmi \
+    odoc_module.cmo
+odoc_dag2html.cmo : \
+    odoc_info.cmi \
+    odoc_dag2html.cmi
+odoc_dag2html.cmx : \
+    odoc_info.cmx \
+    odoc_dag2html.cmi
+odoc_dag2html.cmi : \
+    odoc_info.cmi
+odoc_dep.cmo : \
+    ../parsing/parsetree.cmi \
+    odoc_type.cmo \
+    odoc_print.cmi \
+    odoc_module.cmo \
+    ../utils/misc.cmi \
+    ../parsing/depend.cmi
+odoc_dep.cmx : \
+    ../parsing/parsetree.cmi \
+    odoc_type.cmx \
+    odoc_print.cmx \
+    odoc_module.cmx \
+    ../utils/misc.cmx \
+    ../parsing/depend.cmx
+odoc_dot.cmo : \
+    odoc_messages.cmo \
+    odoc_info.cmi
+odoc_dot.cmx : \
+    odoc_messages.cmx \
+    odoc_info.cmx
+odoc_env.cmo : \
+    ../typing/types.cmi \
+    ../typing/printtyp.cmi \
+    ../typing/predef.cmi \
+    ../typing/path.cmi \
+    odoc_name.cmi \
+    ../typing/btype.cmi \
+    odoc_env.cmi
+odoc_env.cmx : \
+    ../typing/types.cmx \
+    ../typing/printtyp.cmx \
+    ../typing/predef.cmx \
+    ../typing/path.cmx \
+    odoc_name.cmx \
+    ../typing/btype.cmx \
+    odoc_env.cmi
+odoc_env.cmi : \
+    ../typing/types.cmi \
+    odoc_name.cmi
+odoc_exception.cmo : \
+    ../typing/types.cmi \
+    odoc_types.cmi \
+    odoc_type.cmo \
+    odoc_name.cmi
+odoc_exception.cmx : \
+    ../typing/types.cmx \
+    odoc_types.cmx \
+    odoc_type.cmx \
+    odoc_name.cmx
+odoc_extension.cmo : \
+    ../typing/types.cmi \
+    odoc_types.cmi \
+    odoc_type.cmo \
+    odoc_name.cmi \
+    ../parsing/asttypes.cmi
+odoc_extension.cmx : \
+    ../typing/types.cmx \
+    odoc_types.cmx \
+    odoc_type.cmx \
+    odoc_name.cmx \
+    ../parsing/asttypes.cmi
+odoc_gen.cmo : \
+    odoc_texi.cmo \
+    odoc_module.cmo \
+    odoc_man.cmo \
+    odoc_latex.cmo \
+    odoc_html.cmo \
+    odoc_dot.cmo \
+    odoc_gen.cmi
+odoc_gen.cmx : \
+    odoc_texi.cmx \
+    odoc_module.cmx \
+    odoc_man.cmx \
+    odoc_latex.cmx \
+    odoc_html.cmx \
+    odoc_dot.cmx \
+    odoc_gen.cmi
+odoc_gen.cmi : \
+    odoc_texi.cmo \
+    odoc_module.cmo \
+    odoc_man.cmo \
+    odoc_latex.cmo \
+    odoc_html.cmo \
+    odoc_dot.cmo
+odoc_global.cmo : \
+    odoc_types.cmi \
+    odoc_messages.cmo \
+    odoc_config.cmi \
+    ../utils/clflags.cmi \
+    odoc_global.cmi
+odoc_global.cmx : \
+    odoc_types.cmx \
+    odoc_messages.cmx \
+    odoc_config.cmx \
+    ../utils/clflags.cmx \
+    odoc_global.cmi
+odoc_global.cmi : \
+    odoc_types.cmi
+odoc_html.cmo : \
+    odoc_text.cmi \
+    odoc_ocamlhtml.cmo \
+    odoc_messages.cmo \
+    odoc_info.cmi \
+    odoc_global.cmi \
+    odoc_dag2html.cmi \
+    ../utils/misc.cmi \
+    ../parsing/asttypes.cmi
+odoc_html.cmx : \
+    odoc_text.cmx \
+    odoc_ocamlhtml.cmx \
+    odoc_messages.cmx \
+    odoc_info.cmx \
+    odoc_global.cmx \
+    odoc_dag2html.cmx \
+    ../utils/misc.cmx \
+    ../parsing/asttypes.cmi
+odoc_info.cmo : \
+    ../typing/printtyp.cmi \
+    odoc_value.cmo \
+    odoc_types.cmi \
+    odoc_type.cmo \
+    odoc_text.cmi \
+    odoc_str.cmi \
+    odoc_search.cmi \
+    odoc_scan.cmo \
+    odoc_print.cmi \
+    odoc_parameter.cmo \
+    odoc_name.cmi \
+    odoc_module.cmo \
+    odoc_misc.cmi \
+    odoc_global.cmi \
+    odoc_extension.cmo \
+    odoc_exception.cmo \
+    odoc_dep.cmo \
+    odoc_config.cmi \
+    odoc_comments.cmi \
+    odoc_class.cmo \
+    odoc_analyse.cmi \
+    ../parsing/location.cmi \
+    odoc_info.cmi
+odoc_info.cmx : \
+    ../typing/printtyp.cmx \
+    odoc_value.cmx \
+    odoc_types.cmx \
+    odoc_type.cmx \
+    odoc_text.cmx \
+    odoc_str.cmx \
+    odoc_search.cmx \
+    odoc_scan.cmx \
+    odoc_print.cmx \
+    odoc_parameter.cmx \
+    odoc_name.cmx \
+    odoc_module.cmx \
+    odoc_misc.cmx \
+    odoc_global.cmx \
+    odoc_extension.cmx \
+    odoc_exception.cmx \
+    odoc_dep.cmx \
+    odoc_config.cmx \
+    odoc_comments.cmx \
+    odoc_class.cmx \
+    odoc_analyse.cmx \
+    ../parsing/location.cmx \
+    odoc_info.cmi
+odoc_info.cmi : \
+    ../typing/types.cmi \
+    odoc_value.cmo \
+    odoc_types.cmi \
+    odoc_type.cmo \
+    odoc_search.cmi \
+    odoc_parameter.cmo \
+    odoc_module.cmo \
+    odoc_global.cmi \
+    odoc_extension.cmo \
+    odoc_exception.cmo \
+    odoc_class.cmo \
+    ../parsing/location.cmi \
+    ../parsing/asttypes.cmi
+odoc_inherit.cmo :
+odoc_inherit.cmx :
+odoc_latex.cmo : \
+    odoc_to_text.cmo \
+    odoc_messages.cmo \
+    odoc_latex_style.cmo \
+    odoc_info.cmi \
+    ../parsing/asttypes.cmi
+odoc_latex.cmx : \
+    odoc_to_text.cmx \
+    odoc_messages.cmx \
+    odoc_latex_style.cmx \
+    odoc_info.cmx \
+    ../parsing/asttypes.cmi
+odoc_latex_style.cmo :
+odoc_latex_style.cmx :
+odoc_lexer.cmo : \
+    odoc_parser.cmi \
+    odoc_messages.cmo \
+    odoc_global.cmi \
+    odoc_comments_global.cmi
+odoc_lexer.cmx : \
+    odoc_parser.cmx \
+    odoc_messages.cmx \
+    odoc_global.cmx \
+    odoc_comments_global.cmx
+odoc_man.cmo : \
+    odoc_str.cmi \
+    odoc_print.cmi \
+    odoc_misc.cmi \
+    odoc_messages.cmo \
+    odoc_info.cmi \
+    ../parsing/asttypes.cmi
+odoc_man.cmx : \
+    odoc_str.cmx \
+    odoc_print.cmx \
+    odoc_misc.cmx \
+    odoc_messages.cmx \
+    odoc_info.cmx \
+    ../parsing/asttypes.cmi
+odoc_merge.cmo : \
+    odoc_value.cmo \
+    odoc_types.cmi \
+    odoc_type.cmo \
+    odoc_parameter.cmo \
+    odoc_module.cmo \
+    odoc_messages.cmo \
+    odoc_global.cmi \
+    odoc_extension.cmo \
+    odoc_exception.cmo \
+    odoc_class.cmo \
+    odoc_merge.cmi
+odoc_merge.cmx : \
+    odoc_value.cmx \
+    odoc_types.cmx \
+    odoc_type.cmx \
+    odoc_parameter.cmx \
+    odoc_module.cmx \
+    odoc_messages.cmx \
+    odoc_global.cmx \
+    odoc_extension.cmx \
+    odoc_exception.cmx \
+    odoc_class.cmx \
+    odoc_merge.cmi
+odoc_merge.cmi : \
+    odoc_types.cmi \
+    odoc_module.cmo
+odoc_messages.cmo : \
+    ../utils/config.cmi
+odoc_messages.cmx : \
+    ../utils/config.cmx
+odoc_misc.cmo : \
+    ../typing/types.cmi \
+    ../typing/predef.cmi \
+    ../typing/path.cmi \
+    odoc_types.cmi \
+    odoc_messages.cmo \
+    ../parsing/longident.cmi \
+    ../typing/ctype.cmi \
+    ../typing/btype.cmi \
+    odoc_misc.cmi
+odoc_misc.cmx : \
+    ../typing/types.cmx \
+    ../typing/predef.cmx \
+    ../typing/path.cmx \
+    odoc_types.cmx \
+    odoc_messages.cmx \
+    ../parsing/longident.cmx \
+    ../typing/ctype.cmx \
+    ../typing/btype.cmx \
+    odoc_misc.cmi
+odoc_misc.cmi : \
+    ../typing/types.cmi \
+    odoc_types.cmi \
+    ../parsing/longident.cmi \
+    ../parsing/asttypes.cmi
+odoc_module.cmo : \
+    ../typing/types.cmi \
+    odoc_value.cmo \
+    odoc_types.cmi \
+    odoc_type.cmo \
+    odoc_name.cmi \
+    odoc_extension.cmo \
+    odoc_exception.cmo \
+    odoc_class.cmo \
+    ../utils/misc.cmi
+odoc_module.cmx : \
+    ../typing/types.cmx \
+    odoc_value.cmx \
+    odoc_types.cmx \
+    odoc_type.cmx \
+    odoc_name.cmx \
+    odoc_extension.cmx \
+    odoc_exception.cmx \
+    odoc_class.cmx \
+    ../utils/misc.cmx
+odoc_name.cmo : \
+    ../typing/path.cmi \
+    odoc_misc.cmi \
+    ../typing/ident.cmi \
+    odoc_name.cmi
+odoc_name.cmx : \
+    ../typing/path.cmx \
+    odoc_misc.cmx \
+    ../typing/ident.cmx \
+    odoc_name.cmi
+odoc_name.cmi : \
+    ../typing/path.cmi \
+    ../parsing/longident.cmi \
+    ../typing/ident.cmi
+odoc_ocamlhtml.cmo :
+odoc_ocamlhtml.cmx :
+odoc_parameter.cmo : \
+    ../typing/types.cmi \
+    odoc_types.cmi
+odoc_parameter.cmx : \
+    ../typing/types.cmx \
+    odoc_types.cmx
+odoc_parser.cmo : \
+    odoc_types.cmi \
+    odoc_comments_global.cmi \
+    odoc_parser.cmi
+odoc_parser.cmx : \
+    odoc_types.cmx \
+    odoc_comments_global.cmx \
+    odoc_parser.cmi
+odoc_parser.cmi : \
+    odoc_types.cmi
+odoc_print.cmo : \
+    ../typing/types.cmi \
+    ../typing/printtyp.cmi \
+    ../typing/btype.cmi \
+    odoc_print.cmi
+odoc_print.cmx : \
+    ../typing/types.cmx \
+    ../typing/printtyp.cmx \
+    ../typing/btype.cmx \
+    odoc_print.cmi
+odoc_print.cmi : \
+    ../typing/types.cmi
+odoc_scan.cmo : \
+    odoc_value.cmo \
+    odoc_types.cmi \
+    odoc_type.cmo \
+    odoc_module.cmo \
+    odoc_extension.cmo \
+    odoc_exception.cmo \
+    odoc_class.cmo
+odoc_scan.cmx : \
+    odoc_value.cmx \
+    odoc_types.cmx \
+    odoc_type.cmx \
+    odoc_module.cmx \
+    odoc_extension.cmx \
+    odoc_exception.cmx \
+    odoc_class.cmx
+odoc_search.cmo : \
+    odoc_value.cmo \
+    odoc_types.cmi \
+    odoc_type.cmo \
+    odoc_module.cmo \
+    odoc_misc.cmi \
+    odoc_extension.cmo \
+    odoc_exception.cmo \
+    odoc_class.cmo \
+    odoc_search.cmi
+odoc_search.cmx : \
+    odoc_value.cmx \
+    odoc_types.cmx \
+    odoc_type.cmx \
+    odoc_module.cmx \
+    odoc_misc.cmx \
+    odoc_extension.cmx \
+    odoc_exception.cmx \
+    odoc_class.cmx \
+    odoc_search.cmi
+odoc_search.cmi : \
+    odoc_value.cmo \
+    odoc_types.cmi \
+    odoc_type.cmo \
+    odoc_module.cmo \
+    odoc_extension.cmo \
+    odoc_exception.cmo \
+    odoc_class.cmo
+odoc_see_lexer.cmo : \
+    odoc_parser.cmi
+odoc_see_lexer.cmx : \
+    odoc_parser.cmx
+odoc_sig.cmo : \
+    ../typing/types.cmi \
+    ../typing/typedtree.cmi \
+    ../parsing/parsetree.cmi \
+    odoc_value.cmo \
+    odoc_types.cmi \
+    odoc_type.cmo \
+    odoc_parameter.cmo \
+    odoc_module.cmo \
+    odoc_misc.cmi \
+    odoc_messages.cmo \
+    odoc_merge.cmi \
+    odoc_global.cmi \
+    odoc_extension.cmo \
+    odoc_exception.cmo \
+    odoc_env.cmi \
+    odoc_class.cmo \
+    ../parsing/longident.cmi \
+    ../parsing/location.cmi \
+    ../typing/ident.cmi \
+    ../typing/ctype.cmi \
+    ../typing/btype.cmi \
+    ../parsing/asttypes.cmi \
+    odoc_sig.cmi
+odoc_sig.cmx : \
+    ../typing/types.cmx \
+    ../typing/typedtree.cmx \
+    ../parsing/parsetree.cmi \
+    odoc_value.cmx \
+    odoc_types.cmx \
+    odoc_type.cmx \
+    odoc_parameter.cmx \
+    odoc_module.cmx \
+    odoc_misc.cmx \
+    odoc_messages.cmx \
+    odoc_merge.cmx \
+    odoc_global.cmx \
+    odoc_extension.cmx \
+    odoc_exception.cmx \
+    odoc_env.cmx \
+    odoc_class.cmx \
+    ../parsing/longident.cmx \
+    ../parsing/location.cmx \
+    ../typing/ident.cmx \
+    ../typing/ctype.cmx \
+    ../typing/btype.cmx \
+    ../parsing/asttypes.cmi \
+    odoc_sig.cmi
+odoc_sig.cmi : \
+    ../typing/types.cmi \
+    ../typing/typedtree.cmi \
+    ../parsing/parsetree.cmi \
+    odoc_types.cmi \
+    odoc_type.cmo \
+    odoc_name.cmi \
+    odoc_module.cmo \
+    odoc_env.cmi \
+    odoc_class.cmo \
+    ../parsing/location.cmi
+odoc_str.cmo : \
+    ../typing/types.cmi \
+    ../typing/printtyp.cmi \
+    odoc_value.cmo \
+    odoc_type.cmo \
+    odoc_print.cmi \
+    odoc_name.cmi \
+    odoc_misc.cmi \
+    odoc_messages.cmo \
+    odoc_extension.cmo \
+    odoc_exception.cmo \
+    odoc_class.cmo \
+    ../parsing/asttypes.cmi \
+    odoc_str.cmi
+odoc_str.cmx : \
+    ../typing/types.cmx \
+    ../typing/printtyp.cmx \
+    odoc_value.cmx \
+    odoc_type.cmx \
+    odoc_print.cmx \
+    odoc_name.cmx \
+    odoc_misc.cmx \
+    odoc_messages.cmx \
+    odoc_extension.cmx \
+    odoc_exception.cmx \
+    odoc_class.cmx \
+    ../parsing/asttypes.cmi \
+    odoc_str.cmi
+odoc_str.cmi : \
+    ../typing/types.cmi \
+    odoc_value.cmo \
+    odoc_type.cmo \
+    odoc_extension.cmo \
+    odoc_exception.cmo \
+    odoc_class.cmo
+odoc_test.cmo : \
+    odoc_info.cmi \
+    odoc_gen.cmi \
+    odoc_args.cmi
+odoc_test.cmx : \
+    odoc_info.cmx \
+    odoc_gen.cmx \
+    odoc_args.cmx
+odoc_texi.cmo : \
+    ../typing/types.cmi \
+    odoc_to_text.cmo \
+    odoc_messages.cmo \
+    odoc_info.cmi \
+    ../parsing/asttypes.cmi
+odoc_texi.cmx : \
+    ../typing/types.cmx \
+    odoc_to_text.cmx \
+    odoc_messages.cmx \
+    odoc_info.cmx \
+    ../parsing/asttypes.cmi
+odoc_text.cmo : \
+    odoc_types.cmi \
+    odoc_text_parser.cmi \
+    odoc_text_lexer.cmo \
+    odoc_text.cmi
+odoc_text.cmx : \
+    odoc_types.cmx \
+    odoc_text_parser.cmx \
+    odoc_text_lexer.cmx \
+    odoc_text.cmi
+odoc_text.cmi : \
+    odoc_types.cmi
+odoc_text_lexer.cmo : \
+    odoc_text_parser.cmi \
+    odoc_misc.cmi
+odoc_text_lexer.cmx : \
+    odoc_text_parser.cmx \
+    odoc_misc.cmx
+odoc_text_parser.cmo : \
+    odoc_types.cmi \
+    odoc_misc.cmi \
+    odoc_text_parser.cmi
+odoc_text_parser.cmx : \
+    odoc_types.cmx \
+    odoc_misc.cmx \
+    odoc_text_parser.cmi
+odoc_text_parser.cmi : \
+    odoc_types.cmi
+odoc_to_text.cmo : \
+    odoc_str.cmi \
+    odoc_module.cmo \
+    odoc_messages.cmo \
+    odoc_info.cmi
+odoc_to_text.cmx : \
+    odoc_str.cmx \
+    odoc_module.cmx \
+    odoc_messages.cmx \
+    odoc_info.cmx
+odoc_type.cmo : \
+    ../typing/types.cmi \
+    odoc_types.cmi \
+    odoc_name.cmi \
+    ../parsing/asttypes.cmi
+odoc_type.cmx : \
+    ../typing/types.cmx \
+    odoc_types.cmx \
+    odoc_name.cmx \
+    ../parsing/asttypes.cmi
+odoc_types.cmo : \
+    odoc_messages.cmo \
+    ../parsing/location.cmi \
+    odoc_types.cmi
+odoc_types.cmx : \
+    odoc_messages.cmx \
+    ../parsing/location.cmx \
+    odoc_types.cmi
+odoc_types.cmi : \
+    ../parsing/location.cmi
+odoc_value.cmo : \
+    ../typing/types.cmi \
+    ../typing/printtyp.cmi \
+    odoc_types.cmi \
+    odoc_parameter.cmo \
+    odoc_name.cmi \
+    odoc_misc.cmi \
+    ../parsing/asttypes.cmi
+odoc_value.cmx : \
+    ../typing/types.cmx \
+    ../typing/printtyp.cmx \
+    odoc_types.cmx \
+    odoc_parameter.cmx \
+    odoc_name.cmx \
+    odoc_misc.cmx \
+    ../parsing/asttypes.cmi
+generators/odoc_literate.cmo : \
+    odoc_info.cmi \
+    odoc_html.cmo \
+    odoc_gen.cmi \
+    odoc_args.cmi
+generators/odoc_literate.cmx : \
+    odoc_info.cmx \
+    odoc_html.cmx \
+    odoc_gen.cmx \
+    odoc_args.cmx
+generators/odoc_literate.cmxs : \
+    odoc_info.cmx \
+    odoc_html.cmx \
+    odoc_gen.cmx \
+    odoc_args.cmx
+generators/odoc_todo.cmo : \
+    odoc_module.cmo \
+    odoc_info.cmi \
+    odoc_html.cmo \
+    odoc_gen.cmi \
+    odoc_args.cmi
+generators/odoc_todo.cmx : \
+    odoc_module.cmx \
+    odoc_info.cmx \
+    odoc_html.cmx \
+    odoc_gen.cmx \
+    odoc_args.cmx
+generators/odoc_todo.cmxs : \
+    odoc_module.cmx \
+    odoc_info.cmx \
+    odoc_html.cmx \
+    odoc_gen.cmx \
+    odoc_args.cmx
diff --git a/ocamldoc/Changes.txt b/ocamldoc/Changes.txt
new file mode 100644
index 00000000..194e664a
--- /dev/null
+++ b/ocamldoc/Changes.txt
@@ -0,0 +1,209 @@
+TODO:
+ - need to fix display of type parameters for inherited classes/class types
+ - need to add an environment while generating to print correct links:
+   file foo.mli:
+     type u
+     module type M = sig type u end
+     module N : sig include M val f: u -> unit end
+   Here, in html for example, f in displayed being of type Foo.u instead of Foo.M.u
+ - latex: types variant polymorphes depassent de la page quand ils sont trop longs
+ - utilisation nouvelles infos de Xavier: "debut de rec", etc.
+ - xml generator
+
+=====
+Release > 3.11.0:
+- option -g also for native code version (loading custom generators)
+
+=====
+Release 3.09.3:
+- mod: PR#4017 new option -short-functors to use a short form to display
+  functors in html generator
+- fix: PR#4016 (using modtype constraint to filter module elements displayed in doc)
+- fix: PR#4066 (missing crossref in text from intro files)
+- fix: PR#4007 (error in merging of top dependencies of modules)
+- fix: PR#3981 (-dot-colors has no effect)
+- mod: name resolution in cross-referencing: {!name} if name is not
+  found, then it is searched in the parent module/class, and in the parent
+  of the parent, and so on until it is found.
+
+=====
+Release 3.09.1:
+ - fix: remove .TP for generated man pages, use .sp instead
+   (.TP caused a lot of odd margins)
+ - fix: html generator now output DOCTYPE and character encoding information.
+ - add: m_text_only field in Module.t_module, to separate real modules
+   from text files handled as modules.
+ - fix: display only text for "text modules"
+ - extensible {foo } syntax
+ - user can give .txt files on the command line, containing ocamldoc formatted
+   text, to be able to include bigger texts out of source files
+ - -o option is now used by the html generator to indicate the prefix
+   of generated index files (to avoid conflict when a Index module exists
+   on case-insensitive file systems).
+
+=====
+Release 3.08.4:
+ - some improvements in html display
+ - better error messages for misplaced variant constructors comments
+ - some fixes in man page generation (escaping characters)
+
+=====
+Release 3.08.2:
+ - fix: error "Lexing: empty token" (PR#3173)
+
+=====
+Release 3.08.1:
+ - add: new -intf and -impl options supported (PR#3036)
+ - fix: display of class parameters in HTML and LaTeX (PR#2994)
+ - fix: display of link to class page in html (PR#2994)
+
+=====
+Release 3.08.0:
+ - fix: method parameters names in signature are now retrieved correctly
+   (fix of Odoc_value.parameter_list_from_arrows to handle Tpoly for methods)
+ - ajout a la doc de Module_list et Index_list (utilise dans le html seulement)
+ - ajout a la doc: fichier de l'option -intro utilise pour l'index en html
+ - fix: create a Module_with instead of a Module_alias when we encounter
+     module A : Foo in a signature
+ - latex: style latex pour indenter dans les module kind et les class kind
+ - latex: il manque la generation des parametres de classe
+ - parse des {!modules: } et {!indexlist}
+ - gestion des Module_list et Index_list
+ - no need to Dynlink.add_available_units any more
+ - generate html from module_kind rather than from module_type
+   + same for classes and class types
+ - add the kind to module parameters (the way the parameter was build in the parsetree)
+ - fix: the generated ocamldoc.sty is more robust for paragraphs in
+     ocamldocdescription environment
+ - fix: when generating separated files in latex, generate them in
+     the same directory than the main file, (the one specified by -o)
+ - mod: one section per to module in latex output + improve latex output
+ - mod: odoc_latex: use buffers instead of string concatenation
+ - add: new ocamldoc man page, thanks to Samuel Mimram
+ - fix: useless parentheses around arguments of arguments of a type constructor in
+     type definitions, and aournd arguments of exceptions in exception definitions.
+ - fix: blank lines in verbatim, latex, code pre, code and ele ref modes
+     are now accepted
+ - fix: html generator: included module names were displayed with their simple
+     name rather than their fully qualified name
+ - fix: use a formatter from a buffer rather Format.str_formatter in
+     Odoc_mist.sting_of_module_type, to avoid too much blanks
+ - new module odoc_print, will work when Format.pp_print_flush is fixed
+ - odoc_html: use buffers instead of string concatenation
+ - odoc_man: use buffers instead of string concatenation
+ - odoc_cross.ml: use hash tables modified on the fly to resolve
+    (module | module type | exception) name aliases
+ - odoc_html: replace some calls to Str. by specific functions on strings
+ - odoc_cross.ml: use a Map to associate a complete name to
+    the known elements with this name, instead of searching each time
+    through the whole list of modules -> a gain of more than 90% in speed
+    for cross-referencing (Odoc_cross.associate)
+ - fix: Odoc_name.cut printed a '(' instead of a '.'
+ - add: new option -customdir
+ - add: new option -i (to add a path to the directory where
+     to look for custom generators)
+ - add: add odoc_config.ml{,i}
+ - add: keep_code in Odoc_info.Args interface
+ - add: m_code_intf and m_code fields for modules, fit when the
+   Odoc_args.keep_code option is set, and fit for all modules, not
+   only toplevel ones
+ - fix: bug preventing to get the code in a .mli
+ - fix: missing spaces after carriage return in types (Odoc_misc.string_of_type_expr)
+ - fixes: some bugs in the text parser
+     ( ]} meaning end of code and something else instead of end of precode)
+ - add: in Odoc_info: text_of_string, text_string_of_text, info_of_string
+ - fix: better output of titles in html (use more the style)
+ - add: -intro option to use a file content as ocamldoc comment to use as
+   introduction for LaTeX document and HTML index page
+ - add: the HTML generator generates the code of the module if available
+ - add: field m_code for modules, to keep the code of top modules
+ - fix: display "include Foo" instead of "include module Foo" in Latex, Man, Texi
+ - fix: not display comments associated to include directives
+ - fix: bad display of type parameters for class and class types
+
+======
+
+Release 3.05 :
+ - added link tags in html header to reference sections and subsections
+   in each page (for browser which handle those tags)
+ - no titles nor lists in first sentence of text in indexes and latex titles
+ - only one table for the titles in HTML output
+ - fix of bad comment association for types in .ml files
+ - dumps now contain a magic number, checked when dumps are loaded
+ - new option -o to use with texi, latex and dot generators
+ - new .code CSS class used
+ - better output for classes and modules, with their type
+ - added texinfo generator, by Olivier Andrieu
+ - removed iso generator, which became the odoc_check custom generator
+ - link syntax {{:url}text} added to the manual
+ - (** comments in code is colorized in ocaml code html pages
+ - new class .code in style
+ - new generator : -dot . Output dot code to display
+   modules or types dependencies.
+ - new option -inv-merge-ml-mli to inverse the priority of
+   .ml and .mli when merging
+ - option -werr becomes -warn-error
+ - possibility to define and reference section labels
+   Example:
+    (** {2:mysectionlabel My title bla bla bla} *)
+   in module Foo
+
+   This section is referenced with {!Foo.mysectionlabel} in
+   a comment.
+
+Pre-release 4 :
+ - new option -werr to treat ocamldoc warnings as errors
+ - new option -hide to remove some modules from complete names,
+   (e.g., print ref instead of Pervasives.ref)
+ - HTML doc in classic style only contain indexes to existing element kinds
+   (i.e. there is no class index if the doc does not contain any class.)
+ - First description sentence now stops at the first period followed by a blank,
+   or at the first blank line.
+ - update of user manual
+ - check report generator added (options -iso and -iso-{val|ty|cl|ex|mod})
+ - Odoc_info.Scan.scanner base class added
+ - support for custom tags (@xxx with xxx not a predefined tag), see manual
+ - new classes info in Odoc_html, Odoc_to_text, Odoc_latex, and Odoc_man, which
+   contains the functions for printing info structures
+ - replacement of modules Odoc_html.Text and Odoc_latex.Text by
+   classes Odoc_html.text and Odoc_latex.text to allow the redefinition
+   of their methods in custom generators
+ - bug fix : a shortcut list can be pu after a blank line
+ - improved display of variant constructors, record fields and
+   their comments in classic HTML
+ - blank lines in comments become 
     in HTML instead of 
    
+ - bug fix : there can be blanks between the last item
+   and the ending } of a list
+ - new option -latextitles
+ - number of errors encountered is displayed
+ - if at least one error occurs, exit code is not 0
+ - more precise error messages
+ - bug fix : \n and other blanks are accepted after, for example, {i
+
+Pre-release 3 :
+ - option -stars
+ - complete paths of executables in the generated Makefile
+ - names of executables changed to ocamldoc and ocamldoc.opt
+ - better LaTeX output
+ - option -sepfiles for LaTeX
+ - ocamldoc.sty used by the generated LaTeX
+ - ocamldoc.hva added to use Hevea on the generated LaTeX
+ - user manual updated
+ - {[ ]} marks to put pre-formatted code on more than one line
+ - {!Toto.tutu} to add cross references between elements
+ - some bug fixes
+
+Rep-release 2 :
+- generator of texinfo files : odoc_texi.cma
+- use of CSS in generated html
+- new option -css-style to provide a different style sheet
+- improved html
+- added more precise titles in generated html pages
+- no more links to unknown elements
+- added indexes
+- simple html : added  in  : compliant
+  browsers should display quick access to modules and indexes in
+  their navigation bar (for example, mozilla 0.9.5 is compliant)
+- '{bone}' doesn't work any more ; a space is required as in '{b one}'.
+  Same for {e, {i, and some others marks. Check the manual
+- bug fixes
diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile
new file mode 100644
index 00000000..6b7093b6
--- /dev/null
+++ b/ocamldoc/Makefile
@@ -0,0 +1,527 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *
+#*                                                                        *
+#*   Copyright 2001 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+ROOTDIR = ..
+
+-include $(ROOTDIR)/Makefile.config
+-include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.best_binaries
+
+OCAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
+OCAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc
+
+STDLIBFLAGS = -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLC = $(BEST_OCAMLC) $(STDLIBFLAGS)
+OCAMLOPT = $(BEST_OCAMLOPT) $(STDLIBFLAGS)
+OCAMLDEP = $(BEST_OCAMLDEP)
+DEPFLAGS = -slash
+OCAMLLEX = $(BEST_OCAMLLEX)
+
+# TODO: figure out whether the DEBUG lines the following preprocessor removes
+# are actually useful.
+# If they are not, then the preprocessor logic (including the
+# remove_DEBUG script and the debug target) could be removed.
+# If they are, it may be better to be able to enable them at run-time
+# rather than compile-time, e.g. through a -debug command-line option.
+# In the following line, "sh" is useful under Windows. Without it,
+# the ./remove_DEBUG command would be executed by cmd.exe which would not
+# know how to handle it.
+OCAMLPP=-pp 'sh ./remove_DEBUG'
+
+# For installation
+##############
+
+MKDIR=mkdir -p
+CP=cp
+OCAMLDOC=ocamldoc
+OCAMLDOC_OPT=$(OCAMLDOC).opt
+
+# TODO: clarify whether the following really needs to be that complicated
+ifeq "$(UNIX_OR_WIN32)" "unix"
+  ifeq "$(TARGET)" "$(HOST)"
+    ifeq "$(SUPPORTS_SHARED_LIBRARIES)" "true"
+      OCAMLDOC_RUN_BYTE=$(OCAMLRUN) -I $(ROOTDIR)/otherlibs/$(UNIXLIB) -I $(ROOTDIR)/otherlibs/str ./$(OCAMLDOC)
+    else
+# if shared-libraries are not supported, unix.cma and str.cma
+# are compiled with -custom, so ocamldoc also uses -custom,
+# and (ocamlrun ocamldoc) does not work.
+      OCAMLDOC_RUN_BYTE=./$(OCAMLDOC)
+    endif
+  else
+    OCAMLDOC_RUN_BYTE=$(OCAMLRUN) ./$(OCAMLDOC)
+  endif
+else # Windows
+  OCAMLDOC_RUN_BYTE = \
+    CAML_LD_LIBRARY_PATH="$(ROOTDIR)/otherlibs/win32unix;$(ROOTDIR)/otherlibs/str" $(OCAMLRUN) ./$(OCAMLDOC)
+endif
+
+OCAMLDOC_RUN_OPT=./$(OCAMLDOC_OPT)
+
+OCAMLDOC_RUN_PLUGINS=$(OCAMLDOC_RUN_BYTE)
+
+ifeq "$(wildcard $(OCAMLDOC_OPT))" ""
+  OCAMLDOC_RUN=$(OCAMLDOC_RUN_BYTE)
+else
+  OCAMLDOC_RUN=$(OCAMLDOC_RUN_OPT)
+endif
+
+OCAMLDOC_LIBCMA=odoc_info.cma
+OCAMLDOC_LIBCMI=odoc_info.cmi
+OCAMLDOC_LIBCMXA=odoc_info.cmxa
+OCAMLDOC_LIBA=odoc_info.$(A)
+
+OCAMLDOC_LIBMLIS=odoc_info.mli
+OCAMLDOC_LIBCMIS=$(OCAMLDOC_LIBMLIS:.mli=.cmi)
+OCAMLDOC_LIBCMTS=$(OCAMLDOC_LIBMLIS:.mli=.cmt) $(OCAMLDOC_LIBMLIS:.mli=.cmti)
+
+ODOC_TEST=odoc_test.cmo
+GENERATORS_CMOS= \
+        generators/odoc_todo.cmo \
+        generators/odoc_literate.cmo
+ifeq "$(NATDYNLINK)" "true"
+GENERATORS_CMXS = $(GENERATORS_CMOS:.cmo=.cmxs)
+else
+GENERATORS_CMXS =
+endif
+
+# Compilation
+#############
+
+INCLUDES_DEP=\
+  -I $(ROOTDIR)/utils \
+  -I $(ROOTDIR)/parsing \
+  -I $(ROOTDIR)/typing \
+  -I $(ROOTDIR)/driver \
+  -I $(ROOTDIR)/bytecomp \
+  -I $(ROOTDIR)/toplevel
+
+INCLUDES_NODEP=\
+  -I $(ROOTDIR)/stdlib \
+  -I $(ROOTDIR)/compilerlibs \
+  -I $(ROOTDIR)/otherlibs/str \
+  -I $(ROOTDIR)/otherlibs/dynlink \
+  -I $(ROOTDIR)/otherlibs/dynlink/native \
+  -I $(ROOTDIR)/otherlibs/$(UNIXLIB)
+
+DEPINCLUDES=$(INCLUDES_DEP)
+INCLUDES=$(INCLUDES_DEP) $(INCLUDES_NODEP)
+
+COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
+  -safe-string -strict-sequence -strict-formats -bin-annot -principal
+
+LINKFLAGS=$(INCLUDES) -nostdlib
+
+CMOFILES=\
+  odoc_config.cmo \
+  odoc_messages.cmo \
+  odoc_global.cmo \
+  odoc_types.cmo \
+  odoc_misc.cmo \
+  odoc_text_parser.cmo \
+  odoc_text_lexer.cmo \
+  odoc_text.cmo \
+  odoc_name.cmo \
+  odoc_parameter.cmo \
+  odoc_value.cmo \
+  odoc_type.cmo \
+  odoc_extension.cmo \
+  odoc_exception.cmo \
+  odoc_class.cmo \
+  odoc_module.cmo \
+  odoc_print.cmo \
+  odoc_str.cmo \
+  odoc_comments_global.cmo \
+  odoc_parser.cmo \
+  odoc_lexer.cmo \
+  odoc_see_lexer.cmo \
+  odoc_env.cmo \
+  odoc_merge.cmo \
+  odoc_sig.cmo \
+  odoc_ast.cmo \
+  odoc_control.cmo \
+  odoc_inherit.cmo \
+  odoc_search.cmo \
+  odoc_scan.cmo \
+  odoc_cross.cmo \
+  odoc_comments.cmo \
+  odoc_dep.cmo \
+  odoc_analyse.cmo \
+  odoc_info.cmo
+
+CMXFILES = $(CMOFILES:.cmo=.cmx)
+CMIFILES = $(CMOFILES:.cmo=.cmi)
+
+EXECMOFILES=\
+  $(CMOFILES) \
+  odoc_dag2html.cmo \
+  odoc_to_text.cmo \
+  odoc_ocamlhtml.cmo \
+  odoc_html.cmo \
+  odoc_man.cmo \
+  odoc_latex_style.cmo \
+  odoc_latex.cmo \
+  odoc_texi.cmo \
+  odoc_dot.cmo \
+  odoc_gen.cmo \
+  odoc_args.cmo \
+  odoc.cmo
+
+EXECMXFILES = $(EXECMOFILES:.cmo=.cmx)
+EXECMIFILES = $(EXECMOFILES:.cmo=.cmi)
+
+LIBCMOFILES = $(CMOFILES)
+LIBCMXFILES = $(LIBCMOFILES:.cmo=.cmx)
+LIBCMIFILES = $(LIBCMOFILES:.cmo=.cmi)
+
+.PHONY: all
+all: lib exe generators
+
+.PHONY: exe
+exe: $(OCAMLDOC)
+
+.PHONY: lib
+lib: $(OCAMLDOC_LIBCMA) $(OCAMLDOC_LIBCMI) $(ODOC_TEST)
+
+.PHONY: generators
+generators: $(GENERATORS_CMOS)
+
+.PHONY: opt.opt allopt # allopt and opt.opt are synonyms
+opt.opt: exeopt libopt generatorsopt
+allopt: opt.opt
+
+.PHONY: exeopt
+exeopt: $(OCAMLDOC_OPT)
+
+.PHONY: libopt
+libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI)
+
+.PHONY: generatorsopt
+generatorsopt: $(GENERATORS_CMXS)
+
+# TODO: the following debug target could be replaced by a DEBUG variable
+.PHONY: debug
+debug:
+	$(MAKE) OCAMLPP=""
+
+OCAMLDOC_LIBRARIES = ocamlcommon unix str dynlink
+
+OCAMLDOC_BCLIBRARIES = $(OCAMLDOC_LIBRARIES:%=%.cma)
+OCAMLDOC_NCLIBRARIES = $(OCAMLDOC_LIBRARIES:%=%.cmxa)
+
+$(OCAMLDOC): $(EXECMOFILES)
+	$(OCAMLC) -o $@ -linkall $(LINKFLAGS) $(OCAMLDOC_BCLIBRARIES) $^
+
+$(OCAMLDOC_OPT): $(EXECMXFILES)
+	$(OCAMLOPT_CMD) -o $@ -linkall $(LINKFLAGS) $(OCAMLDOC_NCLIBRARIES) $^
+
+$(OCAMLDOC_LIBCMA): $(LIBCMOFILES)
+	$(OCAMLC) -a -o $@ $(LINKFLAGS) $^
+
+$(OCAMLDOC_LIBCMXA): $(LIBCMXFILES)
+	$(OCAMLOPT) -a -o $@ $(LINKFLAGS) $^
+
+.PHONY: manpages
+manpages: stdlib_man/Stdlib.3o
+
+.PHONY: html_doc
+html_doc: stdlib_html/Stdlib.html
+
+.PHONY: pdf_doc
+pdf_doc: stdlib_latex/stdlib.pdf
+
+.PHONY: texi_doc
+texi_doc: stdlib_texi/stdlib.texi
+
+.PHONY: dot
+dot: ocamldoc.dot
+
+ocamldoc.dot: $(EXECMOFILES)
+	$(OCAMLDOC_RUN) -dot -dot-reduce -o $@ $(INCLUDES) odoc*.ml
+
+# Parsers and lexers dependencies :
+###################################
+odoc_text_parser.ml: odoc_text_parser.mly
+odoc_text_parser.mli: odoc_text_parser.mly
+
+odoc_parser.ml:	odoc_parser.mly
+odoc_parser.mli:odoc_parser.mly
+
+odoc_text_lexer.ml: odoc_text_lexer.mll
+
+odoc_lexer.ml:odoc_lexer.mll
+
+odoc_ocamlhtml.ml: odoc_ocamlhtml.mll
+
+odoc_see_lexer.ml: odoc_see_lexer.mll
+
+
+# generic rules :
+#################
+
+.SUFFIXES: .mll .mly .ml .mli .cmo .cmi .cmx .cmxs
+
+.ml.cmo:
+	$(OCAMLC) $(OCAMLPP) $(COMPFLAGS) -c $<
+
+.mli.cmi:
+	$(OCAMLC) $(OCAMLPP) $(COMPFLAGS) -c $<
+
+.ml.cmx:
+	$(OCAMLOPT) $(OCAMLPP) $(COMPFLAGS) -c $<
+
+.ml.cmxs:
+	$(OCAMLOPT_CMD) -shared -o $@ $(OCAMLPP) $(COMPFLAGS) $<
+
+.mll.ml:
+	$(OCAMLLEX) $(OCAMLLEX_FLAGS) $<
+
+.mly.ml:
+	$(OCAMLYACC) --strict -v $<
+
+.mly.mli:
+	$(OCAMLYACC) --strict -v $<
+
+# Installation targets
+######################
+
+# TODO: it may be good to split the following rule in several ones, e.g.
+# install-programs, install-doc, install-libs
+
+INSTALL_MANODIR=$(INSTALL_MANDIR)/man3
+
+.PHONY: install
+install:
+	$(MKDIR) "$(INSTALL_BINDIR)"
+	$(MKDIR) "$(INSTALL_LIBDIR)/ocamldoc"
+	$(MKDIR) "$(INSTALL_MANODIR)"
+	$(INSTALL_PROG) $(OCAMLDOC) "$(INSTALL_BINDIR)/$(OCAMLDOC)$(EXE)"
+	$(INSTALL_DATA) \
+	  ocamldoc.hva *.cmi $(OCAMLDOC_LIBCMA) \
+	  "$(INSTALL_LIBDIR)/ocamldoc"
+	$(INSTALL_DATA) \
+	  $(OCAMLDOC_LIBCMIS) \
+	  "$(INSTALL_LIBDIR)/ocamldoc"
+ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
+	$(INSTALL_DATA) \
+	  $(OCAMLDOC_LIBMLIS) $(OCAMLDOC_LIBCMTS) \
+	  "$(INSTALL_LIBDIR)/ocamldoc"
+endif
+	if test -d stdlib_man; then \
+	  $(INSTALL_DATA) stdlib_man/* "$(INSTALL_MANODIR)"; \
+	else : ; fi
+
+# Note: at the moment, $(INSTALL_MANODIR) is created even if the doc has
+# not been built. This is not clean and should be changed.
+
+.PHONY: installopt
+installopt:
+	if test -f $(OCAMLDOC_OPT); then $(MAKE) installopt_really ; fi
+
+.PHONY: installopt_really
+installopt_really:
+	$(MKDIR) "$(INSTALL_BINDIR)"
+	$(MKDIR) "$(INSTALL_LIBDIR)/ocamldoc"
+	$(INSTALL_PROG) \
+	   $(OCAMLDOC_OPT) "$(INSTALL_BINDIR)/$(OCAMLDOC_OPT)$(EXE)"
+	$(INSTALL_DATA) \
+	  $(OCAMLDOC_LIBCMIS) \
+	  "$(INSTALL_LIBDIR)/ocamldoc"
+ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
+	$(INSTALL_DATA) \
+	  $(OCAMLDOC_LIBMLIS) $(OCAMLDOC_LIBCMTS) \
+	  "$(INSTALL_LIBDIR)/ocamldoc"
+endif
+	$(INSTALL_DATA) \
+	  ocamldoc.hva *.cmx $(OCAMLDOC_LIBA) $(OCAMLDOC_LIBCMXA) \
+	  "$(INSTALL_LIBDIR)/ocamldoc"
+
+# TODO: also split into several rules
+
+# Testing :
+###########
+
+.PHONY: test
+test:
+	$(MKDIR) $@
+	$(OCAMLDOC_RUN) -html -colorize-code -sort -d $@ $(INCLUDES) -dump $@/ocamldoc.odoc odoc*.ml odoc*.mli -v
+	$(MKDIR) $@-custom
+	$(OCAMLDOC_RUN_PLUGINS) -colorize-code -sort -d $@-custom $(INCLUDES) \
+	-g generators/odoc_literate.cmo -g generators/odoc_todo.cmo \
+	-load $@/ocamldoc.odoc -v
+
+.PHONY: test_stdlib
+test_stdlib:
+	$(MKDIR) $@
+	$(OCAMLDOC_RUN) -html -colorize-code -sort -d $@ $(INCLUDES) -dump $@/stdlib.odoc -keep-code \
+	$(ROOTDIR)/stdlib/*.mli \
+	$(ROOTDIR)/otherlibs/$(UNIXLIB)/unix.mli \
+	$(ROOTDIR)/otherlibs/str/str.mli
+
+.PHONY: test_stdlib_code
+test_stdlib_code:
+	$(MKDIR) $@
+	$(OCAMLDOC_RUN) -html -colorize-code -sort -d $@ $(INCLUDES) -dump $@/stdlib.odoc -keep-code \
+	`ls $(ROOTDIR)/stdlib/*.ml | grep -v Labels` \
+	$(ROOTDIR)/otherlibs/$(UNIXLIB)/unix.ml \
+	$(ROOTDIR)/otherlibs/str/str.ml
+
+.PHONY: test_latex
+test_latex:
+	$(MKDIR) $@
+	$(OCAMLDOC_RUN) -latex -sort -o $@/test.tex -d $@ $(INCLUDES) odoc*.ml \
+	        odoc*.mli test2.txt $(ROOTDIR)/stdlib/*.mli $(ROOTDIR)/otherlibs/unix/unix.mli
+
+.PHONY: test_latex_simple
+test_latex_simple:
+	$(MKDIR) $@
+	$(OCAMLDOC_RUN) -latex -sort -o $@/test.tex -d $@ $(INCLUDES) \
+	-latextitle 6,subsection -latextitle 7,subsubection \
+	$(ROOTDIR)/stdlib/hashtbl.mli \
+	$(ROOTDIR)/stdlib/arg.mli \
+	$(ROOTDIR)/otherlibs/$(UNIXLIB)/unix.mli \
+	$(ROOTDIR)/stdlib/map.mli
+
+.PHONY: test_man
+test_man:
+	$(MKDIR) $@
+	$(OCAMLDOC_RUN) -man -sort -d $@ $(INCLUDES) odoc*.ml odoc*.mli
+
+.PHONY: test_texi
+test_texi:
+	$(MKDIR) $@
+	$(OCAMLDOC_RUN) -texi -sort -d $@ $(INCLUDES) odoc*.ml odoc*.mli
+
+# stdlib non-prefixed :
+#######################
+SRC=$(ROOTDIR)
+
+# Documented modules: stdlib + otherlib + utils(?) + parsing(for compiler-libs)
+
+include Makefile.docfiles
+
+stdlib_man/Stdlib.3o: $(OCAMLDOC) $(DOC_ALL)
+	$(MKDIR) stdlib_man
+	$(OCAMLDOC_RUN) -man -d stdlib_man -nostdlib \
+	-hide Stdlib -lib Stdlib $(DOC_ALL_INCLUDES) \
+	-pp "$(AWK) -v ocamldoc=true -f $(SRC)/stdlib/expand_module_aliases.awk" \
+	-t "OCaml library" -man-mini \
+	$(DOC_ALL_TEXT:%=-text %) \
+	$(DOC_ALL_MLIS)
+
+stdlib_html/Stdlib.html: $(OCAMLDOC) $(DOC_ALL)
+	$(MKDIR) stdlib_html
+	$(OCAMLDOC_RUN) -html -d stdlib_html -nostdlib \
+	-hide Stdlib -lib Stdlib $(DOC_ALL_INCLUDES) \
+	-pp "$(AWK) -v ocamldoc=true -f $(SRC)/stdlib/expand_module_aliases.awk" \
+	-t "OCaml library" \
+	$(DOC_ALL_TEXT:%=-text %) \
+	$(DOC_ALL_MLIS)
+
+stdlib_texi/stdlib.texi: $(OCAMLDOC) $(DOC_ALL)
+	$(MKDIR) stdlib_texi
+	$(OCAMLDOC_RUN) -texi -o stdlib_texi/stdlib.texi -nostdlib \
+	-hide Stdlib -lib Stdlib $(DOC_ALL_INCLUDES) \
+	-pp "$(AWK) -v ocamldoc=true -f $(SRC)/stdlib/expand_module_aliases.awk" \
+	-t "OCaml library" \
+	$(DOC_ALL_TEXT:%=-text %) \
+	$(DOC_ALL_MLIS)
+
+
+stdlib_latex/stdlib.tex: $(OCAMLDOC) $(DOC_ALL)
+	$(MKDIR) stdlib_latex
+	$(OCAMLDOC_RUN) -latex -o stdlib_latex/stdlib.tex -nostdlib \
+	-hide Stdlib -lib Stdlib $(DOC_ALL_INCLUDES) \
+	-pp "$(AWK) -v ocamldoc=true -f $(SRC)/stdlib/expand_module_aliases.awk" \
+	-t "OCaml library" \
+	$(DOC_ALL_TEXT:%=-text %) \
+	$(DOC_ALL_MLIS)
+
+stdlib_latex/stdlib.pdf: stdlib_latex/stdlib.tex
+	cd stdlib_latex && pdflatex stdlib && pdflatex stdlib
+
+
+.PHONY: autotest_stdlib
+autotest_stdlib:
+	$(MKDIR) $@
+	$(OCAMLDOC_RUN_PLUGINS) -g autotest/odoc_test.cmo\
+	$(INCLUDES) -keep-code \
+	$(ROOTDIR)/stdlib/*.mli \
+	$(ROOTDIR)/otherlibs/$(UNIXLIB)/unix.mli \
+	$(ROOTDIR)/otherlibs/str/str.mli
+
+
+# odoc rules :
+##############
+
+.PHONY: odoc
+odoc:
+	rm -rf odoc
+	$(MKDIR) odoc
+	# .cmti --> .odoc
+	for fn in $(ROOTDIR)/stdlib/stdlib*.cmti; do \
+	  odoc compile $(INCLUDES) --package stdlib $(ROOTDIR)/stdlib/$$fn; \
+	done
+	for lib in str bigarray; do \
+	  odoc compile $(INCLUDES) --package $$lib $(ROOTDIR)/otherlibs/$$lib/$$lib.cmti; \
+	done
+	odoc compile $(INCLUDES) --package unix $(ROOTDIR)/otherlibs/$(UNIXLIB)/unix.cmti
+	for fn in $(ROOTDIR)/parsing/*.cmti; do \
+	  odoc compile $(INCLUDES) --package parsing $(ROOTDIR)/parsing/$$fn; \
+	done
+	# .odoc --> .html
+	odoc html $(INCLUDES) --output-dir odoc $(ROOTDIR)/stdlib/stdlib.odoc
+	for lib in str bigarray $(UNIXLIB); do \
+	  odoc html $(INCLUDES) --output-dir odoc $(ROOTDIR)/otherlibs/$$lib/$$lib.odoc; \
+	done
+	for fn in $(ROOTDIR)/parsing/*.odoc; do \
+	  odoc html $(INCLUDES) --output-dir odoc $$fn; \
+	done
+	for d in odoc/*; do \
+	  lib=`basename $$d`; \
+	  cd $$d; \
+	  echo -e The $$lib 'library.\n\nModules\n:{!modules:' * '}' > ../../index.mld; \
+	  cd ../..; \
+	  odoc html $(INCLUDES) --output-dir odoc --index-for=$$lib index.mld; \
+	  rm -f index.mld; \
+	done
+	cp odoc_index.html odoc/index.html
+	odoc css -o odoc
+
+# backup, clean and depend :
+############################
+
+.PHONY: clean
+clean:
+	rm -f \#*\#
+	rm -f $(OCAMLDOC) $(OCAMLDOC_OPT) *.cma *.cmxa *.cmo *.cmi *.cmx *.cmt *.cmti *.a *.lib *.o *.obj
+	rm -f odoc_parser.output odoc_text_parser.output
+	rm -f odoc_lexer.ml odoc_text_lexer.ml odoc_see_lexer.ml odoc_ocamlhtml.ml
+	rm -f odoc_parser.ml odoc_parser.mli odoc_text_parser.ml odoc_text_parser.mli
+	rm -rf stdlib_man stdlib_html stdlib_texi stdlib_latex
+	rm -f generators/*.cm[taiox] generators/*.a generators/*.lib generators/*.o generators/*.obj \
+        generators/*.cmx[as]
+
+.PHONY: depend
+depend:
+	$(OCAMLYACC) odoc_text_parser.mly
+	$(OCAMLYACC) odoc_parser.mly
+	$(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_text_lexer.mll
+	$(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_lexer.mll
+	$(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_ocamlhtml.mll
+	$(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_see_lexer.mll
+	$(OCAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) *.mll *.mly *.ml *.mli > .depend
+	$(OCAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) -shared generators/*.ml >> .depend
+
+include .depend
diff --git a/ocamldoc/Makefile.docfiles b/ocamldoc/Makefile.docfiles
new file mode 100644
index 00000000..8cf2fd10
--- /dev/null
+++ b/ocamldoc/Makefile.docfiles
@@ -0,0 +1,64 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                          Florian Angeletti                             *
+#*                                                                        *
+#*   Copyright 2018                                                       *
+#*                                                                        *
+#*   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 the lists of mli file used by ocamldoc to generate the stdlib
+# + otherlibs + compilerlibs documentation
+
+-include $(SRC)/Makefile.config
+-include $(SRC)/stdlib/StdlibModules
+PARSING_MLIS := $(wildcard $(SRC)/parsing/*.mli)
+UTILS_MLIS := $(wildcard $(SRC)/utils/*.mli)
+STR_MLIS = $(addprefix $(SRC)/otherlibs/str/, str.mli)
+UNIX_MLIS = $(addprefix $(SRC)/otherlibs/unix/, unix.mli unixLabels.mli)
+DYNLINK_MLIS = $(addprefix $(SRC)/otherlibs/dynlink/, dynlink.mli)
+THREAD_MLIS = $(addprefix $(SRC)/otherlibs/systhreads/, \
+  thread.mli condition.mli mutex.mli event.mli threadUnix.mli)
+DRIVER_MLIS = $(SRC)/driver/pparse.mli
+
+
+DOC_STDLIB_DIRS = stdlib \
+	otherlibs/str \
+	otherlibs/$(UNIXLIB) otherlibs/dynlink \
+	otherlibs/systhreads
+
+DOC_COMPILERLIBS_DIRS= parsing utils typing bytecomp driver file_formats lambda
+
+DOC_ALL_DIRS = $(DOC_COMPILERLIBS) $(DOC_STDLIB_DIRS)
+
+DOC_STDLIB_INCLUDES = $(addprefix -I $(SRC)/, $(DOC_STDLIB_DIRS))
+DOC_COMPILERLIBS_INCLUDES = $(addprefix -I $(SRC)/, $(DOC_COMPILERLIBS_DIRS))
+
+DOC_ALL_INCLUDES = $(DOC_STDLIB_INCLUDES) $(DOC_COMPILERLIBS_INCLUDES)
+
+STDLIB_MOD_WP = $(filter-out stdlib__pervasives, $(STDLIB_MODULES))
+STDLIB_MLI0 = $(STDLIB_MOD_WP:%=$(SRC)/stdlib/%.mli)
+STDLIB_MLIS=\
+  $(STDLIB_MLI0:$(SRC)/stdlib/stdlib__%=$(SRC)/stdlib/%) \
+  $(STR_MLIS) \
+  $(UNIX_MLIS) \
+  $(THREAD_MLIS) \
+  $(DYNLINK_MLIS)
+
+COMPILERLIBS_MLIS=\
+  $(PARSING_MLIS) \
+  $(UTILS_MLIS) \
+  $(DRIVER_MLIS)
+
+DOC_STDLIB_TEXT = $(SRC)/stdlib/ocaml_operators.mld
+DOC_COMPILERLIBS_TEXT =  $(SRC)/manual/manual/library/compiler_libs.mld
+DOC_ALL_TEXT = $(DOC_STDLIB_TEXT) $(DOC_COMPILERLIBS_TEXT)
+
+
+DOC_ALL_MLIS= $(STDLIB_MLIS) $(COMPILERLIBS_MLIS)
+DOC_ALL = $(DOC_ALL_MLIS) $(DOC_ALL_TEXT)
diff --git a/ocamldoc/dune b/ocamldoc/dune
new file mode 100644
index 00000000..be7a042f
--- /dev/null
+++ b/ocamldoc/dune
@@ -0,0 +1,25 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+(ocamllex  odoc_lexer odoc_ocamlhtml odoc_see_lexer odoc_text_lexer)
+(ocamlyacc odoc_parser odoc_text_parser)
+
+(executable
+ (name odoc)
+ (modes byte)
+ (flags (:standard -nostdlib -w -9-32))
+ (libraries dynlink ocamlcommon stdlib runtime str unix))
+
+(rule
+ (copy odoc.exe ocamldoc.byte))
diff --git a/ocamldoc/generators/odoc_literate.ml b/ocamldoc/generators/odoc_literate.ml
new file mode 100644
index 00000000..aec19808
--- /dev/null
+++ b/ocamldoc/generators/odoc_literate.ml
@@ -0,0 +1,215 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Odoc_info
+module Naming = Odoc_html.Naming
+open Odoc_info.Value
+
+let p = Printf.bprintf
+let bp = Printf.bprintf
+let bs = Buffer.add_string
+
+module Html =
+  (val
+   (
+   match !Odoc_args.current_generator with
+     None -> (module Odoc_html.Generator : Odoc_html.Html_generator)
+   | Some (Odoc_gen.Html m) -> m
+   | _ ->
+       failwith
+         "A non-html generator is already set. Cannot install the Todo-list html generator"
+  ) : Odoc_html.Html_generator)
+;;
+
+module Generator =
+struct
+class html =
+  object (self)
+    inherit Html.html
+
+    method! private html_of_module_comment b text =
+      let br1, br2 =
+        match text with
+          [(Odoc_info.Title _)] -> false, false
+        | (Odoc_info.Title _) :: _ -> false, true
+        | _ -> true, true
+      in
+      if br1 then p b "
    ";
+      self#html_of_text b text;
+      if br2 then p b "

    \n"
+
+    method! private html_of_Title b n l_opt t =
+      let label1 = self#create_title_label (n, l_opt, t) in
+      p b "\n" (Naming.label_target label1);
+      p b "" n;
+      self#html_of_text b t;
+      p b "" n
+
+    val mutable code_id = 0
+    method private code_block b code =
+      code_id <- code_id + 1;
+      Printf.bprintf b
+      "\
+       \"+/-\"/"
+           code_id code_id code_id;
+      Printf.bprintf b "
    " code_id;
+      self#html_of_code b code;
+      Printf.bprintf b "
    "
+
+    (** Print html code for a value. *)
+    method! private html_of_value b v =
+      Odoc_info.reset_type_names ();
+      self#html_of_info b v.val_info;
+      bs b "
    ";
+      bs b (self#keyword "val");
+      bs b " ";
+      (* html mark *)
+      bp b "" (Naming.value_target v);
+      bs b (self#escape (Name.simple v.val_name));
+      bs b " : ";
+      self#html_of_type_expr b (Name.father v.val_name) v.val_type;
+      bs b "
    ";
+      (
+       if !Odoc_html.with_parameter_list then
+         self#html_of_parameter_list b (Name.father v.val_name) v.val_parameters
+       else
+         self#html_of_described_parameter_list b (Name.father v.val_name) v.val_parameters
+      );
+      (
+       match v.val_code with
+         None -> ()
+       | Some code ->
+           self#code_block b code
+      )
+(*
+    (** Print html code for a module. *)
+    method private html_of_module b ?(info=true) ?(complete=true) ?(with_link=true) m =
+      let (html_file, _) = Naming.html_files m.m_name in
+      let father = Name.father m.m_name in
+      bs b "
    ";
+      bs b ((self#keyword "module")^" ");
+      (
+       if with_link then
+         bp b "%s" html_file (Name.simple m.m_name)
+       else
+         bs b (Name.simple m.m_name)
+      );
+(*      A remettre quand on compilera avec ocaml 3.10
+         (
+       match m.m_kind with
+         Module_functor _ when !Odoc_info.Args.html_short_functors  ->
+           ()
+
+       | _ -> *) bs b ": ";
+      (*
+      );
+      *)
+      self#html_of_module_kind b father ~modu: m m.m_kind;
+      bs b "
    ";
+      if info && complete then
+        self#html_of_info ~indent: false b m.m_info
+
+*)
+    initializer
+      default_style_options <-
+        ["a:visited {color : #416DFF; text-decoration : none; }" ;
+          "a:link {color : #416DFF; text-decoration : none;}" ;
+          "a:hover {color : Red; text-decoration : none; background-color: #5FFF88}" ;
+          "a:active {color : Red; text-decoration : underline; }" ;
+          ".keyword { font-weight : bold ; color : Red }" ;
+          ".keywordsign { color : #C04600 }" ;
+          ".superscript { font-size : 0.6em }" ;
+          ".subscript { font-size : 0.6em }" ;
+          ".comment { color : Green }" ;
+          ".constructor { color : Blue }" ;
+          ".type { color : #5C6585 }" ;
+          ".string { color : Maroon }" ;
+          ".warning { color : Red ; font-weight : bold }" ;
+          ".info { margin-top: 8px; }";
+          ".param_info { margin-top: 4px; margin-left : 3em; margin-right : 3em }" ;
+          ".code { color : #465F91 ; }" ;
+          "h1 { font-size : 20pt ; text-align: center; }" ;
+
+          "h2 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #90BDFF ;"^
+            "padding: 2px; }" ;
+
+          "h3 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #90DDFF ;"^
+            "padding: 2px; }" ;
+
+          "h4 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #90EDFF ;"^
+            "padding: 2px; }" ;
+
+          "h5 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #90FDFF ;"^
+            "padding: 2px; }" ;
+
+          "h6 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #C0FFFF ; "^
+            "padding: 2px; }" ;
+
+          "div.h7 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #E0FFFF ; "^
+            "padding: 2px; }" ;
+
+          "div.h8 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #F0FFFF ; "^
+            "padding: 2px; }" ;
+
+          "div.h9 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #FFFFFF ; "^
+            "padding: 2px; }" ;
+
+          ".typetable { border-style : hidden }" ;
+          ".indextable { border-style : hidden }" ;
+          ".paramstable { border-style : hidden ; padding: 5pt 5pt}" ;
+          "body { background-color : White }" ;
+          "tr { background-color : White }" ;
+          "td.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;}" ;
+          "pre { margin-bottom: 4px ; margin-left: 1em; "^
+            "border-color: #27408b; border-style: solid; "^
+            "border-width: 1px 1px 1px 3px; "^
+            "padding: 4px; }" ;
+          "div.sig_block {margin-left: 2em}" ;
+
+          "div.codeblock { "^
+            "margin-left: 2em; margin-right: 1em; padding: 6px; "^
+            "margin-bottom: 8px; display: none; "^
+            "border-width: 1px 1px 1px 3px; border-style: solid; border-color: grey; }" ;
+
+          "span.code_expand { color: blue; text-decoration: underline; cursor: pointer; "^
+          "margin-left: 1em ; } ";
+        ];
+  end
+end
+
+let _ = Odoc_args.set_generator
+ (Odoc_gen.Html (module Generator : Odoc_html.Html_generator))
+ ;;
diff --git a/ocamldoc/generators/odoc_todo.ml b/ocamldoc/generators/odoc_todo.ml
new file mode 100644
index 00000000..ae90cbff
--- /dev/null
+++ b/ocamldoc/generators/odoc_todo.ml
@@ -0,0 +1,235 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2010 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** An OCamldoc generator to retrieve information in "todo" tags and
+   generate an html page with all todo items. *)
+
+open Odoc_info
+module Naming = Odoc_html.Naming
+open Odoc_info.Value
+open Odoc_info.Module
+open Odoc_info.Type
+open Odoc_info.Extension
+open Odoc_info.Exception
+open Odoc_info.Class
+
+let p = Printf.bprintf
+
+module Html =
+  (val
+   (
+   match !Odoc_args.current_generator with
+     None -> (module Odoc_html.Generator : Odoc_html.Html_generator)
+   | Some (Odoc_gen.Html m) -> m
+   | _ ->
+       failwith
+         "A non-html generator is already set. Cannot install the Todo-list html generator"
+  ) : Odoc_html.Html_generator)
+;;
+
+module Generator =
+struct
+  class scanner html =
+    object (self)
+      inherit Odoc_info.Scan.scanner
+
+    val b = Buffer.create 256
+    method buffer = b
+
+    method private gen_if_tag name target info_opt =
+      match info_opt with
+        None -> ()
+      | Some i ->
+          let l =
+            List.fold_left
+              (fun acc (t, text) ->
+                 match t with
+                   "todo" ->
+                     begin
+                       match text with
+                         (Odoc_info.Code s) :: q ->
+                           (
+                            try
+                              let n = int_of_string s in
+                              let head =
+                                Odoc_info.Code (Printf.sprintf "[%d] " n)
+                              in
+                              (Some n, head::q) :: acc
+                            with _ -> (None, text) :: acc
+                           )
+                       | _ -> (None, text) :: acc
+
+                     end
+                 | _ -> acc
+              )
+              []
+              i.i_custom
+          in
+          match l with
+            [] -> ()
+          | _ ->
+              let l = List.sort
+                (fun a b ->
+                   match a, b with
+                     (None, _), _ -> -1
+                   | _, (None, _) -> 1
+                   | (Some n1, _), (Some n2, _) -> compare n1 n2
+                )
+                l
+              in
+              p b "
    %s
    "
+                target name;
+              let col = function
+                None -> "#000000"
+              | Some 1 -> "#FF0000"
+              | Some 2 -> "#AA5555"
+              | Some 3 -> "#44BB00"
+              | Some n -> Printf.sprintf "#%2x0000" (0xAA - (n * 0x10))
+              in
+              List.iter
+                (fun (n, e) ->
+                   Printf.bprintf b "" (col n);
+                   html#html_of_text ?with_p:(Some false) b e;
+                   p b "
    \n";
+                )
+                l;
+              p b "
    "
+
+    method! scan_value v =
+      self#gen_if_tag
+        v.val_name
+        (Odoc_html.Naming.complete_value_target v)
+        v.val_info
+
+    method! scan_type t =
+      self#gen_if_tag
+        t.ty_name
+        (Odoc_html.Naming.complete_type_target t)
+        t.ty_info
+
+    method! scan_extension_constructor x =
+      self#gen_if_tag
+        x.xt_name
+        (Odoc_html.Naming.complete_extension_target x)
+        x.xt_type_extension.te_info
+
+    method! scan_exception e =
+      self#gen_if_tag
+        e.ex_name
+        (Odoc_html.Naming.complete_exception_target e)
+        e.ex_info
+
+    method! scan_attribute a =
+      self#gen_if_tag
+        a.att_value.val_name
+        (Odoc_html.Naming.complete_attribute_target a)
+        a.att_value.val_info
+
+    method! scan_method m =
+      self#gen_if_tag
+        m.met_value.val_name
+        (Odoc_html.Naming.complete_method_target m)
+        m.met_value.val_info
+
+   (** This method scans the elements of the given module. *)
+    method! scan_module_elements m =
+      List.iter
+        (fun ele ->
+          match ele with
+            Odoc_module.Element_module m -> self#scan_module m
+          | Odoc_module.Element_module_type mt -> self#scan_module_type mt
+          | Odoc_module.Element_included_module im -> self#scan_included_module im
+          | Odoc_module.Element_class c -> self#scan_class c
+          | Odoc_module.Element_class_type ct -> self#scan_class_type ct
+          | Odoc_module.Element_value v -> self#scan_value v
+          | Odoc_module.Element_type_extension te -> self#scan_type_extension te
+          | Odoc_module.Element_exception e -> self#scan_exception e
+          | Odoc_module.Element_type t -> self#scan_type t
+          | Odoc_module.Element_module_comment t -> self#scan_module_comment t
+        )
+        (Odoc_module.module_elements ~trans: false m)
+
+    method! scan_included_module _ = ()
+
+    method! scan_class_pre c =
+      self#gen_if_tag
+        c.cl_name
+        (fst (Odoc_html.Naming.html_files c.cl_name))
+        c.cl_info;
+      true
+
+    method! scan_class_type_pre ct =
+      self#gen_if_tag
+        ct.clt_name
+        (fst (Odoc_html.Naming.html_files ct.clt_name))
+        ct.clt_info;
+      true
+
+    method! scan_module_pre m =
+      self#gen_if_tag
+        m.m_name
+        (fst (Odoc_html.Naming.html_files m.m_name))
+        m.m_info;
+      true
+
+    method! scan_module_type_pre mt =
+      self#gen_if_tag
+        mt.mt_name
+        (fst (Odoc_html.Naming.html_files mt.mt_name))
+        mt.mt_info;
+      true
+  end
+
+  class html : Html.html =
+    object (self)
+      inherit Html.html as html
+
+      (** we have to hack a little because we cannot inherit from
+             scanner, since public method cannot be hidden and
+             our html class must respect the type of the default
+             html generator class *)
+      val mutable scanner = new scanner (new Html.html )
+
+      method! generate modules =
+      (* prevent having the 'todo' tag signaled as not handled *)
+      tag_functions <-  ("todo", (fun _ -> "")) :: tag_functions;
+      (* generate doc as usual *)
+      html#generate modules;
+      (* then retrieve the todo tags and generate the todo.html page *)
+      let title =
+        match !Odoc_info.Global.title with
+          None -> ""
+        | Some s -> s
+      in
+      let b = Buffer.create 512 in
+      p b "";
+      self#print_header b title ;
+      p b "
    %s
    " title;
+      scanner#scan_module_list modules;
+      Buffer.add_buffer b scanner#buffer;
+      let oc = open_out
+          (Filename.concat !Odoc_info.Global.target_dir "todo.html")
+      in
+      Buffer.output_buffer oc b;
+      close_out oc
+
+     initializer
+       scanner <- new scanner self
+  end
+end
+
+let _ = Odoc_args.set_generator
+ (Odoc_gen.Html (module Generator : Odoc_html.Html_generator))
+ ;;
diff --git a/ocamldoc/ocamldoc.hva b/ocamldoc/ocamldoc.hva
new file mode 100644
index 00000000..cd5bce0f
--- /dev/null
+++ b/ocamldoc/ocamldoc.hva
@@ -0,0 +1,34 @@
+%**************************************************************************
+%*                                                                        *
+%*                                 OCaml                                  *
+%*                                                                        *
+%*          Maxence Guesdon, projet Cristal, INRIA Rocquencourt           *
+%*                                                                        *
+%*   Copyright 2001 Institut National de Recherche en Informatique et     *
+%*     en Automatique.                                                    *
+%*                                                                        *
+%*   All rights reserved.  This file is distributed under the terms of    *
+%*   the GNU Lesser General Public License version 2.1, with the          *
+%*   special exception on linking described in the file LICENSE.          *
+%*                                                                        *
+%**************************************************************************
+
+\usepackage{alltt}
+\newenvironment{ocamldoccode}{\begin{alltt}}{\end{alltt}}
+\newenvironment{ocamldocdescription}{\begin{quote}}{\end{quote}}
+\newenvironment{ocamldoccomment}{\begin{quote}}{\end{quote}}
+\newcommand\textbar{|}
+\newcommand\textbackslash{\begin{rawhtml}\\end{rawhtml}}
+\newcommand\textasciicircum{\^{}}
+\newcommand\hash{#}
+
+\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}
diff --git a/ocamldoc/ocamldoc.sty b/ocamldoc/ocamldoc.sty
new file mode 100644
index 00000000..6a8ef1e9
--- /dev/null
+++ b/ocamldoc/ocamldoc.sty
@@ -0,0 +1,58 @@
+%% 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\relax}
+{\endlist\medskip}
+
+\newenvironment{ocamldoccomment}
+{\list{}{\leftmargin 2\leftmargini \rightmargin0pt \topsep0pt}\raggedright\item\relax}
+{\endlist}
+
+\let\ocamldocvspace\vspace
+\endinput
diff --git a/ocamldoc/odoc.ml b/ocamldoc/odoc.ml
new file mode 100644
index 00000000..b49aa1b1
--- /dev/null
+++ b/ocamldoc/odoc.ml
@@ -0,0 +1,133 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Main module for bytecode.
+@todo todo*)
+
+module M = Odoc_messages
+
+let print_DEBUG s = print_string s ; print_newline ()
+
+(* we check if we must load a module given on the command line *)
+let arg_list = Array.to_list Sys.argv
+let (plugins, paths) =
+  let rec iter (files, incs) = function
+      [] | _ :: [] -> (List.rev files, List.rev incs)
+    | "-g" :: file :: q when
+        ((Filename.check_suffix file "cmo") ||
+         (Filename.check_suffix file "cma") ||
+           (Filename.check_suffix file "cmxs")) ->
+      iter (file :: files, incs) q
+  | "-i" :: dir :: q ->
+      iter (files, dir :: incs) q
+  | _ :: q ->
+        iter (files, incs) q
+  in
+  iter ([], []) arg_list
+
+let _ = print_DEBUG "Fin analyse des arguments pour le dynamic load"
+
+(** Return the real name of the file to load,
+   searching it in the paths if it is
+   a simple name and not in the current directory. *)
+let get_real_filename name =
+   if Filename.basename name <> name then
+     name
+   else
+     (
+      let paths = Filename.current_dir_name :: paths @ [Odoc_config.custom_generators_path] in
+      try
+        let d = List.find
+            (fun d -> Sys.file_exists (Filename.concat d name))
+            paths
+        in
+        Filename.concat d name
+      with
+        Not_found ->
+          failwith (M.file_not_found_in_paths paths name)
+     )
+
+let load_plugin file =
+  let file = Dynlink.adapt_filename file in
+  Dynlink.allow_unsafe_modules true;
+  try
+    let real_file = get_real_filename file in
+    ignore(Dynlink.loadfile real_file)
+  with
+    Dynlink.Error e ->
+      prerr_endline (Odoc_messages.load_file_error file (Dynlink.error_message e)) ;
+      exit 1
+  | Not_found ->
+      prerr_endline (Odoc_messages.load_file_error file "Not_found");
+      exit 1
+  | Sys_error s
+  | Failure s ->
+      prerr_endline (Odoc_messages.load_file_error file s);
+      exit 1
+;;
+List.iter load_plugin plugins;;
+
+let () = print_DEBUG "Fin du chargement dynamique eventuel"
+
+let () = Odoc_args.parse ()
+
+
+let loaded_modules =
+  List.flatten
+    (List.map
+       (fun f ->
+         Odoc_info.verbose (Odoc_messages.loading f);
+         try
+           let l = Odoc_analyse.load_modules f in
+           Odoc_info.verbose Odoc_messages.ok;
+           l
+         with Failure s ->
+           prerr_endline s ;
+           incr Odoc_global.errors ;
+           []
+       )
+       !Odoc_global.load
+    )
+
+let modules = Odoc_analyse.analyse_files ~init: loaded_modules !Odoc_global.files
+
+let _ =
+  match !Odoc_global.dump with
+    None -> ()
+  | Some f ->
+      try Odoc_analyse.dump_modules f modules
+      with Failure s ->
+        prerr_endline s ;
+        incr Odoc_global.errors
+
+
+let _ =
+  match !Odoc_args.current_generator with
+    None ->
+      ()
+  | Some gen ->
+      let generator = Odoc_gen.get_minimal_generator gen in
+      Odoc_info.verbose Odoc_messages.generating_doc;
+      generator#generate modules;
+      Odoc_info.verbose Odoc_messages.ok
+
+let _ =
+  if !Odoc_global.errors > 0 then
+  (
+   prerr_endline (Odoc_messages.errors_occured !Odoc_global.errors) ;
+   exit 1
+  )
+  else
+    exit 0
diff --git a/ocamldoc/odoc_analyse.ml b/ocamldoc/odoc_analyse.ml
new file mode 100644
index 00000000..ab29fe7b
--- /dev/null
+++ b/ocamldoc/odoc_analyse.ml
@@ -0,0 +1,476 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Analysis of source files. This module is strongly inspired from
+    driver/main.ml :-) *)
+
+let print_DEBUG s = print_string s ; print_newline ()
+
+open Format
+open Typedtree
+
+
+(** Initialize the search path.
+   The current directory is always searched first,
+   then the directories specified with the -I option (in command-line order),
+   then the standard library directory. *)
+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 initial = !Odoc_global.initially_opened_module in
+  let initially_opened_module =
+    if initial = current then
+      None
+    else
+      Some initial
+  in
+  let open_implicit_modules =
+    let ln = !Odoc_global.library_namespace in
+    let ln = if current = ln || ln = initial || ln = "" then [] else [ln] in
+    ln @ List.rev !Clflags.open_modules in
+  Typemod.initial_env
+    ~loc:(Location.in_file "ocamldoc command line")
+    ~safe_string:(Config.safe_string || not !Clflags.unsafe_string)
+    ~open_implicit_modules
+    ~initially_opened_module
+
+(** Optionally preprocess a source file *)
+let preprocess sourcefile =
+  try
+    Pparse.preprocess sourcefile
+  with Pparse.Error err ->
+    Format.eprintf "Preprocessing error@.%a@."
+      Pparse.report_error err;
+    exit 2
+
+(** Analysis of an implementation file. Returns (Some typedtree) if
+   no error occurred, else None and an error message is printed.*)
+
+let tool_name = "ocamldoc"
+
+(** Deactivate the generation of docstrings in the lexer *)
+let no_docstring f x =
+  Lexer.handle_docstrings := false;
+  let result = f x in
+  Lexer.handle_docstrings := true;
+  result
+
+let process_implementation_file sourcefile =
+  init_path ();
+  let prefixname = Filename.chop_extension sourcefile in
+  let modulename = String.capitalize_ascii(Filename.basename prefixname) in
+  Env.set_unit_name modulename;
+  let inputfile = preprocess sourcefile in
+  let env = initial_env () in
+  try
+    let parsetree =
+      Pparse.file ~tool_name inputfile
+        (no_docstring Parse.implementation) Pparse.Structure
+    in
+    let typedtree =
+      Typemod.type_implementation
+        sourcefile prefixname modulename env parsetree
+    in
+    (Some (parsetree, typedtree), inputfile)
+  with
+  | Syntaxerr.Error _ as exn ->
+      begin match Location.error_of_exn exn with
+      | Some (`Ok err) ->
+          fprintf Format.err_formatter "@[%a@]@."
+            Location.print_report err
+      | _ ->
+          assert false
+      end;
+      None, inputfile
+  | Failure s ->
+      prerr_endline s;
+      incr Odoc_global.errors ;
+      None, inputfile
+
+(** Analysis of an interface file. Returns (Some signature) if
+   no error occurred, else None and an error message is printed.*)
+let process_interface_file sourcefile =
+  init_path ();
+  let prefixname = Filename.chop_extension sourcefile in
+  let modulename = String.capitalize_ascii(Filename.basename prefixname) in
+  Env.set_unit_name modulename;
+  let inputfile = preprocess sourcefile in
+  let ast =
+    Pparse.file ~tool_name inputfile
+      (no_docstring Parse.interface) Pparse.Signature
+  in
+  let sg = Typemod.type_interface (initial_env()) ast in
+  Warnings.check_fatal ();
+  (ast, sg, inputfile)
+
+(** The module used to analyse the parsetree and signature of an implementation file.*)
+module Ast_analyser = Odoc_ast.Analyser (Odoc_comments.Basic_info_retriever)
+
+(** The module used to analyse the parse tree and typed tree of an interface file.*)
+module Sig_analyser = Odoc_sig.Analyser (Odoc_comments.Basic_info_retriever)
+
+(** Handle an error. *)
+
+let process_error exn =
+  try Location.report_exception Format.err_formatter exn
+  with exn ->
+    fprintf Format.err_formatter
+      "Compilation error(%s). Use the OCaml compiler to get more details.@."
+      (Printexc.to_string exn)
+
+(** Process the given file, according to its extension. Return the Module.t created, if any.*)
+let process_file sourcefile =
+  if !Odoc_global.verbose then
+    (
+     let f = match sourcefile with
+       Odoc_global.Impl_file f
+     | Odoc_global.Intf_file f -> f
+     | Odoc_global.Text_file f -> f
+     in
+     print_string (Odoc_messages.analysing f) ;
+     print_newline ();
+    );
+  match sourcefile with
+    Odoc_global.Impl_file file ->
+      (
+       Location.input_name := file;
+       try
+         let (parsetree_typedtree_opt, input_file) = process_implementation_file file in
+         match parsetree_typedtree_opt with
+           None ->
+             None
+         | Some (parsetree, typedtree) ->
+             let file_module = Ast_analyser.analyse_typed_tree file
+                 input_file parsetree typedtree
+             in
+             file_module.Odoc_module.m_top_deps <- Odoc_dep.impl_dependencies parsetree ;
+
+             if !Odoc_global.verbose then
+               (
+                print_string Odoc_messages.ok;
+                print_newline ()
+               );
+             Pparse.remove_preprocessed input_file;
+             Some file_module
+       with
+       | Sys_error s
+       | Failure s ->
+           prerr_endline s ;
+           incr Odoc_global.errors ;
+           None
+       | e ->
+           process_error e ;
+           incr Odoc_global.errors ;
+           None
+      )
+  | Odoc_global.Intf_file file ->
+      (
+       Location.input_name := file;
+       try
+         let (ast, signat, input_file) = process_interface_file file in
+         let file_module = Sig_analyser.analyse_signature file
+             input_file ast signat.sig_type
+         in
+
+         file_module.Odoc_module.m_top_deps <- Odoc_dep.intf_dependencies ast ;
+
+         if !Odoc_global.verbose then
+           (
+            print_string Odoc_messages.ok;
+            print_newline ()
+           );
+         Pparse.remove_preprocessed input_file;
+         Some file_module
+       with
+       | Sys_error s
+       | Failure s ->
+           prerr_endline s;
+           incr Odoc_global.errors ;
+           None
+       | e ->
+           process_error e ;
+           incr Odoc_global.errors ;
+           None
+      )
+  | Odoc_global.Text_file file ->
+      Location.input_name := file;
+      try
+        let mod_name =
+          let s =
+            try Filename.chop_extension file
+            with _ -> file
+          in
+          String.capitalize_ascii (Filename.basename s)
+        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) ->
+            raise (Failure (Odoc_messages.text_parse_error l c s))
+        in
+         let m_info =
+          Some Odoc_types.{dummy_info with i_desc= Some txt } in
+        let m =
+          {
+            Odoc_module.m_name = mod_name ;
+            Odoc_module.m_type = Types.Mty_signature [] ;
+            Odoc_module.m_info;
+            Odoc_module.m_is_interface = true ;
+            Odoc_module.m_file = file ;
+            Odoc_module.m_kind = Odoc_module.Module_struct [] ;
+            Odoc_module.m_loc =
+              { Odoc_types.loc_impl = None ;
+                Odoc_types.loc_inter = Some (Location.in_file file) } ;
+            Odoc_module.m_top_deps = [] ;
+            Odoc_module.m_code = None ;
+            Odoc_module.m_code_intf = None ;
+            Odoc_module.m_text_only = true ;
+          }
+        in
+        Some m
+      with
+       | Sys_error s
+       | Failure s ->
+           prerr_endline s;
+           incr Odoc_global.errors ;
+           None
+       | e ->
+           process_error e ;
+           incr Odoc_global.errors ;
+           None
+
+(** Remove the class elements between the stop special comments. *)
+let rec remove_class_elements_between_stop keep eles =
+  match eles with
+    [] -> []
+  | ele :: q ->
+      match ele with
+        Odoc_class.Class_comment [ Odoc_types.Raw "/*" ] ->
+          remove_class_elements_between_stop (not keep) q
+      | Odoc_class.Class_attribute _
+      | Odoc_class.Class_method _
+      | Odoc_class.Class_comment _ ->
+          if keep then
+            ele :: (remove_class_elements_between_stop keep q)
+          else
+            remove_class_elements_between_stop keep q
+
+(** Remove the class elements between the stop special comments in a class kind. *)
+let rec remove_class_elements_between_stop_in_class_kind k =
+  match k with
+    Odoc_class.Class_structure (inher, l) ->
+      Odoc_class.Class_structure (inher, remove_class_elements_between_stop true l)
+  | Odoc_class.Class_apply _ -> k
+  | Odoc_class.Class_constr _ -> k
+  | Odoc_class.Class_constraint (k1, ctk) ->
+      Odoc_class.Class_constraint (remove_class_elements_between_stop_in_class_kind k1,
+                        remove_class_elements_between_stop_in_class_type_kind ctk)
+
+(** Remove the class elements between the stop special comments in a class type kind. *)
+and remove_class_elements_between_stop_in_class_type_kind tk =
+  match tk with
+    Odoc_class.Class_signature (inher, l) ->
+      Odoc_class.Class_signature (inher, remove_class_elements_between_stop true l)
+  | Odoc_class.Class_type _ -> tk
+
+
+(** Remove the module elements between the stop special comments. *)
+let rec remove_module_elements_between_stop keep eles =
+  let f = remove_module_elements_between_stop in
+  match eles with
+    [] -> []
+  | ele :: q ->
+      match ele with
+        Odoc_module.Element_module_comment [ Odoc_types.Raw "/*" ] ->
+          f (not keep) q
+      | Odoc_module.Element_module_comment _ ->
+          if keep then
+            ele :: (f keep q)
+          else
+            f keep q
+      | Odoc_module.Element_module m ->
+          if keep then
+            (
+             m.Odoc_module.m_kind <- remove_module_elements_between_stop_in_module_kind m.Odoc_module.m_kind ;
+             (Odoc_module.Element_module m) :: (f keep q)
+            )
+          else
+            f keep q
+      | Odoc_module.Element_module_type mt ->
+          if keep then
+            (
+             mt.Odoc_module.mt_kind <- Odoc_misc.apply_opt
+                 remove_module_elements_between_stop_in_module_type_kind mt.Odoc_module.mt_kind ;
+             (Odoc_module.Element_module_type mt) :: (f keep q)
+            )
+          else
+            f keep q
+      | Odoc_module.Element_included_module _ ->
+          if keep then
+            ele :: (f keep q)
+          else
+            f keep q
+      | Odoc_module.Element_class c ->
+          if keep then
+            (
+             c.Odoc_class.cl_kind <- remove_class_elements_between_stop_in_class_kind c.Odoc_class.cl_kind ;
+             (Odoc_module.Element_class c) :: (f keep q)
+            )
+          else
+            f keep q
+      | Odoc_module.Element_class_type ct ->
+          if keep then
+            (
+             ct.Odoc_class.clt_kind <- remove_class_elements_between_stop_in_class_type_kind ct.Odoc_class.clt_kind ;
+             (Odoc_module.Element_class_type ct) :: (f keep q)
+            )
+          else
+            f keep q
+      | Odoc_module.Element_value _
+      | Odoc_module.Element_type_extension _
+      | Odoc_module.Element_exception _
+      | Odoc_module.Element_type _ ->
+          if keep then
+            ele :: (f keep q)
+          else
+            f keep q
+
+
+(** Remove the module elements between the stop special comments, in the given module kind. *)
+and remove_module_elements_between_stop_in_module_kind k =
+  match k with
+  | Odoc_module.Module_struct l -> Odoc_module.Module_struct (remove_module_elements_between_stop true l)
+  | Odoc_module.Module_alias _ -> k
+  | Odoc_module.Module_functor (params, k2)  ->
+      Odoc_module.Module_functor (params, remove_module_elements_between_stop_in_module_kind k2)
+  | Odoc_module.Module_apply (k1, k2) ->
+      Odoc_module.Module_apply (remove_module_elements_between_stop_in_module_kind k1,
+                    remove_module_elements_between_stop_in_module_kind k2)
+  | Odoc_module.Module_with (mtkind, s) ->
+      Odoc_module.Module_with (remove_module_elements_between_stop_in_module_type_kind mtkind, s)
+  | Odoc_module.Module_constraint (k2, mtkind) ->
+      Odoc_module.Module_constraint (remove_module_elements_between_stop_in_module_kind k2,
+                         remove_module_elements_between_stop_in_module_type_kind mtkind)
+  | Odoc_module.Module_typeof _ -> k
+  | Odoc_module.Module_unpack _ -> k
+
+(** Remove the module elements between the stop special comment, in the given module type kind. *)
+and remove_module_elements_between_stop_in_module_type_kind tk =
+  match tk with
+  | Odoc_module.Module_type_struct l -> Odoc_module.Module_type_struct (remove_module_elements_between_stop true l)
+  | Odoc_module.Module_type_functor (params, tk2) ->
+      Odoc_module.Module_type_functor (params, remove_module_elements_between_stop_in_module_type_kind tk2)
+  | Odoc_module.Module_type_alias _ -> tk
+  | Odoc_module.Module_type_with (tk2, s) ->
+      Odoc_module.Module_type_with (remove_module_elements_between_stop_in_module_type_kind tk2, s)
+  | Odoc_module.Module_type_typeof _ -> tk
+
+(** Remove elements between the stop special comment. *)
+let remove_elements_between_stop module_list =
+  List.map
+    (fun m ->
+      m.Odoc_module.m_kind <- remove_module_elements_between_stop_in_module_kind m.Odoc_module.m_kind;
+      m
+    )
+    module_list
+
+(** This function builds the modules from the given list of source files. *)
+let analyse_files ?(init=[]) files =
+  let modules_pre =
+    init @
+    (List.fold_left
+       (fun acc -> fun file ->
+         try
+           match process_file file with
+             None ->
+               acc
+           | Some m ->
+               acc @ [ m ]
+         with
+           Failure s ->
+             prerr_endline s ;
+             incr Odoc_global.errors ;
+             acc
+       )
+       []
+       files
+    )
+  in
+  (* Remove elements between the stop special comments, if needed. *)
+  let modules =
+    if !Odoc_global.no_stop then
+      modules_pre
+    else
+      remove_elements_between_stop modules_pre
+  in
+
+
+  if !Odoc_global.verbose then
+    (
+     print_string Odoc_messages.merging;
+     print_newline ()
+    );
+  let merged_modules = Odoc_merge.merge !Odoc_global.merge_options modules in
+  if !Odoc_global.verbose then
+    (
+     print_string Odoc_messages.ok;
+     print_newline ();
+    );
+  let modules_list =
+    (List.fold_left
+       (fun acc -> fun m -> acc @ (Odoc_module.module_all_submodules ~trans: false m))
+       merged_modules
+       merged_modules
+    )
+  in
+  if !Odoc_global.verbose then
+    (
+     print_string Odoc_messages.cross_referencing;
+     print_newline ()
+    );
+  Odoc_cross.associate modules_list;
+
+  if !Odoc_global.verbose then
+    (
+     print_string Odoc_messages.ok;
+     print_newline ();
+    );
+
+  if !Odoc_global.sort_modules then
+    List.sort (fun m1 m2 -> compare m1.Odoc_module.m_name m2.Odoc_module.m_name) merged_modules
+  else
+    merged_modules
+
+let dump_modules file (modules : Odoc_module.t_module list) =
+  try
+    let chanout = open_out_bin file in
+    let dump = Odoc_types.make_dump modules in
+    output_value chanout dump;
+    close_out chanout
+  with
+    Sys_error s ->
+      raise (Failure s)
+
+let load_modules file =
+  try
+    let chanin = open_in_bin file in
+    let dump = input_value chanin in
+    close_in chanin ;
+    let (l : Odoc_module.t_module list) = Odoc_types.open_dump dump in
+    l
+  with
+    Sys_error s ->
+      raise (Failure s)
diff --git a/ocamldoc/odoc_analyse.mli b/ocamldoc/odoc_analyse.mli
new file mode 100644
index 00000000..52e9cf58
--- /dev/null
+++ b/ocamldoc/odoc_analyse.mli
@@ -0,0 +1,33 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Analysis of source files. *)
+
+(** This function builds the top modules from the analysis of the
+   given list of source files.
+   @param init is the list of modules already known from a previous analysis.
+*)
+val analyse_files :
+    ?init: Odoc_module.t_module list ->
+      Odoc_global.source_file list ->
+        Odoc_module.t_module list
+
+(** Dump of a list of modules into a file.
+   @raise Failure if an error occurs.*)
+val dump_modules : string -> Odoc_module.t_module list -> unit
+
+(** Load of a list of modules from a file.
+   @raise Failure if an error occurs.*)
+val load_modules : string -> Odoc_module.t_module list
diff --git a/ocamldoc/odoc_args.ml b/ocamldoc/odoc_args.ml
new file mode 100644
index 00000000..46fcb58b
--- /dev/null
+++ b/ocamldoc/odoc_args.ml
@@ -0,0 +1,387 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Command-line arguments. *)
+
+module M = Odoc_messages
+
+let current_generator = ref (None : Odoc_gen.generator option)
+
+let get_html_generator () =
+  match !current_generator with
+    None -> (module Odoc_html.Generator : Odoc_html.Html_generator)
+  | Some (Odoc_gen.Html m) -> m
+  | Some _ -> failwith (M.current_generator_is_not "html")
+;;
+
+let get_latex_generator () =
+  match !current_generator with
+    None -> (module Odoc_latex.Generator : Odoc_latex.Latex_generator)
+  | Some (Odoc_gen.Latex m) -> m
+  | Some _ -> failwith (M.current_generator_is_not "latex")
+;;
+
+let get_texi_generator () =
+  match !current_generator with
+    None -> (module Odoc_texi.Generator : Odoc_texi.Texi_generator)
+  | Some (Odoc_gen.Texi m) -> m
+  | Some _ -> failwith (M.current_generator_is_not "texi")
+;;
+
+let get_man_generator () =
+  match !current_generator with
+    None -> (module Odoc_man.Generator : Odoc_man.Man_generator)
+  | Some (Odoc_gen.Man m) -> m
+  | Some _ -> failwith (M.current_generator_is_not "man")
+;;
+
+let get_dot_generator () =
+  match !current_generator with
+    None -> (module Odoc_dot.Generator : Odoc_dot.Dot_generator)
+  | Some (Odoc_gen.Dot m) -> m
+  | Some _ -> failwith (M.current_generator_is_not "dot")
+;;
+
+let get_base_generator () =
+  match !current_generator with
+    None -> (module Odoc_gen.Base_generator : Odoc_gen.Base)
+  | Some (Odoc_gen.Base m) -> m
+  | Some _ -> failwith (M.current_generator_is_not "base")
+;;
+
+let extend_html_generator f =
+  let current = get_html_generator () in
+  let module Current = (val current : Odoc_html.Html_generator) in
+  let module F = (val f : Odoc_gen.Html_functor) in
+  let module M = F(Current) in
+  current_generator := Some (Odoc_gen.Html (module M : Odoc_html.Html_generator))
+;;
+
+let extend_latex_generator f =
+  let current = get_latex_generator () in
+  let module Current = (val current : Odoc_latex.Latex_generator) in
+  let module F = (val f : Odoc_gen.Latex_functor) in
+  let module M = F(Current) in
+  current_generator := Some(Odoc_gen.Latex (module M : Odoc_latex.Latex_generator))
+;;
+
+let extend_texi_generator f =
+  let current = get_texi_generator () in
+  let module Current = (val current : Odoc_texi.Texi_generator) in
+  let module F = (val f : Odoc_gen.Texi_functor) in
+  let module M = F(Current) in
+  current_generator := Some(Odoc_gen.Texi (module M : Odoc_texi.Texi_generator))
+;;
+
+let extend_man_generator f =
+  let current = get_man_generator () in
+  let module Current = (val current : Odoc_man.Man_generator) in
+  let module F = (val f : Odoc_gen.Man_functor) in
+  let module M = F(Current) in
+  current_generator := Some(Odoc_gen.Man (module M : Odoc_man.Man_generator))
+;;
+
+let extend_dot_generator f =
+  let current = get_dot_generator () in
+  let module Current = (val current : Odoc_dot.Dot_generator) in
+  let module F = (val f : Odoc_gen.Dot_functor) in
+  let module M = F(Current) in
+  current_generator := Some (Odoc_gen.Dot (module M : Odoc_dot.Dot_generator))
+;;
+
+let extend_base_generator f =
+  let current = get_base_generator () in
+  let module Current = (val current : Odoc_gen.Base) in
+  let module F = (val f : Odoc_gen.Base_functor) in
+  let module M = F(Current) in
+  current_generator := Some (Odoc_gen.Base (module M : Odoc_gen.Base))
+;;
+
+(** Analysis of a string defining options. Return the list of
+   options according to the list giving associations between
+   [(character, _)] and a list of options. *)
+let analyse_option_string l s =
+  List.fold_left
+    (fun acc -> fun ((c,_), v) ->
+      if String.contains s c then
+        acc @ v
+      else
+        acc)
+    []
+    l
+
+(** Analysis of a string defining the merge options to be used.
+   Returns the list of options specified.*)
+let analyse_merge_options s =
+  let l = [
+    (M.merge_description, [Odoc_types.Merge_description]) ;
+    (M.merge_author, [Odoc_types.Merge_author]) ;
+    (M.merge_version, [Odoc_types.Merge_version]) ;
+    (M.merge_see, [Odoc_types.Merge_see]) ;
+    (M.merge_since, [Odoc_types.Merge_since]) ;
+    (M.merge_before, [Odoc_types.Merge_before]) ;
+    (M.merge_deprecated, [Odoc_types.Merge_deprecated]) ;
+    (M.merge_param, [Odoc_types.Merge_param]) ;
+    (M.merge_raised_exception, [Odoc_types.Merge_raised_exception]) ;
+    (M.merge_return_value, [Odoc_types.Merge_return_value]) ;
+    (M.merge_custom, [Odoc_types.Merge_custom]) ;
+    (M.merge_all, Odoc_types.all_merge_options)
+  ]
+  in
+  analyse_option_string l s
+
+
+let f_latex_title s =
+  match String.split_on_char ',' s with
+  | [n;command] ->
+      let n = int_of_string n in
+      Odoc_latex.latex_titles := List.remove_assoc n !Odoc_latex.latex_titles ;
+      Odoc_latex.latex_titles := (n, command) :: !Odoc_latex.latex_titles
+  | _ ->
+      incr Odoc_global.errors ;
+      prerr_endline (M.wrong_format s)
+
+let f_texinfo_title s =
+  match String.split_on_char ',' s with
+  | [n;title;heading] ->
+      let n = int_of_string n in
+      Odoc_texi.titles_and_headings :=
+        (n, (title,heading) ) :: List.remove_assoc n !Odoc_texi.titles_and_headings;
+  | _ ->
+      incr Odoc_global.errors ;
+      prerr_endline (M.wrong_format s)
+
+let add_hidden_modules s =
+  let l = Str.split (Str.regexp ",") s in
+  List.iter
+    (fun n ->
+      let name = Str.global_replace (Str.regexp "[ \n\r\t]+") "" n in
+      match name with
+        "" -> ()
+      | _ ->
+          match name.[0] with
+            'A'..'Z' -> Odoc_global.hidden_modules := name :: !Odoc_global.hidden_modules
+          | _ ->
+              incr Odoc_global.errors;
+              prerr_endline (M.not_a_module_name name)
+    )
+    l
+
+let set_generator (g : Odoc_gen.generator) = current_generator := Some g
+
+let anonymous f =
+  let sf =
+    if Filename.check_suffix f "ml" then
+      Odoc_global.Impl_file f
+    else
+        if Filename.check_suffix f !Config.interface_suffix then
+        Odoc_global.Intf_file f
+      else
+        if Filename.check_suffix f "txt" then
+          Odoc_global.Text_file f
+        else
+          failwith (Odoc_messages.unknown_extension f)
+  in
+  Odoc_global.files := !Odoc_global.files @ [sf]
+
+module Options = Main_args.Make_ocamldoc_options(struct
+    include Main_args.Default.Odoc_args
+    let _I s = Odoc_global.include_dirs := s :: !Odoc_global.include_dirs
+    let _impl s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Impl_file s]
+    let _intf s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Intf_file s]
+end)
+
+(** The default option list *)
+let default_options = Options.list @
+[
+  "-initially-opened-module", Arg.Set_string Odoc_global.initially_opened_module,
+  M.initially_opened_module;
+  "-lib", Arg.Set_string Odoc_global.library_namespace, M.library_namespace;
+  "-text", Arg.String (fun s ->
+       Odoc_global.files := !Odoc_global.files @ [Odoc_global.Text_file s]),
+    M.option_text ;
+  "-warn-error", Arg.Set Odoc_global.warn_error, M.werr ;
+  "-show-missed-crossref", Arg.Set Odoc_global.show_missed_crossref,
+  M.show_missed_crossref;
+  "-hide-warnings", Arg.Clear Odoc_config.print_warnings, M.hide_warnings ;
+  "-o", Arg.String (fun s -> Odoc_global.out_file := s), M.out_file ;
+  "-d", Arg.String (fun s -> Odoc_global.target_dir := s), M.target_dir ;
+  "-sort", Arg.Unit (fun () -> Odoc_global.sort_modules := true), M.sort_modules ;
+  "-no-stop", Arg.Set Odoc_global.no_stop, M.no_stop ;
+  "-no-custom-tags", Arg.Set Odoc_global.no_custom_tags, M.no_custom_tags ;
+  "-stars", Arg.Set Odoc_global.remove_stars, M.remove_stars ;
+  "-inv-merge-ml-mli", Arg.Set Odoc_global.inverse_merge_ml_mli, M.inverse_merge_ml_mli ;
+  "-no-module-constraint-filter", Arg.Clear Odoc_global.filter_with_module_constraints,
+  M.no_filter_with_module_constraints ;
+
+  "-keep-code", Arg.Set Odoc_global.keep_code, M.keep_code^"\n" ;
+
+  "-dump", Arg.String (fun s -> Odoc_global.dump := Some s), M.dump ;
+  "-load", Arg.String (fun s -> Odoc_global.load := !Odoc_global.load @ [s]), M.load^"\n" ;
+
+  "-t", Arg.String (fun s -> Odoc_global.title := Some s), M.option_title ;
+  "-intro", Arg.String (fun s -> Odoc_global.intro_file := Some s), M.option_intro ;
+  "-hide", Arg.String add_hidden_modules, M.hide_modules ;
+  "-m", Arg.String (fun s -> Odoc_global.merge_options := !Odoc_global.merge_options @ (analyse_merge_options s)),
+  M.merge_options ^
+  "\n\n *** choosing a generator ***\n";
+
+(* generators *)
+  "-html", Arg.Unit (fun () ->
+    match !current_generator with
+      Some (Odoc_gen.Html _) -> ()
+    | _ -> set_generator
+             (Odoc_gen.Html (module Odoc_html.Generator : Odoc_html.Html_generator))),
+    M.generate_html ;
+  "-latex", Arg.Unit (fun () ->
+    match !current_generator with
+      Some (Odoc_gen.Latex _) -> ()
+    | _ -> set_generator
+             (Odoc_gen.Latex (module Odoc_latex.Generator : Odoc_latex.Latex_generator))),
+    M.generate_latex ;
+  "-texi", Arg.Unit (fun () ->
+    match !current_generator with
+      Some (Odoc_gen.Texi _) -> ()
+    | _ -> set_generator
+             (Odoc_gen.Texi (module Odoc_texi.Generator : Odoc_texi.Texi_generator))),
+    M.generate_texinfo ;
+  "-man", Arg.Unit (fun () ->
+    match !current_generator with
+      Some (Odoc_gen.Man _) -> ()
+    | _ -> set_generator
+             (Odoc_gen.Man (module Odoc_man.Generator : Odoc_man.Man_generator))),
+    M.generate_man ;
+  "-dot", Arg.Unit (fun () ->
+    match !current_generator with
+      Some (Odoc_gen.Dot _) -> ()
+    | _ -> set_generator
+             (Odoc_gen.Dot (module Odoc_dot.Generator : Odoc_dot.Dot_generator))),
+    M.generate_dot ;
+  "-customdir", Arg.Unit (fun () -> Printf.printf "%s\n" Odoc_config.custom_generators_path; exit 0),
+  M.display_custom_generators_dir ;
+  "-i", Arg.String (fun _ -> ()), M.add_load_dir ;
+  "-g", Arg.String (fun _ -> ()), M.load_file ^
+  "\n\n *** HTML options ***\n";
+
+(* html only options *)
+  "-all-params", Arg.Set Odoc_html.with_parameter_list, M.with_parameter_list ;
+  "-css-style", Arg.String (fun s -> Odoc_html.css_style := Some s), M.css_style ;
+  "-index-only", Arg.Set Odoc_html.index_only, M.index_only ;
+  "-colorize-code", Arg.Set Odoc_html.colorize_code, M.colorize_code ;
+  "-short-functors", Arg.Set Odoc_html.html_short_functors, M.html_short_functors ;
+  "-charset", Arg.Set_string Odoc_html.charset, (M.charset !Odoc_html.charset)^
+  "\n\n *** LaTeX options ***\n";
+
+(* latex only options *)
+  "-noheader", Arg.Unit (fun () -> Odoc_global.with_header := false), M.no_header ;
+  "-notrailer", Arg.Unit (fun () -> Odoc_global.with_trailer := false), M.no_trailer ;
+  "-sepfiles", Arg.Set Odoc_latex.separate_files, M.separate_files ;
+  "-latextitle", Arg.String f_latex_title, M.latex_title Odoc_latex.latex_titles ;
+  "-latex-value-prefix",
+    Arg.String (fun s -> Odoc_latex.latex_value_prefix := s), M.latex_value_prefix ;
+  "-latex-type-prefix",
+    Arg.String (fun s -> Odoc_latex.latex_type_prefix := s), M.latex_type_prefix ;
+  "-latex-exception-prefix",
+    Arg.String (fun s -> Odoc_latex.latex_exception_prefix := s), M.latex_exception_prefix ;
+  "-latex-attribute-prefix",
+    Arg.String (fun s -> Odoc_latex.latex_attribute_prefix := s), M.latex_attribute_prefix ;
+  "-latex-method-prefix",
+    Arg.String (fun s -> Odoc_latex.latex_method_prefix := s), M.latex_method_prefix ;
+  "-latex-module-prefix",
+    Arg.String (fun s -> Odoc_latex.latex_module_prefix := s), M.latex_module_prefix ;
+  "-latex-module-type-prefix",
+    Arg.String (fun s -> Odoc_latex.latex_module_type_prefix := s), M.latex_module_type_prefix ;
+  "-latex-class-prefix",
+    Arg.String (fun s -> Odoc_latex.latex_class_prefix := s), M.latex_class_prefix ;
+  "-latex-class-type-prefix",
+    Arg.String (fun s -> Odoc_latex.latex_class_type_prefix := s), M.latex_class_type_prefix ;
+  "-notoc", Arg.Unit (fun () -> Odoc_global.with_toc := false), M.no_toc ^
+  "\n\n *** texinfo options ***\n";
+
+(* texi only options *)
+  "-noindex", Arg.Clear Odoc_global.with_index, M.no_index ;
+  "-esc8", Arg.Set Odoc_texi.esc_8bits, M.esc_8bits ;
+  "-texinfotitle", Arg.String f_texinfo_title,
+  M.texinfo_title Odoc_texi.titles_and_headings ;
+
+  "-info-section", Arg.String ((:=) Odoc_texi.info_section), M.info_section ;
+  "-info-entry", Arg.String (fun s -> Odoc_texi.info_entry := !Odoc_texi.info_entry @ [ s ]),
+  M.info_entry ^
+  "\n\n *** dot options ***\n";
+
+(* dot only options *)
+  "-dot-colors", Arg.String (fun s -> Odoc_dot.dot_colors := Str.split (Str.regexp_string ",") s), M.dot_colors ;
+  "-dot-include-all", Arg.Set Odoc_dot.dot_include_all, M.dot_include_all ;
+  "-dot-types", Arg.Set Odoc_dot.dot_types, M.dot_types ;
+  "-dot-reduce", Arg.Set Odoc_dot.dot_reduce, M.dot_reduce^
+  "\n\n *** man pages options ***\n";
+
+(* man only options *)
+  "-man-mini", Arg.Set Odoc_man.man_mini, M.man_mini ;
+  "-man-suffix", Arg.String (fun s -> Odoc_man.man_suffix := s), M.man_suffix ;
+  "-man-section", Arg.String (fun s -> Odoc_man.man_section := s), M.man_section ;
+
+]
+
+let options = ref default_options
+
+let modified_options () =
+  !options != default_options
+
+let append_last_doc suffix =
+  match List.rev !options with
+  | (key, spec, doc) :: tl ->
+      options := List.rev ((key, spec, doc ^ suffix) :: tl)
+  | [] -> ()
+
+(** The help option list, overriding the default ones from the Arg module *)
+let help_options = ref []
+let help_action () =
+  let msg =
+    Arg.usage_string
+      (!options @ !help_options)
+      (M.usage ^ M.options_are) in
+  print_string msg
+let () =
+  help_options := [
+    "-help", Arg.Unit help_action, M.help ;
+    "--help", Arg.Unit help_action, M.help
+]
+
+let add_option o =
+  if not (modified_options ()) then
+    append_last_doc "\n *** custom generator options ***\n";
+  let (s,_,_) = o in
+  let rec iter = function
+      [] -> [o]
+    | (s2,f,m) :: q ->
+        if s = s2 then
+          o :: q
+        else
+          (s2,f,m) :: (iter q)
+  in
+  options := iter !options
+
+let parse () =
+  if modified_options () then append_last_doc "\n";
+  let options = !options @ !help_options in
+  Arg.parse (Arg.align ~limit:13 options)
+      anonymous
+      (M.usage^M.options_are);
+  (* we sort the hidden modules by name, to be sure that for example,
+     A.B is before A, so we will match against A.B before A in
+     Odoc_name.hide_modules.*)
+  Odoc_global.hidden_modules :=
+    List.sort (fun a -> fun b -> - (compare a b)) !Odoc_global.hidden_modules
diff --git a/ocamldoc/odoc_args.mli b/ocamldoc/odoc_args.mli
new file mode 100644
index 00000000..a4812b9a
--- /dev/null
+++ b/ocamldoc/odoc_args.mli
@@ -0,0 +1,53 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Analysis of the command line arguments. *)
+
+(** The current module defining the generator to use. *)
+val current_generator : Odoc_gen.generator option ref
+
+(** To set the documentation generator. *)
+val set_generator : Odoc_gen.generator -> unit
+
+(** Extend current HTML generator.
+  @raise Failure if another kind of generator is already set.*)
+val extend_html_generator : (module Odoc_gen.Html_functor) -> unit
+
+(** Extend current LaTeX generator.
+  @raise Failure if another kind of generator is already set.*)
+val extend_latex_generator : (module Odoc_gen.Latex_functor) -> unit
+
+(** Extend current Texi generator.
+  @raise Failure if another kind of generator is already set.*)
+val extend_texi_generator : (module Odoc_gen.Texi_functor) -> unit
+
+(** Extend current man generator.
+  @raise Failure if another kind of generator is already set.*)
+val extend_man_generator : (module Odoc_gen.Man_functor) -> unit
+
+(** Extend current dot generator.
+  @raise Failure if another kind of generator is already set.*)
+val extend_dot_generator : (module Odoc_gen.Dot_functor) -> unit
+
+(** Extend current base generator.
+  @raise Failure if another kind of generator is already set.*)
+val extend_base_generator : (module Odoc_gen.Base_functor) -> unit
+
+(** Add an option specification. *)
+val add_option : string * Arg.spec * string -> unit
+
+(** Parse the args.
+   [byte] indicate if we are in bytecode mode (default is [true]).*)
+val parse : unit -> unit
diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml
new file mode 100644
index 00000000..0203752d
--- /dev/null
+++ b/ocamldoc/odoc_ast.ml
@@ -0,0 +1,1916 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Analysis of implementation files. *)
+open Asttypes
+open Types
+open Typedtree
+
+let print_DEBUG3 s = print_string s ; print_newline ();;
+let print_DEBUG s = print_string s ; print_newline ();;
+
+type typedtree = (Typedtree.structure * Typedtree.module_coercion)
+
+open Odoc_parameter
+open Odoc_value
+open Odoc_type
+open Odoc_extension
+open Odoc_exception
+open Odoc_class
+open Odoc_module
+open Odoc_types
+
+(** This module is used to search for structure items by name in a Typedtree.structure.
+   One function creates two hash tables, which can then be used to search for elements.
+   Class elements do not use tables.
+*)
+module Typedtree_search =
+  struct
+    type ele =
+      | M of string
+      | MT of string
+      | T of string
+      | C of string
+      | CT of string
+      | X of string
+      | E of string
+      | P of string
+
+    type tab = (ele, Typedtree.structure_item_desc) Hashtbl.t
+    type tab_values = (Odoc_module.Name.t, Typedtree.pattern * Typedtree.expression) Hashtbl.t
+
+    let iter_val_pattern = function
+      | Typedtree.Tpat_any -> None
+      | Typedtree.Tpat_var (name, _) -> Some (Name.from_ident name)
+      | Typedtree.Tpat_tuple _ -> None (* FIXME when we will handle tuples *)
+      | _ -> None
+
+    let add_to_hashes table table_values tt =
+      match tt with
+      | Typedtree.Tstr_module mb ->
+          Option.iter (fun id ->
+            Hashtbl.add table (M (Name.from_ident id)) tt) mb.mb_id
+      | Typedtree.Tstr_recmodule mods ->
+          List.iter
+            (fun mb ->
+               Option.iter (fun id ->
+                 Hashtbl.add table (M (Name.from_ident id))
+                   (Typedtree.Tstr_module mb)
+               ) mb.mb_id
+            )
+            mods
+      | Typedtree.Tstr_modtype mtd ->
+          Hashtbl.add table (MT (Name.from_ident mtd.mtd_id)) tt
+      | Typedtree.Tstr_typext te -> begin
+          match te.tyext_constructors with
+            [] -> assert false
+          | ext :: _ -> Hashtbl.add table (X (Name.from_ident ext.ext_id)) tt
+        end
+      | Typedtree.Tstr_exception ext ->
+          Hashtbl.add table (E (Name.from_ident ext.tyexn_constructor.ext_id)) tt
+      | Typedtree.Tstr_type (rf, ident_type_decl_list) ->
+          List.iter
+            (fun td ->
+              Hashtbl.add table (T (Name.from_ident td.typ_id))
+                (Typedtree.Tstr_type (rf, [td])))
+            ident_type_decl_list
+      | Typedtree.Tstr_class info_list ->
+          List.iter
+            (fun (ci, s) ->
+              Hashtbl.add table (C (Name.from_ident ci.ci_id_class))
+                (Typedtree.Tstr_class [ci, s]))
+            info_list
+      | Typedtree.Tstr_class_type info_list ->
+          List.iter
+            (fun ((id,_,_) as ci) ->
+              Hashtbl.add table
+                (CT (Name.from_ident id))
+                (Typedtree.Tstr_class_type [ci]))
+            info_list
+      | Typedtree.Tstr_value (_, pat_exp_list) ->
+          List.iter
+            (fun {vb_pat=pat; vb_expr=exp} ->
+              match iter_val_pattern pat.Typedtree.pat_desc with
+                None -> ()
+              | Some n -> Hashtbl.add table_values n (pat,exp)
+            )
+            pat_exp_list
+      | Typedtree.Tstr_primitive vd ->
+          Hashtbl.add table (P (Name.from_ident vd.val_id)) tt
+      | Typedtree.Tstr_open _ -> ()
+      | Typedtree.Tstr_include _ -> ()
+      | Typedtree.Tstr_eval _ -> ()
+      | Typedtree.Tstr_attribute _ -> ()
+
+    let tables typedtree =
+      let t = Hashtbl.create 13 in
+      let t_values = Hashtbl.create 13 in
+      List.iter (fun str -> add_to_hashes t t_values str.str_desc) typedtree;
+      (t, t_values)
+
+    let search_module table name =
+      match Hashtbl.find table (M name) with
+        (Typedtree.Tstr_module mb) -> mb.mb_expr
+      | _ -> assert false
+
+    let search_module_type table name =
+      match Hashtbl.find table (MT name) with
+      | (Typedtree.Tstr_modtype mtd) -> mtd
+      | _ -> assert false
+
+    let search_extension table name =
+      match Hashtbl.find table (X name) with
+      | (Typedtree.Tstr_typext tyext) -> tyext
+      | _ -> assert false
+
+    let search_exception table name =
+      match Hashtbl.find table (E name) with
+      | (Typedtree.Tstr_exception ext) -> ext
+      | _ -> assert false
+
+    let search_type_declaration table name =
+      match Hashtbl.find table (T name) with
+      | (Typedtree.Tstr_type (_, [td])) -> td
+      | _ -> assert false
+
+    let search_class_exp table name =
+      match Hashtbl.find table (C name) with
+      | (Typedtree.Tstr_class [(ci, _ )]) ->
+          let ce = ci.ci_expr in
+          (
+           try
+             let type_decl = search_type_declaration table name in
+             (ce, type_decl.typ_type.Types.type_params)
+           with
+             Not_found ->
+               (ce, [])
+          )
+      | _ -> assert false
+
+    let search_class_type_declaration table name =
+      match Hashtbl.find table (CT name) with
+      | (Typedtree.Tstr_class_type [(_,_,cltype_decl)]) -> cltype_decl
+      | _ -> assert false
+
+    let search_value table name = Hashtbl.find table name
+
+    let search_primitive table name =
+      match Hashtbl.find table (P name) with
+        Tstr_primitive vd -> vd.val_val.Types.val_type
+      | _ -> assert false
+
+    let get_nth_inherit_class_expr cls n =
+      let rec iter cpt = function
+        | [] ->
+            raise Not_found
+        | { cf_desc = Typedtree.Tcf_inherit (_, clexp, _, _, _) } :: q ->
+            if n = cpt then clexp else iter (cpt+1) q
+        | _ :: q ->
+            iter cpt q
+      in
+      iter 0 cls.Typedtree.cstr_fields
+
+    let search_attribute_type cls name =
+      let rec iter = function
+        | [] ->
+            raise Not_found
+        | { cf_desc = Typedtree.Tcf_val (_, _, ident, Tcfk_concrete (_, exp), _) } :: _
+          when Name.from_ident ident = name ->
+            exp.Typedtree.exp_type
+        | { cf_desc = Typedtree.Tcf_val (_, _, ident, Tcfk_virtual typ, _) } :: _
+          when Name.from_ident ident = name ->
+            typ.Typedtree.ctyp_type
+        | _ :: q ->
+            iter q
+      in
+      iter cls.Typedtree.cstr_fields
+
+   let search_method_expression cls name =
+      let rec iter = function
+        | [] ->
+            raise Not_found
+        | { cf_desc = Typedtree.Tcf_method (label, _, Tcfk_concrete (_, exp)) } :: _ when label.txt = name ->
+            exp
+        | _ :: q ->
+            iter q
+      in
+      iter cls.Typedtree.cstr_fields
+  end
+
+module Analyser =
+  functor (My_ir : Odoc_sig.Info_retriever) ->
+
+  struct
+    module Sig = Odoc_sig.Analyser (My_ir)
+
+    (** This variable is used to load a file as a string and retrieve characters from it.*)
+    let file = Sig.file
+
+    (** The name of the analysed file. *)
+    let file_name = Sig.file_name
+
+    (** This function takes two indexes (start and end) and returns the string
+       corresponding to the indexes in the file global variable. The function
+       prepare_file must have been called to fill the file global variable.*)
+    let get_string_of_file = Sig.get_string_of_file
+
+    (** This function loads the given file in the file global variable
+       and sets file_name.*)
+    let prepare_file = Sig.prepare_file
+
+    (** The function used to get the comments in a class. *)
+    let get_comments_in_class = Sig.get_comments_in_class
+
+    (** The function used to get the comments in a module. *)
+    let get_comments_in_module = Sig.get_comments_in_module
+
+    (** This function takes a parameter pattern and builds the
+       corresponding [parameter] structure. The f_desc function
+       is used to retrieve a parameter description, if any, from
+       a parameter name.
+    *)
+    let tt_param_info_from_pattern env f_desc pat =
+      let rec iter_pattern pat =
+        match pat.pat_desc with
+          Typedtree.Tpat_var (ident, _) ->
+            let name = Name.from_ident ident in
+            Simple_name { sn_name = name ;
+                          sn_text = f_desc name ;
+                          sn_type = Odoc_env.subst_type env pat.pat_type
+                        }
+
+        | Typedtree.Tpat_alias (pat, _, _) ->
+            iter_pattern pat
+
+        | Typedtree.Tpat_tuple patlist ->
+            Tuple
+              (List.map iter_pattern patlist,
+               Odoc_env.subst_type env pat.pat_type)
+
+        | Typedtree.Tpat_construct (_, cons_desc, _) when
+            (* we give a name to the parameter only if it unit *)
+            (match cons_desc.cstr_res.desc with
+              Tconstr (p, _, _) ->
+                Path.same p Predef.path_unit
+            | _ ->
+                false)
+          ->
+            (* a () argument, it never has description *)
+            Simple_name { sn_name = "()" ;
+                          sn_text = None ;
+                          sn_type = Odoc_env.subst_type env pat.pat_type
+                        }
+
+        | _ ->
+            (* implicit pattern matching -> anonymous parameter *)
+            Simple_name { sn_name = "()" ;
+                          sn_text = None ;
+                          sn_type = Odoc_env.subst_type env pat.pat_type
+                        }
+      in
+      iter_pattern pat
+
+    (** Analysis of the parameter of a function. Return a list of t_parameter created from
+       the (pattern, expression) structures encountered. *)
+    let rec tt_analyse_function_parameters env current_comment_opt pat_exp_list =
+      match pat_exp_list with
+        [] ->
+          (* This case means we have a 'function' without pattern, that's impossible *)
+          raise (Failure "tt_analyse_function_parameters: 'function' without pattern")
+
+      | {c_lhs=pattern_param} :: _second_ele :: _ ->
+          (* implicit pattern matching -> anonymous parameter and no more parameter *)
+          (* FIXME : label ? *)
+          let parameter = Odoc_parameter.Tuple ([], Odoc_env.subst_type env pattern_param.pat_type) in
+          [ parameter ]
+
+      | {c_lhs=pattern_param; c_rhs=func_body} :: [] ->
+          let parameter =
+            tt_param_info_from_pattern
+              env
+              (Odoc_parameter.desc_from_info_opt current_comment_opt)
+              pattern_param
+
+          in
+         (* For optional parameters with a default value, a special treatment is required *)
+         (* we look if the name of the parameter we just add is "*opt*", which means
+            that there is a let param_name = ... in ... just right now *)
+          let (p, next_exp) =
+            match parameter with
+              Simple_name { sn_name = "*opt*" } ->
+                (
+                 (
+                  match func_body.exp_desc with
+                    Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _) };
+                                            vb_expr=exp} :: _, func_body2) ->
+                      let name = Name.from_ident id in
+                      let new_param = Simple_name
+                          { sn_name = name ;
+                            sn_text = Odoc_parameter.desc_from_info_opt current_comment_opt name ;
+                            sn_type = Odoc_env.subst_type env exp.exp_type
+                          }
+                      in
+                      (new_param, func_body2)
+                  | _ ->
+                      print_DEBUG3 "Pas le bon filtre pour le parametre optionnel avec valeur par defaut.";
+                      (parameter, func_body)
+                 )
+                )
+            | _ ->
+                (parameter, func_body)
+          in
+         (* continue if the body is still a function *)
+          match next_exp.exp_desc with
+            Texp_function { cases = pat_exp_list ; _ } ->
+              p :: (tt_analyse_function_parameters env current_comment_opt pat_exp_list)
+          | _ ->
+              (* something else ; no more parameter *)
+              [ p ]
+
+     (** Analysis of a Tstr_value from the typedtree. Create and return a list of [t_value].
+        @raise Failure if an error occurs.*)
+     let tt_analyse_value env current_module_name comment_opt loc pat_exp rec_flag =
+       let (pat, exp) = pat_exp in
+       match (pat.pat_desc, exp.exp_desc) with
+         (Typedtree.Tpat_var (ident, _), Typedtree.Texp_function { cases = pat_exp_list2; _ }) ->
+           (* a new function is defined *)
+           let name_pre = Name.from_ident ident in
+           let name = Name.parens_if_infix name_pre in
+           let complete_name = Name.concat current_module_name name in
+           let code =
+              if !Odoc_global.keep_code then
+                Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum
+                      loc.Location.loc_end.Lexing.pos_cnum)
+              else
+                None
+            in
+           (* create the value *)
+           let new_value = {
+             val_name = complete_name ;
+             val_info = comment_opt ;
+             val_type = Odoc_env.subst_type env pat.Typedtree.pat_type ;
+             val_recursive = rec_flag = Asttypes.Recursive ;
+             val_parameters = tt_analyse_function_parameters env comment_opt pat_exp_list2 ;
+             val_code = code ;
+             val_loc = { loc_impl = Some loc ; loc_inter = None } ;
+           }
+           in
+           [ new_value ]
+
+       | (Typedtree.Tpat_var (ident, _), _) ->
+           (* a new value is defined *)
+           let name_pre = Name.from_ident ident in
+           let name = Name.parens_if_infix name_pre in
+           let complete_name = Name.concat current_module_name name in
+           let code =
+             if !Odoc_global.keep_code then
+                Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum
+                      loc.Location.loc_end.Lexing.pos_cnum)
+             else
+               None
+            in
+           let new_value = {
+             val_name = complete_name ;
+             val_info = comment_opt ;
+             val_type = Odoc_env.subst_type env pat.Typedtree.pat_type ;
+             val_recursive = rec_flag = Asttypes.Recursive ;
+             val_parameters = [] ;
+             val_code = code ;
+             val_loc = { loc_impl = Some loc ; loc_inter = None } ;
+           }
+           in
+           [ new_value ]
+
+       | (Typedtree.Tpat_tuple _, _) ->
+           (* new identifiers are defined *)
+           (* FIXME : by now we don't accept to have global variables defined in tuples *)
+           []
+
+       | _ ->
+           (* something else, we don't care ? FIXME *)
+           []
+
+    (** This function takes a Typedtree.class_expr and returns a string which can stand for the class name.
+       The name can be "object ... end" if the class expression is not an ident or a class constraint or a class apply. *)
+    let rec tt_name_of_class_expr clexp =
+(*
+      (
+       match clexp.Typedtree.cl_desc with
+         Tclass_ident _ -> prerr_endline "Tclass_ident"
+       | Tclass_structure _ -> prerr_endline "Tclass_structure"
+       | Tclass_fun _ -> prerr_endline "Tclass_fun"
+       | Tclass_apply _ -> prerr_endline "Tclass_apply"
+       | Tclass_let _ -> prerr_endline "Tclass_let"
+       | Tclass_constraint _ -> prerr_endline "Tclass_constraint"
+      );
+*)
+      match clexp.Typedtree.cl_desc with
+        Typedtree.Tcl_ident (p, _, _) -> Name.from_path p
+      | Typedtree.Tcl_constraint (class_expr, _, _, _, _)
+      | Typedtree.Tcl_apply (class_expr, _) -> tt_name_of_class_expr class_expr
+(*
+      | Typedtree.Tclass_fun (_, _, class_expr, _) -> tt_name_of_class_expr class_expr
+      | Typedtree.Tclass_let (_,_,_, class_expr) -> tt_name_of_class_expr class_expr
+*)
+      |  _ -> Odoc_messages.object_end
+
+    (** Analysis of a method expression to get the method parameters.
+       @param first indicates if we're analysing the method for
+       the first time ; in that case we must not keep the first parameter,
+       which is "self-*", the object itself.
+    *)
+    let rec tt_analyse_method_expression env current_method_name comment_opt ?(first=true) exp =
+      match exp.Typedtree.exp_desc with
+        Typedtree.Texp_function { cases = pat_exp_list; _ } ->
+          (
+           match pat_exp_list with
+             [] ->
+               (* it is not a function since there are no parameters *)
+               (* we can't get here normally *)
+               raise (Failure (Odoc_messages.bad_tree^" "^(Odoc_messages.method_without_param current_method_name)))
+           | l ->
+               match l with
+                 [] ->
+                   (* impossible case, it has already been filtered *)
+                   assert false
+               | {c_lhs=pattern_param} :: _second_ele :: _ ->
+                   (* implicit pattern matching -> anonymous parameter *)
+                   (* Note : We can't match this pattern if it is the first call to the function. *)
+                   let new_param = Simple_name
+                       { sn_name = "??" ; sn_text =  None;
+                         sn_type = Odoc_env.subst_type env pattern_param.Typedtree.pat_type }
+                   in
+                   [ new_param ]
+
+               | {c_lhs=pattern_param; c_rhs=body} :: [] ->
+                   (* if this is the first call to the function, this is the first parameter and we skip it *)
+                   if not first then
+                     (
+                      let parameter =
+                        tt_param_info_from_pattern
+                          env
+                          (Odoc_parameter.desc_from_info_opt comment_opt)
+                          pattern_param
+                      in
+                      (* For optional parameters with a default value, a special treatment is required. *)
+                      (* We look if the name of the parameter we just add is "*opt*", which means
+                         that there is a let param_name = ... in ... just right now. *)
+                      let (current_param, next_exp) =
+                        match parameter with
+                          Simple_name { sn_name = "*opt*"} ->
+                            (
+                             (
+                              match body.exp_desc with
+                                Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _) };
+                                                        vb_expr=exp} :: _, body2) ->
+                                  let name = Name.from_ident id in
+                                  let new_param = Simple_name
+                                      { sn_name = name ;
+                                        sn_text = Odoc_parameter.desc_from_info_opt comment_opt name ;
+                                        sn_type = Odoc_env.subst_type env exp.Typedtree.exp_type ;
+                                      }
+                                  in
+                                  (new_param, body2)
+                              | _ ->
+                                  print_DEBUG3 "Pas le bon filtre pour le parametre optionnel avec valeur par defaut.";
+                                  (parameter, body)
+                             )
+                            )
+                        | _ ->
+                            (* no *opt* parameter, we add the parameter then continue *)
+                            (parameter, body)
+                      in
+                      current_param :: (tt_analyse_method_expression env current_method_name comment_opt ~first: false next_exp)
+                     )
+                   else
+                     tt_analyse_method_expression env current_method_name comment_opt ~first: false body
+          )
+      | _ ->
+          (* no more parameter *)
+          []
+
+    (** Analysis of a [Parsetree.class_struture] and a [Typedtree.class_structure] to get a couple
+       (inherited classes, class elements). *)
+    let analyse_class_structure env current_class_name tt_class_sig last_pos pos_limit p_cls tt_cls _table =
+      let rec iter acc_inher acc_fields last_pos = function
+        | [] ->
+            let s = get_string_of_file last_pos pos_limit in
+            let (_, ele_coms) = My_ir.all_special !file_name s in
+            let ele_comments =
+              List.fold_left
+                (fun acc -> fun sc ->
+                  match sc.Odoc_types.i_desc with
+                    None ->
+                      acc
+                  | Some t ->
+                      acc @ [Class_comment t])
+                []
+                ele_coms
+            in
+            (acc_inher, acc_fields @ ele_comments)
+          | item :: q ->
+              let loc = item.Parsetree.pcf_loc in
+              match item.Parsetree.pcf_desc with
+        | (Parsetree.Pcf_inherit (_, p_clexp, _))  ->
+            let tt_clexp =
+              let n = List.length acc_inher in
+              try Typedtree_search.get_nth_inherit_class_expr tt_cls n
+              with Not_found ->
+                raise (Failure (
+                       Odoc_messages.inherit_classexp_not_found_in_typedtree n))
+            in
+            let (info_opt, ele_comments) =
+              get_comments_in_class last_pos
+                p_clexp.Parsetree.pcl_loc.Location.loc_start.Lexing.pos_cnum
+            in
+            let text_opt =
+              match info_opt with None -> None
+              | Some i -> i.Odoc_types.i_desc in
+            let name = tt_name_of_class_expr tt_clexp in
+            let inher =
+              {
+                ic_name = Odoc_env.full_class_or_class_type_name env name ;
+                ic_class = None ;
+                ic_text = text_opt ;
+              }
+            in
+            iter (acc_inher @ [ inher ]) (acc_fields @ ele_comments)
+              p_clexp.Parsetree.pcl_loc.Location.loc_end.Lexing.pos_cnum
+              q
+
+      | Parsetree.Pcf_val ({ txt = label }, mutable_flag, k) ->
+            let virt = match k with Parsetree.Cfk_virtual _ -> true | Parsetree.Cfk_concrete _ -> false in
+            let complete_name = Name.concat current_class_name label in
+            let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
+            let type_exp =
+              try Typedtree_search.search_attribute_type tt_cls label
+              with Not_found ->
+                raise (Failure (Odoc_messages.attribute_not_found_in_typedtree complete_name))
+          in
+          let code =
+            if !Odoc_global.keep_code then
+              Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum
+                    loc.Location.loc_end.Lexing.pos_cnum)
+            else
+              None
+          in
+          let att =
+            {
+              att_value = { val_name = complete_name ;
+                val_info = info_opt ;
+                val_type = Odoc_env.subst_type env type_exp ;
+                val_recursive = false ;
+                val_parameters = [] ;
+                val_code = code ;
+                val_loc = { loc_impl = Some loc ; loc_inter = None } ;
+              } ;
+              att_mutable = mutable_flag = Asttypes.Mutable ;
+              att_virtual = virt ;
+            }
+          in
+          iter acc_inher (acc_fields @ ele_comments @ [ Class_attribute att ]) loc.Location.loc_end.Lexing.pos_cnum q
+
+        | (Parsetree.Pcf_method  ({ txt = label }, private_flag, Parsetree.Cfk_virtual _)) ->
+            let complete_name = Name.concat current_class_name label in
+            let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
+            let met_type =
+              try Odoc_sig.Signature_search.search_method_type label tt_class_sig
+              with Not_found -> raise (Failure (Odoc_messages.method_type_not_found current_class_name label))
+            in
+            let real_type =
+              match met_type.Types.desc with
+              Tarrow (_, _, t, _) ->
+                t
+            |  _ ->
+                (* ?!? : not an arrow type ! return the original type *)
+                met_type
+          in
+          let code =
+            if !Odoc_global.keep_code then
+              Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum
+               loc.Location.loc_end.Lexing.pos_cnum)
+            else
+              None
+          in
+          let met =
+            {
+              met_value = {
+                val_name = complete_name ;
+                val_info = info_opt ;
+                val_type = Odoc_env.subst_type env real_type ;
+                val_recursive = false ;
+                val_parameters = [] ;
+                val_code = code ;
+                val_loc = { loc_impl = Some loc ; loc_inter = None } ;
+              } ;
+              met_private = private_flag = Asttypes.Private ;
+              met_virtual = true ;
+            }
+          in
+          (* update the parameter description *)
+          Odoc_value.update_value_parameters_text met.met_value;
+
+          iter acc_inher (acc_fields @ ele_comments @ [ Class_method met ]) loc.Location.loc_end.Lexing.pos_cnum q
+
+        | (Parsetree.Pcf_method ({ txt = label }, private_flag, Parsetree.Cfk_concrete _)) ->
+            let complete_name = Name.concat current_class_name label in
+            let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
+            let exp =
+              try Typedtree_search.search_method_expression tt_cls label
+            with Not_found -> raise (Failure (Odoc_messages.method_not_found_in_typedtree complete_name))
+          in
+          let real_type =
+            match exp.exp_type.desc with
+              Tarrow (_, _, t,_) ->
+                t
+            |  _ ->
+                (* ?!? : not an arrow type ! return the original type *)
+                exp.Typedtree.exp_type
+          in
+          let code =
+            if !Odoc_global.keep_code then
+                Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum
+               loc.Location.loc_end.Lexing.pos_cnum)
+            else
+              None
+          in
+          let met =
+            {
+              met_value = { val_name = complete_name ;
+                val_info = info_opt ;
+                val_type = Odoc_env.subst_type env real_type ;
+                val_recursive = false ;
+                val_parameters = tt_analyse_method_expression env complete_name info_opt exp ;
+                val_code = code ;
+                val_loc = { loc_impl = Some loc ; loc_inter = None } ;
+              } ;
+              met_private = private_flag = Asttypes.Private ;
+              met_virtual = false ;
+              }
+          in
+          (* update the parameter description *)
+          Odoc_value.update_value_parameters_text met.met_value;
+
+          iter acc_inher (acc_fields @ ele_comments @ [ Class_method met ]) loc.Location.loc_end.Lexing.pos_cnum q
+
+        | Parsetree.Pcf_constraint (_, _) ->
+            (* don't give a $*%@ ! *)
+            iter acc_inher acc_fields loc.Location.loc_end.Lexing.pos_cnum q
+
+        | (Parsetree.Pcf_initializer exp) ->
+            iter acc_inher acc_fields exp.Parsetree.pexp_loc.Location.loc_end.Lexing.pos_cnum q
+
+        | Parsetree.Pcf_attribute _ ->
+            iter acc_inher acc_fields loc.Location.loc_end.Lexing.pos_cnum q
+
+        | Parsetree.Pcf_extension _ -> assert false
+      in
+      iter [] [] last_pos (p_cls.Parsetree.pcstr_fields)
+
+    (** Analysis of a [Parsetree.class_expr] and a [Typedtree.class_expr] to get a pair (class parameters, class kind). *)
+    let rec analyse_class_kind env current_class_name comment_opt last_pos p_class_expr tt_class_exp table =
+      match (p_class_expr.Parsetree.pcl_desc, tt_class_exp.Typedtree.cl_desc) with
+        (Parsetree.Pcl_constr (lid, _), tt_class_exp_desc ) ->
+          let name =
+            match tt_class_exp_desc with
+              Typedtree.Tcl_ident (p,_,_) -> Name.from_path p
+            | _ ->
+                (* we try to get the name from the environment. *)
+                (* FIXME : Unfortunately, we don't have a Tclass_ident :-( even for a class tutu = toto *)
+                Name.from_longident lid.txt
+          in
+          (* Here, type parameters are not present as Types.type_expr,
+             however they can be found in the class_type *)
+          let params =
+            match tt_class_exp.Typedtree.cl_type with
+              Types.Cty_constr (_p2, type_exp_list, _cltyp) ->
+                (* cltyp is the class type for [type_exp_list] p *)
+                type_exp_list
+            | _ ->
+                []
+          in
+          ([],
+           Class_constr
+             {
+               cco_name = Odoc_env.full_class_name env name ;
+               cco_class = None ;
+               cco_type_parameters = List.map (Odoc_env.subst_type env) params ;
+             } )
+
+      | (Parsetree.Pcl_structure p_class_structure, Typedtree.Tcl_structure tt_class_structure) ->
+          (* we need the class signature to get the type of methods in analyse_class_structure *)
+          let tt_class_sig =
+            match tt_class_exp.Typedtree.cl_type with
+              Types.Cty_signature class_sig -> class_sig
+            | _ -> raise (Failure "analyse_class_kind: no class signature for a class structure.")
+          in
+          let (inherited_classes, class_elements) = analyse_class_structure
+              env
+              current_class_name
+              tt_class_sig
+              last_pos
+              p_class_expr.Parsetree.pcl_loc.Location.loc_end.Lexing.pos_cnum
+              p_class_structure
+              tt_class_structure
+              table
+          in
+          ([],
+           Class_structure (inherited_classes, class_elements) )
+
+      | (Parsetree.Pcl_fun (_label, _expression_opt, _pattern, p_class_expr2),
+         Typedtree.Tcl_fun (_, pat, _ident_exp_list, tt_class_expr2, _partial)) ->
+           (* we check that this is not an optional parameter with
+              a default value. In this case, we look for the good parameter pattern *)
+           let (parameter, next_tt_class_exp) =
+             match pat.Typedtree.pat_desc with
+               Typedtree.Tpat_var (ident, _) when Name.from_ident ident = "*opt*" ->
+                 (
+                  (* there must be a Tcl_let just after *)
+                  match tt_class_expr2.Typedtree.cl_desc with
+                    Typedtree.Tcl_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id,_) };
+                                           vb_expr=exp} :: _, _, tt_class_expr3) ->
+                      let name = Name.from_ident id in
+                      let new_param = Simple_name
+                          { sn_name = name ;
+                            sn_text = Odoc_parameter.desc_from_info_opt comment_opt name ;
+                            sn_type = Odoc_env.subst_type env exp.exp_type
+                          }
+                      in
+                      (new_param, tt_class_expr3)
+                 | _ ->
+                     (* strange case *)
+                     (* we create the parameter and add it to the class *)
+                     raise (Failure "analyse_class_kind: strange case")
+                 )
+             | _ ->
+                 (* no optional parameter with default value, we create the parameter *)
+                 let new_param =
+                   tt_param_info_from_pattern
+                     env
+                     (Odoc_parameter.desc_from_info_opt comment_opt)
+                     pat
+                 in
+                 (new_param, tt_class_expr2)
+           in
+           let (params, k) = analyse_class_kind
+              env current_class_name comment_opt last_pos p_class_expr2
+                next_tt_class_exp table
+            in
+           (parameter :: params, k)
+
+      | (Parsetree.Pcl_apply (p_class_expr2, _), Tcl_apply (tt_class_expr2, exp_opt_optional_list)) ->
+          let applied_name =
+            (* we want an ident, or else the class applied will appear in the form object ... end,
+               because if the class applied has no name, the code is kinda ugly, isn't it ? *)
+            match tt_class_expr2.Typedtree.cl_desc with
+              Typedtree.Tcl_ident (p,_,_) -> Name.from_path p (* FIXME : obtain the full name *)
+            | _ ->
+                (* FIXME : Unfortunately, we don't have a Tclass_ident :-( even for a class tutu = toto *)
+                match p_class_expr2.Parsetree.pcl_desc with
+                  Parsetree.Pcl_constr (lid, _) ->
+                    (* we try to get the name from the environment. *)
+                    Name.from_longident lid.txt
+                |  _ ->
+                    Odoc_messages.object_end
+          in
+          let param_exps = List.fold_left
+              (fun acc -> fun (_, exp_opt) ->
+                match exp_opt with
+                  None -> acc
+                | Some e -> acc @ [e])
+              []
+              exp_opt_optional_list
+          in
+          let param_types = List.map (fun e -> e.Typedtree.exp_type) param_exps in
+          let params_code =
+            List.map
+              (fun e -> get_string_of_file
+                  e.exp_loc.Location.loc_start.Lexing.pos_cnum
+                  e.exp_loc.Location.loc_end.Lexing.pos_cnum)
+              param_exps
+          in
+          ([],
+           Class_apply
+             { capp_name = Odoc_env.full_class_name env applied_name ;
+               capp_class = None ;
+               capp_params = param_types ;
+               capp_params_code = params_code ;
+             } )
+
+      | (Parsetree.Pcl_let (_, _, p_class_expr2), Typedtree.Tcl_let (_, _, _, tt_class_expr2)) ->
+          (* we don't care about these lets *)
+          analyse_class_kind
+              env current_class_name comment_opt last_pos p_class_expr2
+              tt_class_expr2 table
+
+      | (Parsetree.Pcl_constraint (p_class_expr2, _p_class_type2),
+         Typedtree.Tcl_constraint (tt_class_expr2, _, _, _, _)) ->
+          let (l, class_kind) = analyse_class_kind
+              env current_class_name comment_opt last_pos p_class_expr2
+                tt_class_expr2 table
+            in
+            (* FIXME analysis of the class type ? We don't have all the infos. cf. Odoc_sig.analyse_class_type_kind *)
+          let class_type_kind =
+            (*Sig.analyse_class_type_kind
+              env
+              ""
+              p_class_type2.Parsetree.pcty_loc.Location.loc_start.Lexing.pos_cnum
+              p_class_type2
+              tt_class_expr2.Typedtree.cl_type
+            *)
+            Class_type { cta_name = Odoc_messages.object_end ;
+                         cta_class = None ; cta_type_parameters = [] }
+          in
+          (l, Class_constraint (class_kind, class_type_kind))
+
+      | _ ->
+          raise (Failure "analyse_class_kind: Parsetree and typedtree don't match.")
+
+    (** Analysis of a [Parsetree.class_declaration] and a [Typedtree.class_expr] to return a [t_class].*)
+    let analyse_class env current_module_name comment_opt p_class_decl tt_type_params tt_class_exp table =
+      let name = p_class_decl.Parsetree.pci_name in
+      let complete_name = Name.concat current_module_name name.txt in
+      let loc = p_class_decl.Parsetree.pci_expr.Parsetree.pcl_loc in
+      let pos_start = loc.Location.loc_start.Lexing.pos_cnum in
+      let type_parameters = tt_type_params in
+      let virt = p_class_decl.Parsetree.pci_virt = Asttypes.Virtual in
+      let cltype = Odoc_env.subst_class_type env tt_class_exp.Typedtree.cl_type in
+      let (parameters, kind) = analyse_class_kind
+          env
+          complete_name
+          comment_opt
+          pos_start
+          p_class_decl.Parsetree.pci_expr
+          tt_class_exp
+          table
+      in
+      {
+        cl_name = complete_name ;
+        cl_info = comment_opt ;
+        cl_type = cltype ;
+        cl_virtual = virt ;
+        cl_type_parameters = type_parameters ;
+        cl_kind = kind ;
+        cl_parameters = parameters ;
+        cl_loc = { loc_impl = Some loc ; loc_inter = None } ;
+      }
+
+    (** Get a name from a module expression, or "struct ... end" if the module expression
+       is not an ident of a constraint on an ident. *)
+    let rec tt_name_from_module_expr mod_expr =
+      match mod_expr.Typedtree.mod_desc with
+        Typedtree.Tmod_ident (p,_) -> Name.from_path p
+      | Typedtree.Tmod_constraint (m_exp, _, _, _) -> tt_name_from_module_expr m_exp
+      | Typedtree.Tmod_structure _
+      | Typedtree.Tmod_functor _
+      | Typedtree.Tmod_apply _
+      | Typedtree.Tmod_unpack _ ->
+          Odoc_messages.struct_end
+
+    (** Get the list of included modules in a module structure of a typed tree. *)
+    let tt_get_included_module_list tt_structure =
+      let f acc item =
+        match item.str_desc with
+          Typedtree.Tstr_include incl ->
+            acc @ [
+                  { (* FIXME : search within modules and module types, with which env ? *)
+                    im_name = tt_name_from_module_expr incl.incl_mod ;
+                    im_module = None ;
+                    im_info = None ;
+                  }
+                ]
+        | _ ->
+            acc
+      in
+      List.fold_left f [] tt_structure.str_items
+
+    (** This function takes a [module element list] of a module and replaces the "dummy" included modules with
+       the ones found in typed tree structure of the module. *)
+    let replace_dummy_included_modules module_elements included_modules =
+      let rec f = function
+        | ([], _) ->
+            []
+        | ((Element_included_module im) :: q, (im_repl :: im_q)) ->
+            (Element_included_module { im_repl with im_info = im.im_info })
+            :: (f (q, im_q))
+        | ((Element_included_module im) :: q, []) ->
+            (Element_included_module im) :: q
+        | (ele :: q, l) ->
+            ele :: (f (q, l))
+      in
+      f (module_elements, included_modules)
+
+    (** This function removes the elements of the module which does not
+       belong to the given module type, if the module type is expanded
+       and the module has a "structure" kind. *)
+    let rec filter_module_with_module_type_constraint m mt =
+      match m.m_kind, mt with
+        Module_struct l, Types.Mty_signature lsig ->
+          m.m_kind <- Module_struct (filter_module_elements_with_module_type_constraint l lsig);
+          m.m_type <- mt;
+      | _ -> ()
+
+    (** This function removes the elements of the module type which does not
+       belong to the given module type, if the module type is expanded
+       and the module type has a "structure" kind. *)
+    and filter_module_type_with_module_type_constraint mtyp mt =
+      match mtyp.mt_kind, mt with
+        Some Module_type_struct l, Types.Mty_signature lsig ->
+          mtyp.mt_kind <- Some (Module_type_struct (filter_module_elements_with_module_type_constraint l lsig));
+          mtyp.mt_type <- Some mt;
+      | _ -> ()
+
+    and filter_module_elements_with_module_type_constraint l lsig =
+      let pred ele =
+        let f = match ele with
+          Element_module m ->
+            (function
+                Types.Sig_module (ident,_,md,_,_) ->
+                  let n1 = Name.simple m.m_name
+                  and n2 = Ident.name ident in
+                  (
+                   match n1 = n2 with
+                     true -> filter_module_with_module_type_constraint m md.md_type; true
+                   | false -> false
+                  )
+              | _ -> false)
+        | Element_module_type mt ->
+            (function
+                Types.Sig_modtype (ident,{Types.mtd_type=Some t},_) ->
+                  let n1 = Name.simple mt.mt_name
+                  and n2 = Ident.name ident in
+                  (
+                   match n1 = n2 with
+                     true -> filter_module_type_with_module_type_constraint mt t; true
+                   | false -> false
+                  )
+              | _ -> false)
+        | Element_value v ->
+            (function
+                Types.Sig_value (ident,_, _) ->
+                  let n1 = Name.simple v.val_name
+                  and n2 = Ident.name ident in
+                  n1 = n2
+              | _ -> false)
+        | Element_type t ->
+             (function
+                Types.Sig_type (ident,_,_,_) ->
+                  (* FIXME: type details can be hidden *)
+                  let n1 = Name.simple t.ty_name
+                  and n2 = Ident.name ident in
+                  n1 = n2
+               | _ -> false)
+        | Element_type_extension te ->
+            let l =
+              filter_extension_constructors_with_module_type_constraint
+                te.te_constructors lsig
+            in
+              te.te_constructors <- l;
+              if l <> [] then (fun _ -> true)
+              else (fun _ -> false)
+        | Element_exception e ->
+            (function
+                Types.Sig_typext (ident,_,_, _) ->
+                  let n1 = Name.simple e.ex_name
+                  and n2 = Ident.name ident in
+                  n1 = n2
+              | _ -> false)
+        | Element_class c ->
+            (function
+                Types.Sig_class (ident,_,_, _) ->
+                  let n1 = Name.simple c.cl_name
+                  and n2 = Ident.name ident in
+                  n1 = n2
+              | _ -> false)
+        | Element_class_type ct ->
+            (function
+                Types.Sig_class_type (ident,_,_, _) ->
+                  let n1 = Name.simple ct.clt_name
+                  and n2 = Ident.name ident in
+                  n1 = n2
+              | _ -> false)
+        | Element_module_comment _ -> fun _ -> true
+        | Element_included_module _ -> fun _ -> true
+        in
+        List.exists f lsig
+      in
+      List.filter pred l
+
+    and filter_extension_constructors_with_module_type_constraint l lsig =
+      let pred xt =
+        List.exists
+          (function
+              Types.Sig_typext (ident, _, _, _) ->
+                let n1 = Name.simple xt.xt_name
+                and n2 = Ident.name ident in
+                  n1 = n2
+            | _ -> false)
+          lsig
+      in
+        List.filter pred l
+
+    (** Analysis of a parse tree structure with a typed tree, to return module elements.*)
+    let rec analyse_structure env current_module_name last_pos pos_limit parsetree typedtree =
+      print_DEBUG "Odoc_ast:analyse_struture";
+      let (table, table_values) = Typedtree_search.tables typedtree.str_items in
+      let rec iter env last_pos = function
+          [] ->
+            let s = get_string_of_file last_pos pos_limit in
+            let (_, ele_coms) = My_ir.all_special !file_name s in
+            List.fold_left
+              (fun acc -> fun sc ->
+                 match sc.Odoc_types.i_desc with
+                   None ->
+                     acc
+                 | Some t ->
+                     acc @ [Element_module_comment t])
+              []
+              ele_coms
+        | item :: q ->
+            let (comment_opt, ele_comments) =
+              get_comments_in_module last_pos item.Parsetree.pstr_loc.Location.loc_start.Lexing.pos_cnum
+            in
+            let pos_limit2 =
+              match q with
+                [] -> pos_limit
+              | item2 :: _ -> item2.Parsetree.pstr_loc.Location.loc_start.Lexing.pos_cnum
+            in
+            let (maybe_more, new_env, elements) = analyse_structure_item
+                env
+                current_module_name
+                item.Parsetree.pstr_loc
+                pos_limit2
+                comment_opt
+                item.Parsetree.pstr_desc
+                typedtree
+                table
+                table_values
+            in
+            ele_comments @ elements @ (iter new_env (item.Parsetree.pstr_loc.Location.loc_end.Lexing.pos_cnum + maybe_more) q)
+      in
+      iter env last_pos parsetree
+
+   (** Analysis of a parse tree structure item to obtain a new environment and a list of elements.*)
+   and analyse_structure_item env current_module_name loc pos_limit comment_opt parsetree_item_desc _typedtree
+        table table_values =
+      print_DEBUG "Odoc_ast:analyse_struture_item";
+      match parsetree_item_desc with
+        Parsetree.Pstr_eval _ ->
+          (* don't care *)
+          (0, env, [])
+      | Parsetree.Pstr_attribute _
+      | Parsetree.Pstr_extension _ ->
+          (0, env, [])
+      | Parsetree.Pstr_value (rec_flag, pat_exp_list) ->
+          (* of rec_flag * (pattern * expression) list *)
+          (* For each value, look for the value name, then look in the
+             typedtree for the corresponding information,
+             at last analyse this information to build the value *)
+          let rec iter_pat = function
+            | Parsetree.Ppat_any -> None
+            | Parsetree.Ppat_var name -> Some name
+            | Parsetree.Ppat_tuple _ -> None (* FIXME when we will handle tuples *)
+            | Parsetree.Ppat_constraint (pat, _) -> iter_pat pat.Parsetree.ppat_desc
+            | _ -> None
+          in
+          let rec iter ?(first=false) last_pos acc_env acc p_e_list =
+            match p_e_list with
+              [] ->
+                (acc_env, acc)
+            | {Parsetree.pvb_pat=pat; pvb_expr=exp} :: q ->
+                let value_name_opt = iter_pat pat.Parsetree.ppat_desc in
+                let new_last_pos = exp.Parsetree.pexp_loc.Location.loc_end.Lexing.pos_cnum in
+                match value_name_opt with
+                  None ->
+                    iter new_last_pos acc_env acc q
+                | Some name ->
+                    try
+                      let pat_exp = Typedtree_search.search_value table_values name.txt in
+                      let (info_opt, ele_comments) =
+                        (* we already have the optional comment for the first value. *)
+                        if first then
+                          (comment_opt, [])
+                        else
+                          get_comments_in_module
+                            last_pos
+                            pat.Parsetree.ppat_loc.Location.loc_start.Lexing.pos_cnum
+                      in
+                      let l_values = tt_analyse_value
+                          env
+                          current_module_name
+                          info_opt
+                          loc
+                          pat_exp
+                          rec_flag
+                      in
+                      let new_env = List.fold_left
+                          (fun e -> fun v ->
+                            Odoc_env.add_value e v.val_name
+                          )
+                          acc_env
+                          l_values
+                      in
+                      let l_ele = List.map (fun v -> Element_value v) l_values in
+                      iter
+                        new_last_pos
+                        new_env
+                        (acc @ ele_comments @ l_ele)
+                        q
+                    with
+                      Not_found ->
+                        iter new_last_pos acc_env acc q
+          in
+          let (new_env, l_ele) = iter ~first: true loc.Location.loc_start.Lexing.pos_cnum env [] pat_exp_list in
+          (0, new_env, l_ele)
+
+      | Parsetree.Pstr_primitive val_desc ->
+            let name_pre = val_desc.Parsetree.pval_name.txt in
+            (* of string * value_description *)
+            print_DEBUG ("Parsetree.Pstr_primitive ("^name_pre^", ["^(String.concat ", " val_desc.Parsetree.pval_prim)^"]");
+            let typ = Typedtree_search.search_primitive table name_pre in
+            let name = Name.parens_if_infix name_pre in
+            let complete_name = Name.concat current_module_name name in
+            let code =
+              if !Odoc_global.keep_code then
+                Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum
+                      loc.Location.loc_end.Lexing.pos_cnum)
+              else
+                None
+            in
+            let new_value = {
+                val_name = complete_name ;
+                val_info = comment_opt ;
+                val_type = Odoc_env.subst_type env typ ;
+                val_recursive = false ;
+                val_parameters = [] ;
+                val_code = code ;
+                val_loc = { loc_impl = Some loc ; loc_inter = None } ;
+              }
+            in
+            let new_env = Odoc_env.add_value env new_value.val_name in
+            (0, new_env, [Element_value new_value])
+
+      | Parsetree.Pstr_type (rf, name_typedecl_list) ->
+          (* of (string * type_declaration) list *)
+          let extended_env =
+            List.fold_left
+              (fun acc_env {Parsetree.ptype_name = { txt = name }} ->
+                let complete_name = Name.concat current_module_name name in
+                Odoc_env.add_type acc_env complete_name
+              )
+              env
+              name_typedecl_list
+          in
+          let env =
+            match rf with
+            | Recursive -> extended_env
+            | Nonrecursive -> env
+          in
+          let rec f ?(first=false) maybe_more_acc last_pos name_type_decl_list =
+            match name_type_decl_list with
+              [] -> (maybe_more_acc, [])
+            | type_decl :: q ->
+                let name = type_decl.Parsetree.ptype_name.txt in
+                let complete_name = Name.concat current_module_name name in
+                let loc = type_decl.Parsetree.ptype_loc in
+                let loc_start = loc.Location.loc_start.Lexing.pos_cnum in
+                let loc_end =  loc.Location.loc_end.Lexing.pos_cnum in
+                let pos_limit2 =
+                  match q with
+                      [] -> pos_limit
+                    | td :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum
+                  in
+                  let (maybe_more, name_comment_list) =
+                    Sig.name_comment_from_type_decl loc_end pos_limit2 type_decl
+                  in
+                  let tt_type_decl =
+                    try Typedtree_search.search_type_declaration table name
+                    with Not_found -> raise (Failure (Odoc_messages.type_not_found_in_typedtree complete_name))
+                  in
+                  let tt_type_decl = tt_type_decl.Typedtree.typ_type in
+                  let (com_opt, ele_comments) = (* the comment for the first type was already retrieved *)
+                    if first then
+                      (comment_opt , [])
+                    else
+                      get_comments_in_module last_pos loc_start
+                  in
+                  let kind = Sig.get_type_kind
+                    env name_comment_list
+                    tt_type_decl.Types.type_kind
+                  in
+                  let new_end = loc_end + maybe_more in
+                  let t =
+                    {
+                      ty_name = complete_name ;
+                      ty_info = com_opt ;
+                      ty_parameters =
+                      List.map2
+                       (fun p v ->
+                         let (co, cn) = Types.Variance.get_upper v in
+                         (Odoc_env.subst_type env p, co, cn))
+                       tt_type_decl.Types.type_params
+                       tt_type_decl.Types.type_variance ;
+                      ty_kind = kind ;
+                      ty_private = tt_type_decl.Types.type_private;
+                      ty_manifest =
+                        (match tt_type_decl.Types.type_manifest with
+                           None -> None
+                         | Some t ->
+                           Some (Sig.manifest_structure env name_comment_list t));
+                      ty_loc = { loc_impl = Some loc ; loc_inter = None } ;
+                      ty_code =
+                      (
+                       if !Odoc_global.keep_code then
+                         Some (get_string_of_file loc_start new_end)
+                       else
+                         None
+                      ) ;
+                    }
+                  in
+                  let (maybe_more2, info_after_opt) =
+                    My_ir.just_after_special
+                    !file_name
+                    (get_string_of_file new_end pos_limit2)
+                  in
+                  t.ty_info <- Sig.merge_infos t.ty_info info_after_opt ;
+                  let (maybe_more3, eles) = f (maybe_more + maybe_more2) (new_end + maybe_more2) q in
+                  (maybe_more3, ele_comments @ ((Element_type t) :: eles))
+            in
+            let (maybe_more, eles) = f ~first: true 0 loc.Location.loc_start.Lexing.pos_cnum name_typedecl_list in
+            (maybe_more, extended_env, eles)
+
+      | Parsetree.Pstr_typext tyext ->
+          (* we get the extension declaration in the typed tree *)
+          let tt_tyext =
+            match tyext.Parsetree.ptyext_constructors with
+              [] -> assert false
+            | ext :: _ ->
+                try
+                  Typedtree_search.search_extension table ext.Parsetree.pext_name.txt
+                with Not_found ->
+                  raise (Failure
+                           (Odoc_messages.extension_not_found_in_typedtree
+                          (Name.concat current_module_name ext.Parsetree.pext_name.txt)))
+          in
+          let new_env =
+            List.fold_left
+              (fun acc_env -> fun {Parsetree.pext_name = { txt = name }} ->
+                let complete_name = Name.concat current_module_name name in
+                  Odoc_env.add_extension acc_env complete_name
+              )
+              env
+              tyext.Parsetree.ptyext_constructors
+          in
+          let loc_start = loc.Location.loc_start.Lexing.pos_cnum in
+          let loc_end =  loc.Location.loc_end.Lexing.pos_cnum in
+          let new_te =
+            {
+              te_info = comment_opt;
+              te_type_name =
+                Odoc_env.full_type_name new_env (Name.from_path tt_tyext.tyext_path);
+              te_type_parameters =
+                List.map (fun (ctyp, _) -> Odoc_env.subst_type new_env ctyp.ctyp_type)  tt_tyext.tyext_params;
+              te_private = tt_tyext.tyext_private;
+              te_constructors = [];
+              te_loc = { loc_impl = Some loc ; loc_inter = None } ;
+              te_code =
+                (
+                  if !Odoc_global.keep_code then
+                    Some (get_string_of_file loc_start loc_end)
+                  else
+                    None
+                ) ;
+            }
+          in
+          let rec analyse_extension_constructors maybe_more exts_acc tt_ext_list =
+              match tt_ext_list with
+                  [] -> (maybe_more, List.rev exts_acc)
+                | tt_ext :: q ->
+                    let complete_name = Name.concat current_module_name tt_ext.ext_name.txt in
+                    let ext_loc_end =  tt_ext.ext_loc.Location.loc_end.Lexing.pos_cnum in
+                    let new_xt =
+                      match tt_ext.ext_kind with
+                          Text_decl(args, ret_type) ->
+                          let xt_args =
+                            Sig.get_cstr_args new_env ext_loc_end args in
+                            {
+                              xt_name = complete_name;
+                              xt_args;
+                              xt_ret =
+                                Option.map (fun ctyp -> Odoc_env.subst_type new_env ctyp.ctyp_type) ret_type;
+                              xt_type_extension = new_te;
+                              xt_alias = None;
+                              xt_loc = { loc_impl = Some tt_ext.ext_loc ; loc_inter = None } ;
+                              xt_text = None;
+                            }
+                        | Text_rebind(path, _) ->
+                            {
+                              xt_name = complete_name;
+                              xt_args = Cstr_tuple [];
+                              xt_ret = None;
+                              xt_type_extension = new_te;
+                              xt_alias =
+                                Some {
+                                  xa_name = Odoc_env.full_extension_constructor_name env (Name.from_path path);
+                                  xa_xt = None;
+                                };
+                              xt_loc = { loc_impl = Some tt_ext.ext_loc ; loc_inter = None } ;
+                              xt_text = None;
+                            }
+                    in
+                      let pos_limit2 =
+                        match q with
+                          [] -> pos_limit
+                        | next :: _ ->
+                            next.ext_loc.Location.loc_start.Lexing.pos_cnum
+                      in
+                      let s = get_string_of_file ext_loc_end pos_limit2 in
+                      let (maybe_more, comment_opt) =  My_ir.just_after_special !file_name s in
+                        new_xt.xt_text <- comment_opt;
+                        analyse_extension_constructors maybe_more (new_xt :: exts_acc) q
+          in
+            let (maybe_more, exts) = analyse_extension_constructors 0 [] tt_tyext.tyext_constructors in
+              new_te.te_constructors <- exts;
+              (maybe_more, new_env, [ Element_type_extension new_te ])
+
+      | Parsetree.Pstr_exception ext ->
+          let name = ext.Parsetree.ptyexn_constructor.Parsetree.pext_name in
+          (* a new exception is defined *)
+          let complete_name = Name.concat current_module_name name.txt in
+          (* we get the exception declaration in the typed tree *)
+          let tt_ext =
+            try Typedtree_search.search_exception table name.txt
+            with Not_found ->
+              raise (Failure (Odoc_messages.exception_not_found_in_typedtree complete_name))
+          in
+          let new_env = Odoc_env.add_extension env complete_name in
+          let new_ext =
+            match tt_ext.Typedtree.tyexn_constructor.ext_kind with
+              Text_decl(tt_args, tt_ret_type) ->
+                let loc_start = loc.Location.loc_start.Lexing.pos_cnum in
+                let loc_end =  loc.Location.loc_end.Lexing.pos_cnum in
+                let ex_args =
+                  Sig.get_cstr_args env loc_end tt_args in
+                {
+                  ex_name = complete_name ;
+                  ex_info = comment_opt ;
+                  ex_args;
+                  ex_ret =
+                    Option.map
+                      (fun ctyp -> Odoc_env.subst_type new_env ctyp.ctyp_type)
+                      tt_ret_type;
+                  ex_alias = None ;
+                  ex_loc = { loc_impl = Some loc ; loc_inter = None } ;
+                  ex_code =
+                    (
+                      if !Odoc_global.keep_code then
+                        Some (get_string_of_file loc_start loc_end)
+                      else
+                        None
+                    ) ;
+                }
+            | Text_rebind(tt_path, _) ->
+                {
+                  ex_name = complete_name ;
+                  ex_info = comment_opt ;
+                  ex_args = Cstr_tuple [] ;
+                  ex_ret = None ;
+                  ex_alias =
+                    Some { ea_name =
+                             Odoc_env.full_extension_constructor_name
+                               env (Name.from_path tt_path) ;
+                           ea_ex = None ; } ;
+                  ex_loc = { loc_impl = Some loc ; loc_inter = None } ;
+                  ex_code = None ;
+                }
+          in
+            (0, new_env, [ Element_exception new_ext ])
+
+      | Parsetree.Pstr_module {Parsetree.pmb_name={txt=None}} ->
+          (0, env, [])
+
+      | Parsetree.Pstr_module {Parsetree.pmb_name={txt=Some name}; pmb_expr=module_expr} ->
+          (
+           (* of string * module_expr *)
+           try
+             let tt_module_expr = Typedtree_search.search_module table name in
+             let new_module_pre = analyse_module
+                 env
+                 current_module_name
+                 name
+                 comment_opt
+                 module_expr
+                 tt_module_expr
+             in
+             let code =
+               if !Odoc_global.keep_code then
+                 let loc = module_expr.Parsetree.pmod_loc in
+                 let st = loc.Location.loc_start.Lexing.pos_cnum in
+                 let en = loc.Location.loc_end.Lexing.pos_cnum in
+                 Some (get_string_of_file st en)
+               else
+                 None
+             in
+             let new_module =
+               { new_module_pre with m_code = code }
+             in
+             let new_env = Odoc_env.add_module env new_module.m_name in
+             let new_env2 =
+               match new_module.m_type with
+                 (* FIXME : can this be Tmty_ident? In this case, we wouldn't have the signature *)
+                 Types.Mty_signature s ->
+                   Odoc_env.add_signature new_env new_module.m_name
+                     ~rel: (Name.simple new_module.m_name) s
+               | _ ->
+                   new_env
+             in
+             (0, new_env2, [ Element_module new_module ])
+           with
+             Not_found ->
+               let complete_name = Name.concat current_module_name name in
+               raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name))
+          )
+
+      | Parsetree.Pstr_recmodule mods ->
+          (* FIXME Here problem: no link with module types
+             in module constraints *)
+          let new_env =
+            List.fold_left
+              (fun acc_env {Parsetree.pmb_name=name;pmb_expr=mod_exp} ->
+                 match name.txt with
+                 | None -> acc_env
+                 | Some name ->
+                     let complete_name = Name.concat current_module_name name in
+                     let e = Odoc_env.add_module acc_env complete_name in
+                     let tt_mod_exp =
+                       try Typedtree_search.search_module table name
+                       with Not_found -> raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name))
+                     in
+                     let new_module = analyse_module
+                         e
+                         current_module_name
+                         name
+                         None
+                         mod_exp
+                         tt_mod_exp
+                     in
+                     match new_module.m_type with
+                       Types.Mty_signature s ->
+                         Odoc_env.add_signature e new_module.m_name
+                           ~rel: (Name.simple new_module.m_name) s
+                       | _ ->
+                           e
+              )
+              env
+              mods
+          in
+          let rec f ?(first=false) last_pos name_mod_exp_list =
+            match name_mod_exp_list with
+              [] -> []
+            | {Parsetree.pmb_name={txt=None};pmb_expr=mod_exp} :: q ->
+                let loc_start = mod_exp.Parsetree.pmod_loc.Location.loc_start.Lexing.pos_cnum in
+                let loc_end =  mod_exp.Parsetree.pmod_loc.Location.loc_end.Lexing.pos_cnum in
+                let (_, ele_comments) = (* the comment for the first type was already retrieved *)
+                  if first then
+                    (None, [])
+                  else
+                    get_comments_in_module last_pos loc_start
+                in
+                let eles = f loc_end q in
+                ele_comments @ eles
+            | {Parsetree.pmb_name={txt=Some name};pmb_expr=mod_exp} :: q ->
+                let complete_name = Name.concat current_module_name name in
+                let loc_start = mod_exp.Parsetree.pmod_loc.Location.loc_start.Lexing.pos_cnum in
+                let loc_end =  mod_exp.Parsetree.pmod_loc.Location.loc_end.Lexing.pos_cnum in
+                let tt_mod_exp =
+                  try Typedtree_search.search_module table name
+                  with Not_found -> raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name))
+                in
+                let (com_opt, ele_comments) = (* the comment for the first type was already retrieved *)
+                  if first then
+                    (comment_opt, [])
+                  else
+                    get_comments_in_module last_pos loc_start
+                in
+                let new_module = analyse_module
+                    new_env
+                    current_module_name
+                    name
+                    com_opt
+                    mod_exp
+                    tt_mod_exp
+                in
+                let eles = f loc_end q in
+                ele_comments @ ((Element_module new_module) :: eles)
+          in
+          let eles = f ~first: true loc.Location.loc_start.Lexing.pos_cnum mods in
+          (0, new_env, eles)
+
+      | Parsetree.Pstr_modtype {Parsetree.pmtd_name=name; pmtd_type=modtype} ->
+          let complete_name = Name.concat current_module_name name.txt in
+          let tt_module_type =
+            try Typedtree_search.search_module_type table name.txt
+            with Not_found ->
+              raise (Failure (Odoc_messages.module_type_not_found_in_typedtree complete_name))
+          in
+          let kind, sig_mtype =
+            match modtype, tt_module_type.mtd_type with
+            | Some modtype, Some mty_type ->
+                Some (Sig.analyse_module_type_kind env complete_name
+                        modtype mty_type.mty_type),
+                Some mty_type.mty_type
+            | _ -> None, None
+          in
+          let mt =
+            {
+              mt_name = complete_name ;
+              mt_info = comment_opt ;
+              mt_type = sig_mtype ;
+              mt_is_interface = false ;
+              mt_file = !file_name ;
+              mt_kind = kind ;
+              mt_loc = { loc_impl = Some loc ; loc_inter = None } ;
+            }
+          in
+          let new_env = Odoc_env.add_module_type env mt.mt_name in
+          let new_env2 =
+            match sig_mtype with
+              (* FIXME : can this be Tmty_ident? In this case, we wouldn't have the signature *)
+              Some (Types.Mty_signature s) ->
+                Odoc_env.add_signature new_env mt.mt_name ~rel: (Name.simple mt.mt_name) s
+            | _ ->
+                new_env
+          in
+          (0, new_env2, [ Element_module_type mt ])
+
+      | Parsetree.Pstr_open _ ->
+          (* FIXME : extend the environment after open? *)
+          let ele_comments = match comment_opt with
+            None -> []
+          | Some i ->
+              match i.i_desc with
+                None -> []
+              | Some t -> [Element_module_comment t]
+          in
+          (0, env, ele_comments)
+
+      | Parsetree.Pstr_class class_decl_list ->
+          (* we start by extending the environment *)
+          let new_env =
+            List.fold_left
+              (fun acc_env -> fun class_decl ->
+                let complete_name = Name.concat current_module_name class_decl.Parsetree.pci_name.txt in
+                Odoc_env.add_class acc_env complete_name
+              )
+              env
+              class_decl_list
+          in
+          let rec f ?(first=false) last_pos class_decl_list =
+            match class_decl_list with
+              [] ->
+                []
+            | class_decl :: q ->
+                let (tt_class_exp, tt_type_params) =
+                  try Typedtree_search.search_class_exp table class_decl.Parsetree.pci_name.txt
+                  with Not_found ->
+                    let complete_name = Name.concat current_module_name class_decl.Parsetree.pci_name.txt in
+                    raise (Failure (Odoc_messages.class_not_found_in_typedtree complete_name))
+                in
+                let (com_opt, ele_comments) =
+                  if first then
+                    (comment_opt, [])
+                  else
+                    get_comments_in_module last_pos class_decl.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
+                in
+                let last_pos2 = class_decl.Parsetree.pci_loc.Location.loc_end.Lexing.pos_cnum in
+                let new_class = analyse_class
+                    new_env
+                    current_module_name
+                    com_opt
+                    class_decl
+                    tt_type_params
+                    tt_class_exp
+                    table
+                in
+                ele_comments @ ((Element_class new_class) :: (f last_pos2 q))
+          in
+          (0, new_env, f ~first: true loc.Location.loc_start.Lexing.pos_cnum class_decl_list)
+
+      | Parsetree.Pstr_class_type class_type_decl_list ->
+          (* we start by extending the environment *)
+          let new_env =
+            List.fold_left
+              (fun acc_env -> fun class_type_decl ->
+                let complete_name = Name.concat current_module_name class_type_decl.Parsetree.pci_name.txt in
+                Odoc_env.add_class_type acc_env complete_name
+              )
+              env
+              class_type_decl_list
+          in
+          let rec f ?(first=false) last_pos class_type_decl_list =
+            match class_type_decl_list with
+              [] ->
+                []
+            | class_type_decl :: q ->
+                let name = class_type_decl.Parsetree.pci_name in
+                let complete_name = Name.concat current_module_name name.txt in
+                let virt = class_type_decl.Parsetree.pci_virt = Asttypes.Virtual in
+                let tt_cltype_declaration =
+                  try Typedtree_search.search_class_type_declaration table name.txt
+                  with Not_found ->
+                    raise (Failure (Odoc_messages.class_type_not_found_in_typedtree complete_name))
+                  in
+                  let tt_cltype_declaration = tt_cltype_declaration.ci_type_decl in
+                let type_params = tt_cltype_declaration.Types.clty_params in
+                let kind = Sig.analyse_class_type_kind
+                    new_env
+                    complete_name
+                    class_type_decl.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
+                    class_type_decl.Parsetree.pci_expr
+                    tt_cltype_declaration.Types.clty_type
+                in
+                let (com_opt, ele_comments) =
+                  if first then
+                    (comment_opt, [])
+                  else
+                    get_comments_in_module last_pos class_type_decl.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
+                in
+                let last_pos2 = class_type_decl.Parsetree.pci_loc.Location.loc_end.Lexing.pos_cnum in
+                let new_ele =
+                  Element_class_type
+                    {
+                      clt_name = complete_name ;
+                      clt_info = com_opt ;
+                      clt_type = Odoc_env.subst_class_type env tt_cltype_declaration.Types.clty_type ;
+                      clt_type_parameters = List.map (Odoc_env.subst_type new_env) type_params ;
+                      clt_virtual = virt ;
+                      clt_kind = kind ;
+                      clt_loc = { loc_impl = Some loc ;
+                                  loc_inter = None } ;
+                    }
+                in
+                ele_comments @ (new_ele :: (f last_pos2 q))
+          in
+          (0, new_env, f ~first: true loc.Location.loc_start.Lexing.pos_cnum class_type_decl_list)
+
+      | Parsetree.Pstr_include _ ->
+          (* we add a dummy included module which will be replaced by a correct
+             one at the end of the module analysis,
+             to use the Path.t of the included modules in the typdtree. *)
+          let im =
+            {
+              im_name = "dummy" ;
+              im_module = None ;
+              im_info = comment_opt ;
+            }
+          in
+          (0, env, [ Element_included_module im ]) (* FIXME: extend the environment? With what? *)
+
+     (** Analysis of a [Parsetree.module_expr] and a name to return a [t_module].*)
+     and analyse_module env current_module_name module_name comment_opt p_module_expr tt_module_expr =
+      let complete_name = Name.concat current_module_name module_name in
+      let loc = p_module_expr.Parsetree.pmod_loc in
+      let pos_start = loc.Location.loc_start.Lexing.pos_cnum in
+      let pos_end = loc.Location.loc_end.Lexing.pos_cnum in
+      let modtype =
+        (* FIXME : Odoc_env.subst_module_type env  ? *)
+        tt_module_expr.Typedtree.mod_type
+      in
+      let m_code_intf =
+        match p_module_expr.Parsetree.pmod_desc with
+          Parsetree.Pmod_constraint (_, pmodule_type) ->
+            let loc_start = pmodule_type.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
+            let loc_end = pmodule_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
+            Some (get_string_of_file loc_start loc_end)
+        | _ ->
+            None
+      in
+      let m_base =
+        {
+          m_name = complete_name ;
+          m_type = modtype ;
+          m_info = comment_opt ;
+          m_is_interface = false ;
+          m_file = !file_name ;
+          m_kind = Module_struct [] ;
+          m_loc = { loc_impl = Some loc ; loc_inter = None } ;
+          m_top_deps = [] ;
+          m_code = None ; (* code is set by the caller, after the module is created *)
+          m_code_intf = m_code_intf ;
+          m_text_only = false ;
+      }
+      in
+      match (p_module_expr.Parsetree.pmod_desc, tt_module_expr.Typedtree.mod_desc) with
+        (Parsetree.Pmod_ident _, Typedtree.Tmod_ident (path, _))
+        | (Parsetree.Pmod_ident _,
+           Typedtree.Tmod_constraint
+             ({Typedtree.mod_desc = Typedtree.Tmod_ident (path, _)}, _, _, _))
+          ->
+          let alias_name = Odoc_env.full_module_name env (Name.from_path path) in
+          { m_base with m_kind = Module_alias { ma_name = alias_name ;
+                                                ma_module = None ; } }
+
+      | (Parsetree.Pmod_structure p_structure, Typedtree.Tmod_structure tt_structure) ->
+          let elements = analyse_structure env complete_name pos_start pos_end p_structure tt_structure in
+          (* we must complete the included modules *)
+          let included_modules_from_tt = tt_get_included_module_list tt_structure in
+          let elements2 = replace_dummy_included_modules elements included_modules_from_tt in
+          { m_base with m_kind = Module_struct elements2 }
+
+      | (Parsetree.Pmod_functor (param2, p_module_expr2),
+         Typedtree.Tmod_functor (param, tt_module_expr2)) ->
+           let loc, mp_name, mp_kind, mp_type =
+             match param2, param with
+             | Parsetree.Unit, Typedtree.Unit ->
+               Location.none, "*", Module_type_struct [], None
+             | Parsetree.Named (_, pmty), Typedtree.Named (ident, _, mty) ->
+               let loc =  pmty.Parsetree.pmty_loc in
+               let mp_name = Option.fold ~none:"*" ~some:Name.from_ident ident in
+               let mp_kind =
+                 Sig.analyse_module_type_kind env current_module_name pmty
+                   mty.mty_type
+               in
+               let mp_type = Odoc_env.subst_module_type env mty.mty_type in
+               loc, mp_name, mp_kind, Some mp_type
+             | _, _ -> assert false
+           in
+           let loc_start = loc.Location.loc_start.Lexing.pos_cnum in
+           let loc_end = loc.Location.loc_end.Lexing.pos_cnum in
+           let mp_type_code = get_string_of_file loc_start loc_end in
+           print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
+           let param =
+             {
+               mp_name ;
+               mp_type ;
+               mp_type_code = mp_type_code ;
+               mp_kind ;
+             }
+           in
+           let dummy_complete_name = (*Name.concat "__"*) param.mp_name in
+           (* TODO: FIX THIS  __ *)
+           let new_env = Odoc_env.add_module env dummy_complete_name in
+           let m_base2 = analyse_module
+               new_env
+               current_module_name
+               module_name
+               None
+               p_module_expr2
+               tt_module_expr2
+           in
+           let kind = m_base2.m_kind in
+           { m_base with m_kind = Module_functor (param, kind) }
+
+      | (Parsetree.Pmod_apply (p_module_expr1, p_module_expr2),
+         Typedtree.Tmod_apply (tt_module_expr1, tt_module_expr2, _))
+      | (Parsetree.Pmod_apply (p_module_expr1, p_module_expr2),
+         Typedtree.Tmod_constraint
+           ({ Typedtree.mod_desc = Typedtree.Tmod_apply (tt_module_expr1, tt_module_expr2, _)}, _,
+            _, _)
+        ) ->
+          let m1 = analyse_module
+              env
+              current_module_name
+              module_name
+              None
+              p_module_expr1
+              tt_module_expr1
+          in
+          let m2 = analyse_module
+              env
+              current_module_name
+              module_name
+              None
+              p_module_expr2
+              tt_module_expr2
+          in
+          { m_base with m_kind = Module_apply (m1.m_kind, m2.m_kind) }
+
+      | (Parsetree.Pmod_constraint (p_module_expr2, p_modtype),
+         Typedtree.Tmod_constraint (tt_module_expr2, tt_modtype, _, _)) ->
+          print_DEBUG ("Odoc_ast: case Parsetree.Pmod_constraint + Typedtree.Tmod_constraint "^module_name);
+          let m_base2 = analyse_module
+              env
+              current_module_name
+              module_name
+              None
+              p_module_expr2
+              tt_module_expr2
+          in
+          let mtkind = Sig.analyse_module_type_kind env
+              (Name.concat current_module_name "??")
+              p_modtype tt_modtype
+          in
+          let tt_modtype = Odoc_env.subst_module_type env tt_modtype in
+          if !Odoc_global.filter_with_module_constraints then
+            filter_module_with_module_type_constraint m_base2 tt_modtype;
+          {
+            m_base with
+            m_type = tt_modtype ;
+            m_kind = Module_constraint (m_base2.m_kind, mtkind) ;
+          }
+
+      | (Parsetree.Pmod_structure p_structure,
+         Typedtree.Tmod_constraint
+           ({ Typedtree.mod_desc = Typedtree.Tmod_structure tt_structure},
+            tt_modtype, _, _)
+        ) ->
+          (* needed for recursive modules *)
+
+          print_DEBUG ("Odoc_ast: case Parsetree.Pmod_structure + Typedtree.Tmod_constraint "^module_name);
+          let elements = analyse_structure env complete_name pos_start pos_end p_structure tt_structure in
+          (* we must complete the included modules *)
+          let included_modules_from_tt = tt_get_included_module_list tt_structure in
+          let elements2 = replace_dummy_included_modules elements included_modules_from_tt in
+          { m_base with
+            m_type = Odoc_env.subst_module_type env tt_modtype ;
+            m_kind = Module_struct elements2 ;
+          }
+
+      | (Parsetree.Pmod_unpack p_exp,
+         Typedtree.Tmod_unpack (_t_exp, tt_modtype)) ->
+          print_DEBUG ("Odoc_ast: case Parsetree.Pmod_unpack + Typedtree.Tmod_unpack "^module_name);
+          let code =
+            let loc = p_module_expr.Parsetree.pmod_loc in
+            let loc_end = loc.Location.loc_end.Lexing.pos_cnum in
+            let exp_loc = p_exp.Parsetree.pexp_loc in
+            let exp_loc_end = exp_loc.Location.loc_end.Lexing.pos_cnum in
+            let s = get_string_of_file exp_loc_end loc_end in
+            Printf.sprintf "(val ...%s" s
+          in
+          (* let name = Odoc_env.full_module_type_name env (Name.from_path (fst pkg_type)) in *)
+          let name =
+            match tt_modtype with
+            | Mty_ident p ->
+                Odoc_env.full_module_type_name env (Name.from_path p)
+            | _ -> ""
+          in
+          let alias = { mta_name = name ; mta_module = None } in
+          { m_base with
+            m_type = Odoc_env.subst_module_type env tt_modtype ;
+            m_kind = Module_unpack (code, alias) ;
+          }
+
+      | (_parsetree, _typedtree) ->
+          (*DEBUG*)let s_parse =
+          (*DEBUG*)  match _parsetree with
+          (*DEBUG*)    Parsetree.Pmod_ident _ -> "Pmod_ident"
+          (*DEBUG*)  | Parsetree.Pmod_structure _ -> "Pmod_structure"
+          (*DEBUG*)  | Parsetree.Pmod_functor _ -> "Pmod_functor"
+          (*DEBUG*)  | Parsetree.Pmod_apply _ -> "Pmod_apply"
+          (*DEBUG*)  | Parsetree.Pmod_constraint _ -> "Pmod_constraint"
+          (*DEBUG*)  | Parsetree.Pmod_unpack _ -> "Pmod_unpack"
+          (*DEBUG*)  | Parsetree.Pmod_extension _ -> "Pmod_extension"
+          (*DEBUG*)in
+          (*DEBUG*)let s_typed =
+          (*DEBUG*)  match _typedtree with
+          (*DEBUG*)    Typedtree.Tmod_ident _ -> "Tmod_ident"
+          (*DEBUG*)  | Typedtree.Tmod_structure _ -> "Tmod_structure"
+          (*DEBUG*)  | Typedtree.Tmod_functor _ -> "Tmod_functor"
+          (*DEBUG*)  | Typedtree.Tmod_apply _ -> "Tmod_apply"
+          (*DEBUG*)  | Typedtree.Tmod_constraint _ -> "Tmod_constraint"
+          (*DEBUG*)  | Typedtree.Tmod_unpack _ -> "Tmod_unpack"
+          (*DEBUG*)in
+          (*DEBUG*)let code = get_string_of_file pos_start pos_end in
+          print_DEBUG (Printf.sprintf "code=%s\ns_parse=%s\ns_typed=%s\n" code s_parse s_typed);
+
+          raise (Failure "analyse_module: parsetree and typedtree don't match.")
+
+     let analyse_typed_tree source_file input_file
+         (parsetree : Parsetree.structure) (typedtree : typedtree) =
+       let (tree_structure, _) = typedtree in
+       prepare_file source_file input_file;
+       (* We create the t_module for this file. *)
+       let mod_name = String.capitalize_ascii (Filename.basename (Filename.chop_extension source_file)) in
+       let len, info_opt = Sig.preamble !file_name !file
+           (fun x -> x.Parsetree.pstr_loc) parsetree in
+       (* we must complete the included modules *)
+       let elements = analyse_structure Odoc_env.empty mod_name len (String.length !file) parsetree tree_structure in
+       let included_modules_from_tt = tt_get_included_module_list tree_structure in
+       let elements2 = replace_dummy_included_modules elements included_modules_from_tt in
+       let kind = Module_struct elements2 in
+       {
+         m_name = mod_name ;
+         m_type = Types.Mty_signature [] ;
+         m_info = info_opt ;
+         m_is_interface = false ;
+         m_file = !file_name ;
+         m_kind = kind ;
+         m_loc = { loc_impl = Some (Location.in_file !file_name) ; loc_inter = None } ;
+         m_top_deps = [] ;
+         m_code = (if !Odoc_global.keep_code then Some !file else None) ;
+         m_code_intf = None ;
+         m_text_only = false ;
+       }
+  end
diff --git a/ocamldoc/odoc_ast.mli b/ocamldoc/odoc_ast.mli
new file mode 100644
index 00000000..754800d9
--- /dev/null
+++ b/ocamldoc/odoc_ast.mli
@@ -0,0 +1,101 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The module for analysing the typed abstract syntax tree and source code and creating modules, classes, ..., elements.*)
+
+type typedtree = Typedtree.structure * Typedtree.module_coercion
+
+(** This module is used to search for structure items by name in a [Typedtree.structure]. *)
+module Typedtree_search :
+    sig
+      type ele
+
+      type tab = (ele, Typedtree.structure_item_desc) Hashtbl.t
+      type tab_values = (Odoc_name.t, Typedtree.pattern * Typedtree.expression) Hashtbl.t
+
+      (** Create hash tables used to search by some of the functions below. *)
+      val tables : Typedtree.structure_item list -> tab * tab_values
+
+      (** This function returns the [Typedtree.module_expr] associated to the given module name,
+         in the given table.
+         @raise Not_found if the module was not found.*)
+      val search_module : tab -> string -> Typedtree.module_expr
+
+      (** This function returns the [Typedtree.module_type] associated to the given module type name,
+         in the given table.
+         @raise Not_found if the module type was not found.*)
+      val search_module_type : tab -> string -> Typedtree.module_type_declaration
+
+      (** This function returns the [Typedtree.type_extension] associated to the given extension name,
+         in the given table.
+         @raise Not_found if the extension was not found.*)
+      val search_extension : tab -> string -> Typedtree.type_extension
+
+      (** This function returns the [Typedtree.type_declaration] associated to the given type name,
+         in the given table.
+         @raise Not_found if the type was not found. *)
+      val search_type_declaration : tab -> string -> Typedtree.type_declaration
+
+      (** This function returns the [Typedtree.class_expr] and type parameters
+         associated to the given class name, in the given table.
+         @raise Not_found if the class was not found. *)
+      val search_class_exp : tab -> string -> (Typedtree.class_expr * (Types.type_expr list))
+
+      (** This function returns the [Typedtree.class_type_declaration] associated to the given class type name,
+         in the given table.
+         @raise Not_found if the class type was not found. *)
+      val search_class_type_declaration : tab -> string -> Typedtree.class_type_declaration
+
+      (** This function returns the couple (pat, exp) for the given value name, in the
+         given table of values.
+         @raise Not found if no value matches the name.*)
+      val search_value : tab_values -> string -> Typedtree.pattern * Typedtree.expression
+
+      (** This function returns the [type_expr] for the given primitive name, in the
+         given table.
+         @raise Not found if no value matches the name.*)
+      val search_primitive : tab -> string -> Types.type_expr
+
+      (** This function returns the [Typedtree.class_expr] associated to
+         the n'th inherit in the given class structure of typed tree.
+         @raise Not_found if the class expression could not be found.*)
+      val get_nth_inherit_class_expr :
+          Typedtree.class_structure -> int -> Typedtree.class_expr
+
+      (** This function returns the [Types.type_expr] of the attribute
+         whose name is given, in a given class structure.
+         @raise Not_found if the class attribute could not be found.*)
+      val search_attribute_type :
+          Typedtree.class_structure -> string -> Types.type_expr
+
+      (** This function returns the [Types.expression] of the method whose name is given, in a given class structure.
+         @raise Not_found if the class method could not be found.*)
+      val search_method_expression :
+          Typedtree.class_structure -> string -> Typedtree.expression
+    end
+
+(** The module which performs the analysis of a typed tree.
+   The module uses the module {!Odoc_sig.Analyser}.
+   @param My_ir The module used to retrieve comments and special comments.*)
+module Analyser :
+  Odoc_sig.Info_retriever ->
+    sig
+      (** This function takes a file name, a file containing the code and
+         the typed tree obtained from the compiler.
+         It goes through the tree, creating values for encountered
+         functions, modules, ..., and looking in the source file for comments.*)
+      val analyse_typed_tree :
+        string -> string -> Parsetree.structure -> typedtree -> Odoc_module.t_module
+    end
diff --git a/ocamldoc/odoc_class.ml b/ocamldoc/odoc_class.ml
new file mode 100644
index 00000000..b25d89c5
--- /dev/null
+++ b/ocamldoc/odoc_class.ml
@@ -0,0 +1,252 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Representation and manipulation of classes and class types.*)
+
+module Name = Odoc_name
+
+(** To keep the order of elements in a class *)
+type class_element =
+    Class_attribute of Odoc_value.t_attribute
+  | Class_method of Odoc_value.t_method
+  | Class_comment of Odoc_types.text
+
+(** Used when we can reference t_class or t_class_type. *)
+type cct =
+    Cl of t_class
+  | Cltype of t_class_type * Types.type_expr list (** class type and type parameters *)
+
+and inherited_class = {
+    ic_name : Name.t ; (** Complete name of the inherited class *)
+    mutable ic_class : cct option ; (** The associated t_class or t_class_type *)
+    ic_text : Odoc_types.text option ; (** The inheritance comment, if any *)
+  }
+
+and class_apply = {
+    capp_name : Name.t ; (** The complete name of the applied class *)
+    mutable capp_class : t_class option;  (** The associated t_class if we found it *)
+    capp_params : Types.type_expr list; (** The type of expressions the class is applied to *)
+    capp_params_code : string list ; (** The code of these expressions *)
+  }
+
+and class_constr = {
+    cco_name : Name.t ; (** The complete name of the applied class *)
+    mutable cco_class : cct option;  (** The associated class of the class type if we found it *)
+    cco_type_parameters : Types.type_expr list; (** The type parameters of the class, if needed *)
+  }
+
+
+and class_kind =
+    Class_structure of inherited_class list * class_element list
+        (** an explicit class structure, used in implementation and interface *)
+  | Class_apply of class_apply (** application/alias of a class, used in implementation only *)
+  | Class_constr of class_constr (** a class used to give the type of the defined class,
+                                    instead of a structure, used in interface only.
+                                    For example, it will be used with the name "M1.M2....tutu"
+                                    when the class toto is defined like this :
+                                    class toto : int -> tutu *)
+  | Class_constraint of class_kind * class_type_kind
+        (** A class definition with a constraint. *)
+
+(** Representation of a class. *)
+and t_class = {
+    cl_name : Name.t ; (** Name of the class *)
+    mutable cl_info : Odoc_types.info option ; (** The optional associated user information *)
+    cl_type : Types.class_type ;
+    cl_type_parameters : Types.type_expr list ; (** Type parameters *)
+    cl_virtual : bool ; (** true = virtual *)
+    mutable cl_kind : class_kind ;
+    mutable cl_parameters : Odoc_parameter.parameter list ;
+    mutable cl_loc : Odoc_types.location ;
+  }
+
+and class_type_alias = {
+    cta_name : Name.t ;
+    mutable cta_class : cct option ; (** we can have a t_class or a t_class_type *)
+    cta_type_parameters : Types.type_expr list ; (** the type parameters *)
+  }
+
+and class_type_kind =
+    Class_signature of inherited_class list * class_element list
+  | Class_type of class_type_alias (** a class type eventually applied to type args *)
+
+(** Representation of a class type. *)
+and t_class_type = {
+    clt_name : Name.t ;
+    mutable clt_info : Odoc_types.info option ; (** The optional associated user information *)
+    clt_type : Types.class_type ;
+    clt_type_parameters : Types.type_expr list ; (** type parameters *)
+    clt_virtual : bool ; (** true = virtual *)
+    mutable clt_kind : class_type_kind ;
+    mutable clt_loc : Odoc_types.location ;
+  }
+
+
+(** {1 Functions} *)
+
+(** Returns the text associated to the given parameter label
+   in the given class, or None. *)
+let class_parameter_text_by_name cl label =
+  match cl.cl_info with
+    None -> None
+  | Some i ->
+      try
+        let t = List.assoc label i.Odoc_types.i_params in
+        Some t
+      with
+        Not_found ->
+          None
+
+(** Returns the list of elements of a t_class. *)
+let rec class_elements ?(trans=true) cl =
+  let rec iter_kind k =
+    match k with
+      Class_structure (_, elements) -> elements
+    | Class_constraint (c_kind, _ct_kind) ->
+        iter_kind c_kind
+      (* FIXME : use c_kind or ct_kind ?
+         For now, as ct_kind is not analyzed,
+         we search inside c_kind
+         class_type_elements ~trans: trans
+         { clt_name = "" ; clt_info = None ;
+          clt_type_parameters = [] ;
+         clt_virtual = false ;
+         clt_kind = ct_kind }
+      *)
+    | Class_apply capp ->
+        (
+         match capp.capp_class with
+           Some c when trans -> class_elements ~trans: trans c
+         | _ -> []
+        )
+    | Class_constr cco ->
+        (
+         match cco.cco_class with
+           Some (Cl c) when trans -> class_elements ~trans: trans c
+         | Some (Cltype (ct,_)) when trans -> class_type_elements ~trans: trans ct
+         | _ -> []
+        )
+  in
+  iter_kind cl.cl_kind
+
+(** Returns the list of elements of a t_class_type. *)
+and class_type_elements ?(trans=true) clt =
+  match clt.clt_kind with
+    Class_signature (_, elements) -> elements
+  | Class_type { cta_class = Some (Cltype (ct, _)) } when trans ->
+      class_type_elements ~trans ct
+  | Class_type { cta_class = Some (Cl c) } when trans ->
+      class_elements ~trans c
+  | Class_type _ ->
+      []
+
+(** Returns the attributes of a t_class. *)
+let class_attributes ?(trans=true) cl =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Class_attribute a ->
+          acc @ [ a ]
+      | _ ->
+          acc
+    )
+    []
+    (class_elements ~trans cl)
+
+(** Returns the methods of a t_class. *)
+let class_methods ?(trans=true) cl =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Class_method m ->
+          acc @ [ m ]
+      | _ ->
+          acc
+    )
+    []
+    (class_elements ~trans cl)
+
+(** Returns the comments in a t_class. *)
+let class_comments ?(trans=true) cl =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Class_comment t ->
+          acc @ [ t ]
+      | _ ->
+          acc
+    )
+    []
+    (class_elements ~trans cl)
+
+
+(** Update the parameters text of a t_class, according to the cl_info field. *)
+let class_update_parameters_text cl =
+  let f p =
+    Odoc_parameter.update_parameter_text (class_parameter_text_by_name cl) p
+  in
+  List.iter f cl.cl_parameters
+
+(** Returns the attributes of a t_class_type. *)
+let class_type_attributes ?(trans=true) clt =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Class_attribute a ->
+          acc @ [ a ]
+      | _ ->
+          acc
+    )
+    []
+    (class_type_elements ~trans clt)
+
+(** Returns the methods of a t_class_type. *)
+let class_type_methods ?(trans=true) clt =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Class_method m ->
+          acc @ [ m ]
+      | _ ->
+          acc
+    )
+    []
+    (class_type_elements ~trans clt)
+
+(** Returns the comments in a t_class_type. *)
+let class_type_comments ?(trans=true) clt =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Class_comment m ->
+          acc @ [ m ]
+      | _ ->
+          acc
+    )
+    []
+    (class_type_elements ~trans clt)
+
+(** Returns the text associated to the given parameter label
+   in the given class type, or None. *)
+let class_type_parameter_text_by_name clt label =
+  match clt.clt_info with
+    None -> None
+  | Some i ->
+      try
+        let t = List.assoc label i.Odoc_types.i_params in
+        Some t
+      with
+        Not_found ->
+          None
diff --git a/ocamldoc/odoc_comments.ml b/ocamldoc/odoc_comments.ml
new file mode 100644
index 00000000..e408829b
--- /dev/null
+++ b/ocamldoc/odoc_comments.ml
@@ -0,0 +1,262 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Analysis of comments. *)
+
+open Odoc_types
+
+let print_DEBUG s = print_string s ; print_newline ();;
+
+(** This variable contains the regular expression representing a blank but not a '\n'.*)
+let simple_blank = "[ \013\009\012]"
+
+module type Texter =
+    sig
+      (** Return a text structure from a string. *)
+      val text_of_string : string -> text
+    end
+
+module Info_retriever =
+  functor (MyTexter : Texter) ->
+  struct
+    let create_see _file s =
+      try
+        let lexbuf = Lexing.from_string s in
+        let (see_ref, s) = Odoc_parser.see_info Odoc_see_lexer.main lexbuf in
+        (see_ref, MyTexter.text_of_string s)
+      with
+      | Odoc_text.Text_syntax (l, c, s) ->
+          raise (Failure (Odoc_messages.text_parse_error l c s))
+      | _ ->
+          raise (Failure ("Unknown error while parsing @see tag: "^s))
+
+    let retrieve_info fun_lex file (s : string) =
+      try
+        Odoc_comments_global.init ();
+        Odoc_lexer.comments_level := 0;
+        let lexbuf = Lexing.from_string s in
+        match Odoc_parser.main fun_lex lexbuf with
+          None ->
+            (0, None)
+        | Some (desc, remain_opt) ->
+            let mem_nb_chars = !Odoc_comments_global.nb_chars in
+            begin match remain_opt with
+                None ->
+                  ()
+              | Some s ->
+                  (*DEBUG*)print_string ("remain: "^s); print_newline();
+                  let lexbuf2 = Lexing.from_string s in
+                  Odoc_parser.info_part2 Odoc_lexer.elements lexbuf2
+            end;
+            (mem_nb_chars,
+             Some
+               {
+                 i_desc = (match desc with "" -> None | _ -> Some (MyTexter.text_of_string desc));
+                 i_authors = !Odoc_comments_global.authors;
+                 i_version = !Odoc_comments_global.version;
+                 i_sees = (List.map (create_see file) !Odoc_comments_global.sees) ;
+                 i_since = !Odoc_comments_global.since;
+                 i_before = Odoc_merge.merge_before_tags
+                     (List.map (fun (n, s) ->
+                         (n, MyTexter.text_of_string s)) !Odoc_comments_global.before)
+                   ;
+                 i_deprecated =
+                 (match !Odoc_comments_global.deprecated with
+                   None -> None | Some s -> Some (MyTexter.text_of_string s));
+                 i_params =
+                 (List.map (fun (n, s) ->
+                   (n, MyTexter.text_of_string s)) !Odoc_comments_global.params);
+                 i_raised_exceptions =
+                 (List.map (fun (n, s) ->
+                   (n, MyTexter.text_of_string s)) !Odoc_comments_global.raised_exceptions);
+                 i_return_value =
+                 (match !Odoc_comments_global.return_value with
+                   None -> None | Some s -> Some (MyTexter.text_of_string s)) ;
+                 i_custom = (List.map
+                               (fun (tag, s) -> (tag, MyTexter.text_of_string s))
+                               !Odoc_comments_global.customs)
+               }
+            )
+      with e ->
+        let (l, c, message) = match e with
+          | Failure s -> (!Odoc_lexer.line_number + 1, 0, s)
+          | Odoc_text.Text_syntax (l, c, s) -> (l, c, Odoc_messages.text_parse_error l c s)
+          | _other -> (0, 0, Odoc_messages.parse_error)
+        in begin
+          incr Odoc_global.errors;
+          prerr_endline (Odoc_messages.error_location file l c ^ message);
+          (0, None)
+        end
+
+
+    (** Return true if the given string contains a blank line. *)
+    let blank_line s =
+      try
+        let _ = Str.search_forward (Str.regexp ("['\n']"^simple_blank^"*['\n']")) s 0 in
+        (* a blank line was before the comment *)
+        true
+      with
+        Not_found ->
+          false
+
+    let retrieve_info_special file (s : string) =
+      retrieve_info Odoc_lexer.main file s
+
+    let retrieve_info_simple _file (s : string) =
+      Odoc_comments_global.init ();
+      Odoc_lexer.comments_level := 0;
+      let lexbuf = Lexing.from_string s in
+      match Odoc_parser.main Odoc_lexer.simple lexbuf with
+        None ->
+          (0, None)
+      | Some _ ->
+          (!Odoc_comments_global.nb_chars, Some Odoc_types.dummy_info)
+
+    (** Return true if the given string contains a blank line outside a simple comment. *)
+    let blank_line_outside_simple file s =
+      let rec iter s2 =
+        match retrieve_info_simple file s2 with
+          (_, None) ->
+            blank_line s2
+        | (len, Some _) ->
+            try
+              let pos = Str.search_forward (Str.regexp_string "(*") s2 0 in
+              let s_before = String.sub s2 0 pos in
+              let s_after = String.sub s2 len ((String.length s2) - len) in
+              (blank_line s_before) || (iter s_after)
+            with
+              Not_found ->
+                (* we shouldn't get here *)
+                false
+      in
+      iter s
+
+    let all_special file s =
+      print_DEBUG ("all_special: "^s);
+      let rec iter acc n s2 =
+        match retrieve_info_special file s2 with
+          (_, None) ->
+            (n, acc)
+        | (n2, Some i) ->
+            print_DEBUG ("all_special: avant String.sub new_s="^s2);
+            print_DEBUG ("n2="^(Int.to_string n2)) ;
+            print_DEBUG ("len(s2)="^(Int.to_string (String.length s2))) ;
+            let new_s = String.sub s2 n2 ((String.length s2) - n2) in
+            print_DEBUG ("all_special: apres String.sub new_s="^new_s);
+            iter (acc @ [i]) (n + n2) new_s
+      in
+      let res = iter [] 0 s in
+      print_DEBUG ("all_special: end");
+      res
+
+    let just_after_special file s =
+      print_DEBUG ("just_after_special: "^s);
+      let res = match retrieve_info_special file s with
+        (_, None) ->
+          (0, None)
+      | (len, Some d) ->
+          (* we must not have a simple comment or a blank line before. *)
+          match retrieve_info_simple file (String.sub s 0 len) with
+            (_, None) ->
+              (
+               try
+                 (* if the special comment is the stop comment (**/**),
+                    then we must not associate it. *)
+                 let pos = Str.search_forward (Str.regexp_string "(**") s 0 in
+                 if blank_line (String.sub s 0 pos) ||
+                   d.Odoc_types.i_desc = Some [Odoc_types.Raw "/*"]
+                 then
+                   (0, None)
+                 else
+                   (len, Some d)
+               with
+                 Not_found ->
+                   (* should not occur *)
+                   (0, None)
+              )
+          | (_, Some _) ->
+              (0, None)
+      in
+      print_DEBUG ("just_after_special:end");
+      res
+
+    let first_special file s =
+      retrieve_info_special file s
+
+    let get_comments f_create_ele file s =
+      let (assoc_com, ele_coms) =
+        (* get the comments *)
+        let (len, special_coms) =  all_special file s in
+        (* if there is no blank line after the special comments, and
+           if the last special comment is not the stop special comment, then the
+           last special comments must be associated to the element. *)
+        match List.rev special_coms with
+          [] ->
+            (None, [])
+        |  h :: q ->
+            if (blank_line_outside_simple file
+                  (String.sub s len ((String.length s) - len)) )
+                || h.Odoc_types.i_desc = Some [Odoc_types.Raw "/*"]
+            then
+              (None, special_coms)
+            else
+              (Some h, List.rev q)
+      in
+      let ele_comments =
+        List.fold_left
+          (fun acc -> fun sc ->
+            match sc.Odoc_types.i_desc with
+              None ->
+                acc
+            | Some t ->
+                acc @ [f_create_ele t])
+          []
+          ele_coms
+      in
+      (assoc_com, ele_comments)
+  end
+
+module Basic_info_retriever = Info_retriever (Odoc_text.Texter)
+
+let info_of_string s =
+  let dummy =
+    {
+      i_desc = None ;
+      i_authors = [] ;
+      i_version = None ;
+      i_sees = [] ;
+      i_since = None ;
+      i_before = [] ;
+      i_deprecated = None ;
+      i_params = [] ;
+      i_raised_exceptions = [] ;
+      i_return_value = None ;
+      i_custom = [] ;
+    }
+  in
+  let s2 = Printf.sprintf "(** %s *)" s in
+  let (_, i_opt) = Basic_info_retriever.first_special "-" s2 in
+  match i_opt with
+    None -> dummy
+  | Some i -> i
+
+let info_of_comment_file modlist f =
+  try
+    let s = Odoc_misc.input_file_as_string f in
+    let i = info_of_string s in
+    Odoc_cross.assoc_comments_info "" modlist i
+  with
+    Sys_error s ->
+      failwith s
diff --git a/ocamldoc/odoc_comments.mli b/ocamldoc/odoc_comments.mli
new file mode 100644
index 00000000..1220e589
--- /dev/null
+++ b/ocamldoc/odoc_comments.mli
@@ -0,0 +1,76 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Analysis of comments. *)
+
+val simple_blank : string
+
+(** The type of modules in argument to Info_retriever *)
+module type Texter =
+  sig
+    (** Return a text structure from a string. *)
+    val text_of_string : string -> Odoc_types.text
+  end
+
+(** The basic module for special comments analysis.*)
+module Basic_info_retriever :
+  sig
+    (** Return true if the given string contains a blank line. *)
+    val blank_line_outside_simple :
+        string -> string -> bool
+
+    (** This function retrieves all the special comments in the given string. *)
+    val all_special : string -> string -> int * Odoc_types.info list
+
+    (** [just_after_special file str] return the pair ([length], [info_opt])
+       where [info_opt] is the first optional special comment found
+       in [str], without any blank line before. [length] is the number
+       of chars from the beginning of [str] to the end of the special comment. *)
+    val just_after_special :
+        string -> string -> int * Odoc_types.info option
+
+    (** [first_special file str] return the pair ([length], [info_opt])
+       where [info_opt] is the first optional special comment found
+       in [str]. [length] is the number of chars from the beginning of
+       [str] to the end of the special comment. *)
+    val first_special :
+        string -> string -> int * Odoc_types.info option
+
+    (** Return a pair [(comment_opt, element_comment_list)], where [comment_opt] is the last special
+       comment found in the given string and not followed by a blank line,
+       and [element_comment_list] the list of values built from the other
+       special comments found and the given function. *)
+    val get_comments :
+        (Odoc_types.text -> 'a) ->
+          string -> string -> Odoc_types.info option * 'a list
+
+  end
+
+(** [info_of_string s] parses the given string
+   like a regular ocamldoc comment and return an
+   {!Odoc_types.info} structure.
+   @return an empty structure if there was a syntax error. TODO: change this
+*)
+val info_of_string : string -> Odoc_types.info
+
+(** [info_of_comment_file file] parses the given file
+   and return an {!Odoc_types.info} structure. The content of the
+   file must have the same syntax as the content of a special comment.
+   The given module list is used for cross reference.
+   @raise Failure if the file could not be opened or there is a
+   syntax error.
+*)
+val info_of_comment_file :
+    Odoc_module.t_module list -> string -> Odoc_types.info
diff --git a/ocamldoc/odoc_comments_global.ml b/ocamldoc/odoc_comments_global.ml
new file mode 100644
index 00000000..abd7cd59
--- /dev/null
+++ b/ocamldoc/odoc_comments_global.ml
@@ -0,0 +1,51 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The global variables used by the special comment parser.*)
+
+let nb_chars = ref 0
+
+let authors = ref ([] : string list)
+
+let version = ref (None : string option)
+
+let sees = ref ([] : string list)
+
+let since = ref (None : string option)
+
+let before = ref []
+
+let deprecated = ref (None : string option)
+
+let params = ref ([] : (string * string) list)
+
+let raised_exceptions = ref ([] : (string * string) list)
+
+let return_value = ref (None : string option)
+
+let customs = ref []
+
+let init () =
+  nb_chars := 0;
+  authors := [];
+  version := None;
+  sees := [];
+  since := None;
+  before := [];
+  deprecated := None;
+  params := [];
+  raised_exceptions := [];
+  return_value := None ;
+  customs := []
diff --git a/ocamldoc/odoc_comments_global.mli b/ocamldoc/odoc_comments_global.mli
new file mode 100644
index 00000000..6d1fa48a
--- /dev/null
+++ b/ocamldoc/odoc_comments_global.mli
@@ -0,0 +1,52 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The global variables used by the special comment parser.*)
+
+(** the number of chars used in the lexer. *)
+val nb_chars : int ref
+
+(** the authors list *)
+val authors : string list ref
+
+(** the version string *)
+val version : string option ref
+
+(** the see references *)
+val sees : string list ref
+
+(** the since string *)
+val since : string option ref
+
+(** the before tag information *)
+val before : (string * string) list ref
+
+(** the deprecated flag *)
+val deprecated : string option ref
+
+(** parameters, with name and description *)
+val params : (string * string) list ref
+
+(** the raised exceptions, with name and description *)
+val raised_exceptions : (string * string) list ref
+
+(** the description of the return value *)
+val return_value : string option ref
+
+(** the strings associated to custom tags. *)
+val customs : (string * string) list ref
+
+(** this function inits the variables filled by the parser. *)
+val init : unit -> unit
diff --git a/ocamldoc/odoc_config.ml b/ocamldoc/odoc_config.ml
new file mode 100644
index 00000000..82ca4477
--- /dev/null
+++ b/ocamldoc/odoc_config.ml
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let custom_generators_path =
+  Filename.concat Config.standard_library
+    (Filename.concat "ocamldoc" "custom")
+
+let print_warnings = ref true
diff --git a/ocamldoc/odoc_config.mli b/ocamldoc/odoc_config.mli
new file mode 100644
index 00000000..1ca1af9d
--- /dev/null
+++ b/ocamldoc/odoc_config.mli
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Ocamldoc configuration constants. *)
+
+(** Default path to search for custom generators and to install them. *)
+val custom_generators_path : string
+
+(** A flag to indicate whether to print ocamldoc warnings or not. *)
+val print_warnings : bool ref
diff --git a/ocamldoc/odoc_control.ml b/ocamldoc/odoc_control.ml
new file mode 100644
index 00000000..d47351e9
--- /dev/null
+++ b/ocamldoc/odoc_control.ml
@@ -0,0 +1,14 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
diff --git a/ocamldoc/odoc_cross.ml b/ocamldoc/odoc_cross.ml
new file mode 100644
index 00000000..143c675d
--- /dev/null
+++ b/ocamldoc/odoc_cross.ml
@@ -0,0 +1,1131 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Cross referencing. *)
+
+open Odoc_module
+open Odoc_class
+open Odoc_extension
+open Odoc_exception
+open Odoc_types
+open Odoc_value
+open Odoc_type
+open Odoc_parameter
+
+(*** Replacements of aliases : if e1 = e2 and e2 = e3, then replace e2 by e3 to have e1 = e3,
+   in order to associate the element with complete information. *)
+
+(** The module used to keep what refs were modified. *)
+module S = Set.Make
+    (
+     struct type t = string * ref_kind option
+       let compare = Stdlib.compare
+     end
+    )
+
+let verified_refs = ref S.empty
+
+let add_verified v = verified_refs := S.add v !verified_refs
+let was_verified v = S.mem v !verified_refs
+
+(** The module with the predicates used to get the aliased modules, classes and exceptions. *)
+module P_alias =
+  struct
+    type t = int
+
+    let p_module m _ =
+      (true,
+       match m.m_kind with
+         Module_alias _ -> true
+       | _ -> false
+      )
+    let p_module_type mt _ =
+      (true,
+       match mt.mt_kind with
+         Some (Module_type_alias _) -> true
+       | _ -> false
+      )
+    let p_class _ _ = (false, false)
+    let p_class_type _ _ = (false, false)
+    let p_value _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
+    let p_extension x _ = x.xt_alias <> None
+    let p_exception e _ = e.ex_alias <> None
+    let p_attribute _ _ = false
+    let p_method _ _ = false
+    let p_section _ _ = false
+  end
+
+(** The module used to get the aliased elements. *)
+module Search_alias = Odoc_search.Search (P_alias)
+
+type alias_state =
+  | Alias_to_resolve
+
+(** Couples of module name aliases. *)
+let (module_aliases : (Name.t, Name.t * alias_state) Hashtbl.t) = Hashtbl.create 13 ;;
+
+(** Couples of module or module type name aliases. *)
+let module_and_modtype_aliases = Hashtbl.create 13;;
+
+(** Couples of extension name aliases. *)
+let extension_aliases = Hashtbl.create 13;;
+
+(** Couples of exception name aliases. *)
+let exception_aliases = Hashtbl.create 13;;
+
+let rec build_alias_list = function
+    [] -> ()
+  | (Odoc_search.Res_module m) :: q ->
+      (
+       match m.m_kind with
+         Module_alias ma ->
+           Hashtbl.add module_aliases m.m_name (ma.ma_name, Alias_to_resolve);
+           Hashtbl.add module_and_modtype_aliases m.m_name (ma.ma_name, Alias_to_resolve)
+       | _ -> ()
+      );
+      build_alias_list q
+  | (Odoc_search.Res_module_type mt) :: q ->
+      (
+       match mt.mt_kind with
+         Some (Module_type_alias mta) ->
+           Hashtbl.add module_and_modtype_aliases
+             mt.mt_name (mta.mta_name, Alias_to_resolve)
+       | _ -> ()
+      );
+      build_alias_list q
+  | (Odoc_search.Res_extension x) :: q ->
+      (
+       match x.xt_alias with
+         None -> ()
+       | Some xa ->
+           Hashtbl.add extension_aliases
+             x.xt_name (xa.xa_name,Alias_to_resolve)
+      );
+      build_alias_list q
+  | (Odoc_search.Res_exception e) :: q ->
+      (
+       match e.ex_alias with
+         None -> ()
+       | Some ea ->
+           Hashtbl.add exception_aliases
+             e.ex_name (ea.ea_name,Alias_to_resolve)
+      );
+      build_alias_list q
+  | _ :: q ->
+      build_alias_list q
+
+(** Retrieve the aliases for modules, module types and exceptions
+   and put them in global hash tables. *)
+let get_alias_names module_list =
+  Hashtbl.clear module_aliases;
+  Hashtbl.clear module_and_modtype_aliases;
+  Hashtbl.clear extension_aliases;
+  Hashtbl.clear exception_aliases;
+  build_alias_list (Search_alias.search module_list 0)
+
+module Ele_map = Misc.Stdlib.String.Map
+
+let known_elements = ref Ele_map.empty
+let add_known_element name k =
+  try
+    let l = Ele_map.find name !known_elements in
+    let s = Ele_map.remove name !known_elements in
+    known_elements := Ele_map.add name (k::l) s
+  with
+    Not_found ->
+      known_elements := Ele_map.add name [k] !known_elements
+
+let get_known_elements name =
+  try Ele_map.find name !known_elements
+  with Not_found -> []
+
+let kind_name_exists kind =
+  let pred =
+    match kind with
+      RK_module -> (fun e -> match e with Odoc_search.Res_module _ -> true | _ -> false)
+    | RK_module_type -> (fun e -> match e with Odoc_search.Res_module_type _ -> true | _ -> false)
+    | RK_class -> (fun e -> match e with Odoc_search.Res_class _ -> true | _ -> false)
+    | RK_class_type -> (fun e -> match e with Odoc_search.Res_class_type _ -> true | _ -> false)
+    | RK_value -> (fun e -> match e with Odoc_search.Res_value _ -> true | _ -> false)
+    | RK_type -> (fun e -> match e with Odoc_search.Res_type _ -> true | _ -> false)
+    | RK_extension -> (fun e -> match e with Odoc_search.Res_extension _ -> true | _ -> false)
+    | RK_exception -> (fun e -> match e with Odoc_search.Res_exception _ -> true | _ -> false)
+    | RK_attribute -> (fun e -> match e with Odoc_search.Res_attribute _ -> true | _ -> false)
+    | RK_method -> (fun e -> match e with Odoc_search.Res_method _ -> true | _ -> false)
+    | RK_section _ -> assert false
+    | RK_recfield -> (fun e -> match e with Odoc_search.Res_recfield _ -> true | _ -> false)
+    | RK_const -> (fun e -> match e with Odoc_search.Res_const _ -> true | _ -> false)
+  in
+  fun name ->
+    try List.exists pred (get_known_elements name)
+    with Not_found -> false
+
+let module_exists = kind_name_exists RK_module
+let module_type_exists = kind_name_exists RK_module_type
+let class_exists = kind_name_exists RK_class
+let class_type_exists = kind_name_exists RK_class_type
+let value_exists = kind_name_exists RK_value
+let type_exists = kind_name_exists RK_type
+let extension_exists = kind_name_exists RK_extension
+let exception_exists = kind_name_exists RK_exception
+let attribute_exists = kind_name_exists RK_attribute
+let method_exists = kind_name_exists RK_method
+let recfield_exists = kind_name_exists RK_recfield
+let const_exists = kind_name_exists RK_const
+
+let lookup_module name =
+  match List.find
+      (fun k -> match k with Odoc_search.Res_module _ -> true | _ -> false)
+      (get_known_elements name)
+  with
+  | Odoc_search.Res_module m -> m
+  | _ -> assert false
+
+let lookup_module_type name =
+  match List.find
+      (fun k -> match k with Odoc_search.Res_module_type _ -> true | _ -> false)
+      (get_known_elements name)
+  with
+  | Odoc_search.Res_module_type m -> m
+  | _ -> assert false
+
+let lookup_class name =
+  match List.find
+      (fun k -> match k with Odoc_search.Res_class _ -> true | _ -> false)
+      (get_known_elements name)
+  with
+  | Odoc_search.Res_class c -> c
+  | _ -> assert false
+
+let lookup_class_type name =
+  match List.find
+      (fun k -> match k with Odoc_search.Res_class_type _ -> true | _ -> false)
+      (get_known_elements name)
+  with
+  | Odoc_search.Res_class_type c -> c
+  | _ -> assert false
+
+let lookup_extension name =
+  match List.find
+      (fun k -> match k with Odoc_search.Res_extension _ -> true | _ -> false)
+      (get_known_elements name)
+  with
+  | Odoc_search.Res_extension x -> x
+  | _ -> assert false
+
+let lookup_exception name =
+  match List.find
+      (fun k -> match k with Odoc_search.Res_exception _ -> true | _ -> false)
+      (get_known_elements name)
+  with
+  | Odoc_search.Res_exception e -> e
+  | _ -> assert false
+
+class scan =
+  object
+    inherit Odoc_scan.scanner
+    method! scan_value v =
+      add_known_element v.val_name (Odoc_search.Res_value v)
+    method! scan_type_recfield t f =
+      add_known_element
+        (Printf.sprintf "%s.%s" t.ty_name f.rf_name)
+        (Odoc_search.Res_recfield (t, f))
+    method! scan_type_const t f =
+      add_known_element
+        (Printf.sprintf "%s.%s" t.ty_name f.vc_name)
+        (Odoc_search.Res_const (t, f))
+    method! scan_type_pre t =
+      add_known_element t.ty_name (Odoc_search.Res_type t);
+      true
+    method! scan_extension_constructor x =
+      add_known_element x.xt_name (Odoc_search.Res_extension x)
+    method! scan_exception e =
+      add_known_element e.ex_name (Odoc_search.Res_exception e)
+    method! scan_attribute a =
+      add_known_element a.att_value.val_name
+        (Odoc_search.Res_attribute a)
+    method! scan_method m =
+      add_known_element m.met_value.val_name
+        (Odoc_search.Res_method m)
+    method! scan_class_pre c =
+      add_known_element c.cl_name (Odoc_search.Res_class c);
+      true
+    method! scan_class_type_pre c =
+      add_known_element c.clt_name (Odoc_search.Res_class_type c);
+      true
+    method! scan_module_pre m =
+      add_known_element m.m_name (Odoc_search.Res_module m);
+      true
+    method! scan_module_type_pre m =
+      add_known_element m.mt_name (Odoc_search.Res_module_type m);
+      true
+
+  end
+
+let init_known_elements_map module_list =
+  let c = new scan in
+  c#scan_module_list module_list
+
+
+(** The type to describe the names not found. *)
+type not_found_name =
+  | NF_mt of Name.t
+  | NF_mmt of Name.t
+  | NF_c of Name.t
+  | NF_cct of Name.t
+  | NF_xt of Name.t
+  | NF_ex of Name.t
+
+(** Functions to find and associate aliases elements. *)
+
+let rec associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) m =
+  let rec iter_kind (acc_b, acc_inc, acc_names) k =
+    match k with
+      Module_struct elements ->
+        List.fold_left
+          (associate_in_module_element module_list m.m_name)
+          (acc_b, acc_inc, acc_names)
+          elements
+
+    | Module_alias ma ->
+        (
+         match ma.ma_module with
+           Some _ ->
+             (acc_b, acc_inc, acc_names)
+         | None ->
+             let mmt_opt =
+               try Some (Mod (lookup_module ma.ma_name))
+               with Not_found ->
+                 try Some (Modtype (lookup_module_type ma.ma_name))
+                 with Not_found -> None
+             in
+             match mmt_opt with
+               None -> (acc_b, (Name.head m.m_name) :: acc_inc,
+                        (* we don't want to output warning messages for
+                           "sig ... end" or "struct ... end" modules not found *)
+                        (if ma.ma_name = Odoc_messages.struct_end ||
+                          ma.ma_name = Odoc_messages.sig_end then
+                          acc_names
+                        else
+                          (NF_mmt ma.ma_name) :: acc_names)
+                       )
+             | Some mmt ->
+                 ma.ma_module <- Some mmt ;
+                 (true, acc_inc, acc_names)
+        )
+
+    | Module_functor (_, k) ->
+        iter_kind (acc_b, acc_inc, acc_names) k
+
+    | Module_with (tk, _) ->
+        associate_in_module_type module_list (acc_b, acc_inc, acc_names)
+          { mt_name = "" ; mt_info = None ; mt_type = None ;
+            mt_is_interface = false ; mt_file = ""; mt_kind = Some tk ;
+            mt_loc = Odoc_types.dummy_loc }
+
+    | Module_apply (k1, k2) ->
+        let (acc_b2, acc_inc2, acc_names2) = iter_kind (acc_b, acc_inc, acc_names) k1 in
+        iter_kind (acc_b2, acc_inc2, acc_names2) k2
+
+    | Module_constraint (k, tk) ->
+        let (acc_b2, acc_inc2, acc_names2) = iter_kind (acc_b, acc_inc, acc_names) k in
+        associate_in_module_type module_list (acc_b2, acc_inc2, acc_names2)
+          { mt_name = "" ; mt_info = None ; mt_type = None ;
+            mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ;
+            mt_loc = Odoc_types.dummy_loc }
+
+     | Module_typeof _ ->
+        (acc_b, acc_inc, acc_names)
+
+     | Module_unpack (_code, mta) ->
+        begin
+          match mta.mta_module with
+            Some _ ->
+              (acc_b, acc_inc, acc_names)
+          | None ->
+              let mt_opt =
+                try Some (lookup_module_type mta.mta_name)
+                with Not_found -> None
+              in
+              match mt_opt with
+                None -> (acc_b, (Name.head m.m_name) :: acc_inc,
+                   (* we don't want to output warning messages for
+                      "sig ... end" or "struct ... end" modules not found *)
+                   (if mta.mta_name = Odoc_messages.struct_end ||
+                      mta.mta_name = Odoc_messages.sig_end then
+                      acc_names
+                    else
+                      (NF_mt mta.mta_name) :: acc_names)
+                  )
+              | Some mt ->
+                  mta.mta_module <- Some mt ;
+                  (true, acc_inc, acc_names)
+        end
+  in
+  iter_kind (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) m.m_kind
+
+and associate_in_module_type module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) mt =
+  let rec iter_kind (acc_b, acc_inc, acc_names) k =
+    match k with
+      Module_type_struct elements ->
+        List.fold_left
+          (associate_in_module_element module_list mt.mt_name)
+          (acc_b, acc_inc, acc_names)
+          elements
+
+    | Module_type_functor (_, k) ->
+        iter_kind (acc_b, acc_inc, acc_names) k
+
+    | Module_type_with (k, _) ->
+        iter_kind (acc_b, acc_inc, acc_names) k
+
+    | Module_type_alias mta ->
+        begin
+          match mta.mta_module with
+            Some _ ->
+              (acc_b, acc_inc, acc_names)
+          | None ->
+              let mta_name =
+                Name.get_relative_opt
+                  !Odoc_global.library_namespace
+                  mta.mta_name in
+              let mt_opt =
+                try Some (lookup_module_type mta_name)
+                with Not_found -> None
+              in
+              match mt_opt with
+                None -> (acc_b, (Name.head mt.mt_name) :: acc_inc,
+                   (* we don't want to output warning messages for
+                      "sig ... end" or "struct ... end" modules not found *)
+                   (if mta.mta_name = Odoc_messages.struct_end ||
+                      mta.mta_name = Odoc_messages.sig_end then
+                      acc_names
+                    else
+                      (NF_mt mta_name) :: acc_names)
+                  )
+              | Some mt ->
+                  mta.mta_module <- Some mt ;
+                  (true, acc_inc, acc_names)
+        end
+    | Module_type_typeof _ ->
+        (acc_b, acc_inc, acc_names)
+  in
+  match mt.mt_kind with
+    None -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
+  | Some k -> iter_kind (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) k
+
+and associate_in_module_element module_list m_name (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) element =
+   match element with
+     Element_module m -> associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) m
+   | Element_module_type mt ->
+       associate_in_module_type module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) mt
+   | Element_included_module im ->
+       (
+        match im.im_module with
+          Some _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
+        | None ->
+            let mmt_opt =
+              try Some (Mod (lookup_module im.im_name))
+              with Not_found ->
+                try Some (Modtype (lookup_module_type im.im_name))
+                with Not_found -> None
+            in
+            match mmt_opt with
+              None -> (acc_b_modif, (Name.head m_name) :: acc_incomplete_top_module_names,
+                       (* we don't want to output warning messages for
+                           "sig ... end" or "struct ... end" modules not found *)
+                        (if im.im_name = Odoc_messages.struct_end ||
+                          im.im_name = Odoc_messages.sig_end then
+                          acc_names_not_found
+                        else
+                          (NF_mmt im.im_name) :: acc_names_not_found)
+                      )
+            | Some mmt ->
+                im.im_module <- Some mmt ;
+                (true, acc_incomplete_top_module_names, acc_names_not_found)
+       )
+   | Element_class cl -> associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) cl
+   | Element_class_type ct ->
+       associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) ct
+   | Element_value _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
+   | Element_type_extension te ->
+       associate_in_type_extension module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) te
+   | Element_exception ex ->
+       (
+        match ex.ex_alias with
+          None -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
+        | Some ea ->
+            match ea.ea_ex with
+              Some _ ->
+                (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
+            | None ->
+                let ex_opt =
+                  try Some (lookup_exception ea.ea_name)
+                  with Not_found -> None
+                in
+                match ex_opt with
+                  None -> (acc_b_modif,
+                           (Name.head m_name) :: acc_incomplete_top_module_names,
+                           (NF_ex ea.ea_name) :: acc_names_not_found)
+                | Some e ->
+                    ea.ea_ex <- Some e ;
+                    (true, acc_incomplete_top_module_names, acc_names_not_found)
+       )
+   | Element_type _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
+   | Element_module_comment _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
+
+and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) c =
+  let rec iter_kind (acc_b, acc_inc, acc_names) k =
+    match k with
+      Class_structure (inher_l, _) ->
+        let f (acc_b2, acc_inc2, acc_names2) ic =
+          match ic.ic_class with
+          Some _ -> (acc_b2, acc_inc2, acc_names2)
+        | None ->
+            let cct_opt =
+              try Some (Cl (lookup_class ic.ic_name))
+              with Not_found ->
+                try Some (Cltype (lookup_class_type ic.ic_name, []))
+                with Not_found -> None
+            in
+            match cct_opt with
+              None -> (acc_b2, (Name.head c.cl_name) :: acc_inc2,
+                       (* we don't want to output warning messages for "object ... end" classes not found *)
+                       (if ic.ic_name = Odoc_messages.object_end then acc_names2 else (NF_cct ic.ic_name) :: acc_names2))
+            | Some cct ->
+                ic.ic_class <- Some cct ;
+                (true, acc_inc2, acc_names2)
+        in
+        List.fold_left f (acc_b, acc_inc, acc_names) inher_l
+
+    | Class_apply capp ->
+        (
+         match capp.capp_class with
+           Some _ ->  (acc_b, acc_inc, acc_names)
+         | None ->
+             let cl_opt =
+               try Some (lookup_class capp.capp_name)
+               with Not_found -> None
+             in
+             match cl_opt with
+               None -> (acc_b, (Name.head c.cl_name) :: acc_inc,
+                        (* we don't want to output warning messages for "object ... end" classes not found *)
+                        (if capp.capp_name = Odoc_messages.object_end then acc_names else (NF_c capp.capp_name) :: acc_names))
+             | Some c ->
+                 capp.capp_class <- Some c ;
+                 (true, acc_inc, acc_names)
+        )
+
+    | Class_constr cco ->
+        (
+         match cco.cco_class with
+           Some _ ->  (acc_b, acc_inc, acc_names)
+         | None ->
+             let cl_opt =
+               try Some (lookup_class cco.cco_name)
+               with Not_found -> None
+             in
+             match cl_opt with
+               None ->
+                 (
+                  let clt_opt =
+                    try Some (lookup_class_type cco.cco_name)
+                    with Not_found -> None
+                  in
+                  match clt_opt with
+                    None ->
+                      (acc_b, (Name.head c.cl_name) :: acc_inc,
+                        (* we don't want to output warning messages for "object ... end" classes not found *)
+                       (if cco.cco_name = Odoc_messages.object_end then acc_names else (NF_cct cco.cco_name) :: acc_names))
+                  | Some ct ->
+                      cco.cco_class <- Some (Cltype (ct, [])) ;
+                      (true, acc_inc, acc_names)
+                 )
+             | Some c ->
+                 cco.cco_class <- Some (Cl c) ;
+                 (true, acc_inc, acc_names)
+        )
+    | Class_constraint (ckind, ctkind) ->
+        let (acc_b2, acc_inc2, acc_names2) = iter_kind (acc_b, acc_inc, acc_names) ckind in
+        associate_in_class_type module_list (acc_b2, acc_inc2, acc_names2)
+            { clt_name = "" ; clt_info = None ;
+              clt_type = c.cl_type ; (* should be ok *)
+              clt_type_parameters = [] ;
+              clt_virtual = false ;
+              clt_kind = ctkind ;
+              clt_loc = Odoc_types.dummy_loc }
+  in
+  iter_kind (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) c.cl_kind
+
+and associate_in_class_type _module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) ct =
+  let iter_kind (acc_b, acc_inc, acc_names) k =
+    match k with
+      Class_signature (inher_l, _) ->
+        let f (acc_b2, acc_inc2, acc_names2) ic =
+          match ic.ic_class with
+            Some _ -> (acc_b2, acc_inc2, acc_names2)
+          | None ->
+              let cct_opt =
+                try Some (Cltype (lookup_class_type ic.ic_name, []))
+                with Not_found ->
+                  try Some (Cl (lookup_class ic.ic_name))
+                  with Not_found -> None
+              in
+              match cct_opt with
+                None -> (acc_b2, (Name.head ct.clt_name) :: acc_inc2,
+                         (* we don't want to output warning messages for "object ... end" class types not found *)
+                         (if ic.ic_name = Odoc_messages.object_end then acc_names2 else (NF_cct ic.ic_name) :: acc_names2))
+              | Some cct ->
+                  ic.ic_class <- Some cct ;
+                  (true, acc_inc2, acc_names2)
+        in
+        List.fold_left f (acc_b, acc_inc, acc_names) inher_l
+
+    | Class_type cta ->
+        (
+         match cta.cta_class with
+           Some _ ->  (acc_b, acc_inc, acc_names)
+         | None ->
+             let cct_opt =
+               try Some (Cltype (lookup_class_type cta.cta_name, []))
+               with Not_found ->
+                 try Some (Cl (lookup_class cta.cta_name))
+                 with Not_found -> None
+             in
+             match cct_opt with
+               None -> (acc_b, (Name.head ct.clt_name) :: acc_inc,
+                        (* we don't want to output warning messages for "object ... end" class types not found *)
+                        (if cta.cta_name = Odoc_messages.object_end then acc_names else (NF_cct cta.cta_name) :: acc_names))
+             | Some c ->
+                 cta.cta_class <- Some c ;
+                 (true, acc_inc, acc_names)
+        )
+  in
+  iter_kind (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) ct.clt_kind
+
+and associate_in_type_extension _module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) te =
+  List.fold_left
+    (fun (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) xt ->
+       match xt.xt_alias with
+           None -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
+         | Some xa ->
+             match xa.xa_xt with
+                 Some _ ->
+                   (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
+               | None ->
+                   let xt_opt =
+                     try Some (lookup_extension xa.xa_name)
+                     with Not_found -> None
+                   in
+                     match xt_opt with
+                         None -> (acc_b_modif,
+                                  (Name.head xt.xt_name) :: acc_incomplete_top_module_names,
+                                  (NF_xt xa.xa_name) :: acc_names_not_found)
+                       | Some x ->
+                           xa.xa_xt <- Some x ;
+                           (true, acc_incomplete_top_module_names, acc_names_not_found))
+    (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
+    te.te_constructors
+
+
+(*************************************************************)
+(** Association of types to elements referenced in comments .*)
+
+let ao = Odoc_misc.apply_opt
+
+let not_found_of_kind kind name =
+  (match kind with
+    RK_module -> Odoc_messages.cross_module_not_found
+  | RK_module_type -> Odoc_messages.cross_module_type_not_found
+  | RK_class -> Odoc_messages.cross_class_not_found
+  | RK_class_type -> Odoc_messages.cross_class_type_not_found
+  | RK_value -> Odoc_messages.cross_value_not_found
+  | RK_type -> Odoc_messages.cross_type_not_found
+  | RK_extension -> Odoc_messages.cross_extension_not_found
+  | RK_exception -> Odoc_messages.cross_exception_not_found
+  | RK_attribute -> Odoc_messages.cross_attribute_not_found
+  | RK_method -> Odoc_messages.cross_method_not_found
+  | RK_section _ -> Odoc_messages.cross_section_not_found
+  | RK_recfield -> Odoc_messages.cross_recfield_not_found
+  | RK_const -> Odoc_messages.cross_const_not_found
+  ) name
+
+let query module_list name =
+   match get_known_elements name with
+     | [] ->
+         (
+         try
+           let re = Str.regexp ("^"^(Str.quote name)^"$") in
+            let t = Odoc_search.find_section module_list re in
+            let v2 = (name, Some (RK_section t)) in
+            add_verified v2 ;
+            (name, Some (RK_section t))
+          with
+            Not_found ->
+              (name, None)
+         )
+     | ele :: _ ->
+        (* we look for the first element with this name *)
+        let (name, kind) =
+          match ele with
+            Odoc_search.Res_module m -> (m.m_name, RK_module)
+          | Odoc_search.Res_module_type mt -> (mt.mt_name, RK_module_type)
+          | Odoc_search.Res_class c -> (c.cl_name, RK_class)
+          | Odoc_search.Res_class_type ct -> (ct.clt_name, RK_class_type)
+          | Odoc_search.Res_value v -> (v.val_name, RK_value)
+          | Odoc_search.Res_type t -> (t.ty_name, RK_type)
+          | Odoc_search.Res_extension x -> (x.xt_name, RK_extension)
+          | Odoc_search.Res_exception e -> (e.ex_name, RK_exception)
+          | Odoc_search.Res_attribute a -> (a.att_value.val_name, RK_attribute)
+          | Odoc_search.Res_method m -> (m.met_value.val_name, RK_method)
+          | Odoc_search.Res_section _-> assert false
+          | Odoc_search.Res_recfield (t, f) ->
+              (Printf.sprintf "%s.%s" t.ty_name f.rf_name, RK_recfield)
+          | Odoc_search.Res_const (t, f) ->
+              (Printf.sprintf "%s.%s" t.ty_name f.vc_name, RK_const)
+        in
+        add_verified (name, Some kind) ;
+        (name, Some kind)
+
+
+let rec search_within_ancestry
+    (finalize,initial_name,query as param) ?parent_name name =
+  let name = Odoc_name.normalize_name name in
+  let res = query name in
+  match res with
+  | (name, Some k) -> finalize (Some (name,k))
+  | (_, None) ->
+      match parent_name with
+      | None ->
+          finalize None
+      (* *)
+      | Some p ->
+          let parent_name =
+            match Name.father p with
+              "" -> None
+            | s -> Some s
+          in
+          search_within_ancestry param
+            ?parent_name (Name.concat p initial_name)
+
+let search_within_ancestry finalize query ?parent_name name =
+  search_within_ancestry (finalize, name, query) ?parent_name name
+
+
+let rec assoc_comments_text_elements parent_name module_list t_ele =
+  match t_ele with
+  | Raw _
+  | CodePre _
+  | Latex _
+  | Verbatim _ -> t_ele
+  | Bold t -> Bold (assoc_comments_text parent_name module_list t)
+  | Italic t -> Italic (assoc_comments_text parent_name module_list t)
+  | Center t -> Center (assoc_comments_text parent_name module_list t)
+  | Left t -> Left (assoc_comments_text parent_name module_list t)
+  | Right t -> Right (assoc_comments_text parent_name module_list t)
+  | Emphasize t -> Emphasize (assoc_comments_text parent_name module_list t)
+  | List l -> List (List.map (assoc_comments_text parent_name module_list) l)
+  | Enum l -> Enum (List.map (assoc_comments_text parent_name module_list) l)
+  | Newline -> Newline
+  | Block t -> Block (assoc_comments_text parent_name module_list t)
+  | Superscript t -> Superscript (assoc_comments_text parent_name module_list t)
+  | Subscript t -> Subscript (assoc_comments_text parent_name module_list t)
+  | Title (n, l_opt, t) -> Title (n, l_opt, (assoc_comments_text parent_name module_list t))
+  | Link (s, t) -> Link (s, (assoc_comments_text parent_name module_list t))
+  | Ref (initial_name, None, text_option) ->
+      let finalize = function
+        | Some (name,k) -> Ref (name, Some k, text_option)
+        | None ->
+            Odoc_global.pwarning
+              (Odoc_messages.cross_element_not_found initial_name);
+            Ref (initial_name, None, text_option) in
+      search_within_ancestry finalize (query module_list) ~parent_name initial_name
+  | Code s ->
+      if not !Odoc_global.show_missed_crossref then
+        t_ele
+      else (* Check if s could be turned into a valid cross-reference *)
+      let name = String.trim s in
+      begin
+        (* First, we ignore code fragments with more than one space-separated
+           words: "word1 word2" *)
+        try  (ignore (String.index name ' '); t_ele)
+        with Not_found ->
+          if name = "" then t_ele
+          else
+            let first_char = name.[0] in
+            (* Then, we only consider code fragments which start with a
+               distinctly uppercase letter *)
+            if Char.uppercase_ascii first_char <> first_char ||
+               Char.lowercase_ascii first_char = first_char then
+              t_ele
+            else
+              (* Some path analysis auxiliary functions *)
+              let path s =
+                String.split_on_char '.' s
+              in
+              let filter =
+                List.filter
+                  (fun s -> s <> "" && s.[0] = Char.uppercase_ascii s.[0]) in
+              let rec is_prefix prefix full =
+                match prefix, full with
+                | [], _ -> true
+                | a :: pre, b :: f when a = b -> is_prefix pre f
+                | _ -> false in
+              let p = filter @@ path name and parent_p = path parent_name in
+              let is_path_suffix () =
+                is_prefix (List.rev @@ p) (List.rev @@ parent_p ) in
+              (* heuristic:
+                 - if name = parent_name: we are using the name of an element
+                 or module in its definition, no need of cross_reference
+                 - if the path of name is a suffix of the parent path, we
+                 are in the same module, maybe the same function. To decrease
+                 the false positive rate, we stop here *)
+              if name = parent_name || is_path_suffix () then
+                t_ele
+              else
+                let finalize = function
+                  | None -> t_ele
+                  | Some _ ->
+                      Odoc_global.pwarning @@
+                      Odoc_messages.code_could_be_cross_reference name parent_name;
+                      t_ele in
+                search_within_ancestry finalize (query module_list) ~parent_name
+                  name
+      end
+  | Ref (initial_name, Some kind, text_option) ->
+      (
+       let rec iter_parent ?parent_name name =
+         let v = (name, Some kind) in
+         if was_verified v then
+           Ref (name, Some kind, text_option)
+         else
+           let res =
+             match kind with
+             | RK_section _ ->
+                 (
+                  (* we just verify that we find an element of this kind with this name *)
+                  try
+                    let re = Str.regexp ("^"^(Str.quote name)^"$") in
+                    let t = Odoc_search.find_section module_list re in
+                    let v2 = (name, Some (RK_section t)) in
+                    add_verified v2 ;
+                    (name, Some (RK_section t))
+                  with
+                    Not_found ->
+                      (name, None)
+                 )
+             | _ ->
+                 let f =
+                   match kind with
+                     RK_module -> module_exists
+                   | RK_module_type -> module_type_exists
+                   | RK_class -> class_exists
+                   | RK_class_type -> class_type_exists
+                   | RK_value -> value_exists
+                   | RK_type -> type_exists
+                   | RK_extension -> extension_exists
+                   | RK_exception -> exception_exists
+                   | RK_attribute -> attribute_exists
+                   | RK_method -> method_exists
+                   | RK_section _ -> assert false
+                   | RK_recfield -> recfield_exists
+                   | RK_const -> const_exists
+                 in
+                 if f name then
+                   (
+                    add_verified v ;
+                    (name, Some kind)
+                   )
+                 else
+                   (name, None)
+           in
+           match res with
+           | (name, Some k) -> Ref (name, Some k, text_option)
+           | (_, None) ->
+               match parent_name with
+                 None ->
+                   Odoc_global.pwarning (not_found_of_kind kind initial_name);
+                   Ref (initial_name, None, text_option)
+               | Some p ->
+                   let parent_name =
+                     match Name.father p with
+                       "" -> None
+                     | s -> Some s
+                   in
+                   iter_parent ?parent_name (Name.concat p initial_name)
+       in
+       iter_parent ~parent_name initial_name
+      )
+  | Module_list l ->
+      Module_list l
+  | Index_list ->
+      Index_list
+  | Custom (s,t) -> Custom (s, (assoc_comments_text parent_name module_list t))
+  | Target (target, code) -> Target (target, code)
+
+and assoc_comments_text parent_name module_list text =
+  List.map (assoc_comments_text_elements parent_name module_list) text
+
+and assoc_comments_info parent_name module_list i =
+  let ft = assoc_comments_text parent_name module_list in
+  {
+    i with
+    i_desc = ao ft i.i_desc ;
+    i_sees = List.map (fun (sr, t) -> (sr, ft t)) i.i_sees;
+    i_deprecated = ao ft i.i_deprecated ;
+    i_params = List.map (fun (name, t) -> (name, ft t)) i.i_params;
+    i_raised_exceptions = List.map (fun (name, t) -> (name, ft t)) i.i_raised_exceptions;
+    i_return_value = ao ft i.i_return_value ;
+    i_custom = List.map (fun (tag, t) -> (tag, ft t)) i.i_custom ;
+  }
+
+
+let rec assoc_comments_module_element parent_name module_list m_ele =
+  match m_ele with
+    Element_module m ->
+      Element_module (assoc_comments_module module_list m)
+  | Element_module_type mt ->
+      Element_module_type (assoc_comments_module_type module_list mt)
+  | Element_included_module _ ->
+      m_ele (* don't go down into the aliases *)
+  | Element_class c ->
+      Element_class (assoc_comments_class module_list c)
+  | Element_class_type ct ->
+      Element_class_type (assoc_comments_class_type module_list ct)
+  | Element_value v ->
+      Element_value (assoc_comments_value module_list v)
+  | Element_type_extension te ->
+      Element_type_extension (assoc_comments_type_extension parent_name module_list te)
+  | Element_exception e ->
+      Element_exception (assoc_comments_exception module_list e)
+  | Element_type t ->
+      Element_type (assoc_comments_type module_list t)
+  | Element_module_comment t ->
+      Element_module_comment (assoc_comments_text parent_name module_list t)
+
+and assoc_comments_class_element parent_name module_list c_ele =
+  match c_ele with
+    Class_attribute a ->
+      Class_attribute (assoc_comments_attribute module_list a)
+  | Class_method m ->
+      Class_method (assoc_comments_method module_list m)
+  | Class_comment t ->
+      Class_comment (assoc_comments_text parent_name module_list t)
+
+and assoc_comments_module_kind parent_name module_list mk =
+  match mk with
+  | Module_struct eles ->
+      Module_struct
+        (List.map (assoc_comments_module_element parent_name module_list) eles)
+  | Module_alias _
+  | Module_functor _ ->
+      mk
+  | Module_apply (mk1, mk2) ->
+      Module_apply (assoc_comments_module_kind parent_name module_list mk1,
+                    assoc_comments_module_kind parent_name module_list mk2)
+  | Module_with (mtk, s) ->
+      Module_with (assoc_comments_module_type_kind parent_name module_list mtk, s)
+  | Module_constraint (mk1, mtk) ->
+      Module_constraint
+        (assoc_comments_module_kind parent_name module_list mk1,
+         assoc_comments_module_type_kind parent_name module_list mtk)
+  | Module_typeof _ -> mk
+  | Module_unpack _ -> mk
+
+and assoc_comments_module_type_kind parent_name module_list mtk =
+  match mtk with
+  | Module_type_struct eles ->
+      Module_type_struct
+        (List.map (assoc_comments_module_element parent_name module_list) eles)
+  | Module_type_functor (params, mtk1) ->
+      Module_type_functor
+        (params, assoc_comments_module_type_kind parent_name module_list mtk1)
+  | Module_type_alias _ ->
+      mtk
+  | Module_type_with (mtk1, s) ->
+      Module_type_with
+        (assoc_comments_module_type_kind parent_name module_list mtk1, s)
+  | Module_type_typeof _ -> mtk
+
+and assoc_comments_class_kind parent_name module_list ck =
+  match ck with
+    Class_structure (inher, eles) ->
+      let inher2 =
+        List.map
+          (fun ic ->
+            { ic with
+              ic_text = ao (assoc_comments_text parent_name module_list) ic.ic_text })
+          inher
+      in
+      Class_structure
+        (inher2, List.map (assoc_comments_class_element parent_name module_list) eles)
+
+  | Class_apply _
+  | Class_constr _ -> ck
+  | Class_constraint (ck1, ctk) ->
+      Class_constraint (assoc_comments_class_kind parent_name module_list ck1,
+                        assoc_comments_class_type_kind parent_name module_list ctk)
+
+and assoc_comments_class_type_kind parent_name module_list ctk =
+  match ctk with
+    Class_signature (inher, eles) ->
+      let inher2 =
+        List.map
+          (fun ic -> { ic with
+                       ic_text = ao (assoc_comments_text parent_name module_list) ic.ic_text })
+          inher
+      in
+      Class_signature (inher2, List.map (assoc_comments_class_element parent_name module_list) eles)
+
+  | Class_type _ -> ctk
+
+
+and assoc_comments_module module_list m =
+  m.m_info <- ao (assoc_comments_info m.m_name module_list) m.m_info ;
+  m.m_kind <- assoc_comments_module_kind m.m_name module_list m.m_kind ;
+  m
+
+and assoc_comments_module_type module_list mt =
+  mt.mt_info <- ao (assoc_comments_info mt.mt_name module_list) mt.mt_info ;
+  mt.mt_kind <- ao (assoc_comments_module_type_kind mt.mt_name module_list) mt.mt_kind ;
+  mt
+
+and assoc_comments_class module_list c =
+  c.cl_info <- ao (assoc_comments_info c.cl_name module_list) c.cl_info ;
+  c.cl_kind <- assoc_comments_class_kind c.cl_name module_list c.cl_kind ;
+  assoc_comments_parameter_list c.cl_name module_list c.cl_parameters;
+  c
+
+and assoc_comments_class_type module_list ct =
+  ct.clt_info <- ao (assoc_comments_info ct.clt_name module_list) ct.clt_info ;
+  ct.clt_kind <- assoc_comments_class_type_kind ct.clt_name module_list ct.clt_kind ;
+  ct
+
+and assoc_comments_parameter parent_name module_list p =
+  match p with
+    Simple_name sn ->
+      sn.sn_text <- ao (assoc_comments_text parent_name module_list) sn.sn_text
+  | Tuple (l, _) ->
+      List.iter (assoc_comments_parameter parent_name module_list) l
+
+and assoc_comments_parameter_list parent_name module_list pl =
+  List.iter (assoc_comments_parameter parent_name module_list) pl
+
+and assoc_comments_value module_list v =
+  let parent = Name.father v.val_name in
+  v.val_info <- ao (assoc_comments_info parent module_list) v.val_info ;
+  assoc_comments_parameter_list parent module_list v.val_parameters;
+  v
+
+and assoc_comments_extension_constructor module_list x =
+  let parent = Name.father x.xt_name in
+  x.xt_text <- ao (assoc_comments_info parent module_list) x.xt_text
+
+and assoc_comments_type_extension parent_name module_list te =
+  te.te_info <- ao (assoc_comments_info parent_name module_list) te.te_info;
+  List.iter (assoc_comments_extension_constructor module_list) te.te_constructors;
+  te
+
+and assoc_comments_exception module_list e =
+  let parent = Name.father e.ex_name in
+  e.ex_info <- ao (assoc_comments_info parent module_list) e.ex_info ;
+  e
+
+and assoc_comments_type module_list t =
+  let parent = Name.father t.ty_name in
+  t.ty_info <- ao (assoc_comments_info parent module_list) t.ty_info ;
+  (match t.ty_kind with
+    Type_abstract -> ()
+  | Type_variant vl ->
+      List.iter
+        (fun vc -> vc.vc_text <- ao (assoc_comments_info parent module_list) vc.vc_text)
+        vl
+  | Type_record fl ->
+      List.iter
+        (fun rf -> rf.rf_text <- ao (assoc_comments_info parent module_list) rf.rf_text)
+        fl
+  | Type_open -> ()
+  );
+  t
+
+and assoc_comments_attribute module_list a =
+  let _ = assoc_comments_value module_list a.att_value in
+  a
+
+and assoc_comments_method module_list m =
+  let parent_name = Name.father m.met_value.val_name in
+  let _ = assoc_comments_value module_list m.met_value in
+  assoc_comments_parameter_list parent_name module_list m.met_value.val_parameters;
+  m
+
+
+let associate_type_of_elements_in_comments module_list =
+  List.map (assoc_comments_module module_list) module_list
+
+
+(***********************************************************)
+(** The function which performs all the cross referencing. *)
+let associate module_list =
+  get_alias_names module_list ;
+  init_known_elements_map module_list;
+  let rec remove_doubles acc = function
+      [] -> acc
+    | h :: q ->
+        if List.mem h acc then remove_doubles acc q
+        else remove_doubles (h :: acc) q
+  in
+  let rec iter incomplete_modules =
+    let (b_modif, remaining_inc_modules, acc_names_not_found) =
+      List.fold_left (associate_in_module module_list) (false, [], []) incomplete_modules
+    in
+    let remaining_no_doubles = remove_doubles [] remaining_inc_modules in
+    let remaining_modules = List.filter
+        (fun m -> List.mem m.m_name remaining_no_doubles)
+        incomplete_modules
+    in
+    if b_modif then
+      (* we may be able to associate something else *)
+      iter remaining_modules
+    else
+      (* nothing changed, we won't be able to associate any more *)
+      acc_names_not_found
+  in
+  let names_not_found = iter module_list in
+  (
+   match names_not_found with
+     [] ->
+       ()
+   | l ->
+       List.iter
+         (fun nf ->
+           Odoc_global.pwarning
+             (
+              match nf with
+              | NF_mt n -> Odoc_messages.cross_module_type_not_found n
+              | NF_mmt n -> Odoc_messages.cross_module_or_module_type_not_found n
+              | NF_c n -> Odoc_messages.cross_class_not_found n
+              | NF_cct n -> Odoc_messages.cross_class_or_class_type_not_found n
+              | NF_xt n -> Odoc_messages.cross_extension_not_found n
+              | NF_ex n -> Odoc_messages.cross_exception_not_found n
+             );
+         )
+         l
+  ) ;
+
+  (* Find a type for each name of element which is referenced in comments. *)
+  ignore (associate_type_of_elements_in_comments module_list)
diff --git a/ocamldoc/odoc_cross.mli b/ocamldoc/odoc_cross.mli
new file mode 100644
index 00000000..ca0ad7dc
--- /dev/null
+++ b/ocamldoc/odoc_cross.mli
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Cross-referencing. *)
+
+val associate : Odoc_module.t_module list -> unit
+
+val assoc_comments_info :
+    string -> Odoc_module.t_module list ->
+      Odoc_types.info -> Odoc_types.info
diff --git a/ocamldoc/odoc_dag2html.ml b/ocamldoc/odoc_dag2html.ml
new file mode 100644
index 00000000..62b7d1ec
--- /dev/null
+++ b/ocamldoc/odoc_dag2html.ml
@@ -0,0 +1,1613 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The types and functions to create a html table representing a dag. Thanks to Daniel De Rauglaudre. *)
+
+type 'a dag = { mutable dag : 'a node array }
+and 'a node =
+  { mutable pare : idag list; valu : 'a; mutable chil : idag list }
+and idag = int
+;;
+
+external int_of_idag : idag -> int = "%identity";;
+external idag_of_int : int -> idag = "%identity";;
+
+type 'a table = { mutable table : 'a data array array }
+and 'a data = { mutable elem : 'a elem; mutable span : span_id }
+and 'a elem = Elem of 'a | Ghost of ghost_id | Nothing
+and span_id
+and ghost_id
+;;
+
+external span_id_of_int : int -> span_id = "%identity";;
+external ghost_id_of_int : int -> ghost_id = "%identity";;
+
+let new_span_id = let i = ref 0 in fun () -> incr i; span_id_of_int !i;;
+
+let new_ghost_id = let i = ref 0 in fun () -> incr i; ghost_id_of_int !i;;
+
+(** creating the html table structure *)
+
+type align = LeftA | CenterA | RightA;;
+type table_data = TDstring of string | TDhr of align;;
+
+let html_table_struct indi_txt phony d t =
+  let phony =
+    function
+      Elem e -> phony d.dag.(int_of_idag e)
+    | Ghost _ -> false
+    | Nothing -> true
+  in
+  let elem_txt =
+    function
+      Elem e -> indi_txt d.dag.(int_of_idag e)
+    | Ghost _ -> "|"
+    | Nothing -> " "
+  in
+  let bar_txt =
+    function
+      Elem _ | Ghost _ -> "|"
+    | Nothing -> " "
+  in
+  let all_empty i =
+    let rec loop j =
+      if j = Array.length t.table.(i) then true
+      else
+        match t.table.(i).(j).elem with
+          Nothing -> loop (j + 1)
+        | e -> if phony e then loop (j + 1) else false
+    in
+    loop 0
+  in
+  let line_elem_txt i =
+    let les =
+      let rec loop les j =
+        if j = Array.length t.table.(i) then les
+        else
+          let x = t.table.(i).(j) in
+          let next_j =
+            let rec loop j =
+              if j = Array.length t.table.(i) then j
+              else if t.table.(i).(j) = x then loop (j + 1)
+              else j
+            in
+            loop (j + 1)
+          in
+          let colspan = 3 * (next_j - j) in
+          let les = (1, LeftA, TDstring " ") :: les in
+          let les =
+            let s =
+              if t.table.(i).(j).elem = Nothing then " "
+              else elem_txt t.table.(i).(j).elem
+            in
+            (colspan - 2, CenterA, TDstring s) :: les
+          in
+          let les = (1, LeftA, TDstring " ") :: les in loop les next_j
+      in
+      loop [] 0
+    in
+    Array.of_list (List.rev les)
+  in
+  let vbars_txt k i =
+    let les =
+      let rec loop les j =
+        if j = Array.length t.table.(i) then les
+        else
+          let x = t.table.(i).(j) in
+          let next_j =
+            let rec loop j =
+              if j = Array.length t.table.(i) then j
+              else if t.table.(i).(j) = x then loop (j + 1)
+              else j
+            in
+            loop (j + 1)
+          in
+          let colspan = 3 * (next_j - j) in
+          let les = (1, LeftA, TDstring " ") :: les in
+          let les =
+            let s =
+              if k > 0 && t.table.(k - 1).(j).elem = Nothing ||
+                 t.table.(k).(j).elem = Nothing then
+                " "
+              else if phony t.table.(i).(j).elem then " "
+              else bar_txt t.table.(i).(j).elem
+            in
+            (colspan - 2, CenterA, TDstring s) :: les
+          in
+          let les = (1, LeftA, TDstring " ") :: les in loop les next_j
+      in
+      loop [] 0
+    in
+    Array.of_list (List.rev les)
+  in
+  let alone_bar_txt i =
+    let les =
+      let rec loop les j =
+        if j = Array.length t.table.(i) then les
+        else
+          let next_j =
+            let x = t.table.(i).(j).span in
+            let rec loop j =
+              if j = Array.length t.table.(i) then j
+              else if t.table.(i).(j).span = x then loop (j + 1)
+              else j
+            in
+            loop (j + 1)
+          in
+          let colspan = 3 * (next_j - j) - 2 in
+          let les = (1, LeftA, TDstring " ") :: les in
+          let les =
+            if t.table.(i).(j).elem = Nothing ||
+               t.table.(i + 1).(j).elem = Nothing then
+              (colspan, LeftA, TDstring " ") :: les
+            else
+              let s =
+                let all_ph =
+                  let rec loop j =
+                    if j = next_j then true
+                    else if phony t.table.(i + 1).(j).elem then loop (j + 1)
+                    else false
+                  in
+                  loop j
+                in
+                if all_ph then " " else "|"
+              in
+              (colspan, CenterA, TDstring s) :: les
+          in
+          let les = (1, LeftA, TDstring " ") :: les in loop les next_j
+      in
+      loop [] 0
+    in
+    Array.of_list (List.rev les)
+  in
+  let exist_several_branches i k =
+    let rec loop j =
+      if j = Array.length t.table.(i) then false
+      else
+        let x = t.table.(i).(j).span in
+        let e = t.table.(k).(j).elem in
+        let rec loop1 j =
+          if j = Array.length t.table.(i) then false
+          else if t.table.(i).(j).elem = Nothing then loop j
+          else if t.table.(i).(j).span <> x then loop j
+          else if t.table.(k).(j).elem <> e then true
+          else loop1 (j + 1)
+        in
+        loop1 (j + 1)
+    in
+    loop 0
+  in
+  let hbars_txt i k =
+    let les =
+      let rec loop les j =
+        if j = Array.length t.table.(i) then les
+        else
+          let next_j =
+            let e = t.table.(i).(j).elem in
+            let x = t.table.(i).(j).span in
+            let rec loop j =
+              if j = Array.length t.table.(i) then j
+              else if e = Nothing && t.table.(i).(j).elem = Nothing then
+                loop (j + 1)
+              else if t.table.(i).(j).span = x then loop (j + 1)
+              else j
+            in
+            loop (j + 1)
+          in
+          let rec loop1 les l =
+            if l = next_j then loop les next_j
+            else
+              let next_l =
+                let y = t.table.(k).(l) in
+                match y.elem with
+                  Elem _ | Ghost _ ->
+                    let rec loop l =
+                      if l = Array.length t.table.(i) then l
+                      else if t.table.(k).(l) = y then loop (l + 1)
+                      else l
+                    in
+                    loop (l + 1)
+                | _ -> l + 1
+              in
+              if next_l > next_j then
+                begin
+                  Printf.eprintf
+                    "assert false i %d k %d l %d next_l %d next_j %d\n" i k l
+                    next_l next_j;
+                  flush stderr
+                end;
+              let next_l = min next_l next_j in
+              let colspan = 3 * (next_l - l) - 2 in
+              let les =
+                match t.table.(i).(l).elem, t.table.(i + 1).(l).elem with
+                  Nothing, _ | _, Nothing ->
+                    (colspan + 2, LeftA, TDstring " ") :: les
+                | _ ->
+                    let ph s =
+                      if phony t.table.(k).(l).elem then TDstring " "
+                      else s
+                    in
+                    if l = j && next_l = next_j then
+                      let les = (1, LeftA, TDstring " ") :: les in
+                      let s = ph (TDstring "|") in
+                      let les = (colspan, CenterA, s) :: les in
+                      let les = (1, LeftA, TDstring " ") :: les in les
+                    else if l = j then
+                      let les = (1, LeftA, TDstring " ") :: les in
+                      let s = ph (TDhr RightA) in
+                      let les = (colspan, RightA, s) :: les in
+                      let s = ph (TDhr CenterA) in
+                      let les = (1, LeftA, s) :: les in les
+                    else if next_l = next_j then
+                      let s = ph (TDhr CenterA) in
+                      let les = (1, LeftA, s) :: les in
+                      let s = ph (TDhr LeftA) in
+                      let les = (colspan, LeftA, s) :: les in
+                      let les = (1, LeftA, TDstring " ") :: les in les
+                    else
+                      let s = ph (TDhr CenterA) in
+                      (colspan + 2, LeftA, s) :: les
+              in
+              loop1 les next_l
+          in
+          loop1 les j
+      in
+      loop [] 0
+    in
+    Array.of_list (List.rev les)
+  in
+  let hts =
+    let rec loop hts i =
+      if i = Array.length t.table then hts
+      else if i = Array.length t.table - 1 && all_empty i then hts
+      else
+        let hts = line_elem_txt i :: hts in
+        let hts =
+          if i < Array.length t.table - 1 then
+            let hts = vbars_txt (i + 1) i :: hts in
+            let hts =
+              if exist_several_branches i i then
+                alone_bar_txt i :: hbars_txt i i :: hts
+              else hts
+            in
+            let hts =
+              if exist_several_branches i (i + 1) &&
+                 (i < Array.length t.table - 2 ||
+                  not (all_empty (i + 1))) then
+                vbars_txt (i + 1) (i + 1) :: hbars_txt i (i + 1) :: hts
+              else hts
+            in
+            hts
+          else hts
+        in
+        loop hts (i + 1)
+    in
+    loop [] 0
+  in
+  Array.of_list (List.rev hts)
+;;
+
+(** transforming dag into table *)
+
+let ancestors d =
+  let rec loop i =
+    if i = Array.length d.dag then []
+    else
+      let n = d.dag.(i) in
+      if n.pare = [] then idag_of_int i :: loop (i + 1) else loop (i + 1)
+  in
+  loop 0
+;;
+
+let get_children d parents =
+  (* XXXX merge_children used to be declared as a recursive function,
+     but it was not.  I've no idea if it is a bug or not.  One should
+     either fix it (if this is a bug), or simplify the code otherwise. *)
+
+  let merge_children children el =
+    List.fold_right
+      (fun (x, _) children ->
+         match x with
+           Elem e ->
+             let e = d.dag.(int_of_idag e) in
+             List.fold_right
+               (fun c children ->
+                  if List.mem c children then children else c :: children)
+               e.chil children
+         | _ -> [])
+      el children
+  in
+  merge_children [] parents
+;;
+
+let rec get_block t i j =
+  if j = Array.length t.table.(i) then None
+  else if j = Array.length t.table.(i) - 1 then
+    let x = t.table.(i).(j) in Some ([x.elem, 1], 1, x.span)
+  else
+    let x = t.table.(i).(j) in
+    let y = t.table.(i).(j + 1) in
+    if y.span = x.span then
+      match get_block t i (j + 1) with
+        Some ((x1, c1) :: list, mpc, span) ->
+          let (list, mpc) =
+            if x1 = x.elem then (x1, c1 + 1) :: list, max mpc (c1 + 1)
+            else (x.elem, 1) :: (x1, c1) :: list, max mpc c1
+          in
+          Some (list, mpc, span)
+      | _ -> assert false
+    else Some ([x.elem, 1], 1, x.span)
+;;
+
+let group_by_common_children d list =
+  let module O = struct type t = idag;; let compare (x:t) y = compare x y;; end
+  in
+  let module S = Set.Make (O)
+  in
+  let nlcsl =
+    List.map
+      (fun id ->
+         let n = d.dag.(int_of_idag id) in
+         let cs = List.fold_right S.add n.chil S.empty in [id], cs)
+      list
+  in
+  let nlcsl =
+    let rec loop =
+      function
+        [] -> []
+      | (nl, cs) :: rest ->
+          let rec loop1 beg =
+            function
+              (nl1, cs1) :: rest1 ->
+                if S.is_empty (S.inter cs cs1) then
+                  loop1 ((nl1, cs1) :: beg) rest1
+                else
+                  loop ((nl @ nl1, S.union cs cs1) :: (List.rev beg @ rest1))
+            | [] -> (nl, cs) :: loop rest
+          in
+          loop1 [] rest
+    in
+    loop nlcsl
+  in
+  List.fold_right
+    (fun (nl, _) a ->
+       let span = new_span_id () in
+       List.fold_right (fun n a -> {elem = Elem n; span = span} :: a) nl a)
+    nlcsl []
+;;
+
+let copy_data d = {elem = d.elem; span = d.span};;
+
+let insert_columns t nb j =
+  let t1 = Array.make (Array.length t.table) [| |] in
+  for i = 0 to Array.length t.table - 1 do
+    let line = t.table.(i) in
+    let line1 = Array.make (Array.length line + nb) line.(0) in
+    t1.(i) <- line1;
+    let rec loop k =
+      if k = Array.length line then ()
+      else
+        begin
+          if k < j then line1.(k) <- copy_data line.(k)
+          else if k = j then
+            for r = 0 to nb do line1.(k + r) <- copy_data line.(k) done
+          else line1.(k + nb) <- copy_data line.(k);
+          loop (k + 1)
+        end
+    in
+    loop 0
+  done;
+  {table = t1}
+;;
+
+let rec gcd a b =
+  if a < b then gcd b a else if b = 0 then a else gcd b (a mod b)
+;;
+
+let treat_new_row d t =
+  let i = Array.length t.table - 1 in
+  let rec loop t i j =
+    match get_block t i j with
+      Some (parents, max_parent_colspan, _span) ->
+        let children = get_children d parents in
+        let children =
+          if children = [] then [{elem = Nothing; span = new_span_id ()}]
+          else
+            List.map (fun n -> {elem = Elem n; span = new_span_id ()})
+              children
+        in
+        let simple_parents_colspan =
+          List.fold_left (fun x (_, c) -> x + c) 0 parents
+        in
+        if simple_parents_colspan mod List.length children = 0 then
+          let j = j + simple_parents_colspan in
+          let children =
+            let cnt = simple_parents_colspan / List.length children in
+            List.fold_right
+              (fun d list ->
+                 let rec loop cnt list =
+                   if cnt = 1 then d :: list
+                   else copy_data d :: loop (cnt - 1) list
+                 in
+                 loop cnt list)
+              children []
+          in
+          let (t, children_rest) = loop t i j in t, children @ children_rest
+        else
+          let parent_colspan =
+            List.fold_left
+              (fun scm (_, c) -> let g = gcd scm c in scm / g * c)
+              max_parent_colspan parents
+          in
+          let (t, parents, _) =
+            List.fold_left
+              (fun (t, parents, j) (x, c) ->
+                 let to_add = parent_colspan / c - 1 in
+                 let t =
+                   let rec loop cc t j =
+                     if cc = 0 then t
+                     else
+                       let t = insert_columns t to_add j in
+                       loop (cc - 1) t (j + to_add + 1)
+                   in
+                   loop c t j
+                 in
+                 t, (x, parent_colspan) :: parents, j + parent_colspan)
+              (t, [], j) parents
+          in
+          let parents = List.rev parents in
+          let parents_colspan = parent_colspan * List.length parents in
+          let children_colspan = List.length children in
+          let g = gcd parents_colspan children_colspan in
+          let (t, j) =
+            let cnt = children_colspan / g in
+            List.fold_left
+              (fun (t, j) (_, c) ->
+                 let rec loop cc t j =
+                   if cc = 0 then t, j
+                   else
+                     let t = insert_columns t (cnt - 1) j in
+                     let j = j + cnt in loop (cc - 1) t j
+                 in
+                 loop c t j)
+              (t, j) parents
+          in
+          let children =
+            let cnt = parents_colspan / g in
+            List.fold_right
+              (fun d list ->
+                 let rec loop cnt list =
+                   if cnt = 0 then list else d :: loop (cnt - 1) list
+                 in
+                 loop cnt list)
+              children []
+          in
+          let (t, children_rest) = loop t i j in t, children @ children_rest
+    | None -> t, []
+  in
+  loop t i 0
+;;
+
+let down_it t i k =
+  t.table.(Array.length t.table - 1).(k) <- t.table.(i).(k);
+  for r = i to Array.length t.table - 2 do
+    t.table.(r).(k) <- {elem = Ghost (new_ghost_id ()); span = new_span_id ()}
+  done
+;;
+
+(* equilibrate:
+   in the last line, for all elem A, make fall all As, which are located at
+   its right side above, to its line,
+                             A             |
+   i.e. transform all        . into        |
+                      A.......      A......A
+*)
+
+let equilibrate t =
+  let ilast = Array.length t.table - 1 in
+  let last = t.table.(ilast) in
+  let len = Array.length last in
+  let rec loop j =
+    if j = len then ()
+    else
+      match last.(j).elem with
+        Elem x ->
+          let rec loop1 i =
+            if i = ilast then loop (j + 1)
+            else
+              let rec loop2 k =
+                if k = len then loop1 (i + 1)
+                else
+                  match t.table.(i).(k).elem with
+                    Elem y when x = y -> down_it t i k; loop 0
+                  | _ -> loop2 (k + 1)
+              in
+              loop2 0
+          in
+          loop1 0
+      | _ -> loop (j + 1)
+  in
+  loop 0
+;;
+
+(* group_elem:
+   transform all x y into x x
+                 A A      A A *)
+
+let group_elem t =
+  for i = 0 to Array.length t.table - 2 do
+    for j = 1 to Array.length t.table.(0) - 1 do
+      match t.table.(i + 1).(j - 1).elem, t.table.(i + 1).(j).elem with
+        Elem x, Elem y when x = y ->
+          t.table.(i).(j).span <- t.table.(i).(j - 1).span
+      | _ -> ()
+    done
+  done
+;;
+
+(* group_ghost:
+                 x  x       x  x           |a |a      |a |a
+   transform all |a |b into |a |a and all  x  y  into x  x
+                 y  z       y  y           A  A       A  A  *)
+
+let group_ghost t =
+  for i = 0 to Array.length t.table - 2 do
+    for j = 1 to Array.length t.table.(0) - 1 do
+      begin match t.table.(i + 1).(j - 1).elem, t.table.(i + 1).(j).elem with
+        Ghost x, Ghost _ ->
+          if t.table.(i).(j - 1).span = t.table.(i).(j).span then
+            t.table.(i + 1).(j) <-
+              {elem = Ghost x; span = t.table.(i + 1).(j - 1).span}
+      | _ -> ()
+      end;
+      match t.table.(i).(j - 1).elem, t.table.(i).(j).elem with
+        Ghost x, Ghost _ ->
+          if t.table.(i + 1).(j - 1).elem = t.table.(i + 1).(j).elem then
+            begin
+              t.table.(i).(j) <-
+                {elem = Ghost x; span = t.table.(i).(j - 1).span};
+              if i > 0 then
+                t.table.(i - 1).(j).span <- t.table.(i - 1).(j - 1).span
+            end
+      | _ -> ()
+    done
+  done
+;;
+
+(* group_children:
+   transform all A A into A A
+                 x y      x x *)
+
+let group_children t =
+  for i = 0 to Array.length t.table - 1 do
+    let line = t.table.(i) in
+    let len = Array.length line in
+    for j = 1 to len - 1 do
+      if line.(j).elem = line.(j - 1).elem && line.(j).elem <> Nothing then
+        line.(j).span <- line.(j - 1).span
+    done
+  done
+;;
+
+(* group_span_by_common_children:
+   in the last line, transform all
+     A B into A B
+     x y      x x
+   if A and B have common children *)
+
+let group_span_by_common_children d t =
+  let module O = struct type t = idag;; let compare (x:t) y = compare x y;; end
+  in
+  let module S = Set.Make (O)
+  in
+  let i = Array.length t.table - 1 in
+  let line = t.table.(i) in
+  let rec loop j cs =
+    if j = Array.length line then ()
+    else
+      match line.(j).elem with
+        Elem id ->
+          let n = d.dag.(int_of_idag id) in
+          let curr_cs = List.fold_right S.add n.chil S.empty in
+          if S.is_empty (S.inter cs curr_cs) then loop (j + 1) curr_cs
+          else
+            begin
+              line.(j).span <- line.(j - 1).span;
+              loop (j + 1) (S.union cs curr_cs)
+            end
+      | _ -> loop (j + 1) S.empty
+  in
+  loop 0 S.empty
+;;
+
+let find_same_parents t i j1 j2 j3 j4 =
+  let rec loop i j1 j2 j3 j4 =
+    if i = 0 then i, j1, j2, j3, j4
+    else
+      let x1 = t.(i - 1).(j1) in
+      let x2 = t.(i - 1).(j2) in
+      let x3 = t.(i - 1).(j3) in
+      let x4 = t.(i - 1).(j4) in
+      if x1.span = x4.span then i, j1, j2, j3, j4
+      else
+        let j1 =
+          let rec loop j =
+            if j < 0 then 0
+            else if t.(i - 1).(j).span = x1.span then loop (j - 1)
+            else j + 1
+          in
+          loop (j1 - 1)
+        in
+        let j2 =
+          let rec loop j =
+            if j >= Array.length t.(i) then j - 1
+            else if t.(i - 1).(j).span = x2.span then loop (j + 1)
+            else j - 1
+          in
+          loop (j2 + 1)
+        in
+        let j3 =
+          let rec loop j =
+            if j < 0 then 0
+            else if t.(i - 1).(j).span = x3.span then loop (j - 1)
+            else j + 1
+          in
+          loop (j3 - 1)
+        in
+        let j4 =
+          let rec loop j =
+            if j >= Array.length t.(i) then j - 1
+            else if t.(i - 1).(j).span = x4.span then loop (j + 1)
+            else j - 1
+          in
+          loop (j4 + 1)
+        in
+        loop (i - 1) j1 j2 j3 j4
+  in
+  loop i j1 j2 j3 j4
+;;
+
+let find_linked_children t i j1 j2 j3 j4 =
+  let rec loop i j1 j2 j3 j4 =
+    if i = Array.length t - 1 then j1, j2, j3, j4
+    else
+      let x1 = t.(i).(j1) in
+      let x2 = t.(i).(j2) in
+      let x3 = t.(i).(j3) in
+      let x4 = t.(i).(j4) in
+      let j1 =
+        let rec loop j =
+          if j < 0 then 0
+          else if t.(i).(j).span = x1.span then loop (j - 1)
+          else j + 1
+        in
+        loop (j1 - 1)
+      in
+      let j2 =
+        let rec loop j =
+          if j >= Array.length t.(i) then j - 1
+          else if t.(i).(j).span = x2.span then loop (j + 1)
+          else j - 1
+        in
+        loop (j2 + 1)
+      in
+      let j3 =
+        let rec loop j =
+          if j < 0 then 0
+          else if t.(i).(j).span = x3.span then loop (j - 1)
+          else j + 1
+        in
+        loop (j3 - 1)
+      in
+      let j4 =
+        let rec loop j =
+          if j >= Array.length t.(i) then j - 1
+          else if t.(i).(j).span = x4.span then loop (j + 1)
+          else j - 1
+        in
+        loop (j4 + 1)
+      in
+      loop (i + 1) j1 j2 j3 j4
+  in
+  loop i j1 j2 j3 j4
+;;
+
+let mirror_block t i1 i2 j1 j2 =
+  for i = i1 to i2 do
+    let line = t.(i) in
+    let rec loop j1 j2 =
+      if j1 >= j2 then ()
+      else
+        let v = line.(j1) in
+        line.(j1) <- line.(j2); line.(j2) <- v; loop (j1 + 1) (j2 - 1)
+    in
+    loop j1 j2
+  done
+;;
+
+let exch_blocks t i1 i2 j1 j2 j3 j4 =
+  for i = i1 to i2 do
+    let line = t.(i) in
+    let saved = Array.copy line in
+    for j = j1 to j2 do line.(j4 - j2 + j) <- saved.(j) done;
+    for j = j3 to j4 do line.(j1 - j3 + j) <- saved.(j) done
+  done
+;;
+
+let find_block_with_parents t i jj1 jj2 jj3 jj4 =
+  let rec loop ii jj1 jj2 jj3 jj4 =
+    let (nii, njj1, njj2, njj3, njj4) =
+      find_same_parents t i jj1 jj2 jj3 jj4
+    in
+    if nii <> ii || njj1 <> jj1 || njj2 <> jj2 || njj3 <> jj3 ||
+       njj4 <> jj4 then
+      let nii = min ii nii in
+      let (jj1, jj2, jj3, jj4) =
+        find_linked_children t nii njj1 njj2 njj3 njj4
+      in
+      if njj1 <> jj1 || njj2 <> jj2 || njj3 <> jj3 || njj4 <> jj4 then
+        loop nii jj1 jj2 jj3 jj4
+      else nii, jj1, jj2, jj3, jj4
+    else ii, jj1, jj2, jj3, jj4
+  in
+  loop i jj1 jj2 jj3 jj4
+;;
+
+let push_to_right t i j1 j2 =
+  let line = t.(i) in
+  let rec loop j =
+    if j = j2 then j - 1
+    else
+      let ini_jj1 =
+        match line.(j - 1).elem with
+          Nothing -> j - 1
+        | x ->
+            let rec same_value j =
+              if j < 0 then 0
+              else if line.(j).elem = x then same_value (j - 1)
+              else j + 1
+            in
+            same_value (j - 2)
+      in
+      let jj1 = ini_jj1 in
+      let jj2 = j - 1 in
+      let jj3 = j in
+      let jj4 =
+        match line.(j).elem with
+          Nothing -> j
+        | x ->
+            let rec same_value j =
+              if j >= Array.length line then j - 1
+              else if line.(j).elem = x then same_value (j + 1)
+              else j - 1
+            in
+            same_value (j + 1)
+      in
+      let (ii, jj1, jj2, jj3, jj4) =
+        find_block_with_parents t i jj1 jj2 jj3 jj4
+      in
+      if jj4 < j2 && jj2 < jj3 then
+        begin exch_blocks t ii i jj1 jj2 jj3 jj4; loop (jj4 + 1) end
+      else if jj4 < j2 && jj1 = ini_jj1 && jj2 <= jj4 then
+        begin mirror_block t ii i jj1 jj4; loop (jj4 + 1) end
+      else j - 1
+  in
+  loop (j1 + 1)
+;;
+
+let push_to_left t i j1 j2 =
+  let line = t.(i) in
+  let rec loop j =
+    if j = j1 then j + 1
+    else
+      let jj1 =
+        match line.(j).elem with
+          Nothing -> j
+        | x ->
+            let rec same_value j =
+              if j < 0 then 0
+              else if line.(j).elem = x then same_value (j - 1)
+              else j + 1
+            in
+            same_value (j - 1)
+      in
+      let jj2 = j in
+      let jj3 = j + 1 in
+      let ini_jj4 =
+        match line.(j + 1).elem with
+          Nothing -> j + 1
+        | x ->
+            let rec same_value j =
+              if j >= Array.length line then j - 1
+              else if line.(j).elem = x then same_value (j + 1)
+              else j - 1
+            in
+            same_value (j + 2)
+      in
+      let jj4 = ini_jj4 in
+      let (ii, jj1, jj2, jj3, jj4) =
+        find_block_with_parents t i jj1 jj2 jj3 jj4
+      in
+      if jj1 > j1 && jj2 < jj3 then
+        begin exch_blocks t ii i jj1 jj2 jj3 jj4; loop (jj1 - 1) end
+      else if jj1 > j1 && jj4 = ini_jj4 && jj3 >= jj1 then
+        begin mirror_block t ii i jj1 jj4; loop (jj1 - 1) end
+      else j + 1
+  in
+  loop (j2 - 1)
+;;
+
+let fill_gap t i j1 j2 =
+  let t1 =
+    let t1 = Array.copy t.table in
+    for i = 0 to Array.length t.table - 1 do
+      t1.(i) <- Array.copy t.table.(i);
+      for j = 0 to Array.length t1.(i) - 1 do
+        t1.(i).(j) <- copy_data t.table.(i).(j)
+      done
+    done;
+    t1
+  in
+  let j2 = push_to_left t1 i j1 j2 in
+  let j1 = push_to_right t1 i j1 j2 in
+  if j1 = j2 - 1 then
+    let line = t1.(i - 1) in
+    let x = line.(j1).span in
+    let y = line.(j2).span in
+    let rec loop y j =
+      if j >= Array.length line then ()
+      else if line.(j).span = y || t1.(i).(j).elem = t1.(i).(j - 1).elem then
+        let y = line.(j).span in
+        line.(j).span <- x;
+        if i > 0 then t1.(i - 1).(j).span <- t1.(i - 1).(j - 1).span;
+        loop y (j + 1)
+    in
+    loop y j2; Some ({table = t1}, true)
+  else None
+;;
+
+let treat_gaps t =
+  let i = Array.length t.table - 1 in
+  let rec loop t j =
+    let line = t.table.(i) in
+    if j = Array.length line then t
+    else
+      match line.(j).elem with
+        Elem _ as y ->
+          if y = line.(j - 1).elem then loop t (j + 1)
+          else
+            let rec loop1 t j1 =
+              if j1 < 0 then loop t (j + 1)
+              else if y = line.(j1).elem then
+                match fill_gap t i j1 j with
+                  Some (t, ok) -> if ok then loop t 2 else loop t (j + 1)
+                | None -> loop t (j + 1)
+              else loop1 t (j1 - 1)
+            in
+            loop1 t (j - 2)
+      | _ -> loop t (j + 1)
+  in
+  if Array.length t.table.(i) = 1 then t else loop t 2
+;;
+
+let group_span_last_row t =
+  let row = t.table.(Array.length t.table - 1) in
+  let rec loop i =
+    if i >= Array.length row then ()
+    else
+      begin
+        begin match row.(i).elem with
+          Elem _ | Ghost _ as x ->
+            if x = row.(i - 1).elem then row.(i).span <- row.(i - 1).span
+        | _ -> ()
+        end;
+        loop (i + 1)
+      end
+  in
+  loop 1
+;;
+
+let has_phony_children phony d t =
+  let line = t.table.(Array.length t.table - 1) in
+  let rec loop j =
+    if j = Array.length line then false
+    else
+      match line.(j).elem with
+        Elem x -> if phony d.dag.(int_of_idag x) then true else loop (j + 1)
+      | _ -> loop (j + 1)
+  in
+  loop 0
+;;
+
+let tablify phony no_optim no_group d =
+  let a = ancestors d in
+  let r = group_by_common_children d a in
+  let t = {table = [| Array.of_list r |]} in
+  let rec loop t =
+    let (t, new_row) = treat_new_row d t in
+    if List.for_all (fun x -> x.elem = Nothing) new_row then t
+    else
+      let t = {table = Array.append t.table [| Array.of_list new_row |]} in
+      let t =
+        if no_group && not (has_phony_children phony d t) then t
+        else begin
+          if no_optim then () else equilibrate t;
+          group_elem t;
+          group_ghost t;
+          group_children t;
+          group_span_by_common_children d t;
+          let t = if no_optim then t else treat_gaps t in
+          group_span_last_row t;
+          t
+        end
+      in
+      loop t
+  in
+  loop t
+;;
+
+let fall t =
+  for i = 1 to Array.length t.table - 1 do
+    let line = t.table.(i) in
+    let rec loop j =
+      if j = Array.length line then ()
+      else
+        match line.(j).elem with
+          Ghost x ->
+            let j2 =
+              let rec loop j =
+                if j = Array.length line then j - 1
+                else
+                  match line.(j).elem with
+                    Ghost y when y = x -> loop (j + 1)
+                  | _ -> j - 1
+              in
+              loop (j + 1)
+            in
+            let i1 =
+              let rec loop i =
+                if i < 0 then i + 1
+                else
+                  let line = t.table.(i) in
+                  if (j = 0 || line.(j - 1).span <> line.(j).span) &&
+                     (j2 = Array.length line - 1 ||
+                      line.(j2 + 1).span <> line.(j2).span) then
+                    loop (i - 1)
+                  else i + 1
+              in
+              loop (i - 1)
+            in
+            let i1 =
+              if i1 = i then i1
+              else if i1 = 0 then i1
+              else if t.table.(i1).(j).elem = Nothing then i1
+              else i
+            in
+            if i1 < i then
+              begin
+                for k = i downto i1 + 1 do
+                  for j = j to j2 do
+                    t.table.(k).(j).elem <- t.table.(k - 1).(j).elem;
+                    if k < i then
+                      t.table.(k).(j).span <- t.table.(k - 1).(j).span
+                  done
+                done;
+                for l = j to j2 do
+                  if i1 = 0 || t.table.(i1 - 1).(l).elem = Nothing then
+                    t.table.(i1).(l).elem <- Nothing
+                  else
+                    t.table.(i1).(l) <-
+                      if l = j ||
+                         t.table.(i1 - 1).(l - 1).span <>
+                           t.table.(i1 - 1).(l).span then
+                        {elem = Ghost (new_ghost_id ());
+                         span = new_span_id ()}
+                      else copy_data t.table.(i1).(l - 1)
+                done
+              end;
+            loop (j2 + 1)
+        | _ -> loop (j + 1)
+    in
+    loop 0
+  done
+;;
+
+let fall2_cool_right t i1 i2 _i3 j1 j2 =
+  let span = t.table.(i2 - 1).(j1).span in
+  for i = i2 - 1 downto 0 do
+    for j = j1 to j2 - 1 do
+      t.table.(i).(j) <-
+        if i - i2 + i1 >= 0 then t.table.(i - i2 + i1).(j)
+        else {elem = Nothing; span = new_span_id ()}
+    done
+  done;
+  for i = Array.length t.table - 1 downto 0 do
+    for j = j2 to Array.length t.table.(i) - 1 do
+      t.table.(i).(j) <-
+        if i - i2 + i1 >= 0 then t.table.(i - i2 + i1).(j)
+        else {elem = Nothing; span = new_span_id ()}
+    done
+  done;
+  let old_span = t.table.(i2 - 1).(j1).span in
+  let rec loop j =
+    if j = Array.length t.table.(i2 - 1) then ()
+    else if t.table.(i2 - 1).(j).span = old_span then
+      begin t.table.(i2 - 1).(j).span <- span; loop (j + 1) end
+  in
+  loop j1
+;;
+
+let fall2_cool_left t i1 i2 _i3 j1 j2 =
+  let span = t.table.(i2 - 1).(j2).span in
+  for i = i2 - 1 downto 0 do
+    for j = j1 + 1 to j2 do
+      t.table.(i).(j) <-
+        if i - i2 + i1 >= 0 then t.table.(i - i2 + i1).(j)
+        else {elem = Nothing; span = new_span_id ()}
+    done
+  done;
+  for i = Array.length t.table - 1 downto 0 do
+    for j = j1 downto 0 do
+      t.table.(i).(j) <-
+        if i - i2 + i1 >= 0 then t.table.(i - i2 + i1).(j)
+        else {elem = Nothing; span = new_span_id ()}
+    done
+  done;
+  let old_span = t.table.(i2 - 1).(j2).span in
+  let rec loop j =
+    if j < 0 then ()
+    else if t.table.(i2 - 1).(j).span = old_span then
+      begin t.table.(i2 - 1).(j).span <- span; loop (j - 1) end
+  in
+  loop j2
+;;
+
+let do_fall2_right t i1 i2 j1 j2 =
+  let i3 =
+    let rec loop_i i =
+      if i < 0 then 0
+      else
+        let rec loop_j j =
+          if j = Array.length t.table.(i) then loop_i (i - 1)
+          else
+            match t.table.(i).(j).elem with
+              Nothing -> loop_j (j + 1)
+            | _ -> i + 1
+        in
+        loop_j j2
+    in
+    loop_i (Array.length t.table - 1)
+  in
+  let new_height = i3 + i2 - i1 in
+  let t =
+    if new_height > Array.length t.table then
+      let rec loop cnt t =
+        if cnt = 0 then t
+        else
+          let new_line =
+            Array.init (Array.length t.table.(0))
+              (fun _ -> {elem = Nothing; span = new_span_id ()})
+          in
+          let t = {table = Array.append t.table [| new_line |]} in
+          loop (cnt - 1) t
+      in
+      loop (new_height - Array.length t.table) t
+    else t
+  in
+  fall2_cool_right t i1 i2 i3 j1 j2; t
+;;
+
+let do_fall2_left t i1 i2 j1 j2 =
+  let i3 =
+    let rec loop_i i =
+      if i < 0 then 0
+      else
+        let rec loop_j j =
+          if j < 0 then loop_i (i - 1)
+          else
+            match t.table.(i).(j).elem with
+              Nothing -> loop_j (j - 1)
+            | _ -> i + 1
+        in
+        loop_j j1
+    in
+    loop_i (Array.length t.table - 1)
+  in
+  let new_height = i3 + i2 - i1 in
+  let t =
+    if new_height > Array.length t.table then
+      let rec loop cnt t =
+        if cnt = 0 then t
+        else
+          let new_line =
+            Array.init (Array.length t.table.(0))
+              (fun _ -> {elem = Nothing; span = new_span_id ()})
+          in
+          let t = {table = Array.append t.table [| new_line |]} in
+          loop (cnt - 1) t
+      in
+      loop (new_height - Array.length t.table) t
+    else t
+  in
+  fall2_cool_left t i1 i2 i3 j1 j2; t
+;;
+
+let do_shorten_too_long t i1 j1 j2 =
+  for i = i1 to Array.length t.table - 2 do
+    for j = j1 to j2 - 1 do t.table.(i).(j) <- t.table.(i + 1).(j) done
+  done;
+  let i = Array.length t.table - 1 in
+  for j = j1 to j2 - 1 do
+    t.table.(i).(j) <- {elem = Nothing; span = new_span_id ()}
+  done;
+  t
+;;
+
+let try_fall2_right t i j =
+  match t.table.(i).(j).elem with
+    Ghost _ ->
+      let i1 =
+        let rec loop i =
+          if i < 0 then 0
+          else
+            match t.table.(i).(j).elem with
+              Ghost _ -> loop (i - 1)
+            | _ -> i + 1
+        in
+        loop (i - 1)
+      in
+      let separated1 =
+        let rec loop i =
+          if i < 0 then true
+          else if
+            j > 0 && t.table.(i).(j - 1).span = t.table.(i).(j).span then
+            false
+          else loop (i - 1)
+        in
+        loop (i1 - 1)
+      in
+      let j2 =
+        let x = t.table.(i).(j).span in
+        let rec loop j2 =
+          if j2 = Array.length t.table.(i) then j2
+          else
+            match t.table.(i).(j2) with
+              {elem = Ghost _; span = y} when y = x -> loop (j2 + 1)
+            | _ -> j2
+        in
+        loop (j + 1)
+      in
+      let separated2 =
+        let rec loop i =
+          if i = Array.length t.table then true
+          else if j2 = Array.length t.table.(i) then false
+          else if t.table.(i).(j2 - 1).span = t.table.(i).(j2).span then false
+          else loop (i + 1)
+        in
+        loop (i + 1)
+      in
+      if not separated1 || not separated2 then None
+      else Some (do_fall2_right t i1 (i + 1) j j2)
+  | _ -> None
+;;
+
+let try_fall2_left t i j =
+  match t.table.(i).(j).elem with
+    Ghost _ ->
+      let i1 =
+        let rec loop i =
+          if i < 0 then 0
+          else
+            match t.table.(i).(j).elem with
+              Ghost _ -> loop (i - 1)
+            | _ -> i + 1
+        in
+        loop (i - 1)
+      in
+      let separated1 =
+        let rec loop i =
+          if i < 0 then true
+          else if
+            j < Array.length t.table.(i) - 1 &&
+            t.table.(i).(j).span = t.table.(i).(j + 1).span then
+            false
+          else loop (i - 1)
+        in
+        loop (i1 - 1)
+      in
+      let j1 =
+        let x = t.table.(i).(j).span in
+        let rec loop j1 =
+          if j1 < 0 then j1
+          else
+            match t.table.(i).(j1) with
+              {elem = Ghost _; span = y} when y = x -> loop (j1 - 1)
+            | _ -> j1
+        in
+        loop (j - 1)
+      in
+      let separated2 =
+        let rec loop i =
+          if i = Array.length t.table then true
+          else if j1 < 0 then false
+          else if t.table.(i).(j1).span = t.table.(i).(j1 + 1).span then false
+          else loop (i + 1)
+        in
+        loop (i + 1)
+      in
+      if not separated1 || not separated2 then None
+      else Some (do_fall2_left t i1 (i + 1) j1 j)
+  | _ -> None
+;;
+
+let try_shorten_too_long t i j =
+  match t.table.(i).(j).elem with
+    Ghost _ ->
+      let j2 =
+        let x = t.table.(i).(j).span in
+        let rec loop j2 =
+          if j2 = Array.length t.table.(i) then j2
+          else
+            match t.table.(i).(j2) with
+              {elem = Ghost _; span = y} when y = x -> loop (j2 + 1)
+            | _ -> j2
+        in
+        loop (j + 1)
+      in
+      let i1 =
+        let rec loop i =
+          if i = Array.length t.table then i
+          else
+            match t.table.(i).(j).elem with
+              Elem _ -> loop (i + 1)
+            | _ -> i
+        in
+        loop (i + 1)
+      in
+      let i2 =
+        let rec loop i =
+          if i = Array.length t.table then i
+          else
+            match t.table.(i).(j).elem with
+              Nothing -> loop (i + 1)
+            | _ -> i
+        in
+        loop i1
+      in
+      let separated_left =
+        let rec loop i =
+          if i = i2 then true
+          else if
+            j > 0 && t.table.(i).(j).span = t.table.(i).(j - 1).span then
+            false
+          else loop (i + 1)
+        in
+        loop i
+      in
+      let separated_right =
+        let rec loop i =
+          if i = i2 then true
+          else if
+            j2 < Array.length t.table.(i) &&
+            t.table.(i).(j2 - 1).span = t.table.(i).(j2).span then
+            false
+          else loop (i + 1)
+        in
+        loop i
+      in
+      if not separated_left || not separated_right then None
+      else if i2 < Array.length t.table then None
+      else Some (do_shorten_too_long t i j j2)
+  | _ -> None
+;;
+
+let fall2_right t =
+  let rec loop_i i t =
+    if i <= 0 then t
+    else
+      let rec loop_j j t =
+        if j < 0 then loop_i (i - 1) t
+        else
+          match try_fall2_right t i j with
+            Some t -> loop_i (Array.length t.table - 1) t
+          | None -> loop_j (j - 1) t
+      in
+      loop_j (Array.length t.table.(i) - 2) t
+  in
+  loop_i (Array.length t.table - 1) t
+;;
+
+let fall2_left t =
+  let rec loop_i i t =
+    if i <= 0 then t
+    else
+      let rec loop_j j t =
+        if j >= Array.length t.table.(i) then loop_i (i - 1) t
+        else
+          match try_fall2_left t i j with
+            Some t -> loop_i (Array.length t.table - 1) t
+          | None -> loop_j (j + 1) t
+      in
+      loop_j 1 t
+  in
+  loop_i (Array.length t.table - 1) t
+;;
+
+let shorten_too_long t =
+  let rec loop_i i t =
+    if i <= 0 then t
+    else
+      let rec loop_j j t =
+        if j >= Array.length t.table.(i) then loop_i (i - 1) t
+        else
+          match try_shorten_too_long t i j with
+            Some t -> loop_i (Array.length t.table - 1) t
+          | None -> loop_j (j + 1) t
+      in
+      loop_j 1 t
+  in
+  loop_i (Array.length t.table - 1) t
+;;
+
+(* top_adjust:
+   deletes all empty rows that might have appeared on top of the table
+   after the falls *)
+
+let top_adjust t =
+  let di =
+    let rec loop i =
+      if i = Array.length t.table then i
+      else
+        let rec loop_j j =
+          if j = Array.length t.table.(i) then loop (i + 1)
+          else if t.table.(i).(j).elem <> Nothing then i
+          else loop_j (j + 1)
+        in
+        loop_j 0
+    in
+    loop 0
+  in
+  if di > 0 then
+    begin
+      for i = 0 to Array.length t.table - 1 - di do
+        t.table.(i) <- t.table.(i + di)
+      done;
+      {table = Array.sub t.table 0 (Array.length t.table - di)}
+    end
+  else t
+;;
+
+(* bottom_adjust:
+   deletes all empty rows that might have appeared on bottom of the table
+   after the falls *)
+
+let bottom_adjust t =
+  let last_i =
+    let rec loop i =
+      if i < 0 then i
+      else
+        let rec loop_j j =
+          if j = Array.length t.table.(i) then loop (i - 1)
+          else if t.table.(i).(j).elem <> Nothing then i
+          else loop_j (j + 1)
+        in
+        loop_j 0
+    in
+    loop (Array.length t.table - 1)
+  in
+  if last_i < Array.length t.table - 1 then
+    {table = Array.sub t.table 0 (last_i + 1)}
+  else t
+;;
+
+(* invert *)
+
+let invert_dag d =
+  let d = {dag = Array.copy d.dag} in
+  for i = 0 to Array.length d.dag - 1 do
+    let n = d.dag.(i) in
+    d.dag.(i) <-
+      {pare = List.map (fun x -> x) n.chil; valu = n.valu;
+       chil = List.map (fun x -> x) n.pare}
+  done;
+  d
+;;
+
+let invert_table t =
+  let t' = {table = Array.copy t.table} in
+  let len = Array.length t.table in
+  for i = 0 to len - 1 do
+    t'.table.(i) <-
+      Array.init (Array.length t.table.(0))
+        (fun j ->
+           let d = t.table.(len - 1 - i).(j) in
+           {elem = d.elem; span = d.span});
+    if i < len - 1 then
+      for j = 0 to Array.length t'.table.(i) - 1 do
+        t'.table.(i).(j).span <- t.table.(len - 2 - i).(j).span
+      done
+  done;
+  t'
+;;
+
+(* main *)
+
+let table_of_dag phony no_optim invert no_group d =
+  let d = if invert then invert_dag d else d in
+  let t = tablify phony no_optim no_group d in
+  let t = if invert then invert_table t else t in
+  fall t;
+  let t = fall2_right t in
+  let t = fall2_left t in
+  let t = shorten_too_long t in
+  let t = top_adjust t in let t = bottom_adjust t in t
+;;
+
+
+(* input dag *)
+
+let phony _ = false;;
+let indi_txt n = n.valu;;
+
+let string_table border hts =
+  let buf = Buffer.create 30 in
+  Printf.bprintf buf "
    \n";
+  for i = 0 to Array.length hts - 1 do
+    Printf.bprintf buf  "\n";
+    for j = 0 to Array.length hts.(i) - 1 do
+      let (colspan, align, td) = hts.(i).(j) in
+      Printf.bprintf buf " Printf.bprintf buf " align=left"
+      | LeftA, _ -> ()
+      | CenterA, _ -> Printf.bprintf buf " align=center"
+      | RightA, _ -> Printf.bprintf buf " align=right"
+      end;
+      Printf.bprintf buf ">";
+      begin match td with
+        TDstring s -> Printf.bprintf buf "%s" s
+      | TDhr align ->
+          Printf.bprintf buf "
     Printf.bprintf buf " width=\"50%%\" align=left"
+          | RightA -> Printf.bprintf buf " width=\"50%%\" align=right"
+          | _ -> ()
+          end;
+          Printf.bprintf buf ">";
+          ()
+      end;
+      Printf.bprintf buf "\n";
+      ()
+    done
+  done;
+  Printf.bprintf buf "
    \n";
+  Buffer.contents buf
+;;
+
+let invert = ref false;;
+let border = ref 0;;
+let no_optim = ref false;;
+let no_group = ref false;;
+
+let html_of_dag d =
+  let t = table_of_dag phony !no_optim !invert !no_group d in
+  let hts = html_table_struct indi_txt phony d t in
+  string_table !border hts
+;;
+
+
+(********************************* Max's code **********************************)
+(** This function takes a list of classes and a list of class types
+   and create the associate dag. *)
+let create_class_dag cl_list clt_list =
+  let module M = Odoc_info.Class in
+  (* the list of all the classes concerned *)
+  let cl_list2 = List.map (fun c -> (c.M.cl_name, Some (M.Cl c))) cl_list in
+  let clt_list2 = List.map (fun ct -> (ct.M.clt_name, Some (M.Cltype (ct, [])))) clt_list in
+  let list = cl_list2 @ clt_list2 in
+  let all_classes =
+    let rec iter list2 =
+      List.fold_left
+        (fun acc -> fun (name, cct_opt) ->
+          let l =
+            match cct_opt with
+              None -> []
+            | Some (M.Cl c) ->
+                iter
+                  (List.map
+                     (fun inh ->(inh.M.ic_name, inh.M.ic_class))
+                     (match c.M.cl_kind with
+                       M.Class_structure (inher_l, _) ->
+                         inher_l
+                     | _ ->
+                         []
+                     )
+                  )
+            | Some (M.Cltype (ct, _)) ->
+                iter
+                  (List.map
+                     (fun inh ->(inh.M.ic_name, inh.M.ic_class))
+                     (match ct.M.clt_kind with
+                       M.Class_signature (inher_l, _) ->
+                         inher_l
+                     | _ ->
+                         []
+                     )
+                  )
+          in
+          (name, cct_opt) :: (acc @ l)
+        )
+        []
+        list2
+    in
+    iter list
+  in
+  let rec distinct acc = function
+    [] ->
+      acc
+    |   (name, cct_opt) :: q ->
+        if List.exists (fun (name2, _) -> name = name2) acc then
+          distinct acc q
+        else
+          distinct ((name, cct_opt) :: acc) q
+  in
+  let distinct_classes = distinct [] all_classes in
+  let liste_index =
+    let rec f n = function
+        [] -> []
+      | (name, _) :: q -> (name, n) :: (f (n+1) q)
+    in
+    f 0 distinct_classes
+  in
+  let array1 = Array.of_list distinct_classes in
+  (* create the dag array, filling parents and values *)
+  let fmap (name, cct_opt) =
+    { pare = List.map
+        (fun inh -> List.assoc inh.M.ic_name liste_index )
+        (match cct_opt with
+          None -> []
+        | Some (M.Cl c) ->
+            (match c.M.cl_kind with
+              M.Class_structure (inher_l, _) ->
+                inher_l
+            | _ ->
+                []
+            )
+        | Some (M.Cltype (ct, _)) ->
+            (match ct.M.clt_kind with
+              M.Class_signature (inher_l, _) ->
+                inher_l
+            | _ ->
+                []
+            )
+        );
+      valu = (name, cct_opt) ;
+      chil = []
+    }
+  in
+  let dag = { dag = Array.map fmap array1 } in
+  (* fill the children *)
+  let fiter i node =
+    let l = Array.to_list dag.dag in
+    let l2 = List.map (fun n -> n.valu)
+        (List.filter (fun n -> List.mem i n.pare) l)
+    in
+    node.chil <- List.map (fun (name,_) -> List.assoc name liste_index) l2
+  in
+  Array.iteri fiter dag.dag;
+  dag
diff --git a/ocamldoc/odoc_dag2html.mli b/ocamldoc/odoc_dag2html.mli
new file mode 100644
index 00000000..767c1ec3
--- /dev/null
+++ b/ocamldoc/odoc_dag2html.mli
@@ -0,0 +1,31 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The types and functions to create a html table representing a dag.
+   Thanks to Daniel de Rauglaudre. *)
+
+type 'a dag = { mutable dag : 'a node array }
+and 'a node =
+  { mutable pare : idag list; valu : 'a; mutable chil : idag list }
+and idag = int
+
+(** This function returns the html code to represent the given dag. *)
+val html_of_dag : string dag -> string
+
+(** This function takes a list of classes and a list of class types and creates the associate dag. *)
+val create_class_dag :
+    Odoc_info.Class.t_class list ->
+      Odoc_info.Class.t_class_type list ->
+        (Odoc_info.Name.t * Odoc_info.Class.cct option) dag
diff --git a/ocamldoc/odoc_dep.ml b/ocamldoc/odoc_dep.ml
new file mode 100644
index 00000000..5e6c7837
--- /dev/null
+++ b/ocamldoc/odoc_dep.ml
@@ -0,0 +1,214 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Top modules dependencies. *)
+
+module Module = Odoc_module
+module Type = Odoc_type
+module String = Misc.Stdlib.String
+
+let set_to_list s =
+  let l = ref [] in
+  String.Set.iter (fun e -> l := e :: !l) s;
+  !l
+
+let impl_dependencies ast =
+  Depend.free_structure_names := String.Set.empty;
+  Depend.add_use_file String.Map.empty [Parsetree.Ptop_def ast];
+  set_to_list !Depend.free_structure_names
+
+let intf_dependencies ast =
+  Depend.free_structure_names := String.Set.empty;
+  Depend.add_signature String.Map.empty ast;
+  set_to_list !Depend.free_structure_names
+
+
+module Dep =
+  struct
+    type id = string
+
+    let set_to_list s =
+      let l = ref [] in
+      String.Set.iter (fun e -> l := e :: !l) s;
+      !l
+
+    type node = {
+        id : id ;
+        mutable near : String.Set.t ; (** direct children *)
+        mutable far : (id * String.Set.t) list ; (** indirect children, from which children path *)
+        reflex : bool ; (** reflexive or not, we keep
+                           information here to remove the node itself from its direct children *)
+      }
+
+    type graph = node list
+
+    let make_node s children =
+      let set = List.fold_right
+          String.Set.add
+          children
+          String.Set.empty
+      in
+      { id = s;
+        near = String.Set.remove s set ;
+        far = [] ;
+        reflex = List.mem s children ;
+      }
+
+    let get_node graph s =
+      try List.find (fun n -> n.id = s) graph
+      with Not_found ->
+        make_node s []
+
+    let rec trans_closure graph acc n =
+      if String.Set.mem n.id acc then
+        acc
+      else
+        (* potential optimisation: use far field if nonempty? *)
+        String.Set.fold
+          (fun child -> fun acc2 ->
+            trans_closure graph acc2 (get_node graph child))
+          n.near
+          (String.Set.add n.id acc)
+
+    let node_trans_closure graph n =
+      let far = List.map
+          (fun child ->
+            let set = trans_closure graph String.Set.empty (get_node graph child) in
+            (child, set)
+          )
+          (set_to_list n.near)
+      in
+      n.far <- far
+
+    let compute_trans_closure graph =
+      List.iter (node_trans_closure graph) graph
+
+    let prune_node graph node =
+      String.Set.iter
+        (fun child ->
+          let set_reachables = List.fold_left
+              (fun acc -> fun (ch, reachables) ->
+                if child = ch then
+                  acc
+                else
+                  String.Set.union acc reachables
+              )
+              String.Set.empty
+              node.far
+          in
+          let set = String.Set.remove node.id set_reachables in
+          if String.Set.exists (fun n2 -> String.Set.mem child (get_node graph n2).near) set then
+            (
+             node.near <- String.Set.remove child node.near ;
+             node.far <- List.filter (fun (ch,_) -> ch <> child) node.far
+            )
+          else
+            ()
+        )
+        node.near;
+      if node.reflex then
+        node.near <- String.Set.add node.id node.near
+      else
+        ()
+
+    let kernel graph =
+      (* compute transitive closure *)
+      compute_trans_closure graph ;
+
+      (* remove edges to keep a transitive kernel *)
+      List.iter (prune_node graph) graph;
+
+      graph
+
+  end
+
+(** [type_deps t] returns the list of fully qualified type names
+   [t] depends on. *)
+let type_deps t =
+  let module T = Odoc_type in
+  let l = ref [] in
+  let re = Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([a-z][a-zA-Z_'0-9]*\\)" in
+  let f s =
+    let s2 = Str.matched_string s in
+    l := s2 :: !l ;
+    s2
+  in
+  let ty t =
+    let s = Odoc_print.string_of_type_expr t in
+    ignore (Str.global_substitute re f s)
+  in
+  (match t.T.ty_kind with
+    T.Type_abstract -> ()
+  | T.Type_variant cl ->
+      List.iter
+        (fun c ->
+           match c.T.vc_args with
+           | T.Cstr_tuple l -> List.iter ty l
+           | T.Cstr_record l -> List.iter (fun r -> ty r.T.rf_type) l
+        )
+        cl
+  | T.Type_record rl ->
+      List.iter (fun r -> ty r.T.rf_type) rl
+  | T.Type_open -> ()
+  );
+
+  (match t.T.ty_manifest with
+    None -> ()
+  | Some (T.Object_type fields) ->
+      List.iter (fun r -> ty r.T.of_type) fields
+  | Some (T.Other e) ->
+      ty e
+  );
+
+  !l
+
+(** Modify the module dependencies of the given list of modules,
+   to get the minimum transitivity kernel. *)
+let kernel_deps_of_modules modules =
+  let graph = List.map
+      (fun m -> Dep.make_node m.Module.m_name m.Module.m_top_deps)
+      modules
+  in
+  let k = Dep.kernel graph in
+  List.iter
+    (fun m ->
+      let node = Dep.get_node k m.Module.m_name in
+      m.Module.m_top_deps <-
+        List.filter (fun m2 -> String.Set.mem m2 node.Dep.near) m.Module.m_top_deps)
+    modules
+
+(** Return the list of dependencies between the given types,
+   in the form of a list [(type, names of types it depends on)].
+   @param kernel indicates if we must keep only the transitivity kernel
+   of the dependencies. Default is [false].
+*)
+let deps_of_types ?(kernel=false) types =
+  let deps_pre = List.map (fun t -> (t, type_deps t)) types in
+  if kernel then
+    (
+      let graph = List.map
+          (fun (t, names) -> Dep.make_node t.Type.ty_name names)
+          deps_pre
+      in
+      let k = Dep.kernel graph in
+      List.map
+        (fun t ->
+           let node = Dep.get_node k t.Type.ty_name in
+           (t, Dep.set_to_list node.Dep.near)
+        )
+        types
+    )
+  else
+    deps_pre
diff --git a/ocamldoc/odoc_dot.ml b/ocamldoc/odoc_dot.ml
new file mode 100644
index 00000000..75cf4c80
--- /dev/null
+++ b/ocamldoc/odoc_dot.ml
@@ -0,0 +1,147 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Definition of a class which outputs a dot file showing
+   top modules dependencies.*)
+
+open Odoc_info
+
+module F = Format
+
+let dot_include_all = ref false
+
+let dot_types = ref false
+
+let dot_reduce = ref false
+
+let dot_colors  = ref (List.flatten Odoc_messages.default_dot_colors)
+
+module Generator =
+struct
+
+(** This class generates a dot file showing the top modules dependencies. *)
+class dot =
+  object (self)
+
+    (** To store the colors associated to locations of modules. *)
+    val mutable loc_colors = []
+
+    (** the list of modules we know. *)
+    val mutable modules = []
+
+    (** Colors to use when finding new locations of modules. *)
+    val mutable colors = !dot_colors
+
+    (** Graph header. *)
+    method header =
+      "digraph G {\n"^
+      "  size=\"10,7.5\";\n"^
+      "  ratio=\"fill\";\n"^
+      "  rotate=90;\n"^
+      "  fontsize=\"12pt\";\n"^
+      "  rankdir = TB ;\n"
+
+    method get_one_color =
+      match colors with
+        [] -> None
+      | h :: q ->
+          colors <- q ;
+          Some h
+
+    method node_color s =
+      try Some (List.assoc s loc_colors)
+      with
+        Not_found ->
+          match self#get_one_color with
+            None -> None
+          | Some c ->
+              loc_colors <- (s, c) :: loc_colors ;
+              Some c
+
+    method print_module_atts fmt m =
+      match self#node_color (Filename.dirname m.Module.m_file) with
+        None -> ()
+      | Some col -> F.fprintf fmt "\"%s\" [style=filled, color=%s];\n" m.Module.m_name col
+
+    method print_type_atts fmt t =
+      match self#node_color (Name.father t.Type.ty_name) with
+        None -> ()
+      | Some col -> F.fprintf fmt "\"%s\" [style=filled, color=%s];\n" t.Type.ty_name col
+
+    method print_one_dep fmt src dest =
+      F.fprintf fmt "\"%s\" -> \"%s\";\n" src dest
+
+    method generate_for_module fmt m =
+      let l = List.filter
+          (fun n ->
+            !dot_include_all ||
+            (List.exists (fun m -> m.Module.m_name = n) modules))
+          m.Module.m_top_deps
+      in
+      self#print_module_atts fmt m;
+      List.iter (self#print_one_dep fmt m.Module.m_name) l
+
+    method generate_for_type fmt (t, l) =
+      self#print_type_atts fmt t;
+      List.iter
+        (self#print_one_dep fmt t.Type.ty_name)
+        l
+
+    method generate_types types =
+      try
+        let oc = open_out !Global.out_file in
+        let fmt = F.formatter_of_out_channel oc in
+        F.fprintf fmt "%s" self#header;
+        let graph = Odoc_info.Dep.deps_of_types
+            ~kernel: !dot_reduce
+            types
+        in
+        List.iter (self#generate_for_type fmt) graph;
+        F.fprintf fmt "}\n" ;
+        F.pp_print_flush fmt ();
+        close_out oc
+      with
+        Sys_error s ->
+          raise (Failure s)
+
+    method generate_modules modules_list =
+      try
+        modules <- modules_list ;
+        let oc = open_out !Global.out_file in
+        let fmt = F.formatter_of_out_channel oc in
+        F.fprintf fmt "%s" self#header;
+
+        if !dot_reduce then
+          Odoc_info.Dep.kernel_deps_of_modules modules_list;
+
+        List.iter (self#generate_for_module fmt) modules_list;
+        F.fprintf fmt "}\n" ;
+        F.pp_print_flush fmt ();
+        close_out oc
+      with
+        Sys_error s ->
+          raise (Failure s)
+
+    (** Generate the dot code in the file {!Odoc_info.Args.out_file}. *)
+    method generate (modules_list : Odoc_info.Module.t_module list) =
+      colors <- !dot_colors;
+      if !dot_types then
+        self#generate_types (Odoc_info.Search.types modules_list)
+      else
+        self#generate_modules modules_list
+  end
+end
+
+module type Dot_generator = module type of Generator
diff --git a/ocamldoc/odoc_env.ml b/ocamldoc/odoc_env.ml
new file mode 100644
index 00000000..79928f26
--- /dev/null
+++ b/ocamldoc/odoc_env.ml
@@ -0,0 +1,249 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Environment for finding complete names from relative names. *)
+
+let print_DEBUG s = print_string s ; print_newline ();;
+
+module Name = Odoc_name
+
+(** relative name * complete name *)
+type env_element = Name.t * Name.t
+
+type env = {
+    env_values : env_element list ;
+    env_types : env_element list ;
+    env_class_types : env_element list ;
+    env_classes : env_element list ;
+    env_modules : env_element list ;
+    env_module_types : env_element list ;
+    env_extensions : env_element list ;
+  }
+
+let empty = {
+  env_values = [] ;
+  env_types = [] ;
+  env_class_types = [] ;
+  env_classes = [] ;
+  env_modules = [] ;
+  env_module_types = [] ;
+  env_extensions = [] ;
+  }
+
+(** Add a signature to an environment.  *)
+let rec add_signature env root ?rel signat =
+  let qualify id = Name.concat root (Name.from_ident id) in
+  let rel_name id =
+    let n = Name.from_ident id in
+    match rel with
+      None -> n
+    | Some r -> Name.concat r n
+  in
+  let f env item =
+    match item with
+      Types.Sig_value (ident, _, _) -> { env with env_values = (rel_name ident, qualify ident) :: env.env_values }
+    | Types.Sig_type (ident,_,_,_) -> { env with env_types = (rel_name ident, qualify ident) :: env.env_types }
+    | Types.Sig_typext (ident, _, _, _) -> { env with env_extensions = (rel_name ident, qualify ident) :: env.env_extensions }
+    | Types.Sig_module (ident, _, md, _, _) ->
+        let env2 =
+          match md.Types.md_type with (* FIXME: we don't have signature for identifiers *)
+            Types.Mty_signature s -> add_signature env (qualify ident) ~rel: (rel_name ident) s
+          |  _ -> env
+        in
+        { env2 with env_modules = (rel_name ident, qualify ident) :: env2.env_modules }
+    | Types.Sig_modtype (ident, modtype_decl, _) ->
+        let env2 =
+          match modtype_decl.Types.mtd_type with
+            None ->
+              env
+          | Some modtype ->
+              match modtype with
+                 (* FIXME: we don't have signature for identifiers *)
+                Types.Mty_signature s -> add_signature env (qualify ident) ~rel: (rel_name ident) s
+              |  _ -> env
+        in
+        { env2 with env_module_types = (rel_name ident, qualify ident) :: env2.env_module_types }
+    | Types.Sig_class (ident, _, _, _) -> { env with env_classes = (rel_name ident, qualify ident) :: env.env_classes }
+    | Types.Sig_class_type (ident, _, _, _) -> { env with env_class_types = (rel_name ident, qualify ident) :: env.env_class_types }
+  in
+  List.fold_left f env signat
+
+let add_extension env full_name =
+  let simple_name = Name.simple full_name in
+  { env with env_extensions = (simple_name, full_name) :: env.env_extensions }
+
+let add_type env full_name =
+  let simple_name = Name.simple full_name in
+  { env with env_types = (simple_name, full_name) :: env.env_types }
+
+let add_value env full_name =
+  let simple_name = Name.simple full_name in
+  { env with env_values = (simple_name, full_name) :: env.env_values }
+
+let add_module env full_name =
+  let simple_name = Name.simple full_name in
+  { env with env_modules = (simple_name, full_name) :: env.env_modules }
+
+let add_module_type env full_name =
+  let simple_name = Name.simple full_name in
+  { env with env_module_types = (simple_name, full_name) :: env.env_module_types }
+
+let add_class env full_name =
+  let simple_name = Name.simple full_name in
+  { env with
+    env_classes = (simple_name, full_name) :: env.env_classes ;
+    (* we also add a type 'cause the class name may appear as a type *)
+    env_types = (simple_name, full_name) :: env.env_types
+  }
+
+let add_class_type env full_name =
+  let simple_name = Name.simple full_name in
+  { env with
+    env_class_types = (simple_name, full_name) :: env.env_class_types ;
+    (* we also add a type 'cause the class type name may appear as a type *)
+    env_types = (simple_name, full_name) :: env.env_types
+  }
+
+let full_module_name env n =
+  try List.assoc n env.env_modules
+  with Not_found ->
+    print_DEBUG ("Module "^n^" not found with env=");
+    List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_modules;
+    n
+
+let full_module_type_name env n =
+  try List.assoc n env.env_module_types
+  with Not_found ->
+    print_DEBUG ("Module "^n^" not found with env=");
+    List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_modules;
+    n
+
+let full_module_or_module_type_name env n =
+  try List.assoc n env.env_modules
+  with Not_found -> full_module_type_name env n
+
+let full_type_name env n =
+  try
+    let full = List.assoc n env.env_types in
+(*    print_string ("type "^n^" is "^full);
+    print_newline ();*)
+    full
+  with Not_found ->
+(*    print_string ("type "^n^" not found");
+    print_newline ();*)
+    n
+
+let full_value_name env n =
+  try List.assoc n env.env_values
+  with Not_found -> n
+
+let full_extension_constructor_name env n =
+  try List.assoc n env.env_extensions
+  with Not_found ->
+    print_DEBUG ("Extension "^n^" not found with env=");
+    List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_extensions;
+    n
+
+let full_class_name env n =
+  try List.assoc n env.env_classes
+  with Not_found ->
+    print_DEBUG ("Class "^n^" not found with env=");
+    List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_classes;
+    n
+
+let full_class_type_name env n =
+  try List.assoc n env.env_class_types
+  with Not_found ->
+    print_DEBUG ("Class type "^n^" not found with env=");
+    List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_class_types;
+    n
+
+let full_class_or_class_type_name env n =
+  try List.assoc n env.env_classes
+  with Not_found -> full_class_type_name env n
+
+let subst_type env t =
+(*
+  print_string "Odoc_env.subst_type\n";
+  print_env_types env ;
+  print_newline ();
+*)
+  Printtyp.mark_loops t;
+  let deja_vu = ref [] in
+  let rec iter t =
+    if List.memq t !deja_vu then () else begin
+      deja_vu := t :: !deja_vu;
+      Btype.iter_type_expr iter t;
+      match t.Types.desc with
+      | Types.Tconstr (p, [_], _) when Path.same p Predef.path_option ->
+          ()
+      | Types.Tconstr (p, l, a) ->
+          let new_p =
+            Odoc_name.to_path (full_type_name env (Odoc_name.from_path p)) in
+          t.Types.desc <- Types.Tconstr (new_p, l, a)
+      | Types.Tpackage (p, n, l) ->
+          let new_p =
+            Odoc_name.to_path (full_module_type_name env (Odoc_name.from_path p)) in
+          t.Types.desc <- Types.Tpackage (new_p, n, l)
+      | Types.Tobject (_, ({contents=Some(p,tyl)} as r)) ->
+          let new_p =
+            Odoc_name.to_path (full_type_name env (Odoc_name.from_path p)) in
+          r := Some (new_p, tyl)
+      | Types.Tvariant ({Types.row_name=Some(p, tyl)} as row) ->
+          let new_p =
+            Odoc_name.to_path (full_type_name env (Odoc_name.from_path p)) in
+          t.Types.desc <-
+            Types.Tvariant {row with Types.row_name=Some(new_p, tyl)}
+      | _ ->
+          ()
+    end
+  in
+  iter t;
+  t
+
+
+let subst_module_type env t =
+  let rec iter t =
+    let open Types in
+    match t with
+      Mty_ident p ->
+        let new_p = Odoc_name.to_path (full_module_type_name env (Odoc_name.from_path p)) in
+        Mty_ident new_p
+    | Mty_alias _
+    | Mty_signature _ ->
+        t
+    | Mty_functor (Unit, mt) -> Mty_functor (Unit, iter mt)
+    | Mty_functor (Named (name, mt1), mt2) ->
+      Mty_functor (Named (name, iter mt1), iter mt2)
+  in
+  iter t
+
+let subst_class_type env t =
+  let rec iter t =
+    match t with
+      Types.Cty_constr (p,texp_list,ct) ->
+        let new_p = Odoc_name.to_path (full_type_name env (Odoc_name.from_path p)) in
+        let new_texp_list = List.map (subst_type env) texp_list in
+        let new_ct = iter ct in
+        Types.Cty_constr (new_p, new_texp_list, new_ct)
+    | Types.Cty_signature _ ->
+        (* we don't handle vals and methods *)
+        t
+    | Types.Cty_arrow (l, texp, ct) ->
+        let new_texp = subst_type env texp in
+        let new_ct = iter ct in
+        Types.Cty_arrow (l, new_texp, new_ct)
+  in
+  iter t
diff --git a/ocamldoc/odoc_env.mli b/ocamldoc/odoc_env.mli
new file mode 100644
index 00000000..16f5fb53
--- /dev/null
+++ b/ocamldoc/odoc_env.mli
@@ -0,0 +1,78 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Environment for finding complete names from relative names. *)
+
+(** An environment of known names,
+   from simple name to complete name. *)
+type env
+
+(** The empty environment. *)
+val empty : env
+
+(** Extending an environment *)
+
+val add_signature : env -> string -> ?rel:string -> Types.signature -> env
+val add_extension : env -> Odoc_name.t -> env
+val add_type : env -> Odoc_name.t -> env
+val add_value : env -> Odoc_name.t -> env
+val add_module : env -> Odoc_name.t -> env
+val add_module_type : env -> Odoc_name.t -> env
+val add_class : env -> Odoc_name.t -> env
+val add_class_type : env -> Odoc_name.t -> env
+
+(** Retrieving fully qualified names from an environment *)
+
+(** Get the fully qualified module name from a name.*)
+val full_module_name : env -> Odoc_name.t -> Odoc_name.t
+
+(** Get the fully qualified module type name from a name.*)
+val full_module_type_name : env -> Odoc_name.t -> Odoc_name.t
+
+(** Get the fully qualified module or module type name from a name.
+   We look for a module type if we don't find a module.*)
+val full_module_or_module_type_name : env -> Odoc_name.t -> Odoc_name.t
+
+(** Get the fully qualified type name from a name.*)
+val full_type_name : env -> Odoc_name.t -> Odoc_name.t
+
+(** Get the fully qualified value name from a name.*)
+val full_value_name : env -> Odoc_name.t -> Odoc_name.t
+
+(** Get the fully qualified extension name from a name.*)
+val full_extension_constructor_name : env -> Odoc_name.t -> Odoc_name.t
+
+(** Get the fully qualified class name from a name.*)
+val full_class_name : env -> Odoc_name.t -> Odoc_name.t
+
+(** Get the fully qualified class type name from a name.*)
+val full_class_type_name : env -> Odoc_name.t -> Odoc_name.t
+
+(** Get the fully qualified class or class type name from a name.*)
+val full_class_or_class_type_name : env -> Odoc_name.t -> Odoc_name.t
+
+(** Substitutions *)
+
+(** Replace the [Path.t] by a complete [Path.t] in a [Types.type_expr].*)
+val subst_type : env -> Types.type_expr -> Types.type_expr
+
+(** Replace the [Path.t] by a complete [Path.t] in a [Types.module_type].*)
+val subst_module_type : env -> Types.module_type -> Types.module_type
+
+(** Replace the [Path.t] by a complete [Path.t] in a [Types.class_type].
+   Also empty the structures to get only [object end] when the type
+   is printed.
+*)
+val subst_class_type : env -> Types.class_type -> Types.class_type
diff --git a/ocamldoc/odoc_exception.ml b/ocamldoc/odoc_exception.ml
new file mode 100644
index 00000000..9cfeb279
--- /dev/null
+++ b/ocamldoc/odoc_exception.ml
@@ -0,0 +1,33 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Representation and manipulation of exceptions. *)
+
+module Name = Odoc_name
+
+type exception_alias = {
+    ea_name : Name.t ;
+    mutable ea_ex : t_exception option ;
+  }
+
+and t_exception = {
+    ex_name : Name.t ;
+    mutable ex_info : Odoc_types.info option ; (** optional user information *)
+    ex_args : Odoc_type.constructor_args ; (** the types of the parameters *)
+    ex_ret: Types.type_expr option ; (** the optional return type *)
+    ex_alias : exception_alias option ;
+    mutable ex_loc : Odoc_types.location ;
+    mutable ex_code : string option ;
+  }
diff --git a/ocamldoc/odoc_extension.ml b/ocamldoc/odoc_extension.ml
new file mode 100644
index 00000000..73ebfdda
--- /dev/null
+++ b/ocamldoc/odoc_extension.ml
@@ -0,0 +1,48 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Representation and manipulation of type extensions. *)
+
+module Name = Odoc_name
+
+type private_flag = Asttypes.private_flag =
+    Private | Public
+
+type extension_alias = {
+    xa_name : Name.t ;
+    mutable xa_xt : t_extension_constructor option ;
+  }
+
+and t_extension_constructor = {
+    xt_name : Name.t ;
+    xt_args: Odoc_type.constructor_args;
+    xt_ret: Types.type_expr option ; (** the optional return type of the extension *)
+    xt_type_extension: t_type_extension ; (** the type extension containing this constructor *)
+    xt_alias: extension_alias option ;
+    mutable xt_loc: Odoc_types.location ;
+    mutable xt_text: Odoc_types.info option ; (** optional user description *)
+  }
+
+and t_type_extension = {
+    mutable te_info : Odoc_types.info option ; (** optional user information *)
+    te_type_name : Name.t;
+    te_type_parameters : Types.type_expr list;
+    te_private : private_flag;
+    mutable te_constructors: t_extension_constructor list;
+    mutable te_loc : Odoc_types.location ;
+    mutable te_code : string option ;
+  }
+
+let extension_constructors te = te.te_constructors
diff --git a/ocamldoc/odoc_gen.ml b/ocamldoc/odoc_gen.ml
new file mode 100644
index 00000000..152c2414
--- /dev/null
+++ b/ocamldoc/odoc_gen.ml
@@ -0,0 +1,64 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2010 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** *)
+
+class type doc_generator =
+  object method generate : Odoc_module.t_module list -> unit end;;
+
+module type Base = sig
+    class generator : doc_generator
+  end;;
+
+module Base_generator : Base = struct
+  class generator : doc_generator = object method generate _ = () end
+  end;;
+
+module type Base_functor = Base -> Base
+module type Html_functor = Odoc_html.Html_generator -> Odoc_html.Html_generator
+module type Latex_functor = Odoc_latex.Latex_generator -> Odoc_latex.Latex_generator
+module type Texi_functor = Odoc_texi.Texi_generator -> Odoc_texi.Texi_generator
+module type Man_functor = Odoc_man.Man_generator -> Odoc_man.Man_generator
+module type Dot_functor = Odoc_dot.Dot_generator -> Odoc_dot.Dot_generator
+
+type generator =
+  | Html of (module Odoc_html.Html_generator)
+  | Latex of (module Odoc_latex.Latex_generator)
+  | Texi of (module Odoc_texi.Texi_generator)
+  | Man of (module Odoc_man.Man_generator)
+  | Dot of (module Odoc_dot.Dot_generator)
+  | Base of (module Base)
+;;
+
+let get_minimal_generator = function
+  Html m ->
+    let module M = (val m : Odoc_html.Html_generator) in
+    (new M.html :> doc_generator)
+| Latex m ->
+    let module M = (val m : Odoc_latex.Latex_generator) in
+    (new M.latex :> doc_generator)
+| Man m ->
+    let module M = (val m : Odoc_man.Man_generator) in
+    (new M.man :> doc_generator)
+| Texi m ->
+    let module M = (val m : Odoc_texi.Texi_generator) in
+    (new M.texi :> doc_generator)
+| Dot m ->
+    let module M = (val m : Odoc_dot.Dot_generator) in
+    (new M.dot :> doc_generator)
+| Base m ->
+    let module M = (val m : Base) in
+    new M.generator
+    ;;
diff --git a/ocamldoc/odoc_gen.mli b/ocamldoc/odoc_gen.mli
new file mode 100644
index 00000000..0bc723cc
--- /dev/null
+++ b/ocamldoc/odoc_gen.mli
@@ -0,0 +1,46 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2010 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The types of generators. *)
+
+(** The minimal class type of documentation generators. *)
+class type doc_generator =
+  object method generate : Odoc_module.t_module list -> unit end;;
+
+(** The module type of minimal generators. *)
+module type Base = sig
+    class generator : doc_generator
+  end;;
+
+module Base_generator : Base
+
+module type Base_functor = Base -> Base
+module type Html_functor = Odoc_html.Html_generator -> Odoc_html.Html_generator
+module type Latex_functor = Odoc_latex.Latex_generator -> Odoc_latex.Latex_generator
+module type Texi_functor = Odoc_texi.Texi_generator -> Odoc_texi.Texi_generator
+module type Man_functor = Odoc_man.Man_generator -> Odoc_man.Man_generator
+module type Dot_functor = Odoc_dot.Dot_generator -> Odoc_dot.Dot_generator
+
+(** Various ways to create a generator. *)
+type generator =
+  | Html of (module Odoc_html.Html_generator)
+  | Latex of (module Odoc_latex.Latex_generator)
+  | Texi of (module Odoc_texi.Texi_generator)
+  | Man of (module Odoc_man.Man_generator)
+  | Dot of (module Odoc_dot.Dot_generator)
+  | Base of (module Base)
+;;
+
+val get_minimal_generator : generator -> doc_generator
diff --git a/ocamldoc/odoc_global.ml b/ocamldoc/odoc_global.ml
new file mode 100644
index 00000000..3bb1a67c
--- /dev/null
+++ b/ocamldoc/odoc_global.ml
@@ -0,0 +1,83 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Global variables. *)
+
+(* Tell ocaml compiler not to generate files. *)
+let _ = Clflags.dont_write_files := true
+
+type source_file =
+    Impl_file of string
+  | Intf_file of string
+  | Text_file of string
+
+let include_dirs = Clflags.include_dirs
+
+let errors = ref 0
+
+let warn_error = ref false
+let show_missed_crossref = ref false
+
+let pwarning s =
+  if !Odoc_config.print_warnings then prerr_endline (Odoc_messages.warning^": "^s);
+  if !warn_error then incr errors
+
+let merge_options = ref ([] : Odoc_types.merge_option list)
+
+let classic = Clflags.classic
+
+let dump = ref (None : string option)
+
+let load = ref ([] : string list)
+
+let sort_modules = ref false
+
+let no_custom_tags = ref false
+
+let no_stop = ref false
+
+let remove_stars = ref false
+
+let keep_code = ref false
+
+let inverse_merge_ml_mli = ref false
+
+let filter_with_module_constraints = ref true
+
+let hidden_modules = ref ([] : string list)
+
+let files = ref []
+
+let out_file = ref Odoc_messages.default_out_file
+
+let verbose = Clflags.verbose
+
+let target_dir = ref Filename.current_dir_name
+
+let title = ref (None : string option)
+
+let intro_file = ref (None : string option)
+
+let with_header = ref true
+
+let with_trailer = ref true
+
+let with_toc = ref true
+
+let with_index = ref true
+
+let initially_opened_module = ref "Stdlib"
+
+let library_namespace = ref ""
diff --git a/ocamldoc/odoc_global.mli b/ocamldoc/odoc_global.mli
new file mode 100644
index 00000000..c85b4534
--- /dev/null
+++ b/ocamldoc/odoc_global.mli
@@ -0,0 +1,110 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Global variables. *)
+
+(** The kind of source file in arguments. *)
+type source_file =
+    Impl_file of string
+  | Intf_file of string
+  | Text_file of string
+
+(** The include_dirs in the OCaml compiler. *)
+val include_dirs : string list ref
+
+(** The merge options to be used. *)
+val merge_options : Odoc_types.merge_option list ref
+
+(** Classic mode or not. *)
+val classic : bool ref
+
+(** The optional file name to dump the collected information into.*)
+val dump : string option ref
+
+(** The list of information files to load. *)
+val load : string list ref
+
+(** We must sort the list of top modules or not.*)
+val sort_modules : bool ref
+
+(** We must not stop at the stop special comments. Default is false (we stop).*)
+val no_stop : bool ref
+
+(** We must raise an exception when we find an unknown @-tag. *)
+val no_custom_tags : bool ref
+
+(** We must remove the first characters of each comment line, until the first asterisk '*'. *)
+val remove_stars : bool ref
+
+(** To keep the code while merging, when we have both .ml and .mli files for a module. *)
+val keep_code : bool ref
+
+(** To inverse implementation and interface files when merging. *)
+val inverse_merge_ml_mli : bool ref
+
+(** To filter module elements according to module type constraints. *)
+val filter_with_module_constraints : bool ref
+
+(** The list of module names to hide. *)
+val hidden_modules : string list ref
+
+(** The files to be analysed. *)
+val files : source_file list ref
+
+(** A counter for errors. *)
+val errors : int ref
+
+(** Indicate if a warning is an error. *)
+val warn_error : bool ref
+
+(** Show code fragments that could be transformed into a cross-reference. *)
+val show_missed_crossref: bool ref
+
+(** Print the given warning, adding it to the list of {!errors}
+if {!warn_error} is [true]. *)
+val pwarning : string -> unit
+
+(** The file used by the generators outputting only one file. *)
+val out_file : string ref
+
+(** Verbose mode or not. *)
+val verbose : bool ref
+
+(** The optional file whose content can be used as intro text. *)
+val intro_file : string option ref
+
+(** The optional title to use in the generated documentation. *)
+val title : string option ref
+
+(** The directory where files have to be generated. *)
+val target_dir : string ref
+
+(** The flag which indicates if we must generate a table of contents. *)
+val with_toc : bool ref
+
+(** The flag which indicates if we must generate an index. *)
+val with_index : bool ref
+
+(** The flag which indicates if we must generate a header.*)
+val with_header : bool ref
+
+(** The flag which indicates if we must generate a trailer.*)
+val with_trailer : bool ref
+
+(** Name of the module that is initially opened. *)
+val initially_opened_module : string ref
+
+(** Name of the library namespace for a prefixed library *)
+val library_namespace: string ref
diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml
new file mode 100644
index 00000000..a035f785
--- /dev/null
+++ b/ocamldoc/odoc_html.ml
@@ -0,0 +1,2947 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Generation of html documentation.*)
+
+let print_DEBUG s = print_string s ; print_newline ()
+
+open Odoc_info
+open Value
+open Type
+open Extension
+open Exception
+open Class
+open Module
+module String = Misc.Stdlib.String
+
+let with_parameter_list = ref false
+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"
+
+
+(** The functions used for naming files and html marks.*)
+module Naming =
+  struct
+    (** The prefix for modules marks. *)
+    let mark_module = "MODULE"
+
+    (** The prefix for module type marks. *)
+    let mark_module_type = "MODULETYPE"
+
+    (** The prefix for types marks. *)
+    let mark_type = "TYPE"
+
+    (** The prefix for types elements (record fields or constructors). *)
+    let mark_type_elt = "TYPEELT"
+
+    (** The prefix for functions marks. *)
+    let mark_function = "FUN"
+
+    (** The prefix for extensions marks. *)
+    let mark_extension = "EXTENSION"
+
+    (** The prefix for exceptions marks. *)
+    let mark_exception = "EXCEPTION"
+
+    (** The prefix for values marks. *)
+    let mark_value = "VAL"
+
+    (** The prefix for attributes marks. *)
+    let mark_attribute = "ATT"
+
+    (** The prefix for methods marks. *)
+    let mark_method = "METHOD"
+
+    (** The prefix for code files. *)
+    let code_prefix = "code_"
+
+    (** The prefix for type files. *)
+    let type_prefix = "type_"
+
+    (** Return the two html files names for the given module or class name.*)
+    let html_files name =
+      let qual =
+        try
+          let i = String.rindex name '.' in
+          match name.[i + 1] with
+          | 'A'..'Z' -> ""
+          | _ -> "-c"
+        with Not_found -> ""
+      in
+      let prefix = name^qual in
+      let html_file = prefix^".html" in
+      let html_frame_file = prefix^"-frame.html" in
+      (html_file, html_frame_file)
+
+    (** Return the target for the given prefix and simple name. *)
+    let target pref simple_name = pref^simple_name
+
+    (** Return the complete link target (file#target) for the given prefix string and complete name.*)
+    let complete_target pref complete_name =
+      let simple_name = Name.simple complete_name in
+      let module_name =
+        let s = Name.father complete_name in
+        if s = "" then simple_name else s
+      in
+      let (html_file, _) = html_files module_name in
+      html_file^"#"^(target pref simple_name)
+
+    (**return the link target for the given module. *)
+    let module_target m = target mark_module (Name.simple m.m_name)
+
+    (**return the link target for the given module type. *)
+    let module_type_target mt = target mark_module_type (Name.simple mt.mt_name)
+
+    (** Return the link target for the given type. *)
+    let type_target t = target mark_type (Name.simple t.ty_name)
+
+    (** Return the link target for the given variant constructor. *)
+    let const_target t f =
+      let name = Printf.sprintf "%s.%s" (Name.simple t.ty_name) f.vc_name in
+      target mark_type_elt name
+
+    (** Return the link target for the given record field. *)
+    let recfield_target t f = target mark_type_elt
+      (Printf.sprintf "%s.%s" (Name.simple t.ty_name) f.rf_name)
+
+    (** Return the link target for the given inline record field. *)
+    let inline_recfield_target t c f = target mark_type_elt
+      (Printf.sprintf "%s.%s.%s" t c f.rf_name)
+
+    (** Return the link target for the given object field. *)
+    let objfield_target t f = target mark_type_elt
+      (Printf.sprintf "%s.%s" (Name.simple t.ty_name) f.of_name)
+
+    (** Return the complete link target for the given type. *)
+    let complete_type_target t = complete_target mark_type t.ty_name
+
+    let complete_recfield_target name =
+      let typ = Name.father name in
+      let field = Name.simple name in
+      Printf.sprintf "%s.%s" (complete_target mark_type_elt typ) field
+
+    let complete_const_target = complete_recfield_target
+
+    (** Return the link target for the given extension. *)
+    let extension_target x = target mark_extension (Name.simple x.xt_name)
+
+    (** Return the complete link target for the given extension. *)
+    let complete_extension_target x = complete_target mark_extension x.xt_name
+
+    (** Return the link target for the given exception. *)
+    let exception_target e = target mark_exception (Name.simple e.ex_name)
+
+    (** Return the complete link target for the given exception. *)
+    let complete_exception_target e = complete_target mark_exception e.ex_name
+
+    (** Return the link target for the given value. *)
+    let value_target v = target mark_value (Name.simple v.val_name)
+
+    (** Return the given value name where symbols accepted in infix values
+       are replaced by strings, to avoid clashes with the filesystem.*)
+    let subst_infix_symbols name =
+      let len = String.length name in
+      let buf = Buffer.create len in
+      let ch c = Buffer.add_char buf c in
+      let st s = Buffer.add_string buf s in
+      for i = 0 to len - 1 do
+        match name.[i] with
+        | '|' -> st "_pipe_"
+        | '<' -> st "_lt_"
+        | '>' -> st "_gt_"
+        | '@' -> st "_at_"
+        | '^' -> st "_exp_"
+        | '&' -> st "_amp_"
+        | '+' -> st "_plus_"
+        | '-' -> st "_minus_"
+        | '*' -> st "_star_"
+        | '/' -> st "_slash_"
+        | '$' -> st "_dollar_"
+        | '%' -> st "_percent_"
+        | '=' -> st "_equal_"
+        | ':' -> st "_column_"
+        | '~' -> st "_tilde_"
+        | '!' -> st "_bang_"
+        | '?' -> st "_questionmark_"
+        | c -> ch c
+      done;
+      Buffer.contents buf
+
+    (** Return the complete link target for the given value. *)
+    let complete_value_target v = complete_target mark_value v.val_name
+
+    (** Return the complete filename for the code of the given value. *)
+    let file_code_value_complete_target v =
+      code_prefix^mark_value^(subst_infix_symbols v.val_name)^".html"
+
+    (** Return the link target for the given attribute. *)
+    let attribute_target a = target mark_attribute (Name.simple a.att_value.val_name)
+
+    (** Return the complete link target for the given attribute. *)
+    let complete_attribute_target a = complete_target mark_attribute a.att_value.val_name
+
+    (** Return the complete filename for the code of the given attribute. *)
+    let file_code_attribute_complete_target a =
+      code_prefix^mark_attribute^a.att_value.val_name^".html"
+
+    (** Return the link target for the given method. *)
+    let method_target m = target mark_method (Name.simple m.met_value.val_name)
+
+    (** Return the complete link target for the given method. *)
+    let complete_method_target m = complete_target mark_method m.met_value.val_name
+
+    (** Return the complete filename for the code of the given method. *)
+    let file_code_method_complete_target m =
+      code_prefix^mark_method^m.met_value.val_name^".html"
+
+    (** Return the link target for the given label section. *)
+    let label_target l = target "" l
+
+    (** Return the complete link target for the given section label. *)
+    let complete_label_target l = complete_target "" l
+
+    (** Return the complete filename for the code of the type of the
+       given module or module type name. *)
+    let file_type_module_complete_target name =
+      type_prefix^name^".html"
+
+    (** Return the complete filename for the code of the
+       given module name. *)
+    let file_code_module_complete_target name =
+      code_prefix^name^".html"
+
+    (** Return the complete filename for the code of the type of the
+       given class or class type name. *)
+    let file_type_class_complete_target name =
+      type_prefix^name^".html"
+  end
+
+(** A class with a method to colorize a string which represents OCaml code. *)
+class ocaml_code =
+  object
+    method html_of_code b ?(with_pre=true) code =
+      Odoc_ocamlhtml.html_of_code b ~with_pre: with_pre code
+  end
+
+let new_buf () = Buffer.create 1024
+let bp = Printf.bprintf
+let bs = Buffer.add_string
+
+
+(** Generation of html code from text structures. *)
+class virtual text =
+  object (self)
+    (** We want to display colorized code. *)
+    inherit ocaml_code
+
+    (** Escape the strings which would clash with html syntax, and
+       make some replacements (double newlines replaced by 
    ). *)
+    method escape s = Odoc_ocamlhtml.escape_base s
+
+    method keep_alpha_num s =
+      let len = String.length s in
+      let buf = Buffer.create len in
+      for i = 0 to len - 1 do
+        match s.[i] with
+          'a'..'z' | 'A'..'Z' | '0'..'9' -> Buffer.add_char buf s.[i]
+        | _ -> ()
+      done;
+      Buffer.contents buf
+
+    (** Return a label created from the first sentence of a text. *)
+    method label_of_text t=
+      let t2 = Odoc_info.first_sentence_of_text t in
+      let s = Odoc_info.string_of_text t2 in
+      self#keep_alpha_num s
+
+    (** Create a label for the associated title.
+       Return the label specified by the user or a label created
+       from the title level and the first sentence of the title. *)
+    method create_title_label (n,label_opt,t) =
+      match label_opt with
+        Some s -> s
+      | None -> Printf.sprintf "%d_%s" n (self#label_of_text t)
+
+    (** Print the html code corresponding to the [text] parameter. *)
+    method html_of_text ?(with_p=false) b t =
+      if not with_p then
+        List.iter (self#html_of_text_element b) t
+      else
+        self#html_of_text_with_p b t
+
+    method html_of_text_with_p b t =
+      (* In order to enclose the generated text in 
     
    , we first
+         output the content inside a inner buffer b', and then generate
+         the whole paragraph, if the content is not empty,
+         either at the end of the text, at a Newline element or when
+         encountering an element that cannot be part of a paragraph element
+      *)
+      let b' = Buffer.create 17 (* paragraph buffer *) in
+      let flush b' =
+        (* trim the inner string to avoid outputting empty 
     *)
+        let s = String.trim @@ Buffer.contents b' in
+        if s <> "" then
+          begin
+            bp b "
    ";
+            bs b s;
+            bp b "
    \n"
+          end;
+        Buffer.clear b' in
+      let rec iter txt =
+        match txt with
+        | [] ->
+            flush b' (* flush b' at the end of the text *)
+        | (List _ | Enum _ | Title _ | CodePre _ | Verbatim _ | Center _
+          | Left _ | Right _ | Newline | Index_list ) as a :: q
+          (* these elements cannot be part of 
     element *)
+          ->
+            flush b'; (* stop the current paragraph *)
+            self#html_of_text_element b a; (*output [a] directly on [b] *)
+            iter q
+        | a :: q  -> self#html_of_text_element b' a; iter q
+      in
+      iter t
+
+    (** Print the html code for the [text_element] in parameter. *)
+    method html_of_text_element b txt =
+      print_DEBUG "text::html_of_text_element";
+      match txt with
+      | Odoc_info.Raw s -> self#html_of_Raw b s
+      | Odoc_info.Code s -> self#html_of_Code b s
+      | Odoc_info.CodePre s -> self#html_of_CodePre b s
+      | Odoc_info.Verbatim s -> self#html_of_Verbatim b s
+      | Odoc_info.Bold t -> self#html_of_Bold b t
+      | Odoc_info.Italic t -> self#html_of_Italic b t
+      | Odoc_info.Emphasize t -> self#html_of_Emphasize b t
+      | Odoc_info.Center t -> self#html_of_Center b t
+      | Odoc_info.Left t -> self#html_of_Left b t
+      | Odoc_info.Right t -> self#html_of_Right b t
+      | Odoc_info.List tl -> self#html_of_List b tl
+      | Odoc_info.Enum tl -> self#html_of_Enum b tl
+      | Odoc_info.Newline -> self#html_of_Newline b
+      | Odoc_info.Block t -> self#html_of_Block b t
+      | Odoc_info.Title (n, l_opt, t) -> self#html_of_Title b n l_opt t
+      | Odoc_info.Latex s -> self#html_of_Latex b s
+      | Odoc_info.Link (s, t) -> self#html_of_Link b s t
+      | Odoc_info.Ref (name, ref_opt, text_opt) ->
+          self#html_of_Ref b name ref_opt text_opt
+      | Odoc_info.Superscript t -> self#html_of_Superscript b t
+      | Odoc_info.Subscript t -> self#html_of_Subscript b t
+      | Odoc_info.Module_list l -> self#html_of_Module_list b l
+      | Odoc_info.Index_list -> self#html_of_Index_list b
+      | Odoc_info.Custom (s,t) -> self#html_of_custom_text b s t
+      | Odoc_info.Target (target, code) -> self#html_of_Target b ~target ~code
+
+    method html_of_custom_text _ _ _ = ()
+
+    method html_of_Target b ~target ~code =
+      if String.lowercase_ascii target = "html" then bs b code else ()
+
+    method html_of_Raw b s = bs b (self#escape s)
+
+    method html_of_Code b s =
+      if !colorize_code then
+        self#html_of_code b ~with_pre: false s
+      else
+        (
+         bs b "";
+         bs b (self#escape s);
+         bs b ""
+        )
+
+    method html_of_CodePre =
+        let remove_useless_newlines s =
+          let len = String.length s in
+          let rec iter_first n =
+            if n >= len then
+              None
+            else
+              match s.[n] with
+              | '\n' -> iter_first (n+1)
+              | _ -> Some n
+          in
+          match iter_first 0 with
+            None -> ""
+          | Some first ->
+              let rec iter_last n =
+                if n <= first then
+                  None
+                else
+                  match s.[n] with
+                    '\t'  -> iter_last (n-1)
+                  | _ -> Some n
+              in
+              match iter_last (len-1) with
+                None -> String.sub s first 1
+              | Some last -> String.sub s first ((last-first)+1)
+        in
+        fun b s ->
+      if !colorize_code then
+          (
+           bs b "
    ";
+           self#html_of_code b (remove_useless_newlines s);
+           bs b "
    "
+          )
+      else
+        (
+         bs b "
    " ;
+         bs b (self#escape (remove_useless_newlines s));
+         bs b "
    "
+        )
+
+    method html_of_Verbatim b s =
+      bs b "
    ";
+      bs b (self#escape s);
+      bs b "
    "
+
+    method html_of_Bold b t =
+      bs b "";
+      self#html_of_text b t;
+      bs b ""
+
+    method html_of_Italic b t =
+      bs b "" ;
+      self#html_of_text b t;
+      bs b ""
+
+    method html_of_Emphasize b t =
+      bs b "" ;
+      self#html_of_text b t ;
+      bs b ""
+
+    method html_of_Center b t =
+      bs b "
    ";
+      self#html_of_text b t;
+      bs b "
    "
+
+    method html_of_Left b t =
+      bs b "
    ";
+      self#html_of_text b t;
+      bs b "
    "
+
+    method html_of_Right b t =
+      bs b "
    ";
+      self#html_of_text b t;
+      bs b "
    "
+
+    method html_of_List b tl =
+      bs b "
      \n";
+      List.iter
+        (fun t -> bs b "
    • "; self#html_of_text b t; bs b "
      • \n")
+        tl;
+      bs b "
    \n"
+
+    method html_of_Enum b tl =
+      bs b "
      \n";
+      List.iter
+        (fun t -> bs b "
    1. "; self#html_of_text b t; bs b"
      2. \n")
+        tl;
+      bs b "
    \n"
+
+    method html_of_Newline b = bs b "\n"
+
+    method html_of_Block b t =
+      bs b "
    \n";
+      self#html_of_text b t;
+      bs b "
    \n"
+
+    method html_of_Title b n label_opt t =
+      let label1 = self#create_title_label (n, label_opt, t) in
+      let (tag_o, tag_c) =
+        if n > 6 then
+          (Printf.sprintf "div class=\"h%d\"" (n+1), "div")
+        else
+          let t = Printf.sprintf "h%d" (n+1) in (t, t)
+      in
+      bs b "<";
+      bp b "%s id=\"%s\"" tag_o (Naming.label_target label1);
+      bs b ">";
+      self#html_of_text b t;
+      bs b ""
+
+    method html_of_Latex _ _ = ()
+      (* don't care about LaTeX stuff in HTML. *)
+
+    method html_of_Link b s t =
+      bs b "";
+      self#html_of_text b t;
+      bs b ""
+
+    method html_of_Ref b name ref_opt text_opt =
+      match ref_opt with
+        None ->
+          let text =
+            match text_opt with
+              None -> [Odoc_info.Code name]
+            | Some t -> t
+          in
+          self#html_of_text b text
+      | Some kind ->
+          let h name = Odoc_info.Code (Odoc_info.use_hidden_modules name) in
+          let (target, text) =
+            match kind with
+              Odoc_info.RK_module
+            | Odoc_info.RK_module_type
+            | Odoc_info.RK_class
+            | Odoc_info.RK_class_type ->
+                let (html_file, _) = Naming.html_files name in
+                (html_file, h name)
+            | Odoc_info.RK_value -> (Naming.complete_target Naming.mark_value name, h name)
+            | Odoc_info.RK_type -> (Naming.complete_target Naming.mark_type name, h name)
+            | Odoc_info.RK_extension -> (Naming.complete_target Naming.mark_extension name, h name)
+            | Odoc_info.RK_exception -> (Naming.complete_target Naming.mark_exception name, h name)
+            | Odoc_info.RK_attribute -> (Naming.complete_target Naming.mark_attribute name, h name)
+            | Odoc_info.RK_method -> (Naming.complete_target Naming.mark_method name, h name)
+            | Odoc_info.RK_section t -> (Naming.complete_label_target name,
+                                         Odoc_info.Italic [Raw (Odoc_info.string_of_text t)])
+            | Odoc_info.RK_recfield -> (Naming.complete_recfield_target name, h name)
+            | Odoc_info.RK_const -> (Naming.complete_const_target name, h name)
+          in
+          let text =
+            match text_opt with
+              None -> [text]
+            | Some text -> text
+          in
+          bs b ("");
+          self#html_of_text b text;
+          bs b ""
+
+    method html_of_Superscript b t =
+      bs b "";
+      self#html_of_text b t;
+      bs b ""
+
+    method html_of_Subscript b t =
+      bs b "";
+      self#html_of_text b t;
+      bs b ""
+
+    method virtual html_of_info_first_sentence : _
+
+    method html_of_Module_list b l =
+      bs b "\n\n";
+      List.iter
+        (fun name ->
+          bs b "" html m.m_name;
+             bs b "\n"
+        )
+        l;
+      bs b "
    ";
+          (
+           try
+             let m =
+               List.find (fun m -> m.m_name = name) self#list_modules
+             in
+             let (html, _) = Naming.html_files m.m_name in
+             bp b "%s";
+             self#html_of_info_first_sentence b m.m_info;
+           with
+             Not_found ->
+               Odoc_global.pwarning (Odoc_messages.cross_module_not_found name);
+               bp b "%s" name
+          );
+          bs b "
    \n"
+
+    method html_of_Index_list b =
+      let index_if_not_empty l url m =
+        match l with
+          [] -> ()
+        | _ -> bp b "
  • %s
    • \n" url m
+      in
+      bp b "
      \n";
+      index_if_not_empty self#list_types self#index_types Odoc_messages.index_of_types;
+      index_if_not_empty self#list_extensions self#index_extensions Odoc_messages.index_of_extensions;
+      index_if_not_empty self#list_exceptions self#index_exceptions Odoc_messages.index_of_exceptions;
+      index_if_not_empty self#list_values self#index_values Odoc_messages.index_of_values;
+      index_if_not_empty self#list_attributes self#index_attributes Odoc_messages.index_of_attributes;
+      index_if_not_empty self#list_methods self#index_methods Odoc_messages.index_of_methods;
+      index_if_not_empty self#list_classes self#index_classes Odoc_messages.index_of_classes;
+      index_if_not_empty self#list_class_types self#index_class_types Odoc_messages.index_of_class_types;
+      index_if_not_empty self#list_modules self#index_modules Odoc_messages.index_of_modules;
+      index_if_not_empty self#list_module_types self#index_module_types Odoc_messages.index_of_module_types;
+      bp b "
    \n"
+
+    method virtual list_types : Odoc_info.Type.t_type list
+    method virtual index_types : string
+    method virtual list_extensions : Odoc_info.Extension.t_extension_constructor list
+    method virtual index_extensions : string
+    method virtual list_exceptions : Odoc_info.Exception.t_exception list
+    method virtual index_exceptions : string
+    method virtual list_values : Odoc_info.Value.t_value list
+    method virtual index_values : string
+    method virtual list_attributes : Odoc_info.Value.t_attribute list
+    method virtual index_attributes : string
+    method virtual list_methods : Odoc_info.Value.t_method list
+    method virtual index_methods : string
+    method virtual list_classes : Odoc_info.Class.t_class list
+    method virtual index_classes : string
+    method virtual list_class_types : Odoc_info.Class.t_class_type list
+    method virtual index_class_types : string
+    method virtual list_modules : Odoc_info.Module.t_module list
+    method virtual index_modules : string
+    method virtual list_module_types : Odoc_info.Module.t_module_type list
+    method virtual index_module_types : string
+
+  end
+
+(** A class used to generate html code for info structures. *)
+class virtual info =
+  object (self)
+    (** The list of pairs [(tag, f)] where [f] is a function taking
+       the [text] associated to [tag] and returning html code.
+       Add a pair here to handle a tag.*)
+    val mutable tag_functions = ([] : (string * (Odoc_info.text -> string)) list)
+
+    (** The method used to get html code from a [text]. *)
+    method virtual html_of_text :
+      ?with_p:bool -> Buffer.t -> Odoc_info.text -> unit
+
+    (** Print html for an author list. *)
+    method html_of_author_list b l =
+      match l with
+        [] -> ()
+      | _ ->
+          bp b "
  • %s: " Odoc_messages.authors;
+          self#html_of_text b [Raw (String.concat ", " l)];
+          bs b "
    • \n"
+
+    (** Print html code for the given optional version information.*)
+    method html_of_version_opt b v_opt =
+      match v_opt with
+        None -> ()
+      | Some v ->
+           bp b "
  • %s: " Odoc_messages.version;
+           self#html_of_text b [Raw v];
+           bs b "
    • \n"
+
+    (** Print html code for the given optional since information.*)
+    method html_of_since_opt b s_opt =
+      match s_opt with
+        None -> ()
+      | Some s ->
+          bp b "
  • %s " Odoc_messages.since;
+          self#html_of_text b [Raw s];
+          bs b "
    • \n"
+
+    (** Print html code for the given "before" information.*)
+    method html_of_before b l =
+      let f (v, text) =
+        bp b "
  • %s " Odoc_messages.before;
+        self#html_of_text b [Raw v];
+        bs b "  ";
+        self#html_of_text b text;
+        bs b "
    • \n"
+      in
+      List.iter f l
+
+    (** Print html code for the given list of raised exceptions.*)
+    method html_of_raised_exceptions b l =
+      match l with
+        [] -> ()
+      | (s, t) :: [] ->
+          bp b "
  • %s %s "
+            Odoc_messages.raises
+            s;
+          self#html_of_text b t;
+          bs b "
    • \n"
+      | _ ->
+          bp b "
  • %s
      " Odoc_messages.raises;
+          List.iter
+            (fun (ex, desc) ->
+              bp b "
    • %s " ex ;
+              self#html_of_text b desc;
+              bs b "
      • \n"
+            )
+            l;
+          bs b "
    • \n"
+
+    (** Print html code for the given "see also" reference. *)
+    method html_of_see b (see_ref, t)  =
+      let t_ref =
+        match see_ref with
+          Odoc_info.See_url s -> [ Odoc_info.Link (s, t) ]
+        | Odoc_info.See_file s -> (Odoc_info.Code s) :: (Odoc_info.Raw " ") :: t
+        | Odoc_info.See_doc s -> (Odoc_info.Italic [Odoc_info.Raw s]) :: (Odoc_info.Raw " ") :: t
+      in
+      self#html_of_text b t_ref
+
+    (** Print html code for the given list of "see also" references.*)
+    method html_of_sees b l =
+      match l with
+        [] -> ()
+      | see :: [] ->
+          bp b "
  • %s " Odoc_messages.see_also;
+          self#html_of_see b see;
+          bs b "
    • \n"
+      | _ ->
+          bp b "
  • %s
      " Odoc_messages.see_also;
+          List.iter
+            (fun see ->
+              bs b "
    • " ;
+              self#html_of_see b see;
+              bs b "
      • \n"
+            )
+            l;
+          bs b "
    • \n"
+
+    (** Print html code for the given optional return information.*)
+    method html_of_return_opt b return_opt =
+      match return_opt with
+        None -> ()
+      | Some s ->
+          bp b "
  • %s " Odoc_messages.returns;
+          self#html_of_text b s;
+          bs b "
    • \n"
+
+    (** Print html code for the given list of custom tagged texts. *)
+    method html_of_custom b l =
+      List.iter
+        (fun (tag, text) ->
+          try
+            let f = List.assoc tag tag_functions in
+            Buffer.add_string b (f text)
+          with
+            Not_found ->
+              Odoc_info.warning (Odoc_messages.tag_not_handled tag)
+        )
+        l
+
+    (** Print html code for a description, except for the [i_params] field.
+       @param indent can be specified not to use the style of info comments;
+       default is [true].
+    *)
+    method html_of_info ?(cls="") ?(indent=true) b info_opt =
+      match info_opt with
+        None ->
+          ()
+      | Some info ->
+          let module M = Odoc_info in
+          if indent then bs b ("
    \n");
+          (
+           match info.M.i_deprecated with
+            None -> ()
+          | Some d ->
+               bs b "
    \n";
+               bs b "";
+               bs b Odoc_messages.deprecated ;
+               bs b "" ;
+               self#html_of_text b d;
+               bs b "
    \n"
+          );
+          (
+           match info.M.i_desc with
+             None -> ()
+           | Some d when d = [Odoc_info.Raw ""] -> ()
+           | Some d ->
+               bs b "
    \n";
+               self#html_of_text ~with_p:true b d;
+               bs b "
    \n"
+          );
+
+          let b' = Buffer.create 17 in
+          self#html_of_author_list b' info.M.i_authors;
+          self#html_of_version_opt b' info.M.i_version;
+          self#html_of_before b' info.M.i_before;
+          self#html_of_since_opt b' info.M.i_since;
+          self#html_of_raised_exceptions b' info.M.i_raised_exceptions;
+          self#html_of_return_opt b' info.M.i_return_value;
+          self#html_of_sees b' info.M.i_sees;
+          self#html_of_custom b' info.M.i_custom;
+          if Buffer.length b' > 0 then
+            begin
+              bs b "
      \n";
+              Buffer.add_buffer b b';
+              bs b "
    \n"
+            end;
+          if indent then bs b "
    \n"
+
+    (** Print html code for the first sentence of a description.
+       The titles and lists in this first sentence has been removed.*)
+    method html_of_info_first_sentence b info_opt =
+      match info_opt with
+        None -> ()
+      | Some info ->
+          let module M = Odoc_info in
+          let dep = info.M.i_deprecated <> None in
+          bs b "
    \n";
+          if dep then bs b "";
+          (
+           match info.M.i_desc with
+             None -> ()
+           | Some d when d = [Odoc_info.Raw ""] -> ()
+           | Some d ->
+               self#html_of_text ~with_p:true b
+                 (Odoc_info.text_no_title_no_list
+                    (Odoc_info.first_sentence_of_text d));
+               bs b "\n"
+          );
+          if dep then bs b "";
+          bs b "
    \n"
+
+  end
+
+
+
+let opt = Odoc_info.apply_opt
+
+let print_concat b sep f =
+  let rec iter = function
+      [] -> ()
+    | [c] -> f c
+    | c :: q ->
+        f c;
+        bs b sep;
+        iter q
+  in
+  iter
+
+let newline_to_indented_br s =
+  let len = String.length s in
+  let b = Buffer.create len in
+  for i = 0 to len - 1 do
+    match s.[i] with
+      '\n' -> Buffer.add_string b "
         "
+    | c -> Buffer.add_char b c
+  done;
+  Buffer.contents b
+
+module Generator =
+  struct
+(** This class is used to create objects which can generate a simple html documentation. *)
+class html =
+  object (self)
+    inherit text
+    inherit info
+
+    val mutable doctype =
+      "\n"
+    method character_encoding b =
+      bp b
+        "\n"
+        !charset
+
+    method meta b =
+      self#character_encoding b;
+      bs b "\n"
+
+    (** The default style options. *)
+    val mutable default_style_options =
+      [ ".keyword { font-weight : bold ; color : Red }" ;
+        ".keywordsign { color : #C04600 }" ;
+        ".comment { color : Green }" ;
+        ".constructor { color : Blue }" ;
+        ".type { color : #5C6585 }" ;
+        ".string { color : Maroon }" ;
+        ".warning { color : Red ; font-weight : bold }" ;
+        ".info { margin-left : 3em; margin-right: 3em }" ;
+        ".param_info { margin-top: 4px; margin-left : 3em; margin-right : 3em }" ;
+        ".code { color : #465F91 ; }" ;
+        ".typetable { border-style : hidden }" ;
+        ".paramstable { border-style : hidden ; padding: 5pt 5pt}" ;
+        "tr { background-color : White }" ;
+        "td.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;}" ;
+        "div.sig_block {margin-left: 2em}" ;
+        "*:target { background: yellow; }" ;
+
+        "body {font: 13px sans-serif; color: black; text-align: left; padding: 5px; margin: 0}";
+
+        "h1 { font-size : 20pt ; text-align: center; }" ;
+
+        "h2 { font-size : 20pt ; text-align: center; }" ;
+
+        "h3 { font-size : 20pt ; border: 1px solid #000000; "^
+        "margin-top: 5px; margin-bottom: 2px;"^
+        "text-align: center; background-color: #90BDFF ;"^
+        "padding: 2px; }" ;
+
+        "h4 { font-size : 20pt ; border: 1px solid #000000; "^
+        "margin-top: 5px; margin-bottom: 2px;"^
+        "text-align: center; background-color: #90DDFF ;"^
+        "padding: 2px; }" ;
+
+        "h5 { font-size : 20pt ; border: 1px solid #000000; "^
+        "margin-top: 5px; margin-bottom: 2px;"^
+        "text-align: center; background-color: #90EDFF ;"^
+        "padding: 2px; }" ;
+
+        "h6 { font-size : 20pt ; border: 1px solid #000000; "^
+        "margin-top: 5px; margin-bottom: 2px;"^
+        "text-align: center; background-color: #90FDFF ;"^
+        "padding: 2px; }" ;
+
+        "div.h7 { font-size : 20pt ; border: 1px solid #000000; "^
+        "margin-top: 5px; margin-bottom: 2px;"^
+        "text-align: center; background-color: #90BDFF ; "^
+        "padding: 2px; }" ;
+
+        "div.h8 { font-size : 20pt ; border: 1px solid #000000; "^
+        "margin-top: 5px; margin-bottom: 2px;"^
+        "text-align: center; background-color: #E0FFFF ; "^
+        "padding: 2px; }" ;
+
+        "div.h9 { font-size : 20pt ; border: 1px solid #000000; "^
+        "margin-top: 5px; margin-bottom: 2px;"^
+        "text-align: center; background-color: #F0FFFF ; "^
+        "padding: 2px; }" ;
+
+        "div.h10 { font-size : 20pt ; border: 1px solid #000000; "^
+        "margin-top: 5px; margin-bottom: 2px;"^
+        "text-align: center; background-color: #FFFFFF ; "^
+        "padding: 2px; }" ;
+
+        "a {color: #416DFF; text-decoration: none}";
+        "a:hover {background-color: #ddd; text-decoration: underline}";
+        "pre { margin-bottom: 4px; font-family: monospace; }" ;
+        "pre.verbatim, pre.codepre { }";
+
+        ".indextable {border: 1px #ddd solid; border-collapse: collapse}";
+        ".indextable td, .indextable th {border: 1px #ddd solid; min-width: 80px}";
+        ".indextable td.module {background-color: #eee ;  padding-left: 2px; padding-right: 2px}";
+        ".indextable td.module a {color: #4E6272; text-decoration: none; display: block; width: 100%}";
+        ".indextable td.module a:hover {text-decoration: underline; background-color: transparent}";
+        ".deprecated {color: #888; font-style: italic}" ;
+
+        ".indextable tr td div.info { margin-left: 2px; margin-right: 2px }" ;
+
+        "ul.indexlist { margin-left: 0; padding-left: 0;}";
+        "ul.indexlist li { list-style-type: none ; margin-left: 0; padding-left: 0; }";
+        "ul.info-attributes {list-style: none; margin: 0; padding: 0; }";
+        "div.info > p:first-child { margin-top:0; }";
+        "div.info-desc > p:first-child { margin-top:0; margin-bottom:0; }"
+      ]
+
+    (** The style file for all pages. *)
+    val mutable style_file = "style.css"
+
+    (** The code to import the style. Initialized in [init_style]. *)
+    val mutable style = ""
+
+    (** The known types names.
+       Used to know if we must create a link to a type
+       when printing a type. *)
+    val mutable known_types_names = String.Set.empty
+
+    (** The known class and class type names.
+       Used to know if we must create a link to a class
+       or class type or not when printing a type. *)
+    val mutable known_classes_names = String.Set.empty
+
+    (** The known modules and module types names.
+       Used to know if we must create a link to a type or not
+       when printing a module type. *)
+    val mutable known_modules_names = String.Set.empty
+
+    method index_prefix =
+      if !Odoc_global.out_file = Odoc_messages.default_out_file then
+        "index"
+      else
+        Filename.basename !Odoc_global.out_file
+
+    (** The main file. *)
+    method index =
+      let p = self#index_prefix in
+      Printf.sprintf "%s.html" p
+
+    (** The file for the index of values. *)
+    method index_values = Printf.sprintf "%s_values.html" self#index_prefix
+
+    (** The file for the index of types. *)
+    method index_types = Printf.sprintf "%s_types.html" self#index_prefix
+
+    (** The file for the index of extensions. *)
+    method index_extensions = Printf.sprintf "%s_extensions.html" self#index_prefix
+
+    (** The file for the index of exceptions. *)
+    method index_exceptions = Printf.sprintf "%s_exceptions.html" self#index_prefix
+
+    (** The file for the index of attributes. *)
+    method index_attributes = Printf.sprintf "%s_attributes.html" self#index_prefix
+
+    (** The file for the index of methods. *)
+    method index_methods = Printf.sprintf "%s_methods.html" self#index_prefix
+
+    (** The file for the index of classes. *)
+    method index_classes = Printf.sprintf "%s_classes.html" self#index_prefix
+
+    (** The file for the index of class types. *)
+    method index_class_types = Printf.sprintf "%s_class_types.html" self#index_prefix
+
+    (** The file for the index of modules. *)
+    method index_modules = Printf.sprintf "%s_modules.html" self#index_prefix
+
+    (** The file for the index of module types. *)
+    method index_module_types = Printf.sprintf "%s_module_types.html" self#index_prefix
+
+
+    (** The list of attributes. Filled in the [generate] method. *)
+    val mutable list_attributes = []
+    method list_attributes = list_attributes
+
+    (** The list of methods. Filled in the [generate] method. *)
+    val mutable list_methods = []
+    method list_methods = list_methods
+
+    (** The list of values. Filled in the [generate] method. *)
+    val mutable list_values = []
+    method list_values = list_values
+
+    (** The list of extensions. Filled in the [generate] method. *)
+    val mutable list_extensions = []
+    method list_extensions = list_extensions
+
+    (** The list of exceptions. Filled in the [generate] method. *)
+    val mutable list_exceptions = []
+    method list_exceptions = list_exceptions
+
+    (** The list of types. Filled in the [generate] method. *)
+    val mutable list_types = []
+    method list_types = list_types
+
+    (** The list of modules. Filled in the [generate] method. *)
+    val mutable list_modules = []
+    method list_modules = list_modules
+
+    (** The list of module types. Filled in the [generate] method. *)
+    val mutable list_module_types = []
+    method list_module_types = list_module_types
+
+    (** The list of classes. Filled in the [generate] method. *)
+    val mutable list_classes = []
+    method list_classes = list_classes
+
+    (** The list of class types. Filled in the [generate] method. *)
+    val mutable list_class_types = []
+    method list_class_types = list_class_types
+
+    (** The header of pages. Must be prepared by the [prepare_header] method.*)
+    val mutable header = fun _ -> fun ?nav:_ -> fun ?comments:_ -> fun _ -> ()
+
+    (** Init the style. *)
+    method init_style =
+      (match !css_style with
+        None ->
+          let default_style = String.concat "\n" default_style_options in
+          (
+           try
+             let file = Filename.concat !Global.target_dir style_file in
+             if Sys.file_exists file then
+               Odoc_info.verbose (Odoc_messages.file_exists_dont_generate file)
+             else
+               (
+                let chanout = open_out file in
+                output_string chanout default_style ;
+                flush chanout ;
+                close_out chanout;
+                Odoc_info.verbose (Odoc_messages.file_generated file)
+               )
+           with
+             Sys_error s ->
+               prerr_endline s ;
+               incr Odoc_info.errors ;
+          )
+      | Some f ->
+          style_file <- f
+      );
+      style <- "\n"
+
+    (** Get the title given by the user *)
+    method title = match !Global.title with None -> "" | Some t -> self#escape t
+
+    (** Get the title given by the user completed with the given subtitle. *)
+    method inner_title s =
+      (match self#title with "" -> "" | t -> t^" : ")^
+      (self#escape s)
+
+    (** Get the page header. *)
+    method print_header b ?nav ?comments title = header b ?nav ?comments title
+
+    (** A function to build the header of pages. *)
+    method prepare_header module_list =
+      let f b ?(nav=None) ?(comments=[]) t  =
+        let link_if_not_empty l m url =
+          match l with
+            [] -> ()
+          | _ ->
+              bp b "\n" m url
+        in
+        bs b "\n";
+        bs b style;
+        self#meta b;
+        bs b "\n" ;
+        (
+         match nav with
+           None -> ()
+         | Some (pre_opt, post_opt, name) ->
+             (match pre_opt with
+               None -> ()
+             | Some name ->
+                 bp b "\n"
+                   (fst (Naming.html_files name));
+             );
+             (match post_opt with
+               None -> ()
+             | Some name ->
+                 bp b "\n"
+                   (fst (Naming.html_files name));
+             );
+             (
+              let father = Name.father name in
+              let href = if father = "" then self#index else fst (Naming.html_files father) in
+              bp b "\n" href
+             )
+        );
+        link_if_not_empty self#list_types Odoc_messages.index_of_types self#index_types;
+        link_if_not_empty self#list_extensions Odoc_messages.index_of_extensions self#index_extensions;
+        link_if_not_empty self#list_exceptions Odoc_messages.index_of_exceptions self#index_exceptions;
+        link_if_not_empty self#list_values Odoc_messages.index_of_values self#index_values;
+        link_if_not_empty self#list_attributes Odoc_messages.index_of_attributes self#index_attributes;
+        link_if_not_empty self#list_methods Odoc_messages.index_of_methods self#index_methods;
+        link_if_not_empty self#list_classes Odoc_messages.index_of_classes self#index_classes;
+        link_if_not_empty self#list_class_types Odoc_messages.index_of_class_types self#index_class_types;
+        link_if_not_empty self#list_modules Odoc_messages.index_of_modules self#index_modules;
+        link_if_not_empty self#list_module_types Odoc_messages.index_of_module_types self#index_module_types;
+        let print_one m =
+          let html_file = fst (Naming.html_files m.m_name) in
+          bp b ""
+            m.m_name html_file
+        in
+        print_concat b "\n" print_one module_list;
+        self#html_sections_links b comments;
+        bs b "";
+        bs b t ;
+        bs b "\n\n"
+      in
+      header <- f
+
+    (** Build the html code for the link tags in the header, defining section and
+       subsections for the titles found in the given comments.*)
+    method html_sections_links b comments =
+      let titles = List.flatten (List.map Odoc_info.get_titles_in_text comments) in
+      let levels =
+        let rec iter acc l =
+          match l with
+            [] -> acc
+          | (n,_,_) :: q ->
+              if List.mem n acc
+              then iter acc q
+              else iter (n::acc) q
+        in
+        iter [] titles
+      in
+      let sorted_levels = List.sort compare levels in
+      let (section_level, subsection_level) =
+        match sorted_levels with
+          [] -> (None, None)
+        | [n] -> (Some n, None)
+        | n :: m :: _ -> (Some n, Some m)
+      in
+      let titles_per_level level_opt =
+        match level_opt with
+          None -> []
+        | Some n -> List.filter (fun (m,_,_) -> m = n) titles
+      in
+      let section_titles = titles_per_level section_level in
+      let subsection_titles = titles_per_level subsection_level in
+      let print_lines s_rel titles =
+        List.iter
+          (fun (n,lopt,t) ->
+            let s = Odoc_info.string_of_text t in
+            let label = self#create_title_label (n,lopt,t) in
+            bp b "\n" s s_rel label
+          )
+          titles
+      in
+      print_lines "Section" section_titles ;
+      print_lines "Subsection" subsection_titles
+
+
+    (** Html code for navigation bar.
+       @param pre optional name for optional previous module/class
+       @param post optional name for optional next module/class
+       @param name name of current module/class *)
+    method print_navbar b pre post name =
+      bs b "
    ";
+      (
+       match pre with
+         None -> ()
+       | Some name ->
+           bp b "%s\n"
+             (fst (Naming.html_files name))
+             name
+             Odoc_messages.previous
+      );
+      bs b " ";
+      let father = Name.father name in
+      let href = if father = "" then self#index else fst (Naming.html_files father) in
+      let father_name = if father = "" then "Index" else father in
+      bp b "%s\n" href father_name Odoc_messages.up;
+      bs b " ";
+      (
+       match post with
+         None -> ()
+       | Some name ->
+           bp b "%s\n"
+             (fst (Naming.html_files name))
+             name
+             Odoc_messages.next
+      );
+      bs b "
    \n"
+
+    (** Return html code with the given string in the keyword style.*)
+    method keyword s =
+      ""^s^""
+
+    (** Return html code with the given string in the constructor style. *)
+    method constructor s = ""^s^""
+
+    (** Output the given ocaml code to the given file name. *)
+    method private output_code ?(with_pre=true) in_title file code =
+      try
+        let chanout = open_out file in
+        let b = new_buf () in
+        bs b "";
+        self#print_header b (self#inner_title in_title);
+        bs b"\n";
+        self#html_of_code ~with_pre b code;
+        bs b "\n";
+        Buffer.output_buffer chanout b;
+        close_out chanout
+      with
+        Sys_error s ->
+          incr Odoc_info.errors ;
+          prerr_endline s
+
+    (** Take a string and return the string where fully qualified
+       type (or class or class type) idents
+       have been replaced by links to the type referenced by the ident.*)
+    method create_fully_qualified_idents_links m_name s =
+      let ln = !Odoc_global.library_namespace in
+      let f str_t =
+        let match_s = Str.matched_string str_t in
+        let known_type = String.Set.mem match_s known_types_names in
+        let known_class = String.Set.mem match_s known_classes_names in
+        let retry, match_s = if not (known_type || known_class) && ln <> "" then
+            true, Name.get_relative_opt ln match_s
+          else
+            false, match_s
+        in
+        let rel = Name.get_relative m_name match_s in
+        let s_final = Odoc_info.apply_if_equal
+            Odoc_info.use_hidden_modules
+            match_s
+            rel
+        in
+        if known_type ||
+           (retry && String.Set.mem match_s known_types_names) then
+           ""^
+           s_final^
+           ""
+        else
+        if known_class ||
+           (retry && String.Set.mem match_s known_classes_names) then
+            let (html_file, _) = Naming.html_files match_s in
+            ""^s_final^""
+          else
+            s_final
+      in
+      Str.global_substitute
+        (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([a-z][a-zA-Z_'0-9]*\\)")
+        f
+        s
+
+    (** Take a string and return the string where fully qualified module idents
+       have been replaced by links to the module referenced by the ident.*)
+    method create_fully_qualified_module_idents_links m_name s =
+      let f str_t =
+        let match_s = Str.matched_string str_t in
+        let known_module = String.Set.mem match_s known_modules_names in
+        let ln = !Odoc_global.library_namespace in
+        let retry, match_s =
+          if not known_module && ln <> "" then
+            true, Name.get_relative_opt ln match_s
+          else
+            false, match_s in
+        let rel = Name.get_relative m_name match_s in
+        let s_final = Odoc_info.apply_if_equal
+            Odoc_info.use_hidden_modules
+            match_s
+            rel
+        in
+        if known_module ||
+           (retry && String.Set.mem match_s known_modules_names) then
+          let (html_file, _) = Naming.html_files match_s in
+          ""^s_final^""
+        else
+          s_final
+      in
+      Str.global_substitute
+        (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\)\\(\\.[A-Z][a-zA-Z_'0-9]*\\)*")
+        f
+        s
+
+    (** Print html code to display a [Types.type_expr]. *)
+    method html_of_type_expr b m_name t =
+      let s = Odoc_info.remove_ending_newline (Odoc_info.string_of_type_expr t) in
+      let s2 = newline_to_indented_br s in
+      bs b "";
+      bs b (self#create_fully_qualified_idents_links m_name s2);
+      bs b ""
+
+    (** Print html code to display a [Types.type_expr list]. *)
+    method html_of_cstr_args ?par b m_name c_name sep l =
+      print_DEBUG "html#html_of_cstr_args";
+      match l with
+      | Cstr_tuple l ->
+          print_DEBUG "html#html_of_cstr_args: 1";
+          let s = Odoc_info.string_of_type_list ?par sep l in
+          let s2 = newline_to_indented_br s in
+          print_DEBUG "html#html_of_cstr_args: 2";
+          bs b "";
+          bs b (self#create_fully_qualified_idents_links m_name s2);
+          bs b ""
+      | Cstr_record l ->
+          print_DEBUG "html#html_of_cstr_args: 1 bis";
+          bs b "";
+          self#html_of_record ~father:m_name ~close_env: ""
+            (Naming.inline_recfield_target m_name c_name)
+            b l
+
+    (** Print html code to display a [Types.type_expr list] as type parameters
+       of a class of class type. *)
+    method html_of_class_type_param_expr_list b m_name l =
+      let s = Odoc_info.string_of_class_type_param_list l in
+      let s2 = newline_to_indented_br s in
+      bs b "[";
+      bs b (self#create_fully_qualified_idents_links m_name s2);
+      bs b "]"
+
+    method html_of_class_parameter_list b father c =
+      let s = Odoc_info.string_of_class_params c in
+      let s = Odoc_info.remove_ending_newline s in
+      let s2 = newline_to_indented_br s in
+      bs b "";
+      bs b (self#create_fully_qualified_idents_links father s2);
+      bs b ""
+
+    (** Print html code to display a list of type parameters for the given type.*)
+    method html_of_type_expr_param_list b m_name t =
+      let s = Odoc_info.string_of_type_param_list t in
+      let s2 = newline_to_indented_br s in
+      bs b "";
+      bs b (self#create_fully_qualified_idents_links m_name s2);
+      bs b ""
+
+    (** Print html code to display a [Types.module_type]. *)
+    method html_of_module_type b ?code m_name t =
+      let s = Odoc_info.remove_ending_newline (Odoc_info.string_of_module_type ?code t) in
+      bs b "";
+      bs b (self#create_fully_qualified_module_idents_links m_name s);
+      bs b ""
+
+    (** Print html code to display the given module kind. *)
+    method html_of_module_kind b father ?modu kind =
+      match kind with
+        Module_struct eles ->
+          self#html_of_text b [Code "sig"];
+          (
+           match modu with
+             None ->
+               (* first we close the current 
     tag, since the following
+                  list of module elements is not preformatted *)
+               bs b "
    ";
+               bs b "
    ";
+               List.iter (self#html_of_module_element b father) eles;
+               bs b "
    ";
+               bs b "\n
    "
+           | Some m ->
+               let (html_file, _) = Naming.html_files m.m_name in
+               bp b " .. " html_file
+          );
+          self#html_of_text b [Code "end"]
+      | Module_alias a ->
+          bs b "";
+          bs b (self#create_fully_qualified_module_idents_links father a.ma_name);
+          bs b ""
+      | Module_functor (p, k) ->
+          if !html_short_functors then
+            bs b " "
+          else
+            bs b "
    ";
+          self#html_of_module_parameter b father p;
+          (
+           match k with
+             Module_functor _ -> ()
+           | _ when !html_short_functors ->
+               bs b ": "
+           | _ -> ()
+          );
+          self#html_of_module_kind b father ?modu k;
+          if not !html_short_functors then
+            bs b "
    "
+      | Module_apply (k1, k2) ->
+          (* TODO: application is not correct in a .mli.
+             What to do -> print typedtree module_type    *)
+          self#html_of_module_kind b father k1;
+          self#html_of_text b [Code "("];
+          self#html_of_module_kind b father k2;
+          self#html_of_text b [Code ")"]
+      | Module_with (k, s) ->
+          (* TODO: modify when Module_with will be more detailed *)
+          self#html_of_module_type_kind b father ?modu k;
+          bs b " ";
+          bs b (self#create_fully_qualified_module_idents_links father s);
+          bs b ""
+      | Module_constraint (k, _tk) ->
+          (* TODO: what to print ? *)
+          self#html_of_module_kind b father ?modu k
+      | Module_typeof s ->
+          bs b "module type of ";
+          bs b (self#create_fully_qualified_module_idents_links father s);
+          bs b ""
+      | Module_unpack (code, mta) ->
+          bs b "";
+          begin
+            match mta.mta_module with
+              None ->
+                bs b (self#create_fully_qualified_module_idents_links father (self#escape code))
+            | Some mt ->
+                let (html_file, _) = Naming.html_files mt.mt_name in
+                bp b " %s " html_file (self#escape code)
+          end;
+          bs b ""
+
+
+    method html_of_module_parameter b father p =
+      let (s_functor,s_arrow) =
+        if !html_short_functors then
+          "", ""
+        else
+          "functor ", "-> "
+      in
+      self#html_of_text b
+        [
+          Code (s_functor^"(");
+          Code p.mp_name ;
+          Code " : ";
+        ] ;
+      self#html_of_module_type_kind b father p.mp_kind;
+      self#html_of_text b [ Code (") "^s_arrow)]
+
+    method html_of_module_element b m_name ele =
+      match ele with
+        Element_module m ->
+          self#html_of_module b ~complete: false m
+      | Element_module_type mt ->
+          self#html_of_modtype b ~complete: false mt
+      | Element_included_module im ->
+          self#html_of_included_module b im
+      | Element_class c ->
+          self#html_of_class b ~complete: false c
+      | Element_class_type ct ->
+          self#html_of_class_type b ~complete: false ct
+      | Element_value v ->
+          self#html_of_value b v
+      | Element_type_extension te ->
+          self#html_of_type_extension b m_name te
+      | Element_exception e ->
+          self#html_of_exception b e
+      | Element_type t ->
+          self#html_of_type b t
+      | Element_module_comment text ->
+          self#html_of_module_comment b text
+
+    (** Print html code to display the given module type kind. *)
+    method html_of_module_type_kind b father ?modu ?mt kind =
+      match kind with
+        Module_type_struct eles ->
+          self#html_of_text b [Code "sig"];
+          (
+           match mt with
+             None ->
+               (
+                match modu with
+                  None ->
+                    (*close the current 
     tag, to avoid anarchic line breaks
+                      in the list of module elements *)
+                    bs b "
    ";
+                    bs b "
    ";
+                    List.iter (self#html_of_module_element b father) eles;
+                    bs b "
    ";
+                    bs b "
    ";
+                | Some m ->
+                    let (html_file, _) = Naming.html_files m.m_name in
+                    bp b " .. " html_file
+               )
+           | Some mt ->
+               let (html_file, _) = Naming.html_files mt.mt_name in
+               bp b " .. " html_file
+          );
+          self#html_of_text b [Code "end"]
+      | Module_type_functor (p, k) ->
+          self#html_of_module_parameter b father p;
+          self#html_of_module_type_kind b father ?modu ?mt k
+      | Module_type_alias a ->
+          bs b "";
+          bs b (self#create_fully_qualified_module_idents_links father a.mta_name);
+          bs b ""
+      | Module_type_with (k, s) ->
+          self#html_of_module_type_kind b father ?modu ?mt k;
+          bs b " ";
+          bs b (self#create_fully_qualified_module_idents_links father s);
+          bs b ""
+      | Module_type_typeof s ->
+          bs b "module type of ";
+          bs b (self#create_fully_qualified_module_idents_links father s);
+          bs b ""
+
+    (** Print html code to display the type of a module parameter.. *)
+    method html_of_module_parameter_type b m_name p =
+      match p.mp_type with None -> bs b "()"
+      | Some mty -> self#html_of_module_type b m_name ~code: p.mp_type_code mty
+
+    (** Generate a file containing the module type in the given file name. *)
+    method output_module_type in_title file mtyp =
+      let s = Odoc_info.remove_ending_newline (Odoc_info.string_of_module_type ~complete: true mtyp) in
+      self#output_code ~with_pre:false in_title file s
+
+    (** Generate a file containing the class type in the given file name. *)
+    method output_class_type in_title file ctyp =
+      let s = Odoc_info.remove_ending_newline (Odoc_info.string_of_class_type ~complete: true ctyp) in
+      self#output_code ~with_pre:false in_title file s
+
+    (** Print html code for a value. *)
+    method html_of_value b v =
+      Odoc_info.reset_type_names ();
+      bs b "\n
    " ;
+      bp b "" (Naming.value_target v);
+      bs b (self#keyword "val");
+      bs b " ";
+      (
+       match v.val_code with
+         None -> bs b (self#escape (Name.simple v.val_name))
+       | Some c ->
+           let file = Naming.file_code_value_complete_target v in
+           self#output_code v.val_name (Filename.concat !Global.target_dir file) c;
+           bp b "%s" file (self#escape (Name.simple v.val_name))
+      );
+      bs b "";
+      bs b " : ";
+      self#html_of_type_expr b (Name.father v.val_name) v.val_type;
+      bs b "
    ";
+      self#html_of_info b v.val_info;
+      (
+       if !with_parameter_list then
+         self#html_of_parameter_list b (Name.father v.val_name) v.val_parameters
+       else
+         self#html_of_described_parameter_list b (Name.father v.val_name) v.val_parameters
+      )
+
+    (** Print html code for a type extension. *)
+    method html_of_type_extension b m_name te =
+      Odoc_info.reset_type_names ();
+      bs b "
    ";
+      bs b ((self#keyword "type")^" ");
+      let s = Odoc_info.string_of_type_extension_param_list te in
+      let s2 = newline_to_indented_br s in
+      bs b "";
+      bs b (self#create_fully_qualified_idents_links m_name s2);
+      bs b "";
+      (match te.te_type_parameters with [] -> () | _ -> bs b " ");
+      bs b (self#create_fully_qualified_idents_links m_name te.te_type_name);
+      bs b " += ";
+      if te.te_private = Asttypes.Private then bs b "private ";
+      bs b "
    ";
+      bs b "\n";
+      let print_one x =
+        let father = Name.father x.xt_name in
+        let cname = Name.simple x.xt_name in
+        bs b "\n\n\n";
+        (
+          match x.xt_text with
+              None -> ()
+            | Some t ->
+                bs b "";
+                bs b "";
+                bs b "";
+        );
+        bs b "\n"
+      in
+        print_concat b "\n" print_one te.te_constructors;
+        bs b "
    \n";
+        bs b "";
+        bs b (self#keyword "|");
+        bs b "\n";
+        bs b "";
+        bp b "%s"
+          (Naming.extension_target x)
+          cname;
+        (
+          match x.xt_args, x.xt_ret with
+              Cstr_tuple [], None -> ()
+            | l,None ->
+                bs b (" " ^ (self#keyword "of") ^ " ");
+                self#html_of_cstr_args ~par: false b father cname " * " l;
+            | Cstr_tuple [],Some r ->
+                bs b (" " ^ (self#keyword ":") ^ " ");
+                self#html_of_type_expr b father r;
+            | l,Some r ->
+                bs b (" " ^ (self#keyword ":") ^ " ");
+                self#html_of_cstr_args ~par: false b father cname " * " l;
+                bs b (" " ^ (self#keyword "->") ^ " ");
+                self#html_of_type_expr b father r;
+        );
+        (
+            match x.xt_alias with
+              None -> ()
+            | Some xa ->
+                bs b " = ";
+                (
+                  match xa.xa_xt with
+                    None -> bs b xa.xa_name
+                  | Some x ->
+                      bp b "%s" (Naming.complete_extension_target x) x.xt_name
+                )
+        );
+        bs b "";
+                bs b "";
+                bs b "(*";
+                bs b "";
+                self#html_of_info b (Some t);
+                bs b "";
+                bs b "";
+                bs b "*)";
+                bs b "
    \n";
+        bs b "\n";
+        self#html_of_info b te.te_info;
+        bs b "\n"
+
+    (** Print html code for an exception. *)
+    method html_of_exception b e =
+      let cname = Name.simple e.ex_name in
+      Odoc_info.reset_type_names ();
+      bs b "\n
    ";
+      bp b "" (Naming.exception_target e);
+      bs b (self#keyword "exception");
+      bs b " ";
+      bs b cname;
+      bs b "";
+      (
+        let father = Name.father e.ex_name in
+        match e.ex_args, e.ex_ret with
+          Cstr_tuple [], None -> ()
+        | _,None ->
+            bs b (" "^(self#keyword "of")^" ");
+            self#html_of_cstr_args
+                   ~par:false b father cname " * " e.ex_args
+        | Cstr_tuple [],Some r ->
+            bs b (" " ^ (self#keyword ":") ^ " ");
+            self#html_of_type_expr b father r;
+        | l,Some r ->
+            bs b (" " ^ (self#keyword ":") ^ " ");
+            self#html_of_cstr_args
+                   ~par:false b father cname " * " l;
+            bs b (" " ^ (self#keyword "->") ^ " ");
+            self#html_of_type_expr b father r;
+      );
+      (
+       match e.ex_alias with
+         None -> ()
+       | Some ea ->
+           bs b " = ";
+           (
+            match ea.ea_ex with
+              None -> bs b ea.ea_name
+            | Some e ->
+                bp b "%s" (Naming.complete_exception_target e) e.ex_name
+           )
+      );
+      bs b "
    \n";
+      self#html_of_info b e.ex_info
+
+    method html_of_record ~father ~close_env gen_name  b l =
+      bs b "{";
+      bs b close_env;
+      bs b "\n" ;
+      let print_one r =
+        bs b "\n\n\n";
+        (
+          match r.rf_text with
+            None -> ()
+          | Some t ->
+              bs b "";
+              bs b "";
+        );
+        bs b "\n"
+      in
+      print_concat b "\n" print_one l;
+      bs b "
    \n";
+        bs b "  ";
+        bs b "\n";
+        bs b "";
+        if r.rf_mutable then bs b (self#keyword "mutable ") ;
+        bp b "%s : " (gen_name r) r.rf_name;
+        self#html_of_type_expr b father r.rf_type;
+        bs b ";";
+              bs b "";
+              bs b "(*";
+              bs b "";
+              self#html_of_info b (Some t);
+              bs b "";
+              bs b "*)
    \n}\n"
+
+
+    (** Print html code for a type. *)
+    method html_of_type b t =
+      Odoc_info.reset_type_names ();
+      let father = Name.father t.ty_name in
+      let print_field_prefix () =
+        bs b "\n\n";
+        bs b "  ";
+        bs b "\n\n";
+        bs b "";
+      in
+      let print_field_comment = function
+        | None -> ()
+        | Some t ->
+            bs b "";
+            bs b "";
+            bs b "(*";
+            bs b "";
+            bs b "";
+            self#html_of_info b (Some t);
+            bs b "";
+            bs b "*)"
+      in
+      bs b
+        (match t.ty_manifest, t.ty_kind with
+          None, Type_abstract
+        | None, Type_open -> "\n
    "
+        | None, Type_variant _
+        | None, Type_record _ -> "\n
    "
+        | Some _, Type_abstract
+        | Some _, Type_open -> "\n
    "
+        | Some _, Type_variant _
+        | Some _, Type_record _ -> "\n
    "
+        );
+      bp b "" (Naming.type_target t);
+      bs b ((self#keyword "type")^" ");
+      self#html_of_type_expr_param_list b father t;
+      (match t.ty_parameters with [] -> () | _ -> bs b " ");
+      bs b (Name.simple t.ty_name);
+      bs b " ";
+      let priv = t.ty_private = Asttypes.Private in
+      (
+       match t.ty_manifest with
+         None -> ()
+       | Some (Object_type fields) ->
+           bs b "= ";
+           if priv then bs b "private ";
+           bs b "<
    ";
+           bs b "\n" ;
+           let print_one f =
+             print_field_prefix () ;
+             bp b "%s : "
+               (Naming.objfield_target t f)
+               f.of_name;
+             self#html_of_type_expr b father f.of_type;
+             bs b ";\n";
+             print_field_comment f.of_text ;
+             bs b "\n"
+           in
+           print_concat b "\n" print_one fields;
+           bs b "
    \n>\n";
+           bs b " "
+       | Some (Other typ) ->
+           bs b "= ";
+           if priv then bs b "private ";
+           self#html_of_type_expr b father typ;
+           bs b " "
+      );
+      (match t.ty_kind with
+        Type_abstract -> bs b "
    "
+      | Type_variant l ->
+          bs b "= ";
+          if priv then bs b "private ";
+          bs b
+            (
+             match t.ty_manifest with
+               None -> "
    "
+             | Some _ -> "
    "
+            );
+          bs b "\n";
+          let print_bar () =
+            bs b "\n\n\n";
+            (
+             match constr.vc_text with
+               None -> ()
+             | Some t ->
+                 bs b "";
+                 bs b "";
+                 bs b "";
+            );
+            bs b "\n"
+          in
+          if l = [] then print_bar () else
+            print_concat b "\n" print_one l;
+          bs b "
    \n";
+            bs b "";
+            bs b (self#keyword "|");
+            bs b "\n";
+            bs b "" in
+          let print_one constr =
+            print_bar ();
+            bp b "%s"
+              (Naming.const_target t constr)
+              (self#constructor constr.vc_name);
+            (
+             match constr.vc_args, constr.vc_ret with
+               Cstr_tuple [], None -> ()
+             | l,None ->
+                 bs b (" " ^ (self#keyword "of") ^ " ");
+                 self#html_of_cstr_args ~par:false b father constr.vc_name " * " l;
+             | Cstr_tuple [],Some r ->
+                 bs b (" " ^ (self#keyword ":") ^ " ");
+                 self#html_of_type_expr b father r;
+             | l,Some r ->
+                 bs b (" " ^ (self#keyword ":") ^ " ");
+                 self#html_of_cstr_args ~par: false b father constr.vc_name " * " l;
+                 bs b (" " ^ (self#keyword "->") ^ " ");
+                 self#html_of_type_expr b father r;
+            );
+            bs b "";
+                 bs b "";
+                 bs b "(*";
+                 bs b "";
+                 self#html_of_info b (Some t);
+                 bs b "";
+                 bs b "";
+                 bs b "*)";
+                 bs b "
    \n"
+
+      | Type_record l ->
+          bs b "= ";
+          if priv then bs b "private " ;
+          let close_env = match t.ty_manifest with
+              None -> "
    "
+            | Some _ -> "
    " in
+          self#html_of_record ~father ~close_env (Naming.recfield_target t) b l
+      | Type_open ->
+          bs b "= ..";
+          bs b "
    "
+      );
+      bs b "\n";
+      self#html_of_info b t.ty_info;
+      bs b "\n"
+
+    (** Print html code for a class attribute. *)
+    method html_of_attribute b a =
+      let module_name = Name.father (Name.father a.att_value.val_name) in
+      bs b "\n
    " ;
+      bp b "" (Naming.attribute_target a);
+      bs b (self#keyword "val");
+      bs b " ";
+      (
+       if a.att_virtual then
+         bs b ((self#keyword "virtual")^ " ")
+       else
+         ()
+      );
+      (
+       if a.att_mutable then
+         bs b ((self#keyword Odoc_messages.mutab)^ " ")
+       else
+         ()
+      );(
+       match a.att_value.val_code with
+         None -> bs b (Name.simple a.att_value.val_name)
+       | Some c ->
+           let file = Naming.file_code_attribute_complete_target a in
+           self#output_code a.att_value.val_name (Filename.concat !Global.target_dir file) c;
+           bp b "%s" file (Name.simple a.att_value.val_name);
+      );
+      bs b "";
+      bs b " : ";
+      self#html_of_type_expr b module_name a.att_value.val_type;
+      bs b "
    ";
+      self#html_of_info b a.att_value.val_info
+
+    (** Print html code for a class method. *)
+    method html_of_method b m =
+      let module_name = Name.father (Name.father m.met_value.val_name) in
+      bs b "\n
    ";
+      (* html mark *)
+      bp b "" (Naming.method_target m);
+     bs b ((self#keyword "method")^" ");
+       if m.met_private then bs b ((self#keyword "private")^" ");
+      if m.met_virtual then bs b ((self#keyword "virtual")^" ");
+      (
+       match m.met_value.val_code with
+         None -> bs b  (Name.simple m.met_value.val_name)
+       | Some c ->
+           let file = Naming.file_code_method_complete_target m in
+           self#output_code m.met_value.val_name (Filename.concat !Global.target_dir file) c;
+           bp b "%s" file (Name.simple m.met_value.val_name);
+      );
+      bs b "";
+      bs b " : ";
+      self#html_of_type_expr b module_name m.met_value.val_type;
+      bs b "
    ";
+      self#html_of_info b m.met_value.val_info;
+      (
+       if !with_parameter_list then
+         self#html_of_parameter_list b
+           module_name m.met_value.val_parameters
+       else
+         self#html_of_described_parameter_list b
+           module_name m.met_value.val_parameters
+      )
+
+    (** Print html code for the description of a function parameter. *)
+    method html_of_parameter_description b p =
+      match Parameter.names p with
+        [] ->
+          ()
+      | name :: [] ->
+          (
+           (* Only one name, no need for label for the description. *)
+           match Parameter.desc_by_name p name with
+             None -> ()
+           | Some t -> self#html_of_text b t
+          )
+      | l ->
+          (*  A list of names, we display those with a description. *)
+          let l2 = List.filter
+              (fun n -> (Parameter.desc_by_name p n) <> None)
+              l
+          in
+          let print_one n =
+            match Parameter.desc_by_name p n with
+              None -> ()
+            | Some t ->
+                bs b "
    \n";
+                bs b "";
+                bs b n;
+                bs b " : ";
+                self#html_of_text b t;
+                bs b "
    \n"
+          in
+          List.iter print_one l2
+
+    (** Print html code for a list of parameters. *)
+    method html_of_parameter_list b m_name l =
+      match l with
+        [] -> ()
+      | _ ->
+          bs b "
    ";
+          bs b "\n";
+          bs b "\n\n" ;
+          bs b "\n\n
    ";
+          bs b "";
+          bs b Odoc_messages.parameters;
+          bs b ": \n\n";
+          let print_one p =
+            bs b "\n\n\n";
+            bs b "\n";
+          in
+          List.iter print_one l;
+          bs b "
    \n";
+            bs b
+              (
+               match Parameter.complete_name p with
+                 "" -> "?"
+               | s -> s
+              );
+            bs b ":";
+            bs b "
    \n";
+            self#html_of_type_expr b m_name (Parameter.typ p);
+            bs b "
    \n";
+            self#html_of_parameter_description b p;
+            bs b "\n
    \n
    \n"
+
+    (** Print html code for the parameters which have a name and description. *)
+    method html_of_described_parameter_list b _m_name l =
+      (* get the params which have a name, and at least one name described. *)
+      let l2 = List.filter
+          (fun p ->
+            List.exists
+              (fun n -> (Parameter.desc_by_name p n) <> None)
+              (Parameter.names p))
+          l
+      in
+      let f p =
+        bs b "
    ";
+        bs b (Parameter.complete_name p);
+        bs b " : " ;
+        self#html_of_parameter_description b p;
+        bs b "
    \n"
+      in
+      List.iter f l2
+
+    (** Print html code for a list of module parameters. *)
+    method html_of_module_parameter_list b m_name l =
+      match l with
+        [] ->
+          ()
+      | _ ->
+          bs b "\n";
+          bs b "\n";
+          bs b "\n\n\n
    ";
+          bs b Odoc_messages.parameters ;
+          bs b ": \n";
+          bs b "\n";
+          List.iter
+            (fun (p, desc_opt) ->
+              bs b "\n";
+              bs b "\n" ;
+              bs b "\n";
+              bs b "\n" ;
+              )
+            )
+            l;
+          bs b "
    \n" ;
+              bs b p.mp_name;
+              bs b ":" ;
+              self#html_of_module_parameter_type b m_name p;
+              bs b "\n";
+              (
+               match desc_opt with
+                 None -> ()
+               | Some t ->
+                   bs b "
    ";
+                   self#html_of_text b t;
+                   bs b "\n
    \n";
+                   bs b "\n
    \n
    \n"
+
+    (** Print html code for a module. *)
+    method html_of_module b ?(info=true) ?(complete=true) ?(with_link=true) m =
+      let (html_file, _) = Naming.html_files m.m_name in
+      let father = Name.father m.m_name in
+      bs b "\n
    ";
+      bp b "" (Naming.module_target m);
+      bs b ((self#keyword "module")^" ");
+      (
+       if with_link then
+         bp b "%s" html_file (Name.simple m.m_name)
+       else
+         bs b (Name.simple m.m_name)
+      );
+      bs b "" ;
+      (
+       match m.m_kind with
+         Module_functor _ when !html_short_functors  ->
+           ()
+       | _ -> bs b ": "
+      );
+      self#html_of_module_kind b father ~modu: m m.m_kind;
+      bs b "
    ";
+      if info then
+        (
+         if complete then
+           self#html_of_info ~cls: "module top" ~indent: true
+         else
+           self#html_of_info_first_sentence
+        ) b m.m_info
+      else
+        ()
+
+    (** Print html code for a module type. *)
+    method html_of_modtype b ?(info=true) ?(complete=true) ?(with_link=true) mt =
+      let (html_file, _) = Naming.html_files mt.mt_name in
+      let father = Name.father mt.mt_name in
+      bs b "\n
    ";
+      bp b "" (Naming.module_type_target mt);
+      bs b (self#keyword "module type" ^ " ");
+      (
+       if with_link then
+         bp b "%s" html_file (Name.simple mt.mt_name)
+         else
+         bs b (Name.simple mt.mt_name)
+      );
+      bs b "";
+      (match mt.mt_kind with
+        None -> ()
+      | Some k ->
+          bs b " = ";
+          self#html_of_module_type_kind b father ~mt k
+      );
+      bs b "
    ";
+      if info then
+        (
+         if complete then
+           self#html_of_info ~cls: "modtype top" ~indent: true
+         else
+           self#html_of_info_first_sentence
+        ) b mt.mt_info
+      else
+        ()
+
+    (** Print html code for an included module. *)
+    method html_of_included_module b im =
+      bs b "\n
    ";
+      bs b ((self#keyword "include")^" ");
+      (
+       match im.im_module with
+         None ->
+           bs b im.im_name
+       | Some mmt ->
+           let (file, name) =
+             match mmt with
+               Mod m ->
+                 let (html_file, _) = Naming.html_files m.m_name in
+                 (html_file, m.m_name)
+             | Modtype mt ->
+                 let (html_file, _) = Naming.html_files mt.mt_name in
+                 (html_file, mt.mt_name)
+           in
+           bp b "%s" file name
+      );
+      bs b "
    \n";
+      self#html_of_info b im.im_info
+
+    method html_of_class_element b element =
+      match element with
+        Class_attribute a ->
+          self#html_of_attribute b a
+      | Class_method m ->
+          self#html_of_method b m
+      | Class_comment t ->
+          self#html_of_class_comment b t
+
+    method html_of_class_kind b father ?cl kind =
+      match kind with
+        Class_structure (inh, eles) ->
+          self#html_of_text b [Code "object"];
+          (
+           match cl with
+             None ->
+               bs b "\n";
+               (
+                match inh with
+                  [] -> ()
+                | _ ->
+                    self#generate_inheritance_info b inh
+               );
+               List.iter (self#html_of_class_element b) eles;
+           | Some cl ->
+               let (html_file, _) = Naming.html_files cl.cl_name in
+               bp b " .. " html_file
+          );
+          self#html_of_text b [Code "end"]
+
+      | Class_apply _ ->
+          (* TODO: display final type from typedtree *)
+          self#html_of_text b [Raw "class application not handled yet"]
+
+      | Class_constr cco ->
+          (
+           match cco.cco_type_parameters with
+             [] -> ()
+           | l ->
+               self#html_of_class_type_param_expr_list b father l;
+               bs b " "
+          );
+          bs b "";
+          bs b (self#create_fully_qualified_idents_links father cco.cco_name);
+          bs b ""
+
+      | Class_constraint (ck, ctk) ->
+          self#html_of_text b [Code "( "] ;
+          self#html_of_class_kind b father ck;
+          self#html_of_text b [Code " : "] ;
+          self#html_of_class_type_kind b father ctk;
+          self#html_of_text b [Code " )"]
+
+    method html_of_class_type_kind b father ?ct kind =
+      match kind with
+        Class_type cta ->
+          (
+           match cta.cta_type_parameters with
+             [] -> ()
+           | l ->
+               self#html_of_class_type_param_expr_list b father l;
+               bs b " "
+          );
+          bs b "";
+          bs b (self#create_fully_qualified_idents_links father cta.cta_name);
+          bs b ""
+
+      | Class_signature (inh, eles) ->
+          self#html_of_text b [Code "object"];
+          (
+           match ct with
+             None ->
+               bs b "\n";
+               (
+                match inh with
+                  [] -> ()
+                | _ -> self#generate_inheritance_info b inh
+               );
+               List.iter (self#html_of_class_element b) eles
+           | Some ct ->
+               let (html_file, _) = Naming.html_files ct.clt_name in
+               bp b " .. " html_file
+          );
+          self#html_of_text b [Code "end"]
+
+    (** Print html code for a class. *)
+    method html_of_class b ?(complete=true) ?(with_link=true) c =
+      let father = Name.father c.cl_name in
+      Odoc_info.reset_type_names ();
+      let (html_file, _) = Naming.html_files c.cl_name in
+      bs b "\n
    ";
+      (* we add a html id, the same as for a type so we can
+         go directly here when the class name is used as a type name *)
+      bp b ""
+        (Naming.type_target
+           { ty_name = c.cl_name ;
+             ty_info = None ; ty_parameters = [] ;
+             ty_kind = Type_abstract ; ty_private = Asttypes.Public;
+             ty_manifest = None ;
+             ty_loc = Odoc_info.dummy_loc ;
+             ty_code = None ;
+           }
+        );
+      bs b ((self#keyword "class")^" ");
+      print_DEBUG "html#html_of_class : virtual or not" ;
+      if c.cl_virtual then bs b ((self#keyword "virtual")^" ");
+      (
+       match c.cl_type_parameters with
+         [] -> ()
+       | l ->
+           self#html_of_class_type_param_expr_list b father l;
+           bs b " "
+      );
+      print_DEBUG "html#html_of_class : with link or not" ;
+      (
+       if with_link then
+         bp b "%s" html_file (Name.simple c.cl_name)
+       else
+         bs b (Name.simple c.cl_name)
+      );
+      bs b "";
+      bs b " : " ;
+      self#html_of_class_parameter_list b father c ;
+      self#html_of_class_kind b father ~cl: c c.cl_kind;
+      bs b "
    " ;
+      print_DEBUG "html#html_of_class : info" ;
+      (
+       if complete then
+         self#html_of_info ~cls: "class top" ~indent: true
+       else
+         self#html_of_info_first_sentence
+      ) b c.cl_info
+
+    (** Print html code for a class type. *)
+    method html_of_class_type b ?(complete=true) ?(with_link=true) ct =
+      Odoc_info.reset_type_names ();
+      let father = Name.father ct.clt_name in
+      let (html_file, _) = Naming.html_files ct.clt_name in
+      bs b "\n
    ";
+      (* we add a html id, the same as for a type so we can
+         go directly here when the class type name is used as a type name *)
+      bp b ""
+        (Naming.type_target
+           { ty_name = ct.clt_name ;
+             ty_info = None ; ty_parameters = [] ;
+             ty_kind = Type_abstract ; ty_private = Asttypes.Public; ty_manifest = None ;
+             ty_loc = Odoc_info.dummy_loc ;
+             ty_code = None ;
+           }
+        );
+      bs b ((self#keyword "class type")^" ");
+      if ct.clt_virtual then bs b ((self#keyword "virtual")^" ");
+      (
+       match ct.clt_type_parameters with
+        [] -> ()
+      | l ->
+          self#html_of_class_type_param_expr_list b father l;
+          bs b " "
+      );
+
+      if with_link then
+        bp b "%s" html_file (Name.simple ct.clt_name)
+      else
+        bs b (Name.simple ct.clt_name);
+
+      bs b "";
+      bs b " = ";
+      self#html_of_class_type_kind b father ~ct ct.clt_kind;
+      bs b "
    ";
+      (
+       if complete then
+         self#html_of_info ~cls: "classtype top" ~indent: true
+       else
+         self#html_of_info_first_sentence
+      ) b ct.clt_info
+
+    (** Return html code to represent a dag, represented as in Odoc_dag2html. *)
+    method html_of_dag dag =
+      let f n =
+        let (name, cct_opt) = n.Odoc_dag2html.valu in
+        (* if we have a c_opt = Some class then we take its information
+           because we are sure the name is complete. *)
+        let (name2, html_file) =
+          match cct_opt with
+            None -> (name, fst (Naming.html_files name))
+          | Some (Cl c) -> (c.cl_name, fst (Naming.html_files c.cl_name))
+          | Some (Cltype (ct, _)) -> (ct.clt_name, fst (Naming.html_files ct.clt_name))
+        in
+        let new_v =
+          "\n\n
    "^
+          ""^name2^""^
+          "
    \n"
+        in
+        { n with Odoc_dag2html.valu = new_v }
+      in
+      let a = Array.map f dag.Odoc_dag2html.dag in
+      Odoc_dag2html.html_of_dag { Odoc_dag2html.dag = a }
+
+    (** Print html code for a module comment.*)
+    method html_of_module_comment b text =
+      self#html_of_text ~with_p:true b text
+
+    (** Print html code for a class comment.*)
+    method html_of_class_comment b text =
+      (* Add some style if there is no style for the first part of the text. *)
+      let text2 =
+        match text with
+        | (Odoc_info.Raw s) :: q ->
+            (Odoc_info.Title (1, None, [Odoc_info.Raw s])) :: q
+        | _ -> text
+      in
+      self#html_of_text ~with_p:true b text2
+
+    (** Generate html code for the given list of inherited classes.*)
+    method generate_inheritance_info b inher_l =
+      let f inh =
+        match inh.ic_class with
+          None -> (* we can't make the link. *)
+            (Odoc_info.Code inh.ic_name) ::
+            (match inh.ic_text with
+              None -> []
+            | Some t -> (Odoc_info.Raw "    ") :: t)
+        | Some cct ->
+            (* we can create the link. *)
+            let real_name = (* even if it should be the same *)
+              match cct with
+                Cl c -> c.cl_name
+              | Cltype (ct, _) -> ct.clt_name
+            in
+            let (class_file, _) = Naming.html_files real_name in
+            (Odoc_info.Link (class_file, [Odoc_info.Code real_name])) ::
+            (match inh.ic_text with
+              None -> []
+            | Some t -> (Odoc_info.Raw "    ") :: t)
+      in
+      let text = [
+        Odoc_info.Bold [Odoc_info.Raw Odoc_messages.inherits] ;
+        Odoc_info.List (List.map f inher_l)
+      ]
+      in
+      self#html_of_text b text
+
+    (** Generate html code for the inherited classes of the given class. *)
+    method generate_class_inheritance_info b cl =
+      let rec iter_kind k =
+        match k with
+          Class_structure ([], _) ->
+            ()
+        | Class_structure (l, _) ->
+            self#generate_inheritance_info b l
+        | Class_constraint (k, _) ->
+            iter_kind k
+        | Class_apply _
+        | Class_constr _ ->
+            ()
+      in
+      iter_kind cl.cl_kind
+
+    (** Generate html code for the inherited classes of the given class type. *)
+    method generate_class_type_inheritance_info b clt =
+      match clt.clt_kind with
+        Class_signature ([], _) ->
+          ()
+      | Class_signature (l, _) ->
+          self#generate_inheritance_info b l
+      | Class_type _ ->
+          ()
+
+    (** A method to create index files. *)
+    method generate_elements_index :
+        'a.
+        ?strip_libname:bool ->
+          'a list ->
+            ('a -> Odoc_info.Name.t) ->
+              ('a -> Odoc_info.info option) ->
+                ('a -> string) -> string -> string -> unit =
+    fun ?(strip_libname=false) elements name info target title simple_file ->
+      try
+        let chanout = open_out (Filename.concat !Global.target_dir simple_file) in
+        let b = new_buf () in
+        bs b "\n";
+        self#print_header b (self#inner_title title);
+        bs b "\n";
+        self#print_navbar b None None "";
+        bs b "
    ";
+        bs b title;
+        bs b "
    \n" ;
+
+        let sorted_elements = List.sort
+            (fun e1 e2 -> compare (Name.simple (name e1)) (Name.simple (name e2)))
+            elements
+        in
+        let groups = Odoc_info.create_index_lists sorted_elements (fun e -> Name.simple (name e)) in
+        let f_ele e =
+          let simple_name = Name.simple (name e) in
+          let father_name = Name.father (name e) in
+          if strip_libname &&
+               !Odoc_global.library_namespace <> "" &&
+                 father_name = !Odoc_global.library_namespace &&
+                   father_name <> simple_name then
+            (* avoid duplicata *) ()
+          else
+            begin
+          bp b "%s " (target e) (self#escape simple_name);
+          if simple_name <> father_name && father_name <> "" then
+            bp b "[%s]" (fst (Naming.html_files father_name)) father_name;
+          bs b "\n";
+          self#html_of_info_first_sentence b (info e);
+          bs b "\n"
+        end
+        in
+        let f_group l =
+          match l with
+            [] -> ()
+          | e :: _ ->
+              let s =
+                match (Char.uppercase_ascii (Name.simple (name e)).[0]) with
+                  'A'..'Z' as c -> String.make 1 c
+                | _ -> ""
+              in
+              bs b "
    ";
+              bs b s ;
+              bs b "
    \n" ;
+              List.iter f_ele l
+        in
+        bs b "\n";
+        List.iter f_group groups ;
+        bs b "
    \n" ;
+        bs b "\n\n";
+        Buffer.output_buffer chanout b;
+        close_out chanout
+      with
+        Sys_error s ->
+          raise (Failure s)
+
+    (** A method to generate a list of module/class files. *)
+    method generate_elements :
+        'a. ('a option -> 'a option -> 'a -> unit) -> 'a list -> unit =
+      fun f_generate l ->
+        let rec iter pre_opt = function
+            [] -> ()
+          | ele :: [] -> f_generate pre_opt None ele
+          | ele1 :: ele2 :: q ->
+              f_generate pre_opt (Some ele2) ele1 ;
+              iter (Some ele1) (ele2 :: q)
+        in
+        iter None l
+
+    (** Generate the code of the html page for the given class.*)
+    method generate_for_class pre post cl =
+      Odoc_info.reset_type_names ();
+      let (html_file, _) = Naming.html_files cl.cl_name in
+      let type_file = Naming.file_type_class_complete_target cl.cl_name in
+      try
+        let chanout = open_out (Filename.concat !Global.target_dir html_file) in
+        let b = new_buf () in
+        let pre_name = opt (fun c -> c.cl_name) pre in
+        let post_name = opt (fun c -> c.cl_name) post in
+        bs b doctype ;
+        bs b "\n";
+        self#print_header b
+          ~nav: (Some (pre_name, post_name, cl.cl_name))
+          ~comments: (Class.class_comments cl)
+          (self#inner_title cl.cl_name);
+        bs b "\n";
+        self#print_navbar b pre_name post_name cl.cl_name;
+        bs b "
    ";
+        bs b (Odoc_messages.clas^" ");
+        if cl.cl_virtual then bs b "virtual " ;
+        bp b "%s" type_file cl.cl_name;
+        bs b "
    \n";
+        self#html_of_class b ~with_link: false cl;
+        (* parameters *)
+        self#html_of_described_parameter_list b
+          (Name.father cl.cl_name) cl.cl_parameters;
+        (* class inheritance *)
+        self#generate_class_inheritance_info b cl;
+        (* a horizontal line *)
+        bs b "
    \n";
+        (* the various elements *)
+        List.iter (self#html_of_class_element b)
+          (Class.class_elements ~trans:false cl);
+        bs b "\n";
+        Buffer.output_buffer chanout b;
+        close_out chanout;
+
+        (* generate the file with the complete class type *)
+        self#output_class_type
+          cl.cl_name
+          (Filename.concat !Global.target_dir type_file)
+          cl.cl_type
+      with
+        Sys_error s ->
+          raise (Failure s)
+
+    (** Generate the code of the html page for the given class type.*)
+    method generate_for_class_type pre post clt =
+      Odoc_info.reset_type_names ();
+      let (html_file, _) = Naming.html_files clt.clt_name in
+      let type_file = Naming.file_type_class_complete_target clt.clt_name in
+      try
+        let chanout = open_out (Filename.concat !Global.target_dir html_file) in
+        let b = new_buf () in
+        let pre_name = opt (fun ct -> ct.clt_name) pre in
+        let post_name = opt (fun ct -> ct.clt_name) post in
+        bs b doctype ;
+        bs b "\n";
+        self#print_header b
+          ~nav: (Some (pre_name, post_name, clt.clt_name))
+          ~comments: (Class.class_type_comments clt)
+          (self#inner_title clt.clt_name);
+
+        bs b "\n";
+        self#print_navbar b pre_name post_name clt.clt_name;
+        bs b "
    ";
+        bs b (Odoc_messages.class_type^" ");
+        if clt.clt_virtual then bs b "virtual ";
+        bp b "%s" type_file clt.clt_name;
+        bs b "
    \n";
+        self#html_of_class_type b ~with_link: false clt;
+
+        (* class inheritance *)
+        self#generate_class_type_inheritance_info b clt;
+        (* a horizontal line *)
+        bs b "
    \n";
+        (* the various elements *)
+        List.iter (self#html_of_class_element b)
+          (Class.class_type_elements ~trans: false clt);
+        bs b "\n";
+        Buffer.output_buffer chanout b;
+        close_out chanout;
+
+        (* generate the file with the complete class type *)
+        self#output_class_type
+          clt.clt_name
+          (Filename.concat !Global.target_dir type_file)
+          clt.clt_type
+      with
+        Sys_error s ->
+          raise (Failure s)
+
+    (** Generate the html file for the given module type.
+       @raise Failure if an error occurs.*)
+    method generate_for_module_type pre post mt =
+      try
+        let (html_file, _) = Naming.html_files mt.mt_name in
+        let type_file = Naming.file_type_module_complete_target mt.mt_name in
+        let chanout = open_out (Filename.concat !Global.target_dir html_file) in
+        let b = new_buf () in
+        let pre_name = opt (fun mt -> mt.mt_name) pre in
+        let post_name = opt (fun mt -> mt.mt_name) post in
+        bs b doctype ;
+        bs b "\n";
+        self#print_header b
+          ~nav: (Some (pre_name, post_name, mt.mt_name))
+          ~comments: (Module.module_type_comments mt)
+          (self#inner_title mt.mt_name);
+        bs b "\n";
+        self#print_navbar b pre_name post_name mt.mt_name;
+        bp b "
    ";
+        bs b (Odoc_messages.module_type^" ");
+        (
+         match mt.mt_type with
+           Some _ -> bp b "%s" type_file mt.mt_name
+         | None-> bs b mt.mt_name
+        );
+        bs b "
    \n" ;
+        self#html_of_modtype b ~with_link: false mt;
+
+        (* parameters for functors *)
+        self#html_of_module_parameter_list b
+          (Name.father mt.mt_name)
+          (Module.module_type_parameters mt);
+        (* a horizontal line *)
+        bs b "
    \n";
+        (* module elements *)
+        List.iter
+          (self#html_of_module_element b mt.mt_name)
+          (Module.module_type_elements mt);
+
+        bs b "\n";
+        Buffer.output_buffer chanout b;
+        close_out chanout;
+
+        (* generate html files for submodules *)
+        self#generate_elements self#generate_for_module (Module.module_type_modules mt);
+        (* generate html files for module types *)
+        self#generate_elements self#generate_for_module_type (Module.module_type_module_types mt);
+        (* generate html files for classes *)
+        self#generate_elements self#generate_for_class (Module.module_type_classes mt);
+        (* generate html files for class types *)
+        self#generate_elements self#generate_for_class_type (Module.module_type_class_types mt);
+
+        (* generate the file with the complete module type *)
+        (
+         match mt.mt_type with
+           None -> ()
+         | Some mty ->
+             self#output_module_type
+               mt.mt_name
+               (Filename.concat !Global.target_dir type_file)
+               mty
+        )
+      with
+        Sys_error s ->
+          raise (Failure s)
+
+    (** Generate the html file for the given module.
+       @raise Failure if an error occurs.*)
+    method generate_for_module pre post modu =
+      try
+        Odoc_info.verbose ("Generate for module "^modu.m_name);
+        let (html_file, _) = Naming.html_files modu.m_name in
+        let type_file = Naming.file_type_module_complete_target modu.m_name in
+        let code_file = Naming.file_code_module_complete_target modu.m_name in
+        let chanout = open_out (Filename.concat !Global.target_dir html_file) in
+        let b = new_buf () in
+        let pre_name = opt (fun m -> m.m_name) pre in
+        let post_name = opt (fun m -> m.m_name) post in
+        bs b doctype ;
+        bs b "\n";
+        self#print_header b
+          ~nav: (Some (pre_name, post_name, modu.m_name))
+          ~comments: (Module.module_comments modu)
+          (self#inner_title modu.m_name);
+        bs b "\n" ;
+        self#print_navbar b pre_name post_name modu.m_name ;
+        bs b "
    ";
+        if modu.m_text_only then
+          bs b modu.m_name
+        else
+          (
+           bs b
+             (
+              if Module.module_is_functor modu then
+                Odoc_messages.functo
+              else
+                Odoc_messages.modul
+             );
+           bp b " %s" type_file modu.m_name;
+           (
+            match modu.m_code with
+              None -> ()
+            | Some _ -> bp b " (.ml)" code_file
+           )
+          );
+        bs b "
    \n";
+
+        if not modu.m_text_only then
+          self#html_of_module b ~with_link: false modu
+        else
+          self#html_of_info ~indent:false b modu.m_info;
+
+        (* parameters for functors *)
+        self#html_of_module_parameter_list b
+          (Name.father modu.m_name)
+          (Module.module_parameters modu);
+
+        (* a horizontal line *)
+        if not modu.m_text_only then bs b "
    \n";
+
+        (* module elements *)
+        List.iter
+          (self#html_of_module_element b modu.m_name)
+          (Module.module_elements modu);
+
+        bs b "\n";
+        Buffer.output_buffer chanout b;
+        close_out chanout;
+
+        (* generate html files for submodules *)
+        self#generate_elements  self#generate_for_module (Module.module_modules modu);
+        (* generate html files for module types *)
+        self#generate_elements  self#generate_for_module_type (Module.module_module_types modu);
+        (* generate html files for classes *)
+        self#generate_elements  self#generate_for_class (Module.module_classes modu);
+        (* generate html files for class types *)
+        self#generate_elements  self#generate_for_class_type (Module.module_class_types modu);
+
+        (* generate the file with the complete module type *)
+        self#output_module_type
+          modu.m_name
+          (Filename.concat !Global.target_dir type_file)
+          modu.m_type;
+
+        match modu.m_code with
+          None -> ()
+        | Some code ->
+            self#output_code ~with_pre:false
+              modu.m_name
+              (Filename.concat !Global.target_dir code_file)
+              code
+      with
+        Sys_error s ->
+          raise (Failure s)
+
+    (** Generate the [.html] file corresponding to the given module list.
+       @raise Failure if an error occurs.*)
+    method generate_index module_list =
+      try
+        let chanout = open_out (Filename.concat !Global.target_dir self#index) in
+        let b = new_buf () in
+        bs b doctype ;
+        bs b "\n";
+        self#print_header b self#title;
+        bs b "\n";
+
+        (
+        match !Global.title with
+        | None -> ()
+        | Some t ->
+            bs b "
    ";
+            bs b (self#escape t);
+            bs b "
    \n"
+        );
+
+        let info = Odoc_info.apply_opt
+            (Odoc_info.info_of_comment_file module_list)
+            !Odoc_info.Global.intro_file
+        in
+        (
+         match info with
+           None ->
+             bs b "
    \n";
+             self#html_of_Index_list b;
+             bs b "
    \n";
+             self#html_of_Module_list b
+               (List.map (fun m -> m.m_name) module_list);
+         | Some _ -> self#html_of_info ~indent: false b info
+        );
+        bs b "\n\n";
+        Buffer.output_buffer chanout b;
+        close_out chanout
+      with
+        Sys_error s ->
+          raise (Failure s)
+
+    (** Generate the values index in the file [index_values.html]. *)
+    method generate_values_index _module_list =
+      self#generate_elements_index
+        self#list_values
+        (fun v -> v.val_name)
+        (fun v -> v.val_info)
+        Naming.complete_value_target
+        Odoc_messages.index_of_values
+        self#index_values
+
+    (** Generate the extensions index in the file [index_extensions.html]. *)
+    method generate_extensions_index _module_list =
+      self#generate_elements_index
+        self#list_extensions
+        (fun x -> x.xt_name)
+        (fun x -> x.xt_type_extension.te_info)
+        (fun x -> Naming.complete_extension_target x)
+        Odoc_messages.index_of_extensions
+        self#index_extensions
+
+    (** Generate the exceptions index in the file [index_exceptions.html]. *)
+    method generate_exceptions_index _module_list =
+      self#generate_elements_index
+        self#list_exceptions
+        (fun e -> e.ex_name)
+        (fun e -> e.ex_info)
+        Naming.complete_exception_target
+        Odoc_messages.index_of_exceptions
+        self#index_exceptions
+
+    (** Generate the types index in the file [index_types.html]. *)
+    method generate_types_index _module_list =
+      self#generate_elements_index
+        self#list_types
+        (fun t -> t.ty_name)
+        (fun t -> t.ty_info)
+        Naming.complete_type_target
+        Odoc_messages.index_of_types
+        self#index_types
+
+    (** Generate the attributes index in the file [index_attributes.html]. *)
+    method generate_attributes_index _module_list =
+      self#generate_elements_index
+        self#list_attributes
+        (fun a -> a.att_value.val_name)
+        (fun a -> a.att_value.val_info)
+        Naming.complete_attribute_target
+        Odoc_messages.index_of_attributes
+        self#index_attributes
+
+    (** Generate the methods index in the file [index_methods.html]. *)
+    method generate_methods_index _module_list =
+      self#generate_elements_index
+        self#list_methods
+        (fun m -> m.met_value.val_name)
+        (fun m -> m.met_value.val_info)
+        Naming.complete_method_target
+        Odoc_messages.index_of_methods
+        self#index_methods
+
+    (** Generate the classes index in the file [index_classes.html]. *)
+    method generate_classes_index _module_list =
+      self#generate_elements_index
+        self#list_classes
+        (fun c -> c.cl_name)
+        (fun c -> c.cl_info)
+        (fun c -> fst (Naming.html_files c.cl_name))
+        Odoc_messages.index_of_classes
+        self#index_classes
+
+    (** Generate the class types index in the file [index_class_types.html]. *)
+    method generate_class_types_index _module_list =
+      self#generate_elements_index
+        self#list_class_types
+        (fun ct -> ct.clt_name)
+        (fun ct -> ct.clt_info)
+        (fun ct -> fst (Naming.html_files ct.clt_name))
+        Odoc_messages.index_of_class_types
+        self#index_class_types
+
+    (** Generate the modules index in the file [index_modules.html]. *)
+    method generate_modules_index _module_list =
+      self#generate_elements_index
+        ~strip_libname:true
+        self#list_modules
+        (fun m -> m.m_name)
+        (fun m -> m.m_info)
+        (fun m -> fst (Naming.html_files m.m_name))
+        Odoc_messages.index_of_modules
+        self#index_modules
+
+    (** Generate the module types index in the file [index_module_types.html]. *)
+    method generate_module_types_index _module_list =
+      self#generate_elements_index
+        self#list_module_types
+        (fun mt -> mt.mt_name)
+        (fun mt -> mt.mt_info)
+        (fun mt -> fst (Naming.html_files mt.mt_name))
+        Odoc_messages.index_of_module_types
+        self#index_module_types
+
+    (** Generate all the html files from a module list. The main
+       file is [.html]. *)
+    method generate module_list =
+      (* init the style *)
+      self#init_style ;
+      (* init the lists of elements *)
+      list_values <- Odoc_info.Search.values module_list ;
+      list_extensions <- Odoc_info.Search.extensions module_list ;
+      list_exceptions <- Odoc_info.Search.exceptions module_list ;
+      list_types <- Odoc_info.Search.types module_list ;
+      list_attributes <- Odoc_info.Search.attributes module_list ;
+      list_methods <- Odoc_info.Search.methods module_list ;
+      list_classes <- Odoc_info.Search.classes module_list ;
+      list_class_types <- Odoc_info.Search.class_types module_list ;
+      list_modules <- Odoc_info.Search.modules module_list ;
+      list_module_types <- Odoc_info.Search.module_types module_list ;
+
+      (* prepare the page header *)
+      self#prepare_header module_list ;
+      (* Get the names of all known types. *)
+      let types = Odoc_info.Search.types module_list in
+      known_types_names <-
+        List.fold_left
+          (fun acc t -> String.Set.add t.ty_name acc)
+          known_types_names
+          types ;
+      (* Get the names of all class and class types. *)
+      let classes = Odoc_info.Search.classes module_list in
+      let class_types = Odoc_info.Search.class_types module_list in
+      known_classes_names <-
+        List.fold_left
+          (fun acc c -> String.Set.add c.cl_name acc)
+          known_classes_names
+          classes ;
+      known_classes_names <-
+        List.fold_left
+          (fun acc ct -> String.Set.add ct.clt_name acc)
+          known_classes_names
+          class_types ;
+      (* Get the names of all known modules and module types. *)
+      let module_types = Odoc_info.Search.module_types module_list in
+      let modules = Odoc_info.Search.modules module_list in
+      known_modules_names <-
+        List.fold_left
+          (fun acc m -> String.Set.add m.m_name acc)
+          known_modules_names
+          modules ;
+      known_modules_names <-
+        List.fold_left
+          (fun acc mt -> String.Set.add mt.mt_name acc)
+          known_modules_names
+          module_types ;
+      (* generate html for each module *)
+      if not !index_only then
+        self#generate_elements self#generate_for_module module_list ;
+
+      try
+        self#generate_index module_list;
+        self#generate_values_index module_list ;
+        self#generate_extensions_index module_list ;
+        self#generate_exceptions_index module_list ;
+        self#generate_types_index module_list ;
+        self#generate_attributes_index module_list ;
+        self#generate_methods_index module_list ;
+        self#generate_classes_index module_list ;
+        self#generate_class_types_index module_list ;
+        self#generate_modules_index module_list ;
+        self#generate_module_types_index module_list ;
+      with
+        Failure s ->
+          prerr_endline s ;
+          incr Odoc_info.errors
+
+    initializer
+      Odoc_ocamlhtml.html_of_comment :=
+        (fun s ->
+          let b = new_buf () in
+          self#html_of_text b (Odoc_text.Texter.text_of_string s);
+          Buffer.contents b
+        )
+  end
+end
+
+module type Html_generator = module type of Generator
diff --git a/ocamldoc/odoc_index.html b/ocamldoc/odoc_index.html
new file mode 100644
index 00000000..de9c9acf
--- /dev/null
+++ b/ocamldoc/odoc_index.html
@@ -0,0 +1,40 @@
+
+
+  
+    Libraries distributed with OCaml
+    
+    
+    
+    
+  
+  
+    
    The following libraries are distributed with the OCaml distribution.
    
+    
    
+    
+      
+        
+        
+      
+      
+        
+        
+      
+      
+        
+        
+      
+      
+        
+        
+      
+      
+        
+        
+      
+      
+        
+        
+      
+    
    stdlibThe OCaml Standard library.
    unixSystem programming.
    bigarrayLarge, multi-dimensional, numerical arrays.
    strRegular expressions.
    parsingThe OCaml compiler parsing frontend.
    numArbitrary precision integers (deprecated).
    
+  
+
diff --git a/ocamldoc/odoc_info.ml b/ocamldoc/odoc_info.ml
new file mode 100644
index 00000000..19d04314
--- /dev/null
+++ b/ocamldoc/odoc_info.ml
@@ -0,0 +1,338 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Interface for analysing documented OCaml source files and to the collected information. *)
+
+type ref_kind = Odoc_types.ref_kind =
+    RK_module
+  | RK_module_type
+  | RK_class
+  | RK_class_type
+  | RK_value
+  | RK_type
+  | RK_extension
+  | RK_exception
+  | RK_attribute
+  | RK_method
+  | RK_section of text
+  | RK_recfield
+  | RK_const
+
+and text_element = Odoc_types.text_element =
+  | Raw of string
+  | Code of string
+  | CodePre of string
+  | Verbatim of string
+  | Bold of text
+  | Italic of text
+  | Emphasize of text
+  | Center of text
+  | Left of text
+  | Right of text
+  | List of text list
+  | Enum of text list
+  | Newline
+  | Block of text
+  | Title of int * string option * text
+  | Latex of string
+  | Link of string * text
+  | Ref of string * ref_kind option * text option
+  | Superscript of text
+  | Subscript of text
+  | Module_list of string list
+  | Index_list
+  | Custom of string * text
+  | Target of string * string
+
+and text = text_element list
+
+exception Text_syntax = Odoc_text.Text_syntax
+
+type see_ref = Odoc_types.see_ref =
+    See_url of string
+  | See_file of string
+  | See_doc of string
+
+type see = see_ref * text
+
+type param = (string * text)
+
+type raised_exception = (string * text)
+
+type info = Odoc_types.info = {
+    i_desc : text option;
+    i_authors : string list;
+    i_version : string option;
+    i_sees : see list;
+    i_since : string option;
+    i_before : (string * text) list ;
+    i_deprecated : text option;
+    i_params : param list;
+    i_raised_exceptions : raised_exception list;
+    i_return_value : text option ;
+    i_custom : (string * text) list ;
+  }
+
+type location = Odoc_types.location = {
+    loc_impl : Location.t option ;
+    loc_inter : Location.t option ;
+  }
+
+let dummy_loc = { loc_impl = None ; loc_inter = None }
+
+module Name = Odoc_name
+module Parameter = Odoc_parameter
+module Extension = Odoc_extension
+module Exception = Odoc_exception
+module Type = Odoc_type
+module Value = Odoc_value
+module Class = Odoc_class
+module Module = Odoc_module
+
+
+let analyse_files
+    ?(merge_options=([] : Odoc_types.merge_option list))
+    ?(include_dirs=([] : string list))
+    ?(labels=false)
+    ?(sort_modules=false)
+    ?(no_stop=false)
+    ?(init=[])
+    files =
+  Odoc_global.merge_options := merge_options;
+  Odoc_global.include_dirs := include_dirs;
+  Odoc_global.classic := not labels;
+  Odoc_global.sort_modules := sort_modules;
+  Odoc_global.no_stop := no_stop;
+  Odoc_analyse.analyse_files ~init: init files
+
+let dump_modules = Odoc_analyse.dump_modules
+
+let load_modules = Odoc_analyse.load_modules
+
+let reset_type_names = Printtyp.reset
+
+let string_of_variance t (co,cn) = Odoc_str.string_of_variance t (co, cn)
+
+let string_of_type_expr t = Odoc_print.string_of_type_expr t
+
+let string_of_class_params = Odoc_str.string_of_class_params
+
+let string_of_type_list ?par sep type_list = Odoc_str.string_of_type_list ?par sep type_list
+
+let string_of_type_param_list t = Odoc_str.string_of_type_param_list t
+
+let string_of_type_extension_param_list te = Odoc_str.string_of_type_extension_param_list te
+
+let string_of_class_type_param_list l = Odoc_str.string_of_class_type_param_list l
+
+let string_of_module_type = Odoc_print.string_of_module_type
+
+let string_of_class_type = Odoc_print.string_of_class_type
+
+let string_of_text t = Odoc_misc.string_of_text t
+
+let string_of_info i = Odoc_misc.string_of_info i
+
+let string_of_type t = Odoc_str.string_of_type t
+let string_of_record t = Odoc_str.string_of_record t
+
+let string_of_type_extension te = Odoc_str.string_of_type_extension te
+
+let string_of_exception e = Odoc_str.string_of_exception e
+
+let string_of_value v = Odoc_str.string_of_value v
+
+let string_of_attribute att = Odoc_str.string_of_attribute att
+
+let string_of_method m = Odoc_str.string_of_method m
+
+let first_sentence_of_text = Odoc_misc.first_sentence_of_text
+
+let first_sentence_and_rest_of_text = Odoc_misc.first_sentence_and_rest_of_text
+
+let text_no_title_no_list = Odoc_misc.text_no_title_no_list
+
+let text_concat = Odoc_misc.text_concat
+
+let get_titles_in_text = Odoc_misc.get_titles_in_text
+
+let create_index_lists = Odoc_misc.create_index_lists
+
+let remove_ending_newline = Odoc_misc.remove_ending_newline
+
+let remove_option = Odoc_misc.remove_option
+
+let is_optional = Odoc_misc.is_optional
+
+let label_name = Odoc_misc.label_name
+
+let use_hidden_modules n =
+  Odoc_name.hide_given_modules !Odoc_global.hidden_modules n
+
+let verbose s =
+  if !Odoc_global.verbose then
+    (print_string s ; print_newline ())
+  else
+    ()
+
+let warning s = Odoc_global.pwarning s
+let print_warnings = Odoc_config.print_warnings
+
+let errors = Odoc_global.errors
+
+let apply_opt = Odoc_misc.apply_opt
+
+let apply_if_equal f v1 v2 =
+  if v1 = v2 then
+    f v1
+  else
+    v2
+
+let text_of_string = Odoc_text.Texter.text_of_string
+
+let text_string_of_text = Odoc_text.Texter.string_of_text
+
+
+let escape_arobas s =
+  let len = String.length s in
+  let b = Buffer.create len in
+  for i = 0 to len - 1 do
+    match s.[i] with
+      '@' -> Buffer.add_string b "\\@"
+    | c -> Buffer.add_char b c
+  done;
+  Buffer.contents b
+
+let info_string_of_info i =
+  let b = Buffer.create 256 in
+  let p = Printf.bprintf in
+  (
+   match i.i_desc with
+     None -> ()
+   | Some t -> p b "%s" (escape_arobas (text_string_of_text t))
+  );
+  List.iter
+    (fun s -> p b "\n@@author %s" (escape_arobas s))
+    i.i_authors;
+  (
+   match i.i_version with
+     None -> ()
+   | Some s -> p b "\n@@version %s" (escape_arobas s)
+  );
+  (
+   (* TODO: escape characters ? *)
+   let f_see_ref = function
+       See_url s -> Printf.sprintf "<%s>" s
+     | See_file s -> Printf.sprintf "'%s'" s
+     | See_doc s -> Printf.sprintf "\"%s\"" s
+   in
+   List.iter
+     (fun (sref, t) ->
+       p b "\n@@see %s %s"
+         (escape_arobas (f_see_ref sref))
+         (escape_arobas (text_string_of_text t))
+     )
+     i.i_sees
+  );
+  (
+   match i.i_since with
+     None -> ()
+   | Some s -> p b "\n@@since %s" (escape_arobas s)
+  );
+  (
+   match i.i_deprecated with
+     None -> ()
+   | Some t ->
+       p b "\n@@deprecated %s"
+         (escape_arobas (text_string_of_text t))
+  );
+  List.iter
+    (fun (s, t) ->
+      p b "\n@@param %s %s"
+        (escape_arobas s)
+        (escape_arobas (text_string_of_text t))
+    )
+    i.i_params;
+  List.iter
+    (fun (s, t) ->
+      p b "\n@@raise %s %s"
+        (escape_arobas s)
+        (escape_arobas (text_string_of_text t))
+    )
+    i.i_raised_exceptions;
+  (
+   match i.i_return_value with
+     None -> ()
+   | Some t ->
+       p b "\n@@return %s"
+         (escape_arobas (text_string_of_text t))
+  );
+  List.iter
+    (fun (s, t) ->
+      p b "\n@@%s %s" s
+        (escape_arobas (text_string_of_text t))
+    )
+    i.i_custom;
+
+  Buffer.contents b
+
+let info_of_string = Odoc_comments.info_of_string
+let info_of_comment_file = Odoc_comments.info_of_comment_file
+
+module Search =
+  struct
+    type result_element = Odoc_search.result_element =
+          Res_module of Module.t_module
+        | Res_module_type of Module.t_module_type
+        | Res_class of Class.t_class
+        | Res_class_type of Class.t_class_type
+        | Res_value of Value.t_value
+        | Res_type of Type.t_type
+        | Res_extension of Extension.t_extension_constructor
+        | Res_exception of Exception.t_exception
+        | Res_attribute of Value.t_attribute
+        | Res_method of Value.t_method
+        | Res_section of string * text
+        | Res_recfield of Type.t_type * Type.record_field
+        | Res_const of Type.t_type * Type.variant_constructor
+
+    type search_result = result_element list
+
+    let search_by_name = Odoc_search.Search_by_name.search
+
+    let values = Odoc_search.values
+    let extensions = Odoc_search.extensions
+    let exceptions = Odoc_search.exceptions
+    let types = Odoc_search.types
+    let attributes = Odoc_search.attributes
+    let methods = Odoc_search.methods
+    let classes = Odoc_search.classes
+    let class_types = Odoc_search.class_types
+    let modules = Odoc_search.modules
+    let module_types = Odoc_search.module_types
+  end
+
+module Scan =
+  struct
+    class scanner = Odoc_scan.scanner
+  end
+
+module Dep =
+  struct
+    let kernel_deps_of_modules = Odoc_dep.kernel_deps_of_modules
+    let deps_of_types = Odoc_dep.deps_of_types
+  end
+
+module Global = Odoc_global
diff --git a/ocamldoc/odoc_info.mli b/ocamldoc/odoc_info.mli
new file mode 100644
index 00000000..006a28b9
--- /dev/null
+++ b/ocamldoc/odoc_info.mli
@@ -0,0 +1,1097 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Interface to the information collected in source files. *)
+
+(** The different kinds of element references. *)
+type ref_kind = Odoc_types.ref_kind =
+    RK_module
+  | RK_module_type
+  | RK_class
+  | RK_class_type
+  | RK_value
+  | RK_type
+  | RK_extension
+  | RK_exception
+  | RK_attribute
+  | RK_method
+  | RK_section of text
+  | RK_recfield
+  | RK_const
+
+and text_element = Odoc_types.text_element =
+  | Raw of string (** Raw text. *)
+  | Code of string (** The string is source code. *)
+  | CodePre of string (** The string is pre-formatted source code. *)
+  | Verbatim of string (** String 'as is'. *)
+  | Bold of text (** Text in bold style. *)
+  | Italic of text (** Text in italic. *)
+  | Emphasize of text (** Emphasized text. *)
+  | Center of text (** Centered text. *)
+  | Left of text (** Left alignment. *)
+  | Right of text (** Right alignment. *)
+  | List of text list (** A list. *)
+  | Enum of text list (** An enumerated list. *)
+  | Newline   (** To force a line break. *)
+  | Block of text (** Like html's block quote. *)
+  | Title of int * string option * text
+             (** Style number, optional label, and text. *)
+  | Latex of string (** A string for latex. *)
+  | Link of string * text (** A reference string and the link text. *)
+  | Ref of string * ref_kind option * text option
+       (** A reference to an element. Complete name and kind.
+        An optional text can be given to display this text instead
+        of the element name.*)
+  | Superscript of text (** Superscripts. *)
+  | Subscript of text (** Subscripts. *)
+  | Module_list of string list
+       (** The table of the given modules with their abstract. *)
+  | Index_list (** The links to the various indexes (values, types, ...) *)
+  | Custom of string * text (** to extend \{foo syntax *)
+  | Target of string * string (** (target, code) : to specify code specific to a target format *)
+
+(** A text is a list of [text_element]. The order matters. *)
+and text = text_element list
+
+(** The different forms of references in \@see tags. *)
+type see_ref = Odoc_types.see_ref =
+    See_url of string
+  | See_file of string
+  | See_doc of string
+
+(** Raised when parsing string to build a {!Odoc_info.text}
+   structure. [(line, char, string)] *)
+exception Text_syntax of int * int * string
+
+(** The information in a \@see tag. *)
+type see = see_ref * text
+
+(** Parameter name and description. *)
+type param = (string * text)
+
+(** Raised exception name and description. *)
+type raised_exception = (string * text)
+
+(** Information in a special comment
+@before 3.12.0 \@before information was not present.
+*)
+type info = Odoc_types.info = {
+    i_desc : text option; (** The description text. *)
+    i_authors : string list; (** The list of authors in \@author tags. *)
+    i_version : string option; (** The string in the \@version tag. *)
+    i_sees : see list; (** The list of \@see tags. *)
+    i_since : string option; (** The string in the \@since tag. *)
+    i_before : (string * text) list ; (** the version number and text in \@before tag *)
+    i_deprecated : text option; (** The description text of the \@deprecated tag. *)
+    i_params : param list; (** The list of parameter descriptions. *)
+    i_raised_exceptions : raised_exception list; (** The list of raised exceptions. *)
+    i_return_value : text option; (** The description text of the return value. *)
+    i_custom : (string * text) list ; (** A text associated to a custom @-tag. *)
+  }
+
+(** Location of elements in implementation and interface files. *)
+type location = Odoc_types.location = {
+    loc_impl : Location.t option ; (** implementation location *)
+    loc_inter : Location.t option ; (** interface location *)
+  }
+
+(** A dummy location. *)
+val dummy_loc : location
+
+(** Representation of element names. *)
+module Name :
+    sig
+      type t = string
+
+      (** Access to the simple name. *)
+      val simple : t -> t
+
+      (** [concat t1 t2] returns the concatenation of [t1] and [t2].*)
+      val concat : t -> t -> t
+
+      (** Return the depth of the name, i.e. the number of levels to the root.
+         Example : [depth "Toto.Tutu.name"] = [3]. *)
+      val depth : t -> int
+
+      (** Take two names n1 and n2 = n3.n4 and return n4 if n3=n1 or else n2. *)
+      val get_relative : t -> t -> t
+
+      (** Take two names n1 and n2 = n3.n4 and return n4 if n3=n1 and n1<>"" or else n2. *)
+      val get_relative_opt : t -> t -> t
+
+
+      (** Return the name of the 'father' (like [dirname] for a file name).*)
+      val father : t -> t
+    end
+
+(** Representation and manipulation of method / function / class / module parameters.*)
+module Parameter :
+  sig
+    (** {1 Types} *)
+
+    (** Representation of a simple parameter name *)
+    type simple_name = Odoc_parameter.simple_name =
+        {
+          sn_name : string ;
+          sn_type : Types.type_expr ;
+          mutable sn_text : text option ;
+        }
+
+    (** Representation of parameter names. We need it to represent parameter names in tuples.
+       The value [Tuple ([], t)] stands for an anonymous parameter.*)
+    type param_info = Odoc_parameter.param_info =
+        Simple_name of simple_name
+      | Tuple of param_info list * Types.type_expr
+
+    (** A parameter is just a param_info.*)
+    type parameter = param_info
+
+    (** {1 Functions} *)
+
+    (** Access to the name as a string. For tuples, parentheses and commas are added. *)
+    val complete_name : parameter -> string
+
+    (** Access to the complete type. *)
+    val typ : parameter -> Types.type_expr
+
+    (** Access to the list of names ; only one for a simple parameter, or
+       a list for a tuple. *)
+    val names : parameter -> string list
+
+    (** Access to the description of a specific name.
+       @raise Not_found if no description is associated to the given name. *)
+    val desc_by_name : parameter -> string -> text option
+
+    (** Access to the type of a specific name.
+       @raise Not_found if no type is associated to the given name. *)
+    val type_by_name : parameter -> string -> Types.type_expr
+  end
+
+(** Representation and manipulation of extensions. *)
+module Extension :
+  sig
+    type private_flag = Odoc_extension.private_flag =
+      Private | Public
+
+    (** Used when the extension is a rebind of another extension,
+       when we have [extension Xt = Target_xt].*)
+    type extension_alias = Odoc_extension.extension_alias =
+        {
+          xa_name : Name.t ; (** The complete name of the target extension. *)
+          mutable xa_xt : t_extension_constructor option ; (** The target extension, if we found it.*)
+        }
+
+    and t_extension_constructor = Odoc_extension.t_extension_constructor =
+        {
+          xt_name : Name.t ;
+          xt_args: Odoc_type.constructor_args;
+          xt_ret: Types.type_expr option ; (** the optional return type of the extension *)
+          xt_type_extension: t_type_extension ; (** the type extension containing this constructor *)
+          xt_alias: extension_alias option ; (** [None] when the extension is not a rebind. *)
+          mutable xt_loc: Odoc_types.location ;
+          mutable xt_text: Odoc_types.info option ; (** optional user description *)
+        }
+
+    and t_type_extension = Odoc_extension.t_type_extension =
+        {
+          mutable te_info : info option ; (** Information found in the optional associated comment. *)
+          te_type_name : Name.t ; (** The type of the extension *)
+          te_type_parameters : Types.type_expr list;
+          te_private : private_flag ;
+          mutable te_constructors: t_extension_constructor list;
+          mutable te_loc : location ;
+          mutable te_code : string option ;
+        }
+
+    (** Access to the extensions in a group. *)
+    val extension_constructors : t_type_extension -> t_extension_constructor list
+
+  end
+
+(** Representation and manipulation of exceptions. *)
+module Exception :
+  sig
+    (** Used when the exception is a rebind of another exception,
+       when we have [exception Ex = Target_ex].*)
+    type exception_alias = Odoc_exception.exception_alias =
+        {
+          ea_name : Name.t ; (** The complete name of the target exception. *)
+          mutable ea_ex : t_exception option ; (** The target exception, if we found it.*)
+        }
+
+    and t_exception = Odoc_exception.t_exception =
+        {
+          ex_name : Name.t ;
+          mutable ex_info : info option ; (** Information found in the optional associated comment. *)
+          ex_args : Odoc_type.constructor_args;
+          ex_ret : Types.type_expr option ; (** The optional return type of the exception. *)
+          ex_alias : exception_alias option ; (** [None] when the exception is not a rebind. *)
+          mutable ex_loc : location ;
+          mutable ex_code : string option ;
+        }
+  end
+
+(** Representation and manipulation of types.*)
+module Type :
+  sig
+    type private_flag = Odoc_type.private_flag =
+      Private | Public
+
+    (** Description of a record type field. *)
+    type record_field = Odoc_type.record_field =
+        {
+          rf_name : string ; (** Name of the field. *)
+          rf_mutable : bool ; (** [true] if mutable. *)
+          rf_type : Types.type_expr ; (** Type of the field. *)
+          mutable rf_text : info option ; (** Optional description in the associated comment.*)
+        }
+
+    (** Description of a variant type constructor. *)
+    type constructor_args = Odoc_type.constructor_args =
+      | Cstr_record of record_field list
+      | Cstr_tuple of Types.type_expr list
+
+    type variant_constructor = Odoc_type.variant_constructor =
+        {
+          vc_name : string ; (** Name of the constructor. *)
+          vc_args : constructor_args;
+          vc_ret : Types.type_expr option ;
+          mutable vc_text : info option ; (** Optional description in the associated comment. *)
+        }
+
+    (** The various kinds of a type. *)
+    type type_kind = Odoc_type.type_kind =
+        Type_abstract (** Type is abstract, for example [type t]. *)
+      | Type_variant of variant_constructor list
+                   (** constructors *)
+      | Type_record of record_field list
+                   (** fields *)
+      | Type_open (** Type is open *)
+
+    type object_field = Odoc_type.object_field = {
+      of_name : string ;
+      of_type : Types.type_expr ;
+      mutable of_text : Odoc_types.info option ; (** optional user description *)
+    }
+
+    type type_manifest = Odoc_type.type_manifest =
+      | Other of Types.type_expr (** Type manifest directly taken from Typedtree. *)
+      | Object_type of object_field list
+
+    (** Representation of a type. *)
+    type t_type = Odoc_type.t_type =
+        {
+          ty_name : Name.t ; (** Complete name of the type. *)
+          mutable ty_info : info option ; (** Information found in the optional associated comment. *)
+          ty_parameters : (Types.type_expr * bool * bool) list ;
+                    (** type parameters: (type, covariant, contravariant) *)
+          ty_kind : type_kind; (** Type kind. *)
+          ty_private : private_flag; (** Private or public type. *)
+          ty_manifest : type_manifest option ;
+          mutable ty_loc : location ;
+          mutable ty_code : string option;
+        }
+
+  end
+
+(** Representation and manipulation of values, class attributes and class methods. *)
+module Value :
+  sig
+    (** Representation of a value. *)
+    type t_value = Odoc_value.t_value =
+        {
+          val_name : Name.t ; (** Complete name of the value. *)
+          mutable val_info : info option ; (** Information found in the optional associated comment. *)
+          val_type : Types.type_expr ; (** Type of the value. *)
+          val_recursive : bool ; (** [true] if the value is recursive. *)
+          mutable val_parameters : Odoc_parameter.parameter list ; (** The parameters, if any. *)
+          mutable val_code : string option ; (** The code of the value, if we had the only the implementation file. *)
+          mutable val_loc : location ;
+        }
+
+    (** Representation of a class attribute. *)
+    type t_attribute = Odoc_value.t_attribute =
+        {
+          att_value : t_value ; (** an attribute has almost all the same information as a value *)
+          att_mutable : bool ;  (** [true] if the attribute is mutable. *)
+          att_virtual : bool ;  (** [true] if the attribute is virtual. *)
+        }
+
+    (** Representation of a class method. *)
+    type t_method = Odoc_value.t_method =
+        {
+          met_value : t_value ; (** a method has almost all the same information as a value *)
+          met_private : bool ;  (** [true] if the method is private.*)
+          met_virtual : bool ;  (** [true] if the method is virtual. *)
+        }
+
+    (** Return [true] if the value is a function, i.e. it has a functional type. *)
+    val is_function : t_value -> bool
+
+    (** Access to the description associated to the given parameter name.*)
+    val value_parameter_text_by_name : t_value -> string -> text option
+  end
+
+(** Representation and manipulation of classes and class types.*)
+module Class :
+  sig
+    (** {1 Types} *)
+
+    (** To keep the order of elements in a class. *)
+    type class_element = Odoc_class.class_element =
+        Class_attribute of Value.t_attribute
+      | Class_method of Value.t_method
+      | Class_comment of text
+
+    (** Used when we can reference a t_class or a t_class_type. *)
+    type cct = Odoc_class.cct =
+        Cl of t_class
+      | Cltype of t_class_type * Types.type_expr list (** Class type and type parameters. *)
+
+    and inherited_class = Odoc_class.inherited_class =
+        {
+          ic_name : Name.t ; (** Complete name of the inherited class. *)
+          mutable ic_class : cct option ; (** The associated t_class or t_class_type. *)
+          ic_text : text option ; (** The inheritance description, if any. *)
+        }
+
+    and class_apply = Odoc_class.class_apply =
+        {
+          capp_name : Name.t ; (** The complete name of the applied class. *)
+          mutable capp_class : t_class option;  (** The associated t_class if we found it. *)
+          capp_params : Types.type_expr list; (** The type of expressions the class is applied to. *)
+          capp_params_code : string list ; (** The code of these expressions. *)
+        }
+
+    and class_constr = Odoc_class.class_constr =
+        {
+          cco_name : Name.t ; (** The complete name of the applied class. *)
+          mutable cco_class : cct option;
+              (** The associated class or class type if we found it. *)
+          cco_type_parameters : Types.type_expr list; (** The type parameters of the class, if needed. *)
+        }
+
+    and class_kind = Odoc_class.class_kind =
+        Class_structure of inherited_class list * class_element list
+        (** An explicit class structure, used in implementation and interface. *)
+      | Class_apply of class_apply
+        (** Application/alias of a class, used in implementation only. *)
+      | Class_constr of class_constr
+        (** A class used to give the type of the defined class,
+           instead of a structure, used in interface only.
+           For example, it will be used with the name [M1.M2....bar]
+           when the class foo is defined like this :
+           [class foo : int -> bar] *)
+      | Class_constraint of class_kind * class_type_kind
+        (** A class definition with a constraint. *)
+
+    (** Representation of a class. *)
+    and t_class = Odoc_class.t_class =
+        {
+          cl_name : Name.t ; (** Complete name of the class. *)
+          mutable cl_info : info option ; (** Information found in the optional associated comment. *)
+          cl_type : Types.class_type ; (** Type of the class. *)
+          cl_type_parameters : Types.type_expr list ; (** Type parameters. *)
+          cl_virtual : bool ; (** [true] when the class is virtual. *)
+          mutable cl_kind : class_kind ; (** The way the class is defined. *)
+          mutable cl_parameters : Parameter.parameter list ; (** The parameters of the class. *)
+          mutable cl_loc : location ;
+        }
+
+    and class_type_alias = Odoc_class.class_type_alias =
+        {
+          cta_name : Name.t ; (** Complete name of the target class type. *)
+          mutable cta_class : cct option ;  (** The target t_class or t_class_type, if we found it.*)
+          cta_type_parameters : Types.type_expr list ; (** The type parameters. FIXME : use strings? *)
+        }
+
+    and class_type_kind = Odoc_class.class_type_kind =
+        Class_signature of inherited_class list * class_element list
+      | Class_type of class_type_alias (** A class type eventually applied to type args. *)
+
+    (** Representation of a class type. *)
+    and t_class_type = Odoc_class.t_class_type =
+        {
+          clt_name : Name.t ; (** Complete name of the type. *)
+          mutable clt_info : info option ; (** Information found in the optional associated comment. *)
+          clt_type : Types.class_type ;
+          clt_type_parameters : Types.type_expr list ; (** Type parameters. *)
+          clt_virtual : bool ; (** [true] if the class type is virtual *)
+          mutable clt_kind : class_type_kind ; (** The way the class type is defined. *)
+          mutable clt_loc : location ;
+        }
+
+    (** {1 Functions} *)
+
+    (** Access to the elements of a class. *)
+    val class_elements : ?trans:bool -> t_class -> class_element list
+
+    (** Access to the list of class attributes. *)
+    val class_attributes : ?trans:bool -> t_class -> Value.t_attribute list
+
+    (** Access to the description associated to the given class parameter name. *)
+    val class_parameter_text_by_name : t_class -> string -> text option
+
+    (** Access to the methods of a class. *)
+    val class_methods : ?trans:bool -> t_class -> Value.t_method list
+
+    (** Access to the comments of a class. *)
+    val class_comments : ?trans:bool -> t_class -> text list
+
+    (** Access to the elements of a class type. *)
+    val class_type_elements : ?trans:bool -> t_class_type -> class_element list
+
+    (** Access to the list of class type attributes. *)
+    val class_type_attributes : ?trans:bool -> t_class_type -> Value.t_attribute list
+
+    (** Access to the description associated to the given class type parameter name. *)
+    val class_type_parameter_text_by_name : t_class_type -> string -> text option
+
+    (** Access to the methods of a class type. *)
+    val class_type_methods : ?trans:bool -> t_class_type -> Value.t_method list
+
+    (** Access to the comments of a class type. *)
+    val class_type_comments : ?trans:bool -> t_class_type -> text list
+  end
+
+(** Representation and manipulation of modules and module types. *)
+module Module :
+  sig
+    (** {1 Types} *)
+
+    (** To keep the order of elements in a module. *)
+    type module_element = Odoc_module.module_element =
+        Element_module of t_module
+      | Element_module_type of t_module_type
+      | Element_included_module of included_module
+      | Element_class of Class.t_class
+      | Element_class_type of Class.t_class_type
+      | Element_value of Value.t_value
+      | Element_type_extension of Extension.t_type_extension
+      | Element_exception of Exception.t_exception
+      | Element_type of Type.t_type
+      | Element_module_comment of text
+
+    (** Used where we can reference t_module or t_module_type. *)
+    and mmt = Odoc_module.mmt =
+      | Mod of t_module
+      | Modtype of t_module_type
+
+    and included_module = Odoc_module.included_module =
+        {
+          im_name : Name.t ; (** Complete name of the included module. *)
+          mutable im_module : mmt option ; (** The included module or module type, if we found it. *)
+          mutable im_info : Odoc_types.info option ; (** comment associated with the include directive *)
+        }
+
+    and module_alias = Odoc_module.module_alias =
+        {
+          ma_name : Name.t ; (** Complete name of the target module. *)
+          mutable ma_module : mmt option ; (** The real module or module type if we could associate it. *)
+        }
+
+    and module_parameter = Odoc_module.module_parameter = {
+        mp_name : string ; (** the name *)
+        mp_type : Types.module_type option ; (** the type *)
+        mp_type_code : string ; (** the original code *)
+        mp_kind : module_type_kind ; (** the way the parameter was built *)
+      }
+
+    (** Different kinds of a module. *)
+    and module_kind = Odoc_module.module_kind =
+      | Module_struct of module_element list (** A complete module structure. *)
+      | Module_alias of module_alias (** Complete name and corresponding module if we found it *)
+      | Module_functor of module_parameter * module_kind
+                     (** A functor, with its parameter and the rest of its definition *)
+      | Module_apply of module_kind * module_kind
+                     (** A module defined by application of a functor. *)
+      | Module_with of module_type_kind * string
+                     (** A module whose type is a with ... constraint.
+                        Should appear in interface files only. *)
+      | Module_constraint of module_kind * module_type_kind
+                     (** A module constraint by a module type. *)
+      | Module_typeof of string (** by now only the code of the module expression *)
+      | Module_unpack of string * module_type_alias (** code of the expression and module type alias *)
+
+    (** Representation of a module. *)
+    and t_module = Odoc_module.t_module =
+        {
+          m_name : Name.t ; (** Complete name of the module. *)
+          mutable m_type : Types.module_type ; (** The type of the module. *)
+          mutable m_info : info option ; (** Information found in the optional associated comment. *)
+          m_is_interface : bool ; (** [true] for modules read from interface files *)
+          m_file : string ; (** The file the module is defined in. *)
+          mutable m_kind : module_kind ; (** The way the module is defined. *)
+          mutable m_loc : location ;
+          mutable m_top_deps : Name.t list ; (** The toplevels module names this module depends on. *)
+          mutable m_code : string option ; (** The whole code of the module *)
+          mutable m_code_intf : string option ; (** The whole code of the interface of the module *)
+          m_text_only : bool ; (** [true] if the module comes from a text file *)
+        }
+
+    and module_type_alias = Odoc_module.module_type_alias =
+        {
+          mta_name : Name.t ; (** Complete name of the target module type. *)
+          mutable mta_module : t_module_type option ; (** The real module type if we could associate it. *)
+        }
+
+    (** Different kinds of module type. *)
+    and module_type_kind = Odoc_module.module_type_kind =
+      | Module_type_struct of module_element list (** A complete module signature. *)
+      | Module_type_functor of module_parameter * module_type_kind
+            (** A functor, with its parameter and the rest of its definition *)
+      | Module_type_alias of module_type_alias
+            (** Complete alias name and corresponding module type if we found it. *)
+      | Module_type_with of module_type_kind * string
+            (** The module type kind and the code of the with constraint. *)
+      | Module_type_typeof of string
+            (** by now only the code of the module expression *)
+
+    (** Representation of a module type. *)
+    and t_module_type = Odoc_module.t_module_type =
+        {
+          mt_name : Name.t ; (** Complete name of the module type. *)
+          mutable mt_info : info option ; (** Information found in the optional associated comment. *)
+          mutable mt_type : Types.module_type option ; (** [None] means that the module type is abstract. *)
+          mt_is_interface : bool ; (** [true] for modules read from interface files. *)
+          mt_file : string ; (** The file the module type is defined in. *)
+          mutable mt_kind : module_type_kind option ;
+              (** The way the module is defined. [None] means that module type is abstract.
+                 It is always [None] when the module type was extracted from the implementation file.
+                 That means module types are only analysed in interface files. *)
+          mutable mt_loc : location ;
+        }
+
+    (** {1 Functions for modules} *)
+
+    (** Access to the elements of a module. *)
+    val module_elements : ?trans:bool -> t_module -> module_element list
+
+    (** Access to the submodules of a module. *)
+    val module_modules : ?trans:bool -> t_module -> t_module list
+
+    (** Access to the module types of a module. *)
+    val module_module_types : ?trans:bool -> t_module -> t_module_type list
+
+    (** Access to the included modules of a module. *)
+    val module_included_modules : ?trans:bool-> t_module -> included_module list
+
+    (** Access to the type extensions of a module. *)
+    val module_type_extensions : ?trans:bool-> t_module -> Extension.t_type_extension list
+
+    (** Access to the exceptions of a module. *)
+    val module_exceptions : ?trans:bool-> t_module -> Exception.t_exception list
+
+    (** Access to the types of a module. *)
+    val module_types : ?trans:bool-> t_module -> Type.t_type list
+
+    (** Access to the values of a module. *)
+    val module_values : ?trans:bool -> t_module -> Value.t_value list
+
+    (** Access to functional values of a module. *)
+    val module_functions : ?trans:bool-> t_module -> Value.t_value list
+
+    (** Access to non-functional values of a module. *)
+    val module_simple_values : ?trans:bool-> t_module -> Value.t_value list
+
+    (** Access to the classes of a module. *)
+    val module_classes : ?trans:bool-> t_module -> Class.t_class list
+
+    (** Access to the class types of a module. *)
+    val module_class_types : ?trans:bool-> t_module -> Class.t_class_type list
+
+    (** The list of classes defined in this module and all its submodules and functors. *)
+    val module_all_classes : ?trans:bool-> t_module -> Class.t_class list
+
+    (** [true] if the module is functor. *)
+    val module_is_functor : t_module -> bool
+
+    (** The list of couples (module parameter, optional description). *)
+    val module_parameters : ?trans:bool-> t_module -> (module_parameter * text option) list
+
+    (** The list of module comments. *)
+    val module_comments : ?trans:bool-> t_module -> text list
+
+    (** {1 Functions for module types} *)
+
+    (** Access to the elements of a module type. *)
+    val module_type_elements : ?trans:bool-> t_module_type -> module_element list
+
+    (** Access to the submodules of a module type. *)
+    val module_type_modules : ?trans:bool-> t_module_type -> t_module list
+
+    (** Access to the module types of a module type. *)
+    val module_type_module_types : ?trans:bool-> t_module_type -> t_module_type list
+
+    (** Access to the included modules of a module type. *)
+    val module_type_included_modules : ?trans:bool-> t_module_type -> included_module list
+
+    (** Access to the exceptions of a module type. *)
+    val module_type_exceptions : ?trans:bool-> t_module_type -> Exception.t_exception list
+
+    (** Access to the types of a module type. *)
+    val module_type_types : ?trans:bool-> t_module_type -> Type.t_type list
+
+    (** Access to the values of a module type. *)
+    val module_type_values : ?trans:bool-> t_module_type -> Value.t_value list
+
+    (** Access to functional values of a module type. *)
+    val module_type_functions : ?trans:bool-> t_module_type -> Value.t_value list
+
+    (** Access to non-functional values of a module type. *)
+    val module_type_simple_values : ?trans:bool-> t_module_type -> Value.t_value list
+
+    (** Access to the classes of a module type. *)
+    val module_type_classes : ?trans:bool-> t_module_type -> Class.t_class list
+
+    (** Access to the class types of a module type. *)
+    val module_type_class_types : ?trans:bool-> t_module_type -> Class.t_class_type list
+
+    (** The list of classes defined in this module type and all its submodules and functors. *)
+    val module_type_all_classes : ?trans:bool-> t_module_type -> Class.t_class list
+
+    (** [true] if the module type is functor. *)
+    val module_type_is_functor : t_module_type -> bool
+
+    (** The list of couples (module parameter, optional description). *)
+    val module_type_parameters : ?trans:bool-> t_module_type -> (module_parameter * text option) list
+
+    (** The list of module comments. *)
+    val module_type_comments : ?trans:bool-> t_module_type -> text list
+  end
+
+
+(** {2 Getting strings from values} *)
+
+(** This function is used to reset the names of type variables.
+   It must be called when printing the whole type of a function,
+   but not when printing the type of its parameters. Same for
+   classes (call it) and methods and attributes (don't call it).*)
+val reset_type_names : unit -> unit
+
+(** [string_of_variance t (covariant, invariant)] returns ["+"] if
+   the given information means "covariant", ["-"] if it means
+   "contravariant", orelse [""], and always [""] if the given
+   type is not an abstract type with no manifest (i.e. no need
+   for the variance to be printed).*)
+val string_of_variance : Type.t_type -> (bool * bool) -> string
+
+(** This function returns a string representing a Types.type_expr. *)
+val string_of_type_expr : Types.type_expr -> string
+
+(** @return a string to display the parameters of the given class,
+   in the same form as the compiler. *)
+val string_of_class_params : Class.t_class -> string
+
+(** This function returns a string to represent the given list of types,
+   with a given separator. *)
+val string_of_type_list : ?par: bool -> string -> Types.type_expr list -> string
+
+(** This function returns a string to represent the list of type parameters
+   for the given type. *)
+val string_of_type_param_list : Type.t_type -> string
+
+(** This function returns a string to represent the list of type parameters
+   for the given type extension. *)
+val string_of_type_extension_param_list : Extension.t_type_extension -> string
+
+(** This function returns a string to represent the given list of
+   type parameters of a class or class type,
+   with a given separator. *)
+val string_of_class_type_param_list : Types.type_expr list -> string
+
+(** This function returns a string representing a [Types.module_type].
+   @param complete indicates if we must print complete signatures
+   or just [sig end]. Default is [false].
+   @param code if [complete = false] and the type contains something else
+   than identificators and functors, then the given code is used.
+*)
+val string_of_module_type : ?code: string -> ?complete: bool -> Types.module_type -> string
+
+(** This function returns a string representing a [Types.class_type].
+   @param complete indicates if we must print complete signatures
+   or just [object end]. Default is [false].
+*)
+val string_of_class_type : ?complete: bool -> Types.class_type -> string
+
+
+(** Get a string from a text. *)
+val string_of_text : text -> string
+
+(** Get a string from an info structure. *)
+val string_of_info : info -> string
+
+(** @return a string to describe the given type. *)
+val string_of_type : Type.t_type -> string
+
+val string_of_record : Type.record_field list -> string
+
+(** @return a string to describe the given type extension. *)
+val string_of_type_extension : Extension.t_type_extension -> string
+
+(** @return a string to describe the given exception. *)
+val string_of_exception : Exception.t_exception -> string
+
+(** @return a string to describe the given value. *)
+val string_of_value : Value.t_value -> string
+
+(** @return a string to describe the given attribute. *)
+val string_of_attribute : Value.t_attribute -> string
+
+(** @return a string to describe the given method. *)
+val string_of_method : Value.t_method -> string
+
+(** {2 Miscellaneous functions} *)
+
+(** Return the first sentence (until the first dot followed by a blank
+   or the first blank line) of a text.
+   Don't stop in the middle of [Code], [CodePre], [Verbatim], [List], [Enum],
+   [Latex], [Link], [Ref], [Subscript] or [Superscript]. *)
+val first_sentence_of_text : text -> text
+
+(** Return the first sentence (until the first dot followed by a blank
+   or the first blank line) of a text, and the remaining text after.
+   Don't stop in the middle of [Code], [CodePre], [Verbatim], [List], [Enum],
+   [Latex], [Link], [Ref], [Subscript] or [Superscript].*)
+val first_sentence_and_rest_of_text : text -> text * text
+
+(** Return the given [text] without any title or list. *)
+val text_no_title_no_list : text -> text
+
+(** [concat sep l] concats the given list of text [l], each separated with
+   the text [sep]. *)
+val text_concat : Odoc_types.text -> Odoc_types.text list -> Odoc_types.text
+
+(** Return the list of titles in a [text].
+   A title is a title level, an optional label and a text.*)
+val get_titles_in_text : text -> (int * string option * text) list
+
+(** Take a sorted list of elements, a function to get the name
+   of an element and return the list of list of elements,
+   where each list group elements beginning by the same letter.
+   Since the original list is sorted, elements whose name does not
+   begin with a letter should be in the first returned list.*)
+val create_index_lists : 'a list -> ('a -> string) -> 'a list list
+
+(** Take a type and remove the option top constructor. This is
+   useful when printing labels, we then remove the top option constructor
+   for optional labels.*)
+val remove_option : Types.type_expr -> Types.type_expr
+
+(** Return [true] if the given label is optional.*)
+val is_optional : Asttypes.arg_label -> bool
+
+(** Return the label name for the given label,
+   i.e. removes the beginning '?' if present.*)
+val label_name : Asttypes.arg_label -> string
+
+(** Return the given name where the module name or
+   part of it was removed, according to the list of modules
+   which must be hidden (cf {!Odoc_args.hidden_modules})*)
+val use_hidden_modules : Name.t -> Name.t
+
+(** Print the given string if the verbose mode is activated. *)
+val verbose : string -> unit
+
+(** Print a warning message to stderr.
+   If warnings must be treated as errors, then the
+   error counter is incremented. *)
+val warning : string -> unit
+
+(** A flag to indicate whether ocamldoc warnings must be printed or not. *)
+val print_warnings : bool ref
+
+(** Increment this counter when an error is encountered.
+   The ocamldoc tool will print the number of errors
+   encountered exit with code 1 if this number is greater
+   than 0. *)
+val errors : int ref
+
+(** Apply a function to an optional value. *)
+val apply_opt : ('a -> 'b) -> 'a option -> 'b option
+
+(** Apply a function to a first value if it is
+   not different from a second value. If the two values
+   are different, return the second one.*)
+val apply_if_equal : ('a -> 'a) -> 'a -> 'a -> 'a
+
+(** [text_of_string s] returns the text structure from the
+   given string.
+   @raise Text_syntax if a syntax error is encountered. *)
+val text_of_string : string -> text
+
+(** [text_string_of_text text] returns the string representing
+   the given [text]. This string can then be parsed again
+   by {!Odoc_info.text_of_string}.*)
+val text_string_of_text : text -> string
+
+(** [info_of_string s] parses the given string
+   like a regular ocamldoc comment and return an
+   {!Odoc_info.info} structure.
+   @return an empty structure if there was a syntax error. TODO: change this
+*)
+val info_of_string : string -> info
+
+(** [info_string_of_info info] returns the string representing
+   the given [info]. This string can then be parsed again
+   by {!Odoc_info.info_of_string}.*)
+val info_string_of_info : info -> string
+
+(** [info_of_comment_file file] parses the given file
+   and return an {!Odoc_info.info} structure. The content of the
+   file must have the same syntax as the content of a special comment.
+   The given module list is used for cross reference.
+   @raise Failure if the file could not be opened or there is a
+   syntax error.
+*)
+val info_of_comment_file : Module.t_module list -> string -> info
+
+(** [remove_ending_newline s] returns [s] without the optional ending newline. *)
+val remove_ending_newline : string -> string
+
+(** Research in elements *)
+module Search :
+    sig
+      type result_element = Odoc_search.result_element =
+          Res_module of Module.t_module
+        | Res_module_type of Module.t_module_type
+        | Res_class of Class.t_class
+        | Res_class_type of Class.t_class_type
+        | Res_value of Value.t_value
+        | Res_type of Type.t_type
+        | Res_extension of Extension.t_extension_constructor
+        | Res_exception of Exception.t_exception
+        | Res_attribute of Value.t_attribute
+        | Res_method of Value.t_method
+        | Res_section of string  * text
+        | Res_recfield of Type.t_type * Type.record_field
+        | Res_const of Type.t_type * Type.variant_constructor
+
+      (** The type representing a research result.*)
+      type search_result = result_element list
+
+      (** Research of the elements whose name matches the given regular expression.*)
+      val search_by_name : Module.t_module list -> Str.regexp -> search_result
+
+      (** A function to search all the values in a list of modules. *)
+      val values : Module.t_module list -> Value.t_value list
+
+      (** A function to search all the extensions in a list of modules. *)
+      val extensions : Module.t_module list -> Extension.t_extension_constructor list
+
+      (** A function to search all the exceptions in a list of modules. *)
+      val exceptions : Module.t_module list -> Exception.t_exception list
+
+      (** A function to search all the types in a list of modules. *)
+      val types : Module.t_module list -> Type.t_type list
+
+      (** A function to search all the class attributes in a list of modules. *)
+      val attributes : Module.t_module list -> Value.t_attribute list
+
+      (** A function to search all the class methods in a list of modules. *)
+      val methods : Module.t_module list -> Value.t_method list
+
+      (** A function to search all the classes in a list of modules. *)
+      val classes : Module.t_module list -> Class.t_class list
+
+      (** A function to search all the class types in a list of modules. *)
+      val class_types : Module.t_module list -> Class.t_class_type list
+
+      (** A function to search all the modules in a list of modules. *)
+      val modules : Module.t_module list -> Module.t_module list
+
+      (** A function to search all the module types in a list of modules. *)
+      val module_types : Module.t_module list -> Module.t_module_type list
+
+    end
+
+(** Scanning of collected information *)
+module Scan :
+  sig
+    class scanner :
+      object
+
+        method scan_value : Value.t_value -> unit
+
+        method scan_type_pre : Type.t_type -> bool
+        method scan_type_const : Type.t_type -> Type.variant_constructor -> unit
+        method scan_type_recfield : Type.t_type -> Type.record_field -> unit
+        method scan_type : Type.t_type -> unit
+        method scan_extension_constructor : Extension.t_extension_constructor -> unit
+        method scan_exception : Exception.t_exception -> unit
+        method scan_attribute : Value.t_attribute -> unit
+        method scan_method : Value.t_method -> unit
+        method scan_included_module : Module.included_module -> unit
+
+      (** Scan of a type extension *)
+
+        (** Override this method to perform controls on the extension's type,
+            private and info. This method is called before scanning the
+            extension's constructors.
+            @return true if the extension's constructors must be scanned.*)
+        method scan_type_extension_pre : Extension.t_type_extension -> bool
+
+       (** This method scans the constructors of the given type extension. *)
+        method scan_type_extension_constructors : Extension.t_type_extension -> unit
+
+        (** Scan of a type extension. Should not be overridden. It calls [scan_type_extension_pre]
+            and if [scan_type_extension_pre] returns [true], then it calls scan_type_extension_constructors.*)
+        method scan_type_extension : Extension.t_type_extension -> unit
+
+      (** Scan of a class. *)
+
+        (** Scan of a comment inside a class. *)
+        method scan_class_comment : text -> unit
+
+       (** Override this method to perform controls on the class comment
+          and params. This method is called before scanning the class elements.
+          @return true if the class elements must be scanned.*)
+        method scan_class_pre : Class.t_class -> bool
+
+       (** This method scans the elements of the given class. *)
+        method scan_class_elements : Class.t_class -> unit
+
+       (** Scan of a class. Should not be overridden. It calls [scan_class_pre]
+          and if [scan_class_pre] returns [true], then it calls scan_class_elements.*)
+        method scan_class : Class.t_class -> unit
+
+      (** Scan of a class type. *)
+
+        (** Scan of a comment inside a class type. *)
+        method scan_class_type_comment : text -> unit
+
+        (** Override this method to perform controls on the class type comment
+           and form. This method is called before scanning the class type elements.
+           @return true if the class type elements must be scanned.*)
+        method scan_class_type_pre : Class.t_class_type -> bool
+
+        (** This method scans the elements of the given class type. *)
+        method scan_class_type_elements : Class.t_class_type -> unit
+
+        (** Scan of a class type. Should not be overridden. It calls [scan_class_type_pre]
+           and if [scan_class_type_pre] returns [true], then it calls scan_class_type_elements.*)
+        method scan_class_type : Class.t_class_type -> unit
+
+      (** Scan of modules. *)
+
+        (** Scan of a comment inside a module. *)
+        method scan_module_comment : text -> unit
+
+        (** Override this method to perform controls on the module comment
+           and form. This method is called before scanning the module elements.
+           @return true if the module elements must be scanned.*)
+        method scan_module_pre : Module.t_module -> bool
+
+        (** This method scans the elements of the given module. *)
+        method scan_module_elements : Module.t_module -> unit
+
+       (** Scan of a module. Should not be overridden. It calls [scan_module_pre]
+          and if [scan_module_pre] returns [true], then it calls scan_module_elements.*)
+        method scan_module : Module.t_module -> unit
+
+      (** Scan of module types. *)
+
+        (** Scan of a comment inside a module type. *)
+        method scan_module_type_comment : text -> unit
+
+        (** Override this method to perform controls on the module type comment
+           and form. This method is called before scanning the module type elements.
+           @return true if the module type elements must be scanned. *)
+        method scan_module_type_pre : Module.t_module_type -> bool
+
+        (** This method scans the elements of the given module type. *)
+        method scan_module_type_elements : Module.t_module_type -> unit
+
+        (** Scan of a module type. Should not be overridden. It calls [scan_module_type_pre]
+           and if [scan_module_type_pre] returns [true], then it calls scan_module_type_elements.*)
+        method scan_module_type : Module.t_module_type -> unit
+
+      (** Main scanning method. *)
+
+        (** Scan a list of modules. *)
+        method scan_module_list : Module.t_module list -> unit
+      end
+  end
+
+(** Computation of dependencies. *)
+module Dep :
+  sig
+    (** Modify the module dependencies of the given list of modules,
+       to get the minimum transitivity kernel. *)
+    val kernel_deps_of_modules : Module.t_module list -> unit
+
+    (** Return the list of dependencies between the given types,
+       in the form of a list [(type name, names of types it depends on)].
+       @param kernel indicates if we must keep only the transitivity kernel
+       of the dependencies. Default is [false].
+    *)
+    val deps_of_types : ?kernel: bool -> Type.t_type list -> (Type.t_type * (Name.t list)) list
+  end
+
+(** {1 Some global variables} *)
+
+module Global :
+  sig
+    val errors : int ref
+    val warn_error : bool ref
+
+    (** The file used by the generators outputting only one file. *)
+    val out_file : string ref
+
+    (** Verbose mode or not. *)
+    val verbose : bool ref
+
+    (** The directory where files have to be generated. *)
+    val target_dir : string ref
+
+    (** The optional title to use in the generated documentation. *)
+    val title : string option ref
+
+    (** The optional file whose content can be used as intro text. *)
+    val intro_file : string option ref
+
+    (** The flag which indicates if we must generate a table of contents. *)
+    val with_toc : bool ref
+
+    (** The flag which indicates if we must generate an index. *)
+    val with_index : bool ref
+
+    (** The flag which indicates if we must generate a header.*)
+    val with_header : bool ref
+
+    (** The flag which indicates if we must generate a trailer.*)
+    val with_trailer : bool ref
+end
+
+(** Analysis of the given source files.
+   @param init is the list of modules already known from a previous analysis.
+   @return the list of analysed top modules. *)
+val analyse_files :
+    ?merge_options:Odoc_types.merge_option list ->
+      ?include_dirs:string list ->
+        ?labels:bool ->
+          ?sort_modules:bool ->
+            ?no_stop:bool ->
+              ?init: Odoc_module.t_module list ->
+                Odoc_global.source_file list ->
+                  Module.t_module list
+
+(** Dump of a list of modules into a file.
+   @raise Failure if an error occurs.*)
+val dump_modules : string -> Odoc_module.t_module list -> unit
+
+(** Load of a list of modules from a file.
+   @raise Failure if an error occurs.*)
+val load_modules : string -> Odoc_module.t_module list
diff --git a/ocamldoc/odoc_inherit.ml b/ocamldoc/odoc_inherit.ml
new file mode 100644
index 00000000..d47351e9
--- /dev/null
+++ b/ocamldoc/odoc_inherit.ml
@@ -0,0 +1,14 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
diff --git a/ocamldoc/odoc_latex.ml b/ocamldoc/odoc_latex.ml
new file mode 100644
index 00000000..621ceec8
--- /dev/null
+++ b/ocamldoc/odoc_latex.ml
@@ -0,0 +1,1333 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Generation of LaTeX documentation. *)
+
+let print_DEBUG s = print_string s ; print_newline ()
+
+open Odoc_info
+open Value
+open Type
+open Extension
+open Exception
+open Class
+open Module
+
+
+
+let separate_files = ref false
+
+let latex_titles = ref [
+  0, "section" ;
+  1, "section" ;
+  2, "subsection" ;
+  3, "subsubsection" ;
+  4, "paragraph" ;
+  5, "subparagraph" ;
+]
+
+let latex_value_prefix = ref Odoc_messages.default_latex_value_prefix
+let latex_type_prefix = ref Odoc_messages.default_latex_type_prefix
+let latex_type_elt_prefix = ref Odoc_messages.default_latex_type_elt_prefix
+let latex_extension_prefix = ref Odoc_messages.default_latex_extension_prefix
+let latex_exception_prefix = ref Odoc_messages.default_latex_exception_prefix
+let latex_module_prefix = ref Odoc_messages.default_latex_module_prefix
+let latex_module_type_prefix = ref Odoc_messages.default_latex_module_type_prefix
+let latex_class_prefix = ref Odoc_messages.default_latex_class_prefix
+let latex_class_type_prefix = ref Odoc_messages.default_latex_class_type_prefix
+let latex_attribute_prefix = ref Odoc_messages.default_latex_attribute_prefix
+let latex_method_prefix = ref Odoc_messages.default_latex_method_prefix
+
+let new_buf () = Buffer.create 1024
+let new_fmt () =
+  let b = new_buf () in
+  let fmt = Format.formatter_of_buffer b in
+  (fmt,
+   fun () ->
+    Format.pp_print_flush fmt ();
+    let s = Buffer.contents b in
+    Buffer.reset b;
+    s
+  )
+
+let p = Format.fprintf
+let ps f s = Format.fprintf f "%s" s
+
+
+let bp = Printf.bprintf
+let bs = Buffer.add_string
+
+let rec merge_codepre = function
+    [] -> []
+  | [e] -> [e]
+  | (CodePre s1) :: (CodePre s2) :: q ->
+      merge_codepre ((CodePre (s1^"\n"^s2)) :: q)
+  | e :: q ->
+      e :: (merge_codepre q)
+
+let print_concat fmt sep f =
+  let rec iter = function
+      [] -> ()
+    | [c] -> f c
+    | c :: q ->
+        f c;
+        ps fmt sep;
+        iter q
+  in
+  iter
+
+(** Generation of LaTeX code from text structures. *)
+class text =
+  object (self)
+    (** Return latex code to make a section according to the given level,
+       and with the given latex code. *)
+    method section_style level s =
+      try
+        let sec = List.assoc level !latex_titles in
+        "\\"^sec^"{"^s^"}\n"
+      with Not_found -> s
+
+    (** Associations of strings to substitute in latex code. *)
+    val subst_strings = List.map (fun (x, y) -> (Str.regexp x, y))
+      [
+        "\001", "\001\002";
+        "\\\\", "\001b";
+
+        "{", "\\\\{";
+        "}", "\\\\}";
+        "\\$", "\\\\$";
+        "\\^", "{\\\\textasciicircum}";
+        "%", "\\\\%";
+        "_", "\\\\_";
+        "~", "\\\\~{}";
+        "#", "{\\char35}";
+        "->", "$\\\\rightarrow$";
+        "<-", "$\\\\leftarrow$";
+        ">=", "$\\\\geq$";
+        "<=", "$\\\\leq$";
+        ">", "$>$";
+        "<", "$<$";
+        "=", "$=$";
+        "|", "{\\\\textbar}";
+        "\\.\\.\\.", "$\\\\ldots$";
+        "&", "\\\\&";
+
+        "\001b", "{\\\\char92}";
+        "\001\002", "\001";
+      ]
+
+    val subst_strings_simple = List.map (fun (x, y) -> (Str.regexp x, y))
+      [
+        "\001", "\001\002";
+        "\\\\", "\001b";
+        "{", "\001l";
+
+        "}", "{\\\\char125}";
+        "'", "{\\\\textquotesingle}";
+        "`", "{\\\\textasciigrave}";
+
+        "\001b", "{\\\\char92}";
+        "\001l", "{\\\\char123}";
+        "\001\002", "\001";
+      ]
+
+    val subst_strings_code = List.map (fun (x, y) -> (Str.regexp x, y))
+      [
+        "\001", "\001\002";
+        "\\\\", "\001b";
+        "{", "\001l";
+
+        "}", "{\\\\char125}";
+        "'", "{\\\\textquotesingle}";
+        "`", "{\\\\textasciigrave}";
+        "%", "\\\\%";
+        "_", "\\\\_";
+        "~", "{\\\\char126}";
+        "#", "{\\\\char35}";
+        "&", "\\\\&";
+        "\\$", "\\\\$";
+        "\\^", "{\\\\char94}";
+
+        "\001b", "{\\\\char92}";
+        "\001l", "{\\\\char123}";
+        "\001\002", "\001";
+      ]
+
+    method subst l s =
+      List.fold_left (fun acc (re, st) -> Str.global_replace re st acc) s l
+
+    (** Escape the strings which would clash with LaTeX syntax. *)
+    method escape s = self#subst subst_strings s
+
+    (** Escape the ['\'], ['{'] and ['}'] characters. *)
+    method escape_simple s = self#subst subst_strings_simple s
+
+    (** Escape some characters for the code style. *)
+    method escape_code s = self#subst subst_strings_code s
+
+    (** Make a correct latex label from a name. *)
+    (* The following characters are forbidden in LaTeX \index:
+       \ { } $ & # ^ _ % ~ ! " @ | (" to close the double quote)
+       The following characters are forbidden in LaTeX \label:
+       \ { } $ & # ^ _ % ~
+       So we will use characters not forbidden in \index if no_ = true.
+    *)
+    method label ?(no_=true) name =
+      let len = String.length name in
+      let buf = Buffer.create len in
+      for i = 0 to len - 1 do
+        let (s_no_, s) =
+          match name.[i] with
+          '_' -> ("-underscore", "_")
+        | '~' -> ("-tilde", "~")
+        | '%' -> ("-percent", "%")
+        | '@' -> ("-at", "\"@")
+        | '!' -> ("-bang", "\"!")
+        | '|' -> ("-pipe", "\"|")
+        | '<' -> ("-lt", "<")
+        | '>' -> ("-gt", ">")
+        | '^' -> ("-exp", "^")
+        | '&' -> ("-ampersand", "&")
+        | '+' -> ("-plus", "+")
+        | '-' -> ("-minus", "-")
+        | '*' -> ("-star", "*")
+        | '/' -> ("-slash", "/")
+        | '$' -> ("-dollar", "$")
+        | '=' -> ("-equal", "=")
+        | ':' -> ("-colon", ":")
+        | c -> (String.make 1 c, String.make 1 c)
+        in
+        Buffer.add_string buf (if no_ then s_no_ else s)
+      done;
+      Buffer.contents buf
+
+    (** Make a correct label from a value name. *)
+    method value_label ?no_ name = !latex_value_prefix^(self#label ?no_ name)
+
+    (** Make a correct label from an attribute name. *)
+    method attribute_label ?no_ name = !latex_attribute_prefix^(self#label ?no_ name)
+
+    (** Make a correct label from a method name. *)
+    method method_label ?no_ name = !latex_method_prefix^(self#label ?no_ name)
+
+    (** Make a correct label from a class name. *)
+    method class_label ?no_ name = !latex_class_prefix^(self#label ?no_ name)
+
+    (** Make a correct label from a class type name. *)
+    method class_type_label ?no_ name = !latex_class_type_prefix^(self#label ?no_ name)
+
+    (** Make a correct label from a module name. *)
+    method module_label ?no_ name = !latex_module_prefix^(self#label ?no_ name)
+
+    (** Make a correct label from a module type name. *)
+    method module_type_label ?no_ name = !latex_module_type_prefix^(self#label ?no_ name)
+
+    (** Make a correct label from an extension name. *)
+    method extension_label ?no_ name = !latex_extension_prefix^(self#label ?no_ name)
+
+    (** Make a correct label from an exception name. *)
+    method exception_label ?no_ name = !latex_exception_prefix^(self#label ?no_ name)
+
+    (** Make a correct label from a type name. *)
+    method type_label ?no_ name = !latex_type_prefix^(self#label ?no_ name)
+
+    (** Make a correct label from a record field. *)
+    method recfield_label ?no_ name = !latex_type_elt_prefix^(self#label ?no_ name)
+
+    (** Make a correct label from a variant constructor. *)
+    method const_label ?no_ name = !latex_type_elt_prefix^(self#label ?no_ name)
+
+    (** Return latex code for the label of a given label. *)
+    method make_label label = "\\label{"^label^"}"
+
+    (** Return latex code for the ref to a given label. *)
+    method make_ref label = "\\ref{"^label^"}"
+
+    (** Print the LaTeX code corresponding to the [text] parameter.*)
+    method latex_of_text fmt t =
+      List.iter (self#latex_of_text_element fmt) t
+
+    (** Print the LaTeX code for the [text_element] in parameter. *)
+    method latex_of_text_element fmt txt =
+      match txt with
+      | Odoc_info.Raw s -> self#latex_of_Raw fmt s
+      | Odoc_info.Code s -> self#latex_of_Code fmt s
+      | Odoc_info.CodePre s -> self#latex_of_CodePre fmt s
+      | Odoc_info.Verbatim s -> self#latex_of_Verbatim fmt s
+      | Odoc_info.Bold t -> self#latex_of_Bold fmt t
+      | Odoc_info.Italic t -> self#latex_of_Italic fmt t
+      | Odoc_info.Emphasize t -> self#latex_of_Emphasize fmt t
+      | Odoc_info.Center t -> self#latex_of_Center fmt t
+      | Odoc_info.Left t -> self#latex_of_Left fmt t
+      | Odoc_info.Right t -> self#latex_of_Right fmt t
+      | Odoc_info.List tl -> self#latex_of_List fmt tl
+      | Odoc_info.Enum tl -> self#latex_of_Enum fmt tl
+      | Odoc_info.Newline -> self#latex_of_Newline fmt
+      | Odoc_info.Block t -> self#latex_of_Block fmt t
+      | Odoc_info.Title (n, l_opt, t) -> self#latex_of_Title fmt n l_opt t
+      | Odoc_info.Latex s -> self#latex_of_Latex fmt s
+      | Odoc_info.Link (s, t) -> self#latex_of_Link fmt s t
+      | Odoc_info.Ref (name, ref_opt, text_opt) ->
+          self#latex_of_Ref fmt name ref_opt text_opt
+      | Odoc_info.Superscript t -> self#latex_of_Superscript fmt t
+      | Odoc_info.Subscript t -> self#latex_of_Subscript fmt t
+      | Odoc_info.Module_list _ -> ()
+      | Odoc_info.Index_list -> ()
+      | Odoc_info.Custom (s,t) -> self#latex_of_custom_text fmt s t
+      | Odoc_info.Target (target, code) -> self#latex_of_Target fmt ~target ~code
+
+    method latex_of_custom_text _ _ _ = ()
+
+    method latex_of_Target fmt ~target ~code =
+      if String.lowercase_ascii target = "latex" then
+        self#latex_of_Latex fmt code
+      else
+        ()
+
+    method latex_of_Raw fmt s =
+      ps fmt (self#escape s)
+
+    method latex_of_Code fmt s =
+      let s2 = self#escape_code s in
+      let s3 = Str.global_replace (Str.regexp "\n") ("\\\\\n") s2 in
+      p fmt "{\\tt{%s}}" s3
+
+    method latex_of_CodePre fmt s =
+      ps fmt "\\begin{ocamldoccode}\n";
+      ps fmt (self#escape_simple s);
+      ps fmt "\n\\end{ocamldoccode}\n"
+
+    method latex_of_Verbatim fmt s =
+      ps fmt "\n\\begin{verbatim}\n";
+      ps fmt s;
+      ps fmt "\n\\end{verbatim}\n"
+
+    method latex_of_Bold fmt t =
+      ps fmt "{\\bf ";
+      self#latex_of_text fmt t;
+      ps fmt "}"
+
+    method latex_of_Italic fmt t =
+      ps fmt "{\\it ";
+      self#latex_of_text fmt t;
+      ps fmt "}"
+
+    method latex_of_Emphasize fmt t =
+      ps fmt "{\\em ";
+      self#latex_of_text fmt t;
+      ps fmt "}"
+
+    method latex_of_Center fmt t =
+      ps fmt "\\begin{center}\n";
+      self#latex_of_text fmt t;
+      ps fmt "\\end{center}\n"
+
+    method latex_of_Left fmt t =
+      ps fmt "\\begin{flushleft}\n";
+      self#latex_of_text fmt t;
+      ps fmt "\\end{flushleft}\n"
+
+    method latex_of_Right fmt t =
+      ps fmt "\\begin{flushright}\n";
+      self#latex_of_text fmt t;
+      ps fmt "\\end{flushright}\n"
+
+    method latex_of_List fmt tl =
+      ps fmt "\\begin{itemize}\n";
+      List.iter
+        (fun t ->
+          ps fmt "\\item ";
+          self#latex_of_text fmt t;
+          ps fmt "\n"
+        )
+        tl;
+      ps fmt "\\end{itemize}\n"
+
+    method latex_of_Enum fmt tl =
+      ps fmt "\\begin{enumerate}\n";
+      List.iter
+        (fun t ->
+          ps fmt "\\item ";
+          self#latex_of_text fmt t;
+          ps fmt "\n"
+        )
+        tl;
+      ps fmt "\\end{enumerate}\n"
+
+    method latex_of_Newline fmt = ps fmt "\n\n"
+
+    method latex_of_Block fmt t =
+      ps fmt "\\begin{ocamldocdescription}\n";
+      self#latex_of_text fmt t;
+      ps fmt "\n\\end{ocamldocdescription}\n"
+
+    method latex_of_Title fmt n label_opt t =
+      let (fmt2, flush) = new_fmt () in
+      self#latex_of_text fmt2 t;
+      let s_title2 = self#section_style n (flush ()) in
+      ps fmt s_title2;
+      (
+       match label_opt with
+         None -> ()
+       | Some l ->
+           ps fmt (self#make_label (self#label ~no_: false l))
+      )
+
+    method latex_of_Latex fmt s = ps fmt s
+
+    method latex_of_Link fmt s t =
+      self#latex_of_text fmt t ;
+      ps fmt "[\\url{";
+      ps fmt s ;
+      ps fmt "}]"
+
+    method latex_of_Ref fmt name ref_opt text_opt =
+      match ref_opt with
+        None ->
+          self#latex_of_text fmt
+          (match text_opt with
+             None ->
+               [Odoc_info.Code (Odoc_info.use_hidden_modules name)]
+           | Some t -> t
+           )
+      | Some (RK_section _) ->
+          let text = match text_opt with
+            | None -> []
+            | Some x -> x in
+          let label= self#make_ref (self#label ~no_:false (Name.simple name)) in
+          self#latex_of_text fmt
+            (text @ [Latex ("["^label^"]")] )
+      | Some kind ->
+          let f_label =
+            match kind with
+              Odoc_info.RK_module -> self#module_label
+            | Odoc_info.RK_module_type -> self#module_type_label
+            | Odoc_info.RK_class -> self#class_label
+            | Odoc_info.RK_class_type -> self#class_type_label
+            | Odoc_info.RK_value -> self#value_label
+            | Odoc_info.RK_type -> self#type_label
+            | Odoc_info.RK_extension -> self#extension_label
+            | Odoc_info.RK_exception -> self#exception_label
+            | Odoc_info.RK_attribute -> self#attribute_label
+            | Odoc_info.RK_method -> self#method_label
+            | Odoc_info.RK_section _ -> assert false
+            | Odoc_info.RK_recfield -> self#recfield_label
+            | Odoc_info.RK_const -> self#const_label
+          in
+          let text =
+            match text_opt with
+              None -> [Odoc_info.Code (Odoc_info.use_hidden_modules name)]
+            | Some t -> t
+          in
+          self#latex_of_text fmt
+             (text @ [Latex ("["^(self#make_ref (f_label name))^"]")])
+
+    method latex_of_Superscript fmt t =
+      ps fmt "$^{";
+      self#latex_of_text fmt t;
+      ps fmt "}$"
+
+    method latex_of_Subscript fmt t =
+      ps fmt "$_{";
+      self#latex_of_text fmt t;
+      ps fmt "}$"
+
+  end
+
+(** A class used to generate LaTeX code for info structures. *)
+class virtual info =
+  object (self)
+    (** The method used to get LaTeX code from a [text]. *)
+    method virtual latex_of_text : Format.formatter -> Odoc_info.text -> unit
+
+    (** The method used to get a [text] from an optional info structure. *)
+    method virtual text_of_info : ?block: bool -> Odoc_info.info option -> Odoc_info.text
+
+    (** Print LaTeX code for a description, except for the [i_params] field. *)
+    method latex_of_info fmt ?(block=false) info_opt =
+      self#latex_of_text fmt
+        (self#text_of_info ~block info_opt)
+  end
+
+module Generator =
+struct
+(** This class is used to create objects which can generate a simple LaTeX documentation. *)
+class latex =
+  object (self)
+    inherit text
+    inherit Odoc_to_text.to_text as to_text
+    inherit info
+
+    (** Get the first sentence and the rest of a description,
+       from an optional [info] structure. The first sentence
+       can be empty if it would not appear right in a title.
+       In the first sentence, the titles and lists has been removed,
+       since it is used in LaTeX titles and would make LaTeX complain
+       if we has two nested \section commands.
+    *)
+    method first_and_rest_of_info i_opt =
+      match i_opt with
+        None -> ([], [])
+      | Some i ->
+            match i.Odoc_info.i_desc with
+              None -> ([], self#text_of_info ~block: true i_opt)
+            | Some t ->
+                let (first,_) = Odoc_info.first_sentence_and_rest_of_text t in
+                let (_, rest) = Odoc_info.first_sentence_and_rest_of_text (self#text_of_info ~block: false i_opt) in
+                (Odoc_info.text_no_title_no_list first, rest)
+
+    (** Print LaTeX code for a value. *)
+    method latex_of_value fmt v =
+      Odoc_info.reset_type_names () ;
+      let label = self#value_label v.val_name in
+      let latex = self#make_label label in
+      self#latex_of_text fmt
+        ((Latex latex) ::
+         (to_text#text_of_value v))
+
+    (** Print LaTeX code for a class attribute. *)
+    method latex_of_attribute fmt a =
+      self#latex_of_text fmt
+        ((Latex (self#make_label (self#attribute_label a.att_value.val_name))) ::
+         (to_text#text_of_attribute a))
+
+    (** Print LaTeX code for a class method. *)
+    method latex_of_method fmt m =
+      self#latex_of_text fmt
+        ((Latex (self#make_label (self#method_label m.met_value.val_name))) ::
+         (to_text#text_of_method m))
+
+    (** Print LaTeX code for the parameters of a type. *)
+    method latex_of_type_params fmt m_name t =
+      let print_one (p, co, cn) =
+        ps fmt (Odoc_info.string_of_variance t (co,cn));
+        ps fmt (self#normal_type m_name p)
+      in
+      match t.ty_parameters with
+        [] -> ()
+      | [(p,co,cn)] -> print_one (p, co, cn)
+      | _ ->
+          ps fmt "(";
+          print_concat fmt ", " print_one t.ty_parameters;
+          ps fmt ")"
+
+    method latex_of_class_parameter_list fmt father c =
+      self#latex_of_text fmt
+        (self#text_of_class_params father c)
+
+
+    method entry_comment (fmt,flush) = function
+      | None -> []
+      | Some t ->
+          let s =
+            ps fmt "\\begin{ocamldoccomment}\n";
+            self#latex_of_info fmt (Some t);
+            ps fmt "\n\\end{ocamldoccomment}\n";
+            flush ()
+          in
+          [ Latex s]
+
+    (** record printing method *)
+    method latex_of_record ( (fmt,flush) as f) mod_name l =
+      p fmt "{";
+      let fields =
+        List.map (fun r ->
+            let s_field =
+              p fmt
+                "@[  %s%s :@ %s ;"
+                (if r.rf_mutable then "mutable " else "")
+                r.rf_name
+                (self#normal_type mod_name r.rf_type);
+              flush ()
+            in
+            [ CodePre s_field ] @ (self#entry_comment f r.rf_text)
+          ) l in
+      List.flatten fields @ [ CodePre "}" ]
+
+    method latex_of_cstr_args ( (fmt,flush) as f) mod_name (args, ret) =
+      match args, ret with
+      | Cstr_tuple [], None -> [CodePre(flush())]
+      | Cstr_tuple _ as l, None ->
+          p fmt " of@ %s"
+            (self#normal_cstr_args ~par:false mod_name l);
+          [CodePre (flush())]
+      | Cstr_tuple t as l, Some r ->
+          let res = self#normal_type mod_name r in
+          if t = [] then
+            p fmt " :@ %s" res
+          else
+            p fmt " :@ %s -> %s" (self#normal_cstr_args ~par:false mod_name l) res
+          ;
+          [CodePre (flush())]
+      | Cstr_record l, None ->
+          p fmt " of@ ";
+          self#latex_of_record f mod_name l
+      | Cstr_record r, Some res ->
+          let l =
+            p fmt " :@ ";
+            self#latex_of_record f mod_name r in
+          let l2 =
+            p fmt "@ %s@ %s" "->"
+              (self#normal_type mod_name res);
+            [CodePre (flush())] in
+          l @ l2
+
+
+
+
+    (** Print LaTeX code for a type. *)
+    method latex_of_type fmt t =
+      let s_name = Name.simple t.ty_name in
+      let text =
+        let ( (fmt2, flush2) as f) = new_fmt () in
+        Odoc_info.reset_type_names () ;
+        let mod_name = Name.father t.ty_name in
+        Format.fprintf fmt2 "@[type ";
+        self#latex_of_type_params fmt2 mod_name t;
+        (match t.ty_parameters with [] -> () | _ -> ps fmt2 " ");
+        ps fmt2 s_name;
+        let priv = t.ty_private = Asttypes.Private in
+        (
+         match t.ty_manifest with
+         | Some (Other typ) ->
+             p fmt2 " = %s%s" (if priv then "private " else "") (self#normal_type mod_name typ)
+         | _ -> ()
+        );
+        let s_type3 =
+          p fmt2
+            " %s"
+            (
+             match t.ty_kind with
+               Type_abstract ->
+                begin match t.ty_manifest with
+                | Some (Object_type _) ->
+                  "= " ^ (if priv then "private" else "") ^ " <"
+                | _ -> ""
+                end
+             | Type_variant _ -> "="^(if priv then " private" else "")
+             | Type_record _ -> "= "^(if priv then "private " else "")
+             | Type_open -> "= .."
+            ) ;
+          flush2 ()
+        in
+
+        let defs =
+          match t.ty_kind with
+          | Type_abstract ->
+             begin match t.ty_manifest with
+             | Some (Object_type l) ->
+               let fields =
+                 List.map (fun r ->
+                   let s_field =
+                     p fmt2
+                       "@[  %s :@ %s ;"
+                       r.of_name
+                       (self#normal_type mod_name r.of_type);
+                     flush2 ()
+                   in
+                   [ CodePre s_field ] @ (self#entry_comment f r.of_text)
+                 ) l
+               in
+               List.flatten fields @ [ CodePre ">" ]
+
+             | None | Some (Other _) -> []
+             end
+          | Type_variant l ->
+             if l = [] then (p fmt2 "@[  |"; [CodePre (flush2())]) else (
+             let constructors =
+               List.map (fun {vc_name; vc_args; vc_ret; vc_text} ->
+                   p fmt2 "@[  | %s" vc_name ;
+                   let l = self#latex_of_cstr_args f mod_name (vc_args,vc_ret) in
+                   l @ (self#entry_comment f vc_text) ) l
+             in
+             List.flatten constructors)
+          | Type_record l ->
+              self#latex_of_record f mod_name l
+          | Type_open ->
+             (* FIXME ? *)
+             []
+        in
+        let defs2 = (CodePre s_type3) :: defs in
+        (merge_codepre defs2) @
+        [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @
+        (self#text_of_info t.ty_info)
+      in
+      self#latex_of_text fmt
+        ((Latex (self#make_label (self#type_label t.ty_name))) :: text)
+
+    (** Print LaTeX code for a type extension. *)
+    method latex_of_type_extension mod_name fmt te =
+      let text =
+        let (fmt2, flush2) as f = new_fmt () in
+        Odoc_info.reset_type_names () ;
+        Format.fprintf fmt2 "@[type ";
+        (
+          match te.te_type_parameters with
+              [] -> ()
+            | [p] ->
+                ps fmt2 (self#normal_type mod_name p);
+                ps fmt2 " "
+            | l ->
+                ps fmt2 "(";
+                print_concat fmt2 ", " (fun p -> ps fmt2 (self#normal_type mod_name p)) l;
+                ps fmt2 ") "
+        );
+        ps fmt2 (self#relative_idents mod_name te.te_type_name);
+        p fmt2 " +=%s" (if te.te_private = Asttypes.Private then " private" else "") ;
+        let s_type3 = flush2 () in
+        let defs =
+          (List.flatten
+             (List.map
+                (fun x ->
+                   let father = Name.father x.xt_name in
+                   p fmt2 "@[  | %s" (Name.simple x.xt_name);
+                   let l = self#latex_of_cstr_args f father (x.xt_args, x.xt_ret) in
+                   let c =
+                     match x.xt_alias with
+                     | None -> []
+                     | Some xa ->
+                         p fmt2 " = %s"
+                           (
+                             match xa.xa_xt with
+                             | None -> xa.xa_name
+                             | Some x -> x.xt_name
+                           );
+                         [CodePre (flush2 ())]
+                   in
+                    Latex (self#make_label (self#extension_label x.xt_name)) :: l @ c
+                    @ (match x.xt_text with
+                      None -> []
+                    | Some t ->
+                        let s =
+                          ps fmt2 "\\begin{ocamldoccomment}\n";
+                          self#latex_of_info fmt2 (Some t);
+                          ps fmt2 "\n\\end{ocamldoccomment}\n";
+                          flush2 ()
+                        in
+                        [ Latex s]
+                    )
+                  )
+                  te.te_constructors
+               )
+              )
+        in
+        let defs2 = (CodePre s_type3) :: defs in
+        (merge_codepre defs2) @
+        (self#text_of_info te.te_info)
+      in
+      self#latex_of_text fmt text
+
+    (** Print LaTeX code for an exception. *)
+    method latex_of_exception fmt e =
+      let text =
+        let (fmt2, flush2) as f = new_fmt() in
+        Odoc_info.reset_type_names () ;
+        let s_name = Name.simple e.ex_name in
+        let father = Name.father e.ex_name in
+        p fmt2 "@[exception %s" s_name;
+        let l = self#latex_of_cstr_args f father (e.ex_args, e.ex_ret) in
+        let s =
+          match e.ex_alias with
+            None -> []
+          | Some ea ->
+              Format.fprintf fmt " = %s"
+                (
+                  match ea.ea_ex with
+                    None -> ea.ea_name
+                  | Some e -> e.ex_name
+                );
+              [CodePre (flush2 ())]
+        in
+        Latex ( self#make_label (self#exception_label e.ex_name) ) ::
+       merge_codepre (l @ s ) @
+      [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")]
+       @ (self#text_of_info e.ex_info) in
+      self#latex_of_text fmt text
+
+    method latex_of_module_parameter fmt m_name p =
+      self#latex_of_text fmt
+        [
+          Code "functor (";
+          Code p.mp_name ;
+          Code " : ";
+        ] ;
+      self#latex_of_module_type_kind fmt m_name p.mp_kind;
+      self#latex_of_text fmt [ Code ") -> "]
+
+
+    method latex_of_module_type_kind fmt father kind =
+      match kind with
+        Module_type_struct eles ->
+          self#latex_of_text fmt [Latex "\\begin{ocamldocsigend}\n"];
+          List.iter (self#latex_of_module_element fmt father) eles;
+          self#latex_of_text fmt [Latex "\\end{ocamldocsigend}\n"]
+      | Module_type_functor (p, k) ->
+          self#latex_of_module_parameter fmt father p;
+          self#latex_of_module_type_kind fmt father k
+      | Module_type_alias a ->
+          self#latex_of_text fmt
+            [Code (self#relative_module_idents father a.mta_name)]
+      | Module_type_with (k, s) ->
+          self#latex_of_module_type_kind fmt father k;
+          self#latex_of_text fmt
+            [ Code " ";
+              Code (self#relative_idents father s);
+            ]
+      | Module_type_typeof s ->
+          self#latex_of_text fmt
+            [ Code "module type of ";
+              Code (self#relative_idents father s);
+            ]
+
+    method latex_of_module_kind fmt father kind =
+      match kind with
+        Module_struct eles ->
+          self#latex_of_text fmt [Latex "\\begin{ocamldocsigend}\n"];
+          List.iter (self#latex_of_module_element fmt father) eles;
+          self#latex_of_text fmt [Latex "\\end{ocamldocsigend}\n"]
+      | Module_alias a ->
+          self#latex_of_text fmt
+            [Code (self#relative_module_idents father a.ma_name)]
+      | Module_functor (p, k) ->
+          self#latex_of_module_parameter fmt father p;
+          self#latex_of_module_kind fmt father k
+      | Module_apply (k1, k2) ->
+          (* TODO: application is not correct in a .mli.
+             Fix? -> print the typedtree module_type *)
+          self#latex_of_module_kind fmt father k1;
+          self#latex_of_text fmt [Code "("];
+          self#latex_of_module_kind fmt father k2;
+          self#latex_of_text fmt [Code ")"]
+      | Module_with (k, s) ->
+          (* TODO: modify when Module_with will be more detailed *)
+          self#latex_of_module_type_kind fmt father k;
+          self#latex_of_text fmt
+            [ Code " ";
+              Code (self#relative_idents father s) ;
+            ]
+      | Module_constraint (k, _tk) ->
+          (* TODO: what should we print? *)
+          self#latex_of_module_kind fmt father k
+      | Module_typeof s ->
+          self#latex_of_text fmt
+            [ Code "module type of ";
+              Code (self#relative_idents father s);
+            ]
+      | Module_unpack (s, _) ->
+          self#latex_of_text fmt
+            [
+              Code (self#relative_idents father s);
+            ]
+
+    method latex_of_class_kind fmt father kind =
+      match kind with
+        Class_structure (inh, eles) ->
+          self#latex_of_text fmt [Latex "\\begin{ocamldocobjectend}\n"];
+          self#generate_inheritance_info fmt inh;
+          List.iter (self#latex_of_class_element fmt father) eles;
+          self#latex_of_text fmt [Latex "\\end{ocamldocobjectend}\n"]
+
+      | Class_apply _ ->
+          (* TODO: print final type from typedtree *)
+          self#latex_of_text fmt [Raw "class application not handled yet"]
+
+      | Class_constr cco ->
+          (
+           match cco.cco_type_parameters with
+             [] -> ()
+           | l ->
+               self#latex_of_text fmt
+                 (
+                  Code "[" ::
+                  (self#text_of_class_type_param_expr_list father l) @
+                  [Code "] "]
+                 )
+          );
+          self#latex_of_text fmt
+            [Code (self#relative_idents father cco.cco_name)]
+
+      | Class_constraint (ck, ctk) ->
+          self#latex_of_text fmt [Code "( "] ;
+          self#latex_of_class_kind fmt father ck;
+          self#latex_of_text fmt [Code " : "] ;
+          self#latex_of_class_type_kind fmt father ctk;
+          self#latex_of_text fmt [Code " )"]
+
+    method latex_of_class_type_kind fmt father kind =
+      match kind with
+        Class_type cta ->
+          (
+           match cta.cta_type_parameters with
+             [] -> ()
+           | l ->
+               self#latex_of_text fmt
+                 (Code "[" ::
+                  (self#text_of_class_type_param_expr_list father l) @
+                  [Code "] "]
+                 )
+          );
+          self#latex_of_text fmt
+            [Code (self#relative_idents father cta.cta_name)]
+
+      | Class_signature (inh, eles) ->
+          self#latex_of_text fmt [Latex "\\begin{ocamldocobjectend}\n"];
+          self#generate_inheritance_info fmt inh;
+          List.iter (self#latex_of_class_element fmt father) eles;
+          self#latex_of_text fmt [Latex "\\end{ocamldocobjectend}\n"]
+
+    method latex_for_module_index fmt m =
+      let s_name = Name.simple m.m_name in
+      self#latex_of_text fmt
+        [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^
+                (self#label ~no_:false s_name)^"`}\n"
+               )
+        ]
+
+    method latex_for_module_type_index fmt mt =
+      let s_name = Name.simple mt.mt_name in
+      self#latex_of_text fmt
+        [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^
+                (self#label ~no_:false (Name.simple s_name))^"`}\n"
+               )
+        ]
+
+    method latex_for_module_label fmt m =
+      ps fmt (self#make_label (self#module_label m.m_name))
+
+    method latex_for_module_type_label fmt mt =
+      ps fmt (self#make_label (self#module_type_label mt.mt_name))
+
+
+    method latex_for_class_index fmt c =
+      let s_name = Name.simple c.cl_name in
+      self#latex_of_text fmt
+        [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^
+                (self#label ~no_:false s_name)^"`}\n"
+               )
+        ]
+
+    method latex_for_class_type_index fmt ct =
+      let s_name = Name.simple ct.clt_name in
+      self#latex_of_text fmt
+        [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^
+                (self#label ~no_:false s_name)^"`}\n"
+               )
+        ]
+
+    method latex_for_class_label fmt c =
+      ps fmt (self#make_label (self#class_label c.cl_name))
+
+    method latex_for_class_type_label fmt ct =
+      ps fmt (self#make_label (self#class_type_label ct.clt_name))
+
+    (** Print the LaTeX code for the given module. *)
+    method latex_of_module fmt m =
+      let father = Name.father m.m_name in
+      let t =
+        [
+          Latex "\\begin{ocamldoccode}\n" ;
+          Code "module ";
+          Code (Name.simple m.m_name);
+          Code " : ";
+        ]
+      in
+      self#latex_of_text fmt t;
+      self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
+      self#latex_for_module_label fmt m;
+      self#latex_for_module_index fmt m;
+      p fmt "@[";
+      self#latex_of_module_kind fmt father m.m_kind;
+      (
+       match Module.module_is_functor m with
+         false -> ()
+       | true ->
+           self#latex_of_text fmt  [Newline];
+           (
+            match List.filter (fun (_,d) -> d <> None)
+                (module_parameters ~trans: false m)
+            with
+              [] -> ()
+            | l ->
+                let t =
+                  [ Bold [Raw "Parameters: "];
+                    List
+                      (List.map
+                         (fun (p,text_opt) ->
+                           let t = match text_opt with None -> [] | Some t -> t in
+                           ( Raw p.mp_name :: Raw ": " :: t)
+                         )
+                         l
+                      )
+                  ]
+           in
+           self#latex_of_text fmt t
+           );
+      );
+      self#latex_of_text fmt [Newline];
+      self#latex_of_info fmt ~block: true m.m_info;
+      p fmt "@]";
+
+
+    (** Print the LaTeX code for the given module type. *)
+    method latex_of_module_type fmt mt =
+      let father = Name.father mt.mt_name in
+      let t =
+        [
+          Latex "\\begin{ocamldoccode}\n" ;
+          Code "module type " ;
+          Code (Name.simple mt.mt_name);
+        ]
+      in
+      self#latex_of_text fmt t;
+      (
+       match mt.mt_type, mt.mt_kind with
+       | Some _, Some kind ->
+           self#latex_of_text fmt [ Code " = " ];
+           self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
+           self#latex_for_module_type_label fmt mt;
+           self#latex_for_module_type_index fmt mt;
+           p fmt "@[";
+           self#latex_of_module_type_kind fmt father kind
+       | _ ->
+           self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
+           self#latex_for_module_type_index fmt mt;
+           p fmt "@[";
+      );
+      (
+       match Module.module_type_is_functor mt with
+         false -> ()
+       | true ->
+           self#latex_of_text fmt [Newline];
+           (
+            match List.filter (fun (_,d) -> d <> None)
+                (module_type_parameters ~trans: false mt)
+            with
+              [] -> ()
+            | l ->
+                let t =
+                  [ Bold [Raw "Parameters: "];
+                    List
+                      (List.map
+                         (fun (p,text_opt) ->
+                           let t = match text_opt with None -> [] | Some t -> t in
+                           ( Raw p.mp_name :: Raw ": " :: t)
+                         )
+                         l
+                      )
+                  ]
+                in
+                self#latex_of_text fmt t
+           );
+      );
+      self#latex_of_text fmt [Newline];
+      self#latex_of_info fmt ~block: true mt.mt_info;
+      p fmt "@]";
+
+    (** Print the LaTeX code for the given included module. *)
+    method latex_of_included_module fmt im =
+      self#latex_of_text fmt
+        ((Code "include ") ::
+         (Code
+            (match im.im_module with
+              None -> im.im_name
+            | Some (Mod m) -> m.m_name
+            | Some (Modtype mt) -> mt.mt_name)
+         ) ::
+         (self#text_of_info im.im_info)
+        )
+
+    (** Print the LaTeX code for the given class. *)
+    method latex_of_class fmt c =
+      Odoc_info.reset_type_names () ;
+      let father = Name.father c.cl_name in
+      let type_params =
+        match c.cl_type_parameters with
+          [] -> ""
+        | l -> (self#normal_class_type_param_list father l)^" "
+      in
+      let t =
+        [
+          Latex "\\begin{ocamldoccode}\n" ;
+          Code (Printf.sprintf
+                  "class %s%s%s : "
+                  (if c.cl_virtual then "virtual " else "")
+                  type_params
+                  (Name.simple c.cl_name)
+               )
+        ]
+      in
+      self#latex_of_text fmt t;
+      self#latex_of_class_parameter_list fmt father c;
+      (* avoid a big gap if the kind is a constr *)
+      (
+       match c.cl_kind with
+         Class.Class_constr _ ->
+           self#latex_of_class_kind fmt father c.cl_kind
+       | _ ->
+           ()
+      );
+      self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
+      self#latex_for_class_label fmt c;
+      self#latex_for_class_index fmt c;
+      p fmt "@[";
+      (match c.cl_kind with
+        Class.Class_constr _ -> ()
+      |        _ -> self#latex_of_class_kind fmt father c.cl_kind
+      );
+      self#latex_of_text fmt [Newline];
+      self#latex_of_info fmt ~block: true c.cl_info;
+      p fmt "@]"
+
+    (** Print the LaTeX code for the given class type. *)
+    method latex_of_class_type fmt ct =
+      Odoc_info.reset_type_names () ;
+      let father = Name.father ct.clt_name in
+      let type_params =
+        match ct.clt_type_parameters with
+          [] -> ""
+        | l -> (self#normal_class_type_param_list father l)^" "
+      in
+      let t =
+        [
+          Latex "\\begin{ocamldoccode}\n" ;
+          Code (Printf.sprintf
+                  "class type %s%s%s = "
+                  (if ct.clt_virtual then "virtual " else "")
+                  type_params
+                  (Name.simple ct.clt_name)
+               )
+        ]
+      in
+      self#latex_of_text fmt t;
+
+      self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
+      self#latex_for_class_type_label fmt ct;
+      self#latex_for_class_type_index fmt ct;
+      p fmt "@[";
+      self#latex_of_class_type_kind fmt father ct.clt_kind;
+      self#latex_of_text fmt [Newline];
+      self#latex_of_info fmt ~block: true ct.clt_info;
+      p fmt "@]"
+
+    (** Print the LaTeX code for the given class element. *)
+    method latex_of_class_element fmt class_name class_ele =
+      self#latex_of_text fmt [Newline];
+      match class_ele with
+        Class_attribute att -> self#latex_of_attribute fmt att
+      | Class_method met -> self#latex_of_method fmt met
+      | Class_comment t ->
+          match t with
+          | [] -> ()
+          | (Title (_,_,_)) :: _ -> self#latex_of_text fmt t
+          | _ -> self#latex_of_text fmt [ Title ((Name.depth class_name) + 2, None, t) ]
+
+    (** Print the LaTeX code for the given module element. *)
+    method latex_of_module_element fmt module_name module_ele =
+      self#latex_of_text fmt [Newline];
+      match module_ele with
+        Element_module m -> self#latex_of_module fmt m
+      | Element_module_type mt -> self#latex_of_module_type fmt mt
+      | Element_included_module im -> self#latex_of_included_module fmt im
+      | Element_class c -> self#latex_of_class fmt c
+      | Element_class_type ct -> self#latex_of_class_type fmt ct
+      | Element_value v -> self#latex_of_value fmt v
+      | Element_type_extension te -> self#latex_of_type_extension module_name fmt te
+      | Element_exception e -> self#latex_of_exception fmt e
+      | Element_type t -> self#latex_of_type fmt t
+      | Element_module_comment t -> self#latex_of_text fmt t
+
+    (** Generate the LaTeX code for the given list of inherited classes.*)
+    method generate_inheritance_info fmt inher_l =
+      let f inh =
+        match inh.ic_class with
+          None -> (* we can't make the reference *)
+            Newline ::
+            Code ("inherit "^inh.ic_name) ::
+            (match inh.ic_text with
+              None -> []
+            | Some t -> Newline :: t
+            )
+        | Some cct ->
+            let label =
+              match cct with
+                Cl _ -> self#class_label inh.ic_name
+              | Cltype _ -> self#class_type_label inh.ic_name
+            in
+            (* we can create the reference *)
+            Newline ::
+            Odoc_info.Code ("inherit "^inh.ic_name) ::
+            (Odoc_info.Latex (" ["^(self#make_ref label)^"]")) ::
+            (match inh.ic_text with
+              None -> []
+            | Some t -> Newline :: t
+            )
+      in
+      List.iter (self#latex_of_text fmt) (List.map f inher_l)
+
+    (** Generate the LaTeX code for the inherited classes of the given class. *)
+    method generate_class_inheritance_info fmt cl =
+      let rec iter_kind k =
+        match k with
+          Class_structure ([], _) ->
+            ()
+        | Class_structure (l, _) ->
+            self#generate_inheritance_info fmt l
+        | Class_constraint (k, _) ->
+            iter_kind k
+        | Class_apply _
+        | Class_constr _ ->
+            ()
+      in
+      iter_kind cl.cl_kind
+
+    (** Generate the LaTeX code for the inherited classes of the given class type. *)
+    method generate_class_type_inheritance_info fmt clt =
+      match clt.clt_kind with
+        Class_signature ([], _) ->
+          ()
+      | Class_signature (l, _) ->
+          self#generate_inheritance_info fmt l
+      | Class_type _ ->
+          ()
+
+    (** Generate the LaTeX code for the given top module, in the given buffer. *)
+    method generate_for_top_module fmt m =
+      let (first_t, rest_t) = self#first_and_rest_of_info m.m_info in
+      let text =
+        let title =
+          if m.m_text_only then [Raw m.m_name]
+          else [ Raw (Odoc_messages.modul^" ") ; Code m.m_name ] in
+        let subtitle = match first_t with
+          | [] -> []
+          | t -> (Raw " : ") :: t in
+        [ Title (0, None, title @ subtitle ) ]
+      in
+      self#latex_of_text fmt text;
+      self#latex_for_module_label fmt m;
+      self#latex_for_module_index fmt m;
+      self#latex_of_text fmt rest_t ;
+
+      self#latex_of_text fmt [ Newline ] ;
+      if not m.m_text_only then ps fmt "\\ocamldocvspace{0.5cm}\n\n";
+      List.iter
+        (fun ele ->
+          self#latex_of_module_element fmt m.m_name ele;
+          ps fmt "\n\n"
+        )
+        (Module.module_elements ~trans: false m)
+
+    (** Print the header of the TeX document. *)
+    method latex_header fmt module_list =
+      ps fmt "\\documentclass[11pt]{article} \n";
+      ps fmt "\\usepackage[latin1]{inputenc} \n";
+      ps fmt "\\usepackage[T1]{fontenc} \n";
+      ps fmt "\\usepackage{textcomp}\n";
+      ps fmt "\\usepackage{fullpage} \n";
+      ps fmt "\\usepackage{url} \n";
+      ps fmt "\\usepackage{ocamldoc}\n";
+      (
+       match !Global.title with
+         None -> ()
+       | Some s ->
+           ps fmt "\\title{";
+           ps fmt (self#escape s);
+           ps fmt "}\n"
+      );
+      ps fmt "\\begin{document}\n";
+      (match !Global.title with
+        None -> () |
+        Some _ -> ps fmt "\\maketitle\n"
+      );
+      if !Global.with_toc then ps fmt "\\tableofcontents\n";
+      (
+       let info = Odoc_info.apply_opt
+           (Odoc_info.info_of_comment_file module_list)
+           !Odoc_info.Global.intro_file
+       in
+       (match info with None -> () | Some _ -> ps fmt "\\vspace{0.2cm}");
+       self#latex_of_info fmt info;
+       (match info with None -> () | Some _ -> ps fmt "\n\n")
+      )
+
+
+    (** Generate the LaTeX style file, if it does not exist. *)
+    method generate_style_file =
+      try
+        let dir = Filename.dirname !Global.out_file in
+        let file = Filename.concat dir "ocamldoc.sty" in
+        if Sys.file_exists file then
+          Odoc_info.verbose (Odoc_messages.file_exists_dont_generate file)
+        else
+          (
+           let chanout = open_out file in
+           output_string chanout Odoc_latex_style.content ;
+           flush chanout ;
+           close_out chanout;
+           Odoc_info.verbose (Odoc_messages.file_generated file)
+          )
+      with
+        Sys_error s ->
+          prerr_endline s ;
+          incr Odoc_info.errors ;
+
+    (** Generate the LaTeX file from a module list, in the {!Odoc_info.Global.out_file} file. *)
+    method generate module_list =
+      self#generate_style_file ;
+      let main_file = !Global.out_file in
+      let dir = Filename.dirname main_file in
+      if !separate_files then
+        (
+         let f m =
+           try
+             let chanout =
+               open_out ((Filename.concat dir (Name.simple m.m_name))^".tex")
+             in
+             let fmt = Format.formatter_of_out_channel chanout in
+             self#generate_for_top_module fmt m ;
+             Format.pp_print_flush fmt ();
+             close_out chanout
+           with
+             Failure s
+           | Sys_error s ->
+               prerr_endline s ;
+               incr Odoc_info.errors
+         in
+         List.iter f module_list
+        );
+
+      try
+        let chanout = open_out main_file in
+        let fmt = Format.formatter_of_out_channel chanout in
+        if !Global.with_header then self#latex_header fmt module_list;
+        List.iter
+          (fun m ->
+            if !separate_files then
+              ps fmt ("\\input{"^((Name.simple m.m_name))^".tex}\n")
+            else
+              self#generate_for_top_module fmt m
+          )
+          module_list ;
+        if !Global.with_trailer then ps fmt "\\end{document}\n";
+        Format.pp_print_flush fmt ();
+        close_out chanout
+      with
+        Failure s
+      | Sys_error s ->
+          prerr_endline s ;
+          incr Odoc_info.errors
+  end
+end
+
+module type Latex_generator = module type of Generator
diff --git a/ocamldoc/odoc_latex_style.ml b/ocamldoc/odoc_latex_style.ml
new file mode 100644
index 00000000..e3453e2e
--- /dev/null
+++ b/ocamldoc/odoc_latex_style.ml
@@ -0,0 +1,93 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** 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"
diff --git a/ocamldoc/odoc_lexer.mll b/ocamldoc/odoc_lexer.mll
new file mode 100644
index 00000000..8749d123
--- /dev/null
+++ b/ocamldoc/odoc_lexer.mll
@@ -0,0 +1,422 @@
+{
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The lexer for special comments. *)
+
+open Lexing
+open Odoc_parser
+
+let line_number = ref 0
+
+
+let string_buffer = Buffer.create 32
+
+(** Reset the buffer *)
+let reset_string_buffer () = Buffer.reset string_buffer
+
+(** Add a character to the buffer *)
+let add_char_string = Buffer.add_char string_buffer
+
+(** Add a string to the buffer. *)
+let add_string = Buffer.add_string string_buffer
+
+let read_string () = Buffer.contents string_buffer
+
+(** The variable which will contain the description string.
+   Is initialized when we encounter the start of a special comment. *)
+let description = ref ""
+
+let blank = "[ \013\009\012]"
+
+(** The nested comments level. *)
+let comments_level = ref 0
+
+let print_DEBUG2 s = print_string s; print_newline ()
+
+(** This function returns the given string without the leading and trailing blanks.*)
+let remove_blanks s =
+  print_DEBUG2 ("remove_blanks "^s);
+  let l = Str.split_delim (Str.regexp "\n") s in
+  let l2 =
+    let rec iter liste =
+      match liste with
+        h :: q ->
+          let h2 = Str.global_replace (Str.regexp ("^"^blank^"+")) "" h in
+          if h2 = "" then
+            (
+             print_DEBUG2 (h^" n'a que des blancs");
+             (* we remove this line and must remove leading blanks of the next one *)
+             iter q
+            )
+          else
+            (* we don't remove leading blanks in the remaining lines *)
+            h2 :: q
+      | _ ->
+          []
+    in iter l
+  in
+  let l3 =
+    let rec iter liste =
+      match liste with
+        h :: q ->
+          let h2 = Str.global_replace (Str.regexp (blank^"+$")) "" h in
+          if h2 = "" then
+            (
+             print_DEBUG2 (h^" n'a que des blancs");
+             (* we remove this line and must remove trailing blanks of the next one *)
+             iter q
+            )
+          else
+            (* we don't remove trailing blanks in the remaining lines *)
+            h2 :: q
+      | _ ->
+          []
+    in
+    List.rev (iter (List.rev l2))
+  in
+  String.concat "\n" l3
+
+(** 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 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']
+
+rule main = parse
+    [' ' '\013' '\009' '\012'] +
+      {
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length (Lexing.lexeme lexbuf));
+        main lexbuf
+      }
+
+  | [ '\010' ]
+      {
+        incr line_number;
+        incr Odoc_comments_global.nb_chars;
+        main lexbuf
+      }
+  | "(**)"
+      {
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length (Lexing.lexeme lexbuf));
+        Description ("", None)
+      }
+
+  | "(**"("*"+)")"
+      {
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length (Lexing.lexeme lexbuf));
+        main lexbuf
+      }
+
+  | "(***"
+      {
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length (Lexing.lexeme lexbuf));
+        incr comments_level;
+        main lexbuf
+      }
+
+  | "(**"
+      {
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length (Lexing.lexeme lexbuf));
+        incr comments_level;
+        if !comments_level = 1 then
+          (
+           reset_string_buffer ();
+           description := "";
+           special_comment lexbuf
+          )
+        else
+          main lexbuf
+      }
+
+  | eof
+      { EOF }
+
+  |  "*)"
+      {
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length (Lexing.lexeme lexbuf));
+        decr comments_level ;
+        main lexbuf
+      }
+
+  |  "(*"
+      {
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length (Lexing.lexeme lexbuf));
+        incr comments_level ;
+        main lexbuf
+      }
+
+  | _
+      {
+        incr Odoc_comments_global.nb_chars;
+        main lexbuf
+      }
+
+and special_comment = parse
+  | "*)"
+      {
+        let s = Lexing.lexeme lexbuf in
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length s);
+        if !comments_level = 1 then
+          (
+           (* there is just a description *)
+           let s2 = read_string () in
+           let s3 = remove_blanks s2 in
+           let s4 =
+             if !Odoc_global.remove_stars then
+               remove_stars s3
+             else
+               s3
+           in
+           Description (s4, None)
+          )
+        else
+          (
+           add_string s;
+           decr comments_level;
+           special_comment lexbuf
+          )
+      }
+
+  |  "(*"
+      {
+        let s = Lexing.lexeme lexbuf in
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length s);
+        incr comments_level ;
+        add_string s;
+        special_comment lexbuf
+      }
+
+  | "\\@"
+      {
+        let s = Lexing.lexeme lexbuf in
+        let c = (Lexing.lexeme_char lexbuf 1) in
+        add_char_string c;
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length s);
+        special_comment lexbuf
+      }
+
+  | "@"lowercase+
+      {
+        (* we keep the description before we go further *)
+        let s = read_string () in
+        description := remove_blanks s;
+        reset_string_buffer ();
+        let len = String.length (Lexing.lexeme lexbuf) in
+        lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - len;
+        lexbuf.Lexing.lex_curr_p <-
+          { lexbuf.Lexing.lex_curr_p with
+            pos_cnum = lexbuf.Lexing.lex_curr_p.pos_cnum - len
+          } ;
+        (* we don't increment the Odoc_comments_global.nb_chars *)
+        special_comment_part2 lexbuf
+      }
+
+  | _
+      {
+        let c = (Lexing.lexeme_char lexbuf 0) in
+        add_char_string c;
+        if c = '\010' then incr line_number;
+        incr Odoc_comments_global.nb_chars;
+        special_comment lexbuf
+      }
+
+and special_comment_part2 = parse
+  | "*)"
+      {
+        let s = Lexing.lexeme lexbuf in
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length s);
+        if !comments_level = 1 then
+          (* finally we return the description we kept *)
+          let desc =
+            if !Odoc_global.remove_stars then
+              remove_stars !description
+             else
+              !description
+          in
+          let remain = read_string () in
+          let remain2 =
+            if !Odoc_global.remove_stars then
+              remove_stars remain
+             else
+               remain
+          in
+          Description (desc, Some remain2)
+        else
+          (
+           add_string s ;
+           decr comments_level ;
+           special_comment_part2 lexbuf
+          )
+      }
+
+  |  "(*"
+      {
+        let s = Lexing.lexeme lexbuf in
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length s);
+        add_string s;
+        incr comments_level ;
+        special_comment_part2 lexbuf
+      }
+
+  | _
+      {
+        let c = (Lexing.lexeme_char lexbuf 0) in
+        add_char_string c;
+        if c = '\010' then incr line_number;
+        incr Odoc_comments_global.nb_chars;
+        special_comment_part2 lexbuf
+      }
+
+and elements = parse
+  | [' ' '\013' '\009' '\012'] +
+      {
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length (Lexing.lexeme lexbuf));
+        elements lexbuf
+      }
+
+  | [ '\010' ]
+      { incr line_number;
+        incr Odoc_comments_global.nb_chars;
+        print_DEBUG2 "newline";
+        elements lexbuf }
+  | "@"
+      {
+        raise (Failure (Odoc_messages.should_escape_at_sign))
+      }
+
+  | "@"lowercase+
+      {
+        let s = Lexing.lexeme lexbuf in
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length s);
+        let s2 = String.sub s 1 ((String.length s) - 1) in
+        print_DEBUG2 s2;
+        match s2 with
+          "param" ->
+            T_PARAM
+         | "author" ->
+            T_AUTHOR
+         | "version" ->
+             T_VERSION
+         | "see" ->
+             T_SEE
+         | "since" ->
+             T_SINCE
+         | "before" ->
+             T_BEFORE
+         | "deprecated" ->
+             T_DEPRECATED
+         | "raise" ->
+             T_RAISES
+         | "return" ->
+             T_RETURN
+         | s ->
+             if !Odoc_global.no_custom_tags then
+               raise (Failure (Odoc_messages.not_a_valid_tag s))
+             else
+               T_CUSTOM s
+      }
+
+  | ("\\@" | [^'@'])+
+      {
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length (Lexing.lexeme lexbuf));
+        let s = Lexing.lexeme lexbuf in
+        let s = Str.global_replace (Str.regexp_string "\\@") "@" s in
+        let s = remove_blanks s in
+        print_DEBUG2 ("Desc "^s);
+        Desc s
+      }
+  | eof
+      {
+        EOF
+      }
+  | _ {
+        let s = Lexing.lexeme lexbuf in
+        failwith ("Unexpected character '"^s^"'")
+      }
+
+
+and simple = parse
+    [' ' '\013' '\009' '\012'] +
+      {
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length (Lexing.lexeme lexbuf));
+        simple lexbuf
+      }
+
+  | [ '\010' ]
+      { incr line_number;
+        incr Odoc_comments_global.nb_chars;
+        simple lexbuf
+      }
+
+  | "(**"("*"+)
+      {
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length (Lexing.lexeme lexbuf));
+        incr comments_level;
+        simple lexbuf
+      }
+
+  | "(*"("*"+)")"
+      {
+        let s = Lexing.lexeme lexbuf in
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length s);
+        simple lexbuf
+      }
+  | "(**"
+      {
+        let s = Lexing.lexeme lexbuf in
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length s);
+        incr comments_level;
+        simple lexbuf
+      }
+
+  | "(*"
+      {
+        let s = Lexing.lexeme lexbuf in
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length s);
+        incr comments_level;
+        if !comments_level = 1 then
+          (
+           reset_string_buffer ();
+           description := "";
+           special_comment lexbuf
+          )
+        else
+          (
+           add_string s;
+           simple lexbuf
+          )
+      }
+
+  | eof
+      { EOF }
+
+  |  "*)"
+      {
+        let s = Lexing.lexeme lexbuf in
+        Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length s);
+        decr comments_level ;
+        simple lexbuf
+      }
+
+  | _
+      {
+        incr Odoc_comments_global.nb_chars;
+        simple lexbuf
+      }
diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml
new file mode 100644
index 00000000..b2d4cb80
--- /dev/null
+++ b/ocamldoc/odoc_man.ml
@@ -0,0 +1,1319 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The man pages generator. *)
+open Odoc_info
+open Value
+open Type
+open Extension
+open Exception
+open Class
+open Module
+open Search
+
+let man_suffix = ref Odoc_messages.default_man_suffix
+let man_section = ref Odoc_messages.default_man_section
+
+let man_mini = ref false
+
+let new_buf () = Buffer.create 1024
+let bp = Printf.bprintf
+let bs = Buffer.add_string
+
+let linebreak = "\n.sp\n";;
+
+(** A class used to get a [text] for info structures. *)
+class virtual info =
+  object (self)
+    (** The list of pairs [(tag, f)] where [f] is a function taking
+       the [text] associated to [tag] and returning man code.
+       Add a pair here to handle a tag.*)
+    val mutable tag_functions = ([] : (string * (Odoc_info.text -> string)) list)
+
+    (** Return man code for a [text]. *)
+    method virtual man_of_text : Buffer.t -> Odoc_info.text -> unit
+
+    method str_man_of_text t =
+      let b = Buffer.create 256 in
+      self#man_of_text b t ;
+      Buffer.contents b
+
+    (** Print groff string for an author list. *)
+    method str_man_of_author_list l =
+      match l with
+        [] -> ""
+      | _ ->
+          let b = Buffer.create 256 in
+          bs b ".B \"";
+          bs b Odoc_messages.authors;
+          bs b "\"\n:\n";
+          bs b (String.concat ", " l);
+          bs b "\n";
+          (*bs b "\n.sp\n"*)
+          Buffer.contents b
+
+    (** Print groff string for the given optional version information.*)
+    method str_man_of_version_opt v_opt =
+      match v_opt with
+        None -> ""
+      | Some v ->
+          let b = Buffer.create 256 in
+          bs b ".B \"";
+          bs b Odoc_messages.version;
+          bs b "\"\n:\n";
+          bs b v;
+          bs b "\n";
+          (*".sp\n"*)
+          Buffer.contents b
+
+    (** Printf groff string for the \@before information. *)
+    method str_man_of_before = function
+      [] -> ""
+    | l ->
+        let b = Buffer.create 256 in
+        let rec iter = function
+          [] -> ()
+        | (v, text) :: q ->
+             bp b ".B \"%s" Odoc_messages.before;
+             bs b v;
+             bs b "\"\n";
+             self#man_of_text b text;
+             bs b "\n";
+             bs b "\n";
+             match q with
+               [] -> ()
+             | _ -> bs b linebreak ; iter q
+        in
+        iter l;
+        Buffer.contents b
+
+    (** Print groff string for the given optional since information.*)
+    method str_man_of_since_opt s_opt =
+      match s_opt with
+        None -> ""
+      | Some s ->
+          let b = Buffer.create 256 in
+          bs b ".B \"";
+          bs b Odoc_messages.since;
+          bs b "\"\n";
+          bs b s;
+          bs b "\n";(*".sp\n"*)
+          Buffer.contents b
+
+    (** Print groff string for the given list of raised exceptions.*)
+    method str_man_of_raised_exceptions l =
+      match l with
+        [] -> ""
+      | _ ->
+          let b = Buffer.create 256 in
+          let rec iter = function
+            [] -> ()
+          | (s, t) :: q ->
+              bs b ".B \"";
+              bs b Odoc_messages.raises;
+              bs b (" "^s^"\"\n");
+              self#man_of_text b t;
+              bs b "\n";
+              match q with
+                [] -> ()
+              | _ -> bs b linebreak; iter q
+          in
+          iter l;
+          Buffer.contents b
+
+    (** Print groff string for the given "see also" reference. *)
+    method str_man_of_see (see_ref, t)  =
+      let t_ref =
+        match see_ref with
+          Odoc_info.See_url s -> [ Odoc_info.Link (s, t) ]
+        | Odoc_info.See_file s -> (Odoc_info.Code s) :: (Odoc_info.Raw " ") :: t
+        | Odoc_info.See_doc s -> (Odoc_info.Italic [Odoc_info.Raw s]) :: (Odoc_info.Raw " ") :: t
+      in
+      self#str_man_of_text t_ref
+
+    (** Print groff string for the given list of "see also" references.*)
+    method str_man_of_sees l =
+      match l with
+        [] -> ""
+      | _ ->
+          let b = Buffer.create 256 in
+          let rec iter = function
+            [] -> ()
+          | see :: q ->
+              bs b ".B \"";
+              bs b Odoc_messages.see_also;
+              bs b "\"\n";
+              bs b (self#str_man_of_see see);
+              bs b "\n";
+              match q with
+                [] -> ()
+              | _ -> bs b linebreak; iter q
+          in
+          iter l;
+          Buffer.contents b
+
+    (** Print groff string for the given optional return information.*)
+    method str_man_of_return_opt return_opt =
+      match return_opt with
+        None -> ""
+      | Some s ->
+          let b = Buffer.create 256 in
+          bs b ".B ";
+          bs b Odoc_messages.returns;
+          bs b "\n";
+          self#man_of_text b s;
+          bs b "\n";
+          Buffer.contents b
+
+    (** Print man code for the given list of custom tagged texts. *)
+    method str_man_of_custom l =
+      List.fold_left
+        (fun acc (tag, text) ->
+           try
+             let f = List.assoc tag tag_functions in
+             let buf = Buffer.create 50 in
+             Buffer.add_string buf (f text);
+             (Buffer.contents buf) :: acc
+          with
+            Not_found ->
+              Odoc_info.warning (Odoc_messages.tag_not_handled tag);
+              acc
+        )
+        [] l
+
+    (** Print the groff string to display an optional info structure. *)
+    method man_of_info ?margin:(_ :int option) b info_opt =
+        match info_opt with
+        None -> ()
+      | Some info ->
+          let module M = Odoc_info in
+          let l =
+            (
+           match info.M.i_deprecated with
+             None -> []
+           | Some d ->
+               let b = Buffer.create 256 in
+               bs b ".B \"";
+               bs b Odoc_messages.deprecated;
+               bs b "\"\n";
+               self#man_of_text b d;
+               bs b "\n";
+               [ Buffer.contents b ]
+            ) @
+              (
+               match info.M.i_desc with
+                 None -> []
+               | Some d when d = [Odoc_info.Raw ""] -> []
+               | Some d ->
+                   [ (self#str_man_of_text d)^"\n" ]
+              ) @
+              [
+                self#str_man_of_author_list info.M.i_authors;
+                self#str_man_of_version_opt info.M.i_version;
+                self#str_man_of_before info.M.i_before;
+                self#str_man_of_since_opt info.M.i_since;
+                self#str_man_of_raised_exceptions info.M.i_raised_exceptions;
+                self#str_man_of_return_opt info.M.i_return_value;
+                self#str_man_of_sees info.M.i_sees;
+              ] @
+                (self#str_man_of_custom info.M.i_custom)
+          in
+          let l = List.filter ((<>) "") l in
+          Buffer.add_string b (String.concat "\n.sp\n" l)
+  end
+
+module Generator =
+struct
+
+(** This class is used to create objects which can generate a simple html documentation. *)
+class man =
+  let re_slash = Str.regexp_string "/" in
+  object (self)
+    inherit info
+
+    (** Get a file name from a complete name. *)
+    method file_name name =
+      let s = Printf.sprintf "%s.%s" name !man_suffix in
+      Str.global_replace re_slash "slash" s
+
+    (** Escape special sequences of characters in a string. *)
+    method escape (s : string) =
+      let len = String.length s in
+      let b = Buffer.create len in
+      for i = 0 to len - 1 do
+        match s.[i] with
+          '\\' -> Buffer.add_string b "\\(rs"
+        | '.' -> Buffer.add_string b "\\&."
+        | '\'' -> Buffer.add_string b "\\&'"
+        | '-' -> Buffer.add_string b "\\-"
+        | c -> Buffer.add_char b c
+      done;
+      Buffer.contents b
+
+    (** Open a file for output. Add the target directory.*)
+    method open_out file =
+      let f = Filename.concat !Global.target_dir file in
+      open_out f
+
+    (** Print groff string for a text, without correction of blanks. *)
+    method private man_of_text2 b t =
+      List.iter (self#man_of_text_element b) t
+
+    (** Print the groff string for a text, with blanks corrected. *)
+    method man_of_text b t =
+      let b2 = new_buf () in
+      self#man_of_text2 b2 t ;
+      let s = Buffer.contents b2 in
+      let s2 = Str.global_replace (Str.regexp "\n[ ]*") "\n" s in
+      bs b (Str.global_replace (Str.regexp "\n\n") "\n" s2)
+
+    (** Return the given string without no newlines. *)
+    method remove_newlines s =
+      Str.global_replace (Str.regexp "[ ]*\n[ ]*") " " s
+
+    (** Print the groff string for a text element. *)
+    method man_of_text_element b txt =
+      match txt with
+      | Odoc_info.Raw s -> bs b (self#escape s)
+      | Odoc_info.Code s -> self#man_of_code b s
+      | Odoc_info.CodePre s ->
+         bs b "\n.EX";
+         self#man_of_code b s;
+         bs b "\n.EE";
+      | Odoc_info.Verbatim s ->
+          bs b (self#escape s)
+      | Odoc_info.Bold t
+      | Odoc_info.Italic t
+      | Odoc_info.Emphasize t
+      | Odoc_info.Center t
+      | Odoc_info.Left t
+      | Odoc_info.Right t ->
+          self#man_of_text2 b t
+      | Odoc_info.List tl ->
+          List.iter
+            (fun t -> bs b "\n.sp\n \\-"; self#man_of_text2 b t; bs b "\n")
+            tl;
+          bs b "\n"
+      | Odoc_info.Enum tl ->
+          List.iter
+            (fun t -> bs b "\n.sp\n \\-"; self#man_of_text2 b t; bs b "\n")
+            tl;
+          bs b "\n"
+      | Odoc_info.Newline ->
+          bs b "\n.sp\n"
+      | Odoc_info.Block t ->
+          bs b "\n.sp\n";
+          self#man_of_text2 b t;
+          bs b "\n.sp\n"
+      | Odoc_info.Title (_, _, t) ->
+          let txt = Odoc_info.string_of_text t in
+          bp b ".SS %s\n" txt
+      | Odoc_info.Latex _ ->
+          (* don't care about LaTeX stuff in HTML. *)
+          ()
+      | Odoc_info.Link (_, t) ->
+          self#man_of_text2 b t
+      | Odoc_info.Ref (name, _, _) ->
+          self#man_of_text_element b
+            (Odoc_info.Code (Odoc_info.use_hidden_modules name))
+      | Odoc_info.Superscript t ->
+          bs b "^"; self#man_of_text2 b t
+      | Odoc_info.Subscript t ->
+          bs b "_"; self#man_of_text2 b t
+      | Odoc_info.Module_list _ ->
+          ()
+      | Odoc_info.Index_list ->
+          ()
+      | Odoc_info.Custom (s,t) -> self#man_of_custom_text b s t
+      | Odoc_info.Target (target, code) -> self#man_of_Target b ~target ~code
+
+    method man_of_custom_text _ _ _ = ()
+
+    method man_of_Target b ~target ~code =
+      if String.lowercase_ascii target = "man" then bs b code else ()
+
+    (** Print groff string to display code. *)
+    method man_of_code b code =
+      let code = self#escape code in
+      bs b "\n.ft B\n";
+      bs b (Str.global_replace (Str.regexp "\n") "\n.br\n\\&" code);
+      bs b "\n.ft R\n";
+
+    (** Take a string and return the string where fully qualified idents
+       have been replaced by idents relative to the given module name.*)
+    method relative_idents m_name s =
+      let f str_t =
+        let match_s = Str.matched_string str_t in
+        Odoc_info.apply_if_equal
+          Odoc_info.use_hidden_modules
+          match_s
+          (Name.get_relative m_name match_s)
+      in
+      Str.global_substitute
+        (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([a-z][a-zA-Z_'0-9]*\\)")
+        f
+        s
+
+    (** Print groff string to display a [Types.type_expr].*)
+    method man_of_type_expr b m_name t =
+      let s = String.concat "\n"
+          (Str.split (Str.regexp "\n") (Odoc_print.string_of_type_expr t))
+      in
+      let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in
+      bs b "\n.B ";
+      bs b (self#relative_idents m_name s2);
+      bs b "\n"
+
+    (** Print groff string to display a [Types.class_type].*)
+    method man_of_class_type_expr b m_name t =
+      let s = String.concat "\n"
+          (Str.split (Str.regexp "\n") (Odoc_print.string_of_class_type t))
+      in
+      let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in
+      bs b "\n.B ";
+      bs b (self#relative_idents m_name s2);
+      bs b "\n"
+
+    (** Print groff string to display a [Types.type_expr list].*)
+    method man_of_cstr_args ?par b m_name sep l =
+        match l with
+        | Cstr_tuple l ->
+            let s = Odoc_str.string_of_type_list ?par sep l in
+            let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in
+            bs b "\n.B ";
+            bs b (self#relative_idents m_name s2);
+            bs b "\n"
+        | Cstr_record l ->
+            self#man_of_record m_name b l
+
+    (** Print groff string to display the parameters of a type.*)
+    method man_of_type_expr_param_list b m_name t =
+      match t.ty_parameters with
+        [] -> ()
+      | _ ->
+          let s = Odoc_str.string_of_type_param_list t in
+          let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in
+          bs b "\n.B ";
+          bs b (self#relative_idents m_name s2);
+          bs b "\n"
+
+    (** Print groff string to display a [Types.module_type]. *)
+    method man_of_module_type b m_name t =
+      let s = String.concat "\n"
+          (Str.split (Str.regexp "\n") (Odoc_print.string_of_module_type t))
+      in
+      let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in
+      bs b "\n.B ";
+      bs b (self#relative_idents m_name s2);
+      bs b "\n"
+
+    (** Print groff string code for a value. *)
+    method man_of_value b v =
+      Odoc_info.reset_type_names () ;
+      bs b "\n.I val ";
+      bs b (Name.simple v.val_name);
+      bs b " \n: ";
+      self#man_of_type_expr b (Name.father v.val_name) v.val_type;
+      bs b ".sp\n";
+      self#man_of_info b v.val_info;
+      bs b "\n.sp\n"
+
+    (** Print groff string code for a type extension. *)
+    method man_of_type_extension b m_name te =
+      Odoc_info.reset_type_names () ;
+      bs b ".I type ";
+      (
+        match te.te_type_parameters with
+            [] -> ()
+          | _ ->
+              let s = Odoc_str.string_of_type_extension_param_list te in
+              let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in
+                bs b "\n.B ";
+                bs b (self#relative_idents m_name s2);
+                bs b "\n";
+                bs b ".I "
+      );
+      bs b (self#relative_idents m_name te.te_type_name);
+      bs b " \n";
+      bs b "+=";
+      if te.te_private = Asttypes.Private then bs b " private";
+      bs b "\n ";
+      List.iter
+        (fun x ->
+           let father = Name.father x.xt_name in
+           bs b ("| "^(Name.simple x.xt_name));
+           (
+             match x.xt_args, x.xt_ret with
+               | Cstr_tuple [], None -> bs b "\n"
+               | l, None ->
+                   bs b "\n.B of ";
+                   self#man_of_cstr_args ~par: false b father " * " l;
+               | Cstr_tuple [], Some r ->
+                   bs b "\n.B : ";
+                   self#man_of_type_expr b father r;
+               | l, Some r ->
+                   bs b "\n.B : ";
+                   self#man_of_cstr_args ~par: false b father " * " l;
+                   bs b ".B -> ";
+                   self#man_of_type_expr b father r;
+           );
+           (
+             match x.xt_alias with
+                 None -> ()
+               | Some xa ->
+                   bs b ".B = ";
+                   bs b
+                     (
+                       match xa.xa_xt with
+                           None -> xa.xa_name
+                         | Some x -> x.xt_name
+                     );
+                   bs b "\n"
+           );
+           (
+             match x.xt_text with
+                 None ->
+                   bs b " "
+               | Some t ->
+                   bs b ".I \"  \"\n";
+                   bs b "(* ";
+                   self#man_of_info b (Some t);
+                   bs b " *)\n "
+           )
+        )
+        te.te_constructors;
+      bs b "\n.sp\n";
+      self#man_of_info b te.te_info;
+      bs b "\n.sp\n"
+
+    (** Print groff string code for an exception. *)
+    method man_of_exception b e =
+      Odoc_info.reset_type_names () ;
+      bs b "\n.I exception ";
+      bs b (Name.simple e.ex_name);
+      bs b " \n";
+      (
+        match e.ex_args, e.ex_ret with
+        | Cstr_tuple [], None -> ()
+        | _, None ->
+           bs b ".B of ";
+           self#man_of_cstr_args
+             ~par: false
+             b (Name.father e.ex_name) " * " e.ex_args
+        | Cstr_tuple [], Some r ->
+            bs b ".B : ";
+            self#man_of_type_expr b (Name.father e.ex_name) r
+        | l, Some r ->
+            bs b ".B : ";
+            self#man_of_cstr_args
+                   ~par: false
+                   b (Name.father e.ex_name) " * " l;
+            bs b ".B -> ";
+            self#man_of_type_expr b (Name.father e.ex_name) r
+      );
+      (
+       match e.ex_alias with
+         None -> ()
+       | Some ea ->
+           bs b " = ";
+           bs b
+             (
+              match ea.ea_ex with
+                None -> ea.ea_name
+              | Some e -> e.ex_name
+             )
+      );
+      bs b "\n.sp\n";
+      self#man_of_info b e.ex_info;
+      bs b "\n.sp\n"
+
+
+    method field_comment b = function
+      | None -> ()
+      | Some t ->
+          bs b "  (* ";
+          self#man_of_info b (Some t);
+          bs b " *) "
+
+    (** Print groff string for a record type *)
+    method man_of_record father b l =
+          bs b "{";
+           List.iter (fun r ->
+             bs b (if r.rf_mutable then "\n\n.B mutable \n" else "\n ");
+             bs b (r.rf_name^" : ");
+             self#man_of_type_expr b father r.rf_type;
+             bs b ";";
+             self#field_comment b r.rf_text ;
+           ) l;
+          bs b "\n }\n"
+
+
+    (** Print groff string for a type. *)
+    method man_of_type b t =
+      Odoc_info.reset_type_names () ;
+      let father = Name.father t.ty_name in
+      bs b ".I type ";
+      self#man_of_type_expr_param_list b father t;
+      (
+       match t.ty_parameters with
+         [] -> ()
+       | _ -> bs b ".I "
+      );
+      bs b (Name.simple t.ty_name);
+      bs b " \n";
+      let priv = t.ty_private = Asttypes.Private in
+      (
+       match t.ty_manifest with
+         None -> ()
+       | Some (Object_type l) ->
+          bs b "= ";
+          if priv then bs b "private ";
+          bs b "<";
+          List.iter (fun r ->
+            bs b (r.of_name^" : ");
+            self#man_of_type_expr b father r.of_type;
+            bs b ";";
+            self#field_comment b r.of_text ;
+          ) l;
+          bs b "\n >\n"
+       | Some (Other typ) ->
+           bs b "= ";
+           if priv then bs b "private ";
+           self#man_of_type_expr b father typ
+      );
+      (
+       match t.ty_kind with
+        Type_abstract -> ()
+      | Type_variant l ->
+         bs b "=";
+         if priv then bs b " private";
+         bs b "\n ";
+         List.iter (fun constr ->
+           bs b ("| "^constr.vc_name);
+           let print_text t =
+             bs b "  (* ";
+             self#man_of_info b (Some t);
+             bs b " *)\n "
+           in
+           match constr.vc_args, constr.vc_text,constr.vc_ret with
+           | Cstr_tuple [], None, None -> bs b "\n "
+           | Cstr_tuple [], (Some t), None ->
+             print_text t
+           | l, None, None ->
+             bs b "\n.B of ";
+             self#man_of_cstr_args ~par: false b father " * " l;
+             bs b " "
+           | l, (Some t), None ->
+             bs b "\n.B of ";
+             self#man_of_cstr_args ~par: false b father " * " l;
+             bs b ".I \"  \"\n";
+             print_text t
+           | Cstr_tuple [], None, Some r ->
+             bs b "\n.B : ";
+             self#man_of_type_expr b father r;
+             bs b " "
+           | Cstr_tuple [], (Some t), Some r ->
+             bs b "\n.B : ";
+             self#man_of_type_expr b father r;
+             bs b ".I \"  \"\n";
+             print_text t
+           | l, None, Some r ->
+             bs b "\n.B : ";
+             self#man_of_cstr_args ~par: false b father " * " l;
+             bs b ".B -> ";
+             self#man_of_type_expr b father r;
+             bs b " "
+           | l, (Some t), Some r ->
+             bs b "\n.B of ";
+             self#man_of_cstr_args ~par: false b father " * " l;
+             bs b ".B -> ";
+             self#man_of_type_expr b father r;
+             bs b ".I \"  \"\n";
+             print_text t
+         ) l
+
+      | Type_record l ->
+          bs b "= ";
+          if priv then bs b "private ";
+          self#man_of_record father b l
+      | Type_open ->
+          bs b "= ..";
+          bs b "\n"
+      );
+      bs b "\n.sp\n";
+      self#man_of_info b t.ty_info;
+      bs b "\n.sp\n"
+
+    (** Print groff string for a class attribute. *)
+    method man_of_attribute b a =
+      bs b ".I val ";
+      if a.att_virtual then bs b ("virtual ");
+      if a.att_mutable then bs b (Odoc_messages.mutab^" ");
+      bs b ((Name.simple a.att_value.val_name)^" : ");
+      self#man_of_type_expr b (Name.father a.att_value.val_name) a.att_value.val_type;
+      bs b "\n.sp\n";
+      self#man_of_info b a.att_value.val_info;
+      bs b "\n.sp\n"
+
+    (** Print groff string for a class method. *)
+    method man_of_method b m =
+      bs b ".I method ";
+      if m.met_private then bs b "private ";
+      if m.met_virtual then bs b "virtual ";
+      bs b ((Name.simple m.met_value.val_name)^" : ");
+      self#man_of_type_expr b
+        (Name.father m.met_value.val_name) m.met_value.val_type;
+      bs b "\n.sp\n";
+      self#man_of_info b m.met_value.val_info;
+      bs b "\n.sp\n"
+
+    (** Groff for a list of parameters. *)
+    method man_of_parameter_list b m_name l =
+      match l with
+        [] -> ()
+      | _ ->
+          bs b "\n.B ";
+          bs b Odoc_messages.parameters;
+          bs b ": \n";
+          List.iter
+            (fun p ->
+              bs b ".sp\n";
+              bs b "\"";
+              bs b (Parameter.complete_name p);
+              bs b "\"\n";
+              self#man_of_type_expr b m_name (Parameter.typ p);
+              bs b "\n";
+              self#man_of_parameter_description b p;
+              bs b "\n"
+            )
+            l;
+          bs b "\n"
+
+    (** Groff for the description of a function parameter. *)
+    method man_of_parameter_description b p =
+      match Parameter.names p with
+        [] -> ()
+      | name :: [] ->
+          (
+           (* Only one name, no need for label for the description. *)
+           match Parameter.desc_by_name p name with
+             None -> ()
+           | Some t -> bs b "\n "; self#man_of_text b t
+          )
+      | l ->
+          (*  A list of names, we display those with a description. *)
+          List.iter
+            (fun n ->
+              match Parameter.desc_by_name p n with
+                None -> ()
+              | Some t ->
+                  self#man_of_code b (n^" : ");
+                  self#man_of_text b t
+            )
+            l
+
+    (** Print groff string for a list of module parameters. *)
+    method man_of_module_parameter_list b m_name l =
+      match l with
+        [] -> ()
+      | _ ->
+          bs b ".B \"";
+          bs b Odoc_messages.parameters;
+          bs b ":\"\n";
+          List.iter
+            (fun (p, desc_opt) ->
+              bs b ".sp\n";
+              bs b ("\""^p.mp_name^"\"\n");
+              Option.iter (self#man_of_module_type b m_name) p.mp_type;
+              bs b "\n";
+              (
+               match desc_opt with
+                 None -> ()
+               | Some t -> self#man_of_text b t
+              );
+              bs b "\n"
+            )
+            l;
+          bs b "\n\n"
+
+    (** Print groff string for a class. *)
+    method man_of_class b c =
+      Odoc_info.reset_type_names () ;
+      let father = Name.father c.cl_name in
+      bs b  ".I class ";
+      if c.cl_virtual then bs b "virtual ";
+      (
+       match c.cl_type_parameters with
+         [] -> ()
+       | l ->
+           bs b (Odoc_str.string_of_class_type_param_list l);
+           bs b " "
+      );
+      bs b (Name.simple c.cl_name);
+      bs b " : " ;
+      self#man_of_class_type_expr b father c.cl_type;
+      bs b "\n.sp\n";
+      self#man_of_info b c.cl_info;
+      bs b "\n.sp\n"
+
+    (** Print groff string for a class type. *)
+    method man_of_class_type b ct =
+      Odoc_info.reset_type_names () ;
+      bs b ".I class type ";
+      if ct.clt_virtual then bs b "virtual " ;
+      (
+       match ct.clt_type_parameters with
+        [] -> ()
+      | l ->
+          bs b (Odoc_str.string_of_class_type_param_list l);
+          bs b " "
+      );
+      bs b (Name.simple ct.clt_name);
+      bs b  " = " ;
+      self#man_of_class_type_expr b (Name.father ct.clt_name) ct.clt_type;
+      bs b  "\n.sp\n";
+      self#man_of_info b ct.clt_info;
+      bs b "\n.sp\n"
+
+    (** Print groff string for a module. *)
+    method man_of_module b m =
+      bs b ".I module ";
+      bs b (Name.simple m.m_name);
+      bs b " : ";
+      self#man_of_module_type b (Name.father m.m_name) m.m_type;
+      bs b "\n.sp\n";
+      self#man_of_info b m.m_info;
+      bs b "\n.sp\n"
+
+    (** Print groff string for a module type. *)
+    method man_of_modtype b mt =
+      bs b ".I module type ";
+      bs b (Name.simple mt.mt_name);
+      bs b " = ";
+      (match mt.mt_type with
+        None -> ()
+      | Some t ->
+          self#man_of_module_type b (Name.father mt.mt_name) t
+      );
+      bs b "\n.sp\n";
+      self#man_of_info b mt.mt_info;
+      bs b "\n.sp\n"
+
+    (** Print groff string for a module comment.*)
+    method man_of_module_comment b text =
+      bs b "\n.PP\n";
+      self#man_of_text b text;
+      bs b "\n.PP\n"
+
+    (** Print groff string for a class comment.*)
+    method man_of_class_comment b text =
+      bs b "\n.PP\n";
+      self#man_of_text b text;
+      bs b "\n.PP\n"
+
+    method man_of_recfield b modname f =
+      bs b ".I ";
+      if f.rf_mutable then bs b (Odoc_messages.mutab^" ");
+      bs b (f.rf_name^" : ");
+      self#man_of_type_expr b modname f.rf_type;
+      bs b "\n.sp\n";
+      self#man_of_info b f.rf_text;
+      bs b "\n.sp\n"
+
+    method man_of_const b modname c =
+      bs b ".I ";
+      bs b (c.vc_name^" ");
+      (match c.vc_args with
+       | Cstr_tuple [] -> ()
+       | Cstr_tuple (h::q) ->
+         bs b "of ";
+         self#man_of_type_expr b modname h;
+         List.iter
+           (fun ty ->
+              bs b " * ";
+              self#man_of_type_expr b modname ty)
+            q
+       | Cstr_record r -> self#man_of_record c.vc_name b r
+      );
+      bs b "\n.sp\n";
+      self#man_of_info b c.vc_text;
+      bs b "\n.sp\n"
+
+    (** Print groff string for an included module. *)
+    method man_of_included_module b m_name im =
+      bs b ".I include ";
+      (
+       match im.im_module with
+         None -> bs b im.im_name
+       | Some mmt ->
+           let name =
+             match mmt with
+               Mod m -> m.m_name
+             | Modtype mt -> mt.mt_name
+           in
+           bs b (self#relative_idents m_name name)
+      );
+      bs b "\n.sp\n";
+      self#man_of_info b im.im_info;
+      bs b "\n.sp\n"
+
+    (** Generate the man page for the given class.*)
+    method generate_for_class cl =
+      Odoc_info.reset_type_names () ;
+      let file = self#file_name cl.cl_name in
+      try
+        let chanout = self#open_out file in
+        let b = new_buf () in
+        bs b (".TH \""^cl.cl_name^"\" ");
+        bs b !man_section ;
+        bs b (" "^Odoc_misc.current_date^" ");
+        bs b "OCamldoc ";
+        bs b ("\""^(match !Global.title with Some t -> t | None -> "")^"\"\n");
+
+        let abstract =
+          match cl.cl_info with
+            None | Some { i_desc = None } -> "no description"
+          | Some { i_desc = Some t } ->
+              let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in
+              self#remove_newlines s
+        in
+
+        bs b ".SH NAME\n";
+        bs b (cl.cl_name^" \\- "^abstract^"\n");
+        bs b (".SH "^Odoc_messages.clas^"\n");
+        bs b (Odoc_messages.clas^"   "^cl.cl_name^"\n");
+        bs b (".SH "^Odoc_messages.documentation^"\n");
+        bs b ".sp\n";
+        self#man_of_class b cl;
+
+        (* parameters *)
+        self#man_of_parameter_list b "" cl.cl_parameters;
+        (* a large blank *)
+        bs b  "\n.sp\n.sp\n";
+
+(*
+        (* class inheritance *)
+        self#generate_class_inheritance_info chanout cl;
+*)
+        (* the various elements *)
+        List.iter
+          (fun element ->
+            match element with
+              Class_attribute a ->
+                self#man_of_attribute b a
+            | Class_method m ->
+                self#man_of_method b m
+            | Class_comment t ->
+                self#man_of_class_comment b t
+          )
+          (Class.class_elements cl);
+
+        Buffer.output_buffer chanout b;
+        close_out chanout
+      with
+        Sys_error s ->
+          incr Odoc_info.errors ;
+          prerr_endline s
+
+    (** Generate the man page for the given class type.*)
+    method generate_for_class_type ct =
+      Odoc_info.reset_type_names () ;
+      let file = self#file_name ct.clt_name in
+      try
+        let chanout = self#open_out file in
+        let b = new_buf () in
+        bs b (".TH \""^ct.clt_name^"\" ");
+        bs b !man_section ;
+        bs b (" "^Odoc_misc.current_date^" ");
+        bs b "OCamldoc ";
+        bs b ("\""^(match !Global.title with Some t -> t | None -> "")^"\"\n");
+
+        let abstract =
+          match ct.clt_info with
+            None | Some { i_desc = None } -> "no description"
+          | Some { i_desc = Some t } ->
+              let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in
+              self#remove_newlines s
+        in
+
+        bs b ".SH NAME\n";
+        bs b (ct.clt_name^" \\- "^abstract^"\n");
+        bs b (".SH "^Odoc_messages.class_type^"\n");
+        bs b (Odoc_messages.class_type^"   "^ct.clt_name^"\n");
+        bs b (".SH "^Odoc_messages.documentation^"\n");
+        bs b ".sp\n";
+
+        self#man_of_class_type b ct;
+
+        (* a large blank *)
+        bs b "\n.sp\n.sp\n";
+(*
+        (* class inheritance *)
+        self#generate_class_inheritance_info chanout cl;
+*)
+        (* the various elements *)
+        List.iter
+          (fun element ->
+            match element with
+              Class_attribute a ->
+                self#man_of_attribute b a
+            | Class_method m ->
+                self#man_of_method b m
+            | Class_comment t ->
+                self#man_of_class_comment b t
+          )
+          (Class.class_type_elements ct);
+
+        Buffer.output_buffer chanout b;
+        close_out chanout
+      with
+        Sys_error s ->
+          incr Odoc_info.errors ;
+          prerr_endline s
+
+    method man_of_module_type_body b mt =
+      self#man_of_info b mt.mt_info;
+      bs b "\n.sp\n";
+
+      (* parameters for functors *)
+      self#man_of_module_parameter_list b "" (Module.module_type_parameters mt);
+      (* a large blank *)
+      bs b "\n.sp\n.sp\n";
+
+      (* module elements *)
+      List.iter
+        (fun ele ->
+          match ele with
+            Element_module m ->
+              self#man_of_module b m
+          | Element_module_type mt ->
+              self#man_of_modtype b mt
+          | Element_included_module im ->
+              self#man_of_included_module b mt.mt_name im
+          | Element_class c ->
+              self#man_of_class b c
+          | Element_class_type ct ->
+              self#man_of_class_type b ct
+          | Element_value v ->
+              self#man_of_value b v
+          | Element_type_extension te ->
+              self#man_of_type_extension b mt.mt_name te
+          | Element_exception e ->
+              self#man_of_exception b e
+          | Element_type t ->
+              self#man_of_type b t
+          | Element_module_comment text ->
+              self#man_of_module_comment b text
+        )
+        (Module.module_type_elements mt);
+
+    (** Generate the man file for the given module type.
+       @raise Failure if an error occurs.*)
+    method generate_for_module_type mt =
+      let file = self#file_name mt.mt_name in
+      try
+        let chanout = self#open_out file in
+        let b = new_buf () in
+        bs b (".TH \""^mt.mt_name^"\" ");
+        bs b !man_section ;
+        bs b (" "^Odoc_misc.current_date^" ");
+        bs b "OCamldoc ";
+        bs b ("\""^(match !Global.title with Some t -> t | None -> "")^"\"\n");
+
+        let abstract =
+          match mt.mt_info with
+            None | Some { i_desc = None } -> "no description"
+          | Some { i_desc = Some t } ->
+              let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in
+              self#remove_newlines s
+        in
+        bs b ".SH NAME\n";
+        bs b (mt.mt_name^" \\- "^abstract^"\n");
+        bs b (".SH "^Odoc_messages.module_type^"\n");
+        bs b (Odoc_messages.module_type^"   "^mt.mt_name^"\n");
+        bs b (".SH "^Odoc_messages.documentation^"\n");
+        bs b ".sp\n";
+        bs b (Odoc_messages.module_type^"\n");
+        bs b (".BI \""^(Name.simple mt.mt_name)^"\"\n");
+        bs b " = ";
+        (
+         match mt.mt_type with
+           None -> ()
+         | Some t ->
+             self#man_of_module_type b (Name.father mt.mt_name) t
+        );
+        bs b "\n.sp\n";
+        self#man_of_module_type_body b mt;
+
+        Buffer.output_buffer chanout b;
+        close_out chanout
+
+      with
+        Sys_error s ->
+          incr Odoc_info.errors ;
+          prerr_endline s
+
+    method man_of_module_body b m =
+      self#man_of_info b m.m_info;
+      bs b "\n.sp\n";
+
+      (* parameters for functors *)
+      self#man_of_module_parameter_list b "" (Module.module_parameters m);
+      (* a large blank *)
+      bs b "\n.sp\n.sp\n";
+
+      (* module elements *)
+      List.iter
+        (fun ele ->
+          match ele with
+            Element_module m ->
+              self#man_of_module b m
+          | Element_module_type mt ->
+              self#man_of_modtype b mt
+          | Element_included_module im ->
+              self#man_of_included_module b m.m_name im
+          | Element_class c ->
+              self#man_of_class b c
+          | Element_class_type ct ->
+              self#man_of_class_type b ct
+          | Element_value v ->
+              self#man_of_value b v
+          | Element_type_extension te ->
+              self#man_of_type_extension b m.m_name te
+          | Element_exception e ->
+              self#man_of_exception b e
+          | Element_type t ->
+              self#man_of_type b t
+          | Element_module_comment text ->
+              self#man_of_module_comment b text
+        )
+        (Module.module_elements m);
+
+    (** Generate the man file for the given module.
+       @raise Failure if an error occurs.*)
+    method generate_for_module m =
+      let file = self#file_name m.m_name in
+      try
+        let chanout = self#open_out file in
+        let b = new_buf () in
+        bs b (".TH \""^m.m_name^"\" ");
+        bs b !man_section ;
+        bs b (" "^Odoc_misc.current_date^" ");
+        bs b "OCamldoc ";
+        bs b ("\""^(match !Global.title with Some t -> t | None -> "")^"\"\n");
+
+        let abstract =
+          match m.m_info with
+            None | Some { i_desc = None } -> "no description"
+          | Some { i_desc = Some t } ->
+              let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in
+              self#remove_newlines s
+        in
+
+        bs b ".SH NAME\n";
+        bs b (m.m_name^" \\- "^abstract^"\n");
+        bs b (".SH "^Odoc_messages.modul^"\n");
+        bs b (Odoc_messages.modul^"   "^m.m_name^"\n");
+        bs b (".SH "^Odoc_messages.documentation^"\n");
+        bs b ".sp\n";
+        bs b (Odoc_messages.modul^"\n");
+        bs b (".BI \""^(Name.simple m.m_name)^"\"\n");
+        bs b " : ";
+        self#man_of_module_type b (Name.father m.m_name) m.m_type;
+        bs b "\n.sp\n";
+        self#man_of_module_body b m;
+        Buffer.output_buffer chanout b;
+        close_out chanout
+
+      with
+        Sys_error s ->
+          raise (Failure s)
+
+    (** Create the groups of elements to generate pages for. *)
+    method create_groups mini module_list =
+      let name res_ele =
+        match res_ele with
+          Res_module m -> m.m_name
+        | Res_module_type mt -> mt.mt_name
+        | Res_class c -> c.cl_name
+        | Res_class_type ct -> ct.clt_name
+        | Res_value v -> Name.simple v.val_name
+        | Res_type t -> Name.simple t.ty_name
+        | Res_extension x -> Name.simple x.xt_name
+        | Res_exception e -> Name.simple e.ex_name
+        | Res_attribute a -> Name.simple a.att_value.val_name
+        | Res_method m -> Name.simple m.met_value.val_name
+        | Res_section _ -> assert false
+        | Res_recfield (_,f) -> f.rf_name
+        | Res_const (_,f) -> f.vc_name
+      in
+      let all_items_pre = Odoc_info.Search.search_by_name module_list (Str.regexp ".*")  in
+      let all_items = List.filter
+          (fun r ->
+             match r with
+               Res_section _ -> false
+             | Res_module _ | Res_module_type _
+             | Res_class _ | Res_class_type _ -> true
+             | _ -> not mini
+          )
+          all_items_pre
+      in
+      let sorted_items = List.sort (fun e1 -> fun e2 -> compare (name e1) (name e2)) all_items in
+      let rec f acc1 acc2 l =
+        match l with
+          [] -> acc2 :: acc1
+        | h :: q ->
+            match acc2 with
+              [] -> f acc1 [h] q
+            | h2 :: _ ->
+                if (name h) = (name h2) then
+                  if List.mem h acc2 then
+                    f acc1 acc2 q
+                  else
+                    f acc1 (acc2 @ [h]) q
+                else
+                  f (acc2 :: acc1) [h] q
+      in
+      f [] [] sorted_items
+
+    (** Generate a man page for a group of elements with the same name.
+       A group must not be empty.*)
+    method generate_for_group l =
+     let name =
+       Name.simple
+         (
+          match List.hd l with
+            Res_module m -> m.m_name
+          | Res_module_type mt -> mt.mt_name
+          | Res_class c -> c.cl_name
+          | Res_class_type ct -> ct.clt_name
+          | Res_value v -> v.val_name
+          | Res_type t -> t.ty_name
+          | Res_extension x -> x.xt_name
+          | Res_exception e -> e.ex_name
+          | Res_attribute a -> a.att_value.val_name
+          | Res_method m -> m.met_value.val_name
+          | Res_section (s,_) -> s
+          | Res_recfield (_,f) -> f.rf_name
+          | Res_const (_,f) -> f.vc_name
+         )
+     in
+      let file = self#file_name name in
+      try
+        let chanout = self#open_out file in
+        let b = new_buf () in
+        bs b (".TH \""^name^"\" ");
+        bs b !man_section ;
+        bs b (" "^Odoc_misc.current_date^" ");
+        bs b "OCamldoc ";
+        bs b ("\""^(match !Global.title with Some t -> t | None -> "")^"\"\n");
+        bs b ".SH NAME\n";
+        bs b (name^" \\- all "^name^" elements\n\n");
+
+        let f ele =
+          match ele with
+            Res_value v ->
+              bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father v.val_name)^"\n");
+              self#man_of_value b v
+          | Res_type t ->
+              bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father t.ty_name)^"\n");
+              self#man_of_type b t
+          | Res_extension x ->
+              bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father x.xt_name)^"\n");
+              self#man_of_type_extension b (Name.father x.xt_name) x.xt_type_extension
+          | Res_exception e ->
+              bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father e.ex_name)^"\n");
+              self#man_of_exception b e
+          | Res_attribute a ->
+              bs b ("\n.SH "^Odoc_messages.clas^" "^(Name.father a.att_value.val_name)^"\n");
+              self#man_of_attribute b a
+          | Res_method m ->
+              bs b ("\n.SH "^Odoc_messages.clas^" "^(Name.father m.met_value.val_name)^"\n");
+              self#man_of_method b m
+          | Res_class c ->
+              bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father c.cl_name)^"\n");
+              self#man_of_class b c
+          | Res_class_type ct ->
+              bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father ct.clt_name)^"\n");
+              self#man_of_class_type b ct
+          | Res_recfield (ty,f) ->
+               bs b ("\n.SH Type "^(ty.ty_name)^"\n");
+              self#man_of_recfield b (Name.father ty.ty_name) f
+          | Res_const (ty,c) ->
+               bs b ("\n.SH Type "^(ty.ty_name)^"\n");
+              self#man_of_const b (Name.father ty.ty_name) c
+          | Res_module m ->
+              if Name.father m.m_name <> "" then
+                begin
+                  bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father m.m_name)^"\n");
+                  bs b (Odoc_messages.modul^"\n");
+                  bs b (".BI \""^(Name.simple m.m_name)^"\"\n");
+                  bs b " : ";
+                  self#man_of_module_type b (Name.father m.m_name) m.m_type;
+                end
+              else
+                begin
+                  bs b ("\n.SH "^Odoc_messages.modul^" "^m.m_name^"\n");
+                  bs b " : ";
+                  self#man_of_module_type b (Name.father m.m_name) m.m_type;
+                end;
+              bs b "\n.sp\n";
+              self#man_of_module_body b m
+
+          | Res_module_type mt ->
+              bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father mt.mt_name)^"\n");
+              bs b (Odoc_messages.module_type^"\n");
+              bs b (".BI \""^(Name.simple mt.mt_name)^"\"\n");
+              bs b " = ";
+              (
+               match mt.mt_type with
+                None -> ()
+              | Some t ->
+                 self#man_of_module_type b (Name.father mt.mt_name) t
+              );
+              bs b "\n.sp\n";
+              self#man_of_module_type_body b mt
+
+          | Res_section _ ->
+              (* normally, we cannot have modules here. *)
+              ()
+        in
+        List.iter f l;
+        Buffer.output_buffer chanout b;
+        close_out chanout
+      with
+        Sys_error s ->
+          incr Odoc_info.errors ;
+          prerr_endline s
+
+    (** Generate all the man pages from a module list. *)
+    method generate module_list =
+      let sorted_module_list = List.sort (fun m1 m2 -> compare m1.m_name m2.m_name) module_list in
+      let groups = self#create_groups !man_mini sorted_module_list in
+      let f group =
+        match group with
+          [] ->
+            ()
+        | [Res_module m] -> self#generate_for_module m
+        | [Res_module_type mt] -> self#generate_for_module_type mt
+        | [Res_class cl] -> self#generate_for_class cl
+        | [Res_class_type ct] -> self#generate_for_class_type ct
+        | l -> self#generate_for_group l
+      in
+      List.iter f groups
+  end
+end
+
+module type Man_generator = module type of Generator
diff --git a/ocamldoc/odoc_merge.ml b/ocamldoc/odoc_merge.ml
new file mode 100644
index 00000000..f11ab5da
--- /dev/null
+++ b/ocamldoc/odoc_merge.ml
@@ -0,0 +1,1086 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Merge of information from [.ml] and [.mli] for a module.*)
+
+open Odoc_types
+open Odoc_parameter
+open Odoc_value
+open Odoc_type
+open Odoc_extension
+open Odoc_exception
+open Odoc_class
+open Odoc_module
+
+let merge_before_tags l =
+  let rec iter acc = function
+    [] -> List.rev acc
+  | (v, text) :: q ->
+      let (l1, l2) = List.partition
+        (fun (v2,_) -> v = v2) q
+      in
+      let acc =
+        let text =
+          List.fold_left
+            (fun acc t -> acc @ [Raw " "] @ t)
+            text (List.map snd l1)
+        in
+        (v, text) :: acc
+      in
+      iter acc l2
+  in
+  iter [] l
+;;
+
+let version_separators = Str.regexp "[\\.\\+]";;
+
+(** Merge two Odoctypes.info structures, completing the information of
+   the first one with the information in the second one.
+   The merge treatment depends on a given merge_option list.
+   @return the new info structure.*)
+let merge_info merge_options (m1 : info) (m2 : info) =
+  let new_desc_opt =
+    match m1.i_desc, m2.i_desc with
+      None, None -> None
+    | None, Some d
+    | Some d, None -> Some d
+    | Some d1, Some d2 ->
+        if List.mem Merge_description merge_options then
+          Some (d1 @ (Newline :: d2))
+        else
+          Some d1
+  in
+  let new_authors =
+    match m1.i_authors, m2.i_authors with
+      [], [] -> []
+    | l, []
+    | [], l -> l
+    | l1, l2 ->
+        if List.mem Merge_author merge_options then
+          l1 @ l2
+        else
+          l1
+  in
+  let new_version =
+    match m1.i_version , m2.i_version with
+      None, None -> None
+    | Some v, None
+    | None, Some v -> Some v
+    | Some v1, Some v2 ->
+        if List.mem Merge_version merge_options then
+          Some (v1^" "^v2)
+        else
+          Some v1
+  in
+  let new_sees =
+    match m1.i_sees, m2.i_sees with
+      [], [] -> []
+    | l, []
+    | [], l -> l
+    | l1, l2 ->
+        if List.mem Merge_see merge_options then
+          l1 @ l2
+        else
+          l1
+  in
+  let new_since =
+    match m1.i_since, m2.i_since with
+      None, None -> None
+    | Some v, None
+    | None, Some v -> Some v
+    | Some v1, Some v2 ->
+        if List.mem Merge_since merge_options then
+          Some (v1^" "^v2)
+        else
+          Some v1
+  in
+  let new_before =
+    match m1.i_before, m2.i_before with
+      [], [] -> []
+    | l, []
+    | [], l -> l
+    | l1, _ ->
+        if List.mem Merge_before merge_options then
+          merge_before_tags (m1.i_before @ m2.i_before)
+        else
+          l1 in
+  let new_before = List.map (fun (v, t) -> (Str.split version_separators v, v, t)) new_before in
+  let new_before = List.sort Stdlib.compare new_before in
+  let new_before = List.map (fun (_, v, t) -> (v, t)) new_before in
+  let new_dep =
+    match m1.i_deprecated, m2.i_deprecated with
+      None, None -> None
+    | None, Some t
+    | Some t, None -> Some t
+    | Some t1, Some t2 ->
+        if List.mem Merge_deprecated merge_options then
+          Some (t1 @ (Newline :: t2))
+        else
+          Some t1
+  in
+  let new_params =
+    match m1.i_params, m2.i_params with
+      [], [] -> []
+    | l, []
+    | [], l -> l
+    | l1, l2 ->
+        if List.mem Merge_param merge_options then
+          (
+           let l_in_m1_and_m2, l_in_m2_only = List.partition
+               (fun (param2, _) -> List.mem_assoc param2 l1)
+               l2
+           in
+           let rec iter = function
+               [] -> []
+             | (param2, desc2) :: q ->
+                 let desc1 = List.assoc param2 l1 in
+                 (param2, desc1 @ (Newline :: desc2)) :: (iter q)
+           in
+           let l1_completed = iter l_in_m1_and_m2 in
+           l1_completed @ l_in_m2_only
+          )
+        else
+          l1
+  in
+  let new_raised_exceptions =
+    match m1.i_raised_exceptions, m2.i_raised_exceptions with
+      [], [] -> []
+    | l, []
+    | [], l -> l
+    | l1, l2 ->
+        if List.mem Merge_raised_exception merge_options then
+          (
+           let l_in_m1_and_m2, l_in_m2_only = List.partition
+               (fun (exc2, _) -> List.mem_assoc exc2 l1)
+               l2
+           in
+           let rec iter = function
+               [] -> []
+             | (exc2, desc2) :: q ->
+                 let desc1 = List.assoc exc2 l1 in
+                 (exc2, desc1 @ (Newline :: desc2)) :: (iter q)
+           in
+           let l1_completed = iter l_in_m1_and_m2 in
+           l1_completed @ l_in_m2_only
+          )
+        else
+          l1
+  in
+  let new_rv =
+    match m1.i_return_value, m2.i_return_value with
+      None, None -> None
+    | None, Some t
+    | Some t, None -> Some t
+    | Some t1, Some t2 ->
+        if List.mem Merge_return_value merge_options then
+          Some (t1 @ (Newline :: t2))
+        else
+          Some t1
+  in
+  let new_custom =
+    match m1.i_custom, m2.i_custom with
+      [], [] -> []
+    | [], l
+    | l, [] -> l
+    | l1, l2 ->
+        if List.mem Merge_custom merge_options then
+          l1 @ l2
+        else
+          l1
+  in
+  {
+    Odoc_types.i_desc = new_desc_opt ;
+    Odoc_types.i_authors = new_authors ;
+    Odoc_types.i_version = new_version ;
+    Odoc_types.i_sees = new_sees ;
+    Odoc_types.i_since = new_since ;
+    Odoc_types.i_before = new_before ;
+    Odoc_types.i_deprecated = new_dep ;
+    Odoc_types.i_params = new_params ;
+    Odoc_types.i_raised_exceptions = new_raised_exceptions ;
+    Odoc_types.i_return_value = new_rv ;
+    Odoc_types.i_custom = new_custom ;
+  }
+
+(** Merge of two optional info structures. *)
+let merge_info_opt merge_options mli_opt ml_opt =
+  match mli_opt, ml_opt with
+    None, Some i -> Some i
+  | Some i, None -> Some i
+  | None, None -> None
+  | Some i1, Some i2 -> Some (merge_info merge_options i1 i2)
+
+(** merge of two t_type, one for a .mli, another for the .ml.
+   The .mli type is completed with the information in the .ml type. *)
+let merge_types merge_options mli ml =
+  mli.ty_info <- merge_info_opt merge_options mli.ty_info ml.ty_info;
+  mli.ty_loc <- { mli.ty_loc with loc_impl = ml.ty_loc.loc_impl } ;
+  mli.ty_code <- (match mli.ty_code with None -> ml.ty_code | _ -> mli.ty_code) ;
+
+  match mli.ty_kind, ml.ty_kind with
+    Type_abstract, _ ->
+      ()
+
+  | Type_variant l1, Type_variant l2 ->
+      let f cons =
+        try
+          let cons2 = List.find
+              (fun c2 -> c2.vc_name = cons.vc_name)
+              l2
+          in
+          let new_desc =
+            match cons.vc_text, cons2.vc_text with
+              None, None -> None
+            | Some d, None
+            | None, Some d -> Some d
+            | Some d1, Some d2 ->
+                if List.mem Merge_description merge_options then
+                  Some (merge_info merge_options d1 d2)
+                else
+                  Some d1
+          in
+          cons.vc_text <- new_desc
+        with
+          Not_found ->
+            if !Odoc_global.inverse_merge_ml_mli then
+              ()
+            else
+              raise (Failure (Odoc_messages.different_types mli.ty_name))
+      in
+      List.iter f l1
+
+  | Type_record l1, Type_record l2 ->
+      let f record =
+        try
+          let record2= List.find
+              (fun r -> r.rf_name = record.rf_name)
+              l2
+          in
+          let new_desc =
+            match record.rf_text, record2.rf_text with
+              None, None -> None
+            | Some d, None
+            | None, Some d -> Some d
+            | Some d1, Some d2 ->
+                if List.mem Merge_description merge_options then
+                  Some (merge_info merge_options d1 d2)
+                else
+                  Some d1
+          in
+          record.rf_text <- new_desc
+        with
+          Not_found ->
+            if !Odoc_global.inverse_merge_ml_mli then
+              ()
+            else
+              raise (Failure (Odoc_messages.different_types mli.ty_name))
+      in
+      List.iter f l1
+
+  | Type_open, Type_open ->
+      ()
+
+  | _ ->
+      if !Odoc_global.inverse_merge_ml_mli then
+        ()
+      else
+        raise (Failure (Odoc_messages.different_types mli.ty_name))
+
+(** merge of two t_type_extension, one for a .mli, another for the .ml.
+   The .mli type is completed with the information in the .ml type.
+   Information for the extension constructors is merged separately
+   by [merge_extension_constructor]. *)
+let merge_type_extension merge_options mli ml =
+  mli.te_info <- merge_info_opt merge_options mli.te_info ml.te_info;
+  mli.te_loc <- { mli.te_loc with loc_impl = ml.te_loc.loc_impl } ;
+  mli.te_code <- (match mli.te_code with None -> ml.te_code | _ -> mli.te_code)
+
+(** merge of two t_extension_constructor, one for a .mli, another for the .ml.
+   The .mli type is completed with the information in the .ml type. *)
+let merge_extension_constructor merge_options mli ml =
+  let new_desc =
+    match mli.xt_text, ml.xt_text with
+      None, None -> None
+    | Some d, None
+    | None, Some d -> Some d
+    | Some d1, Some d2 ->
+      if List.mem Merge_description merge_options then
+        Some (merge_info merge_options d1 d2)
+      else
+        Some d1
+  in
+    mli.xt_text <- new_desc
+
+
+(** Merge of two param_info, one from a .mli, one from a .ml.
+   The text fields are not handled but will be recreated from the
+   i_params field of the info structure.
+   Here, if a parameter in the .mli has no name, we take the one
+   from the .ml. When two parameters have two different forms,
+   we take the one from the .mli. *)
+let rec merge_param_info pi_mli pi_ml =
+  match (pi_mli, pi_ml) with
+    (Simple_name sn_mli, Simple_name sn_ml) ->
+      if sn_mli.sn_name = "" then
+        Simple_name { sn_mli with sn_name = sn_ml.sn_name }
+      else
+        pi_mli
+  | (Simple_name _, Tuple _) ->
+      pi_mli
+  | (Tuple (_, t_mli), Simple_name sn_ml) ->
+      (* if we're here, then the tuple in the .mli has no parameter names ;
+         then we take the name of the parameter of the .ml and the type of the .mli. *)
+      Simple_name { sn_ml with sn_type = t_mli }
+
+  | (Tuple (l_mli, t_mli), Tuple (l_ml, _)) ->
+      (* if the two tuples have different lengths
+         (which should not occurs), we return the pi_mli,
+         without further investigation.*)
+      if (List.length l_mli) <> (List.length l_ml) then
+        pi_mli
+      else
+        let new_l = List.map2 merge_param_info l_mli l_ml in
+        Tuple (new_l, t_mli)
+
+(** Merge of the parameters of two functions/methods/classes, one for a .mli, another for a .ml.
+   The parameters in the .mli are completed by the name in the .ml.*)
+let rec merge_parameters param_mli param_ml =
+  match (param_mli, param_ml) with
+    ([], []) -> []
+  | (l, []) | ([], l) -> l
+  | ((pi_mli :: li), (pi_ml :: l)) ->
+      (merge_param_info pi_mli pi_ml) :: merge_parameters li l
+
+(** Merge of two t_class, one for a .mli, another for the .ml.
+   The .mli class is completed with the information in the .ml class. *)
+let merge_classes merge_options mli ml =
+  mli.cl_info <- merge_info_opt merge_options mli.cl_info ml.cl_info;
+  mli.cl_loc <- { mli.cl_loc with loc_impl = ml.cl_loc.loc_impl } ;
+  mli.cl_parameters <- merge_parameters mli.cl_parameters ml.cl_parameters;
+
+  (* we must reassociate comments in @param to the corresponding
+     parameters because the associated comment of a parameter may have been changed by the merge.*)
+  Odoc_class.class_update_parameters_text mli;
+
+  (* merge values *)
+  List.iter
+    (fun a ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Class_attribute a2 ->
+                  if a2.att_value.val_name = a.att_value.val_name then
+                    (
+                     a.att_value.val_info <- merge_info_opt merge_options
+                         a.att_value.val_info a2.att_value.val_info;
+                     a.att_value.val_loc <- { a.att_value.val_loc with loc_impl = a2.att_value.val_loc.loc_impl } ;
+                     if !Odoc_global.keep_code then
+                       a.att_value.val_code <- a2.att_value.val_code;
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last attribute with this name defined in the implementation *)
+            (List.rev (Odoc_class.class_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_class.class_attributes mli);
+  (* merge methods *)
+  List.iter
+    (fun m ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Class_method m2 ->
+                  if m2.met_value.val_name = m.met_value.val_name then
+                    (
+                     m.met_value.val_info <- merge_info_opt
+                         merge_options m.met_value.val_info m2.met_value.val_info;
+                     m.met_value.val_loc <- { m.met_value.val_loc with loc_impl = m2.met_value.val_loc.loc_impl } ;
+                     (* merge the parameter names *)
+                     m.met_value.val_parameters <- (merge_parameters
+                                                      m.met_value.val_parameters
+                                                      m2.met_value.val_parameters) ;
+                     (* we must reassociate comments in @param to the corresponding
+                        parameters because the associated comment of a parameter may have been changed by the merge.*)
+                     Odoc_value.update_value_parameters_text m.met_value;
+
+                     if !Odoc_global.keep_code then
+                       m.met_value.val_code <- m2.met_value.val_code;
+
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last method with this name defined in the implementation *)
+            (List.rev (Odoc_class.class_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_class.class_methods mli)
+
+(** merge of two t_class_type, one for a .mli, another for the .ml.
+   The .mli class is completed with the information in the .ml class. *)
+let merge_class_types merge_options mli ml =
+  mli.clt_info <- merge_info_opt merge_options  mli.clt_info ml.clt_info;
+  mli.clt_loc <- { mli.clt_loc with loc_impl = ml.clt_loc.loc_impl } ;
+  (* merge values *)
+  List.iter
+    (fun a ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Class_attribute a2 ->
+                  if a2.att_value.val_name = a.att_value.val_name then
+                    (
+                     a.att_value.val_info <- merge_info_opt merge_options
+                         a.att_value.val_info a2.att_value.val_info;
+                     a.att_value.val_loc <- { a.att_value.val_loc with loc_impl = a2.att_value.val_loc.loc_impl } ;
+                     if !Odoc_global.keep_code then
+                       a.att_value.val_code <- a2.att_value.val_code;
+
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last attribute with this name defined in the implementation *)
+            (List.rev (Odoc_class.class_type_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_class.class_type_attributes mli);
+  (* merge methods *)
+  List.iter
+    (fun m ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Class_method m2 ->
+                  if m2.met_value.val_name = m.met_value.val_name then
+                    (
+                     m.met_value.val_info <- merge_info_opt
+                         merge_options m.met_value.val_info m2.met_value.val_info;
+                     m.met_value.val_loc <- { m.met_value.val_loc with loc_impl = m2.met_value.val_loc.loc_impl } ;
+                     m.met_value.val_parameters <- (merge_parameters
+                                                      m.met_value.val_parameters
+                                                      m2.met_value.val_parameters) ;
+                     (* we must reassociate comments in @param to the corresponding
+                        parameters because the associated comment of a parameter may have been changed by the merge.*)
+                     Odoc_value.update_value_parameters_text m.met_value;
+
+                     if !Odoc_global.keep_code then
+                       m.met_value.val_code <- m2.met_value.val_code;
+
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last method with this name defined in the implementation *)
+            (List.rev (Odoc_class.class_type_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_class.class_type_methods mli)
+
+
+(** merge of two t_module_type, one for a .mli, another for the .ml.
+   The .mli module is completed with the information in the .ml module. *)
+let rec merge_module_types merge_options mli ml =
+  mli.mt_info <- merge_info_opt merge_options mli.mt_info ml.mt_info;
+  mli.mt_loc <- { mli.mt_loc with loc_impl = ml.mt_loc.loc_impl } ;
+  (* merge type extensions *)
+  List.iter
+    (fun te ->
+       let rec f exts elems =
+         match exts, elems with
+             [], _
+           | _, [] -> ()
+           | _, (Element_type_extension te2 :: rest) ->
+               let merge_ext xt =
+                 try
+                   let xt2 =
+                     List.find (fun xt2 -> xt.xt_name = xt2.xt_name)
+                       te2.te_constructors
+                   in
+                     merge_extension_constructor merge_options xt xt2;
+                     true
+                 with Not_found -> false
+               in
+               let merged, unmerged = List.partition merge_ext exts in
+                 if merged <> [] then merge_type_extension merge_options te te2;
+                 f unmerged rest
+           | _, (_ :: rest) -> f exts rest
+       in
+         (* we look for the extensions in reverse order *)
+         f te.te_constructors (List.rev (Odoc_module.module_type_elements ml))
+    )
+    (Odoc_module.module_type_type_extensions mli);
+  (* merge exceptions *)
+  List.iter
+    (fun ex ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Element_exception ex2 ->
+                  if ex2.ex_name = ex.ex_name then
+                    (
+                     ex.ex_info <- merge_info_opt merge_options ex.ex_info ex2.ex_info;
+                     ex.ex_loc <- { ex.ex_loc with loc_impl = ex2.ex_loc.loc_impl } ;
+                     ex.ex_code <- (match ex.ex_code with None -> ex2.ex_code | _ -> ex.ex_code) ;
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last exception with this name defined in the implementation *)
+            (List.rev (Odoc_module.module_type_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_module.module_type_exceptions mli);
+  (* merge types *)
+  List.iter
+    (fun ty ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Element_type ty2 ->
+                  if ty2.ty_name = ty.ty_name then
+                    (
+                     merge_types merge_options ty ty2;
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last type with this name defined in the implementation *)
+            (List.rev (Odoc_module.module_type_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_module.module_type_types mli);
+  (* merge submodules *)
+  List.iter
+    (fun m ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Element_module m2 ->
+                  if m2.m_name = m.m_name then
+                    (
+                     ignore (merge_modules merge_options m m2);
+(*
+                     m.m_info <- merge_info_opt merge_options m.m_info m2.m_info;
+                     m.m_loc <- { m.m_loc with loc_impl = m2.m_loc.loc_impl } ;
+*)
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last module with this name defined in the implementation *)
+            (List.rev (Odoc_module.module_type_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_module.module_type_modules mli);
+
+  (* merge module types *)
+  List.iter
+    (fun m ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Element_module_type m2 ->
+                  if m2.mt_name = m.mt_name then
+                    (
+                     merge_module_types merge_options m m2;
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last module with this name defined in the implementation *)
+            (List.rev (Odoc_module.module_type_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_module.module_type_module_types mli);
+
+  (* A VOIR : merge included modules ? *)
+
+  (* merge values *)
+  List.iter
+    (fun v ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Element_value v2 ->
+                  if v2.val_name = v.val_name then
+                    (
+                     v.val_info <- merge_info_opt merge_options v.val_info v2.val_info ;
+                     v.val_loc <- { v.val_loc with loc_impl = v2.val_loc.loc_impl } ;
+                     (* in the .mli we don't know any parameters so we add the ones in the .ml *)
+                     v.val_parameters <- (merge_parameters
+                                            v.val_parameters
+                                            v2.val_parameters) ;
+                     (* we must reassociate comments in @param to the corresponding
+                        parameters because the associated comment of a parameter may have been changed by the merge.*)
+                     Odoc_value.update_value_parameters_text v;
+
+                     if !Odoc_global.keep_code then
+                       v.val_code <- v2.val_code;
+
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last value with this name defined in the implementation *)
+            (List.rev (Odoc_module.module_type_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_module.module_type_values mli);
+
+  (* merge classes *)
+  List.iter
+    (fun c ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Element_class c2 ->
+                  if c2.cl_name = c.cl_name then
+                    (
+                     merge_classes merge_options c c2;
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last value with this name defined in the implementation *)
+            (List.rev (Odoc_module.module_type_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_module.module_type_classes mli);
+
+  (* merge class types *)
+  List.iter
+    (fun c ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Element_class_type c2 ->
+                  if c2.clt_name = c.clt_name then
+                    (
+                     merge_class_types merge_options c c2;
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last value with this name defined in the implementation *)
+            (List.rev (Odoc_module.module_type_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_module.module_type_class_types mli)
+
+(** merge of two t_module, one for a .mli, another for the .ml.
+   The .mli module is completed with the information in the .ml module. *)
+and merge_modules merge_options mli ml =
+  mli.m_info <- merge_info_opt merge_options mli.m_info ml.m_info;
+  mli.m_loc <- { mli.m_loc with loc_impl = ml.m_loc.loc_impl } ;
+  let rec remove_doubles acc = function
+      [] -> acc
+    | h :: q ->
+        if List.mem h acc then remove_doubles acc q
+        else remove_doubles (h :: acc) q
+  in
+  mli.m_top_deps <- remove_doubles mli.m_top_deps ml.m_top_deps ;
+
+  let code =
+    if !Odoc_global.keep_code then
+      match mli.m_code, ml.m_code with
+        Some s, _ -> Some s
+      | _, Some s -> Some s
+      | _ -> None
+    else
+      None
+  in
+  let code_intf =
+    if !Odoc_global.keep_code then
+      match mli.m_code_intf, ml.m_code_intf with
+        Some s, _ -> Some s
+      | _, Some s -> Some s
+      | _ -> None
+    else
+      None
+  in
+  mli.m_code <- code;
+  mli.m_code_intf <- code_intf;
+
+  (* merge type extensions *)
+  List.iter
+    (fun te ->
+       let rec f exts elems =
+         match exts, elems with
+             [], _
+           | _, [] -> ()
+           | _, (Element_type_extension te2 :: rest) ->
+               let merge_ext xt =
+                 try
+                   let xt2 =
+                     List.find (fun xt2 -> xt.xt_name = xt2.xt_name)
+                       te2.te_constructors
+                   in
+                     merge_extension_constructor merge_options xt xt2;
+                     true
+                 with Not_found -> false
+               in
+               let merged, unmerged = List.partition merge_ext exts in
+                 if merged <> [] then merge_type_extension merge_options te te2;
+                 f unmerged rest
+           | _, (_ :: rest) -> f exts rest
+       in
+         (* we look for the extensions in reverse order *)
+         f te.te_constructors (List.rev (Odoc_module.module_elements ml))
+    )
+    (Odoc_module.module_type_extensions mli);
+  (* merge exceptions *)
+  List.iter
+    (fun ex ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Element_exception ex2 ->
+                  if ex2.ex_name = ex.ex_name then
+                    (
+                     ex.ex_info <- merge_info_opt merge_options ex.ex_info ex2.ex_info;
+                     ex.ex_loc <- { ex.ex_loc with loc_impl = ex.ex_loc.loc_impl } ;
+                     ex.ex_code <- (match ex.ex_code with None -> ex2.ex_code | _ -> ex.ex_code) ;
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last exception with this name defined in the implementation *)
+            (List.rev (Odoc_module.module_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_module.module_exceptions mli);
+  (* merge types *)
+  List.iter
+    (fun ty ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Element_type ty2 ->
+                  if ty2.ty_name = ty.ty_name then
+                    (
+                     merge_types merge_options ty ty2;
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last type with this name defined in the implementation *)
+            (List.rev (Odoc_module.module_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_module.module_types mli);
+  (* merge submodules *)
+  List.iter
+    (fun m ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Element_module m2 ->
+                  if m2.m_name = m.m_name then
+                    (
+                     ignore (merge_modules merge_options m m2);
+(*
+                     m.m_info <- merge_info_opt merge_options m.m_info m2.m_info;
+                     m.m_loc <- { m.m_loc with loc_impl = m2.m_loc.loc_impl } ;
+*)
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last module with this name defined in the implementation *)
+            (List.rev (Odoc_module.module_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_module.module_modules mli);
+
+  (* merge module types *)
+  List.iter
+    (fun m ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Element_module_type m2 ->
+                  if m2.mt_name = m.mt_name then
+                    (
+                     merge_module_types merge_options m m2;
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last module with this name defined in the implementation *)
+            (List.rev (Odoc_module.module_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_module.module_module_types mli);
+
+  (* A VOIR : merge included modules ? *)
+
+  (* merge values *)
+  List.iter
+    (fun v ->
+      try
+        let _ = List.find
+            (fun v2 ->
+              if v2.val_name = v.val_name then
+                (
+                 v.val_info <- merge_info_opt merge_options v.val_info v2.val_info ;
+                 v.val_loc <- { v.val_loc with loc_impl = v2.val_loc.loc_impl } ;
+                 (* in the .mli we don't know any parameters so we add the ones in the .ml *)
+                 v.val_parameters <- (merge_parameters
+                                        v.val_parameters
+                                        v2.val_parameters) ;
+                 (* we must reassociate comments in @param to the corresponding
+                    parameters because the associated comment of a parameter may have been changed by the merge.*)
+                 Odoc_value.update_value_parameters_text v;
+
+                 if !Odoc_global.keep_code then
+                   v.val_code <- v2.val_code;
+                 true
+                )
+              else
+                false
+            )
+            (* we look for the last value with this name defined in the implementation *)
+            (List.rev (Odoc_module.module_values ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_module.module_values mli);
+
+  (* merge classes *)
+  List.iter
+    (fun c ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Element_class c2 ->
+                  if c2.cl_name = c.cl_name then
+                    (
+                     merge_classes merge_options c c2;
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last value with this name defined in the implementation *)
+            (List.rev (Odoc_module.module_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_module.module_classes mli);
+
+  (* merge class types *)
+  List.iter
+    (fun c ->
+      try
+        let _ = List.find
+            (fun ele ->
+              match ele with
+                Element_class_type c2 ->
+                  if c2.clt_name = c.clt_name then
+                    (
+                     merge_class_types merge_options c c2;
+                     true
+                    )
+                  else
+                    false
+              | _ ->
+                  false
+            )
+            (* we look for the last value with this name defined in the implementation *)
+            (List.rev (Odoc_module.module_elements ml))
+        in
+        ()
+      with
+        Not_found ->
+          ()
+    )
+    (Odoc_module.module_class_types mli);
+
+  mli
+
+let merge merge_options modules_list =
+  let rec iter = function
+      [] -> []
+    | m :: q ->
+        (* look for another module with the same name *)
+        let (l_same, l_others) = List.partition
+            (fun m2 -> m.m_name = m2.m_name)
+            q
+        in
+        match l_same with
+          [] ->
+            (* no other module to merge with *)
+            m :: (iter l_others)
+        | m2 :: [] ->
+            (
+             (* we can merge m with m2 if there is an implementation
+                and an interface.*)
+             let f b = if !Odoc_global.inverse_merge_ml_mli then not b else b in
+             match f m.m_is_interface, f m2.m_is_interface with
+               true, false -> (merge_modules merge_options m m2) :: (iter l_others)
+             | false, true -> (merge_modules merge_options m2 m) :: (iter l_others)
+             | false, false ->
+                 if !Odoc_global.inverse_merge_ml_mli then
+                   (* two Module.ts for the .mli ! *)
+                   raise (Failure (Odoc_messages.two_interfaces m.m_name))
+                 else
+                   (* two Module.t for the .ml ! *)
+                   raise (Failure (Odoc_messages.two_implementations m.m_name))
+             | true, true ->
+                 if !Odoc_global.inverse_merge_ml_mli then
+                   (* two Module.t for the .ml ! *)
+                   raise (Failure (Odoc_messages.two_implementations m.m_name))
+                 else
+                   (* two Module.ts for the .mli ! *)
+                   raise (Failure (Odoc_messages.two_interfaces m.m_name))
+            )
+        | _ ->
+            (* too many Module.t ! *)
+            raise (Failure (Odoc_messages.too_many_module_objects m.m_name))
+
+  in
+  iter modules_list
diff --git a/ocamldoc/odoc_merge.mli b/ocamldoc/odoc_merge.mli
new file mode 100644
index 00000000..8614ecfc
--- /dev/null
+++ b/ocamldoc/odoc_merge.mli
@@ -0,0 +1,37 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Merge of information from [.ml] and [.mli] for a module.*)
+
+(** Merging \@before tags. *)
+val merge_before_tags :
+    (string * Odoc_types.text) list -> (string * Odoc_types.text) list
+
+(** Merge of two optional info structures.
+   Used to merge a comment before and a comment after
+   an element in [Odoc_sig.Analyser.analyse_signature_item_desc]. *)
+val merge_info_opt :
+    Odoc_types.merge_option list ->
+      Odoc_types.info option ->
+        Odoc_types.info option ->
+          Odoc_types.info option
+
+(** Merge of modules which represent the same OCaml module, in a list of t_module.
+   There must be at most two t_module for the same OCaml module, one for a .mli, another for the .ml.
+   The function returns the list of t_module where same modules have been merged, according
+   to the given merge_option list.*)
+val merge :
+  Odoc_types.merge_option list ->
+  Odoc_module.t_module list -> Odoc_module.t_module list
diff --git a/ocamldoc/odoc_messages.ml b/ocamldoc/odoc_messages.ml
new file mode 100644
index 00000000..72dd6c08
--- /dev/null
+++ b/ocamldoc/odoc_messages.ml
@@ -0,0 +1,420 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The messages of the application. *)
+
+let ok = "Ok"
+let software = "OCamldoc"
+let config_version = Config.version
+let magic = config_version^""
+
+(** Messages for command line *)
+
+let usage = "Usage: "^(Sys.argv.(0))^" [options] \n"
+let options_are = "Options are:"
+let latex_only = "(LaTeX only)"
+let texi_only = "(TeXinfo only)"
+let latex_texi_only = "(LaTeX and TeXinfo only)"
+let html_only = "(HTML only)"
+let html_latex_only = "(HTML and LaTeX only)"
+let html_latex_texi_only = "(HTML, LaTeX and TeXinfo only)"
+let man_only = "(man only)"
+let option_impl =" Consider  as a .ml file"
+let option_intf =" Consider  as a .mli file"
+let option_text =" Consider  as a .txt file"
+let display_custom_generators_dir = "Display custom generators standard directory and exit"
+let add_load_dir = " Add the given directory to the search path for custom\n"^
+  "\t\tgenerators"
+let load_file = " Load file defining a new documentation generator"
+let werr = " Treat ocamldoc warnings as errors"
+let show_missed_crossref = " Show missed cross-reference opportunities"
+let hide_warnings = " do not print ocamldoc warnings"
+let target_dir = " Generate files in directory , rather than in current\n"^
+  "\t\tdirectory (for man and HTML generators)"
+let dump = " Dump collected information into "
+let load = " Load information from  ; may be used several times"
+let css_style = " Use content of  as CSS style definition "^html_only
+let index_only = " Generate index files only "^html_only
+let colorize_code = " Colorize code even in documentation pages "^html_only
+let html_short_functors = " Use short form to display functor types "^html_only
+let charset c = Printf.sprintf
+  " Add information about character encoding being s\n\t\t(default is %s)"
+  c
+let generate_html = " Generate HTML documentation"
+let generate_latex = " Generate LaTeX documentation"
+let generate_texinfo = " Generate TeXinfo documentation"
+let generate_man = " Generate man pages"
+let generate_dot = " Generate dot code of top modules dependencies"
+
+let option_not_in_native_code op = "Option "^op^" not available in native code version."
+
+let default_out_file = "ocamldoc.out"
+let out_file =
+  " Set the output file name, used by texi, latex and dot generators\n"^
+  "\t\t(default is "^default_out_file^")\n"^
+  "\t\tor the prefix of index files for the HTML generator\n"^
+  "\t\t(default is index)"
+
+let dot_include_all =
+  " Include all modules in the dot output, not only the\n"^
+  "\t\tmodules given on the command line"
+let dot_types = " Generate dependency graph for types instead of modules"
+let default_dot_colors =
+  [ [ "darkturquoise" ; "darkgoldenrod2" ; "cyan" ; "green" ; ] ;
+    [ "magenta" ; "yellow" ; "burlywood1" ; "aquamarine" ; "floralwhite" ; "lightpink" ] ;
+    [ "lightblue" ; "mediumturquoise" ; "salmon" ; "slategray3"] ;
+  ]
+
+let dot_colors =
+  " \n"^
+  "\t\tUse colors c1,c1,...,cn in the dot output\n"^
+  "\t\t(default list is "^
+  (String.concat ",\n\t\t" (List.map (String.concat ",") default_dot_colors))^")"
+
+let dot_reduce =
+  " Perform a transitive reduction on the selected dependency graph\n"^
+  "\t\tbefore the dot output"
+
+let man_mini = " Generate man pages only for modules, module types, classes\n"^
+  "\t\tand class types "^man_only
+let default_man_section = "3"
+let man_section = "
     Use 
     in man page files "^
+  "(default is "^default_man_section^") "^man_only^"\n"
+
+let default_man_suffix = default_man_section^"o"
+let man_suffix = " Use  for man page files "^
+  "(default is "^default_man_suffix^") "^man_only^"\n"
+
+let option_title = " Use <title> as title for the generated documentation"
+let option_intro =
+  "<file> Use content of <file> as ocamldoc text to use as introduction\n"^
+  "\t\t"^(html_latex_texi_only)
+let with_parameter_list = " Display the complete list of parameters for functions and\n"^
+  "\t\tmethods "^html_only
+let hide_modules = "<M1,M2.M3,...> Hide the given complete module names in generated doc"
+let no_header = " Suppress header in generated documentation\n\t\t"^latex_texi_only
+let no_trailer = " Suppress trailer in generated documentation\n\t\t"^latex_texi_only
+let separate_files = " Generate one file per toplevel module "^latex_only
+let latex_title ref_titles =
+  "n,style Associate {n } to the given sectioning style\n"^
+  "\t\t(e.g. 'section') in the latex output "^latex_only^"\n"^
+  "\t\tDefault sectioning is:\n\t\t"^
+  (String.concat "\n\t\t"
+     (List.map (fun (n,t) -> Printf.sprintf " %d -> %s" n t) !ref_titles))
+
+let default_latex_value_prefix = "val:"
+let latex_value_prefix =
+  "<string>\n"^
+  "\t\tUse <string> as prefix for the LaTeX labels of values.\n"^
+  "\t\t(default is \""^default_latex_value_prefix^"\")"
+
+let default_latex_type_prefix = "type:"
+let latex_type_prefix =
+  "<string>\n"^
+  "\t\tUse <string> as prefix for the LaTeX labels of types.\n"^
+  "\t\t(default is \""^default_latex_type_prefix^"\")"
+
+let default_latex_type_elt_prefix = "typeelt:"
+let latex_type_elt_prefix =
+  "<string>\n"^
+  "\t\tUse <string> as prefix for the LaTeX labels of type elements.\n"^
+  "\t\t(default is \""^default_latex_type_elt_prefix^"\")"
+
+let default_latex_extension_prefix = "extension:"
+let latex_extension_prefix =
+  "<string>\n"^
+  "\t\tUse <string> as prefix for the LaTeX labels of extensions.\n"^
+  "\t\t(default is \""^default_latex_extension_prefix^"\")"
+
+let default_latex_exception_prefix = "exception:"
+let latex_exception_prefix =
+  "<string>\n"^
+  "\t\tUse <string> as prefix for the LaTeX labels of exceptions.\n"^
+  "\t\t(default is \""^default_latex_exception_prefix^"\")"
+
+let default_latex_module_prefix = "module:"
+let latex_module_prefix =
+  "<string>\n"^
+  "\t\tUse <string> as prefix for the LaTeX labels of modules.\n"^
+  "\t\t(default is \""^default_latex_module_prefix^"\")"
+
+let default_latex_module_type_prefix = "moduletype:"
+let latex_module_type_prefix =
+  "<string>\n"^
+  "\t\tUse <string> as prefix for the LaTeX labels of module types.\n"^
+  "\t\t(default is \""^default_latex_module_type_prefix^"\")"
+
+let default_latex_class_prefix = "class:"
+let latex_class_prefix =
+  "<string>\n"^
+  "\t\tUse <string> as prefix for the LaTeX labels of classes.\n"^
+  "\t\t(default is \""^default_latex_class_prefix^"\")"
+
+let default_latex_class_type_prefix = "classtype:"
+let latex_class_type_prefix =
+  "<string>\n"^
+  "\t\tUse <string> as prefix for the LaTeX labels of class types.\n"^
+  "\t\t(default is \""^default_latex_class_type_prefix^"\")"
+
+let default_latex_attribute_prefix = "val:"
+let latex_attribute_prefix =
+  "<string>\n"^
+  "\t\tUse <string> as prefix for the LaTeX labels of attributes.\n"^
+  "\t\t(default is \""^default_latex_attribute_prefix^"\")"
+
+let default_latex_method_prefix = "method:"
+let latex_method_prefix =
+  "<string>\n"^
+  "\t\tUse <string> as prefix for the LaTeX labels of methods.\n"^
+  "\t\t(default is \""^default_latex_method_prefix^"\")"
+
+let no_toc = " Do not generate table of contents "^latex_only
+let sort_modules = " Sort the list of top modules before generating the documentation"
+let no_stop = " Do not stop at (**/**) comments"
+let no_custom_tags = " Do not allow custom @-tags"
+let remove_stars = " Remove beginning blanks of comment lines, until the first '*'"
+let keep_code = " Always keep code when available"
+let inverse_merge_ml_mli = " Inverse implementations and interfaces when merging"
+let no_filter_with_module_constraints = "Do not filter module elements using module type constraints"
+let merge_description = ('d', "merge description")
+let merge_author = ('a', "merge @author")
+let merge_version = ('v', "merge @version")
+let merge_see = ('l', "merge @see")
+let merge_since = ('s', "merge @since")
+let merge_before = ('b', "merge @before")
+let merge_deprecated = ('o', "merge @deprecated")
+let merge_param = ('p', "merge @param")
+let merge_raised_exception = ('e', "merge @raise")
+let merge_return_value = ('r', "merge @return")
+let merge_custom = ('c', "merge custom @-tags")
+let merge_all = ('A', "merge all")
+
+let no_index = " Do not build index for Info files "^texi_only
+let esc_8bits = " Escape accentuated characters in Info files "^texi_only
+let texinfo_title r=
+  "n,style Associate {n } to the given sectioning style\n"^
+  "\t\t(e.g. 'section') in the texInfo output "^texi_only^"\n"^
+  "\t\tDefault sectioning is:\n\t\t"^
+  (String.concat "\n\t\t"
+     (List.map (fun (n,(t,h)) ->
+          Printf.sprintf " %d -> %s, %s " n t h) !r))
+
+let info_section = " Specify section of Info directory "^texi_only
+let info_entry = " Specify Info directory entry "^texi_only
+
+let options_can_be = "<options> can be one or more of the following characters:"
+let string_of_options_list l =
+  List.fold_left (fun acc -> fun (c, m) -> acc^"\n\t\t"^(String.make 1 c)^"  "^m)
+    ""
+    l
+
+let merge_options =
+  "<options> specify merge options between .mli and .ml\n\t\t"^
+  options_can_be^
+  (string_of_options_list
+     [ merge_description ;
+       merge_author ;
+       merge_version ;
+       merge_see ;
+       merge_since ;
+       merge_before ;
+       merge_deprecated ;
+       merge_param ;
+       merge_raised_exception ;
+       merge_return_value ;
+       merge_custom ;
+       merge_all ]
+  )
+
+let initially_opened_module = "<module> Name of the module that is initially opened"
+
+let library_namespace =
+  "<module> Name of the library namespace for a prefixed library.\
+   Note: very experimental."
+
+
+let help = " Display this list of options"
+
+
+(** Error and warning messages *)
+
+let warning = "Warning"
+
+let error_location file l c =
+  Printf.sprintf "File \"%s\", line %d, character %d:\n" file l c
+
+let bad_magic_number =
+  "Bad magic number for this ocamldoc dump!\n"^
+  "This dump was not created by this version of OCamldoc."
+
+let not_a_module_name s = s^" is not a valid module name"
+let load_file_error f e = "Error while loading file "^f^":\n"^e
+let wrong_format s = "Wrong format for \""^s^"\""
+let errors_occured n = (Int.to_string n)^" error(s) encountered"
+let parse_error = "Parse error"
+let text_parse_error l c s =
+  let lines = Str.split (Str.regexp_string "\n") s in
+  "Error parsing text:\n"
+  ^ (List.nth lines l) ^ "\n"
+  ^ (String.make c ' ') ^ "^"
+
+let file_not_found_in_paths paths name =
+  Printf.sprintf "No file %s found in the load paths: \n%s"
+    name
+    (String.concat "\n" paths)
+
+let tag_not_handled tag = "Tag @"^tag^" not handled by this generator"
+let should_escape_at_sign = "The character @ has a special meaning in ocamldoc comments, for commands such as @raise or @since. \
+If you want to write a single @, you must escape it as \\@."
+let bad_tree = "Incorrect tree structure."
+let not_a_valid_tag s = s^" is not a valid tag."
+let fun_without_param f = "Function "^f^" has no parameter.";;
+let method_without_param f = "Method "^f^" has no parameter.";;
+let anonymous_parameters f = "Function "^f^" has anonymous parameters."
+let function_colon f = "Function "^f^": "
+let implicit_match_in_parameter = "Parameters contain implicit pattern matching."
+let unknown_extension f = "Unknown extension for file "^f^"."
+let two_implementations name = "There are two implementations of module "^name^"."
+let two_interfaces name = "There are two interfaces of module "^name^"."
+let too_many_module_objects name = "There are too many interfaces/implementation of module "^name^"."
+let extension_not_found_in_implementation ext m = "Extension "^ext^" was not found in implementation of module "^m^"."
+let exception_not_found_in_implementation exc m = "Exception "^exc^" was not found in implementation of module "^m^"."
+let type_not_found_in_implementation exc m = "Type "^exc^" was not found in implementation of module "^m^"."
+let module_not_found_in_implementation m m2 = "Module "^m^" was not found in implementation of module "^m2^"."
+let value_not_found_in_implementation v m = "Value "^v^" was not found in implementation of module "^m^"."
+let class_not_found_in_implementation c m = "Class "^c^" was not found in implementation of module "^m^"."
+let attribute_not_found_in_implementation a c = "Attribute "^a^" was not found in implementation of class "^c^"."
+let method_not_found_in_implementation m c = "Method "^m^" was not found in implementation of class "^c^"."
+let different_types t = "Definition of type "^t^" doesn't match from interface to implementation."
+let attribute_type_not_found cl att = "The type of the attribute "^att^" could not be found in the signature of class "^cl^"."
+let method_type_not_found cl met = "The type of the method "^met^" could not be found in the signature of class "^cl^"."
+let module_not_found m m2 = "The module "^m2^" could not be found in the signature of module "^m^"."
+let module_type_not_found m mt = "The module type "^mt^" could not be found in the signature of module "^m^"."
+let value_not_found m v = "The value "^v^" could not be found in the signature of module "^m^"."
+let extension_not_found m e = "The extension "^e^" could not be found in the signature of module "^m^"."
+let exception_not_found m e = "The exception "^e^" could not be found in the signature of module "^m^"."
+let type_not_found m t = "The type "^t^" could not be found in the signature of module "^m^"."
+let class_not_found m c = "The class "^c^" could not be found in the signature of module "^m^"."
+let class_type_not_found m c = "The class type "^c^" could not be found in the signature of module "^m^"."
+let type_not_found_in_typedtree t = "Type "^t^" was not found in typed tree."
+let extension_not_found_in_typedtree x = "Extension "^x^" was not found in typed tree."
+let exception_not_found_in_typedtree e = "Exception "^e^" was not found in typed tree."
+let module_type_not_found_in_typedtree mt = "Module type "^mt^" was not found in typed tree."
+let module_not_found_in_typedtree m = "Module "^m^" was not found in typed tree."
+let class_not_found_in_typedtree c = "Class "^c^" was not found in typed tree."
+let class_type_not_found_in_typedtree ct = "Class type "^ct^" was not found in typed tree."
+let inherit_classexp_not_found_in_typedtree n =
+  "Inheritance class expression number "^(Int.to_string n)^" was not found in typed tree."
+let attribute_not_found_in_typedtree att = "Class attribute "^att^" was not found in typed tree."
+let method_not_found_in_typedtree met = "Class method "^met^" was not found in typed tree."
+let misplaced_comment file pos =
+  Printf.sprintf "Misplaced special comment in file %s, character %d." file pos
+
+let cross_module_not_found n = "Module "^n^" not found"
+let cross_module_type_not_found n = "Module type "^n^" not found"
+let cross_module_or_module_type_not_found n = "Module or module type "^n^" not found"
+let cross_class_not_found n = "Class "^n^" not found"
+let cross_class_type_not_found n = "class type "^n^" not found"
+let cross_class_or_class_type_not_found n = "Class or class type "^n^" not found"
+let cross_extension_not_found n = "Extension "^n^" not found"
+let cross_exception_not_found n = "Exception "^n^" not found"
+let cross_element_not_found n = "Element "^n^" not found"
+let cross_method_not_found n = "Method "^n^" not found"
+let cross_attribute_not_found n = "Attribute "^n^" not found"
+let cross_section_not_found n = "Section "^n^" not found"
+let cross_value_not_found n = "Value "^n^" not found"
+let cross_type_not_found n = "Type "^n^" not found"
+let cross_recfield_not_found n = Printf.sprintf "Record field %s not found" n
+let cross_const_not_found n = Printf.sprintf "Constructor %s not found" n
+
+let code_could_be_cross_reference n parent =
+  Printf.sprintf "Code element [%s] in %s corresponds to a known \
+                  cross-referenceable element, it might be worthwhile to replace it \
+                  with {!%s}" n parent n
+
+
+let object_end = "object ... end"
+let struct_end = "struct ... end"
+let sig_end = "sig ... end"
+
+let current_generator_is_not kind =
+  Printf.sprintf "Current generator is not a %s generator" kind
+;;
+
+(** Messages for verbose mode. *)
+
+let analysing f = "Analysing file "^f^"..."
+let merging = "Merging..."
+let cross_referencing = "Cross referencing..."
+let generating_doc = "Generating documentation..."
+let loading f = "Loading "^f^"..."
+let file_generated f = "File "^f^" generated."
+let file_exists_dont_generate f =
+  "File "^f^" exists, we don't generate it."
+
+(** Messages for documentation generation.*)
+
+let modul = "Module"
+let modules = "Modules"
+let functors = "Functors"
+let values = "Simple values"
+let types = "Types"
+let extensions = "Extensions"
+let exceptions = "Exceptions"
+let record = "Record"
+let variant = "Variant"
+let mutab = "mutable"
+let functions = "Functions"
+let parameters = "Parameters"
+let abstract = "Abstract"
+let functo = "Functor"
+let clas = "Class"
+let classes = "Classes"
+let attributes = "Attributes"
+let methods = "Methods"
+let authors = "Author(s)"
+let version = "Version"
+let since = "Since"
+let before = "Before"
+let deprecated = "Deprecated."
+let raises = "Raises"
+let returns = "Returns"
+let inherits = "Inherits"
+let inheritance = "Inheritance"
+let privat = "private"
+let module_type = "Module type"
+let class_type = "Class type"
+let description = "Description"
+let interface = "Interface"
+let type_parameters = "Type parameters"
+let class_types = "Class types"
+let module_types = "Module types"
+let see_also = "See also"
+let documentation = "Documentation"
+let index_of = "Index of"
+let top = "Top"
+let index_of_values = index_of^" values"
+let index_of_extensions = index_of^" extensions"
+let index_of_exceptions = index_of^" exceptions"
+let index_of_types = index_of^" types"
+let index_of_attributes = index_of^" class attributes"
+let index_of_methods = index_of^" class methods"
+let index_of_classes = index_of^" classes"
+let index_of_class_types = index_of^" class types"
+let index_of_modules = index_of^" modules"
+let index_of_module_types = index_of^" module types"
+let previous = "Previous"
+let next = "Next"
+let up = "Up"
diff --git a/ocamldoc/odoc_misc.ml b/ocamldoc/odoc_misc.ml
new file mode 100644
index 00000000..77b54a12
--- /dev/null
+++ b/ocamldoc/odoc_misc.ml
@@ -0,0 +1,512 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let no_blanks s =
+  let len = String.length s in
+  let buf = Buffer.create len in
+  for i = 0 to len - 1 do
+    match s.[i] with
+      ' ' | '\n' | '\t' | '\r' -> ()
+    | c -> Buffer.add_char buf c
+  done;
+  Buffer.contents buf
+
+let input_file_as_string nom =
+  let chanin = open_in_bin nom in
+  let len = 1024 in
+  let s = Bytes.create len in
+  let buf = Buffer.create len in
+  let rec iter () =
+    try
+      let n = input chanin s 0 len in
+      if n = 0 then
+        ()
+      else
+        (
+         Buffer.add_subbytes buf s 0 n;
+         iter ()
+        )
+    with
+      End_of_file -> ()
+  in
+  iter ();
+  close_in chanin;
+  Buffer.contents buf
+
+let split_string s chars =
+  let len = String.length s in
+  let rec iter acc pos =
+    if pos >= len then
+      match acc with
+        "" -> []
+      | _ -> [acc]
+    else
+      if List.mem s.[pos] chars then
+        match acc with
+          "" -> iter "" (pos + 1)
+        | _ -> acc :: (iter "" (pos + 1))
+      else
+        iter (Printf.sprintf "%s%c" acc s.[pos]) (pos + 1)
+  in
+  iter "" 0
+
+let split_with_blanks s = split_string s [' ' ; '\n' ; '\r' ; '\t' ]
+
+let list_concat sep =
+  let rec iter = function
+      [] -> []
+    | [h] -> [h]
+    | h :: q -> h :: sep :: iter q
+  in
+  iter
+
+let remove_duplicates (type a) compare (li : a list) =
+  let module S = Set.Make(struct type t = a let compare = compare end) in
+  let maybe_cons ((set, rev_acc) as acc) x =
+    if S.mem x set then acc
+    else (S.add x set, x :: rev_acc) in
+  let (_, rev_acc) = List.fold_left maybe_cons (S.empty, []) li in
+  List.rev rev_acc
+
+let rec string_of_longident li =
+  match li with
+  | Longident.Lident s -> s
+  | Longident.Ldot(li, s) -> string_of_longident li ^ "." ^ s
+  | Longident.Lapply(l1, l2) ->
+      string_of_longident l1 ^ "(" ^ string_of_longident l2 ^ ")"
+
+let get_fields type_expr =
+  let (fields, _) = Ctype.flatten_fields (Ctype.object_fields type_expr) in
+  List.fold_left
+    (fun acc -> fun (label, field_kind, typ) ->
+      match field_kind with
+        Types.Fabsent ->
+          acc
+      | _ ->
+          if label = "*dummy method*" then
+            acc
+          else
+            acc @ [label, typ]
+    )
+    []
+    fields
+
+let rec string_of_text t =
+  let rec iter t_ele =
+    match t_ele with
+      | Odoc_types.Raw s
+      | Odoc_types.Code s
+      | Odoc_types.CodePre s
+      | Odoc_types.Verbatim s -> s
+      | Odoc_types.Bold t
+      | Odoc_types.Italic t
+      | Odoc_types.Center t
+      | Odoc_types.Left t
+      | Odoc_types.Right t
+      | Odoc_types.Emphasize t -> string_of_text t
+      | Odoc_types.List l ->
+          (String.concat ""
+             (List.map (fun t -> "\n- "^(string_of_text t)) l))^
+          "\n"
+      | Odoc_types.Enum l ->
+          let rec f n = function
+              [] -> "\n"
+            | t :: q ->
+                "\n"^(Int.to_string n)^". "^(string_of_text t)^
+                (f (n + 1) q)
+          in
+          f 1 l
+      | Odoc_types.Newline -> "\n"
+      | Odoc_types.Block t -> "\t"^(string_of_text t)^"\n"
+      | Odoc_types.Title (_, _, t) -> "\n"^(string_of_text t)^"\n"
+      | Odoc_types.Latex s -> "{% "^s^" %}"
+      | Odoc_types.Link (s, t) ->
+          "["^s^"]"^(string_of_text t)
+      | Odoc_types.Ref (_name, _, Some text) ->
+          Printf.sprintf "[%s]" (string_of_text text)
+      | Odoc_types.Ref (name, _, None) ->
+          iter (Odoc_types.Code name)
+      | Odoc_types.Superscript t ->
+          "^{"^(string_of_text t)^"}"
+      | Odoc_types.Subscript t ->
+          "^{"^(string_of_text t)^"}"
+      | Odoc_types.Module_list l ->
+          string_of_text
+            (list_concat (Odoc_types.Raw ", ")
+               (List.map (fun s -> Odoc_types.Code s) l)
+            )
+      | Odoc_types.Index_list ->
+          ""
+      | Odoc_types.Custom (_, t) -> string_of_text t
+      | Odoc_types.Target _ -> ""
+  in
+  String.concat "" (List.map iter t)
+
+let string_of_author_list l =
+  match l with
+    [] ->
+      ""
+  | _ ->
+      "* "^Odoc_messages.authors^":\n"^
+      (String.concat ", " l)^
+      "\n"
+
+let string_of_version_opt v_opt =
+  match v_opt with
+    None -> ""
+  | Some v -> Odoc_messages.version^": "^v^"\n"
+
+let string_of_since_opt s_opt =
+  match s_opt with
+    None -> ""
+  | Some s -> Odoc_messages.since^" "^s^"\n"
+
+let string_of_raised_exceptions l =
+  match l with
+    [] -> ""
+  | (s, t) :: [] -> Odoc_messages.raises^" "^s^" "^(string_of_text t)^"\n"
+  | _ ->
+      Odoc_messages.raises^"\n"^
+      (String.concat ""
+         (List.map
+            (fun (ex, desc) -> "- "^ex^" "^(string_of_text desc)^"\n")
+            l
+         )
+      )^"\n"
+
+let string_of_see (see_ref, t) =
+  let t_ref =
+    match see_ref with
+      Odoc_types.See_url s -> [ Odoc_types.Link (s, t) ]
+    | Odoc_types.See_file s -> (Odoc_types.Code s) :: (Odoc_types.Raw " ") :: t
+    | Odoc_types.See_doc s -> (Odoc_types.Italic [Odoc_types.Raw s]) :: (Odoc_types.Raw " ") :: t
+  in
+  string_of_text t_ref
+
+let string_of_sees l =
+  match l with
+    [] -> ""
+  | see :: [] -> Odoc_messages.see_also^" "^(string_of_see see)^" \n"
+  | _ ->
+      Odoc_messages.see_also^"\n"^
+      (String.concat ""
+         (List.map
+            (fun see -> "- "^(string_of_see see)^"\n")
+            l
+         )
+      )^"\n"
+
+let string_of_return_opt return_opt =
+  match return_opt with
+    None -> ""
+  | Some s -> Odoc_messages.returns^" "^(string_of_text s)^"\n"
+
+let string_of_info i =
+  let module M = Odoc_types in
+  (match i.M.i_deprecated with
+    None -> ""
+  | Some d -> Odoc_messages.deprecated^"! "^(string_of_text d)^"\n")^
+  (match i.M.i_desc with
+    None -> ""
+  | Some d when d = [Odoc_types.Raw ""] -> ""
+  | Some d -> (string_of_text d)^"\n"
+  )^
+  (string_of_author_list i.M.i_authors)^
+  (string_of_version_opt i.M.i_version)^
+  (string_of_since_opt i.M.i_since)^
+  (string_of_raised_exceptions i.M.i_raised_exceptions)^
+  (string_of_return_opt i.M.i_return_value)
+
+let apply_opt f v_opt =
+  match v_opt with
+    None -> None
+  | Some v -> Some (f v)
+
+let string_of_date ?(absolute=false) ?(hour=true) d =
+  let add_0 s = if String.length s < 2 then "0"^s else s in
+  let t = (if absolute then Unix.gmtime else Unix.localtime) d in
+  (Int.to_string (t.Unix.tm_year + 1900))^"-"^
+  (add_0 (Int.to_string (t.Unix.tm_mon + 1)))^"-"^
+  (add_0 (Int.to_string t.Unix.tm_mday))^
+  (
+   if hour then
+     " "^
+     (add_0 (Int.to_string t.Unix.tm_hour))^":"^
+     (add_0 (Int.to_string t.Unix.tm_min))
+   else
+     ""
+  )
+
+let current_date =
+  let time =
+    try
+      float_of_string (Sys.getenv "SOURCE_DATE_EPOCH")
+    with
+      Not_found -> Unix.time ()
+  in string_of_date ~absolute: true ~hour: false time
+
+
+let rec text_list_concat sep l =
+  match l with
+    [] -> []
+  | [t] -> t
+  | t :: q ->
+      t @ (sep :: (text_list_concat sep q))
+
+let rec text_no_title_no_list t =
+  let iter t_ele =
+    match t_ele with
+    | Odoc_types.Title (_,_,t) -> text_no_title_no_list t
+    | Odoc_types.List l
+    | Odoc_types.Enum l ->
+        (Odoc_types.Raw " ") ::
+        (text_list_concat
+           (Odoc_types.Raw ", ")
+           (List.map text_no_title_no_list l))
+    | Odoc_types.Raw _
+    | Odoc_types.Code _
+    | Odoc_types.CodePre _
+    | Odoc_types.Verbatim _
+    | Odoc_types.Ref _
+    | Odoc_types.Target _ -> [t_ele]
+    | Odoc_types.Newline ->  [Odoc_types.Newline]
+    | Odoc_types.Block t -> [Odoc_types.Block (text_no_title_no_list t)]
+    | Odoc_types.Bold t -> [Odoc_types.Bold (text_no_title_no_list t)]
+    | Odoc_types.Italic t -> [Odoc_types.Italic (text_no_title_no_list t)]
+    | Odoc_types.Center t -> [Odoc_types.Center (text_no_title_no_list t)]
+    | Odoc_types.Left t -> [Odoc_types.Left (text_no_title_no_list t)]
+    | Odoc_types.Right t -> [Odoc_types.Right (text_no_title_no_list t)]
+    | Odoc_types.Emphasize t -> [Odoc_types.Emphasize (text_no_title_no_list t)]
+    | Odoc_types.Latex s -> [Odoc_types.Latex s]
+    | Odoc_types.Link (s, t) -> [Odoc_types.Link (s, (text_no_title_no_list t))]
+    | Odoc_types.Superscript t -> [Odoc_types.Superscript (text_no_title_no_list t)]
+    | Odoc_types.Subscript t -> [Odoc_types.Subscript (text_no_title_no_list t)]
+    | Odoc_types.Module_list l ->
+        list_concat (Odoc_types.Raw ", ")
+          (List.map
+             (fun s -> Odoc_types.Ref (s, Some Odoc_types.RK_module, None))
+             l
+          )
+    | Odoc_types.Index_list -> []
+    | Odoc_types.Custom (s,t) -> [Odoc_types.Custom (s, text_no_title_no_list t)]
+  in
+  List.flatten (List.map iter t)
+
+let get_titles_in_text t =
+  let l = ref [] in
+  let rec iter_ele ele =
+    match ele with
+    | Odoc_types.Title (n,lopt,t) -> l := (n,lopt,t) :: !l
+    | Odoc_types.List l
+    | Odoc_types.Enum l -> List.iter iter_text l
+    | Odoc_types.Raw _
+    | Odoc_types.Code _
+    | Odoc_types.CodePre _
+    | Odoc_types.Verbatim _
+    | Odoc_types.Ref _ -> ()
+    | Odoc_types.Newline ->  ()
+    | Odoc_types.Block t
+    | Odoc_types.Bold t
+    | Odoc_types.Italic t
+    | Odoc_types.Center t
+    | Odoc_types.Left t
+    | Odoc_types.Right t
+    | Odoc_types.Emphasize t -> iter_text t
+    | Odoc_types.Latex _ -> ()
+    | Odoc_types.Link (_, t)
+    | Odoc_types.Superscript t
+    | Odoc_types.Subscript t  -> iter_text t
+    | Odoc_types.Module_list _ -> ()
+    | Odoc_types.Index_list -> ()
+    | Odoc_types.Custom (_, t) -> iter_text t
+    | Odoc_types.Target _ -> ()
+  and iter_text txt =
+    List.iter iter_ele txt
+  in
+  iter_text t;
+  List.rev !l
+
+let text_concat (sep : Odoc_types.text) l =
+  let rec iter = function
+      [] -> []
+    | [last] -> last
+    | h :: q -> h @ sep @ (iter q)
+  in
+  iter l
+
+(*********************************************************)
+let rec get_before_dot s =
+  try
+    let len = String.length s in
+    let n = String.index s '.' in
+    if n + 1 >= len then
+      (* The dot is the last character *)
+      (true, s, "")
+    else
+      match s.[n+1] with
+        ' ' | '\n' | '\r' | '\t' ->
+          (true, String.sub s 0 (n+1),
+           String.sub s (n+1) (len - n - 1))
+      | _ ->
+          let b, s2, s_after = get_before_dot (String.sub s (n + 1) (len - n - 1)) in
+          (b, (String.sub s 0 (n+1))^s2, s_after)
+  with
+    Not_found -> (false, s, "")
+
+let rec first_sentence_text t =
+  match t with
+    [] -> (false, [], [])
+  | ele :: q ->
+      let (stop, ele2, ele3_opt) = first_sentence_text_ele ele in
+      if stop then
+        (stop, [ele2],
+         match ele3_opt with None -> q | Some e -> e :: q)
+      else
+        let (stop2, q2, rest) = first_sentence_text q in
+        (stop2, ele2 :: q2, rest)
+
+
+and first_sentence_text_ele text_ele =
+  match text_ele with
+  | Odoc_types.Raw s ->
+      let b, s2, s_after = get_before_dot s in
+      (b, Odoc_types.Raw s2, Some (Odoc_types.Raw s_after))
+  | Odoc_types.Code _
+  | Odoc_types.CodePre _
+  | Odoc_types.Verbatim _ -> (false, text_ele, None)
+  | Odoc_types.Bold t ->
+      let (b, t2, t3) = first_sentence_text t in
+      (b, Odoc_types.Bold t2, Some (Odoc_types.Bold t3))
+  | Odoc_types.Italic t ->
+      let (b, t2, t3) = first_sentence_text t in
+      (b, Odoc_types.Italic t2, Some (Odoc_types.Italic t3))
+  | Odoc_types.Center t ->
+      let (b, t2, t3) = first_sentence_text t in
+      (b, Odoc_types.Center t2, Some (Odoc_types.Center t3))
+  | Odoc_types.Left t ->
+      let (b, t2, t3) = first_sentence_text t in
+      (b, Odoc_types.Left t2, Some (Odoc_types.Left t3))
+  | Odoc_types.Right t ->
+      let (b, t2, t3) = first_sentence_text t in
+      (b, Odoc_types.Right t2, Some (Odoc_types.Right t3))
+  | Odoc_types.Emphasize t ->
+      let (b, t2, t3) = first_sentence_text t in
+      (b, Odoc_types.Emphasize t2, Some (Odoc_types.Emphasize t3))
+  | Odoc_types.Block t ->
+      let (b, t2, t3) = first_sentence_text t in
+      (b, Odoc_types.Block t2, Some (Odoc_types.Block t3))
+  | Odoc_types.Title (n, l_opt, t) ->
+      let (b, t2, t3) = first_sentence_text t in
+      (b,
+       Odoc_types.Title (n, l_opt, t2),
+       Some (Odoc_types.Title (n, l_opt, t3)))
+  | Odoc_types.Newline ->
+      (true, Odoc_types.Raw "", Some Odoc_types.Newline)
+  | Odoc_types.List _
+  | Odoc_types.Enum _
+  | Odoc_types.Latex _
+  | Odoc_types.Link _
+  | Odoc_types.Ref _
+  | Odoc_types.Superscript _
+  | Odoc_types.Subscript _
+  | Odoc_types.Module_list _
+  | Odoc_types.Index_list -> (false, text_ele, None)
+  | Odoc_types.Custom _
+  | Odoc_types.Target _ -> (false, text_ele, None)
+
+
+let first_sentence_of_text t =
+  let (_,t2,_) = first_sentence_text t in
+  t2
+
+let first_sentence_and_rest_of_text t =
+  let (_,t1, t2) = first_sentence_text t in
+  (t1, t2)
+
+let remove_ending_newline s =
+  let len = String.length s in
+  if len <= 0 then
+    s
+  else
+    match s.[len-1] with
+      '\n' -> String.sub s 0 (len-1)
+    | _ -> s
+
+let search_string_backward ~pat =
+  let lenp = String.length pat in
+  let rec iter s =
+    let len = String.length s in
+    match compare len lenp with
+      -1 -> raise Not_found
+    | 0 -> if pat = s then 0 else raise Not_found
+    | _ ->
+        let pos = len - lenp in
+        let s2 = String.sub s pos lenp in
+        if s2 = pat then
+          pos
+        else
+          iter (String.sub s 0 pos)
+  in
+  fun ~s -> iter s
+
+
+
+(*********************************************************)
+
+let create_index_lists elements string_of_ele =
+  let rec f current acc0 acc1 acc2 = function
+      [] -> (acc0 :: acc1) @ [acc2]
+    | ele :: q ->
+        let s = string_of_ele ele in
+        match s with
+          "" -> f current acc0 acc1 (acc2 @ [ele]) q
+        | _ ->
+            let first = Char.uppercase_ascii s.[0] in
+            match first with
+              'A' .. 'Z' ->
+                if current = first then
+                  f current acc0 acc1 (acc2 @ [ele]) q
+                else
+                  f first acc0 (acc1 @ [acc2]) [ele] q
+            | _ ->
+                f current (acc0 @ [ele]) acc1 acc2 q
+  in
+  f '_' [] [] [] elements
+
+
+(*** for labels *)
+
+let is_optional = Btype.is_optional
+let label_name = Btype.label_name
+
+let remove_option typ =
+  let rec iter t =
+    match t with
+    | Types.Tconstr(path, [ty], _) when Path.same path Predef.path_option -> ty.Types.desc
+    | Types.Tconstr _
+    | Types.Tvar _
+    | Types.Tunivar _
+    | Types.Tpoly _
+    | Types.Tarrow _
+    | Types.Ttuple _
+    | Types.Tobject _
+    | Types.Tfield _
+    | Types.Tnil
+    | Types.Tvariant _
+    | Types.Tpackage _ -> t
+    | Types.Tlink t2
+    | Types.Tsubst t2 -> iter t2.Types.desc
+  in
+  { typ with Types.desc = iter typ.Types.desc }
diff --git a/ocamldoc/odoc_misc.mli b/ocamldoc/odoc_misc.mli
new file mode 100644
index 00000000..e468f818
--- /dev/null
+++ b/ocamldoc/odoc_misc.mli
@@ -0,0 +1,126 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Miscellaneous functions *)
+
+(** [no_blanks s] returns the given string without any blank
+   characters, i.e. '\n' '\r' ' ' '\t'.
+*)
+val no_blanks : string -> string
+
+(** This function returns a file in the form of one string.*)
+val input_file_as_string : string -> string
+
+(** [split_with_blanks s] splits the given string [s] according to blanks. *)
+val split_with_blanks : string -> string list
+
+(** This function creates a string from a Longident.t .*)
+val string_of_longident : Longident.t -> string
+
+(** This function returns the list of (label, type_expr) describing
+   the methods of a type_expr in a Tobject.*)
+val get_fields : Types.type_expr -> (string * Types.type_expr) list
+
+(** get a string from a text *)
+val string_of_text : Odoc_types.text -> string
+
+(** @return a string for an authors list. *)
+val string_of_author_list : string list -> string
+
+(** @return a string for the given optional version information.*)
+val string_of_version_opt : string option -> string
+
+(** @return a string for the given optional since information.*)
+val string_of_since_opt : string option -> string
+
+(** @return a string for the given list of raised exceptions.*)
+val string_of_raised_exceptions : (string * Odoc_types.text) list -> string
+
+(** @return a string for the given "see also" reference.*)
+val string_of_see : Odoc_types.see_ref * Odoc_types.text -> string
+
+(** @return a string for the given list of "see also" references.*)
+val string_of_sees : (Odoc_types.see_ref * Odoc_types.text) list -> string
+
+(** @return a string for the given optional return information.*)
+val string_of_return_opt : Odoc_types.text option -> string
+
+(** get a string from a Odoc_info.info structure *)
+val string_of_info : Odoc_types.info -> string
+
+(** Apply a function to an optional value. *)
+val apply_opt : ('a -> 'b) -> 'a option -> 'b option
+
+(** Return a string representing a date given as a number of seconds
+   since 1970. The hour is optionally displayed. *)
+val string_of_date : ?absolute:bool -> ?hour:bool -> float -> string
+
+(* Value returned by string_of_date for current time.
+ * Uses environment variable SOURCE_DATE_EPOCH if set; falls back to
+ * current timestamp otherwise. *)
+val current_date : string
+
+(** Return the first sentence (until the first dot) of a text.
+   Don't stop in the middle of [Code], [Verbatim], [List], [Lnum],
+   [Latex], [Link], or [Ref]. *)
+val first_sentence_of_text : Odoc_types.text -> Odoc_types.text
+
+(** Return the first sentence (until the first dot) of a text,
+   and the remaining text after.
+   Don't stop in the middle of [Code], [Verbatim], [List], [Lnum],
+   [Latex], [Link], or [Ref]. *)
+val first_sentence_and_rest_of_text :
+    Odoc_types.text -> Odoc_types.text * Odoc_types.text
+
+(** Return the given [text] without any title or list. *)
+val text_no_title_no_list : Odoc_types.text -> Odoc_types.text
+
+(** [concat sep l] concats the given list of text [l], each separated with
+   the text [sep]. *)
+val text_concat : Odoc_types.text -> Odoc_types.text list -> Odoc_types.text
+
+(** Return the list of titles in a [text].
+   A title is a title level, an optional label and a text.*)
+val get_titles_in_text : Odoc_types.text -> (int * string option * Odoc_types.text) list
+
+(** Take a sorted list of elements, a function to get the name
+   of an element and return the list of list of elements,
+   where each list group elements beginning by the same letter.
+   Since the original list is sorted, elements whose name does not
+   begin with a letter should be in the first returned list.*)
+val create_index_lists : 'a list -> ('a -> string) -> 'a list list
+
+(** [remove_duplicates compare li] removes the duplicates in the input list,
+    keeping the leftmost occurrence of each repeated element. *)
+val remove_duplicates : ('a -> 'a -> int) -> 'a list -> 'a list
+
+(** [remove_ending_newline s] returns [s] without the optional ending newline. *)
+val remove_ending_newline : string -> string
+
+(** [search_string_backward pat s] searches backward string [pat] in string [s].
+   Return position in string [s] where [pat] appears, orelse raise [Not_found]. *)
+val search_string_backward : pat: string -> s: string -> int
+
+(** Take a type and remove the option top constructor. This is
+   useful when printing labels, we then remove the top option constructor
+   for optional labels.*)
+val remove_option : Types.type_expr -> Types.type_expr
+
+(** Return [true] if the given label is optional.*)
+val is_optional : Asttypes.arg_label -> bool
+
+(** Return the label name for the given label,
+   i.e. removes the beginning '?' if present.*)
+val label_name : Asttypes.arg_label -> string
diff --git a/ocamldoc/odoc_module.ml b/ocamldoc/odoc_module.ml
new file mode 100644
index 00000000..1b9cb180
--- /dev/null
+++ b/ocamldoc/odoc_module.ml
@@ -0,0 +1,571 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+module String = Misc.Stdlib.String
+
+(** Representation and manipulation of modules and module types. *)
+
+let print_DEBUG s = print_string s ; print_newline ()
+
+module Name = Odoc_name
+
+(** To keep the order of elements in a module. *)
+type module_element =
+    Element_module of t_module
+  | Element_module_type of t_module_type
+  | Element_included_module of included_module
+  | Element_class of Odoc_class.t_class
+  | Element_class_type of Odoc_class.t_class_type
+  | Element_value of Odoc_value.t_value
+  | Element_type_extension of Odoc_extension.t_type_extension
+  | Element_exception of Odoc_exception.t_exception
+  | Element_type of Odoc_type.t_type
+  | Element_module_comment of Odoc_types.text
+
+(** Used where we can reference t_module or t_module_type *)
+and mmt =
+  | Mod of t_module
+  | Modtype of t_module_type
+
+and included_module = {
+    im_name : Name.t ; (** the name of the included module *)
+    mutable im_module : mmt option ; (** the included module or module type *)
+    mutable im_info : Odoc_types.info option ; (** comment associated to the include directive *)
+  }
+
+and module_alias = {
+    ma_name : Name.t ;
+    mutable ma_module : mmt option ; (** the real module or module type if we could associate it *)
+  }
+
+and module_parameter = {
+    mp_name : string ; (** the name *)
+    mp_type : Types.module_type option ; (** the type *)
+    mp_type_code : string ; (** the original code *)
+    mp_kind : module_type_kind ; (** the way the parameter was built *)
+  }
+
+(** Different kinds of module. *)
+and module_kind =
+  | Module_struct of module_element list
+  | Module_alias of module_alias (** complete name and corresponding module if we found it *)
+  | Module_functor of module_parameter * module_kind
+  | Module_apply of module_kind * module_kind
+  | Module_with of module_type_kind * string
+  | Module_constraint of module_kind * module_type_kind
+  | Module_typeof of string (** by now only the code of the module expression *)
+  | Module_unpack of string * module_type_alias (** code of the expression and module type alias *)
+
+(** Representation of a module. *)
+and t_module = {
+    m_name : Name.t ;
+    mutable m_type : Types.module_type ;
+    mutable m_info : Odoc_types.info option ;
+    m_is_interface : bool ; (** true for modules read from interface files *)
+    m_file : string ; (** the file the module is defined in. *)
+    mutable m_kind : module_kind ;
+    mutable m_loc : Odoc_types.location ;
+    mutable m_top_deps : Name.t list ; (** The toplevels module names this module depends on. *)
+    mutable m_code : string option ; (** The whole code of the module *)
+    mutable m_code_intf : string option ; (** The whole code of the interface of the module *)
+    m_text_only : bool ; (** [true] if the module comes from a text file *)
+  }
+
+and module_type_alias = {
+    mta_name : Name.t ;
+    mutable mta_module : t_module_type option ; (** the real module type if we could associate it *)
+  }
+
+(** Different kinds of module type. *)
+and module_type_kind =
+  | Module_type_struct of module_element list
+  | Module_type_functor of module_parameter * module_type_kind
+  | Module_type_alias of module_type_alias (** complete name and corresponding module type if we found it *)
+  | Module_type_with of module_type_kind * string (** the module type kind and the code of the with constraint *)
+  | Module_type_typeof of string (** by now only the code of the module expression *)
+
+(** Representation of a module type. *)
+and t_module_type = {
+    mt_name : Name.t ;
+    mutable mt_info : Odoc_types.info option ;
+    mutable mt_type : Types.module_type option ; (** [None] = abstract module type *)
+    mt_is_interface : bool ; (** true for modules read from interface files *)
+    mt_file : string ; (** the file the module type is defined in. *)
+    mutable mt_kind : module_type_kind option ; (** [None] = abstract module type if mt_type = None ;
+                                           Always [None] when the module type was extracted from the implementation file. *)
+    mutable mt_loc : Odoc_types.location ;
+  }
+
+
+(** {1 Functions} *)
+
+(** Returns the list of values from a list of module_element. *)
+let values l =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Element_value v -> acc @ [v]
+      | _ -> acc
+    )
+    []
+    l
+
+(** Returns the list of types from a list of module_element. *)
+let types l =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Element_type t -> acc @ [t]
+      | _ -> acc
+    )
+    []
+    l
+
+(** Returns the list of type extensions from a list of module_element. *)
+let type_extensions l =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Element_type_extension x -> acc @ [x]
+      | _ -> acc
+    )
+    []
+    l
+
+(** Returns the list of exceptions from a list of module_element. *)
+let exceptions l =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Element_exception e -> acc @ [e]
+      | _ -> acc
+    )
+    []
+    l
+
+(** Returns the list of classes from a list of module_element. *)
+let classes l =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Element_class c -> acc @ [c]
+      | _ -> acc
+    )
+    []
+    l
+
+(** Returns the list of class types from a list of module_element. *)
+let class_types l =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Element_class_type ct -> acc @ [ct]
+      | _ -> acc
+    )
+    []
+    l
+
+(** Returns the list of modules from a list of module_element. *)
+let modules l =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Element_module m -> acc @ [m]
+      | _ -> acc
+    )
+    []
+    l
+
+(** Returns the list of module types from a list of module_element. *)
+let mod_types l =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Element_module_type mt -> acc @ [mt]
+      | _ -> acc
+    )
+    []
+    l
+
+(** Returns the list of module comment from a list of module_element. *)
+let comments l =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Element_module_comment t -> acc @ [t]
+      | _ -> acc
+    )
+    []
+    l
+
+(** Returns the list of included modules from a list of module_element. *)
+let included_modules l =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Element_included_module m -> acc @ [m]
+      | _ -> acc
+    )
+    []
+    l
+
+(** Returns the list of elements of a module type.
+   @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let rec module_type_elements ?(trans=true) mt =
+  let rec iter_kind = function
+    | None -> []
+    | Some (Module_type_struct l) -> l
+    | Some (Module_type_functor (_, k)) -> iter_kind (Some k)
+    | Some (Module_type_with (k, _)) ->
+        if trans then
+          iter_kind (Some k)
+        else
+          []
+    | Some (Module_type_alias mta) ->
+        if trans then
+          match mta.mta_module with
+            None -> []
+          | Some mt -> module_type_elements mt
+        else
+          []
+  | Some (Module_type_typeof _) -> []
+  in
+  iter_kind mt.mt_kind
+
+(** Returns the list of elements of a module.
+   @param trans indicates if, for aliased modules, we must perform a transitive search.
+*)
+let module_elements ?(trans=true) m =
+(* visited is used to guard against aliases loop
+     (e.g [module rec M:sig end=M] induced loop.
+*)
+  let rec module_elements visited ?(trans=true) m =
+    let rec iter_kind = function
+        Module_struct l ->
+          print_DEBUG "Odoc_module.module_elements: Module_struct";
+          l
+      | Module_alias ma ->
+          print_DEBUG "Odoc_module.module_elements: Module_alias";
+          if trans then
+            match ma.ma_module with
+              None -> []
+            | Some (Mod m') ->
+                if String.Set.mem m'.m_name visited then
+                  []
+                else
+                  module_elements (String.Set.add m'.m_name visited) m'
+            | Some (Modtype mt) -> module_type_elements mt
+          else
+            []
+      | Module_functor (_, k)
+      | Module_apply (k, _) ->
+          print_DEBUG "Odoc_module.module_elements: Module_functor ou Module_apply";
+          iter_kind k
+      | Module_with (tk,_) ->
+          print_DEBUG "Odoc_module.module_elements: Module_with";
+          module_type_elements ~trans: trans
+            { mt_name = "" ; mt_info = None ; mt_type = None ;
+              mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ;
+              mt_loc = Odoc_types.dummy_loc ;
+            }
+      | Module_constraint (k, _tk) ->
+          print_DEBUG "Odoc_module.module_elements: Module_constraint";
+          (* FIXME : use k or tk ? *)
+          module_elements visited ~trans: trans
+            { m_name = "" ;
+              m_info = None ;
+              m_type = Types.Mty_signature [] ;
+              m_is_interface = false ; m_file = "" ; m_kind = k ;
+              m_loc = Odoc_types.dummy_loc ;
+              m_top_deps = [] ;
+              m_code = None ;
+              m_code_intf = None ;
+              m_text_only = false ;
+            }
+      | Module_typeof _ -> []
+      | Module_unpack _ -> []
+(*
+   module_type_elements ~trans: trans
+   { mt_name = "" ; mt_info = None ; mt_type = None ;
+   mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ;
+   mt_loc = Odoc_types.dummy_loc }
+*)
+    in
+    iter_kind m.m_kind in
+  module_elements String.Set.empty ~trans m
+
+(** Returns the list of values of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_values ?(trans=true) m = values (module_elements ~trans m)
+
+(** Returns the list of functional values of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_functions ?(trans=true) m =
+  List.filter
+    (fun v -> Odoc_value.is_function v)
+    (values (module_elements ~trans m))
+
+(** Returns the list of non-functional values of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_simple_values ?(trans=true) m =
+    List.filter
+    (fun v -> not (Odoc_value.is_function v))
+    (values (module_elements ~trans m))
+
+(** Returns the list of types of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_types ?(trans=true) m = types (module_elements ~trans m)
+
+(** Returns the list of type extensions of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_type_extensions ?(trans=true) m = type_extensions (module_elements ~trans m)
+
+(** Returns the list of exceptions of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_exceptions ?(trans=true) m = exceptions (module_elements ~trans m)
+
+(** Returns the list of classes of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_classes ?(trans=true) m = classes (module_elements ~trans m)
+
+(** Returns the list of class types of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_class_types ?(trans=true) m = class_types (module_elements ~trans m)
+
+(** Returns the list of modules of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_modules ?(trans=true) m = modules (module_elements ~trans m)
+
+(** Returns the list of module types of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_module_types ?(trans=true) m = mod_types (module_elements ~trans m)
+
+(** Returns the list of included module of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_included_modules ?(trans=true) m = included_modules (module_elements ~trans m)
+
+(** Returns the list of comments of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_comments ?(trans=true) m = comments (module_elements ~trans m)
+
+(** Access to the parameters, for a functor type.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let rec module_type_parameters ?(trans=true) mt =
+  let rec iter k =
+    match k with
+      Some (Module_type_functor (p, k2)) ->
+        let param =
+           (* we create the couple (parameter, description opt), using
+              the description of the parameter if we can find it in the comment.*)
+          match mt.mt_info with
+            None -> (p, None)
+          | Some i ->
+              try
+                let d = List.assoc p.mp_name i.Odoc_types.i_params in
+                (p, Some d)
+              with
+                Not_found ->
+                  (p, None)
+        in
+        param :: (iter (Some k2))
+    | Some (Module_type_alias mta) ->
+        if trans then
+          match mta.mta_module with
+            None -> []
+          | Some mt2 -> module_type_parameters ~trans mt2
+        else
+          []
+    | Some (Module_type_with (k, _)) ->
+        if trans then
+          iter (Some k)
+        else
+          []
+    | Some (Module_type_struct _) ->
+        []
+    | Some (Module_type_typeof _) -> []
+      | None ->
+        []
+  in
+  iter mt.mt_kind
+
+(** Access to the parameters, for a functor.
+   @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+and module_parameters ?(trans=true) m =
+  let rec iter = function
+      Module_functor (p, k) ->
+        let param =
+         (* we create the couple (parameter, description opt), using
+            the description of the parameter if we can find it in the comment.*)
+          match m.m_info with
+            None ->(p, None)
+          | Some i ->
+              try
+                let d = List.assoc p.mp_name i.Odoc_types.i_params in
+                (p, Some d)
+              with
+                Not_found ->
+                  (p, None)
+        in
+        param :: (iter k)
+
+    | Module_alias ma ->
+        if trans then
+          match ma.ma_module with
+            None -> []
+          | Some (Mod m) -> module_parameters ~trans m
+          | Some (Modtype mt) -> module_type_parameters ~trans mt
+        else
+          []
+    | Module_constraint (_k, tk) ->
+        module_type_parameters ~trans: trans
+          { mt_name = "" ; mt_info = None ; mt_type = None ;
+            mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ;
+            mt_loc = Odoc_types.dummy_loc }
+    | Module_struct _
+    | Module_apply _
+    | Module_with _
+    | Module_typeof _
+    | Module_unpack _ -> []
+  in
+  iter m.m_kind
+
+(** access to all submodules and submodules of submodules ... of the given module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let rec module_all_submodules ?(trans=true) m =
+  let l = module_modules ~trans m in
+  List.fold_left
+    (fun acc -> fun m -> acc @ (module_all_submodules ~trans m))
+    l
+    l
+
+(** The module type is a functor if it is defined as a functor or if it is an alias for a functor. *)
+let rec module_type_is_functor mt =
+  let rec iter k =
+    match k with
+      Some (Module_type_functor _) -> true
+    | Some (Module_type_alias mta) ->
+        (
+         match mta.mta_module with
+           None -> false
+         | Some mtyp -> module_type_is_functor mtyp
+        )
+    | Some (Module_type_with (k, _)) ->
+        iter (Some k)
+    | Some (Module_type_struct _)
+    | Some (Module_type_typeof _)
+    | None -> false
+  in
+  iter mt.mt_kind
+
+(** The module is a functor if it is defined as a functor or if it is an alias for a functor. *)
+let module_is_functor m =
+  let rec iter visited = function
+      Module_functor _ -> true
+    | Module_alias ma ->
+        (
+          not (String.Set.mem ma.ma_name visited)
+          &&
+          match ma.ma_module with
+            None -> false
+          | Some (Mod mo) -> iter (String.Set.add ma.ma_name visited) mo.m_kind
+          | Some (Modtype mt) -> module_type_is_functor mt
+        )
+    | Module_constraint (k, _) ->
+        iter visited k
+    | _ -> false
+  in
+  iter String.Set.empty m.m_kind
+
+(** Returns the list of values of a module type.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_type_values ?(trans=true) m = values (module_type_elements ~trans m)
+
+(** Returns the list of types of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_type_types ?(trans=true) m = types (module_type_elements ~trans m)
+
+(** Returns the list of type extensions of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_type_type_extensions ?(trans=true) m = type_extensions (module_type_elements ~trans m)
+
+(** Returns the list of exceptions of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_type_exceptions ?(trans=true) m = exceptions (module_type_elements ~trans m)
+
+(** Returns the list of classes of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_type_classes ?(trans=true) m = classes (module_type_elements ~trans m)
+
+(** Returns the list of class types of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_type_class_types ?(trans=true) m = class_types (module_type_elements ~trans m)
+
+(** Returns the list of modules of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_type_modules ?(trans=true)  m = modules (module_type_elements ~trans m)
+
+(** Returns the list of module types of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_type_module_types ?(trans=true) m = mod_types (module_type_elements ~trans m)
+
+(** Returns the list of included module of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_type_included_modules ?(trans=true) m = included_modules (module_type_elements ~trans m)
+
+(** Returns the list of comments of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_type_comments ?(trans=true) m = comments (module_type_elements ~trans m)
+
+(** Returns the list of functional values of a module type.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_type_functions ?(trans=true) mt =
+  List.filter
+    (fun v -> Odoc_value.is_function v)
+    (values (module_type_elements ~trans mt))
+
+(** Returns the list of non-functional values of a module type.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_type_simple_values ?(trans=true) mt =
+    List.filter
+    (fun v -> not (Odoc_value.is_function v))
+    (values (module_type_elements ~trans mt))
+
+(** {1 Functions for modules and module types} *)
+
+(** The list of classes defined in this module and all its modules, functors, ....
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let rec module_all_classes ?(trans=true) m =
+  List.fold_left
+    (fun acc -> fun m -> acc @ (module_all_classes ~trans m))
+    (
+       List.fold_left
+       (fun acc -> fun mtyp -> acc @ (module_type_all_classes ~trans mtyp))
+       (module_classes ~trans m)
+       (module_module_types ~trans m)
+    )
+    (module_modules ~trans m)
+
+(** The list of classes defined in this module type and all its modules, functors, ....
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+and module_type_all_classes ?(trans=true) mt =
+  List.fold_left
+    (fun acc -> fun m -> acc @ (module_all_classes ~trans m))
+    (
+     List.fold_left
+       (fun acc -> fun mtyp -> acc @ (module_type_all_classes ~trans mtyp))
+       (module_type_classes ~trans mt)
+       (module_type_module_types ~trans mt)
+    )
+    (module_type_modules ~trans mt)
diff --git a/ocamldoc/odoc_name.ml b/ocamldoc/odoc_name.ml
new file mode 100644
index 00000000..5cb798bd
--- /dev/null
+++ b/ocamldoc/odoc_name.ml
@@ -0,0 +1,244 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Representation of element names. *)
+
+let infix_chars = [ '|' ;
+                    '<' ;
+                    '>' ;
+                    '@' ;
+                    '^' ;
+                    '&' ;
+                    '+' ;
+                    '-' ;
+                    '*' ;
+                    '/' ;
+                    '$' ;
+                    '%' ;
+                    '=' ;
+                    ':' ;
+                    '~' ;
+                    '!' ;
+                    '.' ;
+                    '#' ;
+                  ]
+
+type t = string
+
+let strip_string s =
+  let len = String.length s in
+  let rec iter_first n =
+    if n >= len then
+      None
+    else
+      match s.[n] with
+        ' ' | '\t' | '\n' | '\r' -> iter_first (n+1)
+      | _ -> Some n
+  in
+  match iter_first 0 with
+    None -> ""
+  | Some first ->
+      let rec iter_last n =
+        if n <= first then
+          None
+        else
+          match s.[n] with
+            ' ' | '\t' | '\n' | '\r' -> iter_last (n-1)
+          | _ -> Some n
+      in
+      match iter_last (len-1) with
+        None -> String.sub s first 1
+      | Some last -> String.sub s first ((last-first)+1)
+
+let parens_if_infix name =
+  match strip_string name with
+  | "" -> ""
+  | s when s.[0] = '*' || s.[String.length s - 1] = '*' -> "( " ^ s ^ " )"
+  | s when List.mem s.[0] infix_chars -> "(" ^ s ^ ")"
+  | "or" | "mod" | "land" | "lor" | "lxor" | "lsl" | "lsr" | "asr" ->
+     "(" ^ name ^ ")"
+  | name -> name
+;;
+
+let cut name =
+  match name with
+    "" -> ("", "")
+  | s ->
+      let len = String.length s in
+      match s.[len-1] with
+        ')' ->
+          (
+           let j = ref 0 in
+           let buf = [|Buffer.create len ; Buffer.create len |] in
+           for i = 0 to len - 1 do
+             match s.[i] with
+               '.' when !j = 0 ->
+                 if i < len - 1 then
+                   match s.[i+1] with
+                     '(' ->
+                       j := 1
+                   | _ ->
+                       Buffer.add_char buf.(!j) '.'
+                 else
+                   Buffer.add_char buf.(!j) s.[i]
+             | c ->
+                 Buffer.add_char buf.(!j) c
+           done;
+           (Buffer.contents buf.(0), Buffer.contents buf.(1))
+          )
+      | _ ->
+          match List.rev (Str.split (Str.regexp_string ".") s) with
+            [] -> ("", "")
+          | h :: q ->
+              (String.concat "." (List.rev q), h)
+
+let simple name = snd (cut name)
+let father name = fst (cut name)
+
+let concat n1 n2 = n1^"."^n2
+
+let normalize_name name =
+  let (p,s) = cut name in
+  let len = String.length s in
+  let s =
+    if len >= 2 &&
+      s.[0] = '(' && s.[len - 1] = ')'
+    then
+      parens_if_infix (strip_string (String.sub s 1 (len - 2)))
+    else
+      s
+  in
+  match p with
+    "" -> s
+  | p -> concat p s
+  ;;
+
+let head_and_tail n =
+  try
+    let pos = String.index n '.' in
+    if pos > 0 then
+      let h = String.sub n 0 pos in
+      try
+        ignore (String.index h '(');
+        (n, "")
+      with
+        Not_found ->
+          let len = String.length n in
+          if pos >= (len - 1) then
+            (h, "")
+          else
+            (h, String.sub n (pos + 1) (len - pos - 1))
+    else
+      (n, "")
+  with
+    Not_found -> (n, "")
+
+let head n = fst (head_and_tail n)
+
+let depth name =
+  try
+    List.length (Str.split (Str.regexp "\\.") name)
+  with
+    _ -> 1
+
+let prefix n1 n2 =
+  (n1 <> n2) &&
+  (try
+    let len1 = String.length n1 in
+    ((String.sub n2 0 len1) = n1) &&
+    (n2.[len1] = '.')
+  with _ -> false)
+
+let rec get_relative_raw n1 n2 =
+  let (f1,s1) = head_and_tail n1 in
+  let (f2,s2) = head_and_tail n2 in
+  if f1 = f2 then
+    if f2 = s2 || s2 = "" then
+      s2
+    else
+      if f1 = s1 || s1 = "" then
+        s2
+      else
+        get_relative_raw s1 s2
+  else
+    n2
+
+let get_relative n1 n2 =
+  if prefix n1 n2 then
+    let len1 = String.length n1 in
+    try
+      String.sub n2 (len1+1) ((String.length n2) - len1 - 1)
+    with
+      _ -> n2
+  else
+    n2
+
+let get_relative_opt n1 n2 =
+  if n1 = "" then n2 else
+    if prefix n1 n2 then
+      let len1 = String.length n1 in
+      try
+        String.sub n2 (len1+1) ((String.length n2) - len1 - 1)
+      with
+        _ -> n2
+    else
+      n2
+
+
+let alias_unprefix ln s =
+  if ln = "" then s else
+  let p = ln ^ "__" in
+  let n, k = String.(length p, length s) in
+  if k > n &&
+     String.sub s 0 n = p then
+    String.( capitalize_ascii @@ sub s n (k-n) )
+  else
+    s
+
+let hide_given_modules l s =
+  let rec iter = function
+      [] -> s
+    | h :: q ->
+        let s2 = get_relative h s in
+        if s = s2 then
+          iter q
+        else
+          s2
+  in
+  iter l
+
+let qualified name = String.contains name '.'
+
+let from_ident ident = Ident.name ident
+
+
+let from_path path = Path.name path
+
+let to_path n =
+  match
+    List.fold_left
+      (fun acc_opt -> fun s ->
+        match acc_opt with
+          None -> Some (Path.Pident (Ident.create_local s))
+        | Some acc -> Some (Path.Pdot (acc, s)))
+      None
+      (Str.split (Str.regexp "\\.") n)
+  with
+    None -> raise (Failure "to_path")
+  | Some p -> p
+
+let from_longident = Odoc_misc.string_of_longident
+
+module Map = Map.Make(String)
diff --git a/ocamldoc/odoc_name.mli b/ocamldoc/odoc_name.mli
new file mode 100644
index 00000000..5da8d7d4
--- /dev/null
+++ b/ocamldoc/odoc_name.mli
@@ -0,0 +1,82 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Representation of element names. *)
+
+type t = string
+
+(** Add parenthesis to the given simple name if needed. *)
+val parens_if_infix : t -> t
+
+(** Return a simple name from a name.*)
+val simple : t -> t
+
+(** Return the name of the 'father' (like dirname for a file name).*)
+val father : t -> t
+
+(** Concatenates two names. *)
+val concat : t -> t -> t
+
+(** Normalize the given name by removing the beginning and ending spaces
+     of the simple name and adding parenthesis if needed. *)
+val normalize_name : t -> t
+
+(** Returns the head of a name. *)
+val head : t -> t
+
+(** Returns the depth of the name, i.e. the number of levels to the root.
+   Example : [Toto.Tutu.name] has depth 3. *)
+val depth : t -> int
+
+(** Returns true if the first name is a prefix of the second name.
+   If the two names are equal, then it is false (strict prefix).*)
+val prefix : t -> t -> bool
+
+(** remove a [Library__] prefix and capitalize the resulting name *)
+val alias_unprefix: t -> t -> t
+
+(** Take two names n1 and n2 = n3.n4 and return n4 if n3=n1 or else n2. *)
+val get_relative : t -> t -> t
+
+
+(** [get_relative_opt n1 n2] is [n2] if [n1=""] and
+    [get_relative n1 n2] otherwise *)
+val get_relative_opt : t -> t -> t
+
+
+(** Take two names n1=n3.n4 and n2 = n5.n6 and return n6 if n3=n5 or else n2. *)
+val get_relative_raw : t -> t -> t
+
+(** Take a list of module names to hide and a name,
+   and return the name when the module name (or part of it)
+   was removed, according to the list of module names to hide.*)
+val hide_given_modules : t list -> t -> t
+
+(** Indicate if a name if qualified or not. *)
+val qualified : t -> bool
+
+(** Get a name from an [Ident.t]. *)
+val from_ident : Ident.t -> t
+
+(** Get a name from a [Path.t]. *)
+val from_path : Path.t -> t
+
+(** Get a [Path.t] from a name.*)
+val to_path : t -> Path.t
+
+(** Get a name from a [Longident.t].*)
+val from_longident : Longident.t -> t
+
+module Map : Map.S with type key = t
diff --git a/ocamldoc/odoc_ocamlhtml.mll b/ocamldoc/odoc_ocamlhtml.mll
new file mode 100644
index 00000000..76debf1e
--- /dev/null
+++ b/ocamldoc/odoc_ocamlhtml.mll
@@ -0,0 +1,552 @@
+{
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Generation of html code to display OCaml code. *)
+open Lexing
+
+exception Fatal_error
+
+let fatal_error msg =
+  prerr_string ">> Fatal error: "; prerr_endline msg; raise Fatal_error
+
+type error =
+  | Illegal_character of char
+  | Unterminated_comment
+  | Unterminated_string
+  | Unterminated_string_in_comment
+  | Keyword_as_label of string
+;;
+
+exception Error of error * int * int
+
+let base_escape_strings = [
+    ("&", "&") ;
+    ("<", "<") ;
+    (">", ">") ;
+]
+
+
+let prelike_escape_strings = [
+  (" ", " ") ;
+  ("\t", "        ") ;
+  ("\n", "<br>\n")
+]
+
+
+let pre = ref false
+let fmt = ref Format.str_formatter
+
+(** Escape the strings which would clash with html syntax,
+   and some other strings if we want to get a PRE style outside of
+   <pre> </pre>.*)
+let escape s =
+  let escape_strings =
+    if !pre then
+      base_escape_strings
+    else
+      base_escape_strings @ prelike_escape_strings in
+  List.fold_left
+    (fun acc -> fun (s, s2) -> Str.global_replace (Str.regexp s) s2 acc)
+    s
+    escape_strings
+
+(** Escape the strings which would clash with html syntax. *)
+let escape_base s =
+  List.fold_left
+    (fun acc -> fun (s, s2) -> Str.global_replace (Str.regexp s) s2 acc)
+    s
+    base_escape_strings
+
+(** The output functions *)
+
+let print ?(esc=true) s =
+  Format.pp_print_string !fmt (if esc then escape s else s)
+;;
+
+let print_class ?(esc=true) cl s =
+  print ~esc: false ("<span class=\""^cl^"\">"^
+                     (if esc then escape s else s)^
+                     "</span>")
+;;
+
+(** The table of keywords with colors *)
+let create_hashtable size init =
+  let tbl = Hashtbl.create size in
+  List.iter (fun (key, data) -> Hashtbl.add tbl key data) init;
+  tbl
+
+(** The function used to return html code for the given comment body. *)
+let html_of_comment = ref
+    (fun (_ : string) -> "<b>Odoc_ocamlhtml.html_of_comment not initialized</b>")
+
+let keyword_table =
+  create_hashtable 149 [
+    "and", "keyword" ;
+    "as", "keyword" ;
+    "assert", "keyword" ;
+    "begin", "keyword" ;
+    "class", "keyword" ;
+    "constraint", "keyword" ;
+    "do", "keyword" ;
+    "done", "keyword" ;
+    "downto", "keyword" ;
+    "else", "keyword" ;
+    "end", "keyword" ;
+    "exception", "keyword" ;
+    "external", "keyword" ;
+    "false", "keyword" ;
+    "for", "keyword" ;
+    "fun", "keyword" ;
+    "function", "keyword" ;
+    "functor", "keyword" ;
+    "if", "keyword" ;
+    "in", "keyword" ;
+    "include", "keyword" ;
+    "inherit", "keyword" ;
+    "initializer", "keyword" ;
+    "lazy", "keyword" ;
+    "let", "keyword" ;
+    "match", "keyword" ;
+    "method", "keyword" ;
+    "module", "keyword" ;
+    "mutable", "keyword" ;
+    "new", "keyword" ;
+    "object", "keyword" ;
+    "of", "keyword" ;
+    "open", "keyword" ;
+    "or", "keyword" ;
+    "parser", "keyword" ;
+    "private", "keyword" ;
+    "rec", "keyword" ;
+    "sig", "keyword" ;
+    "struct", "keyword" ;
+    "then", "keyword" ;
+    "to", "keyword" ;
+    "true", "keyword" ;
+    "try", "keyword" ;
+    "type", "keyword" ;
+    "val", "keyword" ;
+    "virtual", "keyword" ;
+    "when", "keyword" ;
+    "while", "keyword" ;
+    "with", "keyword" ;
+
+    "mod", "keyword" ;
+    "land", "keyword" ;
+    "lor", "keyword" ;
+    "lxor", "keyword" ;
+    "lsl", "keyword" ;
+    "lsr", "keyword" ;
+    "asr", "keyword" ;
+]
+
+let kwsign_class = "keywordsign"
+let constructor_class = "constructor"
+let comment_class = "comment"
+let string_class = "string"
+let code_class = "code"
+
+
+(** To buffer and print comments *)
+
+
+let margin = ref 0
+
+let comment_buffer = Buffer.create 32
+let reset_comment_buffer () = Buffer.reset comment_buffer
+let store_comment_char = Buffer.add_char comment_buffer
+let add_comment_string = Buffer.add_string comment_buffer
+
+let make_margin () =
+  let rec iter n =
+    if n <= 0 then ""
+    else " "^(iter (n-1))
+  in
+  iter !margin
+
+let print_comment () =
+  let s = Buffer.contents comment_buffer in
+  let len = String.length s in
+  let code =
+    if len < 1 then
+      "<span class=\""^comment_class^"\">(*"^(escape s)^"*)</span>"
+    else
+      match s.[0] with
+        '*' ->
+          (
+           try
+             let html = !html_of_comment (String.sub s 1 (len-1)) in
+             "</code><table><tr><td>"^(make_margin ())^"</td><td>"^
+             "<span class=\""^comment_class^"\">"^
+             "(**"^html^"*)"^
+             "</span></td></tr></table><code class=\""^code_class^"\">"
+           with
+             e ->
+               prerr_endline (Printexc.to_string e);
+               "<span class=\""^comment_class^"\">(*"^(escape s)^"*)</span>"
+          )
+      | _ ->
+          "<span class=\""^comment_class^"\">(*"^(escape s)^"*)</span>"
+  in
+  print ~esc: false code
+
+(** To buffer string literals *)
+
+let string_buffer = Buffer.create 32
+let reset_string_buffer () = Buffer.reset string_buffer
+let store_string_char = Buffer.add_char string_buffer
+let get_stored_string () =
+  Buffer.contents string_buffer
+
+(** To translate escape sequences *)
+
+let char_for_backslash = function
+  | 'n' -> '\010'
+  | 'r' -> '\013'
+  | 'b' -> '\008'
+  | 't' -> '\009'
+  | c   -> c
+
+let char_for_decimal_code lexbuf i =
+  let c = 100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) +
+           10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) +
+                (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48) in
+  Char.chr(c land 0xFF)
+
+let char_for_hexa_code lexbuf i =
+  let c = 16 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) +
+                (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) in
+  Char.chr(c land 0xFF)
+
+(** To store the position of the beginning of a string and comment *)
+let string_start_pos = ref 0;;
+let comment_start_pos = ref [];;
+let in_comment () = !comment_start_pos <> [];;
+
+(** Error report *)
+
+open Format
+
+let report_error ppf = function
+  | Illegal_character c ->
+      fprintf ppf "Illegal character (%s)" (Char.escaped c)
+  | Unterminated_comment ->
+      fprintf ppf "Comment not terminated"
+  | Unterminated_string ->
+      fprintf ppf "String literal not terminated"
+  | Unterminated_string_in_comment ->
+      fprintf ppf "This comment contains an unterminated string literal"
+  | Keyword_as_label kwd ->
+      fprintf ppf "`%s' is a keyword, it cannot be used as label name" kwd
+;;
+
+}
+
+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 symbolchar =
+  ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~']
+let decimal_literal = ['0'-'9']+
+let hex_literal = '0' ['x' 'X'] ['0'-'9' 'A'-'F' 'a'-'f']+
+let oct_literal = '0' ['o' 'O'] ['0'-'7']+
+let bin_literal = '0' ['b' 'B'] ['0'-'1']+
+let float_literal =
+  ['0'-'9']+ ('.' ['0'-'9']* )? (['e' 'E'] ['+' '-']? ['0'-'9']+)?
+
+rule token = parse
+    blank
+      {
+        let s = Lexing.lexeme lexbuf in
+        (
+         match s with
+           " " -> incr margin
+         | "\t" -> margin := !margin + 8
+         | "\n" -> margin := 0
+         | _ -> ()
+        );
+        print s;
+        token lexbuf
+      }
+  | "_"
+      { print "_" ; token lexbuf }
+  | "~"  { print "~" ; token lexbuf }
+  | "~" lowercase identchar * ':'
+      { let s = Lexing.lexeme lexbuf in
+        let name = String.sub s 1 (String.length s - 2) 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
+        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
+            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
+      { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "\""
+      { reset_string_buffer();
+        let string_start = Lexing.lexeme_start lexbuf in
+        string_start_pos := string_start;
+        string lexbuf;
+        lexbuf.Lexing.lex_start_pos <-
+          string_start - lexbuf.Lexing.lex_abs_pos;
+        print_class string_class ("\""^(get_stored_string())^"\"") ;
+        token lexbuf }
+  | "'" [^ '\\' '\''] "'"
+      { print_class string_class (Lexing.lexeme lexbuf) ;
+        token lexbuf }
+  | "'" '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'"
+      { print_class string_class (Lexing.lexeme lexbuf ) ;
+        token lexbuf }
+  | "'" '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
+      { print_class string_class (Lexing.lexeme lexbuf ) ;
+        token lexbuf }
+  | "(*"
+      {
+        reset_comment_buffer ();
+        comment_start_pos := [Lexing.lexeme_start lexbuf];
+        comment lexbuf ;
+        print_comment ();
+        token lexbuf }
+  | "(*)"
+      { reset_comment_buffer ();
+        comment_start_pos := [Lexing.lexeme_start lexbuf];
+        comment lexbuf ;
+        print_comment ();
+        token lexbuf
+      }
+  | "*)"
+      { lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1;
+        lexbuf.Lexing.lex_curr_p <-
+          { lexbuf.Lexing.lex_curr_p with
+            pos_cnum = lexbuf.Lexing.lex_curr_p.pos_cnum - 1
+          } ;
+        print (Lexing.lexeme lexbuf) ;
+        token lexbuf
+      }
+  | "#" [' ' '\t']* ['0'-'9']+ [^ '\n' '\r'] * ('\n' | '\r' | "\r\n")
+      (* # linenum ...  *)
+      {
+        print (Lexing.lexeme lexbuf);
+        token lexbuf
+      }
+  | "#"  { print_class kwsign_class (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "&"  { print_class kwsign_class (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "&&" { print_class kwsign_class (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "`"  { print_class kwsign_class (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "'"  { print_class kwsign_class (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "("  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ")"  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "*"  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ","  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "??" { print_class kwsign_class (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "->" { print_class kwsign_class (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "."  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ".." { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ":"  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "::" { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ":=" { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ":>" { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ";"  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ";;" { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "<"  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "<-" { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "="  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "["  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "[|" { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "[<" { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "]"  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "{"  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "{<" { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "|"  { print_class kwsign_class (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "||" { print_class kwsign_class (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "|]" { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ">"  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ">]" { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "}"  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ">}" { print (Lexing.lexeme lexbuf) ; token lexbuf }
+
+  | "!=" { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "+"  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "-"  { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "-." { print (Lexing.lexeme lexbuf) ; token lexbuf }
+
+  | "!" symbolchar *
+            { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ['~' '?'] symbolchar +
+            { print_class kwsign_class (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ['=' '<' '>' '|' '&' '$'] symbolchar *
+            { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ['@' '^'] symbolchar *
+            { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ['+' '-'] symbolchar *
+            { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | "**" symbolchar *
+            { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | ['*' '/' '%'] symbolchar *
+            { print (Lexing.lexeme lexbuf) ; token lexbuf }
+  | eof { () }
+  | _
+      { raise (Error(Illegal_character ((Lexing.lexeme lexbuf).[0]),
+                     Lexing.lexeme_start lexbuf, Lexing.lexeme_end lexbuf)) }
+
+and comment = parse
+    "(*"
+      { comment_start_pos := Lexing.lexeme_start lexbuf :: !comment_start_pos;
+        store_comment_char '(';
+        store_comment_char '*';
+        comment lexbuf;
+      }
+  | "*)"
+      { match !comment_start_pos with
+        | [] -> assert false
+        | [_] -> comment_start_pos := []
+        | _ :: l ->
+            store_comment_char '*';
+            store_comment_char ')';
+            comment_start_pos := l;
+            comment lexbuf;
+       }
+(* These filters are useless
+  | "\""
+      { reset_string_buffer();
+        string_start_pos := Lexing.lexeme_start lexbuf;
+        store_comment_char '"';
+        begin
+          try string lexbuf; add_comment_string ((get_stored_string()^"\""))
+          with Error (Unterminated_string, _, _) ->
+          let st = List.hd !comment_start_pos in
+          raise (Error (Unterminated_string_in_comment, st, st + 2))
+        end;
+        comment lexbuf }
+  | "'" [^ '\\' '\''] "'"
+      {
+        store_comment_char '\'';
+        store_comment_char (Lexing.lexeme_char lexbuf 1);
+        store_comment_char '\'';
+        comment lexbuf }
+  | "'\\" ['\\' '\'' 'n' 't' 'b' 'r'] "'"
+      {
+        store_comment_char '\'';
+        store_comment_char '\\';
+        store_comment_char(char_for_backslash(Lexing.lexeme_char lexbuf 1)) ;
+        store_comment_char '\'';
+        comment lexbuf }
+  | "\\" ['0'-'9'] ['0'-'9'] ['0'-'9']
+      {
+        store_comment_char(char_for_decimal_code lexbuf 1);
+        comment lexbuf }
+  | "\\x" ['0'-'9' 'A'-'Z' 'a'-'z' ] ['0'-'9' 'A'-'Z' 'a'-'z']
+      {
+        store_comment_char(char_for_hexa_code lexbuf 2);
+        string lexbuf }
+  | "''"
+      {
+        store_comment_char '\'';
+        store_comment_char '\'';
+        comment lexbuf }
+*)
+  | eof
+      { let st = List.hd !comment_start_pos in
+        raise (Error (Unterminated_comment, st, st + 2));
+      }
+  | _
+      { store_comment_char(Lexing.lexeme_char lexbuf 0);
+        comment lexbuf }
+
+and string = parse
+    '"'
+      { () }
+  | '\\' ("\010" | "\013" | "\013\010") [' ' '\009'] *
+      { string lexbuf }
+  | '\\' ['\\' '"' 'n' 't' 'b' 'r' ]
+      { Buffer.add_string string_buffer (Lexing.lexeme lexbuf) ;
+        string lexbuf }
+  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
+      {
+        Buffer.add_string string_buffer (Lexing.lexeme lexbuf) ;
+        string lexbuf
+      }
+  | '\\' 'x' ['0'-'9' 'A'-'Z' 'a'-'z' ] ['0'-'9' 'A'-'Z' 'a'-'z']
+      {  Buffer.add_string string_buffer (Lexing.lexeme lexbuf) ;
+         string lexbuf }
+  | eof
+      { raise (Error (Unterminated_string,
+                      !string_start_pos, !string_start_pos+1)) }
+  | _
+      { store_string_char(Lexing.lexeme_char lexbuf 0);
+        string lexbuf }
+{
+
+let html_of_code b ?(with_pre=true) code =
+  let old_pre = !pre in
+  let old_margin = !margin in
+  let old_comment_buffer = Buffer.contents comment_buffer in
+  let old_string_buffer = Buffer.contents string_buffer in
+  let buf = Buffer.create 256 in
+  let old_fmt = !fmt in
+  fmt := Format.formatter_of_buffer buf ;
+  pre := with_pre;
+  margin := 0;
+
+  let start = "<code class=\""^code_class^"\">" in
+  let ending = "</code>" in
+  let html =
+    (
+     try
+       print ~esc: false start ;
+       let lexbuf = Lexing.from_string code in
+       token lexbuf;
+       print ~esc: false ending ;
+       Format.pp_print_flush !fmt () ;
+       Buffer.contents buf
+     with
+       _ ->
+         (* flush str_formatter because we already output
+            something in it *)
+         Format.pp_print_flush !fmt () ;
+         start^code^ending
+    )
+  in
+  pre := old_pre;
+  margin := old_margin ;
+  Buffer.reset comment_buffer;
+  Buffer.add_string comment_buffer old_comment_buffer ;
+  Buffer.reset string_buffer;
+  Buffer.add_string string_buffer old_string_buffer ;
+  fmt := old_fmt ;
+
+  Buffer.add_string b html
+
+}
diff --git a/ocamldoc/odoc_parameter.ml b/ocamldoc/odoc_parameter.ml
new file mode 100644
index 00000000..32aa0dec
--- /dev/null
+++ b/ocamldoc/odoc_parameter.ml
@@ -0,0 +1,125 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Representation and manipulation of method / function / class parameters. *)
+
+let print_DEBUG s = print_string s ; print_newline ()
+
+(** Types *)
+
+(** Representation of a simple parameter name *)
+type simple_name = {
+    sn_name : string ;
+    sn_type : Types.type_expr ;
+    mutable sn_text : Odoc_types.text option ;
+  }
+
+(** Representation of parameter names. We need it to represent parameter names in tuples.
+   The value [Tuple ([], t)] stands for an anonymous parameter.*)
+type param_info =
+  | Simple_name of simple_name
+  | Tuple of param_info list * Types.type_expr
+
+(** A parameter is just a param_info.*)
+type parameter = param_info
+
+(** Functions *)
+
+(** access to the name as a string. For tuples, parentheses and commas are added. *)
+let complete_name p =
+  let rec iter pi =
+    match pi with
+      Simple_name sn ->
+        sn.sn_name
+    | Tuple ([], _) -> (* anonymous parameter *)
+        "??"
+    | Tuple (pi_list, _) ->
+        "("^(String.concat "," (List.map iter pi_list))^")"
+  in
+  iter p
+
+(** access to the complete type *)
+let typ pi =
+  match pi with
+    Simple_name sn -> sn.sn_type
+  | Tuple (_, typ) -> typ
+
+(** Update the text of a parameter using a function returning
+   the optional text associated to a parameter name.*)
+let update_parameter_text f p =
+  let rec iter pi =
+    match pi with
+      Simple_name sn ->
+        sn.sn_text <- f sn.sn_name
+    | Tuple (l, _) ->
+        List.iter iter l
+  in
+  iter p
+
+(** access to the description of a specific name.
+   @raise Not_found if no description is associated to the given name. *)
+let desc_by_name pi name =
+  let rec iter acc pi =
+    match pi with
+      Simple_name sn ->
+        (sn.sn_name, sn.sn_text) :: acc
+    | Tuple (pi_list, _) ->
+        List.fold_left iter acc pi_list
+      in
+  let l = iter [] pi in
+  List.assoc name l
+
+
+(** access to the list of names ; only one for a simple parameter, or
+   a list for tuples. *)
+let names pi =
+  let rec iter acc pi =
+    match pi with
+      Simple_name sn ->
+        sn.sn_name :: acc
+    | Tuple (pi_list, _) ->
+            List.fold_left iter acc pi_list
+  in
+  iter [] pi
+
+(** access to the type of a specific name.
+   @raise Not_found if no type is associated to the given name. *)
+let type_by_name pi name =
+  let rec iter acc pi =
+    match pi with
+      Simple_name sn ->
+        (sn.sn_name, sn.sn_type) :: acc
+    | Tuple (pi_list, _) ->
+        List.fold_left iter acc pi_list
+      in
+  let l = iter [] pi in
+  List.assoc name l
+
+(** access to the optional description of a parameter name from an optional info structure.*)
+let desc_from_info_opt info_opt s =
+  print_DEBUG "desc_from_info_opt";
+  match info_opt with
+    None -> None
+  | Some i ->
+      match s with
+        "" -> None
+      | _ ->
+          try
+            Some (List.assoc s i.Odoc_types.i_params)
+          with
+            Not_found ->
+              print_DEBUG ("desc_from_info_opt "^s^" not found in\n");
+              List.iter (fun (s, _) -> print_DEBUG s) i.Odoc_types.i_params;
+              None
diff --git a/ocamldoc/odoc_parser.mly b/ocamldoc/odoc_parser.mly
new file mode 100644
index 00000000..f27a9982
--- /dev/null
+++ b/ocamldoc/odoc_parser.mly
@@ -0,0 +1,177 @@
+%{
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Odoc_comments_global
+
+let uppercase = "[A-Z\192-\214\216-\222]"
+let identchar =
+  "[A-Za-z_\192-\214\216-\246\248-\255'0-9]"
+let blank = "[ \010\013\009\012]"
+
+let print_DEBUG s = print_string s; print_newline ()
+%}
+
+%token <string * (string option)> Description
+
+%token <string> See_url
+%token <string> See_file
+%token <string> See_doc
+
+%token T_PARAM
+%token T_AUTHOR
+%token T_VERSION
+%token T_SEE
+%token T_SINCE
+%token T_BEFORE
+%token T_DEPRECATED
+%token T_RAISES
+%token T_RETURN
+%token <string> T_CUSTOM
+
+%token EOF
+
+%token <string> Desc
+
+/* Start Symbols */
+%start main info_part2 see_info
+%type <(string * (string option)) option> main
+%type <unit> info_part2
+%type <Odoc_types.see_ref * string> see_info
+
+
+%%
+see_info:
+  see_ref Desc { ($1, $2) }
+;
+
+see_ref:
+    See_url { Odoc_types.See_url $1 }
+| See_file { Odoc_types.See_file $1 }
+| See_doc { Odoc_types.See_doc $1 }
+;
+
+main:
+  Description { Some $1 }
+| EOF { None }
+;
+
+info_part2:
+  element_list EOF { () }
+;
+
+element_list:
+  element { () }
+| element element_list { () }
+;
+
+element:
+| param { () }
+| author { () }
+| version { () }
+| see { () }
+| since { () }
+| before { () }
+| deprecated { () }
+| raise_exc { () }
+| return { () }
+| custom { () }
+;
+
+param:
+    T_PARAM Desc
+    {
+      (* isolate the identificator *)
+      (* we only look for simple id, no pattern nor tuples *)
+      let s = $2 in
+      match Str.split (Str.regexp (blank^"+")) s with
+        []
+      | _ :: [] ->
+          raise (Failure "usage: @param id description")
+      | id :: _ ->
+          print_DEBUG ("Identificator "^id);
+          let reg = identchar^"+" in
+          print_DEBUG ("reg="^reg);
+          if Str.string_match (Str.regexp reg) id 0 then
+            let remain = String.sub s (String.length id) ((String.length s) - (String.length id)) in
+            print_DEBUG ("T_PARAM Desc remain="^remain);
+            let remain2 = Str.replace_first (Str.regexp ("^"^blank^"+")) "" remain in
+            params := !params @ [(id, remain2)]
+          else
+            raise (Failure (id^" is not a valid parameter identificator in \"@param "^s^"\""))
+    }
+;
+author:
+    T_AUTHOR Desc { authors := !authors @ [ $2 ] }
+;
+version:
+    T_VERSION Desc { version := Some $2 }
+;
+see:
+    T_SEE Desc { sees := !sees @ [$2] }
+;
+since:
+    T_SINCE Desc { since := Some $2 }
+;
+before:
+    T_BEFORE Desc
+    {
+      (* isolate the version name *)
+      let s = $2 in
+      match Str.split (Str.regexp (blank^"+")) s with
+        []
+      | _ :: [] ->
+          raise (Failure "usage: @before version description")
+      | id :: _ ->
+          print_DEBUG ("version "^id);
+            let remain = String.sub s (String.length id) ((String.length s) - (String.length id)) in
+            let remain2 = Str.replace_first (Str.regexp ("^"^blank^"+")) "" remain in
+            before := !before @ [(id, remain2)]
+    }
+;
+deprecated:
+    T_DEPRECATED Desc { deprecated := Some $2 }
+;
+raise_exc:
+    T_RAISES Desc
+    {
+      (* isolate the exception constructor name *)
+      let s = $2 in
+      match Str.split (Str.regexp (blank^"+")) s with
+        []
+      | _ :: [] ->
+          raise (Failure "usage: @raise Exception description")
+      | id :: _ ->
+          print_DEBUG ("exception "^id);
+          let reg = uppercase^identchar^"*"^"\\(\\."^uppercase^identchar^"*\\)*" in
+          print_DEBUG ("reg="^reg);
+          if Str.string_match (Str.regexp reg) id 0 then
+            let remain = String.sub s (String.length id) ((String.length s) - (String.length id)) in
+            let remain2 = Str.replace_first (Str.regexp ("^"^blank^"+")) "" remain in
+            raised_exceptions := !raised_exceptions @ [(id, remain2)]
+          else
+            raise (Failure (id^" is not a valid exception constructor in \"@raise "^s^"\""))
+    }
+;
+return:
+    T_RETURN Desc { return_value := Some $2 }
+;
+
+custom:
+    T_CUSTOM Desc { customs := !customs @ [($1, $2)] }
+;
+
+
+%%
diff --git a/ocamldoc/odoc_print.ml b/ocamldoc/odoc_print.ml
new file mode 100644
index 00000000..5612e5b7
--- /dev/null
+++ b/ocamldoc/odoc_print.ml
@@ -0,0 +1,109 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Format
+let () = Printtyp.Naming_context.enable false
+
+let new_fmt () =
+  let buf = Buffer.create 512 in
+  let fmt = formatter_of_buffer buf in
+  let flush () =
+    pp_print_flush fmt ();
+    let s = Buffer.contents buf in
+    Buffer.reset buf ;
+    s
+  in
+  (fmt, flush)
+
+let (type_fmt, flush_type_fmt) = new_fmt ()
+let _ =
+  let outfuns = pp_get_formatter_out_functions type_fmt () in
+  pp_set_formatter_out_functions type_fmt
+    {outfuns with out_newline = fun () -> outfuns.out_string "\n  " 0 3}
+
+let (modtype_fmt, flush_modtype_fmt) = new_fmt ()
+
+
+
+
+let string_of_type_expr t =
+  Printtyp.mark_loops t;
+  Printtyp.type_scheme_max ~b_reset_names: false type_fmt t;
+  flush_type_fmt ()
+
+exception Use_code of string
+
+(** Return the given module type where methods and vals have been removed
+   from the signatures. Used when we don't want to print a too long module type.
+   @param code when the code is given, we raise the [Use_code] exception if we
+   encounter a signature, so that the calling function can use the code rather
+   than the "emptied" type.
+*)
+let simpl_module_type ?code t =
+  let open Types in
+  let rec iter t =
+    match t with
+      Mty_ident _
+    | Mty_alias _ -> t
+    | Mty_signature _ ->
+        (
+         match code with
+           None -> Mty_signature []
+         | Some s -> raise (Use_code s)
+        )
+    | Mty_functor (Unit, mt) -> Mty_functor (Unit, iter mt)
+    | Mty_functor (Named (name, mt1), mt2) ->
+      Mty_functor (Named (name, iter mt1), iter mt2)
+  in
+  iter t
+
+let string_of_module_type ?code ?(complete=false) t =
+  try
+    let t2 = if complete then t else simpl_module_type ?code t in
+    Printtyp.modtype modtype_fmt t2;
+    flush_modtype_fmt ()
+  with
+    Use_code s -> s
+
+(** Return the given class type where methods and vals have been removed
+   from the signatures. Used when we don't want to print a too long class type.*)
+let simpl_class_type t =
+  let rec iter t =
+    match t with
+      Types.Cty_constr _ -> t
+    | Types.Cty_signature cs ->
+        (* we delete vals and methods in order to not print them when
+           displaying the type *)
+      let tnil =
+        { Types.desc = Types.Tnil ; Types.level = 0
+        ; Types.scope = Btype.lowest_level ; Types.id = 0 }
+      in
+        Types.Cty_signature { Types.csig_self = { cs.Types.csig_self with
+                                                  Types.desc = Types.Tobject (tnil, ref None) };
+                              csig_vars = Types.Vars.empty ;
+                              csig_concr = Types.Concr.empty ;
+                              csig_inher = []
+                             }
+    | Types.Cty_arrow (l, texp, ct) ->
+        let new_ct = iter ct in
+        Types.Cty_arrow (l, texp, new_ct)
+  in
+  iter t
+
+let string_of_class_type ?(complete=false) t =
+  let t2 = if complete then t else simpl_class_type t in
+  (* FIXME : my own Printtyp.class_type variant to avoid reset_names *)
+  Printtyp.class_type modtype_fmt t2;
+  flush_modtype_fmt ()
diff --git a/ocamldoc/odoc_print.mli b/ocamldoc/odoc_print.mli
new file mode 100644
index 00000000..e288fffb
--- /dev/null
+++ b/ocamldoc/odoc_print.mli
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Printing functions. *)
+
+(** This function takes a Types.type_expr and returns a string.
+   It writes in and flushes [Format.str_formatter].*)
+val string_of_type_expr : Types.type_expr -> string
+
+(** This function returns a string representing a [Types.module_type].
+   @param complete indicates if we must print complete signatures
+   or just [sig end]. Default is [false].
+   @param code if [complete = false] and the type contains something else
+   than identificators and functors, then the given code is used.
+*)
+val string_of_module_type : ?code: string -> ?complete: bool -> Types.module_type -> string
+
+(** This function returns a string representing a [Types.class_type].
+   @param complete indicates if we must print complete signatures
+   or just [object end]. Default is [false].
+*)
+val string_of_class_type : ?complete: bool -> Types.class_type -> string
diff --git a/ocamldoc/odoc_scan.ml b/ocamldoc/odoc_scan.ml
new file mode 100644
index 00000000..50850d11
--- /dev/null
+++ b/ocamldoc/odoc_scan.ml
@@ -0,0 +1,190 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Scanning of modules and elements.
+
+   The class scanner defined in this module can be used to
+   develop generators which perform controls on the elements
+   and their comments.
+*)
+
+open Odoc_types
+
+(** Class which defines the scanning of a list of modules and their
+   elements. Inherit this class to develop your own scanner, by
+   overriding some methods.*)
+class scanner =
+  object (self)
+
+    method scan_value (_ : Odoc_value.t_value) = ()
+
+    method scan_type_pre (_ : Odoc_type.t_type) = true
+
+    method scan_type_recfield _t (_ : Odoc_type.record_field) = ()
+    method scan_type_const _t (_ : Odoc_type.variant_constructor) = ()
+    method scan_type (t : Odoc_type.t_type) =
+      if self#scan_type_pre t then
+        match t.Odoc_type.ty_kind with
+          Odoc_type.Type_abstract -> ()
+        | Odoc_type.Type_variant l -> List.iter (self#scan_type_const t) l
+        | Odoc_type.Type_record l -> List.iter (self#scan_type_recfield t) l
+        | Odoc_type.Type_open -> ()
+
+    method scan_extension_constructor (_ : Odoc_extension.t_extension_constructor) = ()
+    method scan_exception (_ : Odoc_exception.t_exception) = ()
+    method scan_attribute (_ : Odoc_value.t_attribute) = ()
+    method scan_method (_ : Odoc_value.t_method) = ()
+    method scan_included_module (_ : Odoc_module.included_module) = ()
+
+  (** Scan of a type extension *)
+
+    (** Override this method to perform controls on the extension's type,
+        private and info. This method is called before scanning the
+        extensions's constructors.
+        @return true if the extension's constructors must be scanned.*)
+    method scan_type_extension_pre (_: Odoc_extension.t_type_extension) = true
+
+    (** This method scans the constructors of the given type extension. *)
+    method scan_type_extension_constructors (x: Odoc_extension.t_type_extension) =
+      List.iter self#scan_extension_constructor (Odoc_extension.extension_constructors x)
+
+    (** Scan of a type extension. Should not be overridden. It calls [scan_type_extension_pre]
+      and if [scan_type_extension_pre] returns [true], then it calls scan_type_extension_constructors.*)
+    method scan_type_extension (x: Odoc_extension.t_type_extension) =
+      if self#scan_type_extension_pre x then self#scan_type_extension_constructors x
+
+
+  (** Scan of a class. *)
+
+    (** Scan of a comment inside a class. *)
+    method scan_class_comment (_ : text) = ()
+
+    (** Override this method to perform controls on the class comment
+       and params. This method is called before scanning the class elements.
+       @return true if the class elements must be scanned.*)
+    method scan_class_pre (_ : Odoc_class.t_class) = true
+
+    (** This method scans the elements of the given class.
+       A VOIR : scan des classes heritees.*)
+    method scan_class_elements c =
+      List.iter
+        (fun ele ->
+          match ele with
+            Odoc_class.Class_attribute a -> self#scan_attribute a
+          | Odoc_class.Class_method m -> self#scan_method m
+          | Odoc_class.Class_comment t -> self#scan_class_comment t
+        )
+        (Odoc_class.class_elements c)
+
+    (** Scan of a class. Should not be overridden. It calls [scan_class_pre]
+      and if [scan_class_pre] returns [true], then it calls scan_class_elements.*)
+    method scan_class c = if self#scan_class_pre c then self#scan_class_elements c
+
+  (** Scan of a class type. *)
+
+    (** Scan of a comment inside a class type. *)
+    method scan_class_type_comment (_ : text) = ()
+
+    (** Override this method to perform controls on the class type comment
+       and form. This method is called before scanning the class type elements.
+       @return true if the class type elements must be scanned.*)
+    method scan_class_type_pre (_ : Odoc_class.t_class_type) = true
+
+    (** This method scans the elements of the given class type.
+       A VOIR : scan des classes heritees.*)
+    method scan_class_type_elements ct =
+      List.iter
+        (fun ele ->
+          match ele with
+            Odoc_class.Class_attribute a -> self#scan_attribute a
+          | Odoc_class.Class_method m -> self#scan_method m
+          | Odoc_class.Class_comment t -> self#scan_class_type_comment t
+        )
+        (Odoc_class.class_type_elements ct)
+
+    (** Scan of a class type. Should not be overridden. It calls [scan_class_type_pre]
+      and if [scan_class_type_pre] returns [true], then it calls scan_class_type_elements.*)
+    method scan_class_type ct = if self#scan_class_type_pre ct then self#scan_class_type_elements ct
+
+  (** Scan of modules. *)
+
+    (** Scan of a comment inside a module. *)
+    method scan_module_comment (_ : text) = ()
+
+    (** Override this method to perform controls on the module comment
+       and form. This method is called before scanning the module elements.
+       @return true if the module elements must be scanned.*)
+    method scan_module_pre (_ : Odoc_module.t_module) = true
+
+    (** This method scans the elements of the given module. *)
+    method scan_module_elements m =
+      List.iter
+        (fun ele ->
+          match ele with
+            Odoc_module.Element_module m -> self#scan_module m
+          | Odoc_module.Element_module_type mt -> self#scan_module_type mt
+          | Odoc_module.Element_included_module im -> self#scan_included_module im
+          | Odoc_module.Element_class c -> self#scan_class c
+          | Odoc_module.Element_class_type ct -> self#scan_class_type ct
+          | Odoc_module.Element_value v -> self#scan_value v
+          | Odoc_module.Element_type_extension x -> self#scan_type_extension x
+          | Odoc_module.Element_exception e -> self#scan_exception e
+          | Odoc_module.Element_type t -> self#scan_type t
+          | Odoc_module.Element_module_comment t -> self#scan_module_comment t
+        )
+        (Odoc_module.module_elements m)
+
+    (** Scan of a module. Should not be overridden. It calls [scan_module_pre]
+      and if [scan_module_pre] returns [true], then it calls scan_module_elements.*)
+    method scan_module m = if self#scan_module_pre m then self#scan_module_elements m
+
+  (** Scan of module types. *)
+
+    (** Scan of a comment inside a module type. *)
+    method scan_module_type_comment (_ : text) = ()
+
+    (** Override this method to perform controls on the module type comment
+       and form. This method is called before scanning the module type elements.
+       @return true if the module type elements must be scanned. *)
+    method scan_module_type_pre (_ : Odoc_module.t_module_type) = true
+
+    (** This method scans the elements of the given module type. *)
+    method scan_module_type_elements mt =
+      List.iter
+        (fun ele ->
+          match ele with
+            Odoc_module.Element_module m -> self#scan_module m
+          | Odoc_module.Element_module_type mt -> self#scan_module_type mt
+          | Odoc_module.Element_included_module im -> self#scan_included_module im
+          | Odoc_module.Element_class c -> self#scan_class c
+          | Odoc_module.Element_class_type ct -> self#scan_class_type ct
+          | Odoc_module.Element_value v -> self#scan_value v
+          | Odoc_module.Element_type_extension x -> self#scan_type_extension x
+          | Odoc_module.Element_exception e -> self#scan_exception e
+          | Odoc_module.Element_type t -> self#scan_type t
+          | Odoc_module.Element_module_comment t -> self#scan_module_comment t
+        )
+        (Odoc_module.module_type_elements mt)
+
+    (** Scan of a module type. Should not be overridden. It calls [scan_module_type_pre]
+      and if [scan_module_type_pre] returns [true], then it calls scan_module_type_elements.*)
+    method scan_module_type mt =
+      if self#scan_module_type_pre mt then self#scan_module_type_elements mt
+
+  (** Main scanning method. *)
+
+    (** Scan a list of modules. *)
+    method scan_module_list l = List.iter self#scan_module l
+  end
diff --git a/ocamldoc/odoc_search.ml b/ocamldoc/odoc_search.ml
new file mode 100644
index 00000000..810c88e8
--- /dev/null
+++ b/ocamldoc/odoc_search.ml
@@ -0,0 +1,744 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Research of elements through modules. *)
+
+open Odoc_value
+open Odoc_type
+open Odoc_extension
+open Odoc_exception
+open Odoc_class
+open Odoc_module
+
+type result_element =
+    Res_module of t_module
+  | Res_module_type of t_module_type
+  | Res_class of t_class
+  | Res_class_type of t_class_type
+  | Res_value of t_value
+  | Res_type of t_type
+  | Res_extension of t_extension_constructor
+  | Res_exception of t_exception
+  | Res_attribute of t_attribute
+  | Res_method of t_method
+  | Res_section of string * Odoc_types.text
+  | Res_recfield of t_type * record_field
+  | Res_const of t_type * variant_constructor
+
+type result = result_element list
+
+module type Predicates =
+  sig
+    type t
+    val p_module : t_module -> t -> bool * bool
+    val p_module_type : t_module_type -> t -> bool * bool
+    val p_class : t_class -> t -> bool * bool
+    val p_class_type : t_class_type -> t -> bool * bool
+    val p_value : t_value -> t -> bool
+    val p_recfield : t_type -> record_field -> t -> bool
+    val p_const : t_type -> variant_constructor -> t -> bool
+    val p_type : t_type -> t -> (bool * bool)
+    val p_extension : t_extension_constructor -> t -> bool
+    val p_exception : t_exception -> t -> bool
+    val p_attribute : t_attribute -> t -> bool
+    val p_method : t_method -> t -> bool
+    val p_section : string -> t -> bool
+  end
+
+module Search =
+  functor (P : Predicates) ->
+  struct
+    let search_section t s v = if P.p_section s v then [Res_section (s,t)] else []
+
+    let rec search_text root t v =
+      List.flatten (List.map (fun e -> search_text_ele root e v) t)
+
+    and search_text_ele root e v =
+      let module T = Odoc_types in
+      match e with
+      | T.Raw _
+      | T.Code _
+      | T.CodePre _
+      | T.Latex _
+      | T.Verbatim _
+      | T.Ref (_, _, _) -> []
+      | T.Bold t
+      | T.Italic t
+      | T.Center t
+      | T.Left t
+      | T.Right t
+      | T.Emphasize t
+      | T.Block t
+      | T.Superscript t
+      | T.Subscript t
+      | T.Custom (_,t)
+      | T.Link (_, t) -> search_text root t v
+      | T.List l
+      | T.Enum l -> List.flatten (List.map (fun t -> search_text root t v) l)
+      | T.Newline
+      | T.Module_list _
+      | T.Index_list -> []
+      | T.Target _ -> []
+      | T.Title (_, l_opt, t) ->
+          (match l_opt with
+            None -> []
+          | Some s -> search_section t (Name.concat root s) v) @
+          (search_text root t v)
+
+    let search_value va v = if P.p_value va v then [Res_value va] else []
+
+    let search_recfield t f v =
+      if P.p_recfield t f v then [Res_recfield (t,f)] else []
+
+    let search_const t f v =
+      if P.p_const t f v then [Res_const (t,f)] else []
+
+    let search_type t v =
+      let (go_deeper, ok) = P.p_type t v in
+      let l =
+        match go_deeper with
+          false -> []
+        | true ->
+            match t.ty_kind with
+              Type_abstract -> []
+            | Type_record l ->
+                List.flatten (List.map (fun rf -> search_recfield t rf v) l)
+            | Type_variant l ->
+                List.flatten (List.map (fun rf -> search_const t rf v) l)
+            | Type_open -> []
+      in
+      if ok then (Res_type t) :: l else l
+
+    let search_extension_constructor xt v =
+      if P.p_extension xt v then [Res_extension xt] else []
+
+    let search_type_extension te v =
+      List.fold_left
+        (fun acc -> fun xt -> acc @ (search_extension_constructor xt v))
+        []
+        (Odoc_extension.extension_constructors te)
+
+    let search_exception e v = if P.p_exception e v then [Res_exception e] else []
+
+    let search_attribute a v = if P.p_attribute a v then [Res_attribute a] else []
+
+    let search_method m v = if P.p_method m v then [Res_method m] else []
+
+    let search_class c v =
+      let (go_deeper, ok) = P.p_class c v in
+      let l =
+        if go_deeper then
+          let res_att =
+            List.fold_left
+              (fun acc -> fun att -> acc @ (search_attribute att v))
+              []
+              (Odoc_class.class_attributes c)
+          in
+          let res_met =
+            List.fold_left
+              (fun acc -> fun m -> acc @ (search_method m v))
+              []
+              (Odoc_class.class_methods c)
+          in
+          let res_sec =
+            List.fold_left
+              (fun acc -> fun t -> acc @ (search_text c.cl_name t v))
+              []
+              (Odoc_class.class_comments c)
+          in
+          res_att @ res_met @ res_sec
+        else
+          []
+      in
+      if ok then
+        (Res_class c) :: l
+      else
+        l
+
+    let search_class_type ct v =
+      let (go_deeper, ok) = P.p_class_type ct v in
+      let l =
+        if go_deeper then
+          let res_att =
+            List.fold_left
+              (fun acc -> fun att -> acc @ (search_attribute att v))
+              []
+              (Odoc_class.class_type_attributes ct)
+          in
+          let res_met =
+            List.fold_left
+              (fun acc -> fun m -> acc @ (search_method m v))
+              []
+              (Odoc_class.class_type_methods ct)
+          in
+          let res_sec =
+            List.fold_left
+              (fun acc -> fun t -> acc @ (search_text ct.clt_name t v))
+              []
+              (Odoc_class.class_type_comments ct)
+          in
+          res_att @ res_met @ res_sec
+        else
+          []
+      in
+      if ok then
+        (Res_class_type ct) :: l
+      else
+        l
+
+    let rec search_module_type mt v =
+      let (go_deeper, ok) =  P.p_module_type mt v in
+      let l =
+        if go_deeper then
+          let res_val =
+            List.fold_left
+              (fun acc -> fun va -> acc @ (search_value va v))
+              []
+              (Odoc_module.module_type_values mt)
+          in
+          let res_typ =
+            List.fold_left
+              (fun acc -> fun t -> acc @ (search_type t v))
+              []
+              (Odoc_module.module_type_types mt)
+          in
+          let res_ext =
+            List.fold_left
+              (fun acc -> fun te -> acc @ (search_type_extension te v))
+              []
+              (Odoc_module.module_type_type_extensions mt)
+          in
+          let res_exc =
+            List.fold_left
+              (fun acc -> fun e -> acc @ (search_exception e v))
+              []
+              (Odoc_module.module_type_exceptions mt)
+          in
+          let res_mod = search (Odoc_module.module_type_modules mt) v in
+          let res_modtyp =
+            List.fold_left
+              (fun acc -> fun mt -> acc @ (search_module_type mt v))
+              []
+              (Odoc_module.module_type_module_types mt)
+          in
+          let res_cl =
+            List.fold_left
+              (fun acc -> fun cl -> acc @ (search_class cl v))
+              []
+              (Odoc_module.module_type_classes mt)
+          in
+          let res_cltyp =
+            List.fold_left
+              (fun acc -> fun clt -> acc @ (search_class_type clt v))
+              []
+              (Odoc_module.module_type_class_types mt)
+          in
+          let res_sec =
+            List.fold_left
+              (fun acc -> fun t -> acc @ (search_text mt.mt_name t v))
+              []
+              (Odoc_module.module_type_comments mt)
+          in
+          res_val @ res_typ @ res_ext @ res_exc @ res_mod @
+            res_modtyp @ res_cl @ res_cltyp @ res_sec
+        else
+          []
+      in
+      if ok then
+        (Res_module_type mt) :: l
+      else
+        l
+
+    and search_module m v =
+      let (go_deeper, ok) =  P.p_module m v in
+      let l =
+        if go_deeper then
+          let res_val =
+            List.fold_left
+              (fun acc -> fun va -> acc @ (search_value va v))
+              []
+              (Odoc_module.module_values m)
+          in
+          let res_typ =
+            List.fold_left
+              (fun acc -> fun t -> acc @ (search_type t v))
+              []
+              (Odoc_module.module_types m)
+          in
+          let res_ext =
+            List.fold_left
+              (fun acc -> fun te -> acc @ (search_type_extension te v))
+              []
+              (Odoc_module.module_type_extensions m)
+          in
+          let res_exc =
+            List.fold_left
+              (fun acc -> fun e -> acc @ (search_exception e v))
+              []
+              (Odoc_module.module_exceptions m)
+          in
+          let res_mod = search (Odoc_module.module_modules m) v in
+          let res_modtyp =
+            List.fold_left
+              (fun acc -> fun mt -> acc @ (search_module_type mt v))
+              []
+              (Odoc_module.module_module_types m)
+          in
+          let res_cl =
+            List.fold_left
+              (fun acc -> fun cl -> acc @ (search_class cl v))
+              []
+              (Odoc_module.module_classes m)
+          in
+          let res_cltyp =
+            List.fold_left
+              (fun acc -> fun clt -> acc @ (search_class_type clt v))
+              []
+              (Odoc_module.module_class_types m)
+          in
+          let res_sec =
+            List.fold_left
+              (fun acc -> fun t -> acc @ (search_text m.m_name t v))
+              []
+              (Odoc_module.module_comments m)
+          in
+          res_val @ res_typ @ res_ext @ res_exc @ res_mod @
+            res_modtyp @ res_cl @ res_cltyp @ res_sec
+        else
+          []
+      in
+      if ok then
+        (Res_module m) :: l
+      else
+        l
+
+    and search module_list v =
+      let results_with_duplicates =
+        List.fold_left
+          (fun rev_acc m ->
+            List.rev_append (search_module m v) rev_acc)
+          [] module_list
+        |> List.rev
+      in
+      Odoc_misc.remove_duplicates Stdlib.compare results_with_duplicates
+  end
+
+module P_name =
+  struct
+    type t = Str.regexp
+    let (=~) name regexp = Str.string_match regexp name 0
+    let p_module m r = (true, m.m_name =~ r)
+    let p_module_type mt r = (true, mt.mt_name =~ r)
+    let p_class c r = (true, c.cl_name =~ r)
+    let p_class_type ct r = (true, ct.clt_name =~ r)
+    let p_value v r = v.val_name =~ r
+    let p_recfield t f r =
+      let name = Printf.sprintf "%s.%s" t.ty_name f.rf_name in
+      name =~ r
+    let p_const t f r =
+      let name = Printf.sprintf "%s.%s" t.ty_name f.vc_name in
+      name =~ r
+    let p_type t r = (true, t.ty_name =~ r)
+    let p_extension x r = x.xt_name =~ r
+    let p_exception e r = e.ex_name =~ r
+    let p_attribute a r = a.att_value.val_name =~ r
+    let p_method m r = m.met_value.val_name =~ r
+    let p_section s r = s =~ r
+  end
+
+module Search_by_name = Search ( P_name )
+
+module P_values =
+  struct
+    type t = unit
+    let p_module _ _ = (true, false)
+    let p_module_type _ _ = (true, false)
+    let p_class _ _ = (false, false)
+    let p_class_type _ _ = (false, false)
+    let p_value _ _ = true
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
+    let p_extension _ _ = false
+    let p_exception _ _ = false
+    let p_attribute _ _ = false
+    let p_method _ _ = false
+    let p_section _ _ = false
+  end
+module Search_values = Search ( P_values )
+let values l =
+  let l_ele = Search_values.search l () in
+  let p v1 v2 = v1.val_name = v2.val_name in
+  let rec iter acc = function
+      (Res_value v) :: q -> if List.exists (p v) acc then iter acc q else iter (v :: acc) q
+    | _ :: q -> iter acc q
+    | [] -> acc
+  in
+  iter [] l_ele
+
+module P_extensions =
+  struct
+    type t = unit
+    let p_module _ _ = (true, false)
+    let p_module_type _ _ = (true, false)
+    let p_class _ _ = (false, false)
+    let p_class_type _ _ = (false, false)
+    let p_value _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
+    let p_extension _ _ = true
+    let p_exception _ _ = false
+    let p_attribute _ _ = false
+    let p_method _ _ = false
+    let p_section _ _ = false
+  end
+module Search_extensions = Search ( P_extensions )
+let extensions l =
+  let l_ele = Search_extensions.search l () in
+  let p x1 x2 = x1.xt_name = x2.xt_name in
+  let rec iter acc = function
+      (Res_extension x) :: q -> if List.exists (p x) acc then iter acc q else iter (x :: acc) q
+    | _ :: q -> iter acc q
+    | [] -> acc
+  in
+  iter [] l_ele
+
+module P_exceptions =
+  struct
+    type t = unit
+    let p_module _ _ = (true, false)
+    let p_module_type _ _ = (true, false)
+    let p_class _ _ = (false, false)
+    let p_class_type _ _ = (false, false)
+    let p_value _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
+    let p_extension _ _ = false
+    let p_exception _ _ = true
+    let p_attribute _ _ = false
+    let p_method _ _ = false
+    let p_section _ _ = false
+  end
+module Search_exceptions = Search ( P_exceptions )
+let exceptions l =
+  let l_ele = Search_exceptions.search l () in
+  let p e1 e2 = e1.ex_name = e2.ex_name in
+  let rec iter acc = function
+      (Res_exception t) :: q -> if List.exists (p t) acc then iter acc q else iter (t :: acc) q
+    | _ :: q -> iter acc q
+    | [] -> acc
+  in
+  iter [] l_ele
+
+module P_types =
+  struct
+    type t = unit
+    let p_module _ _ = (true, false)
+    let p_module_type _ _ = (true, false)
+    let p_class _ _ = (false, false)
+    let p_class_type _ _ = (false, false)
+    let p_value _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, true)
+    let p_extension _ _ = false
+    let p_exception _ _ = false
+    let p_attribute _ _ = false
+    let p_method _ _ = false
+    let p_section _ _ = false
+  end
+module Search_types = Search ( P_types )
+let types l =
+  let l_ele = Search_types.search l () in
+  let p t1 t2 = t1.ty_name = t2.ty_name in
+  let rec iter acc = function
+      (Res_type t) :: q -> if List.exists (p t) acc then iter acc q else iter (t :: acc) q
+    | _ :: q -> iter acc q
+    | [] -> acc
+  in
+  iter [] l_ele
+
+module P_attributes =
+  struct
+    type t = unit
+    let p_module _ _ = (true, false)
+    let p_module_type _ _ = (true, false)
+    let p_class _ _ = (true, false)
+    let p_class_type _ _ = (true, false)
+    let p_value _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
+    let p_extension _ _ = false
+    let p_exception _ _ = false
+    let p_attribute _ _ = true
+    let p_method _ _ = false
+    let p_section _ _ = false
+  end
+module Search_attributes = Search ( P_attributes )
+let attributes l =
+  let l_ele = Search_attributes.search l () in
+  let p a1 a2 = a1.att_value.val_name = a2.att_value.val_name in
+  let rec iter acc = function
+      (Res_attribute t) :: q -> if List.exists (p t) acc then iter acc q else iter (t :: acc) q
+    | _ :: q -> iter acc q
+    | [] -> acc
+  in
+  iter [] l_ele
+
+module P_methods =
+  struct
+    type t = unit
+    let p_module _ _ = (true, false)
+    let p_module_type _ _ = (true, false)
+    let p_class _ _ = (true, false)
+    let p_class_type _ _ = (true, false)
+    let p_value _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
+    let p_extension _ _ = false
+    let p_exception _ _ = false
+    let p_attribute _ _ = false
+    let p_method _ _ = true
+    let p_section _ _ = true
+  end
+module Search_methods = Search ( P_methods )
+let methods l =
+  let l_ele = Search_methods.search l () in
+  let p m1 m2 = m1.met_value.val_name = m2.met_value.val_name in
+  let rec iter acc = function
+      (Res_method t) :: q -> if List.exists (p t) acc then iter acc q else iter (t :: acc) q
+    | _ :: q -> iter acc q
+    | [] -> acc
+  in
+  iter [] l_ele
+
+module P_classes =
+  struct
+    type t = unit
+    let p_module _ _ = (true, false)
+    let p_module_type _ _ = (true, false)
+    let p_class _ _ = (false, true)
+    let p_class_type _ _ = (false, false)
+    let p_value _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
+    let p_extension _ _ = false
+    let p_exception _ _ = false
+    let p_attribute _ _ = false
+    let p_method _ _ = false
+    let p_section _ _ = false
+  end
+module Search_classes = Search ( P_classes )
+let classes l =
+  let l_ele = Search_classes.search l () in
+  let p c1 c2 = c1.cl_name = c2.cl_name in
+  let rec iter acc = function
+      (Res_class c) :: q -> if List.exists (p c) acc then iter acc q else iter (c :: acc) q
+    | _ :: q -> iter acc q
+    | [] -> acc
+  in
+  iter [] l_ele
+
+module P_class_types =
+  struct
+    type t = unit
+    let p_module _ _ = (true, false)
+    let p_module_type _ _ = (true, false)
+    let p_class _ _ = (false, false)
+    let p_class_type _ _ = (false, true)
+    let p_value _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
+    let p_extension _ _ = false
+    let p_exception _ _ = false
+    let p_attribute _ _ = false
+    let p_method _ _ = false
+    let p_section _ _ = false
+  end
+module Search_class_types = Search ( P_class_types )
+let class_types l =
+  let l_ele = Search_class_types.search l () in
+  let p c1 c2 = c1.clt_name = c2.clt_name in
+  let rec iter acc = function
+      (Res_class_type c) :: q -> if List.exists (p c) acc then iter acc q else iter (c :: acc) q
+    | _ :: q -> iter acc q
+    | [] -> acc
+  in
+  iter [] l_ele
+
+module P_modules =
+  struct
+    type t = unit
+    let p_module _ _ = (true, true)
+    let p_module_type _ _ = (true, false)
+    let p_class _ _ = (false, false)
+    let p_class_type _ _ = (false, false)
+    let p_value _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
+    let p_extension _ _ = false
+    let p_exception _ _ = false
+    let p_attribute _ _ = false
+    let p_method _ _ = false
+    let p_section _ _ = false
+  end
+module Search_modules = Search ( P_modules )
+let modules l =
+  let l_ele = Search_modules.search l () in
+  let p m1 m2 = m1.m_name = m2.m_name in
+  let rec iter acc = function
+      (Res_module m) :: q -> if List.exists (p m) acc then iter acc q else iter (m :: acc) q
+    | _ :: q -> iter acc q
+    | [] -> acc
+  in
+  iter [] l_ele
+
+module P_module_types =
+  struct
+    type t = unit
+    let p_module _ _ = (true, false)
+    let p_module_type _ _ = (true, true)
+    let p_class _ _ = (false, false)
+    let p_class_type _ _ = (false, false)
+    let p_value _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
+    let p_extension _ _ = false
+    let p_exception _ _ = false
+    let p_attribute _ _ = false
+    let p_method _ _ = false
+    let p_section _ _ = false
+  end
+module Search_module_types = Search ( P_module_types )
+let module_types l =
+  let l_ele = Search_module_types.search l () in
+  let p m1 m2 = m1.mt_name = m2.mt_name in
+  let rec iter acc = function
+      (Res_module_type m) :: q -> if List.exists (p m) acc then iter acc q else iter (m :: acc) q
+    | _ :: q -> iter acc q
+    | [] -> acc
+  in
+  iter [] l_ele
+
+let type_exists mods regexp =
+  let l = Search_by_name.search mods regexp in
+  List.exists
+    (function
+        Res_type _ -> true
+      | _ -> false
+    )
+    l
+
+let value_exists mods regexp =
+  let l = Search_by_name.search mods regexp in
+  List.exists
+    (function
+        Res_value _ -> true
+      | _ -> false
+    )
+    l
+
+let class_exists mods regexp =
+  let l = Search_by_name.search mods regexp in
+  List.exists
+    (function
+        Res_class _ -> true
+      | _ -> false
+    )
+    l
+
+let class_type_exists mods regexp =
+  let l = Search_by_name.search mods regexp in
+  List.exists
+    (function
+        Res_class_type _ -> true
+      | _ -> false
+    )
+    l
+
+let module_exists mods regexp =
+  let l = Search_by_name.search mods regexp in
+  List.exists
+    (function
+        Res_module _ -> true
+      | _ -> false
+    )
+    l
+
+let module_type_exists mods regexp =
+  let l = Search_by_name.search mods regexp in
+  List.exists
+    (function
+        Res_module_type _ -> true
+      | _ -> false
+    )
+    l
+
+let extension_exists mods regexp =
+  let l = Search_by_name.search mods regexp in
+  List.exists
+    (function
+        Res_extension _ -> true
+      | _ -> false
+    )
+    l
+
+let exception_exists mods regexp =
+  let l = Search_by_name.search mods regexp in
+  List.exists
+    (function
+        Res_exception _ -> true
+      | _ -> false
+    )
+    l
+
+let attribute_exists mods regexp =
+  let l = Search_by_name.search mods regexp in
+  List.exists
+    (function
+        Res_attribute _ -> true
+      | _ -> false
+    )
+    l
+
+let method_exists mods regexp =
+  let l = Search_by_name.search mods regexp in
+  List.exists
+    (function
+        Res_method _ -> true
+      | _ -> false
+    )
+    l
+
+let find_section mods regexp =
+  let l = Search_by_name.search mods regexp in
+  match
+    List.find
+      (function
+          Res_section _ -> true
+        | _ -> false
+      )
+      l
+  with
+    Res_section (_,t) -> t
+  | _ -> assert false
diff --git a/ocamldoc/odoc_search.mli b/ocamldoc/odoc_search.mli
new file mode 100644
index 00000000..a4681c60
--- /dev/null
+++ b/ocamldoc/odoc_search.mli
@@ -0,0 +1,242 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Research of elements through modules. *)
+
+(** The type for an element of the result of a research. *)
+type result_element =
+    Res_module of Odoc_module.t_module
+  | Res_module_type of Odoc_module.t_module_type
+  | Res_class of Odoc_class.t_class
+  | Res_class_type of Odoc_class.t_class_type
+  | Res_value of Odoc_value.t_value
+  | Res_type of Odoc_type.t_type
+  | Res_extension of Odoc_extension.t_extension_constructor
+  | Res_exception of Odoc_exception.t_exception
+  | Res_attribute of Odoc_value.t_attribute
+  | Res_method of Odoc_value.t_method
+  | Res_section of string * Odoc_types.text
+  | Res_recfield of  Odoc_type.t_type * Odoc_type.record_field
+  | Res_const of  Odoc_type.t_type * Odoc_type.variant_constructor
+
+(** The type representing a research result.*)
+type result = result_element list
+
+(** The type of modules which contain the predicates used during the research.
+   Some functions return a couple of booleans ; the first indicates if we
+   must go deeper in the analysed element, the second if the element satisfies
+   the predicate.
+*)
+module type Predicates =
+  sig
+    type t
+    val p_module : Odoc_module.t_module -> t -> bool * bool
+    val p_module_type : Odoc_module.t_module_type -> t -> bool * bool
+    val p_class : Odoc_class.t_class -> t -> bool * bool
+    val p_class_type : Odoc_class.t_class_type -> t -> bool * bool
+    val p_value : Odoc_value.t_value -> t -> bool
+    val p_recfield : Odoc_type.t_type -> Odoc_type.record_field -> t -> bool
+    val p_const : Odoc_type.t_type -> Odoc_type.variant_constructor -> t -> bool
+    val p_type : Odoc_type.t_type -> t -> (bool * bool)
+    val p_extension :
+      Odoc_extension.t_extension_constructor -> t -> bool
+    val p_exception : Odoc_exception.t_exception -> t -> bool
+    val p_attribute : Odoc_value.t_attribute -> t -> bool
+    val p_method : Odoc_value.t_method -> t -> bool
+    val p_section : string -> t -> bool
+  end
+
+(** Search for elements verifying the predicates in the module in parameter.*)
+module Search :
+  functor (P : Predicates) ->
+    sig
+      (** search in a section title *)
+      val search_section : Odoc_types.text -> string -> P.t -> result_element list
+
+      (** search in a value *)
+      val search_value : Odoc_value.t_value -> P.t -> result_element list
+
+      (** search in a record field *)
+      val search_recfield :
+        Odoc_type.t_type -> Odoc_type.record_field -> P.t -> result_element list
+
+      (** search in a variant constructor *)
+      val search_const :
+        Odoc_type.t_type -> Odoc_type.variant_constructor -> P.t -> result_element list
+
+      (** search in a type *)
+      val search_type : Odoc_type.t_type -> P.t -> result_element list
+
+      (** search in an extension constructor *)
+      val search_extension_constructor :
+          Odoc_extension.t_extension_constructor -> P.t -> result_element list
+
+      (** search in a type extension *)
+      val search_type_extension :
+          Odoc_extension.t_type_extension -> P.t -> result_element list
+
+      (** search in an exception *)
+      val search_exception :
+          Odoc_exception.t_exception -> P.t -> result_element list
+
+      (** search in an attribute *)
+      val search_attribute :
+          Odoc_value.t_attribute -> P.t -> result_element list
+
+      (** search in a method *)
+      val search_method : Odoc_value.t_method -> P.t -> result_element list
+
+      (** search in a class *)
+      val search_class : Odoc_class.t_class -> P.t -> result_element list
+
+      (** search in a class type *)
+      val search_class_type :
+          Odoc_class.t_class_type -> P.t -> result_element list
+
+      (** search in a module type *)
+      val search_module_type :
+          Odoc_module.t_module_type -> P.t -> result_element list
+
+      (** search in a module *)
+      val search_module : Odoc_module.t_module -> P.t -> result_element list
+
+      (** search in a list of modules *)
+      val search : Odoc_module.t_module list -> P.t -> result_element list
+    end
+
+(** A module of predicates to search elements by name (and accepting regexps).*)
+module P_name :
+  sig
+    type t = Str.regexp
+    val ( =~ ) : string -> Str.regexp -> bool
+    val p_module : Odoc_module.t_module -> Str.regexp -> bool * bool
+    val p_module_type :
+      Odoc_module.t_module_type -> Str.regexp -> bool * bool
+    val p_class : Odoc_class.t_class -> Str.regexp -> bool * bool
+    val p_class_type : Odoc_class.t_class_type -> Str.regexp -> bool * bool
+    val p_value : Odoc_value.t_value -> Str.regexp -> bool
+    val p_recfield : Odoc_type.t_type -> Odoc_type.record_field -> Str.regexp -> bool
+    val p_const : Odoc_type.t_type -> Odoc_type.variant_constructor -> Str.regexp -> bool
+    val p_type : Odoc_type.t_type -> Str.regexp -> (bool * bool)
+    val p_extension :
+      Odoc_extension.t_extension_constructor -> Str.regexp -> bool
+    val p_exception : Odoc_exception.t_exception -> Str.regexp -> bool
+    val p_attribute : Odoc_value.t_attribute -> Str.regexp -> bool
+    val p_method : Odoc_value.t_method -> Str.regexp -> bool
+  end
+
+(** A module to search elements by name. *)
+module Search_by_name :
+  sig
+    val search_section : Odoc_types.text -> string -> P_name.t -> result_element list
+    val search_value : Odoc_value.t_value -> P_name.t -> result_element list
+    val search_recfield : Odoc_type.t_type -> Odoc_type.record_field -> P_name.t -> result_element list
+    val search_const : Odoc_type.t_type -> Odoc_type.variant_constructor -> P_name.t -> result_element list
+    val search_type : Odoc_type.t_type -> P_name.t -> result_element list
+    val search_extension_constructor :
+      Odoc_extension.t_extension_constructor -> P_name.t -> result_element list
+    val search_type_extension :
+      Odoc_extension.t_type_extension -> P_name.t -> result_element list
+    val search_exception :
+      Odoc_exception.t_exception -> P_name.t -> result_element list
+    val search_attribute :
+      Odoc_value.t_attribute -> P_name.t -> result_element list
+    val search_method :
+      Odoc_value.t_method -> P_name.t -> result_element list
+    val search_class : Odoc_class.t_class -> P_name.t -> result_element list
+    val search_class_type :
+      Odoc_class.t_class_type -> P_name.t -> result_element list
+    val search_module_type :
+      Odoc_module.t_module_type -> P_name.t -> result_element list
+    val search_module :
+      Odoc_module.t_module -> P_name.t -> result_element list
+    val search : Odoc_module.t_module list -> P_name.t -> result_element list
+  end
+
+(** A function to search all the values in a list of modules. *)
+val values : Odoc_module.t_module list -> Odoc_value.t_value list
+
+(** A function to search all the extension constructors in a list of modules. *)
+val extensions :
+  Odoc_module.t_module list -> Odoc_extension.t_extension_constructor list
+
+(** A function to search all the exceptions in a list of modules. *)
+val exceptions : Odoc_module.t_module list -> Odoc_exception.t_exception list
+
+(** A function to search all the types in a list of modules. *)
+val types : Odoc_module.t_module list -> Odoc_type.t_type list
+
+(** A function to search all the class attributes in a list of modules. *)
+val attributes : Odoc_module.t_module list -> Odoc_value.t_attribute list
+
+(** A function to search all the class methods in a list of modules. *)
+val methods : Odoc_module.t_module list -> Odoc_value.t_method list
+
+(** A function to search all the classes in a list of modules. *)
+val classes : Odoc_module.t_module list -> Odoc_class.t_class list
+
+(** A function to search all the class types in a list of modules. *)
+val class_types : Odoc_module.t_module list -> Odoc_class.t_class_type list
+
+(** A function to search all the modules in a list of modules. *)
+val modules : Odoc_module.t_module list -> Odoc_module.t_module list
+
+(** A function to search all the module types in a list of modules. *)
+val module_types : Odoc_module.t_module list -> Odoc_module.t_module_type list
+
+(** Return [true] if a type with the given complete name (regexp) exists
+   in the given module list.*)
+val type_exists : Odoc_module.t_module list -> Str.regexp -> bool
+
+(** Return [true] if a value with the given complete name (regexp) exists
+   in the given module list.*)
+val value_exists : Odoc_module.t_module list -> Str.regexp -> bool
+
+(** Return [true] if a module with the given complete name (regexp) exists
+   in the given module list.*)
+val module_exists : Odoc_module.t_module list -> Str.regexp -> bool
+
+(** Return [true] if a module type with the given complete name (regexp) exists
+   in the given module list.*)
+val module_type_exists : Odoc_module.t_module list -> Str.regexp -> bool
+
+(** Return [true] if a class with the given complete name (regexp) exists
+   in the given module list.*)
+val class_exists : Odoc_module.t_module list -> Str.regexp -> bool
+
+(** Return [true] if a class type  with the given complete name (regexp) exists
+   in the given module list.*)
+val class_type_exists : Odoc_module.t_module list -> Str.regexp -> bool
+
+(** Return [true] if an extension with the given complete name (regexp) exists
+   in the given module list.*)
+val extension_exists : Odoc_module.t_module list -> Str.regexp -> bool
+
+(** Return [true] if a exception with the given complete name (regexp) exists
+   in the given module list.*)
+val exception_exists : Odoc_module.t_module list -> Str.regexp -> bool
+
+(** Return [true] if an attribute with the given complete name (regexp) exists
+   in the given module list.*)
+val attribute_exists : Odoc_module.t_module list -> Str.regexp -> bool
+
+(** Return [true] if a method with the given complete name (regexp) exists
+   in the given module list.*)
+val method_exists : Odoc_module.t_module list -> Str.regexp -> bool
+
+(** Return the [text] of the section with the given complete name (regexp)
+   in the given module list.
+   @raise Not_found if the section was not found.*)
+val find_section : Odoc_module.t_module list -> Str.regexp -> Odoc_types.text
diff --git a/ocamldoc/odoc_see_lexer.mll b/ocamldoc/odoc_see_lexer.mll
new file mode 100644
index 00000000..1962d50d
--- /dev/null
+++ b/ocamldoc/odoc_see_lexer.mll
@@ -0,0 +1,103 @@
+{
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let print_DEBUG2 s = print_string s ; print_newline ()
+
+(** the lexer for special comments. *)
+
+open Odoc_parser
+
+let buf = Buffer.create 32
+
+}
+
+rule main = parse
+  [' ' '\013' '\009' '\012'] +
+  {
+    print_DEBUG2 "[' ' '\013' '\009' '\012'] +";
+    main lexbuf
+  }
+
+  | [ '\010' ]
+      {
+        print_DEBUG2 " [ '\010' ] ";
+        main lexbuf
+      }
+
+  | "<"
+      {
+        print_DEBUG2 "call url lexbuf" ;
+        url lexbuf
+      }
+
+  | "\""
+      {
+        print_DEBUG2 "call doc lexbuf" ;
+        doc lexbuf
+      }
+
+
+  | '\''
+      {
+        print_DEBUG2 "call file lexbuf" ;
+        file lexbuf
+      }
+
+  | eof
+      {
+        print_DEBUG2 "EOF";
+        EOF
+      }
+
+  | _
+      {
+        Buffer.reset buf ;
+        Buffer.add_string buf (Lexing.lexeme lexbuf);
+        desc lexbuf
+      }
+
+and url = parse
+  | ([^'>'] | '\n')+">"
+      {
+        let s = Lexing.lexeme lexbuf in
+        print_DEBUG2 ("([^'>'] | '\n')+ \">\" with "^s) ;
+        See_url (String.sub s 0 ((String.length s) -1))
+      }
+
+
+and doc = parse
+  | ([^'"'] | '\n' | "\\'")* "\""
+      {
+        let s = Lexing.lexeme lexbuf in
+        See_doc (String.sub s 0 ((String.length s) -1))
+      }
+
+and file = parse
+  | ([^'\''] | '\n' | "\\\"")* "'"
+      {
+        let s = Lexing.lexeme lexbuf in
+        See_file (String.sub s 0 ((String.length s) -1))
+      }
+
+
+and desc = parse
+    eof
+      { Desc (Buffer.contents buf) }
+  | _
+      {
+        Buffer.add_string buf (Lexing.lexeme lexbuf);
+        desc lexbuf
+      }
diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml
new file mode 100644
index 00000000..e7cb90ab
--- /dev/null
+++ b/ocamldoc/odoc_sig.ml
@@ -0,0 +1,1880 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Analysis of interface files. *)
+
+open Asttypes
+open Types
+
+let print_DEBUG s = print_string s ; print_newline ();;
+
+open Odoc_parameter
+open Odoc_value
+open Odoc_type
+open Odoc_extension
+open Odoc_exception
+open Odoc_class
+open Odoc_module
+open Odoc_types
+
+module Signature_search =
+  struct
+    type ele =
+      | M of string
+      | MT of string
+      | V of string
+      | T of string
+      | C of string
+      | CT of string
+      | X of string
+
+    type tab = (ele, Types.signature_item) Hashtbl.t
+
+    let add_to_hash table signat =
+      match signat with
+        Types.Sig_value (ident, _, _) ->
+          Hashtbl.add table (V (Name.from_ident ident)) signat
+      | Types.Sig_typext (ident, _, _, _) ->
+          Hashtbl.add table (X (Name.from_ident ident)) signat
+      | Types.Sig_type (ident, _, _, _) ->
+          Hashtbl.add table (T (Name.from_ident ident)) signat
+      | Types.Sig_class (ident, _, _, _) ->
+          Hashtbl.add table (C (Name.from_ident ident)) signat
+      | Types.Sig_class_type (ident, _, _, _) ->
+          Hashtbl.add table (CT (Name.from_ident ident)) signat
+      | Types.Sig_module (ident, _, _, _, _) ->
+          Hashtbl.add table (M (Name.from_ident ident)) signat
+      | Types.Sig_modtype (ident,_,_) ->
+          Hashtbl.add table (MT (Name.from_ident ident)) signat
+
+    let table signat =
+      let t = Hashtbl.create 13 in
+      List.iter (add_to_hash t) signat;
+      t
+
+    let search_value table name =
+      match Hashtbl.find table (V name) with
+      | (Types.Sig_value (_, val_desc, _)) ->  val_desc.Types.val_type
+      | _ -> assert false
+
+    let search_extension table name =
+      match Hashtbl.find table (X name) with
+      | (Types.Sig_typext (_, ext, _, _)) -> ext
+      | _ -> assert false
+
+    let search_type table name =
+      match Hashtbl.find table (T name) with
+      | (Types.Sig_type (_, type_decl, _, _)) -> type_decl
+      | _ -> assert false
+
+    let search_class table name =
+      match Hashtbl.find table (C name) with
+      | (Types.Sig_class (_, class_decl, _, _)) -> class_decl
+      | _ -> assert false
+
+    let search_class_type table name =
+      match Hashtbl.find table (CT name) with
+      | (Types.Sig_class_type (_, cltype_decl, _, _)) -> cltype_decl
+      | _ -> assert false
+
+    let search_module table name =
+      match Hashtbl.find table (M name) with
+      | (Types.Sig_module (_ident, _, md, _, _)) -> md.Types.md_type
+      | _ -> assert false
+
+    let search_module_type table name =
+      match Hashtbl.find table (MT name) with
+      | (Types.Sig_modtype (_, {Types.mtd_type = Some module_type}, _)) ->
+          Some module_type
+      | (Types.Sig_modtype (_, {Types.mtd_type = None}, _)) ->
+          None
+      | _ -> assert false
+
+    let search_attribute_type name class_sig =
+      let (_, _, type_expr) = Types.Vars.find name class_sig.Types.csig_vars in
+      type_expr
+
+    let search_method_type name class_sig =
+      let fields = Odoc_misc.get_fields class_sig.Types.csig_self in
+      List.assoc name fields
+  end
+
+module type Info_retriever =
+  sig
+    val all_special : string -> string -> int * (Odoc_types.info list)
+    val blank_line_outside_simple : string -> string -> bool
+    val just_after_special : string -> string -> (int * Odoc_types.info option)
+    val first_special : string -> string -> (int * Odoc_types.info option)
+    val get_comments :
+        (Odoc_types.text -> 'a) -> string -> string -> (Odoc_types.info option * 'a list)
+  end
+
+module Analyser =
+  functor (My_ir : Info_retriever) ->
+  struct
+    (** This variable is used to load a file as a string and retrieve characters from it.*)
+    let file = ref ""
+
+    (** The name of the analysed file. *)
+    let file_name = ref ""
+
+    (** This function takes two indexes (start and end) and returns the string
+       corresponding to the indexes in the file global variable. The function
+       prepare_file must have been called to fill the file global variable.*)
+    let get_string_of_file the_start the_end =
+      try
+        String.sub !file the_start (the_end-the_start)
+      with
+        Invalid_argument _ ->
+          ""
+
+    let just_after_special start stop =
+      let s = get_string_of_file start stop in
+      My_ir.just_after_special !file_name s
+
+    (** Helper functions for extracting location*)
+    module Loc = struct
+      let gen proj =
+        (fun ct -> (proj ct).Location.loc_start.Lexing.pos_cnum),
+        (fun ct -> (proj ct).Location.loc_end.Lexing.pos_cnum)
+    let ptyp' ct = ct.Parsetree.ptyp_loc
+    let pcd' pcd = pcd.Parsetree.pcd_loc
+    let loc' loc = loc
+    let psig' p = p.Parsetree.psig_loc
+
+    let start, end_ = gen loc'
+    let ptyp_start, ptyp_end = gen ptyp'
+    let pcd_start, pcd_end = gen pcd'
+    let psig_start, psig_end = gen psig'
+    end
+
+    (** This function loads the given file in the file global variable,
+       and sets file_name.*)
+    let prepare_file f input_f =
+      try
+        let s = Odoc_misc.input_file_as_string input_f in
+        file := s;
+        file_name := f
+      with
+        e ->
+          file := "";
+          raise e
+
+    (** The function used to get the comments in a class. *)
+    let get_comments_in_class pos_start pos_end =
+      My_ir.get_comments (fun t -> Class_comment t)
+        !file_name
+        (get_string_of_file pos_start pos_end)
+
+    (** The function used to get the comments in a module. *)
+    let get_comments_in_module pos_start pos_end =
+      My_ir.get_comments (fun t -> Element_module_comment t)
+        !file_name
+        (get_string_of_file pos_start pos_end)
+
+    let preamble filename file proj ast =
+      let info = My_ir.first_special filename file in
+      (* Only use as module preamble documentation comments that occur before
+           any module elements *)
+      match ast with
+      | a :: _ when  Loc.start (proj a) < fst info -> (0,None)
+      | _ -> info
+
+    let merge_infos = Odoc_merge.merge_info_opt Odoc_types.all_merge_options
+
+    (** Module for extracting documentation comments for record from different
+        tree types *)
+    module Record = struct
+
+      (** A structure to abstract over the tree type *)
+      type ('a,'b,'c) projector = {
+        name:'a -> string;
+        inline_record: 'b -> 'c option;
+        inline_end: 'b -> int;
+        start:'a -> int;
+        end_: 'a -> int }
+
+    (** A function to extract documentation from a list of label declarations *)
+    let doc p pos_end ld =
+      let rec f = function
+        | [] -> []
+        | ld :: [] ->
+            let name = p.name ld in
+            let pos = p.end_ ld in
+            let (_,comment_opt) =  just_after_special pos pos_end in
+            [name, comment_opt]
+        | ld  :: ele2 :: q ->
+            let pos = p.end_ ld in
+            let pos2 = p.start ele2 in
+            let name = p.name ld in
+            let (_,comment_opt) = just_after_special pos pos2 in
+            (name, comment_opt) :: (f (ele2 :: q))
+      in
+      f ld
+
+    let inline_doc p cstr =
+      match p.inline_record cstr with
+      | None -> []
+      | Some r ->
+          doc p (p.inline_end cstr) r
+
+    (** The three tree types used in the rest of the source: *)
+
+    let parsetree =
+      let open Parsetree in
+      { name = (fun ld -> ld.pld_name.txt );
+        start = (fun ld -> Loc.ptyp_start ld.pld_type);
+        end_ =  (fun ld -> Loc.ptyp_end ld.pld_type);
+        inline_record = begin
+          fun c -> match c.pcd_args with
+            | Pcstr_tuple _ -> None
+            | Pcstr_record r -> Some r
+        end;
+        inline_end = (fun c -> Loc.end_ c.pcd_loc)
+      }
+
+    let types =
+      let open Types in
+      { name = (fun ld -> Ident.name ld.ld_id );
+        start = (fun ld -> Loc.start ld.ld_loc);
+        end_ =  (fun ld -> Loc.start ld.ld_loc);
+        (* Beware, Loc.start is correct in the code above:
+           type_expr's do not hold location information, and ld.ld_loc
+           ends after the documentation comment, so we use Loc.start as
+           the least problematic approximation for end_. *)
+        inline_record = begin
+          fun c -> match c.cd_args with
+            | Cstr_tuple _ -> None
+            | Cstr_record r -> Some r
+        end;
+        inline_end = (fun c -> Loc.end_ c.cd_loc)
+      }
+
+    let typedtree =
+      let open Typedtree in
+      { name = (fun ld -> Ident.name ld.ld_id );
+        start = (fun ld -> Loc.start ld.ld_type.ctyp_loc);
+        end_ =  (fun ld -> Loc.end_ ld.ld_type.ctyp_loc);
+        inline_record = begin
+          fun c -> match c.cd_args with
+            | Cstr_tuple _ -> None
+            | Cstr_record r -> Some r
+        end;
+        inline_end = (fun c -> Loc.end_ c.cd_loc)
+      }
+
+
+    end
+
+    let name_comment_from_type_decl pos_end pos_limit ty_decl =
+      match ty_decl.Parsetree.ptype_kind with
+      | Parsetree.Ptype_abstract ->
+        let open Parsetree in
+        begin match ty_decl.ptype_manifest with
+        | None -> (0, [])
+        | Some core_ty ->
+          begin match core_ty.ptyp_desc with
+          | Ptyp_object (fields, _) ->
+            let fields = List.map (fun {pof_desc; _} -> pof_desc) fields in
+            let rec f = function
+              | [] -> []
+              | Otag ({txt=""},_) :: _ ->
+                (* Fields with no name have been eliminated previously. *)
+                assert false
+              | Otag ({txt=name}, ct) :: [] ->
+                let pos = Loc.ptyp_end ct in
+                let (_,comment_opt) = just_after_special pos pos_end in
+                [name, comment_opt]
+              | Otag ({txt=name}, ct) ::
+                  ((Oinherit ct2 | Otag (_, ct2)) as ele2) :: q ->
+                let pos = Loc.ptyp_end ct in
+                let pos2 = Loc.ptyp_start ct2 in
+                let (_,comment_opt) = just_after_special pos pos2 in
+                (name, comment_opt) :: (f (ele2 :: q))
+              | _ :: q -> f q
+            in
+            let is_named_field field =
+              match field with
+              | Otag ({txt=""},_) -> false
+              | _ -> true
+            in
+            (0, f @@ List.filter is_named_field fields)
+
+          | _ -> (0, [])
+          end
+        end
+
+      | Parsetree.Ptype_variant cons_core_type_list_list ->
+          let rec f acc cons_core_type_list_list =
+            let open Parsetree in
+            match cons_core_type_list_list with
+              [] ->
+                (0, acc)
+            | pcd :: [] ->
+                let acc = Record.(inline_doc parsetree) pcd @ acc in
+                let (len, comment_opt) =
+                  just_after_special (Loc.pcd_end pcd) pos_limit in
+                (len, List.rev @@ (pcd.pcd_name.txt, comment_opt):: acc )
+            | pcd :: (pcd2 :: _ as q) ->
+                let acc = Record.(inline_doc parsetree) pcd @ acc in
+                let pos_end_first = Loc.pcd_end pcd in
+                let pos_start_second = Loc.pcd_start pcd2 in
+                let (_,comment_opt) =
+                  just_after_special pos_end_first pos_start_second in
+                f ((pcd.pcd_name.txt, comment_opt)::acc) q
+          in
+          f [] cons_core_type_list_list
+
+      | Parsetree.Ptype_record label_declaration_list ->
+          (0, Record.(doc parsetree) pos_end label_declaration_list)
+      | Parsetree.Ptype_open ->
+          (0, [])
+
+
+    let manifest_structure env name_comment_list type_expr =
+      match type_expr.desc with
+      | Tobject (fields, _) ->
+        let f (field_name, _, type_expr) =
+          let comment_opt =
+            try List.assoc field_name name_comment_list
+            with Not_found -> None
+          in {
+            of_name = field_name ;
+            of_type = Odoc_env.subst_type env type_expr ;
+            of_text = comment_opt ;
+          }
+        in
+        Object_type (List.map f @@ fst @@ Ctype.flatten_fields fields)
+      | _ -> Other (Odoc_env.subst_type env type_expr)
+
+    let get_field env name_comment_list {Types.ld_id=field_name;ld_mutable=mutable_flag;ld_type=type_expr} =
+      let field_name = Ident.name field_name in
+      let comment_opt =
+        try List.assoc field_name name_comment_list
+        with Not_found -> None
+      in
+      {
+        rf_name = field_name ;
+        rf_mutable = mutable_flag = Mutable ;
+        rf_type = Odoc_env.subst_type env type_expr ;
+        rf_text = comment_opt
+      }
+
+    let get_type_kind env name_comment_list type_kind =
+      match type_kind with
+        Types.Type_abstract ->
+          Odoc_type.Type_abstract
+      | Types.Type_variant l ->
+          let f {Types.cd_id=constructor_name;cd_args;cd_res=ret_type} =
+            let constructor_name = Ident.name constructor_name in
+            let comment_opt =
+              try match List.assoc constructor_name name_comment_list with
+                | Some { i_desc = None | Some []; _ } -> None
+                | x -> x
+              with Not_found -> None
+            in
+            let vc_args =
+              match cd_args with
+              | Cstr_tuple l -> Cstr_tuple (List.map (Odoc_env.subst_type env) l)
+              | Cstr_record l ->
+                  Cstr_record (List.map (get_field env name_comment_list) l)
+            in
+            {
+              vc_name = constructor_name ;
+              vc_args;
+              vc_ret =  Option.map (Odoc_env.subst_type env) ret_type;
+              vc_text = comment_opt
+            }
+          in
+          Odoc_type.Type_variant (List.map f l)
+
+      | Types.Type_record (l, _) ->
+          Odoc_type.Type_record (List.map (get_field env name_comment_list) l)
+
+      | Types.Type_open ->
+          Odoc_type.Type_open
+
+
+    let get_cstr_args env pos_end =
+      let tuple ct = Odoc_env.subst_type env ct.Typedtree.ctyp_type in
+      let record comments
+          { Typedtree.ld_id; ld_mutable; ld_type; ld_loc; ld_attributes } =
+        get_field env comments @@
+        {Types.ld_id; ld_mutable; ld_type=ld_type.Typedtree.ctyp_type;
+         ld_loc; ld_attributes; ld_uid=Types.Uid.internal_not_actually_unique} in
+      let open Typedtree in
+      function
+      | Cstr_tuple l ->
+          Odoc_type.Cstr_tuple (List.map tuple l)
+      | Cstr_record l ->
+          let comments = Record.(doc typedtree) pos_end l in
+          Odoc_type.Cstr_record (List.map (record comments) l)
+
+    (* Given a constraint "with type M.N.t := foo", this function adds "M" ->
+       "with type N.t := foo" to acc, ie it build the constraint to put on the
+       first element of the path being modified.
+       When filter_out_erased_items_from_signature finds "M", it applies the
+       constraint on its module type. *)
+    let constraint_for_subitem =
+      let split_longident p =
+        match Longident.flatten p with
+        | [] -> assert false
+        | hd :: tl -> hd, Longident.unflatten tl
+      in
+      fun acc s rebuild_constraint ->
+        match split_longident s.txt with
+        | hd, None -> Name.Map.add hd `Removed acc
+        | hd, Some p ->
+           let constraint_ = rebuild_constraint { s with txt = p } in
+           match Name.Map.find hd acc with
+           | exception Not_found ->
+              Name.Map.add hd (`Constrained [constraint_]) acc
+           | `Constrained old ->
+              Name.Map.add hd (`Constrained (constraint_ :: old)) acc
+           | `Removed -> acc
+
+    let erased_names_of_constraints constraints acc =
+      List.fold_right (fun constraint_ acc ->
+        match constraint_ with
+        | Parsetree.Pwith_type _ | Parsetree.Pwith_module _ -> acc
+        | Parsetree.Pwith_typesubst (s, typedecl) ->
+           constraint_for_subitem acc s (fun s -> Parsetree.Pwith_typesubst (s, typedecl))
+        | Parsetree.Pwith_modsubst (s, modpath) ->
+           constraint_for_subitem acc s (fun s -> Parsetree.Pwith_modsubst (s, modpath)))
+        constraints acc
+
+    let is_erased ident map =
+      match Name.Map.find ident map with
+      | exception Not_found -> false
+      | `Removed -> true
+      | `Constrained _ -> false
+
+    let apply_constraint module_type constraints  =
+      match module_type.Parsetree.pmty_desc with
+      | Parsetree.Pmty_alias _ -> module_type
+      | _ ->
+         { Parsetree.
+           pmty_desc = Parsetree.Pmty_with (module_type, List.rev constraints);
+           pmty_loc = module_type.Parsetree.pmty_loc;
+           pmty_attributes = []
+         }
+
+    let filter_out_erased_items_from_signature erased signature =
+      if Name.Map.is_empty erased then signature
+      else List.fold_right (fun sig_item acc ->
+        let take_item psig_desc = { sig_item with Parsetree.psig_desc } :: acc in
+        match sig_item.Parsetree.psig_desc with
+        | Parsetree.Psig_attribute _
+        | Parsetree.Psig_extension _
+        | Parsetree.Psig_value _
+        | Parsetree.Psig_typext _
+        | Parsetree.Psig_exception _
+        | Parsetree.Psig_open _
+        | Parsetree.Psig_include _
+        | Parsetree.Psig_class _
+        | Parsetree.Psig_class_type _ as tp -> take_item tp
+        | Parsetree.Psig_typesubst _ -> acc
+        | Parsetree.Psig_type (rf, types) ->
+          (match List.filter (fun td -> not (is_erased td.Parsetree.ptype_name.txt erased)) types with
+          | [] -> acc
+          | types -> take_item (Parsetree.Psig_type (rf, types)))
+        | Parsetree.Psig_modsubst _ -> acc
+        | Parsetree.Psig_module {Parsetree.pmd_name={ txt = None }} -> acc
+        | Parsetree.Psig_module ({Parsetree.pmd_name={txt = Some name };
+                                             pmd_type=module_type} as r)
+          as m ->
+           begin match Name.Map.find name erased with
+           | exception Not_found -> take_item m
+           | `Removed -> acc
+           | `Constrained constraints ->
+              take_item
+                (Parsetree.Psig_module
+                   { r with
+                     Parsetree.pmd_type =
+                       apply_constraint module_type constraints })
+           end
+        | Parsetree.Psig_modtype {Parsetree.pmtd_name=name} as m ->
+          if is_erased name.txt erased then acc else take_item m
+        | Parsetree.Psig_recmodule mods ->
+          (match List.filter
+                   (fun pmd ->
+                      match pmd.Parsetree.pmd_name.txt with
+                      | None -> false
+                      | Some name -> not (is_erased name erased))
+                   mods
+           with
+           | [] -> acc
+           | mods -> take_item (Parsetree.Psig_recmodule mods)))
+        signature []
+
+    (** Analysis of the elements of a class, from the information in the parsetree and in the class
+       signature. @return the couple (inherited_class list, elements).*)
+    let analyse_class_elements env current_class_name last_pos pos_limit
+        class_type_field_list class_signature =
+      let get_pos_limit2 q =
+        match q with
+          [] -> pos_limit
+          | ele2 :: _ ->
+              let loc = ele2.Parsetree.pctf_loc in
+            match ele2.Parsetree.pctf_desc with
+              Parsetree.Pctf_val (_, _, _, _)
+            | Parsetree.Pctf_method (_, _, _, _)
+            | Parsetree.Pctf_constraint (_, _)
+            | Parsetree.Pctf_attribute _ -> Loc.start loc
+            | Parsetree.Pctf_inherit class_type ->
+                Loc.start class_type.Parsetree.pcty_loc
+            | Parsetree.Pctf_extension _ -> assert false
+      in
+      let get_method name comment_opt private_flag loc q =
+        let complete_name = Name.concat current_class_name name in
+        let typ =
+          try Signature_search.search_method_type name class_signature
+          with Not_found ->
+            raise (Failure (Odoc_messages.method_type_not_found current_class_name name))
+        in
+        let subst_typ = Odoc_env.subst_type env typ in
+        let met =
+          {
+            met_value =
+            {
+              val_name = complete_name ;
+              val_info = comment_opt ;
+              val_type = subst_typ ;
+              val_recursive = false ;
+              val_parameters = Odoc_value.dummy_parameter_list subst_typ ;
+              val_code = None ;
+              val_loc = { loc_impl = None ; loc_inter = Some loc };
+            } ;
+            met_private = private_flag = Asttypes.Private ;
+            met_virtual = false ;
+          }
+        in
+        let pos_limit2 = get_pos_limit2 q in
+        let pos_end = Loc.end_ loc in
+        let (maybe_more, info_after_opt) =
+          My_ir.just_after_special
+            !file_name
+            (get_string_of_file pos_end pos_limit2)
+        in
+        met.met_value.val_info <- merge_infos met.met_value.val_info info_after_opt ;
+        (* update the parameter description *)
+        Odoc_value.update_value_parameters_text met.met_value;
+        (met, maybe_more)
+      in
+      let rec f last_pos class_type_field_list =
+        match class_type_field_list with
+          [] ->
+            let s = get_string_of_file last_pos pos_limit in
+            let (_, ele_coms) = My_ir.all_special !file_name s in
+            let ele_comments =
+              List.fold_left
+                (fun acc -> fun sc ->
+                  match sc.Odoc_types.i_desc with
+                    None ->
+                      acc
+                  | Some t ->
+                      acc @ [Class_comment t])
+                []
+                ele_coms
+            in
+            ([], ele_comments)
+
+          | item :: q ->
+              let loc = item.Parsetree.pctf_loc in
+              match item.Parsetree.pctf_desc with
+
+        | Parsetree.Pctf_val ({txt=name}, mutable_flag, virtual_flag, _) ->
+            (* of (string * mutable_flag * core_type option * Location.t)*)
+            let (comment_opt, eles_comments) = get_comments_in_class last_pos
+                (Loc.start loc) in
+            let complete_name = Name.concat current_class_name name in
+            let typ =
+              try Signature_search.search_attribute_type name class_signature
+              with Not_found ->
+                raise (Failure (Odoc_messages.attribute_type_not_found current_class_name name))
+            in
+            let subst_typ = Odoc_env.subst_type env typ in
+            let att =
+              {
+                att_value =
+                {
+                  val_name = complete_name ;
+                  val_info = comment_opt ;
+                  val_type = subst_typ;
+                  val_recursive = false ;
+                  val_parameters = [] ;
+                  val_code = None ;
+                  val_loc = { loc_impl = None ; loc_inter = Some loc} ;
+                } ;
+                att_mutable = mutable_flag = Asttypes.Mutable ;
+                att_virtual = virtual_flag = Asttypes.Virtual ;
+              }
+            in
+            let pos_limit2 = get_pos_limit2 q in
+            let pos_end = Loc.end_ loc in
+            let (maybe_more, info_after_opt) =
+              My_ir.just_after_special
+                !file_name
+                (get_string_of_file pos_end pos_limit2)
+            in
+            att.att_value.val_info <- merge_infos att.att_value.val_info info_after_opt ;
+            let (inher_l, eles) = f (pos_end + maybe_more) q in
+            (inher_l, eles_comments @ ((Class_attribute att) :: eles))
+
+        | Parsetree.Pctf_method ({txt=name}, private_flag, virtual_flag, _) ->
+            (* of (string * private_flag * virtual_flag * core_type) *)
+            let (comment_opt, eles_comments) =
+              get_comments_in_class last_pos (Loc.start  loc) in
+            let (met, maybe_more) = get_method name comment_opt private_flag loc q in
+            let met2 =
+              match virtual_flag with
+              | Concrete -> met
+              | Virtual -> { met with met_virtual = true }
+            in
+            let (inher_l, eles) = f (Loc.end_ loc + maybe_more) q in
+            (inher_l, eles_comments @ ((Class_method met2) :: eles))
+
+        | (Parsetree.Pctf_constraint (_, _)) ->
+            (* of (core_type * core_type) *)
+            (* FIXME: this corresponds to constraints, isn't it? We don't keep them for now *)
+            let (_comment_opt, eles_comments) = get_comments_in_class last_pos
+                (Loc.start loc) in
+            let (inher_l, eles) = f (Loc.end_ loc) q in
+            (inher_l, eles_comments @ eles)
+
+        | Parsetree.Pctf_inherit class_type ->
+            let loc = class_type.Parsetree.pcty_loc in
+            let (comment_opt, eles_comments) =
+              get_comments_in_class last_pos (Loc.start loc) in
+            let pos_limit2 = get_pos_limit2 q in
+            let pos_end = Loc.end_ loc in
+            let (maybe_more, info_after_opt) =
+             just_after_special pos_end pos_limit2
+            in
+            let comment_opt2 = merge_infos comment_opt info_after_opt in
+            let text_opt = match comment_opt2 with None -> None | Some i -> i.Odoc_types.i_desc in
+            let inh  =
+              match class_type.Parsetree.pcty_desc with
+                Parsetree.Pcty_constr (longident, _) ->
+                  (*of Longident.t * core_type list*)
+                  let name = Name.from_longident longident.txt in
+                  {
+                    ic_name = Odoc_env.full_class_or_class_type_name env name ;
+                    ic_class = None ;
+                    ic_text = text_opt ;
+                  }
+
+              | Parsetree.Pcty_open _ (* one could also traverse the open *)
+              | Parsetree.Pcty_signature _
+              | Parsetree.Pcty_arrow _ ->
+                    (* we don't have a name for the class signature, so we call it "object ... end"  *)
+                  {
+                    ic_name = Odoc_messages.object_end ;
+                    ic_class = None ;
+                    ic_text = text_opt ;
+                  }
+              | Parsetree.Pcty_extension _ -> assert false
+            in
+            let (inher_l, eles) = f (pos_end + maybe_more) q in
+            (inh :: inher_l , eles_comments @ eles)
+        | Parsetree.Pctf_attribute _ ->
+            let (_comment_opt, eles_comments) =
+              get_comments_in_class last_pos (Loc.start loc) in
+            let (inher_l, eles) = f (Loc.end_ loc) q in
+            (inher_l, eles_comments @ eles)
+
+        | Parsetree.Pctf_extension _ -> assert false
+      in
+      f last_pos class_type_field_list
+
+    (** Analyse of a .mli parse tree, to get the corresponding elements.
+       last_pos is the position of the first character which may be used to look for special comments.
+    *)
+    let rec analyse_parsetree env signat current_module_name last_pos pos_limit sig_item_list =
+      let table = Signature_search.table signat in
+      (* we look for the comment of each item then analyse the item *)
+      let rec f acc_eles acc_env last_pos = function
+          [] ->
+            let s = get_string_of_file last_pos pos_limit in
+            let (_, ele_coms) = My_ir.all_special !file_name s in
+            let ele_comments =
+              List.fold_left
+                (fun acc -> fun sc ->
+                  match sc.Odoc_types.i_desc with
+                    None ->
+                      acc
+                  | Some t ->
+                      acc @ [Element_module_comment t])
+                []
+                ele_coms
+            in
+            acc_eles @ ele_comments
+
+        | ele :: q ->
+            let (assoc_com, ele_comments) =
+              get_comments_in_module last_pos (Loc.psig_start ele)
+            in
+            let (maybe_more, new_env, elements) = analyse_signature_item_desc
+                acc_env
+                signat
+                table
+                current_module_name
+                ele.Parsetree.psig_loc
+                (Loc.psig_start ele)
+                (Loc.psig_end ele)
+                (match q with
+                  [] -> pos_limit
+                | ele2 :: _ -> Loc.psig_start ele2
+                )
+                assoc_com
+                ele.Parsetree.psig_desc
+            in
+            let new_pos = Loc.psig_end ele + maybe_more
+              (* for the comments of constructors in types,
+                 which are after the constructor definition and can
+                 go beyond ele.Parsetree.psig_loc.Location.loc_end.Lexing.pos_cnum *)
+            in
+            f (acc_eles @ (ele_comments @ elements))
+              new_env
+              new_pos
+              q
+      in
+      f [] env last_pos sig_item_list
+
+    (** Analyse the given signature_item_desc to create the corresponding module element
+       (with the given attached comment).*)
+    and analyse_signature_item_desc env _signat table current_module_name
+        sig_item_loc pos_start_ele pos_end_ele pos_limit comment_opt sig_item_desc =
+        match sig_item_desc with
+          Parsetree.Psig_value value_desc ->
+            let name_pre = value_desc.Parsetree.pval_name in
+            let type_expr =
+              try Signature_search.search_value table name_pre.txt
+              with Not_found ->
+                raise (Failure (Odoc_messages.value_not_found current_module_name name_pre.txt))
+            in
+            let name = Name.parens_if_infix name_pre.txt in
+            let subst_typ = Odoc_env.subst_type env type_expr in
+            let v =
+              {
+                val_name = Name.concat current_module_name name ;
+                val_info = comment_opt ;
+                val_type = subst_typ ;
+                val_recursive = false ;
+                val_parameters = Odoc_value.dummy_parameter_list subst_typ ;
+                val_code = None ;
+                val_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ;
+              }
+            in
+            let (maybe_more, info_after_opt) =
+              My_ir.just_after_special
+                !file_name
+                (get_string_of_file pos_end_ele pos_limit)
+            in
+            v.val_info <- merge_infos v.val_info info_after_opt ;
+            (* update the parameter description *)
+            Odoc_value.update_value_parameters_text v;
+
+            let new_env = Odoc_env.add_value env v.val_name in
+            (maybe_more, new_env, [ Element_value v ])
+
+        | Parsetree.Psig_typext tyext ->
+          let new_env, types_ext_list, last_ext =
+            List.fold_left
+              (fun (env_acc, exts_acc, _) -> fun {Parsetree.pext_name = { txt = name }} ->
+                let complete_name = Name.concat current_module_name name in
+                let env_acc = Odoc_env.add_extension env_acc complete_name in
+                let types_ext =
+                  try Signature_search.search_extension table name
+                  with Not_found ->
+                    raise (Failure (Odoc_messages.extension_not_found current_module_name name))
+                in
+                  env_acc, ((name, types_ext) :: exts_acc), Some types_ext
+              )
+              (env, [], None)
+              tyext.Parsetree.ptyext_constructors
+          in
+          let types_ext_list = List.rev types_ext_list in
+          let ty_path, ty_params, priv =
+            match last_ext with
+              None -> assert false
+            | Some ext -> ext.ext_type_path, ext.ext_type_params, ext.ext_private
+          in
+          let new_te =
+            {
+              te_info = comment_opt;
+              te_type_name =
+                Odoc_env.full_type_name new_env (Name.from_path ty_path);
+              te_type_parameters =
+                List.map (Odoc_env.subst_type new_env) ty_params;
+              te_private = priv;
+              te_constructors = [];
+              te_loc = { loc_impl = None ; loc_inter = Some sig_item_loc} ;
+              te_code =
+                (
+                  if !Odoc_global.keep_code then
+                    Some (get_string_of_file pos_start_ele pos_end_ele)
+                  else
+                    None
+                ) ;
+            }
+          in
+          let rec analyse_extension_constructors maybe_more exts_acc types_ext_list =
+            match types_ext_list with
+              [] -> (maybe_more, List.rev exts_acc)
+            | (name, types_ext) :: q ->
+              let ext_loc_end =  Loc.end_ types_ext.Types.ext_loc in
+              let xt_args =
+                match types_ext.ext_args with
+                | Cstr_tuple l ->
+                    Cstr_tuple (List.map (Odoc_env.subst_type new_env) l)
+                | Cstr_record l ->
+                    let docs = Record.(doc types ext_loc_end) l in
+                    Cstr_record (List.map (get_field new_env docs) l)
+              in
+              let new_x =
+                {
+                  xt_name = Name.concat current_module_name name ;
+                  xt_args;
+                  xt_ret = Option.map (Odoc_env.subst_type new_env) types_ext.ext_ret_type ;
+                  xt_type_extension = new_te;
+                  xt_alias = None ;
+                  xt_loc = { loc_impl = None ; loc_inter = Some types_ext.Types.ext_loc} ;
+                  xt_text = None;
+                }
+              in
+              let pos_limit2 =
+                match q with
+                  [] -> pos_limit
+                | (_, next) :: _ -> Loc.start (next.Types.ext_loc)
+              in
+              let (maybe_more, comment_opt) =
+                just_after_special ext_loc_end pos_limit2 in
+                new_x.xt_text <- comment_opt;
+                analyse_extension_constructors maybe_more (new_x :: exts_acc) q
+          in
+          let (maybe_more, exts) = analyse_extension_constructors 0 [] types_ext_list in
+            new_te.te_constructors <- exts;
+            let (maybe_more2, info_after_opt) =
+              just_after_special (pos_end_ele + maybe_more) pos_limit
+            in
+              new_te.te_info <- merge_infos new_te.te_info info_after_opt ;
+              (maybe_more + maybe_more2, new_env, [ Element_type_extension new_te ])
+
+        | Parsetree.Psig_exception ext ->
+            let name = ext.Parsetree.ptyexn_constructor.Parsetree.pext_name in
+            let types_ext =
+              try Signature_search.search_extension table name.txt
+              with Not_found ->
+                raise (Failure (Odoc_messages.exception_not_found current_module_name name.txt))
+            in
+            let ex_args =
+              let pos_end = Loc.end_ types_ext.ext_loc in
+              match types_ext.ext_args with
+              | Cstr_tuple l -> Cstr_tuple (List.map (Odoc_env.subst_type env) l)
+              | Cstr_record l ->
+                  let docs = Record.(doc types) pos_end l in
+                  Cstr_record (List.map (get_field env docs) l)
+            in
+            let e =
+              {
+                ex_name = Name.concat current_module_name name.txt ;
+                ex_info = comment_opt ;
+                ex_args;
+                ex_ret = Option.map (Odoc_env.subst_type env) types_ext.ext_ret_type ;
+                ex_alias = None ;
+                ex_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ;
+                ex_code =
+                   (
+                    if !Odoc_global.keep_code then
+                      Some (get_string_of_file pos_start_ele pos_end_ele)
+                    else
+                      None
+                   ) ;
+              }
+            in
+            let (maybe_more, info_after_opt) =
+              My_ir.just_after_special
+                !file_name
+                (get_string_of_file pos_end_ele pos_limit)
+            in
+            e.ex_info <- merge_infos e.ex_info info_after_opt ;
+            let new_env = Odoc_env.add_extension env e.ex_name in
+            (maybe_more, new_env, [ Element_exception e ])
+
+        | Parsetree.Psig_type (rf, name_type_decl_list) ->
+            let extended_env =
+              List.fold_left
+                (fun acc_env td ->
+                  let complete_name = Name.concat current_module_name td.Parsetree.ptype_name.txt in
+                  Odoc_env.add_type acc_env complete_name
+                )
+                env
+                name_type_decl_list
+            in
+            let env =
+              match rf with
+              | Recursive -> extended_env
+              | Nonrecursive -> env
+            in
+            let rec f ?(first=false) acc_maybe_more last_pos name_type_decl_list =
+              match name_type_decl_list with
+                [] ->
+                  (acc_maybe_more, [])
+              | type_decl :: q ->
+                  let name = type_decl.Parsetree.ptype_name in
+                  let (assoc_com, ele_comments) =
+                    if first then
+                      (comment_opt, [])
+                    else
+                      get_comments_in_module
+                        last_pos
+                        (Loc.start type_decl.Parsetree.ptype_loc)
+                  in
+                  let pos_limit2 =
+                    match q with
+                      [] -> pos_limit
+                    | td :: _ -> Loc.start (td.Parsetree.ptype_loc)
+                  in
+                  let (maybe_more, name_comment_list) =
+                    name_comment_from_type_decl
+                      (Loc.end_ type_decl.Parsetree.ptype_loc)
+                      pos_limit2
+                      type_decl
+                  in
+(* DEBUG *)       begin
+(* DEBUG *)         let comm =
+(* DEBUG *)           match assoc_com with
+(* DEBUG *)           | None -> "sans commentaire"
+(* DEBUG *)           | Some c -> Odoc_misc.string_of_info c
+(* DEBUG *)         in
+(* DEBUG *)         print_DEBUG ("Type "^name.txt^" : "^comm);
+(* DEBUG *)         let f_DEBUG (name, c_opt) =
+(* DEBUG *)           let comm =
+(* DEBUG *)             match c_opt with
+(* DEBUG *)             | None -> "sans commentaire"
+(* DEBUG *)             | Some c -> Odoc_misc.string_of_info c
+(* DEBUG *)           in
+(* DEBUG *)           print_DEBUG ("constructor/field "^name^": "^comm)
+(* DEBUG *)         in
+(* DEBUG *)         List.iter f_DEBUG name_comment_list;
+(* DEBUG *)       end;
+                  (* get the information for the type in the signature *)
+                  let sig_type_decl =
+                    try Signature_search.search_type table name.txt
+                    with Not_found ->
+                      raise (Failure (Odoc_messages.type_not_found current_module_name name.txt))
+                  in
+                  (* get the type kind with the associated comments *)
+                  let type_kind = get_type_kind env name_comment_list sig_type_decl.Types.type_kind in
+                  let loc_start = Loc.start type_decl.Parsetree.ptype_loc in
+                  let new_end = Loc.end_ type_decl.Parsetree.ptype_loc
+                                + maybe_more in
+                  (* associate the comments to each constructor and build the [Type.t_type] *)
+                  let new_type =
+                    {
+                      ty_name = Name.concat current_module_name name.txt ;
+                      ty_info = assoc_com ;
+                      ty_parameters =
+                        List.map2 (fun p v ->
+                          let (co, cn) = Types.Variance.get_upper v in
+                          (Odoc_env.subst_type env p,co, cn))
+                        sig_type_decl.Types.type_params
+                        sig_type_decl.Types.type_variance;
+                      ty_kind = type_kind;
+                      ty_private = sig_type_decl.Types.type_private;
+                      ty_manifest =
+                        begin match sig_type_decl.Types.type_manifest with
+                        | None   -> None
+                        | Some t ->
+                          Some (manifest_structure env name_comment_list t)
+                        end ;
+                      ty_loc = { loc_impl = None ;  loc_inter = Some sig_item_loc } ;
+                      ty_code =
+                        (
+                         if !Odoc_global.keep_code then
+                           Some (get_string_of_file loc_start new_end)
+                         else
+                           None
+                        ) ;
+                    }
+                  in
+                  let (maybe_more2, info_after_opt) =
+                    My_ir.just_after_special
+                      !file_name
+                      (get_string_of_file new_end pos_limit2)
+                  in
+                  new_type.ty_info <- merge_infos new_type.ty_info info_after_opt ;
+                  let (new_maybe_more, eles) = f
+                      (maybe_more + maybe_more2)
+                      (new_end + maybe_more2)
+                      q
+                  in
+                  (new_maybe_more, (ele_comments @ [Element_type new_type]) @ eles)
+            in
+            let (maybe_more, types) = f ~first: true 0 pos_start_ele name_type_decl_list in
+            (maybe_more, extended_env, types)
+
+        | Parsetree.Psig_typesubst (name_type_decl_list) (* FIXME *) ->
+            let extended_env =
+              List.fold_left
+                (fun acc_env td ->
+                  let complete_name = Name.concat current_module_name td.Parsetree.ptype_name.txt in
+                  Odoc_env.add_type acc_env complete_name
+                )
+                env
+                name_type_decl_list
+            in
+            let rec f ?(first=false) acc_maybe_more last_pos name_type_decl_list =
+              match name_type_decl_list with
+                [] ->
+                  (acc_maybe_more, [])
+              | type_decl :: q ->
+                  let name = type_decl.Parsetree.ptype_name in
+                  let (assoc_com, ele_comments) =
+                    if first then
+                      (comment_opt, [])
+                    else
+                      get_comments_in_module
+                        last_pos
+                        (Loc.start type_decl.Parsetree.ptype_loc)
+                  in
+                  let pos_limit2 =
+                    match q with
+                      [] -> pos_limit
+                    | td :: _ -> Loc.start (td.Parsetree.ptype_loc)
+                  in
+                  let (maybe_more, name_comment_list) =
+                    name_comment_from_type_decl
+                      (Loc.end_ type_decl.Parsetree.ptype_loc)
+                      pos_limit2
+                      type_decl
+                  in
+(* DEBUG *)       begin
+(* DEBUG *)         let comm =
+(* DEBUG *)           match assoc_com with
+(* DEBUG *)           | None -> "sans commentaire"
+(* DEBUG *)           | Some c -> Odoc_misc.string_of_info c
+(* DEBUG *)         in
+(* DEBUG *)         print_DEBUG ("Type "^name.txt^" : "^comm);
+(* DEBUG *)         let f_DEBUG (name, c_opt) =
+(* DEBUG *)           let comm =
+(* DEBUG *)             match c_opt with
+(* DEBUG *)             | None -> "sans commentaire"
+(* DEBUG *)             | Some c -> Odoc_misc.string_of_info c
+(* DEBUG *)           in
+(* DEBUG *)           print_DEBUG ("constructor/field "^name^": "^comm)
+(* DEBUG *)         in
+(* DEBUG *)         List.iter f_DEBUG name_comment_list;
+(* DEBUG *)       end;
+                  (* get the information for the type in the signature *)
+                  let sig_type_decl =
+                    try Signature_search.search_type table name.txt
+                    with Not_found ->
+                      raise (Failure (Odoc_messages.type_not_found current_module_name name.txt))
+                  in
+                  (* get the type kind with the associated comments *)
+                  let type_kind = get_type_kind env name_comment_list sig_type_decl.Types.type_kind in
+                  let loc_start = Loc.start type_decl.Parsetree.ptype_loc in
+                  let new_end = Loc.end_ type_decl.Parsetree.ptype_loc
+                                + maybe_more in
+                  (* associate the comments to each constructor and build the [Type.t_type] *)
+                  let new_type =
+                    {
+                      ty_name = Name.concat current_module_name name.txt ;
+                      ty_info = assoc_com ;
+                      ty_parameters =
+                        List.map2 (fun p v ->
+                          let (co, cn) = Types.Variance.get_upper v in
+                          (Odoc_env.subst_type env p,co, cn))
+                        sig_type_decl.Types.type_params
+                        sig_type_decl.Types.type_variance;
+                      ty_kind = type_kind;
+                      ty_private = sig_type_decl.Types.type_private;
+                      ty_manifest =
+                        begin match sig_type_decl.Types.type_manifest with
+                        | None   -> None
+                        | Some t ->
+                          Some (manifest_structure env name_comment_list t)
+                        end ;
+                      ty_loc = { loc_impl = None ;  loc_inter = Some sig_item_loc } ;
+                      ty_code =
+                        (
+                         if !Odoc_global.keep_code then
+                           Some (get_string_of_file loc_start new_end)
+                         else
+                           None
+                        ) ;
+                    }
+                  in
+                  let (maybe_more2, info_after_opt) =
+                    My_ir.just_after_special
+                      !file_name
+                      (get_string_of_file new_end pos_limit2)
+                  in
+                  new_type.ty_info <- merge_infos new_type.ty_info info_after_opt ;
+                  let (new_maybe_more, eles) = f
+                      (maybe_more + maybe_more2)
+                      (new_end + maybe_more2)
+                      q
+                  in
+                  (new_maybe_more, (ele_comments @ [Element_type new_type]) @ eles)
+            in
+            let (maybe_more, types) = f ~first: true 0 pos_start_ele name_type_decl_list in
+            (maybe_more, extended_env, types)
+
+        | Parsetree.Psig_open _ -> (* FIXME *)
+            let ele_comments = match comment_opt with
+              None -> []
+            | Some i ->
+                match i.i_desc with
+                  None -> []
+                | Some t -> [Element_module_comment t]
+            in
+            (0, env, ele_comments)
+
+        | Parsetree.Psig_modsubst _ -> (* FIXME *)
+            (0, env, [])
+
+        | Parsetree.Psig_module {Parsetree.pmd_name={txt=None}} ->
+            (0, env, [])
+
+        | Parsetree.Psig_module {Parsetree.pmd_name={txt=Some name}; pmd_type=module_type} ->
+            let complete_name = Name.concat current_module_name name in
+            (* get the module type in the signature by the module name *)
+            let sig_module_type =
+              try Signature_search.search_module table name
+              with Not_found ->
+                raise (Failure (Odoc_messages.module_not_found current_module_name name))
+            in
+            let module_kind = analyse_module_kind env complete_name module_type sig_module_type in
+            let code_intf =
+              if !Odoc_global.keep_code then
+                let loc = module_type.Parsetree.pmty_loc in
+                let st = Loc.start loc in
+                let en = Loc.end_ loc in
+                Some (get_string_of_file st en)
+              else
+                None
+            in
+            let new_module =
+              {
+                m_name = complete_name ;
+                m_type = sig_module_type;
+                m_info = comment_opt ;
+                m_is_interface = true ;
+                m_file = !file_name ;
+                m_kind = module_kind ;
+                m_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ;
+                m_top_deps = [] ;
+                m_code = None ;
+                m_code_intf = code_intf ;
+                m_text_only = false ;
+              }
+            in
+            let (maybe_more, info_after_opt) =
+              My_ir.just_after_special
+                !file_name
+                (get_string_of_file pos_end_ele pos_limit)
+            in
+            new_module.m_info <- merge_infos new_module.m_info info_after_opt ;
+            let new_env = Odoc_env.add_module env new_module.m_name in
+            let new_env2 =
+              match new_module.m_type with (* FIXME : can this be a Tmty_ident? in this case, we wouldn't have the signature *)
+                Types.Mty_signature s -> Odoc_env.add_signature new_env new_module.m_name ~rel: (Name.simple new_module.m_name) s
+              | _ -> new_env
+            in
+            (maybe_more, new_env2, [ Element_module new_module ])
+
+        | Parsetree.Psig_recmodule decls ->
+            (* we start by extending the environment *)
+            let new_env =
+              List.fold_left
+                (fun acc_env {Parsetree.pmd_name={txt=name}} ->
+                   match name with
+                   | None -> acc_env
+                   | Some name ->
+                      let complete_name = Name.concat current_module_name name in
+                      let e = Odoc_env.add_module acc_env complete_name in
+                      (* get the information for the module in the signature *)
+                      let sig_module_type =
+                        try Signature_search.search_module table name
+                        with Not_found ->
+                          raise (Failure (Odoc_messages.module_not_found current_module_name name))
+                      in
+                      match sig_module_type with
+                        (* FIXME : can this be a Tmty_ident? in this case, we wouldn't have the signature *)
+                        Types.Mty_signature s ->
+                          Odoc_env.add_signature e complete_name ~rel: name s
+                      | _ ->
+                          print_DEBUG "not a Tmty_signature";
+                          e
+                    )
+                    env
+                    decls
+            in
+            let rec f ?(first=false) acc_maybe_more last_pos name_mtype_list =
+              match name_mtype_list with
+                [] ->
+                  (acc_maybe_more, [])
+              | {Parsetree.pmd_name={txt = None}; pmd_type=modtype} :: q ->
+                  let loc = modtype.Parsetree.pmty_loc in
+                  let loc_start = Loc.start loc in
+                  let loc_end = Loc.end_ loc in
+                  let _, ele_comments =
+                    if first then (None, [])
+                    else get_comments_in_module last_pos loc_start
+                  in
+                  let pos_limit2 =
+                    match q with
+                      [] -> pos_limit
+                    | _ :: _ -> Loc.start loc
+                  in
+                  let (maybe_more, _) =
+                    My_ir.just_after_special
+                      !file_name
+                      (get_string_of_file loc_end pos_limit2)
+                  in
+
+                  let (maybe_more2, eles) = f
+                      maybe_more
+                      (loc_end + maybe_more)
+                      q
+                  in
+                  (maybe_more2, ele_comments @ eles)
+
+              | {Parsetree.pmd_name={txt = Some name}; pmd_type=modtype} :: q ->
+                  let complete_name = Name.concat current_module_name name in
+                  let loc = modtype.Parsetree.pmty_loc in
+                  let loc_start = Loc.start loc in
+                  let loc_end = Loc.end_ loc in
+                  let (assoc_com, ele_comments) =
+                    if first then
+                      (comment_opt, [])
+                    else
+                      get_comments_in_module
+                        last_pos
+                        loc_start
+                  in
+                  let pos_limit2 =
+                    match q with
+                      [] -> pos_limit
+                    | _ :: _ -> Loc.start loc
+                  in
+                  (* get the information for the module in the signature *)
+                  let sig_module_type =
+                    try Signature_search.search_module table name
+                    with Not_found ->
+                      raise (Failure (Odoc_messages.module_not_found current_module_name name))
+                  in
+                  (* associate the comments to each constructor and build the [Type.t_type] *)
+                  let module_kind = analyse_module_kind new_env complete_name modtype sig_module_type in
+                  let code_intf =
+                    if !Odoc_global.keep_code then
+                      let st = Loc.start loc in
+                      let en = Loc.end_ loc in
+                      Some (get_string_of_file st en)
+                    else
+                      None
+                  in
+                  let new_module =
+                    {
+                      m_name = complete_name ;
+                      m_type = sig_module_type;
+                      m_info = assoc_com ;
+                      m_is_interface = true ;
+                      m_file = !file_name ;
+                      m_kind = module_kind ;
+                      m_loc = { loc_impl = None ; loc_inter = Some loc } ;
+                      m_top_deps = [] ;
+                      m_code = None ;
+                      m_code_intf = code_intf ;
+                      m_text_only = false ;
+                    }
+                  in
+                  let (maybe_more, info_after_opt) =
+                    My_ir.just_after_special
+                      !file_name
+                      (get_string_of_file loc_end pos_limit2)
+                  in
+                  new_module.m_info <- merge_infos new_module.m_info info_after_opt ;
+
+                  let (maybe_more2, eles) = f
+                      maybe_more
+                      (loc_end + maybe_more)
+                      q
+                  in
+                  (maybe_more2, (ele_comments @ [Element_module new_module]) @ eles)
+            in
+            let (maybe_more, mods) = f ~first: true 0 pos_start_ele decls in
+            (maybe_more, new_env, mods)
+
+        | Parsetree.Psig_modtype {Parsetree.pmtd_name=name; pmtd_type=pmodtype_decl} ->
+            let complete_name = Name.concat current_module_name name.txt in
+            let sig_mtype =
+              try Signature_search.search_module_type table name.txt
+              with Not_found ->
+                raise (Failure (Odoc_messages.module_type_not_found current_module_name name.txt))
+            in
+            let module_type_kind =
+              match pmodtype_decl with
+                None -> None
+              | Some module_type ->
+                match sig_mtype with
+                | Some sig_mtype -> Some (analyse_module_type_kind env complete_name module_type sig_mtype)
+                | None -> None
+            in
+
+            let mt =
+              {
+                mt_name = complete_name ;
+                mt_info = comment_opt ;
+                mt_type = sig_mtype ;
+                mt_is_interface = true ;
+                mt_file = !file_name ;
+                mt_kind = module_type_kind ;
+                mt_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ;
+              }
+            in
+            let (maybe_more, info_after_opt) =
+              My_ir.just_after_special
+                !file_name
+                (get_string_of_file pos_end_ele pos_limit)
+            in
+            mt.mt_info <- merge_infos mt.mt_info info_after_opt ;
+            let new_env = Odoc_env.add_module_type env mt.mt_name in
+            let new_env2 =
+              match sig_mtype with (* FIXME : can this be a Tmty_ident? in this case, we wouldn't have the signature *)
+                Some (Types.Mty_signature s) -> Odoc_env.add_signature new_env mt.mt_name ~rel: (Name.simple mt.mt_name) s
+              | _ -> new_env
+            in
+            (maybe_more, new_env2, [ Element_module_type mt ])
+
+        | Parsetree.Psig_include incl ->
+            let rec f = function
+                Parsetree.Pmty_ident longident ->
+                  Name.from_longident longident.txt
+              | Parsetree.Pmty_alias longident ->
+                  Name.from_longident longident.txt
+              | Parsetree.Pmty_signature _ ->
+                  "??"
+              | Parsetree.Pmty_functor _ ->
+                  "??"
+              | Parsetree.Pmty_with (mt, _) ->
+                  f mt.Parsetree.pmty_desc
+              | Parsetree.Pmty_typeof mexpr ->
+                  let open Parsetree in
+                  begin match mexpr.pmod_desc with
+                    Pmod_ident longident -> Name.from_longident longident.txt
+                  | Pmod_structure [
+                      {pstr_desc=Pstr_include
+                           {pincl_mod={pmod_desc=Pmod_ident longident}}
+                      }] -> (* include module type of struct include M end*)
+                      Name.from_longident longident.txt
+                  | _ -> "??"
+                  end
+              | Parsetree.Pmty_extension _ -> assert false
+            in
+            let name = f incl.Parsetree.pincl_mod.Parsetree.pmty_desc in
+            let full_name = Odoc_env.full_module_or_module_type_name env name in
+            let im =
+              {
+                im_name = full_name ;
+                im_module = None ;
+                im_info = comment_opt;
+              }
+            in
+            (0, env, [ Element_included_module im ]) (* FIXME : extend the environment? How? *)
+
+        | Parsetree.Psig_class class_description_list ->
+            (* we start by extending the environment *)
+            let new_env =
+              List.fold_left
+                (fun acc_env -> fun class_desc ->
+                  let complete_name = Name.concat current_module_name class_desc.Parsetree.pci_name.txt in
+                  Odoc_env.add_class acc_env complete_name
+                )
+                env
+                class_description_list
+            in
+            let rec f ?(first=false) acc_maybe_more last_pos class_description_list =
+              match class_description_list with
+                [] ->
+                  (acc_maybe_more, [])
+              | class_desc :: q ->
+                  let (assoc_com, ele_comments) =
+                    if first then
+                      (comment_opt, [])
+                    else
+                      get_comments_in_module
+                        last_pos
+                        (Loc.start class_desc.Parsetree.pci_loc)
+                  in
+                  let pos_end = Loc.end_ class_desc.Parsetree.pci_loc in
+                  let pos_limit2 =
+                    match q with
+                      [] -> pos_limit
+                    | cd :: _ -> Loc.start cd.Parsetree.pci_loc in
+                  let name = class_desc.Parsetree.pci_name in
+                  let complete_name = Name.concat current_module_name name.txt in
+                  let sig_class_decl =
+                    try Signature_search.search_class table name.txt
+                    with Not_found ->
+                      raise (Failure (Odoc_messages.class_not_found current_module_name name.txt))
+                  in
+                  let sig_class_type = sig_class_decl.Types.cty_type in
+                  let (parameters, class_kind) =
+                    analyse_class_kind
+                     new_env
+                     complete_name
+                     (Loc.start class_desc.Parsetree.pci_loc)
+                     class_desc.Parsetree.pci_expr
+                     sig_class_type
+                 in
+                 let new_class =
+                   {
+                     cl_name = complete_name ;
+                     cl_info = assoc_com ;
+                     cl_type = Odoc_env.subst_class_type env sig_class_type ;
+                     cl_type_parameters = sig_class_decl.Types.cty_params;
+                     cl_virtual = class_desc.Parsetree.pci_virt = Asttypes.Virtual ;
+                     cl_kind = class_kind ;
+                     cl_parameters = parameters ;
+                     cl_loc = { loc_impl = None ; loc_inter = Some class_desc.Parsetree.pci_loc } ;
+                   }
+                 in
+                 let (maybe_more, info_after_opt) =
+                   just_after_special pos_end pos_limit2 in
+                 new_class.cl_info <- merge_infos new_class.cl_info info_after_opt ;
+                 Odoc_class.class_update_parameters_text new_class ;
+                 let (new_maybe_more, eles) =
+                   f maybe_more (pos_end + maybe_more) q
+                 in
+                 (new_maybe_more,
+                  ele_comments @ (( Element_class new_class ) :: eles))
+            in
+            let (maybe_more, eles) =
+              f ~first: true 0 pos_start_ele class_description_list
+            in
+            (maybe_more, new_env, eles)
+
+        | Parsetree.Psig_class_type class_type_declaration_list ->
+            (* we start by extending the environment *)
+            let new_env =
+              List.fold_left
+                (fun acc_env -> fun class_type_decl ->
+                  let complete_name = Name.concat current_module_name class_type_decl.Parsetree.pci_name.txt in
+                  Odoc_env.add_class_type acc_env complete_name
+                )
+                env
+                class_type_declaration_list
+            in
+            let rec f ?(first=false) acc_maybe_more last_pos class_type_description_list =
+              match class_type_description_list with
+                [] ->
+                  (acc_maybe_more, [])
+              | ct_decl :: q ->
+                  let (assoc_com, ele_comments) =
+                    if first then
+                      (comment_opt, [])
+                    else
+                      get_comments_in_module
+                        last_pos
+                        (Loc.start ct_decl.Parsetree.pci_loc)
+                  in
+                  let pos_end = Loc.end_ ct_decl.Parsetree.pci_loc in
+                  let pos_limit2 =
+                    match q with
+                      [] -> pos_limit
+                    | ct_decl2 :: _ -> Loc.start ct_decl2.Parsetree.pci_loc
+                  in
+                  let name = ct_decl.Parsetree.pci_name in
+                  let complete_name = Name.concat current_module_name name.txt in
+                  let sig_cltype_decl =
+                    try Signature_search.search_class_type table name.txt
+                    with Not_found ->
+                      raise (Failure (Odoc_messages.class_type_not_found current_module_name name.txt))
+                  in
+                  let sig_class_type = sig_cltype_decl.Types.clty_type in
+                  let kind = analyse_class_type_kind
+                      new_env
+                      complete_name
+                      (Loc.start ct_decl.Parsetree.pci_loc)
+                      ct_decl.Parsetree.pci_expr
+                      sig_class_type
+                  in
+                  let ct =
+                    {
+                      clt_name = complete_name ;
+                      clt_info = assoc_com ;
+                      clt_type = Odoc_env.subst_class_type env sig_class_type ;
+                      clt_type_parameters = sig_cltype_decl.clty_params ;
+                      clt_virtual = ct_decl.Parsetree.pci_virt = Asttypes.Virtual ;
+                      clt_kind = kind ;
+                      clt_loc = { loc_impl = None ; loc_inter = Some ct_decl.Parsetree.pci_loc } ;
+                    }
+                  in
+                  let (maybe_more, info_after_opt) =
+                    just_after_special pos_end pos_limit2
+                  in
+                  ct.clt_info <- merge_infos ct.clt_info info_after_opt ;
+                  let (new_maybe_more, eles) =
+                    f maybe_more (pos_end + maybe_more) q
+                  in
+                 (new_maybe_more,
+                  ele_comments @ (( Element_class_type ct) :: eles))
+            in
+            let (maybe_more, eles) =
+              f ~first: true 0 pos_start_ele class_type_declaration_list
+            in
+            (maybe_more, new_env, eles)
+        | Parsetree.Psig_attribute _
+        | Parsetree.Psig_extension _ ->
+            (0, env, [])
+
+    (** Return a module_type_kind from a Parsetree.module_type and a Types.module_type *)
+    and analyse_module_type_kind
+      ?(erased = Name.Map.empty) env current_module_name module_type sig_module_type =
+      match module_type.Parsetree.pmty_desc with
+        Parsetree.Pmty_ident longident ->
+          let name =
+            match sig_module_type with
+              Types.Mty_ident path -> Name.from_path path
+            | _ -> Name.from_longident longident.txt
+              (* FIXME this happens for module type F : functor ... -> Toto, Toto is not an ident but a structure *)
+          in
+          Module_type_alias { mta_name = Odoc_env.full_module_type_name env name ;
+                              mta_module = None }
+
+      | Parsetree.Pmty_alias longident ->
+          let name =
+            match sig_module_type with
+              Types.Mty_alias path -> Name.from_path path
+            | _ -> Name.from_longident longident.txt
+          in
+          (* Wrong naming... *)
+          Module_type_alias { mta_name = Odoc_env.full_module_name env name ;
+                              mta_module = None }
+
+      | Parsetree.Pmty_signature ast ->
+          (
+           let ast = filter_out_erased_items_from_signature erased ast in
+           (* we must have a signature in the module type *)
+           match sig_module_type with
+             Types.Mty_signature signat ->
+               let pos_start = Loc.start module_type.Parsetree.pmty_loc in
+               let pos_end = Loc.end_ module_type.Parsetree.pmty_loc in
+               let elements = analyse_parsetree env signat current_module_name pos_start pos_end ast in
+               Module_type_struct elements
+           | _ ->
+               raise (Failure "Parsetree.Pmty_signature signature but not Types.Mty_signature signat")
+          )
+
+      | Parsetree.Pmty_functor (param2, module_type2) ->
+          (
+           let loc = match param2 with Parsetree.Unit -> Location.none
+                     | Parsetree.Named (_, pmty) -> pmty.Parsetree.pmty_loc in
+           let loc_start = Loc.start loc in
+           let loc_end = Loc.end_ loc in
+           let mp_type_code = get_string_of_file loc_start loc_end in
+           print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
+           match sig_module_type with
+             Types.Mty_functor (param, body_module_type) ->
+               let mp_name, mp_kind =
+                 match param2, param with
+                   Parsetree.Named (_, pmty), Types.Named (Some ident, mty) ->
+                     Name.from_ident ident,
+                     analyse_module_type_kind env current_module_name pmty mty
+                 | _ -> "*", Module_type_struct []
+               in
+               let param =
+                 {
+                   mp_name = mp_name;
+                   mp_type =
+                     (match param with
+                      | Types.Unit -> None
+                      | Types.Named (_, mty) ->
+                        Some (Odoc_env.subst_module_type env mty));
+                   mp_type_code = mp_type_code ;
+                   mp_kind = mp_kind ;
+                 }
+               in
+               let k = analyse_module_type_kind ~erased env
+                   current_module_name
+                   module_type2
+                   body_module_type
+               in
+               Module_type_functor (param, k)
+
+           | _ ->
+               (* if we're here something's wrong *)
+               raise (Failure "Parsetree.Pmty_functor _ but not Types.Mty_functor _")
+          )
+
+      | Parsetree.Pmty_with (module_type2, constraints) ->
+          (* of module_type * (Longident.t * with_constraint) list *)
+          (
+           let loc_start = Loc.end_ module_type2.Parsetree.pmty_loc in
+           let loc_end = Loc.end_ module_type.Parsetree.pmty_loc in
+           let s = get_string_of_file loc_start loc_end in
+           let erased = erased_names_of_constraints constraints erased in
+           let k = analyse_module_type_kind ~erased env current_module_name module_type2 sig_module_type in
+
+           Module_type_with (k, s)
+          )
+
+      | Parsetree.Pmty_typeof module_expr ->
+          let loc_start = Loc.start module_expr.Parsetree.pmod_loc in
+          let loc_end = Loc.end_ module_expr.Parsetree.pmod_loc in
+          let s = get_string_of_file loc_start loc_end in
+          Module_type_typeof s
+
+      | Parsetree.Pmty_extension _ -> assert false
+
+    (** analyse of a Parsetree.module_type and a Types.module_type.*)
+    and analyse_module_kind
+        ?(erased = Name.Map.empty) env current_module_name module_type sig_module_type =
+      match module_type.Parsetree.pmty_desc with
+      | Parsetree.Pmty_ident _longident ->
+          let k = analyse_module_type_kind env current_module_name module_type sig_module_type in
+          Module_with ( k, "" )
+      | Parsetree.Pmty_alias _longident ->
+          begin
+            match sig_module_type with
+              Types.Mty_alias path ->
+                let ln = !Odoc_global.library_namespace in
+                let alias_name = Odoc_env.full_module_name env
+                    Name.(alias_unprefix ln @@ from_path path) in
+                let ma = { ma_name = alias_name ; ma_module = None } in
+                Module_alias ma
+            | _ ->
+              raise (Failure "Parsetree.Pmty_alias _ but not Types.Mty_alias _")
+           end
+      | Parsetree.Pmty_signature signature ->
+          (
+           let signature = filter_out_erased_items_from_signature erased signature in
+           match sig_module_type with
+             Types.Mty_signature signat ->
+               Module_struct
+                 (analyse_parsetree
+                    env
+                    signat
+                    current_module_name
+                    (Loc.start module_type.Parsetree.pmty_loc)
+                    (Loc.end_ module_type.Parsetree.pmty_loc)
+                    signature
+                 )
+           | _ ->
+               (* if we're here something's wrong *)
+               raise (Failure "Parsetree.Pmty_signature signature but not Types.Mty_signature signat")
+          )
+      | Parsetree.Pmty_functor (param2,module_type2) (* of string * module_type * module_type *) ->
+          (
+           match sig_module_type with
+             Types.Mty_functor (param, body_module_type) ->
+               let loc = match param2 with Parsetree.Unit -> Location.none
+                     | Parsetree.Named (_, pmty) -> pmty.Parsetree.pmty_loc in
+               let loc_start = Loc.start loc in
+               let loc_end = Loc.end_ loc in
+               let mp_type_code = get_string_of_file loc_start loc_end in
+               print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
+               let mp_name, mp_kind =
+                 match param2, param with
+                   Parsetree.Named (_, pmty), Types.Named (Some ident, mty) ->
+                     Name.from_ident ident,
+                     analyse_module_type_kind env current_module_name pmty mty
+                 | _ -> "*", Module_type_struct []
+               in
+               let param =
+                 {
+                   mp_name;
+                   mp_type =
+                     (match param with
+                      | Types.Unit -> None
+                      | Types.Named(_, mty) -> Some (Odoc_env.subst_module_type env mty));
+                   mp_type_code = mp_type_code ;
+                   mp_kind = mp_kind ;
+                 }
+               in
+               let k = analyse_module_kind ~erased env
+                   current_module_name
+                   module_type2
+                   body_module_type
+               in
+               Module_functor (param, k)
+
+           | _ ->
+               (* if we're here something's wrong *)
+               raise (Failure "Parsetree.Pmty_functor _ but not Types.Mty_functor _")
+          )
+      | Parsetree.Pmty_with (module_type2, constraints) ->
+          (* of module_type * (Longident.t * with_constraint) list*)
+          (
+           let loc_start = Loc.end_ module_type2.Parsetree.pmty_loc in
+           let loc_end = Loc.end_ module_type.Parsetree.pmty_loc in
+           let s = get_string_of_file loc_start loc_end in
+           let erased = erased_names_of_constraints constraints erased in
+           let k = analyse_module_type_kind ~erased env current_module_name module_type2 sig_module_type in
+           Module_with (k, s)
+          )
+      | Parsetree.Pmty_typeof module_expr ->
+          let loc_start = Loc.start module_expr.Parsetree.pmod_loc in
+          let loc_end = Loc.end_ module_expr.Parsetree.pmod_loc in
+          let s = get_string_of_file loc_start loc_end in
+          Module_typeof s
+
+      | Parsetree.Pmty_extension _ -> assert false
+
+
+    (** Analyse of a Parsetree.class_type and a Types.class_type to return a couple
+       (class parameters, class_kind).*)
+    and analyse_class_kind env current_class_name last_pos parse_class_type sig_class_type =
+      match parse_class_type.Parsetree.pcty_desc, sig_class_type with
+        (Parsetree.Pcty_constr (_, _) (*of Longident.t * core_type list *),
+         Types.Cty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) ->
+          print_DEBUG "Cty_constr _";
+           let path_name = Name.from_path p in
+           let name = Odoc_env.full_class_or_class_type_name env path_name in
+           let k =
+             Class_constr
+               {
+                 cco_name = name ;
+                 cco_class = None ;
+                 cco_type_parameters = List.map (Odoc_env.subst_type env) typ_list
+               }
+           in
+           ([], k)
+
+      | (Parsetree.Pcty_signature { Parsetree.pcsig_fields = class_type_field_list }, Types.Cty_signature class_signature) ->
+          (* we get the elements of the class in class_type_field_list *)
+          let (inher_l, ele) = analyse_class_elements env current_class_name
+              last_pos
+              (Loc.end_ parse_class_type.Parsetree.pcty_loc)
+              class_type_field_list
+              class_signature
+          in
+          ([], Class_structure (inher_l, ele))
+
+      | (Parsetree.Pcty_arrow (parse_label, _, pclass_type), Types.Cty_arrow (label, type_expr, class_type)) ->
+          (* label = string. In signature, there is no parameter names inside tuples *)
+          (* if label = "", no label . Here we have the information to determine if a label is explicit or not. *)
+          if parse_label = label then
+            (
+             let new_param = Simple_name
+                 {
+                   sn_name = Btype.label_name label ;
+                   sn_type = Odoc_env.subst_type env type_expr ;
+                   sn_text = None ; (* will be updated when the class will be created *)
+                 }
+             in
+             let (l, k) = analyse_class_kind env current_class_name last_pos pclass_type class_type in
+             ( (new_param :: l), k )
+            )
+          else
+            (
+             raise (Failure "Parsetree.Pcty_arrow (parse_label, _, pclass_type), different labels")
+            )
+
+      | _ ->
+          raise (Failure "analyse_class_kind: match failure")
+
+    (** Analyse of a Parsetree.class_type and a Types.class_type to return a class_type_kind.*)
+    and analyse_class_type_kind env current_class_name last_pos parse_class_type sig_class_type =
+      match parse_class_type.Parsetree.pcty_desc, sig_class_type with
+        (Parsetree.Pcty_constr (_, _) (*of Longident.t * core_type list *),
+         Types.Cty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) ->
+          print_DEBUG "Cty_constr _";
+          Class_type
+            {
+              cta_name = Odoc_env.full_class_or_class_type_name env (Name.from_path p) ;
+              cta_class = None ;
+              cta_type_parameters = List.map (Odoc_env.subst_type env) typ_list
+            }
+
+        | (Parsetree.Pcty_signature {
+              Parsetree.pcsig_fields = class_type_field_list;
+              }, Types.Cty_signature class_signature) ->
+          (* we get the elements of the class in class_type_field_list *)
+          let (inher_l, ele) = analyse_class_elements env current_class_name
+              last_pos
+              (Loc.end_ parse_class_type.Parsetree.pcty_loc)
+              class_type_field_list
+              class_signature
+          in
+          Class_signature (inher_l, ele)
+
+      | (Parsetree.Pcty_arrow _, Types.Cty_arrow _) ->
+          raise (Failure "analyse_class_type_kind : Parsetree.Pcty_arrow (...) with Types.Cty_arrow (...)")
+(*
+      | (Parsetree.Pcty_constr (longident, _) (*of Longident.t * core_type list *),
+         Types.Cty_signature class_signature) ->
+           (* FIXME : this for the case of class constraints :
+              class type cons = object
+                method m : int
+              end
+
+              class ['a] maxou x =
+                (object
+                  val a = (x : 'a)
+                  method m = a
+                end : cons )
+                    ^^^^^^
+           *)
+           let k =
+             Class_type
+               {
+                 cta_name = Odoc_env.full_class_name env (Name.from_longident longident) ;
+                 cta_class = None ;
+                 cta_type_parameters = List.map (Odoc_env.subst_type env) typ_list (* ?? *)
+               }
+           in
+           ([], k)
+*)
+      | _ ->
+          raise (Failure "analyse_class_type_kind: match failure")
+
+    let analyse_signature source_file input_file
+        (ast : Parsetree.signature) (signat : Types.signature) =
+      prepare_file source_file input_file;
+      (* We create the t_module for this file. *)
+      let mod_name = String.capitalize_ascii
+          (Filename.basename (try Filename.chop_extension source_file with _ -> source_file))
+      in
+      let len, info_opt = preamble !file_name !file
+          (fun x -> x.Parsetree.psig_loc) ast in
+      let elements =
+        analyse_parsetree Odoc_env.empty signat mod_name len (String.length !file) ast
+      in
+      let code_intf =
+        if !Odoc_global.keep_code then
+          Some !file
+        else
+          None
+      in
+      {
+        m_name = mod_name ;
+        m_type = Types.Mty_signature signat ;
+        m_info = info_opt ;
+        m_is_interface = true ;
+        m_file = !file_name ;
+        m_kind = Module_struct elements ;
+        m_loc = { loc_impl = None ; loc_inter = Some (Location.in_file !file_name) } ;
+        m_top_deps = [] ;
+        m_code = None ;
+        m_code_intf = code_intf ;
+        m_text_only = false ;
+      }
+
+    end
diff --git a/ocamldoc/odoc_sig.mli b/ocamldoc/odoc_sig.mli
new file mode 100644
index 00000000..78d774de
--- /dev/null
+++ b/ocamldoc/odoc_sig.mli
@@ -0,0 +1,203 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The module for analysing a signature and source code and creating modules, classes, ..., elements.*)
+
+(** The functions used to retrieve information from a signature. *)
+module Signature_search :
+    sig
+      type ele
+      type tab = (ele, Types.signature_item) Hashtbl.t
+
+      (** Create a table from a signature. This table is used by some
+         of the search functions below. *)
+      val table : Types.signature -> tab
+
+      (** This function returns the type expression for the value whose name is given,
+         in the given signature.
+         @raise Not_found if error.*)
+      val search_value : tab -> string -> Types.type_expr
+
+      (** This function returns the Types.extension_constructor for the extension whose name is given,
+         in the given table.
+         @raise Not_found if error.*)
+      val search_extension : tab -> string -> Types.extension_constructor
+
+      (** This function returns the Types.type_declaration  for the type whose name is given,
+         in the given table.
+         @raise Not_found if error.*)
+      val search_type : tab -> string -> Types.type_declaration
+
+      (** This function returns the Types.class_declaration  for the class whose name is given,
+         in the given table.
+         @raise Not_found if error.*)
+      val search_class : tab -> string -> Types.class_declaration
+
+      (** This function returns the Types.class_type_declaration  for the class type whose name is given,
+         in the given table.
+         @raise Not_found if error.*)
+      val search_class_type : tab -> string -> Types.class_type_declaration
+
+      (** This function returns the Types.module_type  for the module whose name is given,
+         in the given table.
+         @raise Not_found if error.*)
+      val search_module : tab -> string -> Types.module_type
+
+      (** This function returns the optional Types.module_type  for the module type whose name is given,
+         in the given table.
+         @raise Not_found if error.*)
+      val search_module_type : tab -> string -> Types.module_type option
+
+      (** This function returns the Types.type_expr  for the given val name
+         in the given class signature.
+         @raise Not_found if error.*)
+      val search_attribute_type :
+          Types.Vars.key -> Types.class_signature -> Types.type_expr
+
+     (** This function returns the Types.type_expr  for the given method name
+        in the given class signature.
+        @raise Not_found if error.*)
+      val search_method_type :
+          string -> Types.class_signature -> Types.type_expr
+    end
+
+(** Functions to retrieve simple and special comments from strings. *)
+module type Info_retriever =
+  sig
+    (** Return the couple [(n, list)] where [n] is the number of
+       characters read to retrieve [list], which is the list
+       of special comments found in the string. *)
+    val all_special :
+        string -> string -> int * Odoc_types.info list
+
+    (** Return true if the given string contains a blank line. *)
+    val blank_line_outside_simple :
+        string -> string -> bool
+
+   (** [just_after_special file str] return the pair ([length], [info_opt])
+      where [info_opt] is the first optional special comment found
+      in [str], without any blank line before. [length] is the number
+      of chars from the beginning of [str] to the end of the special comment. *)
+    val just_after_special :
+        string -> string -> (int * Odoc_types.info option)
+
+   (** [first_special file str] return the pair ([length], [info_opt])
+      where [info_opt] is the first optional special comment found
+      in [str]. [length] is the number of chars from the beginning of [str]
+      to the end of the special comment. *)
+    val first_special :
+        string -> string -> (int * Odoc_types.info option)
+
+    (** Return a pair [(comment_opt, element_comment_list)], where [comment_opt] is the last special
+       comment found in the given string and not followed by a blank line,
+       and [element_comment_list] the list of values built from the other
+       special comments found and the given function. *)
+    val get_comments :
+        (Odoc_types.text -> 'a) -> string -> string -> (Odoc_types.info option * 'a list)
+
+  end
+
+module Analyser :
+  Info_retriever ->
+    sig
+      (** This variable is used to load a file as a string and retrieve characters from it.*)
+      val file : string ref
+
+      (** The name of the analysed file. *)
+      val file_name : string ref
+
+      (** This function takes two indexes (start and end) and returns the string
+         corresponding to the indexes in the file global variable. The function
+         prepare_file must have been called to fill the file global variable.*)
+      val get_string_of_file : int -> int -> string
+
+      (** [prepare_file f input_f] sets [file_name] with [f] and loads the file
+         [input_f] into [file].*)
+      val prepare_file : string -> string -> unit
+
+      (** [preamble f input_f loc ast ] retrieves the position and contents of
+          the preamble for the file [f]: i.e, the first documentation comment
+          before any elements in [ast].
+          If there is no such preamble, [0,None] is returned.
+          The function [loc] is used to obtain the location of this
+          first element of [ast].*)
+      val preamble: string -> string -> ('a -> Location.t) -> 'a list
+        -> int * Odoc_types.info option
+
+      (** The function used to get the comments in a class. *)
+      val get_comments_in_class : int -> int ->
+        (Odoc_types.info option * Odoc_class.class_element list)
+
+      (** The function used to get the comments in a module. *)
+      val get_comments_in_module : int -> int ->
+        (Odoc_types.info option * Odoc_module.module_element list)
+
+      (** [name_comment_from_type_kind pos_end pos_limit type_kind].
+         This function takes a [Parsetree.type_kind] and returns the list of
+         (name, optional comment) for the various fields/constructors of the type,
+         or an empty list for an abstract type.
+         [pos_end] is last char of the complete type definition.
+         [pos_limit] is the position of the last char we could use to look for a comment,
+         i.e. usually the beginning of the next element.*)
+      val name_comment_from_type_decl :
+          int -> int -> Parsetree.type_declaration -> int * (string * Odoc_types.info option) list
+
+      (** This function converts a [Types.type_expr] into a [Odoc_type.type_kind],
+         by associating the comment found in the parsetree of each object field, if any. *)
+      val manifest_structure :
+          Odoc_env.env -> (string * Odoc_types.info option) list ->
+            Types.type_expr -> Odoc_type.type_manifest
+
+      (** This function converts a [Types.type_kind] into a [Odoc_type.type_kind],
+         by associating the comment found in the parsetree of each constructor/field, if any.*)
+      val get_type_kind :
+          Odoc_env.env -> (string * Odoc_types.info option) list ->
+            Types.type_kind -> Odoc_type.type_kind
+
+      (** This function converts a [Types.constructor_arguments] into a
+          [Odoc_type.constructor_args], by associating the comment found
+          in the parsetree of each inner record field, if any.*)
+      val get_cstr_args:
+        Odoc_env.env -> int -> Typedtree.constructor_arguments ->
+        Odoc_type.constructor_args
+
+      (** This function merges two optional info structures. *)
+      val merge_infos :
+          Odoc_types.info option -> Odoc_types.info option ->
+            Odoc_types.info option
+
+      (** Return a module_type_kind from a Parsetree.module_type and a Types.module_type *)
+      val analyse_module_type_kind :
+          ?erased:[ `Constrained of Parsetree.with_constraint list
+                  | `Removed ] Odoc_name.Map.t
+          -> Odoc_env.env -> Odoc_name.t ->
+            Parsetree.module_type -> Types.module_type ->
+              Odoc_module.module_type_kind
+
+      (** Analysis of a Parsetree.class_type and a Types.class_type to
+         return a class_type_kind.*)
+      val analyse_class_type_kind : Odoc_env.env ->
+        Odoc_name.t -> int -> Parsetree.class_type -> Types.class_type ->
+          Odoc_class.class_type_kind
+
+      (** This function takes an interface file name, a file containing the code, a parse tree
+         and the signature obtained from the compiler.
+         It goes through the parse tree, creating values for encountered
+         functions, modules, ..., looking in the source file for comments,
+         and in the signature for types information. *)
+      val analyse_signature :
+        string -> string ->
+        Parsetree.signature -> Types.signature -> Odoc_module.t_module
+    end
diff --git a/ocamldoc/odoc_str.ml b/ocamldoc/odoc_str.ml
new file mode 100644
index 00000000..e250f161
--- /dev/null
+++ b/ocamldoc/odoc_str.ml
@@ -0,0 +1,395 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The functions to get a string from different kinds of elements (types, modules, ...). *)
+
+module Name = Odoc_name
+let () = Printtyp.Naming_context.enable false
+
+let string_of_variance t (co,cn) =
+  if ( t.Odoc_type.ty_kind = Odoc_type.Type_abstract ||
+      t.Odoc_type.ty_kind = Odoc_type.Type_open ) &&
+    t.Odoc_type.ty_manifest = None
+  then
+    match (co, cn) with
+      (true, false) -> "+"
+    | (false, true) -> "-"
+    | _ -> ""
+  else
+    ""
+let rec is_arrow_type t =
+  match t.Types.desc with
+    Types.Tarrow _ -> true
+  | Types.Tlink t2 | Types.Tsubst t2 -> is_arrow_type t2
+  | Types.Ttuple _
+  | Types.Tconstr _
+  | Types.Tvar _ | Types.Tunivar _ | Types.Tobject _ | Types.Tpoly _
+  | Types.Tfield _ | Types.Tnil | Types.Tvariant _ | Types.Tpackage _ -> false
+
+let raw_string_of_type_list sep type_list =
+  let buf = Buffer.create 256 in
+  let fmt = Format.formatter_of_buffer buf in
+  let rec need_parent t =
+    match t.Types.desc with
+      Types.Tarrow _ | Types.Ttuple _ -> true
+    | Types.Tlink t2 | Types.Tsubst t2 -> need_parent t2
+    | Types.Tconstr _ ->
+        false
+    | Types.Tvar _ | Types.Tunivar _ | Types.Tobject _ | Types.Tpoly _
+    | Types.Tfield _ | Types.Tnil | Types.Tvariant _ | Types.Tpackage _ -> false
+  in
+  let print_one_type variance t =
+    Printtyp.mark_loops t;
+    if need_parent t then
+      (
+       Format.fprintf fmt "(%s" variance;
+       Printtyp.type_scheme_max ~b_reset_names: false fmt t;
+       Format.fprintf fmt ")"
+      )
+    else
+      (
+       Format.fprintf fmt "%s" variance;
+       Printtyp.type_scheme_max ~b_reset_names: false fmt t
+      )
+  in
+  begin match type_list with
+    [] -> ()
+  | [(variance, ty)] -> print_one_type variance ty
+  | (variance, ty) :: tyl ->
+      Format.fprintf fmt "@[<hov 2>";
+      print_one_type variance ty;
+      List.iter
+        (fun (variance, t) ->
+          Format.fprintf fmt "@,%s" sep;
+          print_one_type variance t
+        )
+        tyl;
+      Format.fprintf fmt "@]"
+  end;
+  Format.pp_print_flush fmt ();
+  Buffer.contents buf
+
+let string_of_type_list ?par sep type_list =
+  let par =
+    match par with
+    | Some b -> b
+    | None ->
+        match type_list with
+          [] | [_] -> false
+        | _ -> true
+  in
+  Printf.sprintf "%s%s%s"
+    (if par then "(" else "")
+    (raw_string_of_type_list sep (List.map (fun t -> ("", t)) type_list))
+    (if par then ")" else "")
+
+let string_of_type_param_list t =
+  let par =
+    match t.Odoc_type.ty_parameters with
+      [] | [_] -> false
+    | _ -> true
+  in
+  Printf.sprintf "%s%s%s"
+    (if par then "(" else "")
+    (raw_string_of_type_list ", "
+       (List.map
+          (fun (typ, co, cn) -> (string_of_variance t (co, cn), typ))
+          t.Odoc_type.ty_parameters
+       )
+    )
+    (if par then ")" else "")
+
+let string_of_type_extension_param_list te =
+  let par =
+    match te.Odoc_extension.te_type_parameters with
+      [] | [_] -> false
+    | _ -> true
+  in
+  Printf.sprintf "%s%s%s"
+    (if par then "(" else "")
+    (raw_string_of_type_list ", "
+       (List.map
+          (fun typ -> ("", typ))
+          te.Odoc_extension.te_type_parameters
+       )
+    )
+    (if par then ")" else "")
+
+
+let string_of_class_type_param_list l =
+  let par =
+    match l with
+      [] | [_] -> false
+    | _ -> true
+  in
+  Printf.sprintf "%s%s%s"
+    (if par then "[" else "")
+    (raw_string_of_type_list ", "
+       (List.map
+          (fun typ -> ("", typ))
+          l
+       )
+    )
+    (if par then "]" else "")
+
+let string_of_class_params c =
+  let b = Buffer.create 256 in
+  let rec iter = function
+      Types.Cty_arrow (label, t, ctype) ->
+        let parent = is_arrow_type t in
+        Printf.bprintf b "%s%s%s%s -> "
+          (
+           match label with
+             Asttypes.Nolabel -> ""
+           | s -> Printtyp.string_of_label s ^":"
+          )
+          (if parent then "(" else "")
+          (Odoc_print.string_of_type_expr
+             (if Odoc_misc.is_optional label then
+               Odoc_misc.remove_option t
+             else
+               t
+             )
+          )
+          (if parent then ")" else "");
+        iter ctype
+    | Types.Cty_signature _
+    | Types.Cty_constr _ -> ()
+  in
+  iter c.Odoc_class.cl_type;
+  Buffer.contents b
+
+let bool_of_private = function
+  | Asttypes.Private -> true
+  | _ -> false
+
+let field_doc_str = function
+  | None -> ""
+  | Some t -> Printf.sprintf "(* %s *)" (Odoc_misc.string_of_info t)
+
+let string_of_record l =
+  let module M = Odoc_type in
+  let module P = Printf in
+  P.sprintf "{\n%s\n}" (
+    String.concat "\n" (
+      List.map (fun field ->
+          P.sprintf "   %s%s : %s;%s"
+            (if field.M.rf_mutable then "mutable " else "") field.M.rf_name
+            (Odoc_print.string_of_type_expr field.M.rf_type)
+            (field_doc_str field.M.rf_text)
+        ) l
+    )
+  )
+
+let string_of_type t =
+  let module M = Odoc_type in
+   let module P = Printf in
+   let priv = bool_of_private t.M.ty_private in
+   let parameters_str =
+     String.concat " " (
+       List.map (fun (p, co, cn) ->
+         (string_of_variance t (co, cn)) ^ (Odoc_print.string_of_type_expr p)
+       ) t.M.ty_parameters
+     )
+   in
+   let manifest_str =
+     match t.M.ty_manifest with
+     | None -> ""
+     | Some (M.Object_type fields) ->
+       P.sprintf "= %s<\n%s\n>\n" (if priv then "private " else "") (
+         String.concat "\n" (
+           List.map (fun field ->
+             P.sprintf "   %s : %s;%s" field.M.of_name
+               (Odoc_print.string_of_type_expr field.M.of_type)
+               (field_doc_str field.M.of_text)
+           ) fields
+        )
+     )
+   | Some (M.Other typ) ->
+     "= " ^ (if priv then "private " else "" ) ^
+       (Odoc_print.string_of_type_expr typ) ^ " "
+ in
+ let type_kind_str =
+   match t.M.ty_kind with
+   | M.Type_abstract -> ""
+   | M.Type_variant l ->
+     P.sprintf "=%s\n%s\n" (if priv then " private" else "") (
+       String.concat "\n" (
+         List.map (fun cons ->
+           let comment =
+             match cons.M.vc_text with
+             | None -> ""
+             | Some t -> P.sprintf "(* %s *)" (Odoc_misc.string_of_info t)
+           in
+           let string_of_parameters = function
+             | M.Cstr_tuple l ->
+                 String.concat " * " (
+                   List.map (fun t -> "("^Odoc_print.string_of_type_expr t^")") l
+                 )
+             | M.Cstr_record l ->
+                 string_of_record l
+           in
+           P.sprintf "  | %s%s%s" cons.M.vc_name (
+             match cons.M.vc_args, cons.M.vc_ret with
+              | M.Cstr_tuple [], None -> ""
+              | li, None -> " of " ^ (string_of_parameters li)
+              | M.Cstr_tuple [], Some r -> " : " ^ Odoc_print.string_of_type_expr r
+              | li, Some r ->
+                 P.sprintf " : %s -> %s" (string_of_parameters li)
+                   (Odoc_print.string_of_type_expr r)
+             ) comment
+           ) l
+        )
+      )
+
+  | M.Type_open ->
+      "= .." (* FIXME MG: when introducing new constructors next time,
+                thanks to setup a minimal correct output *)
+  | M.Type_record l ->
+     P.sprintf "= %s{\n%s\n}\n" (if priv then "private " else "")
+       (string_of_record l)
+ in
+ P.sprintf "type %s %s %s%s%s" parameters_str (Name.simple t.M.ty_name)
+   manifest_str type_kind_str
+   (match t.M.ty_info with
+    | None -> ""
+    | Some info -> Odoc_misc.string_of_info info)
+
+let string_of_type_extension te =
+  let module M = Odoc_extension in
+  let module T = Odoc_type in
+    "type "
+    ^(String.concat ""
+        (List.map
+           (fun p -> (Odoc_print.string_of_type_expr p)^" ")
+           te.M.te_type_parameters
+        ))
+    ^te.M.te_type_name
+    ^" += "
+    ^(if (bool_of_private te.M.te_private) then "private " else "")
+    ^"\n"
+    ^(String.concat ""
+        (List.map
+           (fun x ->
+              "  | "
+              ^(Name.simple x.M.xt_name)
+              ^(match x.M.xt_args, x.M.xt_ret with
+                  | T.Cstr_tuple [], None -> ""
+                  | T.Cstr_tuple l, None ->
+                      " of " ^
+                        (String.concat " * "
+                           (List.map
+                              (fun t -> "("^Odoc_print.string_of_type_expr t^")") l))
+                  | T.Cstr_tuple [], Some r -> " : " ^ Odoc_print.string_of_type_expr r
+                  | T.Cstr_tuple l, Some r ->
+                      " : " ^
+                        (String.concat " * "
+                           (List.map
+                              (fun t -> "("^Odoc_print.string_of_type_expr t^")") l))
+                      ^ " -> " ^ Odoc_print.string_of_type_expr r
+                  | T.Cstr_record l, None ->
+                      " of " ^  string_of_record l
+                  | T.Cstr_record l, Some r ->
+                      " : " ^ string_of_record l ^ " -> "
+                      ^ Odoc_print.string_of_type_expr r
+               )
+              ^(match x.M.xt_alias with
+                    None -> ""
+                  | Some xa ->
+                      " = "^
+                        (match xa.M.xa_xt with
+                             None -> xa.M.xa_name
+                           | Some x2 -> x2.M.xt_name
+                        )
+               )
+              ^(match x.M.xt_text with
+                    None ->
+                      ""
+                  | Some t ->
+                      "(* "^(Odoc_misc.string_of_info t)^" *)"
+               )^"\n"
+           )
+           te.M.te_constructors))
+    ^(match te.M.te_info with
+          None -> ""
+        | Some i -> Odoc_misc.string_of_info i
+     )
+
+let string_of_exception e =
+  let module T = Odoc_type in
+  let module M = Odoc_exception in
+  "exception "^(Name.simple e.M.ex_name)^
+  (match e.M.ex_args, e.M.ex_ret with
+     T.Cstr_tuple [], None -> ""
+   | T.Cstr_tuple l,None ->
+       " of "^
+       (String.concat " * "
+         (List.map (fun t -> "("^(Odoc_print.string_of_type_expr t)^")") l))
+   | T.Cstr_tuple [],Some r ->
+       " : "^
+       (Odoc_print.string_of_type_expr r)
+   | T.Cstr_tuple l,Some r ->
+       " : "^
+       (String.concat " * "
+         (List.map (fun t -> "("^(Odoc_print.string_of_type_expr t)^")") l))^
+       " -> "^
+       (Odoc_print.string_of_type_expr r)
+   | T.Cstr_record l, None ->
+       " of " ^  string_of_record l
+   | T.Cstr_record l, Some r ->
+       " : " ^ string_of_record l ^ " -> "
+       ^ Odoc_print.string_of_type_expr r
+  )^
+  (match e.M.ex_alias with
+    None -> ""
+  | Some ea ->
+      " = "^
+      (match ea.M.ea_ex with
+        None -> ea.M.ea_name
+      | Some e2 -> e2.M.ex_name
+      )
+  )^"\n"^
+  (match e.M.ex_info with
+    None -> ""
+  | Some i -> Odoc_misc.string_of_info i)
+
+let string_of_value v =
+  let module M = Odoc_value in
+  "val "^(Name.simple v.M.val_name)^" : "^
+  (Odoc_print.string_of_type_expr v.M.val_type)^"\n"^
+  (match v.M.val_info with
+    None -> ""
+  | Some i -> Odoc_misc.string_of_info i)
+
+let string_of_attribute a =
+  let module M = Odoc_value in
+  "val "^
+  (if a.M.att_virtual then "virtual " else "")^
+  (if a.M.att_mutable then Odoc_messages.mutab^" " else "")^
+  (Name.simple a.M.att_value.M.val_name)^" : "^
+  (Odoc_print.string_of_type_expr a.M.att_value.M.val_type)^"\n"^
+  (match a.M.att_value.M.val_info with
+    None -> ""
+  | Some i -> Odoc_misc.string_of_info i)
+
+let string_of_method m =
+  let module M = Odoc_value in
+  "method "^
+  (if m.M.met_private then Odoc_messages.privat^" " else "")^
+  (Name.simple m.M.met_value.M.val_name)^" : "^
+  (Odoc_print.string_of_type_expr m.M.met_value.M.val_type)^"\n"^
+  (match m.M.met_value.M.val_info with
+    None -> ""
+  | Some i -> Odoc_misc.string_of_info i)
diff --git a/ocamldoc/odoc_str.mli b/ocamldoc/odoc_str.mli
new file mode 100644
index 00000000..3cb52b4b
--- /dev/null
+++ b/ocamldoc/odoc_str.mli
@@ -0,0 +1,62 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The functions to get a string from different kinds of elements (types, modules, ...). *)
+
+(** @return the variance string for the given type and (covariant, contravariant) information. *)
+val string_of_variance : Odoc_type.t_type -> (bool * bool) -> string
+
+(** This function returns a string to represent the given list of types,
+   with a given separator.
+   @param par can be used to force the addition or not of parentheses around the returned string.
+*)
+val string_of_type_list : ?par: bool -> string -> Types.type_expr list -> string
+
+(** This function returns a string to represent the list of type parameters
+   for the given type. *)
+val string_of_type_param_list : Odoc_type.t_type -> string
+
+(** This function returns a string to represent the list of type parameters
+   for the given type extension. *)
+val string_of_type_extension_param_list : Odoc_extension.t_type_extension -> string
+
+(** This function returns a string to represent the given list of
+   type parameters of a class or class type,
+   with a given separator. *)
+val string_of_class_type_param_list : Types.type_expr list -> string
+
+(** @return a string to describe the given type. *)
+val string_of_type : Odoc_type.t_type -> string
+
+val string_of_record : Odoc_type.record_field list -> string
+
+(** @return a string to display the parameters of the given class,
+   in the same form as the compiler. *)
+val string_of_class_params : Odoc_class.t_class -> string
+
+(** @return a string to describe the given type extension. *)
+val string_of_type_extension : Odoc_extension.t_type_extension -> string
+
+(** @return a string to describe the given exception. *)
+val string_of_exception : Odoc_exception.t_exception -> string
+
+(** @return a string to describe the given value. *)
+val string_of_value : Odoc_value.t_value -> string
+
+(** @return a string to describe the given attribute. *)
+val string_of_attribute : Odoc_value.t_attribute -> string
+
+(** @return a string to describe the given method. *)
+val string_of_method : Odoc_value.t_method -> string
diff --git a/ocamldoc/odoc_test.ml b/ocamldoc/odoc_test.ml
new file mode 100644
index 00000000..dec7a1ec
--- /dev/null
+++ b/ocamldoc/odoc_test.ml
@@ -0,0 +1,126 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2004 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Custom generator to perform test on ocamldoc. *)
+
+open Odoc_info
+open Odoc_info.Module
+open Odoc_info.Type
+
+type test_kind =
+    Types_display
+
+let p = Format.fprintf
+
+module Generator (G : Odoc_gen.Base) =
+struct
+  class string_gen =
+  object(self)
+    inherit Odoc_info.Scan.scanner
+
+
+    val mutable test_kinds = []
+    val mutable fmt = Format.str_formatter
+
+    method must_display_types = List.mem Types_display test_kinds
+
+    method set_test_kinds_from_module m =
+      test_kinds <- List.fold_left
+          (fun acc (s, _) ->
+            match s with
+              "test_types_display" -> Types_display :: acc
+            | _ -> acc
+          )
+          []
+          (
+           match m.m_info with
+             None -> []
+           | Some i -> i.i_custom
+          )
+    method! scan_type t =
+      match test_kinds with
+        [] -> ()
+      | _ ->
+          p fmt "# type %s:\n" t.ty_name;
+          if self#must_display_types then
+            (
+             p fmt "# manifest :\n<[%s]>\n"
+               (match t.ty_manifest with
+                 None -> "None"
+               | Some (Object_type _fields) -> "< object type >" (* TODO *)
+               | Some (Other e) -> Odoc_info.string_of_type_expr e
+               );
+            );
+
+
+    method! scan_module_pre m =
+      p fmt "#\n# module %s:\n" m.m_name ;
+      if self#must_display_types then
+        (
+         p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
+           (Odoc_info.string_of_module_type m.m_type);
+         p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
+           (Odoc_info.string_of_module_type ~complete: true m.m_type);
+        );
+      true
+
+    method! scan_module_type_pre m =
+      p fmt "#\n# module type %s:\n" m.mt_name ;
+      if self#must_display_types then
+        (
+         p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
+           (match m.mt_type with
+             None -> "None"
+           | Some t -> Odoc_info.string_of_module_type t
+           );
+         p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
+           (match m.mt_type with
+             None -> "None"
+           | Some t -> Odoc_info.string_of_module_type ~complete: true t
+           );
+        );
+      true
+
+    method generate (module_list: Odoc_info.Module.t_module list) =
+      let oc = open_out !Odoc_info.Global.out_file in
+      fmt <- Format.formatter_of_out_channel oc;
+      (
+       try
+         List.iter
+           (fun m ->
+             self#set_test_kinds_from_module m;
+             self#scan_module_list [m];
+           )
+           module_list
+       with
+         e ->
+           prerr_endline (Printexc.to_string e)
+      );
+      Format.pp_print_flush fmt ();
+      close_out oc
+  end
+
+  class generator =
+    let g = new string_gen in
+    object
+      inherit G.generator as base
+
+      method! generate l =
+        base#generate l;
+        g#generate l
+    end
+end;;
+
+let _ = Odoc_args.extend_base_generator (module Generator : Odoc_gen.Base_functor);;
diff --git a/ocamldoc/odoc_texi.ml b/ocamldoc/odoc_texi.ml
new file mode 100644
index 00000000..22f2000b
--- /dev/null
+++ b/ocamldoc/odoc_texi.ml
@@ -0,0 +1,1312 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*       Olivier Andrieu, base sur du code de Maxence Guesdon             *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Generation of Texinfo documentation. *)
+
+open Odoc_info
+open Value
+open Type
+open Extension
+open Exception
+open Class
+open Module
+
+let esc_8bits = ref false
+
+let info_section = ref "OCaml"
+
+let info_entry = ref []
+
+(** {1 Some small helper functions} *)
+
+let puts_nl chan s =
+  output_string chan s ;
+  output_char chan '\n'
+let puts chan s =
+  output_string chan s
+let nl chan =
+  output_char chan '\n'
+
+let is = function
+  | None -> false
+  | Some _ -> true
+
+let pad_to n s =
+  let len = String.length s in
+  if len < n then s ^ String.make (n - len) ' ' else s
+
+let indent nb_sp s =
+  let c = ref 0 in
+  let len = pred (String.length s) in
+  for i = 0 to len do if s.[i] = '\n' then incr c done ;
+  let s' = Bytes.make (succ len + (succ !c) * nb_sp ) ' ' in
+  c := nb_sp ;
+  for i = 0 to len do
+    Bytes.set s' !c s.[i] ;
+    if s.[i] = '\n' then c := !c + nb_sp ;
+    incr c
+  done ;
+  Bytes.to_string s'
+
+type subparts = [
+  | `Module of Odoc_info.Module.t_module
+  | `Module_type of Odoc_info.Module.t_module_type
+  | `Class of Odoc_info.Class.t_class
+  | `Class_type of Odoc_info.Class.t_class_type
+  ]
+
+type menu_data = [
+  | subparts
+  | `Blank
+  | `Comment of string
+  | `Texi of string
+  | `Index of string
+] list
+
+let nothing = Verbatim ""
+
+let module_subparts =
+  let rec iter acc = function
+    | [] -> List.rev acc
+    (* skip aliases *)
+    | Element_module { m_kind = Module_alias _ } :: n ->
+        iter acc n
+    | Element_module_type { mt_kind = Some (Module_type_alias _) } :: n ->
+        iter acc n
+    (* keep modules, module types, classes and class types *)
+    | Element_module m :: n ->
+        iter (`Module m :: acc) n
+    | Element_module_type mt :: n ->
+        iter (`Module_type mt :: acc) n
+    | Element_class c :: n ->
+        iter (`Class c :: acc) n
+    | Element_class_type ct :: n ->
+        iter (`Class_type ct :: acc) n
+    (* forget the rest *)
+    | _ :: n -> iter acc n
+  in
+  iter []
+
+type indices = [
+  | `Type
+  | `Extension
+  | `Exception
+  | `Value
+  | `Class_att
+  | `Method
+  | `Class
+  | `Class_type
+  | `Module
+  | `Module_type
+]
+
+let indices = function
+  | `Type        -> "ty"
+  | `Extension   -> "xt"
+  | `Exception   -> "ex"
+  | `Value       -> "va"
+  | `Class_att   -> "ca"
+  | `Method      -> "me"
+  | `Class       -> "cl"
+  | `Class_type  -> "ct"
+  | `Module      -> "mo"
+  | `Module_type -> "mt"
+
+let indices_names = [
+  "Types"           , "ty" ;
+  "Extensions"      , "xt" ;
+  "Exceptions"      , "ex" ;
+  "Values"          , "va" ;
+  "Class attributes", "ca" ;
+  "Methods"         , "me" ;
+  "Classes"         , "cl" ;
+  "Class types"     , "ct" ;
+  "Modules"         , "mo" ;
+  "Module types"    , "mt" ; ]
+
+
+
+(** Module for generating various Texinfo things (menus, xrefs, ...) *)
+module Texi =
+struct
+  (** Associations of strings to substitute in Texinfo code. *)
+  let subst_strings = [
+    (Str.regexp "@", "@@") ;
+    (Str.regexp "{", "@{") ;
+    (Str.regexp "}", "@}") ;
+    (Str.regexp "\\.\\.\\.", "@dots{}") ;
+  ] @
+    (if !esc_8bits
+    then [
+    (Str.regexp "\xE0", "@`a") ;
+    (Str.regexp "\xE2", "@^a") ;
+    (Str.regexp "\xE9", "@'e") ;
+    (Str.regexp "\xE8", "@`e") ;
+    (Str.regexp "\xEA", "@^e") ;
+    (Str.regexp "\xEB", "@\"e") ;
+    (Str.regexp "\xF7", "@,{c}") ;
+    (Str.regexp "\xF4", "@^o") ;
+    (Str.regexp "\xF6", "@\"o") ;
+    (Str.regexp "\xEE", "@^i") ;
+    (Str.regexp "\xEF", "@\"i") ;
+    (Str.regexp "\xF9", "@`u") ;
+    (Str.regexp "\xFB", "@^u") ;
+    (Str.regexp "\xE6", "@ae{}" ) ;
+    (Str.regexp "\xC6", "@AE{}" ) ;
+    (Str.regexp "\xDF", "@ss{}" ) ;
+    (Str.regexp "\xA9", "@copyright{}" ) ;
+    ]
+    else [])
+
+  (** Escape the strings which would clash with Texinfo syntax. *)
+  let escape s =
+    List.fold_left
+      (fun acc (p, r) -> Str.global_replace p r acc)
+      s subst_strings
+
+  (** Removes dots (no good for a node name). *)
+  let fix_nodename s =
+    Str.global_replace (Str.regexp "\\.") "/" (escape s)
+
+  (** Generates a Texinfo menu. *)
+  let generate_menu chan subpart_list =
+    if subpart_list <> []
+    then begin
+      let menu_line part_qual name =
+        let sname = Name.simple name in
+        if sname = name
+        then (
+          puts chan (pad_to 35
+                       ("* " ^ sname ^ ":: ")) ;
+          puts_nl chan part_qual )
+        else (
+          puts chan (pad_to 35
+                       ("* " ^ sname ^ ": " ^ (fix_nodename name) ^ ". " )) ;
+          puts_nl chan part_qual )
+      in
+      puts_nl chan "@menu" ;
+      List.iter
+        (function
+        | `Module { m_name = name } ->
+            menu_line Odoc_messages.modul name
+        | `Module_type { mt_name = name } ->
+            menu_line Odoc_messages.module_type name
+        | `Class { cl_name = name } ->
+            menu_line Odoc_messages.clas name
+        | `Class_type { clt_name = name } ->
+            menu_line Odoc_messages.class_type name
+        | `Blank -> nl chan
+        | `Comment c -> puts_nl chan (escape c)
+        | `Texi t -> puts_nl chan t
+        | `Index ind -> Printf.fprintf chan "* %s::\n" ind)
+      subpart_list ;
+    puts_nl chan "@end menu"
+  end
+
+  (** cross reference to node [name] *)
+  let xref ?xname name =
+    "@xref{" ^ (fix_nodename name) ^
+    (match xname with | None -> "" | Some s -> "," ^ s) ^
+    "}."
+
+  (** enclose the string between [\@ifinfo] tags *)
+  let ifinfo s =
+    String.concat "\n"
+      [ "@ifinfo" ; s ; "@end ifinfo" ; "" ]
+
+  (** [install-info] information *)
+  let dirsection sec =
+    "@dircategory " ^ (escape sec)
+
+  let direntry ent =
+    [ "@direntry" ] @
+      (List.map escape ent) @
+    [ "@end direntry" ]
+end
+
+
+
+
+
+(** {1 Generation of Texinfo code} *)
+
+(** {2 Associations between a title number and texinfo code.} *)
+let titles_and_headings = ref [
+    0, ("@chapter ", "@majorheading ")  ;
+    1, ("@chapter ", "@majorheading ")  ;
+    2, ("@section ", "@heading ")  ;
+    3, ("@subsection ", "@subheading ") ;
+    4, ("@subsubsection ", "@subsubheading ")  ;
+  ]
+
+let title = fst
+let heading = snd
+
+let fallback_title =
+  "@unnumberedsubsubsec "
+
+let fallback_heading =
+  "@subsubheading "
+
+(** This class generates Texinfo code from text structures *)
+class text =
+  object(self)
+
+    method escape =
+      Texi.escape
+
+    (** this method is not used here but is virtual
+        in a class we will inherit later *)
+    method label ?no_:(_ : bool option) (_ : string) : string =
+      failwith "gni"
+
+    (** Return the Texinfo code corresponding to the [text] parameter.*)
+    method texi_of_text t =
+      String.concat ""
+        (List.map self#texi_of_text_element t)
+
+
+    (** {2 Conversion methods}
+       [texi_of_????] converts a [text_element] to a Texinfo string. *)
+
+    (** Return the Texinfo code for the [text_element] in parameter. *)
+    method texi_of_text_element = function
+      | Verbatim s | Latex s -> self#texi_of_Verbatim s
+      | Raw s -> self#texi_of_Raw s
+      | Code s -> self#texi_of_Code s
+      | CodePre s -> self#texi_of_CodePre s
+      | Bold t -> self#texi_of_Bold t
+      | Italic t -> self#texi_of_Italic t
+      | Emphasize t -> self#texi_of_Emphasize t
+      | Center t -> self#texi_of_Center t
+      | Left t -> self#texi_of_Left t
+      | Right t -> self#texi_of_Right t
+      | List tl -> self#texi_of_List tl
+      | Enum tl -> self#texi_of_Enum tl
+      | Newline -> self#texi_of_Newline
+      | Block t -> self#texi_of_Block t
+      | Title (n, _, t) -> self#texi_of_Title n t
+      | Link (s, t) -> self#texi_of_Link s t
+      | Ref (name, kind, _) ->self#texi_of_Ref name kind
+      | Superscript t -> self#texi_of_Superscript t
+      | Subscript t -> self#texi_of_Subscript t
+      | Odoc_info.Module_list _ -> ""
+      | Odoc_info.Index_list -> ""
+      | Odoc_info.Custom (s,t) -> self#texi_of_custom_text s t
+      | Odoc_info.Target (target, code) -> self#texi_of_Target ~target ~code
+
+    method texi_of_custom_text _ _ = ""
+
+    method texi_of_Target ~target ~code =
+      if String.lowercase_ascii target = "texi" then code else ""
+
+    method texi_of_Verbatim s = s
+    method texi_of_Raw s = self#escape s
+    method texi_of_Code s = "@code{" ^ (self#escape s) ^ "}"
+    method texi_of_CodePre s =
+      String.concat "\n"
+        [ "" ;  "@example" ; self#escape s ; "@end example" ; "" ]
+    method texi_of_Bold t = "@strong{" ^ (self#texi_of_text t) ^ "}"
+    method texi_of_Italic t = "@i{" ^ (self#texi_of_text t) ^ "}"
+    method texi_of_Emphasize t = "@emph{" ^ (self#texi_of_text t) ^ "}"
+    method texi_of_Center t =
+      let sl = Str.split (Str.regexp "\n") (self#texi_of_text t) in
+      String.concat ""
+        ((List.map (fun s -> "\n@center "^s) sl) @ [ "\n" ])
+    method texi_of_Left t =
+      String.concat "\n"
+        [ "" ; "@flushleft" ; self#texi_of_text t ; "@end flushleft" ; "" ]
+    method texi_of_Right t =
+      String.concat "\n"
+        [ "" ; "@flushright" ; self#texi_of_text t ; "@end flushright"; "" ]
+    method texi_of_List tl =
+      String.concat "\n"
+        ( [ "" ; "@itemize" ] @
+          (List.map (fun t -> "@item\n" ^ (self#texi_of_text t)) tl) @
+          [ "@end itemize"; "" ] )
+    method texi_of_Enum tl =
+      String.concat "\n"
+        ( [ "" ; "@enumerate" ] @
+          (List.map (fun t -> "@item\n" ^ (self#texi_of_text t)) tl) @
+          [ "@end enumerate"; "" ] )
+    method texi_of_Newline = "\n"
+    method texi_of_Block t =
+      String.concat "\n"
+        [ "@format" ; self#texi_of_text t ; "@end format" ; "" ]
+    method texi_of_Title n t =
+      let t_begin =
+        try title @@ List.assoc n !titles_and_headings
+        with Not_found -> fallback_title in
+      t_begin ^ (self#texi_of_text t) ^ "\n"
+    method texi_of_Link s t =
+      String.concat ""
+        [ "@uref{" ; s ;  "," ; self#texi_of_text t ; "}" ]
+    method texi_of_Ref name kind =
+      let xname =
+        match kind with
+        | Some RK_module ->
+            Odoc_messages.modul ^ " " ^ (Name.simple name)
+        | Some RK_module_type ->
+            Odoc_messages.module_type ^ " " ^ (Name.simple name)
+        | Some RK_class ->
+            Odoc_messages.clas ^ " " ^ (Name.simple name)
+        | Some RK_class_type ->
+            Odoc_messages.class_type ^ " " ^ (Name.simple name)
+        | _ -> ""
+      in
+      if xname = "" then self#escape name else Texi.xref ~xname name
+    method texi_of_Superscript t =
+      "^@{" ^ (self#texi_of_text t) ^ "@}"
+    method texi_of_Subscript t =
+      "_@{" ^ (self#texi_of_text t) ^ "@}"
+
+    method heading n t =
+      let f =
+        try heading @@ List.assoc n !titles_and_headings
+        with Not_found -> fallback_heading
+      in
+      f ^ (self#texi_of_text t) ^ "\n"
+
+    method fixedblock t =
+      Block ( ( Verbatim "@t{" :: t ) @ [ Verbatim "}" ] )
+
+  end
+
+exception Aliased_node
+
+module Generator =
+struct
+
+(** This class is used to create objects which can generate a simple
+    Texinfo documentation. *)
+class texi =
+  object (self)
+    inherit text
+    inherit Odoc_to_text.to_text as to_text
+
+    (** {2 Small helper stuff.} *)
+
+    val maxdepth = 4
+
+    val bullet = Verbatim " @bullet{} "
+    val minus  = Verbatim " @minus{} "
+    val linebreak =  Verbatim "@*\n"
+
+    val mutable indices_to_build = [ `Module ]
+
+    (** Keep a set of nodes we create. If we try to create one
+        a second time, that means it is some kind of alias, so
+        don't do it, just link to the previous one *)
+    val node_tbl = Hashtbl.create 37
+
+    method node depth name =
+      if Hashtbl.mem node_tbl name
+      then raise Aliased_node ;
+      Hashtbl.add node_tbl name () ;
+      if depth <= maxdepth
+      then Verbatim ("@node " ^ (Texi.fix_nodename name) ^ ",\n")
+      else nothing
+
+    method index (ind : indices) ent =
+      Verbatim
+        (if !Global.with_index
+        then (assert(List.mem ind indices_to_build) ;
+              String.concat ""
+                [ "@" ; indices ind ; "index " ;
+                  Texi.escape (Name.simple ent) ; "\n" ])
+        else "")
+
+
+    (** Two hacks to fix linebreaks in the descriptions.*)
+    method private fix_linebreaks =
+      let re = Str.regexp "\n[ \t]*" in
+      fun t ->
+        List.map
+          (function
+            | Newline -> Raw "\n"
+            | Raw s -> Raw (Str.global_replace re "\n" s)
+            | List tel -> List (List.map self#fix_linebreaks tel)
+            | Enum tel -> Enum (List.map self#fix_linebreaks tel)
+            | txt -> txt) t
+
+    method private soft_fix_linebreaks =
+      let re = Str.regexp "\n[ \t]*" in
+      fun ind t ->
+        let rep = "\n" ^ String.make ind ' ' in
+        List.map
+          (function
+            | Raw s -> Raw (Str.global_replace re rep s)
+            | txt -> txt) t
+
+    (** {2 [text] values generation}
+       Generates [text] values out of description parts.
+       Redefines some of methods of {! Odoc_to_text.to_text}. *)
+
+    method text_of_desc = function
+      | None -> []
+      | Some [ Raw "" ] -> []
+      | Some t -> (self#fix_linebreaks t) @ [ Newline ]
+
+    method text_of_sees_opt see_l =
+      List.concat
+        (List.map
+           (function
+             | (See_url s, t) ->
+                 [ linebreak ; Bold [ Raw Odoc_messages.see_also ] ;
+                   Raw " " ; Link (s, t) ; Newline ]
+             | (See_file s, t)
+             | (See_doc s, t)  ->
+                 [ linebreak ; Bold [ Raw Odoc_messages.see_also ] ;
+                   Raw " " ; Raw s ] @ t @ [ Newline ])
+           see_l)
+
+    method! text_of_before l =
+      List.flatten
+      (List.map
+        (fun x -> linebreak :: (to_text#text_of_before [x])) l)
+
+    method text_of_params params_list =
+        List.concat
+          (List.map
+             (fun (s, t) ->
+               [ linebreak ;
+                 Bold [ Raw Odoc_messages.parameters ] ;
+                 Raw " " ; Raw s ; Raw ": " ] @ t @ [ Newline ] )
+             params_list)
+
+    method! text_of_raised_exceptions = function
+      | [] -> []
+      | (s, t) :: [] ->
+          [ linebreak ;
+            Bold [ Raw Odoc_messages.raises ] ;
+            Raw " " ; Code s ; Raw " " ]
+          @ t @ [ Newline ]
+      | l ->
+          [ linebreak ;
+            Bold [ Raw Odoc_messages.raises ] ;
+            Raw " :" ;
+            List
+              (List.map
+                 (fun (ex, desc) ->(Code ex) :: (Raw " ") :: desc ) l ) ;
+            Newline ]
+
+    method! text_of_return_opt = function
+      | None -> []
+      | Some t ->
+          (Bold [Raw Odoc_messages.returns ]) :: Raw " " :: t @ [ Newline ]
+
+    method! text_of_custom c_l =
+      List.flatten
+        (List.rev
+           (List.fold_left
+              (fun acc -> fun (tag, text) ->
+                try
+                  let f = List.assoc tag tag_functions in
+                  ( linebreak :: (f text) @ [ Newline ] ) :: acc
+                with
+               Not_found ->
+                 Odoc_info.warning (Odoc_messages.tag_not_handled tag) ;
+                 acc
+              ) [] c_l))
+
+    method! text_of_info ?(block=false) = function
+      | None -> []
+      | Some info ->
+          let t =
+            List.concat
+                 [ ( match info.i_deprecated with
+                 | None -> []
+                 | Some t ->
+                     (Raw (Odoc_messages.deprecated ^ " ")) ::
+                     (self#fix_linebreaks t)
+                     @ [ Newline ; Newline ] ) ;
+                   self#text_of_desc info.i_desc ;
+                   if info.i_authors <> []
+                   then ( linebreak ::
+                          self#text_of_author_list info.i_authors )
+                   else [] ;
+                   if is info.i_version
+                   then ( linebreak ::
+                          self#text_of_version_opt info.i_version )
+                   else [] ;
+                   self#text_of_sees_opt info.i_sees ;
+                   self#text_of_before info.i_before ;
+                   if is info.i_since
+                   then ( linebreak ::
+                          self#text_of_since_opt info.i_since )
+                   else [] ;
+                   self#text_of_params info.i_params ;
+                   self#text_of_raised_exceptions info.i_raised_exceptions ;
+                   if is info.i_return_value
+                   then ( linebreak ::
+                          self#text_of_return_opt info.i_return_value )
+                   else [] ;
+                   self#text_of_custom info.i_custom ;
+                 ] in
+          if block
+          then [ Block t ]
+          else (t @ [ Newline ] )
+
+    method texi_of_info i =
+      self#texi_of_text (self#text_of_info i)
+
+    (** {2 Conversion of [module_elements] into Texinfo strings}
+       The following functions convert [module_elements] and their
+       description to [text] values then to Texinfo strings using the
+       functions above. *)
+
+    method text_el_of_type_expr m_name typ =
+      Raw (indent 5
+             (self#relative_idents m_name
+                (Odoc_info.string_of_type_expr typ)))
+
+    method! text_of_short_type_expr m_name typ =
+      [ Raw (self#normal_type m_name typ) ]
+
+    (** Return Texinfo code for a value. *)
+    method texi_of_value v =
+      Odoc_info.reset_type_names () ;
+      let t = [ self#fixedblock
+                  [ Newline ; minus ;
+                    Raw ("val " ^ (Name.simple v.val_name) ^ " :\n") ;
+                    self#text_el_of_type_expr
+                      (Name.father v.val_name) v.val_type ] ;
+                self#index `Value v.val_name ; Newline  ] @
+                (self#text_of_info v.val_info) in
+      self#texi_of_text t
+
+
+    (** Return Texinfo code for a class attribute. *)
+    method texi_of_attribute a =
+      Odoc_info.reset_type_names () ;
+      let t = [ self#fixedblock
+                  [ Newline ; minus ;
+                    Raw "val " ;
+                    Raw (if a.att_virtual then "virtual " else "") ;
+                    Raw (if a.att_mutable then "mutable " else "") ;
+                    Raw (Name.simple a.att_value.val_name) ;
+                    Raw " :\n" ;
+                    self#text_el_of_type_expr
+                      (Name.father a.att_value.val_name)
+                      a.att_value.val_type ] ;
+                self#index `Class_att a.att_value.val_name  ; Newline ] @
+        (self#text_of_info a.att_value.val_info) in
+      self#texi_of_text t
+
+
+    (** Return Texinfo code for a class method. *)
+    method texi_of_method m =
+      Odoc_info.reset_type_names () ;
+      let t = [ self#fixedblock
+                  [ Newline ; minus ; Raw "method " ;
+                    Raw (if m.met_private then "private " else "") ;
+                    Raw (if m.met_virtual then "virtual " else "") ;
+                    Raw (Name.simple m.met_value.val_name) ;
+                    Raw " :\n" ;
+                    self#text_el_of_type_expr
+                      (Name.father m.met_value.val_name)
+                      m.met_value.val_type ] ;
+                self#index `Method m.met_value.val_name ; Newline ] @
+        (self#text_of_info m.met_value.val_info) in
+      self#texi_of_text t
+
+
+    method string_of_type_parameters t =
+      let f (tp, co, cn) =
+        Printf.sprintf "%s%s"
+          (Odoc_info.string_of_variance t (co, cn))
+          (Odoc_info.string_of_type_expr tp)
+      in
+      match t.ty_parameters with
+      | [] -> ""
+      | [ (tp, co, cn) ] ->
+          (f (tp, co, cn))^" "
+      | l ->
+          Printf.sprintf "(%s) "
+            (String.concat ", " (List.map f l))
+
+    method string_of_type_args (args:constructor_args) (ret:Types.type_expr option) =
+      let f = function
+        | Cstr_tuple l -> Odoc_info.string_of_type_list " * " l
+        | Cstr_record l -> Odoc_info.string_of_record l
+      in
+      match args, ret with
+      | Cstr_tuple [], None -> ""
+      | args, None -> " of " ^ (f args)
+      | Cstr_tuple [], Some r -> " : " ^ (Odoc_info.string_of_type_expr r)
+      | args, Some r -> " : " ^ (f args) ^
+                                " -> " ^ (Odoc_info.string_of_type_expr r)
+
+    (** Return Texinfo code for a type. *)
+    method texi_of_type ty =
+      Odoc_info.reset_type_names () ;
+      let entry_doc = function
+        | None -> [ Newline ]
+        | Some t ->
+          (Raw (indent 5 "\n(*\n") :: (self#soft_fix_linebreaks 8 (self#text_of_info (Some t))))
+          @ [ Raw " *)" ; Newline ]
+      in
+      let t =
+        [ self#fixedblock (
+          [ Newline ; minus ; Raw "type " ;
+            Raw (self#string_of_type_parameters ty) ;
+            Raw (Name.simple ty.ty_name) ] @
+          let priv = ty.ty_private = Asttypes.Private in
+          ( match ty.ty_manifest with
+          | None -> []
+          | Some (Other typ) ->
+              (Raw " = ") ::
+              (Raw (if priv then "private " else "")) ::
+              (self#text_of_short_type_expr (Name.father ty.ty_name) typ)
+          | Some (Object_type l) ->
+               (Raw (" = "^(if priv then "private " else "")^"{\n")) ::
+               (List.flatten
+                  (List.map
+                     (fun r ->
+                       [ Raw ("  " ^ r.of_name ^ " : ") ] @
+                       (self#text_of_short_type_expr
+                          (Name.father r.of_name)
+                          r.of_type) @
+                       [ Raw " ;" ] @
+                       (entry_doc r.of_text))
+                     l ) )
+               @  [ Raw " }" ]
+          ) @
+          (
+           match ty.ty_kind with
+           | Type_abstract -> [ Newline ]
+           | Type_variant l ->
+               (Raw (" ="^(if priv then " private" else "")^"\n")) ::
+               (List.flatten
+                  (List.map
+                     (fun constr ->
+                       (Raw ("  | " ^ constr.vc_name)) ::
+                       (Raw (self#string_of_type_args
+                               constr.vc_args constr.vc_ret)) ::
+                         (entry_doc constr.vc_text)
+                         ) l ) )
+           | Type_record l ->
+               (Raw (" = "^(if priv then "private " else "")^"{\n")) ::
+               (List.flatten
+                  (List.map
+                     (fun r ->
+                       [ Raw ("  " ^ r.rf_name ^ " : ") ] @
+                       (self#text_of_short_type_expr
+                          (Name.father r.rf_name)
+                          r.rf_type) @
+                       [ Raw " ;" ] @
+                        (entry_doc r.rf_text)
+                        )
+                     l ) )
+               @  [ Raw " }" ]
+           | Type_open -> [ Raw " = .." ; Newline ]
+          ) ) ;
+          self#index `Type ty.ty_name ; Newline ] @
+        (self#text_of_info ty.ty_info) in
+      self#texi_of_text t
+
+    (** Return Texinfo code for a type extension. *)
+    method texi_of_type_extension m_name te =
+      Odoc_info.reset_type_names () ;
+      let t =
+        ( self#fixedblock (
+            [ Newline ; minus ;
+              Raw "type " ;
+              Raw (match te.te_type_parameters with
+                     | [] -> ""
+                     | [ tp ] ->
+                         Printf.sprintf "%s "
+                           (Odoc_info.string_of_type_expr tp)
+                     | l ->
+                         Printf.sprintf "(%s) "
+                           (String.concat ", "
+                              (List.map Odoc_info.string_of_type_expr l))) ;
+              Raw (self#relative_idents m_name te.te_type_name) ;
+              Raw (" +=" ^
+                      (if te.te_private = Asttypes.Private
+                       then " private" else "")^"\n") ] @
+              (List.flatten
+                 (List.map
+                    (fun x ->
+                       (Raw ("  | " ^ (Name.simple x.xt_name))) ::
+                         (Raw (self#string_of_type_args
+                                 x.xt_args x.xt_ret)) ::
+                         (match x.xt_alias with
+                            | None -> []
+                            | Some xa ->
+                                [ Raw " = " ;
+                                  Raw ( match xa.xa_xt with
+                                          | None -> xa.xa_name
+                                          | Some x -> x.xt_name ) ]) @
+                         (match x.xt_text with
+                            | None -> [ Newline ]
+                            | Some t ->
+                                (Raw (indent 5 "\n(* ") ::
+                                   self#soft_fix_linebreaks 8
+                                     (self#text_of_info (Some t))) @
+                                  [ Raw " *)" ; Newline ] ) @
+                         [self#index `Extension x.xt_name ] )
+                    te.te_constructors ) ) ) ) ::
+          (self#text_of_info te.te_info) in
+        self#texi_of_text t
+
+    (** Return Texinfo code for an exception. *)
+    method texi_of_exception e =
+      Odoc_info.reset_type_names () ;
+      let t =
+        [ self#fixedblock
+            ( [ Newline ; minus ; Raw "exception " ;
+                Raw (Name.simple e.ex_name) ;
+                Raw (self#string_of_type_args e.ex_args e.ex_ret) ] @
+              (match e.ex_alias with
+              | None -> []
+              | Some ea -> [ Raw " = " ; Raw
+                               ( match ea.ea_ex with
+                               | None -> ea.ea_name
+                               | Some e -> e.ex_name ) ; ]
+              ) ) ;
+          self#index `Exception e.ex_name ; Newline ] @
+        (self#text_of_info e.ex_info) in
+      self#texi_of_text t
+
+
+    (** Return the Texinfo code for the given module. *)
+    method texi_of_module m =
+      let is_alias = function
+        | { m_kind = Module_alias _ } -> true
+        | _ -> false in
+      let is_alias_there = function
+        | { m_kind = Module_alias { ma_module = None } } -> false
+        | _ -> true in
+      let resolve_alias_name = function
+        | { m_kind = Module_alias { ma_name = name } } -> name
+        | { m_name = name } -> name in
+      let t =
+        [ [ self#fixedblock
+              [ Newline ; minus ; Raw "module " ;
+                Raw (Name.simple m.m_name) ;
+                Raw (if is_alias m
+                then " = " ^ (resolve_alias_name m)
+                else "" ) ] ] ;
+          ( if is_alias_there m
+          then [ Ref (resolve_alias_name m, Some RK_module, None) ;
+                 Newline ; ]
+          else [] ) ;
+          ( if is_alias m
+          then [ self#index `Module m.m_name ; Newline ]
+          else [ Newline ] ) ;
+          self#text_of_info m.m_info ]
+      in
+      self#texi_of_text (List.flatten t)
+
+    (** Return the Texinfo code for the given module type. *)
+    method texi_of_module_type mt =
+      let is_alias = function
+        | { mt_kind = Some (Module_type_alias _) } -> true
+        | _ -> false in
+      let is_alias_there = function
+        | { mt_kind = Some (Module_type_alias { mta_module = None }) } -> false
+        | _ -> true in
+      let resolve_alias_name = function
+        | { mt_kind = Some (Module_type_alias { mta_name = name }) } -> name
+        | { mt_name = name } -> name in
+      let t =
+        [ [ self#fixedblock
+              [ Newline ; minus ; Raw "module type " ;
+                Raw (Name.simple mt.mt_name) ;
+                Raw (if is_alias mt
+                then " = " ^ (resolve_alias_name mt)
+                else "" ) ] ] ;
+          ( if is_alias_there mt
+          then [ Ref (resolve_alias_name mt, Some RK_module_type, None) ;
+                 Newline ; ]
+          else [] ) ;
+          ( if is_alias mt
+          then [ self#index `Module_type mt.mt_name ; Newline ]
+          else [ Newline ] ) ;
+          self#text_of_info mt.mt_info ]
+      in
+      self#texi_of_text (List.flatten t)
+
+    (** Return the Texinfo code for the given included module. *)
+    method texi_of_included_module im =
+      let t = [ self#fixedblock
+                  ( Newline :: minus :: (Raw "include ") ::
+                    ( match im.im_module with
+                    | None ->
+                        [ Raw im.im_name ]
+                    | Some (Mod { m_name = name }) ->
+                        [ Raw name ; Raw "\n     " ;
+                          Ref (name, Some RK_module, None) ]
+                    | Some (Modtype { mt_name = name }) ->
+                        [ Raw name ; Raw "\n     " ;
+                          Ref (name, Some RK_module_type, None) ]
+                    ) @
+                   [ Newline ] @
+                   (self#text_of_info im.im_info)
+                  )
+              ]
+      in
+      self#texi_of_text t
+
+    (** Return the Texinfo code for the given class. *)
+    method texi_of_class c =
+      Odoc_info.reset_type_names () ;
+      let t = [ self#fixedblock
+                  [ Newline ; minus ; Raw "class " ;
+                    Raw (Name.simple c.cl_name) ] ;
+                Ref (c.cl_name, Some RK_class, None) ; Newline ;
+                Newline ] @ (self#text_of_info c.cl_info) in
+      self#texi_of_text t
+
+    (** Return the Texinfo code for the given class type. *)
+    method texi_of_class_type ct =
+      Odoc_info.reset_type_names () ;
+      let t = [ self#fixedblock
+                  [ Newline ; minus ; Raw "class type " ;
+                    Raw (Name.simple ct.clt_name) ] ;
+                Ref (ct.clt_name, Some RK_class_type, None) ; Newline ;
+                Newline ] @ (self#text_of_info ct.clt_info) in
+      self#texi_of_text t
+
+    (** Return the Texinfo code for the given class element. *)
+    method texi_of_class_element _class_name class_ele =
+      match class_ele with
+      | Class_attribute att -> self#texi_of_attribute att
+      | Class_method met -> self#texi_of_method met
+      | Class_comment t -> self#texi_of_text t
+
+    (** Return the Texinfo code for the given module element. *)
+    method texi_of_module_element module_name module_ele =
+      (match module_ele with
+      | Element_module m -> self#texi_of_module m
+      | Element_module_type mt -> self#texi_of_module_type mt
+      | Element_included_module im -> self#texi_of_included_module im
+      | Element_class c -> self#texi_of_class c
+      | Element_class_type ct -> self#texi_of_class_type ct
+      | Element_value v -> self#texi_of_value v
+      | Element_type_extension te -> self#texi_of_type_extension module_name te
+      | Element_exception e -> self#texi_of_exception e
+      | Element_type t -> self#texi_of_type t
+      | Element_module_comment t ->
+          self#texi_of_text (Newline :: t @ [Newline])
+      )
+
+    (** {2 Generating methods }
+       These methods write Texinfo code to an [out_channel] *)
+
+    (** Generate the Texinfo code for the given list of inherited classes.*)
+    method generate_inheritance_info chanout inher_l =
+      let f inh =
+        match inh.ic_class with
+        | None -> (* we can't make the reference *)
+            (Code inh.ic_name) ::
+            (match inh.ic_text with
+            | None -> []
+            | Some t -> Newline :: t)
+        | Some cct -> (* we can create the reference *)
+            let kind =
+              match cct with
+              | Cl _ -> Some RK_class
+              | Cltype _ -> Some RK_class_type in
+            (Code inh.ic_name) ::
+            (Ref (inh.ic_name, kind, None)) ::
+            ( match inh.ic_text with
+            | None -> []
+            | Some t -> Newline :: t)
+      in
+      let text = [
+        Bold [ Raw Odoc_messages.inherits ] ;
+        List (List.map f inher_l) ; Newline ]
+      in
+      puts chanout (self#texi_of_text text)
+
+
+
+    (** Generate the Texinfo code for the inherited classes
+       of the given class. *)
+    method generate_class_inheritance_info chanout cl =
+      let rec iter_kind = function
+        | Class_structure ([], _) -> ()
+        | Class_structure (l, _) ->
+            self#generate_inheritance_info chanout l
+        | Class_constraint (k, _) -> iter_kind k
+        | Class_apply _
+        | Class_constr _ -> ()
+      in
+      iter_kind cl.cl_kind
+
+
+
+    (** Generate the Texinfo code for the inherited classes
+       of the given class type. *)
+    method generate_class_type_inheritance_info chanout clt =
+      match clt.clt_kind with
+      | Class_signature ([], _) ->
+          ()
+      | Class_signature (l, _) ->
+          self#generate_inheritance_info chanout l
+      | Class_type _ ->
+          ()
+
+    (** Generate the Texinfo code for the given class,
+       in the given out channel. *)
+    method generate_for_class chanout c =
+     try
+      Odoc_info.reset_type_names () ;
+      let depth = Name.depth c.cl_name in
+      let title = [
+        self#node depth c.cl_name ;
+        Title (depth, None, [ Raw (Odoc_messages.clas ^ " ") ;
+                                    Code c.cl_name ]) ;
+        self#index `Class c.cl_name ] in
+      puts chanout (self#texi_of_text title) ;
+
+      if is c.cl_info
+      then begin
+        let descr = [ Title (succ depth, None,
+                             [ Raw Odoc_messages.description ]) ] in
+        puts chanout (self#texi_of_text descr) ;
+        puts chanout (self#texi_of_info c.cl_info)
+      end ;
+
+      let intf = [ Title (succ depth, None,
+                          [ Raw Odoc_messages.interface]) ] in
+      puts chanout (self#texi_of_text intf);
+      self#generate_class_inheritance_info chanout c ;
+      List.iter
+        (fun ele -> puts chanout
+            (self#texi_of_class_element c.cl_name ele))
+        (Class.class_elements ~trans:false c)
+     with Aliased_node -> ()
+
+
+    (** Generate the Texinfo code for the given class type,
+       in the given out channel. *)
+    method generate_for_class_type chanout ct =
+     try
+      Odoc_info.reset_type_names () ;
+      let depth = Name.depth ct.clt_name in
+      let title = [
+        self#node depth ct.clt_name ;
+        Title (depth, None, [ Raw (Odoc_messages.class_type ^ " ") ;
+                                    Code ct.clt_name ]) ;
+        self#index `Class_type ct.clt_name ] in
+      puts chanout (self#texi_of_text title) ;
+
+      if is ct.clt_info
+      then begin
+        let descr = [ Title (succ depth, None,
+                             [ Raw Odoc_messages.description ]) ] in
+        puts chanout (self#texi_of_text descr) ;
+        puts chanout (self#texi_of_info ct.clt_info)
+      end ;
+
+      let intf = [ Title (succ depth, None,
+                          [ Raw Odoc_messages.interface ]) ] in
+      puts chanout (self#texi_of_text intf) ;
+      self#generate_class_type_inheritance_info chanout ct;
+      List.iter
+        (fun ele -> puts chanout
+            (self#texi_of_class_element ct.clt_name ele))
+        (Class.class_type_elements ~trans:false ct)
+     with Aliased_node -> ()
+
+
+    (** Generate the Texinfo code for the given module type,
+       in the given out channel. *)
+    method generate_for_module_type chanout mt =
+     try
+      let depth = Name.depth mt.mt_name in
+      let title = [
+        self#node depth mt.mt_name ;
+        Title (depth, None, [ Raw (Odoc_messages.module_type ^ " ") ;
+                              Code mt.mt_name ]) ;
+        self#index `Module_type mt.mt_name ; Newline ] in
+      puts chanout (self#texi_of_text title) ;
+
+      if is mt.mt_info
+      then begin
+        let descr = [ Title (succ depth, None,
+                             [ Raw Odoc_messages.description ]) ] in
+        puts chanout (self#texi_of_text descr) ;
+        puts chanout (self#texi_of_info mt.mt_info)
+      end ;
+
+      let mt_ele = Module.module_type_elements ~trans:true mt in
+      let subparts = module_subparts mt_ele in
+      if depth < maxdepth && subparts <> []
+      then begin
+        let menu = Texi.ifinfo
+            ( self#heading (succ depth) [ Raw "Subparts" ]) in
+        puts chanout menu ;
+        Texi.generate_menu chanout (subparts :> menu_data)
+      end ;
+
+      let intf = [ Title (succ depth, None,
+                          [ Raw Odoc_messages.interface ]) ] in
+      puts chanout (self#texi_of_text intf) ;
+      List.iter
+        (fun ele -> puts chanout
+            (self#texi_of_module_element mt.mt_name ele))
+        mt_ele ;
+
+      (* create sub parts for modules, module types, classes and class types *)
+      List.iter
+        (function
+          | `Module m -> self#generate_for_module chanout m
+          | `Module_type mt -> self#generate_for_module_type chanout mt
+          | `Class c -> self#generate_for_class chanout c
+          | `Class_type ct -> self#generate_for_class_type chanout ct)
+        subparts
+     with Aliased_node -> ()
+
+    (** Generate the Texinfo code for the given module,
+       in the given out channel. *)
+    method generate_for_module chanout m =
+     try
+      Odoc_info.verbose ("Generate for module " ^ m.m_name) ;
+      let depth = Name.depth m.m_name in
+      let title = [
+        self#node depth m.m_name ;
+        Title (depth, None,
+               if m.m_text_only then
+                 [ Raw m.m_name ]
+               else
+                 [ Raw (Odoc_messages.modul ^ " ") ;
+                   Code m.m_name ]
+              ) ;
+        self#index `Module m.m_name ; Newline ] in
+      puts chanout (self#texi_of_text title) ;
+
+      if is m.m_info
+      then begin
+        let descr = [ Title (succ depth, None,
+                             [ Raw Odoc_messages.description ]) ] in
+        puts chanout (self#texi_of_text descr) ;
+        puts chanout (self#texi_of_info m.m_info)
+      end ;
+
+      let m_ele = Module.module_elements ~trans:true m in
+      let subparts = module_subparts m_ele in
+      if depth < maxdepth && subparts <> []
+      then begin
+        let menu = Texi.ifinfo
+            ( self#heading (succ depth) [ Raw "Subparts" ]) in
+        puts chanout menu ;
+        Texi.generate_menu chanout (subparts :> menu_data)
+      end ;
+
+      let intf = [ Title (succ depth, None,
+                          [ Raw Odoc_messages.interface]) ] in
+      puts chanout (self#texi_of_text intf) ;
+
+      List.iter
+        (fun ele -> puts chanout
+            (self#texi_of_module_element m.m_name ele))
+        m_ele ;
+
+      (* create sub nodes for modules, module types, classes and class types *)
+      List.iter
+        (function
+          | `Module m -> self#generate_for_module chanout m
+          | `Module_type mt -> self#generate_for_module_type chanout mt
+          | `Class c -> self#generate_for_class chanout c
+          | `Class_type ct -> self#generate_for_class_type chanout ct )
+        subparts
+     with Aliased_node -> ()
+
+
+    (** Writes the header of the TeXinfo document. *)
+    method generate_texi_header chan texi_filename m_list =
+      let title = match !Global.title with
+      | None -> ""
+      | Some s -> self#escape s in
+      let filename =
+        if texi_filename <> "ocamldoc.texi"
+        then
+          let fn = Filename.basename texi_filename in
+          (if Filename.check_suffix fn ".texi"
+          then Filename.chop_suffix fn ".texi"
+          else fn) ^ ".info"
+        else
+          if title <> ""
+          then title ^ ".info"
+          else "doc.info"
+      in
+      (* write a standard Texinfo header *)
+      List.iter
+        (puts_nl chan)
+        (List.flatten
+           [ [ "\\input texinfo   @c -*-texinfo-*-" ;
+               "@c %**start of header" ;
+               "@setfilename " ^ filename ;
+               "@settitle " ^ title ;
+               "@c %**end of header" ; ] ;
+
+             (if !Global.with_index then
+               List.map
+                 (fun ind ->
+                   "@defcodeindex " ^ (indices ind))
+                 indices_to_build
+             else []) ;
+
+             [ Texi.dirsection !info_section ] ;
+
+             Texi.direntry
+               (if !info_entry <> []
+               then !info_entry
+               else [ Printf.sprintf "* %s: (%s)."
+                        title
+                        (Filename.chop_suffix filename ".info") ]) ;
+
+             [ "@ifinfo" ;
+               "This file was generated by Ocamldoc using the Texinfo generator." ;
+               "@end ifinfo" ;
+
+               "@c no titlepage." ;
+
+               "@node Top, , , (dir)" ;
+               "@top "^ title ; ]
+           ] ) ;
+
+      (* insert the intro file *)
+      begin
+        match !Odoc_info.Global.intro_file with
+        | None when title <> "" ->
+            puts_nl chan "@ifinfo" ;
+            puts_nl chan ("Documentation for " ^ title) ;
+            puts_nl chan "@end ifinfo"
+        | None ->
+            puts_nl chan "@c no title given"
+        | Some f ->
+            nl chan ;
+            puts_nl chan
+              (self#texi_of_info
+                 (Some (Odoc_info.info_of_comment_file m_list f)))
+      end ;
+
+      (* write a top menu *)
+      Texi.generate_menu chan
+        ((List.map (fun m -> `Module m) m_list) @
+         (if !Global.with_index then
+           let indices_names_to_build = List.map indices indices_to_build in
+           List.rev
+             (List.fold_left
+                (fun acc ->
+                  function (longname, shortname)
+                      when List.mem shortname indices_names_to_build ->
+                        (`Index (longname ^ " index")) :: acc
+                    | _ -> acc)
+                [ `Comment "Indices :" ; `Blank ]
+                indices_names )
+         else [] ))
+
+
+    (** Writes the trailer of the TeXinfo document. *)
+    method generate_texi_trailer chan =
+      nl chan ;
+      if !Global.with_index
+      then
+        let indices_names_to_build = List.map indices indices_to_build in
+        List.iter (puts_nl chan)
+          (List.flatten
+             (List.map
+                (fun (longname, shortname) ->
+                  if List.mem shortname indices_names_to_build
+                  then [ "@node " ^ longname ^ " index," ;
+                         "@unnumbered " ^ longname ^ " index" ;
+                         "@printindex " ^ shortname ; ]
+                  else [])
+                indices_names )) ;
+      if !Global.with_toc
+      then puts_nl chan "@contents" ;
+      puts_nl chan "@bye"
+
+
+    method do_index it =
+      if not (List.mem it indices_to_build)
+      then indices_to_build <- it :: indices_to_build
+
+   (** Scan the whole module information to know which indices need to be build *)
+    method scan_for_index : subparts -> unit = function
+      | `Module m ->
+          let m_ele = Module.module_elements ~trans:true m in
+          List.iter self#scan_for_index_in_mod m_ele
+      | `Module_type mt ->
+          let m_ele = Module.module_type_elements ~trans:true mt in
+          List.iter self#scan_for_index_in_mod m_ele
+      | `Class c ->
+          let c_ele = Class.class_elements ~trans:true c in
+          List.iter self#scan_for_index_in_class c_ele
+      | `Class_type ct ->
+          let c_ele = Class.class_type_elements ~trans:true ct in
+          List.iter self#scan_for_index_in_class c_ele
+
+    method scan_for_index_in_mod = function
+        (* no recursion *)
+      | Element_value _ -> self#do_index `Value
+      | Element_type_extension _ -> self#do_index `Extension
+      | Element_exception _ -> self#do_index `Exception
+      | Element_type _ -> self#do_index `Type
+      | Element_included_module _
+      | Element_module_comment _ -> ()
+         (* recursion *)
+      | Element_module m -> self#do_index `Module ;
+          self#scan_for_index (`Module m)
+      | Element_module_type mt -> self#do_index `Module_type ;
+          self#scan_for_index (`Module_type mt)
+      | Element_class c -> self#do_index `Class ;
+          self#scan_for_index (`Class c)
+      | Element_class_type ct -> self#do_index `Class_type ;
+          self#scan_for_index (`Class_type ct)
+
+    method scan_for_index_in_class = function
+      | Class_attribute _ -> self#do_index `Class_att
+      | Class_method _ -> self#do_index `Method
+      | Class_comment _ -> ()
+
+
+    (** Generate the Texinfo file from a module list,
+       in the {!Odoc_info.Global.out_file} file. *)
+    method generate module_list =
+      Hashtbl.clear node_tbl ;
+      let filename =
+        if !Global.out_file = Odoc_messages.default_out_file
+        then "ocamldoc.texi"
+        else !Global.out_file in
+      if !Global.with_index
+      then List.iter self#scan_for_index
+          (List.map (fun m -> `Module m) module_list) ;
+      try
+        let chanout = open_out
+            (Filename.concat !Global.target_dir filename) in
+        if !Global.with_header
+        then self#generate_texi_header chanout filename module_list ;
+        List.iter
+          (self#generate_for_module chanout)
+          module_list ;
+        if !Global.with_trailer
+        then self#generate_texi_trailer chanout ;
+        close_out chanout
+      with
+      | Failure s
+      | Sys_error s ->
+          prerr_endline s ;
+          incr Odoc_info.errors
+  end
+end
+
+module type Texi_generator = module type of Generator
diff --git a/ocamldoc/odoc_text.ml b/ocamldoc/odoc_text.ml
new file mode 100644
index 00000000..889bb5fb
--- /dev/null
+++ b/ocamldoc/odoc_text.ml
@@ -0,0 +1,169 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+exception Text_syntax of int * int * string (* line, char, string *)
+
+open Odoc_types
+
+module Texter =
+  struct
+    (* builds a text structure from a string. *)
+    let text_of_string s =
+      let lexbuf = Lexing.from_string s in
+      try
+        Odoc_text_lexer.init ();
+        Odoc_text_parser.main Odoc_text_lexer.main lexbuf
+      with
+        _ ->
+          raise (Text_syntax (!Odoc_text_lexer.line_number,
+                              !Odoc_text_lexer.char_number,
+                              s)
+                )
+
+    let count s c =
+      let count = ref 0 in
+      for i = 0 to String.length s - 1 do
+        if s.[i] = c then incr count
+      done;
+      !count
+
+    let escape_n s c n =
+      let remain = ref n in
+      let len = String.length s in
+      let b = Buffer.create (len + n) in
+      for i = 0 to len - 1 do
+        if s.[i] = c && !remain > 0 then
+          (
+           Printf.bprintf b "\\%c" c;
+           decr remain
+          )
+        else
+          Buffer.add_char b s.[i]
+      done;
+      Buffer.contents b
+
+    let escape_code s =
+      let open_brackets = count s '[' in
+      let close_brackets = count s ']' in
+      if open_brackets > close_brackets then
+        escape_n s '[' (open_brackets - close_brackets)
+      else
+        if close_brackets > open_brackets then
+          escape_n s ']' (close_brackets - open_brackets)
+        else
+          s
+
+    let escape_raw s =
+      let len = String.length s in
+      let b = Buffer.create len in
+      for i = 0 to len - 1 do
+        match s.[i] with
+          '[' | ']' | '{' | '}' ->
+            Printf.bprintf b "\\%c" s.[i]
+        | c ->
+            Buffer.add_char b c
+      done;
+      Buffer.contents b
+
+    let p = Printf.bprintf
+
+    let rec p_text b t =
+      List.iter (p_text_element b) t
+
+    and p_list b l =
+      List.iter
+        (fun t -> p b "{- " ; p_text b t ; p b "}\n")
+        l
+
+    and p_text_element b = function
+      | Raw s -> p b "%s" (escape_raw s)
+      | Code s -> p b "[%s]" (escape_code s)
+      | CodePre s -> p b "{[%s]}" s
+      | Verbatim s -> p b "{v %s v}" s
+      | Bold t -> p b "{b " ; p_text b t ; p b "}"
+      | Italic t -> p b "{i " ; p_text b t ; p b "}"
+      | Emphasize t -> p b "{e " ; p_text b t ; p b "}"
+      | Center t -> p b "{C " ; p_text b t ; p b "}"
+      | Left t -> p b "{L " ; p_text b t ; p b "}"
+      | Right t -> p b "{R " ; p_text b t ; p b "}"
+      | List l -> p b "{ul\n"; p_list b l; p b "}"
+      | Enum l -> p b "{ol\n"; p_list b l; p b "}"
+      | Newline -> p b "\n"
+      | Block  t -> p_text b t
+      | Title (n, l_opt, t) ->
+          p b "{%d%s "
+            n
+            (match l_opt with
+              None -> ""
+            | Some s -> ":"^s
+            );
+          p_text b t ;
+          p b "}"
+      | Latex s -> p b "{%% %s%%}" s
+      | Link (s,t) ->
+          p b "{{:%s}" s;
+          p_text b t ;
+          p b "}"
+      | Ref (name, kind_opt, text_opt) ->
+        begin
+          p b "%s{!%s%s}"
+            (match text_opt with None -> "" | Some _ -> "{")
+            (match kind_opt with
+               None -> ""
+             | Some k ->
+                 let s =
+                   match k with
+                     RK_module -> "module"
+                   | RK_module_type -> "modtype"
+                   | RK_class -> "class"
+                   | RK_class_type -> "classtype"
+                   | RK_value -> "val"
+                   | RK_type -> "type"
+                   | RK_extension -> "extension"
+                   | RK_exception -> "exception"
+                   | RK_attribute -> "attribute"
+                   | RK_method -> "method"
+                   | RK_section _ -> "section"
+                   | RK_recfield -> "recfield"
+                   | RK_const -> "const"
+                 in
+                 s^":"
+            )
+            name;
+          match text_opt with
+            None -> ()
+          | Some t -> p_text b t; p b "}"
+        end
+      | Superscript t -> p b "{^" ; p_text b t ; p b "}"
+      | Subscript t -> p b "{_" ; p_text b t ; p b "}"
+      | Module_list l ->
+          p b "{!modules:";
+          List.iter (fun s -> p b " %s" s) l;
+          p b "}"
+      | Index_list ->
+          p b "{!indexlist}"
+      | Custom (s,t) ->
+          p b "{%s " s;
+          p_text b t;
+          p b "}"
+      | Target (target, code) ->
+          p b "{%%%s: %s}" target (escape_raw code)
+
+    let string_of_text s =
+      let b = Buffer.create 256 in
+      p_text b s;
+      Buffer.contents b
+
+  end
diff --git a/ocamldoc/odoc_text.mli b/ocamldoc/odoc_text.mli
new file mode 100644
index 00000000..409acaad
--- /dev/null
+++ b/ocamldoc/odoc_text.mli
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** A module with a function to parse strings to obtain a [Odoc_types.text] value. *)
+
+(** Syntax error in a text. *)
+exception Text_syntax of int * int * string (* line, char, string *)
+
+(** Transformation of strings to text structures. *)
+module Texter :
+    sig
+      val text_of_string : string -> Odoc_types.text
+      val string_of_text : Odoc_types.text -> string
+    end
diff --git a/ocamldoc/odoc_text_lexer.mll b/ocamldoc/odoc_text_lexer.mll
new file mode 100644
index 00000000..f503b527
--- /dev/null
+++ b/ocamldoc/odoc_text_lexer.mll
@@ -0,0 +1,857 @@
+{
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The lexer for string to build text structures. *)
+
+open Lexing
+open Odoc_text_parser
+
+let line_number = ref 0
+let char_number = ref 0
+
+let string_buffer = Buffer.create 32
+
+(** Reset the buffer *)
+let reset_string_buffer () = Buffer.reset string_buffer
+
+(** Add a character to the buffer *)
+let add_char_string = Buffer.add_char string_buffer
+
+(** Add a string to the buffer. *)
+let add_string = Buffer.add_string string_buffer
+
+let read_string () = Buffer.contents string_buffer
+
+
+(** the variable which will contain the description string.
+   Is initialized when we encounter the start of a special comment. *)
+
+let description = ref ""
+
+let blank = "[ \013\009\012]"
+
+
+let print_DEBUG s = print_string s; print_newline ()
+
+(** this flag indicates whether we're in a string between begin_code and end_code tokens, to
+   remember the number of open '[' and handle ']' correctly. *)
+let open_brackets = ref 0
+
+(** this flag indicates if we're in verbatim mode or not, to handle any special expression
+   like a string when we're in verbatim mode.*)
+let verb_mode = ref false
+
+(** this flag indicates if we're in "target format" mode or not, to handle any special expression
+   like a string when we're in this mode.*)
+let target_mode = ref false
+
+(** this flag indicates if we're in shortcut list mode or not, to handle end_shortcut_list correctly.*)
+let shortcut_list_mode = ref false
+
+(** this flag indicates if we're in an element reference. *)
+let ele_ref_mode = ref false
+
+(** this flag indicates if we're in a preformatted code string. *)
+let code_pre_mode = ref false
+
+let init () =
+  open_brackets := 0;
+  verb_mode := false;
+  target_mode := false;
+  shortcut_list_mode := false;
+  ele_ref_mode := false ;
+  code_pre_mode := false ;
+  line_number := 0 ;
+  char_number := 0
+
+let incr_cpts lexbuf =
+  let s = Lexing.lexeme lexbuf in
+  let l = Str.split_delim (Str.regexp_string "\n") s in
+  match List.rev l with
+    [] -> () (* should not occur *)
+  | [s2] -> (* no newline *)
+      char_number := !char_number + (String.length s2)
+  | s2 :: _ ->
+      line_number := !line_number + ((List.length l) - 1) ;
+      char_number := String.length s2
+
+}
+
+(** html marks, to use as alternative possible special strings *)
+
+let html_bold = "<"('b'|'B')">"
+let html_end_bold = "</"('b'|'B')">"
+let html_italic = "<"('i'|'I')">"
+let html_end_italic = "</"('i'|'I')">"
+let html_title = "<"('h'|'H')(['0'-'9'])+">"
+let html_end_title = "</"('h'|'H')(['0'-'9'])+">"
+let html_list = "<"('u'|'U')('l'|'L')">"
+let html_end_list = "</"('u'|'U')('l'|'L')">"
+let html_enum = "<"('o'|'O')('l'|'L')">"
+let html_end_enum = "</"('o'|'O')('l'|'L')">"
+let html_item = "<"('l'|'L')('i'|'I')">"
+let html_end_item = "</"('l'|'L')('i'|'I')">"
+let html_code = "<"('c'|'C')('o'|'O')('d'|'D')('e'|'E')">"
+let html_end_code = "</"('c'|'C')('o'|'O')('d'|'D')('e'|'E')">"
+let html_center = "<"('c'|'C')('e'|'E')('n'|'N')('t'|'T')('e'|'E')('r'|'R')">"
+let html_end_center = "</"('c'|'C')('e'|'E')('n'|'N')('t'|'T')('e'|'E')('r'|'R')">"
+let html_left = "<"('l'|'L')('e'|'E')('f'|'F')('t'|'T')">"
+let html_end_left = "</"('l'|'L')('e'|'E')('f'|'F')('t'|'T')">"
+let html_right = "<"('r'|'R')('i'|'I')('g'|'G')('h'|'H')('t'|'T')">"
+let html_end_right = "</"('r'|'R')('i'|'I')('g'|'G')('h'|'H')('t'|'T')">"
+
+
+let blank = [' ' '\013' '\009' '\012']
+let blank_nl = [' ' '\013' '\009' '\012' '\010']
+let label = ['a'-'z']+['a'-'z' 'A'-'Z' '0'-'9' '_']*
+
+(** special strings *)
+
+let end = "}"
+  | html_end_bold
+  | html_end_italic
+  | html_end_title
+  | html_end_list
+  | html_end_enum
+  | html_end_item
+  | html_end_center
+let begin_title =
+  ("{" ['0'-'9']+(":"label)? blank_nl)
+  | html_title
+
+let begin_bold = "{b"blank_nl | html_bold
+let begin_emp = "{e"blank_nl
+let begin_center = "{C"blank_nl | html_center
+let begin_left = "{L"blank_nl
+let begin_right = "{R"blank_nl
+let begin_italic = "{i"blank_nl | html_italic
+let begin_list = "{ul"blank_nl? | html_list
+let begin_enum = "{ol"blank_nl? | html_enum
+let begin_item = "{li"blank_nl | "{- " | html_item
+let begin_link = "{{:"
+let begin_target = "{%"['a'-'z''A'-'Z''0'-'9''-''_']+":"blank_nl?
+let begin_latex = "{%"blank_nl
+let end_target = "%}"
+let begin_code = "[" | html_code
+let end_code = "]" | html_end_code
+let begin_code_pre = "{["
+let end_code_pre = "]}"
+let begin_verb = "{v"blank_nl
+let end_verb = blank_nl"v}"
+
+let begin_ele_ref = "{!"blank_nl | "{!"
+let begin_val_ref = "{!val:"blank_nl | "{!val:"
+let begin_typ_ref = "{!type:"blank_nl | "{!type:"
+let begin_ext_ref = "{!extension:"blank_nl | "{!extension:"
+let begin_exc_ref = "{!exception:"blank_nl | "{!exception:"
+let begin_mod_ref = "{!module:"blank_nl | "{!module:"
+let begin_modt_ref = "{!modtype:"blank_nl | "{!modtype:"
+let begin_cla_ref = "{!class:"blank_nl | "{!class:"
+let begin_clt_ref = "{!classtype:"blank_nl | "{!classtype:"
+let begin_att_ref = "{!attribute:"blank_nl | "{!attribute:"
+let begin_met_ref = "{!method:"blank_nl | "{!method:"
+let begin_sec_ref = "{!section:"blank_nl | "{!section:"
+let begin_recf_ref = "{!recfield:"blank_nl | "{!recfield:"
+let begin_const_ref = "{!const:"blank_nl | "{!const:"
+let begin_mod_list_ref = "{!modules:"blank_nl | "{!modules:"
+let index_list = "{!indexlist}"
+let begin_custom = "{"['a'-'z''A'-'Z']['a'-'z''A'-'Z''0'-'9']*
+let begin_superscript = "{^"blank_nl | "{^"
+let begin_subscript = "{_"blank_nl | "{_"
+
+let shortcut_list_item = '\n'blank*"- "
+let shortcut_enum_item = '\n'blank*"+ "
+let end_shortcut_list = '\n'(blank*'\n')+
+
+rule main = parse
+| "\\{"
+| "\\}"
+| "\\["
+| "\\]"
+    {
+      incr_cpts lexbuf ;
+      let s = Lexing.lexeme lexbuf in
+      Char (String.sub s 1 1)
+    }
+
+| end
+    {
+      print_DEBUG "end";
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) then
+        Char (Lexing.lexeme lexbuf)
+      else begin
+        if !ele_ref_mode then
+          ele_ref_mode := false;
+        END
+      end
+    }
+| begin_title
+    {
+      print_DEBUG "begin_title";
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        let s = Lexing.lexeme lexbuf in
+        try
+          (* check if the "{..." or html_title mark was used. *)
+          if s.[0] = '<' then
+            let (n, l) = (2, (String.length s - 3)) in
+            let s2 = String.sub s n l in
+            Title (int_of_string s2, None)
+          else
+            let (n, l) = (1, (String.length s - 2)) in
+            let s2 = String.sub s n l in
+            try
+              let i = String.index s2 ':' in
+              let s_n = String.sub s2 0 i in
+              let s_label = String.sub s2 (i+1) (l-i-1) in
+              Title (int_of_string s_n, Some s_label)
+            with
+              Not_found ->
+                Title (int_of_string s2, None)
+        with
+          _ ->
+            Title (1, None)
+    }
+| begin_bold
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        BOLD
+    }
+| begin_italic
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        ITALIC
+    }
+| begin_link
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        LINK
+    }
+| begin_emp
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        EMP
+    }
+| begin_superscript
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        SUPERSCRIPT
+    }
+| begin_subscript
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        SUBSCRIPT
+    }
+| begin_center
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        CENTER
+    }
+| begin_left
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        LEFT
+    }
+| begin_right
+     {
+      incr_cpts lexbuf ;
+       if !verb_mode || !target_mode || !code_pre_mode
+           || (!open_brackets >= 1) || !ele_ref_mode then
+         Char (Lexing.lexeme lexbuf)
+       else
+         RIGHT
+     }
+| begin_list
+    {
+      print_DEBUG "LIST";
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        LIST
+    }
+| begin_enum
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        ENUM
+    }
+| begin_item
+    {
+      print_DEBUG "ITEM";
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        ITEM
+    }
+| begin_target
+   {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        (
+         let s = Lexing.lexeme lexbuf in
+         let fmt =
+           let p1 = String.index s '%' in
+           let p2 = String.index s ':' in
+           String.sub s (p1 + 1) (p2 - p1 - 1)
+         in
+         target_mode := true;
+         Target fmt
+        )
+    }
+| begin_latex
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        (
+         target_mode := true;
+         LATEX
+        )
+    }
+| end_target
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || (!open_brackets >= 1) || !code_pre_mode ||
+        !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        (
+         target_mode := false;
+         END_TARGET
+        )
+    }
+| begin_code end_code
+    {
+      incr_cpts lexbuf ;
+      Char (Lexing.lexeme lexbuf)
+    }
+
+| begin_code
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if !open_brackets <= 0 then
+          (
+           open_brackets := 1;
+           CODE
+          )
+        else
+          (
+           incr open_brackets;
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+| end_code
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if !open_brackets > 1 then
+          (
+           decr open_brackets;
+           Char "]"
+          )
+        else
+          (
+           open_brackets := 0;
+           END_CODE
+          )
+    }
+
+| begin_code_pre end_code_pre
+    {
+      incr_cpts lexbuf ;
+      Char (Lexing.lexeme lexbuf)
+    }
+
+| begin_code_pre
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        (
+         code_pre_mode := true;
+         CODE_PRE
+        )
+    }
+| end_code_pre
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if !open_brackets >= 1 then
+          (
+           lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1;
+           lexbuf.Lexing.lex_curr_p <-
+             { lexbuf.Lexing.lex_curr_p with
+               pos_cnum = lexbuf.Lexing.lex_curr_p.pos_cnum - 1
+             } ;
+           decr char_number ;
+           if !open_brackets > 1 then
+             (
+              decr open_brackets;
+              Char "]"
+             )
+           else
+             (
+              open_brackets := 0;
+              END_CODE
+             )
+          )
+        else
+          if !code_pre_mode then
+            (
+             code_pre_mode := false;
+             END_CODE_PRE
+            )
+          else
+            Char (Lexing.lexeme lexbuf)
+    }
+
+| begin_ele_ref end
+    {
+      incr_cpts lexbuf ;
+      Char (Lexing.lexeme lexbuf)
+    }
+
+| begin_ele_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           ELE_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+
+
+| begin_val_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           VAL_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+
+| begin_typ_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           TYP_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+
+| begin_ext_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           EXT_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+
+| begin_exc_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           EXC_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+
+| begin_mod_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           MOD_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+
+| begin_modt_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           MODT_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+
+| begin_cla_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           CLA_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+
+| begin_clt_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           CLT_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+
+| begin_att_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           ATT_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+
+| begin_met_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           MET_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+
+| begin_sec_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           SEC_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+| begin_recf_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           RECF_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+| begin_const_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           CONST_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+| begin_mod_list_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           MOD_LIST_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+
+| index_list
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          INDEX_LIST
+        else
+          Char (Lexing.lexeme lexbuf)
+    }
+
+| begin_verb
+    {
+      incr_cpts lexbuf ;
+      if !target_mode || (!open_brackets >= 1) || !code_pre_mode || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        (
+         verb_mode := true;
+         VERB
+        )
+    }
+| end_verb
+    {
+      incr_cpts lexbuf ;
+      if !target_mode || (!open_brackets >= 1) || !code_pre_mode || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        (
+         verb_mode := false;
+         END_VERB
+        )
+    }
+
+| shortcut_list_item
+    {
+      incr_cpts lexbuf ;
+      if !target_mode || (!open_brackets >= 1) || !code_pre_mode
+          || !ele_ref_mode || !verb_mode then
+        Char (Lexing.lexeme lexbuf)
+      else if !shortcut_list_mode then
+        (
+         SHORTCUT_LIST_ITEM
+        )
+      else
+        (
+         shortcut_list_mode := true;
+         BEGIN_SHORTCUT_LIST_ITEM
+        )
+    }
+
+| shortcut_enum_item
+    {
+      incr_cpts lexbuf ;
+      if !target_mode || (!open_brackets >= 1) || !code_pre_mode
+         || !ele_ref_mode || !verb_mode then
+        Char (Lexing.lexeme lexbuf)
+      else if !shortcut_list_mode then
+        SHORTCUT_ENUM_ITEM
+      else
+        (
+         shortcut_list_mode := true;
+         BEGIN_SHORTCUT_ENUM_ITEM
+        )
+    }
+| end_shortcut_list
+    {
+      incr_cpts lexbuf ;
+      lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1;
+      lexbuf.Lexing.lex_curr_p <-
+        { lexbuf.Lexing.lex_curr_p with
+          pos_cnum = lexbuf.Lexing.lex_curr_p.pos_cnum - 1 ;
+        } ;
+      decr line_number ;
+      if !shortcut_list_mode then
+        (
+         shortcut_list_mode := false;
+                        (* go back one char to re-use the last '\n', so we can
+                           restart another shortcut-list with a single blank line,
+                           and not two.*)
+         END_SHORTCUT_LIST
+        )
+      else
+        if !target_mode || (!open_brackets >= 1) || !code_pre_mode || !ele_ref_mode || !verb_mode then
+          Char (Lexing.lexeme lexbuf)
+        else
+          BLANK_LINE
+    }
+
+| eof           { EOF }
+
+| begin_custom
+    {
+      print_DEBUG "begin_custom";
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        let s = Lexing.lexeme lexbuf in
+        let len = String.length s in
+        (* remove this starting '{' *)
+        let tag = Odoc_misc.no_blanks (String.sub s 1 (len - 1)) in
+        CUSTOM tag
+    }
+
+|  "{"
+    {
+      incr_cpts lexbuf ;
+      if !target_mode || (!open_brackets >= 1) || !code_pre_mode || !ele_ref_mode then
+        Char (Lexing.lexeme lexbuf)
+      else
+        LBRACE
+    }
+| '\r' { main lexbuf }
+| _
+    {
+      incr_cpts lexbuf ;
+      Char (Lexing.lexeme lexbuf)
+    }
diff --git a/ocamldoc/odoc_text_parser.mly b/ocamldoc/odoc_text_parser.mly
new file mode 100644
index 00000000..3d590d45
--- /dev/null
+++ b/ocamldoc/odoc_text_parser.mly
@@ -0,0 +1,216 @@
+%{
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Odoc_types
+
+let blank = "[ \010\013\009\012]"
+
+let remove_beginning_blanks s =
+  Str.global_replace (Str.regexp ("^"^blank^"+")) "" s
+
+let remove_trailing_blanks s =
+  Str.global_replace (Str.regexp (blank^"+$")) "" s
+
+let print_DEBUG s = print_string s; print_newline ()
+%}
+
+%token END
+%token <int * string option> Title
+%token BOLD
+%token EMP
+%token CENTER
+%token LEFT
+%token RIGHT
+%token ITALIC
+%token <string> CUSTOM
+%token LIST
+%token ENUM
+%token ITEM
+%token LINK
+%token CODE
+%token END_CODE
+%token CODE_PRE
+%token END_CODE_PRE
+%token VERB
+%token END_VERB
+%token LATEX
+%token <string> Target
+%token END_TARGET
+%token LBRACE
+
+%token ELE_REF
+%token VAL_REF
+%token TYP_REF
+%token EXT_REF
+%token EXC_REF
+%token MOD_REF
+%token MODT_REF
+%token CLA_REF
+%token CLT_REF
+%token ATT_REF
+%token MET_REF
+%token SEC_REF
+%token RECF_REF
+%token CONST_REF
+%token MOD_LIST_REF
+%token INDEX_LIST
+
+%token SUPERSCRIPT
+%token SUBSCRIPT
+
+%token BEGIN_SHORTCUT_LIST_ITEM
+%token BEGIN_SHORTCUT_ENUM_ITEM
+%token SHORTCUT_LIST_ITEM
+%token SHORTCUT_ENUM_ITEM
+%token END_SHORTCUT_LIST
+
+%token BLANK_LINE
+
+%token EOF
+%token <string> Char
+
+%nonassoc below_Char
+%nonassoc Char
+
+/* Start Symbols */
+%start main located_element_list
+%type <Odoc_types.text> main
+%type <(int * int * Odoc_types.text_element) list> located_element_list
+
+%%
+main:
+  text EOF { $1 }
+| EOF { [Raw ""] }
+;
+
+text:
+  text_element_list { $1 }
+;
+
+text_element_list:
+  text_element { [ $1 ] }
+| text_element text_element_list { $1 :: $2 }
+;
+
+located_element_list:
+  located_element { [ $1 ] }
+| located_element located_element_list { $1 :: $2 }
+;
+
+located_element:
+  text_element { Parsing.symbol_start (), Parsing.symbol_end (), $1}
+;
+
+
+ele_ref_kind:
+  ELE_REF { None }
+| VAL_REF { Some RK_value }
+| TYP_REF { Some RK_type }
+| EXT_REF { Some RK_extension }
+| EXC_REF { Some RK_exception }
+| MOD_REF { Some RK_module }
+| MODT_REF { Some RK_module_type }
+| CLA_REF { Some RK_class }
+| CLT_REF { Some RK_class_type }
+| ATT_REF { Some RK_attribute }
+| MET_REF { Some RK_method }
+| SEC_REF { Some (RK_section [])}
+| RECF_REF { Some RK_recfield }
+| CONST_REF { Some RK_const }
+;
+
+text_element:
+  Title text END { let n, l_opt = $1 in Title (n, l_opt, $2) }
+| BOLD text END { Bold $2 }
+| ITALIC text END { Italic $2 }
+| CUSTOM text END { Custom ($1, $2) }
+| EMP text END { Emphasize $2 }
+| SUPERSCRIPT text END { Superscript $2 }
+| SUBSCRIPT text END { Subscript $2 }
+| CENTER text END { Center $2 }
+| LEFT text END { Left $2 }
+| RIGHT text END { Right $2 }
+| LIST list END { List $2 }
+| ENUM list END { Enum $2 }
+| CODE string END_CODE { Code $2 }
+| CODE_PRE string END_CODE_PRE { CodePre $2 }
+| ele_ref_kind string END  {
+      let s2 = remove_beginning_blanks $2 in
+      let s3 = remove_trailing_blanks s2 in
+      Ref (s3, $1, None)
+     }
+| LBRACE ele_ref_kind string END text END {
+      let s2 = remove_beginning_blanks $3 in
+      let s3 = remove_trailing_blanks s2 in
+      Ref (s3, $2, Some $5)
+    }
+
+| MOD_LIST_REF string END {
+      let s2 = remove_beginning_blanks $2 in
+      let s3 = remove_trailing_blanks s2 in
+      let l = Odoc_misc.split_with_blanks s3 in
+      Module_list l
+     }
+| INDEX_LIST { Index_list }
+| VERB string END_VERB { Verbatim $2 }
+| LATEX string END_TARGET { Latex $2 }
+| Target string END_TARGET { Target ($1, $2) }
+| LINK string END text END { Link ($2, $4) }
+| BLANK_LINE { Newline }
+| BEGIN_SHORTCUT_LIST_ITEM shortcut_list END_SHORTCUT_LIST { List $2 }
+| BEGIN_SHORTCUT_LIST_ITEM shortcut_list EOF { List $2 }
+| BEGIN_SHORTCUT_ENUM_ITEM shortcut_enum END_SHORTCUT_LIST { Enum $2 }
+| BEGIN_SHORTCUT_ENUM_ITEM shortcut_enum EOF { Enum $2 }
+| string { Raw $1 }
+;
+
+list:
+| string { [] (* TODO: a test to check that there is only space characters *) }
+| string list { $2 }
+| item { [ $1 ] }
+| item list { $1 :: $2 }
+
+;
+
+item:
+    ITEM text END { $2 }
+;
+
+shortcut_list:
+    text shortcut_list2  { $1 :: $2 }
+| text { [ $1 ] }
+;
+
+shortcut_list2:
+| SHORTCUT_LIST_ITEM shortcut_list { $2 }
+;
+
+shortcut_enum:
+    text shortcut_enum2  { $1 :: $2 }
+| text { [ $1 ] }
+;
+
+shortcut_enum2:
+| SHORTCUT_ENUM_ITEM shortcut_enum { $2 }
+;
+
+
+string:
+    Char %prec below_Char { $1 }
+| Char string { $1^$2 }
+;
+
+%%
diff --git a/ocamldoc/odoc_to_text.ml b/ocamldoc/odoc_to_text.ml
new file mode 100644
index 00000000..b42b419e
--- /dev/null
+++ b/ocamldoc/odoc_to_text.ml
@@ -0,0 +1,608 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Text generation.
+
+   This module contains the class [to_text] with methods used to transform
+   information about elements to a [text] structure.*)
+
+open Odoc_info
+open Exception
+open Type
+open Value
+open Module
+open Class
+
+(** A class used to get a [text] for info structures. *)
+class virtual info =
+  object (self)
+    (** The list of pairs [(tag, f)] where [f] is a function taking
+       the [text] associated to [tag] and returning a [text].
+       Add a pair here to handle a tag.*)
+    val mutable tag_functions = ([] : (string * (Odoc_info.text -> Odoc_info.text)) list)
+
+    (** @return [text] value for an authors list. *)
+    method text_of_author_list l =
+      match l with
+        [] ->
+          []
+      | _ ->
+          [ Bold [Raw (Odoc_messages.authors^": ")] ;
+            Raw (String.concat ", " l) ;
+            Newline
+          ]
+
+    (** @return [text] value for the given optional version information.*)
+    method text_of_version_opt v_opt =
+      match v_opt with
+        None -> []
+      | Some v -> [ Bold [Raw (Odoc_messages.version^": ")] ;
+                    Raw v ;
+                    Newline
+                  ]
+
+    (** @return [text] value for the given optional since information.*)
+    method text_of_since_opt s_opt =
+      match s_opt with
+        None -> []
+      | Some s -> [ Bold [Raw (Odoc_messages.since^": ")] ;
+                    Raw s ;
+                    Newline
+                  ]
+
+    (** @return [text] value to represent the list of "before" information. *)
+    method text_of_before = function
+      [] -> []
+    | l ->
+        let f (v, text) =
+          (Bold [Raw (Printf.sprintf "%s %s " Odoc_messages.before v) ]) ::
+            text @
+            [Newline]
+        in
+        List.flatten (List.map f l)
+
+    (** @return [text] value for the given list of raised exceptions.*)
+    method text_of_raised_exceptions l =
+      match l with
+        [] -> []
+      | (s, t) :: [] ->
+          [ Bold [ Raw Odoc_messages.raises ] ;
+            Raw " " ;
+            Code s ;
+            Raw " "
+          ]
+          @ t
+          @ [ Newline ]
+      | _ ->
+          [ Bold [ Raw Odoc_messages.raises ] ;
+            Raw " " ;
+            List
+              (List.map
+                (fun (ex, desc) ->(Code ex) :: (Raw " ") :: desc )
+                 l
+              ) ;
+            Newline
+          ]
+
+    (** Return [text] value for the given "see also" reference. *)
+    method text_of_see (see_ref, t)  =
+      match see_ref with
+        Odoc_info.See_url s -> [ Odoc_info.Link (s, t) ]
+      | Odoc_info.See_file s -> (Odoc_info.Code s) :: (Odoc_info.Raw " ") :: t
+      | Odoc_info.See_doc s -> (Odoc_info.Italic [Odoc_info.Raw s]) :: (Odoc_info.Raw " ") :: t
+
+    (** Return [text] value for the given list of "see also" references.*)
+    method text_of_sees l =
+      match l with
+        [] -> []
+      | see :: [] ->
+          (Bold [ Raw Odoc_messages.see_also ]) ::
+          (Raw " ") ::
+          (self#text_of_see see) @ [ Newline ]
+      | _ ->
+          (Bold [ Raw Odoc_messages.see_also ]) ::
+          [ List
+              (List.map
+                 (fun see -> self#text_of_see see)
+                 l
+              );
+            Newline
+          ]
+
+    (** @return [text] value for the given optional return information.*)
+    method text_of_return_opt return_opt =
+      match return_opt with
+        None -> []
+      | Some t -> (Bold [Raw (Odoc_messages.returns^" ")]) :: t @ [ Newline ]
+
+    (** Return a [text] for the given list of custom tagged texts. *)
+    method text_of_custom l =
+      List.fold_left
+        (fun acc -> fun (tag, text) ->
+          try
+            let f = List.assoc tag tag_functions in
+            match acc with
+              [] -> f text
+            | _ -> acc @ (Newline :: (f text))
+          with
+            Not_found ->
+              Odoc_info.warning (Odoc_messages.tag_not_handled tag) ;
+              acc
+        )
+        []
+        l
+
+    (** @return [text] value for a description, except for the i_params field. *)
+    method text_of_info ?(block=true) info_opt =
+      match info_opt with
+        None ->
+          []
+      | Some info ->
+          let t =
+            (match info.i_deprecated with
+              None -> []
+            | Some t -> ( Italic [Raw (Odoc_messages.deprecated^" ")] ) :: t
+             ) @
+            (match info.i_desc with
+              None -> []
+            | Some t when t = [Odoc_info.Raw ""] -> []
+            | Some t -> t @ [ Newline ]
+            ) @
+            (self#text_of_author_list info.i_authors) @
+            (self#text_of_version_opt info.i_version) @
+            (self#text_of_before info.i_before) @
+            (self#text_of_since_opt info.i_since) @
+            (self#text_of_raised_exceptions info.i_raised_exceptions) @
+            (self#text_of_return_opt info.i_return_value) @
+            (self#text_of_sees info.i_sees) @
+            (self#text_of_custom info.i_custom)
+          in
+          if block then
+            [Block t]
+          else
+            t
+  end
+
+(** This class defines methods to generate a [text] structure from elements. *)
+class virtual to_text =
+  object (self)
+    inherit info
+
+    method virtual label : ?no_: bool -> string -> string
+
+    (** Take a string and return the string where fully qualified idents
+       have been replaced by idents relative to the given module name.
+       Also remove the "hidden modules".*)
+    method relative_idents m_name s =
+      let f str_t =
+        let match_s = Str.matched_string str_t in
+        let rel = Name.get_relative m_name match_s in
+        Odoc_info.apply_if_equal Odoc_info.use_hidden_modules match_s rel
+      in
+      Str.global_substitute
+        (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([a-z][a-zA-Z_'0-9]*\\)")
+        f
+        s
+
+    (** Take a string and return the string where fully qualified idents
+       have been replaced by idents relative to the given module name.
+       Also remove the "hidden modules".*)
+    method relative_module_idents m_name s =
+      let f str_t =
+        let match_s = Str.matched_string str_t in
+        let rel = Name.get_relative m_name match_s in
+        Odoc_info.apply_if_equal Odoc_info.use_hidden_modules match_s rel
+      in
+      Str.global_substitute
+        (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([A-Z][a-zA-Z_'0-9]*\\)")
+        f
+        s
+
+    (** Get a string for a [Types.class_type] where all idents are relative. *)
+    method normal_class_type m_name t =
+      self#relative_idents m_name (Odoc_info.string_of_class_type t)
+
+    (** Get a string for a [Types.module_type] where all idents are relative. *)
+    method normal_module_type ?code m_name t =
+      self#relative_module_idents m_name (Odoc_info.string_of_module_type ?code t)
+
+    (** Get a string for a type where all idents are relative. *)
+    method normal_type m_name t =
+      self#relative_idents m_name (Odoc_info.string_of_type_expr t)
+
+    (** Get a string for a list of types where all idents are relative. *)
+    method normal_type_list ?par m_name sep t =
+      self#relative_idents m_name (Odoc_info.string_of_type_list ?par sep t)
+
+    method normal_cstr_args ?par m_name = function
+      | Cstr_tuple l -> self#normal_type_list ?par m_name " * " l
+      | Cstr_record r -> self#relative_idents m_name
+                            (Odoc_str.string_of_record r)
+
+    (** Get a string for a list of class or class type type parameters
+       where all idents are relative. *)
+    method normal_class_type_param_list m_name t =
+      self#relative_idents m_name (Odoc_info.string_of_class_type_param_list t)
+
+    (** Get a string for the parameters of a class (with arrows) where all idents are relative. *)
+    method normal_class_params m_name c =
+      let s = Odoc_info.string_of_class_params c in
+      self#relative_idents m_name
+        (Odoc_info.remove_ending_newline s)
+
+    (** @return [text] value to represent a [Types.type_expr].*)
+    method text_of_type_expr module_name t =
+      List.flatten
+        (List.map
+           (fun s -> [Code s ; Newline ])
+           (Str.split (Str.regexp "\n")
+              (self#normal_type module_name t))
+        )
+
+    (** Return [text] value for a given short [Types.type_expr].*)
+    method text_of_short_type_expr module_name t =
+      [ Code (self#normal_type module_name t) ]
+
+    (** Return [text] value or the given list of [Types.type_expr], with
+       the given separator. *)
+    method text_of_type_expr_list module_name sep l =
+      [ Code (self#normal_type_list module_name sep l) ]
+
+    (** Return [text] value or the given list of [Types.type_expr],
+       as type parameters of a class of class type. *)
+    method text_of_class_type_param_expr_list module_name l =
+      [ Code (self#normal_class_type_param_list module_name l) ]
+
+    (** @return [text] value to represent parameters of a class (with arrows).*)
+    method text_of_class_params module_name c =
+      Odoc_info.text_concat
+        [Newline]
+        (List.map
+           (fun s -> [Code s])
+           (Str.split (Str.regexp "\n")
+              (self#normal_class_params module_name c))
+        )
+
+    (** @return [text] value to represent a [Types.module_type]. *)
+    method text_of_module_type t =
+      let s = String.concat "\n"
+          (Str.split (Str.regexp "\n") (Odoc_info.string_of_module_type t))
+      in
+      [ Code s ]
+
+    (** @return [text] value for a value. *)
+    method text_of_value v =
+      let name = v.val_name in
+      let s_name = Name.simple name in
+      let s =
+        Format.fprintf Format.str_formatter "@[<hov 2>val %s :@ %s"
+          s_name
+          (self#normal_type (Name.father v.val_name) v.val_type);
+        Format.flush_str_formatter ()
+      in
+      [ CodePre s ] @
+      [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @
+      (self#text_of_info v.val_info)
+
+    (** @return [text] value for a class attribute. *)
+    method text_of_attribute a =
+      let s_name = Name.simple a.att_value.val_name in
+      let mod_name = Name.father a.att_value.val_name in
+      let s =
+        Format.fprintf Format.str_formatter "@[<hov 2>val %s%s%s :@ %s"
+          (if a.att_virtual then "virtual " else "")
+          (if a.att_mutable then "mutable " else "")
+          s_name
+          (self#normal_type mod_name a.att_value.val_type);
+        Format.flush_str_formatter ()
+      in
+      (CodePre s) ::
+      [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @
+      (self#text_of_info a.att_value.val_info)
+
+    (** @return [text] value for a class method. *)
+    method text_of_method m =
+      let s_name = Name.simple m.met_value.val_name in
+      let mod_name = Name.father m.met_value.val_name in
+      let s =
+        Format.fprintf Format.str_formatter "@[<hov 2>method %s%s%s :@ %s"
+          (if m.met_private then "private " else "")
+          (if m.met_virtual then "virtual " else "")
+          s_name
+          (self#normal_type mod_name m.met_value.val_type);
+        Format.flush_str_formatter ()
+      in
+      (CodePre s) ::
+      [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @
+      (self#text_of_info m.met_value.val_info)
+
+
+    (** @return [text] value for an exception. *)
+    method text_of_exception e =
+      let s_name = Name.simple e.ex_name in
+      let father = Name.father e.ex_name in
+      Format.fprintf Format.str_formatter "@[<hov 2>exception %s" s_name ;
+      (match e.ex_args, e.ex_ret with
+         Cstr_tuple [], None -> ()
+       | Cstr_tuple [], Some r ->
+           Format.fprintf Format.str_formatter " %s@ %s"
+             ":"
+             (self#normal_type father r)
+       | args, None ->
+           Format.fprintf Format.str_formatter " %s@ %s"
+             "of"
+             (self#normal_cstr_args ~par:false father args)
+       | args, Some r ->
+           Format.fprintf Format.str_formatter " %s@ %s@ %s@ %s"
+             ":"
+             (self#normal_cstr_args ~par:false father args)
+             "->"
+             (self#normal_type father r)
+      );
+      (match e.ex_alias with
+         None -> ()
+       | Some ea ->
+           Format.fprintf Format.str_formatter " = %s"
+            (
+              match ea.ea_ex with
+                None -> ea.ea_name
+              | Some e -> e.ex_name
+            )
+      );
+      let s2 = Format.flush_str_formatter () in
+      [ CodePre s2 ] @
+      [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @
+      (self#text_of_info e.ex_info)
+
+    (** Return [text] value for the description of a function parameter. *)
+    method text_of_parameter_description p =
+      match Parameter.names p with
+        [] -> []
+      | name :: [] ->
+          (
+           (* Only one name, no need for label for the description. *)
+           match Parameter.desc_by_name p name with
+             None -> []
+           | Some t -> t
+          )
+      | l ->
+          (*  A list of names, we display those with a description. *)
+          let l2 = List.filter (fun n -> (Parameter.desc_by_name p n) <> None) l in
+          match l2 with
+            [] -> []
+          | _ ->
+              [List
+                  (List.map
+                     (fun n ->
+                       match Parameter.desc_by_name p n with
+                         None -> [] (* should not occur *)
+                       | Some t -> [Code (n^" ") ; Raw ": "] @ t
+                     )
+                     l2
+                  )
+              ]
+
+
+    (** Return [text] value for a list of parameters. *)
+    method text_of_parameter_list m_name l =
+      match l with
+        [] ->
+          []
+      | _ ->
+          [ Bold [Raw Odoc_messages.parameters] ;
+            Raw ":" ;
+            List
+              (List.map
+                 (fun p ->
+                   (match Parameter.complete_name p with
+                     "" -> Code "?"
+                   | s -> Code s
+                   ) ::
+                   [Code " : "] @
+                   (self#text_of_short_type_expr m_name (Parameter.typ p)) @
+                   [Newline] @
+                   (self#text_of_parameter_description p)
+                 )
+                 l
+              )
+          ]
+
+    (** Return [text] value for a list of module parameters. *)
+    method text_of_module_parameter_list l =
+      match l with
+        [] ->
+          []
+      | _ ->
+          [ Newline ;
+            Bold [Raw Odoc_messages.parameters] ;
+            Raw ":" ;
+            List
+              (List.map
+                 (fun (p, desc_opt) ->
+                   begin match p.mp_type with None -> [Raw ""]
+                   | Some mty ->
+                       [Code (p.mp_name^" : ")] @
+                       (self#text_of_module_type mty)
+                   end @
+                   (match desc_opt with
+                     None -> []
+                   | Some t -> (Raw " ") :: t)
+                 )
+                 l
+              )
+          ]
+
+(**/**)
+
+    (** Return [text] value for the given [class_kind].*)
+    method text_of_class_kind father ckind =
+      match ckind with
+        Class_structure _ ->
+          [Code Odoc_messages.object_end]
+
+      | Class_apply capp ->
+          [Code
+              (
+               (
+                match capp.capp_class with
+                  None -> capp.capp_name
+                | Some cl -> cl.cl_name
+               )^
+               " "^
+               (String.concat " "
+                  (List.map
+                     (fun s -> "("^s^")")
+                     capp.capp_params_code))
+              )
+          ]
+
+      | Class_constr cco ->
+          (
+           match cco.cco_type_parameters with
+             [] -> []
+           | l ->
+               (Code "[")::
+               (self#text_of_type_expr_list father ", " l)@
+               [Code "] "]
+          )@
+          [Code (
+            match cco.cco_class with
+              None -> cco.cco_name
+            | Some (Cl cl) -> Name.get_relative father cl.cl_name
+            | Some (Cltype (clt,_)) -> Name.get_relative father clt.clt_name
+           )
+          ]
+
+      | Class_constraint (ck, ctk) ->
+          [Code "( "] @
+          (self#text_of_class_kind father ck) @
+          [Code " : "] @
+          (self#text_of_class_type_kind father ctk) @
+          [Code " )"]
+
+
+    (** Return [text] value for the given [class_type_kind].*)
+    method text_of_class_type_kind father ctkind =
+      match ctkind with
+        Class_type cta ->
+          (
+           match cta.cta_type_parameters with
+             [] -> []
+           | l ->
+               (Code "[") ::
+               (self#text_of_class_type_param_expr_list father l) @
+               [Code "] "]
+          ) @
+          (
+           match cta.cta_class with
+             None -> [ Code cta.cta_name ]
+           | Some (Cltype (clt, _)) ->
+               let rel = Name.get_relative father clt.clt_name in
+               [Code rel]
+           | Some (Cl cl) ->
+               let rel = Name.get_relative father cl.cl_name in
+               [Code rel]
+          )
+      | Class_signature _ ->
+          [Code Odoc_messages.object_end]
+
+    (** Return [text] value for a [module_kind]. *)
+    method text_of_module_kind ?(with_def_syntax=true) k =
+      match k with
+        Module_alias m_alias ->
+          (match m_alias.ma_module with
+            None ->
+              [Code ((if with_def_syntax then " = " else "")^m_alias.ma_name)]
+          | Some (Mod m) ->
+              [Code ((if with_def_syntax then " = " else "")^m.m_name)]
+          | Some (Modtype mt) ->
+              [Code ((if with_def_syntax then " = " else "")^mt.mt_name)]
+          )
+      | Module_apply (k1, k2) ->
+          (if with_def_syntax then [Code " = "] else []) @
+          (self#text_of_module_kind ~with_def_syntax: false k1) @
+          [Code " ( "] @
+          (self#text_of_module_kind ~with_def_syntax: false k2) @
+          [Code " ) "]
+
+      | Module_with (tk, code) ->
+          (if with_def_syntax then [Code " : "] else []) @
+          (self#text_of_module_type_kind ~with_def_syntax: false tk) @
+          [Code code]
+
+      | Module_constraint (k, tk) ->
+          (if with_def_syntax then [Code " : "] else []) @
+          [Code "( "] @
+          (self#text_of_module_kind ~with_def_syntax: false k) @
+          [Code " : "] @
+          (self#text_of_module_type_kind ~with_def_syntax: false tk) @
+          [Code " )"]
+
+      | Module_struct _ ->
+          [Code ((if with_def_syntax then " : " else "")^
+                 Odoc_messages.struct_end^" ")]
+
+      | Module_functor (_, k)  ->
+          (if with_def_syntax then [Code " : "] else []) @
+          [Code "functor ... "] @
+          [Code " -> "] @
+          (self#text_of_module_kind ~with_def_syntax: false k)
+
+      | Module_typeof s ->
+          let code = Printf.sprintf "%smodule type of %s"
+            (if with_def_syntax then " : " else "")
+            s
+          in
+          [Code code]
+      | Module_unpack (code, _) ->
+          let code = Printf.sprintf "%s%s"
+            (if with_def_syntax then " : " else "")
+            code
+          in
+          [Code code]
+
+    (** Return html code for a [module_type_kind].*)
+    method text_of_module_type_kind ?(with_def_syntax=true) tk =
+      match tk with
+      | Module_type_struct _ ->
+          [Code ((if with_def_syntax then " = " else "")^Odoc_messages.sig_end)]
+
+      | Module_type_functor (p, k) ->
+          let t1 =
+            [Code ("("^p.mp_name^" : ")] @
+            (self#text_of_module_type_kind p.mp_kind) @
+            [Code ") -> "]
+          in
+          let t2 = self#text_of_module_type_kind ~with_def_syntax: false k in
+          (if with_def_syntax then [Code " = "] else []) @ t1 @ t2
+
+      | Module_type_with (tk2, code) ->
+          let t = self#text_of_module_type_kind ~with_def_syntax: false tk2 in
+          (if with_def_syntax then [Code " = "] else []) @
+          t @ [Code code]
+
+      | Module_type_alias mt_alias ->
+          [Code ((if with_def_syntax then " = " else "")^
+                 (match mt_alias.mta_module with
+                   None -> mt_alias.mta_name
+                 | Some mt -> mt.mt_name))
+          ]
+
+      | Odoc_module.Module_type_typeof s ->
+          let code = Printf.sprintf "%smodule type of %s"
+            (if with_def_syntax then " = " else "") s
+          in
+          [ Code code ]
+  end
diff --git a/ocamldoc/odoc_type.ml b/ocamldoc/odoc_type.ml
new file mode 100644
index 00000000..5f4df740
--- /dev/null
+++ b/ocamldoc/odoc_type.ml
@@ -0,0 +1,73 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Representation and manipulation of a type, but not class nor module type.*)
+
+module Name = Odoc_name
+
+type private_flag = Asttypes.private_flag =
+    Private | Public
+
+(** Description of a record type field. *)
+type record_field = {
+    rf_name : string ;
+    rf_mutable : bool ; (** true if mutable *)
+    rf_type : Types.type_expr ;
+    mutable rf_text : Odoc_types.info option ; (** optional user description *)
+  }
+
+type constructor_args =
+  | Cstr_record of record_field list
+  | Cstr_tuple of Types.type_expr list
+
+(** Description of a variant type constructor. *)
+type variant_constructor = {
+    vc_name : string ;
+    vc_args : constructor_args ;
+    vc_ret : Types.type_expr option ;
+    mutable vc_text : Odoc_types.info option ; (** optional user description *)
+  }
+
+(** The various kinds of type. *)
+type type_kind =
+    Type_abstract
+  | Type_variant of variant_constructor list
+                   (** constructors *)
+  | Type_record of record_field list
+                   (** fields *)
+  | Type_open
+
+type object_field = {
+  of_name : string ;
+  of_type : Types.type_expr ;
+  mutable of_text : Odoc_types.info option ; (** optional user description *)
+}
+
+type type_manifest =
+  | Other of Types.type_expr (** Type manifest directly taken from Typedtree. *)
+  | Object_type of object_field list
+
+(** Representation of a type. *)
+type t_type = {
+    ty_name : Name.t ;
+    mutable ty_info : Odoc_types.info option ; (** optional user information *)
+    ty_parameters : (Types.type_expr * bool * bool) list ;
+                    (** type parameters: (type, covariant, contravariant) *)
+    ty_kind : type_kind ;
+    ty_private : private_flag;
+    ty_manifest : type_manifest option;
+    mutable ty_loc : Odoc_types.location ;
+    mutable ty_code : string option;
+  }
diff --git a/ocamldoc/odoc_types.ml b/ocamldoc/odoc_types.ml
new file mode 100644
index 00000000..2baf1f2f
--- /dev/null
+++ b/ocamldoc/odoc_types.ml
@@ -0,0 +1,143 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type ref_kind =
+    RK_module
+  | RK_module_type
+  | RK_class
+  | RK_class_type
+  | RK_value
+  | RK_type
+  | RK_extension
+  | RK_exception
+  | RK_attribute
+  | RK_method
+  | RK_section of text
+  | RK_recfield
+  | RK_const
+
+and text_element =
+  | Raw of string
+  | Code of string
+  | CodePre of string
+  | Verbatim of string
+  | Bold of text
+  | Italic of text
+  | Emphasize of text
+  | Center of text
+  | Left of text
+  | Right of text
+  | List of text list
+  | Enum of text list
+  | Newline
+  | Block of text
+  | Title of int * string option * text
+  | Latex of string
+  | Link of string * text
+  | Ref of string * ref_kind option * text option
+  | Superscript of text
+  | Subscript of text
+  | Module_list of string list
+  | Index_list
+  | Custom of string * text
+  | Target of string * string
+
+and text = text_element list
+
+type see_ref =
+    See_url of string
+  | See_file of string
+  | See_doc of string
+
+type see = see_ref * text
+
+type param = (string * text)
+
+type raised_exception = (string * text)
+
+type info = {
+    i_desc : text option;
+    i_authors : string list;
+    i_version : string option;
+    i_sees : see list;
+    i_since : string option;
+    i_before : (string * text) list;
+    i_deprecated : text option;
+    i_params : param list;
+    i_raised_exceptions : raised_exception list;
+    i_return_value : text option ;
+    i_custom : (string * text) list ;
+  }
+
+let dummy_info = {
+  i_desc = None ;
+  i_authors = [] ;
+  i_version = None ;
+  i_sees = [] ;
+  i_since = None ;
+  i_before = [] ;
+  i_deprecated = None ;
+  i_params = [] ;
+  i_raised_exceptions = [] ;
+  i_return_value = None ;
+  i_custom = [] ;
+}
+
+type location = {
+    loc_impl : Location.t option ;
+    loc_inter : Location.t option ;
+  }
+
+let dummy_loc = { loc_impl = None ; loc_inter = None }
+
+type merge_option =
+  | Merge_description
+  | Merge_author
+  | Merge_version
+  | Merge_see
+  | Merge_since
+  | Merge_before
+  | Merge_deprecated
+  | Merge_param
+  | Merge_raised_exception
+  | Merge_return_value
+  | Merge_custom
+
+let all_merge_options = [
+  Merge_description ;
+  Merge_author ;
+  Merge_version ;
+  Merge_see ;
+  Merge_since ;
+  Merge_before ;
+  Merge_deprecated ;
+  Merge_param ;
+  Merge_raised_exception ;
+  Merge_return_value ;
+  Merge_custom ;
+]
+
+type magic = string
+
+let magic = Odoc_messages.magic
+
+type 'a dump = Dump of magic * 'a
+
+let make_dump a = Dump (magic, a)
+
+let open_dump = function
+    Dump (m, a) ->
+      if m = magic then a
+      else raise (Failure Odoc_messages.bad_magic_number)
diff --git a/ocamldoc/odoc_types.mli b/ocamldoc/odoc_types.mli
new file mode 100644
index 00000000..e73b26ca
--- /dev/null
+++ b/ocamldoc/odoc_types.mli
@@ -0,0 +1,142 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Types for the information collected in comments. *)
+
+(** The different kinds of element references. *)
+type ref_kind =
+    RK_module
+  | RK_module_type
+  | RK_class
+  | RK_class_type
+  | RK_value
+  | RK_type
+  | RK_extension
+  | RK_exception
+  | RK_attribute
+  | RK_method
+  | RK_section of text
+  | RK_recfield
+  | RK_const
+
+and text_element =
+  | Raw of string (** Raw text. *)
+  | Code of string (** The string is source code. *)
+  | CodePre of string (** The string is pre-formatted source code. *)
+  | Verbatim of string (** String 'as is'. *)
+  | Bold of text (** Text in bold style. *)
+  | Italic of text (** Text in italic. *)
+  | Emphasize of text (** Emphasized text. *)
+  | Center of text (** Centered text. *)
+  | Left of text (** Left alignment. *)
+  | Right of text (** Right alignment. *)
+  | List of text list (** A list. *)
+  | Enum of text list (** An enumerated list. *)
+  | Newline   (** To force a line break. *)
+  | Block of text (** Like html's block quote. *)
+  | Title of int * string option * text
+              (** Style number, optional label, and text. *)
+  | Latex of string (** A string for latex. *)
+  | Link of string * text (** A reference string and the link text. *)
+  | Ref of string * ref_kind option * text option
+    (** A reference to an element. Complete name and kind. An optional
+        text can be given to display this text instead of the element name.*)
+  | Superscript of text (** Superscripts. *)
+  | Subscript of text (** Subscripts. *)
+  | Module_list of string list
+       (** The table of the given modules with their abstracts. *)
+  | Index_list (** The links to the various indexes (values, types, ...) *)
+  | Custom of string * text (** to extend \{foo syntax *)
+  | Target of string * string (** (target, code) : to specify code for a specific target format *)
+
+(** [text] is a list of text_elements. The order matters. *)
+and text = text_element list
+
+(** The different forms of references in \@see tags. *)
+type see_ref =
+    See_url of string
+  | See_file of string
+  | See_doc of string
+
+(** The information in a \@see tag. *)
+type see = see_ref * text
+
+(** Parameter name and description. *)
+type param = (string * text)
+
+(** Raised exception name and description. *)
+type raised_exception = (string * text)
+
+(** Information in a special comment. *)
+type info = {
+    i_desc : text option; (** The description text. *)
+    i_authors : string list; (** The list of authors in \@author tags. *)
+    i_version : string option; (** The string in the \@version tag. *)
+    i_sees : see list; (** The list of \@see tags. *)
+    i_since : string option; (** The string in the \@since tag. *)
+    i_before : (string * text) list; (** the version number and text in \@before tag *)
+    i_deprecated : text option; (** The textual description of the \@deprecated tag. *)
+    i_params : param list; (** The list of parameter descriptions. *)
+    i_raised_exceptions : raised_exception list; (** The list of raised exceptions. *)
+    i_return_value : text option ; (** The description text of the return value. *)
+    i_custom : (string * text) list ; (** A text associated to a custom @-tag. *)
+  }
+
+(** An empty info structure. *)
+val dummy_info : info
+
+(** Location of elements in implementation and interface files. *)
+type location = {
+    loc_impl : Location.t option ; (** implementation location *)
+    loc_inter : Location.t option ; (** interface location *)
+  }
+
+(** A dummy location. *)
+val dummy_loc : location
+
+(** The information to merge from two elements when they both have some information. *)
+type merge_option =
+  | Merge_description (** Descriptions are concatenated. *)
+  | Merge_author (** Lists of authors are concatenated. *)
+  | Merge_version (** Versions are concatenated. *)
+  | Merge_see (** See references are concatenated. *)
+  | Merge_since (** Since information are concatenated. *)
+  | Merge_before (** Before information are concatenated. *)
+  | Merge_deprecated (** Deprecated information are concatenated. *)
+  | Merge_param (** Information on each parameter is concatenated,
+                    and all parameters are kept. *)
+  | Merge_raised_exception (** Information on each raised_exception is concatenated,
+                               and all raised exceptions are kept. *)
+  | Merge_return_value (** Information on return value are concatenated. *)
+  | Merge_custom (** Merge custom tags (all pairs (tag, text) are kept). *)
+
+(** The list with all merge options. *)
+val all_merge_options : merge_option list
+
+(** Type of magic numbers. *)
+type magic
+
+(** The magic number for the dumps of this version of ocamldoc. *)
+val magic : magic
+
+(** A dump of a structure. *)
+type 'a dump
+
+(** Create a dump structure. *)
+val make_dump : 'a -> 'a dump
+
+(** Verify that a dump has the correct magic number
+   and return its content. *)
+val open_dump : 'a dump -> 'a
diff --git a/ocamldoc/odoc_value.ml b/ocamldoc/odoc_value.ml
new file mode 100644
index 00000000..d939f64e
--- /dev/null
+++ b/ocamldoc/odoc_value.ml
@@ -0,0 +1,140 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Representation and manipulation of values, class attributes and class methods. *)
+
+module Name = Odoc_name
+
+(** Types *)
+
+(** Representation of a value. *)
+type t_value = {
+    val_name : Name.t ;
+    mutable val_info : Odoc_types.info option ;
+    val_type : Types.type_expr ;
+    val_recursive : bool ;
+    mutable val_parameters : Odoc_parameter.parameter list ;
+    mutable val_code : string option ;
+    mutable val_loc : Odoc_types.location ;
+  }
+
+(** Representation of a class attribute. *)
+type t_attribute = {
+    att_value : t_value ; (** an attribute has almost all the same information
+                             as a value *)
+    att_mutable : bool ;
+    att_virtual : bool ;
+  }
+
+(** Representation of a class method. *)
+type t_method = {
+    met_value : t_value ; (** a method has almost all the same information
+                             as a value *)
+    met_private : bool ;
+    met_virtual : bool ;
+  }
+
+(** Functions *)
+
+(** Returns the text associated to the given parameter name
+   in the given value, or None. *)
+let value_parameter_text_by_name v name =
+  match v.val_info with
+    None -> None
+  | Some i ->
+      try
+        let t = List.assoc name i.Odoc_types.i_params in
+        Some t
+      with
+        Not_found ->
+          None
+
+(** Update the parameters text of a t_value, according to the val_info field. *)
+let update_value_parameters_text v =
+  let f p =
+    Odoc_parameter.update_parameter_text (value_parameter_text_by_name v) p
+  in
+  List.iter f v.val_parameters
+
+(** Create a list of (parameter name, typ) from a type, according to the arrows.
+   [parameter_list_from_arrows t = [ a ; b ]] if t = a -> b -> c.*)
+let parameter_list_from_arrows typ =
+  let rec iter t =
+    match t.Types.desc with
+      Types.Tarrow (l, t1, t2, _) ->
+        (l, t1) :: (iter t2)
+    | Types.Tlink texp
+    | Types.Tsubst texp ->
+        iter texp
+    | Types.Tpoly (texp, _) -> iter texp
+    | Types.Tvar _
+    | Types.Ttuple _
+    | Types.Tconstr _
+    | Types.Tobject _
+    | Types.Tfield _
+    | Types.Tnil
+    | Types.Tunivar _
+    | Types.Tpackage _
+    | Types.Tvariant _ ->
+        []
+  in
+  iter typ
+
+(** Create a list of parameters with dummy names "??" from a type list.
+   Used when we want to merge the parameters of a value, from the .ml
+   and the .mli file. In the .mli file we don't have parameter names
+   so there is nothing to merge. With this dummy list we can merge the
+   parameter names from the .ml and the type from the .mli file. *)
+let dummy_parameter_list typ =
+  let normal_name = Odoc_misc.label_name in
+  Printtyp.mark_loops typ;
+  let liste_param = parameter_list_from_arrows typ in
+  let rec iter (label, t) =
+    match t.Types.desc with
+    | Types.Ttuple l ->
+        let open Asttypes in
+        if label = Nolabel then
+          Odoc_parameter.Tuple
+            (List.map (fun t2 -> iter (Nolabel, t2)) l, t)
+        else
+          (* if there is a label, then we don't want to decompose the tuple *)
+          Odoc_parameter.Simple_name
+            { Odoc_parameter.sn_name = normal_name label ;
+              Odoc_parameter.sn_type = t ;
+              Odoc_parameter.sn_text = None }
+    | Types.Tlink t2
+    | Types.Tsubst t2 ->
+        (iter (label, t2))
+
+    | _ ->
+        Odoc_parameter.Simple_name
+          { Odoc_parameter.sn_name = normal_name label ;
+             Odoc_parameter.sn_type = t ;
+            Odoc_parameter.sn_text = None }
+  in
+  List.map iter liste_param
+
+(** Return true if the value is a function, i.e. has a functional type.*)
+let is_function v =
+  let rec f t =
+    match t.Types.desc with
+      Types.Tarrow _ ->
+        true
+    | Types.Tlink t ->
+        f t
+        | _ ->
+            false
+      in
+  f v.val_type
diff --git a/ocamldoc/remove_DEBUG b/ocamldoc/remove_DEBUG
new file mode 100755
index 00000000..0eee2df9
--- /dev/null
+++ b/ocamldoc/remove_DEBUG
@@ -0,0 +1,23 @@
+#!/bin/sh
+
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*             Damien Doligez, projet Moscova, INRIA Rocquencourt         *
+#*                                                                        *
+#*   Copyright 2003 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# usage: remove_DEBUG <file>
+# remove from <file> every line that contains the string "DEBUG",
+# respecting the cpp # line annotation conventions
+
+echo "# 1 \"$1\""
+LC_ALL=C sed -e '/DEBUG/s/^.*$/(* DEBUG statement removed *)/' "$1"
diff --git a/ocamltest/.depend b/ocamltest/.depend
new file mode 100644
index 00000000..01a6139e
--- /dev/null
+++ b/ocamltest/.depend
@@ -0,0 +1,460 @@
+run_unix.$(O): run_unix.c run.h ../runtime/caml/misc.h \
+ ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
+ run_common.h
+run_stubs.$(O): run_stubs.c run.h ../runtime/caml/misc.h \
+ ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
+ ../runtime/caml/mlvalues.h ../runtime/caml/misc.h \
+ ../runtime/caml/domain_state.h ../runtime/caml/mlvalues.h \
+ ../runtime/caml/domain_state.tbl ../runtime/caml/memory.h \
+ ../runtime/caml/gc.h ../runtime/caml/major_gc.h \
+ ../runtime/caml/freelist.h ../runtime/caml/minor_gc.h \
+ ../runtime/caml/address_class.h ../runtime/caml/domain.h \
+ ../runtime/caml/io.h ../runtime/caml/osdeps.h ../runtime/caml/memory.h
+ocamltest_stdlib_stubs.$(O): ocamltest_stdlib_stubs.c \
+ ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
+ ../runtime/caml/mlvalues.h ../runtime/caml/config.h \
+ ../runtime/caml/misc.h ../runtime/caml/domain_state.h \
+ ../runtime/caml/mlvalues.h ../runtime/caml/domain_state.tbl \
+ ../runtime/caml/memory.h ../runtime/caml/gc.h ../runtime/caml/major_gc.h \
+ ../runtime/caml/freelist.h ../runtime/caml/minor_gc.h \
+ ../runtime/caml/address_class.h ../runtime/caml/domain.h \
+ ../runtime/caml/alloc.h ../runtime/caml/signals.h \
+ ../runtime/caml/osdeps.h ../runtime/caml/memory.h
+actions.cmo : \
+    variables.cmi \
+    result.cmi \
+    environments.cmi \
+    actions.cmi
+actions.cmx : \
+    variables.cmx \
+    result.cmx \
+    environments.cmx \
+    actions.cmi
+actions.cmi : \
+    variables.cmi \
+    result.cmi \
+    environments.cmi
+actions_helpers.cmo : \
+    variables.cmi \
+    strace.cmi \
+    run_command.cmi \
+    result.cmi \
+    ocamltest_stdlib.cmi \
+    modifier_parser.cmi \
+    filecompare.cmi \
+    environments.cmi \
+    builtin_variables.cmi \
+    actions.cmi \
+    actions_helpers.cmi
+actions_helpers.cmx : \
+    variables.cmx \
+    strace.cmx \
+    run_command.cmx \
+    result.cmx \
+    ocamltest_stdlib.cmx \
+    modifier_parser.cmx \
+    filecompare.cmx \
+    environments.cmx \
+    builtin_variables.cmx \
+    actions.cmx \
+    actions_helpers.cmi
+actions_helpers.cmi : \
+    variables.cmi \
+    result.cmi \
+    environments.cmi \
+    actions.cmi
+builtin_actions.cmo : \
+    result.cmi \
+    ocamltest_stdlib.cmi \
+    ocamltest_config.cmi \
+    environments.cmi \
+    builtin_variables.cmi \
+    actions_helpers.cmi \
+    actions.cmi \
+    builtin_actions.cmi
+builtin_actions.cmx : \
+    result.cmx \
+    ocamltest_stdlib.cmx \
+    ocamltest_config.cmx \
+    environments.cmx \
+    builtin_variables.cmx \
+    actions_helpers.cmx \
+    actions.cmx \
+    builtin_actions.cmi
+builtin_actions.cmi : \
+    actions.cmi
+builtin_variables.cmo : \
+    variables.cmi \
+    builtin_variables.cmi
+builtin_variables.cmx : \
+    variables.cmx \
+    builtin_variables.cmi
+builtin_variables.cmi : \
+    variables.cmi
+environments.cmo : \
+    variables.cmi \
+    ocamltest_stdlib.cmi \
+    environments.cmi
+environments.cmx : \
+    variables.cmx \
+    ocamltest_stdlib.cmx \
+    environments.cmi
+environments.cmi : \
+    variables.cmi
+filecompare.cmo : \
+    run_command.cmi \
+    ocamltest_stdlib.cmi \
+    filecompare.cmi
+filecompare.cmx : \
+    run_command.cmx \
+    ocamltest_stdlib.cmx \
+    filecompare.cmi
+filecompare.cmi :
+main.cmo : \
+    tsl_semantics.cmi \
+    tsl_parser.cmi \
+    tsl_lexer.cmi \
+    tests.cmi \
+    result.cmi \
+    options.cmi \
+    ocamltest_stdlib.cmi \
+    environments.cmi \
+    builtin_variables.cmi \
+    actions_helpers.cmi \
+    actions.cmi \
+    main.cmi
+main.cmx : \
+    tsl_semantics.cmx \
+    tsl_parser.cmx \
+    tsl_lexer.cmx \
+    tests.cmx \
+    result.cmx \
+    options.cmx \
+    ocamltest_stdlib.cmx \
+    environments.cmx \
+    builtin_variables.cmx \
+    actions_helpers.cmx \
+    actions.cmx \
+    main.cmi
+main.cmi :
+modifier_parser.cmo : \
+    variables.cmi \
+    tsl_lexer.cmi \
+    ocamltest_stdlib.cmi \
+    environments.cmi \
+    modifier_parser.cmi
+modifier_parser.cmx : \
+    variables.cmx \
+    tsl_lexer.cmx \
+    ocamltest_stdlib.cmx \
+    environments.cmx \
+    modifier_parser.cmi
+modifier_parser.cmi : \
+    environments.cmi
+ocaml_actions.cmo : \
+    result.cmi \
+    ocamltest_stdlib.cmi \
+    ocamltest_config.cmi \
+    ocaml_variables.cmi \
+    ocaml_toplevels.cmi \
+    ocaml_tools.cmi \
+    ocaml_modifiers.cmi \
+    ocaml_flags.cmi \
+    ocaml_filetypes.cmi \
+    ocaml_files.cmi \
+    ocaml_directories.cmi \
+    ocaml_compilers.cmi \
+    ocaml_commands.cmi \
+    ocaml_backends.cmi \
+    filecompare.cmi \
+    environments.cmi \
+    builtin_variables.cmi \
+    actions_helpers.cmi \
+    actions.cmi \
+    ocaml_actions.cmi
+ocaml_actions.cmx : \
+    result.cmx \
+    ocamltest_stdlib.cmx \
+    ocamltest_config.cmx \
+    ocaml_variables.cmx \
+    ocaml_toplevels.cmx \
+    ocaml_tools.cmx \
+    ocaml_modifiers.cmx \
+    ocaml_flags.cmx \
+    ocaml_filetypes.cmx \
+    ocaml_files.cmx \
+    ocaml_directories.cmx \
+    ocaml_compilers.cmx \
+    ocaml_commands.cmx \
+    ocaml_backends.cmx \
+    filecompare.cmx \
+    environments.cmx \
+    builtin_variables.cmx \
+    actions_helpers.cmx \
+    actions.cmx \
+    ocaml_actions.cmi
+ocaml_actions.cmi : \
+    actions.cmi
+ocaml_backends.cmo : \
+    ocaml_backends.cmi
+ocaml_backends.cmx : \
+    ocaml_backends.cmi
+ocaml_backends.cmi :
+ocaml_commands.cmo : \
+    ocaml_files.cmi \
+    ocaml_commands.cmi
+ocaml_commands.cmx : \
+    ocaml_files.cmx \
+    ocaml_commands.cmi
+ocaml_commands.cmi :
+ocaml_compilers.cmo : \
+    variables.cmi \
+    ocamltest_stdlib.cmi \
+    ocaml_variables.cmi \
+    ocaml_tools.cmi \
+    ocaml_files.cmi \
+    ocaml_commands.cmi \
+    ocaml_backends.cmi \
+    builtin_variables.cmi \
+    ocaml_compilers.cmi
+ocaml_compilers.cmx : \
+    variables.cmx \
+    ocamltest_stdlib.cmx \
+    ocaml_variables.cmx \
+    ocaml_tools.cmx \
+    ocaml_files.cmx \
+    ocaml_commands.cmx \
+    ocaml_backends.cmx \
+    builtin_variables.cmx \
+    ocaml_compilers.cmi
+ocaml_compilers.cmi : \
+    variables.cmi \
+    ocaml_tools.cmi \
+    ocaml_backends.cmi
+ocaml_directories.cmo : \
+    ocamltest_stdlib.cmi \
+    ocamltest_config.cmi \
+    ocaml_directories.cmi
+ocaml_directories.cmx : \
+    ocamltest_stdlib.cmx \
+    ocamltest_config.cmx \
+    ocaml_directories.cmi
+ocaml_directories.cmi :
+ocaml_files.cmo : \
+    ocamltest_stdlib.cmi \
+    ocamltest_config.cmi \
+    ocaml_files.cmi
+ocaml_files.cmx : \
+    ocamltest_stdlib.cmx \
+    ocamltest_config.cmx \
+    ocaml_files.cmi
+ocaml_files.cmi :
+ocaml_filetypes.cmo : \
+    ocamltest_config.cmi \
+    ocaml_backends.cmi \
+    ocaml_filetypes.cmi
+ocaml_filetypes.cmx : \
+    ocamltest_config.cmx \
+    ocaml_backends.cmx \
+    ocaml_filetypes.cmi
+ocaml_filetypes.cmi : \
+    ocaml_backends.cmi
+ocaml_flags.cmo : \
+    ocaml_variables.cmi \
+    ocaml_files.cmi \
+    ocaml_directories.cmi \
+    ocaml_backends.cmi \
+    environments.cmi \
+    ocaml_flags.cmi
+ocaml_flags.cmx : \
+    ocaml_variables.cmx \
+    ocaml_files.cmx \
+    ocaml_directories.cmx \
+    ocaml_backends.cmx \
+    environments.cmx \
+    ocaml_flags.cmi
+ocaml_flags.cmi : \
+    ocaml_backends.cmi \
+    environments.cmi
+ocaml_modifiers.cmo : \
+    ocamltest_stdlib.cmi \
+    ocamltest_config.cmi \
+    ocaml_variables.cmi \
+    environments.cmi \
+    ocaml_modifiers.cmi
+ocaml_modifiers.cmx : \
+    ocamltest_stdlib.cmx \
+    ocamltest_config.cmx \
+    ocaml_variables.cmx \
+    environments.cmx \
+    ocaml_modifiers.cmi
+ocaml_modifiers.cmi : \
+    environments.cmi
+ocaml_tests.cmo : \
+    tests.cmi \
+    ocamltest_config.cmi \
+    ocaml_actions.cmi \
+    builtin_actions.cmi \
+    actions_helpers.cmi \
+    ocaml_tests.cmi
+ocaml_tests.cmx : \
+    tests.cmx \
+    ocamltest_config.cmx \
+    ocaml_actions.cmx \
+    builtin_actions.cmx \
+    actions_helpers.cmx \
+    ocaml_tests.cmi
+ocaml_tests.cmi : \
+    tests.cmi
+ocaml_tools.cmo : \
+    variables.cmi \
+    ocamltest_stdlib.cmi \
+    ocaml_variables.cmi \
+    ocaml_files.cmi \
+    environments.cmi \
+    actions_helpers.cmi \
+    ocaml_tools.cmi
+ocaml_tools.cmx : \
+    variables.cmx \
+    ocamltest_stdlib.cmx \
+    ocaml_variables.cmx \
+    ocaml_files.cmx \
+    environments.cmx \
+    actions_helpers.cmx \
+    ocaml_tools.cmi
+ocaml_tools.cmi : \
+    variables.cmi \
+    environments.cmi
+ocaml_toplevels.cmo : \
+    variables.cmi \
+    ocamltest_stdlib.cmi \
+    ocaml_variables.cmi \
+    ocaml_tools.cmi \
+    ocaml_files.cmi \
+    ocaml_compilers.cmi \
+    ocaml_commands.cmi \
+    ocaml_backends.cmi \
+    ocaml_toplevels.cmi
+ocaml_toplevels.cmx : \
+    variables.cmx \
+    ocamltest_stdlib.cmx \
+    ocaml_variables.cmx \
+    ocaml_tools.cmx \
+    ocaml_files.cmx \
+    ocaml_compilers.cmx \
+    ocaml_commands.cmx \
+    ocaml_backends.cmx \
+    ocaml_toplevels.cmi
+ocaml_toplevels.cmi : \
+    variables.cmi \
+    ocaml_tools.cmi \
+    ocaml_compilers.cmi \
+    ocaml_backends.cmi
+ocaml_variables.cmo : \
+    variables.cmi \
+    ocamltest_stdlib.cmi \
+    ocaml_variables.cmi
+ocaml_variables.cmx : \
+    variables.cmx \
+    ocamltest_stdlib.cmx \
+    ocaml_variables.cmi
+ocaml_variables.cmi : \
+    variables.cmi
+ocamltest_config.cmo : \
+    ocamltest_config.cmi
+ocamltest_config.cmx : \
+    ocamltest_config.cmi
+ocamltest_config.cmi :
+ocamltest_stdlib.cmo : \
+    ocamltest_stdlib.cmi
+ocamltest_stdlib.cmx : \
+    ocamltest_stdlib.cmi
+ocamltest_stdlib.cmi :
+options.cmo : \
+    variables.cmi \
+    tests.cmi \
+    actions.cmi \
+    options.cmi
+options.cmx : \
+    variables.cmx \
+    tests.cmx \
+    actions.cmx \
+    options.cmi
+options.cmi :
+result.cmo : \
+    result.cmi
+result.cmx : \
+    result.cmi
+result.cmi :
+run_command.cmo : \
+    ocamltest_stdlib.cmi \
+    run_command.cmi
+run_command.cmx : \
+    ocamltest_stdlib.cmx \
+    run_command.cmi
+run_command.cmi :
+strace.cmo : \
+    variables.cmi \
+    strace.cmi
+strace.cmx : \
+    variables.cmx \
+    strace.cmi
+strace.cmi : \
+    variables.cmi
+tests.cmo : \
+    result.cmi \
+    actions.cmi \
+    tests.cmi
+tests.cmx : \
+    result.cmx \
+    actions.cmx \
+    tests.cmi
+tests.cmi : \
+    result.cmi \
+    environments.cmi \
+    actions.cmi
+tsl_ast.cmo : \
+    tsl_ast.cmi
+tsl_ast.cmx : \
+    tsl_ast.cmi
+tsl_ast.cmi :
+tsl_lexer.cmo : \
+    tsl_parser.cmi \
+    tsl_lexer.cmi
+tsl_lexer.cmx : \
+    tsl_parser.cmx \
+    tsl_lexer.cmi
+tsl_lexer.cmi : \
+    tsl_parser.cmi
+tsl_parser.cmo : \
+    tsl_ast.cmi \
+    tsl_parser.cmi
+tsl_parser.cmx : \
+    tsl_ast.cmx \
+    tsl_parser.cmi
+tsl_parser.cmi : \
+    tsl_ast.cmi
+tsl_semantics.cmo : \
+    variables.cmi \
+    tsl_ast.cmi \
+    tests.cmi \
+    environments.cmi \
+    actions.cmi \
+    tsl_semantics.cmi
+tsl_semantics.cmx : \
+    variables.cmx \
+    tsl_ast.cmx \
+    tests.cmx \
+    environments.cmx \
+    actions.cmx \
+    tsl_semantics.cmi
+tsl_semantics.cmi : \
+    tsl_ast.cmi \
+    tests.cmi \
+    environments.cmi \
+    actions.cmi
+variables.cmo : \
+    variables.cmi
+variables.cmx : \
+    variables.cmi
+variables.cmi :
diff --git a/ocamltest/Makefile b/ocamltest/Makefile
new file mode 100644
index 00000000..eb7e7587
--- /dev/null
+++ b/ocamltest/Makefile
@@ -0,0 +1,300 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Sebastien Hinderer, projet Gallium, INRIA Paris             *
+#*                                                                        *
+#*   Copyright 2016 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.          *
+#*                                                                        *
+#**************************************************************************
+
+# The Makefile for ocamltest
+
+ROOTDIR = ..
+
+-include $(ROOTDIR)/Makefile.config
+-include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.best_binaries
+
+ifeq "$(filter str,$(OTHERLIBRARIES))" ""
+  str := false
+else
+  str := true
+endif
+
+ifeq "$(filter systhreads,$(OTHERLIBRARIES))" ""
+  systhreads := false
+else
+  systhreads := true
+endif
+
+ifeq "$(filter $(UNIXLIB),$(OTHERLIBRARIES))" ""
+  unix := None
+else
+  ifeq "$(UNIX_OR_WIN32)" "win32"
+    unix := Some false
+  else
+    unix := Some true
+  endif
+endif
+
+ifeq "$(UNIX_OR_WIN32)" "win32"
+  ocamlsrcdir := $(shell echo "$(abspath $(shell pwd)/..)"|cygpath -w -f - \
+    | sed 's/\\/\\\\\\\\/g')
+  mkexe := $(MKEXE_ANSI) -link $(OC_LDFLAGS)
+else
+  ocamlsrcdir := $(abspath $(shell pwd)/..)
+  mkexe := $(MKEXE)
+endif
+
+ifeq "$(TOOLCHAIN)" "msvc"
+CPP := $(CPP) 2> nul
+CSC := csc
+ifeq "$(HOST)" "i686-pc-windows"
+CSCFLAGS := /platform:x86
+else
+CSCFLAGS :=
+endif
+CSCFLAGS += /nologo /nowarn:1668
+else
+CSC :=
+CSCFLAGS :=
+endif
+
+ifeq "$(WITH_OCAMLDOC)" "ocamldoc"
+WITH_OCAMLDOC := true
+else
+WITH_OCAMLDOC := false
+endif
+
+ifeq "$(WITH_DEBUGGER)" "ocamldebugger"
+WITH_OCAMLDEBUG := true
+else
+WITH_OCAMLDEBUG := false
+endif
+
+OC_CPPFLAGS += -I$(ROOTDIR)/runtime -DCAML_INTERNALS
+
+run := run_$(UNIX_OR_WIN32)
+
+# List of source files from which ocamltest is compiled
+# (all the different sorts of files are derived from this)
+
+# ocamltest has two components: its core and the OCaml "plugin"
+# which is actually built into the tool but clearly separated from its core
+
+core := \
+  $(run).c \
+  run_stubs.c \
+  ocamltest_stdlib_stubs.c \
+  ocamltest_config.mli ocamltest_config.ml.in \
+  ocamltest_stdlib.mli ocamltest_stdlib.ml \
+  run_command.mli run_command.ml \
+  filecompare.mli filecompare.ml \
+  variables.mli variables.ml \
+  environments.mli environments.ml \
+  result.mli result.ml \
+  actions.mli actions.ml \
+  tests.mli tests.ml \
+  strace.mli strace.ml \
+  tsl_ast.mli tsl_ast.ml \
+  tsl_parser.mly \
+  tsl_lexer.mli tsl_lexer.mll \
+  modifier_parser.mli modifier_parser.ml \
+  tsl_semantics.mli tsl_semantics.ml \
+  builtin_variables.mli builtin_variables.ml \
+  actions_helpers.mli actions_helpers.ml \
+  builtin_actions.mli builtin_actions.ml
+
+ocaml_plugin := \
+  ocaml_backends.mli ocaml_backends.ml \
+  ocaml_filetypes.mli ocaml_filetypes.ml \
+  ocaml_variables.mli ocaml_variables.ml \
+  ocaml_modifiers.mli ocaml_modifiers.ml \
+  ocaml_directories.mli ocaml_directories.ml \
+  ocaml_files.mli ocaml_files.ml \
+  ocaml_flags.mli ocaml_flags.ml \
+  ocaml_commands.mli ocaml_commands.ml \
+  ocaml_tools.mli ocaml_tools.ml \
+  ocaml_compilers.mli ocaml_compilers.ml \
+  ocaml_toplevels.mli ocaml_toplevels.ml \
+  ocaml_actions.mli ocaml_actions.ml \
+  ocaml_tests.mli ocaml_tests.ml
+
+sources := $(core) $(ocaml_plugin) \
+  options.mli options.ml \
+  main.mli main.ml
+
+# List of .ml files used for ocamldep and to get the list of modules
+
+ml_files := \
+  $(filter %.ml, \
+    $(subst .ml.in,.ml,$(subst .mll,.ml,$(subst .mly,.ml,$(sources)))) \
+  )
+
+cmo_files := $(ml_files:.ml=.cmo)
+
+cmx_files := $(ml_files:.ml=.cmx)
+
+ocaml_objects := $(ml_files:.ml=.$(O))
+
+# List of .mli files for ocamldep
+mli_files := \
+  $(filter %.mli,$(subst .mly,.mli,$(sources)))
+
+cmi_files := $(mli_files:.mli=.cmi)
+
+c_files := $(filter %.c, $(sources))
+
+o_files := $(c_files:.c=.$(O))
+
+lexers := $(filter %.mll,$(sources))
+
+parsers := $(filter %.mly,$(sources))
+
+config_files := $(filter %.ml.in,$(sources))
+
+dependencies_generated_prereqs := \
+  $(config_files:.ml.in=.ml) \
+  $(lexers:.mll=.ml) \
+  $(parsers:.mly=.mli) $(parsers:.mly=.ml)
+
+generated := $(dependencies_generated_prereqs) $(parsers:.mly=.output)
+
+bytecode_modules := $(o_files) $(cmo_files)
+
+native_modules := $(o_files) $(cmx_files)
+
+directories := $(addprefix $(ROOTDIR)/,utils bytecomp parsing stdlib \
+                                       compilerlibs file_formats)
+
+include_directories := $(addprefix -I , $(directories))
+
+flags := -g -nostdlib $(include_directories) \
+  -strict-sequence -safe-string -strict-formats \
+  -w +a-4-9-41-42-44-45-48 -warn-error A
+
+ocamlc := $(BEST_OCAMLC) $(flags)
+
+ocamlopt :=  $(BEST_OCAMLOPT) $(flags)
+
+ocamldep := $(BEST_OCAMLDEP)
+depflags := -slash
+depincludes :=
+
+ocamllex := $(BEST_OCAMLLEX)
+
+ocamlyacc := $(ROOTDIR)/yacc/ocamlyacc
+
+ocamlcdefaultflags :=
+
+ocamloptdefaultflags := $(shell ./getocamloptdefaultflags $(TARGET))
+
+.SECONDARY: $(lexers:.mll=.ml) $(parsers:.mly=.mli) $(parsers:.mly=.ml)
+
+.PHONY: all allopt opt.opt # allopt and opt.opt are synonyms
+all: ocamltest$(EXE)
+allopt: ocamltest.opt$(EXE)
+opt.opt: allopt
+
+compdeps_names=ocamlcommon ocamlbytecomp
+compdeps_paths=$(addprefix $(ROOTDIR)/compilerlibs/,$(compdeps_names))
+compdeps_byte=$(addsuffix .cma,$(compdeps_paths))
+compdeps_opt=$(addsuffix .cmxa,$(compdeps_paths))
+
+ocamltest$(EXE): $(compdeps_byte) $(bytecode_modules)
+	$(ocamlc_cmd) -custom -o $@ $^
+
+%.cmo: %.ml $(compdeps_byte)
+	$(ocamlc) -c $<
+
+ocamltest.opt$(EXE): $(compdeps_opt) $(native_modules)
+	$(ocamlopt_cmd) -o $@ $^
+
+%.cmx: %.ml $(compdeps_opt)
+	$(ocamlopt) -c $<
+
+%.cmi: %.mli $(compdeps_byte)
+	$(ocamlc) -c $<
+
+%.ml %.mli: %.mly
+	$(ocamlyacc) $<
+
+%.ml: %.mll
+	$(ocamllex) $(OCAMLLEX_FLAGS) $<
+
+ocamltest_config.ml: ocamltest_config.ml.in Makefile ../Makefile.config
+	sed \
+	  -e 's|@@AFL_INSTRUMENT@@|$(AFL_INSTRUMENT)|' \
+	  -e 's|@@RUNTIMEI@@|$(RUNTIMEI)|' \
+	  -e 's|@@ARCH@@|$(ARCH)|' \
+	  -e 's|@@SHARED_LIBRARIES@@|$(SUPPORTS_SHARED_LIBRARIES)|' \
+	  -e 's|@@UNIX@@|$(unix)|' \
+	  -e 's|@@SYSTHREADS@@|$(systhreads)|' \
+	  -e 's|@@STR@@|$(str)|' \
+	  -e 's|@@SYSTEM@@|$(SYSTEM)|' \
+	  -e 's|@@CPP@@|$(CPP)|' \
+	  -e 's|@@OCAMLCDEFAULTFLAGS@@|$(ocamlcdefaultflags)|' \
+	  -e 's|@@OCAMLOPTDEFAULTFLAGS@@|$(ocamloptdefaultflags)|' \
+	  -e 's|@@OCAMLSRCDIR@@|$(ocamlsrcdir)|' \
+	  -e 's|@@FLAMBDA@@|$(FLAMBDA)|' \
+	  -e 's|@@SPACETIME@@|$(WITH_SPACETIME)|' \
+	  -e 's|@@FORCE_SAFE_STRING@@|$(FORCE_SAFE_STRING)|' \
+	  -e 's|@@FLAT_FLOAT_ARRAY@@|$(FLAT_FLOAT_ARRAY)|' \
+	  -e 's|@@OCAMLDOC@@|$(WITH_OCAMLDOC)|' \
+	  -e 's|@@OCAMLDEBUG@@|$(WITH_OCAMLDEBUG)|' \
+	  -e 's|@@OBJEXT@@|$(O)|' \
+	  -e 's|@@ASMEXT@@|$(S)|' \
+	  -e 's|@@NATIVE_DYNLINK@@|$(NATDYNLINK)|' \
+	  -e 's|@@SHARED_LIBRARY_CFLAGS@@|$(SHAREDLIB_CFLAGS)|' \
+	  -e 's|@@SHAREDOBJEXT@@|$(SO)|' \
+	  -e 's|@@CSC@@|$(CSC)|' \
+	  -e 's|@@CSCFLAGS@@|$(CSCFLAGS)|' \
+	  -e 's|@@MKDLL@@|$(MKDLL)|' \
+	  -e 's|@@MKEXE@@|$(mkexe)|' \
+	  -e 's|@@BYTECCLIBS@@|$(BYTECCLIBS)|' \
+	  -e 's|@@NATIVECCLIBS@@|$(NATIVECCLIBS)|' \
+	  -e 's|@@ASM@@|$(ASM)|' \
+	  -e 's|@@CC@@|$(CC)|' \
+	  -e 's|@@CFLAGS@@|$(OC_CFLAGS)|' \
+	  -e 's|@@CCOMPTYPE@@|$(CCOMPTYPE)|' \
+	  -e 's|@@WINDOWS_UNICODE@@|$(WINDOWS_UNICODE)|' \
+	  -e 's|@@FUNCTION_SECTIONS@@|$(FUNCTION_SECTIONS)|' \
+	  $< > $@
+
+# Manual
+
+.PHONY: doc
+
+doc: ocamltest.html
+
+ocamltest.html: ocamltest.org
+	pandoc -s --toc -N -f org -t html -o $@ $<
+
+.PHONY: clean
+clean:
+	rm -rf ocamltest ocamltest.exe ocamltest.opt ocamltest.opt.exe
+	rm -rf $(c_files:.c=.o) $(c_files:.c=.obj)
+	rm -rf run_unix.o run_win32.o run_win32.obj
+	rm -rf $(ml_files:.ml=.o) $(ml_files:.ml=.obj)
+	rm -rf $(cmi_files)
+	rm -rf $(cmo_files)
+	rm -rf $(cmx_files)
+	rm -rf $(generated)
+	rm -f ocamltest.html
+
+ifneq "$(TOOLCHAIN)" "msvc"
+.PHONY: depend
+depend: $(dependencies_generated_prereqs)
+	$(CC) -MM $(OC_CPPFLAGS) $(c_files) \
+	  | sed -e 's/\.o/.$$(O)/' > .depend
+	$(ocamldep) $(depflags) $(depincludes) $(mli_files) $(ml_files) \
+	  >> .depend
+endif
+
+-include .depend
diff --git a/ocamltest/README b/ocamltest/README
new file mode 100644
index 00000000..f54dc5d0
--- /dev/null
+++ b/ocamltest/README
@@ -0,0 +1,199 @@
+# Introduction
+
+## Context
+
+The testsuite of the OCaml compiler consists of a series of programs
+that are compiled and executed. The output of their compilation and
+execution is compared to expected outputs.
+
+Before the introduction of ocamltest, the tests were driven by a set of
+makefiles which were responsible for compiling and running the test
+programs, and verifying that the compilation and execution outputs were
+matching the expected ones.
+
+In this set-up, the precise information about how exactly one test
+should be compiled was separated from the test itself. It was stored
+somewhere in the makefiles, interleaved with the recipes to actually
+compile and run the test. Thus, given one test, it was not easy to
+determine exactly how this test was supposed to be compiled and run.
+
+## Purpose
+
+The ocamltest tool has been introduced to replace most of the makefiles
+logic. It takes a test program as its input and derives from annotations
+stored as a special comment at the beginning of the program the exact
+way to compile and run it. Thus the test-specific metadata are stored in
+the test file itself and clearly separated from the machinery required
+to perform the actual tasks, which is centralized in the ocamltest tool.
+
+## Constraints
+
+It may look odd at first glance to write the tool used to test the
+compiler in its target language. There are, however, parts of the
+compiler and the standard library that are already tested in a way,
+namely those used to compile the compiler itself. Therefore, these
+components can be considered more trustworthy than those that have
+not yet been used and that's
+why ocamltest relies only on the part of the standard library that has been
+used to develop the compiler itself.
+
+This excludes for instance the use of the Unix and Str libraries.
+
+# Initial set-up
+
+ocamltest needs to know two things:
+
+1. Where the sources of the OCaml compiler to test are located.
+This is determined while OCaml is built. The default location can be
+overridden by defining the OCAMLSRCDIR environment variable.
+
+2. Which directory to use to build tests. The default value for this is
+"ocamltest" under Filename.get_temp_dir_name(). This value can be
+overridden by defining the OCAMLTESTDIR environment variable.
+
+# Running tests
+
+(all the commands below are assumed to be run from OCAMLSRCDIR/testsuite)
+
+From here, one can:
+
+## Run all tests: make all
+
+This runs the complete testsuite. This includes the "legacy" tests
+that still use the makefile-based infrastructure and the "new" tests
+that have been migrated to use ocamltest.
+
+## Run legacy tests: make legacy
+
+## Run new tests: make new
+
+## Run tests manually
+
+It is convenient to have the following ocamltest script in a directory
+appearing in PATH, like ~/bin:
+
+#!/bin/sh
+TERM=dumb OCAMLRUNPARAM= /path/to/ocaml/sources/ocamltest/ocamltest $*
+
+Once this file has been made executable, one can for instance run:
+
+ocamltest tests/basic-io/wc.ml
+
+As can be seen, ocamltest's output looks similar to the legacy format.
+
+This is to make the transition between the makefile-based
+infrastructure and ocamltest as smooth as possible. Once all the
+tests will have been migrated to ocamltest, it will become possible to
+change this output format.
+
+The details of what exactly has been tested can be found in
+${OCAMLTESTDIR}/tests/basic-io/wc/wc.log
+
+One can then examine tests/basic-io/wc.ml to see how the file
+had to be annotated to produce such a result.
+
+Many other tests have already been migrated and it may be useful to see
+how the test files have been annotated. the command
+
+find tests -name '*ocamltests*' | xargs cat
+
+gives a list of tests that have been modified and can therefore be used
+as starting points to understand what ocamltest can do.
+
+# Migrating tests from makefiles to ocamltest
+
+It may be a good idea to run make new from the testsuite directory before
+starting to migrate tests. This will show how many "new" tests there
+already are.
+
+Then, when running make new after migrating n tests,
+the number of new tests reported by make new should have increased by n.
+
+OCaml's testsuite is divided into directories, each of them
+containing one or several tests, which can each consist of one or
+several files.
+
+Thus, the directory is the smallest unit that can be migrated.
+
+To see which directories still need to be migrated, do:
+
+find tests -name 'Makefile'
+
+In other words, the directories that still need to be migrated are
+the subdirectories of testsuite/tests that still contain a Makefile.
+
+Once you know which directory you want to migrate, say foo, here is
+what you should do:
+
+Read foo/Makefile to see how many tests the directory contains and how
+they are compiled. If the makefile only includes other makefiles and
+does not define any variable, then it means that nothing special
+has to be done to compile or run the tests.
+
+You can also run the tests of this directory with the legacy framework,
+to see exactly how they are compiled and executed. To do so, use the
+following command  from the testsuite directory:
+
+make --trace DIR=tests/foo
+
+(You may want to log the output of this command for future reference.)
+
+For each test, annotate its main file with a test block, i.e. a
+comment that looks like this:
+
+(* TEST
+  Optional variable assignments and tests
+*)
+
+In particular, if the test's main file is foo.ml and the test uses
+modules m1.ml and m2.ml, the test block will look like this:
+
+(* TEST
+  modules = "m1.ml m2.ml"
+*)
+
+And if the test consists of a single file foo.ml that needs to be
+run under the top-level, then its test block will look like this:
+
+(* TEST
+  * toplevel
+*)
+
+Or, if there are two reference files for that test and the name
+of one of them contains "principal", then it means the file should
+be tested with the top-level, without and with the -principal option.
+This is expressed as follows:
+
+(* TEST
+  * toplevel
+  * toplevel
+    include principal
+*)
+
+Lines starting with stars indicate which tests to run. If no test is
+specified, then the tests that are enabled by default are used,
+namely to compile and run the test program in both bytecode and native
+code (roughly speaking).
+
+Once your test has been annotated, run ocamltest on it and see
+whether it passes or fails. If it fails, see the log file to understand why
+and make the necessary adjustments until all the tests pass.
+
+The adjustments will mostly consist in renaming reference files and
+updating their content.
+
+Note that there are different types of reference files, those for
+compiler output and those for program output.
+
+To make sure the migration has been done correctly, you can compare the
+commands used to compile the programs in ocamltest's log file to those
+obtained with make --trace. Beware that the commands used to compare an
+obtained result to an expected one will not show up in ocamltest's log
+file.
+
+Once this has been done for all tests, create a file called "ocamltests"
+(mark the final s!) with the names of all the files that
+have been annotated for ocamltest, one per line.
+
+Finally, git rm the Makefile and run make new from the testsuite directory
+to make sure the number of new tests has increased as expected.
diff --git a/ocamltest/actions.ml b/ocamltest/actions.ml
new file mode 100644
index 00000000..cb436a60
--- /dev/null
+++ b/ocamltest/actions.ml
@@ -0,0 +1,75 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of actions, basic blocks for tests *)
+
+type code = out_channel -> Environments.t -> Result.t * Environments.t
+
+type t = {
+  name : string;
+  body : code;
+  mutable hook : code option
+}
+
+let name a = a.name
+
+let action_name = Variables.make ("action_name", "Name of the current action")
+
+let make n c = { name = n; body = c; hook = None }
+
+let update action code = { action with body = code }
+
+let compare a1 a2 = String.compare a1.name a2.name
+
+let (actions : (string, t) Hashtbl.t) = Hashtbl.create 10
+
+let register action =
+  Hashtbl.add actions action.name action
+
+let get_registered_actions () =
+  let f _name action acc = action::acc in
+  let unsorted_actions = Hashtbl.fold f actions [] in
+  List.sort compare unsorted_actions
+
+let lookup name =
+  try Some (Hashtbl.find actions name)
+  with Not_found -> None
+
+let set_hook name hook =
+  let action = (Hashtbl.find actions name) in
+  action.hook <- Some hook
+
+let clear_hook name =
+  let action = (Hashtbl.find actions name) in
+  action.hook <- None
+
+let clear_all_hooks () =
+  let f _name action = action.hook <- None in
+  Hashtbl.iter f actions
+
+let run log env action =
+  let code = match action.hook with
+    | None -> action.body
+    | Some code -> code in
+  let env = Environments.add action_name action.name env in
+  code log env
+
+module ActionSet = Set.Make
+(struct
+  type nonrec t = t
+  let compare = compare
+end)
+
+let _ = Variables.register_variable action_name
diff --git a/ocamltest/actions.mli b/ocamltest/actions.mli
new file mode 100644
index 00000000..bdcf4258
--- /dev/null
+++ b/ocamltest/actions.mli
@@ -0,0 +1,44 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of actions, basic blocks for tests *)
+
+type code = out_channel -> Environments.t -> Result.t * Environments.t
+
+type t
+
+val name : t -> string
+
+val action_name : Variables.t
+
+val update : t -> code -> t
+
+val make : string -> code -> t
+
+val compare : t -> t -> int
+
+val register : t -> unit
+
+val get_registered_actions : unit -> t list
+
+val lookup : string -> t option
+
+val set_hook : string -> code -> unit
+val clear_hook : string -> unit
+val clear_all_hooks : unit -> unit
+
+val run : out_channel -> Environments.t -> t -> Result.t * Environments.t
+
+module ActionSet : Set.S with type elt = t
diff --git a/ocamltest/actions_helpers.ml b/ocamltest/actions_helpers.ml
new file mode 100644
index 00000000..6dae89fd
--- /dev/null
+++ b/ocamltest/actions_helpers.ml
@@ -0,0 +1,342 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Helper functions when writing actions *)
+
+open Ocamltest_stdlib
+
+let skip_with_reason reason =
+  let code _log env =
+    let result = Result.skip_with_reason reason in
+    (result, env)
+  in
+  Actions.make "skip" code
+
+let pass_or_skip test pass_reason skip_reason _log env =
+  let open Result in
+  let result =
+    if test
+    then pass_with_reason pass_reason
+    else skip_with_reason skip_reason in
+  (result, env)
+
+let mkreason what commandline exitcode =
+  Printf.sprintf "%s: command\n%s\nfailed with exit code %d"
+    what commandline exitcode
+
+let testfile env =
+  match Environments.lookup Builtin_variables.test_file env with
+  | None -> assert false
+  | Some t -> t
+
+let test_source_directory env =
+  Environments.safe_lookup Builtin_variables.test_source_directory env
+
+let test_build_directory env =
+  Environments.safe_lookup Builtin_variables.test_build_directory env
+
+let test_build_directory_prefix env =
+  Environments.safe_lookup Builtin_variables.test_build_directory_prefix env
+
+let words_of_variable env variable =
+  String.words (Environments.safe_lookup variable env)
+
+let exit_status_of_variable env variable =
+  try int_of_string
+    (Environments.safe_lookup variable env)
+  with _ -> 0
+
+let files env = words_of_variable env Builtin_variables.files
+
+let setup_symlinks test_source_directory build_directory files =
+  let symlink filename =
+    let src = Filename.concat test_source_directory filename in
+    let cmd = "ln -sf " ^ src ^" " ^ build_directory in
+    Sys.run_system_command cmd in
+  let copy filename =
+    let src = Filename.concat test_source_directory filename in
+    let dst = Filename.concat build_directory filename in
+    Sys.copy_file src dst in
+  let f = if Sys.os_type="Win32" then copy else symlink in
+  Sys.make_directory build_directory;
+  List.iter f files
+
+let setup_build_env add_testfile additional_files (_log : out_channel) env =
+  let build_dir = (test_build_directory env) in
+  let some_files = additional_files @ (files env) in
+  let files =
+    if add_testfile
+    then (testfile env) :: some_files
+    else some_files in
+  setup_symlinks (test_source_directory env) build_dir files;
+  Sys.chdir build_dir;
+  (Result.pass, env)
+
+let setup_simple_build_env add_testfile additional_files log env =
+  let build_env = Environments.add
+    Builtin_variables.test_build_directory
+    (test_build_directory_prefix env) env in
+  setup_build_env add_testfile additional_files log build_env
+
+let run_cmd
+    ?(environment=[||])
+    ?(stdin_variable=Builtin_variables.stdin)
+    ?(stdout_variable=Builtin_variables.stdout)
+    ?(stderr_variable=Builtin_variables.stderr)
+    ?(append=false)
+    ?(timeout=0)
+    log env original_cmd
+  =
+  let log_redirection std filename =
+    if filename<>"" then
+    begin
+      Printf.fprintf log "  Redirecting %s to %s \n%!" std filename
+    end in
+  let cmd =
+    if (Environments.lookup_as_bool Strace.strace env) = Some true then
+    begin
+      let action_name = Environments.safe_lookup Actions.action_name env in
+      let test_build_directory = test_build_directory env in
+      let strace_logfile_name = Strace.get_logfile_name action_name in
+      let strace_logfile =
+        Filename.make_path [test_build_directory; strace_logfile_name]
+      in
+      let strace_flags = Environments.safe_lookup Strace.strace_flags env in
+      let strace_cmd =
+        ["strace"; "-f"; "-o"; strace_logfile; strace_flags]
+      in
+      strace_cmd @ original_cmd
+    end else original_cmd
+  in
+  let lst = List.concat (List.map String.words cmd) in
+  let quoted_lst =
+    if Sys.os_type="Win32"
+    then List.map Filename.maybe_quote lst
+    else lst in
+  let cmd' = String.concat " " quoted_lst in
+  Printf.fprintf log "Commandline: %s\n" cmd';
+  let progname = List.hd quoted_lst in
+  let arguments = Array.of_list quoted_lst in
+  let stdin_filename = Environments.safe_lookup stdin_variable env in
+  let stdout_filename = Environments.safe_lookup stdout_variable env in
+  let stderr_filename = Environments.safe_lookup stderr_variable env in
+  log_redirection "stdin" stdin_filename;
+  log_redirection "stdout" stdout_filename;
+  log_redirection "stderr" stderr_filename;
+  let systemenv =
+    Array.append
+      environment
+      (Environments.to_system_env env)
+  in
+  Run_command.run {
+    Run_command.progname = progname;
+    Run_command.argv = arguments;
+    Run_command.envp = systemenv;
+    Run_command.stdin_filename = stdin_filename;
+    Run_command.stdout_filename = stdout_filename;
+    Run_command.stderr_filename = stderr_filename;
+    Run_command.append = append;
+    Run_command.timeout = timeout;
+    Run_command.log = log
+  }
+
+let run
+    (log_message : string)
+    (redirect_output : bool)
+    (can_skip : bool)
+    (prog_variable : Variables.t)
+    (args_variable : Variables.t option)
+    (log : out_channel)
+    (env : Environments.t)
+  =
+  match Environments.lookup prog_variable env with
+  | None ->
+    let msg = Printf.sprintf "%s: variable %s is undefined"
+      log_message (Variables.name_of_variable prog_variable) in
+    (Result.fail_with_reason msg, env)
+  | Some program ->
+    let arguments = match args_variable with
+      | None -> ""
+      | Some variable -> Environments.safe_lookup variable env in
+    let commandline = [program; arguments] in
+    let what = log_message ^ " " ^ program ^ " " ^
+    begin if arguments="" then "without any argument"
+    else "with arguments " ^ arguments
+    end in
+    let env =
+      if redirect_output
+      then begin
+        let output = Environments.safe_lookup Builtin_variables.output env in
+        let env =
+          Environments.add_if_undefined Builtin_variables.stdout output env
+        in
+        Environments.add_if_undefined Builtin_variables.stderr output env
+      end else env
+    in
+    let expected_exit_status =
+      exit_status_of_variable env Builtin_variables.exit_status
+    in
+    let exit_status = run_cmd log env commandline in
+    if exit_status=expected_exit_status
+    then (Result.pass, env)
+    else begin
+      let reason = mkreason what (String.concat " " commandline) exit_status in
+      if exit_status = 125 && can_skip
+      then (Result.skip_with_reason reason, env)
+      else (Result.fail_with_reason reason, env)
+    end
+
+let run_program =
+  run
+    "Running program"
+    true
+    false
+    Builtin_variables.program
+    (Some Builtin_variables.arguments)
+
+let run_script log env =
+  let response_file = Filename.temp_file "ocamltest-" ".response" in
+  Printf.fprintf log "Script should write its response to %s\n%!"
+    response_file;
+  let scriptenv = Environments.add
+    Builtin_variables.ocamltest_response response_file env in
+  let (result, newenv) = run
+    "Running script"
+    true
+    true
+    Builtin_variables.script
+    None
+    log scriptenv in
+  let final_value =
+    if Result.is_pass result then begin
+      match Modifier_parser.modifiers_of_file response_file with
+      | modifiers ->
+        let modified_env = Environments.apply_modifiers newenv modifiers in
+        (result, modified_env)
+      | exception Failure reason ->
+        (Result.fail_with_reason reason, newenv)
+      | exception Variables.No_such_variable name ->
+        let reason =
+          Printf.sprintf "error in script response: unknown variable %s" name
+        in
+        (Result.fail_with_reason reason, newenv)
+    end else begin
+      let reason = String.trim (Sys.string_of_file response_file) in
+      let newresult = { result with Result.reason = Some reason } in
+      (newresult, newenv)
+    end
+  in
+  Sys.force_remove response_file;
+  final_value
+
+let run_hook hook_name log input_env =
+  Printf.fprintf log "Entering run_hook for hook %s\n%!" hook_name;
+  let response_file = Filename.temp_file "ocamltest-" ".response" in
+  Printf.fprintf log "Hook should write its response to %s\n%!"
+    response_file;
+  let hookenv = Environments.add
+    Builtin_variables.ocamltest_response response_file input_env in
+  let systemenv =
+    Environments.to_system_env hookenv in
+  let open Run_command in
+  let settings = {
+    progname = "sh";
+    argv = [|"sh"; Filename.maybe_quote hook_name|];
+    envp = systemenv;
+    stdin_filename = "";
+    stdout_filename = "";
+    stderr_filename = "";
+    append = false;
+    timeout = 0;
+    log = log;
+  } in let exit_status = run settings in
+  let final_value = match exit_status with
+    | 0 ->
+      begin match Modifier_parser.modifiers_of_file response_file with
+      | modifiers ->
+        let modified_env = Environments.apply_modifiers hookenv modifiers in
+        (Result.pass, modified_env)
+      | exception Failure reason ->
+        (Result.fail_with_reason reason, hookenv)
+      | exception Variables.No_such_variable name ->
+        let reason =
+          Printf.sprintf "error in script response: unknown variable %s" name
+        in
+        (Result.fail_with_reason reason, hookenv)
+      end
+    | _ ->
+      Printf.fprintf log "Hook returned %d" exit_status;
+      let reason = String.trim (Sys.string_of_file response_file) in
+      if exit_status=125
+      then (Result.skip_with_reason reason, hookenv)
+      else (Result.fail_with_reason reason, hookenv)
+  in
+  Sys.force_remove response_file;
+  final_value
+
+let check_output kind_of_output output_variable reference_variable log
+    env =
+  let to_int = function None -> 0 | Some s -> int_of_string s in
+  let skip_lines =
+    to_int (Environments.lookup Builtin_variables.skip_header_lines env) in
+  let skip_bytes =
+    to_int (Environments.lookup Builtin_variables.skip_header_bytes env) in
+  let reference_filename = Environments.safe_lookup reference_variable env in
+  let output_filename = Environments.safe_lookup output_variable env in
+  Printf.fprintf log "Comparing %s output %s to reference %s\n%!"
+    kind_of_output output_filename reference_filename;
+  let files =
+  {
+    Filecompare.filetype = Filecompare.Text;
+    Filecompare.reference_filename = reference_filename;
+    Filecompare.output_filename = output_filename
+  } in
+  let ignore_header_conf = {
+      Filecompare.lines = skip_lines;
+      Filecompare.bytes = skip_bytes;
+    } in
+  let tool =
+    Filecompare.make_cmp_tool ~ignore:ignore_header_conf in
+  match Filecompare.check_file ~tool files with
+    | Filecompare.Same -> (Result.pass, env)
+    | Filecompare.Different ->
+      let diff = Filecompare.diff files in
+      let diffstr = match diff with
+        | Ok difference -> difference
+        | Error diff_file -> ("See " ^ diff_file) in
+      let reason =
+        Printf.sprintf "%s output %s differs from reference %s: \n%s\n"
+        kind_of_output output_filename reference_filename diffstr in
+      if Environments.lookup_as_bool Builtin_variables.promote env = Some true
+      then begin
+        Printf.fprintf log "Promoting %s output %s to reference %s\n%!"
+          kind_of_output output_filename reference_filename;
+        Filecompare.promote files ignore_header_conf;
+      end;
+      (Result.fail_with_reason reason, env)
+    | Filecompare.Unexpected_output ->
+      let banner = String.make 40 '=' in
+      let unexpected_output = Sys.string_of_file output_filename in
+      let unexpected_output_with_banners = Printf.sprintf
+        "%s\n%s%s\n" banner unexpected_output banner in
+      let reason = Printf.sprintf
+        "The file %s was expected to be empty because there is no \
+          reference file %s but it is not:\n%s\n"
+        output_filename reference_filename unexpected_output_with_banners in
+      (Result.fail_with_reason reason, env)
+    | Filecompare.Error (commandline, exitcode) ->
+      let reason = Printf.sprintf "The command %s failed with status %d"
+        commandline exitcode in
+      (Result.fail_with_reason reason, env)
diff --git a/ocamltest/actions_helpers.mli b/ocamltest/actions_helpers.mli
new file mode 100644
index 00000000..8c305ff7
--- /dev/null
+++ b/ocamltest/actions_helpers.mli
@@ -0,0 +1,62 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Helper functions when writing actions *)
+
+val skip_with_reason : string -> Actions.t
+
+val pass_or_skip
+  : bool -> string -> string -> out_channel -> Environments.t
+         -> Result.t * Environments.t
+
+val mkreason : string -> string -> int -> string
+
+val testfile : Environments.t -> string
+
+val test_build_directory : Environments.t -> string
+
+val test_source_directory : Environments.t -> string
+
+val words_of_variable : Environments.t -> Variables.t -> string list
+
+val exit_status_of_variable : Environments.t -> Variables.t -> int
+
+val files : Environments.t -> string list
+
+val setup_symlinks : string -> string -> string list -> unit
+
+val setup_build_env : bool -> string list -> Actions.code
+
+val setup_simple_build_env : bool -> string list -> Actions.code
+
+val run_cmd :
+  ?environment : string array ->
+  ?stdin_variable : Variables.t ->
+  ?stdout_variable : Variables.t ->
+  ?stderr_variable : Variables.t ->
+  ?append : bool ->
+  ?timeout : int ->
+  out_channel -> Environments.t -> string list -> int
+
+val run : string -> bool -> bool -> Variables.t
+                 -> Variables.t option -> Actions.code
+
+val run_program : Actions.code
+
+val run_script : Actions.code
+
+val run_hook : string -> Actions.code
+
+val check_output : string -> Variables.t -> Variables.t -> Actions.code
diff --git a/ocamltest/builtin_actions.ml b/ocamltest/builtin_actions.ml
new file mode 100644
index 00000000..99059c1c
--- /dev/null
+++ b/ocamltest/builtin_actions.ml
@@ -0,0 +1,260 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of a few built-in actions *)
+
+open Ocamltest_stdlib
+open Actions
+
+let reason_with_fallback env fallback =
+  match Environments.lookup Builtin_variables.reason env with
+  | None -> fallback
+  | Some reason -> reason
+
+let pass = make
+  "pass"
+  (fun _log env ->
+    let reason = reason_with_fallback env "the pass action always succeeds" in
+    let result = Result.pass_with_reason reason in
+    (result, env))
+
+let skip = make
+  "skip"
+  (fun _log env ->
+    let reason = reason_with_fallback env "the skip action always skips" in
+    let result = Result.skip_with_reason reason in
+    (result, env))
+
+let fail = make
+  "fail"
+  (fun _log env ->
+    let reason = reason_with_fallback env "the fail action always fails" in
+    let result = Result.fail_with_reason reason in
+    (result, env))
+
+let cd = make
+  "cd"
+  (fun _log env ->
+    let cwd = Environments.safe_lookup Builtin_variables.cwd env in
+    begin
+      try
+        Sys.chdir cwd; (Result.pass, env)
+      with _ ->
+        let reason = "Could not chidir to \"" ^ cwd ^ "\"" in
+        let result = Result.fail_with_reason reason in
+        (result, env)
+    end)
+
+let dumpenv = make
+  "dumpenv"
+  (fun log env ->
+    Environments.dump log env; (Result.pass, env))
+
+let hasinstrumentedruntime = make
+  "hasinstrumentedruntime"
+  (Actions_helpers.pass_or_skip (Ocamltest_config.has_instrumented_runtime)
+    "instrumented runtime available"
+    "instrumented runtime not available")
+
+let hasunix = make
+  "hasunix"
+  (Actions_helpers.pass_or_skip (Ocamltest_config.libunix <> None)
+    "unix library available"
+    "unix library not available")
+
+let libunix = make
+  "libunix"
+  (Actions_helpers.pass_or_skip (Ocamltest_config.libunix = Some true)
+    "libunix available"
+    "libunix not available")
+
+let libwin32unix = make
+  "libwin32unix"
+  (Actions_helpers.pass_or_skip (Ocamltest_config.libunix = Some false)
+    "libwin32unix available"
+    "libwin32unix not available")
+
+let hassysthreads = make
+  "hassysthreads"
+  (Actions_helpers.pass_or_skip Ocamltest_config.systhreads
+    "systhreads library available"
+    "systhreads library not available")
+
+let hasstr = make
+  "hasstr"
+  (Actions_helpers.pass_or_skip Ocamltest_config.str
+    "str library available"
+    "str library not available")
+
+let windows_OS = "Windows_NT"
+
+let get_OS () = Sys.safe_getenv "OS"
+
+let windows = make
+  "windows"
+  (Actions_helpers.pass_or_skip (get_OS () = windows_OS)
+    "running on Windows"
+    "not running on Windows")
+
+let not_windows = make
+  "not-windows"
+  (Actions_helpers.pass_or_skip (get_OS () <> windows_OS)
+    "not running on Windows"
+    "running on Windows")
+
+let is_bsd_system s =
+  match s with
+  | "bsd_elf" | "netbsd" | "freebsd" | "openbsd" -> true
+  | _ -> false
+
+let bsd = make
+  "bsd"
+  (Actions_helpers.pass_or_skip (is_bsd_system Ocamltest_config.system)
+    "on a BSD system"
+    "not on a BSD system")
+
+let not_bsd = make
+  "not-bsd"
+  (Actions_helpers.pass_or_skip (not (is_bsd_system Ocamltest_config.system))
+    "not on a BSD system"
+    "on a BSD system")
+
+let macos_system = "macosx"
+
+let macos = make
+  "macos"
+  (Actions_helpers.pass_or_skip (Ocamltest_config.system = macos_system)
+    "on a MacOS system"
+    "not on a MacOS system")
+
+let arch32 = make
+  "arch32"
+  (Actions_helpers.pass_or_skip (Sys.word_size = 32)
+    "32-bit architecture"
+    "non-32-bit architecture")
+
+let arch64 = make
+  "arch64"
+  (Actions_helpers.pass_or_skip (Sys.word_size = 64)
+    "64-bit architecture"
+    "non-64-bit architecture")
+
+let arch_arm = make
+  "arch_arm"
+  (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "arm")
+     "Target is ARM architecture"
+     "Target is not ARM architecture")
+
+let arch_arm64 = make
+  "arch_arm64"
+  (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "arm64")
+     "Target is ARM64 architecture"
+     "Target is not ARM64 architecture")
+
+ let arch_amd64 = make
+  "arch_amd64"
+  (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "amd64")
+     "Target is AMD64 architecture"
+     "Target is not AMD64 architecture")
+
+ let arch_i386 = make
+  "arch_i386"
+  (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "i386")
+     "Target is i386 architecture"
+     "Target is not i386 architecture")
+
+let arch_power = make
+  "arch_power"
+  (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "power")
+    "Target is POWER architecture"
+    "Target is not POWER architecture")
+
+let function_sections = make
+  "function_sections"
+  (Actions_helpers.pass_or_skip (Ocamltest_config.function_sections)
+     "Target supports function sections"
+     "Target does not support function sections")
+
+let has_symlink = make
+  "has_symlink"
+  (Actions_helpers.pass_or_skip (Sys.has_symlink () )
+    "symlinks available"
+    "symlinks not available")
+
+let setup_build_env = make
+  "setup-build-env"
+  (Actions_helpers.setup_build_env true [])
+
+let setup_simple_build_env = make
+  "setup-simple-build-env"
+  (Actions_helpers.setup_simple_build_env true [])
+
+let run = make
+  "run"
+  Actions_helpers.run_program
+
+let script = make
+  "script"
+  Actions_helpers.run_script
+
+let check_program_output = make
+  "check-program-output"
+  (Actions_helpers.check_output "program"
+    Builtin_variables.output
+    Builtin_variables.reference)
+
+let initialize_test_exit_status_variables _log env =
+  Environments.add_bindings
+  [
+    Builtin_variables.test_pass, "0";
+    Builtin_variables.test_fail, "1";
+    Builtin_variables.test_skip, "125";
+  ] env
+
+let _ =
+  Environments.register_initializer
+    "test_exit_status_variables" initialize_test_exit_status_variables;
+  List.iter register
+  [
+    pass;
+    skip;
+    fail;
+    cd;
+    dumpenv;
+    hasinstrumentedruntime;
+    hasunix;
+    hassysthreads;
+    hasstr;
+    libunix;
+    libwin32unix;
+    windows;
+    not_windows;
+    bsd;
+    not_bsd;
+    macos;
+    arch32;
+    arch64;
+    has_symlink;
+    setup_build_env;
+    run;
+    script;
+    check_program_output;
+    arch_arm;
+    arch_arm64;
+    arch_amd64;
+    arch_i386;
+    arch_power;
+    function_sections;
+  ]
diff --git a/ocamltest/builtin_actions.mli b/ocamltest/builtin_actions.mli
new file mode 100644
index 00000000..241270eb
--- /dev/null
+++ b/ocamltest/builtin_actions.mli
@@ -0,0 +1,49 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of a few built-in actions *)
+
+val pass : Actions.t
+val skip : Actions.t
+val fail : Actions.t
+
+val dumpenv : Actions.t
+
+val hasunix : Actions.t
+val libunix : Actions.t
+val libwin32unix : Actions.t
+
+val windows : Actions.t
+val not_windows : Actions.t
+
+val bsd : Actions.t
+val not_bsd : Actions.t
+
+val arch32 : Actions.t
+val arch64 : Actions.t
+
+(** Whether the compiler target is POWER architecture. *)
+val arch_power : Actions.t
+
+val has_symlink : Actions.t
+
+val setup_build_env : Actions.t
+
+val setup_simple_build_env : Actions.t
+
+val run : Actions.t
+val script : Actions.t
+
+val check_program_output : Actions.t
diff --git a/ocamltest/builtin_variables.ml b/ocamltest/builtin_variables.ml
new file mode 100644
index 00000000..6ea498f6
--- /dev/null
+++ b/ocamltest/builtin_variables.ml
@@ -0,0 +1,132 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of variables used by built-in actions *)
+
+(* The variables are listed in alphabetical order *)
+
+(*
+  The name of the identifier representing a variable and its string name
+  should be similar. Is there a way to enforce this?
+*)
+
+let arguments = Variables.make ("arguments",
+  "Arguments passed to executed programs and scripts")
+
+let cwd = Variables.make ("cwd",
+  "Used to change current working directory, but not updated")
+
+let commandline = Variables.make ("commandline",
+  "Specify the commandline of a tool")
+
+let exit_status = Variables.make ("exit_status",
+  "Expected program exit status")
+
+let files = Variables.make ("files",
+  "Files used by the tests")
+
+let make = Variables.make ("MAKE",
+  "Command used to invoke make")
+
+let ocamltest_response = Variables.make ("ocamltest_response",
+  "File used by hooks to send back information.")
+
+let ocamltest_log = Variables.make ("ocamltest_log",
+  "Path to log file for the current test")
+
+let output = Variables.make ("output",
+  "Where the output of executing the program is saved")
+
+let program = Variables.make ("program",
+  "Name of program produced by ocamlc.byte and ocamlopt.byte")
+let program2 = Variables.make ("program2",
+  "Name of program produced by ocamlc.opt and ocamlopt.opt")
+
+let promote = Variables.make ("promote",
+  "Set to \"true\" to overwrite reference files with the test output")
+
+let reason = Variables.make ("reason",
+  "Let a test report why it passed/skipped/failed.")
+
+let reference = Variables.make ("reference",
+  "Path of file to which program output should be compared")
+
+let skip_header_lines =
+  Variables.make ( "skip_header_lines",
+         "The number of lines to skip when comparing program output \
+          with the reference file")
+
+let skip_header_bytes =
+  Variables.make ( "skip_header_bytes",
+         "The number of bytes to skip when comparing program output \
+          with the reference file")
+
+let script = Variables.make ("script",
+  "External script to run")
+
+let stdin = Variables.make ("stdin", "Default standard input")
+let stdout = Variables.make ("stdout", "Default standard output")
+let stderr = Variables.make ("stderr", "Default standard error")
+
+let test_build_directory = Variables.make ("test_build_directory",
+  "Directory for files produced during a test")
+
+let test_build_directory_prefix = Variables.make ("test_build_directory_prefix",
+  "Directory under which all test directories should be created")
+
+let test_file = Variables.make ("test_file",
+  "Name of file containing the specification of which tests to run")
+
+let test_source_directory = Variables.make ("test_source_directory",
+  "Directory containing the test source files")
+
+let test_pass = Variables.make ("TEST_PASS",
+  "Exit code to let a script report success")
+
+let test_skip = Variables.make ("TEST_SKIP",
+  "Exit code to let a script report skipping")
+
+let test_fail = Variables.make ("TEST_FAIL",
+  "Exit code to let a script report failure")
+
+
+
+let _ = List.iter Variables.register_variable
+  [
+    arguments;
+    cwd;
+    commandline;
+    exit_status;
+    files;
+    make;
+    ocamltest_response;
+    ocamltest_log;
+    output;
+    program; program2;
+    reason;
+    reference;
+    skip_header_lines;
+    skip_header_bytes;
+    script;
+    stdin;
+    stdout;
+    stderr;
+    test_build_directory;
+    test_file;
+    test_source_directory;
+    test_pass;
+    test_skip;
+    test_fail;
+  ]
diff --git a/ocamltest/builtin_variables.mli b/ocamltest/builtin_variables.mli
new file mode 100644
index 00000000..2e82174d
--- /dev/null
+++ b/ocamltest/builtin_variables.mli
@@ -0,0 +1,67 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of variables used by built-in actions *)
+
+(* The variables are listed in alphabetical order *)
+
+val arguments : Variables.t
+
+val cwd : Variables.t
+
+val commandline : Variables.t
+
+val exit_status : Variables.t
+
+val files : Variables.t
+
+val make : Variables.t
+
+val ocamltest_response : Variables.t
+
+val ocamltest_log : Variables.t
+
+val output : Variables.t
+
+val program : Variables.t
+val program2 : Variables.t
+
+val promote : Variables.t
+
+val reason : Variables.t
+
+val reference : Variables.t
+
+val skip_header_lines : Variables.t
+val skip_header_bytes : Variables.t
+
+val script : Variables.t
+
+val stdin : Variables.t
+val stdout : Variables.t
+val stderr : Variables.t
+
+val test_build_directory : Variables.t
+val test_build_directory_prefix : Variables.t
+
+val test_file : Variables.t
+
+val test_source_directory : Variables.t
+
+val test_pass : Variables.t
+
+val test_skip : Variables.t
+
+val test_fail : Variables.t
diff --git a/ocamltest/dune b/ocamltest/dune
new file mode 100644
index 00000000..ff6cb830
--- /dev/null
+++ b/ocamltest/dune
@@ -0,0 +1,52 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+(ocamllex
+ (modules tsl_lexer)
+ (mode fallback))
+
+(ocamlyacc
+ (modules tsl_parser)
+ (mode fallback))
+
+(rule
+ (targets ocamltest_config.ml)
+ (deps ../Makefile.config ../Makefile.common ../Makefile.best_binaries Makefile
+       ./ocamltest_config.ml.in ./getocamloptdefaultflags)
+ (action (run make %{targets})))
+
+;; FIXME: handle UNIX_OR_WIN32 or something similar
+(library
+ (name ocamltest_core_and_plugin)
+ (modes byte)
+ (wrapped false)
+ (flags (:standard -nostdlib))
+ (libraries ocamlcommon stdlib)
+ (modules (:standard \ options main))
+ (c_flags (-DCAML_INTERNALS -I%{project_root}/runtime)) ; fixme
+ (c_names run_unix run_stubs ocamltest_stdlib_stubs))
+
+(rule
+ (targets empty.ml)
+ (deps (source_tree %{project_root}/runtime/caml))
+ (action (write-file %{targets} "(* hack *)")))
+
+(executable
+ (name main)
+ (modes byte)
+ (flags (:standard -nostdlib))
+ (modules options main)
+ (libraries ocamltest_core_and_plugin runtime stdlib))
+
+(rule (copy main.exe ocamltest.byte))
diff --git a/ocamltest/environments.ml b/ocamltest/environments.ml
new file mode 100644
index 00000000..43dd1173
--- /dev/null
+++ b/ocamltest/environments.ml
@@ -0,0 +1,144 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of environments, used to pass parameters to tests and actions *)
+
+open Ocamltest_stdlib
+
+module VariableMap = Map.Make (Variables)
+
+type t = string VariableMap.t
+
+let empty = VariableMap.empty
+
+let to_bindings env =
+  let f variable value lst = (variable, value) :: lst in
+  VariableMap.fold f env []
+
+let expand_aux env value =
+  let bindings = to_bindings env in
+  let f (variable, value) = ((Variables.name_of_variable variable), value) in
+  let simple_bindings = List.map f bindings in
+  let subst s = try (List.assoc s simple_bindings) with Not_found -> "" in
+  let b = Buffer.create 100 in
+  try Buffer.add_substitute b subst value; Buffer.contents b with _ -> value
+
+let rec expand env value =
+  let expanded = expand_aux env value in
+  if expanded=value then value else expand env expanded
+
+let to_system_env env =
+  let system_env = Array.make (VariableMap.cardinal env) "" in
+  let i = ref 0 in
+  let store variable value =
+    system_env.(!i) <-
+      Variables.string_of_binding variable (expand env value);
+    incr i in
+  VariableMap.iter store env;
+  system_env
+
+let lookup variable env =
+  try Some (expand env (VariableMap.find variable env)) with Not_found -> None
+
+let lookup_nonempty variable env = match lookup variable env with
+  | None -> None
+  | Some x as t -> if String.words x = [] then None else t
+
+let lookup_as_bool variable env =
+  match lookup variable env with
+  | None -> None
+  | Some "true" -> Some true
+  | Some _ -> Some false
+
+let safe_lookup variable env = match lookup variable env with
+  | None -> ""
+  | Some value -> value
+
+let is_variable_defined variable env =
+  VariableMap.mem variable env
+
+let add variable value env = VariableMap.add variable value env
+
+let add_if_undefined variable value env =
+  if VariableMap.mem variable env then env else add variable value env
+
+let append variable appened_value environment =
+  let previous_value = safe_lookup variable environment in
+  let new_value = previous_value ^ appened_value in
+  VariableMap.add variable new_value environment
+
+let remove = VariableMap.remove
+
+let add_bindings bindings env =
+  let f env (variable, value) = add variable value env in
+  List.fold_left f env bindings
+
+let from_bindings bindings = add_bindings bindings empty
+
+let dump_assignment log (variable, value) =
+  Printf.fprintf log "%s = %s\n%!" (Variables.name_of_variable variable) value
+
+let dump log environment =
+  List.iter (dump_assignment log) (VariableMap.bindings environment)
+
+(* Initializers *)
+
+type env_initializer = out_channel -> t -> t
+
+let (initializers : (string, env_initializer) Hashtbl.t) = Hashtbl.create 10
+
+let register_initializer name code = Hashtbl.add initializers name code
+
+let apply_initializer _log _name code env =
+  code _log env
+
+let initialize log env =
+  let f = apply_initializer log in
+  Hashtbl.fold f initializers env
+
+(* Modifiers *)
+
+type modifier =
+  | Include of string
+  | Add of Variables.t * string
+  | Append of Variables.t * string
+  | Remove of Variables.t
+
+type modifiers = modifier list
+
+exception Empty_modifiers_name
+exception Modifiers_name_already_registered of string
+exception Modifiers_name_not_found of string
+
+let (registered_modifiers : (string, modifiers) Hashtbl.t) = Hashtbl.create 20
+
+let register_modifiers name modifiers =
+  if name="" then raise Empty_modifiers_name
+  else if Hashtbl.mem registered_modifiers name
+  then raise (Modifiers_name_already_registered name)
+  else Hashtbl.add registered_modifiers name modifiers
+
+let find_modifiers name =
+  try Hashtbl.find registered_modifiers name
+  with Not_found -> raise (Modifiers_name_not_found name)
+
+let rec apply_modifier environment = function
+  | Include modifiers_name ->
+    apply_modifiers environment (find_modifiers modifiers_name)
+  | Add (variable, value) -> add variable value environment
+  | Append (variable, value) -> append variable value environment
+  | Remove variable -> remove variable environment
+and apply_modifiers environment modifiers =
+  List.fold_left apply_modifier environment modifiers
diff --git a/ocamltest/environments.mli b/ocamltest/environments.mli
new file mode 100644
index 00000000..f288a6f1
--- /dev/null
+++ b/ocamltest/environments.mli
@@ -0,0 +1,69 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of environments, used to pass parameters to tests and actions *)
+
+type t
+
+val empty : t
+
+val from_bindings : (Variables.t * string) list -> t
+val to_bindings : t -> (Variables.t * string) list
+val to_system_env : t -> string array
+
+val lookup : Variables.t -> t -> string option
+val lookup_nonempty : Variables.t -> t -> string option
+val safe_lookup : Variables.t -> t -> string
+val is_variable_defined : Variables.t -> t -> bool
+
+val lookup_as_bool : Variables.t -> t -> bool option
+(** returns [Some true] if the variable is set to ["true"],
+    [Some false] if it is set to another string, and
+    [None] if not set. *)
+
+val add : Variables.t -> string -> t -> t
+val add_if_undefined : Variables.t -> string -> t -> t
+val add_bindings : (Variables.t * string) list -> t -> t
+
+val append : Variables.t -> string -> t -> t
+
+val dump : out_channel -> t -> unit
+
+(* Initializers *)
+
+type env_initializer = out_channel -> t -> t
+
+val register_initializer : string -> env_initializer -> unit
+
+val initialize : env_initializer
+
+(* Modifiers *)
+
+type modifier =
+  | Include of string
+  | Add of Variables.t * string
+  | Append of Variables.t * string
+  | Remove of Variables.t
+
+type modifiers = modifier list
+
+val apply_modifier : t -> modifier -> t
+val apply_modifiers : t -> modifiers -> t
+
+exception Empty_modifiers_name
+exception Modifiers_name_already_registered of string
+exception Modifiers_name_not_found of string
+
+val register_modifiers : string -> modifiers -> unit
diff --git a/ocamltest/filecompare.ml b/ocamltest/filecompare.ml
new file mode 100644
index 00000000..2e87d0ce
--- /dev/null
+++ b/ocamltest/filecompare.ml
@@ -0,0 +1,199 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* File comparison tools *)
+
+open Ocamltest_stdlib
+
+type result =
+  | Same
+  | Different
+  | Unexpected_output
+  | Error of string * int
+
+type ignore = {bytes: int; lines: int}
+type tool =
+  |  External of {
+                   tool_name : string;
+                   tool_flags : string;
+                   result_of_exitcode : string -> int -> result
+                }
+  | Internal of ignore
+
+let cmp_result_of_exitcode commandline = function
+  | 0 -> Same
+  | 1 -> Different
+  | exit_code -> (Error (commandline, exit_code))
+
+let make_cmp_tool ~ignore =
+  Internal ignore
+
+let make_comparison_tool ?(result_of_exitcode = cmp_result_of_exitcode)
+                         name flags =
+  External
+    {
+      tool_name = name;
+      tool_flags = flags;
+      result_of_exitcode
+    }
+
+let default_comparison_tool = make_cmp_tool ~ignore:{bytes=0;lines=0}
+
+type filetype = Binary | Text
+
+type files = {
+  filetype : filetype;
+  reference_filename : string;
+  output_filename : string;
+}
+
+let read_text_file lines_to_drop fn =
+  let ic = open_in_bin fn in
+  let drop_cr s =
+    let l = String.length s in
+    if l > 0 && s.[l - 1] = '\r' then String.sub s 0 (l - 1)
+    else raise Exit
+  in
+  let rec drop k =
+    if k = 0 then
+      loop []
+    else
+      let stop = try ignore (input_line ic); false with End_of_file -> true in
+      if stop then [] else drop (k-1)
+  and loop acc =
+    match input_line ic with
+    | s -> loop (s :: acc)
+    | exception End_of_file ->
+      close_in ic;
+      try List.rev_map drop_cr acc
+      with Exit -> List.rev acc
+  in
+  drop lines_to_drop
+
+let compare_text_files dropped_lines file1 file2 =
+  if read_text_file 0 file1 = read_text_file dropped_lines file2 then
+    Same
+  else
+    Different
+
+(* Version of Stdlib.really_input which stops at EOF, rather than raising
+   an exception. *)
+let really_input_up_to ic =
+  let block_size = 8192 in
+  let buf = Bytes.create block_size in
+  let rec read pos =
+    let bytes_read = input ic buf pos (block_size - pos) in
+    let new_pos = pos + bytes_read in
+    if bytes_read = 0 || new_pos = block_size then
+      new_pos
+    else
+      read new_pos
+  in
+  let bytes_read = read 0 in
+  if bytes_read = block_size then
+    buf
+  else
+    Bytes.sub buf 0 bytes_read
+
+let compare_binary_files bytes_to_ignore file1 file2 =
+  let ic1 = open_in_bin file1 in
+  let ic2 = open_in_bin file2 in
+  seek_in ic1 bytes_to_ignore;
+  seek_in ic2 bytes_to_ignore;
+  let rec compare () =
+    let block1 = really_input_up_to ic1 in
+    let block2 = really_input_up_to ic2 in
+    if block1 = block2 then
+      if Bytes.length block1 > 0 then
+        compare ()
+      else
+        Same
+    else
+      Different
+  in
+  let result = compare () in
+  close_in ic1;
+  close_in ic2;
+  result
+
+let compare_files ?(tool = default_comparison_tool) files =
+  match tool with
+  | External {tool_name; tool_flags; result_of_exitcode} ->
+      let commandline = String.concat " "
+      [
+        tool_name;
+        tool_flags;
+        files.reference_filename;
+        files.output_filename
+      ] in
+      let dev_null = match Sys.os_type with
+        | "Win32" -> "NUL"
+        | _ -> "/dev/null" in
+      let settings = Run_command.settings_of_commandline
+        ~stdout_fname:dev_null ~stderr_fname:dev_null commandline in
+      let status = Run_command.run settings in
+      result_of_exitcode commandline status
+  | Internal ignore ->
+      match files.filetype with
+        | Text ->
+            (* bytes_to_ignore is silently ignored for text files *)
+            compare_text_files ignore.lines
+              files.reference_filename files.output_filename
+        | Binary ->
+            compare_binary_files ignore.bytes
+                                 files.reference_filename files.output_filename
+
+let check_file ?(tool = default_comparison_tool) files =
+  if Sys.file_exists files.reference_filename
+  then compare_files ~tool:tool files
+  else begin
+    if Sys.file_is_empty files.output_filename
+    then Same
+    else Unexpected_output
+  end
+
+let diff files =
+  let temporary_file = Filename.temp_file "ocamltest" "diff" in
+  let diff_commandline =
+    Filename.quote_command "diff" ~stdout:temporary_file
+      [ "-u";
+        files.reference_filename;
+        files.output_filename ]
+  in
+  let result =
+    if (Sys.command diff_commandline) = 2 then Stdlib.Error "diff"
+    else Ok (Sys.string_of_file temporary_file)
+  in
+  Sys.force_remove temporary_file;
+  result
+
+let promote files ignore_conf =
+  match files.filetype, ignore_conf with
+    | Text, {lines = skip_lines; _} ->
+       let reference = open_out files.reference_filename in
+       let output = open_in files.output_filename in
+       for _ = 1 to skip_lines do
+         try ignore (input_line output) with End_of_file -> ()
+       done;
+       Sys.copy_chan output reference;
+       close_out reference;
+       close_in output
+    | Binary, {bytes = skip_bytes; _} ->
+       let reference = open_out_bin files.reference_filename in
+       let output = open_in_bin files.output_filename in
+       seek_in output skip_bytes;
+       Sys.copy_chan output reference;
+       close_out reference;
+       close_in output
diff --git a/ocamltest/filecompare.mli b/ocamltest/filecompare.mli
new file mode 100644
index 00000000..6a071dc6
--- /dev/null
+++ b/ocamltest/filecompare.mli
@@ -0,0 +1,50 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* File comparison tools *)
+
+type result =
+  | Same
+  | Different
+  | Unexpected_output
+  | Error of string * int
+
+type tool
+
+type ignore = {bytes: int; lines: int}
+val make_cmp_tool : ignore:ignore -> tool
+
+val make_comparison_tool :
+  ?result_of_exitcode:(string -> int -> result) -> string -> string -> tool
+
+val default_comparison_tool : tool
+
+type filetype = Binary | Text
+
+type files = {
+  filetype : filetype;
+  reference_filename : string;
+  output_filename : string;
+}
+
+val compare_files : ?tool:tool -> files -> result
+
+val check_file : ?tool:tool -> files -> result
+
+val cmp_result_of_exitcode : string -> int -> result
+
+val diff : files -> (string, string) Stdlib.result
+
+val promote : files -> ignore -> unit
diff --git a/ocamltest/getocamloptdefaultflags b/ocamltest/getocamloptdefaultflags
new file mode 100755
index 00000000..8d835eed
--- /dev/null
+++ b/ocamltest/getocamloptdefaultflags
@@ -0,0 +1,26 @@
+#!/bin/sh
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Sebastien Hinderer, projet Gallium, INRIA Paris             *
+#*                                                                        *
+#*   Copyright 2016 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 script provides command-line options to use by default
+# when invoking ocamlopt
+
+# It is used to add that disable annoying linker warnings on some versions
+# of OpenBSD
+
+case "$1" in
+  i386-*-openbsd5.[5-9]*|i386-*-openbsd[6-9].*)
+    echo "-ccopt -nopie";;
+esac
diff --git a/ocamltest/main.ml b/ocamltest/main.ml
new file mode 100644
index 00000000..9d952965
--- /dev/null
+++ b/ocamltest/main.ml
@@ -0,0 +1,274 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Main program of the ocamltest test driver *)
+
+open Ocamltest_stdlib
+open Tsl_semantics
+
+type behavior =
+  | Skip_all_tests
+  | Run of Environments.t
+
+(*
+let first_token filename =
+  let input_channel = open_in filename in
+  let lexbuf = Lexing.from_channel input_channel in
+  Location.init lexbuf filename;
+  let token =
+    try Tsl_lexer.token lexbuf with e -> close_in input_channel; raise e
+  in close_in input_channel; token
+
+let is_test filename =
+  match first_token filename with
+    | exception _ -> false
+    | Tsl_parser.TSL_BEGIN_C_STYLE | TSL_BEGIN_OCAML_STYLE -> true
+    | _ -> false
+*)
+
+(* this primitive announce should be used for tests
+   that were aborted on system error before ocamltest
+   could parse them *)
+let announce_test_error test_filename error =
+  Printf.printf " ... testing '%s' => unexpected error (%s)\n%!"
+    (Filename.basename test_filename) error
+
+let tsl_block_of_file test_filename =
+  let input_channel = open_in test_filename in
+  let lexbuf = Lexing.from_channel input_channel in
+  Location.init lexbuf test_filename;
+  match Tsl_parser.tsl_block Tsl_lexer.token lexbuf with
+    | exception e -> close_in input_channel; raise e
+    | _ as tsl_block -> close_in input_channel; tsl_block
+
+let tsl_block_of_file_safe test_filename =
+  try tsl_block_of_file test_filename with
+  | Sys_error message ->
+    Printf.eprintf "%s\n%!" message;
+    announce_test_error test_filename message;
+    exit 1
+  | Parsing.Parse_error ->
+    Printf.eprintf "Could not read test block in %s\n%!" test_filename;
+    announce_test_error test_filename "could not read test block";
+    exit 1
+
+let print_usage () =
+  Printf.printf "%s\n%!" Options.usage
+
+type result_summary = No_failure | Some_failure
+let join_summaries sa sb =
+  match sa, sb with
+  | Some_failure, _ | _, Some_failure -> Some_failure
+  | No_failure, No_failure -> No_failure
+
+let summary_of_result res =
+  let open Result in
+  match res.status with
+  | Pass -> No_failure
+  | Skip -> No_failure
+  | Fail -> Some_failure
+
+let rec run_test log common_prefix path behavior = function
+  Node (testenvspec, test, env_modifiers, subtrees) ->
+  Printf.printf "%s %s (%s) => %!" common_prefix path test.Tests.test_name;
+  let (msg, children_behavior, summary) = match behavior with
+    | Skip_all_tests -> "n/a", Skip_all_tests, No_failure
+    | Run env ->
+      let testenv0 = interprete_environment_statements env testenvspec in
+      let testenv = List.fold_left apply_modifiers testenv0 env_modifiers in
+      let (result, newenv) = Tests.run log testenv test in
+      let msg = Result.string_of_result result in
+      let children_behavior =
+        if Result.is_pass result then Run newenv else Skip_all_tests in
+      let summary = summary_of_result result in
+      (msg, children_behavior, summary) in
+  Printf.printf "%s\n%!" msg;
+  join_summaries summary
+    (run_test_trees log common_prefix path children_behavior subtrees)
+
+and run_test_trees log common_prefix path behavior trees =
+  List.fold_left join_summaries No_failure
+    (List.mapi (run_test_i log common_prefix path behavior) trees)
+
+and run_test_i log common_prefix path behavior i test_tree =
+  let path_prefix = if path="" then "" else path ^ "." in
+  let new_path = Printf.sprintf "%s%d" path_prefix (i+1) in
+  run_test log common_prefix new_path behavior test_tree
+
+let get_test_source_directory test_dirname =
+  if (Filename.is_relative test_dirname) then
+    Sys.with_chdir test_dirname Sys.getcwd
+  else test_dirname
+
+let get_test_build_directory_prefix test_dirname =
+  let ocamltestdir_variable = "OCAMLTESTDIR" in
+  let root =
+    Sys.getenv_with_default_value ocamltestdir_variable
+      (Filename.concat (Sys.getcwd ()) "_ocamltest")
+  in
+  if test_dirname = "." then root
+  else Filename.concat root test_dirname
+
+let tests_to_skip = ref []
+
+let init_tests_to_skip () =
+  tests_to_skip := String.words (Sys.safe_getenv "OCAMLTEST_SKIP_TESTS")
+
+let test_file test_filename =
+  (* Printf.printf "# reading test file %s\n%!" test_filename; *)
+  (* Save current working directory *)
+  let cwd = Sys.getcwd() in
+  let skip_test = List.mem test_filename !tests_to_skip in
+  let tsl_block = tsl_block_of_file_safe test_filename in
+  let (rootenv_statements, test_trees) = test_trees_of_tsl_block tsl_block in
+  let test_trees = match test_trees with
+    | [] ->
+      let default_tests = Tests.default_tests() in
+      let make_tree test = Node ([], test, [], []) in
+      List.map make_tree default_tests
+    | _ -> test_trees in
+  let used_tests = tests_in_trees test_trees in
+  let used_actions = actions_in_tests used_tests in
+  let action_names =
+    let f act names = String.Set.add (Actions.name act) names in
+    Actions.ActionSet.fold f used_actions String.Set.empty in
+  let test_dirname = Filename.dirname test_filename in
+  let test_basename = Filename.basename test_filename in
+  let test_prefix = Filename.chop_extension test_basename in
+  let test_directory =
+    if test_dirname="." then test_prefix
+    else Filename.concat test_dirname test_prefix in
+  let test_source_directory = get_test_source_directory test_dirname in
+  let hookname_prefix = Filename.concat test_source_directory test_prefix in
+  let test_build_directory_prefix =
+    get_test_build_directory_prefix test_directory in
+  let clean_test_build_directory () =
+    ignore
+      (Sys.command
+         (Filename.quote_command "rm" ["-rf"; test_build_directory_prefix]))
+  in
+  clean_test_build_directory ();
+  Sys.make_directory test_build_directory_prefix;
+  let summary = Sys.with_chdir test_build_directory_prefix
+    (fun () ->
+       let log =
+         if !Options.log_to_stderr then stderr else begin
+           let log_filename = test_prefix ^ ".log" in
+           open_out log_filename
+         end in
+       let promote = string_of_bool !Options.promote in
+       let install_hook name =
+         let hook_name = Filename.make_filename hookname_prefix name in
+         if Sys.file_exists hook_name then begin
+           let hook = Actions_helpers.run_hook hook_name in
+           Actions.set_hook name hook
+         end in
+       String.Set.iter install_hook action_names;
+
+       let reference_filename = Filename.concat
+           test_source_directory (test_prefix ^ ".reference") in
+       let make = try Sys.getenv "MAKE" with Not_found -> "make" in
+       let initial_environment = Environments.from_bindings
+           [
+             Builtin_variables.make, make;
+             Builtin_variables.test_file, test_basename;
+             Builtin_variables.reference, reference_filename;
+             Builtin_variables.test_source_directory, test_source_directory;
+             Builtin_variables.test_build_directory_prefix,
+               test_build_directory_prefix;
+             Builtin_variables.promote, promote;
+           ] in
+       let root_environment =
+         interprete_environment_statements
+           initial_environment rootenv_statements in
+       let rootenv = Environments.initialize log root_environment in
+       let common_prefix = " ... testing '" ^ test_basename ^ "' with" in
+       let initial_status =
+         if skip_test then Skip_all_tests else Run rootenv
+       in
+       let summary =
+         run_test_trees log common_prefix "" initial_status test_trees in
+       Actions.clear_all_hooks();
+       if not !Options.log_to_stderr then close_out log;
+       summary
+    ) in
+  (* Restore current working directory  *)
+  Sys.chdir cwd;
+  begin match summary with
+  | Some_failure -> ()
+  | No_failure ->
+      if not !Options.keep_test_dir_on_success then
+        clean_test_build_directory ()
+  end
+
+let is_test s =
+  match tsl_block_of_file s with
+  | _ -> true
+  | exception _ -> false
+
+let ignored s =
+  s = "" || s.[0] = '_' || s.[0] = '.'
+
+let find_test_dirs dir =
+  let res = ref [] in
+  let rec loop dir =
+    let contains_tests = ref false in
+    Array.iter (fun s ->
+        if ignored s then ()
+        else begin
+          let s = dir ^ "/" ^ s in
+          if Sys.is_directory s then loop s
+          else if not !contains_tests && is_test s then contains_tests := true
+        end
+      ) (Sys.readdir dir);
+    if !contains_tests then res := dir :: !res
+  in
+  loop dir;
+  List.rev !res
+
+let list_tests dir =
+  let res = ref [] in
+  if Sys.is_directory dir then begin
+    Array.iter (fun s ->
+        if ignored s then ()
+        else begin
+          let s' = dir ^ "/" ^ s in
+          if Sys.is_directory s' || not (is_test s') then ()
+          else res := s :: !res
+        end
+      ) (Sys.readdir dir)
+  end;
+  List.rev !res
+
+let () =
+  init_tests_to_skip()
+
+let main () =
+  let failed = ref false in
+  let work_done = ref false in
+  let list_tests dir =
+    match list_tests dir with
+    | [] -> failed := true
+    | res -> List.iter print_endline res
+  in
+  let find_test_dirs dir = List.iter print_endline (find_test_dirs dir) in
+  let doit f x = work_done := true; f x in
+  List.iter (doit find_test_dirs) !Options.find_test_dirs;
+  List.iter (doit list_tests) !Options.list_tests;
+  List.iter (doit test_file) !Options.files_to_test;
+  if not !work_done then print_usage();
+  if !failed || not !work_done then exit 1
+
+let _ = main()
diff --git a/ocamltest/main.mli b/ocamltest/main.mli
new file mode 100644
index 00000000..6d84084a
--- /dev/null
+++ b/ocamltest/main.mli
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Interface for the main program of the test driver *)
+
+(* Nothing is exported. This file exists merely so that every
+ * .ml has a corresponding interface *)
diff --git a/ocamltest/modifier_parser.ml b/ocamltest/modifier_parser.ml
new file mode 100644
index 00000000..65af1284
--- /dev/null
+++ b/ocamltest/modifier_parser.ml
@@ -0,0 +1,41 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2019 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Parsing of modifier (response) files created by hooks and scripts *)
+
+open Ocamltest_stdlib
+
+let modifier_of_string str =
+  let lexbuf = Lexing.from_string str in
+  let variable_name, result = Tsl_lexer.modifier lexbuf in
+  let variable =
+    match Variables.find_variable variable_name with
+    | None -> raise (Variables.No_such_variable variable_name)
+    | Some variable -> variable
+  in
+  match result with
+  | `Remove -> Environments.Remove variable
+  | `Add value -> Environments.Add (variable, value)
+  | `Append value -> Environments.Append (variable, value)
+
+let modifiers_of_file filename =
+  let ic = open_in filename in
+  let rec modifiers_of_lines acc = match input_line_opt ic with
+    | None -> acc
+    | Some line ->
+      modifiers_of_lines ((modifier_of_string (String.trim line)) :: acc) in
+  let modifiers = modifiers_of_lines [] in
+  close_in ic;
+  List.rev modifiers
diff --git a/ocamltest/modifier_parser.mli b/ocamltest/modifier_parser.mli
new file mode 100644
index 00000000..f34e3a39
--- /dev/null
+++ b/ocamltest/modifier_parser.mli
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2019 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Parsing of modifier (response) files created by hooks and scripts *)
+
+val modifier_of_string : string -> Environments.modifier
+
+val modifiers_of_file : string -> Environments.modifiers
diff --git a/ocamltest/ocaml_actions.ml b/ocamltest/ocaml_actions.ml
new file mode 100644
index 00000000..8334c43a
--- /dev/null
+++ b/ocamltest/ocaml_actions.ml
@@ -0,0 +1,1431 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Actions specific to the OCaml compilers *)
+
+open Ocamltest_stdlib
+open Actions
+
+(* Extracting information from environment *)
+
+let native_support = Ocamltest_config.arch <> "none"
+
+let no_native_compilers _log env =
+  (Result.skip_with_reason "native compilers disabled", env)
+
+let native_action a =
+  if native_support then a else (Actions.update a no_native_compilers)
+
+let get_backend_value_from_env env bytecode_var native_var =
+  Ocaml_backends.make_backend_function
+    (Environments.safe_lookup bytecode_var env)
+    (Environments.safe_lookup native_var env)
+
+let modules env =
+  Actions_helpers.words_of_variable env Ocaml_variables.modules
+
+let plugins env =
+  Actions_helpers.words_of_variable env Ocaml_variables.plugins
+
+let directories env =
+  Actions_helpers.words_of_variable env Ocaml_variables.directories
+
+let directory_flags env =
+  let f dir = ("-I " ^ dir) in
+  let l = List.map f (directories env) in
+  String.concat " " l
+
+let flags env = Environments.safe_lookup Ocaml_variables.flags env
+
+let last_flags env = Environments.safe_lookup Ocaml_variables.last_flags env
+
+let ocamllex_flags env =
+  Environments.safe_lookup Ocaml_variables.ocamllex_flags env
+
+let ocamlyacc_flags env =
+  Environments.safe_lookup Ocaml_variables.ocamlyacc_flags env
+
+let filelist env variable extension =
+  let value = Environments.safe_lookup variable env in
+  let filenames = String.words value in
+  let add_extension filename = Filename.make_filename filename extension in
+  String.concat " " (List.map add_extension filenames)
+
+let libraries backend env =
+  let extension = Ocaml_backends.library_extension backend in
+  filelist env Ocaml_variables.libraries extension
+
+let binary_modules backend env =
+  let extension = Ocaml_backends.module_extension backend in
+  filelist env Ocaml_variables.binary_modules extension
+
+let backend_default_flags env =
+  get_backend_value_from_env env
+    Ocaml_variables.ocamlc_default_flags
+    Ocaml_variables.ocamlopt_default_flags
+
+let backend_flags env =
+  get_backend_value_from_env env
+    Ocaml_variables.ocamlc_flags
+    Ocaml_variables.ocamlopt_flags
+
+let env_setting env_reader default_setting =
+  Printf.sprintf "%s=%s"
+    env_reader.Clflags.env_var
+    (env_reader.Clflags.print default_setting)
+
+let default_ocaml_env = [|
+  "TERM=dumb";
+  env_setting Clflags.color_reader Misc.Color.default_setting;
+  env_setting Clflags.error_style_reader Misc.Error_style.default_setting;
+|]
+
+type module_generator = {
+  description : string;
+  command : string -> string;
+  flags : Environments.t -> string;
+  generated_compilation_units :
+    string -> (string * Ocaml_filetypes.t) list
+}
+
+let ocamllex =
+{
+  description = "lexer";
+  command = Ocaml_commands.ocamlrun_ocamllex;
+  flags = ocamllex_flags;
+  generated_compilation_units =
+    fun lexer_name -> [(lexer_name, Ocaml_filetypes.Implementation)]
+}
+
+let ocamlyacc =
+{
+  description = "parser";
+  command = Ocaml_files.ocamlyacc;
+  flags = ocamlyacc_flags;
+  generated_compilation_units =
+    fun parser_name ->
+      [
+        (parser_name, Ocaml_filetypes.Interface);
+        (parser_name, Ocaml_filetypes.Implementation)
+      ]
+}
+
+let generate_module generator ocamlsrcdir output_variable input log env =
+  let basename = fst input in
+  let input_file = Ocaml_filetypes.make_filename input in
+  let what =
+    Printf.sprintf "Generating %s module from %s"
+    generator.description input_file
+  in
+  Printf.fprintf log "%s\n%!" what;
+  let commandline =
+  [
+    generator.command ocamlsrcdir;
+    generator.flags env;
+    input_file
+  ] in
+  let expected_exit_status = 0 in
+  let exit_status =
+    Actions_helpers.run_cmd
+      ~environment:default_ocaml_env
+      ~stdin_variable: Ocaml_variables.compiler_stdin
+      ~stdout_variable:output_variable
+      ~stderr_variable:output_variable
+      ~append:true
+      log env commandline in
+  if exit_status=expected_exit_status
+  then generator.generated_compilation_units basename
+  else begin
+    let reason =
+      (Actions_helpers.mkreason
+        what (String.concat " " commandline) exit_status) in
+    Printf.fprintf log "%s\n%!" reason;
+    []
+  end
+
+let generate_lexer = generate_module ocamllex
+
+let generate_parser = generate_module ocamlyacc
+
+let prepare_module ocamlsrcdir output_variable log env input =
+  let input_type = snd input in
+  let open Ocaml_filetypes in
+  match input_type with
+    | Implementation | Interface | C | Obj -> [input]
+    | Binary_interface -> [input]
+    | Backend_specific _ -> [input]
+    | C_minus_minus -> assert false
+    | Lexer ->
+      generate_lexer ocamlsrcdir output_variable input log env
+    | Grammar ->
+      generate_parser ocamlsrcdir output_variable input log env
+    | Text -> assert false
+
+let get_program_file backend env =
+  let testfile = Actions_helpers.testfile env in
+  let testfile_basename = Filename.chop_extension testfile in
+  let program_filename =
+    Filename.mkexe
+      (Filename.make_filename
+        testfile_basename (Ocaml_backends.executable_extension backend)) in
+  let test_build_directory =
+    Actions_helpers.test_build_directory env in
+  Filename.make_path [test_build_directory; program_filename]
+
+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))
+  in
+  Misc.Stdlib.List.find_map loads_c_code (String.words libraries)
+
+let compile_program ocamlsrcdir (compiler : Ocaml_compilers.compiler) log env =
+  let program_variable = compiler#program_variable in
+  let program_file = Environments.safe_lookup program_variable env in
+  let all_modules =
+    Actions_helpers.words_of_variable env Ocaml_variables.all_modules in
+  let output_variable = compiler#output_variable in
+  let prepare = prepare_module ocamlsrcdir output_variable log env in
+  let modules =
+    List.concatmap prepare (List.map Ocaml_filetypes.filetype all_modules) in
+  let has_c_file = List.exists is_c_file modules in
+  let c_headers_flags =
+    if has_c_file then Ocaml_flags.c_includes ocamlsrcdir else "" in
+  let expected_exit_status =
+    Ocaml_tools.expected_exit_status env (compiler :> Ocaml_tools.tool) in
+  let module_names =
+    (binary_modules compiler#target env) ^ " " ^
+    (String.concat " " (List.map Ocaml_filetypes.make_filename modules)) in
+  let what = Printf.sprintf "Compiling program %s from modules %s"
+    program_file module_names in
+  Printf.fprintf log "%s\n%!" what;
+  let compile_only =
+    Environments.lookup_as_bool Ocaml_variables.compile_only env = Some true
+  in
+  let compile_flags =
+    if compile_only then " -c " else ""
+  in
+  let output = if compile_only then "" else "-o " ^ program_file in
+  let libraries = libraries compiler#target env in
+  let cmas_need_dynamic_loading =
+    if not Config.supports_shared_libraries &&
+       compiler#target = Ocaml_backends.Bytecode then
+      cmas_need_dynamic_loading (directories env) libraries
+    else
+      None
+  in
+  match cmas_need_dynamic_loading with
+    | Some (Error reason) ->
+        (Result.fail_with_reason reason, env)
+    | _ ->
+      let bytecode_links_c_code = (cmas_need_dynamic_loading = Some (Ok ())) in
+      let commandline =
+      [
+        compiler#name ocamlsrcdir;
+        Ocaml_flags.runtime_flags ocamlsrcdir env compiler#target
+                                  (has_c_file || bytecode_links_c_code);
+        c_headers_flags;
+        Ocaml_flags.stdlib ocamlsrcdir;
+        directory_flags env;
+        flags env;
+        libraries;
+        backend_default_flags env compiler#target;
+        backend_flags env compiler#target;
+        compile_flags;
+        output;
+        (Environments.safe_lookup Ocaml_variables.ocaml_filetype_flag env);
+        module_names;
+        last_flags env
+      ] in
+      let exit_status =
+        Actions_helpers.run_cmd
+          ~environment:default_ocaml_env
+          ~stdin_variable: Ocaml_variables.compiler_stdin
+          ~stdout_variable:compiler#output_variable
+          ~stderr_variable:compiler#output_variable
+          ~append:true
+          log env commandline in
+      if exit_status=expected_exit_status
+      then (Result.pass, env)
+      else begin
+        let reason =
+          (Actions_helpers.mkreason
+            what (String.concat " " commandline) exit_status) in
+        (Result.fail_with_reason reason, env)
+      end
+
+let compile_module ocamlsrcdir compiler module_ log env =
+  let expected_exit_status =
+    Ocaml_tools.expected_exit_status env (compiler :> Ocaml_tools.tool) in
+  let what = Printf.sprintf "Compiling module %s" module_ in
+  Printf.fprintf log "%s\n%!" what;
+  let module_with_filetype = Ocaml_filetypes.filetype module_ in
+  let is_c = is_c_file module_with_filetype in
+  let c_headers_flags =
+    if is_c then Ocaml_flags.c_includes ocamlsrcdir else "" in
+  let commandline =
+  [
+    compiler#name ocamlsrcdir;
+    Ocaml_flags.stdlib ocamlsrcdir;
+    c_headers_flags;
+    directory_flags env;
+    flags env;
+    libraries compiler#target env;
+    backend_default_flags env compiler#target;
+    backend_flags env compiler#target;
+    "-c " ^ module_;
+  ] in
+  let exit_status =
+    Actions_helpers.run_cmd
+      ~environment:default_ocaml_env
+      ~stdin_variable: Ocaml_variables.compiler_stdin
+      ~stdout_variable:compiler#output_variable
+      ~stderr_variable:compiler#output_variable
+      ~append:true
+      log env commandline in
+  if exit_status=expected_exit_status
+  then (Result.pass, env)
+  else begin
+    let reason =
+      (Actions_helpers.mkreason
+        what (String.concat " " commandline) exit_status) in
+    (Result.fail_with_reason reason, env)
+  end
+
+let module_has_interface directory module_name =
+  let interface_name =
+    Ocaml_filetypes.make_filename (module_name, Ocaml_filetypes.Interface) in
+  let interface_fullpath = Filename.make_path [directory;interface_name] in
+  Sys.file_exists interface_fullpath
+
+let add_module_interface directory module_description =
+  match module_description with
+    | (filename, Ocaml_filetypes.Implementation) when
+      module_has_interface directory filename ->
+        [(filename, Ocaml_filetypes.Interface); module_description]
+  | _ -> [module_description]
+
+let print_module_names log description modules =
+  Printf.fprintf log "%s modules: %s\n%!"
+    description
+    (String.concat " " (List.map Ocaml_filetypes.make_filename modules))
+
+let find_source_modules log env =
+  let source_directory = Actions_helpers.test_source_directory env in
+  let specified_modules =
+    List.map Ocaml_filetypes.filetype
+      ((plugins env) @ (modules env) @ [(Actions_helpers.testfile env)]) in
+  print_module_names log "Specified" specified_modules;
+  let source_modules =
+    List.concatmap
+      (add_module_interface source_directory)
+      specified_modules in
+  print_module_names log "Source" source_modules;
+  Environments.add
+    Ocaml_variables.all_modules
+    (String.concat " " (List.map Ocaml_filetypes.make_filename source_modules))
+    env
+
+let setup_tool_build_env tool log env =
+  let source_directory = Actions_helpers.test_source_directory env in
+  let testfile = Actions_helpers.testfile env in
+  let testfile_basename = Filename.chop_extension testfile in
+  let tool_reference_variable =
+    tool#reference_variable in
+  let tool_reference_prefix =
+    Filename.make_path [source_directory; testfile_basename] in
+  let tool_reference_file =
+    tool#reference_file env tool_reference_prefix
+  in
+  let env =
+    Environments.add_if_undefined
+      tool_reference_variable
+      tool_reference_file env
+  in
+  let source_modules =
+    Actions_helpers.words_of_variable env Ocaml_variables.all_modules in
+  let tool_directory_suffix =
+    Environments.safe_lookup Ocaml_variables.compiler_directory_suffix env in
+  let tool_directory_name =
+    tool#directory ^ tool_directory_suffix in
+  let build_dir = Filename.concat
+    (Environments.safe_lookup
+      Builtin_variables.test_build_directory_prefix env)
+    tool_directory_name in
+  let tool_output_variable = tool#output_variable in
+  let tool_output_filename =
+    Filename.make_filename tool#directory "output" in
+  let tool_output_file =
+    Filename.make_path [build_dir; tool_output_filename]
+  in
+  let env =
+    Environments.add_if_undefined
+      tool_output_variable
+      tool_output_file env
+  in
+  Sys.force_remove tool_output_file;
+  let env =
+    Environments.add Builtin_variables.test_build_directory build_dir env in
+  Actions_helpers.setup_build_env false source_modules log env
+
+let setup_compiler_build_env (compiler : Ocaml_compilers.compiler) log env =
+  let (r, env) = setup_tool_build_env compiler log env in
+  if Result.is_pass r then
+  begin
+    let prog_var = compiler#program_variable in
+    let prog_output_var = compiler#program_output_variable in
+    let default_prog_file = get_program_file compiler#target env in
+    let env = Environments.add_if_undefined prog_var default_prog_file env in
+    let prog_file = Environments.safe_lookup prog_var env in
+    let prog_output_file = prog_file ^ ".output" in
+    let env = match prog_output_var with
+      | None -> env
+      | Some outputvar ->
+        Environments.add_if_undefined outputvar prog_output_file env
+    in
+    (r, env)
+  end else (r, env)
+
+let setup_toplevel_build_env (toplevel : Ocaml_toplevels.toplevel) log env =
+  setup_tool_build_env toplevel log env
+
+let mk_compiler_env_setup name (compiler : Ocaml_compilers.compiler) =
+  Actions.make name (setup_compiler_build_env compiler)
+
+let mk_toplevel_env_setup name (toplevel : Ocaml_toplevels.toplevel) =
+  Actions.make name (setup_toplevel_build_env toplevel)
+
+let setup_ocamlc_byte_build_env =
+  mk_compiler_env_setup
+    "setup-ocamlc.byte-build-env"
+    Ocaml_compilers.ocamlc_byte
+
+let setup_ocamlc_opt_build_env =
+  native_action
+    (mk_compiler_env_setup
+      "setup-ocamlc.opt-build-env"
+      Ocaml_compilers.ocamlc_opt)
+
+let setup_ocamlopt_byte_build_env =
+  native_action
+    (mk_compiler_env_setup
+      "setup-ocamlopt.byte-build-env"
+      Ocaml_compilers.ocamlopt_byte)
+
+let setup_ocamlopt_opt_build_env =
+  native_action
+    (mk_compiler_env_setup
+      "setup-ocamlopt.opt-build-env"
+      Ocaml_compilers.ocamlopt_opt)
+
+let setup_ocaml_build_env =
+  mk_toplevel_env_setup
+    "setup-ocaml-build-env"
+    Ocaml_toplevels.ocaml
+
+let setup_ocamlnat_build_env =
+  native_action
+    (mk_toplevel_env_setup
+      "setup-ocamlnat-build-env"
+      Ocaml_toplevels.ocamlnat)
+
+let compile (compiler : Ocaml_compilers.compiler) log env =
+  let ocamlsrcdir = Ocaml_directories.srcdir () in
+  match Environments.lookup_nonempty Builtin_variables.commandline env with
+  | None ->
+    begin
+      match Environments.lookup_nonempty Ocaml_variables.module_ env with
+      | None -> compile_program ocamlsrcdir compiler log env
+      | Some module_ -> compile_module ocamlsrcdir compiler module_ log env
+    end
+  | Some cmdline ->
+    let expected_exit_status =
+      Ocaml_tools.expected_exit_status env (compiler :> Ocaml_tools.tool) in
+    let what = Printf.sprintf "Compiling using commandline %s" cmdline in
+    Printf.fprintf log "%s\n%!" what;
+    let commandline = [compiler#name ocamlsrcdir; cmdline] in
+    let exit_status =
+      Actions_helpers.run_cmd
+        ~environment:default_ocaml_env
+        ~stdin_variable: Ocaml_variables.compiler_stdin
+        ~stdout_variable:compiler#output_variable
+        ~stderr_variable:compiler#output_variable
+        ~append:true
+        log env commandline in
+    if exit_status=expected_exit_status
+    then (Result.pass, env)
+    else begin
+      let reason =
+        (Actions_helpers.mkreason
+          what (String.concat " " commandline) exit_status) in
+      (Result.fail_with_reason reason, env)
+    end
+
+(* Compile actions *)
+
+let ocamlc_byte =
+  Actions.make
+    "ocamlc.byte"
+    (compile Ocaml_compilers.ocamlc_byte)
+
+let ocamlc_opt =
+  native_action
+    (Actions.make
+      "ocamlc.opt"
+      (compile Ocaml_compilers.ocamlc_opt))
+
+let ocamlopt_byte =
+  native_action
+    (Actions.make
+      "ocamlopt.byte"
+      (compile Ocaml_compilers.ocamlopt_byte))
+
+let ocamlopt_opt =
+  native_action
+    (Actions.make
+      "ocamlopt.opt"
+      (compile Ocaml_compilers.ocamlopt_opt))
+
+let env_with_lib_unix ocamlsrcdir env =
+  let libunixdir = Ocaml_directories.libunix ocamlsrcdir in
+  let newlibs =
+    match Environments.lookup Ocaml_variables.caml_ld_library_path env with
+    | None -> libunixdir
+    | Some libs -> libunixdir ^ " " ^ libs
+  in
+  Environments.add Ocaml_variables.caml_ld_library_path newlibs env
+
+let debug log env =
+  let ocamlsrcdir = Ocaml_directories.srcdir () in
+  let program = Environments.safe_lookup Builtin_variables.program env in
+  let what = Printf.sprintf "Debugging program %s" program in
+  Printf.fprintf log "%s\n%!" what;
+  let commandline =
+  [
+    Ocaml_commands.ocamlrun_ocamldebug ocamlsrcdir;
+    Ocaml_flags.ocamldebug_default_flags ocamlsrcdir;
+    program
+  ] in
+  let systemenv =
+    Array.append
+      default_ocaml_env
+      (Environments.to_system_env (env_with_lib_unix ocamlsrcdir env))
+  in
+  let expected_exit_status = 0 in
+  let exit_status =
+    Actions_helpers.run_cmd
+      ~environment:systemenv
+      ~stdin_variable: Ocaml_variables.ocamldebug_script
+      ~stdout_variable:Builtin_variables.output
+      ~stderr_variable:Builtin_variables.output
+      ~append:true
+      log (env_with_lib_unix ocamlsrcdir env) commandline in
+  if exit_status=expected_exit_status
+  then (Result.pass, env)
+  else begin
+    let reason =
+      (Actions_helpers.mkreason
+        what (String.concat " " commandline) exit_status) in
+    (Result.fail_with_reason reason, env)
+  end
+
+let ocamldebug = Actions.make "ocamldebug" debug
+
+let objinfo log env =
+  let ocamlsrcdir = Ocaml_directories.srcdir () in
+  let tools_directory = Ocaml_directories.tools ocamlsrcdir in
+  let program = Environments.safe_lookup Builtin_variables.program env in
+  let what = Printf.sprintf "Running ocamlobjinfo on %s" program in
+  Printf.fprintf log "%s\n%!" what;
+  let commandline =
+  [
+    Ocaml_commands.ocamlrun_ocamlobjinfo ocamlsrcdir;
+    Ocaml_flags.ocamlobjinfo_default_flags;
+    program
+  ] in
+  let ocamllib = [| (Printf.sprintf "OCAMLLIB=%s" tools_directory) |] in
+  let systemenv =
+    Array.concat
+    [
+      default_ocaml_env;
+      ocamllib;
+      (Environments.to_system_env (env_with_lib_unix ocamlsrcdir env))
+    ]
+  in
+  let expected_exit_status = 0 in
+  let exit_status =
+    Actions_helpers.run_cmd
+      ~environment:systemenv
+      ~stdout_variable:Builtin_variables.output
+      ~stderr_variable:Builtin_variables.output
+      ~append:true
+      log (env_with_lib_unix ocamlsrcdir env) commandline in
+  if exit_status=expected_exit_status
+  then (Result.pass, env)
+  else begin
+    let reason =
+      (Actions_helpers.mkreason
+        what (String.concat " " commandline) exit_status) in
+    (Result.fail_with_reason reason, env)
+  end
+
+let ocamlobjinfo = Actions.make "ocamlobjinfo" objinfo
+
+let mklib log env =
+  let ocamlsrcdir = Ocaml_directories.srcdir () in
+  let program = Environments.safe_lookup Builtin_variables.program env in
+  let what = Printf.sprintf "Running ocamlmklib to produce %s" program in
+  Printf.fprintf log "%s\n%!" what;
+  let ocamlc_command =
+    String.concat " "
+    [
+      Ocaml_commands.ocamlrun_ocamlc ocamlsrcdir;
+      Ocaml_flags.stdlib ocamlsrcdir;
+    ]
+  in
+  let commandline =
+  [
+    Ocaml_commands.ocamlrun_ocamlmklib ocamlsrcdir;
+    "-ocamlc '" ^ ocamlc_command ^ "'";
+    "-o " ^ program
+  ] @ modules env in
+  let expected_exit_status = 0 in
+  let exit_status =
+    Actions_helpers.run_cmd
+      ~environment:default_ocaml_env
+      ~stdout_variable:Ocaml_variables.compiler_output
+      ~stderr_variable:Ocaml_variables.compiler_output
+      ~append:true
+      log env commandline in
+  if exit_status=expected_exit_status
+  then (Result.pass, env)
+  else begin
+    let reason =
+      (Actions_helpers.mkreason
+        what (String.concat " " commandline) exit_status) in
+    (Result.fail_with_reason reason, env)
+  end
+
+let ocamlmklib = Actions.make "ocamlmklib" mklib
+
+let finalise_codegen_cc ocamlsrcdir test_basename _log env =
+  let test_module =
+    Filename.make_filename test_basename "s"
+  in
+  let archmod = Ocaml_files.asmgen_archmod ocamlsrcdir in
+  let modules = test_module ^ " " ^ archmod in
+  let program = Filename.make_filename test_basename "out" in
+  let env = Environments.add_bindings
+  [
+    Ocaml_variables.modules, modules;
+    Builtin_variables.program, program;
+  ] env in
+  (Result.pass, env)
+
+let finalise_codegen_msvc ocamlsrcdir test_basename log env =
+  let obj = Filename.make_filename test_basename Ocamltest_config.objext in
+  let src = Filename.make_filename test_basename "s" in
+  let what = "Running Microsoft assembler" in
+  Printf.fprintf log "%s\n%!" what;
+  let commandline = [Ocamltest_config.asm; obj; src] in
+  let expected_exit_status = 0 in
+  let exit_status =
+    Actions_helpers.run_cmd
+      ~environment:default_ocaml_env
+      ~stdout_variable:Ocaml_variables.compiler_output
+      ~stderr_variable:Ocaml_variables.compiler_output
+      ~append:true
+      log env commandline in
+  if exit_status=expected_exit_status
+  then begin
+    let archmod = Ocaml_files.asmgen_archmod ocamlsrcdir in
+    let modules = obj ^ " " ^ archmod in
+    let program = Filename.make_filename test_basename "out" in
+    let env = Environments.add_bindings
+    [
+      Ocaml_variables.modules, modules;
+      Builtin_variables.program, program;
+    ] env in
+    (Result.pass, env)
+  end else begin
+    let reason =
+      (Actions_helpers.mkreason
+        what (String.concat " " commandline) exit_status) in
+    (Result.fail_with_reason reason, env)
+  end
+
+let run_codegen log env =
+  let ocamlsrcdir = Ocaml_directories.srcdir () in
+  let testfile = Actions_helpers.testfile env in
+  let testfile_basename = Filename.chop_extension testfile in
+  let what = Printf.sprintf "Running codegen on %s" testfile in
+  Printf.fprintf log "%s\n%!" what;
+  let test_build_directory =
+    Actions_helpers.test_build_directory env in
+  let compiler_output =
+    Filename.make_path [test_build_directory; "compiler-output"]
+  in
+  let env =
+    Environments.add_if_undefined
+      Ocaml_variables.compiler_output
+      compiler_output
+      env
+  in
+  let output_file = Filename.make_filename testfile_basename "output" in
+  let output = Filename.make_path [test_build_directory; output_file] in
+  let env = Environments.add Builtin_variables.output output env in
+  let commandline =
+  [
+    Ocaml_commands.ocamlrun_codegen ocamlsrcdir;
+    flags env;
+    "-S " ^ testfile
+  ] in
+  let expected_exit_status = 0 in
+  let exit_status =
+    Actions_helpers.run_cmd
+      ~environment:default_ocaml_env
+      ~stdout_variable:Ocaml_variables.compiler_output
+      ~stderr_variable:Ocaml_variables.compiler_output
+      ~append:true
+      log env commandline in
+  if exit_status=expected_exit_status
+  then begin
+    let finalise =
+       if Ocamltest_config.ccomptype="msvc"
+      then finalise_codegen_msvc
+      else finalise_codegen_cc
+    in
+    finalise ocamlsrcdir testfile_basename log env
+  end else begin
+    let reason =
+      (Actions_helpers.mkreason
+        what (String.concat " " commandline) exit_status) in
+    (Result.fail_with_reason reason, env)
+  end
+
+let codegen = Actions.make "codegen" run_codegen
+
+let run_cc log env =
+  let ocamlsrcdir = Ocaml_directories.srcdir () in
+  let program = Environments.safe_lookup Builtin_variables.program env in
+  let what = Printf.sprintf "Running C compiler to build %s" program in
+  Printf.fprintf log "%s\n%!" what;
+  let output_exe =
+    if Ocamltest_config.ccomptype="msvc" then "/Fe" else "-o "
+  in
+  let commandline =
+  [
+    Ocamltest_config.cc;
+    Ocamltest_config.cflags;
+    "-I" ^ Ocaml_directories.runtime ocamlsrcdir;
+    output_exe ^ program;
+    Environments.safe_lookup Builtin_variables.arguments env;
+  ] @ modules env in
+  let expected_exit_status = 0 in
+  let exit_status =
+    Actions_helpers.run_cmd
+      ~environment:default_ocaml_env
+      ~stdout_variable:Ocaml_variables.compiler_output
+      ~stderr_variable:Ocaml_variables.compiler_output
+      ~append:true
+      log env commandline in
+  if exit_status=expected_exit_status
+  then (Result.pass, env)
+  else begin
+    let reason =
+      (Actions_helpers.mkreason
+        what (String.concat " " commandline) exit_status) in
+    (Result.fail_with_reason reason, env)
+  end
+
+let cc = Actions.make "cc" run_cc
+
+let run_expect_once ocamlsrcdir input_file principal log env =
+  let expect_flags = Sys.safe_getenv "EXPECT_FLAGS" in
+  let repo_root = "-repo-root " ^ ocamlsrcdir in
+  let principal_flag = if principal then "-principal" else "" in
+  let commandline =
+  [
+    Ocaml_commands.ocamlrun_expect_test ocamlsrcdir;
+    expect_flags;
+    flags env;
+    repo_root;
+    principal_flag;
+    input_file
+  ] in
+  let exit_status =
+    Actions_helpers.run_cmd ~environment:default_ocaml_env log env commandline
+  in
+  if exit_status=0 then (Result.pass, env)
+  else begin
+    let reason = (Actions_helpers.mkreason
+      "expect" (String.concat " " commandline) exit_status) in
+    (Result.fail_with_reason reason, env)
+  end
+
+let run_expect_twice ocamlsrcdir input_file log env =
+  let corrected filename = Filename.make_filename filename "corrected" in
+  let (result1, env1) = run_expect_once ocamlsrcdir input_file false log env in
+  if Result.is_pass result1 then begin
+    let intermediate_file = corrected input_file in
+    let (result2, env2) =
+      run_expect_once ocamlsrcdir intermediate_file true log env1 in
+    if Result.is_pass result2 then begin
+      let output_file = corrected intermediate_file in
+      let output_env = Environments.add_bindings
+      [
+        Builtin_variables.reference, input_file;
+        Builtin_variables.output, output_file
+      ] env2 in
+      (Result.pass, output_env)
+    end else (result2, env2)
+  end else (result1, env1)
+
+let run_expect log env =
+  let ocamlsrcdir = Ocaml_directories.srcdir () in
+  let input_file = Actions_helpers.testfile env in
+  run_expect_twice ocamlsrcdir input_file log env
+
+let run_expect = Actions.make "run-expect" run_expect
+
+let make_check_tool_output name tool = Actions.make
+  name
+  (Actions_helpers.check_output
+    tool#family
+    tool#output_variable
+    tool#reference_variable)
+
+let check_ocamlc_byte_output = make_check_tool_output
+  "check-ocamlc.byte-output" Ocaml_compilers.ocamlc_byte
+
+let check_ocamlc_opt_output =
+  native_action
+    (make_check_tool_output
+      "check-ocamlc.opt-output" Ocaml_compilers.ocamlc_opt)
+
+let check_ocamlopt_byte_output =
+  native_action
+    (make_check_tool_output
+      "check-ocamlopt.byte-output" Ocaml_compilers.ocamlopt_byte)
+
+let check_ocamlopt_opt_output =
+  native_action
+    (make_check_tool_output
+      "check-ocamlopt.opt-output" Ocaml_compilers.ocamlopt_opt)
+
+let really_compare_programs backend comparison_tool log env =
+  let program = Environments.safe_lookup Builtin_variables.program env in
+  let program2 = Environments.safe_lookup Builtin_variables.program2 env in
+  let what = Printf.sprintf "Comparing %s programs %s and %s"
+    (Ocaml_backends.string_of_backend backend) program program2 in
+  Printf.fprintf log "%s\n%!" what;
+  let files = {
+    Filecompare.filetype = Filecompare.Binary;
+    Filecompare.reference_filename = program;
+    Filecompare.output_filename = program2
+  } in
+  if Ocamltest_config.flambda && backend = Ocaml_backends.Native
+  then begin
+    let reason =
+      "flambda temporarily disables comparison of native programs" in
+    (Result.pass_with_reason reason, env)
+  end else
+  if backend = Ocaml_backends.Native &&
+    (Sys.os_type="Win32" || Sys.os_type="Cygwin")
+  then begin
+    let reason =
+      "comparison of native programs temporarily disabled under Windows" in
+    (Result.pass_with_reason reason, env)
+  end else begin
+    let comparison_tool =
+      if backend=Ocaml_backends.Native &&
+        (Sys.os_type="Win32" || Sys.os_type="Cygwin")
+        then
+          let bytes_to_ignore = 512 (* comparison_start_address program *) in
+          Filecompare.(make_cmp_tool ~ignore:{bytes=bytes_to_ignore; lines=0})
+        else comparison_tool in
+    match Filecompare.compare_files ~tool:comparison_tool files with
+      | Filecompare.Same -> (Result.pass, env)
+      | Filecompare.Different ->
+        let reason = Printf.sprintf "Files %s and %s are different"
+          program program2 in
+        (Result.fail_with_reason reason, env)
+      | Filecompare.Unexpected_output -> assert false
+      | Filecompare.Error (commandline, exitcode) ->
+        let reason = Actions_helpers.mkreason what commandline exitcode in
+        (Result.fail_with_reason reason, env)
+  end
+
+let compare_programs backend comparison_tool log env =
+  let compare_programs =
+    Environments.lookup_as_bool Ocaml_variables.compare_programs env in
+  if compare_programs = Some false then begin
+    let reason = "program comparison disabled" in
+    (Result.pass_with_reason reason, env)
+  end else really_compare_programs backend comparison_tool log env
+
+let make_bytecode_programs_comparison_tool ocamlsrcdir =
+  let ocamlrun = Ocaml_files.ocamlrun ocamlsrcdir in
+  let cmpbyt = Ocaml_files.cmpbyt ocamlsrcdir in
+  let tool_name = ocamlrun ^ " " ^ cmpbyt in
+  Filecompare.make_comparison_tool tool_name ""
+
+let native_programs_comparison_tool = Filecompare.default_comparison_tool
+
+let compare_bytecode_programs_code log env =
+  let ocamlsrcdir = Ocaml_directories.srcdir () in
+  let bytecode_programs_comparison_tool =
+    make_bytecode_programs_comparison_tool ocamlsrcdir in
+  compare_programs
+    Ocaml_backends.Bytecode bytecode_programs_comparison_tool log env
+
+let compare_bytecode_programs =
+  native_action
+    (Actions.make
+      "compare-bytecode-programs"
+      compare_bytecode_programs_code)
+
+let compare_native_programs =
+  native_action
+    (Actions.make
+      "compare-native-programs"
+      (compare_programs Ocaml_backends.Native native_programs_comparison_tool))
+
+let compile_module
+  ocamlsrcdir compiler compilername compileroutput log env
+  (module_basename, module_filetype) =
+  let backend = compiler#target in
+  let filename =
+    Ocaml_filetypes.make_filename (module_basename, module_filetype) in
+  let expected_exit_status =
+    Ocaml_tools.expected_exit_status env (compiler :> Ocaml_tools.tool) in
+  let what = Printf.sprintf "%s for file %s (expected exit status: %d)"
+    (Ocaml_filetypes.action_of_filetype module_filetype) filename
+      (expected_exit_status) in
+  let compile_commandline input_file output_file optional_flags =
+    let compile = "-c " ^ input_file in
+    let output = match output_file with
+      | None -> ""
+      | Some file -> "-o " ^ file in
+    [
+      compilername;
+      Ocaml_flags.stdlib ocamlsrcdir;
+      flags env;
+      backend_flags env backend;
+      optional_flags;
+      compile;
+      output;
+    ] in
+  let exec commandline =
+    Printf.fprintf log "%s\n%!" what;
+    let exit_status =
+      Actions_helpers.run_cmd
+        ~stdin_variable: Ocaml_variables.compiler_stdin
+        ~stdout_variable:compileroutput
+        ~stderr_variable:compileroutput
+        ~append:true log env commandline in
+    if exit_status=expected_exit_status
+    then (Result.pass, env)
+    else begin
+      let reason =
+        (Actions_helpers.mkreason
+          what (String.concat " " commandline) exit_status) in
+      (Result.fail_with_reason reason, env)
+    end in
+  match module_filetype with
+    | Ocaml_filetypes.Interface ->
+      let interface_name =
+        Ocaml_filetypes.make_filename
+          (module_basename, Ocaml_filetypes.Interface) in
+      let commandline = compile_commandline interface_name None "" in
+      exec commandline
+    | Ocaml_filetypes.Implementation ->
+      let module_extension = Ocaml_backends.module_extension backend in
+      let module_output_name =
+        Filename.make_filename module_basename module_extension in
+      let commandline =
+        compile_commandline filename (Some module_output_name) "" in
+      exec commandline
+    | Ocaml_filetypes.C ->
+      let object_extension = Config.ext_obj in
+      let _object_filename = module_basename ^ object_extension in
+      let commandline =
+        compile_commandline filename None
+          (Ocaml_flags.c_includes ocamlsrcdir) in
+      exec commandline
+    | _ ->
+      let reason = Printf.sprintf "File %s of type %s not supported yet"
+        filename (Ocaml_filetypes.string_of_filetype module_filetype) in
+      (Result.fail_with_reason reason, env)
+
+let compile_modules
+    ocamlsrcdir compiler compilername compileroutput
+    modules_with_filetypes log initial_env
+  =
+  let compile_mod env mod_ =
+    compile_module ocamlsrcdir compiler compilername compileroutput
+    log env mod_ in
+  let rec compile_mods env = function
+    | [] -> (Result.pass, env)
+    | m::ms ->
+      (let (result, newenv) = compile_mod env m in
+      if Result.is_pass result then (compile_mods newenv ms)
+      else (result, newenv)) in
+  compile_mods initial_env modules_with_filetypes
+
+let run_test_program_in_toplevel (toplevel : Ocaml_toplevels.toplevel) log env =
+  let backend = toplevel#backend in
+  let libraries = libraries backend env in
+  (* This is a sub-optimal check - skip the test if any libraries requiring
+     C stubs are loaded. It would be better at this point to build a custom
+     toplevel. *)
+  let toplevel_can_run =
+    Config.supports_shared_libraries || backend <> Ocaml_backends.Bytecode
+  in
+  if not toplevel_can_run then
+    (Result.skip, env)
+  else
+    match cmas_need_dynamic_loading (directories env) libraries with
+      | Some (Error reason) ->
+        (Result.fail_with_reason reason, env)
+      | Some (Ok ()) ->
+        (Result.skip, env)
+      | None ->
+        let testfile = Actions_helpers.testfile env in
+        let expected_exit_status =
+          Ocaml_tools.expected_exit_status env (toplevel :> Ocaml_tools.tool) in
+        let compiler_output_variable = toplevel#output_variable in
+        let ocamlsrcdir = Ocaml_directories.srcdir () in
+        let compiler = toplevel#compiler in
+        let compiler_name = compiler#name ocamlsrcdir in
+        let modules_with_filetypes =
+          List.map Ocaml_filetypes.filetype (modules env) in
+        let (result, env) = compile_modules
+          ocamlsrcdir compiler compiler_name compiler_output_variable
+          modules_with_filetypes log env in
+        if Result.is_pass result then begin
+          let what =
+            Printf.sprintf "Running %s in %s toplevel \
+                            (expected exit status: %d)"
+            testfile
+            (Ocaml_backends.string_of_backend backend)
+            expected_exit_status in
+          Printf.fprintf log "%s\n%!" what;
+          let toplevel_name = toplevel#name ocamlsrcdir in
+          let ocaml_script_as_argument =
+            match
+              Environments.lookup_as_bool
+                Ocaml_variables.ocaml_script_as_argument env
+            with
+            | None -> false
+            | Some b -> b
+          in
+          let commandline =
+          [
+            toplevel_name;
+            Ocaml_flags.toplevel_default_flags;
+            toplevel#flags;
+            Ocaml_flags.stdlib ocamlsrcdir;
+            directory_flags env;
+            Ocaml_flags.include_toplevel_directory ocamlsrcdir;
+            flags env;
+            libraries;
+            binary_modules backend env;
+            if ocaml_script_as_argument then testfile else "";
+            Environments.safe_lookup Builtin_variables.arguments env
+          ] in
+          let exit_status =
+            if ocaml_script_as_argument
+            then Actions_helpers.run_cmd
+              ~environment:default_ocaml_env
+              ~stdout_variable:compiler_output_variable
+              ~stderr_variable:compiler_output_variable
+              log env commandline
+            else Actions_helpers.run_cmd
+              ~environment:default_ocaml_env
+              ~stdin_variable:Builtin_variables.test_file
+              ~stdout_variable:compiler_output_variable
+              ~stderr_variable:compiler_output_variable
+              log env commandline
+          in
+          if exit_status=expected_exit_status
+          then (Result.pass, env)
+          else begin
+            let reason =
+              (Actions_helpers.mkreason
+                what (String.concat " " commandline) exit_status) in
+            (Result.fail_with_reason reason, env)
+          end
+        end else (result, env)
+
+let ocaml = Actions.make
+  "ocaml"
+  (run_test_program_in_toplevel Ocaml_toplevels.ocaml)
+
+let ocamlnat =
+  native_action
+    (Actions.make
+      "ocamlnat"
+      (run_test_program_in_toplevel Ocaml_toplevels.ocamlnat))
+
+let check_ocaml_output = make_check_tool_output
+  "check-ocaml-output" Ocaml_toplevels.ocaml
+
+let check_ocamlnat_output =
+  native_action
+    (make_check_tool_output
+      "check-ocamlnat-output" Ocaml_toplevels.ocamlnat)
+
+let config_variables _log env =
+  let ocamlsrcdir = Ocaml_directories.srcdir () in
+  Environments.add_bindings
+  [
+    Ocaml_variables.arch, Ocamltest_config.arch;
+    Ocaml_variables.ocamlrun, Ocaml_files.ocamlrun ocamlsrcdir;
+    Ocaml_variables.ocamlc_byte, Ocaml_files.ocamlc ocamlsrcdir;
+    Ocaml_variables.ocamlopt_byte, Ocaml_files.ocamlopt ocamlsrcdir;
+    Ocaml_variables.bytecc_libs, Ocamltest_config.bytecc_libs;
+    Ocaml_variables.nativecc_libs, Ocamltest_config.nativecc_libs;
+    Ocaml_variables.mkdll,
+      Sys.getenv_with_default_value "MKDLL" Ocamltest_config.mkdll;
+    Ocaml_variables.mkexe, Ocamltest_config.mkexe;
+    Ocaml_variables.c_preprocessor, Ocamltest_config.c_preprocessor;
+    Ocaml_variables.csc, Ocamltest_config.csc;
+    Ocaml_variables.csc_flags, Ocamltest_config.csc_flags;
+    Ocaml_variables.shared_library_cflags,
+      Ocamltest_config.shared_library_cflags;
+    Ocaml_variables.objext, Ocamltest_config.objext;
+    Ocaml_variables.asmext, Ocamltest_config.asmext;
+    Ocaml_variables.sharedobjext, Ocamltest_config.sharedobjext;
+    Ocaml_variables.ocamlc_default_flags,
+      Ocamltest_config.ocamlc_default_flags;
+    Ocaml_variables.ocamlopt_default_flags,
+      Ocamltest_config.ocamlopt_default_flags;
+    Ocaml_variables.ocamlrunparam, Sys.safe_getenv "OCAMLRUNPARAM";
+    Ocaml_variables.ocamlsrcdir, Ocaml_directories.srcdir();
+    Ocaml_variables.os_type, Sys.os_type;
+  ] env
+
+let flat_float_array = Actions.make
+  "flat-float-array"
+  (Actions_helpers.pass_or_skip Ocamltest_config.flat_float_array
+    "compiler configured with -flat-float-array"
+    "compiler configured with -no-flat-float-array")
+
+let no_flat_float_array = make
+  "no-flat-float-array"
+  (Actions_helpers.pass_or_skip (not Ocamltest_config.flat_float_array)
+    "compiler configured with -no-flat-float-array"
+    "compiler configured with -flat-float-array")
+
+let flambda = Actions.make
+  "flambda"
+  (Actions_helpers.pass_or_skip Ocamltest_config.flambda
+    "support for flambda enabled"
+    "support for flambda disabled")
+
+let no_flambda = make
+  "no-flambda"
+  (Actions_helpers.pass_or_skip (not Ocamltest_config.flambda)
+    "support for flambda disabled"
+    "support for flambda enabled")
+
+let spacetime = Actions.make
+  "spacetime"
+  (Actions_helpers.pass_or_skip Ocamltest_config.spacetime
+    "support for spacetime enabled"
+    "support for spacetime disabled")
+
+let no_spacetime = make
+  "no-spacetime"
+  (Actions_helpers.pass_or_skip (not Ocamltest_config.spacetime)
+    "support for spacetime disabled"
+    "support for spacetime enabled")
+
+let shared_libraries = Actions.make
+  "shared-libraries"
+  (Actions_helpers.pass_or_skip Ocamltest_config.shared_libraries
+    "Shared libraries are supported."
+    "Shared libraries are not supported.")
+
+let no_shared_libraries = Actions.make
+  "no-shared-libraries"
+  (Actions_helpers.pass_or_skip (not Ocamltest_config.shared_libraries)
+    "Shared libraries are not supported."
+    "Shared libraries are supported.")
+
+let native_compiler = Actions.make
+  "native-compiler"
+  (Actions_helpers.pass_or_skip (Ocamltest_config.arch <> "none")
+    "native compiler available"
+    "native compiler not available")
+
+let native_dynlink = Actions.make
+  "native-dynlink"
+  (Actions_helpers.pass_or_skip (Ocamltest_config.native_dynlink)
+    "native dynlink support available"
+    "native dynlink support not available")
+
+let debugger = Actions.make
+  "debugger"
+  (Actions_helpers.pass_or_skip Ocamltest_config.ocamldebug
+     "debugger available"
+     "debugger not available")
+
+let csharp_compiler = Actions.make
+  "csharp-compiler"
+  (Actions_helpers.pass_or_skip (Ocamltest_config.csc<>"")
+    "C# compiler available"
+    "C# compiler not available")
+
+let windows_unicode = Actions.make
+  "windows-unicode"
+  (Actions_helpers.pass_or_skip (Ocamltest_config.windows_unicode )
+    "Windows Unicode support available"
+    "Windows Unicode support not available")
+
+let afl_instrument = Actions.make
+  "afl-instrument"
+  (Actions_helpers.pass_or_skip Ocamltest_config.afl_instrument
+    "AFL instrumentation enabled"
+    "AFL instrumentation disabled")
+
+let no_afl_instrument = Actions.make
+  "no-afl-instrument"
+  (Actions_helpers.pass_or_skip (not Ocamltest_config.afl_instrument)
+    "AFL instrumentation disabled"
+    "AFL instrumentation enabled")
+
+let ocamldoc = Ocaml_tools.ocamldoc
+
+let ocamldoc_output_file env prefix =
+  let backend =
+    Environments.safe_lookup Ocaml_variables.ocamldoc_backend env in
+  let suffix = match backend with
+    | "latex" -> ".tex"
+    | "html" -> ".html"
+    | "man" -> ".3o"
+    | _ -> ".result" in
+  prefix ^ suffix
+
+let check_ocamldoc_output = make_check_tool_output
+  "check-ocamldoc-output" ocamldoc
+
+let ocamldoc_flags env =
+  Environments.safe_lookup Ocaml_variables.ocamldoc_flags env
+
+let compiled_doc_name input = input ^ ".odoc"
+
+(* The compiler used for compiling both cmi file
+   and plugins *)
+let compiler_for_ocamldoc ocamlsrcdir =
+  let compiler = Ocaml_compilers.ocamlc_byte in
+  compile_modules ocamlsrcdir compiler (compiler#name ocamlsrcdir)
+    compiler#output_variable
+
+(* Within ocamldoc tests,
+   modules="a.ml b.ml" is interpreted as a list of
+   secondaries documentation modules that need to be
+   compiled into cmi files and odoc file (serialized ocamldoc information)
+   before the main documentation is generated *)
+let compile_ocamldoc ocamlsrcdir (basename,filetype as module_) log env =
+  let expected_exit_status =
+    Ocaml_tools.expected_exit_status env (ocamldoc :> Ocaml_tools.tool) in
+  let what = Printf.sprintf "Compiling documentation for module %s" basename in
+  Printf.fprintf log "%s\n%!" what;
+  let filename =
+    Ocaml_filetypes.make_filename (basename, filetype) in
+  let (r,env) = compiler_for_ocamldoc ocamlsrcdir [module_] log env in
+  if not (Result.is_pass r) then (r,env) else
+  let commandline =
+    (* currently, we are ignoring the global ocamldoc_flags, since we
+       don't have per-module flags *)
+    [
+    Ocaml_commands.ocamlrun_ocamldoc ocamlsrcdir;
+    Ocaml_flags.stdlib ocamlsrcdir;
+    "-dump " ^ compiled_doc_name basename;
+     filename;
+  ] in
+  let exit_status =
+    Actions_helpers.run_cmd
+      ~environment:(Environments.to_system_env env)
+      ~stdin_variable: Ocaml_variables.compiler_stdin
+      ~stdout_variable:ocamldoc#output_variable
+      ~stderr_variable:ocamldoc#output_variable
+      ~append:true
+      log env commandline in
+  if exit_status=expected_exit_status
+  then (Result.pass, env)
+  else begin
+    let reason =
+      (Actions_helpers.mkreason
+        what (String.concat " " commandline) exit_status) in
+    (Result.fail_with_reason reason, env)
+  end
+
+let rec ocamldoc_compile_all ocamlsrcdir log env = function
+  | [] -> (Result.pass, env)
+  | a :: q ->
+      let (r,env) = compile_ocamldoc ocamlsrcdir a log env in
+      if Result.is_pass r then
+        ocamldoc_compile_all ocamlsrcdir log env q
+      else
+        (r,env)
+
+let setup_ocamldoc_build_env =
+  Actions.make "setup_ocamldoc_build_env" @@ fun log env ->
+  let (r,env) = setup_tool_build_env ocamldoc log env in
+  if not (Result.is_pass r) then (r,env) else
+  let source_directory = Actions_helpers.test_source_directory env in
+  let root_file = Filename.chop_extension (Actions_helpers.testfile env) in
+  let reference_prefix = Filename.make_path [source_directory; root_file] in
+  let output = ocamldoc_output_file env root_file in
+  let reference= reference_prefix ^ ocamldoc#reference_filename_suffix env in
+  let backend = Environments.safe_lookup Ocaml_variables.ocamldoc_backend env in
+  let env =
+    Environments.apply_modifiers env  Ocaml_modifiers.(str @ unix)
+    |> Environments.add Builtin_variables.reference reference
+    |> Environments.add Builtin_variables.output output in
+  let env =
+    if backend = "man" then Environments.add_if_undefined
+        Builtin_variables.skip_header_lines "1" env
+    else env in
+  Result.pass, env
+
+let ocamldoc_plugin name = name ^ ".cmo"
+
+let ocamldoc_backend_flag env =
+  let backend = Environments.safe_lookup Ocaml_variables.ocamldoc_backend env in
+  if backend = "" then "" else "-" ^ backend
+
+let ocamldoc_o_flag env =
+  let output =  Environments.safe_lookup Builtin_variables.output env in
+  match Environments.safe_lookup Ocaml_variables.ocamldoc_backend env with
+  | "html" | "manual" -> "index"
+  | _ -> output
+
+let run_ocamldoc =
+  Actions.make "ocamldoc" @@ fun log env ->
+  (* modules corresponds to secondaries modules of which the
+     documentation and cmi files need to be build before the main
+     module documentation *)
+  let modules =  List.map Ocaml_filetypes.filetype @@ modules env in
+  (* plugins are used for custom documentation generators *)
+  let plugins = List.map Ocaml_filetypes.filetype @@ plugins env in
+  let ocamlsrcdir = Ocaml_directories.srcdir () in
+  let (r,env) = compiler_for_ocamldoc ocamlsrcdir plugins log env in
+  if not (Result.is_pass r) then r, env else
+  let (r,env) = ocamldoc_compile_all ocamlsrcdir log env modules in
+  if not (Result.is_pass r) then r, env else
+  let input_file = Actions_helpers.testfile env in
+  Printf.fprintf log "Generating documentation for %s\n%!" input_file;
+  let load_all =
+    List.map (fun name -> "-load " ^ compiled_doc_name (fst name))
+    @@ (* sort module in alphabetical order *)
+    List.sort Stdlib.compare modules in
+  let with_plugins =
+    List.map (fun name -> "-g " ^ ocamldoc_plugin (fst name)) plugins in
+  let commandline =
+  [
+    Ocaml_commands.ocamlrun_ocamldoc ocamlsrcdir;
+    ocamldoc_backend_flag env;
+    Ocaml_flags.stdlib ocamlsrcdir;
+    ocamldoc_flags env]
+  @ load_all @ with_plugins @
+   [ input_file;
+     "-o"; ocamldoc_o_flag env
+   ] in
+  let exit_status =
+    Actions_helpers.run_cmd ~environment:(Environments.to_system_env env)
+      ~stdin_variable: Ocaml_variables.compiler_stdin
+      ~stdout_variable:ocamldoc#output_variable
+      ~stderr_variable:ocamldoc#output_variable
+      ~append:true
+      log env commandline in
+  if exit_status=0 then
+    (Result.pass, env)
+  else begin
+    let reason = (Actions_helpers.mkreason
+      "ocamldoc" (String.concat " " commandline) exit_status) in
+    (Result.fail_with_reason reason, env)
+  end
+
+let _ =
+  Environments.register_initializer "find_source_modules" find_source_modules;
+  Environments.register_initializer "config_variables" config_variables;
+  List.iter register
+  [
+    setup_ocamlc_byte_build_env;
+    ocamlc_byte;
+    check_ocamlc_byte_output;
+    setup_ocamlc_opt_build_env;
+    ocamlc_opt;
+    check_ocamlc_opt_output;
+    setup_ocamlopt_byte_build_env;
+    ocamlopt_byte;
+    check_ocamlopt_byte_output;
+    setup_ocamlopt_opt_build_env;
+    ocamlopt_opt;
+    check_ocamlopt_opt_output;
+    run_expect;
+    compare_bytecode_programs;
+    compare_native_programs;
+    setup_ocaml_build_env;
+    ocaml;
+    check_ocaml_output;
+    setup_ocamlnat_build_env;
+    ocamlnat;
+    check_ocamlnat_output;
+    flat_float_array;
+    no_flat_float_array;
+    flambda;
+    no_flambda;
+    spacetime;
+    no_spacetime;
+    shared_libraries;
+    no_shared_libraries;
+    native_compiler;
+    native_dynlink;
+    debugger;
+    csharp_compiler;
+    windows_unicode;
+    afl_instrument;
+    no_afl_instrument;
+    setup_ocamldoc_build_env;
+    run_ocamldoc;
+    check_ocamldoc_output;
+    ocamldebug;
+    ocamlmklib;
+    codegen;
+    cc;
+    ocamlobjinfo
+  ]
diff --git a/ocamltest/ocaml_actions.mli b/ocamltest/ocaml_actions.mli
new file mode 100644
index 00000000..efa05a10
--- /dev/null
+++ b/ocamltest/ocaml_actions.mli
@@ -0,0 +1,57 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Actions specific to the OCaml compilers *)
+
+val setup_ocamlc_byte_build_env : Actions.t
+val ocamlc_byte : Actions.t
+val check_ocamlc_byte_output : Actions.t
+val setup_ocamlc_opt_build_env : Actions.t
+val ocamlc_opt : Actions.t
+val check_ocamlc_opt_output : Actions.t
+val setup_ocamlopt_byte_build_env : Actions.t
+val ocamlopt_byte : Actions.t
+val check_ocamlopt_byte_output : Actions.t
+val setup_ocamlopt_opt_build_env : Actions.t
+val ocamlopt_opt : Actions.t
+val check_ocamlopt_opt_output : Actions.t
+val run_expect : Actions.t
+val compare_bytecode_programs : Actions.t
+val compare_native_programs : Actions.t
+val setup_ocaml_build_env : Actions.t
+val ocaml : Actions.t
+val check_ocaml_output : Actions.t
+val setup_ocamlnat_build_env : Actions.t
+val ocamlnat : Actions.t
+val check_ocamlnat_output : Actions.t
+
+val setup_ocamldoc_build_env : Actions.t
+val run_ocamldoc: Actions.t
+val check_ocamldoc_output: Actions.t
+
+val flat_float_array : Actions.t
+val no_flat_float_array : Actions.t
+
+val shared_libraries : Actions.t
+val no_shared_libraries : Actions.t
+
+val native_compiler : Actions.t
+
+val afl_instrument : Actions.t
+val no_afl_instrument : Actions.t
+
+val codegen : Actions.t
+
+val cc : Actions.t
diff --git a/ocamltest/ocaml_backends.ml b/ocamltest/ocaml_backends.ml
new file mode 100644
index 00000000..71e75a49
--- /dev/null
+++ b/ocamltest/ocaml_backends.ml
@@ -0,0 +1,38 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Backends of the OCaml compiler and their properties *)
+
+type t = Native | Bytecode
+
+let is_bytecode t = t=Bytecode
+
+let is_native t = t=Native
+
+let string_of_backend = function
+  | Native -> "native"
+  | Bytecode -> "bytecode"
+
+(* Creates a function that returns its first argument for Bytecode           *)
+(* and its second argument for Native code                                   *)
+let make_backend_function bytecode_value native_value = function
+  | Bytecode -> bytecode_value
+  | Native -> native_value
+
+let module_extension = make_backend_function "cmo" "cmx"
+
+let library_extension = make_backend_function "cma" "cmxa"
+
+let executable_extension = make_backend_function "byte" "opt"
diff --git a/ocamltest/ocaml_backends.mli b/ocamltest/ocaml_backends.mli
new file mode 100644
index 00000000..5cc48e85
--- /dev/null
+++ b/ocamltest/ocaml_backends.mli
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Backends of the OCaml compiler and their properties *)
+
+type t = Native | Bytecode
+
+val is_bytecode : t -> bool
+
+val is_native : t -> bool
+
+val string_of_backend : t -> string
+
+val make_backend_function : 'a -> 'a -> t -> 'a
+
+val module_extension : t -> string
+
+val library_extension : t -> string
+
+val executable_extension : t -> string
diff --git a/ocamltest/ocaml_commands.ml b/ocamltest/ocaml_commands.ml
new file mode 100644
index 00000000..59bbb6c9
--- /dev/null
+++ b/ocamltest/ocaml_commands.ml
@@ -0,0 +1,45 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Helper functions to build OCaml-related commands *)
+
+let ocamlrun ocamlsrcdir program =
+  (Ocaml_files.ocamlrun ocamlsrcdir) ^ " " ^ (program ocamlsrcdir)
+
+let ocamlrun_ocamlc ocamlsrcdir = ocamlrun ocamlsrcdir Ocaml_files.ocamlc
+
+let ocamlrun_ocamlopt ocamlsrcdir = ocamlrun ocamlsrcdir Ocaml_files.ocamlopt
+
+let ocamlrun_ocaml ocamlsrcdir = ocamlrun ocamlsrcdir Ocaml_files.ocaml
+
+let ocamlrun_expect_test ocamlsrcdir =
+  ocamlrun ocamlsrcdir Ocaml_files.expect_test
+
+let ocamlrun_ocamllex ocamlsrcdir = ocamlrun ocamlsrcdir Ocaml_files.ocamllex
+
+let ocamlrun_ocamldoc ocamlsrcdir =
+  ocamlrun ocamlsrcdir Ocaml_files.ocamldoc
+
+let ocamlrun_ocamldebug ocamlsrcdir =
+  ocamlrun ocamlsrcdir Ocaml_files.ocamldebug
+
+let ocamlrun_ocamlobjinfo ocamlsrcdir =
+  ocamlrun ocamlsrcdir Ocaml_files.ocamlobjinfo
+
+let ocamlrun_ocamlmklib ocamlsrcdir =
+  ocamlrun ocamlsrcdir Ocaml_files.ocamlmklib
+
+let ocamlrun_codegen ocamlsrcdir =
+  ocamlrun ocamlsrcdir Ocaml_files.codegen
diff --git a/ocamltest/ocaml_commands.mli b/ocamltest/ocaml_commands.mli
new file mode 100644
index 00000000..9a1474e2
--- /dev/null
+++ b/ocamltest/ocaml_commands.mli
@@ -0,0 +1,35 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Helper functions to build OCaml-related commands *)
+
+val ocamlrun_ocamlc : string -> string
+
+val ocamlrun_ocamlopt : string -> string
+
+val ocamlrun_ocaml : string -> string
+
+val ocamlrun_expect_test : string -> string
+
+val ocamlrun_ocamllex : string -> string
+
+val ocamlrun_ocamldoc : string -> string
+
+val ocamlrun_ocamldebug : string -> string
+
+val ocamlrun_ocamlobjinfo : string -> string
+
+val ocamlrun_ocamlmklib : string -> string
+val ocamlrun_codegen : string -> string
diff --git a/ocamltest/ocaml_compilers.ml b/ocamltest/ocaml_compilers.ml
new file mode 100644
index 00000000..bb3ed6ae
--- /dev/null
+++ b/ocamltest/ocaml_compilers.ml
@@ -0,0 +1,101 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Description of the OCaml compilers *)
+
+open Ocamltest_stdlib
+
+class compiler
+  ~(name : string -> string)
+  ~(flags : string)
+  ~(directory : string)
+  ~(exit_status_variable : Variables.t)
+  ~(reference_variable : Variables.t)
+  ~(output_variable : Variables.t)
+  ~(host : Ocaml_backends.t)
+  ~(target : Ocaml_backends.t)
+= object (self) inherit Ocaml_tools.tool
+  ~name:name
+  ~family:"compiler"
+  ~flags:flags
+  ~directory:directory
+  ~exit_status_variable:exit_status_variable
+  ~reference_variable:reference_variable
+  ~output_variable:output_variable
+  as tool
+
+  method host = host
+  method target = target
+
+  method program_variable =
+    if Ocaml_backends.is_native host
+    then Builtin_variables.program2
+    else Builtin_variables.program
+
+  method program_output_variable =
+    if Ocaml_backends.is_native host
+    then None
+    else Some Builtin_variables.output
+
+  method ! reference_file env prefix =
+    let default = tool#reference_file env prefix in
+    if Sys.file_exists default then default else
+    let suffix = self#reference_filename_suffix env in
+    let mk s = (Filename.make_filename prefix s) ^ suffix in
+    let filename = mk
+      (Ocaml_backends.string_of_backend target) in
+    if Sys.file_exists filename then filename else
+    mk "compilers"
+end
+
+let ocamlc_byte = new compiler
+  ~name: Ocaml_commands.ocamlrun_ocamlc
+  ~flags: ""
+  ~directory: "ocamlc.byte"
+  ~exit_status_variable: Ocaml_variables.ocamlc_byte_exit_status
+  ~reference_variable: Ocaml_variables.compiler_reference
+  ~output_variable: Ocaml_variables.compiler_output
+  ~host: Ocaml_backends.Bytecode
+  ~target: Ocaml_backends.Bytecode
+
+let ocamlc_opt = new compiler
+  ~name: Ocaml_files.ocamlc_dot_opt
+  ~flags: ""
+  ~directory: "ocamlc.opt"
+  ~exit_status_variable: Ocaml_variables.ocamlc_opt_exit_status
+  ~reference_variable: Ocaml_variables.compiler_reference2
+  ~output_variable: Ocaml_variables.compiler_output2
+  ~host: Ocaml_backends.Native
+  ~target: Ocaml_backends.Bytecode
+
+let ocamlopt_byte = new compiler
+  ~name: Ocaml_commands.ocamlrun_ocamlopt
+  ~flags: ""
+  ~directory: "ocamlopt.byte"
+  ~exit_status_variable: Ocaml_variables.ocamlopt_byte_exit_status
+  ~reference_variable: Ocaml_variables.compiler_reference
+  ~output_variable: Ocaml_variables.compiler_output
+  ~host: Ocaml_backends.Bytecode
+  ~target: Ocaml_backends.Native
+
+let ocamlopt_opt = new compiler
+  ~name: Ocaml_files.ocamlopt_dot_opt
+  ~flags: ""
+  ~directory: "ocamlopt.opt"
+  ~exit_status_variable: Ocaml_variables.ocamlopt_opt_exit_status
+  ~reference_variable: Ocaml_variables.compiler_reference2
+  ~output_variable: Ocaml_variables.compiler_output2
+  ~host: Ocaml_backends.Native
+  ~target: Ocaml_backends.Native
diff --git a/ocamltest/ocaml_compilers.mli b/ocamltest/ocaml_compilers.mli
new file mode 100644
index 00000000..e4eb638e
--- /dev/null
+++ b/ocamltest/ocaml_compilers.mli
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Descriptions of the OCaml compilers *)
+
+class compiler :
+  name : (string -> string) ->
+  flags : string ->
+  directory : string ->
+  exit_status_variable : Variables.t ->
+  reference_variable : Variables.t ->
+  output_variable : Variables.t ->
+  host : Ocaml_backends.t ->
+  target : Ocaml_backends.t ->
+object inherit Ocaml_tools.tool
+  method host : Ocaml_backends.t
+  method target : Ocaml_backends.t
+  method program_variable : Variables.t
+  method program_output_variable : Variables.t option
+end
+
+val ocamlc_byte : compiler
+
+val ocamlc_opt : compiler
+
+val ocamlopt_byte : compiler
+
+val ocamlopt_opt : compiler
diff --git a/ocamltest/ocaml_directories.ml b/ocamltest/ocaml_directories.ml
new file mode 100644
index 00000000..b85ff07c
--- /dev/null
+++ b/ocamltest/ocaml_directories.ml
@@ -0,0 +1,37 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Locations of directories in the OCaml source tree *)
+
+open Ocamltest_stdlib
+
+let srcdir () =
+  Sys.getenv_with_default_value "OCAMLSRCDIR" Ocamltest_config.ocamlsrcdir
+
+let stdlib ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "stdlib"]
+
+let libunix ocamlsrcdir =
+  let subdir = if Sys.os_type="Win32" then "win32unix" else "unix" in
+  Filename.make_path [ocamlsrcdir; "otherlibs"; subdir]
+
+let toplevel ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "toplevel"]
+
+let runtime ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "runtime"]
+
+let tools ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "tools"]
diff --git a/ocamltest/ocaml_directories.mli b/ocamltest/ocaml_directories.mli
new file mode 100644
index 00000000..d689f34e
--- /dev/null
+++ b/ocamltest/ocaml_directories.mli
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Locations of directories in the OCaml source tree *)
+
+val srcdir : unit -> string
+
+val stdlib : string -> string
+
+val libunix : string -> string
+
+val toplevel : string -> string
+
+val runtime : string -> string
+
+val tools : string -> string
diff --git a/ocamltest/ocaml_files.ml b/ocamltest/ocaml_files.ml
new file mode 100644
index 00000000..70e24d7d
--- /dev/null
+++ b/ocamltest/ocaml_files.ml
@@ -0,0 +1,89 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Locations of files in the OCaml source tree *)
+
+open Ocamltest_stdlib
+
+type runtime_variant =
+  | Normal
+  | Debug
+  | Instrumented
+
+let runtime_variant() =
+  let use_runtime = Sys.safe_getenv "USE_RUNTIME" in
+  if use_runtime="d" then Debug
+  else if use_runtime="i" then Instrumented
+  else Normal
+
+let ocamlrun ocamlsrcdir =
+  let runtime = match runtime_variant () with
+    | Normal -> "ocamlrun"
+    | Debug -> "ocamlrund"
+    | Instrumented -> "ocamlruni" in
+  let ocamlrunfile = Filename.mkexe runtime in
+  Filename.make_path [ocamlsrcdir; "runtime"; ocamlrunfile]
+
+let ocamlc ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "ocamlc"]
+
+let ocaml ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "ocaml"]
+
+let ocamlc_dot_opt ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "ocamlc.opt"]
+
+let ocamlopt ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "ocamlopt"]
+
+let ocamlopt_dot_opt ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "ocamlopt.opt"]
+
+let ocamlnat ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; Filename.mkexe "ocamlnat"]
+
+let cmpbyt ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "tools"; "cmpbyt"]
+
+let expect_test ocamlsrcdir =
+  Filename.make_path
+    [ocamlsrcdir; "testsuite"; "tools"; Filename.mkexe "expect_test"]
+
+let ocamllex ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "lex"; "ocamllex"]
+
+let ocamlyacc ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "yacc"; Filename.mkexe "ocamlyacc"]
+
+let ocamldoc ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "ocamldoc"; "ocamldoc"]
+
+let ocamldebug ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "debugger"; Filename.mkexe "ocamldebug"]
+
+let ocamlobjinfo ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "tools"; "ocamlobjinfo"]
+
+let ocamlmklib ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "tools"; "ocamlmklib"]
+
+let codegen ocamlsrcdir =
+  Filename.make_path [ocamlsrcdir; "testsuite"; "tools"; "codegen"]
+
+let asmgen_archmod ocamlsrcdir =
+  let objname =
+    "asmgen_" ^ Ocamltest_config.arch ^ "." ^ Ocamltest_config.objext
+  in
+  Filename.make_path [ocamlsrcdir; "testsuite"; "tools"; objname]
diff --git a/ocamltest/ocaml_files.mli b/ocamltest/ocaml_files.mli
new file mode 100644
index 00000000..95c93179
--- /dev/null
+++ b/ocamltest/ocaml_files.mli
@@ -0,0 +1,53 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Locations of files in the OCaml source tree *)
+
+type runtime_variant =
+  | Normal
+  | Debug
+  | Instrumented
+
+val runtime_variant : unit -> runtime_variant
+
+val ocamlrun : string -> string
+
+val ocamlc : string -> string
+
+val ocaml : string -> string
+
+val ocamlc_dot_opt : string -> string
+
+val ocamlopt : string -> string
+
+val ocamlopt_dot_opt : string -> string
+
+val ocamlnat : string -> string
+
+val cmpbyt : string -> string
+
+val expect_test : string -> string
+
+val ocamllex : string -> string
+
+val ocamlyacc : string -> string
+
+val ocamldoc : string -> string
+val ocamldebug : string -> string
+val ocamlobjinfo : string -> string
+val ocamlmklib : string -> string
+val codegen : string -> string
+
+val asmgen_archmod : string -> string
diff --git a/ocamltest/ocaml_filetypes.ml b/ocamltest/ocaml_filetypes.ml
new file mode 100644
index 00000000..c399cf7c
--- /dev/null
+++ b/ocamltest/ocaml_filetypes.ml
@@ -0,0 +1,117 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Types of files involved in an OCaml project and related functions *)
+
+type backend_specific = Object | Library | Program
+
+type t =
+  | Implementation
+  | Interface
+  | C
+  | C_minus_minus
+  | Lexer
+  | Grammar
+  | Binary_interface
+  | Obj
+  | Backend_specific of Ocaml_backends.t * backend_specific
+  | Text (* used by ocamldoc for text only documentation *)
+
+let string_of_backend_specific = function
+  | Object -> "object"
+  | Library -> "library"
+  | Program -> "program"
+
+let string_of_filetype = function
+  | Implementation -> "implementation"
+  | Interface -> "interface"
+  | C -> "C source file"
+  | C_minus_minus -> "C minus minus source file"
+  | Lexer -> "lexer"
+  | Grammar -> "grammar"
+  | Binary_interface -> "binary interface"
+  | Obj -> "object"
+  | Backend_specific (backend, filetype) ->
+    ((Ocaml_backends.string_of_backend backend) ^ " " ^
+      (string_of_backend_specific filetype))
+  | Text -> "text"
+
+let extension_of_filetype = function
+  | Implementation -> "ml"
+  | Interface -> "mli"
+  | C -> "c"
+  | C_minus_minus -> "cmm"
+  | Lexer -> "mll"
+  | Grammar -> "mly"
+  | Binary_interface -> "cmi"
+  | Obj -> Ocamltest_config.objext
+  | Backend_specific (backend, filetype) ->
+    begin match (backend, filetype) with
+      | (Ocaml_backends.Native, Object) -> "cmx"
+      | (Ocaml_backends.Native, Library) -> "cmxa"
+      | (Ocaml_backends.Native, Program) -> "opt"
+      | (Ocaml_backends.Bytecode, Object) -> "cmo"
+      | (Ocaml_backends.Bytecode, Library) -> "cma"
+      | (Ocaml_backends.Bytecode, Program) -> "byte"
+    end
+  | Text -> "txt"
+
+let filetype_of_extension = function
+  | "ml" -> Implementation
+  | "mli" -> Interface
+  | "c" -> C
+  | "cmm" -> C_minus_minus
+  | "mll" -> Lexer
+  | "mly" -> Grammar
+  | "cmi" -> Binary_interface
+  | "o" -> Obj
+  | "obj" -> Obj
+  | "cmx" -> Backend_specific (Ocaml_backends.Native, Object)
+  | "cmxa" -> Backend_specific (Ocaml_backends.Native, Library)
+  | "opt" -> Backend_specific (Ocaml_backends.Native, Program)
+  | "cmo" -> Backend_specific (Ocaml_backends.Bytecode, Object)
+  | "cma" -> Backend_specific (Ocaml_backends.Bytecode, Library)
+  | "byte" -> Backend_specific (Ocaml_backends.Bytecode, Program)
+  | "txt" -> Text
+  | _ as e -> Printf.eprintf "Unknown file extension %s\n%!" e; exit 2
+
+let split_filename name =
+  let l = String.length name in
+  let is_dir_sep name i = name.[i] = Filename.dir_sep.[0] in
+  let rec search_dot i =
+    if i < 0 || is_dir_sep name i then (name, "")
+    else if name.[i] = '.' then
+      let basename = String.sub name 0 i in
+      let extension = String.sub name (i+1) (l-i-1) in
+      (basename, extension)
+    else search_dot (i - 1) in
+  search_dot (l - 1)
+
+let filetype filename =
+  let (basename, extension) = split_filename filename in
+  (basename, filetype_of_extension extension)
+
+let make_filename (basename, filetype) =
+  let extension = extension_of_filetype filetype in
+  basename ^ "." ^ extension
+
+let action_of_filetype = function
+  | Implementation -> "Compiling implementation"
+  | Interface -> "Compiling interface"
+  | C -> "Compiling C source file"
+  | C_minus_minus -> "Processing C-- file"
+  | Lexer -> "Generating lexer"
+  | Grammar -> "Generating parser"
+  | filetype -> ("nothing to do for " ^ (string_of_filetype filetype))
diff --git a/ocamltest/ocaml_filetypes.mli b/ocamltest/ocaml_filetypes.mli
new file mode 100644
index 00000000..542d13ae
--- /dev/null
+++ b/ocamltest/ocaml_filetypes.mli
@@ -0,0 +1,44 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Types of files involved in an OCaml project and related functions *)
+
+type backend_specific = Object | Library | Program
+
+type t =
+  | Implementation
+  | Interface
+  | C
+  | C_minus_minus
+  | Lexer
+  | Grammar
+  | Binary_interface
+  | Obj
+  | Backend_specific of Ocaml_backends.t * backend_specific
+  | Text (** text-only documentation file *)
+
+val string_of_filetype : t -> string
+
+val extension_of_filetype : t -> string
+
+val filetype_of_extension : string -> t
+
+val split_filename : string -> string * string
+
+val filetype : string -> string * t
+
+val make_filename : string * t -> string
+
+val action_of_filetype : t -> string
diff --git a/ocamltest/ocaml_flags.ml b/ocamltest/ocaml_flags.ml
new file mode 100644
index 00000000..bfb31cc7
--- /dev/null
+++ b/ocamltest/ocaml_flags.ml
@@ -0,0 +1,61 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Flags used in OCaml commands *)
+
+let stdlib ocamlsrcdir =
+  let stdlib_path = Ocaml_directories.stdlib ocamlsrcdir in
+  "-nostdlib -I " ^ stdlib_path
+
+let include_toplevel_directory ocamlsrcdir =
+  "-I " ^ (Ocaml_directories.toplevel ocamlsrcdir)
+
+let c_includes ocamlsrcdir =
+  let dir = Ocaml_directories.runtime ocamlsrcdir in
+  "-ccopt -I" ^ dir
+
+let runtime_variant_flags () = match Ocaml_files.runtime_variant() with
+  | Ocaml_files.Normal -> ""
+  | Ocaml_files.Debug -> " -runtime-variant d"
+  | Ocaml_files.Instrumented -> " -runtime-variant i"
+
+let runtime_flags ocamlsrcdir env backend c_files =
+  let runtime_library_flags = "-I " ^
+    (Ocaml_directories.runtime ocamlsrcdir) in
+  let rt_flags = match backend with
+    | Ocaml_backends.Native -> runtime_variant_flags ()
+    | Ocaml_backends.Bytecode ->
+      begin
+        if c_files then begin (* custom mode *)
+          "-custom " ^ (runtime_variant_flags ())
+        end else begin (* non-custom mode *)
+          let use_runtime =
+            Environments.lookup_as_bool Ocaml_variables.use_runtime env
+          in
+          if use_runtime = Some false
+          then ""
+          else "-use-runtime " ^ (Ocaml_files.ocamlrun ocamlsrcdir)
+        end
+      end in
+  rt_flags ^ " " ^ runtime_library_flags
+
+let toplevel_default_flags = "-noinit -no-version -noprompt"
+
+let ocamldebug_default_flags ocamlsrcdir =
+  "-no-version -no-prompt -no-time -no-breakpoint-message " ^
+  ("-I " ^ (Ocaml_directories.stdlib ocamlsrcdir) ^ " ") ^
+  ("-topdirs-path " ^ (Ocaml_directories.toplevel ocamlsrcdir))
+
+let ocamlobjinfo_default_flags = "-null-crc"
diff --git a/ocamltest/ocaml_flags.mli b/ocamltest/ocaml_flags.mli
new file mode 100644
index 00000000..7bfb3a32
--- /dev/null
+++ b/ocamltest/ocaml_flags.mli
@@ -0,0 +1,31 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Flags used in OCaml commands *)
+
+val stdlib : string -> string
+
+val include_toplevel_directory : string -> string
+
+val c_includes : string -> string
+
+val runtime_flags :
+  string -> Environments.t -> Ocaml_backends.t -> bool -> string
+
+val toplevel_default_flags : string
+
+val ocamldebug_default_flags : string -> string
+
+val ocamlobjinfo_default_flags : string
diff --git a/ocamltest/ocaml_modifiers.ml b/ocamltest/ocaml_modifiers.ml
new file mode 100644
index 00000000..c310cf36
--- /dev/null
+++ b/ocamltest/ocaml_modifiers.ml
@@ -0,0 +1,144 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of a few OCaml-specific environment modifiers *)
+
+open Ocamltest_stdlib
+open Environments
+
+let principal =
+[
+  Append (Ocaml_variables.flags, " -principal ");
+  Add (Ocaml_variables.compiler_directory_suffix, ".principal");
+  Add (Ocaml_variables.compiler_reference_suffix, ".principal");
+]
+
+let latex =
+  [
+    Add (Ocaml_variables.ocamldoc_backend, "latex");
+    Append (Ocaml_variables.ocamldoc_flags, "-latex-type-prefix=TYP ");
+    Append (Ocaml_variables.ocamldoc_flags, "-latex-module-prefix= ");
+    Append (Ocaml_variables.ocamldoc_flags, "-latex-value-prefix=  ");
+    Append (Ocaml_variables.ocamldoc_flags, "-latex-module-type-prefix= ");
+    Append (Ocaml_variables.ocamldoc_flags, "-latextitle=1,subsection* ");
+    Append (Ocaml_variables.ocamldoc_flags, "-latextitle=2,subsubsection* ");
+    Append (Ocaml_variables.ocamldoc_flags, "-latextitle=6,subsection* ");
+    Append (Ocaml_variables.ocamldoc_flags, "-latextitle=7,subsubsection* ");
+  ]
+
+
+let html =
+  [
+    Add (Ocaml_variables.ocamldoc_backend, "html");
+    Append (Ocaml_variables.ocamldoc_flags, "-colorize-code ");
+  ]
+
+let man =
+  [
+    Add (Ocaml_variables.ocamldoc_backend, "man");
+  ]
+
+let wrap str = (" " ^ str ^ " ")
+
+let make_library_modifier library directory =
+[
+  Append (Ocaml_variables.directories, (wrap directory));
+  Append (Ocaml_variables.libraries, (wrap library));
+  Append (Ocaml_variables.caml_ld_library_path, (wrap directory));
+]
+
+let make_module_modifier unit_name directory =
+[
+  Append (Ocaml_variables.directories, (wrap directory));
+  Append (Ocaml_variables.binary_modules, (wrap unit_name));
+]
+
+let compiler_subdir subdir =
+  Filename.make_path (Ocamltest_config.ocamlsrcdir :: subdir)
+
+let config =
+[
+  Append (Ocaml_variables.directories, (wrap (compiler_subdir ["utils"])));
+]
+
+let testing = make_library_modifier
+  "testing" (compiler_subdir ["testsuite"; "lib"])
+
+let tool_ocaml_lib = make_module_modifier
+  "lib" (compiler_subdir ["testsuite"; "lib"])
+
+let unixlibdir = if Sys.os_type="Win32" then "win32unix" else "unix"
+
+let unix = make_library_modifier
+  "unix" (compiler_subdir ["otherlibs"; unixlibdir])
+
+let dynlink =
+  make_library_modifier "dynlink" (compiler_subdir ["otherlibs"; "dynlink"])
+
+let str = make_library_modifier
+  "str" (compiler_subdir ["otherlibs"; "str"])
+
+let systhreads =
+  unix @
+  (make_library_modifier
+    "threads" (compiler_subdir ["otherlibs"; "systhreads"]))
+
+let compilerlibs_subdirs =
+[
+  "asmcomp";
+  "bytecomp";
+  "compilerlibs";
+  "driver";
+  "file_formats";
+  "lambda";
+  "middle_end";
+  "parsing";
+  "toplevel";
+  "typing";
+  "utils";
+]
+
+let add_compiler_subdir subdir =
+  Append (Ocaml_variables.directories, (wrap (compiler_subdir [subdir])))
+
+let compilerlibs_archive archive =
+  (Append (Ocaml_variables.libraries, wrap archive)) ::
+  (List.map add_compiler_subdir compilerlibs_subdirs)
+
+let debugger = [add_compiler_subdir "debugger"]
+
+let _ =
+  register_modifiers "principal" principal;
+  register_modifiers "config" config;
+  register_modifiers "testing" testing;
+  register_modifiers "unix" unix;
+  register_modifiers "dynlink" dynlink;
+  register_modifiers "str" str;
+  List.iter
+    (fun archive -> register_modifiers archive (compilerlibs_archive archive))
+    [
+      "ocamlcommon";
+      "ocamlbytecomp";
+      "ocamlmiddleend";
+      "ocamloptcomp";
+      "ocamltoplevel";
+    ];
+  register_modifiers "systhreads" systhreads;
+  register_modifiers "latex" latex;
+  register_modifiers "html" html;
+  register_modifiers "man" man;
+  register_modifiers "tool-ocaml-lib" tool_ocaml_lib;
+  register_modifiers "debugger" debugger;
+  ()
diff --git a/ocamltest/ocaml_modifiers.mli b/ocamltest/ocaml_modifiers.mli
new file mode 100644
index 00000000..a6d2adc2
--- /dev/null
+++ b/ocamltest/ocaml_modifiers.mli
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of a few OCaml-specific environment modifiers *)
+
+val principal : Environments.modifiers
+
+val testing : Environments.modifiers
+
+val unix : Environments.modifiers
+
+val str : Environments.modifiers
+
+val latex: Environments.modifiers
+val man: Environments.modifiers
+val html: Environments.modifiers
diff --git a/ocamltest/ocaml_tests.ml b/ocamltest/ocaml_tests.ml
new file mode 100644
index 00000000..964eaa2f
--- /dev/null
+++ b/ocamltest/ocaml_tests.ml
@@ -0,0 +1,146 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Tests specific to the OCaml compiler *)
+
+open Tests
+open Builtin_actions
+open Ocaml_actions
+
+let bytecode =
+  let opt_actions =
+  [
+    setup_ocamlc_opt_build_env;
+    ocamlc_opt;
+    check_ocamlc_opt_output;
+    compare_bytecode_programs
+  ] in
+{
+  test_name = "bytecode";
+  test_run_by_default = true;
+  test_actions =
+  [
+    setup_ocamlc_byte_build_env;
+    ocamlc_byte;
+    check_ocamlc_byte_output;
+    run;
+    check_program_output;
+  ] @ (if Ocamltest_config.arch<>"none" then opt_actions else [])
+}
+
+let native =
+  let opt_actions =
+  [
+    setup_ocamlopt_byte_build_env;
+    ocamlopt_byte;
+    check_ocamlopt_byte_output;
+    run;
+    check_program_output;
+    setup_ocamlopt_opt_build_env;
+    ocamlopt_opt;
+    check_ocamlopt_opt_output;
+    compare_native_programs;
+  ] in
+  {
+    test_name = "native";
+    test_run_by_default = true;
+    test_actions =
+      (if Ocamltest_config.arch<>"none" then opt_actions else [skip])
+  }
+
+let toplevel = {
+  test_name = "toplevel";
+  test_run_by_default = false;
+  test_actions =
+  [
+    setup_ocaml_build_env;
+    ocaml;
+    check_ocaml_output;
+(*
+    setup_ocamlnat_build_env;
+    ocamlnat;
+    check_ocamlnat_output;
+*)
+  ]
+}
+
+let expect =
+{
+  test_name = "expect";
+  test_run_by_default = false;
+  test_actions =
+  [
+    setup_simple_build_env;
+    run_expect;
+    check_program_output
+  ]
+}
+
+let ocamldoc =
+{
+  test_name = "ocamldoc";
+  test_run_by_default = false;
+  test_actions =
+  if  Ocamltest_config.ocamldoc then
+  [
+    shared_libraries;
+    setup_ocamldoc_build_env;
+    run_ocamldoc;
+    check_program_output;
+    check_ocamldoc_output
+  ]
+  else
+  [ skip ]
+}
+
+let asmgen_skip_on_bytecode_only =
+  Actions_helpers.skip_with_reason "native compiler disabled"
+
+let asmgen_skip_on_spacetime =
+  Actions_helpers.skip_with_reason "not ported to Spacetime yet"
+
+let msvc64 =
+  Ocamltest_config.ccomptype = "msvc" && Ocamltest_config.arch="amd64"
+
+let asmgen_skip_on_msvc64 =
+  Actions_helpers.skip_with_reason "not ported to MSVC64 yet"
+
+let asmgen_actions =
+  if Ocamltest_config.arch="none" then [asmgen_skip_on_bytecode_only]
+  else if Ocamltest_config.spacetime then [asmgen_skip_on_spacetime]
+  else if msvc64 then [asmgen_skip_on_msvc64]
+  else [
+    setup_simple_build_env;
+    codegen;
+    cc;
+  ]
+
+let asmgen =
+{
+  test_name = "asmgen";
+  test_run_by_default = false;
+  test_actions = asmgen_actions
+}
+
+let _ =
+  List.iter register
+  [
+    bytecode;
+    native;
+    toplevel;
+    expect;
+    ocamldoc;
+    asmgen;
+  ]
diff --git a/ocamltest/ocaml_tests.mli b/ocamltest/ocaml_tests.mli
new file mode 100644
index 00000000..8ace884a
--- /dev/null
+++ b/ocamltest/ocaml_tests.mli
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Tests specific to the OCaml compiler *)
+
+val bytecode : Tests.t
+
+val native : Tests.t
+
+val toplevel : Tests.t
+
+val expect : Tests.t
+
+val ocamldoc : Tests.t
+
+val asmgen : Tests.t
diff --git a/ocamltest/ocaml_tools.ml b/ocamltest/ocaml_tools.ml
new file mode 100644
index 00000000..4b98bc2d
--- /dev/null
+++ b/ocamltest/ocaml_tools.ml
@@ -0,0 +1,71 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Descriptions of the OCaml tools *)
+
+open Ocamltest_stdlib
+
+class tool
+  ~(name : string -> string)
+  ~(family : string)
+  ~(flags : string)
+  ~(directory : string)
+  ~(exit_status_variable : Variables.t)
+  ~(reference_variable : Variables.t)
+  ~(output_variable : Variables.t)
+= object (self)
+  method name = name
+  method family = family
+  method flags = flags
+  method directory = directory
+  method exit_status_variable = exit_status_variable
+  method reference_variable = reference_variable
+  method output_variable = output_variable
+
+  method reference_filename_suffix env =
+    let tool_reference_suffix =
+      Environments.safe_lookup Ocaml_variables.compiler_reference_suffix env
+    in
+    if tool_reference_suffix<>""
+    then tool_reference_suffix ^ ".reference"
+    else ".reference"
+
+  method reference_file env prefix =
+    let suffix = self#reference_filename_suffix env in
+    (Filename.make_filename prefix directory) ^ suffix
+end
+
+let expected_exit_status env tool =
+  Actions_helpers.exit_status_of_variable env tool#exit_status_variable
+
+
+let ocamldoc =
+  object inherit
+  tool
+    ~name:Ocaml_files.ocamldoc
+    ~family:"doc"
+    ~flags:""
+    ~directory:"ocamldoc"
+    ~exit_status_variable:Ocaml_variables.ocamldoc_exit_status
+    ~reference_variable:Ocaml_variables.ocamldoc_reference
+    ~output_variable:Ocaml_variables.ocamldoc_output
+
+    method ! reference_filename_suffix env =
+      let backend =
+        Environments.safe_lookup Ocaml_variables.ocamldoc_backend env in
+      if backend = "" then
+        ".reference"
+      else "." ^ backend ^ ".reference"
+  end
diff --git a/ocamltest/ocaml_tools.mli b/ocamltest/ocaml_tools.mli
new file mode 100644
index 00000000..c8acbee3
--- /dev/null
+++ b/ocamltest/ocaml_tools.mli
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Descriptions of the OCaml tools *)
+
+class tool :
+  name : (string -> string) ->
+  family : string ->
+  flags : string ->
+  directory : string ->
+  exit_status_variable : Variables.t ->
+  reference_variable : Variables.t ->
+  output_variable : Variables.t ->
+object
+  method name : string -> string
+  method family : string
+  method flags : string
+  method directory : string
+  method exit_status_variable : Variables.t
+  method reference_variable : Variables.t
+  method output_variable : Variables.t
+  method reference_filename_suffix : Environments.t -> string
+  method reference_file : Environments.t -> string -> string
+end
+
+val expected_exit_status : Environments.t -> tool -> int
+
+val ocamldoc: tool
diff --git a/ocamltest/ocaml_toplevels.ml b/ocamltest/ocaml_toplevels.ml
new file mode 100644
index 00000000..9121cc0c
--- /dev/null
+++ b/ocamltest/ocaml_toplevels.ml
@@ -0,0 +1,70 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Description of the OCaml toplevels *)
+
+open Ocamltest_stdlib
+
+class toplevel
+  ~(name : string -> string)
+  ~(flags : string)
+  ~(directory : string)
+  ~(exit_status_variable : Variables.t)
+  ~(reference_variable : Variables.t)
+  ~(output_variable : Variables.t)
+  ~(backend : Ocaml_backends.t)
+  ~(compiler : Ocaml_compilers.compiler)
+= object (self) inherit Ocaml_tools.tool
+  ~name:name
+  ~family:"toplevel"
+  ~flags:flags
+  ~directory:directory
+  ~exit_status_variable:exit_status_variable
+  ~reference_variable:reference_variable
+  ~output_variable:output_variable
+  as tool
+  method backend = backend
+  method compiler = compiler
+  method ! reference_file env prefix =
+    let default = tool#reference_file env prefix in
+    if Sys.file_exists default then default else
+    let suffix = self#reference_filename_suffix env in
+    let mk s = (Filename.make_filename prefix s) ^ suffix in
+    let filename = mk
+      (Ocaml_backends.string_of_backend self#backend) in
+    if Sys.file_exists filename then filename else
+    mk "compilers"
+
+end
+
+let ocaml = new toplevel
+  ~name: Ocaml_commands.ocamlrun_ocaml
+  ~flags: ""
+  ~directory: "ocaml"
+  ~exit_status_variable: Ocaml_variables.ocaml_exit_status
+  ~reference_variable: Ocaml_variables.compiler_reference
+  ~output_variable: Ocaml_variables.compiler_output
+  ~backend: Ocaml_backends.Bytecode
+  ~compiler: Ocaml_compilers.ocamlc_byte
+
+let ocamlnat = new toplevel
+  ~name: Ocaml_files.ocamlnat
+  ~flags: "-S" (* Keep intermediate assembly files *)
+  ~directory: "ocamlnat"
+  ~exit_status_variable: Ocaml_variables.ocamlnat_exit_status
+  ~reference_variable: Ocaml_variables.compiler_reference2
+  ~output_variable: Ocaml_variables.compiler_output2
+  ~backend: Ocaml_backends.Native
+  ~compiler: Ocaml_compilers.ocamlc_opt
diff --git a/ocamltest/ocaml_toplevels.mli b/ocamltest/ocaml_toplevels.mli
new file mode 100644
index 00000000..f29fbac7
--- /dev/null
+++ b/ocamltest/ocaml_toplevels.mli
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Descriptions of the OCaml toplevels *)
+
+class toplevel :
+  name : (string -> string) ->
+  flags : string ->
+  directory : string ->
+  exit_status_variable : Variables.t ->
+  reference_variable : Variables.t ->
+  output_variable : Variables.t ->
+  backend : Ocaml_backends.t ->
+  compiler : Ocaml_compilers.compiler ->
+object inherit Ocaml_tools.tool
+  method backend : Ocaml_backends.t
+  method compiler : Ocaml_compilers.compiler
+end
+
+val ocaml : toplevel
+
+val ocamlnat : toplevel
diff --git a/ocamltest/ocaml_variables.ml b/ocamltest/ocaml_variables.ml
new file mode 100644
index 00000000..b9515629
--- /dev/null
+++ b/ocamltest/ocaml_variables.ml
@@ -0,0 +1,291 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of variables used by built-in actions *)
+
+(* The variables are listed in alphabetical order *)
+
+(*
+  The name of the identifier representing a variable and its string name
+  should be similar. Is there a way to enforce this?
+*)
+
+open Ocamltest_stdlib
+
+open Variables (* Should not be necessary with a ppx *)
+
+let all_modules = make ("all_modules",
+  "All the modules to compile and link")
+
+let arch = make ("arch",
+  "Host architecture")
+
+let binary_modules = make ("binary_modules",
+  "Additional binary modules to link")
+
+let bytecc_libs = make ("bytecc_libs",
+  "Libraries to link with for bytecode")
+
+let c_preprocessor = make ("c_preprocessor",
+  "Command to use to invoke the C preprocessor")
+
+let caml_ld_library_path_name = "CAML_LD_LIBRARY_PATH"
+
+let export_caml_ld_library_path value =
+  let current_value = Sys.safe_getenv caml_ld_library_path_name in
+  let local_value =
+    (String.concat Filename.path_sep (String.words value)) in
+  let new_value =
+    if local_value="" then current_value else
+    if current_value="" then local_value else
+    String.concat Filename.path_sep [local_value; current_value] in
+  Printf.sprintf "%s=%s" caml_ld_library_path_name new_value
+
+let caml_ld_library_path =
+  make_with_exporter
+    export_caml_ld_library_path
+    ("ld_library_path",
+      "List of paths to lookup for loading dynamic libraries")
+
+let compare_programs = make ("compare_programs",
+  "Set to \"false\" to disable program comparison")
+
+let compiler_directory_suffix = make ("compiler_directory_suffix",
+  "Suffix to add to the directory where the test will be compiled")
+
+let compiler_reference = make ("compiler_reference",
+  "Reference file for compiler output for ocamlc.byte and ocamlopt.byte")
+
+let compiler_reference2 = make ("compiler_reference2",
+  "Reference file for compiler output for ocamlc.opt and ocamlopt.opt")
+
+let compiler_reference_suffix = make ("compiler_reference_suffix",
+  "Suffix to add to the file name containing the reference for compiler output")
+
+let compiler_output = make ("compiler_output",
+  "Where to log output of bytecode compilers")
+
+let compiler_output2 = make ("compiler_output2",
+  "Where to log output of native compilers")
+
+let compiler_stdin = make ("compiler_stdin",
+  "standard input of compilers")
+
+let compile_only = make ("compile_only",
+  "Compile only (do not link)")
+
+let csc = make ("csc", "Path to the CSharp compiler")
+
+let csc_flags = make ("csc_flags", "Flags for the CSharp compiler")
+
+let directories = make ("directories",
+  "Directories to include by all the compilers")
+
+let flags = make ("flags",
+  "Flags passed to all the compilers")
+
+let last_flags = make ("last_flags",
+  "Flags passed to all the compilers at the end of the commandline")
+
+let libraries = make ("libraries",
+  "Libraries the program should be linked with")
+
+let mkdll = make ("mkdll",
+  "Command to use to build a DLL")
+
+let mkexe = make ("mkexe",
+  "Command used to build an executable program DLL")
+
+let module_ = make ("module",
+  "Compile one module at once")
+
+let modules = make ("modules",
+  "Other modules of the test")
+
+let nativecc_libs = make ("nativecc_libs",
+  "Libraries to link with for native code")
+
+let objext = make ("objext",
+  "Extension of object files")
+
+let asmext = make ("asmext",
+  "Extension of assembly files")
+
+let ocamlc_byte = make ("ocamlc_byte",
+  "Path of the ocamlc.byte executable")
+
+let ocamlopt_byte = make ("ocamlopt_byte",
+  "Path of the ocamlopt.byte executable")
+
+let ocamlrun = make ("ocamlrun",
+  "Path of the ocamlrun executable")
+
+let ocamlc_flags = make ("ocamlc_flags",
+  "Flags passed to ocamlc.byte and ocamlc.opt")
+
+let ocamlc_default_flags = make ("ocamlc_default_flags",
+  "Flags passed by default to ocamlc.byte and ocamlc.opt")
+
+
+
+let ocamllex_flags = make ("ocamllex_flags",
+  "Flags passed to ocamllex")
+
+let ocamlopt_flags = make ("ocamlopt_flags",
+  "Flags passed to ocamlopt.byte and ocamlopt.opt")
+
+let ocamlopt_default_flags = make ("ocamlopt_default_flags",
+  "Flags passed by default to ocamlopt.byte and ocamlopt.opt")
+
+let ocamlyacc_flags = make ("ocamlyacc_flags",
+  "Flags passed to ocamlyacc")
+
+let ocaml_exit_status = make ("ocaml_exit_status",
+  "Expected exit status of ocaml")
+
+let ocaml_filetype_flag = make ("ocaml_filetype_flag",
+  "Filetype of the testfile (-impl, -intf, etc.)")
+
+let ocamlc_byte_exit_status = make ("ocamlc_byte_exit_status",
+  "Expected exit status of ocac.byte")
+
+let ocamlopt_byte_exit_status = make ("ocamlopt_byte_exit_status",
+  "Expected exit status of ocamlopt.byte")
+
+let ocamlnat_exit_status = make ("ocamlnat_exit_status",
+  "Expected exit status of ocamlnat")
+
+let ocamlc_opt_exit_status = make ("ocamlc_opt_exit_status",
+  "Expected exit status of ocac.opt")
+
+let ocamlopt_opt_exit_status = make ("ocamlopt_opt_exit_status",
+  "Expected exit status of ocamlopt.opt")
+
+let export_ocamlrunparam value =
+  Printf.sprintf "%s=%s" "OCAMLRUNPARAM" value
+
+let ocamlrunparam =
+  make_with_exporter
+    export_ocamlrunparam
+    ("ocamlrunparam",
+      "Equivalent of OCAMLRUNPARAM")
+
+let ocamlsrcdir = make ("ocamlsrcdir",
+  "Where OCaml sources are")
+
+let ocamldebug_flags = make ("ocamldebug_flags",
+  "Flags for ocamldebug")
+
+let ocamldebug_script = make ("ocamldebug_script",
+  "Where ocamldebug should read its commands")
+
+let os_type = make ("os_type",
+  "The OS we are running on")
+
+let ocamldoc_flags = Variables.make ("ocamldoc_flags",
+  "ocamldoc flags")
+
+let ocamldoc_backend = Variables.make ("ocamldoc_backend",
+  "ocamldoc backend (html, latex, man, ... )")
+
+let ocamldoc_exit_status =
+  Variables.make ( "ocamldoc_exit_status", "expected ocamldoc exit status")
+
+let ocamldoc_output =
+  Variables.make ( "ocamldoc_output", "Where to log ocamldoc output")
+
+let ocamldoc_reference =
+  Variables.make ( "ocamldoc_reference",
+                   "Where to find expected ocamldoc output")
+
+let ocaml_script_as_argument =
+  Variables.make ( "ocaml_script_as_argument",
+    "Whether the ocaml script should be passed as argument or on stdin")
+
+let plugins =
+  Variables.make ( "plugins", "plugins for ocamldoc" )
+
+let shared_library_cflags =
+  Variables.make ("shared_library_cflags",
+    "Flags used to compile C files for inclusion in shared libraries")
+
+let sharedobjext =
+  Variables.make ("sharedobjext",
+    "Extension of shared object files")
+
+let use_runtime =
+  Variables.make ("use_runtime",
+    "Whether the -use-runtime option should be used" )
+
+let _ = List.iter register_variable
+  [
+    all_modules;
+    arch;
+    binary_modules;
+    bytecc_libs;
+    c_preprocessor;
+    caml_ld_library_path;
+    compare_programs;
+    compiler_directory_suffix;
+    compiler_reference;
+    compiler_reference2;
+    compiler_reference_suffix;
+    compiler_output;
+    compiler_output2;
+    compiler_stdin;
+    compile_only;
+    csc;
+    csc_flags;
+    directories;
+    flags;
+    last_flags;
+    libraries;
+    mkdll;
+    module_;
+    modules;
+    nativecc_libs;
+    objext;
+    asmext;
+    ocamlc_byte;
+    ocamlopt_byte;
+    ocamlrun;
+    ocamlc_flags;
+    ocamlc_default_flags;
+    ocamlopt_flags;
+    ocamlopt_default_flags;
+    ocaml_exit_status;
+    ocaml_filetype_flag;
+    ocamlc_byte_exit_status;
+    ocamlopt_byte_exit_status;
+    ocamlnat_exit_status;
+    ocamlc_opt_exit_status;
+    ocamlopt_opt_exit_status;
+    ocamlrunparam;
+    ocamllex_flags;
+    ocamlyacc_flags;
+    ocamldoc_flags;
+    ocamldoc_backend;
+    ocamldoc_output;
+    ocamldoc_reference;
+    ocamldoc_exit_status;
+    ocamldebug_flags;
+    ocamldebug_script;
+    ocaml_script_as_argument;
+    os_type;
+    plugins;
+    shared_library_cflags;
+    sharedobjext;
+    use_runtime;
+  ]
diff --git a/ocamltest/ocaml_variables.mli b/ocamltest/ocaml_variables.mli
new file mode 100644
index 00000000..89686de1
--- /dev/null
+++ b/ocamltest/ocaml_variables.mli
@@ -0,0 +1,131 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of OCaml-specific variables *)
+
+(* The variables are listed in alphabetical order *)
+
+val all_modules : Variables.t
+
+val arch : Variables.t
+
+val binary_modules : Variables.t
+
+val bytecc_libs : Variables.t
+(** Libraries to link with for bytecode *)
+
+val c_preprocessor : Variables.t
+
+val caml_ld_library_path : Variables.t
+
+val compare_programs : Variables.t
+
+val compiler_directory_suffix : Variables.t
+
+val compiler_reference : Variables.t
+
+val compiler_reference2 : Variables.t
+
+val compiler_reference_suffix : Variables.t
+
+val compiler_output : Variables.t
+
+val compiler_output2 : Variables.t
+
+val compiler_stdin : Variables.t
+
+val compile_only : Variables.t
+
+val csc : Variables.t
+
+val csc_flags : Variables.t
+
+val directories : Variables.t
+
+val flags : Variables.t
+
+val last_flags : Variables.t
+
+val libraries : Variables.t
+
+val mkdll : Variables.t
+(** Command used to make a DLL *)
+
+val mkexe : Variables.t
+(** Command used to build an executable program *)
+
+val module_ : Variables.t
+
+val modules : Variables.t
+
+val nativecc_libs : Variables.t
+(** Libraries to link with for native code *)
+
+val objext : Variables.t
+val asmext : Variables.t
+
+val ocamlc_byte : Variables.t
+val ocamlopt_byte : Variables.t
+val ocamlrun : Variables.t
+
+val ocamlc_flags : Variables.t
+val ocamlc_default_flags : Variables.t
+
+val ocamllex_flags : Variables.t
+
+val ocamlopt_flags : Variables.t
+val ocamlopt_default_flags : Variables.t
+
+val ocamlyacc_flags : Variables.t
+
+val ocaml_exit_status : Variables.t
+
+val ocaml_filetype_flag : Variables.t
+
+val ocamlc_byte_exit_status : Variables.t
+
+val ocamlopt_byte_exit_status : Variables.t
+
+val ocamlnat_exit_status : Variables.t
+
+val ocamlc_opt_exit_status : Variables.t
+
+val ocamlopt_opt_exit_status : Variables.t
+
+val ocamlrunparam : Variables.t
+
+val ocamlsrcdir : Variables.t
+
+val ocamldebug_flags : Variables.t
+
+val ocamldebug_script : Variables.t
+
+val os_type : Variables.t
+
+val ocamldoc_flags : Variables.t
+val ocamldoc_backend : Variables.t
+val ocamldoc_exit_status : Variables.t
+val ocamldoc_output : Variables.t
+val ocamldoc_reference : Variables.t
+
+val ocaml_script_as_argument : Variables.t
+
+val plugins : Variables.t
+
+val shared_library_cflags : Variables.t
+
+val sharedobjext : Variables.t
+
+val use_runtime : Variables.t
diff --git a/ocamltest/ocamltest.org b/ocamltest/ocamltest.org
new file mode 100644
index 00000000..20651fc7
--- /dev/null
+++ b/ocamltest/ocamltest.org
@@ -0,0 +1,745 @@
+#+STARTUP: showall
+
+#+title: The ocamltest reference manual
+#+language: en
+
+#+HTML_HEAD: <style> body { font-size: 1rem; max-width: 900px; margin: 0 auto; } </style>
+
+* Introduction
+
+This is =verbatim= and this is ~code~.
+
+** What is ocamltest
+
+ocamltest is a test-driver, that is, a program that can run tests and report
+their results so that they can be used by a test infrastructure.
+
+Originally, the tool has been designed specifically to run the integration
+tests of the OCaml compiler's test suite. However, it has been
+designed with extensibility in mind and thus has a plugin
+mechanism that makes it possible to extend it with other tests.
+
+** Design choices
+
+*** Programming language and external dependencies
+
+For a start, one may wonder in which language a test-driver for a compiler
+should be written. It may indeed seem odd to write a test-driver for a
+compiler in the language it compiles, since the compiler itself
+is yet untested and thus not trustworthy.
+
+It can however be observed that the OCaml compiler is /bootstraped/,
+meaning that it is itself written in OCaml. A newer version of the
+compiler can thus be produced from an existing one and the (OCaml)
+source code of that newer version. Practically, this means that the
+compiler works at least well enough to recompile itself. This is why we
+consider that it is okay to write a test-driver like ocamltest in OCaml,
+as long as it uses only code that has been used to bootstrap the
+compiler. In particular, this is why we prefer not to rely on any
+external dependency, not even the libraries included in the compiler
+distribution such as the =Unix= library.
+
+*** Test types
+
+As has been noted above, ocamltest has been developed to run the already
+existing integration tests of the OCaml compiler's test suite, which
+were previously run by a set of makefiles. This context explains
+several design decisions which could otherwise seem rather arbitrary.
+
+For example, the reason why ocamltest has no support for running unit tests
+is that there were no such tests in the OCaml compiler's test suite.
+
+Indeed, the OCaml compiler's test suite is composed mainly of complete
+programs. In this context, the most current meaning of "testing" a program
+is that the program needs to be compiled and executed. The test will
+be considered successful if the program compiles as expected and, when run,
+returns the expected value.
+
+Since this scenario is the most frequent one, it was of particular
+importance to make writing tests of this form as simple as possible.
+
+However, not all tests fall into the previously described category, so it is
+also necessary to support not only variations on the previous scenario
+(compile but do not run, compile with certain options, etc.) but also
+completely different tests, such as top-level tests, debugger tests,
+etc.
+
+To fulfill these requirements and make it as easy as possible to turn a
+program into a test, it has been chosen to design a Domain-Specific
+Language (DSL) used to annotate the test program with a
+=(* TEST *)= block at its top. This block specifies how the test
+should be performed.
+
+** Outline of this document
+
+The next chapter explains through examples how to write simple tests. We
+then introduce the key concepts used by ocamltest to provide a better
+understanding of how it works and can be used to write more complex
+tests. The two last chapters give an in-depth description of the
+built-in tests and actions and of the tests and actions that are specific
+to the OCaml compiler.
+
+* Writing simple tests
+
+This chapter is a tutorial. It explains how to write simple test
+programs and also tries to give insights about how ocamltest works. These
+insights will be deepened in chapter [[#concepts]] where ocamltest is
+presented in a more abstract and conceptual way.
+
+We start by explaining how to set-up a proper environment for writing
+tests. We then show how to turn the traditional "Hello, world!" program
+into a test and explain how to run it with ocamltest. We continue
+with a few variations on this test and conclude this chapter
+with a few other useful tests.
+
+** Prerequisites for writing tests
+
+Writing tests requires that the sources of the OCaml compiler for which
+one wants to write them are downloaded and compiled. The compiler
+does not need to be installed, though.
+
+The sources can be downloaded either as an archive, or directly cloned
+through git, which seems more appropriate in the context of writing ones
+own tests. Refer to
+=INSTALL.adoc= (and also to =README.win32.adoc= if you are on Windows) to
+learn how to get the sources of the OCaml compiler and to compile them.
+
+In the remainder of this manual, we will assume that the sources of the
+OCaml compiler have been extracted in the =${OCAMLSRCDIR}= directory (for
+instance =${HOME}/src/ocaml=) and that you have successfully configured
+and compiled them as described in =INSTALL.adoc= or =README.win32.adoc=,
+according to your operating system. The tools and libraries necessary
+for running tests should also be built. This can be achieved by running
+the following command from =${OCAMLSRCDIR}=:
+: make -C testsuite lib tools
+
+We will also assume that an =ocamltest= command is available in
+your =PATH=. Although this is not strictly necessary, it is strongly
+recommended that you set this up because this will simplify test
+development a lot. This can be achieved e.g. by creating a symbolic
+link to =${OCAMLSRCDIR}/ocamltest/ocamltest= (or its native
+counterpart =${OCAMLSRCDIR}/ocamltest/ocamltest.opt=) in a directory that
+is already in your =PATH=, like =~/bin=.
+
+** Testing the "Hello, world!" program with the default tests
+
+*** Turning "Hello, world!" into a useful test program
+
+Consider the following OCaml implementation of the classical "Hello, world!"
+program written to a =hello.ml= file:
+
+: let _ = print_endline "Hello, world!"
+
+Now assume we would like to make sure that the OCaml compiler can
+compile this program and that the resulting executable indeed prints the
+expected output. Here are the required steps to turn the program
+above into a test usable by ocamltest to verify this:
+
+1. First, we add a special comment at the very beginning of our =hello.ml=
+   file to make it explicit that it is a test:
+   #+begin_src
+   (* TEST *)
+
+   let _ = print_endline "Hello, world!"
+   #+end_src
+
+2. We then need to say what the expected outputs are. In our case, we
+   expect that compiling the test produces no output at all and that its
+   execution produces one single line:
+   : Hello, world!
+   To let ocamltest know about this, we create a =hello.reference= file
+   containing the program's expected output -- the line mentioned
+   above. There is nothing special to do for silent compilations
+   since this is what is expected by default and a non-silent
+   compilation would actually cause a test failure.
+
+3. We can now ask ocamltest to run our test program with the
+   following command:
+   : ocamltest hello.ml
+
+   Running this would produce an output similar to this one:
+
+   #+begin_src
+    ... testing 'hello.ml' with 1 (native) => passed
+    ... testing 'hello.ml' with 2 (bytecode) => passed
+   #+end_src
+
+   In addition to this output, it may be noticed that the previous
+   command has also created an =_ocamltest= directory whose content will
+   be examined in the next sub-section.
+
+4. Finally, there is one extra step required if we want our newly created
+   test to be run automatically as part of the OCaml compiler's test suite.
+   We need to move =hello.ml= and =hello.reference= to a directory (say
+   =newtest=) located somewhere
+   below =testsuite/tests= in the compiler's source tree and we
+   need to declare the test. This is done by appending the name of the
+   file containing the =(* TEST *)= comment to an =ocamltests=
+   (mark the final s) file located in the =newtest= directory,
+   alongside the other files relevant to the test. Once this is done,
+   the command
+   : make all
+   executed in the =testsuite= directory of the OCaml compiler' source
+   tree will run all the test suite, which now also includes our own test.
+
+*** What exactly is going on during the test
+
+The only thing we know from ocamltest's output when run on =hello.ml= is
+that it is running two tests named =bytecode= and =native= and that the two of
+them succeed. This can seem rather uninformative, and in a way it is, but
+it has to be kept in mind that this information is the one passed by the
+test-driver (ocamltest) to the test infrastructure. In that respect,
+this is enough. For us users, though, it is not. That's why
+ocamltest logs much more details about what is going on in a per-test
+log file, which should be located in the =_ocamltest/hello/hello.log= file
+found in the directory where =hello.ml= is.
+
+Before looking at this log file, notice that it has been created in a
+test-specific directory. ocamltest creates such a directory for each
+file it tests and makes sure every file produced as a result of
+testing this file will be placed in this directory, either directly, or
+in one of its sub-directories. The latter happens if the test has
+to be compiled several times, with the same compiler and different
+command-line options, or with different compilers. In particular,
+in order to better understand what follows, it may be helpful to
+remember that =OCaml= actually consists in not less than four compilers:
+=ocamlc.byte= and =ocamlc.opt= which are the bytecode and native
+flavors of the bytecode compiler and =ocamlopt.byte= and
+=ocamlopt.opt= which are the bytecode and native flavors of the native
+compiler. So, as we will see, ''testing the bytecode compiler''
+actually involves testing two compilers, and the same goes for ''testing
+the native compiler''.
+
+Now that all this has been spelled out, let's examine the log file
+produced by the test. Although it is too long to be reproduced here,
+it is recommended to go through it quickly to get an idea of its
+structure. Here is how it starts:
+
+#+begin_src
+Specified modules: hello.ml
+Source modules: hello.ml
+#+end_src
+
+The first line lists the names of the modules the test consists of. The
+second line is almost similar but if some modules had separate
+interface files, they would be listed here, too, without the user
+having to specify them in the list of modules (for each specified =.ml=
+file, ocamltest looks whether a corresponding =.mli= file exists and, if
+so, adds it to the list of files to consider).
+
+The rest of the log file can be split into two parts which are very
+similar to each other: one for the =native= test and one for the =bytecode=
+test. Among other things, we learn that each of these tests is composed
+of nine actions. Before diving into the details of what each of these
+actions does, let us take this opportunity to introduce a bit of
+ocamltest terminology. An /action/ is anything that can =pass=, =skip= or
+=fail=. A =test= is a sequence of such actions. Running
+a test thus means running each of its actions, in sequence, until all the
+actions have been run or one of them returns =pass= or =skip=. Whatever
+the last run action returns, this value will be the result of the whole
+test.
+
+To give concrete examples of actions, let's briefly go over the nine ones
+involved in the =bytecode= test (those for the =native= test are
+quite similar):
+
+1. =setup-ocamlc.byte-build-env=:: as its name suggests, this action
+   creates a build environment where a program can be compiled and
+   executed using the =ocamlc.byte= compiler. More precisely, this
+   involves creating a dedicated directory under the test-file specific
+   directory and populating it with the files required by subsequent actions.
+   Depending on what the underlying operating system supports, the files
+   will be either symlinked or copied from the test source directory.
+
+2. =ocamlc.byte=:: invokes the =ocamlc.byte= compiler in various ways.
+   Here, the test program is compiled and linked, but as we will see
+   later, different behaviors are possible depending on ocamltest
+   /variables/.
+
+3. =check-ocamlc.byte-output=:: this action compares the compiler's
+   output to a reference file, if one exists. As has been mentioned
+   earlier, the absence of such a reference file specifies that the
+   compiler's output is expected to be empty -- if it is not, this
+   causes a failure of this action and thus of the whole =bytecode=
+   test.
+
+4. =run=:: now that the program has been successfully compiled, it is
+   run with its standard output and error streams saved to a file.
+
+
+5. =check-program-output=:: this time it is the output of the program
+   which is compared to a reference file, namely the =hello.reference=
+   file created earlier. So far this comparison succeeds, because the
+   output of the program is identical to the reference file but, as an
+   exercise, one may try to modify the reference file to see how this
+   causes the failure of this action and of the whole =bytecode= test.
+
+   This action concludes the test of the =ocamlc.byte= compiler. We now
+   know that it is able to successfully compile our test program and that
+   the resulting executable runs as expected. The four remaining actions
+   are going to test the =ocamlc.opt= compiler in a similar but not
+   identical way:
+
+6. =setup-ocamlc.opt-build-env=:: this action is the counterpart of
+   action 1 for the =ocamlc.opt= compiler.
+
+7. =ocamlc.opt=:: like action 2, this action compiles the test program
+   but with the =ocamlc.opt= compiler.
+
+8. =check-ocamlc.opt-output=:: again, this action is similar to
+   action 3.
+
+9. =compare-bytecode-programs=:: here we make sure that the generated
+   executable is correct, but in a different way than for the
+   =ocamlc.byte= compiler. Rather than running it and checking its
+   output, we compare it to the one produced in action 2. Such a check
+   may seem strange, because what it requires is that =ocamlc.byte= and
+   =ocamlc.opt= produce exactly the same binary and not two binaries
+   than perform similarly when they are run, but it has proven useful in
+   the past and has permitted to detect a subtle bug in the compiler.
+
+** Customizing the default tests
+
+As has been briefly mentioned, the precise behavior of actions (and
+thus of tests) may depend on /variables/ whose value can be adjusted in
+the =(* TEST ... *)= blocks. In ocamltest, all the values of variables
+are strings. Here are a few examples of things that can be achieved just
+by defining the appropriate variables. The complete description of the
+actions provided by ocamltest and the variables they use will be given
+in chapters [[#builtins]] and [[#ocaml-specific]].
+
+*** Passing flags to the compilers
+
+Assume our =hello.ml= example is modified as follows:
+
+#+begin_src
+(* TEST *)
+
+open Format
+
+let _ = print_endline "Hello, world!"
+#+end_src
+
+As may be verified, this program still passes the default tests. It is
+however not as minimal as our previous version, because the =Format=
+module is opened but not used. Fortunately, OCaml has a warning to
+detect such unused =open= directives, namely warning 33, which is
+disabled by default. We could thus add this version of =hello.ml=
+to the test suite, not so much to verify that the program compiles and
+runs as expected (we verified this already), but rather to make sure
+the compiler does indeed trigger the expected warning. Here are the
+required steps to achieve this:
+
+1. We slightly modify the test block in =hello.ml=, as follows:
+   #+begin_src
+   (* TEST
+   flags = "-w +33"
+   *)
+   #+end_src
+
+2. Since we now expect a non-empty output for the compilers, we need to
+   store the expected output in a file, namely =hello.compilers.output=
+   besides to =hello.ml= and =hello.reference=. To figure out what
+   this file shall contain, we can run ocamltest even before it
+   has been created. Of course, the action that checks compiler output
+   will fail, but in this way we will get the compiler's output
+   which we will just have to check (to
+   make sure it is what we expect) and to move to the reference file.
+   Thus, we do:
+   : $ ocamltest hello.ml
+   which fails, unsurprisingly, and shows us the paths to the file
+   containing the output produced by the compiler and the path to the
+   expected reference file. We also see what the compiler produced as
+   output but we can double-check that the output is what we expect as a
+   reference:
+   : $ cat _ocamltest/hello/ocamlc.byte/ocamlc.byte.output
+   which shows the warning we expect from the compiler. We can thus move
+   this file to the reference file:
+   : $ mv _ocamltest/hello/ocamlc.byte/ocamlc.byte.output hello.compilers.reference
+   and if we now run ocamltest again, all the tests pass.
+
+Two remarks are due. First, we have used the =flags= variable, to pass
+extra flags to all the compilers. There are two other variables one can
+use, namely =ocamlc_flags= and =ocamlopt_flags=, to pass flags to the
+bytecode or native compilers. Second, in this test all the compilers
+have the same output so one reference file is enough for all of them.
+There are situations, though, where the compiler's output is
+back-end-specific (it depends whether we compile to bytecode or to native
+code) or even compiler-specific. ocamltest is clever enough to know how
+to deal with such situations, provided that the reference files are
+named appropriately. It will indeed first lookup the test source
+directory for a compiler-specific reference file, e.g.
+=hello.ocamlc.byte.reference=. If no such file exists, a
+back-end-specific reference file is searched, e.g.
+=hello.ocamlc.reference= for a compiler common to both =ocamlc.byte= and
+=ocamlc.opt=. If this file does not exist either, ocamltest falls back
+to looking for =hello.compilers.reference= as we have seen in this
+example, the absence of which meaning that the compiler's output is
+expected to be empty.
+
+*** Using an auxiliary module
+
+Let's start with our original =hello.ml= test program and extract the
+greeting logic into a distinct =greet.ml= module:
+
+#+begin_src
+let greet guest = Printf.printf "Hello, %s!\n" guest
+#+end_src
+
+Let's also write an interface, =greet.mli=:
+
+#+begin_src
+val greet : string -> unit
+#+end_src
+
+Our =hello.ml= test program can then be rewritten as follows:
+
+#+begin_src
+(* TEST
+modules = "greet.ml"
+*)
+
+let _ = Greet.greet "world"
+#+end_src
+
+Provided that the =hello.compilers.reference= file previously to test
+warnings is deleted, running ocamltest on =hello.ml= should work. It
+will also be worth looking at the two first lines of the log file generated
+while running the test. It says:
+
+#+begin_src
+Specified modules: greet.ml hello.ml
+Source modules: greet.mli greet.ml hello.ml
+#+end_src
+
+The first line shows that the =modules= variable has been taken into
+account. On the second line, it can be seen that the =greet.mli= file
+appears, right before =greet.ml=. It is ocamltest that has added it,
+because it has been recognized as an interface for one of the specified
+modules.
+
+To sum up, if a test consists in several modules, it is enough to list
+their implementations (except the one of the main test program which is
+implicit) in the =modules= variable, in linking order. There is no need
+to worry about their interfaces, which will be added automatically by
+ocamltest, if they exist.
+
+*** Linking with a library
+
+Assume we want to use the following program to make sure regular
+expressions as implemented by the =Str= library work as expected:
+
+#+begin_src
+let hello_re = Str.regexp "^Hello, .+!$"
+
+let hello_str = "Hello, world!"
+
+let _ =
+  if not (Str.string_match hello_re hello_str 0) then
+  begin
+     Printf.eprintf "There is a problem!\n";
+     exit 2
+  end
+#+end_src
+
+This test terminates silently if everything goes well and prints a
+message on its standard error only if something goes wrong, which means
+we won't have anything special to do so that ocamltest checks for an
+empty output after the program has run. However, to be able to compile
+and link this test, there are several things we need to do so that it
+finds the =Str= library it uses. More precisely, we need to add the =-I=
+option pointing to the right directory and, at link time, to give the
+name of the appropriate library file. To make our life a bit simpler,
+ocamltest has a few variables where directories and libraries can be
+listed. Once they are there, it is ocamltest which will take care of
+adding the =-I= option for each directory and for adding the right
+library file depending on whether we are producing bytecode or native
+programs. So, here is how the previous program can be annotated so that
+it becomes a test:
+
+#+begin_src
+(* TEST
+directories += " ${ocamlsrcdir}/otherlibs/str "
+libraries += " str "
+*)
+#+end_src
+
+With these annotations, it becomes possible to run =re.ml= as an
+ocamltest test program and, doing so, one may notice that the two tests
+pass. There are however a few other things worth pointing out here
+regarding the ocamltest DSL. For a start, the notation =${variable}=
+inside a string means to replace =variable= by its value, as happens in
+many other languages, like the bash shell. Moreover, it is the first
+time we meet the ~+=~ operator which concatenates a value to a variable.
+More precisely,
+: foo += "bar"
+is equivalent to
+: foo = "${foo}bar"
+and not to
+: foo = "${foo} bar"
+as it may happen in other languages such as makefiles.
+
+In other words, the ~+=~ operator concatenates two strings without
+inserting any implicit space between them as e.g. make would do. This is
+because in some cases such a behavior is required and could not be
+achieved if spaces were implicitly added, whereas with a literal
+concatenation it is always possible to include spaces explicitly. This is
+exactly what happens in the ocamltest annotation block above, where the
+strings added to the =libraries= and =directories= variables are
+surrounded by spaces. As should be clear to the reader by now, these
+spaces are mandatory. Without them, the added values would be glued to
+the last word of the variable and would thus be misinterpreted.
+
+Finally, one may notice that, although ocamltest does make it
+possible to link a test program with a library, it does not really make
+it easy or convenient to do so. In particular, what if we want to write
+several, perhaps many test programs that need to be linked with =Str=?
+Will we have to repeat these lines everywhere, thus creating code that
+is going to be tedious to maintain? Well, fortunately not. Actually,
+ocamltest has a much more elegant way to deal with such issues, namely
+/environment modifiers/. As will be explained in chapter [[#concepts]], an
+/environment modifier/ is an object that gathers several variable
+definitions that can then be included in an ocamltest block at once.
+Environment modifiers have to be defined in ocamltest itself and can
+then be used with the =include= directive. For instance, the previous
+test block is actually written as follows:
+
+#+begin_src
+(* TEST
+include str
+*)
+#+end_src
+
+*** Testing only on Unix systems
+
+So far, we have been able to fulfill our requirements just by assigning
+the right values to variables and relying on the =bytecode= and =native=
+tests ocaml runs by default. There are however situations where this is
+not enough and where one needs the ability to run other tests. One
+example of such a situation is when a test needs to be performed only on
+one given operating system, e.g. because it uses a feature which is
+present only on that operating system. On an other operating system, the
+test should be skipped because it is irrelevant. To illustrate this,
+here is how our original =hello.ml= test program should be annotated so
+that it is run only on Unix platforms:
+
+#+begin_src
+(* TEST
+:* unix
+:** bytecode
+:** native
+*)
+#+end_src
+
+As can be understood from this example, lines starting with an asterisk
+describe which tests should be executed. In addition, the number of
+asterisks allows to specify the nesting level of each test or action.
+Here for instance, =bytecode= and =native= are sub-tests that will be
+run only if the =unix= test passes and will not be started if it fails
+or skips.
+
+This way of describing the dependencies between tests has been inspired
+by the syntax of org-mode. Each line starting with asterisks (thus lines
+specifying which tests to run) can also be seen as a title. The whole
+set of lines is like the outline of the test scenario.
+
+With this information in mind, it can be seen that the smallest test
+block
+: (* TEST *)
+is actually equivalent to
+#+begin_src
+(* TEST
+:* bytecode
+:* native
+*)
+#+end_src
+
+One common error when designing tests is to believe that a block like
+#+begin_src
+(* TEST
+:* unix
+*)
+#+end_src
+means to execute the =unix= test that verifies that the OS is indeed
+Unix and then to execute the default tests. This is actually not the
+case. The only situation in which the default tests are considered is
+when the test block contains absolutely no line starting with an
+asterisk. As soon as there is a line starting with an asterisk, the
+default tests are ignored completely and one needs to be totally
+explicit about which tests to run. So the correct way to write the
+erroneous block above is the use shown at the beginning of this section,
+namely:
+#+begin_src
+(* TEST
+:* unix
+:** bytecode
+:** native
+*)
+#+end_src
+
+The fact that the language is inspired by org-mode should also be
+helpful in understanding the scope of variable assignments. Roughly
+speaking:
+
+1. Variables defined at the root level are visible by all the tests and
+   sub-tests that follow their assignment.
+
+2. If a variable is defined just below a test line, then it is visible
+   by that test and all its sub-tests (unless its definition is
+   overridden) but not by tests at a nesting level whose depth is less or
+   equal than the one of the test in which the variable is defined.
+
+For instance, given the following block:
+#+begin_src
+(* TEST
+foo = "abc"
+:* test1
+bar = "def"
+:** subtest1
+baz = "hij"
+:** subtest2
+:* test2
+*)
+#+end_src
+- The definition of =foo= is visible in all the tests
+
+- The definition of =bar= is visible in all the tests except =test2=.
+
+- The definition of =baz= is visible only in =subtest1=.
+
+** Other useful tests
+
+This section introduces three tests provided by =ocamltest= and that can
+be of particular interest. A complete list of available tests and
+actions and their detailed descriptions are given in chapters
+[[#builtins]] and [[#ocaml-specific]].
+
+*** Testing the top-level: the =toplevel= and =expect= tests
+
+Two tests are provided to make sure that the OCaml top-level behaves as
+expected: =toplevel= and =expect=. These tests are similar in that they
+both allow to test how the OCaml top-level reacts to some user input,
+but they are different in the way one specifies the expected output and
+also in what they can test. The =toplevel= test behaves in a spirit
+similar to the compiler tests described above, meaning that the expected
+output has to be stored in its own, separate file. Since this test
+invokes the real OCaml top-level, it is useful to test advanced features
+like the behavior of the top-level when its input is a file rather than
+a terminal, or similar things. In the expect test, on the contrary,
+the input and the output it is expected to produce can be written in
+the same file, close to each other. However, this test uses the OCaml
+top-level as a library, rather than calling it as an external program.
+So this test is actually not testing the complete real OCaml top-level,
+but for testing language features it remains perfectly valid and is
+actually what is needed in most of the cases. We thus give below an
+example of an expect test and will describe the =toplevel= test in
+chapter [[#ocaml-specific]].
+
+So, here is a toy example of an =expect= test:
+
+#+begin_src
+(* TEST
+:* expect
+*)
+
+type point = { x : int; y : int };;
+[%%expect{|
+type point = { x : int; y : int; }
+|}];;
+#+end_src
+
+The first line after the test block is the input phrase, while the line
+that appears between =[%%expect{|= and =|}];;= is the corresponding
+expected output. The =expect= test can also be used to test the output
+in presence of the =-principal= command-line flag. In such cases, the
+expected output should be written in a =|}, Principal{|= block (to be
+improved).
+
+*** The =script= test
+
+It may happen that a needed test is not provided by ocamltest. Of
+course, if it turns out that this test would be helpful to test several
+source files, then the best solution is to add it to ocamltest itself.
+Some tests are however so specific that it is easier to write them as
+shell scripts. Such tests can be run by the =script= test, their name
+being defined by the =script= variable. In this case, the script is run
+in an environment where all the variables defined in ocamltest have been
+exported. The script uses its exit status to report its result and can
+write a response to a dedicated file to modify its environment or
+explain why it failed or skipped, as will be explained in chapter
+[[#builtins]]. For the moment, let's see how to use a script to "test" our
+original =hello.ml= example. Our annotated program would look as
+follows:
+
+#+begin_src
+(* TEST
+script = "${test_source_directory}/faketest.sh"
+:* script
+*)
+
+let _ = print_endline "Hello, world!"
+#+end_src
+
+And here is =faketest.sh=, make sure it is executable:
+
+#+begin_src
+#!/bin/sh
+exit ${TEST_PASS}
+#+end_src
+
+This should be enough for the following command to work:
+: ocamltest hello.ml
+
+This of course tests nothing and a real test script should actually do
+something before returning its result. Let's however see how we can
+make the script test fail gracefully:
+
+#+begin_src
+#!/bin/sh
+echo Why should this pass in the first place > ${ocamltest_response}
+exit ${TEST_FAIL}
+#+end_src
+
+Running ocamltest on our =hello.ml= program again produces the following
+output:
+#+begin_src
+ ... testing 'hello.ml' with 1 (script) => failed (Why should this pass in the first place)
+#+end_src
+
+* Key concepts
+  :PROPERTIES:
+  :CUSTOM_ID: concepts
+  :END:
+
+** Actions, hooks and tests
+
+** Semantics of a test block
+
+** Variables, environments and how they are inherited
+
+** Environment modifiers
+
+* Built-in actions and tests
+  :PROPERTIES:
+  :CUSTOM_ID: builtins
+  :END:
+
+* OCaml-specific actions and tests
+  :PROPERTIES:
+  :CUSTOM_ID: ocaml-specific
+  :END:
+
+# Things to document (requested by Leo on caml-devel)
+# - the syntax of the DSL
+# - the precise meaning of the stars
+# - a clear definition of what "test" means in the context of the DSL
+# - a list of the builtin "actions"
+# - a list of which "actions" depend on which "variables"
+# - what does "include" do?
+# - what is the scoping of variables?
+
+# LocalWords: ocamltest OCaml DSL extensibility makefiles
+
+# Local Variables:
+# ispell-local-dictionary: "english"
+# End:
diff --git a/ocamltest/ocamltest_config.ml.in b/ocamltest/ocamltest_config.ml.in
new file mode 100644
index 00000000..b42f9230
--- /dev/null
+++ b/ocamltest/ocamltest_config.ml.in
@@ -0,0 +1,84 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The configuration module for ocamltest *)
+
+let arch = "@@ARCH@@"
+
+let afl_instrument = @@AFL_INSTRUMENT@@
+
+let asm = "@@ASM@@"
+
+let cc = "@@CC@@"
+
+let cflags = "@@CFLAGS@@"
+
+let ccomptype = "@@CCOMPTYPE@@"
+
+let shared_libraries = @@SHARED_LIBRARIES@@
+
+let libunix = @@UNIX@@
+
+let systhreads = @@SYSTHREADS@@
+
+let str = @@STR@@
+
+let objext = "@@OBJEXT@@"
+
+let asmext = "@@ASMEXT@@"
+
+let system = "@@SYSTEM@@"
+
+let c_preprocessor = "@@CPP@@"
+
+let ocamlsrcdir = "@@OCAMLSRCDIR@@"
+
+let flambda = @@FLAMBDA@@
+
+let spacetime = @@SPACETIME@@
+
+let ocamlc_default_flags = "@@OCAMLCDEFAULTFLAGS@@"
+let ocamlopt_default_flags = "@@OCAMLOPTDEFAULTFLAGS@@"
+
+let safe_string = @@FORCE_SAFE_STRING@@
+
+let flat_float_array = @@FLAT_FLOAT_ARRAY@@
+
+let ocamldoc = @@OCAMLDOC@@
+
+let ocamldebug = @@OCAMLDEBUG@@
+
+let native_dynlink = @@NATIVE_DYNLINK@@
+
+let shared_library_cflags = "@@SHARED_LIBRARY_CFLAGS@@"
+
+let sharedobjext = "@@SHAREDOBJEXT@@"
+
+let csc = "@@CSC@@"
+
+let csc_flags = "@@CSCFLAGS@@"
+
+let mkdll = "@@MKDLL@@"
+let mkexe = "@@MKEXE@@"
+
+let bytecc_libs = "@@BYTECCLIBS@@"
+
+let nativecc_libs = "@@NATIVECCLIBS@@"
+
+let windows_unicode = @@WINDOWS_UNICODE@@ != 0
+
+let function_sections = @@FUNCTION_SECTIONS@@
+
+let has_instrumented_runtime = @@RUNTIMEI@@
diff --git a/ocamltest/ocamltest_config.mli b/ocamltest/ocamltest_config.mli
new file mode 100644
index 00000000..a03c6b68
--- /dev/null
+++ b/ocamltest/ocamltest_config.mli
@@ -0,0 +1,117 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Interface for ocamltest's configuration module *)
+
+val arch : string
+(** Architecture for the native compiler, "none" if it is disabled *)
+
+val afl_instrument : bool
+(** Whether AFL support has been enabled in the compiler *)
+
+val asm : string
+(** Path to the assembler*)
+
+val cc : string
+(** Path to the C compiler*)
+
+val cflags : string
+(** Flags to pass to the C compiler *)
+
+val ccomptype : string
+(** Type of C compiler (msvc, cc, etc.) *)
+
+val shared_libraries : bool
+(** [true] if shared libraries are supported, [false] otherwise *)
+
+val libunix : bool option
+(** [Some true] for unix, [Some false] for win32unix, or [None] if neither is
+    built. *)
+
+val systhreads : bool
+(** Indicates whether systhreads is available. *)
+
+val str : bool
+(** Indicates whether str is available. *)
+
+val objext : string
+(** Extension of object files *)
+
+val asmext : string
+(** Extension of assembly files *)
+
+val system : string
+(** The content of the SYSTEM Make variable *)
+
+val c_preprocessor : string
+(** Command to use to invoke the C preprocessor *)
+
+val ocamlc_default_flags : string
+(** Flags passed by default to ocamlc.byte and ocamlc.opt *)
+
+val ocamlopt_default_flags : string
+(** Flags passed by default to ocamlopt.byte and ocamlopt.opt *)
+
+val ocamlsrcdir : string
+(** The absolute path of the directory containing the sources of OCaml *)
+
+val flambda : bool
+(** Whether flambda has been enabled at configure time *)
+
+val spacetime : bool
+(** Whether Spacetime profiling has been enabled at configure time *)
+
+val safe_string : bool
+(** Whether the compiler was configured with -safe-string *)
+
+val flat_float_array : bool
+(* Whether the compiler was configured with -flat-float-array *)
+
+val ocamldoc : bool
+(** Whether ocamldoc has been enabled at configure time *)
+
+val ocamldebug : bool
+(** Whether ocamldebug has been enabled at configure time *)
+
+val native_dynlink : bool
+(** Whether support for native dynlink is available or not *)
+
+val shared_library_cflags : string
+(** Flags to use when compiling a C object for a shared library *)
+
+val sharedobjext : string
+(** Extension of shared object files *)
+
+val csc : string
+(** Path of the CSharp compiler, empty if not available *)
+
+val csc_flags : string
+(** Flags for the CSharp compiler *)
+
+val mkdll : string
+val mkexe : string
+
+val bytecc_libs : string
+
+val nativecc_libs : string
+
+val windows_unicode : bool
+
+val function_sections : bool
+(** Whether the compiler was configured to generate
+    each function in a separate section *)
+
+val has_instrumented_runtime : bool
+(** Whether the instrumented runtime is available *)
diff --git a/ocamltest/ocamltest_stdlib.ml b/ocamltest/ocamltest_stdlib.ml
new file mode 100644
index 00000000..3b550101
--- /dev/null
+++ b/ocamltest/ocamltest_stdlib.ml
@@ -0,0 +1,176 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* A few extensions to OCaml's standard library *)
+
+(* Pervaisive *)
+
+let input_line_opt ic =
+  try Some (input_line ic) with End_of_file -> None
+
+module Char = struct
+  include Char
+  let is_blank c =
+    c = ' ' || c = '\012' || c = '\n' || c = '\r' || c =  '\t'
+end
+
+module Filename = struct
+  include Filename
+  let path_sep = if Sys.os_type="Win32" then ";" else ":"
+  (* This function comes from otherlibs/win32unix/unix.ml *)
+  let maybe_quote f =
+    if String.contains f ' ' ||
+      String.contains f '\"' ||
+      String.contains f '\t' ||
+       f = ""
+    then Filename.quote f
+    else f
+
+  let make_filename name ext = String.concat "." [name; ext]
+
+  let make_path components = List.fold_left Filename.concat "" components
+
+  let mkexe =
+    if Sys.os_type="Win32"
+    then fun name -> make_filename name "exe"
+    else fun name -> name
+end
+
+module List = struct
+  include List
+  let rec concatmap f = function
+    | [] -> []
+    | x::xs -> (f x) @ (concatmap f xs)
+end
+
+module String = struct
+  include Misc.Stdlib.String
+  let string_of_char = String.make 1
+
+  let words s =
+    let l = String.length s in
+    let rec f quote w ws i =
+      if i>=l then begin
+        if w<>"" then List.rev (w::ws)
+        else List.rev ws
+      end else begin
+        let j = i+1 in
+        match s.[i] with
+          | '\'' -> f (not quote) w ws j
+          | ' ' ->
+            begin
+              if quote
+              then f true (w ^ (string_of_char ' ')) ws j
+              else begin
+                if w=""
+                then f false w ws j
+                else f false "" (w::ws) j
+              end
+            end
+          | _ as c -> f quote (w ^ (string_of_char c)) ws j
+      end in
+    if l=0 then [] else f false "" [] 0
+end
+
+module Sys = struct
+  include Sys
+
+  let file_is_empty filename =
+    let ic = open_in filename in
+    let filesize = in_channel_length ic in
+    close_in ic;
+    filesize = 0
+
+  let run_system_command command = match Sys.command command with
+    | 0 -> ()
+    | _ as exitcode ->
+      Printf.eprintf "Sysem command %s failed with status %d\n%!"
+        command exitcode;
+      exit 3
+
+  let mkdir dir =
+    if not (Sys.file_exists dir) then
+      run_system_command (Filename.quote_command "mkdir" [dir])
+
+  let rec make_directory dir =
+    if Sys.file_exists dir then ()
+    else (make_directory (Filename.dirname dir); mkdir dir)
+
+  let string_of_file filename =
+    let chan = open_in_bin filename in
+    let filesize = in_channel_length chan in
+    if filesize > Sys.max_string_length then
+    begin
+      close_in chan;
+      failwith
+        ("The file " ^ filename ^ " is too large to be loaded into a string")
+    end else begin
+      let result =
+        try really_input_string chan filesize
+        with End_of_file ->
+          close_in chan;
+          failwith ("Got unexpected end of file while reading " ^ filename) in
+      close_in chan;
+      result
+    end
+
+  let with_input_file ?(bin=false) x f =
+    let ic = (if bin then open_in_bin else open_in) x in
+    try let res = f ic in close_in ic; res with e -> (close_in ic; raise e)
+
+  let with_output_file ?(bin=false) x f =
+    let oc = (if bin then open_out_bin else open_out) x in
+    try let res = f oc in close_out oc; res with e -> (close_out oc; raise e)
+
+  let copy_chan ic oc =
+    let m = in_channel_length ic in
+    let m = (m lsr 12) lsl 12 in
+    let m = max 16384 (min Sys.max_string_length m) in
+    let buf = Bytes.create m in
+    let rec loop () =
+      let len = input ic buf 0 m in
+      if len > 0 then begin
+        output oc buf 0 len;
+        loop ()
+      end
+    in loop ()
+
+  let copy_file src dest =
+    with_input_file ~bin:true src begin fun ic ->
+      with_output_file ~bin:true dest begin fun oc ->
+        copy_chan ic oc
+      end
+    end
+
+  let force_remove file =
+    if file_exists file then remove file
+
+  external has_symlink : unit -> bool = "caml_has_symlink"
+
+  let with_chdir path f =
+    let oldcwd = Sys.getcwd () in
+    Sys.chdir path;
+    match f () with
+    | r ->
+        Sys.chdir oldcwd;
+        r
+    | exception e ->
+        Sys.chdir oldcwd;
+        raise e
+
+  let getenv_with_default_value variable default_value =
+    try Sys.getenv variable with Not_found -> default_value
+  let safe_getenv variable = getenv_with_default_value variable ""
+end
diff --git a/ocamltest/ocamltest_stdlib.mli b/ocamltest/ocamltest_stdlib.mli
new file mode 100644
index 00000000..d74fc2c2
--- /dev/null
+++ b/ocamltest/ocamltest_stdlib.mli
@@ -0,0 +1,59 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* A few extensions to OCaml's standard library *)
+
+(* Pervasive *)
+
+val input_line_opt : in_channel -> string option
+
+module Char : sig
+  include module type of Char
+  val is_blank : char -> bool
+end
+
+module Filename  : sig
+  include module type of Filename
+  val path_sep : string
+  val maybe_quote : string -> string
+  val make_filename : string -> string -> string
+  val make_path : string list -> string
+  val mkexe : string -> string
+end
+
+module List : sig
+  include module type of List
+  val concatmap : ('a -> 'b list) -> 'a list -> 'b list
+end
+
+module String : sig
+  include module type of Misc.Stdlib.String
+  val words : string -> string list
+end
+
+module Sys : sig
+  include module type of Sys
+  val file_is_empty : string -> bool
+  val run_system_command : string -> unit
+  val make_directory : string -> unit
+  val string_of_file : string -> string
+  val copy_chan : in_channel -> out_channel -> unit
+  val copy_file : string -> string -> unit
+  val force_remove : string -> unit
+  val has_symlink : unit -> bool
+  val with_chdir : string -> (unit -> 'a) -> 'a
+  val getenv_with_default_value : string -> string -> string
+  val safe_getenv : string -> string
+end
diff --git a/ocamltest/ocamltest_stdlib_stubs.c b/ocamltest/ocamltest_stdlib_stubs.c
new file mode 100644
index 00000000..18f4f519
--- /dev/null
+++ b/ocamltest/ocamltest_stdlib_stubs.c
@@ -0,0 +1,116 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Sebastien Hinderer, projet Gallium, INRIA Paris            */
+/*                                                                        */
+/*   Copyright 2018 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Stubs for ocamltest's standard library */
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <caml/config.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+/*
+#include <caml/fail.h>
+*/
+#include <caml/signals.h>
+#include <caml/osdeps.h>
+
+
+#ifdef _WIN32
+
+/*
+ * Windows Vista functions enabled
+ */
+#undef _WIN32_WINNT
+#define _WIN32_WINNT 0x0600
+
+#include <wtypes.h>
+#include <winbase.h>
+#include <process.h>
+#include <sys/types.h>
+
+#define luid_eq(l, r) (l.LowPart == r.LowPart && l.HighPart == r.HighPart)
+
+CAMLprim value caml_has_symlink(value unit)
+{
+  CAMLparam1(unit);
+  HANDLE hProcess = GetCurrentProcess();
+  BOOL result = FALSE;
+
+  if (OpenProcessToken(hProcess, TOKEN_READ, &hProcess)) {
+    LUID seCreateSymbolicLinkPrivilege;
+
+    if (LookupPrivilegeValue(NULL,
+                             SE_CREATE_SYMBOLIC_LINK_NAME,
+                             &seCreateSymbolicLinkPrivilege)) {
+      DWORD length;
+
+      if (!GetTokenInformation(hProcess, TokenPrivileges, NULL, 0, &length)) {
+        if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) {
+          TOKEN_PRIVILEGES* privileges =
+            (TOKEN_PRIVILEGES*)caml_stat_alloc(length);
+          if (GetTokenInformation(hProcess,
+                                  TokenPrivileges,
+                                  privileges,
+                                  length,
+                                  &length)) {
+            DWORD count = privileges->PrivilegeCount;
+
+            if (count) {
+              LUID_AND_ATTRIBUTES* privs = privileges->Privileges;
+              while (count-- &&
+                     !(result = luid_eq(privs->Luid,
+                                        seCreateSymbolicLinkPrivilege)))
+                privs++;
+            }
+          }
+
+          caml_stat_free(privileges);
+        }
+      }
+    }
+
+    CloseHandle(hProcess);
+  }
+
+  CAMLreturn(Val_bool(result));
+}
+
+
+#else /* _WIN32 */
+
+#ifdef HAS_SYMLINK
+
+CAMLprim value caml_has_symlink(value unit)
+{
+  CAMLparam0();
+  CAMLreturn(Val_true);
+}
+
+#else /* HAS_SYMLINK */
+
+CAMLprim value unix_symlink(value to_dir, value path1, value path2)
+{ caml_invalid_argument("symlink not implemented"); }
+
+CAMLprim value caml_has_symlink(value unit)
+{
+  CAMLparam0();
+  CAMLreturn(Val_false);
+}
+
+#endif
+
+#endif /* _WIN32 */
diff --git a/ocamltest/options.ml b/ocamltest/options.ml
new file mode 100644
index 00000000..60bcdeb7
--- /dev/null
+++ b/ocamltest/options.ml
@@ -0,0 +1,82 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Description of ocamltest's command-line options *)
+
+let show_objects title string_of_object objects =
+  let print_object o = print_endline ("  " ^ (string_of_object o)) in
+  print_endline title;
+  List.iter print_object objects;
+  exit 0
+
+let string_of_action = Actions.name
+
+let string_of_test test =
+  if test.Tests.test_run_by_default
+  then (test.Tests.test_name ^ " (run by default)")
+  else test.Tests.test_name
+
+let string_of_variable v =
+  Printf.sprintf "%s: %s"
+    (Variables.name_of_variable v)
+    (Variables.description_of_variable v)
+
+let show_actions () =
+  let actions = Actions.get_registered_actions () in
+  show_objects "Available actions are:" string_of_action actions
+
+let show_tests () =
+  let tests = Tests.get_registered_tests () in
+  show_objects "Available tests are:" string_of_test tests
+
+let show_variables () =
+  let variables = Variables.get_registered_variables () in
+  show_objects "Available variables are:" string_of_variable variables
+
+let log_to_stderr = ref false
+
+let promote = ref false
+
+let keep_test_dir_on_success = ref false
+
+let find_test_dirs = ref []
+
+let list_tests = ref []
+
+let add_to_list r x =
+  r := !r @ [x]
+
+let commandline_options =
+[
+  ("-e", Arg.Set log_to_stderr, " Log to stderr instead of a file.");
+  ("-promote", Arg.Set promote,
+   " Overwrite reference files with the test output (experimental, unstable)");
+  ("-show-actions", Arg.Unit show_actions, " Show available actions.");
+  ("-show-tests", Arg.Unit show_tests, " Show available tests.");
+  ("-show-variables", Arg.Unit show_variables, " Show available variables.");
+  ("-find-test-dirs", Arg.String (add_to_list find_test_dirs),
+   " Find directories that contain tests (recursive).");
+  ("-list-tests", Arg.String (add_to_list list_tests),
+   " List tests in given directory.");
+  ("-keep-test-dir-on-success", Arg.Set keep_test_dir_on_success,
+   " Keep the test directory (with the generated test artefacts) on success.");
+]
+
+let files_to_test = ref []
+
+let usage = "Usage: " ^ Sys.argv.(0) ^ " options files to test"
+
+let _ =
+  Arg.parse (Arg.align commandline_options) (add_to_list files_to_test) usage
diff --git a/ocamltest/options.mli b/ocamltest/options.mli
new file mode 100644
index 00000000..2047f60a
--- /dev/null
+++ b/ocamltest/options.mli
@@ -0,0 +1,30 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Description of ocamltest's command-line options *)
+
+val log_to_stderr : bool ref
+
+val files_to_test : string list ref
+
+val promote : bool ref
+
+val usage : string
+
+val find_test_dirs : string list ref
+
+val list_tests : string list ref
+
+val keep_test_dir_on_success : bool ref
diff --git a/ocamltest/result.ml b/ocamltest/result.ml
new file mode 100644
index 00000000..9e2b932f
--- /dev/null
+++ b/ocamltest/result.ml
@@ -0,0 +1,57 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of test-result related types and functions *)
+
+type status = Pass | Skip | Fail
+
+type t = {
+  status : status;
+  reason : string option
+}
+
+let result_of_status s = { status = s; reason = None }
+
+let pass = result_of_status Pass
+
+let skip = result_of_status Skip
+
+let fail = result_of_status Fail
+
+let result_with_reason s r = { status = s; reason = Some r }
+
+let pass_with_reason r = result_with_reason Pass r
+
+let skip_with_reason r = result_with_reason Skip r
+
+let fail_with_reason r = result_with_reason Fail r
+
+let string_of_status = function
+  | Pass -> "passed"
+  | Skip -> "skipped"
+  | Fail -> "failed"
+
+let string_of_reason = function
+  | None -> ""
+  | Some reason -> (" (" ^ reason ^ ")")
+
+let string_of_result r =
+  (string_of_status r.status) ^ (string_of_reason r.reason)
+
+let is_pass r = r.status = Pass
+
+let is_skip r = r.status = Skip
+
+let is_fail r = r.status = Fail
diff --git a/ocamltest/result.mli b/ocamltest/result.mli
new file mode 100644
index 00000000..2369e5f6
--- /dev/null
+++ b/ocamltest/result.mli
@@ -0,0 +1,43 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of test-result related types and functions *)
+
+type status = Pass | Skip | Fail
+
+type t = {
+  status : status;
+  reason : string option
+}
+
+val pass : t
+
+val skip : t
+
+val fail : t
+
+val pass_with_reason : string -> t
+
+val skip_with_reason : string -> t
+
+val fail_with_reason : string -> t
+
+val string_of_result : t -> string
+
+val is_pass : t -> bool
+
+val is_skip : t -> bool
+
+val is_fail : t -> bool
diff --git a/ocamltest/run.h b/ocamltest/run.h
new file mode 100644
index 00000000..7c13212e
--- /dev/null
+++ b/ocamltest/run.h
@@ -0,0 +1,44 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Sebastien Hinderer, projet Gallium, INRIA Paris            */
+/*                                                                        */
+/*   Copyright 2016 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Header file for the run library */
+
+#ifndef __RUN_H__
+
+#define __RUN_H__
+
+#include <stdarg.h>
+#include <caml/misc.h>
+
+typedef char_os **array;
+
+typedef void Logger(void *, const char *, va_list ap);
+
+typedef struct {
+  char_os *program;
+  array argv;
+  array envp;
+  char_os *stdin_filename;
+  char_os *stdout_filename;
+  char_os *stderr_filename;
+  int append;
+  int timeout;
+  Logger *logger;
+  void *loggerData;
+} command_settings;
+
+extern int run_command(const command_settings *settings);
+
+#endif /* __RUN_H__ */
diff --git a/ocamltest/run_command.ml b/ocamltest/run_command.ml
new file mode 100644
index 00000000..1a1df614
--- /dev/null
+++ b/ocamltest/run_command.ml
@@ -0,0 +1,52 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Run programs and log their stdout/stderr, with a timer... *)
+
+open Ocamltest_stdlib
+
+type settings = {
+  progname : string;
+  argv : string array;
+  envp : string array;
+  stdin_filename : string;
+  stdout_filename : string;
+  stderr_filename : string;
+  append : bool;
+  timeout : int;
+  log : out_channel;
+}
+
+let settings_of_commandline ?(stdout_fname="") ?(stderr_fname="") commandline =
+  let words = String.words commandline in
+  let quoted_words =
+    if Sys.os_type="Win32"
+    then List.map Filename.maybe_quote words
+    else words in
+  {
+    progname = List.hd quoted_words;
+    argv = Array.of_list quoted_words;
+    envp = [||];
+    stdin_filename = "";
+    stdout_filename = stdout_fname;
+    stderr_filename = stderr_fname;
+    append = false;
+    timeout = 0;
+    log = stderr
+  }
+
+external run : settings -> int = "caml_run_command"
+
+let run_commandline commandline = run (settings_of_commandline commandline)
diff --git a/ocamltest/run_command.mli b/ocamltest/run_command.mli
new file mode 100644
index 00000000..30033ce3
--- /dev/null
+++ b/ocamltest/run_command.mli
@@ -0,0 +1,37 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Run programs and log their stdout/stderr, with a timer... *)
+
+type settings = {
+  progname : string;
+  argv : string array;
+  envp : string array;
+  stdin_filename : string;
+  stdout_filename : string;
+  stderr_filename : string;
+  append : bool;
+  timeout : int;
+  log : out_channel;
+}
+
+val settings_of_commandline :
+  ?stdout_fname:string ->
+  ?stderr_fname:string ->
+  string -> settings
+
+val run : settings -> int
+
+val run_commandline : string -> int
diff --git a/ocamltest/run_common.h b/ocamltest/run_common.h
new file mode 100644
index 00000000..fdedd86c
--- /dev/null
+++ b/ocamltest/run_common.h
@@ -0,0 +1,59 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Sebastien Hinderer, projet Gallium, INRIA Paris            */
+/*                                                                        */
+/*   Copyright 2016 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Private definitions shared by both Unix and Windows process runners */
+
+#ifndef __RUN_COMMON_H__
+#define __RUN_COMMON_H__
+
+/* is_defined(str) returns 1 iff str points to a non-empty string */
+/* Otherwise returns 0 */
+static int is_defined(const char_os *str)
+{
+  return (str != NULL) && (*str != 0);
+}
+
+static void defaultLogger(void *where, const char *format, va_list ap)
+{
+  vfprintf(stderr, format, ap);
+}
+
+static void mylog(Logger *logger, void *loggerData, char *fmt, ...)
+{
+  va_list ap;
+  va_start(ap, fmt);
+  logger(loggerData, fmt, ap);
+  va_end(ap);
+}
+
+static void error_with_location(
+  const char *file, int line,
+  const command_settings *settings,
+  const char *msg, ...)
+{
+  va_list ap;
+  Logger *logger = (settings->logger != NULL) ? settings->logger
+                                              : defaultLogger;
+  void *loggerData = settings->loggerData;
+  va_start(ap, msg);
+  mylog(logger, loggerData, "%s:%d: ", file, line);
+  logger(loggerData, msg, ap);
+  mylog(logger, loggerData, "\n");
+  va_end(ap);
+}
+
+
+
+#endif /* __RUN_COMMON_H__ */
diff --git a/ocamltest/run_stubs.c b/ocamltest/run_stubs.c
new file mode 100644
index 00000000..2f89e83d
--- /dev/null
+++ b/ocamltest/run_stubs.c
@@ -0,0 +1,108 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Sebastien Hinderer, projet Gallium, INRIA Paris            */
+/*                                                                        */
+/*   Copyright 2016 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Stubs to let OCaml programs use the run library */
+
+#define _GNU_SOURCE
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <sys/types.h>
+#include <string.h>
+
+#include "run.h"
+
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+#include "caml/io.h"
+#include "caml/osdeps.h"
+
+/* cstringvect: inspired by similar function in otherlibs/unix/cstringv.c */
+static array cstringvect(value arg)
+{
+  array res;
+  mlsize_t size, i;
+
+  size = Wosize_val(arg);
+  res = (array) caml_stat_alloc((size + 1) * sizeof(char_os *));
+  for (i = 0; i < size; i++)
+    res[i] = caml_stat_strdup_to_os(String_val(Field(arg, i)));
+  res[size] = NULL;
+  return res;
+}
+
+static void free_cstringvect(array v)
+{
+  char_os **p;
+  for (p = v; *p != NULL; p++)
+    caml_stat_free(*p);
+  caml_stat_free(v);
+}
+
+static void logToChannel(void *voidchannel, const char *fmt, va_list ap)
+{
+  struct channel *channel = (struct channel *) voidchannel;
+  int length, initialTextLength = 512;
+  char *text = malloc(512);
+  if (text == NULL) return;
+  length = vsnprintf(text, initialTextLength, fmt, ap);
+  if (length <= 0)
+  {
+    free(text);
+    return;
+  }
+  if (length > initialTextLength)
+  {
+    free(text);
+    text = malloc(length);
+    if (text == NULL) return;
+    if (vsnprintf(text, length, fmt, ap) != length) goto end;
+  }
+  caml_putblock(channel, text, length);
+  caml_flush(channel);
+end:
+  free(text);
+}
+
+CAMLprim value caml_run_command(value caml_settings)
+{
+  int res;
+  command_settings settings;
+
+  CAMLparam1(caml_settings);
+  settings.program =
+    caml_stat_strdup_to_os(String_val(Field(caml_settings, 0)));
+  settings.argv = cstringvect(Field(caml_settings, 1));
+  settings.envp = cstringvect(Field(caml_settings, 2));
+  settings.stdin_filename =
+    caml_stat_strdup_to_os(String_val(Field(caml_settings, 3)));
+  settings.stdout_filename =
+    caml_stat_strdup_to_os(String_val(Field(caml_settings, 4)));
+  settings.stderr_filename =
+    caml_stat_strdup_to_os(String_val(Field(caml_settings, 5)));
+  settings.append = Bool_val(Field(caml_settings, 6));
+  settings.timeout = Int_val(Field(caml_settings, 7));
+  settings.logger = logToChannel;
+  settings.loggerData = Channel(Field(caml_settings, 8));
+  res = run_command(&settings);
+  caml_stat_free(settings.program);
+  free_cstringvect(settings.argv);
+  free_cstringvect(settings.envp);
+  caml_stat_free(settings.stdin_filename);
+  caml_stat_free(settings.stdout_filename);
+  caml_stat_free(settings.stderr_filename);
+  CAMLreturn(Val_int(res));
+}
diff --git a/ocamltest/run_unix.c b/ocamltest/run_unix.c
new file mode 100644
index 00000000..2cfd6868
--- /dev/null
+++ b/ocamltest/run_unix.c
@@ -0,0 +1,349 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Sebastien Hinderer, projet Gallium, INRIA Paris            */
+/*                                                                        */
+/*   Copyright 2016 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Run programs with rediretions and timeouts under Unix */
+
+#include <stdio.h>
+#include <limits.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include <sys/wait.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <string.h>
+#include <errno.h>
+#include <stdarg.h>
+#include <signal.h>
+
+#include "run.h"
+#include "run_common.h"
+
+#define COREFILENAME "core"
+
+static volatile int timeout_expired = 0;
+
+#define error(msg, ...) \
+error_with_location(__FILE__, __LINE__, settings, msg, ## __VA_ARGS__)
+
+/*
+  Note: the ## __VA_ARGS__ construct is gcc specific.
+  For a more portable (but also more complex) solution, see
+  http://stackoverflow.com/questions/20818800/variadic-macro-and-trailing-comma
+*/
+
+static void myperror_with_location(
+  const char *file, int line,
+  const command_settings *settings,
+  const char *msg, ...)
+{
+  va_list ap;
+  Logger *logger = (settings->logger != NULL) ? settings->logger
+                                              : defaultLogger;
+  void *loggerData = settings->loggerData;
+  va_start(ap, msg);
+  mylog(logger, loggerData, "%s:%d: ", file, line);
+  logger(loggerData, msg, ap);
+  mylog(logger, loggerData, ": %s\n", strerror(errno));
+  va_end(ap);
+}
+
+#define myperror(msg, ...) \
+myperror_with_location(__FILE__, __LINE__, settings, msg, ## __VA_ARGS__)
+
+/* Same remark as for the error macro. */
+
+#define child_error(msg, ...) \
+  myperror(msg, ## __VA_ARGS__); \
+  goto child_failed;
+
+static void open_error_with_location(
+  const char *file, int line,
+  const command_settings *settings,
+  const char *msg)
+{
+  myperror_with_location(file, line, settings, "Can not open %s", msg);
+}
+
+#define open_error(filename) \
+open_error_with_location(__FILE__, __LINE__, settings, filename)
+
+static void realpath_error_with_location(
+  const char *file, int line,
+  const command_settings *settings,
+  const char *msg)
+{
+  myperror_with_location(file, line, settings, "realpath(\"%s\") failed", msg);
+}
+
+#define realpath_error(filename) \
+realpath_error_with_location(__FILE__, __LINE__, settings, filename)
+
+static void handle_alarm(int sig)
+{
+  timeout_expired = 1;
+}
+
+static int paths_same_file(
+  const command_settings *settings, const char * path1, const char * path2)
+{
+  int same_file = 0;
+#ifdef __GLIBC__
+  char *realpath1, *realpath2;
+  realpath1 = realpath(path1, NULL);
+  if (realpath1 == NULL)
+    realpath_error(path1);
+  realpath2 = realpath(path2, NULL);
+  if (realpath2 == NULL)
+  {
+    free(realpath1);
+    if (errno == ENOENT) return 0;
+    else realpath_error(path2);
+  }
+#else
+  char realpath1[PATH_MAX], realpath2[PATH_MAX];
+  if (realpath(path1, realpath1) == NULL)
+    realpath_error(path1);
+    if (realpath(path2, realpath2) == NULL)
+    {
+      if (errno == ENOENT) return 0;
+      else realpath_error(path2);
+    }
+#endif /* __GLIBC__ */
+  if (strcmp(realpath1, realpath2) == 0)
+    same_file = 1;
+#ifdef __GLIBC__
+  free(realpath1);
+  free(realpath2);
+#endif /* __GLIBC__ */
+  return same_file;
+}
+
+static void update_environment(array local_env)
+{
+  array envp;
+  for (envp = local_env; *envp != NULL; envp++) {
+    char *pos_eq = strchr(*envp, '=');
+    if (pos_eq != NULL) {
+      char *name, *value;
+      int name_length = pos_eq - *envp;
+      int l = strlen(*envp);
+      int value_length = l - (name_length +1);
+      name = malloc(name_length+1);
+      value = malloc(value_length+1);
+      memcpy(name, *envp, name_length);
+      name[name_length] = '\0';
+      memcpy(value, pos_eq + 1, value_length);
+      value[value_length] = '\0';
+      setenv(name, value, 1); /* 1 means overwrite */
+    }
+  }
+}
+
+/*
+  This function should return an exitcode that can itself be returned
+  to its father through the exit system call.
+  So it returns 0 to report success and 1 to report an error
+
+ */
+static int run_command_child(const command_settings *settings)
+{
+  int stdin_fd = -1, stdout_fd = -1, stderr_fd = -1; /* -1 = no redir */
+  int inputFlags = O_RDONLY;
+  int outputFlags =
+    O_CREAT | O_WRONLY | (settings->append ? O_APPEND : O_TRUNC);
+  int inputMode = 0400, outputMode = 0666;
+
+  if (setpgid(0, 0) == -1)
+  {
+    child_error("setpgid");
+  }
+
+  if (is_defined(settings->stdin_filename))
+  {
+    stdin_fd = open(settings->stdin_filename, inputFlags, inputMode);
+    if (stdin_fd < 0)
+    {
+      open_error(settings->stdin_filename);
+      goto child_failed;
+    }
+    if (dup2(stdin_fd, STDIN_FILENO) == -1)
+    {
+      child_error("dup2 for stdin");
+    }
+  }
+
+  if (is_defined(settings->stdout_filename))
+  {
+    stdout_fd = open(settings->stdout_filename, outputFlags, outputMode);
+    if (stdout_fd < 0) {
+      open_error(settings->stdout_filename);
+      goto child_failed;
+    }
+    if (dup2(stdout_fd, STDOUT_FILENO) == -1)
+    {
+      child_error("dup2 for stdout");
+    }
+  }
+
+  if (is_defined(settings->stderr_filename))
+  {
+    if (stdout_fd != -1)
+    {
+      if (paths_same_file(
+        settings, settings->stdout_filename,settings->stderr_filename))
+        stderr_fd = stdout_fd;
+    }
+    if (stderr_fd == -1)
+    {
+      stderr_fd = open(settings->stderr_filename, outputFlags, outputMode);
+      if (stderr_fd == -1)
+      {
+        open_error(settings->stderr_filename);
+        goto child_failed;
+      }
+    }
+    if (dup2(stderr_fd, STDERR_FILENO) == -1)
+    {
+      child_error("dup2 for stderr");
+    }
+  }
+
+  update_environment(settings->envp);
+
+  execvp(settings->program, settings->argv);
+
+  myperror("Cannot execute %s", settings->program);
+
+child_failed:
+  return 1;
+}
+
+/* Handles the termination of a process. Arguments:
+ * The pid of the terminated process
+ * Its termination status as returned by wait(2)
+ * A string giving a prefix for the core file name.
+   (the file will be called prefix.pid.core but may come from a
+   different process)
+ * Returns the code to return if this is the child process
+ */
+static int handle_process_termination(
+  const command_settings *settings,
+  pid_t pid, int status, const char *corefilename_prefix)
+{
+  int signal, core = 0;
+  char *corestr;
+
+  if (WIFEXITED(status)) return WEXITSTATUS(status);
+
+  if ( !WIFSIGNALED(status) )
+    error("Process %lld neither terminated normally nor received a" \
+          "signal!?", (long long) pid);
+
+  /* From here we know that the process terminated due to a signal */
+  signal = WTERMSIG(status);
+#ifdef WCOREDUMP
+  core = WCOREDUMP(status);
+#endif /* WCOREDUMP */
+  corestr = core ? "" : "no ";
+  fprintf(stderr,
+    "Process %lld got signal %d(%s), %score dumped\n",
+    (long long) pid, signal, strsignal(signal), corestr
+  );
+
+  if (core)
+  {
+    if ( access(COREFILENAME, F_OK) == -1)
+      fprintf(stderr, "Could not find core file.\n");
+    else {
+      size_t corefile_len = strlen(corefilename_prefix) + 128;
+      char * corefile = malloc(corefile_len);
+      if (corefile == NULL)
+        fprintf(stderr, "Out of memory while processing core file.\n");
+      else {
+        snprintf(corefile, corefile_len,
+          "%s.%lld.core", corefilename_prefix, (long long) pid);
+        if ( rename(COREFILENAME, corefile) == -1)
+          fprintf(stderr, "The core file exists but could not be renamed.\n");
+        else
+          fprintf(stderr,"The core file has been renamed to %s\n", corefile);
+        free(corefile);
+      }
+    }
+  }
+
+  return -signal;
+}
+
+static int run_command_parent(const command_settings *settings, pid_t child_pid)
+{
+  int waiting = 1, status, code, child_code = 0;
+  pid_t pid;
+
+  if (settings->timeout>0)
+  {
+    struct sigaction action;
+    action.sa_handler = handle_alarm;
+    sigemptyset(&action.sa_mask);
+    action.sa_flags = SA_RESETHAND;
+    if (sigaction(SIGALRM, &action, NULL) == -1) myperror("sigaction");
+    if (alarm(settings->timeout) == -1) myperror("alarm");
+  }
+
+  while (waiting)
+  {
+    pid = wait(&status);
+    if (pid == -1)
+    {
+      switch (errno)
+      {
+        case EINTR:
+          if ((settings->timeout > 0) && (timeout_expired))
+          {
+            timeout_expired = 0;
+            fprintf(stderr, "Timeout expired, killing all child processes");
+            if (kill(-child_pid, SIGKILL) == -1) myperror("kill");
+          };
+          break;
+        case ECHILD:
+          waiting = 0;
+          break;
+        default:
+          myperror("wait");
+      }
+    } else { /* Got a pid */
+      code = handle_process_termination(
+        settings, pid, status, settings->program);
+      if (pid == child_pid) child_code = code;
+    }
+  }
+
+  return child_code;
+}
+
+int run_command(const command_settings *settings)
+{
+  pid_t child_pid = fork();
+
+  switch (child_pid)
+  {
+    case -1:
+      myperror("fork");
+      return -1;
+    case 0: /* child process */
+      exit( run_command_child(settings) );
+    default:
+      return run_command_parent(settings, child_pid);
+  }
+}
diff --git a/ocamltest/run_win32.c b/ocamltest/run_win32.c
new file mode 100644
index 00000000..f5353575
--- /dev/null
+++ b/ocamltest/run_win32.c
@@ -0,0 +1,412 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Sebastien Hinderer, projet Gallium, INRIA Paris            */
+/*                                                                        */
+/*   Copyright 2016 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Run programs with rediretions and timeouts under Windows */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <wtypes.h>
+#include <winbase.h>
+#include <windows.h>
+#include <process.h>
+#include <string.h>
+#include <errno.h>
+#include <stdarg.h>
+#include <sys/types.h>
+
+#include "caml/osdeps.h"
+
+#include "run.h"
+#include "run_common.h"
+
+static void report_error(
+  const char *file, int line,
+  const command_settings *settings,
+  const char *message, const WCHAR *argument)
+{
+  WCHAR windows_error_message[1024];
+  DWORD error = GetLastError();
+  char *caml_error_message, buf[256];
+  if (FormatMessage(
+    FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
+    NULL, error, 0, windows_error_message,
+    sizeof(windows_error_message)/sizeof(WCHAR), NULL) ) {
+    caml_error_message = caml_stat_strdup_of_utf16(windows_error_message);
+  } else {
+    caml_error_message = caml_stat_alloc(256);
+    sprintf(caml_error_message, "unknown Windows error #%lu", error);
+  }
+  if ( is_defined(argument) )
+    error_with_location(file, line,
+      settings, "%s %s: %s", message, argument, caml_error_message);
+  else
+    error_with_location(file, line,
+      settings, "%s: %s", message, caml_error_message);
+  caml_stat_free(caml_error_message);
+}
+
+static WCHAR *find_program(const WCHAR *program_name)
+{
+  int max_path_length = 512;
+  DWORD result;
+  LPCWSTR searchpath = NULL, extension = L".exe";
+  WCHAR **filepart = NULL;
+  WCHAR *fullpath = malloc(max_path_length*sizeof(WCHAR));
+  if (fullpath == NULL) return NULL;
+
+  result = SearchPath
+  (
+    searchpath,
+    program_name,
+    extension,
+    max_path_length,
+    fullpath,
+    filepart
+  );
+  if (result == 0)
+  {
+    /* It may be an absolute path, return a copy of it */
+    int l = wcslen(program_name) + 1;
+    free(fullpath);
+    fullpath = malloc(l*sizeof(WCHAR));
+    if (fullpath != NULL) wcscpy(fullpath, program_name);
+    return fullpath;
+  }
+  if (result <= max_path_length) return fullpath;
+
+  /* fullpath was too small, allocate a bigger one */
+  free(fullpath);
+
+  result++; /* Take '\0' into account */
+
+  fullpath = malloc(result*sizeof(WCHAR));
+  if (fullpath == NULL) return NULL;
+  SearchPath
+  (
+    searchpath,
+    program_name,
+    extension,
+    result,
+    fullpath,
+    filepart
+  );
+  return fullpath;
+}
+
+static WCHAR *commandline_of_arguments(WCHAR **arguments)
+{
+  WCHAR *commandline = NULL, **arguments_p, *commandline_p;
+  int args = 0; /* Number of arguments */
+  int commandline_length = 0;
+
+  if (*arguments == NULL) return NULL;
+  /* 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++)
+  {
+    args++;
+    commandline_length += wcslen(*arguments_p);
+  }
+  commandline_length += args; /* args-1 ' ' between arguments + final '\0' */
+
+  /* Allocate memory and accumulate arguments separated by spaces */
+  commandline = malloc(commandline_length*sizeof(WCHAR));
+  if (commandline == NULL) return NULL;
+  commandline_p = commandline;
+  for (arguments_p = arguments; *arguments_p!=NULL; arguments_p++)
+  {
+    int l = wcslen(*arguments_p);
+    memcpy(commandline_p, *arguments_p, l*sizeof(WCHAR));
+    commandline_p += l;
+    *commandline_p = L' ';
+    commandline_p++;
+  }
+  commandline[commandline_length-1] = 0;
+  return commandline;
+}
+
+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;
+
+  process_env = GetEnvironmentStrings();
+  if (process_env == NULL) return NULL;
+
+  /* Compute length of process environment */
+  process_env_length = 0;
+  p = process_env;
+  while (*p != L'\0') {
+    l = wcslen(p) + 1; /* also count terminating '\0' */
+    process_env_length += l;
+    p += l;
+  }
+
+  /* Compute length of local environment */
+  localenv_length = 0;
+  q = localenv;
+  while (*q != NULL) {
+    localenv_length += wcslen(*q) + 1;
+    q++;
+  }
+
+  /* Build new env that contains both process and local env */
+  env_length = process_env_length + localenv_length + 1;
+  env = malloc(env_length * sizeof(WCHAR));
+  if (env == NULL) {
+    FreeEnvironmentStrings(process_env);
+    return NULL;
+  }
+  r = env;
+  p = process_env;
+  while (*p != L'\0') {
+    l = wcslen(p) + 1; /* also count terminating '\0' */
+    memcpy(r, p, l * sizeof(WCHAR));
+    p += l;
+    r += l;
+  }
+  FreeEnvironmentStrings(process_env);
+  q = localenv;
+  while (*q != NULL) {
+    l = wcslen(*q) + 1;
+    memcpy(r, *q, l * sizeof(WCHAR));
+    r += l;
+    q++;
+  }
+  *r = L'\0';
+  return env;
+}
+
+static SECURITY_ATTRIBUTES security_attributes = {
+  sizeof(SECURITY_ATTRIBUTES), /* nLength */
+  NULL, /* lpSecurityDescriptor */
+  TRUE /* bInheritHandle */
+};
+
+static HANDLE create_input_handle(const WCHAR *filename)
+{
+  return CreateFile
+  (
+    filename,
+    GENERIC_READ, /* DWORD desired_access */
+    FILE_SHARE_READ, /* DWORD share_mode */
+    &security_attributes,
+    OPEN_EXISTING, /* DWORD creation_disposition */
+    FILE_ATTRIBUTE_NORMAL, /* DWORD flags_and_attributes */
+    NULL /* HANDLE template_file */
+  );
+}
+
+static HANDLE create_output_handle(const WCHAR *filename, int append)
+{
+  DWORD desired_access = append ? FILE_APPEND_DATA : GENERIC_WRITE;
+  DWORD share_mode = FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE;
+  DWORD creation_disposition = append ? OPEN_ALWAYS : CREATE_ALWAYS;
+  return CreateFile
+  (
+    filename,
+    desired_access,
+    share_mode,
+    &security_attributes,
+    creation_disposition,
+    FILE_ATTRIBUTE_NORMAL, /* DWORD flags_and_attributes */
+    NULL /* HANDLE template_file */
+  );
+}
+
+#define checkerr(condition, message, argument) \
+if ( (condition) ) \
+{ \
+  report_error(__FILE__, __LINE__, settings, message, argument); \
+  status = -1; \
+  goto cleanup; \
+} else { }
+
+static WCHAR *translate_finename(WCHAR *filename)
+{
+  if (!wcscmp(filename, L"/dev/null")) return L"NUL"; else return filename;
+}
+
+int run_command(const command_settings *settings)
+{
+  BOOL process_created = FALSE;
+  int stdin_redirected = 0, stdout_redirected = 0, stderr_redirected = 0;
+  int combined = 0; /* 1 if stdout and stderr are redirected to the same file */
+  int wait_again = 0;
+  WCHAR *program = NULL;
+  WCHAR *commandline = NULL;
+
+  LPVOID environment = NULL;
+  LPCWSTR current_directory = NULL;
+  STARTUPINFO startup_info;
+  PROCESS_INFORMATION process_info;
+  BOOL wait_result;
+  DWORD status, stamp, cur;
+  DWORD timeout = (settings->timeout > 0) ? settings->timeout * 1000 : INFINITE;
+
+  JOBOBJECT_ASSOCIATE_COMPLETION_PORT port = {NULL, NULL};
+  HANDLE hJob = NULL;
+  DWORD completion_code;
+  ULONG_PTR completion_key;
+  LPOVERLAPPED pOverlapped;
+
+  ZeroMemory(&startup_info, sizeof(STARTUPINFO));
+  startup_info.cb = sizeof(STARTUPINFO);
+  startup_info.dwFlags = STARTF_USESTDHANDLES;
+
+  program = find_program(settings->program);
+  checkerr(
+    (program == NULL),
+    "Could not find program to execute",
+     settings->program
+  );
+
+  commandline = commandline_of_arguments(settings->argv);
+
+  environment = prepare_environment(settings->envp);
+
+  if (is_defined(settings->stdin_filename))
+  {
+    WCHAR *stdin_filename = translate_finename(settings->stdin_filename);
+    startup_info.hStdInput = create_input_handle(stdin_filename);
+    checkerr( (startup_info.hStdInput == INVALID_HANDLE_VALUE),
+      "Could not redirect standard input",
+      stdin_filename);
+    stdin_redirected = 1;
+  } else startup_info.hStdInput = GetStdHandle(STD_INPUT_HANDLE);
+
+  if (is_defined(settings->stdout_filename))
+  {
+    WCHAR *stdout_filename = translate_finename(settings->stdout_filename);
+    startup_info.hStdOutput = create_output_handle(
+      stdout_filename, settings->append
+    );
+    checkerr( (startup_info.hStdOutput == INVALID_HANDLE_VALUE),
+      "Could not redirect standard output",
+      stdout_filename);
+    stdout_redirected = 1;
+  } else startup_info.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);
+
+  if (is_defined(settings->stderr_filename))
+  {
+    if (stdout_redirected)
+    {
+      if (wcscmp(settings->stdout_filename, settings->stderr_filename) == 0)
+      {
+        startup_info.hStdError = startup_info.hStdOutput;
+        stderr_redirected = 1;
+        combined = 1;
+      }
+    }
+
+    if (! stderr_redirected)
+    {
+      WCHAR *stderr_filename = translate_finename(settings->stderr_filename);
+      startup_info.hStdError = create_output_handle
+      (
+        stderr_filename, settings->append
+      );
+      checkerr( (startup_info.hStdError == INVALID_HANDLE_VALUE),
+        "Could not redirect standard error",
+        stderr_filename);
+      stderr_redirected = 1;
+    }
+  } else startup_info.hStdError = GetStdHandle(STD_ERROR_HANDLE);
+
+  process_created = CreateProcess(
+    program,
+    commandline,
+    NULL, /* SECURITY_ATTRIBUTES process_attributes */
+    NULL, /* SECURITY_ATTRIBUTES thread_attributes */
+    TRUE, /* BOOL inherit_handles */
+    CREATE_SUSPENDED | CREATE_UNICODE_ENVIRONMENT, /* DWORD creation_flags */
+    environment,
+    NULL, /* LPCSTR current_directory */
+    &startup_info,
+    &process_info
+  );
+  checkerr( (! process_created), "CreateProcess failed", NULL);
+
+  hJob = CreateJobObject(NULL, NULL);
+  checkerr( (hJob == NULL), "CreateJobObject failed", NULL);
+  checkerr( !AssignProcessToJobObject(hJob, process_info.hProcess),
+    "AssignProcessToJob failed", NULL);
+  port.CompletionPort =
+    CreateIoCompletionPort(INVALID_HANDLE_VALUE, NULL, 0, 0);
+  checkerr( (port.CompletionPort == NULL),
+    "CreateIoCompletionPort failed", NULL);
+  checkerr( !SetInformationJobObject(
+    hJob,
+    JobObjectAssociateCompletionPortInformation,
+    &port, sizeof(port)), "SetInformationJobObject failed", NULL);
+
+  ResumeThread(process_info.hThread);
+  CloseHandle(process_info.hThread);
+
+  stamp = GetTickCount();
+  while ((wait_result = GetQueuedCompletionStatus(port.CompletionPort,
+                                                  &completion_code,
+                                                  &completion_key,
+                                                  &pOverlapped,
+                                                  timeout))
+         && completion_code != JOB_OBJECT_MSG_ACTIVE_PROCESS_ZERO)
+  {
+    if (timeout != INFINITE)
+    {
+      cur = GetTickCount();
+      stamp = (cur > stamp ? cur - stamp : MAXDWORD - stamp + cur);
+      timeout = (timeout > stamp ? timeout - stamp : 0);
+      stamp = cur;
+    }
+  }
+  if (wait_result)
+  {
+    /* The child has terminated before the timeout has expired */
+    checkerr( (! GetExitCodeProcess(process_info.hProcess, &status)),
+      "GetExitCodeProcess failed", NULL);
+  } else if (pOverlapped == NULL) {
+    /* The timeout has expired, terminate the process */
+    checkerr( (! TerminateJobObject(hJob, 0)),
+      "TerminateJob failed", NULL);
+    status = -1;
+    wait_again = 1;
+  } else {
+    error_with_location(__FILE__, __LINE__, settings,
+      "GetQueuedCompletionStatus failed\n");
+    report_error(__FILE__, __LINE__,
+      settings, "Failure while waiting for process termination", NULL);
+    status = -1;
+  }
+
+cleanup:
+  free(program);
+  free(commandline);
+  if (stdin_redirected) CloseHandle(startup_info.hStdInput);
+  if (stdout_redirected) CloseHandle(startup_info.hStdOutput);
+  if (stderr_redirected && !combined) CloseHandle(startup_info.hStdError);
+  if (wait_again)
+  {
+    /* Wait again but this time just 1sec to avoid being blocked */
+    WaitForSingleObject(process_info.hProcess, 1000);
+  }
+  if (process_created) CloseHandle(process_info.hProcess);
+  if (hJob != NULL) CloseHandle(hJob);
+  if (port.CompletionPort != NULL) CloseHandle(port.CompletionPort);
+  return status;
+}
diff --git a/ocamltest/strace.ml b/ocamltest/strace.ml
new file mode 100644
index 00000000..f289adba
--- /dev/null
+++ b/ocamltest/strace.ml
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2019 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Implementation of the strace feature *)
+
+let strace = Variables.make ("strace", "Whether to use strace")
+let strace_flags =
+  Variables.make ("strace_flags", "Which flags to pass to strace")
+
+let (counters : (string, int) Hashtbl.t) = Hashtbl.create 10
+
+let get_logfile_name base =
+  let n = try Hashtbl.find counters base with Not_found -> 1 in
+  let filename = Printf.sprintf "strace-%s_%d.log" base n in
+  Hashtbl.replace counters base (n+1);
+  filename
+
+let _ =
+  Variables.register_variable strace;
+  Variables.register_variable strace_flags
diff --git a/ocamltest/strace.mli b/ocamltest/strace.mli
new file mode 100644
index 00000000..ac21db36
--- /dev/null
+++ b/ocamltest/strace.mli
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2019 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Interface to the strace feature *)
+
+val strace : Variables.t
+
+val strace_flags : Variables.t
+
+val get_logfile_name : string -> string
diff --git a/ocamltest/tests.ml b/ocamltest/tests.ml
new file mode 100644
index 00000000..7e86bbf7
--- /dev/null
+++ b/ocamltest/tests.ml
@@ -0,0 +1,79 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of tests, built from actions *)
+
+type t = {
+  test_name : string;
+  test_run_by_default : bool;
+  test_actions : Actions.t list
+}
+
+let compare t1 t2 = String.compare t1.test_name t2.test_name
+
+let (tests: (string, t) Hashtbl.t) = Hashtbl.create 20
+
+let register test = Hashtbl.add tests test.test_name test
+
+let get_registered_tests () =
+  let f _test_name test acc = test::acc in
+  let unsorted_tests = Hashtbl.fold f tests [] in
+  List.sort compare unsorted_tests
+
+let default_tests () =
+  let f _test_name test acc =
+    if test.test_run_by_default then test::acc else acc in
+  Hashtbl.fold f tests []
+
+let lookup name =
+  try Some (Hashtbl.find tests name)
+  with Not_found -> None
+
+let test_of_action action =
+{
+  test_name = Actions.name action;
+  test_run_by_default = false;
+  test_actions = [action]
+}
+
+let run_actions log testenv actions =
+  let total = List.length actions in
+  let rec run_actions_aux action_number env = function
+    | [] -> (Result.pass, env)
+    | action::remaining_actions ->
+      begin
+        Printf.fprintf log "Running action %d/%d (%s)\n%!"
+          action_number total (Actions.name action);
+        let (result, env') = Actions.run log env action in
+        Printf.fprintf log "Action %d/%d (%s) %s\n%!"
+          action_number total (Actions.name action)
+          (Result.string_of_result result);
+        if Result.is_pass result
+        then run_actions_aux (action_number+1) env' remaining_actions
+        else (result, env')
+      end in
+  run_actions_aux 1 testenv actions
+
+let run log env test =
+  Printf.fprintf log "Running test %s with %d actions\n%!"
+    test.test_name
+    (List.length test.test_actions);
+  run_actions log env test.test_actions
+
+module TestSet = Set.Make
+(struct
+  type nonrec t = t
+  let compare = compare
+end)
diff --git a/ocamltest/tests.mli b/ocamltest/tests.mli
new file mode 100644
index 00000000..eebc4bb4
--- /dev/null
+++ b/ocamltest/tests.mli
@@ -0,0 +1,38 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of tests, built from actions *)
+
+type t = {
+  test_name : string;
+  test_run_by_default : bool;
+  test_actions : Actions.t list
+}
+
+val compare : t -> t -> int
+
+val register : t -> unit
+
+val get_registered_tests : unit -> t list
+
+val default_tests : unit -> t list
+
+val lookup : string -> t option
+
+val run : out_channel -> Environments.t -> t -> Result.t * Environments.t
+
+val test_of_action : Actions.t -> t
+
+module TestSet : Set.S with type elt = t
diff --git a/ocamltest/tsl_ast.ml b/ocamltest/tsl_ast.ml
new file mode 100644
index 00000000..47180b66
--- /dev/null
+++ b/ocamltest/tsl_ast.ml
@@ -0,0 +1,41 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Abstract Syntax Tree for the Tests Specification Language *)
+
+type 'a located = {
+  node : 'a;
+  loc : Location.t
+}
+
+type environment_statement =
+  | Assignment of bool * string located * string located (* variable = value *)
+  | Append of string located * string located
+  | Include of string located (* include named environment *)
+
+type tsl_item =
+  | Environment_statement of environment_statement located
+  | Test of
+    int (* test depth *) *
+    string located (* test name *) *
+    string located list (* environment modifiers *)
+
+type tsl_block = tsl_item list
+
+let make ?(loc = Location.none) foo = { node = foo; loc = loc }
+
+let make_identifier = make
+let make_string = make
+let make_environment_statement = make
diff --git a/ocamltest/tsl_ast.mli b/ocamltest/tsl_ast.mli
new file mode 100644
index 00000000..06a61a19
--- /dev/null
+++ b/ocamltest/tsl_ast.mli
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Abstract Syntax Tree for the Tests Specification Language *)
+
+type 'a located = {
+  node : 'a;
+  loc : Location.t
+}
+
+type environment_statement =
+  | Assignment of bool * string located * string located (* variable = value *)
+  | Append of string located * string located (* variable += value *)
+  | Include of string located (* include named environment *)
+
+type tsl_item =
+  | Environment_statement of environment_statement located
+  | Test of
+    int (* test depth *) *
+    string located (* test name *) *
+    string located list (* environment modifiers *)
+
+type tsl_block = tsl_item list
+
+val make_identifier : ?loc:Location.t -> string -> string located
+val make_string : ?loc:Location.t -> string -> string located
+val make_environment_statement :
+  ?loc:Location.t -> environment_statement -> environment_statement located
diff --git a/ocamltest/tsl_lexer.mli b/ocamltest/tsl_lexer.mli
new file mode 100644
index 00000000..b25e9f85
--- /dev/null
+++ b/ocamltest/tsl_lexer.mli
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Interface to the Tsl_lexer module *)
+
+val token : Lexing.lexbuf -> Tsl_parser.token
+val modifier :
+    Lexing.lexbuf -> string * [`Remove | `Add of string | `Append of string]
diff --git a/ocamltest/tsl_lexer.mll b/ocamltest/tsl_lexer.mll
new file mode 100644
index 00000000..19ef10ee
--- /dev/null
+++ b/ocamltest/tsl_lexer.mll
@@ -0,0 +1,128 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Lexer definitions for the Tests Specification Language and for
+   response files *)
+
+{
+open Tsl_parser
+
+let comment_start_pos = ref []
+
+let lexer_error message =
+  failwith (Printf.sprintf "Tsl lexer: %s" message)
+}
+
+let newline = ('\013'* '\010')
+let blank = [' ' '\009' '\012']
+let identchar = ['A'-'Z' 'a'-'z' '_' '.' '-' '\'' '0'-'9']
+
+rule token = parse
+  | blank * { token lexbuf }
+  | newline { Lexing.new_line lexbuf; token lexbuf }
+  | "/*" blank* "TEST" { TSL_BEGIN_C_STYLE }
+  | "*/" { TSL_END_C_STYLE }
+  | "(*" blank* "TEST" { TSL_BEGIN_OCAML_STYLE }
+  | "*)" { TSL_END_OCAML_STYLE }
+  | "," { COMA }
+  | '*'+ { TEST_DEPTH (String.length (Lexing.lexeme lexbuf)) }
+  | "+=" { PLUSEQUAL }
+  | "=" { EQUAL }
+  | identchar *
+    { let s = Lexing.lexeme lexbuf in
+      match s with
+        | "include" -> INCLUDE
+        | "set" -> SET
+        | "with" -> WITH
+        | _ -> IDENTIFIER s
+    }
+  | "(*"
+    {
+      comment_start_pos := [Lexing.lexeme_start_p lexbuf];
+      comment lexbuf
+    }
+  | '"'
+    { STRING (string "" lexbuf) }
+  | _
+    {
+      let pos = Lexing.lexeme_start_p lexbuf in
+      let file = pos.Lexing.pos_fname in
+      let line = pos.Lexing.pos_lnum in
+      let column = pos.Lexing.pos_cnum - pos.Lexing.pos_bol in
+      let message = Printf.sprintf "%s:%d:%d: unexpected character %s"
+        file line column (Lexing.lexeme lexbuf) in
+      lexer_error message
+    }
+  | eof
+    { lexer_error "unexpected eof" }
+(* Backslashes are ignored in strings except at the end of lines where they
+   cause the newline to be ignored. After an escaped newline, any blank
+   characters at the start of the line are ignored and optionally one blank
+   character may be escaped with a backslash.
+
+   In particular, this means that the following:
+script = "some-directory\\
+         \ foo"
+   is interpreted as the OCaml string "some-directory\\ foo".
+   *)
+and string acc = parse
+  | [^ '\\' '"' ]+
+    { string (acc ^ Lexing.lexeme lexbuf) lexbuf }
+  | '\\' newline blank* ('\\' (blank as blank))?
+    { let space =
+        match blank with None -> "" | Some blank -> String.make 1 blank
+      in
+      string (acc ^ space) lexbuf }
+  | '\\'
+    {string (acc ^ "\\") lexbuf}
+  | '"'
+    {acc}
+and comment = parse
+  | "(*"
+    {
+      comment_start_pos :=
+        (Lexing.lexeme_start_p lexbuf) :: !comment_start_pos;
+      comment lexbuf
+    }
+  | "*)"
+    {
+      comment_start_pos := List.tl !comment_start_pos;
+      if !comment_start_pos = [] then token lexbuf else comment lexbuf
+    }
+  | eof
+    {
+      let pos = List.hd !comment_start_pos in
+      let file = pos.Lexing.pos_fname in
+      let line = pos.Lexing.pos_lnum in
+      let column = pos.Lexing.pos_cnum - pos.Lexing.pos_bol in
+      let message = Printf.sprintf "%s:%d:%d: unterminated comment"
+        file line column in
+      lexer_error message
+    }
+  | _
+    {
+      comment lexbuf
+    }
+
+(* Parse one line of a response file (for scripts and hooks) *)
+and modifier = parse
+  | '-' (identchar* as variable)
+    { variable, `Remove }
+  | (identchar* as variable) "=\"" (_* as str) '"'
+    { variable, `Add str }
+  | (identchar* as variable) "+=\"" (_* as str) '"'
+    { variable, `Append str }
+  | _
+    { failwith "syntax error in script response file" }
diff --git a/ocamltest/tsl_parser.mly b/ocamltest/tsl_parser.mly
new file mode 100644
index 00000000..eb891f6a
--- /dev/null
+++ b/ocamltest/tsl_parser.mly
@@ -0,0 +1,87 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Sebastien Hinderer, projet Gallium, INRIA Paris            */
+/*                                                                        */
+/*   Copyright 2016 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Parser for the Tests Specification Language */
+
+%{
+
+open Location
+open Tsl_ast
+
+let mkstring s = make_string ~loc:(symbol_rloc()) s
+
+let mkidentifier id = make_identifier ~loc:(symbol_rloc()) id
+
+let mkenvstmt envstmt =
+  let located_env_statement =
+    make_environment_statement ~loc:(symbol_rloc()) envstmt in
+  Environment_statement located_env_statement
+
+%}
+
+%token TSL_BEGIN_C_STYLE TSL_END_C_STYLE
+%token TSL_BEGIN_OCAML_STYLE TSL_END_OCAML_STYLE
+%token COMA
+%token <int> TEST_DEPTH
+%token EQUAL PLUSEQUAL
+/* %token COLON */
+%token INCLUDE SET WITH
+%token <string> IDENTIFIER
+%token <string> STRING
+
+%start tsl_block
+%type <Tsl_ast.tsl_block> tsl_block
+
+%%
+
+tsl_block:
+| TSL_BEGIN_C_STYLE tsl_items TSL_END_C_STYLE { $2 }
+| TSL_BEGIN_OCAML_STYLE tsl_items TSL_END_OCAML_STYLE { $2 }
+
+tsl_items:
+| { [] }
+| tsl_item tsl_items { $1 :: $2 }
+
+tsl_item:
+| test_item { $1 }
+| env_item { $1 }
+
+test_item:
+  TEST_DEPTH identifier with_environment_modifiers { (Test ($1, $2, $3)) }
+
+with_environment_modifiers:
+| { [] }
+| WITH identifier opt_environment_modifiers { $2::(List.rev $3) }
+
+opt_environment_modifiers:
+| { [] }
+| opt_environment_modifiers COMA identifier { $3::$1 }
+
+env_item:
+| identifier EQUAL string
+    { mkenvstmt (Assignment (false, $1, $3)) }
+| identifier PLUSEQUAL string
+    { mkenvstmt (Append ($1, $3)) }
+| SET identifier EQUAL string
+    { mkenvstmt (Assignment (true, $2, $4)) }
+
+| INCLUDE identifier
+  { mkenvstmt (Include $2) }
+
+identifier: IDENTIFIER { mkidentifier $1 }
+
+string: STRING { mkstring $1 }
+
+%%
diff --git a/ocamltest/tsl_semantics.ml b/ocamltest/tsl_semantics.ml
new file mode 100644
index 00000000..e9e163f2
--- /dev/null
+++ b/ocamltest/tsl_semantics.ml
@@ -0,0 +1,170 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Interpretation of TSL blocks and operations on test trees *)
+
+open Tsl_ast
+
+let string_of_location loc =
+  let buf = Buffer.create 64 in
+  let fmt = Format.formatter_of_buffer buf in
+  Location.print_loc fmt loc;
+  Format.pp_print_flush fmt ();
+  Buffer.contents buf
+
+let no_such_variable loc name =
+  let locstr = string_of_location loc in
+  Printf.eprintf "%s\nNo such variable %s\n%!" locstr name;
+  exit 2
+
+let no_such_modifiers loc name =
+  let locstr = string_of_location loc in
+  Printf.eprintf "%s\nNo such modifiers %s\n%!" locstr name;
+  exit 2
+
+let apply_modifiers env modifiers_name =
+  let name = modifiers_name.node in
+  let modifier = Environments.Include name in
+  try Environments.apply_modifier env modifier with
+  | Environments.Modifiers_name_not_found name ->
+    no_such_modifiers modifiers_name.loc name
+
+let rec add_to_env decl loc variable_name value env =
+  match (Variables.find_variable variable_name, decl) with
+    | (None, true) ->
+      let newvar = Variables.make (variable_name,"User variable") in
+      Variables.register_variable newvar;
+      add_to_env false loc variable_name value env
+    | (Some variable, false) ->
+      Environments.add variable value env
+    | (None, false) ->
+      raise (Variables.No_such_variable variable_name)
+    | (Some _, true) ->
+      raise (Variables.Variable_already_registered variable_name)
+
+let append_to_env loc variable_name value env =
+  let variable =
+    match Variables.find_variable variable_name with
+    | None ->
+        raise (Variables.No_such_variable variable_name)
+    | Some variable ->
+        variable
+  in
+  try
+    Environments.append variable value env
+  with Variables.No_such_variable name ->
+    no_such_variable loc name
+
+let interprete_environment_statement env statement = match statement.node with
+  | Assignment (decl, var, value) ->
+      add_to_env decl statement.loc var.node value.node env
+  | Append (var, value) ->
+      append_to_env statement.loc var.node value.node env
+  | Include modifiers_name ->
+      apply_modifiers env modifiers_name
+
+let interprete_environment_statements env l =
+  List.fold_left interprete_environment_statement env l
+
+type test_tree =
+  | Node of
+    (Tsl_ast.environment_statement located list) *
+    Tests.t *
+    string located list *
+    (test_tree list)
+
+let too_deep testname max_level real_level =
+  Printf.eprintf "Test %s should have depth atmost %d but has depth %d\n%!"
+    testname max_level real_level;
+  exit 2
+
+let unexpected_environment_statement s =
+  let locstr = string_of_location s.loc in
+  Printf.eprintf "%s\nUnexpected environment statement\n%!" locstr;
+  exit 2
+
+let no_such_test_or_action t =
+  let locstr = string_of_location t.loc in
+  Printf.eprintf "%s\nNo such test or action: %s\n%!" locstr t.node;
+  exit 2
+
+let test_trees_of_tsl_block tsl_block =
+  let rec env_of_lines = function
+    | [] -> ([], [])
+    | Environment_statement s :: lines ->
+      let (env', remaining_lines) = env_of_lines lines in
+      (s :: env', remaining_lines)
+    | lines -> ([], lines)
+  and tree_of_lines depth = function
+    | [] -> (None, [])
+    | line::remaining_lines as l ->
+      begin match line with
+        | Environment_statement s -> unexpected_environment_statement s
+        | Test (test_depth, located_name, env_modifiers) ->
+          begin
+            let name = located_name.node in
+            if test_depth > depth then too_deep name depth test_depth
+            else if test_depth < depth then (None, l)
+            else
+              let (env, rem) = env_of_lines remaining_lines in
+              let (trees, rem) = trees_of_lines (depth+1) rem in
+              match Tests.lookup name with
+                | None ->
+                  begin match Actions.lookup name with
+                    | None -> no_such_test_or_action located_name
+                    | Some action ->
+                      let test = Tests.test_of_action action in
+                      (Some (Node (env, test, env_modifiers, trees)), rem)
+                  end
+                | Some test ->
+                  (Some (Node (env, test, env_modifiers, trees)), rem)
+          end
+      end
+  and trees_of_lines depth lines =
+    let remaining_lines = ref lines in
+    let trees = ref [] in
+    let continue = ref true in
+    while !continue; do
+      let (tree, rem) = tree_of_lines depth !remaining_lines in
+      remaining_lines := rem;
+      match tree with
+        | None -> continue := false
+        | Some t -> trees := t :: !trees
+    done;
+    (List.rev !trees, !remaining_lines) in
+  let (env, rem) = env_of_lines tsl_block in
+  let (trees, rem) = trees_of_lines 1 rem in
+  match rem with
+    | [] -> (env, trees)
+    | (Environment_statement s)::_ -> unexpected_environment_statement s
+    | _ -> assert false
+
+let rec tests_in_tree_aux set = function Node (_, test, _, subtrees) ->
+  let set' = List.fold_left tests_in_tree_aux set subtrees in
+  Tests.TestSet.add test set'
+
+let tests_in_tree t = tests_in_tree_aux Tests.TestSet.empty t
+
+let tests_in_trees subtrees =
+  List.fold_left tests_in_tree_aux Tests.TestSet.empty subtrees
+
+let actions_in_test test =
+  let add action_set action = Actions.ActionSet.add action action_set in
+  List.fold_left add Actions.ActionSet.empty test.Tests.test_actions
+
+let actions_in_tests tests =
+  let f test action_set =
+    Actions.ActionSet.union (actions_in_test test) action_set in
+  Tests.TestSet.fold f tests Actions.ActionSet.empty
diff --git a/ocamltest/tsl_semantics.mli b/ocamltest/tsl_semantics.mli
new file mode 100644
index 00000000..dc0f2858
--- /dev/null
+++ b/ocamltest/tsl_semantics.mli
@@ -0,0 +1,47 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Interpretation of TSL blocks and operations on test trees *)
+
+open Tsl_ast
+
+val apply_modifiers : Environments.t -> string located -> Environments.t
+
+val interprete_environment_statement :
+  Environments.t -> Tsl_ast.environment_statement Tsl_ast.located ->
+  Environments.t
+
+val interprete_environment_statements :
+  Environments.t -> Tsl_ast.environment_statement Tsl_ast.located list ->
+  Environments.t
+
+type test_tree =
+  | Node of
+    (Tsl_ast.environment_statement located list) *
+    Tests.t *
+    string located list *
+    (test_tree list)
+
+val test_trees_of_tsl_block :
+  Tsl_ast.tsl_block ->
+  Tsl_ast.environment_statement located list * test_tree list
+
+val tests_in_tree : test_tree -> Tests.TestSet.t
+
+val tests_in_trees : test_tree list -> Tests.TestSet.t
+
+val actions_in_test : Tests.t -> Actions.ActionSet.t
+
+val actions_in_tests : Tests.TestSet.t -> Actions.ActionSet.t
diff --git a/ocamltest/variables.ml b/ocamltest/variables.ml
new file mode 100644
index 00000000..e72bf1c5
--- /dev/null
+++ b/ocamltest/variables.ml
@@ -0,0 +1,72 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of environment variables *)
+
+type value = string
+
+type exporter = value -> string
+
+type t = {
+  variable_name : string;
+  variable_description : string;
+  variable_exporter : exporter
+}
+
+let compare v1 v2 = String.compare v1.variable_name v2.variable_name
+
+exception Empty_variable_name
+
+exception Variable_already_registered of string
+
+exception No_such_variable of string
+
+let default_exporter varname value = Printf.sprintf "%s=%s" varname value
+
+let make (name, description) =
+  if name="" then raise Empty_variable_name else {
+    variable_name = name;
+    variable_description = description;
+    variable_exporter = default_exporter name
+  }
+
+let make_with_exporter exporter (name, description) =
+  if name="" then raise Empty_variable_name else {
+    variable_name = name;
+    variable_description = description;
+    variable_exporter = exporter
+  }
+
+let name_of_variable v = v.variable_name
+
+let description_of_variable v = v.variable_description
+
+let (variables : (string, t) Hashtbl.t) = Hashtbl.create 10
+
+let register_variable variable =
+  if Hashtbl.mem variables variable.variable_name
+  then raise (Variable_already_registered variable.variable_name)
+  else Hashtbl.add variables variable.variable_name variable
+
+let find_variable variable_name =
+  try Some (Hashtbl.find variables variable_name)
+  with Not_found -> None
+
+let string_of_binding variable value =
+  variable.variable_exporter value
+
+let get_registered_variables () =
+  let f _variable_name variable variable_list = variable::variable_list in
+  List.sort compare (Hashtbl.fold f variables [])
diff --git a/ocamltest/variables.mli b/ocamltest/variables.mli
new file mode 100644
index 00000000..8a70c7ff
--- /dev/null
+++ b/ocamltest/variables.mli
@@ -0,0 +1,46 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Definition of environment variables *)
+
+type value = string
+
+type exporter = value -> string
+
+type t
+
+val compare : t -> t -> int
+
+exception Empty_variable_name
+
+exception Variable_already_registered of string
+
+exception No_such_variable of string
+
+val make : string * string -> t
+
+val make_with_exporter : exporter -> string * string -> t
+
+val name_of_variable : t -> string
+
+val description_of_variable : t -> string
+
+val register_variable : t -> unit
+
+val find_variable : string -> t option
+
+val string_of_binding : t -> value -> string
+
+val get_registered_variables : unit -> t list
diff --git a/otherlibs/Makefile b/otherlibs/Makefile
new file mode 100644
index 00000000..8342b402
--- /dev/null
+++ b/otherlibs/Makefile
@@ -0,0 +1,38 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Gabriel Scherer, projet Parsifal, INRIA Saclay              *
+#*                                                                        *
+#*   Copyright 2018 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.          *
+#*                                                                        *
+#**************************************************************************
+
+ROOTDIR=..
+-include $(ROOTDIR)/Makefile.config
+-include $(ROOTDIR)/Makefile.common
+
+OTHERLIBRARIES ?= bigarray dynlink raw_spacetime_lib str systhreads \
+                  unix win32unix
+
+# $1: target name to dispatch to all otherlibs/*/Makefile
+define dispatch_
+$1:
+	@for lib in $$(OTHERLIBRARIES); do \
+	  ($$(MAKE) -C $$$$lib $1) || exit $$$$?; \
+	done
+endef
+define dispatch
+$(eval $(call dispatch_,$1))
+endef
+
+.PHONY: all allopt clean partialclean
+$(call dispatch,all)
+$(call dispatch,allopt)
+$(call dispatch,clean)
+$(call dispatch,partialclean)
diff --git a/otherlibs/Makefile.otherlibs.common b/otherlibs/Makefile.otherlibs.common
new file mode 100644
index 00000000..2e0802de
--- /dev/null
+++ b/otherlibs/Makefile.otherlibs.common
@@ -0,0 +1,140 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# Common Makefile for otherlibs
+
+ROOTDIR=../..
+-include $(ROOTDIR)/Makefile.config
+-include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.best_binaries
+
+CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
+
+CAMLC := $(BEST_OCAMLC) -nostdlib -I $(ROOTDIR)/stdlib
+CAMLOPT := $(BEST_OCAMLOPT) -nostdlib -I $(ROOTDIR)/stdlib
+
+OC_CFLAGS += $(SHAREDLIB_CFLAGS) $(EXTRACFLAGS)
+OC_CPPFLAGS += -I$(ROOTDIR)/runtime
+
+# Compilation options
+COMPFLAGS=-absname -w +a-4-9-41-42-44-45-48 -warn-error A -bin-annot -g \
+          -safe-string -strict-sequence -strict-formats $(EXTRACAMLFLAGS)
+ifeq "$(FLAMBDA)" "true"
+OPTCOMPFLAGS += -O3
+endif
+MKLIB=$(CAMLRUN) $(ROOTDIR)/tools/ocamlmklib
+
+# Variables that must be defined by individual libraries:
+# LIBNAME
+# CAMLOBJS
+
+# Variables that can be defined by individual libraries,
+# but have sensible default values:
+COBJS ?=
+EXTRACFLAGS ?=
+EXTRACAMLFLAGS ?=
+LINKOPTS ?=
+LDOPTS ?=
+HEADERS ?=
+CMIFILES ?= $(CAMLOBJS:.cmo=.cmi)
+CAMLOBJS_NAT ?= $(CAMLOBJS:.cmo=.cmx)
+CLIBNAME ?= $(LIBNAME)
+
+ifeq "$(COBJS)" ""
+STUBSLIB=
+else
+STUBSLIB=lib$(CLIBNAME).$(A)
+endif
+
+.PHONY: all allopt opt.opt # allopt and opt.opt are synonyms
+all: $(STUBSLIB) $(LIBNAME).cma $(CMIFILES)
+
+allopt: $(STUBSLIB) $(LIBNAME).cmxa $(LIBNAME).$(CMXS) $(CMIFILES)
+opt.opt: allopt
+
+$(LIBNAME).cma: $(CAMLOBJS)
+ifeq "$(COBJS)" ""
+	$(CAMLC) -o $@ -a -linkall $(CAMLOBJS) $(LINKOPTS)
+else
+	$(MKLIB) -o $(LIBNAME) -oc $(CLIBNAME) -ocamlc '$(CAMLC)' -linkall \
+	         $(CAMLOBJS) $(LINKOPTS)
+endif
+
+$(LIBNAME).cmxa: $(CAMLOBJS_NAT)
+ifeq "$(COBJS)" ""
+	$(CAMLOPT) -o $@ -a -linkall $(CAMLOBJS_NAT) $(LINKOPTS)
+else
+	$(MKLIB) -o $(LIBNAME) -oc $(CLIBNAME) -ocamlopt '$(CAMLOPT)' -linkall \
+	         $(CAMLOBJS_NAT) $(LINKOPTS)
+endif
+
+$(LIBNAME).cmxs: $(LIBNAME).cmxa $(STUBSLIB)
+	$(CAMLOPT_CMD) -shared -o $(LIBNAME).cmxs -I . $(LIBNAME).cmxa
+
+lib$(CLIBNAME).$(A): $(COBJS)
+	$(MKLIB_CMD) -oc $(CLIBNAME) $(COBJS) $(LDOPTS)
+
+install::
+	if test -f dll$(CLIBNAME)$(EXT_DLL); then \
+	  $(INSTALL_PROG) \
+	    dll$(CLIBNAME)$(EXT_DLL) \
+	    "$(INSTALL_STUBLIBDIR)/"; \
+	fi
+ifneq "$(STUBSLIB)" ""
+	$(INSTALL_DATA) $(STUBSLIB) "$(INSTALL_LIBDIR)/"
+	cd "$(INSTALL_LIBDIR)"; $(RANLIB) lib$(CLIBNAME).$(A)
+endif
+
+	$(INSTALL_DATA) \
+	  $(LIBNAME).cma $(CMIFILES) \
+	  "$(INSTALL_LIBDIR)/"
+ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
+	$(INSTALL_DATA) \
+	  $(CMIFILES:.cmi=.mli) \
+          $(CMIFILES:.cmi=.cmti) \
+	  "$(INSTALL_LIBDIR)/"
+endif
+	if test -n "$(HEADERS)"; then \
+	  $(INSTALL_DATA) $(HEADERS) "$(INSTALL_LIBDIR)/caml/"; \
+	fi
+
+installopt:
+	$(INSTALL_DATA) \
+	   $(CAMLOBJS_NAT) $(LIBNAME).cmxa $(LIBNAME).$(A) \
+	   "$(INSTALL_LIBDIR)/"
+	cd "$(INSTALL_LIBDIR)"; $(RANLIB) $(LIBNAME).a
+	if test -f $(LIBNAME).cmxs; then \
+	  $(INSTALL_PROG) $(LIBNAME).cmxs "$(INSTALL_LIBDIR)/"; \
+	fi
+
+partialclean:
+	rm -f *.cm*
+
+clean:: partialclean
+	rm -f *.dll *.so *.a *.lib *.o *.obj
+
+.SUFFIXES: .ml .mli .cmi .cmo .cmx .$(O)
+
+.mli.cmi:
+	$(CAMLC) -c $(COMPFLAGS) $<
+
+.ml.cmo:
+	$(CAMLC) -c $(COMPFLAGS) $<
+
+.ml.cmx:
+	$(CAMLOPT) -c $(COMPFLAGS) $(OPTCOMPFLAGS) $<
+
+.c.$(O):
+	$(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $<
diff --git a/otherlibs/bigarray/.depend b/otherlibs/bigarray/.depend
new file mode 100644
index 00000000..24e7963a
--- /dev/null
+++ b/otherlibs/bigarray/.depend
@@ -0,0 +1,5 @@
+bigarray.cmo : \
+    bigarray.cmi
+bigarray.cmx : \
+    bigarray.cmi
+bigarray.cmi :
diff --git a/otherlibs/bigarray/Makefile b/otherlibs/bigarray/Makefile
new file mode 100644
index 00000000..577b4f1b
--- /dev/null
+++ b/otherlibs/bigarray/Makefile
@@ -0,0 +1,26 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+LIBNAME=bigarray
+CAMLOBJS=bigarray.cmo
+
+include ../Makefile.otherlibs.common
+
+.PHONY: depend
+
+depend:
+	$(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml > .depend
+
+include .depend
diff --git a/otherlibs/bigarray/bigarray.ml b/otherlibs/bigarray/bigarray.ml
new file mode 100644
index 00000000..d7c9354e
--- /dev/null
+++ b/otherlibs/bigarray/bigarray.ml
@@ -0,0 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Jeremie Dimino, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+include Stdlib.Bigarray
diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli
new file mode 100644
index 00000000..9dcaed96
--- /dev/null
+++ b/otherlibs/bigarray/bigarray.mli
@@ -0,0 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Jeremie Dimino, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+include module type of struct include Stdlib.Bigarray end
diff --git a/otherlibs/bigarray/empty.c b/otherlibs/bigarray/empty.c
new file mode 100644
index 00000000..e69de29b
diff --git a/otherlibs/dynlink/.depend b/otherlibs/dynlink/.depend
new file mode 100644
index 00000000..0a3555b1
--- /dev/null
+++ b/otherlibs/dynlink/.depend
@@ -0,0 +1,40 @@
+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 :
+extract_crc.cmo : \
+    byte/dynlink_compilerlibs.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
+extract_crc.cmx : \
+    native/dynlink_compilerlibs.cmx
+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
new file mode 100644
index 00000000..fc41cd5f
--- /dev/null
+++ b/otherlibs/dynlink/Makefile
@@ -0,0 +1,301 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 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.config
+-include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.best_binaries
+
+CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
+
+OCAMLC=$(BEST_OCAMLC) -g -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLOPT=$(BEST_OCAMLOPT) -g -nostdlib -I $(ROOTDIR)/stdlib
+
+# 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-66 \
+	  -warn-error A \
+          -bin-annot -safe-string -strict-formats
+ifeq "$(FLAMBDA)" "true"
+OPTCOMPFLAGS += -O3
+endif
+
+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 \
+  file_formats/cmo_format.mli \
+  file_formats/cmxs_format.mli
+
+# .ml files from compilerlibs that have corresponding .mli files.
+COMPILERLIBS_SOURCES=\
+  utils/config.ml \
+  utils/build_path_prefix_map.ml \
+  utils/misc.ml \
+  utils/identifiable.ml \
+  utils/numbers.ml \
+  utils/arg_helper.ml \
+  utils/clflags.ml \
+  utils/profile.ml \
+  utils/consistbl.ml \
+  utils/terminfo.ml \
+  utils/warnings.ml \
+  utils/load_path.ml \
+  utils/int_replace_polymorphic_compare.ml \
+  parsing/location.ml \
+  parsing/longident.ml \
+  parsing/docstrings.ml \
+  parsing/syntaxerr.ml \
+  parsing/ast_helper.ml \
+  parsing/ast_mapper.ml \
+  parsing/attr_helper.ml \
+  parsing/builtin_attributes.ml \
+  typing/ident.ml \
+  typing/path.ml \
+  typing/primitive.ml \
+  typing/type_immediacy.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 \
+  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
+
+# 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
+	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))
+
+# $(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=$(COMPILERLIBS_COPIED_SOURCES:.ml=.cmx)
+
+$(LOCAL_SRC)/%.cmi: $(LOCAL_SRC)/%.mli
+	$(OCAMLC) -c -for-pack Dynlink_compilerlibs $(COMPFLAGS) \
+          -I $(LOCAL_SRC) -o $@ $(LOCAL_SRC)/$*.mli
+
+$(LOCAL_SRC)/%.cmo: $(LOCAL_SRC)/%.ml
+	$(OCAMLC) -c -for-pack Dynlink_compilerlibs $(COMPFLAGS) \
+          -I $(LOCAL_SRC) -o $@ $(LOCAL_SRC)/$*.ml
+
+$(LOCAL_SRC)/%.cmx: $(LOCAL_SRC)/%.ml
+	$(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.
+
+byte/dynlink_compilerlibs.cmo: $(COMPILERLIBS_CMO)
+	$(OCAMLC) $(COMPFLAGS) -pack -o $@ $(COMPILERLIBS_CMO)
+
+byte/dynlink_compilerlibs.cmi: byte/dynlink_compilerlibs.cmo
+
+native/dynlink_compilerlibs.cmx: $(COMPILERLIBS_CMX)
+	$(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 extract_crc
+
+allopt: dynlink.cmxa
+
+dynlink.cma: $(OBJS)
+	$(OCAMLC) $(COMPFLAGS) -ccopt "$(NATDYNLINKOPTS)" -a -I byte -o $@ $^
+
+dynlink.cmxa: $(NATOBJS)
+	$(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 $< $@
+
+extract_crc: dynlink.cma byte/dynlink_compilerlibs.cmo extract_crc.cmo
+	$(OCAMLC) -o $@ $^
+
+install:
+	$(INSTALL_DATA) \
+	  dynlink.cmi dynlink.cma \
+	  "$(INSTALL_LIBDIR)"
+ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
+	$(INSTALL_DATA) \
+	  dynlink.cmti dynlink.mli \
+	  "$(INSTALL_LIBDIR)"
+endif
+	$(INSTALL_PROG) \
+	  extract_crc "$(INSTALL_LIBDIR)/extract_crc$(EXE)"
+
+installopt:
+	if $(NATDYNLINK); then \
+	  $(INSTALL_DATA) \
+	    $(NATOBJS) dynlink.cmxa dynlink.$(A) \
+	    "$(INSTALL_LIBDIR)" && \
+	  cd "$(INSTALL_LIBDIR)" && $(RANLIB) dynlink.$(A); \
+	fi
+
+partialclean:
+	rm -f extract_crc *.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: beforedepend
+beforedepend: dynlink_platform_intf.mli
+
+.PHONY: depend
+ifeq "$(TOOLCHAIN)" "msvc"
+depend:
+	$(error Dependencies cannot be regenerated using the MSVC ports)
+else
+DEPEND_DUMMY_FILES=\
+  native/dynlink_compilerlibs.ml \
+  byte/dynlink_compilerlibs.mli \
+  byte/dynlink.mli \
+  native/dynlink.mli
+
+depend: beforedepend
+	touch $(DEPEND_DUMMY_FILES)
+	$(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash \
+	  -I byte -bytecode *.mli *.ml byte/dynlink.ml > .depend
+	$(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash \
+	  -I native -native *.ml native/dynlink.ml >> .depend
+	rm -f $(DEPEND_DUMMY_FILES)
+endif
+
+include .depend
+
+.SUFFIXES: .ml .mli .cmi .cmo .cmx .$(O)
+
+.mli.cmi:
+	$(OCAMLC) -c $(COMPFLAGS) $<
+
+.ml.cmo:
+	$(OCAMLC) -c $(COMPFLAGS) $<
+
+.ml.cmx:
+	$(OCAMLOPT) -c $(COMPFLAGS) $(OPTCOMPFLAGS) $<
diff --git a/otherlibs/dynlink/byte/dynlink.ml b/otherlibs/dynlink/byte/dynlink.ml
new file mode 100644
index 00000000..e7d6c24c
--- /dev/null
+++ b/otherlibs/dynlink/byte/dynlink.ml
@@ -0,0 +1,207 @@
+#3 "otherlibs/dynlink/dynlink.ml"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*              Mark Shinwell and Leo White, Jane Street Europe           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2017--2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+open! Dynlink_compilerlibs
+
+module DC = Dynlink_common
+module DT = Dynlink_types
+
+module Bytecode = struct
+  type filename = string
+
+  module Unit_header = struct
+    type t = Cmo_format.compilation_unit
+
+    let name (t : t) = t.cu_name
+    let crc _t = None
+
+    let interface_imports (t : t) = t.cu_imports
+    let implementation_imports (t : t) =
+      let required =
+        t.cu_required_globals
+        @ Symtable.required_globals t.cu_reloc
+      in
+      let required =
+        List.filter
+          (fun id ->
+             not (Ident.is_predef id)
+             && not (String.contains (Ident.name id) '.'))
+          required
+      in
+      List.map
+        (fun ident -> Ident.name ident, None)
+        required
+
+    let defined_symbols (t : t) =
+      List.map (fun ident -> Ident.name ident)
+        (Symtable.defined_globals t.cu_reloc)
+
+    let unsafe_module (t : t) = t.cu_primitives <> []
+  end
+
+  type handle = Stdlib.in_channel * filename * Digest.t
+
+  let default_crcs = ref []
+  let default_global_map = ref Symtable.empty_global_map
+
+  let init () =
+    if !Sys.interactive then begin (* PR#6802 *)
+      invalid_arg "The dynlink.cma library cannot be used \
+        inside the OCaml toplevel"
+    end;
+    default_crcs := Symtable.init_toplevel ();
+    default_global_map := Symtable.current_state ()
+
+  let is_native = false
+  let adapt_filename f = f
+
+  let num_globals_inited () =
+    Misc.fatal_error "Should never be called for bytecode dynlink"
+
+  let fold_initial_units ~init ~f =
+    List.fold_left (fun acc (comp_unit, interface) ->
+        let id = Ident.create_persistent comp_unit in
+        let defined =
+          Symtable.is_defined_in_global_map !default_global_map id
+        in
+        let implementation =
+          if defined then Some (None, DT.Loaded)
+          else None
+        in
+        let defined_symbols =
+          if defined then [comp_unit]
+          else []
+        in
+        f acc ~comp_unit ~interface ~implementation ~defined_symbols)
+      init
+      !default_crcs
+
+  let run_shared_startup _ = ()
+
+  let run (ic, file_name, file_digest) ~unit_header ~priv =
+    let open Misc in
+    let old_state = Symtable.current_state () in
+    let compunit : Cmo_format.compilation_unit = unit_header in
+    seek_in ic compunit.cu_pos;
+    let code_size = compunit.cu_codesize + 8 in
+    let code = LongString.create code_size in
+    LongString.input_bytes_into code ic compunit.cu_codesize;
+    LongString.set code compunit.cu_codesize (Char.chr Opcodes.opRETURN);
+    LongString.blit_string "\000\000\000\001\000\000\000" 0
+      code (compunit.cu_codesize + 1) 7;
+    begin try
+      Symtable.patch_object code compunit.cu_reloc;
+      Symtable.check_global_initialized compunit.cu_reloc;
+      Symtable.update_global_table ()
+    with Symtable.Error error ->
+      let new_error : DT.linking_error =
+        match error with
+        | Symtable.Undefined_global s -> Undefined_global s
+        | Symtable.Unavailable_primitive s -> Unavailable_primitive s
+        | Symtable.Uninitialized_global s -> Uninitialized_global s
+        | Symtable.Wrong_vm _ -> assert false
+      in
+      raise (DT.Error (Linking_error (file_name, new_error)))
+    end;
+    (* PR#5215: identify this code fragment by
+       digest of file contents + unit name.
+       Unit name is needed for .cma files, which produce several code
+       fragments. *)
+    let digest = Digest.string (file_digest ^ compunit.cu_name) in
+    let events =
+      if compunit.cu_debug = 0 then [| |]
+      else begin
+        seek_in ic compunit.cu_debug;
+        [| input_value ic |]
+      end in
+    if priv then Symtable.hide_additions old_state;
+    let _, clos = Meta.reify_bytecode code events (Some digest) in
+    try ignore ((clos ()) : Obj.t)
+    with exn ->
+      Printexc.raise_with_backtrace
+        (DT.Error (Library's_module_initializers_failed exn))
+        (Printexc.get_raw_backtrace ())
+
+  let load ~filename:file_name ~priv:_ =
+    let ic = open_in_bin file_name in
+    let file_digest = Digest.channel ic (-1) in
+    seek_in ic 0;
+    try
+      let buffer =
+        try really_input_string ic (String.length Config.cmo_magic_number)
+        with End_of_file -> raise (DT.Error (Not_a_bytecode_file file_name))
+      in
+      let handle = ic, file_name, file_digest in
+      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
+        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
+        begin try
+          Dll.open_dlls Dll.For_execution
+            (List.map Dll.extract_dll_name lib.lib_dllibs)
+        with exn ->
+          raise (DT.Error (Cannot_open_dynamic_library exn))
+        end;
+        handle, lib.lib_units
+      end else begin
+        raise (DT.Error (Not_a_bytecode_file file_name))
+      end
+    with exc ->
+      close_in ic;
+      raise exc
+
+  let unsafe_get_global_value ~bytecode_or_asm_symbol =
+    let id = Ident.create_persistent bytecode_or_asm_symbol in
+    match Symtable.get_global_value id with
+    | exception _ -> None
+    | obj -> Some obj
+
+  let finish (ic, _filename, _digest) =
+    close_in ic
+end
+
+include DC.Make (Bytecode)
+
+type linking_error = DT.linking_error =
+  | Undefined_global of string
+  | Unavailable_primitive of string
+  | Uninitialized_global of string
+
+type error = DT.error =
+  | Not_a_bytecode_file of string
+  | Inconsistent_import of string
+  | Unavailable_unit of string
+  | Unsafe_file
+  | Linking_error of string * linking_error
+  | Corrupted_interface of string
+  | Cannot_open_dynamic_library of exn
+  | Library's_module_initializers_failed of exn
+  | Inconsistent_implementation of string
+  | Module_already_loaded of string
+  | Private_library_cannot_implement_interface of string
+
+exception Error = DT.Error
+let error_message = DT.error_message
diff --git a/otherlibs/dynlink/dune b/otherlibs/dynlink/dune
new file mode 100644
index 00000000..32a84264
--- /dev/null
+++ b/otherlibs/dynlink/dune
@@ -0,0 +1,31 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+; mshinwell: Disabled: this needs to build in the same way as the
+; Makefile does, with the [Dynlink_compilerlibs] pack.
+;
+; (library
+;   (name dynlink)
+;   (wrapped false)
+;   (modules dynlink dynlink_compilerlibs 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.mli b/otherlibs/dynlink/dynlink.mli
new file mode 100644
index 00000000..a9770a25
--- /dev/null
+++ b/otherlibs/dynlink/dynlink.mli
@@ -0,0 +1,173 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*             Mark Shinwell and Leo White, Jane Street Europe            *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2017--2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Dynamic loading of .cmo, .cma and .cmxs files. *)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+val is_native : bool
+(** [true] if the program is native,
+    [false] if the program is bytecode. *)
+
+(** {1 Dynamic loading of compiled files} *)
+
+val loadfile : string -> unit
+(** In bytecode: load the given bytecode object file ([.cmo] file) or
+    bytecode library file ([.cma] file), and link it with the running
+    program. In native code: load the given OCaml plugin file (usually
+    [.cmxs]), and link it with the running program.
+
+    All toplevel expressions in the loaded compilation units
+    are evaluated. No facilities are provided to
+    access value names defined by the unit. Therefore, the unit
+    must itself register its entry points with the main program (or a
+    previously-loaded library) e.g. by modifying tables of functions.
+
+    An exception will be raised if the given library defines toplevel
+    modules whose names clash with modules existing either in the main
+    program or a shared library previously loaded with [loadfile].
+    Modules from shared libraries previously loaded with
+    [loadfile_private] are not included in this restriction.
+
+    The compilation units loaded by this function are added to the
+    "allowed units" list (see {!set_allowed_units}). *)
+
+val loadfile_private : string -> unit
+(** Same as [loadfile], except that the compilation units just loaded
+    are hidden (cannot be referenced) from other modules dynamically
+    loaded afterwards.
+
+    An exception will be raised if the given library defines toplevel
+    modules whose names clash with modules existing in either the main
+    program or a shared library previously loaded with [loadfile].
+    Modules from shared libraries previously loaded with
+    [loadfile_private] are not included in this restriction.
+
+    An exception will also be raised if the given library defines
+    toplevel modules whose name matches that of an interface depended
+    on by a module existing in either the main program or a shared
+    library previously loaded with [loadfile]. This applies even if
+    such dependency is only a "module alias" dependency (i.e. just on
+    the name rather than the contents of the interface).
+
+    The compilation units loaded by this function are not added to the
+    "allowed units" list (see {!set_allowed_units}) since they cannot
+    be referenced from other compilation units. *)
+
+val adapt_filename : string -> string
+(** In bytecode, the identity function. In native code, replace the last
+    extension with [.cmxs]. *)
+
+(** {1 Access control} *)
+
+val set_allowed_units : string list -> unit
+(** Set the list of compilation units that may be referenced from units that
+    are dynamically loaded in the future to be exactly the given value.
+
+    Initially all compilation units composing the program currently running
+    are available for reference from dynamically-linked units.
+    [set_allowed_units] can be used to restrict access to a subset of these
+    units, e.g. to the units that compose the API for
+    dynamically-linked code, and prevent access to all other units,
+    e.g. private, internal modules of the running program.
+
+    Note that {!loadfile} changes the allowed-units list. *)
+
+val allow_only: string list -> unit
+(** [allow_only units] sets the list of allowed units to be the intersection
+    of the existing allowed units and the given list of units.  As such it
+    can never increase the set of allowed units. *)
+
+val prohibit : string list -> unit
+(** [prohibit units] prohibits dynamically-linked units from referencing
+    the units named in list [units] by removing such units from the allowed
+    units list.  This can be used to prevent access to selected units,
+    e.g. private, internal modules of the running program. *)
+
+val main_program_units : unit -> string list
+(** Return the list of compilation units that form the main program (i.e.
+    are not dynamically linked). *)
+
+val public_dynamically_loaded_units : unit -> string list
+(** Return the list of compilation units that have been dynamically loaded via
+    [loadfile] (and not via [loadfile_private]).  Note that compilation units
+    loaded dynamically cannot be unloaded. *)
+
+val all_units : unit -> string list
+(** Return the list of compilation units that form the main program together
+    with those that have been dynamically loaded via [loadfile] (and not via
+    [loadfile_private]). *)
+
+val allow_unsafe_modules : bool -> unit
+(** Govern whether unsafe object files are allowed to be
+    dynamically linked. A compilation unit is 'unsafe' if it contains
+    declarations of external functions, which can break type safety.
+    By default, dynamic linking of unsafe object files is
+    not allowed. In native code, this function does nothing; object files
+    with external functions are always allowed to be dynamically linked. *)
+
+(** {1 Error reporting} *)
+
+type linking_error = private
+  | Undefined_global of string
+  | Unavailable_primitive of string
+  | Uninitialized_global of string
+
+type error = private
+  | Not_a_bytecode_file of string
+  | Inconsistent_import of string
+  | Unavailable_unit of string
+  | Unsafe_file
+  | Linking_error of string * linking_error
+  | Corrupted_interface of string
+  | Cannot_open_dynamic_library of exn
+  | Library's_module_initializers_failed of exn
+  | Inconsistent_implementation of string
+  | Module_already_loaded of string
+  | Private_library_cannot_implement_interface of string
+
+exception Error of error
+(** Errors in dynamic linking are reported by raising the [Error]
+    exception with a description of the error.
+    A common case is the dynamic library not being found on the system: this
+    is reported via [Cannot_open_dynamic_library] (the enclosed exception may
+    be platform-specific). *)
+
+val error_message : error -> string
+(** Convert an error description to a printable message. *)
+
+(**/**)
+
+val unsafe_get_global_value : bytecode_or_asm_symbol:string -> Obj.t option
+(** Obtain the globally-visible value whose address is that of the given symbol.
+    The symbol name must be the mangled form as would occur in bytecode or
+    a native object file.  [None] is returned if the value is inaccessible.
+    The accessible values are those in the main program and those provided by
+    previous calls to [loadfile].
+
+    This function is deemed "unsafe" as there is no type safety provided.
+
+    When executing in bytecode, this function uses [Symtable]. As a cautionary
+    note for programs such as the debugger: even though the linking of a packed
+    (subset of) compilerlibs into [Dynlink] hides the copy of [Symtable] that
+    [Dynlink] uses from its clients, there is still only one table of global
+    values in the bytecode VM. Changes to this table are NOT synchronized
+    between [Dynlink] and the functions that change the global value table
+    ([update_global_table] and [assign_global_value], accessed through a
+    client's version of [Symtable]). This is why we can't use [Dynlink] from the
+    toplevel interactive loop, in particular.
+*)
diff --git a/otherlibs/dynlink/dynlink_common.ml b/otherlibs/dynlink/dynlink_common.ml
new file mode 100644
index 00000000..3a362fd1
--- /dev/null
+++ b/otherlibs/dynlink/dynlink_common.ml
@@ -0,0 +1,361 @@
+#2 "otherlibs/dynlink/dynlink_common.ml"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*             Mark Shinwell and Leo White, Jane Street Europe            *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2017--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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+open! Dynlink_compilerlibs
+
+module String = struct
+  include Misc.Stdlib.String
+
+  module Map = struct
+    include Map
+
+    let keys t =
+      fold (fun key _data keys -> Set.add key keys) t Set.empty
+  end
+end
+
+module Make (P : Dynlink_platform_intf.S) = struct
+  module DT = Dynlink_types
+  module UH = P.Unit_header
+
+  type interface_dep =
+    | Name  (* the only use of the interface can be via a module alias *)
+    | Contents of Digest.t
+
+  type implem = Digest.t option * DT.filename * DT.implem_state
+
+  module State = struct
+    type t = {
+      ifaces : (interface_dep * DT.filename) String.Map.t;
+      (* Interfaces that have been depended upon. *)
+      implems : implem String.Map.t;
+      (* Implementations that exist in the main program or have been
+         dynamically loaded. *)
+      defined_symbols : String.Set.t;
+      (* Symbols corresponding to compilation units or packed modules (cf.
+         [Asmpackager.build_package_cmx]).  Used as a sanity check. *)
+      allowed_units : String.Set.t;
+      (* Units that are allowed to be referenced by a subsequently-loaded
+         dynamic library. *)
+      main_program_units : String.Set.t;
+      (* Units forming part of the main program (i.e. not dynamically
+         linked). *)
+      public_dynamically_loaded_units : String.Set.t;
+      (* All units that have been dynamically linked, not including those that
+         were privately loaded. *)
+    }
+
+    let invariant t =
+      let ifaces = String.Map.keys t.ifaces in
+      let implems = String.Map.keys t.implems in
+      assert (String.Set.subset implems ifaces);
+      assert (String.Set.subset t.main_program_units ifaces);
+      assert (String.Set.subset t.main_program_units implems);
+      assert (String.Set.subset t.public_dynamically_loaded_units ifaces);
+      assert (String.Set.subset t.public_dynamically_loaded_units implems)
+
+    let empty = {
+      ifaces = String.Map.empty;
+      implems = String.Map.empty;
+      defined_symbols = String.Set.empty;
+      allowed_units = String.Set.empty;
+      main_program_units = String.Set.empty;
+      public_dynamically_loaded_units = String.Set.empty;
+    }
+  end
+
+  let global_state = ref State.empty
+
+  let inited = ref false
+
+  let unsafe_allowed = ref false
+
+  let allow_unsafe_modules b =
+    unsafe_allowed := b
+
+  let check_symbols_disjoint ~descr syms1 syms2 =
+    let exe = Sys.executable_name in
+    let overlap = String.Set.inter syms1 syms2 in
+    if not (String.Set.is_empty overlap) then begin
+      let msg =
+        Format.asprintf "%s: symbols multiply-defined %s: %a"
+          exe (Lazy.force descr)
+          (Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ", ")
+            Format.pp_print_string)
+          (String.Set.elements overlap)
+      in
+      failwith msg
+    end
+
+  let default_available_units () =
+    let exe = Sys.executable_name in
+    let ifaces, implems, defined_symbols =
+      P.fold_initial_units
+        ~init:(String.Map.empty, String.Map.empty, String.Set.empty)
+        ~f:(fun (ifaces, implems, defined_symbols)
+                ~comp_unit ~interface ~implementation
+                ~defined_symbols:defined_symbols_this_unit ->
+          let ifaces =
+            match interface with
+            | None -> String.Map.add comp_unit (Name, exe) ifaces
+            | Some crc -> String.Map.add comp_unit (Contents crc, exe) ifaces
+          in
+          let implems =
+            match implementation with
+            | None -> implems
+            | Some (crc, state) ->
+              String.Map.add comp_unit (crc, exe, state) implems
+          in
+          let defined_symbols_this_unit =
+            String.Set.of_list defined_symbols_this_unit
+          in
+          check_symbols_disjoint ~descr:(lazy "in the executable file")
+            defined_symbols_this_unit defined_symbols;
+          let defined_symbols =
+            String.Set.union defined_symbols_this_unit defined_symbols
+          in
+          ifaces, implems, defined_symbols)
+    in
+    let main_program_units = String.Map.keys implems in
+    let state : State.t =
+      { ifaces;
+        implems;
+        defined_symbols;
+        allowed_units = main_program_units;
+        main_program_units;
+        public_dynamically_loaded_units = String.Set.empty;
+      }
+    in
+    global_state := state
+
+  let init () =
+    if not !inited then begin
+      P.init ();
+      default_available_units ();
+      inited := true
+    end
+
+  let set_loaded_implem filename ui implems =
+    String.Map.add (UH.name ui) (UH.crc ui, filename, DT.Loaded) implems
+
+  let set_loaded filename ui (state : State.t) =
+    { state with implems = set_loaded_implem filename ui state.implems }
+
+  let check_interface_imports filename ui ifaces =
+    List.fold_left (fun ifaces (name, crc) ->
+        match String.Map.find name ifaces with
+        | exception Not_found -> begin
+            match crc with
+            | None -> String.Map.add name (Name, filename) ifaces
+            | Some crc -> String.Map.add name (Contents crc, filename) ifaces
+          end
+        | old_crc, _old_src ->
+          match old_crc, crc with
+          | (Name | Contents _), None -> ifaces
+          | Name, Some crc ->
+            String.Map.add name (Contents crc, filename) ifaces
+          | Contents old_crc, Some crc ->
+            if old_crc <> crc then raise (DT.Error (Inconsistent_import name))
+            else ifaces)
+      ifaces
+      (UH.interface_imports ui)
+
+  let check_implementation_imports ~allowed_units filename ui implems =
+    List.iter (fun (name, crc) ->
+      if not (String.Set.mem name allowed_units) then begin
+        raise (DT.Error (Unavailable_unit name))
+      end;
+      match String.Map.find name implems with
+      | exception Not_found -> raise (DT.Error (Unavailable_unit name))
+      | ((old_crc, _old_src, unit_state) : implem) ->
+        begin match old_crc, crc with
+        | (None | Some _), None -> ()
+        | None, Some _crc ->
+          (* The [None] behaves like a CRC different from every other. *)
+          raise (DT.Error (Inconsistent_implementation name))
+        | Some old_crc, Some crc ->
+          if old_crc <> crc then begin
+            raise (DT.Error (Inconsistent_implementation name))
+          end
+        end;
+        match unit_state with
+        | Not_initialized ->
+          raise (DT.Error (Linking_error (
+            filename, Uninitialized_global name)))
+        | Check_inited i ->
+          if P.num_globals_inited () < i then begin
+            raise (DT.Error (Linking_error (
+              filename, Uninitialized_global name)))
+          end
+        | Loaded -> ())
+      (UH.implementation_imports ui)
+
+  let check_name filename ui priv ifaces implems =
+    let name = UH.name ui in
+    if String.Map.mem name implems then begin
+      raise (DT.Error (Module_already_loaded name))
+    end;
+    if priv && String.Map.mem name ifaces then begin
+      raise (DT.Error (Private_library_cannot_implement_interface name))
+    end;
+    String.Map.add name (UH.crc ui, filename, DT.Not_initialized) implems
+
+  let check_unsafe_module ui =
+    if (not !unsafe_allowed) && UH.unsafe_module ui then begin
+      raise (DT.Error Unsafe_file)
+    end
+
+  let check filename (units : UH.t list) (state : State.t) ~priv =
+    List.iter (fun ui -> check_unsafe_module ui) units;
+    let new_units =
+      String.Set.of_list (List.map (fun ui -> UH.name ui) units)
+    in
+    let implems =
+      List.fold_left (fun implems ui ->
+          check_name filename ui priv state.ifaces implems)
+        state.implems units
+    in
+    let ifaces =
+      List.fold_left (fun ifaces ui ->
+          check_interface_imports filename ui ifaces)
+        state.ifaces units
+    in
+    let allowed_units = String.Set.union state.allowed_units new_units in
+    let (_ : implem String.Map.t) =
+      List.fold_left
+        (fun acc ui ->
+           check_implementation_imports ~allowed_units filename ui acc;
+           set_loaded_implem filename ui acc)
+        implems units
+    in
+    let defined_symbols =
+      List.fold_left (fun defined_symbols ui ->
+          let descr =
+            lazy (Printf.sprintf "between the executable file (and any \
+                existing dynamically-loaded units) and the unit `%s' being \
+                dynamically loaded from %s"
+              (UH.name ui)
+              filename)
+          in
+          let symbols = String.Set.of_list (UH.defined_symbols ui) in
+          check_symbols_disjoint ~descr symbols defined_symbols;
+          String.Set.union symbols defined_symbols)
+        state.defined_symbols
+        units
+    in
+    if priv then begin
+      state
+    end else begin
+      let public_dynamically_loaded_units =
+        String.Set.union state.public_dynamically_loaded_units new_units
+      in
+      let state =
+        { state with
+          implems;
+          ifaces;
+          defined_symbols;
+          allowed_units;
+          public_dynamically_loaded_units;
+        }
+      in
+      State.invariant state;
+      state
+    end
+
+  let set_allowed_units allowed_units =
+    let allowed_units = String.Set.of_list allowed_units in
+    let state =
+      let state = !global_state in
+      { state with
+        allowed_units;
+      }
+    in
+    global_state := state
+
+  let allow_only units =
+    let allowed_units =
+      String.Set.inter (!global_state).allowed_units
+        (String.Set.of_list units)
+    in
+    let state =
+      let state = !global_state in
+      { state with
+        allowed_units;
+      }
+    in
+    global_state := state
+
+  let prohibit units =
+    let allowed_units =
+      String.Set.diff (!global_state).allowed_units
+        (String.Set.of_list units)
+    in
+    let state =
+      let state = !global_state in
+      { state with
+        allowed_units;
+      }
+    in
+    global_state := state
+
+  let main_program_units () =
+    String.Set.elements (!global_state).main_program_units
+
+  let public_dynamically_loaded_units () =
+    String.Set.elements (!global_state).public_dynamically_loaded_units
+
+  let all_units () =
+    String.Set.elements (String.Set.union
+      (!global_state).main_program_units
+      (!global_state).public_dynamically_loaded_units)
+
+  let dll_filename fname =
+    if Filename.is_implicit fname then Filename.concat (Sys.getcwd ()) fname
+    else fname
+
+  let load priv filename =
+    init ();
+    let filename = dll_filename filename in
+    match P.load ~filename ~priv with
+    | exception exn -> raise (DT.Error (Cannot_open_dynamic_library exn))
+    | handle, units ->
+      try
+        global_state := check filename units !global_state ~priv;
+        P.run_shared_startup handle;
+        List.iter
+          (fun unit_header ->
+             P.run handle ~unit_header ~priv;
+             if not priv then begin
+               global_state := set_loaded filename unit_header !global_state
+             end)
+          units;
+        P.finish handle
+      with exn ->
+        P.finish handle;
+        raise exn
+
+  let loadfile filename = load false filename
+  let loadfile_private filename = load true filename
+
+  let unsafe_get_global_value = P.unsafe_get_global_value
+
+  let is_native = P.is_native
+  let adapt_filename = P.adapt_filename
+end
diff --git a/otherlibs/dynlink/dynlink_common.mli b/otherlibs/dynlink/dynlink_common.mli
new file mode 100644
index 00000000..c6f92d05
--- /dev/null
+++ b/otherlibs/dynlink/dynlink_common.mli
@@ -0,0 +1,35 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*             Mark Shinwell and Leo White, Jane Street Europe            *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2017--2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+(** Construction of dynlink functionality given the platform-specific code. *)
+
+module Make (_ : Dynlink_platform_intf.S) : sig
+  val is_native : bool
+  val loadfile : string -> unit
+  val loadfile_private : string -> unit
+  val unsafe_get_global_value : bytecode_or_asm_symbol:string -> Obj.t option
+  val adapt_filename : string -> string
+  val set_allowed_units : string list -> unit
+  val allow_only: string list -> unit
+  val prohibit : string list -> unit
+  val main_program_units : unit -> string list
+  val public_dynamically_loaded_units : unit -> string list
+  val all_units : unit -> string list
+  val allow_unsafe_modules : bool -> unit
+end
diff --git a/otherlibs/dynlink/dynlink_compilerlibs/Makefile.copy-sources b/otherlibs/dynlink/dynlink_compilerlibs/Makefile.copy-sources
new file mode 100644
index 00000000..7d2114f0
--- /dev/null
+++ b/otherlibs/dynlink/dynlink_compilerlibs/Makefile.copy-sources
@@ -0,0 +1,30 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 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
+	$(BEST_OCAMLDEP) -slash -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_platform_intf.ml b/otherlibs/dynlink/dynlink_platform_intf.ml
new file mode 100644
index 00000000..d4b3a9b6
--- /dev/null
+++ b/otherlibs/dynlink/dynlink_platform_intf.ml
@@ -0,0 +1,69 @@
+#2 "otherlibs/dynlink/dynlink_platform_intf.ml"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*             Mark Shinwell and Leo White, Jane Street Europe            *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2017--2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Interface for platform-specific dynlink providers.
+    Note that this file needs to be a valid .mli file. *)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+module type S = sig
+  type handle
+
+  module Unit_header : sig
+    type t
+
+    val name : t -> string
+    val crc : t -> Digest.t option
+
+    val interface_imports : t -> (string * Digest.t option) list
+    val implementation_imports : t -> (string * Digest.t option) list
+
+    val defined_symbols : t -> string list
+    val unsafe_module : t -> bool
+  end
+
+  val init : unit -> unit
+
+  val is_native : bool
+
+  val adapt_filename : Dynlink_types.filename -> Dynlink_types.filename
+
+  val num_globals_inited : unit -> int
+
+  val fold_initial_units
+     : init:'a
+    -> f:('a
+      -> comp_unit:string
+      -> interface:Digest.t option
+      -> implementation:(Digest.t option * Dynlink_types.implem_state) option
+      -> defined_symbols:string list
+      -> 'a)
+    -> 'a
+
+  val load
+     : filename:Dynlink_types.filename
+    -> priv:bool
+    -> handle * (Unit_header.t list)
+
+  val run_shared_startup : handle -> unit
+  val run : handle -> unit_header:Unit_header.t -> priv:bool -> unit
+
+  val unsafe_get_global_value : bytecode_or_asm_symbol:string -> Obj.t option
+
+  val finish : handle -> unit
+end
diff --git a/otherlibs/dynlink/dynlink_types.ml b/otherlibs/dynlink/dynlink_types.ml
new file mode 100644
index 00000000..ebfd2d1c
--- /dev/null
+++ b/otherlibs/dynlink/dynlink_types.ml
@@ -0,0 +1,116 @@
+#2 "otherlibs/dynlink/dynlink_types.ml"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*             Mark Shinwell and Leo White, Jane Street Europe            *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2017--2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Types shared amongst the various parts of the dynlink code. *)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+type implem_state =
+  | Loaded
+  | Not_initialized
+  | Check_inited of int
+
+type filename = string
+
+type linking_error =
+  | Undefined_global of string
+  | Unavailable_primitive of string
+  | Uninitialized_global of string
+
+type error =
+  | Not_a_bytecode_file of string
+  | Inconsistent_import of string
+  | Unavailable_unit of string
+  | Unsafe_file
+  | Linking_error of string * linking_error
+  | Corrupted_interface of string
+  | Cannot_open_dynamic_library of exn
+  | Library's_module_initializers_failed of exn
+  | Inconsistent_implementation of string
+  | Module_already_loaded of string
+  | Private_library_cannot_implement_interface of string
+
+exception Error of error
+
+let error_message = function
+  | Not_a_bytecode_file name ->
+    name ^ " is not an object file"
+  | Inconsistent_import name ->
+    "interface mismatch on " ^ name
+  | Unavailable_unit name ->
+    "no implementation available for " ^ name
+  | Unsafe_file ->
+    "this object file uses unsafe features"
+  | Linking_error (name, Undefined_global s) ->
+    "error while linking " ^ name ^ ".\n" ^
+      "Reference to undefined global `" ^ s ^ "'"
+  | Linking_error (name, Unavailable_primitive s) ->
+    "error while linking " ^ name ^ ".\n" ^
+      "The external function `" ^ s ^ "' is not available"
+  | Linking_error (name, Uninitialized_global s) ->
+    "error while linking " ^ name ^ ".\n" ^
+      "The module `" ^ s ^ "' is not yet initialized"
+  | Corrupted_interface name ->
+    "corrupted interface file " ^ name
+  | Cannot_open_dynamic_library exn ->
+    "error loading shared library: " ^ (Printexc.to_string exn)
+  | Inconsistent_implementation name ->
+    "implementation mismatch on " ^ name
+  | Library's_module_initializers_failed exn ->
+    "execution of module initializers in the shared library failed: "
+      ^ (Printexc.to_string exn)
+  | Module_already_loaded name ->
+    "The module `" ^ name ^ "' is already loaded \
+      (either by the main program or a previously-dynlinked library)"
+  | Private_library_cannot_implement_interface name ->
+    "The interface `" ^ name ^ "' cannot be implemented by a \
+      library loaded privately"
+
+let () =
+  Printexc.register_printer (function
+    | Error err ->
+      let msg = match err with
+      | Not_a_bytecode_file s -> Printf.sprintf "Not_a_bytecode_file %S" s
+      | Inconsistent_import s -> Printf.sprintf "Inconsistent_import %S" s
+      | Unavailable_unit s -> Printf.sprintf "Unavailable_unit %S" s
+      | Unsafe_file -> "Unsafe_file"
+      | Linking_error (s, Undefined_global s') ->
+        Printf.sprintf "Linking_error (%S, Dynlink.Undefined_global %S)"
+          s s'
+      | Linking_error (s, Unavailable_primitive s') ->
+        Printf.sprintf "Linking_error (%S, Dynlink.Unavailable_primitive %S)"
+          s s'
+      | Linking_error (s, Uninitialized_global s') ->
+        Printf.sprintf "Linking_error (%S, Dynlink.Uninitialized_global %S)"
+          s s'
+      | Corrupted_interface s ->
+        Printf.sprintf "Corrupted_interface %S" s
+      | Cannot_open_dynamic_library exn ->
+        Printf.sprintf "Cannot_open_dll %S" (Printexc.to_string exn)
+      | Inconsistent_implementation s ->
+        Printf.sprintf "Inconsistent_implementation %S" s
+      | Library's_module_initializers_failed exn ->
+        Printf.sprintf "Library's_module_initializers_failed %S"
+          (Printexc.to_string exn)
+      | Module_already_loaded name ->
+        Printf.sprintf "Module_already_loaded %S" name
+      | Private_library_cannot_implement_interface name ->
+        Printf.sprintf "Private_library_cannot_implement_interface %S" name
+      in
+      Some (Printf.sprintf "Dynlink.Error (Dynlink.%s)" msg)
+    | _ -> None)
diff --git a/otherlibs/dynlink/dynlink_types.mli b/otherlibs/dynlink/dynlink_types.mli
new file mode 100644
index 00000000..6adf9b89
--- /dev/null
+++ b/otherlibs/dynlink/dynlink_types.mli
@@ -0,0 +1,49 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*             Mark Shinwell and Leo White, Jane Street Europe            *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2017--2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Types shared amongst the various parts of the dynlink code. *)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+type implem_state =
+  | Loaded
+  | Not_initialized
+  | Check_inited of int
+
+type filename = string
+
+type linking_error =
+  | Undefined_global of string
+  | Unavailable_primitive of string
+  | Uninitialized_global of string
+
+type error =
+  | Not_a_bytecode_file of string
+  | Inconsistent_import of string
+  | Unavailable_unit of string
+  | Unsafe_file
+  | Linking_error of string * linking_error
+  | Corrupted_interface of string
+  | Cannot_open_dynamic_library of exn
+  | Library's_module_initializers_failed of exn
+  | Inconsistent_implementation of string
+  | Module_already_loaded of string
+  | Private_library_cannot_implement_interface of string
+
+exception Error of error
+
+val error_message : error -> string
diff --git a/otherlibs/dynlink/extract_crc.ml b/otherlibs/dynlink/extract_crc.ml
new file mode 100644
index 00000000..49c48394
--- /dev/null
+++ b/otherlibs/dynlink/extract_crc.ml
@@ -0,0 +1,86 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Print the digests of unit interfaces *)
+
+open! Dynlink_compilerlibs
+
+let load_path = ref []
+let first = ref true
+
+exception Corrupted_interface
+
+let digest_interface unit loadpath =
+  let filename =
+    let shortname = unit ^ ".cmi" in
+    try
+      Misc.find_in_path_uncap loadpath shortname
+    with Not_found ->
+      failwith (Printf.sprintf "Cannot find interface %s in load path"
+        shortname)
+  in
+  let ic = open_in_bin filename in
+  try
+    let buffer =
+      really_input_string ic (String.length Config.cmi_magic_number)
+    in
+    if buffer <> Config.cmi_magic_number then begin
+      close_in ic;
+      raise Corrupted_interface
+    end;
+    let cmi = Cmi_format.input_cmi ic in
+    close_in ic;
+    let crc =
+      match cmi.Cmi_format.cmi_crcs with
+        (_, Some crc) :: _ -> crc
+      | _             -> raise Corrupted_interface
+    in
+    crc
+  with End_of_file | Failure _ ->
+    close_in ic;
+    raise Corrupted_interface
+
+let print_crc unit =
+  try
+    let crc = digest_interface unit (!load_path @ ["."]) in
+    if !first then first := false else print_string ";\n";
+    print_string "  \""; print_string (String.capitalize_ascii unit);
+    print_string "\",\n    \"";
+    for i = 0 to String.length crc - 1 do
+      Printf.printf "\\%03d" (Char.code crc.[i])
+    done;
+    print_string "\""
+  with exn ->
+    prerr_string "Error while reading the interface for ";
+    prerr_endline unit;
+    begin match exn with
+      Sys_error msg -> prerr_endline msg
+    | Corrupted_interface ->
+      Printf.eprintf "Ill-formed .cmi file (%s)\n" (Printexc.to_string exn)
+    | _ -> raise exn
+    end;
+    exit 2
+
+let usage = "Usage: extract_crc [-I <dir>] <files>"
+
+let main () =
+  print_string "let crc_unit_list = [\n";
+  Arg.parse
+    ["-I", Arg.String(fun dir -> load_path := !load_path @ [dir]),
+           "<dir>  Add <dir> to the list of include directories"]
+    print_crc usage;
+  print_string "\n]\n"
+
+let _ = main(); exit 0
diff --git a/otherlibs/dynlink/native/dynlink.ml b/otherlibs/dynlink/native/dynlink.ml
new file mode 100644
index 00000000..a827e36d
--- /dev/null
+++ b/otherlibs/dynlink/native/dynlink.ml
@@ -0,0 +1,130 @@
+#3 "otherlibs/dynlink/native/dynlink.ml"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*              Mark Shinwell and Leo White, Jane Street Europe           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2017--2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Dynamic loading of .cmx files *)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+open! Dynlink_compilerlibs
+
+module DC = Dynlink_common
+module DT = Dynlink_types
+
+type global_map = {
+  name : string;
+  crc_intf : Digest.t option;
+  crc_impl : Digest.t option;
+  syms : string list
+}
+
+module Native = struct
+  type handle
+
+  external ndl_open : string -> bool -> handle * Cmxs_format.dynheader
+    = "caml_natdynlink_open"
+  external ndl_run : handle -> string -> unit = "caml_natdynlink_run"
+  external ndl_getmap : unit -> global_map list = "caml_natdynlink_getmap"
+  external ndl_globals_inited : unit -> int = "caml_natdynlink_globals_inited"
+  external ndl_loadsym : string -> Obj.t = "caml_natdynlink_loadsym"
+
+  module Unit_header = struct
+    type t = Cmxs_format.dynunit
+
+    let name (t : t) = t.dynu_name
+    let crc (t : t) = Some t.dynu_crc
+
+    let interface_imports (t : t) = t.dynu_imports_cmi
+    let implementation_imports (t : t) = t.dynu_imports_cmx
+
+    let defined_symbols (t : t) = t.dynu_defines
+    let unsafe_module _t = false
+  end
+
+  let init () = ()
+
+  let is_native = true
+  let adapt_filename f = Filename.chop_extension f ^ ".cmxs"
+
+  let num_globals_inited () = ndl_globals_inited ()
+
+  let fold_initial_units ~init ~f =
+    let rank = ref 0 in
+    List.fold_left (fun acc { name; crc_intf; crc_impl; syms; } ->
+        rank := !rank + List.length syms;
+        let implementation =
+          match crc_impl with
+          | None -> None
+          | Some _ as crco -> Some (crco, DT.Check_inited !rank)
+        in
+        f acc ~comp_unit:name ~interface:crc_intf
+            ~implementation ~defined_symbols:syms)
+      init
+      (ndl_getmap ())
+
+  let run_shared_startup handle =
+    ndl_run handle "_shared_startup"
+
+  let run handle ~unit_header ~priv:_ =
+    List.iter (fun cu ->
+        try ndl_run handle cu
+        with exn ->
+          Printexc.raise_with_backtrace
+            (DT.Error (Library's_module_initializers_failed exn))
+            (Printexc.get_raw_backtrace ()))
+      (Unit_header.defined_symbols unit_header)
+
+  let load ~filename ~priv =
+    let handle, header =
+      try ndl_open filename (not priv)
+      with exn -> raise (DT.Error (Cannot_open_dynamic_library exn))
+    in
+    if header.dynu_magic <> Config.cmxs_magic_number then begin
+      raise (DT.Error (Not_a_bytecode_file filename))
+    end;
+    handle, header.dynu_units
+
+  let unsafe_get_global_value ~bytecode_or_asm_symbol =
+    match ndl_loadsym bytecode_or_asm_symbol with
+    | exception _ -> None
+    | obj -> Some obj
+
+  let finish _handle = ()
+end
+
+include DC.Make (Native)
+
+type linking_error = DT.linking_error =
+  | Undefined_global of string
+  | Unavailable_primitive of string
+  | Uninitialized_global of string
+
+type error = DT.error =
+  | Not_a_bytecode_file of string
+  | Inconsistent_import of string
+  | Unavailable_unit of string
+  | Unsafe_file
+  | Linking_error of string * linking_error
+  | Corrupted_interface of string
+  | Cannot_open_dynamic_library of exn
+  | Library's_module_initializers_failed of exn
+  | Inconsistent_implementation of string
+  | Module_already_loaded of string
+  | Private_library_cannot_implement_interface of string
+
+exception Error = DT.Error
+let error_message = DT.error_message
diff --git a/otherlibs/raw_spacetime_lib/.depend b/otherlibs/raw_spacetime_lib/.depend
new file mode 100644
index 00000000..7f6e6e7a
--- /dev/null
+++ b/otherlibs/raw_spacetime_lib/.depend
@@ -0,0 +1,22 @@
+spacetime_offline.$(O): spacetime_offline.c ../../runtime/caml/alloc.h \
+ ../../runtime/caml/misc.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/config.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/intext.h ../../runtime/caml/io.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/roots.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/signals.h \
+ ../../runtime/caml/stack.h ../../runtime/caml/sys.h \
+ ../../runtime/caml/spacetime.h ../../runtime/caml/stack.h \
+ ../../runtime/caml/s.h
+raw_spacetime_lib.cmo : \
+    raw_spacetime_lib.cmi
+raw_spacetime_lib.cmx : \
+    raw_spacetime_lib.cmi
+raw_spacetime_lib.cmi :
diff --git a/otherlibs/raw_spacetime_lib/Makefile b/otherlibs/raw_spacetime_lib/Makefile
new file mode 100644
index 00000000..0a87a553
--- /dev/null
+++ b/otherlibs/raw_spacetime_lib/Makefile
@@ -0,0 +1,33 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*           Xavier Leroy, projet Cristal, INRIA Rocquencourt             *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# Makefile for Raw_spacetime_lib
+
+LIBNAME=raw_spacetime_lib
+COBJS=spacetime_offline.$(O)
+CAMLOBJS=raw_spacetime_lib.cmo
+
+include ../Makefile.otherlibs.common
+
+.PHONY: depend
+depend:
+ifeq "$(TOOLCHAIN)" "msvc"
+	$(error Dependencies cannot be regenerated using the MSVC ports)
+else
+	$(CC) -MM $(OC_CPPFLAGS) *.c | sed -e 's/\.o/.$$(O)/g' > .depend
+	$(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml >> .depend
+endif
+
+include .depend
diff --git a/otherlibs/raw_spacetime_lib/raw_spacetime_lib.ml b/otherlibs/raw_spacetime_lib/raw_spacetime_lib.ml
new file mode 100644
index 00000000..5ee81fc2
--- /dev/null
+++ b/otherlibs/raw_spacetime_lib/raw_spacetime_lib.ml
@@ -0,0 +1,668 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2015--2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Gc_stats : sig
+  type t
+
+  val minor_words : t -> int
+  val promoted_words : t -> int
+  val major_words : t -> int
+  val minor_collections : t -> int
+  val major_collections : t -> int
+  val heap_words : t -> int
+  val heap_chunks : t -> int
+  val compactions : t -> int
+  val top_heap_words : t -> int
+end = struct
+  type t = {
+    minor_words : int;
+    promoted_words : int;
+    major_words : int;
+    minor_collections : int;
+    major_collections : int;
+    heap_words : int;
+    heap_chunks : int;
+    compactions : int;
+    top_heap_words : int;
+  }
+
+  let minor_words t = t.minor_words
+  let promoted_words t = t.promoted_words
+  let major_words t = t.major_words
+  let minor_collections t = t.minor_collections
+  let major_collections t = t.major_collections
+  let heap_words t = t.heap_words
+  let heap_chunks t = t.heap_chunks
+  let compactions t = t.compactions
+  let top_heap_words t = t.top_heap_words
+end
+
+module Program_counter = struct
+  module OCaml = struct
+    type t = Int64.t
+
+    let to_int64 t = t
+  end
+
+  module Foreign = struct
+    type t = Int64.t
+
+    let to_int64 t = t
+  end
+end
+
+module Function_identifier = struct
+  type t = Int64.t
+
+  let to_int64 t = t
+end
+
+module Function_entry_point = struct
+  type t = Int64.t
+
+  let to_int64 t = t
+end
+
+module Int64_map = Map.Make (Int64)
+
+module Frame_table = struct
+  type raw = (Int64.t * (Printexc.Slot.t list)) list
+
+  type t = Printexc.Slot.t list Int64_map.t
+
+  let demarshal chn : t =
+    let raw : raw = Marshal.from_channel chn in
+    List.fold_left (fun map (pc, rev_location_list) ->
+        Int64_map.add pc (List.rev rev_location_list) map)
+      Int64_map.empty
+      raw
+
+  let find_exn = Int64_map.find
+end
+
+module Shape_table = struct
+  type part_of_shape =
+    | Direct_call of { call_site : Int64.t; callee : Int64.t; }
+    | Indirect_call of Int64.t
+    | Allocation_point of Int64.t
+
+  let _ = Direct_call { call_site = 0L; callee = 0L; }
+  let _ = Indirect_call 0L
+  let _ = Allocation_point 0L
+
+  type raw = (Int64.t * (part_of_shape list)) list
+
+  type t = {
+    shapes : part_of_shape list Int64_map.t;
+    call_counts : bool;
+  }
+
+  let part_of_shape_size t = function
+    | Direct_call _ -> if t.call_counts then 2 else 1
+    | Indirect_call _ -> 1
+    | Allocation_point _ -> 3
+
+  let demarshal chn ~call_counts : t =
+    let raw : raw = Marshal.from_channel chn in
+    let shapes =
+      List.fold_left (fun map (key, data) -> Int64_map.add key data map)
+        Int64_map.empty
+        raw
+    in
+    { shapes;
+      call_counts;
+    }
+
+  let find_exn func_id t = Int64_map.find func_id t.shapes
+  let call_counts t = t.call_counts
+end
+
+module Annotation = struct
+  type t = int
+
+  let to_int t = t
+end
+
+module Trace = struct
+  type node
+  type ocaml_node
+  type foreign_node
+  type uninstrumented_node
+
+  type t = node option
+  type trace = t
+
+  (* This function unmarshals into malloc blocks, which mean that we
+     obtain a straightforward means of writing [compare] on [node]s. *)
+  external unmarshal : in_channel -> 'a
+    = "caml_spacetime_unmarshal_trie"
+
+  let unmarshal in_channel =
+    let trace = unmarshal in_channel in
+    if trace = () then
+      None
+    else
+      Some ((Obj.magic trace) : node)
+
+  let foreign_node_is_null (node : foreign_node) =
+    ((Obj.magic node) : unit) == ()
+
+  external node_num_header_words : unit -> int
+    = "caml_spacetime_node_num_header_words" [@@noalloc]
+
+  let num_header_words = lazy (node_num_header_words ())
+
+  module OCaml = struct
+    type field_iterator = {
+      node : ocaml_node;
+      offset : int;
+      part_of_shape : Shape_table.part_of_shape;
+      remaining_layout : Shape_table.part_of_shape list;
+      shape_table : Shape_table.t;
+    }
+
+    module Allocation_point = struct
+      type t = field_iterator
+
+      let program_counter t =
+        match t.part_of_shape with
+        | Shape_table.Allocation_point call_site -> call_site
+        | _ -> assert false
+
+      external annotation : ocaml_node -> int -> Annotation.t
+        = "caml_spacetime_ocaml_allocation_point_annotation"
+          [@@noalloc]
+
+      let annotation t = annotation t.node t.offset
+
+      external count : ocaml_node -> int -> int
+        = "caml_spacetime_ocaml_allocation_point_count"
+          [@@noalloc]
+
+      let num_words_including_headers t = count t.node t.offset
+    end
+
+    module Direct_call_point = struct
+      type _ t = field_iterator
+
+      let call_site t =
+        match t.part_of_shape with
+        | Shape_table.Direct_call { call_site; _ } -> call_site
+        | _ -> assert false
+
+      let callee t =
+        match t.part_of_shape with
+        | Shape_table.Direct_call { callee; _ } -> callee
+        | _ -> assert false
+
+      external callee_node : ocaml_node -> int -> 'target
+        = "caml_spacetime_ocaml_direct_call_point_callee_node"
+
+      let callee_node (type target) (t : target t) : target =
+        callee_node t.node t.offset
+
+      external call_count : ocaml_node -> int -> int
+        = "caml_spacetime_ocaml_direct_call_point_call_count"
+
+      let call_count t =
+        if Shape_table.call_counts t.shape_table then
+          Some (call_count t.node t.offset)
+        else
+          None
+    end
+
+    module Indirect_call_point = struct
+      type t = field_iterator
+
+      let call_site t =
+        match t.part_of_shape with
+        | Shape_table.Indirect_call call_site -> call_site
+        | _ -> assert false
+
+      module Callee = struct
+        (* CR-soon mshinwell: we should think about the names again.  This is
+           a "c_node" but it isn't foreign. *)
+        type t = {
+          node : foreign_node;
+          call_counts : bool;
+        }
+
+        let is_null t = foreign_node_is_null t.node
+
+        (* CR-soon mshinwell: maybe rename ...c_node_call_site -> c_node_pc,
+           since it isn't a call site in this case. *)
+        external callee : foreign_node -> Function_entry_point.t
+          = "caml_spacetime_c_node_call_site"
+
+        let callee t = callee t.node
+
+        (* This can return a node satisfying "is_null" in the case of an
+           uninitialised tail call point.  See the comment in the C code. *)
+        external callee_node : foreign_node -> node
+          = "caml_spacetime_c_node_callee_node" [@@noalloc]
+
+        let callee_node t = callee_node t.node
+
+        external call_count : foreign_node -> int
+          = "caml_spacetime_c_node_call_count"
+
+        let call_count t =
+          if t.call_counts then Some (call_count t.node)
+          else None
+
+        external next : foreign_node -> foreign_node
+          = "caml_spacetime_c_node_next" [@@noalloc]
+
+        let next t =
+          let next = { t with node = next t.node; } in
+          if foreign_node_is_null next.node then None
+          else Some next
+      end
+
+      external callees : ocaml_node -> int -> foreign_node
+        = "caml_spacetime_ocaml_indirect_call_point_callees"
+          [@@noalloc]
+
+      let callees t =
+        let callees =
+          { Callee.
+            node = callees t.node t.offset;
+            call_counts = Shape_table.call_counts t.shape_table;
+          }
+        in
+        if Callee.is_null callees then None
+        else Some callees
+    end
+
+    module Field = struct
+      type t = field_iterator
+
+      type direct_call_point =
+        | To_ocaml of ocaml_node Direct_call_point.t
+        | To_foreign of foreign_node Direct_call_point.t
+        | To_uninstrumented of
+            uninstrumented_node Direct_call_point.t
+
+      type classification =
+        | Allocation of Allocation_point.t
+        | Direct_call of direct_call_point
+        | Indirect_call of Indirect_call_point.t
+
+      external classify_direct_call_point : ocaml_node -> int -> int
+        = "caml_spacetime_classify_direct_call_point"
+          [@@noalloc]
+
+      let classify t =
+        match t.part_of_shape with
+        | Shape_table.Direct_call _callee ->
+          let direct_call_point =
+            match classify_direct_call_point t.node t.offset with
+            | 0 ->
+              (* We should never classify uninitialised call points here. *)
+              assert false
+            | 1 -> To_ocaml t
+            | 2 -> To_foreign t
+            | _ -> assert false
+          in
+          Direct_call direct_call_point
+        | Shape_table.Indirect_call _ -> Indirect_call t
+        | Shape_table.Allocation_point _ -> Allocation t
+
+      (* CR-soon mshinwell: change to "is_unused"? *)
+      let is_uninitialised t =
+        let offset_to_node_hole =
+          match t.part_of_shape with
+          | Shape_table.Direct_call _ -> Some 0
+          | Shape_table.Indirect_call _ -> Some 0
+          | Shape_table.Allocation_point _ -> None
+        in
+        match offset_to_node_hole with
+        | None -> false
+        | Some offset_to_node_hole ->
+          (* There are actually two cases:
+             1. A normal unused node hole, which says Val_unit;
+             2. An unused tail call point.  This will contain a pointer to the
+                start of the current node, but it also has the bottom bit
+                set. *)
+          let offset = t.offset + offset_to_node_hole in
+          Obj.is_int (Obj.field (Obj.repr t.node) offset)
+
+      let rec next t =
+        match t.remaining_layout with
+        | [] -> None
+        | part_of_shape::remaining_layout ->
+          let size =
+            Shape_table.part_of_shape_size t.shape_table t.part_of_shape
+          in
+          let offset = t.offset + size in
+          assert (offset < Obj.size (Obj.repr t.node));
+          let t =
+            { node = t.node;
+              offset;
+              part_of_shape;
+              remaining_layout;
+              shape_table = t.shape_table;
+            }
+          in
+          skip_uninitialised t
+
+      and skip_uninitialised t =
+        if not (is_uninitialised t) then Some t
+        else next t
+    end
+
+    module Node = struct
+      type t = ocaml_node
+
+      external function_identifier : t -> Function_identifier.t
+        = "caml_spacetime_ocaml_function_identifier"
+
+      external next_in_tail_call_chain : t -> t
+        = "caml_spacetime_ocaml_tail_chain" [@@noalloc]
+
+      external compare : t -> t -> int
+        = "caml_spacetime_compare_node" [@@noalloc]
+
+      let fields t ~shape_table =
+        let id = function_identifier t in
+        match Shape_table.find_exn id shape_table with
+        | exception Not_found -> None
+        | [] -> None
+        | part_of_shape::remaining_layout ->
+          let t =
+            { node = t;
+              offset = Lazy.force num_header_words;
+              part_of_shape;
+              remaining_layout;
+              shape_table;
+            }
+          in
+          Field.skip_uninitialised t
+    end
+  end
+
+  module Foreign = struct
+    module Node = struct
+      type t = foreign_node
+
+      external compare : t -> t -> int
+        = "caml_spacetime_compare_node" [@@noalloc]
+
+      let fields t =
+        if foreign_node_is_null t then None
+        else Some t
+    end
+
+    module Allocation_point = struct
+      type t = foreign_node
+
+      external program_counter : t -> Program_counter.Foreign.t
+        (* This is not a mistake; the same C function works. *)
+        = "caml_spacetime_c_node_call_site"
+
+      external annotation : t -> Annotation.t
+        = "caml_spacetime_c_node_profinfo" [@@noalloc]
+
+      external num_words_including_headers : t -> int
+        = "caml_spacetime_c_node_allocation_count" [@@noalloc]
+    end
+
+    module Call_point = struct
+      type t = foreign_node
+
+      external call_site : t -> Program_counter.Foreign.t
+        = "caml_spacetime_c_node_call_site"
+
+      (* May return a null node.  See comment above and the C code. *)
+      external callee_node : t -> node
+        = "caml_spacetime_c_node_callee_node" [@@noalloc]
+    end
+
+    module Field = struct
+      type t = foreign_node
+
+      type classification =
+        | Allocation of Allocation_point.t
+        | Call of Call_point.t
+
+      external is_call : t -> bool
+        = "caml_spacetime_c_node_is_call" [@@noalloc]
+
+      let classify t =
+        if is_call t then Call t
+        else Allocation t
+
+      external next : t -> t
+        = "caml_spacetime_c_node_next" [@@noalloc]
+
+      let next t =
+        let next = next t in
+        if foreign_node_is_null next then None
+        else Some next
+    end
+  end
+
+  module Node = struct
+    module T = struct
+      type t = node
+
+      external compare : t -> t -> int
+        = "caml_spacetime_compare_node" [@@noalloc]
+    end
+
+    include T
+
+    type classification =
+      | OCaml of OCaml.Node.t
+      | Foreign of Foreign.Node.t
+
+    external is_ocaml_node : t -> bool
+      = "caml_spacetime_is_ocaml_node" [@@noalloc]
+
+    let classify t =
+      if is_ocaml_node t then OCaml ((Obj.magic t) : ocaml_node)
+      else Foreign ((Obj.magic t) : foreign_node)
+
+    let of_ocaml_node (node : ocaml_node) : t = Obj.magic node
+    let of_foreign_node (node : foreign_node) : t = Obj.magic node
+
+    module Map = Map.Make (T)
+    module Set = Set.Make (T)
+  end
+
+  let root t = t
+end
+
+module Heap_snapshot = struct
+
+  module Entries = struct
+    type t = int array  (* == "struct snapshot_entries" *)
+
+    let length t =
+      let length = Array.length t in
+      assert (length mod 3 = 0);
+      length / 3
+
+    let annotation t idx = t.(idx*3)
+    let num_blocks t idx = t.(idx*3 + 1)
+    let num_words_including_headers t idx = t.(idx*3 + 2)
+  end
+
+  type total_allocations =
+    | End
+    | Total of {
+        annotation : Annotation.t;
+        count : int;
+        next : total_allocations;
+      }
+
+  let (_ : total_allocations) =  (* suppress compiler warning *)
+    Total { annotation = 0; count = 0; next = End; }
+
+  type t = {
+    timestamp : float;
+    gc_stats : Gc_stats.t;
+    entries : Entries.t;
+    words_scanned : int;
+    words_scanned_with_profinfo : int;
+    total_allocations : total_allocations;
+  }
+
+  type heap_snapshot = t
+
+  let timestamp t = t.timestamp
+  let gc_stats t = t.gc_stats
+  let entries t = t.entries
+  let words_scanned t = t.words_scanned
+  let words_scanned_with_profinfo t = t.words_scanned_with_profinfo
+
+  module Total_allocation = struct
+    type t = total_allocations  (* [End] is forbidden *)
+
+    let annotation = function
+      | End -> assert false
+      | Total { annotation; _ } -> annotation
+
+    let num_words_including_headers = function
+      | End -> assert false
+      | Total { count; _ } -> count
+
+    let next = function
+      | End -> assert false
+      | Total { next = End; _ } -> None
+      | Total { next; _ } -> Some next
+  end
+
+  let total_allocations t =
+    match t.total_allocations with
+    | End -> None
+    | (Total _) as totals -> Some totals
+
+  module Event = struct
+    type t = {
+      event_name : string;
+      time : float;
+    }
+
+    let event_name t = t.event_name
+    let timestamp t = t.time
+  end
+
+  module Series = struct
+    type t = {
+      num_snapshots : int;
+      time_of_writer_close : float;
+      frame_table : Frame_table.t;
+      shape_table : Shape_table.t;
+      traces_by_thread : Trace.t array;
+      finaliser_traces_by_thread : Trace.t array;
+      snapshots : heap_snapshot array;
+      events : Event.t list;
+      call_counts : bool;
+    }
+
+    (* The order of these constructors must match the C code. *)
+    type what_comes_next =
+      | Snapshot
+      | Traces
+      | Event
+
+    (* Suppress compiler warning 37. *)
+    let _ : what_comes_next list = [Snapshot; Traces; Event;]
+
+    let rec read_snapshots_and_events chn snapshots events =
+      let next : what_comes_next = Marshal.from_channel chn in
+      match next with
+      | Snapshot ->
+        let snapshot : heap_snapshot = Marshal.from_channel chn in
+        read_snapshots_and_events chn (snapshot :: snapshots) events
+      | Event ->
+        let event_name : string = Marshal.from_channel chn in
+        let time : float = Marshal.from_channel chn in
+        let event = { Event. event_name; time; } in
+        read_snapshots_and_events chn snapshots (event :: events)
+      | Traces ->
+        (Array.of_list (List.rev snapshots)), List.rev events
+
+    let read ~path =
+      let chn = open_in_bin path in
+      let magic_number : int = Marshal.from_channel chn in
+      let magic_number_base = magic_number land 0xffff_ffff in
+      let version_number = (magic_number lsr 32) land 0xffff in
+      let features = (magic_number lsr 48) land 0xffff in
+      if magic_number_base <> 0xace00ace then begin
+        failwith "Raw_spacetime_lib: not a Spacetime profiling file"
+      end else begin
+        match version_number with
+        | 0 ->
+          let call_counts =
+            match features with
+            | 0 -> false
+            | 1 -> true
+            | _ ->
+              failwith "Raw_spacetime_lib: unknown Spacetime profiling file \
+                feature set"
+          in
+          let snapshots, events = read_snapshots_and_events chn [] [] in
+          let num_snapshots = Array.length snapshots in
+          let time_of_writer_close : float = Marshal.from_channel chn in
+          let frame_table = Frame_table.demarshal chn in
+          let shape_table = Shape_table.demarshal chn ~call_counts in
+          let num_threads : int = Marshal.from_channel chn in
+          let traces_by_thread = Array.init num_threads (fun _ -> None) in
+          let finaliser_traces_by_thread =
+            Array.init num_threads (fun _ -> None)
+          in
+          for thread = 0 to num_threads - 1 do
+            let trace : Trace.t = Trace.unmarshal chn in
+            let finaliser_trace : Trace.t = Trace.unmarshal chn in
+            traces_by_thread.(thread) <- trace;
+            finaliser_traces_by_thread.(thread) <- finaliser_trace
+          done;
+          close_in chn;
+          { num_snapshots;
+            time_of_writer_close;
+            frame_table;
+            shape_table;
+            traces_by_thread;
+            finaliser_traces_by_thread;
+            snapshots;
+            events;
+            call_counts;
+          }
+        | _ ->
+          failwith "Raw_spacetime_lib: unknown Spacetime profiling file \
+            version number"
+      end
+
+    type trace_kind = Normal | Finaliser
+
+    let num_threads t = Array.length t.traces_by_thread
+
+    let trace t ~kind ~thread_index =
+      if thread_index < 0 || thread_index >= num_threads t then None
+      else
+        match kind with
+        | Normal -> Some t.traces_by_thread.(thread_index)
+        | Finaliser -> Some t.finaliser_traces_by_thread.(thread_index)
+
+    let num_snapshots t = t.num_snapshots
+    let snapshot t ~index = t.snapshots.(index)
+    let frame_table t = t.frame_table
+    let shape_table t = t.shape_table
+    let time_of_writer_close t = t.time_of_writer_close
+    let events t = t.events
+    let has_call_counts t = t.call_counts
+  end
+end
diff --git a/otherlibs/raw_spacetime_lib/raw_spacetime_lib.mli b/otherlibs/raw_spacetime_lib/raw_spacetime_lib.mli
new file mode 100644
index 00000000..6bdffffe
--- /dev/null
+++ b/otherlibs/raw_spacetime_lib/raw_spacetime_lib.mli
@@ -0,0 +1,364 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2015--2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Access to the information recorded by the [Spacetime]
+    module.  (It is intended that this module will be used by
+    post-processors rather than users wishing to understand their
+    programs.)
+    For 64-bit targets only.
+    This module may be used from any program, not just one compiled
+    with a compiler configured for Spacetime. *)
+
+module Gc_stats : sig
+  type t
+
+  val minor_words : t -> int
+  val promoted_words : t -> int
+  val major_words : t -> int
+  val minor_collections : t -> int
+  val major_collections : t -> int
+  val heap_words : t -> int
+  val heap_chunks : t -> int
+  val compactions : t -> int
+  val top_heap_words : t -> int
+end
+
+module Annotation : sig
+  (** An annotation written into a value's header.  These may be looked up
+      in a [Trace.t] (see below). *)
+  type t
+
+  (* CR-someday mshinwell: consider using tag and size to increase the
+     available space of annotations.  Need to be careful of [Obj.truncate].
+     Could also randomise the tags on records.
+  *)
+
+  val to_int : t -> int
+end
+
+module Program_counter : sig
+  module OCaml : sig
+    type t
+
+    val to_int64 : t -> Int64.t
+  end
+
+  module Foreign : sig
+    type t
+
+    val to_int64 : t -> Int64.t
+  end
+
+end
+
+module Frame_table : sig
+  (* CR-someday mshinwell: move to [Gc] if dependencies permit? *)
+  (** A value of type [t] corresponds to the frame table of a running
+      OCaml program.  The table is indexed by program counter address
+      (typically, but not always when using Spacetime, return addresses). *)
+  type t
+
+  (** Find the location, including any inlined frames, corresponding to the
+      given program counter address.  Raises [Not_found] if the location
+      could not be resolved. *)
+  val find_exn : Program_counter.OCaml.t -> t -> Printexc.Slot.t list
+end
+
+module Function_entry_point : sig
+  type t
+
+  val to_int64 : t -> Int64.t
+end
+
+module Function_identifier : sig
+  type t
+  (* CR-soon mshinwell: same as [Function_entry_point] now *)
+  val to_int64 : t -> Int64.t
+end
+
+module Shape_table : sig
+  type t
+end
+
+module Trace : sig
+  (** A value of type [t] holds the dynamic call structure of the program
+      (i.e. which functions have called which other functions) together with
+      information required to decode profiling annotations written into
+      values' headers. *)
+  type t
+  type trace = t
+
+  type node
+  type ocaml_node
+  type foreign_node
+  type uninstrumented_node
+
+  module OCaml : sig
+    module Allocation_point : sig
+      (** A value of type [t] corresponds to an allocation point in OCaml
+          code. *)
+      type t
+
+      (** The program counter at (or close to) the allocation site. *)
+      val program_counter : t -> Program_counter.OCaml.t
+
+      (** The annotation written into the headers of boxed values allocated
+          at the given allocation site. *)
+      val annotation : t -> Annotation.t
+
+      (** The total number of words allocated at this point. *)
+      val num_words_including_headers : t -> int
+    end
+
+    module Direct_call_point : sig
+      (** A value of type ['target t] corresponds to a direct (i.e. known
+          at compile time) call point in OCaml code.  ['target] is the type
+          of the node corresponding to the callee. *)
+      type 'target t
+
+      (** The program counter at (or close to) the call site. *)
+      val call_site : _ t -> Program_counter.OCaml.t
+
+      (** The address of the first instruction of the callee. *)
+      val callee : _ t -> Function_entry_point.t
+
+      (** The node corresponding to the callee. *)
+      val callee_node : 'target t -> 'target
+
+      (** The number of times the callee was called.  Only available if the
+          compiler that recorded the Spacetime profile was configured with
+          "-with-spacetime-call-counts".  [None] will be returned otherwise. *)
+      val call_count : _ t -> int option
+    end
+
+    module Indirect_call_point : sig
+      (** A value of type [t] corresponds to an indirect call point in OCaml
+          code.  Each such value contains a list of callees to which the
+          call point has branched. *)
+      type t
+
+      (** The program counter at (or close to) the call site. *)
+      val call_site : t -> Program_counter.OCaml.t
+
+      module Callee : sig
+        type t
+
+        (** The address of the first instruction of the callee. *)
+        val callee : t -> Function_entry_point.t
+
+        (** The node corresponding to the callee. *)
+        val callee_node : t -> node
+
+        (** The number of times the callee was called.  This returns [None] in
+            the same circumstances as [Direct_call_point.call_count], above. *)
+        val call_count : t -> int option
+
+        (** Move to the next callee to which this call point has branched.
+            [None] is returned when the end of the list is reached. *)
+        val next : t -> t option
+      end
+
+      (** The list of callees to which this indirect call point has
+          branched. *)
+      val callees : t -> Callee.t option
+    end
+
+    module Field : sig
+      (** A value of type [t] enables iteration through the contents
+          ("fields") of an OCaml node. *)
+      type t
+
+      type direct_call_point =
+        | To_ocaml of ocaml_node Direct_call_point.t
+        | To_foreign of foreign_node Direct_call_point.t
+        (* CR-soon mshinwell: once everything's finished, "uninstrumented"
+           should be able to go away.  Let's try to do this after the
+           first release. *)
+        | To_uninstrumented of
+            uninstrumented_node Direct_call_point.t
+
+      type classification =
+        | Allocation of Allocation_point.t
+        | Direct_call of direct_call_point
+        | Indirect_call of Indirect_call_point.t
+
+      val classify : t -> classification
+      val next : t -> t option
+    end
+
+    module Node : sig
+      (** A node corresponding to an invocation of a function written in
+          OCaml. *)
+      type t = ocaml_node
+
+      val compare : t -> t -> int
+
+      (** A unique identifier for the function corresponding to this node. *)
+      val function_identifier : t -> Function_identifier.t
+
+      (** This function traverses a circular list. *)
+      val next_in_tail_call_chain : t -> t
+
+      val fields : t -> shape_table:Shape_table.t -> Field.t option
+    end
+  end
+
+  module Foreign : sig
+    module Allocation_point : sig
+      (** A value of type [t] corresponds to an allocation point in non-OCaml
+          code. *)
+      type t
+
+      val program_counter : t -> Program_counter.Foreign.t
+      val annotation : t -> Annotation.t
+      val num_words_including_headers : t -> int
+    end
+
+    module Call_point : sig
+      (** A value of type [t] corresponds to a call point from non-OCaml
+          code (to either non-OCaml code, or OCaml code via the usual
+          assembly veneer).  Call counts are not available for such nodes. *)
+      type t
+
+      (** N.B. The address of the callee (of type [Function_entry_point.t]) is
+          not available.  It must be recovered during post-processing. *)
+      val call_site : t -> Program_counter.Foreign.t
+      val callee_node : t -> node
+    end
+
+    module Field : sig
+      (** A value of type [t] enables iteration through the contents ("fields")
+          of a C node. *)
+      type t
+
+      type classification = private
+        | Allocation of Allocation_point.t
+        | Call of Call_point.t
+
+      val classify : t -> classification
+      val next : t -> t option
+    end
+
+    module Node : sig
+      (** A node corresponding to an invocation of a function written in C
+          (or any other language that is not OCaml). *)
+      type t = foreign_node
+
+      val compare : t -> t -> int
+
+      val fields : t -> Field.t option
+
+    end
+
+  end
+
+  module Node : sig
+    (** Either an OCaml or a foreign node; or an indication that this
+        is a branch of the graph corresponding to uninstrumented
+        code. *)
+    type t = node
+
+    val compare : t -> t -> int
+
+    type classification = private
+      | OCaml of OCaml.Node.t
+      | Foreign of Foreign.Node.t
+
+    val classify : t -> classification
+
+    val of_ocaml_node : OCaml.Node.t -> t
+    val of_foreign_node : Foreign.Node.t -> t
+
+    module Set : Set.S with type elt = t
+    module Map : Map.S with type key = t
+  end
+
+  (** Obtains the root of the graph for traversal.  [None] is returned if
+      the graph is empty. *)
+  val root : t -> Node.t option
+end
+
+module Heap_snapshot : sig
+  type t
+  type heap_snapshot = t
+
+  module Entries : sig
+    (** An immutable array of the total number of blocks (= boxed
+        values) and the total number of words occupied by such blocks
+        (including their headers) for each profiling annotation in
+        the heap. *)
+    type t
+
+    val length : t -> int
+    val annotation : t -> int -> Annotation.t
+    val num_blocks : t -> int -> int
+    val num_words_including_headers : t -> int -> int
+
+  end
+
+  (** The timestamp of a snapshot.  The units are as for [Sys.time]
+      (unless custom timestamps are being provided, cf. the [Spacetime] module
+      in the standard library). *)
+  val timestamp : t -> float
+
+  val gc_stats : t -> Gc_stats.t
+  val entries : t -> Entries.t
+  val words_scanned : t -> int
+  val words_scanned_with_profinfo : t -> int
+
+  module Total_allocation : sig
+    type t
+
+    val annotation : t -> Annotation.t
+    val num_words_including_headers : t -> int
+    val next : t -> t option
+  end
+
+  (** Total allocations across *all threads*. *)
+  (* CR-someday mshinwell: change the relevant variables to be thread-local *)
+  val total_allocations : t -> Total_allocation.t option
+
+  module Event : sig
+    type t
+
+    val event_name : t -> string
+    val timestamp : t -> float
+  end
+
+  module Series : sig
+    type t
+
+    (** At present, the [Trace.t] associated with a [Series.t] cannot be
+        garbage collected or freed.  This should not be a problem, since
+        the intention is that a post-processor reads the trace and outputs
+        another format. *)
+    val read : path:string -> t
+
+    val time_of_writer_close : t -> float
+    val num_threads : t -> int
+
+    type trace_kind = Normal | Finaliser
+    val trace : t -> kind:trace_kind -> thread_index:int -> Trace.t option
+
+    val frame_table : t -> Frame_table.t
+    val shape_table : t -> Shape_table.t
+    val num_snapshots : t -> int
+    val snapshot : t -> index:int -> heap_snapshot
+    val events : t -> Event.t list
+
+    (** Returns [true] iff call count information was recorded in the
+        series. *)
+    val has_call_counts : t -> bool
+  end
+end
diff --git a/otherlibs/raw_spacetime_lib/spacetime_offline.c b/otherlibs/raw_spacetime_lib/spacetime_offline.c
new file mode 100644
index 00000000..d022c5de
--- /dev/null
+++ b/otherlibs/raw_spacetime_lib/spacetime_offline.c
@@ -0,0 +1,250 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*            Mark Shinwell and Leo White, Jane Street Europe             */
+/*                                                                        */
+/*   Copyright 2013--2016, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#define CAML_INTERNALS
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include <math.h>
+
+#include "caml/alloc.h"
+#include "caml/config.h"
+#include "caml/fail.h"
+#include "caml/gc.h"
+#include "caml/intext.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/signals.h"
+#include "caml/stack.h"
+#include "caml/sys.h"
+#include "caml/spacetime.h"
+
+#include "caml/s.h"
+
+#define SPACETIME_PROFINFO_WIDTH 26
+#define Spacetime_profinfo_hd(hd) \
+  (Gen_profinfo_hd(SPACETIME_PROFINFO_WIDTH, hd))
+
+#ifdef ARCH_SIXTYFOUR
+
+/* CR-someday lwhite: The following two definitions are copied from spacetime.c
+   because they are needed here, but must be inlined in spacetime.c
+   for performance. Perhaps a macro or "static inline" would be
+   more appropriate. */
+
+c_node* caml_spacetime_offline_c_node_of_stored_pointer_not_null
+          (value node_stored)
+{
+  CAMLassert(Is_c_node(node_stored));
+  return (c_node*) Hp_val(node_stored);
+}
+
+c_node_type caml_spacetime_offline_classify_c_node(c_node* node)
+{
+  return (node->pc & 2) ? CALL : ALLOCATION;
+}
+
+CAMLprim value caml_spacetime_compare_node(
+      value node1, value node2)
+{
+  CAMLassert(!Is_in_value_area(node1));
+  CAMLassert(!Is_in_value_area(node2));
+
+  if (node1 == node2) {
+    return Val_long(0);
+  }
+  if (node1 < node2) {
+    return Val_long(-1);
+  }
+  return Val_long(1);
+}
+
+CAMLprim value caml_spacetime_unmarshal_trie (value v_channel)
+{
+  return caml_input_value_to_outside_heap(v_channel);
+}
+
+CAMLprim value caml_spacetime_node_num_header_words(value unit)
+{
+  return Val_long(Node_num_header_words);
+}
+
+CAMLprim value caml_spacetime_is_ocaml_node(value node)
+{
+  CAMLassert(Is_ocaml_node(node) || Is_c_node(node));
+  return Val_bool(Is_ocaml_node(node));
+}
+
+CAMLprim value caml_spacetime_ocaml_function_identifier(value node)
+{
+  CAMLassert(Is_ocaml_node(node));
+  return caml_copy_int64((uint64_t) Decode_node_pc(Node_pc(node)));
+}
+
+CAMLprim value caml_spacetime_ocaml_tail_chain(value node)
+{
+  CAMLassert(Is_ocaml_node(node));
+  return Tail_link(node);
+}
+
+CAMLprim value caml_spacetime_classify_direct_call_point
+      (value node, value offset)
+{
+  uintnat field;
+  value callee_node;
+
+  CAMLassert(Is_ocaml_node(node));
+
+  field = Long_val(offset);
+
+  callee_node = Direct_callee_node(node, field);
+  if (!Is_block(callee_node)) {
+    /* An unused call point (may be a tail call point). */
+    return Val_long(0);
+  } else if (Is_ocaml_node(callee_node)) {
+    return Val_long(1);  /* direct call point to OCaml code */
+  } else {
+    return Val_long(2);  /* direct call point to non-OCaml code */
+  }
+}
+
+CAMLprim value caml_spacetime_ocaml_allocation_point_annotation
+      (value node, value offset)
+{
+  uintnat profinfo_shifted;
+  profinfo_shifted = (uintnat) Alloc_point_profinfo(node, Long_val(offset));
+  return Val_long(Spacetime_profinfo_hd(profinfo_shifted));
+}
+
+CAMLprim value caml_spacetime_ocaml_allocation_point_count
+      (value node, value offset)
+{
+  value count = Alloc_point_count(node, Long_val(offset));
+  CAMLassert(!Is_block(count));
+  return count;
+}
+
+CAMLprim value caml_spacetime_ocaml_direct_call_point_callee_node
+      (value node, value offset)
+{
+  return Direct_callee_node(node, Long_val(offset));
+}
+
+CAMLprim value caml_spacetime_ocaml_direct_call_point_call_count
+(value node, value offset)
+{
+  return Direct_call_count(node, Long_val(offset));
+}
+
+CAMLprim value caml_spacetime_ocaml_indirect_call_point_callees
+      (value node, value offset)
+{
+  value callees = Indirect_pc_linked_list(node, Long_val(offset));
+  CAMLassert(Is_block(callees));
+  CAMLassert(Is_c_node(callees));
+  return callees;
+}
+
+CAMLprim value caml_spacetime_c_node_is_call(value node)
+{
+  c_node* c_node;
+  CAMLassert(node != (value) NULL);
+  CAMLassert(Is_c_node(node));
+  c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
+  switch (caml_spacetime_offline_classify_c_node(c_node)) {
+    case CALL: return Val_true;
+    case ALLOCATION: return Val_false;
+  }
+  CAMLassert(0);
+  return Val_unit;  /* silence compiler warning */
+}
+
+CAMLprim value caml_spacetime_c_node_next(value node)
+{
+  c_node* c_node;
+
+  CAMLassert(node != (value) NULL);
+  CAMLassert(Is_c_node(node));
+  c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
+  CAMLassert(c_node->next == Val_unit || Is_c_node(c_node->next));
+  return c_node->next;
+}
+
+CAMLprim value caml_spacetime_c_node_call_site(value node)
+{
+  c_node* c_node;
+  CAMLassert(node != (value) NULL);
+  CAMLassert(Is_c_node(node));
+  c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
+  return caml_copy_int64((uint64_t) Decode_c_node_pc(c_node->pc));
+}
+
+CAMLprim value caml_spacetime_c_node_callee_node(value node)
+{
+  c_node* c_node;
+  CAMLassert(node != (value) NULL);
+  CAMLassert(Is_c_node(node));
+  c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
+  CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == CALL);
+  /* This might be an uninitialised tail call point: for example if an OCaml
+     callee was indirectly called but the callee wasn't instrumented (e.g. a
+     leaf function that doesn't allocate). */
+  if (Is_tail_caller_node_encoded(c_node->data.call.callee_node)) {
+    return Val_unit;
+  }
+  return c_node->data.call.callee_node;
+}
+
+CAMLprim value caml_spacetime_c_node_call_count(value node)
+{
+  c_node* c_node;
+  CAMLassert(node != (value) NULL);
+  CAMLassert(Is_c_node(node));
+  c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
+  CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == CALL);
+  if (Is_tail_caller_node_encoded(c_node->data.call.callee_node)) {
+    return Val_long(0);
+  }
+  return c_node->data.call.call_count;
+}
+
+CAMLprim value caml_spacetime_c_node_profinfo(value node)
+{
+  c_node* c_node;
+  CAMLassert(node != (value) NULL);
+  CAMLassert(Is_c_node(node));
+  c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
+  CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == ALLOCATION);
+  CAMLassert(!Is_block(c_node->data.allocation.profinfo));
+  return Val_long(Spacetime_profinfo_hd(c_node->data.allocation.profinfo));
+}
+
+CAMLprim value caml_spacetime_c_node_allocation_count(value node)
+{
+  c_node* c_node;
+  CAMLassert(node != (value) NULL);
+  CAMLassert(Is_c_node(node));
+  c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
+  CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == ALLOCATION);
+  CAMLassert(!Is_block(c_node->data.allocation.count));
+  return c_node->data.allocation.count;
+}
+
+#endif
diff --git a/otherlibs/str/.depend b/otherlibs/str/.depend
new file mode 100644
index 00000000..e9bdc28a
--- /dev/null
+++ b/otherlibs/str/.depend
@@ -0,0 +1,12 @@
+strstubs.$(O): strstubs.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/fail.h
+str.cmo : \
+    str.cmi
+str.cmx : \
+    str.cmi
+str.cmi :
diff --git a/otherlibs/str/Makefile b/otherlibs/str/Makefile
new file mode 100644
index 00000000..6b0f025e
--- /dev/null
+++ b/otherlibs/str/Makefile
@@ -0,0 +1,36 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# Makefile for the str library
+
+LIBNAME=str
+COBJS=strstubs.$(O)
+CLIBNAME=camlstr
+CAMLOBJS=str.cmo
+
+include ../Makefile.otherlibs.common
+str.cmo: str.cmi
+str.cmx: str.cmi
+
+.PHONY: depend
+depend:
+ifeq "$(TOOLCHAIN)" "msvc"
+	$(error Dependencies cannot be regenerated using the MSVC ports)
+else
+	$(CC) -MM $(OC_CPPFLAGS) *.c | sed -e 's/\.o/.$$(O)/g' > .depend
+	$(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml >> .depend
+endif
+
+include .depend
diff --git a/otherlibs/str/dune b/otherlibs/str/dune
new file mode 100644
index 00000000..0c96b638
--- /dev/null
+++ b/otherlibs/str/dune
@@ -0,0 +1,20 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+(library
+ (name str)
+ (modes byte)
+ (flags (:standard -nostdlib))
+ (libraries stdlib)
+ (c_names strstubs))
diff --git a/otherlibs/str/str.ml b/otherlibs/str/str.ml
new file mode 100644
index 00000000..6242be7f
--- /dev/null
+++ b/otherlibs/str/str.ml
@@ -0,0 +1,754 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* In this module, [@ocaml.warning "-3"] is used in several places
+   that use deprecated functions to preserve legacy behavior.
+   It overrides -w @3 given on the command line. *)
+
+(** String utilities *)
+
+let string_before s n = String.sub s 0 n
+
+let string_after s n = String.sub s n (String.length s - n)
+
+let first_chars s n = String.sub s 0 n
+
+let last_chars s n = String.sub s (String.length s - n) n
+
+(** Representation of character sets **)
+
+module Charset =
+  struct
+    type t = bytes (* of length 32 *)
+
+    (*let empty = Bytes.make 32 '\000'*)
+    let full = Bytes.make 32 '\255'
+
+    let make_empty () = Bytes.make 32 '\000'
+
+    let add s c =
+      let i = Char.code c in
+      Bytes.set s (i lsr 3)
+                (Char.chr (Char.code (Bytes.get s (i lsr 3))
+                           lor (1 lsl (i land 7))))
+
+    let add_range s c1 c2 =
+      for i = Char.code c1 to Char.code c2 do add s (Char.chr i) done
+
+    let singleton c =
+      let s = make_empty () in add s c; s
+
+    (*let range c1 c2 =
+      let s = make_empty () in add_range s c1 c2; s
+    *)
+    let complement s =
+      let r = Bytes.create 32 in
+      for i = 0 to 31 do
+        Bytes.set r i (Char.chr(Char.code (Bytes.get s i) lxor 0xFF))
+      done;
+      r
+
+    let union s1 s2 =
+      let r = Bytes.create 32 in
+      for i = 0 to 31 do
+        Bytes.set r i (Char.chr(Char.code (Bytes.get s1 i)
+                       lor Char.code (Bytes.get s2 i)))
+      done;
+      r
+
+    let disjoint s1 s2 =
+      try
+        for i = 0 to 31 do
+          if Char.code (Bytes.get s1 i) land Char.code (Bytes.get s2 i)
+             <> 0
+          then raise Exit
+        done;
+        true
+      with Exit ->
+        false
+
+    let iter fn s =
+      for i = 0 to 31 do
+        let c = Char.code (Bytes.get s i) in
+        if c <> 0 then
+          for j = 0 to 7 do
+            if c land (1 lsl j) <> 0 then fn (Char.chr ((i lsl 3) + j))
+          done
+      done
+
+    let expand s =
+      let r = Bytes.make 256 '\000' in
+      iter (fun c -> Bytes.set r (Char.code c) '\001') s;
+      r
+
+    let fold_case s =
+      (let r = make_empty() in
+       iter (fun c -> add r (Char.lowercase c); add r (Char.uppercase c)) s;
+       r)[@ocaml.warning "-3"]
+
+  end
+
+(** Abstract syntax tree for regular expressions *)
+
+type re_syntax =
+    Char of char
+  | String of string
+  | CharClass of Charset.t * bool  (* true = complemented, false = normal *)
+  | Seq of re_syntax list
+  | Alt of re_syntax * re_syntax
+  | Star of re_syntax
+  | Plus of re_syntax
+  | Option of re_syntax
+  | Group of int * re_syntax
+  | Refgroup of int
+  | Bol
+  | Eol
+  | Wordboundary
+
+(** Representation of compiled regular expressions *)
+
+type regexp = {
+  prog: int array;         (* bytecode instructions *)
+  cpool: string array;     (* constant pool (string literals) *)
+  normtable: string;       (* case folding table (if any) *)
+  numgroups: int;          (* number of \(...\) groups *)
+  numregisters: int;       (* number of nullable Star or Plus *)
+  startchars: int          (* index of set of starting chars, or -1 if none *)
+}
+
+(** Opcodes for bytecode instructions; see strstubs.c for description *)
+
+let op_CHAR = 0
+let op_CHARNORM = 1
+let op_STRING = 2
+let op_STRINGNORM = 3
+let op_CHARCLASS = 4
+let op_BOL = 5
+let op_EOL = 6
+let op_WORDBOUNDARY = 7
+let op_BEGGROUP = 8
+let op_ENDGROUP = 9
+let op_REFGROUP = 10
+let op_ACCEPT = 11
+let op_SIMPLEOPT = 12
+let op_SIMPLESTAR = 13
+let op_SIMPLEPLUS = 14
+let op_GOTO = 15
+let op_PUSHBACK = 16
+let op_SETMARK = 17
+let op_CHECKPROGRESS = 18
+
+(* Encoding of bytecode instructions *)
+
+let instr opc arg = opc lor (arg lsl 8)
+
+(* Computing relative displacements for GOTO and PUSHBACK instructions *)
+
+let displ dest from = dest - from - 1
+
+(** Compilation of a regular expression *)
+
+(* Determine if a regexp can match the empty string *)
+
+let rec is_nullable = function
+    Char _ -> false
+  | String s -> s = ""
+  | CharClass _ -> false
+  | Seq rl -> List.for_all is_nullable rl
+  | Alt (r1, r2) -> is_nullable r1 || is_nullable r2
+  | Star _ -> true
+  | Plus r -> is_nullable r
+  | Option _ -> true
+  | Group(_, r) -> is_nullable r
+  | Refgroup _ -> true
+  | Bol -> true
+  | Eol -> true
+  | Wordboundary -> true
+
+(* first r returns a set of characters C such that:
+     for all string s, s matches r => the first character of s is in C.
+   For convenience, return Charset.full if r is nullable. *)
+
+let rec first = function
+    Char c -> Charset.singleton c
+  | String s -> if s = "" then Charset.full else Charset.singleton s.[0]
+  | CharClass(cl, cmpl) -> if cmpl then Charset.complement cl else cl
+  | Seq rl -> first_seq rl
+  | Alt (r1, r2) -> Charset.union (first r1) (first r2)
+  | Star _ -> Charset.full
+  | Plus r -> first r
+  | Option _ -> Charset.full
+  | Group(_, r) -> first r
+  | Refgroup _ -> Charset.full
+  | Bol -> Charset.full
+  | Eol -> Charset.full
+  | Wordboundary -> Charset.full
+
+and first_seq = function
+    [] -> Charset.full
+  | (Bol | Eol | Wordboundary) :: rl -> first_seq rl
+  | Star r :: rl -> Charset.union (first r) (first_seq rl)
+  | Option r :: rl -> Charset.union (first r) (first_seq rl)
+  | r :: _ -> first r
+
+(* Transform a Char or CharClass regexp into a character class *)
+
+let charclass_of_regexp fold_case re =
+  let (cl1, compl) =
+    match re with
+    | Char c -> (Charset.singleton c, false)
+    | CharClass(cl, compl) -> (cl, compl)
+    | _ -> assert false in
+  let cl2 = if fold_case then Charset.fold_case cl1 else cl1 in
+  Bytes.to_string (if compl then Charset.complement cl2 else cl2)
+
+(* The case fold table: maps characters to their lowercase equivalent *)
+
+let fold_case_table =
+  (let t = Bytes.create 256 in
+   for i = 0 to 255 do Bytes.set t i (Char.lowercase(Char.chr i)) done;
+   Bytes.to_string t)[@ocaml.warning "-3"]
+
+module StringMap =
+  Map.Make(struct type t = string let compare (x:t) y = compare x y end)
+
+(* Compilation of a regular expression *)
+
+let compile fold_case re =
+
+  (* Instruction buffering *)
+  let prog = ref (Array.make 32 0)
+  and progpos = ref 0
+  and cpool = ref StringMap.empty
+  and cpoolpos = ref 0
+  and numgroups = ref 1
+  and numregs = ref 0 in
+  (* Add a new instruction *)
+  let emit_instr opc arg =
+    if !progpos >= Array.length !prog then begin
+      let newlen = ref (Array.length !prog) in
+      while !progpos >= !newlen do newlen := !newlen * 2 done;
+      let nprog = Array.make !newlen 0 in
+      Array.blit !prog 0 nprog 0 (Array.length !prog);
+      prog := nprog
+    end;
+    (!prog).(!progpos) <- (instr opc arg);
+    incr progpos in
+  (* Reserve an instruction slot and return its position *)
+  let emit_hole () =
+    let p = !progpos in emit_instr op_CHAR 0; p in
+  (* Fill a reserved instruction slot with a GOTO or PUSHBACK instruction *)
+  let patch_instr pos opc dest =
+    (!prog).(pos) <- (instr opc (displ dest pos)) in
+  (* Return the cpool index for the given string, adding it if not
+     already there *)
+  let cpool_index s =
+    try
+      StringMap.find s !cpool
+    with Not_found ->
+      let p = !cpoolpos in
+      cpool := StringMap.add s p !cpool;
+      incr cpoolpos;
+      p in
+  (* Allocate fresh register if regexp is nullable *)
+  let allocate_register_if_nullable r =
+    if is_nullable r then begin
+      let n = !numregs in
+      if n >= 64 then failwith "too many r* or r+ where r is nullable";
+      incr numregs;
+      n
+    end else
+      -1 in
+  (* Main recursive compilation function *)
+  let rec emit_code = function
+    Char c ->
+      if fold_case then
+        emit_instr op_CHARNORM (Char.code (Char.lowercase c))
+          [@ocaml.warning "-3"]
+      else
+        emit_instr op_CHAR (Char.code c)
+  | String s ->
+      begin match String.length s with
+        0 -> ()
+      | 1 ->
+        if fold_case then
+          emit_instr op_CHARNORM (Char.code (Char.lowercase s.[0]))
+            [@ocaml.warning "-3"]
+        else
+          emit_instr op_CHAR (Char.code s.[0])
+      | _ ->
+        try
+          (* null characters are not accepted by the STRING* instructions;
+             if one is found, split string at null character *)
+          let i = String.index s '\000' in
+          emit_code (String (string_before s i));
+          emit_instr op_CHAR 0;
+          emit_code (String (string_after s (i+1)))
+        with Not_found ->
+          if fold_case then
+            emit_instr op_STRINGNORM (cpool_index (String.lowercase s))
+              [@ocaml.warning "-3"]
+          else
+            emit_instr op_STRING (cpool_index s)
+      end
+  | CharClass(cl, compl) ->
+      let cl1 = if fold_case then Charset.fold_case cl else cl in
+      let cl2 = if compl then Charset.complement cl1 else cl1 in
+      emit_instr op_CHARCLASS (cpool_index (Bytes.to_string cl2))
+  | Seq rl ->
+      emit_seq_code rl
+  | Alt(r1, r2) ->
+      (*      PUSHBACK lbl1
+              <match r1>
+              GOTO lbl2
+        lbl1: <match r2>
+        lbl2: ... *)
+      let pos_pushback = emit_hole() in
+      emit_code r1;
+      let pos_goto_end = emit_hole() in
+      let lbl1 = !progpos in
+      emit_code r2;
+      let lbl2 = !progpos in
+      patch_instr pos_pushback op_PUSHBACK lbl1;
+      patch_instr pos_goto_end op_GOTO lbl2
+  | Star r ->
+      (* Implement longest match semantics for compatibility with old Str *)
+      (* General translation:
+           lbl1: PUSHBACK lbl2
+                 SETMARK regno
+                 <match r>
+                 CHECKPROGRESS regno
+                 GOTO lbl1
+           lbl2:
+         If r cannot match the empty string, code can be simplified:
+           lbl1: PUSHBACK lbl2
+                 <match r>
+                 GOTO lbl1
+           lbl2:
+        *)
+      let regno = allocate_register_if_nullable r in
+      let lbl1 = emit_hole() in
+      if regno >= 0 then emit_instr op_SETMARK regno;
+      emit_code r;
+      if regno >= 0 then emit_instr op_CHECKPROGRESS regno;
+      emit_instr op_GOTO (displ lbl1 !progpos);
+      let lbl2 = !progpos in
+      patch_instr lbl1 op_PUSHBACK lbl2
+  | Plus r ->
+      (* Implement longest match semantics for compatibility with old Str *)
+      (* General translation:
+           lbl1: <match r>
+                 CHECKPROGRESS regno
+                 PUSHBACK lbl2
+                 SETMARK regno
+                 GOTO lbl1
+           lbl2:
+         If r cannot match the empty string, code can be simplified:
+           lbl1: <match r>
+                 PUSHBACK lbl2
+                 GOTO_PLUS lbl1
+           lbl2:
+      *)
+      let regno = allocate_register_if_nullable r in
+      let lbl1 = !progpos in
+      emit_code r;
+      if regno >= 0 then emit_instr op_CHECKPROGRESS regno;
+      let pos_pushback = emit_hole() in
+      if regno >= 0 then emit_instr op_SETMARK regno;
+      emit_instr op_GOTO (displ lbl1 !progpos);
+      let lbl2 = !progpos in
+      patch_instr pos_pushback op_PUSHBACK lbl2
+  | Option r ->
+      (* Implement longest match semantics for compatibility with old Str *)
+      (*      PUSHBACK lbl
+              <match r>
+         lbl:
+      *)
+      let pos_pushback = emit_hole() in
+      emit_code r;
+      let lbl = !progpos in
+      patch_instr pos_pushback op_PUSHBACK lbl
+  | Group(n, r) ->
+      emit_instr op_BEGGROUP n;
+      emit_code r;
+      emit_instr op_ENDGROUP n;
+      numgroups := max !numgroups (n+1)
+  | Refgroup n ->
+      emit_instr op_REFGROUP n;
+      numgroups := max !numgroups (n+1)
+  | Bol ->
+      emit_instr op_BOL 0
+  | Eol ->
+      emit_instr op_EOL 0
+  | Wordboundary ->
+      emit_instr op_WORDBOUNDARY 0
+
+  and emit_seq_code = function
+    [] -> ()
+  | Star(Char _ | CharClass _ as r) :: rl
+    when disjoint_modulo_case (first r) (first_seq rl) ->
+      emit_instr op_SIMPLESTAR (cpool_index (charclass_of_regexp fold_case r));
+      emit_seq_code rl
+  | Plus(Char _ | CharClass _ as r) :: rl
+    when disjoint_modulo_case (first r) (first_seq rl) ->
+      emit_instr op_SIMPLEPLUS (cpool_index (charclass_of_regexp fold_case r));
+      emit_seq_code rl
+  | Option(Char _ | CharClass _ as r) :: rl
+    when disjoint_modulo_case (first r) (first_seq rl) ->
+      emit_instr op_SIMPLEOPT (cpool_index (charclass_of_regexp fold_case r));
+      emit_seq_code rl
+  | r :: rl ->
+      emit_code r;
+      emit_seq_code rl
+
+  and disjoint_modulo_case c1 c2 =
+    if fold_case
+    then Charset.disjoint (Charset.fold_case c1) (Charset.fold_case c2)
+    else Charset.disjoint c1 c2
+  in
+
+  emit_code re;
+  emit_instr op_ACCEPT 0;
+  let start = first re in
+  let start' = if fold_case then Charset.fold_case start else start in
+  let start_pos =
+    if start = Charset.full
+    then -1
+    else cpool_index (Bytes.to_string (Charset.expand start')) in
+  let constantpool = Array.make !cpoolpos "" in
+  StringMap.iter (fun str idx -> constantpool.(idx) <- str) !cpool;
+  { prog = Array.sub !prog 0 !progpos;
+    cpool = constantpool;
+    normtable = if fold_case then fold_case_table else "";
+    numgroups = !numgroups;
+    numregisters = !numregs;
+    startchars = start_pos }
+
+(** Parsing of a regular expression *)
+
+(* Efficient buffering of sequences *)
+
+module SeqBuffer = struct
+
+  type t = { sb_chars: Buffer.t; mutable sb_next: re_syntax list }
+
+  let create() = { sb_chars = Buffer.create 16; sb_next = [] }
+
+  let flush buf =
+    let s = Buffer.contents buf.sb_chars in
+    Buffer.clear buf.sb_chars;
+    match String.length s with
+      0 -> ()
+    | 1 -> buf.sb_next <- Char s.[0] :: buf.sb_next
+    | _ -> buf.sb_next <- String s :: buf.sb_next
+
+  let add buf re =
+    match re with
+      Char c -> Buffer.add_char buf.sb_chars c
+    | _ -> flush buf; buf.sb_next <- re :: buf.sb_next
+
+  let extract buf =
+    flush buf; Seq(List.rev buf.sb_next)
+
+end
+
+(* The character class corresponding to `.' *)
+
+let dotclass = Charset.complement (Charset.singleton '\n')
+
+(* Parse a regular expression *)
+
+let parse s =
+  let len = String.length s in
+  let group_counter = ref 1 in
+
+  let rec regexp0 i =
+    let (r, j) = regexp1 i in
+    regexp0cont r j
+  and regexp0cont r1 i =
+    if i + 2 <= len && s.[i] = '\\' && s.[i+1] = '|' then
+      let (r2, j) = regexp1 (i+2) in
+      regexp0cont (Alt(r1, r2)) j
+    else
+      (r1, i)
+  and regexp1 i =
+    regexp1cont (SeqBuffer.create()) i
+  and regexp1cont sb i =
+    if i >= len
+    || i + 2 <= len && s.[i] = '\\' && (let c = s.[i+1] in c = '|' || c = ')')
+    then
+      (SeqBuffer.extract sb, i)
+    else
+      let (r, j) = regexp2 i in
+      SeqBuffer.add sb r;
+      regexp1cont sb j
+  and regexp2 i =
+    let (r, j) = regexp3 i in
+    regexp2cont r j
+  and regexp2cont r i =
+    if i >= len then (r, i) else
+      match s.[i] with
+        '?' -> regexp2cont (Option r) (i+1)
+      | '*' -> regexp2cont (Star r) (i+1)
+      | '+' -> regexp2cont (Plus r) (i+1)
+      |  _  -> (r, i)
+  and regexp3 i =
+    match s.[i] with
+      '\\' -> regexpbackslash (i+1)
+    | '['  -> let (c, compl, j) = regexpclass0 (i+1) in
+              (CharClass(c, compl), j)
+    | '^'  -> (Bol, i+1)
+    | '$'  -> (Eol, i+1)
+    | '.'  -> (CharClass(dotclass, false), i+1)
+    | c    -> (Char c, i+1)
+  and regexpbackslash i =
+    if i >= len then (Char '\\', i) else
+      match s.[i] with
+        '|' | ')' ->
+          assert false
+      | '(' ->
+          let group_no = !group_counter in
+          incr group_counter;
+          let (r, j) = regexp0 (i+1) in
+          if j + 1 < len && s.[j] = '\\' && s.[j+1] = ')' then
+            (Group(group_no, r), j + 2)
+          else
+            failwith "\\( group not closed by \\)"
+      | '1' .. '9' as c ->
+          (Refgroup(Char.code c - 48), i + 1)
+      | 'b' ->
+          (Wordboundary, i + 1)
+      | c ->
+          (Char c, i + 1)
+  and regexpclass0 i =
+    if i < len && s.[i] = '^'
+    then let (c, j) = regexpclass1 (i+1) in (c, true, j)
+    else let (c, j) = regexpclass1 i in (c, false, j)
+  and regexpclass1 i =
+    let c = Charset.make_empty() in
+    let j = regexpclass2 c i i in
+    (c, j)
+  and regexpclass2 c start i =
+    if i >= len then failwith "[ class not closed by ]";
+    if s.[i] = ']' && i > start then i+1 else begin
+      let c1 = s.[i] in
+      if i+2 < len && s.[i+1] = '-' && s.[i+2] <> ']' then begin
+        let c2 = s.[i+2] in
+        Charset.add_range c c1 c2;
+        regexpclass2 c start (i+3)
+      end else begin
+        Charset.add c c1;
+        regexpclass2 c start (i+1)
+      end
+    end in
+
+  let (r, j) = regexp0 0 in
+  if j = len then r else failwith "spurious \\) in regular expression"
+
+(** Parsing and compilation *)
+
+let regexp e = compile false (parse e)
+
+let regexp_case_fold e = compile true (parse e)
+
+let quote s =
+  let len = String.length s in
+  let buf = Bytes.create (2 * len) in
+  let pos = ref 0 in
+  for i = 0 to len - 1 do
+    match s.[i] with
+      '[' | ']' | '*' | '.' | '\\' | '?' | '+' | '^' | '$' as c ->
+        Bytes.set buf !pos '\\';
+        Bytes.set buf (!pos + 1) c;
+        pos := !pos + 2
+    | c ->
+        Bytes.set buf !pos c;
+        pos := !pos + 1
+  done;
+  Bytes.sub_string buf 0 !pos
+
+let regexp_string s = compile false (String s)
+
+let regexp_string_case_fold s = compile true (String s)
+
+(** Matching functions **)
+
+external re_string_match: regexp -> string -> int -> int array
+     = "re_string_match"
+external re_partial_match: regexp -> string -> int -> int array
+     = "re_partial_match"
+external re_search_forward: regexp -> string -> int -> int array
+     = "re_search_forward"
+external re_search_backward: regexp -> string -> int -> int array
+     = "re_search_backward"
+
+let last_search_result = ref [||]
+
+let string_match re s pos =
+  let res = re_string_match re s pos in
+  last_search_result := res;
+  Array.length res > 0
+
+let string_partial_match re s pos =
+  let res = re_partial_match re s pos in
+  last_search_result := res;
+  Array.length res > 0
+
+let search_forward re s pos =
+  let res = re_search_forward re s pos in
+  last_search_result := res;
+  if Array.length res = 0 then raise Not_found else res.(0)
+
+let search_backward re s pos =
+  let res = re_search_backward re s pos in
+  last_search_result := res;
+  if Array.length res = 0 then raise Not_found else res.(0)
+
+let group_beginning n =
+  let n2 = n + n in
+  if n < 0 || n2 >= Array.length !last_search_result then
+    invalid_arg "Str.group_beginning"
+  else
+    let pos = !last_search_result.(n2) in
+    if pos = -1 then raise Not_found else pos
+
+let group_end n =
+  let n2 = n + n in
+  if n < 0 || n2 >= Array.length !last_search_result then
+    invalid_arg "Str.group_end"
+  else
+    let pos = !last_search_result.(n2 + 1) in
+    if pos = -1 then raise Not_found else pos
+
+let matched_group n txt =
+  let n2 = n + n in
+  if n < 0 || n2 >= Array.length !last_search_result then
+    invalid_arg "Str.matched_group"
+  else
+    let b = !last_search_result.(n2)
+    and e = !last_search_result.(n2 + 1) in
+    if b = -1 then raise Not_found else String.sub txt b (e - b)
+
+let match_beginning () = group_beginning 0
+and match_end () = group_end 0
+and matched_string txt = matched_group 0 txt
+
+(** Replacement **)
+
+external re_replacement_text: string -> int array -> string -> string
+    = "re_replacement_text"
+
+let replace_matched repl matched =
+  re_replacement_text repl !last_search_result matched
+
+let substitute_first expr repl_fun text =
+  try
+    let pos = search_forward expr text 0 in
+    String.concat "" [string_before text pos;
+                      repl_fun text;
+                      string_after text (match_end())]
+  with Not_found ->
+    text
+
+let opt_search_forward re s pos =
+  try Some(search_forward re s pos) with Not_found -> None
+
+let global_substitute expr repl_fun text =
+  let rec replace accu start last_was_empty =
+    let startpos = if last_was_empty then start + 1 else start in
+    if startpos > String.length text then
+      string_after text start :: accu
+    else
+      match opt_search_forward expr text startpos with
+      | None ->
+          string_after text start :: accu
+      | Some pos ->
+          let end_pos = match_end() in
+          let repl_text = repl_fun text in
+          replace (repl_text :: String.sub text start (pos-start) :: accu)
+                  end_pos (end_pos = pos)
+  in
+    String.concat "" (List.rev (replace [] 0 false))
+
+let global_replace expr repl text =
+  global_substitute expr (replace_matched repl) text
+and replace_first expr repl text =
+  substitute_first expr (replace_matched repl) text
+
+(** Splitting *)
+
+let opt_search_forward_progress expr text start =
+  match opt_search_forward expr text start with
+  | None -> None
+  | Some pos ->
+      if match_end() > start then
+        Some pos
+      else if start < String.length text then
+        opt_search_forward expr text (start + 1)
+      else None
+
+let bounded_split expr text num =
+  let start =
+    if string_match expr text 0 then match_end() else 0 in
+  let rec split accu start n =
+    if start >= String.length text then accu else
+    if n = 1 then string_after text start :: accu else
+      match opt_search_forward_progress expr text start with
+      | None ->
+          string_after text start :: accu
+      | Some pos ->
+          split (String.sub text start (pos-start) :: accu)
+                (match_end()) (n-1)
+  in
+    List.rev (split [] start num)
+
+let split expr text = bounded_split expr text 0
+
+let bounded_split_delim expr text num =
+  let rec split accu start n =
+    if start > String.length text then accu else
+    if n = 1 then string_after text start :: accu else
+      match opt_search_forward_progress expr text start with
+      | None ->
+          string_after text start :: accu
+      | Some pos ->
+          split (String.sub text start (pos-start) :: accu)
+                (match_end()) (n-1)
+  in
+    if text = "" then [] else List.rev (split [] 0 num)
+
+let split_delim expr text = bounded_split_delim expr text 0
+
+type split_result = Text of string | Delim of string
+
+let bounded_full_split expr text num =
+  let rec split accu start n =
+    if start >= String.length text then accu else
+    if n = 1 then Text(string_after text start) :: accu else
+      match opt_search_forward_progress expr text start with
+      | None ->
+          Text(string_after text start) :: accu
+      | Some pos ->
+          let s = matched_string text in
+          if pos > start then
+            split (Delim(s) :: Text(String.sub text start (pos-start)) :: accu)
+                  (match_end()) (n-1)
+          else
+            split (Delim(s) :: accu)
+                  (match_end()) (n-1)
+  in
+    List.rev (split [] 0 num)
+
+let full_split expr text = bounded_full_split expr text 0
diff --git a/otherlibs/str/str.mli b/otherlibs/str/str.mli
new file mode 100644
index 00000000..d8299bbe
--- /dev/null
+++ b/otherlibs/str/str.mli
@@ -0,0 +1,291 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Regular expressions and high-level string processing *)
+
+
+(** {1 Regular expressions} *)
+
+
+type regexp
+(** The type of compiled regular expressions. *)
+
+
+val regexp : string -> regexp
+(** Compile a regular expression. The following constructs are
+    recognized:
+   - [.     ] Matches any character except newline.
+   - [*     ] (postfix) Matches the preceding expression zero, one or
+              several times
+   - [+     ] (postfix) Matches the preceding expression one or
+              several times
+   - [?     ] (postfix) Matches the preceding expression once or
+              not at all
+   - [[..]  ] Character set. Ranges are denoted with [-], as in [[a-z]].
+              An initial [^], as in [[^0-9]], complements the set.
+              To include a [\]] character in a set, make it the first
+              character of the set. To include a [-] character in a set,
+              make it the first or the last character of the set.
+   - [^     ] Matches at beginning of line: either at the beginning of
+              the matched string, or just after a '\n' character.
+   - [$     ] Matches at end of line: either at the end of the matched
+              string, or just before a '\n' character.
+   - [\|    ] (infix) Alternative between two expressions.
+   - [\(..\)] Grouping and naming of the enclosed expression.
+   - [\1    ] The text matched by the first [\(...\)] expression
+     ([\2] for the second expression, and so on up to [\9]).
+   - [\b    ] Matches word boundaries.
+   - [\     ] Quotes special characters.  The special characters
+              are [$^\.*+?[]].
+
+   Note: the argument to [regexp] is usually a string literal. In this
+   case, any backslash character in the regular expression must be
+   doubled to make it past the OCaml string parser. For example, the
+   following expression:
+   {[ let r = Str.regexp "hello \\([A-Za-z]+\\)" in
+      Str.replace_first r "\\1" "hello world" ]}
+   returns the string ["world"].
+
+   In particular, if you want a regular expression that matches a single
+   backslash character, you need to quote it in the argument to [regexp]
+   (according to the last item of the list above) by adding a second
+   backslash. Then you need to quote both backslashes (according to the
+   syntax of string constants in OCaml) by doubling them again, so you
+   need to write four backslash characters: [Str.regexp "\\\\"].
+*)
+
+val regexp_case_fold : string -> regexp
+(** Same as [regexp], but the compiled expression will match text
+    in a case-insensitive way: uppercase and lowercase letters will
+    be considered equivalent. *)
+
+val quote : string -> string
+(** [Str.quote s] returns a regexp string that matches exactly
+   [s] and nothing else. *)
+
+val regexp_string : string -> regexp
+(** [Str.regexp_string s] returns a regular expression
+   that matches exactly [s] and nothing else.*)
+
+val regexp_string_case_fold : string -> regexp
+(** [Str.regexp_string_case_fold] is similar to {!Str.regexp_string},
+   but the regexp matches in a case-insensitive way. *)
+
+
+(** {1 String matching and searching} *)
+
+
+val string_match : regexp -> string -> int -> bool
+(** [string_match r s start] tests whether a substring of [s] that
+   starts at position [start] matches the regular expression [r].
+   The first character of a string has position [0], as usual. *)
+
+val search_forward : regexp -> string -> int -> int
+(** [search_forward r s start] searches the string [s] for a substring
+   matching the regular expression [r]. The search starts at position
+   [start] and proceeds towards the end of the string.
+   Return the position of the first character of the matched
+   substring.
+   @raise Not_found if no substring matches. *)
+
+val search_backward : regexp -> string -> int -> int
+(** [search_backward r s last] searches the string [s] for a
+  substring matching the regular expression [r]. The search first
+  considers substrings that start at position [last] and proceeds
+  towards the beginning of string. Return the position of the first
+  character of the matched substring.
+  @raise Not_found if no substring matches. *)
+
+val string_partial_match : regexp -> string -> int -> bool
+(** Similar to {!Str.string_match}, but also returns true if
+   the argument string is a prefix of a string that matches.
+   This includes the case of a true complete match. *)
+
+val matched_string : string -> string
+(** [matched_string s] returns the substring of [s] that was matched
+   by the last call to one of the following matching or searching
+   functions:
+   - {!Str.string_match}
+   - {!Str.search_forward}
+   - {!Str.search_backward}
+   - {!Str.string_partial_match}
+   - {!Str.global_substitute}
+   - {!Str.substitute_first}
+
+   provided that none of the following functions was called in between:
+   - {!Str.global_replace}
+   - {!Str.replace_first}
+   - {!Str.split}
+   - {!Str.bounded_split}
+   - {!Str.split_delim}
+   - {!Str.bounded_split_delim}
+   - {!Str.full_split}
+   - {!Str.bounded_full_split}
+
+   Note: in the case of [global_substitute] and [substitute_first],
+   a call to [matched_string] is only valid within the [subst] argument,
+   not after [global_substitute] or [substitute_first] returns.
+
+   The user must make sure that the parameter [s] is the same string
+   that was passed to the matching or searching function. *)
+
+val match_beginning : unit -> int
+(** [match_beginning()] returns the position of the first character
+   of the substring that was matched by the last call to a matching
+   or searching function (see {!Str.matched_string} for details). *)
+
+val match_end : unit -> int
+(** [match_end()] returns the position of the character following the
+   last character of the substring that was matched by the last call
+   to a matching or searching function (see {!Str.matched_string} for
+   details). *)
+
+val matched_group : int -> string -> string
+(** [matched_group n s] returns the substring of [s] that was matched
+   by the [n]th group [\(...\)] of the regular expression that was
+   matched by the last call to a matching or searching function (see
+   {!Str.matched_string} for details).
+   The user must make sure that the parameter [s] is the same string
+   that was passed to the matching or searching function.
+   @raise Not_found if the [n]th group
+   of the regular expression was not matched.  This can happen
+   with groups inside alternatives [\|], options [?]
+   or repetitions [*].  For instance, the empty string will match
+   [\(a\)*], but [matched_group 1 ""] will raise [Not_found]
+   because the first group itself was not matched. *)
+
+val group_beginning : int -> int
+(** [group_beginning n] returns the position of the first character
+   of the substring that was matched by the [n]th group of
+   the regular expression that was matched by the last call to a
+   matching or searching function (see {!Str.matched_string} for details).
+   @raise Not_found if the [n]th group of the regular expression
+   was not matched.
+   @raise Invalid_argument if there are fewer than [n] groups in
+   the regular expression. *)
+
+val group_end : int -> int
+(** [group_end n] returns
+   the position of the character following the last character of
+   substring that was matched by the [n]th group of the regular
+   expression that was matched by the last call to a matching or
+   searching function (see {!Str.matched_string} for details).
+   @raise Not_found if the [n]th group of the regular expression
+   was not matched.
+   @raise Invalid_argument if there are fewer than [n] groups in
+   the regular expression. *)
+
+
+(** {1 Replacement} *)
+
+
+val global_replace : regexp -> string -> string -> string
+(** [global_replace regexp templ s] returns a string identical to [s],
+   except that all substrings of [s] that match [regexp] have been
+   replaced by [templ]. The replacement template [templ] can contain
+   [\1], [\2], etc; these sequences will be replaced by the text
+   matched by the corresponding group in the regular expression.
+   [\0] stands for the text matched by the whole regular expression. *)
+
+val replace_first : regexp -> string -> string -> string
+(** Same as {!Str.global_replace}, except that only the first substring
+   matching the regular expression is replaced. *)
+
+val global_substitute : regexp -> (string -> string) -> string -> string
+(** [global_substitute regexp subst s] returns a string identical
+   to [s], except that all substrings of [s] that match [regexp]
+   have been replaced by the result of function [subst]. The
+   function [subst] is called once for each matching substring,
+   and receives [s] (the whole text) as argument. *)
+
+val substitute_first : regexp -> (string -> string) -> string -> string
+(** Same as {!Str.global_substitute}, except that only the first substring
+   matching the regular expression is replaced. *)
+
+val replace_matched : string -> string -> string
+(** [replace_matched repl s] returns the replacement text [repl]
+   in which [\1], [\2], etc. have been replaced by the text
+   matched by the corresponding groups in the regular expression
+   that was matched by the last call to a matching or searching
+   function (see {!Str.matched_string} for details).
+   [s] must be the same string that was passed to the matching or
+   searching function. *)
+
+
+(** {1 Splitting} *)
+
+
+val split : regexp -> string -> string list
+(** [split r s] splits [s] into substrings, taking as delimiters
+   the substrings that match [r], and returns the list of substrings.
+   For instance, [split (regexp "[ \t]+") s] splits [s] into
+   blank-separated words.  An occurrence of the delimiter at the
+   beginning or at the end of the string is ignored. *)
+
+val bounded_split : regexp -> string -> int -> string list
+(** Same as {!Str.split}, but splits into at most [n] substrings,
+   where [n] is the extra integer parameter. *)
+
+val split_delim : regexp -> string -> string list
+(** Same as {!Str.split} but occurrences of the
+   delimiter at the beginning and at the end of the string are
+   recognized and returned as empty strings in the result.
+   For instance, [split_delim (regexp " ") " abc "]
+   returns [[""; "abc"; ""]], while [split] with the same
+   arguments returns [["abc"]]. *)
+
+val bounded_split_delim : regexp -> string -> int -> string list
+(** Same as {!Str.bounded_split}, but occurrences of the
+   delimiter at the beginning and at the end of the string are
+   recognized and returned as empty strings in the result. *)
+
+type split_result =
+    Text of string
+  | Delim of string
+
+val full_split : regexp -> string -> split_result list
+(** Same as {!Str.split_delim}, but returns
+   the delimiters as well as the substrings contained between
+   delimiters.  The former are tagged [Delim] in the result list;
+   the latter are tagged [Text].  For instance,
+   [full_split (regexp "[{}]") "{ab}"] returns
+   [[Delim "{"; Text "ab"; Delim "}"]]. *)
+
+val bounded_full_split : regexp -> string -> int -> split_result list
+(** Same as {!Str.bounded_split_delim}, but returns
+   the delimiters as well as the substrings contained between
+   delimiters.  The former are tagged [Delim] in the result list;
+   the latter are tagged [Text]. *)
+
+
+(** {1 Extracting substrings} *)
+
+
+val string_before : string -> int -> string
+(** [string_before s n] returns the substring of all characters of [s]
+   that precede position [n] (excluding the character at
+   position [n]). *)
+
+val string_after : string -> int -> string
+(** [string_after s n] returns the substring of all characters of [s]
+   that follow position [n] (including the character at
+   position [n]). *)
+
+val first_chars : string -> int -> string
+(** [first_chars s n] returns the first [n] characters of [s].
+   This is the same function as {!Str.string_before}. *)
+
+val last_chars : string -> int -> string
+(** [last_chars s n] returns the last [n] characters of [s]. *)
diff --git a/otherlibs/str/strstubs.c b/otherlibs/str/strstubs.c
new file mode 100644
index 00000000..51d7b796
--- /dev/null
+++ b/otherlibs/str/strstubs.c
@@ -0,0 +1,547 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <string.h>
+#include <ctype.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+
+/* The backtracking NFA interpreter */
+
+union backtrack_point {
+  struct {
+    value * pc;                 /* with low bit set */
+    unsigned char * txt;
+  } pos;
+  struct {
+    unsigned char ** loc;       /* with low bit clear */
+    unsigned char * val;
+  } undo;
+};
+
+#define Set_tag(p) ((value *) ((intnat)(p) | 1))
+#define Clear_tag(p) ((value *) ((intnat)(p) & ~1))
+#define Tag_is_set(p) ((intnat)(p) & 1)
+
+#define BACKTRACK_STACK_BLOCK_SIZE 500
+
+struct backtrack_stack {
+  struct backtrack_stack * previous;
+  union backtrack_point point[BACKTRACK_STACK_BLOCK_SIZE];
+};
+
+#define Opcode(x) ((x) & 0xFF)
+#define Arg(x) ((uintnat)(x) >> 8)
+#define SignedArg(x) ((intnat)(x) >> 8)
+
+enum {
+  CHAR,       /* match a single character */
+  CHARNORM,   /* match a single character, after normalization */
+  STRING,     /* match a character string */
+  STRINGNORM, /* match a character string, after normalization */
+  CHARCLASS,  /* match a character class */
+  BOL,        /* match at beginning of line */
+  EOL,        /* match at end of line */
+  WORDBOUNDARY, /* match on a word boundary */
+  BEGGROUP,   /* record the beginning of a group */
+  ENDGROUP,   /* record the end of a group */
+  REFGROUP,   /* match a previously matched group */
+  ACCEPT,     /* report success */
+  SIMPLEOPT,  /* match a character class 0 or 1 times */
+  SIMPLESTAR, /* match a character class 0, 1 or several times */
+  SIMPLEPLUS, /* match a character class 1 or several times */
+  GOTO,       /* unconditional branch */
+  PUSHBACK,   /* record a backtrack point --
+                 where to jump in case of failure */
+  SETMARK,    /* remember current position in given register # */
+  CHECKPROGRESS /* backtrack if no progress was made w.r.t. reg # */
+};
+
+/* Accessors in a compiled regexp */
+#define Prog(re) Field(re, 0)
+#define Cpool(re) Field(re, 1)
+#define Normtable(re) Field(re, 2)
+#define Numgroups(re) Int_val(Field(re, 3))
+#define Numregisters(re) Int_val(Field(re, 4))
+#define Startchars(re) Int_val(Field(re, 5))
+
+/* Record positions of matched groups */
+#define DEFAULT_NUM_GROUPS 10
+struct re_group {
+  unsigned char * start;
+  unsigned char * end;
+};
+
+/* Record positions reached during matching; used to check progress
+   in repeated matching of a regexp. */
+#define NUM_REGISTERS 64
+static unsigned char * re_register[NUM_REGISTERS];
+
+/* The initial backtracking stack */
+static struct backtrack_stack initial_stack = { NULL, };
+
+/* Free a chained list of backtracking stacks */
+static void free_backtrack_stack(struct backtrack_stack * stack)
+{
+  struct backtrack_stack * prevstack;
+  while ((prevstack = stack->previous) != NULL) {
+    caml_stat_free(stack);
+    stack = prevstack;
+  }
+}
+
+/* Membership in a bit vector representing a set of booleans */
+#define In_bitset(s,i,tmp) (tmp = (i), ((s)[tmp >> 3] >> (tmp & 7)) & 1)
+
+/* Determine if a character is a word constituent */
+/* PR#4874: word constituent = letter, digit, underscore. */
+
+static unsigned char re_word_letters[32] = {
+  0x00, 0x00, 0x00, 0x00,       /* 0x00-0x1F: none */
+  0x00, 0x00, 0xFF, 0x03,       /* 0x20-0x3F: digits 0-9 */
+  0xFE, 0xFF, 0xFF, 0x87,       /* 0x40-0x5F: A to Z, _ */
+  0xFE, 0xFF, 0xFF, 0x07,       /* 0x60-0x7F: a to z */
+  0x00, 0x00, 0x00, 0x00,       /* 0x80-0x9F: none */
+  0x00, 0x00, 0x00, 0x00,       /* 0xA0-0xBF: none */
+  0xFF, 0xFF, 0x7F, 0xFF,       /* 0xC0-0xDF: Latin-1 accented uppercase */
+  0xFF, 0xFF, 0x7F, 0xFF        /* 0xE0-0xFF: Latin-1 accented lowercase */
+};
+
+#define Is_word_letter(c) ((re_word_letters[(c) >> 3] >> ((c) & 7)) & 1)
+
+/* Allocate an integer array containing the positions of the matched groups.
+   Beginning of group #N is at 2N, end is at 2N+1.
+   Take position = -1 when group wasn't matched. */
+
+static value re_alloc_groups(value re, unsigned char * starttxt,
+                             struct re_group * groups)
+{
+  value res;
+  int n = Numgroups(re);
+  int i;
+  struct re_group * group;
+
+  res = caml_alloc(n * 2, 0);
+  for (i = 0; i < n; i++) {
+    group = &(groups[i]);
+    if (group->start == NULL || group->end == NULL) {
+      Field(res, i * 2) = Val_int(-1);
+      Field(res, i * 2 + 1) = Val_int(-1);
+    } else {
+      Field(res, i * 2) = Val_long(group->start - starttxt);
+      Field(res, i * 2 + 1) = Val_long(group->end - starttxt);
+    }
+  }
+  return res;
+}
+
+/* The bytecode interpreter for the NFA.
+   Return Caml array of matched groups on success, 0 on failure. */
+
+static value re_match(value re,
+                      unsigned char * starttxt,
+                      register unsigned char * txt,
+                      register unsigned char * endtxt,
+                      int accept_partial_match)
+{
+  register value * pc;
+  intnat instr;
+  struct backtrack_stack * stack;
+  union backtrack_point * sp;
+  value cpool;
+  value normtable;
+  unsigned char c;
+  union backtrack_point back;
+  struct re_group default_groups[DEFAULT_NUM_GROUPS];
+  struct re_group * groups;
+  int numgroups = Numgroups(re);
+  value result;
+
+  if (numgroups <= DEFAULT_NUM_GROUPS)
+    groups = default_groups;
+  else
+    groups = caml_stat_alloc(sizeof(struct re_group) * numgroups);
+
+  { int i;
+    struct re_group * p;
+    unsigned char ** q;
+    for (p = &groups[1], i = numgroups; i > 1; i--, p++)
+      p->start = p->end = NULL;
+    for (q = &re_register[0], i = Numregisters(re); i > 0; i--, q++)
+      *q = NULL;
+  }
+
+  pc = &Field(Prog(re), 0);
+  stack = &initial_stack;
+  sp = stack->point;
+  cpool = Cpool(re);
+  normtable = Normtable(re);
+  groups[0].start = txt;
+
+  while (1) {
+    instr = Long_val(*pc++);
+    switch (Opcode(instr)) {
+    case CHAR:
+      if (txt == endtxt) goto prefix_match;
+      if (*txt != Arg(instr)) goto backtrack;
+      txt++;
+      break;
+    case CHARNORM:
+      if (txt == endtxt) goto prefix_match;
+      if (Byte_u(normtable, *txt) != Arg(instr)) goto backtrack;
+      txt++;
+      break;
+    case STRING: {
+      unsigned char * s =
+        (unsigned char *) String_val(Field(cpool, Arg(instr)));
+      while ((c = *s++) != 0) {
+        if (txt == endtxt) goto prefix_match;
+        if (c != *txt) goto backtrack;
+        txt++;
+      }
+      break;
+    }
+    case STRINGNORM: {
+      unsigned char * s =
+        (unsigned char *) String_val(Field(cpool, Arg(instr)));
+      while ((c = *s++) != 0) {
+        if (txt == endtxt) goto prefix_match;
+        if (c != Byte_u(normtable, *txt)) goto backtrack;
+        txt++;
+      }
+      break;
+    }
+    case CHARCLASS:
+      if (txt == endtxt) goto prefix_match;
+      if (! In_bitset(String_val(Field(cpool, Arg(instr))), *txt, c))
+        goto backtrack;
+      txt++;
+      break;
+    case BOL:
+      if (txt > starttxt && txt[-1] != '\n') goto backtrack;
+      break;
+    case EOL:
+      if (txt < endtxt && *txt != '\n') goto backtrack;
+      break;
+    case WORDBOUNDARY:
+      /* At beginning and end of text: no
+         At beginning of text: OK if current char is a letter
+         At end of text: OK if previous char is a letter
+         Otherwise:
+           OK if previous char is a letter and current char not a letter
+           or previous char is not a letter and current char is a letter */
+      if (txt == starttxt) {
+        if (txt == endtxt) goto prefix_match;
+        if (Is_word_letter(txt[0])) break;
+        goto backtrack;
+      } else if (txt == endtxt) {
+        if (Is_word_letter(txt[-1])) break;
+        goto backtrack;
+      } else {
+        if (Is_word_letter(txt[-1]) != Is_word_letter(txt[0])) break;
+        goto backtrack;
+      }
+    case BEGGROUP: {
+      int group_no = Arg(instr);
+      struct re_group * group = &(groups[group_no]);
+      back.undo.loc = &(group->start);
+      back.undo.val = group->start;
+      group->start = txt;
+      goto push;
+    }
+    case ENDGROUP: {
+      int group_no = Arg(instr);
+      struct re_group * group = &(groups[group_no]);
+      back.undo.loc = &(group->end);
+      back.undo.val = group->end;
+      group->end = txt;
+      goto push;
+    }
+    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++) {
+        if (txt == endtxt) goto prefix_match;
+        if (*s != *txt) goto backtrack;
+        txt++;
+      }
+      break;
+    }
+    case ACCEPT:
+      goto accept;
+    case SIMPLEOPT: {
+      const char * set = String_val(Field(cpool, Arg(instr)));
+      if (txt < endtxt && In_bitset(set, *txt, c)) txt++;
+      break;
+    }
+    case SIMPLESTAR: {
+      const char * set = String_val(Field(cpool, Arg(instr)));
+      while (txt < endtxt && In_bitset(set, *txt, c))
+        txt++;
+      break;
+    }
+    case SIMPLEPLUS: {
+      const char * set = String_val(Field(cpool, Arg(instr)));
+      if (txt == endtxt) goto prefix_match;
+      if (! In_bitset(set, *txt, c)) goto backtrack;
+      txt++;
+      while (txt < endtxt && In_bitset(set, *txt, c))
+        txt++;
+      break;
+    }
+    case GOTO:
+      pc = pc + SignedArg(instr);
+      break;
+    case PUSHBACK:
+      back.pos.pc = Set_tag(pc + SignedArg(instr));
+      back.pos.txt = txt;
+      goto push;
+    case SETMARK: {
+      int reg_no = Arg(instr);
+      unsigned char ** reg = &(re_register[reg_no]);
+      back.undo.loc = reg;
+      back.undo.val = *reg;
+      *reg = txt;
+      goto push;
+    }
+    case CHECKPROGRESS: {
+      int reg_no = Arg(instr);
+      if (re_register[reg_no] == txt)
+        goto backtrack;
+      break;
+    }
+    default:
+      caml_fatal_error ("impossible case in re_match");
+    }
+    /* Continue with next instruction */
+    continue;
+
+  push:
+    /* Push an item on the backtrack stack and continue with next instr */
+    if (sp == stack->point + BACKTRACK_STACK_BLOCK_SIZE) {
+      struct backtrack_stack * newstack =
+        caml_stat_alloc(sizeof(struct backtrack_stack));
+      newstack->previous = stack;
+      stack = newstack;
+      sp = stack->point;
+    }
+    *sp = back;
+    sp++;
+    continue;
+
+  prefix_match:
+    /* We get here when matching failed because the end of text
+       was encountered. */
+    if (accept_partial_match) goto accept;
+
+  backtrack:
+    /* We get here when matching fails.  Backtrack to most recent saved
+       program point, undoing variable assignments on the way. */
+    while (1) {
+      if (sp == stack->point) {
+        struct backtrack_stack * prevstack = stack->previous;
+        if (prevstack == NULL) goto reject;
+        caml_stat_free(stack);
+        stack = prevstack;
+        sp = stack->point + BACKTRACK_STACK_BLOCK_SIZE;
+      }
+      sp--;
+      if (Tag_is_set(sp->pos.pc)) {
+        pc = Clear_tag(sp->pos.pc);
+        txt = sp->pos.txt;
+        break;
+      } else {
+        *(sp->undo.loc) = sp->undo.val;
+      }
+    }
+    continue;
+  }
+
+ accept:
+  /* We get here when the regexp was successfully matched */
+  free_backtrack_stack(stack);
+  groups[0].end = txt;
+  result = re_alloc_groups(re, starttxt, groups);
+  if (groups != default_groups) caml_stat_free(groups);
+  return result;
+
+ reject:
+  /* We get here when the regexp was not matched */
+  if (groups != default_groups) caml_stat_free(groups);
+  return 0;
+}
+
+/* String matching and searching.  All functions return the empty array
+   on failure, and an array of positions on success. */
+
+CAMLprim value re_string_match(value re, value str, value pos)
+{
+  unsigned char * starttxt = &Byte_u(str, 0);
+  unsigned char * txt = &Byte_u(str, Long_val(pos));
+  unsigned char * endtxt = &Byte_u(str, caml_string_length(str));
+  value res;
+
+  if (txt < starttxt || txt > endtxt)
+    caml_invalid_argument("Str.string_match");
+  res = re_match(re, starttxt, txt, endtxt, 0);
+  return res == 0 ? Atom(0) : res;
+}
+
+CAMLprim value re_partial_match(value re, value str, value pos)
+{
+  unsigned char * starttxt = &Byte_u(str, 0);
+  unsigned char * txt = &Byte_u(str, Long_val(pos));
+  unsigned char * endtxt = &Byte_u(str, caml_string_length(str));
+  value res;
+
+  if (txt < starttxt || txt > endtxt)
+    caml_invalid_argument("Str.string_partial_match");
+  res = re_match(re, starttxt, txt, endtxt, 1);
+  return res == 0 ? Atom(0) : res;
+}
+
+CAMLprim value re_search_forward(value re, value str, value startpos)
+{
+  unsigned char * starttxt = &Byte_u(str, 0);
+  unsigned char * txt = &Byte_u(str, Long_val(startpos));
+  unsigned char * endtxt = &Byte_u(str, caml_string_length(str));
+  unsigned char * startchars;
+  value res;
+
+  if (txt < starttxt || txt > endtxt)
+    caml_invalid_argument("Str.search_forward");
+  if (Startchars(re) == -1) {
+    do {
+      res = re_match(re, starttxt, txt, endtxt, 0);
+      if (res != 0) return res;
+      txt++;
+    } while (txt <= endtxt);
+    return Atom(0);
+  } else {
+    startchars =
+      (unsigned char *) String_val(Field(Cpool(re), Startchars(re)));
+    do {
+      while (txt < endtxt && startchars[*txt] == 0) txt++;
+      res = re_match(re, starttxt, txt, endtxt, 0);
+      if (res != 0) return res;
+      txt++;
+    } while (txt <= endtxt);
+    return Atom(0);
+  }
+}
+
+CAMLprim value re_search_backward(value re, value str, value startpos)
+{
+  unsigned char * starttxt = &Byte_u(str, 0);
+  unsigned char * txt = &Byte_u(str, Long_val(startpos));
+  unsigned char * endtxt = &Byte_u(str, caml_string_length(str));
+  unsigned char * startchars;
+  value res;
+
+  if (txt < starttxt || txt > endtxt)
+    caml_invalid_argument("Str.search_backward");
+  if (Startchars(re) == -1) {
+    do {
+      res = re_match(re, starttxt, txt, endtxt, 0);
+      if (res != 0) return res;
+      txt--;
+    } while (txt >= starttxt);
+    return Atom(0);
+  } else {
+    startchars =
+      (unsigned char *) String_val(Field(Cpool(re), Startchars(re)));
+    do {
+      while (txt > starttxt && startchars[*txt] == 0) txt--;
+      res = re_match(re, starttxt, txt, endtxt, 0);
+      if (res != 0) return res;
+      txt--;
+    } while (txt >= starttxt);
+    return Atom(0);
+  }
+}
+
+/* Replacement */
+
+CAMLprim value re_replacement_text(value repl, value groups, value orig)
+{
+  CAMLparam3(repl, groups, orig);
+  CAMLlocal1(res);
+  mlsize_t start, end, len, n;
+  const char * p;
+  char * q;
+  int c;
+
+  len = 0;
+  p = String_val(repl);
+  n = caml_string_length(repl);
+  while (n > 0) {
+    c = *p++; n--;
+    if(c != '\\')
+      len++;
+    else {
+      if (n == 0) caml_failwith("Str.replace: illegal backslash sequence");
+      c = *p++; n--;
+      switch (c) {
+      case '\\':
+        len++; break;
+      case '0': case '1': case '2': case '3': case '4':
+      case '5': case '6': case '7': case '8': case '9':
+        c -= '0';
+        if (c*2 >= Wosize_val(groups))
+          caml_failwith("Str.replace: reference to unmatched group");
+        start = Long_val(Field(groups, c*2));
+        end = Long_val(Field(groups, c*2 + 1));
+        if (start == (mlsize_t) -1)
+          caml_failwith("Str.replace: reference to unmatched group");
+        len += end - start;
+        break;
+      default:
+        len += 2; break;
+      }
+    }
+  }
+  res = caml_alloc_string(len);
+  p = String_val(repl);
+  q = (char *)String_val(res);
+  n = caml_string_length(repl);
+  while (n > 0) {
+    c = *p++; n--;
+    if(c != '\\')
+      *q++ = c;
+    else {
+      c = *p++; n--;
+      switch (c) {
+      case '\\':
+        *q++ = '\\'; break;
+      case '0': case '1': case '2': case '3': case '4':
+      case '5': case '6': case '7': case '8': case '9':
+        c -= '0';
+        start = Long_val(Field(groups, c*2));
+        end = Long_val(Field(groups, c*2 + 1));
+        len = end - start;
+        memmove (q, &Byte(orig, start), len);
+        q += len;
+        break;
+      default:
+        *q++ = '\\'; *q++ = c; break;
+      }
+    }
+  }
+  CAMLreturn(res);
+}
diff --git a/otherlibs/systhreads/.depend b/otherlibs/systhreads/.depend
new file mode 100644
index 00000000..8647bddf
--- /dev/null
+++ b/otherlibs/systhreads/.depend
@@ -0,0 +1,68 @@
+st_stubs_b.$(O): st_stubs.c ../../runtime/caml/alloc.h \
+ ../../runtime/caml/misc.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/backtrace.h \
+ ../../runtime/caml/exec.h ../../runtime/caml/callback.h \
+ ../../runtime/caml/custom.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/io.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/printexc.h \
+ ../../runtime/caml/roots.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/stacks.h \
+ ../../runtime/caml/sys.h ../../runtime/caml/memprof.h \
+ ../../runtime/caml/roots.h threads.h
+st_stubs_n.$(O): st_stubs.c ../../runtime/caml/alloc.h \
+ ../../runtime/caml/misc.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/backtrace.h \
+ ../../runtime/caml/exec.h ../../runtime/caml/callback.h \
+ ../../runtime/caml/custom.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/io.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/printexc.h \
+ ../../runtime/caml/roots.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/stack.h \
+ ../../runtime/caml/sys.h ../../runtime/caml/memprof.h \
+ ../../runtime/caml/roots.h threads.h
+condition.cmo : \
+    mutex.cmi \
+    condition.cmi
+condition.cmx : \
+    mutex.cmx \
+    condition.cmi
+condition.cmi : \
+    mutex.cmi
+event.cmo : \
+    mutex.cmi \
+    condition.cmi \
+    event.cmi
+event.cmx : \
+    mutex.cmx \
+    condition.cmx \
+    event.cmi
+event.cmi :
+mutex.cmo : \
+    mutex.cmi
+mutex.cmx : \
+    mutex.cmi
+mutex.cmi :
+thread.cmo : \
+    thread.cmi
+thread.cmx : \
+    thread.cmi
+thread.cmi :
+threadUnix.cmo : \
+    thread.cmi \
+    threadUnix.cmi
+threadUnix.cmx : \
+    thread.cmx \
+    threadUnix.cmi
+threadUnix.cmi :
diff --git a/otherlibs/systhreads/Makefile b/otherlibs/systhreads/Makefile
new file mode 100644
index 00000000..173183ba
--- /dev/null
+++ b/otherlibs/systhreads/Makefile
@@ -0,0 +1,171 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+ROOTDIR=../..
+
+-include $(ROOTDIR)/Makefile.config
+-include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.best_binaries
+
+OC_CFLAGS += $(SHAREDLIB_CFLAGS)
+
+OC_CPPFLAGS += -I$(ROOTDIR)/runtime
+
+NATIVE_CPPFLAGS = \
+  -DNATIVE_CODE -DTARGET_$(ARCH) -DMODEL_$(MODEL) -DSYS_$(SYSTEM)
+
+CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
+
+LIBS = -nostdlib -I $(ROOTDIR)/stdlib -I $(ROOTDIR)/otherlibs/$(UNIXLIB)
+
+CAMLC=$(BEST_OCAMLC) $(LIBS)
+CAMLOPT=$(BEST_OCAMLOPT) $(LIBS)
+
+MKLIB=$(CAMLRUN) $(ROOTDIR)/tools/ocamlmklib
+COMPFLAGS=-w +33..39 -warn-error A -g -bin-annot -safe-string
+ifeq "$(FLAMBDA)" "true"
+OPTCOMPFLAGS += -O3
+endif
+
+LIBNAME=threads
+
+ifeq "$(UNIX_OR_WIN32)" "unix"
+HEADER = st_posix.h
+else # Windows
+HEADER = st_win32.h
+endif
+
+# Note: the header on which object files produced from st_stubs.c
+# should actually depend is known for sure only at compile-time.
+# That's why this dependency is handled in the Makefile directly
+# and removed from the output of the C compiler during make depend
+
+BYTECODE_C_OBJS=st_stubs_b.$(O)
+NATIVECODE_C_OBJS=st_stubs_n.$(O)
+
+THREADS_SOURCES = thread.ml mutex.ml condition.ml event.ml threadUnix.ml
+
+THREADS_BCOBJS = $(THREADS_SOURCES:.ml=.cmo)
+THREADS_NCOBJS = $(THREADS_SOURCES:.ml=.cmx)
+
+MLIFILES=thread.mli mutex.mli condition.mli event.mli threadUnix.mli
+CMIFILES=$(MLIFILES:.mli=.cmi)
+
+all: lib$(LIBNAME).$(A) $(LIBNAME).cma $(CMIFILES)
+
+allopt: lib$(LIBNAME)nat.$(A) $(LIBNAME).cmxa $(CMIFILES)
+
+lib$(LIBNAME).$(A): $(BYTECODE_C_OBJS)
+	$(MKLIB_CMD) -o $(LIBNAME) $(BYTECODE_C_OBJS) $(PTHREAD_LINK)
+
+lib$(LIBNAME)nat.$(A): $(NATIVECODE_C_OBJS)
+	$(MKLIB_CMD) -o $(LIBNAME)nat $^
+
+$(LIBNAME).cma: $(THREADS_BCOBJS)
+ifeq "$(UNIX_OR_WIN32)" "unix"
+	$(MKLIB) -o $(LIBNAME) -ocamlc '$(CAMLC)' -cclib -lunix -linkall \
+	  $(PTHREAD_CAML_LINK) $^
+# TODO: Figure out why -cclib -lunix is used here.
+# It may be because of the threadsUnix module which is deprecated.
+# It may hence be good to figure out whether this module shouldn't be
+# removed, and then -cclib -lunix arguments.
+else # Windows
+	$(MKLIB) -o $(LIBNAME) -ocamlc "$(CAMLC)" -linkall \
+	  $(PTHREAD_CAML_LINK) $^
+endif
+
+# See remark above: force static linking of libthreadsnat.a
+$(LIBNAME).cmxa: $(THREADS_NCOBJS)
+	$(CAMLOPT) -linkall -a -cclib -lthreadsnat $(PTHREAD_CAML_LINK) -o $@ $^
+
+# Note: I removed "-cclib -lunix" from the line above.
+# Indeed, if we link threads.cmxa, then we must also link unix.cmxa,
+# which itself will pass -lunix to the C linker.  It seems more
+# modular to me this way. -- Alain
+
+# The following lines produce two object files st_stubs_b.$(O) and
+# st_stubs_n.$(O) from the same source file st_stubs.c (it is compiled
+# twice, each time with different options).
+
+st_stubs_n.$(O): OC_CPPFLAGS += $(NATIVE_CPPFLAGS)
+
+st_stubs_b.$(O): st_stubs.c $(HEADER)
+	$(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $<
+
+st_stubs_n.$(O): st_stubs.c $(HEADER)
+	$(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $<
+
+partialclean:
+	rm -f *.cm*
+
+clean: partialclean
+	rm -f dllthreads*.so dllthreads*.dll *.a *.lib *.o *.obj
+
+INSTALL_THREADSLIBDIR=$(INSTALL_LIBDIR)/$(LIBNAME)
+
+install:
+	if test -f dllthreads$(EXT_DLL); then \
+	  $(INSTALL_PROG) \
+	    dllthreads$(EXT_DLL) "$(INSTALL_STUBLIBDIR)/dllthreads$(EXT_DLL)"; \
+	fi
+	$(INSTALL_DATA) libthreads.$(A) "$(INSTALL_LIBDIR)"
+	cd "$(INSTALL_LIBDIR)"; $(RANLIB) libthreads.$(A)
+	mkdir -p "$(INSTALL_THREADSLIBDIR)"
+	$(INSTALL_DATA) \
+	  $(CMIFILES) threads.cma \
+	  "$(INSTALL_THREADSLIBDIR)"
+ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
+	$(INSTALL_DATA) \
+	  $(CMIFILES:.cmi=.cmti) \
+	  "$(INSTALL_THREADSLIBDIR)"
+	$(INSTALL_DATA) $(MLIFILES) "$(INSTALL_THREADSLIBDIR)"
+endif
+	$(INSTALL_DATA) threads.h "$(INSTALL_LIBDIR)/caml"
+
+installopt:
+	$(INSTALL_DATA) libthreadsnat.$(A) "$(INSTALL_LIBDIR)"
+	cd "$(INSTALL_LIBDIR)"; $(RANLIB) libthreadsnat.$(A)
+	$(INSTALL_DATA) \
+	  $(THREADS_NCOBJS) threads.cmxa threads.$(A) \
+	  "$(INSTALL_THREADSLIBDIR)"
+	cd "$(INSTALL_THREADSLIBDIR)" && $(RANLIB) threads.$(A)
+
+.SUFFIXES: .ml .mli .cmo .cmi .cmx
+
+.mli.cmi:
+	$(CAMLC) -c $(COMPFLAGS) $<
+
+.ml.cmo:
+	$(CAMLC) -c $(COMPFLAGS) $<
+
+.ml.cmx:
+	$(CAMLOPT) -c $(COMPFLAGS) $(OPTCOMPFLAGS) $<
+
+.PHONY: depend
+ifeq "$(TOOLCHAIN)" "msvc"
+depend:
+	$(error Dependencies cannot be regenerated using the MSVC ports)
+else
+depend:
+	$(CC) -MM $(OC_CPPFLAGS) st_stubs.c \
+	  | sed -e 's/st_stubs\.o/st_stubs_b.$$(O)/' \
+	  -e 's/ st_\(posix\|win32\)\.h//g' > .depend
+	$(CC) -MM $(OC_CPPFLAGS) $(NATIVE_CPPFLAGS) \
+	  st_stubs.c | sed -e 's/st_stubs\.o/st_stubs_n.$$(O)/' \
+	  -e 's/ st_\(posix\|win32\)\.h//g' >> .depend
+	$(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml >> .depend
+endif
+
+include .depend
diff --git a/otherlibs/systhreads/condition.ml b/otherlibs/systhreads/condition.ml
new file mode 100644
index 00000000..9a014528
--- /dev/null
+++ b/otherlibs/systhreads/condition.ml
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt     *)
+(*                                                                        *)
+(*   Copyright 1995 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
+external create: unit -> t = "caml_condition_new"
+external wait: t -> Mutex.t -> unit = "caml_condition_wait"
+external signal: t -> unit = "caml_condition_signal"
+external broadcast: t -> unit = "caml_condition_broadcast"
diff --git a/otherlibs/systhreads/condition.mli b/otherlibs/systhreads/condition.mli
new file mode 100644
index 00000000..36c71fc8
--- /dev/null
+++ b/otherlibs/systhreads/condition.mli
@@ -0,0 +1,53 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          Xavier Leroy and Damien Doligez, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Condition variables to synchronize between threads.
+
+   Condition variables are used when one thread wants to wait until another
+   thread has finished doing something: the former thread 'waits' on the
+   condition variable, the latter thread 'signals' the condition when it
+   is done. Condition variables should always be protected by a mutex.
+   The typical use is (if [D] is a shared data structure, [m] its mutex,
+   and [c] is a condition variable):
+   {[
+     Mutex.lock m;
+     while (* some predicate P over D is not satisfied *) do
+       Condition.wait c m
+     done;
+     (* Modify D *)
+     if (* the predicate P over D is now satisfied *) then Condition.signal c;
+     Mutex.unlock m
+   ]}
+*)
+
+type t
+(** The type of condition variables. *)
+
+val create : unit -> t
+(** Return a new condition variable. *)
+
+val wait : t -> Mutex.t -> unit
+(** [wait c m] atomically unlocks the mutex [m] and suspends the
+   calling process on the condition variable [c]. The process will
+   restart after the condition variable [c] has been signalled.
+   The mutex [m] is locked again before [wait] returns. *)
+
+val signal : t -> unit
+(** [signal c] restarts one of the processes waiting on the
+   condition variable [c]. *)
+
+val broadcast : t -> unit
+(** [broadcast c] restarts all processes waiting on the
+   condition variable [c]. *)
diff --git a/otherlibs/systhreads/event.ml b/otherlibs/systhreads/event.ml
new file mode 100644
index 00000000..f5fc9785
--- /dev/null
+++ b/otherlibs/systhreads/event.ml
@@ -0,0 +1,276 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   David Nowak and 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Events *)
+type 'a basic_event =
+  { poll: unit -> bool;
+      (* If communication can take place immediately, return true. *)
+    suspend: unit -> unit;
+      (* Offer the communication on the channel and get ready
+         to suspend current process. *)
+    result: unit -> 'a }
+      (* Return the result of the communication *)
+
+type 'a behavior = int ref -> Condition.t -> int -> 'a basic_event
+
+type 'a event =
+    Communication of 'a behavior
+  | Choose of 'a event list
+  | WrapAbort of 'a event * (unit -> unit)
+  | Guard of (unit -> 'a event)
+
+(* Communication channels *)
+type 'a channel =
+  { mutable writes_pending: 'a communication Queue.t;
+                        (* All offers to write on it *)
+    mutable reads_pending:  'a communication Queue.t }
+                        (* All offers to read from it *)
+
+(* Communication offered *)
+and 'a communication =
+  { performed: int ref;  (* -1 if not performed yet, set to the number *)
+                         (* of the matching communication after rendez-vous. *)
+    condition: Condition.t;             (* To restart the blocked thread. *)
+    mutable data: 'a option;            (* The data sent or received. *)
+    event_number: int }                 (* Event number in select *)
+
+(* Create a channel *)
+
+let new_channel () =
+  { writes_pending = Queue.create();
+    reads_pending = Queue.create() }
+
+(* Basic synchronization function *)
+
+let masterlock = Mutex.create()
+
+let do_aborts abort_env genev performed =
+  if abort_env <> [] then begin
+    if performed >= 0 then begin
+      let ids_done = snd genev.(performed) in
+      List.iter
+        (fun (id,f) -> if not (List.mem id ids_done) then f ())
+        abort_env
+    end else begin
+      List.iter (fun (_,f) -> f ()) abort_env
+    end
+  end
+
+let basic_sync abort_env genev =
+  let performed = ref (-1) in
+  let condition = Condition.create() in
+  let bev = Array.make (Array.length genev)
+                         (fst (genev.(0)) performed condition 0) in
+  for i = 1 to Array.length genev - 1 do
+    bev.(i) <- (fst genev.(i)) performed condition i
+  done;
+  (* See if any of the events is already activable *)
+  let rec poll_events i =
+    if i >= Array.length bev
+    then false
+    else bev.(i).poll() || poll_events (i+1) in
+  Mutex.lock masterlock;
+  if not (poll_events 0) then begin
+    (* Suspend on all events *)
+    for i = 0 to Array.length bev - 1 do bev.(i).suspend() done;
+    (* Wait until the condition is signalled *)
+    Condition.wait condition masterlock;
+    (* PR#7013: protect against spurious wake-up *)
+    while !performed < 0 do Condition.wait condition masterlock done
+  end;
+  Mutex.unlock masterlock;
+  (* Extract the result *)
+  if abort_env = [] then
+    (* Preserve tail recursion *)
+    bev.(!performed).result()
+  else begin
+    let num = !performed in
+    let result = bev.(num).result() in
+    (* Handle the aborts and return the result *)
+    do_aborts abort_env genev num;
+    result
+  end
+
+(* Apply a random permutation on an array *)
+
+let scramble_array a =
+  let len = Array.length a in
+  if len = 0 then invalid_arg "Event.choose";
+  for i = len - 1 downto 1 do
+    let j = Random.int (i + 1) in
+    let temp = a.(i) in a.(i) <- a.(j); a.(j) <- temp
+  done;
+  a
+
+(* Main synchronization function *)
+
+let gensym = let count = ref 0 in fun () -> incr count; !count
+
+let rec flatten_event
+      (abort_list : int list)
+      (accu : ('a behavior * int list) list)
+      (accu_abort : (int * (unit -> unit)) list)
+      ev =
+  match ev with
+     Communication bev -> ((bev,abort_list) :: accu) , accu_abort
+  | WrapAbort (ev,fn) ->
+      let id = gensym () in
+      flatten_event (id :: abort_list) accu ((id,fn)::accu_abort) ev
+  | Choose evl ->
+      let rec flatten_list accu' accu_abort'= function
+         ev :: l ->
+           let (accu'',accu_abort'') =
+             flatten_event abort_list accu' accu_abort' ev in
+           flatten_list accu'' accu_abort'' l
+       | [] -> (accu',accu_abort') in
+      flatten_list accu accu_abort evl
+  | Guard fn -> flatten_event abort_list accu accu_abort (fn ())
+
+let sync ev =
+  let (evl,abort_env) = flatten_event [] [] [] ev in
+  basic_sync abort_env (scramble_array(Array.of_list evl))
+
+(* Event polling -- like sync, but non-blocking *)
+
+let basic_poll abort_env genev =
+  let performed = ref (-1) in
+  let condition = Condition.create() in
+  let bev = Array.make(Array.length genev)
+                        (fst genev.(0) performed condition 0) in
+  for i = 1 to Array.length genev - 1 do
+    bev.(i) <- fst genev.(i) performed condition i
+  done;
+  (* See if any of the events is already activable *)
+  let rec poll_events i =
+    if i >= Array.length bev
+    then false
+    else bev.(i).poll() || poll_events (i+1) in
+  Mutex.lock masterlock;
+  let ready = poll_events 0 in
+  if ready then begin
+    (* Extract the result *)
+    Mutex.unlock masterlock;
+    let result = Some(bev.(!performed).result()) in
+    do_aborts abort_env genev !performed; result
+  end else begin
+    (* Cancel the communication offers *)
+    performed := 0;
+    Mutex.unlock masterlock;
+    do_aborts abort_env genev (-1);
+    None
+  end
+
+let poll ev =
+  let (evl,abort_env) = flatten_event [] [] [] ev in
+  basic_poll abort_env (scramble_array(Array.of_list evl))
+
+(* Remove all communication opportunities already synchronized *)
+
+let cleanup_queue q =
+  let q' = Queue.create() in
+  Queue.iter (fun c -> if !(c.performed) = -1 then Queue.add c q') q;
+  q'
+
+(* Event construction *)
+
+let always data =
+  Communication(fun performed condition evnum ->
+    { poll = (fun () -> performed := evnum; true);
+      suspend = (fun () -> ());
+      result = (fun () -> data) })
+
+let send channel data =
+  Communication(fun performed condition evnum ->
+    let wcomm =
+      { performed = performed;
+        condition = condition;
+        data = Some data;
+        event_number = evnum } in
+    { poll = (fun () ->
+        let rec poll () =
+          let rcomm = Queue.take channel.reads_pending in
+          if !(rcomm.performed) >= 0 then
+            poll ()
+          else begin
+            rcomm.data <- wcomm.data;
+            performed := evnum;
+            rcomm.performed := rcomm.event_number;
+            Condition.signal rcomm.condition
+          end in
+        try
+          poll();
+          true
+        with Queue.Empty ->
+          false);
+      suspend = (fun () ->
+        channel.writes_pending <- cleanup_queue channel.writes_pending;
+        Queue.add wcomm channel.writes_pending);
+      result = (fun () -> ()) })
+
+let receive channel =
+  Communication(fun performed condition evnum ->
+    let rcomm =
+      { performed = performed;
+        condition = condition;
+        data = None;
+        event_number = evnum } in
+    { poll = (fun () ->
+        let rec poll () =
+          let wcomm = Queue.take channel.writes_pending in
+          if !(wcomm.performed) >= 0 then
+            poll ()
+          else begin
+            rcomm.data <- wcomm.data;
+            performed := evnum;
+            wcomm.performed := wcomm.event_number;
+            Condition.signal wcomm.condition
+          end in
+        try
+          poll();
+          true
+        with Queue.Empty ->
+          false);
+    suspend = (fun () ->
+      channel.reads_pending <- cleanup_queue channel.reads_pending;
+      Queue.add rcomm channel.reads_pending);
+    result = (fun () ->
+      match rcomm.data with
+        None -> invalid_arg "Event.receive"
+      | Some res -> res) })
+
+let choose evl = Choose evl
+
+let wrap_abort ev fn = WrapAbort(ev,fn)
+
+let guard fn = Guard fn
+
+let rec wrap ev fn =
+  match ev with
+    Communication genev ->
+      Communication(fun performed condition evnum ->
+        let bev = genev performed condition evnum in
+        { poll = bev.poll;
+          suspend = bev.suspend;
+          result = (fun () -> fn(bev.result())) })
+  | Choose evl ->
+      Choose(List.map (fun ev -> wrap ev fn) evl)
+  | WrapAbort (ev, f') ->
+      WrapAbort (wrap ev fn, f')
+  | Guard gu ->
+      Guard(fun () -> wrap (gu()) fn)
+
+(* Convenience functions *)
+
+let select evl = sync(Choose evl)
diff --git a/otherlibs/systhreads/event.mli b/otherlibs/systhreads/event.mli
new file mode 100644
index 00000000..fd452652
--- /dev/null
+++ b/otherlibs/systhreads/event.mli
@@ -0,0 +1,81 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   David Nowak and 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** First-class synchronous communication.
+
+   This module implements synchronous inter-thread communications over
+   channels. As in John Reppy's Concurrent ML system, the communication
+   events are first-class values: they can be built and combined
+   independently before being offered for communication.
+*)
+
+type 'a channel
+(** The type of communication channels carrying values of type ['a]. *)
+
+val new_channel : unit -> 'a channel
+(** Return a new channel. *)
+
+type +'a event
+(** The type of communication events returning a result of type ['a]. *)
+
+(** [send ch v] returns the event consisting in sending the value [v]
+   over the channel [ch]. The result value of this event is [()]. *)
+val send : 'a channel -> 'a -> unit event
+
+(** [receive ch] returns the event consisting in receiving a value
+   from the channel [ch]. The result value of this event is the
+   value received. *)
+val receive : 'a channel -> 'a event
+
+val always : 'a -> 'a event
+(** [always v] returns an event that is always ready for
+   synchronization.  The result value of this event is [v]. *)
+
+val choose : 'a event list -> 'a event
+(** [choose evl] returns the event that is the alternative of
+   all the events in the list [evl]. *)
+
+val wrap : 'a event -> ('a -> 'b) -> 'b event
+(** [wrap ev fn] returns the event that performs the same communications
+   as [ev], then applies the post-processing function [fn]
+   on the return value. *)
+
+val wrap_abort : 'a event -> (unit -> unit) -> 'a event
+(** [wrap_abort ev fn] returns the event that performs
+   the same communications as [ev], but if it is not selected
+   the function [fn] is called after the synchronization. *)
+
+val guard : (unit -> 'a event) -> 'a event
+(** [guard fn] returns the event that, when synchronized, computes
+   [fn()] and behaves as the resulting event. This enables
+   computing events with side-effects at the time of the synchronization
+   operation. *)
+
+val sync : 'a event -> 'a
+(** 'Synchronize' on an event: offer all the communication
+   possibilities specified in the event to the outside world,
+   and block until one of the communications succeed. The result
+   value of that communication is returned. *)
+
+val select : 'a event list -> 'a
+(** 'Synchronize' on an alternative of events.
+   [select evl] is shorthand for [sync(choose evl)]. *)
+
+val poll : 'a event -> 'a option
+(** Non-blocking version of {!Event.sync}: offer all the communication
+   possibilities specified in the event to the outside world,
+   and if one can take place immediately, perform it and return
+   [Some r] where [r] is the result value of that communication.
+   Otherwise, return [None] without blocking. *)
diff --git a/otherlibs/systhreads/mutex.ml b/otherlibs/systhreads/mutex.ml
new file mode 100644
index 00000000..836109e7
--- /dev/null
+++ b/otherlibs/systhreads/mutex.ml
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Xavier Leroy and Pascal Cuoq, INRIA Rocquencourt             *)
+(*                                                                        *)
+(*   Copyright 1995 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
+external create: unit -> t = "caml_mutex_new"
+external lock: t -> unit = "caml_mutex_lock"
+external try_lock: t -> bool = "caml_mutex_try_lock"
+external unlock: t -> unit = "caml_mutex_unlock"
diff --git a/otherlibs/systhreads/mutex.mli b/otherlibs/systhreads/mutex.mli
new file mode 100644
index 00000000..8953a159
--- /dev/null
+++ b/otherlibs/systhreads/mutex.mli
@@ -0,0 +1,49 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          Xavier Leroy and Damien Doligez, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Locks for mutual exclusion.
+
+   Mutexes (mutual-exclusion locks) are used to implement critical sections
+   and protect shared mutable data structures against concurrent accesses.
+   The typical use is (if [m] is the mutex associated with the data structure
+   [D]):
+   {[
+     Mutex.lock m;
+     (* Critical section that operates over D *);
+     Mutex.unlock m
+   ]}
+*)
+
+type t
+(** The type of mutexes. *)
+
+val create : unit -> t
+(** Return a new mutex. *)
+
+val lock : t -> unit
+(** Lock the given mutex. Only one thread can have the mutex locked
+   at any time. A thread that attempts to lock a mutex already locked
+   by another thread will suspend until the other thread unlocks
+   the mutex. *)
+
+val try_lock : t -> bool
+(** Same as {!Mutex.lock}, but does not suspend the calling thread if
+   the mutex is already locked: just return [false] immediately
+   in that case. If the mutex is unlocked, lock it and
+   return [true]. *)
+
+val unlock : t -> unit
+(** Unlock the given mutex. Other threads suspended trying to lock
+   the mutex will restart. *)
diff --git a/otherlibs/systhreads/st_posix.h b/otherlibs/systhreads/st_posix.h
new file mode 100644
index 00000000..17ed1514
--- /dev/null
+++ b/otherlibs/systhreads/st_posix.h
@@ -0,0 +1,459 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2009 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* POSIX thread implementation of the "st" interface */
+
+#include <assert.h>
+#include <errno.h>
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <pthread.h>
+#ifdef __sun
+#define _POSIX_PTHREAD_SEMANTICS
+#endif
+#include <signal.h>
+#include <time.h>
+#include <sys/time.h>
+#ifdef __linux__
+#include <unistd.h>
+#endif
+
+typedef int st_retcode;
+
+#define SIGPREEMPTION SIGVTALRM
+
+/* OS-specific initialization */
+
+static int st_initialize(void)
+{
+  caml_sigmask_hook = pthread_sigmask;
+  return 0;
+}
+
+/* Thread creation.  Created in detached mode if [res] is NULL. */
+
+typedef pthread_t st_thread_id;
+
+static int st_thread_create(st_thread_id * res,
+                            void * (*fn)(void *), void * arg)
+{
+  pthread_t thr;
+  pthread_attr_t attr;
+  int rc;
+
+  pthread_attr_init(&attr);
+  if (res == NULL) pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
+  rc = pthread_create(&thr, &attr, fn, arg);
+  if (res != NULL) *res = thr;
+  return rc;
+}
+
+#define ST_THREAD_FUNCTION void *
+
+/* Cleanup at thread exit */
+
+Caml_inline void st_thread_cleanup(void)
+{
+  return;
+}
+
+/* Thread termination */
+
+CAMLnoreturn_start
+static void st_thread_exit(void)
+CAMLnoreturn_end;
+
+static void st_thread_exit(void)
+{
+  pthread_exit(NULL);
+}
+
+static void st_thread_join(st_thread_id thr)
+{
+  pthread_join(thr, NULL);
+  /* best effort: ignore errors */
+}
+
+/* Thread-specific state */
+
+typedef pthread_key_t st_tlskey;
+
+static int st_tls_newkey(st_tlskey * res)
+{
+  return pthread_key_create(res, NULL);
+}
+
+Caml_inline void * st_tls_get(st_tlskey k)
+{
+  return pthread_getspecific(k);
+}
+
+Caml_inline void st_tls_set(st_tlskey k, void * v)
+{
+  pthread_setspecific(k, v);
+}
+
+/* The master lock.  This is a mutex that is held most of the time,
+   so we implement it in a slightly convoluted way to avoid
+   all risks of busy-waiting.  Also, we count the number of waiting
+   threads. */
+
+typedef struct {
+  pthread_mutex_t lock;         /* to protect contents  */
+  int busy;                     /* 0 = free, 1 = taken */
+  volatile int waiters;         /* number of threads waiting on master lock */
+  pthread_cond_t is_free;       /* signaled when free */
+} st_masterlock;
+
+static void st_masterlock_init(st_masterlock * m)
+{
+  pthread_mutex_init(&m->lock, NULL);
+  pthread_cond_init(&m->is_free, NULL);
+  m->busy = 1;
+  m->waiters = 0;
+}
+
+static void st_masterlock_acquire(st_masterlock * m)
+{
+  pthread_mutex_lock(&m->lock);
+  while (m->busy) {
+    m->waiters ++;
+    pthread_cond_wait(&m->is_free, &m->lock);
+    m->waiters --;
+  }
+  m->busy = 1;
+  pthread_mutex_unlock(&m->lock);
+}
+
+static void st_masterlock_release(st_masterlock * m)
+{
+  pthread_mutex_lock(&m->lock);
+  m->busy = 0;
+  pthread_mutex_unlock(&m->lock);
+  pthread_cond_signal(&m->is_free);
+}
+
+CAMLno_tsan  /* This can be called for reading [waiters] without locking. */
+Caml_inline int st_masterlock_waiters(st_masterlock * m)
+{
+  return m->waiters;
+}
+
+/* Scheduling hints */
+
+/* This is mostly equivalent to release(); acquire(), but better. In particular,
+   release(); acquire(); leaves both us and the waiter we signal() racing to
+   acquire the lock. Calling yield or sleep helps there but does not solve the
+   problem. Sleeping ourselves is much more reliable--and since we're handing
+   off the lock to a waiter we know exists, it's safe, as they'll certainly
+   re-wake us later.
+*/
+Caml_inline void st_thread_yield(st_masterlock * m)
+{
+  pthread_mutex_lock(&m->lock);
+  /* We must hold the lock to call this. */
+  assert(m->busy);
+
+  /* We already checked this without the lock, but we might have raced--if
+     there's no waiter, there's nothing to do and no one to wake us if we did
+     wait, so just keep going. */
+  if (m->waiters == 0) {
+    pthread_mutex_unlock(&m->lock);
+    return;
+  }
+
+  m->busy = 0;
+  pthread_cond_signal(&m->is_free);
+  m->waiters++;
+  do {
+    /* Note: the POSIX spec prevents the above signal from pairing with this
+       wait, which is good: we'll reliably continue waiting until the next
+       yield() or enter_blocking_section() call (or we see a spurious condvar
+       wakeup, which are rare at best.) */
+       pthread_cond_wait(&m->is_free, &m->lock);
+  } while (m->busy);
+  m->busy = 1;
+  m->waiters--;
+  pthread_mutex_unlock(&m->lock);
+}
+
+/* Mutexes */
+
+typedef pthread_mutex_t * st_mutex;
+
+static int st_mutex_create(st_mutex * res)
+{
+  int rc;
+  st_mutex m = caml_stat_alloc_noexc(sizeof(pthread_mutex_t));
+  if (m == NULL) return ENOMEM;
+  rc = pthread_mutex_init(m, NULL);
+  if (rc != 0) { caml_stat_free(m); return rc; }
+  *res = m;
+  return 0;
+}
+
+static int st_mutex_destroy(st_mutex m)
+{
+  int rc;
+  rc = pthread_mutex_destroy(m);
+  caml_stat_free(m);
+  return rc;
+}
+
+Caml_inline int st_mutex_lock(st_mutex m)
+{
+  return pthread_mutex_lock(m);
+}
+
+#define PREVIOUSLY_UNLOCKED 0
+#define ALREADY_LOCKED EBUSY
+
+Caml_inline int st_mutex_trylock(st_mutex m)
+{
+  return pthread_mutex_trylock(m);
+}
+
+Caml_inline int st_mutex_unlock(st_mutex m)
+{
+  return pthread_mutex_unlock(m);
+}
+
+/* Condition variables */
+
+typedef pthread_cond_t * st_condvar;
+
+static int st_condvar_create(st_condvar * res)
+{
+  int rc;
+  st_condvar c = caml_stat_alloc_noexc(sizeof(pthread_cond_t));
+  if (c == NULL) return ENOMEM;
+  rc = pthread_cond_init(c, NULL);
+  if (rc != 0) { caml_stat_free(c); return rc; }
+  *res = c;
+  return 0;
+}
+
+static int st_condvar_destroy(st_condvar c)
+{
+  int rc;
+  rc = pthread_cond_destroy(c);
+  caml_stat_free(c);
+  return rc;
+}
+
+Caml_inline int st_condvar_signal(st_condvar c)
+{
+  return pthread_cond_signal(c);
+}
+
+Caml_inline int st_condvar_broadcast(st_condvar c)
+{
+  return pthread_cond_broadcast(c);
+}
+
+Caml_inline int st_condvar_wait(st_condvar c, st_mutex m)
+{
+  return pthread_cond_wait(c, m);
+}
+
+/* Triggered events */
+
+typedef struct st_event_struct {
+  pthread_mutex_t lock;         /* to protect contents */
+  int status;                   /* 0 = not triggered, 1 = triggered */
+  pthread_cond_t triggered;     /* signaled when triggered */
+} * st_event;
+
+static int st_event_create(st_event * res)
+{
+  int rc;
+  st_event e = caml_stat_alloc_noexc(sizeof(struct st_event_struct));
+  if (e == NULL) return ENOMEM;
+  rc = pthread_mutex_init(&e->lock, NULL);
+  if (rc != 0) { caml_stat_free(e); return rc; }
+  rc = pthread_cond_init(&e->triggered, NULL);
+  if (rc != 0)
+  { pthread_mutex_destroy(&e->lock); caml_stat_free(e); return rc; }
+  e->status = 0;
+  *res = e;
+  return 0;
+}
+
+static int st_event_destroy(st_event e)
+{
+  int rc1, rc2;
+  rc1 = pthread_mutex_destroy(&e->lock);
+  rc2 = pthread_cond_destroy(&e->triggered);
+  caml_stat_free(e);
+  return rc1 != 0 ? rc1 : rc2;
+}
+
+static int st_event_trigger(st_event e)
+{
+  int rc;
+  rc = pthread_mutex_lock(&e->lock);
+  if (rc != 0) return rc;
+  e->status = 1;
+  rc = pthread_mutex_unlock(&e->lock);
+  if (rc != 0) return rc;
+  rc = pthread_cond_broadcast(&e->triggered);
+  return rc;
+}
+
+static int st_event_wait(st_event e)
+{
+  int rc;
+  rc = pthread_mutex_lock(&e->lock);
+  if (rc != 0) return rc;
+  while(e->status == 0) {
+    rc = pthread_cond_wait(&e->triggered, &e->lock);
+    if (rc != 0) return rc;
+  }
+  rc = pthread_mutex_unlock(&e->lock);
+  return rc;
+}
+
+/* Reporting errors */
+
+static void st_check_error(int retcode, char * msg)
+{
+  char * err;
+  int errlen, msglen;
+  value str;
+
+  if (retcode == 0) return;
+  if (retcode == ENOMEM) caml_raise_out_of_memory();
+  err = strerror(retcode);
+  msglen = strlen(msg);
+  errlen = strlen(err);
+  str = caml_alloc_string(msglen + 2 + errlen);
+  memmove (&Byte(str, 0), msg, msglen);
+  memmove (&Byte(str, msglen), ": ", 2);
+  memmove (&Byte(str, msglen + 2), err, errlen);
+  caml_raise_sys_error(str);
+}
+
+/* Variable used to stop the "tick" thread */
+static volatile int caml_tick_thread_stop = 0;
+
+/* The tick thread: posts a SIGPREEMPTION signal periodically */
+
+static void * caml_thread_tick(void * arg)
+{
+  struct timeval timeout;
+  sigset_t mask;
+
+  /* Block all signals so that we don't try to execute an OCaml signal handler*/
+  sigfillset(&mask);
+  pthread_sigmask(SIG_BLOCK, &mask, NULL);
+  while(! caml_tick_thread_stop) {
+    /* select() seems to be the most efficient way to suspend the
+       thread for sub-second intervals */
+    timeout.tv_sec = 0;
+    timeout.tv_usec = Thread_timeout * 1000;
+    select(0, NULL, NULL, NULL, &timeout);
+    /* The preemption signal should never cause a callback, so don't
+     go through caml_handle_signal(), just record signal delivery via
+     caml_record_signal(). */
+    caml_record_signal(SIGPREEMPTION);
+  }
+  return NULL;
+}
+
+/* "At fork" processing */
+
+#if defined(__ANDROID__)
+/* Android's libc does not include declaration of pthread_atfork;
+   however, it implements it since API level 10 (Gingerbread).
+   The reason for the omission is that Android (GUI) applications
+   are not supposed to fork at all, however this workaround is still
+   included in case OCaml is used for an Android CLI utility. */
+int pthread_atfork(void (*prepare)(void), void (*parent)(void),
+                   void (*child)(void));
+#endif
+
+static int st_atfork(void (*fn)(void))
+{
+  return pthread_atfork(NULL, NULL, fn);
+}
+
+/* Signal handling */
+
+static void st_decode_sigset(value vset, sigset_t * set)
+{
+  sigemptyset(set);
+  while (vset != Val_int(0)) {
+    int sig = caml_convert_signal_number(Int_val(Field(vset, 0)));
+    sigaddset(set, sig);
+    vset = Field(vset, 1);
+  }
+}
+
+#ifndef NSIG
+#define NSIG 64
+#endif
+
+static value st_encode_sigset(sigset_t * set)
+{
+  value res = Val_int(0);
+  int i;
+
+  Begin_root(res)
+    for (i = 1; i < NSIG; i++)
+      if (sigismember(set, i) > 0) {
+        value newcons = caml_alloc_small(2, 0);
+        Field(newcons, 0) = Val_int(caml_rev_convert_signal_number(i));
+        Field(newcons, 1) = res;
+        res = newcons;
+      }
+  End_roots();
+  return res;
+}
+
+static int sigmask_cmd[3] = { SIG_SETMASK, SIG_BLOCK, SIG_UNBLOCK };
+
+value caml_thread_sigmask(value cmd, value sigs) /* ML */
+{
+  int how;
+  sigset_t set, oldset;
+  int retcode;
+
+  how = sigmask_cmd[Int_val(cmd)];
+  st_decode_sigset(sigs, &set);
+  caml_enter_blocking_section();
+  retcode = pthread_sigmask(how, &set, &oldset);
+  caml_leave_blocking_section();
+  st_check_error(retcode, "Thread.sigmask");
+  return st_encode_sigset(&oldset);
+}
+
+value caml_wait_signal(value sigs) /* ML */
+{
+#ifdef HAS_SIGWAIT
+  sigset_t set;
+  int retcode, signo;
+
+  st_decode_sigset(sigs, &set);
+  caml_enter_blocking_section();
+  retcode = sigwait(&set, &signo);
+  caml_leave_blocking_section();
+  st_check_error(retcode, "Thread.wait_signal");
+  return Val_int(caml_rev_convert_signal_number(signo));
+#else
+  caml_invalid_argument("Thread.wait_signal not implemented");
+  return Val_int(0);            /* not reached */
+#endif
+}
diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c
new file mode 100644
index 00000000..285466ed
--- /dev/null
+++ b/otherlibs/systhreads/st_stubs.c
@@ -0,0 +1,979 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 1995 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
+
+#include "caml/alloc.h"
+#include "caml/backtrace.h"
+#include "caml/callback.h"
+#include "caml/custom.h"
+#include "caml/domain.h"
+#include "caml/fail.h"
+#include "caml/io.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/printexc.h"
+#include "caml/roots.h"
+#include "caml/signals.h"
+#ifdef NATIVE_CODE
+#include "caml/stack.h"
+#else
+#include "caml/stacks.h"
+#endif
+#include "caml/sys.h"
+#include "caml/memprof.h"
+#include "threads.h"
+
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+#include "caml/spacetime.h"
+#endif
+
+#ifndef NATIVE_CODE
+/* Initial size of bytecode stack when a thread is created (4 Ko) */
+#define Thread_stack_size (Stack_size / 4)
+#endif
+
+/* Max computation time before rescheduling, in milliseconds */
+#define Thread_timeout 50
+
+/* OS-specific code */
+#ifdef _WIN32
+#include "st_win32.h"
+#else
+#include "st_posix.h"
+#endif
+
+/* The ML value describing a thread (heap-allocated) */
+
+struct caml_thread_descr {
+  value ident;                  /* Unique integer ID */
+  value start_closure;          /* The closure to start this thread */
+  value terminated;             /* Triggered event for thread termination */
+};
+
+#define Ident(v) (((struct caml_thread_descr *)(v))->ident)
+#define Start_closure(v) (((struct caml_thread_descr *)(v))->start_closure)
+#define Terminated(v) (((struct caml_thread_descr *)(v))->terminated)
+
+/* The infos on threads (allocated via caml_stat_alloc()) */
+
+struct caml_thread_struct {
+  value descr;              /* The heap-allocated descriptor (root) */
+  struct caml_thread_struct * next;  /* Double linking of running threads */
+  struct caml_thread_struct * prev;
+#ifdef NATIVE_CODE
+  char * top_of_stack;      /* Top of stack for this thread (approx.) */
+  char * bottom_of_stack;   /* Saved value of Caml_state->bottom_of_stack */
+  uintnat last_retaddr;     /* Saved value of Caml_state->last_return_address */
+  value * gc_regs;          /* Saved value of Caml_state->gc_regs */
+  char * exception_pointer; /* Saved value of Caml_state->exception_pointer */
+  struct caml__roots_block * local_roots; /* Saved value of local_roots */
+  struct longjmp_buffer * exit_buf; /* For thread exit */
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+  value internal_spacetime_trie_root;
+  value internal_spacetime_finaliser_trie_root;
+  value* spacetime_trie_node_ptr;
+  value* spacetime_finaliser_trie_root;
+#endif
+#else
+  value * stack_low; /* The execution stack for this thread */
+  value * stack_high;
+  value * stack_threshold;
+  value * sp;        /* Saved value of Caml_state->extern_sp for this thread */
+  value * trapsp;    /* Saved value of Caml_state->trapsp for this thread */
+  /* Saved value of Caml_state->local_roots */
+  struct caml__roots_block * local_roots;
+  struct longjmp_buffer * external_raise; /* Saved Caml_state->external_raise */
+#endif
+  int backtrace_pos; /* Saved Caml_state->backtrace_pos */
+  backtrace_slot * backtrace_buffer; /* Saved Caml_state->backtrace_buffer */
+  value backtrace_last_exn;  /* Saved Caml_state->backtrace_last_exn (root) */
+  struct caml_memprof_th_ctx memprof_ctx;
+};
+
+typedef struct caml_thread_struct * caml_thread_t;
+
+/* The "head" of the circular list of thread descriptors */
+static caml_thread_t all_threads = NULL;
+
+/* The descriptor for the currently executing thread */
+static caml_thread_t curr_thread = NULL;
+
+/* The master lock protecting the OCaml runtime system */
+static st_masterlock caml_master_lock;
+
+/* Whether the "tick" thread is already running */
+static int caml_tick_thread_running = 0;
+
+/* The thread identifier of the "tick" thread */
+static st_thread_id caml_tick_thread_id;
+
+/* The key used for storing the thread descriptor in the specific data
+   of the corresponding system thread. */
+static st_tlskey thread_descriptor_key;
+
+/* The key used for unlocking I/O channels on exceptions */
+static st_tlskey last_channel_locked_key;
+
+/* Identifier for next thread creation */
+static intnat thread_next_ident = 0;
+
+/* Forward declarations */
+static value caml_threadstatus_new (void);
+static void caml_threadstatus_terminate (value);
+static st_retcode caml_threadstatus_wait (value);
+
+/* Imports from the native-code runtime system */
+#ifdef NATIVE_CODE
+extern struct longjmp_buffer caml_termination_jmpbuf;
+extern void (*caml_termination_hook)(void);
+#endif
+
+/* Hook for scanning the stacks of the other threads */
+
+static void (*prev_scan_roots_hook) (scanning_action);
+
+static void caml_thread_scan_roots(scanning_action action)
+{
+  caml_thread_t th;
+
+  th = curr_thread;
+  do {
+    (*action)(th->descr, &th->descr);
+    (*action)(th->backtrace_last_exn, &th->backtrace_last_exn);
+    /* Don't rescan the stack of the current thread, it was done already */
+    if (th != curr_thread) {
+#ifdef NATIVE_CODE
+      if (th->bottom_of_stack != NULL)
+        caml_do_local_roots(action, th->bottom_of_stack, th->last_retaddr,
+                       th->gc_regs, th->local_roots);
+#else
+      caml_do_local_roots(action, th->sp, th->stack_high, th->local_roots);
+#endif
+    }
+    th = th->next;
+  } while (th != curr_thread);
+  /* Hook */
+  if (prev_scan_roots_hook != NULL) (*prev_scan_roots_hook)(action);
+}
+
+/* Saving and restoring runtime state in curr_thread */
+
+Caml_inline void caml_thread_save_runtime_state(void)
+{
+#ifdef NATIVE_CODE
+  curr_thread->top_of_stack = Caml_state->top_of_stack;
+  curr_thread->bottom_of_stack = Caml_state->bottom_of_stack;
+  curr_thread->last_retaddr = Caml_state->last_return_address;
+  curr_thread->gc_regs = Caml_state->gc_regs;
+  curr_thread->exception_pointer = Caml_state->exception_pointer;
+#ifdef WITH_SPACETIME
+  curr_thread->spacetime_trie_node_ptr
+    = caml_spacetime_trie_node_ptr;
+  curr_thread->spacetime_finaliser_trie_root
+    = caml_spacetime_finaliser_trie_root;
+#endif
+#else
+  curr_thread->stack_low = Caml_state->stack_low;
+  curr_thread->stack_high = Caml_state->stack_high;
+  curr_thread->stack_threshold = Caml_state->stack_threshold;
+  curr_thread->sp = Caml_state->extern_sp;
+  curr_thread->trapsp = Caml_state->trapsp;
+  curr_thread->external_raise = Caml_state->external_raise;
+#endif
+  curr_thread->local_roots = Caml_state->local_roots;
+  curr_thread->backtrace_pos = Caml_state->backtrace_pos;
+  curr_thread->backtrace_buffer = Caml_state->backtrace_buffer;
+  curr_thread->backtrace_last_exn = Caml_state->backtrace_last_exn;
+  caml_memprof_save_th_ctx(&curr_thread->memprof_ctx);
+}
+
+Caml_inline void caml_thread_restore_runtime_state(void)
+{
+#ifdef NATIVE_CODE
+  Caml_state->top_of_stack = curr_thread->top_of_stack;
+  Caml_state->bottom_of_stack= curr_thread->bottom_of_stack;
+  Caml_state->last_return_address = curr_thread->last_retaddr;
+  Caml_state->gc_regs = curr_thread->gc_regs;
+  Caml_state->exception_pointer = curr_thread->exception_pointer;
+#ifdef WITH_SPACETIME
+  caml_spacetime_trie_node_ptr
+    = curr_thread->spacetime_trie_node_ptr;
+  caml_spacetime_finaliser_trie_root
+    = curr_thread->spacetime_finaliser_trie_root;
+#endif
+#else
+  Caml_state->stack_low = curr_thread->stack_low;
+  Caml_state->stack_high = curr_thread->stack_high;
+  Caml_state->stack_threshold = curr_thread->stack_threshold;
+  Caml_state->extern_sp = curr_thread->sp;
+  Caml_state->trapsp = curr_thread->trapsp;
+  Caml_state->external_raise = curr_thread->external_raise;
+#endif
+  Caml_state->local_roots = curr_thread->local_roots;
+  Caml_state->backtrace_pos = curr_thread->backtrace_pos;
+  Caml_state->backtrace_buffer = curr_thread->backtrace_buffer;
+  Caml_state->backtrace_last_exn = curr_thread->backtrace_last_exn;
+  caml_memprof_restore_th_ctx(&curr_thread->memprof_ctx);
+}
+
+/* Hooks for caml_enter_blocking_section and caml_leave_blocking_section */
+
+
+static void caml_thread_enter_blocking_section(void)
+{
+  /* Save the current runtime state in the thread descriptor
+     of the current thread */
+  caml_thread_save_runtime_state();
+  /* Tell other threads that the runtime is free */
+  st_masterlock_release(&caml_master_lock);
+}
+
+static void caml_thread_leave_blocking_section(void)
+{
+  /* Wait until the runtime is free */
+  st_masterlock_acquire(&caml_master_lock);
+  /* Update curr_thread to point to the thread descriptor corresponding
+     to the thread currently executing */
+  curr_thread = st_tls_get(thread_descriptor_key);
+  /* Restore the runtime state from the curr_thread descriptor */
+  caml_thread_restore_runtime_state();
+}
+
+static int caml_thread_try_leave_blocking_section(void)
+{
+  /* Disable immediate processing of signals (PR#3659).
+     try_leave_blocking_section always fails, forcing the signal to be
+     recorded and processed at the next leave_blocking_section or
+     polling. */
+  return 0;
+}
+
+/* Hooks for I/O locking */
+
+static void caml_io_mutex_free(struct channel *chan)
+{
+  st_mutex mutex = chan->mutex;
+  if (mutex != NULL) {
+    st_mutex_destroy(mutex);
+    chan->mutex = NULL;
+  }
+}
+
+static void caml_io_mutex_lock(struct channel *chan)
+{
+  st_mutex mutex = chan->mutex;
+
+  if (mutex == NULL) {
+    st_check_error(st_mutex_create(&mutex), "channel locking"); /*PR#7038*/
+    chan->mutex = mutex;
+  }
+  /* PR#4351: first try to acquire mutex without releasing the master lock */
+  if (st_mutex_trylock(mutex) == PREVIOUSLY_UNLOCKED) {
+    st_tls_set(last_channel_locked_key, (void *) chan);
+    return;
+  }
+  /* If unsuccessful, block on mutex */
+  caml_enter_blocking_section();
+  st_mutex_lock(mutex);
+  /* Problem: if a signal occurs at this point,
+     and the signal handler raises an exception, we will not
+     unlock the mutex.  The alternative (doing the setspecific
+     before locking the mutex is also incorrect, since we could
+     then unlock a mutex that is unlocked or locked by someone else. */
+  st_tls_set(last_channel_locked_key, (void *) chan);
+  caml_leave_blocking_section();
+}
+
+static void caml_io_mutex_unlock(struct channel *chan)
+{
+  st_mutex_unlock(chan->mutex);
+  st_tls_set(last_channel_locked_key, NULL);
+}
+
+static void caml_io_mutex_unlock_exn(void)
+{
+  struct channel * chan = st_tls_get(last_channel_locked_key);
+  if (chan != NULL) caml_io_mutex_unlock(chan);
+}
+
+/* Hook for estimating stack usage */
+
+static uintnat (*prev_stack_usage_hook)(void);
+
+static uintnat caml_thread_stack_usage(void)
+{
+  uintnat sz;
+  caml_thread_t th;
+
+  /* Don't add stack for current thread, this is done elsewhere */
+  for (sz = 0, th = curr_thread->next;
+       th != curr_thread;
+       th = th->next) {
+#ifdef NATIVE_CODE
+  if(th->top_of_stack != NULL && th->bottom_of_stack != NULL &&
+     th->top_of_stack > th->bottom_of_stack)
+       sz += (value *) th->top_of_stack - (value *) th->bottom_of_stack;
+#else
+    sz += th->stack_high - th->sp;
+#endif
+  }
+  if (prev_stack_usage_hook != NULL)
+    sz += prev_stack_usage_hook();
+  return sz;
+}
+
+/* Create and setup a new thread info block.
+   This block has no associated thread descriptor and
+   is not inserted in the list of threads. */
+
+static caml_thread_t caml_thread_new_info(void)
+{
+  caml_thread_t th;
+  th = (caml_thread_t) caml_stat_alloc_noexc(sizeof(struct caml_thread_struct));
+  if (th == NULL) return NULL;
+  th->descr = Val_unit;         /* filled later */
+#ifdef NATIVE_CODE
+  th->bottom_of_stack = NULL;
+  th->top_of_stack = NULL;
+  th->last_retaddr = 1;
+  th->exception_pointer = NULL;
+  th->local_roots = NULL;
+  th->exit_buf = NULL;
+#ifdef WITH_SPACETIME
+  /* CR-someday mshinwell: The commented-out changes here are for multicore,
+     where we think we should have one trie per domain. */
+  th->internal_spacetime_trie_root = Val_unit;
+  th->spacetime_trie_node_ptr =
+    &caml_spacetime_trie_root; /* &th->internal_spacetime_trie_root; */
+  th->internal_spacetime_finaliser_trie_root = Val_unit;
+  th->spacetime_finaliser_trie_root
+    = caml_spacetime_finaliser_trie_root;
+    /* &th->internal_spacetime_finaliser_trie_root; */
+  caml_spacetime_register_thread(
+    th->spacetime_trie_node_ptr,
+    th->spacetime_finaliser_trie_root);
+#endif
+#else
+  /* Allocate the stacks */
+  th->stack_low = (value *) caml_stat_alloc(Thread_stack_size);
+  th->stack_high = th->stack_low + Thread_stack_size / sizeof(value);
+  th->stack_threshold = th->stack_low + Stack_threshold / sizeof(value);
+  th->sp = th->stack_high;
+  th->trapsp = th->stack_high;
+  th->local_roots = NULL;
+  th->external_raise = NULL;
+#endif
+  th->backtrace_pos = 0;
+  th->backtrace_buffer = NULL;
+  th->backtrace_last_exn = Val_unit;
+  caml_memprof_init_th_ctx(&th->memprof_ctx);
+  return th;
+}
+
+/* Allocate a thread descriptor block. */
+
+static value caml_thread_new_descriptor(value clos)
+{
+  value mu = Val_unit;
+  value descr;
+  Begin_roots2 (clos, mu)
+    /* Create and initialize the termination semaphore */
+    mu = caml_threadstatus_new();
+    /* Create a descriptor for the new thread */
+    descr = caml_alloc_small(3, 0);
+    Ident(descr) = Val_long(thread_next_ident);
+    Start_closure(descr) = clos;
+    Terminated(descr) = mu;
+    thread_next_ident++;
+  End_roots();
+  return descr;
+}
+
+/* Remove a thread info block from the list of threads.
+   Free it and its stack resources. */
+
+static void caml_thread_remove_info(caml_thread_t th)
+{
+  if (th->next == th)
+    all_threads = NULL; /* last OCaml thread exiting */
+  else if (all_threads == th)
+    all_threads = th->next;     /* PR#5295 */
+  th->next->prev = th->prev;
+  th->prev->next = th->next;
+#ifndef NATIVE_CODE
+  caml_stat_free(th->stack_low);
+#endif
+  if (th->backtrace_buffer != NULL) caml_stat_free(th->backtrace_buffer);
+#ifndef WITH_SPACETIME
+  caml_stat_free(th);
+  /* CR-soon mshinwell: consider what to do about the Spacetime trace.  Could
+     perhaps have a hook to save a snapshot on thread termination.
+     For the moment we can't even free [th], since it contains the trie
+     roots. */
+#endif
+}
+
+/* Reinitialize the thread machinery after a fork() (PR#4577) */
+
+static void caml_thread_reinitialize(void)
+{
+  caml_thread_t thr, next;
+  struct channel * chan;
+
+  /* Remove all other threads (now nonexistent)
+     from the doubly-linked list of threads */
+  thr = curr_thread->next;
+  while (thr != curr_thread) {
+    next = thr->next;
+    caml_stat_free(thr);
+    thr = next;
+  }
+  curr_thread->next = curr_thread;
+  curr_thread->prev = curr_thread;
+  all_threads = curr_thread;
+  /* Reinitialize the master lock machinery,
+     just in case the fork happened while other threads were doing
+     caml_leave_blocking_section */
+  st_masterlock_init(&caml_master_lock);
+  /* Tick thread is not currently running in child process, will be
+     re-created at next Thread.create */
+  caml_tick_thread_running = 0;
+  /* Destroy all IO mutexes; will be reinitialized on demand */
+  for (chan = caml_all_opened_channels;
+       chan != NULL;
+       chan = chan->next) {
+    if (chan->mutex != NULL) {
+      st_mutex_destroy(chan->mutex);
+      chan->mutex = NULL;
+    }
+  }
+}
+
+/* Initialize the thread machinery */
+
+CAMLprim value caml_thread_initialize(value unit)   /* ML */
+{
+  /* Protect against repeated initialization (PR#3532) */
+  if (curr_thread != NULL) return Val_unit;
+  /* OS-specific initialization */
+  st_initialize();
+  /* Initialize and acquire the master lock */
+  st_masterlock_init(&caml_master_lock);
+  /* Initialize the keys */
+  st_tls_newkey(&thread_descriptor_key);
+  st_tls_newkey(&last_channel_locked_key);
+  /* Set up a thread info block for the current thread */
+  curr_thread =
+    (caml_thread_t) caml_stat_alloc(sizeof(struct caml_thread_struct));
+  curr_thread->descr = caml_thread_new_descriptor(Val_unit);
+  curr_thread->next = curr_thread;
+  curr_thread->prev = curr_thread;
+  all_threads = curr_thread;
+  curr_thread->backtrace_last_exn = Val_unit;
+#ifdef NATIVE_CODE
+  curr_thread->exit_buf = &caml_termination_jmpbuf;
+#endif
+  /* The stack-related fields will be filled in at the next
+     caml_enter_blocking_section */
+  /* Associate the thread descriptor with the thread */
+  st_tls_set(thread_descriptor_key, (void *) curr_thread);
+  /* Set up the hooks */
+  prev_scan_roots_hook = caml_scan_roots_hook;
+  caml_scan_roots_hook = caml_thread_scan_roots;
+  caml_enter_blocking_section_hook = caml_thread_enter_blocking_section;
+  caml_leave_blocking_section_hook = caml_thread_leave_blocking_section;
+  caml_try_leave_blocking_section_hook = caml_thread_try_leave_blocking_section;
+#ifdef NATIVE_CODE
+  caml_termination_hook = st_thread_exit;
+#endif
+  caml_channel_mutex_free = caml_io_mutex_free;
+  caml_channel_mutex_lock = caml_io_mutex_lock;
+  caml_channel_mutex_unlock = caml_io_mutex_unlock;
+  caml_channel_mutex_unlock_exn = caml_io_mutex_unlock_exn;
+  prev_stack_usage_hook = caml_stack_usage_hook;
+  caml_stack_usage_hook = caml_thread_stack_usage;
+  /* Set up fork() to reinitialize the thread machinery in the child
+     (PR#4577) */
+  st_atfork(caml_thread_reinitialize);
+  return Val_unit;
+}
+
+/* Cleanup the thread machinery when the runtime is shut down. Joining the tick
+   thread take 25ms on average / 50ms in the worst case, so we don't do it on
+   program exit. */
+
+CAMLprim value caml_thread_cleanup(value unit)   /* ML */
+{
+  if (caml_tick_thread_running){
+    caml_tick_thread_stop = 1;
+    st_thread_join(caml_tick_thread_id);
+    caml_tick_thread_stop = 0;
+    caml_tick_thread_running = 0;
+  }
+  return Val_unit;
+}
+
+/* Thread cleanup at termination */
+
+static void caml_thread_stop(void)
+{
+  /* PR#5188, PR#7220: some of the global runtime state may have
+     changed as the thread was running, so we save it in the
+     curr_thread data to make sure that the cleanup logic
+     below uses accurate information. */
+  caml_thread_save_runtime_state();
+  /* Tell memprof that this thread is terminating. */
+  caml_memprof_stop_th_ctx(&curr_thread->memprof_ctx);
+  /* Signal that the thread has terminated */
+  caml_threadstatus_terminate(Terminated(curr_thread->descr));
+  /* Remove th from the doubly-linked list of threads and free its info block */
+  caml_thread_remove_info(curr_thread);
+  /* OS-specific cleanups */
+  st_thread_cleanup();
+  /* Release the runtime system */
+  st_masterlock_release(&caml_master_lock);
+}
+
+/* Create a thread */
+
+static ST_THREAD_FUNCTION caml_thread_start(void * arg)
+{
+  caml_thread_t th = (caml_thread_t) arg;
+  value clos;
+#ifdef NATIVE_CODE
+  struct longjmp_buffer termination_buf;
+  char tos;
+  /* Record top of stack (approximative) */
+  th->top_of_stack = &tos;
+#endif
+
+  /* Associate the thread descriptor with the thread */
+  st_tls_set(thread_descriptor_key, (void *) th);
+  /* Acquire the global mutex */
+  caml_leave_blocking_section();
+  caml_setup_stack_overflow_detection();
+#ifdef NATIVE_CODE
+  /* Setup termination handler (for caml_thread_exit) */
+  if (sigsetjmp(termination_buf.buf, 0) == 0) {
+    th->exit_buf = &termination_buf;
+#endif
+    /* Callback the closure */
+    clos = Start_closure(th->descr);
+    caml_modify(&(Start_closure(th->descr)), Val_unit);
+    caml_callback_exn(clos, Val_unit);
+    caml_thread_stop();
+#ifdef NATIVE_CODE
+  }
+#endif
+  /* The thread now stops running */
+  return 0;
+}
+
+CAMLprim value caml_thread_new(value clos)          /* ML */
+{
+  caml_thread_t th;
+  st_retcode err;
+
+  /* Create a thread info block */
+  th = caml_thread_new_info();
+  if (th == NULL) caml_raise_out_of_memory();
+  /* Equip it with a thread descriptor */
+  th->descr = caml_thread_new_descriptor(clos);
+  /* Add thread info block to the list of threads */
+  th->next = curr_thread->next;
+  th->prev = curr_thread;
+  curr_thread->next->prev = th;
+  curr_thread->next = th;
+  /* Create the new thread */
+  err = st_thread_create(NULL, caml_thread_start, (void *) th);
+  if (err != 0) {
+    /* Creation failed, remove thread info block from list of threads */
+    caml_thread_remove_info(th);
+    st_check_error(err, "Thread.create");
+  }
+  /* Create the tick thread if not already done.
+     Because of PR#4666, we start the tick thread late, only when we create
+     the first additional thread in the current process*/
+  if (! caml_tick_thread_running) {
+    err = st_thread_create(&caml_tick_thread_id, caml_thread_tick, NULL);
+    st_check_error(err, "Thread.create");
+    caml_tick_thread_running = 1;
+  }
+  return th->descr;
+}
+
+/* Register a thread already created from C */
+
+CAMLexport int caml_c_thread_register(void)
+{
+  caml_thread_t th;
+  st_retcode err;
+
+  /* Already registered? */
+  if (st_tls_get(thread_descriptor_key) != NULL) return 0;
+  /* Create a thread info block */
+  th = caml_thread_new_info();
+  if (th == NULL) return 0;
+#ifdef NATIVE_CODE
+  th->top_of_stack = (char *) &err;
+#endif
+  /* Take master lock to protect access to the chaining of threads */
+  st_masterlock_acquire(&caml_master_lock);
+  /* Add thread info block to the list of threads */
+  if (all_threads == NULL) {
+    th->next = th;
+    th->prev = th;
+    all_threads = th;
+  } else {
+    th->next = all_threads->next;
+    th->prev = all_threads;
+    all_threads->next->prev = th;
+    all_threads->next = th;
+  }
+  /* Associate the thread descriptor with the thread */
+  st_tls_set(thread_descriptor_key, (void *) th);
+  /* Release the master lock */
+  st_masterlock_release(&caml_master_lock);
+  /* Now we can re-enter the run-time system and heap-allocate the descriptor */
+  caml_leave_blocking_section();
+  th->descr = caml_thread_new_descriptor(Val_unit);  /* no closure */
+  /* Create the tick thread if not already done.  */
+  if (! caml_tick_thread_running) {
+    err = st_thread_create(&caml_tick_thread_id, caml_thread_tick, NULL);
+    if (err == 0) caml_tick_thread_running = 1;
+  }
+  /* Exit the run-time system */
+  caml_enter_blocking_section();
+  return 1;
+}
+
+/* Unregister a thread that was created from C and registered with
+   the function above */
+
+CAMLexport int caml_c_thread_unregister(void)
+{
+  caml_thread_t th = st_tls_get(thread_descriptor_key);
+  /* Not registered? */
+  if (th == NULL) return 0;
+  /* Wait until the runtime is available */
+  st_masterlock_acquire(&caml_master_lock);
+  /* Forget the thread descriptor */
+  st_tls_set(thread_descriptor_key, NULL);
+  /* Remove thread info block from list of threads, and free it */
+  caml_thread_remove_info(th);
+  /* Release the runtime */
+  st_masterlock_release(&caml_master_lock);
+  return 1;
+}
+
+/* Return the current thread */
+
+CAMLprim value caml_thread_self(value unit)         /* ML */
+{
+  if (curr_thread == NULL)
+    caml_invalid_argument("Thread.self: not initialized");
+  return curr_thread->descr;
+}
+
+/* Return the identifier of a thread */
+
+CAMLprim value caml_thread_id(value th)          /* ML */
+{
+  return Ident(th);
+}
+
+/* Print uncaught exception and backtrace */
+
+CAMLprim value caml_thread_uncaught_exception(value exn)  /* ML */
+{
+  char * msg = caml_format_exception(exn);
+  fprintf(stderr, "Thread %d killed on uncaught exception %s\n",
+          Int_val(Ident(curr_thread->descr)), msg);
+  caml_stat_free(msg);
+  if (Caml_state->backtrace_active) caml_print_exception_backtrace();
+  fflush(stderr);
+  return Val_unit;
+}
+
+/* Terminate current thread */
+
+CAMLprim value caml_thread_exit(value unit)   /* ML */
+{
+  struct longjmp_buffer * exit_buf = NULL;
+
+  if (curr_thread == NULL)
+    caml_invalid_argument("Thread.exit: not initialized");
+
+  /* In native code, we cannot call pthread_exit here because on some
+     systems this raises a C++ exception, and ocamlopt-generated stack
+     frames cannot be unwound.  Instead, we longjmp to the thread
+     creation point (in caml_thread_start) or to the point in
+     caml_main where caml_termination_hook will be called.
+     Note that threads created in C then registered do not have
+     a creation point (exit_buf == NULL).
+ */
+#ifdef NATIVE_CODE
+  exit_buf = curr_thread->exit_buf;
+#endif
+  caml_thread_stop();
+  if (exit_buf != NULL) {
+    /* Native-code and (main thread or thread created by OCaml) */
+    siglongjmp(exit_buf->buf, 1);
+  } else {
+    /* Bytecode, or thread created from C */
+    st_thread_exit();
+  }
+  return Val_unit;  /* not reached */
+}
+
+/* Allow re-scheduling */
+
+CAMLprim value caml_thread_yield(value unit)        /* ML */
+{
+  if (st_masterlock_waiters(&caml_master_lock) == 0) return Val_unit;
+
+  /* Do all the parts of a blocking section enter/leave except lock
+     manipulation, which we'll do more efficiently in st_thread_yield. (Since
+     our blocking section doesn't contain anything interesting, don't bother
+     with saving errno.)
+  */
+  caml_raise_if_exception(caml_process_pending_signals_exn());
+  caml_thread_save_runtime_state();
+  st_thread_yield(&caml_master_lock);
+  curr_thread = st_tls_get(thread_descriptor_key);
+  caml_thread_restore_runtime_state();
+  caml_raise_if_exception(caml_process_pending_signals_exn());
+
+  return Val_unit;
+}
+
+/* Suspend the current thread until another thread terminates */
+
+CAMLprim value caml_thread_join(value th)          /* ML */
+{
+  st_retcode rc = caml_threadstatus_wait(Terminated(th));
+  st_check_error(rc, "Thread.join");
+  return Val_unit;
+}
+
+/* Mutex operations */
+
+#define Mutex_val(v) (* ((st_mutex *) Data_custom_val(v)))
+
+static void caml_mutex_finalize(value wrapper)
+{
+  st_mutex_destroy(Mutex_val(wrapper));
+}
+
+static int caml_mutex_compare(value wrapper1, value wrapper2)
+{
+  st_mutex mut1 = Mutex_val(wrapper1);
+  st_mutex mut2 = Mutex_val(wrapper2);
+  return mut1 == mut2 ? 0 : mut1 < mut2 ? -1 : 1;
+}
+
+static intnat caml_mutex_hash(value wrapper)
+{
+  return (intnat) (Mutex_val(wrapper));
+}
+
+static struct custom_operations caml_mutex_ops = {
+  "_mutex",
+  caml_mutex_finalize,
+  caml_mutex_compare,
+  caml_mutex_hash,
+  custom_serialize_default,
+  custom_deserialize_default,
+  custom_compare_ext_default,
+  custom_fixed_length_default
+};
+
+CAMLprim value caml_mutex_new(value unit)        /* ML */
+{
+  st_mutex mut = NULL;          /* suppress warning */
+  value wrapper;
+  st_check_error(st_mutex_create(&mut), "Mutex.create");
+  wrapper = caml_alloc_custom(&caml_mutex_ops, sizeof(st_mutex *),
+                              0, 1);
+  Mutex_val(wrapper) = mut;
+  return wrapper;
+}
+
+CAMLprim value caml_mutex_lock(value wrapper)     /* ML */
+{
+  st_mutex mut = Mutex_val(wrapper);
+  st_retcode retcode;
+
+  /* PR#4351: first try to acquire mutex without releasing the master lock */
+  if (st_mutex_trylock(mut) == PREVIOUSLY_UNLOCKED) return Val_unit;
+  /* If unsuccessful, block on mutex */
+  Begin_root(wrapper)           /* prevent the deallocation of mutex */
+    caml_enter_blocking_section();
+    retcode = st_mutex_lock(mut);
+    caml_leave_blocking_section();
+  End_roots();
+  st_check_error(retcode, "Mutex.lock");
+  return Val_unit;
+}
+
+CAMLprim value caml_mutex_unlock(value wrapper)           /* ML */
+{
+  st_mutex mut = Mutex_val(wrapper);
+  st_retcode retcode;
+  /* PR#4351: no need to release and reacquire master lock */
+  retcode = st_mutex_unlock(mut);
+  st_check_error(retcode, "Mutex.unlock");
+  return Val_unit;
+}
+
+CAMLprim value caml_mutex_try_lock(value wrapper)           /* ML */
+{
+  st_mutex mut = Mutex_val(wrapper);
+  st_retcode retcode;
+  retcode = st_mutex_trylock(mut);
+  if (retcode == ALREADY_LOCKED) return Val_false;
+  st_check_error(retcode, "Mutex.try_lock");
+  return Val_true;
+}
+
+/* Conditions operations */
+
+#define Condition_val(v) (* (st_condvar *) Data_custom_val(v))
+
+static void caml_condition_finalize(value wrapper)
+{
+  st_condvar_destroy(Condition_val(wrapper));
+}
+
+static int caml_condition_compare(value wrapper1, value wrapper2)
+{
+  st_condvar cond1 = Condition_val(wrapper1);
+  st_condvar cond2 = Condition_val(wrapper2);
+  return cond1 == cond2 ? 0 : cond1 < cond2 ? -1 : 1;
+}
+
+static intnat caml_condition_hash(value wrapper)
+{
+  return (intnat) (Condition_val(wrapper));
+}
+
+static struct custom_operations caml_condition_ops = {
+  "_condition",
+  caml_condition_finalize,
+  caml_condition_compare,
+  caml_condition_hash,
+  custom_serialize_default,
+  custom_deserialize_default,
+  custom_compare_ext_default,
+  custom_fixed_length_default
+};
+
+CAMLprim value caml_condition_new(value unit)        /* ML */
+{
+  st_condvar cond = NULL;       /* suppress warning */
+  value wrapper;
+  st_check_error(st_condvar_create(&cond), "Condition.create");
+  wrapper = caml_alloc_custom(&caml_condition_ops, sizeof(st_condvar *),
+                              0, 1);
+  Condition_val(wrapper) = cond;
+  return wrapper;
+}
+
+CAMLprim value caml_condition_wait(value wcond, value wmut)           /* ML */
+{
+  st_condvar cond = Condition_val(wcond);
+  st_mutex mut = Mutex_val(wmut);
+  st_retcode retcode;
+
+  Begin_roots2(wcond, wmut)     /* prevent deallocation of cond and mutex */
+    caml_enter_blocking_section();
+    retcode = st_condvar_wait(cond, mut);
+    caml_leave_blocking_section();
+  End_roots();
+  st_check_error(retcode, "Condition.wait");
+  return Val_unit;
+}
+
+CAMLprim value caml_condition_signal(value wrapper)           /* ML */
+{
+  st_check_error(st_condvar_signal(Condition_val(wrapper)),
+                 "Condition.signal");
+  return Val_unit;
+}
+
+CAMLprim value caml_condition_broadcast(value wrapper)           /* ML */
+{
+  st_check_error(st_condvar_broadcast(Condition_val(wrapper)),
+                 "Condition.broadcast");
+  return Val_unit;
+}
+
+/* Thread status blocks */
+
+#define Threadstatus_val(v) (* ((st_event *) Data_custom_val(v)))
+
+static void caml_threadstatus_finalize(value wrapper)
+{
+  st_event_destroy(Threadstatus_val(wrapper));
+}
+
+static int caml_threadstatus_compare(value wrapper1, value wrapper2)
+{
+  st_event ts1 = Threadstatus_val(wrapper1);
+  st_event ts2 = Threadstatus_val(wrapper2);
+  return ts1 == ts2 ? 0 : ts1 < ts2 ? -1 : 1;
+}
+
+static struct custom_operations caml_threadstatus_ops = {
+  "_threadstatus",
+  caml_threadstatus_finalize,
+  caml_threadstatus_compare,
+  custom_hash_default,
+  custom_serialize_default,
+  custom_deserialize_default,
+  custom_compare_ext_default,
+  custom_fixed_length_default
+};
+
+static value caml_threadstatus_new (void)
+{
+  st_event ts = NULL;           /* suppress warning */
+  value wrapper;
+  st_check_error(st_event_create(&ts), "Thread.create");
+  wrapper = caml_alloc_custom(&caml_threadstatus_ops, sizeof(st_event *),
+                              0, 1);
+  Threadstatus_val(wrapper) = ts;
+  return wrapper;
+}
+
+static void caml_threadstatus_terminate (value wrapper)
+{
+  st_event_trigger(Threadstatus_val(wrapper));
+}
+
+static st_retcode caml_threadstatus_wait (value wrapper)
+{
+  st_event ts = Threadstatus_val(wrapper);
+  st_retcode retcode;
+
+  Begin_roots1(wrapper)         /* prevent deallocation of ts */
+    caml_enter_blocking_section();
+    retcode = st_event_wait(ts);
+    caml_leave_blocking_section();
+  End_roots();
+  return retcode;
+}
diff --git a/otherlibs/systhreads/st_win32.h b/otherlibs/systhreads/st_win32.h
new file mode 100644
index 00000000..ab4e2b59
--- /dev/null
+++ b/otherlibs/systhreads/st_win32.h
@@ -0,0 +1,432 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2009 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Win32 implementation of the "st" interface */
+
+#undef _WIN32_WINNT
+#define _WIN32_WINNT 0x0400
+#include <windows.h>
+#include <winerror.h>
+#include <stdio.h>
+#include <signal.h>
+
+#include <caml/osdeps.h>
+
+#if 1
+#define TRACE(x)
+#define TRACE1(x,y)
+#else
+#include <stdio.h>
+#define TRACE(x) printf("%d: %s\n", GetCurrentThreadId(), x); fflush(stdout)
+#define TRACE1(x,y) printf("%d: %s %p\n", GetCurrentThreadId(), x, (void *)y); \
+                    fflush(stdout)
+#endif
+
+typedef DWORD st_retcode;
+
+#define SIGPREEMPTION SIGTERM
+
+/* Thread-local storage associating a Win32 event to every thread. */
+static DWORD st_thread_sem_key;
+
+/* OS-specific initialization */
+
+static DWORD st_initialize(void)
+{
+  st_thread_sem_key = TlsAlloc();
+  if (st_thread_sem_key == TLS_OUT_OF_INDEXES)
+    return GetLastError();
+  else
+    return 0;
+}
+
+/* Thread creation.  Created in detached mode if [res] is NULL. */
+
+typedef HANDLE st_thread_id;
+
+static DWORD st_thread_create(st_thread_id * res,
+                              LPTHREAD_START_ROUTINE fn, void * arg)
+{
+  HANDLE h = CreateThread(NULL, 0, fn, arg, 0, NULL);
+  TRACE1("st_thread_create", h);
+  if (h == NULL) return GetLastError();
+  if (res == NULL)
+    CloseHandle(h);
+  else
+    *res = h;
+  return 0;
+}
+
+#define ST_THREAD_FUNCTION DWORD WINAPI
+
+/* Cleanup at thread exit */
+
+static void st_thread_cleanup(void)
+{
+  HANDLE ev = (HANDLE) TlsGetValue(st_thread_sem_key);
+  if (ev != NULL) CloseHandle(ev);
+}
+
+/* Thread termination */
+
+CAMLnoreturn_start
+static void st_thread_exit(void)
+CAMLnoreturn_end;
+
+static void st_thread_exit(void)
+{
+  TRACE("st_thread_exit");
+  ExitThread(0);
+}
+
+static void st_thread_join(st_thread_id thr)
+{
+  TRACE1("st_thread_join", h);
+  WaitForSingleObject(thr, INFINITE);
+}
+
+/* Thread-specific state */
+
+typedef DWORD st_tlskey;
+
+static DWORD st_tls_newkey(st_tlskey * res)
+{
+  *res = TlsAlloc();
+  if (*res == TLS_OUT_OF_INDEXES)
+    return GetLastError();
+  else
+    return 0;
+}
+
+Caml_inline void * st_tls_get(st_tlskey k)
+{
+  return TlsGetValue(k);
+}
+
+Caml_inline void st_tls_set(st_tlskey k, void * v)
+{
+  TlsSetValue(k, v);
+}
+
+/* The master lock.  */
+
+typedef CRITICAL_SECTION st_masterlock;
+
+static void st_masterlock_init(st_masterlock * m)
+{
+  TRACE("st_masterlock_init");
+  InitializeCriticalSection(m);
+  EnterCriticalSection(m);
+}
+
+Caml_inline void st_masterlock_acquire(st_masterlock * m)
+{
+  TRACE("st_masterlock_acquire");
+  EnterCriticalSection(m);
+  TRACE("st_masterlock_acquire (done)");
+}
+
+Caml_inline void st_masterlock_release(st_masterlock * m)
+{
+  LeaveCriticalSection(m);
+  TRACE("st_masterlock_released");
+}
+
+Caml_inline int st_masterlock_waiters(st_masterlock * m)
+{
+  return 1;                     /* info not maintained */
+}
+
+/* Scheduling hints */
+
+Caml_inline void st_thread_yield(st_masterlock * m)
+{
+  LeaveCriticalSection(m);
+  Sleep(0);
+  EnterCriticalSection(m);
+}
+
+/* Mutexes */
+
+typedef CRITICAL_SECTION * st_mutex;
+
+static DWORD st_mutex_create(st_mutex * res)
+{
+  st_mutex m = caml_stat_alloc_noexc(sizeof(CRITICAL_SECTION));
+  if (m == NULL) return ERROR_NOT_ENOUGH_MEMORY;
+  InitializeCriticalSection(m);
+  *res = m;
+  return 0;
+}
+
+static DWORD st_mutex_destroy(st_mutex m)
+{
+  DeleteCriticalSection(m);
+  caml_stat_free(m);
+  return 0;
+}
+
+Caml_inline DWORD st_mutex_lock(st_mutex m)
+{
+  TRACE1("st_mutex_lock", m);
+  EnterCriticalSection(m);
+  TRACE1("st_mutex_lock (done)", m);
+  return 0;
+}
+
+/* Error codes with the 29th bit set are reserved for the application */
+
+#define PREVIOUSLY_UNLOCKED 0
+#define ALREADY_LOCKED (1<<29)
+
+Caml_inline DWORD st_mutex_trylock(st_mutex m)
+{
+  TRACE1("st_mutex_trylock", m);
+  if (TryEnterCriticalSection(m)) {
+    TRACE1("st_mutex_trylock (success)", m);
+    return PREVIOUSLY_UNLOCKED;
+  } else {
+    TRACE1("st_mutex_trylock (failure)", m);
+    return ALREADY_LOCKED;
+  }
+}
+
+Caml_inline DWORD st_mutex_unlock(st_mutex m)
+{
+  TRACE1("st_mutex_unlock", m);
+  LeaveCriticalSection(m);
+  return 0;
+}
+
+/* Condition variables */
+
+/* A condition variable is just a list of threads currently
+   waiting on this c.v.  Each thread is represented by its
+   associated event. */
+
+struct st_wait_list {
+  HANDLE event;                  /* event of the first waiting thread */
+  struct st_wait_list * next;
+};
+
+typedef struct st_condvar_struct {
+  CRITICAL_SECTION lock;         /* protect the data structure */
+  struct st_wait_list * waiters; /* list of threads waiting */
+} * st_condvar;
+
+static DWORD st_condvar_create(st_condvar * res)
+{
+  st_condvar c = caml_stat_alloc_noexc(sizeof(struct st_condvar_struct));
+  if (c == NULL) return ERROR_NOT_ENOUGH_MEMORY;
+  InitializeCriticalSection(&c->lock);
+  c->waiters = NULL;
+  *res = c;
+  return 0;
+}
+
+static DWORD st_condvar_destroy(st_condvar c)
+{
+  TRACE1("st_condvar_destroy", c);
+  DeleteCriticalSection(&c->lock);
+  caml_stat_free(c);
+  return 0;
+}
+
+static DWORD st_condvar_signal(st_condvar c)
+{
+  DWORD rc = 0;
+  struct st_wait_list * curr, * next;
+
+  TRACE1("st_condvar_signal", c);
+  EnterCriticalSection(&c->lock);
+  curr = c->waiters;
+  if (curr != NULL) {
+    next = curr->next;
+    /* Wake up the first waiting thread */
+    TRACE1("st_condvar_signal: waking up", curr->event);
+    if (! SetEvent(curr->event)) rc = GetLastError();
+    /* Remove it from the waiting list */
+    c->waiters = next;
+  }
+  LeaveCriticalSection(&c->lock);
+  return rc;
+}
+
+static DWORD st_condvar_broadcast(st_condvar c)
+{
+  DWORD rc = 0;
+  struct st_wait_list * curr, * next;
+
+  TRACE1("st_condvar_broadcast", c);
+  EnterCriticalSection(&c->lock);
+  /* Wake up all waiting threads */
+  curr = c->waiters;
+  while (curr != NULL) {
+    next = curr->next;
+    TRACE1("st_condvar_signal: waking up", curr->event);
+    if (! SetEvent(curr->event)) rc = GetLastError();
+    curr = next;
+  }
+  /* Remove them all from the waiting list */
+  c->waiters = NULL;
+  LeaveCriticalSection(&c->lock);
+  return rc;
+}
+
+static DWORD st_condvar_wait(st_condvar c, st_mutex m)
+{
+  HANDLE ev;
+  struct st_wait_list wait;
+
+  TRACE1("st_condvar_wait", c);
+  /* Recover (or create) the event associated with the calling thread */
+  ev = (HANDLE) TlsGetValue(st_thread_sem_key);
+  if (ev == 0) {
+    ev = CreateEvent(NULL,
+                     FALSE /*auto reset*/,
+                     FALSE /*initially unset*/,
+                     NULL);
+    if (ev == NULL) return GetLastError();
+    TlsSetValue(st_thread_sem_key, (void *) ev);
+  }
+  EnterCriticalSection(&c->lock);
+  /* Insert the current thread in the waiting list (atomically) */
+  wait.event = ev;
+  wait.next = c->waiters;
+  c->waiters = &wait;
+  LeaveCriticalSection(&c->lock);
+  /* Release the mutex m */
+  LeaveCriticalSection(m);
+  /* Wait for our event to be signaled.  There is no risk of lost
+     wakeup, since we inserted ourselves on the waiting list of c
+     before releasing m */
+  TRACE1("st_condvar_wait: blocking on event", ev);
+  if (WaitForSingleObject(ev, INFINITE) == WAIT_FAILED)
+    return GetLastError();
+  /* Reacquire the mutex m */
+  TRACE1("st_condvar_wait: restarted, acquiring mutex", m);
+  EnterCriticalSection(m);
+  TRACE1("st_condvar_wait: acquired mutex", m);
+  return 0;
+}
+
+/* Triggered events */
+
+typedef HANDLE st_event;
+
+static DWORD st_event_create(st_event * res)
+{
+  st_event m =
+    CreateEvent(NULL, TRUE/*manual reset*/, FALSE/*initially unset*/, NULL);
+  TRACE1("st_event_create", m);
+  if (m == NULL) return GetLastError();
+  *res = m;
+  return 0;
+}
+
+static DWORD st_event_destroy(st_event e)
+{
+  TRACE1("st_event_destroy", e);
+  if (CloseHandle(e))
+    return 0;
+  else
+    return GetLastError();
+}
+
+static DWORD st_event_trigger(st_event e)
+{
+  TRACE1("st_event_trigger", e);
+  if (SetEvent(e))
+    return 0;
+  else
+    return GetLastError();
+}
+
+static DWORD st_event_wait(st_event e)
+{
+  TRACE1("st_event_wait", e);
+  if (WaitForSingleObject(e, INFINITE) == WAIT_FAILED)
+    return GetLastError();
+  else
+    return 0;
+}
+
+/* Reporting errors */
+
+static void st_check_error(DWORD retcode, char * msg)
+{
+  wchar_t err[1024];
+  int errlen, msglen, ret;
+  value str;
+
+  if (retcode == 0) return;
+  if (retcode == ERROR_NOT_ENOUGH_MEMORY) caml_raise_out_of_memory();
+  ret = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS,
+                      NULL,
+                      retcode,
+                      0,
+                      err,
+                      sizeof(err)/sizeof(wchar_t),
+                      NULL);
+  if (! ret) {
+    ret =
+      swprintf(err, sizeof(err)/sizeof(wchar_t), L"error code %lx", retcode);
+  }
+  msglen = strlen(msg);
+  errlen = win_wide_char_to_multi_byte(err, ret, NULL, 0);
+  str = caml_alloc_string(msglen + 2 + errlen);
+  memmove (&Byte(str, 0), msg, msglen);
+  memmove (&Byte(str, msglen), ": ", 2);
+  win_wide_char_to_multi_byte(err, ret, &Byte(str, msglen + 2), errlen);
+  caml_raise_sys_error(str);
+}
+
+/* Variable used to stop the "tick" thread */
+static volatile int caml_tick_thread_stop = 0;
+
+/* The tick thread: posts a SIGPREEMPTION signal periodically */
+
+static DWORD WINAPI caml_thread_tick(void * arg)
+{
+  while(! caml_tick_thread_stop) {
+    Sleep(Thread_timeout);
+    /* The preemption signal should never cause a callback, so don't
+     go through caml_handle_signal(), just record signal delivery via
+     caml_record_signal(). */
+    caml_record_signal(SIGPREEMPTION);
+  }
+  return 0;
+}
+
+/* "At fork" processing -- none under Win32 */
+
+static DWORD st_atfork(void (*fn)(void))
+{
+  return 0;
+}
+
+/* Signal handling -- none under Win32 */
+
+value caml_thread_sigmask(value cmd, value sigs) /* ML */
+{
+  caml_invalid_argument("Thread.sigmask not implemented");
+  return Val_int(0);            /* not reached */
+}
+
+value caml_wait_signal(value sigs) /* ML */
+{
+  caml_invalid_argument("Thread.wait_signal not implemented");
+  return Val_int(0);            /* not reached */
+}
diff --git a/otherlibs/systhreads/thread.ml b/otherlibs/systhreads/thread.ml
new file mode 100644
index 00000000..bf47d75b
--- /dev/null
+++ b/otherlibs/systhreads/thread.ml
@@ -0,0 +1,89 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Xavier Leroy and Pascal Cuoq, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* User-level threads *)
+
+type t
+
+external thread_initialize : unit -> unit = "caml_thread_initialize"
+external thread_cleanup : unit -> unit = "caml_thread_cleanup"
+external thread_new : (unit -> unit) -> t = "caml_thread_new"
+external thread_uncaught_exception : exn -> unit =
+            "caml_thread_uncaught_exception"
+
+external yield : unit -> unit = "caml_thread_yield"
+external self : unit -> t = "caml_thread_self" [@@noalloc]
+external id : t -> int = "caml_thread_id" [@@noalloc]
+external join : t -> unit = "caml_thread_join"
+external exit : unit -> unit = "caml_thread_exit"
+
+(* For new, make sure the function passed to thread_new never
+   raises an exception. *)
+
+let create fn arg =
+  thread_new
+    (fun () ->
+      try
+        fn arg; ()
+      with exn ->
+             flush stdout; flush stderr;
+             thread_uncaught_exception exn)
+
+(* Thread.kill is currently not implemented due to problems with
+   cleanup handlers on several platforms *)
+
+let kill th = invalid_arg "Thread.kill: not implemented"
+
+(* Preemption *)
+
+let preempt signal = yield()
+
+(* Initialization of the scheduler *)
+
+let preempt_signal =
+  match Sys.os_type with
+  | "Win32" -> Sys.sigterm
+  | _       -> Sys.sigvtalrm
+
+let () =
+  Sys.set_signal preempt_signal (Sys.Signal_handle preempt);
+  thread_initialize ();
+  Callback.register "Thread.at_shutdown" (fun () ->
+    thread_cleanup();
+    (* In case of DLL-embedded OCaml the preempt_signal handler
+       will point to nowhere after DLL unloading and an accidental
+       preempt_signal will crash the main program. So restore the
+       default handler. *)
+    Sys.set_signal preempt_signal Sys.Signal_default
+  )
+
+(* Wait functions *)
+
+let delay = Unix.sleepf
+
+let wait_read fd = ()
+let wait_write fd = ()
+
+let wait_timed_read fd d =
+  match Unix.select [fd] [] [] d with ([], _, _) -> false | (_, _, _) -> true
+let wait_timed_write fd d =
+  match Unix.select [] [fd] [] d with (_, [], _) -> false | (_, _, _) -> true
+let select = Unix.select
+
+let wait_pid p = Unix.waitpid [] p
+
+external sigmask : Unix.sigprocmask_command -> int list -> int list
+   = "caml_thread_sigmask"
+external wait_signal : int list -> int = "caml_wait_signal"
diff --git a/otherlibs/systhreads/thread.mli b/otherlibs/systhreads/thread.mli
new file mode 100644
index 00000000..2373e58d
--- /dev/null
+++ b/otherlibs/systhreads/thread.mli
@@ -0,0 +1,133 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt     *)
+(*                                                                        *)
+(*   Copyright 1995 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Lightweight threads for Posix [1003.1c] and Win32. *)
+
+type t
+(** The type of thread handles. *)
+
+(** {1 Thread creation and termination} *)
+
+val create : ('a -> 'b) -> 'a -> t
+(** [Thread.create funct arg] creates a new thread of control,
+   in which the function application [funct arg]
+   is executed concurrently with the other threads of the program.
+   The application of [Thread.create]
+   returns the handle of the newly created thread.
+   The new thread terminates when the application [funct arg]
+   returns, either normally or by raising an uncaught exception.
+   In the latter case, the exception is printed on standard error,
+   but not propagated back to the parent thread. Similarly, the
+   result of the application [funct arg] is discarded and not
+   directly accessible to the parent thread. *)
+
+val self : unit -> t
+(** Return the thread currently executing. *)
+
+val id : t -> int
+(** Return the identifier of the given thread. A thread identifier
+   is an integer that identifies uniquely the thread.
+   It can be used to build data structures indexed by threads. *)
+
+val exit : unit -> unit
+(** Terminate prematurely the currently executing thread. *)
+
+val kill : t -> unit
+(** Terminate prematurely the thread whose handle is given. *)
+
+(** {1 Suspending threads} *)
+
+val delay: float -> unit
+(** [delay d] suspends the execution of the calling thread for
+   [d] seconds. The other program threads continue to run during
+   this time. *)
+
+val join : t -> unit
+(** [join th] suspends the execution of the calling thread
+   until the thread [th] has terminated. *)
+
+val wait_read : Unix.file_descr -> unit
+(** See {!Thread.wait_write}.*)
+
+val wait_write : Unix.file_descr -> unit
+(** This function does nothing in this implementation. *)
+
+val wait_timed_read : Unix.file_descr -> float -> bool
+(** See {!Thread.wait_timed_write}.*)
+
+val wait_timed_write : Unix.file_descr -> float -> bool
+(** Suspend the execution of the calling thread until at least
+   one character or EOF is available for reading ([wait_read]) or
+   one character can be written without blocking ([wait_write])
+   on the given Unix file descriptor. Wait for at most
+   the amount of time given as second argument (in seconds).
+   Return [true] if the file descriptor is ready for input/output
+   and [false] if the timeout expired.
+
+   These functions return immediately [true] in the Win32
+   implementation. *)
+
+val select :
+  Unix.file_descr list -> Unix.file_descr list ->
+  Unix.file_descr list -> float ->
+    Unix.file_descr list * Unix.file_descr list * Unix.file_descr list
+(** Suspend the execution of the calling thread until input/output
+   becomes possible on the given Unix file descriptors.
+   The arguments and results have the same meaning as for
+   [Unix.select].
+   This function is not implemented yet under Win32. *)
+
+val wait_pid : int -> int * Unix.process_status
+(** [wait_pid p] suspends the execution of the calling thread
+   until the process specified by the process identifier [p]
+   terminates. Returns the pid of the child caught and
+   its termination status, as per [Unix.wait].
+   This function is not implemented under MacOS. *)
+
+val yield : unit -> unit
+(** Re-schedule the calling thread without suspending it.
+   This function can be used to give scheduling hints,
+   telling the scheduler that now is a good time to
+   switch to other threads. *)
+
+(** {1 Management of signals} *)
+
+(** Signal handling follows the POSIX thread model: signals generated
+  by a thread are delivered to that thread; signals generated externally
+  are delivered to one of the threads that does not block it.
+  Each thread possesses a set of blocked signals, which can be modified
+  using {!Thread.sigmask}.  This set is inherited at thread creation time.
+  Per-thread signal masks are supported only by the system thread library
+  under Unix, but not under Win32, nor by the VM thread library. *)
+
+val sigmask : Unix.sigprocmask_command -> int list -> int list
+(** [sigmask cmd sigs] changes the set of blocked signals for the
+   calling thread.
+   If [cmd] is [SIG_SETMASK], blocked signals are set to those in
+   the list [sigs].
+   If [cmd] is [SIG_BLOCK], the signals in [sigs] are added to
+   the set of blocked signals.
+   If [cmd] is [SIG_UNBLOCK], the signals in [sigs] are removed
+   from the set of blocked signals.
+   [sigmask] returns the set of previously blocked signals for the thread. *)
+
+
+val wait_signal : int list -> int
+(** [wait_signal sigs] suspends the execution of the calling thread
+   until the process receives one of the signals specified in the
+   list [sigs].  It then returns the number of the signal received.
+   Signal handlers attached to the signals in [sigs] will not
+   be invoked.  The signals [sigs] are expected to be blocked before
+   calling [wait_signal]. *)
diff --git a/otherlibs/systhreads/threadUnix.ml b/otherlibs/systhreads/threadUnix.ml
new file mode 100644
index 00000000..acaafb01
--- /dev/null
+++ b/otherlibs/systhreads/threadUnix.ml
@@ -0,0 +1,65 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Module [ThreadUnix]: thread-compatible system calls *)
+
+open Unix
+
+(*** Process handling *)
+
+external execv : string -> string array -> unit = "unix_execv"
+external execve : string -> string array -> string array -> unit
+           = "unix_execve"
+external execvp : string -> string array -> unit = "unix_execvp"
+let wait = Unix.wait
+let waitpid = Unix.waitpid
+let system = Unix.system
+let read = Unix.read
+let write = Unix.write
+let write_substring = Unix.write_substring
+let select = Unix.select
+
+let timed_read fd buff ofs len timeout =
+  if Thread.wait_timed_read fd timeout
+  then Unix.read fd buff ofs len
+  else raise (Unix_error(ETIMEDOUT, "timed_read", ""))
+
+let timed_write fd buff ofs len timeout =
+  if Thread.wait_timed_write fd timeout
+  then Unix.write fd buff ofs len
+  else raise (Unix_error(ETIMEDOUT, "timed_write", ""))
+
+let timed_write_substring fd buff ofs len timeout =
+  timed_write fd (Bytes.unsafe_of_string buff) ofs len timeout
+
+let pipe = Unix.pipe
+
+let open_process_in = Unix.open_process_in
+let open_process_out = Unix.open_process_out
+let open_process = Unix.open_process
+
+external sleep : int -> unit = "unix_sleep"
+
+let socket = Unix.socket
+let accept = Unix.accept
+external connect : file_descr -> sockaddr -> unit = "unix_connect"
+let recv = Unix.recv
+let recvfrom = Unix.recvfrom
+let send = Unix.send
+let send_substring = Unix.send_substring
+let sendto = Unix.sendto
+let sendto_substring = Unix.sendto_substring
+
+let open_connection = Unix.open_connection
diff --git a/otherlibs/systhreads/threadUnix.mli b/otherlibs/systhreads/threadUnix.mli
new file mode 100644
index 00000000..1fe1bcc8
--- /dev/null
+++ b/otherlibs/systhreads/threadUnix.mli
@@ -0,0 +1,96 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Thread-compatible system calls.
+
+   @deprecated The functionality of this module has been merged back into
+   the {!Unix} module.  Threaded programs can now call the functions
+   from module {!Unix} directly, and still get the correct behavior
+   (block the calling thread, if required, but do not block all threads
+   in the process).  *)
+
+(** {1 Process handling} *)
+
+val execv : string -> string array -> unit
+val execve : string -> string array -> string array -> unit
+val execvp : string -> string array -> unit
+val wait : unit -> int * Unix.process_status
+val waitpid : Unix.wait_flag list -> int -> int * Unix.process_status
+val system : string -> Unix.process_status
+
+(** {1 Basic input/output} *)
+
+val read : Unix.file_descr -> bytes -> int -> int -> int
+val write : Unix.file_descr -> bytes -> int -> int -> int
+val write_substring : Unix.file_descr -> string -> int -> int -> int
+
+(** {1 Input/output with timeout} *)
+
+val timed_read :
+      Unix.file_descr ->
+      bytes -> int -> int -> float -> int
+(** See {!ThreadUnix.timed_write}. *)
+
+val timed_write :
+      Unix.file_descr ->
+      bytes -> int -> int -> float -> int
+(** Behave as {!ThreadUnix.read} and {!ThreadUnix.write}, except that
+   [Unix_error(ETIMEDOUT,_,_)] is raised if no data is
+   available for reading or ready for writing after [d] seconds.
+   The delay [d] is given in the fifth argument, in seconds. *)
+
+val timed_write_substring :
+      Unix.file_descr -> string -> int -> int -> float -> int
+(** See {!ThreadUnix.timed_write}. *)
+
+(** {1 Polling} *)
+
+val select :
+  Unix.file_descr list -> Unix.file_descr list ->
+  Unix.file_descr list -> float ->
+        Unix.file_descr list * Unix.file_descr list * Unix.file_descr list
+
+(** {1 Pipes and redirections} *)
+
+val pipe : ?cloexec:bool -> unit -> Unix.file_descr * Unix.file_descr
+val open_process_in: string -> in_channel
+val open_process_out: string -> out_channel
+val open_process: string -> in_channel * out_channel
+
+(** {1 Time} *)
+
+val sleep : int -> unit
+
+(** {1 Sockets} *)
+
+val socket :
+  ?cloexec:bool -> Unix.socket_domain -> Unix.socket_type -> int ->
+    Unix.file_descr
+val accept :
+  ?cloexec:bool -> Unix.file_descr -> Unix.file_descr * Unix.sockaddr
+val connect : Unix.file_descr -> Unix.sockaddr -> unit
+val recv : Unix.file_descr -> bytes ->
+           int -> int -> Unix.msg_flag list -> int
+val recvfrom : Unix.file_descr -> bytes -> int -> int ->
+               Unix.msg_flag list -> int * Unix.sockaddr
+val send : Unix.file_descr -> bytes -> int -> int ->
+           Unix.msg_flag list -> int
+val send_substring : Unix.file_descr -> string -> int -> int ->
+           Unix.msg_flag list -> int
+val sendto : Unix.file_descr -> bytes -> int -> int ->
+             Unix.msg_flag list -> Unix.sockaddr -> int
+val sendto_substring : Unix.file_descr -> string -> int -> int ->
+             Unix.msg_flag list -> Unix.sockaddr -> int
+val open_connection : Unix.sockaddr -> in_channel * out_channel
diff --git a/otherlibs/systhreads/threads.h b/otherlibs/systhreads/threads.h
new file mode 100644
index 00000000..97fd1b27
--- /dev/null
+++ b/otherlibs/systhreads/threads.h
@@ -0,0 +1,68 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 1995 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_THREADS_H
+#define CAML_THREADS_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+CAMLextern void caml_enter_blocking_section (void);
+CAMLextern void caml_leave_blocking_section (void);
+#define caml_acquire_runtime_system caml_leave_blocking_section
+#define caml_release_runtime_system caml_enter_blocking_section
+
+/* Manage the master lock around the OCaml run-time system.
+   Only one thread at a time can execute OCaml compiled code or
+   OCaml run-time system functions.
+
+   When OCaml calls a C function, the current thread holds the master
+   lock.  The C function can release it by calling
+   [caml_release_runtime_system].  Then, another thread can execute OCaml
+   code.  However, the calling thread must not access any OCaml data,
+   nor call any runtime system function, nor call back into OCaml.
+
+   Before returning to its OCaml caller, or accessing OCaml data,
+   or call runtime system functions, the current thread must
+   re-acquire the master lock by calling [caml_acquire_runtime_system].
+
+   Symmetrically, if a C function (not called from OCaml) wishes to
+   call back into OCaml code, it should invoke [caml_acquire_runtime_system]
+   first, then do the callback, then invoke [caml_release_runtime_system].
+
+   For historical reasons, alternate names can be used:
+     [caml_enter_blocking_section]  instead of  [caml_release_runtime_system]
+     [caml_leave_blocking_section]  instead of  [caml_acquire_runtime_system]
+   Intuition: a ``blocking section'' is a piece of C code that does not
+   use the runtime system (typically, a blocking I/O operation).
+*/
+
+CAMLextern int caml_c_thread_register(void);
+CAMLextern int caml_c_thread_unregister(void);
+
+/* If a thread is created by C code (instead of by OCaml itself),
+   it must be registered with the OCaml runtime system before
+   being able to call back into OCaml code or use other runtime system
+   functions.  Just call [caml_c_thread_register] once.
+   Before the thread finishes, it must call [caml_c_thread_unregister].
+   Both functions return 1 on success, 0 on error.
+*/
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_THREADS_H */
diff --git a/otherlibs/unix/.depend b/otherlibs/unix/.depend
new file mode 100644
index 00000000..5c9eb799
--- /dev/null
+++ b/otherlibs/unix/.depend
@@ -0,0 +1,657 @@
+accept.o: accept.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
+access.o: access.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+addrofstr.o: addrofstr.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
+alarm.o: alarm.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+bind.o: bind.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/mlvalues.h unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
+channels.o: channels.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/io.h \
+ ../../runtime/caml/signals.h unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
+chdir.o: chdir.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+chmod.o: chmod.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+chown.o: chown.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
+chroot.o: chroot.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
+close.o: close.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
+ unixsupport.h
+closedir.o: closedir.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
+connect.o: connect.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
+cst2constr.o: cst2constr.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
+ cst2constr.h
+cstringv.o: cstringv.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+dup.o: dup.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+dup2.o: dup2.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+envir.o: envir.c ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h
+errmsg.o: errmsg.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h
+execv.o: execv.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+execve.o: execve.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+execvp.o: execvp.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+exit.o: exit.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+fchmod.o: fchmod.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h
+fchown.o: fchown.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h
+fcntl.o: fcntl.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/mlvalues.h unixsupport.h
+fork.o: fork.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/debugger.h \
+ ../../runtime/caml/eventlog.h unixsupport.h
+fsync.o: fsync.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
+ unixsupport.h
+ftruncate.o: ftruncate.c ../../runtime/caml/fail.h \
+ ../../runtime/caml/misc.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/io.h ../../runtime/caml/signals.h unixsupport.h
+getaddrinfo.o: getaddrinfo.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/signals.h unixsupport.h cst2constr.h socketaddr.h
+getcwd.o: getcwd.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
+ ../../runtime/caml/domain.h unixsupport.h
+getegid.o: getegid.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+geteuid.o: geteuid.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+getgid.o: getgid.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+getgr.o: getgr.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
+getgroups.o: getgroups.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h unixsupport.h
+gethost.o: gethost.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
+gethostname.o: gethostname.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h unixsupport.h
+getlogin.o: getlogin.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ unixsupport.h
+getnameinfo.o: getnameinfo.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
+getpeername.o: getpeername.c ../../runtime/caml/fail.h \
+ ../../runtime/caml/misc.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \
+ unixsupport.h socketaddr.h ../../runtime/caml/misc.h
+getpid.o: getpid.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+getppid.o: getppid.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+getproto.o: getproto.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
+getpw.o: getpw.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/fail.h unixsupport.h
+getserv.o: getserv.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
+getsockname.o: getsockname.c ../../runtime/caml/fail.h \
+ ../../runtime/caml/misc.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \
+ unixsupport.h socketaddr.h ../../runtime/caml/misc.h
+gettimeofday.o: gettimeofday.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h unixsupport.h
+getuid.o: getuid.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+gmtime.o: gmtime.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
+initgroups.o: initgroups.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h unixsupport.h
+isatty.o: isatty.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+itimer.o: itimer.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
+kill.o: kill.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
+ unixsupport.h ../../runtime/caml/signals.h
+link.o: link.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
+listen.o: listen.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/mlvalues.h unixsupport.h
+lockf.o: lockf.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h
+lseek.o: lseek.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/io.h ../../runtime/caml/signals.h unixsupport.h
+mkdir.o: mkdir.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
+mkfifo.o: mkfifo.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
+mmap.o: mmap.c ../../runtime/caml/bigarray.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/fail.h ../../runtime/caml/io.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h \
+ ../../runtime/caml/sys.h unixsupport.h
+mmap_ba.o: mmap_ba.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/bigarray.h ../../runtime/caml/custom.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/misc.h
+nice.o: nice.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+open.o: open.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/misc.h ../../runtime/caml/signals.h unixsupport.h
+opendir.o: opendir.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \
+ ../../runtime/caml/signals.h unixsupport.h
+pipe.o: pipe.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ unixsupport.h
+putenv.o: putenv.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+read.o: read.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
+readdir.o: readdir.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/signals.h unixsupport.h
+readlink.o: readlink.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/signals.h unixsupport.h
+rename.o: rename.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
+rewinddir.o: rewinddir.c ../../runtime/caml/fail.h \
+ ../../runtime/caml/misc.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \
+ unixsupport.h
+rmdir.o: rmdir.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+select.o: select.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
+sendrecv.o: sendrecv.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
+setgid.o: setgid.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+setgroups.o: setgroups.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
+setsid.o: setsid.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/mlvalues.h unixsupport.h
+setuid.o: setuid.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+shutdown.o: shutdown.c ../../runtime/caml/fail.h \
+ ../../runtime/caml/misc.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \
+ unixsupport.h
+signals.o: signals.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h
+sleep.o: sleep.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
+ unixsupport.h
+socket.o: socket.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/mlvalues.h unixsupport.h
+socketaddr.o: socketaddr.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
+socketpair.o: socketpair.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h unixsupport.h
+sockopt.o: sockopt.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
+stat.o: stat.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/signals.h \
+ ../../runtime/caml/io.h unixsupport.h cst2constr.h nanosecond_stat.h
+strofaddr.o: strofaddr.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
+symlink.o: symlink.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
+termios.o: termios.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h unixsupport.h
+time.o: time.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ unixsupport.h
+times.o: times.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h unixsupport.h
+truncate.o: truncate.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/signals.h \
+ ../../runtime/caml/io.h unixsupport.h
+umask.o: umask.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+unixsupport.o: unixsupport.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/callback.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \
+ cst2constr.h
+unlink.o: unlink.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+utimes.o: utimes.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+wait.o: wait.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h unixsupport.h
+write.o: write.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
+unix.cmo : \
+    unix.cmi
+unix.cmx : \
+    unix.cmi
+unix.cmi :
+unixLabels.cmo : \
+    unix.cmi \
+    unixLabels.cmi
+unixLabels.cmx : \
+    unix.cmx \
+    unixLabels.cmi
+unixLabels.cmi : \
+    unix.cmi
diff --git a/otherlibs/unix/Makefile b/otherlibs/unix/Makefile
new file mode 100644
index 00000000..2eaa5097
--- /dev/null
+++ b/otherlibs/unix/Makefile
@@ -0,0 +1,58 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# Makefile for the Unix interface library
+
+LIBNAME=unix
+
+EXTRACAMLFLAGS=-nolabels
+
+# dllunix.so particularly requires libm for modf symbols
+LDOPTS=$(NATIVECCLIBS)
+
+COBJS=accept.o access.o addrofstr.o alarm.o bind.o channels.o chdir.o \
+  chmod.o chown.o chroot.o close.o fsync.o closedir.o connect.o cst2constr.o \
+  cstringv.o dup.o dup2.o envir.o errmsg.o execv.o execve.o execvp.o exit.o \
+  fchmod.o fchown.o fcntl.o fork.o ftruncate.o \
+  getaddrinfo.o getcwd.o getegid.o geteuid.o getgid.o \
+  getgr.o getgroups.o gethost.o gethostname.o getlogin.o \
+  getnameinfo.o getpeername.o getpid.o getppid.o getproto.o getpw.o \
+  gettimeofday.o getserv.o getsockname.o getuid.o gmtime.o \
+  initgroups.o isatty.o itimer.o kill.o link.o listen.o lockf.o lseek.o \
+  mkdir.o mkfifo.o mmap.o mmap_ba.o \
+  nice.o open.o opendir.o pipe.o putenv.o read.o \
+  readdir.o readlink.o rename.o rewinddir.o rmdir.o select.o sendrecv.o \
+  setgid.o setgroups.o setsid.o setuid.o shutdown.o signals.o \
+  sleep.o socket.o socketaddr.o \
+  socketpair.o sockopt.o stat.o strofaddr.o symlink.o termios.o \
+  time.o times.o truncate.o umask.o unixsupport.o unlink.o \
+  utimes.o wait.o write.o
+
+CAMLOBJS=unix.cmo unixLabels.cmo
+
+HEADERS=unixsupport.h socketaddr.h
+
+include ../Makefile.otherlibs.common
+
+.PHONY: depend
+depend:
+ifeq "$(TOOLCHAIN)" "msvc"
+	$(error Dependencies cannot be regenerated using the MSVC ports)
+else
+	$(CC) -MM $(OC_CPPFLAGS) *.c > .depend
+	$(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml >> .depend
+endif
+
+include .depend
diff --git a/otherlibs/unix/accept.c b/otherlibs/unix/accept.c
new file mode 100644
index 00000000..d02cc09a
--- /dev/null
+++ b/otherlibs/unix/accept.c
@@ -0,0 +1,64 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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 _GNU_SOURCE
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+
+CAMLprim value unix_accept(value cloexec, value sock)
+{
+  int retcode;
+  value res;
+  value a;
+  union sock_addr_union addr;
+  socklen_param_type addr_len;
+  int clo = unix_cloexec_p(cloexec);
+
+  addr_len = sizeof(addr);
+  caml_enter_blocking_section();
+#if defined(HAS_ACCEPT4) && defined(SOCK_CLOEXEC)
+  retcode = accept4(Int_val(sock), &addr.s_gen, &addr_len,
+                    clo ? SOCK_CLOEXEC : 0);
+#else
+  retcode = accept(Int_val(sock), &addr.s_gen, &addr_len);
+#endif
+  caml_leave_blocking_section();
+  if (retcode == -1) uerror("accept", Nothing);
+#if !(defined(HAS_ACCEPT4) && defined(SOCK_CLOEXEC))
+  if (clo) unix_set_cloexec(retcode, "accept", Nothing);
+#endif
+  a = alloc_sockaddr(&addr, addr_len, retcode);
+  Begin_root (a);
+    res = caml_alloc_small(2, 0);
+    Field(res, 0) = Val_int(retcode);
+    Field(res, 1) = a;
+  End_roots();
+  return res;
+}
+
+#else
+
+CAMLprim value unix_accept(value cloexec, value sock)
+{ caml_invalid_argument("accept not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/access.c b/otherlibs/unix/access.c
new file mode 100644
index 00000000..07cbcf62
--- /dev/null
+++ b/otherlibs/unix/access.c
@@ -0,0 +1,67 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#define CAML_INTERNALS
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+#ifdef HAS_UNISTD
+# include <unistd.h>
+#else
+# ifndef _WIN32
+#  include <sys/file.h>
+# endif
+# ifndef R_OK
+#   define R_OK    4/* test for read permission */
+#   define W_OK    2/* test for write permission */
+#   define X_OK    1/* test for execute (search) permission */
+#   define F_OK    0/* test for presence of file */
+# endif
+#endif
+
+static int access_permission_table[] = {
+  R_OK,
+  W_OK,
+#ifdef _WIN32
+  /* Since there is no concept of execute permission on Windows,
+     we fall b+ack to the read permission */
+  R_OK,
+#else
+  X_OK,
+#endif
+  F_OK
+};
+
+CAMLprim value unix_access(value path, value perms)
+{
+  CAMLparam2(path, perms);
+  char_os * p;
+  int ret, cv_flags;
+
+  caml_unix_check_path(path, "access");
+  cv_flags = caml_convert_flag_list(perms, access_permission_table);
+  p = caml_stat_strdup_to_os(String_val(path));
+  caml_enter_blocking_section();
+  ret = access_os(p, cv_flags);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1)
+    uerror("access", path);
+  CAMLreturn(Val_unit);
+}
diff --git a/otherlibs/unix/addrofstr.c b/otherlibs/unix/addrofstr.c
new file mode 100644
index 00000000..2325cb9e
--- /dev/null
+++ b/otherlibs/unix/addrofstr.c
@@ -0,0 +1,97 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+
+CAMLprim value unix_inet_addr_of_string(value s)
+{
+  if (! caml_string_is_c_safe(s)) caml_failwith("inet_addr_of_string");
+#if defined(HAS_IPV6)
+#ifdef _WIN32
+ {
+  CAMLparam1(s);
+  CAMLlocal1(vres);
+  struct addrinfo hints;
+  struct addrinfo * res;
+  int retcode;
+  memset(&hints, 0, sizeof(hints));
+  hints.ai_family = AF_UNSPEC;
+  hints.ai_flags = AI_NUMERICHOST;
+  retcode = getaddrinfo(String_val(s), NULL, &hints, &res);
+  if (retcode != 0) caml_failwith("inet_addr_of_string");
+  switch (res->ai_addr->sa_family) {
+  case AF_INET:
+    {
+      vres =
+        alloc_inet_addr(&((struct sockaddr_in *) res->ai_addr)->sin_addr);
+      break;
+    }
+  case AF_INET6:
+    {
+      vres =
+        alloc_inet6_addr(&((struct sockaddr_in6 *) res->ai_addr)->sin6_addr);
+      break;
+    }
+  default:
+    {
+      freeaddrinfo(res);
+      caml_failwith("inet_addr_of_string");
+    }
+  }
+  freeaddrinfo(res);
+  CAMLreturn (vres);
+ }
+#else
+ {
+  struct in_addr address;
+  struct in6_addr address6;
+  if (inet_pton(AF_INET, String_val(s), &address) > 0)
+    return alloc_inet_addr(&address);
+  else if (inet_pton(AF_INET6, String_val(s), &address6) > 0)
+    return alloc_inet6_addr(&address6);
+  else
+    caml_failwith("inet_addr_of_string");
+ }
+#endif
+#elif defined(HAS_INET_ATON)
+ {
+  struct in_addr address;
+  if (inet_aton(String_val(s), &address) == 0)
+    caml_failwith("inet_addr_of_string");
+  return alloc_inet_addr(&address);
+ }
+#else
+ {
+  struct in_addr address;
+  address.s_addr = inet_addr(String_val(s));
+  if (address.s_addr == (uint32_t) -1) caml_failwith("inet_addr_of_string");
+  return alloc_inet_addr(&address);
+ }
+#endif
+}
+
+#else
+
+CAMLprim value unix_inet_addr_of_string(value s)
+{ caml_invalid_argument("inet_addr_of_string not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/alarm.c b/otherlibs/unix/alarm.c
new file mode 100644
index 00000000..05542524
--- /dev/null
+++ b/otherlibs/unix/alarm.c
@@ -0,0 +1,22 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_alarm(value t)
+{
+  return Val_int(alarm((unsigned int) Long_val(t)));
+}
diff --git a/otherlibs/unix/bind.c b/otherlibs/unix/bind.c
new file mode 100644
index 00000000..73b24b06
--- /dev/null
+++ b/otherlibs/unix/bind.c
@@ -0,0 +1,41 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+
+CAMLprim value unix_bind(value socket, value address)
+{
+  int ret;
+  union sock_addr_union addr;
+  socklen_param_type addr_len;
+
+  get_sockaddr(address, &addr, &addr_len);
+  ret = bind(Int_val(socket), &addr.s_gen, addr_len);
+  if (ret == -1) uerror("bind", Nothing);
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_bind(value socket, value address)
+{ caml_invalid_argument("bind not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/channels.c b/otherlibs/unix/channels.c
new file mode 100644
index 00000000..ecf0cc2f
--- /dev/null
+++ b/otherlibs/unix/channels.c
@@ -0,0 +1,89 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Gallium, INRIA Paris                  */
+/*                                                                        */
+/*   Copyright 2017 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
+
+#include <errno.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <caml/mlvalues.h>
+#include <caml/io.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+#include <sys/socket.h>
+#include "socketaddr.h"
+#endif
+
+/* Check that the given file descriptor has "stream semantics" and
+   can therefore be used as part of buffered I/O.  Things that
+   don't have "stream semantics" include block devices and
+   UDP (datagram) sockets.
+   Returns 0 if OK, a nonzero error code if error. */
+
+static int unix_check_stream_semantics(int fd)
+{
+  struct stat buf;
+
+  if (fstat(fd, &buf) == -1) return errno;
+  switch (buf.st_mode & S_IFMT) {
+  case S_IFREG: case S_IFCHR: case S_IFIFO:
+    /* These have stream semantics */
+    return 0;
+#ifdef HAS_SOCKETS
+  case S_IFSOCK: {
+    int so_type;
+    socklen_param_type so_type_len = sizeof(so_type);
+    if (getsockopt(fd, SOL_SOCKET, SO_TYPE, &so_type, &so_type_len) == -1)
+      return errno;
+    switch (so_type) {
+    case SOCK_STREAM:
+      return 0;
+    default:
+      return EINVAL;
+    }
+    }
+#endif
+  default:
+    /* All other file types are suspect: block devices, directories,
+       symbolic links, whatnot. */
+    return EINVAL;
+  }
+}
+
+/* From runtime/io.c.  To be declared in <caml/io.h> ? */
+extern value caml_ml_open_descriptor_in(value fd);
+extern value caml_ml_open_descriptor_out(value fd);
+
+CAMLprim value unix_inchannel_of_filedescr(value fd)
+{
+  int err;
+  caml_enter_blocking_section();
+  err = unix_check_stream_semantics(Int_val(fd));
+  caml_leave_blocking_section();
+  if (err != 0) unix_error(err, "in_channel_of_descr", Nothing);
+  return caml_ml_open_descriptor_in(fd);
+}
+
+CAMLprim value unix_outchannel_of_filedescr(value fd)
+{
+  int err;
+  caml_enter_blocking_section();
+  err = unix_check_stream_semantics(Int_val(fd));
+  caml_leave_blocking_section();
+  if (err != 0) unix_error(err, "out_channel_of_descr", Nothing);
+  return caml_ml_open_descriptor_out(fd);
+}
diff --git a/otherlibs/unix/chdir.c b/otherlibs/unix/chdir.c
new file mode 100644
index 00000000..d6217dc5
--- /dev/null
+++ b/otherlibs/unix/chdir.c
@@ -0,0 +1,37 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_chdir(value path)
+{
+  CAMLparam1(path);
+  char_os * p;
+  int ret;
+  caml_unix_check_path(path, "chdir");
+  p = caml_stat_strdup_to_os(String_val(path));
+  caml_enter_blocking_section();
+  ret = chdir_os(p);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1) uerror("chdir", path);
+  CAMLreturn(Val_unit);
+}
diff --git a/otherlibs/unix/chmod.c b/otherlibs/unix/chmod.c
new file mode 100644
index 00000000..7aff4878
--- /dev/null
+++ b/otherlibs/unix/chmod.c
@@ -0,0 +1,39 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_chmod(value path, value perm)
+{
+  CAMLparam2(path, perm);
+  char_os * p;
+  int ret;
+  caml_unix_check_path(path, "chmod");
+  p = caml_stat_strdup_to_os(String_val(path));
+  caml_enter_blocking_section();
+  ret = chmod_os(p, Int_val(perm));
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1) uerror("chmod", path);
+  CAMLreturn(Val_unit);
+}
diff --git a/otherlibs/unix/chown.c b/otherlibs/unix/chown.c
new file mode 100644
index 00000000..4b53a2c0
--- /dev/null
+++ b/otherlibs/unix/chown.c
@@ -0,0 +1,34 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_chown(value path, value uid, value gid)
+{
+  CAMLparam1(path);
+  char * p;
+  int ret;
+  caml_unix_check_path(path, "chown");
+  p = caml_stat_strdup(String_val(path));
+  caml_enter_blocking_section();
+  ret = chown(p, Int_val(uid), Int_val(gid));
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1) uerror("chown", path);
+  CAMLreturn(Val_unit);
+}
diff --git a/otherlibs/unix/chroot.c b/otherlibs/unix/chroot.c
new file mode 100644
index 00000000..8da7710c
--- /dev/null
+++ b/otherlibs/unix/chroot.c
@@ -0,0 +1,34 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_chroot(value path)
+{
+  CAMLparam1(path);
+  char * p;
+  int ret;
+  caml_unix_check_path(path, "chroot");
+  p = caml_stat_strdup(String_val(path));
+  caml_enter_blocking_section();
+  ret = chroot(p);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1) uerror("chroot", path);
+  CAMLreturn(Val_unit);
+}
diff --git a/otherlibs/unix/close.c b/otherlibs/unix/close.c
new file mode 100644
index 00000000..961b8cbf
--- /dev/null
+++ b/otherlibs/unix/close.c
@@ -0,0 +1,28 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_close(value fd)
+{
+  int ret;
+  caml_enter_blocking_section();
+  ret = close(Int_val(fd));
+  caml_leave_blocking_section();
+  if (ret == -1) uerror("close", Nothing);
+  return Val_unit;
+}
diff --git a/otherlibs/unix/closedir.c b/otherlibs/unix/closedir.c
new file mode 100644
index 00000000..97bebb49
--- /dev/null
+++ b/otherlibs/unix/closedir.c
@@ -0,0 +1,38 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+#include <errno.h>
+#include <sys/types.h>
+#ifdef HAS_DIRENT
+#include <dirent.h>
+#else
+#include <sys/dir.h>
+#endif
+
+CAMLprim value unix_closedir(value vd)
+{
+  CAMLparam1(vd);
+  DIR * d = DIR_Val(vd);
+  if (d == (DIR *) NULL) unix_error(EBADF, "closedir", Nothing);
+  caml_enter_blocking_section();
+  closedir(d);
+  caml_leave_blocking_section();
+  DIR_Val(vd) = (DIR *) NULL;
+  CAMLreturn(Val_unit);
+}
diff --git a/otherlibs/unix/connect.c b/otherlibs/unix/connect.c
new file mode 100644
index 00000000..8569ab41
--- /dev/null
+++ b/otherlibs/unix/connect.c
@@ -0,0 +1,44 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+
+CAMLprim value unix_connect(value socket, value address)
+{
+  int retcode;
+  union sock_addr_union addr;
+  socklen_param_type addr_len;
+
+  get_sockaddr(address, &addr, &addr_len);
+  caml_enter_blocking_section();
+  retcode = connect(Int_val(socket), &addr.s_gen, addr_len);
+  caml_leave_blocking_section();
+  if (retcode == -1) uerror("connect", Nothing);
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_connect(value socket, value address)
+{ caml_invalid_argument("connect not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/cst2constr.c b/otherlibs/unix/cst2constr.c
new file mode 100644
index 00000000..aab492b9
--- /dev/null
+++ b/otherlibs/unix/cst2constr.c
@@ -0,0 +1,26 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
+#include "cst2constr.h"
+
+value cst_to_constr(int n, int *tbl, int size, int deflt)
+{
+  int i;
+  for (i = 0; i < size; i++)
+    if (n == tbl[i]) return Val_int(i);
+  return Val_int(deflt);
+}
diff --git a/otherlibs/unix/cst2constr.h b/otherlibs/unix/cst2constr.h
new file mode 100644
index 00000000..44c9299e
--- /dev/null
+++ b/otherlibs/unix/cst2constr.h
@@ -0,0 +1,16 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+extern value cst_to_constr(int n, int * tbl, int size, int deflt);
diff --git a/otherlibs/unix/cstringv.c b/otherlibs/unix/cstringv.c
new file mode 100644
index 00000000..cb5eb596
--- /dev/null
+++ b/otherlibs/unix/cstringv.c
@@ -0,0 +1,45 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <errno.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+char_os ** cstringvect(value arg, char * cmdname)
+{
+  char_os ** res;
+  mlsize_t size, i;
+
+  size = Wosize_val(arg);
+  for (i = 0; i < size; i++)
+    if (! caml_string_is_c_safe(Field(arg, i)))
+      unix_error(EINVAL, cmdname, Field(arg, i));
+  res = (char_os **) caml_stat_alloc((size + 1) * sizeof(char_os *));
+  for (i = 0; i < size; i++)
+    res[i] = caml_stat_strdup_to_os(String_val(Field(arg, i)));
+  res[size] = NULL;
+  return res;
+}
+
+void cstringvect_free(char_os ** v)
+{
+  int i = 0;
+  while (v[i]) caml_stat_free(v[i++]);
+  caml_stat_free((char *)v);
+}
diff --git a/otherlibs/unix/dune b/otherlibs/unix/dune
new file mode 100644
index 00000000..eadac1a2
--- /dev/null
+++ b/otherlibs/unix/dune
@@ -0,0 +1,33 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+(library
+ (name unix)
+ (wrapped false)
+ (modes byte)
+ (flags (:standard -nostdlib -nolabels))
+ (c_flags (-I %{project_root}/runtime))
+ (libraries stdlib)
+ (c_names
+   accept access addrofstr alarm bind channels chdir chmod chown chroot close
+   fsync closedir connect cst2constr cstringv dup dup2 envir errmsg execv execve
+   execvp exit fchmod fchown fcntl fork ftruncate getaddrinfo getcwd getegid
+   geteuid getgid getgr getgroups gethost gethostname getlogin getnameinfo
+   getpeername getpid getppid getproto getpw gettimeofday getserv getsockname
+   getuid gmtime initgroups isatty itimer kill link listen lockf lseek mkdir
+   mkfifo mmap mmap_ba nice open opendir pipe putenv read readdir readlink
+   rename rewinddir rmdir select sendrecv setgid setgroups setsid setuid
+   shutdown signals sleep socket socketaddr socketpair sockopt stat strofaddr
+   symlink termios time times truncate umask unixsupport unlink utimes wait
+   write))
diff --git a/otherlibs/unix/dup.c b/otherlibs/unix/dup.c
new file mode 100644
index 00000000..c9294e6e
--- /dev/null
+++ b/otherlibs/unix/dup.c
@@ -0,0 +1,36 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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 _GNU_SOURCE
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+#include <fcntl.h>
+
+CAMLprim value unix_dup(value cloexec, value fd)
+{
+  int ret;
+#ifdef F_DUPFD_CLOEXEC
+  ret = fcntl(Int_val(fd),
+              (unix_cloexec_p(cloexec) ? F_DUPFD_CLOEXEC : F_DUPFD),
+              0);
+#else
+  ret = dup(Int_val(fd));
+#endif
+  if (ret == -1) uerror("dup", Nothing);
+#ifndef F_DUPFD_CLOEXEC
+  if (unix_cloexec_p(cloexec)) unix_set_cloexec(ret, "dup", Nothing);
+#endif
+  return Val_int(ret);
+}
diff --git a/otherlibs/unix/dup2.c b/otherlibs/unix/dup2.c
new file mode 100644
index 00000000..78539765
--- /dev/null
+++ b/otherlibs/unix/dup2.c
@@ -0,0 +1,44 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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 _GNU_SOURCE
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+#include <fcntl.h>
+
+CAMLprim value unix_dup2(value cloexec, value fd1, value fd2)
+{
+  if (Int_val(fd2) == Int_val(fd1)) {
+    /* In this case, dup3 fails and dup2 does nothing. */
+    /* Just apply the cloexec flag to fd2, if it is given. */
+    if (Is_block(cloexec)) {
+      if (Bool_val(Field(cloexec, 0)))
+        unix_set_cloexec(Int_val(fd2), "dup2", Nothing);
+      else
+        unix_clear_cloexec(Int_val(fd2), "dup2", Nothing);
+    }
+  } else {
+#ifdef HAS_DUP3
+    if (dup3(Int_val(fd1), Int_val(fd2),
+             unix_cloexec_p(cloexec) ? O_CLOEXEC : 0) == -1)
+      uerror("dup2", Nothing);
+#else
+    if (dup2(Int_val(fd1), Int_val(fd2)) == -1) uerror("dup2", Nothing);
+    if (unix_cloexec_p(cloexec))
+      unix_set_cloexec(Int_val(fd2), "dup2", Nothing);
+#endif
+  }
+  return Val_unit;
+}
diff --git a/otherlibs/unix/envir.c b/otherlibs/unix/envir.c
new file mode 100644
index 00000000..3ad4b9ca
--- /dev/null
+++ b/otherlibs/unix/envir.c
@@ -0,0 +1,68 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/config.h>
+
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#include <sys/types.h>
+#ifdef HAS_GETAUXVAL
+#include <sys/auxv.h>
+#endif
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+
+extern char ** environ;
+
+CAMLprim value unix_environment_unsafe(value unit)
+{
+  if (environ != NULL) {
+    return caml_copy_string_array((const char**)environ);
+  } else {
+    return Atom(0);
+  }
+}
+
+static char **secure_environ(void)
+{
+#ifdef HAS_GETAUXVAL
+  if (!getauxval(AT_SECURE))
+    return environ;
+  else
+   return NULL;
+#elif defined(HAS_ISSETUGID)
+  if (!issetugid ())
+    return environ;
+  else
+    return NULL;
+#else
+  if (geteuid () == getuid () && getegid () == getgid ())
+    return environ;
+  else
+    return NULL;
+#endif
+}
+
+CAMLprim value unix_environment(value unit)
+{
+  char **e = secure_environ();
+  if (e != NULL) {
+    return caml_copy_string_array((const char**)e);
+  } else {
+    return Atom(0);
+  }
+}
diff --git a/otherlibs/unix/errmsg.c b/otherlibs/unix/errmsg.c
new file mode 100644
index 00000000..fef473ea
--- /dev/null
+++ b/otherlibs/unix/errmsg.c
@@ -0,0 +1,28 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <errno.h>
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+
+extern int error_table[];
+
+CAMLprim value unix_error_message(value err)
+{
+  int errnum;
+  errnum = Is_block(err) ? Int_val(Field(err, 0)) : error_table[Int_val(err)];
+  return caml_copy_string(strerror(errnum));
+}
diff --git a/otherlibs/unix/execv.c b/otherlibs/unix/execv.c
new file mode 100644
index 00000000..e751b19d
--- /dev/null
+++ b/otherlibs/unix/execv.c
@@ -0,0 +1,36 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_execv(value path, value args)
+{
+  char_os * wpath;
+  char_os ** argv;
+  caml_unix_check_path(path, "execv");
+  argv = cstringvect(args, "execv");
+  wpath = caml_stat_strdup_to_os(String_val(path));
+  (void) execv_os(wpath, EXECV_CAST argv);
+  caml_stat_free(wpath);
+  cstringvect_free(argv);
+  uerror("execv", path);
+  return Val_unit;                  /* never reached, but suppress warnings */
+                                /* from smart compilers */
+}
diff --git a/otherlibs/unix/execve.c b/otherlibs/unix/execve.c
new file mode 100644
index 00000000..bdce766b
--- /dev/null
+++ b/otherlibs/unix/execve.c
@@ -0,0 +1,39 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_execve(value path, value args, value env)
+{
+  char_os ** argv;
+  char_os ** envp;
+  char_os * wpath;
+  caml_unix_check_path(path, "execve");
+  argv = cstringvect(args, "execve");
+  envp = cstringvect(env, "execve");
+  wpath = caml_stat_strdup_to_os(String_val(path));
+  (void) execve_os(wpath, EXECV_CAST argv, EXECV_CAST envp);
+  caml_stat_free(wpath);
+  cstringvect_free(argv);
+  cstringvect_free(envp);
+  uerror("execve", path);
+  return Val_unit;                  /* never reached, but suppress warnings */
+                                /* from smart compilers */
+}
diff --git a/otherlibs/unix/execvp.c b/otherlibs/unix/execvp.c
new file mode 100644
index 00000000..90ea1d01
--- /dev/null
+++ b/otherlibs/unix/execvp.c
@@ -0,0 +1,67 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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 _GNU_SOURCE  /* helps to find execvpe() */
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#define CAML_INTERNALS
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+#include "errno.h"
+
+CAMLprim value unix_execvp(value path, value args)
+{
+  char_os ** argv;
+  char_os * wpath;
+  caml_unix_check_path(path, "execvp");
+  argv = cstringvect(args, "execvp");
+  wpath = caml_stat_strdup_to_os(String_val(path));
+  (void) execvp_os((const char_os *)wpath, EXECV_CAST argv);
+  caml_stat_free(wpath);
+  cstringvect_free(argv);
+  uerror("execvp", path);
+  return Val_unit;                  /* never reached, but suppress warnings */
+                                    /* from smart compilers */
+}
+
+#ifdef HAS_EXECVPE
+
+CAMLprim value unix_execvpe(value path, value args, value env)
+{
+  char_os ** argv;
+  char_os ** envp;
+  char_os * wpath;
+  caml_unix_check_path(path, "execvpe");
+  argv = cstringvect(args, "execvpe");
+  envp = cstringvect(env, "execvpe");
+  wpath = caml_stat_strdup_to_os(String_val(path));
+  (void) execvpe_os((const char_os *)wpath, EXECV_CAST argv, EXECV_CAST envp);
+  caml_stat_free(wpath);
+  cstringvect_free(argv);
+  cstringvect_free(envp);
+  uerror("execvpe", path);
+  return Val_unit;                  /* never reached, but suppress warnings */
+                                    /* from smart compilers */
+}
+
+#else
+
+CAMLprim value unix_execvpe(value path, value args, value env)
+{
+  unix_error(ENOSYS, "execvpe", path);
+  return Val_unit;
+}
+
+#endif
diff --git a/otherlibs/unix/exit.c b/otherlibs/unix/exit.c
new file mode 100644
index 00000000..8da00dac
--- /dev/null
+++ b/otherlibs/unix/exit.c
@@ -0,0 +1,24 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_exit(value n)
+{
+  _exit(Int_val(n));
+  return Val_unit;                  /* never reached, but suppress warnings */
+                                    /* from smart compilers */
+}
diff --git a/otherlibs/unix/fchmod.c b/otherlibs/unix/fchmod.c
new file mode 100644
index 00000000..49c7e8b0
--- /dev/null
+++ b/otherlibs/unix/fchmod.c
@@ -0,0 +1,40 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#ifdef HAS_FCHMOD
+
+CAMLprim value unix_fchmod(value fd, value perm)
+{
+  int result;
+  caml_enter_blocking_section();
+  result = fchmod(Int_val(fd), Int_val(perm));
+  caml_leave_blocking_section();
+  if (result == -1) uerror("fchmod", Nothing);
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_fchmod(value fd, value perm)
+{ caml_invalid_argument("fchmod not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/fchown.c b/otherlibs/unix/fchown.c
new file mode 100644
index 00000000..8e441967
--- /dev/null
+++ b/otherlibs/unix/fchown.c
@@ -0,0 +1,38 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#ifdef HAS_FCHMOD
+
+CAMLprim value unix_fchown(value fd, value uid, value gid)
+{
+  int result;
+  caml_enter_blocking_section();
+  result = fchown(Int_val(fd), Int_val(uid), Int_val(gid));
+  caml_leave_blocking_section();
+  if (result == -1) uerror("fchown", Nothing);
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_fchown(value fd, value uid, value gid)
+{ caml_invalid_argument("fchown not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/fcntl.c b/otherlibs/unix/fcntl.c
new file mode 100644
index 00000000..e10a98e3
--- /dev/null
+++ b/otherlibs/unix/fcntl.c
@@ -0,0 +1,58 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#include <fcntl.h>
+
+#ifndef O_NONBLOCK
+#define O_NONBLOCK O_NDELAY
+#endif
+
+CAMLprim value unix_set_nonblock(value fd)
+{
+  int retcode;
+  retcode = fcntl(Int_val(fd), F_GETFL, 0);
+  if (retcode == -1 ||
+      fcntl(Int_val(fd), F_SETFL, retcode | O_NONBLOCK) == -1)
+    uerror("set_nonblock", Nothing);
+  return Val_unit;
+}
+
+CAMLprim value unix_clear_nonblock(value fd)
+{
+  int retcode;
+  retcode = fcntl(Int_val(fd), F_GETFL, 0);
+  if (retcode == -1 ||
+      fcntl(Int_val(fd), F_SETFL, retcode & ~O_NONBLOCK) == -1)
+    uerror("clear_nonblock", Nothing);
+  return Val_unit;
+}
+
+CAMLprim value unix_set_close_on_exec(value fd)
+{
+  unix_set_cloexec(Int_val(fd), "set_close_on_exec", Nothing);
+  return Val_unit;
+}
+
+CAMLprim value unix_clear_close_on_exec(value fd)
+{
+  unix_clear_cloexec(Int_val(fd), "set_close_on_exec", Nothing);
+  return Val_unit;
+}
diff --git a/otherlibs/unix/fork.c b/otherlibs/unix/fork.c
new file mode 100644
index 00000000..a244a5cf
--- /dev/null
+++ b/otherlibs/unix/fork.c
@@ -0,0 +1,43 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <caml/mlvalues.h>
+#include <caml/debugger.h>
+#include <caml/eventlog.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_fork(value unit)
+{
+  int ret;
+
+  CAML_EV_FLUSH();
+
+  ret = fork();
+  if (ret == -1) uerror("fork", Nothing);
+
+  CAML_EVENTLOG_DO({
+      if (ret == 0)
+        caml_eventlog_disable();
+  });
+
+  if (caml_debugger_in_use)
+    if ((caml_debugger_fork_mode && ret == 0) ||
+        (!caml_debugger_fork_mode && ret != 0))
+      caml_debugger_cleanup_fork();
+
+  return Val_int(ret);
+}
diff --git a/otherlibs/unix/fsync.c b/otherlibs/unix/fsync.c
new file mode 100644
index 00000000..efeadd49
--- /dev/null
+++ b/otherlibs/unix/fsync.c
@@ -0,0 +1,40 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Francois Berenger, Kyushu Institute of Technology          */
+/*                                                                        */
+/*   Copyright 2018 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#ifdef _WIN32
+#include <io.h>
+#define fsync(fd) _commit(fd)
+#else
+#define fsync(fd) fsync(fd)
+#endif
+
+CAMLprim value unix_fsync(value v)
+{
+  int ret;
+#ifdef _WIN32
+  int fd = win_CRT_fd_of_filedescr(v);
+#else
+  int fd = Int_val(v);
+#endif
+  caml_enter_blocking_section();
+  ret = fsync(fd);
+  caml_leave_blocking_section();
+  if (ret == -1) uerror("fsync", Nothing);
+  return Val_unit;
+}
diff --git a/otherlibs/unix/ftruncate.c b/otherlibs/unix/ftruncate.c
new file mode 100644
index 00000000..335ffe08
--- /dev/null
+++ b/otherlibs/unix/ftruncate.c
@@ -0,0 +1,59 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <sys/types.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/io.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+
+#ifdef HAS_TRUNCATE
+
+CAMLprim value unix_ftruncate(value fd, value len)
+{
+  int result;
+  caml_enter_blocking_section();
+  result = ftruncate(Int_val(fd), Long_val(len));
+  caml_leave_blocking_section();
+  if (result == -1) uerror("ftruncate", Nothing);
+  return Val_unit;
+}
+
+CAMLprim value unix_ftruncate_64(value fd, value len)
+{
+  int result;
+  file_offset ofs = File_offset_val(len);
+  caml_enter_blocking_section();
+  result = ftruncate(Int_val(fd), ofs);
+  caml_leave_blocking_section();
+  if (result == -1) uerror("ftruncate", Nothing);
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_ftruncate(value fd, value len)
+{ caml_invalid_argument("ftruncate not implemented"); }
+
+CAMLprim value unix_ftruncate_64(value fd, value len)
+{ caml_invalid_argument("ftruncate not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/getaddrinfo.c b/otherlibs/unix/getaddrinfo.c
new file mode 100644
index 00000000..4b2cd6e3
--- /dev/null
+++ b/otherlibs/unix/getaddrinfo.c
@@ -0,0 +1,135 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2004 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/misc.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+#include "cst2constr.h"
+
+#if defined(HAS_SOCKETS) && defined(HAS_IPV6)
+
+#include "socketaddr.h"
+#ifndef _WIN32
+#include <sys/types.h>
+#include <netdb.h>
+#endif
+
+extern int socket_domain_table[]; /* from socket.c */
+extern int socket_type_table[];   /* from socket.c */
+
+static value convert_addrinfo(struct addrinfo * a)
+{
+  CAMLparam0();
+  CAMLlocal3(vres,vaddr,vcanonname);
+  union sock_addr_union sa;
+  socklen_param_type len;
+
+  len = a->ai_addrlen;
+  if (len > sizeof(sa)) len = sizeof(sa);
+  memcpy(&sa.s_gen, a->ai_addr, len);
+  vaddr = alloc_sockaddr(&sa, len, -1);
+  vcanonname = caml_copy_string(a->ai_canonname == NULL ? "" : a->ai_canonname);
+  vres = caml_alloc_small(5, 0);
+  Field(vres, 0) = cst_to_constr(a->ai_family, socket_domain_table, 3, 0);
+  Field(vres, 1) = cst_to_constr(a->ai_socktype, socket_type_table, 4, 0);
+  Field(vres, 2) = Val_int(a->ai_protocol);
+  Field(vres, 3) = vaddr;
+  Field(vres, 4) = vcanonname;
+  CAMLreturn(vres);
+}
+
+CAMLprim value unix_getaddrinfo(value vnode, value vserv, value vopts)
+{
+  CAMLparam3(vnode, vserv, vopts);
+  CAMLlocal3(vres, v, e);
+  char * node, * serv;
+  struct addrinfo hints;
+  struct addrinfo * res, * r;
+  int retcode;
+
+  if (! (caml_string_is_c_safe(vnode) && caml_string_is_c_safe(vserv)))
+    CAMLreturn (Val_int(0));
+
+  /* Extract "node" parameter */
+  if (caml_string_length(vnode) == 0) {
+    node = NULL;
+  } else {
+    node = caml_stat_strdup(String_val(vnode));
+  }
+  /* Extract "service" parameter */
+  if (caml_string_length(vserv) == 0) {
+    serv = NULL;
+  } else {
+    serv = caml_stat_strdup(String_val(vserv));
+  }
+  /* Parse options, set hints */
+  memset(&hints, 0, sizeof(hints));
+  hints.ai_family = PF_UNSPEC;
+  for (/*nothing*/; Is_block(vopts); vopts = Field(vopts, 1)) {
+    v = Field(vopts, 0);
+    if (Is_block(v))
+      switch (Tag_val(v)) {
+      case 0:                   /* AI_FAMILY of socket_domain */
+        hints.ai_family = socket_domain_table[Int_val(Field(v, 0))];
+        break;
+      case 1:                   /* AI_SOCKTYPE of socket_type */
+        hints.ai_socktype = socket_type_table[Int_val(Field(v, 0))];
+        break;
+      case 2:                   /* AI_PROTOCOL of int */
+        hints.ai_protocol = Int_val(Field(v, 0));
+        break;
+      }
+    else
+      switch (Int_val(v)) {
+      case 0:                   /* AI_NUMERICHOST */
+        hints.ai_flags |= AI_NUMERICHOST; break;
+      case 1:                   /* AI_CANONNAME */
+        hints.ai_flags |= AI_CANONNAME; break;
+      case 2:                   /* AI_PASSIVE */
+        hints.ai_flags |= AI_PASSIVE; break;
+      }
+  }
+  /* Do the call */
+  caml_enter_blocking_section();
+  retcode = getaddrinfo(node, serv, &hints, &res);
+  caml_leave_blocking_section();
+  if (node != NULL) caml_stat_free(node);
+  if (serv != NULL) caml_stat_free(serv);
+  /* Convert result */
+  vres = Val_int(0);
+  if (retcode == 0) {
+    for (r = res; r != NULL; r = r->ai_next) {
+      e = convert_addrinfo(r);
+      v = caml_alloc_small(2, 0);
+      Field(v, 0) = e;
+      Field(v, 1) = vres;
+      vres = v;
+    }
+    freeaddrinfo(res);
+  }
+  CAMLreturn(vres);
+}
+
+#else
+
+CAMLprim value unix_getaddrinfo(value vnode, value vserv, value vopts)
+{ caml_invalid_argument("getaddrinfo not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/getcwd.c b/otherlibs/unix/getcwd.c
new file mode 100644
index 00000000..a38e4092
--- /dev/null
+++ b/otherlibs/unix/getcwd.c
@@ -0,0 +1,52 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+#if !defined (_WIN32) && !macintosh
+#include <sys/param.h>
+#endif
+
+#ifndef PATH_MAX
+#ifdef MAXPATHLEN
+#define PATH_MAX MAXPATHLEN
+#else
+#define PATH_MAX 512
+#endif
+#endif
+
+#ifdef HAS_GETCWD
+
+CAMLprim value unix_getcwd(value unit)
+{
+  char_os buff[PATH_MAX];
+  char_os * ret;
+  ret = getcwd_os(buff, sizeof(buff)/sizeof(*buff));
+  if (ret == 0) uerror("getcwd", Nothing);
+  return caml_copy_string_of_os(buff);
+}
+
+#else
+
+CAMLprim value unix_getcwd(value unit)
+{ caml_invalid_argument("getcwd not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/getegid.c b/otherlibs/unix/getegid.c
new file mode 100644
index 00000000..ddda2f63
--- /dev/null
+++ b/otherlibs/unix/getegid.c
@@ -0,0 +1,22 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_getegid(value unit)
+{
+  return Val_int(getegid());
+}
diff --git a/otherlibs/unix/geteuid.c b/otherlibs/unix/geteuid.c
new file mode 100644
index 00000000..3243ba76
--- /dev/null
+++ b/otherlibs/unix/geteuid.c
@@ -0,0 +1,22 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_geteuid(value unit)
+{
+  return Val_int(geteuid());
+}
diff --git a/otherlibs/unix/getgid.c b/otherlibs/unix/getgid.c
new file mode 100644
index 00000000..f18b4c09
--- /dev/null
+++ b/otherlibs/unix/getgid.c
@@ -0,0 +1,22 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_getgid(value unit)
+{
+  return Val_int(getgid());
+}
diff --git a/otherlibs/unix/getgr.c b/otherlibs/unix/getgr.c
new file mode 100644
index 00000000..7d120aa5
--- /dev/null
+++ b/otherlibs/unix/getgr.c
@@ -0,0 +1,74 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include "unixsupport.h"
+#include <errno.h>
+#include <stdio.h>
+#include <grp.h>
+
+static value alloc_group_entry(struct group *entry)
+{
+  value res;
+  value name = Val_unit, pass = Val_unit, mem = Val_unit;
+
+  Begin_roots3 (name, pass, mem);
+    name = caml_copy_string(entry->gr_name);
+    /* on some platforms, namely Android, gr_passwd can be NULL,
+       hence this workaround */
+    pass = caml_copy_string(entry->gr_passwd ? entry->gr_passwd : "");
+    mem = caml_copy_string_array((const char**)entry->gr_mem);
+    res = caml_alloc_small(4, 0);
+    Field(res,0) = name;
+    Field(res,1) = pass;
+    Field(res,2) = Val_int(entry->gr_gid);
+    Field(res,3) = mem;
+  End_roots();
+  return res;
+}
+
+CAMLprim value unix_getgrnam(value name)
+{
+  struct group * entry;
+  if (! caml_string_is_c_safe(name)) caml_raise_not_found();
+  errno = 0;
+  entry = getgrnam(String_val(name));
+  if (entry == NULL) {
+    if (errno == EINTR) {
+      uerror("getgrnam", Nothing);
+    } else {
+      caml_raise_not_found();
+    }
+  }
+  return alloc_group_entry(entry);
+}
+
+CAMLprim value unix_getgrgid(value gid)
+{
+  struct group * entry;
+  errno = 0;
+  entry = getgrgid(Int_val(gid));
+  if (entry == NULL) {
+    if (errno == EINTR) {
+      uerror("getgrgid", Nothing);
+    } else {
+      caml_raise_not_found();
+    }
+  }
+  return alloc_group_entry(entry);
+}
diff --git a/otherlibs/unix/getgroups.c b/otherlibs/unix/getgroups.c
new file mode 100644
index 00000000..4bccd69d
--- /dev/null
+++ b/otherlibs/unix/getgroups.c
@@ -0,0 +1,49 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+
+#ifdef HAS_GETGROUPS
+
+#include <sys/types.h>
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#include <limits.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_getgroups(value unit)
+{
+  gid_t gidset[NGROUPS_MAX];
+  int n;
+  value res;
+  int i;
+
+  n = getgroups(NGROUPS_MAX, gidset);
+  if (n == -1) uerror("getgroups", Nothing);
+  res = caml_alloc_tuple(n);
+  for (i = 0; i < n; i++)
+    Field(res, i) = Val_int(gidset[i]);
+  return res;
+}
+
+#else
+
+CAMLprim value unix_getgroups(value unit)
+{ caml_invalid_argument("getgroups not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/gethost.c b/otherlibs/unix/gethost.c
new file mode 100644
index 00000000..97e85f26
--- /dev/null
+++ b/otherlibs/unix/gethost.c
@@ -0,0 +1,173 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+#ifndef _WIN32
+#include <sys/types.h>
+#include <netdb.h>
+#endif
+
+#define NETDB_BUFFER_SIZE 10000
+
+#ifdef _WIN32
+#define GETHOSTBYADDR_IS_REENTRANT 1
+#define GETHOSTBYNAME_IS_REENTRANT 1
+#endif
+
+static int entry_h_length;
+
+extern int socket_domain_table[];
+
+static value alloc_one_addr(char const *a)
+{
+  struct in_addr addr;
+#ifdef HAS_IPV6
+  struct in6_addr addr6;
+  if (entry_h_length == 16) {
+    memmove(&addr6, a, 16);
+    return alloc_inet6_addr(&addr6);
+  }
+#endif
+  memmove (&addr, a, 4);
+  return alloc_inet_addr(&addr);
+}
+
+static value alloc_host_entry(struct hostent *entry)
+{
+  value res;
+  value name = Val_unit, aliases = Val_unit;
+  value addr_list = Val_unit, adr = Val_unit;
+
+  Begin_roots4 (name, aliases, addr_list, adr);
+    name = caml_copy_string((char *)(entry->h_name));
+    /* PR#4043: protect against buggy implementations of gethostbyname()
+       that return a NULL pointer in h_aliases */
+    if (entry->h_aliases)
+      aliases = caml_copy_string_array((const char**)entry->h_aliases);
+    else
+      aliases = Atom(0);
+    entry_h_length = entry->h_length;
+    addr_list =
+      caml_alloc_array(alloc_one_addr, (const char**)entry->h_addr_list);
+    res = caml_alloc_small(4, 0);
+    Field(res, 0) = name;
+    Field(res, 1) = aliases;
+    switch (entry->h_addrtype) {
+    case PF_UNIX:          Field(res, 2) = Val_int(0); break;
+    case PF_INET:          Field(res, 2) = Val_int(1); break;
+    default: /*PF_INET6 */ Field(res, 2) = Val_int(2); break;
+    }
+    Field(res, 3) = addr_list;
+  End_roots();
+  return res;
+}
+
+CAMLprim value unix_gethostbyaddr(value a)
+{
+  struct in_addr adr = GET_INET_ADDR(a);
+  struct hostent * hp;
+#if HAS_GETHOSTBYADDR_R == 7
+  struct hostent h;
+  char buffer[NETDB_BUFFER_SIZE];
+  int h_errnop;
+  caml_enter_blocking_section();
+  hp = gethostbyaddr_r((char *) &adr, 4, AF_INET,
+                       &h, buffer, sizeof(buffer), &h_errnop);
+  caml_leave_blocking_section();
+#elif HAS_GETHOSTBYADDR_R == 8
+  struct hostent h;
+  char buffer[NETDB_BUFFER_SIZE];
+  int h_errnop, rc;
+  caml_enter_blocking_section();
+  rc = gethostbyaddr_r((char *) &adr, 4, AF_INET,
+                       &h, buffer, sizeof(buffer), &hp, &h_errnop);
+  caml_leave_blocking_section();
+  if (rc != 0) hp = NULL;
+#else
+#ifdef GETHOSTBYADDR_IS_REENTRANT
+  caml_enter_blocking_section();
+#endif
+  hp = gethostbyaddr((char *) &adr, 4, AF_INET);
+#ifdef GETHOSTBYADDR_IS_REENTRANT
+  caml_leave_blocking_section();
+#endif
+#endif
+  if (hp == (struct hostent *) NULL) caml_raise_not_found();
+  return alloc_host_entry(hp);
+}
+
+CAMLprim value unix_gethostbyname(value name)
+{
+  struct hostent * hp;
+  char * hostname;
+#if HAS_GETHOSTBYNAME_R
+  struct hostent h;
+  char buffer[NETDB_BUFFER_SIZE];
+  int err;
+#endif
+
+  if (! caml_string_is_c_safe(name)) caml_raise_not_found();
+
+  hostname = caml_stat_strdup(String_val(name));
+
+#if HAS_GETHOSTBYNAME_R == 5
+  {
+    caml_enter_blocking_section();
+    hp = gethostbyname_r(hostname, &h, buffer, sizeof(buffer), &err);
+    caml_leave_blocking_section();
+  }
+#elif HAS_GETHOSTBYNAME_R == 6
+  {
+    int rc;
+    caml_enter_blocking_section();
+    rc = gethostbyname_r(hostname, &h, buffer, sizeof(buffer), &hp, &err);
+    caml_leave_blocking_section();
+    if (rc != 0) hp = NULL;
+  }
+#else
+#ifdef GETHOSTBYNAME_IS_REENTRANT
+  caml_enter_blocking_section();
+#endif
+  hp = gethostbyname(hostname);
+#ifdef GETHOSTBYNAME_IS_REENTRANT
+  caml_leave_blocking_section();
+#endif
+#endif
+
+  caml_stat_free(hostname);
+
+  if (hp == (struct hostent *) NULL) caml_raise_not_found();
+  return alloc_host_entry(hp);
+}
+
+#else
+
+CAMLprim value unix_gethostbyaddr(value name)
+{ caml_invalid_argument("gethostbyaddr not implemented"); }
+
+CAMLprim value unix_gethostbyname(value name)
+{ caml_invalid_argument("gethostbyname not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/gethostname.c b/otherlibs/unix/gethostname.c
new file mode 100644
index 00000000..0552a448
--- /dev/null
+++ b/otherlibs/unix/gethostname.c
@@ -0,0 +1,56 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#ifndef _WIN32
+#include <sys/param.h>
+#endif
+#include "unixsupport.h"
+
+#ifdef HAS_GETHOSTNAME
+
+#ifndef MAXHOSTNAMELEN
+#define MAXHOSTNAMELEN 256
+#endif
+
+CAMLprim value unix_gethostname(value unit)
+{
+  char name[MAXHOSTNAMELEN];
+  gethostname(name, MAXHOSTNAMELEN);
+  name[MAXHOSTNAMELEN-1] = 0;
+  return caml_copy_string(name);
+}
+
+#else
+#ifdef HAS_UNAME
+
+#include <sys/utsname.h>
+
+CAMLprim value unix_gethostname(value unit)
+{
+  struct utsname un;
+  uname(&un);
+  return copy_string(un.nodename);
+}
+
+#else
+
+CAMLprim value unix_gethostname(value unit)
+{ caml_invalid_argument("gethostname not implemented"); }
+
+#endif
+#endif
diff --git a/otherlibs/unix/getlogin.c b/otherlibs/unix/getlogin.c
new file mode 100644
index 00000000..9cbb9518
--- /dev/null
+++ b/otherlibs/unix/getlogin.c
@@ -0,0 +1,29 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include "unixsupport.h"
+#include <errno.h>
+
+extern char * getlogin(void);
+
+CAMLprim value unix_getlogin(value unit)
+{
+  char * name;
+  name = getlogin();
+  if (name == NULL) unix_error(ENOENT, "getlogin", Nothing);
+  return caml_copy_string(name);
+}
diff --git a/otherlibs/unix/getnameinfo.c b/otherlibs/unix/getnameinfo.c
new file mode 100644
index 00000000..d3721d8c
--- /dev/null
+++ b/otherlibs/unix/getnameinfo.c
@@ -0,0 +1,68 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2004 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#if defined(HAS_SOCKETS) && defined(HAS_IPV6)
+
+#include "socketaddr.h"
+#ifndef _WIN32
+#include <sys/types.h>
+#include <netdb.h>
+#endif
+
+static int getnameinfo_flag_table[] = {
+  NI_NOFQDN, NI_NUMERICHOST, NI_NAMEREQD, NI_NUMERICSERV, NI_DGRAM
+};
+
+CAMLprim value unix_getnameinfo(value vaddr, value vopts)
+{
+  CAMLparam0();
+  CAMLlocal3(vhost, vserv, vres);
+  union sock_addr_union addr;
+  socklen_param_type addr_len;
+  char host[4096];
+  char serv[1024];
+  int opts, retcode;
+
+  get_sockaddr(vaddr, &addr, &addr_len);
+  opts = caml_convert_flag_list(vopts, getnameinfo_flag_table);
+  caml_enter_blocking_section();
+  retcode =
+    getnameinfo((const struct sockaddr *) &addr.s_gen, addr_len,
+                host, sizeof(host), serv, sizeof(serv), opts);
+  caml_leave_blocking_section();
+  /* TODO: detailed error reporting? */
+  if (retcode != 0) caml_raise_not_found();
+  vhost = caml_copy_string(host);
+  vserv = caml_copy_string(serv);
+  vres = caml_alloc_small(2, 0);
+  Field(vres, 0) = vhost;
+  Field(vres, 1) = vserv;
+  CAMLreturn(vres);
+}
+
+#else
+
+CAMLprim value unix_getnameinfo(value vaddr, value vopts)
+{ caml_invalid_argument("getnameinfo not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/getpeername.c b/otherlibs/unix/getpeername.c
new file mode 100644
index 00000000..9390b55b
--- /dev/null
+++ b/otherlibs/unix/getpeername.c
@@ -0,0 +1,41 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+
+CAMLprim value unix_getpeername(value sock)
+{
+  int retcode;
+  union sock_addr_union addr;
+  socklen_param_type addr_len;
+
+  addr_len = sizeof(addr);
+  retcode = getpeername(Int_val(sock), &addr.s_gen, &addr_len);
+  if (retcode == -1) uerror("getpeername", Nothing);
+  return alloc_sockaddr(&addr, addr_len, -1);
+}
+
+#else
+
+CAMLprim value unix_getpeername(value sock)
+{ caml_invalid_argument("getpeername not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/getpid.c b/otherlibs/unix/getpid.c
new file mode 100644
index 00000000..1c7600d6
--- /dev/null
+++ b/otherlibs/unix/getpid.c
@@ -0,0 +1,22 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_getpid(value unit)
+{
+  return Val_int(getpid());
+}
diff --git a/otherlibs/unix/getppid.c b/otherlibs/unix/getppid.c
new file mode 100644
index 00000000..ba961f32
--- /dev/null
+++ b/otherlibs/unix/getppid.c
@@ -0,0 +1,22 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_getppid(value unit)
+{
+  return Val_int(getppid());
+}
diff --git a/otherlibs/unix/getproto.c b/otherlibs/unix/getproto.c
new file mode 100644
index 00000000..d50c2d4a
--- /dev/null
+++ b/otherlibs/unix/getproto.c
@@ -0,0 +1,69 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#ifndef _WIN32
+#include <netdb.h>
+#endif
+
+static value alloc_proto_entry(struct protoent *entry)
+{
+  value res;
+  value name = Val_unit, aliases = Val_unit;
+
+  Begin_roots2 (name, aliases);
+    name = caml_copy_string(entry->p_name);
+    aliases = caml_copy_string_array((const char**)entry->p_aliases);
+    res = caml_alloc_small(3, 0);
+    Field(res,0) = name;
+    Field(res,1) = aliases;
+    Field(res,2) = Val_int(entry->p_proto);
+  End_roots();
+  return res;
+}
+
+CAMLprim value unix_getprotobyname(value name)
+{
+  struct protoent * entry;
+  if (! caml_string_is_c_safe(name)) caml_raise_not_found();
+  entry = getprotobyname(String_val(name));
+  if (entry == (struct protoent *) NULL) caml_raise_not_found();
+  return alloc_proto_entry(entry);
+}
+
+CAMLprim value unix_getprotobynumber(value proto)
+{
+  struct protoent * entry;
+  entry = getprotobynumber(Int_val(proto));
+  if (entry == (struct protoent *) NULL) caml_raise_not_found();
+  return alloc_proto_entry(entry);
+}
+
+#else
+
+CAMLprim value unix_getprotobynumber(value proto)
+{ caml_invalid_argument("getprotobynumber not implemented"); }
+
+CAMLprim value unix_getprotobyname(value name)
+{ caml_invalid_argument("getprotobyname not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/getpw.c b/otherlibs/unix/getpw.c
new file mode 100644
index 00000000..0c0ec80d
--- /dev/null
+++ b/otherlibs/unix/getpw.c
@@ -0,0 +1,81 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include "unixsupport.h"
+#include <errno.h>
+#include <pwd.h>
+
+static value alloc_passwd_entry(struct passwd *entry)
+{
+  value res;
+  value name = Val_unit, passwd = Val_unit, gecos = Val_unit;
+  value dir = Val_unit, shell = Val_unit;
+
+  Begin_roots5 (name, passwd, gecos, dir, shell);
+    name = caml_copy_string(entry->pw_name);
+    passwd = caml_copy_string(entry->pw_passwd);
+#if !defined(__BEOS__) && !defined(__ANDROID__)
+    gecos = caml_copy_string(entry->pw_gecos);
+#else
+    gecos = caml_copy_string("");
+#endif
+    dir = caml_copy_string(entry->pw_dir);
+    shell = caml_copy_string(entry->pw_shell);
+    res = caml_alloc_small(7, 0);
+    Field(res,0) = name;
+    Field(res,1) = passwd;
+    Field(res,2) = Val_int(entry->pw_uid);
+    Field(res,3) = Val_int(entry->pw_gid);
+    Field(res,4) = gecos;
+    Field(res,5) = dir;
+    Field(res,6) = shell;
+  End_roots();
+  return res;
+}
+
+CAMLprim value unix_getpwnam(value name)
+{
+  struct passwd * entry;
+  if (! caml_string_is_c_safe(name)) caml_raise_not_found();
+  errno = 0;
+  entry = getpwnam(String_val(name));
+  if (entry == (struct passwd *) NULL) {
+    if (errno == EINTR) {
+      uerror("getpwnam", Nothing);
+    } else {
+      caml_raise_not_found();
+    }
+  }
+  return alloc_passwd_entry(entry);
+}
+
+CAMLprim value unix_getpwuid(value uid)
+{
+  struct passwd * entry;
+  errno = 0;
+  entry = getpwuid(Int_val(uid));
+  if (entry == (struct passwd *) NULL) {
+    if (errno == EINTR) {
+      uerror("getpwuid", Nothing);
+    } else {
+      caml_raise_not_found();
+    }
+  }
+  return alloc_passwd_entry(entry);
+}
diff --git a/otherlibs/unix/getserv.c b/otherlibs/unix/getserv.c
new file mode 100644
index 00000000..9edfa879
--- /dev/null
+++ b/otherlibs/unix/getserv.c
@@ -0,0 +1,77 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#include <sys/types.h>
+
+#ifndef _WIN32
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <netdb.h>
+#endif
+
+static value alloc_service_entry(struct servent *entry)
+{
+  value res;
+  value name = Val_unit, aliases = Val_unit, proto = Val_unit;
+
+  Begin_roots3 (name, aliases, proto);
+    name = caml_copy_string(entry->s_name);
+    aliases = caml_copy_string_array((const char**)entry->s_aliases);
+    proto = caml_copy_string(entry->s_proto);
+    res = caml_alloc_small(4, 0);
+    Field(res,0) = name;
+    Field(res,1) = aliases;
+    Field(res,2) = Val_int(ntohs(entry->s_port));
+    Field(res,3) = proto;
+  End_roots();
+  return res;
+}
+
+CAMLprim value unix_getservbyname(value name, value proto)
+{
+  struct servent * entry;
+  if (! (caml_string_is_c_safe(name) && caml_string_is_c_safe(proto)))
+    caml_raise_not_found();
+  entry = getservbyname(String_val(name), String_val(proto));
+  if (entry == (struct servent *) NULL) caml_raise_not_found();
+  return alloc_service_entry(entry);
+}
+
+CAMLprim value unix_getservbyport(value port, value proto)
+{
+  struct servent * entry;
+  if (! caml_string_is_c_safe(proto)) caml_raise_not_found();
+  entry = getservbyport(htons(Int_val(port)), String_val(proto));
+  if (entry == (struct servent *) NULL) caml_raise_not_found();
+  return alloc_service_entry(entry);
+}
+
+#else
+
+CAMLprim value unix_getservbyport(value port, value proto)
+{ caml_invalid_argument("getservbyport not implemented"); }
+
+CAMLprim value unix_getservbyname(value name, value proto)
+{ caml_invalid_argument("getservbyname not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/getsockname.c b/otherlibs/unix/getsockname.c
new file mode 100644
index 00000000..3544b25f
--- /dev/null
+++ b/otherlibs/unix/getsockname.c
@@ -0,0 +1,41 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+
+CAMLprim value unix_getsockname(value sock)
+{
+  int retcode;
+  union sock_addr_union addr;
+  socklen_param_type addr_len;
+
+  addr_len = sizeof(addr);
+  retcode = getsockname(Int_val(sock), &addr.s_gen, &addr_len);
+  if (retcode == -1) uerror("getsockname", Nothing);
+  return alloc_sockaddr(&addr, addr_len, -1);
+}
+
+#else
+
+CAMLprim value unix_getsockname(value sock)
+{ caml_invalid_argument("getsockname not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/gettimeofday.c b/otherlibs/unix/gettimeofday.c
new file mode 100644
index 00000000..609a9a82
--- /dev/null
+++ b/otherlibs/unix/gettimeofday.c
@@ -0,0 +1,38 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include "unixsupport.h"
+
+#ifdef HAS_GETTIMEOFDAY
+
+#include <sys/types.h>
+#include <sys/time.h>
+
+CAMLprim value unix_gettimeofday(value unit)
+{
+  struct timeval tp;
+  if (gettimeofday(&tp, NULL) == -1) uerror("gettimeofday", Nothing);
+  return caml_copy_double((double) tp.tv_sec + (double) tp.tv_usec / 1e6);
+}
+
+#else
+
+CAMLprim value unix_gettimeofday(value unit)
+{ caml_invalid_argument("gettimeofday not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/getuid.c b/otherlibs/unix/getuid.c
new file mode 100644
index 00000000..781c4b8d
--- /dev/null
+++ b/otherlibs/unix/getuid.c
@@ -0,0 +1,22 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_getuid(value unit)
+{
+  return Val_int(getuid());
+}
diff --git a/otherlibs/unix/gmtime.c b/otherlibs/unix/gmtime.c
new file mode 100644
index 00000000..b0c2711a
--- /dev/null
+++ b/otherlibs/unix/gmtime.c
@@ -0,0 +1,95 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include "unixsupport.h"
+#include <time.h>
+#include <errno.h>
+
+static value alloc_tm(struct tm *tm)
+{
+  value res;
+  res = caml_alloc_small(9, 0);
+  Field(res,0) = Val_int(tm->tm_sec);
+  Field(res,1) = Val_int(tm->tm_min);
+  Field(res,2) = Val_int(tm->tm_hour);
+  Field(res,3) = Val_int(tm->tm_mday);
+  Field(res,4) = Val_int(tm->tm_mon);
+  Field(res,5) = Val_int(tm->tm_year);
+  Field(res,6) = Val_int(tm->tm_wday);
+  Field(res,7) = Val_int(tm->tm_yday);
+  Field(res,8) = tm->tm_isdst ? Val_true : Val_false;
+  return res;
+}
+
+CAMLprim value unix_gmtime(value t)
+{
+  time_t clock;
+  struct tm * tm;
+  clock = (time_t) Double_val(t);
+  tm = gmtime(&clock);
+  if (tm == NULL) unix_error(EINVAL, "gmtime", Nothing);
+  return alloc_tm(tm);
+}
+
+CAMLprim value unix_localtime(value t)
+{
+  time_t clock;
+  struct tm * tm;
+  clock = (time_t) Double_val(t);
+  tm = localtime(&clock);
+  if (tm == NULL) unix_error(EINVAL, "localtime", Nothing);
+  return alloc_tm(tm);
+}
+
+#ifdef HAS_MKTIME
+
+CAMLprim value unix_mktime(value t)
+{
+  struct tm tm;
+  time_t clock;
+  value res;
+  value tmval = Val_unit, clkval = Val_unit;
+
+  Begin_roots2(tmval, clkval);
+    tm.tm_sec = Int_val(Field(t, 0));
+    tm.tm_min = Int_val(Field(t, 1));
+    tm.tm_hour = Int_val(Field(t, 2));
+    tm.tm_mday = Int_val(Field(t, 3));
+    tm.tm_mon = Int_val(Field(t, 4));
+    tm.tm_year = Int_val(Field(t, 5));
+    tm.tm_wday = Int_val(Field(t, 6));
+    tm.tm_yday = Int_val(Field(t, 7));
+    tm.tm_isdst = -1; /* tm.tm_isdst = Bool_val(Field(t, 8)); */
+    clock = mktime(&tm);
+    if (clock == (time_t) -1) unix_error(ERANGE, "mktime", Nothing);
+    tmval = alloc_tm(&tm);
+    clkval = caml_copy_double((double) clock);
+    res = caml_alloc_small(2, 0);
+    Field(res, 0) = clkval;
+    Field(res, 1) = tmval;
+  End_roots ();
+  return res;
+}
+
+#else
+
+CAMLprim value unix_mktime(value t)
+{ caml_invalid_argument("mktime not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/initgroups.c b/otherlibs/unix/initgroups.c
new file mode 100644
index 00000000..77be82f0
--- /dev/null
+++ b/otherlibs/unix/initgroups.c
@@ -0,0 +1,46 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Contributed by Stephane Glondu <steph@glondu.net>                    */
+/*                                                                        */
+/*   Copyright 2009 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+
+#ifdef HAS_INITGROUPS
+
+#include <sys/types.h>
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#include <errno.h>
+#include <limits.h>
+#include <grp.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_initgroups(value user, value group)
+{
+  if (! caml_string_is_c_safe(user))
+    unix_error(EINVAL, "initgroups", user);
+  if (initgroups(String_val(user), Int_val(group)) == -1) {
+    uerror("initgroups", Nothing);
+  }
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_initgroups(value user, value group)
+{ caml_invalid_argument("initgroups not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/isatty.c b/otherlibs/unix/isatty.c
new file mode 100644
index 00000000..fb537dd1
--- /dev/null
+++ b/otherlibs/unix/isatty.c
@@ -0,0 +1,22 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2006 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_isatty(value fd)
+{
+  return (Val_bool(isatty(Int_val(fd))));
+}
diff --git a/otherlibs/unix/itimer.c b/otherlibs/unix/itimer.c
new file mode 100644
index 00000000..09993706
--- /dev/null
+++ b/otherlibs/unix/itimer.c
@@ -0,0 +1,75 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SETITIMER
+
+#include <math.h>
+#include <sys/time.h>
+
+static void unix_set_timeval(struct timeval * tv, double d)
+{
+  double integr, frac;
+  frac = modf(d, &integr);
+  /* Round time up so that if d is small but not 0, we end up with
+     a non-0 timeval. */
+  tv->tv_sec = integr;
+  tv->tv_usec = ceil(1e6 * frac);
+  if (tv->tv_usec >= 1000000) { tv->tv_sec++; tv->tv_usec = 0; }
+}
+
+static value unix_convert_itimer(struct itimerval *tp)
+{
+#define Get_timeval(tv) (double) tv.tv_sec + (double) tv.tv_usec / 1e6
+  value res = caml_alloc_small(Double_wosize * 2, Double_array_tag);
+  Store_double_field(res, 0, Get_timeval(tp->it_interval));
+  Store_double_field(res, 1, Get_timeval(tp->it_value));
+  return res;
+#undef Get_timeval
+}
+
+static int itimers[3] = { ITIMER_REAL, ITIMER_VIRTUAL, ITIMER_PROF };
+
+CAMLprim value unix_setitimer(value which, value newval)
+{
+  struct itimerval new, old;
+  unix_set_timeval(&new.it_interval, Double_field(newval, 0));
+  unix_set_timeval(&new.it_value, Double_field(newval, 1));
+  if (setitimer(itimers[Int_val(which)], &new, &old) == -1)
+    uerror("setitimer", Nothing);
+  return unix_convert_itimer(&old);
+}
+
+CAMLprim value unix_getitimer(value which)
+{
+  struct itimerval val;
+  if (getitimer(itimers[Int_val(which)], &val) == -1)
+    uerror("getitimer", Nothing);
+  return unix_convert_itimer(&val);
+}
+
+#else
+
+CAMLprim value unix_setitimer(value which, value newval)
+{ caml_invalid_argument("setitimer not implemented"); }
+CAMLprim value unix_getitimer(value which)
+{ caml_invalid_argument("getitimer not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/kill.c b/otherlibs/unix/kill.c
new file mode 100644
index 00000000..d229d3e9
--- /dev/null
+++ b/otherlibs/unix/kill.c
@@ -0,0 +1,31 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
+#include "unixsupport.h"
+#include <signal.h>
+#include <caml/signals.h>
+
+CAMLprim value unix_kill(value pid, value signal)
+{
+  int sig;
+  sig = caml_convert_signal_number(Int_val(signal));
+  if (kill(Int_val(pid), sig) == -1)
+    uerror("kill", Nothing);
+  return Val_unit;
+}
diff --git a/otherlibs/unix/link.c b/otherlibs/unix/link.c
new file mode 100644
index 00000000..c5dc603b
--- /dev/null
+++ b/otherlibs/unix/link.c
@@ -0,0 +1,58 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Needed to get linkat exposed in compliant OS.
+   Must be defined before the first system .h is included. */
+#define _XOPEN_SOURCE 700
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#include <fcntl.h>
+#include <unistd.h>
+#include <errno.h>
+
+CAMLprim value unix_link(value follow, value path1, value path2)
+{
+  CAMLparam3(follow, path1, path2);
+  char * p1;
+  char * p2;
+  int ret;
+  caml_unix_check_path(path1, "link");
+  caml_unix_check_path(path2, "link");
+  p1 = caml_stat_strdup(String_val(path1));
+  p2 = caml_stat_strdup(String_val(path2));
+  caml_enter_blocking_section();
+  if (follow == Val_int(0) /* None */)
+    ret = link(p1, p2);
+  else { /* Some bool */
+# ifdef AT_SYMLINK_FOLLOW
+    int flags =
+      Is_block(follow) && Bool_val(Field(follow, 0)) /* Some true */
+      ? AT_SYMLINK_FOLLOW
+      : 0;
+    ret = linkat(AT_FDCWD, p1, AT_FDCWD, p2, flags);
+# else
+    ret = -1; errno = ENOSYS;
+# endif
+  }
+  caml_leave_blocking_section();
+  caml_stat_free(p1);
+  caml_stat_free(p2);
+  if (ret == -1) uerror("link", path2);
+  CAMLreturn(Val_unit);
+}
diff --git a/otherlibs/unix/listen.c b/otherlibs/unix/listen.c
new file mode 100644
index 00000000..f5ac130d
--- /dev/null
+++ b/otherlibs/unix/listen.c
@@ -0,0 +1,35 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#include <sys/socket.h>
+
+CAMLprim value unix_listen(value sock, value backlog)
+{
+  if (listen(Int_val(sock), Int_val(backlog)) == -1) uerror("listen", Nothing);
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_listen(value sock, value backlog)
+{ caml_invalid_argument("listen not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/lockf.c b/otherlibs/unix/lockf.c
new file mode 100644
index 00000000..cdcc4afe
--- /dev/null
+++ b/otherlibs/unix/lockf.c
@@ -0,0 +1,116 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <errno.h>
+#include <fcntl.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#if defined(F_GETLK) && defined(F_SETLK) && defined(F_SETLKW)
+
+CAMLprim value unix_lockf(value fd, value cmd, value span)
+{
+  struct flock l;
+  int ret;
+  int fildes;
+  long size;
+
+  fildes = Int_val(fd);
+  size = Long_val(span);
+  l.l_whence = 1;
+  if (size < 0) {
+    l.l_start = size;
+    l.l_len = -size;
+  } else {
+    l.l_start = 0L;
+    l.l_len = size;
+  }
+  switch (Int_val(cmd)) {
+  case 0: /* F_ULOCK */
+    l.l_type = F_UNLCK;
+    ret = fcntl(fildes, F_SETLK, &l);
+    break;
+  case 1: /* F_LOCK */
+    l.l_type = F_WRLCK;
+    caml_enter_blocking_section();
+    ret = fcntl(fildes, F_SETLKW, &l);
+    caml_leave_blocking_section();
+    break;
+  case 2: /* F_TLOCK */
+    l.l_type = F_WRLCK;
+    ret = fcntl(fildes, F_SETLK, &l);
+    break;
+  case 3: /* F_TEST */
+    l.l_type = F_WRLCK;
+    ret = fcntl(fildes, F_GETLK, &l);
+    if (ret != -1) {
+      if (l.l_type == F_UNLCK)
+        ret = 0;
+      else {
+        errno = EACCES;
+        ret = -1;
+      }
+    }
+    break;
+  case 4: /* F_RLOCK */
+    l.l_type = F_RDLCK;
+    caml_enter_blocking_section();
+    ret = fcntl(fildes, F_SETLKW, &l);
+    caml_leave_blocking_section();
+    break;
+  case 5: /* F_TRLOCK */
+    l.l_type = F_RDLCK;
+    ret = fcntl(fildes, F_SETLK, &l);
+    break;
+  default:
+    errno = EINVAL;
+    ret = -1;
+  }
+  if (ret == -1) uerror("lockf", Nothing);
+  return Val_unit;
+}
+
+#else
+
+#ifdef HAS_LOCKF
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#else
+#define F_ULOCK 0
+#define F_LOCK 1
+#define F_TLOCK 2
+#define F_TEST 3
+#endif
+
+static int lock_command_table[] = {
+  F_ULOCK, F_LOCK, F_TLOCK, F_TEST, F_LOCK, F_TLOCK
+};
+
+CAMLprim value unix_lockf(value fd, value cmd, value span)
+{
+  if (lockf(Int_val(fd), lock_command_table[Int_val(cmd)], Long_val(span))
+      == -1) uerror("lockf", Nothing);
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_lockf(value fd, value cmd, value span)
+{ caml_invalid_argument("lockf not implemented"); }
+
+#endif
+#endif
diff --git a/otherlibs/unix/lseek.c b/otherlibs/unix/lseek.c
new file mode 100644
index 00000000..4b3cad41
--- /dev/null
+++ b/otherlibs/unix/lseek.c
@@ -0,0 +1,66 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <errno.h>
+#include <sys/types.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/io.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#else
+#define SEEK_SET 0
+#define SEEK_CUR 1
+#define SEEK_END 2
+#endif
+
+#ifndef EOVERFLOW
+#define EOVERFLOW ERANGE
+#endif
+
+static int seek_command_table[] = {
+  SEEK_SET, SEEK_CUR, SEEK_END
+};
+
+CAMLprim value unix_lseek(value fd, value ofs, value cmd)
+{
+  file_offset ret;
+  caml_enter_blocking_section();
+  ret = lseek(Int_val(fd), Long_val(ofs),
+                       seek_command_table[Int_val(cmd)]);
+  caml_leave_blocking_section();
+  if (ret == -1) uerror("lseek", Nothing);
+  if (ret > Max_long) unix_error(EOVERFLOW, "lseek", Nothing);
+  return Val_long(ret);
+}
+
+CAMLprim value unix_lseek_64(value fd, value ofs, value cmd)
+{
+  file_offset ret;
+  /* [ofs] is an Int64, which is stored as a custom block; we must therefore
+     extract its contents before dropping the runtime lock, or it might be
+     moved. */
+  file_offset ofs_c = File_offset_val(ofs);
+  caml_enter_blocking_section();
+  ret = lseek(Int_val(fd), ofs_c, seek_command_table[Int_val(cmd)]);
+  caml_leave_blocking_section();
+  if (ret == -1) uerror("lseek", Nothing);
+  return Val_file_offset(ret);
+}
diff --git a/otherlibs/unix/mkdir.c b/otherlibs/unix/mkdir.c
new file mode 100644
index 00000000..0c177781
--- /dev/null
+++ b/otherlibs/unix/mkdir.c
@@ -0,0 +1,36 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_mkdir(value path, value perm)
+{
+  CAMLparam2(path, perm);
+  char * p;
+  int ret;
+  caml_unix_check_path(path, "mkdir");
+  p = caml_stat_strdup(String_val(path));
+  caml_enter_blocking_section();
+  ret = mkdir(p, Int_val(perm));
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1) uerror("mkdir", path);
+  CAMLreturn(Val_unit);
+}
diff --git a/otherlibs/unix/mkfifo.c b/otherlibs/unix/mkfifo.c
new file mode 100644
index 00000000..7914c877
--- /dev/null
+++ b/otherlibs/unix/mkfifo.c
@@ -0,0 +1,73 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#ifdef HAS_MKFIFO
+
+CAMLprim value unix_mkfifo(value path, value mode)
+{
+  CAMLparam2(path, mode);
+  char * p;
+  int ret;
+  caml_unix_check_path(path, "mkfifo");
+  p = caml_stat_strdup(String_val(path));
+  caml_enter_blocking_section();
+  ret = mkfifo(p, Int_val(mode));
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1)
+    uerror("mkfifo", path);
+  CAMLreturn(Val_unit);
+}
+
+#else
+
+#include <sys/types.h>
+#include <sys/stat.h>
+
+#ifdef S_IFIFO
+
+CAMLprim value unix_mkfifo(value path, value mode)
+{
+  CAMLparam2(path, mode);
+  char * p;
+  int ret;
+  caml_unix_check_path(path, "mkfifo");
+  p = caml_stat_strdup(String_val(path));
+  caml_enter_blocking_section();
+  ret = mknod(p, (Int_val(mode) & 07777) | S_IFIFO, 0);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1)
+    uerror("mkfifo", path);
+  CAMLreturn(Val_unit);
+}
+
+#else
+
+CAMLprim value unix_mkfifo(value path, value mode)
+{
+  caml_invalid_argument("mkfifo not implemented");
+}
+
+#endif
+#endif
diff --git a/otherlibs/unix/mmap.c b/otherlibs/unix/mmap.c
new file mode 100644
index 00000000..15465ddc
--- /dev/null
+++ b/otherlibs/unix/mmap.c
@@ -0,0 +1,207 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Manuel Serrano and Xavier Leroy, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2000 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
+
+/* Needed (under Linux at least) to get pwrite's prototype in unistd.h.
+   Must be defined before the first system .h is included. */
+#define _XOPEN_SOURCE 600
+
+#include <stddef.h>
+#include "caml/bigarray.h"
+#include "caml/fail.h"
+#include "caml/io.h"
+#include "caml/mlvalues.h"
+#include "caml/signals.h"
+#include "caml/sys.h"
+#include "unixsupport.h"
+
+#include <errno.h>
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#ifdef HAS_MMAP
+#include <sys/types.h>
+#include <sys/mman.h>
+#include <sys/stat.h>
+#endif
+
+/* Defined in [mmap_ba.c] */
+CAMLextern value
+caml_unix_mapped_alloc(int flags, int num_dims, void * data, intnat * dim);
+
+#if defined(HAS_MMAP)
+
+#ifndef MAP_FAILED
+#define MAP_FAILED ((void *) -1)
+#endif
+
+/* [caml_grow_file] function contributed by Gerd Stolpmann (PR#5543). */
+
+static int caml_grow_file(int fd, file_offset size)
+{
+  char c;
+  int p;
+
+  /* First use pwrite for growing - it is a conservative method, as it
+     can never happen that we shrink by accident
+   */
+#ifdef HAS_PWRITE
+  c = 0;
+  p = pwrite(fd, &c, 1, size - 1);
+#else
+
+  /* Emulate pwrite with lseek. This should only be necessary on ancient
+     systems nowadays
+   */
+  file_offset currpos;
+  currpos = lseek(fd, 0, SEEK_CUR);
+  if (currpos != -1) {
+    p = lseek(fd, size - 1, SEEK_SET);
+    if (p != -1) {
+      c = 0;
+      p = write(fd, &c, 1);
+      if (p != -1)
+        p = lseek(fd, currpos, SEEK_SET);
+    }
+  }
+  else p=-1;
+#endif
+#ifdef HAS_TRUNCATE
+  if (p == -1 && errno == ESPIPE) {
+    /* Plan B. Check if at least ftruncate is possible. There are
+       some non-seekable descriptor types that do not support pwrite
+       but ftruncate, like shared memory. We never get into this case
+       for real files, so there is no danger of truncating persistent
+       data by accident
+     */
+    p = ftruncate(fd, size);
+  }
+#endif
+  return p;
+}
+
+
+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 dim[CAML_BA_MAX_NUM_DIMS];
+  file_offset startpos, file_size, data_size;
+  struct stat st;
+  uintnat array_size, page, delta;
+  void * addr;
+
+  fd = Int_val(vfd);
+  flags = Caml_ba_kind_val(vkind) | Caml_ba_layout_val(vlayout);
+  startpos = File_offset_val(vstart);
+  num_dims = Wosize_val(vdim);
+  major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0;
+  /* Extract dimensions from OCaml array */
+  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++) {
+    dim[i] = Long_val(Field(vdim, i));
+    if (dim[i] == -1 && i == major_dim) continue;
+    if (dim[i] < 0)
+      caml_invalid_argument("Unix.map_file: negative dimension");
+  }
+  /* Determine file size. We avoid lseek here because it is fragile,
+     and because some mappable file types do not support it
+   */
+  caml_enter_blocking_section();
+  if (fstat(fd, &st) == -1) {
+    caml_leave_blocking_section();
+    uerror("map_file", Nothing);
+  }
+  file_size = st.st_size;
+  /* 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++)
+    if (dim[i] != -1) array_size *= dim[i];
+  /* Check if the major dimension is unknown */
+  if (dim[major_dim] == -1) {
+    /* Determine major dimension from file size */
+    if (file_size < startpos) {
+      caml_leave_blocking_section();
+      caml_failwith("Unix.map_file: file position exceeds file size");
+    }
+    data_size = file_size - startpos;
+    dim[major_dim] = (uintnat) (data_size / array_size);
+    array_size = dim[major_dim] * array_size;
+    if (array_size != data_size) {
+      caml_leave_blocking_section();
+      caml_failwith("Unix.map_file: file size doesn't match array dimensions");
+    }
+  } else {
+    /* Check that file is large enough, and grow it otherwise */
+    if (file_size < startpos + array_size) {
+      if (caml_grow_file(fd, startpos + array_size) == -1) { /* PR#5543 */
+        caml_leave_blocking_section();
+        uerror("map_file", Nothing);
+      }
+    }
+  }
+  /* Determine offset so that the mapping starts at the given file pos */
+  page = sysconf(_SC_PAGESIZE);
+  delta = (uintnat) startpos % page;
+  /* Do the mmap */
+  shared = Bool_val(vshared) ? MAP_SHARED : MAP_PRIVATE;
+  if (array_size > 0)
+    addr = mmap(NULL, array_size + delta, PROT_READ | PROT_WRITE,
+                shared, fd, startpos - delta);
+  else
+    addr = NULL;                /* PR#5463 - mmap fails on empty region */
+  caml_leave_blocking_section();
+  if (addr == (void *) MAP_FAILED) uerror("map_file", Nothing);
+  addr = (void *) ((uintnat) addr + delta);
+  /* Build and return the OCaml bigarray */
+  return caml_unix_mapped_alloc(flags, num_dims, addr, dim);
+}
+
+#else
+
+CAMLprim value caml_unix_map_file(value vfd, value vkind, value vlayout,
+                                  value vshared, value vdim, value vpos)
+{
+  caml_invalid_argument("Unix.map_file: not supported");
+  return Val_unit;
+}
+
+#endif
+
+CAMLprim value caml_unix_map_file_bytecode(value * argv, int argn)
+{
+  return caml_unix_map_file(argv[0], argv[1], argv[2],
+                            argv[3], argv[4], argv[5]);
+}
+
+void caml_ba_unmap_file(void * addr, uintnat len)
+{
+#if defined(HAS_MMAP)
+  uintnat page = sysconf(_SC_PAGESIZE);
+  uintnat delta = (uintnat) addr % page;
+  if (len == 0) return;         /* PR#5463 */
+  addr = (void *)((uintnat)addr - delta);
+  len  = len + delta;
+#if defined(_POSIX_SYNCHRONIZED_IO)
+  msync(addr, len, MS_ASYNC);   /* PR#3571 */
+#endif
+  munmap(addr, len);
+#endif
+}
diff --git a/otherlibs/unix/mmap_ba.c b/otherlibs/unix/mmap_ba.c
new file mode 100644
index 00000000..bdb5c60f
--- /dev/null
+++ b/otherlibs/unix/mmap_ba.c
@@ -0,0 +1,81 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Manuel Serrano and Xavier Leroy, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2000 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
+
+#include "caml/alloc.h"
+#include "caml/bigarray.h"
+#include "caml/custom.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+
+/* Allocation of bigarrays for memory-mapped files.
+   This is the OS-independent part of [mmap.c]. */
+
+CAMLextern void caml_ba_unmap_file(void * addr, uintnat len);
+
+static void caml_ba_mapped_finalize(value v)
+{
+  struct caml_ba_array * b = Caml_ba_array_val(v);
+  CAMLassert((b->flags & CAML_BA_MANAGED_MASK) == CAML_BA_MAPPED_FILE);
+  if (b->proxy == NULL) {
+    caml_ba_unmap_file(b->data, caml_ba_byte_size(b));
+  } else {
+    if (-- b->proxy->refcount == 0) {
+      caml_ba_unmap_file(b->proxy->data, b->proxy->size);
+      free(b->proxy);
+    }
+  }
+}
+
+/* Operation table for bigarrays representing memory-mapped files.
+   Only the finalization method differs from regular bigarrays. */
+
+static struct custom_operations caml_ba_mapped_ops = {
+  "_bigarray",
+  caml_ba_mapped_finalize,
+  caml_ba_compare,
+  caml_ba_hash,
+  caml_ba_serialize,
+  caml_ba_deserialize,
+  custom_compare_ext_default,
+  custom_fixed_length_default
+};
+
+/* [caml_unix_mapped_alloc] allocates a new bigarray object in the heap
+   corresponding to a memory-mapped file. */
+
+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((flags & CAML_BA_KIND_MASK) <= CAML_BA_CHAR);
+  for (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);
+  b->data = data;
+  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];
+  return res;
+}
diff --git a/otherlibs/unix/nanosecond_stat.h b/otherlibs/unix/nanosecond_stat.h
new file mode 100644
index 00000000..6abeb57e
--- /dev/null
+++ b/otherlibs/unix/nanosecond_stat.h
@@ -0,0 +1,27 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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/nice.c b/otherlibs/unix/nice.c
new file mode 100644
index 00000000..50d46413
--- /dev/null
+++ b/otherlibs/unix/nice.c
@@ -0,0 +1,34 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+#include <errno.h>
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+
+CAMLprim value unix_nice(value incr)
+{
+  int ret;
+  errno = 0;
+#ifdef HAS_NICE
+  ret = nice(Int_val(incr));
+#else
+  ret = 0;
+#endif
+  if (ret == -1 && errno != 0) uerror("nice", Nothing);
+  return Val_int(ret);
+}
diff --git a/otherlibs/unix/open.c b/otherlibs/unix/open.c
new file mode 100644
index 00000000..cae1ce0f
--- /dev/null
+++ b/otherlibs/unix/open.c
@@ -0,0 +1,87 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/misc.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+#include <string.h>
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#include <fcntl.h>
+
+#ifndef O_NONBLOCK
+#define O_NONBLOCK O_NDELAY
+#endif
+#ifndef O_DSYNC
+#define O_DSYNC 0
+#endif
+#ifndef O_SYNC
+#define O_SYNC 0
+#endif
+#ifndef O_RSYNC
+#define O_RSYNC 0
+#endif
+
+static int open_flag_table[15] = {
+  O_RDONLY, O_WRONLY, O_RDWR, O_NONBLOCK, O_APPEND, O_CREAT, O_TRUNC, O_EXCL,
+  O_NOCTTY, O_DSYNC, O_SYNC, O_RSYNC,
+  0, /* O_SHARE_DELETE, Windows-only */
+  0, /* O_CLOEXEC, treated specially */
+  0  /* O_KEEPEXEC, treated specially */
+};
+
+enum { CLOEXEC = 1, KEEPEXEC = 2 };
+
+static int open_cloexec_table[15] = {
+  0, 0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0,
+  0,
+  CLOEXEC, KEEPEXEC
+};
+
+CAMLprim value unix_open(value path, value flags, value perm)
+{
+  CAMLparam3(path, flags, perm);
+  int fd, cv_flags, clo_flags, cloexec;
+  char * p;
+
+  caml_unix_check_path(path, "open");
+  cv_flags = caml_convert_flag_list(flags, open_flag_table);
+  clo_flags = caml_convert_flag_list(flags, open_cloexec_table);
+  if (clo_flags & CLOEXEC)
+    cloexec = 1;
+  else if (clo_flags & KEEPEXEC)
+    cloexec = 0;
+  else
+    cloexec = unix_cloexec_default;
+#if defined(O_CLOEXEC)
+  if (cloexec) cv_flags |= O_CLOEXEC;
+#endif
+  p = caml_stat_strdup(String_val(path));
+  /* open on a named FIFO can block (PR#8005) */
+  caml_enter_blocking_section();
+  fd = open(p, cv_flags, Int_val(perm));
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (fd == -1) uerror("open", path);
+#if !defined(O_CLOEXEC)
+  if (cloexec) unix_set_cloexec(fd, "open", path);
+#endif
+  CAMLreturn (Val_int(fd));
+}
diff --git a/otherlibs/unix/opendir.c b/otherlibs/unix/opendir.c
new file mode 100644
index 00000000..ead693d3
--- /dev/null
+++ b/otherlibs/unix/opendir.c
@@ -0,0 +1,45 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+#include <sys/types.h>
+#ifdef HAS_DIRENT
+#include <dirent.h>
+#else
+#include <sys/dir.h>
+#endif
+
+CAMLprim value unix_opendir(value path)
+{
+  CAMLparam1(path);
+  DIR * d;
+  value res;
+  char * p;
+
+  caml_unix_check_path(path, "opendir");
+  p = caml_stat_strdup(String_val(path));
+  caml_enter_blocking_section();
+  d = opendir(p);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (d == (DIR *) NULL) uerror("opendir", path);
+  res = caml_alloc_small(1, Abstract_tag);
+  DIR_Val(res) = d;
+  CAMLreturn(res);
+}
diff --git a/otherlibs/unix/pipe.c b/otherlibs/unix/pipe.c
new file mode 100644
index 00000000..103f826c
--- /dev/null
+++ b/otherlibs/unix/pipe.c
@@ -0,0 +1,40 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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 _GNU_SOURCE
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include "unixsupport.h"
+#include <fcntl.h>
+
+CAMLprim value unix_pipe(value cloexec, value vunit)
+{
+  int fd[2];
+  value res;
+#ifdef HAS_PIPE2
+  if (pipe2(fd, unix_cloexec_p(cloexec) ? O_CLOEXEC : 0) == -1)
+    uerror("pipe", Nothing);
+#else
+  if (pipe(fd) == -1) uerror("pipe", Nothing);
+  if (unix_cloexec_p(cloexec)) {
+    unix_set_cloexec(fd[0], "pipe", Nothing);
+    unix_set_cloexec(fd[1], "pipe", Nothing);
+  }
+#endif
+  res = caml_alloc_small(2, 0);
+  Field(res, 0) = Val_int(fd[0]);
+  Field(res, 1) = Val_int(fd[1]);
+  return res;
+}
diff --git a/otherlibs/unix/putenv.c b/otherlibs/unix/putenv.c
new file mode 100644
index 00000000..76ec1b2d
--- /dev/null
+++ b/otherlibs/unix/putenv.c
@@ -0,0 +1,55 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 1998 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
+
+#include <stdlib.h>
+#include <string.h>
+#include <errno.h>
+
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+#include <caml/osdeps.h>
+
+#include "unixsupport.h"
+
+#ifdef HAS_PUTENV
+
+CAMLprim value unix_putenv(value name, value val)
+{
+  char * s;
+  char_os * p;
+  int ret;
+
+  if (! (caml_string_is_c_safe(name) && caml_string_is_c_safe(val)))
+    unix_error(EINVAL, "putenv", name);
+  s = caml_stat_strconcat(3, name, "=", val);
+  p = caml_stat_strdup_to_os(s);
+  caml_stat_free(s);
+  ret = putenv_os(p);
+  if (ret == -1) {
+    caml_stat_free(p);
+    uerror("putenv", name);
+  }
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_putenv(value name, value val)
+{ caml_invalid_argument("putenv not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/read.c b/otherlibs/unix/read.c
new file mode 100644
index 00000000..428e49fc
--- /dev/null
+++ b/otherlibs/unix/read.c
@@ -0,0 +1,38 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_read(value fd, value buf, value ofs, value len)
+{
+  long numbytes;
+  int ret;
+  char iobuf[UNIX_BUFFER_SIZE];
+
+  Begin_root (buf);
+    numbytes = Long_val(len);
+    if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
+    caml_enter_blocking_section();
+    ret = read(Int_val(fd), iobuf, (int) numbytes);
+    caml_leave_blocking_section();
+    if (ret == -1) uerror("read", Nothing);
+    memmove (&Byte(buf, Long_val(ofs)), iobuf, ret);
+  End_roots();
+  return Val_int(ret);
+}
diff --git a/otherlibs/unix/readdir.c b/otherlibs/unix/readdir.c
new file mode 100644
index 00000000..d741fc4f
--- /dev/null
+++ b/otherlibs/unix/readdir.c
@@ -0,0 +1,42 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
+#include <caml/alloc.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+#include <errno.h>
+#include <sys/types.h>
+#ifdef HAS_DIRENT
+#include <dirent.h>
+typedef struct dirent directory_entry;
+#else
+#include <sys/dir.h>
+typedef struct direct directory_entry;
+#endif
+
+CAMLprim value unix_readdir(value vd)
+{
+  DIR * d;
+  directory_entry * e;
+  d = DIR_Val(vd);
+  if (d == (DIR *) NULL) unix_error(EBADF, "readdir", Nothing);
+  caml_enter_blocking_section();
+  e = readdir((DIR *) d);
+  caml_leave_blocking_section();
+  if (e == (directory_entry *) NULL) caml_raise_end_of_file();
+  return caml_copy_string(e->d_name);
+}
diff --git a/otherlibs/unix/readlink.c b/otherlibs/unix/readlink.c
new file mode 100644
index 00000000..05973e0e
--- /dev/null
+++ b/otherlibs/unix/readlink.c
@@ -0,0 +1,57 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/signals.h>
+
+#ifdef HAS_SYMLINK
+
+#include <sys/param.h>
+#include "unixsupport.h"
+
+#ifndef PATH_MAX
+#ifdef MAXPATHLEN
+#define PATH_MAX MAXPATHLEN
+#else
+#define PATH_MAX 512
+#endif
+#endif
+
+CAMLprim value unix_readlink(value path)
+{
+  CAMLparam1(path);
+  char buffer[PATH_MAX];
+  int len;
+  char * p;
+  caml_unix_check_path(path, "readlink");
+  p = caml_stat_strdup(String_val(path));
+  caml_enter_blocking_section();
+  len = readlink(p, buffer, sizeof(buffer) - 1);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (len == -1) uerror("readlink", path);
+  buffer[len] = '\0';
+  CAMLreturn(caml_copy_string(buffer));
+}
+
+#else
+
+CAMLprim value unix_readlink(value path)
+{ caml_invalid_argument("readlink not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/rename.c b/otherlibs/unix/rename.c
new file mode 100644
index 00000000..c31e028b
--- /dev/null
+++ b/otherlibs/unix/rename.c
@@ -0,0 +1,40 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <stdio.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_rename(value path1, value path2)
+{
+  CAMLparam2(path1, path2);
+  char * p1;
+  char * p2;
+  int ret;
+  caml_unix_check_path(path1, "rename");
+  caml_unix_check_path(path2, "rename");
+  p1 = caml_stat_strdup(String_val(path1));
+  p2 = caml_stat_strdup(String_val(path2));
+  caml_enter_blocking_section();
+  ret = rename(p1, p2);
+  caml_leave_blocking_section();
+  caml_stat_free(p2);
+  caml_stat_free(p1);
+  if (ret == -1)
+    uerror("rename", path1);
+  CAMLreturn(Val_unit);
+}
diff --git a/otherlibs/unix/rewinddir.c b/otherlibs/unix/rewinddir.c
new file mode 100644
index 00000000..e3f889f2
--- /dev/null
+++ b/otherlibs/unix/rewinddir.c
@@ -0,0 +1,42 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+#include <errno.h>
+#include <sys/types.h>
+#ifdef HAS_DIRENT
+#include <dirent.h>
+#else
+#include <sys/dir.h>
+#endif
+
+#ifdef HAS_REWINDDIR
+
+CAMLprim value unix_rewinddir(value vd)
+{
+  DIR * d = DIR_Val(vd);
+  if (d == (DIR *) NULL) unix_error(EBADF, "rewinddir", Nothing);
+  rewinddir(d);
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_rewinddir(value d)
+{ caml_invalid_argument("rewinddir not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/rmdir.c b/otherlibs/unix/rmdir.c
new file mode 100644
index 00000000..3405f193
--- /dev/null
+++ b/otherlibs/unix/rmdir.c
@@ -0,0 +1,37 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_rmdir(value path)
+{
+  CAMLparam1(path);
+  char_os * p;
+  int ret;
+  caml_unix_check_path(path, "rmdir");
+  p = caml_stat_strdup_to_os(String_val(path));
+  caml_enter_blocking_section();
+  ret = rmdir_os(p);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1) uerror("rmdir", path);
+  CAMLreturn(Val_unit);
+}
diff --git a/otherlibs/unix/select.c b/otherlibs/unix/select.c
new file mode 100644
index 00000000..aaf3ddc7
--- /dev/null
+++ b/otherlibs/unix/select.c
@@ -0,0 +1,114 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SELECT
+
+#include <sys/types.h>
+#include <sys/time.h>
+#ifdef HAS_SYS_SELECT_H
+#include <sys/select.h>
+#endif
+#include <string.h>
+#include <unistd.h>
+#include <errno.h>
+
+static int fdlist_to_fdset(value fdlist, fd_set *fdset, int *maxfd)
+{
+  value l;
+  FD_ZERO(fdset);
+  for (l = fdlist; l != Val_int(0); 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;
+    FD_SET((int) fd, fdset);
+    if (fd > *maxfd) *maxfd = fd;
+  }
+  return 0;
+}
+
+static value fdset_to_fdlist(value fdlist, fd_set *fdset)
+{
+  value l;
+  value res = Val_int(0);
+
+  Begin_roots2(l, res);
+    for (l = fdlist; l != Val_int(0); l = Field(l, 1)) {
+      int fd = Int_val(Field(l, 0));
+      if (FD_ISSET(fd, fdset)) {
+        value newres = caml_alloc_small(2, 0);
+        Field(newres, 0) = Val_int(fd);
+        Field(newres, 1) = res;
+        res = newres;
+      }
+    }
+  End_roots();
+  return res;
+}
+
+CAMLprim value unix_select(value readfds, value writefds, value exceptfds,
+                           value timeout)
+{
+  fd_set read, write, except;
+  int maxfd;
+  double tm;
+  struct timeval tv;
+  struct timeval * tvp;
+  int retcode;
+  value res;
+
+  Begin_roots3 (readfds, writefds, exceptfds);
+    maxfd = -1;
+    retcode  = fdlist_to_fdset(readfds, &read, &maxfd);
+    retcode += fdlist_to_fdset(writefds, &write, &maxfd);
+    retcode += fdlist_to_fdset(exceptfds, &except, &maxfd);
+    /* PR#5563: if a bad fd was encountered, report EINVAL error */
+    if (retcode != 0) unix_error(EINVAL, "select", Nothing);
+    tm = Double_val(timeout);
+    if (tm < 0.0)
+      tvp = (struct timeval *) NULL;
+    else {
+      tv.tv_sec = (int) tm;
+      tv.tv_usec = (int) (1e6 * (tm - tv.tv_sec));
+      tvp = &tv;
+    }
+    caml_enter_blocking_section();
+    retcode = select(maxfd + 1, &read, &write, &except, tvp);
+    caml_leave_blocking_section();
+    if (retcode == -1) uerror("select", Nothing);
+    readfds = fdset_to_fdlist(readfds, &read);
+    writefds = fdset_to_fdlist(writefds, &write);
+    exceptfds = fdset_to_fdlist(exceptfds, &except);
+    res = caml_alloc_small(3, 0);
+    Field(res, 0) = readfds;
+    Field(res, 1) = writefds;
+    Field(res, 2) = exceptfds;
+  End_roots();
+  return res;
+}
+
+#else
+
+CAMLprim value unix_select(value readfds, value writefds, value exceptfds,
+                           value timeout)
+{ caml_invalid_argument("select not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/sendrecv.c b/otherlibs/unix/sendrecv.c
new file mode 100644
index 00000000..4b8e7554
--- /dev/null
+++ b/otherlibs/unix/sendrecv.c
@@ -0,0 +1,148 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+#include "socketaddr.h"
+
+static int msg_flag_table[] = {
+  MSG_OOB, MSG_DONTROUTE, MSG_PEEK
+};
+
+CAMLprim value unix_recv(value sock, value buff, value ofs, value len,
+                         value flags)
+{
+  int ret, cv_flags;
+  long numbytes;
+  char iobuf[UNIX_BUFFER_SIZE];
+
+  cv_flags = caml_convert_flag_list(flags, msg_flag_table);
+  Begin_root (buff);
+    numbytes = Long_val(len);
+    if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
+    caml_enter_blocking_section();
+    ret = recv(Int_val(sock), iobuf, (int) numbytes, cv_flags);
+    caml_leave_blocking_section();
+    if (ret == -1) uerror("recv", Nothing);
+    memmove (&Byte(buff, Long_val(ofs)), iobuf, ret);
+  End_roots();
+  return Val_int(ret);
+}
+
+CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len,
+                             value flags)
+{
+  int ret, cv_flags;
+  long numbytes;
+  char iobuf[UNIX_BUFFER_SIZE];
+  value res;
+  value adr = Val_unit;
+  union sock_addr_union addr;
+  socklen_param_type addr_len;
+
+  cv_flags = caml_convert_flag_list(flags, msg_flag_table);
+  Begin_roots2 (buff, adr);
+    numbytes = Long_val(len);
+    if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
+    addr_len = sizeof(addr);
+    caml_enter_blocking_section();
+    ret = recvfrom(Int_val(sock), iobuf, (int) numbytes, cv_flags,
+                   &addr.s_gen, &addr_len);
+    caml_leave_blocking_section();
+    if (ret == -1) uerror("recvfrom", Nothing);
+    memmove (&Byte(buff, Long_val(ofs)), iobuf, ret);
+    adr = alloc_sockaddr(&addr, addr_len, -1);
+    res = caml_alloc_small(2, 0);
+    Field(res, 0) = Val_int(ret);
+    Field(res, 1) = adr;
+  End_roots();
+  return res;
+}
+
+CAMLprim value unix_send(value sock, value buff, value ofs, value len,
+                         value flags)
+{
+  int ret, cv_flags;
+  long numbytes;
+  char iobuf[UNIX_BUFFER_SIZE];
+
+  cv_flags = caml_convert_flag_list(flags, msg_flag_table);
+  numbytes = Long_val(len);
+  if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
+  memmove (iobuf, &Byte(buff, Long_val(ofs)), numbytes);
+  caml_enter_blocking_section();
+  ret = send(Int_val(sock), iobuf, (int) numbytes, cv_flags);
+  caml_leave_blocking_section();
+  if (ret == -1) uerror("send", Nothing);
+  return Val_int(ret);
+}
+
+CAMLprim value unix_sendto_native(value sock, value buff, value ofs, value len,
+                                  value flags, value dest)
+{
+  int ret, cv_flags;
+  long numbytes;
+  char iobuf[UNIX_BUFFER_SIZE];
+  union sock_addr_union addr;
+  socklen_param_type addr_len;
+
+  cv_flags = caml_convert_flag_list(flags, msg_flag_table);
+  get_sockaddr(dest, &addr, &addr_len);
+  numbytes = Long_val(len);
+  if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
+  memmove (iobuf, &Byte(buff, Long_val(ofs)), numbytes);
+  caml_enter_blocking_section();
+  ret = sendto(Int_val(sock), iobuf, (int) numbytes, cv_flags,
+               &addr.s_gen, addr_len);
+  caml_leave_blocking_section();
+  if (ret == -1) uerror("sendto", Nothing);
+  return Val_int(ret);
+}
+
+CAMLprim value unix_sendto(value *argv, int argc)
+{
+  return unix_sendto_native
+           (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
+}
+
+#else
+
+CAMLprim value unix_recv(value sock, value buff, value ofs, value len,
+                         value flags)
+{ caml_invalid_argument("recv not implemented"); }
+
+CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len,
+                             value flags)
+{ caml_invalid_argument("recvfrom not implemented"); }
+
+CAMLprim value unix_send(value sock, value buff, value ofs, value len,
+                         value flags)
+{ caml_invalid_argument("send not implemented"); }
+
+CAMLprim value unix_sendto_native(value sock, value buff, value ofs, value len,
+                                  value flags, value dest)
+{ caml_invalid_argument("sendto not implemented"); }
+
+CAMLprim value unix_sendto(value *argv, int argc)
+{ caml_invalid_argument("sendto not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/setgid.c b/otherlibs/unix/setgid.c
new file mode 100644
index 00000000..91d22557
--- /dev/null
+++ b/otherlibs/unix/setgid.c
@@ -0,0 +1,23 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_setgid(value gid)
+{
+  if (setgid(Int_val(gid)) == -1) uerror("setgid", Nothing);
+  return Val_unit;
+}
diff --git a/otherlibs/unix/setgroups.c b/otherlibs/unix/setgroups.c
new file mode 100644
index 00000000..6c63cce0
--- /dev/null
+++ b/otherlibs/unix/setgroups.c
@@ -0,0 +1,53 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*  Contributed by Stephane Glondu <steph@glondu.net>                     */
+/*                                                                        */
+/*   Copyright 2009 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+
+#ifdef HAS_SETGROUPS
+
+#include <sys/types.h>
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#include <limits.h>
+#include <grp.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_setgroups(value groups)
+{
+  gid_t * gidset;
+  mlsize_t size, i;
+  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));
+
+  n = setgroups(size, gidset);
+
+  caml_stat_free(gidset);
+  if (n == -1) uerror("setgroups", Nothing);
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_setgroups(value groups)
+{ caml_invalid_argument("setgroups not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/setsid.c b/otherlibs/unix/setsid.c
new file mode 100644
index 00000000..b4449e67
--- /dev/null
+++ b/otherlibs/unix/setsid.c
@@ -0,0 +1,31 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 1997 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+
+CAMLprim value unix_setsid(value unit)
+{
+#ifdef HAS_SETSID
+  return Val_int(setsid());
+#else
+  caml_invalid_argument("setsid not implemented");
+  return Val_unit;
+#endif
+}
diff --git a/otherlibs/unix/setuid.c b/otherlibs/unix/setuid.c
new file mode 100644
index 00000000..978dd9eb
--- /dev/null
+++ b/otherlibs/unix/setuid.c
@@ -0,0 +1,23 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_setuid(value uid)
+{
+  if (setuid(Int_val(uid)) == -1) uerror("setuid", Nothing);
+  return Val_unit;
+}
diff --git a/otherlibs/unix/shutdown.c b/otherlibs/unix/shutdown.c
new file mode 100644
index 00000000..6c0edd37
--- /dev/null
+++ b/otherlibs/unix/shutdown.c
@@ -0,0 +1,40 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#include <sys/socket.h>
+
+static int shutdown_command_table[] = {
+  0, 1, 2
+};
+
+CAMLprim value unix_shutdown(value sock, value cmd)
+{
+  if (shutdown(Int_val(sock), shutdown_command_table[Int_val(cmd)]) == -1)
+    uerror("shutdown", Nothing);
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_shutdown(value sock, value cmd)
+{ caml_invalid_argument("shutdown not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/signals.c b/otherlibs/unix/signals.c
new file mode 100644
index 00000000..ff59a726
--- /dev/null
+++ b/otherlibs/unix/signals.c
@@ -0,0 +1,112 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 1998 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
+
+#include <errno.h>
+#include <signal.h>
+
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#ifndef NSIG
+#define NSIG 64
+#endif
+
+#ifdef POSIX_SIGNALS
+
+static void decode_sigset(value vset, sigset_t * set)
+{
+  sigemptyset(set);
+  while (vset != Val_int(0)) {
+    int sig = caml_convert_signal_number(Int_val(Field(vset, 0)));
+    sigaddset(set, sig);
+    vset = Field(vset, 1);
+  }
+}
+
+static value encode_sigset(sigset_t * set)
+{
+  value res = Val_int(0);
+  int i;
+
+  Begin_root(res)
+    for (i = 1; i < NSIG; i++)
+      if (sigismember(set, i) > 0) {
+        value newcons = caml_alloc_small(2, 0);
+        Field(newcons, 0) = Val_int(caml_rev_convert_signal_number(i));
+        Field(newcons, 1) = res;
+        res = newcons;
+      }
+  End_roots();
+  return res;
+}
+
+static int sigprocmask_cmd[3] = { SIG_SETMASK, SIG_BLOCK, SIG_UNBLOCK };
+
+CAMLprim value unix_sigprocmask(value vaction, value vset)
+{
+  int how;
+  sigset_t set, oldset;
+  int retcode;
+
+  how = sigprocmask_cmd[Int_val(vaction)];
+  decode_sigset(vset, &set);
+  caml_enter_blocking_section();
+  retcode = caml_sigmask_hook(how, &set, &oldset);
+  caml_leave_blocking_section();
+  if (retcode != 0) unix_error(retcode, "sigprocmask", Nothing);
+  return encode_sigset(&oldset);
+}
+
+CAMLprim value unix_sigpending(value unit)
+{
+  sigset_t pending;
+  int i;
+  if (sigpending(&pending) == -1) uerror("sigpending", Nothing);
+  for (i = 1; i < NSIG; i++)
+    if(caml_pending_signals[i])
+      sigaddset(&pending, i);
+  return encode_sigset(&pending);
+}
+
+CAMLprim value unix_sigsuspend(value vset)
+{
+  sigset_t set;
+  int retcode;
+  decode_sigset(vset, &set);
+  caml_enter_blocking_section();
+  retcode = sigsuspend(&set);
+  caml_leave_blocking_section();
+  if (retcode == -1 && errno != EINTR) uerror("sigsuspend", Nothing);
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_sigprocmask(value vaction, value vset)
+{ caml_invalid_argument("Unix.sigprocmask not available"); }
+
+CAMLprim value unix_sigpending(value unit)
+{ caml_invalid_argument("Unix.sigpending not available"); }
+
+CAMLprim value unix_sigsuspend(value vset)
+{ caml_invalid_argument("Unix.sigsuspend not available"); }
+
+#endif
diff --git a/otherlibs/unix/sleep.c b/otherlibs/unix/sleep.c
new file mode 100644
index 00000000..bada9ae7
--- /dev/null
+++ b/otherlibs/unix/sleep.c
@@ -0,0 +1,76 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#include <errno.h>
+#include <time.h>
+#ifdef HAS_SELECT
+#include <sys/types.h>
+#include <sys/time.h>
+#ifdef HAS_SYS_SELECT_H
+#include <sys/select.h>
+#endif
+#endif
+
+CAMLprim value unix_sleep(value duration)
+{
+  double d = Double_val(duration);
+  if (d < 0.0) return Val_unit;
+#if defined(HAS_NANOSLEEP)
+  {
+    struct timespec t;
+    int ret;
+    t.tv_sec = (time_t) d;
+    t.tv_nsec = (d - t.tv_sec) * 1e9;
+    do {
+      caml_enter_blocking_section();
+      ret = nanosleep(&t, &t);
+      /* MPR#7903: if we were interrupted by a signal, and this signal
+         is handled in OCaml, we should run its handler now,
+         not at the end of the full sleep duration.  Leaving the blocking
+         section and re-entering it does the job. */
+      caml_leave_blocking_section();
+    } while (ret == -1 && errno == EINTR);
+    if (ret == -1) uerror("sleep", Nothing);
+  }
+#elif defined(HAS_SELECT)
+  {
+    struct timeval t;
+    int ret;
+    t.tv_sec = (time_t) d;
+    t.tv_usec = (d - t.tv_sec) * 1e6;
+    do {
+      caml_enter_blocking_section();
+      ret = select(0, NULL, NULL, NULL, &t);
+      /* MPR#7903: same comment as above */
+      caml_leave_blocking_section();
+    } while (ret == -1 && errno == EINTR);
+    if (ret == -1) uerror("sleep", Nothing);
+  }
+#else
+  /* Fallback implementation, resolution 1 second only.
+     We cannot reliably iterate until sleep() returns 0, because the
+     remaining time returned by sleep() is generally rounded up. */
+  {
+    caml_enter_blocking_section();
+    sleep ((unsigned int) d);
+    caml_leave_blocking_section();
+  }
+#endif
+  return Val_unit;
+}
diff --git a/otherlibs/unix/socket.c b/otherlibs/unix/socket.c
new file mode 100644
index 00000000..5166ed13
--- /dev/null
+++ b/otherlibs/unix/socket.c
@@ -0,0 +1,65 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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 _GNU_SOURCE
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#include <sys/types.h>
+#include <sys/socket.h>
+
+int socket_domain_table[] = {
+  PF_UNIX, PF_INET,
+#if defined(HAS_IPV6)
+  PF_INET6
+#elif defined(PF_UNDEF)
+  PF_UNDEF
+#else
+  0
+#endif
+};
+
+int socket_type_table[] = {
+  SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, SOCK_SEQPACKET
+};
+
+CAMLprim value unix_socket(value cloexec, value domain,
+                           value type, value proto)
+{
+  int retcode;
+  int ty = socket_type_table[Int_val(type)];
+#ifdef SOCK_CLOEXEC
+  if (unix_cloexec_p(cloexec)) ty |= SOCK_CLOEXEC;
+#endif
+  retcode = socket(socket_domain_table[Int_val(domain)],
+                   ty, Int_val(proto));
+  if (retcode == -1) uerror("socket", Nothing);
+#ifndef SOCK_CLOEXEC
+  if (unix_cloexec_p(cloexec))
+    unix_set_cloexec(retcode, "socket", Nothing);
+#endif
+  return Val_int(retcode);
+}
+
+#else
+
+CAMLprim value unix_socket(value cloexec, value domain,
+                           value type,value proto)
+{ caml_invalid_argument("socket not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/socketaddr.c b/otherlibs/unix/socketaddr.c
new file mode 100644
index 00000000..3e053246
--- /dev/null
+++ b/otherlibs/unix/socketaddr.c
@@ -0,0 +1,178 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <errno.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+
+#ifdef _WIN32
+#undef EAFNOSUPPORT
+#define EAFNOSUPPORT WSAEAFNOSUPPORT
+#endif
+
+CAMLexport value alloc_inet_addr(struct in_addr * a)
+{
+  value res;
+  /* Use a string rather than an abstract block so that it can be
+     marshaled safely.  Remember that a is in network byte order,
+     hence is marshaled in an endian-independent manner. */
+  res = caml_alloc_initialized_string(4, (char *)a);
+  return res;
+}
+
+#ifdef HAS_IPV6
+
+CAMLexport value alloc_inet6_addr(struct in6_addr * a)
+{
+  value res;
+  res = caml_alloc_initialized_string(16, (char *)a);
+  return res;
+}
+
+#endif
+
+void get_sockaddr(value mladr,
+                  union sock_addr_union * adr /*out*/,
+                  socklen_param_type * adr_len /*out*/)
+{
+  switch(Tag_val(mladr)) {
+#ifndef _WIN32
+  case 0:                       /* ADDR_UNIX */
+    { value path;
+      mlsize_t len;
+      path = Field(mladr, 0);
+      len = caml_string_length(path);
+      adr->s_unix.sun_family = AF_UNIX;
+      if (len >= sizeof(adr->s_unix.sun_path)) {
+        unix_error(ENAMETOOLONG, "", path);
+      }
+      /* "Abstract" sockets in Linux have names starting with '\0' */
+      if (Byte(path, 0) != 0 && ! caml_string_is_c_safe(path)) {
+        unix_error(ENOENT, "", path);
+      }
+      memmove (adr->s_unix.sun_path, String_val(path), len + 1);
+      *adr_len =
+        ((char *)&(adr->s_unix.sun_path) - (char *)&(adr->s_unix))
+        + len;
+      break;
+    }
+#endif
+  case 1:                       /* ADDR_INET */
+#ifdef HAS_IPV6
+    if (caml_string_length(Field(mladr, 0)) == 16) {
+      memset(&adr->s_inet6, 0, sizeof(struct sockaddr_in6));
+      adr->s_inet6.sin6_family = AF_INET6;
+      adr->s_inet6.sin6_addr = GET_INET6_ADDR(Field(mladr, 0));
+      adr->s_inet6.sin6_port = htons(Int_val(Field(mladr, 1)));
+#ifdef SIN6_LEN
+      adr->s_inet6.sin6_len = sizeof(struct sockaddr_in6);
+#endif
+      *adr_len = sizeof(struct sockaddr_in6);
+      break;
+    }
+#endif
+    memset(&adr->s_inet, 0, sizeof(struct sockaddr_in));
+    adr->s_inet.sin_family = AF_INET;
+    adr->s_inet.sin_addr = GET_INET_ADDR(Field(mladr, 0));
+    adr->s_inet.sin_port = htons(Int_val(Field(mladr, 1)));
+#ifdef SIN6_LEN
+    adr->s_inet.sin_len = sizeof(struct sockaddr_in);
+#endif
+    *adr_len = sizeof(struct sockaddr_in);
+    break;
+  }
+}
+
+value alloc_unix_sockaddr(value path) {
+  CAMLparam1(path);
+  CAMLlocal1(res);
+  res = caml_alloc_small(1, 0);
+  Field(res,0) = path;
+  CAMLreturn(res);
+}
+
+value alloc_sockaddr(union sock_addr_union * adr /*in*/,
+                     socklen_param_type adr_len, int close_on_error)
+{
+  value res;
+#ifndef _WIN32
+  if (adr_len < offsetof(struct sockaddr, sa_data)) {
+    // Only possible for an unnamed AF_UNIX socket, in
+    // which case sa_family might be uninitialized.
+    return alloc_unix_sockaddr(caml_alloc_string(0));
+  }
+#endif
+
+  switch(adr->s_gen.sa_family) {
+#ifndef _WIN32
+  case AF_UNIX:
+    { /* Based on recommendation in section BUGS of Linux unix(7). See
+         http://man7.org/linux/man-pages/man7/unix.7.html. */
+      mlsize_t struct_offset = offsetof(struct sockaddr_un, sun_path);
+      mlsize_t path_length = 0;
+      if (adr_len > struct_offset) {
+        path_length = adr_len - struct_offset;
+
+        /* paths _may_ be null-terminated, but Linux abstract sockets
+         * start with a null, and may contain internal nulls. */
+        path_length = (
+#ifdef __linux__
+          (adr->s_unix.sun_path[0] == '\0') ? path_length :
+#endif
+          strnlen(adr->s_unix.sun_path, path_length)
+        );
+      }
+
+      res = alloc_unix_sockaddr(
+        caml_alloc_initialized_string(path_length, (char *)adr->s_unix.sun_path)
+      );
+      break;
+    }
+#endif
+  case AF_INET:
+    { value a = alloc_inet_addr(&adr->s_inet.sin_addr);
+      Begin_root (a);
+        res = caml_alloc_small(2, 1);
+        Field(res,0) = a;
+        Field(res,1) = Val_int(ntohs(adr->s_inet.sin_port));
+      End_roots();
+      break;
+    }
+#ifdef HAS_IPV6
+  case AF_INET6:
+    { value a = alloc_inet6_addr(&adr->s_inet6.sin6_addr);
+      Begin_root (a);
+        res = caml_alloc_small(2, 1);
+        Field(res,0) = a;
+        Field(res,1) = Val_int(ntohs(adr->s_inet6.sin6_port));
+      End_roots();
+      break;
+    }
+#endif
+  default:
+    if (close_on_error != -1) close (close_on_error);
+    unix_error(EAFNOSUPPORT, "", Nothing);
+  }
+  return res;
+}
+
+#endif
diff --git a/otherlibs/unix/socketaddr.h b/otherlibs/unix/socketaddr.h
new file mode 100644
index 00000000..4c80d25d
--- /dev/null
+++ b/otherlibs/unix/socketaddr.h
@@ -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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_SOCKETADDR_H
+#define CAML_SOCKETADDR_H
+
+#include "caml/misc.h"
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <sys/un.h>
+#include <netinet/in.h>
+#include <arpa/inet.h>
+
+union sock_addr_union {
+  struct sockaddr s_gen;
+  struct sockaddr_un s_unix;
+  struct sockaddr_in s_inet;
+#ifdef HAS_IPV6
+  struct sockaddr_in6 s_inet6;
+#endif
+};
+
+#ifdef HAS_SOCKLEN_T
+typedef socklen_t socklen_param_type;
+#else
+typedef int socklen_param_type;
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern void get_sockaddr (value mladdr,
+                          union sock_addr_union * addr /*out*/,
+                          socklen_param_type * addr_len /*out*/);
+CAMLexport value alloc_sockaddr (union sock_addr_union * addr /*in*/,
+                      socklen_param_type addr_len, int close_on_error);
+CAMLexport value alloc_inet_addr (struct in_addr * inaddr);
+#define GET_INET_ADDR(v) (*((struct in_addr *) (v)))
+
+#ifdef HAS_IPV6
+CAMLexport value alloc_inet6_addr (struct in6_addr * inaddr);
+#define GET_INET6_ADDR(v) (*((struct in6_addr *) (v)))
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_SOCKETADDR_H */
diff --git a/otherlibs/unix/socketpair.c b/otherlibs/unix/socketpair.c
new file mode 100644
index 00000000..15cc82b2
--- /dev/null
+++ b/otherlibs/unix/socketpair.c
@@ -0,0 +1,56 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#include <sys/socket.h>
+
+extern int socket_domain_table[], socket_type_table[];
+
+CAMLprim value unix_socketpair(value cloexec, value domain,
+                               value type, value proto)
+{
+  int sv[2];
+  value res;
+  int ty = socket_type_table[Int_val(type)];
+#ifdef SOCK_CLOEXEC
+  if (unix_cloexec_p(cloexec)) ty |= SOCK_CLOEXEC;
+#endif
+  if (socketpair(socket_domain_table[Int_val(domain)],
+                 ty, Int_val(proto), sv) == -1)
+    uerror("socketpair", Nothing);
+#ifndef SOCK_CLOEXEC
+  if (unix_cloexec_p(cloexec)) {
+    unix_set_cloexec(sv[0], "socketpair", Nothing);
+    unix_set_cloexec(sv[1], "socketpair", Nothing);
+  }
+#endif
+  res = caml_alloc_small(2, 0);
+  Field(res,0) = Val_int(sv[0]);
+  Field(res,1) = Val_int(sv[1]);
+  return res;
+}
+
+#else
+
+CAMLprim value unix_socketpair(value domain, value type, value proto)
+{ caml_invalid_argument("socketpair not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/sockopt.c b/otherlibs/unix/sockopt.c
new file mode 100644
index 00000000..d2961d09
--- /dev/null
+++ b/otherlibs/unix/sockopt.c
@@ -0,0 +1,301 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#include <errno.h>
+#include <sys/time.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/tcp.h>
+
+#include "socketaddr.h"
+
+#ifndef SO_DEBUG
+#define SO_DEBUG (-1)
+#endif
+#ifndef SO_BROADCAST
+#define SO_BROADCAST (-1)
+#endif
+#ifndef SO_REUSEADDR
+#define SO_REUSEADDR (-1)
+#endif
+#ifndef SO_KEEPALIVE
+#define SO_KEEPALIVE (-1)
+#endif
+#ifndef SO_DONTROUTE
+#define SO_DONTROUTE (-1)
+#endif
+#ifndef SO_OOBINLINE
+#define SO_OOBINLINE (-1)
+#endif
+#ifndef SO_ACCEPTCONN
+#define SO_ACCEPTCONN (-1)
+#endif
+#ifndef SO_SNDBUF
+#define SO_SNDBUF (-1)
+#endif
+#ifndef SO_RCVBUF
+#define SO_RCVBUF (-1)
+#endif
+#ifndef SO_ERROR
+#define SO_ERROR (-1)
+#endif
+#ifndef SO_TYPE
+#define SO_TYPE (-1)
+#endif
+#ifndef SO_RCVLOWAT
+#define SO_RCVLOWAT (-1)
+#endif
+#ifndef SO_SNDLOWAT
+#define SO_SNDLOWAT (-1)
+#endif
+#ifndef SO_LINGER
+#define SO_LINGER (-1)
+#endif
+#ifndef SO_RCVTIMEO
+#define SO_RCVTIMEO (-1)
+#endif
+#ifndef SO_SNDTIMEO
+#define SO_SNDTIMEO (-1)
+#endif
+#ifndef TCP_NODELAY
+#define TCP_NODELAY (-1)
+#endif
+#ifndef SO_ERROR
+#define SO_ERROR (-1)
+#endif
+#ifndef IPPROTO_IPV6
+#define IPPROTO_IPV6 (-1)
+#endif
+#ifndef IPV6_V6ONLY
+#define IPV6_V6ONLY (-1)
+#endif
+
+enum option_type {
+  TYPE_BOOL = 0,
+  TYPE_INT = 1,
+  TYPE_LINGER = 2,
+  TYPE_TIMEVAL = 3,
+  TYPE_UNIX_ERROR = 4
+};
+
+struct socket_option {
+  int level;
+  int option;
+};
+
+/* Table of options, indexed by type */
+
+static struct socket_option sockopt_bool[] = {
+  { SOL_SOCKET, SO_DEBUG },
+  { SOL_SOCKET, SO_BROADCAST },
+  { SOL_SOCKET, SO_REUSEADDR },
+  { SOL_SOCKET, SO_KEEPALIVE },
+  { SOL_SOCKET, SO_DONTROUTE },
+  { SOL_SOCKET, SO_OOBINLINE },
+  { SOL_SOCKET, SO_ACCEPTCONN },
+  { IPPROTO_TCP, TCP_NODELAY },
+  { IPPROTO_IPV6, IPV6_V6ONLY}
+};
+
+static struct socket_option sockopt_int[] = {
+  { SOL_SOCKET, SO_SNDBUF },
+  { SOL_SOCKET, SO_RCVBUF },
+  { SOL_SOCKET, SO_ERROR },
+  { SOL_SOCKET, SO_TYPE },
+  { SOL_SOCKET, SO_RCVLOWAT },
+  { SOL_SOCKET, SO_SNDLOWAT } };
+
+static struct socket_option sockopt_linger[] = {
+  { SOL_SOCKET, SO_LINGER }
+};
+
+static struct socket_option sockopt_timeval[] = {
+  { SOL_SOCKET, SO_RCVTIMEO },
+  { SOL_SOCKET, SO_SNDTIMEO }
+};
+
+static struct socket_option sockopt_unix_error[] = {
+  { SOL_SOCKET, SO_ERROR }
+};
+
+static struct socket_option * sockopt_table[] = {
+  sockopt_bool,
+  sockopt_int,
+  sockopt_linger,
+  sockopt_timeval,
+  sockopt_unix_error
+};
+
+static char * getsockopt_fun_name[] = {
+  "getsockopt",
+  "getsockopt_int",
+  "getsockopt_optint",
+  "getsockopt_float",
+  "getsockopt_error"
+};
+
+static char * setsockopt_fun_name[] = {
+  "setsockopt",
+  "setsockopt_int",
+  "setsockopt_optint",
+  "setsockopt_float",
+  "setsockopt_error"
+};
+
+union option_value {
+  int i;
+  struct linger lg;
+  struct timeval tv;
+};
+
+CAMLexport value
+unix_getsockopt_aux(char * name,
+                    enum option_type ty, int level, int option,
+                    value socket)
+{
+  union option_value optval;
+  socklen_param_type optsize;
+
+
+  switch (ty) {
+  case TYPE_BOOL:
+  case TYPE_INT:
+  case TYPE_UNIX_ERROR:
+    optsize = sizeof(optval.i); break;
+  case TYPE_LINGER:
+    optsize = sizeof(optval.lg); break;
+  case TYPE_TIMEVAL:
+    optsize = sizeof(optval.tv); break;
+  default:
+    unix_error(EINVAL, name, Nothing);
+  }
+
+  if (getsockopt(Int_val(socket), level, option,
+                 (void *) &optval, &optsize) == -1)
+    uerror(name, Nothing);
+
+  switch (ty) {
+  case TYPE_BOOL:
+    return Val_bool(optval.i);
+  case TYPE_INT:
+    return Val_int(optval.i);
+  case TYPE_LINGER:
+    if (optval.lg.l_onoff == 0) {
+      return Val_int(0);        /* None */
+    } else {
+      value res = caml_alloc_small(1, 0); /* Some */
+      Field(res, 0) = Val_int(optval.lg.l_linger);
+      return res;
+    }
+  case TYPE_TIMEVAL:
+    return caml_copy_double((double) optval.tv.tv_sec
+                       + (double) optval.tv.tv_usec / 1e6);
+  case TYPE_UNIX_ERROR:
+    if (optval.i == 0) {
+      return Val_int(0);        /* None */
+    } else {
+      value err, res;
+      err = unix_error_of_code(optval.i);
+      Begin_root(err);
+        res = caml_alloc_small(1, 0); /* Some */
+        Field(res, 0) = err;
+      End_roots();
+      return res;
+    }
+  default:
+    unix_error(EINVAL, name, Nothing);
+  }
+}
+
+CAMLexport value
+unix_setsockopt_aux(char * name,
+                    enum option_type ty, int level, int option,
+                    value socket, value val)
+{
+  union option_value optval;
+  socklen_param_type optsize;
+  double f;
+
+  switch (ty) {
+  case TYPE_BOOL:
+  case TYPE_INT:
+    optsize = sizeof(optval.i);
+    optval.i = Int_val(val);
+    break;
+  case TYPE_LINGER:
+    optsize = sizeof(optval.lg);
+    optval.lg.l_onoff = Is_block (val);
+    if (optval.lg.l_onoff)
+      optval.lg.l_linger = Int_val (Field (val, 0));
+    break;
+  case TYPE_TIMEVAL:
+    f = Double_val(val);
+    optsize = sizeof(optval.tv);
+    optval.tv.tv_sec = (int) f;
+    optval.tv.tv_usec = (int) (1e6 * (f - optval.tv.tv_sec));
+    break;
+  case TYPE_UNIX_ERROR:
+  default:
+    unix_error(EINVAL, name, Nothing);
+  }
+
+  if (setsockopt(Int_val(socket), level, option,
+                 (void *) &optval, optsize) == -1)
+    uerror(name, Nothing);
+
+  return Val_unit;
+}
+
+CAMLprim value 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)]);
+  return unix_getsockopt_aux(getsockopt_fun_name[ty],
+                             ty,
+                             opt->level,
+                             opt->option,
+                             vsocket);
+}
+
+CAMLprim value 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)]);
+  return unix_setsockopt_aux(setsockopt_fun_name[ty],
+                             ty,
+                             opt->level,
+                             opt->option,
+                             vsocket,
+                             val);
+}
+
+#else
+
+CAMLprim value unix_getsockopt(value vty, value socket, value option)
+{ caml_invalid_argument("getsockopt not implemented"); }
+
+CAMLprim value unix_setsockopt(value vty, value socket, value option, value val)
+{ caml_invalid_argument("setsockopt not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/stat.c b/otherlibs/unix/stat.c
new file mode 100644
index 00000000..69ad96ea
--- /dev/null
+++ b/otherlibs/unix/stat.c
@@ -0,0 +1,198 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <errno.h>
+#include <math.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/signals.h>
+#include <caml/io.h>
+#include "unixsupport.h"
+#include "cst2constr.h"
+
+#ifndef S_IFLNK
+#define S_IFLNK 0
+#endif
+#ifndef S_IFIFO
+#define S_IFIFO 0
+#endif
+#ifndef S_IFSOCK
+#define S_IFSOCK 0
+#endif
+#ifndef S_IFBLK
+#define S_IFBLK 0
+#endif
+
+#ifndef EOVERFLOW
+#define EOVERFLOW ERANGE
+#endif
+
+static int file_kind_table[] = {
+  S_IFREG, S_IFDIR, S_IFCHR, S_IFBLK, S_IFLNK, S_IFIFO, S_IFSOCK
+};
+
+/* Transform a (seconds, nanoseconds) time stamp (in the style of
+   struct timespec) to a number of seconds in floating-point.
+   Make sure the integer part of the result is always equal to [seconds]
+   (issue #9490). */
+
+static double stat_timestamp(time_t sec, long nsec)
+{
+  /* The conversion of sec to FP is exact for the foreseeable future.
+     (It starts rounding when sec > 2^53, i.e. in 285 million years.) */
+  double s = (double) sec;
+  /* The conversion of nsec to fraction of seconds can round.
+     Still, we have 0 <= n < 1.0. */
+  double n = (double) nsec / 1e9;
+  /* The sum s + n can round up, hence s <= t + <= s + 1.0 */
+  double t = s + n;
+  /* Detect the "round up to s + 1" case and decrease t so that
+     its integer part is s. */
+  if (t == s + 1.0) t = nextafter(t, s);
+  return t;
+}
+
+static value stat_aux(int use_64, struct stat *buf)
+{
+  CAMLparam0();
+  CAMLlocal5(atime, mtime, ctime, offset, v);
+
+  #include "nanosecond_stat.h"
+  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
+  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);
+  Field (v, 1) = Val_int (buf->st_ino);
+  Field (v, 2) = cst_to_constr(buf->st_mode & S_IFMT, file_kind_table,
+                               sizeof(file_kind_table) / sizeof(int), 0);
+  Field (v, 3) = Val_int (buf->st_mode & 07777);
+  Field (v, 4) = Val_int (buf->st_nlink);
+  Field (v, 5) = Val_int (buf->st_uid);
+  Field (v, 6) = Val_int (buf->st_gid);
+  Field (v, 7) = Val_int (buf->st_rdev);
+  Field (v, 8) = offset;
+  Field (v, 9) = atime;
+  Field (v, 10) = mtime;
+  Field (v, 11) = ctime;
+  CAMLreturn(v);
+}
+
+CAMLprim value unix_stat(value path)
+{
+  CAMLparam1(path);
+  int ret;
+  struct stat buf;
+  char * p;
+  caml_unix_check_path(path, "stat");
+  p = caml_stat_strdup(String_val(path));
+  caml_enter_blocking_section();
+  ret = stat(p, &buf);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1) uerror("stat", path);
+  if (buf.st_size > Max_long && (buf.st_mode & S_IFMT) == S_IFREG)
+    unix_error(EOVERFLOW, "stat", path);
+  CAMLreturn(stat_aux(0, &buf));
+}
+
+CAMLprim value unix_lstat(value path)
+{
+  CAMLparam1(path);
+  int ret;
+  struct stat buf;
+  char * p;
+  caml_unix_check_path(path, "lstat");
+  p = caml_stat_strdup(String_val(path));
+  caml_enter_blocking_section();
+#ifdef HAS_SYMLINK
+  ret = lstat(p, &buf);
+#else
+  ret = stat(p, &buf);
+#endif
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1) uerror("lstat", path);
+  if (buf.st_size > Max_long && (buf.st_mode & S_IFMT) == S_IFREG)
+    unix_error(EOVERFLOW, "lstat", path);
+  CAMLreturn(stat_aux(0, &buf));
+}
+
+CAMLprim value unix_fstat(value fd)
+{
+  int ret;
+  struct stat buf;
+  caml_enter_blocking_section();
+  ret = fstat(Int_val(fd), &buf);
+  caml_leave_blocking_section();
+  if (ret == -1) uerror("fstat", Nothing);
+  if (buf.st_size > Max_long && (buf.st_mode & S_IFMT) == S_IFREG)
+    unix_error(EOVERFLOW, "fstat", Nothing);
+  return stat_aux(0, &buf);
+}
+
+CAMLprim value unix_stat_64(value path)
+{
+  CAMLparam1(path);
+  int ret;
+  struct stat buf;
+  char * p;
+  caml_unix_check_path(path, "stat");
+  p = caml_stat_strdup(String_val(path));
+  caml_enter_blocking_section();
+  ret = stat(p, &buf);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1) uerror("stat", path);
+  CAMLreturn(stat_aux(1, &buf));
+}
+
+CAMLprim value unix_lstat_64(value path)
+{
+  CAMLparam1(path);
+  int ret;
+  struct stat buf;
+  char * p;
+  caml_unix_check_path(path, "lstat");
+  p = caml_stat_strdup(String_val(path));
+  caml_enter_blocking_section();
+#ifdef HAS_SYMLINK
+  ret = lstat(p, &buf);
+#else
+  ret = stat(p, &buf);
+#endif
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1) uerror("lstat", path);
+  CAMLreturn(stat_aux(1, &buf));
+}
+
+CAMLprim value unix_fstat_64(value fd)
+{
+  int ret;
+  struct stat buf;
+  caml_enter_blocking_section();
+  ret = fstat(Int_val(fd), &buf);
+  caml_leave_blocking_section();
+  if (ret == -1) uerror("fstat", Nothing);
+  return stat_aux(1, &buf);
+}
diff --git a/otherlibs/unix/strofaddr.c b/otherlibs/unix/strofaddr.c
new file mode 100644
index 00000000..45675ad0
--- /dev/null
+++ b/otherlibs/unix/strofaddr.c
@@ -0,0 +1,74 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+
+CAMLprim value unix_string_of_inet_addr(value a)
+{
+  char * res;
+#ifdef HAS_IPV6
+#ifdef _WIN32
+  char buffer[64];
+  union sock_addr_union sa;
+  int len;
+  int retcode;
+  if (caml_string_length(a) == 16) {
+    memset(&sa.s_inet6, 0, sizeof(struct sockaddr_in6));
+    sa.s_inet6.sin6_family = AF_INET6;
+    sa.s_inet6.sin6_addr = GET_INET6_ADDR(a);
+    len = sizeof(struct sockaddr_in6);
+  } else {
+    memset(&sa.s_inet, 0, sizeof(struct sockaddr_in));
+    sa.s_inet.sin_family = AF_INET;
+    sa.s_inet.sin_addr = GET_INET_ADDR(a);
+    len = sizeof(struct sockaddr_in);
+  }
+  retcode = getnameinfo
+    (&sa.s_gen, len, buffer, sizeof(buffer), NULL, 0, NI_NUMERICHOST);
+  if (retcode != 0)
+    res = NULL;
+  else
+    res = buffer;
+#else
+  char buffer[64];
+  if (caml_string_length(a) == 16)
+    res = (char *)
+      inet_ntop(AF_INET6, (const void *) &GET_INET6_ADDR(a),
+                buffer, sizeof(buffer));
+  else
+    res = (char *)
+      inet_ntop(AF_INET, (const void *) &GET_INET_ADDR(a),
+                buffer, sizeof(buffer));
+#endif
+#else
+  res = inet_ntoa(GET_INET_ADDR(a));
+#endif
+  if (res == NULL) uerror("string_of_inet_addr", Nothing);
+  return caml_copy_string(res);
+}
+
+#else
+
+CAMLprim value unix_string_of_inet_addr(value a)
+{ caml_invalid_argument("string_of_inet_addr not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/symlink.c b/otherlibs/unix/symlink.c
new file mode 100644
index 00000000..bbf3cfcb
--- /dev/null
+++ b/otherlibs/unix/symlink.c
@@ -0,0 +1,61 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#ifdef HAS_SYMLINK
+
+CAMLprim value unix_symlink(value to_dir, value path1, value path2)
+{
+  CAMLparam3(to_dir, path1, path2);
+  char * p1;
+  char * p2;
+  int ret;
+  caml_unix_check_path(path1, "symlink");
+  caml_unix_check_path(path2, "symlink");
+  p1 = caml_stat_strdup(String_val(path1));
+  p2 = caml_stat_strdup(String_val(path2));
+  caml_enter_blocking_section();
+  ret = symlink(p1, p2);
+  caml_leave_blocking_section();
+  caml_stat_free(p1);
+  caml_stat_free(p2);
+  if (ret == -1)
+    uerror("symlink", path2);
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value unix_has_symlink(value unit)
+{
+  CAMLparam0();
+  CAMLreturn(Val_true);
+}
+
+#else
+
+CAMLprim value unix_symlink(value to_dir, value path1, value path2)
+{ caml_invalid_argument("symlink not implemented"); }
+
+CAMLprim value unix_has_symlink(value unit)
+{
+  CAMLparam0();
+  CAMLreturn(Val_false);
+}
+
+#endif
diff --git a/otherlibs/unix/termios.c b/otherlibs/unix/termios.c
new file mode 100644
index 00000000..b6a221ff
--- /dev/null
+++ b/otherlibs/unix/termios.c
@@ -0,0 +1,387 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include "unixsupport.h"
+
+#ifdef HAS_TERMIOS
+
+#include <termios.h>
+#include <errno.h>
+
+static struct termios terminal_status;
+
+enum { Bool, Enum, Speed, Char, End };
+
+enum { Input, Output };
+
+#define iflags ((long)(&terminal_status.c_iflag))
+#define oflags ((long)(&terminal_status.c_oflag))
+#define cflags ((long)(&terminal_status.c_cflag))
+#define lflags ((long)(&terminal_status.c_lflag))
+
+/* Number of fields in the terminal_io record field. Cf. unix.mli */
+
+#define NFIELDS 38
+
+/* Structure of the terminal_io record. Cf. unix.mli */
+
+static long terminal_io_descr[] = {
+  /* Input modes */
+  Bool, iflags, IGNBRK,
+  Bool, iflags, BRKINT,
+  Bool, iflags, IGNPAR,
+  Bool, iflags, PARMRK,
+  Bool, iflags, INPCK,
+  Bool, iflags, ISTRIP,
+  Bool, iflags, INLCR,
+  Bool, iflags, IGNCR,
+  Bool, iflags, ICRNL,
+  Bool, iflags, IXON,
+  Bool, iflags, IXOFF,
+  /* Output modes */
+  Bool, oflags, OPOST,
+  /* Control modes */
+  Speed, Output,
+  Speed, Input,
+  Enum, cflags, 5, 4, CSIZE, CS5, CS6, CS7, CS8,
+  Enum, cflags, 1, 2, CSTOPB, 0, CSTOPB,
+  Bool, cflags, CREAD,
+  Bool, cflags, PARENB,
+  Bool, cflags, PARODD,
+  Bool, cflags, HUPCL,
+  Bool, cflags, CLOCAL,
+  /* Local modes */
+  Bool, lflags, ISIG,
+  Bool, lflags, ICANON,
+  Bool, lflags, NOFLSH,
+  Bool, lflags, ECHO,
+  Bool, lflags, ECHOE,
+  Bool, lflags, ECHOK,
+  Bool, lflags, ECHONL,
+  /* Control characters */
+  Char, VINTR,
+  Char, VQUIT,
+  Char, VERASE,
+  Char, VKILL,
+  Char, VEOF,
+  Char, VEOL,
+  Char, VMIN,
+  Char, VTIME,
+  Char, VSTART,
+  Char, VSTOP,
+  End
+};
+
+#undef iflags
+#undef oflags
+#undef cflags
+#undef lflags
+
+static struct {
+  speed_t speed;
+  int baud;
+} speedtable[] = {
+
+  /* standard speeds */
+  {B0,       0},
+  {B50,      50},
+  {B75,      75},
+  {B110,     110},
+  {B134,     134},
+  {B150,     150},
+#ifdef B200
+  /* Shouldn't need to be ifdef'd but I'm not sure it's available everywhere. */
+  {B200,     200},
+#endif
+  {B300,     300},
+  {B600,     600},
+  {B1200,    1200},
+  {B1800,    1800},
+  {B2400,    2400},
+  {B4800,    4800},
+  {B9600,    9600},
+  {B19200,   19200},
+  {B38400,   38400},
+
+  /* usual extensions */
+#ifdef B57600
+  {B57600,   57600},
+#endif
+#ifdef B115200
+  {B115200,  115200},
+#endif
+#ifdef B230400
+  {B230400,  230400},
+#endif
+
+  /* Linux extensions */
+#ifdef B460800
+  {B460800,  460800},
+#endif
+#ifdef B500000
+  {B500000,  500000},
+#endif
+#ifdef B576000
+  {B576000,  576000},
+#endif
+#ifdef B921600
+  {B921600,  921600},
+#endif
+#ifdef B1000000
+  {B1000000, 1000000},
+#endif
+#ifdef B1152000
+  {B1152000, 1152000},
+#endif
+#ifdef B1500000
+  {B1500000, 1500000},
+#endif
+#ifdef B2000000
+  {B2000000, 2000000},
+#endif
+#ifdef B2500000
+  {B2500000, 2500000},
+#endif
+#ifdef B3000000
+  {B3000000, 3000000},
+#endif
+#ifdef B3500000
+  {B3500000, 3500000},
+#endif
+#ifdef B4000000
+  {B4000000, 4000000},
+#endif
+
+  /* MacOS extensions */
+#ifdef B7200
+  {B7200,    7200},
+#endif
+#ifdef B14400
+  {B14400,   14400},
+#endif
+#ifdef B28800
+  {B28800,   28800},
+#endif
+#ifdef B76800
+  {B76800,   76800},
+#endif
+
+  /* Cygwin extensions (in addition to the Linux ones) */
+#ifdef B128000
+  {B128000,  128000},
+#endif
+#ifdef B256000
+  {B256000,  256000},
+#endif
+};
+
+#define NSPEEDS (sizeof(speedtable) / sizeof(speedtable[0]))
+
+static void encode_terminal_status(value *dst)
+{
+  long * pc;
+  int i;
+
+  for(pc = terminal_io_descr; *pc != End; dst++) {
+    switch(*pc++) {
+    case Bool:
+      { int * src = (int *) (*pc++);
+        int msk = *pc++;
+        *dst = Val_bool(*src & msk);
+        break; }
+    case Enum:
+      { int * src = (int *) (*pc++);
+        int ofs = *pc++;
+        int num = *pc++;
+        int msk = *pc++;
+        for (i = 0; i < num; i++) {
+          if ((*src & msk) == pc[i]) {
+            *dst = Val_int(i + ofs);
+            break;
+          }
+        }
+        pc += num;
+        break; }
+    case Speed:
+      { int which = *pc++;
+        speed_t speed = 0;
+        *dst = Val_int(9600);   /* in case no speed in speedtable matches */
+        switch (which) {
+        case Output:
+          speed = cfgetospeed(&terminal_status); break;
+        case Input:
+          speed = cfgetispeed(&terminal_status); break;
+        }
+        for (i = 0; i < NSPEEDS; i++) {
+          if (speed == speedtable[i].speed) {
+            *dst = Val_int(speedtable[i].baud);
+            break;
+          }
+        }
+        break; }
+    case Char:
+      { int which = *pc++;
+        *dst = Val_int(terminal_status.c_cc[which]);
+        break; }
+    }
+  }
+}
+
+static void decode_terminal_status(value *src)
+{
+  long * pc;
+  int i;
+
+  for (pc = terminal_io_descr; *pc != End; src++) {
+    switch(*pc++) {
+    case Bool:
+      { int * dst = (int *) (*pc++);
+        int msk = *pc++;
+        if (Bool_val(*src))
+          *dst |= msk;
+        else
+          *dst &= ~msk;
+        break; }
+    case Enum:
+      { int * dst = (int *) (*pc++);
+        int ofs = *pc++;
+        int num = *pc++;
+        int msk = *pc++;
+        i = Int_val(*src) - ofs;
+        if (i >= 0 && i < num) {
+          *dst = (*dst & ~msk) | pc[i];
+        } else {
+          unix_error(EINVAL, "tcsetattr", Nothing);
+        }
+        pc += num;
+        break; }
+    case Speed:
+      { int which = *pc++;
+        int baud = Int_val(*src);
+        int res = 0;
+        for (i = 0; i < NSPEEDS; i++) {
+          if (baud == speedtable[i].baud) {
+            switch (which) {
+            case Output:
+              res = cfsetospeed(&terminal_status, speedtable[i].speed); break;
+            case Input:
+              res = cfsetispeed(&terminal_status, speedtable[i].speed); break;
+            }
+            if (res == -1) uerror("tcsetattr", Nothing);
+            goto ok;
+          }
+        }
+        unix_error(EINVAL, "tcsetattr", Nothing);
+      ok:
+        break; }
+    case Char:
+      { int which = *pc++;
+        terminal_status.c_cc[which] = Int_val(*src);
+        break; }
+    }
+  }
+}
+
+CAMLprim value unix_tcgetattr(value fd)
+{
+  value res;
+
+  if (tcgetattr(Int_val(fd), &terminal_status) == -1)
+    uerror("tcgetattr", Nothing);
+  res = caml_alloc_tuple(NFIELDS);
+  encode_terminal_status(&Field(res, 0));
+  return res;
+}
+
+static int when_flag_table[] = {
+  TCSANOW, TCSADRAIN, TCSAFLUSH
+};
+
+CAMLprim value unix_tcsetattr(value fd, value when, value arg)
+{
+  if (tcgetattr(Int_val(fd), &terminal_status) == -1)
+    uerror("tcsetattr", Nothing);
+  decode_terminal_status(&Field(arg, 0));
+  if (tcsetattr(Int_val(fd),
+                when_flag_table[Int_val(when)],
+                &terminal_status) == -1)
+    uerror("tcsetattr", Nothing);
+  return Val_unit;
+}
+
+CAMLprim value unix_tcsendbreak(value fd, value delay)
+{
+  if (tcsendbreak(Int_val(fd), Int_val(delay)) == -1)
+    uerror("tcsendbreak", Nothing);
+  return Val_unit;
+}
+
+#if defined(__ANDROID__)
+CAMLprim value unix_tcdrain(value fd)
+{ caml_invalid_argument("tcdrain not implemented"); }
+#else
+CAMLprim value unix_tcdrain(value fd)
+{
+  if (tcdrain(Int_val(fd)) == -1) uerror("tcdrain", Nothing);
+  return Val_unit;
+}
+#endif
+
+static int queue_flag_table[] = {
+  TCIFLUSH, TCOFLUSH, TCIOFLUSH
+};
+
+CAMLprim value unix_tcflush(value fd, value queue)
+{
+  if (tcflush(Int_val(fd), queue_flag_table[Int_val(queue)]) == -1)
+    uerror("tcflush", Nothing);
+  return Val_unit;
+}
+
+static int action_flag_table[] = {
+  TCOOFF, TCOON, TCIOFF, TCION
+};
+
+CAMLprim value unix_tcflow(value fd, value action)
+{
+  if (tcflow(Int_val(fd), action_flag_table[Int_val(action)]) == -1)
+    uerror("tcflow", Nothing);
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_tcgetattr(value fd)
+{ caml_invalid_argument("tcgetattr not implemented"); }
+
+CAMLprim value unix_tcsetattr(value fd, value when, value arg)
+{ caml_invalid_argument("tcsetattr not implemented"); }
+
+CAMLprim value unix_tcsendbreak(value fd, value delay)
+{ caml_invalid_argument("tcsendbreak not implemented"); }
+
+CAMLprim value unix_tcdrain(value fd)
+{ caml_invalid_argument("tcdrain not implemented"); }
+
+CAMLprim value unix_tcflush(value fd, value queue)
+{ caml_invalid_argument("tcflush not implemented"); }
+
+CAMLprim value unix_tcflow(value fd, value action)
+{ caml_invalid_argument("tcflow not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/time.c b/otherlibs/unix/time.c
new file mode 100644
index 00000000..f7916c99
--- /dev/null
+++ b/otherlibs/unix/time.c
@@ -0,0 +1,24 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <time.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_time(value unit)
+{
+  return caml_copy_double((double) time((time_t *) NULL));
+}
diff --git a/otherlibs/unix/times.c b/otherlibs/unix/times.c
new file mode 100644
index 00000000..90e79c5a
--- /dev/null
+++ b/otherlibs/unix/times.c
@@ -0,0 +1,67 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include "unixsupport.h"
+#include <time.h>
+#include <sys/types.h>
+#include <sys/times.h>
+#ifdef HAS_GETRUSAGE
+#include <sys/time.h>
+#include <sys/resource.h>
+#endif
+
+CAMLprim value unix_times(value unit)
+{
+#ifdef HAS_GETRUSAGE
+
+  value res;
+  struct rusage ru;
+
+  res = caml_alloc_small(4 * Double_wosize, Double_array_tag);
+
+  getrusage (RUSAGE_SELF, &ru);
+  Store_double_field (res, 0, ru.ru_utime.tv_sec + ru.ru_utime.tv_usec / 1e6);
+  Store_double_field (res, 1, ru.ru_stime.tv_sec + ru.ru_stime.tv_usec / 1e6);
+  getrusage (RUSAGE_CHILDREN, &ru);
+  Store_double_field (res, 2, ru.ru_utime.tv_sec + ru.ru_utime.tv_usec / 1e6);
+  Store_double_field (res, 3, ru.ru_stime.tv_sec + ru.ru_stime.tv_usec / 1e6);
+  return res;
+
+#else
+
+#ifndef CLK_TCK
+#ifdef HZ
+#define CLK_TCK HZ
+#else
+#define CLK_TCK 60
+#endif
+#endif
+
+  value res;
+  struct tms buffer;
+
+  times(&buffer);
+  res = caml_alloc_small(4 * Double_wosize, Double_array_tag);
+  Store_double_field(res, 0, (double) buffer.tms_utime / CLK_TCK);
+  Store_double_field(res, 1, (double) buffer.tms_stime / CLK_TCK);
+  Store_double_field(res, 2, (double) buffer.tms_cutime / CLK_TCK);
+  Store_double_field(res, 3, (double) buffer.tms_cstime / CLK_TCK);
+  return res;
+
+#endif
+}
diff --git a/otherlibs/unix/truncate.c b/otherlibs/unix/truncate.c
new file mode 100644
index 00000000..e7c1f6cb
--- /dev/null
+++ b/otherlibs/unix/truncate.c
@@ -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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#define CAML_INTERNALS
+
+#include <sys/types.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/signals.h>
+#include <caml/io.h>
+#include "unixsupport.h"
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+
+#ifdef HAS_TRUNCATE
+
+CAMLprim value unix_truncate(value path, value len)
+{
+  CAMLparam2(path, len);
+  char * p;
+  int ret;
+  caml_unix_check_path(path, "truncate");
+  p = caml_stat_strdup(String_val(path));
+  caml_enter_blocking_section();
+  ret = truncate(p, Long_val(len));
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1)
+    uerror("truncate", path);
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value unix_truncate_64(value path, value vlen)
+{
+  CAMLparam2(path, vlen);
+  char * p;
+  int ret;
+  file_offset len = File_offset_val(vlen);
+  caml_unix_check_path(path, "truncate");
+  p = caml_stat_strdup(String_val(path));
+  caml_enter_blocking_section();
+  ret = truncate(p, len);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1)
+    uerror("truncate", path);
+  CAMLreturn(Val_unit);
+}
+
+#else
+
+CAMLprim value unix_truncate(value path, value len)
+{ caml_invalid_argument("truncate not implemented"); }
+
+CAMLprim value unix_truncate_64(value path, value len)
+{ caml_invalid_argument("truncate not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/umask.c b/otherlibs/unix/umask.c
new file mode 100644
index 00000000..90fd970d
--- /dev/null
+++ b/otherlibs/unix/umask.c
@@ -0,0 +1,24 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_umask(value perm)
+{
+  return Val_int(umask(Int_val(perm)));
+}
diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml
new file mode 100644
index 00000000..ae9b1fc8
--- /dev/null
+++ b/otherlibs/unix/unix.ml
@@ -0,0 +1,1201 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let shell = "/bin/sh"
+
+type error =
+    E2BIG
+  | EACCES
+  | EAGAIN
+  | EBADF
+  | EBUSY
+  | ECHILD
+  | EDEADLK
+  | EDOM
+  | EEXIST
+  | EFAULT
+  | EFBIG
+  | EINTR
+  | EINVAL
+  | EIO
+  | EISDIR
+  | EMFILE
+  | EMLINK
+  | ENAMETOOLONG
+  | ENFILE
+  | ENODEV
+  | ENOENT
+  | ENOEXEC
+  | ENOLCK
+  | ENOMEM
+  | ENOSPC
+  | ENOSYS
+  | ENOTDIR
+  | ENOTEMPTY
+  | ENOTTY
+  | ENXIO
+  | EPERM
+  | EPIPE
+  | ERANGE
+  | EROFS
+  | ESPIPE
+  | ESRCH
+  | EXDEV
+  | EWOULDBLOCK
+  | EINPROGRESS
+  | EALREADY
+  | ENOTSOCK
+  | EDESTADDRREQ
+  | EMSGSIZE
+  | EPROTOTYPE
+  | ENOPROTOOPT
+  | EPROTONOSUPPORT
+  | ESOCKTNOSUPPORT
+  | EOPNOTSUPP
+  | EPFNOSUPPORT
+  | EAFNOSUPPORT
+  | EADDRINUSE
+  | EADDRNOTAVAIL
+  | ENETDOWN
+  | ENETUNREACH
+  | ENETRESET
+  | ECONNABORTED
+  | ECONNRESET
+  | ENOBUFS
+  | EISCONN
+  | ENOTCONN
+  | ESHUTDOWN
+  | ETOOMANYREFS
+  | ETIMEDOUT
+  | ECONNREFUSED
+  | EHOSTDOWN
+  | EHOSTUNREACH
+  | ELOOP
+  | EOVERFLOW
+  | EUNKNOWNERR of int
+
+exception Unix_error of error * string * string
+
+let _ = Callback.register_exception "Unix.Unix_error"
+                                    (Unix_error(E2BIG, "", ""))
+
+external error_message : error -> string = "unix_error_message"
+
+let () =
+  Printexc.register_printer
+    (function
+      | Unix_error (e, s, s') ->
+          let msg = match e with
+          | E2BIG -> "E2BIG"
+          | EACCES -> "EACCES"
+          | EAGAIN -> "EAGAIN"
+          | EBADF -> "EBADF"
+          | EBUSY -> "EBUSY"
+          | ECHILD -> "ECHILD"
+          | EDEADLK -> "EDEADLK"
+          | EDOM -> "EDOM"
+          | EEXIST -> "EEXIST"
+          | EFAULT -> "EFAULT"
+          | EFBIG -> "EFBIG"
+          | EINTR -> "EINTR"
+          | EINVAL -> "EINVAL"
+          | EIO -> "EIO"
+          | EISDIR -> "EISDIR"
+          | EMFILE -> "EMFILE"
+          | EMLINK -> "EMLINK"
+          | ENAMETOOLONG -> "ENAMETOOLONG"
+          | ENFILE -> "ENFILE"
+          | ENODEV -> "ENODEV"
+          | ENOENT -> "ENOENT"
+          | ENOEXEC -> "ENOEXEC"
+          | ENOLCK -> "ENOLCK"
+          | ENOMEM -> "ENOMEM"
+          | ENOSPC -> "ENOSPC"
+          | ENOSYS -> "ENOSYS"
+          | ENOTDIR -> "ENOTDIR"
+          | ENOTEMPTY -> "ENOTEMPTY"
+          | ENOTTY -> "ENOTTY"
+          | ENXIO -> "ENXIO"
+          | EPERM -> "EPERM"
+          | EPIPE -> "EPIPE"
+          | ERANGE -> "ERANGE"
+          | EROFS -> "EROFS"
+          | ESPIPE -> "ESPIPE"
+          | ESRCH -> "ESRCH"
+          | EXDEV -> "EXDEV"
+          | EWOULDBLOCK -> "EWOULDBLOCK"
+          | EINPROGRESS -> "EINPROGRESS"
+          | EALREADY -> "EALREADY"
+          | ENOTSOCK -> "ENOTSOCK"
+          | EDESTADDRREQ -> "EDESTADDRREQ"
+          | EMSGSIZE -> "EMSGSIZE"
+          | EPROTOTYPE -> "EPROTOTYPE"
+          | ENOPROTOOPT -> "ENOPROTOOPT"
+          | EPROTONOSUPPORT -> "EPROTONOSUPPORT"
+          | ESOCKTNOSUPPORT -> "ESOCKTNOSUPPORT"
+          | EOPNOTSUPP -> "EOPNOTSUPP"
+          | EPFNOSUPPORT -> "EPFNOSUPPORT"
+          | EAFNOSUPPORT -> "EAFNOSUPPORT"
+          | EADDRINUSE -> "EADDRINUSE"
+          | EADDRNOTAVAIL -> "EADDRNOTAVAIL"
+          | ENETDOWN -> "ENETDOWN"
+          | ENETUNREACH -> "ENETUNREACH"
+          | ENETRESET -> "ENETRESET"
+          | ECONNABORTED -> "ECONNABORTED"
+          | ECONNRESET -> "ECONNRESET"
+          | ENOBUFS -> "ENOBUFS"
+          | EISCONN -> "EISCONN"
+          | ENOTCONN -> "ENOTCONN"
+          | ESHUTDOWN -> "ESHUTDOWN"
+          | ETOOMANYREFS -> "ETOOMANYREFS"
+          | ETIMEDOUT -> "ETIMEDOUT"
+          | ECONNREFUSED -> "ECONNREFUSED"
+          | EHOSTDOWN -> "EHOSTDOWN"
+          | EHOSTUNREACH -> "EHOSTUNREACH"
+          | ELOOP -> "ELOOP"
+          | EOVERFLOW -> "EOVERFLOW"
+          | EUNKNOWNERR x -> Printf.sprintf "EUNKNOWNERR %d" x in
+          Some (Printf.sprintf "Unix.Unix_error(Unix.%s, %S, %S)" msg s s')
+      | _ -> None)
+
+let handle_unix_error f arg =
+  try
+    f arg
+  with Unix_error(err, fun_name, arg) ->
+    prerr_string Sys.argv.(0);
+    prerr_string ": \"";
+    prerr_string fun_name;
+    prerr_string "\" failed";
+    if String.length arg > 0 then begin
+      prerr_string " on \"";
+      prerr_string arg;
+      prerr_string "\""
+    end;
+    prerr_string ": ";
+    prerr_endline (error_message err);
+    exit 2
+
+external environment : unit -> string array = "unix_environment"
+external unsafe_environment : unit -> string array = "unix_environment_unsafe"
+external getenv: string -> string = "caml_sys_getenv"
+external unsafe_getenv: string -> string = "caml_sys_unsafe_getenv"
+external putenv: string -> string -> unit = "unix_putenv"
+
+type process_status =
+    WEXITED of int
+  | WSIGNALED of int
+  | WSTOPPED of int
+
+type wait_flag =
+    WNOHANG
+  | WUNTRACED
+
+external execv : string -> string array -> 'a = "unix_execv"
+external execve : string -> string array -> string array -> 'a = "unix_execve"
+external execvp : string -> string array -> 'a = "unix_execvp"
+external execvpe_c :
+            string -> string array -> string array -> 'a = "unix_execvpe"
+
+let execvpe_ml name args env =
+  (* Try to execute the given file *)
+  let exec file =
+    try
+      execve file args env
+    with Unix_error(ENOEXEC, _, _) ->
+      (* Assume this is a script and try to execute through the shell *)
+      let argc = Array.length args in
+      (* Drop the original args.(0) if it is there *)
+      let new_args = Array.append
+        [| shell; file |]
+        (if argc = 0 then args else Array.sub args 1 (argc - 1)) in
+      execve new_args.(0) new_args env in
+  (* Try each path element in turn *)
+  let rec scan_dir eacces = function
+  | [] ->
+      (* No matching file was found (if [eacces = false]) or
+         a matching file was found but we got a "permission denied"
+         error while trying to execute it (if [eacces = true]).
+         Raise the error appropriate to each case. *)
+      raise (Unix_error((if eacces then EACCES else ENOENT),
+                        "execvpe", name))
+  | dir :: rem ->
+      let dir =  (* an empty path element means the current directory *)
+        if dir = "" then Filename.current_dir_name else dir in
+      try
+        exec (Filename.concat dir name)
+      with Unix_error(err, _, _) as exn ->
+        match err with
+        (* The following errors are treated as nonfatal, meaning that
+           we will ignore them and continue searching in the path.
+           Among those errors, EACCES is recorded specially so as
+           to produce the correct exception in the end.
+           To determine which errors are nonfatal, we looked at the
+           execvpe() sources in Glibc and in OpenBSD. *)
+        | EACCES ->
+            scan_dir true rem
+        | EISDIR|ELOOP|ENAMETOOLONG|ENODEV|ENOENT|ENOTDIR|ETIMEDOUT ->
+            scan_dir eacces rem
+        (* Other errors, e.g. E2BIG, are fatal and abort the search. *)
+        | _ ->
+            raise exn in
+  if String.contains name '/' then
+    (* If the command name contains "/" characters, don't search in path *)
+    exec name
+  else
+    (* Split path into elements and search in these elements *)
+    (try unsafe_getenv "PATH" with Not_found -> "/bin:/usr/bin")
+    |> String.split_on_char ':'
+    |> scan_dir false
+      (* [unsafe_getenv] and not [getenv] to be consistent with [execvp],
+         which looks up the PATH environment variable whether SUID or not. *)
+
+let execvpe name args env =
+  try
+    execvpe_c name args env
+  with Unix_error(ENOSYS, _, _) ->
+    execvpe_ml name args env
+
+external fork : unit -> int = "unix_fork"
+external wait : unit -> int * process_status = "unix_wait"
+external waitpid : wait_flag list -> int -> int * process_status
+   = "unix_waitpid"
+external getpid : unit -> int = "unix_getpid"
+external getppid : unit -> int = "unix_getppid"
+external nice : int -> int = "unix_nice"
+
+type file_descr = int
+
+let stdin = 0
+let stdout = 1
+let stderr = 2
+
+type open_flag =
+    O_RDONLY
+  | O_WRONLY
+  | O_RDWR
+  | O_NONBLOCK
+  | O_APPEND
+  | O_CREAT
+  | O_TRUNC
+  | O_EXCL
+  | O_NOCTTY
+  | O_DSYNC
+  | O_SYNC
+  | O_RSYNC
+  | O_SHARE_DELETE
+  | O_CLOEXEC
+  | O_KEEPEXEC
+
+type file_perm = int
+
+
+external openfile : string -> open_flag list -> file_perm -> file_descr
+           = "unix_open"
+external close : file_descr -> unit = "unix_close"
+external fsync : file_descr -> unit = "unix_fsync"
+external unsafe_read : file_descr -> bytes -> int -> int -> int
+   = "unix_read"
+external unsafe_write : file_descr -> bytes -> int -> int -> int = "unix_write"
+external unsafe_single_write : file_descr -> bytes -> int -> int -> int
+   = "unix_single_write"
+
+let read fd buf ofs len =
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
+  then invalid_arg "Unix.read"
+  else unsafe_read fd buf ofs len
+let write fd buf ofs len =
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
+  then invalid_arg "Unix.write"
+  else unsafe_write fd buf ofs len
+(* write misbehaves because it attempts to write all data by making repeated
+   calls to the Unix write function (see comment in write.c and unix.mli).
+   single_write fixes this by never calling write twice. *)
+let single_write fd buf ofs len =
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
+  then invalid_arg "Unix.single_write"
+  else unsafe_single_write fd buf ofs len
+
+let write_substring fd buf ofs len =
+  write fd (Bytes.unsafe_of_string buf) ofs len
+
+let single_write_substring fd buf ofs len =
+  single_write fd (Bytes.unsafe_of_string buf) ofs len
+
+external in_channel_of_descr : file_descr -> in_channel
+                             = "unix_inchannel_of_filedescr"
+external out_channel_of_descr : file_descr -> out_channel
+                              = "unix_outchannel_of_filedescr"
+external descr_of_in_channel : in_channel -> file_descr
+                             = "caml_channel_descriptor"
+external descr_of_out_channel : out_channel -> file_descr
+                              = "caml_channel_descriptor"
+
+type seek_command =
+    SEEK_SET
+  | SEEK_CUR
+  | SEEK_END
+
+external lseek : file_descr -> int -> seek_command -> int = "unix_lseek"
+external truncate : string -> int -> unit = "unix_truncate"
+external ftruncate : file_descr -> int -> unit = "unix_ftruncate"
+
+type file_kind =
+    S_REG
+  | S_DIR
+  | S_CHR
+  | S_BLK
+  | S_LNK
+  | S_FIFO
+  | S_SOCK
+
+type stats =
+  { st_dev : int;
+    st_ino : int;
+    st_kind : file_kind;
+    st_perm : file_perm;
+    st_nlink : int;
+    st_uid : int;
+    st_gid : int;
+    st_rdev : int;
+    st_size : int;
+    st_atime : float;
+    st_mtime : float;
+    st_ctime : float }
+
+external stat : string -> stats = "unix_stat"
+external lstat : string -> stats = "unix_lstat"
+external fstat : file_descr -> stats = "unix_fstat"
+external isatty : file_descr -> bool = "unix_isatty"
+external unlink : string -> unit = "unix_unlink"
+external rename : string -> string -> unit = "unix_rename"
+external link : ?follow:bool -> string -> string -> unit = "unix_link"
+
+module LargeFile =
+  struct
+    external lseek : file_descr -> int64 -> seek_command -> int64
+       = "unix_lseek_64"
+    external truncate : string -> int64 -> unit = "unix_truncate_64"
+    external ftruncate : file_descr -> int64 -> unit = "unix_ftruncate_64"
+    type stats =
+      { st_dev : int;
+        st_ino : int;
+        st_kind : file_kind;
+        st_perm : file_perm;
+        st_nlink : int;
+        st_uid : int;
+        st_gid : int;
+        st_rdev : int;
+        st_size : int64;
+        st_atime : float;
+        st_mtime : float;
+        st_ctime : float;
+      }
+    external stat : string -> stats = "unix_stat_64"
+    external lstat : string -> stats = "unix_lstat_64"
+    external fstat : file_descr -> stats = "unix_fstat_64"
+  end
+
+external map_internal:
+   file_descr -> ('a, 'b) Stdlib.Bigarray.kind
+              -> 'c Stdlib.Bigarray.layout
+              -> bool -> int array -> int64
+              -> ('a, 'b, 'c) Stdlib.Bigarray.Genarray.t
+     = "caml_unix_map_file_bytecode" "caml_unix_map_file"
+
+let map_file fd ?(pos=0L) kind layout shared dims =
+  map_internal fd kind layout shared dims pos
+
+type access_permission =
+    R_OK
+  | W_OK
+  | X_OK
+  | F_OK
+
+external chmod : string -> file_perm -> unit = "unix_chmod"
+external fchmod : file_descr -> file_perm -> unit = "unix_fchmod"
+external chown : string -> int -> int -> unit = "unix_chown"
+external fchown : file_descr -> int -> int -> unit = "unix_fchown"
+external umask : int -> int = "unix_umask"
+external access : string -> access_permission list -> unit = "unix_access"
+
+external dup : ?cloexec: bool -> file_descr -> file_descr = "unix_dup"
+external dup2 :
+   ?cloexec: bool -> file_descr -> file_descr -> unit = "unix_dup2"
+external set_nonblock : file_descr -> unit = "unix_set_nonblock"
+external clear_nonblock : file_descr -> unit = "unix_clear_nonblock"
+external set_close_on_exec : file_descr -> unit = "unix_set_close_on_exec"
+external clear_close_on_exec : file_descr -> unit = "unix_clear_close_on_exec"
+
+external mkdir : string -> file_perm -> unit = "unix_mkdir"
+external rmdir : string -> unit = "unix_rmdir"
+external chdir : string -> unit = "unix_chdir"
+external getcwd : unit -> string = "unix_getcwd"
+external chroot : string -> unit = "unix_chroot"
+
+type dir_handle
+
+external opendir : string -> dir_handle = "unix_opendir"
+external readdir : dir_handle -> string = "unix_readdir"
+external rewinddir : dir_handle -> unit = "unix_rewinddir"
+external closedir : dir_handle -> unit = "unix_closedir"
+
+external pipe :
+  ?cloexec: bool -> unit -> file_descr * file_descr = "unix_pipe"
+external symlink : ?to_dir:bool -> string -> string -> unit = "unix_symlink"
+external has_symlink : unit -> bool = "unix_has_symlink"
+external readlink : string -> string = "unix_readlink"
+external mkfifo : string -> file_perm -> unit = "unix_mkfifo"
+external select :
+  file_descr list -> file_descr list -> file_descr list -> float ->
+        file_descr list * file_descr list * file_descr list = "unix_select"
+
+type lock_command =
+    F_ULOCK
+  | F_LOCK
+  | F_TLOCK
+  | F_TEST
+  | F_RLOCK
+  | F_TRLOCK
+
+external lockf : file_descr -> lock_command -> int -> unit = "unix_lockf"
+external kill : int -> int -> unit = "unix_kill"
+type sigprocmask_command = SIG_SETMASK | SIG_BLOCK | SIG_UNBLOCK
+external sigprocmask: sigprocmask_command -> int list -> int list
+        = "unix_sigprocmask"
+external sigpending: unit -> int list = "unix_sigpending"
+external sigsuspend: int list -> unit = "unix_sigsuspend"
+
+let pause() =
+  let sigs = sigprocmask SIG_BLOCK [] in sigsuspend sigs
+
+type process_times =
+  { tms_utime : float;
+    tms_stime : float;
+    tms_cutime : float;
+    tms_cstime : float }
+
+type tm =
+  { tm_sec : int;
+    tm_min : int;
+    tm_hour : int;
+    tm_mday : int;
+    tm_mon : int;
+    tm_year : int;
+    tm_wday : int;
+    tm_yday : int;
+    tm_isdst : bool }
+
+external time : unit -> float = "unix_time"
+external gettimeofday : unit -> float = "unix_gettimeofday"
+external gmtime : float -> tm = "unix_gmtime"
+external localtime : float -> tm = "unix_localtime"
+external mktime : tm -> float * tm = "unix_mktime"
+external alarm : int -> int = "unix_alarm"
+external sleepf : float -> unit = "unix_sleep"
+let sleep duration = sleepf (float duration)
+external times : unit -> process_times = "unix_times"
+external utimes : string -> float -> float -> unit = "unix_utimes"
+
+type interval_timer =
+    ITIMER_REAL
+  | ITIMER_VIRTUAL
+  | ITIMER_PROF
+
+type interval_timer_status =
+  { it_interval: float;                 (* Period *)
+    it_value: float }                   (* Current value of the timer *)
+
+external getitimer: interval_timer -> interval_timer_status = "unix_getitimer"
+external setitimer:
+  interval_timer -> interval_timer_status -> interval_timer_status
+  = "unix_setitimer"
+
+external getuid : unit -> int = "unix_getuid"
+external geteuid : unit -> int = "unix_geteuid"
+external setuid : int -> unit = "unix_setuid"
+external getgid : unit -> int = "unix_getgid"
+external getegid : unit -> int = "unix_getegid"
+external setgid : int -> unit = "unix_setgid"
+external getgroups : unit -> int array = "unix_getgroups"
+external setgroups : int array -> unit = "unix_setgroups"
+external initgroups : string -> int -> unit = "unix_initgroups"
+
+type passwd_entry =
+  { pw_name : string;
+    pw_passwd : string;
+    pw_uid : int;
+    pw_gid : int;
+    pw_gecos : string;
+    pw_dir : string;
+    pw_shell : string }
+
+type group_entry =
+  { gr_name : string;
+    gr_passwd : string;
+    gr_gid : int;
+    gr_mem : string array }
+
+
+external getlogin : unit -> string = "unix_getlogin"
+external getpwnam : string -> passwd_entry = "unix_getpwnam"
+external getgrnam : string -> group_entry = "unix_getgrnam"
+external getpwuid : int -> passwd_entry = "unix_getpwuid"
+external getgrgid : int -> group_entry = "unix_getgrgid"
+
+type inet_addr = string
+
+let is_inet6_addr s = String.length s = 16
+
+external inet_addr_of_string : string -> inet_addr
+                                    = "unix_inet_addr_of_string"
+external string_of_inet_addr : inet_addr -> string
+                                    = "unix_string_of_inet_addr"
+
+let inet_addr_any = inet_addr_of_string "0.0.0.0"
+let inet_addr_loopback = inet_addr_of_string "127.0.0.1"
+let inet6_addr_any =
+  try inet_addr_of_string "::" with Failure _ -> inet_addr_any
+let inet6_addr_loopback =
+  try inet_addr_of_string "::1" with Failure _ -> inet_addr_loopback
+
+type socket_domain =
+    PF_UNIX
+  | PF_INET
+  | PF_INET6
+
+type socket_type =
+    SOCK_STREAM
+  | SOCK_DGRAM
+  | SOCK_RAW
+  | SOCK_SEQPACKET
+
+type sockaddr =
+    ADDR_UNIX of string
+  | ADDR_INET of inet_addr * int
+
+let domain_of_sockaddr = function
+    ADDR_UNIX _ -> PF_UNIX
+  | ADDR_INET(a, _) -> if is_inet6_addr a then PF_INET6 else PF_INET
+
+type shutdown_command =
+    SHUTDOWN_RECEIVE
+  | SHUTDOWN_SEND
+  | SHUTDOWN_ALL
+
+type msg_flag =
+    MSG_OOB
+  | MSG_DONTROUTE
+  | MSG_PEEK
+
+external socket :
+  ?cloexec: bool -> socket_domain -> socket_type -> int -> file_descr
+  = "unix_socket"
+external socketpair :
+  ?cloexec: bool -> socket_domain -> socket_type -> int ->
+                                           file_descr * file_descr
+  = "unix_socketpair"
+external accept :
+  ?cloexec: bool -> file_descr -> file_descr * sockaddr = "unix_accept"
+external bind : file_descr -> sockaddr -> unit = "unix_bind"
+external connect : file_descr -> sockaddr -> unit = "unix_connect"
+external listen : file_descr -> int -> unit = "unix_listen"
+external shutdown : file_descr -> shutdown_command -> unit = "unix_shutdown"
+external getsockname : file_descr -> sockaddr = "unix_getsockname"
+external getpeername : file_descr -> sockaddr = "unix_getpeername"
+
+external unsafe_recv :
+  file_descr -> bytes -> int -> int -> msg_flag list -> int
+                                  = "unix_recv"
+external unsafe_recvfrom :
+  file_descr -> bytes -> int -> int -> msg_flag list -> int * sockaddr
+                                  = "unix_recvfrom"
+external unsafe_send :
+  file_descr -> bytes -> int -> int -> msg_flag list -> int
+                                  = "unix_send"
+external unsafe_sendto :
+  file_descr -> bytes -> int -> int -> msg_flag list -> sockaddr -> int
+                                  = "unix_sendto" "unix_sendto_native"
+
+let recv fd buf ofs len flags =
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
+  then invalid_arg "Unix.recv"
+  else unsafe_recv fd buf ofs len flags
+let recvfrom fd buf ofs len flags =
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
+  then invalid_arg "Unix.recvfrom"
+  else unsafe_recvfrom fd buf ofs len flags
+let send fd buf ofs len flags =
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
+  then invalid_arg "Unix.send"
+  else unsafe_send fd buf ofs len flags
+let sendto fd buf ofs len flags addr =
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
+  then invalid_arg "Unix.sendto"
+  else unsafe_sendto fd buf ofs len flags addr
+
+let send_substring fd buf ofs len flags =
+  send fd (Bytes.unsafe_of_string buf) ofs len flags
+
+let sendto_substring fd buf ofs len flags addr =
+  sendto fd (Bytes.unsafe_of_string buf) ofs len flags addr
+
+type socket_bool_option =
+    SO_DEBUG
+  | SO_BROADCAST
+  | SO_REUSEADDR
+  | SO_KEEPALIVE
+  | SO_DONTROUTE
+  | SO_OOBINLINE
+  | SO_ACCEPTCONN
+  | TCP_NODELAY
+  | IPV6_ONLY
+
+type socket_int_option =
+    SO_SNDBUF
+  | SO_RCVBUF
+  | SO_ERROR
+  | SO_TYPE
+  | SO_RCVLOWAT
+  | SO_SNDLOWAT
+
+type socket_optint_option = SO_LINGER
+
+type socket_float_option =
+    SO_RCVTIMEO
+  | SO_SNDTIMEO
+
+type socket_error_option = SO_ERROR
+
+module SO: sig
+  type ('opt, 'v) t
+  val bool: (socket_bool_option, bool) t
+  val int: (socket_int_option, int) t
+  val optint: (socket_optint_option, int option) t
+  val float: (socket_float_option, float) t
+  val error: (socket_error_option, error option) t
+  val get: ('opt, 'v) t -> file_descr -> 'opt -> 'v
+  val set: ('opt, 'v) t -> file_descr -> 'opt -> 'v -> unit
+end = struct
+  type ('opt, 'v) t = int
+  let bool = 0
+  let int = 1
+  let optint = 2
+  let float = 3
+  let error = 4
+  external get: ('opt, 'v) t -> file_descr -> 'opt -> 'v
+              = "unix_getsockopt"
+  external set: ('opt, 'v) t -> file_descr -> 'opt -> 'v -> unit
+              = "unix_setsockopt"
+end
+
+let getsockopt fd opt = SO.get SO.bool fd opt
+let setsockopt fd opt v = SO.set SO.bool fd opt v
+
+let getsockopt_int fd opt = SO.get SO.int fd opt
+let setsockopt_int fd opt v = SO.set SO.int fd opt v
+
+let getsockopt_optint fd opt = SO.get SO.optint fd opt
+let setsockopt_optint fd opt v = SO.set SO.optint fd opt v
+
+let getsockopt_float fd opt = SO.get SO.float fd opt
+let setsockopt_float fd opt v = SO.set SO.float fd opt v
+
+let getsockopt_error fd = SO.get SO.error fd SO_ERROR
+
+type host_entry =
+  { h_name : string;
+    h_aliases : string array;
+    h_addrtype : socket_domain;
+    h_addr_list : inet_addr array }
+
+type protocol_entry =
+  { p_name : string;
+    p_aliases : string array;
+    p_proto : int }
+
+type service_entry =
+  { s_name : string;
+    s_aliases : string array;
+    s_port : int;
+    s_proto : string }
+
+external gethostname : unit -> string = "unix_gethostname"
+external gethostbyname : string -> host_entry = "unix_gethostbyname"
+external gethostbyaddr : inet_addr -> host_entry = "unix_gethostbyaddr"
+external getprotobyname : string -> protocol_entry
+                                         = "unix_getprotobyname"
+external getprotobynumber : int -> protocol_entry
+                                         = "unix_getprotobynumber"
+external getservbyname : string -> string -> service_entry
+                                         = "unix_getservbyname"
+external getservbyport : int -> string -> service_entry
+                                         = "unix_getservbyport"
+
+type addr_info =
+  { ai_family : socket_domain;
+    ai_socktype : socket_type;
+    ai_protocol : int;
+    ai_addr : sockaddr;
+    ai_canonname : string }
+
+type getaddrinfo_option =
+    AI_FAMILY of socket_domain
+  | AI_SOCKTYPE of socket_type
+  | AI_PROTOCOL of int
+  | AI_NUMERICHOST
+  | AI_CANONNAME
+  | AI_PASSIVE
+
+external getaddrinfo_system
+  : string -> string -> getaddrinfo_option list -> addr_info list
+  = "unix_getaddrinfo"
+
+let getaddrinfo_emulation node service opts =
+  (* Parse options *)
+  let opt_socktype = ref None
+  and opt_protocol = ref 0
+  and opt_passive = ref false in
+  List.iter
+    (function AI_SOCKTYPE s -> opt_socktype := Some s
+            | AI_PROTOCOL p -> opt_protocol := p
+            | AI_PASSIVE -> opt_passive := true
+            | _ -> ())
+    opts;
+  (* Determine socket types and port numbers *)
+  let get_port ty kind =
+    if service = "" then [ty, 0] else
+      try
+        [ty, int_of_string service]
+      with Failure _ ->
+      try
+        [ty, (getservbyname service kind).s_port]
+      with Not_found -> []
+  in
+  let ports =
+    match !opt_socktype with
+    | None ->
+        get_port SOCK_STREAM "tcp" @ get_port SOCK_DGRAM "udp"
+    | Some SOCK_STREAM ->
+        get_port SOCK_STREAM "tcp"
+    | Some SOCK_DGRAM ->
+        get_port SOCK_DGRAM "udp"
+    | Some ty ->
+        if service = "" then [ty, 0] else [] in
+  (* Determine IP addresses *)
+  let addresses =
+    if node = "" then
+      if List.mem AI_PASSIVE opts
+      then [inet_addr_any, "0.0.0.0"]
+      else [inet_addr_loopback, "127.0.0.1"]
+    else
+      try
+        [inet_addr_of_string node, node]
+      with Failure _ ->
+      try
+        let he = gethostbyname node in
+        List.map
+          (fun a -> (a, he.h_name))
+          (Array.to_list he.h_addr_list)
+      with Not_found ->
+        [] in
+  (* Cross-product of addresses and ports *)
+  List.flatten
+    (List.map
+      (fun (ty, port) ->
+        List.map
+          (fun (addr, name) ->
+            { ai_family = PF_INET;
+              ai_socktype = ty;
+              ai_protocol = !opt_protocol;
+              ai_addr = ADDR_INET(addr, port);
+              ai_canonname = name })
+          addresses)
+      ports)
+
+let getaddrinfo node service opts =
+  try
+    List.rev(getaddrinfo_system node service opts)
+  with Invalid_argument _ ->
+    getaddrinfo_emulation node service opts
+
+type name_info =
+  { ni_hostname : string;
+    ni_service : string }
+
+type getnameinfo_option =
+    NI_NOFQDN
+  | NI_NUMERICHOST
+  | NI_NAMEREQD
+  | NI_NUMERICSERV
+  | NI_DGRAM
+
+external getnameinfo_system
+  : sockaddr -> getnameinfo_option list -> name_info
+  = "unix_getnameinfo"
+
+let getnameinfo_emulation addr opts =
+  match addr with
+  | ADDR_UNIX f ->
+      { ni_hostname = ""; ni_service = f } (* why not? *)
+  | ADDR_INET(a, p) ->
+      let hostname =
+        try
+          if List.mem NI_NUMERICHOST opts then raise Not_found;
+          (gethostbyaddr a).h_name
+        with Not_found ->
+          if List.mem NI_NAMEREQD opts then raise Not_found;
+          string_of_inet_addr a in
+      let service =
+        try
+          if List.mem NI_NUMERICSERV opts then raise Not_found;
+          let kind = if List.mem NI_DGRAM opts then "udp" else "tcp" in
+          (getservbyport p kind).s_name
+        with Not_found ->
+          Int.to_string p in
+      { ni_hostname = hostname; ni_service = service }
+
+let getnameinfo addr opts =
+  try
+    getnameinfo_system addr opts
+  with Invalid_argument _ ->
+    getnameinfo_emulation addr opts
+
+type terminal_io = {
+    mutable c_ignbrk: bool;
+    mutable c_brkint: bool;
+    mutable c_ignpar: bool;
+    mutable c_parmrk: bool;
+    mutable c_inpck: bool;
+    mutable c_istrip: bool;
+    mutable c_inlcr: bool;
+    mutable c_igncr: bool;
+    mutable c_icrnl: bool;
+    mutable c_ixon: bool;
+    mutable c_ixoff: bool;
+    mutable c_opost: bool;
+    mutable c_obaud: int;
+    mutable c_ibaud: int;
+    mutable c_csize: int;
+    mutable c_cstopb: int;
+    mutable c_cread: bool;
+    mutable c_parenb: bool;
+    mutable c_parodd: bool;
+    mutable c_hupcl: bool;
+    mutable c_clocal: bool;
+    mutable c_isig: bool;
+    mutable c_icanon: bool;
+    mutable c_noflsh: bool;
+    mutable c_echo: bool;
+    mutable c_echoe: bool;
+    mutable c_echok: bool;
+    mutable c_echonl: bool;
+    mutable c_vintr: char;
+    mutable c_vquit: char;
+    mutable c_verase: char;
+    mutable c_vkill: char;
+    mutable c_veof: char;
+    mutable c_veol: char;
+    mutable c_vmin: int;
+    mutable c_vtime: int;
+    mutable c_vstart: char;
+    mutable c_vstop: char
+  }
+
+external tcgetattr: file_descr -> terminal_io = "unix_tcgetattr"
+
+type setattr_when = TCSANOW | TCSADRAIN | TCSAFLUSH
+
+external tcsetattr: file_descr -> setattr_when -> terminal_io -> unit
+               = "unix_tcsetattr"
+external tcsendbreak: file_descr -> int -> unit = "unix_tcsendbreak"
+external tcdrain: file_descr -> unit = "unix_tcdrain"
+
+type flush_queue = TCIFLUSH | TCOFLUSH | TCIOFLUSH
+
+external tcflush: file_descr -> flush_queue -> unit = "unix_tcflush"
+
+type flow_action = TCOOFF | TCOON | TCIOFF | TCION
+
+external tcflow: file_descr -> flow_action -> unit = "unix_tcflow"
+
+external setsid : unit -> int = "unix_setsid"
+
+(* High-level process management (system, popen) *)
+
+let rec waitpid_non_intr pid =
+  try waitpid [] pid
+  with Unix_error (EINTR, _, _) -> waitpid_non_intr pid
+
+external sys_exit : int -> 'a = "caml_sys_exit"
+
+let system cmd =
+  match fork() with
+     0 -> begin try
+            execv shell [| shell; "-c"; cmd |]
+          with _ ->
+            sys_exit 127
+          end
+  | id -> snd(waitpid_non_intr id)
+
+(* Duplicate [fd] if needed to make sure it isn't one of the
+   standard descriptors (stdin, stdout, stderr).
+   Note that this function always leaves the standard descriptors open,
+   the caller must take care of closing them if needed.
+   The "cloexec" mode doesn't matter, because
+   the descriptor returned by [dup] will be closed before the [exec],
+   and because no other thread is running concurrently
+   (we are in the child process of a fork).
+ *)
+let rec file_descr_not_standard fd =
+  if fd >= 3 then fd else file_descr_not_standard (dup fd)
+
+let safe_close fd =
+  try close fd with Unix_error(_,_,_) -> ()
+
+let perform_redirections new_stdin new_stdout new_stderr =
+  let new_stdin = file_descr_not_standard new_stdin in
+  let new_stdout = file_descr_not_standard new_stdout in
+  let new_stderr = file_descr_not_standard new_stderr in
+  (*  The three dup2 close the original stdin, stdout, stderr,
+      which are the descriptors possibly left open
+      by file_descr_not_standard *)
+  dup2 ~cloexec:false new_stdin stdin;
+  dup2 ~cloexec:false new_stdout stdout;
+  dup2 ~cloexec:false new_stderr stderr;
+  safe_close new_stdin;
+  safe_close new_stdout;
+  safe_close new_stderr
+
+let create_process cmd args new_stdin new_stdout new_stderr =
+  match fork() with
+    0 ->
+      begin try
+        perform_redirections new_stdin new_stdout new_stderr;
+        execvp cmd args
+      with _ ->
+        sys_exit 127
+      end
+  | id -> id
+
+let create_process_env cmd args env new_stdin new_stdout new_stderr =
+  match fork() with
+    0 ->
+      begin try
+        perform_redirections new_stdin new_stdout new_stderr;
+        execvpe cmd args env
+      with _ ->
+        sys_exit 127
+      end
+  | id -> id
+
+type popen_process =
+    Process of in_channel * out_channel
+  | Process_in of in_channel
+  | Process_out of out_channel
+  | Process_full of in_channel * out_channel * in_channel
+
+let popen_processes = (Hashtbl.create 7 : (popen_process, int) Hashtbl.t)
+
+let open_proc prog args envopt proc input output error =
+  match fork() with
+    0 -> perform_redirections input output error;
+      begin try
+        match envopt with
+        | Some env -> execve prog args env
+        | None     -> execv prog args
+      with _ ->
+        sys_exit 127
+      end
+  | id -> Hashtbl.add popen_processes proc id
+
+let open_process_args_in prog args =
+  let (in_read, in_write) = pipe ~cloexec:true () in
+  let inchan = in_channel_of_descr in_read in
+  begin
+    try
+      open_proc prog args None (Process_in inchan) stdin in_write stderr
+    with e ->
+      close_in inchan;
+      close in_write;
+      raise e
+  end;
+  close in_write;
+  inchan
+
+let open_process_args_out prog args =
+  let (out_read, out_write) = pipe ~cloexec:true () in
+  let outchan = out_channel_of_descr out_write in
+  begin
+    try
+      open_proc prog args None (Process_out outchan) out_read stdout stderr
+    with e ->
+    close_out outchan;
+    close out_read;
+    raise e
+  end;
+  close out_read;
+  outchan
+
+let open_process_args prog args =
+  let (in_read, in_write) = pipe ~cloexec:true () in
+  let (out_read, out_write) =
+    try pipe ~cloexec:true ()
+    with e -> close in_read; close in_write; raise e in
+  let inchan = in_channel_of_descr in_read in
+  let outchan = out_channel_of_descr out_write in
+  begin
+    try
+      open_proc prog args None
+                (Process(inchan, outchan)) out_read in_write stderr
+    with e ->
+      close out_read; close out_write;
+      close in_read; close in_write;
+      raise e
+  end;
+  close out_read;
+  close in_write;
+  (inchan, outchan)
+
+let open_process_args_full prog args env =
+  let (in_read, in_write) = pipe ~cloexec:true () in
+  let (out_read, out_write) =
+    try pipe ~cloexec:true ()
+    with e -> close in_read; close in_write; raise e in
+  let (err_read, err_write) =
+    try pipe ~cloexec:true ()
+    with e -> close in_read; close in_write;
+              close out_read; close out_write; raise e in
+  let inchan = in_channel_of_descr in_read in
+  let outchan = out_channel_of_descr out_write in
+  let errchan = in_channel_of_descr err_read in
+  begin
+    try
+      open_proc prog args (Some env) (Process_full(inchan, outchan, errchan))
+                out_read in_write err_write
+    with e ->
+      close out_read; close out_write;
+      close in_read; close in_write;
+      close err_read; close err_write;
+      raise e
+  end;
+  close out_read;
+  close in_write;
+  close err_write;
+  (inchan, outchan, errchan)
+
+let open_process_shell fn cmd =
+  fn shell [|shell; "-c"; cmd|]
+let open_process_in cmd =
+  open_process_shell open_process_args_in cmd
+let open_process_out cmd =
+  open_process_shell open_process_args_out cmd
+let open_process cmd =
+  open_process_shell open_process_args cmd
+let open_process_full cmd =
+  open_process_shell open_process_args_full cmd
+
+let find_proc_id fun_name proc =
+  try
+    Hashtbl.find popen_processes proc
+  with Not_found ->
+    raise(Unix_error(EBADF, fun_name, ""))
+
+let remove_proc_id proc =
+  Hashtbl.remove popen_processes proc
+
+let process_in_pid inchan =
+  find_proc_id "process_in_pid" (Process_in inchan)
+let process_out_pid outchan =
+  find_proc_id "process_out_pid" (Process_out outchan)
+let process_pid (inchan, outchan) =
+  find_proc_id "process_pid" (Process(inchan, outchan))
+let process_full_pid (inchan, outchan, errchan) =
+  find_proc_id "process_full_pid"
+    (Process_full(inchan, outchan, errchan))
+
+let close_process_in inchan =
+  let proc = Process_in inchan in
+  let pid = find_proc_id "close_process_in" proc in
+  remove_proc_id proc;
+  close_in inchan;
+  snd(waitpid_non_intr pid)
+
+let close_process_out outchan =
+  let proc = Process_out outchan in
+  let pid = find_proc_id "close_process_out" proc in
+  remove_proc_id proc;
+  (* The application may have closed [outchan] already to signal
+     end-of-input to the process.  *)
+  begin try close_out outchan with Sys_error _ -> () end;
+  snd(waitpid_non_intr pid)
+
+let close_process (inchan, outchan) =
+  let proc = Process(inchan, outchan) in
+  let pid = find_proc_id "close_process" proc in
+  remove_proc_id proc;
+  close_in inchan;
+  begin try close_out outchan with Sys_error _ -> () end;
+  snd(waitpid_non_intr pid)
+
+let close_process_full (inchan, outchan, errchan) =
+  let proc = Process_full(inchan, outchan, errchan) in
+  let pid = find_proc_id "close_process_full" proc in
+  remove_proc_id proc;
+  close_in inchan;
+  begin try close_out outchan with Sys_error _ -> () end;
+  close_in errchan;
+  snd(waitpid_non_intr pid)
+
+(* High-level network functions *)
+
+let open_connection sockaddr =
+  let sock =
+    socket ~cloexec:true (domain_of_sockaddr sockaddr) SOCK_STREAM 0 in
+  try
+    connect sock sockaddr;
+    (in_channel_of_descr sock, out_channel_of_descr sock)
+  with exn ->
+    close sock; raise exn
+
+let shutdown_connection inchan =
+  shutdown (descr_of_in_channel inchan) SHUTDOWN_SEND
+
+let rec accept_non_intr s =
+  try accept ~cloexec:true s
+  with Unix_error (EINTR, _, _) -> accept_non_intr s
+
+let establish_server server_fun sockaddr =
+  let sock =
+    socket ~cloexec:true (domain_of_sockaddr sockaddr) SOCK_STREAM 0 in
+  setsockopt sock SO_REUSEADDR true;
+  bind sock sockaddr;
+  listen sock 5;
+  while true do
+    let (s, _caller) = accept_non_intr sock in
+    (* The "double fork" trick, the process which calls server_fun will not
+       leave a zombie process *)
+    match fork() with
+       0 -> if fork() <> 0 then sys_exit 0;
+                                (* The son exits, the grandson works *)
+            close sock;
+            let inchan = in_channel_of_descr s in
+            let outchan = out_channel_of_descr s in
+            server_fun inchan outchan;
+            (* Do not close inchan nor outchan, as the server_fun could
+               have done it already, and we are about to exit anyway
+               (PR#3794) *)
+            exit 0
+    | id -> close s; ignore(waitpid_non_intr id) (* Reclaim the son *)
+  done
diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli
new file mode 100644
index 00000000..ab23cf27
--- /dev/null
+++ b/otherlibs/unix/unix.mli
@@ -0,0 +1,1768 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Interface to the Unix system.
+
+    Note: all the functions of this module (except {!error_message} and
+    {!handle_unix_error}) are liable to raise the {!Unix_error}
+    exception whenever the underlying system call signals an error. *)
+
+
+(** {1 Error report} *)
+
+
+type error =
+    E2BIG               (** Argument list too long *)
+  | EACCES              (** Permission denied *)
+  | EAGAIN              (** Resource temporarily unavailable; try again *)
+  | EBADF               (** Bad file descriptor *)
+  | EBUSY               (** Resource unavailable *)
+  | ECHILD              (** No child process *)
+  | EDEADLK             (** Resource deadlock would occur *)
+  | EDOM                (** Domain error for math functions, etc. *)
+  | EEXIST              (** File exists *)
+  | EFAULT              (** Bad address *)
+  | EFBIG               (** File too large *)
+  | EINTR               (** Function interrupted by signal *)
+  | EINVAL              (** Invalid argument *)
+  | EIO                 (** Hardware I/O error *)
+  | EISDIR              (** Is a directory *)
+  | EMFILE              (** Too many open files by the process *)
+  | EMLINK              (** Too many links *)
+  | ENAMETOOLONG        (** Filename too long *)
+  | ENFILE              (** Too many open files in the system *)
+  | ENODEV              (** No such device *)
+  | ENOENT              (** No such file or directory *)
+  | ENOEXEC             (** Not an executable file *)
+  | ENOLCK              (** No locks available *)
+  | ENOMEM              (** Not enough memory *)
+  | ENOSPC              (** No space left on device *)
+  | ENOSYS              (** Function not supported *)
+  | ENOTDIR             (** Not a directory *)
+  | ENOTEMPTY           (** Directory not empty *)
+  | ENOTTY              (** Inappropriate I/O control operation *)
+  | ENXIO               (** No such device or address *)
+  | EPERM               (** Operation not permitted *)
+  | EPIPE               (** Broken pipe *)
+  | ERANGE              (** Result too large *)
+  | EROFS               (** Read-only file system *)
+  | ESPIPE              (** Invalid seek e.g. on a pipe *)
+  | ESRCH               (** No such process *)
+  | EXDEV               (** Invalid link *)
+  | EWOULDBLOCK         (** Operation would block *)
+  | EINPROGRESS         (** Operation now in progress *)
+  | EALREADY            (** Operation already in progress *)
+  | ENOTSOCK            (** Socket operation on non-socket *)
+  | EDESTADDRREQ        (** Destination address required *)
+  | EMSGSIZE            (** Message too long *)
+  | EPROTOTYPE          (** Protocol wrong type for socket *)
+  | ENOPROTOOPT         (** Protocol not available *)
+  | EPROTONOSUPPORT     (** Protocol not supported *)
+  | ESOCKTNOSUPPORT     (** Socket type not supported *)
+  | EOPNOTSUPP          (** Operation not supported on socket *)
+  | EPFNOSUPPORT        (** Protocol family not supported *)
+  | EAFNOSUPPORT        (** Address family not supported by protocol family *)
+  | EADDRINUSE          (** Address already in use *)
+  | EADDRNOTAVAIL       (** Can't assign requested address *)
+  | ENETDOWN            (** Network is down *)
+  | ENETUNREACH         (** Network is unreachable *)
+  | ENETRESET           (** Network dropped connection on reset *)
+  | ECONNABORTED        (** Software caused connection abort *)
+  | ECONNRESET          (** Connection reset by peer *)
+  | ENOBUFS             (** No buffer space available *)
+  | EISCONN             (** Socket is already connected *)
+  | ENOTCONN            (** Socket is not connected *)
+  | ESHUTDOWN           (** Can't send after socket shutdown *)
+  | ETOOMANYREFS        (** Too many references: can't splice *)
+  | ETIMEDOUT           (** Connection timed out *)
+  | ECONNREFUSED        (** Connection refused *)
+  | EHOSTDOWN           (** Host is down *)
+  | EHOSTUNREACH        (** No route to host *)
+  | ELOOP               (** Too many levels of symbolic links *)
+  | EOVERFLOW           (** File size or position not representable *)
+
+  | EUNKNOWNERR of int  (** Unknown error *)
+(** The type of error codes.
+   Errors defined in the POSIX standard
+   and additional errors from UNIX98 and BSD.
+   All other errors are mapped to EUNKNOWNERR.
+*)
+
+
+exception Unix_error of error * string * string
+(** Raised by the system calls below when an error is encountered.
+   The first component is the error code; the second component
+   is the function name; the third component is the string parameter
+   to the function, if it has one, or the empty string otherwise. *)
+
+val error_message : error -> string
+(** Return a string describing the given error code. *)
+
+val handle_unix_error : ('a -> 'b) -> 'a -> 'b
+(** [handle_unix_error f x] applies [f] to [x] and returns the result.
+   If the exception {!Unix_error} is raised, it prints a message
+   describing the error and exits with code 2. *)
+
+
+(** {1 Access to the process environment} *)
+
+
+val environment : unit -> string array
+(** Return the process environment, as an array of strings
+    with the format ``variable=value''.  The returned array
+    is empty if the process has special privileges. *)
+
+val unsafe_environment : unit -> string array
+(** Return the process environment, as an array of strings with the
+    format ``variable=value''.  Unlike {!environment}, this function
+    returns a populated array even if the process has special
+    privileges.  See the documentation for {!unsafe_getenv} for more
+    details.
+
+    @since 4.06.0 *)
+
+val getenv : string -> string
+(** Return the value associated to a variable in the process
+   environment, unless the process has special privileges.
+   @raise Not_found if the variable is unbound or the process has
+   special privileges.
+
+   (This function is identical to {!Sys.getenv}. *)
+
+val unsafe_getenv : string -> string
+(** Return the value associated to a variable in the process
+   environment.
+
+   Unlike {!getenv}, this function returns the value even if the
+   process has special privileges. It is considered unsafe because the
+   programmer of a setuid or setgid program must be careful to avoid
+   using maliciously crafted environment variables in the search path
+   for executables, the locations for temporary files or logs, and the
+   like.
+
+   @raise Not_found if the variable is unbound.
+   @since 4.06.0  *)
+
+val putenv : string -> string -> unit
+(** [Unix.putenv name value] sets the value associated to a
+   variable in the process environment.
+   [name] is the name of the environment variable,
+   and [value] its new associated value. *)
+
+
+(** {1 Process handling} *)
+
+
+type process_status =
+    WEXITED of int
+        (** The process terminated normally by [exit];
+           the argument is the return code. *)
+  | WSIGNALED of int
+        (** The process was killed by a signal;
+           the argument is the signal number. *)
+  | WSTOPPED of int
+        (** The process was stopped by a signal; the argument is the
+           signal number. *)
+(** The termination status of a process.  See module {!Sys} for the
+    definitions of the standard signal numbers.  Note that they are
+    not the numbers used by the OS. *)
+
+
+type wait_flag =
+    WNOHANG (** Do not block if no child has
+               died yet, but immediately return with a pid equal to 0.*)
+  | WUNTRACED (** Report also the children that receive stop signals. *)
+(** Flags for {!Unix.waitpid}. *)
+
+val execv : string -> string array -> 'a
+(** [execv prog args] execute the program in file [prog], with
+   the arguments [args], and the current process environment.
+   These [execv*] functions never return: on success, the current
+   program is replaced by the new one.
+   @raise Unix.Unix_error on failure. *)
+
+val execve : string -> string array -> string array -> 'a
+(** Same as {!Unix.execv}, except that the third argument provides the
+   environment to the program executed. *)
+
+val execvp : string -> string array -> 'a
+(** Same as {!Unix.execv}, except that
+   the program is searched in the path. *)
+
+val execvpe : string -> string array -> string array -> 'a
+(** Same as {!Unix.execve}, except that
+   the program is searched in the path. *)
+
+val fork : unit -> int
+(** Fork a new process. The returned integer is 0 for the child
+   process, the pid of the child process for the parent process.
+
+   On Windows: not implemented, use {!create_process} or threads. *)
+
+val wait : unit -> int * process_status
+(** Wait until one of the children processes die, and return its pid
+   and termination status.
+
+   On Windows: Not implemented, use {!waitpid}. *)
+
+val waitpid : wait_flag list -> int -> int * process_status
+(** Same as {!Unix.wait}, but waits for the child process whose pid is given.
+   A pid of [-1] means wait for any child.
+   A pid of [0] means wait for any child in the same process group
+   as the current process.
+   Negative pid arguments represent process groups.
+   The list of options indicates whether [waitpid] should return
+   immediately without waiting, and whether it should report stopped
+   children.
+
+   On Windows, this function can only wait for a given PID, not any
+   child process. *)
+
+val system : string -> process_status
+(** Execute the given command, wait until it terminates, and return
+   its termination status. The string is interpreted by the shell
+   [/bin/sh] (or the command interpreter [cmd.exe] on Windows) and
+   therefore can contain redirections, quotes, variables, etc.
+   To properly quote whitespace and shell special characters occurring
+   in file names or command arguments, the use of
+   {!Filename.quote_command} is recommended.
+   The result [WEXITED 127] indicates that the shell couldn't be
+   executed. *)
+
+val getpid : unit -> int
+(** Return the pid of the process. *)
+
+val getppid : unit -> int
+(** Return the pid of the parent process.
+   On Windows: not implemented (because it is meaningless). *)
+
+val nice : int -> int
+(** Change the process priority. The integer argument is added to the
+   ``nice'' value. (Higher values of the ``nice'' value mean
+   lower priorities.) Return the new nice value.
+
+   On Windows: not implemented. *)
+
+
+(** {1 Basic file input/output} *)
+
+
+type file_descr
+(** The abstract type of file descriptors. *)
+
+val stdin : file_descr
+(** File descriptor for standard input.*)
+
+val stdout : file_descr
+(** File descriptor for standard output.*)
+
+val stderr : file_descr
+(** File descriptor for standard error. *)
+
+type open_flag =
+    O_RDONLY                    (** Open for reading *)
+  | O_WRONLY                    (** Open for writing *)
+  | O_RDWR                      (** Open for reading and writing *)
+  | O_NONBLOCK                  (** Open in non-blocking mode *)
+  | O_APPEND                    (** Open for append *)
+  | O_CREAT                     (** Create if nonexistent *)
+  | O_TRUNC                     (** Truncate to 0 length if existing *)
+  | O_EXCL                      (** Fail if existing *)
+  | O_NOCTTY                    (** Don't make this dev a controlling tty *)
+  | O_DSYNC                     (** Writes complete as `Synchronised I/O data
+                                   integrity completion' *)
+  | O_SYNC                      (** Writes complete as `Synchronised I/O file
+                                   integrity completion' *)
+  | O_RSYNC                     (** Reads complete as writes (depending on
+                                   O_SYNC/O_DSYNC) *)
+  | O_SHARE_DELETE              (** Windows only: allow the file to be deleted
+                                   while still open *)
+  | O_CLOEXEC                   (** Set the close-on-exec flag on the
+                                   descriptor returned by {!openfile}.
+                                   See {!set_close_on_exec} for more
+                                   information. *)
+  | O_KEEPEXEC                  (** Clear the close-on-exec flag.
+                                    This is currently the default. *)
+(** The flags to {!Unix.openfile}. *)
+
+
+type file_perm = int
+(** The type of file access rights, e.g. [0o640] is read and write for user,
+    read for group, none for others *)
+
+val openfile : string -> open_flag list -> file_perm -> file_descr
+(** Open the named file with the given flags. Third argument is the
+   permissions to give to the file if it is created (see
+   {!umask}). Return a file descriptor on the named file. *)
+
+val close : file_descr -> unit
+(** Close a file descriptor. *)
+
+val fsync : file_descr -> unit
+(** Flush file buffers to disk. *)
+
+val read : file_descr -> bytes -> int -> int -> int
+(** [read fd buff ofs len] reads [len] bytes from descriptor [fd],
+    storing them in byte sequence [buff], starting at position [ofs] in
+    [buff]. Return the number of bytes actually read. *)
+
+val write : file_descr -> bytes -> int -> int -> int
+(** [write fd buff ofs len] writes [len] bytes to descriptor [fd],
+    taking them from byte sequence [buff], starting at position [ofs]
+    in [buff]. Return the number of bytes actually written.  [write]
+    repeats the writing operation until all bytes have been written or
+    an error occurs.  *)
+
+val single_write : file_descr -> bytes -> int -> int -> int
+(** Same as [write], but attempts to write only once.
+   Thus, if an error occurs, [single_write] guarantees that no data
+   has been written. *)
+
+val write_substring : file_descr -> string -> int -> int -> int
+(** Same as [write], but take the data from a string instead of a byte
+    sequence.
+    @since 4.02.0 *)
+
+val single_write_substring : file_descr -> string -> int -> int -> int
+(** Same as [single_write], but take the data from a string instead of
+    a byte sequence.
+    @since 4.02.0 *)
+
+(** {1 Interfacing with the standard input/output library} *)
+
+
+
+val in_channel_of_descr : file_descr -> in_channel
+(** Create an input channel reading from the given descriptor.
+   The channel is initially in binary mode; use
+   [set_binary_mode_in ic false] if text mode is desired.
+   Text mode is supported only if the descriptor refers to a file
+   or pipe, but is not supported if it refers to a socket.
+   On Windows, [set_binary_mode_in] always fails on channels created
+   with this function.
+
+   Beware that channels are buffered so more characters may have been
+   read from the file descriptor than those accessed using channel functions.
+   Channels also keep a copy of the current position in the file.
+
+   You need to explicitly close all channels created with this function.
+   Closing the channel also closes the underlying file descriptor (unless
+   it was already closed). *)
+
+val out_channel_of_descr : file_descr -> out_channel
+(** Create an output channel writing on the given descriptor.
+   The channel is initially in binary mode; use
+   [set_binary_mode_out oc false] if text mode is desired.
+   Text mode is supported only if the descriptor refers to a file
+   or pipe, but is not supported if it refers to a socket.
+   On Windows, [set_binary_mode_out] always fails on channels created
+   with this function.
+
+   Beware that channels are buffered so you may have to [flush] them
+   to ensure that all data has been sent to the file descriptor.
+   Channels also keep a copy of the current position in the file.
+
+   You need to explicitly close all channels created with this function.
+   Closing the channel flushes the data and closes the underlying file
+   descriptor (unless it has already been closed, in which case the
+   buffered data is lost).*)
+
+val descr_of_in_channel : in_channel -> file_descr
+(** Return the descriptor corresponding to an input channel. *)
+
+val descr_of_out_channel : out_channel -> file_descr
+(** Return the descriptor corresponding to an output channel. *)
+
+
+(** {1 Seeking and truncating} *)
+
+
+type seek_command =
+    SEEK_SET (** indicates positions relative to the beginning of the file *)
+  | SEEK_CUR (** indicates positions relative to the current position *)
+  | SEEK_END (** indicates positions relative to the end of the file *)
+(** Positioning modes for {!Unix.lseek}. *)
+
+
+val lseek : file_descr -> int -> seek_command -> int
+(** Set the current position for a file descriptor, and return the resulting
+    offset (from the beginning of the file). *)
+
+val truncate : string -> int -> unit
+(** Truncates the named file to the given size. *)
+
+val ftruncate : file_descr -> int -> unit
+(** Truncates the file corresponding to the given descriptor
+   to the given size. *)
+
+
+(** {1 File status} *)
+
+
+type file_kind =
+    S_REG                       (** Regular file *)
+  | S_DIR                       (** Directory *)
+  | S_CHR                       (** Character device *)
+  | S_BLK                       (** Block device *)
+  | S_LNK                       (** Symbolic link *)
+  | S_FIFO                      (** Named pipe *)
+  | S_SOCK                      (** Socket *)
+
+type stats =
+  { st_dev : int;               (** Device number *)
+    st_ino : int;               (** Inode number *)
+    st_kind : file_kind;        (** Kind of the file *)
+    st_perm : file_perm;        (** Access rights *)
+    st_nlink : int;             (** Number of links *)
+    st_uid : int;               (** User id of the owner *)
+    st_gid : int;               (** Group ID of the file's group *)
+    st_rdev : int;              (** Device ID (if special file) *)
+    st_size : int;              (** Size in bytes *)
+    st_atime : float;           (** Last access time *)
+    st_mtime : float;           (** Last modification time *)
+    st_ctime : float;           (** Last status change time *)
+  }
+(** The information returned by the {!Unix.stat} calls. *)
+
+val stat : string -> stats
+(** Return the information for the named file. *)
+
+val lstat : string -> stats
+(** Same as {!Unix.stat}, but in case the file is a symbolic link,
+   return the information for the link itself. *)
+
+val fstat : file_descr -> stats
+(** Return the information for the file associated with the given
+   descriptor. *)
+
+val isatty : file_descr -> bool
+(** Return [true] if the given file descriptor refers to a terminal or
+   console window, [false] otherwise. *)
+
+(** {1 File operations on large files} *)
+
+module LargeFile :
+  sig
+    val lseek : file_descr -> int64 -> seek_command -> int64
+    (** See {!Unix.lseek}. *)
+
+    val truncate : string -> int64 -> unit
+    (** See {!Unix.truncate}. *)
+
+    val ftruncate : file_descr -> int64 -> unit
+    (** See {!Unix.ftruncate}. *)
+
+    type stats =
+      { st_dev : int;               (** Device number *)
+        st_ino : int;               (** Inode number *)
+        st_kind : file_kind;        (** Kind of the file *)
+        st_perm : file_perm;        (** Access rights *)
+        st_nlink : int;             (** Number of links *)
+        st_uid : int;               (** User id of the owner *)
+        st_gid : int;               (** Group ID of the file's group *)
+        st_rdev : int;              (** Device ID (if special file) *)
+        st_size : int64;            (** Size in bytes *)
+        st_atime : float;           (** Last access time *)
+        st_mtime : float;           (** Last modification time *)
+        st_ctime : float;           (** Last status change time *)
+      }
+    val stat : string -> stats
+    val lstat : string -> stats
+    val fstat : file_descr -> stats
+  end
+(** File operations on large files.
+  This sub-module provides 64-bit variants of the functions
+  {!Unix.lseek} (for positioning a file descriptor),
+  {!Unix.truncate} and {!Unix.ftruncate} (for changing the size of a file),
+  and {!Unix.stat}, {!Unix.lstat} and {!Unix.fstat} (for obtaining
+  information on files).  These alternate functions represent
+  positions and sizes by 64-bit integers (type [int64]) instead of
+  regular integers (type [int]), thus allowing operating on files
+  whose sizes are greater than [max_int]. *)
+
+(** {1 Mapping files into memory} *)
+
+val map_file :
+  file_descr -> ?pos:int64 -> ('a, 'b) Stdlib.Bigarray.kind ->
+  'c Stdlib.Bigarray.layout -> bool -> int array ->
+  ('a, 'b, 'c) Stdlib.Bigarray.Genarray.t
+(** Memory mapping of a file as a Bigarray.
+  [map_file fd kind layout shared dims]
+  returns a Bigarray of kind [kind], layout [layout],
+  and dimensions as specified in [dims].  The data contained in
+  this Bigarray are the contents of the file referred to by
+  the file descriptor [fd] (as opened previously with
+  [Unix.openfile], for example).  The optional [pos] parameter
+  is the byte offset in the file of the data being mapped;
+  it defaults to 0 (map from the beginning of the file).
+
+  If [shared] is [true], all modifications performed on the array
+  are reflected in the file.  This requires that [fd] be opened
+  with write permissions.  If [shared] is [false], modifications
+  performed on the array are done in memory only, using
+  copy-on-write of the modified pages; the underlying file is not
+  affected.
+
+  [Genarray.map_file] is much more efficient than reading
+  the whole file in a Bigarray, modifying that Bigarray,
+  and writing it afterwards.
+
+  To adjust automatically the dimensions of the Bigarray to
+  the actual size of the file, the major dimension (that is,
+  the first dimension for an array with C layout, and the last
+  dimension for an array with Fortran layout) can be given as
+  [-1].  [Genarray.map_file] then determines the major dimension
+  from the size of the file.  The file must contain an integral
+  number of sub-arrays as determined by the non-major dimensions,
+  otherwise [Failure] is raised.
+
+  If all dimensions of the Bigarray are given, the file size is
+  matched against the size of the Bigarray.  If the file is larger
+  than the Bigarray, only the initial portion of the file is
+  mapped to the Bigarray.  If the file is smaller than the big
+  array, the file is automatically grown to the size of the Bigarray.
+  This requires write permissions on [fd].
+
+  Array accesses are bounds-checked, but the bounds are determined by
+  the initial call to [map_file]. Therefore, you should make sure no
+  other process modifies the mapped file while you're accessing it,
+  or a SIGBUS signal may be raised. This happens, for instance, if the
+  file is shrunk.
+
+  [Invalid_argument] or [Failure] may be raised in cases where argument
+  validation fails.
+  @since 4.06.0 *)
+
+(** {1 Operations on file names} *)
+
+
+val unlink : string -> unit
+(** Removes the named file.
+
+    If the named file is a directory, raises:
+    {ul
+    {- [EPERM] on POSIX compliant system}
+    {- [EISDIR] on Linux >= 2.1.132}
+    {- [EACCESS] on Windows}}
+*)
+
+val rename : string -> string -> unit
+(** [rename old new] changes the name of a file from [old] to [new],
+    moving it between directories if needed.  If [new] already
+    exists, its contents will be replaced with those of [old].
+    Depending on the operating system, the metadata (permissions,
+    owner, etc) of [new] can either be preserved or be replaced by
+    those of [old].  *)
+
+val link :  ?follow:bool -> string -> string -> unit
+(** [link ?follow source dest] creates a hard link named [dest] to the file
+   named [source].
+
+   @param follow indicates whether a [source] symlink is followed or a
+   hardlink to [source] itself will be created. On {e Unix} systems this is
+   done using the [linkat(2)] function. If [?follow] is not provided, then the
+   [link(2)] function is used whose behaviour is OS-dependent, but more widely
+   available.
+
+   @raise ENOSYS On {e Unix} if [~follow:_] is requested, but linkat is
+                 unavailable.
+   @raise ENOSYS On {e Windows} if [~follow:false] is requested. *)
+
+
+(** {1 File permissions and ownership} *)
+
+
+type access_permission =
+    R_OK                        (** Read permission *)
+  | W_OK                        (** Write permission *)
+  | X_OK                        (** Execution permission *)
+  | F_OK                        (** File exists *)
+(** Flags for the {!Unix.access} call. *)
+
+
+val chmod : string -> file_perm -> unit
+(** Change the permissions of the named file. *)
+
+val fchmod : file_descr -> file_perm -> unit
+(** Change the permissions of an opened file.
+    On Windows: not implemented. *)
+
+val chown : string -> int -> int -> unit
+(** Change the owner uid and owner gid of the named file.
+    On Windows: not implemented (make no sense on a DOS file system). *)
+
+val fchown : file_descr -> int -> int -> unit
+(** Change the owner uid and owner gid of an opened file.
+    On Windows: not implemented (make no sense on a DOS file system).  *)
+
+val umask : int -> int
+(** Set the process's file mode creation mask, and return the previous
+    mask.
+    On Windows: not implemented. *)
+
+val access : string -> access_permission list -> unit
+(** Check that the process has the given permissions over the named file.
+   @raise Unix_error otherwise.
+
+   On Windows, execute permission [X_OK], cannot be tested, it just
+   tests for read permission instead. *)
+
+
+(** {1 Operations on file descriptors} *)
+
+
+val dup : ?cloexec:bool -> file_descr -> file_descr
+(** Return a new file descriptor referencing the same file as
+   the given descriptor.
+   See {!set_close_on_exec} for documentation on the [cloexec]
+   optional argument. *)
+
+val dup2 : ?cloexec:bool -> file_descr -> file_descr -> unit
+(** [dup2 fd1 fd2] duplicates [fd1] to [fd2], closing [fd2] if already
+   opened.
+   See {!set_close_on_exec} for documentation on the [cloexec]
+   optional argument. *)
+
+val set_nonblock : file_descr -> unit
+(** Set the ``non-blocking'' flag on the given descriptor.
+   When the non-blocking flag is set, reading on a descriptor
+   on which there is temporarily no data available raises the
+   [EAGAIN] or [EWOULDBLOCK] error instead of blocking;
+   writing on a descriptor on which there is temporarily no room
+   for writing also raises [EAGAIN] or [EWOULDBLOCK]. *)
+
+val clear_nonblock : file_descr -> unit
+(** Clear the ``non-blocking'' flag on the given descriptor.
+   See {!Unix.set_nonblock}.*)
+
+val set_close_on_exec : file_descr -> unit
+(** Set the ``close-on-exec'' flag on the given descriptor.
+   A descriptor with the close-on-exec flag is automatically
+   closed when the current process starts another program with
+   one of the [exec], [create_process] and [open_process] functions.
+
+   It is often a security hole to leak file descriptors opened on, say,
+   a private file to an external program: the program, then, gets access
+   to the private file and can do bad things with it.  Hence, it is
+   highly recommended to set all file descriptors ``close-on-exec'',
+   except in the very few cases where a file descriptor actually needs
+   to be transmitted to another program.
+
+   The best way to set a file descriptor ``close-on-exec'' is to create
+   it in this state.  To this end, the [openfile] function has
+   [O_CLOEXEC] and [O_KEEPEXEC] flags to enforce ``close-on-exec'' mode
+   or ``keep-on-exec'' mode, respectively.  All other operations in
+   the Unix module that create file descriptors have an optional
+   argument [?cloexec:bool] to indicate whether the file descriptor
+   should be created in ``close-on-exec'' mode (by writing
+   [~cloexec:true]) or in ``keep-on-exec'' mode (by writing
+   [~cloexec:false]).  For historical reasons, the default file
+   descriptor creation mode is ``keep-on-exec'', if no [cloexec] optional
+   argument is given.  This is not a safe default, hence it is highly
+   recommended to pass explicit [cloexec] arguments to operations that
+   create file descriptors.
+
+   The [cloexec] optional arguments and the [O_KEEPEXEC] flag were introduced
+   in OCaml 4.05.  Earlier, the common practice was to create file descriptors
+   in the default, ``keep-on-exec'' mode, then call [set_close_on_exec]
+   on those freshly-created file descriptors.  This is not as safe as
+   creating the file descriptor in ``close-on-exec'' mode because, in
+   multithreaded programs, a window of vulnerability exists between the time
+   when the file descriptor is created and the time [set_close_on_exec]
+   completes.  If another thread spawns another program during this window,
+   the descriptor will leak, as it is still in the ``keep-on-exec'' mode.
+
+   Regarding the atomicity guarantees given by [~cloexec:true] or by
+   the use of the [O_CLOEXEC] flag: on all platforms it is guaranteed
+   that a concurrently-executing Caml thread cannot leak the descriptor
+   by starting a new process.  On Linux, this guarantee extends to
+   concurrently-executing C threads.  As of Feb 2017, other operating
+   systems lack the necessary system calls and still expose a window
+   of vulnerability during which a C thread can see the newly-created
+   file descriptor in ``keep-on-exec'' mode.
+ *)
+
+val clear_close_on_exec : file_descr -> unit
+(** Clear the ``close-on-exec'' flag on the given descriptor.
+   See {!Unix.set_close_on_exec}.*)
+
+
+(** {1 Directories} *)
+
+
+val mkdir : string -> file_perm -> unit
+(** Create a directory with the given permissions (see {!umask}). *)
+
+val rmdir : string -> unit
+(** Remove an empty directory. *)
+
+val chdir : string -> unit
+(** Change the process working directory. *)
+
+val getcwd : unit -> string
+(** Return the name of the current working directory. *)
+
+val chroot : string -> unit
+(** Change the process root directory.
+    On Windows: not implemented. *)
+
+type dir_handle
+(** The type of descriptors over opened directories. *)
+
+val opendir : string -> dir_handle
+(** Open a descriptor on a directory *)
+
+val readdir : dir_handle -> string
+(** Return the next entry in a directory.
+   @raise End_of_file when the end of the directory has been reached. *)
+
+val rewinddir : dir_handle -> unit
+(** Reposition the descriptor to the beginning of the directory *)
+
+val closedir : dir_handle -> unit
+(** Close a directory descriptor. *)
+
+
+
+(** {1 Pipes and redirections} *)
+
+
+val pipe : ?cloexec:bool -> unit -> file_descr * file_descr
+(** Create a pipe. The first component of the result is opened
+   for reading, that's the exit to the pipe. The second component is
+   opened for writing, that's the entrance to the pipe.
+   See {!set_close_on_exec} for documentation on the [cloexec]
+   optional argument. *)
+
+val mkfifo : string -> file_perm -> unit
+(** Create a named pipe with the given permissions (see {!umask}).
+   On Windows: not implemented. *)
+
+
+(** {1 High-level process and redirection management} *)
+
+
+val create_process :
+  string -> string array -> file_descr -> file_descr -> file_descr -> int
+(** [create_process prog args new_stdin new_stdout new_stderr]
+   forks a new process that executes the program
+   in file [prog], with arguments [args]. The pid of the new
+   process is returned immediately; the new process executes
+   concurrently with the current process.
+   The standard input and outputs of the new process are connected
+   to the descriptors [new_stdin], [new_stdout] and [new_stderr].
+   Passing e.g. [stdout] for [new_stdout] prevents the redirection
+   and causes the new process to have the same standard output
+   as the current process.
+   The executable file [prog] is searched in the path.
+   The new process has the same environment as the current process. *)
+
+val create_process_env :
+  string -> string array -> string array -> file_descr -> file_descr ->
+    file_descr -> int
+(** [create_process_env prog args env new_stdin new_stdout new_stderr]
+   works as {!Unix.create_process}, except that the extra argument
+   [env] specifies the environment passed to the program. *)
+
+
+val open_process_in : string -> in_channel
+(** High-level pipe and process management. This function
+   runs the given command in parallel with the program.
+   The standard output of the command is redirected to a pipe,
+   which can be read via the returned input channel.
+   The command is interpreted by the shell [/bin/sh]
+   (or [cmd.exe] on Windows), cf. {!Unix.system}.
+   The {!Filename.quote_command} function can be used to
+   quote the command and its arguments as appropriate for the shell being
+   used.  If the command does not need to be run through the shell,
+   {!Unix.open_process_args_in} can be used as a more robust and
+   more efficient alternative to {!Unix.open_process_in}. *)
+
+val open_process_out : string -> out_channel
+(** Same as {!Unix.open_process_in}, but redirect the standard input of
+   the command to a pipe.  Data written to the returned output channel
+   is sent to the standard input of the command.
+   Warning: writes on output channels are buffered, hence be careful
+   to call {!Stdlib.flush} at the right times to ensure
+   correct synchronization.
+   If the command does not need to be run through the shell,
+   {!Unix.open_process_args_out} can be used instead of
+   {!Unix.open_process_out}. *)
+
+val open_process : string -> in_channel * out_channel
+(** Same as {!Unix.open_process_out}, but redirects both the standard input
+   and standard output of the command to pipes connected to the two
+   returned channels.  The input channel is connected to the output
+   of the command, and the output channel to the input of the command.
+   If the command does not need to be run through the shell,
+   {!Unix.open_process_args} can be used instead of
+   {!Unix.open_process}. *)
+
+val open_process_full :
+  string -> string array -> in_channel * out_channel * in_channel
+(** Similar to {!Unix.open_process}, but the second argument specifies
+   the environment passed to the command.  The result is a triple
+   of channels connected respectively to the standard output, standard input,
+   and standard error of the command.
+   If the command does not need to be run through the shell,
+   {!Unix.open_process_args_full} can be used instead of
+   {!Unix.open_process_full}. *)
+
+val open_process_args_in : string -> string array -> in_channel
+(** High-level pipe and process management. The first argument specifies the
+   command to run, and the second argument specifies the argument array passed
+   to the command.  This function runs the command in parallel with the program.
+   The standard output of the command is redirected to a pipe, which can be read
+   via the returned input channel.
+
+    @since 4.08.0 *)
+
+val open_process_args_out : string -> string array -> out_channel
+(** Same as {!Unix.open_process_args_in}, but redirect the standard input of the
+   command to a pipe.  Data written to the returned output channel is sent to
+   the standard input of the command.  Warning: writes on output channels are
+   buffered, hence be careful to call {!Stdlib.flush} at the right times to
+   ensure correct synchronization.
+
+    @since 4.08.0 *)
+
+val open_process_args : string -> string array -> in_channel * out_channel
+(** Same as {!Unix.open_process_args_out}, but redirects both the standard input
+   and standard output of the command to pipes connected to the two returned
+   channels.  The input channel is connected to the output of the command, and
+   the output channel to the input of the command.
+
+    @since 4.08.0 *)
+
+val open_process_args_full :
+  string -> string array -> string array ->
+    in_channel * out_channel * in_channel
+(** Similar to {!Unix.open_process_args}, but the third argument specifies the
+   environment passed to the command.  The result is a triple of channels
+   connected respectively to the standard output, standard input, and standard
+   error of the command.
+
+    @since 4.08.0 *)
+
+val process_in_pid : in_channel -> int
+(** Return the pid of a process opened via {!Unix.open_process_in} or
+   {!Unix.open_process_args_in}.
+
+    @since 4.08.0 *)
+
+val process_out_pid : out_channel -> int
+(** Return the pid of a process opened via {!Unix.open_process_out} or
+   {!Unix.open_process_args_out}.
+
+    @since 4.08.0 *)
+
+val process_pid : in_channel * out_channel -> int
+(** Return the pid of a process opened via {!Unix.open_process} or
+   {!Unix.open_process_args}.
+
+    @since 4.08.0 *)
+
+val process_full_pid : in_channel * out_channel * in_channel -> int
+(** Return the pid of a process opened via {!Unix.open_process_full} or
+   {!Unix.open_process_args_full}.
+
+    @since 4.08.0 *)
+
+val close_process_in : in_channel -> process_status
+(** Close channels opened by {!Unix.open_process_in},
+   wait for the associated command to terminate,
+   and return its termination status. *)
+
+val close_process_out : out_channel -> process_status
+(** Close channels opened by {!Unix.open_process_out},
+   wait for the associated command to terminate,
+   and return its termination status. *)
+
+val close_process : in_channel * out_channel -> process_status
+(** Close channels opened by {!Unix.open_process},
+   wait for the associated command to terminate,
+   and return its termination status. *)
+
+val close_process_full :
+  in_channel * out_channel * in_channel -> process_status
+(** Close channels opened by {!Unix.open_process_full},
+   wait for the associated command to terminate,
+   and return its termination status. *)
+
+
+(** {1 Symbolic links} *)
+
+
+val symlink : ?to_dir:bool -> string -> string -> unit
+(** [symlink ?to_dir source dest] creates the file [dest] as a symbolic link
+   to the file [source]. On Windows, [~to_dir] indicates if the symbolic link
+   points to a directory or a file; if omitted, [symlink] examines [source]
+   using [stat] and picks appropriately, if [source] does not exist then [false]
+   is assumed (for this reason, it is recommended that the [~to_dir] parameter
+   be specified in new code). On Unix, [~to_dir] is ignored.
+
+   Windows symbolic links are available in Windows Vista onwards. There are some
+   important differences between Windows symlinks and their POSIX counterparts.
+
+   Windows symbolic links come in two flavours: directory and regular, which
+   designate whether the symbolic link points to a directory or a file. The type
+   must be correct - a directory symlink which actually points to a file cannot
+   be selected with chdir and a file symlink which actually points to a
+   directory cannot be read or written (note that Cygwin's emulation layer
+   ignores this distinction).
+
+   When symbolic links are created to existing targets, this distinction doesn't
+   matter and [symlink] will automatically create the correct kind of symbolic
+   link. The distinction matters when a symbolic link is created to a
+   non-existent target.
+
+   The other caveat is that by default symbolic links are a privileged
+   operation. Administrators will always need to be running elevated (or with
+   UAC disabled) and by default normal user accounts need to be granted the
+   SeCreateSymbolicLinkPrivilege via Local Security Policy (secpol.msc) or via
+   Active Directory.
+
+   {!has_symlink} can be used to check that a process is able to create symbolic
+   links. *)
+
+val has_symlink : unit -> bool
+(** Returns [true] if the user is able to create symbolic links. On Windows,
+   this indicates that the user not only has the SeCreateSymbolicLinkPrivilege
+   but is also running elevated, if necessary. On other platforms, this is
+   simply indicates that the symlink system call is available.
+   @since 4.03.0 *)
+
+val readlink : string -> string
+(** Read the contents of a symbolic link. *)
+
+
+(** {1 Polling} *)
+
+
+val select :
+  file_descr list -> file_descr list -> file_descr list -> float ->
+    file_descr list * file_descr list * file_descr list
+(** Wait until some input/output operations become possible on
+   some channels. The three list arguments are, respectively, a set
+   of descriptors to check for reading (first argument), for writing
+   (second argument), or for exceptional conditions (third argument).
+   The fourth argument is the maximal timeout, in seconds; a
+   negative fourth argument means no timeout (unbounded wait).
+   The result is composed of three sets of descriptors: those ready
+   for reading (first component), ready for writing (second component),
+   and over which an exceptional condition is pending (third
+   component). *)
+
+
+(** {1 Locking} *)
+
+type lock_command =
+    F_ULOCK       (** Unlock a region *)
+  | F_LOCK        (** Lock a region for writing, and block if already locked *)
+  | F_TLOCK       (** Lock a region for writing, or fail if already locked *)
+  | F_TEST        (** Test a region for other process locks *)
+  | F_RLOCK       (** Lock a region for reading, and block if already locked *)
+  | F_TRLOCK      (** Lock a region for reading, or fail if already locked *)
+(** Commands for {!Unix.lockf}. *)
+
+val lockf : file_descr -> lock_command -> int -> unit
+(** [lockf fd cmd size] puts a lock on a region of the file opened
+   as [fd]. The region starts at the current read/write position for
+   [fd] (as set by {!Unix.lseek}), and extends [size] bytes forward if
+   [size] is positive, [size] bytes backwards if [size] is negative,
+   or to the end of the file if [size] is zero.
+   A write lock prevents any other
+   process from acquiring a read or write lock on the region.
+   A read lock prevents any other
+   process from acquiring a write lock on the region, but lets
+   other processes acquire read locks on it.
+
+   The [F_LOCK] and [F_TLOCK] commands attempts to put a write lock
+   on the specified region.
+   The [F_RLOCK] and [F_TRLOCK] commands attempts to put a read lock
+   on the specified region.
+   If one or several locks put by another process prevent the current process
+   from acquiring the lock, [F_LOCK] and [F_RLOCK] block until these locks
+   are removed, while [F_TLOCK] and [F_TRLOCK] fail immediately with an
+   exception.
+   The [F_ULOCK] removes whatever locks the current process has on
+   the specified region.
+   Finally, the [F_TEST] command tests whether a write lock can be
+   acquired on the specified region, without actually putting a lock.
+   It returns immediately if successful, or fails otherwise.
+
+   What happens when a process tries to lock a region of a file that is
+   already locked by the same process depends on the OS.  On POSIX-compliant
+   systems, the second lock operation succeeds and may "promote" the older
+   lock from read lock to write lock.  On Windows, the second lock
+   operation will block or fail.
+*)
+
+
+(** {1 Signals}
+   Note: installation of signal handlers is performed via
+   the functions {!Sys.signal} and {!Sys.set_signal}.
+*)
+
+val kill : int -> int -> unit
+(** [kill pid sig] sends signal number [sig] to the process
+   with id [pid].  On Windows, only the {!Sys.sigkill} signal
+   is emulated. *)
+
+type sigprocmask_command =
+    SIG_SETMASK
+  | SIG_BLOCK
+  | SIG_UNBLOCK
+
+val sigprocmask : sigprocmask_command -> int list -> int list
+(** [sigprocmask cmd sigs] changes the set of blocked signals.
+   If [cmd] is [SIG_SETMASK], blocked signals are set to those in
+   the list [sigs].
+   If [cmd] is [SIG_BLOCK], the signals in [sigs] are added to
+   the set of blocked signals.
+   If [cmd] is [SIG_UNBLOCK], the signals in [sigs] are removed
+   from the set of blocked signals.
+   [sigprocmask] returns the set of previously blocked signals.
+
+   When the systhreads version of the [Thread] module is loaded, this
+   function redirects to [Thread.sigmask]. I.e., [sigprocmask] only
+   changes the mask of the current thread.
+
+   On Windows: not implemented (no inter-process signals on Windows). *)
+
+val sigpending : unit -> int list
+(** Return the set of blocked signals that are currently pending.
+
+   On Windows: not implemented (no inter-process signals on Windows). *)
+
+val sigsuspend : int list -> unit
+(** [sigsuspend sigs] atomically sets the blocked signals to [sigs]
+   and waits for a non-ignored, non-blocked signal to be delivered.
+   On return, the blocked signals are reset to their initial value.
+
+   On Windows: not implemented (no inter-process signals on Windows). *)
+
+val pause : unit -> unit
+(** Wait until a non-ignored, non-blocked signal is delivered.
+
+  On Windows: not implemented (no inter-process signals on Windows). *)
+
+
+(** {1 Time functions} *)
+
+
+type process_times =
+  { tms_utime : float;  (** User time for the process *)
+    tms_stime : float;  (** System time for the process *)
+    tms_cutime : float; (** User time for the children processes *)
+    tms_cstime : float; (** System time for the children processes *)
+  }
+(** The execution times (CPU times) of a process. *)
+
+type tm =
+  { tm_sec : int;               (** Seconds 0..60 *)
+    tm_min : int;               (** Minutes 0..59 *)
+    tm_hour : int;              (** Hours 0..23 *)
+    tm_mday : int;              (** Day of month 1..31 *)
+    tm_mon : int;               (** Month of year 0..11 *)
+    tm_year : int;              (** Year - 1900 *)
+    tm_wday : int;              (** Day of week (Sunday is 0) *)
+    tm_yday : int;              (** Day of year 0..365 *)
+    tm_isdst : bool;            (** Daylight time savings in effect *)
+  }
+(** The type representing wallclock time and calendar date. *)
+
+
+val time : unit -> float
+(** Return the current time since 00:00:00 GMT, Jan. 1, 1970,
+   in seconds. *)
+
+val gettimeofday : unit -> float
+(** Same as {!Unix.time}, but with resolution better than 1 second. *)
+
+val gmtime : float -> tm
+(** Convert a time in seconds, as returned by {!Unix.time}, into a date and
+   a time. Assumes UTC (Coordinated Universal Time), also known as GMT.
+   To perform the inverse conversion, set the TZ environment variable
+   to "UTC", use {!mktime}, and then restore the original value of TZ. *)
+
+val localtime : float -> tm
+(** Convert a time in seconds, as returned by {!Unix.time}, into a date and
+   a time. Assumes the local time zone.
+   The function performing the inverse conversion is {!mktime}. *)
+
+val mktime : tm -> float * tm
+(** Convert a date and time, specified by the [tm] argument, into
+   a time in seconds, as returned by {!Unix.time}.  The [tm_isdst],
+   [tm_wday] and [tm_yday] fields of [tm] are ignored.  Also return a
+   normalized copy of the given [tm] record, with the [tm_wday],
+   [tm_yday], and [tm_isdst] fields recomputed from the other fields,
+   and the other fields normalized (so that, e.g., 40 October is
+   changed into 9 November).  The [tm] argument is interpreted in the
+   local time zone. *)
+
+val alarm : int -> int
+(** Schedule a [SIGALRM] signal after the given number of seconds.
+
+   On Windows: not implemented. *)
+
+val sleep : int -> unit
+(** Stop execution for the given number of seconds. *)
+
+val sleepf : float -> unit
+(** Stop execution for the given number of seconds.  Like [sleep],
+    but fractions of seconds are supported.
+
+    @since 4.03.0 *)
+
+val times : unit -> process_times
+(** Return the execution times of the process.
+   On Windows, it is partially implemented, will not report timings
+   for child processes. *)
+
+val utimes : string -> float -> float -> unit
+(** Set the last access time (second arg) and last modification time
+   (third arg) for a file. Times are expressed in seconds from
+   00:00:00 GMT, Jan. 1, 1970.  If both times are [0.0], the access
+   and last modification times are both set to the current time. *)
+
+type interval_timer =
+    ITIMER_REAL
+      (** decrements in real time, and sends the signal [SIGALRM] when
+         expired.*)
+  | ITIMER_VIRTUAL
+      (** decrements in process virtual time, and sends [SIGVTALRM]
+          when expired. *)
+  | ITIMER_PROF
+      (** (for profiling) decrements both when the process
+         is running and when the system is running on behalf of the
+         process; it sends [SIGPROF] when expired. *)
+(** The three kinds of interval timers. *)
+
+type interval_timer_status =
+  { it_interval : float;         (** Period *)
+    it_value : float;            (** Current value of the timer *)
+  }
+(** The type describing the status of an interval timer *)
+
+val getitimer : interval_timer -> interval_timer_status
+(** Return the current status of the given interval timer.
+
+   On Windows: not implemented. *)
+
+val setitimer :
+  interval_timer -> interval_timer_status -> interval_timer_status
+(** [setitimer t s] sets the interval timer [t] and returns
+   its previous status. The [s] argument is interpreted as follows:
+   [s.it_value], if nonzero, is the time to the next timer expiration;
+   [s.it_interval], if nonzero, specifies a value to
+   be used in reloading [it_value] when the timer expires.
+   Setting [s.it_value] to zero disables the timer.
+   Setting [s.it_interval] to zero causes the timer to be disabled
+   after its next expiration.
+
+   On Windows: not implemented. *)
+
+
+(** {1 User id, group id} *)
+
+
+val getuid : unit -> int
+(** Return the user id of the user executing the process.
+   On Windows, always return [1]. *)
+
+val geteuid : unit -> int
+(** Return the effective user id under which the process runs.
+   On Windows, always return [1]. *)
+
+val setuid : int -> unit
+(** Set the real user id and effective user id for the process.
+   On Windows: not implemented. *)
+
+val getgid : unit -> int
+(** Return the group id of the user executing the process.
+   On Windows, always return [1]. *)
+
+val getegid : unit -> int
+(** Return the effective group id under which the process runs.
+   On Windows, always return [1]. *)
+
+val setgid : int -> unit
+(** Set the real group id and effective group id for the process.
+   On Windows: not implemented. *)
+
+val getgroups : unit -> int array
+(** Return the list of groups to which the user executing the process
+   belongs.
+   On Windows, always return [[|1|]]. *)
+
+val setgroups : int array -> unit
+(** [setgroups groups] sets the supplementary group IDs for the
+    calling process. Appropriate privileges are required.
+    On Windows: not implemented. *)
+
+val initgroups : string -> int -> unit
+(** [initgroups user group] initializes the group access list by
+    reading the group database /etc/group and using all groups of
+    which [user] is a member. The additional group [group] is also
+    added to the list.
+    On Windows: not implemented. *)
+
+type passwd_entry =
+  { pw_name : string;
+    pw_passwd : string;
+    pw_uid : int;
+    pw_gid : int;
+    pw_gecos : string;
+    pw_dir : string;
+    pw_shell : string
+  }
+(** Structure of entries in the [passwd] database. *)
+
+type group_entry =
+  { gr_name : string;
+    gr_passwd : string;
+    gr_gid : int;
+    gr_mem : string array
+  }
+(** Structure of entries in the [groups] database. *)
+
+val getlogin : unit -> string
+(** Return the login name of the user executing the process. *)
+
+val getpwnam : string -> passwd_entry
+(** Find an entry in [passwd] with the given name.
+   @raise Not_found if no such entry exist.
+
+   On Windows, always raise [Not_found]. *)
+
+val getgrnam : string -> group_entry
+(** Find an entry in [group] with the given name.
+   @raise Not_found if no such entry exist.
+
+   On Windows, always raise [Not_found]. *)
+
+val getpwuid : int -> passwd_entry
+(** Find an entry in [passwd] with the given user id.
+   @raise Not_found if no such entry exist.
+
+   On Windows, always raise [Not_found]. *)
+
+val getgrgid : int -> group_entry
+(** Find an entry in [group] with the given group id.
+   @raise Not_found if no such entry exist.
+
+   On Windows, always raise [Not_found]. *)
+
+
+(** {1 Internet addresses} *)
+
+
+type inet_addr
+(** The abstract type of Internet addresses. *)
+
+val inet_addr_of_string : string -> inet_addr
+(** Conversion from the printable representation of an Internet
+    address to its internal representation.  The argument string
+    consists of 4 numbers separated by periods ([XXX.YYY.ZZZ.TTT])
+    for IPv4 addresses, and up to 8 numbers separated by colons
+    for IPv6 addresses.
+    @raise Failure when given a string that does not match these formats. *)
+
+val string_of_inet_addr : inet_addr -> string
+(** Return the printable representation of the given Internet address.
+    See {!Unix.inet_addr_of_string} for a description of the
+    printable representation. *)
+
+val inet_addr_any : inet_addr
+(** A special IPv4 address, for use only with [bind], representing
+   all the Internet addresses that the host machine possesses. *)
+
+val inet_addr_loopback : inet_addr
+(** A special IPv4 address representing the host machine ([127.0.0.1]). *)
+
+val inet6_addr_any : inet_addr
+(** A special IPv6 address, for use only with [bind], representing
+   all the Internet addresses that the host machine possesses. *)
+
+val inet6_addr_loopback : inet_addr
+(** A special IPv6 address representing the host machine ([::1]). *)
+
+
+(** {1 Sockets} *)
+
+
+type socket_domain =
+    PF_UNIX                     (** Unix domain *)
+  | PF_INET                     (** Internet domain (IPv4) *)
+  | PF_INET6                    (** Internet domain (IPv6) *)
+(** The type of socket domains.  Not all platforms support
+    IPv6 sockets (type [PF_INET6]).  Windows does not support
+    [PF_UNIX]. *)
+
+type socket_type =
+    SOCK_STREAM                 (** Stream socket *)
+  | SOCK_DGRAM                  (** Datagram socket *)
+  | SOCK_RAW                    (** Raw socket *)
+  | SOCK_SEQPACKET              (** Sequenced packets socket *)
+(** The type of socket kinds, specifying the semantics of
+   communications.  [SOCK_SEQPACKET] is included for completeness,
+   but is rarely supported by the OS, and needs system calls that
+   are not available in this library. *)
+
+type sockaddr =
+    ADDR_UNIX of string
+  | ADDR_INET of inet_addr * int (**)
+(** The type of socket addresses. [ADDR_UNIX name] is a socket
+   address in the Unix domain; [name] is a file name in the file
+   system. [ADDR_INET(addr,port)] is a socket address in the Internet
+   domain; [addr] is the Internet address of the machine, and
+   [port] is the port number. *)
+
+val socket :
+    ?cloexec:bool -> socket_domain -> socket_type -> int -> file_descr
+(** Create a new socket in the given domain, and with the
+   given kind. The third argument is the protocol type; 0 selects
+   the default protocol for that kind of sockets.
+   See {!set_close_on_exec} for documentation on the [cloexec]
+   optional argument. *)
+
+val domain_of_sockaddr: sockaddr -> socket_domain
+(** Return the socket domain adequate for the given socket address. *)
+
+val socketpair :
+     ?cloexec:bool -> socket_domain -> socket_type -> int ->
+                                                 file_descr * file_descr
+(** Create a pair of unnamed sockets, connected together.
+   See {!set_close_on_exec} for documentation on the [cloexec]
+   optional argument. *)
+
+val accept : ?cloexec:bool -> file_descr -> file_descr * sockaddr
+(** Accept connections on the given socket. The returned descriptor
+   is a socket connected to the client; the returned address is
+   the address of the connecting client.
+   See {!set_close_on_exec} for documentation on the [cloexec]
+   optional argument. *)
+
+val bind : file_descr -> sockaddr -> unit
+(** Bind a socket to an address. *)
+
+val connect : file_descr -> sockaddr -> unit
+(** Connect a socket to an address. *)
+
+val listen : file_descr -> int -> unit
+(** Set up a socket for receiving connection requests. The integer
+   argument is the maximal number of pending requests. *)
+
+type shutdown_command =
+    SHUTDOWN_RECEIVE            (** Close for receiving *)
+  | SHUTDOWN_SEND               (** Close for sending *)
+  | SHUTDOWN_ALL                (** Close both *)
+(** The type of commands for [shutdown]. *)
+
+
+val shutdown : file_descr -> shutdown_command -> unit
+(** Shutdown a socket connection. [SHUTDOWN_SEND] as second argument
+   causes reads on the other end of the connection to return
+   an end-of-file condition.
+   [SHUTDOWN_RECEIVE] causes writes on the other end of the connection
+   to return a closed pipe condition ([SIGPIPE] signal). *)
+
+val getsockname : file_descr -> sockaddr
+(** Return the address of the given socket. *)
+
+val getpeername : file_descr -> sockaddr
+(** Return the address of the host connected to the given socket. *)
+
+type msg_flag =
+    MSG_OOB
+  | MSG_DONTROUTE
+  | MSG_PEEK (**)
+(** The flags for {!Unix.recv},  {!Unix.recvfrom},
+   {!Unix.send} and {!Unix.sendto}. *)
+
+val recv : file_descr -> bytes -> int -> int -> msg_flag list -> int
+(** Receive data from a connected socket. *)
+
+val recvfrom :
+  file_descr -> bytes -> int -> int -> msg_flag list -> int * sockaddr
+(** Receive data from an unconnected socket. *)
+
+val send : file_descr -> bytes -> int -> int -> msg_flag list -> int
+(** Send data over a connected socket. *)
+
+val send_substring : file_descr -> string -> int -> int -> msg_flag list -> int
+(** Same as [send], but take the data from a string instead of a byte
+    sequence.
+    @since 4.02.0 *)
+
+val sendto :
+  file_descr -> bytes -> int -> int -> msg_flag list -> sockaddr -> int
+(** Send data over an unconnected socket. *)
+
+val sendto_substring :
+  file_descr -> string -> int -> int -> msg_flag list -> sockaddr -> int
+(** Same as [sendto], but take the data from a string instead of a
+    byte sequence.
+    @since 4.02.0 *)
+
+
+(** {1 Socket options} *)
+
+
+type socket_bool_option =
+    SO_DEBUG       (** Record debugging information *)
+  | SO_BROADCAST   (** Permit sending of broadcast messages *)
+  | SO_REUSEADDR   (** Allow reuse of local addresses for bind *)
+  | SO_KEEPALIVE   (** Keep connection active *)
+  | SO_DONTROUTE   (** Bypass the standard routing algorithms *)
+  | SO_OOBINLINE   (** Leave out-of-band data in line *)
+  | SO_ACCEPTCONN  (** Report whether socket listening is enabled *)
+  | TCP_NODELAY    (** Control the Nagle algorithm for TCP sockets *)
+  | IPV6_ONLY      (** Forbid binding an IPv6 socket to an IPv4 address *)
+(** The socket options that can be consulted with {!Unix.getsockopt}
+   and modified with {!Unix.setsockopt}.  These options have a boolean
+   ([true]/[false]) value. *)
+
+type socket_int_option =
+    SO_SNDBUF      (** Size of send buffer *)
+  | SO_RCVBUF      (** Size of received buffer *)
+  | SO_ERROR       (** Deprecated.  Use {!Unix.getsockopt_error} instead. *)
+  | SO_TYPE        (** Report the socket type *)
+  | SO_RCVLOWAT    (** Minimum number of bytes to process for input operations*)
+  | SO_SNDLOWAT    (** Minimum number of bytes to process for output
+                       operations *)
+(** The socket options that can be consulted with {!Unix.getsockopt_int}
+   and modified with {!Unix.setsockopt_int}.  These options have an
+   integer value. *)
+
+type socket_optint_option =
+  SO_LINGER      (** Whether to linger on closed connections
+                    that have data present, and for how long
+                    (in seconds) *)
+(** The socket options that can be consulted with {!Unix.getsockopt_optint}
+   and modified with {!Unix.setsockopt_optint}.  These options have a
+   value of type [int option], with [None] meaning ``disabled''. *)
+
+type socket_float_option =
+    SO_RCVTIMEO    (** Timeout for input operations *)
+  | SO_SNDTIMEO    (** Timeout for output operations *)
+(** The socket options that can be consulted with {!Unix.getsockopt_float}
+   and modified with {!Unix.setsockopt_float}.  These options have a
+   floating-point value representing a time in seconds.
+   The value 0 means infinite timeout. *)
+
+val getsockopt : file_descr -> socket_bool_option -> bool
+(** Return the current status of a boolean-valued option
+   in the given socket. *)
+
+val setsockopt : file_descr -> socket_bool_option -> bool -> unit
+(** Set or clear a boolean-valued option in the given socket. *)
+
+val getsockopt_int : file_descr -> socket_int_option -> int
+(** Same as {!Unix.getsockopt} for an integer-valued socket option. *)
+
+val setsockopt_int : file_descr -> socket_int_option -> int -> unit
+(** Same as {!Unix.setsockopt} for an integer-valued socket option. *)
+
+val getsockopt_optint : file_descr -> socket_optint_option -> int option
+(** Same as {!Unix.getsockopt} for a socket option whose value is an
+   [int option]. *)
+
+val setsockopt_optint :
+      file_descr -> socket_optint_option -> int option -> unit
+(** Same as {!Unix.setsockopt} for a socket option whose value is an
+   [int option]. *)
+
+val getsockopt_float : file_descr -> socket_float_option -> float
+(** Same as {!Unix.getsockopt} for a socket option whose value is a
+   floating-point number. *)
+
+val setsockopt_float : file_descr -> socket_float_option -> float -> unit
+(** Same as {!Unix.setsockopt} for a socket option whose value is a
+   floating-point number. *)
+
+val getsockopt_error : file_descr -> error option
+(** Return the error condition associated with the given socket,
+    and clear it. *)
+
+
+(** {1 High-level network connection functions} *)
+
+
+val open_connection : sockaddr -> in_channel * out_channel
+(** Connect to a server at the given address.
+   Return a pair of buffered channels connected to the server.
+   Remember to call {!Stdlib.flush} on the output channel at the right
+   times to ensure correct synchronization. *)
+
+val shutdown_connection : in_channel -> unit
+(** ``Shut down'' a connection established with {!Unix.open_connection};
+   that is, transmit an end-of-file condition to the server reading
+   on the other side of the connection. This does not fully close the
+   file descriptor associated with the channel, which you must remember
+   to free via {!Stdlib.close_in}. *)
+
+val establish_server : (in_channel -> out_channel -> unit) -> sockaddr -> unit
+(** Establish a server on the given address.
+   The function given as first argument is called for each connection
+   with two buffered channels connected to the client. A new process
+   is created for each connection. The function {!Unix.establish_server}
+   never returns normally.
+
+   On Windows, it is not implemented.  Use threads. *)
+
+
+(** {1 Host and protocol databases} *)
+
+
+type host_entry =
+  { h_name : string;
+    h_aliases : string array;
+    h_addrtype : socket_domain;
+    h_addr_list : inet_addr array
+  }
+(** Structure of entries in the [hosts] database. *)
+
+type protocol_entry =
+  { p_name : string;
+    p_aliases : string array;
+    p_proto : int
+  }
+(** Structure of entries in the [protocols] database. *)
+
+type service_entry =
+  { s_name : string;
+    s_aliases : string array;
+    s_port : int;
+    s_proto : string
+  }
+(** Structure of entries in the [services] database. *)
+
+val gethostname : unit -> string
+(** Return the name of the local host. *)
+
+val gethostbyname : string -> host_entry
+(** Find an entry in [hosts] with the given name.
+    @raise Not_found if no such entry exist. *)
+
+val gethostbyaddr : inet_addr -> host_entry
+(** Find an entry in [hosts] with the given address.
+    @raise Not_found if no such entry exist. *)
+
+val getprotobyname : string -> protocol_entry
+(** Find an entry in [protocols] with the given name.
+    @raise Not_found if no such entry exist. *)
+
+val getprotobynumber : int -> protocol_entry
+(** Find an entry in [protocols] with the given protocol number.
+    @raise Not_found if no such entry exist. *)
+
+val getservbyname : string -> string -> service_entry
+(** Find an entry in [services] with the given name.
+    @raise Not_found if no such entry exist. *)
+
+val getservbyport : int -> string -> service_entry
+(** Find an entry in [services] with the given service number.
+    @raise Not_found if no such entry exist. *)
+
+type addr_info =
+  { ai_family : socket_domain;          (** Socket domain *)
+    ai_socktype : socket_type;          (** Socket type *)
+    ai_protocol : int;                  (** Socket protocol number *)
+    ai_addr : sockaddr;                 (** Address *)
+    ai_canonname : string               (** Canonical host name  *)
+  }
+(** Address information returned by {!Unix.getaddrinfo}. *)
+
+type getaddrinfo_option =
+    AI_FAMILY of socket_domain          (** Impose the given socket domain *)
+  | AI_SOCKTYPE of socket_type          (** Impose the given socket type *)
+  | AI_PROTOCOL of int                  (** Impose the given protocol  *)
+  | AI_NUMERICHOST                      (** Do not call name resolver,
+                                            expect numeric IP address *)
+  | AI_CANONNAME                        (** Fill the [ai_canonname] field
+                                            of the result *)
+  | AI_PASSIVE                          (** Set address to ``any'' address
+                                            for use with {!Unix.bind} *)
+(** Options to {!Unix.getaddrinfo}. *)
+
+val getaddrinfo:
+  string -> string -> getaddrinfo_option list -> addr_info list
+(** [getaddrinfo host service opts] returns a list of {!Unix.addr_info}
+    records describing socket parameters and addresses suitable for
+    communicating with the given host and service.  The empty list is
+    returned if the host or service names are unknown, or the constraints
+    expressed in [opts] cannot be satisfied.
+
+    [host] is either a host name or the string representation of an IP
+    address.  [host] can be given as the empty string; in this case,
+    the ``any'' address or the ``loopback'' address are used,
+    depending whether [opts] contains [AI_PASSIVE].
+    [service] is either a service name or the string representation of
+    a port number.  [service] can be given as the empty string;
+    in this case, the port field of the returned addresses is set to 0.
+    [opts] is a possibly empty list of options that allows the caller
+    to force a particular socket domain (e.g. IPv6 only or IPv4 only)
+    or a particular socket type (e.g. TCP only or UDP only). *)
+
+type name_info =
+  { ni_hostname : string;               (** Name or IP address of host *)
+    ni_service : string;                (** Name of service or port number *)
+  }
+(** Host and service information returned by {!Unix.getnameinfo}. *)
+
+type getnameinfo_option =
+    NI_NOFQDN            (** Do not qualify local host names *)
+  | NI_NUMERICHOST       (** Always return host as IP address *)
+  | NI_NAMEREQD          (** Fail if host name cannot be determined *)
+  | NI_NUMERICSERV       (** Always return service as port number *)
+  | NI_DGRAM             (** Consider the service as UDP-based
+                             instead of the default TCP *)
+(** Options to {!Unix.getnameinfo}. *)
+
+val getnameinfo : sockaddr -> getnameinfo_option list -> name_info
+(** [getnameinfo addr opts] returns the host name and service name
+    corresponding to the socket address [addr].  [opts] is a possibly
+    empty list of options that governs how these names are obtained.
+    @raise Not_found if an error occurs. *)
+
+
+(** {1 Terminal interface} *)
+
+
+(** The following functions implement the POSIX standard terminal
+   interface. They provide control over asynchronous communication ports
+   and pseudo-terminals. Refer to the [termios] man page for a
+   complete description. *)
+
+type terminal_io =
+  {
+    (* input modes *)
+    mutable c_ignbrk : bool;  (** Ignore the break condition. *)
+    mutable c_brkint : bool;  (** Signal interrupt on break condition. *)
+    mutable c_ignpar : bool;  (** Ignore characters with parity errors. *)
+    mutable c_parmrk : bool;  (** Mark parity errors. *)
+    mutable c_inpck : bool;   (** Enable parity check on input. *)
+    mutable c_istrip : bool;  (** Strip 8th bit on input characters. *)
+    mutable c_inlcr : bool;   (** Map NL to CR on input. *)
+    mutable c_igncr : bool;   (** Ignore CR on input. *)
+    mutable c_icrnl : bool;   (** Map CR to NL on input. *)
+    mutable c_ixon : bool;    (** Recognize XON/XOFF characters on input. *)
+    mutable c_ixoff : bool;   (** Emit XON/XOFF chars to control input flow. *)
+    (* Output modes: *)
+    mutable c_opost : bool;   (** Enable output processing. *)
+    (* Control modes: *)
+    mutable c_obaud : int;    (** Output baud rate (0 means close connection).*)
+    mutable c_ibaud : int;    (** Input baud rate. *)
+    mutable c_csize : int;    (** Number of bits per character (5-8). *)
+    mutable c_cstopb : int;   (** Number of stop bits (1-2). *)
+    mutable c_cread : bool;   (** Reception is enabled. *)
+    mutable c_parenb : bool;  (** Enable parity generation and detection. *)
+    mutable c_parodd : bool;  (** Specify odd parity instead of even. *)
+    mutable c_hupcl : bool;   (** Hang up on last close. *)
+    mutable c_clocal : bool;  (** Ignore modem status lines. *)
+    (* Local modes: *)
+    mutable c_isig : bool;    (** Generate signal on INTR, QUIT, SUSP. *)
+    mutable c_icanon : bool;  (** Enable canonical processing
+                                 (line buffering and editing) *)
+    mutable c_noflsh : bool;  (** Disable flush after INTR, QUIT, SUSP. *)
+    mutable c_echo : bool;    (** Echo input characters. *)
+    mutable c_echoe : bool;   (** Echo ERASE (to erase previous character). *)
+    mutable c_echok : bool;   (** Echo KILL (to erase the current line). *)
+    mutable c_echonl : bool;  (** Echo NL even if c_echo is not set. *)
+    (* Control characters: *)
+    mutable c_vintr : char;   (** Interrupt character (usually ctrl-C). *)
+    mutable c_vquit : char;   (** Quit character (usually ctrl-\). *)
+    mutable c_verase : char;  (** Erase character (usually DEL or ctrl-H). *)
+    mutable c_vkill : char;   (** Kill line character (usually ctrl-U). *)
+    mutable c_veof : char;    (** End-of-file character (usually ctrl-D). *)
+    mutable c_veol : char;    (** Alternate end-of-line char. (usually none). *)
+    mutable c_vmin : int;     (** Minimum number of characters to read
+                                 before the read request is satisfied. *)
+    mutable c_vtime : int;    (** Maximum read wait (in 0.1s units). *)
+    mutable c_vstart : char;  (** Start character (usually ctrl-Q). *)
+    mutable c_vstop : char;   (** Stop character (usually ctrl-S). *)
+  }
+
+val tcgetattr : file_descr -> terminal_io
+(** Return the status of the terminal referred to by the given
+   file descriptor.
+   On Windows, not implemented. *)
+
+type setattr_when =
+    TCSANOW
+  | TCSADRAIN
+  | TCSAFLUSH
+
+val tcsetattr : file_descr -> setattr_when -> terminal_io -> unit
+(** Set the status of the terminal referred to by the given
+   file descriptor. The second argument indicates when the
+   status change takes place: immediately ([TCSANOW]),
+   when all pending output has been transmitted ([TCSADRAIN]),
+   or after flushing all input that has been received but not
+   read ([TCSAFLUSH]). [TCSADRAIN] is recommended when changing
+   the output parameters; [TCSAFLUSH], when changing the input
+   parameters.
+
+   On Windows, not implemented. *)
+
+val tcsendbreak : file_descr -> int -> unit
+(** Send a break condition on the given file descriptor.
+   The second argument is the duration of the break, in 0.1s units;
+   0 means standard duration (0.25s).
+
+   On Windows, not implemented. *)
+
+val tcdrain : file_descr -> unit
+(** Waits until all output written on the given file descriptor
+   has been transmitted.
+
+   On Windows, not implemented. *)
+
+type flush_queue =
+    TCIFLUSH
+  | TCOFLUSH
+  | TCIOFLUSH
+
+val tcflush : file_descr -> flush_queue -> unit
+(** Discard data written on the given file descriptor but not yet
+   transmitted, or data received but not yet read, depending on the
+   second argument: [TCIFLUSH] flushes data received but not read,
+   [TCOFLUSH] flushes data written but not transmitted, and
+   [TCIOFLUSH] flushes both.
+
+   On Windows, not implemented. *)
+
+type flow_action =
+    TCOOFF
+  | TCOON
+  | TCIOFF
+  | TCION
+
+val tcflow : file_descr -> flow_action -> unit
+(** Suspend or restart reception or transmission of data on
+   the given file descriptor, depending on the second argument:
+   [TCOOFF] suspends output, [TCOON] restarts output,
+   [TCIOFF] transmits a STOP character to suspend input,
+   and [TCION] transmits a START character to restart input.
+
+   On Windows, not implemented. *)
+
+val setsid : unit -> int
+(** Put the calling process in a new session and detach it from
+   its controlling terminal.
+
+   On Windows, not implemented. *)
diff --git a/otherlibs/unix/unixLabels.ml b/otherlibs/unix/unixLabels.ml
new file mode 100644
index 00000000..3da36995
--- /dev/null
+++ b/otherlibs/unix/unixLabels.ml
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Jacques Garrigue, Kyoto University RIMS                 *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Module [UnixLabels]: labelled Unix module *)
+
+include Unix
diff --git a/otherlibs/unix/unixLabels.mli b/otherlibs/unix/unixLabels.mli
new file mode 100644
index 00000000..6b4c9374
--- /dev/null
+++ b/otherlibs/unix/unixLabels.mli
@@ -0,0 +1,1499 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Interface to the Unix system.
+   To use as replacement to default {!Unix} module,
+   add [module Unix = UnixLabels] in your implementation.
+*)
+
+(** {1 Error report} *)
+
+
+type error = Unix.error =
+    E2BIG               (** Argument list too long *)
+  | EACCES              (** Permission denied *)
+  | EAGAIN              (** Resource temporarily unavailable; try again *)
+  | EBADF               (** Bad file descriptor *)
+  | EBUSY               (** Resource unavailable *)
+  | ECHILD              (** No child process *)
+  | EDEADLK             (** Resource deadlock would occur *)
+  | EDOM                (** Domain error for math functions, etc. *)
+  | EEXIST              (** File exists *)
+  | EFAULT              (** Bad address *)
+  | EFBIG               (** File too large *)
+  | EINTR               (** Function interrupted by signal *)
+  | EINVAL              (** Invalid argument *)
+  | EIO                 (** Hardware I/O error *)
+  | EISDIR              (** Is a directory *)
+  | EMFILE              (** Too many open files by the process *)
+  | EMLINK              (** Too many links *)
+  | ENAMETOOLONG        (** Filename too long *)
+  | ENFILE              (** Too many open files in the system *)
+  | ENODEV              (** No such device *)
+  | ENOENT              (** No such file or directory *)
+  | ENOEXEC             (** Not an executable file *)
+  | ENOLCK              (** No locks available *)
+  | ENOMEM              (** Not enough memory *)
+  | ENOSPC              (** No space left on device *)
+  | ENOSYS              (** Function not supported *)
+  | ENOTDIR             (** Not a directory *)
+  | ENOTEMPTY           (** Directory not empty *)
+  | ENOTTY              (** Inappropriate I/O control operation *)
+  | ENXIO               (** No such device or address *)
+  | EPERM               (** Operation not permitted *)
+  | EPIPE               (** Broken pipe *)
+  | ERANGE              (** Result too large *)
+  | EROFS               (** Read-only file system *)
+  | ESPIPE              (** Invalid seek e.g. on a pipe *)
+  | ESRCH               (** No such process *)
+  | EXDEV               (** Invalid link *)
+  | EWOULDBLOCK         (** Operation would block *)
+  | EINPROGRESS         (** Operation now in progress *)
+  | EALREADY            (** Operation already in progress *)
+  | ENOTSOCK            (** Socket operation on non-socket *)
+  | EDESTADDRREQ        (** Destination address required *)
+  | EMSGSIZE            (** Message too long *)
+  | EPROTOTYPE          (** Protocol wrong type for socket *)
+  | ENOPROTOOPT         (** Protocol not available *)
+  | EPROTONOSUPPORT     (** Protocol not supported *)
+  | ESOCKTNOSUPPORT     (** Socket type not supported *)
+  | EOPNOTSUPP          (** Operation not supported on socket *)
+  | EPFNOSUPPORT        (** Protocol family not supported *)
+  | EAFNOSUPPORT        (** Address family not supported by protocol family *)
+  | EADDRINUSE          (** Address already in use *)
+  | EADDRNOTAVAIL       (** Can't assign requested address *)
+  | ENETDOWN            (** Network is down *)
+  | ENETUNREACH         (** Network is unreachable *)
+  | ENETRESET           (** Network dropped connection on reset *)
+  | ECONNABORTED        (** Software caused connection abort *)
+  | ECONNRESET          (** Connection reset by peer *)
+  | ENOBUFS             (** No buffer space available *)
+  | EISCONN             (** Socket is already connected *)
+  | ENOTCONN            (** Socket is not connected *)
+  | ESHUTDOWN           (** Can't send after socket shutdown *)
+  | ETOOMANYREFS        (** Too many references: can't splice *)
+  | ETIMEDOUT           (** Connection timed out *)
+  | ECONNREFUSED        (** Connection refused *)
+  | EHOSTDOWN           (** Host is down *)
+  | EHOSTUNREACH        (** No route to host *)
+  | ELOOP               (** Too many levels of symbolic links *)
+  | EOVERFLOW           (** File size or position not representable *)
+
+  | EUNKNOWNERR of int  (** Unknown error *)
+(** The type of error codes.
+   Errors defined in the POSIX standard
+   and additional errors from UNIX98 and BSD.
+   All other errors are mapped to EUNKNOWNERR.
+*)
+
+
+exception Unix_error of error * string * string
+(** Raised by the system calls below when an error is encountered.
+   The first component is the error code; the second component
+   is the function name; the third component is the string parameter
+   to the function, if it has one, or the empty string otherwise. *)
+
+val error_message : error -> string
+(** Return a string describing the given error code. *)
+
+val handle_unix_error : ('a -> 'b) -> 'a -> 'b
+(** [handle_unix_error f x] applies [f] to [x] and returns the result.
+   If the exception [Unix_error] is raised, it prints a message
+   describing the error and exits with code 2. *)
+
+
+(** {1 Access to the process environment} *)
+
+
+val environment : unit -> string array
+(** Return the process environment, as an array of strings
+    with the format ``variable=value''. *)
+
+val getenv : string -> string
+(** Return the value associated to a variable in the process
+   environment. Raise [Not_found] if the variable is unbound.
+   (This function is identical to [Sys.getenv].) *)
+
+val unsafe_getenv : string -> string
+(** Return the value associated to a variable in the process
+   environment.
+
+   Unlike {!getenv}, this function returns the value even if the
+   process has special privileges. It is considered unsafe because the
+   programmer of a setuid or setgid program must be careful to avoid
+   using maliciously crafted environment variables in the search path
+   for executables, the locations for temporary files or logs, and the
+   like.
+
+   @raise Not_found if the variable is unbound.
+   @since 4.06.0  *)
+
+val putenv : string -> string -> unit
+(** [Unix.putenv name value] sets the value associated to a
+   variable in the process environment.
+   [name] is the name of the environment variable,
+   and [value] its new associated value. *)
+
+
+(** {1 Process handling} *)
+
+
+type process_status = Unix.process_status =
+    WEXITED of int
+        (** The process terminated normally by [exit];
+           the argument is the return code. *)
+  | WSIGNALED of int
+        (** The process was killed by a signal;
+           the argument is the signal number. *)
+  | WSTOPPED of int
+        (** The process was stopped by a signal; the argument is the
+           signal number. *)
+(** The termination status of a process.  See module {!Sys} for the
+    definitions of the standard signal numbers.  Note that they are
+    not the numbers used by the OS. *)
+
+
+type wait_flag = Unix.wait_flag =
+    WNOHANG (** do not block if no child has
+               died yet, but immediately return with a pid equal to 0.*)
+  | WUNTRACED (** report also the children that receive stop signals. *)
+(** Flags for {!UnixLabels.waitpid}. *)
+
+val execv : prog:string -> args:string array -> 'a
+(** [execv prog args] execute the program in file [prog], with
+   the arguments [args], and the current process environment.
+   These [execv*] functions never return: on success, the current
+   program is replaced by the new one;
+   on failure, a {!UnixLabels.Unix_error} exception is raised. *)
+
+val execve : prog:string -> args:string array -> env:string array -> 'a
+(** Same as {!UnixLabels.execv}, except that the third argument provides the
+   environment to the program executed. *)
+
+val execvp : prog:string -> args:string array -> 'a
+(** Same as {!UnixLabels.execv}, except that
+   the program is searched in the path. *)
+
+val execvpe : prog:string -> args:string array -> env:string array -> 'a
+(** Same as {!UnixLabels.execve}, except that
+   the program is searched in the path. *)
+
+val fork : unit -> int
+(** Fork a new process. The returned integer is 0 for the child
+   process, the pid of the child process for the parent process. *)
+
+val wait : unit -> int * process_status
+(** Wait until one of the children processes die, and return its pid
+   and termination status. *)
+
+val waitpid : mode:wait_flag list -> int -> int * process_status
+(** Same as {!UnixLabels.wait}, but waits for the child process whose pid
+   is given.
+   A pid of [-1] means wait for any child.
+   A pid of [0] means wait for any child in the same process group
+   as the current process.
+   Negative pid arguments represent process groups.
+   The list of options indicates whether [waitpid] should return
+   immediately without waiting, or also report stopped children. *)
+
+val system : string -> process_status
+(** Execute the given command, wait until it terminates, and return
+   its termination status. The string is interpreted by the shell
+   [/bin/sh] and therefore can contain redirections, quotes, variables,
+   etc. The result [WEXITED 127] indicates that the shell couldn't
+   be executed. *)
+
+val getpid : unit -> int
+(** Return the pid of the process. *)
+
+val getppid : unit -> int
+(** Return the pid of the parent process. *)
+
+val nice : int -> int
+(** Change the process priority. The integer argument is added to the
+   ``nice'' value. (Higher values of the ``nice'' value mean
+   lower priorities.) Return the new nice value. *)
+
+
+(** {1 Basic file input/output} *)
+
+
+type file_descr = Unix.file_descr
+(** The abstract type of file descriptors. *)
+
+val stdin : file_descr
+(** File descriptor for standard input.*)
+
+val stdout : file_descr
+(** File descriptor for standard output.*)
+
+val stderr : file_descr
+(** File descriptor for standard error. *)
+
+type open_flag = Unix.open_flag =
+    O_RDONLY                    (** Open for reading *)
+  | O_WRONLY                    (** Open for writing *)
+  | O_RDWR                      (** Open for reading and writing *)
+  | O_NONBLOCK                  (** Open in non-blocking mode *)
+  | O_APPEND                    (** Open for append *)
+  | O_CREAT                     (** Create if nonexistent *)
+  | O_TRUNC                     (** Truncate to 0 length if existing *)
+  | O_EXCL                      (** Fail if existing *)
+  | O_NOCTTY                    (** Don't make this dev a controlling tty *)
+  | O_DSYNC                     (** Writes complete as `Synchronised I/O data
+                                    integrity completion' *)
+  | O_SYNC                      (** Writes complete as `Synchronised I/O file
+                                    integrity completion' *)
+  | O_RSYNC                     (** Reads complete as writes (depending
+                                    on O_SYNC/O_DSYNC) *)
+  | O_SHARE_DELETE              (** Windows only: allow the file to be deleted
+                                    while still open *)
+  | O_CLOEXEC                   (** Set the close-on-exec flag on the
+                                   descriptor returned by {!openfile} *)
+  | O_KEEPEXEC                  (** Clear the close-on-exec flag.
+                                    This is currently the default. *)
+(** The flags to {!UnixLabels.openfile}. *)
+
+
+type file_perm = int
+(** The type of file access rights, e.g. [0o640] is read and write for user,
+    read for group, none for others *)
+
+val openfile : string -> mode:open_flag list -> perm:file_perm -> file_descr
+(** Open the named file with the given flags. Third argument is
+   the permissions to give to the file if it is created. Return
+   a file descriptor on the named file. *)
+
+val close : file_descr -> unit
+(** Close a file descriptor. *)
+
+val read : file_descr -> buf:bytes -> pos:int -> len:int -> int
+(** [read fd buff ofs len] reads [len] bytes from descriptor [fd],
+    storing them in byte sequence [buff], starting at position [ofs] in
+    [buff]. Return the number of bytes actually read. *)
+
+val write : file_descr -> buf:bytes -> pos:int -> len:int -> int
+(** [write fd buff ofs len] writes [len] bytes to descriptor [fd],
+    taking them from byte sequence [buff], starting at position [ofs]
+    in [buff]. Return the number of bytes actually written.  [write]
+    repeats the writing operation until all bytes have been written or
+    an error occurs.  *)
+
+val single_write : file_descr -> buf:bytes -> pos:int -> len:int -> int
+(** Same as [write], but attempts to write only once.
+   Thus, if an error occurs, [single_write] guarantees that no data
+   has been written. *)
+
+val write_substring : file_descr -> buf:string -> pos:int -> len:int -> int
+(** Same as [write], but take the data from a string instead of a byte
+    sequence.
+    @since 4.02.0 *)
+
+val single_write_substring :
+  file_descr -> buf:string -> pos:int -> len:int -> int
+(** Same as [single_write], but take the data from a string instead of
+    a byte sequence.
+    @since 4.02.0 *)
+
+(** {1 Interfacing with the standard input/output library} *)
+
+
+
+val in_channel_of_descr : file_descr -> in_channel
+(** Create an input channel reading from the given descriptor.
+   The channel is initially in binary mode; use
+   [set_binary_mode_in ic false] if text mode is desired. *)
+
+val out_channel_of_descr : file_descr -> out_channel
+(** Create an output channel writing on the given descriptor.
+   The channel is initially in binary mode; use
+   [set_binary_mode_out oc false] if text mode is desired. *)
+
+val descr_of_in_channel : in_channel -> file_descr
+(** Return the descriptor corresponding to an input channel. *)
+
+val descr_of_out_channel : out_channel -> file_descr
+(** Return the descriptor corresponding to an output channel. *)
+
+
+(** {1 Seeking and truncating} *)
+
+
+type seek_command = Unix.seek_command =
+    SEEK_SET (** indicates positions relative to the beginning of the file *)
+  | SEEK_CUR (** indicates positions relative to the current position *)
+  | SEEK_END (** indicates positions relative to the end of the file *)
+(** Positioning modes for {!UnixLabels.lseek}. *)
+
+
+val lseek : file_descr -> int -> mode:seek_command -> int
+(** Set the current position for a file descriptor, and return the resulting
+    offset (from the beginning of the file). *)
+
+val truncate : string -> len:int -> unit
+(** Truncates the named file to the given size. *)
+
+val ftruncate : file_descr -> len:int -> unit
+(** Truncates the file corresponding to the given descriptor
+   to the given size. *)
+
+
+(** {1 File status} *)
+
+
+type file_kind = Unix.file_kind =
+    S_REG                       (** Regular file *)
+  | S_DIR                       (** Directory *)
+  | S_CHR                       (** Character device *)
+  | S_BLK                       (** Block device *)
+  | S_LNK                       (** Symbolic link *)
+  | S_FIFO                      (** Named pipe *)
+  | S_SOCK                      (** Socket *)
+
+type stats = Unix.stats =
+  { st_dev : int;               (** Device number *)
+    st_ino : int;               (** Inode number *)
+    st_kind : file_kind;        (** Kind of the file *)
+    st_perm : file_perm;        (** Access rights *)
+    st_nlink : int;             (** Number of links *)
+    st_uid : int;               (** User id of the owner *)
+    st_gid : int;               (** Group ID of the file's group *)
+    st_rdev : int;              (** Device ID (if special file) *)
+    st_size : int;              (** Size in bytes *)
+    st_atime : float;           (** Last access time *)
+    st_mtime : float;           (** Last modification time *)
+    st_ctime : float;           (** Last status change time *)
+  }
+(** The information returned by the {!UnixLabels.stat} calls. *)
+
+val stat : string -> stats
+(** Return the information for the named file. *)
+
+val lstat : string -> stats
+(** Same as {!UnixLabels.stat}, but in case the file is a symbolic link,
+   return the information for the link itself. *)
+
+val fstat : file_descr -> stats
+(** Return the information for the file associated with the given
+   descriptor. *)
+
+val isatty : file_descr -> bool
+(** Return [true] if the given file descriptor refers to a terminal or
+   console window, [false] otherwise. *)
+
+(** {1 File operations on large files} *)
+
+module LargeFile :
+  sig
+    val lseek : file_descr -> int64 -> mode:seek_command -> int64
+    val truncate : string -> len:int64 -> unit
+    val ftruncate : file_descr -> len:int64 -> unit
+    type stats = Unix.LargeFile.stats =
+      { st_dev : int;               (** Device number *)
+        st_ino : int;               (** Inode number *)
+        st_kind : file_kind;        (** Kind of the file *)
+        st_perm : file_perm;        (** Access rights *)
+        st_nlink : int;             (** Number of links *)
+        st_uid : int;               (** User id of the owner *)
+        st_gid : int;               (** Group ID of the file's group *)
+        st_rdev : int;              (** Device ID (if special file) *)
+        st_size : int64;            (** Size in bytes *)
+        st_atime : float;           (** Last access time *)
+        st_mtime : float;           (** Last modification time *)
+        st_ctime : float;           (** Last status change time *)
+      }
+    val stat : string -> stats
+    val lstat : string -> stats
+    val fstat : file_descr -> stats
+  end
+(** File operations on large files.
+  This sub-module provides 64-bit variants of the functions
+  {!UnixLabels.lseek} (for positioning a file descriptor),
+  {!UnixLabels.truncate} and {!UnixLabels.ftruncate}
+  (for changing the size of a file),
+  and {!UnixLabels.stat}, {!UnixLabels.lstat} and {!UnixLabels.fstat}
+  (for obtaining information on files).  These alternate functions represent
+  positions and sizes by 64-bit integers (type [int64]) instead of
+  regular integers (type [int]), thus allowing operating on files
+  whose sizes are greater than [max_int]. *)
+
+
+(** {1 Mapping files into memory} *)
+
+val map_file :
+  file_descr -> ?pos:int64 -> kind:('a, 'b) Stdlib.Bigarray.kind ->
+  layout:'c Stdlib.Bigarray.layout -> shared:bool -> dims:int array ->
+  ('a, 'b, 'c) Stdlib.Bigarray.Genarray.t
+(** Memory mapping of a file as a Bigarray.
+  [map_file fd kind layout shared dims]
+  returns a Bigarray of kind [kind], layout [layout],
+  and dimensions as specified in [dims].  The data contained in
+  this Bigarray are the contents of the file referred to by
+  the file descriptor [fd] (as opened previously with
+  [Unix.openfile], for example).  The optional [pos] parameter
+  is the byte offset in the file of the data being mapped;
+  it defaults to 0 (map from the beginning of the file).
+
+  If [shared] is [true], all modifications performed on the array
+  are reflected in the file.  This requires that [fd] be opened
+  with write permissions.  If [shared] is [false], modifications
+  performed on the array are done in memory only, using
+  copy-on-write of the modified pages; the underlying file is not
+  affected.
+
+  [Genarray.map_file] is much more efficient than reading
+  the whole file in a Bigarray, modifying that Bigarray,
+  and writing it afterwards.
+
+  To adjust automatically the dimensions of the Bigarray to
+  the actual size of the file, the major dimension (that is,
+  the first dimension for an array with C layout, and the last
+  dimension for an array with Fortran layout) can be given as
+  [-1].  [Genarray.map_file] then determines the major dimension
+  from the size of the file.  The file must contain an integral
+  number of sub-arrays as determined by the non-major dimensions,
+  otherwise [Failure] is raised.
+
+  If all dimensions of the Bigarray are given, the file size is
+  matched against the size of the Bigarray.  If the file is larger
+  than the Bigarray, only the initial portion of the file is
+  mapped to the Bigarray.  If the file is smaller than the big
+  array, the file is automatically grown to the size of the Bigarray.
+  This requires write permissions on [fd].
+
+  Array accesses are bounds-checked, but the bounds are determined by
+  the initial call to [map_file]. Therefore, you should make sure no
+  other process modifies the mapped file while you're accessing it,
+  or a SIGBUS signal may be raised. This happens, for instance, if the
+  file is shrunk.
+
+  [Invalid_argument] or [Failure] may be raised in cases where argument
+  validation fails.
+  @since 4.06.0 *)
+
+(** {1 Operations on file names} *)
+
+
+val unlink : string -> unit
+(** Removes the named file *)
+
+val rename : src:string -> dst:string -> unit
+(** [rename old new] changes the name of a file from [old] to [new]. *)
+
+val link : ?follow:bool -> src:string -> dst:string -> unit
+(** [link ?follow source dest] creates a hard link named [dest] to the file
+   named [source].
+
+   @param follow indicates whether a [source] symlink is followed or a
+   hardlink to [source] itself will be created. On {e Unix} systems this is
+   done using the [linkat(2)] function. If [?follow] is not provided, then the
+   [link(2)] function is used whose behaviour is OS-dependent, but more widely
+   available.
+
+   @raise ENOSYS On {e Unix} if [~follow:_] is requested, but linkat is
+                 unavailable.
+   @raise ENOSYS On {e Windows} if [~follow:false] is requested. *)
+
+
+(** {1 File permissions and ownership} *)
+
+
+type access_permission = Unix.access_permission =
+    R_OK                        (** Read permission *)
+  | W_OK                        (** Write permission *)
+  | X_OK                        (** Execution permission *)
+  | F_OK                        (** File exists *)
+(** Flags for the {!UnixLabels.access} call. *)
+
+
+val chmod : string -> perm:file_perm -> unit
+(** Change the permissions of the named file. *)
+
+val fchmod : file_descr -> perm:file_perm -> unit
+(** Change the permissions of an opened file. *)
+
+val chown : string -> uid:int -> gid:int -> unit
+(** Change the owner uid and owner gid of the named file. *)
+
+val fchown : file_descr -> uid:int -> gid:int -> unit
+(** Change the owner uid and owner gid of an opened file. *)
+
+val umask : int -> int
+(** Set the process's file mode creation mask, and return the previous
+    mask. *)
+
+val access : string -> perm:access_permission list -> unit
+(** Check that the process has the given permissions over the named
+   file. Raise [Unix_error] otherwise. *)
+
+
+(** {1 Operations on file descriptors} *)
+
+
+val dup : ?cloexec:bool -> file_descr -> file_descr
+(** Return a new file descriptor referencing the same file as
+   the given descriptor. *)
+
+val dup2 : ?cloexec:bool -> src:file_descr -> dst:file_descr -> unit
+(** [dup2 fd1 fd2] duplicates [fd1] to [fd2], closing [fd2] if already
+   opened. *)
+
+val set_nonblock : file_descr -> unit
+(** Set the ``non-blocking'' flag on the given descriptor.
+   When the non-blocking flag is set, reading on a descriptor
+   on which there is temporarily no data available raises the
+   [EAGAIN] or [EWOULDBLOCK] error instead of blocking;
+   writing on a descriptor on which there is temporarily no room
+   for writing also raises [EAGAIN] or [EWOULDBLOCK]. *)
+
+val clear_nonblock : file_descr -> unit
+(** Clear the ``non-blocking'' flag on the given descriptor.
+   See {!UnixLabels.set_nonblock}.*)
+
+val set_close_on_exec : file_descr -> unit
+(** Set the ``close-on-exec'' flag on the given descriptor.
+   A descriptor with the close-on-exec flag is automatically
+   closed when the current process starts another program with
+   one of the [exec] functions. *)
+
+val clear_close_on_exec : file_descr -> unit
+(** Clear the ``close-on-exec'' flag on the given descriptor.
+   See {!UnixLabels.set_close_on_exec}.*)
+
+
+(** {1 Directories} *)
+
+
+val mkdir : string -> perm:file_perm -> unit
+(** Create a directory with the given permissions. *)
+
+val rmdir : string -> unit
+(** Remove an empty directory. *)
+
+val chdir : string -> unit
+(** Change the process working directory. *)
+
+val getcwd : unit -> string
+(** Return the name of the current working directory. *)
+
+val chroot : string -> unit
+(** Change the process root directory. *)
+
+type dir_handle = Unix.dir_handle
+(** The type of descriptors over opened directories. *)
+
+val opendir : string -> dir_handle
+(** Open a descriptor on a directory *)
+
+val readdir : dir_handle -> string
+(** Return the next entry in a directory.
+   @raise End_of_file when the end of the directory has been reached. *)
+
+val rewinddir : dir_handle -> unit
+(** Reposition the descriptor to the beginning of the directory *)
+
+val closedir : dir_handle -> unit
+(** Close a directory descriptor. *)
+
+
+
+(** {1 Pipes and redirections} *)
+
+
+val pipe : ?cloexec:bool -> unit -> file_descr * file_descr
+(** Create a pipe. The first component of the result is opened
+   for reading, that's the exit to the pipe. The second component is
+   opened for writing, that's the entrance to the pipe. *)
+
+val mkfifo : string -> perm:file_perm -> unit
+(** Create a named pipe with the given permissions. *)
+
+
+(** {1 High-level process and redirection management} *)
+
+
+val create_process :
+  prog:string -> args:string array -> stdin:file_descr -> stdout:file_descr ->
+    stderr:file_descr -> int
+(** [create_process prog args new_stdin new_stdout new_stderr]
+   forks a new process that executes the program
+   in file [prog], with arguments [args]. The pid of the new
+   process is returned immediately; the new process executes
+   concurrently with the current process.
+   The standard input and outputs of the new process are connected
+   to the descriptors [new_stdin], [new_stdout] and [new_stderr].
+   Passing e.g. [stdout] for [new_stdout] prevents the redirection
+   and causes the new process to have the same standard output
+   as the current process.
+   The executable file [prog] is searched in the path.
+   The new process has the same environment as the current process. *)
+
+val create_process_env :
+  prog:string -> args:string array -> env:string array -> stdin:file_descr ->
+    stdout:file_descr -> stderr:file_descr -> int
+(** [create_process_env prog args env new_stdin new_stdout new_stderr]
+   works as {!UnixLabels.create_process}, except that the extra argument
+   [env] specifies the environment passed to the program. *)
+
+
+val open_process_in : string -> in_channel
+(** High-level pipe and process management. This function
+   runs the given command in parallel with the program.
+   The standard output of the command is redirected to a pipe,
+   which can be read via the returned input channel.
+   The command is interpreted by the shell [/bin/sh] (cf. [system]). *)
+
+val open_process_out : string -> out_channel
+(** Same as {!UnixLabels.open_process_in}, but redirect the standard input of
+   the command to a pipe.  Data written to the returned output channel
+   is sent to the standard input of the command.
+   Warning: writes on output channels are buffered, hence be careful
+   to call {!Stdlib.flush} at the right times to ensure
+   correct synchronization. *)
+
+val open_process : string -> in_channel * out_channel
+(** Same as {!UnixLabels.open_process_out}, but redirects both the standard
+   input and standard output of the command to pipes connected to the two
+   returned channels.  The input channel is connected to the output
+   of the command, and the output channel to the input of the command. *)
+
+val open_process_full :
+  string -> env:string array -> in_channel * out_channel * in_channel
+(** Similar to {!UnixLabels.open_process}, but the second argument specifies
+   the environment passed to the command.  The result is a triple
+   of channels connected respectively to the standard output, standard input,
+   and standard error of the command. *)
+
+val open_process_args_in : string -> string array -> in_channel
+(** High-level pipe and process management. The first argument specifies the
+   command to run, and the second argument specifies the argument array passed
+   to the command.  This function runs the command in parallel with the program.
+   The standard output of the command is redirected to a pipe, which can be read
+   via the returned input channel.
+
+    @since 4.08.0 *)
+
+val open_process_args_out : string -> string array -> out_channel
+(** Same as {!Unix.open_process_args_in}, but redirect the standard input of the
+   command to a pipe.  Data written to the returned output channel is sent to
+   the standard input of the command.  Warning: writes on output channels are
+   buffered, hence be careful to call {!Stdlib.flush} at the right times to
+   ensure correct synchronization.
+
+    @since 4.08.0 *)
+
+val open_process_args : string -> string array -> in_channel * out_channel
+(** Same as {!Unix.open_process_args_out}, but redirects both the standard input
+   and standard output of the command to pipes connected to the two returned
+   channels.  The input channel is connected to the output of the command, and
+   the output channel to the input of the command.
+
+    @since 4.08.0 *)
+
+val open_process_args_full :
+  string -> string array -> string array ->
+    in_channel * out_channel * in_channel
+(** Similar to {!Unix.open_process_args}, but the third argument specifies the
+   environment passed to the command.  The result is a triple of channels
+   connected respectively to the standard output, standard input, and standard
+   error of the command.
+
+    @since 4.08.0 *)
+
+val close_process_in : in_channel -> process_status
+(** Close channels opened by {!UnixLabels.open_process_in},
+   wait for the associated command to terminate,
+   and return its termination status. *)
+
+val close_process_out : out_channel -> process_status
+(** Close channels opened by {!UnixLabels.open_process_out},
+   wait for the associated command to terminate,
+   and return its termination status. *)
+
+val close_process : in_channel * out_channel -> process_status
+(** Close channels opened by {!UnixLabels.open_process},
+   wait for the associated command to terminate,
+   and return its termination status. *)
+
+val close_process_full :
+  in_channel * out_channel * in_channel -> process_status
+(** Close channels opened by {!UnixLabels.open_process_full},
+   wait for the associated command to terminate,
+   and return its termination status. *)
+
+
+(** {1 Symbolic links} *)
+
+
+val symlink : ?to_dir:bool -> src:string -> dst:string -> unit
+(** [symlink source dest] creates the file [dest] as a symbolic link
+   to the file [source]. See {!Unix.symlink} for details of [~to_dir] *)
+
+val has_symlink : unit -> bool
+(** Returns [true] if the user is able to create symbolic links. On Windows,
+   this indicates that the user not only has the SeCreateSymbolicLinkPrivilege
+   but is also running elevated, if necessary. On other platforms, this is
+   simply indicates that the symlink system call is available.
+   @since 4.03.0 *)
+
+val readlink : string -> string
+(** Read the contents of a link. *)
+
+
+(** {1 Polling} *)
+
+
+val select :
+  read:file_descr list -> write:file_descr list -> except:file_descr list ->
+    timeout:float -> file_descr list * file_descr list * file_descr list
+(** Wait until some input/output operations become possible on
+   some channels. The three list arguments are, respectively, a set
+   of descriptors to check for reading (first argument), for writing
+   (second argument), or for exceptional conditions (third argument).
+   The fourth argument is the maximal timeout, in seconds; a
+   negative fourth argument means no timeout (unbounded wait).
+   The result is composed of three sets of descriptors: those ready
+   for reading (first component), ready for writing (second component),
+   and over which an exceptional condition is pending (third
+   component). *)
+
+(** {1 Locking} *)
+
+
+type lock_command = Unix.lock_command =
+    F_ULOCK       (** Unlock a region *)
+  | F_LOCK        (** Lock a region for writing, and block if already locked *)
+  | F_TLOCK       (** Lock a region for writing, or fail if already locked *)
+  | F_TEST        (** Test a region for other process locks *)
+  | F_RLOCK       (** Lock a region for reading, and block if already locked *)
+  | F_TRLOCK      (** Lock a region for reading, or fail if already locked *)
+(** Commands for {!UnixLabels.lockf}. *)
+
+val lockf : file_descr -> mode:lock_command -> len:int -> unit
+(** [lockf fd cmd size] puts a lock on a region of the file opened
+   as [fd]. The region starts at the current read/write position for
+   [fd] (as set by {!UnixLabels.lseek}), and extends [size] bytes forward if
+   [size] is positive, [size] bytes backwards if [size] is negative,
+   or to the end of the file if [size] is zero.
+   A write lock prevents any other
+   process from acquiring a read or write lock on the region.
+   A read lock prevents any other
+   process from acquiring a write lock on the region, but lets
+   other processes acquire read locks on it.
+
+   The [F_LOCK] and [F_TLOCK] commands attempts to put a write lock
+   on the specified region.
+   The [F_RLOCK] and [F_TRLOCK] commands attempts to put a read lock
+   on the specified region.
+   If one or several locks put by another process prevent the current process
+   from acquiring the lock, [F_LOCK] and [F_RLOCK] block until these locks
+   are removed, while [F_TLOCK] and [F_TRLOCK] fail immediately with an
+   exception.
+   The [F_ULOCK] removes whatever locks the current process has on
+   the specified region.
+   Finally, the [F_TEST] command tests whether a write lock can be
+   acquired on the specified region, without actually putting a lock.
+   It returns immediately if successful, or fails otherwise. *)
+
+
+(** {1 Signals}
+   Note: installation of signal handlers is performed via
+   the functions {!Sys.signal} and {!Sys.set_signal}.
+*)
+
+val kill : pid:int -> signal:int -> unit
+(** [kill pid sig] sends signal number [sig] to the process
+   with id [pid]. *)
+
+type sigprocmask_command = Unix.sigprocmask_command =
+    SIG_SETMASK
+  | SIG_BLOCK
+  | SIG_UNBLOCK
+
+val sigprocmask : mode:sigprocmask_command -> int list -> int list
+(** [sigprocmask cmd sigs] changes the set of blocked signals.
+   If [cmd] is [SIG_SETMASK], blocked signals are set to those in
+   the list [sigs].
+   If [cmd] is [SIG_BLOCK], the signals in [sigs] are added to
+   the set of blocked signals.
+   If [cmd] is [SIG_UNBLOCK], the signals in [sigs] are removed
+   from the set of blocked signals.
+   [sigprocmask] returns the set of previously blocked signals. *)
+
+val sigpending : unit -> int list
+(** Return the set of blocked signals that are currently pending. *)
+
+val sigsuspend : int list -> unit
+(** [sigsuspend sigs] atomically sets the blocked signals to [sigs]
+   and waits for a non-ignored, non-blocked signal to be delivered.
+   On return, the blocked signals are reset to their initial value. *)
+
+val pause : unit -> unit
+(** Wait until a non-ignored, non-blocked signal is delivered. *)
+
+
+(** {1 Time functions} *)
+
+
+type process_times = Unix.process_times =
+  { tms_utime : float;  (** User time for the process *)
+    tms_stime : float;  (** System time for the process *)
+    tms_cutime : float; (** User time for the children processes *)
+    tms_cstime : float; (** System time for the children processes *)
+  }
+(** The execution times (CPU times) of a process. *)
+
+type tm = Unix.tm =
+  { tm_sec : int;               (** Seconds 0..60 *)
+    tm_min : int;               (** Minutes 0..59 *)
+    tm_hour : int;              (** Hours 0..23 *)
+    tm_mday : int;              (** Day of month 1..31 *)
+    tm_mon : int;               (** Month of year 0..11 *)
+    tm_year : int;              (** Year - 1900 *)
+    tm_wday : int;              (** Day of week (Sunday is 0) *)
+    tm_yday : int;              (** Day of year 0..365 *)
+    tm_isdst : bool;            (** Daylight time savings in effect *)
+  }
+(** The type representing wallclock time and calendar date. *)
+
+
+val time : unit -> float
+(** Return the current time since 00:00:00 GMT, Jan. 1, 1970,
+   in seconds. *)
+
+val gettimeofday : unit -> float
+(** Same as {!UnixLabels.time}, but with resolution better than 1 second. *)
+
+val gmtime : float -> tm
+(** Convert a time in seconds, as returned by {!UnixLabels.time}, into a date
+   and a time. Assumes UTC (Coordinated Universal Time), also known as GMT. *)
+
+val localtime : float -> tm
+(** Convert a time in seconds, as returned by {!UnixLabels.time}, into a date
+   and a time. Assumes the local time zone. *)
+
+val mktime : tm -> float * tm
+(** Convert a date and time, specified by the [tm] argument, into
+   a time in seconds, as returned by {!UnixLabels.time}.  The [tm_isdst],
+   [tm_wday] and [tm_yday] fields of [tm] are ignored.  Also return a
+   normalized copy of the given [tm] record, with the [tm_wday],
+   [tm_yday], and [tm_isdst] fields recomputed from the other fields,
+   and the other fields normalized (so that, e.g., 40 October is
+   changed into 9 November).  The [tm] argument is interpreted in the
+   local time zone. *)
+
+val alarm : int -> int
+(** Schedule a [SIGALRM] signal after the given number of seconds. *)
+
+val sleep : int -> unit
+(** Stop execution for the given number of seconds. *)
+
+val times : unit -> process_times
+(** Return the execution times of the process. *)
+
+val utimes : string -> access:float -> modif:float -> unit
+(** Set the last access time (second arg) and last modification time
+   (third arg) for a file. Times are expressed in seconds from
+   00:00:00 GMT, Jan. 1, 1970.  A time of [0.0] is interpreted as the
+   current time. *)
+
+type interval_timer = Unix.interval_timer =
+    ITIMER_REAL
+      (** decrements in real time, and sends the signal [SIGALRM] when
+          expired.*)
+  | ITIMER_VIRTUAL
+      (** decrements in process virtual time, and sends [SIGVTALRM] when
+          expired. *)
+  | ITIMER_PROF
+      (** (for profiling) decrements both when the process
+         is running and when the system is running on behalf of the
+         process; it sends [SIGPROF] when expired. *)
+(** The three kinds of interval timers. *)
+
+type interval_timer_status = Unix.interval_timer_status =
+  { it_interval : float;         (** Period *)
+    it_value : float;            (** Current value of the timer *)
+  }
+(** The type describing the status of an interval timer *)
+
+val getitimer : interval_timer -> interval_timer_status
+(** Return the current status of the given interval timer. *)
+
+val setitimer :
+  interval_timer -> interval_timer_status -> interval_timer_status
+(** [setitimer t s] sets the interval timer [t] and returns
+   its previous status. The [s] argument is interpreted as follows:
+   [s.it_value], if nonzero, is the time to the next timer expiration;
+   [s.it_interval], if nonzero, specifies a value to
+   be used in reloading it_value when the timer expires.
+   Setting [s.it_value] to zero disable the timer.
+   Setting [s.it_interval] to zero causes the timer to be disabled
+   after its next expiration. *)
+
+
+(** {1 User id, group id} *)
+
+
+val getuid : unit -> int
+(** Return the user id of the user executing the process. *)
+
+val geteuid : unit -> int
+(** Return the effective user id under which the process runs. *)
+
+val setuid : int -> unit
+(** Set the real user id and effective user id for the process. *)
+
+val getgid : unit -> int
+(** Return the group id of the user executing the process. *)
+
+val getegid : unit -> int
+(** Return the effective group id under which the process runs. *)
+
+val setgid : int -> unit
+(** Set the real group id and effective group id for the process. *)
+
+val getgroups : unit -> int array
+(** Return the list of groups to which the user executing the process
+   belongs. *)
+
+val setgroups : int array -> unit
+  (** [setgroups groups] sets the supplementary group IDs for the
+      calling process. Appropriate privileges are required. *)
+
+val initgroups : string -> int -> unit
+  (** [initgroups user group] initializes the group access list by
+      reading the group database /etc/group and using all groups of
+      which [user] is a member. The additional group [group] is also
+      added to the list. *)
+
+type passwd_entry = Unix.passwd_entry =
+  { pw_name : string;
+    pw_passwd : string;
+    pw_uid : int;
+    pw_gid : int;
+    pw_gecos : string;
+    pw_dir : string;
+    pw_shell : string
+  }
+(** Structure of entries in the [passwd] database. *)
+
+type group_entry = Unix.group_entry =
+  { gr_name : string;
+    gr_passwd : string;
+    gr_gid : int;
+    gr_mem : string array
+  }
+(** Structure of entries in the [groups] database. *)
+
+val getlogin : unit -> string
+(** Return the login name of the user executing the process. *)
+
+val getpwnam : string -> passwd_entry
+(** Find an entry in [passwd] with the given name, or raise
+   [Not_found] if the matching entry is not found. *)
+
+val getgrnam : string -> group_entry
+(** Find an entry in [group] with the given name, or raise
+   [Not_found] if the matching entry is not found. *)
+
+val getpwuid : int -> passwd_entry
+(** Find an entry in [passwd] with the given user id, or raise
+   [Not_found] if the matching entry is not found. *)
+
+val getgrgid : int -> group_entry
+(** Find an entry in [group] with the given group id, or raise
+   [Not_found] if the matching entry is not found. *)
+
+
+(** {1 Internet addresses} *)
+
+
+type inet_addr = Unix.inet_addr
+(** The abstract type of Internet addresses. *)
+
+val inet_addr_of_string : string -> inet_addr
+(** Conversion from the printable representation of an Internet
+    address to its internal representation.  The argument string
+    consists of 4 numbers separated by periods ([XXX.YYY.ZZZ.TTT])
+    for IPv4 addresses, and up to 8 numbers separated by colons
+    for IPv6 addresses.  Raise [Failure] when given a string that
+    does not match these formats. *)
+
+val string_of_inet_addr : inet_addr -> string
+(** Return the printable representation of the given Internet address.
+    See {!Unix.inet_addr_of_string} for a description of the
+    printable representation. *)
+
+val inet_addr_any : inet_addr
+(** A special IPv4 address, for use only with [bind], representing
+   all the Internet addresses that the host machine possesses. *)
+
+val inet_addr_loopback : inet_addr
+(** A special IPv4 address representing the host machine ([127.0.0.1]). *)
+
+val inet6_addr_any : inet_addr
+(** A special IPv6 address, for use only with [bind], representing
+   all the Internet addresses that the host machine possesses. *)
+
+val inet6_addr_loopback : inet_addr
+(** A special IPv6 address representing the host machine ([::1]). *)
+
+
+(** {1 Sockets} *)
+
+
+type socket_domain = Unix.socket_domain =
+    PF_UNIX                     (** Unix domain *)
+  | PF_INET                     (** Internet domain (IPv4) *)
+  | PF_INET6                    (** Internet domain (IPv6) *)
+(** The type of socket domains.  Not all platforms support
+    IPv6 sockets (type [PF_INET6]). *)
+
+type socket_type = Unix.socket_type =
+    SOCK_STREAM                 (** Stream socket *)
+  | SOCK_DGRAM                  (** Datagram socket *)
+  | SOCK_RAW                    (** Raw socket *)
+  | SOCK_SEQPACKET              (** Sequenced packets socket *)
+(** The type of socket kinds, specifying the semantics of
+   communications. *)
+
+type sockaddr = Unix.sockaddr =
+    ADDR_UNIX of string
+  | ADDR_INET of inet_addr * int (**)
+(** The type of socket addresses. [ADDR_UNIX name] is a socket
+   address in the Unix domain; [name] is a file name in the file
+   system. [ADDR_INET(addr,port)] is a socket address in the Internet
+   domain; [addr] is the Internet address of the machine, and
+   [port] is the port number. *)
+
+val socket :
+  ?cloexec:bool -> domain:socket_domain -> kind:socket_type -> protocol:int ->
+     file_descr
+(** Create a new socket in the given domain, and with the
+   given kind. The third argument is the protocol type; 0 selects
+   the default protocol for that kind of sockets. *)
+
+val domain_of_sockaddr: sockaddr -> socket_domain
+(** Return the socket domain adequate for the given socket address. *)
+
+val socketpair :
+  ?cloexec:bool -> domain:socket_domain -> kind:socket_type -> protocol:int ->
+    file_descr * file_descr
+(** Create a pair of unnamed sockets, connected together. *)
+
+val accept : ?cloexec:bool -> file_descr -> file_descr * sockaddr
+(** Accept connections on the given socket. The returned descriptor
+   is a socket connected to the client; the returned address is
+   the address of the connecting client. *)
+
+val bind : file_descr -> addr:sockaddr -> unit
+(** Bind a socket to an address. *)
+
+val connect : file_descr -> addr:sockaddr -> unit
+(** Connect a socket to an address. *)
+
+val listen : file_descr -> max:int -> unit
+(** Set up a socket for receiving connection requests. The integer
+   argument is the maximal number of pending requests. *)
+
+type shutdown_command = Unix.shutdown_command =
+    SHUTDOWN_RECEIVE            (** Close for receiving *)
+  | SHUTDOWN_SEND               (** Close for sending *)
+  | SHUTDOWN_ALL                (** Close both *)
+(** The type of commands for [shutdown]. *)
+
+
+val shutdown : file_descr -> mode:shutdown_command -> unit
+(** Shutdown a socket connection. [SHUTDOWN_SEND] as second argument
+   causes reads on the other end of the connection to return
+   an end-of-file condition.
+   [SHUTDOWN_RECEIVE] causes writes on the other end of the connection
+   to return a closed pipe condition ([SIGPIPE] signal). *)
+
+val getsockname : file_descr -> sockaddr
+(** Return the address of the given socket. *)
+
+val getpeername : file_descr -> sockaddr
+(** Return the address of the host connected to the given socket. *)
+
+type msg_flag = Unix.msg_flag =
+    MSG_OOB
+  | MSG_DONTROUTE
+  | MSG_PEEK (**)
+(** The flags for {!UnixLabels.recv},  {!UnixLabels.recvfrom},
+   {!UnixLabels.send} and {!UnixLabels.sendto}. *)
+
+val recv :
+  file_descr -> buf:bytes -> pos:int -> len:int -> mode:msg_flag list -> int
+(** Receive data from a connected socket. *)
+
+val recvfrom :
+  file_descr -> buf:bytes -> pos:int -> len:int -> mode:msg_flag list ->
+    int * sockaddr
+(** Receive data from an unconnected socket. *)
+
+val send :
+  file_descr -> buf:bytes -> pos:int -> len:int -> mode:msg_flag list -> int
+(** Send data over a connected socket. *)
+
+val send_substring :
+  file_descr -> buf:string -> pos:int -> len:int -> mode:msg_flag list -> int
+(** Same as [send], but take the data from a string instead of a byte
+    sequence.
+    @since 4.02.0 *)
+
+val sendto :
+  file_descr -> buf:bytes -> pos:int -> len:int -> mode:msg_flag list ->
+    addr:sockaddr -> int
+(** Send data over an unconnected socket. *)
+
+val sendto_substring :
+  file_descr -> buf:string -> pos:int -> len:int -> mode:msg_flag list
+  -> sockaddr -> int
+(** Same as [sendto], but take the data from a string instead of a
+    byte sequence.
+    @since 4.02.0 *)
+
+
+
+(** {1 Socket options} *)
+
+
+type socket_bool_option =
+    SO_DEBUG       (** Record debugging information *)
+  | SO_BROADCAST   (** Permit sending of broadcast messages *)
+  | SO_REUSEADDR   (** Allow reuse of local addresses for bind *)
+  | SO_KEEPALIVE   (** Keep connection active *)
+  | SO_DONTROUTE   (** Bypass the standard routing algorithms *)
+  | SO_OOBINLINE   (** Leave out-of-band data in line *)
+  | SO_ACCEPTCONN  (** Report whether socket listening is enabled *)
+  | TCP_NODELAY    (** Control the Nagle algorithm for TCP sockets *)
+  | IPV6_ONLY      (** Forbid binding an IPv6 socket to an IPv4 address *)
+(** The socket options that can be consulted with {!UnixLabels.getsockopt}
+   and modified with {!UnixLabels.setsockopt}.  These options have a boolean
+   ([true]/[false]) value. *)
+
+type socket_int_option =
+    SO_SNDBUF    (** Size of send buffer *)
+  | SO_RCVBUF    (** Size of received buffer *)
+  | SO_ERROR     (** Deprecated.  Use {!Unix.getsockopt_error} instead. *)
+  | SO_TYPE      (** Report the socket type *)
+  | SO_RCVLOWAT  (** Minimum number of bytes to process for input operations *)
+  | SO_SNDLOWAT  (** Minimum number of bytes to process for output operations *)
+(** The socket options that can be consulted with {!UnixLabels.getsockopt_int}
+   and modified with {!UnixLabels.setsockopt_int}.  These options have an
+   integer value. *)
+
+type socket_optint_option =
+  SO_LINGER      (** Whether to linger on closed connections
+                    that have data present, and for how long
+                    (in seconds) *)
+(** The socket options that can be consulted with {!Unix.getsockopt_optint}
+   and modified with {!Unix.setsockopt_optint}.  These options have a
+   value of type [int option], with [None] meaning ``disabled''. *)
+
+type socket_float_option =
+    SO_RCVTIMEO    (** Timeout for input operations *)
+  | SO_SNDTIMEO    (** Timeout for output operations *)
+(** The socket options that can be consulted with {!UnixLabels.getsockopt_float}
+   and modified with {!UnixLabels.setsockopt_float}.  These options have a
+   floating-point value representing a time in seconds.
+   The value 0 means infinite timeout. *)
+
+val getsockopt : file_descr -> socket_bool_option -> bool
+(** Return the current status of a boolean-valued option
+   in the given socket. *)
+
+val setsockopt : file_descr -> socket_bool_option -> bool -> unit
+(** Set or clear a boolean-valued option in the given socket. *)
+
+val getsockopt_int : file_descr -> socket_int_option -> int
+(** Same as {!Unix.getsockopt} for an integer-valued socket option. *)
+
+val setsockopt_int : file_descr -> socket_int_option -> int -> unit
+(** Same as {!Unix.setsockopt} for an integer-valued socket option. *)
+
+val getsockopt_optint : file_descr -> socket_optint_option -> int option
+(** Same as {!Unix.getsockopt} for a socket option whose value is
+    an [int option]. *)
+
+val setsockopt_optint :
+      file_descr -> socket_optint_option -> int option -> unit
+(** Same as {!Unix.setsockopt} for a socket option whose value is
+    an [int option]. *)
+
+val getsockopt_float : file_descr -> socket_float_option -> float
+(** Same as {!Unix.getsockopt} for a socket option whose value is a
+    floating-point number. *)
+
+val setsockopt_float : file_descr -> socket_float_option -> float -> unit
+(** Same as {!Unix.setsockopt} for a socket option whose value is a
+    floating-point number. *)
+
+val getsockopt_error : file_descr -> error option
+(** Return the error condition associated with the given socket,
+    and clear it. *)
+
+(** {1 High-level network connection functions} *)
+
+
+val open_connection : sockaddr -> in_channel * out_channel
+(** Connect to a server at the given address.
+   Return a pair of buffered channels connected to the server.
+   Remember to call {!Stdlib.flush} on the output channel at the right
+   times to ensure correct synchronization. *)
+
+val shutdown_connection : in_channel -> unit
+(** ``Shut down'' a connection established with {!UnixLabels.open_connection};
+   that is, transmit an end-of-file condition to the server reading
+   on the other side of the connection. *)
+
+val establish_server :
+  (in_channel -> out_channel -> unit) -> addr:sockaddr -> unit
+(** Establish a server on the given address.
+   The function given as first argument is called for each connection
+   with two buffered channels connected to the client. A new process
+   is created for each connection. The function {!UnixLabels.establish_server}
+   never returns normally. *)
+
+
+(** {1 Host and protocol databases} *)
+
+
+type host_entry = Unix.host_entry =
+  { h_name : string;
+    h_aliases : string array;
+    h_addrtype : socket_domain;
+    h_addr_list : inet_addr array
+  }
+(** Structure of entries in the [hosts] database. *)
+
+type protocol_entry = Unix.protocol_entry =
+  { p_name : string;
+    p_aliases : string array;
+    p_proto : int
+  }
+(** Structure of entries in the [protocols] database. *)
+
+type service_entry = Unix.service_entry =
+  { s_name : string;
+    s_aliases : string array;
+    s_port : int;
+    s_proto : string
+  }
+(** Structure of entries in the [services] database. *)
+
+val gethostname : unit -> string
+(** Return the name of the local host. *)
+
+val gethostbyname : string -> host_entry
+(** Find an entry in [hosts] with the given name, or raise
+   [Not_found]. *)
+
+val gethostbyaddr : inet_addr -> host_entry
+(** Find an entry in [hosts] with the given address, or raise
+   [Not_found]. *)
+
+val getprotobyname : string -> protocol_entry
+(** Find an entry in [protocols] with the given name, or raise
+   [Not_found]. *)
+
+val getprotobynumber : int -> protocol_entry
+(** Find an entry in [protocols] with the given protocol number,
+   or raise [Not_found]. *)
+
+val getservbyname : string -> protocol:string -> service_entry
+(** Find an entry in [services] with the given name, or raise
+   [Not_found]. *)
+
+val getservbyport : int -> protocol:string -> service_entry
+(** Find an entry in [services] with the given service number,
+   or raise [Not_found]. *)
+
+type addr_info =
+  { ai_family : socket_domain;          (** Socket domain *)
+    ai_socktype : socket_type;          (** Socket type *)
+    ai_protocol : int;                  (** Socket protocol number *)
+    ai_addr : sockaddr;                 (** Address *)
+    ai_canonname : string               (** Canonical host name  *)
+  }
+(** Address information returned by {!Unix.getaddrinfo}. *)
+
+type getaddrinfo_option =
+    AI_FAMILY of socket_domain          (** Impose the given socket domain *)
+  | AI_SOCKTYPE of socket_type          (** Impose the given socket type *)
+  | AI_PROTOCOL of int                  (** Impose the given protocol  *)
+  | AI_NUMERICHOST                      (** Do not call name resolver,
+                                            expect numeric IP address *)
+  | AI_CANONNAME                        (** Fill the [ai_canonname] field
+                                            of the result *)
+  | AI_PASSIVE                          (** Set address to ``any'' address
+                                            for use with {!Unix.bind} *)
+(** Options to {!Unix.getaddrinfo}. *)
+
+val getaddrinfo:
+  string -> string -> getaddrinfo_option list -> addr_info list
+(** [getaddrinfo host service opts] returns a list of {!Unix.addr_info}
+    records describing socket parameters and addresses suitable for
+    communicating with the given host and service.  The empty list is
+    returned if the host or service names are unknown, or the constraints
+    expressed in [opts] cannot be satisfied.
+
+    [host] is either a host name or the string representation of an IP
+    address.  [host] can be given as the empty string; in this case,
+    the ``any'' address or the ``loopback'' address are used,
+    depending whether [opts] contains [AI_PASSIVE].
+    [service] is either a service name or the string representation of
+    a port number.  [service] can be given as the empty string;
+    in this case, the port field of the returned addresses is set to 0.
+    [opts] is a possibly empty list of options that allows the caller
+    to force a particular socket domain (e.g. IPv6 only or IPv4 only)
+    or a particular socket type (e.g. TCP only or UDP only). *)
+
+type name_info =
+  { ni_hostname : string;               (** Name or IP address of host *)
+    ni_service : string;                (** Name of service or port number *)
+  }
+(** Host and service information returned by {!Unix.getnameinfo}. *)
+
+type getnameinfo_option =
+    NI_NOFQDN            (** Do not qualify local host names *)
+  | NI_NUMERICHOST       (** Always return host as IP address *)
+  | NI_NAMEREQD          (** Fail if host name cannot be determined *)
+  | NI_NUMERICSERV       (** Always return service as port number *)
+  | NI_DGRAM             (** Consider the service as UDP-based
+                             instead of the default TCP *)
+(** Options to {!Unix.getnameinfo}. *)
+
+val getnameinfo : sockaddr -> getnameinfo_option list -> name_info
+(** [getnameinfo addr opts] returns the host name and service name
+    corresponding to the socket address [addr].  [opts] is a possibly
+    empty list of options that governs how these names are obtained.
+    Raise [Not_found] if an error occurs. *)
+
+
+(** {1 Terminal interface} *)
+
+
+(** The following functions implement the POSIX standard terminal
+   interface. They provide control over asynchronous communication ports
+   and pseudo-terminals. Refer to the [termios] man page for a
+   complete description. *)
+
+type terminal_io = Unix.terminal_io =
+  {
+    (* input modes *)
+    mutable c_ignbrk : bool;  (** Ignore the break condition. *)
+    mutable c_brkint : bool;  (** Signal interrupt on break condition. *)
+    mutable c_ignpar : bool;  (** Ignore characters with parity errors. *)
+    mutable c_parmrk : bool;  (** Mark parity errors. *)
+    mutable c_inpck : bool;   (** Enable parity check on input. *)
+    mutable c_istrip : bool;  (** Strip 8th bit on input characters. *)
+    mutable c_inlcr : bool;   (** Map NL to CR on input. *)
+    mutable c_igncr : bool;   (** Ignore CR on input. *)
+    mutable c_icrnl : bool;   (** Map CR to NL on input. *)
+    mutable c_ixon : bool;    (** Recognize XON/XOFF characters on input. *)
+    mutable c_ixoff : bool;   (** Emit XON/XOFF chars to control input flow. *)
+    (* Output modes: *)
+    mutable c_opost : bool;   (** Enable output processing. *)
+    (* Control modes: *)
+    mutable c_obaud : int;    (** Output baud rate (0 means close connection).*)
+    mutable c_ibaud : int;    (** Input baud rate. *)
+    mutable c_csize : int;    (** Number of bits per character (5-8). *)
+    mutable c_cstopb : int;   (** Number of stop bits (1-2). *)
+    mutable c_cread : bool;   (** Reception is enabled. *)
+    mutable c_parenb : bool;  (** Enable parity generation and detection. *)
+    mutable c_parodd : bool;  (** Specify odd parity instead of even. *)
+    mutable c_hupcl : bool;   (** Hang up on last close. *)
+    mutable c_clocal : bool;  (** Ignore modem status lines. *)
+    (* Local modes: *)
+    mutable c_isig : bool;    (** Generate signal on INTR, QUIT, SUSP. *)
+    mutable c_icanon : bool;  (** Enable canonical processing
+                                 (line buffering and editing) *)
+    mutable c_noflsh : bool;  (** Disable flush after INTR, QUIT, SUSP. *)
+    mutable c_echo : bool;    (** Echo input characters. *)
+    mutable c_echoe : bool;   (** Echo ERASE (to erase previous character). *)
+    mutable c_echok : bool;   (** Echo KILL (to erase the current line). *)
+    mutable c_echonl : bool;  (** Echo NL even if c_echo is not set. *)
+    (* Control characters: *)
+    mutable c_vintr : char;   (** Interrupt character (usually ctrl-C). *)
+    mutable c_vquit : char;   (** Quit character (usually ctrl-\). *)
+    mutable c_verase : char;  (** Erase character (usually DEL or ctrl-H). *)
+    mutable c_vkill : char;   (** Kill line character (usually ctrl-U). *)
+    mutable c_veof : char;    (** End-of-file character (usually ctrl-D). *)
+    mutable c_veol : char;    (** Alternate end-of-line char. (usually none). *)
+    mutable c_vmin : int;     (** Minimum number of characters to read
+                                 before the read request is satisfied. *)
+    mutable c_vtime : int;    (** Maximum read wait (in 0.1s units). *)
+    mutable c_vstart : char;  (** Start character (usually ctrl-Q). *)
+    mutable c_vstop : char;   (** Stop character (usually ctrl-S). *)
+  }
+
+val tcgetattr : file_descr -> terminal_io
+(** Return the status of the terminal referred to by the given
+   file descriptor. *)
+
+type setattr_when = Unix.setattr_when =
+    TCSANOW
+  | TCSADRAIN
+  | TCSAFLUSH
+
+val tcsetattr : file_descr -> mode:setattr_when -> terminal_io -> unit
+(** Set the status of the terminal referred to by the given
+   file descriptor. The second argument indicates when the
+   status change takes place: immediately ([TCSANOW]),
+   when all pending output has been transmitted ([TCSADRAIN]),
+   or after flushing all input that has been received but not
+   read ([TCSAFLUSH]). [TCSADRAIN] is recommended when changing
+   the output parameters; [TCSAFLUSH], when changing the input
+   parameters. *)
+
+val tcsendbreak : file_descr -> duration:int -> unit
+(** Send a break condition on the given file descriptor.
+   The second argument is the duration of the break, in 0.1s units;
+   0 means standard duration (0.25s). *)
+
+val tcdrain : file_descr -> unit
+(** Waits until all output written on the given file descriptor
+   has been transmitted. *)
+
+type flush_queue = Unix.flush_queue =
+    TCIFLUSH
+  | TCOFLUSH
+  | TCIOFLUSH
+
+val tcflush : file_descr -> mode:flush_queue -> unit
+(** Discard data written on the given file descriptor but not yet
+   transmitted, or data received but not yet read, depending on the
+   second argument: [TCIFLUSH] flushes data received but not read,
+   [TCOFLUSH] flushes data written but not transmitted, and
+   [TCIOFLUSH] flushes both. *)
+
+type flow_action = Unix.flow_action =
+    TCOOFF
+  | TCOON
+  | TCIOFF
+  | TCION
+
+val tcflow : file_descr -> mode:flow_action -> unit
+(** Suspend or restart reception or transmission of data on
+   the given file descriptor, depending on the second argument:
+   [TCOOFF] suspends output, [TCOON] restarts output,
+   [TCIOFF] transmits a STOP character to suspend input,
+   and [TCION] transmits a START character to restart input. *)
+
+val setsid : unit -> int
+(** Put the calling process in a new session and detach it from
+   its controlling terminal. *)
diff --git a/otherlibs/unix/unixsupport.c b/otherlibs/unix/unixsupport.c
new file mode 100644
index 00000000..937146b2
--- /dev/null
+++ b/otherlibs/unix/unixsupport.c
@@ -0,0 +1,347 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/callback.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include "unixsupport.h"
+#include "cst2constr.h"
+#include <errno.h>
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#include <fcntl.h>
+
+#ifndef E2BIG
+#define E2BIG (-1)
+#endif
+#ifndef EACCES
+#define EACCES (-1)
+#endif
+#ifndef EAGAIN
+#define EAGAIN (-1)
+#endif
+#ifndef EBADF
+#define EBADF (-1)
+#endif
+#ifndef EBUSY
+#define EBUSY (-1)
+#endif
+#ifndef ECHILD
+#define ECHILD (-1)
+#endif
+#ifndef EDEADLK
+#define EDEADLK (-1)
+#endif
+#ifndef EDOM
+#define EDOM (-1)
+#endif
+#ifndef EEXIST
+#define EEXIST (-1)
+#endif
+
+#ifndef EFAULT
+#define EFAULT (-1)
+#endif
+#ifndef EFBIG
+#define EFBIG (-1)
+#endif
+#ifndef EINTR
+#define EINTR (-1)
+#endif
+#ifndef EINVAL
+#define EINVAL (-1)
+#endif
+#ifndef EIO
+#define EIO (-1)
+#endif
+#ifndef EISDIR
+#define EISDIR (-1)
+#endif
+#ifndef EMFILE
+#define EMFILE (-1)
+#endif
+#ifndef EMLINK
+#define EMLINK (-1)
+#endif
+#ifndef ENAMETOOLONG
+#define ENAMETOOLONG (-1)
+#endif
+#ifndef ENFILE
+#define ENFILE (-1)
+#endif
+#ifndef ENODEV
+#define ENODEV (-1)
+#endif
+#ifndef ENOENT
+#define ENOENT (-1)
+#endif
+#ifndef ENOEXEC
+#define ENOEXEC (-1)
+#endif
+#ifndef ENOLCK
+#define ENOLCK (-1)
+#endif
+#ifndef ENOMEM
+#define ENOMEM (-1)
+#endif
+#ifndef ENOSPC
+#define ENOSPC (-1)
+#endif
+#ifndef ENOSYS
+#define ENOSYS (-1)
+#endif
+#ifndef ENOTDIR
+#define ENOTDIR (-1)
+#endif
+#ifndef ENOTEMPTY
+#define ENOTEMPTY (-1)
+#endif
+#ifndef ENOTTY
+#define ENOTTY (-1)
+#endif
+#ifndef ENXIO
+#define ENXIO (-1)
+#endif
+#ifndef EPERM
+#define EPERM (-1)
+#endif
+#ifndef EPIPE
+#define EPIPE (-1)
+#endif
+#ifndef ERANGE
+#define ERANGE (-1)
+#endif
+#ifndef EROFS
+#define EROFS (-1)
+#endif
+#ifndef ESPIPE
+#define ESPIPE (-1)
+#endif
+#ifndef ESRCH
+#define ESRCH (-1)
+#endif
+#ifndef EXDEV
+#define EXDEV (-1)
+#endif
+#ifndef EWOULDBLOCK
+#define EWOULDBLOCK (-1)
+#endif
+#ifndef EINPROGRESS
+#define EINPROGRESS (-1)
+#endif
+#ifndef EALREADY
+#define EALREADY (-1)
+#endif
+#ifndef ENOTSOCK
+#define ENOTSOCK (-1)
+#endif
+#ifndef EDESTADDRREQ
+#define EDESTADDRREQ (-1)
+#endif
+#ifndef EMSGSIZE
+#define EMSGSIZE (-1)
+#endif
+#ifndef EPROTOTYPE
+#define EPROTOTYPE (-1)
+#endif
+#ifndef ENOPROTOOPT
+#define ENOPROTOOPT (-1)
+#endif
+#ifndef EPROTONOSUPPORT
+#define EPROTONOSUPPORT (-1)
+#endif
+#ifndef ESOCKTNOSUPPORT
+#define ESOCKTNOSUPPORT (-1)
+#endif
+#ifndef EOPNOTSUPP
+#  ifdef ENOTSUP
+#    define EOPNOTSUPP ENOTSUP
+#  else
+#    define EOPNOTSUPP (-1)
+#  endif
+#endif
+#ifndef EPFNOSUPPORT
+#define EPFNOSUPPORT (-1)
+#endif
+#ifndef EAFNOSUPPORT
+#define EAFNOSUPPORT (-1)
+#endif
+#ifndef EADDRINUSE
+#define EADDRINUSE (-1)
+#endif
+#ifndef EADDRNOTAVAIL
+#define EADDRNOTAVAIL (-1)
+#endif
+#ifndef ENETDOWN
+#define ENETDOWN (-1)
+#endif
+#ifndef ENETUNREACH
+#define ENETUNREACH (-1)
+#endif
+#ifndef ENETRESET
+#define ENETRESET (-1)
+#endif
+#ifndef ECONNABORTED
+#define ECONNABORTED (-1)
+#endif
+#ifndef ECONNRESET
+#define ECONNRESET (-1)
+#endif
+#ifndef ENOBUFS
+#define ENOBUFS (-1)
+#endif
+#ifndef EISCONN
+#define EISCONN (-1)
+#endif
+#ifndef ENOTCONN
+#define ENOTCONN (-1)
+#endif
+#ifndef ESHUTDOWN
+#define ESHUTDOWN (-1)
+#endif
+#ifndef ETOOMANYREFS
+#define ETOOMANYREFS (-1)
+#endif
+#ifndef ETIMEDOUT
+#define ETIMEDOUT (-1)
+#endif
+#ifndef ECONNREFUSED
+#define ECONNREFUSED (-1)
+#endif
+#ifndef EHOSTDOWN
+#define EHOSTDOWN (-1)
+#endif
+#ifndef EHOSTUNREACH
+#define EHOSTUNREACH (-1)
+#endif
+#ifndef ENOTEMPTY
+#define ENOTEMPTY (-1)
+#endif
+#ifndef ELOOP
+#define ELOOP (-1)
+#endif
+#ifndef EOVERFLOW
+#define EOVERFLOW (-1)
+#endif
+
+int error_table[] = {
+  E2BIG, EACCES, EAGAIN, EBADF, EBUSY, ECHILD, EDEADLK, EDOM,
+  EEXIST, EFAULT, EFBIG, EINTR, EINVAL, EIO, EISDIR, EMFILE, EMLINK,
+  ENAMETOOLONG, ENFILE, ENODEV, ENOENT, ENOEXEC, ENOLCK, ENOMEM, ENOSPC,
+  ENOSYS, ENOTDIR, ENOTEMPTY, ENOTTY, ENXIO, EPERM, EPIPE, ERANGE,
+  EROFS, ESPIPE, ESRCH, EXDEV, EWOULDBLOCK, EINPROGRESS, EALREADY,
+  ENOTSOCK, EDESTADDRREQ, EMSGSIZE, EPROTOTYPE, ENOPROTOOPT,
+  EPROTONOSUPPORT, ESOCKTNOSUPPORT, EOPNOTSUPP, EPFNOSUPPORT,
+  EAFNOSUPPORT, EADDRINUSE, EADDRNOTAVAIL, ENETDOWN, ENETUNREACH,
+  ENETRESET, ECONNABORTED, ECONNRESET, ENOBUFS, EISCONN, ENOTCONN,
+  ESHUTDOWN, ETOOMANYREFS, ETIMEDOUT, ECONNREFUSED, EHOSTDOWN,
+  EHOSTUNREACH, ELOOP, EOVERFLOW /*, EUNKNOWNERR */
+};
+
+static const value * unix_error_exn = NULL;
+
+value unix_error_of_code (int errcode)
+{
+  int errconstr;
+  value err;
+
+#if defined(ENOTSUP) && (EOPNOTSUPP != ENOTSUP)
+  if (errcode == ENOTSUP)
+    errcode = EOPNOTSUPP;
+#endif
+
+  errconstr =
+      cst_to_constr(errcode, error_table, sizeof(error_table)/sizeof(int), -1);
+  if (errconstr == Val_int(-1)) {
+    err = caml_alloc_small(1, 0);
+    Field(err, 0) = Val_int(errcode);
+  } else {
+    err = errconstr;
+  }
+  return err;
+}
+
+extern int code_of_unix_error (value error)
+{
+  if (Is_block(error)) {
+    return Int_val(Field(error, 0));
+  } else {
+    return error_table[Int_val(error)];
+  }
+}
+
+void unix_error(int errcode, const char *cmdname, value cmdarg)
+{
+  value res;
+  value name = Val_unit, err = Val_unit, arg = Val_unit;
+
+  Begin_roots3 (name, err, arg);
+    arg = cmdarg == Nothing ? caml_copy_string("") : cmdarg;
+    name = caml_copy_string(cmdname);
+    err = unix_error_of_code (errcode);
+    if (unix_error_exn == NULL) {
+      unix_error_exn = caml_named_value("Unix.Unix_error");
+      if (unix_error_exn == NULL)
+        caml_invalid_argument("Exception Unix.Unix_error not initialized,"
+                         " please link unix.cma");
+    }
+    res = caml_alloc_small(4, 0);
+    Field(res, 0) = *unix_error_exn;
+    Field(res, 1) = err;
+    Field(res, 2) = name;
+    Field(res, 3) = arg;
+  End_roots();
+  caml_raise(res);
+}
+
+void uerror(const char *cmdname, value cmdarg)
+{
+  unix_error(errno, cmdname, cmdarg);
+}
+
+void caml_unix_check_path(value path, const char * cmdname)
+{
+  if (! caml_string_is_c_safe(path)) unix_error(ENOENT, cmdname, path);
+}
+
+int unix_cloexec_default = 0;
+
+int unix_cloexec_p(value cloexec)
+{
+  /* [cloexec] is a [bool option].  */
+  if (Is_block(cloexec))
+    return Bool_val(Field(cloexec, 0));
+  else
+    return unix_cloexec_default;
+}
+
+void unix_set_cloexec(int fd, char *cmdname, value cmdarg)
+{
+  int flags = fcntl(fd, F_GETFD, 0);
+  if (flags == -1 ||
+      fcntl(fd, F_SETFD, flags | FD_CLOEXEC) == -1)
+    uerror(cmdname, cmdarg);
+}
+
+void unix_clear_cloexec(int fd, char *cmdname, value cmdarg)
+{
+  int flags = fcntl(fd, F_GETFD, 0);
+  if (flags == -1 ||
+      fcntl(fd, F_SETFD, flags & ~FD_CLOEXEC) == -1)
+    uerror(cmdname, cmdarg);
+}
diff --git a/otherlibs/unix/unixsupport.h b/otherlibs/unix/unixsupport.h
new file mode 100644
index 00000000..fe345466
--- /dev/null
+++ b/otherlibs/unix/unixsupport.h
@@ -0,0 +1,60 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_UNIXSUPPORT_H
+#define CAML_UNIXSUPPORT_H
+
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define Nothing ((value) 0)
+
+extern value unix_error_of_code (int errcode);
+extern int code_of_unix_error (value error);
+
+CAMLnoreturn_start
+extern void unix_error (int errcode, const char * cmdname, value arg)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+extern void uerror (const char * cmdname, value arg)
+CAMLnoreturn_end;
+
+extern void caml_unix_check_path(value path, const char * cmdname);
+
+#define UNIX_BUFFER_SIZE 65536
+
+#define DIR_Val(v) *((DIR **) &Field(v, 0))
+
+extern char ** cstringvect(value arg, char * cmdname);
+extern void cstringvect_free(char **);
+
+extern int unix_cloexec_default;
+extern int unix_cloexec_p(value cloexec);
+extern void unix_set_cloexec(int fd, char * cmdname, value arg);
+extern void unix_clear_cloexec(int fd, char * cmdname, value arg);
+
+#ifdef __cplusplus
+}
+#endif
+
+#define EXECV_CAST
+
+#endif /* CAML_UNIXSUPPORT_H */
diff --git a/otherlibs/unix/unlink.c b/otherlibs/unix/unlink.c
new file mode 100644
index 00000000..578125f5
--- /dev/null
+++ b/otherlibs/unix/unlink.c
@@ -0,0 +1,37 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_unlink(value path)
+{
+  CAMLparam1(path);
+  char_os * p;
+  int ret;
+  caml_unix_check_path(path, "unlink");
+  p = caml_stat_strdup_to_os(String_val(path));
+  caml_enter_blocking_section();
+  ret = unlink_os(p);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1) uerror("unlink", path);
+  CAMLreturn(Val_unit);
+}
diff --git a/otherlibs/unix/utimes.c b/otherlibs/unix/utimes.c
new file mode 100644
index 00000000..a706fdf6
--- /dev/null
+++ b/otherlibs/unix/utimes.c
@@ -0,0 +1,94 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+#if defined(HAS_UTIMES)
+
+#include <sys/types.h>
+#include <sys/time.h>
+
+CAMLprim value unix_utimes(value path, value atime, value mtime)
+{
+  CAMLparam3(path, atime, mtime);
+  struct timeval tv[2], * t;
+  char * p;
+  int ret;
+  double at, mt;
+  caml_unix_check_path(path, "utimes");
+  at = Double_val(atime);
+  mt = Double_val(mtime);
+  if (at == 0.0 && mt == 0.0) {
+    t = (struct timeval *) NULL;
+  } else {
+    tv[0].tv_sec = at;
+    tv[0].tv_usec = (at - tv[0].tv_sec) * 1000000;
+    tv[1].tv_sec = mt;
+    tv[1].tv_usec = (mt - tv[1].tv_sec) * 1000000;
+    t = tv;
+  }
+  p = caml_stat_strdup(String_val(path));
+  caml_enter_blocking_section();
+  ret = utimes(p, t);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1) uerror("utimes", path);
+  CAMLreturn(Val_unit);
+}
+
+#elif defined(HAS_UTIME)
+
+#include <sys/types.h>
+#include <utime.h>
+
+CAMLprim value unix_utimes(value path, value atime, value mtime)
+{
+  CAMLparam3(path, atime, mtime);
+  struct utimbuf times, * t;
+  char * p;
+  int ret;
+  double at, mt;
+  caml_unix_check_path(path, "utimes");
+  at = Double_val(atime);
+  mt = Double_val(mtime);
+  if (at == 0.0 && mt == 0.0) {
+    t = NULL;
+  } else {
+    times.actime = at;
+    times.modtime = mt;
+    t = ×
+  }
+  p = caml_stat_strdup(String_val(path));
+  caml_enter_blocking_section();
+  ret = utime(p, t);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1) uerror("utimes", path);
+  CAMLreturn(Val_unit);
+}
+
+#else
+
+CAMLprim value unix_utimes(value path, value atime, value mtime)
+{ caml_invalid_argument("utimes not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/wait.c b/otherlibs/unix/wait.c
new file mode 100644
index 00000000..d0f06bfc
--- /dev/null
+++ b/otherlibs/unix/wait.c
@@ -0,0 +1,107 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#include <sys/types.h>
+#include <sys/wait.h>
+
+#if !(defined(WIFEXITED) && defined(WEXITSTATUS) && defined(WIFSTOPPED) && \
+      defined(WSTOPSIG) && defined(WTERMSIG))
+/* Assume old-style V7 status word */
+#define WIFEXITED(status) (((status) & 0xFF) == 0)
+#define WEXITSTATUS(status) (((status) >> 8) & 0xFF)
+#define WIFSTOPPED(status) (((status) & 0xFF) == 0xFF)
+#define WSTOPSIG(status) (((status) >> 8) & 0xFF)
+#define WTERMSIG(status) ((status) & 0x3F)
+#endif
+
+#define TAG_WEXITED 0
+#define TAG_WSIGNALED 1
+#define TAG_WSTOPPED 2
+
+static value alloc_process_status(int pid, int status)
+{
+  value st, res;
+
+  // status is undefined when pid is zero so we set a default value.
+  if (pid == 0) status = 0;
+
+  if (WIFEXITED(status)) {
+    st = caml_alloc_small(1, TAG_WEXITED);
+    Field(st, 0) = Val_int(WEXITSTATUS(status));
+  }
+  else if (WIFSTOPPED(status)) {
+    st = caml_alloc_small(1, TAG_WSTOPPED);
+    Field(st, 0) = Val_int(caml_rev_convert_signal_number(WSTOPSIG(status)));
+  }
+  else {
+    st = caml_alloc_small(1, TAG_WSIGNALED);
+    Field(st, 0) = Val_int(caml_rev_convert_signal_number(WTERMSIG(status)));
+  }
+  Begin_root (st);
+    res = caml_alloc_small(2, 0);
+    Field(res, 0) = Val_int(pid);
+    Field(res, 1) = st;
+  End_roots();
+  return res;
+}
+
+CAMLprim value unix_wait(value unit)
+{
+  int pid, status;
+
+  caml_enter_blocking_section();
+  pid = wait(&status);
+  caml_leave_blocking_section();
+  if (pid == -1) uerror("wait", Nothing);
+  return alloc_process_status(pid, status);
+}
+
+#if defined(HAS_WAITPID) || defined(HAS_WAIT4)
+
+#ifndef HAS_WAITPID
+#define waitpid(pid,status,opts) wait4(pid,status,opts,NULL)
+#endif
+
+static int wait_flag_table[] = {
+  WNOHANG, WUNTRACED
+};
+
+CAMLprim value unix_waitpid(value flags, value pid_req)
+{
+  int pid, status, cv_flags;
+
+  cv_flags = caml_convert_flag_list(flags, wait_flag_table);
+  caml_enter_blocking_section();
+  pid = waitpid(Int_val(pid_req), &status, cv_flags);
+  caml_leave_blocking_section();
+  if (pid == -1) uerror("waitpid", Nothing);
+  return alloc_process_status(pid, status);
+}
+
+#else
+
+CAMLprim value unix_waitpid(value flags, value pid_req)
+{ caml_invalid_argument("waitpid not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/write.c b/otherlibs/unix/write.c
new file mode 100644
index 00000000..8d5b6a87
--- /dev/null
+++ b/otherlibs/unix/write.c
@@ -0,0 +1,86 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <errno.h>
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+#ifndef EAGAIN
+#define EAGAIN (-1)
+#endif
+#ifndef EWOULDBLOCK
+#define EWOULDBLOCK (-1)
+#endif
+
+CAMLprim value unix_write(value fd, value buf, value vofs, value vlen)
+{
+  long ofs, len, written;
+  int numbytes, ret;
+  char iobuf[UNIX_BUFFER_SIZE];
+
+  Begin_root (buf);
+    ofs = Long_val(vofs);
+    len = Long_val(vlen);
+    written = 0;
+    while (len > 0) {
+      numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len;
+      memmove (iobuf, &Byte(buf, ofs), numbytes);
+      caml_enter_blocking_section();
+      ret = write(Int_val(fd), iobuf, numbytes);
+      caml_leave_blocking_section();
+      if (ret == -1) {
+        if ((errno == EAGAIN || errno == EWOULDBLOCK) && written > 0) break;
+        uerror("write", Nothing);
+      }
+      written += ret;
+      ofs += ret;
+      len -= ret;
+    }
+  End_roots();
+  return Val_long(written);
+}
+
+/* When an error occurs after the first loop, unix_write reports the
+   error and discards the number of already written characters.
+   In this case, it would be better to discard the error and return the
+   number of bytes written, since most likely, unix_write will be call again,
+   and the error will be reproduced and this time will be reported.
+   This problem is avoided in unix_single_write, which is faithful to the
+   Unix system call. */
+
+CAMLprim value unix_single_write(value fd, value buf, value vofs, value vlen)
+{
+  long ofs, len;
+  int numbytes, ret;
+  char iobuf[UNIX_BUFFER_SIZE];
+
+  Begin_root (buf);
+    ofs = Long_val(vofs);
+    len = Long_val(vlen);
+    ret = 0;
+    if (len > 0) {
+      numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len;
+      memmove (iobuf, &Byte(buf, ofs), numbytes);
+      caml_enter_blocking_section();
+      ret = write(Int_val(fd), iobuf, numbytes);
+      caml_leave_blocking_section();
+      if (ret == -1) uerror("single_write", Nothing);
+    }
+  End_roots();
+  return Val_int(ret);
+}
diff --git a/otherlibs/win32unix/.depend b/otherlibs/win32unix/.depend
new file mode 100644
index 00000000..68b0f1b2
--- /dev/null
+++ b/otherlibs/win32unix/.depend
@@ -0,0 +1,563 @@
+accept.$(O): accept.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
+bind.$(O): bind.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
+channels.$(O): channels.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/io.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ unixsupport.h
+close.$(O): close.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h \
+ ../../runtime/caml/io.h
+close_on.$(O): close_on.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+connect.$(O): connect.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
+ unixsupport.h socketaddr.h ../../runtime/caml/misc.h
+createprocess.$(O): createprocess.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ unixsupport.h ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h
+dup.$(O): dup.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+dup2.$(O): dup2.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+errmsg.$(O): errmsg.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ unixsupport.h
+envir.$(O): envir.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h
+getpeername.$(O): getpeername.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
+getpid.$(O): getpid.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+getsockname.$(O): getsockname.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
+gettimeofday.$(O): gettimeofday.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ unixsupport.h
+isatty.$(O): isatty.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
+ ../../runtime/caml/domain.h unixsupport.h
+link.$(O): link.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+listen.$(O): listen.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+lockf.$(O): lockf.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \
+ ../../runtime/caml/signals.h
+lseek.$(O): lseek.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ unixsupport.h
+nonblock.$(O): nonblock.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
+ unixsupport.h
+mkdir.$(O): mkdir.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/memory.h unixsupport.h
+mmap.$(O): mmap.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/bigarray.h ../../runtime/caml/fail.h \
+ ../../runtime/caml/io.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/sys.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ unixsupport.h
+open.$(O): open.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/memory.h unixsupport.h
+pipe.$(O): pipe.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/alloc.h unixsupport.h
+read.$(O): read.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
+readlink.$(O): readlink.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/fail.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+rename.$(O): rename.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/memory.h unixsupport.h
+select.$(O): select.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/signals.h winworker.h \
+ unixsupport.h windbug.h winlist.h
+sendrecv.$(O): sendrecv.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
+shutdown.$(O): shutdown.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+sleep.$(O): sleep.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
+ unixsupport.h
+socket.$(O): socket.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+sockopt.$(O): sockopt.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
+startup.$(O): startup.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl winworker.h unixsupport.h windbug.h
+stat.$(O): stat.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/signals.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h \
+ ../unix/cst2constr.h
+symlink.$(O): symlink.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/fail.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+system.$(O): system.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/signals.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+times.$(O): times.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ unixsupport.h
+truncate.$(O): truncate.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/signals.h \
+ ../../runtime/caml/io.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+unixsupport.$(O): unixsupport.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/callback.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/fail.h \
+ ../../runtime/caml/custom.h unixsupport.h ../unix/cst2constr.h
+windir.$(O): windir.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/alloc.h ../../runtime/caml/fail.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+winwait.$(O): winwait.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h unixsupport.h
+write.$(O): write.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
+winlist.$(O): winlist.c winlist.h
+winworker.$(O): winworker.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h winworker.h unixsupport.h winlist.h \
+ windbug.h
+windbug.$(O): windbug.c windbug.h
+utimes.$(O): utimes.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+access.$(O): access.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+addrofstr.$(O): addrofstr.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
+chdir.$(O): chdir.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+chmod.$(O): chmod.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+cst2constr.$(O): cst2constr.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
+ ../unix/cst2constr.h
+cstringv.$(O): cstringv.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+execv.$(O): execv.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+execve.$(O): execve.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+execvp.$(O): execvp.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+exit.$(O): exit.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl unixsupport.h
+getaddrinfo.$(O): getaddrinfo.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/signals.h unixsupport.h ../unix/cst2constr.h \
+ socketaddr.h
+getcwd.$(O): getcwd.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
+ ../../runtime/caml/domain.h unixsupport.h
+gethost.$(O): gethost.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
+gethostname.$(O): gethostname.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h unixsupport.h
+getnameinfo.$(O): getnameinfo.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
+getproto.$(O): getproto.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
+getserv.$(O): getserv.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
+gmtime.$(O): gmtime.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
+ ../../runtime/caml/domain.h unixsupport.h
+mmap_ba.$(O): mmap_ba.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/bigarray.h ../../runtime/caml/custom.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/misc.h
+putenv.$(O): putenv.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
+ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
+ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
+ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
+ ../../runtime/caml/domain.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
+rmdir.$(O): rmdir.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+socketaddr.$(O): socketaddr.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/memory.h ../../runtime/caml/domain.h unixsupport.h \
+ socketaddr.h ../../runtime/caml/misc.h
+strofaddr.$(O): strofaddr.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ ../../runtime/caml/fail.h unixsupport.h socketaddr.h \
+ ../../runtime/caml/misc.h
+time.$(O): time.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
+ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
+ unixsupport.h
+unlink.$(O): unlink.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
+ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
+ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
+ ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
+ ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
+ ../../runtime/caml/memory.h unixsupport.h
+fsync.$(O): fsync.c ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/config.h ../../runtime/caml/m.h \
+ ../../runtime/caml/s.h ../../runtime/caml/misc.h \
+ ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
+ ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
+ unixsupport.h
+unix.cmo : \
+    unix.cmi
+unix.cmx : \
+    unix.cmi
+unix.cmi :
+unixLabels.cmo : \
+    unix.cmi \
+    unixLabels.cmi
+unixLabels.cmx : \
+    unix.cmx \
+    unixLabels.cmi
+unixLabels.cmi : \
+    unix.cmi
diff --git a/otherlibs/win32unix/Makefile b/otherlibs/win32unix/Makefile
new file mode 100644
index 00000000..7d5ec984
--- /dev/null
+++ b/otherlibs/win32unix/Makefile
@@ -0,0 +1,79 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# Note: since this directory is Windows-specific, it may be good to make sure
+# its content can not be compiled under Unix.
+# This directory could even become a subdirectory of the unix directory.
+
+# Files in this directory
+WIN_FILES = accept.c bind.c channels.c close.c \
+  close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c envir.c \
+  getpeername.c getpid.c getsockname.c gettimeofday.c isatty.c \
+  link.c listen.c lockf.c lseek.c nonblock.c \
+  mkdir.c mmap.c open.c pipe.c read.c readlink.c rename.c \
+  select.c sendrecv.c \
+  shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
+  symlink.c system.c times.c truncate.c unixsupport.c windir.c winwait.c \
+  write.c winlist.c winworker.c windbug.c utimes.c
+
+# Files from the ../unix directory
+UNIX_FILES = access.c addrofstr.c chdir.c chmod.c cst2constr.c \
+  cstringv.c execv.c execve.c execvp.c \
+  exit.c getaddrinfo.c getcwd.c gethost.c gethostname.c \
+  getnameinfo.c getproto.c \
+  getserv.c gmtime.c mmap_ba.c putenv.c rmdir.c \
+  socketaddr.c strofaddr.c time.c unlink.c fsync.c
+
+UNIX_CAML_FILES = unix.mli unixLabels.mli unixLabels.ml
+
+ALL_FILES=$(WIN_FILES) $(UNIX_FILES)
+
+LIBNAME=unix
+COBJS=$(ALL_FILES:.c=.$(O))
+CAMLOBJS=unix.cmo unixLabels.cmo
+WIN32_LIBS=$(call SYSLIB,ws2_32) $(call SYSLIB,advapi32)
+LINKOPTS=$(addprefix -cclib ,$(WIN32_LIBS))
+EXTRACAMLFLAGS=-nolabels
+EXTRACFLAGS=-I../unix
+HEADERS=unixsupport.h socketaddr.h
+
+
+include ../Makefile.otherlibs.common
+
+ifeq "$(SYSTEM)" "mingw"
+LDOPTS=-ldopt "-link -static-libgcc" $(addprefix -ldopt ,$(WIN32_LIBS))
+else
+LDOPTS=$(addprefix -ldopt ,$(WIN32_LIBS))
+endif
+
+clean::
+	rm -f $(UNIX_FILES) $(UNIX_CAML_FILES)
+
+$(UNIX_FILES) $(UNIX_CAML_FILES): %: ../unix/%
+	cp ../unix/$* $*
+
+.PHONY: depend
+ifeq "$(TOOLCHAIN)" "msvc"
+depend:
+	$(error Dependencies cannot be regenerated using the MSVC ports)
+else
+depend: $(ALL_FILES) $(UNIX_CAML_FILES) unix.ml
+	$(CC) -MM $(OC_CPPFLAGS) -I../unix $(ALL_FILES) \
+	  | sed -e 's/\.o/.$$(O)/g' > .depend
+	$(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash $(UNIX_CAML_FILES) \
+	  unix.ml >> .depend
+endif
+
+include .depend
diff --git a/otherlibs/win32unix/accept.c b/otherlibs/win32unix/accept.c
new file mode 100644
index 00000000..0a15673e
--- /dev/null
+++ b/otherlibs/win32unix/accept.c
@@ -0,0 +1,53 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+#include "socketaddr.h"
+
+CAMLprim value unix_accept(value cloexec, value sock)
+{
+  SOCKET sconn = Socket_val(sock);
+  SOCKET snew;
+  value fd = Val_unit, adr = Val_unit, res;
+  union sock_addr_union addr;
+  socklen_param_type addr_len;
+  DWORD err = 0;
+
+  addr_len = sizeof(sock_addr);
+  caml_enter_blocking_section();
+  snew = accept(sconn, &addr.s_gen, &addr_len);
+  if (snew == INVALID_SOCKET) err = WSAGetLastError ();
+  caml_leave_blocking_section();
+  if (snew == INVALID_SOCKET) {
+    win32_maperr(err);
+    uerror("accept", Nothing);
+  }
+  /* This is a best effort, not guaranteed to work, so don't fail on error */
+  SetHandleInformation((HANDLE) snew,
+                       HANDLE_FLAG_INHERIT,
+                       unix_cloexec_p(cloexec) ? 0 : HANDLE_FLAG_INHERIT);
+  Begin_roots2 (fd, adr)
+    fd = win_alloc_socket(snew);
+    adr = alloc_sockaddr(&addr, addr_len, snew);
+    res = caml_alloc_small(2, 0);
+    Field(res, 0) = fd;
+    Field(res, 1) = adr;
+  End_roots();
+  return res;
+}
diff --git a/otherlibs/win32unix/bind.c b/otherlibs/win32unix/bind.c
new file mode 100644
index 00000000..b852f93f
--- /dev/null
+++ b/otherlibs/win32unix/bind.c
@@ -0,0 +1,34 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+#include "socketaddr.h"
+
+CAMLprim value unix_bind(socket, address)
+     value socket, address;
+{
+  int ret;
+  union sock_addr_union addr;
+  socklen_param_type addr_len;
+
+  get_sockaddr(address, &addr, &addr_len);
+  ret = bind(Socket_val(socket), &addr.s_gen, addr_len);
+  if (ret == -1) {
+    win32_maperr(WSAGetLastError());
+    uerror("bind", Nothing);
+  }
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/channels.c b/otherlibs/win32unix/channels.c
new file mode 100644
index 00000000..863ca431
--- /dev/null
+++ b/otherlibs/win32unix/channels.c
@@ -0,0 +1,141 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/io.h>
+#include <caml/memory.h>
+#include "unixsupport.h"
+#include <fcntl.h>
+#include <io.h>
+
+/* Check that the given file descriptor has "stream semantics" and
+   can therefore be used as part of buffered I/O.  Things that
+   don't have "stream semantics" include block devices and
+   UDP (datagram) sockets.
+   Returns 0 if OK, a Win32 error code if error. */
+
+static DWORD win_check_stream_semantics(value handle)
+{
+  switch (Descr_kind_val(handle)) {
+  case KIND_HANDLE:
+    switch (GetFileType(Handle_val(handle)) & ~FILE_TYPE_REMOTE) {
+    case FILE_TYPE_DISK: case FILE_TYPE_CHAR: case FILE_TYPE_PIPE:
+      return 0;
+    default: {
+      DWORD err = GetLastError();
+      return err == NO_ERROR ? ERROR_INVALID_ACCESS : err;
+    }
+    }
+  case KIND_SOCKET: {
+    int so_type;
+    int so_type_len = sizeof(so_type);
+    if (getsockopt(Socket_val(handle), SOL_SOCKET, SO_TYPE,
+                   (void *) &so_type, &so_type_len) != 0)
+      return WSAGetLastError();
+    switch (so_type) {
+    case SOCK_STREAM:
+      return 0;
+    default:
+      return ERROR_INVALID_ACCESS;
+    }
+  }
+  default:
+    return ERROR_INVALID_ACCESS;
+  }
+}
+
+int win_CRT_fd_of_filedescr(value handle)
+{
+  if (CRT_fd_val(handle) != NO_CRT_FD) {
+    return CRT_fd_val(handle);
+  } else {
+    int fd = _open_osfhandle((intptr_t) Handle_val(handle), O_BINARY);
+    if (fd == -1) uerror("channel_of_descr", Nothing);
+    CRT_fd_val(handle) = fd;
+    return fd;
+  }
+}
+
+CAMLprim value win_inchannel_of_filedescr(value handle)
+{
+  CAMLparam1(handle);
+  CAMLlocal1(vchan);
+  struct channel * chan;
+  DWORD err;
+
+#if defined(_MSC_VER) && _MSC_VER < 1400
+  fflush(stdin);
+#endif
+  err = win_check_stream_semantics(handle);
+  if (err != 0) { win32_maperr(err); uerror("in_channel_of_descr", Nothing); }
+  chan = caml_open_descriptor_in(win_CRT_fd_of_filedescr(handle));
+  chan->flags |= CHANNEL_FLAG_MANAGED_BY_GC;
+                 /* as in caml_ml_open_descriptor_in() */
+  if (Descr_kind_val(handle) == KIND_SOCKET)
+    chan->flags |= CHANNEL_FLAG_FROM_SOCKET;
+  vchan = caml_alloc_channel(chan);
+  CAMLreturn(vchan);
+}
+
+CAMLprim value win_outchannel_of_filedescr(value handle)
+{
+  CAMLparam1(handle);
+  CAMLlocal1(vchan);
+  int fd;
+  struct channel * chan;
+  DWORD err;
+
+  err = win_check_stream_semantics(handle);
+  if (err != 0) { win32_maperr(err); uerror("out_channel_of_descr", Nothing); }
+  chan = caml_open_descriptor_out(win_CRT_fd_of_filedescr(handle));
+  chan->flags |= CHANNEL_FLAG_MANAGED_BY_GC;
+                 /* as in caml_ml_open_descriptor_out() */
+  if (Descr_kind_val(handle) == KIND_SOCKET)
+    chan->flags |= CHANNEL_FLAG_FROM_SOCKET;
+  vchan = caml_alloc_channel(chan);
+  CAMLreturn(vchan);
+}
+
+CAMLprim value win_filedescr_of_channel(value vchan)
+{
+  CAMLparam1(vchan);
+  CAMLlocal1(fd);
+  struct channel * chan;
+  HANDLE h;
+
+  chan = Channel(vchan);
+  if (chan->fd == -1) uerror("descr_of_channel", Nothing);
+  h = (HANDLE) _get_osfhandle(chan->fd);
+  if (chan->flags & CHANNEL_FLAG_FROM_SOCKET)
+    fd = win_alloc_socket((SOCKET) h);
+  else
+    fd = win_alloc_handle(h);
+  CRT_fd_val(fd) = chan->fd;
+  CAMLreturn(fd);
+}
+
+CAMLprim value win_handle_fd(value vfd)
+{
+  int crt_fd = Int_val(vfd);
+  /* PR#4750: do not use the _or_socket variant as it can cause performance
+     degradation and this function is only used with the standard
+     handles 0, 1, 2, which are not sockets. */
+  value res = win_alloc_handle((HANDLE) _get_osfhandle(crt_fd));
+  CRT_fd_val(res) = crt_fd;
+  return res;
+}
diff --git a/otherlibs/win32unix/close.c b/otherlibs/win32unix/close.c
new file mode 100644
index 00000000..289e3b11
--- /dev/null
+++ b/otherlibs/win32unix/close.c
@@ -0,0 +1,42 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+#include <caml/io.h>
+
+CAMLprim value unix_close(value fd)
+{
+  if (Descr_kind_val(fd) == KIND_SOCKET) {
+    if (closesocket(Socket_val(fd)) != 0) {
+      win32_maperr(WSAGetLastError());
+      uerror("close", Nothing);
+    }
+  } else {
+    /* If we have an fd then closing it also closes
+     * the underlying handle. Also, closing only
+     * the handle and not the fd leads to fd leaks. */
+    if (CRT_fd_val(fd) != NO_CRT_FD) {
+      if (_close(CRT_fd_val(fd)) != 0)
+         uerror("close", Nothing);
+    } else {
+      if (! CloseHandle(Handle_val(fd))) {
+        win32_maperr(GetLastError());
+        uerror("close", Nothing);
+      }
+    }
+  }
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/close_on.c b/otherlibs/win32unix/close_on.c
new file mode 100644
index 00000000..79dd56a8
--- /dev/null
+++ b/otherlibs/win32unix/close_on.c
@@ -0,0 +1,43 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+#include <windows.h>
+
+int win_set_inherit(value fd, BOOL inherit)
+{
+  /* According to the MSDN, SetHandleInformation may not work
+     for console handles on WinNT4 and earlier versions. */
+  if (! SetHandleInformation(Handle_val(fd),
+                             HANDLE_FLAG_INHERIT,
+                             inherit ? HANDLE_FLAG_INHERIT : 0)) {
+    win32_maperr(GetLastError());
+    return -1;
+  }
+  return 0;
+}
+
+CAMLprim value win_set_close_on_exec(value fd)
+{
+  if (win_set_inherit(fd, FALSE) == -1) uerror("set_close_on_exec", Nothing);
+  return Val_unit;
+}
+
+CAMLprim value win_clear_close_on_exec(value fd)
+{
+  if (win_set_inherit(fd, TRUE) == -1) uerror("clear_close_on_exec", Nothing);
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/connect.c b/otherlibs/win32unix/connect.c
new file mode 100644
index 00000000..9ce86c03
--- /dev/null
+++ b/otherlibs/win32unix/connect.c
@@ -0,0 +1,39 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+#include "socketaddr.h"
+
+CAMLprim value unix_connect(socket, address)
+     value socket, address;
+{
+  SOCKET s = Socket_val(socket);
+  union sock_addr_union addr;
+  socklen_param_type addr_len;
+  DWORD err = 0;
+
+  get_sockaddr(address, &addr, &addr_len);
+  caml_enter_blocking_section();
+  if (connect(s, &addr.s_gen, addr_len) == -1)
+    err = WSAGetLastError();
+  caml_leave_blocking_section();
+  if (err) {
+    win32_maperr(err);
+    uerror("connect", Nothing);
+  }
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/createprocess.c b/otherlibs/win32unix/createprocess.c
new file mode 100644
index 00000000..758a98f9
--- /dev/null
+++ b/otherlibs/win32unix/createprocess.c
@@ -0,0 +1,155 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include "unixsupport.h"
+#include <windows.h>
+#include <caml/osdeps.h>
+#include <errno.h>
+
+static int win_has_console(void);
+
+static DWORD do_create_process_native(wchar_t * exefile, wchar_t * cmdline,
+                                      wchar_t * env, HANDLE fd1, HANDLE fd2,
+                                      HANDLE fd3, HANDLE * hProcess)
+{
+  PROCESS_INFORMATION pi;
+  STARTUPINFO si;
+  DWORD flags, err;
+  HANDLE hp;
+
+  err = ERROR_SUCCESS;
+  /* Prepare stdin/stdout/stderr redirection */
+  ZeroMemory(&si, sizeof(STARTUPINFO));
+  si.cb = sizeof(STARTUPINFO);
+  si.dwFlags = STARTF_USESTDHANDLES;
+  /* Duplicate the handles fd1, fd2, fd3 to make sure they are inheritable */
+  hp = GetCurrentProcess();
+  if (! DuplicateHandle(hp, fd1, hp, &(si.hStdInput),
+                        0, TRUE, DUPLICATE_SAME_ACCESS)) {
+    err = GetLastError(); goto ret1;
+  }
+  if (! DuplicateHandle(hp, fd2, hp, &(si.hStdOutput),
+                        0, TRUE, DUPLICATE_SAME_ACCESS)) {
+    err = GetLastError(); goto ret2;
+  }
+  if (! DuplicateHandle(hp, fd3, hp, &(si.hStdError),
+                        0, TRUE, DUPLICATE_SAME_ACCESS)) {
+    err = GetLastError(); goto ret3;
+  }
+  /* If we do not have a console window, then we must create one
+     before running the process (keep it hidden for appearance).
+     If we are starting a GUI application, the newly created
+     console should not matter. */
+  if (win_has_console())
+    flags = 0;
+  else {
+    flags = CREATE_NEW_CONSOLE;
+    si.dwFlags = (STARTF_USESHOWWINDOW | STARTF_USESTDHANDLES);
+    si.wShowWindow = SW_HIDE;
+  }
+  flags |= CREATE_UNICODE_ENVIRONMENT;
+  /* Create the process */
+  if (! CreateProcess(exefile, cmdline, NULL, NULL,
+                      TRUE, flags, env, NULL, &si, &pi)) {
+    err = GetLastError(); goto ret4;
+  }
+  CloseHandle(pi.hThread);
+ ret4:
+  CloseHandle(si.hStdError);
+ ret3:
+  CloseHandle(si.hStdOutput);
+ ret2:
+  CloseHandle(si.hStdInput);
+ ret1:
+  *hProcess = (err == ERROR_SUCCESS) ? pi.hProcess : NULL;
+  return err;
+}
+
+value win_create_process_native(value cmd, value cmdline, value env,
+                               value fd1, value fd2, value fd3)
+{
+  wchar_t * exefile, * wcmdline, * wenv, * wcmd;
+  HANDLE hProcess;
+  DWORD err;
+  int size;
+
+  caml_unix_check_path(cmd, "create_process");
+  if (! caml_string_is_c_safe(cmdline))
+    unix_error(EINVAL, "create_process", cmdline);
+  /* [env] is checked for null bytes at construction time, see unix.ml */
+
+  wcmd = caml_stat_strdup_to_utf16(String_val(cmd));
+  exefile = caml_search_exe_in_path(wcmd);
+  caml_stat_free(wcmd);
+  wcmdline = caml_stat_strdup_to_utf16(String_val(cmdline));
+
+  if (env != Val_int(0)) {
+    env = Field(env, 0);
+    size =
+      win_multi_byte_to_wide_char(String_val(env),
+                                  caml_string_length(env), NULL, 0);
+    wenv = caml_stat_alloc((size + 1)*sizeof(wchar_t));
+    win_multi_byte_to_wide_char(String_val(env),
+                                caml_string_length(env), wenv, size);
+    wenv[size] = 0;
+  } else {
+    wenv = NULL;
+  }
+
+  err =
+    do_create_process_native(exefile, wcmdline, wenv, Handle_val(fd1),
+                             Handle_val(fd2), Handle_val(fd3), &hProcess);
+
+  if (wenv != NULL) caml_stat_free(wenv);
+  caml_stat_free(wcmdline);
+  caml_stat_free(exefile);
+  if (err != ERROR_SUCCESS) {
+    win32_maperr(err);
+    uerror("create_process", cmd);
+  }
+  /* Return the process handle as pseudo-PID
+     (this is consistent with the wait() emulation in the MSVC C library */
+  return Val_long(hProcess);
+}
+
+CAMLprim value win_create_process(value * argv, int argn)
+{
+  return win_create_process_native(argv[0], argv[1], argv[2],
+                                   argv[3], argv[4], argv[5]);
+}
+
+static int win_has_console(void)
+{
+  HANDLE h, log;
+  int i;
+
+  h = CreateFile(L"CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
+                 OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
+  if (h == INVALID_HANDLE_VALUE) {
+    return 0;
+  } else {
+    CloseHandle(h);
+    return 1;
+  }
+}
+
+CAMLprim value win_terminate_process(value v_pid)
+{
+  return (Val_bool(TerminateProcess((HANDLE) Long_val(v_pid), 0)));
+}
diff --git a/otherlibs/win32unix/dup.c b/otherlibs/win32unix/dup.c
new file mode 100644
index 00000000..c02153b5
--- /dev/null
+++ b/otherlibs/win32unix/dup.c
@@ -0,0 +1,35 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_dup(value cloexec, value fd)
+{
+  HANDLE newh;
+  value newfd;
+  int kind = Descr_kind_val(fd);
+  if (! DuplicateHandle(GetCurrentProcess(), Handle_val(fd),
+                        GetCurrentProcess(), &newh,
+                        0L,
+                        unix_cloexec_p(cloexec) ? FALSE : TRUE,
+                        DUPLICATE_SAME_ACCESS)) {
+    win32_maperr(GetLastError());
+    return -1;
+  }
+  newfd = win_alloc_handle(newh);
+  Descr_kind_val(newfd) = kind;
+  return newfd;
+}
diff --git a/otherlibs/win32unix/dup2.c b/otherlibs/win32unix/dup2.c
new file mode 100644
index 00000000..44ff41d6
--- /dev/null
+++ b/otherlibs/win32unix/dup2.c
@@ -0,0 +1,42 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_dup2(value cloexec, value fd1, value fd2)
+{
+  HANDLE oldh, newh;
+
+  oldh = Handle_val(fd2);
+  if (! DuplicateHandle(GetCurrentProcess(), Handle_val(fd1),
+                        GetCurrentProcess(), &newh,
+                        0L,
+                        unix_cloexec_p(cloexec) ? FALSE : TRUE,
+                        DUPLICATE_SAME_ACCESS)) {
+    win32_maperr(GetLastError());
+    return -1;
+  }
+  Handle_val(fd2) = newh;
+  if (Descr_kind_val(fd2) == KIND_SOCKET)
+    closesocket((SOCKET) oldh);
+  else
+    CloseHandle(oldh);
+  Descr_kind_val(fd2) = Descr_kind_val(fd1);
+  /* Reflect the dup2 on the CRT fds, if any */
+  if (CRT_fd_val(fd1) != NO_CRT_FD || CRT_fd_val(fd2) != NO_CRT_FD)
+    _dup2(win_CRT_fd_of_filedescr(fd1), win_CRT_fd_of_filedescr(fd2));
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/envir.c b/otherlibs/win32unix/envir.c
new file mode 100644
index 00000000..5432cb11
--- /dev/null
+++ b/otherlibs/win32unix/envir.c
@@ -0,0 +1,43 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/osdeps.h>
+
+#include <windows.h>
+
+/* Win32 doesn't have a notion of setuid bit. */
+CAMLprim value unix_environment(value unit)
+{
+  CAMLparam0();
+  CAMLlocal2(v, result);
+  wchar_t * envp, * p;
+  int size, i;
+
+  envp = GetEnvironmentStrings();
+  for (p = envp, size = 0; *p; p += wcslen(p) + 1) size++;
+  result = caml_alloc(size, 0);
+  for (p = envp, i = 0; *p; p += wcslen(p) + 1) {
+    v = caml_copy_string_of_utf16(p);
+    Store_field(result, i ++, v);
+  }
+  FreeEnvironmentStrings(envp);
+
+  CAMLreturn(result);
+}
diff --git a/otherlibs/win32unix/errmsg.c b/otherlibs/win32unix/errmsg.c
new file mode 100644
index 00000000..d910df55
--- /dev/null
+++ b/otherlibs/win32unix/errmsg.c
@@ -0,0 +1,47 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2001 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+#define CAML_INTERNALS
+
+#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+extern int error_table[];
+
+CAMLprim value unix_error_message(value err)
+{
+  int errnum;
+  wchar_t buffer[512];
+
+  errnum = Is_block(err) ? Int_val(Field(err, 0)) : error_table[Int_val(err)];
+  if (errnum > 0)
+    return caml_copy_string(strerror(errnum));
+  if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
+                    NULL,
+                    -errnum,
+                    0,
+                    buffer,
+                    sizeof(buffer)/sizeof(wchar_t),
+                    NULL))
+    return caml_copy_string_of_utf16(buffer);
+  swprintf(buffer, sizeof(buffer)/sizeof(wchar_t),
+           L"unknown error #%d", errnum);
+  return caml_copy_string_of_utf16(buffer);
+}
diff --git a/otherlibs/win32unix/getpeername.c b/otherlibs/win32unix/getpeername.c
new file mode 100644
index 00000000..d022a847
--- /dev/null
+++ b/otherlibs/win32unix/getpeername.c
@@ -0,0 +1,35 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+#include "socketaddr.h"
+
+CAMLprim value unix_getpeername(sock)
+     value sock;
+{
+  int retcode;
+  union sock_addr_union addr;
+  socklen_param_type addr_len;
+
+  addr_len = sizeof(sock_addr);
+  retcode = getpeername(Socket_val(sock),
+                        &addr.s_gen, &addr_len);
+  if (retcode == -1) {
+    win32_maperr(WSAGetLastError());
+    uerror("getpeername", Nothing);
+  }
+  return alloc_sockaddr(&addr, addr_len, -1);
+}
diff --git a/otherlibs/win32unix/getpid.c b/otherlibs/win32unix/getpid.c
new file mode 100644
index 00000000..71e9c141
--- /dev/null
+++ b/otherlibs/win32unix/getpid.c
@@ -0,0 +1,24 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+extern value val_process_id;
+
+CAMLprim value unix_getpid(value unit)
+{
+  return val_process_id;
+}
diff --git a/otherlibs/win32unix/getsockname.c b/otherlibs/win32unix/getsockname.c
new file mode 100644
index 00000000..6df6adfb
--- /dev/null
+++ b/otherlibs/win32unix/getsockname.c
@@ -0,0 +1,32 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+#include "socketaddr.h"
+
+CAMLprim value unix_getsockname(sock)
+     value sock;
+{
+  int retcode;
+  union sock_addr_union addr;
+  socklen_param_type addr_len;
+
+  addr_len = sizeof(sock_addr);
+  retcode = getsockname(Socket_val(sock),
+                        &addr.s_gen, &addr_len);
+  if (retcode == -1) uerror("getsockname", Nothing);
+  return alloc_sockaddr(&addr, addr_len, -1);
+}
diff --git a/otherlibs/win32unix/gettimeofday.c b/otherlibs/win32unix/gettimeofday.c
new file mode 100644
index 00000000..20f62a1f
--- /dev/null
+++ b/otherlibs/win32unix/gettimeofday.c
@@ -0,0 +1,40 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <time.h>
+
+#include "unixsupport.h"
+
+/* Unix epoch as a Windows timestamp in hundreds of ns */
+#define epoch_ft 116444736000000000.0;
+
+CAMLprim value unix_gettimeofday(value unit)
+{
+  FILETIME ft;
+  double tm;
+  GetSystemTimeAsFileTime(&ft);
+#if defined(_MSC_VER) && _MSC_VER < 1300
+  /* This compiler can't cast uint64_t to double! Fortunately, this doesn't
+     matter since SYSTEMTIME is only ever 63-bit (maximum value 31-Dec-30827
+     23:59:59.999, and it requires some skill to set the clock past 2099!)
+   */
+  tm = *(int64_t *)&ft - epoch_ft; /* shift to Epoch-relative time */
+#else
+  tm = *(uint64_t *)&ft - epoch_ft; /* shift to Epoch-relative time */
+#endif
+  return caml_copy_double(tm * 1e-7);  /* tm is in 100ns */
+}
diff --git a/otherlibs/win32unix/isatty.c b/otherlibs/win32unix/isatty.c
new file mode 100644
index 00000000..56f6f093
--- /dev/null
+++ b/otherlibs/win32unix/isatty.c
@@ -0,0 +1,24 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                 David Allsopp, OCaml Labs, Cambridge.                  */
+/*                                                                        */
+/*   Copyright 2017 MetaStack Solutions Ltd.                              */
+/*                                                                        */
+/*   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
+
+#include <caml/mlvalues.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_isatty(value fd)
+{
+  return Val_bool(caml_win32_isatty(win_CRT_fd_of_filedescr(fd)));
+}
diff --git a/otherlibs/win32unix/link.c b/otherlibs/win32unix/link.c
new file mode 100644
index 00000000..32ea0023
--- /dev/null
+++ b/otherlibs/win32unix/link.c
@@ -0,0 +1,64 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                  File contributed by Lionel Fourquaux                  */
+/*                                                                        */
+/*   Copyright 2001 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
+
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+#include <errno.h>
+#include <windows.h>
+
+typedef
+BOOL (WINAPI *tCreateHardLink)(
+  LPCWSTR lpFileName,
+  LPCWSTR lpExistingFileName,
+  LPSECURITY_ATTRIBUTES lpSecurityAttributes
+);
+
+CAMLprim value unix_link(value follow, value path1, value path2)
+{
+  HMODULE hModKernel32;
+  tCreateHardLink pCreateHardLink;
+  BOOL result;
+  wchar_t * wpath1, * wpath2;
+  if (Is_block(follow) && !Bool_val(Field(follow, 0))) { /* Some false */
+    errno = ENOSYS;
+    uerror("link", path2);
+  }
+  hModKernel32 = GetModuleHandle(L"KERNEL32.DLL");
+  pCreateHardLink =
+    (tCreateHardLink) GetProcAddress(hModKernel32, "CreateHardLinkW");
+  if (pCreateHardLink == NULL)
+    caml_invalid_argument("Unix.link not implemented");
+  caml_unix_check_path(path1, "link");
+  caml_unix_check_path(path2, "link");
+
+  wpath1 = caml_stat_strdup_to_utf16(String_val(path1));
+  wpath2 = caml_stat_strdup_to_utf16(String_val(path2));
+
+  result = pCreateHardLink(wpath2, wpath1, NULL);
+
+  caml_stat_free(wpath1);
+  caml_stat_free(wpath2);
+
+  if (! result) {
+    win32_maperr(GetLastError());
+    uerror("link", path2);
+  }
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/listen.c b/otherlibs/win32unix/listen.c
new file mode 100644
index 00000000..364b4be4
--- /dev/null
+++ b/otherlibs/win32unix/listen.c
@@ -0,0 +1,27 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_listen(sock, backlog)
+     value sock, backlog;
+{
+  if (listen(Socket_val(sock), Int_val(backlog)) == -1) {
+    win32_maperr(WSAGetLastError());
+    uerror("listen", Nothing);
+  }
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/lockf.c b/otherlibs/win32unix/lockf.c
new file mode 100644
index 00000000..f48e7ce6
--- /dev/null
+++ b/otherlibs/win32unix/lockf.c
@@ -0,0 +1,160 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*    Contributed by Tracy Camp, PolyServe Inc., <campt@polyserve.com>    */
+/*                  Further improvements by Reed Wilson                   */
+/*                                                                        */
+/*   Copyright 2002 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <errno.h>
+#include <fcntl.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include "unixsupport.h"
+#include <stdio.h>
+#include <caml/signals.h>
+
+#ifndef INVALID_SET_FILE_POINTER
+#define INVALID_SET_FILE_POINTER (-1)
+#endif
+
+/* Sets handle h to a position based on gohere */
+/* output, if set, is changed to the new location */
+
+static void set_file_pointer(HANDLE h, LARGE_INTEGER gohere,
+                             PLARGE_INTEGER output, DWORD method)
+{
+  LONG high = gohere.HighPart;
+  DWORD ret = SetFilePointer(h, gohere.LowPart, &high, method);
+  if(ret == INVALID_SET_FILE_POINTER) {
+    DWORD err = GetLastError();
+    if(err != NO_ERROR) {
+      win32_maperr(err);
+      uerror("lockf", Nothing);
+    }
+  }
+  if(output != NULL) {
+    output->LowPart = ret;
+    output->HighPart = high;
+  }
+}
+
+CAMLprim value unix_lockf(value fd, value cmd, value span)
+{
+  CAMLparam3(fd, cmd, span);
+  OVERLAPPED overlap;
+  intnat l_len;
+  HANDLE h;
+  OSVERSIONINFO version;
+  LARGE_INTEGER cur_position;
+  LARGE_INTEGER beg_position;
+  LARGE_INTEGER lock_len;
+  LARGE_INTEGER zero;
+  DWORD err = NO_ERROR;
+
+  version.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+  if(GetVersionEx(&version) == 0) {
+    caml_invalid_argument("lockf only supported on WIN32_NT platforms:"
+                     " could not determine current platform.");
+  }
+  if(version.dwPlatformId != VER_PLATFORM_WIN32_NT) {
+    caml_invalid_argument("lockf only supported on WIN32_NT platforms");
+  }
+
+  h = Handle_val(fd);
+
+  l_len = Long_val(span);
+
+  /* No matter what, we need the current position in the file */
+  zero.HighPart = zero.LowPart = 0;
+  set_file_pointer(h, zero, &cur_position, FILE_CURRENT);
+
+  /* All unused fields must be set to zero */
+  memset(&overlap, 0, sizeof(overlap));
+
+  if(l_len == 0) {
+    /* Lock from cur to infinity */
+    lock_len.QuadPart = -1;
+    overlap.OffsetHigh = cur_position.HighPart;
+    overlap.Offset     = cur_position.LowPart ;
+  }
+  else if(l_len > 0) {
+    /* Positive file offset */
+    lock_len.QuadPart = l_len;
+    overlap.OffsetHigh = cur_position.HighPart;
+    overlap.Offset     = cur_position.LowPart ;
+  }
+  else {
+    /* Negative file offset */
+    lock_len.QuadPart = - l_len;
+    if (lock_len.QuadPart > cur_position.QuadPart) {
+      errno = EINVAL;
+      uerror("lockf", Nothing);
+    }
+    beg_position.QuadPart = cur_position.QuadPart - lock_len.QuadPart;
+    overlap.OffsetHigh = beg_position.HighPart;
+    overlap.Offset     = beg_position.LowPart ;
+  }
+
+  switch(Int_val(cmd)) {
+  case 0: /* F_ULOCK - unlock */
+    if (! UnlockFileEx(h, 0,
+                       lock_len.LowPart, lock_len.HighPart, &overlap))
+      err = GetLastError();
+    break;
+  case 1: /* F_LOCK - blocking write lock */
+    caml_enter_blocking_section();
+    if (! LockFileEx(h, LOCKFILE_EXCLUSIVE_LOCK, 0,
+                     lock_len.LowPart, lock_len.HighPart, &overlap))
+      err = GetLastError();
+    caml_leave_blocking_section();
+    break;
+  case 2: /* F_TLOCK - non-blocking write lock */
+    if (! LockFileEx(h, LOCKFILE_FAIL_IMMEDIATELY | LOCKFILE_EXCLUSIVE_LOCK, 0,
+                     lock_len.LowPart, lock_len.HighPart, &overlap))
+      err = GetLastError();
+    break;
+  case 3: /* F_TEST - check whether a write lock can be obtained */
+    /*  I'm doing this by acquiring an immediate write
+     * lock and then releasing it. It is not clear that
+     * this behavior matches anything in particular, but
+     * it is not clear the nature of the lock test performed
+     * by ocaml (unix) currently. */
+    if (LockFileEx(h, LOCKFILE_FAIL_IMMEDIATELY | LOCKFILE_EXCLUSIVE_LOCK, 0,
+                   lock_len.LowPart, lock_len.HighPart, &overlap)) {
+      UnlockFileEx(h, 0, lock_len.LowPart, lock_len.HighPart, &overlap);
+    } else {
+      err = GetLastError();
+    }
+    break;
+  case 4: /* F_RLOCK - blocking read lock */
+    caml_enter_blocking_section();
+    if (! LockFileEx(h, 0, 0,
+                     lock_len.LowPart, lock_len.HighPart, &overlap))
+      err = GetLastError();
+    caml_leave_blocking_section();
+    break;
+  case 5: /* F_TRLOCK - non-blocking read lock */
+    if (! LockFileEx(h, LOCKFILE_FAIL_IMMEDIATELY, 0,
+                     lock_len.LowPart, lock_len.HighPart, &overlap))
+      err = GetLastError();
+    break;
+  default:
+    errno = EINVAL;
+    uerror("lockf", Nothing);
+  }
+  if (err != NO_ERROR) {
+    win32_maperr(err);
+    uerror("lockf", Nothing);
+  }
+  CAMLreturn(Val_unit);
+}
diff --git a/otherlibs/win32unix/lseek.c b/otherlibs/win32unix/lseek.c
new file mode 100644
index 00000000..79639870
--- /dev/null
+++ b/otherlibs/win32unix/lseek.c
@@ -0,0 +1,70 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include "unixsupport.h"
+
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#else
+#define SEEK_SET 0
+#define SEEK_CUR 1
+#define SEEK_END 2
+#endif
+
+static DWORD seek_command_table[] = {
+  FILE_BEGIN, FILE_CURRENT, FILE_END
+};
+
+#ifndef INVALID_SET_FILE_POINTER
+#define INVALID_SET_FILE_POINTER (-1)
+#endif
+
+static __int64 caml_set_file_pointer(HANDLE h, __int64 dist, DWORD mode)
+{
+  LARGE_INTEGER i;
+  DWORD err;
+
+  i.QuadPart = dist;
+  i.LowPart = SetFilePointer(h, i.LowPart, &i.HighPart, mode);
+  if (i.LowPart == INVALID_SET_FILE_POINTER) {
+    err = GetLastError();
+    if (err != NO_ERROR) { win32_maperr(err); uerror("lseek", Nothing); }
+  }
+  return i.QuadPart;
+}
+
+CAMLprim value unix_lseek(value fd, value ofs, value cmd)
+{
+  __int64 ret;
+
+  ret = caml_set_file_pointer(Handle_val(fd), Long_val(ofs),
+                              seek_command_table[Int_val(cmd)]);
+  if (ret > Max_long) {
+    win32_maperr(ERROR_ARITHMETIC_OVERFLOW);
+    uerror("lseek", Nothing);
+  }
+  return Val_long(ret);
+}
+
+CAMLprim value unix_lseek_64(value fd, value ofs, value cmd)
+{
+  __int64 ret;
+
+  ret = caml_set_file_pointer(Handle_val(fd), Int64_val(ofs),
+                              seek_command_table[Int_val(cmd)]);
+  return caml_copy_int64(ret);
+}
diff --git a/otherlibs/win32unix/mkdir.c b/otherlibs/win32unix/mkdir.c
new file mode 100644
index 00000000..1b2a33a5
--- /dev/null
+++ b/otherlibs/win32unix/mkdir.c
@@ -0,0 +1,34 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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
+
+#include <caml/mlvalues.h>
+#include <caml/osdeps.h>
+#include <caml/memory.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_mkdir(path, perm)
+     value path, perm;
+{
+  int err;
+  wchar_t * wpath;
+  caml_unix_check_path(path, "mkdir");
+  wpath = caml_stat_strdup_to_utf16(String_val(path));
+  err = _wmkdir(wpath);
+  caml_stat_free(wpath);
+  if (err == -1) uerror("mkdir", path);
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/mmap.c b/otherlibs/win32unix/mmap.c
new file mode 100644
index 00000000..da08a19f
--- /dev/null
+++ b/otherlibs/win32unix/mmap.c
@@ -0,0 +1,169 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Manuel Serrano and Xavier Leroy, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2000 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
+
+#include <stddef.h>
+#include "caml/alloc.h"
+#include "caml/bigarray.h"
+#include "caml/fail.h"
+#include "caml/io.h"
+#include "caml/mlvalues.h"
+#include "caml/signals.h"
+#include "caml/sys.h"
+#include "caml/osdeps.h"
+#include "unixsupport.h"
+
+#define uerror(func, arg) \
+  do { win32_maperr(GetLastError()); uerror(func, arg); } while(0)
+
+/* Defined in [mmap_ba.c] */
+CAMLextern value
+caml_unix_mapped_alloc(int flags, int num_dims, void * data, intnat * dim);
+
+#ifndef INVALID_SET_FILE_POINTER
+#define INVALID_SET_FILE_POINTER (-1)
+#endif
+
+static __int64 caml_set_file_pointer(HANDLE h, __int64 dist, DWORD mode)
+{
+  LARGE_INTEGER i;
+  DWORD err;
+
+  i.QuadPart = dist;
+  i.LowPart = SetFilePointer(h, i.LowPart, &i.HighPart, mode);
+  if (i.LowPart == INVALID_SET_FILE_POINTER) return -1;
+  return i.QuadPart;
+}
+
+CAMLprim value caml_unix_map_file(value vfd, value vkind, value vlayout,
+                                  value vshared, value vdim, value vstart)
+{
+  HANDLE fd, fmap;
+  int flags, major_dim, mode, perm;
+  intnat num_dims, i;
+  intnat dim[CAML_BA_MAX_NUM_DIMS];
+  __int64 currpos, startpos, file_size, data_size;
+  uintnat array_size, page, delta;
+  char c;
+  void * addr;
+  LARGE_INTEGER li;
+  SYSTEM_INFO sysinfo;
+
+  fd = Handle_val(vfd);
+  flags = Caml_ba_kind_val(vkind) | Caml_ba_layout_val(vlayout);
+  startpos = Int64_val(vstart);
+  num_dims = Wosize_val(vdim);
+  major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0;
+  /* Extract dimensions from OCaml array */
+  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++) {
+    dim[i] = Long_val(Field(vdim, i));
+    if (dim[i] == -1 && i == major_dim) continue;
+    if (dim[i] < 0)
+      caml_invalid_argument("Unix.map_file: negative dimension");
+  }
+  /* Determine file size */
+  currpos = caml_set_file_pointer(fd, 0, FILE_CURRENT);
+  if (currpos == -1) uerror("map_file", Nothing);
+  file_size = caml_set_file_pointer(fd, 0, FILE_END);
+  if (file_size == -1) uerror("map_file", Nothing);
+  /* 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++)
+    if (dim[i] != -1) array_size *= dim[i];
+  /* Check if the first/last dimension is unknown */
+  if (dim[major_dim] == -1) {
+    /* Determine first/last dimension from file size */
+    if (file_size < startpos)
+      caml_failwith("Unix.map_file: file position exceeds file size");
+    data_size = file_size - startpos;
+    dim[major_dim] = (uintnat) (data_size / array_size);
+    array_size = dim[major_dim] * array_size;
+    if (array_size != data_size)
+      caml_failwith("Unix.map_file: file size doesn't match array dimensions");
+  }
+  /* Restore original file position */
+  caml_set_file_pointer(fd, currpos, FILE_BEGIN);
+  /* Create the file mapping */
+  if (Bool_val(vshared)) {
+    perm = PAGE_READWRITE;
+    mode = FILE_MAP_WRITE;
+  } else {
+    perm = PAGE_READONLY;       /* doesn't work under Win98 */
+    mode = FILE_MAP_COPY;
+  }
+  li.QuadPart = startpos + array_size;
+  fmap = CreateFileMapping(fd, NULL, perm, li.HighPart, li.LowPart, NULL);
+  if (fmap == NULL) uerror("map_file", Nothing);
+  /* Determine offset so that the mapping starts at the given file pos */
+  GetSystemInfo(&sysinfo);
+  delta = (uintnat) (startpos % sysinfo.dwAllocationGranularity);
+  /* Map the mapping in memory */
+  li.QuadPart = startpos - delta;
+  addr =
+    MapViewOfFile(fmap, mode, li.HighPart, li.LowPart, array_size + delta);
+  if (addr == NULL) uerror("map_file", Nothing);
+  addr = (void *) ((uintnat) addr + delta);
+  /* Close the file mapping */
+  CloseHandle(fmap);
+  /* Build and return the OCaml bigarray */
+  return caml_unix_mapped_alloc(flags, num_dims, addr, dim);
+}
+
+CAMLprim value caml_unix_map_file_bytecode(value * argv, int argn)
+{
+  return caml_unix_map_file(argv[0], argv[1], argv[2],
+                            argv[3], argv[4], argv[5]);
+}
+
+void caml_ba_unmap_file(void * addr, uintnat len)
+{
+  SYSTEM_INFO sysinfo;
+  uintnat delta;
+
+  GetSystemInfo(&sysinfo);
+  delta = (uintnat) addr % sysinfo.dwAllocationGranularity;
+  UnmapViewOfFile((void *)((uintnat)addr - delta));
+}
+
+#ifdef IN_OCAML_BIGARRAY
+
+/* This function reports a Win32 error as a Sys_error exception.
+   It is included for backward compatibility with the old
+   Bigarray.*.map_file implementation.  */
+
+static void caml_ba_sys_error(void)
+{
+  wchar_t buffer[512];
+  DWORD errnum;
+
+  errnum = GetLastError();
+  if (!FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS,
+                     NULL,
+                     errnum,
+                     0,
+                     buffer,
+                     sizeof(buffer)/sizeof(wchar_t),
+                     NULL))
+    swprintf(buffer, sizeof(buffer)/sizeof(wchar_t),
+             L"Unknown error %ld\n", errnum);
+  caml_raise_sys_error(caml_copy_string_of_utf16(buffer));
+}
+
+#endif
diff --git a/otherlibs/win32unix/nonblock.c b/otherlibs/win32unix/nonblock.c
new file mode 100644
index 00000000..599445e6
--- /dev/null
+++ b/otherlibs/win32unix/nonblock.c
@@ -0,0 +1,44 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2002 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_set_nonblock(socket)
+     value socket;
+{
+  u_long non_block = 1;
+
+  if (ioctlsocket(Socket_val(socket), FIONBIO, &non_block) != 0) {
+    win32_maperr(WSAGetLastError());
+    uerror("unix_set_nonblock", Nothing);
+  }
+  Flags_fd_val(socket) = Flags_fd_val(socket) & ~FLAGS_FD_IS_BLOCKING;
+  return Val_unit;
+}
+
+CAMLprim value unix_clear_nonblock(socket)
+     value socket;
+{
+  u_long non_block = 0;
+
+  if (ioctlsocket(Socket_val(socket), FIONBIO, &non_block) != 0) {
+    win32_maperr(WSAGetLastError());
+    uerror("unix_clear_nonblock", Nothing);
+  }
+  Flags_fd_val(socket) = Flags_fd_val(socket) | FLAGS_FD_IS_BLOCKING;
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/open.c b/otherlibs/win32unix/open.c
new file mode 100644
index 00000000..5a56d92d
--- /dev/null
+++ b/otherlibs/win32unix/open.c
@@ -0,0 +1,91 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/osdeps.h>
+#include <caml/memory.h>
+#include "unixsupport.h"
+#include <fcntl.h>
+
+static 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
+};
+
+static int open_create_flags[15] = {
+  0, 0, 0, 0, 0, O_CREAT, O_TRUNC, O_EXCL, 0, 0, 0, 0, 0, 0, 0
+};
+
+static int open_share_flags[15] = {
+  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, FILE_SHARE_DELETE, 0, 0
+};
+
+enum { CLOEXEC = 1, KEEPEXEC = 2 };
+
+static int open_cloexec_flags[15] = {
+  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, CLOEXEC, KEEPEXEC
+};
+
+CAMLprim value unix_open(value path, value flags, value perm)
+{
+  int fileaccess, createflags, fileattrib, filecreate, sharemode, cloexec;
+  SECURITY_ATTRIBUTES attr;
+  HANDLE h;
+  wchar_t * wpath;
+
+  caml_unix_check_path(path, "open");
+  fileaccess = caml_convert_flag_list(flags, open_access_flags);
+  sharemode = FILE_SHARE_READ | FILE_SHARE_WRITE
+              | caml_convert_flag_list(flags, open_share_flags);
+
+  createflags = caml_convert_flag_list(flags, open_create_flags);
+  if ((createflags & (O_CREAT | O_EXCL)) == (O_CREAT | O_EXCL))
+    filecreate = CREATE_NEW;
+  else if ((createflags & (O_CREAT | O_TRUNC)) == (O_CREAT | O_TRUNC))
+    filecreate = CREATE_ALWAYS;
+  else if (createflags & O_TRUNC)
+    filecreate = TRUNCATE_EXISTING;
+  else if (createflags & O_CREAT)
+    filecreate = OPEN_ALWAYS;
+  else
+    filecreate = OPEN_EXISTING;
+
+  if ((createflags & O_CREAT) && (Int_val(perm) & 0200) == 0)
+    fileattrib = FILE_ATTRIBUTE_READONLY;
+  else
+    fileattrib = FILE_ATTRIBUTE_NORMAL;
+
+  cloexec = caml_convert_flag_list(flags, open_cloexec_flags);
+  attr.nLength = sizeof(attr);
+  attr.lpSecurityDescriptor = NULL;
+  attr.bInheritHandle =
+    cloexec & CLOEXEC ? FALSE
+                      : cloexec & KEEPEXEC ? TRUE
+                                           : !unix_cloexec_default;
+
+  wpath = caml_stat_strdup_to_utf16(String_val(path));
+  h = CreateFile(wpath, fileaccess,
+                 sharemode, &attr,
+                 filecreate, fileattrib, NULL);
+  caml_stat_free(wpath);
+  if (h == INVALID_HANDLE_VALUE) {
+    win32_maperr(GetLastError());
+    uerror("open", path);
+  }
+  return win_alloc_handle(h);
+}
diff --git a/otherlibs/win32unix/pipe.c b/otherlibs/win32unix/pipe.c
new file mode 100644
index 00000000..a48c686a
--- /dev/null
+++ b/otherlibs/win32unix/pipe.c
@@ -0,0 +1,46 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include "unixsupport.h"
+#include <fcntl.h>
+
+/* PR#4749: pick a size that matches that of I/O buffers */
+#define SIZEBUF 4096
+
+CAMLprim value unix_pipe(value cloexec, value unit)
+{
+  SECURITY_ATTRIBUTES attr;
+  HANDLE readh, writeh;
+  value readfd = Val_unit, writefd = Val_unit, res;
+
+  attr.nLength = sizeof(attr);
+  attr.lpSecurityDescriptor = NULL;
+  attr.bInheritHandle = unix_cloexec_p(cloexec) ? FALSE : TRUE;
+  if (! CreatePipe(&readh, &writeh, &attr, SIZEBUF)) {
+    win32_maperr(GetLastError());
+    uerror("pipe", Nothing);
+  }
+  Begin_roots2(readfd, writefd)
+    readfd = win_alloc_handle(readh);
+    writefd = win_alloc_handle(writeh);
+    res = caml_alloc_small(2, 0);
+    Field(res, 0) = readfd;
+    Field(res, 1) = writefd;
+  End_roots();
+  return res;
+}
diff --git a/otherlibs/win32unix/read.c b/otherlibs/win32unix/read.c
new file mode 100644
index 00000000..a96951e4
--- /dev/null
+++ b/otherlibs/win32unix/read.c
@@ -0,0 +1,61 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_read(value fd, value buf, value ofs, value vlen)
+{
+  intnat len;
+  DWORD numbytes, numread;
+  char iobuf[UNIX_BUFFER_SIZE];
+  DWORD err = 0;
+
+  Begin_root (buf);
+    len = Long_val(vlen);
+    numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len;
+    if (Descr_kind_val(fd) == KIND_SOCKET) {
+      int ret;
+      SOCKET s = Socket_val(fd);
+      caml_enter_blocking_section();
+      ret = recv(s, iobuf, numbytes, 0);
+      if (ret == SOCKET_ERROR) err = WSAGetLastError();
+      caml_leave_blocking_section();
+      numread = ret;
+    } else {
+      HANDLE h = Handle_val(fd);
+      caml_enter_blocking_section();
+      if (! ReadFile(h, iobuf, numbytes, &numread, NULL))
+        err = GetLastError();
+      caml_leave_blocking_section();
+    }
+    if (err) {
+      if (err == ERROR_BROKEN_PIPE) {
+        // The write handle for an anonymous pipe has been closed. We match the
+        // Unix behavior, and treat this as a zero-read instead of a Unix_error.
+        err = 0;
+        numread = 0;
+      } else {
+        win32_maperr(err);
+        uerror("read", Nothing);
+      }
+    }
+    memmove (&Byte(buf, Long_val(ofs)), iobuf, numread);
+  End_roots();
+  return Val_int(numread);
+}
diff --git a/otherlibs/win32unix/readlink.c b/otherlibs/win32unix/readlink.c
new file mode 100644
index 00000000..b428db84
--- /dev/null
+++ b/otherlibs/win32unix/readlink.c
@@ -0,0 +1,106 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                David Allsopp, MetaStack Solutions Ltd.                 */
+/*                                                                        */
+/*   Copyright 2015 MetaStack Solutions Ltd.                              */
+/*                                                                        */
+/*   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
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/signals.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+#include <errno.h>
+#include <winioctl.h>
+
+CAMLprim value unix_readlink(value opath)
+{
+  CAMLparam1(opath);
+  CAMLlocal1(result);
+  HANDLE h;
+  wchar_t* path;
+  DWORD attributes;
+  caml_unix_check_path(opath, "readlink");
+  path = caml_stat_strdup_to_utf16(String_val(opath));
+
+  caml_enter_blocking_section();
+  attributes = GetFileAttributes(path);
+  caml_leave_blocking_section();
+
+  if (attributes == INVALID_FILE_ATTRIBUTES) {
+    caml_stat_free(path);
+    win32_maperr(GetLastError());
+    uerror("readlink", opath);
+  }
+  else if (!(attributes & FILE_ATTRIBUTE_REPARSE_POINT)) {
+    caml_stat_free(path);
+    errno = EINVAL;
+    uerror("readlink", opath);
+  }
+  else {
+    caml_enter_blocking_section();
+    if ((h = CreateFile(path,
+                        FILE_READ_ATTRIBUTES,
+                        FILE_SHARE_DELETE | FILE_SHARE_READ | FILE_SHARE_WRITE,
+                        NULL,
+                        OPEN_EXISTING,
+                        FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT,
+                        NULL)) == INVALID_HANDLE_VALUE) {
+      caml_leave_blocking_section();
+      caml_stat_free(path);
+      errno = ENOENT;
+      uerror("readlink", opath);
+    }
+    else {
+      char buffer[16384];
+      DWORD read;
+      REPARSE_DATA_BUFFER* point;
+
+      caml_stat_free(path);
+
+      if (DeviceIoControl(h, FSCTL_GET_REPARSE_POINT, NULL, 0, buffer, 16384, &read, NULL)) {
+        caml_leave_blocking_section();
+        point = (REPARSE_DATA_BUFFER*)buffer;
+        if (point->ReparseTag == IO_REPARSE_TAG_SYMLINK) {
+          int cbLen = point->SymbolicLinkReparseBuffer.SubstituteNameLength / sizeof(WCHAR);
+          int len;
+          len =
+            win_wide_char_to_multi_byte(
+              point->SymbolicLinkReparseBuffer.PathBuffer + point->SymbolicLinkReparseBuffer.SubstituteNameOffset / sizeof(WCHAR),
+              cbLen, NULL, 0);
+          result = caml_alloc_string(len);
+          win_wide_char_to_multi_byte(
+            point->SymbolicLinkReparseBuffer.PathBuffer + point->SymbolicLinkReparseBuffer.SubstituteNameOffset / sizeof(WCHAR),
+            cbLen,
+            (char *)String_val(result),
+            len);
+          CloseHandle(h);
+        }
+        else {
+          errno = EINVAL;
+          CloseHandle(h);
+          uerror("readline", opath);
+        }
+      }
+      else {
+        caml_leave_blocking_section();
+        win32_maperr(GetLastError());
+        CloseHandle(h);
+        uerror("readlink", opath);
+      }
+    }
+  }
+
+  CAMLreturn(result);
+}
diff --git a/otherlibs/win32unix/rename.c b/otherlibs/win32unix/rename.c
new file mode 100644
index 00000000..9bab6aef
--- /dev/null
+++ b/otherlibs/win32unix/rename.c
@@ -0,0 +1,43 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Contributed by Tracy Camp, PolyServe Inc., <campt@polyserve.com>     */
+/*                                                                        */
+/*   Copyright 2002 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
+
+#include <stdio.h>
+#include <caml/mlvalues.h>
+#include <caml/osdeps.h>
+#include <caml/memory.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_rename(value path1, value path2)
+{
+  wchar_t * wpath1, * wpath2;
+  BOOL ok;
+
+  caml_unix_check_path(path1, "rename");
+  caml_unix_check_path(path2, "rename");
+  wpath1 = caml_stat_strdup_to_utf16(String_val(path1));
+  wpath2 = caml_stat_strdup_to_utf16(String_val(path2));
+  ok = MoveFileEx(wpath1, wpath2,
+                  MOVEFILE_REPLACE_EXISTING | MOVEFILE_WRITE_THROUGH |
+                  MOVEFILE_COPY_ALLOWED);
+  caml_stat_free(wpath1);
+  caml_stat_free(wpath2);
+  if (! ok) {
+    win32_maperr(GetLastError());
+    uerror("rename", path1);
+  }
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/select.c b/otherlibs/win32unix/select.c
new file mode 100644
index 00000000..b5b83278
--- /dev/null
+++ b/otherlibs/win32unix/select.c
@@ -0,0 +1,1330 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Contributed by Sylvain Le Gall for Lexifi                            */
+/*                                                                        */
+/*   Copyright 2008 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/signals.h>
+#include "winworker.h"
+#include <stdio.h>
+#include "windbug.h"
+#include "winlist.h"
+
+/* This constant define the maximum number of objects that
+ * can be handle by a SELECTDATA.
+ * It takes the following parameters into account:
+ * - limitation on number of objects is mostly due to limitation
+ *   a WaitForMultipleObjects
+ * - there is always an event "hStop" to watch
+ *
+ * This lead to pick the following value as the biggest possible
+ * value
+ */
+#define MAXIMUM_SELECT_OBJECTS (MAXIMUM_WAIT_OBJECTS - 1)
+
+/* Manage set of handle */
+typedef struct _SELECTHANDLESET {
+  LPHANDLE lpHdl;
+  DWORD    nMax;
+  DWORD    nLast;
+} SELECTHANDLESET;
+
+typedef SELECTHANDLESET *LPSELECTHANDLESET;
+
+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++)
+  {
+    hds->lpHdl[i] = INVALID_HANDLE_VALUE;
+  };
+}
+
+void handle_set_add (LPSELECTHANDLESET hds, HANDLE hdl)
+{
+  LPSELECTHANDLESET res;
+
+  if (hds->nLast < hds->nMax)
+  {
+    hds->lpHdl[hds->nLast] = hdl;
+    hds->nLast++;
+  }
+
+  DEBUG_PRINT("Adding handle %x to set %x", hdl, hds);
+}
+
+BOOL handle_set_mem (LPSELECTHANDLESET hds, HANDLE hdl)
+{
+  BOOL  res;
+  DWORD i;
+
+  res = FALSE;
+  for (i = 0; !res && i < hds->nLast; i++)
+  {
+    res = (hds->lpHdl[i] == hdl);
+  }
+
+  return res;
+}
+
+void handle_set_reset (LPSELECTHANDLESET hds)
+{
+  DWORD i;
+
+  for (i = 0; i < hds->nMax; i++)
+  {
+    hds->lpHdl[i] = INVALID_HANDLE_VALUE;
+  }
+  hds->nMax  = 0;
+  hds->nLast = 0;
+  hds->lpHdl = NULL;
+}
+
+/* Data structure for handling select */
+
+typedef enum _SELECTHANDLETYPE {
+  SELECT_HANDLE_NONE = 0,
+  SELECT_HANDLE_DISK,
+  SELECT_HANDLE_CONSOLE,
+  SELECT_HANDLE_PIPE,
+  SELECT_HANDLE_SOCKET,
+} SELECTHANDLETYPE;
+
+typedef enum _SELECTMODE {
+  SELECT_MODE_NONE = 0,
+  SELECT_MODE_READ = 1,
+  SELECT_MODE_WRITE = 2,
+  SELECT_MODE_EXCEPT = 4,
+} SELECTMODE;
+
+typedef enum _SELECTSTATE {
+  SELECT_STATE_NONE = 0,
+  SELECT_STATE_INITFAILED,
+  SELECT_STATE_ERROR,
+  SELECT_STATE_SIGNALED
+} SELECTSTATE;
+
+typedef enum _SELECTTYPE {
+  SELECT_TYPE_NONE = 0,
+  SELECT_TYPE_STATIC,       /* Result is known without running anything */
+  SELECT_TYPE_CONSOLE_READ, /* Reading data on console */
+  SELECT_TYPE_PIPE_READ,    /* Reading data on pipe */
+  SELECT_TYPE_SOCKET        /* Classic select */
+} SELECTTYPE;
+
+/* Data structure for results */
+typedef struct _SELECTRESULT {
+  LIST       lst;
+  SELECTMODE EMode;
+  int        lpOrigIdx;
+} SELECTRESULT;
+
+typedef SELECTRESULT *LPSELECTRESULT;
+
+/* Data structure for query */
+typedef struct _SELECTQUERY {
+  LIST         lst;
+  SELECTMODE   EMode;
+  HANDLE       hFileDescr;
+  int          lpOrigIdx;
+  unsigned int uFlagsFd; /* Copy of filedescr->flags_fd */
+} SELECTQUERY;
+
+typedef SELECTQUERY *LPSELECTQUERY;
+
+typedef struct _SELECTDATA {
+  LIST             lst;
+  SELECTTYPE       EType;
+  /* Sockets may generate a result for all three lists from one single
+     query object
+   */
+  SELECTRESULT     aResults[MAXIMUM_SELECT_OBJECTS * 3];
+  DWORD            nResultsCount;
+  /* Data following are dedicated to APC like call, they
+     will be initialized if required.
+     */
+  WORKERFUNC       funcWorker;
+  SELECTQUERY      aQueries[MAXIMUM_SELECT_OBJECTS];
+  DWORD            nQueriesCount;
+  SELECTSTATE      EState;
+  DWORD            nError;
+  LPWORKER         lpWorker;
+} SELECTDATA;
+
+typedef SELECTDATA *LPSELECTDATA;
+
+/* Get error status if associated condition is false */
+static BOOL check_error(LPSELECTDATA lpSelectData, BOOL bFailed)
+{
+  if (bFailed && lpSelectData->nError == 0)
+  {
+    lpSelectData->EState = SELECT_STATE_ERROR;
+    lpSelectData->nError = GetLastError();
+  }
+  return bFailed;
+}
+
+/* Create data associated with a  select operation */
+LPSELECTDATA select_data_new (LPSELECTDATA lpSelectData, SELECTTYPE EType)
+{
+  /* Allocate the data structure */
+  LPSELECTDATA res;
+  DWORD        i;
+
+  res = (LPSELECTDATA)caml_stat_alloc(sizeof(SELECTDATA));
+
+  /* Init common data */
+  list_init((LPLIST)res);
+  list_next_set((LPLIST)res, (LPLIST)lpSelectData);
+  res->EType         = EType;
+  res->nResultsCount = 0;
+
+
+  /* Data following are dedicated to APC like call, they
+     will be initialized if required. For now they are set to
+     invalid values.
+     */
+  res->funcWorker    = NULL;
+  res->nQueriesCount = 0;
+  res->EState        = SELECT_STATE_NONE;
+  res->nError        = 0;
+  res->lpWorker  = NULL;
+
+  return res;
+}
+
+/* Free select data */
+void select_data_free (LPSELECTDATA lpSelectData)
+{
+  DWORD i;
+
+  DEBUG_PRINT("Freeing data of %x", lpSelectData);
+
+  /* Free APC related data, if they exists */
+  if (lpSelectData->lpWorker != NULL)
+  {
+    worker_job_finish(lpSelectData->lpWorker);
+    lpSelectData->lpWorker = NULL;
+  };
+
+  /* Make sure results/queries cannot be accessed */
+  lpSelectData->nResultsCount = 0;
+  lpSelectData->nQueriesCount = 0;
+
+  caml_stat_free(lpSelectData);
+}
+
+/* Add a result to select data, return zero if something goes wrong. */
+DWORD select_data_result_add (LPSELECTDATA lpSelectData, SELECTMODE EMode,
+                              int lpOrigIdx)
+{
+  DWORD res;
+  DWORD i;
+
+  res = 0;
+  if (lpSelectData->nResultsCount < MAXIMUM_SELECT_OBJECTS * 3)
+  {
+    i = lpSelectData->nResultsCount;
+    lpSelectData->aResults[i].EMode  = EMode;
+    lpSelectData->aResults[i].lpOrigIdx = lpOrigIdx;
+    lpSelectData->nResultsCount++;
+    res = 1;
+  }
+
+  return res;
+}
+
+/* Add a query to select data, return zero if something goes wrong */
+DWORD select_data_query_add (LPSELECTDATA lpSelectData,
+                             SELECTMODE EMode,
+                             HANDLE hFileDescr,
+                             int lpOrigIdx,
+                             unsigned int uFlagsFd)
+{
+  DWORD res;
+  DWORD i;
+
+  res = 0;
+  if (lpSelectData->nQueriesCount < MAXIMUM_SELECT_OBJECTS)
+  {
+    i = lpSelectData->nQueriesCount;
+    lpSelectData->aQueries[i].EMode      = EMode;
+    lpSelectData->aQueries[i].hFileDescr = hFileDescr;
+    lpSelectData->aQueries[i].lpOrigIdx  = lpOrigIdx;
+    lpSelectData->aQueries[i].uFlagsFd   = uFlagsFd;
+    lpSelectData->nQueriesCount++;
+    res = 1;
+  }
+
+  return res;
+}
+
+/* Search for a job that has available query slots and that match provided type.
+ * If none is found, create a new one. Return the corresponding SELECTDATA, and
+ * update provided SELECTDATA head, if required.
+ */
+LPSELECTDATA select_data_job_search (LPSELECTDATA *lppSelectData,
+                                     SELECTTYPE EType)
+{
+  LPSELECTDATA res;
+
+  res = NULL;
+
+  /* Search for job */
+  DEBUG_PRINT("Searching an available job for type %d", EType);
+  res = *lppSelectData;
+  while (
+      res != NULL
+      && !(
+        res->EType == EType
+        && res->nQueriesCount < MAXIMUM_SELECT_OBJECTS
+        )
+      )
+  {
+    res = LIST_NEXT(LPSELECTDATA, res);
+  }
+
+  /* No matching job found, create one */
+  if (res == NULL)
+  {
+    DEBUG_PRINT("No job for type %d found, create one", EType);
+    res = select_data_new(*lppSelectData, EType);
+    *lppSelectData = res;
+  }
+
+  return res;
+}
+
+/***********************/
+/*      Console        */
+/***********************/
+
+void read_console_poll(HANDLE hStop, void *_data)
+{
+  HANDLE events[2];
+  INPUT_RECORD record;
+  DWORD waitRes;
+  DWORD n;
+  LPSELECTDATA  lpSelectData;
+  LPSELECTQUERY lpQuery;
+
+  DEBUG_PRINT("Waiting for data on console");
+
+  record;
+  waitRes = 0;
+  n = 0;
+  lpSelectData = (LPSELECTDATA)_data;
+  lpQuery = &(lpSelectData->aQueries[0]);
+
+  events[0] = hStop;
+  events[1] = lpQuery->hFileDescr;
+  while (lpSelectData->EState == SELECT_STATE_NONE)
+  {
+    waitRes = WaitForMultipleObjects(2, events, FALSE, INFINITE);
+    if (waitRes == WAIT_OBJECT_0
+        || check_error(lpSelectData, waitRes == WAIT_FAILED))
+    {
+      /* stop worker event or error */
+      break;
+    }
+    /* console event */
+    if (check_error(lpSelectData, PeekConsoleInput(lpQuery->hFileDescr,
+                                                   &record, 1, &n)
+                    == 0))
+    {
+      break;
+    }
+    /* check for ASCII keypress only */
+    if (record.EventType == KEY_EVENT &&
+      record.Event.KeyEvent.bKeyDown &&
+      record.Event.KeyEvent.uChar.AsciiChar != 0)
+    {
+      select_data_result_add(lpSelectData, lpQuery->EMode, lpQuery->lpOrigIdx);
+      lpSelectData->EState = SELECT_STATE_SIGNALED;
+      break;
+    }
+    else
+    {
+      /* discard everything else and try again */
+      if (check_error(lpSelectData, ReadConsoleInput(lpQuery->hFileDescr,
+                                                     &record, 1, &n)
+                      == 0))
+      {
+        break;
+      }
+    }
+  };
+}
+
+/* Add a function to monitor console input */
+LPSELECTDATA read_console_poll_add (LPSELECTDATA lpSelectData,
+                                    SELECTMODE EMode,
+                                    HANDLE hFileDescr,
+                                    int lpOrigIdx,
+                                    unsigned int uFlagsFd)
+{
+  LPSELECTDATA res;
+
+  res = select_data_new(lpSelectData, SELECT_TYPE_CONSOLE_READ);
+  res->funcWorker = read_console_poll;
+  select_data_query_add(res, SELECT_MODE_READ, hFileDescr, lpOrigIdx, uFlagsFd);
+
+  return res;
+}
+
+/***********************/
+/*        Pipe         */
+/***********************/
+
+/* Monitor a pipe for input */
+void read_pipe_poll (HANDLE hStop, void *_data)
+{
+  DWORD         res;
+  DWORD         event;
+  DWORD         n;
+  LPSELECTQUERY iterQuery;
+  LPSELECTDATA  lpSelectData;
+  DWORD         i;
+  DWORD         wait;
+
+  /* Poll pipe */
+  event = 0;
+  n = 0;
+  lpSelectData = (LPSELECTDATA)_data;
+  wait = 1;
+
+  DEBUG_PRINT("Checking data pipe");
+  while (lpSelectData->EState == SELECT_STATE_NONE)
+  {
+    for (i = 0; i < lpSelectData->nQueriesCount; i++)
+    {
+      iterQuery = &(lpSelectData->aQueries[i]);
+      res = PeekNamedPipe(
+          iterQuery->hFileDescr,
+          NULL,
+          0,
+          NULL,
+          &n,
+          NULL);
+      if (check_error(lpSelectData,
+            (res == 0) &&
+            (GetLastError() != ERROR_BROKEN_PIPE)))
+      {
+        break;
+      };
+
+      if ((n > 0) || (res == 0))
+      {
+        lpSelectData->EState = SELECT_STATE_SIGNALED;
+        select_data_result_add(lpSelectData, iterQuery->EMode,
+                               iterQuery->lpOrigIdx);
+      };
+    };
+
+    /* Alas, nothing except polling seems to work for pipes.
+       Check the state & stop_worker_event every 10 ms
+     */
+    if (lpSelectData->EState == SELECT_STATE_NONE)
+    {
+      event = WaitForSingleObject(hStop, wait);
+
+      /* Fast start: begin to wait 1, 2, 4, 8 and then 10 ms.
+       * If we are working with the output of a program there is
+       * a chance that one of the 4 first calls succeed.
+       */
+      wait = 2 * wait;
+      if (wait > 10)
+      {
+        wait = 10;
+      };
+      if (event == WAIT_OBJECT_0
+          || check_error(lpSelectData, event == WAIT_FAILED))
+      {
+        break;
+      }
+    }
+  }
+  DEBUG_PRINT("Finish checking data on pipe");
+}
+
+/* Add a function to monitor pipe input */
+LPSELECTDATA read_pipe_poll_add (LPSELECTDATA lpSelectData,
+                                 SELECTMODE EMode,
+                                 HANDLE hFileDescr,
+                                 int lpOrigIdx,
+                                 unsigned int uFlagsFd)
+{
+  LPSELECTDATA res;
+  LPSELECTDATA hd;
+
+  hd = lpSelectData;
+  /* Polling pipe is a non blocking operation by default. This means that each
+     worker can handle many pipe. We begin to try to find a worker that is
+     polling pipe, but for which there is under the limit of pipe per worker.
+     */
+  DEBUG_PRINT("Searching an available worker handling pipe");
+  res = select_data_job_search(&hd, SELECT_TYPE_PIPE_READ);
+
+  /* Add a new pipe to poll */
+  res->funcWorker = read_pipe_poll;
+  select_data_query_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
+
+  return hd;
+}
+
+/***********************/
+/*       Socket        */
+/***********************/
+
+/* Monitor socket */
+void socket_poll (HANDLE hStop, void *_data)
+{
+  LPSELECTDATA   lpSelectData;
+  LPSELECTQUERY    iterQuery;
+  HANDLE           aEvents[MAXIMUM_SELECT_OBJECTS];
+  DWORD            nEvents;
+  long             maskEvents;
+  DWORD            i;
+  u_long           iMode;
+  SELECTMODE       mode;
+  WSANETWORKEVENTS events;
+
+  lpSelectData = (LPSELECTDATA)_data;
+
+  DEBUG_PRINT("Worker has %d queries to service", lpSelectData->nQueriesCount);
+  for (nEvents = 0; nEvents < lpSelectData->nQueriesCount; nEvents++)
+  {
+    iterQuery = &(lpSelectData->aQueries[nEvents]);
+    aEvents[nEvents] = CreateEvent(NULL, TRUE, FALSE, NULL);
+    maskEvents = 0;
+    mode = iterQuery->EMode;
+    if ((mode & SELECT_MODE_READ) != 0)
+    {
+      DEBUG_PRINT("Polling read for %d", iterQuery->hFileDescr);
+      maskEvents |= FD_READ | FD_ACCEPT | FD_CLOSE;
+    }
+    if ((mode & SELECT_MODE_WRITE) != 0)
+    {
+      DEBUG_PRINT("Polling write for %d", iterQuery->hFileDescr);
+      maskEvents |= FD_WRITE | FD_CONNECT | FD_CLOSE;
+    }
+    if ((mode & SELECT_MODE_EXCEPT) != 0)
+    {
+      DEBUG_PRINT("Polling exceptions for %d", iterQuery->hFileDescr);
+      maskEvents |= FD_OOB;
+    }
+
+    check_error(lpSelectData,
+        WSAEventSelect(
+          (SOCKET)(iterQuery->hFileDescr),
+          aEvents[nEvents],
+          maskEvents) == SOCKET_ERROR);
+  }
+
+  /* Add stop event */
+  aEvents[nEvents]  = hStop;
+  nEvents++;
+
+  if (lpSelectData->nError == 0)
+  {
+    check_error(lpSelectData,
+        WaitForMultipleObjects(
+          nEvents,
+          aEvents,
+          FALSE,
+          INFINITE) == WAIT_FAILED);
+  };
+
+  if (lpSelectData->nError == 0)
+  {
+    for (i = 0; i < lpSelectData->nQueriesCount; i++)
+    {
+      iterQuery = &(lpSelectData->aQueries[i]);
+      if (WaitForSingleObject(aEvents[i], 0) == WAIT_OBJECT_0)
+      {
+        DEBUG_PRINT("Socket %d has pending events", (i - 1));
+        if (iterQuery != NULL)
+        {
+          /* Find out what kind of events were raised
+           */
+          if (WSAEnumNetworkEvents((SOCKET)(iterQuery->hFileDescr),
+                                   aEvents[i], &events) == 0)
+          {
+            if ((iterQuery->EMode & SELECT_MODE_READ) != 0
+                && (events.lNetworkEvents & (FD_READ | FD_ACCEPT | FD_CLOSE))
+                   != 0)
+            {
+              select_data_result_add(lpSelectData, SELECT_MODE_READ,
+                                     iterQuery->lpOrigIdx);
+            }
+            if ((iterQuery->EMode & SELECT_MODE_WRITE) != 0
+                && (events.lNetworkEvents & (FD_WRITE | FD_CONNECT | FD_CLOSE))
+                   != 0)
+            {
+              select_data_result_add(lpSelectData, SELECT_MODE_WRITE,
+                                     iterQuery->lpOrigIdx);
+            }
+            if ((iterQuery->EMode & SELECT_MODE_EXCEPT) != 0
+                && (events.lNetworkEvents & FD_OOB) != 0)
+            {
+              select_data_result_add(lpSelectData, SELECT_MODE_EXCEPT,
+                                     iterQuery->lpOrigIdx);
+            }
+          }
+        }
+      }
+      /* WSAEventSelect() automatically sets socket to nonblocking mode.
+         Restore the blocking one. */
+      if (iterQuery->uFlagsFd & FLAGS_FD_IS_BLOCKING)
+      {
+        DEBUG_PRINT("Restore a blocking socket");
+        iMode = 0;
+        check_error(lpSelectData,
+          WSAEventSelect((SOCKET)(iterQuery->hFileDescr), aEvents[i], 0) != 0 ||
+          ioctlsocket((SOCKET)(iterQuery->hFileDescr), FIONBIO, &iMode) != 0);
+      }
+      else
+      {
+        check_error(lpSelectData,
+          WSAEventSelect((SOCKET)(iterQuery->hFileDescr), aEvents[i], 0) != 0);
+      };
+
+      CloseHandle(aEvents[i]);
+      aEvents[i] = INVALID_HANDLE_VALUE;
+    }
+  }
+}
+
+/* Add a function to monitor socket */
+LPSELECTDATA socket_poll_add (LPSELECTDATA lpSelectData,
+                              SELECTMODE EMode,
+                              HANDLE hFileDescr,
+                              int lpOrigIdx,
+                              unsigned int uFlagsFd)
+{
+  LPSELECTDATA res;
+  LPSELECTDATA candidate;
+  long i;
+  LPSELECTQUERY aQueries;
+
+  res = lpSelectData;
+  candidate = NULL;
+  aQueries = NULL;
+
+  /* Polling socket can be done multiple handle at the same time. You just
+     need one worker to use it. Try to find if there is already a worker
+     handling this kind of request.
+     Only one event can be associated with a given socket which means
+     that if a socket is in more than one of the fd_sets then we have
+     to find that particular query and update EMode with the
+     additional flag.
+     */
+  DEBUG_PRINT("Scanning list of worker to find one that already handle socket");
+  /* Search for job */
+  DEBUG_PRINT("Searching for an available job for type %d for descriptor %d",
+              SELECT_TYPE_SOCKET, hFileDescr);
+  while (res != NULL)
+  {
+    if (res->EType == SELECT_TYPE_SOCKET)
+    {
+      i = res->nQueriesCount - 1;
+      aQueries = res->aQueries;
+      while (i >= 0 && aQueries[i].hFileDescr != hFileDescr)
+      {
+        i--;
+      }
+      /* If we didn't find the socket but this worker has available
+         slots, store it
+       */
+      if (i < 0)
+      {
+        if ( res->nQueriesCount < MAXIMUM_SELECT_OBJECTS)
+        {
+          candidate = res;
+        }
+        res = LIST_NEXT(LPSELECTDATA, res);
+      }
+      else
+      {
+        /* Previous socket query located -- we're finished
+         */
+        aQueries = &aQueries[i];
+        break;
+      }
+    }
+    else
+    {
+      res = LIST_NEXT(LPSELECTDATA, res);
+    }
+  }
+
+  if (res == NULL)
+  {
+    res = candidate;
+
+    /* No matching job found, create one */
+    if (res == NULL)
+    {
+      DEBUG_PRINT("No job for type %d found, create one", SELECT_TYPE_SOCKET);
+      res = select_data_new(lpSelectData, SELECT_TYPE_SOCKET);
+      res->funcWorker = socket_poll;
+      res->nQueriesCount = 1;
+      aQueries = &res->aQueries[0];
+    }
+    else
+    {
+      aQueries = &(res->aQueries[res->nQueriesCount++]);
+    }
+    aQueries->EMode = EMode;
+    aQueries->hFileDescr = hFileDescr;
+    aQueries->lpOrigIdx = lpOrigIdx;
+    aQueries->uFlagsFd = uFlagsFd;
+    DEBUG_PRINT("Socket %x added", hFileDescr);
+  }
+  else
+  {
+    aQueries->EMode |= EMode;
+    DEBUG_PRINT("Socket %x updated to %d", hFileDescr, aQueries->EMode);
+  }
+
+  return res;
+}
+
+/***********************/
+/*       Static        */
+/***********************/
+
+/* Add a static result */
+LPSELECTDATA static_poll_add (LPSELECTDATA lpSelectData,
+                              SELECTMODE EMode,
+                              HANDLE hFileDescr,
+                              int lpOrigIdx,
+                              unsigned int uFlagsFd)
+{
+  LPSELECTDATA res;
+  LPSELECTDATA hd;
+
+  /* Look for an already initialized static element */
+  hd = lpSelectData;
+  res = select_data_job_search(&hd, SELECT_TYPE_STATIC);
+
+  /* Add a new query/result */
+  select_data_query_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
+  select_data_result_add(res, EMode, lpOrigIdx);
+
+  return hd;
+}
+
+/********************************/
+/* Generic select data handling */
+/********************************/
+
+/* Guess handle type */
+static SELECTHANDLETYPE get_handle_type(value fd)
+{
+  DWORD            mode;
+  SELECTHANDLETYPE res;
+
+  CAMLparam1(fd);
+
+  mode = 0;
+  res = SELECT_HANDLE_NONE;
+
+  if (Descr_kind_val(fd) == KIND_SOCKET)
+  {
+    res = SELECT_HANDLE_SOCKET;
+  }
+  else
+  {
+    switch(GetFileType(Handle_val(fd)))
+    {
+      case FILE_TYPE_DISK:
+        res = SELECT_HANDLE_DISK;
+        break;
+
+      case FILE_TYPE_CHAR: /* character file or a console */
+        if (GetConsoleMode(Handle_val(fd), &mode) != 0)
+        {
+          res = SELECT_HANDLE_CONSOLE;
+        }
+        else
+        {
+          res = SELECT_HANDLE_NONE;
+        };
+        break;
+
+      case FILE_TYPE_PIPE: /* a named or an anonymous pipe (socket
+                              already handled) */
+        res = SELECT_HANDLE_PIPE;
+        break;
+    };
+  };
+
+  CAMLreturnT(SELECTHANDLETYPE, res);
+}
+
+/* Choose what to do with given data */
+LPSELECTDATA select_data_dispatch (LPSELECTDATA lpSelectData, SELECTMODE EMode,
+                                   value fd, int lpOrigIdx)
+{
+  LPSELECTDATA    res;
+  HANDLE          hFileDescr;
+  struct sockaddr sa;
+  int             sa_len;
+  BOOL            alreadyAdded;
+  unsigned int    uFlagsFd;
+
+  CAMLparam1(fd);
+
+  res          = lpSelectData;
+  hFileDescr   = Handle_val(fd);
+  sa_len       = sizeof(sa);
+  alreadyAdded = FALSE;
+  uFlagsFd     = Flags_fd_val(fd);
+
+  DEBUG_PRINT("Begin dispatching handle %x", hFileDescr);
+
+  DEBUG_PRINT("Waiting for %d on handle %x", EMode, hFileDescr);
+
+  /* There is only 2 way to have except mode: transmission of OOB data through
+     a socket TCP/IP and through a strange interaction with a TTY.
+     With windows, we only consider the TCP/IP except condition
+  */
+  switch(get_handle_type(fd))
+  {
+    case SELECT_HANDLE_DISK:
+      DEBUG_PRINT("Handle %x is a disk handle", hFileDescr);
+      /* Disk is always ready in read/write operation */
+      if (EMode == SELECT_MODE_READ || EMode == SELECT_MODE_WRITE)
+      {
+        res = static_poll_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
+      };
+      break;
+
+    case SELECT_HANDLE_CONSOLE:
+      DEBUG_PRINT("Handle %x is a console handle", hFileDescr);
+      /* Console is always ready in write operation, need to check for read. */
+      if (EMode == SELECT_MODE_READ)
+      {
+        res = read_console_poll_add(res, EMode, hFileDescr, lpOrigIdx,
+                                    uFlagsFd);
+      }
+      else if (EMode == SELECT_MODE_WRITE)
+      {
+        res = static_poll_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
+      };
+      break;
+
+    case SELECT_HANDLE_PIPE:
+      DEBUG_PRINT("Handle %x is a pipe handle", hFileDescr);
+      /* Console is always ready in write operation, need to check for read. */
+      if (EMode == SELECT_MODE_READ)
+      {
+        DEBUG_PRINT("Need to check availability of data on pipe");
+        res = read_pipe_poll_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
+      }
+      else if (EMode == SELECT_MODE_WRITE)
+      {
+        DEBUG_PRINT("No need to check availability of data on pipe, "
+                    "write operation always possible");
+        res = static_poll_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
+      };
+      break;
+
+    case SELECT_HANDLE_SOCKET:
+      DEBUG_PRINT("Handle %x is a socket handle", hFileDescr);
+      if (getsockname((SOCKET)hFileDescr, &sa, &sa_len) == SOCKET_ERROR)
+      {
+        if (WSAGetLastError() == WSAEINVAL)
+        {
+          /* Socket is not bound */
+          DEBUG_PRINT("Socket is not connected");
+          if (EMode == SELECT_MODE_WRITE || EMode == SELECT_MODE_READ)
+          {
+            res = static_poll_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
+            alreadyAdded = TRUE;
+          }
+        }
+      }
+      if (!alreadyAdded)
+      {
+        res = socket_poll_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
+      }
+      break;
+
+    default:
+      DEBUG_PRINT("Handle %x is unknown", hFileDescr);
+      win32_maperr(ERROR_INVALID_HANDLE);
+      uerror("select", Nothing);
+      break;
+  };
+
+  DEBUG_PRINT("Finish dispatching handle %x", hFileDescr);
+
+  CAMLreturnT(LPSELECTDATA, res);
+}
+
+static DWORD caml_list_length (value lst)
+{
+  DWORD res;
+
+  CAMLparam1 (lst);
+  CAMLlocal1 (l);
+
+  for (res = 0, l = lst; l != Val_int(0); l = Field(l, 1), res++)
+  { }
+
+  CAMLreturnT(DWORD, res);
+}
+
+static value find_handle(LPSELECTRESULT iterResult, value readfds,
+                         value writefds, value exceptfds)
+{
+  CAMLparam3(readfds, writefds, exceptfds);
+  CAMLlocal2(result, list);
+  int i;
+
+  switch( iterResult->EMode )
+  {
+    case SELECT_MODE_READ:
+      list = readfds;
+      break;
+    case SELECT_MODE_WRITE:
+      list = writefds;
+      break;
+    case SELECT_MODE_EXCEPT:
+      list = exceptfds;
+      break;
+    case SELECT_MODE_NONE:
+      CAMLassert(0);
+  };
+
+  for(i=0; list != Val_unit && i < iterResult->lpOrigIdx; ++i )
+  {
+    list = Field(list, 1);
+  }
+
+  if (list == Val_unit)
+    caml_failwith ("select.c: original file handle not found");
+
+  result = Field(list, 0);
+
+  CAMLreturn( result );
+}
+
+#define MAX(a, b) ((a) > (b) ? (a) : (b))
+
+/* Convert fdlist to an fd_set if all the handles in fdlist are
+ * sockets and return 1.  Returns 0 if a non-socket value is
+ * encountered, or if there are more than FD_SETSIZE sockets.
+ */
+static int fdlist_to_fdset(value fdlist, fd_set *fdset)
+{
+  value l, c;
+  int n = 0;
+  FD_ZERO(fdset);
+  for (l = fdlist; l != Val_int(0); l = Field(l, 1)) {
+    if (++n > FD_SETSIZE) {
+      DEBUG_PRINT("More than FD_SETSIZE sockets");
+      return 0;
+    }
+    c = Field(l, 0);
+    if (Descr_kind_val(c) == KIND_SOCKET) {
+      FD_SET(Socket_val(c), fdset);
+    } else {
+      DEBUG_PRINT("Non socket value encountered");
+      return 0;
+    }
+  }
+  return 1;
+}
+
+static value fdset_to_fdlist(value fdlist, fd_set *fdset)
+{
+  CAMLparam1(fdlist);
+  CAMLlocal2(res, s);
+  res = Val_int(0);
+  for (/*nothing*/; fdlist != Val_int(0); fdlist = Field(fdlist, 1)) {
+    s = Field(fdlist, 0);
+    if (FD_ISSET(Socket_val(s), fdset)) {
+      value newres = caml_alloc_small(2, 0);
+      Field(newres, 0) = s;
+      Field(newres, 1) = res;
+      res = newres;
+    }
+  }
+  CAMLreturn(res);
+}
+
+CAMLprim value unix_select(value readfds, value writefds, value exceptfds,
+                           value timeout)
+{
+  /* Event associated to handle */
+  DWORD   nEventsCount;
+  DWORD   nEventsMax;
+  HANDLE *lpEventsDone;
+
+  /* Data for all handles */
+  LPSELECTDATA lpSelectData;
+  LPSELECTDATA iterSelectData;
+
+  /* Iterator for results */
+  LPSELECTRESULT iterResult;
+
+  /* Iterator */
+  DWORD i;
+
+  /* Error status */
+  DWORD err;
+
+  /* Time to wait */
+  DWORD milliseconds;
+
+  /* Is there static select data */
+  BOOL  hasStaticData = FALSE;
+
+  /* Wait return */
+  DWORD waitRet;
+
+  /* Set of handle */
+  SELECTHANDLESET hds;
+  DWORD           hdsMax;
+  LPHANDLE        hdsData;
+
+  /* Length of each list */
+  DWORD readfds_len;
+  DWORD writefds_len;
+  DWORD exceptfds_len;
+
+  CAMLparam4 (readfds, writefds, exceptfds, timeout);
+  CAMLlocal5 (read_list, write_list, except_list, res, l);
+  CAMLlocal1 (fd);
+
+  fd_set read, write, except;
+  double tm;
+  struct timeval tv;
+  struct timeval * tvp;
+
+  DEBUG_PRINT("in select");
+
+  err = 0;
+  tm = Double_val(timeout);
+  if (readfds == Val_int(0)
+      && writefds == Val_int(0)
+      && exceptfds == Val_int(0)) {
+    DEBUG_PRINT("nothing to do");
+    if ( tm > 0.0 ) {
+      caml_enter_blocking_section();
+      Sleep( (int)(tm * 1000));
+      caml_leave_blocking_section();
+    }
+    read_list = write_list = except_list = Val_int(0);
+  } else {
+    if (fdlist_to_fdset(readfds, &read)
+        && fdlist_to_fdset(writefds, &write)
+        && fdlist_to_fdset(exceptfds, &except)) {
+      DEBUG_PRINT("only sockets to select on, using classic select");
+      if (tm < 0.0) {
+        tvp = (struct timeval *) NULL;
+      } else {
+        tv.tv_sec = (int) tm;
+        tv.tv_usec = (int) (1e6 * (tm - (int) tm));
+        tvp = &tv;
+      }
+      caml_enter_blocking_section();
+      if (select(FD_SETSIZE, &read, &write, &except, tvp) == -1) {
+        err = WSAGetLastError();
+        DEBUG_PRINT("Error %ld occurred", err);
+      }
+      caml_leave_blocking_section();
+      if (err) {
+        DEBUG_PRINT("Error %ld occurred", err);
+        win32_maperr(err);
+        uerror("select", Nothing);
+      }
+      read_list = fdset_to_fdlist(readfds, &read);
+      write_list = fdset_to_fdlist(writefds, &write);
+      except_list = fdset_to_fdlist(exceptfds, &except);
+    } else {
+      nEventsCount   = 0;
+      nEventsMax     = 0;
+      lpEventsDone   = NULL;
+      lpSelectData   = NULL;
+      iterSelectData = NULL;
+      iterResult     = NULL;
+      hasStaticData  = 0;
+      waitRet        = 0;
+      readfds_len    = caml_list_length(readfds);
+      writefds_len   = caml_list_length(writefds);
+      exceptfds_len  = caml_list_length(exceptfds);
+      hdsMax         = MAX(readfds_len, MAX(writefds_len, exceptfds_len));
+
+      hdsData = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * hdsMax);
+
+      if (tm >= 0.0)
+        {
+          milliseconds = 1000 * tm;
+          DEBUG_PRINT("Will wait %d ms", milliseconds);
+        }
+      else
+        {
+          milliseconds = INFINITE;
+        }
+
+
+      /* Create list of select data, based on the different list of fd
+         to watch */
+      DEBUG_PRINT("Dispatch read fd");
+      handle_set_init(&hds, hdsData, hdsMax);
+      i=0;
+      for (l = readfds; l != Val_int(0); l = Field(l, 1))
+        {
+          fd = Field(l, 0);
+          if (!handle_set_mem(&hds, Handle_val(fd)))
+            {
+              handle_set_add(&hds, Handle_val(fd));
+              lpSelectData = select_data_dispatch(lpSelectData,
+                                                  SELECT_MODE_READ, fd, i++);
+            }
+          else
+            {
+              DEBUG_PRINT("Discarding handle %x which is already monitor "
+                          "for read", Handle_val(fd));
+            }
+        }
+      handle_set_reset(&hds);
+
+      DEBUG_PRINT("Dispatch write fd");
+      handle_set_init(&hds, hdsData, hdsMax);
+      i=0;
+      for (l = writefds; l != Val_int(0); l = Field(l, 1))
+        {
+          fd = Field(l, 0);
+          if (!handle_set_mem(&hds, Handle_val(fd)))
+            {
+              handle_set_add(&hds, Handle_val(fd));
+              lpSelectData = select_data_dispatch(lpSelectData,
+                                                  SELECT_MODE_WRITE, fd, i++);
+            }
+          else
+            {
+              DEBUG_PRINT("Discarding handle %x which is already monitor "
+                          "for write", Handle_val(fd));
+            }
+        }
+      handle_set_reset(&hds);
+
+      DEBUG_PRINT("Dispatch exceptional fd");
+      handle_set_init(&hds, hdsData, hdsMax);
+      i=0;
+      for (l = exceptfds; l != Val_int(0); l = Field(l, 1))
+        {
+          fd = Field(l, 0);
+          if (!handle_set_mem(&hds, Handle_val(fd)))
+            {
+              handle_set_add(&hds, Handle_val(fd));
+              lpSelectData = select_data_dispatch(lpSelectData,
+                                                  SELECT_MODE_EXCEPT, fd, i++);
+            }
+          else
+            {
+              DEBUG_PRINT("Discarding handle %x which is already monitor "
+                          "for exceptional", Handle_val(fd));
+            }
+        }
+      handle_set_reset(&hds);
+
+      /* Building the list of handle to wait for */
+      DEBUG_PRINT("Building events done array");
+      nEventsMax   = list_length((LPLIST)lpSelectData);
+      nEventsCount = 0;
+      lpEventsDone = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * nEventsMax);
+
+      iterSelectData = lpSelectData;
+      while (iterSelectData != NULL)
+        {
+          /* Check if it is static data. If this is the case, launch everything
+           * but don't wait for events. It helps to test if there are events on
+           * any other fd (which are not static), knowing that there is at least
+           * one result (the static data).
+           */
+          if (iterSelectData->EType == SELECT_TYPE_STATIC)
+            {
+              hasStaticData = TRUE;
+            };
+
+          /* Execute APC */
+          if (iterSelectData->funcWorker != NULL)
+            {
+              iterSelectData->lpWorker =
+                worker_job_submit(
+                                  iterSelectData->funcWorker,
+                                  (void *)iterSelectData);
+              DEBUG_PRINT("Job submitted to worker %x",
+                          iterSelectData->lpWorker);
+              lpEventsDone[nEventsCount]
+                = worker_job_event_done(iterSelectData->lpWorker);
+              nEventsCount++;
+            };
+          iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
+        };
+
+      DEBUG_PRINT("Need to watch %d workers", nEventsCount);
+
+      /* Processing select itself */
+      caml_enter_blocking_section();
+      /* There are worker started, waiting to be monitored */
+      if (nEventsCount > 0)
+        {
+          /* Waiting for event */
+          if (err == 0 && !hasStaticData)
+            {
+              DEBUG_PRINT("Waiting for one select worker to be done");
+              switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, FALSE,
+                                             milliseconds))
+                {
+                case WAIT_FAILED:
+                  err = GetLastError();
+                  break;
+
+                case WAIT_TIMEOUT:
+                  DEBUG_PRINT("Select timeout");
+                  break;
+
+                default:
+                  DEBUG_PRINT("One worker is done");
+                  break;
+                };
+            }
+
+          /* Ordering stop to every worker */
+          DEBUG_PRINT("Sending stop signal to every select workers");
+          iterSelectData = lpSelectData;
+          while (iterSelectData != NULL)
+            {
+              if (iterSelectData->lpWorker != NULL)
+                {
+                  worker_job_stop(iterSelectData->lpWorker);
+                };
+              iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
+            };
+
+          DEBUG_PRINT("Waiting for every select worker to be done");
+          switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, TRUE,
+                                         INFINITE))
+            {
+            case WAIT_FAILED:
+              err = GetLastError();
+              break;
+
+            default:
+              DEBUG_PRINT("Every worker is done");
+              break;
+            }
+        }
+      /* Nothing to monitor but some time to wait. */
+      else if (!hasStaticData)
+        {
+          Sleep(milliseconds);
+        }
+      caml_leave_blocking_section();
+
+      DEBUG_PRINT("Error status: %d (0 is ok)", err);
+      /* Build results */
+      if (err == 0)
+        {
+          DEBUG_PRINT("Building result");
+          read_list = Val_unit;
+          write_list = Val_unit;
+          except_list = Val_unit;
+
+          iterSelectData = lpSelectData;
+          while (iterSelectData != NULL)
+            {
+              for (i = 0; i < iterSelectData->nResultsCount; i++)
+                {
+                  iterResult = &(iterSelectData->aResults[i]);
+                  l = caml_alloc_small(2, 0);
+                  Field(l, 0) = find_handle(iterResult, readfds, writefds,
+                                            exceptfds);
+                  switch (iterResult->EMode)
+                    {
+                    case SELECT_MODE_READ:
+                      Field(l, 1) =  read_list;
+                      read_list = l;
+                      break;
+                    case SELECT_MODE_WRITE:
+                      Field(l, 1) = write_list;
+                      write_list = l;
+                      break;
+                    case SELECT_MODE_EXCEPT:
+                      Field(l, 1) = except_list;
+                      except_list = l;
+                      break;
+                    case SELECT_MODE_NONE:
+                      CAMLassert(0);
+                    }
+                }
+              /* We try to only process the first error, bypass other errors */
+              if (err == 0 && iterSelectData->EState == SELECT_STATE_ERROR)
+                {
+                  err = iterSelectData->nError;
+                }
+              iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
+            }
+        }
+
+      /* Free resources */
+      DEBUG_PRINT("Free selectdata resources");
+      iterSelectData = lpSelectData;
+      while (iterSelectData != NULL)
+        {
+          lpSelectData = iterSelectData;
+          iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
+          select_data_free(lpSelectData);
+        }
+      lpSelectData = NULL;
+
+      /* Free allocated events/handle set array */
+      DEBUG_PRINT("Free local allocated resources");
+      caml_stat_free(lpEventsDone);
+      caml_stat_free(hdsData);
+
+      DEBUG_PRINT("Raise error if required");
+      if (err != 0)
+        {
+          win32_maperr(err);
+          uerror("select", Nothing);
+        }
+    }
+  }
+
+  DEBUG_PRINT("Build final result");
+  res = caml_alloc_small(3, 0);
+  Field(res, 0) = read_list;
+  Field(res, 1) = write_list;
+  Field(res, 2) = except_list;
+
+  DEBUG_PRINT("out select");
+
+  CAMLreturn(res);
+}
diff --git a/otherlibs/win32unix/sendrecv.c b/otherlibs/win32unix/sendrecv.c
new file mode 100644
index 00000000..1daa8e99
--- /dev/null
+++ b/otherlibs/win32unix/sendrecv.c
@@ -0,0 +1,143 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+#include "socketaddr.h"
+
+static int msg_flag_table[] = {
+  MSG_OOB, MSG_DONTROUTE, MSG_PEEK
+};
+
+CAMLprim value unix_recv(value sock, value buff, value ofs, value len,
+                         value flags)
+{
+  SOCKET s = Socket_val(sock);
+  int flg = caml_convert_flag_list(flags, msg_flag_table);
+  int ret;
+  intnat numbytes;
+  char iobuf[UNIX_BUFFER_SIZE];
+  DWORD err = 0;
+
+  Begin_root (buff);
+    numbytes = Long_val(len);
+    if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
+    caml_enter_blocking_section();
+    ret = recv(s, iobuf, (int) numbytes, flg);
+    if (ret == -1) err = WSAGetLastError();
+    caml_leave_blocking_section();
+    if (ret == -1) {
+      win32_maperr(err);
+      uerror("recv", Nothing);
+    }
+    memmove (&Byte(buff, Long_val(ofs)), iobuf, ret);
+  End_roots();
+  return Val_int(ret);
+}
+
+CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len,
+                             value flags)
+{
+  SOCKET s = Socket_val(sock);
+  int flg = caml_convert_flag_list(flags, msg_flag_table);
+  int ret;
+  intnat numbytes;
+  char iobuf[UNIX_BUFFER_SIZE];
+  value res;
+  value adr = Val_unit;
+  union sock_addr_union addr;
+  socklen_param_type addr_len;
+  DWORD err = 0;
+
+  Begin_roots2 (buff, adr);
+    numbytes = Long_val(len);
+    if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
+    addr_len = sizeof(sock_addr);
+    caml_enter_blocking_section();
+    ret = recvfrom(s, iobuf, (int) numbytes, flg, &addr.s_gen, &addr_len);
+    if (ret == -1) err = WSAGetLastError();
+    caml_leave_blocking_section();
+    if (ret == -1) {
+      win32_maperr(err);
+      uerror("recvfrom", Nothing);
+    }
+    memmove (&Byte(buff, Long_val(ofs)), iobuf, ret);
+    adr = alloc_sockaddr(&addr, addr_len, -1);
+    res = caml_alloc_small(2, 0);
+    Field(res, 0) = Val_int(ret);
+    Field(res, 1) = adr;
+  End_roots();
+  return res;
+}
+
+CAMLprim value unix_send(value sock, value buff, value ofs, value len,
+                         value flags)
+{
+  SOCKET s = Socket_val(sock);
+  int flg = caml_convert_flag_list(flags, msg_flag_table);
+  int ret;
+  intnat numbytes;
+  char iobuf[UNIX_BUFFER_SIZE];
+  DWORD err = 0;
+
+  numbytes = Long_val(len);
+  if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
+  memmove (iobuf, &Byte(buff, Long_val(ofs)), numbytes);
+  caml_enter_blocking_section();
+  ret = send(s, iobuf, (int) numbytes, flg);
+  if (ret == -1) err = WSAGetLastError();
+  caml_leave_blocking_section();
+  if (ret == -1) {
+    win32_maperr(err);
+    uerror("send", Nothing);
+  }
+  return Val_int(ret);
+}
+
+value unix_sendto_native(value sock, value buff, value ofs, value len,
+                         value flags, value dest)
+{
+  SOCKET s = Socket_val(sock);
+  int flg = caml_convert_flag_list(flags, msg_flag_table);
+  int ret;
+  intnat numbytes;
+  char iobuf[UNIX_BUFFER_SIZE];
+  union sock_addr_union addr;
+  socklen_param_type addr_len;
+  DWORD err = 0;
+
+  get_sockaddr(dest, &addr, &addr_len);
+  numbytes = Long_val(len);
+  if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
+  memmove (iobuf, &Byte(buff, Long_val(ofs)), numbytes);
+  caml_enter_blocking_section();
+  ret = sendto(s, iobuf, (int) numbytes, flg, &addr.s_gen, addr_len);
+  if (ret == -1) err = WSAGetLastError();
+  caml_leave_blocking_section();
+  if (ret == -1) {
+    win32_maperr(err);
+    uerror("sendto", Nothing);
+  }
+  return Val_int(ret);
+}
+
+CAMLprim value unix_sendto(value * argv, int argc)
+{
+  return unix_sendto_native
+           (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
+}
diff --git a/otherlibs/win32unix/shutdown.c b/otherlibs/win32unix/shutdown.c
new file mode 100644
index 00000000..d70f280e
--- /dev/null
+++ b/otherlibs/win32unix/shutdown.c
@@ -0,0 +1,32 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+static int shutdown_command_table[] = {
+  0, 1, 2
+};
+
+CAMLprim value unix_shutdown(sock, cmd)
+     value sock, cmd;
+{
+  if (shutdown(Socket_val(sock),
+               shutdown_command_table[Int_val(cmd)]) == -1) {
+    win32_maperr(WSAGetLastError());
+    uerror("shutdown", Nothing);
+  }
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/sleep.c b/otherlibs/win32unix/sleep.c
new file mode 100644
index 00000000..40127376
--- /dev/null
+++ b/otherlibs/win32unix/sleep.c
@@ -0,0 +1,28 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_sleep(t)
+     value t;
+{
+  double d = Double_val(t);
+  caml_enter_blocking_section();
+  Sleep(d * 1e3);
+  caml_leave_blocking_section();
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/socket.c b/otherlibs/win32unix/socket.c
new file mode 100644
index 00000000..dc88fcbb
--- /dev/null
+++ b/otherlibs/win32unix/socket.c
@@ -0,0 +1,56 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include "unixsupport.h"
+
+int socket_domain_table[] = {
+  PF_UNIX, PF_INET,
+#if defined(HAS_IPV6)
+  PF_INET6
+#else
+  0
+#endif
+};
+
+int socket_type_table[] = {
+  SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, SOCK_SEQPACKET
+};
+
+CAMLprim value unix_socket(value cloexec, value domain, value type, value proto)
+{
+  SOCKET s;
+
+  #ifndef HAS_IPV6
+  /* IPv6 requires WinSock2, we must raise an error on PF_INET6 */
+  if (Int_val(domain) >= sizeof(socket_domain_table)/sizeof(int)) {
+    win32_maperr(WSAEPFNOSUPPORT);
+    uerror("socket", Nothing);
+  }
+  #endif
+
+  s = socket(socket_domain_table[Int_val(domain)],
+                   socket_type_table[Int_val(type)],
+                   Int_val(proto));
+  if (s == INVALID_SOCKET) {
+    win32_maperr(WSAGetLastError());
+    uerror("socket", Nothing);
+  }
+  /* This is a best effort, not guaranteed to work, so don't fail on error */
+  SetHandleInformation((HANDLE) s,
+                       HANDLE_FLAG_INHERIT,
+                       unix_cloexec_p(cloexec) ? 0 : HANDLE_FLAG_INHERIT);
+  return win_alloc_socket(s);
+}
diff --git a/otherlibs/win32unix/socketaddr.h b/otherlibs/win32unix/socketaddr.h
new file mode 100644
index 00000000..e951bece
--- /dev/null
+++ b/otherlibs/win32unix/socketaddr.h
@@ -0,0 +1,58 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_SOCKETADDR_H
+#define CAML_SOCKETADDR_H
+
+#include "caml/misc.h"
+
+union sock_addr_union {
+  struct sockaddr s_gen;
+  struct sockaddr_in s_inet;
+#ifdef HAS_IPV6
+  struct sockaddr_in6 s_inet6;
+#endif
+};
+
+extern union sock_addr_union sock_addr;
+
+#ifdef HAS_SOCKLEN_T
+typedef socklen_t socklen_param_type;
+#else
+typedef int socklen_param_type;
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern void get_sockaddr (value mladdr,
+                          union sock_addr_union * addr /*out*/,
+                          socklen_param_type * addr_len /*out*/);
+CAMLprim value alloc_sockaddr (union sock_addr_union * addr /*in*/,
+                      socklen_param_type addr_len, int close_on_error);
+CAMLprim value alloc_inet_addr (struct in_addr * inaddr);
+#define GET_INET_ADDR(v) (*((struct in_addr *) (v)))
+
+#ifdef HAS_IPV6
+CAMLexport value alloc_inet6_addr (struct in6_addr * inaddr);
+#define GET_INET6_ADDR(v) (*((struct in6_addr *) (v)))
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_SOCKETADDR_H */
diff --git a/otherlibs/win32unix/sockopt.c b/otherlibs/win32unix/sockopt.c
new file mode 100644
index 00000000..6035556f
--- /dev/null
+++ b/otherlibs/win32unix/sockopt.c
@@ -0,0 +1,229 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <errno.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include "unixsupport.h"
+#include "socketaddr.h"
+
+#ifndef IPPROTO_IPV6
+#define IPPROTO_IPV6 (-1)
+#endif
+#ifndef IPV6_V6ONLY
+#define IPV6_V6ONLY (-1)
+#endif
+
+enum option_type {
+  TYPE_BOOL = 0,
+  TYPE_INT = 1,
+  TYPE_LINGER = 2,
+  TYPE_TIMEVAL = 3,
+  TYPE_UNIX_ERROR = 4
+};
+
+struct socket_option {
+  int level;
+  int option;
+};
+
+/* Table of options, indexed by type */
+
+static struct socket_option sockopt_bool[] = {
+  { SOL_SOCKET, SO_DEBUG },
+  { SOL_SOCKET, SO_BROADCAST },
+  { SOL_SOCKET, SO_REUSEADDR },
+  { SOL_SOCKET, SO_KEEPALIVE },
+  { SOL_SOCKET, SO_DONTROUTE },
+  { SOL_SOCKET, SO_OOBINLINE },
+  { SOL_SOCKET, SO_ACCEPTCONN },
+  { IPPROTO_TCP, TCP_NODELAY },
+  { IPPROTO_IPV6, IPV6_V6ONLY}
+};
+
+static struct socket_option sockopt_int[] = {
+  { SOL_SOCKET, SO_SNDBUF },
+  { SOL_SOCKET, SO_RCVBUF },
+  { SOL_SOCKET, SO_ERROR },
+  { SOL_SOCKET, SO_TYPE },
+  { SOL_SOCKET, SO_RCVLOWAT },
+  { SOL_SOCKET, SO_SNDLOWAT } };
+
+static struct socket_option sockopt_linger[] = {
+  { SOL_SOCKET, SO_LINGER }
+};
+
+static struct socket_option sockopt_timeval[] = {
+  { SOL_SOCKET, SO_RCVTIMEO },
+  { SOL_SOCKET, SO_SNDTIMEO }
+};
+
+static struct socket_option sockopt_unix_error[] = {
+  { SOL_SOCKET, SO_ERROR }
+};
+
+static struct socket_option * sockopt_table[] = {
+  sockopt_bool,
+  sockopt_int,
+  sockopt_linger,
+  sockopt_timeval,
+  sockopt_unix_error
+};
+
+static char * getsockopt_fun_name[] = {
+  "getsockopt",
+  "getsockopt_int",
+  "getsockopt_optint",
+  "getsockopt_float",
+  "getsockopt_error"
+};
+
+static char * setsockopt_fun_name[] = {
+  "setsockopt",
+  "setsockopt_int",
+  "setsockopt_optint",
+  "setsockopt_float",
+  "setsockopt_error"
+};
+
+union option_value {
+  int i;
+  struct linger lg;
+  struct timeval tv;
+};
+
+CAMLexport value
+unix_getsockopt_aux(char * name,
+                    enum option_type ty, int level, int option,
+                    value socket)
+{
+  union option_value optval;
+  socklen_param_type optsize;
+
+
+  switch (ty) {
+  case TYPE_BOOL:
+  case TYPE_INT:
+  case TYPE_UNIX_ERROR:
+    optsize = sizeof(optval.i); break;
+  case TYPE_LINGER:
+    optsize = sizeof(optval.lg); break;
+  case TYPE_TIMEVAL:
+    optsize = sizeof(optval.tv); break;
+  default:
+    unix_error(EINVAL, name, Nothing);
+  }
+
+  if (getsockopt(Socket_val(socket), level, option,
+                 (void *) &optval, &optsize) == -1)
+    uerror(name, Nothing);
+
+  switch (ty) {
+  case TYPE_BOOL:
+  case TYPE_INT:
+    return Val_int(optval.i);
+  case TYPE_LINGER:
+    if (optval.lg.l_onoff == 0) {
+      return Val_int(0);        /* None */
+    } else {
+      value res = caml_alloc_small(1, 0); /* Some */
+      Field(res, 0) = Val_int(optval.lg.l_linger);
+      return res;
+    }
+  case TYPE_TIMEVAL:
+    return caml_copy_double((double) optval.tv.tv_sec
+                       + (double) optval.tv.tv_usec / 1e6);
+  case TYPE_UNIX_ERROR:
+    if (optval.i == 0) {
+      return Val_int(0);        /* None */
+    } else {
+      value err, res;
+      err = unix_error_of_code(optval.i);
+      Begin_root(err);
+        res = caml_alloc_small(1, 0); /* Some */
+        Field(res, 0) = err;
+      End_roots();
+      return res;
+    }
+  default:
+    unix_error(EINVAL, name, Nothing);
+    return Val_unit; /* Avoid warning */
+  }
+}
+
+CAMLexport value
+unix_setsockopt_aux(char * name,
+                    enum option_type ty, int level, int option,
+                    value socket, value val)
+{
+  union option_value optval;
+  socklen_param_type optsize;
+  double f;
+
+  switch (ty) {
+  case TYPE_BOOL:
+  case TYPE_INT:
+    optsize = sizeof(optval.i);
+    optval.i = Int_val(val);
+    break;
+  case TYPE_LINGER:
+    optsize = sizeof(optval.lg);
+    optval.lg.l_onoff = Is_block (val);
+    if (optval.lg.l_onoff)
+      optval.lg.l_linger = Int_val (Field (val, 0));
+    break;
+  case TYPE_TIMEVAL:
+    f = Double_val(val);
+    optsize = sizeof(optval.tv);
+    optval.tv.tv_sec = (int) f;
+    optval.tv.tv_usec = (int) (1e6 * (f - optval.tv.tv_sec));
+    break;
+  case TYPE_UNIX_ERROR:
+  default:
+    unix_error(EINVAL, name, Nothing);
+  }
+
+  if (setsockopt(Socket_val(socket), level, option,
+                 (void *) &optval, optsize) == -1)
+    uerror(name, Nothing);
+
+  return Val_unit;
+}
+
+CAMLprim value 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)]);
+  return unix_getsockopt_aux(getsockopt_fun_name[ty],
+                             ty,
+                             opt->level,
+                             opt->option,
+                             vsocket);
+}
+
+CAMLprim value 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)]);
+  return unix_setsockopt_aux(setsockopt_fun_name[ty],
+                             ty,
+                             opt->level,
+                             opt->option,
+                             vsocket,
+                             val);
+}
diff --git a/otherlibs/win32unix/startup.c b/otherlibs/win32unix/startup.c
new file mode 100644
index 00000000..844ebd5b
--- /dev/null
+++ b/otherlibs/win32unix/startup.c
@@ -0,0 +1,51 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <stdio.h>
+#include <fcntl.h>
+#include <stdlib.h>
+#include <caml/mlvalues.h>
+#include "winworker.h"
+#include "windbug.h"
+
+value val_process_id;
+
+CAMLprim value win_startup(unit)
+     value unit;
+{
+  WSADATA wsaData;
+  int i;
+  HANDLE h;
+
+  (void) WSAStartup(MAKEWORD(2, 0), &wsaData);
+  DuplicateHandle(GetCurrentProcess(), GetCurrentProcess(),
+                  GetCurrentProcess(), &h, 0, TRUE,
+                  DUPLICATE_SAME_ACCESS);
+  val_process_id = Val_int(h);
+
+  worker_init();
+
+  return Val_unit;
+}
+
+CAMLprim value win_cleanup(unit)
+     value unit;
+{
+  worker_cleanup();
+
+  (void) WSACleanup();
+
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/stat.c b/otherlibs/win32unix/stat.c
new file mode 100644
index 00000000..cafa8e3d
--- /dev/null
+++ b/otherlibs/win32unix/stat.c
@@ -0,0 +1,448 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                David Allsopp, MetaStack Solutions Ltd.                 */
+/*                                                                        */
+/*   Copyright 2015 MetaStack Solutions Ltd.                              */
+/*                                                                        */
+/*   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
+
+#include <errno.h>
+#ifdef _MSC_VER
+#include <float.h>
+#ifndef nextafter
+#define nextafter _nextafter
+#endif
+#else
+#include <math.h>
+#endif
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/signals.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+#include "cst2constr.h"
+#define _INTEGRAL_MAX_BITS 64
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <time.h>
+#include <winioctl.h>
+
+#ifndef S_IFLNK
+/*
+ * The Microsoft CRT doesn't support lstat and so has no S_IFLNK
+ * The implementation uses comparison, so rather than allocating another bit, in
+ * a potentially future-incompatible way, just create a value with multiple bits
+ * set.
+ */
+#define S_IFLNK (S_IFDIR | S_IFREG)
+#endif
+#ifndef S_IFIFO
+#ifdef _S_IFIFO
+#define S_IFIFO _S_IFIFO
+#else
+#define S_IFIFO (S_IFREG | S_IFCHR)
+#endif
+#endif
+#ifndef S_IFSOCK
+#define S_IFSOCK (S_IFDIR | S_IFCHR)
+#endif
+#ifndef S_IFBLK
+#define S_IFBLK 0
+#endif
+
+static int file_kind_table[] = {
+  S_IFREG, S_IFDIR, S_IFCHR, S_IFBLK, S_IFLNK, S_IFIFO, S_IFSOCK
+};
+
+/* Transform a timestamp expressed in units of 100ns
+   to a number of seconds in floating-point.
+   Make sure the integer part of the result is always equal to
+   the timestamp divided by 10^7 (issue #9490).
+   Use the same algorithm as for the Unix implementation
+   (in ../unix/stat.c) in the hope of getting the same result
+   when the same file is accessed either from Windows or from Linux.
+ */
+
+static double stat_timestamp(__time64_t tm)
+{
+  /* Split the timestamp into seconds and remaining 100ns units */
+  __int64 sec = tm / 10000000;  /* 10^7 */
+  int n100sec = tm % 10000000;
+  /* The conversion of sec to FP is exact for the foreseeable future.
+     (It starts rounding when sec > 2^53, i.e. in 285 million years.) */
+  double s = (double) sec;
+  /* The conversion of n100sec to fraction of seconds can round.
+     Still, we have 0 <= n100sec < 1.0. */
+  double n = (double) n100sec / 1e7;
+  /* The sum s + n can round up, hence s <= t + <= s + 1.0 */
+  double t = s + n;
+  /* Detect the "round up to s + 1" case and decrease t so that
+     its integer part is s. */
+  if (t == s + 1.0) t = nextafter(t, s);
+  return t;
+}
+
+static value stat_aux(int use_64, __int64 st_ino, struct _stat64 *buf)
+{
+  CAMLparam0 ();
+  CAMLlocal1 (v);
+
+  v = caml_alloc (12, 0);
+  Store_field (v, 0, Val_int (buf->st_dev));
+  Store_field (v, 1, Val_int (st_ino ? st_ino & Max_long : buf->st_ino));
+  Store_field (v, 2, cst_to_constr (buf->st_mode & S_IFMT, file_kind_table,
+                                    sizeof(file_kind_table) / sizeof(int), 0));
+  Store_field (v, 3, Val_int(buf->st_mode & 07777));
+  Store_field (v, 4, Val_int (buf->st_nlink));
+  Store_field (v, 5, Val_int (buf->st_uid));
+  Store_field (v, 6, Val_int (buf->st_gid));
+  Store_field (v, 7, Val_int (buf->st_rdev));
+  Store_field (v, 8,
+               use_64 ? caml_copy_int64(buf->st_size) : Val_int (buf->st_size));
+  Store_field (v, 9, caml_copy_double(stat_timestamp(buf->st_atime)));
+  Store_field (v, 10, caml_copy_double(stat_timestamp(buf->st_mtime)));
+  Store_field (v, 11, caml_copy_double(stat_timestamp(buf->st_ctime)));
+  CAMLreturn (v);
+}
+
+/*
+ * The long and ugly story of Microsoft CRT stat and symbolic links
+ *
+ * msvcrt.dll - which is now a core Windows component - is basically Visual
+ * Studio .NET 2003 CRT (Version 7). It is the version usually linked against by
+ * mingw64-gcc Its behaviour is as follows:
+ *   a) st_mode is correctly populated
+ *   b) st_atime, st_mtime and st_ctime are those for the symbolic link, not the
+ *      target
+ *   c) stat incorrectly returns information even if the target doesn't exist
+ *
+ * The next CRT of interest is Visual Studio 2008 (Version 9 - msvcr900.dll), as
+ * that's included with the Windows 7 SDK. This worked until 2011 when Microsoft
+ * produced security advisory KB2467174 (see https://bugs.python.org/issue6727)
+ * at which point stat returns ENOENT for symbolic links.
+ *
+ * This persists until Visual Studio 2010, when a hotfix
+ * (https://support.microsoft.com/en-gb/kb/2890375) was produced which was
+ * supposed to fix this behaviour. This CRT has one problem: it returns S_REG
+ * instead of S_DIR for directory symbolic links because of a subtle error in
+ * its implementation (it calls fstat which quite reasonably always assumes its
+ * looking at a regular file).
+ *
+ * The bug persists in Visual Studio 2012. Visual Studio 2015 features the
+ * "great refactored" CRT (written in C++!). This CRT correctly returns st_mode
+ * for directory symbolic links. Its two limitations are that it doesn't return
+ * the st_size correctly for symbolic links and it doesn't populate st_nlink
+ * correctly.
+ *
+ * However, even if fixed, mingw64 is limited to msvcrt.dll (by default, anyway)
+ * and that's a lot of buggy CRTs out there.
+ *
+ * There is also no implementation given for lstat in any CRT.
+ *
+ * do_stat therefore reimplements stat - but the algorithms for populating the
+ * resulting _stat64 are identical to Microsoft's (with the exception of correct
+ * handling of st_nlink for symbolic links), being based upon the code for the
+ * Microsoft CRT given in Microsoft Visual Studio 2013 Express
+ */
+
+static int convert_time(FILETIME* time, __time64_t* result, __time64_t def)
+{
+  /* Tempting though it may be, MSDN prohibits casting FILETIME directly
+   * to __int64 for alignment concerns. While this doesn't affect our supported
+   * platforms, it's easier to go with the flow...
+   */
+  ULARGE_INTEGER utime = {{time->dwLowDateTime, time->dwHighDateTime}};
+
+  if (utime.QuadPart) {
+    /* There are 11644473600 seconds between 1 January 1601 (the NT Epoch) and 1
+     * January 1970 (the Unix Epoch). FILETIME is measured in 100ns ticks.
+     */
+    *result = (utime.QuadPart - INT64_LITERAL(116444736000000000U));
+  }
+  else {
+    *result = def;
+  }
+
+  return 1;
+}
+
+/* path allocated outside the OCaml heap */
+static int safe_do_stat(int do_lstat, int use_64, wchar_t* path, HANDLE fstat, __int64* st_ino, struct _stat64* res)
+{
+  BY_HANDLE_FILE_INFORMATION info;
+  int i;
+  wchar_t* ptr;
+  char c;
+  HANDLE h;
+  unsigned short mode;
+  int is_symlink = 0;
+
+  if (!path) {
+    h = fstat;
+  }
+  else {
+    caml_enter_blocking_section();
+    h = CreateFile(path,
+                   FILE_READ_ATTRIBUTES,
+                   FILE_SHARE_DELETE | FILE_SHARE_READ | FILE_SHARE_WRITE,
+                   NULL,
+                   OPEN_EXISTING,
+                   FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT,
+                   NULL);
+    caml_leave_blocking_section();
+  }
+  if (h == INVALID_HANDLE_VALUE) {
+    errno = ENOENT;
+    return 0;
+  }
+  else {
+    caml_enter_blocking_section();
+    if (!GetFileInformationByHandle(h, &info)) {
+      win32_maperr(GetLastError());
+      caml_leave_blocking_section();
+      if (path) CloseHandle(h);
+      return 0;
+    }
+    caml_leave_blocking_section();
+
+    /*
+     * It shouldn't be possible to call this via fstat and have a reparse point
+     * open, but the test on path guarantees this.
+     */
+    if (info.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT && path) {
+      /*
+       * Only symbolic links should be processed specially. The call to
+       * DeviceIoControl solves two problems at the same time:
+       *   a) Although FindFirstFileEx gives the reparse tag in dwReserved0,
+       *      GetFileInformationByHandle does not and using the Ex version (or
+       *      GetFileAttributesEx) makes Windows XP support harder
+       *   b) Windows returns 0 for the size of a symbolic link - reading the
+       *      reparse point allows a POSIX-compatible value to be returned in
+       *      st_size
+       */
+      char buffer[16384];
+      DWORD read;
+      REPARSE_DATA_BUFFER* point;
+
+      caml_enter_blocking_section();
+      if (DeviceIoControl(h, FSCTL_GET_REPARSE_POINT, NULL, 0, buffer, 16384, &read, NULL)) {
+        if (((REPARSE_DATA_BUFFER*)buffer)->ReparseTag == IO_REPARSE_TAG_SYMLINK) {
+          is_symlink = do_lstat;
+          res->st_size = ((REPARSE_DATA_BUFFER*)buffer)->SymbolicLinkReparseBuffer.SubstituteNameLength / 2;
+        }
+      }
+      caml_leave_blocking_section();
+
+      if (!is_symlink) {
+        CloseHandle(h);
+        caml_enter_blocking_section();
+        if ((h = CreateFile(path,
+                            FILE_READ_ATTRIBUTES,
+                            FILE_SHARE_DELETE | FILE_SHARE_READ | FILE_SHARE_WRITE,
+                            NULL,
+                            OPEN_EXISTING,
+                            FILE_FLAG_BACKUP_SEMANTICS,
+                            NULL)) == INVALID_HANDLE_VALUE) {
+          errno = ENOENT;
+          caml_leave_blocking_section();
+          return 0;
+        }
+        else {
+          if (!GetFileInformationByHandle(h, &info)) {
+            win32_maperr(GetLastError());
+            caml_leave_blocking_section();
+            CloseHandle(h);
+            return 0;
+          }
+          caml_leave_blocking_section();
+        }
+      }
+    }
+
+    if (path) CloseHandle(h);
+
+    if (!is_symlink) {
+      /*
+       * The size returned seems to vary depending on whether it's a directory
+       * (in which case it's 0) or a symbolic link (in which case it looks like
+       * allocated sector size).
+       * Neither is interesting, so return 0.
+       */
+      if (info.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) {
+        res->st_size = 0;
+      }
+      else {
+        res->st_size = ((__int64)(info.nFileSizeHigh)) << 32 |
+                       ((__int64)info.nFileSizeLow);
+      }
+    }
+
+    if (!use_64 && res->st_size > Max_long) {
+      win32_maperr(ERROR_ARITHMETIC_OVERFLOW);
+      return 0;
+    }
+
+    if (!convert_time(&info.ftLastWriteTime, &res->st_mtime, 0) ||
+        !convert_time(&info.ftLastAccessTime, &res->st_atime, res->st_mtime) ||
+        !convert_time(&info.ftCreationTime, &res->st_ctime, res->st_mtime)) {
+      win32_maperr(GetLastError());
+      return 0;
+    }
+
+    /*
+     * Note MS CRT (still) puts st_nlink = 1 and gives st_ino = 0
+     */
+    res->st_nlink = info.nNumberOfLinks;
+    res->st_dev = info.dwVolumeSerialNumber;
+    *st_ino = ((__int64)(info.nFileIndexHigh)) << 32 | ((__int64)info.nFileIndexLow);
+  }
+
+  if (do_lstat && is_symlink) {
+    mode = S_IFLNK | S_IEXEC | S_IWRITE;
+  }
+  else {
+    mode = (info.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY ? _S_IFDIR | _S_IEXEC : _S_IFREG);
+  }
+  mode |= (info.dwFileAttributes & FILE_ATTRIBUTE_READONLY ? _S_IREAD : _S_IREAD | _S_IWRITE);
+  /*
+   * The simulation of the execute bit is ignored for fstat. It could be
+   * emulated using GetFinalPathNameByHandle, but the pre-Vista emulation is a
+   * bit too much effort for a simulated value, so it's simply ignored!
+   */
+  if (path && (ptr = wcsrchr(path, '.')) && (!_wcsicmp(ptr, L".exe") ||
+                                             !_wcsicmp(ptr, L".cmd") ||
+                                             !_wcsicmp(ptr, L".bat") ||
+                                             !_wcsicmp(ptr, L".com"))) {
+    mode |= _S_IEXEC;
+  }
+  mode |= (mode & 0700) >> 3;
+  mode |= (mode & 0700) >> 6;
+  res->st_mode = mode;
+  res->st_uid = res->st_gid = res->st_ino = 0;
+  res->st_rdev = res->st_dev;
+
+  return 1;
+}
+
+static int do_stat(int do_lstat, int use_64, const char* opath, HANDLE fstat, __int64* st_ino, struct _stat64* res)
+{
+  wchar_t* wpath;
+  int ret;
+  wpath = caml_stat_strdup_to_utf16(opath);
+  ret = safe_do_stat(do_lstat, use_64, wpath, fstat, st_ino, res);
+  caml_stat_free(wpath);
+  return ret;
+}
+
+CAMLprim value unix_stat(value path)
+{
+  struct _stat64 buf;
+  __int64 st_ino;
+
+  caml_unix_check_path(path, "stat");
+  if (!do_stat(0, 0, String_val(path), NULL, &st_ino, &buf)) {
+    uerror("stat", path);
+  }
+  return stat_aux(0, st_ino, &buf);
+}
+
+CAMLprim value unix_stat_64(value path)
+{
+  struct _stat64 buf;
+  __int64 st_ino;
+
+  caml_unix_check_path(path, "stat");
+  if (!do_stat(0, 1, String_val(path), NULL, &st_ino, &buf)) {
+    uerror("stat", path);
+  }
+  return stat_aux(1, st_ino, &buf);
+}
+
+CAMLprim value unix_lstat(value path)
+{
+  struct _stat64 buf;
+  __int64 st_ino;
+
+  caml_unix_check_path(path, "lstat");
+  if (!do_stat(1, 0, String_val(path), NULL, &st_ino, &buf)) {
+    uerror("lstat", path);
+  }
+  return stat_aux(0, st_ino, &buf);
+}
+
+CAMLprim value unix_lstat_64(value path)
+{
+  struct _stat64 buf;
+  __int64 st_ino;
+
+  caml_unix_check_path(path, "lstat");
+  if (!do_stat(1, 1, String_val(path), NULL, &st_ino, &buf)) {
+    uerror("lstat", path);
+  }
+  return stat_aux(1, st_ino, &buf);
+}
+
+static value do_fstat(value handle, int use_64)
+{
+  int ret;
+  struct _stat64 buf;
+  __int64 st_ino;
+  HANDLE h;
+  DWORD ft;
+
+  st_ino = 0;
+  memset(&buf, 0, sizeof buf);
+  buf.st_nlink = 1;
+
+  h = Handle_val(handle);
+  ft = GetFileType(h) & ~FILE_TYPE_REMOTE;
+  switch(ft) {
+  case FILE_TYPE_DISK:
+    if (!safe_do_stat(0, use_64, NULL, Handle_val(handle), &st_ino, &buf)) {
+      uerror("fstat", Nothing);
+    }
+    break;
+  case FILE_TYPE_CHAR:
+    buf.st_mode = S_IFCHR;
+    break;
+  case FILE_TYPE_PIPE:
+    {
+      DWORD n_avail;
+      if (Descr_kind_val(handle) == KIND_SOCKET) {
+        buf.st_mode = S_IFSOCK;
+      }
+      else {
+        buf.st_mode = S_IFIFO;
+      }
+      if (PeekNamedPipe(h, NULL, 0, NULL, &n_avail, NULL)) {
+        buf.st_size = n_avail;
+      }
+    }
+    break;
+  case FILE_TYPE_UNKNOWN:
+    unix_error(EBADF, "fstat", Nothing);
+  default:
+    win32_maperr(GetLastError());
+    uerror("fstat", Nothing);
+  }
+  return stat_aux(use_64, st_ino, &buf);
+}
+
+CAMLprim value unix_fstat(value handle)
+{
+  return do_fstat(handle, 0);
+}
+
+CAMLprim value unix_fstat_64(value handle)
+{
+  return do_fstat(handle, 1);
+}
diff --git a/otherlibs/win32unix/symlink.c b/otherlibs/win32unix/symlink.c
new file mode 100644
index 00000000..1336ba6c
--- /dev/null
+++ b/otherlibs/win32unix/symlink.c
@@ -0,0 +1,118 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                David Allsopp, MetaStack Solutions Ltd.                 */
+/*                                                                        */
+/*   Copyright 2015 MetaStack Solutions Ltd.                              */
+/*                                                                        */
+/*   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
+
+/*
+ * Windows Vista functions enabled
+ */
+#undef _WIN32_WINNT
+#define _WIN32_WINNT 0x0600
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/signals.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+typedef BOOLEAN (WINAPI *LPFN_CREATESYMBOLICLINK) (LPWSTR, LPWSTR, DWORD);
+
+static LPFN_CREATESYMBOLICLINK pCreateSymbolicLink = NULL;
+static int no_symlink = 0;
+
+CAMLprim value unix_symlink(value to_dir, value osource, value odest)
+{
+  CAMLparam3(to_dir, osource, odest);
+  DWORD flags = (Bool_val(to_dir) ? SYMBOLIC_LINK_FLAG_DIRECTORY : 0);
+  BOOLEAN result;
+  LPWSTR source;
+  LPWSTR dest;
+  caml_unix_check_path(osource, "symlink");
+  caml_unix_check_path(odest, "symlink");
+
+again:
+  if (no_symlink) {
+    caml_invalid_argument("symlink not available");
+  }
+
+  if (!pCreateSymbolicLink) {
+    pCreateSymbolicLink = (LPFN_CREATESYMBOLICLINK)GetProcAddress(GetModuleHandle(L"kernel32"), "CreateSymbolicLinkW");
+    no_symlink = !pCreateSymbolicLink;
+    goto again;
+  }
+
+  /* Copy source and dest outside the OCaml heap */
+  source = caml_stat_strdup_to_utf16(String_val(osource));
+  dest = caml_stat_strdup_to_utf16(String_val(odest));
+
+  caml_enter_blocking_section();
+  result = pCreateSymbolicLink(dest, source, flags);
+  caml_leave_blocking_section();
+
+  caml_stat_free(source);
+  caml_stat_free(dest);
+
+  if (!result) {
+    win32_maperr(GetLastError());
+    uerror("symlink", odest);
+  }
+
+  CAMLreturn(Val_unit);
+}
+
+#define luid_eq(l, r) (l.LowPart == r.LowPart && l.HighPart == r.HighPart)
+
+CAMLprim value unix_has_symlink(value unit)
+{
+  CAMLparam1(unit);
+  HANDLE hProcess = GetCurrentProcess();
+  BOOL result = FALSE;
+
+  if (OpenProcessToken(hProcess, TOKEN_READ, &hProcess)) {
+    LUID seCreateSymbolicLinkPrivilege;
+
+    if (LookupPrivilegeValue(NULL,
+                             SE_CREATE_SYMBOLIC_LINK_NAME,
+                             &seCreateSymbolicLinkPrivilege)) {
+      DWORD length;
+
+      if (!GetTokenInformation(hProcess, TokenPrivileges, NULL, 0, &length)) {
+        if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) {
+          TOKEN_PRIVILEGES* privileges = (TOKEN_PRIVILEGES*)caml_stat_alloc(length);
+          if (GetTokenInformation(hProcess,
+                                  TokenPrivileges,
+                                  privileges,
+                                  length,
+                                  &length)) {
+            DWORD count = privileges->PrivilegeCount;
+
+            if (count) {
+              LUID_AND_ATTRIBUTES* privs = privileges->Privileges;
+              while (count-- && !(result = luid_eq(privs->Luid, seCreateSymbolicLinkPrivilege)))
+                privs++;
+            }
+          }
+
+          caml_stat_free(privileges);
+        }
+      }
+    }
+
+    CloseHandle(hProcess);
+  }
+
+  CAMLreturn(Val_bool(result));
+}
diff --git a/otherlibs/win32unix/system.c b/otherlibs/win32unix/system.c
new file mode 100644
index 00000000..39a47582
--- /dev/null
+++ b/otherlibs/win32unix/system.c
@@ -0,0 +1,45 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/signals.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+#include <process.h>
+#include <stdio.h>
+
+CAMLprim value win_system(cmd)
+     value cmd;
+{
+  int ret;
+  value st;
+  wchar_t *buf;
+
+  caml_unix_check_path(cmd, "system");
+  buf = caml_stat_strdup_to_utf16 (String_val (cmd));
+  caml_enter_blocking_section();
+  _flushall();
+  ret = _wsystem(buf);
+  caml_leave_blocking_section();
+  caml_stat_free(buf);
+  if (ret == -1) uerror("system", Nothing);
+  st = caml_alloc_small(1, 0); /* Tag 0: Exited */
+  Field(st, 0) = Val_int(ret);
+  return st;
+}
diff --git a/otherlibs/win32unix/times.c b/otherlibs/win32unix/times.c
new file mode 100644
index 00000000..18cd9aa9
--- /dev/null
+++ b/otherlibs/win32unix/times.c
@@ -0,0 +1,58 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                  File contributed by Josh Berdine                      */
+/*                                                                        */
+/*   Copyright 2011 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include "unixsupport.h"
+#include <windows.h>
+
+
+double to_sec(FILETIME ft) {
+#if defined(_MSC_VER) && _MSC_VER < 1300
+  /* See gettimeofday.c - it is not possible for these values to be 64-bit, so
+     there's no worry about using a signed struct in order to work around the
+     lack of support for casting int64_t to double.
+   */
+  LARGE_INTEGER tmp;
+#else
+  ULARGE_INTEGER tmp;
+#endif
+
+  tmp.u.LowPart = ft.dwLowDateTime;
+  tmp.u.HighPart = ft.dwHighDateTime;
+
+  /* convert to seconds:
+     GetProcessTimes returns number of 100-nanosecond intervals */
+  return tmp.QuadPart / 1e7;
+}
+
+
+value unix_times(value unit) {
+  value res;
+  FILETIME creation, exit, stime, utime;
+
+  if (!(GetProcessTimes(GetCurrentProcess(), &creation, &exit, &stime,
+                        &utime))) {
+    win32_maperr(GetLastError());
+    uerror("times", Nothing);
+  }
+
+  res = caml_alloc_small(4 * Double_wosize, Double_array_tag);
+  Store_double_field(res, 0, to_sec(utime));
+  Store_double_field(res, 1, to_sec(stime));
+  Store_double_field(res, 2, 0);
+  Store_double_field(res, 3, 0);
+  return res;
+}
diff --git a/otherlibs/win32unix/truncate.c b/otherlibs/win32unix/truncate.c
new file mode 100644
index 00000000..b9ce92c0
--- /dev/null
+++ b/otherlibs/win32unix/truncate.c
@@ -0,0 +1,125 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                            Florent Monnier                             */
+/*                       Nicolas Ojeda Bar, LexiFi                        */
+/*                                                                        */
+/*   Copyright 2019 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
+
+#include <sys/types.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/signals.h>
+#include <caml/io.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+#include <windows.h>
+
+static int win_truncate_handle(HANDLE fh, __int64 len)
+{
+  LARGE_INTEGER fp;
+  fp.QuadPart = len;
+  if (SetFilePointerEx(fh, fp, NULL, FILE_BEGIN) == 0 ||
+      SetEndOfFile(fh) == 0) {
+    return -1;
+  }
+  return 0;
+}
+
+static int win_ftruncate(HANDLE fh, __int64 len)
+{
+  HANDLE dupfh, currproc;
+  int ret;
+  currproc = GetCurrentProcess();
+  /* Duplicate the handle, so we are free to modify its file position. */
+  if (DuplicateHandle(currproc, fh, currproc, &dupfh, 0, FALSE,
+                      DUPLICATE_SAME_ACCESS) == 0) {
+     return -1;
+  }
+  ret = win_truncate_handle(dupfh, len);
+  CloseHandle(dupfh);
+  return ret;
+}
+
+static int win_truncate(WCHAR * path, __int64 len)
+{
+  HANDLE fh;
+  int ret;
+  fh = CreateFile(path, GENERIC_WRITE, 0, NULL,
+                  OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
+  if (fh == INVALID_HANDLE_VALUE) {
+    return -1;
+  }
+  ret = win_truncate_handle(fh, len);
+  CloseHandle(fh);
+  return ret;
+}
+
+CAMLprim value unix_truncate(value path, value len)
+{
+  CAMLparam2(path, len);
+  WCHAR * p;
+  int ret;
+  caml_unix_check_path(path, "truncate");
+  p = caml_stat_strdup_to_utf16(String_val(path));
+  caml_enter_blocking_section();
+  ret = win_truncate(p, Long_val(len));
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1)
+    uerror("truncate", path);
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value unix_truncate_64(value path, value vlen)
+{
+  CAMLparam2(path, vlen);
+  WCHAR * p;
+  int ret;
+  __int64 len = Int64_val(vlen);
+  caml_unix_check_path(path, "truncate");
+  p = caml_stat_strdup_to_utf16(String_val(path));
+  caml_enter_blocking_section();
+  ret = win_truncate(p, len);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1)
+    uerror("truncate", path);
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value unix_ftruncate(value fd, value len)
+{
+  int ret;
+  HANDLE h = Handle_val(fd);
+  caml_enter_blocking_section();
+  ret = win_ftruncate(h, Long_val(len));
+  caml_leave_blocking_section();
+  if (ret == -1)
+    uerror("ftruncate", Nothing);
+  return Val_unit;
+}
+
+CAMLprim value unix_ftruncate_64(value fd, value vlen)
+{
+  int ret;
+  HANDLE h = Handle_val(fd);
+  __int64 len = Int64_val(vlen);
+  caml_enter_blocking_section();
+  ret = win_ftruncate(h, len);
+  caml_leave_blocking_section();
+  if (ret == -1)
+    uerror("ftruncate", Nothing);
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/unix.ml b/otherlibs/win32unix/unix.ml
new file mode 100644
index 00000000..8d986544
--- /dev/null
+++ b/otherlibs/win32unix/unix.ml
@@ -0,0 +1,1212 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Xavier Leroy and Pascal Cuoq, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Initialization *)
+
+external startup: unit -> unit = "win_startup"
+external cleanup: unit -> unit = "win_cleanup"
+
+let _ = startup(); at_exit cleanup
+
+(* Errors *)
+
+type error =
+  (* Errors defined in the POSIX standard *)
+    E2BIG               (* Argument list too long *)
+  | EACCES              (* Permission denied *)
+  | EAGAIN              (* Resource temporarily unavailable; try again *)
+  | EBADF               (* Bad file descriptor *)
+  | EBUSY               (* Resource unavailable *)
+  | ECHILD              (* No child process *)
+  | EDEADLK             (* Resource deadlock would occur *)
+  | EDOM                (* Domain error for math functions, etc. *)
+  | EEXIST              (* File exists *)
+  | EFAULT              (* Bad address *)
+  | EFBIG               (* File too large *)
+  | EINTR               (* Function interrupted by signal *)
+  | EINVAL              (* Invalid argument *)
+  | EIO                 (* Hardware I/O error *)
+  | EISDIR              (* Is a directory *)
+  | EMFILE              (* Too many open files by the process *)
+  | EMLINK              (* Too many links *)
+  | ENAMETOOLONG        (* Filename too long *)
+  | ENFILE              (* Too many open files in the system *)
+  | ENODEV              (* No such device *)
+  | ENOENT              (* No such file or directory *)
+  | ENOEXEC             (* Not an executable file *)
+  | ENOLCK              (* No locks available *)
+  | ENOMEM              (* Not enough memory *)
+  | ENOSPC              (* No space left on device *)
+  | ENOSYS              (* Function not supported *)
+  | ENOTDIR             (* Not a directory *)
+  | ENOTEMPTY           (* Directory not empty *)
+  | ENOTTY              (* Inappropriate I/O control operation *)
+  | ENXIO               (* No such device or address *)
+  | EPERM               (* Operation not permitted *)
+  | EPIPE               (* Broken pipe *)
+  | ERANGE              (* Result too large *)
+  | EROFS               (* Read-only file system *)
+  | ESPIPE              (* Invalid seek e.g. on a pipe *)
+  | ESRCH               (* No such process *)
+  | EXDEV               (* Invalid link *)
+  (* Additional errors, mostly BSD *)
+  | EWOULDBLOCK         (* Operation would block *)
+  | EINPROGRESS         (* Operation now in progress *)
+  | EALREADY            (* Operation already in progress *)
+  | ENOTSOCK            (* Socket operation on non-socket *)
+  | EDESTADDRREQ        (* Destination address required *)
+  | EMSGSIZE            (* Message too long *)
+  | EPROTOTYPE          (* Protocol wrong type for socket *)
+  | ENOPROTOOPT         (* Protocol not available *)
+  | EPROTONOSUPPORT     (* Protocol not supported *)
+  | ESOCKTNOSUPPORT     (* Socket type not supported *)
+  | EOPNOTSUPP          (* Operation not supported on socket *)
+  | EPFNOSUPPORT        (* Protocol family not supported *)
+  | EAFNOSUPPORT        (* Address family not supported by protocol family *)
+  | EADDRINUSE          (* Address already in use *)
+  | EADDRNOTAVAIL       (* Can't assign requested address *)
+  | ENETDOWN            (* Network is down *)
+  | ENETUNREACH         (* Network is unreachable *)
+  | ENETRESET           (* Network dropped connection on reset *)
+  | ECONNABORTED        (* Software caused connection abort *)
+  | ECONNRESET          (* Connection reset by peer *)
+  | ENOBUFS             (* No buffer space available *)
+  | EISCONN             (* Socket is already connected *)
+  | ENOTCONN            (* Socket is not connected *)
+  | ESHUTDOWN           (* Can't send after socket shutdown *)
+  | ETOOMANYREFS        (* Too many references: can't splice *)
+  | ETIMEDOUT           (* Connection timed out *)
+  | ECONNREFUSED        (* Connection refused *)
+  | EHOSTDOWN           (* Host is down *)
+  | EHOSTUNREACH        (* No route to host *)
+  | ELOOP               (* Too many levels of symbolic links *)
+  | EOVERFLOW
+  (* All other errors are mapped to EUNKNOWNERR *)
+  | EUNKNOWNERR of int  (* Unknown error *)
+
+exception Unix_error of error * string * string
+
+let _ = Callback.register_exception "Unix.Unix_error"
+                                    (Unix_error(E2BIG, "", ""))
+
+external error_message : error -> string = "unix_error_message"
+
+let () =
+  Printexc.register_printer
+    (function
+      | Unix_error (e, s, s') ->
+          let msg = match e with
+          | E2BIG -> "E2BIG"
+          | EACCES -> "EACCES"
+          | EAGAIN -> "EAGAIN"
+          | EBADF -> "EBADF"
+          | EBUSY -> "EBUSY"
+          | ECHILD -> "ECHILD"
+          | EDEADLK -> "EDEADLK"
+          | EDOM -> "EDOM"
+          | EEXIST -> "EEXIST"
+          | EFAULT -> "EFAULT"
+          | EFBIG -> "EFBIG"
+          | EINTR -> "EINTR"
+          | EINVAL -> "EINVAL"
+          | EIO -> "EIO"
+          | EISDIR -> "EISDIR"
+          | EMFILE -> "EMFILE"
+          | EMLINK -> "EMLINK"
+          | ENAMETOOLONG -> "ENAMETOOLONG"
+          | ENFILE -> "ENFILE"
+          | ENODEV -> "ENODEV"
+          | ENOENT -> "ENOENT"
+          | ENOEXEC -> "ENOEXEC"
+          | ENOLCK -> "ENOLCK"
+          | ENOMEM -> "ENOMEM"
+          | ENOSPC -> "ENOSPC"
+          | ENOSYS -> "ENOSYS"
+          | ENOTDIR -> "ENOTDIR"
+          | ENOTEMPTY -> "ENOTEMPTY"
+          | ENOTTY -> "ENOTTY"
+          | ENXIO -> "ENXIO"
+          | EPERM -> "EPERM"
+          | EPIPE -> "EPIPE"
+          | ERANGE -> "ERANGE"
+          | EROFS -> "EROFS"
+          | ESPIPE -> "ESPIPE"
+          | ESRCH -> "ESRCH"
+          | EXDEV -> "EXDEV"
+          | EWOULDBLOCK -> "EWOULDBLOCK"
+          | EINPROGRESS -> "EINPROGRESS"
+          | EALREADY -> "EALREADY"
+          | ENOTSOCK -> "ENOTSOCK"
+          | EDESTADDRREQ -> "EDESTADDRREQ"
+          | EMSGSIZE -> "EMSGSIZE"
+          | EPROTOTYPE -> "EPROTOTYPE"
+          | ENOPROTOOPT -> "ENOPROTOOPT"
+          | EPROTONOSUPPORT -> "EPROTONOSUPPORT"
+          | ESOCKTNOSUPPORT -> "ESOCKTNOSUPPORT"
+          | EOPNOTSUPP -> "EOPNOTSUPP"
+          | EPFNOSUPPORT -> "EPFNOSUPPORT"
+          | EAFNOSUPPORT -> "EAFNOSUPPORT"
+          | EADDRINUSE -> "EADDRINUSE"
+          | EADDRNOTAVAIL -> "EADDRNOTAVAIL"
+          | ENETDOWN -> "ENETDOWN"
+          | ENETUNREACH -> "ENETUNREACH"
+          | ENETRESET -> "ENETRESET"
+          | ECONNABORTED -> "ECONNABORTED"
+          | ECONNRESET -> "ECONNRESET"
+          | ENOBUFS -> "ENOBUFS"
+          | EISCONN -> "EISCONN"
+          | ENOTCONN -> "ENOTCONN"
+          | ESHUTDOWN -> "ESHUTDOWN"
+          | ETOOMANYREFS -> "ETOOMANYREFS"
+          | ETIMEDOUT -> "ETIMEDOUT"
+          | ECONNREFUSED -> "ECONNREFUSED"
+          | EHOSTDOWN -> "EHOSTDOWN"
+          | EHOSTUNREACH -> "EHOSTUNREACH"
+          | ELOOP -> "ELOOP"
+          | EOVERFLOW -> "EOVERFLOW"
+          | EUNKNOWNERR x -> Printf.sprintf "EUNKNOWNERR %d" x in
+          Some (Printf.sprintf "Unix.Unix_error(Unix.%s, %S, %S)" msg s s')
+      | _ -> None)
+
+let handle_unix_error f arg =
+  try
+    f arg
+  with Unix_error(err, fun_name, arg) ->
+    prerr_string Sys.argv.(0);
+    prerr_string ": \"";
+    prerr_string fun_name;
+    prerr_string "\" failed";
+    if String.length arg > 0 then begin
+      prerr_string " on \"";
+      prerr_string arg;
+      prerr_string "\""
+    end;
+    prerr_string ": ";
+    prerr_endline (error_message err);
+    exit 2
+
+external environment : unit -> string array = "unix_environment"
+(* On Win32 environment access is always considered safe. *)
+let unsafe_environment = environment
+external getenv: string -> string = "caml_sys_getenv"
+external unsafe_getenv: string -> string = "caml_sys_unsafe_getenv"
+external putenv: string -> string -> unit = "unix_putenv"
+
+type process_status =
+    WEXITED of int
+  | WSIGNALED of int
+  | WSTOPPED of int
+
+type wait_flag =
+    WNOHANG
+  | WUNTRACED
+
+type file_descr
+
+let maybe_quote f =
+  if String.contains f ' ' ||
+     String.contains f '\"' ||
+     String.contains f '\t' ||
+     f = ""
+  then Filename.quote f
+  else f
+
+external sys_execv : string -> string array -> 'a = "unix_execv"
+external sys_execve :
+             string -> string array -> string array -> 'a = "unix_execve"
+external sys_execvp : string -> string array -> 'a = "unix_execvp"
+external sys_execvpe :
+             string -> string array -> string array -> 'a = "unix_execvpe"
+
+let execv prog args =
+  sys_execv prog (Array.map maybe_quote args)
+let execve prog args env =
+  sys_execve prog (Array.map maybe_quote args) env
+let execvp prog args =
+  sys_execvp prog (Array.map maybe_quote args)
+let execvpe prog args env =
+  sys_execvpe prog (Array.map maybe_quote args) env
+
+external waitpid : wait_flag list -> int -> int * process_status
+                 = "win_waitpid"
+external getpid : unit -> int = "unix_getpid"
+
+let fork () = invalid_arg "Unix.fork not implemented"
+let wait () = invalid_arg "Unix.wait not implemented"
+let getppid () = invalid_arg "Unix.getppid not implemented"
+let nice _ = invalid_arg "Unix.nice not implemented"
+
+(* Basic file input/output *)
+
+external filedescr_of_fd : int -> file_descr = "win_handle_fd"
+
+let stdin = filedescr_of_fd 0
+let stdout = filedescr_of_fd 1
+let stderr = filedescr_of_fd 2
+
+type open_flag =
+    O_RDONLY
+  | O_WRONLY
+  | O_RDWR
+  | O_NONBLOCK
+  | O_APPEND
+  | O_CREAT
+  | O_TRUNC
+  | O_EXCL
+  | O_NOCTTY
+  | O_DSYNC
+  | O_SYNC
+  | O_RSYNC
+  | O_SHARE_DELETE
+  | O_CLOEXEC
+  | O_KEEPEXEC
+
+type file_perm = int
+
+external openfile : string -> open_flag list -> file_perm -> file_descr
+           = "unix_open"
+external close : file_descr -> unit = "unix_close"
+external fsync : file_descr -> unit = "unix_fsync"
+external unsafe_read : file_descr -> bytes -> int -> int -> int
+                     = "unix_read"
+external unsafe_write : file_descr -> bytes -> int -> int -> int
+                      = "unix_write"
+external unsafe_single_write : file_descr -> bytes -> int -> int -> int
+                      = "unix_single_write"
+
+let read fd buf ofs len =
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
+  then invalid_arg "Unix.read"
+  else unsafe_read fd buf ofs len
+let write fd buf ofs len =
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
+  then invalid_arg "Unix.write"
+  else unsafe_write fd buf ofs len
+let single_write fd buf ofs len =
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
+  then invalid_arg "Unix.single_write"
+  else unsafe_single_write fd buf ofs len
+
+let write_substring fd buf ofs len =
+  write fd (Bytes.unsafe_of_string buf) ofs len
+
+let single_write_substring fd buf ofs len =
+  single_write fd (Bytes.unsafe_of_string buf) ofs len
+
+(* Interfacing with the standard input/output library *)
+
+external in_channel_of_descr: file_descr -> in_channel
+   = "win_inchannel_of_filedescr"
+external out_channel_of_descr: file_descr -> out_channel
+   = "win_outchannel_of_filedescr"
+external descr_of_in_channel : in_channel -> file_descr
+   = "win_filedescr_of_channel"
+external descr_of_out_channel : out_channel -> file_descr
+   = "win_filedescr_of_channel"
+
+(* Seeking and truncating *)
+
+type seek_command =
+    SEEK_SET
+  | SEEK_CUR
+  | SEEK_END
+
+external lseek : file_descr -> int -> seek_command -> int = "unix_lseek"
+
+external truncate : string -> int -> unit = "unix_truncate"
+external ftruncate : file_descr -> int -> unit = "unix_ftruncate"
+
+(* File statistics *)
+
+type file_kind =
+    S_REG
+  | S_DIR
+  | S_CHR
+  | S_BLK
+  | S_LNK
+  | S_FIFO
+  | S_SOCK
+
+type stats =
+  { st_dev : int;
+    st_ino : int;
+    st_kind : file_kind;
+    st_perm : file_perm;
+    st_nlink : int;
+    st_uid : int;
+    st_gid : int;
+    st_rdev : int;
+    st_size : int;
+    st_atime : float;
+    st_mtime : float;
+    st_ctime : float }
+
+external stat : string -> stats = "unix_stat"
+external lstat : string -> stats = "unix_lstat"
+external fstat : file_descr -> stats = "unix_fstat"
+external isatty : file_descr -> bool = "unix_isatty"
+
+(* Operations on file names *)
+
+external unlink : string -> unit = "unix_unlink"
+external rename : string -> string -> unit = "unix_rename"
+external link : ?follow:bool -> string -> string -> unit = "unix_link"
+
+(* Operations on large files *)
+
+module LargeFile =
+  struct
+    external lseek : file_descr -> int64 -> seek_command -> int64
+       = "unix_lseek_64"
+    external truncate : string -> int64 -> unit = "unix_truncate_64"
+    external ftruncate : file_descr -> int64 -> unit = "unix_ftruncate_64"
+    type stats =
+      { st_dev : int;
+        st_ino : int;
+        st_kind : file_kind;
+        st_perm : file_perm;
+        st_nlink : int;
+        st_uid : int;
+        st_gid : int;
+        st_rdev : int;
+        st_size : int64;
+        st_atime : float;
+        st_mtime : float;
+        st_ctime : float;
+      }
+    external stat : string -> stats = "unix_stat_64"
+    external lstat : string -> stats = "unix_lstat_64"
+    external fstat : file_descr -> stats = "unix_fstat_64"
+  end
+
+(* Mapping files into memory *)
+
+external map_internal:
+   file_descr -> ('a, 'b) Stdlib.Bigarray.kind
+              -> 'c Stdlib.Bigarray.layout
+              -> bool -> int array -> int64
+              -> ('a, 'b, 'c) Stdlib.Bigarray.Genarray.t
+     = "caml_unix_map_file_bytecode" "caml_unix_map_file"
+
+let map_file fd ?(pos=0L) kind layout shared dims =
+  map_internal fd kind layout shared dims pos
+
+(* File permissions and ownership *)
+
+type access_permission =
+    R_OK
+  | W_OK
+  | X_OK
+  | F_OK
+
+external chmod : string -> file_perm -> unit = "unix_chmod"
+let fchmod _fd _perm = invalid_arg "Unix.fchmod not implemented"
+let chown _file _perm = invalid_arg "Unix.chown not implemented"
+let fchown _fd _perm = invalid_arg "Unix.fchown not implemented"
+let umask _msk = invalid_arg "Unix.umask not implemented"
+
+external access : string -> access_permission list -> unit = "unix_access"
+
+(* Operations on file descriptors *)
+
+external dup : ?cloexec: bool -> file_descr -> file_descr = "unix_dup"
+external dup2 :
+   ?cloexec: bool -> file_descr -> file_descr -> unit = "unix_dup2"
+
+external set_nonblock : file_descr -> unit = "unix_set_nonblock"
+external clear_nonblock : file_descr -> unit = "unix_clear_nonblock"
+
+external set_close_on_exec : file_descr -> unit = "win_set_close_on_exec"
+external clear_close_on_exec : file_descr -> unit = "win_clear_close_on_exec"
+
+(* Directories *)
+
+external mkdir : string -> file_perm -> unit = "unix_mkdir"
+external rmdir : string -> unit = "unix_rmdir"
+external chdir : string -> unit = "unix_chdir"
+external getcwd : unit -> string = "unix_getcwd"
+let chroot _ = invalid_arg "Unix.chroot not implemented"
+
+type dir_entry =
+    Dir_empty
+  | Dir_read of string
+  | Dir_toread
+
+type dir_handle =
+  { dirname: string; mutable handle: int; mutable entry_read: dir_entry }
+
+external findfirst : string -> string * int = "win_findfirst"
+external findnext : int -> string= "win_findnext"
+
+let opendir dirname =
+  try
+    let (first_entry, handle) = findfirst (Filename.concat dirname "*.*") in
+    { dirname = dirname; handle = handle; entry_read = Dir_read first_entry }
+  with End_of_file ->
+    { dirname = dirname; handle = 0; entry_read = Dir_empty }
+
+let readdir d =
+  match d.entry_read with
+    Dir_empty -> raise End_of_file
+  | Dir_read name -> d.entry_read <- Dir_toread; name
+  | Dir_toread -> findnext d.handle
+
+external win_findclose : int -> unit = "win_findclose"
+
+let closedir d =
+  match d.entry_read with
+    Dir_empty -> ()
+  | _ -> win_findclose d.handle
+
+let rewinddir d =
+  closedir d;
+  try
+    let (first_entry, handle) = findfirst (d.dirname ^ "\\*.*") in
+    d.handle <- handle; d.entry_read <- Dir_read first_entry
+  with End_of_file ->
+    d.handle <- 0; d.entry_read <- Dir_empty
+
+(* Pipes *)
+
+external pipe :
+  ?cloexec: bool -> unit -> file_descr * file_descr = "unix_pipe"
+
+let mkfifo _name _perm = invalid_arg "Unix.mkfifo not implemented"
+
+(* Symbolic links *)
+
+external readlink : string -> string = "unix_readlink"
+external symlink_stub : bool -> string -> string -> unit = "unix_symlink"
+
+(* See https://caml.inria.fr/mantis/view.php?id=7564.
+   The Windows API used to create symbolic links does not normalize the target
+   of a symbolic link, so we do it here.  Note that we cannot use the native
+   Windows call GetFullPathName to do this because we need relative paths to
+   stay relative. *)
+let normalize_slashes path =
+  if String.length path >= 4 && path.[0] = '\\' && path.[1] = '\\'
+                             && path.[2] = '?' && path.[3] = '\\' then
+    path
+  else
+    String.init (String.length path)
+                (fun i -> match path.[i] with '/' -> '\\' | c -> c)
+
+let symlink ?to_dir source dest =
+  let to_dir =
+    match to_dir with
+      Some to_dir ->
+        to_dir
+    | None ->
+        try
+          LargeFile.((stat source).st_kind = S_DIR)
+        with _ ->
+          false
+  in
+  let source = normalize_slashes source in
+  symlink_stub to_dir source dest
+
+external has_symlink : unit -> bool = "unix_has_symlink"
+
+(* Locking *)
+
+type lock_command =
+    F_ULOCK
+  | F_LOCK
+  | F_TLOCK
+  | F_TEST
+  | F_RLOCK
+  | F_TRLOCK
+
+external lockf : file_descr -> lock_command -> int -> unit = "unix_lockf"
+
+external terminate_process: int -> bool = "win_terminate_process"
+
+let kill pid signo =
+  if signo <> Sys.sigkill then
+    invalid_arg "Unix.kill"
+  else
+    if not (terminate_process pid) then
+      raise(Unix_error(ESRCH, "kill", ""))
+        (* could be more precise *)
+
+type sigprocmask_command = SIG_SETMASK | SIG_BLOCK | SIG_UNBLOCK
+let sigprocmask _cmd _sigs = invalid_arg "Unix.sigprocmask not implemented"
+let sigpending () = invalid_arg "Unix.sigpending not implemented"
+let sigsuspend _sigs = invalid_arg "Unix.sigsuspend not implemented"
+let pause () = invalid_arg "Unix.pause not implemented"
+
+(* Time functions *)
+
+type process_times =
+  { tms_utime : float;
+    tms_stime : float;
+    tms_cutime : float;
+    tms_cstime : float }
+
+type tm =
+  { tm_sec : int;
+    tm_min : int;
+    tm_hour : int;
+    tm_mday : int;
+    tm_mon : int;
+    tm_year : int;
+    tm_wday : int;
+    tm_yday : int;
+    tm_isdst : bool }
+
+external time : unit -> float = "unix_time"
+external gettimeofday : unit -> float = "unix_gettimeofday"
+external gmtime : float -> tm = "unix_gmtime"
+external localtime : float -> tm = "unix_localtime"
+external mktime : tm -> float * tm = "unix_mktime"
+let alarm _n = invalid_arg "Unix.alarm not implemented"
+external sleepf : float -> unit = "unix_sleep"
+let sleep n = sleepf (float n)
+external times: unit -> process_times = "unix_times"
+external utimes : string -> float -> float -> unit = "unix_utimes"
+
+type interval_timer =
+    ITIMER_REAL
+  | ITIMER_VIRTUAL
+  | ITIMER_PROF
+
+type interval_timer_status =
+  { it_interval: float;
+    it_value: float }
+
+let getitimer _it = invalid_arg "Unix.getitimer not implemented"
+let setitimer _it _tm = invalid_arg "Unix.setitimer not implemented"
+
+(* User id, group id *)
+
+let getuid () = 1
+let geteuid = getuid
+let setuid _id = invalid_arg "Unix.setuid not implemented"
+
+let getgid () = 1
+let getegid = getgid
+let setgid _id = invalid_arg "Unix.setgid not implemented"
+
+let getgroups () = [|1|]
+let setgroups _ = invalid_arg "Unix.setgroups not implemented"
+let initgroups _ _ = invalid_arg "Unix.initgroups not implemented"
+
+type passwd_entry =
+  { pw_name : string;
+    pw_passwd : string;
+    pw_uid : int;
+    pw_gid : int;
+    pw_gecos : string;
+    pw_dir : string;
+    pw_shell : string }
+
+type group_entry =
+  { gr_name : string;
+    gr_passwd : string;
+    gr_gid : int;
+    gr_mem : string array }
+
+let getlogin () = try Sys.getenv "USERNAME" with Not_found -> ""
+let getpwnam _x = raise Not_found
+let getgrnam = getpwnam
+let getpwuid = getpwnam
+let getgrgid = getpwnam
+
+(* Internet addresses *)
+
+type inet_addr = string
+
+let is_inet6_addr s = String.length s = 16
+
+external inet_addr_of_string : string -> inet_addr
+                                    = "unix_inet_addr_of_string"
+external string_of_inet_addr : inet_addr -> string
+                                    = "unix_string_of_inet_addr"
+
+let inet_addr_any = inet_addr_of_string "0.0.0.0"
+let inet_addr_loopback = inet_addr_of_string "127.0.0.1"
+let inet6_addr_any =
+  try inet_addr_of_string "::" with Failure _ -> inet_addr_any
+let inet6_addr_loopback =
+  try inet_addr_of_string "::1" with Failure _ -> inet_addr_loopback
+
+(* Sockets *)
+
+type socket_domain =
+    PF_UNIX
+  | PF_INET
+  | PF_INET6
+
+type socket_type =
+    SOCK_STREAM
+  | SOCK_DGRAM
+  | SOCK_RAW
+  | SOCK_SEQPACKET
+
+type sockaddr =
+    ADDR_UNIX of string
+  | ADDR_INET of inet_addr * int
+
+let domain_of_sockaddr = function
+    ADDR_UNIX _ -> PF_UNIX
+  | ADDR_INET(a, _) -> if is_inet6_addr a then PF_INET6 else PF_INET
+
+type shutdown_command =
+    SHUTDOWN_RECEIVE
+  | SHUTDOWN_SEND
+  | SHUTDOWN_ALL
+
+type msg_flag =
+    MSG_OOB
+  | MSG_DONTROUTE
+  | MSG_PEEK
+
+external socket :
+  ?cloexec: bool -> socket_domain -> socket_type -> int -> file_descr
+  = "unix_socket"
+let socketpair ?cloexec:_ _dom _ty _proto =
+  invalid_arg "Unix.socketpair not implemented"
+external accept :
+  ?cloexec: bool -> file_descr -> file_descr * sockaddr = "unix_accept"
+external bind : file_descr -> sockaddr -> unit = "unix_bind"
+external connect : file_descr -> sockaddr -> unit = "unix_connect"
+external listen : file_descr -> int -> unit = "unix_listen"
+external shutdown : file_descr -> shutdown_command -> unit = "unix_shutdown"
+external getsockname : file_descr -> sockaddr = "unix_getsockname"
+external getpeername : file_descr -> sockaddr = "unix_getpeername"
+
+external unsafe_recv :
+  file_descr -> bytes -> int -> int -> msg_flag list -> int
+                                  = "unix_recv"
+external unsafe_recvfrom :
+  file_descr -> bytes -> int -> int -> msg_flag list -> int * sockaddr
+                                  = "unix_recvfrom"
+external unsafe_send :
+  file_descr -> bytes -> int -> int -> msg_flag list -> int
+                                  = "unix_send"
+external unsafe_sendto :
+  file_descr -> bytes -> int -> int -> msg_flag list -> sockaddr -> int
+                                  = "unix_sendto" "unix_sendto_native"
+
+let recv fd buf ofs len flags =
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
+  then invalid_arg "Unix.recv"
+  else unsafe_recv fd buf ofs len flags
+let recvfrom fd buf ofs len flags =
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
+  then invalid_arg "Unix.recvfrom"
+  else unsafe_recvfrom fd buf ofs len flags
+let send fd buf ofs len flags =
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
+  then invalid_arg "Unix.send"
+  else unsafe_send fd buf ofs len flags
+let sendto fd buf ofs len flags addr =
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
+  then invalid_arg "Unix.sendto"
+  else unsafe_sendto fd buf ofs len flags addr
+
+let send_substring fd buf ofs len flags =
+  send fd (Bytes.unsafe_of_string buf) ofs len flags
+
+let sendto_substring fd buf ofs len flags addr =
+  sendto fd (Bytes.unsafe_of_string buf) ofs len flags addr
+
+type socket_bool_option =
+    SO_DEBUG
+  | SO_BROADCAST
+  | SO_REUSEADDR
+  | SO_KEEPALIVE
+  | SO_DONTROUTE
+  | SO_OOBINLINE
+  | SO_ACCEPTCONN
+  | TCP_NODELAY
+  | IPV6_ONLY
+
+type socket_int_option =
+    SO_SNDBUF
+  | SO_RCVBUF
+  | SO_ERROR
+  | SO_TYPE
+  | SO_RCVLOWAT
+  | SO_SNDLOWAT
+
+type socket_optint_option = SO_LINGER
+
+type socket_float_option =
+    SO_RCVTIMEO
+  | SO_SNDTIMEO
+
+type socket_error_option = SO_ERROR
+
+module SO: sig
+  type ('opt, 'v) t
+  val bool: (socket_bool_option, bool) t
+  val int: (socket_int_option, int) t
+  val optint: (socket_optint_option, int option) t
+  val float: (socket_float_option, float) t
+  val error: (socket_error_option, error option) t
+  val get: ('opt, 'v) t -> file_descr -> 'opt -> 'v
+  val set: ('opt, 'v) t -> file_descr -> 'opt -> 'v -> unit
+end = struct
+  type ('opt, 'v) t = int
+  let bool = 0
+  let int = 1
+  let optint = 2
+  let float = 3
+  let error = 4
+  external get: ('opt, 'v) t -> file_descr -> 'opt -> 'v
+              = "unix_getsockopt"
+  external set: ('opt, 'v) t -> file_descr -> 'opt -> 'v -> unit
+              = "unix_setsockopt"
+end
+
+let getsockopt fd opt = SO.get SO.bool fd opt
+let setsockopt fd opt v = SO.set SO.bool fd opt v
+
+let getsockopt_int fd opt = SO.get SO.int fd opt
+let setsockopt_int fd opt v = SO.set SO.int fd opt v
+
+let getsockopt_optint fd opt = SO.get SO.optint fd opt
+let setsockopt_optint fd opt v = SO.set SO.optint fd opt v
+
+let getsockopt_float fd opt = SO.get SO.float fd opt
+let setsockopt_float fd opt v = SO.set SO.float fd opt v
+
+let getsockopt_error fd = SO.get SO.error fd SO_ERROR
+
+(* Host and protocol databases *)
+
+type host_entry =
+  { h_name : string;
+    h_aliases : string array;
+    h_addrtype : socket_domain;
+    h_addr_list : inet_addr array }
+
+type protocol_entry =
+  { p_name : string;
+    p_aliases : string array;
+    p_proto : int }
+
+type service_entry =
+  { s_name : string;
+    s_aliases : string array;
+    s_port : int;
+    s_proto : string }
+
+external gethostname : unit -> string = "unix_gethostname"
+external gethostbyname : string -> host_entry = "unix_gethostbyname"
+external gethostbyaddr : inet_addr -> host_entry = "unix_gethostbyaddr"
+external getprotobyname : string -> protocol_entry
+                                         = "unix_getprotobyname"
+external getprotobynumber : int -> protocol_entry
+                                         = "unix_getprotobynumber"
+
+external getservbyname : string -> string -> service_entry
+                                         = "unix_getservbyname"
+external getservbyport : int -> string -> service_entry
+                                         = "unix_getservbyport"
+
+type addr_info =
+  { ai_family : socket_domain;
+    ai_socktype : socket_type;
+    ai_protocol : int;
+    ai_addr : sockaddr;
+    ai_canonname : string }
+
+type getaddrinfo_option =
+    AI_FAMILY of socket_domain
+  | AI_SOCKTYPE of socket_type
+  | AI_PROTOCOL of int
+  | AI_NUMERICHOST
+  | AI_CANONNAME
+  | AI_PASSIVE
+
+external getaddrinfo_system
+  : string -> string -> getaddrinfo_option list -> addr_info list
+  = "unix_getaddrinfo"
+
+let getaddrinfo_emulation node service opts =
+  (* Parse options *)
+  let opt_socktype = ref None
+  and opt_protocol = ref 0
+  and opt_passive = ref false in
+  List.iter
+    (function AI_SOCKTYPE s -> opt_socktype := Some s
+            | AI_PROTOCOL p -> opt_protocol := p
+            | AI_PASSIVE -> opt_passive := true
+            | _ -> ())
+    opts;
+  (* Determine socket types and port numbers *)
+  let get_port ty kind =
+    if service = "" then [ty, 0] else
+      try
+        [ty, int_of_string service]
+      with Failure _ ->
+      try
+        [ty, (getservbyname service kind).s_port]
+      with Not_found -> []
+  in
+  let ports =
+    match !opt_socktype with
+    | None ->
+        get_port SOCK_STREAM "tcp" @ get_port SOCK_DGRAM "udp"
+    | Some SOCK_STREAM ->
+        get_port SOCK_STREAM "tcp"
+    | Some SOCK_DGRAM ->
+        get_port SOCK_DGRAM "udp"
+    | Some ty ->
+        if service = "" then [ty, 0] else [] in
+  (* Determine IP addresses *)
+  let addresses =
+    if node = "" then
+      if List.mem AI_PASSIVE opts
+      then [inet_addr_any, "0.0.0.0"]
+      else [inet_addr_loopback, "127.0.0.1"]
+    else
+      try
+        [inet_addr_of_string node, node]
+      with Failure _ ->
+      try
+        let he = gethostbyname node in
+        List.map
+          (fun a -> (a, he.h_name))
+          (Array.to_list he.h_addr_list)
+      with Not_found ->
+        [] in
+  (* Cross-product of addresses and ports *)
+  List.flatten
+    (List.map
+      (fun (ty, port) ->
+        List.map
+          (fun (addr, name) ->
+            { ai_family = PF_INET;
+              ai_socktype = ty;
+              ai_protocol = !opt_protocol;
+              ai_addr = ADDR_INET(addr, port);
+              ai_canonname = name })
+          addresses)
+      ports)
+
+let getaddrinfo node service opts =
+  try
+    List.rev(getaddrinfo_system node service opts)
+  with Invalid_argument _ ->
+    getaddrinfo_emulation node service opts
+
+type name_info =
+  { ni_hostname : string;
+    ni_service : string }
+
+type getnameinfo_option =
+    NI_NOFQDN
+  | NI_NUMERICHOST
+  | NI_NAMEREQD
+  | NI_NUMERICSERV
+  | NI_DGRAM
+
+external getnameinfo_system
+  : sockaddr -> getnameinfo_option list -> name_info
+  = "unix_getnameinfo"
+
+let getnameinfo_emulation addr opts =
+  match addr with
+  | ADDR_UNIX f ->
+      { ni_hostname = ""; ni_service = f } (* why not? *)
+  | ADDR_INET(a, p) ->
+      let hostname =
+        try
+          if List.mem NI_NUMERICHOST opts then raise Not_found;
+          (gethostbyaddr a).h_name
+        with Not_found ->
+          if List.mem NI_NAMEREQD opts then raise Not_found;
+          string_of_inet_addr a in
+      let service =
+        try
+          if List.mem NI_NUMERICSERV opts then raise Not_found;
+          let kind = if List.mem NI_DGRAM opts then "udp" else "tcp" in
+          (getservbyport p kind).s_name
+        with Not_found ->
+          Int.to_string p in
+      { ni_hostname = hostname; ni_service = service }
+
+let getnameinfo addr opts =
+  try
+    getnameinfo_system addr opts
+  with Invalid_argument _ ->
+    getnameinfo_emulation addr opts
+
+(* High-level process management (system, popen) *)
+
+external win_create_process : string -> string -> string option ->
+                              file_descr -> file_descr -> file_descr -> int
+                            = "win_create_process" "win_create_process_native"
+
+let make_cmdline args =
+  String.concat " " (List.map maybe_quote (Array.to_list args))
+
+let make_process_env env =
+  Array.iter
+    (fun s -> if String.contains s '\000' then raise(Unix_error(EINVAL, "", s)))
+    env;
+  String.concat "\000" (Array.to_list env) ^ "\000"
+
+let create_process prog args fd1 fd2 fd3 =
+  win_create_process prog (make_cmdline args) None fd1 fd2 fd3
+
+let create_process_env prog args env fd1 fd2 fd3 =
+  win_create_process prog (make_cmdline args)
+                     (Some(make_process_env env))
+                     fd1 fd2 fd3
+
+external system: string -> process_status = "win_system"
+
+type popen_process =
+    Process of in_channel * out_channel
+  | Process_in of in_channel
+  | Process_out of out_channel
+  | Process_full of in_channel * out_channel * in_channel
+
+let popen_processes = (Hashtbl.create 7 : (popen_process, int) Hashtbl.t)
+
+let open_proc prog cmdline optenv proc input output error =
+  let pid =
+    win_create_process prog cmdline optenv
+                       input output error in
+  Hashtbl.add popen_processes proc pid
+
+let open_process_cmdline_in prog cmdline =
+  let (in_read, in_write) = pipe ~cloexec:true () in
+  let inchan = in_channel_of_descr in_read in
+  begin
+    try
+      open_proc prog cmdline None (Process_in inchan) stdin in_write stderr
+    with e ->
+      close_in inchan;
+      close in_write;
+      raise e
+  end;
+  close in_write;
+  inchan
+
+let open_process_cmdline_out prog cmdline =
+  let (out_read, out_write) = pipe ~cloexec:true () in
+  let outchan = out_channel_of_descr out_write in
+  begin
+    try
+      open_proc prog cmdline None (Process_out outchan) out_read stdout stderr
+    with e ->
+    close_out outchan;
+    close out_read;
+    raise e
+  end;
+  close out_read;
+  outchan
+
+let open_process_cmdline prog cmdline =
+  let (in_read, in_write) = pipe ~cloexec:true () in
+  let (out_read, out_write) =
+    try pipe ~cloexec:true ()
+    with e -> close in_read; close in_write; raise e in
+  let inchan = in_channel_of_descr in_read in
+  let outchan = out_channel_of_descr out_write in
+  begin
+    try
+      open_proc prog cmdline None
+                (Process(inchan, outchan)) out_read in_write stderr
+    with e ->
+      close out_read; close out_write;
+      close in_read; close in_write;
+      raise e
+  end;
+  close out_read;
+  close in_write;
+  (inchan, outchan)
+
+let open_process_cmdline_full prog cmdline env =
+  let (in_read, in_write) = pipe ~cloexec:true () in
+  let (out_read, out_write) =
+    try pipe ~cloexec:true ()
+    with e -> close in_read; close in_write; raise e in
+  let (err_read, err_write) =
+    try pipe ~cloexec:true ()
+    with e -> close in_read; close in_write;
+              close out_read; close out_write; raise e in
+  let inchan = in_channel_of_descr in_read in
+  let outchan = out_channel_of_descr out_write in
+  let errchan = in_channel_of_descr err_read in
+  begin
+    try
+      open_proc prog cmdline (Some (make_process_env env))
+               (Process_full(inchan, outchan, errchan))
+                out_read in_write err_write
+    with e ->
+      close out_read; close out_write;
+      close in_read; close in_write;
+      close err_read; close err_write;
+      raise e
+  end;
+  close out_read;
+  close in_write;
+  close err_write;
+  (inchan, outchan, errchan)
+
+let open_process_args_in prog args =
+  open_process_cmdline_in prog (make_cmdline args)
+let open_process_args_out prog args =
+  open_process_cmdline_out prog (make_cmdline args)
+let open_process_args prog args =
+  open_process_cmdline prog (make_cmdline args)
+let open_process_args_full prog args =
+  open_process_cmdline_full prog (make_cmdline args)
+
+let open_process_shell fn cmd =
+  let shell =
+    try Sys.getenv "COMSPEC"
+    with Not_found -> raise(Unix_error(ENOEXEC, "open_process_shell", cmd)) in
+  fn shell (shell ^ " /c " ^ cmd)
+let open_process_in cmd =
+  open_process_shell open_process_cmdline_in cmd
+let open_process_out cmd =
+  open_process_shell open_process_cmdline_out cmd
+let open_process cmd =
+  open_process_shell open_process_cmdline cmd
+let open_process_full cmd =
+  open_process_shell open_process_cmdline_full cmd
+
+let find_proc_id fun_name proc =
+  try
+    Hashtbl.find popen_processes proc
+  with Not_found ->
+    raise(Unix_error(EBADF, fun_name, ""))
+
+let remove_proc_id proc =
+  Hashtbl.remove popen_processes proc
+
+let process_in_pid inchan =
+  find_proc_id "process_in_pid" (Process_in inchan)
+let process_out_pid outchan =
+  find_proc_id "process_out_pid" (Process_out outchan)
+let process_pid (inchan, outchan) =
+  find_proc_id "process_pid" (Process(inchan, outchan))
+let process_full_pid (inchan, outchan, errchan) =
+  find_proc_id "process_full_pid"
+    (Process_full(inchan, outchan, errchan))
+
+let close_process_in inchan =
+  let proc = Process_in inchan in
+  let pid = find_proc_id "close_process_in" proc in
+  remove_proc_id proc;
+  close_in inchan;
+  snd(waitpid [] pid)
+
+let close_process_out outchan =
+  let proc = Process_out outchan in
+  let pid = find_proc_id "close_process_out" proc in
+  remove_proc_id proc;
+  close_out outchan;
+  snd(waitpid [] pid)
+
+let close_process (inchan, outchan) =
+  let proc = Process(inchan, outchan) in
+  let pid = find_proc_id "close_process" proc in
+  remove_proc_id proc;
+  close_in inchan; close_out outchan;
+  snd(waitpid [] pid)
+
+let close_process_full (inchan, outchan, errchan) =
+  let proc = Process_full(inchan, outchan, errchan) in
+  let pid = find_proc_id "close_process_full" proc in
+  remove_proc_id proc;
+  close_in inchan; close_out outchan; close_in errchan;
+  snd(waitpid [] pid)
+
+(* Polling *)
+
+external select :
+  file_descr list -> file_descr list -> file_descr list -> float ->
+        file_descr list * file_descr list * file_descr list = "unix_select"
+
+(* High-level network functions *)
+
+let open_connection sockaddr =
+  let sock =
+    socket ~cloexec:true (domain_of_sockaddr sockaddr) SOCK_STREAM 0 in
+  try
+    connect sock sockaddr;
+    (in_channel_of_descr sock, out_channel_of_descr sock)
+  with exn ->
+    close sock; raise exn
+
+let shutdown_connection inchan =
+  shutdown (descr_of_in_channel inchan) SHUTDOWN_SEND
+
+let establish_server _server_fun _sockaddr =
+  invalid_arg "Unix.establish_server not implemented"
+
+(* Terminal interface *)
+
+type terminal_io = {
+    mutable c_ignbrk: bool;
+    mutable c_brkint: bool;
+    mutable c_ignpar: bool;
+    mutable c_parmrk: bool;
+    mutable c_inpck: bool;
+    mutable c_istrip: bool;
+    mutable c_inlcr: bool;
+    mutable c_igncr: bool;
+    mutable c_icrnl: bool;
+    mutable c_ixon: bool;
+    mutable c_ixoff: bool;
+    mutable c_opost: bool;
+    mutable c_obaud: int;
+    mutable c_ibaud: int;
+    mutable c_csize: int;
+    mutable c_cstopb: int;
+    mutable c_cread: bool;
+    mutable c_parenb: bool;
+    mutable c_parodd: bool;
+    mutable c_hupcl: bool;
+    mutable c_clocal: bool;
+    mutable c_isig: bool;
+    mutable c_icanon: bool;
+    mutable c_noflsh: bool;
+    mutable c_echo: bool;
+    mutable c_echoe: bool;
+    mutable c_echok: bool;
+    mutable c_echonl: bool;
+    mutable c_vintr: char;
+    mutable c_vquit: char;
+    mutable c_verase: char;
+    mutable c_vkill: char;
+    mutable c_veof: char;
+    mutable c_veol: char;
+    mutable c_vmin: int;
+    mutable c_vtime: int;
+    mutable c_vstart: char;
+    mutable c_vstop: char
+  }
+
+type setattr_when = TCSANOW | TCSADRAIN | TCSAFLUSH
+
+let tcgetattr _fd = invalid_arg "Unix.tcgetattr not implemented"
+let tcsetattr _fd _wh = invalid_arg "Unix.tcsetattr not implemented"
+let tcsendbreak _fd _n = invalid_arg "Unix.tcsendbreak not implemented"
+let tcdrain _fd = invalid_arg "Unix.tcdrain not implemented"
+
+type flush_queue = TCIFLUSH | TCOFLUSH | TCIOFLUSH
+let tcflush _fd _q = invalid_arg "Unix.tcflush not implemented"
+type flow_action = TCOOFF | TCOON | TCIOFF | TCION
+let tcflow _fd _fl = invalid_arg "Unix.tcflow not implemented"
+let setsid () = invalid_arg "Unix.setsid not implemented"
diff --git a/otherlibs/win32unix/unixsupport.c b/otherlibs/win32unix/unixsupport.c
new file mode 100644
index 00000000..c6005bfc
--- /dev/null
+++ b/otherlibs/win32unix/unixsupport.c
@@ -0,0 +1,330 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <stddef.h>
+#include <caml/mlvalues.h>
+#include <caml/callback.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/custom.h>
+#include "unixsupport.h"
+#include "cst2constr.h"
+#include <errno.h>
+
+/* Heap-allocation of Windows file handles */
+
+static int win_handle_compare(value v1, value v2)
+{
+  HANDLE h1 = Handle_val(v1);
+  HANDLE h2 = Handle_val(v2);
+  return h1 == h2 ? 0 : h1 < h2 ? -1 : 1;
+}
+
+static intnat win_handle_hash(value v)
+{
+  return (intnat) Handle_val(v);
+}
+
+static struct custom_operations win_handle_ops = {
+  "_handle",
+  custom_finalize_default,
+  win_handle_compare,
+  win_handle_hash,
+  custom_serialize_default,
+  custom_deserialize_default,
+  custom_compare_ext_default,
+  custom_fixed_length_default
+};
+
+value win_alloc_handle(HANDLE h)
+{
+  value res =
+    caml_alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1);
+  Handle_val(res) = h;
+  Descr_kind_val(res) = KIND_HANDLE;
+  CRT_fd_val(res) = NO_CRT_FD;
+  Flags_fd_val(res) = FLAGS_FD_IS_BLOCKING;
+  return res;
+}
+
+value win_alloc_socket(SOCKET s)
+{
+  value res =
+    caml_alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1);
+  Socket_val(res) = s;
+  Descr_kind_val(res) = KIND_SOCKET;
+  CRT_fd_val(res) = NO_CRT_FD;
+  Flags_fd_val(res) = FLAGS_FD_IS_BLOCKING;
+  return res;
+}
+
+#if 0
+/* PR#4750: this function is no longer used */
+value win_alloc_handle_or_socket(HANDLE h)
+{
+  value res = win_alloc_handle(h);
+  int opt;
+  int optlen = sizeof(opt);
+  if (getsockopt((SOCKET) h, SOL_SOCKET, SO_TYPE, (char *)&opt, &optlen) == 0)
+    Descr_kind_val(res) = KIND_SOCKET;
+  return res;
+}
+#endif
+
+/* Mapping of Windows error codes to POSIX error codes */
+
+struct error_entry { DWORD win_code; int range; int posix_code; };
+
+static struct error_entry win_error_table[] = {
+  { ERROR_INVALID_FUNCTION, 0, EINVAL},
+  { ERROR_FILE_NOT_FOUND, 0, ENOENT},
+  { ERROR_PATH_NOT_FOUND, 0, ENOENT},
+  { ERROR_TOO_MANY_OPEN_FILES, 0, EMFILE},
+  { ERROR_ACCESS_DENIED, 0, EACCES},
+  { ERROR_INVALID_HANDLE, 0, EBADF},
+  { ERROR_ARENA_TRASHED, 0, ENOMEM},
+  { ERROR_NOT_ENOUGH_MEMORY, 0, ENOMEM},
+  { ERROR_INVALID_BLOCK, 0, ENOMEM},
+  { ERROR_BAD_ENVIRONMENT, 0, E2BIG},
+  { ERROR_BAD_FORMAT, 0, ENOEXEC},
+  { ERROR_INVALID_ACCESS, 0, EINVAL},
+  { ERROR_INVALID_DATA, 0, EINVAL},
+  { ERROR_INVALID_DRIVE, 0, ENOENT},
+  { ERROR_CURRENT_DIRECTORY, 0, EACCES},
+  { ERROR_NOT_SAME_DEVICE, 0, EXDEV},
+  { ERROR_NO_MORE_FILES, 0, ENOENT},
+  { ERROR_LOCK_VIOLATION, 0, EACCES},
+  { ERROR_BAD_NETPATH, 0, ENOENT},
+  { ERROR_NETWORK_ACCESS_DENIED, 0, EACCES},
+  { ERROR_BAD_NET_NAME, 0, ENOENT},
+  { ERROR_FILE_EXISTS, 0, EEXIST},
+  { ERROR_CANNOT_MAKE, 0, EACCES},
+  { ERROR_FAIL_I24, 0, EACCES},
+  { ERROR_INVALID_PARAMETER, 0, EINVAL},
+  { ERROR_NO_PROC_SLOTS, 0, EAGAIN},
+  { ERROR_DRIVE_LOCKED, 0, EACCES},
+  { ERROR_BROKEN_PIPE, 0, EPIPE},
+  { ERROR_NO_DATA, 0, EPIPE},
+  { ERROR_DISK_FULL, 0, ENOSPC},
+  { ERROR_INVALID_TARGET_HANDLE, 0, EBADF},
+  { ERROR_INVALID_HANDLE, 0, EINVAL},
+  { ERROR_WAIT_NO_CHILDREN, 0, ECHILD},
+  { ERROR_CHILD_NOT_COMPLETE, 0, ECHILD},
+  { ERROR_DIRECT_ACCESS_HANDLE, 0, EBADF},
+  { ERROR_NEGATIVE_SEEK, 0, EINVAL},
+  { ERROR_SEEK_ON_DEVICE, 0, EACCES},
+  { ERROR_DIR_NOT_EMPTY, 0, ENOTEMPTY},
+  { ERROR_NOT_LOCKED, 0, EACCES},
+  { ERROR_BAD_PATHNAME, 0, ENOENT},
+  { ERROR_MAX_THRDS_REACHED, 0, EAGAIN},
+  { ERROR_LOCK_FAILED, 0, EACCES},
+  { ERROR_ALREADY_EXISTS, 0, EEXIST},
+  { ERROR_FILENAME_EXCED_RANGE, 0, ENOENT},
+  { ERROR_NESTING_NOT_ALLOWED, 0, EAGAIN},
+  { ERROR_NOT_ENOUGH_QUOTA, 0, ENOMEM},
+  { ERROR_INVALID_STARTING_CODESEG,
+    ERROR_INFLOOP_IN_RELOC_CHAIN - ERROR_INVALID_STARTING_CODESEG,
+    ENOEXEC },
+  { ERROR_WRITE_PROTECT,
+    ERROR_SHARING_BUFFER_EXCEEDED - ERROR_WRITE_PROTECT,
+    EACCES },
+  { WSAEINVAL, 0, EINVAL },
+  { WSAEACCES, 0, EACCES },
+  { WSAEBADF, 0, EBADF },
+  { WSAEFAULT, 0, EFAULT },
+  { WSAEINTR, 0, EINTR },
+  { WSAEINVAL, 0, EINVAL },
+  { WSAEMFILE, 0, EMFILE },
+#ifdef WSANAMETOOLONG
+  { WSANAMETOOLONG, 0, ENAMETOOLONG },
+#endif
+#ifdef WSAENFILE
+  { WSAENFILE, 0, ENFILE },
+#endif
+  { WSAENOTEMPTY, 0, ENOTEMPTY },
+  { 0, -1, 0 }
+};
+
+void win32_maperr(DWORD errcode)
+{
+  int i;
+
+  for (i = 0; win_error_table[i].range >= 0; i++) {
+    if (errcode >= win_error_table[i].win_code &&
+        errcode <= win_error_table[i].win_code + win_error_table[i].range) {
+      errno = win_error_table[i].posix_code;
+      return;
+    }
+  }
+  /* Not found: save original error code, negated so that we can
+     recognize it in unix_error_message */
+  errno = -errcode;
+}
+
+/* Windows socket errors */
+#undef EWOULDBLOCK
+#define EWOULDBLOCK             -WSAEWOULDBLOCK
+#undef EINPROGRESS
+#define EINPROGRESS             -WSAEINPROGRESS
+#undef EALREADY
+#define EALREADY                -WSAEALREADY
+#undef ENOTSOCK
+#define ENOTSOCK                -WSAENOTSOCK
+#undef EDESTADDRREQ
+#define EDESTADDRREQ            -WSAEDESTADDRREQ
+#undef EMSGSIZE
+#define EMSGSIZE                -WSAEMSGSIZE
+#undef EPROTOTYPE
+#define EPROTOTYPE              -WSAEPROTOTYPE
+#undef ENOPROTOOPT
+#define ENOPROTOOPT             -WSAENOPROTOOPT
+#undef EPROTONOSUPPORT
+#define EPROTONOSUPPORT         -WSAEPROTONOSUPPORT
+#undef ESOCKTNOSUPPORT
+#define ESOCKTNOSUPPORT         -WSAESOCKTNOSUPPORT
+#undef EOPNOTSUPP
+#define EOPNOTSUPP              -WSAEOPNOTSUPP
+#undef EPFNOSUPPORT
+#define EPFNOSUPPORT            -WSAEPFNOSUPPORT
+#undef EAFNOSUPPORT
+#define EAFNOSUPPORT            -WSAEAFNOSUPPORT
+#undef EADDRINUSE
+#define EADDRINUSE              -WSAEADDRINUSE
+#undef EADDRNOTAVAIL
+#define EADDRNOTAVAIL           -WSAEADDRNOTAVAIL
+#undef ENETDOWN
+#define ENETDOWN                -WSAENETDOWN
+#undef ENETUNREACH
+#define ENETUNREACH             -WSAENETUNREACH
+#undef ENETRESET
+#define ENETRESET               -WSAENETRESET
+#undef ECONNABORTED
+#define ECONNABORTED            -WSAECONNABORTED
+#undef ECONNRESET
+#define ECONNRESET              -WSAECONNRESET
+#undef ENOBUFS
+#define ENOBUFS                 -WSAENOBUFS
+#undef EISCONN
+#define EISCONN                 -WSAEISCONN
+#undef ENOTCONN
+#define ENOTCONN                -WSAENOTCONN
+#undef ESHUTDOWN
+#define ESHUTDOWN               -WSAESHUTDOWN
+#undef ETOOMANYREFS
+#define ETOOMANYREFS            -WSAETOOMANYREFS
+#undef ETIMEDOUT
+#define ETIMEDOUT               -WSAETIMEDOUT
+#undef ECONNREFUSED
+#define ECONNREFUSED            -WSAECONNREFUSED
+#undef ELOOP
+#define ELOOP                   -WSAELOOP
+#undef EHOSTDOWN
+#define EHOSTDOWN               -WSAEHOSTDOWN
+#undef EHOSTUNREACH
+#define EHOSTUNREACH            -WSAEHOSTUNREACH
+#undef EPROCLIM
+#define EPROCLIM                -WSAEPROCLIM
+#undef EUSERS
+#define EUSERS                  -WSAEUSERS
+#undef EDQUOT
+#define EDQUOT                  -WSAEDQUOT
+#undef ESTALE
+#define ESTALE                  -WSAESTALE
+#undef EREMOTE
+#define EREMOTE                 -WSAEREMOTE
+
+#undef EOVERFLOW
+#define EOVERFLOW -ERROR_ARITHMETIC_OVERFLOW
+#undef EACCESS
+#define EACCESS EACCES
+
+int error_table[] = {
+  E2BIG, EACCESS, EAGAIN, EBADF, EBUSY, ECHILD, EDEADLK, EDOM,
+  EEXIST, EFAULT, EFBIG, EINTR, EINVAL, EIO, EISDIR, EMFILE, EMLINK,
+  ENAMETOOLONG, ENFILE, ENODEV, ENOENT, ENOEXEC, ENOLCK, ENOMEM, ENOSPC,
+  ENOSYS, ENOTDIR, ENOTEMPTY, ENOTTY, ENXIO, EPERM, EPIPE, ERANGE,
+  EROFS, ESPIPE, ESRCH, EXDEV, EWOULDBLOCK, EINPROGRESS, EALREADY,
+  ENOTSOCK, EDESTADDRREQ, EMSGSIZE, EPROTOTYPE, ENOPROTOOPT,
+  EPROTONOSUPPORT, ESOCKTNOSUPPORT, EOPNOTSUPP, EPFNOSUPPORT,
+  EAFNOSUPPORT, EADDRINUSE, EADDRNOTAVAIL, ENETDOWN, ENETUNREACH,
+  ENETRESET, ECONNABORTED, ECONNRESET, ENOBUFS, EISCONN, ENOTCONN,
+  ESHUTDOWN, ETOOMANYREFS, ETIMEDOUT, ECONNREFUSED, EHOSTDOWN,
+  EHOSTUNREACH, ELOOP, EOVERFLOW /*, EUNKNOWNERR */
+};
+
+static const value * unix_error_exn = NULL;
+
+value unix_error_of_code (int errcode)
+{
+  int errconstr;
+  value err;
+
+  errconstr =
+      cst_to_constr(errcode, error_table, sizeof(error_table)/sizeof(int), -1);
+  if (errconstr == Val_int(-1)) {
+    err = caml_alloc_small(1, 0);
+    Field(err, 0) = Val_int(errcode);
+  } else {
+    err = errconstr;
+  }
+  return err;
+}
+
+void unix_error(int errcode, const char *cmdname, value cmdarg)
+{
+  value res;
+  value name = Val_unit, err = Val_unit, arg = Val_unit;
+  int errconstr;
+
+  Begin_roots3 (name, err, arg);
+    arg = cmdarg == Nothing ? caml_copy_string("") : cmdarg;
+    name = caml_copy_string(cmdname);
+    err = unix_error_of_code (errcode);
+    if (unix_error_exn == NULL) {
+      unix_error_exn = caml_named_value("Unix.Unix_error");
+      if (unix_error_exn == NULL)
+        caml_invalid_argument("Exception Unix.Unix_error not initialized,"
+                         " please link unix.cma");
+    }
+    res = caml_alloc_small(4, 0);
+    Field(res, 0) = *unix_error_exn;
+    Field(res, 1) = err;
+    Field(res, 2) = name;
+    Field(res, 3) = arg;
+  End_roots();
+  caml_raise(res);
+}
+
+void uerror(const char * cmdname, value cmdarg)
+{
+  unix_error(errno, cmdname, cmdarg);
+}
+
+void caml_unix_check_path(value path, const char * cmdname)
+{
+  if (! caml_string_is_c_safe(path)) unix_error(ENOENT, cmdname, path);
+}
+
+int unix_cloexec_default = 0;
+
+int unix_cloexec_p(value cloexec)
+{
+  /* [cloexec] is a [bool option].  */
+  if (Is_block(cloexec))
+    return Bool_val(Field(cloexec, 0));
+  else
+    return unix_cloexec_default;
+}
diff --git a/otherlibs/win32unix/unixsupport.h b/otherlibs/win32unix/unixsupport.h
new file mode 100644
index 00000000..09ebaca9
--- /dev/null
+++ b/otherlibs/win32unix/unixsupport.h
@@ -0,0 +1,133 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Xavier Leroy and Pascal Cuoq, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_UNIXSUPPORT_H
+#define CAML_UNIXSUPPORT_H
+
+#define WIN32_LEAN_AND_MEAN
+#include <wtypes.h>
+#include <winbase.h>
+#include <stdlib.h>
+#include <direct.h>
+#include <process.h>
+#include <sys/types.h>
+#include <winsock2.h>
+#ifdef HAS_IPV6
+#include <ws2tcpip.h>
+#include <wspiapi.h>
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+struct filedescr {
+  union {
+    HANDLE handle;
+    SOCKET socket;
+  } fd;                   /* Real windows handle */
+  enum { KIND_HANDLE, KIND_SOCKET } kind;
+  int crt_fd;             /* C runtime descriptor */
+  unsigned int flags_fd;  /* See FLAGS_FD_* */
+};
+
+#define Handle_val(v) (((struct filedescr *) Data_custom_val(v))->fd.handle)
+#define Socket_val(v) (((struct filedescr *) Data_custom_val(v))->fd.socket)
+#define Descr_kind_val(v) (((struct filedescr *) Data_custom_val(v))->kind)
+#define CRT_fd_val(v) (((struct filedescr *) Data_custom_val(v))->crt_fd)
+#define Flags_fd_val(v) (((struct filedescr *) Data_custom_val(v))->flags_fd)
+
+/* extern value win_alloc_handle_or_socket(HANDLE); */
+extern value win_alloc_handle(HANDLE);
+extern value win_alloc_socket(SOCKET);
+extern int win_CRT_fd_of_filedescr(value handle);
+
+#define NO_CRT_FD (-1)
+#define Nothing ((value) 0)
+
+extern void win32_maperr(DWORD errcode);
+extern value unix_error_of_code (int errcode);
+
+CAMLnoreturn_start
+extern void unix_error (int errcode, const char * cmdname, value arg)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+extern void uerror (const char * cmdname, value arg)
+CAMLnoreturn_end;
+
+extern void caml_unix_check_path(value path, const char * cmdname);
+extern value unix_freeze_buffer (value);
+extern wchar_t ** cstringvect(value arg, char * cmdname);
+extern void cstringvect_free(wchar_t **);
+
+extern int unix_cloexec_default;
+extern int unix_cloexec_p(value cloexec);
+
+/* Information stored in flags_fd, describing more precisely the socket
+ * and its status. The whole flags_fd is initialized to 0.
+ */
+
+/* Blocking or nonblocking.  By default a filedescr is in blocking state */
+#define FLAGS_FD_IS_BLOCKING (1<<0)
+
+#define UNIX_BUFFER_SIZE 65536
+
+#ifdef __cplusplus
+}
+#endif
+
+/*
+ * This structure is defined inconsistently. mingw64 has it in ntdef.h (which
+ * doesn't look like a primary header) and technically it's part of ntifs.h in
+ * the WDK. Requiring the WDK is a bit extreme, so the definition is taken from
+ * ntdef.h. Both ntdef.h and ntifs.h define REPARSE_DATA_BUFFER_HEADER_SIZE
+ */
+#ifndef REPARSE_DATA_BUFFER_HEADER_SIZE
+typedef struct _REPARSE_DATA_BUFFER
+{
+  ULONG  ReparseTag;
+  USHORT ReparseDataLength;
+  USHORT Reserved;
+  union
+  {
+    struct
+    {
+      USHORT SubstituteNameOffset;
+      USHORT SubstituteNameLength;
+      USHORT PrintNameOffset;
+      USHORT PrintNameLength;
+      ULONG  Flags;
+      WCHAR  PathBuffer[1];
+    } SymbolicLinkReparseBuffer;
+    struct
+    {
+      USHORT SubstituteNameOffset;
+      USHORT SubstituteNameLength;
+      USHORT PrintNameOffset;
+      USHORT PrintNameLength;
+      WCHAR  PathBuffer[1];
+    } MountPointReparseBuffer;
+    struct
+    {
+      UCHAR  DataBuffer[1];
+    } GenericReparseBuffer;
+  };
+} REPARSE_DATA_BUFFER, *PREPARSE_DATA_BUFFER;
+#endif
+
+#define EXECV_CAST (const char_os * const *)
+
+#endif /* CAML_UNIXSUPPORT_H */
diff --git a/otherlibs/win32unix/utimes.c b/otherlibs/win32unix/utimes.c
new file mode 100644
index 00000000..cf448c2a
--- /dev/null
+++ b/otherlibs/win32unix/utimes.c
@@ -0,0 +1,85 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                        Nicolas Ojeda Bar, LexiFi                       */
+/*                                                                        */
+/*   Copyright 2017 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
+
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+#include <windows.h>
+
+static void convert_time(double unixTime, FILETIME* ft)
+{
+  ULARGE_INTEGER u;
+  /* There are 11644473600 seconds between 1 January 1601 (the NT Epoch) and 1
+   * January 1970 (the Unix Epoch). FILETIME is measured in 100ns ticks.
+   */
+  u.QuadPart =
+    (ULONGLONG)(unixTime * 10000000.0) + INT64_LITERAL(116444736000000000U);
+  ft->dwLowDateTime = u.LowPart;
+  ft->dwHighDateTime = u.HighPart;
+}
+
+CAMLprim value unix_utimes(value path, value atime, value mtime)
+{
+  CAMLparam3(path, atime, mtime);
+  WCHAR *wpath;
+  HANDLE hFile;
+  FILETIME lastAccessTime, lastModificationTime;
+  SYSTEMTIME systemTime;
+  double at, mt;
+  BOOL res;
+
+  caml_unix_check_path(path, "utimes");
+  at = Double_val(atime);
+  mt = Double_val(mtime);
+  wpath = caml_stat_strdup_to_utf16(String_val(path));
+  caml_enter_blocking_section();
+  hFile = CreateFile(wpath,
+                     FILE_WRITE_ATTRIBUTES,
+                     FILE_SHARE_READ | FILE_SHARE_WRITE,
+                     NULL,
+                     OPEN_EXISTING,
+                     0,
+                     NULL);
+  caml_leave_blocking_section();
+  caml_stat_free(wpath);
+  if (hFile == INVALID_HANDLE_VALUE) {
+    win32_maperr(GetLastError());
+    uerror("utimes", path);
+  }
+  if (at == 0.0 && mt == 0.0) {
+    GetSystemTime(&systemTime);
+    SystemTimeToFileTime(&systemTime, &lastAccessTime);
+    memcpy(&lastModificationTime, &lastAccessTime, sizeof(FILETIME));
+  } else {
+    convert_time(at, &lastAccessTime);
+    convert_time(mt, &lastModificationTime);
+  }
+  caml_enter_blocking_section();
+  res = SetFileTime(hFile, NULL, &lastAccessTime, &lastModificationTime);
+  caml_leave_blocking_section();
+  if (res == 0) {
+    win32_maperr(GetLastError());
+    CloseHandle(hFile);
+    uerror("utimes", path);
+  }
+  CloseHandle(hFile);
+  CAMLreturn(Val_unit);
+}
diff --git a/otherlibs/win32unix/windbug.c b/otherlibs/win32unix/windbug.c
new file mode 100644
index 00000000..424dd920
--- /dev/null
+++ b/otherlibs/win32unix/windbug.c
@@ -0,0 +1,32 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Contributed by Sylvain Le Gall for Lexifi                            */
+/*                                                                        */
+/*   Copyright 2008 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include "windbug.h"
+
+int debug_test (void)
+{
+  static int debug_init = 0;
+  static int debug = 0;
+
+#ifdef DEBUG
+  if (!debug_init)
+  {
+    debug = (getenv("OCAMLDEBUG") != NULL);
+    debug_init = 1;
+  };
+#endif
+
+  return debug;
+}
diff --git a/otherlibs/win32unix/windbug.h b/otherlibs/win32unix/windbug.h
new file mode 100644
index 00000000..cc5ee690
--- /dev/null
+++ b/otherlibs/win32unix/windbug.h
@@ -0,0 +1,70 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Contributed by Sylvain Le Gall for Lexifi                            */
+/*                                                                        */
+/*   Copyright 2008 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifdef DEBUG
+
+#include <stdio.h>
+#include <windows.h>
+
+/* According to MSDN, MSVC supports the gcc ## operator (to deal with empty
+   argument lists)
+ */
+#define DEBUG_PRINT(fmt, ...) \
+  do \
+  { \
+    if (debug_test()) \
+    { \
+      fprintf(stderr, "DBUG (pid:%ld, tid: %ld): ", GetCurrentProcessId(), \
+              GetCurrentThreadId()); \
+      fprintf(stderr, fmt, ##__VA_ARGS__); \
+      fprintf(stderr, "\n"); \
+      fflush(stderr); \
+    }; \
+  } while(0)
+
+/* Test if we are in dbug mode */
+int  debug_test    (void);
+
+#elif defined(_MSC_VER) && _MSC_VER < 1300
+
+#define DEBUG_PRINT(fmt)
+
+/* __pragma wasn't added until Visual C++ .NET 2002, so simply disable the
+   warning entirely
+ */
+
+#pragma warning (disable:4002)
+
+#elif defined(_MSC_VER) && _MSC_VER <= 1400
+
+/* Not all versions of the Visual Studio 2005 C Compiler (Version 14) support
+   variadic macros, hence the test for this branch being <= 1400 rather than
+   < 1400.
+   This convoluted pair of macros allow DEBUG_PRINT to remain while temporarily
+   suppressing the warning displayed for a macro called with too many
+   parameters.
+ */
+#define DEBUG_PRINT_S(fmt) __pragma(warning(pop))
+#define DEBUG_PRINT \
+  __pragma(warning(push)) \
+  __pragma(warning(disable:4002)) \
+  DEBUG_PRINT_S
+
+#else
+
+/* Visual Studio supports variadic macros in all versions from 2008 (CL 15). */
+#define DEBUG_PRINT(fmt, ...)
+
+#endif
diff --git a/otherlibs/win32unix/windir.c b/otherlibs/win32unix/windir.c
new file mode 100644
index 00000000..b287a8ea
--- /dev/null
+++ b/otherlibs/win32unix/windir.c
@@ -0,0 +1,83 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*    Pascal Cuoq and 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
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <errno.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+CAMLprim value win_findfirst(value name)
+{
+  HANDLE h;
+  value v;
+  WIN32_FIND_DATAW fileinfo;
+  value valname = Val_unit;
+  value valh = Val_unit;
+  wchar_t * wname;
+
+  caml_unix_check_path(name, "opendir");
+  Begin_roots2 (valname,valh);
+    wname = caml_stat_strdup_to_utf16(String_val(name));
+    h = FindFirstFile(wname,&fileinfo);
+    caml_stat_free(wname);
+    if (h == INVALID_HANDLE_VALUE) {
+      DWORD err = GetLastError();
+      if (err == ERROR_NO_MORE_FILES)
+        caml_raise_end_of_file();
+      else {
+        win32_maperr(err);
+        uerror("opendir", Nothing);
+      }
+    }
+    valname = caml_copy_string_of_utf16(fileinfo.cFileName);
+    valh = win_alloc_handle(h);
+    v = caml_alloc_small(2, 0);
+    Field(v,0) = valname;
+    Field(v,1) = valh;
+  End_roots();
+  return v;
+}
+
+CAMLprim value win_findnext(value valh)
+{
+  WIN32_FIND_DATAW fileinfo;
+  BOOL retcode;
+
+  retcode = FindNextFile(Handle_val(valh), &fileinfo);
+  if (!retcode) {
+    DWORD err = GetLastError();
+    if (err == ERROR_NO_MORE_FILES)
+      caml_raise_end_of_file();
+    else {
+      win32_maperr(err);
+      uerror("readdir", Nothing);
+    }
+  }
+  return caml_copy_string_of_utf16(fileinfo.cFileName);
+}
+
+CAMLprim value win_findclose(value valh)
+{
+  if (! FindClose(Handle_val(valh))) {
+    win32_maperr(GetLastError());
+    uerror("closedir", Nothing);
+  }
+  return Val_unit;
+}
diff --git a/otherlibs/win32unix/winlist.c b/otherlibs/win32unix/winlist.c
new file mode 100644
index 00000000..c05dd11d
--- /dev/null
+++ b/otherlibs/win32unix/winlist.c
@@ -0,0 +1,80 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Contributed by Sylvain Le Gall for Lexifi                            */
+/*                                                                        */
+/*   Copyright 2008 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Basic list function in C. */
+
+#include "winlist.h"
+#include <windows.h>
+
+void list_init (LPLIST lst)
+{
+  lst->lpNext = NULL;
+}
+
+void list_cleanup (LPLIST lst)
+{
+  lst->lpNext = NULL;
+}
+
+void list_next_set (LPLIST lst, LPLIST next)
+{
+  lst->lpNext = next;
+}
+
+LPLIST list_next (LPLIST lst)
+{
+  return lst->lpNext;
+}
+
+int list_length (LPLIST lst)
+{
+  int length = 0;
+  LPLIST iter = lst;
+  while (iter != NULL)
+  {
+    length++;
+    iter = list_next(iter);
+  };
+  return length;
+}
+
+LPLIST list_concat (LPLIST lsta, LPLIST lstb)
+{
+  LPLIST res = NULL;
+  LPLIST iter = NULL;
+  LPLIST iterPrev = NULL;
+
+  if (lsta == NULL)
+  {
+    res = lstb;
+  }
+  else if (lstb == NULL)
+  {
+    res = lsta;
+  }
+  else
+  {
+    res = lsta;
+    iter = lsta;
+    while (iter != NULL)
+    {
+      iterPrev = iter;
+      iter = list_next(iter);
+    };
+    iterPrev->lpNext = lstb;
+  };
+
+  return res;
+}
diff --git a/otherlibs/win32unix/winlist.h b/otherlibs/win32unix/winlist.h
new file mode 100644
index 00000000..285d507b
--- /dev/null
+++ b/otherlibs/win32unix/winlist.h
@@ -0,0 +1,55 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Contributed by Sylvain Le Gall for Lexifi                            */
+/*                                                                        */
+/*   Copyright 2008 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef _WINLIST_H
+#define _WINLIST_H
+
+/* Basic list function in C. */
+
+/* Singly-linked list data structure.
+ * To transform a C struct into a list structure, you must include
+ * at first position of your C struct a "LIST lst" and call list_init
+ * on this data structure.
+ *
+ * See winworker.c for example.
+ */
+typedef struct _LIST LIST;
+typedef LIST *LPLIST;
+
+struct _LIST {
+  LPLIST lpNext;
+};
+
+/* Initialize list data structure */
+void list_init (LPLIST lst);
+
+/* Cleanup list data structure */
+void list_cleanup (LPLIST lst);
+
+/* Set next element */
+void list_next_set (LPLIST lst, LPLIST next);
+
+/* Return next element */
+LPLIST list_next (LPLIST);
+
+#define LIST_NEXT(T, e) ((T)(list_next((LPLIST)(e))))
+
+/* Get the number of elements */
+int list_length (LPLIST);
+
+/* Concatenate two lists */
+LPLIST list_concat (LPLIST, LPLIST);
+
+#endif /* _WINLIST_H */
diff --git a/otherlibs/win32unix/winwait.c b/otherlibs/win32unix/winwait.c
new file mode 100644
index 00000000..90cc6db6
--- /dev/null
+++ b/otherlibs/win32unix/winwait.c
@@ -0,0 +1,81 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*    Pascal Cuoq and 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+#include <windows.h>
+#include <sys/types.h>
+
+static value alloc_process_status(HANDLE pid, int status)
+{
+  value res, st;
+
+  st = caml_alloc(1, 0);
+  Field(st, 0) = Val_int(status);
+  Begin_root (st);
+    res = caml_alloc_small(2, 0);
+    Field(res, 0) = Val_long((intnat) pid);
+    Field(res, 1) = st;
+  End_roots();
+  return res;
+}
+
+enum { CAML_WNOHANG = 1, CAML_WUNTRACED = 2 };
+
+static int wait_flag_table[] = { CAML_WNOHANG, CAML_WUNTRACED };
+
+CAMLprim value win_waitpid(value vflags, value vpid_req)
+{
+  int flags;
+  DWORD status, retcode;
+  HANDLE pid_req = (HANDLE) Long_val(vpid_req);
+  DWORD err = 0;
+
+  flags = caml_convert_flag_list(vflags, wait_flag_table);
+  if ((flags & CAML_WNOHANG) == 0) {
+    caml_enter_blocking_section();
+    retcode = WaitForSingleObject(pid_req, INFINITE);
+    if (retcode == WAIT_FAILED) err = GetLastError();
+    caml_leave_blocking_section();
+  } else {
+    /* GPR#1155: we don't rely solely on GetExitCodeProcess to
+       determine whether the process has terminated or not. This is
+       because GetExitCodeProcess might return that the process has
+       terminated before the resources associated with the process are
+       released. This can be a problem since by default one cannot
+       delete a file or directory that is still in use. */
+    retcode = WaitForSingleObject(pid_req, 0);
+    if (retcode == WAIT_TIMEOUT)
+      return alloc_process_status((HANDLE) 0, 0);
+    if (retcode == WAIT_FAILED) err = GetLastError();
+  }
+  if (err) {
+    win32_maperr(err);
+    uerror("waitpid", Nothing);
+  }
+  if (! GetExitCodeProcess(pid_req, &status)) {
+    win32_maperr(GetLastError());
+    uerror("waitpid", Nothing);
+  }
+  if (status == STILL_ACTIVE)
+    return alloc_process_status((HANDLE) 0, 0);
+  else {
+    CloseHandle(pid_req);
+    return alloc_process_status(pid_req, status);
+  }
+}
diff --git a/otherlibs/win32unix/winworker.c b/otherlibs/win32unix/winworker.c
new file mode 100644
index 00000000..17ac60f5
--- /dev/null
+++ b/otherlibs/win32unix/winworker.c
@@ -0,0 +1,322 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Contributed by Sylvain Le Gall for Lexifi                            */
+/*                                                                        */
+/*   Copyright 2008 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "winworker.h"
+#include "winlist.h"
+#include "windbug.h"
+
+typedef enum {
+  WORKER_CMD_NONE = 0,
+  WORKER_CMD_EXEC,
+  WORKER_CMD_STOP
+} WORKERCMD;
+
+struct _WORKER {
+  LIST       lst;           /* This structure is used as a list. */
+  HANDLE     hJobStarted;   /* Event representing that the function has begun.*/
+  HANDLE     hJobStop;      /* Event that can be used to notify the function
+                               that it should stop processing. */
+  HANDLE     hJobDone;      /* Event representing that the function has
+                               finished. */
+  void      *lpJobUserData; /* User data for the job. */
+  WORKERFUNC hJobFunc;      /* Function to be called during APC */
+  HANDLE     hWorkerReady;  /* Worker is ready. */
+  HANDLE     hCommandReady; /* Worker should execute command. */
+  WORKERCMD  ECommand;      /* Command to execute */
+  HANDLE     hThread;       /* Thread handle of the worker. */
+};
+
+#define THREAD_WORKERS_MAX 16
+#define THREAD_WORKERS_MEM 4000
+
+LPWORKER lpWorkers       = NULL;
+DWORD    nWorkersCurrent = 0;
+DWORD    nWorkersMax     = 0;
+HANDLE   hWorkersMutex   = INVALID_HANDLE_VALUE;
+
+DWORD WINAPI worker_wait (LPVOID _data)
+{
+  BOOL     bExit;
+  LPWORKER lpWorker;
+
+  lpWorker = (LPWORKER )_data;
+  bExit    = FALSE;
+
+  DEBUG_PRINT("Worker %x starting", lpWorker);
+  while (
+      !bExit
+      && SignalObjectAndWait(
+        lpWorker->hWorkerReady,
+        lpWorker->hCommandReady,
+        INFINITE,
+        TRUE) == WAIT_OBJECT_0)
+  {
+    DEBUG_PRINT("Worker %x running", lpWorker);
+    switch (lpWorker->ECommand)
+    {
+      case WORKER_CMD_NONE:
+        break;
+
+      case WORKER_CMD_EXEC:
+        if (lpWorker->hJobFunc != NULL)
+        {
+          SetEvent(lpWorker->hJobStarted);
+          lpWorker->hJobFunc(lpWorker->hJobStop, lpWorker->lpJobUserData);
+          SetEvent(lpWorker->hJobDone);
+        };
+        break;
+
+      case WORKER_CMD_STOP:
+        bExit = TRUE;
+        break;
+    }
+  };
+  DEBUG_PRINT("Worker %x exiting", lpWorker);
+
+  return 0;
+}
+
+LPWORKER worker_new (void)
+{
+  LPWORKER lpWorker = NULL;
+
+  lpWorker = (LPWORKER)caml_stat_alloc(sizeof(WORKER));
+  list_init((LPLIST)lpWorker);
+  lpWorker->hJobStarted  = CreateEvent(NULL, TRUE, FALSE, NULL);
+  lpWorker->hJobStop     = CreateEvent(NULL, TRUE, FALSE, NULL);
+  lpWorker->hJobDone     = CreateEvent(NULL, TRUE, FALSE, NULL);
+  lpWorker->lpJobUserData = NULL;
+  lpWorker->hWorkerReady       = CreateEvent(NULL, FALSE, FALSE, NULL);
+  lpWorker->hCommandReady      = CreateEvent(NULL, FALSE, FALSE, NULL);
+  lpWorker->ECommand           = WORKER_CMD_NONE;
+  lpWorker->hThread = CreateThread(
+    NULL,
+    THREAD_WORKERS_MEM,
+    worker_wait,
+    (LPVOID)lpWorker,
+    0,
+    NULL);
+
+  return lpWorker;
+};
+
+void worker_free (LPWORKER lpWorker)
+{
+  /* Wait for termination of the worker */
+  DEBUG_PRINT("Shutting down worker %x", lpWorker);
+  WaitForSingleObject(lpWorker->hWorkerReady, INFINITE);
+  lpWorker->ECommand = WORKER_CMD_STOP;
+  SetEvent(lpWorker->hCommandReady);
+  WaitForSingleObject(lpWorker->hThread, INFINITE);
+
+  /* Free resources */
+  DEBUG_PRINT("Freeing resources of worker %x", lpWorker);
+  if (lpWorker->hThread != INVALID_HANDLE_VALUE)
+  {
+    CloseHandle(lpWorker->hThread);
+    lpWorker->hThread = INVALID_HANDLE_VALUE;
+  }
+
+  if (lpWorker->hJobStarted != INVALID_HANDLE_VALUE)
+  {
+    CloseHandle(lpWorker->hJobStarted);
+    lpWorker->hJobStarted = INVALID_HANDLE_VALUE;
+  }
+
+  if (lpWorker->hJobStop != INVALID_HANDLE_VALUE)
+  {
+    CloseHandle(lpWorker->hJobStop);
+    lpWorker->hJobStop = INVALID_HANDLE_VALUE;
+  }
+
+  if (lpWorker->hJobDone != INVALID_HANDLE_VALUE)
+  {
+    CloseHandle(lpWorker->hJobDone);
+    lpWorker->hJobDone = INVALID_HANDLE_VALUE;
+  }
+
+  lpWorker->lpJobUserData = NULL;
+  lpWorker->hJobFunc = NULL;
+
+  if (lpWorker->hWorkerReady != INVALID_HANDLE_VALUE)
+  {
+    CloseHandle(lpWorker->hWorkerReady);
+    lpWorker->hWorkerReady = INVALID_HANDLE_VALUE;
+  }
+
+  if (lpWorker->hCommandReady != INVALID_HANDLE_VALUE)
+  {
+    CloseHandle(lpWorker->hCommandReady);
+    lpWorker->hCommandReady = INVALID_HANDLE_VALUE;
+  }
+
+  caml_stat_free(lpWorker);
+};
+
+LPWORKER worker_pop (void)
+{
+  LPWORKER lpWorkerFree = NULL;
+
+  WaitForSingleObject(hWorkersMutex, INFINITE);
+  /* Get the first worker of the list */
+  if (lpWorkers != NULL)
+  {
+    lpWorkerFree = lpWorkers;
+    lpWorkers = LIST_NEXT(LPWORKER, lpWorkers);
+  }
+  nWorkersCurrent++;
+  nWorkersMax = (nWorkersCurrent > nWorkersMax ? nWorkersCurrent : nWorkersMax);
+  DEBUG_PRINT("Workers running current/running max/waiting: %d/%d/%d",
+      nWorkersCurrent,
+      nWorkersMax,
+      list_length((LPLIST)lpWorkers));
+  ReleaseMutex(hWorkersMutex);
+
+  if (lpWorkerFree == NULL)
+  {
+    /* We cannot find a free worker, create one. */
+    lpWorkerFree = worker_new();
+  }
+
+  /* Ensure that we don't get dangling pointer to old data. */
+  list_init((LPLIST)lpWorkerFree);
+  lpWorkerFree->lpJobUserData = NULL;
+
+  /* Reset events */
+  ResetEvent(lpWorkerFree->hJobStarted);
+  ResetEvent(lpWorkerFree->hJobStop);
+  ResetEvent(lpWorkerFree->hJobDone);
+
+  return lpWorkerFree;
+}
+
+void worker_push(LPWORKER lpWorker)
+{
+  BOOL bFreeWorker;
+
+  bFreeWorker = TRUE;
+
+  WaitForSingleObject(hWorkersMutex, INFINITE);
+  DEBUG_PRINT("Testing if we are under the maximum number of running workers");
+  if (list_length((LPLIST)lpWorkers) < THREAD_WORKERS_MAX)
+  {
+    DEBUG_PRINT("Saving this worker for future use");
+    DEBUG_PRINT("Next: %x", ((LPLIST)lpWorker)->lpNext);
+    lpWorkers = (LPWORKER)list_concat((LPLIST)lpWorker, (LPLIST)lpWorkers);
+    bFreeWorker = FALSE;
+  };
+  nWorkersCurrent--;
+  DEBUG_PRINT("Workers running current/running max/waiting: %d/%d/%d",
+      nWorkersCurrent,
+      nWorkersMax,
+      list_length((LPLIST)lpWorkers));
+  ReleaseMutex(hWorkersMutex);
+
+  if (bFreeWorker)
+  {
+    DEBUG_PRINT("Freeing worker %x", lpWorker);
+    worker_free(lpWorker);
+  }
+}
+
+void 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.
+     */
+  DEBUG_PRINT("Allocating mutex for workers");
+  if (hWorkersMutex == INVALID_HANDLE_VALUE)
+  {
+    hWorkersMutex = CreateMutex(NULL, FALSE, NULL);
+  }
+}
+
+void worker_cleanup(void)
+{
+  LPWORKER lpWorker = NULL;
+
+  /* WARNING: we can have a race condition here, if while this code
+     is executed another worker is waiting to access hWorkersMutex,
+     he will never be able to get it...
+     */
+  if (hWorkersMutex != INVALID_HANDLE_VALUE)
+  {
+    WaitForSingleObject(hWorkersMutex, INFINITE);
+    DEBUG_PRINT("Freeing global resource of workers");
+    /* Empty the queue of worker worker */
+    while (lpWorkers != NULL)
+    {
+      ReleaseMutex(hWorkersMutex);
+      lpWorker = worker_pop();
+      DEBUG_PRINT("Freeing worker %x", lpWorker);
+      WaitForSingleObject(hWorkersMutex, INFINITE);
+      worker_free(lpWorker);
+    };
+    ReleaseMutex(hWorkersMutex);
+
+    /* Destroy associated mutex */
+    CloseHandle(hWorkersMutex);
+    hWorkersMutex = INVALID_HANDLE_VALUE;
+  };
+}
+
+LPWORKER worker_job_submit (WORKERFUNC f, void *user_data)
+{
+  LPWORKER lpWorker = worker_pop();
+
+  DEBUG_PRINT("Waiting for worker to be ready");
+  caml_enter_blocking_section();
+  WaitForSingleObject(lpWorker->hWorkerReady, INFINITE);
+  ResetEvent(lpWorker->hWorkerReady);
+  caml_leave_blocking_section();
+  DEBUG_PRINT("Worker is ready");
+
+  lpWorker->hJobFunc      = f;
+  lpWorker->lpJobUserData = user_data;
+  lpWorker->ECommand      = WORKER_CMD_EXEC;
+
+  DEBUG_PRINT("Call worker (func: %x, worker: %x)", f, lpWorker);
+  SetEvent(lpWorker->hCommandReady);
+
+  return (LPWORKER)lpWorker;
+}
+
+HANDLE worker_job_event_done (LPWORKER lpWorker)
+{
+  return lpWorker->hJobDone;
+}
+
+void worker_job_stop (LPWORKER lpWorker)
+{
+  DEBUG_PRINT("Sending stop signal to worker %x", lpWorker);
+  SetEvent(lpWorker->hJobStop);
+  DEBUG_PRINT("Signal sent to worker %x", lpWorker);
+}
+
+void worker_job_finish (LPWORKER lpWorker)
+{
+  DEBUG_PRINT("Finishing call of worker %x", lpWorker);
+  caml_enter_blocking_section();
+  WaitForSingleObject(lpWorker->hJobDone, INFINITE);
+  caml_leave_blocking_section();
+
+  worker_push(lpWorker);
+}
diff --git a/otherlibs/win32unix/winworker.h b/otherlibs/win32unix/winworker.h
new file mode 100644
index 00000000..a807f6b7
--- /dev/null
+++ b/otherlibs/win32unix/winworker.h
@@ -0,0 +1,73 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*   Contributed by Sylvain Le Gall for Lexifi                            */
+/*                                                                        */
+/*   Copyright 2008 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef _WINWORKER_H
+#define _WINWORKER_H
+
+#undef _WIN32_WINNT
+#define _WIN32_WINNT 0x0400
+#include "unixsupport.h"
+#include <windows.h>
+
+/* Pool of worker threads.
+ *
+ * These functions help to manage a pool of worker threads and submit task to
+ * the pool. It helps to reduce the number of thread creation.
+ *
+ * Each worker are started in alertable wait state and jobs are submitted as
+ * APC (asynchronous procedure call).
+ */
+
+/* Data associated with submitted job */
+typedef struct _WORKER WORKER;
+typedef WORKER *LPWORKER;
+
+/* Function type of submitted job:
+ * void worker_call (HANDLE hStop, void *data)
+ *
+ * This function will be called using the data following:
+ * - hStop must be watched for change, since it represents an external command
+ *   to stop the call. This event is shared through the WORKER structure, which
+ *   can be accessed through worker_job_event_done.
+ * - data is user provided data for the function.
+ */
+typedef void (*WORKERFUNC) (HANDLE, void *);
+
+/* Initialize global data structure for worker
+ */
+void worker_init (void);
+
+/* Free global data structure for worker
+ */
+void worker_cleanup (void);
+
+/* Submit a job to worker. Use returned data to synchronize with the procedure
+ * submitted.
+ */
+LPWORKER worker_job_submit (WORKERFUNC f, void *data);
+
+/* Get event to know when a job is done.
+ */
+HANDLE worker_job_event_done (LPWORKER);
+
+/* Ask a job to stop processing.
+ */
+void worker_job_stop (LPWORKER);
+
+/* End a job submitted to worker.
+ */
+void worker_job_finish (LPWORKER);
+
+#endif /* _WINWORKER_H */
diff --git a/otherlibs/win32unix/write.c b/otherlibs/win32unix/write.c
new file mode 100644
index 00000000..3114763a
--- /dev/null
+++ b/otherlibs/win32unix/write.c
@@ -0,0 +1,101 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <errno.h>
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_write(value fd, value buf, value vofs, value vlen)
+{
+  intnat ofs, len, written;
+  DWORD numbytes, numwritten;
+  char iobuf[UNIX_BUFFER_SIZE];
+  DWORD err = 0;
+
+  Begin_root (buf);
+    ofs = Long_val(vofs);
+    len = Long_val(vlen);
+    written = 0;
+    while (len > 0) {
+      numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len;
+      memmove (iobuf, &Byte(buf, ofs), numbytes);
+      if (Descr_kind_val(fd) == KIND_SOCKET) {
+        int ret;
+        SOCKET s = Socket_val(fd);
+        caml_enter_blocking_section();
+        ret = send(s, iobuf, numbytes, 0);
+        if (ret == SOCKET_ERROR) err = WSAGetLastError();
+        caml_leave_blocking_section();
+        numwritten = ret;
+      } else {
+        HANDLE h = Handle_val(fd);
+        caml_enter_blocking_section();
+        if (! WriteFile(h, iobuf, numbytes, &numwritten, NULL))
+          err = GetLastError();
+        caml_leave_blocking_section();
+      }
+      if (err) {
+        win32_maperr(err);
+        uerror("write", Nothing);
+      }
+      written += numwritten;
+      ofs += numwritten;
+      len -= numwritten;
+    }
+  End_roots();
+  return Val_long(written);
+}
+
+CAMLprim value unix_single_write(value fd, value buf, value vofs, value vlen)
+{
+  intnat ofs, len, written;
+  DWORD numbytes, numwritten;
+  char iobuf[UNIX_BUFFER_SIZE];
+  DWORD err = 0;
+
+  Begin_root (buf);
+    ofs = Long_val(vofs);
+    len = Long_val(vlen);
+    written = 0;
+    if (len > 0) {
+      numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len;
+      memmove (iobuf, &Byte(buf, ofs), numbytes);
+      if (Descr_kind_val(fd) == KIND_SOCKET) {
+        int ret;
+        SOCKET s = Socket_val(fd);
+        caml_enter_blocking_section();
+        ret = send(s, iobuf, numbytes, 0);
+        if (ret == SOCKET_ERROR) err = WSAGetLastError();
+        caml_leave_blocking_section();
+        numwritten = ret;
+      } else {
+        HANDLE h = Handle_val(fd);
+        caml_enter_blocking_section();
+        if (! WriteFile(h, iobuf, numbytes, &numwritten, NULL))
+          err = GetLastError();
+        caml_leave_blocking_section();
+      }
+      if (err) {
+        win32_maperr(err);
+        uerror("single_write", Nothing);
+      }
+      written = numwritten;
+    }
+  End_roots();
+  return Val_long(written);
+}
diff --git a/parsing/CONFLICTS.md b/parsing/CONFLICTS.md
new file mode 100644
index 00000000..b2a84fcb
--- /dev/null
+++ b/parsing/CONFLICTS.md
@@ -0,0 +1,54 @@
+# Conflicts
+
+Some of the conflicts and issues in the grammar are documented here.
+
+## A variant type that lists a single atomic type
+
+Why can't `[t]` be considered a valid atomic type? (A variant type.)
+
+(This is related to MPR #3835.)
+
+A class type that begins with `[t] foo` could continue as follows:
+
+```
+  [t] foo -> <class_type>
+```
+
+Here `t` is understood as a variant type,
+and is used as an actual parameter of the parameterized type `'a foo`.
+
+Or it could continue as follows:
+
+```
+  [t] foo
+```
+
+Here `t` is a type (there is no variant type)
+and is used as an actual parameter of the class `['a] foo`.
+
+After we have read the closing bracket and are looking ahead at `foo`,
+we need to decide which of the above two situations we have. (The first
+situation requires a reduction; the second situation requires shifting.)
+But we cannot decide yet; we would need to look at the arrow `->` beyond
+`foo` in order to decide. In this example LR(2) is required; in general,
+`foo` could be replaced with an arbitrary qualified name, so unbounded
+lookahead is required.
+
+As a result of this issue, we must abandon the idea that `[t]` could be
+a well-formed variant type. In the syntax of atomic types, instead of:
+
+```
+  atomic_type: LBRACKET row_field RBRACKET
+```
+
+we must use the more restricted form:
+
+```
+  atomic_type: LBRACKET tag_field RBRACKET
+```
+
+In other words, we rule out exactly the following:
+
+```
+  atomic_type: LBRACKET atomic_type RBRACKET
+```
diff --git a/parsing/HACKING.adoc b/parsing/HACKING.adoc
new file mode 100644
index 00000000..0566c013
--- /dev/null
+++ b/parsing/HACKING.adoc
@@ -0,0 +1,76 @@
+link:parsetree.mli[Parsetree] and link:asttypes.mli[Asttypes]::
+Parsetree is an Abstract Syntax Tree (AST) representation of OCaml
+source code. It is well annotated with examples and is a recommended
+read before any further exploration of the compiler.
+
+link:location.mli[Location]:: This module contains utilities
+related to locations and error handling. In particular, it contains
+handlers that are used for all the error reporting in the compiler.
+
+link:parser.mly[parser.mly]:: This file contains the grammar used to
+generated the parser -- using the
+link:http://gallium.inria.fr/~fpottier/menhir/[menhir] parser
+generator, which is an external tool that you need to install if you
+wish to modify the parser.
+
+=== Working on the parser grammar
+
+To avoid depending on an external tool, the compiler build system does
+not rebuild the parser from the source grammar link:parser.mly[] each
+time. It works from a versioned copy of the generated parser stored
+in the `boot/menhir` subdirectory.
+
+If you change link:parser.mly[], you need to run the `promote-menhir`
+target of the root Makefile to rebuild the compiler parser. See
+link:../Makefile.menhir[] for the details of the various
+Menhir-related targets and their use.
+
+==== Testing the grammar
+
+The root Makefile contains a `build-all-asts` target that will build,
+for each source `.ml` or `.mli` file in the repository, a `.ml.ast` or
+`.mli.ast` file describing the parsed abstract syntax tree (AST) in
+`-dparsetree` format.
+This rule is rather slow to run, and can safely be run in parallel, so
+we recommend using `-j` (without a number) to maximize parallelism:
+
+----
+make -j build-all-asts
+----
+
+Finally, the 'list-all-asts' target lists all such '.ast' files.
+
+This is intended to be used to test parser changes, in particular
+those that should not modify the parsed AST at all:
+
+1. Before performing any changes, build all AST files and add them to
+   the git index (`make list-all-asts | xargs git add`).
+
+2. Perform any parser change of interest.
+
+3. To test your changes, build AST files again; `git diff` will show
+   any change to an AST file.
+
+4. Before committing any change, remember to remove the `.ast` files
+   from your index (using `git reset HEAD`), and maybe remove them
+   completely (unless you plan to check further changes).
+
+----
+# save pre-change ASTs
+make -j build-all-asts
+make list-all-asts | xargs git add
+
+# do your parser changes
+# ...
+make promote-menhir
+
+# compare new ASTs
+make -j build-all-asts
+git diff # shows any .ml.ast difference
+
+# remove AST files from the index
+make list-all-asts | xargs git reset HEAD
+
+# remove the files (if no further parser change planned)
+make list-all-asts | xargs rm
+----
diff --git a/parsing/VIPs.md b/parsing/VIPs.md
new file mode 100644
index 00000000..baae0244
--- /dev/null
+++ b/parsing/VIPs.md
@@ -0,0 +1,20 @@
+# VIPs
+
+A VIP is a common syntax error, for which a good error message should be
+given.
+
+## Structures versus signatures
+
+Everything that is allowed in a structure but forbidden in a signature,
+or vice-versa, is a VIP. For instance, writing:
+
+```
+  exception A = B
+```
+
+is allowed in a structure, but forbidden in a signature. (Here, we might
+wish to make the error message depend on the lookahead token; the token
+`=` suggests that the user confuses a structure and a signature.)
+
+Similarly, writing `struct` where `sig` is expected, or vice-versa, is
+probably a common mistake.
diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml
new file mode 100644
index 00000000..2d51dda7
--- /dev/null
+++ b/parsing/ast_helper.ml
@@ -0,0 +1,642 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         Alain Frisch, LexiFi                           *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Helpers to produce Parsetree fragments *)
+
+open Asttypes
+open Parsetree
+open Docstrings
+
+type 'a with_loc = 'a Location.loc
+type loc = Location.t
+
+type lid = Longident.t with_loc
+type str = string with_loc
+type str_opt = string option with_loc
+type attrs = attribute list
+
+let default_loc = ref Location.none
+
+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 string ?quotation_delimiter ?(loc= !default_loc) s =
+    Pconst_string (s, loc, quotation_delimiter)
+end
+
+module Attr = struct
+  let mk ?(loc= !default_loc) name payload =
+    { attr_name = name;
+      attr_payload = payload;
+      attr_loc = loc }
+end
+
+module Typ = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    {ptyp_desc = d;
+     ptyp_loc = loc;
+     ptyp_loc_stack = [];
+     ptyp_attributes = attrs}
+
+  let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]}
+
+  let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any
+  let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a)
+  let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c))
+  let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a)
+  let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b))
+  let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b))
+  let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b))
+  let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b))
+  let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c))
+  let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b))
+  let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b))
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a)
+
+  let force_poly t =
+    match t.ptyp_desc with
+    | Ptyp_poly _ -> t
+    | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *)
+
+  let varify_constructors var_names t =
+    let check_variable vl loc v =
+      if List.mem v vl then
+        raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in
+    let var_names = List.map (fun v -> v.txt) var_names in
+    let rec loop t =
+      let desc =
+        match t.ptyp_desc with
+        | Ptyp_any -> Ptyp_any
+        | Ptyp_var x ->
+            check_variable var_names t.ptyp_loc x;
+            Ptyp_var x
+        | Ptyp_arrow (label,core_type,core_type') ->
+            Ptyp_arrow(label, loop core_type, loop core_type')
+        | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
+        | Ptyp_constr( { txt = Longident.Lident s }, [])
+          when List.mem s var_names ->
+            Ptyp_var s
+        | Ptyp_constr(longident, lst) ->
+            Ptyp_constr(longident, List.map loop lst)
+        | Ptyp_object (lst, o) ->
+            Ptyp_object (List.map loop_object_field lst, o)
+        | Ptyp_class (longident, lst) ->
+            Ptyp_class (longident, List.map loop lst)
+        | Ptyp_alias(core_type, string) ->
+            check_variable var_names t.ptyp_loc string;
+            Ptyp_alias(loop core_type, string)
+        | Ptyp_variant(row_field_list, flag, lbl_lst_option) ->
+            Ptyp_variant(List.map loop_row_field row_field_list,
+                         flag, lbl_lst_option)
+        | Ptyp_poly(string_lst, core_type) ->
+          List.iter (fun v ->
+            check_variable var_names t.ptyp_loc v.txt) string_lst;
+            Ptyp_poly(string_lst, loop core_type)
+        | Ptyp_package(longident,lst) ->
+            Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst)
+        | Ptyp_extension (s, arg) ->
+            Ptyp_extension (s, arg)
+      in
+      {t with ptyp_desc = desc}
+    and loop_row_field field =
+      let prf_desc = match field.prf_desc with
+        | Rtag(label,flag,lst) ->
+            Rtag(label,flag,List.map loop lst)
+        | Rinherit t ->
+            Rinherit (loop t)
+      in
+      { field with prf_desc; }
+    and loop_object_field field =
+      let pof_desc = match field.pof_desc with
+        | Otag(label, t) ->
+            Otag(label, loop t)
+        | Oinherit t ->
+            Oinherit (loop t)
+      in
+      { field with pof_desc; }
+    in
+    loop t
+
+end
+
+module Pat = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    {ppat_desc = d;
+     ppat_loc = loc;
+     ppat_loc_stack = [];
+     ppat_attributes = attrs}
+  let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]}
+
+  let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any
+  let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a)
+  let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b))
+  let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a)
+  let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b))
+  let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a)
+  let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b))
+  let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b))
+  let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b))
+  let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a)
+  let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b))
+  let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b))
+  let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a)
+  let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a)
+  let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a)
+  let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b))
+  let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a)
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a)
+end
+
+module Exp = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    {pexp_desc = d;
+     pexp_loc = loc;
+     pexp_loc_stack = [];
+     pexp_attributes = attrs}
+  let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]}
+
+  let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a)
+  let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a)
+  let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c))
+  let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d))
+  let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a)
+  let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b))
+  let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b))
+  let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b))
+  let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a)
+  let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b))
+  let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b))
+  let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b))
+  let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b))
+  let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c))
+  let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a)
+  let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c))
+  let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b))
+  let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b))
+  let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e))
+  let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b))
+  let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c))
+  let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b))
+  let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a)
+  let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b))
+  let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a)
+  let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c))
+  let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b))
+  let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a)
+  let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a)
+  let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b))
+  let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a)
+  let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b))
+  let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a)
+  let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_open (a, b))
+  let letop ?loc ?attrs let_ ands body =
+    mk ?loc ?attrs (Pexp_letop {let_; ands; body})
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a)
+  let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable
+
+  let case lhs ?guard rhs =
+    {
+     pc_lhs = lhs;
+     pc_guard = guard;
+     pc_rhs = rhs;
+    }
+
+  let binding_op op pat exp loc =
+    {
+      pbop_op = op;
+      pbop_pat = pat;
+      pbop_exp = exp;
+      pbop_loc = loc;
+    }
+end
+
+module Mty = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs}
+  let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]}
+
+  let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a)
+  let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a)
+  let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a)
+  let functor_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_functor (a, b))
+  let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b))
+  let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a)
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a)
+end
+
+module Mod = struct
+let mk ?(loc = !default_loc) ?(attrs = []) d =
+  {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs}
+  let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]}
+
+  let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x)
+  let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x)
+  let functor_ ?loc ?attrs arg body =
+    mk ?loc ?attrs (Pmod_functor (arg, body))
+  let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2))
+  let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty))
+  let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e)
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a)
+end
+
+module Sig = struct
+  let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc}
+
+  let value ?loc a = mk ?loc (Psig_value a)
+  let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a))
+  let type_subst ?loc a = mk ?loc (Psig_typesubst a)
+  let type_extension ?loc a = mk ?loc (Psig_typext a)
+  let exception_ ?loc a = mk ?loc (Psig_exception a)
+  let module_ ?loc a = mk ?loc (Psig_module a)
+  let mod_subst ?loc a = mk ?loc (Psig_modsubst a)
+  let rec_module ?loc a = mk ?loc (Psig_recmodule a)
+  let modtype ?loc a = mk ?loc (Psig_modtype a)
+  let open_ ?loc a = mk ?loc (Psig_open a)
+  let include_ ?loc a = mk ?loc (Psig_include a)
+  let class_ ?loc a = mk ?loc (Psig_class a)
+  let class_type ?loc a = mk ?loc (Psig_class_type a)
+  let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs))
+  let attribute ?loc a = mk ?loc (Psig_attribute a)
+  let text txt =
+    let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in
+    List.map
+      (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
+      f_txt
+end
+
+module Str = struct
+  let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc}
+
+  let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs))
+  let value ?loc a b = mk ?loc (Pstr_value (a, b))
+  let primitive ?loc a = mk ?loc (Pstr_primitive a)
+  let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a))
+  let type_extension ?loc a = mk ?loc (Pstr_typext a)
+  let exception_ ?loc a = mk ?loc (Pstr_exception a)
+  let module_ ?loc a = mk ?loc (Pstr_module a)
+  let rec_module ?loc a = mk ?loc (Pstr_recmodule a)
+  let modtype ?loc a = mk ?loc (Pstr_modtype a)
+  let open_ ?loc a = mk ?loc (Pstr_open a)
+  let class_ ?loc a = mk ?loc (Pstr_class a)
+  let class_type ?loc a = mk ?loc (Pstr_class_type a)
+  let include_ ?loc a = mk ?loc (Pstr_include a)
+  let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs))
+  let attribute ?loc a = mk ?loc (Pstr_attribute a)
+  let text txt =
+    let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in
+    List.map
+      (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
+      f_txt
+end
+
+module Cl = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    {
+     pcl_desc = d;
+     pcl_loc = loc;
+     pcl_attributes = attrs;
+    }
+  let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]}
+
+  let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b))
+  let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a)
+  let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d))
+  let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b))
+  let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c))
+  let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b))
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a)
+  let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_open (a, b))
+end
+
+module Cty = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    {
+     pcty_desc = d;
+     pcty_loc = loc;
+     pcty_attributes = attrs;
+    }
+  let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]}
+
+  let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b))
+  let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a)
+  let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c))
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a)
+  let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcty_open (a, b))
+end
+
+module Ctf = struct
+  let mk ?(loc = !default_loc) ?(attrs = [])
+           ?(docs = empty_docs) d =
+    {
+     pctf_desc = d;
+     pctf_loc = loc;
+     pctf_attributes = add_docs_attrs docs attrs;
+    }
+
+  let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a)
+  let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d))
+  let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d))
+  let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b))
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a)
+  let attribute ?loc a = mk ?loc (Pctf_attribute a)
+  let text txt =
+   let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in
+     List.map
+      (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
+      f_txt
+
+  let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]}
+
+end
+
+module Cf = struct
+  let mk ?(loc = !default_loc) ?(attrs = [])
+        ?(docs = empty_docs) d =
+    {
+     pcf_desc = d;
+     pcf_loc = loc;
+     pcf_attributes = add_docs_attrs docs attrs;
+    }
+
+  let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c))
+  let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c))
+  let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c))
+  let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b))
+  let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a)
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a)
+  let attribute ?loc a = mk ?loc (Pcf_attribute a)
+  let text txt =
+    let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in
+    List.map
+      (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
+      f_txt
+
+  let virtual_ ct = Cfk_virtual ct
+  let concrete o e = Cfk_concrete (o, e)
+
+  let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]}
+
+end
+
+module Val = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
+        ?(prim = []) name typ =
+    {
+     pval_name = name;
+     pval_type = typ;
+     pval_attributes = add_docs_attrs docs attrs;
+     pval_loc = loc;
+     pval_prim = prim;
+    }
+end
+
+module Md = struct
+  let mk ?(loc = !default_loc) ?(attrs = [])
+        ?(docs = empty_docs) ?(text = []) name typ =
+    {
+     pmd_name = name;
+     pmd_type = typ;
+     pmd_attributes =
+       add_text_attrs text (add_docs_attrs docs attrs);
+     pmd_loc = loc;
+    }
+end
+
+module Ms = struct
+  let mk ?(loc = !default_loc) ?(attrs = [])
+        ?(docs = empty_docs) ?(text = []) name syn =
+    {
+     pms_name = name;
+     pms_manifest = syn;
+     pms_attributes =
+       add_text_attrs text (add_docs_attrs docs attrs);
+     pms_loc = loc;
+    }
+end
+
+module Mtd = struct
+  let mk ?(loc = !default_loc) ?(attrs = [])
+        ?(docs = empty_docs) ?(text = []) ?typ name =
+    {
+     pmtd_name = name;
+     pmtd_type = typ;
+     pmtd_attributes =
+       add_text_attrs text (add_docs_attrs docs attrs);
+     pmtd_loc = loc;
+    }
+end
+
+module Mb = struct
+  let mk ?(loc = !default_loc) ?(attrs = [])
+        ?(docs = empty_docs) ?(text = []) name expr =
+    {
+     pmb_name = name;
+     pmb_expr = expr;
+     pmb_attributes =
+       add_text_attrs text (add_docs_attrs docs attrs);
+     pmb_loc = loc;
+    }
+end
+
+module Opn = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
+        ?(override = Fresh) expr =
+    {
+     popen_expr = expr;
+     popen_override = override;
+     popen_loc = loc;
+     popen_attributes = add_docs_attrs docs attrs;
+    }
+end
+
+module Incl = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr =
+    {
+     pincl_mod = mexpr;
+     pincl_loc = loc;
+     pincl_attributes = add_docs_attrs docs attrs;
+    }
+
+end
+
+module Vb = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
+        ?(text = []) pat expr =
+    {
+     pvb_pat = pat;
+     pvb_expr = expr;
+     pvb_attributes =
+       add_text_attrs text (add_docs_attrs docs attrs);
+     pvb_loc = loc;
+    }
+end
+
+module Ci = struct
+  let mk ?(loc = !default_loc) ?(attrs = [])
+        ?(docs = empty_docs) ?(text = [])
+        ?(virt = Concrete) ?(params = []) name expr =
+    {
+     pci_virt = virt;
+     pci_params = params;
+     pci_name = name;
+     pci_expr = expr;
+     pci_attributes =
+       add_text_attrs text (add_docs_attrs docs attrs);
+     pci_loc = loc;
+    }
+end
+
+module Type = struct
+  let mk ?(loc = !default_loc) ?(attrs = [])
+        ?(docs = empty_docs) ?(text = [])
+      ?(params = [])
+      ?(cstrs = [])
+      ?(kind = Ptype_abstract)
+      ?(priv = Public)
+      ?manifest
+      name =
+    {
+     ptype_name = name;
+     ptype_params = params;
+     ptype_cstrs = cstrs;
+     ptype_kind = kind;
+     ptype_private = priv;
+     ptype_manifest = manifest;
+     ptype_attributes =
+       add_text_attrs text (add_docs_attrs docs attrs);
+     ptype_loc = loc;
+    }
+
+  let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info)
+        ?(args = Pcstr_tuple []) ?res name =
+    {
+     pcd_name = name;
+     pcd_args = args;
+     pcd_res = res;
+     pcd_loc = loc;
+     pcd_attributes = add_info_attrs info attrs;
+    }
+
+  let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info)
+        ?(mut = Immutable) name typ =
+    {
+     pld_name = name;
+     pld_mutable = mut;
+     pld_type = typ;
+     pld_loc = loc;
+     pld_attributes = add_info_attrs info attrs;
+    }
+
+end
+
+(** Type extensions *)
+module Te = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
+        ?(params = []) ?(priv = Public) path constructors =
+    {
+     ptyext_path = path;
+     ptyext_params = params;
+     ptyext_constructors = constructors;
+     ptyext_private = priv;
+     ptyext_loc = loc;
+     ptyext_attributes = add_docs_attrs docs attrs;
+    }
+
+  let mk_exception ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
+      constructor =
+    {
+     ptyexn_constructor = constructor;
+     ptyexn_loc = loc;
+     ptyexn_attributes = add_docs_attrs docs attrs;
+    }
+
+  let constructor ?(loc = !default_loc) ?(attrs = [])
+        ?(docs = empty_docs) ?(info = empty_info) name kind =
+    {
+     pext_name = name;
+     pext_kind = kind;
+     pext_loc = loc;
+     pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);
+    }
+
+  let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
+             ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name =
+    {
+     pext_name = name;
+     pext_kind = Pext_decl(args, res);
+     pext_loc = loc;
+     pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);
+    }
+
+  let rebind ?(loc = !default_loc) ?(attrs = [])
+        ?(docs = empty_docs) ?(info = empty_info) name lid =
+    {
+     pext_name = name;
+     pext_kind = Pext_rebind lid;
+     pext_loc = loc;
+     pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);
+    }
+
+end
+
+module Csig = struct
+  let mk self fields =
+    {
+     pcsig_self = self;
+     pcsig_fields = fields;
+    }
+end
+
+module Cstr = struct
+  let mk self fields =
+    {
+     pcstr_self = self;
+     pcstr_fields = fields;
+    }
+end
+
+(** Row fields *)
+module Rf = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) desc = {
+    prf_desc = desc;
+    prf_loc = loc;
+    prf_attributes = attrs;
+  }
+  let tag ?loc ?attrs label const tys =
+    mk ?loc ?attrs (Rtag (label, const, tys))
+  let inherit_?loc ty =
+    mk ?loc (Rinherit ty)
+end
+
+(** Object fields *)
+module Of = struct
+  let mk ?(loc = !default_loc) ?(attrs=[]) desc = {
+    pof_desc = desc;
+    pof_loc = loc;
+    pof_attributes = attrs;
+  }
+  let tag ?loc ?attrs label ty =
+    mk ?loc ?attrs (Otag (label, ty))
+  let inherit_ ?loc ty =
+    mk ?loc (Oinherit ty)
+end
diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli
new file mode 100644
index 00000000..330f68ee
--- /dev/null
+++ b/parsing/ast_helper.mli
@@ -0,0 +1,490 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         Alain Frisch, LexiFi                           *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Helpers to produce Parsetree fragments
+
+  {b Warning} This module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Asttypes
+open Docstrings
+open Parsetree
+
+type 'a with_loc = 'a Location.loc
+type loc = Location.t
+
+type lid = Longident.t with_loc
+type str = string with_loc
+type str_opt = string option with_loc
+type attrs = attribute list
+
+(** {1 Default locations} *)
+
+val default_loc: loc ref
+    (** Default value for all optional location arguments. *)
+
+val with_default_loc: loc -> (unit -> 'a) -> 'a
+    (** Set the [default_loc] within the scope of the execution
+        of the provided function. *)
+
+(** {1 Constants} *)
+
+module Const : sig
+  val char : 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
+end
+
+(** {1 Attributes} *)
+module Attr : sig
+  val mk: ?loc:loc -> str -> payload -> attribute
+end
+
+(** {1 Core language} *)
+
+(** Type expressions *)
+module Typ :
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type
+    val attr: core_type -> attribute -> core_type
+
+    val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type
+    val var: ?loc:loc -> ?attrs:attrs -> string -> core_type
+    val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type
+               -> core_type
+    val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type
+    val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
+    val object_: ?loc:loc -> ?attrs:attrs -> object_field list
+                   -> closed_flag -> core_type
+    val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
+    val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type
+    val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag
+                 -> label list option -> core_type
+    val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type
+    val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list
+                 -> core_type
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type
+
+    val force_poly: core_type -> core_type
+
+    val varify_constructors: str list -> core_type -> core_type
+    (** [varify_constructors newtypes te] is type expression [te], of which
+        any of nullary type constructor [tc] is replaced by type variable of
+        the same name, if [tc]'s name appears in [newtypes].
+        Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te]
+        appears in [newtypes].
+        @since 4.05
+     *)
+  end
+
+(** Patterns *)
+module Pat:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern
+    val attr:pattern -> attribute -> pattern
+
+    val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern
+    val var: ?loc:loc -> ?attrs:attrs -> str -> pattern
+    val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern
+    val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern
+    val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern
+    val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern
+    val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern
+    val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern
+    val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag
+                -> pattern
+    val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern
+    val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern
+    val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern
+    val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern
+    val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern
+    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 extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern
+  end
+
+(** Expressions *)
+module Exp:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression
+    val attr: expression -> attribute -> expression
+
+    val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression
+    val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression
+    val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list
+              -> expression -> expression
+    val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option
+              -> pattern -> expression -> expression
+    val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression
+    val apply: ?loc:loc -> ?attrs:attrs -> expression
+               -> (arg_label * expression) list -> expression
+    val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list
+                -> expression
+    val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression
+    val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression
+    val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option
+                   -> expression
+    val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option
+                 -> expression
+    val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list
+                -> expression option -> expression
+    val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression
+    val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression
+                  -> expression
+    val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression
+    val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression
+                    -> expression option -> expression
+    val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression
+                  -> expression
+    val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression
+                -> expression
+    val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression
+              -> direction_flag -> expression -> expression
+    val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option
+                -> core_type -> expression
+    val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type
+                     -> expression
+    val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression
+    val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression
+    val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression
+    val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list
+                  -> expression
+    val letmodule: ?loc:loc -> ?attrs:attrs -> str_opt -> module_expr
+                   -> expression -> expression
+    val letexception:
+      ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression
+      -> expression
+    val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression
+    val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression
+    val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option
+              -> expression
+    val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression
+    val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression
+    val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression
+    val open_: ?loc:loc -> ?attrs:attrs -> open_declaration -> expression
+               -> expression
+    val letop: ?loc:loc -> ?attrs:attrs -> binding_op
+               -> binding_op list -> expression -> expression
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression
+    val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression
+
+    val case: pattern -> ?guard:expression -> expression -> case
+    val binding_op: str -> pattern -> expression -> loc -> binding_op
+  end
+
+(** Value declarations *)
+module Val:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
+      ?prim:string list -> str -> core_type -> value_description
+  end
+
+(** Type declarations *)
+module Type:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+      ?params:(core_type * variance) list ->
+      ?cstrs:(core_type * core_type * loc) list ->
+      ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str ->
+      type_declaration
+
+    val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info ->
+      ?args:constructor_arguments -> ?res:core_type -> str ->
+      constructor_declaration
+    val field: ?loc:loc -> ?attrs:attrs -> ?info:info ->
+      ?mut:mutable_flag -> str -> core_type -> label_declaration
+  end
+
+(** Type extensions *)
+module Te:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
+      ?params:(core_type * variance) list -> ?priv:private_flag ->
+      lid -> extension_constructor list -> type_extension
+
+    val mk_exception: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
+      extension_constructor -> type_exception
+
+    val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info ->
+      str -> extension_constructor_kind -> extension_constructor
+
+    val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info ->
+      ?args:constructor_arguments -> ?res:core_type -> str ->
+      extension_constructor
+    val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info ->
+      str -> lid -> extension_constructor
+  end
+
+(** {1 Module language} *)
+
+(** Module type expressions *)
+module Mty:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type
+    val attr: module_type -> attribute -> module_type
+
+    val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type
+    val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type
+    val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type
+    val functor_: ?loc:loc -> ?attrs:attrs ->
+      functor_parameter -> module_type -> module_type
+    val with_: ?loc:loc -> ?attrs:attrs -> module_type ->
+      with_constraint list -> module_type
+    val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type
+  end
+
+(** Module expressions *)
+module Mod:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr
+    val attr: module_expr -> attribute -> module_expr
+
+    val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr
+    val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr
+    val functor_: ?loc:loc -> ?attrs:attrs ->
+      functor_parameter -> module_expr -> module_expr
+    val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr ->
+      module_expr
+    val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type ->
+      module_expr
+    val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr
+  end
+
+(** Signature items *)
+module Sig:
+  sig
+    val mk: ?loc:loc -> signature_item_desc -> signature_item
+
+    val value: ?loc:loc -> value_description -> signature_item
+    val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item
+    val type_subst: ?loc:loc -> type_declaration list -> signature_item
+    val type_extension: ?loc:loc -> type_extension -> signature_item
+    val exception_: ?loc:loc -> type_exception -> signature_item
+    val module_: ?loc:loc -> module_declaration -> signature_item
+    val mod_subst: ?loc:loc -> module_substitution -> signature_item
+    val rec_module: ?loc:loc -> module_declaration list -> signature_item
+    val modtype: ?loc:loc -> module_type_declaration -> signature_item
+    val open_: ?loc:loc -> open_description -> signature_item
+    val include_: ?loc:loc -> include_description -> signature_item
+    val class_: ?loc:loc -> class_description list -> signature_item
+    val class_type: ?loc:loc -> class_type_declaration list -> signature_item
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item
+    val attribute: ?loc:loc -> attribute -> signature_item
+    val text: text -> signature_item list
+  end
+
+(** Structure items *)
+module Str:
+  sig
+    val mk: ?loc:loc -> structure_item_desc -> structure_item
+
+    val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item
+    val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item
+    val primitive: ?loc:loc -> value_description -> structure_item
+    val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item
+    val type_extension: ?loc:loc -> type_extension -> structure_item
+    val exception_: ?loc:loc -> type_exception -> structure_item
+    val module_: ?loc:loc -> module_binding -> structure_item
+    val rec_module: ?loc:loc -> module_binding list -> structure_item
+    val modtype: ?loc:loc -> module_type_declaration -> structure_item
+    val open_: ?loc:loc -> open_declaration -> structure_item
+    val class_: ?loc:loc -> class_declaration list -> structure_item
+    val class_type: ?loc:loc -> class_type_declaration list -> structure_item
+    val include_: ?loc:loc -> include_declaration -> structure_item
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item
+    val attribute: ?loc:loc -> attribute -> structure_item
+    val text: text -> structure_item list
+  end
+
+(** Module declarations *)
+module Md:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+      str_opt -> module_type -> module_declaration
+  end
+
+(** Module substitutions *)
+module Ms:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+      str -> lid -> module_substitution
+  end
+
+(** Module type declarations *)
+module Mtd:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+      ?typ:module_type -> str -> module_type_declaration
+  end
+
+(** Module bindings *)
+module Mb:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+      str_opt -> module_expr -> module_binding
+  end
+
+(** Opens *)
+module Opn:
+  sig
+    val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs ->
+      ?override:override_flag -> 'a -> 'a open_infos
+  end
+
+(** Includes *)
+module Incl:
+  sig
+    val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos
+  end
+
+(** Value bindings *)
+module Vb:
+  sig
+    val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+      pattern -> expression -> value_binding
+  end
+
+
+(** {1 Class language} *)
+
+(** Class type expressions *)
+module Cty:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type
+    val attr: class_type -> attribute -> class_type
+
+    val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type
+    val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type
+    val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type ->
+      class_type -> class_type
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type
+    val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_type
+               -> class_type
+  end
+
+(** Class type fields *)
+module Ctf:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
+      class_type_field_desc -> class_type_field
+    val attr: class_type_field -> attribute -> class_type_field
+
+    val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field
+    val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag ->
+      virtual_flag -> core_type -> class_type_field
+    val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag ->
+      virtual_flag -> core_type -> class_type_field
+    val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type ->
+      class_type_field
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field
+    val attribute: ?loc:loc -> attribute -> class_type_field
+    val text: text -> class_type_field list
+  end
+
+(** Class expressions *)
+module Cl:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr
+    val attr: class_expr -> attribute -> class_expr
+
+    val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr
+    val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr
+    val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option ->
+      pattern -> class_expr -> class_expr
+    val apply: ?loc:loc -> ?attrs:attrs -> class_expr ->
+      (arg_label * expression) list -> class_expr
+    val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list ->
+      class_expr -> class_expr
+    val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type ->
+      class_expr
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr
+    val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_expr
+               -> class_expr
+  end
+
+(** Class fields *)
+module Cf:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc ->
+      class_field
+    val attr: class_field -> attribute -> class_field
+
+    val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr ->
+      str option -> class_field
+    val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag ->
+      class_field_kind -> class_field
+    val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag ->
+      class_field_kind -> class_field
+    val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type ->
+      class_field
+    val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field
+    val attribute: ?loc:loc -> attribute -> class_field
+    val text: text -> class_field list
+
+    val virtual_: core_type -> class_field_kind
+    val concrete: override_flag -> expression -> class_field_kind
+
+  end
+
+(** Classes *)
+module Ci:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+      ?virt:virtual_flag -> ?params:(core_type * variance) list ->
+      str -> 'a -> 'a class_infos
+  end
+
+(** Class signatures *)
+module Csig:
+  sig
+    val mk: core_type -> class_type_field list -> class_signature
+  end
+
+(** Class structures *)
+module Cstr:
+  sig
+    val mk: pattern -> class_field list -> class_structure
+  end
+
+(** Row fields *)
+module Rf:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> row_field_desc -> row_field
+    val tag: ?loc:loc -> ?attrs:attrs ->
+      label with_loc -> bool -> core_type list -> row_field
+    val inherit_: ?loc:loc -> core_type -> row_field
+  end
+
+(** Object fields *)
+module Of:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs ->
+      object_field_desc -> object_field
+    val tag: ?loc:loc -> ?attrs:attrs ->
+      label with_loc -> core_type -> object_field
+    val inherit_: ?loc:loc -> core_type -> object_field
+  end
diff --git a/parsing/ast_invariants.ml b/parsing/ast_invariants.ml
new file mode 100644
index 00000000..23aa008c
--- /dev/null
+++ b/parsing/ast_invariants.ml
@@ -0,0 +1,187 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Jeremie Dimino, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 2015 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Asttypes
+open Parsetree
+open Ast_iterator
+
+let err = Syntaxerr.ill_formed_ast
+
+let empty_record loc = err loc "Records cannot be empty."
+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 complex_id loc = err loc "Functor application not allowed here."
+
+let simple_longident id =
+  let rec is_simple = function
+    | Longident.Lident _ -> true
+    | Longident.Ldot (id, _) -> is_simple id
+    | Longident.Lapply _ -> false
+  in
+  if not (is_simple id.txt) then complex_id id.loc
+
+let iterator =
+  let super = Ast_iterator.default_iterator in
+  let type_declaration self td =
+    super.type_declaration self td;
+    let loc = td.ptype_loc in
+    match td.ptype_kind with
+    | Ptype_record [] -> empty_record loc
+    | _ -> ()
+  in
+  let typ self ty =
+    super.typ self ty;
+    let loc = ty.ptyp_loc in
+    match ty.ptyp_desc with
+    | Ptyp_tuple ([] | [_]) -> invalid_tuple loc
+    | Ptyp_package (_, cstrs) ->
+      List.iter (fun (id, _) -> simple_longident id) cstrs
+    | _ -> ()
+  in
+  let pat self pat =
+    begin match pat.ppat_desc with
+    | Ppat_construct (_, Some ({ppat_desc = Ppat_tuple _} as p))
+      when Builtin_attributes.explicit_arity pat.ppat_attributes ->
+        super.pat self p (* allow unary tuple, see GPR#523. *)
+    | _ ->
+        super.pat self pat
+    end;
+    let loc = pat.ppat_loc in
+    match pat.ppat_desc with
+    | Ppat_tuple ([] | [_]) -> invalid_tuple loc
+    | Ppat_record ([], _) -> empty_record loc
+    | Ppat_construct (id, _) -> simple_longident id
+    | Ppat_record (fields, _) ->
+      List.iter (fun (id, _) -> simple_longident id) fields
+    | _ -> ()
+  in
+  let expr self exp =
+    begin match exp.pexp_desc with
+    | Pexp_construct (_, Some ({pexp_desc = Pexp_tuple _} as e))
+      when Builtin_attributes.explicit_arity exp.pexp_attributes ->
+        super.expr self e (* allow unary tuple, see GPR#523. *)
+    | _ ->
+        super.expr self exp
+    end;
+    let loc = exp.pexp_loc in
+    match exp.pexp_desc with
+    | Pexp_tuple ([] | [_]) -> invalid_tuple loc
+    | Pexp_record ([], _) -> empty_record loc
+    | Pexp_apply (_, []) -> no_args loc
+    | Pexp_let (_, [], _) -> empty_let loc
+    | Pexp_ident id
+    | Pexp_construct (id, _)
+    | Pexp_field (_, id)
+    | Pexp_setfield (_, id, _)
+    | Pexp_new id -> simple_longident id
+    | Pexp_record (fields, _) ->
+      List.iter (fun (id, _) -> simple_longident id) fields
+    | _ -> ()
+  in
+  let extension_constructor self ec =
+    super.extension_constructor self ec;
+    match ec.pext_kind with
+    | Pext_rebind id -> simple_longident id
+    | _ -> ()
+  in
+  let class_expr self ce =
+    super.class_expr self ce;
+    let loc = ce.pcl_loc in
+    match ce.pcl_desc with
+    | Pcl_apply (_, []) -> no_args loc
+    | Pcl_constr (id, _) -> simple_longident id
+    | _ -> ()
+  in
+  let module_type self mty =
+    super.module_type self mty;
+    match mty.pmty_desc with
+    | Pmty_alias id -> simple_longident id
+    | _ -> ()
+  in
+  let open_description self opn =
+    super.open_description self opn
+  in
+  let with_constraint self wc =
+    super.with_constraint self wc;
+    match wc with
+    | Pwith_type (id, _)
+    | Pwith_module (id, _) -> simple_longident id
+    | _ -> ()
+  in
+  let module_expr self me =
+    super.module_expr self me;
+    match me.pmod_desc with
+    | Pmod_ident id -> simple_longident id
+    | _ -> ()
+  in
+  let structure_item self st =
+    super.structure_item self st;
+    let loc = st.pstr_loc in
+    match st.pstr_desc with
+    | Pstr_type (_, []) -> empty_type loc
+    | Pstr_value (_, []) -> empty_let loc
+    | _ -> ()
+  in
+  let signature_item self sg =
+    super.signature_item self sg;
+    let loc = sg.psig_loc in
+    match sg.psig_desc with
+    | Psig_type (_, []) -> empty_type loc
+    | _ -> ()
+  in
+  let row_field self field =
+    super.row_field self field;
+    let loc = field.prf_loc in
+    match field.prf_desc with
+    | Rtag _ -> ()
+    | Rinherit _ ->
+      if field.prf_attributes = []
+      then ()
+      else err loc
+          "In variant types, attaching attributes to inherited \
+           subtypes is not allowed."
+  in
+  let object_field self field =
+    super.object_field self field;
+    let loc = field.pof_loc in
+    match field.pof_desc with
+    | Otag _ -> ()
+    | Oinherit _ ->
+      if field.pof_attributes = []
+      then ()
+      else err loc
+          "In object types, attaching attributes to inherited \
+           subtypes is not allowed."
+  in
+  { super with
+    type_declaration
+  ; typ
+  ; pat
+  ; expr
+  ; extension_constructor
+  ; class_expr
+  ; module_expr
+  ; module_type
+  ; open_description
+  ; with_constraint
+  ; structure_item
+  ; signature_item
+  ; row_field
+  ; object_field
+  }
+
+let structure st = iterator.structure iterator st
+let signature sg = iterator.signature iterator sg
diff --git a/parsing/ast_invariants.mli b/parsing/ast_invariants.mli
new file mode 100644
index 00000000..fdb56aa5
--- /dev/null
+++ b/parsing/ast_invariants.mli
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Jeremie Dimino, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 2015 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Check AST invariants
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+val structure : Parsetree.structure -> unit
+val signature : Parsetree.signature -> unit
diff --git a/parsing/ast_iterator.ml b/parsing/ast_iterator.ml
new file mode 100644
index 00000000..5f016c00
--- /dev/null
+++ b/parsing/ast_iterator.ml
@@ -0,0 +1,673 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                      Nicolas Ojeda Bar, LexiFi                         *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* A generic Parsetree mapping class *)
+
+(*
+[@@@ocaml.warning "+9"]
+  (* Ensure that record patterns don't miss any field. *)
+*)
+
+
+open Parsetree
+open Location
+
+type iterator = {
+  attribute: iterator -> attribute -> unit;
+  attributes: iterator -> attribute list -> unit;
+  binding_op: iterator -> binding_op -> unit;
+  case: iterator -> case -> unit;
+  cases: iterator -> case list -> unit;
+  class_declaration: iterator -> class_declaration -> unit;
+  class_description: iterator -> class_description -> unit;
+  class_expr: iterator -> class_expr -> unit;
+  class_field: iterator -> class_field -> unit;
+  class_signature: iterator -> class_signature -> unit;
+  class_structure: iterator -> class_structure -> unit;
+  class_type: iterator -> class_type -> unit;
+  class_type_declaration: iterator -> class_type_declaration -> unit;
+  class_type_field: iterator -> class_type_field -> unit;
+  constructor_declaration: iterator -> constructor_declaration -> unit;
+  expr: iterator -> expression -> unit;
+  extension: iterator -> extension -> unit;
+  extension_constructor: iterator -> extension_constructor -> unit;
+  include_declaration: iterator -> include_declaration -> unit;
+  include_description: iterator -> include_description -> unit;
+  label_declaration: iterator -> label_declaration -> unit;
+  location: iterator -> Location.t -> unit;
+  module_binding: iterator -> module_binding -> unit;
+  module_declaration: iterator -> module_declaration -> unit;
+  module_substitution: iterator -> module_substitution -> unit;
+  module_expr: iterator -> module_expr -> unit;
+  module_type: iterator -> module_type -> unit;
+  module_type_declaration: iterator -> module_type_declaration -> unit;
+  open_declaration: iterator -> open_declaration -> unit;
+  open_description: iterator -> open_description -> unit;
+  pat: iterator -> pattern -> unit;
+  payload: iterator -> payload -> unit;
+  signature: iterator -> signature -> unit;
+  signature_item: iterator -> signature_item -> unit;
+  structure: iterator -> structure -> unit;
+  structure_item: iterator -> structure_item -> unit;
+  typ: iterator -> core_type -> unit;
+  row_field: iterator -> row_field -> unit;
+  object_field: iterator -> object_field -> unit;
+  type_declaration: iterator -> type_declaration -> unit;
+  type_extension: iterator -> type_extension -> unit;
+  type_exception: iterator -> type_exception -> unit;
+  type_kind: iterator -> type_kind -> unit;
+  value_binding: iterator -> value_binding -> unit;
+  value_description: iterator -> value_description -> unit;
+  with_constraint: iterator -> with_constraint -> unit;
+}
+(** A [iterator] record implements one "method" per syntactic category,
+    using an open recursion style: each method takes as its first
+    argument the iterator to be applied to children in the syntax
+    tree. *)
+
+let iter_fst f (x, _) = f x
+let iter_snd f (_, y) = f y
+let iter_tuple f1 f2 (x, y) = f1 x; f2 y
+let iter_tuple3 f1 f2 f3 (x, y, z) = f1 x; f2 y; f3 z
+let iter_opt f = function None -> () | Some x -> f x
+
+let iter_loc sub {loc; txt = _} = sub.location sub loc
+
+module T = struct
+  (* Type expressions for the core language *)
+
+  let row_field sub {
+      prf_desc;
+      prf_loc;
+      prf_attributes;
+    } =
+    sub.location sub prf_loc;
+    sub.attributes sub prf_attributes;
+    match prf_desc with
+    | Rtag (_, _, tl) -> List.iter (sub.typ sub) tl
+    | Rinherit t -> sub.typ sub t
+
+  let object_field sub {
+      pof_desc;
+      pof_loc;
+      pof_attributes;
+    } =
+    sub.location sub pof_loc;
+    sub.attributes sub pof_attributes;
+    match pof_desc with
+    | Otag (_, t) -> sub.typ sub t
+    | Oinherit t -> sub.typ sub t
+
+  let iter sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} =
+    sub.location sub loc;
+    sub.attributes sub attrs;
+    match desc with
+    | Ptyp_any
+    | Ptyp_var _ -> ()
+    | Ptyp_arrow (_lab, t1, t2) ->
+        sub.typ sub t1; sub.typ sub t2
+    | Ptyp_tuple tyl -> List.iter (sub.typ sub) tyl
+    | Ptyp_constr (lid, tl) ->
+        iter_loc sub lid; List.iter (sub.typ sub) tl
+    | Ptyp_object (ol, _o) ->
+        List.iter (object_field sub) ol
+    | Ptyp_class (lid, tl) ->
+        iter_loc sub lid; List.iter (sub.typ sub) tl
+    | Ptyp_alias (t, _) -> sub.typ sub t
+    | Ptyp_variant (rl, _b, _ll) ->
+        List.iter (row_field sub) rl
+    | Ptyp_poly (_, t) -> sub.typ sub t
+    | Ptyp_package (lid, l) ->
+        iter_loc sub lid;
+        List.iter (iter_tuple (iter_loc sub) (sub.typ sub)) l
+    | Ptyp_extension x -> sub.extension sub x
+
+  let iter_type_declaration sub
+      {ptype_name; ptype_params; ptype_cstrs;
+       ptype_kind;
+       ptype_private = _;
+       ptype_manifest;
+       ptype_attributes;
+       ptype_loc} =
+    iter_loc sub ptype_name;
+    List.iter (iter_fst (sub.typ sub)) ptype_params;
+    List.iter
+      (iter_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub))
+      ptype_cstrs;
+    sub.type_kind sub ptype_kind;
+    iter_opt (sub.typ sub) ptype_manifest;
+    sub.location sub ptype_loc;
+    sub.attributes sub ptype_attributes
+
+  let iter_type_kind sub = function
+    | Ptype_abstract -> ()
+    | Ptype_variant l ->
+        List.iter (sub.constructor_declaration sub) l
+    | Ptype_record l -> List.iter (sub.label_declaration sub) l
+    | Ptype_open -> ()
+
+  let iter_constructor_arguments sub = function
+    | Pcstr_tuple l -> List.iter (sub.typ sub) l
+    | Pcstr_record l ->
+        List.iter (sub.label_declaration sub) l
+
+  let iter_type_extension sub
+      {ptyext_path; ptyext_params;
+       ptyext_constructors;
+       ptyext_private = _;
+       ptyext_loc;
+       ptyext_attributes} =
+    iter_loc sub ptyext_path;
+    List.iter (sub.extension_constructor sub) ptyext_constructors;
+    List.iter (iter_fst (sub.typ sub)) ptyext_params;
+    sub.location sub ptyext_loc;
+    sub.attributes sub ptyext_attributes
+
+  let iter_type_exception sub
+      {ptyexn_constructor; ptyexn_loc; ptyexn_attributes} =
+    sub.extension_constructor sub ptyexn_constructor;
+    sub.location sub ptyexn_loc;
+    sub.attributes sub ptyexn_attributes
+
+  let iter_extension_constructor_kind sub = function
+      Pext_decl(ctl, cto) ->
+        iter_constructor_arguments sub ctl; iter_opt (sub.typ sub) cto
+    | Pext_rebind li ->
+        iter_loc sub li
+
+  let iter_extension_constructor sub
+      {pext_name;
+       pext_kind;
+       pext_loc;
+       pext_attributes} =
+    iter_loc sub pext_name;
+    iter_extension_constructor_kind sub pext_kind;
+    sub.location sub pext_loc;
+    sub.attributes sub pext_attributes
+
+end
+
+module CT = struct
+  (* Type expressions for the class language *)
+
+  let iter sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} =
+    sub.location sub loc;
+    sub.attributes sub attrs;
+    match desc with
+    | Pcty_constr (lid, tys) ->
+        iter_loc sub lid; List.iter (sub.typ sub) tys
+    | Pcty_signature x -> sub.class_signature sub x
+    | Pcty_arrow (_lab, t, ct) ->
+        sub.typ sub t; sub.class_type sub ct
+    | Pcty_extension x -> sub.extension sub x
+    | Pcty_open (o, e) ->
+        sub.open_description sub o; sub.class_type sub e
+
+  let iter_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs}
+    =
+    sub.location sub loc;
+    sub.attributes sub attrs;
+    match desc with
+    | Pctf_inherit ct -> sub.class_type sub ct
+    | Pctf_val (_s, _m, _v, t) -> sub.typ sub t
+    | Pctf_method (_s, _p, _v, t) -> sub.typ sub t
+    | Pctf_constraint (t1, t2) ->
+        sub.typ sub t1; sub.typ sub t2
+    | Pctf_attribute x -> sub.attribute sub x
+    | Pctf_extension x -> sub.extension sub x
+
+  let iter_signature sub {pcsig_self; pcsig_fields} =
+    sub.typ sub pcsig_self;
+    List.iter (sub.class_type_field sub) pcsig_fields
+end
+
+let iter_functor_param sub = function
+  | Unit -> ()
+  | Named (name, mty) ->
+    iter_loc sub name;
+    sub.module_type sub mty
+
+module MT = struct
+  (* Type expressions for the module language *)
+
+  let iter sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} =
+    sub.location sub loc;
+    sub.attributes sub attrs;
+    match desc with
+    | Pmty_ident s -> iter_loc sub s
+    | Pmty_alias s -> iter_loc sub s
+    | Pmty_signature sg -> sub.signature sub sg
+    | Pmty_functor (param, mt2) ->
+        iter_functor_param sub param;
+        sub.module_type sub mt2
+    | Pmty_with (mt, l) ->
+        sub.module_type sub mt;
+        List.iter (sub.with_constraint sub) l
+    | Pmty_typeof me -> sub.module_expr sub me
+    | Pmty_extension x -> sub.extension sub x
+
+  let iter_with_constraint sub = function
+    | Pwith_type (lid, d) ->
+        iter_loc sub lid; sub.type_declaration sub d
+    | Pwith_module (lid, lid2) ->
+        iter_loc sub lid; iter_loc sub lid2
+    | Pwith_typesubst (lid, d) ->
+        iter_loc sub lid; sub.type_declaration sub d
+    | Pwith_modsubst (s, lid) ->
+        iter_loc sub s; iter_loc sub lid
+
+  let iter_signature_item sub {psig_desc = desc; psig_loc = loc} =
+    sub.location sub loc;
+    match desc with
+    | Psig_value vd -> sub.value_description sub vd
+    | Psig_type (_, l)
+    | Psig_typesubst l ->
+      List.iter (sub.type_declaration sub) l
+    | Psig_typext te -> sub.type_extension sub te
+    | Psig_exception ed -> sub.type_exception sub ed
+    | Psig_module x -> sub.module_declaration sub x
+    | Psig_modsubst x -> sub.module_substitution sub x
+    | Psig_recmodule l ->
+        List.iter (sub.module_declaration sub) l
+    | Psig_modtype x -> sub.module_type_declaration sub x
+    | Psig_open x -> sub.open_description sub x
+    | Psig_include x -> sub.include_description sub x
+    | Psig_class l -> List.iter (sub.class_description sub) l
+    | Psig_class_type l ->
+        List.iter (sub.class_type_declaration sub) l
+    | Psig_extension (x, attrs) ->
+        sub.attributes sub attrs;
+        sub.extension sub x
+    | Psig_attribute x -> sub.attribute sub x
+end
+
+
+module M = struct
+  (* Value expressions for the module language *)
+
+  let iter sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} =
+    sub.location sub loc;
+    sub.attributes sub attrs;
+    match desc with
+    | Pmod_ident x -> iter_loc sub x
+    | Pmod_structure str -> sub.structure sub str
+    | Pmod_functor (param, body) ->
+        iter_functor_param sub param;
+        sub.module_expr sub body
+    | Pmod_apply (m1, m2) ->
+        sub.module_expr sub m1; sub.module_expr sub m2
+    | Pmod_constraint (m, mty) ->
+        sub.module_expr sub m; sub.module_type sub mty
+    | Pmod_unpack e -> sub.expr sub e
+    | Pmod_extension x -> sub.extension sub x
+
+  let iter_structure_item sub {pstr_loc = loc; pstr_desc = desc} =
+    sub.location sub loc;
+    match desc with
+    | Pstr_eval (x, attrs) ->
+        sub.attributes sub attrs; sub.expr sub x
+    | Pstr_value (_r, vbs) -> List.iter (sub.value_binding sub) vbs
+    | Pstr_primitive vd -> sub.value_description sub vd
+    | Pstr_type (_rf, l) -> List.iter (sub.type_declaration sub) l
+    | Pstr_typext te -> sub.type_extension sub te
+    | Pstr_exception ed -> sub.type_exception sub ed
+    | Pstr_module x -> sub.module_binding sub x
+    | Pstr_recmodule l -> List.iter (sub.module_binding sub) l
+    | Pstr_modtype x -> sub.module_type_declaration sub x
+    | Pstr_open x -> sub.open_declaration sub x
+    | Pstr_class l -> List.iter (sub.class_declaration sub) l
+    | Pstr_class_type l ->
+        List.iter (sub.class_type_declaration sub) l
+    | Pstr_include x -> sub.include_declaration sub x
+    | Pstr_extension (x, attrs) ->
+        sub.attributes sub attrs; sub.extension sub x
+    | Pstr_attribute x -> sub.attribute sub x
+end
+
+module E = struct
+  (* Value expressions for the core language *)
+
+  let iter sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} =
+    sub.location sub loc;
+    sub.attributes sub attrs;
+    match desc with
+    | Pexp_ident x -> iter_loc sub x
+    | Pexp_constant _ -> ()
+    | Pexp_let (_r, vbs, e) ->
+        List.iter (sub.value_binding sub) vbs;
+        sub.expr sub e
+    | Pexp_fun (_lab, def, p, e) ->
+        iter_opt (sub.expr sub) def;
+        sub.pat sub p;
+        sub.expr sub e
+    | Pexp_function pel -> sub.cases sub pel
+    | Pexp_apply (e, l) ->
+        sub.expr sub e; List.iter (iter_snd (sub.expr sub)) l
+    | Pexp_match (e, pel) ->
+        sub.expr sub e; sub.cases sub pel
+    | Pexp_try (e, pel) -> sub.expr sub e; sub.cases sub pel
+    | Pexp_tuple el -> List.iter (sub.expr sub) el
+    | Pexp_construct (lid, arg) ->
+        iter_loc sub lid; iter_opt (sub.expr sub) arg
+    | Pexp_variant (_lab, eo) ->
+        iter_opt (sub.expr sub) eo
+    | Pexp_record (l, eo) ->
+        List.iter (iter_tuple (iter_loc sub) (sub.expr sub)) l;
+        iter_opt (sub.expr sub) eo
+    | Pexp_field (e, lid) ->
+        sub.expr sub e; iter_loc sub lid
+    | Pexp_setfield (e1, lid, e2) ->
+        sub.expr sub e1; iter_loc sub lid;
+        sub.expr sub e2
+    | Pexp_array el -> List.iter (sub.expr sub) el
+    | Pexp_ifthenelse (e1, e2, e3) ->
+        sub.expr sub e1; sub.expr sub e2;
+        iter_opt (sub.expr sub) e3
+    | Pexp_sequence (e1, e2) ->
+        sub.expr sub e1; sub.expr sub e2
+    | Pexp_while (e1, e2) ->
+        sub.expr sub e1; sub.expr sub e2
+    | Pexp_for (p, e1, e2, _d, e3) ->
+        sub.pat sub p; sub.expr sub e1; sub.expr sub e2;
+        sub.expr sub e3
+    | Pexp_coerce (e, t1, t2) ->
+        sub.expr sub e; iter_opt (sub.typ sub) t1;
+        sub.typ sub t2
+    | Pexp_constraint (e, t) ->
+        sub.expr sub e; sub.typ sub t
+    | Pexp_send (e, _s) -> sub.expr sub e
+    | Pexp_new lid -> iter_loc sub lid
+    | Pexp_setinstvar (s, e) ->
+        iter_loc sub s; sub.expr sub e
+    | Pexp_override sel ->
+        List.iter (iter_tuple (iter_loc sub) (sub.expr sub)) sel
+    | Pexp_letmodule (s, me, e) ->
+        iter_loc sub s; sub.module_expr sub me;
+        sub.expr sub e
+    | Pexp_letexception (cd, e) ->
+        sub.extension_constructor sub cd;
+        sub.expr sub e
+    | Pexp_assert e -> sub.expr sub e
+    | Pexp_lazy e -> sub.expr sub e
+    | Pexp_poly (e, t) ->
+        sub.expr sub e; iter_opt (sub.typ sub) t
+    | Pexp_object cls -> sub.class_structure sub cls
+    | Pexp_newtype (_s, e) -> sub.expr sub e
+    | Pexp_pack me -> sub.module_expr sub me
+    | Pexp_open (o, e) ->
+        sub.open_declaration sub o; sub.expr sub e
+    | Pexp_letop {let_; ands; body} ->
+        sub.binding_op sub let_;
+        List.iter (sub.binding_op sub) ands;
+        sub.expr sub body
+    | Pexp_extension x -> sub.extension sub x
+    | Pexp_unreachable -> ()
+
+  let iter_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} =
+    iter_loc sub pbop_op;
+    sub.pat sub pbop_pat;
+    sub.expr sub pbop_exp;
+    sub.location sub pbop_loc
+
+end
+
+module P = struct
+  (* Patterns *)
+
+  let iter sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} =
+    sub.location sub loc;
+    sub.attributes sub attrs;
+    match desc with
+    | Ppat_any -> ()
+    | Ppat_var s -> iter_loc sub s
+    | Ppat_alias (p, s) -> sub.pat sub p; iter_loc sub s
+    | Ppat_constant _ -> ()
+    | Ppat_interval _ -> ()
+    | Ppat_tuple pl -> List.iter (sub.pat sub) pl
+    | Ppat_construct (l, p) ->
+        iter_loc sub l; iter_opt (sub.pat sub) p
+    | Ppat_variant (_l, p) -> iter_opt (sub.pat sub) p
+    | Ppat_record (lpl, _cf) ->
+        List.iter (iter_tuple (iter_loc sub) (sub.pat sub)) lpl
+    | Ppat_array pl -> List.iter (sub.pat sub) pl
+    | Ppat_or (p1, p2) -> sub.pat sub p1; sub.pat sub p2
+    | Ppat_constraint (p, t) ->
+        sub.pat sub p; sub.typ sub t
+    | Ppat_type s -> iter_loc sub s
+    | Ppat_lazy p -> sub.pat sub p
+    | Ppat_unpack s -> iter_loc sub s
+    | Ppat_exception p -> sub.pat sub p
+    | Ppat_extension x -> sub.extension sub x
+    | Ppat_open (lid, p) ->
+        iter_loc sub lid; sub.pat sub p
+
+end
+
+module CE = struct
+  (* Value expressions for the class language *)
+
+  let iter sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} =
+    sub.location sub loc;
+    sub.attributes sub attrs;
+    match desc with
+    | Pcl_constr (lid, tys) ->
+        iter_loc sub lid; List.iter (sub.typ sub) tys
+    | Pcl_structure s ->
+        sub.class_structure sub s
+    | Pcl_fun (_lab, e, p, ce) ->
+        iter_opt (sub.expr sub) e;
+        sub.pat sub p;
+        sub.class_expr sub ce
+    | Pcl_apply (ce, l) ->
+        sub.class_expr sub ce;
+        List.iter (iter_snd (sub.expr sub)) l
+    | Pcl_let (_r, vbs, ce) ->
+        List.iter (sub.value_binding sub) vbs;
+        sub.class_expr sub ce
+    | Pcl_constraint (ce, ct) ->
+        sub.class_expr sub ce; sub.class_type sub ct
+    | Pcl_extension x -> sub.extension sub x
+    | Pcl_open (o, e) ->
+        sub.open_description sub o; sub.class_expr sub e
+
+  let iter_kind sub = function
+    | Cfk_concrete (_o, e) -> sub.expr sub e
+    | Cfk_virtual t -> sub.typ sub t
+
+  let iter_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} =
+    sub.location sub loc;
+    sub.attributes sub attrs;
+    match desc with
+    | Pcf_inherit (_o, ce, _s) -> sub.class_expr sub ce
+    | Pcf_val (s, _m, k) -> iter_loc sub s; iter_kind sub k
+    | Pcf_method (s, _p, k) ->
+        iter_loc sub s; iter_kind sub k
+    | Pcf_constraint (t1, t2) ->
+        sub.typ sub t1; sub.typ sub t2
+    | Pcf_initializer e -> sub.expr sub e
+    | Pcf_attribute x -> sub.attribute sub x
+    | Pcf_extension x -> sub.extension sub x
+
+  let iter_structure sub {pcstr_self; pcstr_fields} =
+    sub.pat sub pcstr_self;
+    List.iter (sub.class_field sub) pcstr_fields
+
+  let class_infos sub f {pci_virt = _; pci_params = pl; pci_name; pci_expr;
+                         pci_loc; pci_attributes} =
+    List.iter (iter_fst (sub.typ sub)) pl;
+    iter_loc sub pci_name;
+    f pci_expr;
+    sub.location sub pci_loc;
+    sub.attributes sub pci_attributes
+end
+
+(* Now, a generic AST mapper, to be extended to cover all kinds and
+   cases of the OCaml grammar.  The default behavior of the mapper is
+   the identity. *)
+
+let default_iterator =
+  {
+    structure = (fun this l -> List.iter (this.structure_item this) l);
+    structure_item = M.iter_structure_item;
+    module_expr = M.iter;
+    signature = (fun this l -> List.iter (this.signature_item this) l);
+    signature_item = MT.iter_signature_item;
+    module_type = MT.iter;
+    with_constraint = MT.iter_with_constraint;
+    class_declaration =
+      (fun this -> CE.class_infos this (this.class_expr this));
+    class_expr = CE.iter;
+    class_field = CE.iter_field;
+    class_structure = CE.iter_structure;
+    class_type = CT.iter;
+    class_type_field = CT.iter_field;
+    class_signature = CT.iter_signature;
+    class_type_declaration =
+      (fun this -> CE.class_infos this (this.class_type this));
+    class_description =
+      (fun this -> CE.class_infos this (this.class_type this));
+    type_declaration = T.iter_type_declaration;
+    type_kind = T.iter_type_kind;
+    typ = T.iter;
+    row_field = T.row_field;
+    object_field = T.object_field;
+    type_extension = T.iter_type_extension;
+    type_exception = T.iter_type_exception;
+    extension_constructor = T.iter_extension_constructor;
+    value_description =
+      (fun this {pval_name; pval_type; pval_prim = _; pval_loc;
+                 pval_attributes} ->
+        iter_loc this pval_name;
+        this.typ this pval_type;
+        this.location this pval_loc;
+        this.attributes this pval_attributes;
+      );
+
+    pat = P.iter;
+    expr = E.iter;
+    binding_op = E.iter_binding_op;
+
+    module_declaration =
+      (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} ->
+         iter_loc this pmd_name;
+         this.module_type this pmd_type;
+         this.location this pmd_loc;
+         this.attributes this pmd_attributes;
+      );
+
+    module_substitution =
+      (fun this {pms_name; pms_manifest; pms_attributes; pms_loc} ->
+         iter_loc this pms_name;
+         iter_loc this pms_manifest;
+         this.location this pms_loc;
+         this.attributes this pms_attributes;
+      );
+
+    module_type_declaration =
+      (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} ->
+         iter_loc this pmtd_name;
+         iter_opt (this.module_type this) pmtd_type;
+         this.location this pmtd_loc;
+         this.attributes this pmtd_attributes;
+      );
+
+    module_binding =
+      (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} ->
+         iter_loc this pmb_name; this.module_expr this pmb_expr;
+         this.location this pmb_loc;
+         this.attributes this pmb_attributes;
+      );
+
+    open_declaration =
+      (fun this {popen_expr; popen_override = _; popen_attributes; popen_loc} ->
+         this.module_expr this popen_expr;
+         this.location this popen_loc;
+         this.attributes this popen_attributes
+      );
+
+    open_description =
+      (fun this {popen_expr; popen_override = _; popen_attributes; popen_loc} ->
+         iter_loc this popen_expr;
+         this.location this popen_loc;
+         this.attributes this popen_attributes
+      );
+
+
+    include_description =
+      (fun this {pincl_mod; pincl_attributes; pincl_loc} ->
+         this.module_type this pincl_mod;
+         this.location this pincl_loc;
+         this.attributes this pincl_attributes
+      );
+
+    include_declaration =
+      (fun this {pincl_mod; pincl_attributes; pincl_loc} ->
+         this.module_expr this pincl_mod;
+         this.location this pincl_loc;
+         this.attributes this pincl_attributes
+      );
+
+
+    value_binding =
+      (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} ->
+         this.pat this pvb_pat;
+         this.expr this pvb_expr;
+         this.location this pvb_loc;
+         this.attributes this pvb_attributes
+      );
+
+
+    constructor_declaration =
+      (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} ->
+         iter_loc this pcd_name;
+         T.iter_constructor_arguments this pcd_args;
+         iter_opt (this.typ this) pcd_res;
+         this.location this pcd_loc;
+         this.attributes this pcd_attributes
+      );
+
+    label_declaration =
+      (fun this {pld_name; pld_type; pld_loc; pld_mutable = _; pld_attributes}->
+         iter_loc this pld_name;
+         this.typ this pld_type;
+         this.location this pld_loc;
+         this.attributes this pld_attributes
+      );
+
+    cases = (fun this l -> List.iter (this.case this) l);
+    case =
+      (fun this {pc_lhs; pc_guard; pc_rhs} ->
+         this.pat this pc_lhs;
+         iter_opt (this.expr this) pc_guard;
+         this.expr this pc_rhs
+      );
+
+    location = (fun _this _l -> ());
+
+    extension = (fun this (s, e) -> iter_loc this s; this.payload this e);
+    attribute = (fun this a ->
+      iter_loc this a.attr_name;
+      this.payload this a.attr_payload;
+      this.location this a.attr_loc
+    );
+    attributes = (fun this l -> List.iter (this.attribute this) l);
+    payload =
+      (fun this -> function
+         | PStr x -> this.structure this x
+         | PSig x -> this.signature this x
+         | PTyp x -> this.typ this x
+         | PPat (x, g) -> this.pat this x; iter_opt (this.expr this) g
+      );
+  }
diff --git a/parsing/ast_iterator.mli b/parsing/ast_iterator.mli
new file mode 100644
index 00000000..26308d20
--- /dev/null
+++ b/parsing/ast_iterator.mli
@@ -0,0 +1,83 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                      Nicolas Ojeda Bar, LexiFi                         *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** {!iterator} enables AST inspection using open recursion.  A
+    typical mapper would be based on {!default_iterator}, a trivial iterator,
+    and will fall back on it for handling the syntax it does not modify.
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Parsetree
+
+(** {1 A generic Parsetree iterator} *)
+
+type iterator = {
+  attribute: iterator -> attribute -> unit;
+  attributes: iterator -> attribute list -> unit;
+  binding_op: iterator -> binding_op -> unit;
+  case: iterator -> case -> unit;
+  cases: iterator -> case list -> unit;
+  class_declaration: iterator -> class_declaration -> unit;
+  class_description: iterator -> class_description -> unit;
+  class_expr: iterator -> class_expr -> unit;
+  class_field: iterator -> class_field -> unit;
+  class_signature: iterator -> class_signature -> unit;
+  class_structure: iterator -> class_structure -> unit;
+  class_type: iterator -> class_type -> unit;
+  class_type_declaration: iterator -> class_type_declaration -> unit;
+  class_type_field: iterator -> class_type_field -> unit;
+  constructor_declaration: iterator -> constructor_declaration -> unit;
+  expr: iterator -> expression -> unit;
+  extension: iterator -> extension -> unit;
+  extension_constructor: iterator -> extension_constructor -> unit;
+  include_declaration: iterator -> include_declaration -> unit;
+  include_description: iterator -> include_description -> unit;
+  label_declaration: iterator -> label_declaration -> unit;
+  location: iterator -> Location.t -> unit;
+  module_binding: iterator -> module_binding -> unit;
+  module_declaration: iterator -> module_declaration -> unit;
+  module_substitution: iterator -> module_substitution -> unit;
+  module_expr: iterator -> module_expr -> unit;
+  module_type: iterator -> module_type -> unit;
+  module_type_declaration: iterator -> module_type_declaration -> unit;
+  open_declaration: iterator -> open_declaration -> unit;
+  open_description: iterator -> open_description -> unit;
+  pat: iterator -> pattern -> unit;
+  payload: iterator -> payload -> unit;
+  signature: iterator -> signature -> unit;
+  signature_item: iterator -> signature_item -> unit;
+  structure: iterator -> structure -> unit;
+  structure_item: iterator -> structure_item -> unit;
+  typ: iterator -> core_type -> unit;
+  row_field: iterator -> row_field -> unit;
+  object_field: iterator -> object_field -> unit;
+  type_declaration: iterator -> type_declaration -> unit;
+  type_extension: iterator -> type_extension -> unit;
+  type_exception: iterator -> type_exception -> unit;
+  type_kind: iterator -> type_kind -> unit;
+  value_binding: iterator -> value_binding -> unit;
+  value_description: iterator -> value_description -> unit;
+  with_constraint: iterator -> with_constraint -> unit;
+}
+(** A [iterator] record implements one "method" per syntactic category,
+    using an open recursion style: each method takes as its first
+    argument the iterator to be applied to children in the syntax
+    tree. *)
+
+val default_iterator: iterator
+(** A default iterator, which implements a "do not do anything" mapping. *)
diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml
new file mode 100644
index 00000000..dadf5eaa
--- /dev/null
+++ b/parsing/ast_mapper.ml
@@ -0,0 +1,1068 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         Alain Frisch, LexiFi                           *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* A generic Parsetree mapping class *)
+
+(*
+[@@@ocaml.warning "+9"]
+  (* Ensure that record patterns don't miss any field. *)
+*)
+
+open Parsetree
+open Ast_helper
+open Location
+
+module String = Misc.Stdlib.String
+
+type mapper = {
+  attribute: mapper -> attribute -> attribute;
+  attributes: mapper -> attribute list -> attribute list;
+  binding_op: mapper -> binding_op -> binding_op;
+  case: mapper -> case -> case;
+  cases: mapper -> case list -> case list;
+  class_declaration: mapper -> class_declaration -> class_declaration;
+  class_description: mapper -> class_description -> class_description;
+  class_expr: mapper -> class_expr -> class_expr;
+  class_field: mapper -> class_field -> class_field;
+  class_signature: mapper -> class_signature -> class_signature;
+  class_structure: mapper -> class_structure -> class_structure;
+  class_type: mapper -> class_type -> class_type;
+  class_type_declaration: mapper -> class_type_declaration
+                          -> class_type_declaration;
+  class_type_field: mapper -> class_type_field -> class_type_field;
+  constant: mapper -> constant -> constant;
+  constructor_declaration: mapper -> constructor_declaration
+                           -> constructor_declaration;
+  expr: mapper -> expression -> expression;
+  extension: mapper -> extension -> extension;
+  extension_constructor: mapper -> extension_constructor
+                         -> extension_constructor;
+  include_declaration: mapper -> include_declaration -> include_declaration;
+  include_description: mapper -> include_description -> include_description;
+  label_declaration: mapper -> label_declaration -> label_declaration;
+  location: mapper -> Location.t -> Location.t;
+  module_binding: mapper -> module_binding -> module_binding;
+  module_declaration: mapper -> module_declaration -> module_declaration;
+  module_substitution: mapper -> module_substitution -> module_substitution;
+  module_expr: mapper -> module_expr -> module_expr;
+  module_type: mapper -> module_type -> module_type;
+  module_type_declaration: mapper -> module_type_declaration
+                           -> module_type_declaration;
+  open_declaration: mapper -> open_declaration -> open_declaration;
+  open_description: mapper -> open_description -> open_description;
+  pat: mapper -> pattern -> pattern;
+  payload: mapper -> payload -> payload;
+  signature: mapper -> signature -> signature;
+  signature_item: mapper -> signature_item -> signature_item;
+  structure: mapper -> structure -> structure;
+  structure_item: mapper -> structure_item -> structure_item;
+  typ: mapper -> core_type -> core_type;
+  type_declaration: mapper -> type_declaration -> type_declaration;
+  type_extension: mapper -> type_extension -> type_extension;
+  type_exception: mapper -> type_exception -> type_exception;
+  type_kind: mapper -> type_kind -> type_kind;
+  value_binding: mapper -> value_binding -> value_binding;
+  value_description: mapper -> value_description -> value_description;
+  with_constraint: mapper -> with_constraint -> with_constraint;
+}
+
+let map_fst f (x, y) = (f x, y)
+let map_snd f (x, y) = (x, f y)
+let map_tuple f1 f2 (x, y) = (f1 x, f2 y)
+let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
+let map_opt f = function None -> None | Some x -> Some (f x)
+
+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
+end
+
+module T = struct
+  (* Type expressions for the core language *)
+
+  let row_field sub {
+      prf_desc;
+      prf_loc;
+      prf_attributes;
+    } =
+    let loc = sub.location sub prf_loc in
+    let attrs = sub.attributes sub prf_attributes in
+    let desc = match prf_desc with
+      | Rtag (l, b, tl) -> Rtag (map_loc sub l, b, List.map (sub.typ sub) tl)
+      | Rinherit t -> Rinherit (sub.typ sub t)
+    in
+    Rf.mk ~loc ~attrs desc
+
+  let object_field sub {
+      pof_desc;
+      pof_loc;
+      pof_attributes;
+    } =
+    let loc = sub.location sub pof_loc in
+    let attrs = sub.attributes sub pof_attributes in
+    let desc = match pof_desc with
+      | Otag (l, t) -> Otag (map_loc sub l, sub.typ sub t)
+      | Oinherit t -> Oinherit (sub.typ sub t)
+    in
+    Of.mk ~loc ~attrs desc
+
+  let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} =
+    let open Typ in
+    let loc = sub.location sub loc in
+    let attrs = sub.attributes sub attrs in
+    match desc with
+    | Ptyp_any -> any ~loc ~attrs ()
+    | Ptyp_var s -> var ~loc ~attrs s
+    | Ptyp_arrow (lab, t1, t2) ->
+        arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2)
+    | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl)
+    | Ptyp_constr (lid, tl) ->
+        constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
+    | Ptyp_object (l, o) ->
+        object_ ~loc ~attrs (List.map (object_field sub) l) o
+    | Ptyp_class (lid, tl) ->
+        class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
+    | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s
+    | Ptyp_variant (rl, b, ll) ->
+        variant ~loc ~attrs (List.map (row_field sub) rl) b ll
+    | Ptyp_poly (sl, t) -> poly ~loc ~attrs
+                             (List.map (map_loc sub) sl) (sub.typ sub t)
+    | Ptyp_package (lid, l) ->
+        package ~loc ~attrs (map_loc sub lid)
+          (List.map (map_tuple (map_loc sub) (sub.typ sub)) l)
+    | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x)
+
+  let map_type_declaration sub
+      {ptype_name; ptype_params; ptype_cstrs;
+       ptype_kind;
+       ptype_private;
+       ptype_manifest;
+       ptype_attributes;
+       ptype_loc} =
+    let loc = sub.location sub ptype_loc in
+    let attrs = sub.attributes sub ptype_attributes in
+    Type.mk ~loc ~attrs (map_loc sub ptype_name)
+      ~params:(List.map (map_fst (sub.typ sub)) ptype_params)
+      ~priv:ptype_private
+      ~cstrs:(List.map
+                (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub))
+                ptype_cstrs)
+      ~kind:(sub.type_kind sub ptype_kind)
+      ?manifest:(map_opt (sub.typ sub) ptype_manifest)
+
+  let map_type_kind sub = function
+    | Ptype_abstract -> Ptype_abstract
+    | Ptype_variant l ->
+        Ptype_variant (List.map (sub.constructor_declaration sub) l)
+    | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l)
+    | Ptype_open -> Ptype_open
+
+  let map_constructor_arguments sub = function
+    | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l)
+    | Pcstr_record l ->
+        Pcstr_record (List.map (sub.label_declaration sub) l)
+
+  let map_type_extension sub
+      {ptyext_path; ptyext_params;
+       ptyext_constructors;
+       ptyext_private;
+       ptyext_loc;
+       ptyext_attributes} =
+    let loc = sub.location sub ptyext_loc in
+    let attrs = sub.attributes sub ptyext_attributes in
+    Te.mk ~loc ~attrs
+      (map_loc sub ptyext_path)
+      (List.map (sub.extension_constructor sub) ptyext_constructors)
+      ~params:(List.map (map_fst (sub.typ sub)) ptyext_params)
+      ~priv:ptyext_private
+
+  let map_type_exception sub
+      {ptyexn_constructor; ptyexn_loc; ptyexn_attributes} =
+    let loc = sub.location sub ptyexn_loc in
+    let attrs = sub.attributes sub ptyexn_attributes in
+    Te.mk_exception ~loc ~attrs
+      (sub.extension_constructor sub ptyexn_constructor)
+
+  let map_extension_constructor_kind sub = function
+      Pext_decl(ctl, cto) ->
+        Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto)
+    | Pext_rebind li ->
+        Pext_rebind (map_loc sub li)
+
+  let map_extension_constructor sub
+      {pext_name;
+       pext_kind;
+       pext_loc;
+       pext_attributes} =
+    let loc = sub.location sub pext_loc in
+    let attrs = sub.attributes sub pext_attributes in
+    Te.constructor ~loc ~attrs
+      (map_loc sub pext_name)
+      (map_extension_constructor_kind sub pext_kind)
+
+end
+
+module CT = struct
+  (* Type expressions for the class language *)
+
+  let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} =
+    let open Cty in
+    let loc = sub.location sub loc in
+    let attrs = sub.attributes sub attrs in
+    match desc with
+    | Pcty_constr (lid, tys) ->
+        constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys)
+    | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x)
+    | Pcty_arrow (lab, t, ct) ->
+        arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct)
+    | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x)
+    | Pcty_open (o, ct) ->
+        open_ ~loc ~attrs (sub.open_description sub o) (sub.class_type sub ct)
+
+  let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs}
+    =
+    let open Ctf in
+    let loc = sub.location sub loc in
+    let attrs = sub.attributes sub attrs in
+    match desc with
+    | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct)
+    | Pctf_val (s, m, v, t) ->
+        val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t)
+    | Pctf_method (s, p, v, t) ->
+        method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t)
+    | Pctf_constraint (t1, t2) ->
+        constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2)
+    | Pctf_attribute x -> attribute ~loc (sub.attribute sub x)
+    | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x)
+
+  let map_signature sub {pcsig_self; pcsig_fields} =
+    Csig.mk
+      (sub.typ sub pcsig_self)
+      (List.map (sub.class_type_field sub) pcsig_fields)
+end
+
+let map_functor_param sub = function
+  | Unit -> Unit
+  | Named (s, mt) -> Named (map_loc sub s, sub.module_type sub mt)
+
+module MT = struct
+  (* Type expressions for the module language *)
+
+  let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} =
+    let open Mty in
+    let loc = sub.location sub loc in
+    let attrs = sub.attributes sub attrs in
+    match desc with
+    | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s)
+    | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s)
+    | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg)
+    | Pmty_functor (param, mt) ->
+        functor_ ~loc ~attrs
+          (map_functor_param sub param)
+          (sub.module_type sub mt)
+    | Pmty_with (mt, l) ->
+        with_ ~loc ~attrs (sub.module_type sub mt)
+          (List.map (sub.with_constraint sub) l)
+    | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me)
+    | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x)
+
+  let map_with_constraint sub = function
+    | Pwith_type (lid, d) ->
+        Pwith_type (map_loc sub lid, sub.type_declaration sub d)
+    | Pwith_module (lid, lid2) ->
+        Pwith_module (map_loc sub lid, map_loc sub lid2)
+    | Pwith_typesubst (lid, d) ->
+        Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d)
+    | Pwith_modsubst (s, lid) ->
+        Pwith_modsubst (map_loc sub s, map_loc sub lid)
+
+  let map_signature_item sub {psig_desc = desc; psig_loc = loc} =
+    let open Sig in
+    let loc = sub.location sub loc in
+    match desc with
+    | Psig_value vd -> value ~loc (sub.value_description sub vd)
+    | Psig_type (rf, l) ->
+        type_ ~loc rf (List.map (sub.type_declaration sub) l)
+    | Psig_typesubst l ->
+        type_subst ~loc (List.map (sub.type_declaration sub) l)
+    | Psig_typext te -> type_extension ~loc (sub.type_extension sub te)
+    | Psig_exception ed -> exception_ ~loc (sub.type_exception sub ed)
+    | Psig_module x -> module_ ~loc (sub.module_declaration sub x)
+    | Psig_modsubst x -> mod_subst ~loc (sub.module_substitution sub x)
+    | Psig_recmodule l ->
+        rec_module ~loc (List.map (sub.module_declaration sub) l)
+    | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x)
+    | Psig_open x -> open_ ~loc (sub.open_description sub x)
+    | Psig_include x -> include_ ~loc (sub.include_description sub x)
+    | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l)
+    | Psig_class_type l ->
+        class_type ~loc (List.map (sub.class_type_declaration sub) l)
+    | Psig_extension (x, attrs) ->
+        let attrs = sub.attributes sub attrs in
+        extension ~loc ~attrs (sub.extension sub x)
+    | Psig_attribute x -> attribute ~loc (sub.attribute sub x)
+end
+
+
+module M = struct
+  (* Value expressions for the module language *)
+
+  let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} =
+    let open Mod in
+    let loc = sub.location sub loc in
+    let attrs = sub.attributes sub attrs in
+    match desc with
+    | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x)
+    | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str)
+    | Pmod_functor (param, body) ->
+        functor_ ~loc ~attrs
+          (map_functor_param sub param)
+          (sub.module_expr sub body)
+    | Pmod_apply (m1, m2) ->
+        apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2)
+    | Pmod_constraint (m, mty) ->
+        constraint_ ~loc ~attrs (sub.module_expr sub m)
+                    (sub.module_type sub mty)
+    | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e)
+    | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x)
+
+  let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} =
+    let open Str in
+    let loc = sub.location sub loc in
+    match desc with
+    | Pstr_eval (x, attrs) ->
+        let attrs = sub.attributes sub attrs in
+        eval ~loc ~attrs (sub.expr sub x)
+    | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs)
+    | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd)
+    | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l)
+    | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te)
+    | Pstr_exception ed -> exception_ ~loc (sub.type_exception sub ed)
+    | Pstr_module x -> module_ ~loc (sub.module_binding sub x)
+    | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l)
+    | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x)
+    | Pstr_open x -> open_ ~loc (sub.open_declaration sub x)
+    | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l)
+    | Pstr_class_type l ->
+        class_type ~loc (List.map (sub.class_type_declaration sub) l)
+    | Pstr_include x -> include_ ~loc (sub.include_declaration sub x)
+    | Pstr_extension (x, attrs) ->
+        let attrs = sub.attributes sub attrs in
+        extension ~loc ~attrs (sub.extension sub x)
+    | Pstr_attribute x -> attribute ~loc (sub.attribute sub x)
+end
+
+module E = struct
+  (* Value expressions for the core language *)
+
+  let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} =
+    let open Exp in
+    let loc = sub.location sub loc in
+    let attrs = sub.attributes sub attrs in
+    match desc with
+    | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x)
+    | Pexp_constant x -> constant ~loc ~attrs (sub.constant sub x)
+    | Pexp_let (r, vbs, e) ->
+        let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs)
+          (sub.expr sub e)
+    | Pexp_fun (lab, def, p, e) ->
+        fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p)
+          (sub.expr sub e)
+    | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel)
+    | Pexp_apply (e, l) ->
+        apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l)
+    | Pexp_match (e, pel) ->
+        match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
+    | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
+    | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el)
+    | Pexp_construct (lid, arg) ->
+        construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg)
+    | Pexp_variant (lab, eo) ->
+        variant ~loc ~attrs lab (map_opt (sub.expr sub) eo)
+    | Pexp_record (l, eo) ->
+        record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l)
+          (map_opt (sub.expr sub) eo)
+    | Pexp_field (e, lid) ->
+        field ~loc ~attrs (sub.expr sub e) (map_loc sub lid)
+    | Pexp_setfield (e1, lid, e2) ->
+        setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid)
+          (sub.expr sub e2)
+    | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el)
+    | Pexp_ifthenelse (e1, e2, e3) ->
+        ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2)
+          (map_opt (sub.expr sub) e3)
+    | Pexp_sequence (e1, e2) ->
+        sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2)
+    | Pexp_while (e1, e2) ->
+        while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2)
+    | Pexp_for (p, e1, e2, d, e3) ->
+        for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d
+          (sub.expr sub e3)
+    | Pexp_coerce (e, t1, t2) ->
+        coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1)
+          (sub.typ sub t2)
+    | Pexp_constraint (e, t) ->
+        constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t)
+    | Pexp_send (e, s) ->
+        send ~loc ~attrs (sub.expr sub e) (map_loc sub s)
+    | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid)
+    | Pexp_setinstvar (s, e) ->
+        setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e)
+    | Pexp_override sel ->
+        override ~loc ~attrs
+          (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel)
+    | Pexp_letmodule (s, me, e) ->
+        letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me)
+          (sub.expr sub e)
+    | Pexp_letexception (cd, e) ->
+        letexception ~loc ~attrs
+          (sub.extension_constructor sub cd)
+          (sub.expr sub e)
+    | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e)
+    | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e)
+    | Pexp_poly (e, t) ->
+        poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t)
+    | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls)
+    | Pexp_newtype (s, e) ->
+        newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e)
+    | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me)
+    | Pexp_open (o, e) ->
+        open_ ~loc ~attrs (sub.open_declaration sub o) (sub.expr sub e)
+    | Pexp_letop {let_; ands; body} ->
+        letop ~loc ~attrs (sub.binding_op sub let_)
+          (List.map (sub.binding_op sub) ands) (sub.expr sub body)
+    | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x)
+    | Pexp_unreachable -> unreachable ~loc ~attrs ()
+
+  let map_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} =
+    let open Exp in
+    let op = map_loc sub pbop_op in
+    let pat = sub.pat sub pbop_pat in
+    let exp = sub.expr sub pbop_exp in
+    let loc = sub.location sub pbop_loc in
+    binding_op op pat exp loc
+
+end
+
+module P = struct
+  (* Patterns *)
+
+  let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} =
+    let open Pat in
+    let loc = sub.location sub loc in
+    let attrs = sub.attributes sub attrs in
+    match desc with
+    | Ppat_any -> any ~loc ~attrs ()
+    | Ppat_var s -> var ~loc ~attrs (map_loc sub s)
+    | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s)
+    | Ppat_constant c -> constant ~loc ~attrs (sub.constant sub c)
+    | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2
+    | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl)
+    | Ppat_construct (l, p) ->
+        construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p)
+    | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p)
+    | Ppat_record (lpl, cf) ->
+        record ~loc ~attrs
+               (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf
+    | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl)
+    | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2)
+    | Ppat_constraint (p, t) ->
+        constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t)
+    | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s)
+    | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p)
+    | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s)
+    | Ppat_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_extension x -> extension ~loc ~attrs (sub.extension sub x)
+end
+
+module CE = struct
+  (* Value expressions for the class language *)
+
+  let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} =
+    let open Cl in
+    let loc = sub.location sub loc in
+    let attrs = sub.attributes sub attrs in
+    match desc with
+    | Pcl_constr (lid, tys) ->
+        constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys)
+    | Pcl_structure s ->
+        structure ~loc ~attrs (sub.class_structure sub s)
+    | Pcl_fun (lab, e, p, ce) ->
+        fun_ ~loc ~attrs lab
+          (map_opt (sub.expr sub) e)
+          (sub.pat sub p)
+          (sub.class_expr sub ce)
+    | Pcl_apply (ce, l) ->
+        apply ~loc ~attrs (sub.class_expr sub ce)
+          (List.map (map_snd (sub.expr sub)) l)
+    | Pcl_let (r, vbs, ce) ->
+        let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs)
+          (sub.class_expr sub ce)
+    | Pcl_constraint (ce, ct) ->
+        constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct)
+    | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x)
+    | Pcl_open (o, ce) ->
+        open_ ~loc ~attrs (sub.open_description sub o) (sub.class_expr sub ce)
+
+  let map_kind sub = function
+    | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e)
+    | Cfk_virtual t -> Cfk_virtual (sub.typ sub t)
+
+  let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} =
+    let open Cf in
+    let loc = sub.location sub loc in
+    let attrs = sub.attributes sub attrs in
+    match desc with
+    | Pcf_inherit (o, ce, s) ->
+        inherit_ ~loc ~attrs o (sub.class_expr sub ce)
+          (map_opt (map_loc sub) s)
+    | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k)
+    | Pcf_method (s, p, k) ->
+        method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k)
+    | Pcf_constraint (t1, t2) ->
+        constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2)
+    | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e)
+    | Pcf_attribute x -> attribute ~loc (sub.attribute sub x)
+    | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x)
+
+  let map_structure sub {pcstr_self; pcstr_fields} =
+    {
+      pcstr_self = sub.pat sub pcstr_self;
+      pcstr_fields = List.map (sub.class_field sub) pcstr_fields;
+    }
+
+  let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr;
+                         pci_loc; pci_attributes} =
+    let loc = sub.location sub pci_loc in
+    let attrs = sub.attributes sub pci_attributes in
+    Ci.mk ~loc ~attrs
+     ~virt:pci_virt
+     ~params:(List.map (map_fst (sub.typ sub)) pl)
+      (map_loc sub pci_name)
+      (f pci_expr)
+end
+
+(* Now, a generic AST mapper, to be extended to cover all kinds and
+   cases of the OCaml grammar.  The default behavior of the mapper is
+   the identity. *)
+
+let default_mapper =
+  {
+    constant = C.map;
+    structure = (fun this l -> List.map (this.structure_item this) l);
+    structure_item = M.map_structure_item;
+    module_expr = M.map;
+    signature = (fun this l -> List.map (this.signature_item this) l);
+    signature_item = MT.map_signature_item;
+    module_type = MT.map;
+    with_constraint = MT.map_with_constraint;
+    class_declaration =
+      (fun this -> CE.class_infos this (this.class_expr this));
+    class_expr = CE.map;
+    class_field = CE.map_field;
+    class_structure = CE.map_structure;
+    class_type = CT.map;
+    class_type_field = CT.map_field;
+    class_signature = CT.map_signature;
+    class_type_declaration =
+      (fun this -> CE.class_infos this (this.class_type this));
+    class_description =
+      (fun this -> CE.class_infos this (this.class_type this));
+    type_declaration = T.map_type_declaration;
+    type_kind = T.map_type_kind;
+    typ = T.map;
+    type_extension = T.map_type_extension;
+    type_exception = T.map_type_exception;
+    extension_constructor = T.map_extension_constructor;
+    value_description =
+      (fun this {pval_name; pval_type; pval_prim; pval_loc;
+                 pval_attributes} ->
+        Val.mk
+          (map_loc this pval_name)
+          (this.typ this pval_type)
+          ~attrs:(this.attributes this pval_attributes)
+          ~loc:(this.location this pval_loc)
+          ~prim:pval_prim
+      );
+
+    pat = P.map;
+    expr = E.map;
+    binding_op = E.map_binding_op;
+
+    module_declaration =
+      (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} ->
+         Md.mk
+           (map_loc this pmd_name)
+           (this.module_type this pmd_type)
+           ~attrs:(this.attributes this pmd_attributes)
+           ~loc:(this.location this pmd_loc)
+      );
+
+    module_substitution =
+      (fun this {pms_name; pms_manifest; pms_attributes; pms_loc} ->
+         Ms.mk
+           (map_loc this pms_name)
+           (map_loc this pms_manifest)
+           ~attrs:(this.attributes this pms_attributes)
+           ~loc:(this.location this pms_loc)
+      );
+
+    module_type_declaration =
+      (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} ->
+         Mtd.mk
+           (map_loc this pmtd_name)
+           ?typ:(map_opt (this.module_type this) pmtd_type)
+           ~attrs:(this.attributes this pmtd_attributes)
+           ~loc:(this.location this pmtd_loc)
+      );
+
+    module_binding =
+      (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} ->
+         Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr)
+           ~attrs:(this.attributes this pmb_attributes)
+           ~loc:(this.location this pmb_loc)
+      );
+
+
+    open_declaration =
+      (fun this {popen_expr; popen_override; popen_attributes; popen_loc} ->
+         Opn.mk (this.module_expr this popen_expr)
+           ~override:popen_override
+           ~loc:(this.location this popen_loc)
+           ~attrs:(this.attributes this popen_attributes)
+      );
+
+    open_description =
+      (fun this {popen_expr; popen_override; popen_attributes; popen_loc} ->
+         Opn.mk (map_loc this popen_expr)
+           ~override:popen_override
+           ~loc:(this.location this popen_loc)
+           ~attrs:(this.attributes this popen_attributes)
+      );
+
+    include_description =
+      (fun this {pincl_mod; pincl_attributes; pincl_loc} ->
+         Incl.mk (this.module_type this pincl_mod)
+           ~loc:(this.location this pincl_loc)
+           ~attrs:(this.attributes this pincl_attributes)
+      );
+
+    include_declaration =
+      (fun this {pincl_mod; pincl_attributes; pincl_loc} ->
+         Incl.mk (this.module_expr this pincl_mod)
+           ~loc:(this.location this pincl_loc)
+           ~attrs:(this.attributes this pincl_attributes)
+      );
+
+
+    value_binding =
+      (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} ->
+         Vb.mk
+           (this.pat this pvb_pat)
+           (this.expr this pvb_expr)
+           ~loc:(this.location this pvb_loc)
+           ~attrs:(this.attributes this pvb_attributes)
+      );
+
+
+    constructor_declaration =
+      (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} ->
+        Type.constructor
+          (map_loc this pcd_name)
+          ~args:(T.map_constructor_arguments this pcd_args)
+          ?res:(map_opt (this.typ this) pcd_res)
+          ~loc:(this.location this pcd_loc)
+          ~attrs:(this.attributes this pcd_attributes)
+      );
+
+    label_declaration =
+      (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} ->
+         Type.field
+           (map_loc this pld_name)
+           (this.typ this pld_type)
+           ~mut:pld_mutable
+           ~loc:(this.location this pld_loc)
+           ~attrs:(this.attributes this pld_attributes)
+      );
+
+    cases = (fun this l -> List.map (this.case this) l);
+    case =
+      (fun this {pc_lhs; pc_guard; pc_rhs} ->
+         {
+           pc_lhs = this.pat this pc_lhs;
+           pc_guard = map_opt (this.expr this) pc_guard;
+           pc_rhs = this.expr this pc_rhs;
+         }
+      );
+
+
+
+    location = (fun _this l -> l);
+
+    extension = (fun this (s, e) -> (map_loc this s, this.payload this e));
+    attribute = (fun this a ->
+      {
+        attr_name = map_loc this a.attr_name;
+        attr_payload = this.payload this a.attr_payload;
+        attr_loc = this.location this a.attr_loc
+      }
+    );
+    attributes = (fun this l -> List.map (this.attribute this) l);
+    payload =
+      (fun this -> function
+         | PStr x -> PStr (this.structure this x)
+         | PSig x -> PSig (this.signature this x)
+         | PTyp x -> PTyp (this.typ this x)
+         | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g)
+      );
+  }
+
+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 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)))])
+  in
+  { loc = main.loc; txt = "ocaml.error" },
+  PStr (Str.eval (Exp.constant
+                    (Pconst_string (str_of_pp main.txt, main.loc, None))) ::
+        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)))]))
+
+let cookies = ref String.Map.empty
+
+let get_cookie k =
+  try Some (String.Map.find k !cookies)
+  with Not_found -> None
+
+let set_cookie k v =
+  cookies := String.Map.add k v !cookies
+
+let tool_name_ref = ref "_none_"
+
+let tool_name () = !tool_name_ref
+
+
+module PpxContext = struct
+  open Longident
+  open Asttypes
+  open Ast_helper
+
+  let lid name = { txt = Lident name; loc = Location.none }
+
+  let make_string s = Exp.constant (Const.string s)
+
+  let make_bool x =
+    if x
+    then Exp.construct (lid "true") None
+    else Exp.construct (lid "false") None
+
+  let rec make_list f lst =
+    match lst with
+    | x :: rest ->
+      Exp.construct (lid "::") (Some (Exp.tuple [f x; make_list f rest]))
+    | [] ->
+      Exp.construct (lid "[]") None
+
+  let make_pair f1 f2 (x1, x2) =
+    Exp.tuple [f1 x1; f2 x2]
+
+  let make_option f opt =
+    match opt with
+    | Some x -> Exp.construct (lid "Some") (Some (f x))
+    | None   -> Exp.construct (lid "None") None
+
+  let get_cookies () =
+    lid "cookies",
+    make_list (make_pair make_string (fun x -> x))
+      (String.Map.bindings !cookies)
+
+  let mk fields =
+    {
+      attr_name = { txt = "ocaml.ppx.context"; loc = Location.none };
+      attr_payload = Parsetree.PStr [Str.eval (Exp.record fields None)];
+      attr_loc = Location.none
+    }
+
+  let make ~tool_name () =
+    let fields =
+      [
+        lid "tool_name",    make_string tool_name;
+        lid "include_dirs", make_list make_string !Clflags.include_dirs;
+        lid "load_path",    make_list make_string (Load_path.get_paths ());
+        lid "open_modules", make_list make_string !Clflags.open_modules;
+        lid "for_package",  make_option make_string !Clflags.for_package;
+        lid "debug",        make_bool !Clflags.debug;
+        lid "use_threads",  make_bool !Clflags.use_threads;
+        lid "use_vmthreads", make_bool false;
+        lid "recursive_types", make_bool !Clflags.recursive_types;
+        lid "principal", make_bool !Clflags.principal;
+        lid "transparent_modules", make_bool !Clflags.transparent_modules;
+        lid "unboxed_types", make_bool !Clflags.unboxed_types;
+        lid "unsafe_string", make_bool !Clflags.unsafe_string;
+        get_cookies ()
+      ]
+    in
+    mk fields
+
+  let get_fields = function
+    | PStr [{pstr_desc = Pstr_eval
+                 ({ pexp_desc = Pexp_record (fields, None) }, [])}] ->
+        fields
+    | _ ->
+        raise_errorf "Internal error: invalid [@@@ocaml.ppx.context] syntax"
+
+  let restore fields =
+    let field name payload =
+      let rec get_string = function
+        | { pexp_desc = Pexp_constant (Pconst_string (str, _, None)) } -> str
+        | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
+                             { %s }] string syntax" name
+      and get_bool pexp =
+        match pexp with
+        | {pexp_desc = Pexp_construct ({txt = Longident.Lident "true"},
+                                       None)} ->
+            true
+        | {pexp_desc = Pexp_construct ({txt = Longident.Lident "false"},
+                                       None)} ->
+            false
+        | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
+                             { %s }] bool syntax" name
+      and get_list elem = function
+        | {pexp_desc =
+             Pexp_construct ({txt = Longident.Lident "::"},
+                             Some {pexp_desc = Pexp_tuple [exp; rest]}) } ->
+            elem exp :: get_list elem rest
+        | {pexp_desc =
+             Pexp_construct ({txt = Longident.Lident "[]"}, None)} ->
+            []
+        | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
+                             { %s }] list syntax" name
+      and get_pair f1 f2 = function
+        | {pexp_desc = Pexp_tuple [e1; e2]} ->
+            (f1 e1, f2 e2)
+        | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
+                             { %s }] pair syntax" name
+      and get_option elem = function
+        | { pexp_desc =
+              Pexp_construct ({ txt = Longident.Lident "Some" }, Some exp) } ->
+            Some (elem exp)
+        | { pexp_desc =
+              Pexp_construct ({ txt = Longident.Lident "None" }, None) } ->
+            None
+        | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
+                             { %s }] option syntax" name
+      in
+      match name with
+      | "tool_name" ->
+          tool_name_ref := get_string payload
+      | "include_dirs" ->
+          Clflags.include_dirs := get_list get_string payload
+      | "load_path" ->
+          Load_path.init (get_list get_string payload)
+      | "open_modules" ->
+          Clflags.open_modules := get_list get_string payload
+      | "for_package" ->
+          Clflags.for_package := get_option get_string payload
+      | "debug" ->
+          Clflags.debug := get_bool payload
+      | "use_threads" ->
+          Clflags.use_threads := get_bool payload
+      | "use_vmthreads" ->
+          if get_bool payload then
+            raise_errorf "Internal error: vmthreads not supported after 4.09.0"
+      | "recursive_types" ->
+          Clflags.recursive_types := get_bool payload
+      | "principal" ->
+          Clflags.principal := get_bool payload
+      | "transparent_modules" ->
+          Clflags.transparent_modules := get_bool payload
+      | "unboxed_types" ->
+          Clflags.unboxed_types := get_bool payload
+      | "unsafe_string" ->
+          Clflags.unsafe_string := get_bool payload
+      | "cookies" ->
+          let l = get_list (get_pair get_string (fun x -> x)) payload in
+          cookies :=
+            List.fold_left
+              (fun s (k, v) -> String.Map.add k v s) String.Map.empty
+              l
+      | _ ->
+          ()
+    in
+    List.iter (function ({txt=Lident name}, x) -> field name x | _ -> ()) fields
+
+  let update_cookies fields =
+    let fields =
+      List.filter
+        (function ({txt=Lident "cookies"}, _) -> false | _ -> true)
+        fields
+    in
+    fields @ [get_cookies ()]
+end
+
+let ppx_context = PpxContext.make
+
+let extension_of_exn exn =
+  match error_of_exn exn with
+  | Some (`Ok error) -> extension_of_error error
+  | Some `Already_displayed ->
+      { loc = Location.none; txt = "ocaml.error" }, PStr []
+  | None -> raise exn
+
+
+let apply_lazy ~source ~target mapper =
+  let implem ast =
+    let fields, ast =
+      match ast with
+      | {pstr_desc = Pstr_attribute ({attr_name = {txt = "ocaml.ppx.context"};
+                                      attr_payload = x})} :: l ->
+          PpxContext.get_fields x, l
+      | _ -> [], ast
+    in
+    PpxContext.restore fields;
+    let ast =
+      try
+        let mapper = mapper () in
+        mapper.structure mapper ast
+      with exn ->
+        [{pstr_desc = Pstr_extension (extension_of_exn exn, []);
+          pstr_loc  = Location.none}]
+    in
+    let fields = PpxContext.update_cookies fields in
+    Str.attribute (PpxContext.mk fields) :: ast
+  in
+  let iface ast =
+    let fields, ast =
+      match ast with
+      | {psig_desc = Psig_attribute ({attr_name = {txt = "ocaml.ppx.context"};
+                                      attr_payload = x;
+                                      attr_loc = _})} :: l ->
+          PpxContext.get_fields x, l
+      | _ -> [], ast
+    in
+    PpxContext.restore fields;
+    let ast =
+      try
+        let mapper = mapper () in
+        mapper.signature mapper ast
+      with exn ->
+        [{psig_desc = Psig_extension (extension_of_exn exn, []);
+          psig_loc  = Location.none}]
+    in
+    let fields = PpxContext.update_cookies fields in
+    Sig.attribute (PpxContext.mk fields) :: ast
+  in
+
+  let ic = open_in_bin source in
+  let magic =
+    really_input_string ic (String.length Config.ast_impl_magic_number)
+  in
+
+  let rewrite transform =
+    Location.input_name := input_value ic;
+    let ast = input_value ic in
+    close_in ic;
+    let ast = transform ast in
+    let oc = open_out_bin target in
+    output_string oc magic;
+    output_value oc !Location.input_name;
+    output_value oc ast;
+    close_out oc
+  and fail () =
+    close_in ic;
+    failwith "Ast_mapper: OCaml version mismatch or malformed input";
+  in
+
+  if magic = Config.ast_impl_magic_number then
+    rewrite (implem : structure -> structure)
+  else if magic = Config.ast_intf_magic_number then
+    rewrite (iface : signature -> signature)
+  else fail ()
+
+let drop_ppx_context_str ~restore = function
+  | {pstr_desc = Pstr_attribute
+                   {attr_name = {Location.txt = "ocaml.ppx.context"};
+                    attr_payload = a;
+                    attr_loc = _}}
+    :: items ->
+      if restore then
+        PpxContext.restore (PpxContext.get_fields a);
+      items
+  | items -> items
+
+let drop_ppx_context_sig ~restore = function
+  | {psig_desc = Psig_attribute
+                   {attr_name = {Location.txt = "ocaml.ppx.context"};
+                    attr_payload = a;
+                    attr_loc = _}}
+    :: items ->
+      if restore then
+        PpxContext.restore (PpxContext.get_fields a);
+      items
+  | items -> items
+
+let add_ppx_context_str ~tool_name ast =
+  Ast_helper.Str.attribute (ppx_context ~tool_name ()) :: ast
+
+let add_ppx_context_sig ~tool_name ast =
+  Ast_helper.Sig.attribute (ppx_context ~tool_name ()) :: ast
+
+
+let apply ~source ~target mapper =
+  apply_lazy ~source ~target (fun () -> mapper)
+
+let run_main mapper =
+  try
+    let a = Sys.argv in
+    let n = Array.length a in
+    if n > 2 then
+      let mapper () =
+        try mapper (Array.to_list (Array.sub a 1 (n - 3)))
+        with exn ->
+          (* PR#6463 *)
+          let f _ _ = raise exn in
+          {default_mapper with structure = f; signature = f}
+      in
+      apply_lazy ~source:a.(n - 2) ~target:a.(n - 1) mapper
+    else begin
+      Printf.eprintf "Usage: %s [extra_args] <infile> <outfile>\n%!"
+                     Sys.executable_name;
+      exit 2
+    end
+  with exn ->
+    prerr_endline (Printexc.to_string exn);
+    exit 2
+
+let register_function = ref (fun _name f -> run_main f)
+let register name f = !register_function name f
diff --git a/parsing/ast_mapper.mli b/parsing/ast_mapper.mli
new file mode 100644
index 00000000..69f6b017
--- /dev/null
+++ b/parsing/ast_mapper.mli
@@ -0,0 +1,208 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         Alain Frisch, LexiFi                           *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The interface of a -ppx rewriter
+
+  A -ppx rewriter is a program that accepts a serialized abstract syntax
+  tree and outputs another, possibly modified, abstract syntax tree.
+  This module encapsulates the interface between the compiler and
+  the -ppx rewriters, handling such details as the serialization format,
+  forwarding of command-line flags, and storing state.
+
+  {!mapper} enables AST rewriting using open recursion.
+  A typical mapper would be based on {!default_mapper}, a deep
+  identity mapper, and will fall back on it for handling the syntax it
+  does not modify. For example:
+
+  {[
+open Asttypes
+open Parsetree
+open Ast_mapper
+
+let test_mapper argv =
+  { default_mapper with
+    expr = fun mapper expr ->
+      match expr with
+      | { pexp_desc = Pexp_extension ({ txt = "test" }, PStr [])} ->
+        Ast_helper.Exp.constant (Const_int 42)
+      | other -> default_mapper.expr mapper other; }
+
+let () =
+  register "ppx_test" test_mapper]}
+
+  This -ppx rewriter, which replaces [[%test]] in expressions with
+  the constant [42], can be compiled using
+  [ocamlc -o ppx_test -I +compiler-libs ocamlcommon.cma ppx_test.ml].
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+  *)
+
+open Parsetree
+
+(** {1 A generic Parsetree mapper} *)
+
+type mapper = {
+  attribute: mapper -> attribute -> attribute;
+  attributes: mapper -> attribute list -> attribute list;
+  binding_op: mapper -> binding_op -> binding_op;
+  case: mapper -> case -> case;
+  cases: mapper -> case list -> case list;
+  class_declaration: mapper -> class_declaration -> class_declaration;
+  class_description: mapper -> class_description -> class_description;
+  class_expr: mapper -> class_expr -> class_expr;
+  class_field: mapper -> class_field -> class_field;
+  class_signature: mapper -> class_signature -> class_signature;
+  class_structure: mapper -> class_structure -> class_structure;
+  class_type: mapper -> class_type -> class_type;
+  class_type_declaration: mapper -> class_type_declaration
+                          -> class_type_declaration;
+  class_type_field: mapper -> class_type_field -> class_type_field;
+  constant: mapper -> constant -> constant;
+  constructor_declaration: mapper -> constructor_declaration
+                           -> constructor_declaration;
+  expr: mapper -> expression -> expression;
+  extension: mapper -> extension -> extension;
+  extension_constructor: mapper -> extension_constructor
+                         -> extension_constructor;
+  include_declaration: mapper -> include_declaration -> include_declaration;
+  include_description: mapper -> include_description -> include_description;
+  label_declaration: mapper -> label_declaration -> label_declaration;
+  location: mapper -> Location.t -> Location.t;
+  module_binding: mapper -> module_binding -> module_binding;
+  module_declaration: mapper -> module_declaration -> module_declaration;
+  module_substitution: mapper -> module_substitution -> module_substitution;
+  module_expr: mapper -> module_expr -> module_expr;
+  module_type: mapper -> module_type -> module_type;
+  module_type_declaration: mapper -> module_type_declaration
+                           -> module_type_declaration;
+  open_declaration: mapper -> open_declaration -> open_declaration;
+  open_description: mapper -> open_description -> open_description;
+  pat: mapper -> pattern -> pattern;
+  payload: mapper -> payload -> payload;
+  signature: mapper -> signature -> signature;
+  signature_item: mapper -> signature_item -> signature_item;
+  structure: mapper -> structure -> structure;
+  structure_item: mapper -> structure_item -> structure_item;
+  typ: mapper -> core_type -> core_type;
+  type_declaration: mapper -> type_declaration -> type_declaration;
+  type_extension: mapper -> type_extension -> type_extension;
+  type_exception: mapper -> type_exception -> type_exception;
+  type_kind: mapper -> type_kind -> type_kind;
+  value_binding: mapper -> value_binding -> value_binding;
+  value_description: mapper -> value_description -> value_description;
+  with_constraint: mapper -> with_constraint -> with_constraint;
+}
+(** A mapper record implements one "method" per syntactic category,
+    using an open recursion style: each method takes as its first
+    argument the mapper to be applied to children in the syntax
+    tree. *)
+
+val default_mapper: mapper
+(** A default mapper, which implements a "deep identity" mapping. *)
+
+(** {1 Apply mappers to compilation units} *)
+
+val tool_name: unit -> string
+(** Can be used within a ppx preprocessor to know which tool is
+    calling it ["ocamlc"], ["ocamlopt"], ["ocamldoc"], ["ocamldep"],
+    ["ocaml"], ...  Some global variables that reflect command-line
+    options are automatically synchronized between the calling tool
+    and the ppx preprocessor: {!Clflags.include_dirs},
+    {!Load_path}, {!Clflags.open_modules}, {!Clflags.for_package},
+    {!Clflags.debug}. *)
+
+
+val apply: source:string -> target:string -> mapper -> unit
+(** Apply a mapper (parametrized by the unit name) to a dumped
+    parsetree found in the [source] file and put the result in the
+    [target] file. The [structure] or [signature] field of the mapper
+    is applied to the implementation or interface.  *)
+
+val run_main: (string list -> mapper) -> unit
+(** Entry point to call to implement a standalone -ppx rewriter from a
+    mapper, parametrized by the command line arguments.  The current
+    unit name can be obtained from {!Location.input_name}.  This
+    function implements proper error reporting for uncaught
+    exceptions. *)
+
+(** {1 Registration API} *)
+
+val register_function: (string -> (string list -> mapper) -> unit) ref
+
+val register: string -> (string list -> mapper) -> unit
+(** Apply the [register_function].  The default behavior is to run the
+    mapper immediately, taking arguments from the process command
+    line.  This is to support a scenario where a mapper is linked as a
+    stand-alone executable.
+
+    It is possible to overwrite the [register_function] to define
+    "-ppx drivers", which combine several mappers in a single process.
+    Typically, a driver starts by defining [register_function] to a
+    custom implementation, then lets ppx rewriters (linked statically
+    or dynamically) register themselves, and then run all or some of
+    them.  It is also possible to have -ppx drivers apply rewriters to
+    only specific parts of an AST.
+
+    The first argument to [register] is a symbolic name to be used by
+    the ppx driver.  *)
+
+
+(** {1 Convenience functions to write mappers} *)
+
+val map_opt: ('a -> 'b) -> 'a option -> 'b option
+
+val extension_of_error: Location.error -> extension
+(** Encode an error into an 'ocaml.error' extension node which can be
+    inserted in a generated Parsetree.  The compiler will be
+    responsible for reporting the error. *)
+
+val attribute_of_warning: Location.t -> string -> attribute
+(** Encode a warning message into an 'ocaml.ppwarning' attribute which can be
+    inserted in a generated Parsetree.  The compiler will be
+    responsible for reporting the warning. *)
+
+(** {1 Helper functions to call external mappers} *)
+
+val add_ppx_context_str:
+    tool_name:string -> Parsetree.structure -> Parsetree.structure
+(** Extract information from the current environment and encode it
+    into an attribute which is prepended to the list of structure
+    items in order to pass the information to an external
+    processor. *)
+
+val add_ppx_context_sig:
+    tool_name:string -> Parsetree.signature -> Parsetree.signature
+(** Same as [add_ppx_context_str], but for signatures. *)
+
+val drop_ppx_context_str:
+    restore:bool -> Parsetree.structure -> Parsetree.structure
+(** Drop the ocaml.ppx.context attribute from a structure.  If
+    [restore] is true, also restore the associated data in the current
+    process. *)
+
+val drop_ppx_context_sig:
+    restore:bool -> Parsetree.signature -> Parsetree.signature
+(** Same as [drop_ppx_context_str], but for signatures. *)
+
+(** {1 Cookies} *)
+
+(** Cookies are used to pass information from a ppx processor to
+    a further invocation of itself, when called from the OCaml
+    toplevel (or other tools that support cookies). *)
+
+val set_cookie: string -> Parsetree.expression -> unit
+val get_cookie: string -> Parsetree.expression option
diff --git a/parsing/asttypes.mli b/parsing/asttypes.mli
new file mode 100644
index 00000000..353d7776
--- /dev/null
+++ b/parsing/asttypes.mli
@@ -0,0 +1,63 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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
+  | Invariant
diff --git a/parsing/attr_helper.ml b/parsing/attr_helper.ml
new file mode 100644
index 00000000..0a616cd7
--- /dev/null
+++ b/parsing/attr_helper.ml
@@ -0,0 +1,54 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                  Jeremie Dimino, Jane Street Europe                    *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Asttypes
+open Parsetree
+
+type error =
+  | Multiple_attributes of string
+  | No_payload_expected of string
+
+exception Error of Location.t * error
+
+let get_no_payload_attribute alt_names attrs =
+  match List.filter (fun a -> List.mem a.attr_name.txt alt_names) attrs with
+  | [] -> None
+  | [ {attr_name = name; attr_payload = PStr []; attr_loc = _} ] -> Some name
+  | [ {attr_name = name; _} ] ->
+    raise (Error (name.loc, No_payload_expected name.txt))
+  | _ :: {attr_name = name; _} :: _ ->
+    raise (Error (name.loc, Multiple_attributes name.txt))
+
+let has_no_payload_attribute alt_names attrs =
+  match get_no_payload_attribute alt_names attrs with
+  | None   -> false
+  | Some _ -> true
+
+open Format
+
+let report_error ppf = function
+  | Multiple_attributes name ->
+    fprintf ppf "Too many `%s' attributes" name
+  | No_payload_expected name ->
+    fprintf ppf "Attribute `%s' does not accept a payload" name
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (loc, err) ->
+        Some (Location.error_of_printer ~loc report_error err)
+      | _ ->
+        None
+    )
diff --git a/parsing/attr_helper.mli b/parsing/attr_helper.mli
new file mode 100644
index 00000000..a3ddc0c9
--- /dev/null
+++ b/parsing/attr_helper.mli
@@ -0,0 +1,41 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                  Jeremie Dimino, Jane Street Europe                    *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Helpers for attributes
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Asttypes
+open Parsetree
+
+type error =
+  | Multiple_attributes of string
+  | No_payload_expected of string
+
+(** The [string list] argument of the following functions is a list of
+    alternative names for the attribute we are looking for. For instance:
+
+    {[
+      ["foo"; "ocaml.foo"]
+    ]} *)
+val get_no_payload_attribute : string list -> attributes -> string loc option
+val has_no_payload_attribute : string list -> attributes -> bool
+
+exception Error of Location.t * error
+
+val report_error: Format.formatter -> error -> unit
diff --git a/parsing/builtin_attributes.ml b/parsing/builtin_attributes.ml
new file mode 100644
index 00000000..af495e90
--- /dev/null
+++ b/parsing/builtin_attributes.ml
@@ -0,0 +1,287 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         Alain Frisch, LexiFi                           *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Asttypes
+open Parsetree
+
+let string_of_cst = function
+  | Pconst_string(s, _, _) -> Some s
+  | _ -> None
+
+let string_of_payload = function
+  | PStr[{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant c},_)}] ->
+      string_of_cst c
+  | _ -> None
+
+let string_of_opt_payload p =
+  match string_of_payload p with
+  | Some s -> s
+  | None -> ""
+
+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,_,_))}, _)}
+               ]) ->
+            { Location.loc; txt = fun ppf -> Format.pp_print_text ppf msg }
+        | _ ->
+            { Location.loc; txt = fun ppf ->
+                Format.fprintf ppf
+                  "Invalid syntax for sub-message of extension '%s'." main_txt }
+        end
+    | {pstr_desc=Pstr_extension (({txt; loc}, _), _)} ->
+        { Location.loc; txt = fun ppf ->
+            Format.fprintf ppf "Uninterpreted extension '%s'." txt }
+    | _ ->
+        { Location.loc = main_loc; txt = fun ppf ->
+            Format.fprintf ppf
+              "Invalid syntax for sub-message of extension '%s'." 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,_,_))}, _)}::
+             inner) ->
+          let sub = List.map (submessage_from loc txt) inner in
+          Location.error_of_printer ~loc ~sub Format.pp_print_text msg
+      | _ ->
+          Location.errorf ~loc "Invalid syntax for extension '%s'." txt
+      end
+  | ({txt; loc}, _) ->
+      Location.errorf ~loc "Uninterpreted extension '%s'." txt
+
+let kind_and_message = function
+  | PStr[
+      {pstr_desc=
+         Pstr_eval
+           ({pexp_desc=Pexp_apply
+                 ({pexp_desc=Pexp_ident{txt=Longident.Lident id}},
+                  [Nolabel,{pexp_desc=Pexp_constant (Pconst_string(s,_,_))}])
+            },_)}] ->
+      Some (id, s)
+  | PStr[
+      {pstr_desc=
+         Pstr_eval
+           ({pexp_desc=Pexp_ident{txt=Longident.Lident id}},_)}] ->
+      Some (id, "")
+  | _ -> None
+
+let cat s1 s2 =
+  if s2 = "" then s1 else s1 ^ "\n" ^ s2
+
+let alert_attr x =
+  match x.attr_name.txt with
+  | "ocaml.deprecated"|"deprecated" ->
+      Some (x, "deprecated", string_of_opt_payload x.attr_payload)
+  | "ocaml.alert"|"alert" ->
+      begin match kind_and_message x.attr_payload with
+      | Some (kind, message) -> Some (x, kind, message)
+      | None -> None (* note: bad payloads detected by warning_attribute *)
+      end
+  | _ -> None
+
+let alert_attrs l =
+  List.filter_map alert_attr l
+
+let alerts_of_attrs l =
+  List.fold_left
+    (fun acc (_, kind, message) ->
+       let upd = function
+         | None | Some "" -> Some message
+         | Some s -> Some (cat s message)
+       in
+       Misc.Stdlib.String.Map.update kind upd acc
+    )
+    Misc.Stdlib.String.Map.empty
+    (alert_attrs l)
+
+let check_alerts loc attrs s =
+  Misc.Stdlib.String.Map.iter
+    (fun kind message -> Location.alert loc ~kind (cat s message))
+    (alerts_of_attrs attrs)
+
+let check_alerts_inclusion ~def ~use loc attrs1 attrs2 s =
+  let m2 = alerts_of_attrs attrs2 in
+  Misc.Stdlib.String.Map.iter
+    (fun kind msg ->
+       if not (Misc.Stdlib.String.Map.mem kind m2) then
+         Location.alert ~def ~use ~kind loc (cat s msg)
+    )
+    (alerts_of_attrs attrs1)
+
+let rec deprecated_mutable_of_attrs = function
+  | [] -> None
+  | {attr_name =  {txt = "ocaml.deprecated_mutable"|"deprecated_mutable"; _};
+     attr_payload = p} :: _ ->
+     Some (string_of_opt_payload p)
+  | _ :: tl -> deprecated_mutable_of_attrs tl
+
+let check_deprecated_mutable loc attrs s =
+  match deprecated_mutable_of_attrs attrs with
+  | None -> ()
+  | Some txt ->
+      Location.deprecated loc (Printf.sprintf "mutating field %s" (cat s txt))
+
+let check_deprecated_mutable_inclusion ~def ~use loc attrs1 attrs2 s =
+  match deprecated_mutable_of_attrs attrs1,
+        deprecated_mutable_of_attrs attrs2
+  with
+  | None, _ | Some _, Some _ -> ()
+  | Some txt, None ->
+      Location.deprecated ~def ~use loc
+        (Printf.sprintf "mutating field %s" (cat s txt))
+
+let rec attrs_of_sig = function
+  | {psig_desc = Psig_attribute a} :: tl ->
+      a :: attrs_of_sig tl
+  | _ ->
+      []
+
+let alerts_of_sig sg = alerts_of_attrs (attrs_of_sig sg)
+
+let rec attrs_of_str = function
+  | {pstr_desc = Pstr_attribute a} :: tl ->
+      a :: attrs_of_str tl
+  | _ ->
+      []
+
+let alerts_of_str str = alerts_of_attrs (attrs_of_str str)
+
+let check_no_alert attrs =
+  List.iter
+    (fun (a, _, _) ->
+       Location.prerr_warning a.attr_loc
+         (Warnings.Misplaced_attribute a.attr_name.txt)
+    )
+    (alert_attrs attrs)
+
+let warn_payload loc txt msg =
+  Location.prerr_warning loc (Warnings.Attribute_payload (txt, msg))
+
+let warning_attribute ?(ppwarning = true) =
+  let process loc txt errflag payload =
+    match string_of_payload payload with
+    | Some s ->
+        begin try Warnings.parse_options errflag s
+        with Arg.Bad msg -> warn_payload loc txt msg
+        end
+    | None ->
+        warn_payload loc txt "A single string literal is expected"
+  in
+  let process_alert loc txt = function
+    | PStr[{pstr_desc=
+              Pstr_eval(
+                {pexp_desc=Pexp_constant(Pconst_string(s,_,_))},
+                _)
+           }] ->
+        begin try Warnings.parse_alert_option s
+        with Arg.Bad msg -> warn_payload loc txt msg
+        end
+    | k ->
+        match kind_and_message k with
+        | Some ("all", _) ->
+            warn_payload loc txt "The alert name 'all' is reserved"
+        | Some _ -> ()
+        | None -> warn_payload loc txt "Invalid payload"
+  in
+  function
+  | {attr_name = {txt = ("ocaml.warning"|"warning") as txt; _};
+     attr_loc;
+     attr_payload;
+     } ->
+      process attr_loc txt false attr_payload
+  | {attr_name = {txt = ("ocaml.warnerror"|"warnerror") as txt; _};
+     attr_loc;
+     attr_payload
+    } ->
+      process attr_loc txt true attr_payload
+  | {attr_name = {txt="ocaml.ppwarning"|"ppwarning"; _};
+     attr_loc = _;
+     attr_payload =
+       PStr [
+         { pstr_desc=
+             Pstr_eval({pexp_desc=Pexp_constant (Pconst_string (s, _, _))},_);
+           pstr_loc }
+       ];
+    } when ppwarning ->
+     Location.prerr_warning pstr_loc (Warnings.Preprocessor s)
+  | {attr_name = {txt = ("ocaml.alert"|"alert") as txt; _};
+     attr_loc;
+     attr_payload;
+     } ->
+      process_alert attr_loc txt attr_payload
+  | _ ->
+     ()
+
+let warning_scope ?ppwarning attrs f =
+  let prev = Warnings.backup () in
+  try
+    List.iter (warning_attribute ?ppwarning) (List.rev attrs);
+    let ret = f () in
+    Warnings.restore prev;
+    ret
+  with exn ->
+    Warnings.restore prev;
+    raise exn
+
+
+let warn_on_literal_pattern =
+  List.exists
+    (fun a -> match a.attr_name.txt with
+       | "ocaml.warn_on_literal_pattern"|"warn_on_literal_pattern" -> true
+       | _ -> false
+    )
+
+let explicit_arity =
+  List.exists
+    (fun a -> match a.attr_name.txt with
+       | "ocaml.explicit_arity"|"explicit_arity" -> true
+       | _ -> false
+    )
+
+let immediate =
+  List.exists
+    (fun a -> match a.attr_name.txt with
+       | "ocaml.immediate"|"immediate" -> true
+       | _ -> false
+    )
+
+let immediate64 =
+  List.exists
+    (fun a -> match a.attr_name.txt with
+       | "ocaml.immediate64"|"immediate64" -> true
+       | _ -> false
+    )
+
+(* The "ocaml.boxed (default)" and "ocaml.unboxed (default)"
+   attributes cannot be input by the user, they are added by the
+   compiler when applying the default setting. This is done to record
+   in the .cmi the default used by the compiler when compiling the
+   source file because the default can change between compiler
+   invocations. *)
+
+let check l a = List.mem a.attr_name.txt l
+
+let has_unboxed attr =
+  List.exists (check ["ocaml.unboxed"; "unboxed"])
+    attr
+
+let has_boxed attr =
+  List.exists (check ["ocaml.boxed"; "boxed"]) attr
diff --git a/parsing/builtin_attributes.mli b/parsing/builtin_attributes.mli
new file mode 100644
index 00000000..6200fd74
--- /dev/null
+++ b/parsing/builtin_attributes.mli
@@ -0,0 +1,84 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         Alain Frisch, LexiFi                           *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Support for some of the builtin attributes
+
+    - ocaml.deprecated
+    - ocaml.alert
+    - ocaml.error
+    - ocaml.ppwarning
+    - ocaml.warning
+    - ocaml.warnerror
+    - ocaml.explicit_arity (for camlp4/camlp5)
+    - ocaml.warn_on_literal_pattern
+    - ocaml.deprecated_mutable
+    - ocaml.immediate
+    - ocaml.immediate64
+    - ocaml.boxed / ocaml.unboxed
+
+    {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+val check_alerts: Location.t -> Parsetree.attributes -> string -> unit
+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 check_deprecated_mutable:
+    Location.t -> Parsetree.attributes -> string -> unit
+val check_deprecated_mutable_inclusion:
+  def:Location.t -> use:Location.t -> Location.t -> Parsetree.attributes ->
+  Parsetree.attributes -> string -> unit
+
+val check_no_alert: Parsetree.attributes -> unit
+
+val error_of_extension: Parsetree.extension -> Location.error
+
+val warning_attribute: ?ppwarning:bool -> Parsetree.attribute -> unit
+  (** Apply warning settings from the specified attribute.
+      "ocaml.warning"/"ocaml.warnerror" (and variants without the prefix)
+      are processed and other attributes are ignored.
+
+      Also implement ocaml.ppwarning (unless ~ppwarning:false is
+      passed).
+  *)
+
+val warning_scope:
+  ?ppwarning:bool ->
+  Parsetree.attributes -> (unit -> 'a) -> 'a
+  (** Execute a function in a new scope for warning settings.  This
+      means that the effect of any call to [warning_attribute] during
+      the execution of this function will be discarded after
+      execution.
+
+      The function also takes a list of attributes which are processed
+      with [warning_attribute] in the fresh scope before the function
+      is executed.
+  *)
+
+val warn_on_literal_pattern: Parsetree.attributes -> bool
+val explicit_arity: Parsetree.attributes -> bool
+
+
+val immediate: Parsetree.attributes -> bool
+val immediate64: Parsetree.attributes -> bool
+
+val has_unboxed: Parsetree.attributes -> bool
+val has_boxed: Parsetree.attributes -> bool
diff --git a/parsing/depend.ml b/parsing/depend.ml
new file mode 100644
index 00000000..f513144b
--- /dev/null
+++ b/parsing/depend.ml
@@ -0,0 +1,588 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1999 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Asttypes
+open Location
+open Longident
+open Parsetree
+module String = Misc.Stdlib.String
+
+let pp_deps = ref []
+
+(* Module resolution map *)
+(* Node (set of imports for this path, map for submodules) *)
+type map_tree = Node of String.Set.t * bound_map
+and  bound_map = map_tree String.Map.t
+let bound = Node (String.Set.empty, String.Map.empty)
+
+(*let get_free (Node (s, _m)) = s*)
+let get_map (Node (_s, m)) = m
+let make_leaf s = Node (String.Set.singleton s, String.Map.empty)
+let make_node m =  Node (String.Set.empty, m)
+let rec weaken_map s (Node(s0,m0)) =
+  Node (String.Set.union s s0, String.Map.map (weaken_map s) m0)
+let rec collect_free (Node (s, m)) =
+  String.Map.fold (fun _ n -> String.Set.union (collect_free n)) m s
+
+(* Returns the imports required to access the structure at path p *)
+(* Only raises Not_found if the head of p is not in the toplevel map *)
+let rec lookup_free p m =
+  match p with
+    [] -> raise Not_found
+  | s::p ->
+      let Node (f, m') = String.Map.find s m  in
+      try lookup_free p m' with Not_found -> f
+
+(* Returns the node corresponding to the structure at path p *)
+let rec lookup_map lid m =
+  match lid with
+    Lident s    -> String.Map.find s m
+  | Ldot (l, s) -> String.Map.find s (get_map (lookup_map l m))
+  | Lapply _    -> raise Not_found
+
+(* Collect free module identifiers in the a.s.t. *)
+
+let free_structure_names = ref String.Set.empty
+
+let add_names s =
+  free_structure_names := String.Set.union s !free_structure_names
+
+let rec add_path bv ?(p=[]) = function
+  | Lident s ->
+      let free =
+        try lookup_free (s::p) bv with Not_found -> String.Set.singleton s
+      in
+      (*String.Set.iter (fun s -> Printf.eprintf "%s " s) free;
+        prerr_endline "";*)
+      add_names free
+  | Ldot(l, s) -> add_path bv ~p:(s::p) l
+  | Lapply(l1, l2) -> add_path bv l1; add_path bv l2
+
+let open_module bv lid =
+  match lookup_map lid bv with
+  | Node (s, m) ->
+      add_names s;
+      String.Map.fold String.Map.add m bv
+  | exception Not_found ->
+      add_path bv lid; bv
+
+let add_parent bv lid =
+  match lid.txt with
+    Ldot(l, _s) -> add_path bv l
+  | _ -> ()
+
+let add = add_parent
+
+let add_module_path bv lid = add_path bv lid.txt
+
+let handle_extension ext =
+  match (fst ext).txt with
+  | "error" | "ocaml.error" ->
+    raise (Location.Error
+             (Builtin_attributes.error_of_extension ext))
+  | _ ->
+    ()
+
+let rec add_type bv ty =
+  match ty.ptyp_desc with
+    Ptyp_any -> ()
+  | Ptyp_var _ -> ()
+  | Ptyp_arrow(_, t1, t2) -> add_type bv t1; add_type bv t2
+  | Ptyp_tuple tl -> List.iter (add_type bv) tl
+  | Ptyp_constr(c, tl) -> add bv c; List.iter (add_type bv) tl
+  | Ptyp_object (fl, _) ->
+      List.iter
+       (fun {pof_desc; _} -> match pof_desc with
+         | Otag (_, t) -> add_type bv t
+         | Oinherit t -> add_type bv t) fl
+  | Ptyp_class(c, tl) -> add bv c; List.iter (add_type bv) tl
+  | Ptyp_alias(t, _) -> add_type bv t
+  | Ptyp_variant(fl, _, _) ->
+      List.iter
+        (fun {prf_desc; _} -> match prf_desc with
+          | Rtag(_, _, stl) -> List.iter (add_type bv) stl
+          | Rinherit sty -> add_type bv sty)
+        fl
+  | Ptyp_poly(_, t) -> add_type bv t
+  | Ptyp_package pt -> add_package_type bv pt
+  | Ptyp_extension e -> handle_extension e
+
+and add_package_type bv (lid, l) =
+  add bv lid;
+  List.iter (add_type bv) (List.map (fun (_, e) -> e) l)
+
+let add_opt add_fn bv = function
+    None -> ()
+  | Some x -> add_fn bv x
+
+let add_constructor_arguments bv = function
+  | Pcstr_tuple l -> List.iter (add_type bv) l
+  | Pcstr_record l -> List.iter (fun l -> add_type bv l.pld_type) l
+
+let add_constructor_decl bv pcd =
+  add_constructor_arguments bv pcd.pcd_args;
+  Option.iter (add_type bv) pcd.pcd_res
+
+let add_type_declaration bv td =
+  List.iter
+    (fun (ty1, ty2, _) -> add_type bv ty1; add_type bv ty2)
+    td.ptype_cstrs;
+  add_opt add_type bv td.ptype_manifest;
+  let add_tkind = function
+    Ptype_abstract -> ()
+  | Ptype_variant cstrs ->
+      List.iter (add_constructor_decl bv) cstrs
+  | Ptype_record lbls ->
+      List.iter (fun pld -> add_type bv pld.pld_type) lbls
+  | Ptype_open -> () in
+  add_tkind td.ptype_kind
+
+let add_extension_constructor bv ext =
+  match ext.pext_kind with
+    Pext_decl(args, rty) ->
+      add_constructor_arguments bv args;
+      Option.iter (add_type bv) rty
+  | Pext_rebind lid -> add bv lid
+
+let add_type_extension bv te =
+  add bv te.ptyext_path;
+  List.iter (add_extension_constructor bv) te.ptyext_constructors
+
+let add_type_exception bv te =
+  add_extension_constructor bv te.ptyexn_constructor
+
+let pattern_bv = ref String.Map.empty
+
+let rec add_pattern bv pat =
+  match pat.ppat_desc with
+    Ppat_any -> ()
+  | Ppat_var _ -> ()
+  | Ppat_alias(p, _) -> add_pattern bv p
+  | Ppat_interval _
+  | Ppat_constant _ -> ()
+  | Ppat_tuple pl -> List.iter (add_pattern bv) pl
+  | Ppat_construct(c, op) -> add bv c; add_opt add_pattern bv op
+  | Ppat_record(pl, _) ->
+      List.iter (fun (lbl, p) -> add bv lbl; add_pattern bv p) pl
+  | Ppat_array pl -> List.iter (add_pattern bv) pl
+  | Ppat_or(p1, p2) -> add_pattern bv p1; add_pattern bv p2
+  | Ppat_constraint(p, ty) -> add_pattern bv p; add_type bv ty
+  | Ppat_variant(_, op) -> add_opt add_pattern bv op
+  | Ppat_type li -> add bv li
+  | Ppat_lazy p -> add_pattern bv p
+  | Ppat_unpack id ->
+      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_exception p -> add_pattern bv p
+  | Ppat_extension e -> handle_extension e
+
+let add_pattern bv pat =
+  pattern_bv := bv;
+  add_pattern bv pat;
+  !pattern_bv
+
+let rec add_expr bv exp =
+  match exp.pexp_desc with
+    Pexp_ident l -> add bv l
+  | Pexp_constant _ -> ()
+  | Pexp_let(rf, pel, e) ->
+      let bv = add_bindings rf bv pel in add_expr bv e
+  | Pexp_fun (_, opte, p, e) ->
+      add_opt add_expr bv opte; add_expr (add_pattern bv p) e
+  | Pexp_function pel ->
+      add_cases bv pel
+  | Pexp_apply(e, el) ->
+      add_expr bv e; List.iter (fun (_,e) -> add_expr bv e) el
+  | Pexp_match(e, pel) -> add_expr bv e; add_cases bv pel
+  | Pexp_try(e, pel) -> add_expr bv e; add_cases bv pel
+  | Pexp_tuple el -> List.iter (add_expr bv) el
+  | Pexp_construct(c, opte) -> add bv c; add_opt add_expr bv opte
+  | Pexp_variant(_, opte) -> add_opt add_expr bv opte
+  | Pexp_record(lblel, opte) ->
+      List.iter (fun (lbl, e) -> add bv lbl; add_expr bv e) lblel;
+      add_opt add_expr bv opte
+  | Pexp_field(e, fld) -> add_expr bv e; add bv fld
+  | Pexp_setfield(e1, fld, e2) -> add_expr bv e1; add bv fld; add_expr bv e2
+  | Pexp_array el -> List.iter (add_expr bv) el
+  | Pexp_ifthenelse(e1, e2, opte3) ->
+      add_expr bv e1; add_expr bv e2; add_opt add_expr bv opte3
+  | Pexp_sequence(e1, e2) -> add_expr bv e1; add_expr bv e2
+  | Pexp_while(e1, e2) -> add_expr bv e1; add_expr bv e2
+  | Pexp_for( _, e1, e2, _, e3) ->
+      add_expr bv e1; add_expr bv e2; add_expr bv e3
+  | Pexp_coerce(e1, oty2, ty3) ->
+      add_expr bv e1;
+      add_opt add_type bv oty2;
+      add_type bv ty3
+  | Pexp_constraint(e1, ty2) ->
+      add_expr bv e1;
+      add_type bv ty2
+  | Pexp_send(e, _m) -> add_expr bv e
+  | Pexp_new li -> add bv li
+  | Pexp_setinstvar(_v, e) -> add_expr bv e
+  | Pexp_override sel -> List.iter (fun (_s, e) -> add_expr bv e) sel
+  | Pexp_letmodule(id, m, e) ->
+      let b = add_module_binding bv m in
+      let bv =
+        match id.txt with
+        | None -> bv
+        | Some id -> String.Map.add id b bv
+      in
+      add_expr bv e
+  | Pexp_letexception(_, e) -> add_expr bv e
+  | Pexp_assert (e) -> add_expr bv e
+  | Pexp_lazy (e) -> add_expr bv e
+  | Pexp_poly (e, t) -> add_expr bv e; add_opt add_type bv t
+  | Pexp_object { pcstr_self = pat; pcstr_fields = fieldl } ->
+      let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl
+  | Pexp_newtype (_, e) -> add_expr bv e
+  | Pexp_pack m -> add_module_expr bv m
+  | Pexp_open (o, e) ->
+      let bv = open_declaration bv o in
+      add_expr bv e
+  | Pexp_letop {let_; ands; body} ->
+      let bv' = add_binding_op bv bv let_ in
+      let bv' = List.fold_left (add_binding_op bv) bv' ands in
+      add_expr bv' body
+  | Pexp_extension (({ txt = ("ocaml.extension_constructor"|
+                              "extension_constructor"); _ },
+                     PStr [item]) as e) ->
+      begin match item.pstr_desc with
+      | Pstr_eval ({ pexp_desc = Pexp_construct (c, None) }, _) -> add bv c
+      | _ -> handle_extension e
+      end
+  | Pexp_extension e -> handle_extension e
+  | Pexp_unreachable -> ()
+
+and add_cases bv cases =
+  List.iter (add_case bv) cases
+
+and add_case bv {pc_lhs; pc_guard; pc_rhs} =
+  let bv = add_pattern bv pc_lhs in
+  add_opt add_expr bv pc_guard;
+  add_expr bv pc_rhs
+
+and add_bindings recf bv pel =
+  let bv' = List.fold_left (fun bv x -> add_pattern bv x.pvb_pat) bv pel in
+  let bv = if recf = Recursive then bv' else bv in
+  List.iter (fun x -> add_expr bv x.pvb_expr) pel;
+  bv'
+
+and add_binding_op bv bv' pbop =
+  add_expr bv pbop.pbop_exp;
+  add_pattern bv' pbop.pbop_pat
+
+and add_modtype bv mty =
+  match mty.pmty_desc with
+    Pmty_ident l -> add bv l
+  | Pmty_alias l -> add_module_path bv l
+  | Pmty_signature s -> add_signature bv s
+  | Pmty_functor(param, mty2) ->
+      let bv =
+        match param with
+        | Unit -> bv
+        | Named (id, mty1) ->
+          add_modtype bv mty1;
+          match id.txt with
+          | None -> bv
+          | Some name -> String.Map.add name bound bv
+      in
+      add_modtype bv mty2
+  | Pmty_with(mty, cstrl) ->
+      add_modtype bv mty;
+      List.iter
+        (function
+          | Pwith_type (_, td) -> add_type_declaration bv td
+          | Pwith_module (_, lid) -> add_module_path bv lid
+          | Pwith_typesubst (_, td) -> add_type_declaration bv td
+          | Pwith_modsubst (_, lid) -> add_module_path bv lid
+        )
+        cstrl
+  | Pmty_typeof m -> add_module_expr bv m
+  | Pmty_extension e -> handle_extension e
+
+and add_module_alias bv l =
+  (* If we are in delayed dependencies mode, we delay the dependencies
+       induced by "Lident s" *)
+  (if !Clflags.transparent_modules then add_parent else add_module_path) bv l;
+  try
+    lookup_map l.txt bv
+  with Not_found ->
+    match l.txt with
+      Lident s -> make_leaf s
+    | _ -> add_module_path bv l; bound (* cannot delay *)
+
+and add_modtype_binding bv mty =
+  match mty.pmty_desc with
+    Pmty_alias l ->
+      add_module_alias bv l
+  | Pmty_signature s ->
+      make_node (add_signature_binding bv s)
+  | Pmty_typeof modl ->
+      add_module_binding bv modl
+  | _ ->
+      add_modtype bv mty; bound
+
+and add_signature bv sg =
+  ignore (add_signature_binding bv sg)
+
+and add_signature_binding bv sg =
+  snd (List.fold_left add_sig_item (bv, String.Map.empty) sg)
+
+and add_sig_item (bv, m) item =
+  match item.psig_desc with
+    Psig_value vd ->
+      add_type bv vd.pval_type; (bv, m)
+  | Psig_type (_, dcls)
+  | Psig_typesubst dcls->
+      List.iter (add_type_declaration bv) dcls; (bv, m)
+  | Psig_typext te ->
+      add_type_extension bv te; (bv, m)
+  | Psig_exception te ->
+      add_type_exception bv te; (bv, m)
+  | Psig_module pmd ->
+      let m' = add_modtype_binding bv pmd.pmd_type in
+      let add map =
+        match pmd.pmd_name.txt with
+        | None -> map
+        | Some name -> String.Map.add name m' map
+      in
+      (add bv, add m)
+  | Psig_modsubst pms ->
+      let m' = add_module_alias bv pms.pms_manifest in
+      let add = String.Map.add pms.pms_name.txt m' in
+      (add bv, add m)
+  | Psig_recmodule decls ->
+      let add =
+        List.fold_right (fun pmd map ->
+          match pmd.pmd_name.txt with
+          | None -> map
+          | Some name -> String.Map.add name bound map
+        ) decls
+      in
+      let bv' = add bv and m' = add m in
+      List.iter (fun pmd -> add_modtype bv' pmd.pmd_type) decls;
+      (bv', m')
+  | Psig_modtype x ->
+      begin match x.pmtd_type with
+        None -> ()
+      | Some mty -> add_modtype bv mty
+      end;
+      (bv, m)
+  | Psig_open od ->
+      (open_description bv od, m)
+  | Psig_include incl ->
+      let Node (s, m') = add_modtype_binding bv incl.pincl_mod in
+      add_names s;
+      let add = String.Map.fold String.Map.add m' in
+      (add bv, add m)
+  | Psig_class cdl ->
+      List.iter (add_class_description bv) cdl; (bv, m)
+  | Psig_class_type cdtl ->
+      List.iter (add_class_type_declaration bv) cdtl; (bv, m)
+  | Psig_attribute _ -> (bv, m)
+  | Psig_extension (e, _) ->
+      handle_extension e;
+      (bv, m)
+
+and open_description bv od =
+  let Node(s, m) = add_module_alias bv od.popen_expr in
+  add_names s;
+  String.Map.fold String.Map.add m bv
+
+and open_declaration bv od =
+  let Node (s, m) = add_module_binding bv od.popen_expr in
+  add_names s;
+  String.Map.fold String.Map.add m bv
+
+and add_module_binding bv modl =
+  match modl.pmod_desc with
+    Pmod_ident l -> add_module_alias bv l
+  | Pmod_structure s ->
+     make_node (snd @@ add_structure_binding bv s)
+  | _ -> add_module_expr bv modl; bound
+
+and add_module_expr bv modl =
+  match modl.pmod_desc with
+    Pmod_ident l -> add_module_path bv l
+  | Pmod_structure s -> ignore (add_structure bv s)
+  | Pmod_functor(param, modl) ->
+      let bv =
+        match param with
+        | Unit -> bv
+        | Named (id, mty) ->
+          add_modtype bv mty;
+          match id.txt with
+          | None -> bv
+          | Some name -> String.Map.add name bound bv
+      in
+      add_module_expr bv modl
+  | Pmod_apply(mod1, mod2) ->
+      add_module_expr bv mod1; add_module_expr bv mod2
+  | Pmod_constraint(modl, mty) ->
+      add_module_expr bv modl; add_modtype bv mty
+  | Pmod_unpack(e) ->
+      add_expr bv e
+  | Pmod_extension e ->
+      handle_extension e
+
+and add_class_type bv cty =
+  match cty.pcty_desc with
+    Pcty_constr(l, tyl) ->
+      add bv l; List.iter (add_type bv) tyl
+  | Pcty_signature { pcsig_self = ty; pcsig_fields = fieldl } ->
+      add_type bv ty;
+      List.iter (add_class_type_field bv) fieldl
+  | Pcty_arrow(_, ty1, cty2) ->
+      add_type bv ty1; add_class_type bv cty2
+  | Pcty_extension e -> handle_extension e
+  | Pcty_open (o, e) ->
+      let bv = open_description bv o in
+      add_class_type bv e
+
+and add_class_type_field bv pctf =
+  match pctf.pctf_desc with
+    Pctf_inherit cty -> add_class_type bv cty
+  | Pctf_val(_, _, _, ty) -> add_type bv ty
+  | Pctf_method(_, _, _, ty) -> add_type bv ty
+  | Pctf_constraint(ty1, ty2) -> add_type bv ty1; add_type bv ty2
+  | Pctf_attribute _ -> ()
+  | Pctf_extension e -> handle_extension e
+
+and add_class_description bv infos =
+  add_class_type bv infos.pci_expr
+
+and add_class_type_declaration bv infos = add_class_description bv infos
+
+and add_structure bv item_list =
+  let (bv, m) = add_structure_binding bv item_list in
+  add_names (collect_free (make_node m));
+  bv
+
+and add_structure_binding bv item_list =
+  List.fold_left add_struct_item (bv, String.Map.empty) item_list
+
+and add_struct_item (bv, m) item : _ String.Map.t * _ String.Map.t =
+  match item.pstr_desc with
+    Pstr_eval (e, _attrs) ->
+      add_expr bv e; (bv, m)
+  | Pstr_value(rf, pel) ->
+      let bv = add_bindings rf bv pel in (bv, m)
+  | Pstr_primitive vd ->
+      add_type bv vd.pval_type; (bv, m)
+  | Pstr_type (_, dcls) ->
+      List.iter (add_type_declaration bv) dcls; (bv, m)
+  | Pstr_typext te ->
+      add_type_extension bv te;
+      (bv, m)
+  | Pstr_exception te ->
+      add_type_exception bv te;
+      (bv, m)
+  | Pstr_module x ->
+      let b = add_module_binding bv x.pmb_expr in
+      let add map =
+        match x.pmb_name.txt with
+        | None -> map
+        | Some name -> String.Map.add name b map
+      in
+      (add bv, add m)
+  | Pstr_recmodule bindings ->
+      let add =
+        List.fold_right (fun x map ->
+          match x.pmb_name.txt with
+          | None -> map
+          | Some name -> String.Map.add name bound map
+        ) bindings
+      in
+      let bv' = add bv and m = add m in
+      List.iter
+        (fun x -> add_module_expr bv' x.pmb_expr)
+        bindings;
+      (bv', m)
+  | Pstr_modtype x ->
+      begin match x.pmtd_type with
+        None -> ()
+      | Some mty -> add_modtype bv mty
+      end;
+      (bv, m)
+  | Pstr_open od ->
+      (open_declaration bv od, m)
+  | Pstr_class cdl ->
+      List.iter (add_class_declaration bv) cdl; (bv, m)
+  | Pstr_class_type cdtl ->
+      List.iter (add_class_type_declaration bv) cdtl; (bv, m)
+  | Pstr_include incl ->
+      let Node (s, m') as n = add_module_binding bv incl.pincl_mod in
+      if !Clflags.transparent_modules then
+        add_names s
+      else
+        (* If we are not in the delayed dependency mode, we need to
+           collect all delayed dependencies imported by the include statement *)
+        add_names (collect_free n);
+      let add = String.Map.fold String.Map.add m' in
+      (add bv, add m)
+  | Pstr_attribute _ -> (bv, m)
+  | Pstr_extension (e, _) ->
+      handle_extension e;
+      (bv, m)
+
+and add_use_file bv top_phrs =
+  ignore (List.fold_left add_top_phrase bv top_phrs)
+
+and add_implementation bv l =
+    ignore (add_structure_binding bv l)
+
+and add_implementation_binding bv l =
+  snd (add_structure_binding bv l)
+
+and add_top_phrase bv = function
+  | Ptop_def str -> add_structure bv str
+  | Ptop_dir _ -> bv
+
+and add_class_expr bv ce =
+  match ce.pcl_desc with
+    Pcl_constr(l, tyl) ->
+      add bv l; List.iter (add_type bv) tyl
+  | Pcl_structure { pcstr_self = pat; pcstr_fields = fieldl } ->
+      let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl
+  | Pcl_fun(_, opte, pat, ce) ->
+      add_opt add_expr bv opte;
+      let bv = add_pattern bv pat in add_class_expr bv ce
+  | Pcl_apply(ce, exprl) ->
+      add_class_expr bv ce; List.iter (fun (_,e) -> add_expr bv e) exprl
+  | Pcl_let(rf, pel, ce) ->
+      let bv = add_bindings rf bv pel in add_class_expr bv ce
+  | Pcl_constraint(ce, ct) ->
+      add_class_expr bv ce; add_class_type bv ct
+  | Pcl_extension e -> handle_extension e
+  | Pcl_open (o, e) ->
+      let bv = open_description bv o in
+      add_class_expr bv e
+
+and add_class_field bv pcf =
+  match pcf.pcf_desc with
+    Pcf_inherit(_, ce, _) -> add_class_expr bv ce
+  | Pcf_val(_, _, Cfk_concrete (_, e))
+  | Pcf_method(_, _, Cfk_concrete (_, e)) -> add_expr bv e
+  | Pcf_val(_, _, Cfk_virtual ty)
+  | Pcf_method(_, _, Cfk_virtual ty) -> add_type bv ty
+  | Pcf_constraint(ty1, ty2) -> add_type bv ty1; add_type bv ty2
+  | Pcf_initializer e -> add_expr bv e
+  | Pcf_attribute _ -> ()
+  | Pcf_extension e -> handle_extension e
+
+and add_class_declaration bv decl =
+  add_class_expr bv decl.pci_expr
diff --git a/parsing/depend.mli b/parsing/depend.mli
new file mode 100644
index 00000000..74c095f9
--- /dev/null
+++ b/parsing/depend.mli
@@ -0,0 +1,45 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1999 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Module dependencies.
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+module String = Misc.Stdlib.String
+
+type map_tree = Node of String.Set.t * bound_map
+and  bound_map = map_tree String.Map.t
+val make_leaf : string -> map_tree
+val make_node : bound_map -> map_tree
+val weaken_map : String.Set.t -> map_tree -> map_tree
+
+val free_structure_names : String.Set.t ref
+
+(** dependencies found by preprocessing tools *)
+val pp_deps : string list ref
+
+val open_module : bound_map -> Longident.t -> bound_map
+
+val add_use_file : bound_map -> Parsetree.toplevel_phrase list -> unit
+
+val add_signature : bound_map -> Parsetree.signature -> unit
+
+val add_implementation : bound_map -> Parsetree.structure -> unit
+
+val add_implementation_binding : bound_map -> Parsetree.structure -> bound_map
+val add_signature_binding : bound_map -> Parsetree.signature -> bound_map
diff --git a/parsing/docstrings.ml b/parsing/docstrings.ml
new file mode 100644
index 00000000..987365aa
--- /dev/null
+++ b/parsing/docstrings.ml
@@ -0,0 +1,425 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                               Leo White                                *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Location
+
+(* Docstrings *)
+
+(* A docstring is "attached" if it has been inserted in the AST. This
+   is used for generating unexpected docstring warnings. *)
+type ds_attached =
+  | Unattached   (* Not yet attached anything.*)
+  | Info         (* Attached to a field or constructor. *)
+  | Docs         (* Attached to an item or as floating text. *)
+
+(* A docstring is "associated" with an item if there are no blank lines between
+   them. This is used for generating docstring ambiguity warnings. *)
+type ds_associated =
+  | Zero             (* Not associated with an item *)
+  | One              (* Associated with one item *)
+  | Many             (* Associated with multiple items (ambiguity) *)
+
+type docstring =
+  { ds_body: string;
+    ds_loc: Location.t;
+    mutable ds_attached: ds_attached;
+    mutable ds_associated: ds_associated; }
+
+(* List of docstrings *)
+
+let docstrings : docstring list ref = ref []
+
+(* Warn for unused and ambiguous docstrings *)
+
+let warn_bad_docstrings () =
+  if Warnings.is_active (Warnings.Bad_docstring true) then begin
+    List.iter
+      (fun ds ->
+         match ds.ds_attached with
+         | Info -> ()
+         | Unattached ->
+           prerr_warning ds.ds_loc (Warnings.Bad_docstring true)
+         | Docs ->
+             match ds.ds_associated with
+             | Zero | One -> ()
+             | Many ->
+               prerr_warning ds.ds_loc (Warnings.Bad_docstring false))
+      (List.rev !docstrings)
+end
+
+(* Docstring constructors and destructors *)
+
+let docstring body loc =
+  let ds =
+    { ds_body = body;
+      ds_loc = loc;
+      ds_attached = Unattached;
+      ds_associated = Zero; }
+  in
+  ds
+
+let register ds =
+  docstrings := ds :: !docstrings
+
+let docstring_body ds = ds.ds_body
+
+let docstring_loc ds = ds.ds_loc
+
+(* Docstrings attached to items *)
+
+type docs =
+  { docs_pre: docstring option;
+    docs_post: docstring option; }
+
+let empty_docs = { docs_pre = None; docs_post = None }
+
+let doc_loc = {txt = "ocaml.doc"; loc = Location.none}
+
+let docs_attr ds =
+  let open Parsetree in
+  let body = ds.ds_body in
+  let loc = ds.ds_loc in
+  let exp =
+    { pexp_desc = Pexp_constant (Pconst_string(body, loc, None));
+      pexp_loc = loc;
+      pexp_loc_stack = [];
+      pexp_attributes = []; }
+  in
+  let item =
+    { pstr_desc = Pstr_eval (exp, []); pstr_loc = loc }
+  in
+  { attr_name = doc_loc;
+    attr_payload = PStr [item];
+    attr_loc = loc }
+
+let add_docs_attrs docs attrs =
+  let attrs =
+    match docs.docs_pre with
+    | None | Some { ds_body=""; _ } -> attrs
+    | Some ds -> docs_attr ds :: attrs
+  in
+  let attrs =
+    match docs.docs_post with
+    | None | Some { ds_body=""; _ } -> attrs
+    | Some ds -> attrs @ [docs_attr ds]
+  in
+  attrs
+
+(* Docstrings attached to constructors or fields *)
+
+type info = docstring option
+
+let empty_info = None
+
+let info_attr = docs_attr
+
+let add_info_attrs info attrs =
+  match info with
+  | None | Some {ds_body=""; _} -> attrs
+  | Some ds -> attrs @ [info_attr ds]
+
+(* Docstrings not attached to a specific item *)
+
+type text = docstring list
+
+let empty_text = []
+let empty_text_lazy = lazy []
+
+let text_loc = {txt = "ocaml.text"; loc = Location.none}
+
+let text_attr ds =
+  let open Parsetree in
+  let body = ds.ds_body in
+  let loc = ds.ds_loc in
+  let exp =
+    { pexp_desc = Pexp_constant (Pconst_string(body, loc, None));
+      pexp_loc = loc;
+      pexp_loc_stack = [];
+      pexp_attributes = []; }
+  in
+  let item =
+    { pstr_desc = Pstr_eval (exp, []); pstr_loc = loc }
+  in
+  { attr_name = text_loc;
+    attr_payload = PStr [item];
+    attr_loc = loc }
+
+let add_text_attrs dsl attrs =
+  let fdsl = List.filter (function {ds_body=""} -> false| _ ->true) dsl in
+  (List.map text_attr fdsl) @ attrs
+
+(* Find the first non-info docstring in a list, attach it and return it *)
+let get_docstring ~info dsl =
+  let rec loop = function
+    | [] -> None
+    | {ds_attached = Info; _} :: rest -> loop rest
+    | ds :: _ ->
+        ds.ds_attached <- if info then Info else Docs;
+        Some ds
+  in
+  loop dsl
+
+(* Find all the non-info docstrings in a list, attach them and return them *)
+let get_docstrings dsl =
+  let rec loop acc = function
+    | [] -> List.rev acc
+    | {ds_attached = Info; _} :: rest -> loop acc rest
+    | ds :: rest ->
+        ds.ds_attached <- Docs;
+        loop (ds :: acc) rest
+  in
+    loop [] dsl
+
+(* "Associate" all the docstrings in a list *)
+let associate_docstrings dsl =
+  List.iter
+    (fun ds ->
+       match ds.ds_associated with
+       | Zero -> ds.ds_associated <- One
+       | (One | Many) -> ds.ds_associated <- Many)
+    dsl
+
+(* Map from positions to pre docstrings *)
+
+let pre_table : (Lexing.position, docstring list) Hashtbl.t =
+  Hashtbl.create 50
+
+let set_pre_docstrings pos dsl =
+  if dsl <> [] then Hashtbl.add pre_table pos dsl
+
+let get_pre_docs pos =
+  try
+    let dsl = Hashtbl.find pre_table pos in
+      associate_docstrings dsl;
+      get_docstring ~info:false dsl
+  with Not_found -> None
+
+let mark_pre_docs pos =
+  try
+    let dsl = Hashtbl.find pre_table pos in
+      associate_docstrings dsl
+  with Not_found -> ()
+
+(* Map from positions to post docstrings *)
+
+let post_table : (Lexing.position, docstring list) Hashtbl.t =
+  Hashtbl.create 50
+
+let set_post_docstrings pos dsl =
+  if dsl <> [] then Hashtbl.add post_table pos dsl
+
+let get_post_docs pos =
+  try
+    let dsl = Hashtbl.find post_table pos in
+      associate_docstrings dsl;
+      get_docstring ~info:false dsl
+  with Not_found -> None
+
+let mark_post_docs pos =
+  try
+    let dsl = Hashtbl.find post_table pos in
+      associate_docstrings dsl
+  with Not_found -> ()
+
+let get_info pos =
+  try
+    let dsl = Hashtbl.find post_table pos in
+      get_docstring ~info:true dsl
+  with Not_found -> None
+
+(* Map from positions to floating docstrings *)
+
+let floating_table : (Lexing.position, docstring list) Hashtbl.t =
+  Hashtbl.create 50
+
+let set_floating_docstrings pos dsl =
+  if dsl <> [] then Hashtbl.add floating_table pos dsl
+
+let get_text pos =
+  try
+    let dsl = Hashtbl.find floating_table pos in
+      get_docstrings dsl
+  with Not_found -> []
+
+let get_post_text pos =
+  try
+    let dsl = Hashtbl.find post_table pos in
+      get_docstrings dsl
+  with Not_found -> []
+
+(* Maps from positions to extra docstrings *)
+
+let pre_extra_table : (Lexing.position, docstring list) Hashtbl.t =
+  Hashtbl.create 50
+
+let set_pre_extra_docstrings pos dsl =
+  if dsl <> [] then Hashtbl.add pre_extra_table pos dsl
+
+let get_pre_extra_text pos =
+  try
+    let dsl = Hashtbl.find pre_extra_table pos in
+      get_docstrings dsl
+  with Not_found -> []
+
+let post_extra_table : (Lexing.position, docstring list) Hashtbl.t =
+  Hashtbl.create 50
+
+let set_post_extra_docstrings pos dsl =
+  if dsl <> [] then Hashtbl.add post_extra_table pos dsl
+
+let get_post_extra_text pos =
+  try
+    let dsl = Hashtbl.find post_extra_table pos in
+      get_docstrings dsl
+  with Not_found -> []
+
+(* Docstrings from parser actions *)
+module WithParsing = struct
+let symbol_docs () =
+  { docs_pre = get_pre_docs (Parsing.symbol_start_pos ());
+    docs_post = get_post_docs (Parsing.symbol_end_pos ()); }
+
+let symbol_docs_lazy () =
+  let p1 = Parsing.symbol_start_pos () in
+  let p2 = Parsing.symbol_end_pos () in
+    lazy { docs_pre = get_pre_docs p1;
+           docs_post = get_post_docs p2; }
+
+let rhs_docs pos1 pos2 =
+  { docs_pre = get_pre_docs (Parsing.rhs_start_pos pos1);
+    docs_post = get_post_docs (Parsing.rhs_end_pos pos2); }
+
+let rhs_docs_lazy pos1 pos2 =
+  let p1 = Parsing.rhs_start_pos pos1 in
+  let p2 = Parsing.rhs_end_pos pos2 in
+    lazy { docs_pre = get_pre_docs p1;
+           docs_post = get_post_docs p2; }
+
+let mark_symbol_docs () =
+  mark_pre_docs (Parsing.symbol_start_pos ());
+  mark_post_docs (Parsing.symbol_end_pos ())
+
+let mark_rhs_docs pos1 pos2 =
+  mark_pre_docs (Parsing.rhs_start_pos pos1);
+  mark_post_docs (Parsing.rhs_end_pos pos2)
+
+let symbol_info () =
+  get_info (Parsing.symbol_end_pos ())
+
+let rhs_info pos =
+  get_info (Parsing.rhs_end_pos pos)
+
+let symbol_text () =
+  get_text (Parsing.symbol_start_pos ())
+
+let symbol_text_lazy () =
+  let pos = Parsing.symbol_start_pos () in
+    lazy (get_text pos)
+
+let rhs_text pos =
+  get_text (Parsing.rhs_start_pos pos)
+
+let rhs_post_text pos =
+  get_post_text (Parsing.rhs_end_pos pos)
+
+let rhs_text_lazy pos =
+  let pos = Parsing.rhs_start_pos pos in
+    lazy (get_text pos)
+
+let symbol_pre_extra_text () =
+  get_pre_extra_text (Parsing.symbol_start_pos ())
+
+let symbol_post_extra_text () =
+  get_post_extra_text (Parsing.symbol_end_pos ())
+
+let rhs_pre_extra_text pos =
+  get_pre_extra_text (Parsing.rhs_start_pos pos)
+
+let rhs_post_extra_text pos =
+  get_post_extra_text (Parsing.rhs_end_pos pos)
+end
+
+include WithParsing
+
+module WithMenhir = struct
+let symbol_docs (startpos, endpos) =
+  { docs_pre = get_pre_docs startpos;
+    docs_post = get_post_docs endpos; }
+
+let symbol_docs_lazy (p1, p2) =
+  lazy { docs_pre = get_pre_docs p1;
+         docs_post = get_post_docs p2; }
+
+let rhs_docs pos1 pos2 =
+  { docs_pre = get_pre_docs pos1;
+    docs_post = get_post_docs pos2; }
+
+let rhs_docs_lazy p1 p2 =
+    lazy { docs_pre = get_pre_docs p1;
+           docs_post = get_post_docs p2; }
+
+let mark_symbol_docs (startpos, endpos) =
+  mark_pre_docs startpos;
+  mark_post_docs endpos;
+  ()
+
+let mark_rhs_docs pos1 pos2 =
+  mark_pre_docs pos1;
+  mark_post_docs pos2;
+  ()
+
+let symbol_info endpos =
+  get_info endpos
+
+let rhs_info endpos =
+  get_info endpos
+
+let symbol_text startpos =
+  get_text startpos
+
+let symbol_text_lazy startpos =
+  lazy (get_text startpos)
+
+let rhs_text pos =
+  get_text pos
+
+let rhs_post_text pos =
+  get_post_text pos
+
+let rhs_text_lazy pos =
+  lazy (get_text pos)
+
+let symbol_pre_extra_text startpos =
+  get_pre_extra_text startpos
+
+let symbol_post_extra_text endpos =
+  get_post_extra_text endpos
+
+let rhs_pre_extra_text pos =
+  get_pre_extra_text pos
+
+let rhs_post_extra_text pos =
+  get_post_extra_text pos
+end
+
+(* (Re)Initialise all comment state *)
+
+let init () =
+  docstrings := [];
+  Hashtbl.reset pre_table;
+  Hashtbl.reset post_table;
+  Hashtbl.reset floating_table;
+  Hashtbl.reset pre_extra_table;
+  Hashtbl.reset post_extra_table
diff --git a/parsing/docstrings.mli b/parsing/docstrings.mli
new file mode 100644
index 00000000..bf2508fd
--- /dev/null
+++ b/parsing/docstrings.mli
@@ -0,0 +1,223 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                               Leo White                                *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Documentation comments
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+(** (Re)Initialise all docstring state *)
+val init : unit -> unit
+
+(** Emit warnings for unattached and ambiguous docstrings *)
+val warn_bad_docstrings : unit -> unit
+
+(** {2 Docstrings} *)
+
+(** Documentation comments *)
+type docstring
+
+(** Create a docstring *)
+val docstring : string -> Location.t -> docstring
+
+(** Register a docstring *)
+val register : docstring -> unit
+
+(** Get the text of a docstring *)
+val docstring_body : docstring -> string
+
+(** Get the location of a docstring *)
+val docstring_loc : docstring -> Location.t
+
+(** {2 Set functions}
+
+   These functions are used by the lexer to associate docstrings to
+   the locations of tokens. *)
+
+(** Docstrings immediately preceding a token *)
+val set_pre_docstrings : Lexing.position -> docstring list -> unit
+
+(** Docstrings immediately following a token *)
+val set_post_docstrings : Lexing.position -> docstring list -> unit
+
+(** Docstrings not immediately adjacent to a token *)
+val set_floating_docstrings : Lexing.position -> docstring list -> unit
+
+(** Docstrings immediately following the token which precedes this one *)
+val set_pre_extra_docstrings : Lexing.position -> docstring list -> unit
+
+(** Docstrings immediately preceding the token which follows this one *)
+val set_post_extra_docstrings : Lexing.position -> docstring list -> unit
+
+(** {2 Items}
+
+    The {!docs} type represents documentation attached to an item. *)
+
+type docs =
+  { docs_pre: docstring option;
+    docs_post: docstring option; }
+
+val empty_docs : docs
+
+val docs_attr : docstring -> Parsetree.attribute
+
+(** Convert item documentation to attributes and add them to an
+    attribute list *)
+val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes
+
+(** Fetch the item documentation for the current symbol. This also
+    marks this documentation (for ambiguity warnings). *)
+val symbol_docs : unit -> docs
+val symbol_docs_lazy : unit -> docs Lazy.t
+
+(** Fetch the item documentation for the symbols between two
+    positions. This also marks this documentation (for ambiguity
+    warnings). *)
+val rhs_docs : int -> int -> docs
+val rhs_docs_lazy : int -> int -> docs Lazy.t
+
+(** Mark the item documentation for the current symbol (for ambiguity
+    warnings). *)
+val mark_symbol_docs : unit -> unit
+
+(** Mark as associated the item documentation for the symbols between
+    two positions (for ambiguity warnings) *)
+val mark_rhs_docs : int -> int -> unit
+
+(** {2 Fields and constructors}
+
+    The {!info} type represents documentation attached to a field or
+    constructor. *)
+
+type info = docstring option
+
+val empty_info : info
+
+val info_attr : docstring -> Parsetree.attribute
+
+(** Convert field info to attributes and add them to an
+    attribute list *)
+val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes
+
+(** Fetch the field info for the current symbol. *)
+val symbol_info : unit -> info
+
+(** Fetch the field info following the symbol at a given position. *)
+val rhs_info : int -> info
+
+(** {2 Unattached comments}
+
+    The {!text} type represents documentation which is not attached to
+    anything. *)
+
+type text = docstring list
+
+val empty_text : text
+val empty_text_lazy : text Lazy.t
+
+val text_attr : docstring -> Parsetree.attribute
+
+(** Convert text to attributes and add them to an attribute list *)
+val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes
+
+(** Fetch the text preceding the current symbol. *)
+val symbol_text : unit -> text
+val symbol_text_lazy : unit -> text Lazy.t
+
+(** Fetch the text preceding the symbol at the given position. *)
+val rhs_text : int -> text
+val rhs_text_lazy : int -> text Lazy.t
+
+(** {2 Extra text}
+
+    There may be additional text attached to the delimiters of a block
+    (e.g. [struct] and [end]). This is fetched by the following
+    functions, which are applied to the contents of the block rather
+    than the delimiters. *)
+
+(** Fetch additional text preceding the current symbol *)
+val symbol_pre_extra_text : unit -> text
+
+(** Fetch additional text following the current symbol *)
+val symbol_post_extra_text : unit -> text
+
+(** Fetch additional text preceding the symbol at the given position *)
+val rhs_pre_extra_text : int -> text
+
+(** Fetch additional text following the symbol at the given position *)
+val rhs_post_extra_text : int -> text
+
+(** Fetch text following the symbol at the given position *)
+val rhs_post_text : int -> text
+
+module WithMenhir: sig
+(** Fetch the item documentation for the current symbol. This also
+    marks this documentation (for ambiguity warnings). *)
+val symbol_docs : Lexing.position * Lexing.position -> docs
+val symbol_docs_lazy : Lexing.position * Lexing.position -> docs Lazy.t
+
+(** Fetch the item documentation for the symbols between two
+    positions. This also marks this documentation (for ambiguity
+    warnings). *)
+val rhs_docs : Lexing.position -> Lexing.position -> docs
+val rhs_docs_lazy : Lexing.position -> Lexing.position -> docs Lazy.t
+
+(** Mark the item documentation for the current symbol (for ambiguity
+    warnings). *)
+val mark_symbol_docs : Lexing.position * Lexing.position -> unit
+
+(** Mark as associated the item documentation for the symbols between
+    two positions (for ambiguity warnings) *)
+val mark_rhs_docs : Lexing.position -> Lexing.position -> unit
+
+(** Fetch the field info for the current symbol. *)
+val symbol_info : Lexing.position -> info
+
+(** Fetch the field info following the symbol at a given position. *)
+val rhs_info : Lexing.position -> info
+
+(** Fetch the text preceding the current symbol. *)
+val symbol_text : Lexing.position -> text
+val symbol_text_lazy : Lexing.position -> text Lazy.t
+
+(** Fetch the text preceding the symbol at the given position. *)
+val rhs_text : Lexing.position -> text
+val rhs_text_lazy : Lexing.position -> text Lazy.t
+
+(** {3 Extra text}
+
+    There may be additional text attached to the delimiters of a block
+    (e.g. [struct] and [end]). This is fetched by the following
+    functions, which are applied to the contents of the block rather
+    than the delimiters. *)
+
+(** Fetch additional text preceding the current symbol *)
+val symbol_pre_extra_text : Lexing.position -> text
+
+(** Fetch additional text following the current symbol *)
+val symbol_post_extra_text : Lexing.position -> text
+
+(** Fetch additional text preceding the symbol at the given position *)
+val rhs_pre_extra_text : Lexing.position -> text
+
+(** Fetch additional text following the symbol at the given position *)
+val rhs_post_extra_text : Lexing.position -> text
+
+(** Fetch text following the symbol at the given position *)
+val rhs_post_text : Lexing.position -> text
+
+end
diff --git a/parsing/dune b/parsing/dune
new file mode 100644
index 00000000..4198c6b1
--- /dev/null
+++ b/parsing/dune
@@ -0,0 +1,48 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+;; We're just reusing the stuff from boot/ here.
+;; One could add a dune file in boot/menhir/ with the appropriate rules if we
+;; want to regenerate the parser while building with dune, but it doesn't seem
+;; essential right now.
+
+(rule
+ (targets camlinternalMenhirLib.ml)
+ (mode    fallback)
+ (action  (copy# ../boot/menhir/menhirLib.ml %{targets})))
+
+(rule
+ (targets camlinternalMenhirLib.mli)
+ (mode    fallback)
+ (action  (copy# ../boot/menhir/menhirLib.mli %{targets})))
+
+(rule
+ (targets parser.ml)
+ (mode    fallback)
+ (deps    (:dep ../boot/menhir/parser.ml))
+ (action
+   (with-stdout-to %{targets}
+     (bash "cat %{dep} | sed 's/MenhirLib/CamlinternalMenhirLib/g'"))))
+
+(rule
+ (targets parser.mli)
+ (mode    fallback)
+ (deps    (:dep ../boot/menhir/parser.mli))
+ (action
+   (with-stdout-to %{targets}
+     (bash "cat %{dep} | sed 's/MenhirLib/CamlinternalMenhirLib/g'"))))
+
+(ocamllex
+ (modules lexer)
+ (mode fallback))
diff --git a/parsing/lexer.mli b/parsing/lexer.mli
new file mode 100644
index 00000000..cde2ad5c
--- /dev/null
+++ b/parsing/lexer.mli
@@ -0,0 +1,64 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The lexical analyzer
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+val init : unit -> unit
+val token: Lexing.lexbuf -> Parser.token
+val skip_hash_bang: Lexing.lexbuf -> unit
+
+type error =
+  | Illegal_character of char
+  | Illegal_escape of string * string option
+  | Reserved_sequence of string * string option
+  | Unterminated_comment of Location.t
+  | Unterminated_string
+  | Unterminated_string_in_comment of Location.t * Location.t
+  | Keyword_as_label of string
+  | Invalid_literal of string
+  | Invalid_directive of string * string option
+;;
+
+exception Error of error * Location.t
+
+val in_comment : unit -> bool;;
+val in_string : unit -> bool;;
+
+
+val print_warnings : bool ref
+val handle_docstrings: bool ref
+val comments : unit -> (string * Location.t) list
+val token_with_comments : Lexing.lexbuf -> Parser.token
+
+(*
+  [set_preprocessor init preprocessor] registers [init] as the function
+to call to initialize the preprocessor when the lexer is initialized,
+and [preprocessor] a function that is called when a new token is needed
+by the parser, as [preprocessor lexer lexbuf] where [lexer] is the
+lexing function.
+
+When a preprocessor is configured by calling [set_preprocessor], the lexer
+changes its behavior to accept backslash-newline as a token-separating blank.
+*)
+
+val set_preprocessor :
+  (unit -> unit) ->
+  ((Lexing.lexbuf -> Parser.token) -> Lexing.lexbuf -> Parser.token) ->
+  unit
diff --git a/parsing/lexer.mll b/parsing/lexer.mll
new file mode 100644
index 00000000..6d68b59e
--- /dev/null
+++ b/parsing/lexer.mll
@@ -0,0 +1,858 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The lexer definition *)
+
+{
+open Lexing
+open Misc
+open Parser
+
+type error =
+  | Illegal_character of char
+  | Illegal_escape of string * string option
+  | Reserved_sequence of string * string option
+  | Unterminated_comment of Location.t
+  | Unterminated_string
+  | Unterminated_string_in_comment of Location.t * Location.t
+  | Keyword_as_label of string
+  | Invalid_literal of string
+  | Invalid_directive of string * string option
+;;
+
+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;
+(*  "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")
+]
+
+(* To buffer string literals *)
+
+let string_buffer = Buffer.create 256
+let reset_string_buffer () = Buffer.reset string_buffer
+let get_stored_string () = Buffer.contents string_buffer
+
+let store_string_char c = Buffer.add_char string_buffer c
+let store_string_utf_8_uchar u = Buffer.add_utf_8_uchar string_buffer u
+let store_string s = Buffer.add_string string_buffer s
+let store_lexeme lexbuf = store_string (Lexing.lexeme lexbuf)
+
+(* To store the position of the beginning of a string and comment *)
+let string_start_loc = ref Location.none;;
+let comment_start_loc = ref [];;
+let in_comment () = !comment_start_loc <> [];;
+let is_in_string = ref false
+let in_string () = !is_in_string
+let print_warnings = ref true
+
+(* Escaped chars are interpreted in strings unless they are in comments. *)
+let store_escaped_char lexbuf c =
+  if in_comment () then store_lexeme lexbuf else store_string_char c
+
+let store_escaped_uchar lexbuf u =
+  if in_comment () then store_lexeme lexbuf else store_string_utf_8_uchar u
+
+let compute_quoted_string_idloc {Location.loc_start = orig_loc } shift id =
+  let id_start_pos = orig_loc.Lexing.pos_cnum + shift in
+  let loc_start =
+    Lexing.{orig_loc with pos_cnum = id_start_pos }
+  in
+  let loc_end =
+    Lexing.{orig_loc with pos_cnum = id_start_pos + String.length id}
+  in
+  {Location. loc_start ; loc_end ; loc_ghost = false }
+
+let wrap_string_lexer f lexbuf =
+  let loc_start = lexbuf.lex_curr_p in
+  reset_string_buffer();
+  is_in_string := true;
+  let string_start = lexbuf.lex_start_p in
+  string_start_loc := Location.curr lexbuf;
+  let loc_end = f lexbuf in
+  is_in_string := false;
+  lexbuf.lex_start_p <- string_start;
+  let loc = Location.{loc_ghost= false; loc_start; loc_end} in
+  get_stored_string (), loc
+
+let wrap_comment_lexer comment lexbuf =
+  let start_loc = Location.curr lexbuf  in
+  comment_start_loc := [start_loc];
+  reset_string_buffer ();
+  let end_loc = comment lexbuf in
+  let s = get_stored_string () in
+  reset_string_buffer ();
+  s,
+  { start_loc with Location.loc_end = end_loc.Location.loc_end }
+
+let error lexbuf e = raise (Error(e, Location.curr lexbuf))
+let error_loc loc e = raise (Error(e, loc))
+
+(* to translate escape sequences *)
+
+let digit_value c =
+  match c with
+  | 'a' .. 'f' -> 10 + Char.code c - Char.code 'a'
+  | 'A' .. 'F' -> 10 + Char.code c - Char.code 'A'
+  | '0' .. '9' -> Char.code c - Char.code '0'
+  | _ -> assert false
+
+let num_value lexbuf ~base ~first ~last =
+  let c = ref 0 in
+  for i = first to last do
+    let v = digit_value (Lexing.lexeme_char lexbuf i) in
+    assert(v < base);
+    c := (base * !c) + v
+  done;
+  !c
+
+let char_for_backslash = function
+  | 'n' -> '\010'
+  | 'r' -> '\013'
+  | 'b' -> '\008'
+  | 't' -> '\009'
+  | c   -> c
+
+let illegal_escape lexbuf reason =
+  let error = Illegal_escape (Lexing.lexeme lexbuf, Some reason) in
+  raise (Error (error, Location.curr lexbuf))
+
+let char_for_decimal_code lexbuf i =
+  let c = num_value lexbuf ~base:10 ~first:i ~last:(i+2) in
+  if (c < 0 || c > 255) then
+    if in_comment ()
+    then 'x'
+    else
+      illegal_escape lexbuf
+        (Printf.sprintf
+          "%d is outside the range of legal characters (0-255)." c)
+  else Char.chr c
+
+let char_for_octal_code lexbuf i =
+  let c = num_value lexbuf ~base:8 ~first:i ~last:(i+2) in
+  if (c < 0 || c > 255) then
+    if in_comment ()
+    then 'x'
+    else
+      illegal_escape lexbuf
+        (Printf.sprintf
+          "o%o (=%d) is outside the range of legal characters (0-255)." c c)
+  else Char.chr c
+
+let char_for_hexadecimal_code lexbuf i =
+  Char.chr (num_value lexbuf ~base:16 ~first:i ~last:(i+1))
+
+let uchar_for_uchar_escape lexbuf =
+  let len = Lexing.lexeme_end lexbuf - Lexing.lexeme_start lexbuf in
+  let first = 3 (* skip opening \u{ *) in
+  let last = len - 2 (* skip closing } *) in
+  let digit_count = last - first + 1 in
+  match digit_count > 6 with
+  | true ->
+      illegal_escape lexbuf
+        "too many digits, expected 1 to 6 hexadecimal digits"
+  | false ->
+      let cp = num_value lexbuf ~base:16 ~first ~last in
+      if Uchar.is_valid cp then Uchar.unsafe_of_int cp else
+      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)
+
+(* Update the current location with file name and line number. *)
+
+let update_loc lexbuf file line absolute chars =
+  let pos = lexbuf.lex_curr_p in
+  let new_file = match file with
+                 | None -> pos.pos_fname
+                 | Some s -> s
+  in
+  lexbuf.lex_curr_p <- { pos with
+    pos_fname = new_file;
+    pos_lnum = if absolute then line else pos.pos_lnum + line;
+    pos_bol = pos.pos_cnum - chars;
+  }
+;;
+
+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 []
+
+let add_comment com =
+  comment_list := com :: !comment_list
+
+let add_docstring_comment ds =
+  let com =
+    ("*" ^ Docstrings.docstring_body ds, Docstrings.docstring_loc ds)
+  in
+    add_comment com
+
+let comments () = List.rev !comment_list
+
+(* Error report *)
+
+open Format
+
+let prepare_error loc = function
+  | Illegal_character c ->
+      Location.errorf ~loc "Illegal character (%s)" (Char.escaped c)
+  | Illegal_escape (s, explanation) ->
+      Location.errorf ~loc
+        "Illegal backslash escape in string or character (%s)%t" s
+        (fun ppf -> match explanation with
+           | None -> ()
+           | Some expl -> fprintf ppf ": %s" expl)
+  | Reserved_sequence (s, explanation) ->
+      Location.errorf ~loc
+        "Reserved character sequence: %s%t" s
+        (fun ppf -> match explanation with
+           | None -> ()
+           | Some expl -> fprintf ppf " %s" expl)
+  | Unterminated_comment _ ->
+      Location.errorf ~loc "Comment not terminated"
+  | Unterminated_string ->
+      Location.errorf ~loc "String literal not terminated"
+  | Unterminated_string_in_comment (_, literal_loc) ->
+      Location.errorf ~loc
+        "This comment contains an unterminated string literal"
+        ~sub:[Location.msg ~loc:literal_loc "String literal begins here"]
+  | Keyword_as_label kwd ->
+      Location.errorf ~loc
+        "`%s' is a keyword, it cannot be used as label name" kwd
+  | Invalid_literal s ->
+      Location.errorf ~loc "Invalid literal %s" s
+  | Invalid_directive (dir, explanation) ->
+      Location.errorf ~loc "Invalid lexer directive %S%t" dir
+        (fun ppf -> match explanation with
+           | None -> ()
+           | Some expl -> fprintf ppf ": %s" expl)
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (err, loc) ->
+          Some (prepare_error loc err)
+      | _ ->
+          None
+    )
+
+}
+
+let newline = ('\013'* '\010')
+let blank = [' ' '\009' '\012']
+let lowercase = ['a'-'z' '_']
+let uppercase = ['A'-'Z']
+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']
+let symbolchar =
+  ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~']
+let dotsymbolchar =
+  ['!' '$' '%' '&' '*' '+' '-' '/' ':' '=' '>' '?' '@' '^' '|']
+let kwdopchar =
+  ['$' '&' '*' '+' '-' '/' '<' '=' '>' '@' '^' '|']
+
+let ident = (lowercase | uppercase) identchar*
+let extattrident = ident ('.' ident)*
+
+let decimal_literal =
+  ['0'-'9'] ['0'-'9' '_']*
+let hex_digit =
+  ['0'-'9' 'A'-'F' 'a'-'f']
+let hex_literal =
+  '0' ['x' 'X'] ['0'-'9' 'A'-'F' 'a'-'f']['0'-'9' 'A'-'F' 'a'-'f' '_']*
+let oct_literal =
+  '0' ['o' 'O'] ['0'-'7'] ['0'-'7' '_']*
+let bin_literal =
+  '0' ['b' 'B'] ['0'-'1'] ['0'-'1' '_']*
+let int_literal =
+  decimal_literal | hex_literal | oct_literal | bin_literal
+let float_literal =
+  ['0'-'9'] ['0'-'9' '_']*
+  ('.' ['0'-'9' '_']* )?
+  (['e' 'E'] ['+' '-']? ['0'-'9'] ['0'-'9' '_']* )?
+let hex_float_literal =
+  '0' ['x' 'X']
+  ['0'-'9' 'A'-'F' 'a'-'f'] ['0'-'9' 'A'-'F' 'a'-'f' '_']*
+  ('.' ['0'-'9' 'A'-'F' 'a'-'f' '_']* )?
+  (['p' 'P'] ['+' '-']? ['0'-'9'] ['0'-'9' '_']* )?
+let literal_modifier = ['G'-'Z' 'g'-'z']
+
+rule token = parse
+  | ('\\' as bs) newline {
+      if not !escaped_newlines then error lexbuf (Illegal_character bs);
+      update_loc lexbuf None 1 false 0;
+      token lexbuf }
+  | newline
+      { update_loc lexbuf None 1 false 0;
+        EOL }
+  | blank +
+      { token lexbuf }
+  | "_"
+      { UNDERSCORE }
+  | "~"
+      { TILDE }
+  | ".~"
+      { error lexbuf
+          (Reserved_sequence (".~", Some "is reserved for use in MetaOCaml")) }
+  | "~" (lowercase identchar * as name) ':'
+      { check_label_name lexbuf name;
+        LABEL name }
+  | "~" (lowercase_latin1 identchar_latin1 * as name) ':'
+      { warn_latin1 lexbuf;
+        LABEL name }
+  | "?"
+      { QUESTION }
+  | "?" (lowercase identchar * as name) ':'
+      { check_label_name lexbuf name;
+        OPTLABEL name }
+  | "?" (lowercase_latin1 identchar_latin1 * as name) ':'
+      { warn_latin1 lexbuf;
+        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 }
+  | uppercase identchar * as name
+      { UIDENT name } (* No capitalized keywords *)
+  | uppercase_latin1 identchar_latin1 * as name
+      { warn_latin1 lexbuf; UIDENT name }
+  | int_literal as lit { INT (lit, None) }
+  | (int_literal as lit) (literal_modifier as modif)
+      { INT (lit, Some modif) }
+  | float_literal | hex_float_literal as lit
+      { FLOAT (lit, None) }
+  | (float_literal | hex_float_literal as lit) (literal_modifier as modif)
+      { FLOAT (lit, Some modif) }
+  | (float_literal | hex_float_literal | int_literal) identchar+ as invalid
+      { error lexbuf (Invalid_literal invalid) }
+  | "\""
+      { 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) "|"
+      { let orig_loc = Location.curr lexbuf 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) "|"
+      { let orig_loc = Location.curr lexbuf 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) "|"
+      { let orig_loc = Location.curr lexbuf 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) "|"
+      { let orig_loc = Location.curr lexbuf 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) }
+  | "\'" newline "\'"
+      { update_loc lexbuf None 1 false 1;
+        (* newline is ('\013'* '\010') *)
+        CHAR '\n' }
+  | "\'" ([^ '\\' '\'' '\010' '\013'] as c) "\'"
+      { CHAR c }
+  | "\'\\" (['\\' '\'' '\"' 'n' 't' 'b' 'r' ' '] as c) "\'"
+      { CHAR (char_for_backslash c) }
+  | "\'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "\'"
+      { CHAR(char_for_decimal_code lexbuf 2) }
+  | "\'\\" 'o' ['0'-'7'] ['0'-'7'] ['0'-'7'] "\'"
+      { CHAR(char_for_octal_code lexbuf 3) }
+  | "\'\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "\'"
+      { CHAR(char_for_hexadecimal_code lexbuf 3) }
+  | "\'" ("\\" _ as esc)
+      { error lexbuf (Illegal_escape (esc, None)) }
+  | "(*"
+      { let s, loc = wrap_comment_lexer comment lexbuf in
+        COMMENT (s, loc) }
+  | "(**"
+      { let s, loc = wrap_comment_lexer comment lexbuf in
+        if !handle_docstrings then
+          DOCSTRING (Docstrings.docstring s loc)
+        else
+          COMMENT ("*" ^ s, loc)
+      }
+  | "(**" (('*'+) as stars)
+      { let s, loc =
+          wrap_comment_lexer
+            (fun lexbuf ->
+               store_string ("*" ^ stars);
+               comment lexbuf)
+            lexbuf
+        in
+        COMMENT (s, loc) }
+  | "(*)"
+      { if !print_warnings then
+          Location.prerr_warning (Location.curr lexbuf) Warnings.Comment_start;
+        let s, loc = wrap_comment_lexer comment lexbuf in
+        COMMENT (s, loc) }
+  | "(*" (('*'*) as stars) "*)"
+      { if !handle_docstrings && stars="" then
+         (* (**) is an empty docstring *)
+          DOCSTRING(Docstrings.docstring "" (Location.curr lexbuf))
+        else
+          COMMENT (stars, Location.curr lexbuf) }
+  | "*)"
+      { let loc = Location.curr lexbuf in
+        Location.prerr_warning loc Warnings.Comment_not_end;
+        lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1;
+        let curpos = lexbuf.lex_curr_p in
+        lexbuf.lex_curr_p <- { curpos with pos_cnum = curpos.pos_cnum - 1 };
+        STAR
+      }
+  | "#"
+      { let at_beginning_of_line pos = (pos.pos_cnum = pos.pos_bol) in
+        if not (at_beginning_of_line lexbuf.lex_start_p)
+        then HASH
+        else try directive lexbuf with Failure _ -> HASH
+      }
+  | "&"  { AMPERSAND }
+  | "&&" { AMPERAMPER }
+  | "`"  { BACKQUOTE }
+  | "\'" { QUOTE }
+  | "("  { LPAREN }
+  | ")"  { RPAREN }
+  | "*"  { STAR }
+  | ","  { COMMA }
+  | "->" { MINUSGREATER }
+  | "."  { DOT }
+  | ".." { DOTDOT }
+  | "." (dotsymbolchar symbolchar* as op) { DOTOP op }
+  | ":"  { COLON }
+  | "::" { COLONCOLON }
+  | ":=" { COLONEQUAL }
+  | ":>" { COLONGREATER }
+  | ";"  { SEMI }
+  | ";;" { SEMISEMI }
+  | "<"  { LESS }
+  | "<-" { LESSMINUS }
+  | "="  { EQUAL }
+  | "["  { LBRACKET }
+  | "[|" { LBRACKETBAR }
+  | "[<" { LBRACKETLESS }
+  | "[>" { LBRACKETGREATER }
+  | "]"  { RBRACKET }
+  | "{"  { LBRACE }
+  | "{<" { LBRACELESS }
+  | "|"  { BAR }
+  | "||" { BARBAR }
+  | "|]" { BARRBRACKET }
+  | ">"  { GREATER }
+  | ">]" { GREATERRBRACKET }
+  | "}"  { RBRACE }
+  | ">}" { GREATERRBRACE }
+  | "[@" { LBRACKETAT }
+  | "[@@"  { LBRACKETATAT }
+  | "[@@@" { LBRACKETATATAT }
+  | "[%"   { LBRACKETPERCENT }
+  | "[%%"  { LBRACKETPERCENTPERCENT }
+  | "!"  { BANG }
+  | "!=" { INFIXOP0 "!=" }
+  | "+"  { PLUS }
+  | "+." { PLUSDOT }
+  | "+=" { PLUSEQ }
+  | "-"  { MINUS }
+  | "-." { MINUSDOT }
+
+  | "!" symbolchar + as op
+            { PREFIXOP op }
+  | ['~' '?'] symbolchar + as op
+            { PREFIXOP op }
+  | ['=' '<' '>' '|' '&' '$'] symbolchar * as op
+            { INFIXOP0 op }
+  | ['@' '^'] symbolchar * as op
+            { INFIXOP1 op }
+  | ['+' '-'] symbolchar * as op
+            { INFIXOP2 op }
+  | "**" symbolchar * as op
+            { INFIXOP4 op }
+  | '%'     { PERCENT }
+  | ['*' '/' '%'] symbolchar * as op
+            { INFIXOP3 op }
+  | '#' (symbolchar | '#') + as op
+            { HASHOP op }
+  | "let" kwdopchar dotsymbolchar * as op
+            { LETOP op }
+  | "and" kwdopchar dotsymbolchar * as op
+            { ANDOP op }
+  | eof { EOF }
+  | (_ as illegal_char)
+      { error lexbuf (Illegal_character illegal_char) }
+
+and directive = parse
+  | ([' ' '\t']* (['0'-'9']+ as num) [' ' '\t']*
+        ("\"" ([^ '\010' '\013' '\"' ] * as name) "\"") as directive)
+        [^ '\010' '\013'] *
+      {
+        match int_of_string num with
+        | exception _ ->
+            (* PR#7165 *)
+            let explanation = "line number out of range" in
+            error lexbuf (Invalid_directive ("#" ^ directive, Some explanation))
+        | line_num ->
+           (* Documentation says that the line number should be
+              positive, but we have never guarded against this and it
+              might have useful hackish uses. *)
+            update_loc lexbuf (Some name) (line_num - 1) true 0;
+            token lexbuf
+      }
+and comment = parse
+    "(*"
+      { comment_start_loc := (Location.curr lexbuf) :: !comment_start_loc;
+        store_lexeme lexbuf;
+        comment lexbuf
+      }
+  | "*)"
+      { match !comment_start_loc with
+        | [] -> assert false
+        | [_] -> comment_start_loc := []; Location.curr lexbuf
+        | _ :: l -> comment_start_loc := l;
+                  store_lexeme lexbuf;
+                  comment lexbuf
+       }
+  | "\""
+      {
+        string_start_loc := Location.curr lexbuf;
+        store_string_char '\"';
+        is_in_string := true;
+        let _loc = try string lexbuf
+        with Error (Unterminated_string, str_start) ->
+          match !comment_start_loc with
+          | [] -> assert false
+          | loc :: _ ->
+            let start = List.hd (List.rev !comment_start_loc) in
+            comment_start_loc := [];
+            error_loc loc (Unterminated_string_in_comment (start, str_start))
+        in
+        is_in_string := false;
+        store_string_char '\"';
+        comment lexbuf }
+  | "{" ('%' '%'? extattrident blank*)? (lowercase* as delim) "|"
+      {
+        string_start_loc := Location.curr lexbuf;
+        store_lexeme lexbuf;
+        is_in_string := true;
+        let _loc = try quoted_string delim lexbuf
+        with Error (Unterminated_string, str_start) ->
+          match !comment_start_loc with
+          | [] -> assert false
+          | loc :: _ ->
+            let start = List.hd (List.rev !comment_start_loc) in
+            comment_start_loc := [];
+            error_loc loc (Unterminated_string_in_comment (start, str_start))
+        in
+        is_in_string := false;
+        store_string_char '|';
+        store_string delim;
+        store_string_char '}';
+        comment lexbuf }
+  | "\'\'"
+      { store_lexeme lexbuf; comment lexbuf }
+  | "\'" newline "\'"
+      { update_loc lexbuf None 1 false 1;
+        store_lexeme lexbuf;
+        comment lexbuf
+      }
+  | "\'" [^ '\\' '\'' '\010' '\013' ] "\'"
+      { store_lexeme lexbuf; comment lexbuf }
+  | "\'\\" ['\\' '\"' '\'' 'n' 't' 'b' 'r' ' '] "\'"
+      { store_lexeme lexbuf; comment lexbuf }
+  | "\'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "\'"
+      { store_lexeme lexbuf; comment lexbuf }
+  | "\'\\" 'o' ['0'-'3'] ['0'-'7'] ['0'-'7'] "\'"
+      { store_lexeme lexbuf; comment lexbuf }
+  | "\'\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "\'"
+      { store_lexeme lexbuf; comment lexbuf }
+  | eof
+      { match !comment_start_loc with
+        | [] -> assert false
+        | loc :: _ ->
+          let start = List.hd (List.rev !comment_start_loc) in
+          comment_start_loc := [];
+          error_loc loc (Unterminated_comment start)
+      }
+  | newline
+      { update_loc lexbuf None 1 false 0;
+        store_lexeme lexbuf;
+        comment lexbuf
+      }
+  | ident
+      { store_lexeme lexbuf; comment lexbuf }
+  | _
+      { store_lexeme lexbuf; comment lexbuf }
+
+and string = parse
+    '\"'
+      { lexbuf.lex_start_p }
+  | '\\' newline ([' ' '\t'] * as space)
+      { update_loc lexbuf None 1 false (String.length space);
+        if in_comment () then store_lexeme lexbuf;
+        string lexbuf
+      }
+  | '\\' (['\\' '\'' '\"' 'n' 't' 'b' 'r' ' '] as c)
+      { store_escaped_char lexbuf (char_for_backslash c);
+        string lexbuf }
+  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
+      { store_escaped_char lexbuf (char_for_decimal_code lexbuf 1);
+         string lexbuf }
+  | '\\' 'o' ['0'-'7'] ['0'-'7'] ['0'-'7']
+      { store_escaped_char lexbuf (char_for_octal_code lexbuf 2);
+         string lexbuf }
+  | '\\' 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F']
+      { store_escaped_char lexbuf (char_for_hexadecimal_code lexbuf 2);
+         string lexbuf }
+  | '\\' 'u' '{' hex_digit+ '}'
+        { store_escaped_uchar lexbuf (uchar_for_uchar_escape lexbuf);
+          string lexbuf }
+  | '\\' _
+      { if not (in_comment ()) then begin
+(*  Should be an error, but we are very lax.
+          error lexbuf (Illegal_escape (Lexing.lexeme lexbuf, None))
+*)
+          let loc = Location.curr lexbuf in
+          Location.prerr_warning loc Warnings.Illegal_backslash;
+        end;
+        store_lexeme lexbuf;
+        string lexbuf
+      }
+  | newline
+      { if not (in_comment ()) then
+          Location.prerr_warning (Location.curr lexbuf) Warnings.Eol_in_string;
+        update_loc lexbuf None 1 false 0;
+        store_lexeme lexbuf;
+        string lexbuf
+      }
+  | eof
+      { is_in_string := false;
+        error_loc !string_start_loc Unterminated_string }
+  | (_ as c)
+      { store_string_char c;
+        string lexbuf }
+
+and quoted_string delim = parse
+  | newline
+      { update_loc lexbuf None 1 false 0;
+        store_lexeme lexbuf;
+        quoted_string delim lexbuf
+      }
+  | eof
+      { is_in_string := false;
+        error_loc !string_start_loc Unterminated_string }
+  | "|" (lowercase* as edelim) "}"
+      {
+        if delim = edelim then lexbuf.lex_start_p
+        else (store_lexeme lexbuf; quoted_string delim lexbuf)
+      }
+  | (_ as c)
+      { store_string_char c;
+        quoted_string delim lexbuf }
+
+and skip_hash_bang = parse
+  | "#!" [^ '\n']* '\n' [^ '\n']* "\n!#\n"
+      { update_loc lexbuf None 3 false 0 }
+  | "#!" [^ '\n']* '\n'
+      { update_loc lexbuf None 1 false 0 }
+  | "" { () }
+
+{
+
+  let token_with_comments lexbuf =
+    match !preprocessor with
+    | None -> token lexbuf
+    | Some (_init, preprocess) -> preprocess token lexbuf
+
+  type newline_state =
+    | NoLine (* There have been no blank lines yet. *)
+    | NewLine
+        (* There have been no blank lines, and the previous
+           token was a newline. *)
+    | BlankLine (* There have been blank lines. *)
+
+  type doc_state =
+    | Initial  (* There have been no docstrings yet *)
+    | After of docstring list
+        (* There have been docstrings, none of which were
+           preceded by a blank line *)
+    | Before of docstring list * docstring list * docstring list
+        (* There have been docstrings, some of which were
+           preceded by a blank line *)
+
+  and docstring = Docstrings.docstring
+
+  let token lexbuf =
+    let post_pos = lexeme_end_p lexbuf in
+    let attach lines docs pre_pos =
+      let open Docstrings in
+        match docs, lines with
+        | Initial, _ -> ()
+        | After a, (NoLine | NewLine) ->
+            set_post_docstrings post_pos (List.rev a);
+            set_pre_docstrings pre_pos a;
+        | After a, BlankLine ->
+            set_post_docstrings post_pos (List.rev a);
+            set_pre_extra_docstrings pre_pos (List.rev a)
+        | Before(a, f, b), (NoLine | NewLine) ->
+            set_post_docstrings post_pos (List.rev a);
+            set_post_extra_docstrings post_pos
+              (List.rev_append f (List.rev b));
+            set_floating_docstrings pre_pos (List.rev f);
+            set_pre_extra_docstrings pre_pos (List.rev a);
+            set_pre_docstrings pre_pos b
+        | Before(a, f, b), BlankLine ->
+            set_post_docstrings post_pos (List.rev a);
+            set_post_extra_docstrings post_pos
+              (List.rev_append f (List.rev b));
+            set_floating_docstrings pre_pos
+              (List.rev_append f (List.rev b));
+            set_pre_extra_docstrings pre_pos (List.rev a)
+    in
+    let rec loop lines docs lexbuf =
+      match token_with_comments lexbuf with
+      | COMMENT (s, loc) ->
+          add_comment (s, loc);
+          let lines' =
+            match lines with
+            | NoLine -> NoLine
+            | NewLine -> NoLine
+            | BlankLine -> BlankLine
+          in
+          loop lines' docs lexbuf
+      | EOL ->
+          let lines' =
+            match lines with
+            | NoLine -> NewLine
+            | NewLine -> BlankLine
+            | BlankLine -> BlankLine
+          in
+          loop lines' docs lexbuf
+      | DOCSTRING doc ->
+          Docstrings.register doc;
+          add_docstring_comment doc;
+          let docs' =
+            if Docstrings.docstring_body doc = "/*" then
+              match docs with
+              | Initial -> Before([], [doc], [])
+              | After a -> Before (a, [doc], [])
+              | Before(a, f, b) -> Before(a, doc :: b @ f, [])
+            else
+              match docs, lines with
+              | Initial, (NoLine | NewLine) -> After [doc]
+              | Initial, BlankLine -> Before([], [], [doc])
+              | After a, (NoLine | NewLine) -> After (doc :: a)
+              | After a, BlankLine -> Before (a, [], [doc])
+              | Before(a, f, b), (NoLine | NewLine) -> Before(a, f, doc :: b)
+              | Before(a, f, b), BlankLine -> Before(a, b @ f, [doc])
+          in
+          loop NoLine docs' lexbuf
+      | tok ->
+          attach lines docs (lexeme_start_p lexbuf);
+          tok
+    in
+      loop NoLine Initial lexbuf
+
+  let init () =
+    is_in_string := false;
+    comment_start_loc := [];
+    comment_list := [];
+    match !preprocessor with
+    | None -> ()
+    | Some (init, _preprocess) -> init ()
+
+  let set_preprocessor init preprocess =
+    escaped_newlines := true;
+    preprocessor := Some (init, preprocess)
+
+}
diff --git a/parsing/location.ml b/parsing/location.ml
new file mode 100644
index 00000000..aa596c85
--- /dev/null
+++ b/parsing/location.ml
@@ -0,0 +1,943 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Lexing
+
+type t = Warnings.loc =
+  { loc_start: position; loc_end: position; loc_ghost: bool };;
+
+let in_file name =
+  let loc = { dummy_pos with pos_fname = name } in
+  { loc_start = loc; loc_end = loc; loc_ghost = true }
+;;
+
+let none = in_file "_none_";;
+let is_none l = (l = none);;
+
+let curr lexbuf = {
+  loc_start = lexbuf.lex_start_p;
+  loc_end = lexbuf.lex_curr_p;
+  loc_ghost = false
+};;
+
+let init lexbuf fname =
+  lexbuf.lex_curr_p <- {
+    pos_fname = fname;
+    pos_lnum = 1;
+    pos_bol = 0;
+    pos_cnum = 0;
+  }
+;;
+
+let symbol_rloc () = {
+  loc_start = Parsing.symbol_start_pos ();
+  loc_end = Parsing.symbol_end_pos ();
+  loc_ghost = false;
+};;
+
+let symbol_gloc () = {
+  loc_start = Parsing.symbol_start_pos ();
+  loc_end = Parsing.symbol_end_pos ();
+  loc_ghost = true;
+};;
+
+let rhs_loc n = {
+  loc_start = Parsing.rhs_start_pos n;
+  loc_end = Parsing.rhs_end_pos n;
+  loc_ghost = false;
+};;
+
+let rhs_interval m n = {
+  loc_start = Parsing.rhs_start_pos m;
+  loc_end = Parsing.rhs_end_pos n;
+  loc_ghost = false;
+};;
+
+(* return file, line, char from the given position *)
+let get_pos_info pos =
+  (pos.pos_fname, pos.pos_lnum, pos.pos_cnum - pos.pos_bol)
+;;
+
+type 'a loc = {
+  txt : 'a;
+  loc : t;
+}
+
+let mkloc txt loc = { txt ; loc }
+let mknoloc txt = mkloc txt none
+
+(******************************************************************************)
+(* Input info *)
+
+let input_name = ref "_none_"
+let input_lexbuf = ref (None : lexbuf option)
+let input_phrase_buffer = ref (None : Buffer.t option)
+
+(******************************************************************************)
+(* Terminal info *)
+
+let status = ref Terminfo.Uninitialised
+
+let setup_terminal () =
+  if !status = Terminfo.Uninitialised then
+    status := Terminfo.setup stdout
+
+(* The number of lines already printed after input.
+
+   This is used by [highlight_terminfo] to identify the current position of the
+   input in the terminal. This would not be possible without this information,
+   since printing several warnings/errors adds text between the user input and
+   the bottom of the terminal.
+*)
+let num_loc_lines = ref 0
+
+(* This is used by the toplevel to reset [num_loc_lines] before each phrase *)
+let reset () =
+  num_loc_lines := 0
+
+(* This is used by the toplevel *)
+let echo_eof () =
+  print_newline ();
+  incr num_loc_lines
+
+(* Code printing errors and warnings must be wrapped using this function, in
+   order to update [num_loc_lines].
+
+   [print_updating_num_loc_lines ppf f arg] is equivalent to calling [f ppf
+   arg], and additionally updates [num_loc_lines]. *)
+let print_updating_num_loc_lines ppf f arg =
+  let open Format in
+  let out_functions = pp_get_formatter_out_functions ppf () in
+  let out_string str start len =
+    let rec count i c =
+      if i = start + len then c
+      else if String.get str i = '\n' then count (succ i) (succ c)
+      else count (succ i) c in
+    num_loc_lines := !num_loc_lines + count start 0 ;
+    out_functions.out_string str start len in
+  pp_set_formatter_out_functions ppf
+    { out_functions with out_string } ;
+  f ppf arg ;
+  pp_print_flush ppf ();
+  pp_set_formatter_out_functions ppf out_functions
+
+let setup_colors () =
+  Misc.Color.setup !Clflags.color
+
+(******************************************************************************)
+(* Printing locations, e.g. 'File "foo.ml", line 3, characters 10-12' *)
+
+let rewrite_absolute_path path =
+  match Misc.get_build_path_prefix_map () with
+  | None -> path
+  | Some map -> Build_path_prefix_map.rewrite map path
+
+let absolute_path s = (* This function could go into Filename *)
+  let open Filename in
+  let s =
+    if not (is_relative s) then s
+    else (rewrite_absolute_path (concat (Sys.getcwd ()) s))
+  in
+  (* Now simplify . and .. components *)
+  let rec aux s =
+    let base = basename s in
+    let dir = dirname s in
+    if dir = s then dir
+    else if base = current_dir_name then aux dir
+    else if base = parent_dir_name then dirname (aux dir)
+    else concat (aux dir) base
+  in
+  aux s
+
+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)
+
+(* Best-effort printing of the text describing a location, of the form
+   'File "foo.ml", line 3, characters 10-12'.
+
+   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_colors ();
+  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 (
+    comma ();
+    Format.fprintf ppf "%s %i-%i" (capitalize "characters") startchar endchar
+  );
+
+  Format.fprintf ppf "@}"
+
+(* 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
+
+(******************************************************************************)
+(* An interval set structure; additionally, it stores user-provided information
+   at interval boundaries.
+
+   The implementation provided here is naive and assumes the number of intervals
+   to be small, but the interface would allow for a more efficient
+   implementation if needed.
+
+   Note: the structure only stores maximal intervals (that therefore do not
+   overlap).
+*)
+
+module ISet : sig
+  type 'a bound = 'a * int
+  type 'a t
+  (* bounds are included *)
+  val of_intervals : ('a bound * 'a bound) list -> 'a t
+
+  val mem : 'a t -> pos:int -> bool
+  val find_bound_in : 'a t -> range:(int * int) -> 'a bound option
+
+  val is_start : 'a t -> pos:int -> 'a option
+  val is_end : 'a t -> pos:int -> 'a option
+
+  val extrema : 'a t -> ('a bound * 'a bound) option
+end
+=
+struct
+  type 'a bound = 'a * int
+
+  (* non overlapping intervals *)
+  type 'a t = ('a bound * 'a bound) list
+
+  let of_intervals intervals =
+    let pos =
+      List.map (fun ((a, x), (b, y)) ->
+        if x > y then [] else [((a, x), `S); ((b, y), `E)]
+      ) intervals
+      |> List.flatten
+      |> List.sort (fun ((_, x), k) ((_, y), k') ->
+        (* Make `S come before `E so that consecutive intervals get merged
+           together in the fold below *)
+        let kn = function `S -> 0 | `E -> 1 in
+        compare (x, kn k) (y, kn k'))
+    in
+    let nesting, acc =
+      List.fold_left (fun (nesting, acc) (a, kind) ->
+        match kind, nesting with
+        | `S, `Outside -> `Inside (a, 0), acc
+        | `S, `Inside (s, n) -> `Inside (s, n+1), acc
+        | `E, `Outside -> assert false
+        | `E, `Inside (s, 0) -> `Outside, ((s, a) :: acc)
+        | `E, `Inside (s, n) -> `Inside (s, n-1), acc
+      ) (`Outside, []) pos in
+    assert (nesting = `Outside);
+    List.rev acc
+
+  let mem iset ~pos =
+    List.exists (fun ((_, s), (_, e)) -> s <= pos && pos <= e) iset
+
+  let find_bound_in iset ~range:(start, end_)  =
+    Misc.Stdlib.List.find_map (fun ((a, x), (b, y)) ->
+      if start <= x && x <= end_ then Some (a, x)
+      else if start <= y && y <= end_ then Some (b, y)
+      else None
+    ) iset
+
+  let is_start iset ~pos =
+    Misc.Stdlib.List.find_map (fun ((a, x), _) ->
+      if pos = x then Some a else None
+    ) iset
+
+  let is_end iset ~pos =
+    Misc.Stdlib.List.find_map (fun (_, (b, y)) ->
+      if pos = y then Some b else None
+    ) iset
+
+  let extrema iset =
+    if iset = [] then None
+    else Some (fst (List.hd iset), snd (List.hd (List.rev iset)))
+end
+
+(******************************************************************************)
+(* Toplevel: highlighting and quoting locations *)
+
+(* Highlight the locations using standout mode.
+
+   If [locs] is empty, this function is a no-op.
+*)
+let highlight_terminfo lb ppf locs =
+  Format.pp_print_flush ppf ();  (* avoid mixing Format and normal output *)
+  (* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *)
+  let pos0 = -lb.lex_abs_pos in
+  (* Do nothing if the buffer does not contain the whole phrase. *)
+  if pos0 < 0 then raise Exit;
+  (* Count number of lines in phrase *)
+  let lines = ref !num_loc_lines in
+  for i = pos0 to lb.lex_buffer_len - 1 do
+    if Bytes.get lb.lex_buffer i = '\n' then incr lines
+  done;
+  (* If too many lines, give up *)
+  if !lines >= Terminfo.num_lines stdout - 2 then raise Exit;
+  (* Move cursor up that number of lines *)
+  flush stdout; Terminfo.backup stdout !lines;
+  (* Print the input, switching to standout for the location *)
+  let bol = ref false in
+  print_string "# ";
+  for pos = 0 to lb.lex_buffer_len - pos0 - 1 do
+    if !bol then (print_string "  "; bol := false);
+    if List.exists (fun loc -> pos = loc.loc_start.pos_cnum) locs then
+      Terminfo.standout stdout true;
+    if List.exists (fun loc -> pos = loc.loc_end.pos_cnum) locs then
+      Terminfo.standout stdout false;
+    let c = Bytes.get lb.lex_buffer (pos + pos0) in
+    print_char c;
+    bol := (c = '\n')
+  done;
+  (* Make sure standout mode is over *)
+  Terminfo.standout stdout false;
+  (* Position cursor back to original location *)
+  Terminfo.resume stdout !num_loc_lines;
+  flush stdout
+
+let highlight_terminfo lb ppf locs =
+  try highlight_terminfo lb ppf locs
+  with Exit -> ()
+
+(* Highlight the location by printing it again.
+
+   There are two different styles for highlighting errors in "dumb" mode,
+   depending if the error fits on a single line or spans across several lines.
+
+   For single-line errors,
+
+     foo the_error bar
+
+   gets displayed as follows, where X is the line number:
+
+     X | foo the_error bar
+             ^^^^^^^^^
+
+
+   For multi-line errors,
+
+     foo the_
+     error bar
+
+   gets displayed as:
+
+     X1 | ....the_
+     X2 | error....
+
+   An ellipsis hides the middle lines of the multi-line error if it has more
+   than [max_lines] lines.
+
+   If [locs] is empty then this function is a no-op.
+*)
+
+type input_line = {
+  text : string;
+  start_pos : int;
+}
+
+(* Takes a list of lines with possibly missing line numbers.
+
+   If the line numbers that are present are consistent with the number of lines
+   between them, then infer the intermediate line numbers.
+
+   This is not always the case, typically if lexer line directives are
+   involved... *)
+let infer_line_numbers
+    (lines: (int option * input_line) list):
+  (int option * input_line) list
+  =
+  let (_, offset, consistent) =
+    List.fold_left (fun (i, offset, consistent) (lnum, _) ->
+      match lnum, offset with
+      | None, _ -> (i+1, offset, consistent)
+      | Some n, None -> (i+1, Some (n - i), consistent)
+      | Some n, Some m -> (i+1, offset, consistent && n = m + i)
+    ) (0, None, true) lines
+  in
+  match offset, consistent with
+  | Some m, true ->
+      List.mapi (fun i (_, line) -> (Some (m + i), line)) lines
+  | _, _ ->
+      lines
+
+(* [get_lines] must return the lines to highlight, given starting and ending
+   positions.
+
+   See [lines_around_from_current_input] below for an instantiation of
+   [get_lines] that reads from the current input.
+*)
+let highlight_quote ppf
+    ~(get_lines: start_pos:position -> end_pos:position -> input_line list)
+    ?(max_lines = 10)
+    highlight_tag
+    locs
+  =
+  let iset = ISet.of_intervals @@ List.filter_map (fun loc ->
+    let s, e = loc.loc_start, loc.loc_end in
+    if s.pos_cnum = -1 || e.pos_cnum = -1 then None
+    else Some ((s, s.pos_cnum), (e, e.pos_cnum - 1))
+  ) locs in
+  match ISet.extrema iset with
+  | None -> ()
+  | Some ((leftmost, _), (rightmost, _)) ->
+      let lines =
+        get_lines ~start_pos:leftmost ~end_pos:rightmost
+        |> List.map (fun ({ text; start_pos } as line) ->
+          let end_pos = start_pos + String.length text - 1 in
+          let line_nb =
+            match ISet.find_bound_in iset ~range:(start_pos, end_pos) with
+            | None -> None
+            | Some (p, _) -> Some p.pos_lnum
+          in
+          (line_nb, line))
+        |> infer_line_numbers
+        |> List.map (fun (lnum, { text; start_pos }) ->
+          (text,
+           Option.fold ~some:Int.to_string ~none:"" lnum,
+           start_pos))
+      in
+    Format.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) "";
+        for pos = line_start_cnum to rightmost.pos_cnum - 1 do
+          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 '^'
+          else Format.pp_print_char ppf ' ';
+          if ISet.is_end iset ~pos <> None then
+            Format.fprintf ppf "@}"
+        done;
+        Format.fprintf ppf "@}@,"
+    | _ ->
+        (* Multi-line error *)
+        Misc.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 '.'
+          ) line in
+          (line_nb, line)
+        ) lines
+    end;
+    Format.fprintf ppf "@]"
+
+
+
+let lines_around
+    ~(start_pos: position) ~(end_pos: position)
+    ~(seek: int -> unit)
+    ~(read_char: unit -> char option):
+  input_line list
+  =
+  seek start_pos.pos_bol;
+  let lines = ref [] in
+  let bol = ref start_pos.pos_bol in
+  let cur = ref start_pos.pos_bol in
+  let b = Buffer.create 80 in
+  let add_line () =
+    if !bol < !cur then begin
+      let text = Buffer.contents b in
+      Buffer.clear b;
+      lines := { text; start_pos = !bol } :: !lines;
+      bol := !cur
+    end
+  in
+  let rec loop () =
+    if !bol >= end_pos.pos_cnum then ()
+    else begin
+      match read_char () with
+      | None ->
+          (* end of input *)
+          add_line ()
+      | Some c ->
+          incr cur;
+          match c with
+          | '\r' -> loop ()
+          | '\n' -> add_line (); loop ()
+          | _ -> Buffer.add_char b c; loop ()
+    end
+  in
+  loop ();
+  List.rev !lines
+
+(* Try to get lines from a lexbuf *)
+let lines_around_from_lexbuf
+    ~(start_pos: position) ~(end_pos: position)
+    (lb: lexbuf):
+  input_line list
+  =
+  (* Converts a global position to one that is relative to the lexing buffer *)
+  let rel n = n - lb.lex_abs_pos in
+  if rel start_pos.pos_bol < 0 then begin
+    (* Do nothing if the buffer does not contain the input (because it has been
+       refilled while lexing it) *)
+    []
+  end else begin
+    let pos = ref 0 in (* relative position *)
+    let seek n = pos := rel n in
+    let read_char () =
+      if !pos >= lb.lex_buffer_len then (* end of buffer *) None
+      else
+        let c = Bytes.get lb.lex_buffer !pos in
+        incr pos; Some c
+    in
+    lines_around ~start_pos ~end_pos ~seek ~read_char
+  end
+
+(* Attempt to get lines from the phrase buffer *)
+let lines_around_from_phrasebuf
+    ~(start_pos: position) ~(end_pos: position)
+    (pb: Buffer.t):
+  input_line list
+  =
+  let pos = ref 0 in
+  let seek n = pos := n in
+  let read_char () =
+    if !pos >= Buffer.length pb then None
+    else begin
+      let c = Buffer.nth pb !pos in
+      incr pos; Some c
+    end
+  in
+  lines_around ~start_pos ~end_pos ~seek ~read_char
+
+(* Get lines from a file *)
+let lines_around_from_file
+    ~(start_pos: position) ~(end_pos: position)
+    (filename: string):
+  input_line list
+  =
+  try
+    let cin = open_in_bin filename in
+    let read_char () =
+      try Some (input_char cin) with End_of_file -> None
+    in
+    let lines =
+      lines_around ~start_pos ~end_pos ~seek:(seek_in cin) ~read_char
+    in
+    close_in cin;
+    lines
+  with Sys_error _ -> []
+
+(* A [get_lines] function for [highlight_quote] that reads from the current
+   input.
+
+   It first tries to read from [!input_lexbuf], then if that fails (because the
+   lexbuf no longer contains the input we want), it reads from [!input_name]
+   directly *)
+let lines_around_from_current_input ~start_pos ~end_pos =
+  (* Be a bit defensive, and do not try to open one of the possible
+     [!input_name] values that we know do not denote valid filenames. *)
+  let file_valid = function
+    | "//toplevel//" | "_none_" | "" -> false
+    | _ -> true
+  in
+  let from_file () =
+    if file_valid !input_name then
+      lines_around_from_file !input_name ~start_pos ~end_pos
+    else
+      []
+  in
+  match !input_lexbuf, !input_phrase_buffer, !input_name with
+  | _, Some pb, "//toplevel//" ->
+      begin match lines_around_from_phrasebuf pb ~start_pos ~end_pos with
+      | [] -> (* Could not read the input from the phrase buffer. This is likely
+                 a sign that we were given a buggy location. *)
+          []
+      | lines ->
+          lines
+      end
+  | Some lb, _, _ ->
+      begin match lines_around_from_lexbuf lb ~start_pos ~end_pos with
+      | [] -> (* The input is likely not in the lexbuf anymore *)
+          from_file ()
+      | lines ->
+          lines
+      end
+  | None, _, _ ->
+      from_file ()
+
+(******************************************************************************)
+(* Reporting errors and warnings *)
+
+type msg = (Format.formatter -> unit) loc
+
+let msg ?(loc = none) fmt =
+  Format.kdprintf (fun txt -> { loc; txt }) fmt
+
+type report_kind =
+  | Report_error
+  | Report_warning of string
+  | Report_warning_as_error of string
+  | Report_alert of string
+  | Report_alert_as_error of string
+
+type report = {
+  kind : report_kind;
+  main : msg;
+  sub : msg list;
+}
+
+type report_printer = {
+  (* The entry point *)
+  pp : report_printer ->
+    Format.formatter -> report -> unit;
+
+  pp_report_kind : report_printer -> report ->
+    Format.formatter -> report_kind -> unit;
+  pp_main_loc : report_printer -> report ->
+    Format.formatter -> t -> unit;
+  pp_main_txt : report_printer -> report ->
+    Format.formatter -> (Format.formatter -> unit) -> unit;
+  pp_submsgs : report_printer -> report ->
+    Format.formatter -> msg list -> unit;
+  pp_submsg : report_printer -> report ->
+    Format.formatter -> msg -> unit;
+  pp_submsg_loc : report_printer -> report ->
+    Format.formatter -> t -> unit;
+  pp_submsg_txt : report_printer -> report ->
+    Format.formatter -> (Format.formatter -> unit) -> unit;
+}
+
+let is_dummy_loc loc =
+  (* Fixme: this should be just [loc.loc_ghost] and the function should be
+     inlined below. However, currently, the compiler emits in some places ghost
+     locations with valid ranges that should still be printed. These locations
+     should be made non-ghost -- in the meantime we just check if the ranges are
+     valid. *)
+  loc.loc_start.pos_cnum = -1 || loc.loc_end.pos_cnum = -1
+
+(* It only makes sense to highlight (i.e. quote or underline the corresponding
+   source code) locations that originate from the current input.
+
+   As of now, this should only happen in the following cases:
+
+   - if dummy locs or ghost locs leak out of the compiler or a buggy ppx;
+
+   - more generally, if some code uses the compiler-libs API and feeds it
+   locations that do not match the current values of [!Location.input_name],
+   [!Location.input_lexbuf];
+
+   - when calling the compiler on a .ml file that contains lexer line directives
+   indicating an other file. This should happen relatively rarely in practice --
+   in particular this is not what happens when using -pp or -ppx or a ppx
+   driver.
+*)
+let is_quotable_loc loc =
+  not (is_dummy_loc loc)
+  && loc.loc_start.pos_fname = !input_name
+  && loc.loc_end.pos_fname = !input_name
+
+let error_style () =
+  match !Clflags.error_style with
+  | Some setting -> setting
+  | None -> Misc.Error_style.default_setting
+
+let batch_mode_printer : report_printer =
+  let pp_loc _self report ppf loc =
+    let tag = match report.kind with
+      | Report_warning_as_error _
+      | Report_alert_as_error _
+      | Report_error -> "error"
+      | Report_warning _
+      | Report_alert _ -> "warning"
+    in
+    let highlight ppf loc =
+      match error_style () with
+      | Misc.Error_style.Contextual ->
+          if is_quotable_loc loc then
+            highlight_quote ppf
+              ~get_lines:lines_around_from_current_input
+              tag [loc]
+      | Misc.Error_style.Short ->
+          ()
+    in
+    Format.fprintf ppf "@[<v>%a:@ %a@]" print_loc loc highlight loc
+  in
+  let pp_txt ppf txt = Format.fprintf ppf "@[%t@]" txt in
+  let pp self ppf report =
+    setup_colors ();
+    (* Make sure we keep [num_loc_lines] updated. *)
+    print_updating_num_loc_lines ppf (fun ppf () ->
+      Format.fprintf ppf "@[<v>%a%a: %a%a@]@."
+      (self.pp_main_loc self report) report.main.loc
+      (self.pp_report_kind self report) report.kind
+      (self.pp_main_txt self report) report.main.txt
+      (self.pp_submsgs self report) report.sub
+    ) ()
+  in
+  let pp_report_kind _self _ ppf = function
+    | Report_error -> Format.fprintf ppf "@{<error>Error@}"
+    | Report_warning w -> Format.fprintf ppf "@{<warning>Warning@} %s" w
+    | Report_warning_as_error w ->
+        Format.fprintf ppf "@{<error>Error@} (warning %s)" w
+    | Report_alert w -> Format.fprintf ppf "@{<warning>Alert@} %s" w
+    | Report_alert_as_error w ->
+        Format.fprintf ppf "@{<error>Error@} (alert %s)" w
+  in
+  let pp_main_loc self report ppf loc =
+    pp_loc self report ppf loc
+  in
+  let pp_main_txt _self _ ppf txt =
+    pp_txt ppf txt
+  in
+  let pp_submsgs self report ppf msgs =
+    List.iter (fun msg ->
+      Format.fprintf ppf "@,%a" (self.pp_submsg self report) msg
+    ) msgs
+  in
+  let pp_submsg self report ppf { loc; txt } =
+    Format.fprintf ppf "@[%a  %a@]"
+      (self.pp_submsg_loc self report) loc
+      (self.pp_submsg_txt self report) txt
+  in
+  let pp_submsg_loc self report ppf loc =
+    if not loc.loc_ghost then
+      pp_loc self report ppf loc
+  in
+  let pp_submsg_txt _self _ ppf loc =
+    pp_txt ppf loc
+  in
+  { pp; pp_report_kind; pp_main_loc; pp_main_txt;
+    pp_submsgs; pp_submsg; pp_submsg_loc; pp_submsg_txt }
+
+let terminfo_toplevel_printer (lb: lexbuf): report_printer =
+  let pp self ppf err =
+    setup_colors ();
+    (* Highlight all toplevel locations of the report, instead of displaying
+       the main location. Do it now instead of in [pp_main_loc], to avoid
+       messing with Format boxes. *)
+    let sub_locs = List.map (fun { loc; _ } -> loc) err.sub in
+    let all_locs = err.main.loc :: sub_locs in
+    let locs_highlighted = List.filter is_quotable_loc all_locs in
+    highlight_terminfo lb ppf locs_highlighted;
+    batch_mode_printer.pp self ppf err
+  in
+  let pp_main_loc _ _ _ _ = () in
+  let pp_submsg_loc _ _ ppf loc =
+    if not loc.loc_ghost then
+      Format.fprintf ppf "%a:@ " print_loc loc in
+  { batch_mode_printer with pp; pp_main_loc; pp_submsg_loc }
+
+let best_toplevel_printer () =
+  setup_terminal ();
+  match !status, !input_lexbuf with
+  | Terminfo.Good_term, Some lb ->
+      terminfo_toplevel_printer lb
+  | _, _ ->
+      batch_mode_printer
+
+(* Creates a printer for the current input *)
+let default_report_printer () : report_printer =
+  if !input_name = "//toplevel//" then
+    best_toplevel_printer ()
+  else
+    batch_mode_printer
+
+let report_printer = ref default_report_printer
+
+let print_report ppf report =
+  let printer = !report_printer () in
+  printer.pp printer ppf report
+
+(******************************************************************************)
+(* Reporting errors *)
+
+type error = report
+
+let report_error ppf err =
+  print_report ppf err
+
+let mkerror loc sub txt =
+  { kind = Report_error; main = { loc; txt }; sub }
+
+let errorf ?(loc = none) ?(sub = []) =
+  Format.kdprintf (mkerror loc sub)
+
+let error ?(loc = none) ?(sub = []) msg_str =
+  mkerror loc sub (fun ppf -> Format.pp_print_string ppf msg_str)
+
+let error_of_printer ?(loc = none) ?(sub = []) pp x =
+  mkerror loc sub (fun ppf -> pp ppf x)
+
+let error_of_printer_file print x =
+  error_of_printer ~loc:(in_file !input_name) print x
+
+(******************************************************************************)
+(* Reporting warnings: generating a report from a warning number using the
+   information in [Warnings] + convenience functions. *)
+
+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 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 }
+
+
+let default_warning_reporter =
+  default_warning_alert_reporter
+    Warnings.report
+    (fun is_error id ->
+       if is_error then Report_warning_as_error id
+       else Report_warning id
+    )
+
+let warning_reporter = ref default_warning_reporter
+let report_warning loc w = !warning_reporter loc w
+
+let formatter_for_warnings = ref Format.err_formatter
+
+let print_warning loc ppf w =
+  match report_warning loc w with
+  | None -> ()
+  | Some report -> print_report ppf report
+
+let prerr_warning loc w = print_warning loc !formatter_for_warnings w
+
+let default_alert_reporter =
+  default_warning_alert_reporter
+    Warnings.report_alert
+    (fun is_error id ->
+       if is_error then Report_alert_as_error id
+       else Report_alert id
+    )
+
+let alert_reporter = ref default_alert_reporter
+let report_alert loc w = !alert_reporter loc w
+
+let print_alert loc ppf w =
+  match report_alert loc w with
+  | None -> ()
+  | Some report -> print_report ppf report
+
+let prerr_alert loc w = print_alert loc !formatter_for_warnings w
+
+let alert ?(def = none) ?(use = none) ~kind loc message =
+  prerr_alert loc {Warnings.kind; message; def; use}
+
+let deprecated ?def ?use loc message =
+  alert ?def ?use ~kind:"deprecated" loc message
+
+(******************************************************************************)
+(* Reporting errors on exceptions *)
+
+let error_of_exn : (exn -> error option) list ref = ref []
+
+let register_error_of_exn f = error_of_exn := f :: !error_of_exn
+
+exception Already_displayed_error = Warnings.Errors
+
+let error_of_exn exn =
+  match exn with
+  | Already_displayed_error -> Some `Already_displayed
+  | _ ->
+     let rec loop = function
+       | [] -> None
+       | f :: rest ->
+          match f exn with
+          | Some error -> Some (`Ok error)
+          | None -> loop rest
+     in
+     loop !error_of_exn
+
+let () =
+  register_error_of_exn
+    (function
+      | Sys_error msg ->
+          Some (errorf ~loc:(in_file !input_name) "I/O error: %s" msg)
+      | _ -> None
+    )
+
+external reraise : exn -> 'a = "%reraise"
+
+let report_exception ppf exn =
+  let rec loop n exn =
+    match error_of_exn exn with
+    | None -> reraise exn
+    | Some `Already_displayed -> ()
+    | Some (`Ok err) -> report_error ppf err
+    | exception exn when n > 0 -> loop (n-1) exn
+  in
+  loop 5 exn
+
+exception Error of error
+
+let () =
+  register_error_of_exn
+    (function
+      | Error e -> Some e
+      | _ -> None
+    )
+
+let raise_errorf ?(loc = none) ?(sub = []) =
+  Format.kdprintf (fun txt -> raise (Error (mkerror loc sub txt)))
diff --git a/parsing/location.mli b/parsing/location.mli
new file mode 100644
index 00000000..ecf39b21
--- /dev/null
+++ b/parsing/location.mli
@@ -0,0 +1,287 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** {1 Source code locations (ranges of positions), used in parsetree}
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Format
+
+type t = Warnings.loc = {
+  loc_start: Lexing.position;
+  loc_end: Lexing.position;
+  loc_ghost: bool;
+}
+
+(** Note on the use of Lexing.position in this module.
+   If [pos_fname = ""], then use [!input_name] instead.
+   If [pos_lnum = -1], then [pos_bol = 0]. Use [pos_cnum] and
+     re-parse the file to get the line and character numbers.
+   Else all fields are correct.
+*)
+
+val none : t
+(** An arbitrary value of type [t]; describes an empty ghost range. *)
+
+val is_none : t -> bool
+(** True for [Location.none], false any other location *)
+
+val in_file : string -> t
+(** Return an empty ghost range located in a given file. *)
+
+val init : Lexing.lexbuf -> string -> unit
+(** Set the file name and line number of the [lexbuf] to be the start
+    of the named file. *)
+
+val curr : Lexing.lexbuf -> t
+(** Get the location of the current token from the [lexbuf]. *)
+
+val symbol_rloc: unit -> t
+val symbol_gloc: unit -> t
+
+(** [rhs_loc n] returns the location of the symbol at position [n], starting
+  at 1, in the current parser rule. *)
+val rhs_loc: int -> t
+
+val rhs_interval: int -> int -> t
+
+val get_pos_info: Lexing.position -> string * int * int
+(** file, line, char *)
+
+type 'a loc = {
+  txt : 'a;
+  loc : t;
+}
+
+val mknoloc : 'a -> 'a loc
+val mkloc : 'a -> t -> 'a loc
+
+
+(** {1 Input info} *)
+
+val input_name: string ref
+val input_lexbuf: Lexing.lexbuf option ref
+
+(* This is used for reporting errors coming from the toplevel.
+
+   When running a toplevel session (i.e. when [!input_name] is "//toplevel//"),
+   [!input_phrase_buffer] should be [Some buf] where [buf] contains the last
+   toplevel phrase. *)
+val input_phrase_buffer: Buffer.t option ref
+
+
+(** {1 Toplevel-specific functions} *)
+
+val echo_eof: unit -> unit
+val reset: unit -> unit
+
+
+(** {1 Printing locations} *)
+
+val rewrite_absolute_path: string -> string
+    (** rewrite absolute path to honor the BUILD_PATH_PREFIX_MAP
+        variable (https://reproducible-builds.org/specs/build-path-prefix-map/)
+        if it is set. *)
+
+val absolute_path: string -> string
+
+val show_filename: string -> string
+    (** In -absname mode, return the absolute path for this filename.
+        Otherwise, returns the filename unchanged. *)
+
+val print_filename: formatter -> string -> unit
+
+val print_loc: formatter -> t -> unit
+val print_locs: formatter -> t list -> unit
+
+
+(** {1 Toplevel-specific location highlighting} *)
+
+val highlight_terminfo:
+  Lexing.lexbuf -> formatter -> t list -> unit
+
+
+(** {1 Reporting errors and warnings} *)
+
+(** {2 The type of reports and report printers} *)
+
+type msg = (Format.formatter -> unit) loc
+
+val msg: ?loc:t -> ('a, Format.formatter, unit, msg) format4 -> 'a
+
+type report_kind =
+  | Report_error
+  | Report_warning of string
+  | Report_warning_as_error of string
+  | Report_alert of string
+  | Report_alert_as_error of string
+
+type report = {
+  kind : report_kind;
+  main : msg;
+  sub : msg list;
+}
+
+type report_printer = {
+  (* The entry point *)
+  pp : report_printer ->
+    Format.formatter -> report -> unit;
+
+  pp_report_kind : report_printer -> report ->
+    Format.formatter -> report_kind -> unit;
+  pp_main_loc : report_printer -> report ->
+    Format.formatter -> t -> unit;
+  pp_main_txt : report_printer -> report ->
+    Format.formatter -> (Format.formatter -> unit) -> unit;
+  pp_submsgs : report_printer -> report ->
+    Format.formatter -> msg list -> unit;
+  pp_submsg : report_printer -> report ->
+    Format.formatter -> msg -> unit;
+  pp_submsg_loc : report_printer -> report ->
+    Format.formatter -> t -> unit;
+  pp_submsg_txt : report_printer -> report ->
+    Format.formatter -> (Format.formatter -> unit) -> 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
+    existing ones.
+*)
+
+(** {2 Report printers used in the compiler} *)
+
+val batch_mode_printer: report_printer
+
+val terminfo_toplevel_printer: Lexing.lexbuf -> report_printer
+
+val best_toplevel_printer: unit -> report_printer
+(** Detects the terminal capabilities and selects an adequate printer *)
+
+(** {2 Printing a [report]} *)
+
+val print_report: formatter -> report -> unit
+(** Display an error or warning report. *)
+
+val report_printer: (unit -> report_printer) ref
+(** Hook for redefining the printer of reports.
+
+    The hook is a [unit -> report_printer] and not simply a [report_printer]:
+    this is useful so that it can detect the type of the output (a file, a
+    terminal, ...) and select a printer accordingly. *)
+
+val default_report_printer: unit -> report_printer
+(** Original report printer for use in hooks. *)
+
+
+(** {1 Reporting warnings} *)
+
+(** {2 Converting a [Warnings.t] into a [report]} *)
+
+val report_warning: t -> Warnings.t -> report option
+(** [report_warning loc w] produces a report for the given warning [w], or
+   [None] if the warning is not to be printed. *)
+
+val warning_reporter: (t -> Warnings.t -> report option) ref
+(** Hook for intercepting warnings. *)
+
+val default_warning_reporter: t -> Warnings.t -> report option
+(** Original warning reporter for use in hooks. *)
+
+(** {2 Printing warnings} *)
+
+val formatter_for_warnings : formatter ref
+
+val print_warning: t -> formatter -> Warnings.t -> unit
+(** Prints a warning. This is simply the composition of [report_warning] and
+   [print_report]. *)
+
+val prerr_warning: t -> Warnings.t -> unit
+(** Same as [print_warning], but uses [!formatter_for_warnings] as output
+   formatter. *)
+
+(** {1 Reporting alerts} *)
+
+(** {2 Converting an [Alert.t] into a [report]} *)
+
+val report_alert: t -> Warnings.alert -> report option
+(** [report_alert loc w] produces a report for the given alert [w], or
+   [None] if the alert is not to be printed. *)
+
+val alert_reporter: (t -> Warnings.alert -> report option) ref
+(** Hook for intercepting alerts. *)
+
+val default_alert_reporter: t -> Warnings.alert -> report option
+(** Original alert reporter for use in hooks. *)
+
+(** {2 Printing alerts} *)
+
+val print_alert: t -> formatter -> Warnings.alert -> unit
+(** Prints an alert. This is simply the composition of [report_alert] and
+   [print_report]. *)
+
+val prerr_alert: t -> Warnings.alert -> unit
+(** Same as [print_alert], but uses [!formatter_for_warnings] as output
+   formatter. *)
+
+val deprecated: ?def:t -> ?use:t -> t -> string -> unit
+(** Prints a deprecation alert. *)
+
+val alert: ?def:t -> ?use:t -> kind:string -> t -> string -> unit
+(** Prints an arbitrary alert. *)
+
+
+(** {1 Reporting errors} *)
+
+type error = report
+(** An [error] is a [report] which [report_kind] must be [Report_error]. *)
+
+val error: ?loc:t -> ?sub:msg list -> string -> error
+
+val errorf: ?loc:t -> ?sub:msg list ->
+  ('a, Format.formatter, unit, error) format4 -> 'a
+
+val error_of_printer: ?loc:t -> ?sub:msg list ->
+  (formatter -> 'a -> unit) -> 'a -> error
+
+val error_of_printer_file: (formatter -> 'a -> unit) -> 'a -> error
+
+
+(** {1 Automatically reporting errors for raised exceptions} *)
+
+val register_error_of_exn: (exn -> error option) -> unit
+(** Each compiler module which defines a custom type of exception
+    which can surface as a user-visible error should register
+    a "printer" for this exception using [register_error_of_exn].
+    The result of the printer is an [error] value containing
+    a location, a message, and optionally sub-messages (each of them
+    being located as well). *)
+
+val error_of_exn: exn -> [ `Ok of error | `Already_displayed ] option
+
+exception Error of error
+(** Raising [Error e] signals an error [e]; the exception will be caught and the
+   error will be printed. *)
+
+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 report_exception: formatter -> exn -> unit
+(** Reraise the exception if it is unknown. *)
diff --git a/parsing/longident.ml b/parsing/longident.ml
new file mode 100644
index 00000000..eaafb02b
--- /dev/null
+++ b/parsing/longident.ml
@@ -0,0 +1,50 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t =
+    Lident of string
+  | Ldot of t * string
+  | Lapply of t * t
+
+let rec flat accu = function
+    Lident s -> s :: accu
+  | Ldot(lid, s) -> flat (s :: accu) lid
+  | Lapply(_, _) -> Misc.fatal_error "Longident.flat"
+
+let flatten lid = flat [] lid
+
+let last = function
+    Lident s -> s
+  | Ldot(_, s) -> s
+  | Lapply(_, _) -> Misc.fatal_error "Longident.last"
+
+
+let rec split_at_dots s pos =
+  try
+    let dot = String.index_from s pos '.' in
+    String.sub s pos (dot - pos) :: split_at_dots s (dot + 1)
+  with Not_found ->
+    [String.sub s pos (String.length s - pos)]
+
+let unflatten l =
+  match l with
+  | [] -> None
+  | hd :: tl -> Some (List.fold_left (fun p s -> Ldot(p, s)) (Lident hd) tl)
+
+let parse s =
+  match unflatten (split_at_dots s 0) with
+  | None -> Lident ""  (* should not happen, but don't put assert false
+                          so as not to crash the toplevel (see Genprintval) *)
+  | Some v -> v
diff --git a/parsing/longident.mli b/parsing/longident.mli
new file mode 100644
index 00000000..07086301
--- /dev/null
+++ b/parsing/longident.mli
@@ -0,0 +1,60 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Long identifiers, used in parsetree.
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type t =
+    Lident of string
+  | Ldot of t * string
+  | Lapply of t * t
+
+val flatten: t -> string list
+val unflatten: string list -> t option
+(** For a non-empty list [l], [unflatten l] is [Some lid] where [lid] is
+    the long identifier created by concatenating the elements of [l]
+    with [Ldot].
+    [unflatten []] is [None].
+*)
+
+val last: t -> string
+val parse: string -> t
+[@@deprecated "this function may misparse its input,\n\
+use \"Parse.longident\" or \"Longident.unflatten\""]
+(**
+
+   This function is broken on identifiers that are not just "Word.Word.word";
+   for example, it returns incorrect results on infix operators
+   and extended module paths.
+
+   If you want to generate long identifiers that are a list of
+   dot-separated identifiers, the function {!unflatten} is safer and faster.
+   {!unflatten} is available since OCaml 4.06.0.
+
+   If you want to parse any identifier correctly, use the long-identifiers
+   functions from the {!Parse} module, in particular {!Parse.longident}.
+   They are available since OCaml 4.11, and also provide proper
+   input-location support.
+
+*)
+
+
+
+(** To print a longident, see {!Pprintast.longident}, using
+    {!Format.asprintf} to convert to a string. *)
diff --git a/parsing/parse.ml b/parsing/parse.ml
new file mode 100644
index 00000000..b0cee445
--- /dev/null
+++ b/parsing/parse.ml
@@ -0,0 +1,173 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Entry points in the parser *)
+
+(* Skip tokens to the end of the phrase *)
+
+let last_token = ref Parser.EOF
+
+let token lexbuf =
+  let token = Lexer.token lexbuf in
+  last_token := token;
+  token
+
+let rec skip_phrase lexbuf =
+  match token lexbuf with
+  | Parser.SEMISEMI | Parser.EOF -> ()
+  | _ -> skip_phrase lexbuf
+  | exception (Lexer.Error (Lexer.Unterminated_comment _, _)
+              | Lexer.Error (Lexer.Unterminated_string, _)
+              | Lexer.Error (Lexer.Reserved_sequence _, _)
+              | Lexer.Error (Lexer.Unterminated_string_in_comment _, _)
+              | Lexer.Error (Lexer.Illegal_character _, _)) ->
+      skip_phrase lexbuf
+
+let maybe_skip_phrase lexbuf =
+  match !last_token with
+  | Parser.SEMISEMI | Parser.EOF -> ()
+  | _ -> skip_phrase lexbuf
+
+let wrap parsing_fun lexbuf =
+  try
+    Docstrings.init ();
+    Lexer.init ();
+    let ast = parsing_fun lexbuf in
+    Parsing.clear_parser();
+    Docstrings.warn_bad_docstrings ();
+    last_token := Parser.EOF;
+    ast
+  with
+  | Lexer.Error(Lexer.Illegal_character _, _) as err
+    when !Location.input_name = "//toplevel//"->
+      skip_phrase lexbuf;
+      raise err
+  | Syntaxerr.Error _ as err
+    when !Location.input_name = "//toplevel//" ->
+      maybe_skip_phrase lexbuf;
+      raise err
+  | Parsing.Parse_error | Syntaxerr.Escape_error ->
+      let loc = Location.curr lexbuf in
+      if !Location.input_name = "//toplevel//"
+      then maybe_skip_phrase lexbuf;
+      raise(Syntaxerr.Error(Syntaxerr.Other loc))
+
+let rec loop lexbuf in_error checkpoint =
+  let module I = Parser.MenhirInterpreter in
+  match checkpoint with
+  | I.InputNeeded _env ->
+      let triple =
+        if in_error then
+          (* The parser detected an error.
+             At this point we don't want to consume input anymore. In the
+             top-level, it would translate into waiting for the user to type
+             something, just to raise an error at some earlier position, rather
+             than just raising the error immediately.
+
+             This worked before with yacc because, AFAICT (@let-def):
+             - yacc eagerly reduces "default reduction" (when the next action
+               is to reduce the same production no matter what token is read,
+               yacc reduces it immediately rather than waiting for that token
+               to be read)
+             - error productions in OCaml grammar are always in a position that
+               allows default reduction ("error" symbol is the last producer,
+               and the lookahead token will not be used to disambiguate between
+               two possible error rules)
+             This solution is fragile because it relies on an optimization
+             (default reduction), that changes the semantics of the parser the
+             way it is implemented in Yacc (an optimization that changes
+             semantics? hmmmm).
+
+             Rather than relying on implementation details of the parser, when
+             an error is detected in this loop we stop looking at the input and
+             fill the parser with EOF tokens.
+             The skip_phrase logic will resynchronize the input stream by
+             looking for the next ';;'.  *)
+          (Parser.EOF, lexbuf.Lexing.lex_curr_p, lexbuf.Lexing.lex_curr_p)
+        else
+          let token = token lexbuf in
+          (token, lexbuf.Lexing.lex_start_p, lexbuf.Lexing.lex_curr_p)
+      in
+      let checkpoint = I.offer checkpoint triple in
+      loop lexbuf in_error checkpoint
+  | I.Shifting _ | I.AboutToReduce _ ->
+      loop lexbuf in_error (I.resume checkpoint)
+  | I.Accepted v -> v
+  | I.Rejected -> raise Parser.Error
+  | I.HandlingError _ ->
+      loop lexbuf true (I.resume checkpoint)
+
+let wrap_menhir entry lexbuf =
+  let initial = entry lexbuf.Lexing.lex_curr_p in
+  wrap (fun lexbuf -> loop lexbuf false initial) lexbuf
+
+let implementation = wrap_menhir Parser.Incremental.implementation
+and interface = wrap_menhir Parser.Incremental.interface
+and toplevel_phrase = wrap_menhir Parser.Incremental.toplevel_phrase
+and use_file = wrap_menhir Parser.Incremental.use_file
+and core_type = wrap_menhir Parser.Incremental.parse_core_type
+and expression = wrap_menhir Parser.Incremental.parse_expression
+and pattern = wrap_menhir Parser.Incremental.parse_pattern
+
+let longident = wrap_menhir Parser.Incremental.parse_any_longident
+let val_ident = wrap_menhir Parser.Incremental.parse_val_longident
+let constr_ident= wrap_menhir Parser.Incremental.parse_constr_longident
+let extended_module_path =
+  wrap_menhir Parser.Incremental.parse_mod_ext_longident
+let simple_module_path = wrap_menhir Parser.Incremental.parse_mod_longident
+let type_ident = wrap_menhir Parser.Incremental.parse_mty_longident
+
+(* Error reporting for Syntaxerr *)
+(* The code has been moved here so that one can reuse Pprintast.tyvar *)
+
+let prepare_error err =
+  let open Syntaxerr in
+  match err with
+  | Unclosed(opening_loc, opening, closing_loc, closing) ->
+      Location.errorf
+        ~loc:closing_loc
+        ~sub:[
+          Location.msg ~loc:opening_loc
+            "This '%s' might be unmatched" opening
+        ]
+        "Syntax error: '%s' expected" closing
+
+  | Expecting (loc, nonterm) ->
+      Location.errorf ~loc "Syntax error: %s expected." nonterm
+  | Not_expecting (loc, nonterm) ->
+      Location.errorf ~loc "Syntax error: %s not expected." nonterm
+  | Applicative_path loc ->
+      Location.errorf ~loc
+        "Syntax error: applicative paths of the form F(X).t \
+         are not supported when the option -no-app-func is set."
+  | Variable_in_scope (loc, var) ->
+      Location.errorf ~loc
+        "In this scoped type, variable %a \
+         is reserved for the local type %s."
+        Pprintast.tyvar var var
+  | Other loc ->
+      Location.errorf ~loc "Syntax error"
+  | Ill_formed_ast (loc, s) ->
+      Location.errorf ~loc
+        "broken invariant in parsetree: %s" s
+  | Invalid_package_type (loc, s) ->
+      Location.errorf ~loc "invalid package type: %s" s
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Syntaxerr.Error err -> Some (prepare_error err)
+      | _ -> None
+    )
diff --git a/parsing/parse.mli b/parsing/parse.mli
new file mode 100644
index 00000000..699e6bad
--- /dev/null
+++ b/parsing/parse.mli
@@ -0,0 +1,108 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Entry points in the parser
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+val implementation : Lexing.lexbuf -> Parsetree.structure
+val interface : Lexing.lexbuf -> Parsetree.signature
+val toplevel_phrase : Lexing.lexbuf -> Parsetree.toplevel_phrase
+val use_file : Lexing.lexbuf -> Parsetree.toplevel_phrase list
+val core_type : Lexing.lexbuf -> Parsetree.core_type
+val expression : Lexing.lexbuf -> Parsetree.expression
+val pattern : Lexing.lexbuf -> Parsetree.pattern
+
+(** The functions below can be used to parse Longident safely. *)
+
+val longident: Lexing.lexbuf -> Longident.t
+(**
+   The function [longident] is guaranted to parse all subclasses
+   of {!Longident.t} used in OCaml: values, constructors, simple or extended
+   module paths, and types or module types.
+
+   However, this function accepts inputs which are not accepted by the
+   compiler, because they combine functor applications and infix operators.
+   In valid OCaml syntax, only value-level identifiers may end with infix
+   operators [Foo.( + )].
+   Moreover, in value-level identifiers the module path [Foo] must be simple
+   ([M.N] rather than [F(X)]): functor applications may only appear in
+   type-level identifiers.
+   As a consequence, a path such as [F(X).( + )] is not a valid OCaml
+   identifier; but it is accepted by this function.
+*)
+
+(** The next functions are specialized to a subclass of {!Longident.t} *)
+
+val val_ident: Lexing.lexbuf -> Longident.t
+(**
+   This function parses a syntactically valid path for a value. For instance,
+   [x], [M.x], and [(+.)] are valid. Contrarily, [M.A], [F(X).x], and [true]
+   are rejected.
+
+   Longident for OCaml's value cannot contain functor application.
+   The last component of the {!Longident.t} is not capitalized,
+   but can be an operator [A.Path.To.(.%.%.(;..)<-)]
+*)
+
+val constr_ident: Lexing.lexbuf -> Longident.t
+(**
+   This function parses a syntactically valid path for a variant constructor.
+   For instance, [A], [M.A] and [M.(::)] are valid, but both [M.a]
+   and [F(X).A] are rejected.
+
+   Longident for OCaml's variant constructors cannot contain functor
+   application.
+   The last component of the {!Longident.t} is capitalized,
+   or it may be one the special constructors: [true],[false],[()],[[]],[(::)].
+   Among those special constructors, only [(::)] can be prefixed by a module
+   path ([A.B.C.(::)]).
+*)
+
+
+val simple_module_path: Lexing.lexbuf -> Longident.t
+(**
+   This function parses a syntactically valid path for a module.
+   For instance, [A], and [M.A] are valid, but both [M.a]
+   and [F(X).A] are rejected.
+
+   Longident for OCaml's module cannot contain functor application.
+   The last component of the {!Longident.t} is capitalized.
+*)
+
+
+val extended_module_path: Lexing.lexbuf -> Longident.t
+(**
+   This function parse syntactically valid path for an extended module.
+   For instance, [A.B] and [F(A).B] are valid. Contrarily,
+   [(.%())] or [[]] are both rejected.
+
+   The last component of the {!Longident.t} is capitalized.
+
+*)
+
+val type_ident: Lexing.lexbuf -> Longident.t
+(**
+   This function parse syntactically valid path for a type or a module type.
+   For instance, [A], [t], [M.t] and [F(X).t] are valid. Contrarily,
+   [(.%())] or [[]] are both rejected.
+
+   In path for type and module types, only operators and special constructors
+   are rejected.
+
+*)
diff --git a/parsing/parser.mly b/parsing/parser.mly
new file mode 100644
index 00000000..12e18186
--- /dev/null
+++ b/parsing/parser.mly
@@ -0,0 +1,3761 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* The parser definition */
+
+%{
+
+open Asttypes
+open Longident
+open Parsetree
+open Ast_helper
+open Docstrings
+open Docstrings.WithMenhir
+
+let mkloc = Location.mkloc
+let mknoloc = Location.mknoloc
+
+let make_loc (startpos, endpos) = {
+  Location.loc_start = startpos;
+  Location.loc_end = endpos;
+  Location.loc_ghost = false;
+}
+
+let ghost_loc (startpos, endpos) = {
+  Location.loc_start = startpos;
+  Location.loc_end = endpos;
+  Location.loc_ghost = true;
+}
+
+let mktyp ~loc d = Typ.mk ~loc:(make_loc loc) d
+let mkpat ~loc d = Pat.mk ~loc:(make_loc loc) d
+let mkexp ~loc d = Exp.mk ~loc:(make_loc loc) d
+let mkmty ~loc ?attrs d = Mty.mk ~loc:(make_loc loc) ?attrs d
+let mksig ~loc d = Sig.mk ~loc:(make_loc loc) d
+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 pstr_typext (te, ext) =
+  (Pstr_typext te, ext)
+let pstr_primitive (vd, ext) =
+  (Pstr_primitive vd, ext)
+let pstr_type ((nr, ext), tys) =
+  (Pstr_type (nr, tys), ext)
+let pstr_exception (te, ext) =
+  (Pstr_exception te, ext)
+let pstr_include (body, ext) =
+  (Pstr_include body, ext)
+let pstr_recmodule (ext, bindings) =
+  (Pstr_recmodule bindings, ext)
+
+let psig_typext (te, ext) =
+  (Psig_typext te, ext)
+let psig_value (vd, ext) =
+  (Psig_value vd, ext)
+let psig_type ((nr, ext), tys) =
+  (Psig_type (nr, tys), ext)
+let psig_typesubst ((nr, ext), tys) =
+  assert (nr = Recursive); (* see [no_nonrec_flag] *)
+  (Psig_typesubst tys, ext)
+let psig_exception (te, ext) =
+  (Psig_exception te, ext)
+let psig_include (body, ext) =
+  (Psig_include body, ext)
+
+let mkctf ~loc ?attrs ?docs d =
+  Ctf.mk ~loc:(make_loc loc) ?attrs ?docs d
+let mkcf ~loc ?attrs ?docs d =
+  Cf.mk ~loc:(make_loc loc) ?attrs ?docs d
+
+let mkrhs rhs loc = mkloc rhs (make_loc loc)
+let ghrhs rhs loc = mkloc rhs (ghost_loc loc)
+
+let push_loc x acc =
+  if x.Location.loc_ghost
+  then acc
+  else x :: acc
+
+let reloc_pat ~loc x =
+  { x with ppat_loc = make_loc loc;
+           ppat_loc_stack = push_loc x.ppat_loc x.ppat_loc_stack };;
+let reloc_exp ~loc x =
+  { x with pexp_loc = make_loc loc;
+           pexp_loc_stack = push_loc x.pexp_loc x.pexp_loc_stack };;
+let reloc_typ ~loc x =
+  { x with ptyp_loc = make_loc loc;
+           ptyp_loc_stack = push_loc x.ptyp_loc x.ptyp_loc_stack };;
+
+let mkexpvar ~loc (name : string) =
+  mkexp ~loc (Pexp_ident(mkrhs (Lident name) loc))
+
+let mkoperator =
+  mkexpvar
+
+let mkpatvar ~loc name =
+  mkpat ~loc (Ppat_var (mkrhs name loc))
+
+(*
+  Ghost expressions and patterns:
+  expressions and patterns that do not appear explicitly in the
+  source file they have the loc_ghost flag set to true.
+  Then the profiler will not try to instrument them and the
+  -annot option will not try to display their type.
+
+  Every grammar rule that generates an element with a location must
+  make at most one non-ghost element, the topmost one.
+
+  How to tell whether your location must be ghost:
+  A location corresponds to a range of characters in the source file.
+  If the location contains a piece of code that is syntactically
+  valid (according to the documentation), and corresponds to the
+  AST node, then the location must be real; in all other cases,
+  it must be ghost.
+*)
+let ghexp ~loc d = Exp.mk ~loc:(ghost_loc loc) d
+let ghpat ~loc d = Pat.mk ~loc:(ghost_loc loc) d
+let ghtyp ~loc d = Typ.mk ~loc:(ghost_loc loc) d
+let ghloc ~loc d = { txt = d; loc = ghost_loc loc }
+let ghstr ~loc d = Str.mk ~loc:(ghost_loc loc) d
+let ghsig ~loc d = Sig.mk ~loc:(ghost_loc loc) d
+
+let mkinfix arg1 op arg2 =
+  Pexp_apply(op, [Nolabel, arg1; Nolabel, arg2])
+
+let neg_string f =
+  if String.length f > 0 && f.[0] = '-'
+  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))
+  | _ ->
+      Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
+
+let mkuplus ~oploc name arg =
+  let desc = arg.pexp_desc in
+  match name, desc with
+  | "+", Pexp_constant(Pconst_integer _)
+  | ("+" | "+."), Pexp_constant(Pconst_float _) -> desc
+  | _ ->
+      Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
+
+(* TODO define an abstraction boundary between locations-as-pairs
+   and locations-as-Location.t; it should be clear when we move from
+   one world to the other *)
+
+let mkexp_cons_desc consloc args =
+  Pexp_construct(mkrhs (Lident "::") consloc, Some args)
+let mkexp_cons ~loc consloc args =
+  mkexp ~loc (mkexp_cons_desc consloc args)
+
+let mkpat_cons_desc consloc args =
+  Ppat_construct(mkrhs (Lident "::") consloc, Some args)
+let mkpat_cons ~loc consloc args =
+  mkpat ~loc (mkpat_cons_desc consloc args)
+
+let ghexp_cons_desc consloc args =
+  Pexp_construct(ghrhs (Lident "::") consloc, Some args)
+let ghpat_cons_desc consloc args =
+  Ppat_construct(ghrhs (Lident "::") consloc, Some args)
+
+let rec mktailexp nilloc = let open Location in function
+    [] ->
+      let nil = ghloc ~loc:nilloc (Lident "[]") in
+      Pexp_construct (nil, None), nilloc
+  | e1 :: el ->
+      let exp_el, el_loc = mktailexp nilloc el in
+      let loc = (e1.pexp_loc.loc_start, snd el_loc) in
+      let arg = ghexp ~loc (Pexp_tuple [e1; ghexp ~loc:el_loc exp_el]) in
+      ghexp_cons_desc loc arg, loc
+
+let rec mktailpat nilloc = let open Location in function
+    [] ->
+      let nil = ghloc ~loc:nilloc (Lident "[]") in
+      Ppat_construct (nil, None), nilloc
+  | p1 :: pl ->
+      let pat_pl, el_loc = mktailpat nilloc pl in
+      let loc = (p1.ppat_loc.loc_start, snd el_loc) in
+      let arg = ghpat ~loc (Ppat_tuple [p1; ghpat ~loc:el_loc pat_pl]) in
+      ghpat_cons_desc loc arg, loc
+
+let mkstrexp e attrs =
+  { pstr_desc = Pstr_eval (e, attrs); pstr_loc = e.pexp_loc }
+
+let mkexp_constraint ~loc e (t1, t2) =
+  match t1, t2 with
+  | Some t, None -> ghexp ~loc (Pexp_constraint(e, t))
+  | _, Some t -> ghexp ~loc (Pexp_coerce(e, t1, t))
+  | None, None -> assert false
+
+let mkexp_opt_constraint ~loc e = function
+  | None -> e
+  | Some constraint_ -> mkexp_constraint ~loc e constraint_
+
+let mkpat_opt_constraint ~loc p = function
+  | None -> p
+  | Some typ -> mkpat ~loc (Ppat_constraint(p, typ))
+
+let syntax_error () =
+  raise Syntaxerr.Escape_error
+
+let unclosed opening_name opening_loc closing_name closing_loc =
+  raise(Syntaxerr.Error(Syntaxerr.Unclosed(make_loc opening_loc, opening_name,
+                                           make_loc closing_loc, closing_name)))
+
+let expecting loc nonterm =
+    raise Syntaxerr.(Error(Expecting(make_loc loc, nonterm)))
+
+let not_expecting loc nonterm =
+    raise Syntaxerr.(Error(Not_expecting(make_loc loc, nonterm)))
+
+let dotop ~left ~right ~assign ~ext ~multi =
+  let assign = if assign then "<-" else "" in
+  let mid = if multi then ";.." else "" in
+  String.concat "" ["."; ext; left; mid; right; assign]
+let paren = "(",")"
+let brace = "{", "}"
+let bracket = "[", "]"
+let lident x =  Lident x
+let ldot x y = Ldot(x,y)
+let dotop_fun ~loc dotop =
+  (* We could use ghexp here, but sticking to mkexp for parser.mly
+     compatibility. TODO improve parser.mly *)
+  mkexp ~loc (Pexp_ident (ghloc ~loc dotop))
+
+let array_function ~loc str name =
+  ghloc ~loc (Ldot(Lident str,
+                   (if !Clflags.unsafe then "unsafe_" ^ name else name)))
+
+let array_get_fun ~loc =
+  ghexp ~loc (Pexp_ident(array_function ~loc "Array" "get"))
+let string_get_fun ~loc =
+  ghexp ~loc (Pexp_ident(array_function ~loc "String" "get"))
+
+let array_set_fun ~loc =
+  ghexp ~loc (Pexp_ident(array_function ~loc "Array" "set"))
+let string_set_fun ~loc =
+  ghexp ~loc (Pexp_ident(array_function ~loc "String" "set"))
+
+let multi_indices ~loc = function
+  | [a] -> false, a
+  | l -> true, mkexp ~loc (Pexp_array l)
+
+let index_get ~loc get_fun array index =
+  let args = [Nolabel, array; Nolabel, index] in
+   mkexp ~loc (Pexp_apply(get_fun, args))
+
+let index_set ~loc set_fun array index value =
+  let args = [Nolabel, array; Nolabel, index; Nolabel, value] in
+   mkexp ~loc (Pexp_apply(set_fun, args))
+
+let array_get ~loc = index_get ~loc (array_get_fun ~loc)
+let string_get ~loc = index_get ~loc (string_get_fun ~loc)
+let dotop_get ~loc path (left,right) ext array index =
+  let multi, index = multi_indices ~loc index in
+  index_get ~loc
+    (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:false))
+    array index
+
+let array_set ~loc = index_set ~loc (array_set_fun ~loc)
+let string_set ~loc = index_set ~loc (string_set_fun ~loc)
+let dotop_set ~loc path (left,right) ext array index value=
+  let multi, index = multi_indices ~loc index in
+  index_set ~loc
+    (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:true))
+    array index value
+
+
+let bigarray_function ~loc str name =
+  ghloc ~loc (Ldot(Ldot(Lident "Bigarray", str), name))
+
+let bigarray_untuplify = function
+    { pexp_desc = Pexp_tuple explist; pexp_loc = _ } -> explist
+  | exp -> [exp]
+
+let bigarray_get ~loc arr arg =
+  let mkexp, ghexp = mkexp ~loc, ghexp ~loc in
+  let bigarray_function = bigarray_function ~loc in
+  let get = if !Clflags.unsafe then "unsafe_get" else "get" in
+  match bigarray_untuplify arg with
+    [c1] ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" get)),
+                       [Nolabel, arr; Nolabel, c1]))
+  | [c1;c2] ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" get)),
+                       [Nolabel, arr; Nolabel, c1; Nolabel, c2]))
+  | [c1;c2;c3] ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" get)),
+                       [Nolabel, arr; Nolabel, c1; Nolabel, c2; Nolabel, c3]))
+  | coords ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "get")),
+                       [Nolabel, arr; Nolabel, ghexp(Pexp_array coords)]))
+
+let bigarray_set ~loc arr arg newval =
+  let mkexp, ghexp = mkexp ~loc, ghexp ~loc in
+  let bigarray_function = bigarray_function ~loc in
+  let set = if !Clflags.unsafe then "unsafe_set" else "set" in
+  match bigarray_untuplify arg with
+    [c1] ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" set)),
+                       [Nolabel, arr; Nolabel, c1; Nolabel, newval]))
+  | [c1;c2] ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" set)),
+                       [Nolabel, arr; Nolabel, c1;
+                        Nolabel, c2; Nolabel, newval]))
+  | [c1;c2;c3] ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" set)),
+                       [Nolabel, arr; Nolabel, c1;
+                        Nolabel, c2; Nolabel, c3; Nolabel, newval]))
+  | coords ->
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "set")),
+                       [Nolabel, arr;
+                        Nolabel, ghexp(Pexp_array coords);
+                        Nolabel, newval]))
+
+let lapply ~loc p1 p2 =
+  if !Clflags.applicative_functors
+  then Lapply(p1, p2)
+  else raise (Syntaxerr.Error(
+                  Syntaxerr.Applicative_path (make_loc loc)))
+
+let exp_of_longident ~loc lid =
+  mkexp ~loc (Pexp_ident {lid with txt = Lident(Longident.last lid.txt)})
+
+(* [loc_map] could be [Location.map]. *)
+let loc_map (f : 'a -> 'b) (x : 'a Location.loc) : 'b Location.loc =
+  { x with txt = f x.txt }
+
+let loc_last (id : Longident.t Location.loc) : string Location.loc =
+  loc_map Longident.last id
+
+let loc_lident (id : string Location.loc) : Longident.t Location.loc =
+  loc_map (fun x -> Lident x) id
+
+let exp_of_label ~loc lbl =
+  mkexp ~loc (Pexp_ident (loc_lident lbl))
+
+let pat_of_label ~loc lbl =
+  mkpat ~loc (Ppat_var (loc_last lbl))
+
+let mk_newtypes ~loc newtypes exp =
+  let mkexp = mkexp ~loc in
+  List.fold_right (fun newtype exp -> mkexp (Pexp_newtype (newtype, exp)))
+    newtypes exp
+
+let wrap_type_annotation ~loc newtypes core_type body =
+  let mkexp, ghtyp = mkexp ~loc, ghtyp ~loc in
+  let mk_newtypes = mk_newtypes ~loc in
+  let exp = mkexp(Pexp_constraint(body,core_type)) in
+  let exp = mk_newtypes newtypes exp in
+  (exp, ghtyp(Ptyp_poly(newtypes, Typ.varify_constructors newtypes core_type)))
+
+let wrap_exp_attrs ~loc body (ext, attrs) =
+  let ghexp = ghexp ~loc in
+  (* todo: keep exact location for the entire attribute *)
+  let body = {body with pexp_attributes = attrs @ body.pexp_attributes} in
+  match ext with
+  | None -> body
+  | Some id -> ghexp(Pexp_extension (id, PStr [mkstrexp body []]))
+
+let mkexp_attrs ~loc d attrs =
+  wrap_exp_attrs ~loc (mkexp ~loc d) attrs
+
+let wrap_typ_attrs ~loc typ (ext, attrs) =
+  (* todo: keep exact location for the entire attribute *)
+  let typ = {typ with ptyp_attributes = attrs @ typ.ptyp_attributes} in
+  match ext with
+  | None -> typ
+  | Some id -> ghtyp ~loc (Ptyp_extension (id, PTyp typ))
+
+let wrap_pat_attrs ~loc pat (ext, attrs) =
+  (* todo: keep exact location for the entire attribute *)
+  let pat = {pat with ppat_attributes = attrs @ pat.ppat_attributes} in
+  match ext with
+  | None -> pat
+  | Some id -> ghpat ~loc (Ppat_extension (id, PPat (pat, None)))
+
+let mkpat_attrs ~loc d attrs =
+  wrap_pat_attrs ~loc (mkpat ~loc d) attrs
+
+let wrap_class_attrs ~loc:_ body attrs =
+  {body with pcl_attributes = attrs @ body.pcl_attributes}
+let wrap_mod_attrs ~loc:_ attrs body =
+  {body with pmod_attributes = attrs @ body.pmod_attributes}
+let wrap_mty_attrs ~loc:_ attrs body =
+  {body with pmty_attributes = attrs @ body.pmty_attributes}
+
+let wrap_str_ext ~loc body ext =
+  match ext with
+  | None -> body
+  | Some id -> ghstr ~loc (Pstr_extension ((id, PStr [body]), []))
+
+let wrap_mkstr_ext ~loc (item, ext) =
+  wrap_str_ext ~loc (mkstr ~loc item) ext
+
+let wrap_sig_ext ~loc body ext =
+  match ext with
+  | None -> body
+  | Some id -> ghsig ~loc (Psig_extension ((id, PSig [body]), []))
+
+let wrap_mksig_ext ~loc (item, ext) =
+  wrap_sig_ext ~loc (mksig ~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
+  (exp_id, PStr [mkstrexp e []])
+
+let text_str pos = Str.text (rhs_text pos)
+let text_sig pos = Sig.text (rhs_text pos)
+let text_cstr pos = Cf.text (rhs_text pos)
+let text_csig pos = Ctf.text (rhs_text pos)
+let text_def pos = [Ptop_def (Str.text (rhs_text pos))]
+
+let extra_text startpos endpos text items =
+  match items with
+  | [] ->
+      let post = rhs_post_text endpos in
+      let post_extras = rhs_post_extra_text endpos in
+      text post @ text post_extras
+  | _ :: _ ->
+      let pre_extras = rhs_pre_extra_text startpos in
+      let post_extras = rhs_post_extra_text endpos in
+        text pre_extras @ items @ text post_extras
+
+let extra_str p1 p2 items = extra_text p1 p2 Str.text items
+let extra_sig p1 p2 items = extra_text p1 p2 Sig.text items
+let extra_cstr p1 p2 items = extra_text p1 p2 Cf.text items
+let extra_csig p1 p2 items = extra_text p1 p2 Ctf.text  items
+let extra_def p1 p2 items =
+  extra_text p1 p2 (fun txt -> [Ptop_def (Str.text txt)]) items
+
+let extra_rhs_core_type ct ~pos =
+  let docs = rhs_info pos in
+  { ct with ptyp_attributes = add_info_attrs docs ct.ptyp_attributes }
+
+type let_binding =
+  { lb_pattern: pattern;
+    lb_expression: expression;
+    lb_attributes: attributes;
+    lb_docs: docs Lazy.t;
+    lb_text: text Lazy.t;
+    lb_loc: Location.t; }
+
+type let_bindings =
+  { lbs_bindings: let_binding list;
+    lbs_rec: rec_flag;
+    lbs_extension: string Asttypes.loc option;
+    lbs_loc: Location.t }
+
+let mklb first ~loc (p, e) attrs =
+  {
+    lb_pattern = p;
+    lb_expression = e;
+    lb_attributes = attrs;
+    lb_docs = symbol_docs_lazy loc;
+    lb_text = (if first then empty_text_lazy
+               else symbol_text_lazy (fst loc));
+    lb_loc = make_loc loc;
+  }
+
+let mklbs ~loc ext rf lb =
+  {
+    lbs_bindings = [lb];
+    lbs_rec = rf;
+    lbs_extension = ext ;
+    lbs_loc = make_loc loc;
+  }
+
+let addlb lbs lb =
+  { lbs with lbs_bindings = lb :: lbs.lbs_bindings }
+
+let val_of_let_bindings ~loc lbs =
+  let bindings =
+    List.map
+      (fun lb ->
+         Vb.mk ~loc:lb.lb_loc ~attrs:lb.lb_attributes
+           ~docs:(Lazy.force lb.lb_docs)
+           ~text:(Lazy.force lb.lb_text)
+           lb.lb_pattern lb.lb_expression)
+      lbs.lbs_bindings
+  in
+  let str = mkstr ~loc (Pstr_value(lbs.lbs_rec, List.rev bindings)) in
+  match lbs.lbs_extension with
+  | None -> str
+  | Some id -> ghstr ~loc (Pstr_extension((id, PStr [str]), []))
+
+let expr_of_let_bindings ~loc lbs body =
+  let bindings =
+    List.map
+      (fun lb ->
+         Vb.mk ~loc:lb.lb_loc ~attrs:lb.lb_attributes
+           lb.lb_pattern lb.lb_expression)
+      lbs.lbs_bindings
+  in
+    mkexp_attrs ~loc (Pexp_let(lbs.lbs_rec, List.rev bindings, body))
+      (lbs.lbs_extension, [])
+
+let class_of_let_bindings ~loc lbs body =
+  let bindings =
+    List.map
+      (fun lb ->
+         Vb.mk ~loc:lb.lb_loc ~attrs:lb.lb_attributes
+           lb.lb_pattern lb.lb_expression)
+      lbs.lbs_bindings
+  in
+    (* Our use of let_bindings(no_ext) guarantees the following: *)
+    assert (lbs.lbs_extension = None);
+    mkclass ~loc (Pcl_let (lbs.lbs_rec, List.rev bindings, body))
+
+(* 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. *)
+let package_type_of_module_type pmty =
+  let err loc s =
+    raise (Syntaxerr.Error (Syntaxerr.Invalid_package_type (loc, s)))
+  in
+  let map_cstr = function
+    | Pwith_type (lid, ptyp) ->
+        let loc = ptyp.ptype_loc in
+        if ptyp.ptype_params <> [] then
+          err loc "parametrized types are not supported";
+        if ptyp.ptype_cstrs <> [] then
+          err loc "constrained types are not supported";
+        if ptyp.ptype_private <> Public then
+          err loc "private types are not supported";
+
+        (* restrictions below are checked by the 'with_constraint' rule *)
+        assert (ptyp.ptype_kind = Ptype_abstract);
+        assert (ptyp.ptype_attributes = []);
+        let ty =
+          match ptyp.ptype_manifest with
+          | Some ty -> ty
+          | None -> assert false
+        in
+        (lid, ty)
+    | _ ->
+        err pmty.pmty_loc "only 'with type t =' constraints are supported"
+  in
+  match pmty with
+  | {pmty_desc = Pmty_ident lid} -> (lid, [])
+  | {pmty_desc = Pmty_with({pmty_desc = Pmty_ident lid}, cstrs)} ->
+      (lid, List.map map_cstr cstrs)
+  | _ ->
+      err pmty.pmty_loc
+        "only module type identifier and 'with type' constraints are supported"
+
+let mk_directive_arg ~loc k =
+  { pdira_desc = k;
+    pdira_loc = make_loc loc;
+  }
+
+let mk_directive ~loc name arg =
+  Ptop_dir {
+      pdir_name = name;
+      pdir_arg = arg;
+      pdir_loc = make_loc loc;
+    }
+
+%}
+
+/* Tokens */
+
+%token AMPERAMPER
+%token AMPERSAND
+%token AND
+%token AS
+%token ASSERT
+%token BACKQUOTE
+%token BANG
+%token BAR
+%token BARBAR
+%token BARRBRACKET
+%token BEGIN
+%token <char> CHAR
+%token CLASS
+%token COLON
+%token COLONCOLON
+%token COLONEQUAL
+%token COLONGREATER
+%token COMMA
+%token CONSTRAINT
+%token DO
+%token DONE
+%token DOT
+%token DOTDOT
+%token DOWNTO
+%token ELSE
+%token END
+%token EOF
+%token EQUAL
+%token EXCEPTION
+%token EXTERNAL
+%token FALSE
+%token <string * char option> FLOAT
+%token FOR
+%token FUN
+%token FUNCTION
+%token FUNCTOR
+%token GREATER
+%token GREATERRBRACE
+%token GREATERRBRACKET
+%token IF
+%token IN
+%token INCLUDE
+%token <string> INFIXOP0
+%token <string> INFIXOP1
+%token <string> INFIXOP2
+%token <string> INFIXOP3
+%token <string> INFIXOP4
+%token <string> DOTOP
+%token <string> LETOP
+%token <string> ANDOP
+%token INHERIT
+%token INITIALIZER
+%token <string * char option> INT
+%token <string> LABEL
+%token LAZY
+%token LBRACE
+%token LBRACELESS
+%token LBRACKET
+%token LBRACKETBAR
+%token LBRACKETLESS
+%token LBRACKETGREATER
+%token LBRACKETPERCENT
+%token LBRACKETPERCENTPERCENT
+%token LESS
+%token LESSMINUS
+%token LET
+%token <string> LIDENT
+%token LPAREN
+%token LBRACKETAT
+%token LBRACKETATAT
+%token LBRACKETATATAT
+%token MATCH
+%token METHOD
+%token MINUS
+%token MINUSDOT
+%token MINUSGREATER
+%token MODULE
+%token MUTABLE
+%token NEW
+%token NONREC
+%token OBJECT
+%token OF
+%token OPEN
+%token <string> OPTLABEL
+%token OR
+/* %token PARSER */
+%token PERCENT
+%token PLUS
+%token PLUSDOT
+%token PLUSEQ
+%token <string> PREFIXOP
+%token PRIVATE
+%token QUESTION
+%token QUOTE
+%token RBRACE
+%token RBRACKET
+%token REC
+%token RPAREN
+%token SEMI
+%token SEMISEMI
+%token HASH
+%token <string> HASHOP
+%token SIG
+%token STAR
+%token <string * Location.t * string option> STRING
+%token
+  <string * Location.t * string * Location.t * string option> QUOTED_STRING_EXPR
+%token
+  <string * Location.t * string * Location.t * string option> QUOTED_STRING_ITEM
+%token STRUCT
+%token THEN
+%token TILDE
+%token TO
+%token TRUE
+%token TRY
+%token TYPE
+%token <string> UIDENT
+%token UNDERSCORE
+%token VAL
+%token VIRTUAL
+%token WHEN
+%token WHILE
+%token WITH
+%token <string * Location.t> COMMENT
+%token <Docstrings.docstring> DOCSTRING
+
+%token EOL
+
+/* Precedences and associativities.
+
+Tokens and rules have precedences.  A reduce/reduce conflict is resolved
+in favor of the first rule (in source file order).  A shift/reduce conflict
+is resolved by comparing the precedence and associativity of the token to
+be shifted with those of the rule to be reduced.
+
+By default, a rule has the precedence of its rightmost terminal (if any).
+
+When there is a shift/reduce conflict between a rule and a token that
+have the same precedence, it is resolved using the associativity:
+if the token is left-associative, the parser will reduce; if
+right-associative, the parser will shift; if non-associative,
+the parser will declare a syntax error.
+
+We will only use associativities with operators of the kind  x * x -> x
+for example, in the rules of the form    expr: expr BINOP expr
+in all other cases, we define two precedences if needed to resolve
+conflicts.
+
+The precedences must be listed from low to high.
+*/
+
+%nonassoc IN
+%nonassoc below_SEMI
+%nonassoc SEMI                          /* below EQUAL ({lbl=...; lbl=...}) */
+%nonassoc LET                           /* above SEMI ( ...; let ... in ...) */
+%nonassoc below_WITH
+%nonassoc FUNCTION WITH                 /* below BAR  (match ... with ...) */
+%nonassoc AND             /* above WITH (module rec A: SIG with ... and ...) */
+%nonassoc THEN                          /* below ELSE (if ... then ...) */
+%nonassoc ELSE                          /* (if ... then ... else ...) */
+%nonassoc LESSMINUS                     /* below COLONEQUAL (lbl <- x := e) */
+%right    COLONEQUAL                    /* expr (e := e := e) */
+%nonassoc AS
+%left     BAR                           /* pattern (p|p|p) */
+%nonassoc below_COMMA
+%left     COMMA                         /* expr/expr_comma_list (e,e,e) */
+%right    MINUSGREATER                  /* function_type (t -> t -> t) */
+%right    OR BARBAR                     /* expr (e || e || e) */
+%right    AMPERSAND AMPERAMPER          /* expr (e && e && e) */
+%nonassoc below_EQUAL
+%left     INFIXOP0 EQUAL LESS GREATER   /* expr (e OP e OP e) */
+%right    INFIXOP1                      /* expr (e OP e OP e) */
+%nonassoc below_LBRACKETAT
+%nonassoc LBRACKETAT
+%right    COLONCOLON                    /* expr (e :: e :: e) */
+%left     INFIXOP2 PLUS PLUSDOT MINUS MINUSDOT PLUSEQ /* expr (e OP e OP e) */
+%left     PERCENT INFIXOP3 STAR                 /* expr (e OP e OP e) */
+%right    INFIXOP4                      /* expr (e OP e OP e) */
+%nonassoc prec_unary_minus prec_unary_plus /* unary - */
+%nonassoc prec_constant_constructor     /* cf. simple_expr (C versus C x) */
+%nonassoc prec_constr_appl              /* above AS BAR COLONCOLON COMMA */
+%nonassoc below_HASH
+%nonassoc HASH                         /* simple_expr/toplevel_directive */
+%left     HASHOP
+%nonassoc below_DOT
+%nonassoc DOT DOTOP
+/* Finally, the first tokens of simple_expr are above everything else. */
+%nonassoc BACKQUOTE BANG BEGIN CHAR FALSE FLOAT INT
+          LBRACE LBRACELESS LBRACKET LBRACKETBAR LIDENT LPAREN
+          NEW PREFIXOP STRING TRUE UIDENT
+          LBRACKETPERCENT QUOTED_STRING_EXPR
+
+
+/* Entry points */
+
+%start implementation                   /* for implementation files */
+%type <Parsetree.structure> implementation
+%start interface                        /* for interface files */
+%type <Parsetree.signature> interface
+%start toplevel_phrase                  /* for interactive use */
+%type <Parsetree.toplevel_phrase> toplevel_phrase
+%start use_file                         /* for the #use directive */
+%type <Parsetree.toplevel_phrase list> use_file
+%start parse_core_type
+%type <Parsetree.core_type> parse_core_type
+%start parse_expression
+%type <Parsetree.expression> parse_expression
+%start parse_pattern
+%type <Parsetree.pattern> parse_pattern
+%start parse_constr_longident
+%type <Longident.t> parse_constr_longident
+%start parse_val_longident
+%type <Longident.t> parse_val_longident
+%start parse_mty_longident
+%type <Longident.t> parse_mty_longident
+%start parse_mod_ext_longident
+%type <Longident.t> parse_mod_ext_longident
+%start parse_mod_longident
+%type <Longident.t> parse_mod_longident
+%start parse_any_longident
+%type <Longident.t> parse_any_longident
+%%
+
+/* macros */
+%inline extra_str(symb): symb { extra_str $startpos $endpos $1 };
+%inline extra_sig(symb): symb { extra_sig $startpos $endpos $1 };
+%inline extra_cstr(symb): symb { extra_cstr $startpos $endpos $1 };
+%inline extra_csig(symb): symb { extra_csig $startpos $endpos $1 };
+%inline extra_def(symb): symb { extra_def $startpos $endpos $1 };
+%inline extra_text(symb): symb { extra_text $startpos $endpos $1 };
+%inline extra_rhs(symb): symb { extra_rhs_core_type $1 ~pos:$endpos($1) };
+%inline mkrhs(symb): symb
+    { mkrhs $1 $sloc }
+;
+
+%inline text_str(symb): symb
+  { text_str $startpos @ [$1] }
+%inline text_str_SEMISEMI: SEMISEMI
+  { text_str $startpos }
+%inline text_sig(symb): symb
+  { text_sig $startpos @ [$1] }
+%inline text_sig_SEMISEMI: SEMISEMI
+  { text_sig $startpos }
+%inline text_def(symb): symb
+  { text_def $startpos @ [$1] }
+%inline top_def(symb): symb
+  { Ptop_def [$1] }
+%inline text_cstr(symb): symb
+  { text_cstr $startpos @ [$1] }
+%inline text_csig(symb): symb
+  { text_csig $startpos @ [$1] }
+
+(* Using this %inline definition means that we do not control precisely
+   when [mark_rhs_docs] is called, but I don't think this matters. *)
+%inline mark_rhs_docs(symb): symb
+  { mark_rhs_docs $startpos $endpos;
+    $1 }
+
+%inline op(symb): symb
+   { mkoperator ~loc:$sloc $1 }
+
+%inline mkloc(symb): symb
+    { mkloc $1 (make_loc $sloc) }
+
+%inline mkexp(symb): symb
+    { mkexp ~loc:$sloc $1 }
+%inline mkpat(symb): symb
+    { mkpat ~loc:$sloc $1 }
+%inline mktyp(symb): symb
+    { mktyp ~loc:$sloc $1 }
+%inline mkstr(symb): symb
+    { mkstr ~loc:$sloc $1 }
+%inline mksig(symb): symb
+    { mksig ~loc:$sloc $1 }
+%inline mkmod(symb): symb
+    { mkmod ~loc:$sloc $1 }
+%inline mkmty(symb): symb
+    { mkmty ~loc:$sloc $1 }
+%inline mkcty(symb): symb
+    { mkcty ~loc:$sloc $1 }
+%inline mkctf(symb): symb
+    { mkctf ~loc:$sloc $1 }
+%inline mkcf(symb): symb
+    { mkcf ~loc:$sloc $1 }
+%inline mkclass(symb): symb
+    { mkclass ~loc:$sloc $1 }
+
+%inline wrap_mkstr_ext(symb): symb
+    { wrap_mkstr_ext ~loc:$sloc $1 }
+%inline wrap_mksig_ext(symb): symb
+    { wrap_mksig_ext ~loc:$sloc $1 }
+
+%inline mk_directive_arg(symb): symb
+    { mk_directive_arg ~loc:$sloc $1 }
+
+/* Generic definitions */
+
+(* [iloption(X)] recognizes either nothing or [X]. Assuming [X] produces
+   an OCaml list, it produces an OCaml list, too. *)
+
+%inline iloption(X):
+  /* nothing */
+    { [] }
+| x = X
+    { x }
+
+(* [llist(X)] recognizes a possibly empty list of [X]s. It is left-recursive. *)
+
+reversed_llist(X):
+  /* empty */
+    { [] }
+| xs = reversed_llist(X) x = X
+    { x :: xs }
+
+%inline llist(X):
+  xs = rev(reversed_llist(X))
+    { xs }
+
+(* [reversed_nonempty_llist(X)] recognizes a nonempty list of [X]s, and produces
+   an OCaml list in reverse order -- that is, the last element in the input text
+   appears first in this list. Its definition is left-recursive. *)
+
+reversed_nonempty_llist(X):
+  x = X
+    { [ x ] }
+| xs = reversed_nonempty_llist(X) x = X
+    { x :: xs }
+
+(* [nonempty_llist(X)] recognizes a nonempty list of [X]s, and produces an OCaml
+   list in direct order -- that is, the first element in the input text appears
+   first in this list. *)
+
+%inline nonempty_llist(X):
+  xs = rev(reversed_nonempty_llist(X))
+    { xs }
+
+(* [reversed_separated_nonempty_llist(separator, X)] recognizes a nonempty list
+   of [X]s, separated with [separator]s, and produces an OCaml list in reverse
+   order -- that is, the last element in the input text appears first in this
+   list. Its definition is left-recursive. *)
+
+(* [inline_reversed_separated_nonempty_llist(separator, X)] is semantically
+   equivalent to [reversed_separated_nonempty_llist(separator, X)], but is
+   marked %inline, which means that the case of a list of length one and
+   the case of a list of length more than one will be distinguished at the
+   use site, and will give rise there to two productions. This can be used
+   to avoid certain conflicts. *)
+
+%inline inline_reversed_separated_nonempty_llist(separator, X):
+  x = X
+    { [ x ] }
+| xs = reversed_separated_nonempty_llist(separator, X)
+  separator
+  x = X
+    { x :: xs }
+
+reversed_separated_nonempty_llist(separator, X):
+  xs = inline_reversed_separated_nonempty_llist(separator, X)
+    { xs }
+
+(* [separated_nonempty_llist(separator, X)] recognizes a nonempty list of [X]s,
+   separated with [separator]s, and produces an OCaml list in direct order --
+   that is, the first element in the input text appears first in this list. *)
+
+%inline separated_nonempty_llist(separator, X):
+  xs = rev(reversed_separated_nonempty_llist(separator, X))
+    { xs }
+
+%inline inline_separated_nonempty_llist(separator, X):
+  xs = rev(inline_reversed_separated_nonempty_llist(separator, X))
+    { xs }
+
+(* [reversed_separated_nontrivial_llist(separator, X)] recognizes a list of at
+   least two [X]s, separated with [separator]s, and produces an OCaml list in
+   reverse order -- that is, the last element in the input text appears first
+   in this list. Its definition is left-recursive. *)
+
+reversed_separated_nontrivial_llist(separator, X):
+  xs = reversed_separated_nontrivial_llist(separator, X)
+  separator
+  x = X
+    { x :: xs }
+| x1 = X
+  separator
+  x2 = X
+    { [ x2; x1 ] }
+
+(* [separated_nontrivial_llist(separator, X)] recognizes a list of at least
+   two [X]s, separated with [separator]s, and produces an OCaml list in direct
+   order -- that is, the first element in the input text appears first in this
+   list. *)
+
+%inline separated_nontrivial_llist(separator, X):
+  xs = rev(reversed_separated_nontrivial_llist(separator, X))
+    { xs }
+
+(* [separated_or_terminated_nonempty_list(delimiter, X)] recognizes a nonempty
+   list of [X]s, separated with [delimiter]s, and optionally terminated with a
+   final [delimiter]. Its definition is right-recursive. *)
+
+separated_or_terminated_nonempty_list(delimiter, X):
+  x = X ioption(delimiter)
+    { [x] }
+| x = X
+  delimiter
+  xs = separated_or_terminated_nonempty_list(delimiter, X)
+    { x :: xs }
+
+(* [reversed_preceded_or_separated_nonempty_llist(delimiter, X)] recognizes a
+   nonempty list of [X]s, separated with [delimiter]s, and optionally preceded
+   with a leading [delimiter]. It produces an OCaml list in reverse order. Its
+   definition is left-recursive. *)
+
+reversed_preceded_or_separated_nonempty_llist(delimiter, X):
+  ioption(delimiter) x = X
+    { [x] }
+| xs = reversed_preceded_or_separated_nonempty_llist(delimiter, X)
+  delimiter
+  x = X
+    { x :: xs }
+
+(* [preceded_or_separated_nonempty_llist(delimiter, X)] recognizes a nonempty
+   list of [X]s, separated with [delimiter]s, and optionally preceded with a
+   leading [delimiter]. It produces an OCaml list in direct order. *)
+
+%inline preceded_or_separated_nonempty_llist(delimiter, X):
+  xs = rev(reversed_preceded_or_separated_nonempty_llist(delimiter, X))
+    { xs }
+
+(* [bar_llist(X)] recognizes a nonempty list of [X]'s, separated with BARs,
+   with an optional leading BAR. We assume that [X] is itself parameterized
+   with an opening symbol, which can be [epsilon] or [BAR]. *)
+
+(* This construction may seem needlessly complicated: one might think that
+   using [preceded_or_separated_nonempty_llist(BAR, X)], where [X] is *not*
+   itself parameterized, would be sufficient. Indeed, this simpler approach
+   would recognize the same language. However, the two approaches differ in
+   the footprint of [X]. We want the start location of [X] to include [BAR]
+   when present. In the future, we might consider switching to the simpler
+   definition, at the cost of producing slightly different locations. TODO *)
+
+reversed_bar_llist(X):
+    (* An [X] without a leading BAR. *)
+    x = X(epsilon)
+      { [x] }
+  | (* An [X] with a leading BAR. *)
+    x = X(BAR)
+      { [x] }
+  | (* An initial list, followed with a BAR and an [X]. *)
+    xs = reversed_bar_llist(X)
+    x = X(BAR)
+      { x :: xs }
+
+%inline bar_llist(X):
+  xs = reversed_bar_llist(X)
+    { List.rev xs }
+
+(* [xlist(A, B)] recognizes [AB*]. We assume that the semantic value for [A]
+   is a pair [x, b], while the semantic value for [B*] is a list [bs].
+   We return the pair [x, b :: bs]. *)
+
+%inline xlist(A, B):
+  a = A bs = B*
+    { let (x, b) = a in x, b :: bs }
+
+(* [listx(delimiter, X, Y)] recognizes a nonempty list of [X]s, optionally
+   followed with a [Y], separated-or-terminated with [delimiter]s. The
+   semantic value is a pair of a list of [X]s and an optional [Y]. *)
+
+listx(delimiter, X, Y):
+| x = X ioption(delimiter)
+    { [x], None }
+| x = X delimiter y = Y delimiter?
+    { [x], Some y }
+| x = X
+  delimiter
+  tail = listx(delimiter, X, Y)
+    { let xs, y = tail in
+      x :: xs, y }
+
+(* -------------------------------------------------------------------------- *)
+
+(* Entry points. *)
+
+(* An .ml file. *)
+implementation:
+  structure EOF
+    { $1 }
+;
+
+(* An .mli file. *)
+interface:
+  signature EOF
+    { $1 }
+;
+
+(* A toplevel phrase. *)
+toplevel_phrase:
+  (* An expression with attributes, ended by a double semicolon. *)
+  extra_str(text_str(str_exp))
+  SEMISEMI
+    { Ptop_def $1 }
+| (* A list of structure items, ended by a double semicolon. *)
+  extra_str(flatten(text_str(structure_item)*))
+  SEMISEMI
+    { Ptop_def $1 }
+| (* A directive, ended by a double semicolon. *)
+  toplevel_directive
+  SEMISEMI
+    { $1 }
+| (* End of input. *)
+  EOF
+    { raise End_of_file }
+;
+
+(* An .ml file that is read by #use. *)
+use_file:
+  (* An optional standalone expression,
+     followed with a series of elements,
+     followed with EOF. *)
+  extra_def(append(
+    optional_use_file_standalone_expression,
+    flatten(use_file_element*)
+  ))
+  EOF
+    { $1 }
+;
+
+(* An optional standalone expression is just an expression with attributes
+   (str_exp), with extra wrapping. *)
+%inline optional_use_file_standalone_expression:
+  iloption(text_def(top_def(str_exp)))
+    { $1 }
+;
+
+(* An element in a #used file is one of the following:
+   - a double semicolon followed with an optional standalone expression;
+   - a structure item;
+   - a toplevel directive.
+ *)
+%inline use_file_element:
+  preceded(SEMISEMI, optional_use_file_standalone_expression)
+| text_def(top_def(structure_item))
+| text_def(mark_rhs_docs(toplevel_directive))
+      { $1 }
+;
+
+parse_core_type:
+  core_type EOF
+    { $1 }
+;
+
+parse_expression:
+  seq_expr EOF
+    { $1 }
+;
+
+parse_pattern:
+  pattern EOF
+    { $1 }
+;
+
+parse_mty_longident:
+  mty_longident EOF
+    { $1 }
+;
+
+parse_val_longident:
+  val_longident EOF
+    { $1 }
+;
+
+parse_constr_longident:
+  constr_longident EOF
+    { $1 }
+;
+
+parse_mod_ext_longident:
+  mod_ext_longident EOF
+    { $1 }
+;
+
+parse_mod_longident:
+  mod_longident EOF
+    { $1 }
+;
+
+parse_any_longident:
+  any_longident EOF
+    { $1 }
+;
+(* -------------------------------------------------------------------------- *)
+
+(* Functor arguments appear in module expressions and module types. *)
+
+%inline functor_args:
+  reversed_nonempty_llist(functor_arg)
+    { $1 }
+    (* Produce a reversed list on purpose;
+       later processed using [fold_left]. *)
+;
+
+functor_arg:
+    (* An anonymous and untyped argument. *)
+    LPAREN RPAREN
+      { Unit }
+  | (* An argument accompanied with an explicit type. *)
+    LPAREN x = mkrhs(module_name) COLON mty = module_type RPAREN
+      { Named (x, mty) }
+;
+
+module_name:
+    (* A named argument. *)
+    x = UIDENT
+      { Some x }
+  | (* An anonymous argument. *)
+    UNDERSCORE
+      { None }
+;
+
+(* -------------------------------------------------------------------------- *)
+
+(* Module expressions. *)
+
+(* The syntax of module expressions is not properly stratified. The cases of
+   functors, functor applications, and attributes interact and cause conflicts,
+   which are resolved by precedence declarations. This is concise but fragile.
+   Perhaps in the future an explicit stratification could be used. *)
+
+module_expr:
+  | STRUCT attrs = attributes s = structure END
+      { mkmod ~loc:$sloc ~attrs (Pmod_structure s) }
+  | STRUCT attributes structure error
+      { unclosed "struct" $loc($1) "end" $loc($4) }
+  | FUNCTOR attrs = attributes args = functor_args MINUSGREATER me = module_expr
+      { wrap_mod_attrs ~loc:$sloc attrs (
+          List.fold_left (fun acc arg ->
+            mkmod ~loc:$sloc (Pmod_functor (arg, acc))
+          ) me args
+        ) }
+  | me = paren_module_expr
+      { me }
+  | me = module_expr attr = attribute
+      { Mod.attr me attr }
+  | mkmod(
+      (* A module identifier. *)
+      x = mkrhs(mod_longident)
+        { Pmod_ident x }
+    | (* In a functor application, the actual argument must be parenthesized. *)
+      me1 = module_expr me2 = paren_module_expr
+        { Pmod_apply(me1, me2) }
+    | (* Application to unit is sugar for application to an empty structure. *)
+      me1 = module_expr LPAREN RPAREN
+        { (* TODO review mkmod location *)
+          Pmod_apply(me1, mkmod ~loc:$sloc (Pmod_structure [])) }
+    | (* An extension. *)
+      ex = extension
+        { Pmod_extension ex }
+    )
+    { $1 }
+;
+
+(* A parenthesized module expression is a module expression that begins
+   and ends with parentheses. *)
+
+paren_module_expr:
+    (* A module expression annotated with a module type. *)
+    LPAREN me = module_expr COLON mty = module_type RPAREN
+      { mkmod ~loc:$sloc (Pmod_constraint(me, mty)) }
+  | LPAREN module_expr COLON module_type error
+      { unclosed "(" $loc($1) ")" $loc($5) }
+  | (* A module expression within parentheses. *)
+    LPAREN me = module_expr RPAREN
+      { me (* TODO consider reloc *) }
+  | LPAREN module_expr error
+      { unclosed "(" $loc($1) ")" $loc($3) }
+  | (* A core language expression that produces a first-class module.
+       This expression can be annotated in various ways. *)
+    LPAREN VAL attrs = attributes e = expr_colon_package_type RPAREN
+      { mkmod ~loc:$sloc ~attrs (Pmod_unpack e) }
+  | LPAREN VAL attributes expr COLON error
+      { unclosed "(" $loc($1) ")" $loc($6) }
+  | LPAREN VAL attributes expr COLONGREATER error
+      { unclosed "(" $loc($1) ")" $loc($6) }
+  | LPAREN VAL attributes expr error
+      { unclosed "(" $loc($1) ")" $loc($5) }
+;
+
+(* The various ways of annotating a core language expression that
+   produces a first-class module that we wish to unpack. *)
+%inline expr_colon_package_type:
+    e = expr
+      { e }
+  | e = expr COLON ty = package_type
+      { ghexp ~loc:$loc (Pexp_constraint (e, ty)) }
+  | e = expr COLON ty1 = package_type COLONGREATER ty2 = package_type
+      { ghexp ~loc:$loc (Pexp_coerce (e, Some ty1, ty2)) }
+  | e = expr COLONGREATER ty2 = package_type
+      { ghexp ~loc:$loc (Pexp_coerce (e, None, ty2)) }
+;
+
+(* A structure, which appears between STRUCT and END (among other places),
+   begins with an optional standalone expression, and continues with a list
+   of structure elements. *)
+structure:
+  extra_str(append(
+    optional_structure_standalone_expression,
+    flatten(structure_element*)
+  ))
+  { $1 }
+;
+
+(* An optional standalone expression is just an expression with attributes
+   (str_exp), with extra wrapping. *)
+%inline optional_structure_standalone_expression:
+  items = iloption(mark_rhs_docs(text_str(str_exp)))
+    { items }
+;
+
+(* An expression with attributes, wrapped as a structure item. *)
+%inline str_exp:
+  e = seq_expr
+  attrs = post_item_attributes
+    { mkstrexp e attrs }
+;
+
+(* A structure element is one of the following:
+   - a double semicolon followed with an optional standalone expression;
+   - a structure item. *)
+%inline structure_element:
+    append(text_str_SEMISEMI, optional_structure_standalone_expression)
+  | text_str(structure_item)
+      { $1 }
+;
+
+(* A structure item. *)
+structure_item:
+    let_bindings(ext)
+      { val_of_let_bindings ~loc:$sloc $1 }
+  | mkstr(
+      item_extension post_item_attributes
+        { let docs = symbol_docs $sloc in
+          Pstr_extension ($1, add_docs_attrs docs $2) }
+    | floating_attribute
+        { Pstr_attribute $1 }
+    )
+  | wrap_mkstr_ext(
+      primitive_declaration
+        { pstr_primitive $1 }
+    | value_description
+        { pstr_primitive $1 }
+    | type_declarations
+        { pstr_type $1 }
+    | str_type_extension
+        { pstr_typext $1 }
+    | str_exception_declaration
+        { pstr_exception $1 }
+    | module_binding
+        { $1 }
+    | rec_module_bindings
+        { pstr_recmodule $1 }
+    | module_type_declaration
+        { let (body, ext) = $1 in (Pstr_modtype body, ext) }
+    | open_declaration
+        { let (body, ext) = $1 in (Pstr_open body, ext) }
+    | class_declarations
+        { let (ext, l) = $1 in (Pstr_class l, ext) }
+    | class_type_declarations
+        { let (ext, l) = $1 in (Pstr_class_type l, ext) }
+    | include_statement(module_expr)
+        { pstr_include $1 }
+    )
+    { $1 }
+;
+
+(* A single module binding. *)
+%inline module_binding:
+  MODULE
+  ext = ext attrs1 = attributes
+  name = mkrhs(module_name)
+  body = module_binding_body
+  attrs2 = post_item_attributes
+    { 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 }
+;
+
+(* The body (right-hand side) of a module binding. *)
+module_binding_body:
+    EQUAL me = module_expr
+      { me }
+  | mkmod(
+      COLON mty = module_type EQUAL me = module_expr
+        { Pmod_constraint(me, mty) }
+    | arg = functor_arg body = module_binding_body
+        { Pmod_functor(arg, body) }
+  ) { $1 }
+;
+
+(* A group of recursive module bindings. *)
+%inline rec_module_bindings:
+  xlist(rec_module_binding, and_module_binding)
+    { $1 }
+;
+
+(* The first binding in a group of recursive module bindings. *)
+%inline rec_module_binding:
+  MODULE
+  ext = ext
+  attrs1 = attributes
+  REC
+  name = mkrhs(module_name)
+  body = module_binding_body
+  attrs2 = post_item_attributes
+  {
+    let loc = make_loc $sloc in
+    let attrs = attrs1 @ attrs2 in
+    let docs = symbol_docs $sloc in
+    ext,
+    Mb.mk name body ~attrs ~loc ~docs
+  }
+;
+
+(* The following bindings in a group of recursive module bindings. *)
+%inline and_module_binding:
+  AND
+  attrs1 = attributes
+  name = mkrhs(module_name)
+  body = module_binding_body
+  attrs2 = post_item_attributes
+  {
+    let loc = make_loc $sloc in
+    let attrs = attrs1 @ attrs2 in
+    let docs = symbol_docs $sloc in
+    let text = symbol_text $symbolstartpos in
+    Mb.mk name body ~attrs ~loc ~text ~docs
+  }
+;
+
+(* -------------------------------------------------------------------------- *)
+
+(* Shared material between structures and signatures. *)
+
+(* An [include] statement can appear in a structure or in a signature,
+   which is why this definition is parameterized. *)
+%inline include_statement(thing):
+  INCLUDE
+  ext = ext
+  attrs1 = attributes
+  thing = thing
+  attrs2 = post_item_attributes
+  {
+    let attrs = attrs1 @ attrs2 in
+    let loc = make_loc $sloc in
+    let docs = symbol_docs $sloc in
+    Incl.mk thing ~attrs ~loc ~docs, ext
+  }
+;
+
+(* A module type declaration. *)
+module_type_declaration:
+  MODULE TYPE
+  ext = ext
+  attrs1 = attributes
+  id = mkrhs(ident)
+  typ = preceded(EQUAL, module_type)?
+  attrs2 = post_item_attributes
+  {
+    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
+  }
+;
+
+(* -------------------------------------------------------------------------- *)
+
+(* Opens. *)
+
+open_declaration:
+  OPEN
+  override = override_flag
+  ext = ext
+  attrs1 = attributes
+  me = module_expr
+  attrs2 = post_item_attributes
+  {
+    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
+  }
+;
+
+open_description:
+  OPEN
+  override = override_flag
+  ext = ext
+  attrs1 = attributes
+  id = mkrhs(mod_ext_longident)
+  attrs2 = post_item_attributes
+  {
+    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
+  }
+;
+
+%inline open_dot_declaration: mkrhs(mod_longident)
+  { let loc = make_loc $loc($1) in
+    let me = Mod.ident ~loc $1 in
+    Opn.mk ~loc me }
+;
+
+(* -------------------------------------------------------------------------- *)
+
+/* Module types */
+
+module_type:
+  | SIG attrs = attributes s = signature END
+      { mkmty ~loc:$sloc ~attrs (Pmty_signature s) }
+  | SIG attributes signature error
+      { unclosed "sig" $loc($1) "end" $loc($4) }
+  | FUNCTOR attrs = attributes args = functor_args
+    MINUSGREATER mty = module_type
+      %prec below_WITH
+      { wrap_mty_attrs ~loc:$sloc attrs (
+          List.fold_left (fun acc arg ->
+            mkmty ~loc:$sloc (Pmty_functor (arg, acc))
+          ) mty args
+        ) }
+  | MODULE TYPE OF attributes module_expr %prec below_LBRACKETAT
+      { mkmty ~loc:$sloc ~attrs:$4 (Pmty_typeof $5) }
+  | LPAREN module_type RPAREN
+      { $2 }
+  | LPAREN module_type error
+      { unclosed "(" $loc($1) ")" $loc($3) }
+  | module_type attribute
+      { Mty.attr $1 $2 }
+  | mkmty(
+      mkrhs(mty_longident)
+        { Pmty_ident $1 }
+    | module_type MINUSGREATER module_type
+        %prec below_WITH
+        { Pmty_functor(Named (mknoloc None, $1), $3) }
+    | module_type WITH separated_nonempty_llist(AND, with_constraint)
+        { Pmty_with($1, $3) }
+/*  | LPAREN MODULE mkrhs(mod_longident) RPAREN
+        { Pmty_alias $3 } */
+    | extension
+        { Pmty_extension $1 }
+    )
+    { $1 }
+;
+(* A signature, which appears between SIG and END (among other places),
+   is a list of signature elements. *)
+signature:
+  extra_sig(flatten(signature_element*))
+    { $1 }
+;
+
+(* A signature element is one of the following:
+   - a double semicolon;
+   - a signature item. *)
+%inline signature_element:
+    text_sig_SEMISEMI
+  | text_sig(signature_item)
+      { $1 }
+;
+
+(* A signature item. *)
+signature_item:
+  | item_extension post_item_attributes
+      { let docs = symbol_docs $sloc in
+        mksig ~loc:$sloc (Psig_extension ($1, (add_docs_attrs docs $2))) }
+  | mksig(
+      floating_attribute
+        { Psig_attribute $1 }
+    )
+    { $1 }
+  | wrap_mksig_ext(
+      value_description
+        { psig_value $1 }
+    | primitive_declaration
+        { psig_value $1 }
+    | type_declarations
+        { psig_type $1 }
+    | type_subst_declarations
+        { psig_typesubst $1 }
+    | sig_type_extension
+        { psig_typext $1 }
+    | sig_exception_declaration
+        { psig_exception $1 }
+    | module_declaration
+        { let (body, ext) = $1 in (Psig_module body, ext) }
+    | module_alias
+        { let (body, ext) = $1 in (Psig_module body, ext) }
+    | module_subst
+        { let (body, ext) = $1 in (Psig_modsubst body, ext) }
+    | rec_module_declarations
+        { let (ext, l) = $1 in (Psig_recmodule l, ext) }
+    | module_type_declaration
+        { let (body, ext) = $1 in (Psig_modtype body, ext) }
+    | open_description
+        { let (body, ext) = $1 in (Psig_open body, ext) }
+    | include_statement(module_type)
+        { psig_include $1 }
+    | class_descriptions
+        { let (ext, l) = $1 in (Psig_class l, ext) }
+    | class_type_declarations
+        { let (ext, l) = $1 in (Psig_class_type l, ext) }
+    )
+    { $1 }
+
+(* A module declaration. *)
+%inline module_declaration:
+  MODULE
+  ext = ext attrs1 = attributes
+  name = mkrhs(module_name)
+  body = module_declaration_body
+  attrs2 = post_item_attributes
+  {
+    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
+  }
+;
+
+(* The body (right-hand side) of a module declaration. *)
+module_declaration_body:
+    COLON mty = module_type
+      { mty }
+  | mkmty(
+      arg = functor_arg body = module_declaration_body
+        { Pmty_functor(arg, body) }
+    )
+    { $1 }
+;
+
+(* A module alias declaration (in a signature). *)
+%inline module_alias:
+  MODULE
+  ext = ext attrs1 = attributes
+  name = mkrhs(module_name)
+  EQUAL
+  body = module_expr_alias
+  attrs2 = post_item_attributes
+  {
+    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
+  }
+;
+%inline module_expr_alias:
+  id = mkrhs(mod_longident)
+    { Mty.alias ~loc:(make_loc $sloc) id }
+;
+(* A module substitution (in a signature). *)
+module_subst:
+  MODULE
+  ext = ext attrs1 = attributes
+  uid = mkrhs(UIDENT)
+  COLONEQUAL
+  body = mkrhs(mod_ext_longident)
+  attrs2 = post_item_attributes
+  {
+    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
+  }
+| MODULE ext attributes mkrhs(UIDENT) COLONEQUAL error
+    { expecting $loc($6) "module path" }
+;
+
+(* A group of recursive module declarations. *)
+%inline rec_module_declarations:
+  xlist(rec_module_declaration, and_module_declaration)
+    { $1 }
+;
+%inline rec_module_declaration:
+  MODULE
+  ext = ext
+  attrs1 = attributes
+  REC
+  name = mkrhs(module_name)
+  COLON
+  mty = module_type
+  attrs2 = post_item_attributes
+  {
+    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
+  }
+;
+%inline and_module_declaration:
+  AND
+  attrs1 = attributes
+  name = mkrhs(module_name)
+  COLON
+  mty = module_type
+  attrs2 = post_item_attributes
+  {
+    let attrs = attrs1 @ attrs2 in
+    let docs = symbol_docs $sloc in
+    let loc = make_loc $sloc in
+    let text = symbol_text $symbolstartpos in
+    Md.mk name mty ~attrs ~loc ~text ~docs
+  }
+;
+
+(* -------------------------------------------------------------------------- *)
+
+(* Class declarations. *)
+
+%inline class_declarations:
+  xlist(class_declaration, and_class_declaration)
+    { $1 }
+;
+%inline class_declaration:
+  CLASS
+  ext = ext
+  attrs1 = attributes
+  virt = virtual_flag
+  params = formal_class_parameters
+  id = mkrhs(LIDENT)
+  body = class_fun_binding
+  attrs2 = post_item_attributes
+  {
+    let attrs = attrs1 @ attrs2 in
+    let loc = make_loc $sloc in
+    let docs = symbol_docs $sloc in
+    ext,
+    Ci.mk id body ~virt ~params ~attrs ~loc ~docs
+  }
+;
+%inline and_class_declaration:
+  AND
+  attrs1 = attributes
+  virt = virtual_flag
+  params = formal_class_parameters
+  id = mkrhs(LIDENT)
+  body = class_fun_binding
+  attrs2 = post_item_attributes
+  {
+    let attrs = attrs1 @ attrs2 in
+    let loc = make_loc $sloc in
+    let docs = symbol_docs $sloc in
+    let text = symbol_text $symbolstartpos in
+    Ci.mk id body ~virt ~params ~attrs ~loc ~text ~docs
+  }
+;
+
+class_fun_binding:
+    EQUAL class_expr
+      { $2 }
+  | mkclass(
+      COLON class_type EQUAL class_expr
+        { Pcl_constraint($4, $2) }
+    | labeled_simple_pattern class_fun_binding
+      { let (l,o,p) = $1 in Pcl_fun(l, o, p, $2) }
+    ) { $1 }
+;
+
+formal_class_parameters:
+  params = class_parameters(type_parameter)
+    { params }
+;
+
+(* -------------------------------------------------------------------------- *)
+
+(* Class expressions. *)
+
+class_expr:
+    class_simple_expr
+      { $1 }
+  | FUN attributes class_fun_def
+      { wrap_class_attrs ~loc:$sloc $3 $2 }
+  | let_bindings(no_ext) IN class_expr
+      { class_of_let_bindings ~loc:$sloc $1 $3 }
+  | LET OPEN override_flag attributes mkrhs(mod_longident) IN class_expr
+      { let loc = ($startpos($2), $endpos($4)) in
+        let od = Opn.mk ~override:$3 ~loc:(make_loc loc) $5 in
+        mkclass ~loc:$sloc ~attrs:$4 (Pcl_open(od, $7)) }
+  | class_expr attribute
+      { Cl.attr $1 $2 }
+  | mkclass(
+      class_simple_expr nonempty_llist(labeled_simple_expr)
+        { Pcl_apply($1, $2) }
+    | extension
+        { Pcl_extension $1 }
+    ) { $1 }
+;
+class_simple_expr:
+  | LPAREN class_expr RPAREN
+      { $2 }
+  | LPAREN class_expr error
+      { unclosed "(" $loc($1) ")" $loc($3) }
+  | mkclass(
+      tys = actual_class_parameters cid = mkrhs(class_longident)
+        { Pcl_constr(cid, tys) }
+    | OBJECT attributes class_structure error
+        { unclosed "object" $loc($1) "end" $loc($4) }
+    | LPAREN class_expr COLON class_type RPAREN
+        { Pcl_constraint($2, $4) }
+    | LPAREN class_expr COLON class_type error
+        { unclosed "(" $loc($1) ")" $loc($5) }
+    ) { $1 }
+  | OBJECT attributes class_structure END
+    { mkclass ~loc:$sloc ~attrs:$2 (Pcl_structure $3) }
+;
+
+class_fun_def:
+  mkclass(
+    labeled_simple_pattern MINUSGREATER e = class_expr
+  | labeled_simple_pattern e = class_fun_def
+      { let (l,o,p) = $1 in Pcl_fun(l, o, p, e) }
+  ) { $1 }
+;
+%inline class_structure:
+  |  class_self_pattern extra_cstr(class_fields)
+       { Cstr.mk $1 $2 }
+;
+class_self_pattern:
+    LPAREN pattern RPAREN
+      { reloc_pat ~loc:$sloc $2 }
+  | mkpat(LPAREN pattern COLON core_type RPAREN
+      { Ppat_constraint($2, $4) })
+      { $1 }
+  | /* empty */
+      { ghpat ~loc:$sloc Ppat_any }
+;
+%inline class_fields:
+  flatten(text_cstr(class_field)*)
+    { $1 }
+;
+class_field:
+  | INHERIT override_flag attributes class_expr
+    self = preceded(AS, mkrhs(LIDENT))?
+    post_item_attributes
+      { let docs = symbol_docs $sloc in
+        mkcf ~loc:$sloc (Pcf_inherit ($2, $4, self)) ~attrs:($3@$6) ~docs }
+  | VAL value post_item_attributes
+      { let v, attrs = $2 in
+        let docs = symbol_docs $sloc in
+        mkcf ~loc:$sloc (Pcf_val v) ~attrs:(attrs@$3) ~docs }
+  | METHOD method_ post_item_attributes
+      { let meth, attrs = $2 in
+        let docs = symbol_docs $sloc in
+        mkcf ~loc:$sloc (Pcf_method meth) ~attrs:(attrs@$3) ~docs }
+  | CONSTRAINT attributes constrain_field post_item_attributes
+      { let docs = symbol_docs $sloc in
+        mkcf ~loc:$sloc (Pcf_constraint $3) ~attrs:($2@$4) ~docs }
+  | INITIALIZER attributes seq_expr post_item_attributes
+      { let docs = symbol_docs $sloc in
+        mkcf ~loc:$sloc (Pcf_initializer $3) ~attrs:($2@$4) ~docs }
+  | item_extension post_item_attributes
+      { let docs = symbol_docs $sloc in
+        mkcf ~loc:$sloc (Pcf_extension $1) ~attrs:$2 ~docs }
+  | mkcf(floating_attribute
+      { Pcf_attribute $1 })
+      { $1 }
+;
+value:
+    no_override_flag
+    attrs = attributes
+    mutable_ = virtual_with_mutable_flag
+    label = mkrhs(label) COLON ty = core_type
+      { (label, mutable_, Cfk_virtual ty), attrs }
+  | override_flag attributes mutable_flag mkrhs(label) EQUAL seq_expr
+      { ($4, $3, Cfk_concrete ($1, $6)), $2 }
+  | override_flag attributes mutable_flag mkrhs(label) type_constraint
+    EQUAL seq_expr
+      { let e = mkexp_constraint ~loc:$sloc $7 $5 in
+        ($4, $3, Cfk_concrete ($1, e)), $2
+      }
+;
+method_:
+    no_override_flag
+    attrs = attributes
+    private_ = virtual_with_private_flag
+    label = mkrhs(label) COLON ty = poly_type
+      { (label, private_, Cfk_virtual ty), attrs }
+  | override_flag attributes private_flag mkrhs(label) strict_binding
+      { 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 }
+  | override_flag attributes private_flag mkrhs(label)
+    COLON poly_type EQUAL seq_expr
+      { 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 }
+  | override_flag attributes private_flag mkrhs(label) COLON TYPE lident_list
+    DOT core_type EQUAL seq_expr
+      { let poly_exp_loc = ($startpos($7), $endpos($11)) in
+        let poly_exp =
+          let exp, poly =
+            (* it seems odd to use the global ~loc here while poly_exp_loc
+               is tighter, but this is what ocamlyacc does;
+               TODO improve parser.mly *)
+            wrap_type_annotation ~loc:$sloc $7 $9 $11 in
+          ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in
+        ($4, $3,
+        Cfk_concrete ($1, poly_exp)), $2 }
+;
+
+/* Class types */
+
+class_type:
+    class_signature
+      { $1 }
+  | mkcty(
+      label = arg_label
+      domain = tuple_type
+      MINUSGREATER
+      codomain = class_type
+        { Pcty_arrow(label, domain, codomain) }
+    ) { $1 }
+ ;
+class_signature:
+    mkcty(
+      tys = actual_class_parameters cid = mkrhs(clty_longident)
+        { Pcty_constr (cid, tys) }
+    | extension
+        { Pcty_extension $1 }
+    ) { $1 }
+  | OBJECT attributes class_sig_body END
+      { mkcty ~loc:$sloc ~attrs:$2 (Pcty_signature $3) }
+  | OBJECT attributes class_sig_body error
+      { unclosed "object" $loc($1) "end" $loc($4) }
+  | class_signature attribute
+      { Cty.attr $1 $2 }
+  | LET OPEN override_flag attributes mkrhs(mod_longident) IN class_signature
+      { let loc = ($startpos($2), $endpos($4)) in
+        let od = Opn.mk ~override:$3 ~loc:(make_loc loc) $5 in
+        mkcty ~loc:$sloc ~attrs:$4 (Pcty_open(od, $7)) }
+;
+%inline class_parameters(parameter):
+  | /* empty */
+      { [] }
+  | LBRACKET params = separated_nonempty_llist(COMMA, parameter) RBRACKET
+      { params }
+;
+%inline actual_class_parameters:
+  tys = class_parameters(core_type)
+    { tys }
+;
+%inline class_sig_body:
+    class_self_type extra_csig(class_sig_fields)
+      { Csig.mk $1 $2 }
+;
+class_self_type:
+    LPAREN core_type RPAREN
+      { $2 }
+  | mktyp((* empty *) { Ptyp_any })
+      { $1 }
+;
+%inline class_sig_fields:
+  flatten(text_csig(class_sig_field)*)
+    { $1 }
+;
+class_sig_field:
+    INHERIT attributes class_signature post_item_attributes
+      { let docs = symbol_docs $sloc in
+        mkctf ~loc:$sloc (Pctf_inherit $3) ~attrs:($2@$4) ~docs }
+  | VAL attributes value_type post_item_attributes
+      { let docs = symbol_docs $sloc in
+        mkctf ~loc:$sloc (Pctf_val $3) ~attrs:($2@$4) ~docs }
+  | METHOD attributes private_virtual_flags mkrhs(label) COLON poly_type
+    post_item_attributes
+      { let (p, v) = $3 in
+        let docs = symbol_docs $sloc in
+        mkctf ~loc:$sloc (Pctf_method ($4, p, v, $6)) ~attrs:($2@$7) ~docs }
+  | CONSTRAINT attributes constrain_field post_item_attributes
+      { let docs = symbol_docs $sloc in
+        mkctf ~loc:$sloc (Pctf_constraint $3) ~attrs:($2@$4) ~docs }
+  | item_extension post_item_attributes
+      { let docs = symbol_docs $sloc in
+        mkctf ~loc:$sloc (Pctf_extension $1) ~attrs:$2 ~docs }
+  | mkctf(floating_attribute
+      { Pctf_attribute $1 })
+      { $1 }
+;
+%inline value_type:
+  flags = mutable_virtual_flags
+  label = mkrhs(label)
+  COLON
+  ty = core_type
+  {
+    let mut, virt = flags in
+    label, mut, virt, ty
+  }
+;
+%inline constrain:
+    core_type EQUAL core_type
+    { $1, $3, make_loc $sloc }
+;
+constrain_field:
+  core_type EQUAL core_type
+    { $1, $3 }
+;
+(* A group of class descriptions. *)
+%inline class_descriptions:
+  xlist(class_description, and_class_description)
+    { $1 }
+;
+%inline class_description:
+  CLASS
+  ext = ext
+  attrs1 = attributes
+  virt = virtual_flag
+  params = formal_class_parameters
+  id = mkrhs(LIDENT)
+  COLON
+  cty = class_type
+  attrs2 = post_item_attributes
+    {
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc $sloc in
+      let docs = symbol_docs $sloc in
+      ext,
+      Ci.mk id cty ~virt ~params ~attrs ~loc ~docs
+    }
+;
+%inline and_class_description:
+  AND
+  attrs1 = attributes
+  virt = virtual_flag
+  params = formal_class_parameters
+  id = mkrhs(LIDENT)
+  COLON
+  cty = class_type
+  attrs2 = post_item_attributes
+    {
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc $sloc in
+      let docs = symbol_docs $sloc in
+      let text = symbol_text $symbolstartpos in
+      Ci.mk id cty ~virt ~params ~attrs ~loc ~text ~docs
+    }
+;
+class_type_declarations:
+  xlist(class_type_declaration, and_class_type_declaration)
+    { $1 }
+;
+%inline class_type_declaration:
+  CLASS TYPE
+  ext = ext
+  attrs1 = attributes
+  virt = virtual_flag
+  params = formal_class_parameters
+  id = mkrhs(LIDENT)
+  EQUAL
+  csig = class_signature
+  attrs2 = post_item_attributes
+    {
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc $sloc in
+      let docs = symbol_docs $sloc in
+      ext,
+      Ci.mk id csig ~virt ~params ~attrs ~loc ~docs
+    }
+;
+%inline and_class_type_declaration:
+  AND
+  attrs1 = attributes
+  virt = virtual_flag
+  params = formal_class_parameters
+  id = mkrhs(LIDENT)
+  EQUAL
+  csig = class_signature
+  attrs2 = post_item_attributes
+    {
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc $sloc in
+      let docs = symbol_docs $sloc in
+      let text = symbol_text $symbolstartpos in
+      Ci.mk id csig ~virt ~params ~attrs ~loc ~text ~docs
+    }
+;
+
+/* Core expressions */
+
+seq_expr:
+  | expr        %prec below_SEMI  { $1 }
+  | expr SEMI                     { $1 }
+  | mkexp(expr SEMI seq_expr
+    { Pexp_sequence($1, $3) })
+    { $1 }
+  | expr SEMI PERCENT attr_id seq_expr
+    { let seq = mkexp ~loc:$sloc (Pexp_sequence ($1, $5)) in
+      let payload = PStr [mkstrexp seq []] in
+      mkexp ~loc:$sloc (Pexp_extension ($4, payload)) }
+;
+labeled_simple_pattern:
+    QUESTION LPAREN label_let_pattern opt_default RPAREN
+      { (Optional (fst $3), $4, snd $3) }
+  | QUESTION label_var
+      { (Optional (fst $2), None, snd $2) }
+  | OPTLABEL LPAREN let_pattern opt_default RPAREN
+      { (Optional $1, $4, $3) }
+  | OPTLABEL pattern_var
+      { (Optional $1, None, $2) }
+  | TILDE LPAREN label_let_pattern RPAREN
+      { (Labelled (fst $3), None, snd $3) }
+  | TILDE label_var
+      { (Labelled (fst $2), None, snd $2) }
+  | LABEL simple_pattern
+      { (Labelled $1, None, $2) }
+  | simple_pattern
+      { (Nolabel, None, $1) }
+;
+
+pattern_var:
+  mkpat(
+      mkrhs(LIDENT)     { Ppat_var $1 }
+    | UNDERSCORE        { Ppat_any }
+  ) { $1 }
+;
+
+%inline opt_default:
+  preceded(EQUAL, seq_expr)?
+    { $1 }
+;
+label_let_pattern:
+    x = label_var
+      { x }
+  | x = label_var COLON cty = core_type
+      { let lab, pat = x in
+        lab,
+        mkpat ~loc:$sloc (Ppat_constraint (pat, cty)) }
+;
+%inline label_var:
+    mkrhs(LIDENT)
+      { ($1.Location.txt, mkpat ~loc:$sloc (Ppat_var $1)) }
+;
+let_pattern:
+    pattern
+      { $1 }
+  | mkpat(pattern COLON core_type
+      { Ppat_constraint($1, $3) })
+      { $1 }
+;
+
+expr:
+    simple_expr %prec below_HASH
+      { $1 }
+  | expr_attrs
+      { let desc, attrs = $1 in
+        mkexp_attrs ~loc:$sloc desc attrs }
+  | mkexp(expr_)
+      { $1 }
+  | let_bindings(ext) IN seq_expr
+      { expr_of_let_bindings ~loc:$sloc $1 $3 }
+  | pbop_op = mkrhs(LETOP) bindings = letop_bindings IN body = seq_expr
+      { 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}) }
+  | expr COLONCOLON expr
+      { mkexp_cons ~loc:$sloc $loc($2) (ghexp ~loc:$sloc (Pexp_tuple[$1;$3])) }
+  | mkrhs(label) LESSMINUS expr
+      { mkexp ~loc:$sloc (Pexp_setinstvar($1, $3)) }
+  | simple_expr DOT mkrhs(label_longident) LESSMINUS expr
+      { mkexp ~loc:$sloc (Pexp_setfield($1, $3, $5)) }
+  | simple_expr DOT LPAREN seq_expr RPAREN LESSMINUS expr
+      { array_set ~loc:$sloc $1 $4 $7 }
+  | simple_expr DOT LBRACKET seq_expr RBRACKET LESSMINUS expr
+      { string_set ~loc:$sloc $1 $4 $7 }
+  | simple_expr DOT LBRACE expr RBRACE LESSMINUS expr
+      { bigarray_set ~loc:$sloc $1 $4 $7 }
+  | simple_expr DOTOP LBRACKET expr_semi_list RBRACKET LESSMINUS expr
+      { dotop_set ~loc:$sloc lident bracket $2 $1 $4 $7 }
+  | simple_expr DOTOP LPAREN expr_semi_list RPAREN LESSMINUS expr
+      { dotop_set ~loc:$sloc lident paren $2 $1 $4 $7 }
+  | simple_expr DOTOP LBRACE expr_semi_list RBRACE LESSMINUS expr
+      { dotop_set ~loc:$sloc lident brace $2 $1 $4 $7 }
+  | simple_expr DOT mod_longident DOTOP LBRACKET expr_semi_list RBRACKET
+      LESSMINUS expr
+      { dotop_set ~loc:$sloc (ldot $3) bracket $4 $1 $6 $9 }
+  | simple_expr DOT mod_longident DOTOP LPAREN expr_semi_list RPAREN
+      LESSMINUS expr
+      { dotop_set ~loc:$sloc (ldot $3) paren $4 $1 $6 $9  }
+  | simple_expr DOT mod_longident DOTOP LBRACE expr_semi_list RBRACE
+      LESSMINUS expr
+      { dotop_set ~loc:$sloc (ldot $3) brace $4 $1 $6 $9 }
+  | expr attribute
+      { Exp.attr $1 $2 }
+  | UNDERSCORE
+     { not_expecting $loc($1) "wildcard \"_\"" }
+;
+%inline expr_attrs:
+  | LET MODULE ext_attributes mkrhs(module_name) module_binding_body IN seq_expr
+      { Pexp_letmodule($4, $5, $7), $3 }
+  | LET EXCEPTION ext_attributes let_exception_declaration IN seq_expr
+      { Pexp_letexception($4, $6), $3 }
+  | LET OPEN override_flag ext_attributes module_expr IN seq_expr
+      { 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 }
+  | FUNCTION ext_attributes match_cases
+      { Pexp_function $3, $2 }
+  | FUN ext_attributes labeled_simple_pattern fun_def
+      { let (l,o,p) = $3 in
+        Pexp_fun(l, o, p, $4), $2 }
+  | FUN ext_attributes LPAREN TYPE lident_list RPAREN fun_def
+      { (mk_newtypes ~loc:$sloc $5 $7).pexp_desc, $2 }
+  | MATCH ext_attributes seq_expr WITH match_cases
+      { Pexp_match($3, $5), $2 }
+  | TRY ext_attributes seq_expr WITH match_cases
+      { Pexp_try($3, $5), $2 }
+  | TRY ext_attributes seq_expr WITH error
+      { syntax_error() }
+  | IF ext_attributes seq_expr THEN expr ELSE expr
+      { Pexp_ifthenelse($3, $5, Some $7), $2 }
+  | IF ext_attributes seq_expr THEN expr
+      { Pexp_ifthenelse($3, $5, None), $2 }
+  | WHILE ext_attributes seq_expr DO seq_expr DONE
+      { Pexp_while($3, $5), $2 }
+  | FOR ext_attributes pattern EQUAL seq_expr direction_flag seq_expr DO
+    seq_expr DONE
+      { Pexp_for($3, $5, $7, $6, $9), $2 }
+  | ASSERT ext_attributes simple_expr %prec below_HASH
+      { Pexp_assert $3, $2 }
+  | LAZY ext_attributes simple_expr %prec below_HASH
+      { Pexp_lazy $3, $2 }
+  | OBJECT ext_attributes class_structure END
+      { Pexp_object $3, $2 }
+  | OBJECT ext_attributes class_structure error
+      { unclosed "object" $loc($1) "end" $loc($4) }
+;
+%inline expr_:
+  | simple_expr nonempty_llist(labeled_simple_expr)
+      { Pexp_apply($1, $2) }
+  | expr_comma_list %prec below_COMMA
+      { Pexp_tuple($1) }
+  | mkrhs(constr_longident) simple_expr %prec below_HASH
+      { Pexp_construct($1, Some $2) }
+  | name_tag simple_expr %prec below_HASH
+      { Pexp_variant($1, Some $2) }
+  | e1 = expr op = op(infix_operator) e2 = expr
+      { mkinfix e1 op e2 }
+  | subtractive expr %prec prec_unary_minus
+      { mkuminus ~oploc:$loc($1) $1 $2 }
+  | additive expr %prec prec_unary_plus
+      { mkuplus ~oploc:$loc($1) $1 $2 }
+;
+
+simple_expr:
+  | LPAREN seq_expr RPAREN
+      { reloc_exp ~loc:$sloc $2 }
+  | LPAREN seq_expr error
+      { unclosed "(" $loc($1) ")" $loc($3) }
+  | LPAREN seq_expr type_constraint RPAREN
+      { mkexp_constraint ~loc:$sloc $2 $3 }
+  | simple_expr DOT LPAREN seq_expr RPAREN
+      { array_get ~loc:$sloc $1 $4 }
+  | simple_expr DOT LPAREN seq_expr error
+      { unclosed "(" $loc($3) ")" $loc($5) }
+  | simple_expr DOT LBRACKET seq_expr RBRACKET
+      { string_get ~loc:$sloc $1 $4 }
+  | simple_expr DOT LBRACKET seq_expr error
+      { unclosed "[" $loc($3) "]" $loc($5) }
+  | simple_expr DOTOP LBRACKET expr_semi_list RBRACKET
+      { dotop_get ~loc:$sloc lident bracket $2 $1 $4 }
+  | simple_expr DOTOP LBRACKET expr_semi_list error
+      { unclosed "[" $loc($3) "]" $loc($5) }
+  | simple_expr DOTOP LPAREN expr_semi_list RPAREN
+      { dotop_get ~loc:$sloc lident paren $2 $1 $4  }
+  | simple_expr DOTOP LPAREN expr_semi_list error
+      { unclosed "(" $loc($3) ")" $loc($5) }
+  | simple_expr DOTOP LBRACE expr_semi_list RBRACE
+      { dotop_get ~loc:$sloc lident brace $2 $1 $4 }
+  | simple_expr DOTOP LBRACE expr error
+      { unclosed "{" $loc($3) "}" $loc($5) }
+  | simple_expr DOT mod_longident DOTOP LBRACKET expr_semi_list RBRACKET
+      { dotop_get ~loc:$sloc (ldot $3) bracket $4 $1 $6  }
+  | simple_expr DOT
+    mod_longident DOTOP LBRACKET expr_semi_list error
+      { unclosed "[" $loc($5) "]" $loc($7) }
+  | simple_expr DOT mod_longident DOTOP LPAREN expr_semi_list RPAREN
+      { dotop_get ~loc:$sloc (ldot $3) paren $4 $1 $6 }
+  | simple_expr DOT
+    mod_longident DOTOP LPAREN expr_semi_list error
+      { unclosed "(" $loc($5) ")" $loc($7) }
+  | simple_expr DOT mod_longident DOTOP LBRACE expr_semi_list RBRACE
+      { dotop_get ~loc:$sloc (ldot $3) brace $4 $1 $6  }
+  | simple_expr DOT
+    mod_longident DOTOP LBRACE expr_semi_list error
+      { unclosed "{" $loc($5) "}" $loc($7) }
+  | simple_expr DOT LBRACE expr RBRACE
+      { bigarray_get ~loc:$sloc $1 $4 }
+  | simple_expr DOT LBRACE expr error
+      { unclosed "{" $loc($3) "}" $loc($5) }
+  | simple_expr_attrs
+    { let desc, attrs = $1 in
+      mkexp_attrs ~loc:$sloc desc attrs }
+  | mkexp(simple_expr_)
+      { $1 }
+;
+%inline simple_expr_attrs:
+  | BEGIN ext = ext attrs = attributes e = seq_expr END
+      { e.pexp_desc, (ext, attrs @ e.pexp_attributes) }
+  | BEGIN ext_attributes END
+      { Pexp_construct (mkloc (Lident "()") (make_loc $sloc), None), $2 }
+  | BEGIN ext_attributes seq_expr error
+      { unclosed "begin" $loc($1) "end" $loc($4) }
+  | NEW ext_attributes mkrhs(class_longident)
+      { Pexp_new($3), $2 }
+  | LPAREN MODULE ext_attributes module_expr RPAREN
+      { Pexp_pack $4, $3 }
+  | LPAREN MODULE ext_attributes module_expr COLON package_type RPAREN
+      { Pexp_constraint (ghexp ~loc:$sloc (Pexp_pack $4), $6), $3 }
+  | LPAREN MODULE ext_attributes module_expr COLON error
+      { unclosed "(" $loc($1) ")" $loc($6) }
+;
+%inline simple_expr_:
+  | mkrhs(val_longident)
+      { Pexp_ident ($1) }
+  | constant
+      { Pexp_constant $1 }
+  | mkrhs(constr_longident) %prec prec_constant_constructor
+      { Pexp_construct($1, None) }
+  | name_tag %prec prec_constant_constructor
+      { Pexp_variant($1, None) }
+  | op(PREFIXOP) simple_expr
+      { Pexp_apply($1, [Nolabel,$2]) }
+  | op(BANG {"!"}) simple_expr
+      { Pexp_apply($1, [Nolabel,$2]) }
+  | LBRACELESS object_expr_content GREATERRBRACE
+      { Pexp_override $2 }
+  | LBRACELESS object_expr_content error
+      { unclosed "{<" $loc($1) ">}" $loc($3) }
+  | LBRACELESS GREATERRBRACE
+      { Pexp_override [] }
+  | simple_expr DOT mkrhs(label_longident)
+      { Pexp_field($1, $3) }
+  | od=open_dot_declaration DOT LPAREN seq_expr RPAREN
+      { Pexp_open(od, $4) }
+  | od=open_dot_declaration DOT LBRACELESS object_expr_content GREATERRBRACE
+      { (* TODO: review the location of Pexp_override *)
+        Pexp_open(od, mkexp ~loc:$sloc (Pexp_override $4)) }
+  | mod_longident DOT LBRACELESS object_expr_content error
+      { unclosed "{<" $loc($3) ">}" $loc($5) }
+  | simple_expr HASH mkrhs(label)
+      { Pexp_send($1, $3) }
+  | simple_expr op(HASHOP) simple_expr
+      { mkinfix $1 $2 $3 }
+  | extension
+      { Pexp_extension $1 }
+  | od=open_dot_declaration DOT mkrhs(LPAREN RPAREN {Lident "()"})
+      { (* TODO: review the location of Pexp_construct *)
+        Pexp_open(od, mkexp ~loc:$sloc (Pexp_construct($3, None))) }
+  | mod_longident DOT LPAREN seq_expr error
+      { unclosed "(" $loc($3) ")" $loc($5) }
+  | LBRACE record_expr_content RBRACE
+      { let (exten, fields) = $2 in
+        Pexp_record(fields, exten) }
+  | LBRACE record_expr_content error
+      { unclosed "{" $loc($1) "}" $loc($3) }
+  | od=open_dot_declaration DOT LBRACE record_expr_content RBRACE
+      { let (exten, fields) = $4 in
+        (* TODO: review the location of Pexp_construct *)
+        Pexp_open(od, mkexp ~loc:$sloc (Pexp_record(fields, exten))) }
+  | mod_longident DOT LBRACE record_expr_content error
+      { unclosed "{" $loc($3) "}" $loc($5) }
+  | LBRACKETBAR expr_semi_list BARRBRACKET
+      { Pexp_array($2) }
+  | LBRACKETBAR expr_semi_list error
+      { unclosed "[|" $loc($1) "|]" $loc($3) }
+  | LBRACKETBAR BARRBRACKET
+      { Pexp_array [] }
+  | od=open_dot_declaration DOT LBRACKETBAR expr_semi_list BARRBRACKET
+      { (* TODO: review the location of Pexp_array *)
+        Pexp_open(od, mkexp ~loc:$sloc (Pexp_array($4))) }
+  | od=open_dot_declaration DOT LBRACKETBAR BARRBRACKET
+      { (* TODO: review the location of Pexp_array *)
+        Pexp_open(od, mkexp ~loc:$sloc (Pexp_array [])) }
+  | mod_longident DOT
+    LBRACKETBAR expr_semi_list error
+      { unclosed "[|" $loc($3) "|]" $loc($5) }
+  | LBRACKET expr_semi_list RBRACKET
+      { fst (mktailexp $loc($3) $2) }
+  | LBRACKET expr_semi_list error
+      { unclosed "[" $loc($1) "]" $loc($3) }
+  | od=open_dot_declaration DOT LBRACKET expr_semi_list RBRACKET
+      { let list_exp =
+          (* TODO: review the location of list_exp *)
+          let tail_exp, _tail_loc = mktailexp $loc($5) $4 in
+          mkexp ~loc:$sloc tail_exp in
+        Pexp_open(od, list_exp) }
+  | od=open_dot_declaration DOT mkrhs(LBRACKET RBRACKET {Lident "[]"})
+      { (* TODO: review the location of Pexp_construct *)
+        Pexp_open(od, mkexp ~loc:$sloc (Pexp_construct($3, None))) }
+  | mod_longident DOT
+    LBRACKET expr_semi_list error
+      { unclosed "[" $loc($3) "]" $loc($5) }
+  | od=open_dot_declaration DOT LPAREN MODULE ext_attributes module_expr COLON
+    package_type RPAREN
+      { (* TODO: review the location of Pexp_constraint *)
+        let modexp =
+          mkexp_attrs ~loc:$sloc
+            (Pexp_constraint (ghexp ~loc:$sloc (Pexp_pack $6), $8)) $5 in
+        Pexp_open(od, modexp) }
+  | mod_longident DOT
+    LPAREN MODULE ext_attributes module_expr COLON error
+      { unclosed "(" $loc($3) ")" $loc($8) }
+;
+labeled_simple_expr:
+    simple_expr %prec below_HASH
+      { (Nolabel, $1) }
+  | LABEL simple_expr %prec below_HASH
+      { (Labelled $1, $2) }
+  | TILDE label = LIDENT
+      { let loc = $loc(label) in
+        (Labelled label, mkexpvar ~loc label) }
+  | QUESTION label = LIDENT
+      { let loc = $loc(label) in
+        (Optional label, mkexpvar ~loc label) }
+  | OPTLABEL simple_expr %prec below_HASH
+      { (Optional $1, $2) }
+;
+%inline lident_list:
+  xs = mkrhs(LIDENT)+
+    { xs }
+;
+%inline let_ident:
+    val_ident { mkpatvar ~loc:$sloc $1 }
+;
+let_binding_body:
+    let_ident strict_binding
+      { ($1, $2) }
+  | let_ident type_constraint EQUAL seq_expr
+      { let v = $1 in (* PR#7344 *)
+        let t =
+          match $2 with
+            Some t, None -> t
+          | _, Some t -> t
+          | _ -> assert false
+        in
+        let loc = Location.(t.ptyp_loc.loc_start, t.ptyp_loc.loc_end) in
+        let typ = ghtyp ~loc (Ptyp_poly([],t)) in
+        let patloc = ($startpos($1), $endpos($2)) in
+        (ghpat ~loc:patloc (Ppat_constraint(v, typ)),
+         mkexp_constraint ~loc:$sloc $4 $2) }
+  | let_ident COLON typevar_list DOT core_type EQUAL seq_expr
+      (* TODO: could replace [typevar_list DOT core_type]
+               with [mktyp(poly(core_type))]
+               and simplify the semantic action? *)
+      { let typloc = ($startpos($3), $endpos($5)) in
+        let patloc = ($startpos($1), $endpos($5)) in
+        (ghpat ~loc:patloc
+           (Ppat_constraint($1, ghtyp ~loc:typloc (Ptyp_poly($3,$5)))),
+         $7) }
+  | let_ident COLON TYPE lident_list DOT core_type EQUAL seq_expr
+      { let exp, poly =
+          wrap_type_annotation ~loc:$sloc $4 $6 $8 in
+        let loc = ($startpos($1), $endpos($6)) in
+        (ghpat ~loc (Ppat_constraint($1, poly)), exp) }
+  | pattern_no_exn EQUAL seq_expr
+      { ($1, $3) }
+  | simple_pattern_not_ident COLON core_type EQUAL seq_expr
+      { let loc = ($startpos($1), $endpos($3)) in
+        (ghpat ~loc (Ppat_constraint($1, $3)), $5) }
+;
+(* The formal parameter EXT can be instantiated with ext or no_ext
+   so as to indicate whether an extension is allowed or disallowed. *)
+let_bindings(EXT):
+    let_binding(EXT)                            { $1 }
+  | let_bindings(EXT) and_let_binding           { addlb $1 $2 }
+;
+%inline let_binding(EXT):
+  LET
+  ext = EXT
+  attrs1 = attributes
+  rec_flag = rec_flag
+  body = let_binding_body
+  attrs2 = post_item_attributes
+    {
+      let attrs = attrs1 @ attrs2 in
+      mklbs ~loc:$sloc ext rec_flag (mklb ~loc:$sloc true body attrs)
+    }
+;
+and_let_binding:
+  AND
+  attrs1 = attributes
+  body = let_binding_body
+  attrs2 = post_item_attributes
+    {
+      let attrs = attrs1 @ attrs2 in
+      mklb ~loc:$sloc false body attrs
+    }
+;
+letop_binding_body:
+    pat = let_ident exp = strict_binding
+      { (pat, exp) }
+  | pat = simple_pattern COLON typ = core_type EQUAL exp = seq_expr
+      { let loc = ($startpos(pat), $endpos(typ)) in
+        (ghpat ~loc (Ppat_constraint(pat, typ)), exp) }
+  | pat = pattern_no_exn EQUAL exp = seq_expr
+      { (pat, exp) }
+;
+letop_bindings:
+    body = letop_binding_body
+      { let let_pat, let_exp = body in
+        let_pat, let_exp, [] }
+  | bindings = letop_bindings pbop_op = mkrhs(ANDOP) body = let_binding_body
+      { 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 }
+;
+fun_binding:
+    strict_binding
+      { $1 }
+  | type_constraint EQUAL seq_expr
+      { mkexp_constraint ~loc:$sloc $3 $1 }
+;
+strict_binding:
+    EQUAL seq_expr
+      { $2 }
+  | labeled_simple_pattern fun_binding
+      { let (l, o, p) = $1 in ghexp ~loc:$sloc (Pexp_fun(l, o, p, $2)) }
+  | LPAREN TYPE lident_list RPAREN fun_binding
+      { mk_newtypes ~loc:$sloc $3 $5 }
+;
+%inline match_cases:
+  xs = preceded_or_separated_nonempty_llist(BAR, match_case)
+    { xs }
+;
+match_case:
+    pattern MINUSGREATER seq_expr
+      { Exp.case $1 $3 }
+  | pattern WHEN seq_expr MINUSGREATER seq_expr
+      { Exp.case $1 ~guard:$3 $5 }
+  | pattern MINUSGREATER DOT
+      { Exp.case $1 (Exp.unreachable ~loc:(make_loc $loc($3)) ()) }
+;
+fun_def:
+    MINUSGREATER seq_expr
+      { $2 }
+  | mkexp(COLON atomic_type MINUSGREATER seq_expr
+      { Pexp_constraint ($4, $2) })
+      { $1 }
+/* Cf #5939: we used to accept (fun p when e0 -> e) */
+  | labeled_simple_pattern fun_def
+      {
+       let (l,o,p) = $1 in
+       ghexp ~loc:$sloc (Pexp_fun(l, o, p, $2))
+      }
+  | LPAREN TYPE lident_list RPAREN fun_def
+      { mk_newtypes ~loc:$sloc $3 $5 }
+;
+%inline expr_comma_list:
+  es = separated_nontrivial_llist(COMMA, expr)
+    { es }
+;
+record_expr_content:
+  eo = ioption(terminated(simple_expr, WITH))
+  fields = separated_or_terminated_nonempty_list(SEMI, record_expr_field)
+    { eo, fields }
+;
+%inline record_expr_field:
+  | label = mkrhs(label_longident)
+    c = type_constraint?
+    eo = preceded(EQUAL, expr)?
+      { let e =
+          match eo with
+          | None ->
+              (* No pattern; this is a pun. Desugar it. *)
+              exp_of_longident ~loc:$sloc label
+          | Some e ->
+              e
+        in
+        label, mkexp_opt_constraint ~loc:$sloc e c }
+;
+%inline object_expr_content:
+  xs = separated_or_terminated_nonempty_list(SEMI, object_expr_field)
+    { xs }
+;
+%inline object_expr_field:
+    label = mkrhs(label)
+    oe = preceded(EQUAL, expr)?
+      { let e =
+          match oe with
+          | None ->
+              (* No expression; this is a pun. Desugar it. *)
+              exp_of_label ~loc:$sloc label
+          | Some e ->
+              e
+        in
+        label, e }
+;
+%inline expr_semi_list:
+  es = separated_or_terminated_nonempty_list(SEMI, expr)
+    { es }
+;
+type_constraint:
+    COLON core_type                             { (Some $2, None) }
+  | COLON core_type COLONGREATER core_type      { (Some $2, Some $4) }
+  | COLONGREATER core_type                      { (None, Some $2) }
+  | COLON error                                 { syntax_error() }
+  | COLONGREATER error                          { syntax_error() }
+;
+
+/* Patterns */
+
+(* Whereas [pattern] is an arbitrary pattern, [pattern_no_exn] is a pattern
+   that does not begin with the [EXCEPTION] keyword. Thus, [pattern_no_exn]
+   is the intersection of the context-free language [pattern] with the
+   regular language [^EXCEPTION .*].
+
+   Ideally, we would like to use [pattern] everywhere and check in a later
+   phase that EXCEPTION patterns are used only where they are allowed (there
+   is code in typing/typecore.ml to this end). Unfortunately, in the
+   definition of [let_binding_body], we cannot allow [pattern]. That would
+   create a shift/reduce conflict: upon seeing LET EXCEPTION ..., the parser
+   wouldn't know whether this is the beginning of a LET EXCEPTION construct or
+   the beginning of a LET construct whose pattern happens to begin with
+   EXCEPTION. The conflict is avoided there by using [pattern_no_exn] in the
+   definition of [let_binding_body].
+
+   In order to avoid duplication between the definitions of [pattern] and
+   [pattern_no_exn], we create a parameterized definition [pattern_(self)]
+   and instantiate it twice. *)
+
+pattern:
+    pattern_(pattern)
+      { $1 }
+  | EXCEPTION ext_attributes pattern %prec prec_constr_appl
+      { mkpat_attrs ~loc:$sloc (Ppat_exception $3) $2}
+;
+
+pattern_no_exn:
+    pattern_(pattern_no_exn)
+      { $1 }
+;
+
+%inline pattern_(self):
+  | self COLONCOLON pattern
+      { mkpat_cons ~loc:$sloc $loc($2) (ghpat ~loc:$sloc (Ppat_tuple[$1;$3])) }
+  | self attribute
+      { Pat.attr $1 $2 }
+  | pattern_gen
+      { $1 }
+  | mkpat(
+      self AS mkrhs(val_ident)
+        { Ppat_alias($1, $3) }
+    | self AS error
+        { expecting $loc($3) "identifier" }
+    | pattern_comma_list(self) %prec below_COMMA
+        { Ppat_tuple(List.rev $1) }
+    | self COLONCOLON error
+        { expecting $loc($3) "pattern" }
+    | self BAR pattern
+        { Ppat_or($1, $3) }
+    | self BAR error
+        { expecting $loc($3) "pattern" }
+  ) { $1 }
+;
+
+pattern_gen:
+    simple_pattern
+      { $1 }
+  | mkpat(
+      mkrhs(constr_longident) pattern %prec prec_constr_appl
+        { Ppat_construct($1, Some $2) }
+    | name_tag pattern %prec prec_constr_appl
+        { Ppat_variant($1, Some $2) }
+    ) { $1 }
+  | 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) })
+      { $1 }
+  | simple_pattern_not_ident { $1 }
+;
+
+simple_pattern_not_ident:
+  | LPAREN pattern RPAREN
+      { reloc_pat ~loc:$sloc $2 }
+  | simple_delimited_pattern
+      { $1 }
+  | LPAREN MODULE ext_attributes mkrhs(module_name) RPAREN
+      { mkpat_attrs ~loc:$sloc (Ppat_unpack $4) $3 }
+  | LPAREN MODULE ext_attributes mkrhs(module_name) COLON package_type RPAREN
+      { mkpat_attrs ~loc:$sloc
+          (Ppat_constraint(mkpat ~loc:$sloc (Ppat_unpack $4), $6))
+          $3 }
+  | mkpat(simple_pattern_not_ident_)
+      { $1 }
+;
+%inline simple_pattern_not_ident_:
+  | UNDERSCORE
+      { Ppat_any }
+  | signed_constant
+      { Ppat_constant $1 }
+  | signed_constant DOTDOT signed_constant
+      { Ppat_interval ($1, $3) }
+  | mkrhs(constr_longident)
+      { Ppat_construct($1, None) }
+  | name_tag
+      { Ppat_variant($1, None) }
+  | HASH mkrhs(type_longident)
+      { Ppat_type ($2) }
+  | mkrhs(mod_longident) DOT simple_delimited_pattern
+      { Ppat_open($1, $3) }
+  | mkrhs(mod_longident) DOT mkrhs(LBRACKET RBRACKET {Lident "[]"})
+    { Ppat_open($1, mkpat ~loc:$sloc (Ppat_construct($3, None))) }
+  | mkrhs(mod_longident) DOT mkrhs(LPAREN RPAREN {Lident "()"})
+    { Ppat_open($1, mkpat ~loc:$sloc (Ppat_construct($3, None))) }
+  | mkrhs(mod_longident) DOT LPAREN pattern RPAREN
+      { Ppat_open ($1, $4) }
+  | mod_longident DOT LPAREN pattern error
+      { unclosed "(" $loc($3) ")" $loc($5)  }
+  | mod_longident DOT LPAREN error
+      { expecting $loc($4) "pattern" }
+  | LPAREN pattern error
+      { unclosed "(" $loc($1) ")" $loc($3) }
+  | LPAREN pattern COLON core_type RPAREN
+      { Ppat_constraint($2, $4) }
+  | LPAREN pattern COLON core_type error
+      { unclosed "(" $loc($1) ")" $loc($5) }
+  | LPAREN pattern COLON error
+      { expecting $loc($4) "type" }
+  | LPAREN MODULE ext_attributes module_name COLON package_type
+    error
+      { unclosed "(" $loc($1) ")" $loc($7) }
+  | extension
+      { Ppat_extension $1 }
+;
+
+simple_delimited_pattern:
+  mkpat(
+      LBRACE record_pat_content RBRACE
+      { let (fields, closed) = $2 in
+        Ppat_record(fields, closed) }
+    | LBRACE record_pat_content error
+      { unclosed "{" $loc($1) "}" $loc($3) }
+    | LBRACKET pattern_semi_list RBRACKET
+      { fst (mktailpat $loc($3) $2) }
+    | LBRACKET pattern_semi_list error
+      { unclosed "[" $loc($1) "]" $loc($3) }
+    | LBRACKETBAR pattern_semi_list BARRBRACKET
+      { Ppat_array $2 }
+    | LBRACKETBAR BARRBRACKET
+      { Ppat_array [] }
+    | LBRACKETBAR pattern_semi_list error
+      { unclosed "[|" $loc($1) "|]" $loc($3) }
+  ) { $1 }
+
+pattern_comma_list(self):
+    pattern_comma_list(self) COMMA pattern      { $3 :: $1 }
+  | self COMMA pattern                          { [$3; $1] }
+  | self COMMA error                            { expecting $loc($3) "pattern" }
+;
+%inline pattern_semi_list:
+  ps = separated_or_terminated_nonempty_list(SEMI, pattern)
+    { ps }
+;
+(* A label-pattern list is a nonempty list of label-pattern pairs, optionally
+   followed with an UNDERSCORE, separated-or-terminated with semicolons. *)
+%inline record_pat_content:
+  listx(SEMI, record_pat_field, UNDERSCORE)
+    { let fields, closed = $1 in
+      let closed = match closed with Some () -> Open | None -> Closed in
+      fields, closed }
+;
+%inline record_pat_field:
+  label = mkrhs(label_longident)
+  octy = preceded(COLON, core_type)?
+  opat = preceded(EQUAL, pattern)?
+    { let pat =
+        match opat with
+        | None ->
+            (* No pattern; this is a pun. Desugar it. *)
+            pat_of_label ~loc:$sloc label
+        | Some pat ->
+            pat
+      in
+      label, mkpat_opt_constraint ~loc:$sloc pat octy
+    }
+;
+
+/* Value descriptions */
+
+value_description:
+  VAL
+  ext = ext
+  attrs1 = attributes
+  id = mkrhs(val_ident)
+  COLON
+  ty = core_type
+  attrs2 = post_item_attributes
+    { 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 }
+;
+
+/* Primitive declarations */
+
+primitive_declaration:
+  EXTERNAL
+  ext = ext
+  attrs1 = attributes
+  id = mkrhs(val_ident)
+  COLON
+  ty = core_type
+  EQUAL
+  prim = raw_string+
+  attrs2 = post_item_attributes
+    { 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 }
+;
+
+(* Type declarations and type substitutions. *)
+
+(* Type declarations [type t = u] and type substitutions [type t := u] are very
+   similar, so we view them as instances of [generic_type_declarations]. In the
+   case of a type declaration, the use of [nonrec_flag] means that [NONREC] may
+   be absent or present, whereas in the case of a type substitution, the use of
+   [no_nonrec_flag] means that [NONREC] must be absent. The use of [type_kind]
+   versus [type_subst_kind] means that in the first case, we expect an [EQUAL]
+   sign, whereas in the second case, we expect [COLONEQUAL]. *)
+
+%inline type_declarations:
+  generic_type_declarations(nonrec_flag, type_kind)
+    { $1 }
+;
+
+%inline type_subst_declarations:
+  generic_type_declarations(no_nonrec_flag, type_subst_kind)
+    { $1 }
+;
+
+(* A set of type declarations or substitutions begins with a
+   [generic_type_declaration] and continues with a possibly empty list of
+   [generic_and_type_declaration]s. *)
+
+%inline generic_type_declarations(flag, kind):
+  xlist(
+    generic_type_declaration(flag, kind),
+    generic_and_type_declaration(kind)
+  )
+  { $1 }
+;
+
+(* [generic_type_declaration] and [generic_and_type_declaration] look similar,
+   but are in reality different enough that it is difficult to share anything
+   between them. *)
+
+generic_type_declaration(flag, kind):
+  TYPE
+  ext = ext
+  attrs1 = attributes
+  flag = flag
+  params = type_parameters
+  id = mkrhs(LIDENT)
+  kind_priv_manifest = kind
+  cstrs = constraints
+  attrs2 = post_item_attributes
+    {
+      let (kind, priv, manifest) = kind_priv_manifest in
+      let docs = symbol_docs $sloc in
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc $sloc in
+      (flag, ext),
+      Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
+    }
+;
+%inline generic_and_type_declaration(kind):
+  AND
+  attrs1 = attributes
+  params = type_parameters
+  id = mkrhs(LIDENT)
+  kind_priv_manifest = kind
+  cstrs = constraints
+  attrs2 = post_item_attributes
+    {
+      let (kind, priv, manifest) = kind_priv_manifest in
+      let docs = symbol_docs $sloc in
+      let attrs = attrs1 @ attrs2 in
+      let loc = make_loc $sloc in
+      let text = symbol_text $symbolstartpos in
+      Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text
+    }
+;
+%inline constraints:
+  llist(preceded(CONSTRAINT, constrain))
+    { $1 }
+;
+(* Lots of %inline expansion are required for [nonempty_type_kind] to be
+   LR(1). At the cost of some manual expansion, it would be possible to give a
+   definition that leads to a smaller grammar (after expansion) and therefore
+   a smaller automaton. *)
+nonempty_type_kind:
+  | priv = inline_private_flag
+    ty = core_type
+      { (Ptype_abstract, priv, Some ty) }
+  | oty = type_synonym
+    priv = inline_private_flag
+    cs = constructor_declarations
+      { (Ptype_variant cs, priv, oty) }
+  | oty = type_synonym
+    priv = inline_private_flag
+    DOTDOT
+      { (Ptype_open, priv, oty) }
+  | oty = type_synonym
+    priv = inline_private_flag
+    LBRACE ls = label_declarations RBRACE
+      { (Ptype_record ls, priv, oty) }
+;
+%inline type_synonym:
+  ioption(terminated(core_type, EQUAL))
+    { $1 }
+;
+type_kind:
+    /*empty*/
+      { (Ptype_abstract, Public, None) }
+  | EQUAL nonempty_type_kind
+      { $2 }
+;
+%inline type_subst_kind:
+    COLONEQUAL nonempty_type_kind
+      { $2 }
+;
+type_parameters:
+    /* empty */
+      { [] }
+  | p = type_parameter
+      { [p] }
+  | LPAREN ps = separated_nonempty_llist(COMMA, type_parameter) RPAREN
+      { ps }
+;
+type_parameter:
+    type_variance type_variable        { $2, $1 }
+;
+type_variable:
+  mktyp(
+    QUOTE tyvar = ident
+      { Ptyp_var tyvar }
+  | UNDERSCORE
+      { Ptyp_any }
+  ) { $1 }
+;
+
+type_variance:
+    /* empty */                                 { Invariant }
+  | PLUS                                        { Covariant }
+  | MINUS                                       { Contravariant }
+;
+
+(* A sequence of constructor declarations is either a single BAR, which
+   means that the list is empty, or a nonempty BAR-separated list of
+   declarations, with an optional leading BAR. *)
+constructor_declarations:
+  | BAR
+      { [] }
+  | cs = bar_llist(constructor_declaration)
+      { cs }
+;
+(* A constructor declaration begins with an opening symbol, which can
+   be either epsilon or BAR. Note that this opening symbol is included
+   in the footprint $sloc. *)
+(* Because [constructor_declaration] and [extension_constructor_declaration]
+   are identical except for their semantic actions, we introduce the symbol
+   [generic_constructor_declaration], whose semantic action is neutral -- it
+   merely returns a tuple. *)
+generic_constructor_declaration(opening):
+  opening
+  cid = mkrhs(constr_ident)
+  args_res = generalized_constructor_arguments
+  attrs = attributes
+    {
+      let args, res = args_res in
+      let info = symbol_info $endpos in
+      let loc = make_loc $sloc in
+      cid, args, res, attrs, loc, info
+    }
+;
+%inline constructor_declaration(opening):
+  d = generic_constructor_declaration(opening)
+    {
+      let cid, args, res, attrs, loc, info = d in
+      Type.constructor cid ~args ?res ~attrs ~loc ~info
+    }
+;
+str_exception_declaration:
+  sig_exception_declaration
+    { $1 }
+| EXCEPTION
+  ext = ext
+  attrs1 = attributes
+  id = mkrhs(constr_ident)
+  EQUAL
+  lid = mkrhs(constr_longident)
+  attrs2 = attributes
+  attrs = post_item_attributes
+  { 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 }
+;
+sig_exception_declaration:
+  EXCEPTION
+  ext = ext
+  attrs1 = attributes
+  id = mkrhs(constr_ident)
+  args_res = generalized_constructor_arguments
+  attrs2 = attributes
+  attrs = post_item_attributes
+    { let args, res = args_res in
+      let loc = make_loc $sloc in
+      let docs = symbol_docs $sloc in
+      Te.mk_exception ~attrs
+        (Te.decl id ~args ?res ~attrs:(attrs1 @ attrs2) ~loc ~docs)
+      , ext }
+;
+%inline let_exception_declaration:
+    mkrhs(constr_ident) generalized_constructor_arguments attributes
+      { let args, res = $2 in
+        Te.decl $1 ~args ?res ~attrs:$3 ~loc:(make_loc $sloc) }
+;
+generalized_constructor_arguments:
+    /*empty*/                     { (Pcstr_tuple [],None) }
+  | OF constructor_arguments      { ($2,None) }
+  | COLON constructor_arguments MINUSGREATER atomic_type %prec below_HASH
+                                  { ($2,Some $4) }
+  | COLON atomic_type %prec below_HASH
+                                  { (Pcstr_tuple [],Some $2) }
+;
+
+constructor_arguments:
+  | tys = inline_separated_nonempty_llist(STAR, atomic_type)
+    %prec below_HASH
+      { Pcstr_tuple tys }
+  | LBRACE label_declarations RBRACE
+      { Pcstr_record $2 }
+;
+label_declarations:
+    label_declaration                           { [$1] }
+  | label_declaration_semi                      { [$1] }
+  | label_declaration_semi label_declarations   { $1 :: $2 }
+;
+label_declaration:
+    mutable_flag mkrhs(label) COLON poly_type_no_attr attributes
+      { let info = symbol_info $endpos in
+        Type.field $2 $4 ~mut:$1 ~attrs:$5 ~loc:(make_loc $sloc) ~info }
+;
+label_declaration_semi:
+    mutable_flag mkrhs(label) COLON poly_type_no_attr attributes SEMI attributes
+      { 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 }
+;
+
+/* Type Extensions */
+
+%inline str_type_extension:
+  type_extension(extension_constructor)
+    { $1 }
+;
+%inline sig_type_extension:
+  type_extension(extension_constructor_declaration)
+    { $1 }
+;
+%inline type_extension(declaration):
+  TYPE
+  ext = ext
+  attrs1 = attributes
+  no_nonrec_flag
+  params = type_parameters
+  tid = mkrhs(type_longident)
+  PLUSEQ
+  priv = private_flag
+  cs = bar_llist(declaration)
+  attrs2 = post_item_attributes
+    { let docs = symbol_docs $sloc in
+      let attrs = attrs1 @ attrs2 in
+      Te.mk tid cs ~params ~priv ~attrs ~docs,
+      ext }
+;
+%inline extension_constructor(opening):
+    extension_constructor_declaration(opening)
+      { $1 }
+  | extension_constructor_rebind(opening)
+      { $1 }
+;
+%inline extension_constructor_declaration(opening):
+  d = generic_constructor_declaration(opening)
+    {
+      let cid, args, res, attrs, loc, info = d in
+      Te.decl cid ~args ?res ~attrs ~loc ~info
+    }
+;
+extension_constructor_rebind(opening):
+  opening
+  cid = mkrhs(constr_ident)
+  EQUAL
+  lid = mkrhs(constr_longident)
+  attrs = attributes
+      { let info = symbol_info $endpos in
+        Te.rebind cid lid ~attrs ~loc:(make_loc $sloc) ~info }
+;
+
+/* "with" constraints (additional type equations over signature components) */
+
+with_constraint:
+    TYPE type_parameters mkrhs(label_longident) with_type_binder
+    core_type_no_attr constraints
+      { let lident = loc_last $3 in
+        Pwith_type
+          ($3,
+           (Type.mk lident
+              ~params:$2
+              ~cstrs:$6
+              ~manifest:$5
+              ~priv:$4
+              ~loc:(make_loc $sloc))) }
+    /* used label_longident instead of type_longident to disallow
+       functor applications in type path */
+  | TYPE type_parameters mkrhs(label_longident)
+    COLONEQUAL core_type_no_attr
+      { let lident = loc_last $3 in
+        Pwith_typesubst
+         ($3,
+           (Type.mk lident
+              ~params:$2
+              ~manifest:$5
+              ~loc:(make_loc $sloc))) }
+  | MODULE mkrhs(mod_longident) EQUAL mkrhs(mod_ext_longident)
+      { Pwith_module ($2, $4) }
+  | MODULE mkrhs(mod_longident) COLONEQUAL mkrhs(mod_ext_longident)
+      { Pwith_modsubst ($2, $4) }
+;
+with_type_binder:
+    EQUAL          { Public }
+  | EQUAL PRIVATE  { Private }
+;
+
+/* Polymorphic types */
+
+%inline typevar:
+  QUOTE mkrhs(ident)
+    { $2 }
+;
+%inline typevar_list:
+  nonempty_llist(typevar)
+    { $1 }
+;
+%inline poly(X):
+  typevar_list DOT X
+    { Ptyp_poly($1, $3) }
+;
+possibly_poly(X):
+  X
+    { $1 }
+| mktyp(poly(X))
+    { $1 }
+;
+%inline poly_type:
+  possibly_poly(core_type)
+    { $1 }
+;
+%inline poly_type_no_attr:
+  possibly_poly(core_type_no_attr)
+    { $1 }
+;
+
+(* -------------------------------------------------------------------------- *)
+
+(* Core language types. *)
+
+(* A core type (core_type) is a core type without attributes (core_type_no_attr)
+   followed with a list of attributes. *)
+core_type:
+    core_type_no_attr
+      { $1 }
+  | core_type attribute
+      { Typ.attr $1 $2 }
+;
+
+(* A core type without attributes is currently defined as an alias type, but
+   this could change in the future if new forms of types are introduced. From
+   the outside, one should use core_type_no_attr. *)
+%inline core_type_no_attr:
+  alias_type
+    { $1 }
+;
+
+(* Alias types include:
+   - function types (see below);
+   - proper alias types:                  'a -> int as 'a
+ *)
+alias_type:
+    function_type
+      { $1 }
+  | mktyp(
+      ty = alias_type AS QUOTE tyvar = ident
+        { Ptyp_alias(ty, tyvar) }
+    )
+    { $1 }
+;
+
+(* Function types include:
+   - tuple types (see below);
+   - proper function types:               int -> int
+                                          foo: int -> int
+                                          ?foo: int -> int
+ *)
+function_type:
+  | ty = tuple_type
+    %prec MINUSGREATER
+      { ty }
+  | mktyp(
+      label = arg_label
+      domain = extra_rhs(tuple_type)
+      MINUSGREATER
+      codomain = function_type
+        { Ptyp_arrow(label, domain, codomain) }
+    )
+    { $1 }
+;
+%inline arg_label:
+  | label = optlabel
+      { Optional label }
+  | label = LIDENT COLON
+      { Labelled label }
+  | /* empty */
+      { Nolabel }
+;
+(* Tuple types include:
+   - atomic types (see below);
+   - proper tuple types:                  int * int * int list
+   A proper tuple type is a star-separated list of at least two atomic types.
+ *)
+tuple_type:
+  | ty = atomic_type
+    %prec below_HASH
+      { ty }
+  | mktyp(
+      tys = separated_nontrivial_llist(STAR, atomic_type)
+        { Ptyp_tuple tys }
+    )
+    { $1 }
+;
+
+(* Atomic types are the most basic level in the syntax of types.
+   Atomic types include:
+   - types between parentheses:           (int -> int)
+   - first-class module types:            (module S)
+   - type variables:                      'a
+   - applications of type constructors:   int, int list, int option list
+   - variant types:                       [`A]
+ *)
+atomic_type:
+  | LPAREN core_type RPAREN
+      { $2 }
+  | LPAREN MODULE ext_attributes package_type RPAREN
+      { wrap_typ_attrs ~loc:$sloc (reloc_typ ~loc:$sloc $4) $3 }
+  | mktyp( /* begin mktyp group */
+      QUOTE ident
+        { Ptyp_var $2 }
+    | UNDERSCORE
+        { Ptyp_any }
+    | tys = actual_type_parameters
+      tid = mkrhs(type_longident)
+        { Ptyp_constr(tid, tys) }
+    | LESS meth_list GREATER
+        { let (f, c) = $2 in Ptyp_object (f, c) }
+    | LESS GREATER
+        { Ptyp_object ([], Closed) }
+    | tys = actual_type_parameters
+      HASH
+      cid = mkrhs(clty_longident)
+        { Ptyp_class(cid, tys) }
+    | LBRACKET tag_field RBRACKET
+        (* not row_field; see CONFLICTS *)
+        { Ptyp_variant([$2], Closed, None) }
+    | LBRACKET BAR row_field_list RBRACKET
+        { Ptyp_variant($3, Closed, None) }
+    | LBRACKET row_field BAR row_field_list RBRACKET
+        { Ptyp_variant($2 :: $4, Closed, None) }
+    | LBRACKETGREATER BAR? row_field_list RBRACKET
+        { Ptyp_variant($3, Open, None) }
+    | LBRACKETGREATER RBRACKET
+        { Ptyp_variant([], Open, None) }
+    | LBRACKETLESS BAR? row_field_list RBRACKET
+        { Ptyp_variant($3, Closed, Some []) }
+    | LBRACKETLESS BAR? row_field_list GREATER name_tag_list RBRACKET
+        { Ptyp_variant($3, Closed, Some $5) }
+    | extension
+        { Ptyp_extension $1 }
+  )
+  { $1 } /* end mktyp group */
+;
+
+(* This is the syntax of the actual type parameters in an application of
+   a type constructor, such as int, int list, or (int, bool) Hashtbl.t.
+   We allow one of the following:
+   - zero parameters;
+   - one parameter:
+     an atomic type;
+     among other things, this can be an arbitrary type between parentheses;
+   - two or more parameters:
+     arbitrary types, between parentheses, separated with commas.
+ *)
+%inline actual_type_parameters:
+  | /* empty */
+      { [] }
+  | ty = atomic_type
+      { [ty] }
+  | LPAREN tys = separated_nontrivial_llist(COMMA, core_type) RPAREN
+      { tys }
+;
+
+%inline package_type:
+    mktyp(module_type
+      { Ptyp_package (package_type_of_module_type $1) })
+      { $1 }
+;
+%inline row_field_list:
+  separated_nonempty_llist(BAR, row_field)
+    { $1 }
+;
+row_field:
+    tag_field
+      { $1 }
+  | core_type
+      { Rf.inherit_ ~loc:(make_loc $sloc) $1 }
+;
+tag_field:
+    mkrhs(name_tag) OF opt_ampersand amper_type_list attributes
+      { let info = symbol_info $endpos in
+        let attrs = add_info_attrs info $5 in
+        Rf.tag ~loc:(make_loc $sloc) ~attrs $1 $3 $4 }
+  | mkrhs(name_tag) attributes
+      { let info = symbol_info $endpos in
+        let attrs = add_info_attrs info $2 in
+        Rf.tag ~loc:(make_loc $sloc) ~attrs $1 true [] }
+;
+opt_ampersand:
+    AMPERSAND                                   { true }
+  | /* empty */                                 { false }
+;
+%inline amper_type_list:
+  separated_nonempty_llist(AMPERSAND, core_type_no_attr)
+    { $1 }
+;
+%inline name_tag_list:
+  nonempty_llist(name_tag)
+    { $1 }
+;
+(* A method list (in an object type). *)
+meth_list:
+    head = field_semi         tail = meth_list
+  | head = inherit_field SEMI tail = meth_list
+      { let (f, c) = tail in (head :: f, c) }
+  | head = field_semi
+  | head = inherit_field SEMI
+      { [head], Closed }
+  | head = field
+  | head = inherit_field
+      { [head], Closed }
+  | DOTDOT
+      { [], Open }
+;
+%inline field:
+  mkrhs(label) COLON poly_type_no_attr attributes
+    { let info = symbol_info $endpos in
+      let attrs = add_info_attrs info $4 in
+      Of.tag ~loc:(make_loc $sloc) ~attrs $1 $3 }
+;
+
+%inline field_semi:
+  mkrhs(label) COLON poly_type_no_attr attributes SEMI attributes
+    { let info =
+        match rhs_info $endpos($4) with
+        | Some _ as info_before_semi -> info_before_semi
+        | None -> symbol_info $endpos
+      in
+      let attrs = add_info_attrs info ($4 @ $6) in
+      Of.tag ~loc:(make_loc $sloc) ~attrs $1 $3 }
+;
+
+%inline inherit_field:
+  ty = atomic_type
+    { Of.inherit_ ~loc:(make_loc $sloc) ty }
+;
+
+%inline label:
+    LIDENT                                      { $1 }
+;
+
+/* 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) }
+;
+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) }
+;
+
+/* Identifiers and long identifiers */
+
+ident:
+    UIDENT                    { $1 }
+  | LIDENT                    { $1 }
+;
+val_extra_ident:
+  | LPAREN operator RPAREN    { $2 }
+  | LPAREN operator error     { unclosed "(" $loc($1) ")" $loc($3) }
+  | LPAREN error              { expecting $loc($2) "operator" }
+  | LPAREN MODULE error       { expecting $loc($3) "module-expr" }
+;
+val_ident:
+    LIDENT                    { $1 }
+  | val_extra_ident           { $1 }
+;
+operator:
+    PREFIXOP                                    { $1 }
+  | LETOP                                       { $1 }
+  | ANDOP                                       { $1 }
+  | DOTOP LPAREN index_mod RPAREN               { "."^ $1 ^"(" ^ $3 ^ ")" }
+  | DOTOP LPAREN index_mod RPAREN LESSMINUS     { "."^ $1 ^ "(" ^ $3 ^ ")<-" }
+  | DOTOP LBRACKET index_mod RBRACKET           { "."^ $1 ^"[" ^ $3 ^ "]" }
+  | DOTOP LBRACKET index_mod RBRACKET LESSMINUS { "."^ $1 ^ "[" ^ $3 ^ "]<-" }
+  | DOTOP LBRACE index_mod RBRACE               { "."^ $1 ^"{" ^ $3 ^ "}" }
+  | DOTOP LBRACE index_mod RBRACE LESSMINUS     { "."^ $1 ^ "{" ^ $3 ^ "}<-" }
+  | HASHOP                                      { $1 }
+  | BANG                                        { "!" }
+  | infix_operator                              { $1 }
+;
+%inline infix_operator:
+  | op = INFIXOP0 { op }
+  | op = INFIXOP1 { op }
+  | op = INFIXOP2 { op }
+  | op = INFIXOP3 { op }
+  | op = INFIXOP4 { op }
+  | PLUS           {"+"}
+  | PLUSDOT       {"+."}
+  | PLUSEQ        {"+="}
+  | MINUS          {"-"}
+  | MINUSDOT      {"-."}
+  | STAR           {"*"}
+  | PERCENT        {"%"}
+  | EQUAL          {"="}
+  | LESS           {"<"}
+  | GREATER        {">"}
+  | OR            {"or"}
+  | BARBAR        {"||"}
+  | AMPERSAND      {"&"}
+  | AMPERAMPER    {"&&"}
+  | COLONEQUAL    {":="}
+;
+index_mod:
+| { "" }
+| SEMI DOTDOT { ";.." }
+;
+
+%inline constr_extra_ident:
+  | LPAREN COLONCOLON RPAREN                    { "::" }
+;
+constr_extra_nonprefix_ident:
+  | LBRACKET RBRACKET                           { "[]" }
+  | LPAREN RPAREN                               { "()" }
+  | FALSE                                       { "false" }
+  | TRUE                                        { "true" }
+;
+constr_ident:
+    UIDENT                                      { $1 }
+  | constr_extra_ident                          { $1 }
+  | constr_extra_nonprefix_ident                { $1 }
+;
+constr_longident:
+    mod_longident       %prec below_DOT  { $1 } /* A.B.x vs (A).B.x */
+  | mod_longident DOT constr_extra_ident { Ldot($1,$3) }
+  | constr_extra_ident                   { Lident $1 }
+  | constr_extra_nonprefix_ident         { Lident $1 }
+;
+mk_longident(prefix,final):
+   | final            { Lident $1 }
+   | prefix DOT final { Ldot($1,$3) }
+;
+val_longident:
+    mk_longident(mod_longident, val_ident) { $1 }
+;
+label_longident:
+    mk_longident(mod_longident, LIDENT) { $1 }
+;
+type_longident:
+    mk_longident(mod_ext_longident, LIDENT)  { $1 }
+;
+mod_longident:
+    mk_longident(mod_longident, UIDENT)  { $1 }
+;
+mod_ext_longident:
+    mk_longident(mod_ext_longident, UIDENT) { $1 }
+  | mod_ext_longident LPAREN mod_ext_longident RPAREN
+      { lapply ~loc:$sloc $1 $3 }
+  | mod_ext_longident LPAREN error
+      { expecting $loc($3) "module path" }
+;
+mty_longident:
+    mk_longident(mod_ext_longident,ident) { $1 }
+;
+clty_longident:
+    mk_longident(mod_ext_longident,LIDENT) { $1 }
+;
+class_longident:
+   mk_longident(mod_longident,LIDENT) { $1 }
+;
+
+/* For compiler-libs: parse all valid longidents and a little more:
+   final identifiers which are value specific are accepted even when
+   the path prefix is only valid for types: (e.g. F(X).(::)) */
+any_longident:
+  | mk_longident (mod_ext_longident,
+     ident | constr_extra_ident | val_extra_ident { $1 }
+    ) { $1 }
+  | constr_extra_nonprefix_ident { Lident $1 }
+;
+
+/* Toplevel directives */
+
+toplevel_directive:
+  HASH dir = mkrhs(ident)
+  arg = ioption(mk_directive_arg(toplevel_directive_argument))
+    { mk_directive ~loc:$sloc dir arg }
+;
+
+%inline toplevel_directive_argument:
+  | STRING        { let (s, _, _) = $1 in Pdir_string s }
+  | INT           { let (n, m) = $1 in Pdir_int (n ,m) }
+  | val_longident { Pdir_ident $1 }
+  | mod_longident { Pdir_ident $1 }
+  | FALSE         { Pdir_bool false }
+  | TRUE          { Pdir_bool true }
+;
+
+/* Miscellaneous */
+
+(* The symbol epsilon can be used instead of an /* empty */ comment. *)
+%inline epsilon:
+  /* empty */
+    { () }
+;
+
+%inline raw_string:
+  s = STRING
+    { let body, _, _ = s in body }
+;
+
+name_tag:
+    BACKQUOTE ident                             { $2 }
+;
+rec_flag:
+    /* empty */                                 { Nonrecursive }
+  | REC                                         { Recursive }
+;
+%inline nonrec_flag:
+    /* empty */                                 { Recursive }
+  | NONREC                                      { Nonrecursive }
+;
+%inline no_nonrec_flag:
+    /* empty */ { Recursive }
+  | NONREC      { not_expecting $loc "nonrec flag" }
+;
+direction_flag:
+    TO                                          { Upto }
+  | DOWNTO                                      { Downto }
+;
+private_flag:
+  inline_private_flag
+    { $1 }
+;
+%inline inline_private_flag:
+    /* empty */                                 { Public }
+  | PRIVATE                                     { Private }
+;
+mutable_flag:
+    /* empty */                                 { Immutable }
+  | MUTABLE                                     { Mutable }
+;
+virtual_flag:
+    /* empty */                                 { Concrete }
+  | VIRTUAL                                     { Virtual }
+;
+mutable_virtual_flags:
+    /* empty */
+      { Immutable, Concrete }
+  | MUTABLE
+      { Mutable, Concrete }
+  | VIRTUAL
+      { Immutable, Virtual }
+  | MUTABLE VIRTUAL
+  | VIRTUAL MUTABLE
+      { Mutable, Virtual }
+;
+private_virtual_flags:
+    /* empty */  { Public, Concrete }
+  | PRIVATE { Private, Concrete }
+  | VIRTUAL { Public, Virtual }
+  | PRIVATE VIRTUAL { Private, Virtual }
+  | VIRTUAL PRIVATE { Private, Virtual }
+;
+(* This nonterminal symbol indicates the definite presence of a VIRTUAL
+   keyword and the possible presence of a MUTABLE keyword. *)
+virtual_with_mutable_flag:
+  | VIRTUAL { Immutable }
+  | MUTABLE VIRTUAL { Mutable }
+  | VIRTUAL MUTABLE { Mutable }
+;
+(* This nonterminal symbol indicates the definite presence of a VIRTUAL
+   keyword and the possible presence of a PRIVATE keyword. *)
+virtual_with_private_flag:
+  | VIRTUAL { Public }
+  | PRIVATE VIRTUAL { Private }
+  | VIRTUAL PRIVATE { Private }
+;
+%inline no_override_flag:
+    /* empty */                                 { Fresh }
+;
+%inline override_flag:
+    /* empty */                                 { Fresh }
+  | BANG                                        { Override }
+;
+subtractive:
+  | MINUS                                       { "-" }
+  | MINUSDOT                                    { "-." }
+;
+additive:
+  | PLUS                                        { "+" }
+  | PLUSDOT                                     { "+." }
+;
+optlabel:
+   | OPTLABEL                                   { $1 }
+   | QUESTION LIDENT COLON                      { $2 }
+;
+
+/* Attributes and extensions */
+
+single_attr_id:
+    LIDENT { $1 }
+  | UIDENT { $1 }
+  | 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" }
+  | 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" }
+/* mod/land/lor/lxor/lsl/lsr/asr are not supported for now */
+;
+
+attr_id:
+  mkloc(
+      single_attr_id { $1 }
+    | single_attr_id DOT attr_id { $1 ^ "." ^ $3.txt }
+  ) { $1 }
+;
+attribute:
+  LBRACKETAT attr_id payload RBRACKET
+    { Attr.mk ~loc:(make_loc $sloc) $2 $3 }
+;
+post_item_attribute:
+  LBRACKETATAT attr_id payload RBRACKET
+    { Attr.mk ~loc:(make_loc $sloc) $2 $3 }
+;
+floating_attribute:
+  LBRACKETATATAT attr_id payload RBRACKET
+    { mark_symbol_docs $sloc;
+      Attr.mk ~loc:(make_loc $sloc) $2 $3 }
+;
+%inline post_item_attributes:
+  post_item_attribute*
+    { $1 }
+;
+%inline attributes:
+  attribute*
+    { $1 }
+;
+ext:
+  | /* empty */     { None }
+  | PERCENT attr_id { Some $2 }
+;
+%inline no_ext:
+  | /* empty */     { None }
+  | PERCENT attr_id { not_expecting $loc "extension" }
+;
+%inline ext_attributes:
+  ext attributes    { $1, $2 }
+;
+extension:
+  | LBRACKETPERCENT attr_id payload RBRACKET { ($2, $3) }
+  | QUOTED_STRING_EXPR
+    { mk_quotedext ~loc:$sloc $1 }
+;
+item_extension:
+  | LBRACKETPERCENTPERCENT attr_id payload RBRACKET { ($2, $3) }
+  | QUOTED_STRING_ITEM
+    { mk_quotedext ~loc:$sloc $1 }
+;
+payload:
+    structure { PStr $1 }
+  | COLON signature { PSig $2 }
+  | COLON core_type { PTyp $2 }
+  | QUESTION pattern { PPat ($2, None) }
+  | QUESTION pattern WHEN seq_expr { PPat ($2, Some $4) }
+;
+%%
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
new file mode 100644
index 00000000..0712f87c
--- /dev/null
+++ b/parsing/parsetree.mli
@@ -0,0 +1,970 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Abstract syntax tree produced by parsing
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Asttypes
+
+type constant =
+    Pconst_integer of string * char option
+  (* 3 3l 3L 3n
+
+     Suffixes [g-z][G-Z] are accepted by the parser.
+     Suffixes except 'l', 'L' and 'n' are rejected by the typechecker
+  *)
+  | Pconst_char of char
+  (* 'c' *)
+  | Pconst_string of string * Location.t * string option
+  (* "constant"
+     {delim|other constant|delim}
+
+     The location span the content of the string, without the delimiters.
+  *)
+  | Pconst_float of string * char option
+  (* 3.4 2e5 1.4e-4
+
+     Suffixes [g-z][G-Z] are accepted by the parser.
+     Suffixes are rejected by the typechecker.
+  *)
+
+type location_stack = Location.t list
+
+(** {1 Extension points} *)
+
+type attribute = {
+    attr_name : string loc;
+    attr_payload : payload;
+    attr_loc : Location.t;
+  }
+       (* [@id ARG]
+          [@@id ARG]
+
+          Metadata containers passed around within the AST.
+          The compiler ignores unknown attributes.
+       *)
+
+and extension = string loc * payload
+      (* [%id ARG]
+         [%%id ARG]
+
+         Sub-language placeholder -- rejected by the typechecker.
+      *)
+
+and attributes = attribute list
+
+and payload =
+  | PStr of structure
+  | PSig of signature (* : SIG *)
+  | PTyp of core_type  (* : T *)
+  | PPat of pattern * expression option  (* ? P  or  ? P when E *)
+
+(** {1 Core language} *)
+
+(* Type expressions *)
+
+and core_type =
+    {
+     ptyp_desc: core_type_desc;
+     ptyp_loc: Location.t;
+     ptyp_loc_stack: location_stack;
+     ptyp_attributes: attributes; (* ... [@id1] [@id2] *)
+    }
+
+and core_type_desc =
+  | Ptyp_any
+        (*  _ *)
+  | Ptyp_var of string
+        (* 'a *)
+  | Ptyp_arrow of arg_label * core_type * core_type
+        (* T1 -> T2       Simple
+           ~l:T1 -> T2    Labelled
+           ?l:T1 -> T2    Optional
+         *)
+  | Ptyp_tuple of core_type list
+        (* T1 * ... * Tn
+
+           Invariant: n >= 2
+        *)
+  | Ptyp_constr of Longident.t loc * core_type list
+        (* tconstr
+           T tconstr
+           (T1, ..., Tn) tconstr
+         *)
+  | Ptyp_object of object_field list * closed_flag
+        (* < l1:T1; ...; ln:Tn >     (flag = Closed)
+           < l1:T1; ...; ln:Tn; .. > (flag = Open)
+         *)
+  | Ptyp_class of Longident.t loc * core_type list
+        (* #tconstr
+           T #tconstr
+           (T1, ..., Tn) #tconstr
+         *)
+  | Ptyp_alias of core_type * string
+        (* T as 'a *)
+  | Ptyp_variant of row_field list * closed_flag * label list option
+        (* [ `A|`B ]         (flag = Closed; labels = None)
+           [> `A|`B ]        (flag = Open;   labels = None)
+           [< `A|`B ]        (flag = Closed; labels = Some [])
+           [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"])
+         *)
+  | Ptyp_poly of string loc list * core_type
+        (* 'a1 ... 'an. T
+
+           Can only appear in the following context:
+
+           - As the core_type of a Ppat_constraint node corresponding
+             to a constraint on a let-binding: let x : 'a1 ... 'an. T
+             = e ...
+
+           - Under Cfk_virtual for methods (not values).
+
+           - As the core_type of a Pctf_method node.
+
+           - As the core_type of a Pexp_poly node.
+
+           - As the pld_type field of a label_declaration.
+
+           - As a core_type of a Ptyp_object node.
+         *)
+
+  | Ptyp_package of package_type
+        (* (module S) *)
+  | Ptyp_extension of extension
+        (* [%id] *)
+
+and package_type = Longident.t loc * (Longident.t loc * core_type) list
+      (*
+        (module S)
+        (module S with type t1 = T1 and ... and tn = Tn)
+       *)
+
+and row_field = {
+  prf_desc : row_field_desc;
+  prf_loc : Location.t;
+  prf_attributes : attributes;
+}
+
+and row_field_desc =
+  | Rtag of label loc * bool * core_type list
+        (* [`A]                   ( true,  [] )
+           [`A of T]              ( false, [T] )
+           [`A of T1 & .. & Tn]   ( false, [T1;...Tn] )
+           [`A of & T1 & .. & Tn] ( true,  [T1;...Tn] )
+
+          - The 'bool' field is true if the tag contains a
+            constant (empty) constructor.
+          - '&' occurs when several types are used for the same constructor
+            (see 4.2 in the manual)
+        *)
+  | Rinherit of core_type
+        (* [ T ] *)
+
+and object_field = {
+  pof_desc : object_field_desc;
+  pof_loc : Location.t;
+  pof_attributes : attributes;
+}
+
+and object_field_desc =
+  | Otag of label loc * core_type
+  | Oinherit of core_type
+
+(* Patterns *)
+
+and pattern =
+    {
+     ppat_desc: pattern_desc;
+     ppat_loc: Location.t;
+     ppat_loc_stack: location_stack;
+     ppat_attributes: attributes; (* ... [@id1] [@id2] *)
+    }
+
+and pattern_desc =
+  | Ppat_any
+        (* _ *)
+  | Ppat_var of string loc
+        (* x *)
+  | Ppat_alias of pattern * string loc
+        (* P as 'a *)
+  | Ppat_constant of constant
+        (* 1, 'a', "true", 1.0, 1l, 1L, 1n *)
+  | Ppat_interval of constant * constant
+        (* 'a'..'z'
+
+           Other forms of interval are recognized by the parser
+           but rejected by the type-checker. *)
+  | Ppat_tuple of pattern list
+        (* (P1, ..., Pn)
+
+           Invariant: n >= 2
+        *)
+  | Ppat_construct of Longident.t loc * pattern option
+        (* C                None
+           C P              Some P
+           C (P1, ..., Pn)  Some (Ppat_tuple [P1; ...; Pn])
+         *)
+  | Ppat_variant of label * pattern option
+        (* `A             (None)
+           `A P           (Some P)
+         *)
+  | Ppat_record of (Longident.t loc * pattern) list * closed_flag
+        (* { l1=P1; ...; ln=Pn }     (flag = Closed)
+           { l1=P1; ...; ln=Pn; _}   (flag = Open)
+
+           Invariant: n > 0
+         *)
+  | Ppat_array of pattern list
+        (* [| P1; ...; Pn |] *)
+  | Ppat_or of pattern * pattern
+        (* P1 | P2 *)
+  | Ppat_constraint of pattern * core_type
+        (* (P : T) *)
+  | Ppat_type of Longident.t loc
+        (* #tconst *)
+  | Ppat_lazy of pattern
+        (* lazy P *)
+  | Ppat_unpack of string option loc
+        (* (module P)        Some "P"
+           (module _)        None
+
+           Note: (module P : S) is represented as
+           Ppat_constraint(Ppat_unpack, Ptyp_package)
+         *)
+  | Ppat_exception of pattern
+        (* exception P *)
+  | Ppat_extension of extension
+        (* [%id] *)
+  | Ppat_open of Longident.t loc * pattern
+        (* M.(P) *)
+
+(* Value expressions *)
+
+and expression =
+    {
+     pexp_desc: expression_desc;
+     pexp_loc: Location.t;
+     pexp_loc_stack: location_stack;
+     pexp_attributes: attributes; (* ... [@id1] [@id2] *)
+    }
+
+and expression_desc =
+  | Pexp_ident of Longident.t loc
+        (* x
+           M.x
+         *)
+  | Pexp_constant of constant
+        (* 1, 'a', "true", 1.0, 1l, 1L, 1n *)
+  | Pexp_let of rec_flag * value_binding list * expression
+        (* let P1 = E1 and ... and Pn = EN in E       (flag = Nonrecursive)
+           let rec P1 = E1 and ... and Pn = EN in E   (flag = Recursive)
+         *)
+  | Pexp_function of case list
+        (* function P1 -> E1 | ... | Pn -> En *)
+  | Pexp_fun of arg_label * expression option * pattern * expression
+        (* fun P -> E1                          (Simple, None)
+           fun ~l:P -> E1                       (Labelled l, None)
+           fun ?l:P -> E1                       (Optional l, None)
+           fun ?l:(P = E0) -> E1                (Optional l, Some E0)
+
+           Notes:
+           - If E0 is provided, only Optional is allowed.
+           - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun.
+           - "let f P = E" is represented using Pexp_fun.
+         *)
+  | Pexp_apply of expression * (arg_label * expression) list
+        (* E0 ~l1:E1 ... ~ln:En
+           li can be empty (non labeled argument) or start with '?'
+           (optional argument).
+
+           Invariant: n > 0
+         *)
+  | Pexp_match of expression * case list
+        (* match E0 with P1 -> E1 | ... | Pn -> En *)
+  | Pexp_try of expression * case list
+        (* try E0 with P1 -> E1 | ... | Pn -> En *)
+  | Pexp_tuple of expression list
+        (* (E1, ..., En)
+
+           Invariant: n >= 2
+        *)
+  | Pexp_construct of Longident.t loc * expression option
+        (* C                None
+           C E              Some E
+           C (E1, ..., En)  Some (Pexp_tuple[E1;...;En])
+        *)
+  | Pexp_variant of label * expression option
+        (* `A             (None)
+           `A E           (Some E)
+         *)
+  | Pexp_record of (Longident.t loc * expression) list * expression option
+        (* { l1=P1; ...; ln=Pn }     (None)
+           { E0 with l1=P1; ...; ln=Pn }   (Some E0)
+
+           Invariant: n > 0
+         *)
+  | Pexp_field of expression * Longident.t loc
+        (* E.l *)
+  | Pexp_setfield of expression * Longident.t loc * expression
+        (* E1.l <- E2 *)
+  | Pexp_array of expression list
+        (* [| E1; ...; En |] *)
+  | Pexp_ifthenelse of expression * expression * expression option
+        (* if E1 then E2 else E3 *)
+  | Pexp_sequence of expression * expression
+        (* E1; E2 *)
+  | Pexp_while of expression * expression
+        (* while E1 do E2 done *)
+  | Pexp_for of
+      pattern *  expression * expression * direction_flag * expression
+        (* for i = E1 to E2 do E3 done      (flag = Upto)
+           for i = E1 downto E2 do E3 done  (flag = Downto)
+         *)
+  | Pexp_constraint of expression * core_type
+        (* (E : T) *)
+  | Pexp_coerce of expression * core_type option * core_type
+        (* (E :> T)        (None, T)
+           (E : T0 :> T)   (Some T0, T)
+         *)
+  | Pexp_send of expression * label loc
+        (*  E # m *)
+  | Pexp_new of Longident.t loc
+        (* new M.c *)
+  | Pexp_setinstvar of label loc * expression
+        (* x <- 2 *)
+  | Pexp_override of (label loc * expression) list
+        (* {< x1 = E1; ...; Xn = En >} *)
+  | Pexp_letmodule of string option loc * module_expr * expression
+        (* let module M = ME in E *)
+  | Pexp_letexception of extension_constructor * expression
+        (* let exception C in E *)
+  | Pexp_assert of expression
+        (* assert E
+           Note: "assert false" is treated in a special way by the
+           type-checker. *)
+  | Pexp_lazy of expression
+        (* lazy E *)
+  | Pexp_poly of expression * core_type option
+        (* Used for method bodies.
+
+           Can only be used as the expression under Cfk_concrete
+           for methods (not values). *)
+  | Pexp_object of class_structure
+        (* object ... end *)
+  | Pexp_newtype of string loc * expression
+        (* fun (type t) -> E *)
+  | Pexp_pack of module_expr
+        (* (module ME)
+
+           (module ME : S) is represented as
+           Pexp_constraint(Pexp_pack, Ptyp_package S) *)
+  | Pexp_open of open_declaration * expression
+        (* M.(E)
+           let open M in E
+           let! open M in E *)
+  | Pexp_letop of letop
+        (* let* P = E in E
+           let* P = E and* P = E in E *)
+  | Pexp_extension of extension
+        (* [%id] *)
+  | Pexp_unreachable
+        (* . *)
+
+and case =   (* (P -> E) or (P when E0 -> E) *)
+    {
+     pc_lhs: pattern;
+     pc_guard: expression option;
+     pc_rhs: expression;
+   }
+
+and letop =
+  {
+    let_ : binding_op;
+    ands : binding_op list;
+    body : expression;
+  }
+
+and binding_op =
+  {
+    pbop_op : string loc;
+    pbop_pat : pattern;
+    pbop_exp : expression;
+    pbop_loc : Location.t;
+  }
+
+(* Value descriptions *)
+
+and value_description =
+    {
+     pval_name: string loc;
+     pval_type: core_type;
+     pval_prim: string list;
+     pval_attributes: attributes;  (* ... [@@id1] [@@id2] *)
+     pval_loc: Location.t;
+    }
+
+(*
+  val x: T                            (prim = [])
+  external x: T = "s1" ... "sn"       (prim = ["s1";..."sn"])
+*)
+
+(* Type declarations *)
+
+and type_declaration =
+    {
+     ptype_name: string loc;
+     ptype_params: (core_type * variance) list;
+           (* ('a1,...'an) t; None represents  _*)
+     ptype_cstrs: (core_type * core_type * Location.t) list;
+           (* ... constraint T1=T1'  ... constraint Tn=Tn' *)
+     ptype_kind: type_kind;
+     ptype_private: private_flag;   (* = private ... *)
+     ptype_manifest: core_type option;  (* = T *)
+     ptype_attributes: attributes;   (* ... [@@id1] [@@id2] *)
+     ptype_loc: Location.t;
+    }
+
+(*
+  type t                     (abstract, no manifest)
+  type t = T0                (abstract, manifest=T0)
+  type t = C of T | ...      (variant,  no manifest)
+  type t = T0 = C of T | ... (variant,  manifest=T0)
+  type t = {l: T; ...}       (record,   no manifest)
+  type t = T0 = {l : T; ...} (record,   manifest=T0)
+  type t = ..                (open,     no manifest)
+*)
+
+and type_kind =
+  | Ptype_abstract
+  | Ptype_variant of constructor_declaration list
+  | Ptype_record of label_declaration list
+        (* Invariant: non-empty list *)
+  | Ptype_open
+
+and label_declaration =
+    {
+     pld_name: string loc;
+     pld_mutable: mutable_flag;
+     pld_type: core_type;
+     pld_loc: Location.t;
+     pld_attributes: attributes; (* l : T [@id1] [@id2] *)
+    }
+
+(*  { ...; l: T; ... }            (mutable=Immutable)
+    { ...; mutable l: T; ... }    (mutable=Mutable)
+
+    Note: T can be a Ptyp_poly.
+*)
+
+and constructor_declaration =
+    {
+     pcd_name: string loc;
+     pcd_args: constructor_arguments;
+     pcd_res: core_type option;
+     pcd_loc: Location.t;
+     pcd_attributes: attributes; (* C of ... [@id1] [@id2] *)
+    }
+
+and constructor_arguments =
+  | Pcstr_tuple of core_type list
+  | Pcstr_record of label_declaration list
+
+(*
+  | C of T1 * ... * Tn     (res = None,    args = Pcstr_tuple [])
+  | C: T0                  (res = Some T0, args = [])
+  | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple)
+  | C of {...}             (res = None,    args = Pcstr_record)
+  | C: {...} -> T0         (res = Some T0, args = Pcstr_record)
+  | C of {...} as t        (res = None,    args = Pcstr_record)
+*)
+
+and type_extension =
+    {
+     ptyext_path: Longident.t loc;
+     ptyext_params: (core_type * variance) list;
+     ptyext_constructors: extension_constructor list;
+     ptyext_private: private_flag;
+     ptyext_loc: Location.t;
+     ptyext_attributes: attributes;   (* ... [@@id1] [@@id2] *)
+    }
+(*
+  type t += ...
+*)
+
+and extension_constructor =
+    {
+     pext_name: string loc;
+     pext_kind : extension_constructor_kind;
+     pext_loc : Location.t;
+     pext_attributes: attributes; (* C of ... [@id1] [@id2] *)
+   }
+
+(* exception E *)
+and type_exception =
+  {
+    ptyexn_constructor: extension_constructor;
+    ptyexn_loc: Location.t;
+    ptyexn_attributes: attributes; (* ... [@@id1] [@@id2] *)
+  }
+
+and extension_constructor_kind =
+    Pext_decl of constructor_arguments * core_type option
+      (*
+         | C of T1 * ... * Tn     ([T1; ...; Tn], None)
+         | C: T0                  ([], Some T0)
+         | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0)
+       *)
+  | Pext_rebind of Longident.t loc
+      (*
+         | C = D
+       *)
+
+(** {1 Class language} *)
+
+(* Type expressions for the class language *)
+
+and class_type =
+    {
+     pcty_desc: class_type_desc;
+     pcty_loc: Location.t;
+     pcty_attributes: attributes; (* ... [@id1] [@id2] *)
+    }
+
+and class_type_desc =
+  | Pcty_constr of Longident.t loc * core_type list
+        (* c
+           ['a1, ..., 'an] c *)
+  | Pcty_signature of class_signature
+        (* object ... end *)
+  | Pcty_arrow of arg_label * core_type * class_type
+        (* T -> CT       Simple
+           ~l:T -> CT    Labelled l
+           ?l:T -> CT    Optional l
+         *)
+  | Pcty_extension of extension
+        (* [%id] *)
+  | Pcty_open of open_description * class_type
+        (* let open M in CT *)
+
+and class_signature =
+    {
+     pcsig_self: core_type;
+     pcsig_fields: class_type_field list;
+    }
+(* object('selfpat) ... end
+   object ... end             (self = Ptyp_any)
+ *)
+
+and class_type_field =
+    {
+     pctf_desc: class_type_field_desc;
+     pctf_loc: Location.t;
+     pctf_attributes: attributes; (* ... [@@id1] [@@id2] *)
+    }
+
+and class_type_field_desc =
+  | Pctf_inherit of class_type
+        (* inherit CT *)
+  | Pctf_val of (label loc * mutable_flag * virtual_flag * core_type)
+        (* val x: T *)
+  | Pctf_method  of (label loc * private_flag * virtual_flag * core_type)
+        (* method x: T
+
+           Note: T can be a Ptyp_poly.
+         *)
+  | Pctf_constraint  of (core_type * core_type)
+        (* constraint T1 = T2 *)
+  | Pctf_attribute of attribute
+        (* [@@@id] *)
+  | Pctf_extension of extension
+        (* [%%id] *)
+
+and 'a class_infos =
+    {
+     pci_virt: virtual_flag;
+     pci_params: (core_type * variance) list;
+     pci_name: string loc;
+     pci_expr: 'a;
+     pci_loc: Location.t;
+     pci_attributes: attributes;  (* ... [@@id1] [@@id2] *)
+    }
+(* class c = ...
+   class ['a1,...,'an] c = ...
+   class virtual c = ...
+
+   Also used for "class type" declaration.
+*)
+
+and class_description = class_type class_infos
+
+and class_type_declaration = class_type class_infos
+
+(* Value expressions for the class language *)
+
+and class_expr =
+    {
+     pcl_desc: class_expr_desc;
+     pcl_loc: Location.t;
+     pcl_attributes: attributes; (* ... [@id1] [@id2] *)
+    }
+
+and class_expr_desc =
+  | Pcl_constr of Longident.t loc * core_type list
+        (* c
+           ['a1, ..., 'an] c *)
+  | Pcl_structure of class_structure
+        (* object ... end *)
+  | Pcl_fun of arg_label * expression option * pattern * class_expr
+        (* fun P -> CE                          (Simple, None)
+           fun ~l:P -> CE                       (Labelled l, None)
+           fun ?l:P -> CE                       (Optional l, None)
+           fun ?l:(P = E0) -> CE                (Optional l, Some E0)
+         *)
+  | Pcl_apply of class_expr * (arg_label * expression) list
+        (* CE ~l1:E1 ... ~ln:En
+           li can be empty (non labeled argument) or start with '?'
+           (optional argument).
+
+           Invariant: n > 0
+         *)
+  | Pcl_let of rec_flag * value_binding list * class_expr
+        (* let P1 = E1 and ... and Pn = EN in CE      (flag = Nonrecursive)
+           let rec P1 = E1 and ... and Pn = EN in CE  (flag = Recursive)
+         *)
+  | Pcl_constraint of class_expr * class_type
+        (* (CE : CT) *)
+  | Pcl_extension of extension
+  (* [%id] *)
+  | Pcl_open of open_description * class_expr
+  (* let open M in CE *)
+
+
+and class_structure =
+    {
+     pcstr_self: pattern;
+     pcstr_fields: class_field list;
+    }
+(* object(selfpat) ... end
+   object ... end           (self = Ppat_any)
+ *)
+
+and class_field =
+    {
+     pcf_desc: class_field_desc;
+     pcf_loc: Location.t;
+     pcf_attributes: attributes; (* ... [@@id1] [@@id2] *)
+    }
+
+and class_field_desc =
+  | Pcf_inherit of override_flag * class_expr * string loc option
+        (* inherit CE
+           inherit CE as x
+           inherit! CE
+           inherit! CE as x
+         *)
+  | Pcf_val of (label loc * mutable_flag * class_field_kind)
+        (* val x = E
+           val virtual x: T
+         *)
+  | Pcf_method of (label loc * private_flag * class_field_kind)
+        (* method x = E            (E can be a Pexp_poly)
+           method virtual x: T     (T can be a Ptyp_poly)
+         *)
+  | Pcf_constraint of (core_type * core_type)
+        (* constraint T1 = T2 *)
+  | Pcf_initializer of expression
+        (* initializer E *)
+  | Pcf_attribute of attribute
+        (* [@@@id] *)
+  | Pcf_extension of extension
+        (* [%%id] *)
+
+and class_field_kind =
+  | Cfk_virtual of core_type
+  | Cfk_concrete of override_flag * expression
+
+and class_declaration = class_expr class_infos
+
+(** {1 Module language} *)
+
+(* Type expressions for the module language *)
+
+and module_type =
+    {
+     pmty_desc: module_type_desc;
+     pmty_loc: Location.t;
+     pmty_attributes: attributes; (* ... [@id1] [@id2] *)
+    }
+
+and module_type_desc =
+  | Pmty_ident of Longident.t loc
+        (* S *)
+  | Pmty_signature of signature
+        (* sig ... end *)
+  | Pmty_functor of functor_parameter * module_type
+        (* functor(X : MT1) -> MT2 *)
+  | Pmty_with of module_type * with_constraint list
+        (* MT with ... *)
+  | Pmty_typeof of module_expr
+        (* module type of ME *)
+  | Pmty_extension of extension
+        (* [%id] *)
+  | Pmty_alias of Longident.t loc
+        (* (module M) *)
+
+and functor_parameter =
+  | Unit
+        (* () *)
+  | Named of string option loc * module_type
+        (* (X : MT)          Some X, MT
+           (_ : MT)          None, MT *)
+
+and signature = signature_item list
+
+and signature_item =
+    {
+     psig_desc: signature_item_desc;
+     psig_loc: Location.t;
+    }
+
+and signature_item_desc =
+  | Psig_value of value_description
+        (*
+          val x: T
+          external x: T = "s1" ... "sn"
+         *)
+  | Psig_type of rec_flag * type_declaration list
+        (* type t1 = ... and ... and tn  = ... *)
+  | Psig_typesubst of type_declaration list
+        (* type t1 := ... and ... and tn := ...  *)
+  | Psig_typext of type_extension
+        (* type t1 += ... *)
+  | Psig_exception of type_exception
+        (* exception C of T *)
+  | Psig_module of module_declaration
+        (* module X = M
+           module X : MT *)
+  | Psig_modsubst of module_substitution
+        (* module X := M *)
+  | Psig_recmodule of module_declaration list
+        (* module rec X1 : MT1 and ... and Xn : MTn *)
+  | Psig_modtype of module_type_declaration
+        (* module type S = MT
+           module type S *)
+  | Psig_open of open_description
+        (* open X *)
+  | Psig_include of include_description
+        (* include MT *)
+  | Psig_class of class_description list
+        (* class c1 : ... and ... and cn : ... *)
+  | Psig_class_type of class_type_declaration list
+        (* class type ct1 = ... and ... and ctn = ... *)
+  | Psig_attribute of attribute
+        (* [@@@id] *)
+  | Psig_extension of extension * attributes
+        (* [%%id] *)
+
+and module_declaration =
+    {
+     pmd_name: string option loc;
+     pmd_type: module_type;
+     pmd_attributes: attributes; (* ... [@@id1] [@@id2] *)
+     pmd_loc: Location.t;
+    }
+(* S : MT *)
+
+and module_substitution =
+    {
+     pms_name: string loc;
+     pms_manifest: Longident.t loc;
+     pms_attributes: attributes; (* ... [@@id1] [@@id2] *)
+     pms_loc: Location.t;
+    }
+
+and module_type_declaration =
+    {
+     pmtd_name: string loc;
+     pmtd_type: module_type option;
+     pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *)
+     pmtd_loc: Location.t;
+    }
+(* S = MT
+   S       (abstract module type declaration, pmtd_type = None)
+*)
+
+and 'a open_infos =
+    {
+     popen_expr: 'a;
+     popen_override: override_flag;
+     popen_loc: Location.t;
+     popen_attributes: attributes;
+    }
+(* open! X - popen_override = Override (silences the 'used identifier
+                              shadowing' warning)
+   open  X - popen_override = Fresh
+ *)
+
+and open_description = Longident.t loc open_infos
+(* open M.N
+   open M(N).O *)
+
+and open_declaration = module_expr open_infos
+(* open M.N
+   open M(N).O
+   open struct ... end *)
+
+and 'a include_infos =
+    {
+     pincl_mod: 'a;
+     pincl_loc: Location.t;
+     pincl_attributes: attributes;
+    }
+
+and include_description = module_type include_infos
+(* include MT *)
+
+and include_declaration = module_expr include_infos
+(* include ME *)
+
+and with_constraint =
+  | Pwith_type of Longident.t loc * type_declaration
+        (* with type X.t = ...
+
+           Note: the last component of the longident must match
+           the name of the type_declaration. *)
+  | Pwith_module of Longident.t loc * Longident.t loc
+        (* with module X.Y = Z *)
+  | Pwith_typesubst of Longident.t loc * type_declaration
+        (* with type X.t := ..., same format as [Pwith_type] *)
+  | Pwith_modsubst of Longident.t loc * Longident.t loc
+        (* with module X.Y := Z *)
+
+(* Value expressions for the module language *)
+
+and module_expr =
+    {
+     pmod_desc: module_expr_desc;
+     pmod_loc: Location.t;
+     pmod_attributes: attributes; (* ... [@id1] [@id2] *)
+    }
+
+and module_expr_desc =
+  | Pmod_ident of Longident.t loc
+        (* X *)
+  | Pmod_structure of structure
+        (* struct ... end *)
+  | Pmod_functor of functor_parameter * module_expr
+        (* functor(X : MT1) -> ME *)
+  | Pmod_apply of module_expr * module_expr
+        (* ME1(ME2) *)
+  | Pmod_constraint of module_expr * module_type
+        (* (ME : MT) *)
+  | Pmod_unpack of expression
+        (* (val E) *)
+  | Pmod_extension of extension
+        (* [%id] *)
+
+and structure = structure_item list
+
+and structure_item =
+    {
+     pstr_desc: structure_item_desc;
+     pstr_loc: Location.t;
+    }
+
+and structure_item_desc =
+  | Pstr_eval of expression * attributes
+        (* E *)
+  | Pstr_value of rec_flag * value_binding list
+        (* let P1 = E1 and ... and Pn = EN       (flag = Nonrecursive)
+           let rec P1 = E1 and ... and Pn = EN   (flag = Recursive)
+         *)
+  | Pstr_primitive of value_description
+        (*  val x: T
+            external x: T = "s1" ... "sn" *)
+  | Pstr_type of rec_flag * type_declaration list
+        (* type t1 = ... and ... and tn = ... *)
+  | Pstr_typext of type_extension
+        (* type t1 += ... *)
+  | Pstr_exception of type_exception
+        (* exception C of T
+           exception C = M.X *)
+  | Pstr_module of module_binding
+        (* module X = ME *)
+  | Pstr_recmodule of module_binding list
+        (* module rec X1 = ME1 and ... and Xn = MEn *)
+  | Pstr_modtype of module_type_declaration
+        (* module type S = MT *)
+  | Pstr_open of open_declaration
+        (* open X *)
+  | Pstr_class of class_declaration list
+        (* class c1 = ... and ... and cn = ... *)
+  | Pstr_class_type of class_type_declaration list
+        (* class type ct1 = ... and ... and ctn = ... *)
+  | Pstr_include of include_declaration
+        (* include ME *)
+  | Pstr_attribute of attribute
+        (* [@@@id] *)
+  | Pstr_extension of extension * attributes
+        (* [%%id] *)
+
+and value_binding =
+  {
+    pvb_pat: pattern;
+    pvb_expr: expression;
+    pvb_attributes: attributes;
+    pvb_loc: Location.t;
+  }
+
+and module_binding =
+    {
+     pmb_name: string option loc;
+     pmb_expr: module_expr;
+     pmb_attributes: attributes;
+     pmb_loc: Location.t;
+    }
+(* X = ME *)
+
+(** {1 Toplevel} *)
+
+(* Toplevel phrases *)
+
+type toplevel_phrase =
+  | Ptop_def of structure
+  | Ptop_dir of toplevel_directive
+     (* #use, #load ... *)
+
+and toplevel_directive =
+  {
+    pdir_name : string loc;
+    pdir_arg : directive_argument option;
+    pdir_loc : Location.t;
+  }
+
+and directive_argument =
+  {
+    pdira_desc : directive_argument_desc;
+    pdira_loc : Location.t;
+  }
+
+and directive_argument_desc =
+  | Pdir_string of string
+  | Pdir_int of string * char option
+  | Pdir_ident of Longident.t
+  | Pdir_bool of bool
diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
new file mode 100644
index 00000000..d731bdff
--- /dev/null
+++ b/parsing/pprintast.ml
@@ -0,0 +1,1647 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                      Thomas Gazagnaire, OCamlPro                       *)
+(*                   Fabrice Le Fessant, INRIA Saclay                     *)
+(*               Hongbo Zhang, University of Pennsylvania                 *)
+(*                                                                        *)
+(*   Copyright 2007 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Original Code from Ber-metaocaml, modified for 3.12.0 and fixed *)
+(* Printing code expressions *)
+(* Authors:  Ed Pizzi, Fabrice Le Fessant *)
+(* Extensive Rewrite: Hongbo Zhang: University of Pennsylvania *)
+(* TODO more fine-grained precedence pretty-printing *)
+
+open Asttypes
+open Format
+open Location
+open Longident
+open Parsetree
+open Ast_helper
+
+let prefix_symbols  = [ '!'; '?'; '~' ] ;;
+let infix_symbols = [ '='; '<'; '>'; '@'; '^'; '|'; '&'; '+'; '-'; '*'; '/';
+                      '$'; '%'; '#' ]
+
+(* type fixity = Infix| Prefix  *)
+let special_infix_strings =
+  ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; ":="; "!="; "::" ]
+
+let letop s =
+  String.length s > 3
+  && s.[0] = 'l'
+  && s.[1] = 'e'
+  && s.[2] = 't'
+  && List.mem s.[3] infix_symbols
+
+let andop s =
+  String.length s > 3
+  && s.[0] = 'a'
+  && s.[1] = 'n'
+  && s.[2] = 'd'
+  && List.mem s.[3] infix_symbols
+
+(* determines if the string is an infix string.
+   checks backwards, first allowing a renaming postfix ("_102") which
+   may have resulted from Pexp -> Texp -> Pexp translation, then checking
+   if all the characters in the beginning of the string are valid infix
+   characters. *)
+let fixity_of_string  = function
+  | "" -> `Normal
+  | s when List.mem s special_infix_strings -> `Infix s
+  | s when List.mem s.[0] infix_symbols -> `Infix s
+  | s when List.mem s.[0] prefix_symbols -> `Prefix s
+  | s when s.[0] = '.' -> `Mixfix s
+  | s when letop s -> `Letop s
+  | s when andop s -> `Andop s
+  | _ -> `Normal
+
+let view_fixity_of_exp = function
+  | {pexp_desc = Pexp_ident {txt=Lident l;_}; pexp_attributes = []} ->
+      fixity_of_string l
+  | _ -> `Normal
+
+let is_infix  = function `Infix _ -> true | _  -> false
+let is_mixfix = function `Mixfix _ -> true | _ -> false
+let is_kwdop = function `Letop _ | `Andop _ -> true | _ -> false
+
+let first_is c str =
+  str <> "" && str.[0] = c
+let last_is c str =
+  str <> "" && str.[String.length str - 1] = c
+
+let first_is_in cs str =
+  str <> "" && List.mem str.[0] cs
+
+(* 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
+
+(* some infixes need spaces around parens to avoid clashes with comment
+   syntax *)
+let needs_spaces txt =
+  first_is '*' txt || last_is '*' txt
+
+(* add parentheses to binders when they are in fact infix or prefix operators *)
+let protect_ident ppf txt =
+  let format : (_, _, _) format =
+    if not (needs_parens txt) then "%s"
+    else if needs_spaces txt then "(@;%s@;)"
+    else "(%s)"
+  in fprintf ppf format txt
+
+let protect_longident ppf print_longident longprefix txt =
+  let format : (_, _, _) format =
+    if not (needs_parens txt) then "%a.%s"
+    else if needs_spaces txt then  "%a.(@;%s@;)"
+    else "%a.(%s)" in
+  fprintf ppf format print_longident longprefix txt
+
+type space_formatter = (unit, Format.formatter, unit) format
+
+let override = function
+  | Override -> "!"
+  | Fresh -> ""
+
+(* variance encoding: need to sync up with the [parser.mly] *)
+let type_variance = function
+  | Invariant -> ""
+  | Covariant -> "+"
+  | Contravariant -> "-"
+
+type construct =
+  [ `cons of expression list
+  | `list of expression list
+  | `nil
+  | `normal
+  | `simple of Longident.t
+  | `tuple ]
+
+let view_expr x =
+  match x.pexp_desc with
+  | Pexp_construct ( {txt= Lident "()"; _},_) -> `tuple
+  | Pexp_construct ( {txt= Lident "[]";_},_) -> `nil
+  | Pexp_construct ( {txt= Lident"::";_},Some _) ->
+      let rec loop exp acc = match exp with
+          | {pexp_desc=Pexp_construct ({txt=Lident "[]";_},_);
+             pexp_attributes = []} ->
+              (List.rev acc,true)
+          | {pexp_desc=
+             Pexp_construct ({txt=Lident "::";_},
+                             Some ({pexp_desc= Pexp_tuple([e1;e2]);
+                                    pexp_attributes = []}));
+             pexp_attributes = []}
+            ->
+              loop e2 (e1::acc)
+          | e -> (List.rev (e::acc),false) in
+      let (ls,b) = loop x []  in
+      if b then
+        `list ls
+      else `cons ls
+  | Pexp_construct (x,None) -> `simple (x.txt)
+  | _ -> `normal
+
+let is_simple_construct :construct -> bool = function
+  | `nil | `tuple | `list _ | `simple _  -> true
+  | `cons _ | `normal -> false
+
+let pp = fprintf
+
+type ctxt = {
+  pipe : bool;
+  semi : bool;
+  ifthenelse : bool;
+}
+
+let reset_ctxt = { pipe=false; semi=false; ifthenelse=false }
+let under_pipe ctxt = { ctxt with pipe=true }
+let under_semi ctxt = { ctxt with semi=true }
+let under_ifthenelse ctxt = { ctxt with ifthenelse=true }
+(*
+let reset_semi ctxt = { ctxt with semi=false }
+let reset_ifthenelse ctxt = { ctxt with ifthenelse=false }
+let reset_pipe ctxt = { ctxt with pipe=false }
+*)
+
+let list : 'a . ?sep:space_formatter -> ?first:space_formatter ->
+  ?last:space_formatter -> (Format.formatter -> 'a -> unit) ->
+  Format.formatter -> 'a list -> unit
+  = fun ?sep ?first ?last fu f xs ->
+    let first = match first with Some x -> x |None -> ("": _ format6)
+    and last = match last with Some x -> x |None -> ("": _ format6)
+    and sep = match sep with Some x -> x |None -> ("@ ": _ format6) in
+    let aux f = function
+      | [] -> ()
+      | [x] -> fu f x
+      | xs ->
+          let rec loop  f = function
+            | [x] -> fu f x
+            | x::xs ->  fu f x; pp f sep; loop f xs;
+            | _ -> assert false in begin
+            pp f first; loop f xs; pp f last;
+          end in
+    aux f xs
+
+let option : 'a. ?first:space_formatter -> ?last:space_formatter ->
+  (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a option -> unit
+  = fun  ?first  ?last fu f a ->
+    let first = match first with Some x -> x | None -> ("": _ format6)
+    and last = match last with Some x -> x | None -> ("": _ format6) in
+    match a with
+    | None -> ()
+    | Some x -> pp f first; fu f x; pp f last
+
+let paren: 'a . ?first:space_formatter -> ?last:space_formatter ->
+  bool -> (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a -> unit
+  = fun  ?(first=("": _ format6)) ?(last=("": _ format6)) b fu f x ->
+    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 -> protect_ident 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 constant f = function
+  | Pconst_char i ->
+      pp f "%C"  i
+  | Pconst_string (i, _, None) ->
+      pp f "%S" i
+  | Pconst_string (i, _, Some delim) ->
+      pp f "{%s|%s|%s}" delim i delim
+  | Pconst_integer (i, None) ->
+      paren (first_is '-' i) (fun f -> pp f "%s") f i
+  | Pconst_integer (i, Some m) ->
+      paren (first_is '-' i) (fun f (i, m) -> pp f "%s%c" i m) f (i,m)
+  | Pconst_float (i, None) ->
+      paren (first_is '-' i) (fun f -> pp f "%s") f i
+  | Pconst_float (i, Some m) ->
+      paren (first_is '-' i) (fun f (i,m) -> pp f "%s%c" i m) f (i,m)
+
+(* trailing space*)
+let mutable_flag f = function
+  | Immutable -> ()
+  | Mutable -> pp f "mutable@;"
+let virtual_flag f  = function
+  | Concrete -> ()
+  | Virtual -> pp f "virtual@;"
+
+(* trailing space added *)
+let rec_flag f rf =
+  match rf with
+  | Nonrecursive -> ()
+  | Recursive -> pp f "rec "
+let nonrec_flag f rf =
+  match rf with
+  | Nonrecursive -> pp f "nonrec "
+  | Recursive -> ()
+let direction_flag f = function
+  | Upto -> pp f "to@ "
+  | Downto -> pp f "downto@ "
+let private_flag f = function
+  | Public -> ()
+  | Private -> pp f "private@ "
+
+let iter_loc f ctxt {txt; loc = _} = f ctxt txt
+
+let constant_string f s = pp f "%S" s
+
+let tyvar ppf s =
+  if String.length s >= 2 && s.[1] = '\'' then
+    (* without the space, this would be parsed as
+       a character literal *)
+    Format.fprintf ppf "' %s" s
+  else
+    Format.fprintf ppf "'%s" s
+
+let tyvar_loc f str = tyvar f str.txt
+let string_quot f x = pp f "`%s" x
+
+(* c ['a,'b] *)
+let rec class_params_def ctxt f =  function
+  | [] -> ()
+  | l ->
+      pp f "[%a] " (* space *)
+        (list (type_param ctxt) ~sep:",") l
+
+and type_with_label ctxt f (label, c) =
+  match label with
+  | Nolabel    -> core_type1 ctxt f c (* otherwise parenthesize *)
+  | Labelled s -> pp f "%s:%a" s (core_type1 ctxt) c
+  | Optional s -> pp f "?%s:%a" s (core_type1 ctxt) c
+
+and core_type ctxt f x =
+  if x.ptyp_attributes <> [] then begin
+    pp f "((%a)%a)" (core_type ctxt) {x with ptyp_attributes=[]}
+      (attributes ctxt) x.ptyp_attributes
+  end
+  else match x.ptyp_desc with
+    | Ptyp_arrow (l, ct1, ct2) ->
+        pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
+          (type_with_label ctxt) (l,ct1) (core_type ctxt) ct2
+    | Ptyp_alias (ct, s) ->
+        pp f "@[<2>%a@;as@;%a@]" (core_type1 ctxt) ct tyvar s
+    | Ptyp_poly ([], ct) ->
+        core_type ctxt f ct
+    | Ptyp_poly (sl, ct) ->
+        pp f "@[<2>%a%a@]"
+          (fun f l ->
+             pp f "%a"
+               (fun f l -> match l with
+                  | [] -> ()
+                  | _ ->
+                      pp f "%a@;.@;"
+                        (list tyvar_loc ~sep:"@;")  l)
+               l)
+          sl (core_type ctxt) ct
+    | _ -> pp f "@[<2>%a@]" (core_type1 ctxt) x
+
+and core_type1 ctxt f x =
+  if x.ptyp_attributes <> [] then core_type ctxt f x
+  else match x.ptyp_desc with
+    | Ptyp_any -> pp f "_";
+    | Ptyp_var s -> tyvar f  s;
+    | Ptyp_tuple l ->  pp f "(%a)" (list (core_type1 ctxt) ~sep:"@;*@;") l
+    | Ptyp_constr (li, l) ->
+        pp f (* "%a%a@;" *) "%a%a"
+          (fun f l -> match l with
+             |[] -> ()
+             |[x]-> pp f "%a@;" (core_type1 ctxt)  x
+             | _ -> list ~first:"(" ~last:")@;" (core_type ctxt) ~sep:",@;" f l)
+          l longident_loc li
+    | Ptyp_variant (l, closed, low) ->
+        let type_variant_helper f x =
+          match x.prf_desc with
+          | Rtag (l, _, ctl) ->
+              pp f "@[<2>%a%a@;%a@]" (iter_loc string_quot) l
+                (fun f l -> match l with
+                   |[] -> ()
+                   | _ -> pp f "@;of@;%a"
+                            (list (core_type ctxt) ~sep:"&")  ctl) ctl
+                (attributes ctxt) x.prf_attributes
+          | Rinherit ct -> core_type ctxt f ct in
+        pp f "@[<2>[%a%a]@]"
+          (fun f l ->
+             match l, closed with
+             | [], Closed -> ()
+             | [], Open -> pp f ">" (* Cf #7200: print [>] correctly *)
+             | _ ->
+                 pp f "%s@;%a"
+                   (match (closed,low) with
+                    | (Closed,None) -> ""
+                    | (Closed,Some _) -> "<" (* FIXME desugar the syntax sugar*)
+                    | (Open,_) -> ">")
+                   (list type_variant_helper ~sep:"@;<1 -2>| ") l) l
+          (fun f low -> match low with
+             |Some [] |None -> ()
+             |Some xs ->
+                 pp f ">@ %a"
+                   (list string_quot) xs) low
+    | Ptyp_object (l, o) ->
+        let core_field_type f x = match x.pof_desc with
+          | Otag (l, ct) ->
+            (* Cf #7200 *)
+            pp f "@[<hov2>%s: %a@ %a@ @]" l.txt
+              (core_type ctxt) ct (attributes ctxt) x.pof_attributes
+          | Oinherit ct ->
+            pp f "@[<hov2>%a@ @]" (core_type ctxt) ct
+        in
+        let field_var f = function
+          | Asttypes.Closed -> ()
+          | Asttypes.Open ->
+              match l with
+              | [] -> pp f ".."
+              | _ -> pp f " ;.."
+        in
+        pp f "@[<hov2><@ %a%a@ > @]"
+          (list core_field_type ~sep:";") l
+          field_var o (* Cf #7200 *)
+    | Ptyp_class (li, l) ->   (*FIXME*)
+        pp f "@[<hov2>%a#%a@]"
+          (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")") l
+          longident_loc li
+    | Ptyp_package (lid, cstrs) ->
+        let aux f (s, ct) =
+          pp f "type %a@ =@ %a" longident_loc s (core_type ctxt) ct  in
+        (match cstrs with
+         |[] -> pp f "@[<hov2>(module@ %a)@]" longident_loc lid
+         |_ ->
+             pp f "@[<hov2>(module@ %a@ with@ %a)@]" longident_loc lid
+               (list aux  ~sep:"@ and@ ")  cstrs)
+    | Ptyp_extension e -> extension ctxt f e
+    | _ -> paren true (core_type ctxt) f x
+
+(********************pattern********************)
+(* be cautious when use [pattern], [pattern1] is preferred *)
+and pattern ctxt f x =
+  let rec list_of_pattern acc = function (* only consider ((A|B)|C)*)
+    | {ppat_desc= Ppat_or (p1,p2); ppat_attributes = []} ->
+        list_of_pattern  (p2::acc) p1
+    | x -> x::acc
+  in
+  if x.ppat_attributes <> [] then begin
+    pp f "((%a)%a)" (pattern ctxt) {x with ppat_attributes=[]}
+      (attributes ctxt) x.ppat_attributes
+  end
+  else match x.ppat_desc with
+    | Ppat_alias (p, s) ->
+        pp f "@[<2>%a@;as@;%a@]" (pattern ctxt) p protect_ident s.txt (* RA*)
+    | Ppat_or _ -> (* *)
+        pp f "@[<hov0>%a@]" (list ~sep:"@,|" (pattern ctxt))
+          (list_of_pattern [] x)
+    | _ -> pattern1 ctxt f x
+
+and pattern1 ctxt (f:Format.formatter) (x:pattern) : unit =
+  let rec pattern_list_helper f = function
+    | {ppat_desc =
+         Ppat_construct
+           ({ txt = Lident("::") ;_},
+            Some ({ppat_desc = Ppat_tuple([pat1; pat2]);_}));
+       ppat_attributes = []}
+
+      ->
+        pp f "%a::%a" (simple_pattern ctxt) pat1 pattern_list_helper pat2 (*RA*)
+    | p -> pattern1 ctxt f p
+  in
+  if x.ppat_attributes <> [] then pattern ctxt f x
+  else match x.ppat_desc with
+    | Ppat_variant (l, Some p) ->
+        pp f "@[<2>`%s@;%a@]" l (simple_pattern ctxt) p
+    | Ppat_construct (({txt=Lident("()"|"[]");_}), _) -> simple_pattern ctxt f x
+    | Ppat_construct (({txt;_} as li), po) ->
+        (* FIXME The third field always false *)
+        if txt = Lident "::" then
+          pp f "%a" pattern_list_helper x
+        else
+          (match po with
+           | Some x -> pp f "%a@;%a"  longident_loc li (simple_pattern ctxt) x
+           | None -> pp f "%a" longident_loc li)
+    | _ -> simple_pattern ctxt f x
+
+and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
+  if x.ppat_attributes <> [] then pattern ctxt f x
+  else match x.ppat_desc with
+    | Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), _) -> pp f  "%s" x
+    | Ppat_any -> pp f "_";
+    | Ppat_var ({txt = txt;_}) -> protect_ident f txt
+    | Ppat_array l ->
+        pp f "@[<2>[|%a|]@]"  (list (pattern1 ctxt) ~sep:";") l
+    | Ppat_unpack { txt = None } ->
+        pp f "(module@ _)@ "
+    | Ppat_unpack { txt = Some s } ->
+        pp f "(module@ %s)@ " s
+    | Ppat_type li ->
+        pp f "#%a" longident_loc li
+    | Ppat_record (l, closed) ->
+        let longident_x_pattern f (li, p) =
+          match (li,p) with
+          | ({txt=Lident s;_ },
+             {ppat_desc=Ppat_var {txt;_};
+              ppat_attributes=[]; _})
+            when s = txt ->
+              pp f "@[<2>%a@]"  longident_loc li
+          | _ ->
+              pp f "@[<2>%a@;=@;%a@]" longident_loc li (pattern1 ctxt) p
+        in
+        begin match closed with
+        | Closed ->
+            pp f "@[<2>{@;%a@;}@]" (list longident_x_pattern ~sep:";@;") l
+        | _ ->
+            pp f "@[<2>{@;%a;_}@]" (list longident_x_pattern ~sep:";@;") l
+        end
+    | Ppat_tuple l ->
+        pp f "@[<1>(%a)@]" (list  ~sep:",@;" (pattern1 ctxt))  l (* level1*)
+    | Ppat_constant (c) -> pp f "%a" constant c
+    | Ppat_interval (c1, c2) -> pp f "%a..%a" constant c1 constant c2
+    | Ppat_variant (l,None) ->  pp f "`%s" l
+    | Ppat_constraint (p, ct) ->
+        pp f "@[<2>(%a@;:@;%a)@]" (pattern1 ctxt) p (core_type ctxt) ct
+    | Ppat_lazy p ->
+        pp f "@[<2>(lazy@;%a)@]" (simple_pattern ctxt) p
+    | Ppat_exception p ->
+        pp f "@[<2>exception@;%a@]" (pattern1 ctxt) p
+    | Ppat_extension e -> extension ctxt f e
+    | Ppat_open (lid, p) ->
+        let with_paren =
+        match p.ppat_desc with
+        | Ppat_array _ | Ppat_record _
+        | Ppat_construct (({txt=Lident ("()"|"[]");_}), _) -> false
+        | _ -> true in
+        pp f "@[<2>%a.%a @]" longident_loc lid
+          (paren with_paren @@ pattern1 ctxt) p
+    | _ -> paren true (pattern ctxt) f x
+
+and label_exp ctxt f (l,opt,p) =
+  match l with
+  | Nolabel ->
+      (* single case pattern parens needed here *)
+      pp f "%a@ " (simple_pattern ctxt) p
+  | Optional rest ->
+      begin match p with
+      | {ppat_desc = Ppat_var {txt;_}; ppat_attributes = []}
+        when txt = rest ->
+          (match opt with
+           | Some o -> pp f "?(%s=@;%a)@;" rest  (expression ctxt) o
+           | None -> pp f "?%s@ " rest)
+      | _ ->
+          (match opt with
+           | Some o ->
+               pp f "?%s:(%a=@;%a)@;"
+                 rest (pattern1 ctxt) p (expression ctxt) o
+           | None -> pp f "?%s:%a@;" rest (simple_pattern ctxt) p)
+      end
+  | Labelled l -> match p with
+    | {ppat_desc  = Ppat_var {txt;_}; ppat_attributes = []}
+      when txt = l ->
+        pp f "~%s@;" l
+    | _ ->  pp f "~%s:%a@;" l (simple_pattern ctxt) p
+
+and sugar_expr ctxt f e =
+  if e.pexp_attributes <> [] then false
+  else match e.pexp_desc with
+  | Pexp_apply ({ pexp_desc = Pexp_ident {txt = id; _};
+                  pexp_attributes=[]; _}, args)
+    when List.for_all (fun (lab, _) -> lab = Nolabel) args -> begin
+      let print_indexop a path_prefix assign left sep right print_index indices
+          rem_args =
+        let print_path ppf = function
+          | None -> ()
+          | Some m -> pp ppf ".%a" longident m in
+        match assign, rem_args with
+            | false, [] ->
+              pp f "@[%a%a%s%a%s@]"
+                (simple_expr ctxt) a print_path path_prefix
+                left (list ~sep print_index) indices right; true
+            | true, [v] ->
+              pp f "@[%a%a%s%a%s@ <-@;<1 2>%a@]"
+                (simple_expr ctxt) a print_path path_prefix
+                left (list ~sep print_index) indices right
+                (simple_expr ctxt) v; true
+            | _ -> false in
+      match id, List.map snd args with
+      | Lident "!", [e] ->
+        pp f "@[<hov>!%a@]" (simple_expr ctxt) e; true
+      | Ldot (path, ("get"|"set" as func)), a :: other_args -> begin
+          let assign = func = "set" in
+          let print = print_indexop a None assign in
+          match path, other_args with
+          | Lident "Array", i :: rest ->
+            print ".(" "" ")" (expression ctxt) [i] rest
+          | Lident "String", i :: rest ->
+            print ".[" "" "]" (expression ctxt) [i] rest
+          | Ldot (Lident "Bigarray", "Array1"), i1 :: rest ->
+            print ".{" "," "}" (simple_expr ctxt) [i1] rest
+          | Ldot (Lident "Bigarray", "Array2"), i1 :: i2 :: rest ->
+            print ".{" "," "}" (simple_expr ctxt) [i1; i2] rest
+          | Ldot (Lident "Bigarray", "Array3"), i1 :: i2 :: i3 :: rest ->
+            print ".{" "," "}" (simple_expr ctxt) [i1; i2; i3] rest
+          | Ldot (Lident "Bigarray", "Genarray"),
+            {pexp_desc = Pexp_array indexes; pexp_attributes = []} :: rest ->
+              print ".{" "," "}" (simple_expr ctxt) indexes rest
+          | _ -> false
+        end
+      | (Lident s | Ldot(_,s)) , a :: i :: rest
+        when first_is '.' s ->
+          (* extract operator:
+             assignment operators end with [right_bracket ^ "<-"],
+             access operators end with [right_bracket] directly
+          *)
+          let multi_indices = String.contains s ';' in
+          let i =
+              match i.pexp_desc with
+                | Pexp_array l when multi_indices -> l
+                | _ -> [ i ] in
+          let assign = last_is '-' s in
+          let kind =
+            (* extract the right end bracket *)
+            let n = String.length s in
+            if assign then s.[n - 3] else s.[n - 1] in
+          let left, right = match kind with
+            | ')' -> '(', ")"
+            | ']' -> '[', "]"
+            | '}' -> '{', "}"
+            | _ -> assert false in
+          let path_prefix = match id with
+            | Ldot(m,_) -> Some m
+            | _ -> None in
+          let left = String.sub s 0 (1+String.index s left) in
+          print_indexop a path_prefix assign left ";" right
+            (if multi_indices then expression ctxt else simple_expr ctxt)
+            i rest
+      | _ -> false
+    end
+  | _ -> false
+
+and expression ctxt f x =
+  if x.pexp_attributes <> [] then
+    pp f "((%a)@,%a)" (expression ctxt) {x with pexp_attributes=[]}
+      (attributes ctxt) x.pexp_attributes
+  else match x.pexp_desc with
+    | Pexp_function _ | Pexp_fun _ | Pexp_match _ | Pexp_try _ | Pexp_sequence _
+    | Pexp_newtype _
+      when ctxt.pipe || ctxt.semi ->
+        paren true (expression reset_ctxt) f x
+    | Pexp_ifthenelse _ | Pexp_sequence _ when ctxt.ifthenelse ->
+        paren true (expression reset_ctxt) f x
+    | Pexp_let _ | Pexp_letmodule _ | Pexp_open _
+      | Pexp_letexception _ | Pexp_letop _
+        when ctxt.semi ->
+        paren true (expression reset_ctxt) f x
+    | Pexp_fun (l, e0, p, e) ->
+        pp f "@[<2>fun@;%a->@;%a@]"
+          (label_exp ctxt) (l, e0, p)
+          (expression ctxt) e
+    | Pexp_newtype (lid, e) ->
+        pp f "@[<2>fun@;(type@;%s)@;->@;%a@]" lid.txt
+          (expression ctxt) e
+    | Pexp_function l ->
+        pp f "@[<hv>function%a@]" (case_list ctxt) l
+    | Pexp_match (e, l) ->
+        pp f "@[<hv0>@[<hv0>@[<2>match %a@]@ with@]%a@]"
+          (expression reset_ctxt) e (case_list ctxt) l
+
+    | Pexp_try (e, l) ->
+        pp f "@[<0>@[<hv2>try@ %a@]@ @[<0>with%a@]@]"
+             (* "try@;@[<2>%a@]@\nwith@\n%a"*)
+          (expression reset_ctxt) e  (case_list ctxt) l
+    | Pexp_let (rf, l, e) ->
+        (* pp f "@[<2>let %a%a in@;<1 -2>%a@]"
+           (*no indentation here, a new line*) *)
+        (*   rec_flag rf *)
+        pp f "@[<2>%a in@;<1 -2>%a@]"
+          (bindings reset_ctxt) (rf,l)
+          (expression ctxt) e
+    | Pexp_apply (e, l) ->
+        begin if not (sugar_expr ctxt f x) then
+            match view_fixity_of_exp e with
+            | `Infix s ->
+                begin match l with
+                | [ (Nolabel, _) as arg1; (Nolabel, _) as arg2 ] ->
+                    (* FIXME associativity label_x_expression_param *)
+                    pp f "@[<2>%a@;%s@;%a@]"
+                      (label_x_expression_param reset_ctxt) arg1 s
+                      (label_x_expression_param ctxt) arg2
+                | _ ->
+                    pp f "@[<2>%a %a@]"
+                      (simple_expr ctxt) e
+                      (list (label_x_expression_param ctxt)) l
+                end
+            | `Prefix s ->
+                let s =
+                  if List.mem s ["~+";"~-";"~+.";"~-."] &&
+                   (match l with
+                    (* See #7200: avoid turning (~- 1) into (- 1) which is
+                       parsed as an int literal *)
+                    |[(_,{pexp_desc=Pexp_constant _})] -> false
+                    | _ -> true)
+                  then String.sub s 1 (String.length s -1)
+                  else s in
+                begin match l with
+                | [(Nolabel, x)] ->
+                  pp f "@[<2>%s@;%a@]" s (simple_expr ctxt) x
+                | _   ->
+                  pp f "@[<2>%a %a@]" (simple_expr ctxt) e
+                    (list (label_x_expression_param ctxt)) l
+                end
+            | _ ->
+                pp f "@[<hov2>%a@]" begin fun f (e,l) ->
+                  pp f "%a@ %a" (expression2 ctxt) e
+                    (list (label_x_expression_param reset_ctxt))  l
+                    (* reset here only because [function,match,try,sequence]
+                       are lower priority *)
+                end (e,l)
+        end
+
+    | Pexp_construct (li, Some eo)
+      when not (is_simple_construct (view_expr x))-> (* Not efficient FIXME*)
+        (match view_expr x with
+         | `cons ls -> list (simple_expr ctxt) f ls ~sep:"@;::@;"
+         | `normal ->
+             pp f "@[<2>%a@;%a@]" longident_loc 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
+    | Pexp_ifthenelse (e1, e2, eo) ->
+        (* @;@[<2>else@ %a@]@] *)
+        let fmt:(_,_,_)format ="@[<hv0>@[<2>if@ %a@]@;@[<2>then@ %a@]%a@]" in
+        let expression_under_ifthenelse = expression (under_ifthenelse ctxt) in
+        pp f fmt expression_under_ifthenelse e1 expression_under_ifthenelse e2
+          (fun f eo -> match eo with
+             | Some x ->
+                 pp f "@;@[<2>else@;%a@]" (expression (under_semi ctxt)) x
+             | None -> () (* pp f "()" *)) eo
+    | Pexp_sequence _ ->
+        let rec sequence_helper acc = function
+          | {pexp_desc=Pexp_sequence(e1,e2); pexp_attributes = []} ->
+              sequence_helper (e1::acc) e2
+          | v -> List.rev (v::acc) in
+        let lst = sequence_helper [] x in
+        pp f "@[<hv>%a@]"
+          (list (expression (under_semi ctxt)) ~sep:";@;") lst
+    | Pexp_new (li) ->
+        pp f "@[<hov2>new@ %a@]" longident_loc li;
+    | Pexp_setinstvar (s, e) ->
+        pp f "@[<hov2>%s@ <-@ %a@]" s.txt (expression ctxt) e
+    | Pexp_override l -> (* FIXME *)
+        let string_x_expression f (s, e) =
+          pp f "@[<hov2>%s@ =@ %a@]" s.txt (expression ctxt) e in
+        pp f "@[<hov2>{<%a>}@]"
+          (list string_x_expression  ~sep:";"  )  l;
+    | Pexp_letmodule (s, me, e) ->
+        pp f "@[<hov2>let@ module@ %s@ =@ %a@ in@ %a@]"
+          (Option.value s.txt ~default:"_")
+          (module_expr reset_ctxt) me (expression ctxt) e
+    | Pexp_letexception (cd, e) ->
+        pp f "@[<hov2>let@ exception@ %a@ in@ %a@]"
+          (extension_constructor ctxt) cd
+          (expression ctxt) e
+    | Pexp_assert e ->
+        pp f "@[<hov2>assert@ %a@]" (simple_expr ctxt) e
+    | Pexp_lazy (e) ->
+        pp f "@[<hov2>lazy@ %a@]" (simple_expr ctxt) e
+    (* Pexp_poly: impossible but we should print it anyway, rather than
+       assert false *)
+    | Pexp_poly (e, None) ->
+        pp f "@[<hov2>!poly!@ %a@]" (simple_expr ctxt) e
+    | Pexp_poly (e, Some ct) ->
+        pp f "@[<hov2>(!poly!@ %a@ : %a)@]"
+          (simple_expr ctxt) e (core_type ctxt) ct
+    | Pexp_open (o, e) ->
+        pp f "@[<2>let open%s %a in@;%a@]"
+          (override o.popen_override) (module_expr ctxt) o.popen_expr
+          (expression ctxt) e
+    | Pexp_variant (l,Some eo) ->
+        pp f "@[<2>`%s@;%a@]" l (simple_expr ctxt) eo
+    | Pexp_letop {let_; ands; body} ->
+        pp f "@[<2>@[<v>%a@,%a@] in@;<1 -2>%a@]"
+          (binding_op ctxt) let_
+          (list ~sep:"@," (binding_op ctxt)) ands
+          (expression ctxt) body
+    | Pexp_extension e -> extension ctxt f e
+    | Pexp_unreachable -> pp f "."
+    | _ -> expression1 ctxt f x
+
+and expression1 ctxt f x =
+  if x.pexp_attributes <> [] then expression ctxt f x
+  else match x.pexp_desc with
+    | Pexp_object cs -> pp f "%a" (class_structure ctxt) cs
+    | _ -> expression2 ctxt f x
+(* used in [Pexp_apply] *)
+
+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
+    | Pexp_send (e, s) -> pp f "@[<hov2>%a#%s@]" (simple_expr ctxt) e s.txt
+
+    | _ -> simple_expr ctxt f x
+
+and simple_expr ctxt f x =
+  if x.pexp_attributes <> [] then expression ctxt f x
+  else match x.pexp_desc with
+    | Pexp_construct _  when is_simple_construct (view_expr x) ->
+        (match view_expr x with
+         | `nil -> pp f "[]"
+         | `tuple -> pp f "()"
+         | `list xs ->
+             pp f "@[<hv0>[%a]@]"
+               (list (expression (under_semi ctxt)) ~sep:";@;") xs
+         | `simple x -> longident f x
+         | _ -> assert false)
+    | Pexp_ident li ->
+        longident_loc f li
+    (* (match view_fixity_of_exp x with *)
+    (* |`Normal -> longident_loc f li *)
+    (* | `Prefix _ | `Infix _ -> pp f "( %a )" longident_loc li) *)
+    | Pexp_constant c -> constant f c;
+    | Pexp_pack me ->
+        pp f "(module@;%a)" (module_expr ctxt) me
+    | Pexp_tuple l ->
+        pp f "@[<hov2>(%a)@]" (list (simple_expr ctxt) ~sep:",@;") l
+    | Pexp_constraint (e, ct) ->
+        pp f "(%a : %a)" (expression ctxt) e (core_type ctxt) ct
+    | Pexp_coerce (e, cto1, ct) ->
+        pp f "(%a%a :> %a)" (expression ctxt) e
+          (option (core_type ctxt) ~first:" : " ~last:" ") cto1 (* no sep hint*)
+          (core_type ctxt) ct
+    | Pexp_variant (l, None) -> pp f "`%s" l
+    | Pexp_record (l, eo) ->
+        let longident_x_expression f ( li, e) =
+          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@;=@;%a@]" longident_loc li (simple_expr ctxt) e
+        in
+        pp f "@[<hv0>@[<hv2>{@;%a%a@]@;}@]"(* "@[<hov2>{%a%a}@]" *)
+          (option ~last:" with@;" (simple_expr ctxt)) eo
+          (list longident_x_expression ~sep:";@;") l
+    | Pexp_array (l) ->
+        pp f "@[<0>@[<2>[|%a|]@]@]"
+          (list (simple_expr (under_semi ctxt)) ~sep:";") l
+    | Pexp_while (e1, e2) ->
+        let fmt : (_,_,_) format = "@[<2>while@;%a@;do@;%a@;done@]" in
+        pp f fmt (expression ctxt) e1 (expression ctxt) e2
+    | Pexp_for (s, e1, e2, df, e3) ->
+        let fmt:(_,_,_)format =
+          "@[<hv0>@[<hv2>@[<2>for %a =@;%a@;%a%a@;do@]@;%a@]@;done@]" in
+        let expression = expression ctxt in
+        pp f fmt (pattern ctxt) s expression e1 direction_flag
+          df expression e2 expression e3
+    | _ ->  paren true (expression ctxt) f x
+
+and attributes ctxt f l =
+  List.iter (attribute ctxt f) l
+
+and item_attributes ctxt f l =
+  List.iter (item_attribute ctxt f) l
+
+and attribute ctxt f a =
+  pp f "@[<2>[@@%s@ %a]@]" a.attr_name.txt (payload ctxt) a.attr_payload
+
+and item_attribute ctxt f a =
+  pp f "@[<2>[@@@@%s@ %a]@]" a.attr_name.txt (payload ctxt) a.attr_payload
+
+and floating_attribute ctxt f a =
+  pp f "@[<2>[@@@@@@%s@ %a]@]" a.attr_name.txt (payload ctxt) a.attr_payload
+
+and value_description ctxt f x =
+  (* note: value_description has an attribute field,
+           but they're already printed by the callers this method *)
+  pp f "@[<hov2>%a%a@]" (core_type ctxt) x.pval_type
+    (fun f x ->
+       if x.pval_prim <> []
+       then pp f "@ =@ %a" (list constant_string) x.pval_prim
+    ) x
+
+and extension ctxt f (s, e) =
+  pp f "@[<2>[%%%s@ %a]@]" s.txt (payload ctxt) e
+
+and item_extension ctxt f (s, e) =
+  pp f "@[<2>[%%%%%s@ %a]@]" s.txt (payload ctxt) e
+
+and exception_declaration ctxt f x =
+  pp f "@[<hov2>exception@ %a@]%a"
+    (extension_constructor ctxt) x.ptyexn_constructor
+    (item_attributes ctxt) x.ptyexn_attributes
+
+and class_signature ctxt f { pcsig_self = ct; pcsig_fields = l ;_} =
+  let class_type_field f x =
+    match x.pctf_desc with
+    | Pctf_inherit (ct) ->
+        pp f "@[<2>inherit@ %a@]%a" (class_type ctxt) ct
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_val (s, mf, vf, ct) ->
+        pp f "@[<2>val @ %a%a%s@ :@ %a@]%a"
+          mutable_flag mf virtual_flag vf s.txt (core_type ctxt) ct
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_method (s, pf, vf, ct) ->
+        pp f "@[<2>method %a %a%s :@;%a@]%a"
+          private_flag pf virtual_flag vf s.txt (core_type ctxt) ct
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_constraint (ct1, ct2) ->
+        pp f "@[<2>constraint@ %a@ =@ %a@]%a"
+          (core_type ctxt) ct1 (core_type ctxt) ct2
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_attribute a -> floating_attribute ctxt f a
+    | Pctf_extension e ->
+        item_extension ctxt f e;
+        item_attributes ctxt f x.pctf_attributes
+  in
+  pp f "@[<hv0>@[<hv2>object@[<1>%a@]@ %a@]@ end@]"
+    (fun f -> function
+         {ptyp_desc=Ptyp_any; ptyp_attributes=[]; _} -> ()
+       | ct -> pp f " (%a)" (core_type ctxt) ct) ct
+    (list class_type_field ~sep:"@;") l
+
+(* call [class_signature] called by [class_signature] *)
+and class_type ctxt f x =
+  match x.pcty_desc with
+  | Pcty_signature cs ->
+      class_signature ctxt f cs;
+      attributes ctxt f x.pcty_attributes
+  | Pcty_constr (li, l) ->
+      pp f "%a%a%a"
+        (fun f l -> match l with
+           | [] -> ()
+           | _  -> pp f "[%a]@ " (list (core_type ctxt) ~sep:"," ) l) l
+        longident_loc li
+        (attributes ctxt) x.pcty_attributes
+  | Pcty_arrow (l, co, cl) ->
+      pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
+        (type_with_label ctxt) (l,co)
+        (class_type ctxt) cl
+  | Pcty_extension e ->
+      extension ctxt f e;
+      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
+        (class_type ctxt) e
+
+(* [class type a = object end] *)
+and class_type_declaration_list ctxt f l =
+  let class_type_declaration kwd f x =
+    let { pci_params=ls; pci_name={ txt; _ }; _ } = x in
+    pp f "@[<2>%s %a%a%s@ =@ %a@]%a" kwd
+      virtual_flag x.pci_virt
+      (class_params_def ctxt) ls txt
+      (class_type ctxt) x.pci_expr
+      (item_attributes ctxt) x.pci_attributes
+  in
+  match l with
+  | [] -> ()
+  | [x] -> class_type_declaration "class type" f x
+  | x :: xs ->
+      pp f "@[<v>%a@,%a@]"
+        (class_type_declaration "class type") x
+        (list ~sep:"@," (class_type_declaration "and")) xs
+
+and class_field ctxt f x =
+  match x.pcf_desc with
+  | Pcf_inherit (ovf, ce, so) ->
+      pp f "@[<2>inherit@ %s@ %a%a@]%a" (override ovf)
+        (class_expr ctxt) ce
+        (fun f so -> match so with
+           | None -> ();
+           | Some (s) -> pp f "@ as %s" s.txt ) so
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_val (s, mf, Cfk_concrete (ovf, e)) ->
+      pp f "@[<2>val%s %a%s =@;%a@]%a" (override ovf)
+        mutable_flag mf s.txt
+        (expression ctxt) e
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_method (s, pf, Cfk_virtual ct) ->
+      pp f "@[<2>method virtual %a %s :@;%a@]%a"
+        private_flag pf s.txt
+        (core_type ctxt) ct
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_val (s, mf, Cfk_virtual ct) ->
+      pp f "@[<2>val virtual %a%s :@ %a@]%a"
+        mutable_flag mf s.txt
+        (core_type ctxt) ct
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_method (s, pf, Cfk_concrete (ovf, e)) ->
+      let bind e =
+        binding ctxt f
+          {pvb_pat=
+             {ppat_desc=Ppat_var s;
+              ppat_loc=Location.none;
+              ppat_loc_stack=[];
+              ppat_attributes=[]};
+           pvb_expr=e;
+           pvb_attributes=[];
+           pvb_loc=Location.none;
+          }
+      in
+      pp f "@[<2>method%s %a%a@]%a"
+        (override ovf)
+        private_flag pf
+        (fun f -> function
+           | {pexp_desc=Pexp_poly (e, Some ct); pexp_attributes=[]; _} ->
+               pp f "%s :@;%a=@;%a"
+                 s.txt (core_type ctxt) ct (expression ctxt) e
+           | {pexp_desc=Pexp_poly (e, None); pexp_attributes=[]; _} ->
+               bind e
+           | _ -> bind e) e
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_constraint (ct1, ct2) ->
+      pp f "@[<2>constraint %a =@;%a@]%a"
+        (core_type ctxt) ct1
+        (core_type ctxt) ct2
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_initializer (e) ->
+      pp f "@[<2>initializer@ %a@]%a"
+        (expression ctxt) e
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_attribute a -> floating_attribute ctxt f a
+  | Pcf_extension e ->
+      item_extension ctxt f e;
+      item_attributes ctxt f x.pcf_attributes
+
+and class_structure ctxt f { pcstr_self = p; pcstr_fields =  l } =
+  pp f "@[<hv0>@[<hv2>object%a@;%a@]@;end@]"
+    (fun f p -> match p.ppat_desc with
+       | Ppat_any -> ()
+       | Ppat_constraint _ -> pp f " %a" (pattern ctxt) p
+       | _ -> pp f " (%a)" (pattern ctxt) p) p
+    (list (class_field ctxt)) l
+
+and class_expr ctxt f x =
+  if x.pcl_attributes <> [] then begin
+    pp f "((%a)%a)" (class_expr ctxt) {x with pcl_attributes=[]}
+      (attributes ctxt) x.pcl_attributes
+  end else
+    match x.pcl_desc with
+    | Pcl_structure (cs) -> class_structure ctxt f cs
+    | Pcl_fun (l, eo, p, e) ->
+        pp f "fun@ %a@ ->@ %a"
+          (label_exp ctxt) (l,eo,p)
+          (class_expr ctxt) e
+    | Pcl_let (rf, l, ce) ->
+        pp f "%a@ in@ %a"
+          (bindings ctxt) (rf,l)
+          (class_expr ctxt) ce
+    | Pcl_apply (ce, l) ->
+        pp f "((%a)@ %a)" (* Cf: #7200 *)
+          (class_expr ctxt) ce
+          (list (label_x_expression_param ctxt)) l
+    | Pcl_constr (li, l) ->
+        pp f "%a%a"
+          (fun f l-> if l <>[] then
+              pp f "[%a]@ "
+                (list (core_type ctxt) ~sep:",") l) l
+          longident_loc li
+    | Pcl_constraint (ce, ct) ->
+        pp f "(%a@ :@ %a)"
+          (class_expr ctxt) ce
+          (class_type ctxt) ct
+    | 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
+          (class_expr ctxt) e
+
+and module_type ctxt f x =
+  if x.pmty_attributes <> [] then begin
+    pp f "((%a)%a)" (module_type ctxt) {x with pmty_attributes=[]}
+      (attributes ctxt) x.pmty_attributes
+  end else
+    match x.pmty_desc with
+    | Pmty_functor (Unit, mt2) ->
+        pp f "@[<hov2>functor () ->@ %a@]" (module_type ctxt) mt2
+    | Pmty_functor (Named (s, mt1), mt2) ->
+        begin match s.txt with
+        | None ->
+            pp f "@[<hov2>%a@ ->@ %a@]"
+              (module_type1 ctxt) mt1 (module_type ctxt) mt2
+        | Some name ->
+            pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" name
+              (module_type ctxt) mt1 (module_type ctxt) mt2
+        end
+    | Pmty_with (mt, []) -> module_type ctxt f mt
+    | Pmty_with (mt, l) ->
+        let with_constraint f = function
+          | Pwith_type (li, ({ptype_params= ls ;_} as td)) ->
+              let ls = List.map fst ls in
+              pp f "type@ %a %a =@ %a"
+                (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
+                ls longident_loc li (type_declaration ctxt) td
+          | Pwith_module (li, li2) ->
+              pp f "module %a =@ %a" longident_loc li longident_loc li2;
+          | Pwith_typesubst (li, ({ptype_params=ls;_} as td)) ->
+              let ls = List.map fst ls in
+              pp f "type@ %a %a :=@ %a"
+                (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
+                ls longident_loc li
+                (type_declaration ctxt) td
+          | Pwith_modsubst (li, li2) ->
+             pp f "module %a :=@ %a" longident_loc li longident_loc li2 in
+        pp f "@[<hov2>%a@ with@ %a@]"
+          (module_type1 ctxt) mt (list with_constraint ~sep:"@ and@ ") l
+    | _ -> module_type1 ctxt f x
+
+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;
+    | Pmty_alias li ->
+        pp f "(module %a)" longident_loc li;
+    | Pmty_signature (s) ->
+        pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" (* "@[<hov>sig@ %a@ end@]" *)
+          (list (signature_item ctxt)) s (* FIXME wrong indentation*)
+    | Pmty_typeof me ->
+        pp f "@[<hov2>module@ type@ of@ %a@]" (module_expr ctxt) me
+    | Pmty_extension e -> extension ctxt f e
+    | _ -> paren true (module_type ctxt) f x
+
+and signature ctxt f x =  list ~sep:"@\n" (signature_item ctxt) f x
+
+and signature_item ctxt f x : unit =
+  match x.psig_desc with
+  | Psig_type (rf, l) ->
+      type_def_list ctxt f (rf, true, l)
+  | Psig_typesubst l ->
+      type_def_list ctxt f (Nonrecursive, false, l)
+  | Psig_value vd ->
+      let intro = if vd.pval_prim = [] then "val" else "external" in
+      pp f "@[<2>%s@ %a@ :@ %a@]%a" intro
+        protect_ident vd.pval_name.txt
+        (value_description ctxt) vd
+        (item_attributes ctxt) vd.pval_attributes
+  | Psig_typext te ->
+      type_extension ctxt f te
+  | Psig_exception ed ->
+      exception_declaration ctxt f ed
+  | Psig_class l ->
+      let class_description kwd f ({pci_params=ls;pci_name={txt;_};_} as x) =
+        pp f "@[<2>%s %a%a%s@;:@;%a@]%a" kwd
+          virtual_flag x.pci_virt
+          (class_params_def ctxt) ls txt
+          (class_type ctxt) x.pci_expr
+          (item_attributes ctxt) x.pci_attributes
+      in begin
+        match l with
+        | [] -> ()
+        | [x] -> class_description "class" f x
+        | x :: xs ->
+            pp f "@[<v>%a@,%a@]"
+              (class_description "class") x
+              (list ~sep:"@," (class_description "and")) xs
+      end
+  | Psig_module ({pmd_type={pmty_desc=Pmty_alias alias;
+                            pmty_attributes=[]; _};_} as pmd) ->
+      pp f "@[<hov>module@ %s@ =@ %a@]%a"
+        (Option.value pmd.pmd_name.txt ~default:"_")
+        longident_loc alias
+        (item_attributes ctxt) pmd.pmd_attributes
+  | Psig_module pmd ->
+      pp f "@[<hov>module@ %s@ :@ %a@]%a"
+        (Option.value pmd.pmd_name.txt ~default:"_")
+        (module_type ctxt) pmd.pmd_type
+        (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
+        (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
+        (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
+        (fun f md -> match md with
+           | None -> ()
+           | Some mt ->
+               pp_print_space f () ;
+               pp f "@ =@ %a" (module_type ctxt) mt
+        ) md
+        (item_attributes ctxt) attrs
+  | Psig_class_type (l) -> class_type_declaration_list ctxt f l
+  | Psig_recmodule decls ->
+      let rec  string_x_module_type_list f ?(first=true) l =
+        match l with
+        | [] -> () ;
+        | pmd :: tl ->
+            if not first then
+              pp f "@ @[<hov2>and@ %s:@ %a@]%a"
+                (Option.value pmd.pmd_name.txt ~default:"_")
+                (module_type1 ctxt) pmd.pmd_type
+                (item_attributes ctxt) pmd.pmd_attributes
+            else
+              pp f "@[<hov2>module@ rec@ %s:@ %a@]%a"
+                (Option.value pmd.pmd_name.txt ~default:"_")
+                (module_type1 ctxt) pmd.pmd_type
+                (item_attributes ctxt) pmd.pmd_attributes;
+            string_x_module_type_list f ~first:false tl
+      in
+      string_x_module_type_list f decls
+  | Psig_attribute a -> floating_attribute ctxt f a
+  | Psig_extension(e, a) ->
+      item_extension ctxt f e;
+      item_attributes ctxt f a
+
+and module_expr ctxt f x =
+  if x.pmod_attributes <> [] then
+    pp f "((%a)%a)" (module_expr ctxt) {x with pmod_attributes=[]}
+      (attributes ctxt) x.pmod_attributes
+  else match x.pmod_desc with
+    | Pmod_structure (s) ->
+        pp f "@[<hv2>struct@;@[<0>%a@]@;<1 -2>end@]"
+          (list (structure_item ctxt) ~sep:"@\n") s;
+    | Pmod_constraint (me, mt) ->
+        pp f "@[<hov2>(%a@ :@ %a)@]"
+          (module_expr ctxt) me
+          (module_type ctxt) mt
+    | Pmod_ident (li) ->
+        pp f "%a" longident_loc li;
+    | Pmod_functor (Unit, me) ->
+        pp f "functor ()@;->@;%a" (module_expr ctxt) me
+    | Pmod_functor (Named (s, mt), me) ->
+        pp f "functor@ (%s@ :@ %a)@;->@;%a"
+          (Option.value s.txt ~default:"_")
+          (module_type ctxt) mt (module_expr ctxt) me
+    | Pmod_apply (me1, me2) ->
+        pp f "(%a)(%a)" (module_expr ctxt) me1 (module_expr ctxt) me2
+        (* Cf: #7200 *)
+    | Pmod_unpack e ->
+        pp f "(val@ %a)" (expression ctxt) e
+    | Pmod_extension e -> extension ctxt f e
+
+and structure ctxt f x = list ~sep:"@\n" (structure_item ctxt) f x
+
+and payload ctxt f = function
+  | PStr [{pstr_desc = Pstr_eval (e, attrs)}] ->
+      pp f "@[<2>%a@]%a"
+        (expression ctxt) e
+        (item_attributes ctxt) attrs
+  | PStr x -> structure ctxt f x
+  | PTyp x -> pp f ":"; core_type ctxt f x
+  | PSig x -> pp f ":"; signature ctxt f x
+  | PPat (x, None) -> pp f "?"; pattern ctxt f x
+  | PPat (x, Some e) ->
+      pp f "?"; pattern ctxt f x;
+      pp f " when "; expression ctxt f e
+
+(* transform [f = fun g h -> ..] to [f g h = ... ] could be improved *)
+and binding ctxt f {pvb_pat=p; pvb_expr=x; _} =
+  (* .pvb_attributes have already been printed by the caller, #bindings *)
+  let rec pp_print_pexp_function f x =
+    if x.pexp_attributes <> [] then pp f "=@;%a" (expression ctxt) x
+    else match x.pexp_desc with
+      | Pexp_fun (label, eo, p, e) ->
+          if label=Nolabel then
+            pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function e
+          else
+            pp f "%a@ %a"
+              (label_exp ctxt) (label,eo,p) pp_print_pexp_function e
+      | Pexp_newtype (str,e) ->
+          pp f "(type@ %s)@ %a" str.txt pp_print_pexp_function e
+      | _ -> pp f "=@;%a" (expression ctxt) x
+  in
+  let tyvars_str tyvars = List.map (fun v -> v.txt) tyvars in
+  let is_desugared_gadt p e =
+    let gadt_pattern =
+      match p with
+      | {ppat_desc=Ppat_constraint({ppat_desc=Ppat_var _} as pat,
+                                   {ptyp_desc=Ptyp_poly (args_tyvars, rt)});
+         ppat_attributes=[]}->
+          Some (pat, args_tyvars, rt)
+      | _ -> None in
+    let rec gadt_exp tyvars e =
+      match e with
+      | {pexp_desc=Pexp_newtype (tyvar, e); pexp_attributes=[]} ->
+          gadt_exp (tyvar :: tyvars) e
+      | {pexp_desc=Pexp_constraint (e, ct); pexp_attributes=[]} ->
+          Some (List.rev tyvars, e, ct)
+      | _ -> None in
+    let gadt_exp = gadt_exp [] e in
+    match gadt_pattern, gadt_exp with
+    | Some (p, pt_tyvars, pt_ct), Some (e_tyvars, e, e_ct)
+      when tyvars_str pt_tyvars = tyvars_str e_tyvars ->
+      let ety = Typ.varify_constructors e_tyvars e_ct in
+      if ety = pt_ct then
+      Some (p, pt_tyvars, e_ct, e) else None
+    | _ -> None in
+  if x.pexp_attributes <> []
+  then pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x else
+  match is_desugared_gadt p x with
+  | Some (p, [], ct, e) ->
+      pp f "%a@;: %a@;=@;%a"
+        (simple_pattern ctxt) p (core_type ctxt) ct (expression ctxt) e
+  | Some (p, tyvars, ct, e) -> begin
+    pp f "%a@;: type@;%a.@;%a@;=@;%a"
+    (simple_pattern ctxt) p (list pp_print_string ~sep:"@;")
+    (tyvars_str tyvars) (core_type ctxt) ct (expression ctxt) e
+    end
+  | None -> begin
+      match p with
+      | {ppat_desc=Ppat_constraint(p ,ty);
+         ppat_attributes=[]} -> (* special case for the first*)
+          begin match ty with
+          | {ptyp_desc=Ptyp_poly _; ptyp_attributes=[]} ->
+              pp f "%a@;:@;%a@;=@;%a" (simple_pattern ctxt) p
+                (core_type ctxt) ty (expression ctxt) x
+          | _ ->
+              pp f "(%a@;:@;%a)@;=@;%a" (simple_pattern ctxt) p
+                (core_type ctxt) ty (expression ctxt) x
+          end
+      | {ppat_desc=Ppat_var _; ppat_attributes=[]} ->
+          pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function x
+      | _ ->
+          pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x
+    end
+
+(* [in] is not printed *)
+and bindings ctxt f (rf,l) =
+  let binding kwd rf f x =
+    pp f "@[<2>%s %a%a@]%a" kwd rec_flag rf
+      (binding ctxt) x (item_attributes ctxt) x.pvb_attributes
+  in
+  match l with
+  | [] -> ()
+  | [x] -> binding "let" rf f x
+  | x::xs ->
+      pp f "@[<v>%a@,%a@]"
+        (binding "let" rf) x
+        (list ~sep:"@," (binding "and" Nonrecursive)) xs
+
+and binding_op ctxt f x =
+  pp f "@[<2>%s %a@;=@;%a@]"
+    x.pbop_op.txt (pattern ctxt) x.pbop_pat (expression ctxt) x.pbop_exp
+
+and structure_item ctxt f x =
+  match x.pstr_desc with
+  | Pstr_eval (e, attrs) ->
+      pp f "@[<hov2>;;%a@]%a"
+        (expression ctxt) e
+        (item_attributes ctxt) attrs
+  | Pstr_type (_, []) -> assert false
+  | Pstr_type (rf, l)  -> type_def_list ctxt f (rf, true, l)
+  | Pstr_value (rf, l) ->
+      (* pp f "@[<hov2>let %a%a@]"  rec_flag rf bindings l *)
+      pp f "@[<2>%a@]" (bindings ctxt) (rf,l)
+  | Pstr_typext te -> type_extension ctxt f te
+  | Pstr_exception ed -> exception_declaration ctxt f ed
+  | Pstr_module x ->
+      let rec module_helper = function
+        | {pmod_desc=Pmod_functor(arg_opt,me'); pmod_attributes = []} ->
+            begin match arg_opt with
+            | Unit -> pp f "()"
+            | Named (s, mt) ->
+              pp f "(%s:%a)" (Option.value s.txt ~default:"_")
+                (module_type ctxt) mt
+            end;
+            module_helper me'
+        | me -> me
+      in
+      pp f "@[<hov2>module %s%a@]%a"
+        (Option.value x.pmb_name.txt ~default:"_")
+        (fun f me ->
+           let me = module_helper me in
+           match me with
+           | {pmod_desc=
+                Pmod_constraint
+                  (me',
+                   ({pmty_desc=(Pmty_ident (_)
+                               | Pmty_signature (_));_} as mt));
+              pmod_attributes = []} ->
+               pp f " :@;%a@;=@;%a@;"
+                 (module_type ctxt) mt (module_expr ctxt) me'
+           | _ -> pp f " =@ %a" (module_expr ctxt) me
+        ) x.pmb_expr
+        (item_attributes ctxt) x.pmb_attributes
+  | Pstr_open od ->
+      pp f "@[<2>open%s@;%a@]%a"
+        (override od.popen_override)
+        (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
+        (fun f md -> match md with
+           | None -> ()
+           | Some mt ->
+               pp_print_space f () ;
+               pp f "@ =@ %a" (module_type ctxt) mt
+        ) md
+        (item_attributes ctxt) attrs
+  | Pstr_class l ->
+      let extract_class_args cl =
+        let rec loop acc = function
+          | {pcl_desc=Pcl_fun (l, eo, p, cl'); pcl_attributes = []} ->
+              loop ((l,eo,p) :: acc) cl'
+          | cl -> List.rev acc, cl
+        in
+        let args, cl = loop [] cl in
+        let constr, cl =
+          match cl with
+          | {pcl_desc=Pcl_constraint (cl', ct); pcl_attributes = []} ->
+              Some ct, cl'
+          | _ -> None, cl
+        in
+        args, constr, cl
+      in
+      let class_constraint f ct = pp f ": @[%a@] " (class_type ctxt) ct in
+      let class_declaration kwd f
+          ({pci_params=ls; pci_name={txt;_}; _} as x) =
+        let args, constr, cl = extract_class_args x.pci_expr in
+        pp f "@[<2>%s %a%a%s %a%a=@;%a@]%a" kwd
+          virtual_flag x.pci_virt
+          (class_params_def ctxt) ls txt
+          (list (label_exp ctxt)) args
+          (option class_constraint) constr
+          (class_expr ctxt) cl
+          (item_attributes ctxt) x.pci_attributes
+      in begin
+        match l with
+        | [] -> ()
+        | [x] -> class_declaration "class" f x
+        | x :: xs ->
+            pp f "@[<v>%a@,%a@]"
+              (class_declaration "class") x
+              (list ~sep:"@," (class_declaration "and")) xs
+      end
+  | Pstr_class_type l -> class_type_declaration_list ctxt f l
+  | Pstr_primitive vd ->
+      pp f "@[<hov2>external@ %a@ :@ %a@]%a"
+        protect_ident vd.pval_name.txt
+        (value_description ctxt) vd
+        (item_attributes ctxt) vd.pval_attributes
+  | Pstr_include incl ->
+      pp f "@[<hov2>include@ %a@]%a"
+        (module_expr ctxt) incl.pincl_mod
+        (item_attributes ctxt) incl.pincl_attributes
+  | Pstr_recmodule decls -> (* 3.07 *)
+      let aux f = function
+        | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) ->
+            pp f "@[<hov2>@ and@ %s:%a@ =@ %a@]%a"
+              (Option.value pmb.pmb_name.txt ~default:"_")
+              (module_type ctxt) typ
+              (module_expr ctxt) expr
+              (item_attributes ctxt) pmb.pmb_attributes
+        | pmb ->
+            pp f "@[<hov2>@ and@ %s@ =@ %a@]%a"
+              (Option.value pmb.pmb_name.txt ~default:"_")
+              (module_expr ctxt) pmb.pmb_expr
+              (item_attributes ctxt) pmb.pmb_attributes
+      in
+      begin match decls with
+      | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) :: l2 ->
+          pp f "@[<hv>@[<hov2>module@ rec@ %s:%a@ =@ %a@]%a@ %a@]"
+            (Option.value pmb.pmb_name.txt ~default:"_")
+            (module_type ctxt) typ
+            (module_expr ctxt) expr
+            (item_attributes ctxt) pmb.pmb_attributes
+            (fun f l2 -> List.iter (aux f) l2) l2
+      | pmb :: l2 ->
+          pp f "@[<hv>@[<hov2>module@ rec@ %s@ =@ %a@]%a@ %a@]"
+            (Option.value pmb.pmb_name.txt ~default:"_")
+            (module_expr ctxt) pmb.pmb_expr
+            (item_attributes ctxt) pmb.pmb_attributes
+            (fun f l2 -> List.iter (aux f) l2) l2
+      | _ -> assert false
+      end
+  | Pstr_attribute a -> floating_attribute ctxt f a
+  | Pstr_extension(e, a) ->
+      item_extension ctxt f e;
+      item_attributes ctxt f a
+
+and type_param ctxt f (ct, a) =
+  pp f "%s%a" (type_variance a) (core_type ctxt) ct
+
+and type_params ctxt f = function
+  | [] -> ()
+  | l -> pp f "%a " (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",@;") l
+
+and type_def_list ctxt f (rf, exported, l) =
+  let type_decl kwd rf f x =
+    let eq =
+      if (x.ptype_kind = Ptype_abstract)
+         && (x.ptype_manifest = None) then ""
+      else if exported then " ="
+      else " :="
+    in
+    pp f "@[<2>%s %a%a%s%s%a@]%a" kwd
+      nonrec_flag rf
+      (type_params ctxt) x.ptype_params
+      x.ptype_name.txt eq
+      (type_declaration ctxt) x
+      (item_attributes ctxt) x.ptype_attributes
+  in
+  match l with
+  | [] -> assert false
+  | [x] -> type_decl "type" rf f x
+  | x :: xs -> pp f "@[<v>%a@,%a@]"
+                 (type_decl "type" rf) x
+                 (list ~sep:"@," (type_decl "and" Recursive)) xs
+
+and record_declaration ctxt f lbls =
+  let type_record_field f pld =
+    pp f "@[<2>%a%s:@;%a@;%a@]"
+      mutable_flag pld.pld_mutable
+      pld.pld_name.txt
+      (core_type ctxt) pld.pld_type
+      (attributes ctxt) pld.pld_attributes
+  in
+  pp f "{@\n%a}"
+    (list type_record_field ~sep:";@\n" )  lbls
+
+and type_declaration ctxt f x =
+  (* type_declaration has an attribute field,
+     but it's been printed by the caller of this method *)
+  let priv f =
+    match x.ptype_private with
+    | Public -> ()
+    | Private -> pp f "@;private"
+  in
+  let manifest f =
+    match x.ptype_manifest with
+    | None -> ()
+    | Some y ->
+        if x.ptype_kind = Ptype_abstract then
+          pp f "%t@;%a" priv (core_type ctxt) y
+        else
+          pp f "@;%a" (core_type ctxt) y
+  in
+  let constructor_declaration f pcd =
+    pp f "|@;";
+    constructor_declaration ctxt f
+      (pcd.pcd_name.txt, pcd.pcd_args, pcd.pcd_res, pcd.pcd_attributes)
+  in
+  let repr f =
+    let intro f =
+      if x.ptype_manifest = None then ()
+      else pp f "@;="
+    in
+    match x.ptype_kind with
+    | Ptype_variant xs ->
+      let variants fmt xs =
+        if xs = [] then pp fmt " |" else
+          pp fmt "@\n%a" (list ~sep:"@\n" constructor_declaration) xs
+      in pp f "%t%t%a" intro priv variants xs
+    | Ptype_abstract -> ()
+    | Ptype_record l ->
+        pp f "%t%t@;%a" intro priv (record_declaration ctxt) l
+    | Ptype_open -> pp f "%t%t@;.." intro priv
+  in
+  let constraints f =
+    List.iter
+      (fun (ct1,ct2,_) ->
+         pp f "@[<hov2>@ constraint@ %a@ =@ %a@]"
+           (core_type ctxt) ct1 (core_type ctxt) ct2)
+      x.ptype_cstrs
+  in
+  pp f "%t%t%t" manifest repr constraints
+
+and type_extension ctxt f x =
+  let extension_constructor f x =
+    pp f "@\n|@;%a" (extension_constructor ctxt) x
+  in
+  pp f "@[<2>type %a%a += %a@ %a@]%a"
+    (fun f -> function
+       | [] -> ()
+       | l ->
+           pp f "%a@;" (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",") l)
+    x.ptyext_params
+    longident_loc x.ptyext_path
+    private_flag x.ptyext_private (* Cf: #7200 *)
+    (list ~sep:"" extension_constructor)
+    x.ptyext_constructors
+    (item_attributes ctxt) x.ptyext_attributes
+
+and constructor_declaration ctxt f (name, args, res, attrs) =
+  let name =
+    match name with
+    | "::" -> "(::)"
+    | s -> s in
+  match res with
+  | None ->
+      pp f "%s%a@;%a" name
+        (fun f -> function
+           | Pcstr_tuple [] -> ()
+           | Pcstr_tuple l ->
+             pp f "@;of@;%a" (list (core_type1 ctxt) ~sep:"@;*@;") l
+           | Pcstr_record l -> pp f "@;of@;%a" (record_declaration ctxt) l
+        ) args
+        (attributes ctxt) attrs
+  | Some r ->
+      pp f "%s:@;%a@;%a" name
+        (fun f -> function
+           | Pcstr_tuple [] -> core_type1 ctxt f r
+           | Pcstr_tuple l -> pp f "%a@;->@;%a"
+                                (list (core_type1 ctxt) ~sep:"@;*@;") l
+                                (core_type1 ctxt) r
+           | Pcstr_record l ->
+               pp f "%a@;->@;%a" (record_declaration ctxt) l (core_type1 ctxt) r
+        )
+        args
+        (attributes ctxt) attrs
+
+and extension_constructor ctxt f x =
+  (* Cf: #7200 *)
+  match x.pext_kind with
+  | Pext_decl(l, r) ->
+      constructor_declaration ctxt f (x.pext_name.txt, l, r, x.pext_attributes)
+  | Pext_rebind li ->
+      pp f "%s%a@;=@;%a" x.pext_name.txt
+        (attributes ctxt) x.pext_attributes
+        longident_loc li
+
+and case_list ctxt f l : unit =
+  let aux f {pc_lhs; pc_guard; pc_rhs} =
+    pp f "@;| @[<2>%a%a@;->@;%a@]"
+      (pattern ctxt) pc_lhs (option (expression ctxt) ~first:"@;when@;")
+      pc_guard (expression (under_pipe ctxt)) pc_rhs
+  in
+  list aux f l ~sep:""
+
+and label_x_expression_param ctxt f (l,e) =
+  let simple_name = match e with
+    | {pexp_desc=Pexp_ident {txt=Lident l;_};
+       pexp_attributes=[]} -> Some l
+    | _ -> None
+  in match l with
+  | Nolabel  -> expression2 ctxt f e (* level 2*)
+  | Optional str ->
+      if Some str = simple_name then
+        pp f "?%s" str
+      else
+        pp f "?%s:%a" str (simple_expr ctxt) e
+  | Labelled lbl ->
+      if Some lbl = simple_name then
+        pp f "~%s" lbl
+      else
+        pp f "~%s:%a" lbl (simple_expr ctxt) e
+
+and directive_argument f x =
+  match x.pdira_desc with
+  | 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_bool (b) -> pp f "@ %s" (string_of_bool b)
+
+let toplevel_phrase f x =
+  match x with
+  | Ptop_def (s) ->pp f "@[<hov0>%a@]"  (list (structure_item reset_ctxt)) s
+   (* pp_open_hvbox f 0; *)
+   (* pp_print_list structure_item f s ; *)
+   (* pp_close_box f (); *)
+  | Ptop_dir {pdir_name; pdir_arg = None; _} ->
+   pp f "@[<hov2>#%s@]" pdir_name.txt
+  | Ptop_dir {pdir_name; pdir_arg = Some pdir_arg; _} ->
+   pp f "@[<hov2>#%s@ %a@]" pdir_name.txt directive_argument pdir_arg
+
+let expression f x =
+  pp f "@[%a@]" (expression reset_ctxt) x
+
+let string_of_expression x =
+  ignore (flush_str_formatter ()) ;
+  let f = str_formatter in
+  expression f x;
+  flush_str_formatter ()
+
+let string_of_structure x =
+  ignore (flush_str_formatter ());
+  let f = str_formatter in
+  structure reset_ctxt f x;
+  flush_str_formatter ()
+
+let top_phrase f x =
+  pp_print_newline f ();
+  toplevel_phrase f x;
+  pp f ";;";
+  pp_print_newline f ()
+
+let core_type = core_type reset_ctxt
+let pattern = pattern reset_ctxt
+let signature = signature reset_ctxt
+let structure = structure reset_ctxt
diff --git a/parsing/pprintast.mli b/parsing/pprintast.mli
new file mode 100644
index 00000000..454e60e2
--- /dev/null
+++ b/parsing/pprintast.mli
@@ -0,0 +1,44 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Hongbo Zhang (University of Pennsylvania)                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(** Pretty-printers for {!Parsetree}
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type space_formatter = (unit, Format.formatter, unit) format
+
+val longident : Format.formatter -> Longident.t -> unit
+val expression : Format.formatter -> Parsetree.expression -> unit
+val string_of_expression : Parsetree.expression -> string
+
+val pattern: Format.formatter -> Parsetree.pattern -> unit
+
+val core_type: Format.formatter -> Parsetree.core_type -> unit
+
+val signature: Format.formatter -> Parsetree.signature -> unit
+val structure: Format.formatter -> Parsetree.structure -> unit
+val string_of_structure: Parsetree.structure -> string
+
+val toplevel_phrase : Format.formatter -> Parsetree.toplevel_phrase -> unit
+val top_phrase: Format.formatter -> Parsetree.toplevel_phrase -> unit
+
+
+val tyvar: Format.formatter -> string -> unit
+  (** Print a type variable name, taking care of the special treatment
+      required for the single quote character in second position. *)
diff --git a/parsing/printast.ml b/parsing/printast.ml
new file mode 100644
index 00000000..4e3ef2b2
--- /dev/null
+++ b/parsing/printast.ml
@@ -0,0 +1,965 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*              Damien Doligez, projet Para, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1999 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Asttypes;;
+open Format;;
+open Lexing;;
+open Location;;
+open Parsetree;;
+
+let fmt_position with_name f l =
+  let fname = if with_name then l.pos_fname else "" in
+  if l.pos_lnum = -1
+  then fprintf f "%s[%d]" fname l.pos_cnum
+  else fprintf f "%s[%d,%d+%d]" fname l.pos_lnum l.pos_bol
+               (l.pos_cnum - l.pos_bol)
+;;
+
+let fmt_location f loc =
+  if not !Clflags.locations then ()
+  else begin
+    let p_2nd_name = loc.loc_start.pos_fname <> loc.loc_end.pos_fname in
+    fprintf f "(%a..%a)" (fmt_position true) loc.loc_start
+                         (fmt_position p_2nd_name) loc.loc_end;
+    if loc.loc_ghost then fprintf f " ghost";
+  end
+;;
+
+let rec fmt_longident_aux f x =
+  match x with
+  | Longident.Lident (s) -> fprintf f "%s" s;
+  | Longident.Ldot (y, s) -> fprintf f "%a.%s" fmt_longident_aux y s;
+  | Longident.Lapply (y, z) ->
+      fprintf f "%a(%a)" fmt_longident_aux y fmt_longident_aux z;
+;;
+
+let fmt_longident f x = fprintf f "\"%a\"" fmt_longident_aux x;;
+
+let fmt_longident_loc f (x : Longident.t loc) =
+  fprintf f "\"%a\" %a" fmt_longident_aux x.txt fmt_location x.loc;
+;;
+
+let fmt_string_loc f (x : string loc) =
+  fprintf f "\"%s\" %a" x.txt fmt_location x.loc;
+;;
+
+let fmt_str_opt_loc f (x : string option loc) =
+  fprintf f "\"%s\" %a" (Option.value x.txt ~default:"_") fmt_location x.loc;
+;;
+
+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";
+  | Mutable -> fprintf f "Mutable";
+;;
+
+let fmt_virtual_flag f x =
+  match x with
+  | Virtual -> fprintf f "Virtual";
+  | Concrete -> fprintf f "Concrete";
+;;
+
+let fmt_override_flag f x =
+  match x with
+  | Override -> fprintf f "Override";
+  | Fresh -> fprintf f "Fresh";
+;;
+
+let fmt_closed_flag f x =
+  match x with
+  | Closed -> fprintf f "Closed"
+  | Open -> fprintf f "Open"
+
+let fmt_rec_flag f x =
+  match x with
+  | Nonrecursive -> fprintf f "Nonrec";
+  | Recursive -> fprintf f "Rec";
+;;
+
+let fmt_direction_flag f x =
+  match x with
+  | Upto -> fprintf f "Up";
+  | Downto -> fprintf f "Down";
+;;
+
+let fmt_private_flag f x =
+  match x with
+  | Public -> fprintf f "Public";
+  | Private -> fprintf f "Private";
+;;
+
+let line i f s (*...*) =
+  fprintf f "%s" (String.make ((2*i) mod 72) ' ');
+  fprintf f s (*...*)
+;;
+
+let list i f ppf l =
+  match l with
+  | [] -> line i ppf "[]\n";
+  | _ :: _ ->
+     line i ppf "[\n";
+     List.iter (f (i+1) ppf) l;
+     line i ppf "]\n";
+;;
+
+let option i f ppf x =
+  match x with
+  | None -> line i ppf "None\n";
+  | Some x ->
+      line i ppf "Some\n";
+      f (i+1) ppf x;
+;;
+
+let longident_loc i ppf li = line i ppf "%a\n" fmt_longident_loc li;;
+let string i ppf s = line i ppf "\"%s\"\n" s;;
+let string_loc i ppf s = line i ppf "%a\n" fmt_string_loc s;;
+let str_opt_loc i ppf s = line i ppf "%a\n" fmt_str_opt_loc s;;
+let arg_label i ppf = function
+  | Nolabel -> line i ppf "Nolabel\n"
+  | Optional s -> line i ppf "Optional \"%s\"\n" s
+  | Labelled s -> line i ppf "Labelled \"%s\"\n" s
+;;
+
+let rec core_type i ppf x =
+  line i ppf "core_type %a\n" fmt_location x.ptyp_loc;
+  attributes i ppf x.ptyp_attributes;
+  let i = i+1 in
+  match x.ptyp_desc with
+  | Ptyp_any -> line i ppf "Ptyp_any\n";
+  | Ptyp_var (s) -> line i ppf "Ptyp_var %s\n" s;
+  | Ptyp_arrow (l, ct1, ct2) ->
+      line i ppf "Ptyp_arrow\n";
+      arg_label i ppf l;
+      core_type i ppf ct1;
+      core_type i ppf ct2;
+  | Ptyp_tuple l ->
+      line i ppf "Ptyp_tuple\n";
+      list i core_type ppf l;
+  | Ptyp_constr (li, l) ->
+      line i ppf "Ptyp_constr %a\n" fmt_longident_loc li;
+      list i core_type ppf l;
+  | Ptyp_variant (l, closed, low) ->
+      line i ppf "Ptyp_variant closed=%a\n" fmt_closed_flag closed;
+      list i label_x_bool_x_core_type_list ppf l;
+      option i (fun i -> list i string) ppf low
+  | Ptyp_object (l, c) ->
+      line i ppf "Ptyp_object %a\n" fmt_closed_flag c;
+      let i = i + 1 in
+      List.iter (fun field ->
+        match field.pof_desc with
+          | Otag (l, t) ->
+            line i ppf "method %s\n" l.txt;
+            attributes i ppf field.pof_attributes;
+            core_type (i + 1) ppf t
+          | Oinherit ct ->
+              line i ppf "Oinherit\n";
+              core_type (i + 1) ppf ct
+      ) l
+  | Ptyp_class (li, l) ->
+      line i ppf "Ptyp_class %a\n" fmt_longident_loc li;
+      list i core_type ppf l
+  | Ptyp_alias (ct, s) ->
+      line i ppf "Ptyp_alias \"%s\"\n" s;
+      core_type i ppf ct;
+  | Ptyp_poly (sl, ct) ->
+      line i ppf "Ptyp_poly%a\n"
+        (fun ppf ->
+           List.iter (fun x -> fprintf ppf " %a" Pprintast.tyvar x.txt)
+        )
+        sl;
+      core_type i ppf ct;
+  | Ptyp_package (s, l) ->
+      line i ppf "Ptyp_package %a\n" fmt_longident_loc s;
+      list i package_with ppf l;
+  | Ptyp_extension (s, arg) ->
+      line i ppf "Ptyp_extension \"%s\"\n" s.txt;
+      payload i ppf arg
+
+and package_with i ppf (s, t) =
+  line i ppf "with type %a\n" fmt_longident_loc s;
+  core_type i ppf t
+
+and pattern i ppf x =
+  line i ppf "pattern %a\n" fmt_location x.ppat_loc;
+  attributes i ppf x.ppat_attributes;
+  let i = i+1 in
+  match x.ppat_desc with
+  | Ppat_any -> line i ppf "Ppat_any\n";
+  | Ppat_var (s) -> line i ppf "Ppat_var %a\n" fmt_string_loc s;
+  | 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_interval (c1, c2) ->
+      line i ppf "Ppat_interval %a..%a\n" fmt_constant c1 fmt_constant c2;
+  | Ppat_tuple (l) ->
+      line i ppf "Ppat_tuple\n";
+      list i pattern ppf l;
+  | Ppat_construct (li, po) ->
+      line i ppf "Ppat_construct %a\n" fmt_longident_loc li;
+      option i pattern ppf po;
+  | Ppat_variant (l, po) ->
+      line i ppf "Ppat_variant \"%s\"\n" l;
+      option i pattern ppf po;
+  | Ppat_record (l, c) ->
+      line i ppf "Ppat_record %a\n" fmt_closed_flag c;
+      list i longident_x_pattern ppf l;
+  | Ppat_array (l) ->
+      line i ppf "Ppat_array\n";
+      list i pattern ppf l;
+  | Ppat_or (p1, p2) ->
+      line i ppf "Ppat_or\n";
+      pattern i ppf p1;
+      pattern i ppf p2;
+  | Ppat_lazy p ->
+      line i ppf "Ppat_lazy\n";
+      pattern i ppf p;
+  | Ppat_constraint (p, ct) ->
+      line i ppf "Ppat_constraint\n";
+      pattern i ppf p;
+      core_type i ppf ct;
+  | Ppat_type (li) ->
+      line i ppf "Ppat_type\n";
+      longident_loc i ppf li
+  | Ppat_unpack s ->
+      line i ppf "Ppat_unpack %a\n" fmt_str_opt_loc s;
+  | Ppat_exception p ->
+      line i ppf "Ppat_exception\n";
+      pattern i ppf p
+  | Ppat_open (m,p) ->
+      line i ppf "Ppat_open \"%a\"\n" fmt_longident_loc m;
+      pattern i ppf p
+  | Ppat_extension (s, arg) ->
+      line i ppf "Ppat_extension \"%s\"\n" s.txt;
+      payload i ppf arg
+
+and expression i ppf x =
+  line i ppf "expression %a\n" fmt_location x.pexp_loc;
+  attributes i ppf x.pexp_attributes;
+  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_let (rf, l, e) ->
+      line i ppf "Pexp_let %a\n" fmt_rec_flag rf;
+      list i value_binding ppf l;
+      expression i ppf e;
+  | Pexp_function l ->
+      line i ppf "Pexp_function\n";
+      list i case ppf l;
+  | Pexp_fun (l, eo, p, e) ->
+      line i ppf "Pexp_fun\n";
+      arg_label i ppf l;
+      option i expression ppf eo;
+      pattern i ppf p;
+      expression i ppf e;
+  | Pexp_apply (e, l) ->
+      line i ppf "Pexp_apply\n";
+      expression i ppf e;
+      list i label_x_expression ppf l;
+  | Pexp_match (e, l) ->
+      line i ppf "Pexp_match\n";
+      expression i ppf e;
+      list i case ppf l;
+  | Pexp_try (e, l) ->
+      line i ppf "Pexp_try\n";
+      expression i ppf e;
+      list i case ppf l;
+  | Pexp_tuple (l) ->
+      line i ppf "Pexp_tuple\n";
+      list i expression ppf l;
+  | Pexp_construct (li, eo) ->
+      line i ppf "Pexp_construct %a\n" fmt_longident_loc li;
+      option i expression ppf eo;
+  | Pexp_variant (l, eo) ->
+      line i ppf "Pexp_variant \"%s\"\n" l;
+      option i expression ppf eo;
+  | Pexp_record (l, eo) ->
+      line i ppf "Pexp_record\n";
+      list i longident_x_expression ppf l;
+      option i expression ppf eo;
+  | Pexp_field (e, li) ->
+      line i ppf "Pexp_field\n";
+      expression i ppf e;
+      longident_loc i ppf li;
+  | Pexp_setfield (e1, li, e2) ->
+      line i ppf "Pexp_setfield\n";
+      expression i ppf e1;
+      longident_loc i ppf li;
+      expression i ppf e2;
+  | Pexp_array (l) ->
+      line i ppf "Pexp_array\n";
+      list i expression ppf l;
+  | Pexp_ifthenelse (e1, e2, eo) ->
+      line i ppf "Pexp_ifthenelse\n";
+      expression i ppf e1;
+      expression i ppf e2;
+      option i expression ppf eo;
+  | Pexp_sequence (e1, e2) ->
+      line i ppf "Pexp_sequence\n";
+      expression i ppf e1;
+      expression i ppf e2;
+  | Pexp_while (e1, e2) ->
+      line i ppf "Pexp_while\n";
+      expression i ppf e1;
+      expression i ppf e2;
+  | Pexp_for (p, e1, e2, df, e3) ->
+      line i ppf "Pexp_for %a\n" fmt_direction_flag df;
+      pattern i ppf p;
+      expression i ppf e1;
+      expression i ppf e2;
+      expression i ppf e3;
+  | Pexp_constraint (e, ct) ->
+      line i ppf "Pexp_constraint\n";
+      expression i ppf e;
+      core_type i ppf ct;
+  | Pexp_coerce (e, cto1, cto2) ->
+      line i ppf "Pexp_coerce\n";
+      expression i ppf e;
+      option i core_type ppf cto1;
+      core_type i ppf cto2;
+  | Pexp_send (e, s) ->
+      line i ppf "Pexp_send \"%s\"\n" s.txt;
+      expression i ppf e;
+  | Pexp_new (li) -> line i ppf "Pexp_new %a\n" fmt_longident_loc li;
+  | Pexp_setinstvar (s, e) ->
+      line i ppf "Pexp_setinstvar %a\n" fmt_string_loc s;
+      expression i ppf e;
+  | Pexp_override (l) ->
+      line i ppf "Pexp_override\n";
+      list i string_x_expression ppf l;
+  | Pexp_letmodule (s, me, e) ->
+      line i ppf "Pexp_letmodule %a\n" fmt_str_opt_loc s;
+      module_expr i ppf me;
+      expression i ppf e;
+  | Pexp_letexception (cd, e) ->
+      line i ppf "Pexp_letexception\n";
+      extension_constructor i ppf cd;
+      expression i ppf e;
+  | Pexp_assert (e) ->
+      line i ppf "Pexp_assert\n";
+      expression i ppf e;
+  | Pexp_lazy (e) ->
+      line i ppf "Pexp_lazy\n";
+      expression i ppf e;
+  | Pexp_poly (e, cto) ->
+      line i ppf "Pexp_poly\n";
+      expression i ppf e;
+      option i core_type ppf cto;
+  | Pexp_object s ->
+      line i ppf "Pexp_object\n";
+      class_structure i ppf s
+  | Pexp_newtype (s, e) ->
+      line i ppf "Pexp_newtype \"%s\"\n" s.txt;
+      expression i ppf e
+  | Pexp_pack me ->
+      line i ppf "Pexp_pack\n";
+      module_expr i ppf me
+  | Pexp_open (o, e) ->
+      line i ppf "Pexp_open %a\n" fmt_override_flag o.popen_override;
+      module_expr i ppf o.popen_expr;
+      expression i ppf e
+  | Pexp_letop {let_; ands; body} ->
+      line i ppf "Pexp_letop\n";
+      binding_op i ppf let_;
+      list i binding_op ppf ands;
+      expression i ppf body
+  | Pexp_extension (s, arg) ->
+      line i ppf "Pexp_extension \"%s\"\n" s.txt;
+      payload i ppf arg
+  | Pexp_unreachable ->
+      line i ppf "Pexp_unreachable"
+
+and value_description i ppf x =
+  line i ppf "value_description %a %a\n" fmt_string_loc
+       x.pval_name fmt_location x.pval_loc;
+  attributes i ppf x.pval_attributes;
+  core_type (i+1) ppf x.pval_type;
+  list (i+1) string ppf x.pval_prim
+
+and type_parameter i ppf (x, _variance) = core_type i ppf x
+
+and type_declaration i ppf x =
+  line i ppf "type_declaration %a %a\n" fmt_string_loc x.ptype_name
+       fmt_location x.ptype_loc;
+  attributes i ppf x.ptype_attributes;
+  let i = i+1 in
+  line i ppf "ptype_params =\n";
+  list (i+1) type_parameter ppf x.ptype_params;
+  line i ppf "ptype_cstrs =\n";
+  list (i+1) core_type_x_core_type_x_location ppf x.ptype_cstrs;
+  line i ppf "ptype_kind =\n";
+  type_kind (i+1) ppf x.ptype_kind;
+  line i ppf "ptype_private = %a\n" fmt_private_flag x.ptype_private;
+  line i ppf "ptype_manifest =\n";
+  option (i+1) core_type ppf x.ptype_manifest
+
+and attribute i ppf k a =
+  line i ppf "%s \"%s\"\n" k a.attr_name.txt;
+  payload i ppf a.attr_payload;
+
+and attributes i ppf l =
+  let i = i + 1 in
+  List.iter (fun a ->
+    line i ppf "attribute \"%s\"\n" a.attr_name.txt;
+    payload (i + 1) ppf a.attr_payload;
+  ) l;
+
+and payload i ppf = function
+  | PStr x -> structure i ppf x
+  | PSig x -> signature i ppf x
+  | PTyp x -> core_type i ppf x
+  | PPat (x, None) -> pattern i ppf x
+  | PPat (x, Some g) ->
+    pattern i ppf x;
+    line i ppf "<when>\n";
+    expression (i + 1) ppf g
+
+
+and type_kind i ppf x =
+  match x with
+  | Ptype_abstract ->
+      line i ppf "Ptype_abstract\n"
+  | Ptype_variant l ->
+      line i ppf "Ptype_variant\n";
+      list (i+1) constructor_decl ppf l;
+  | Ptype_record l ->
+      line i ppf "Ptype_record\n";
+      list (i+1) label_decl ppf l;
+  | Ptype_open ->
+      line i ppf "Ptype_open\n";
+
+and type_extension i ppf x =
+  line i ppf "type_extension\n";
+  attributes i ppf x.ptyext_attributes;
+  let i = i+1 in
+  line i ppf "ptyext_path = %a\n" fmt_longident_loc x.ptyext_path;
+  line i ppf "ptyext_params =\n";
+  list (i+1) type_parameter ppf x.ptyext_params;
+  line i ppf "ptyext_constructors =\n";
+  list (i+1) extension_constructor ppf x.ptyext_constructors;
+  line i ppf "ptyext_private = %a\n" fmt_private_flag x.ptyext_private;
+
+and type_exception i ppf x =
+  line i ppf "type_exception\n";
+  attributes i ppf x.ptyexn_attributes;
+  let i = i+1 in
+  line i ppf "ptyext_constructor =\n";
+  let i = i+1 in
+  extension_constructor i ppf x.ptyexn_constructor
+
+and extension_constructor i ppf x =
+  line i ppf "extension_constructor %a\n" fmt_location x.pext_loc;
+  attributes i ppf x.pext_attributes;
+  let i = i + 1 in
+  line i ppf "pext_name = \"%s\"\n" x.pext_name.txt;
+  line i ppf "pext_kind =\n";
+  extension_constructor_kind (i + 1) ppf x.pext_kind;
+
+and extension_constructor_kind i ppf x =
+  match x with
+      Pext_decl(a, r) ->
+        line i ppf "Pext_decl\n";
+        constructor_arguments (i+1) ppf a;
+        option (i+1) core_type ppf r;
+    | Pext_rebind li ->
+        line i ppf "Pext_rebind\n";
+        line (i+1) ppf "%a\n" fmt_longident_loc li;
+
+and class_type i ppf x =
+  line i ppf "class_type %a\n" fmt_location x.pcty_loc;
+  attributes i ppf x.pcty_attributes;
+  let i = i+1 in
+  match x.pcty_desc with
+  | Pcty_constr (li, l) ->
+      line i ppf "Pcty_constr %a\n" fmt_longident_loc li;
+      list i core_type ppf l;
+  | Pcty_signature (cs) ->
+      line i ppf "Pcty_signature\n";
+      class_signature i ppf cs;
+  | Pcty_arrow (l, co, cl) ->
+      line i ppf "Pcty_arrow\n";
+      arg_label i ppf l;
+      core_type i ppf co;
+      class_type i ppf cl;
+  | Pcty_extension (s, arg) ->
+      line i ppf "Pcty_extension \"%s\"\n" s.txt;
+      payload i ppf arg
+  | Pcty_open (o, e) ->
+      line i ppf "Pcty_open %a %a\n" fmt_override_flag o.popen_override
+        fmt_longident_loc o.popen_expr;
+      class_type i ppf e
+
+and class_signature i ppf cs =
+  line i ppf "class_signature\n";
+  core_type (i+1) ppf cs.pcsig_self;
+  list (i+1) class_type_field ppf cs.pcsig_fields;
+
+and class_type_field i ppf x =
+  line i ppf "class_type_field %a\n" fmt_location x.pctf_loc;
+  let i = i+1 in
+  attributes i ppf x.pctf_attributes;
+  match x.pctf_desc with
+  | Pctf_inherit (ct) ->
+      line i ppf "Pctf_inherit\n";
+      class_type i ppf ct;
+  | Pctf_val (s, mf, vf, ct) ->
+      line i ppf "Pctf_val \"%s\" %a %a\n" s.txt fmt_mutable_flag mf
+           fmt_virtual_flag vf;
+      core_type (i+1) ppf ct;
+  | Pctf_method (s, pf, vf, ct) ->
+      line i ppf "Pctf_method \"%s\" %a %a\n" s.txt fmt_private_flag pf
+           fmt_virtual_flag vf;
+      core_type (i+1) ppf ct;
+  | Pctf_constraint (ct1, ct2) ->
+      line i ppf "Pctf_constraint\n";
+      core_type (i+1) ppf ct1;
+      core_type (i+1) ppf ct2;
+  | Pctf_attribute a ->
+      attribute i ppf "Pctf_attribute" a
+  | Pctf_extension (s, arg) ->
+      line i ppf "Pctf_extension \"%s\"\n" s.txt;
+     payload i ppf arg
+
+and class_description i ppf x =
+  line i ppf "class_description %a\n" fmt_location x.pci_loc;
+  attributes i ppf x.pci_attributes;
+  let i = i+1 in
+  line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
+  line i ppf "pci_params =\n";
+  list (i+1) type_parameter ppf x.pci_params;
+  line i ppf "pci_name = %a\n" fmt_string_loc x.pci_name;
+  line i ppf "pci_expr =\n";
+  class_type (i+1) ppf x.pci_expr;
+
+and class_type_declaration i ppf x =
+  line i ppf "class_type_declaration %a\n" fmt_location x.pci_loc;
+  attributes i ppf x.pci_attributes;
+  let i = i+1 in
+  line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
+  line i ppf "pci_params =\n";
+  list (i+1) type_parameter ppf x.pci_params;
+  line i ppf "pci_name = %a\n" fmt_string_loc x.pci_name;
+  line i ppf "pci_expr =\n";
+  class_type (i+1) ppf x.pci_expr;
+
+and class_expr i ppf x =
+  line i ppf "class_expr %a\n" fmt_location x.pcl_loc;
+  attributes i ppf x.pcl_attributes;
+  let i = i+1 in
+  match x.pcl_desc with
+  | Pcl_constr (li, l) ->
+      line i ppf "Pcl_constr %a\n" fmt_longident_loc li;
+      list i core_type ppf l;
+  | Pcl_structure (cs) ->
+      line i ppf "Pcl_structure\n";
+      class_structure i ppf cs;
+  | Pcl_fun (l, eo, p, e) ->
+      line i ppf "Pcl_fun\n";
+      arg_label i ppf l;
+      option i expression ppf eo;
+      pattern i ppf p;
+      class_expr i ppf e;
+  | Pcl_apply (ce, l) ->
+      line i ppf "Pcl_apply\n";
+      class_expr i ppf ce;
+      list i label_x_expression ppf l;
+  | Pcl_let (rf, l, ce) ->
+      line i ppf "Pcl_let %a\n" fmt_rec_flag rf;
+      list i value_binding ppf l;
+      class_expr i ppf ce;
+  | Pcl_constraint (ce, ct) ->
+      line i ppf "Pcl_constraint\n";
+      class_expr i ppf ce;
+      class_type i ppf ct;
+  | Pcl_extension (s, arg) ->
+      line i ppf "Pcl_extension \"%s\"\n" s.txt;
+      payload i ppf arg
+  | Pcl_open (o, e) ->
+      line i ppf "Pcl_open %a %a\n" fmt_override_flag o.popen_override
+        fmt_longident_loc o.popen_expr;
+      class_expr i ppf e
+
+and class_structure i ppf { pcstr_self = p; pcstr_fields = l } =
+  line i ppf "class_structure\n";
+  pattern (i+1) ppf p;
+  list (i+1) class_field ppf l;
+
+and class_field i ppf x =
+  line i ppf "class_field %a\n" fmt_location x.pcf_loc;
+  let i = i + 1 in
+  attributes i ppf x.pcf_attributes;
+  match x.pcf_desc with
+  | Pcf_inherit (ovf, ce, so) ->
+      line i ppf "Pcf_inherit %a\n" fmt_override_flag ovf;
+      class_expr (i+1) ppf ce;
+      option (i+1) string_loc ppf so;
+  | Pcf_val (s, mf, k) ->
+      line i ppf "Pcf_val %a\n" fmt_mutable_flag mf;
+      line (i+1) ppf "%a\n" fmt_string_loc s;
+      class_field_kind (i+1) ppf k
+  | Pcf_method (s, pf, k) ->
+      line i ppf "Pcf_method %a\n" fmt_private_flag pf;
+      line (i+1) ppf "%a\n" fmt_string_loc s;
+      class_field_kind (i+1) ppf k
+  | Pcf_constraint (ct1, ct2) ->
+      line i ppf "Pcf_constraint\n";
+      core_type (i+1) ppf ct1;
+      core_type (i+1) ppf ct2;
+  | Pcf_initializer (e) ->
+      line i ppf "Pcf_initializer\n";
+      expression (i+1) ppf e;
+  | Pcf_attribute a ->
+      attribute i ppf "Pcf_attribute" a
+  | Pcf_extension (s, arg) ->
+      line i ppf "Pcf_extension \"%s\"\n" s.txt;
+      payload i ppf arg
+
+and class_field_kind i ppf = function
+  | Cfk_concrete (o, e) ->
+      line i ppf "Concrete %a\n" fmt_override_flag o;
+      expression i ppf e
+  | Cfk_virtual t ->
+      line i ppf "Virtual\n";
+      core_type i ppf t
+
+and class_declaration i ppf x =
+  line i ppf "class_declaration %a\n" fmt_location x.pci_loc;
+  attributes i ppf x.pci_attributes;
+  let i = i+1 in
+  line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
+  line i ppf "pci_params =\n";
+  list (i+1) type_parameter ppf x.pci_params;
+  line i ppf "pci_name = %a\n" fmt_string_loc x.pci_name;
+  line i ppf "pci_expr =\n";
+  class_expr (i+1) ppf x.pci_expr;
+
+and module_type i ppf x =
+  line i ppf "module_type %a\n" fmt_location x.pmty_loc;
+  attributes i ppf x.pmty_attributes;
+  let i = i+1 in
+  match x.pmty_desc with
+  | Pmty_ident li -> line i ppf "Pmty_ident %a\n" fmt_longident_loc li;
+  | Pmty_alias li -> line i ppf "Pmty_alias %a\n" fmt_longident_loc li;
+  | Pmty_signature (s) ->
+      line i ppf "Pmty_signature\n";
+      signature i ppf s;
+  | Pmty_functor (Unit, mt2) ->
+      line i ppf "Pmty_functor ()\n";
+      module_type i ppf mt2;
+  | Pmty_functor (Named (s, mt1), mt2) ->
+      line i ppf "Pmty_functor %a\n" fmt_str_opt_loc s;
+      module_type i ppf mt1;
+      module_type i ppf mt2;
+  | Pmty_with (mt, l) ->
+      line i ppf "Pmty_with\n";
+      module_type i ppf mt;
+      list i with_constraint ppf l;
+  | Pmty_typeof m ->
+      line i ppf "Pmty_typeof\n";
+      module_expr i ppf m;
+  | Pmty_extension (s, arg) ->
+      line i ppf "Pmod_extension \"%s\"\n" s.txt;
+      payload i ppf arg
+
+and signature i ppf x = list i signature_item ppf x
+
+and signature_item i ppf x =
+  line i ppf "signature_item %a\n" fmt_location x.psig_loc;
+  let i = i+1 in
+  match x.psig_desc with
+  | Psig_value vd ->
+      line i ppf "Psig_value\n";
+      value_description i ppf vd;
+  | Psig_type (rf, l) ->
+      line i ppf "Psig_type %a\n" fmt_rec_flag rf;
+      list i type_declaration ppf l;
+  | Psig_typesubst l ->
+      line i ppf "Psig_typesubst\n";
+      list i type_declaration ppf l;
+  | Psig_typext te ->
+      line i ppf "Psig_typext\n";
+      type_extension i ppf te
+  | Psig_exception te ->
+      line i ppf "Psig_exception\n";
+      type_exception i ppf te
+  | Psig_module pmd ->
+      line i ppf "Psig_module %a\n" fmt_str_opt_loc pmd.pmd_name;
+      attributes i ppf pmd.pmd_attributes;
+      module_type i ppf pmd.pmd_type
+  | Psig_modsubst pms ->
+      line i ppf "Psig_modsubst %a = %a\n"
+        fmt_string_loc pms.pms_name
+        fmt_longident_loc pms.pms_manifest;
+      attributes i ppf pms.pms_attributes;
+  | Psig_recmodule decls ->
+      line i ppf "Psig_recmodule\n";
+      list i module_declaration ppf decls;
+  | Psig_modtype x ->
+      line i ppf "Psig_modtype %a\n" fmt_string_loc x.pmtd_name;
+      attributes i ppf x.pmtd_attributes;
+      modtype_declaration i ppf x.pmtd_type
+  | Psig_open od ->
+      line i ppf "Psig_open %a %a\n" fmt_override_flag od.popen_override
+        fmt_longident_loc od.popen_expr;
+      attributes i ppf od.popen_attributes
+  | Psig_include incl ->
+      line i ppf "Psig_include\n";
+      module_type i ppf incl.pincl_mod;
+      attributes i ppf incl.pincl_attributes
+  | Psig_class (l) ->
+      line i ppf "Psig_class\n";
+      list i class_description ppf l;
+  | Psig_class_type (l) ->
+      line i ppf "Psig_class_type\n";
+      list i class_type_declaration ppf l;
+  | Psig_extension ((s, arg), attrs) ->
+      line i ppf "Psig_extension \"%s\"\n" s.txt;
+      attributes i ppf attrs;
+      payload i ppf arg
+  | Psig_attribute a ->
+      attribute i ppf "Psig_attribute" a
+
+and modtype_declaration i ppf = function
+  | None -> line i ppf "#abstract"
+  | Some mt -> module_type (i+1) ppf mt
+
+and with_constraint i ppf x =
+  match x with
+  | Pwith_type (lid, td) ->
+      line i ppf "Pwith_type %a\n" fmt_longident_loc lid;
+      type_declaration (i+1) ppf td;
+  | Pwith_typesubst (lid, td) ->
+      line i ppf "Pwith_typesubst %a\n" fmt_longident_loc lid;
+      type_declaration (i+1) ppf td;
+  | Pwith_module (lid1, lid2) ->
+      line i ppf "Pwith_module %a = %a\n"
+        fmt_longident_loc lid1
+        fmt_longident_loc lid2;
+  | Pwith_modsubst (lid1, lid2) ->
+      line i ppf "Pwith_modsubst %a = %a\n"
+        fmt_longident_loc lid1
+        fmt_longident_loc lid2;
+
+and module_expr i ppf x =
+  line i ppf "module_expr %a\n" fmt_location x.pmod_loc;
+  attributes i ppf x.pmod_attributes;
+  let i = i+1 in
+  match x.pmod_desc with
+  | Pmod_ident (li) -> line i ppf "Pmod_ident %a\n" fmt_longident_loc li;
+  | Pmod_structure (s) ->
+      line i ppf "Pmod_structure\n";
+      structure i ppf s;
+  | Pmod_functor (Unit, me) ->
+      line i ppf "Pmod_functor ()\n";
+      module_expr i ppf me;
+  | Pmod_functor (Named (s, mt), me) ->
+      line i ppf "Pmod_functor %a\n" fmt_str_opt_loc s;
+      module_type i ppf mt;
+      module_expr i ppf me;
+  | Pmod_apply (me1, me2) ->
+      line i ppf "Pmod_apply\n";
+      module_expr i ppf me1;
+      module_expr i ppf me2;
+  | Pmod_constraint (me, mt) ->
+      line i ppf "Pmod_constraint\n";
+      module_expr i ppf me;
+      module_type i ppf mt;
+  | Pmod_unpack (e) ->
+      line i ppf "Pmod_unpack\n";
+      expression i ppf e;
+  | Pmod_extension (s, arg) ->
+      line i ppf "Pmod_extension \"%s\"\n" s.txt;
+      payload i ppf arg
+
+and structure i ppf x = list i structure_item ppf x
+
+and structure_item i ppf x =
+  line i ppf "structure_item %a\n" fmt_location x.pstr_loc;
+  let i = i+1 in
+  match x.pstr_desc with
+  | Pstr_eval (e, attrs) ->
+      line i ppf "Pstr_eval\n";
+      attributes i ppf attrs;
+      expression i ppf e;
+  | Pstr_value (rf, l) ->
+      line i ppf "Pstr_value %a\n" fmt_rec_flag rf;
+      list i value_binding ppf l;
+  | Pstr_primitive vd ->
+      line i ppf "Pstr_primitive\n";
+      value_description i ppf vd;
+  | Pstr_type (rf, l) ->
+      line i ppf "Pstr_type %a\n" fmt_rec_flag rf;
+      list i type_declaration ppf l;
+  | Pstr_typext te ->
+      line i ppf "Pstr_typext\n";
+      type_extension i ppf te
+  | Pstr_exception te ->
+      line i ppf "Pstr_exception\n";
+      type_exception i ppf te
+  | Pstr_module x ->
+      line i ppf "Pstr_module\n";
+      module_binding i ppf x
+  | Pstr_recmodule bindings ->
+      line i ppf "Pstr_recmodule\n";
+      list i module_binding ppf bindings;
+  | Pstr_modtype x ->
+      line i ppf "Pstr_modtype %a\n" fmt_string_loc x.pmtd_name;
+      attributes i ppf x.pmtd_attributes;
+      modtype_declaration i ppf x.pmtd_type
+  | Pstr_open od ->
+      line i ppf "Pstr_open %a\n" fmt_override_flag od.popen_override;
+      module_expr i ppf od.popen_expr;
+      attributes i ppf od.popen_attributes
+  | Pstr_class (l) ->
+      line i ppf "Pstr_class\n";
+      list i class_declaration ppf l;
+  | Pstr_class_type (l) ->
+      line i ppf "Pstr_class_type\n";
+      list i class_type_declaration ppf l;
+  | Pstr_include incl ->
+      line i ppf "Pstr_include";
+      attributes i ppf incl.pincl_attributes;
+      module_expr i ppf incl.pincl_mod
+  | Pstr_extension ((s, arg), attrs) ->
+      line i ppf "Pstr_extension \"%s\"\n" s.txt;
+      attributes i ppf attrs;
+      payload i ppf arg
+  | Pstr_attribute a ->
+      attribute i ppf "Pstr_attribute" a
+
+and module_declaration i ppf pmd =
+  str_opt_loc i ppf pmd.pmd_name;
+  attributes i ppf pmd.pmd_attributes;
+  module_type (i+1) ppf pmd.pmd_type;
+
+and module_binding i ppf x =
+  str_opt_loc i ppf x.pmb_name;
+  attributes i ppf x.pmb_attributes;
+  module_expr (i+1) ppf x.pmb_expr
+
+and core_type_x_core_type_x_location i ppf (ct1, ct2, l) =
+  line i ppf "<constraint> %a\n" fmt_location l;
+  core_type (i+1) ppf ct1;
+  core_type (i+1) ppf ct2;
+
+and constructor_decl i ppf
+                     {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} =
+  line i ppf "%a\n" fmt_location pcd_loc;
+  line (i+1) ppf "%a\n" fmt_string_loc pcd_name;
+  attributes i ppf pcd_attributes;
+  constructor_arguments (i+1) ppf pcd_args;
+  option (i+1) core_type ppf pcd_res
+
+and constructor_arguments i ppf = function
+  | Pcstr_tuple l -> list i core_type ppf l
+  | Pcstr_record l -> list i label_decl ppf l
+
+and label_decl i ppf {pld_name; pld_mutable; pld_type; pld_loc; pld_attributes}=
+  line i ppf "%a\n" fmt_location pld_loc;
+  attributes i ppf pld_attributes;
+  line (i+1) ppf "%a\n" fmt_mutable_flag pld_mutable;
+  line (i+1) ppf "%a" fmt_string_loc pld_name;
+  core_type (i+1) ppf pld_type
+
+and longident_x_pattern i ppf (li, p) =
+  line i ppf "%a\n" fmt_longident_loc li;
+  pattern (i+1) ppf p;
+
+and case i ppf {pc_lhs; pc_guard; pc_rhs} =
+  line i ppf "<case>\n";
+  pattern (i+1) ppf pc_lhs;
+  begin match pc_guard with
+  | None -> ()
+  | Some g -> line (i+1) ppf "<when>\n"; expression (i + 2) ppf g
+  end;
+  expression (i+1) ppf pc_rhs;
+
+and value_binding i ppf x =
+  line i ppf "<def>\n";
+  attributes (i+1) ppf x.pvb_attributes;
+  pattern (i+1) ppf x.pvb_pat;
+  expression (i+1) ppf x.pvb_expr
+
+and binding_op i ppf x =
+  line i ppf "<binding_op> %a %a"
+    fmt_string_loc x.pbop_op fmt_location x.pbop_loc;
+  pattern (i+1) ppf x.pbop_pat;
+  expression (i+1) ppf x.pbop_exp;
+
+and string_x_expression i ppf (s, e) =
+  line i ppf "<override> %a\n" fmt_string_loc s;
+  expression (i+1) ppf e;
+
+and longident_x_expression i ppf (li, e) =
+  line i ppf "%a\n" fmt_longident_loc li;
+  expression (i+1) ppf e;
+
+and label_x_expression i ppf (l,e) =
+  line i ppf "<arg>\n";
+  arg_label i ppf l;
+  expression (i+1) ppf e;
+
+and label_x_bool_x_core_type_list i ppf x =
+  match x.prf_desc with
+    Rtag (l, b, ctl) ->
+      line i ppf "Rtag \"%s\" %s\n" l.txt (string_of_bool b);
+      attributes (i+1) ppf x.prf_attributes;
+      list (i+1) core_type ppf ctl
+  | Rinherit (ct) ->
+      line i ppf "Rinherit\n";
+      core_type (i+1) ppf ct
+;;
+
+let rec toplevel_phrase i ppf x =
+  match x with
+  | Ptop_def (s) ->
+      line i ppf "Ptop_def\n";
+      structure (i+1) ppf s;
+  | Ptop_dir {pdir_name; pdir_arg; _} ->
+      line i ppf "Ptop_dir \"%s\"\n" pdir_name.txt;
+      match pdir_arg with
+      | None -> ()
+      | Some da -> directive_argument i ppf da;
+
+and directive_argument i ppf x =
+  match x.pdira_desc with
+  | Pdir_string (s) -> line i ppf "Pdir_string \"%s\"\n" s;
+  | Pdir_int (n, None) -> line i ppf "Pdir_int %s\n" n;
+  | Pdir_int (n, Some m) -> line i ppf "Pdir_int %s%c\n" n m;
+  | Pdir_ident (li) -> line i ppf "Pdir_ident %a\n" fmt_longident li;
+  | Pdir_bool (b) -> line i ppf "Pdir_bool %s\n" (string_of_bool b);
+;;
+
+let interface ppf x = list 0 signature_item ppf x;;
+
+let implementation ppf x = list 0 structure_item ppf x;;
+
+let top_phrase ppf x = toplevel_phrase 0 ppf x;;
diff --git a/parsing/printast.mli b/parsing/printast.mli
new file mode 100644
index 00000000..82156548
--- /dev/null
+++ b/parsing/printast.mli
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*              Damien Doligez, projet Para, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1999 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Raw printer for {!Parsetree}
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Parsetree;;
+open Format;;
+
+val interface : formatter -> signature_item list -> unit;;
+val implementation : formatter -> structure_item list -> unit;;
+val top_phrase : formatter -> toplevel_phrase -> unit;;
+
+val expression: int -> formatter -> expression -> unit
+val structure: int -> formatter -> structure -> unit
+val payload: int -> formatter -> payload -> unit
diff --git a/parsing/syntaxerr.ml b/parsing/syntaxerr.ml
new file mode 100644
index 00000000..49372b9e
--- /dev/null
+++ b/parsing/syntaxerr.ml
@@ -0,0 +1,43 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1997 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 type for reporting syntax errors *)
+
+type error =
+    Unclosed of Location.t * string * Location.t * string
+  | Expecting of Location.t * string
+  | Not_expecting of Location.t * string
+  | Applicative_path of Location.t
+  | Variable_in_scope of Location.t * string
+  | Other of Location.t
+  | Ill_formed_ast of Location.t * string
+  | Invalid_package_type of Location.t * string
+
+exception Error of error
+exception Escape_error
+
+let location_of_error = function
+  | Unclosed(l,_,_,_)
+  | Applicative_path l
+  | Variable_in_scope(l,_)
+  | Other l
+  | Not_expecting (l, _)
+  | Ill_formed_ast (l, _)
+  | Invalid_package_type (l, _)
+  | Expecting (l, _) -> l
+
+
+let ill_formed_ast loc s =
+  raise (Error (Ill_formed_ast (loc, s)))
diff --git a/parsing/syntaxerr.mli b/parsing/syntaxerr.mli
new file mode 100644
index 00000000..26ba7126
--- /dev/null
+++ b/parsing/syntaxerr.mli
@@ -0,0 +1,37 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1997 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 type for reporting syntax errors
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type error =
+    Unclosed of Location.t * string * Location.t * string
+  | Expecting of Location.t * string
+  | Not_expecting of Location.t * string
+  | Applicative_path of Location.t
+  | Variable_in_scope of Location.t * string
+  | Other of Location.t
+  | Ill_formed_ast of Location.t * string
+  | Invalid_package_type of Location.t * string
+
+exception Error of error
+exception Escape_error
+
+val location_of_error: error -> Location.t
+val ill_formed_ast: Location.t -> string -> 'a
diff --git a/runtime/.depend b/runtime/.depend
new file mode 100644
index 00000000..9f5d2fdf
--- /dev/null
+++ b/runtime/.depend
@@ -0,0 +1,2433 @@
+interp_b.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
+ caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/startup_aux.h caml/jumptbl.h
+misc_b.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
+stacks_b.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+fix_code_b.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \
+ caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
+startup_aux_b.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \
+ caml/osdeps.h caml/memory.h caml/startup_aux.h caml/memprof.h \
+ caml/roots.h
+startup_byt_b.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
+ caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h \
+ caml/eventlog.h caml/exec.h caml/fail.h caml/fix_code.h caml/freelist.h \
+ caml/gc_ctrl.h caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h \
+ caml/io.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h \
+ caml/printexc.h caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h \
+ caml/startup.h caml/startup_aux.h caml/version.h
+freelist_b.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h caml/eventlog.h
+major_gc_b.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
+minor_gc_b.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
+ caml/eventlog.h
+memory_b.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h caml/eventlog.h
+alloc_b.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
+roots_byt_b.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
+ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h \
+ caml/eventlog.h
+globroots_b.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
+fail_byt_b.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stacks.h caml/memory.h
+signals_b.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
+signals_byt_b.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
+ caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
+ caml/signals.h caml/signals_machdep.h
+printexc_b.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
+backtrace_byt_b.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
+ caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
+ caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
+ caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
+ caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
+backtrace_b.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
+compare_b.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h
+ints_b.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
+eventlog_b.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/osdeps.h caml/memory.h
+floats_b.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+str_b.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
+array_b.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
+io_b.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
+extern_b.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
+intern_b.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
+hash_b.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
+sys_b.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
+meta_b.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
+parsing_b.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/alloc.h
+gc_ctrl_b.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
+ caml/eventlog.h caml/stacks.h caml/startup_aux.h
+md5_b.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h caml/io.h caml/reverse.h
+obj_b.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+lexing_b.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
+callback_b.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \
+ caml/stacks.h caml/memory.h
+debugger_b.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/fail.h caml/fix_code.h \
+ caml/instruct.h caml/intext.h caml/io.h caml/io.h caml/mlvalues.h \
+ caml/stacks.h caml/sys.h
+weak_b.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
+compact_b.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
+ caml/memprof.h caml/eventlog.h
+finalise_b.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
+ caml/roots.h caml/signals.h
+custom_b.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
+dynlink_b.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/prims.h caml/signals.h
+spacetime_byt_b.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/mlvalues.h
+afl_b.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+unix_b.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
+bigarray_b.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
+main_b.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+memprof_b.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
+ caml/eventlog.h
+domain_b.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+win32_b.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
+instrtrace_b.$(O): instrtrace.c
+interp_bd.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
+ caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/startup_aux.h
+misc_bd.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
+stacks_bd.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+fix_code_bd.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \
+ caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
+startup_aux_bd.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \
+ caml/osdeps.h caml/memory.h caml/startup_aux.h caml/memprof.h \
+ caml/roots.h
+startup_byt_bd.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
+ caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h \
+ caml/eventlog.h caml/exec.h caml/fail.h caml/fix_code.h caml/freelist.h \
+ caml/gc_ctrl.h caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h \
+ caml/io.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h \
+ caml/printexc.h caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h \
+ caml/startup.h caml/startup_aux.h caml/version.h
+freelist_bd.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h caml/eventlog.h
+major_gc_bd.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
+minor_gc_bd.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
+ caml/eventlog.h
+memory_bd.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h caml/eventlog.h
+alloc_bd.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
+roots_byt_bd.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
+ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h \
+ caml/eventlog.h
+globroots_bd.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
+fail_byt_bd.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stacks.h caml/memory.h
+signals_bd.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
+signals_byt_bd.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
+ caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
+ caml/signals.h caml/signals_machdep.h
+printexc_bd.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
+backtrace_byt_bd.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
+ caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
+ caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
+ caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
+ caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
+backtrace_bd.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
+compare_bd.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h
+ints_bd.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
+eventlog_bd.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/osdeps.h caml/memory.h
+floats_bd.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+str_bd.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
+array_bd.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
+io_bd.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
+extern_bd.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
+intern_bd.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
+hash_bd.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
+sys_bd.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
+meta_bd.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
+parsing_bd.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/alloc.h
+gc_ctrl_bd.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
+ caml/eventlog.h caml/stacks.h caml/startup_aux.h
+md5_bd.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h caml/io.h caml/reverse.h
+obj_bd.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+lexing_bd.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
+callback_bd.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \
+ caml/stacks.h caml/memory.h
+debugger_bd.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/fail.h caml/fix_code.h \
+ caml/instruct.h caml/intext.h caml/io.h caml/io.h caml/mlvalues.h \
+ caml/stacks.h caml/sys.h
+weak_bd.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
+compact_bd.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
+ caml/memprof.h caml/eventlog.h
+finalise_bd.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
+ caml/roots.h caml/signals.h
+custom_bd.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
+dynlink_bd.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/prims.h caml/signals.h
+spacetime_byt_bd.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/mlvalues.h
+afl_bd.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+unix_bd.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
+bigarray_bd.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
+main_bd.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+memprof_bd.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
+ caml/eventlog.h
+domain_bd.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+win32_bd.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
+instrtrace_bd.$(O): instrtrace.c caml/instrtrace.h caml/mlvalues.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/instruct.h caml/misc.h caml/mlvalues.h \
+ caml/opnames.h caml/prims.h caml/stacks.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/startup_aux.h
+interp_bi.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
+ caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/startup_aux.h caml/jumptbl.h
+misc_bi.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
+stacks_bi.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+fix_code_bi.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \
+ caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
+startup_aux_bi.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \
+ caml/osdeps.h caml/memory.h caml/startup_aux.h caml/memprof.h \
+ caml/roots.h
+startup_byt_bi.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
+ caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h \
+ caml/eventlog.h caml/exec.h caml/fail.h caml/fix_code.h caml/freelist.h \
+ caml/gc_ctrl.h caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h \
+ caml/io.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h \
+ caml/printexc.h caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h \
+ caml/startup.h caml/startup_aux.h caml/version.h
+freelist_bi.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h caml/eventlog.h
+major_gc_bi.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
+minor_gc_bi.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
+ caml/eventlog.h
+memory_bi.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h caml/eventlog.h
+alloc_bi.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
+roots_byt_bi.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
+ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h \
+ caml/eventlog.h
+globroots_bi.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
+fail_byt_bi.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stacks.h caml/memory.h
+signals_bi.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
+signals_byt_bi.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
+ caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
+ caml/signals.h caml/signals_machdep.h
+printexc_bi.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
+backtrace_byt_bi.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
+ caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
+ caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
+ caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
+ caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
+backtrace_bi.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
+compare_bi.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h
+ints_bi.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
+eventlog_bi.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/osdeps.h caml/memory.h
+floats_bi.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+str_bi.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
+array_bi.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
+io_bi.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
+extern_bi.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
+intern_bi.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
+hash_bi.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
+sys_bi.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
+meta_bi.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
+parsing_bi.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/alloc.h
+gc_ctrl_bi.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
+ caml/eventlog.h caml/stacks.h caml/startup_aux.h
+md5_bi.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h caml/io.h caml/reverse.h
+obj_bi.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+lexing_bi.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
+callback_bi.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \
+ caml/stacks.h caml/memory.h
+debugger_bi.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/fail.h caml/fix_code.h \
+ caml/instruct.h caml/intext.h caml/io.h caml/io.h caml/mlvalues.h \
+ caml/stacks.h caml/sys.h
+weak_bi.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
+compact_bi.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
+ caml/memprof.h caml/eventlog.h
+finalise_bi.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
+ caml/roots.h caml/signals.h
+custom_bi.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
+dynlink_bi.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/prims.h caml/signals.h
+spacetime_byt_bi.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/mlvalues.h
+afl_bi.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+unix_bi.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
+bigarray_bi.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
+main_bi.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+memprof_bi.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
+ caml/eventlog.h
+domain_bi.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+win32_bi.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
+instrtrace_bi.$(O): instrtrace.c
+interp_bpic.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
+ caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/startup_aux.h caml/jumptbl.h
+misc_bpic.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
+stacks_bpic.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+fix_code_bpic.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \
+ caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
+startup_aux_bpic.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \
+ caml/osdeps.h caml/memory.h caml/startup_aux.h caml/memprof.h \
+ caml/roots.h
+startup_byt_bpic.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
+ caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h \
+ caml/eventlog.h caml/exec.h caml/fail.h caml/fix_code.h caml/freelist.h \
+ caml/gc_ctrl.h caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h \
+ caml/io.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h \
+ caml/printexc.h caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h \
+ caml/startup.h caml/startup_aux.h caml/version.h
+freelist_bpic.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h caml/eventlog.h
+major_gc_bpic.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
+minor_gc_bpic.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
+ caml/eventlog.h
+memory_bpic.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h caml/eventlog.h
+alloc_bpic.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
+roots_byt_bpic.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
+ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h \
+ caml/eventlog.h
+globroots_bpic.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
+fail_byt_bpic.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stacks.h caml/memory.h
+signals_bpic.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
+signals_byt_bpic.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
+ caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
+ caml/signals.h caml/signals_machdep.h
+printexc_bpic.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
+backtrace_byt_bpic.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
+ caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
+ caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
+ caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
+ caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
+backtrace_bpic.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
+compare_bpic.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h
+ints_bpic.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
+eventlog_bpic.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/osdeps.h caml/memory.h
+floats_bpic.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+str_bpic.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
+array_bpic.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
+io_bpic.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
+extern_bpic.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
+intern_bpic.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
+hash_bpic.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
+sys_bpic.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
+meta_bpic.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
+parsing_bpic.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/alloc.h
+gc_ctrl_bpic.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
+ caml/eventlog.h caml/stacks.h caml/startup_aux.h
+md5_bpic.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h caml/io.h caml/reverse.h
+obj_bpic.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+lexing_bpic.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
+callback_bpic.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \
+ caml/stacks.h caml/memory.h
+debugger_bpic.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/fail.h caml/fix_code.h \
+ caml/instruct.h caml/intext.h caml/io.h caml/io.h caml/mlvalues.h \
+ caml/stacks.h caml/sys.h
+weak_bpic.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
+compact_bpic.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
+ caml/memprof.h caml/eventlog.h
+finalise_bpic.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
+ caml/roots.h caml/signals.h
+custom_bpic.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
+dynlink_bpic.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/prims.h caml/signals.h
+spacetime_byt_bpic.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/mlvalues.h
+afl_bpic.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+unix_bpic.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
+bigarray_bpic.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
+main_bpic.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+memprof_bpic.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
+ caml/eventlog.h
+domain_bpic.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+win32_bpic.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
+instrtrace_bpic.$(O): instrtrace.c
+startup_aux_n.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \
+ caml/memory.h caml/startup_aux.h caml/memprof.h caml/roots.h
+startup_nat_n.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
+ caml/debugger.h caml/domain.h caml/eventlog.h caml/fail.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/osdeps.h caml/memory.h caml/printexc.h caml/stack.h \
+ caml/startup_aux.h caml/sys.h
+main_n.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+fail_nat_n.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stack.h caml/roots.h caml/memory.h caml/callback.h
+roots_nat_n.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
+ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h \
+ caml/eventlog.h
+signals_n.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
+signals_nat_n.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
+ signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
+ caml/memprof.h caml/roots.h caml/finalise.h
+misc_n.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
+freelist_n.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h caml/eventlog.h
+major_gc_n.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
+minor_gc_n.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
+ caml/eventlog.h
+memory_n.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h caml/eventlog.h
+alloc_n.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
+compare_n.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h
+ints_n.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
+floats_n.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+str_n.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
+array_n.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
+io_n.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
+extern_n.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
+intern_n.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
+hash_n.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
+sys_n.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
+parsing_n.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/alloc.h
+gc_ctrl_n.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
+ caml/eventlog.h caml/stack.h caml/startup_aux.h
+eventlog_n.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/osdeps.h caml/memory.h
+md5_n.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h caml/io.h caml/reverse.h
+obj_n.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+lexing_n.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
+unix_n.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
+printexc_n.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
+callback_n.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h
+weak_n.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
+compact_n.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
+ caml/memprof.h caml/eventlog.h
+finalise_n.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
+ caml/roots.h caml/signals.h
+custom_n.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
+globroots_n.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
+backtrace_nat_n.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
+ caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/stack.h
+backtrace_n.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
+dynlink_nat_n.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \
+ caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h
+debugger_n.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+meta_n.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
+dynlink_n.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/prims.h caml/signals.h
+clambda_checks_n.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl
+spacetime_nat_n.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
+ caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
+ caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
+ caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
+spacetime_snapshot_n.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
+ caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
+ caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
+afl_n.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+bigarray_n.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
+memprof_n.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
+ caml/eventlog.h
+domain_n.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+win32_n.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
+startup_aux_nd.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \
+ caml/memory.h caml/startup_aux.h caml/memprof.h caml/roots.h
+startup_nat_nd.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
+ caml/debugger.h caml/domain.h caml/eventlog.h caml/fail.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/osdeps.h caml/memory.h caml/printexc.h caml/stack.h \
+ caml/startup_aux.h caml/sys.h
+main_nd.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+fail_nat_nd.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stack.h caml/roots.h caml/memory.h caml/callback.h
+roots_nat_nd.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
+ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h \
+ caml/eventlog.h
+signals_nd.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
+signals_nat_nd.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
+ signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
+ caml/memprof.h caml/roots.h caml/finalise.h
+misc_nd.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
+freelist_nd.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h caml/eventlog.h
+major_gc_nd.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
+minor_gc_nd.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
+ caml/eventlog.h
+memory_nd.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h caml/eventlog.h
+alloc_nd.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
+compare_nd.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h
+ints_nd.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
+floats_nd.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+str_nd.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
+array_nd.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
+io_nd.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
+extern_nd.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
+intern_nd.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
+hash_nd.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
+sys_nd.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
+parsing_nd.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/alloc.h
+gc_ctrl_nd.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
+ caml/eventlog.h caml/stack.h caml/startup_aux.h
+eventlog_nd.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/osdeps.h caml/memory.h
+md5_nd.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h caml/io.h caml/reverse.h
+obj_nd.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+lexing_nd.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
+unix_nd.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
+printexc_nd.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
+callback_nd.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h
+weak_nd.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
+compact_nd.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
+ caml/memprof.h caml/eventlog.h
+finalise_nd.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
+ caml/roots.h caml/signals.h
+custom_nd.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
+globroots_nd.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
+backtrace_nat_nd.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
+ caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/stack.h
+backtrace_nd.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
+dynlink_nat_nd.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \
+ caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h
+debugger_nd.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+meta_nd.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
+dynlink_nd.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/prims.h caml/signals.h
+clambda_checks_nd.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl
+spacetime_nat_nd.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
+ caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
+ caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
+ caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
+spacetime_snapshot_nd.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
+ caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
+ caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
+afl_nd.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+bigarray_nd.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
+memprof_nd.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
+ caml/eventlog.h
+domain_nd.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+win32_nd.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
+startup_aux_ni.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \
+ caml/memory.h caml/startup_aux.h caml/memprof.h caml/roots.h
+startup_nat_ni.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
+ caml/debugger.h caml/domain.h caml/eventlog.h caml/fail.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/osdeps.h caml/memory.h caml/printexc.h caml/stack.h \
+ caml/startup_aux.h caml/sys.h
+main_ni.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+fail_nat_ni.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stack.h caml/roots.h caml/memory.h caml/callback.h
+roots_nat_ni.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
+ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h \
+ caml/eventlog.h
+signals_ni.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
+signals_nat_ni.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
+ signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
+ caml/memprof.h caml/roots.h caml/finalise.h
+misc_ni.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
+freelist_ni.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h caml/eventlog.h
+major_gc_ni.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
+minor_gc_ni.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
+ caml/eventlog.h
+memory_ni.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h caml/eventlog.h
+alloc_ni.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
+compare_ni.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h
+ints_ni.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
+floats_ni.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+str_ni.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
+array_ni.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
+io_ni.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
+extern_ni.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
+intern_ni.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
+hash_ni.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
+sys_ni.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
+parsing_ni.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/alloc.h
+gc_ctrl_ni.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
+ caml/eventlog.h caml/stack.h caml/startup_aux.h
+eventlog_ni.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/osdeps.h caml/memory.h
+md5_ni.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h caml/io.h caml/reverse.h
+obj_ni.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+lexing_ni.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
+unix_ni.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
+printexc_ni.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
+callback_ni.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h
+weak_ni.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
+compact_ni.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
+ caml/memprof.h caml/eventlog.h
+finalise_ni.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
+ caml/roots.h caml/signals.h
+custom_ni.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
+globroots_ni.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
+backtrace_nat_ni.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
+ caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/stack.h
+backtrace_ni.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
+dynlink_nat_ni.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \
+ caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h
+debugger_ni.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+meta_ni.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
+dynlink_ni.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/prims.h caml/signals.h
+clambda_checks_ni.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl
+spacetime_nat_ni.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
+ caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
+ caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
+ caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
+spacetime_snapshot_ni.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
+ caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
+ caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
+afl_ni.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+bigarray_ni.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
+memprof_ni.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
+ caml/eventlog.h
+domain_ni.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+win32_ni.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
+startup_aux_npic.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \
+ caml/memory.h caml/startup_aux.h caml/memprof.h caml/roots.h
+startup_nat_npic.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
+ caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
+ caml/debugger.h caml/domain.h caml/eventlog.h caml/fail.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/osdeps.h caml/memory.h caml/printexc.h caml/stack.h \
+ caml/startup_aux.h caml/sys.h
+main_npic.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+fail_nat_npic.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
+ caml/stack.h caml/roots.h caml/memory.h caml/callback.h
+roots_nat_npic.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
+ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
+ caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h \
+ caml/eventlog.h
+signals_npic.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
+ caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
+ caml/roots.h caml/finalise.h
+signals_nat_npic.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
+ signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
+ caml/memprof.h caml/roots.h caml/finalise.h
+misc_npic.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
+ caml/version.h
+freelist_npic.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
+ caml/mlvalues.h caml/eventlog.h
+major_gc_npic.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
+minor_gc_npic.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
+ caml/eventlog.h
+memory_npic.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
+ caml/memory.h caml/eventlog.h
+alloc_npic.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/stacks.h caml/memory.h caml/signals.h
+compare_npic.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h
+ints_npic.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
+ caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h
+floats_npic.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+str_npic.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
+array_npic.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
+io_npic.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/signals.h caml/sys.h
+extern_npic.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
+intern_npic.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/signals.h
+hash_npic.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
+ caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
+sys_npic.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
+ caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
+ caml/startup_aux.h
+parsing_npic.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
+ caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/alloc.h
+gc_ctrl_npic.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
+ caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
+ caml/eventlog.h caml/stack.h caml/startup_aux.h
+eventlog_npic.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/osdeps.h caml/memory.h
+md5_npic.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h caml/io.h caml/reverse.h
+obj_npic.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
+ caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
+lexing_npic.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
+unix_npic.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
+printexc_npic.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
+ caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/memprof.h caml/roots.h caml/memory.h
+callback_npic.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/mlvalues.h
+weak_npic.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
+compact_npic.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
+ caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
+ caml/memprof.h caml/eventlog.h
+finalise_npic.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
+ caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
+ caml/roots.h caml/signals.h
+custom_npic.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/mlvalues.h caml/signals.h
+globroots_npic.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
+ caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
+ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h
+backtrace_nat_npic.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
+ caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
+ caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
+ caml/mlvalues.h caml/stack.h
+backtrace_npic.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
+ caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
+dynlink_nat_npic.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \
+ caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h
+debugger_npic.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+meta_npic.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \
+ caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \
+ caml/stacks.h caml/memory.h
+dynlink_npic.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
+ caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
+ caml/memory.h caml/prims.h caml/signals.h
+clambda_checks_npic.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
+ caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl
+spacetime_nat_npic.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
+ caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
+ caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
+ caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
+ caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
+spacetime_snapshot_npic.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
+ caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
+ caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
+ caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
+ caml/stack.h
+afl_npic.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
+ caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h
+bigarray_npic.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
+ caml/signals.h
+memprof_npic.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
+ caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
+ caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
+ caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
+ caml/eventlog.h
+domain_npic.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
+ caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/domain.h
+win32_npic.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
+ caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
+ caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
+ caml/sys.h caml/config.h
diff --git a/runtime/Makefile b/runtime/Makefile
new file mode 100644
index 00000000..744955c0
--- /dev/null
+++ b/runtime/Makefile
@@ -0,0 +1,413 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+ROOTDIR = ..
+
+-include $(ROOTDIR)/Makefile.config
+-include $(ROOTDIR)/Makefile.common
+
+# Lists of source files
+
+BYTECODE_C_SOURCES := $(addsuffix .c, \
+  interp misc stacks fix_code startup_aux startup_byt freelist major_gc \
+  minor_gc memory alloc roots_byt globroots fail_byt signals \
+  signals_byt printexc backtrace_byt backtrace compare ints eventlog \
+  floats str array io extern intern hash sys meta parsing gc_ctrl md5 obj \
+  lexing callback debugger weak compact finalise custom dynlink \
+  spacetime_byt afl $(UNIX_OR_WIN32) bigarray main memprof domain)
+
+NATIVE_C_SOURCES := $(addsuffix .c, \
+  startup_aux startup_nat main fail_nat roots_nat signals \
+  signals_nat misc freelist major_gc minor_gc memory alloc compare ints \
+  floats str array io extern intern hash sys parsing gc_ctrl eventlog md5 obj \
+  lexing $(UNIX_OR_WIN32) printexc callback weak compact finalise custom \
+  globroots backtrace_nat backtrace dynlink_nat debugger meta \
+  dynlink clambda_checks spacetime_nat spacetime_snapshot afl bigarray \
+  memprof domain)
+
+# The other_files variable stores the list of files whose dependencies
+# should be computed by `make depend` although they do not need to be
+# compiled on the current build system
+ifeq "$(UNIX_OR_WIN32)" "win32"
+other_files := unix.c
+else
+other_files := win32.c
+endif
+
+ifeq "$(TOOLCHAIN)" "msvc"
+ASM_EXT := asm
+ASM_SOURCES := $(ARCH)nt.$(ASM_EXT)
+else
+ASM_EXT := S
+ASM_SOURCES := $(ARCH).$(ASM_EXT)
+endif
+
+# Targets to build and install
+
+PROGRAMS := ocamlrun$(EXE)
+BYTECODE_STATIC_LIBRARIES := ld.conf libcamlrun.$(A)
+BYTECODE_SHARED_LIBRARIES :=
+NATIVE_STATIC_LIBRARIES := libasmrun.$(A)
+NATIVE_SHARED_LIBRARIES :=
+
+ifeq "$(RUNTIMED)" "true"
+PROGRAMS += ocamlrund$(EXE)
+BYTECODE_STATIC_LIBRARIES += libcamlrund.$(A)
+NATIVE_STATIC_LIBRARIES += libasmrund.$(A)
+endif
+
+ifeq "$(RUNTIMEI)" "true"
+PROGRAMS += ocamlruni$(EXE)
+BYTECODE_STATIC_LIBRARIES += libcamlruni.$(A)
+NATIVE_STATIC_LIBRARIES += libasmruni.$(A)
+endif
+
+ifeq "$(UNIX_OR_WIN32)" "unix"
+ifeq "$(SUPPORTS_SHARED_LIBRARIES)" "true"
+BYTECODE_STATIC_LIBRARIES += libcamlrun_pic.$(A)
+BYTECODE_SHARED_LIBRARIES += libcamlrun_shared.$(SO)
+NATIVE_STATIC_LIBRARIES += libasmrun_pic.$(A)
+NATIVE_SHARED_LIBRARIES += libasmrun_shared.$(SO)
+endif
+endif
+
+# List of object files for each target
+
+ASM_OBJECTS := $(ASM_SOURCES:.$(ASM_EXT)=.$(O))
+
+libcamlrun_OBJECTS := $(BYTECODE_C_SOURCES:.c=_b.$(O))
+
+libcamlrund_OBJECTS := $(BYTECODE_C_SOURCES:.c=_bd.$(O)) \
+  instrtrace_bd.$(O)
+
+libcamlruni_OBJECTS := $(BYTECODE_C_SOURCES:.c=_bi.$(O))
+
+libcamlrunpic_OBJECTS := $(BYTECODE_C_SOURCES:.c=_bpic.$(O))
+
+libasmrun_OBJECTS := $(NATIVE_C_SOURCES:.c=_n.$(O)) $(ASM_OBJECTS)
+
+libasmrund_OBJECTS := $(NATIVE_C_SOURCES:.c=_nd.$(O)) $(ASM_OBJECTS)
+
+libasmruni_OBJECTS := $(NATIVE_C_SOURCES:.c=_ni.$(O)) $(ASM_OBJECTS)
+
+libasmrunpic_OBJECTS := $(NATIVE_C_SOURCES:.c=_npic.$(O)) \
+  $(ASM_OBJECTS:.$(O)=_libasmrunpic.$(O))
+
+# General (non target-specific) assembler and compiler flags
+
+ifdef BOOTSTRAPPING_FLEXLINK
+OC_CPPFLAGS += -DBOOTSTRAPPING_FLEXLINK
+endif
+
+# On Windows, OCAML_STDLIB_DIR needs to be defined dynamically
+
+ifeq "$(UNIX_OR_WIN32)" "win32"
+# OCAML_STDLIB_DIR needs to arrive in dynlink.c as a string which both gcc and
+# msvc are willing parse without warning. This means we can't pass UTF-8
+# directly since, as far as I can tell, cl can cope, but the pre-processor
+# can't. So the string needs to be directly translated to L"" form. To do this,
+# we take advantage of the fact that Cygwin uses GNU libiconv which includes a
+# Java pseudo-encoding which translates any UTF-8 sequences to \uXXXX (and,
+# unlike the C99 pseudo-encoding, emits two surrogate values when needed, rather
+# than \UXXXXXXXX). The \u is then translated to \x in order to accommodate
+# pre-Visual Studio 2013 compilers where \x is a non-standard alias for \u.
+OCAML_STDLIB_DIR = $(shell echo $(LIBDIR)| iconv -t JAVA | sed -e 's/\\u/\\x/g')
+STDLIB_CPP_FLAG = -DOCAML_STDLIB_DIR='L"$(OCAML_STDLIB_DIR)"'
+else # Unix
+OCAML_STDLIB_DIR = $(LIBDIR)
+STDLIB_CPP_FLAG = -DOCAML_STDLIB_DIR='"$(OCAML_STDLIB_DIR)"'
+endif
+
+OC_CPPFLAGS += $(IFLEXDIR)
+
+ifneq "$(CCOMPTYPE)" "msvc"
+OC_CFLAGS += -g
+endif
+
+OC_NATIVE_CPPFLAGS = -DNATIVE_CODE -DTARGET_$(ARCH)
+
+ifeq "$(UNIX_OR_WIN32)" "unix"
+OC_NATIVE_CPPFLAGS += -DMODEL_$(MODEL)
+endif
+
+OC_NATIVE_CPPFLAGS += -DSYS_$(SYSTEM) $(IFLEXDIR) $(LIBUNWIND_INCLUDE_FLAGS)
+
+OC_DEBUG_CPPFLAGS=-DDEBUG
+OC_INSTR_CPPFLAGS=-DCAML_INSTR
+
+ifeq "$(TOOLCHAIN)" "msvc"
+ASMFLAGS=
+ifeq ($(WITH_SPACETIME),true)
+ASMFLAGS=/DWITH_SPACETIME
+endif
+endif
+
+ASPPFLAGS = -DSYS_$(SYSTEM) -I$(ROOTDIR)/runtime
+ifeq "$(UNIX_OR_WIN32)" "unix"
+ASPPFLAGS += -DMODEL_$(MODEL)
+endif
+
+# Commands used to build native libraries
+
+ifeq "$(UNIX_OR_WIN32)" "win32"
+LIBS = $(BYTECCLIBS) $(EXTRALIBS)
+ifdef BOOTSTRAPPING_FLEXLINK
+MAKE_OCAMLRUN=$(MKEXE_BOOT)
+else
+MAKE_OCAMLRUN = $(MKEXE) -o $(1) $(2)
+endif
+else
+LIBS = $(BYTECCLIBS)
+MAKE_OCAMLRUN = $(MKEXE) -o $(1) $(2)
+endif
+
+# Build, install and clean targets
+
+.PHONY: all
+all: $(BYTECODE_STATIC_LIBRARIES) $(BYTECODE_SHARED_LIBRARIES) $(PROGRAMS)
+
+.PHONY: allopt
+allopt: $(NATIVE_STATIC_LIBRARIES) $(NATIVE_SHARED_LIBRARIES)
+
+INSTALL_INCDIR=$(INSTALL_LIBDIR)/caml
+.PHONY: install
+install:
+	$(INSTALL_PROG) $(PROGRAMS) "$(INSTALL_BINDIR)"
+	$(INSTALL_DATA) $(BYTECODE_STATIC_LIBRARIES) "$(INSTALL_LIBDIR)"
+ifneq "$(BYTECODE_SHARED_LIBRARIES)" ""
+	$(INSTALL_PROG) $(BYTECODE_SHARED_LIBRARIES) "$(INSTALL_LIBDIR)"
+endif
+	mkdir -p "$(INSTALL_INCDIR)"
+	$(INSTALL_DATA) caml/domain_state.tbl caml/*.h "$(INSTALL_INCDIR)"
+
+.PHONY: installopt
+installopt:
+	$(INSTALL_DATA) $(NATIVE_STATIC_LIBRARIES) "$(INSTALL_LIBDIR)"
+ifneq "$(NATIVE_SHARED_LIBRARIES)" ""
+	$(INSTALL_PROG) $(NATIVE_SHARED_LIBRARIES) "$(INSTALL_LIBDIR)"
+endif
+
+.PHONY: clean
+clean:
+	rm -f *.o *.obj *.a *.lib *.so *.dll ld.conf
+	rm -f ocamlrun ocamlrund ocamlruni
+	rm -f ocamlrun.exe ocamlrund.exe ocamlruni.exe
+	rm -f primitives primitives.new prims.c caml/opnames.h caml/jumptbl.h
+	rm -f caml/version.h domain_state*.inc
+
+.PHONY: distclean
+distclean: clean
+
+# Generated non-object files
+
+ld.conf: $(ROOTDIR)/Makefile.config
+	echo "$(STUBLIBDIR)" > $@
+	echo "$(LIBDIR)" >> $@
+
+# If primitives contain duplicated lines (e.g. because the code is defined
+# like
+# #ifdef X
+# CAMLprim value caml_foo() ...
+# #else
+# CAMLprim value caml_foo() ...
+# end), horrible things will happen (duplicated entries in Runtimedef ->
+# double registration in Symtable -> empty entry in the PRIM table ->
+# the bytecode interpreter is confused).
+# We sort the primitive file and remove duplicates to avoid this problem.
+
+# Warning: we use "sort | uniq" instead of "sort -u" because in the MSVC
+# port, the "sort" program in the path is Microsoft's and not cygwin's
+
+# Warning: POSIX sort is locale dependent, that's why we set LC_ALL explicitly.
+# Sort is unstable for "is_directory" and "isatty"
+# see http://pubs.opengroup.org/onlinepubs/9699919799/utilities/sort.html:
+# "using sort to process pathnames, it is recommended that LC_ALL .. set to C"
+
+# To speed up builds, we avoid changing "primitives" when files
+# containing primitives change but the primitives table does not
+primitives: $(shell ./gen_primitives.sh > primitives.new; \
+                    cmp -s primitives primitives.new || echo primitives.new)
+	cp $^ $@
+
+prims.c : primitives
+	(echo '#define CAML_INTERNALS'; \
+         echo '#include "caml/mlvalues.h"'; \
+	 echo '#include "caml/prims.h"'; \
+	 sed -e 's/.*/extern value &();/' primitives; \
+	 echo 'c_primitive caml_builtin_cprim[] = {'; \
+	 sed -e 's/.*/	&,/' primitives; \
+	 echo '	 0 };'; \
+	 echo 'char * caml_names_of_builtin_cprim[] = {'; \
+	 sed -e 's/.*/	"&",/' primitives; \
+	 echo '	 0 };') > prims.c
+
+caml/opnames.h : caml/instruct.h
+	tr -d '\r' < $< | \
+	sed -e '/\/\*/d' \
+	    -e '/^#/d' \
+	    -e 's/enum /static char * names_of_/' \
+	    -e 's/{$$/[] = {/' \
+	    -e 's/\([[:upper:]][[:upper:]_0-9]*\)/"\1"/g' > $@
+
+# caml/jumptbl.h is required only if you have GCC 2.0 or later
+caml/jumptbl.h : caml/instruct.h
+	tr -d '\r' < $< | \
+	sed -n -e '/^  /s/ \([A-Z]\)/ \&\&lbl_\1/gp' \
+	       -e '/^}/q' > $@
+
+caml/version.h : $(ROOTDIR)/tools/make-version-header.sh $(ROOTDIR)/VERSION
+	$^ > $@
+
+# Libraries and programs
+
+ocamlrun$(EXE): prims.$(O) libcamlrun.$(A)
+	$(call MAKE_OCAMLRUN,$@,$^ $(LIBS))
+
+libcamlrun.$(A): $(libcamlrun_OBJECTS)
+	$(call MKLIB,$@, $^)
+
+ocamlrund$(EXE): prims.$(O) libcamlrund.$(A)
+	$(MKEXE) $(MKEXEDEBUGFLAG) -o $@ $^ $(LIBS)
+
+libcamlrund.$(A): $(libcamlrund_OBJECTS)
+	$(call MKLIB,$@, $^)
+
+ocamlruni$(EXE): prims.$(O) libcamlruni.$(A)
+	$(MKEXE) -o $@ $^ $(LIBS)
+
+libcamlruni.$(A): $(libcamlruni_OBJECTS)
+	$(call MKLIB,$@, $^)
+
+libcamlrun_pic.$(A): $(libcamlrunpic_OBJECTS)
+	$(call MKLIB,$@, $^)
+
+libcamlrun_shared.$(SO): $(libcamlrunpic_OBJECTS)
+	$(MKDLL) -o $@ $^ $(BYTECCLIBS)
+
+libasmrun.$(A): $(libasmrun_OBJECTS)
+	$(call MKLIB,$@, $^)
+
+libasmrund.$(A): $(libasmrund_OBJECTS)
+	$(call MKLIB,$@, $^)
+
+libasmruni.$(A): $(libasmruni_OBJECTS)
+	$(call MKLIB,$@, $^)
+
+libasmrun_pic.$(A): $(libasmrunpic_OBJECTS)
+	$(call MKLIB,$@, $^)
+
+libasmrun_shared.$(SO): $(libasmrunpic_OBJECTS)
+	$(MKDLL) -o $@ $^ $(NATIVECCLIBS)
+
+# Target-specific preprocessor and compiler flags
+
+%_bd.$(O): OC_CPPFLAGS += $(OC_DEBUG_CPPFLAGS)
+
+%_bi.$(O): OC_CPPFLAGS += $(OC_INSTR_CPPFLAGS)
+
+%_bpic.$(O): OC_CFLAGS += $(SHAREDLIB_CFLAGS)
+
+%_n.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)
+
+%_nd.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(OC_DEBUG_CPPFLAGS)
+
+%_ni.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(OC_INSTR_CPPFLAGS)
+
+%_npic.$(O): OC_CFLAGS += $(SHAREDLIB_CFLAGS)
+%_npic.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)
+
+# Compilation of C files
+
+# The COMPILE_C_FILE macro below receives as argument the pattern
+# that corresponds to the name of the generated object file
+# (without the extension, which is added by the macro)
+define COMPILE_C_FILE
+$(1).$(O): %.c
+	$$(CC) -c $$(OC_CFLAGS) $$(OC_CPPFLAGS) $$(OUTPUTOBJ)$$@ $$<
+endef
+
+object_types := % %_b %_bd %_bi %_bpic %_n %_nd %_ni %_np %_npic
+
+$(foreach object_type, $(object_types), \
+  $(eval $(call COMPILE_C_FILE,$(object_type))))
+
+dynlink_%.$(O): OC_CPPFLAGS += $(STDLIB_CPP_FLAG)
+
+$(foreach object_type,$(subst %,,$(object_types)), \
+  $(eval dynlink$(object_type).$(O): $(ROOTDIR)/Makefile.config))
+
+# Compilation of assembly files
+
+%.o: %.S
+	$(ASPP) $(ASPPFLAGS) -o $@ $< || \
+	{ echo "If your assembler produced syntax errors, it is probably";\
+          echo "unhappy with the preprocessor. Check your assembler, or";\
+          echo "try producing $*.o by hand.";\
+          exit 2; }
+
+%_libasmrunpic.o: %.S
+	$(ASPP) $(ASPPFLAGS) $(SHAREDLIB_CFLAGS) -o $@ $<
+
+domain_state64.inc: caml/domain_state.tbl gen_domain_state64_inc.awk
+	$(AWK) -f ./gen_domain_state64_inc.awk $< > $@
+
+domain_state32.inc: caml/domain_state.tbl gen_domain_state32_inc.awk
+	$(AWK) -f ./gen_domain_state32_inc.awk $< > $@
+
+amd64nt.obj: amd64nt.asm domain_state64.inc
+	$(ASM)$@ $(ASMFLAGS) $<
+
+i386nt.obj: i386nt.asm domain_state32.inc
+	$(ASM)$@ $(ASMFLAGS) $<
+
+%_libasmrunpic.obj: %.asm
+	$(ASM)$@ $(ASMFLAGS) $<
+
+# Dependencies
+
+.PHONY: depend
+ifeq "$(TOOLCHAIN)" "msvc"
+depend:
+	$(error Dependencies cannot be regenerated using the MSVC ports)
+else
+
+NATIVE_DEP_CPPFLAGS := $(OC_CPPFLAGS) $(OC_NATIVE_CPPFLAGS)
+BYTECODE_DEP_FILES := $(BYTECODE_C_SOURCES) $(other_files) instrtrace.c
+NATIVE_DEP_FILES := $(NATIVE_C_SOURCES) $(other_files)
+
+depend: *.c caml/opnames.h caml/jumptbl.h caml/version.h
+	$(CC) -MM $(OC_CPPFLAGS) $(BYTECODE_DEP_FILES) | \
+	  sed -e 's/\([^.]*\)\.o/\1_b.$$(O)/' > .depend
+	$(CC) -MM $(OC_CPPFLAGS) $(OC_DEBUG_CPPFLAGS) \
+                  $(BYTECODE_DEP_FILES) | \
+	  sed -e 's/\([^.]*\)\.o/\1_bd.$$(O)/' >> .depend
+	$(CC) -MM $(OC_CPPFLAGS) $(OC_INSTR_CPPFLAGS) \
+               $(BYTECODE_DEP_FILES) | \
+	  sed -e 's/\([^.]*\)\.o/\1_bi.$$(O)/' >> .depend
+	$(CC) -MM $(OC_CPPFLAGS) $(BYTECODE_DEP_FILES) | \
+	  sed -e 's/\([^.]*\)\.o/\1_bpic.$$(O)/' >> .depend
+	$(CC) -MM $(NATIVE_DEP_CPPFLAGS) $(NATIVE_DEP_FILES) | \
+	  sed -e 's/\([^.]*\)\.o/\1_n.$$(O)/' >> .depend
+	$(CC) -MM $(NATIVE_DEP_CPPFLAGS) $(OC_DEBUG_CPPFLAGS) \
+                  $(NATIVE_DEP_FILES) | \
+	  sed -e 's/\([^.]*\)\.o/\1_nd.$$(O)/' >> .depend
+	$(CC) -MM $(NATIVE_DEP_CPPFLAGS) $(OC_INSTR_CPPFLAGS) \
+                  $(NATIVE_DEP_FILES) | \
+	  sed -e 's/\([^.]*\)\.o/\1_ni.$$(O)/' >> .depend
+	$(CC) -MM $(NATIVE_DEP_CPPFLAGS) $(NATIVE_DEP_FILES) | \
+	  sed -e 's/\([^.]*\)\.o/\1_npic.$$(O)/' >> .depend
+endif
+
+include .depend
diff --git a/runtime/afl.c b/runtime/afl.c
new file mode 100644
index 00000000..582449ef
--- /dev/null
+++ b/runtime/afl.c
@@ -0,0 +1,167 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Runtime support for afl-fuzz */
+#include "caml/config.h"
+
+#if !defined(HAS_SYS_SHM_H)
+
+#include "caml/mlvalues.h"
+
+CAMLprim value caml_setup_afl (value unit)
+{
+  return Val_unit;
+}
+
+CAMLprim value caml_reset_afl_instrumentation(value unused)
+{
+  return Val_unit;
+}
+
+#else
+
+#include <unistd.h>
+#include <sys/types.h>
+#include <signal.h>
+#include <sys/shm.h>
+#include <sys/wait.h>
+#include <stdio.h>
+#include <string.h>
+
+#define CAML_INTERNALS
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/osdeps.h"
+
+static int afl_initialised = 0;
+
+/* afl uses abnormal termination (SIGABRT) to check whether
+   to count a testcase as "crashing" */
+extern int caml_abort_on_uncaught_exn;
+
+/* Values used by the instrumentation logic (see cmmgen.ml) */
+static unsigned char afl_area_initial[1 << 16];
+unsigned char* caml_afl_area_ptr = afl_area_initial;
+uintnat caml_afl_prev_loc;
+
+/* File descriptors used to synchronise with afl-fuzz */
+#define FORKSRV_FD_READ 198
+#define FORKSRV_FD_WRITE 199
+
+static void afl_write(uint32_t msg)
+{
+  if (write(FORKSRV_FD_WRITE, &msg, 4) != 4)
+    caml_fatal_error("writing to afl-fuzz");
+}
+
+static uint32_t afl_read()
+{
+  uint32_t msg;
+  if (read(FORKSRV_FD_READ, &msg, 4) != 4)
+    caml_fatal_error("reading from afl-fuzz");
+  return msg;
+}
+
+CAMLprim value caml_setup_afl(value unit)
+{
+  char* shm_id_str;
+  char* shm_id_end;
+  long int shm_id;
+  uint32_t startup_msg = 0;
+
+  if (afl_initialised) return Val_unit;
+  afl_initialised = 1;
+
+  shm_id_str = caml_secure_getenv("__AFL_SHM_ID");
+  if (shm_id_str == NULL) {
+    /* Not running under afl-fuzz, continue as normal */
+    return Val_unit;
+  }
+
+  /* if afl-fuzz is attached, we want it to know about uncaught exceptions */
+  caml_abort_on_uncaught_exn = 1;
+
+  shm_id = strtol(shm_id_str, &shm_id_end, 10);
+  if (!(*shm_id_str != '\0' && *shm_id_end == '\0'))
+    caml_fatal_error("afl-fuzz: bad shm id");
+
+  caml_afl_area_ptr = shmat((int)shm_id, NULL, 0);
+  if (caml_afl_area_ptr == (void*)-1)
+    caml_fatal_error("afl-fuzz: could not attach shm area");
+
+  /* poke the bitmap so that afl-fuzz knows we exist, even if the
+     application has sparse instrumentation */
+  caml_afl_area_ptr[0] = 1;
+
+  /* synchronise with afl-fuzz */
+  if (write(FORKSRV_FD_WRITE, &startup_msg, 4) != 4) {
+    /* initial write failed, so assume we're not meant to fork.
+       afl-tmin uses this mode. */
+    return Val_unit;
+  }
+  afl_read();
+
+  while (1) {
+    int child_pid = fork();
+    if (child_pid < 0) caml_fatal_error("afl-fuzz: could not fork");
+    else if (child_pid == 0) {
+      /* Run the program */
+      close(FORKSRV_FD_READ);
+      close(FORKSRV_FD_WRITE);
+      return Val_unit;
+    }
+
+    /* As long as the child keeps raising SIGSTOP, we re-use the same process */
+    while (1) {
+      int status;
+      uint32_t was_killed;
+
+      afl_write((uint32_t)child_pid);
+
+      /* WUNTRACED means wait until termination or SIGSTOP */
+      if (waitpid(child_pid, &status, WUNTRACED) < 0)
+        caml_fatal_error("afl-fuzz: waitpid failed");
+
+      afl_write((uint32_t)status);
+
+      was_killed = afl_read();
+      if (WIFSTOPPED(status)) {
+        /* child stopped, waiting for another test case */
+        if (was_killed) {
+          /* we saw the child stop, but since then afl-fuzz killed it.
+             we should wait for it before forking another child */
+          if (waitpid(child_pid, &status, 0) < 0)
+            caml_fatal_error("afl-fuzz: waitpid failed");
+          break;
+        } else {
+          kill(child_pid, SIGCONT);
+        }
+      } else {
+        /* child died */
+        break;
+      }
+    }
+  }
+}
+
+CAMLprim value caml_reset_afl_instrumentation(value full)
+{
+  if (full != Val_int(0)) {
+    memset(caml_afl_area_ptr, 0, sizeof(afl_area_initial));
+  }
+  caml_afl_prev_loc = 0;
+  return Val_unit;
+}
+
+#endif /* HAS_SYS_SHM_H */
diff --git a/runtime/alloc.c b/runtime/alloc.c
new file mode 100644
index 00000000..7ae6b62c
--- /dev/null
+++ b/runtime/alloc.c
@@ -0,0 +1,274 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, 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
+
+/* 1. Allocation functions doing the same work as the macros in the
+      case where [Setup_for_gc] and [Restore_after_gc] are no-ops.
+   2. Convenience functions related to allocation.
+*/
+
+#include <string.h>
+#include "caml/alloc.h"
+#include "caml/custom.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "caml/stacks.h"
+#include "caml/signals.h"
+
+#define Setup_for_gc
+#define Restore_after_gc
+
+CAMLexport value caml_alloc (mlsize_t wosize, tag_t tag)
+{
+  value result;
+  mlsize_t i;
+
+  CAMLassert (tag < 256);
+  CAMLassert (tag != Infix_tag);
+  if (wosize <= Max_young_wosize){
+    if (wosize == 0){
+      result = Atom (tag);
+    }else{
+      Alloc_small (result, wosize, tag);
+      if (tag < No_scan_tag){
+        for (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;
+    }
+    result = caml_check_urgent_gc (result);
+  }
+  return result;
+}
+
+CAMLexport value caml_alloc_small (mlsize_t wosize, tag_t tag)
+{
+  value result;
+
+  CAMLassert (wosize > 0);
+  CAMLassert (wosize <= Max_young_wosize);
+  CAMLassert (tag < 256);
+  Alloc_small (result, wosize, tag);
+  return result;
+}
+
+CAMLexport value caml_alloc_small_with_my_or_given_profinfo (mlsize_t wosize,
+  tag_t tag, uintnat profinfo)
+{
+  if (profinfo == 0) {
+    return caml_alloc_small(wosize, tag);
+  }
+  else {
+    value result;
+
+    CAMLassert (wosize > 0);
+    CAMLassert (wosize <= Max_young_wosize);
+    CAMLassert (tag < 256);
+    Alloc_small_with_profinfo (result, wosize, tag, profinfo);
+    return result;
+  }
+}
+
+/* [n] is a number of words (fields) */
+CAMLexport value caml_alloc_tuple(mlsize_t n)
+{
+  return caml_alloc(n, 0);
+}
+
+/* [len] is a number of bytes (chars) */
+CAMLexport value caml_alloc_string (mlsize_t len)
+{
+  value result;
+  mlsize_t offset_index;
+  mlsize_t wosize = (len + sizeof (value)) / sizeof (value);
+
+  if (wosize <= Max_young_wosize) {
+    Alloc_small (result, wosize, String_tag);
+  }else{
+    result = caml_alloc_shr (wosize, String_tag);
+    result = caml_check_urgent_gc (result);
+  }
+  Field (result, wosize - 1) = 0;
+  offset_index = Bsize_wsize (wosize) - 1;
+  Byte (result, offset_index) = offset_index - len;
+  return result;
+}
+
+/* [len] is a number of bytes (chars) */
+CAMLexport value caml_alloc_initialized_string (mlsize_t len, const char *p)
+{
+  value result = caml_alloc_string (len);
+  memcpy((char *)String_val(result), p, len);
+  return result;
+}
+
+/* [len] is a number of words.
+   [mem] and [max] are relative (without unit).
+*/
+CAMLexport value caml_alloc_final (mlsize_t len, final_fun fun,
+                                   mlsize_t mem, mlsize_t max)
+{
+  return caml_alloc_custom(caml_final_custom_operations(fun),
+                           len * sizeof(value), mem, max);
+}
+
+CAMLexport value caml_copy_string(char const *s)
+{
+  mlsize_t len;
+  value res;
+
+  len = strlen(s);
+  res = caml_alloc_initialized_string(len, s);
+  return res;
+}
+
+CAMLexport value caml_alloc_array(value (*funct)(char const *),
+                                  char const ** arr)
+{
+  CAMLparam0 ();
+  mlsize_t nbr, n;
+  CAMLlocal2 (v, result);
+
+  nbr = 0;
+  while (arr[nbr] != 0) nbr++;
+  result = caml_alloc (nbr, 0);
+  for (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). */
+    v = funct(arr[n]);
+    caml_modify(&Field(result, n), v);
+  }
+  CAMLreturn (result);
+}
+
+/* [len] is a number of floats */
+value caml_alloc_float_array(mlsize_t len)
+{
+#ifdef FLAT_FLOAT_ARRAY
+  mlsize_t wosize = len * Double_wosize;
+  value result;
+  /* For consistency with [caml_make_vect], 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){
+    if (wosize == 0)
+      return Atom(0);
+    else
+      Alloc_small (result, wosize, Double_array_tag);
+  }else {
+    result = caml_alloc_shr (wosize, Double_array_tag);
+    result = caml_check_urgent_gc (result);
+  }
+  return result;
+#else
+  return caml_alloc (len, 0);
+#endif
+}
+
+
+CAMLexport value caml_copy_string_array(char const ** arr)
+{
+  return caml_alloc_array(caml_copy_string, arr);
+}
+
+CAMLexport int caml_convert_flag_list(value list, int *flags)
+{
+  int res;
+  res = 0;
+  while (list != Val_int(0)) {
+    res |= flags[Int_val(Field(list, 0))];
+    list = Field(list, 1);
+  }
+  return res;
+}
+
+/* For compiling let rec over values */
+
+/* [size] is a [value] representing number of words (fields) */
+CAMLprim value caml_alloc_dummy(value size)
+{
+  mlsize_t wosize = Long_val(size);
+  return caml_alloc (wosize, 0);
+}
+
+/* [size] is a [value] representing number of words (fields) */
+CAMLprim value caml_alloc_dummy_function(value size,value arity)
+{
+  /* the arity argument is used by the js_of_ocaml runtime */
+  return caml_alloc_dummy(size);
+}
+
+/* [size] is a [value] representing number of floats. */
+CAMLprim value caml_alloc_dummy_float (value size)
+{
+  mlsize_t wosize = Long_val(size) * Double_wosize;
+  return caml_alloc (wosize, 0);
+}
+
+CAMLprim value caml_alloc_dummy_infix(value vsize, value voffset)
+{
+  mlsize_t wosize = Long_val(vsize), offset = Long_val(voffset);
+  value v = caml_alloc(wosize, Closure_tag);
+  if (offset > 0) {
+    v += Bsize_wsize(offset);
+    Hd_val(v) = Make_header(offset, Infix_tag, Caml_white);
+  }
+  return v;
+}
+
+CAMLprim value caml_update_dummy(value dummy, value newval)
+{
+  mlsize_t size, i;
+  tag_t tag;
+
+  tag = Tag_val (newval);
+
+  if (tag == Double_array_tag){
+    CAMLassert (Wosize_val(newval) == Wosize_val(dummy));
+    CAMLassert (Tag_val(dummy) != Infix_tag);
+    Tag_val(dummy) = Double_array_tag;
+    size = Wosize_val (newval) / Double_wosize;
+    for (i = 0; i < size; i++) {
+      Store_double_flat_field (dummy, i, Double_flat_field (newval, i));
+    }
+  } else if (tag == Infix_tag) {
+    value clos = newval - Infix_offset_hd(Hd_val(newval));
+    CAMLassert (Tag_val(clos) == Closure_tag);
+    CAMLassert (Tag_val(dummy) == Infix_tag);
+    CAMLassert (Infix_offset_val(dummy) == Infix_offset_val(newval));
+    dummy = dummy - Infix_offset_val(dummy);
+    size = Wosize_val(clos);
+    CAMLassert (size == Wosize_val(dummy));
+    for (i = 0; i < size; i++) {
+      caml_modify (&Field(dummy, i), Field(clos, i));
+    }
+  } else {
+    CAMLassert (tag < No_scan_tag);
+    CAMLassert (Tag_val(dummy) != Infix_tag);
+    Tag_val(dummy) = tag;
+    size = Wosize_val(newval);
+    CAMLassert (size == Wosize_val(dummy));
+    for (i = 0; i < size; i++){
+      caml_modify (&Field(dummy, i), Field(newval, i));
+    }
+  }
+  return Val_unit;
+}
diff --git a/runtime/amd64.S b/runtime/amd64.S
new file mode 100644
index 00000000..056b39cd
--- /dev/null
+++ b/runtime/amd64.S
@@ -0,0 +1,743 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2003 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Asm part of the runtime system, AMD64 processor */
+/* Must be preprocessed by cpp */
+
+/* PIC mode support based on contribution by Paul Stravers (see PR#4795) */
+
+#include "caml/m.h"
+
+#if defined(SYS_macosx)
+
+#define LBL(x) L##x
+#define G(r) _##r
+#define GREL(r) _##r@GOTPCREL
+#define GCALL(r) _##r
+#define TEXT_SECTION(name) .text
+#define FUNCTION_ALIGN 2
+#define EIGHT_ALIGN 3
+#define SIXTEEN_ALIGN 4
+#define FUNCTION(name) \
+        .globl name; \
+        .align FUNCTION_ALIGN; \
+        name:
+
+#elif defined(SYS_mingw64) || defined(SYS_cygwin)
+
+#define LBL(x) .L##x
+#define G(r) r
+#undef  GREL
+#define GCALL(r) r
+#define TEXT_SECTION(name)
+#define FUNCTION_ALIGN 4
+#define EIGHT_ALIGN 8
+#define SIXTEEN_ALIGN 16
+#define FUNCTION(name) \
+        TEXT_SECTION(name); \
+        .globl name; \
+        .align FUNCTION_ALIGN; \
+        name:
+
+#else
+
+#define LBL(x) .L##x
+#define G(r) r
+#define GREL(r) r@GOTPCREL
+#define GCALL(r) r@PLT
+#if defined(FUNCTION_SECTIONS)
+#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
+#else
+#define TEXT_SECTION(name)
+#endif
+#define FUNCTION_ALIGN 4
+#define EIGHT_ALIGN 8
+#define SIXTEEN_ALIGN 16
+#define FUNCTION(name) \
+        TEXT_SECTION(caml.##name); \
+        .globl name; \
+        .type name,@function; \
+        .align FUNCTION_ALIGN; \
+        name:
+
+#endif
+
+#if defined(SYS_linux) || defined(SYS_gnu)
+#define ENDFUNCTION(name) \
+        .size name, . - name
+#else
+#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_SAME_VALUE(r) .cfi_same_value r
+#else
+#define CFI_STARTPROC
+#define CFI_ENDPROC
+#define CFI_ADJUST(n)
+#define CFI_OFFSET(r, n)
+#define CFI_SAME_VALUE(r)
+#endif
+
+#ifdef WITH_FRAME_POINTERS
+
+#define ENTER_FUNCTION \
+        pushq   %rbp; CFI_ADJUST(8); \
+        movq    %rsp, %rbp
+#define LEAVE_FUNCTION \
+        popq    %rbp; CFI_ADJUST(-8);
+
+#else
+
+#define ENTER_FUNCTION \
+        subq    $8, %rsp; CFI_ADJUST (8);
+#define LEAVE_FUNCTION \
+        addq    $8, %rsp; CFI_ADJUST (-8);
+
+#endif
+
+        .set    domain_curr_field, 0
+#define DOMAIN_STATE(c_type, name) \
+        .equ    domain_field_caml_##name, domain_curr_field ; \
+        .set    domain_curr_field, domain_curr_field + 1
+#include "../runtime/caml/domain_state.tbl"
+#undef DOMAIN_STATE
+
+#define Caml_state(var) (8*domain_field_caml_##var)(%r14)
+
+#if defined(__PIC__) && !defined(SYS_mingw64) && !defined(SYS_cygwin)
+
+/* Position-independent operations on global variables. */
+
+/* Store [srcreg] in global [dstlabel].  Clobbers %r11. */
+#define STORE_VAR(srcreg,dstlabel) \
+        movq    GREL(dstlabel)(%rip), %r11 ; \
+        movq    srcreg, (%r11)
+
+#define STORE_VAR32(srcreg,dstlabel) \
+        movq    GREL(dstlabel)(%rip), %r11 ; \
+        movl    srcreg, (%r11)
+
+/* Load global [srclabel] in register [dstreg].  Clobbers %r11. */
+#define LOAD_VAR(srclabel,dstreg) \
+        movq    GREL(srclabel)(%rip), %r11 ; \
+        movq    (%r11), dstreg
+
+/* Compare global [label] with register [reg].  Clobbers %rax. */
+#define CMP_VAR(label,reg) \
+        movq    GREL(label)(%rip), %rax ; \
+        cmpq    (%rax), reg
+
+/* Test 32-bit global [label] against mask [imm].  Clobbers %r11. */
+#define TESTL_VAR(imm,label) \
+        movq    GREL(label)(%rip), %r11 ; \
+        testl   imm, (%r11)
+
+/* Push global [label] on stack.  Clobbers %r11. */
+#define PUSH_VAR(srclabel) \
+        movq    GREL(srclabel)(%rip), %r11 ; \
+        pushq   (%r11); CFI_ADJUST (8)
+
+/* Pop global [label] off stack.  Clobbers %r11. */
+#define POP_VAR(dstlabel) \
+        movq    GREL(dstlabel)(%rip), %r11 ; \
+        popq    (%r11);  CFI_ADJUST (-8)
+
+/* Load address of global [label] in register [dst]. */
+#define LEA_VAR(label,dst) \
+        movq    GREL(label)(%rip), dst
+
+#else
+
+/* Non-PIC operations on global variables.  Slightly faster. */
+
+#define STORE_VAR(srcreg,dstlabel) \
+        movq    srcreg, G(dstlabel)(%rip)
+
+#define STORE_VAR32(srcreg,dstlabel) \
+        movl    srcreg, G(dstlabel)(%rip)
+
+#define LOAD_VAR(srclabel,dstreg) \
+        movq    G(srclabel)(%rip), dstreg
+
+#define CMP_VAR(label,reg) \
+        cmpq    G(label)(%rip), %r15
+
+#define TESTL_VAR(imm,label) \
+        testl   imm, G(label)(%rip)
+
+#define PUSH_VAR(srclabel) \
+        pushq   G(srclabel)(%rip) ; CFI_ADJUST(8)
+
+#define POP_VAR(dstlabel) \
+        popq    G(dstlabel)(%rip); CFI_ADJUST(-8)
+
+#define LEA_VAR(label,dst) \
+        leaq    G(label)(%rip), dst
+#endif
+
+/* Save and restore all callee-save registers on stack.
+   Keep the stack 16-aligned. */
+
+#if defined(SYS_mingw64) || defined(SYS_cygwin)
+
+/* Win64 API: callee-save regs are rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15 */
+
+#define PUSH_CALLEE_SAVE_REGS \
+        pushq   %rbx; CFI_ADJUST (8); CFI_OFFSET(rbx, -16); \
+        pushq   %rbp; CFI_ADJUST (8); CFI_OFFSET(rbp, -24); \
+                      /* Allows debugger to walk the stack */ \
+        pushq   %rsi; CFI_ADJUST (8); CFI_OFFSET(rsi, -32); \
+        pushq   %rdi; CFI_ADJUST (8); CFI_OFFSET(rdi, -40); \
+        pushq   %r12; CFI_ADJUST (8); CFI_OFFSET(r12, -48); \
+        pushq   %r13; CFI_ADJUST (8); CFI_OFFSET(r13, -56); \
+        pushq   %r14; CFI_ADJUST (8); CFI_OFFSET(r14, -64); \
+        pushq   %r15; CFI_ADJUST (8); CFI_OFFSET(r15, -72); \
+        subq    $(8+10*16), %rsp; CFI_ADJUST (8+10*16); \
+        movupd  %xmm6, 0*16(%rsp); \
+        movupd  %xmm7, 1*16(%rsp); \
+        movupd  %xmm8, 2*16(%rsp); \
+        movupd  %xmm9, 3*16(%rsp); \
+        movupd  %xmm10, 4*16(%rsp); \
+        movupd  %xmm11, 5*16(%rsp); \
+        movupd  %xmm12, 6*16(%rsp); \
+        movupd  %xmm13, 7*16(%rsp); \
+        movupd  %xmm14, 8*16(%rsp); \
+        movupd  %xmm15, 9*16(%rsp)
+
+#define POP_CALLEE_SAVE_REGS \
+        movupd  0*16(%rsp), %xmm6; \
+        movupd  1*16(%rsp), %xmm7; \
+        movupd  2*16(%rsp), %xmm8; \
+        movupd  3*16(%rsp), %xmm9; \
+        movupd  4*16(%rsp), %xmm10; \
+        movupd  5*16(%rsp), %xmm11; \
+        movupd  6*16(%rsp), %xmm12; \
+        movupd  7*16(%rsp), %xmm13; \
+        movupd  8*16(%rsp), %xmm14; \
+        movupd  9*16(%rsp), %xmm15; \
+        addq    $(8+10*16), %rsp; CFI_ADJUST (-8-10*16); \
+        popq    %r15; CFI_ADJUST(-8); CFI_SAME_VALUE(r15); \
+        popq    %r14; CFI_ADJUST(-8); CFI_SAME_VALUE(r14); \
+        popq    %r13; CFI_ADJUST(-8); CFI_SAME_VALUE(r13); \
+        popq    %r12; CFI_ADJUST(-8); CFI_SAME_VALUE(r12); \
+        popq    %rdi; CFI_ADJUST(-8); CFI_SAME_VALUE(rdi); \
+        popq    %rsi; CFI_ADJUST(-8); CFI_SAME_VALUE(rsi); \
+        popq    %rbp; CFI_ADJUST(-8); CFI_SAME_VALUE(rbp); \
+        popq    %rbx; CFI_ADJUST(-8); CFI_SAME_VALUE(rbx)
+
+#else
+
+/* Unix API: callee-save regs are rbx, rbp, r12-r15 */
+
+#define PUSH_CALLEE_SAVE_REGS \
+        pushq   %rbx; CFI_ADJUST(8); CFI_OFFSET(rbx, -16); \
+        pushq   %rbp; CFI_ADJUST(8); CFI_OFFSET(rbp, -24); \
+        pushq   %r12; CFI_ADJUST(8); CFI_OFFSET(r12, -32); \
+        pushq   %r13; CFI_ADJUST(8); CFI_OFFSET(r13, -40); \
+        pushq   %r14; CFI_ADJUST(8); CFI_OFFSET(r14, -48); \
+        pushq   %r15; CFI_ADJUST(8); CFI_OFFSET(r15, -56); \
+        subq    $8, %rsp; CFI_ADJUST(8)
+
+#define POP_CALLEE_SAVE_REGS \
+        addq    $8, %rsp; CFI_ADJUST(-8); \
+        popq    %r15; CFI_ADJUST(-8); CFI_SAME_VALUE(r15); \
+        popq    %r14; CFI_ADJUST(-8); CFI_SAME_VALUE(r14); \
+        popq    %r13; CFI_ADJUST(-8); CFI_SAME_VALUE(r13); \
+        popq    %r12; CFI_ADJUST(-8); CFI_SAME_VALUE(r12); \
+        popq    %rbp; CFI_ADJUST(-8); CFI_SAME_VALUE(rbp); \
+        popq    %rbx; CFI_ADJUST(-8); CFI_SAME_VALUE(rbx)
+
+#endif
+
+#if defined(SYS_mingw64) || defined (SYS_cygwin)
+   /* Calls from OCaml to C must reserve 32 bytes of extra stack space */
+#  define PREPARE_FOR_C_CALL subq $32, %rsp; CFI_ADJUST(32)
+#  define CLEANUP_AFTER_C_CALL addq $32, %rsp; CFI_ADJUST(-32)
+   /* Stack probing mustn't be larger than the page size */
+#  define STACK_PROBE_SIZE 4096
+#else
+#  define PREPARE_FOR_C_CALL
+#  define CLEANUP_AFTER_C_CALL
+#  define STACK_PROBE_SIZE 4096
+#endif
+
+/* Registers holding arguments of C functions. */
+
+#if defined(SYS_mingw64) || defined(SYS_cygwin)
+#define C_ARG_1 %rcx
+#define C_ARG_2 %rdx
+#define C_ARG_3 %r8
+#define C_ARG_4 %r9
+#else
+#define C_ARG_1 %rdi
+#define C_ARG_2 %rsi
+#define C_ARG_3 %rdx
+#define C_ARG_4 %rcx
+#endif
+
+#if defined(FUNCTION_SECTIONS)
+        TEXT_SECTION(caml_hot__code_begin)
+        .globl  G(caml_hot__code_begin)
+G(caml_hot__code_begin):
+
+        TEXT_SECTION(caml_hot__code_end)
+        .globl  G(caml_hot__code_end)
+G(caml_hot__code_end):
+#endif
+
+        .text
+
+        .globl  G(caml_system__code_begin)
+G(caml_system__code_begin):
+        ret  /* just one instruction, so that debuggers don't display
+        caml_system__code_begin instead of caml_call_gc */
+
+/* Allocation */
+
+FUNCTION(G(caml_call_gc))
+        CFI_STARTPROC
+LBL(caml_call_gc):
+    /* Record lowest stack address and return address. */
+        movq    (%rsp), %r11
+        movq    %r11, Caml_state(last_return_address)
+        leaq    8(%rsp), %r11
+        movq    %r11, Caml_state(bottom_of_stack)
+    /* Touch the stack to trigger a recoverable segfault
+       if insufficient space remains */
+        subq    $(STACK_PROBE_SIZE), %rsp; CFI_ADJUST(STACK_PROBE_SIZE);
+        movq    %r11, 0(%rsp)
+        addq    $(STACK_PROBE_SIZE), %rsp; CFI_ADJUST(-STACK_PROBE_SIZE);
+    /* Build array of registers, save it into Caml_state->gc_regs */
+#ifdef WITH_FRAME_POINTERS
+        ENTER_FUNCTION          ;
+#else
+        pushq   %rbp; CFI_ADJUST(8);
+#endif
+        pushq   %r11; CFI_ADJUST (8);
+        pushq   %r10; CFI_ADJUST (8);
+        pushq   %r13; CFI_ADJUST (8);
+        pushq   %r12; CFI_ADJUST (8);
+        pushq   %r9; CFI_ADJUST (8);
+        pushq   %r8; CFI_ADJUST (8);
+        pushq   %rcx; CFI_ADJUST (8);
+        pushq   %rdx; CFI_ADJUST (8);
+        pushq   %rsi; CFI_ADJUST (8);
+        pushq   %rdi; CFI_ADJUST (8);
+        pushq   %rbx; CFI_ADJUST (8);
+        pushq   %rax; CFI_ADJUST (8);
+        movq    %rsp, Caml_state(gc_regs)
+    /* Save young_ptr */
+        movq    %r15, Caml_state(young_ptr)
+#ifdef WITH_SPACETIME
+        STORE_VAR(%r13, caml_spacetime_trie_node_ptr)
+#endif
+    /* Save floating-point registers */
+        subq    $(16*8), %rsp; CFI_ADJUST (16*8);
+        movsd   %xmm0, 0*8(%rsp)
+        movsd   %xmm1, 1*8(%rsp)
+        movsd   %xmm2, 2*8(%rsp)
+        movsd   %xmm3, 3*8(%rsp)
+        movsd   %xmm4, 4*8(%rsp)
+        movsd   %xmm5, 5*8(%rsp)
+        movsd   %xmm6, 6*8(%rsp)
+        movsd   %xmm7, 7*8(%rsp)
+        movsd   %xmm8, 8*8(%rsp)
+        movsd   %xmm9, 9*8(%rsp)
+        movsd   %xmm10, 10*8(%rsp)
+        movsd   %xmm11, 11*8(%rsp)
+        movsd   %xmm12, 12*8(%rsp)
+        movsd   %xmm13, 13*8(%rsp)
+        movsd   %xmm14, 14*8(%rsp)
+        movsd   %xmm15, 15*8(%rsp)
+    /* Call the garbage collector */
+        PREPARE_FOR_C_CALL
+        call    GCALL(caml_garbage_collection)
+        CLEANUP_AFTER_C_CALL
+    /* Restore young_ptr */
+        movq    Caml_state(young_ptr), %r15
+    /* Restore all regs used by the code generator */
+        movsd   0*8(%rsp), %xmm0
+        movsd   1*8(%rsp), %xmm1
+        movsd   2*8(%rsp), %xmm2
+        movsd   3*8(%rsp), %xmm3
+        movsd   4*8(%rsp), %xmm4
+        movsd   5*8(%rsp), %xmm5
+        movsd   6*8(%rsp), %xmm6
+        movsd   7*8(%rsp), %xmm7
+        movsd   8*8(%rsp), %xmm8
+        movsd   9*8(%rsp), %xmm9
+        movsd   10*8(%rsp), %xmm10
+        movsd   11*8(%rsp), %xmm11
+        movsd   12*8(%rsp), %xmm12
+        movsd   13*8(%rsp), %xmm13
+        movsd   14*8(%rsp), %xmm14
+        movsd   15*8(%rsp), %xmm15
+        addq    $(16*8), %rsp; CFI_ADJUST(-16*8)
+        popq    %rax; CFI_ADJUST(-8)
+        popq    %rbx; CFI_ADJUST(-8)
+        popq    %rdi; CFI_ADJUST(-8)
+        popq    %rsi; CFI_ADJUST(-8)
+        popq    %rdx; CFI_ADJUST(-8)
+        popq    %rcx; CFI_ADJUST(-8)
+        popq    %r8; CFI_ADJUST(-8)
+        popq    %r9; CFI_ADJUST(-8)
+        popq    %r12; CFI_ADJUST(-8)
+        popq    %r13; CFI_ADJUST(-8)
+        popq    %r10; CFI_ADJUST(-8)
+        popq    %r11; CFI_ADJUST(-8)
+#ifdef WITH_FRAME_POINTERS
+        LEAVE_FUNCTION
+#else
+        popq    %rbp; CFI_ADJUST(-8);
+#endif
+    /* Return to caller */
+        ret
+CFI_ENDPROC
+ENDFUNCTION(G(caml_call_gc))
+
+FUNCTION(G(caml_alloc1))
+CFI_STARTPROC
+        subq    $16, %r15
+        cmpq    Caml_state(young_limit), %r15
+        jb      LBL(caml_call_gc)
+        ret
+CFI_ENDPROC
+ENDFUNCTION(G(caml_alloc1))
+
+FUNCTION(G(caml_alloc2))
+CFI_STARTPROC
+        subq    $24, %r15
+        cmpq    Caml_state(young_limit), %r15
+        jb      LBL(caml_call_gc)
+        ret
+CFI_ENDPROC
+ENDFUNCTION(G(caml_alloc2))
+
+FUNCTION(G(caml_alloc3))
+CFI_STARTPROC
+        subq    $32, %r15
+        cmpq    Caml_state(young_limit), %r15
+        jb      LBL(caml_call_gc)
+        ret
+CFI_ENDPROC
+ENDFUNCTION(G(caml_alloc3))
+
+FUNCTION(G(caml_allocN))
+CFI_STARTPROC
+        cmpq    Caml_state(young_limit), %r15
+        jb      LBL(caml_call_gc)
+        ret
+CFI_ENDPROC
+ENDFUNCTION(G(caml_allocN))
+
+/* Call a C function from OCaml */
+
+FUNCTION(G(caml_c_call))
+CFI_STARTPROC
+LBL(caml_c_call):
+    /* Record lowest stack address and return address */
+        popq    Caml_state(last_return_address); CFI_ADJUST(-8)
+        movq    %rsp, Caml_state(bottom_of_stack)
+    /* equivalent to pushing last return address */
+        subq    $8, %rsp; CFI_ADJUST(8)
+#ifdef WITH_SPACETIME
+    /* Record the trie node hole pointer that corresponds to
+       [Caml_state->last_return_address] */
+        STORE_VAR(%r13, caml_spacetime_trie_node_ptr)
+#endif
+    /* Touch the stack to trigger a recoverable segfault
+       if insufficient space remains */
+        subq    $(STACK_PROBE_SIZE), %rsp; CFI_ADJUST(STACK_PROBE_SIZE);
+        movq    %rax, 0(%rsp)
+        addq    $(STACK_PROBE_SIZE), %rsp; CFI_ADJUST(-STACK_PROBE_SIZE);
+    /* Make the alloc ptr available to the C code */
+        movq    %r15, Caml_state(young_ptr)
+    /* Call the function (address in %rax) */
+    /* No need to PREPARE_FOR_C_CALL since the caller already
+       reserved the stack space if needed (cf. amd64/proc.ml) */
+        jmp    *%rax
+CFI_ENDPROC
+ENDFUNCTION(G(caml_c_call))
+
+/* Start the OCaml program */
+
+FUNCTION(G(caml_start_program))
+       CFI_STARTPROC
+    /* Save callee-save registers */
+        PUSH_CALLEE_SAVE_REGS
+    /* Load Caml_state into r14 (was passed as an argument from C) */
+        movq    C_ARG_1, %r14
+    /* Initial entry point is G(caml_program) */
+        LEA_VAR(caml_program, %r12)
+    /* Common code for caml_start_program and caml_callback* */
+LBL(caml_start_program):
+    /* Build a callback link */
+#ifdef WITH_SPACETIME
+        PUSH_VAR(caml_spacetime_trie_node_ptr)
+#else
+        subq    $8, %rsp; CFI_ADJUST (8)        /* stack 16-aligned */
+#endif
+        pushq   Caml_state(gc_regs); CFI_ADJUST(8)
+        pushq   Caml_state(last_return_address); CFI_ADJUST(8)
+        pushq   Caml_state(bottom_of_stack); CFI_ADJUST(8)
+#ifdef WITH_SPACETIME
+        /* Save arguments to caml_callback* */
+        pushq   %rax; CFI_ADJUST (8)
+        pushq   %rbx; CFI_ADJUST (8)
+        pushq   %rdi; CFI_ADJUST (8)
+        pushq   %rsi; CFI_ADJUST (8)
+        /* No need to push %r12: it's callee-save. */
+        movq    %r12, C_ARG_1
+        LEA_VAR(caml_start_program, C_ARG_2)
+        call    GCALL(caml_spacetime_c_to_ocaml)
+        popq    %rsi; CFI_ADJUST (-8)
+        popq    %rdi; CFI_ADJUST (-8)
+        popq    %rbx; CFI_ADJUST (-8)
+        popq    %rax; CFI_ADJUST (-8)
+#endif
+    /* Setup alloc ptr */
+        movq    Caml_state(young_ptr), %r15
+    /* Build an exception handler */
+        lea     LBL(108)(%rip), %r13
+        pushq   %r13; CFI_ADJUST(8)
+        pushq   Caml_state(exception_pointer); CFI_ADJUST(8)
+        movq    %rsp, Caml_state(exception_pointer)
+#ifdef WITH_SPACETIME
+        LOAD_VAR(caml_spacetime_trie_node_ptr, %r13)
+#endif
+    /* Call the OCaml code */
+        call    *%r12
+LBL(107):
+    /* Pop the exception handler */
+        popq    Caml_state(exception_pointer); CFI_ADJUST(-8)
+        popq    %r12; CFI_ADJUST(-8)   /* dummy register */
+LBL(109):
+    /* Update alloc ptr */
+        movq    %r15, Caml_state(young_ptr)
+    /* Pop the callback link, restoring the global variables */
+        popq    Caml_state(bottom_of_stack); CFI_ADJUST(-8)
+        popq    Caml_state(last_return_address); CFI_ADJUST(-8)
+        popq    Caml_state(gc_regs); CFI_ADJUST(-8)
+#ifdef WITH_SPACETIME
+        POP_VAR(caml_spacetime_trie_node_ptr)
+#else
+        addq    $8, %rsp; CFI_ADJUST (-8);
+#endif
+    /* Restore callee-save registers. */
+        POP_CALLEE_SAVE_REGS
+    /* Return to caller. */
+        ret
+LBL(108):
+    /* Exception handler*/
+    /* Mark the bucket as an exception result and return it */
+        orq     $2, %rax
+        jmp     LBL(109)
+CFI_ENDPROC
+ENDFUNCTION(G(caml_start_program))
+
+/* Raise an exception from OCaml */
+
+FUNCTION(G(caml_raise_exn))
+CFI_STARTPROC
+        testq   $1, Caml_state(backtrace_active)
+        jne     LBL(110)
+        movq    Caml_state(exception_pointer), %rsp
+        popq    Caml_state(exception_pointer); CFI_ADJUST(-8)
+        ret
+LBL(110):
+        movq    %rax, %r12            /* Save exception bucket */
+        movq    %rax, C_ARG_1         /* arg 1: exception bucket */
+#ifdef WITH_FRAME_POINTERS
+        ENTER_FUNCTION
+        movq    8(%rsp), C_ARG_2      /* arg 2: pc of raise */
+        leaq    16(%rsp), C_ARG_3     /* arg 3: sp at raise */
+#else
+        popq    C_ARG_2               /* arg 2: pc of raise */
+        movq    %rsp, C_ARG_3         /* arg 3: sp at raise */
+#endif
+        /* arg 4: sp of handler */
+        movq    Caml_state(exception_pointer), C_ARG_4
+        /* PR#5700: thanks to popq above, stack is now 16-aligned */
+        /* Thanks to ENTER_FUNCTION, stack is now 16-aligned */
+        PREPARE_FOR_C_CALL            /* no need to cleanup after */
+        call    GCALL(caml_stash_backtrace)
+        movq    %r12, %rax            /* Recover exception bucket */
+        movq    Caml_state(exception_pointer), %rsp
+        popq    Caml_state(exception_pointer); CFI_ADJUST(-8)
+        ret
+CFI_ENDPROC
+ENDFUNCTION(G(caml_raise_exn))
+
+/* Raise an exception from C */
+
+FUNCTION(G(caml_raise_exception))
+CFI_STARTPROC
+        movq    C_ARG_1, %r14   /* Caml_state */
+        testq   $1, Caml_state(backtrace_active)
+        jne     LBL(112)
+        movq    C_ARG_2, %rax
+        movq    Caml_state(exception_pointer), %rsp  /* Cut stack */
+        /* Recover previous exception handler */
+        popq    Caml_state(exception_pointer); CFI_ADJUST(-8)
+        movq    Caml_state(young_ptr), %r15 /* Reload alloc ptr */
+        ret
+LBL(112):
+#ifdef WITH_FRAME_POINTERS
+        ENTER_FUNCTION          ;
+#endif
+        /* Save exception bucket. Caml_state in r14 saved across C calls. */
+        movq    C_ARG_2, %r12
+        /* arg 1: exception bucket */
+        movq    C_ARG_2, C_ARG_1
+        /* arg 2: pc of raise */
+        movq    Caml_state(last_return_address), C_ARG_2
+        /* arg 3: sp of raise */
+        movq    Caml_state(bottom_of_stack), C_ARG_3
+        /* arg 4: sp of handler */
+        movq    Caml_state(exception_pointer), C_ARG_4
+#ifndef WITH_FRAME_POINTERS
+        subq    $8, %rsp              /* PR#5700: maintain stack alignment */
+#endif
+        PREPARE_FOR_C_CALL            /* no need to cleanup after */
+        call    GCALL(caml_stash_backtrace)
+        movq    %r12, %rax            /* Recover exception bucket */
+        movq    Caml_state(exception_pointer), %rsp
+     /* Recover previous exception handler */
+        popq    Caml_state(exception_pointer); CFI_ADJUST(-8)
+        movq    Caml_state(young_ptr), %r15 /* Reload alloc ptr */
+        ret
+CFI_ENDPROC
+ENDFUNCTION(G(caml_raise_exception))
+
+/* Raise a Stack_overflow exception on return from segv_handler()
+   (in runtime/signals_nat.c).  On entry, the stack is full, so we
+   cannot record a backtrace.
+   No CFI information here since this function disrupts the stack
+   backtrace anyway. */
+
+FUNCTION(G(caml_stack_overflow))
+        movq    C_ARG_1, %r14                 /* Caml_state */
+        LEA_VAR(caml_exn_Stack_overflow, %rax)
+        movq    Caml_state(exception_pointer), %rsp /* cut the stack */
+     /* Recover previous exn handler */
+        popq    Caml_state(exception_pointer)
+        ret                                   /* jump to handler's code */
+ENDFUNCTION(G(caml_stack_overflow))
+
+/* Callback from C to OCaml */
+
+FUNCTION(G(caml_callback_asm))
+CFI_STARTPROC
+    /* Save callee-save registers */
+        PUSH_CALLEE_SAVE_REGS
+    /* Initial loading of arguments */
+        movq    C_ARG_1, %r14      /* Caml_state */
+        movq    C_ARG_2, %rbx      /* closure */
+        movq    0(C_ARG_3), %rax   /* argument */
+        movq    0(%rbx), %r12      /* code pointer */
+        jmp     LBL(caml_start_program)
+CFI_ENDPROC
+ENDFUNCTION(G(caml_callback_asm))
+
+FUNCTION(G(caml_callback2_asm))
+CFI_STARTPROC
+    /* Save callee-save registers */
+        PUSH_CALLEE_SAVE_REGS
+    /* Initial loading of arguments */
+        movq    C_ARG_1, %r14      /* Caml_state */
+        movq    C_ARG_2, %rdi      /* closure */
+        movq    0(C_ARG_3), %rax   /* first argument */
+        movq    8(C_ARG_3), %rbx   /* second argument */
+        LEA_VAR(caml_apply2, %r12) /* code pointer */
+        jmp     LBL(caml_start_program)
+CFI_ENDPROC
+ENDFUNCTION(G(caml_callback2_asm))
+
+FUNCTION(G(caml_callback3_asm))
+CFI_STARTPROC
+    /* Save callee-save registers */
+        PUSH_CALLEE_SAVE_REGS
+    /* Initial loading of arguments */
+        movq    C_ARG_1, %r14      /* Caml_state */
+        movq    0(C_ARG_3), %rax   /* first argument */
+        movq    8(C_ARG_3), %rbx   /* second argument */
+        movq    C_ARG_2, %rsi      /* closure */
+        movq    16(C_ARG_3), %rdi  /* third argument */
+        LEA_VAR(caml_apply3, %r12) /* code pointer */
+        jmp     LBL(caml_start_program)
+CFI_ENDPROC
+ENDFUNCTION(G(caml_callback3_asm))
+
+FUNCTION(G(caml_ml_array_bound_error))
+CFI_STARTPROC
+        LEA_VAR(caml_array_bound_error, %rax)
+        jmp     LBL(caml_c_call)
+CFI_ENDPROC
+ENDFUNCTION(G(caml_ml_array_bound_error))
+
+        .globl  G(caml_system__code_end)
+G(caml_system__code_end):
+
+        .data
+        .globl  G(caml_system__frametable)
+        .align  EIGHT_ALIGN
+G(caml_system__frametable):
+        .quad   1           /* one descriptor */
+        .quad   LBL(107)    /* return address into callback */
+        .value  -1          /* negative frame size => use callback link */
+        .value  0           /* no roots here */
+        .align  EIGHT_ALIGN
+        .quad   16
+        .quad   0
+        .string "amd64.S"
+
+#ifdef WITH_SPACETIME
+        .data
+        .globl  G(caml_system__spacetime_shapes)
+        .align  EIGHT_ALIGN
+G(caml_system__spacetime_shapes):
+        .quad   G(caml_start_program)
+        .quad   2           /* indirect call point to OCaml code */
+        .quad   LBL(107)    /* in caml_start_program / caml_callback* */
+        .quad   0           /* end of shapes for caml_start_program */
+        .quad   0           /* end of shape table */
+        .align  EIGHT_ALIGN
+#endif
+
+#if defined(SYS_macosx)
+        .literal16
+#elif defined(SYS_mingw64) || defined(SYS_cygwin)
+        .section .rdata,"dr"
+#else
+        .section    .rodata.cst8,"a",@progbits
+#endif
+        .globl  G(caml_negf_mask)
+        .align  SIXTEEN_ALIGN
+G(caml_negf_mask):
+        .quad   0x8000000000000000, 0
+        .globl  G(caml_absf_mask)
+        .align  SIXTEEN_ALIGN
+G(caml_absf_mask):
+        .quad   0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF
+
+#if defined(SYS_linux)
+    /* Mark stack as non-executable, PR#4564 */
+        .section .note.GNU-stack,"",%progbits
+#endif
diff --git a/runtime/amd64nt.asm b/runtime/amd64nt.asm
new file mode 100644
index 00000000..d34631ab
--- /dev/null
+++ b/runtime/amd64nt.asm
@@ -0,0 +1,499 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *
+;*                                                                        *
+;*   Copyright 2006 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.          *
+;*                                                                        *
+;**************************************************************************
+
+; Asm part of the runtime system, AMD64 processor, Intel syntax
+
+; Notes on Win64 calling conventions:
+;     function arguments in RCX, RDX, R8, R9 / XMM0 - XMM3
+;     caller must reserve 32 bytes of stack space
+;     callee must preserve RBX, RBP, RSI, RDI, R12-R15, XMM6-XMM15
+
+        EXTRN  caml_garbage_collection: NEAR
+        EXTRN  caml_apply2: NEAR
+        EXTRN  caml_apply3: NEAR
+        EXTRN  caml_program: NEAR
+        EXTRN  caml_array_bound_error: NEAR
+       EXTRN  caml_stash_backtrace: NEAR
+IFDEF WITH_SPACETIME
+        EXTRN  caml_spacetime_trie_node_ptr: QWORD
+        EXTRN  caml_spacetime_c_to_ocaml: NEAR
+ENDIF
+
+INCLUDE domain_state64.inc
+
+        .CODE
+
+        PUBLIC  caml_system__code_begin
+caml_system__code_begin:
+        ret  ; just one instruction, so that debuggers don't display
+             ; caml_system__code_begin instead of caml_call_gc
+
+; Allocation
+
+        PUBLIC  caml_call_gc
+        ALIGN   16
+caml_call_gc:
+    ; Record lowest stack address and return address
+        mov     r11, [rsp]
+        Store_last_return_address r11
+        lea     r11, [rsp+8]
+        Store_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
+        Store_young_ptr r15
+IFDEF WITH_SPACETIME
+        mov     caml_spacetime_trie_node_ptr, r13
+ENDIF
+    ; 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
+        Store_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
+    ; 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)
+        Load_young_ptr r15
+    ; Return to caller
+        ret
+
+        PUBLIC  caml_alloc1
+        ALIGN   16
+caml_alloc1:
+        sub     r15, 16
+        Cmp_young_limit r15
+        jb      caml_call_gc
+        ret
+
+        PUBLIC  caml_alloc2
+        ALIGN   16
+caml_alloc2:
+        sub     r15, 24
+        Cmp_young_limit r15
+        jb      caml_call_gc
+        ret
+
+        PUBLIC  caml_alloc3
+        ALIGN   16
+caml_alloc3:
+        sub     r15, 32
+        Cmp_young_limit r15
+        jb      caml_call_gc
+        ret
+
+        PUBLIC  caml_allocN
+        ALIGN   16
+caml_allocN:
+        Cmp_young_limit r15
+        jb      caml_call_gc
+        ret
+
+; Call a C function from OCaml
+
+        PUBLIC  caml_c_call
+        ALIGN   16
+caml_c_call:
+    ; Record lowest stack address and return address
+        pop     r12
+        Store_last_return_address r12
+        Store_bottom_of_stack rsp
+IFDEF WITH_SPACETIME
+    ; Record the trie node hole pointer that corresponds to
+    ; [Caml_state(last_return_address)]
+        mov     caml_spacetime_trie_node_ptr, r13
+ENDIF
+    ; Touch the stack to trigger a recoverable segfault
+    ; if insufficient space remains
+        sub     rsp, 01000h
+        mov     [rsp], rax
+        add     rsp, 01000h
+    ; Make the alloc ptr available to the C code
+        Store_young_ptr r15
+    ; Call the function (address in rax)
+        call    rax
+    ; Reload alloc ptr
+        Load_young_ptr r15
+    ; Return to caller
+        push    r12
+        ret
+
+; Start the OCaml program
+
+        PUBLIC  caml_start_program
+        ALIGN   16
+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
+    ; 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
+IFDEF WITH_SPACETIME
+        push    caml_spacetime_trie_node_ptr
+ELSE
+        sub     rsp, 8  ; stack 16-aligned
+ENDIF
+        Push_gc_regs
+        Push_last_return_address
+        Push_bottom_of_stack
+IFDEF WITH_SPACETIME
+    ; Save arguments to caml_callback
+        push    rax
+        push    rbx
+        push    rdi
+        push    rsi
+    ; No need to push r12: it is callee-save.
+        mov     rcx, r12
+        lea     rdx, caml_start_program
+        call    caml_spacetime_c_to_ocaml
+        pop     rsi
+        pop     rdi
+        pop     rbx
+        pop     rax
+ENDIF
+    ; Setup alloc ptr
+        Load_young_ptr r15
+    ; Build an exception handler
+        lea     r13, L108
+        push    r13
+        Push_exception_pointer
+        Store_exception_pointer rsp
+IFDEF WITH_SPACETIME
+        mov     r13, caml_spacetime_trie_node_ptr
+ENDIF
+    ; Call the OCaml code
+        call    r12
+L107:
+    ; Pop the exception handler
+        Pop_exception_pointer
+        pop     r12    ; dummy register
+L109:
+    ; Update alloc ptr
+        Store_young_ptr r15
+    ; Pop the callback restoring, link the global variables
+        Pop_bottom_of_stack
+        Pop_last_return_address
+        Pop_gc_regs
+IFDEF WITH_SPACETIME
+        pop     caml_spacetime_trie_node_ptr
+ELSE
+        add     rsp, 8
+ENDIF
+    ; 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
+    ; Return to caller
+        ret
+L108:
+    ; Exception handler
+    ; Mark the bucket as an exception result and return it
+        or      rax, 2
+        jmp     L109
+
+; Raise an exception from OCaml
+
+        PUBLIC  caml_raise_exn
+        ALIGN   16
+caml_raise_exn:
+        Load_backtrace_active r11
+        test    r11, 1
+        jne     L110
+        Load_exception_pointer rsp ; Cut stack
+    ; Recover previous exception handler
+        Pop_exception_pointer
+        ret                                        ; Branch to handler
+L110:
+        mov     r12, rax             ; Save exception bucket in r12
+        mov     rcx, rax             ; Arg 1: exception bucket
+        mov     rdx, [rsp]           ; Arg 2: PC of raise
+        lea     r8, [rsp+8]          ; Arg 3: SP of raise
+        Load_exception_pointer r9    ; Arg 4: SP of handler
+        sub     rsp, 32              ; Reserve 32 bytes on stack
+        call    caml_stash_backtrace
+        mov     rax, r12             ; Recover exception bucket
+        Load_exception_pointer rsp ; Cut stack
+    ; Recover previous exception handler
+        Pop_exception_pointer
+        ret                          ; Branch to handler
+
+; Raise an exception from C
+
+        PUBLIC  caml_raise_exception
+        ALIGN   16
+caml_raise_exception:
+        mov     r14, rcx             ; First argument is Caml_state
+        Load_backtrace_active r11
+        test    r11, 1
+        jne     L112
+        mov     rax, rdx             ; Second argument is exn bucket
+        Load_exception_pointer rsp
+    ; Recover previous exception handler
+        Pop_exception_pointer
+        Load_young_ptr r15           ; Reload alloc ptr
+        ret
+L112:
+        mov     r12, rdx             ; Save exception bucket in r12
+        mov     rcx, rdx             ; Arg 1: exception bucket
+        Load_last_return_address rdx ; Arg 2: PC of raise
+        Load_bottom_of_stack r8      ; Arg 3: SP of raise
+        Load_exception_pointer r9    ; Arg 4: SP of handler
+        sub     rsp, 32              ; Reserve 32 bytes on stack
+        call    caml_stash_backtrace
+        mov     rax, r12             ; Recover exception bucket
+        Load_exception_pointer rsp
+    ; Recover previous exception handler
+        Pop_exception_pointer
+        Load_young_ptr r15; Reload alloc ptr
+        ret
+
+; Callback from C to OCaml
+
+        PUBLIC  caml_callback_asm
+        ALIGN   16
+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
+    ; Initial loading of arguments
+        mov     r14, rcx      ; Caml_state
+        mov     rbx, rdx      ; closure
+        mov     rax, [r8]     ; argument
+        mov     r12, [rbx]    ; code pointer
+        jmp     L106
+
+        PUBLIC  caml_callback2_asm
+        ALIGN   16
+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
+    ; Initial loading of arguments
+        mov     r14, rcx        ; Caml_state
+        mov     rdi, rdx        ; closure
+        mov     rax, [r8]       ; first argument
+        mov     rbx, [r8 + 8]   ; second argument
+        lea     r12, caml_apply2  ; code pointer
+        jmp     L106
+
+        PUBLIC  caml_callback3_asm
+        ALIGN   16
+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
+    ; Initial loading of arguments
+        mov     r14, rcx        ; Caml_state
+        mov     rsi, rdx        ; closure
+        mov     rax, [r8]       ; first argument
+        mov     rbx, [r8 + 8]   ; second argument
+        mov     rdi, [r8 + 16]  ; third argument
+        lea     r12, caml_apply3      ; code pointer
+        jmp     L106
+
+        PUBLIC  caml_ml_array_bound_error
+        ALIGN   16
+caml_ml_array_bound_error:
+        lea     rax, caml_array_bound_error
+        jmp     caml_c_call
+
+        PUBLIC caml_system__code_end
+caml_system__code_end:
+
+        .DATA
+        PUBLIC  caml_system__frametable
+caml_system__frametable LABEL QWORD
+        QWORD   1           ; one descriptor
+        QWORD   L107        ; return address into callback
+        WORD    -1          ; negative frame size => use callback link
+        WORD    0           ; no roots here
+        ALIGN   8
+
+IFDEF WITH_SPACETIME
+        .DATA
+        PUBLIC  caml_system__spacetime_shapes
+        ALIGN   8
+caml_system__spacetime_shapes LABEL QWORD
+        QWORD   caml_start_program
+        QWORD   2         ; indirect call point to OCaml code
+        QWORD   L107      ; in caml_start_program / caml_callback*
+        QWORD   0         ; end of shapes in caml_start_program
+        QWORD   0         ; end of shape table
+        ALIGN   8
+ENDIF
+
+        PUBLIC  caml_negf_mask
+        ALIGN   16
+caml_negf_mask LABEL QWORD
+        QWORD   8000000000000000H, 0
+
+        PUBLIC  caml_absf_mask
+        ALIGN   16
+caml_absf_mask LABEL QWORD
+        QWORD   7FFFFFFFFFFFFFFFH, 0FFFFFFFFFFFFFFFFH
+
+        END
diff --git a/runtime/arm.S b/runtime/arm.S
new file mode 100644
index 00000000..85ebb84e
--- /dev/null
+++ b/runtime/arm.S
@@ -0,0 +1,445 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                 Benedikt Meurer, University of Siegen                  */
+/*                                                                        */
+/*   Copyright 1998 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*   Copyright 2012 Benedikt Meurer.                                      */
+/*                                                                        */
+/*   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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Asm part of the runtime system, ARM processor */
+/* Must be preprocessed by cpp */
+
+#include "caml/m.h"
+
+        .syntax unified
+        .text
+#if defined(SYS_linux_eabihf) && defined(MODEL_armv6)
+        .arch   armv6
+        .fpu    vfpv2
+        .arm
+
+    /* Compatibility macros */
+        .macro  cbz reg, lbl
+        cmp     \reg, #0
+        beq     \lbl
+        .endm
+#elif defined(SYS_linux_eabihf)
+        .arch   armv7-a
+        .fpu    vfpv3-d16
+        .thumb
+#elif defined(SYS_linux_eabi)
+        .arch   armv4t
+        .arm
+
+    /* Compatibility macros */
+        .macro  blx reg
+        mov     lr, pc
+        bx      \reg
+        .endm
+        .macro  cbz reg, lbl
+        cmp     \reg, #0
+        beq     \lbl
+        .endm
+#elif defined(SYS_netbsd)
+
+  #if defined(MODEL_armv6)
+        .arch   armv6
+        .fpu    vfpv2
+        .arm
+
+    /* Compatibility macros */
+        .macro  cbz reg, lbl
+        cmp     \reg, #0
+        beq     \lbl
+        .endm
+  #elif defined(MODEL_armv7)
+        .arch   armv7-a
+        .fpu    vfpv3-d16
+        .thumb
+  #else
+    #error "Only NetBSD eabihf supported"
+  #endif
+
+#elif defined(SYS_freebsd)
+        .arch   armv6
+        .arm
+
+    /* Compatibility macros */
+        .macro  cbz reg, lbl
+        cmp     \reg, #0
+        beq     \lbl
+        .endm
+#endif
+
+trap_ptr          .req    r8
+alloc_ptr         .req    r10
+domain_state_ptr  .req    r11
+
+/* 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
+#else
+#define CFI_STARTPROC
+#define CFI_ENDPROC
+#define CFI_ADJUST(n)
+#define CFI_REGISTER(r1,r2)
+#define CFI_OFFSET(r,n)
+#endif
+
+#if defined(FUNCTION_SECTIONS)
+#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
+#else
+#define TEXT_SECTION(name)
+#endif
+
+#define FUNCTION(name) \
+        TEXT_SECTION(caml.##name); \
+        .align 2; \
+        .globl name; \
+        .type name, %function; \
+name:
+
+#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
+
+        .set    domain_curr_field, 0
+#define DOMAIN_STATE(c_type, name) \
+        .equ    domain_field_caml_##name, domain_curr_field ; \
+        .set    domain_curr_field, domain_curr_field + 1
+#include "../runtime/caml/domain_state.tbl"
+#undef DOMAIN_STATE
+
+#define Caml_state(var) [domain_state_ptr, 8*domain_field_caml_##var]
+
+/* Allocation functions and GC interface */
+        .globl  caml_system__code_begin
+caml_system__code_begin:
+
+FUNCTION(caml_call_gc)
+        CFI_STARTPROC
+.Lcaml_call_gc:
+    /* Record return address */
+        str     lr, Caml_state(last_return_address)
+    /* Record lowest stack address */
+        str     sp, Caml_state(bottom_of_stack)
+#if defined(SYS_linux_eabihf) || defined(SYS_netbsd)
+    /* Save caller floating-point registers on the stack */
+        vpush   {d0-d7}; CFI_ADJUST(64)
+#endif
+    /* Save integer registers and return address on the stack */
+        push    {r0-r7,r12,lr}; CFI_ADJUST(40)
+#if defined(SYS_linux_eabihf) || defined(SYS_netbsd)
+        CFI_OFFSET(lr, -68)
+#else
+        CFI_OFFSET(lr, -4)
+#endif
+    /* Store pointer to saved integer registers in Caml_state->gc_regs */
+        str     sp, Caml_state(gc_regs)
+    /* Save current allocation pointer for debugging purposes */
+        str     alloc_ptr, Caml_state(young_ptr)
+    /* Save trap pointer in case an exception is raised during GC */
+        str     trap_ptr, Caml_state(exception_pointer)
+    /* Call the garbage collector */
+        bl      caml_garbage_collection
+    /* Restore integer registers and return address from the stack */
+        pop     {r0-r7,r12,lr}; CFI_ADJUST(-40)
+#if defined(SYS_linux_eabihf) || defined(SYS_netbsd)
+    /* Restore floating-point registers from the stack */
+        vpop    {d0-d7}; CFI_ADJUST(-64)
+#endif
+    /* Reload new allocation pointer */
+        ldr     alloc_ptr, Caml_state(young_ptr)
+    /* Return to caller */
+        bx      lr
+        CFI_ENDPROC
+        .size   caml_call_gc, .-caml_call_gc
+
+FUNCTION(caml_alloc1)
+        CFI_STARTPROC
+        sub     alloc_ptr, alloc_ptr, 8
+        ldr     r7, Caml_state(young_limit)
+        cmp     alloc_ptr, r7
+        bcc     .Lcaml_call_gc
+        bx      lr
+        CFI_ENDPROC
+        .size   caml_alloc1, .-caml_alloc1
+
+FUNCTION(caml_alloc2)
+        CFI_STARTPROC
+        sub     alloc_ptr, alloc_ptr, 12
+        ldr     r7, Caml_state(young_limit)
+        cmp     alloc_ptr, r7
+        bcc     .Lcaml_call_gc
+        bx      lr
+        CFI_ENDPROC
+        .size   caml_alloc2, .-caml_alloc2
+
+FUNCTION(caml_alloc3)
+        CFI_STARTPROC
+        sub     alloc_ptr, alloc_ptr, 16
+        ldr     r7, Caml_state(young_limit)
+        cmp     alloc_ptr, r7
+        bcc     .Lcaml_call_gc
+        bx      lr
+        CFI_ENDPROC
+        .size   caml_alloc3, .-caml_alloc3
+
+FUNCTION(caml_allocN)
+        CFI_STARTPROC
+        sub     alloc_ptr, alloc_ptr, r7
+        ldr     r7, Caml_state(young_limit)
+        cmp     alloc_ptr, r7
+        bcc     .Lcaml_call_gc
+        bx      lr
+        CFI_ENDPROC
+        .size   caml_allocN, .-caml_allocN
+
+/* Call a C function from OCaml */
+/* Function to call is in r7 */
+
+FUNCTION(caml_c_call)
+        CFI_STARTPROC
+    /* Record lowest stack address and return address */
+        str     lr, Caml_state(last_return_address)
+        str     sp, Caml_state(bottom_of_stack)
+    /* Preserve return address in callee-save register r4 */
+        mov     r4, lr
+        CFI_REGISTER(lr, r4)
+    /* Make the exception handler alloc ptr available to the C code */
+        str     alloc_ptr, Caml_state(young_ptr)
+        str     trap_ptr, Caml_state(exception_pointer)
+    /* Call the function */
+        blx     r7
+    /* Reload alloc ptr */
+        ldr     alloc_ptr, Caml_state(young_ptr)
+    /* Return */
+        bx      r4
+        CFI_ENDPROC
+        .size   caml_c_call, .-caml_c_call
+
+/* Start the OCaml program */
+
+FUNCTION(caml_start_program)
+        CFI_STARTPROC
+        ldr     r12, =caml_program
+
+/* Code shared with caml_callback* */
+/* Address of OCaml code to call is in r12 */
+/* Arguments to the OCaml code are in r0...r3 */
+
+.Ljump_to_caml:
+#if defined(SYS_linux_eabihf) || defined(SYS_netbsd)
+    /* Save callee-save floating-point registers */
+        vpush   {d8-d15}; CFI_ADJUST(64)
+#endif
+    /* Save return address and callee-save registers */
+        push    {r4-r8,r10,r11,lr}; CFI_ADJUST(32)      /* 8-byte alignment */
+#if defined(SYS_linux_eabihf) || defined(SYS_netbsd)
+        CFI_OFFSET(lr, -68)
+#else
+        CFI_OFFSET(lr, -4)
+#endif
+        ldr     domain_state_ptr, =Caml_state
+        ldr     domain_state_ptr, [domain_state_ptr]
+    /* Setup a callback link on the stack */
+        sub     sp, sp, 16; CFI_ADJUST(16)              /* 8-byte alignment */
+        ldr     r4, Caml_state(bottom_of_stack)
+        ldr     r5, Caml_state(last_return_address)
+        ldr     r6, Caml_state(gc_regs)
+        str     r4, [sp, 0]
+        str     r5, [sp, 4]
+        str     r6, [sp, 8]
+    /* Setup a trap frame to catch exceptions escaping the OCaml code */
+        sub     sp, sp, 8; CFI_ADJUST(8)
+        ldr     r5, =.Ltrap_handler
+        ldr     r4, Caml_state(exception_pointer)
+        str     r4, [sp, 0]
+        str     r5, [sp, 4]
+        mov     trap_ptr, sp
+    /* Reload allocation pointer */
+        ldr     alloc_ptr, Caml_state(young_ptr)
+    /* Call the OCaml code */
+        blx     r12
+.Lcaml_retaddr:
+    /* Pop the trap frame, restoring caml_exception_pointer */
+        ldr     r5, [sp, 0]
+        str     r5, Caml_state(exception_pointer)
+        add     sp, sp, 8; CFI_ADJUST(-8)
+    /* Pop the callback link, restoring the global variables */
+.Lreturn_result:
+        ldr     r5, [sp, 0]
+        str     r5, Caml_state(bottom_of_stack)
+        ldr     r5, [sp, 4]
+        str     r5, Caml_state(last_return_address)
+        ldr     r5, [sp, 8]
+        str     r5, Caml_state(gc_regs)
+        add     sp, sp, 16; CFI_ADJUST(-16)
+    /* Update allocation pointer */
+        str     alloc_ptr, Caml_state(young_ptr)
+    /* Reload callee-save registers and return address */
+        pop     {r4-r8,r10,r11,lr}; CFI_ADJUST(-32)
+#if defined(SYS_linux_eabihf) || defined(SYS_netbsd)
+    /* Reload callee-save floating-point registers */
+        vpop    {d8-d15}; CFI_ADJUST(-64)
+#endif
+        bx      lr
+        CFI_ENDPROC
+        .type   .Lcaml_retaddr, %function
+        .size   .Lcaml_retaddr, .-.Lcaml_retaddr
+        .size   caml_start_program, .-caml_start_program
+
+/* The trap handler */
+
+        .align  2
+.Ltrap_handler:
+        CFI_STARTPROC
+    /* Save exception pointer */
+        str     trap_ptr, Caml_state(exception_pointer)
+    /* Encode exception bucket as an exception result */
+        orr     r0, r0, 2
+    /* Return it */
+        b       .Lreturn_result
+        CFI_ENDPROC
+        .type   .Ltrap_handler, %function
+        .size   .Ltrap_handler, .-.Ltrap_handler
+
+/* Raise an exception from OCaml */
+
+FUNCTION(caml_raise_exn)
+        CFI_STARTPROC
+    /* Test if backtrace is active */
+        ldr     r1, Caml_state(backtrace_active)
+        cbz     r1, 1f
+    /* Preserve exception bucket in callee-save register r4 */
+        mov     r4, r0
+    /* Stash the backtrace */
+        mov     r1, lr                          /* arg2: pc of raise */
+        mov     r2, sp                          /* arg3: sp of raise */
+        mov     r3, trap_ptr                    /* arg4: sp of handler */
+        bl      caml_stash_backtrace
+    /* Restore exception bucket */
+        mov     r0, r4
+1:  /* Cut stack at current trap handler */
+        mov     sp, trap_ptr
+    /* Pop previous handler and addr of trap, and jump to it */
+        pop     {trap_ptr, pc}
+        CFI_ENDPROC
+        .size   caml_raise_exn, .-caml_raise_exn
+
+/* Raise an exception from C */
+
+FUNCTION(caml_raise_exception)
+        CFI_STARTPROC
+    /* Load the domain state ptr */
+        mov     domain_state_ptr, r0
+    /* Load exception bucket */
+        mov     r0, r1
+    /* Reload trap ptr and alloc ptr */
+        ldr     trap_ptr, Caml_state(exception_pointer)
+        ldr     alloc_ptr, Caml_state(young_ptr)
+    /* Test if backtrace is active */
+        ldr     r1, Caml_state(backtrace_active)
+        cbz     r1, 1f
+    /* Preserve exception bucket in callee-save register r4 */
+        mov     r4, r0
+        ldr     r1, Caml_state(last_return_address) /* arg2: pc of raise */
+        ldr     r2, Caml_state(bottom_of_stack)     /* arg3: sp of raise */
+        mov     r3, trap_ptr                        /* arg4: sp of handler */
+        bl      caml_stash_backtrace
+    /* Restore exception bucket */
+        mov     r0, r4
+1:  /* Cut stack at current trap handler */
+        mov     sp, trap_ptr
+    /* Pop previous handler and addr of trap, and jump to it */
+        pop     {trap_ptr, pc}
+        CFI_ENDPROC
+        .size   caml_raise_exception, .-caml_raise_exception
+
+/* Callback from C to OCaml */
+
+FUNCTION(caml_callback_asm)
+        CFI_STARTPROC
+    /* Initial shuffling of arguments */
+    /* (r0 = Caml_state, r1 = closure, [r2] = first arg) */
+        ldr     r0, [r2]        /* r0 = first arg */
+                                /* r1 = closure environment */
+        ldr     r12, [r1]       /* code pointer */
+        b       .Ljump_to_caml
+        CFI_ENDPROC
+        .size   caml_callback_asm, .-caml_callback_asm
+
+FUNCTION(caml_callback2_asm)
+        CFI_STARTPROC
+    /* Initial shuffling of arguments */
+    /* (r0 = Caml_state, r1 = closure, [r2] = arg1, [r2,4] = arg2) */
+        mov     r12, r1
+        ldr     r0, [r2]          /* r0 = first arg */
+        ldr     r1, [r2,4]        /* r1 = second arg */
+        mov     r2, r12           /* r2 = closure environment */
+        ldr     r12, =caml_apply2
+        b       .Ljump_to_caml
+        CFI_ENDPROC
+        .size   caml_callback2_asm, .-caml_callback2_asm
+
+FUNCTION(caml_callback3_asm)
+        CFI_STARTPROC
+    /* Initial shuffling of arguments */
+    /* (r0 = Caml_state, r1 = closure, [r2] = arg1, [r2,4] = arg2,
+        [r2,8] = arg3) */
+        mov     r3, r1            /* r3 = closure environment */
+        ldr     r0, [r2]          /* r0 = first arg */
+        ldr     r1, [r2,4]        /* r1 = second arg */
+        ldr     r2, [r2,8]        /* r2 = third arg */
+        ldr     r12, =caml_apply3
+        b       .Ljump_to_caml
+        CFI_ENDPROC
+        .size   caml_callback3_asm, .-caml_callback3_asm
+
+FUNCTION(caml_ml_array_bound_error)
+        CFI_STARTPROC
+    /* Load address of [caml_array_bound_error] in r7 */
+        ldr     r7, =caml_array_bound_error
+    /* Call that function */
+        b       caml_c_call
+        CFI_ENDPROC
+        .size   caml_ml_array_bound_error, .-caml_ml_array_bound_error
+
+        .globl  caml_system__code_end
+caml_system__code_end:
+
+/* GC roots for callback */
+
+        .data
+        .align  2
+        .globl  caml_system__frametable
+caml_system__frametable:
+        .word   1               /* one descriptor */
+        .word   .Lcaml_retaddr  /* return address into callback */
+        .short  -1              /* negative frame size => use callback link */
+        .short  0               /* no roots */
+        .align  2
+        .type   caml_system__frametable, %object
+        .size   caml_system__frametable, .-caml_system__frametable
+
+/* Mark stack as non-executable */
+        .section .note.GNU-stack,"",%progbits
diff --git a/runtime/arm64.S b/runtime/arm64.S
new file mode 100644
index 00000000..6bad4ce8
--- /dev/null
+++ b/runtime/arm64.S
@@ -0,0 +1,483 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2013 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Asm part of the runtime system, ARM processor, 64-bit mode */
+/* Must be preprocessed by cpp */
+
+#include "caml/m.h"
+
+/* Special registers */
+
+#define DOMAIN_STATE_PTR x25
+#define TRAP_PTR x26
+#define ALLOC_PTR x27
+#define ALLOC_LIMIT x28
+#define ARG x15
+#define TMP x16
+#define TMP2 x17
+#define ARG_DOMAIN_STATE_PTR x18
+
+#define C_ARG_1 x0
+#define C_ARG_2 x1
+#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
+#else
+#define CFI_STARTPROC
+#define CFI_ENDPROC
+#define CFI_ADJUST(n)
+#define CFI_REGISTER(r1,r2)
+#define CFI_OFFSET(r,n)
+#endif
+
+        .set    domain_curr_field, 0
+#define DOMAIN_STATE(c_type, name) \
+        .equ    domain_field_caml_##name, domain_curr_field ; \
+        .set    domain_curr_field, domain_curr_field + 1
+#include "../runtime/caml/domain_state.tbl"
+#undef DOMAIN_STATE
+
+#define Caml_state(var) [x25, 8*domain_field_caml_##var]
+
+#if defined(__PIC__)
+
+#define ADDRGLOBAL(reg,symb) \
+        adrp    TMP2, :got:symb; \
+        ldr     reg, [TMP2, #:got_lo12:symb]
+#else
+
+#define ADDRGLOBAL(reg,symb) \
+        adrp    reg, symb; \
+        add     reg, reg, #:lo12:symb
+
+#endif
+
+#if defined(FUNCTION_SECTIONS)
+#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
+#else
+#define TEXT_SECTION(name)
+#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(caml.##name); \
+        .align 2; \
+        .globl name; \
+        .type name, %function; \
+name:
+
+/* Allocation functions and GC interface */
+        .globl  caml_system__code_begin
+caml_system__code_begin:
+
+FUNCTION(caml_call_gc)
+        CFI_STARTPROC
+.Lcaml_call_gc:
+    /* Record return address */
+        str     x30, Caml_state(last_return_address)
+    /* Record lowest stack address */
+        mov     TMP, sp
+        str     TMP, Caml_state(bottom_of_stack)
+    /* Set up stack space, saving return address and frame pointer */
+    /* (2 regs RA/GP, 24 allocatable int regs, 24 caller-save float regs) * 8 */
+        CFI_OFFSET(29, -400)
+        CFI_OFFSET(30, -392)
+        stp     x29, x30, [sp, -400]!
+        CFI_ADJUST(400)
+        add     x29, sp, #0
+    /* Save allocatable integer registers on the stack, in the order
+       given in proc.ml */
+        stp     x0, x1, [sp, 16]
+        stp     x2, x3, [sp, 32]
+        stp     x4, x5, [sp, 48]
+        stp     x6, x7, [sp, 64]
+        stp     x8, x9, [sp, 80]
+        stp     x10, x11, [sp, 96]
+        stp     x12, x13, [sp, 112]
+        stp     x14, x15, [sp, 128]
+        stp     x19, x20, [sp, 144]
+        stp     x21, x22, [sp, 160]
+        stp     x23, x24, [sp, 176]
+        str     x25, [sp, 192]
+     /* Save caller-save floating-point registers on the stack
+        (callee-saves are preserved by caml_garbage_collection) */
+        stp     d0, d1, [sp, 208]
+        stp     d2, d3, [sp, 224]
+        stp     d4, d5, [sp, 240]
+        stp     d6, d7, [sp, 256]
+        stp     d16, d17, [sp, 272]
+        stp     d18, d19, [sp, 288]
+        stp     d20, d21, [sp, 304]
+        stp     d22, d23, [sp, 320]
+        stp     d24, d25, [sp, 336]
+        stp     d26, d27, [sp, 352]
+        stp     d28, d29, [sp, 368]
+        stp     d30, d31, [sp, 384]
+    /* Store pointer to saved integer registers in Caml_state->gc_regs */
+        add     TMP, sp, #16
+        str     TMP, Caml_state(gc_regs)
+    /* Save current allocation pointer for debugging purposes */
+        str     ALLOC_PTR, Caml_state(young_ptr)
+    /* Save trap pointer in case an exception is raised during GC */
+        str     TRAP_PTR, Caml_state(exception_pointer)
+    /* Call the garbage collector */
+        bl      caml_garbage_collection
+    /* Restore registers */
+        ldp     x0, x1, [sp, 16]
+        ldp     x2, x3, [sp, 32]
+        ldp     x4, x5, [sp, 48]
+        ldp     x6, x7, [sp, 64]
+        ldp     x8, x9, [sp, 80]
+        ldp     x10, x11, [sp, 96]
+        ldp     x12, x13, [sp, 112]
+        ldp     x14, x15, [sp, 128]
+        ldp     x19, x20, [sp, 144]
+        ldp     x21, x22, [sp, 160]
+        ldp     x23, x24, [sp, 176]
+        ldr     x25, [sp, 192]
+        ldp     d0, d1, [sp, 208]
+        ldp     d2, d3, [sp, 224]
+        ldp     d4, d5, [sp, 240]
+        ldp     d6, d7, [sp, 256]
+        ldp     d16, d17, [sp, 272]
+        ldp     d18, d19, [sp, 288]
+        ldp     d20, d21, [sp, 304]
+        ldp     d22, d23, [sp, 320]
+        ldp     d24, d25, [sp, 336]
+        ldp     d26, d27, [sp, 352]
+        ldp     d28, d29, [sp, 368]
+        ldp     d30, d31, [sp, 384]
+    /* Reload new allocation pointer and allocation limit */
+        ldr     ALLOC_PTR, Caml_state(young_ptr)
+        ldr     ALLOC_LIMIT, Caml_state(young_limit)
+    /* Free stack space and return to caller */
+        ldp     x29, x30, [sp], 400
+        ret
+        CFI_ENDPROC
+        .size   caml_call_gc, .-caml_call_gc
+
+FUNCTION(caml_alloc1)
+        CFI_STARTPROC
+        sub     ALLOC_PTR, ALLOC_PTR, #16
+        cmp     ALLOC_PTR, ALLOC_LIMIT
+        b.lo    .Lcaml_call_gc
+        ret
+        CFI_ENDPROC
+        .size   caml_alloc1, .-caml_alloc1
+
+FUNCTION(caml_alloc2)
+        CFI_STARTPROC
+        sub     ALLOC_PTR, ALLOC_PTR, #24
+        cmp     ALLOC_PTR, ALLOC_LIMIT
+        b.lo    .Lcaml_call_gc
+        ret
+        CFI_ENDPROC
+        .size   caml_alloc2, .-caml_alloc2
+
+FUNCTION(caml_alloc3)
+        CFI_STARTPROC
+        sub     ALLOC_PTR, ALLOC_PTR, #32
+        cmp     ALLOC_PTR, ALLOC_LIMIT
+        b.lo    .Lcaml_call_gc
+        ret
+        CFI_ENDPROC
+        .size   caml_alloc3, .-caml_alloc3
+
+FUNCTION(caml_allocN)
+        CFI_STARTPROC
+        sub     ALLOC_PTR, ALLOC_PTR, ARG
+        cmp     ALLOC_PTR, ALLOC_LIMIT
+        b.lo    .Lcaml_call_gc
+        ret
+        CFI_ENDPROC
+        .size   caml_allocN, .-caml_allocN
+
+/* Call a C function from OCaml */
+/* Function to call is in ARG */
+
+FUNCTION(caml_c_call)
+        CFI_STARTPROC
+    /* Preserve return address in callee-save register x19 */
+        mov     x19, x30
+        CFI_REGISTER(30, 19)
+    /* Record lowest stack address and return address */
+        str     x30, Caml_state(last_return_address)
+        add     TMP, sp, #0
+        str     TMP, Caml_state(bottom_of_stack)
+    /* Make the exception handler alloc ptr available to the C code */
+        str     ALLOC_PTR, Caml_state(young_ptr)
+        str     TRAP_PTR, Caml_state(exception_pointer)
+    /* Call the function */
+        blr     ARG
+    /* Reload alloc ptr and alloc limit */
+        ldr     ALLOC_PTR, Caml_state(young_ptr)
+        ldr     ALLOC_LIMIT, Caml_state(young_limit)
+    /* Return */
+        ret     x19
+        CFI_ENDPROC
+        .size   caml_c_call, .-caml_c_call
+
+/* Start the OCaml program */
+
+FUNCTION(caml_start_program)
+        CFI_STARTPROC
+        mov     ARG_DOMAIN_STATE_PTR, C_ARG_1
+        ADDRGLOBAL(ARG, caml_program)
+
+/* Code shared with caml_callback* */
+/* Address of OCaml code to call is in ARG */
+/* Arguments to the OCaml code are in x0...x7 */
+
+.Ljump_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)
+        add     x29, sp, #0
+        stp     x19, x20, [sp, 16]
+        stp     x21, x22, [sp, 32]
+        stp     x23, x24, [sp, 48]
+        stp     x25, x26, [sp, 64]
+        stp     x27, x28, [sp, 80]
+        stp     d8, d9, [sp, 96]
+        stp     d10, d11, [sp, 112]
+        stp     d12, d13, [sp, 128]
+        stp     d14, d15, [sp, 144]
+    /* Load domain state pointer from argument */
+        mov     DOMAIN_STATE_PTR, ARG_DOMAIN_STATE_PTR
+    /* Setup a callback link on the stack */
+        ldr     x8, Caml_state(bottom_of_stack)
+        ldr     x9, Caml_state(last_return_address)
+        ldr     x10, Caml_state(gc_regs)
+        stp     x8, x9, [sp, -32]!     /* 16-byte alignment */
+        CFI_ADJUST(32)
+        str     x10, [sp, 16]
+    /* Setup a trap frame to catch exceptions escaping the OCaml code */
+        ldr     x8, Caml_state(exception_pointer)
+        adr     x9, .Ltrap_handler
+        stp     x8, x9, [sp, -16]!
+        CFI_ADJUST(16)
+        add     TRAP_PTR, sp, #0
+    /* Reload allocation pointers */
+        ldr     ALLOC_PTR, Caml_state(young_ptr)
+        ldr     ALLOC_LIMIT, Caml_state(young_limit)
+    /* Call the OCaml code */
+        blr     ARG
+.Lcaml_retaddr:
+    /* Pop the trap frame, restoring caml_exception_pointer */
+        ldr     x8, [sp], 16
+        CFI_ADJUST(-16)
+        str     x8, Caml_state(exception_pointer)
+    /* Pop the callback link, restoring the global variables */
+.Lreturn_result:
+        ldr     x10, [sp, 16]
+        ldp     x8, x9, [sp], 32
+        CFI_ADJUST(-32)
+        str     x8, Caml_state(bottom_of_stack)
+        str     x9, Caml_state(last_return_address)
+        str     x10, Caml_state(gc_regs)
+    /* Update allocation pointer */
+        str     ALLOC_PTR, Caml_state(young_ptr)
+    /* Reload callee-save registers and return address */
+        ldp     x19, x20, [sp, 16]
+        ldp     x21, x22, [sp, 32]
+        ldp     x23, x24, [sp, 48]
+        ldp     x25, x26, [sp, 64]
+        ldp     x27, x28, [sp, 80]
+        ldp     d8, d9, [sp, 96]
+        ldp     d10, d11, [sp, 112]
+        ldp     d12, d13, [sp, 128]
+        ldp     d14, d15, [sp, 144]
+        ldp     x29, x30, [sp], 160
+        CFI_ADJUST(-160)
+    /* Return to C caller */
+        ret
+        CFI_ENDPROC
+        .type   .Lcaml_retaddr, %function
+        .size   .Lcaml_retaddr, .-.Lcaml_retaddr
+        .size   caml_start_program, .-caml_start_program
+
+/* The trap handler */
+
+        .align  2
+.Ltrap_handler:
+        CFI_STARTPROC
+    /* Save exception pointer */
+        str     TRAP_PTR, Caml_state(exception_pointer)
+    /* Encode exception bucket as an exception result */
+        orr     x0, x0, #2
+    /* Return it */
+        b       .Lreturn_result
+        CFI_ENDPROC
+        .type   .Ltrap_handler, %function
+        .size   .Ltrap_handler, .-.Ltrap_handler
+
+/* Raise an exception from OCaml */
+
+FUNCTION(caml_raise_exn)
+        CFI_STARTPROC
+    /* Test if backtrace is active */
+        ldr     TMP, Caml_state(backtrace_active)
+        cbnz    TMP, 2f
+1:  /* 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
+        br      TMP
+2:  /* Preserve exception bucket in callee-save register x19 */
+        mov     x19, x0
+    /* Stash the backtrace */
+                               /* arg1: exn bucket, already in x0 */
+        mov     x1, x30        /* arg2: pc of raise */
+        add     x2, sp, #0     /* arg3: sp of raise */
+        mov     x3, TRAP_PTR   /* arg4: sp of handler */
+        bl      caml_stash_backtrace
+    /* Restore exception bucket and raise */
+        mov     x0, x19
+        b       1b
+        CFI_ENDPROC
+        .size   caml_raise_exn, .-caml_raise_exn
+
+/* Raise an exception from C */
+
+FUNCTION(caml_raise_exception)
+        CFI_STARTPROC
+    /* Load the domain state ptr */
+        mov     DOMAIN_STATE_PTR, C_ARG_1
+    /* Load the exception bucket */
+        mov     x0, C_ARG_2
+    /* Reload trap ptr, alloc ptr and alloc limit */
+        ldr     TRAP_PTR, Caml_state(exception_pointer)
+        ldr     ALLOC_PTR, Caml_state(young_ptr)
+        ldr     ALLOC_LIMIT, Caml_state(young_limit)
+    /* Test if backtrace is active */
+        ldr     TMP, Caml_state(backtrace_active)
+        cbnz    TMP, 2f
+1:  /* 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
+        br      TMP
+2:  /* Preserve exception bucket in callee-save register x19 */
+        mov     x19, x0
+    /* Stash the backtrace */
+                                                      /* arg1: exn bucket */
+        ldr     x1, Caml_state(last_return_address)   /* arg2: pc of raise */
+        ldr     x2, Caml_state(bottom_of_stack)       /* arg3: sp of raise */
+        mov     x3, TRAP_PTR   /* arg4: sp of handler */
+        bl      caml_stash_backtrace
+    /* Restore exception bucket and raise */
+        mov     x0, x19
+        b       1b
+        CFI_ENDPROC
+        .size   caml_raise_exception, .-caml_raise_exception
+
+/* Callback from C to OCaml */
+
+FUNCTION(caml_callback_asm)
+        CFI_STARTPROC
+    /* Initial shuffling of arguments */
+    /* (x0 = Caml_state, x1 = closure, [x2] = first arg) */
+        mov     ARG_DOMAIN_STATE_PTR, x0
+        ldr     x0, [x2]        /* x0 = first arg */
+                                /* x1 = closure environment */
+        ldr     ARG, [x1]       /* code pointer */
+        b       .Ljump_to_caml
+        CFI_ENDPROC
+        .type   caml_callback_asm, %function
+        .size   caml_callback_asm, .-caml_callback_asm
+
+        TEXT_SECTION(caml_callback2_asm)
+        .align  2
+        .globl  caml_callback2_asm
+caml_callback2_asm:
+        CFI_STARTPROC
+    /* Initial shuffling of arguments */
+    /* (x0 = Caml_state, x1 = closure, [x2] = arg1, [x2,8] = arg2) */
+        mov     ARG_DOMAIN_STATE_PTR, x0
+        mov     TMP, x1
+        ldp     x0, x1, [x2, 0] /* x0 = first arg, x1 = second arg */
+        mov     x2, TMP         /* x2 = closure environment */
+        ADDRGLOBAL(ARG, caml_apply2)
+        b       .Ljump_to_caml
+        CFI_ENDPROC
+        .type   caml_callback2_asm, %function
+        .size   caml_callback2_asm, .-caml_callback2_asm
+
+        TEXT_SECTION(caml_callback3_asm)
+        .align  2
+        .globl  caml_callback3_asm
+caml_callback3_asm:
+        CFI_STARTPROC
+    /* Initial shuffling of arguments */
+    /* (x0 = Caml_state, x1 = closure, [x2] = arg1, [x2,8] = arg2,
+        [x2,16] = arg3) */
+        mov     ARG_DOMAIN_STATE_PTR, x0
+        mov     x3, x1          /* x3 = closure environment */
+        ldp     x0, x1, [x2, 0] /* x0 = first arg, x1 = second arg */
+        ldr     x2, [x2, 16]    /* x2 = third arg */
+        ADDRGLOBAL(ARG, caml_apply3)
+        b       .Ljump_to_caml
+        CFI_ENDPROC
+        .size   caml_callback3_asm, .-caml_callback3_asm
+
+FUNCTION(caml_ml_array_bound_error)
+        CFI_STARTPROC
+    /* Load address of [caml_array_bound_error] in ARG */
+        ADDRGLOBAL(ARG, caml_array_bound_error)
+    /* Call that function */
+        b       caml_c_call
+        CFI_ENDPROC
+        .size   caml_ml_array_bound_error, .-caml_ml_array_bound_error
+
+        .globl  caml_system__code_end
+caml_system__code_end:
+
+/* GC roots for callback */
+
+        .data
+        .align  3
+        .globl  caml_system__frametable
+caml_system__frametable:
+        .quad   1               /* one descriptor */
+        .quad   .Lcaml_retaddr  /* return address into callback */
+        .short  -1              /* negative frame size => use callback link */
+        .short  0               /* no roots */
+        .align  3
+        .type   caml_system__frametable, %object
+        .size   caml_system__frametable, .-caml_system__frametable
+
+/* Mark stack as non-executable */
+        .section .note.GNU-stack,"",%progbits
diff --git a/runtime/array.c b/runtime/array.c
new file mode 100644
index 00000000..37af6b7f
--- /dev/null
+++ b/runtime/array.c
@@ -0,0 +1,637 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* Operations on arrays */
+#include <string.h>
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/signals.h"
+#include "caml/eventlog.h"
+/* Why is caml/spacetime.h included conditionnally sometimes and not here ? */
+#include "caml/spacetime.h"
+
+static const mlsize_t mlsize_t_max = -1;
+
+/* returns number of elements (either fields or floats) */
+/* [ 'a array -> int ] */
+CAMLexport mlsize_t caml_array_length(value array)
+{
+#ifdef FLAT_FLOAT_ARRAY
+  if (Tag_val(array) == Double_array_tag)
+    return Wosize_val(array) / Double_wosize;
+  else
+#endif
+    return Wosize_val(array);
+}
+
+CAMLexport int caml_is_double_array(value array)
+{
+  return (Tag_val(array) == Double_array_tag);
+}
+
+/* Note: the OCaml types on the following primitives will work both with
+   and without the -no-flat-float-array configure-time option. If you
+   respect them, your C code should work in both configurations.
+*/
+
+/* [ 'a array -> int -> 'a ] where 'a != float */
+CAMLprim value caml_array_get_addr(value array, value index)
+{
+  intnat idx = Long_val(index);
+  if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error();
+  return Field(array, idx);
+}
+
+/* [ float array -> int -> float ] */
+CAMLprim value caml_array_get_float(value array, value index)
+{
+  intnat idx = Long_val(index);
+#ifdef FLAT_FLOAT_ARRAY
+  double d;
+  value res;
+
+  if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
+    caml_array_bound_error();
+  d = Double_flat_field(array, idx);
+#define Setup_for_gc
+#define Restore_after_gc
+  Alloc_small(res, Double_wosize, Double_tag);
+#undef Setup_for_gc
+#undef Restore_after_gc
+  Store_double_val(res, d);
+  return res;
+#else
+  CAMLassert (Tag_val (array) != Double_array_tag);
+  if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error();
+  return Field(array, idx);
+#endif /* FLAT_FLOAT_ARRAY */
+}
+
+/* [ 'a array -> int -> 'a ] */
+CAMLprim value caml_array_get(value array, value index)
+{
+#ifdef FLAT_FLOAT_ARRAY
+  if (Tag_val(array) == Double_array_tag)
+    return caml_array_get_float(array, index);
+#else
+  CAMLassert (Tag_val(array) != Double_array_tag);
+#endif
+  return caml_array_get_addr(array, index);
+}
+
+/* [ floatarray -> int -> float ] */
+CAMLprim value caml_floatarray_get(value array, value index)
+{
+  intnat idx = Long_val(index);
+  double d;
+  value res;
+
+  CAMLassert (Tag_val(array) == Double_array_tag);
+  if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
+    caml_array_bound_error();
+  d = Double_flat_field(array, idx);
+#define Setup_for_gc
+#define Restore_after_gc
+  Alloc_small(res, Double_wosize, Double_tag);
+#undef Setup_for_gc
+#undef Restore_after_gc
+  Store_double_val(res, d);
+  return res;
+}
+
+/* [ 'a array -> int -> 'a -> unit ] where 'a != float */
+CAMLprim value caml_array_set_addr(value array, value index, value newval)
+{
+  intnat idx = Long_val(index);
+  if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error();
+  Modify(&Field(array, idx), newval);
+  return Val_unit;
+}
+
+/* [ float array -> int -> float -> unit ] */
+CAMLprim value caml_array_set_float(value array, value index, value newval)
+{
+  intnat idx = Long_val(index);
+#ifdef FLAT_FLOAT_ARRAY
+  double d = Double_val (newval);
+  if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
+    caml_array_bound_error();
+  Store_double_flat_field(array, idx, d);
+#else
+  CAMLassert (Tag_val (array) != Double_array_tag);
+  if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error();
+  Modify(&Field(array, idx), newval);
+#endif
+  return Val_unit;
+}
+
+/* [ 'a array -> int -> 'a -> unit ] */
+CAMLprim value caml_array_set(value array, value index, value newval)
+{
+#ifdef FLAT_FLOAT_ARRAY
+  if (Tag_val(array) == Double_array_tag)
+    return caml_array_set_float(array, index, newval);
+#else
+  CAMLassert (Tag_val(array) != Double_array_tag);
+#endif
+  return caml_array_set_addr(array, index, newval);
+}
+
+/* [ floatarray -> int -> float -> unit ] */
+CAMLprim value caml_floatarray_set(value array, value index, value newval)
+{
+  intnat idx = Long_val(index);
+  double d = Double_val (newval);
+  CAMLassert (Tag_val(array) == Double_array_tag);
+  if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
+    caml_array_bound_error();
+  Store_double_flat_field(array, idx, d);
+  return Val_unit;
+}
+
+/* [ float array -> int -> float ] */
+CAMLprim value caml_array_unsafe_get_float(value array, value index)
+{
+  intnat idx = Long_val (index);
+#ifdef FLAT_FLOAT_ARRAY
+  double d;
+  value res;
+
+  d = Double_flat_field(array, idx);
+#define Setup_for_gc
+#define Restore_after_gc
+  Alloc_small(res, Double_wosize, Double_tag);
+#undef Setup_for_gc
+#undef Restore_after_gc
+  Store_double_val(res, d);
+  return res;
+#else /* FLAT_FLOAT_ARRAY */
+  CAMLassert (Tag_val(array) != Double_array_tag);
+  return Field(array, idx);
+#endif /* FLAT_FLOAT_ARRAY */
+}
+
+/* [ 'a array -> int -> 'a ] */
+CAMLprim value caml_array_unsafe_get(value array, value index)
+{
+#ifdef FLAT_FLOAT_ARRAY
+  if (Tag_val(array) == Double_array_tag)
+    return caml_array_unsafe_get_float(array, index);
+#else
+  CAMLassert (Tag_val(array) != Double_array_tag);
+#endif
+  return Field(array, Long_val(index));
+}
+
+/* [ floatarray -> int -> float ] */
+CAMLprim value caml_floatarray_unsafe_get(value array, value index)
+{
+  intnat idx = Long_val(index);
+  double d;
+  value res;
+
+  CAMLassert (Tag_val(array) == Double_array_tag);
+  d = Double_flat_field(array, idx);
+#define Setup_for_gc
+#define Restore_after_gc
+  Alloc_small(res, Double_wosize, Double_tag);
+#undef Setup_for_gc
+#undef Restore_after_gc
+  Store_double_val(res, d);
+  return res;
+}
+
+/* [ 'a array -> int -> 'a -> unit ] where 'a != float */
+CAMLprim value caml_array_unsafe_set_addr(value array, value index,value newval)
+{
+  intnat idx = Long_val(index);
+  Modify(&Field(array, idx), newval);
+  return Val_unit;
+}
+
+/* [ float array -> int -> float -> unit ] */
+CAMLprim value caml_array_unsafe_set_float(value array,value index,value newval)
+{
+  intnat idx = Long_val(index);
+#ifdef FLAT_FLOAT_ARRAY
+  double d = Double_val (newval);
+  Store_double_flat_field(array, idx, d);
+#else
+  Modify(&Field(array, idx), newval);
+#endif
+  return Val_unit;
+}
+
+/* [ 'a array -> int -> 'a -> unit ] */
+CAMLprim value caml_array_unsafe_set(value array, value index, value newval)
+{
+#ifdef FLAT_FLOAT_ARRAY
+  if (Tag_val(array) == Double_array_tag)
+    return caml_array_unsafe_set_float(array, index, newval);
+#else
+  CAMLassert (Tag_val(array) != Double_array_tag);
+#endif
+  return caml_array_unsafe_set_addr(array, index, newval);
+}
+
+/* [ floatarray -> int -> float -> unit ] */
+CAMLprim value caml_floatarray_unsafe_set(value array, value index,value newval)
+{
+  intnat idx = Long_val(index);
+  double d = Double_val (newval);
+  Store_double_flat_field(array, idx, d);
+  return Val_unit;
+}
+
+/* [len] is a [value] representing number of floats. */
+/* [ int -> floatarray ] */
+CAMLprim value caml_floatarray_create(value len)
+{
+  mlsize_t wosize = Long_val(len) * Double_wosize;
+  value result;
+  if (wosize <= Max_young_wosize){
+    if (wosize == 0)
+      return Atom(0);
+    else
+#define Setup_for_gc
+#define Restore_after_gc
+      Alloc_small (result, wosize, Double_array_tag);
+#undef Setup_for_gc
+#undef Restore_after_gc
+  }else if (wosize > Max_wosize)
+    caml_invalid_argument("Float.Array.create");
+  else {
+    result = caml_alloc_shr (wosize, Double_array_tag);
+  }
+  // Give the GC a chance to run, and run memprof callbacks
+  return caml_process_pending_actions_with_root (result);
+}
+
+/* [len] is a [value] representing number of words or floats */
+/* Spacetime profiling assumes that this function is only called from OCaml. */
+CAMLprim value caml_make_vect(value len, value init)
+{
+  CAMLparam2 (len, init);
+  CAMLlocal1 (res);
+  mlsize_t size, i;
+
+  size = Long_val(len);
+  if (size == 0) {
+    res = Atom(0);
+#ifdef FLAT_FLOAT_ARRAY
+  } else if (Is_block(init)
+           && Is_in_value_area(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) {
+      uintnat profinfo;
+      Get_my_profinfo_with_cached_backtrace(profinfo, size);
+      res = caml_alloc_small_with_my_or_given_profinfo(size, 0, profinfo);
+      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;
+    }
+  }
+  // Give the GC a chance to run, and run memprof callbacks
+  caml_process_pending_actions ();
+  CAMLreturn (res);
+}
+
+/* [len] is a [value] representing number of floats */
+/* [ int -> float array ] */
+CAMLprim value caml_make_float_vect(value len)
+{
+#ifdef FLAT_FLOAT_ARRAY
+  return caml_floatarray_create (len);
+#else
+  static value uninitialized_float = Val_unit;
+  if (uninitialized_float == Val_unit){
+    uninitialized_float = caml_alloc_shr (Double_wosize, Double_tag);
+    caml_register_generational_global_root (&uninitialized_float);
+  }
+  return caml_make_vect (len, uninitialized_float);
+#endif
+}
+
+/* This primitive is used internally by the compiler to compile
+   explicit array expressions.
+   For float arrays when FLAT_FLOAT_ARRAY is true, it takes an array of
+   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)
+{
+#ifdef FLAT_FLOAT_ARRAY
+  CAMLparam1 (init);
+  mlsize_t wsize, size, i;
+  CAMLlocal2 (v, res);
+
+  size = Wosize_val(init);
+  if (size == 0) {
+    CAMLreturn (init);
+  } else {
+    v = Field(init, 0);
+    if (Is_long(v)
+        || ! Is_in_value_area(v)
+        || Tag_val(v) != Double_tag) {
+      CAMLreturn (init);
+    } else {
+      wsize = size * Double_wosize;
+      if (wsize <= Max_young_wosize) {
+        res = caml_alloc_small(wsize, Double_array_tag);
+      } else {
+        res = caml_alloc_shr(wsize, Double_array_tag);
+      }
+      for (i = 0; i < size; i++) {
+        double d = Double_val(Field(init, i));
+        Store_double_flat_field(res, i, d);
+      }
+      // run memprof callbacks
+      caml_process_pending_actions();
+      CAMLreturn (res);
+    }
+  }
+#else
+  return init;
+#endif
+}
+
+/* Blitting */
+
+CAMLprim value caml_array_blit(value a1, value ofs1, value a2, value ofs2,
+                               value n)
+{
+  value * src, * dst;
+  intnat count;
+
+#ifdef FLAT_FLOAT_ARRAY
+  if (Tag_val(a2) == Double_array_tag) {
+    /* Arrays of floats.  The values being copied are floats, not
+       pointer, so we can do a direct copy.  memmove takes care of
+       potential overlap between the copied areas. */
+    memmove((double *)a2 + Long_val(ofs2),
+            (double *)a1 + Long_val(ofs1),
+            Long_val(n) * sizeof(double));
+    return Val_unit;
+  }
+#endif
+  CAMLassert (Tag_val(a2) != Double_array_tag);
+  if (Is_young(a2)) {
+    /* Arrays of values, destination is in young generation.
+       Here too we can do a direct copy since this cannot create
+       old-to-young pointers, nor mess up with the incremental major GC.
+       Again, memmove takes care of overlap. */
+    memmove(&Field(a2, Long_val(ofs2)),
+            &Field(a1, Long_val(ofs1)),
+            Long_val(n) * sizeof(value));
+    return Val_unit;
+  }
+  /* Array of values, destination is in old generation.
+     We must use caml_modify.  */
+  count = Long_val(n);
+  if (a1 == a2 && Long_val(ofs1) < Long_val(ofs2)) {
+    /* Copy in descending order */
+    for (dst = &Field(a2, Long_val(ofs2) + count - 1),
+           src = &Field(a1, Long_val(ofs1) + count - 1);
+         count > 0;
+         count--, src--, dst--) {
+      caml_modify(dst, *src);
+    }
+  } else {
+    /* Copy in ascending order */
+    for (dst = &Field(a2, Long_val(ofs2)), src = &Field(a1, Long_val(ofs1));
+         count > 0;
+         count--, src++, dst++) {
+      caml_modify(dst, *src);
+    }
+  }
+  /* Many caml_modify in a row can create a lot of old-to-young refs.
+     Give the minor GC a chance to run if it needs to. */
+  caml_check_urgent_gc(Val_unit);
+  return Val_unit;
+}
+
+/* A generic function for extraction and concatenation of sub-arrays */
+
+static value caml_array_gather(intnat num_arrays,
+                               value arrays[/*num_arrays*/],
+                               intnat offsets[/*num_arrays*/],
+                               intnat lengths[/*num_arrays*/])
+{
+  CAMLparamN(arrays, num_arrays);
+  value res;                    /* no need to register it as a root */
+#ifdef FLAT_FLOAT_ARRAY
+  int isfloat = 0;
+  mlsize_t wsize;
+#endif
+  mlsize_t i, size, count, pos;
+  value * src;
+
+  /* Determine total size and whether result array is an array of floats */
+  size = 0;
+  for (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
+  }
+  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++) {
+      memcpy((double *)res + pos,
+             (double *)arrays[i] + offsets[i],
+             lengths[i] * sizeof(double));
+      pos += lengths[i];
+    }
+    CAMLassert(pos == size);
+  }
+#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++) {
+      memcpy(&Field(res, pos),
+             &Field(arrays[i], offsets[i]),
+             lengths[i] * sizeof(value));
+      pos += lengths[i];
+    }
+    CAMLassert(pos == size);
+  }
+  else if (size > Max_wosize) {
+    /* Array of values, too big. */
+    caml_invalid_argument("Array.concat");
+  } else {
+    /* 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];
+           count > 0;
+           count--, src++, pos++) {
+        caml_initialize(&Field(res, pos), *src);
+      }
+    }
+    CAMLassert(pos == size);
+
+    /* Many caml_initialize in a row can create a lot of old-to-young
+       refs.  Give the minor GC a chance to run if it needs to.
+       Run memprof callbacks for the major allocation. */
+    res = caml_process_pending_actions_with_root (res);
+  }
+  CAMLreturn (res);
+}
+
+CAMLprim value caml_array_sub(value a, value ofs, value len)
+{
+  value arrays[1] = { a };
+  intnat offsets[1] = { Long_val(ofs) };
+  intnat lengths[1] = { Long_val(len) };
+  return caml_array_gather(1, arrays, offsets, lengths);
+}
+
+CAMLprim value caml_array_append(value a1, value a2)
+{
+  value arrays[2] = { a1, a2 };
+  intnat offsets[2] = { 0, 0 };
+  intnat lengths[2] = { caml_array_length(a1), caml_array_length(a2) };
+  return caml_array_gather(2, arrays, offsets, lengths);
+}
+
+CAMLprim value caml_array_concat(value al)
+{
+#define STATIC_SIZE 16
+  value static_arrays[STATIC_SIZE], * arrays;
+  intnat static_offsets[STATIC_SIZE], * offsets;
+  intnat static_lengths[STATIC_SIZE], * lengths;
+  intnat n, i;
+  value l, res;
+
+  /* Length of list = number of arrays */
+  for (n = 0, l = al; l != Val_int(0); l = Field(l, 1)) n++;
+  /* Allocate extra storage if too many arrays */
+  if (n <= STATIC_SIZE) {
+    arrays = static_arrays;
+    offsets = static_offsets;
+    lengths = static_lengths;
+  } else {
+    arrays = caml_stat_alloc(n * sizeof(value));
+    offsets = caml_stat_alloc_noexc(n * sizeof(intnat));
+    if (offsets == NULL) {
+      caml_stat_free(arrays);
+      caml_raise_out_of_memory();
+    }
+    lengths = caml_stat_alloc_noexc(n * sizeof(value));
+    if (lengths == NULL) {
+      caml_stat_free(offsets);
+      caml_stat_free(arrays);
+      caml_raise_out_of_memory();
+    }
+  }
+  /* Build the parameters to caml_array_gather */
+  for (i = 0, l = al; l != Val_int(0); l = Field(l, 1), i++) {
+    arrays[i] = Field(l, 0);
+    offsets[i] = 0;
+    lengths[i] = caml_array_length(Field(l, 0));
+  }
+  /* Do the concatenation */
+  res = caml_array_gather(n, arrays, offsets, lengths);
+  /* Free the extra storage if needed */
+  if (n > STATIC_SIZE) {
+    caml_stat_free(arrays);
+    caml_stat_free(offsets);
+    caml_stat_free(lengths);
+  }
+  return res;
+}
+
+CAMLprim value caml_array_fill(value array,
+                               value v_ofs,
+                               value v_len,
+                               value val)
+{
+  intnat ofs = Long_val(v_ofs);
+  intnat len = Long_val(v_len);
+  value* fp;
+
+  /* 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;
+  } else {
+    int is_val_young_block = Is_block(val) && Is_young(val);
+    CAMLassert(Is_in_heap(fp));
+    for (; len > 0; len--, fp++) {
+      value old = *fp;
+      if (old == val) continue;
+      *fp = val;
+      if (Is_block(old)) {
+        if (Is_young(old)) continue;
+        if (caml_gc_phase == Phase_mark) caml_darken(old, NULL);
+      }
+      if (is_val_young_block)
+        add_to_ref_table (Caml_state->ref_table, fp);
+    }
+    if (is_val_young_block) caml_check_urgent_gc (Val_unit);
+  }
+  return Val_unit;
+}
diff --git a/runtime/backtrace.c b/runtime/backtrace.c
new file mode 100644
index 00000000..3e68a356
--- /dev/null
+++ b/runtime/backtrace.c
@@ -0,0 +1,343 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2000 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
+
+/* Stack backtrace for uncaught exceptions */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "caml/alloc.h"
+#include "caml/memory.h"
+#include "caml/backtrace.h"
+#include "caml/backtrace_prim.h"
+#include "caml/fail.h"
+#include "caml/debugger.h"
+
+void caml_init_backtrace(void)
+{
+  caml_register_global_root(&Caml_state->backtrace_last_exn);
+}
+
+/* Start or stop the backtrace machinery */
+CAMLprim value caml_record_backtrace(value vflag)
+{
+  int flag = Int_val(vflag);
+
+  if (flag != Caml_state->backtrace_active) {
+    Caml_state->backtrace_active = flag;
+    Caml_state->backtrace_pos = 0;
+    Caml_state->backtrace_last_exn = Val_unit;
+    /* Note: We do lazy initialization of Caml_state->backtrace_buffer when
+       needed in order to simplify the interface with the thread
+       library (thread creation doesn't need to allocate
+       Caml_state->backtrace_buffer). So we don't have to allocate it here.
+    */
+  }
+  return Val_unit;
+}
+
+/* Return the status of the backtrace machinery */
+CAMLprim value caml_backtrace_status(value vunit)
+{
+  return Val_bool(Caml_state->backtrace_active);
+}
+
+/* Print location information -- same behavior as in Printexc
+
+   note that the test for compiler-inserted raises is slightly redundant:
+     (!li->loc_valid && li->loc_is_raise)
+   caml_debuginfo_location guarantees that when li->loc_valid is
+   0, then li->loc_is_raise is always 1, so the latter test is
+   useless. We kept it to keep code identical to the runtime/
+   implementation. */
+static void print_location(struct caml_loc_info * li, int index)
+{
+  char * info;
+  char * inlined;
+
+  /* Ignore compiler-inserted raise */
+  if (!li->loc_valid && li->loc_is_raise) return;
+
+  if (li->loc_is_raise) {
+    /* Initial raise if index == 0, re-raise otherwise */
+    if (index == 0)
+      info = "Raised at";
+    else
+      info = "Re-raised at";
+  } else {
+    if (index == 0)
+      info = "Raised by primitive operation at";
+    else
+      info = "Called from";
+  }
+  if (li->loc_is_inlined) {
+    inlined = " (inlined)";
+  } else {
+    inlined = "";
+  }
+  if (! li->loc_valid) {
+    fprintf(stderr, "%s unknown location%s\n", info, inlined);
+  } else {
+    fprintf (stderr, "%s %s in file \"%s\"%s, line %d, characters %d-%d\n",
+             info, li->loc_defname, li->loc_filename, inlined, li->loc_lnum,
+             li->loc_startchr, li->loc_endchr);
+  }
+}
+
+/* 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: "
+                    "no debug information available)\n");
+    return;
+  }
+
+  for (i = 0; i < Caml_state->backtrace_pos; i++) {
+    for (dbg = caml_debuginfo_extract(Caml_state->backtrace_buffer[i]);
+         dbg != NULL;
+         dbg = caml_debuginfo_next(dbg))
+    {
+      caml_debuginfo_location(dbg, &li);
+      print_location(&li, i);
+    }
+  }
+}
+
+/* Get a copy of the latest backtrace */
+CAMLprim value caml_get_exception_raw_backtrace(value unit)
+{
+  CAMLparam0();
+  CAMLlocal1(res);
+
+  if (!Caml_state->backtrace_active ||
+      Caml_state->backtrace_buffer == NULL ||
+      Caml_state->backtrace_pos == 0) {
+    res = caml_alloc(0, 0);
+  }
+  else {
+    intnat i, len = Caml_state->backtrace_pos;
+
+    res = caml_alloc(len, 0);
+    for (i = 0; i < len; i++)
+      Field(res, i) = Val_backtrace_slot(Caml_state->backtrace_buffer[i]);
+  }
+
+  CAMLreturn(res);
+}
+
+/* Copy back a backtrace and exception to the global state.
+   This function should be used only with Printexc.raw_backtrace */
+/* noalloc (caml value): so no CAMLparam* CAMLreturn* */
+CAMLprim value caml_restore_raw_backtrace(value exn, value backtrace)
+{
+  intnat i;
+  mlsize_t bt_size;
+
+  Caml_state->backtrace_last_exn = exn;
+
+  bt_size = Wosize_val(backtrace);
+  if(bt_size > BACKTRACE_BUFFER_SIZE){
+    bt_size = BACKTRACE_BUFFER_SIZE;
+  }
+
+  /* We don't allocate if the backtrace is empty (no -g or backtrace
+     not activated) */
+  if(bt_size == 0){
+    Caml_state->backtrace_pos = 0;
+    return Val_unit;
+  }
+
+  /* Allocate if needed and copy the backtrace buffer */
+  if (Caml_state->backtrace_buffer == NULL &&
+      caml_alloc_backtrace_buffer() == -1) {
+    return Val_unit;
+  }
+
+  Caml_state->backtrace_pos = bt_size;
+  for(i=0; i < Caml_state->backtrace_pos; i++){
+    Caml_state->backtrace_buffer[i] = Backtrace_slot_val(Field(backtrace, i));
+  }
+
+  return Val_unit;
+}
+
+#define Val_debuginfo(bslot) (Val_long((uintnat)(bslot)>>1))
+#define Debuginfo_val(vslot) ((debuginfo)(Long_val(vslot) << 1))
+
+/* Convert the raw backtrace to a data structure usable from OCaml */
+static value caml_convert_debuginfo(debuginfo dbg)
+{
+  CAMLparam0();
+  CAMLlocal3(p, fname, dname);
+  struct caml_loc_info li;
+
+  caml_debuginfo_location(dbg, &li);
+
+  if (li.loc_valid) {
+    fname = caml_copy_string(li.loc_filename);
+    dname = caml_copy_string(li.loc_defname);
+    p = caml_alloc_small(7, 0);
+    Field(p, 0) = Val_bool(li.loc_is_raise);
+    Field(p, 1) = fname;
+    Field(p, 2) = Val_int(li.loc_lnum);
+    Field(p, 3) = Val_int(li.loc_startchr);
+    Field(p, 4) = Val_int(li.loc_endchr);
+    Field(p, 5) = Val_bool(li.loc_is_inlined);
+    Field(p, 6) = dname;
+  } else {
+    p = caml_alloc_small(1, 1);
+    Field(p, 0) = Val_bool(li.loc_is_raise);
+  }
+
+  CAMLreturn(p);
+}
+
+CAMLprim value caml_convert_raw_backtrace_slot(value slot)
+{
+  if (!caml_debug_info_available())
+    caml_failwith("No debug information available");
+
+  return (caml_convert_debuginfo(Debuginfo_val(slot)));
+}
+
+/* Convert the raw backtrace to a data structure usable from OCaml */
+CAMLprim value caml_convert_raw_backtrace(value bt)
+{
+  CAMLparam1(bt);
+  CAMLlocal1(array);
+  intnat i, index;
+
+  if (!caml_debug_info_available())
+    caml_failwith("No debug information available");
+
+  for (i = 0, index = 0; i < Wosize_val(bt); ++i)
+  {
+    debuginfo dbg;
+    for (dbg = caml_debuginfo_extract(Backtrace_slot_val(Field(bt, i)));
+         dbg != NULL;
+         dbg = caml_debuginfo_next(dbg))
+      index++;
+  }
+
+  array = caml_alloc(index, 0);
+
+  for (i = 0, index = 0; i < Wosize_val(bt); ++i)
+  {
+    debuginfo dbg;
+    for (dbg = caml_debuginfo_extract(Backtrace_slot_val(Field(bt, i)));
+         dbg != NULL;
+         dbg = caml_debuginfo_next(dbg))
+    {
+      Store_field(array, index, caml_convert_debuginfo(dbg));
+      index++;
+    }
+  }
+
+  CAMLreturn(array);
+}
+
+CAMLprim value caml_raw_backtrace_length(value bt)
+{
+  return Val_int(Wosize_val(bt));
+}
+
+CAMLprim value caml_raw_backtrace_slot(value bt, value index)
+{
+  uintnat i;
+  debuginfo dbg;
+
+  i = Long_val(index);
+  if (i >= Wosize_val(bt))
+    caml_invalid_argument("Printexc.get_raw_backtrace_slot: "
+                          "index out of bounds");
+  dbg = caml_debuginfo_extract(Backtrace_slot_val(Field(bt, i)));
+  return Val_debuginfo(dbg);
+}
+
+CAMLprim value caml_raw_backtrace_next_slot(value slot)
+{
+  debuginfo dbg;
+
+  CAMLparam1(slot);
+  CAMLlocal1(v);
+
+  dbg = Debuginfo_val(slot);
+  dbg = caml_debuginfo_next(dbg);
+
+  if (dbg == NULL)
+    v = Val_int(0); /* None */
+  else
+  {
+    v = caml_alloc(1, 0);
+    Field(v, 0) = Val_debuginfo(dbg);
+  }
+
+  CAMLreturn(v);
+}
+
+/* the function below is deprecated: we previously returned directly
+   the OCaml-usable representation, instead of the raw backtrace as an
+   abstract type, but this has a large performance overhead if you
+   store a lot of backtraces and print only some of them.
+
+   It is not used by the Printexc library anymore, or anywhere else in
+   the compiler, but we have kept it in case some user still depends
+   on it as an external.  */
+CAMLprim value caml_get_exception_backtrace(value unit)
+{
+  CAMLparam0();
+  CAMLlocal3(arr, res, backtrace);
+  intnat i;
+
+  if (!caml_debug_info_available()) {
+    res = Val_int(0); /* None */
+  } else {
+    backtrace = caml_get_exception_raw_backtrace(Val_unit);
+
+    arr = caml_alloc(Wosize_val(backtrace), 0);
+    for (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));
+    }
+
+    res = caml_alloc_small(1, 0); Field(res, 0) = arr; /* Some */
+  }
+
+  CAMLreturn(res);
+}
+
+CAMLprim value caml_get_current_callstack(value max_frames_value)
+{
+  CAMLparam1(max_frames_value);
+  CAMLlocal1(res);
+  value* callstack = NULL;
+  intnat callstack_alloc_len = 0;
+  intnat callstack_len =
+    caml_collect_current_callstack(&callstack, &callstack_alloc_len,
+                                   Long_val(max_frames_value), -1);
+  res = caml_alloc(callstack_len, 0);
+  memcpy(Op_val(res), callstack, sizeof(value) * callstack_len);
+  caml_stat_free(callstack);
+  CAMLreturn(res);
+}
diff --git a/runtime/backtrace_byt.c b/runtime/backtrace_byt.c
new file mode 100644
index 00000000..28fe44c7
--- /dev/null
+++ b/runtime/backtrace_byt.c
@@ -0,0 +1,491 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2000 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
+
+/* Stack backtrace for uncaught exceptions */
+
+#include <fcntl.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "caml/config.h"
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+
+#include "caml/mlvalues.h"
+#include "caml/alloc.h"
+#include "caml/custom.h"
+#include "caml/io.h"
+#include "caml/instruct.h"
+#include "caml/intext.h"
+#include "caml/exec.h"
+#include "caml/fix_code.h"
+#include "caml/memory.h"
+#include "caml/startup.h"
+#include "caml/stacks.h"
+#include "caml/sys.h"
+#include "caml/backtrace.h"
+#include "caml/fail.h"
+#include "caml/backtrace_prim.h"
+#include "caml/debugger.h"
+
+/* The table of debug information fragments */
+struct ext_table caml_debug_info;
+
+CAMLexport char_os * caml_cds_file = NULL;
+
+/* Location of fields in the Instruct.debug_event record */
+enum {
+  EV_POS = 0,
+  EV_MODULE = 1,
+  EV_LOC = 2,
+  EV_KIND = 3,
+  EV_DEFNAME = 4
+};
+
+/* Location of fields in the Location.t record. */
+enum {
+  LOC_START = 0,
+  LOC_END = 1,
+  LOC_GHOST = 2
+};
+
+/* Location of fields in the Lexing.position record. */
+enum {
+  POS_FNAME = 0,
+  POS_LNUM = 1,
+  POS_BOL = 2,
+  POS_CNUM = 3
+};
+
+/* Runtime representation of the debug information, optimized
+   for quick lookup */
+struct ev_info {
+  code_t ev_pc;
+  char *ev_filename;
+  char *ev_defname;
+  int ev_lnum;
+  int ev_startchr;
+  int ev_endchr;
+};
+
+struct debug_info {
+  code_t start;
+  code_t end;
+  mlsize_t num_events;
+  struct ev_info *events;
+  int already_read;
+};
+
+static struct debug_info *find_debug_info(code_t pc)
+{
+  int i;
+  for (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;
+  }
+  return NULL;
+}
+
+static int cmp_ev_info(const void *a, const void *b)
+{
+  const struct ev_info* ev_a = a;
+  const struct ev_info* ev_b = b;
+  code_t pc_a = ev_a->ev_pc;
+  code_t pc_b = ev_b->ev_pc;
+  int num_a;
+  int num_b;
+
+  /* Perform a full lexicographic comparison to make sure the resulting order is
+     the same under all implementations of qsort (which is not stable). */
+
+  if (pc_a > pc_b) return 1;
+  if (pc_a < pc_b) return -1;
+
+  num_a = ev_a->ev_lnum;
+  num_b = ev_b->ev_lnum;
+
+  if (num_a > num_b) return 1;
+  if (num_a < num_b) return -1;
+
+  num_a = ev_a->ev_startchr;
+  num_b = ev_b->ev_startchr;
+
+  if (num_a > num_b) return 1;
+  if (num_a < num_b) return -1;
+
+  num_a = ev_a->ev_endchr;
+  num_b = ev_b->ev_endchr;
+
+  if (num_a > num_b) return 1;
+  if (num_a < num_b) return -1;
+
+  return 0;
+}
+
+static struct ev_info *process_debug_events(code_t code_start,
+                                            value events_heap,
+                                            mlsize_t *num_events)
+{
+  CAMLparam1(events_heap);
+  CAMLlocal3(l, ev, ev_start);
+  mlsize_t i, 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 (l = Field(events_heap, i); l != Val_int(0); l = Field(l, 1))
+      (*num_events)++;
+
+  if (*num_events == 0)
+      CAMLreturnT(struct ev_info *, NULL);
+
+  events = caml_stat_alloc_noexc(*num_events * sizeof(struct ev_info));
+  if(events == NULL)
+    caml_fatal_error ("caml_add_debug_info: out of memory");
+
+  j = 0;
+  for (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);
+
+      events[j].ev_pc = (code_t)((char*)code_start
+                                 + Long_val(Field(ev, EV_POS)));
+
+      ev_start = Field(Field(ev, EV_LOC), LOC_START);
+
+      {
+        const char *fname = String_val(Field(ev_start, POS_FNAME));
+        events[j].ev_filename = caml_stat_strdup_noexc(fname);
+        if(events[j].ev_filename == NULL)
+          caml_fatal_error ("caml_add_debug_info: out of memory");
+      }
+
+      if (Is_block(Field(ev, EV_DEFNAME)) &&
+          Tag_val(Field(ev, EV_DEFNAME)) == String_tag) {
+        const char *dname = String_val(Field(ev, EV_DEFNAME));
+        events[j].ev_defname = caml_stat_strdup_noexc(dname);
+        if (events[j].ev_defname == NULL)
+          caml_fatal_error ("caml_add_debug_info: out of memory");
+      } else {
+        events[j].ev_defname = "<old bytecode>";
+      }
+
+      events[j].ev_lnum = Int_val(Field(ev_start, POS_LNUM));
+      events[j].ev_startchr =
+        Int_val(Field(ev_start, POS_CNUM))
+        - Int_val(Field(ev_start, POS_BOL));
+      events[j].ev_endchr =
+        Int_val(Field(Field(Field(ev, EV_LOC), LOC_END), POS_CNUM))
+        - Int_val(Field(ev_start, POS_BOL));
+
+      j++;
+    }
+  }
+
+  CAMLassert(j == *num_events);
+
+  qsort(events, *num_events, sizeof(struct ev_info), cmp_ev_info);
+
+  CAMLreturnT(struct ev_info *, events);
+}
+
+/* Processes a (Instruct.debug_event list array) into a form suitable
+   for quick lookup and registers it for the (code_start,code_size) pc range. */
+CAMLprim value caml_add_debug_info(code_t code_start, value code_size,
+                                   value events_heap)
+{
+  CAMLparam1(events_heap);
+  struct debug_info *debug_info;
+
+  if (events_heap != Val_unit)
+    caml_debugger(DEBUG_INFO_ADDED, events_heap);
+
+  /* build the OCaml-side debug_info value */
+  debug_info = caml_stat_alloc(sizeof(struct debug_info));
+
+  debug_info->start = code_start;
+  debug_info->end = (code_t)((char*) code_start + Long_val(code_size));
+  if (events_heap == Val_unit) {
+    debug_info->events = NULL;
+    debug_info->num_events = 0;
+    debug_info->already_read = 0;
+  } else {
+    debug_info->events =
+      process_debug_events(code_start, events_heap, &debug_info->num_events);
+    debug_info->already_read = 1;
+  }
+
+  caml_ext_table_add(&caml_debug_info, debug_info);
+
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value caml_remove_debug_info(code_t start)
+{
+  CAMLparam0();
+  CAMLlocal2(dis, prev);
+
+  int i;
+  for (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
+         removed resource, bracketing the caml_stat_alloc call in
+         caml_add_debug_info. */
+      caml_ext_table_remove(&caml_debug_info, di);
+      break;
+    }
+  }
+
+  CAMLreturn(Val_unit);
+}
+
+int caml_alloc_backtrace_buffer(void){
+  CAMLassert(Caml_state->backtrace_pos == 0);
+  Caml_state->backtrace_buffer =
+    caml_stat_alloc_noexc(BACKTRACE_BUFFER_SIZE * sizeof(code_t));
+  if (Caml_state->backtrace_buffer == NULL) return -1;
+  return 0;
+}
+
+/* Store the return addresses contained in the given stack fragment
+   into the backtrace array */
+
+void caml_stash_backtrace(value exn, value * sp, int reraise)
+{
+  if (exn != Caml_state->backtrace_last_exn || !reraise) {
+    Caml_state->backtrace_pos = 0;
+    Caml_state->backtrace_last_exn = exn;
+  }
+
+  if (Caml_state->backtrace_buffer == NULL &&
+      caml_alloc_backtrace_buffer() == -1)
+    return;
+
+  /* Traverse the stack and put all values pointing into bytecode
+     into the backtrace buffer. */
+  for (/*nothing*/; sp < Caml_state->trapsp; sp++) {
+    code_t p;
+    if (Is_long(*sp)) continue;
+    p = (code_t) *sp;
+    if (Caml_state->backtrace_pos >= BACKTRACE_BUFFER_SIZE) break;
+    if (find_debug_info(p) != NULL)
+      Caml_state->backtrace_buffer[Caml_state->backtrace_pos++] = p;
+  }
+}
+
+/* returns the next frame pointer (or NULL if none is available);
+   updates *sp to point to the following one, and *trsp to the next
+   trap frame, which we will skip when we reach it  */
+
+code_t caml_next_frame_pointer(value ** sp, value ** trsp)
+{
+  while (*sp < Caml_state->stack_high) {
+    value *spv = (*sp)++;
+    code_t *p;
+    if (Is_long(*spv)) continue;
+    p = (code_t*) spv;
+    if(&Trap_pc(*trsp) == p) {
+      *trsp = Trap_link(*trsp);
+      continue;
+    }
+
+    if (find_debug_info(*p) != NULL)
+      return *p;
+  }
+  return NULL;
+}
+
+#define Default_callstack_size 32
+intnat caml_collect_current_callstack(value** ptrace, intnat* plen,
+                                      intnat max_frames, int alloc_idx)
+{
+  value * sp = Caml_state->extern_sp;
+  value * trsp = Caml_state->trapsp;
+  intnat trace_pos = 0;
+  CAMLassert(alloc_idx == 0 || alloc_idx == -1);
+
+  if (max_frames <= 0) return 0;
+  if (*plen == 0) {
+    value* trace =
+      caml_stat_alloc_noexc(Default_callstack_size * sizeof(value));
+    if (trace == NULL) return 0;
+    *ptrace = trace;
+    *plen = Default_callstack_size;
+  }
+
+  while (trace_pos < max_frames) {
+    code_t p = caml_next_frame_pointer(&sp, &trsp);
+    if (p == NULL) break;
+    if (trace_pos == *plen) {
+      intnat new_len = *plen * 2;
+      value * trace = caml_stat_resize_noexc(*ptrace, new_len * sizeof(value));
+      if (trace == NULL) break;
+      *ptrace = trace;
+      *plen = new_len;
+    }
+    (*ptrace)[trace_pos++] = Val_backtrace_slot(p);
+  }
+
+  return trace_pos;
+}
+
+/* Read the debugging info contained in the current bytecode executable. */
+
+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;
+  struct channel *chan;
+  struct exec_trailer trail;
+
+  CAMLassert(di->already_read == 0);
+  di->already_read = 1;
+
+  /* At the moment, bytecode programs built with --output-complete-exe
+     do not contain any debug info.
+
+     See  https://github.com/ocaml/ocaml/issues/9344 for details.
+  */
+  if (caml_cds_file == NULL && caml_byte_program_mode == COMPLETE_EXE)
+    CAMLreturn0;
+
+  if (caml_cds_file != NULL) {
+    exec_name = caml_cds_file;
+  } else {
+    exec_name = caml_exe_name;
+  }
+
+  fd = caml_attempt_open(&exec_name, &trail, 1);
+  if (fd < 0){
+    caml_fatal_error ("executable program file not found");
+    CAMLreturn0;
+  }
+
+  caml_read_section_descriptors(fd, &trail);
+  if (caml_seek_optional_section(fd, &trail, "DBUG") != -1) {
+    chan = caml_open_descriptor_in(fd);
+
+    num_events = caml_getword(chan);
+    events = caml_alloc(num_events, 0);
+
+    for (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 */
+      /* Relocate events in event list */
+      for (l = evl; l != Val_int(0); l = Field(l, 1)) {
+        value ev = Field(l, 0);
+        Field(ev, EV_POS) = Val_long(Long_val(Field(ev, EV_POS)) + orig);
+      }
+      /* Record event list */
+      Store_field(events, i, evl);
+    }
+
+    caml_close_channel(chan);
+
+    di->events = process_debug_events(caml_start_code, events, &di->num_events);
+  }
+
+  CAMLreturn0;
+}
+
+CAMLexport void caml_init_debug_info(void)
+{
+  caml_ext_table_init(&caml_debug_info, 1);
+  caml_add_debug_info(caml_start_code, Val_long(caml_code_size), Val_unit);
+}
+
+int caml_debug_info_available(void)
+{
+  return (caml_debug_info.size != 0);
+}
+
+/* Search the event index for the given PC.  Return -1 if not found. */
+
+static struct ev_info *event_for_location(code_t pc)
+{
+  uintnat low, high;
+  struct debug_info *di = find_debug_info(pc);
+
+  if (di == NULL)
+    return NULL;
+
+  if (!di->already_read)
+    read_main_debug_info(di);
+
+  if (di->num_events == 0)
+    return NULL;
+
+  low = 0;
+  high = di->num_events;
+  while (low+1 < high) {
+    uintnat m = (low+high)/2;
+    if(pc < di->events[m].ev_pc) high = m;
+    else low = m;
+  }
+  if (di->events[low].ev_pc == pc)
+    return &di->events[low];
+  /* ocamlc sometimes moves an event past a following PUSH instruction;
+     allow mismatch by 1 instruction. */
+  if (di->events[low].ev_pc == pc + 1)
+    return &di->events[low];
+  if (low+1 < di->num_events && di->events[low+1].ev_pc == pc + 1)
+    return &di->events[low+1];
+
+  return NULL;
+}
+
+/* Extract location information for the given PC */
+
+void caml_debuginfo_location(debuginfo dbg,
+                             /*out*/ struct caml_loc_info * li)
+{
+  code_t pc = dbg;
+  struct ev_info *event = event_for_location(pc);
+  li->loc_is_raise =
+    caml_is_instruction(*pc, RAISE) ||
+    caml_is_instruction(*pc, RERAISE);
+  if (event == NULL) {
+    li->loc_valid = 0;
+    return;
+  }
+  li->loc_valid = 1;
+  li->loc_is_inlined = 0;
+  li->loc_filename = event->ev_filename;
+  li->loc_defname = event->ev_defname;
+  li->loc_lnum = event->ev_lnum;
+  li->loc_startchr = event->ev_startchr;
+  li->loc_endchr = event->ev_endchr;
+}
+
+debuginfo caml_debuginfo_extract(backtrace_slot slot)
+{
+  return (debuginfo)slot;
+}
+
+debuginfo caml_debuginfo_next(debuginfo dbg)
+{
+  /* No inlining in bytecode */
+  return NULL;
+}
diff --git a/runtime/backtrace_nat.c b/runtime/backtrace_nat.c
new file mode 100644
index 00000000..893ba15d
--- /dev/null
+++ b/runtime/backtrace_nat.c
@@ -0,0 +1,297 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2006 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
+
+/* Stack backtrace for uncaught exceptions */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "caml/alloc.h"
+#include "caml/backtrace.h"
+#include "caml/backtrace_prim.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/stack.h"
+
+/* 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(uintnat * pc, char ** sp)
+{
+  frame_descr * d;
+  uintnat h;
+
+  while (1) {
+    h = Hash_retaddr(*pc);
+    while (1) {
+      d = caml_frame_descriptors[h];
+      if (d == NULL) return NULL; /* happens if some code compiled without -g */
+      if (d->retaddr == *pc) break;
+      h = (h+1) & caml_frame_descriptors_mask;
+    }
+    /* Skip to next frame */
+    if (d->frame_size != 0xFFFF) {
+      /* Regular frame, update sp/pc and return the frame descriptor */
+      *sp += (d->frame_size & 0xFFFC);
+      *pc = Saved_return_address(*sp);
+#ifdef Mask_already_scanned
+      *pc = Mask_already_scanned(*pc);
+#endif
+      return d;
+    } else {
+      /* Special frame marking the top of a stack chunk for an ML callback.
+         Skip C portion of stack and continue with next ML stack chunk. */
+      struct caml_context * next_context = Callback_link(*sp);
+      *sp = next_context->bottom_of_stack;
+      *pc = next_context->last_retaddr;
+      /* A null sp means no more ML stack chunks; stop here. */
+      if (*sp == NULL) return NULL;
+    }
+  }
+}
+
+int caml_alloc_backtrace_buffer(void){
+  CAMLassert(Caml_state->backtrace_pos == 0);
+  Caml_state->backtrace_buffer =
+    caml_stat_alloc_noexc(BACKTRACE_BUFFER_SIZE * sizeof(backtrace_slot));
+  if (Caml_state->backtrace_buffer == NULL) return -1;
+  return 0;
+}
+
+/* Stores the return addresses contained in the given stack fragment
+   into the backtrace array ; this version is performance-sensitive as
+   it is called at each [raise] in a program compiled with [-g], so we
+   preserved the global, statically bounded buffer of the old
+   implementation -- before the more flexible
+   [caml_get_current_callstack] was implemented. */
+void caml_stash_backtrace(value exn, uintnat pc, char * sp, char * trapsp)
+{
+  if (exn != Caml_state->backtrace_last_exn) {
+    Caml_state->backtrace_pos = 0;
+    Caml_state->backtrace_last_exn = exn;
+  }
+
+  if (Caml_state->backtrace_buffer == NULL &&
+      caml_alloc_backtrace_buffer() == -1)
+    return;
+
+  /* iterate on each frame  */
+  while (1) {
+    frame_descr * descr = caml_next_frame_descriptor(&pc, &sp);
+    if (descr == NULL) return;
+    /* store its descriptor in the backtrace buffer */
+    if (Caml_state->backtrace_pos >= BACKTRACE_BUFFER_SIZE) return;
+    Caml_state->backtrace_buffer[Caml_state->backtrace_pos++] =
+      (backtrace_slot) descr;
+
+    /* Stop when we reach the current exception handler */
+    if (sp > trapsp) return;
+  }
+}
+
+/* A backtrace_slot is either a debuginfo or a frame_descr* */
+#define Slot_is_debuginfo(s) ((uintnat)(s) & 2)
+#define Debuginfo_slot(s) ((debuginfo)((uintnat)(s) - 2))
+#define Slot_debuginfo(d) ((backtrace_slot)((uintnat)(d) + 2))
+#define Frame_descr_slot(s) ((frame_descr*)(s))
+#define Slot_frame_descr(f) ((backtrace_slot)(f))
+static debuginfo debuginfo_extract(frame_descr* d, int alloc_idx);
+
+#define Default_callstack_size 32
+intnat caml_collect_current_callstack(value** ptrace, intnat* plen,
+                                      intnat max_frames, int alloc_idx)
+{
+  uintnat pc = Caml_state->last_return_address;
+  char * sp = Caml_state->bottom_of_stack;
+  intnat trace_pos = 0;
+
+  if (max_frames <= 0) return 0;
+  if (*plen == 0) {
+    value* trace =
+      caml_stat_alloc_noexc(Default_callstack_size * sizeof(value));
+    if (trace == NULL) return 0;
+    *ptrace = trace;
+    *plen = Default_callstack_size;
+  }
+
+  if (alloc_idx >= 0) {
+    /* First frame has a Comballoc selector */
+    frame_descr * descr = caml_next_frame_descriptor(&pc, &sp);
+    debuginfo info;
+    if (descr == NULL) return 0;
+    info = debuginfo_extract(descr, alloc_idx);
+    if (info != NULL) {
+      CAMLassert(((uintnat)info & 3) == 0);
+      (*ptrace)[trace_pos++] = Val_backtrace_slot(Slot_debuginfo(info));
+    } else {
+      (*ptrace)[trace_pos++] = Val_backtrace_slot(Slot_frame_descr(descr));
+    }
+  }
+
+  while (trace_pos < max_frames) {
+    frame_descr * descr = caml_next_frame_descriptor(&pc, &sp);
+    if (descr == NULL) break;
+    CAMLassert(((uintnat)descr & 3) == 0);
+    if (trace_pos == *plen) {
+      intnat new_len = *plen * 2;
+      value * trace = caml_stat_resize_noexc(*ptrace, new_len * sizeof(value));
+      if (trace == NULL) break;
+      *ptrace = trace;
+      *plen = new_len;
+    }
+    (*ptrace)[trace_pos++] = Val_backtrace_slot(Slot_frame_descr(descr));
+  }
+
+  return trace_pos;
+}
+
+static debuginfo debuginfo_extract(frame_descr* d, int alloc_idx)
+{
+  unsigned char* infoptr;
+  uint32_t debuginfo_offset;
+
+  /* The special frames marking the top of an ML stack chunk are never
+     returned by caml_next_frame_descriptor, so should never reach here. */
+  CAMLassert(d->frame_size != 0xffff);
+
+  if ((d->frame_size & 1) == 0) {
+    return NULL;
+  }
+  /* Recover debugging info */
+  infoptr = (unsigned char*)&d->live_ofs[d->num_live];
+  if (d->frame_size & 2) {
+    CAMLassert(alloc_idx == -1 || (0 <= alloc_idx && alloc_idx < *infoptr));
+    /* skip alloc_lengths */
+    infoptr += *infoptr + 1;
+    /* align to 32 bits */
+    infoptr = Align_to(infoptr, uint32_t);
+    /* select the right debug info for this allocation */
+    if (alloc_idx != -1) {
+      infoptr += alloc_idx * sizeof(uint32_t);
+      if (*(uint32_t*)infoptr == 0) {
+        /* No debug info for this particular allocation */
+        return NULL;
+      }
+    } else {
+      /* We don't care which alloc_idx we use, so use the first
+         that has debug info. (e.g. this is a backtrace through a
+         finaliser/signal handler triggered via a Comballoc alloc) */
+      while (*(uint32_t*)infoptr == 0) {
+        infoptr += sizeof(uint32_t);
+      }
+    }
+  } else {
+    /* align to 32 bits */
+    infoptr = Align_to(infoptr, uint32_t);
+    CAMLassert(alloc_idx == -1);
+  }
+  debuginfo_offset = *(uint32_t*)infoptr;
+  CAMLassert(debuginfo_offset != 0 && (debuginfo_offset & 3) == 0);
+  return (debuginfo)(infoptr + debuginfo_offset);
+}
+
+debuginfo caml_debuginfo_extract(backtrace_slot slot)
+{
+  if (Slot_is_debuginfo(slot)) {
+    /* already a decoded debuginfo */
+    return Debuginfo_slot(slot);
+  } else {
+    return debuginfo_extract(Frame_descr_slot(slot), -1);
+  }
+}
+
+debuginfo caml_debuginfo_next(debuginfo dbg)
+{
+  uint32_t * infoptr;
+
+  if (dbg == NULL)
+    return NULL;
+
+  infoptr = dbg;
+  if ((infoptr[0] & 1) == 0)
+    /* No next debuginfo */
+    return NULL;
+  else
+    /* Next debuginfo is after the two packed info fields */
+    return (debuginfo*)(infoptr + 2);
+}
+
+/* Multiple names may share the same filename,
+   so it is referenced as an offset instead of stored inline */
+struct name_info {
+  int32_t filename_offs;
+  char name[1];
+};
+
+/* Extract location information for the given frame descriptor */
+void caml_debuginfo_location(debuginfo dbg, /*out*/ struct caml_loc_info * li)
+{
+  uint32_t info1, info2;
+  struct name_info * name_info;
+
+  /* If no debugging information available, print nothing.
+     When everything is compiled with -g, this corresponds to
+     compiler-inserted re-raise operations. */
+  if (dbg == NULL) {
+    li->loc_valid = 0;
+    li->loc_is_raise = 1;
+    li->loc_is_inlined = 0;
+    return;
+  }
+  /* Recover debugging info */
+  info1 = ((uint32_t *)dbg)[0];
+  info2 = ((uint32_t *)dbg)[1];
+  name_info = (struct name_info*)((char *) dbg + (info1 & 0x3FFFFFC));
+  /* Format of the two info words:
+       llllllllllllllllllll aaaaaaaa bbbbbbbbbb ffffffffffffffffffffffff k n
+                         44       36         26                        2 1 0
+                       (32+12)    (32+4)
+     n ( 1 bit ): 0 if this is the final debuginfo
+                  1 if there's another following this one
+     k ( 1 bit ): 0 if it's a call
+                  1 if it's a raise
+     f (24 bits): offset (in 4-byte words) of file name relative to dbg
+     l (20 bits): line number
+     a ( 8 bits): beginning of character range
+     b (10 bits): end of character range */
+  li->loc_valid = 1;
+  li->loc_is_raise = (info1 & 2) == 2;
+  li->loc_is_inlined = caml_debuginfo_next(dbg) != NULL;
+  li->loc_defname = name_info->name;
+  li->loc_filename =
+    (char *)name_info + name_info->filename_offs;
+  li->loc_lnum = info2 >> 12;
+  li->loc_startchr = (info2 >> 4) & 0xFF;
+  li->loc_endchr = ((info2 & 0xF) << 6) | (info1 >> 26);
+}
+
+CAMLprim value caml_add_debug_info(backtrace_slot start, value size,
+                                   value events)
+{
+  return Val_unit;
+}
+
+CAMLprim value caml_remove_debug_info(backtrace_slot start)
+{
+  return Val_unit;
+}
+
+int caml_debug_info_available(void)
+{
+  return 1;
+}
diff --git a/runtime/bigarray.c b/runtime/bigarray.c
new file mode 100644
index 00000000..871b81ef
--- /dev/null
+++ b/runtime/bigarray.c
@@ -0,0 +1,1237 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Manuel Serrano and Xavier Leroy, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2000 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
+
+#include <stddef.h>
+#include <stdarg.h>
+#include <string.h>
+#include "caml/alloc.h"
+#include "caml/bigarray.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/intext.h"
+#include "caml/hash.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "caml/signals.h"
+
+#define int8 caml_ba_int8
+#define uint8 caml_ba_uint8
+#define int16 caml_ba_int16
+#define uint16 caml_ba_uint16
+
+/* Compute the number of elements of a big array */
+
+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];
+  return num_elts;
+}
+
+/* Size in bytes of a bigarray element, indexed by bigarray kind */
+
+CAMLexport int caml_ba_element_size[] =
+{ 4 /*FLOAT32*/, 8 /*FLOAT64*/,
+  1 /*SINT8*/, 1 /*UINT8*/,
+  2 /*SINT16*/, 2 /*UINT16*/,
+  4 /*INT32*/, 8 /*INT64*/,
+  sizeof(value) /*CAML_INT*/, sizeof(value) /*NATIVE_INT*/,
+  8 /*COMPLEX32*/, 16 /*COMPLEX64*/,
+  1 /*CHAR*/
+};
+
+/* Compute the number of bytes for the elements of a big array */
+
+CAMLexport uintnat caml_ba_byte_size(struct caml_ba_array * b)
+{
+  return caml_ba_num_elts(b)
+         * caml_ba_element_size[b->flags & CAML_BA_KIND_MASK];
+}
+
+/* Operation table for bigarrays */
+
+CAMLexport struct custom_operations caml_ba_ops = {
+  "_bigarr02",
+  caml_ba_finalize,
+  caml_ba_compare,
+  caml_ba_hash,
+  caml_ba_serialize,
+  caml_ba_deserialize,
+  custom_compare_ext_default,
+  custom_fixed_length_default
+};
+
+/* Allocation of a big array */
+
+/* [caml_ba_alloc] will allocate a new bigarray object in the heap.
+   If [data] is NULL, the memory for the contents is also allocated
+   (with [malloc]) by [caml_ba_alloc].
+   [data] cannot point into the OCaml heap.
+   [dim] may point into an object in the OCaml heap.
+*/
+CAMLexport value
+caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim)
+{
+  uintnat num_elts, asize, size;
+  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((flags & CAML_BA_KIND_MASK) <= CAML_BA_CHAR);
+  for (i = 0; i < num_dims; i++) dimcopy[i] = dim[i];
+  size = 0;
+  if (data == NULL) {
+    num_elts = 1;
+    for (i = 0; i < num_dims; i++) {
+      if (caml_umul_overflow(num_elts, dimcopy[i], &num_elts))
+        caml_raise_out_of_memory();
+    }
+    if (caml_umul_overflow(num_elts,
+                           caml_ba_element_size[flags & CAML_BA_KIND_MASK],
+                           &size))
+      caml_raise_out_of_memory();
+    data = malloc(size);
+    if (data == NULL && size != 0) caml_raise_out_of_memory();
+    flags |= CAML_BA_MANAGED;
+  }
+  asize = SIZEOF_BA_ARRAY + num_dims * sizeof(intnat);
+  res = caml_alloc_custom_mem(&caml_ba_ops, asize, size);
+  b = Caml_ba_array_val(res);
+  b->data = data;
+  b->num_dims = num_dims;
+  b->flags = flags;
+  b->proxy = NULL;
+  for (i = 0; i < num_dims; i++) b->dim[i] = dimcopy[i];
+  return res;
+}
+
+/* Same as caml_ba_alloc, but dimensions are passed as a list of
+   arguments */
+
+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);
+  va_end(ap);
+  res = caml_ba_alloc(flags, num_dims, data, dim);
+  return res;
+}
+
+/* Finalization of a big array */
+
+CAMLexport void caml_ba_finalize(value v)
+{
+  struct caml_ba_array * b = Caml_ba_array_val(v);
+
+  switch (b->flags & CAML_BA_MANAGED_MASK) {
+  case CAML_BA_EXTERNAL:
+    break;
+  case CAML_BA_MANAGED:
+    if (b->proxy == NULL) {
+      free(b->data);
+    } else {
+      if (-- b->proxy->refcount == 0) {
+        free(b->proxy->data);
+        free(b->proxy);
+      }
+    }
+    break;
+  case CAML_BA_MAPPED_FILE:
+    /* Bigarrays for mapped files use a different finalization method */
+    /* fallthrough */
+  default:
+    CAMLassert(0);
+  }
+}
+
+/* Comparison of two big arrays */
+
+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;
+  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);
+  flags2 = b2->flags & (CAML_BA_KIND_MASK | CAML_BA_LAYOUT_MASK);
+  if (flags1 != flags2) return flags2 - flags1;
+  /* 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++) {
+    intnat d1 = b1->dim[i];
+    intnat d2 = b2->dim[i];
+    if (d1 != d2) return d1 < d2 ? -1 : 1;
+  }
+  /* Same dimensions: compare contents lexicographically */
+  num_elts = caml_ba_num_elts(b1);
+
+#define DO_INTEGER_COMPARISON(type) \
+  { type * p1 = b1->data; type * p2 = b2->data; \
+    for (n = 0; n < num_elts; n++) { \
+      type e1 = *p1++; type e2 = *p2++; \
+      if (e1 < e2) return -1; \
+      if (e1 > e2) return 1; \
+    } \
+    return 0; \
+  }
+#define DO_FLOAT_COMPARISON(type) \
+  { type * p1 = b1->data; type * p2 = b2->data; \
+    for (n = 0; n < num_elts; n++) { \
+      type e1 = *p1++; type e2 = *p2++; \
+      if (e1 < e2) return -1; \
+      if (e1 > e2) return 1; \
+      if (e1 != e2) { \
+        Caml_state->compare_unordered = 1; \
+        if (e1 == e1) return 1; \
+        if (e2 == e2) return -1; \
+      } \
+    } \
+    return 0; \
+  }
+
+  switch (b1->flags & CAML_BA_KIND_MASK) {
+  case CAML_BA_COMPLEX32:
+    num_elts *= 2; /*fallthrough*/
+  case CAML_BA_FLOAT32:
+    DO_FLOAT_COMPARISON(float);
+  case CAML_BA_COMPLEX64:
+    num_elts *= 2; /*fallthrough*/
+  case CAML_BA_FLOAT64:
+    DO_FLOAT_COMPARISON(double);
+  case CAML_BA_CHAR:
+    DO_INTEGER_COMPARISON(caml_ba_uint8);
+  case CAML_BA_SINT8:
+    DO_INTEGER_COMPARISON(caml_ba_int8);
+  case CAML_BA_UINT8:
+    DO_INTEGER_COMPARISON(caml_ba_uint8);
+  case CAML_BA_SINT16:
+    DO_INTEGER_COMPARISON(caml_ba_int16);
+  case CAML_BA_UINT16:
+    DO_INTEGER_COMPARISON(caml_ba_uint16);
+  case CAML_BA_INT32:
+    DO_INTEGER_COMPARISON(int32_t);
+  case CAML_BA_INT64:
+    DO_INTEGER_COMPARISON(int64_t);
+  case CAML_BA_CAML_INT:
+  case CAML_BA_NATIVE_INT:
+    DO_INTEGER_COMPARISON(intnat);
+  default:
+    CAMLassert(0);
+    return 0;                   /* should not happen */
+  }
+#undef DO_INTEGER_COMPARISON
+#undef DO_FLOAT_COMPARISON
+}
+
+/* Hashing of a bigarray */
+
+CAMLexport intnat caml_ba_hash(value v)
+{
+  struct caml_ba_array * b = Caml_ba_array_val(v);
+  intnat num_elts, n;
+  uint32_t h, w;
+  int i;
+
+  num_elts = 1;
+  for (i = 0; i < b->num_dims; i++) num_elts = num_elts * b->dim[i];
+  h = 0;
+
+  switch (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) {
+      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 1: w |= p[0];
+            h = caml_hash_mix_uint32(h, w);
+    }
+    break;
+  }
+  case CAML_BA_SINT16:
+  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) {
+      w = p[0] | (p[1] << 16);
+      h = caml_hash_mix_uint32(h, w);
+    }
+    if ((num_elts & 1) != 0)
+      h = caml_hash_mix_uint32(h, p[0]);
+    break;
+  }
+  case CAML_BA_INT32:
+  {
+    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);
+    break;
+  }
+  case CAML_BA_CAML_INT:
+  case CAML_BA_NATIVE_INT:
+  {
+    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);
+    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);
+    break;
+  }
+  case CAML_BA_COMPLEX32:
+    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);
+    break;
+  }
+  case CAML_BA_COMPLEX64:
+    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);
+    break;
+  }
+  }
+  return h;
+}
+
+static void caml_ba_serialize_longarray(void * data,
+                                        intnat num_elts,
+                                        intnat min_val, intnat max_val)
+{
+#ifdef ARCH_SIXTYFOUR
+  int overflow_32 = 0;
+  intnat * p, n;
+  for (n = 0, p = data; n < num_elts; n++, p++) {
+    if (*p < min_val || *p > max_val) { overflow_32 = 1; break; }
+  }
+  if (overflow_32) {
+    caml_serialize_int_1(1);
+    caml_serialize_block_8(data, num_elts);
+  } else {
+    caml_serialize_int_1(0);
+    for (n = 0, p = data; n < num_elts; n++, p++)
+      caml_serialize_int_4((int32_t) *p);
+  }
+#else
+  caml_serialize_int_1(0);
+  caml_serialize_block_4(data, num_elts);
+#endif
+}
+
+CAMLexport void caml_ba_serialize(value v,
+                              uintnat * wsize_32,
+                              uintnat * wsize_64)
+{
+  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++) {
+    intnat len = b->dim[i];
+    if (len < 0xffff) {
+      caml_serialize_int_2(len);
+    } else {
+      caml_serialize_int_2(0xffff);
+      caml_serialize_int_8(len);
+    }
+  }
+  /* Compute total number of elements */
+  num_elts = 1;
+  for (i = 0; i < b->num_dims; i++) num_elts = num_elts * b->dim[i];
+  /* Serialize elements */
+  switch (b->flags & CAML_BA_KIND_MASK) {
+  case CAML_BA_CHAR:
+  case CAML_BA_SINT8:
+  case CAML_BA_UINT8:
+    caml_serialize_block_1(b->data, num_elts); break;
+  case CAML_BA_SINT16:
+  case CAML_BA_UINT16:
+    caml_serialize_block_2(b->data, num_elts); break;
+  case CAML_BA_FLOAT32:
+  case CAML_BA_INT32:
+    caml_serialize_block_4(b->data, num_elts); break;
+  case CAML_BA_COMPLEX32:
+    caml_serialize_block_4(b->data, num_elts * 2); break;
+  case CAML_BA_FLOAT64:
+  case CAML_BA_INT64:
+    caml_serialize_block_8(b->data, num_elts); break;
+  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);
+    break;
+  case CAML_BA_NATIVE_INT:
+    caml_ba_serialize_longarray(b->data, num_elts, -0x80000000, 0x7FFFFFFF);
+    break;
+  }
+  /* Compute required size in OCaml heap.  Assumes struct caml_ba_array
+     is exactly 4 + num_dims words */
+  CAMLassert(SIZEOF_BA_ARRAY == 4 * sizeof(value));
+  *wsize_32 = (4 + b->num_dims) * 4;
+  *wsize_64 = (4 + b->num_dims) * 8;
+}
+
+static void caml_ba_deserialize_longarray(void * dest, intnat num_elts)
+{
+  int sixty = caml_deserialize_uint_1();
+#ifdef ARCH_SIXTYFOUR
+  if (sixty) {
+    caml_deserialize_block_8(dest, num_elts);
+  } else {
+    intnat * p, n;
+    for (n = 0, p = dest; n < num_elts; n++, p++)
+      *p = caml_deserialize_sint_4();
+  }
+#else
+  if (sixty)
+    caml_deserialize_error("input_value: cannot read bigarray "
+                      "with 64-bit OCaml ints");
+  caml_deserialize_block_4(dest, num_elts);
+#endif
+}
+
+CAMLexport uintnat caml_ba_deserialize(void * dst)
+{
+  struct caml_ba_array * b = dst;
+  int i;
+  uintnat num_elts, size;
+
+  /* Read back header information */
+  b->num_dims = caml_deserialize_uint_4();
+  if (b->num_dims < 0 || b->num_dims > CAML_BA_MAX_NUM_DIMS)
+    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++) {
+    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++) {
+    if (caml_umul_overflow(num_elts, b->dim[i], &num_elts))
+      caml_deserialize_error("input_value: size overflow for bigarray");
+  }
+  /* Determine array size in bytes.  Watch out for overflows (MPR#7765). */
+  if ((b->flags & CAML_BA_KIND_MASK) > CAML_BA_CHAR)
+    caml_deserialize_error("input_value: bad bigarray kind");
+  if (caml_umul_overflow(num_elts,
+                         caml_ba_element_size[b->flags & CAML_BA_KIND_MASK],
+                         &size))
+    caml_deserialize_error("input_value: size overflow for bigarray");
+  /* Allocate room for data */
+  b->data = malloc(size);
+  if (b->data == NULL)
+    caml_deserialize_error("input_value: out of memory for bigarray");
+  /* Read data */
+  switch (b->flags & CAML_BA_KIND_MASK) {
+  case CAML_BA_CHAR:
+  case CAML_BA_SINT8:
+  case CAML_BA_UINT8:
+    caml_deserialize_block_1(b->data, num_elts); break;
+  case CAML_BA_SINT16:
+  case CAML_BA_UINT16:
+    caml_deserialize_block_2(b->data, num_elts); break;
+  case CAML_BA_FLOAT32:
+  case CAML_BA_INT32:
+    caml_deserialize_block_4(b->data, num_elts); break;
+  case CAML_BA_COMPLEX32:
+    caml_deserialize_block_4(b->data, num_elts * 2); break;
+  case CAML_BA_FLOAT64:
+  case CAML_BA_INT64:
+    caml_deserialize_block_8(b->data, num_elts); break;
+  case CAML_BA_COMPLEX64:
+    caml_deserialize_block_8(b->data, num_elts * 2); break;
+  case CAML_BA_CAML_INT:
+  case CAML_BA_NATIVE_INT:
+    caml_ba_deserialize_longarray(b->data, num_elts); break;
+  }
+  /* PR#5516: use C99's flexible array types if possible */
+  return SIZEOF_BA_ARRAY + b->num_dims * sizeof(intnat);
+}
+
+/* Allocate a bigarray from OCaml */
+
+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;
+
+  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++) {
+    dim[i] = Long_val(Field(vdim, i));
+    if (dim[i] < 0)
+      caml_invalid_argument("Bigarray.create: negative dimension");
+  }
+  flags = Caml_ba_kind_val(vkind) | Caml_ba_layout_val(vlayout);
+  return caml_ba_alloc(flags, num_dims, NULL, dim);
+}
+
+/* Given a big array and a vector of indices, check that the indices
+   are within the bounds and return the offset of the corresponding
+   array element in the data part of the array. */
+
+static long 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) {
+    /* C-style layout: row major, indices start at 0 */
+    for (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 {
+    /* Fortran-style layout: column major, indices start at 1 */
+    for (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);
+    }
+  }
+  return offset;
+}
+
+/* Helper function to allocate a record of two double floats */
+
+static value copy_two_doubles(double d0, double d1)
+{
+  value res = caml_alloc_small(2 * Double_wosize, Double_array_tag);
+  Store_double_field(res, 0, d0);
+  Store_double_field(res, 1, d1);
+  return res;
+}
+
+/* Generic code to read from a big array */
+
+value caml_ba_get_N(value vb, 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
+     (maybe not necessary if ML typing guarantees this) */
+  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]);
+  offset = caml_ba_offset(b, index);
+  /* Perform read */
+  switch ((b->flags) & CAML_BA_KIND_MASK) {
+  default:
+    CAMLassert(0);
+  case CAML_BA_FLOAT32:
+    return caml_copy_double((double) ((float *) b->data)[offset]);
+  case CAML_BA_FLOAT64:
+    return caml_copy_double(((double *) b->data)[offset]);
+  case CAML_BA_SINT8:
+    return Val_int(((int8 *) b->data)[offset]);
+  case CAML_BA_UINT8:
+    return Val_int(((uint8 *) b->data)[offset]);
+  case CAML_BA_SINT16:
+    return Val_int(((int16 *) b->data)[offset]);
+  case CAML_BA_UINT16:
+    return Val_int(((uint16 *) b->data)[offset]);
+  case CAML_BA_INT32:
+    return caml_copy_int32(((int32_t *) b->data)[offset]);
+  case CAML_BA_INT64:
+    return caml_copy_int64(((int64_t *) b->data)[offset]);
+  case CAML_BA_NATIVE_INT:
+    return caml_copy_nativeint(((intnat *) b->data)[offset]);
+  case CAML_BA_CAML_INT:
+    return Val_long(((intnat *) b->data)[offset]);
+  case CAML_BA_COMPLEX32:
+    { float * p = ((float *) b->data) + offset * 2;
+      return copy_two_doubles((double) p[0], (double) p[1]); }
+  case CAML_BA_COMPLEX64:
+    { double * p = ((double *) b->data) + offset * 2;
+      return copy_two_doubles(p[0], p[1]); }
+  case CAML_BA_CHAR:
+    return Val_int(((unsigned char *) b->data)[offset]);
+  }
+}
+
+CAMLprim value caml_ba_get_1(value vb, value vind1)
+{
+  return caml_ba_get_N(vb, &vind1, 1);
+}
+
+CAMLprim value caml_ba_get_2(value vb, value vind1, value vind2)
+{
+  value vind[2];
+  vind[0] = vind1; vind[1] = vind2;
+  return caml_ba_get_N(vb, vind, 2);
+}
+
+CAMLprim value caml_ba_get_3(value vb, value vind1, value vind2, value vind3)
+{
+  value vind[3];
+  vind[0] = vind1; vind[1] = vind2; vind[2] = vind3;
+  return caml_ba_get_N(vb, vind, 3);
+}
+
+CAMLprim value caml_ba_get_generic(value vb, value vind)
+{
+  return caml_ba_get_N(vb, &Field(vind, 0), Wosize_val(vind));
+}
+
+
+CAMLprim value caml_ba_uint8_get16(value vb, value vind)
+{
+  intnat res;
+  unsigned char b1, b2;
+  intnat idx = Long_val(vind);
+  struct caml_ba_array * b = Caml_ba_array_val(vb);
+  if (idx < 0 || idx >= b->dim[0] - 1) caml_array_bound_error();
+  b1 = ((unsigned char*) b->data)[idx];
+  b2 = ((unsigned char*) b->data)[idx+1];
+#ifdef ARCH_BIG_ENDIAN
+  res = b1 << 8 | b2;
+#else
+  res = b2 << 8 | b1;
+#endif
+  return Val_int(res);
+}
+
+CAMLprim value caml_ba_uint8_get32(value vb, value vind)
+{
+  uint32_t res;
+  unsigned char b1, b2, b3, b4;
+  intnat idx = Long_val(vind);
+  struct caml_ba_array * b = Caml_ba_array_val(vb);
+  if (idx < 0 || idx >= b->dim[0] - 3) caml_array_bound_error();
+  b1 = ((unsigned char*) b->data)[idx];
+  b2 = ((unsigned char*) b->data)[idx+1];
+  b3 = ((unsigned char*) b->data)[idx+2];
+  b4 = ((unsigned char*) b->data)[idx+3];
+#ifdef ARCH_BIG_ENDIAN
+  res = b1 << 24 | b2 << 16 | b3 << 8 | b4;
+#else
+  res = b4 << 24 | b3 << 16 | b2 << 8 | b1;
+#endif
+  return caml_copy_int32(res);
+}
+
+CAMLprim value caml_ba_uint8_get64(value vb, value vind)
+{
+  uint64_t res;
+  unsigned char b1, b2, b3, b4, b5, b6, b7, b8;
+  intnat idx = Long_val(vind);
+  struct caml_ba_array * b = Caml_ba_array_val(vb);
+  if (idx < 0 || idx >= b->dim[0] - 7) caml_array_bound_error();
+  b1 = ((unsigned char*) b->data)[idx];
+  b2 = ((unsigned char*) b->data)[idx+1];
+  b3 = ((unsigned char*) b->data)[idx+2];
+  b4 = ((unsigned char*) b->data)[idx+3];
+  b5 = ((unsigned char*) b->data)[idx+4];
+  b6 = ((unsigned char*) b->data)[idx+5];
+  b7 = ((unsigned char*) b->data)[idx+6];
+  b8 = ((unsigned char*) b->data)[idx+7];
+#ifdef ARCH_BIG_ENDIAN
+  res = (uint64_t) b1 << 56 | (uint64_t) b2 << 48
+        | (uint64_t) b3 << 40 | (uint64_t) b4 << 32
+        | (uint64_t) b5 << 24 | (uint64_t) b6 << 16
+        | (uint64_t) b7 << 8 | (uint64_t) b8;
+#else
+  res = (uint64_t) b8 << 56 | (uint64_t) b7 << 48
+        | (uint64_t) b6 << 40 | (uint64_t) b5 << 32
+        | (uint64_t) b4 << 24 | (uint64_t) b3 << 16
+        | (uint64_t) b2 << 8 | (uint64_t) b1;
+#endif
+  return caml_copy_int64(res);
+}
+
+/* Generic write to a big array */
+
+static value caml_ba_set_aux(value vb, value * vind, intnat nind, value newval)
+{
+  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
+     (maybe not necessary if ML typing guarantees this) */
+  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]);
+  offset = caml_ba_offset(b, index);
+  /* Perform write */
+  switch (b->flags & CAML_BA_KIND_MASK) {
+  default:
+    CAMLassert(0);
+  case CAML_BA_FLOAT32:
+    ((float *) b->data)[offset] = Double_val(newval); break;
+  case CAML_BA_FLOAT64:
+    ((double *) b->data)[offset] = Double_val(newval); break;
+  case CAML_BA_CHAR:
+  case CAML_BA_SINT8:
+  case CAML_BA_UINT8:
+    ((int8 *) b->data)[offset] = Int_val(newval); break;
+  case CAML_BA_SINT16:
+  case CAML_BA_UINT16:
+    ((int16 *) b->data)[offset] = Int_val(newval); break;
+  case CAML_BA_INT32:
+    ((int32_t *) b->data)[offset] = Int32_val(newval); break;
+  case CAML_BA_INT64:
+    ((int64_t *) b->data)[offset] = Int64_val(newval); break;
+  case CAML_BA_NATIVE_INT:
+    ((intnat *) b->data)[offset] = Nativeint_val(newval); break;
+  case CAML_BA_CAML_INT:
+    ((intnat *) b->data)[offset] = Long_val(newval); break;
+  case CAML_BA_COMPLEX32:
+    { float * p = ((float *) b->data) + offset * 2;
+      p[0] = Double_field(newval, 0);
+      p[1] = Double_field(newval, 1);
+      break; }
+  case CAML_BA_COMPLEX64:
+    { double * p = ((double *) b->data) + offset * 2;
+      p[0] = Double_field(newval, 0);
+      p[1] = Double_field(newval, 1);
+      break; }
+  }
+  return Val_unit;
+}
+
+CAMLprim value caml_ba_set_1(value vb, value vind1, value newval)
+{
+  return caml_ba_set_aux(vb, &vind1, 1, newval);
+}
+
+CAMLprim value caml_ba_set_2(value vb, value vind1, value vind2, value newval)
+{
+  value vind[2];
+  vind[0] = vind1; vind[1] = vind2;
+  return caml_ba_set_aux(vb, vind, 2, newval);
+}
+
+CAMLprim value caml_ba_set_3(value vb, value vind1, value vind2, value vind3,
+                     value newval)
+{
+  value vind[3];
+  vind[0] = vind1; vind[1] = vind2; vind[2] = vind3;
+  return caml_ba_set_aux(vb, vind, 3, newval);
+}
+
+value caml_ba_set_N(value vb, value * vind, int nargs)
+{
+  return caml_ba_set_aux(vb, vind, nargs - 1, vind[nargs - 1]);
+}
+
+CAMLprim value caml_ba_set_generic(value vb, value vind, value newval)
+{
+  return caml_ba_set_aux(vb, &Field(vind, 0), Wosize_val(vind), newval);
+}
+
+CAMLprim value caml_ba_uint8_set16(value vb, value vind, value newval)
+{
+  unsigned char b1, b2;
+  intnat val;
+  intnat idx = Long_val(vind);
+  struct caml_ba_array * b = Caml_ba_array_val(vb);
+  if (idx < 0 || idx >= b->dim[0] - 1) caml_array_bound_error();
+  val = Long_val(newval);
+#ifdef ARCH_BIG_ENDIAN
+  b1 = 0xFF & val >> 8;
+  b2 = 0xFF & val;
+#else
+  b2 = 0xFF & val >> 8;
+  b1 = 0xFF & val;
+#endif
+  ((unsigned char*) b->data)[idx] = b1;
+  ((unsigned char*) b->data)[idx+1] = b2;
+  return Val_unit;
+}
+
+CAMLprim value caml_ba_uint8_set32(value vb, value vind, value newval)
+{
+  unsigned char b1, b2, b3, b4;
+  intnat idx = Long_val(vind);
+  intnat val;
+  struct caml_ba_array * b = Caml_ba_array_val(vb);
+  if (idx < 0 || idx >= b->dim[0] - 3) caml_array_bound_error();
+  val = Int32_val(newval);
+#ifdef ARCH_BIG_ENDIAN
+  b1 = 0xFF & val >> 24;
+  b2 = 0xFF & val >> 16;
+  b3 = 0xFF & val >> 8;
+  b4 = 0xFF & val;
+#else
+  b4 = 0xFF & val >> 24;
+  b3 = 0xFF & val >> 16;
+  b2 = 0xFF & val >> 8;
+  b1 = 0xFF & val;
+#endif
+  ((unsigned char*) b->data)[idx] = b1;
+  ((unsigned char*) b->data)[idx+1] = b2;
+  ((unsigned char*) b->data)[idx+2] = b3;
+  ((unsigned char*) b->data)[idx+3] = b4;
+  return Val_unit;
+}
+
+CAMLprim value caml_ba_uint8_set64(value vb, value vind, value newval)
+{
+  unsigned char b1, b2, b3, b4, b5, b6, b7, b8;
+  intnat idx = Long_val(vind);
+  int64_t val;
+  struct caml_ba_array * b = Caml_ba_array_val(vb);
+  if (idx < 0 || idx >= b->dim[0] - 7) caml_array_bound_error();
+  val = Int64_val(newval);
+#ifdef ARCH_BIG_ENDIAN
+  b1 = 0xFF & val >> 56;
+  b2 = 0xFF & val >> 48;
+  b3 = 0xFF & val >> 40;
+  b4 = 0xFF & val >> 32;
+  b5 = 0xFF & val >> 24;
+  b6 = 0xFF & val >> 16;
+  b7 = 0xFF & val >> 8;
+  b8 = 0xFF & val;
+#else
+  b8 = 0xFF & val >> 56;
+  b7 = 0xFF & val >> 48;
+  b6 = 0xFF & val >> 40;
+  b5 = 0xFF & val >> 32;
+  b4 = 0xFF & val >> 24;
+  b3 = 0xFF & val >> 16;
+  b2 = 0xFF & val >> 8;
+  b1 = 0xFF & val;
+#endif
+  ((unsigned char*) b->data)[idx] = b1;
+  ((unsigned char*) b->data)[idx+1] = b2;
+  ((unsigned char*) b->data)[idx+2] = b3;
+  ((unsigned char*) b->data)[idx+3] = b4;
+  ((unsigned char*) b->data)[idx+4] = b5;
+  ((unsigned char*) b->data)[idx+5] = b6;
+  ((unsigned char*) b->data)[idx+6] = b7;
+  ((unsigned char*) b->data)[idx+7] = b8;
+  return Val_unit;
+}
+
+/* Return the number of dimensions of a big array */
+
+CAMLprim value caml_ba_num_dims(value vb)
+{
+  struct caml_ba_array * b = Caml_ba_array_val(vb);
+  return Val_long(b->num_dims);
+}
+
+/* Return the n-th dimension of a big array */
+
+CAMLprim value caml_ba_dim(value vb, value vn)
+{
+  struct caml_ba_array * b = Caml_ba_array_val(vb);
+  intnat n = Long_val(vn);
+  if (n < 0 || n >= b->num_dims) caml_invalid_argument("Bigarray.dim");
+  return Val_long(b->dim[n]);
+}
+
+CAMLprim value caml_ba_dim_1(value vb)
+{
+  return caml_ba_dim(vb, Val_int(0));
+}
+
+CAMLprim value caml_ba_dim_2(value vb)
+{
+  return caml_ba_dim(vb, Val_int(1));
+}
+
+CAMLprim value caml_ba_dim_3(value vb)
+{
+  return caml_ba_dim(vb, Val_int(2));
+}
+
+/* Return the kind of a big array */
+
+CAMLprim value caml_ba_kind(value vb)
+{
+  return Val_caml_ba_kind(Caml_ba_array_val(vb)->flags & CAML_BA_KIND_MASK);
+}
+
+/* Return the layout of a big array */
+
+CAMLprim value caml_ba_layout(value vb)
+{
+  int layout = Caml_ba_array_val(vb)->flags & CAML_BA_LAYOUT_MASK;
+  return Val_caml_ba_layout(layout);
+}
+
+/* Create / update proxy to indicate that b2 is a sub-array of b1 */
+
+static void caml_ba_update_proxy(struct caml_ba_array * b1,
+                                 struct caml_ba_array * b2)
+{
+  struct caml_ba_proxy * proxy;
+  /* Nothing to do for un-managed arrays */
+  if ((b1->flags & CAML_BA_MANAGED_MASK) == CAML_BA_EXTERNAL) return;
+  if (b1->proxy != NULL) {
+    /* If b1 is already a proxy for a larger array, increment refcount of
+       proxy */
+    b2->proxy = b1->proxy;
+    ++ b1->proxy->refcount;
+  } else {
+    /* Otherwise, create proxy and attach it to both b1 and b2 */
+    proxy = malloc(sizeof(struct caml_ba_proxy));
+    if (proxy == NULL) caml_raise_out_of_memory();
+    proxy->refcount = 2;      /* original array + sub array */
+    proxy->data = b1->data;
+    proxy->size =
+      b1->flags & CAML_BA_MAPPED_FILE ? caml_ba_byte_size(b1) : 0;
+    b1->proxy = proxy;
+    b2->proxy = proxy;
+  }
+}
+
+/* Slicing */
+
+CAMLprim value caml_ba_slice(value vb, value vind)
+{
+  CAMLparam2 (vb, vind);
+  #define b (Caml_ba_array_val(vb))
+  CAMLlocal1 (res);
+  intnat index[CAML_BA_MAX_NUM_DIMS];
+  int num_inds, i;
+  intnat offset;
+  intnat * sub_dims;
+  char * sub_data;
+
+  /* Check number of indices <= number of dimensions of array */
+  num_inds = Wosize_val(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) {
+    /* 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 {
+    /* We slice from the right */
+    for (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;
+    offset = caml_ba_offset(b, index);
+    sub_dims = b->dim;
+  }
+  sub_data =
+    (char *) b->data +
+    offset * caml_ba_element_size[b->flags & CAML_BA_KIND_MASK];
+  /* Allocate an OCaml bigarray to hold the result */
+  res = caml_ba_alloc(b->flags, b->num_dims - num_inds, sub_data, sub_dims);
+  /* Copy the finalization function from the original array (PR#8568) */
+  Custom_ops_val(res) = Custom_ops_val(vb);
+  /* Create or update proxy in case of managed bigarray */
+  caml_ba_update_proxy(b, Caml_ba_array_val(res));
+  /* Return result */
+  CAMLreturn (res);
+
+  #undef b
+}
+
+/* Changing the layout of an array (memory is shared) */
+
+CAMLprim value caml_ba_change_layout(value vb, value vlayout)
+{
+  CAMLparam2 (vb, vlayout);
+  CAMLlocal1 (res);
+  #define b (Caml_ba_array_val(vb))
+  /* if the layout is different, change the flags and reverse the dimensions */
+  if (Caml_ba_layout_val(vlayout) != (b->flags & CAML_BA_LAYOUT_MASK)) {
+    /* change the flags to reflect the new layout */
+    int flags = (b->flags & (CAML_BA_KIND_MASK | CAML_BA_MANAGED_MASK))
+                 | 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];
+    res = caml_ba_alloc(flags, b->num_dims, b->data, new_dim);
+    /* Copy the finalization function from the original array (PR#8568) */
+    Custom_ops_val(res) = Custom_ops_val(vb);
+    caml_ba_update_proxy(b, Caml_ba_array_val(res));
+    CAMLreturn(res);
+  } else {
+    /* otherwise, do nothing */
+    CAMLreturn(vb);
+  }
+  #undef b
+}
+
+
+/* Extracting a sub-array of same number of dimensions */
+
+CAMLprim value caml_ba_sub(value vb, value vofs, value vlen)
+{
+  CAMLparam3 (vb, vofs, vlen);
+  CAMLlocal1 (res);
+  #define b (Caml_ba_array_val(vb))
+  intnat ofs = Long_val(vofs);
+  intnat len = Long_val(vlen);
+  int i, changed_dim;
+  intnat mul;
+  char * sub_data;
+
+  /* Compute offset and check bounds */
+  if ((b->flags & CAML_BA_LAYOUT_MASK) == CAML_BA_C_LAYOUT) {
+    /* We reduce the first dimension */
+    mul = 1;
+    for (i = 1; i < b->num_dims; i++) mul *= b->dim[i];
+    changed_dim = 0;
+  } else {
+    /* We reduce the last dimension */
+    mul = 1;
+    for (i = 0; i < b->num_dims - 1; i++) mul *= b->dim[i];
+    changed_dim = b->num_dims - 1;
+    ofs--;                      /* Fortran arrays start at 1 */
+  }
+  if (ofs < 0 || len < 0 || ofs + len > b->dim[changed_dim])
+    caml_invalid_argument("Bigarray.sub: bad sub-array");
+  sub_data =
+    (char *) b->data +
+    ofs * mul * caml_ba_element_size[b->flags & CAML_BA_KIND_MASK];
+  /* Allocate an OCaml bigarray to hold the result */
+  res = caml_ba_alloc(b->flags, b->num_dims, sub_data, b->dim);
+  /* Copy the finalization function from the original array (PR#8568) */
+  Custom_ops_val(res) = Custom_ops_val(vb);
+  /* Doctor the changed dimension */
+  Caml_ba_array_val(res)->dim[changed_dim] = len;
+  /* Create or update proxy in case of managed bigarray */
+  caml_ba_update_proxy(b, Caml_ba_array_val(res));
+  /* Return result */
+  CAMLreturn (res);
+
+  #undef b
+}
+
+/* Copying a big array into another one */
+
+#define LEAVE_RUNTIME_OP_CUTOFF 4096
+#define is_mmapped(ba) ((ba)->flags & CAML_BA_MAPPED_FILE)
+
+CAMLprim value caml_ba_blit(value vsrc, value vdst)
+{
+  CAMLparam2(vsrc, vdst);
+  struct caml_ba_array * src = Caml_ba_array_val(vsrc);
+  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++)
+    if (src->dim[i] != dst->dim[i]) goto blit_error;
+  /* Compute number of bytes in array data */
+  num_bytes =
+    caml_ba_num_elts(src)
+    * caml_ba_element_size[src->flags & CAML_BA_KIND_MASK];
+  leave_runtime =
+    (
+      (num_bytes >= LEAVE_RUNTIME_OP_CUTOFF*sizeof(long))
+      || is_mmapped(src)
+      || is_mmapped(dst)
+    );
+  /* Do the copying */
+  if (leave_runtime) caml_enter_blocking_section();
+  memmove (dst_data, src_data, num_bytes);
+  if (leave_runtime) caml_leave_blocking_section();
+  CAMLreturn (Val_unit);
+ blit_error:
+  caml_invalid_argument("Bigarray.blit: dimension mismatch");
+  CAMLreturn (Val_unit);              /* not reached */
+}
+
+/* Filling a big array with a given value */
+
+#define FILL_GEN_LOOP(n_ops, loop) do{                                       \
+  int leave_runtime = ((n_ops >= LEAVE_RUNTIME_OP_CUTOFF) || is_mmapped(b)); \
+  if (leave_runtime) caml_enter_blocking_section();                          \
+  loop;                                                                      \
+  if (leave_runtime) caml_leave_blocking_section();                          \
+}while(0)
+
+#define FILL_SCALAR_LOOP                                        \
+  FILL_GEN_LOOP(num_elts,                                       \
+    for (p = data; num_elts > 0; p++, num_elts--) *p = init)
+
+#define FILL_COMPLEX_LOOP                                                    \
+  FILL_GEN_LOOP(num_elts + num_elts,                                         \
+    for (p = data; num_elts > 0; num_elts--) { *p++ = init0; *p++ = init1; })
+
+CAMLprim value caml_ba_fill(value vb, value vinit)
+{
+  CAMLparam1(vb);
+  struct caml_ba_array * b = Caml_ba_array_val(vb);
+  void *data = b->data;
+  intnat num_elts = caml_ba_num_elts(b);
+
+  switch (b->flags & CAML_BA_KIND_MASK) {
+  default:
+    CAMLassert(0);
+  case CAML_BA_FLOAT32: {
+    float init = Double_val(vinit);
+    float * p;
+    FILL_SCALAR_LOOP;
+    break;
+  }
+  case CAML_BA_FLOAT64: {
+    double init = Double_val(vinit);
+    double * p;
+    FILL_SCALAR_LOOP;
+    break;
+  }
+  case CAML_BA_CHAR:
+  case CAML_BA_SINT8:
+  case CAML_BA_UINT8: {
+    int init = Int_val(vinit);
+    unsigned char * p;
+    FILL_SCALAR_LOOP;
+    break;
+  }
+  case CAML_BA_SINT16:
+  case CAML_BA_UINT16: {
+    int init = Int_val(vinit);
+    int16 * p;
+    FILL_SCALAR_LOOP;
+    break;
+  }
+  case CAML_BA_INT32: {
+    int32_t init = Int32_val(vinit);
+    int32_t * p;
+    FILL_SCALAR_LOOP;
+    break;
+  }
+  case CAML_BA_INT64: {
+    int64_t init = Int64_val(vinit);
+    int64_t * p;
+    FILL_SCALAR_LOOP;
+    break;
+  }
+  case CAML_BA_NATIVE_INT: {
+    intnat init = Nativeint_val(vinit);
+    intnat * p;
+    FILL_SCALAR_LOOP;
+    break;
+  }
+  case CAML_BA_CAML_INT: {
+    intnat init = Long_val(vinit);
+    intnat * p;
+    FILL_SCALAR_LOOP;
+    break;
+  }
+  case CAML_BA_COMPLEX32: {
+    float init0 = Double_field(vinit, 0);
+    float init1 = Double_field(vinit, 1);
+    float * p;
+    FILL_COMPLEX_LOOP;
+    break;
+  }
+  case CAML_BA_COMPLEX64: {
+    double init0 = Double_field(vinit, 0);
+    double init1 = Double_field(vinit, 1);
+    double * p;
+    FILL_COMPLEX_LOOP;
+    break;
+  }
+  }
+  CAMLreturn (Val_unit);
+}
+
+/* Reshape an array: change dimensions and number of dimensions, preserving
+   array contents */
+
+CAMLprim value caml_ba_reshape(value vb, value vdim)
+{
+  CAMLparam2 (vb, vdim);
+  CAMLlocal1 (res);
+#define b (Caml_ba_array_val(vb))
+  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++) {
+    dim[i] = Long_val(Field(vdim, i));
+    if (dim[i] < 0)
+      caml_invalid_argument("Bigarray.reshape: negative dimension");
+    num_elts *= dim[i];
+  }
+  /* Check that sizes agree */
+  if (num_elts != caml_ba_num_elts(b))
+    caml_invalid_argument("Bigarray.reshape: size mismatch");
+  /* Create bigarray with same data and new dimensions */
+  res = caml_ba_alloc(b->flags, num_dims, b->data, dim);
+  /* Copy the finalization function from the original array (PR#8568) */
+  Custom_ops_val(res) = Custom_ops_val(vb);
+  /* Create or update proxy in case of managed bigarray */
+  caml_ba_update_proxy(b, Caml_ba_array_val(res));
+  /* Return result */
+  CAMLreturn (res);
+
+#undef b
+}
diff --git a/runtime/callback.c b/runtime/callback.c
new file mode 100644
index 00000000..71936374
--- /dev/null
+++ b/runtime/callback.c
@@ -0,0 +1,280 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* Callbacks from C to OCaml */
+
+#include <string.h>
+#include "caml/callback.h"
+#include "caml/domain.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+
+#ifndef NATIVE_CODE
+
+/* Bytecode callbacks */
+
+#include "caml/interp.h"
+#include "caml/instruct.h"
+#include "caml/fix_code.h"
+#include "caml/stacks.h"
+
+CAMLexport int caml_callback_depth = 0;
+
+#ifndef LOCAL_CALLBACK_BYTECODE
+static opcode_t callback_code[] = { ACC, 0, APPLY, 0, POP, 1, STOP };
+#endif
+
+
+#ifdef THREADED_CODE
+
+static int callback_code_threaded = 0;
+
+static void thread_callback(void)
+{
+  caml_thread_code(callback_code, sizeof(callback_code));
+  callback_code_threaded = 1;
+}
+
+#define Init_callback() if (!callback_code_threaded) thread_callback()
+
+#else
+
+#define Init_callback()
+
+#endif
+
+CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
+{
+  int i;
+  value res;
+
+  /* some alternate bytecode implementations (e.g. a JIT translator)
+     might require that the bytecode is kept in a local variable on
+     the C stack */
+#ifdef LOCAL_CALLBACK_BYTECODE
+  opcode_t local_callback_code[7];
+#endif
+
+  CAMLassert(narg + 4 <= 256);
+
+  Caml_state->extern_sp -= narg + 4;
+  for (i = 0; i < narg; i++) Caml_state->extern_sp[i] = args[i]; /* arguments */
+#ifndef LOCAL_CALLBACK_BYTECODE
+  Caml_state->extern_sp[narg] = (value)(callback_code + 4); /* return address */
+  Caml_state->extern_sp[narg + 1] = Val_unit;    /* environment */
+  Caml_state->extern_sp[narg + 2] = Val_long(0); /* extra args */
+  Caml_state->extern_sp[narg + 3] = closure;
+  Init_callback();
+  callback_code[1] = narg + 3;
+  callback_code[3] = narg;
+  res = caml_interprete(callback_code, sizeof(callback_code));
+#else /*have LOCAL_CALLBACK_BYTECODE*/
+  /* return address */
+  Caml_state->extern_sp[narg] = (value) (local_callback_code + 4);
+  Caml_state->extern_sp[narg + 1] = Val_unit;    /* environment */
+  Caml_state->extern_sp[narg + 2] = Val_long(0); /* extra args */
+  Caml_state->extern_sp[narg + 3] = closure;
+  local_callback_code[0] = ACC;
+  local_callback_code[1] = narg + 3;
+  local_callback_code[2] = APPLY;
+  local_callback_code[3] = narg;
+  local_callback_code[4] = POP;
+  local_callback_code[5] =  1;
+  local_callback_code[6] = STOP;
+#ifdef THREADED_CODE
+  caml_thread_code(local_callback_code, sizeof(local_callback_code));
+#endif /*THREADED_CODE*/
+  res = caml_interprete(local_callback_code, sizeof(local_callback_code));
+  caml_release_bytecode(local_callback_code, sizeof(local_callback_code));
+#endif /*LOCAL_CALLBACK_BYTECODE*/
+  if (Is_exception_result(res)) Caml_state->extern_sp += narg + 4; /* PR#3419 */
+  return res;
+}
+
+CAMLexport value caml_callback_exn(value closure, value arg1)
+{
+  value arg[1];
+  arg[0] = arg1;
+  return caml_callbackN_exn(closure, 1, arg);
+}
+
+CAMLexport value caml_callback2_exn(value closure, value arg1, value arg2)
+{
+  value arg[2];
+  arg[0] = arg1;
+  arg[1] = arg2;
+  return caml_callbackN_exn(closure, 2, arg);
+}
+
+CAMLexport value caml_callback3_exn(value closure,
+                               value arg1, value arg2, value arg3)
+{
+  value arg[3];
+  arg[0] = arg1;
+  arg[1] = arg2;
+  arg[2] = arg3;
+  return caml_callbackN_exn(closure, 3, arg);
+}
+
+#else
+
+/* Native-code callbacks. */
+
+typedef value (callback_stub)(caml_domain_state* state, value closure,
+                              value* args);
+
+callback_stub caml_callback_asm, caml_callback2_asm, caml_callback3_asm;
+
+CAMLexport value caml_callback_exn(value closure, value arg)
+{
+  return caml_callback_asm(Caml_state, closure, &arg);
+}
+
+CAMLexport value caml_callback2_exn(value closure, value arg1, value arg2)
+{
+  value args[] = {arg1, arg2};
+  return caml_callback2_asm(Caml_state, closure, args);
+}
+
+CAMLexport value caml_callback3_exn(value closure,
+                                    value arg1, value arg2, value arg3)
+{
+  value args[] = {arg1, arg2, arg3};
+  return caml_callback3_asm(Caml_state, closure, args);
+}
+
+
+CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
+{
+  CAMLparam1 (closure);
+  CAMLxparamN (args, narg);
+  CAMLlocal1 (res);
+  int i;
+
+  res = closure;
+  for (i = 0; i < narg; /*nothing*/) {
+    /* Pass as many arguments as possible */
+    switch (narg - i) {
+    case 1:
+      res = caml_callback_exn(res, args[i]);
+      if (Is_exception_result(res)) CAMLreturn (res);
+      i += 1;
+      break;
+    case 2:
+      res = caml_callback2_exn(res, args[i], args[i + 1]);
+      if (Is_exception_result(res)) CAMLreturn (res);
+      i += 2;
+      break;
+    default:
+      res = caml_callback3_exn(res, args[i], args[i + 1], args[i + 2]);
+      if (Is_exception_result(res)) CAMLreturn (res);
+      i += 3;
+      break;
+    }
+  }
+  CAMLreturn (res);
+}
+
+#endif
+
+/* Exception-propagating variants of the above */
+
+CAMLexport value caml_callback (value closure, value arg)
+{
+  return caml_raise_if_exception(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));
+}
+
+CAMLexport value caml_callback3 (value closure, value arg1, value arg2,
+                                 value arg3)
+{
+  return caml_raise_if_exception(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));
+}
+
+/* Naming of OCaml values */
+
+struct named_value {
+  value val;
+  struct named_value * next;
+  char name[1];
+};
+
+#define Named_value_size 13
+
+static struct named_value * named_value_table[Named_value_size] = { NULL, };
+
+static unsigned int hash_value_name(char const *name)
+{
+  unsigned int h;
+  for (h = 0; *name != 0; name++) h = h * 19 + *name;
+  return h % Named_value_size;
+}
+
+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);
+
+  for (nv = named_value_table[h]; nv != NULL; nv = nv->next) {
+    if (strcmp(name, nv->name) == 0) {
+      caml_modify_generational_global_root(&nv->val, val);
+      return Val_unit;
+    }
+  }
+  nv = (struct named_value *)
+          caml_stat_alloc(sizeof(struct named_value) + namelen);
+  memcpy(nv->name, name, namelen + 1);
+  nv->val = val;
+  nv->next = named_value_table[h];
+  named_value_table[h] = nv;
+  caml_register_generational_global_root(&nv->val);
+  return Val_unit;
+}
+
+CAMLexport const value * caml_named_value(char const *name)
+{
+  struct named_value * nv;
+  for (nv = named_value_table[hash_value_name(name)];
+       nv != NULL;
+       nv = nv->next) {
+    if (strcmp(name, nv->name) == 0) return &nv->val;
+  }
+  return NULL;
+}
+
+CAMLexport void caml_iterate_named_values(caml_named_action f)
+{
+  int i;
+  for(i = 0; i < Named_value_size; i++){
+    struct named_value * nv;
+    for (nv = named_value_table[i]; nv != NULL; nv = nv->next) {
+      f( &nv->val, nv->name );
+    }
+  }
+}
diff --git a/runtime/caml/address_class.h b/runtime/caml/address_class.h
new file mode 100644
index 00000000..45e5410e
--- /dev/null
+++ b/runtime/caml/address_class.h
@@ -0,0 +1,85 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*              Damien Doligez, projet Para, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Classification of addresses for GC and runtime purposes. */
+
+#ifndef CAML_ADDRESS_CLASS_H
+#define CAML_ADDRESS_CLASS_H
+
+#include "config.h"
+#include "misc.h"
+#include "mlvalues.h"
+
+/* Use the following macros to test an address for the different classes
+   it might belong to. */
+
+#define Is_young(val) \
+  (CAMLassert (Is_block (val)), \
+   (char *)(val) < (char *)Caml_state_field(young_end) && \
+   (char *)(val) > (char *)Caml_state_field(young_start))
+
+#define Is_in_heap(a) (Classify_addr(a) & In_heap)
+
+#define Is_in_heap_or_young(a) (Classify_addr(a) & (In_heap | In_young))
+
+#define Is_in_value_area(a)                                     \
+  (Classify_addr(a) & (In_heap | In_young | In_static_data))
+
+#define Is_in_code_area(pc) \
+ (    ((char *)(pc) >= caml_code_area_start && \
+       (char *)(pc) <= caml_code_area_end)     \
+   || (Classify_addr(pc) & In_code_area) )
+
+#define Is_in_static_data(a) (Classify_addr(a) & In_static_data)
+
+/***********************************************************************/
+/* The rest of this file is private and may change without notice. */
+
+extern char * caml_code_area_start, * caml_code_area_end;
+
+#define Not_in_heap 0
+#define In_heap 1
+#define In_young 2
+#define In_static_data 4
+#define In_code_area 8
+
+#ifdef ARCH_SIXTYFOUR
+
+/* 64 bits: Represent page table as a sparse hash table */
+int caml_page_table_lookup(void * addr);
+#define Classify_addr(a) (caml_page_table_lookup((void *)(a)))
+
+#else
+
+/* 32 bits: Represent page table as a 2-level array */
+#define Pagetable2_log 11
+#define Pagetable2_size (1 << Pagetable2_log)
+#define Pagetable1_log (Page_log + Pagetable2_log)
+#define Pagetable1_size (1 << (32 - Pagetable1_log))
+CAMLextern unsigned char * caml_page_table[Pagetable1_size];
+
+#define Pagetable_index1(a) (((uintnat)(a)) >> Pagetable1_log)
+#define Pagetable_index2(a) \
+  ((((uintnat)(a)) >> Page_log) & (Pagetable2_size - 1))
+#define Classify_addr(a) \
+  caml_page_table[Pagetable_index1(a)][Pagetable_index2(a)]
+
+#endif
+
+int caml_page_table_add(int kind, void * start, void * end);
+int caml_page_table_remove(int kind, void * start, void * end);
+int caml_page_table_initialize(mlsize_t bytesize);
+
+#endif /* CAML_ADDRESS_CLASS_H */
diff --git a/runtime/caml/alloc.h b/runtime/caml/alloc.h
new file mode 100644
index 00000000..7e2be4b0
--- /dev/null
+++ b/runtime/caml/alloc.h
@@ -0,0 +1,85 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_ALLOC_H
+#define CAML_ALLOC_H
+
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "misc.h"
+#include "mlvalues.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* It is guaranteed that these allocation functions will not trigger
+   any OCaml callback such as finalizers or signal handlers. */
+
+CAMLextern value caml_alloc (mlsize_t wosize, tag_t);
+CAMLextern value caml_alloc_small (mlsize_t wosize, tag_t);
+CAMLextern value caml_alloc_tuple (mlsize_t wosize);
+CAMLextern value caml_alloc_float_array (mlsize_t len);
+CAMLextern value caml_alloc_string (mlsize_t len);  /* len in bytes (chars) */
+CAMLextern value caml_alloc_initialized_string (mlsize_t len, const char *);
+CAMLextern value caml_copy_string (char const *);
+CAMLextern value caml_copy_string_array (char const **);
+CAMLextern value caml_copy_double (double);
+CAMLextern value caml_copy_int32 (int32_t);       /* defined in [ints.c] */
+CAMLextern value caml_copy_int64 (int64_t);       /* defined in [ints.c] */
+CAMLextern value caml_copy_nativeint (intnat);  /* defined in [ints.c] */
+CAMLextern value caml_alloc_array (value (*funct) (char const *),
+                                   char const ** array);
+CAMLextern value caml_alloc_sprintf(const char * format, ...)
+#ifdef __GNUC__
+  __attribute__ ((format (printf, 1, 2)))
+#endif
+;
+
+CAMLextern value caml_alloc_with_profinfo (mlsize_t, tag_t, intnat);
+CAMLextern value caml_alloc_small_with_my_or_given_profinfo (
+  mlsize_t, tag_t, uintnat);
+CAMLextern value caml_alloc_small_with_profinfo (mlsize_t, tag_t, intnat);
+
+typedef void (*final_fun)(value);
+CAMLextern value caml_alloc_final (mlsize_t wosize,
+                                   final_fun, /*finalization function*/
+                                   mlsize_t, /*resources consumed*/
+                                   mlsize_t  /*max resources*/);
+
+CAMLextern int caml_convert_flag_list (value, int *);
+
+/* Convenience functions to deal with unboxable types. */
+Caml_inline value caml_alloc_unboxed (value arg) { return arg; }
+Caml_inline value caml_alloc_boxed (value arg) {
+  value result = caml_alloc_small (1, 0);
+  Field (result, 0) = arg;
+  return result;
+}
+Caml_inline value caml_field_unboxed (value arg) { return arg; }
+Caml_inline value caml_field_boxed (value arg) { return Field (arg, 0); }
+
+/* Unannotated unboxable types are boxed by default. (may change in the
+   future) */
+#define caml_alloc_unboxable caml_alloc_boxed
+#define caml_field_unboxable caml_field_boxed
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_ALLOC_H */
diff --git a/runtime/caml/backtrace.h b/runtime/caml/backtrace.h
new file mode 100644
index 00000000..5cf24b85
--- /dev/null
+++ b/runtime/caml/backtrace.h
@@ -0,0 +1,129 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2001 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_BACKTRACE_H
+#define CAML_BACKTRACE_H
+
+#ifdef CAML_INTERNALS
+
+#include "mlvalues.h"
+#include "exec.h"
+
+/* Runtime support for backtrace generation.
+ *
+ * It has two kind of users:
+ * - high-level API to capture and decode backtraces;
+ * - low-level runtime routines, to introspect machine state and determine
+ *   whether a backtrace should be generated when using "raise".
+ *
+ * Backtrace generation is split in multiple steps.
+ * The lowest-level one, done by [backtrace_byt.c] and
+ * [backtrace_nat.c] just fills the [Caml_state->backtrace_buffer]
+ * variable each time a frame is unwinded.
+ * At that point, we don't know whether the backtrace will be useful or not so
+ * this code should be as fast as possible.
+ *
+ * If the backtrace happens to be useful, later passes will read
+ * [Caml_state->backtrace_buffer] and turn it into a [raw_backtrace] and then a
+ * [backtrace].
+ * This is done in [backtrace.c] and [stdlib/printexc.ml].
+ *
+ * Content of buffers
+ * ------------------
+ *
+ * [Caml_state->backtrace_buffer] (really cheap)
+ *   Backend and process image dependent, abstracted by C-type backtrace_slot.
+ * [raw_backtrace] (cheap)
+ *   OCaml values of abstract type [Printexc.raw_backtrace_slot],
+ *   still backend and process image dependent (unsafe to marshal).
+ * [backtrace] (more expensive)
+ *   OCaml values of algebraic data-type [Printexc.backtrace_slot]
+ */
+ /* [Caml_state->backtrace_active] is non zero iff backtraces are recorded.
+ * This variable must be changed with [caml_record_backtrace].
+ */
+#define caml_backtrace_active (Caml_state_field(backtrace_active))
+/* The [Caml_state->backtrace_buffer] and [Caml_state->backtrace_last_exn]
+ * variables are valid only if [Caml_state->backtrace_active != 0].
+ *
+ * They are part of the state specific to each thread, and threading libraries
+ * are responsible for copying them on context switch.
+ * See [otherlibs/systhreads/st_stubs.c].
+ *
+ *
+ * [Caml_state->backtrace_buffer] is filled by runtime when unwinding stack. It
+ * is an array ranging from [0] to [Caml_state->backtrace_pos - 1].
+ * [Caml_state->backtrace_pos] is always zero if
+ * [!Caml_state->backtrace_active].
+ *
+ * Its maximum size is determined by [BACKTRACE_BUFFER_SIZE] from
+ * [backtrace_prim.h], but this shouldn't affect users.
+ */
+#define caml_backtrace_buffer (Caml_state_field(backtrace_buffer))
+#define caml_backtrace_pos (Caml_state_field(backtrace_pos))
+
+/* [Caml_state->backtrace_last_exn] stores the last exception value that was
+ * raised, iff [Caml_state->backtrace_active != 0]. It is tested for equality
+ * to determine whether a raise is a re-raise of the same exception.
+ */
+#define caml_backtrace_last_exn (Caml_state_field(backtrace_last_exn))
+
+/* FIXME: this shouldn't matter anymore. Since OCaml 4.02, non-parameterized
+ * exceptions are constant, so physical equality is no longer appropriate.
+ * raise and re-raise are distinguished by:
+ * - passing reraise = 1 to [caml_stash_backtrace] (see below) in the bytecode
+ *   interpreter;
+ * - directly resetting [Caml_state->backtrace_pos] to 0 in native
+     runtimes for raise.
+ */
+
+/* [caml_record_backtrace] toggle backtrace recording on and off.
+ * This function can be called at runtime by user-code, or during
+ * initialization if backtraces were requested.
+ *
+ * It might be called before GC initialization, so it shouldn't do OCaml
+ * allocation.
+ */
+CAMLprim value caml_record_backtrace(value vflag);
+
+
+#ifndef NATIVE_CODE
+
+/* Path to the file containing debug information, if any, or NULL. */
+CAMLextern char_os * caml_cds_file;
+
+/* Primitive called _only_ by runtime to record unwinded frames to
+ * backtrace.  A similar primitive exists for native code, but with a
+ * different prototype. */
+extern void caml_stash_backtrace(value exn, value * sp, int reraise);
+
+#endif
+
+
+/* Default (C-level) printer for backtraces.  It is called if an
+ * exception causes a termination of the program or of a thread.
+ *
+ * [Printexc] provide a higher-level printer mimicking its output but making
+ * use of registered exception printers, and is used when possible in place of
+ * this function after [Printexc] initialization.
+ */
+CAMLextern void caml_print_exception_backtrace(void);
+
+void caml_init_backtrace(void);
+CAMLexport void caml_init_debug_info(void);
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_BACKTRACE_H */
diff --git a/runtime/caml/backtrace_prim.h b/runtime/caml/backtrace_prim.h
new file mode 100644
index 00000000..cf9596d3
--- /dev/null
+++ b/runtime/caml/backtrace_prim.h
@@ -0,0 +1,112 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2001 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_BACKTRACE_PRIM_H
+#define CAML_BACKTRACE_PRIM_H
+
+#ifdef CAML_INTERNALS
+
+#include "backtrace.h"
+
+/* Backtrace generation is split in [backtrace.c] and [backtrace_prim].
+ *
+ * [backtrace_prim] contains all backend-specific
+ * code, and has two different
+ * implementations in [runtime/backtrace_byt.c] and [runtime/backtrace_nat.c].
+ *
+ * [backtrace.c] has a unique implementation, and exposes a uniform
+ * higher level API above [backtrace_{byt,nat}.c].
+ */
+
+/* Extract location information for the given raw_backtrace_slot */
+
+struct caml_loc_info {
+  int loc_valid;
+  int loc_is_raise;
+  char * loc_filename;
+  char * loc_defname;
+  int loc_lnum;
+  int loc_startchr;
+  int loc_endchr;
+  int loc_is_inlined;
+};
+
+/* When compiling with -g, backtrace slots have debug info associated.
+ * When a call is inlined in native mode, debuginfos form a sequence.
+ */
+typedef void * debuginfo;
+
+/* Check availability of debug information before extracting a trace.
+ * Relevant for bytecode, always true for native code. */
+int caml_debug_info_available(void);
+
+/* Return debuginfo associated to a slot or NULL. */
+debuginfo caml_debuginfo_extract(backtrace_slot slot);
+
+/* In case of an inlined call return next debuginfo or NULL otherwise. */
+debuginfo caml_debuginfo_next(debuginfo dbg);
+
+/* Extract locations from backtrace_slot */
+void caml_debuginfo_location(debuginfo dbg, /*out*/ struct caml_loc_info * li);
+
+/* In order to prevent the GC from walking through the debug
+   information (which have no headers), we transform slots to 31/63 bits
+   ocaml integers by shifting them by 1 to the right. We do not lose
+   information as slots are aligned.
+
+   In particular, we do not need to use [caml_modify] when setting
+   an array element with such a value.
+ */
+#define Val_backtrace_slot(bslot) (Val_long(((uintnat)(bslot))>>1))
+#define Backtrace_slot_val(vslot) ((backtrace_slot)(Long_val(vslot) << 1))
+
+/* Allocate Caml_state->backtrace_buffer. Returns 0 on success, -1 otherwise */
+int caml_alloc_backtrace_buffer(void);
+
+#ifndef NATIVE_CODE
+/* These two functions are used by the bytecode runtime when loading
+   and unloading bytecode */
+value caml_add_debug_info(code_t code_start, value code_size,
+                                   value events_heap);
+value caml_remove_debug_info(code_t start);
+#endif
+
+#define BACKTRACE_BUFFER_SIZE 1024
+
+/* Besides decoding backtrace info, [backtrace_prim] has two other
+ * responsibilities:
+ *
+ * It defines the [caml_stash_backtrace] function, which is called to quickly
+ * fill the backtrace buffer by walking the stack when an exception is raised.
+ *
+ * It also defines [caml_collect_current_callstack], which stores up
+ * to [max_frames] frames of the current call stack into the
+ * statically allocated buffer [*pbuffer] of length [*plen]. If the
+ * buffer is not long enough, it will be reallocated. The number of
+ * frames collected is returned.
+ *
+ * The alloc_idx parameter is used to select between the backtraces of
+ * different allocation sites which were combined by Comballoc.
+ * Passing -1 here means the caller doesn't care which is chosen.
+ *
+ * We use `intnat` for max_frames because, were it only `int`, passing
+ * `max_int` from the OCaml side would overflow on 64bits machines. */
+
+intnat caml_collect_current_callstack(value** pbuffer, intnat* plen,
+                                      intnat max_frames, int alloc_idx);
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_BACKTRACE_PRIM_H */
diff --git a/runtime/caml/bigarray.h b/runtime/caml/bigarray.h
new file mode 100644
index 00000000..fc1fb145
--- /dev/null
+++ b/runtime/caml/bigarray.h
@@ -0,0 +1,134 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Manuel Serrano and Xavier Leroy, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2000 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_BIGARRAY_H
+#define CAML_BIGARRAY_H
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "config.h"
+#include "mlvalues.h"
+
+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
+
+enum caml_ba_kind {
+  CAML_BA_FLOAT32,             /* Single-precision floats */
+  CAML_BA_FLOAT64,             /* Double-precision floats */
+  CAML_BA_SINT8,               /* Signed 8-bit integers */
+  CAML_BA_UINT8,               /* Unsigned 8-bit integers */
+  CAML_BA_SINT16,              /* Signed 16-bit integers */
+  CAML_BA_UINT16,              /* Unsigned 16-bit integers */
+  CAML_BA_INT32,               /* Signed 32-bit integers */
+  CAML_BA_INT64,               /* Signed 64-bit integers */
+  CAML_BA_CAML_INT,            /* OCaml-style integers (signed 31 or 63 bits) */
+  CAML_BA_NATIVE_INT,       /* Platform-native long integers (32 or 64 bits) */
+  CAML_BA_COMPLEX32,           /* Single-precision complex */
+  CAML_BA_COMPLEX64,           /* Double-precision complex */
+  CAML_BA_CHAR,                /* Characters */
+  CAML_BA_KIND_MASK = 0xFF     /* Mask for kind in flags field */
+};
+
+#define Caml_ba_kind_val(v) Int_val(v)
+
+#define Val_caml_ba_kind(k) Val_int(k)
+
+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_val(v) (Int_val(v) << CAML_BA_LAYOUT_SHIFT)
+
+#define Val_caml_ba_layout(l) Val_int(l >> CAML_BA_LAYOUT_SHIFT)
+
+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 */
+};
+
+struct caml_ba_proxy {
+  intnat refcount;              /* Reference count */
+  void * data;                  /* Pointer to base of actual data */
+  uintnat size;                 /* Size of data in bytes (if mapped file) */
+};
+
+struct caml_ba_array {
+  void * data;                /* Pointer to raw data */
+  intnat num_dims;            /* Number of dimensions */
+  intnat flags;  /* Kind of element array + memory layout + allocation status */
+  struct caml_ba_proxy * proxy; /* The proxy for sub-arrays, or NULL */
+  /* PR#5516: use C99's flexible array types if possible */
+#if (__STDC_VERSION__ >= 199901L)
+  intnat dim[]  /*[num_dims]*/; /* Size in each dimension */
+#else
+  intnat dim[1] /*[num_dims]*/; /* Size in each dimension */
+#endif
+};
+
+/* Size of struct caml_ba_array, in bytes, without dummy first dimension */
+#if (__STDC_VERSION__ >= 199901L)
+#define SIZEOF_BA_ARRAY sizeof(struct caml_ba_array)
+#else
+#define SIZEOF_BA_ARRAY (sizeof(struct caml_ba_array) - sizeof(intnat))
+#endif
+
+#define Caml_ba_array_val(v) ((struct caml_ba_array *) Data_custom_val(v))
+
+#define Caml_ba_data_val(v) (Caml_ba_array_val(v)->data)
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+CAMLextern value
+    caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim);
+CAMLextern value caml_ba_alloc_dims(int flags, int num_dims, void * data,
+                                 ... /*dimensions, with type intnat */);
+CAMLextern uintnat caml_ba_byte_size(struct caml_ba_array * b);
+CAMLextern uintnat caml_ba_num_elts(struct caml_ba_array * b);
+
+#ifdef __cplusplus
+}
+#endif
+
+#ifdef CAML_INTERNALS
+
+CAMLextern int caml_ba_element_size[];
+CAMLextern void caml_ba_finalize(value v);
+CAMLextern int caml_ba_compare(value v1, value v2);
+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_BIGARRAY_H */
diff --git a/runtime/caml/callback.h b/runtime/caml/callback.h
new file mode 100644
index 00000000..eef3342e
--- /dev/null
+++ b/runtime/caml/callback.h
@@ -0,0 +1,59 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Callbacks from C to OCaml */
+
+#ifndef CAML_CALLBACK_H
+#define CAML_CALLBACK_H
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "mlvalues.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+CAMLextern value caml_callback (value closure, value arg);
+CAMLextern value caml_callback2 (value closure, value arg1, value arg2);
+CAMLextern value caml_callback3 (value closure, value arg1, value arg2,
+                                 value arg3);
+CAMLextern value caml_callbackN (value closure, int narg, value args[]);
+
+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,
+                                     value arg1, value arg2, value arg3);
+CAMLextern value caml_callbackN_exn (value closure, int narg, value args[]);
+
+CAMLextern const value * caml_named_value (char const * name);
+typedef void (*caml_named_action) (const value*, char *);
+CAMLextern void caml_iterate_named_values(caml_named_action f);
+
+CAMLextern void caml_main (char_os ** argv);
+CAMLextern void caml_startup (char_os ** argv);
+CAMLextern value caml_startup_exn (char_os ** argv);
+CAMLextern void caml_startup_pooled (char_os ** argv);
+CAMLextern value caml_startup_pooled_exn (char_os ** argv);
+CAMLextern void caml_shutdown (void);
+
+CAMLextern int caml_callback_depth;
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
diff --git a/runtime/caml/compact.h b/runtime/caml/compact.h
new file mode 100644
index 00000000..5f189507
--- /dev/null
+++ b/runtime/caml/compact.h
@@ -0,0 +1,36 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*              Damien Doligez, projet Para, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_COMPACT_H
+#define CAML_COMPACT_H
+
+#ifdef CAML_INTERNALS
+
+#include "config.h"
+#include "misc.h"
+#include "mlvalues.h"
+
+/* [caml_compact_heap] compacts the heap and optionally changes the
+   allocation policy.
+   if [new_allocation_policy] is -1, the policy is not changed.
+*/
+void caml_compact_heap (intnat new_allocation_policy);
+
+void caml_compact_heap_maybe (void);
+void caml_invert_root (value v, value *p);
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_COMPACT_H */
diff --git a/runtime/caml/compare.h b/runtime/caml/compare.h
new file mode 100644
index 00000000..54b71581
--- /dev/null
+++ b/runtime/caml/compare.h
@@ -0,0 +1,25 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*           Damien Doligez, Projet Moscova, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2003 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_COMPARE_H
+#define CAML_COMPARE_H
+
+#ifdef CAML_INTERNALS
+
+CAMLextern int caml_compare_unordered;
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_COMPARE_H */
diff --git a/runtime/caml/compatibility.h b/runtime/caml/compatibility.h
new file mode 100644
index 00000000..1ec4df3f
--- /dev/null
+++ b/runtime/caml/compatibility.h
@@ -0,0 +1,374 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*           Damien Doligez, projet Moscova, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2003 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the 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
+
+/* internal global variables renamed between 4.02.1 and 4.03.0 */
+#define caml_stat_top_heap_size Bsize_wsize(caml_stat_top_heap_wsz)
+#define caml_stat_heap_size Bsize_wsize(caml_stat_heap_wsz)
+
+#ifndef CAML_NAME_SPACE
+
+/*
+   #define --> CAMLextern  (defined with CAMLexport or CAMLprim)
+   (rien)  --> CAMLprim
+   g       --> global C identifier
+   x       --> special case
+
+   SP* signals the special cases:
+   - when the identifier was not simply prefixed with [caml_]
+   - when the [caml_] version was already used for something else, and
+     was renamed out of the way (watch out for [caml_alloc] and
+     [caml_array_bound_error] in *.s)
+*/
+
+/* a faire:
+   - ui_*   (reverifier que win32.c n'en depend pas)
+*/
+
+
+/* **** alloc.c */
+#define alloc caml_alloc /*SP*/
+#define alloc_small caml_alloc_small
+#define alloc_tuple caml_alloc_tuple
+#define alloc_string caml_alloc_string
+#define alloc_final caml_alloc_final
+#define copy_string caml_copy_string
+#define alloc_array caml_alloc_array
+#define copy_string_array caml_copy_string_array
+#define convert_flag_list caml_convert_flag_list
+
+/* **** array.c */
+
+/* **** backtrace.c */
+#define backtrace_active caml_backtrace_active
+#define backtrace_pos caml_backtrace_pos
+#define backtrace_buffer caml_backtrace_buffer
+#define backtrace_last_exn caml_backtrace_last_exn
+#define print_exception_backtrace caml_print_exception_backtrace
+
+/* **** callback.c */
+#define callback_depth caml_callback_depth
+#define callbackN_exn caml_callbackN_exn
+#define callback_exn caml_callback_exn
+#define callback2_exn caml_callback2_exn
+#define callback3_exn caml_callback3_exn
+#define callback caml_callback
+#define callback2 caml_callback2
+#define callback3 caml_callback3
+#define callbackN caml_callbackN
+
+/* **** compact.c */
+
+/* **** compare.c */
+#define compare_unordered caml_compare_unordered
+
+/* **** custom.c */
+#define alloc_custom caml_alloc_custom
+#define register_custom_operations caml_register_custom_operations
+
+/* **** debugger.c */
+
+/* **** dynlink.c */
+
+/* **** extern.c */
+#define output_val caml_output_val
+#define output_value_to_malloc caml_output_value_to_malloc
+#define output_value_to_block caml_output_value_to_block
+#define serialize_int_1 caml_serialize_int_1
+#define serialize_int_2 caml_serialize_int_2
+#define serialize_int_4 caml_serialize_int_4
+#define serialize_int_8 caml_serialize_int_8
+#define serialize_float_4 caml_serialize_float_4
+#define serialize_float_8 caml_serialize_float_8
+#define serialize_block_1 caml_serialize_block_1
+#define serialize_block_2 caml_serialize_block_2
+#define serialize_block_4 caml_serialize_block_4
+#define serialize_block_8 caml_serialize_block_8
+#define serialize_block_float_8 caml_serialize_block_float_8
+
+/* **** fail.c */
+#define external_raise caml_external_raise
+#define mlraise caml_raise /*SP*/
+#define raise_constant caml_raise_constant
+#define raise_with_arg caml_raise_with_arg
+#define raise_with_string caml_raise_with_string
+#define failwith caml_failwith
+#define invalid_argument caml_invalid_argument
+#define array_bound_error caml_array_bound_error /*SP*/
+#define raise_out_of_memory caml_raise_out_of_memory
+#define raise_stack_overflow caml_raise_stack_overflow
+#define raise_sys_error caml_raise_sys_error
+#define raise_end_of_file caml_raise_end_of_file
+#define raise_zero_divide caml_raise_zero_divide
+#define raise_not_found caml_raise_not_found
+#define raise_sys_blocked_io caml_raise_sys_blocked_io
+/* **** runtime/fail_nat.c */
+/* **** runtime/<arch>.s */
+
+/* **** finalise.c */
+
+/* **** fix_code.c */
+
+/* **** floats.c */
+/*#define Double_val caml_Double_val             done in mlvalues.h as needed */
+/*#define Store_double_val caml_Store_double_val done in mlvalues.h as needed */
+#define copy_double caml_copy_double
+
+/* **** freelist.c */
+
+/* **** gc_ctrl.c */
+
+/* **** globroots.c */
+#define register_global_root caml_register_global_root
+#define remove_global_root caml_remove_global_root
+
+/* **** hash.c */
+#define hash_variant caml_hash_variant
+
+/* **** instrtrace.c */
+
+/* **** intern.c */
+#define input_val caml_input_val
+#define input_val_from_string caml_input_val_from_string
+#define input_value_from_malloc caml_input_value_from_malloc
+#define input_value_from_block caml_input_value_from_block
+#define deserialize_uint_1 caml_deserialize_uint_1
+#define deserialize_sint_1 caml_deserialize_sint_1
+#define deserialize_uint_2 caml_deserialize_uint_2
+#define deserialize_sint_2 caml_deserialize_sint_2
+#define deserialize_uint_4 caml_deserialize_uint_4
+#define deserialize_sint_4 caml_deserialize_sint_4
+#define deserialize_uint_8 caml_deserialize_uint_8
+#define deserialize_sint_8 caml_deserialize_sint_8
+#define deserialize_float_4 caml_deserialize_float_4
+#define deserialize_float_8 caml_deserialize_float_8
+#define deserialize_block_1 caml_deserialize_block_1
+#define deserialize_block_2 caml_deserialize_block_2
+#define deserialize_block_4 caml_deserialize_block_4
+#define deserialize_block_8 caml_deserialize_block_8
+#define deserialize_block_float_8 caml_deserialize_block_float_8
+#define deserialize_error caml_deserialize_error
+
+/* **** interp.c */
+
+/* **** ints.c */
+#define int32_ops caml_int32_ops
+#define copy_int32 caml_copy_int32
+/*#define Int64_val caml_Int64_val   *** done in mlvalues.h as needed */
+#define int64_ops caml_int64_ops
+#define copy_int64 caml_copy_int64
+#define nativeint_ops caml_nativeint_ops
+#define copy_nativeint caml_copy_nativeint
+
+/* **** io.c */
+#define channel_mutex_free caml_channel_mutex_free
+#define channel_mutex_lock caml_channel_mutex_lock
+#define channel_mutex_unlock caml_channel_mutex_unlock
+#define channel_mutex_unlock_exn caml_channel_mutex_unlock_exn
+#define all_opened_channels caml_all_opened_channels
+#define open_descriptor_in caml_open_descriptor_in /*SP*/
+#define open_descriptor_out caml_open_descriptor_out /*SP*/
+#define close_channel caml_close_channel /*SP*/
+#define channel_size caml_channel_size /*SP*/
+#define channel_binary_mode caml_channel_binary_mode
+#define flush_partial caml_flush_partial /*SP*/
+#define flush caml_flush /*SP*/
+#define putword caml_putword
+#define putblock caml_putblock
+#define really_putblock caml_really_putblock
+#define seek_out caml_seek_out /*SP*/
+#define pos_out caml_pos_out /*SP*/
+#define do_read caml_do_read
+#define refill caml_refill
+#define getword caml_getword
+#define getblock caml_getblock
+#define really_getblock caml_really_getblock
+#define seek_in caml_seek_in /*SP*/
+#define pos_in caml_pos_in /*SP*/
+#define input_scan_line caml_input_scan_line /*SP*/
+#define finalize_channel caml_finalize_channel
+#define alloc_channel caml_alloc_channel
+/*#define Val_file_offset caml_Val_file_offset   *** done in io.h as needed */
+/*#define File_offset_val caml_File_offset_val   *** done in io.h as needed */
+
+/* **** lexing.c */
+
+/* **** main.c */
+/* *** no change */
+
+/* **** major_gc.c */
+#define heap_start caml_heap_start
+#define page_table caml_page_table
+
+/* **** md5.c */
+#define md5_string caml_md5_string
+#define md5_chan caml_md5_chan
+#define MD5Init caml_MD5Init
+#define MD5Update caml_MD5Update
+#define MD5Final caml_MD5Final
+#define MD5Transform caml_MD5Transform
+
+/* **** memory.c */
+#define alloc_shr caml_alloc_shr
+#define initialize caml_initialize
+#define modify caml_modify
+#define stat_alloc caml_stat_alloc
+#define stat_free caml_stat_free
+#define stat_resize caml_stat_resize
+
+/* **** meta.c */
+
+/* **** minor_gc.c */
+#define young_start caml_young_start
+#define young_end caml_young_end
+#define young_ptr caml_young_ptr
+#define young_limit caml_young_limit
+#define ref_table caml_ref_table
+#define minor_collection caml_minor_collection
+#define check_urgent_gc caml_check_urgent_gc
+
+/* **** misc.c */
+
+/* **** obj.c */
+
+/* **** parsing.c */
+
+/* **** prims.c */
+
+/* **** printexc.c */
+#define format_caml_exception caml_format_exception /*SP*/
+
+/* **** roots.c */
+#define local_roots caml_local_roots
+#define scan_roots_hook caml_scan_roots_hook
+#define do_local_roots caml_do_local_roots
+
+/* **** signals.c */
+#define pending_signals caml_pending_signals
+#define something_to_do caml_something_to_do
+#define enter_blocking_section_hook caml_enter_blocking_section_hook
+#define leave_blocking_section_hook caml_leave_blocking_section_hook
+#define try_leave_blocking_section_hook caml_try_leave_blocking_section_hook
+#define enter_blocking_section caml_enter_blocking_section
+#define leave_blocking_section caml_leave_blocking_section
+#define convert_signal_number caml_convert_signal_number
+/* **** runtime/signals.c */
+#define garbage_collection caml_garbage_collection
+
+/* **** stacks.c */
+#define stack_low caml_stack_low
+#define stack_high caml_stack_high
+#define stack_threshold caml_stack_threshold
+#define extern_sp caml_extern_sp
+#define trapsp caml_trapsp
+#define trap_barrier caml_trap_barrier
+
+/* **** startup.c */
+#define atom_table caml_atom_table
+/* **** runtime/startup_nat.c */
+#define static_data_start caml_static_data_start
+#define static_data_end caml_static_data_end
+
+/* **** str.c */
+#define string_length caml_string_length
+
+/* **** sys.c */
+#define sys_error caml_sys_error
+#define sys_exit caml_sys_exit
+
+/* **** terminfo.c */
+
+/* **** unix.c  &  win32.c */
+#define search_exe_in_path caml_search_exe_in_path
+
+/* **** weak.c */
+
+/* **** asmcomp/asmlink.ml */
+
+/* **** asmcomp/cmmgen.ml */
+
+/* **** asmcomp/asmlink.ml, asmcomp/cmmgen.ml, asmcomp/compilenv.ml */
+
+/* ************************************************************* */
+
+/* **** otherlibs/bigarray */
+#define int8 caml_ba_int8
+#define uint8 caml_ba_uint8
+#define int16 caml_ba_int16
+#define uint16 caml_ba_uint16
+#define MAX_NUM_DIMS CAML_BA_MAX_NUM_DIMS
+#define caml_bigarray_kind caml_ba_kind
+#define BIGARRAY_FLOAT32 CAML_BA_FLOAT32
+#define BIGARRAY_FLOAT64 CAML_BA_FLOAT64
+#define BIGARRAY_SINT8 CAML_BA_SINT8
+#define BIGARRAY_UINT8 CAML_BA_UINT8
+#define BIGARRAY_SINT16 CAML_BA_SINT16
+#define BIGARRAY_UINT16 CAML_BA_UINT16
+#define BIGARRAY_INT32 CAML_BA_INT32
+#define BIGARRAY_INT64 CAML_BA_INT64
+#define BIGARRAY_CAML_INT CAML_BA_CAML_INT
+#define BIGARRAY_NATIVE_INT CAML_BA_NATIVE_INT
+#define BIGARRAY_COMPLEX32 CAML_BA_COMPLEX32
+#define BIGARRAY_COMPLEX64 CAML_BA_COMPLEX64
+#define BIGARRAY_KIND_MASK CAML_BA_KIND_MASK
+#define caml_bigarray_layout caml_ba_layout
+#define BIGARRAY_C_LAYOUT CAML_BA_C_LAYOUT
+#define BIGARRAY_FORTRAN_LAYOUT CAML_BA_FORTRAN_LAYOUT
+#define BIGARRAY_LAYOUT_MASK CAML_BA_LAYOUT_MASK
+#define caml_bigarray_managed caml_ba_managed
+#define BIGARRAY_EXTERNAL CAML_BA_EXTERNAL
+#define BIGARRAY_MANAGED CAML_BA_MANAGED
+#define BIGARRAY_MAPPED_FILE CAML_BA_MAPPED_FILE
+#define BIGARRAY_MANAGED_MASK CAML_BA_MANAGED_MASK
+#define caml_bigarray_proxy caml_ba_proxy
+#define caml_bigarray caml_ba_array
+#define Bigarray_val Caml_ba_array_val
+#define Data_bigarray_val Caml_ba_data_val
+#define alloc_bigarray caml_ba_alloc
+#define alloc_bigarray_dims caml_ba_alloc_dims
+#define bigarray_map_file caml_ba_map_file
+#define bigarray_unmap_file caml_ba_unmap_file
+#define bigarray_element_size caml_ba_element_size
+#define bigarray_byte_size caml_ba_byte_size
+#define bigarray_deserialize caml_ba_deserialize
+#define MAX_BIGARRAY_MEMORY CAML_BA_MAX_MEMORY
+#define bigarray_create caml_ba_create
+#define bigarray_get_N caml_ba_get_N
+#define bigarray_get_1 caml_ba_get_1
+#define bigarray_get_2 caml_ba_get_2
+#define bigarray_get_3 caml_ba_get_3
+#define bigarray_get_generic caml_ba_get_generic
+#define bigarray_set_1 caml_ba_set_1
+#define bigarray_set_2 caml_ba_set_2
+#define bigarray_set_3 caml_ba_set_3
+#define bigarray_set_N caml_ba_set_N
+#define bigarray_set_generic caml_ba_set_generic
+#define bigarray_num_dims caml_ba_num_dims
+#define bigarray_dim caml_ba_dim
+#define bigarray_kind caml_ba_kind
+#define bigarray_layout caml_ba_layout
+#define bigarray_slice caml_ba_slice
+#define bigarray_sub caml_ba_sub
+#define bigarray_blit caml_ba_blit
+#define bigarray_fill caml_ba_fill
+#define bigarray_reshape caml_ba_reshape
+#define bigarray_init caml_ba_init
+
+#endif /* CAML_NAME_SPACE */
+#endif /* CAML_COMPATIBILITY_H */
diff --git a/runtime/caml/config.h b/runtime/caml/config.h
new file mode 100644
index 00000000..b119bc34
--- /dev/null
+++ b/runtime/caml/config.h
@@ -0,0 +1,260 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_CONFIG_H
+#define CAML_CONFIG_H
+
+#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
+#ifndef __PIC__
+#  define ARCH_CODE32
+#endif /* __PIC__ */
+#endif /* HAS_ARCH_CODE32 */
+
+/* Microsoft introduced the LL integer literal suffix in Visual C++ .NET 2003 */
+#if defined(_MSC_VER) && _MSC_VER < 1400
+#define INT64_LITERAL(s) s ## i64
+#else
+#define INT64_LITERAL(s) s ## LL
+#endif
+
+#if defined(_MSC_VER) && !defined(__cplusplus)
+#define Caml_inline static __inline
+#else
+#define Caml_inline static inline
+#endif
+
+#include "s.h"
+
+#ifdef BOOTSTRAPPING_FLEXLINK
+#undef SUPPORT_DYNAMIC_LINKING
+#endif
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+
+#ifndef CAML_CONFIG_H_NO_TYPEDEFS
+
+#include <stddef.h>
+
+#if defined(HAS_LOCALE_H) || defined(HAS_XLOCALE_H)
+#define HAS_LOCALE
+#endif
+
+#ifdef HAS_STDINT_H
+#include <stdint.h>
+#endif
+
+#if defined(__MINGW32__) || (defined(_MSC_VER) && _MSC_VER < 1800)
+#define ARCH_SIZET_PRINTF_FORMAT "I"
+#else
+#define ARCH_SIZET_PRINTF_FORMAT "z"
+#endif
+
+/* Types for 32-bit integers, 64-bit integers, and
+   native integers (as wide as a pointer type) */
+
+#ifndef ARCH_INT32_TYPE
+#if SIZEOF_INT == 4
+#define ARCH_INT32_TYPE int
+#define ARCH_UINT32_TYPE unsigned int
+#define ARCH_INT32_PRINTF_FORMAT ""
+#elif SIZEOF_LONG == 4
+#define ARCH_INT32_TYPE long
+#define ARCH_UINT32_TYPE unsigned long
+#define ARCH_INT32_PRINTF_FORMAT "l"
+#elif SIZEOF_SHORT == 4
+#define ARCH_INT32_TYPE short
+#define ARCH_UINT32_TYPE unsigned short
+#define ARCH_INT32_PRINTF_FORMAT ""
+#else
+#error "No 32-bit integer type available"
+#endif
+#endif
+
+#ifdef __MINGW32__
+  #define ARCH_INT64_TYPE long long
+  #define ARCH_UINT64_TYPE unsigned long long
+  #define ARCH_INT64_PRINTF_FORMAT "I64"
+#elif defined(_MSC_VER)
+  #define ARCH_INT64_TYPE __int64
+  #define ARCH_UINT64_TYPE unsigned __int64
+  #define ARCH_INT64_PRINTF_FORMAT "I64"
+#else
+  #if SIZEOF_LONG == 8
+    #define ARCH_INT64_TYPE long
+    #define ARCH_UINT64_TYPE unsigned long
+    #define ARCH_INT64_PRINTF_FORMAT "l"
+  #elif SIZEOF_LONGLONG == 8
+    #define ARCH_INT64_TYPE long long
+    #define ARCH_UINT64_TYPE unsigned long long
+    #define ARCH_INT64_PRINTF_FORMAT "ll"
+  #else
+    #error "No 64-bit integer type available"
+  #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;
+typedef unsigned long uintnat;
+#define ARCH_INTNAT_PRINTF_FORMAT "l"
+#elif SIZEOF_PTR == SIZEOF_INT
+/* Hypothetical IP32L64 model */
+typedef int intnat;
+typedef unsigned int uintnat;
+#define ARCH_INTNAT_PRINTF_FORMAT ""
+#elif SIZEOF_PTR == 8
+/* Win64 model: IL32P64 */
+typedef int64_t intnat;
+typedef uint64_t uintnat;
+#define ARCH_INTNAT_PRINTF_FORMAT ARCH_INT64_PRINTF_FORMAT
+#else
+#error "No integer type available to represent pointers"
+#endif
+
+#endif /* CAML_CONFIG_H_NO_TYPEDEFS */
+
+/* Endianness of floats */
+
+/* ARCH_FLOAT_ENDIANNESS encodes the byte order of doubles as follows:
+   the value [0xabcdefgh] means that the least significant byte of the
+   float is at byte offset [a], the next lsb at [b], ..., and the
+   most significant byte at [h]. */
+
+#if defined(__arm__) && !defined(__ARM_EABI__)
+#define ARCH_FLOAT_ENDIANNESS 0x45670123
+#elif defined(ARCH_BIG_ENDIAN)
+#define ARCH_FLOAT_ENDIANNESS 0x76543210
+#else
+#define ARCH_FLOAT_ENDIANNESS 0x01234567
+#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) && !defined(CAML_JIT)
+#define THREADED_CODE
+#endif
+
+
+/* Memory model parameters */
+
+/* The size of a page for memory management (in bytes) is [1 << Page_log].
+   [Page_size] must be a multiple of [sizeof (value)].
+   [Page_log] must be be >= 8 and <= 20.
+   Do not change the definition of [Page_size]. */
+#define Page_log 12             /* A page is 4 kilobytes. */
+#define Page_size (1 << Page_log)
+
+/* Initial size of stack (bytes). */
+#define Stack_size (4096 * sizeof(value))
+
+/* Minimum free size of stack (bytes); below that, it is reallocated. */
+#define Stack_threshold (256 * sizeof(value))
+
+/* Default maximum size of the stack (words). */
+#define Max_stack_def (1024 * 1024)
+
+
+/* Maximum size of a block allocated in the young generation (words). */
+/* Must be > 4 */
+#define Max_young_wosize 256
+#define Max_young_whsize (Whsize_wosize (Max_young_wosize))
+
+
+/* Minimum size of the minor zone (words).
+   This must be at least [2 * Max_young_whsize]. */
+#define Minor_heap_min 4096
+
+/* Maximum size of the minor zone (words).
+   Must be greater than or equal to [Minor_heap_min].
+*/
+#define Minor_heap_max (1 << 28)
+
+/* Default size of the minor zone. (words)  */
+#define Minor_heap_def 262144
+
+
+/* Minimum size increment when growing the heap (words).
+   Must be a multiple of [Page_size / sizeof (value)]. */
+#define Heap_chunk_min (15 * Page_size)
+
+/* Default size increment when growing the heap.
+   If this is <= 1000, it's a percentage of the current heap size.
+   If it is > 1000, it's a number of words. */
+#define Heap_chunk_def 15
+
+/* Default initial size of the major heap (words);
+   Must be a multiple of [Page_size / sizeof (value)]. */
+#define Init_heap_def (31 * Page_size)
+/* (about 512 kB for a 32-bit platform, 1 MB for a 64-bit platform.) */
+
+
+/* Default speed setting for the major GC.  The heap will grow until
+   the dead objects and the free list represent this percentage of the
+   total size of live objects. */
+#define Percent_free_def 80
+
+/* Default setting for the compacter: 500%
+   (i.e. trigger the compacter when 5/6 of the heap is free or garbage)
+   This can be set quite high because the overhead is over-estimated
+   when fragmentation occurs.
+ */
+#define Max_percent_free_def 500
+
+/* Default setting for the major GC slice smoothing window: 1
+   (i.e. no smoothing)
+*/
+#define Major_window_def 1
+
+/* Maximum size of the major GC slice smoothing window. */
+#define Max_major_window 50
+
+/* Default setting for the ratio of custom garbage to major heap size.
+   Documented in gc.mli */
+#define Custom_major_ratio_def 44
+
+/* Default setting for the ratio of custom garbage to minor heap size.
+   Documented in gc.mli */
+#define Custom_minor_ratio_def 100
+
+/* Default setting for maximum size of custom objects counted as garbage
+   in the minor heap.
+   Documented in gc.mli */
+#define Custom_minor_max_bsz_def 8192
+
+#endif /* CAML_CONFIG_H */
diff --git a/runtime/caml/custom.h b/runtime/caml/custom.h
new file mode 100644
index 00000000..2713867b
--- /dev/null
+++ b/runtime/caml/custom.h
@@ -0,0 +1,84 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Manuel Serrano and Xavier Leroy, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2000 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_CUSTOM_H
+#define CAML_CUSTOM_H
+
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "mlvalues.h"
+
+struct custom_fixed_length {
+  intnat bsize_32;
+  intnat bsize_64;
+};
+
+struct custom_operations {
+  char const *identifier;
+  void (*finalize)(value v);
+  int (*compare)(value v1, value v2);
+  intnat (*hash)(value v);
+  void (*serialize)(value v,
+                    /*out*/ uintnat * bsize_32 /*size in bytes*/,
+                    /*out*/ uintnat * bsize_64 /*size in bytes*/);
+  uintnat (*deserialize)(void * dst);
+  int (*compare_ext)(value v1, value v2);
+  const struct custom_fixed_length* fixed_length;
+};
+
+#define custom_finalize_default NULL
+#define custom_compare_default NULL
+#define custom_hash_default NULL
+#define custom_serialize_default NULL
+#define custom_deserialize_default NULL
+#define custom_compare_ext_default NULL
+#define custom_fixed_length_default NULL
+
+#define Custom_ops_val(v) (*((struct custom_operations **) (v)))
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+CAMLextern value caml_alloc_custom(struct custom_operations * ops,
+                                   uintnat size, /*size in bytes*/
+                                   mlsize_t mem, /*resources consumed*/
+                                   mlsize_t max  /*max resources*/);
+
+CAMLextern value caml_alloc_custom_mem(struct custom_operations * ops,
+                                       uintnat size, /*size in bytes*/
+                                       mlsize_t mem  /*memory consumed*/);
+
+CAMLextern void caml_register_custom_operations(struct custom_operations * ops);
+
+/* Global variable moved to Caml_state in 4.10 */
+#define caml_compare_unordered (Caml_state_field(compare_unordered))
+
+#ifdef CAML_INTERNALS
+extern struct custom_operations * caml_find_custom_operations(char * ident);
+extern struct custom_operations *
+          caml_final_custom_operations(void (*fn)(value));
+
+extern void caml_init_custom_operations(void);
+#endif /* CAML_INTERNALS */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_CUSTOM_H */
diff --git a/runtime/caml/debugger.h b/runtime/caml/debugger.h
new file mode 100644
index 00000000..f5b27f61
--- /dev/null
+++ b/runtime/caml/debugger.h
@@ -0,0 +1,130 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Interface with the debugger */
+
+#ifndef CAML_DEBUGGER_H
+#define CAML_DEBUGGER_H
+
+#ifdef CAML_INTERNALS
+
+#include "misc.h"
+#include "mlvalues.h"
+
+CAMLextern int caml_debugger_in_use;
+CAMLextern int caml_debugger_fork_mode; /* non-zero for parent */
+extern uintnat caml_event_count;
+
+enum event_kind {
+  EVENT_COUNT, BREAKPOINT, PROGRAM_START, PROGRAM_EXIT,
+  TRAP_BARRIER, UNCAUGHT_EXC, DEBUG_INFO_ADDED,
+  CODE_LOADED, CODE_UNLOADED
+};
+
+void caml_debugger_init (void);
+void caml_debugger (enum event_kind event, value param);
+void caml_debugger_cleanup_fork (void);
+
+opcode_t caml_debugger_saved_instruction(code_t pc);
+
+/* Communication protocol */
+
+/* Requests from the debugger to the runtime system */
+
+enum debugger_request {
+  REQ_SET_EVENT = 'e',          /* uint32_t pos */
+  /* Set an event on the instruction at position pos */
+  REQ_SET_BREAKPOINT = 'B',     /* uint32_t pos, (char k) */
+  /* Set a breakpoint at position pos */
+  /* In profiling mode, the breakpoint kind is set to k */
+  REQ_RESET_INSTR = 'i',        /* uint32_t pos */
+  /* Clear an event or breapoint at position pos, restores initial instr. */
+  REQ_CHECKPOINT = 'c',         /* no args */
+  /* Checkpoint the runtime system by forking a child process.
+     Reply is pid of child process or -1 if checkpoint failed. */
+  REQ_GO = 'g',                 /* uint32_t n */
+  /* Run the program for n events.
+     Reply is one of debugger_reply described below. */
+  REQ_STOP = 's',               /* no args */
+  /* Terminate the runtime system */
+  REQ_WAIT = 'w',               /* no args */
+  /* Reap one dead child (a discarded checkpoint). */
+  REQ_INITIAL_FRAME = '0',      /* no args */
+  /* Set current frame to bottom frame (the one currently executing).
+     Reply is stack offset and current pc. */
+  REQ_GET_FRAME = 'f',          /* no args */
+  /* Return current frame location (stack offset + current pc). */
+  REQ_SET_FRAME = 'S',          /* uint32_t stack_offset */
+  /* Set current frame to given stack offset. No reply. */
+  REQ_UP_FRAME = 'U',           /* uint32_t n */
+  /* Move one frame up. Argument n is size of current frame (in words).
+     Reply is stack offset and current pc, or -1 if top of stack reached. */
+  REQ_SET_TRAP_BARRIER = 'b',   /* uint32_t offset */
+  /* Set the trap barrier at the given offset. */
+  REQ_GET_LOCAL = 'L',          /* uint32_t slot_number */
+  /* Return the local variable at the given slot in the current frame.
+     Reply is one value. */
+  REQ_GET_ENVIRONMENT = 'E',    /* uint32_t slot_number */
+  /* Return the local variable at the given slot in the heap environment
+     of the current frame. Reply is one value. */
+  REQ_GET_GLOBAL = 'G',         /* uint32_t global_number */
+  /* Return the specified global variable. Reply is one value. */
+  REQ_GET_ACCU = 'A',           /* no args */
+  /* Return the current contents of the accumulator. Reply is one value. */
+  REQ_GET_HEADER = 'H',         /* mlvalue v */
+  /* As REQ_GET_OBJ, but sends only the header. */
+  REQ_GET_FIELD = 'F',          /* mlvalue v, uint32_t fieldnum */
+  /* As REQ_GET_OBJ, but sends only one field. */
+  REQ_MARSHAL_OBJ = 'M',        /* mlvalue v */
+  /* Send a copy of the data structure rooted at v, using the same
+     format as [caml_output_value]. */
+  REQ_GET_CLOSURE_CODE = 'C',   /* mlvalue v */
+  /* Send the code address of the given closure.
+     Reply is one uint32_t. */
+  REQ_SET_FORK_MODE = 'K'       /* uint32_t m */
+  /* Set whether to follow the child (m=0) or the parent on fork. */
+};
+
+/* Replies to a REQ_GO request. All replies are followed by three uint32_t:
+   - the value of the event counter
+   - the position of the stack
+   - the current pc.
+   The REP_CODE_DEBUG_INFO reply is also followed by:
+   - the newly added debug information.
+   The REP_CODE_{UN,}LOADED reply is also followed by:
+   - the code fragment index. */
+
+enum debugger_reply {
+  REP_EVENT = 'e',
+  /* Event counter reached 0. */
+  REP_BREAKPOINT = 'b',
+  /* Breakpoint hit. */
+  REP_EXITED = 'x',
+  /* Program exited by calling exit or reaching the end of the source. */
+  REP_TRAP = 's',
+  /* Trap barrier crossed. */
+  REP_UNCAUGHT_EXC = 'u',
+  /* Program exited due to a stray exception. */
+  REP_CODE_DEBUG_INFO = 'D',
+  /* Additional debug info loaded. */
+  REP_CODE_LOADED = 'L',
+  /* Additional code loaded. */
+  REP_CODE_UNLOADED = 'U',
+  /* Additional code unloaded. */
+};
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_DEBUGGER_H */
diff --git a/runtime/caml/domain.h b/runtime/caml/domain.h
new file mode 100644
index 00000000..23833d24
--- /dev/null
+++ b/runtime/caml/domain.h
@@ -0,0 +1,36 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*      KC Sivaramakrishnan, Indian Institute of Technology, Madras       */
+/*                   Stephen Dolan, University of Cambridge               */
+/*                                                                        */
+/*   Copyright 2019 Indian Institute of Technology, Madras                */
+/*   Copyright 2019 University of Cambridge                               */
+/*                                                                        */
+/*   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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_DOMAIN_H
+#define CAML_DOMAIN_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef CAML_INTERNALS
+
+#include "domain_state.h"
+
+void caml_init_domain(void);
+
+#endif /* CAML_INTERNALS */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_DOMAIN_H */
diff --git a/runtime/caml/domain_state.h b/runtime/caml/domain_state.h
new file mode 100644
index 00000000..ee4613d6
--- /dev/null
+++ b/runtime/caml/domain_state.h
@@ -0,0 +1,59 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*      KC Sivaramakrishnan, Indian Institute of Technology, Madras       */
+/*                Stephen Dolan, University of Cambridge                  */
+/*                                                                        */
+/*   Copyright 2019 Indian Institute of Technology, Madras                */
+/*   Copyright 2019 University of Cambridge                               */
+/*                                                                        */
+/*   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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_STATE_H
+#define CAML_STATE_H
+
+#include <stddef.h>
+#include <stdio.h>
+#include "misc.h"
+#include "mlvalues.h"
+
+/* This structure sits in the TLS area and is also accessed efficiently
+ * via native code, which is why the indices are important */
+
+typedef struct {
+#ifdef CAML_NAME_SPACE
+#define DOMAIN_STATE(type, name) CAMLalign(8) type name;
+#else
+#define DOMAIN_STATE(type, name) CAMLalign(8) type _##name;
+#endif
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+    CAMLalign(8) char end_of_domain_state;
+} caml_domain_state;
+
+enum {
+  Domain_state_num_fields =
+#define DOMAIN_STATE(type, name) + 1
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+};
+
+/* Check that the structure was laid out without padding,
+   since the runtime assumes this in computing offsets */
+CAML_STATIC_ASSERT(
+    offsetof(caml_domain_state, end_of_domain_state) ==
+    Domain_state_num_fields * 8);
+
+CAMLextern caml_domain_state* Caml_state;
+#ifdef CAML_NAME_SPACE
+#define Caml_state_field(field) Caml_state->field
+#else
+#define Caml_state_field(field) Caml_state->_##field
+#endif
+
+#endif /* CAML_STATE_H */
diff --git a/runtime/caml/domain_state.tbl b/runtime/caml/domain_state.tbl
new file mode 100644
index 00000000..ef838433
--- /dev/null
+++ b/runtime/caml/domain_state.tbl
@@ -0,0 +1,82 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*      KC Sivaramakrishnan, Indian Institute of Technology, Madras       */
+/*                   Stephen Dolan, University of Cambridge               */
+/*                                                                        */
+/*   Copyright 2019 Indian Institute of Technology, Madras                */
+/*   Copyright 2019 University of Cambridge                               */
+/*                                                                        */
+/*   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.          */
+/*                                                                        */
+/**************************************************************************/
+
+DOMAIN_STATE(value*, young_ptr)
+DOMAIN_STATE(value*, young_limit)
+/* Minor heap limit. See minor_gc.c. */
+
+DOMAIN_STATE(char*, exception_pointer)
+/* Exception pointer that points into the current stack */
+
+DOMAIN_STATE(void*, young_base)
+DOMAIN_STATE(value*, young_start)
+DOMAIN_STATE(value*, young_end)
+DOMAIN_STATE(value*, young_alloc_start)
+DOMAIN_STATE(value*, young_alloc_end)
+DOMAIN_STATE(value*, young_alloc_mid)
+DOMAIN_STATE(value*, young_trigger)
+DOMAIN_STATE(asize_t, minor_heap_wsz)
+DOMAIN_STATE(intnat, in_minor_collection)
+DOMAIN_STATE(double, extra_heap_resources_minor)
+DOMAIN_STATE(struct caml_ref_table*, ref_table)
+DOMAIN_STATE(struct caml_ephe_ref_table*, ephe_ref_table)
+DOMAIN_STATE(struct caml_custom_table*, custom_table)
+/* See minor_gc.c */
+
+DOMAIN_STATE(value*, stack_low)
+DOMAIN_STATE(value*, stack_high)
+DOMAIN_STATE(value*, stack_threshold)
+DOMAIN_STATE(value*, extern_sp)
+DOMAIN_STATE(value*, trapsp)
+DOMAIN_STATE(value*, trap_barrier)
+DOMAIN_STATE(struct longjmp_buffer*, external_raise)
+DOMAIN_STATE(value, exn_bucket)
+/* See interp.c */
+
+DOMAIN_STATE(char*, top_of_stack)
+DOMAIN_STATE(char*, bottom_of_stack)
+DOMAIN_STATE(uintnat, last_return_address)
+DOMAIN_STATE(value*, gc_regs)
+/* See roots_nat.c */
+
+DOMAIN_STATE(intnat, backtrace_active)
+DOMAIN_STATE(intnat, backtrace_pos)
+DOMAIN_STATE(backtrace_slot*, backtrace_buffer)
+DOMAIN_STATE(value, backtrace_last_exn)
+/* See backtrace.c */
+
+DOMAIN_STATE(intnat, compare_unordered)
+DOMAIN_STATE(intnat, requested_major_slice)
+DOMAIN_STATE(intnat, requested_minor_gc)
+DOMAIN_STATE(struct caml__roots_block *, local_roots)
+
+DOMAIN_STATE(double, stat_minor_words)
+DOMAIN_STATE(double, stat_promoted_words)
+DOMAIN_STATE(double, stat_major_words)
+DOMAIN_STATE(intnat, stat_minor_collections)
+DOMAIN_STATE(intnat, stat_major_collections)
+DOMAIN_STATE(intnat, stat_heap_wsz)
+DOMAIN_STATE(intnat, stat_top_heap_wsz)
+DOMAIN_STATE(intnat, stat_compactions)
+DOMAIN_STATE(intnat, stat_heap_chunks)
+/* See gc_ctrl.c */
+
+DOMAIN_STATE(uintnat, eventlog_startup_timestamp)
+DOMAIN_STATE(uint32_t, eventlog_startup_pid)
+DOMAIN_STATE(uintnat, eventlog_paused)
+DOMAIN_STATE(uintnat, eventlog_enabled)
+DOMAIN_STATE(FILE*, eventlog_out)
+/* See eventlog.c */
diff --git a/runtime/caml/dune b/runtime/caml/dune
new file mode 100644
index 00000000..5b6c7cb2
--- /dev/null
+++ b/runtime/caml/dune
@@ -0,0 +1,29 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+(rule
+ (targets jumptbl.h)
+ (mode    fallback)
+ (deps (:h instruct.h))
+ (action
+   (with-stdout-to %{targets}
+     (bash "cat %{h} | tr -d '\\r' | \
+            sed -n -e '/^  /s/ \\([A-Z]\\)/ \\&\\&lbl_\\1/gp' -e '/^}/q'"))))
+
+(rule
+ (targets version.h)
+ (mode    fallback)
+ (action
+   (with-stdout-to %{targets}
+     (run %{dep:../../tools/make-version-header.sh} %{dep:../../VERSION}))))
diff --git a/runtime/caml/dynlink.h b/runtime/caml/dynlink.h
new file mode 100644
index 00000000..92f4e235
--- /dev/null
+++ b/runtime/caml/dynlink.h
@@ -0,0 +1,46 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2000 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Dynamic loading of C primitives. */
+
+#ifndef CAML_DYNLINK_H
+#define CAML_DYNLINK_H
+
+#ifdef CAML_INTERNALS
+
+#include "misc.h"
+
+/* Build the table of primitives, given a search path, a list
+   of shared libraries, and a list of primitive names
+   (all three 0-separated in char arrays).
+   Abort the runtime system on error.
+   Calling this frees caml_shared_libs_path (not touching its contents). */
+extern void caml_build_primitive_table(char_os * lib_path,
+                                       char_os * libs,
+                                       char * req_prims);
+
+/* The search path for shared libraries */
+extern struct ext_table caml_shared_libs_path;
+
+/* Build the table of primitives as a copy of the builtin primitive table.
+   Used for executables generated by ocamlc -output-obj. */
+extern void caml_build_primitive_table_builtin(void);
+
+/* Unload all the previously loaded shared libraries */
+extern void caml_free_shared_libs(void);
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_DYNLINK_H */
diff --git a/runtime/caml/eventlog.h b/runtime/caml/eventlog.h
new file mode 100644
index 00000000..3f2a4fca
--- /dev/null
+++ b/runtime/caml/eventlog.h
@@ -0,0 +1,130 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                 Stephen Dolan, University of Cambridge                 */
+/*                      Enguerrand Decorne, Tarides                       */
+/*                                                                        */
+/*   Copyright 2020 University of Cambridge                               */
+/*   Copyright 2020 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_EVENTLOG_H
+#define CAML_EVENTLOG_H
+
+typedef enum {
+    EV_ENTRY,
+    EV_EXIT,
+    EV_COUNTER,
+    EV_ALLOC,
+    EV_FLUSH
+} ev_type;
+
+typedef enum {
+    EV_COMPACT_MAIN,
+    EV_COMPACT_RECOMPACT,
+    EV_EXPLICIT_GC_SET,
+    EV_EXPLICIT_GC_STAT,
+    EV_EXPLICIT_GC_MINOR,
+    EV_EXPLICIT_GC_MAJOR,
+    EV_EXPLICIT_GC_FULL_MAJOR,
+    EV_EXPLICIT_GC_COMPACT,
+    EV_MAJOR,
+    EV_MAJOR_ROOTS,
+    EV_MAJOR_SWEEP,
+    EV_MAJOR_MARK_ROOTS,
+    EV_MAJOR_MARK_MAIN,
+    EV_MAJOR_MARK_FINAL,
+    EV_MAJOR_MARK,
+    EV_MAJOR_MARK_GLOBAL_ROOTS_SLICE,
+    EV_MAJOR_ROOTS_GLOBAL,
+    EV_MAJOR_ROOTS_DYNAMIC_GLOBAL,
+    EV_MAJOR_ROOTS_LOCAL,
+    EV_MAJOR_ROOTS_C,
+    EV_MAJOR_ROOTS_FINALISED,
+    EV_MAJOR_ROOTS_MEMPROF,
+    EV_MAJOR_ROOTS_HOOK,
+    EV_MAJOR_CHECK_AND_COMPACT,
+    EV_MINOR,
+    EV_MINOR_LOCAL_ROOTS,
+    EV_MINOR_REF_TABLES,
+    EV_MINOR_COPY,
+    EV_MINOR_UPDATE_WEAK,
+    EV_MINOR_FINALIZED,
+    EV_EXPLICIT_GC_MAJOR_SLICE
+} ev_gc_phase;
+
+typedef enum {
+    EV_C_ALLOC_JUMP,
+    EV_C_FORCE_MINOR_ALLOC_SMALL,
+    EV_C_FORCE_MINOR_MAKE_VECT,
+    EV_C_FORCE_MINOR_SET_MINOR_HEAP_SIZE,
+    EV_C_FORCE_MINOR_WEAK,
+    EV_C_FORCE_MINOR_MEMPROF,
+    EV_C_MAJOR_MARK_SLICE_REMAIN,
+    EV_C_MAJOR_MARK_SLICE_FIELDS,
+    EV_C_MAJOR_MARK_SLICE_POINTERS,
+    EV_C_MAJOR_WORK_EXTRA,
+    EV_C_MAJOR_WORK_MARK,
+    EV_C_MAJOR_WORK_SWEEP,
+    EV_C_MINOR_PROMOTED,
+    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_gc_counter;
+
+#ifdef CAML_INSTR
+
+#define CAML_EVENTLOG_DO(f) if (Caml_state->eventlog_enabled &&\
+                                 !Caml_state->eventlog_paused) f
+
+#define CAML_EVENTLOG_INIT() caml_eventlog_init()
+#define CAML_EVENTLOG_DISABLE() caml_eventlog_disable()
+#define CAML_EV_BEGIN(p) caml_ev_begin(p)
+#define CAML_EV_END(p) caml_ev_end(p)
+#define CAML_EV_COUNTER(c, v) caml_ev_counter(c, v)
+#define CAML_EV_ALLOC(s) caml_ev_alloc(s)
+#define CAML_EV_ALLOC_FLUSH() caml_ev_alloc_flush()
+#define CAML_EV_FLUSH() caml_ev_flush()
+
+/* General note about the public API for the eventlog framework
+   The caml_ev_* functions are no-op when called with the eventlog framework
+   paused or disabled.
+   caml_eventlog_* functions on the other hand may introduce side effects
+   (such as write buffer flushes, or side effects in the eventlog internals.)
+
+   All these functions should be called while holding the runtime lock.
+*/
+
+void caml_eventlog_init(void);
+void caml_eventlog_disable(void);
+void caml_ev_begin(ev_gc_phase phase);
+void caml_ev_end(ev_gc_phase phase);
+void caml_ev_counter(ev_gc_counter counter, uint64_t val);
+void caml_ev_alloc(uint64_t size);
+void caml_ev_alloc_flush(void);
+void caml_ev_flush(void);
+
+#else
+
+#define CAML_EVENTLOG_DO(f) /**/
+
+#define CAML_EVENTLOG_INIT() /**/
+#define CAML_EVENTLOG_DISABLE() /**/
+#define CAML_EV_BEGIN(p) /**/
+#define CAML_EV_END(p) /**/
+#define CAML_EV_COUNTER(c, v) /**/
+#define CAML_EV_ALLOC(S) /**/
+#define CAML_EV_ALLOC_FLUSH() /**/
+#define CAML_EV_FLUSH() /**/
+
+#endif /*CAML_INSTR*/
+
+#endif /*CAML_EVENTLOG_H*/
diff --git a/runtime/caml/exec.h b/runtime/caml/exec.h
new file mode 100644
index 00000000..c8b4ab37
--- /dev/null
+++ b/runtime/caml/exec.h
@@ -0,0 +1,67 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* exec.h : format of executable bytecode files */
+
+#ifndef CAML_EXEC_H
+#define CAML_EXEC_H
+
+#ifdef CAML_INTERNALS
+
+/* Executable bytecode files are composed of a number of sections,
+   identified by 4-character names.  A table of contents at the
+   end of the file lists the section names along with their sizes,
+   in the order in which they appear in the file:
+
+   offset 0 --->  initial junk
+                  data for section 1
+                  data for section 2
+                  ...
+                  data for section N
+                  table of contents:
+                    descriptor for section 1
+                    ...
+                    descriptor for section N
+                  trailer
+ end of file --->
+*/
+
+/* Structure of t.o.c. entries
+   Numerical quantities are 32-bit unsigned integers, big endian */
+
+struct section_descriptor {
+  char name[4];                 /* Section name */
+  uint32_t len;                   /* Length of data in bytes */
+};
+
+#define EXEC_MAGIC_LENGTH 12
+
+/* Structure of the trailer. */
+
+struct exec_trailer {
+  uint32_t num_sections;               /* Number of sections */
+  char magic[EXEC_MAGIC_LENGTH];       /* The magic number */
+  struct section_descriptor * section; /* Not part of file */
+};
+
+#define TRAILER_SIZE (4+EXEC_MAGIC_LENGTH)
+
+/* Magic number for this release */
+
+#define EXEC_MAGIC "Caml1999X028"
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_EXEC_H */
diff --git a/runtime/caml/fail.h b/runtime/caml/fail.h
new file mode 100644
index 00000000..ca4d8fd4
--- /dev/null
+++ b/runtime/caml/fail.h
@@ -0,0 +1,148 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_FAIL_H
+#define CAML_FAIL_H
+
+#ifdef CAML_INTERNALS
+#include <setjmp.h>
+#endif /* CAML_INTERNALS */
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "misc.h"
+#include "mlvalues.h"
+
+#ifdef CAML_INTERNALS
+#define OUT_OF_MEMORY_EXN 0     /* "Out_of_memory" */
+#define SYS_ERROR_EXN 1         /* "Sys_error" */
+#define FAILURE_EXN 2           /* "Failure" */
+#define INVALID_EXN 3           /* "Invalid_argument" */
+#define END_OF_FILE_EXN 4       /* "End_of_file" */
+#define ZERO_DIVIDE_EXN 5       /* "Division_by_zero" */
+#define NOT_FOUND_EXN 6         /* "Not_found" */
+#define MATCH_FAILURE_EXN 7     /* "Match_failure" */
+#define STACK_OVERFLOW_EXN 8    /* "Stack_overflow" */
+#define SYS_BLOCKED_IO 9        /* "Sys_blocked_io" */
+#define ASSERT_FAILURE_EXN 10   /* "Assert_failure" */
+#define UNDEFINED_RECURSIVE_MODULE_EXN 11 /* "Undefined_recursive_module" */
+
+#ifdef POSIX_SIGNALS
+struct longjmp_buffer {
+  sigjmp_buf buf;
+};
+#elif defined(__MINGW64__) && defined(__GNUC__) && __GNUC__ >= 4
+/* MPR#7638: issues with setjmp/longjmp in Mingw64, use GCC builtins instead */
+struct longjmp_buffer {
+  intptr_t buf[5];
+};
+#define sigsetjmp(buf,save) __builtin_setjmp(buf)
+#define siglongjmp(buf,val) __builtin_longjmp(buf,val)
+#else
+struct longjmp_buffer {
+  jmp_buf buf;
+};
+#define sigsetjmp(buf,save) setjmp(buf)
+#define siglongjmp(buf,val) longjmp(buf,val)
+#endif
+
+/* Global variables moved to Caml_state in 4.10 */
+#define caml_external_raise (Caml_state_field(external_raise))
+#define caml_exn_bucket (Caml_state_field(exn_bucket))
+
+int caml_is_special_exception(value exn);
+
+value caml_raise_if_exception(value res);
+
+#endif /* CAML_INTERNALS */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+CAMLnoreturn_start
+CAMLextern void caml_raise (value bucket)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_raise_constant (value tag)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_raise_with_arg (value tag, value arg)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_raise_with_args (value tag, int nargs, value arg[])
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_raise_with_string (value tag, char const * msg)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_failwith (char const *msg)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_failwith_value (value msg)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_invalid_argument (char const *msg)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_invalid_argument_value (value msg)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_raise_out_of_memory (void)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_raise_stack_overflow (void)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_raise_sys_error (value)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_raise_end_of_file (void)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_raise_zero_divide (void)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_raise_not_found (void)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_array_bound_error (void)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_raise_sys_blocked_io (void)
+CAMLnoreturn_end;
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_FAIL_H */
diff --git a/runtime/caml/finalise.h b/runtime/caml/finalise.h
new file mode 100644
index 00000000..fbde3619
--- /dev/null
+++ b/runtime/caml/finalise.h
@@ -0,0 +1,36 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*           Damien Doligez, projet Moscova, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2000 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_FINALISE_H
+#define CAML_FINALISE_H
+
+#ifdef CAML_INTERNALS
+
+#include "roots.h"
+
+void caml_final_update_mark_phase (void);
+void caml_final_update_clean_phase (void);
+value caml_final_do_calls_exn (void);
+void caml_final_do_roots (scanning_action f);
+void caml_final_invert_finalisable_values (void);
+void caml_final_oldify_young_roots (void);
+void caml_final_empty_young (void);
+void caml_final_update_minor_roots(void);
+value caml_final_register (value f, value v);
+void caml_final_invariant_check(void);
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_FINALISE_H */
diff --git a/runtime/caml/fix_code.h b/runtime/caml/fix_code.h
new file mode 100644
index 00000000..83c393a1
--- /dev/null
+++ b/runtime/caml/fix_code.h
@@ -0,0 +1,44 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Handling of blocks of bytecode (endianness switch, threading). */
+
+#ifndef CAML_FIX_CODE_H
+#define CAML_FIX_CODE_H
+
+#ifdef CAML_INTERNALS
+
+#include "config.h"
+#include "misc.h"
+#include "mlvalues.h"
+
+extern code_t caml_start_code;
+extern asize_t caml_code_size;
+
+void caml_init_code_fragments(void);
+void caml_load_code (int fd, asize_t len);
+void caml_fixup_endianness (code_t code, asize_t len);
+void caml_set_instruction (code_t pos, opcode_t instr);
+int caml_is_instruction (opcode_t instr1, opcode_t instr2);
+
+#ifdef THREADED_CODE
+extern char ** caml_instr_table;
+extern char * caml_instr_base;
+void caml_thread_code (code_t code, asize_t len);
+#endif
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_FIX_CODE_H */
diff --git a/runtime/caml/freelist.h b/runtime/caml/freelist.h
new file mode 100644
index 00000000..17ebf5ef
--- /dev/null
+++ b/runtime/caml/freelist.h
@@ -0,0 +1,65 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*              Damien Doligez, projet Para, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Free lists of heap blocks. */
+
+#ifndef CAML_FREELIST_H
+#define CAML_FREELIST_H
+
+#ifdef CAML_INTERNALS
+
+#include "misc.h"
+#include "mlvalues.h"
+
+extern asize_t caml_fl_cur_wsz;
+
+/* See [freelist.c] for usage info on these functions. */
+extern header_t *(*caml_fl_p_allocate) (mlsize_t wo_sz);
+extern void (*caml_fl_p_init_merge) (void);
+extern header_t *(*caml_fl_p_merge_block) (value bp, char *limit);
+extern void (*caml_fl_p_add_blocks) (value bp);
+extern void (*caml_fl_p_make_free_blocks)
+  (value *p, mlsize_t size, int do_merge, int color);
+#ifdef DEBUG
+extern void (*caml_fl_p_check) (void);
+#endif
+
+Caml_inline header_t *caml_fl_allocate (mlsize_t wo_sz)
+  { return (*caml_fl_p_allocate) (wo_sz); }
+
+Caml_inline void caml_fl_init_merge (void)
+  { (*caml_fl_p_init_merge) (); }
+
+Caml_inline header_t *caml_fl_merge_block (value bp, char *limit)
+  { return (*caml_fl_p_merge_block) (bp, limit); }
+
+Caml_inline void caml_fl_add_blocks (value bp)
+  { (*caml_fl_p_add_blocks) (bp); }
+
+Caml_inline void caml_make_free_blocks
+  (value *p, mlsize_t size, int do_merge, int color)
+  { (*caml_fl_p_make_free_blocks) (p, size, do_merge, color); }
+
+extern void caml_set_allocation_policy (intnat);
+extern void caml_fl_reset_and_switch_policy (intnat);
+
+#ifdef DEBUG
+Caml_inline void caml_fl_check (void)
+  { (*caml_fl_p_check) (); }
+#endif
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_FREELIST_H */
diff --git a/runtime/caml/gc.h b/runtime/caml/gc.h
new file mode 100644
index 00000000..5276087e
--- /dev/null
+++ b/runtime/caml/gc.h
@@ -0,0 +1,79 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*              Damien Doligez, projet Para, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_GC_H
+#define CAML_GC_H
+
+
+#include "mlvalues.h"
+
+#define Caml_white (0 << 8)
+#define Caml_gray  (1 << 8)
+#define Caml_blue  (2 << 8)
+#define Caml_black (3 << 8)
+
+#define Color_hd(hd) ((color_t) ((hd) & Caml_black))
+#define Color_hp(hp) (Color_hd (Hd_hp (hp)))
+#define Color_val(val) (Color_hd (Hd_val (val)))
+
+#define Is_white_hd(hd) (Color_hd (hd) == Caml_white)
+#define Is_gray_hd(hd) (Color_hd (hd) == Caml_gray)
+#define Is_blue_hd(hd) (Color_hd (hd) == Caml_blue)
+#define Is_black_hd(hd) (Color_hd (hd) == Caml_black)
+
+#define Whitehd_hd(hd) (((hd)  & ~Caml_black)/*| Caml_white*/)
+#define Grayhd_hd(hd)  (((hd)  & ~Caml_black)  | Caml_gray)
+#define Blackhd_hd(hd) (((hd)/*& ~Caml_black*/)| Caml_black)
+#define Bluehd_hd(hd)  (((hd)  & ~Caml_black)  | Caml_blue)
+
+/* This depends on the layout of the header.  See [mlvalues.h]. */
+#define Make_header(wosize, tag, color)                                       \
+      (/*CAMLassert ((wosize) <= Max_wosize),*/                               \
+       ((header_t) (((header_t) (wosize) << 10)                               \
+                    + (color)                                                 \
+                    + (tag_t) (tag)))                                         \
+      )
+
+#ifdef WITH_PROFINFO
+#define Make_header_with_profinfo(wosize, tag, color, profinfo)               \
+      (Make_header(wosize, tag, color)                                        \
+        | ((((intnat) profinfo) & PROFINFO_MASK) << PROFINFO_SHIFT)           \
+      )
+#else
+#define Make_header_with_profinfo(wosize, tag, color, profinfo) \
+  Make_header(wosize, tag, color)
+#endif
+
+#ifdef WITH_SPACETIME
+struct ext_table;
+extern uintnat caml_spacetime_my_profinfo(struct ext_table**, uintnat);
+#define Make_header_allocated_here(wosize, tag, color)                        \
+      (Make_header_with_profinfo(wosize, tag, color,                          \
+        caml_spacetime_my_profinfo(NULL, wosize))                             \
+      )
+#else
+#define Make_header_allocated_here Make_header
+#endif
+
+#define Is_white_val(val) (Color_val(val) == Caml_white)
+#define Is_gray_val(val) (Color_val(val) == Caml_gray)
+#define Is_blue_val(val) (Color_val(val) == Caml_blue)
+#define Is_black_val(val) (Color_val(val) == Caml_black)
+
+/* For extern.c */
+#define Colornum_hd(hd) ((color_t) (((hd) >> 8) & 3))
+#define Coloredhd_hd(hd,colnum) (((hd) & ~Caml_black) | ((colnum) << 8))
+
+#endif /* CAML_GC_H */
diff --git a/runtime/caml/gc_ctrl.h b/runtime/caml/gc_ctrl.h
new file mode 100644
index 00000000..dd3be4e5
--- /dev/null
+++ b/runtime/caml/gc_ctrl.h
@@ -0,0 +1,58 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*              Damien Doligez, projet Para, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_GC_CTRL_H
+#define CAML_GC_CTRL_H
+
+#ifdef CAML_INTERNALS
+
+#include "misc.h"
+
+/* Global variables moved to Caml_state in 4.10 */
+#define caml_stat_minor_words (Caml_state_field(stat_minor_words))
+#define caml_stat_promoted_words (Caml_state_field(stat_promoted_words))
+#define caml_stat_major_words (Caml_state_field(stat_major_words))
+#define caml_stat_minor_collections (Caml_state_field(stat_minor_collections))
+#define caml_stat_major_collections (Caml_state_field(stat_major_collections))
+#define caml_stat_heap_wsz (Caml_state_field(stat_heap_wsz))
+#define caml_stat_top_heap_wsz (Caml_state_field(stat_top_heap_wsz))
+#define caml_stat_compactions (Caml_state_field(stat_compactions))
+#define caml_stat_heap_chunks (Caml_state_field(stat_heap_chunks))
+
+/*
+  minor_size: cf. minor_heap_size in gc.mli
+  major_size: Size in words of the initial major heap
+  major_incr: cf. major_heap_increment in gc.mli
+  percent_fr: cf. space_overhead in gc.mli
+  percent_m : cf. max_overhead in gc.mli
+  window    : cf. window_size in gc.mli
+  custom_maj: cf. custom_major_ratio in gc.mli
+  custom_min: cf. custom_minor_ratio in gc.mli
+  custom_sz : cf. custom_minor_max_size in gc.mli
+*/
+void caml_init_gc (uintnat minor_size, uintnat major_size, uintnat major_incr,
+                   uintnat percent_fr, uintnat percent_m, uintnat window,
+                   uintnat custom_maj, uintnat custom_min, uintnat custom_bsz);
+
+
+CAMLextern value caml_gc_stat(value v);
+
+#ifdef DEBUG
+void caml_heap_check (void);
+#endif
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_GC_CTRL_H */
diff --git a/runtime/caml/globroots.h b/runtime/caml/globroots.h
new file mode 100644
index 00000000..10fe66f5
--- /dev/null
+++ b/runtime/caml/globroots.h
@@ -0,0 +1,31 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            */
+/*                                                                        */
+/*   Copyright 2001 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Registration of global memory roots */
+
+#ifndef CAML_GLOBROOTS_H
+#define CAML_GLOBROOTS_H
+
+#ifdef CAML_INTERNALS
+
+#include "mlvalues.h"
+#include "roots.h"
+
+void caml_scan_global_roots(scanning_action f);
+void caml_scan_global_young_roots(scanning_action f);
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_GLOBROOTS_H */
diff --git a/runtime/caml/hash.h b/runtime/caml/hash.h
new file mode 100644
index 00000000..fcc7589f
--- /dev/null
+++ b/runtime/caml/hash.h
@@ -0,0 +1,39 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2011 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 functions for custom hash functions */
+
+#ifndef CAML_HASH_H
+#define CAML_HASH_H
+
+#include "mlvalues.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+CAMLextern uint32_t caml_hash_mix_uint32(uint32_t h, uint32_t d);
+CAMLextern uint32_t caml_hash_mix_intnat(uint32_t h, intnat d);
+CAMLextern uint32_t caml_hash_mix_int64(uint32_t h, int64_t d);
+CAMLextern uint32_t caml_hash_mix_double(uint32_t h, double d);
+CAMLextern uint32_t caml_hash_mix_float(uint32_t h, float d);
+CAMLextern uint32_t caml_hash_mix_string(uint32_t h, value s);
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif /* CAML_HASH_H */
diff --git a/runtime/caml/hooks.h b/runtime/caml/hooks.h
new file mode 100644
index 00000000..5877dd25
--- /dev/null
+++ b/runtime/caml/hooks.h
@@ -0,0 +1,42 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                    Fabrice Le Fessant, INRIA de Paris                  */
+/*                                                                        */
+/*   Copyright 2016 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_HOOKS_H
+#define CAML_HOOKS_H
+
+#include "misc.h"
+#include "memory.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef CAML_INTERNALS
+
+#ifdef NATIVE_CODE
+
+/* executed just before calling the entry point of a dynamically
+   loaded native code module. */
+CAMLextern void (*caml_natdynlink_hook)(void* handle, const char* unit);
+
+#endif /* NATIVE_CODE */
+
+#endif /* CAML_INTERNALS */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_HOOKS_H */
diff --git a/runtime/caml/instrtrace.h b/runtime/caml/instrtrace.h
new file mode 100644
index 00000000..17ee3ce0
--- /dev/null
+++ b/runtime/caml/instrtrace.h
@@ -0,0 +1,35 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Trace the instructions executed */
+
+#ifndef _instrtrace_
+#define _instrtrace_
+
+#ifdef CAML_INTERNALS
+
+#include "mlvalues.h"
+#include "misc.h"
+
+extern intnat caml_icount;
+void caml_stop_here (void);
+void caml_disasm_instr (code_t pc);
+void caml_trace_value_file (value v, code_t prog, asize_t proglen, FILE * f);
+void caml_trace_accu_sp_file(value accu, value * sp, code_t prog,
+                             asize_t proglen, FILE * f);
+
+#endif /* CAML_INTERNALS */
+
+#endif
diff --git a/runtime/caml/instruct.h b/runtime/caml/instruct.h
new file mode 100644
index 00000000..5c10df4f
--- /dev/null
+++ b/runtime/caml/instruct.h
@@ -0,0 +1,68 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* The instruction set. */
+
+#ifndef CAML_INSTRUCT_H
+#define CAML_INSTRUCT_H
+
+#ifdef CAML_INTERNALS
+
+enum instructions {
+  ACC0, ACC1, ACC2, ACC3, ACC4, ACC5, ACC6, ACC7,
+  ACC, PUSH,
+  PUSHACC0, PUSHACC1, PUSHACC2, PUSHACC3,
+  PUSHACC4, PUSHACC5, PUSHACC6, PUSHACC7,
+  PUSHACC, POP, ASSIGN,
+  ENVACC1, ENVACC2, ENVACC3, ENVACC4, ENVACC,
+  PUSHENVACC1, PUSHENVACC2, PUSHENVACC3, PUSHENVACC4, PUSHENVACC,
+  PUSH_RETADDR, APPLY, APPLY1, APPLY2, APPLY3,
+  APPTERM, APPTERM1, APPTERM2, APPTERM3,
+  RETURN, RESTART, GRAB,
+  CLOSURE, CLOSUREREC,
+  OFFSETCLOSUREM2, OFFSETCLOSURE0, OFFSETCLOSURE2, OFFSETCLOSURE,
+  PUSHOFFSETCLOSUREM2, PUSHOFFSETCLOSURE0,
+  PUSHOFFSETCLOSURE2, PUSHOFFSETCLOSURE,
+  GETGLOBAL, PUSHGETGLOBAL, GETGLOBALFIELD, PUSHGETGLOBALFIELD, SETGLOBAL,
+  ATOM0, ATOM, PUSHATOM0, PUSHATOM,
+  MAKEBLOCK, MAKEBLOCK1, MAKEBLOCK2, MAKEBLOCK3, MAKEFLOATBLOCK,
+  GETFIELD0, GETFIELD1, GETFIELD2, GETFIELD3, GETFIELD, GETFLOATFIELD,
+  SETFIELD0, SETFIELD1, SETFIELD2, SETFIELD3, SETFIELD, SETFLOATFIELD,
+  VECTLENGTH, GETVECTITEM, SETVECTITEM,
+  GETBYTESCHAR, SETBYTESCHAR,
+  BRANCH, BRANCHIF, BRANCHIFNOT, SWITCH, BOOLNOT,
+  PUSHTRAP, POPTRAP, RAISE,
+  CHECK_SIGNALS,
+  C_CALL1, C_CALL2, C_CALL3, C_CALL4, C_CALL5, C_CALLN,
+  CONST0, CONST1, CONST2, CONST3, CONSTINT,
+  PUSHCONST0, PUSHCONST1, PUSHCONST2, PUSHCONST3, PUSHCONSTINT,
+  NEGINT, ADDINT, SUBINT, MULINT, DIVINT, MODINT,
+  ANDINT, ORINT, XORINT, LSLINT, LSRINT, ASRINT,
+  EQ, NEQ, LTINT, LEINT, GTINT, GEINT,
+  OFFSETINT, OFFSETREF, ISINT,
+  GETMETHOD,
+  BEQ, BNEQ,  BLTINT, BLEINT, BGTINT, BGEINT,
+  ULTINT, UGEINT,
+  BULTINT, BUGEINT,
+  GETPUBMET, GETDYNMET,
+  STOP,
+  EVENT, BREAK,
+  RERAISE, RAISE_NOTRACE,
+  GETSTRINGCHAR,
+FIRST_UNIMPLEMENTED_OP};
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_INSTRUCT_H */
diff --git a/runtime/caml/interp.h b/runtime/caml/interp.h
new file mode 100644
index 00000000..d1ebdc01
--- /dev/null
+++ b/runtime/caml/interp.h
@@ -0,0 +1,37 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* The bytecode interpreter */
+
+#ifndef CAML_INTERP_H
+#define CAML_INTERP_H
+
+#ifdef CAML_INTERNALS
+
+#include "misc.h"
+#include "mlvalues.h"
+
+/* interpret a bytecode */
+value caml_interprete (code_t prog, asize_t prog_size);
+
+/* tell the runtime that a bytecode program might be needed */
+void caml_prepare_bytecode(code_t prog, asize_t prog_size);
+
+/* tell the runtime that a bytecode program is no more needed */
+void caml_release_bytecode(code_t prog, asize_t prog_size);
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_INTERP_H */
diff --git a/runtime/caml/intext.h b/runtime/caml/intext.h
new file mode 100644
index 00000000..be4b9467
--- /dev/null
+++ b/runtime/caml/intext.h
@@ -0,0 +1,195 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Structured input/output */
+
+#ifndef CAML_INTEXT_H
+#define CAML_INTEXT_H
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "misc.h"
+#include "mlvalues.h"
+
+#ifdef CAML_INTERNALS
+#include "io.h"
+
+/* Magic number */
+
+#define Intext_magic_number_small 0x8495A6BE
+#define Intext_magic_number_big 0x8495A6BF
+
+/* Header format for the "small" model: 20 bytes
+       0   "small" magic number
+       4   length of marshaled data, in bytes
+       8   number of shared blocks
+      12   size in words when read on a 32-bit platform
+      16   size in words when read on a 64-bit platform
+   The 4 numbers are 32 bits each, in big endian.
+
+   Header format for the "big" model: 32 bytes
+       0   "big" magic number
+       4   four reserved bytes, currently set to 0
+       8   length of marshaled data, in bytes
+      16   number of shared blocks
+      24   size in words when read on a 64-bit platform
+   The 3 numbers are 64 bits each, in big endian.
+*/
+
+/* Codes for the compact format */
+
+#define PREFIX_SMALL_BLOCK 0x80
+#define PREFIX_SMALL_INT 0x40
+#define PREFIX_SMALL_STRING 0x20
+#define CODE_INT8 0x0
+#define CODE_INT16 0x1
+#define CODE_INT32 0x2
+#define CODE_INT64 0x3
+#define CODE_SHARED8 0x4
+#define CODE_SHARED16 0x5
+#define CODE_SHARED32 0x6
+#define CODE_SHARED64 0x14
+#define CODE_BLOCK32 0x8
+#define CODE_BLOCK64 0x13
+#define CODE_STRING8 0x9
+#define CODE_STRING32 0xA
+#define CODE_STRING64 0x15
+#define CODE_DOUBLE_BIG 0xB
+#define CODE_DOUBLE_LITTLE 0xC
+#define CODE_DOUBLE_ARRAY8_BIG 0xD
+#define CODE_DOUBLE_ARRAY8_LITTLE 0xE
+#define CODE_DOUBLE_ARRAY32_BIG 0xF
+#define CODE_DOUBLE_ARRAY32_LITTLE 0x7
+#define CODE_DOUBLE_ARRAY64_BIG 0x16
+#define CODE_DOUBLE_ARRAY64_LITTLE 0x17
+#define CODE_CODEPOINTER 0x10
+#define CODE_INFIXPOINTER 0x11
+#define CODE_CUSTOM 0x12 /* deprecated */
+#define CODE_CUSTOM_LEN 0x18
+#define CODE_CUSTOM_FIXED 0x19
+
+#if ARCH_FLOAT_ENDIANNESS == 0x76543210
+#define CODE_DOUBLE_NATIVE CODE_DOUBLE_BIG
+#define CODE_DOUBLE_ARRAY8_NATIVE CODE_DOUBLE_ARRAY8_BIG
+#define CODE_DOUBLE_ARRAY32_NATIVE CODE_DOUBLE_ARRAY32_BIG
+#define CODE_DOUBLE_ARRAY64_NATIVE CODE_DOUBLE_ARRAY64_BIG
+#else
+#define CODE_DOUBLE_NATIVE CODE_DOUBLE_LITTLE
+#define CODE_DOUBLE_ARRAY8_NATIVE CODE_DOUBLE_ARRAY8_LITTLE
+#define CODE_DOUBLE_ARRAY32_NATIVE CODE_DOUBLE_ARRAY32_LITTLE
+#define CODE_DOUBLE_ARRAY64_NATIVE CODE_DOUBLE_ARRAY64_LITTLE
+#endif
+
+/* Size-ing data structures for extern.  Chosen so that
+   sizeof(struct trail_block) and sizeof(struct output_block)
+   are slightly below 8Kb. */
+
+#define ENTRIES_PER_TRAIL_BLOCK  1025
+#define SIZE_EXTERN_OUTPUT_BLOCK 8100
+
+/* The entry points */
+
+void caml_output_val (struct channel * chan, value v, value flags);
+  /* Output [v] with flags [flags] on the channel [chan]. */
+
+#endif /* CAML_INTERNALS */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+CAMLextern void caml_output_value_to_malloc(value v, value flags,
+                                            /*out*/ char ** buf,
+                                            /*out*/ intnat * len);
+  /* Output [v] with flags [flags] to a memory buffer allocated with
+     malloc.  On return, [*buf] points to the buffer and [*len]
+     contains the number of bytes in buffer. */
+CAMLextern intnat caml_output_value_to_block(value v, value flags,
+                                             char * data, intnat len);
+  /* Output [v] with flags [flags] to a user-provided memory buffer.
+     [data] points to the start of this buffer, and [len] is its size
+     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]. */
+
+extern value caml_input_value_to_outside_heap (value channel);
+  /* As for [caml_input_value], but the value is unmarshalled into
+     malloc blocks that are not added to the heap.  Not for the
+     casual user. */
+
+extern int caml_extern_allow_out_of_heap;
+  /* Permit the marshaller to traverse structures that look like OCaml
+     values but do not live in the OCaml heap. */
+
+extern value caml_output_value(value vchan, value v, value flags);
+#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]. */
+CAMLextern value caml_input_value_from_malloc(char * data, intnat ofs);
+  /* Read a structured value from a malloced buffer.  [data] points
+     to the beginning of the buffer, and [ofs] is the offset of the
+     beginning of the externed data in this buffer.  The buffer is
+     deallocated with [free] on return, or if an exception is raised. */
+CAMLextern value caml_input_value_from_block(char * data, intnat len);
+  /* Read a structured value from a user-provided buffer.  [data] points
+     to the beginning of the externed data in this buffer,
+     and [len] is the length in bytes of valid data in this buffer.
+     The buffer is never deallocated by this routine. */
+
+/* Functions for writing user-defined marshallers */
+
+CAMLextern void caml_serialize_int_1(int i);
+CAMLextern void caml_serialize_int_2(int i);
+CAMLextern void caml_serialize_int_4(int32_t i);
+CAMLextern void caml_serialize_int_8(int64_t i);
+CAMLextern void caml_serialize_float_4(float f);
+CAMLextern void caml_serialize_float_8(double f);
+CAMLextern void caml_serialize_block_1(void * data, intnat len);
+CAMLextern void caml_serialize_block_2(void * data, intnat len);
+CAMLextern void caml_serialize_block_4(void * data, intnat len);
+CAMLextern void caml_serialize_block_8(void * data, intnat len);
+CAMLextern void caml_serialize_block_float_8(void * data, intnat len);
+
+CAMLextern int caml_deserialize_uint_1(void);
+CAMLextern int caml_deserialize_sint_1(void);
+CAMLextern int caml_deserialize_uint_2(void);
+CAMLextern int caml_deserialize_sint_2(void);
+CAMLextern uint32_t caml_deserialize_uint_4(void);
+CAMLextern int32_t caml_deserialize_sint_4(void);
+CAMLextern uint64_t caml_deserialize_uint_8(void);
+CAMLextern int64_t caml_deserialize_sint_8(void);
+CAMLextern float caml_deserialize_float_4(void);
+CAMLextern double caml_deserialize_float_8(void);
+CAMLextern void caml_deserialize_block_1(void * data, intnat len);
+CAMLextern void caml_deserialize_block_2(void * data, intnat len);
+CAMLextern void caml_deserialize_block_4(void * data, intnat len);
+CAMLextern void caml_deserialize_block_8(void * data, intnat len);
+CAMLextern void caml_deserialize_block_float_8(void * data, intnat len);
+
+CAMLnoreturn_start
+CAMLextern void caml_deserialize_error(char * msg)
+CAMLnoreturn_end;
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_INTEXT_H */
diff --git a/runtime/caml/io.h b/runtime/caml/io.h
new file mode 100644
index 00000000..2d961f95
--- /dev/null
+++ b/runtime/caml/io.h
@@ -0,0 +1,124 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Buffered input/output */
+
+#ifndef CAML_IO_H
+#define CAML_IO_H
+
+#ifdef CAML_INTERNALS
+
+#include "misc.h"
+#include "mlvalues.h"
+
+#ifndef IO_BUFFER_SIZE
+#define IO_BUFFER_SIZE 65536
+#endif
+
+#if defined(_WIN32)
+typedef __int64 file_offset;
+#else
+#include <sys/types.h>
+typedef off_t file_offset;
+#endif
+
+struct channel {
+  int fd;                       /* Unix file descriptor */
+  file_offset offset;           /* Absolute position of fd in the file */
+  char * end;                   /* Physical end of the buffer */
+  char * curr;                  /* Current position in the buffer */
+  char * max;                   /* Logical end of the buffer (for input) */
+  void * mutex;                 /* Placeholder for mutex (for systhreads) */
+  struct channel * next, * prev;/* Double chaining of channels (flush_all) */
+  int revealed;                 /* For Cash only */
+  int old_revealed;             /* For Cash only */
+  int refcount;                 /* For flush_all and for Cash */
+  int flags;                    /* Bitfield */
+  char buff[IO_BUFFER_SIZE];    /* The buffer itself */
+  char * name;                  /* Optional name (to report fd leaks) */
+};
+
+enum {
+  CHANNEL_FLAG_FROM_SOCKET = 1,  /* For Windows */
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+  CHANNEL_FLAG_BLOCKING_WRITE = 2, /* Don't release master lock when writing */
+#endif
+  CHANNEL_FLAG_MANAGED_BY_GC = 4,  /* Free and close using GC finalization */
+};
+
+/* For an output channel:
+     [offset] is the absolute position of the beginning of the buffer [buff].
+   For an input channel:
+     [offset] is the absolute position of the logical end of the buffer, [max].
+*/
+
+/* Functions and macros that can be called from C.  Take arguments of
+   type struct channel *.  No locking is performed. */
+
+#define caml_putch(channel, ch) do{                                       \
+  if ((channel)->curr >= (channel)->end) caml_flush_partial(channel);     \
+  *((channel)->curr)++ = (ch);                                            \
+}while(0)
+
+#define caml_getch(channel)                                                 \
+  ((channel)->curr >= (channel)->max                                        \
+   ? caml_refill(channel)                                                   \
+   : (unsigned char) *((channel)->curr)++)
+
+CAMLextern struct channel * caml_open_descriptor_in (int);
+CAMLextern struct channel * caml_open_descriptor_out (int);
+CAMLextern void caml_close_channel (struct channel *);
+CAMLextern int caml_channel_binary_mode (struct channel *);
+CAMLextern value caml_alloc_channel(struct channel *chan);
+
+CAMLextern int caml_flush_partial (struct channel *);
+CAMLextern void caml_flush (struct channel *);
+CAMLextern void caml_putword (struct channel *, uint32_t);
+CAMLextern int caml_putblock (struct channel *, char *, intnat);
+CAMLextern void caml_really_putblock (struct channel *, char *, intnat);
+
+CAMLextern unsigned char caml_refill (struct channel *);
+CAMLextern uint32_t caml_getword (struct channel *);
+CAMLextern int caml_getblock (struct channel *, char *, intnat);
+CAMLextern intnat caml_really_getblock (struct channel *, char *, intnat);
+
+/* Extract a struct channel * from the heap object representing it */
+
+#define Channel(v) (*((struct channel **) (Data_custom_val(v))))
+
+/* The locking machinery */
+
+CAMLextern void (*caml_channel_mutex_free) (struct channel *);
+CAMLextern void (*caml_channel_mutex_lock) (struct channel *);
+CAMLextern void (*caml_channel_mutex_unlock) (struct channel *);
+CAMLextern void (*caml_channel_mutex_unlock_exn) (void);
+
+CAMLextern struct channel * caml_all_opened_channels;
+
+#define Lock(channel) \
+  if (caml_channel_mutex_lock != NULL) (*caml_channel_mutex_lock)(channel)
+#define Unlock(channel) \
+  if (caml_channel_mutex_unlock != NULL) (*caml_channel_mutex_unlock)(channel)
+#define Unlock_exn() \
+  if (caml_channel_mutex_unlock_exn != NULL) (*caml_channel_mutex_unlock_exn)()
+
+/* Conversion between file_offset and int64_t */
+
+#define Val_file_offset(fofs) caml_copy_int64(fofs)
+#define File_offset_val(v) ((file_offset) Int64_val(v))
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_IO_H */
diff --git a/runtime/caml/m.h.in b/runtime/caml/m.h.in
new file mode 100644
index 00000000..b5a7205b
--- /dev/null
+++ b/runtime/caml/m.h.in
@@ -0,0 +1,100 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Machine-related configuration */
+
+#undef ARCH_SIXTYFOUR
+
+/* Define ARCH_SIXTYFOUR if the processor has a natural word size of 64 bits.
+   That is, sizeof(char *) = 8.
+   Otherwise, leave ARCH_SIXTYFOUR undefined.
+   This assumes sizeof(char *) = 4. */
+
+#undef ARCH_BIG_ENDIAN
+
+/* Define ARCH_BIG_ENDIAN if the processor is big endian (the most
+   significant byte of an integer stored in memory comes first).
+   Leave ARCH_BIG_ENDIAN undefined if the processor is little-endian
+   (the least significant byte comes first).
+*/
+
+#undef ARCH_ALIGN_DOUBLE
+
+/* Define ARCH_ALIGN_DOUBLE if the processor requires doubles to be
+   doubleword-aligned. Leave ARCH_ALIGN_DOUBLE undefined if the processor
+   supports word-aligned doubles. */
+
+#undef HAS_ARCH_CODE32
+
+/* Define HAS_ARCH_CODE32 if, on a 64-bit machine, code pointers fit
+   in 32 bits, i.e. the code segment resides in the low 4G of the
+   addressing space.
+   HAS_ARCH_CODE32 is ignored on 32-bit machines. */
+
+#undef SIZEOF_INT
+#undef SIZEOF_LONG
+#undef SIZEOF_PTR
+#undef SIZEOF_SHORT
+#undef SIZEOF_LONGLONG
+
+/* Define SIZEOF_INT, SIZEOF_LONG, SIZEOF_PTR, SIZEOF_SHORT and
+   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
+   doubleword-aligned. Leave ARCH_ALIGN_INT64 undefined if the processor
+   supports word-aligned 64-bit integers.  Leave undefined if
+   64-bit integers are not supported. */
+
+#undef PROFINFO_WIDTH
+
+#undef WITH_SPACETIME
+#undef ENABLE_CALL_COUNTS
+
+#undef ASM_CFI_SUPPORTED
+
+#undef WITH_FRAME_POINTERS
+
+#undef NO_NAKED_POINTERS
+
+#undef WITH_PROFINFO
+
+#undef CAML_WITH_FPIC
+
+#undef CAML_SAFE_STRING
+
+#undef FLAT_FLOAT_ARRAY
+
+#undef FUNCTION_SECTIONS
+
+#undef SUPPORTS_ALIGNED_ATTRIBUTE
diff --git a/runtime/caml/major_gc.h b/runtime/caml/major_gc.h
new file mode 100644
index 00000000..87339757
--- /dev/null
+++ b/runtime/caml/major_gc.h
@@ -0,0 +1,98 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*              Damien Doligez, projet Para, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_MAJOR_GC_H
+#define CAML_MAJOR_GC_H
+
+#ifdef CAML_INTERNALS
+
+#include "freelist.h"
+#include "misc.h"
+
+typedef struct {
+  void *block;           /* address of the malloced block this chunk lives in */
+  asize_t alloc;         /* in bytes, used for compaction */
+  asize_t size;          /* in bytes */
+  char *next;
+} heap_chunk_head;
+
+#define Chunk_size(c) (((heap_chunk_head *) (c)) [-1]).size
+#define Chunk_alloc(c) (((heap_chunk_head *) (c)) [-1]).alloc
+#define Chunk_next(c) (((heap_chunk_head *) (c)) [-1]).next
+#define Chunk_block(c) (((heap_chunk_head *) (c)) [-1]).block
+
+extern int caml_gc_phase;
+extern int caml_gc_subphase;
+extern uintnat caml_allocated_words;
+extern double caml_extra_heap_resources;
+extern uintnat caml_dependent_size, caml_dependent_allocated;
+extern uintnat caml_fl_wsz_at_phase_change;
+
+#define Phase_mark 0
+#define Phase_clean 1
+#define Phase_sweep 2
+#define Phase_idle 3
+
+/* Subphase of mark */
+#define Subphase_mark_roots 10
+/* Subphase_mark_roots: At the end of this subphase all the global
+   roots are marked. */
+#define Subphase_mark_main 11
+/* Subphase_mark_main: At the end of this subphase all the value alive at
+   the start of this subphase and created during it are marked. */
+#define Subphase_mark_final 12
+/* Subphase_mark_final: At the start of this subphase register which
+   value with an ocaml finalizer are not marked, the associated
+   finalizer will be run later. So we mark now these values as alive,
+   since they must be available for their finalizer.
+  */
+
+CAMLextern char *caml_heap_start;
+extern uintnat total_heap_size;
+extern char *caml_gc_sweep_hp;
+
+extern int caml_major_window;
+extern double caml_major_ring[Max_major_window];
+extern int caml_major_ring_index;
+extern double caml_major_work_credit;
+extern double caml_gc_clock;
+
+/* [caml_major_gc_hook] is called just between the end of the mark
+   phase and the beginning of the sweep phase of the major GC.
+
+   This hook must not allocate, change any heap value, nor
+   call OCaml code. */
+CAMLextern void (*caml_major_gc_hook)(void);
+
+void caml_init_major_heap (asize_t);           /* size in bytes */
+asize_t caml_clip_heap_chunk_wsz (asize_t wsz);
+void caml_darken (value, value *);
+void caml_major_collection_slice (intnat);
+void major_collection (void);
+void caml_finish_major_cycle (void);
+void caml_set_major_window (int);
+
+/* Forces finalisation of all heap-allocated values,
+   disregarding both local and global roots.
+
+   Warning: finalisation is performed by means of forced sweeping, which may
+   result in pointers referencing nonexistent values; therefore the function
+   should only be used on runtime shutdown.
+*/
+void caml_finalise_heap (void);
+
+#endif /* CAML_INTERNALiS */
+
+#endif /* CAML_MAJOR_GC_H */
diff --git a/runtime/caml/md5.h b/runtime/caml/md5.h
new file mode 100644
index 00000000..e83c16cd
--- /dev/null
+++ b/runtime/caml/md5.h
@@ -0,0 +1,47 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 1999 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* MD5 message digest */
+
+#ifndef CAML_MD5_H
+#define CAML_MD5_H
+
+#ifdef CAML_INTERNALS
+
+#include "mlvalues.h"
+#include "io.h"
+
+CAMLextern value caml_md5_string (value str, value ofs, value len);
+CAMLextern value caml_md5_chan (value vchan, value len);
+CAMLextern void caml_md5_block(unsigned char digest[16],
+                               void * data, uintnat len);
+
+CAMLextern value caml_md5_channel(struct channel *chan, intnat toread);
+
+struct MD5Context {
+        uint32_t buf[4];
+        uint32_t bits[2];
+        unsigned char in[64];
+};
+
+CAMLextern void caml_MD5Init (struct MD5Context *context);
+CAMLextern void caml_MD5Update (struct MD5Context *context, unsigned char *buf,
+                                uintnat len);
+CAMLextern void caml_MD5Final (unsigned char *digest, struct MD5Context *ctx);
+CAMLextern void caml_MD5Transform (uint32_t *buf, uint32_t *in);
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_MD5_H */
diff --git a/runtime/caml/memory.h b/runtime/caml/memory.h
new file mode 100644
index 00000000..2669cfdf
--- /dev/null
+++ b/runtime/caml/memory.h
@@ -0,0 +1,620 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*              Damien Doligez, projet Para, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Allocation macros and functions */
+
+#ifndef CAML_MEMORY_H
+#define CAML_MEMORY_H
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "config.h"
+#ifdef CAML_INTERNALS
+#include "gc.h"
+#include "major_gc.h"
+#include "minor_gc.h"
+#endif /* CAML_INTERNALS */
+#include "misc.h"
+#include "mlvalues.h"
+#include "domain.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+CAMLextern value caml_alloc_shr (mlsize_t wosize, tag_t);
+#ifdef WITH_PROFINFO
+CAMLextern value caml_alloc_shr_with_profinfo (mlsize_t, tag_t, intnat);
+#else
+#define caml_alloc_shr_with_profinfo(size, tag, profinfo) \
+  caml_alloc_shr(size, tag)
+#endif /* WITH_PROFINFO */
+
+/* Variant of [caml_alloc_shr] where no memprof sampling is performed. */
+CAMLextern value caml_alloc_shr_no_track_noexc (mlsize_t, tag_t);
+
+/* Variant of [caml_alloc_shr] where no memprof sampling is performed,
+   and re-using the profinfo associated with the header given in
+   parameter. */
+CAMLextern value caml_alloc_shr_for_minor_gc (mlsize_t, tag_t, header_t);
+
+CAMLextern void caml_adjust_gc_speed (mlsize_t, mlsize_t);
+CAMLextern void caml_alloc_dependent_memory (mlsize_t bsz);
+CAMLextern void caml_free_dependent_memory (mlsize_t bsz);
+CAMLextern void caml_modify (value *, value);
+CAMLextern void caml_initialize (value *, value);
+CAMLextern value caml_check_urgent_gc (value);
+CAMLextern char *caml_alloc_for_heap (asize_t request);   /* Size in bytes. */
+CAMLextern void caml_free_for_heap (char *mem);
+CAMLextern void caml_disown_for_heap (char *mem);
+CAMLextern int caml_add_to_heap (char *mem);
+CAMLextern color_t caml_allocation_color (void *hp);
+
+CAMLextern int caml_huge_fallback_count;
+
+
+/* [caml_stat_*] functions below provide an interface to the static memory
+   manager built into the runtime, which can be used for managing static
+   (that is, non-moving) blocks of heap memory.
+
+   Function arguments that have type [caml_stat_block] must always be pointers
+   to blocks returned by the [caml_stat_*] functions below. Attempting to use
+   these functions on memory blocks allocated by a different memory manager
+   (e.g. the one from the C runtime) will cause undefined behaviour.
+*/
+typedef void* caml_stat_block;
+
+#ifdef CAML_INTERNALS
+
+/* The pool must be initialized with a call to [caml_stat_create_pool]
+   before it is possible to use any of the [caml_stat_*] functions below.
+
+   If the pool is not initialized, [caml_stat_*] functions will still work in
+   backward compatibility mode, becoming thin wrappers around [malloc] family
+   of functions. In this case, calling [caml_stat_destroy_pool] will not free
+   the claimed heap memory, resulting in leaks.
+*/
+CAMLextern void caml_stat_create_pool(void);
+
+/* [caml_stat_destroy_pool] frees all the heap memory claimed by the pool.
+
+   Once the pool is destroyed, [caml_stat_*] functions will continue to work
+   in backward compatibility mode, becoming thin wrappers around [malloc]
+   family of functions.
+*/
+CAMLextern void caml_stat_destroy_pool(void);
+
+#endif /* CAML_INTERNALS */
+
+/* [caml_stat_alloc(size)] allocates a memory block of the requested [size]
+   (in bytes) and returns a pointer to it. It throws an OCaml exception in case
+   the request fails, and so requires the runtime lock to be held.
+*/
+CAMLextern caml_stat_block caml_stat_alloc(asize_t);
+
+/* [caml_stat_alloc_noexc(size)] allocates a memory block of the requested
+   [size] (in bytes) and returns a pointer to it, or NULL in case the request
+   fails.
+*/
+CAMLextern caml_stat_block caml_stat_alloc_noexc(asize_t);
+
+/* [caml_stat_alloc_aligned(size, modulo, block*)] allocates a memory block of
+   the requested [size] (in bytes), the starting address of which is aligned to
+   the provided [modulo] value. The function returns the aligned address, as
+   well as the unaligned [block] (as an output parameter). It throws an OCaml
+   exception in case the request fails, and so requires the runtime lock.
+*/
+CAMLextern void* caml_stat_alloc_aligned(asize_t, int modulo, caml_stat_block*);
+
+/* [caml_stat_alloc_aligned_noexc] is a variant of [caml_stat_alloc_aligned]
+   that returns NULL in case the request fails, and doesn't require the runtime
+   lock to be held.
+*/
+CAMLextern void* caml_stat_alloc_aligned_noexc(asize_t, int modulo,
+                                               caml_stat_block*);
+
+/* [caml_stat_calloc_noexc(num, size)] allocates a block of memory for an array
+   of [num] elements, each of them [size] bytes long, and initializes all its
+   bits to zero, effectively allocating a zero-initialized memory block of
+   [num * size] bytes. It returns NULL in case the request fails.
+*/
+CAMLextern caml_stat_block caml_stat_calloc_noexc(asize_t, asize_t);
+
+/* [caml_stat_free(block)] deallocates the provided [block]. */
+CAMLextern void caml_stat_free(caml_stat_block);
+
+/* [caml_stat_resize(block, size)] changes the size of the provided [block] to
+   [size] bytes. The function may move the memory block to a new location (whose
+   address is returned by the function). The content of the [block] is preserved
+   up to the smaller of the new and old sizes, even if the block is moved to a
+   new location. If the new size is larger, the value of the newly allocated
+   portion is indeterminate. The function throws an OCaml exception in case the
+   request fails, and so requires the runtime lock to be held.
+*/
+CAMLextern caml_stat_block caml_stat_resize(caml_stat_block, asize_t);
+
+/* [caml_stat_resize_noexc] is a variant of [caml_stat_resize] that returns NULL
+   in case the request fails, and doesn't require the runtime lock.
+*/
+CAMLextern caml_stat_block caml_stat_resize_noexc(caml_stat_block, asize_t);
+
+
+/* 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
+   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,
+   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.
+*/
+CAMLextern caml_stat_string caml_stat_strconcat(int n, ...);
+#ifdef _WIN32
+CAMLextern wchar_t* caml_stat_wcsconcat(int n, ...);
+#endif
+
+
+/* void caml_shrink_heap (char *);        Only used in compact.c */
+
+#ifdef CAML_INTERNALS
+
+extern uintnat caml_use_huge_pages;
+
+#ifdef HAS_HUGE_PAGES
+#include <sys/mman.h>
+#define Heap_page_size HUGE_PAGE_SIZE
+#define Round_mmap_size(x)                                      \
+    (((x) + (Heap_page_size - 1)) & ~ (Heap_page_size - 1))
+#endif
+
+
+int caml_page_table_add(int kind, void * start, void * end);
+int caml_page_table_remove(int kind, void * start, void * end);
+int caml_page_table_initialize(mlsize_t bytesize);
+
+#ifdef DEBUG
+#define DEBUG_clear(result, wosize) do{ \
+  uintnat caml__DEBUG_i; \
+  for (caml__DEBUG_i = 0; caml__DEBUG_i < (wosize); ++ caml__DEBUG_i){ \
+    Field ((result), caml__DEBUG_i) = Debug_uninit_minor; \
+  } \
+}while(0)
+#else
+#define DEBUG_clear(result, wosize)
+#endif
+
+enum caml_alloc_small_flags {
+  CAML_DONT_TRACK = 0, CAML_DO_TRACK = 1,
+  CAML_FROM_C = 0,     CAML_FROM_CAML = 2
+};
+
+extern void caml_alloc_small_dispatch (intnat wosize, int flags,
+                                       int nallocs, unsigned char* alloc_lens);
+// Do not call asynchronous callbacks from allocation functions
+#define Alloc_small_origin CAML_FROM_C
+#define Alloc_small_aux(result, wosize, tag, profinfo, track) do {     \
+  CAMLassert ((wosize) >= 1);                                          \
+  CAMLassert ((tag_t) (tag) < 256);                                    \
+  CAMLassert ((wosize) <= Max_young_wosize);                           \
+  Caml_state_field(young_ptr) -= Whsize_wosize (wosize);               \
+  if (Caml_state_field(young_ptr) < Caml_state_field(young_limit)) {   \
+    Setup_for_gc;                                                      \
+    caml_alloc_small_dispatch((wosize), (track) | Alloc_small_origin,  \
+                              1, NULL);                                \
+    Restore_after_gc;                                                  \
+  }                                                                    \
+  Hd_hp (Caml_state_field(young_ptr)) =                                \
+    Make_header_with_profinfo ((wosize), (tag), 0, profinfo);          \
+  (result) = Val_hp (Caml_state_field(young_ptr));                     \
+  DEBUG_clear ((result), (wosize));                                    \
+}while(0)
+
+#define Alloc_small_with_profinfo(result, wosize, tag, profinfo) \
+  Alloc_small_aux(result, wosize, tag, profinfo, CAML_DO_TRACK)
+
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+
+extern uintnat caml_spacetime_my_profinfo(struct ext_table**, uintnat);
+
+#define Alloc_small(result, wosize, tag) \
+  Alloc_small_with_profinfo(result, wosize, tag, \
+    caml_spacetime_my_profinfo(NULL, wosize))
+#define Alloc_small_no_track(result, wosize, tag) \
+  Alloc_small_aux(result, wosize, tag, \
+    caml_spacetime_my_profinfo(NULL, wosize), CAML_DONT_TRACK)
+
+#else
+
+#define Alloc_small(result, wosize, tag) \
+  Alloc_small_with_profinfo(result, wosize, tag, (uintnat) 0)
+#define Alloc_small_no_track(result, wosize, tag) \
+  Alloc_small_aux(result, wosize, tag, (uintnat) 0, CAML_DONT_TRACK)
+
+#endif
+
+/* Deprecated alias for [caml_modify] */
+
+#define Modify(fp,val) caml_modify((fp), (val))
+
+#endif /* CAML_INTERNALS */
+
+struct caml__roots_block {
+  struct caml__roots_block *next;
+  intnat ntables;
+  intnat nitems;
+  value *tables [5];
+};
+
+/* Global variable moved to Caml_state in 4.10 */
+#define caml_local_roots (Caml_state_field(local_roots))
+
+/* The following macros are used to declare C local variables and
+   function parameters of type [value].
+
+   The function body must start with one of the [CAMLparam] macros.
+   If the function has no parameter of type [value], use [CAMLparam0].
+   If the function has 1 to 5 [value] parameters, use the corresponding
+   [CAMLparam] with the parameters as arguments.
+   If the function has more than 5 [value] parameters, use [CAMLparam5]
+   for the first 5 parameters, and one or more calls to the [CAMLxparam]
+   macros for the others.
+   If the function takes an array of [value]s as argument, use
+   [CAMLparamN] to declare it (or [CAMLxparamN] if you already have a
+   call to [CAMLparam] for some other arguments).
+
+   If you need local variables of type [value], declare them with one
+   or more calls to the [CAMLlocal] macros at the beginning of the
+   function, after the call to CAMLparam.  Use [CAMLlocalN] (at the
+   beginning of the function) to declare an array of [value]s.
+
+   Your function may raise an exception or return a [value] with the
+   [CAMLreturn] macro.  Its argument is simply the [value] returned by
+   your function.  Do NOT directly return a [value] with the [return]
+   keyword.  If your function returns void, use [CAMLreturn0]. If you
+   un-register the local roots (i.e. undo the effects of the [CAMLparam*]
+   and [CAMLlocal] macros) without returning immediately, use [CAMLdrop].
+
+   All the identifiers beginning with "caml__" are reserved by OCaml.
+   Do not use them for anything (local or global variables, struct or
+   union tags, macros, etc.)
+*/
+
+#define CAMLparam0() \
+  struct caml__roots_block *caml__frame = Caml_state_field(local_roots)
+
+#define CAMLparam1(x) \
+  CAMLparam0 (); \
+  CAMLxparam1 (x)
+
+#define CAMLparam2(x, y) \
+  CAMLparam0 (); \
+  CAMLxparam2 (x, y)
+
+#define CAMLparam3(x, y, z) \
+  CAMLparam0 (); \
+  CAMLxparam3 (x, y, z)
+
+#define CAMLparam4(x, y, z, t) \
+  CAMLparam0 (); \
+  CAMLxparam4 (x, y, z, t)
+
+#define CAMLparam5(x, y, z, t, u) \
+  CAMLparam0 (); \
+  CAMLxparam5 (x, y, z, t, u)
+
+#define CAMLparamN(x, size) \
+  CAMLparam0 (); \
+  CAMLxparamN (x, (size))
+
+/* CAMLunused is preserved for compatibility reasons.
+   Instead of the legacy GCC/Clang-only
+     CAMLunused foo;
+   you should prefer
+     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))
+  #define CAMLunused_end
+  #define CAMLunused __attribute__ ((unused))
+#elif _MSC_VER >= 1500
+  #define CAMLunused_start  __pragma( warning (push) )           \
+    __pragma( warning (disable:4189 ) )
+  #define CAMLunused_end __pragma( warning (pop))
+  #define CAMLunused
+#else
+  #define CAMLunused_start
+  #define CAMLunused_end
+  #define CAMLunused
+#endif
+
+#define CAMLxparam1(x) \
+  struct caml__roots_block caml__roots_##x; \
+  CAMLunused_start int caml__dummy_##x = ( \
+    (void) caml__frame, \
+    (caml__roots_##x.next = Caml_state_field(local_roots)), \
+    (Caml_state_field(local_roots) = &caml__roots_##x), \
+    (caml__roots_##x.nitems = 1), \
+    (caml__roots_##x.ntables = 1), \
+    (caml__roots_##x.tables [0] = &x), \
+    0) \
+   CAMLunused_end
+
+#define CAMLxparam2(x, y) \
+  struct caml__roots_block caml__roots_##x; \
+  CAMLunused_start int caml__dummy_##x = ( \
+    (void) caml__frame, \
+    (caml__roots_##x.next = Caml_state_field(local_roots)), \
+    (Caml_state_field(local_roots) = &caml__roots_##x), \
+    (caml__roots_##x.nitems = 1), \
+    (caml__roots_##x.ntables = 2), \
+    (caml__roots_##x.tables [0] = &x), \
+    (caml__roots_##x.tables [1] = &y), \
+    0) \
+   CAMLunused_end
+
+#define CAMLxparam3(x, y, z) \
+  struct caml__roots_block caml__roots_##x; \
+  CAMLunused_start int caml__dummy_##x = ( \
+    (void) caml__frame, \
+    (caml__roots_##x.next = Caml_state_field(local_roots)), \
+    (Caml_state_field(local_roots) = &caml__roots_##x), \
+    (caml__roots_##x.nitems = 1), \
+    (caml__roots_##x.ntables = 3), \
+    (caml__roots_##x.tables [0] = &x), \
+    (caml__roots_##x.tables [1] = &y), \
+    (caml__roots_##x.tables [2] = &z), \
+    0) \
+  CAMLunused_end
+
+#define CAMLxparam4(x, y, z, t) \
+  struct caml__roots_block caml__roots_##x; \
+  CAMLunused_start int caml__dummy_##x = ( \
+    (void) caml__frame, \
+    (caml__roots_##x.next = Caml_state_field(local_roots)), \
+    (Caml_state_field(local_roots) = &caml__roots_##x), \
+    (caml__roots_##x.nitems = 1), \
+    (caml__roots_##x.ntables = 4), \
+    (caml__roots_##x.tables [0] = &x), \
+    (caml__roots_##x.tables [1] = &y), \
+    (caml__roots_##x.tables [2] = &z), \
+    (caml__roots_##x.tables [3] = &t), \
+    0) \
+  CAMLunused_end
+
+#define CAMLxparam5(x, y, z, t, u) \
+  struct caml__roots_block caml__roots_##x; \
+  CAMLunused_start int caml__dummy_##x = ( \
+    (void) caml__frame, \
+    (caml__roots_##x.next = Caml_state_field(local_roots)), \
+    (Caml_state_field(local_roots) = &caml__roots_##x), \
+    (caml__roots_##x.nitems = 1), \
+    (caml__roots_##x.ntables = 5), \
+    (caml__roots_##x.tables [0] = &x), \
+    (caml__roots_##x.tables [1] = &y), \
+    (caml__roots_##x.tables [2] = &z), \
+    (caml__roots_##x.tables [3] = &t), \
+    (caml__roots_##x.tables [4] = &u), \
+    0) \
+  CAMLunused_end
+
+#define CAMLxparamN(x, size) \
+  struct caml__roots_block caml__roots_##x; \
+  CAMLunused_start int caml__dummy_##x = (     \
+    (void) caml__frame, \
+    (caml__roots_##x.next = Caml_state_field(local_roots)), \
+    (Caml_state_field(local_roots) = &caml__roots_##x), \
+    (caml__roots_##x.nitems = (size)), \
+    (caml__roots_##x.ntables = 1), \
+    (caml__roots_##x.tables[0] = &(x[0])), \
+    0) \
+  CAMLunused_end
+
+#define CAMLlocal1(x) \
+  value x = Val_unit; \
+  CAMLxparam1 (x)
+
+#define CAMLlocal2(x, y) \
+  value x = Val_unit, y = Val_unit; \
+  CAMLxparam2 (x, y)
+
+#define CAMLlocal3(x, y, z) \
+  value x = Val_unit, y = Val_unit, z = Val_unit; \
+  CAMLxparam3 (x, y, z)
+
+#define CAMLlocal4(x, y, z, t) \
+  value x = Val_unit, y = Val_unit, z = Val_unit, t = Val_unit; \
+  CAMLxparam4 (x, y, z, t)
+
+#define CAMLlocal5(x, y, z, t, u) \
+  value x = Val_unit, y = Val_unit, z = Val_unit, t = Val_unit, u = Val_unit; \
+  CAMLxparam5 (x, y, z, t, u)
+
+#define CAMLlocalN(x, size) \
+  value x [(size)]; \
+  int caml__i_##x; \
+  for (caml__i_##x = 0; caml__i_##x < size; caml__i_##x ++) { \
+    x[caml__i_##x] = Val_unit; \
+  } \
+  CAMLxparamN (x, (size))
+
+
+#define CAMLdrop Caml_state_field(local_roots) = caml__frame
+
+#define CAMLreturn0 do{ \
+  CAMLdrop; \
+  return; \
+}while (0)
+
+#define CAMLreturnT(type, result) do{ \
+  type caml__temp_result = (result); \
+  CAMLdrop; \
+  return caml__temp_result; \
+}while(0)
+
+#define CAMLreturn(result) CAMLreturnT(value, result)
+
+#define CAMLnoreturn ((void) caml__frame)
+
+
+/* convenience macro */
+#define Store_field(block, offset, val) do{ \
+  mlsize_t caml__temp_offset = (offset); \
+  value caml__temp_val = (val); \
+  caml_modify (&Field ((block), caml__temp_offset), caml__temp_val); \
+}while(0)
+
+/*
+   NOTE: [Begin_roots] and [End_roots] are superseded by [CAMLparam]*,
+   [CAMLxparam]*, [CAMLlocal]*, [CAMLreturn].
+
+   [Begin_roots] and [End_roots] are used for C variables that are GC roots.
+   It must contain all values in C local variables and function parameters
+   at the time the minor GC is called.
+   Usage:
+   After initialising your local variables to legal OCaml values, but before
+   calling allocation functions, insert [Begin_roots_n(v1, ... vn)], where
+   v1 ... vn are your variables of type [value] that you want to be updated
+   across allocations.
+   At the end, insert [End_roots()].
+
+   Note that [Begin_roots] opens a new block, and [End_roots] closes it.
+   Thus they must occur in matching pairs at the same brace nesting level.
+
+   You can use [Val_unit] as a dummy initial value for your variables.
+*/
+
+#define Begin_root Begin_roots1
+
+#define Begin_roots1(r0) { \
+  struct caml__roots_block caml__roots_block; \
+  caml__roots_block.next = Caml_state_field(local_roots); \
+  Caml_state_field(local_roots) = &caml__roots_block; \
+  caml__roots_block.nitems = 1; \
+  caml__roots_block.ntables = 1; \
+  caml__roots_block.tables[0] = &(r0);
+
+#define Begin_roots2(r0, r1) { \
+  struct caml__roots_block caml__roots_block; \
+  caml__roots_block.next = Caml_state_field(local_roots); \
+  Caml_state_field(local_roots) = &caml__roots_block; \
+  caml__roots_block.nitems = 1; \
+  caml__roots_block.ntables = 2; \
+  caml__roots_block.tables[0] = &(r0); \
+  caml__roots_block.tables[1] = &(r1);
+
+#define Begin_roots3(r0, r1, r2) { \
+  struct caml__roots_block caml__roots_block; \
+  caml__roots_block.next = Caml_state_field(local_roots); \
+  Caml_state_field(local_roots) = &caml__roots_block; \
+  caml__roots_block.nitems = 1; \
+  caml__roots_block.ntables = 3; \
+  caml__roots_block.tables[0] = &(r0); \
+  caml__roots_block.tables[1] = &(r1); \
+  caml__roots_block.tables[2] = &(r2);
+
+#define Begin_roots4(r0, r1, r2, r3) { \
+  struct caml__roots_block caml__roots_block; \
+  caml__roots_block.next = Caml_state_field(local_roots); \
+  Caml_state_field(local_roots) = &caml__roots_block; \
+  caml__roots_block.nitems = 1; \
+  caml__roots_block.ntables = 4; \
+  caml__roots_block.tables[0] = &(r0); \
+  caml__roots_block.tables[1] = &(r1); \
+  caml__roots_block.tables[2] = &(r2); \
+  caml__roots_block.tables[3] = &(r3);
+
+#define Begin_roots5(r0, r1, r2, r3, r4) { \
+  struct caml__roots_block caml__roots_block; \
+  caml__roots_block.next = Caml_state_field(local_roots); \
+  Caml_state_field(local_roots) = &caml__roots_block; \
+  caml__roots_block.nitems = 1; \
+  caml__roots_block.ntables = 5; \
+  caml__roots_block.tables[0] = &(r0); \
+  caml__roots_block.tables[1] = &(r1); \
+  caml__roots_block.tables[2] = &(r2); \
+  caml__roots_block.tables[3] = &(r3); \
+  caml__roots_block.tables[4] = &(r4);
+
+#define Begin_roots_block(table, size) { \
+  struct caml__roots_block caml__roots_block; \
+  caml__roots_block.next = Caml_state_field(local_roots); \
+  Caml_state_field(local_roots) = &caml__roots_block; \
+  caml__roots_block.nitems = (size); \
+  caml__roots_block.ntables = 1; \
+  caml__roots_block.tables[0] = (table);
+
+#define End_roots() Caml_state_field(local_roots) = caml__roots_block.next; }
+
+
+/* [caml_register_global_root] registers a global C variable as a memory root
+   for the duration of the program, or until [caml_remove_global_root] is
+   called. */
+
+CAMLextern void caml_register_global_root (value *);
+
+/* [caml_remove_global_root] removes a memory root registered on a global C
+   variable with [caml_register_global_root]. */
+
+CAMLextern void caml_remove_global_root (value *);
+
+/* [caml_register_generational_global_root] registers a global C
+   variable as a memory root for the duration of the program, or until
+   [caml_remove_generational_global_root] is called.
+   The program guarantees that the value contained in this variable
+   will not be assigned directly.  If the program needs to change
+   the value of this variable, it must do so by calling
+   [caml_modify_generational_global_root].  The [value *] pointer
+   passed to [caml_register_generational_global_root] must contain
+   a valid OCaml value before the call.
+   In return for these constraints, scanning of memory roots during
+   minor collection is made more efficient. */
+
+CAMLextern void caml_register_generational_global_root (value *);
+
+/* [caml_remove_generational_global_root] removes a memory root
+   registered on a global C variable with
+   [caml_register_generational_global_root]. */
+
+CAMLextern void caml_remove_generational_global_root (value *);
+
+/* [caml_modify_generational_global_root(r, newval)]
+   modifies the value contained in [r], storing [newval] inside.
+   In other words, the assignment [*r = newval] is performed,
+   but in a way that is compatible with the optimized scanning of
+   generational global roots.  [r] must be a global memory root
+   previously registered with [caml_register_generational_global_root]. */
+
+CAMLextern void caml_modify_generational_global_root(value *r, value newval);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_MEMORY_H */
diff --git a/runtime/caml/memprof.h b/runtime/caml/memprof.h
new file mode 100644
index 00000000..af311050
--- /dev/null
+++ b/runtime/caml/memprof.h
@@ -0,0 +1,55 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*            Jacques-Henri Jourdan, projet Gallium, INRIA Paris          */
+/*                                                                        */
+/*   Copyright 2016 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_MEMPROF_H
+#define CAML_MEMPROF_H
+
+#ifdef CAML_INTERNALS
+
+#include "config.h"
+#include "mlvalues.h"
+#include "roots.h"
+
+extern int caml_memprof_suspended;
+
+extern value caml_memprof_handle_postponed_exn(void);
+
+extern void caml_memprof_track_alloc_shr(value block);
+extern void caml_memprof_track_young(uintnat wosize, int from_caml,
+                                     int nallocs, unsigned char* alloc_lens);
+extern void caml_memprof_track_interned(header_t* block, header_t* blockend);
+
+extern void caml_memprof_renew_minor_sample(void);
+extern value* caml_memprof_young_trigger;
+
+extern void caml_memprof_oldify_young_roots(void);
+extern void caml_memprof_minor_update(void);
+extern void caml_memprof_do_roots(scanning_action f);
+extern void caml_memprof_update_clean_phase(void);
+extern void caml_memprof_invert_tracked(void);
+
+extern void caml_memprof_shutdown(void);
+
+struct caml_memprof_th_ctx {
+  int suspended, callback_running;
+};
+extern void caml_memprof_init_th_ctx(struct caml_memprof_th_ctx* ctx);
+extern void caml_memprof_stop_th_ctx(struct caml_memprof_th_ctx* ctx);
+extern void caml_memprof_save_th_ctx(struct caml_memprof_th_ctx* ctx);
+extern void caml_memprof_restore_th_ctx(const struct caml_memprof_th_ctx* ctx);
+
+#endif
+
+#endif /* CAML_MEMPROF_H */
diff --git a/runtime/caml/minor_gc.h b/runtime/caml/minor_gc.h
new file mode 100644
index 00000000..20baa8d5
--- /dev/null
+++ b/runtime/caml/minor_gc.h
@@ -0,0 +1,134 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*              Damien Doligez, projet Para, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_MINOR_GC_H
+#define CAML_MINOR_GC_H
+
+#include "address_class.h"
+#include "config.h"
+
+/* Global variables moved to Caml_state in 4.10 */
+#define caml_young_start (Caml_state_field(young_start))
+#define caml_young_end (Caml_state_field(young_end))
+#define caml_young_ptr (Caml_state_field(young_ptr))
+#define caml_young_limit (Caml_state_field(young_limit))
+#define caml_young_alloc_start (Caml_state_field(young_alloc_start))
+#define caml_young_alloc_end (Caml_state_field(young_alloc_end))
+#define caml_young_alloc_mid (Caml_state_field(young_alloc_mid))
+#define caml_young_trigger (Caml_state_field(young_trigger))
+#define caml_minor_heap_wsz (Caml_state_field(minor_heap_wsz))
+#define caml_in_minor_collection (Caml_state_field(in_minor_collection))
+#define caml_extra_heap_resources_minor \
+  (Caml_state_field(extra_heap_resources_minor))
+
+
+#define CAML_TABLE_STRUCT(t) { \
+  t *base;                     \
+  t *end;                      \
+  t *threshold;                \
+  t *ptr;                      \
+  t *limit;                    \
+  asize_t size;                \
+  asize_t reserve;             \
+}
+
+struct caml_ref_table CAML_TABLE_STRUCT(value *);
+
+struct caml_ephe_ref_elt {
+  value ephe;      /* an ephemeron in major heap */
+  mlsize_t offset; /* the offset that points in the minor heap  */
+};
+
+struct caml_ephe_ref_table CAML_TABLE_STRUCT(struct caml_ephe_ref_elt);
+
+struct caml_custom_elt {
+  value block;     /* The finalized block in the minor heap. */
+  mlsize_t mem;    /* The parameters for adjusting GC speed. */
+  mlsize_t max;
+};
+
+struct caml_custom_table CAML_TABLE_STRUCT(struct caml_custom_elt);
+/* Table of custom blocks in the minor heap that contain finalizers
+   or GC speed parameters. */
+
+extern void caml_set_minor_heap_size (asize_t); /* size in bytes */
+extern void caml_empty_minor_heap (void);
+CAMLextern void caml_gc_dispatch (void);
+CAMLextern void caml_minor_collection (void);
+CAMLextern void garbage_collection (void); /* runtime/signals_nat.c */
+extern void caml_oldify_one (value, value *);
+extern void caml_oldify_mopup (void);
+
+extern void caml_realloc_ref_table (struct caml_ref_table *);
+extern void caml_alloc_table (struct caml_ref_table *, asize_t, asize_t);
+extern void caml_realloc_ephe_ref_table (struct caml_ephe_ref_table *);
+extern void caml_alloc_ephe_table (struct caml_ephe_ref_table *,
+                                   asize_t, asize_t);
+extern void caml_realloc_custom_table (struct caml_custom_table *);
+extern void caml_alloc_custom_table (struct caml_custom_table *,
+                                     asize_t, asize_t);
+void caml_alloc_minor_tables (void);
+
+/* Asserts that a word is a valid header for a young object */
+#define CAMLassert_young_header(hd)                \
+  CAMLassert(Wosize_hd(hd) > 0 &&                  \
+             Wosize_hd(hd) <= Max_young_wosize &&  \
+             Color_hd(hd) == 0)
+
+#define Oldify(p) do{ \
+    value __oldify__v__ = *p; \
+    if (Is_block (__oldify__v__) && Is_young (__oldify__v__)){ \
+      caml_oldify_one (__oldify__v__, (p)); \
+    } \
+  }while(0)
+
+Caml_inline void add_to_ref_table (struct caml_ref_table *tbl, value *p)
+{
+  if (tbl->ptr >= tbl->limit){
+    CAMLassert (tbl->ptr == tbl->limit);
+    caml_realloc_ref_table (tbl);
+  }
+  *tbl->ptr++ = p;
+}
+
+Caml_inline void add_to_ephe_ref_table (struct caml_ephe_ref_table *tbl,
+                                          value ar, mlsize_t offset)
+{
+  struct caml_ephe_ref_elt *ephe_ref;
+  if (tbl->ptr >= tbl->limit){
+    CAMLassert (tbl->ptr == tbl->limit);
+    caml_realloc_ephe_ref_table (tbl);
+  }
+  ephe_ref = tbl->ptr++;
+  ephe_ref->ephe = ar;
+  ephe_ref->offset = offset;
+  CAMLassert(ephe_ref->offset < Wosize_val(ephe_ref->ephe));
+}
+
+Caml_inline void add_to_custom_table (struct caml_custom_table *tbl, value v,
+                                        mlsize_t mem, mlsize_t max)
+{
+  struct caml_custom_elt *elt;
+  if (tbl->ptr >= tbl->limit){
+    CAMLassert (tbl->ptr == tbl->limit);
+    caml_realloc_custom_table (tbl);
+  }
+  elt = tbl->ptr++;
+  elt->block = v;
+  elt->mem = mem;
+  elt->max = max;
+}
+
+#endif /* CAML_MINOR_GC_H */
diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h
new file mode 100644
index 00000000..fcc06660
--- /dev/null
+++ b/runtime/caml/misc.h
@@ -0,0 +1,463 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Miscellaneous macros and variables. */
+
+#ifndef CAML_MISC_H
+#define CAML_MISC_H
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "config.h"
+
+/* Standard definitions */
+
+#include <stddef.h>
+#include <stdlib.h>
+#include <stdarg.h>
+
+/* Basic types and constants */
+
+typedef size_t asize_t;
+
+#if defined(__GNUC__) || defined(__clang__)
+  /* Supported since at least GCC 3.1 */
+  #define CAMLdeprecated_typedef(name, type) \
+    typedef type name __attribute ((deprecated))
+#elif _MSC_VER >= 1310
+  /* NB deprecated("message") only supported from _MSC_VER >= 1400 */
+  #define CAMLdeprecated_typedef(name, type) \
+    typedef __declspec(deprecated) type name
+#else
+  #define CAMLdeprecated_typedef(name, type) typedef type name
+#endif
+
+#ifdef CAML_INTERNALS
+CAMLdeprecated_typedef(addr, char *);
+#endif /* CAML_INTERNALS */
+
+/* Noreturn is preserved for compatibility reasons.
+   Instead of the legacy GCC/Clang-only
+     foo Noreturn;
+   you should prefer
+     CAMLnoreturn_start foo CAMLnoreturn_end;
+   which supports both GCC/Clang and MSVC.
+
+   Note: CAMLnoreturn is a different macro defined in memory.h,
+   to be used in function bodies rather than as a prototype attribute.
+*/
+#ifdef __GNUC__
+  /* Works only in GCC 2.5 and later */
+  #define CAMLnoreturn_start
+  #define CAMLnoreturn_end __attribute__ ((noreturn))
+  #define Noreturn __attribute__ ((noreturn))
+#elif _MSC_VER >= 1500
+  #define CAMLnoreturn_start __declspec(noreturn)
+  #define CAMLnoreturn_end
+  #define Noreturn
+#else
+  #define CAMLnoreturn_start
+  #define CAMLnoreturn_end
+  #define Noreturn
+#endif
+
+
+
+/* Export control (to mark primitives and to handle Windows DLL) */
+
+#define CAMLexport
+#define CAMLprim
+#define CAMLextern extern
+
+/* Weak function definitions that can be overridden by external libs */
+/* Conservatively restricted to ELF and MacOSX platforms */
+#if defined(__GNUC__) && (defined (__ELF__) || defined(__APPLE__))
+#define CAMLweakdef __attribute__((weak))
+#else
+#define CAMLweakdef
+#endif
+
+/* Alignment is necessary for domain_state.h, since the code generated */
+/* 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 || _MSC_VER >= 1900)
+#define CAMLalign(n) alignas(n)
+#elif defined(SUPPORTS_ALIGNED_ATTRIBUTE)
+#define CAMLalign(n) __attribute__((aligned(n)))
+#elif _MSC_VER >= 1500
+#define CAMLalign(n) __declspec(align(n))
+#else
+#error "How do I align values on this platform?"
+#endif
+
+/* CAMLunused is preserved for compatibility reasons.
+   Instead of the legacy GCC/Clang-only
+     CAMLunused foo;
+   you should prefer
+     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))
+  #define CAMLunused_end
+  #define CAMLunused __attribute__ ((unused))
+#elif _MSC_VER >= 1500
+  #define CAMLunused_start  __pragma( warning (push) )           \
+    __pragma( warning (disable:4189 ) )
+  #define CAMLunused_end __pragma( warning (pop))
+  #define CAMLunused
+#else
+  #define CAMLunused_start
+  #define CAMLunused_end
+  #define CAMLunused
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* GC timing hooks. These can be assigned by the user. These hooks
+   must not allocate, change any heap value, nor call OCaml code.
+*/
+typedef void (*caml_timing_hook) (void);
+extern caml_timing_hook caml_major_slice_begin_hook, caml_major_slice_end_hook;
+extern caml_timing_hook caml_minor_gc_begin_hook, caml_minor_gc_end_hook;
+extern caml_timing_hook caml_finalise_begin_hook, caml_finalise_end_hook;
+
+#define CAML_STATIC_ASSERT_3(b, l) \
+  CAMLunused_start \
+    CAMLextern char static_assertion_failure_line_##l[(b) ? 1 : -1] \
+  CAMLunused_end
+
+#define CAML_STATIC_ASSERT_2(b, l) CAML_STATIC_ASSERT_3(b, l)
+#define CAML_STATIC_ASSERT(b) CAML_STATIC_ASSERT_2(b, __LINE__)
+
+/* Windows Unicode support (rest below - char_os is needed earlier) */
+
+#ifdef _WIN32
+typedef wchar_t char_os;
+#else
+typedef char char_os;
+#endif
+
+/* Assertions */
+
+#ifdef DEBUG
+
+#ifdef UNICODE
+/* See https://msdn.microsoft.com/ja-jp/library/b0084kay(v=vs.71).aspx
+   It's not clear why this isn't so obviously documented, as it doesn't
+   seem to have been superseded by a more sensible mechanism! */
+#define CAML_WIDEN_STRING_LITERAL2(x) L##x
+#define CAML_WIDEN_STRING_LITERAL(x) CAML_WIDEN_STRING_LITERAL2(x)
+#define __OSFILE__ CAML_WIDEN_STRING_LITERAL(__FILE__)
+#else
+#define __OSFILE__ __FILE__
+#endif
+
+#define CAMLassert(x) \
+  ((x) ? (void) 0 : caml_failed_assert ( #x , __OSFILE__, __LINE__))
+CAMLnoreturn_start
+CAMLextern void caml_failed_assert (char *, char_os *, int)
+CAMLnoreturn_end;
+#else
+#define CAMLassert(x) ((void) 0)
+#endif
+
+/* This hook is called when a fatal error occurs in the OCaml
+   runtime. It is given arguments to be passed to the [vprintf]-like
+   functions in order to synthetize the error message.
+   If it returns, the runtime calls [abort()].
+
+   If it is [NULL], the error message is printed on stderr and then
+   [abort()] is called. */
+extern void (*caml_fatal_error_hook) (char *msg, va_list args);
+
+CAMLnoreturn_start
+CAMLextern void caml_fatal_error (char *, ...)
+#ifdef __GNUC__
+  __attribute__ ((format (printf, 1, 2)))
+#endif
+CAMLnoreturn_end;
+
+/* 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].
+   If no overflow is reported, this is the exact result.
+   If overflow is reported, this is the exact result modulo 2 to the word size.
+*/
+
+Caml_inline int caml_uadd_overflow(uintnat a, uintnat b, uintnat * res)
+{
+#if __GNUC__ >= 5 || Caml_has_builtin(__builtin_add_overflow)
+  return __builtin_add_overflow(a, b, res);
+#else
+  uintnat c = a + b;
+  *res = c;
+  return c < a;
+#endif
+}
+
+Caml_inline int caml_usub_overflow(uintnat a, uintnat b, uintnat * res)
+{
+#if __GNUC__ >= 5 || Caml_has_builtin(__builtin_sub_overflow)
+  return __builtin_sub_overflow(a, b, res);
+#else
+  uintnat c = a - b;
+  *res = c;
+  return a < b;
+#endif
+}
+
+#if __GNUC__ >= 5 || Caml_has_builtin(__builtin_mul_overflow)
+Caml_inline int caml_umul_overflow(uintnat a, uintnat b, uintnat * res)
+{
+  return __builtin_mul_overflow(a, b, res);
+}
+#else
+extern int caml_umul_overflow(uintnat a, uintnat b, uintnat * res);
+#endif
+
+/* From floats.c */
+extern double caml_log1p(double);
+
+/* Windows Unicode support */
+
+#ifdef _WIN32
+
+#ifdef CAML_INTERNALS
+#define T(x) L ## x
+#endif
+
+#define access_os _waccess
+#define open_os _wopen
+#define stat_os _wstati64
+#define unlink_os _wunlink
+#define rename_os caml_win32_rename
+#define chdir_os _wchdir
+#define getcwd_os _wgetcwd
+#define system_os _wsystem
+#define rmdir_os _wrmdir
+#define putenv_os _wputenv
+#define chmod_os _wchmod
+#define execv_os _wexecv
+#define execve_os _wexecve
+#define execvp_os _wexecvp
+#define execvpe_os _wexecvpe
+#define strcmp_os wcscmp
+#define strlen_os wcslen
+#define sscanf_os swscanf
+#define strcpy_os wcscpy
+#define mktemp_os _wmktemp
+#define fopen_os _wfopen
+
+#define caml_stat_strdup_os caml_stat_wcsdup
+#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_copy_string_of_os caml_copy_string_of_utf16
+
+#else /* _WIN32 */
+
+#ifdef CAML_INTERNALS
+#define T(x) x
+#endif
+
+#define access_os access
+#define open_os open
+#define stat_os stat
+#define unlink_os unlink
+#define rename_os rename
+#define chdir_os chdir
+#define getcwd_os getcwd
+#define system_os system
+#define rmdir_os rmdir
+#define putenv_os putenv
+#define chmod_os chmod
+#define execv_os execv
+#define execve_os execve
+#define execvp_os execvp
+#define execvpe_os execvpe
+#define strcmp_os strcmp
+#define strlen_os strlen
+#define sscanf_os sscanf
+#define strcpy_os strcpy
+#define mktemp_os mktemp
+#define fopen_os fopen
+
+#define caml_stat_strdup_os caml_stat_strdup
+#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_copy_string_of_os caml_copy_string
+
+#endif /* _WIN32 */
+
+
+/* Data structures */
+
+struct ext_table {
+  int size;
+  int capacity;
+  void ** contents;
+};
+
+extern void caml_ext_table_init(struct ext_table * tbl, int init_capa);
+extern int caml_ext_table_add(struct ext_table * tbl, void * data);
+extern void caml_ext_table_remove(struct ext_table * tbl, void * data);
+extern void caml_ext_table_free(struct ext_table * tbl, int free_entries);
+extern void caml_ext_table_clear(struct ext_table * tbl, int free_entries);
+
+CAMLextern int caml_read_directory(char_os * dirname,
+                                   struct ext_table * contents);
+
+/* Deprecated aliases */
+#define caml_aligned_malloc caml_stat_alloc_aligned_noexc
+#define caml_strdup caml_stat_strdup
+#define caml_strconcat caml_stat_strconcat
+
+#ifdef CAML_INTERNALS
+
+/* GC flags and messages */
+
+extern uintnat caml_verb_gc;
+void caml_gc_message (int, char *, ...)
+#ifdef __GNUC__
+  __attribute__ ((format (printf, 2, 3)))
+#endif
+;
+
+/* Runtime warnings */
+extern uintnat caml_runtime_warnings;
+int caml_runtime_warnings_active(void);
+
+#ifdef DEBUG
+#ifdef ARCH_SIXTYFOUR
+#define Debug_tag(x) (INT64_LITERAL(0xD700D7D7D700D6D7u) \
+                      | ((uintnat) (x) << 16) \
+                      | ((uintnat) (x) << 48))
+#else
+#define Debug_tag(x) (0xD700D6D7ul | ((uintnat) (x) << 16))
+#endif /* ARCH_SIXTYFOUR */
+
+/*
+  00 -> free words in minor heap
+  01 -> fields of free list blocks in major heap
+  03 -> heap chunks deallocated by heap shrinking
+  04 -> fields deallocated by [caml_obj_truncate]
+  05 -> unused child pointers in large free blocks
+  10 -> uninitialised fields of minor objects
+  11 -> uninitialised fields of major objects
+  15 -> uninitialised words of [caml_stat_alloc_aligned] blocks
+  85 -> filler bytes of [caml_stat_alloc_aligned]
+  99 -> the magic prefix of a memory block allocated by [caml_stat_alloc]
+
+  special case (byte by byte):
+  D7 -> uninitialised words of [caml_stat_alloc] blocks
+*/
+#define Debug_free_minor     Debug_tag (0x00)
+#define Debug_free_major     Debug_tag (0x01)
+#define Debug_free_shrink    Debug_tag (0x03)
+#define Debug_free_truncate  Debug_tag (0x04)
+#define Debug_free_unused    Debug_tag (0x05)
+#define Debug_uninit_minor   Debug_tag (0x10)
+#define Debug_uninit_major   Debug_tag (0x11)
+#define Debug_uninit_align   Debug_tag (0x15)
+#define Debug_filler_align   Debug_tag (0x85)
+#define Debug_pool_magic     Debug_tag (0x99)
+
+#define Debug_uninit_stat    0xD7
+
+/* Note: the first argument is in fact a [value] but we don't have this
+   type available yet because we can't include [mlvalues.h] in this file.
+*/
+extern void caml_set_fields (intnat v, uintnat, uintnat);
+#endif /* DEBUG */
+
+
+/* snprintf emulation for Win32 */
+
+#ifdef _WIN32
+#ifndef _UCRT
+extern int caml_snprintf(char * buf, size_t size, const char * format, ...);
+#define snprintf caml_snprintf
+#endif
+
+extern int caml_snwprintf(wchar_t * buf,
+                          size_t size,
+                          const wchar_t * format, ...);
+#define snprintf_os caml_snwprintf
+#else
+#define snprintf_os snprintf
+#endif
+
+/* Macro used to deactivate thread and address sanitizers on some
+   functions. */
+#define CAMLno_tsan
+#define CAMLno_asan
+#if defined(__has_feature)
+#  if __has_feature(thread_sanitizer)
+#    undef CAMLno_tsan
+#    define CAMLno_tsan __attribute__((no_sanitize("thread")))
+#  endif
+#  if __has_feature(address_sanitizer)
+#    undef CAMLno_asan
+#    define CAMLno_asan __attribute__((no_sanitize("address")))
+#  endif
+#endif
+
+/* A table of all code fragments (main program and dynlinked modules) */
+struct code_fragment {
+  char *code_start;
+  char *code_end;
+  unsigned char digest[16];
+  char digest_computed;
+};
+
+extern struct ext_table caml_code_fragments_table;
+
+int caml_find_code_fragment(char *pc, int *index, struct code_fragment **cf);
+
+#endif /* CAML_INTERNALS */
+
+/* The [backtrace_slot] type represents values stored in
+ * [Caml_state->backtrace_buffer].  In bytecode, it is the same as a
+ * [code_t], in native code it is either a [frame_descr *] or a [debuginfo],
+ * depending on the second-lowest bit.  In any case, the lowest bit must
+ * be 0.
+ * The representation doesn't matter for code outside [backtrace_{byt,nat}.c],
+ * so it is just exposed as a [void *].
+ */
+typedef void * backtrace_slot;
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_MISC_H */
diff --git a/runtime/caml/mlvalues.h b/runtime/caml/mlvalues.h
new file mode 100644
index 00000000..487dd080
--- /dev/null
+++ b/runtime/caml/mlvalues.h
@@ -0,0 +1,386 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_MLVALUES_H
+#define CAML_MLVALUES_H
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "config.h"
+#include "misc.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* Definitions
+
+  word: Four bytes on 32 and 16 bit architectures,
+        eight bytes on 64 bit architectures.
+  long: A C integer having the same number of bytes as a word.
+  val: The ML representation of something.  A long or a block or a pointer
+       outside the heap.  If it is a block, it is the (encoded) address
+       of an object.  If it is a long, it is encoded as well.
+  block: Something allocated.  It always has a header and some
+          fields or some number of bytes (a multiple of the word size).
+  field: A word-sized val which is part of a block.
+  bp: Pointer to the first byte of a block.  (a char *)
+  op: Pointer to the first field of a block.  (a value *)
+  hp: Pointer to the header of a block.  (a char *)
+  int32_t: Four bytes on all architectures.
+  int64_t: Eight bytes on all architectures.
+
+  Remark: A block size is always a multiple of the word size, and at least
+          one word plus the header.
+
+  bosize: Size (in bytes) of the "bytes" part.
+  wosize: Size (in words) of the "fields" part.
+  bhsize: Size (in bytes) of the block with its header.
+  whsize: Size (in words) of the block with its header.
+
+  hd: A header.
+  tag: The value of the tag field of the header.
+  color: The value of the color field of the header.
+         This is for use only by the GC.
+*/
+
+typedef intnat value;
+typedef uintnat header_t;
+typedef uintnat mlsize_t;
+typedef unsigned int tag_t;             /* Actually, an unsigned char */
+typedef uintnat color_t;
+typedef uintnat mark_t;
+
+#include "domain_state.h"
+
+/* Longs vs blocks. */
+#define Is_long(x)   (((x) & 1) != 0)
+#define Is_block(x)  (((x) & 1) == 0)
+
+/* Conversion macro names are always of the form  "to_from". */
+/* Example: Val_long as in "Val from long" or "Val of long". */
+#define Val_long(x)     ((intnat) (((uintnat)(x) << 1)) + 1)
+#define Long_val(x)     ((x) >> 1)
+#define Max_long (((intnat)1 << (8 * sizeof(value) - 2)) - 1)
+#define Min_long (-((intnat)1 << (8 * sizeof(value) - 2)))
+#define Val_int(x) Val_long(x)
+#define Int_val(x) ((int) Long_val(x))
+#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)
+
+/* Structure of the header:
+
+For 16-bit and 32-bit architectures:
+     +--------+-------+-----+
+     | wosize | color | tag |
+     +--------+-------+-----+
+bits  31    10 9     8 7   0
+
+For 64-bit architectures:
+
+     +--------+-------+-----+
+     | wosize | color | tag |
+     +--------+-------+-----+
+bits  63    10 9     8 7   0
+
+For x86-64 with Spacetime profiling:
+  P = PROFINFO_WIDTH (as set by "configure", currently 26 bits, giving a
+    maximum block size of just under 4Gb)
+     +----------------+----------------+-------------+
+     | profiling info | wosize         | color | tag |
+     +----------------+----------------+-------------+
+bits  63        (64-P) (63-P)        10 9     8 7   0
+
+*/
+
+#define Tag_hd(hd) ((tag_t) ((hd) & 0xFF))
+
+#define Gen_profinfo_shift(width) (64 - (width))
+#define Gen_profinfo_mask(width) ((1ull << (width)) - 1ull)
+#define Gen_profinfo_hd(width, hd) \
+  (((mlsize_t) ((hd) >> (Gen_profinfo_shift(width)))) \
+   & (Gen_profinfo_mask(width)))
+
+#ifdef WITH_PROFINFO
+#define PROFINFO_SHIFT (Gen_profinfo_shift(PROFINFO_WIDTH))
+#define PROFINFO_MASK (Gen_profinfo_mask(PROFINFO_WIDTH))
+#define Hd_no_profinfo(hd) ((hd) & ~(PROFINFO_MASK << PROFINFO_SHIFT))
+#define Wosize_hd(hd) ((mlsize_t) ((Hd_no_profinfo(hd)) >> 10))
+#define Profinfo_hd(hd) (Gen_profinfo_hd(PROFINFO_WIDTH, hd))
+#else
+#define Wosize_hd(hd) ((mlsize_t) ((hd) >> 10))
+#endif /* WITH_PROFINFO */
+
+#define Hd_val(val) (((header_t *) (val)) [-1])        /* Also an l-value. */
+#define Hd_op(op) (Hd_val (op))                        /* Also an l-value. */
+#define Hd_bp(bp) (Hd_val (bp))                        /* Also an l-value. */
+#define Hd_hp(hp) (* ((header_t *) (hp)))              /* Also an l-value. */
+#define Hp_val(val) (((header_t *) (val)) - 1)
+#define Hp_op(op) (Hp_val (op))
+#define Hp_bp(bp) (Hp_val (bp))
+#define Val_op(op) ((value) (op))
+#define Val_hp(hp) ((value) (((header_t *) (hp)) + 1))
+#define Op_hp(hp) ((value *) Val_hp (hp))
+#define Bp_hp(hp) ((char *) Val_hp (hp))
+
+#define Num_tags (1 << 8)
+#ifdef ARCH_SIXTYFOUR
+#define Max_wosize (((intnat)1 << (54-PROFINFO_WIDTH)) - 1)
+#else
+#define Max_wosize ((1 << 22) - 1)
+#endif /* ARCH_SIXTYFOUR */
+
+#define Wosize_val(val) (Wosize_hd (Hd_val (val)))
+#define Wosize_op(op) (Wosize_val (op))
+#define Wosize_bp(bp) (Wosize_val (bp))
+#define Wosize_hp(hp) (Wosize_hd (Hd_hp (hp)))
+#define Whsize_wosize(sz) ((sz) + 1)
+#define Wosize_whsize(sz) ((sz) - 1)
+#define Wosize_bhsize(sz) ((sz) / sizeof (value) - 1)
+#define Bsize_wsize(sz) ((sz) * sizeof (value))
+#define Wsize_bsize(sz) ((sz) / sizeof (value))
+#define Bhsize_wosize(sz) (Bsize_wsize (Whsize_wosize (sz)))
+#define Bhsize_bosize(sz) ((sz) + sizeof (header_t))
+#define Bosize_val(val) (Bsize_wsize (Wosize_val (val)))
+#define Bosize_op(op) (Bosize_val (Val_op (op)))
+#define Bosize_bp(bp) (Bosize_val (Val_bp (bp)))
+#define Bosize_hd(hd) (Bsize_wsize (Wosize_hd (hd)))
+#define Whsize_hp(hp) (Whsize_wosize (Wosize_hp (hp)))
+#define Whsize_val(val) (Whsize_hp (Hp_val (val)))
+#define Whsize_bp(bp) (Whsize_val (Val_bp (bp)))
+#define Whsize_hd(hd) (Whsize_wosize (Wosize_hd (hd)))
+#define Bhsize_hp(hp) (Bsize_wsize (Whsize_hp (hp)))
+#define Bhsize_hd(hd) (Bsize_wsize (Whsize_hd (hd)))
+
+#define Profinfo_val(val) (Profinfo_hd (Hd_val (val)))
+
+#ifdef ARCH_BIG_ENDIAN
+#define Tag_val(val) (((unsigned char *) (val)) [-1])
+                                                 /* Also an l-value. */
+#define Tag_hp(hp) (((unsigned char *) (hp)) [sizeof(value)-1])
+                                                 /* Also an l-value. */
+#else
+#define Tag_val(val) (((unsigned char *) (val)) [-sizeof(value)])
+                                                 /* Also an l-value. */
+#define Tag_hp(hp) (((unsigned char *) (hp)) [0])
+                                                 /* Also an l-value. */
+#endif
+
+/* The lowest tag for blocks containing no value. */
+#define No_scan_tag 251
+
+
+/* 1- If tag < No_scan_tag : a tuple of fields.  */
+
+/* Pointer to the first field. */
+#define Op_val(x) ((value *) (x))
+/* Fields are numbered from 0. */
+#define Field(x, i) (((value *)(x)) [i])           /* Also an l-value. */
+
+typedef int32_t opcode_t;
+typedef opcode_t * code_t;
+
+/* NOTE: [Forward_tag] and [Infix_tag] must be just under
+   [No_scan_tag], with [Infix_tag] the lower one.
+   See [caml_oldify_one] in minor_gc.c for more details.
+
+   NOTE: Update stdlib/obj.ml whenever you change the tags.
+ */
+
+/* Forward_tag: forwarding pointer that the GC may silently shortcut.
+   See stdlib/lazy.ml. */
+#define Forward_tag 250
+#define Forward_val(v) Field(v, 0)
+
+/* If tag == Infix_tag : an infix header inside a closure */
+/* Infix_tag must be odd so that the infix header is scanned as an integer */
+/* Infix_tag must be 1 modulo 4 and infix headers can only occur in blocks
+   with tag Closure_tag (see compact.c). */
+
+#define Infix_tag 249
+#define Infix_offset_hd(hd) (Bosize_hd(hd))
+#define Infix_offset_val(v) Infix_offset_hd(Hd_val(v))
+
+/* Another special case: objects */
+#define Object_tag 248
+#define Class_val(val) Field((val), 0)
+#define Oid_val(val) Long_val(Field((val), 1))
+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. */
+
+/* Special case of tuples of fields: closures */
+#define Closure_tag 247
+#define Code_val(val) (((code_t *) (val)) [0])     /* Also an l-value. */
+
+/* This tag is used (with Forward_tag) to implement lazy values.
+   See major_gc.c and stdlib/lazy.ml. */
+#define Lazy_tag 246
+
+/* Another special case: variants */
+CAMLextern value caml_hash_variant(char const * tag);
+
+/* 2- If tag >= No_scan_tag : a sequence of bytes. */
+
+/* Pointer to the first byte */
+#define Bp_val(v) ((char *) (v))
+#define Val_bp(p) ((value) (p))
+/* Bytes are numbered from 0. */
+#define Byte(x, i) (((char *) (x)) [i])            /* Also an l-value. */
+#define Byte_u(x, i) (((unsigned char *) (x)) [i]) /* Also an l-value. */
+
+/* Abstract things.  Their contents is not traced by the GC; therefore they
+   must not contain any [value]. Must have odd number so that headers with
+   this tag cannot be mistaken for pointers (see caml_obj_truncate).
+*/
+#define Abstract_tag 251
+#define Data_abstract_val(v) ((void*) Op_val(v))
+
+/* Strings. */
+#define String_tag 252
+#ifdef CAML_SAFE_STRING
+#define String_val(x) ((const char *) Bp_val(x))
+#else
+#define String_val(x) ((char *) Bp_val(x))
+#endif
+#define Bytes_val(x) ((unsigned char *) Bp_val(x))
+CAMLextern mlsize_t caml_string_length (value);   /* size in bytes */
+CAMLextern int caml_string_is_c_safe (value);
+  /* true if string contains no '\0' null characters */
+
+/* Floating-point numbers. */
+#define Double_tag 253
+#define Double_wosize ((sizeof(double) / sizeof(value)))
+#ifndef ARCH_ALIGN_DOUBLE
+#define Double_val(v) (* (double *)(v))
+#define Store_double_val(v,d) (* (double *)(v) = (d))
+#else
+CAMLextern double caml_Double_val (value);
+CAMLextern void caml_Store_double_val (value,double);
+#define Double_val(v) caml_Double_val(v)
+#define Store_double_val(v,d) caml_Store_double_val(v,d)
+#endif
+
+/* Arrays of floating-point numbers. */
+#define Double_array_tag 254
+
+/* The [_flat_field] macros are for [floatarray] values and float-only records.
+*/
+#define Double_flat_field(v,i) Double_val((value)((double *)(v) + (i)))
+#define Store_double_flat_field(v,i,d) do{ \
+  mlsize_t caml__temp_i = (i); \
+  double caml__temp_d = (d); \
+  Store_double_val((value)((double *) (v) + caml__temp_i), caml__temp_d); \
+}while(0)
+
+/* The [_array_field] macros are for [float array]. */
+#ifdef FLAT_FLOAT_ARRAY
+  #define Double_array_field(v,i) Double_flat_field(v,i)
+  #define Store_double_array_field(v,i,d) Store_double_flat_field(v,i,d)
+#else
+  #define Double_array_field(v,i) Double_val (Field(v,i))
+  CAMLextern void caml_Store_double_array_field (value, mlsize_t, double);
+  #define Store_double_array_field(v,i,d) caml_Store_double_array_field (v,i,d)
+#endif
+
+/* The old [_field] macros are for backward compatibility only.
+   They work with [floatarray], float-only records, and [float array]. */
+#ifdef FLAT_FLOAT_ARRAY
+  #define Double_field(v,i) Double_flat_field(v,i)
+  #define Store_double_field(v,i,d) Store_double_flat_field(v,i,d)
+#else
+  Caml_inline double Double_field (value v, mlsize_t i) {
+    if (Tag_val (v) == Double_array_tag){
+      return Double_flat_field (v, i);
+    }else{
+      return Double_array_field (v, i);
+    }
+  }
+  Caml_inline void Store_double_field (value v, mlsize_t i, double d) {
+    if (Tag_val (v) == Double_array_tag){
+      Store_double_flat_field (v, i, d);
+    }else{
+      Store_double_array_field (v, i, d);
+    }
+  }
+#endif /* FLAT_FLOAT_ARRAY */
+
+CAMLextern mlsize_t caml_array_length (value);   /* size in items */
+CAMLextern int caml_is_double_array (value);   /* 0 is false, 1 is true */
+
+
+/* Custom blocks.  They contain a pointer to a "method suite"
+   of functions (for finalization, comparison, hashing, etc)
+   followed by raw data.  The contents of custom blocks is not traced by
+   the GC; therefore, they must not contain any [value].
+   See [custom.h] for operations on method suites. */
+#define Custom_tag 255
+#define Data_custom_val(v) ((void *) &Field((v), 1))
+struct custom_operations;       /* defined in [custom.h] */
+
+/* Int32.t, Int64.t and Nativeint.t are represented as custom blocks. */
+
+#define Int32_val(v) (*((int32_t *) Data_custom_val(v)))
+#define Nativeint_val(v) (*((intnat *) Data_custom_val(v)))
+#ifndef ARCH_ALIGN_INT64
+#define Int64_val(v) (*((int64_t *) Data_custom_val(v)))
+#else
+CAMLextern int64_t caml_Int64_val(value v);
+#define Int64_val(v) caml_Int64_val(v)
+#endif
+
+/* 3- Atoms are 0-tuples.  They are statically allocated once and for all. */
+
+CAMLextern header_t *caml_atom_table;
+#define Atom(tag) (Val_hp (&(caml_atom_table [(tag)])))
+
+/* Booleans are integers 0 or 1 */
+
+#define Val_bool(x) Val_int((x) != 0)
+#define Bool_val(x) Int_val(x)
+#define Val_false Val_int(0)
+#define Val_true Val_int(1)
+#define Val_not(x) (Val_false + Val_true - (x))
+
+/* The unit value is 0 (tagged) */
+
+#define Val_unit Val_int(0)
+
+/* List constructors */
+#define Val_emptylist Val_int(0)
+#define Tag_cons 0
+
+/* The table of global identifiers */
+
+extern value caml_global_data;
+
+CAMLextern value caml_set_oo_id(value obj);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_MLVALUES_H */
diff --git a/runtime/caml/osdeps.h b/runtime/caml/osdeps.h
new file mode 100644
index 00000000..d41779d3
--- /dev/null
+++ b/runtime/caml/osdeps.h
@@ -0,0 +1,160 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            */
+/*                                                                        */
+/*   Copyright 2001 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Operating system - specific stuff */
+
+#ifndef CAML_OSDEPS_H
+#define CAML_OSDEPS_H
+
+#ifdef _WIN32
+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"
+#include "memory.h"
+
+/* Read at most [n] bytes from file descriptor [fd] into buffer [buf].
+   [flags] indicates whether [fd] is a socket
+   (bit [CHANNEL_FLAG_FROM_SOCKET] is set in this case, see [io.h]).
+   (This distinction matters for Win32, but not for Unix.)
+   Return number of bytes read.
+   In case of error, raises [Sys_error] or [Sys_blocked_io]. */
+extern int caml_read_fd(int fd, int flags, void * buf, int n);
+
+/* Write at most [n] bytes from buffer [buf] onto file descriptor [fd].
+   [flags] indicates whether [fd] is a socket
+   (bit [CHANNEL_FLAG_FROM_SOCKET] is set in this case, see [io.h]).
+   (This distinction matters for Win32, but not for Unix.)
+   Return number of bytes written.
+   In case of error, raises [Sys_error] or [Sys_blocked_io]. */
+extern int caml_write_fd(int fd, int flags, void * buf, int n);
+
+/* Decompose the given path into a list of directories, and add them
+   to the given table. */
+extern char_os * caml_decompose_path(struct ext_table * tbl, char_os * path);
+
+/* Search the given file in the given list of directories.
+   If not found, return a copy of [name]. */
+extern char_os * caml_search_in_path(struct ext_table * path,
+                                     const char_os * name);
+
+/* Same, but search an executable name in the system path for executables. */
+CAMLextern char_os * caml_search_exe_in_path(const char_os * name);
+
+/* Same, but search a shared library in the given path. */
+extern char_os * caml_search_dll_in_path(struct ext_table * path,
+                                         const char_os * name);
+
+/* Open a shared library and return a handle on it.
+   If [for_execution] is true, perform full symbol resolution and
+   execute initialization code so that functions from the shared library
+   can be called.  If [for_execution] is false, functions from this
+   shared library will not be called, but just checked for presence,
+   so symbol resolution can be skipped.
+   If [global] is true, symbols from the shared library can be used
+   to resolve for other libraries to be opened later on.
+   Return [NULL] on error. */
+extern void * caml_dlopen(char_os * libname, int for_execution, int global);
+
+/* Close a shared library handle */
+extern void caml_dlclose(void * handle);
+
+/* Look up the given symbol in the given shared library.
+   Return [NULL] if not found, or symbol value if found. */
+extern void * caml_dlsym(void * handle, const char * name);
+
+extern void * caml_globalsym(const char * name);
+
+/* Return an error message describing the most recent dynlink failure. */
+extern char * caml_dlerror(void);
+
+/* Add to [contents] the (short) names of the files contained in
+   the directory named [dirname].  No entries are added for [.] and [..].
+   Return 0 on success, -1 on error; set errno in the case of error. */
+extern int caml_read_directory(char_os * dirname, struct ext_table * contents);
+
+/* Recover executable name if possible (/proc/sef/exe under Linux,
+   GetModuleFileName under Windows).  Return NULL on error,
+   string allocated with [caml_stat_alloc] on success. */
+extern char_os * caml_executable_name(void);
+
+/* Secure version of [getenv]: returns NULL if the process has special
+   privileges (setuid bit, setgid bit, capabilities).
+*/
+extern char_os *caml_secure_getenv(char_os const *var);
+
+/* If [fd] refers to a terminal or console, return the number of rows
+   (lines) that it displays.  Otherwise, or if the number of rows
+   cannot be determined, return -1. */
+extern int caml_num_rows_fd(int fd);
+
+#ifdef _WIN32
+
+extern int caml_win32_rename(const wchar_t *, const wchar_t *);
+
+extern void caml_probe_win32_version(void);
+extern void caml_setup_win32_terminal(void);
+extern void caml_restore_win32_terminal(void);
+
+extern wchar_t *caml_win32_getenv(wchar_t const *);
+
+/* Windows Unicode support */
+
+extern int win_multi_byte_to_wide_char(const char* s,
+                                       int slen,
+                                       wchar_t *out,
+                                       int outlen);
+extern int win_wide_char_to_multi_byte(const wchar_t* s,
+                                       int slen,
+                                       char *out,
+                                       int outlen);
+
+/* [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.
+
+   The returned string is allocated with [caml_stat_alloc], so it should be free
+   using [caml_stat_free].
+*/
+extern wchar_t* caml_stat_strdup_to_utf16(const char *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], so it should be free
+   using [caml_stat_free].
+*/
+extern char* caml_stat_strdup_of_utf16(const wchar_t *s);
+
+/* [caml_copy_string_of_utf16(s)] returns an OCaml string containing a copy of
+   [s] re-encoded in UTF-8 if [caml_windows_unicode_runtime_enabled] is non-zero
+   or in the current code page otherwise.
+*/
+extern value caml_copy_string_of_utf16(const wchar_t *s);
+
+extern int caml_win32_isatty(int fd);
+
+#endif /* _WIN32 */
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_OSDEPS_H */
diff --git a/runtime/caml/prims.h b/runtime/caml/prims.h
new file mode 100644
index 00000000..147cd98a
--- /dev/null
+++ b/runtime/caml/prims.h
@@ -0,0 +1,40 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Interface with C primitives. */
+
+#ifndef CAML_PRIMS_H
+#define CAML_PRIMS_H
+
+#ifdef CAML_INTERNALS
+
+typedef value (*c_primitive)();
+
+extern c_primitive caml_builtin_cprim[];
+extern char * caml_names_of_builtin_cprim[];
+
+extern struct ext_table caml_prim_table;
+#ifdef DEBUG
+extern struct ext_table caml_prim_name_table;
+#endif
+
+#define Primitive(n) ((c_primitive)(caml_prim_table.contents[n]))
+
+extern char * caml_section_table;
+extern asize_t caml_section_table_size;
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_PRIMS_H */
diff --git a/runtime/caml/printexc.h b/runtime/caml/printexc.h
new file mode 100644
index 00000000..92c5af53
--- /dev/null
+++ b/runtime/caml/printexc.h
@@ -0,0 +1,35 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2001 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_PRINTEXC_H
+#define CAML_PRINTEXC_H
+
+
+#include "misc.h"
+#include "mlvalues.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+CAMLextern char * caml_format_exception (value);
+CAMLnoreturn_start void caml_fatal_uncaught_exception (value) CAMLnoreturn_end;
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_PRINTEXC_H */
diff --git a/runtime/caml/reverse.h b/runtime/caml/reverse.h
new file mode 100644
index 00000000..a186078e
--- /dev/null
+++ b/runtime/caml/reverse.h
@@ -0,0 +1,92 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Swap byte-order in 16, 32, and 64-bit integers or floats */
+
+#ifndef CAML_REVERSE_H
+#define CAML_REVERSE_H
+
+#ifdef CAML_INTERNALS
+
+#define Reverse_16(dst,src) {                                               \
+  char * _p, * _q;                                                          \
+  char _a;                                                                  \
+  _p = (char *) (src);                                                      \
+  _q = (char *) (dst);                                                      \
+  _a = _p[0];                                                               \
+  _q[0] = _p[1];                                                            \
+  _q[1] = _a;                                                               \
+}
+
+#define Reverse_32(dst,src) {                                               \
+  char * _p, * _q;                                                          \
+  char _a, _b;                                                              \
+  _p = (char *) (src);                                                      \
+  _q = (char *) (dst);                                                      \
+  _a = _p[0];                                                               \
+  _b = _p[1];                                                               \
+  _q[0] = _p[3];                                                            \
+  _q[1] = _p[2];                                                            \
+  _q[3] = _a;                                                               \
+  _q[2] = _b;                                                               \
+}
+
+#define Reverse_64(dst,src) {                                               \
+  char * _p, * _q;                                                          \
+  char _a, _b;                                                              \
+  _p = (char *) (src);                                                      \
+  _q = (char *) (dst);                                                      \
+  _a = _p[0];                                                               \
+  _b = _p[1];                                                               \
+  _q[0] = _p[7];                                                            \
+  _q[1] = _p[6];                                                            \
+  _q[7] = _a;                                                               \
+  _q[6] = _b;                                                               \
+  _a = _p[2];                                                               \
+  _b = _p[3];                                                               \
+  _q[2] = _p[5];                                                            \
+  _q[3] = _p[4];                                                            \
+  _q[5] = _a;                                                               \
+  _q[4] = _b;                                                               \
+}
+
+#define Perm_index(perm,i) ((perm >> (i * 4)) & 0xF)
+
+#define Permute_64(dst,perm_dst,src,perm_src) {                             \
+  char * _p;                                                                \
+  char _a, _b, _c, _d, _e, _f, _g, _h;                                      \
+  _p = (char *) (src);                                                      \
+  _a = _p[Perm_index(perm_src, 0)];                                         \
+  _b = _p[Perm_index(perm_src, 1)];                                         \
+  _c = _p[Perm_index(perm_src, 2)];                                         \
+  _d = _p[Perm_index(perm_src, 3)];                                         \
+  _e = _p[Perm_index(perm_src, 4)];                                         \
+  _f = _p[Perm_index(perm_src, 5)];                                         \
+  _g = _p[Perm_index(perm_src, 6)];                                         \
+  _h = _p[Perm_index(perm_src, 7)];                                         \
+  _p = (char *) (dst);                                                      \
+  _p[Perm_index(perm_dst, 0)] = _a;                                         \
+  _p[Perm_index(perm_dst, 1)] = _b;                                         \
+  _p[Perm_index(perm_dst, 2)] = _c;                                         \
+  _p[Perm_index(perm_dst, 3)] = _d;                                         \
+  _p[Perm_index(perm_dst, 4)] = _e;                                         \
+  _p[Perm_index(perm_dst, 5)] = _f;                                         \
+  _p[Perm_index(perm_dst, 6)] = _g;                                         \
+  _p[Perm_index(perm_dst, 7)] = _h;                                         \
+}
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_REVERSE_H */
diff --git a/runtime/caml/roots.h b/runtime/caml/roots.h
new file mode 100644
index 00000000..755aa8a7
--- /dev/null
+++ b/runtime/caml/roots.h
@@ -0,0 +1,44 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_ROOTS_H
+#define CAML_ROOTS_H
+
+#ifdef CAML_INTERNALS
+
+#include "misc.h"
+#include "memory.h"
+
+typedef void (*scanning_action) (value, value *);
+
+void caml_oldify_local_roots (void);
+void caml_darken_all_roots_start (void);
+intnat caml_darken_all_roots_slice (intnat);
+void caml_do_roots (scanning_action, int);
+extern uintnat caml_incremental_roots_count;
+#ifndef NATIVE_CODE
+CAMLextern void caml_do_local_roots (scanning_action, value *, value *,
+                                     struct caml__roots_block *);
+#else
+CAMLextern void caml_do_local_roots(scanning_action f, char * c_bottom_of_stack,
+                                    uintnat last_retaddr, value * v_gc_regs,
+                                    struct caml__roots_block * gc_local_roots);
+#endif
+
+CAMLextern void (*caml_scan_roots_hook) (scanning_action);
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_ROOTS_H */
diff --git a/runtime/caml/s.h.in b/runtime/caml/s.h.in
new file mode 100644
index 00000000..30d2d768
--- /dev/null
+++ b/runtime/caml/s.h.in
@@ -0,0 +1,271 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Operating system and standard library configuration. */
+
+/* 0. Operating system type string. */
+
+#undef OCAML_OS_TYPE
+/* #define OCAML_OS_TYPE "Unix" */
+/* #define OCAML_OS_TYPE "Win32" */
+/* #define OCAML_OS_TYPE "MacOS" */
+
+/* 1. For the runtime system. */
+
+#undef POSIX_SIGNALS
+
+/* Define POSIX_SIGNALS if signal handling is POSIX-compliant.
+   In particular, sigaction(), sigprocmask() and the operations on
+   sigset_t are provided. */
+
+#undef BSD_SIGNALS
+
+/* Define BSD_SIGNALS if signal handlers have the BSD semantics: the handler
+   remains attached to the signal when the signal is received. Leave it
+   undefined if signal handlers have the System V semantics: the signal
+   resets the behavior to default. */
+
+#undef SUPPORT_DYNAMIC_LINKING
+
+/* Define SUPPORT_DYNAMIC_LINKING if dynamic loading of C stub code
+   via dlopen() is available. */
+
+#undef HAS_C99_FLOAT_OPS
+
+/* Define HAS_C99_FLOAT_OPS if <math.h> conforms to ISO C99.
+   In particular, it should provide expm1(), log1p(), hypot(), copysign(). */
+
+#undef HAS_WORKING_FMA
+
+/* Define HAS_WORKING_FMA if the fma function is correctly implemented. The
+   newlib library (intentionally) just has return x * y + z. */
+
+#undef HAS_GETRUSAGE
+
+#undef HAS_TIMES
+
+#undef HAS_SECURE_GETENV
+
+#undef HAS___SECURE_GETENV
+
+#undef HAS_ISSETUGID
+
+/* 2. For the Unix library. */
+
+#undef HAS_SOCKETS
+
+/* Define HAS_SOCKETS if you have BSD sockets. */
+
+#undef HAS_SOCKLEN_T
+
+/* Define HAS_SOCKLEN_T if the type socklen_t is defined in
+   /usr/include/sys/socket.h. */
+
+#undef HAS_INET_ATON
+
+#undef HAS_IPV6
+
+#undef HAS_STDINT_H
+
+#undef HAS_UNISTD
+
+/* Define HAS_UNISTD if you have /usr/include/unistd.h. */
+
+#undef HAS_DIRENT
+
+/* Define HAS_DIRENT if you have /usr/include/dirent.h and the result of
+   readdir() is of type struct dirent *.
+   Otherwise, we'll load /usr/include/sys/dir.h, and readdir() is expected to
+   return a struct direct *. */
+
+#undef HAS_REWINDDIR
+
+/* Define HAS_REWINDDIR if you have rewinddir(). */
+
+#undef HAS_LOCKF
+
+/* Define HAS_LOCKF if the library provides the lockf() function. */
+
+#undef HAS_MKFIFO
+
+/* Define HAS_MKFIFO if the library provides the mkfifo() function. */
+
+#undef HAS_GETCWD
+
+/* Define HAS_GETCWD if the library provides the getcwd() function. */
+
+#undef HAS_UTIME
+#undef HAS_UTIMES
+
+/* Define HAS_UTIME if you have /usr/include/utime.h and the library
+   provides utime(). Define HAS_UTIMES if the library provides utimes(). */
+
+#undef HAS_FCHMOD
+
+/* Define HAS_FCHMOD if you have fchmod() and fchown(). */
+
+#undef HAS_TRUNCATE
+
+/* Define HAS_TRUNCATE if you have truncate() and
+   ftruncate(). */
+
+#undef HAS_SELECT
+
+/* Define HAS_SELECT if you have select(). */
+
+#undef HAS_SYS_SELECT_H
+
+/* Define HAS_SYS_SELECT_H if /usr/include/sys/select.h exists
+   and should be included before using select(). */
+
+#undef HAS_NANOSLEEP
+/* Define HAS_NANOSLEEP if you have nanosleep(). */
+
+#undef HAS_SYMLINK
+
+/* Define HAS_SYMLINK if you have symlink() and readlink() and lstat(). */
+
+#undef HAS_WAIT4
+#undef HAS_WAITPID
+
+/* Define HAS_WAIT4 if you have wait4().
+   Define HAS_WAITPID if you have waitpid(). */
+
+#undef HAS_GETGROUPS
+
+/* Define HAS_GETGROUPS if you have getgroups(). */
+
+#undef HAS_SETGROUPS
+
+/* Define HAS_SETGROUPS if you have setgroups(). */
+
+#undef HAS_INITGROUPS
+
+/* Define HAS_INITGROUPS if you have initgroups(). */
+
+#undef HAS_TERMIOS
+
+/* Define HAS_TERMIOS if you have /usr/include/termios.h and it is
+   Posix-compliant. */
+
+#undef HAS_SETITIMER
+
+/* Define HAS_SETITIMER if you have setitimer(). */
+
+#undef HAS_GETHOSTNAME
+
+/* Define HAS_GETHOSTNAME if you have gethostname(). */
+
+#undef HAS_UNAME
+
+/* Define HAS_UNAME if you have uname(). */
+
+#undef HAS_GETTIMEOFDAY
+
+/* Define HAS_GETTIMEOFDAY if you have gettimeofday(). */
+
+#undef HAS_MKTIME
+
+/* Define HAS_MKTIME if you have mktime(). */
+
+#undef HAS_SETSID
+
+/* Define HAS_SETSID if you have setsid(). */
+
+#undef HAS_PUTENV
+
+/* Define HAS_PUTENV if you have putenv(). */
+
+#undef HAS_SETENV_UNSETENV
+
+/* Define HAS_SETENV_UNSETENV if you have setenv() and unsetenv(). */
+
+#undef HAS_LOCALE_H
+
+/* Define HAS_LOCALE_H if you have the include file <locale.h> and the
+   uselocale() function. */
+
+#undef HAS_XLOCALE_H
+
+/* Define HAS_XLOCALE_H if you have the include file <xlocale.h> and the
+   uselocale() function. */
+
+#undef HAS_STRTOD_L
+
+/* Define HAS_STRTOD_L if you have strtod_l */
+
+#undef HAS_MMAP
+
+/* Define HAS_MMAP if you have the include file <sys/mman.h> and the
+   functions mmap() and munmap(). */
+
+#undef HAS_PWRITE
+
+#undef HAS_NANOSECOND_STAT
+
+#undef HAS_GETHOSTBYNAME_R
+
+/* Define HAS_GETHOSTBYNAME_R if gethostbyname_r() is available.
+   The value of this symbol is the number of arguments of
+   gethostbyname_r(): either 5 or 6 depending on prototype.
+   (5 is the Solaris version, 6 is the Linux version). */
+
+#undef HAS_GETHOSTBYADDR_R 8
+
+/* Define HAS_GETHOSTBYADDR_R if gethostbyname_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). */
+
+#undef HAS_MKSTEMP
+
+#undef HAS_NICE
+
+/* Define HAS_NICE if you have nice(). */
+
+#undef HAS_DUP3
+
+#undef HAS_PIPE2
+
+#undef HAS_ACCEPT4
+
+#undef HAS_GETAUXVAL
+
+#undef HAS_SYS_SHM_H
+
+#undef HAS_EXECVPE
+
+#undef HAS_FFS
+#undef HAS_BITSCANFORWARD
+
+#undef HAS_STACK_OVERFLOW_DETECTION
+
+#undef HAS_SIGWAIT
+
+#undef HAS_LIBBFD
+
+#undef HAS_HUGE_PAGES
+
+#undef HUGE_PAGE_SIZE
+
+#undef HAS_LIBUNWIND
+
+#undef HAS_BROKEN_PRINTF
+
+#undef HAS_STRERROR
+
+#undef HAS_POSIX_MONOTONIC_CLOCK
+
+#undef HAS_MACH_ABSOLUTE_TIME
diff --git a/runtime/caml/signals.h b/runtime/caml/signals.h
new file mode 100644
index 00000000..7ec1ad3b
--- /dev/null
+++ b/runtime/caml/signals.h
@@ -0,0 +1,99 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_SIGNALS_H
+#define CAML_SIGNALS_H
+
+#if defined(CAML_INTERNALS) && defined(POSIX_SIGNALS)
+#include<signal.h>
+#endif
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "misc.h"
+#include "mlvalues.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+CAMLextern void caml_enter_blocking_section (void);
+CAMLextern void caml_leave_blocking_section (void);
+
+CAMLextern void caml_process_pending_actions (void);
+/* Checks for pending actions and executes them. This includes pending
+   minor and major collections, signal handlers, finalisers, and
+   Memprof callbacks. Assumes that the runtime lock is held. Can raise
+   exceptions asynchronously into OCaml code. */
+
+CAMLextern value caml_process_pending_actions_exn (void);
+/* Same as [caml_process_pending_actions], but returns the exception
+   if any (otherwise returns [Val_unit]). */
+
+#ifdef CAML_INTERNALS
+CAMLextern intnat volatile caml_pending_signals[];
+
+/* When an action is pending, either [caml_something_to_do] is 1, or
+   there is a function currently running which will end by either
+   executing all actions, or set [caml_something_to_do] back to 1. We
+   set it to 0 when starting executing all callbacks.
+
+   In the case there are two different callbacks (say, a signal and a
+   finaliser) arriving at the same time, then the processing of one
+   awaits the return of the other. In case of long-running callbacks,
+   we may want to run the second one without waiting the end of the
+   first one. We do this by provoking an additional polling every
+   minor collection and every major slice. To guarantee a low latency
+   for signals, we avoid delaying signal handlers in that case by
+   calling them first.
+
+   FIXME: We could get into caml_process_pending_actions when
+   caml_something_to_do is seen as set but not caml_pending_signals,
+   making us miss the signal.
+*/
+CAMLextern int volatile caml_something_to_do;
+
+/* Global variables moved to Caml_state in 4.10 */
+#define caml_requested_major_slice (Caml_state_field(requested_major_slice))
+#define caml_requested_minor_gc (Caml_state_field(requested_minor_gc))
+
+void caml_update_young_limit(void);
+void caml_request_major_slice (void);
+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, int in_signal_handler);
+void caml_record_signal(int signal_number);
+value caml_process_pending_signals_exn(void);
+void caml_set_action_pending (void);
+value caml_do_pending_actions_exn (void);
+value caml_process_pending_actions_with_root (value extra_root); // raises
+int caml_set_signal_action(int signo, int action);
+void caml_setup_stack_overflow_detection(void);
+
+CAMLextern void (*caml_enter_blocking_section_hook)(void);
+CAMLextern void (*caml_leave_blocking_section_hook)(void);
+CAMLextern int (*caml_try_leave_blocking_section_hook)(void);
+#ifdef POSIX_SIGNALS
+CAMLextern int (*caml_sigmask_hook)(int, const sigset_t *, sigset_t *);
+#endif
+#endif /* CAML_INTERNALS */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_SIGNALS_H */
diff --git a/runtime/caml/signals_machdep.h b/runtime/caml/signals_machdep.h
new file mode 100644
index 00000000..ef4e5bbd
--- /dev/null
+++ b/runtime/caml/signals_machdep.h
@@ -0,0 +1,74 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Processor-specific operation: atomic "read and clear" */
+
+#ifndef CAML_SIGNALS_MACHDEP_H
+#define CAML_SIGNALS_MACHDEP_H
+
+#ifdef CAML_INTERNALS
+
+#if defined(__GNUC__) && defined(__ATOMIC_SEQ_CST) \
+    && defined(__GCC_ATOMIC_LONG_LOCK_FREE)
+
+/* Use the "atomic" builtins of GCC and Clang */
+#define Read_and_clear(dst,src) \
+  ((dst) = __atomic_exchange_n(&(src), 0, __ATOMIC_SEQ_CST))
+
+#elif defined(__GNUC__) && (defined(__i386__) || (defined(__x86_64__) \
+      && defined(__ILP32__)))
+
+#define Read_and_clear(dst,src) \
+  asm("xorl %0, %0; xchgl %0, %1" \
+      : "=r" (dst), "=m" (src) \
+      : "m" (src))
+
+#elif defined(__GNUC__) && defined(__x86_64__)
+
+#define Read_and_clear(dst,src) \
+  asm("xorq %0, %0; xchgq %0, %1" \
+      : "=r" (dst), "=m" (src) \
+      : "m" (src))
+
+#elif defined(__GNUC__) && defined(__ppc__)
+
+#define Read_and_clear(dst,src) \
+  asm("0: lwarx %0, 0, %1\n\t" \
+      "stwcx. %2, 0, %1\n\t" \
+      "bne- 0b" \
+      : "=&r" (dst) \
+      : "r" (&(src)), "r" (0) \
+      : "cr0", "memory")
+
+#elif defined(__GNUC__) && defined(__ppc64__)
+
+#define Read_and_clear(dst,src) \
+  asm("0: ldarx %0, 0, %1\n\t" \
+      "stdcx. %2, 0, %1\n\t" \
+      "bne- 0b" \
+      : "=&r" (dst) \
+      : "r" (&(src)), "r" (0) \
+      : "cr0", "memory")
+
+#else
+
+/* Default, non-atomic implementation */
+#define Read_and_clear(dst,src) ((dst) = (src), (src) = 0)
+
+#endif
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_SIGNALS_MACHDEP_H */
diff --git a/runtime/caml/spacetime.h b/runtime/caml/spacetime.h
new file mode 100644
index 00000000..5bcc9232
--- /dev/null
+++ b/runtime/caml/spacetime.h
@@ -0,0 +1,203 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*            Mark Shinwell and Leo White, Jane Street Europe             */
+/*                                                                        */
+/*   Copyright 2013--2016, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_SPACETIME_H
+#define CAML_SPACETIME_H
+
+#include "io.h"
+#include "misc.h"
+#include "stack.h"
+
+/* Runtime support for Spacetime profiling.
+ * This header file is not intended for the casual user.
+ *
+ * The implementation is split into three files:
+ *   1. spacetime.c: core management of the instrumentation;
+ *   2. spacetime_snapshot.c: the taking of heap snapshots;
+ *   3. spacetime_offline.c: functions that are also used when examining
+ *      saved profiling data.
+ */
+
+typedef enum {
+  CALL,
+  ALLOCATION
+} c_node_type;
+
+/* All pointers between nodes point at the word immediately after the
+   GC headers, and everything is traversable using the normal OCaml rules.
+
+   On entry to an OCaml function:
+   If the node hole pointer register has the bottom bit set, then the function
+   is being tail called or called from a self-recursive call site:
+   - If the node hole is empty, the callee must create a new node and link
+     it into the tail chain.  The node hole pointer will point at the tail
+     chain.
+   - Otherwise the node should be used as normal.
+   Otherwise (not a tail call):
+   - If the node hole is empty, the callee must create a new node, but the
+     tail chain is untouched.
+   - Otherwise the node should be used as normal.
+*/
+
+/* Classification of nodes (OCaml or C) with corresponding GC tags. */
+#define OCaml_node_tag 0
+#define C_node_tag 1
+#define Is_ocaml_node(node) (Is_block(node) && Tag_val(node) == OCaml_node_tag)
+#define Is_c_node(node) (Is_block(node) && Tag_val(node) == C_node_tag)
+
+/* The header words are:
+   1. The node program counter.
+   2. The tail link. */
+#define Node_num_header_words 2
+
+/* The "node program counter" at the start of an OCaml node. */
+#define Node_pc(node) (Field(node, 0))
+#define Encode_node_pc(pc) (((value) pc) | 1)
+#define Decode_node_pc(encoded_pc) ((void*) (encoded_pc & ~1))
+
+/* The circular linked list of tail-called functions within OCaml nodes. */
+#define Tail_link(node) (Field(node, 1))
+
+/* The convention for pointers from OCaml nodes to other nodes.  There are
+   two special cases:
+   1. [Val_unit] means "uninitialized", and further, that this is not a
+      tail call point.  (Tail call points are pre-initialized, as in case 2.)
+   2. If the bottom bit is set, and the value is not [Val_unit], this is a
+      tail call point. */
+#define Encode_tail_caller_node(node) ((node) | 1)
+#define Decode_tail_caller_node(node) ((node) & ~1)
+#define Is_tail_caller_node_encoded(node) (((node) & 1) == 1)
+
+/* Allocation points within OCaml nodes.
+   The "profinfo" value looks exactly like a black Infix_tag header.
+   This enables us to point just after it and return such pointer as a valid
+   OCaml value.  (Used for the list of all allocation points.  We could do
+   without this and instead just encode the list pointers as integers, but
+   this would mean that the structure was destroyed on marshalling.  This
+   might not be a great problem since it is intended that the total counts
+   be obtained via snapshots, but it seems neater and easier to use
+   Infix_tag.
+   The "count" is just an OCaml integer giving the total number of words
+   (including headers) allocated at the point.
+   The "pointer to next allocation point" points to the "count" word of the
+   next allocation point in the linked list of all allocation points.
+   There is no special encoding needed by virtue of the [Infix_tag] trick. */
+#define Alloc_point_profinfo(node, offset) (Field(node, offset))
+#define Alloc_point_count(node, offset) (Field(node, offset + 1))
+#define Alloc_point_next_ptr(node, offset) (Field(node, offset + 2))
+
+/* Direct call points (tail or non-tail) within OCaml nodes.
+   They hold a pointer to the child node and (if the compiler was so
+   configured) a call count.
+   The call site and callee are both recorded in the shape. */
+#define Direct_callee_node(node,offset) (Field(node, offset))
+#define Direct_call_count(node,offset) (Field(node, offset + 1))
+#define Encode_call_point_pc(pc) (((value) pc) | 1)
+#define Decode_call_point_pc(pc) ((void*) (((value) pc) & ~((uintnat) 1)))
+
+/* Indirect call points (tail or non-tail) within OCaml nodes.
+   They hold a linked list of (PC upon entry to the callee, pointer to
+   child node) pairs.  The linked list is encoded using C nodes and should
+   be thought of as part of the OCaml node itself. */
+#define Indirect_num_fields 1
+#define Indirect_pc_linked_list(node,offset) (Field(node, offset))
+
+/* Encodings of the program counter value within a C node. */
+#define Encode_c_node_pc_for_call(pc) ((((value) pc) << 2) | 3)
+#define Encode_c_node_pc_for_alloc_point(pc) ((((value) pc) << 2) | 1)
+#define Decode_c_node_pc(pc) ((void*) (((uintnat) (pc)) >> 2))
+
+typedef struct {
+  /* The layout and encoding of this structure must match that of the
+     allocation points within OCaml nodes, so that the linked list
+     traversal across all allocation points works correctly. */
+  value profinfo;  /* encoded using [Infix_tag] (see above) */
+  value count;
+  /* [next] is [Val_unit] for the end of the list.
+     Otherwise it points at the second word of this [allocation_point]
+     structure. */
+  value next;
+} allocation_point;
+
+typedef struct {
+  value callee_node;
+  value call_count;
+} call_point;
+
+typedef struct {
+  /* CR-soon mshinwell: delete [gc_header], all the offset arithmetic will
+     then go away */
+  uintnat gc_header;
+  uintnat pc;           /* see above for encodings */
+  union {
+    call_point call;  /* for CALL */
+    allocation_point allocation;  /* for ALLOCATION */
+  } data;
+  value next;           /* [Val_unit] for the end of the list */
+} c_node; /* CR-soon mshinwell: rename to dynamic_node */
+
+typedef struct shape_table {
+  uint64_t* table;
+  struct shape_table* next;
+} shape_table;
+
+extern uint64_t** caml_spacetime_static_shape_tables;
+extern shape_table* caml_spacetime_dynamic_shape_tables;
+
+typedef struct ext_table* spacetime_unwind_info_cache;
+
+extern value caml_spacetime_trie_root;
+extern value* caml_spacetime_trie_node_ptr;
+extern value* caml_spacetime_finaliser_trie_root;
+
+extern allocation_point* caml_all_allocation_points;
+
+extern void caml_spacetime_initialize(void);
+extern uintnat caml_spacetime_my_profinfo(
+  spacetime_unwind_info_cache*, uintnat);
+extern c_node_type caml_spacetime_classify_c_node(c_node* node);
+extern c_node* caml_spacetime_c_node_of_stored_pointer(value);
+extern c_node* caml_spacetime_c_node_of_stored_pointer_not_null(value);
+extern value caml_spacetime_stored_pointer_of_c_node(c_node* node);
+extern void caml_spacetime_register_thread(value*, value*);
+extern void caml_spacetime_register_shapes(void*);
+extern value caml_spacetime_frame_table(void);
+extern value caml_spacetime_shape_table(void);
+extern void caml_spacetime_save_snapshot (struct channel *chan,
+                                          double time_override,
+                                          int use_time_override);
+extern value caml_spacetime_timestamp(double time_override,
+                                      int use_time_override);
+extern void caml_spacetime_automatic_snapshot (void);
+
+/* For use in runtime functions that are executed from OCaml
+   code, to save the overhead of using libunwind every time. */
+#ifdef WITH_SPACETIME
+#define Get_my_profinfo_with_cached_backtrace(profinfo, size) \
+  do { \
+    static spacetime_unwind_info_cache spacetime_unwind_info = NULL; \
+    profinfo = caml_spacetime_my_profinfo(&spacetime_unwind_info, size); \
+  } \
+  while (0);
+#else
+#define Get_my_profinfo_with_cached_backtrace(profinfo, size) \
+  profinfo = (uintnat) 0;
+#endif
+
+#else
+
+#define Get_my_profinfo_with_cached_backtrace(profinfo, size)   \
+  profinfo = (uintnat) 0;
+
+#endif
diff --git a/runtime/caml/stack.h b/runtime/caml/stack.h
new file mode 100644
index 00000000..6b7df0e6
--- /dev/null
+++ b/runtime/caml/stack.h
@@ -0,0 +1,150 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Machine-dependent interface with the asm code */
+
+#ifndef CAML_STACK_H
+#define CAML_STACK_H
+
+#ifdef CAML_INTERNALS
+
+/* Macros to access the stack frame */
+
+#ifdef TARGET_i386
+#define Saved_return_address(sp) *((intnat *)((sp) - 4))
+#ifndef SYS_win32
+#define Callback_link(sp) ((struct caml_context *)((sp) + 16))
+#else
+#define Callback_link(sp) ((struct caml_context *)((sp) + 8))
+#endif
+#endif
+
+#ifdef TARGET_power
+#if defined(MODEL_ppc)
+#define Saved_return_address(sp) *((intnat *)((sp) - 4))
+#define Callback_link(sp) ((struct caml_context *)((sp) + 16))
+#elif defined(MODEL_ppc64)
+#define Saved_return_address(sp) *((intnat *)((sp) + 16))
+#define Callback_link(sp) ((struct caml_context *)((sp) + (48 + 32)))
+#elif defined(MODEL_ppc64le)
+#define Saved_return_address(sp) *((intnat *)((sp) + 16))
+#define Callback_link(sp) ((struct caml_context *)((sp) + (32 + 32)))
+#else
+#error "TARGET_power: wrong MODEL"
+#endif
+#define Already_scanned(sp, retaddr) ((retaddr) & 1)
+#define Mask_already_scanned(retaddr) ((retaddr) & ~1)
+#define Mark_scanned(sp, retaddr) Saved_return_address(sp) = (retaddr) | 1
+#endif
+
+#ifdef TARGET_s390x
+#define Saved_return_address(sp) *((intnat *)((sp) - SIZEOF_PTR))
+#define Trap_frame_size 16
+#define Callback_link(sp) ((struct caml_context *)((sp) + Trap_frame_size))
+#endif
+
+#ifdef TARGET_arm
+#define Saved_return_address(sp) *((intnat *)((sp) - 4))
+#define Callback_link(sp) ((struct caml_context *)((sp) + 8))
+#endif
+
+#ifdef TARGET_amd64
+#define Saved_return_address(sp) *((intnat *)((sp) - 8))
+#define Callback_link(sp) ((struct caml_context *)((sp) + 16))
+#endif
+
+#ifdef TARGET_arm64
+#define Saved_return_address(sp) *((intnat *)((sp) - 8))
+#define Callback_link(sp) ((struct caml_context *)((sp) + 16))
+#endif
+
+#ifdef TARGET_riscv
+#define Saved_return_address(sp) *((intnat *)((sp) - 8))
+#define Callback_link(sp) ((struct caml_context *)((sp) + 16))
+#endif
+
+/* Structure of OCaml callback contexts */
+
+struct caml_context {
+  char * bottom_of_stack;       /* beginning of OCaml stack chunk */
+  uintnat last_retaddr;         /* last return address in OCaml code */
+  value * gc_regs;              /* pointer to register block */
+#ifdef WITH_SPACETIME
+  void* trie_node;
+#endif
+};
+
+/* Structure of frame descriptors */
+
+typedef struct {
+  uintnat retaddr;
+  unsigned short frame_size;
+  unsigned short num_live;
+  unsigned short live_ofs[1 /* num_live */];
+  /*
+    If frame_size & 2, then allocation info follows:
+  unsigned char num_allocs;
+  unsigned char alloc_lengths[num_alloc];
+
+    If frame_size & 1, then debug info follows:
+  uint32_t debug_info_offset[num_debug];
+
+    Debug info is stored as relative offsets to debuginfo structures.
+    num_debug is num_alloc if frame_size & 2, otherwise 1. */
+} frame_descr;
+
+/* Allocation lengths are encoded as 0-255, giving sizes 1-256 */
+#define Wosize_encoded_alloc_len(n) ((uintnat)(n) + 1)
+
+/* 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))
+
+
+/* Hash table of frame descriptors */
+
+extern frame_descr ** caml_frame_descriptors;
+extern uintnat caml_frame_descriptors_mask;
+
+#define Hash_retaddr(addr) \
+  (((uintnat)(addr) >> 3) & caml_frame_descriptors_mask)
+
+extern void caml_init_frame_descriptors(void);
+extern void caml_register_frametable(intnat *);
+extern void caml_unregister_frametable(intnat *);
+extern void caml_register_dyn_global(void *);
+
+extern uintnat caml_stack_usage (void);
+extern uintnat (*caml_stack_usage_hook)(void);
+
+/* Declaration of variables used in the asm code */
+extern value * caml_globals[];
+extern char caml_globals_map[];
+extern intnat caml_globals_inited;
+extern intnat * caml_frametable[];
+
+/* Global variables moved to Caml_state in 4.10 */
+#define caml_top_of_stack (Caml_state_field(top_of_stack))
+#define caml_bottom_of_stack (Caml_state_field(bottom_of_stack))
+#define caml_last_return_address (Caml_state_field(last_return_address))
+#define caml_gc_regs (Caml_state_field(gc_regs))
+#define caml_exception_pointer (Caml_state_field(exception_pointer))
+
+CAMLextern frame_descr * caml_next_frame_descriptor(uintnat * pc, char ** sp);
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_STACK_H */
diff --git a/runtime/caml/stacks.h b/runtime/caml/stacks.h
new file mode 100644
index 00000000..8cbb02a8
--- /dev/null
+++ b/runtime/caml/stacks.h
@@ -0,0 +1,47 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* structure of the stacks */
+
+#ifndef CAML_STACKS_H
+#define CAML_STACKS_H
+
+#ifdef CAML_INTERNALS
+
+#include "misc.h"
+#include "mlvalues.h"
+#include "memory.h"
+
+/* Global variables moved to Caml_state in 4.10 */
+#define caml_stack_low (Caml_state_field(stack_low))
+#define caml_stack_high (Caml_state_field(stack_high))
+#define caml_stack_threshold (Caml_state_field(stack_threshold))
+#define caml_extern_sp (Caml_state_field(extern_sp))
+#define caml_trapsp (Caml_state_field(trapsp))
+#define caml_trap_barrier (Caml_state_field(trap_barrier))
+
+#define Trap_pc(tp) (((code_t *)(tp))[0])
+#define Trap_link(tp) (((value **)(tp))[1])
+
+void caml_init_stack (uintnat init_max_size);
+void caml_realloc_stack (asize_t required_size);
+void caml_change_max_stack_size (uintnat new_max_size);
+uintnat caml_stack_usage (void);
+
+CAMLextern uintnat (*caml_stack_usage_hook)(void);
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_STACKS_H */
diff --git a/runtime/caml/startup.h b/runtime/caml/startup.h
new file mode 100644
index 00000000..abbcd596
--- /dev/null
+++ b/runtime/caml/startup.h
@@ -0,0 +1,60 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2001 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_STARTUP_H
+#define CAML_STARTUP_H
+
+#ifdef CAML_INTERNALS
+
+#include "mlvalues.h"
+#include "exec.h"
+
+CAMLextern void caml_main(char_os **argv);
+
+CAMLextern void caml_startup_code(
+           code_t code, asize_t code_size,
+           char *data, asize_t data_size,
+           char *section_table, asize_t section_table_size,
+           int pooling,
+           char_os **argv);
+
+CAMLextern value caml_startup_code_exn(
+  code_t code, asize_t code_size,
+  char *data, asize_t data_size,
+  char *section_table, asize_t section_table_size,
+  int pooling,
+  char_os **argv);
+
+enum { FILE_NOT_FOUND = -1, BAD_BYTECODE = -2, WRONG_MAGIC = -3 };
+
+extern int caml_attempt_open(char_os **name, struct exec_trailer *trail,
+                             int do_open_script);
+extern void caml_read_section_descriptors(int fd, struct exec_trailer *trail);
+extern int32_t caml_seek_optional_section(int fd, struct exec_trailer *trail,
+                                        char *name);
+extern int32_t caml_seek_section(int fd, struct exec_trailer *trail,
+                                 char *name);
+
+enum caml_byte_program_mode
+  {
+   STANDARD /* normal bytecode program requiring "ocamlrun" */,
+   COMPLETE_EXE /* embeding the vm, i.e. compiled with --output-complete-exe */
+  };
+
+extern enum caml_byte_program_mode caml_byte_program_mode;
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_STARTUP_H */
diff --git a/runtime/caml/startup_aux.h b/runtime/caml/startup_aux.h
new file mode 100644
index 00000000..77ced69f
--- /dev/null
+++ b/runtime/caml/startup_aux.h
@@ -0,0 +1,50 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                  Damien Doligez, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_STARTUP_AUX_H
+#define CAML_STARTUP_AUX_H
+
+#ifdef CAML_INTERNALS
+
+#include "config.h"
+
+extern void caml_init_locale(void);
+extern void caml_free_locale(void);
+
+extern void caml_init_atom_table (void);
+
+extern uintnat caml_init_percent_free;
+extern uintnat caml_init_max_percent_free;
+extern uintnat caml_init_minor_heap_wsz;
+extern uintnat caml_init_heap_chunk_sz;
+extern uintnat caml_init_heap_wsz;
+extern uintnat caml_init_max_stack_wsz;
+extern uintnat caml_init_major_window;
+extern uintnat caml_init_custom_major_ratio;
+extern uintnat caml_init_custom_minor_ratio;
+extern uintnat caml_init_custom_minor_max_bsz;
+extern uintnat caml_trace_level;
+extern int caml_cleanup_on_exit;
+
+extern void caml_parse_ocamlrunparam (void);
+
+/* Common entry point to caml_startup.
+   Returns 0 if the runtime is already initialized.
+   If [pooling] is 0, [caml_stat_*] functions will not be backed by a pool. */
+extern int caml_startup_aux (int pooling);
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_STARTUP_AUX_H */
diff --git a/runtime/caml/sys.h b/runtime/caml/sys.h
new file mode 100644
index 00000000..39e24c57
--- /dev/null
+++ b/runtime/caml/sys.h
@@ -0,0 +1,55 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef CAML_SYS_H
+#define CAML_SYS_H
+
+#ifdef CAML_INTERNALS
+
+#include "misc.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define NO_ARG Val_int(0)
+
+CAMLnoreturn_start
+CAMLextern void caml_sys_error (value)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+CAMLextern void caml_sys_io_error (value)
+CAMLnoreturn_end;
+
+CAMLextern double caml_sys_time_unboxed(value);
+CAMLextern void caml_sys_init (char_os * exe_name, char_os ** argv);
+
+CAMLnoreturn_start
+CAMLextern value caml_sys_exit (value)
+CAMLnoreturn_end;
+
+extern double caml_sys_time_unboxed(value);
+CAMLextern value caml_sys_get_argv(value unit);
+
+extern char_os * caml_exe_name;
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_SYS_H */
diff --git a/runtime/caml/ui.h b/runtime/caml/ui.h
new file mode 100644
index 00000000..3047ba7f
--- /dev/null
+++ b/runtime/caml/ui.h
@@ -0,0 +1,32 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Damien Doligez, projet Para, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Function declarations for non-Unix user interfaces */
+
+#ifndef CAML_UI_H
+#define CAML_UI_H
+
+#ifdef CAML_INTERNALS
+
+#include "config.h"
+
+void ui_exit (int return_code);
+int ui_read (int file_desc, char *buf, unsigned int length);
+int ui_write (int file_desc, char *buf, unsigned int length);
+void ui_print_stderr (char *format, void *arg);
+
+#endif /* CAML_INTERNALS */
+
+#endif /* CAML_UI_H */
diff --git a/runtime/caml/weak.h b/runtime/caml/weak.h
new file mode 100644
index 00000000..a8f36ab1
--- /dev/null
+++ b/runtime/caml/weak.h
@@ -0,0 +1,231 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Damien Doligez, projet Para, INRIA Rocquencourt            */
+/*                                                                        */
+/*   Copyright 1997 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Operations on weak arrays */
+
+#ifndef CAML_WEAK_H
+#define CAML_WEAK_H
+
+#include "mlvalues.h"
+#include "memory.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/** The requirements of the functions must be satisfied, it is
+    unspecified what happens if they are not. The debugging runtime
+    could check some of them. */
+
+CAMLextern value caml_ephemeron_create(mlsize_t len);
+/** Create an ephemeron with the given number of keys.
+    This function allocates.
+ */
+
+CAMLextern mlsize_t caml_ephemeron_num_keys(value eph);
+/** Return the number of key in the ephemeron. The valid key offset goes
+    from [0] to the predecessor of the returned value. */
+
+CAMLextern int caml_ephemeron_key_is_set(value eph, mlsize_t offset);
+/** Return 1 if the key in the ephemeron at the given offset is set.
+    Otherwise 0. The value [eph] must be an ephemeron and [offset] a
+    valid key offset.
+*/
+
+CAMLextern void caml_ephemeron_set_key(value eph, mlsize_t offset, value k);
+/** Set the key of the given ephemeron [eph] at the given offset
+    [offset] to the given value [k]. The value [eph] must be an
+    ephemeron, [offset] a valid key offset and [k] a block.
+*/
+
+CAMLextern void caml_ephemeron_unset_key(value eph, mlsize_t offset);
+/** Unset the key of the given ephemeron at the given offset. The
+    value [eph] must be an ephemeron and [offset] a valid key offset.
+*/
+
+CAMLextern int caml_ephemeron_get_key(value eph, mlsize_t offset, value *key);
+/** Return 1 if the key in the ephemeron at the given offset is set.
+    Otherwise 0. When returning 1, set [*key] to the pointed value.
+
+    The value [eph] must be an ephemeron and [offset] a valid key
+    offset.
+*/
+
+CAMLextern int caml_ephemeron_get_key_copy(value eph, mlsize_t offset,
+                                           value *key);
+/** Return 1 if the key in the ephemeron at the given offset is set.
+    Otherwise 0. When returning 1, set [*key] to a shallow copy of the
+    key. This function allocates.
+
+    The value [eph] must be an ephemeron and [offset] a valid key
+    offset.
+*/
+
+CAMLextern void caml_ephemeron_blit_key(value eph1, mlsize_t off1,
+                                        value eph2, mlsize_t off2,
+                                        mlsize_t len);
+/** Fill the given range of keys of [eph2] with the given range of
+    keys of [eph1]. Contrary to using caml_ephemeron_get_key followed
+    by caml_ephemeron_set_key or caml_ephemeron_unset_key, this
+    function does not prevent the incremental GC from erasing the
+    value in its current cycle. The value [eph1] (resp. [eph2]) must
+    be an ephemeron and the offsets between [off1] and [off1+len]
+    (resp. between [off2] and [off2+offset]) must be valid keys of
+    [eph1] (resp. [eph2]).
+*/
+
+CAMLextern int caml_ephemeron_data_is_set(value eph);
+/** Return 1 if the data in the ephemeron is set.
+    Otherwise 0. The value [eph] must be an ephemeron.
+*/
+
+CAMLextern void caml_ephemeron_set_data(value eph, value k);
+/** Set the data of the given ephemeron [eph] to the given value
+    [k]. The value [eph] must be an ephemeron and [k] a block.
+*/
+
+CAMLextern void caml_ephemeron_unset_data(value eph);
+/** Unset the data of the given ephemeron. The value [eph] must be an
+    ephemeron.
+*/
+
+CAMLextern int caml_ephemeron_get_data(value eph, value *data);
+/** Return 1 if the data in the ephemeron at the given offset is set.
+    Otherwise 0. When returning 1, set [*data] to the pointed value.
+
+    The value [eph] must be an ephemeron and [offset] a valid key
+    offset.
+*/
+
+CAMLextern int caml_ephemeron_get_data_copy(value eph, value *data);
+/** Return 1 if the data in the ephemeron at the given offset is set.
+    Otherwise 0. When returning 1, set [*data] to a shallow copy of
+    the data. This function allocates.
+
+    The value [eph] must be an ephemeron and [offset] a valid key
+    offset.
+*/
+
+CAMLextern void caml_ephemeron_blit_data(value eph1, value eph2);
+/** Sets the data of [eph2] to be the same as the data of [eph1].
+    Contrary to using caml_ephemeron_get_data followed by
+    caml_ephemeron_set_data or caml_ephemeron_unset_data, this
+    function does not prevent the incremental GC from erasing the
+    value in its current cycle. The values [eph1] and [eph2] must be
+    ephemerons.
+*/
+
+
+#define caml_weak_array_length caml_ephemeron_num_keys
+#define caml_weak_array_create caml_ephemeron_create
+#define caml_weak_array_check caml_ephemeron_key_is_set
+#define caml_weak_array_unset caml_ephemeron_unset_key
+#define caml_weak_array_set caml_ephemeron_set_key
+#define caml_weak_array_get caml_ephemeron_get_key
+#define caml_weak_array_get_copy caml_ephemeron_get_key_copy
+#define caml_weak_array_blit caml_ephemeron_blit_key
+
+#ifdef CAML_INTERNALS
+
+extern value caml_ephe_list_head;
+extern value caml_ephe_none;
+
+
+/** The first field 0:  weak list;
+       second field 1:  data;
+       others       2..:  keys;
+
+    A weak pointer is an ephemeron with the data at caml_ephe_none
+    If fields are added, don't forget to update weak.ml, [additional_values],
+    and obj.ml, [Ephemeron.additional_values].
+
+
+ */
+
+#define CAML_EPHE_LINK_OFFSET 0
+#define CAML_EPHE_DATA_OFFSET 1
+#define CAML_EPHE_FIRST_KEY 2
+#define CAML_EPHE_MAX_WOSIZE (Max_wosize - CAML_EPHE_FIRST_KEY)
+
+/* In the header, in order to let major_gc.c
+   and weak.c see the body of the function */
+Caml_inline void caml_ephe_clean_partial (value v,
+                                            mlsize_t offset_start,
+                                            mlsize_t offset_end) {
+  value child;
+  int release_data = 0;
+  mlsize_t i;
+  CAMLassert(caml_gc_phase == Phase_clean);
+  CAMLassert(2 <= offset_start
+             && offset_start <= offset_end
+             && offset_end <= Wosize_hd (Hd_val(v)));
+
+  for (i = offset_start; i < offset_end; i++){
+    child = Field (v, i);
+  ephemeron_again:
+    if (child != caml_ephe_none
+        && Is_block (child) && Is_in_heap_or_young (child)){
+      if (Tag_val (child) == Forward_tag){
+        value f = Forward_val (child);
+        if (Is_block (f)) {
+          if (!Is_in_value_area(f) || Tag_val (f) == Forward_tag
+              || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag){
+            /* Do not short-circuit the pointer. */
+          }else{
+            Field (v, i) = child = f;
+            if (Is_block (f) && Is_young (f))
+              add_to_ephe_ref_table(Caml_state_field(ephe_ref_table), v, i);
+            goto ephemeron_again;
+          }
+        }
+      }
+      if (Is_white_val (child) && !Is_young (child)){
+        release_data = 1;
+        Field (v, i) = caml_ephe_none;
+      }
+    }
+  }
+
+  child = Field (v, 1);
+  if(child != caml_ephe_none){
+    if (release_data){
+        Field (v, 1) = caml_ephe_none;
+      } else {
+        /* If we scanned all the keys and the data field remains filled,
+           then the mark phase must have marked it */
+        CAMLassert( !(offset_start == 2 && offset_end == Wosize_hd (Hd_val(v))
+                      && Is_block (child) && Is_in_heap (child)
+                      && Is_white_val (child)));
+      }
+  }
+}
+
+Caml_inline void caml_ephe_clean (value v) {
+  mlsize_t size;
+  header_t hd;
+  hd = Hd_val (v);
+  size = Wosize_hd (hd);
+
+  caml_ephe_clean_partial(v, 2, size);
+}
+
+
+#endif /* CAML_INTERNALS */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_WEAK_H */
diff --git a/runtime/clambda_checks.c b/runtime/clambda_checks.c
new file mode 100644
index 00000000..b2b33d14
--- /dev/null
+++ b/runtime/clambda_checks.c
@@ -0,0 +1,88 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                       Pierre Chambart, OCamlPro                        */
+/*                   Mark Shinwell, Jane Street Europe                    */
+/*                                                                        */
+/*   Copyright 2013--2016 OCamlPro SAS                                    */
+/*   Copyright 2014--2016 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Runtime checks to try to catch errors in code generation.
+   See flambda_to_clambda.ml for more information. */
+
+#include <stdio.h>
+
+#include "caml/mlvalues.h"
+
+value caml_check_value_is_closure(value v, value v_descr)
+{
+  const char* descr = String_val(v_descr);
+  value orig_v = v;
+
+  if (v == (value) 0) {
+    fprintf(stderr, "NULL is not a closure: %s\n",
+      descr);
+    abort();
+  }
+  if (!Is_block(v)) {
+    fprintf(stderr,
+      "Expecting a closure, got a non-boxed value %p: %s\n",
+      (void*) v, descr);
+    abort();
+  }
+  if (!(Tag_val(v) == Closure_tag || Tag_val(v) == Infix_tag)) {
+    fprintf(stderr,
+      "Expecting a closure, got a boxed value with tag %i: %s\n",
+      Tag_val(v), descr);
+    abort();
+  }
+  if (Tag_val(v) == Infix_tag) {
+    v -= Infix_offset_val(v);
+    CAMLassert(Tag_val(v) == Closure_tag);
+  }
+  CAMLassert(Wosize_val(v) >= 2);
+
+  return orig_v;
+}
+
+value caml_check_field_access(value v, value pos, value v_descr)
+{
+  const char* descr = String_val(v_descr);
+  value orig_v = v;
+  if (v == (value) 0) {
+    fprintf(stderr,
+      "Access to field %" ARCH_INT64_PRINTF_FORMAT
+      "u of NULL: %s\n", (ARCH_UINT64_TYPE) Long_val(pos), descr);
+    abort();
+  }
+  if (!Is_block(v)) {
+    fprintf(stderr,
+      "Access to field %" ARCH_INT64_PRINTF_FORMAT
+      "u of non-boxed value %p is illegal: %s\n",
+      (ARCH_UINT64_TYPE) Long_val(pos), (void*) v, descr);
+    abort();
+  }
+  if (Tag_val(v) == Infix_tag) {
+    uintnat offset = Infix_offset_val(v);
+    v -= offset;
+    pos += offset / sizeof(value);
+  }
+  CAMLassert(Long_val(pos) >= 0);
+  if (Long_val(pos) >= Wosize_val(v)) {
+    fprintf(stderr,
+      "Access to field %" ARCH_INT64_PRINTF_FORMAT
+      "u of value %p of size %" ARCH_INT64_PRINTF_FORMAT "u is illegal: %s\n",
+      (ARCH_UINT64_TYPE) Long_val(pos), (void*) v,
+      (ARCH_UINT64_TYPE) Wosize_val(v),
+      descr);
+    abort();
+  }
+  return orig_v;
+}
diff --git a/runtime/compact.c b/runtime/compact.c
new file mode 100644
index 00000000..02aec46b
--- /dev/null
+++ b/runtime/compact.c
@@ -0,0 +1,581 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*              Damien Doligez, projet Para, 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
+
+#include <string.h>
+
+#include "caml/address_class.h"
+#include "caml/config.h"
+#include "caml/finalise.h"
+#include "caml/freelist.h"
+#include "caml/gc.h"
+#include "caml/gc_ctrl.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/weak.h"
+#include "caml/compact.h"
+#include "caml/memprof.h"
+#include "caml/eventlog.h"
+
+extern uintnat caml_percent_free;                   /* major_gc.c */
+extern void caml_shrink_heap (char *);              /* memory.c */
+
+/* Encoded headers: the color is stored in the 2 least significant bits.
+   (For pointer inversion, we need to distinguish headers from pointers.)
+   s is a Wosize, t is a tag, and c is a color (a two-bit number)
+
+   For the purpose of compaction, "colors" are:
+   0: pointers (direct or inverted)
+   1: integer or (unencoded) infix header
+   2: inverted pointer for infix header
+   3: integer or encoded (noninfix) header
+
+  XXX Should be fixed:
+  XXX The above assumes that all roots are aligned on a 4-byte boundary,
+  XXX which is not always guaranteed by C.
+  XXX (see [caml_register_global_roots])
+  XXX Should be able to fix it to only assume 2-byte alignment.
+*/
+#ifdef WITH_PROFINFO
+#define Make_ehd(s,t,c,p) \
+  (((s) << 10) | (t) << 2 | (c) | ((p) << PROFINFO_SHIFT))
+#else
+#define Make_ehd(s,t,c,p) (((s) << 10) | (t) << 2 | (c))
+#endif
+#define Whsize_ehd(h) Whsize_hd (h)
+#define Wosize_ehd(h) Wosize_hd (h)
+#define Tag_ehd(h) (((h) >> 2) & 0xFF)
+#ifdef WITH_PROFINFO
+#define Profinfo_ehd(hd) Profinfo_hd(hd)
+#endif
+#define Ecolor(w) ((w) & 3)
+
+typedef uintnat word;
+
+static void invert_pointer_at (word *p)
+{
+  word q = *p;
+  CAMLassert (Ecolor ((intnat) p) == 0);
+
+  /* Use Ecolor (q) == 0 instead of Is_block (q) because q could be an
+     inverted pointer for an infix header (with Ecolor == 2). */
+  if (Ecolor (q) == 0 && Is_in_heap (q)){
+    switch (Ecolor (Hd_val (q))){
+    case 0:
+    case 3: /* Pointer or header: insert in inverted list. */
+      *p = Hd_val (q);
+      Hd_val (q) = (header_t) p;
+      break;
+    case 1: /* Infix header: make inverted infix list. */
+      /* Double inversion: the last of the inverted infix list points to
+         the next infix header in this block.  The last of the last list
+         contains the original block header. */
+      {
+        /* This block as a value. */
+        value val = (value) q - Infix_offset_val (q);
+        /* Get the block header. */
+        word *hp = (word *) Hp_val (val);
+
+        while (Ecolor (*hp) == 0) hp = (word *) *hp;
+        CAMLassert (Ecolor (*hp) == 3);
+        if (Tag_ehd (*hp) == Closure_tag){
+          /* This is the first infix found in this block. */
+          /* Save original header. */
+          *p = *hp;
+          /* Link inverted infix list. */
+          Hd_val (q) = (header_t) ((word) p | 2);
+          /* Change block header's tag to Infix_tag, and change its size
+             to point to the infix list. */
+          *hp = Make_ehd (Wosize_bhsize (q - val), Infix_tag, 3, (uintnat) 0);
+        }else{
+          CAMLassert (Tag_ehd (*hp) == Infix_tag);
+          /* Point the last of this infix list to the current first infix
+             list of the block. */
+          *p = (word) &Field (val, Wosize_ehd (*hp)) | 1;
+          /* Point the head of this infix list to the above. */
+          Hd_val (q) = (header_t) ((word) p | 2);
+          /* Change block header's size to point to this infix list. */
+          *hp = Make_ehd (Wosize_bhsize (q - val), Infix_tag, 3, (uintnat) 0);
+        }
+      }
+      break;
+    case 2: /* Inverted infix list: insert. */
+      *p = Hd_val (q);
+      Hd_val (q) = (header_t) ((word) p | 2);
+      break;
+    }
+  }
+}
+
+void caml_invert_root (value v, value *p)
+{
+  invert_pointer_at ((word *) p);
+}
+
+static char *compact_fl;
+
+static void init_compact_allocate (void)
+{
+  char *ch = caml_heap_start;
+  while (ch != NULL){
+    Chunk_alloc (ch) = 0;
+    ch = Chunk_next (ch);
+  }
+  compact_fl = caml_heap_start;
+}
+
+/* [size] is a number of bytes and includes the header size */
+static char *compact_allocate (mlsize_t size)
+{
+  char *chunk, *adr;
+
+  while (Chunk_size (compact_fl) - Chunk_alloc (compact_fl) <= Bhsize_wosize (3)
+         && Chunk_size (Chunk_next (compact_fl))
+            - Chunk_alloc (Chunk_next (compact_fl))
+            <= Bhsize_wosize (3)){
+    compact_fl = Chunk_next (compact_fl);
+  }
+  chunk = compact_fl;
+  while (Chunk_size (chunk) - Chunk_alloc (chunk) < size){
+    chunk = Chunk_next (chunk);
+    CAMLassert (chunk != NULL);
+  }
+  adr = chunk + Chunk_alloc (chunk);
+  Chunk_alloc (chunk) += size;
+  return adr;
+}
+
+static void do_compaction (intnat new_allocation_policy)
+{
+  char *ch, *chend;
+  CAMLassert (caml_gc_phase == Phase_idle);
+  caml_gc_message (0x10, "Compacting heap...\n");
+
+#ifdef DEBUG
+  caml_heap_check ();
+#endif
+
+  /* Make sure the heap is in the right state for compaction:
+     - all free blocks are blue
+     - all other blocks are white and contain valid pointers
+  */
+  caml_fl_reset_and_switch_policy (new_allocation_policy);
+
+
+  /* First pass: encode all noninfix headers. */
+  {
+    ch = caml_heap_start;
+    while (ch != NULL){
+      header_t *p = (header_t *) ch;
+
+      chend = ch + Chunk_size (ch);
+      while ((char *) p < chend){
+        header_t hd = Hd_hp (p);
+        mlsize_t sz = Wosize_hd (hd);
+
+        if (Is_blue_hd (hd)){
+          /* Free object.  Give it a string tag. */
+          Hd_hp (p) = Make_ehd (sz, String_tag, 3, (uintnat) 0);
+        }else{
+          CAMLassert (Is_white_hd (hd));
+          /* Live object.  Keep its tag. */
+          Hd_hp (p) = Make_ehd (sz, Tag_hd (hd), 3, Profinfo_hd (hd));
+        }
+        p += Whsize_wosize (sz);
+      }
+      ch = Chunk_next (ch);
+    }
+  }
+
+
+  /* Second pass: invert pointers.
+     Link infix headers in each block in an inverted list of inverted lists.
+     Don't forget roots and weak pointers. */
+  {
+    /* Invert roots first because the threads library needs some heap
+       data structures to find its roots.  Fortunately, it doesn't need
+       the headers (see above). */
+    caml_do_roots (caml_invert_root, 1);
+    /* The values to be finalised are not roots but should still be inverted */
+    caml_final_invert_finalisable_values ();
+    /* Idem for memprof tracked blocks */
+    caml_memprof_invert_tracked ();
+
+    ch = caml_heap_start;
+    while (ch != NULL){
+      word *p = (word *) ch;
+      chend = ch + Chunk_size (ch);
+
+      while ((char *) p < chend){
+        word q = *p;
+        size_t sz, i;
+        tag_t t;
+        word *infixes;
+
+        while (Ecolor (q) == 0) q = * (word *) q;
+        sz = Whsize_ehd (q);
+        t = Tag_ehd (q);
+
+        if (t == Infix_tag){
+          /* Get the original header of this block. */
+          infixes = p + sz;
+          q = *infixes;
+          while (Ecolor (q) != 3) q = * (word *) (q & ~(uintnat)3);
+          sz = Whsize_ehd (q);
+          t = Tag_ehd (q);
+        }
+
+        if (t < No_scan_tag){
+          for (i = 1; i < sz; i++) invert_pointer_at (&(p[i]));
+        }
+        p += sz;
+      }
+      ch = Chunk_next (ch);
+    }
+    /* Invert weak pointers. */
+    {
+      value *pp = &caml_ephe_list_head;
+      value p;
+      word q;
+      size_t sz, i;
+
+      while (1){
+        p = *pp;
+        if (p == (value) NULL) break;
+        q = Hd_val (p);
+        while (Ecolor (q) == 0) q = * (word *) q;
+        sz = Wosize_ehd (q);
+        for (i = 1; i < sz; i++){
+          if (Field (p,i) != caml_ephe_none){
+            invert_pointer_at ((word *) &(Field (p,i)));
+          }
+        }
+        invert_pointer_at ((word *) pp);
+        pp = &Field (p, 0);
+      }
+    }
+  }
+
+
+  /* Third pass: reallocate virtually; revert pointers; decode headers.
+     Rebuild infix headers. */
+  {
+    init_compact_allocate ();
+    ch = caml_heap_start;
+    while (ch != NULL){
+      word *p = (word *) ch;
+
+      chend = ch + Chunk_size (ch);
+      while ((char *) p < chend){
+        word q = *p;
+
+        if (Ecolor (q) == 0 || Tag_ehd (q) == Infix_tag){
+          /* There were (normal or infix) pointers to this block. */
+          size_t sz;
+          tag_t t;
+          char *newadr;
+#ifdef WITH_PROFINFO
+          uintnat profinfo;
+#endif
+          word *infixes = NULL;
+
+          while (Ecolor (q) == 0) q = * (word *) q;
+          sz = Whsize_ehd (q);
+          t = Tag_ehd (q);
+#ifdef WITH_PROFINFO
+          profinfo = Profinfo_ehd (q);
+#endif
+          if (t == Infix_tag){
+            /* Get the original header of this block. */
+            infixes = p + sz;
+            q = *infixes;
+            CAMLassert (Ecolor (q) == 2);
+            while (Ecolor (q) != 3) q = * (word *) (q & ~(uintnat)3);
+            sz = Whsize_ehd (q);
+            t = Tag_ehd (q);
+          }
+
+          newadr = compact_allocate (Bsize_wsize (sz));
+          q = *p;
+          while (Ecolor (q) == 0){
+            word next = * (word *) q;
+            * (word *) q = (word) Val_hp (newadr);
+            q = next;
+          }
+          *p = Make_header_with_profinfo (Wosize_whsize (sz), t, Caml_white,
+            profinfo);
+
+          if (infixes != NULL){
+            /* Rebuild the infix headers and revert the infix pointers. */
+            while (Ecolor ((word) infixes) != 3){
+              infixes = (word *) ((word) infixes & ~(uintnat) 3);
+              q = *infixes;
+              while (Ecolor (q) == 2){
+                word next;
+                q = (word) q & ~(uintnat) 3;
+                next = * (word *) q;
+                * (word *) q = (word) Val_hp ((word *) newadr + (infixes - p));
+                q = next;
+              }
+              CAMLassert (Ecolor (q) == 1 || Ecolor (q) == 3);
+              /* No need to preserve any profinfo value on the [Infix_tag]
+                 headers; the Spacetime profiling heap snapshot code doesn't
+                 look at them. */
+              *infixes = Make_header (infixes - p, Infix_tag, Caml_white);
+              infixes = (word *) q;
+            }
+          }
+          p += sz;
+        }else{
+          CAMLassert (Ecolor (q) == 3);
+          /* This is guaranteed only if caml_compact_heap was called after a
+             nonincremental major GC:    CAMLassert (Tag_ehd (q) == String_tag);
+          */
+          /* No pointers to the header and no infix header:
+             the object was free. */
+          *p = Make_header (Wosize_ehd (q), Tag_ehd (q), Caml_blue);
+          p += Whsize_ehd (q);
+        }
+      }
+      ch = Chunk_next (ch);
+    }
+  }
+
+
+  /* Fourth pass: reallocate and move objects.
+     Use the exact same allocation algorithm as pass 3. */
+  {
+    init_compact_allocate ();
+    ch = caml_heap_start;
+    while (ch != NULL){
+      word *p = (word *) ch;
+
+      chend = ch + Chunk_size (ch);
+      while ((char *) p < chend){
+        word q = *p;
+        if (Color_hd (q) == Caml_white){
+          size_t sz = Bhsize_hd (q);
+          char *newadr = compact_allocate (sz);
+          memmove (newadr, p, sz);
+          p += Wsize_bsize (sz);
+        }else{
+          CAMLassert (Color_hd (q) == Caml_blue);
+          p += Whsize_hd (q);
+        }
+      }
+      ch = Chunk_next (ch);
+    }
+  }
+
+  /* Shrink the heap if needed. */
+  {
+    /* Find the amount of live data and the unshrinkable free space. */
+    asize_t live = 0;
+    asize_t free = 0;
+    asize_t wanted;
+
+    ch = caml_heap_start;
+    while (ch != NULL){
+      if (Chunk_alloc (ch) != 0){
+        live += Wsize_bsize (Chunk_alloc (ch));
+        free += Wsize_bsize (Chunk_size (ch) - Chunk_alloc (ch));
+      }
+      ch = Chunk_next (ch);
+    }
+
+    /* Add up the empty chunks until there are enough, then remove the
+       other empty chunks. */
+    wanted = caml_percent_free * (live / 100 + 1);
+    ch = caml_heap_start;
+    while (ch != NULL){
+      char *next_chunk = Chunk_next (ch);  /* Chunk_next (ch) will be erased */
+
+      if (Chunk_alloc (ch) == 0){
+        if (free < wanted){
+          free += Wsize_bsize (Chunk_size (ch));
+        }else{
+          caml_shrink_heap (ch);
+        }
+      }
+      ch = next_chunk;
+    }
+  }
+
+  /* Rebuild the free list. This is the right time for a change of
+     allocation policy, since we are rebuilding the allocator's data
+     structures from scratch. */
+  {
+    ch = caml_heap_start;
+    caml_fl_init_merge ();
+    while (ch != NULL){
+      if (Chunk_size (ch) > Chunk_alloc (ch)){
+        caml_make_free_blocks ((value *) (ch + Chunk_alloc (ch)),
+                               Wsize_bsize (Chunk_size(ch)-Chunk_alloc(ch)), 1,
+                               Caml_white);
+      }
+      ch = Chunk_next (ch);
+    }
+  }
+  ++ Caml_state->stat_compactions;
+  caml_gc_message (0x10, "done.\n");
+}
+
+uintnat caml_percent_max;  /* used in gc_ctrl.c and memory.c */
+
+void caml_compact_heap (intnat new_allocation_policy)
+{
+  uintnat target_wsz, live;
+
+  CAMLassert (Caml_state->young_ptr == Caml_state->young_alloc_end);
+  CAMLassert (Caml_state->ref_table->ptr ==
+              Caml_state->ref_table->base);
+  CAMLassert (Caml_state->ephe_ref_table->ptr ==
+              Caml_state->ephe_ref_table->base);
+  CAMLassert (Caml_state->custom_table->ptr ==
+              Caml_state->custom_table->base);
+
+  CAML_EV_BEGIN(EV_COMPACT_MAIN);
+  do_compaction (new_allocation_policy);
+  CAML_EV_END(EV_COMPACT_MAIN);
+  /* Compaction may fail to shrink the heap to a reasonable size
+     because it deals in complete chunks: if a very large chunk
+     is at the beginning of the heap, everything gets moved to
+     it and it is not freed.
+
+     In that case, we allocate a new chunk of the desired heap
+     size, chain it at the beginning of the heap (thus pretending
+     its address is smaller), and launch a second compaction.
+     This will move all data to this new chunk and free the
+     very large chunk.
+
+     See PR#5389
+  */
+  /* We compute:
+     freewords = caml_fl_cur_wsz                   (exact)
+     heapwords = Wsize_bsize (caml_heap_size)      (exact)
+     live = heapwords - freewords
+     wanted = caml_percent_free * (live / 100 + 1) (same as in do_compaction)
+     target_wsz = live + wanted
+     We add one page to make sure a small difference in counting sizes
+     won't make [do_compaction] keep the second block (and break all sorts
+     of invariants).
+
+     We recompact if target_wsz < heap_size / 2
+  */
+  live = Caml_state->stat_heap_wsz - caml_fl_cur_wsz;
+  target_wsz = live + caml_percent_free * (live / 100 + 1)
+                 + Wsize_bsize (Page_size);
+  target_wsz = caml_clip_heap_chunk_wsz (target_wsz);
+
+#ifdef HAS_HUGE_PAGES
+  if (caml_use_huge_pages
+      && Bsize_wsize (Caml_state->stat_heap_wsz) <= HUGE_PAGE_SIZE)
+    return;
+#endif
+
+  if (target_wsz < Caml_state->stat_heap_wsz / 2){
+    /* Recompact. */
+    char *chunk;
+
+    caml_gc_message (0x10, "Recompacting heap (target=%"
+                     ARCH_INTNAT_PRINTF_FORMAT "uk words)\n",
+                     target_wsz / 1024);
+
+    chunk = caml_alloc_for_heap (Bsize_wsize (target_wsz));
+    if (chunk == NULL) return;
+    /* PR#5757: we need to make the new blocks blue, or they won't be
+       recognized as free by the recompaction. */
+    caml_make_free_blocks ((value *) chunk,
+                           Wsize_bsize (Chunk_size (chunk)), 0, Caml_blue);
+    if (caml_page_table_add (In_heap, chunk, chunk + Chunk_size (chunk)) != 0){
+      caml_free_for_heap (chunk);
+      return;
+    }
+    Chunk_next (chunk) = caml_heap_start;
+    caml_heap_start = chunk;
+    ++ Caml_state->stat_heap_chunks;
+    Caml_state->stat_heap_wsz += Wsize_bsize (Chunk_size (chunk));
+    if (Caml_state->stat_heap_wsz > Caml_state->stat_top_heap_wsz){
+      Caml_state->stat_top_heap_wsz = Caml_state->stat_heap_wsz;
+    }
+    CAML_EV_BEGIN(EV_COMPACT_RECOMPACT);
+    do_compaction (-1);
+    CAMLassert (Caml_state->stat_heap_chunks == 1);
+    CAMLassert (Chunk_next (caml_heap_start) == NULL);
+    CAMLassert (Caml_state->stat_heap_wsz == Wsize_bsize (Chunk_size (chunk)));
+    CAML_EV_END(EV_COMPACT_RECOMPACT);
+  }
+}
+
+void caml_compact_heap_maybe (void)
+{
+  /* Estimated free+garbage words in the heap:
+         FW = fl_size_at_phase_change + 3 * (caml_fl_cur_wsz
+                                             - caml_fl_wsz_at_phase_change)
+         FW = 3 * caml_fl_cur_wsz - 2 * caml_fl_wsz_at_phase_change
+     Estimated live words:      LW = Caml_state->stat_heap_wsz - FW
+     Estimated free percentage: FP = 100 * FW / LW
+     We compact the heap if FP > caml_percent_max
+  */
+  double fw, fp;
+  CAMLassert (caml_gc_phase == Phase_idle);
+  if (caml_percent_max >= 1000000) return;
+  if (Caml_state->stat_major_collections < 3) return;
+  if (Caml_state->stat_heap_wsz <= 2 * caml_clip_heap_chunk_wsz (0)) return;
+
+#ifdef HAS_HUGE_PAGES
+  if (caml_use_huge_pages
+      && Bsize_wsize (Caml_state->stat_heap_wsz) <= HUGE_PAGE_SIZE)
+    return;
+#endif
+
+  fw = 3.0 * caml_fl_cur_wsz - 2.0 * caml_fl_wsz_at_phase_change;
+  if (fw < 0) fw = caml_fl_cur_wsz;
+
+  if (fw >= Caml_state->stat_heap_wsz){
+    fp = 1000000.0;
+  }else{
+    fp = 100.0 * fw / (Caml_state->stat_heap_wsz - fw);
+    if (fp > 1000000.0) fp = 1000000.0;
+  }
+  caml_gc_message (0x200, "FL size at phase change = %"
+                          ARCH_INTNAT_PRINTF_FORMAT "u words\n",
+                   (uintnat) caml_fl_wsz_at_phase_change);
+  caml_gc_message (0x200, "FL current size = %"
+                          ARCH_INTNAT_PRINTF_FORMAT "u words\n",
+                   (uintnat) caml_fl_cur_wsz);
+  caml_gc_message (0x200, "Estimated overhead = %"
+                          ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
+                   (uintnat) fp);
+  if (fp >= caml_percent_max){
+    caml_gc_message (0x200, "Automatic compaction triggered.\n");
+    caml_empty_minor_heap ();  /* minor heap must be empty for compaction */
+    caml_finish_major_cycle ();
+
+    fw = caml_fl_cur_wsz;
+    fp = 100.0 * fw / (Caml_state->stat_heap_wsz - fw);
+    caml_gc_message (0x200, "Measured overhead: %"
+                            ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
+                     (uintnat) fp);
+    if (fp >= caml_percent_max)
+         caml_compact_heap (-1);
+    else
+         caml_gc_message (0x200, "Automatic compaction aborted.\n");
+
+  }
+}
diff --git a/runtime/compare.c b/runtime/compare.c
new file mode 100644
index 00000000..974e0c01
--- /dev/null
+++ b/runtime/compare.c
@@ -0,0 +1,344 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <string.h>
+#include <stdlib.h>
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+
+/* Structural comparison on trees. */
+
+struct compare_item { value * v1, * v2; mlsize_t count; };
+
+#define COMPARE_STACK_INIT_SIZE 8
+#define COMPARE_STACK_MIN_ALLOC_SIZE 32
+#define COMPARE_STACK_MAX_SIZE (1024*1024)
+
+struct compare_stack {
+  struct compare_item init_stack[COMPARE_STACK_INIT_SIZE];
+  struct compare_item* stack;
+  struct compare_item* limit;
+};
+
+/* Free the compare stack if needed */
+static void compare_free_stack(struct compare_stack* stk)
+{
+  if (stk->stack != stk->init_stack) {
+    caml_stat_free(stk->stack);
+    stk->stack = NULL;
+  }
+}
+
+/* Same, then raise Out_of_memory */
+CAMLnoreturn_start
+static void compare_stack_overflow(struct compare_stack* stk)
+CAMLnoreturn_end;
+
+static void compare_stack_overflow(struct compare_stack* stk)
+{
+  caml_gc_message (0x04, "Stack overflow in structural comparison\n");
+  compare_free_stack(stk);
+  caml_raise_out_of_memory();
+}
+
+/* Grow the compare stack */
+static struct compare_item * compare_resize_stack(struct compare_stack* stk,
+                                                  struct compare_item * sp)
+{
+  asize_t newsize;
+  asize_t sp_offset = sp - stk->stack;
+  struct compare_item * newstack;
+
+  if (stk->stack == stk->init_stack) {
+    newsize = COMPARE_STACK_MIN_ALLOC_SIZE;
+    newstack = caml_stat_alloc_noexc(sizeof(struct compare_item) * newsize);
+    if (newstack == NULL) compare_stack_overflow(stk);
+    memcpy(newstack, stk->init_stack,
+           sizeof(struct compare_item) * COMPARE_STACK_INIT_SIZE);
+  } else {
+    newsize = 2 * (stk->limit - stk->stack);
+    if (newsize >= COMPARE_STACK_MAX_SIZE) compare_stack_overflow(stk);
+    newstack = caml_stat_resize_noexc(stk->stack,
+                                      sizeof(struct compare_item) * newsize);
+    if (newstack == NULL) compare_stack_overflow(stk);
+  }
+  stk->stack = newstack;
+  stk->limit = newstack + newsize;
+  return newstack + sp_offset;
+}
+
+
+static intnat do_compare_val(struct compare_stack* stk,
+                             value v1, value v2, int total);
+
+static intnat compare_val(value v1, value v2, int total)
+{
+  struct compare_stack stk;
+  intnat res;
+  stk.stack = stk.init_stack;
+  stk.limit = stk.stack + COMPARE_STACK_INIT_SIZE;
+  res = do_compare_val(&stk, v1, v2, total);
+  compare_free_stack(&stk);
+  return res;
+}
+
+/* Structural comparison */
+
+
+#define LESS -1
+#define EQUAL 0
+#define GREATER 1
+#define UNORDERED ((intnat)1 << (8 * sizeof(value) - 1))
+
+/* The return value of compare_val is as follows:
+      > 0                 v1 is greater than v2
+      0                   v1 is equal to v2
+      < 0 and > UNORDERED v1 is less than v2
+      UNORDERED           v1 and v2 cannot be compared */
+
+static intnat do_compare_val(struct compare_stack* stk,
+                             value v1, value v2, int total)
+{
+  struct compare_item * sp;
+  tag_t t1, t2;
+
+  sp = stk->stack;
+  while (1) {
+    if (v1 == v2 && total) goto next_item;
+    if (Is_long(v1)) {
+      if (v1 == v2) goto next_item;
+      if (Is_long(v2))
+        return Long_val(v1) - Long_val(v2);
+      /* Subtraction above cannot overflow and cannot result in UNORDERED */
+#ifndef NO_NAKED_POINTERS
+      if (!Is_in_value_area(v2))
+        return LESS;
+#endif
+        switch (Tag_val(v2)) {
+        case Forward_tag:
+          v2 = Forward_val(v2);
+          continue;
+        case Custom_tag: {
+          int res;
+          int (*compare)(value v1, value v2) = Custom_ops_val(v2)->compare_ext;
+          if (compare == NULL) break;  /* for backward compatibility */
+          Caml_state->compare_unordered = 0;
+          res = compare(v1, v2);
+          if (Caml_state->compare_unordered && !total) return UNORDERED;
+          if (res != 0) return res;
+          goto next_item;
+        }
+        default: /*fallthrough*/;
+        }
+      return LESS;                /* v1 long < v2 block */
+    }
+    if (Is_long(v2)) {
+#ifndef NO_NAKED_POINTERS
+      if (!Is_in_value_area(v1))
+        return GREATER;
+#endif
+        switch (Tag_val(v1)) {
+        case Forward_tag:
+          v1 = Forward_val(v1);
+          continue;
+        case Custom_tag: {
+          int res;
+          int (*compare)(value v1, value v2) = Custom_ops_val(v1)->compare_ext;
+          if (compare == NULL) break;  /* for backward compatibility */
+          Caml_state->compare_unordered = 0;
+          res = compare(v1, v2);
+          if (Caml_state->compare_unordered && !total) return UNORDERED;
+          if (res != 0) return res;
+          goto next_item;
+        }
+        default: /*fallthrough*/;
+        }
+      return GREATER;            /* v1 block > v2 long */
+    }
+#ifndef NO_NAKED_POINTERS
+    /* If one of the objects is outside the heap (but is not an atom),
+       use address comparison. Since both addresses are 2-aligned,
+       shift lsb off to avoid overflow in subtraction. */
+    if (! Is_in_value_area(v1) || ! Is_in_value_area(v2)) {
+      if (v1 == v2) goto next_item;
+      return (v1 >> 1) - (v2 >> 1);
+      /* Subtraction above cannot result in UNORDERED */
+    }
+#endif
+    t1 = Tag_val(v1);
+    t2 = Tag_val(v2);
+    if (t1 == Forward_tag) { v1 = Forward_val (v1); continue; }
+    if (t2 == Forward_tag) { v2 = Forward_val (v2); continue; }
+    if (t1 != t2) return (intnat)t1 - (intnat)t2;
+    switch(t1) {
+    case String_tag: {
+      mlsize_t len1, len2;
+      int res;
+      if (v1 == v2) break;
+      len1 = caml_string_length(v1);
+      len2 = caml_string_length(v2);
+      res = memcmp(String_val(v1), String_val(v2), len1 <= len2 ? len1 : len2);
+      if (res < 0) return LESS;
+      if (res > 0) return GREATER;
+      if (len1 != len2) return len1 - len2;
+      break;
+    }
+    case Double_tag: {
+      double d1 = Double_val(v1);
+      double d2 = Double_val(v2);
+      if (d1 < d2) return LESS;
+      if (d1 > d2) return GREATER;
+      if (d1 != d2) {
+        if (! total) return UNORDERED;
+        /* One or both of d1 and d2 is NaN.  Order according to the
+           convention NaN = NaN and NaN < f for all other floats f. */
+        if (d1 == d1) return GREATER; /* d1 is not NaN, d2 is NaN */
+        if (d2 == d2) return LESS;    /* d2 is not NaN, d1 is NaN */
+        /* d1 and d2 are both NaN, thus equal: continue comparison */
+      }
+      break;
+    }
+    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++) {
+        double d1 = Double_flat_field(v1, i);
+        double d2 = Double_flat_field(v2, i);
+        if (d1 < d2) return LESS;
+        if (d1 > d2) return GREATER;
+        if (d1 != d2) {
+          if (! total) return UNORDERED;
+          /* See comment for Double_tag case */
+          if (d1 == d1) return GREATER;
+          if (d2 == d2) return LESS;
+        }
+      }
+      break;
+    }
+    case Abstract_tag:
+      compare_free_stack(stk);
+      caml_invalid_argument("compare: abstract value");
+    case Closure_tag:
+    case Infix_tag:
+      compare_free_stack(stk);
+      caml_invalid_argument("compare: functional value");
+    case Object_tag: {
+      intnat oid1 = Oid_val(v1);
+      intnat oid2 = Oid_val(v2);
+      if (oid1 != oid2) return oid1 - oid2;
+      break;
+    }
+    case Custom_tag: {
+      int res;
+      int (*compare)(value v1, value v2) = Custom_ops_val(v1)->compare;
+      /* Hardening against comparisons between different types */
+      if (compare != Custom_ops_val(v2)->compare) {
+        return strcmp(Custom_ops_val(v1)->identifier,
+                      Custom_ops_val(v2)->identifier) < 0
+               ? LESS : GREATER;
+      }
+      if (compare == NULL) {
+        compare_free_stack(stk);
+        caml_invalid_argument("compare: abstract value");
+      }
+      Caml_state->compare_unordered = 0;
+      res = compare(v1, v2);
+      if (Caml_state->compare_unordered && !total) return UNORDERED;
+      if (res != 0) return res;
+      break;
+    }
+    default: {
+      mlsize_t sz1 = Wosize_val(v1);
+      mlsize_t sz2 = Wosize_val(v2);
+      /* Compare sizes first for speed */
+      if (sz1 != sz2) return sz1 - sz2;
+      if (sz1 == 0) break;
+      /* Remember that we still have to compare fields 1 ... sz - 1 */
+      if (sz1 > 1) {
+        sp++;
+        if (sp >= stk->limit) sp = compare_resize_stack(stk, sp);
+        sp->v1 = &Field(v1, 1);
+        sp->v2 = &Field(v2, 1);
+        sp->count = sz1 - 1;
+      }
+      /* Continue comparison with first field */
+      v1 = Field(v1, 0);
+      v2 = Field(v2, 0);
+      continue;
+    }
+    }
+  next_item:
+    /* Pop one more item to compare, if any */
+    if (sp == stk->stack) return EQUAL; /* we're done */
+    v1 = *((sp->v1)++);
+    v2 = *((sp->v2)++);
+    if (--(sp->count) == 0) sp--;
+  }
+}
+
+CAMLprim value caml_compare(value v1, value v2)
+{
+  intnat res = compare_val(v1, v2, 1);
+  /* Free stack if needed */
+  if (res < 0)
+    return Val_int(LESS);
+  else if (res > 0)
+    return Val_int(GREATER);
+  else
+    return Val_int(EQUAL);
+}
+
+CAMLprim value caml_equal(value v1, value v2)
+{
+  intnat res = compare_val(v1, v2, 0);
+  return Val_int(res == 0);
+}
+
+CAMLprim value caml_notequal(value v1, value v2)
+{
+  intnat res = compare_val(v1, v2, 0);
+  return Val_int(res != 0);
+}
+
+CAMLprim value caml_lessthan(value v1, value v2)
+{
+  intnat res = compare_val(v1, v2, 0);
+  return Val_int(res < 0 && res != UNORDERED);
+}
+
+CAMLprim value caml_lessequal(value v1, value v2)
+{
+  intnat res = compare_val(v1, v2, 0);
+  return Val_int(res <= 0 && res != UNORDERED);
+}
+
+CAMLprim value caml_greaterthan(value v1, value v2)
+{
+  intnat res = compare_val(v1, v2, 0);
+  return Val_int(res > 0);
+}
+
+CAMLprim value caml_greaterequal(value v1, value v2)
+{
+  intnat res = compare_val(v1, v2, 0);
+  return Val_int(res >= 0);
+}
diff --git a/runtime/custom.c b/runtime/custom.c
new file mode 100644
index 00000000..8568b587
--- /dev/null
+++ b/runtime/custom.c
@@ -0,0 +1,169 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Manuel Serrano and Xavier Leroy, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2000 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
+
+#include <string.h>
+
+#include "caml/alloc.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/gc_ctrl.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "caml/signals.h"
+
+uintnat caml_custom_major_ratio = Custom_major_ratio_def;
+uintnat caml_custom_minor_ratio = Custom_minor_ratio_def;
+uintnat caml_custom_minor_max_bsz = Custom_minor_max_bsz_def;
+
+static value alloc_custom_gen (struct custom_operations * ops,
+                               uintnat bsz,
+                               mlsize_t mem,
+                               mlsize_t max_major,
+                               mlsize_t mem_minor,
+                               mlsize_t max_minor)
+{
+  mlsize_t wosize;
+  CAMLparam0();
+  CAMLlocal1(result);
+
+  /* [mem] is the total amount of out-of-heap memory, [mem_minor] is how much
+     of it should be counted against [max_minor]. */
+  CAMLassert (mem_minor <= mem);
+
+  wosize = 1 + (bsz + sizeof(value) - 1) / sizeof(value);
+  if (wosize <= Max_young_wosize) {
+    result = caml_alloc_small(wosize, Custom_tag);
+    Custom_ops_val(result) = ops;
+    if (ops->finalize != NULL || mem != 0) {
+      if (mem > mem_minor) {
+        caml_adjust_gc_speed (mem - mem_minor, max_major);
+      }
+      /* The remaining [mem_minor] will be counted if the block survives a
+         minor GC */
+      add_to_custom_table (Caml_state->custom_table, result,
+                           mem_minor, max_major);
+      /* Keep track of extra resources held by custom block in
+         minor heap. */
+      if (mem_minor != 0) {
+        if (max_minor == 0) max_minor = 1;
+        Caml_state->extra_heap_resources_minor +=
+          (double) mem_minor / (double) max_minor;
+        if (Caml_state->extra_heap_resources_minor > 1.0)
+          caml_minor_collection ();
+      }
+    }
+  } else {
+    result = caml_alloc_shr(wosize, Custom_tag);
+    Custom_ops_val(result) = ops;
+    caml_adjust_gc_speed(mem, max_major);
+    caml_check_urgent_gc(Val_unit);
+  }
+  CAMLreturn(result);
+}
+
+CAMLexport value caml_alloc_custom(struct custom_operations * ops,
+                                   uintnat bsz,
+                                   mlsize_t mem,
+                                   mlsize_t max)
+{
+  return alloc_custom_gen (ops, bsz, mem, max, mem, max);
+}
+
+CAMLexport value caml_alloc_custom_mem(struct custom_operations * ops,
+                                       uintnat bsz,
+                                       mlsize_t mem)
+{
+  mlsize_t mem_minor =
+    mem < caml_custom_minor_max_bsz ? mem : caml_custom_minor_max_bsz;
+  mlsize_t max_major =
+    /* The major ratio is a percentage relative to the major heap size.
+       A complete GC cycle will be done every time 2/3 of that much memory
+       is allocated for blocks in the major heap.  Assuming constant
+       allocation and deallocation rates, this means there are at most
+       [M/100 * major-heap-size] bytes of floating garbage at any time.
+       The reason for a factor of 2/3 (or 1.5) is, roughly speaking, because
+       the major GC takes 1.5 cycles (previous cycle + marking phase) before
+       it starts to deallocate dead blocks allocated during the previous cycle.
+       [heap_size / 150] is really [heap_size * (2/3) / 100] (but faster). */
+    Bsize_wsize (Caml_state->stat_heap_wsz) / 150 * caml_custom_major_ratio;
+  mlsize_t max_minor =
+    Bsize_wsize (Caml_state->minor_heap_wsz) / 100 * caml_custom_minor_ratio;
+  return alloc_custom_gen (ops, bsz, mem, max_major, mem_minor, max_minor);
+}
+
+struct custom_operations_list {
+  struct custom_operations * ops;
+  struct custom_operations_list * next;
+};
+
+static struct custom_operations_list * custom_ops_table = NULL;
+
+CAMLexport void caml_register_custom_operations(struct custom_operations * ops)
+{
+  struct custom_operations_list * l =
+    caml_stat_alloc(sizeof(struct custom_operations_list));
+  CAMLassert(ops->identifier != NULL);
+  CAMLassert(ops->deserialize != NULL);
+  l->ops = ops;
+  l->next = custom_ops_table;
+  custom_ops_table = l;
+}
+
+struct custom_operations * caml_find_custom_operations(char * ident)
+{
+  struct custom_operations_list * l;
+  for (l = custom_ops_table; l != NULL; l = l->next)
+    if (strcmp(l->ops->identifier, ident) == 0) return l->ops;
+  return NULL;
+}
+
+static struct custom_operations_list * 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 = custom_ops_final_table; l != NULL; l = l->next)
+    if (l->ops->finalize == fn) return l->ops;
+  ops = caml_stat_alloc(sizeof(struct custom_operations));
+  ops->identifier = "_final";
+  ops->finalize = fn;
+  ops->compare = custom_compare_default;
+  ops->hash = custom_hash_default;
+  ops->serialize = custom_serialize_default;
+  ops->deserialize = custom_deserialize_default;
+  ops->compare_ext = custom_compare_ext_default;
+  ops->fixed_length = custom_fixed_length_default;
+  l = caml_stat_alloc(sizeof(struct custom_operations_list));
+  l->ops = ops;
+  l->next = custom_ops_final_table;
+  custom_ops_final_table = l;
+  return ops;
+}
+
+extern struct custom_operations caml_int32_ops,
+                                caml_nativeint_ops,
+                                caml_int64_ops,
+                                caml_ba_ops;
+
+void caml_init_custom_operations(void)
+{
+  caml_register_custom_operations(&caml_int32_ops);
+  caml_register_custom_operations(&caml_nativeint_ops);
+  caml_register_custom_operations(&caml_int64_ops);
+  caml_register_custom_operations(&caml_ba_ops);
+}
diff --git a/runtime/debugger.c b/runtime/debugger.c
new file mode 100644
index 00000000..21a93737
--- /dev/null
+++ b/runtime/debugger.c
@@ -0,0 +1,599 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* Interface with the byte-code debugger */
+
+#ifdef _WIN32
+#include <io.h>
+#endif /* _WIN32 */
+
+#include <string.h>
+
+#include "caml/alloc.h"
+#include "caml/config.h"
+#include "caml/debugger.h"
+#include "caml/misc.h"
+#include "caml/osdeps.h"
+
+int caml_debugger_in_use = 0;
+uintnat caml_event_count;
+int caml_debugger_fork_mode = 1; /* parent by default */
+
+#if !defined(HAS_SOCKETS) || defined(NATIVE_CODE)
+
+void caml_debugger_init(void)
+{
+}
+
+void caml_debugger(enum event_kind event, value param)
+{
+}
+
+void caml_debugger_cleanup_fork(void)
+{
+}
+
+#else
+
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#include <errno.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#ifndef _WIN32
+#include <sys/wait.h>
+#include <sys/socket.h>
+#include <sys/un.h>
+#include <netinet/in.h>
+#include <arpa/inet.h>
+#include <netdb.h>
+#else
+#define ATOM ATOM_WS
+#include <winsock.h>
+#undef ATOM
+#include <process.h>
+#endif
+
+#include "caml/fail.h"
+#include "caml/fix_code.h"
+#include "caml/instruct.h"
+#include "caml/intext.h"
+#include "caml/io.h"
+#include "caml/mlvalues.h"
+#include "caml/stacks.h"
+#include "caml/sys.h"
+
+static value marshal_flags = Val_emptylist;
+
+static int sock_domain;         /* Socket domain for the debugger */
+static union {                  /* Socket address for the debugger */
+  struct sockaddr s_gen;
+#ifndef _WIN32
+  struct sockaddr_un s_unix;
+#endif
+  struct sockaddr_in s_inet;
+} sock_addr;
+static int sock_addr_len;       /* Length of sock_addr */
+
+static int dbg_socket = -1;     /* The socket connected to the debugger */
+static struct channel * dbg_in; /* Input channel on the socket */
+static struct channel * dbg_out;/* Output channel on the socket */
+
+static char *dbg_addr = NULL;
+
+static struct ext_table breakpoints_table;
+
+static void open_connection(void)
+{
+#ifdef _WIN32
+  /* Set socket to synchronous mode so that file descriptor-oriented
+     functions (read()/write() etc.) can be used */
+
+  int oldvalue, oldvaluelen, newvalue, retcode;
+  oldvaluelen = sizeof(oldvalue);
+  retcode = getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
+                       (char *) &oldvalue, &oldvaluelen);
+  if (retcode == 0) {
+      newvalue = SO_SYNCHRONOUS_NONALERT;
+      setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
+                 (char *) &newvalue, sizeof(newvalue));
+  }
+#endif
+  dbg_socket = socket(sock_domain, SOCK_STREAM, 0);
+#ifdef _WIN32
+  if (retcode == 0) {
+    /* Restore initial mode */
+    setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
+               (char *) &oldvalue, oldvaluelen);
+  }
+#endif
+  if (dbg_socket == -1 ||
+      connect(dbg_socket, &sock_addr.s_gen, sock_addr_len) == -1){
+    caml_fatal_error
+    (
+      "cannot connect to debugger at %s\n"
+      "error: %s",
+      (dbg_addr ? dbg_addr : "(none)"),
+      strerror (errno)
+    );
+  }
+#ifdef _WIN32
+  dbg_socket = _open_osfhandle(dbg_socket, 0);
+  if (dbg_socket == -1)
+    caml_fatal_error("_open_osfhandle failed");
+#endif
+  dbg_in = caml_open_descriptor_in(dbg_socket);
+  dbg_out = caml_open_descriptor_out(dbg_socket);
+  if (!caml_debugger_in_use) caml_putword(dbg_out, -1); /* first connection */
+#ifdef _WIN32
+  caml_putword(dbg_out, _getpid());
+#else
+  caml_putword(dbg_out, getpid());
+#endif
+  caml_flush(dbg_out);
+}
+
+static void close_connection(void)
+{
+  caml_close_channel(dbg_in);
+  caml_close_channel(dbg_out);
+  dbg_socket = -1;              /* was closed by caml_close_channel */
+}
+
+#ifdef _WIN32
+static void winsock_startup(void)
+{
+  WSADATA wsaData;
+  int err = WSAStartup(MAKEWORD(2, 0), &wsaData);
+  if (err) caml_fatal_error("WSAStartup failed");
+}
+
+static void winsock_cleanup(void)
+{
+  WSACleanup();
+}
+#endif
+
+void caml_debugger_init(void)
+{
+  char * address;
+  char_os * a;
+  size_t a_len;
+  char * port, * p;
+  struct hostent * host;
+  int n;
+
+  caml_register_global_root(&marshal_flags);
+  marshal_flags = caml_alloc(2, Tag_cons);
+  Store_field(marshal_flags, 0, Val_int(1)); /* Marshal.Closures */
+  Store_field(marshal_flags, 1, Val_emptylist);
+
+  a = caml_secure_getenv(T("CAML_DEBUG_SOCKET"));
+  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
+     the debugger. */
+#if defined(_WIN32)
+  _wputenv(L"CAML_DEBUG_SOCKET=");
+#elif defined(HAS_SETENV_UNSETENV)
+  unsetenv("CAML_DEBUG_SOCKET");
+#endif
+
+  caml_ext_table_init(&breakpoints_table, 16);
+
+#ifdef _WIN32
+  winsock_startup();
+  (void)atexit(winsock_cleanup);
+#endif
+  /* Parse the address */
+  port = NULL;
+  for (p = address; *p != 0; p++) {
+    if (*p == ':') { *p = 0; port = p+1; break; }
+  }
+  if (port == NULL) {
+#ifndef _WIN32
+    /* Unix domain */
+    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)) {
+      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;
+#else
+    caml_fatal_error("unix sockets not supported");
+#endif
+  } 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);
+    }
+    sock_addr.s_inet.sin_port = htons(atoi(port));
+    sock_addr_len = sizeof(sock_addr.s_inet);
+  }
+  open_connection();
+  caml_debugger_in_use = 1;
+  Caml_state->trap_barrier = Caml_state->stack_high;
+}
+
+static value getval(struct channel *chan)
+{
+  value res;
+  if (caml_really_getblock(chan, (char *) &res, sizeof(res)) < sizeof(res))
+    caml_raise_end_of_file(); /* Bad, but consistent with caml_getword */
+  return res;
+}
+
+static void putval(struct channel *chan, value val)
+{
+  caml_really_putblock(chan, (char *) &val, sizeof(val));
+}
+
+static void safe_output_value(struct channel *chan, value val)
+{
+  struct longjmp_buffer raise_buf, * saved_external_raise;
+
+  /* Catch exceptions raised by [caml_output_val] */
+  saved_external_raise = Caml_state->external_raise;
+  if (sigsetjmp(raise_buf.buf, 0) == 0) {
+    Caml_state->external_raise = &raise_buf;
+    caml_output_val(chan, val, marshal_flags);
+  } else {
+    /* Send wrong magic number, will cause [caml_input_value] to fail */
+    caml_really_putblock(chan, "\000\000\000\000", 4);
+  }
+  Caml_state->external_raise = saved_external_raise;
+}
+
+struct breakpoint {
+  code_t pc;
+  opcode_t saved;
+};
+
+static struct breakpoint *find_breakpoint(code_t pc)
+{
+  struct breakpoint *bpti;
+  int i;
+
+  for (i = 0; i < breakpoints_table.size; i++) {
+    bpti = (struct breakpoint *) breakpoints_table.contents[i];
+    if (bpti->pc == pc)
+      return bpti;
+  }
+
+  return NULL;
+}
+
+static void save_instruction(code_t pc)
+{
+  struct breakpoint *bpt;
+
+  if (find_breakpoint(pc) != NULL) {
+    /* Already saved. Nothing to do. */
+    return;
+  }
+
+  bpt = caml_stat_alloc(sizeof(struct breakpoint));
+  bpt->pc = pc;
+  bpt->saved = *pc;
+  caml_ext_table_add(&breakpoints_table, bpt);
+}
+
+static void set_instruction(code_t pc, opcode_t opcode)
+{
+  save_instruction(pc);
+  caml_set_instruction(pc, opcode);
+}
+
+static void restore_instruction(code_t pc)
+{
+  struct breakpoint *bpt = find_breakpoint(pc);
+  CAMLassert (bpt != NULL);
+
+  *pc = bpt->saved;
+  caml_ext_table_remove(&breakpoints_table, bpt);
+}
+
+static code_t pc_from_pos(int frag, intnat pos)
+{
+  struct code_fragment *cf;
+  CAMLassert (frag >= 0);
+  CAMLassert (frag < caml_code_fragments_table.size);
+  CAMLassert (pos >= 0);
+  CAMLassert (pos < caml_code_size);
+
+  cf = (struct code_fragment *) caml_code_fragments_table.contents[frag];
+  return (code_t) (cf->code_start + pos);
+}
+
+opcode_t caml_debugger_saved_instruction(code_t pc)
+{
+  struct breakpoint *bpt = find_breakpoint(pc);
+  CAMLassert (bpt != NULL);
+
+  return bpt->saved;
+}
+
+void caml_debugger_code_unloaded(int index)
+{
+  struct code_fragment *cf;
+  struct breakpoint *bpti;
+  int i;
+
+  if (!caml_debugger_in_use) return;
+
+  caml_putch(dbg_out, REP_CODE_UNLOADED);
+  caml_putword(dbg_out, index);
+
+  cf = (struct code_fragment *) caml_code_fragments_table.contents[index];
+
+  for (i = 0; i < breakpoints_table.size; i++) {
+    bpti = (struct breakpoint *) breakpoints_table.contents[i];
+    if ((char*) bpti->pc >= cf->code_start && (char*) bpti->pc < cf->code_end) {
+      caml_ext_table_remove(&breakpoints_table, bpti);
+      /* caml_ext_table_remove has shifted the next element in place
+         of the one we just removed. Decrement i for the next
+         iteration. */
+      i--;
+    }
+  }
+}
+
+#define Pc(sp) ((code_t)((sp)[0]))
+#define Env(sp) ((sp)[1])
+#define Extra_args(sp) (Long_val(((sp)[2])))
+#define Locals(sp) ((sp) + 3)
+
+void caml_debugger(enum event_kind event, value param)
+{
+  value *frame, *newframe;
+  intnat i, pos;
+  value val;
+  int frag, found = 0;
+  struct code_fragment *cf;
+  (void) found; /* Silence unused variable warning. */
+
+  if (dbg_socket == -1) return;  /* Not connected to a debugger. */
+
+  /* Reset current frame */
+  frame = Caml_state->extern_sp + 1;
+
+  /* Report the event to the debugger */
+  switch(event) {
+  case PROGRAM_START:           /* Nothing to report */
+    CAMLassert (param == Val_unit);
+    goto command_loop;
+  case EVENT_COUNT:
+    CAMLassert (param == Val_unit);
+    caml_putch(dbg_out, REP_EVENT);
+    break;
+  case BREAKPOINT:
+    CAMLassert (param == Val_unit);
+    caml_putch(dbg_out, REP_BREAKPOINT);
+    break;
+  case PROGRAM_EXIT:
+    CAMLassert (param == Val_unit);
+    caml_putch(dbg_out, REP_EXITED);
+    break;
+  case TRAP_BARRIER:
+    CAMLassert (param == Val_unit);
+    caml_putch(dbg_out, REP_TRAP);
+    break;
+  case UNCAUGHT_EXC:
+    CAMLassert (param == Val_unit);
+    caml_putch(dbg_out, REP_UNCAUGHT_EXC);
+    break;
+  case DEBUG_INFO_ADDED:
+    caml_putch(dbg_out, REP_CODE_DEBUG_INFO);
+    caml_output_val(dbg_out, /* debug_info */ param, Val_emptylist);
+    break;
+  case CODE_LOADED:
+    caml_putch(dbg_out, REP_CODE_LOADED);
+    caml_putword(dbg_out, /* index */ Long_val(param));
+    break;
+  case CODE_UNLOADED:
+    caml_putch(dbg_out, REP_CODE_UNLOADED);
+    caml_putword(dbg_out, /* index */ Long_val(param));
+    break;
+  }
+  caml_putword(dbg_out, caml_event_count);
+  if (event == EVENT_COUNT || event == BREAKPOINT) {
+    caml_putword(dbg_out, Caml_state->stack_high - frame);
+    found = caml_find_code_fragment((char*) Pc(frame), &frag, &cf);
+    CAMLassert(found);
+    caml_putword(dbg_out, frag);
+    caml_putword(dbg_out, (char*) Pc(frame) - cf->code_start);
+  } else {
+    /* No PC and no stack frame associated with other events */
+    caml_putword(dbg_out, 0);
+    caml_putword(dbg_out, -1);
+    caml_putword(dbg_out, 0);
+  }
+  caml_flush(dbg_out);
+
+ command_loop:
+
+  /* Read and execute the commands sent by the debugger */
+  while(1) {
+    switch(caml_getch(dbg_in)) {
+    case REQ_SET_EVENT:
+      frag = caml_getword(dbg_in);
+      pos = caml_getword(dbg_in);
+      set_instruction(pc_from_pos(frag, pos), EVENT);
+      break;
+    case REQ_SET_BREAKPOINT:
+      frag = caml_getword(dbg_in);
+      pos = caml_getword(dbg_in);
+      set_instruction(pc_from_pos(frag, pos), BREAK);
+      break;
+    case REQ_RESET_INSTR:
+      frag = caml_getword(dbg_in);
+      pos = caml_getword(dbg_in);
+      restore_instruction(pc_from_pos(frag, pos));
+      break;
+    case REQ_CHECKPOINT:
+#ifndef _WIN32
+      i = fork();
+      if (i == 0) {
+        close_connection();     /* Close parent connection. */
+        open_connection();      /* Open new connection with debugger */
+      } else {
+        caml_putword(dbg_out, i);
+        caml_flush(dbg_out);
+      }
+#else
+      caml_fatal_error("REQ_CHECKPOINT command");
+#endif
+      break;
+    case REQ_GO:
+      caml_event_count = caml_getword(dbg_in);
+      return;
+    case REQ_STOP:
+      exit(0);
+      break;
+    case REQ_WAIT:
+#ifndef _WIN32
+      wait(NULL);
+#else
+      caml_fatal_error("REQ_WAIT command");
+#endif
+      break;
+    case REQ_INITIAL_FRAME:
+      frame = Caml_state->extern_sp + 1;
+      /* Fall through */
+    case REQ_GET_FRAME:
+      caml_putword(dbg_out, Caml_state->stack_high - frame);
+      if (frame < Caml_state->stack_high &&
+          caml_find_code_fragment((char*) Pc(frame), &frag, &cf)) {
+        caml_putword(dbg_out, frag);
+        caml_putword(dbg_out, (char*) Pc(frame) - cf->code_start);
+      } else {
+        caml_putword(dbg_out, 0);
+        caml_putword(dbg_out, 0);
+      }
+      caml_flush(dbg_out);
+      break;
+    case REQ_SET_FRAME:
+      i = caml_getword(dbg_in);
+      frame = Caml_state->stack_high - i;
+      break;
+    case REQ_UP_FRAME:
+      i = caml_getword(dbg_in);
+      newframe = frame + Extra_args(frame) + i + 3;
+      if (newframe >= Caml_state->stack_high ||
+          !caml_find_code_fragment((char*) Pc(newframe), &frag, &cf)) {
+        caml_putword(dbg_out, -1);
+      } else {
+        frame = newframe;
+        caml_putword(dbg_out, Caml_state->stack_high - frame);
+        caml_putword(dbg_out, frag);
+        caml_putword(dbg_out, (char*) Pc(frame) - cf->code_start);
+      }
+      caml_flush(dbg_out);
+      break;
+    case REQ_SET_TRAP_BARRIER:
+      i = caml_getword(dbg_in);
+      Caml_state->trap_barrier = Caml_state->stack_high - i;
+      break;
+    case REQ_GET_LOCAL:
+      i = caml_getword(dbg_in);
+      putval(dbg_out, Locals(frame)[i]);
+      caml_flush(dbg_out);
+      break;
+    case REQ_GET_ENVIRONMENT:
+      i = caml_getword(dbg_in);
+      putval(dbg_out, Field(Env(frame), i));
+      caml_flush(dbg_out);
+      break;
+    case REQ_GET_GLOBAL:
+      i = caml_getword(dbg_in);
+      putval(dbg_out, Field(caml_global_data, i));
+      caml_flush(dbg_out);
+      break;
+    case REQ_GET_ACCU:
+      putval(dbg_out, *Caml_state->extern_sp);
+      caml_flush(dbg_out);
+      break;
+    case REQ_GET_HEADER:
+      val = getval(dbg_in);
+      caml_putword(dbg_out, Hd_val(val));
+      caml_flush(dbg_out);
+      break;
+    case REQ_GET_FIELD:
+      val = getval(dbg_in);
+      i = caml_getword(dbg_in);
+      if (Tag_val(val) != Double_array_tag) {
+        caml_putch(dbg_out, 0);
+        putval(dbg_out, Field(val, i));
+      } else {
+        double d = Double_flat_field(val, i);
+        caml_putch(dbg_out, 1);
+        caml_really_putblock(dbg_out, (char *) &d, 8);
+      }
+      caml_flush(dbg_out);
+      break;
+    case REQ_MARSHAL_OBJ:
+      val = getval(dbg_in);
+      safe_output_value(dbg_out, val);
+      caml_flush(dbg_out);
+      break;
+    case REQ_GET_CLOSURE_CODE:
+      val = getval(dbg_in);
+      found = caml_find_code_fragment((char*) Code_val(val), &frag, &cf);
+      CAMLassert(found);
+      caml_putword(dbg_out, frag);
+      caml_putword(dbg_out, (char*) Code_val(val) - cf->code_start);
+      caml_flush(dbg_out);
+      break;
+    case REQ_SET_FORK_MODE:
+      caml_debugger_fork_mode = caml_getword(dbg_in);
+      break;
+    }
+  }
+}
+
+void caml_debugger_cleanup_fork(void)
+{
+  /* We could remove all of the breakpoints, but closing the connection
+   * means that they'll just be skipped anyway. */
+  close_connection();
+  caml_debugger_in_use = 0;
+}
+
+#endif
diff --git a/runtime/domain.c b/runtime/domain.c
new file mode 100644
index 00000000..0850021f
--- /dev/null
+++ b/runtime/domain.c
@@ -0,0 +1,89 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*      KC Sivaramakrishnan, Indian Institute of Technology, Madras       */
+/*                 Stephen Dolan, University of Cambridge                 */
+/*                                                                        */
+/*   Copyright 2019 Indian Institute of Technology, Madras                */
+/*   Copyright 2019 University of Cambridge                               */
+/*                                                                        */
+/*   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
+
+#include "caml/domain_state.h"
+#include "caml/memory.h"
+
+CAMLexport caml_domain_state* Caml_state;
+
+void caml_init_domain ()
+{
+  if (Caml_state != NULL)
+    return;
+
+  Caml_state =
+    (caml_domain_state*)caml_stat_alloc_noexc(sizeof(caml_domain_state));
+  if (Caml_state == NULL)
+    caml_fatal_error ("cannot initialize domain state");
+
+  Caml_state->young_limit = NULL;
+  Caml_state->exception_pointer = NULL;
+
+  Caml_state->young_ptr = NULL;
+  Caml_state->young_base = NULL;
+  Caml_state->young_start = NULL;
+  Caml_state->young_end = NULL;
+  Caml_state->young_alloc_start = NULL;
+  Caml_state->young_alloc_mid = NULL;
+  Caml_state->young_alloc_end = NULL;
+  Caml_state->young_trigger = NULL;
+  Caml_state->minor_heap_wsz = 0;
+  Caml_state->in_minor_collection = 0;
+  Caml_state->extra_heap_resources_minor = 0;
+  caml_alloc_minor_tables();
+
+  Caml_state->stack_low = NULL;
+  Caml_state->stack_high = NULL;
+  Caml_state->stack_threshold = NULL;
+  Caml_state->extern_sp = NULL;
+  Caml_state->trapsp = NULL;
+  Caml_state->trap_barrier = NULL;
+  Caml_state->external_raise = NULL;
+  Caml_state->exn_bucket = Val_unit;
+
+  Caml_state->top_of_stack = NULL;
+  Caml_state->bottom_of_stack = NULL; /* no stack initially */
+  Caml_state->last_return_address = 1; /* not in OCaml code initially */
+  Caml_state->gc_regs = NULL;
+
+  Caml_state->stat_minor_words = 0.0;
+  Caml_state->stat_promoted_words = 0.0;
+  Caml_state->stat_major_words = 0.0;
+  Caml_state->stat_minor_collections = 0;
+  Caml_state->stat_major_collections = 0;
+  Caml_state->stat_heap_wsz = 0;
+  Caml_state->stat_top_heap_wsz = 0;
+  Caml_state->stat_compactions = 0;
+  Caml_state->stat_heap_chunks = 0;
+
+  Caml_state->backtrace_active = 0;
+  Caml_state->backtrace_pos = 0;
+  Caml_state->backtrace_buffer = NULL;
+  Caml_state->backtrace_last_exn = Val_unit;
+
+  Caml_state->compare_unordered = 0;
+  Caml_state->local_roots = NULL;
+  Caml_state->requested_major_slice = 0;
+  Caml_state->requested_minor_gc = 0;
+
+  Caml_state->eventlog_enabled = 0;
+  Caml_state->eventlog_paused = 0;
+  Caml_state->eventlog_startup_pid = 0;
+  Caml_state->eventlog_startup_timestamp = 0;
+  Caml_state->eventlog_out = NULL;
+}
diff --git a/runtime/dune b/runtime/dune
new file mode 100644
index 00000000..4b9c50af
--- /dev/null
+++ b/runtime/dune
@@ -0,0 +1,58 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+(rule
+ (targets primitives)
+ (mode    fallback)
+ (deps    alloc.c array.c compare.c extern.c floats.c gc_ctrl.c hash.c intern.c
+          interp.c ints.c io.c lexing.c md5.c meta.c obj.c parsing.c signals.c
+          str.c sys.c callback.c weak.c finalise.c stacks.c dynlink.c
+          backtrace_byt.c backtrace.c spacetime_byt.c afl.c bigarray.c)
+ (action  (with-stdout-to %{targets} (run %{dep:gen_primitives.sh}))))
+
+(rule
+ (targets libcamlrun.a)
+ (mode    fallback)
+ (deps    ../Makefile.config ../Makefile.common Makefile
+          (glob_files caml/*.h)
+          interp.c misc.c stacks.c fix_code.c startup_aux.c startup_byt.c
+          freelist.c major_gc.c minor_gc.c memory.c alloc.c roots_byt.c
+          globroots.c fail_byt.c signals.c signals_byt.c printexc.c
+          backtrace_byt.c backtrace.c compare.c ints.c floats.c str.c array.c
+          io.c extern.c intern.c hash.c sys.c meta.c parsing.c gc_ctrl.c md5.c
+          obj.c lexing.c callback.c debugger.c weak.c compact.c finalise.c
+          custom.c dynlink.c spacetime_byt.c afl.c unix.c win32.c bigarray.c
+          main.c memprof.c domain.c)
+ (action
+   (progn
+     (bash "touch .depend") ; hack.
+     (run make %{targets})
+     (bash "rm .depend"))))
+
+;; HACK
+(library
+  (name runtime)
+  (modes byte)
+  (wrapped false)
+  (modules runtime)
+  (flags (-nostdlib -nopervasives))
+  (self_build_stubs_archive (runtime)))
+
+(rule
+  (targets libruntime_stubs.a)
+  (action (copy libcamlrun.a %{targets})))
+
+(rule
+  (targets runtime.ml)
+  (action (write-file %{targets} "let linkme = ()")))
diff --git a/runtime/dynlink.c b/runtime/dynlink.c
new file mode 100644
index 00000000..2d61f53c
--- /dev/null
+++ b/runtime/dynlink.c
@@ -0,0 +1,304 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2000 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
+
+/* Dynamic loading of C primitives. */
+
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+#include <fcntl.h>
+#include <sys/stat.h>
+#include "caml/config.h"
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#include "caml/alloc.h"
+#include "caml/dynlink.h"
+#include "caml/fail.h"
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/osdeps.h"
+#include "caml/prims.h"
+#include "caml/signals.h"
+
+#ifndef NATIVE_CODE
+
+/* The table of primitives */
+struct ext_table caml_prim_table;
+
+#ifdef DEBUG
+/* The names of primitives (for instrtrace.c) */
+struct ext_table caml_prim_name_table;
+#endif
+
+/* The table of shared libraries currently opened */
+static struct ext_table shared_libs;
+
+/* The search path for shared libraries */
+struct ext_table caml_shared_libs_path;
+
+/* Look up the given primitive name in the built-in primitive table,
+   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++) {
+    if (strcmp(name, caml_names_of_builtin_cprim[i]) == 0)
+      return caml_builtin_cprim[i];
+  }
+  for (i = 0; i < shared_libs.size; i++) {
+    res = caml_dlsym(shared_libs.contents[i], name);
+    if (res != NULL) return (c_primitive) res;
+  }
+  return NULL;
+}
+
+/* Parse the OCAML_STDLIB_DIR/ld.conf file and add the directories
+   listed there to the search path */
+
+#define LD_CONF_NAME T("ld.conf")
+
+static char_os * parse_ld_conf(void)
+{
+  char_os * stdlib, * ldconfname, * wconfig, * p, * q;
+  char * config;
+#ifdef _WIN32
+  struct _stati64 st;
+#else
+  struct stat st;
+#endif
+  int ldconf, nread;
+
+  stdlib = caml_secure_getenv(T("OCAMLLIB"));
+  if (stdlib == NULL) stdlib = caml_secure_getenv(T("CAMLLIB"));
+  if (stdlib == NULL) stdlib = OCAML_STDLIB_DIR;
+  ldconfname = caml_stat_strconcat_os(3, stdlib, T("/"), LD_CONF_NAME);
+  if (stat_os(ldconfname, &st) == -1) {
+    caml_stat_free(ldconfname);
+    return NULL;
+  }
+  ldconf = open_os(ldconfname, O_RDONLY, 0);
+  if (ldconf == -1)
+    caml_fatal_error("cannot read loader config file %s",
+                         caml_stat_strdup_of_os(ldconfname));
+  config = caml_stat_alloc(st.st_size + 1);
+  nread = read(ldconf, config, st.st_size);
+  if (nread == -1)
+    caml_fatal_error
+      ("error while reading loader config file %s",
+       caml_stat_strdup_of_os(ldconfname));
+  config[nread] = 0;
+  wconfig = caml_stat_strdup_to_os(config);
+  caml_stat_free(config);
+  q = wconfig;
+  for (p = wconfig; *p != 0; p++) {
+    if (*p == '\n') {
+      *p = 0;
+      caml_ext_table_add(&caml_shared_libs_path, q);
+      q = p + 1;
+    }
+  }
+  if (q < p) caml_ext_table_add(&caml_shared_libs_path, q);
+  close(ldconf);
+  caml_stat_free(ldconfname);
+  return wconfig;
+}
+
+/* Open the given shared library and add it to shared_libs.
+   Abort on error. */
+static void open_shared_lib(char_os * name)
+{
+  char_os * realname;
+  char * u8;
+  void * handle;
+
+  realname = caml_search_dll_in_path(&caml_shared_libs_path, name);
+  u8 = caml_stat_strdup_of_os(realname);
+  caml_gc_message(0x100, "Loading shared library %s\n", u8);
+  caml_stat_free(u8);
+  caml_enter_blocking_section();
+  handle = caml_dlopen(realname, 1, 1);
+  caml_leave_blocking_section();
+  if (handle == NULL)
+    caml_fatal_error
+    (
+      "cannot load shared library %s\n"
+      "Reason: %s",
+      caml_stat_strdup_of_os(name),
+      caml_dlerror()
+    );
+  caml_ext_table_add(&shared_libs, handle);
+  caml_stat_free(realname);
+}
+
+/* Build the table of primitives, given a search path and a list
+   of shared libraries (both 0-separated in a char array).
+   Abort the runtime system on error. */
+void caml_build_primitive_table(char_os * lib_path,
+                                char_os * libs,
+                                char * req_prims)
+{
+  char_os * tofree1, * tofree2;
+  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
+     - directories specified in the executable
+     - directories specified in the file <stdlib>/ld.conf */
+  tofree1 = 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)
+      caml_ext_table_add(&caml_shared_libs_path, p);
+  tofree2 = 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)
+      open_shared_lib(p);
+  /* Build the primitive table */
+  caml_ext_table_init(&caml_prim_table, 0x180);
+#ifdef DEBUG
+  caml_ext_table_init(&caml_prim_name_table, 0x180);
+#endif
+  for (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);
+    caml_ext_table_add(&caml_prim_table, (void *) prim);
+#ifdef DEBUG
+    caml_ext_table_add(&caml_prim_name_table, caml_stat_strdup(q));
+#endif
+  }
+  /* Clean up */
+  caml_stat_free(tofree1);
+  caml_stat_free(tofree2);
+  caml_ext_table_free(&caml_shared_libs_path, 0);
+}
+
+/* Build the table of primitives as a copy of the builtin primitive table.
+   Used for executables generated by ocamlc -output-obj. */
+
+void caml_build_primitive_table_builtin(void)
+{
+  int i;
+  caml_ext_table_init(&caml_prim_table, 0x180);
+#ifdef DEBUG
+  caml_ext_table_init(&caml_prim_name_table, 0x180);
+#endif
+  for (i = 0; caml_builtin_cprim[i] != 0; i++) {
+    caml_ext_table_add(&caml_prim_table, (void *) caml_builtin_cprim[i]);
+#ifdef DEBUG
+    caml_ext_table_add(&caml_prim_name_table,
+                       caml_stat_strdup(caml_names_of_builtin_cprim[i]));
+#endif
+  }
+}
+
+void caml_free_shared_libs(void)
+{
+  while (shared_libs.size > 0)
+    caml_dlclose(shared_libs.contents[--shared_libs.size]);
+}
+
+#endif /* NATIVE_CODE */
+
+/** dlopen interface for the bytecode linker **/
+
+#define Handle_val(v) (*((void **) (v)))
+
+CAMLprim value caml_dynlink_open_lib(value mode, value filename)
+{
+  void * handle;
+  value result;
+  char_os * p;
+
+  caml_gc_message(0x100, "Opening shared library %s\n",
+                  String_val(filename));
+  p = caml_stat_strdup_to_os(String_val(filename));
+  caml_enter_blocking_section();
+  handle = caml_dlopen(p, Int_val(mode), 1);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (handle == NULL) caml_failwith(caml_dlerror());
+  result = caml_alloc_small(1, Abstract_tag);
+  Handle_val(result) = handle;
+  return result;
+}
+
+CAMLprim value caml_dynlink_close_lib(value handle)
+{
+  caml_dlclose(Handle_val(handle));
+  return Val_unit;
+}
+
+/*#include <stdio.h>*/
+CAMLprim value caml_dynlink_lookup_symbol(value handle, value symbolname)
+{
+  void * symb;
+  value result;
+  symb = caml_dlsym(Handle_val(handle), String_val(symbolname));
+  /* printf("%s = 0x%lx\n", String_val(symbolname), symb);
+     fflush(stdout); */
+  if (symb == NULL) return Val_unit /*caml_failwith(caml_dlerror())*/;
+  result = caml_alloc_small(1, Abstract_tag);
+  Handle_val(result) = symb;
+  return result;
+}
+
+#ifndef NATIVE_CODE
+
+CAMLprim value caml_dynlink_add_primitive(value handle)
+{
+  return Val_int(caml_ext_table_add(&caml_prim_table, Handle_val(handle)));
+}
+
+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++) {
+    value v = caml_alloc_small(1, Abstract_tag);
+    Handle_val(v) = shared_libs.contents[i];
+    Store_field(res, i, v);
+  }
+  CAMLreturn(res);
+}
+
+#else
+
+value caml_dynlink_add_primitive(value handle)
+{
+  caml_invalid_argument("dynlink_add_primitive");
+  return Val_unit; /* not reached */
+}
+
+value caml_dynlink_get_current_libs(value unit)
+{
+  caml_invalid_argument("dynlink_get_current_libs");
+  return Val_unit; /* not reached */
+}
+
+#endif /* NATIVE_CODE */
diff --git a/runtime/dynlink_nat.c b/runtime/dynlink_nat.c
new file mode 100644
index 00000000..95626109
--- /dev/null
+++ b/runtime/dynlink_nat.c
@@ -0,0 +1,185 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Alain Frisch, projet Gallium, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2007 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
+
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+#include "caml/stack.h"
+#include "caml/callback.h"
+#include "caml/alloc.h"
+#include "caml/intext.h"
+#include "caml/osdeps.h"
+#include "caml/fail.h"
+#include "caml/signals.h"
+#ifdef WITH_SPACETIME
+#include "caml/spacetime.h"
+#endif
+
+#include "caml/hooks.h"
+
+CAMLexport void (*caml_natdynlink_hook)(void* handle, const char* unit) = NULL;
+
+#include <stdio.h>
+#include <string.h>
+#include <limits.h>
+
+#define Handle_val(v) (*((void **) Data_abstract_val(v)))
+static value Val_handle(void* handle) {
+  value res = caml_alloc_small(1, Abstract_tag);
+  Handle_val(res) = handle;
+  return res;
+}
+
+static void *getsym(void *handle, const char *module, const char *name){
+  char *fullname = caml_stat_strconcat(3, "caml", module, name);
+  void *sym;
+  sym = caml_dlsym (handle, fullname);
+  /*  printf("%s => %lx\n", fullname, (uintnat) sym); */
+  caml_stat_free(fullname);
+  return sym;
+}
+
+CAMLprim value caml_natdynlink_getmap(value unit)
+{
+  return caml_input_value_from_block(caml_globals_map, INT_MAX);
+}
+
+CAMLprim value caml_natdynlink_globals_inited(value unit)
+{
+  return Val_int(caml_globals_inited);
+}
+
+CAMLprim value caml_natdynlink_open(value filename, value global)
+{
+  CAMLparam2 (filename, global);
+  CAMLlocal3 (res, handle, header);
+  void *sym;
+  void *dlhandle;
+  char_os *p;
+
+  /* TODO: dlclose in case of error... */
+
+  p = caml_stat_strdup_to_os(String_val(filename));
+  caml_enter_blocking_section();
+  dlhandle = caml_dlopen(p, 1, Int_val(global));
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+
+  if (NULL == dlhandle)
+    caml_failwith(caml_dlerror());
+
+  sym = caml_dlsym(dlhandle, "caml_plugin_header");
+  if (NULL == sym)
+    caml_failwith("not an OCaml plugin");
+
+  handle = Val_handle(dlhandle);
+  header = caml_input_value_from_block(sym, INT_MAX);
+
+  res = caml_alloc_tuple(2);
+  Field(res, 0) = handle;
+  Field(res, 1) = header;
+  CAMLreturn(res);
+}
+
+CAMLprim value caml_natdynlink_run(value handle_v, value symbol) {
+  CAMLparam2 (handle_v, symbol);
+  CAMLlocal1 (result);
+  void *sym,*sym2;
+  void* handle = Handle_val(handle_v);
+  struct code_fragment * cf;
+
+#define optsym(n) getsym(handle,unit,n)
+  const char *unit;
+  void (*entrypoint)(void);
+
+  unit = String_val(symbol);
+
+  sym = optsym("__frametable");
+  if (NULL != sym) caml_register_frametable(sym);
+
+#ifdef WITH_SPACETIME
+  sym = optsym("__spacetime_shapes");
+  if (NULL != sym) caml_spacetime_register_shapes(sym);
+#endif
+
+  sym = optsym("__gc_roots");
+  if (NULL != sym) caml_register_dyn_global(sym);
+
+  sym = optsym("__data_begin");
+  sym2 = optsym("__data_end");
+  if (NULL != sym && NULL != sym2)
+    caml_page_table_add(In_static_data, sym, sym2);
+
+  sym = optsym("__code_begin");
+  sym2 = optsym("__code_end");
+  if (NULL != sym && NULL != sym2) {
+    caml_page_table_add(In_code_area, sym, sym2);
+    cf = caml_stat_alloc(sizeof(struct code_fragment));
+    cf->code_start = (char *) sym;
+    cf->code_end = (char *) sym2;
+    cf->digest_computed = 0;
+    caml_ext_table_add(&caml_code_fragments_table, cf);
+  }
+
+  if( caml_natdynlink_hook != NULL ) caml_natdynlink_hook(handle,unit);
+
+  entrypoint = optsym("__entry");
+  if (NULL != entrypoint) result = caml_callback((value)(&entrypoint), 0);
+  else result = Val_unit;
+
+#undef optsym
+
+  CAMLreturn (result);
+}
+
+CAMLprim value caml_natdynlink_run_toplevel(value filename, value symbol)
+{
+  CAMLparam2 (filename, symbol);
+  CAMLlocal3 (res, v, handle_v);
+  void *handle;
+  char_os *p;
+
+  /* TODO: dlclose in case of error... */
+
+  p = caml_stat_strdup_to_os(String_val(filename));
+  caml_enter_blocking_section();
+  handle = caml_dlopen(p, 1, 1);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+
+  if (NULL == handle) {
+    res = caml_alloc(1,1);
+    v = caml_copy_string(caml_dlerror());
+    Store_field(res, 0, v);
+  } else {
+    handle_v = Val_handle(handle);
+    res = caml_alloc(1,0);
+    v = caml_natdynlink_run(handle_v, symbol);
+    Store_field(res, 0, v);
+  }
+  CAMLreturn(res);
+}
+
+CAMLprim value caml_natdynlink_loadsym(value symbol)
+{
+  CAMLparam1 (symbol);
+  CAMLlocal1 (sym);
+
+  sym = (value) caml_globalsym(String_val(symbol));
+  if (!sym) caml_failwith(String_val(symbol));
+  CAMLreturn(sym);
+}
diff --git a/runtime/eventlog.c b/runtime/eventlog.c
new file mode 100644
index 00000000..6d3bd7ca
--- /dev/null
+++ b/runtime/eventlog.c
@@ -0,0 +1,396 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                 Stephen Dolan, University of Cambridge                 */
+/*                      Enguerrand Decorne, Tarides                       */
+/*                                                                        */
+/*   Copyright 2020 University of Cambridge                               */
+/*   Copyright 2020 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#define CAML_INTERNALS
+#include <stdio.h>
+#include <string.h>
+#include "caml/alloc.h"
+#include "caml/eventlog.h"
+#include "caml/misc.h"
+#include "caml/memory.h"
+#include "caml/osdeps.h"
+
+
+#ifdef _WIN32
+#include <wtypes.h>
+#include <process.h>
+#elif defined(HAS_UNISTD)
+#include <unistd.h>
+#endif
+
+#ifdef HAS_MACH_ABSOLUTE_TIME
+#include <mach/mach_time.h>
+#elif HAS_POSIX_MONOTONIC_CLOCK
+#include <time.h>
+#endif
+
+#ifdef CAML_INSTR
+
+#define CTF_MAGIC 0xc1fc1fc1
+#define CAML_TRACE_VERSION 0x1
+
+struct ctf_stream_header {
+  uint32_t magic;
+  uint16_t caml_trace_version;
+  uint16_t stream_id;
+};
+
+static struct ctf_stream_header header = {
+  CTF_MAGIC,
+  CAML_TRACE_VERSION,
+  0
+};
+
+#pragma pack(1)
+struct ctf_event_header {
+  uint64_t timestamp;
+  uint32_t pid;
+  uint32_t id;
+};
+
+struct event {
+  struct ctf_event_header header;
+  uint16_t  phase; /* for GC events */
+  uint16_t  counter_kind; /* misc counter name */
+  uint8_t  alloc_bucket; /* for alloc counters */
+  uint64_t count; /* for misc counters */
+};
+
+#define EVENT_BUF_SIZE 4096
+struct event_buffer {
+  uintnat ev_generated;
+  struct event events[EVENT_BUF_SIZE];
+};
+
+static struct event_buffer* evbuf;
+
+static int64_t time_counter(void)
+{
+#ifdef _WIN32
+  static double clock_freq = 0;
+  static LARGE_INTEGER now;
+
+  if (clock_freq == 0) {
+    LARGE_INTEGER f;
+    if (!QueryPerformanceFrequency(&f))
+      return 0;
+    clock_freq = (1000000000.0 / f.QuadPart);
+  };
+
+  if (!QueryPerformanceCounter(&now))
+    return 0;
+  return (int64_t)(now.QuadPart * clock_freq);
+
+#elif defined(HAS_MACH_ABSOLUTE_TIME)
+  static mach_timebase_info_data_t time_base = {0};
+
+  if (time_base.denom == 0) {
+    if (mach_timebase_info (&time_base) != KERN_SUCCESS)
+      return 0;
+
+    if (time_base.denom == 0)
+      return 0;
+  }
+
+  uint64_t now = mach_absolute_time ();
+  return (int64_t)((now * time_base.numer) / time_base.denom);
+
+#elif defined(HAS_POSIX_MONOTONIC_CLOCK)
+  struct timespec t;
+  clock_gettime(CLOCK_MONOTONIC, &t);
+  return
+    (int64_t)t.tv_sec  * (int64_t)1000000000 +
+    (int64_t)t.tv_nsec;
+
+
+#endif
+}
+
+static void setup_evbuf()
+{
+  CAMLassert(!evbuf);
+  evbuf = caml_stat_alloc_noexc(sizeof(*evbuf));
+
+  if (evbuf == NULL)
+    caml_fatal_error("eventlog: could not allocate event buffer");
+
+  evbuf->ev_generated = 0;
+}
+
+#define OUTPUT_FILE_LEN 4096
+static void setup_eventlog_file()
+{
+  char_os output_file[OUTPUT_FILE_LEN];
+  char_os *eventlog_filename = NULL;
+
+  eventlog_filename = caml_secure_getenv(T("OCAML_EVENTLOG_PREFIX"));
+
+  if (eventlog_filename) {
+    int ret = snprintf_os(output_file, OUTPUT_FILE_LEN, T("%s.%d.eventlog"),
+                         eventlog_filename, Caml_state->eventlog_startup_pid);
+    if (ret > OUTPUT_FILE_LEN)
+      caml_fatal_error("eventlog: specified OCAML_EVENTLOG_PREFIX is too long");
+  } else {
+    snprintf_os(output_file, OUTPUT_FILE_LEN, T("caml-%d.eventlog"),
+               Caml_state->eventlog_startup_pid);
+  }
+
+  Caml_state->eventlog_out = fopen_os(output_file, T("wb"));
+
+  if (Caml_state->eventlog_out) {
+    int ret =  fwrite(&header, sizeof(struct ctf_stream_header),
+                      1, Caml_state->eventlog_out);
+    if (ret != 1)
+      caml_eventlog_disable();
+    fflush(Caml_state->eventlog_out);
+  } else {
+    caml_fatal_error("eventlog: could not open trace for writing");
+  }
+}
+#undef OUTPUT_FILE_LEN
+
+#define FWRITE_EV(item, size) \
+  if (fwrite(item, size, 1, out) != 1) \
+    goto fwrite_failure;
+
+static void flush_events(FILE* out, struct event_buffer* eb)
+{
+  uintnat i;
+  uint64_t flush_duration;
+  uintnat n = eb->ev_generated;
+
+  struct ctf_event_header ev_flush;
+  ev_flush.id = EV_FLUSH;
+  ev_flush.timestamp = time_counter() -
+                        Caml_state->eventlog_startup_timestamp;
+  ev_flush.pid = Caml_state->eventlog_startup_pid;
+
+  for (i = 0; i < n; i++) {
+    struct event ev = eb->events[i];
+    ev.header.pid = Caml_state->eventlog_startup_pid;
+
+    FWRITE_EV(&ev.header, sizeof(struct ctf_event_header));
+
+    switch (ev.header.id)
+    {
+    case EV_ENTRY:
+      FWRITE_EV(&ev.phase, sizeof(uint16_t));
+      break;
+    case EV_EXIT:
+      FWRITE_EV(&ev.phase, sizeof(uint16_t));
+      break;
+    case EV_COUNTER:
+      FWRITE_EV(&ev.count, sizeof(uint64_t));
+      FWRITE_EV(&ev.counter_kind, sizeof(uint16_t));
+      break;
+    case EV_ALLOC:
+      FWRITE_EV(&ev.count, sizeof(uint64_t));
+      FWRITE_EV(&ev.alloc_bucket, sizeof(uint8_t));
+      break;
+    default:
+      break;
+    }
+  }
+
+  flush_duration =
+    (time_counter() - Caml_state->eventlog_startup_timestamp) -
+    ev_flush.timestamp;
+
+  FWRITE_EV(&ev_flush, sizeof(struct ctf_event_header));
+  FWRITE_EV(&flush_duration, sizeof(uint64_t));
+
+  return;
+
+ fwrite_failure:
+  /* on event flush failure, shut down eventlog. */
+  if (caml_runtime_warnings_active())
+    fprintf(stderr,
+           "[ocaml] error while writing trace file, disabling eventlog\n");
+  caml_eventlog_disable();
+  return;
+
+}
+
+static void teardown_eventlog(void)
+{
+  if (evbuf) {
+    if (Caml_state->eventlog_out)
+      flush_events(Caml_state->eventlog_out, evbuf);
+    caml_stat_free(evbuf);
+    evbuf = NULL;
+  }
+  if (Caml_state->eventlog_out) {
+    fclose(Caml_state->eventlog_out);
+    Caml_state->eventlog_out = NULL;
+  }
+}
+
+void caml_eventlog_init()
+{
+  char_os *toggle = caml_secure_getenv(T("OCAML_EVENTLOG_ENABLED"));
+
+  if (toggle != NULL) {
+    Caml_state->eventlog_enabled = 1;
+    if (*toggle == 'p')
+      Caml_state->eventlog_paused = 1;
+  };
+
+  if (!Caml_state->eventlog_enabled) return;
+
+  Caml_state->eventlog_startup_timestamp = time_counter();
+#ifdef _WIN32
+  Caml_state->eventlog_startup_pid = _getpid();
+#else
+  Caml_state->eventlog_startup_pid = getpid();
+#endif
+
+  setup_eventlog_file();
+  setup_evbuf();
+
+  atexit(&teardown_eventlog);
+}
+
+static void post_event(ev_gc_phase phase, ev_gc_counter counter_kind,
+                       uint8_t bucket, uint64_t count, ev_type ty)
+{
+  uintnat i;
+  struct event* ev;
+
+  if (!Caml_state->eventlog_enabled) return;
+  if (Caml_state->eventlog_paused) return;
+
+  i = evbuf->ev_generated;
+  CAMLassert(i <= EVENT_BUF_SIZE);
+  if (i == EVENT_BUF_SIZE) {
+    flush_events(Caml_state->eventlog_out, evbuf);
+    evbuf->ev_generated = 0;
+    i = 0;
+  }
+  ev = &evbuf->events[i];
+  ev->header.id = ty;
+  ev->count = count;
+  ev->counter_kind = counter_kind;
+  ev->alloc_bucket = bucket;
+  ev->phase = phase;
+  ev->header.timestamp = time_counter() -
+                           Caml_state->eventlog_startup_timestamp;
+  evbuf->ev_generated = i + 1;
+}
+
+void caml_ev_begin(ev_gc_phase phase)
+{
+  post_event(phase, 0, 0, 0, EV_ENTRY);
+}
+
+void caml_ev_end(ev_gc_phase phase)
+{
+  post_event(phase, 0, 0, 0, EV_EXIT);
+}
+
+void caml_ev_counter(ev_gc_counter counter, uint64_t val)
+{
+  post_event(0, counter, 0, val, EV_COUNTER);
+}
+
+static uint64_t alloc_buckets [20] = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
+
+/* This function records allocations in caml_alloc_shr_aux in given bucket sizes
+   These buckets are meant to be flushed explicitly by the caller through the
+   caml_ev_alloc_flush function. Until then the buckets are just updated until
+   flushed.
+*/
+void caml_ev_alloc(uint64_t sz)
+{
+  if (!Caml_state->eventlog_enabled) return;
+  if (Caml_state->eventlog_paused) return;
+
+  if (sz < 10) {
+    ++alloc_buckets[sz];
+  } else if (sz < 100) {
+    ++alloc_buckets[sz/10 + 9];
+  } else {
+    ++alloc_buckets[19];
+  }
+}
+
+/*  Note that this function does not trigger an actual disk flush, it just
+    pushes events in the event buffer.
+*/
+void caml_ev_alloc_flush()
+{
+  int i;
+
+  if (!Caml_state->eventlog_enabled) return;
+  if (Caml_state->eventlog_paused) return;
+
+  for (i = 1; i < 20; i++) {
+    if (alloc_buckets[i] != 0) {
+      post_event(0, 0, i, alloc_buckets[i], EV_ALLOC);
+    };
+    alloc_buckets[i] = 0;
+  }
+}
+
+void caml_ev_flush()
+{
+  if (!Caml_state->eventlog_enabled) return;
+  if (Caml_state->eventlog_paused) return;
+
+  if (Caml_state->eventlog_out) {
+    if (evbuf)
+      flush_events(Caml_state->eventlog_out, evbuf);
+    fflush(Caml_state->eventlog_out);
+  };
+}
+
+void caml_eventlog_disable()
+{
+  Caml_state->eventlog_enabled = 0;
+  teardown_eventlog();
+}
+
+CAMLprim value caml_eventlog_resume(value v)
+{
+  CAMLassert(v == Val_unit);
+  if (Caml_state->eventlog_enabled)
+    Caml_state->eventlog_paused = 0;
+  return Val_unit;
+}
+
+CAMLprim value caml_eventlog_pause(value v)
+{
+  CAMLassert(v == Val_unit);
+  if (Caml_state->eventlog_enabled) {
+    Caml_state->eventlog_paused = 1;
+    if (evbuf && Caml_state->eventlog_out)
+      flush_events(Caml_state->eventlog_out, evbuf);
+  };
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value caml_eventlog_resume(value v)
+{
+  return Val_unit;
+}
+
+CAMLprim value caml_eventlog_pause(value v)
+{
+  return Val_unit;
+}
+
+#endif /*CAML_INSTR*/
diff --git a/runtime/extern.c b/runtime/extern.c
new file mode 100644
index 00000000..7613e280
--- /dev/null
+++ b/runtime/extern.c
@@ -0,0 +1,1037 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* Structured output */
+
+/* The interface of this file is "caml/intext.h" */
+
+#include <string.h>
+#include "caml/alloc.h"
+#include "caml/config.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/gc.h"
+#include "caml/intext.h"
+#include "caml/io.h"
+#include "caml/md5.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/reverse.h"
+
+static uintnat obj_counter;  /* Number of objects emitted so far */
+static uintnat size_32;  /* Size in words of 32-bit block for struct. */
+static uintnat size_64;  /* Size in words of 64-bit block for struct. */
+
+/* Flags affecting marshaling */
+
+enum {
+  NO_SHARING = 1,               /* Flag to ignore sharing */
+  CLOSURES = 2,                 /* Flag to allow marshaling code pointers */
+  COMPAT_32 = 4                 /* Flag to ensure that output can safely
+                                   be read back on a 32-bit platform */
+};
+
+static int extern_flags;        /* logical or of some of the flags above */
+
+/* Stack for pending values to marshal */
+
+struct extern_item { value * v; mlsize_t count; };
+
+#define EXTERN_STACK_INIT_SIZE 256
+#define EXTERN_STACK_MAX_SIZE (1024*1024*100)
+
+static struct extern_item extern_stack_init[EXTERN_STACK_INIT_SIZE];
+
+static struct extern_item * extern_stack = extern_stack_init;
+static struct extern_item * extern_stack_limit = extern_stack_init
+                                                   + EXTERN_STACK_INIT_SIZE;
+
+/* Hash table to record already-marshaled objects and their positions */
+
+struct object_position { value obj; uintnat pos; };
+
+/* The hash table uses open addressing, linear probing, and a redundant
+   representation:
+   - a bitvector [present] records which entries of the table are occupied;
+   - an array [entries] records (object, position) pairs for the entries
+     that are occupied.
+   The bitvector is much smaller than the array (1/128th on 64-bit
+   platforms, 1/64th on 32-bit platforms), so it has better locality,
+   making it faster to determine that an object is not in the table.
+   Also, it makes it faster to empty or initialize a table: only the
+   [present] bitvector needs to be filled with zeros, the [entries]
+   array can be left uninitialized.
+*/
+
+struct position_table {
+  int shift;
+  mlsize_t size;                    /* size == 1 << (wordsize - shift) */
+  mlsize_t mask;                    /* mask == size - 1 */
+  mlsize_t threshold;               /* threshold == a fixed fraction of size */
+  uintnat * present;                /* [Bitvect_size(size)] */
+  struct object_position * entries; /* [size]  */
+};
+
+#define Bits_word (8 * sizeof(uintnat))
+#define Bitvect_size(n) (((n) + Bits_word - 1) / Bits_word)
+
+#define POS_TABLE_INIT_SIZE_LOG2 8
+#define POS_TABLE_INIT_SIZE (1 << POS_TABLE_INIT_SIZE_LOG2)
+
+static uintnat pos_table_present_init[Bitvect_size(POS_TABLE_INIT_SIZE)];
+static struct object_position pos_table_entries_init[POS_TABLE_INIT_SIZE];
+
+static struct position_table pos_table;
+
+/* Forward declarations */
+
+CAMLnoreturn_start
+static void extern_out_of_memory(void)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+static void extern_invalid_argument(char *msg)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+static void extern_failwith(char *msg)
+CAMLnoreturn_end;
+
+CAMLnoreturn_start
+static void extern_stack_overflow(void)
+CAMLnoreturn_end;
+
+static void free_extern_output(void);
+
+/* Free the extern stack if needed */
+static void extern_free_stack(void)
+{
+  if (extern_stack != extern_stack_init) {
+    caml_stat_free(extern_stack);
+    /* Reinitialize the globals for next time around */
+    extern_stack = extern_stack_init;
+    extern_stack_limit = extern_stack + EXTERN_STACK_INIT_SIZE;
+  }
+}
+
+static struct extern_item * extern_resize_stack(struct extern_item * sp)
+{
+  asize_t newsize = 2 * (extern_stack_limit - extern_stack);
+  asize_t sp_offset = sp - extern_stack;
+  struct extern_item * newstack;
+
+  if (newsize >= EXTERN_STACK_MAX_SIZE) extern_stack_overflow();
+  if (extern_stack == extern_stack_init) {
+    newstack = caml_stat_alloc_noexc(sizeof(struct extern_item) * newsize);
+    if (newstack == NULL) extern_stack_overflow();
+    memcpy(newstack, extern_stack_init,
+           sizeof(struct extern_item) * EXTERN_STACK_INIT_SIZE);
+  } else {
+    newstack = caml_stat_resize_noexc(extern_stack,
+                                      sizeof(struct extern_item) * newsize);
+    if (newstack == NULL) extern_stack_overflow();
+  }
+  extern_stack = newstack;
+  extern_stack_limit = newstack + newsize;
+  return newstack + sp_offset;
+}
+
+/* Multiplicative Fibonacci hashing
+   (Knuth, TAOCP vol 3, section 6.4, page 518).
+   HASH_FACTOR is (sqrt(5) - 1) / 2 * 2^wordsize. */
+#ifdef ARCH_SIXTYFOUR
+#define HASH_FACTOR 11400714819323198486UL
+#else
+#define HASH_FACTOR 2654435769UL
+#endif
+#define Hash(v) (((uintnat)(v) * HASH_FACTOR) >> pos_table.shift)
+
+/* When the table becomes 2/3 full, its size is increased. */
+#define Threshold(sz) (((sz) * 2) / 3)
+
+/* Initialize the position table */
+
+static void extern_init_position_table(void)
+{
+  if (extern_flags & NO_SHARING) return;
+  pos_table.size = POS_TABLE_INIT_SIZE;
+  pos_table.shift = 8 * sizeof(value) - POS_TABLE_INIT_SIZE_LOG2;
+  pos_table.mask = POS_TABLE_INIT_SIZE - 1;
+  pos_table.threshold = Threshold(POS_TABLE_INIT_SIZE);
+  pos_table.present = pos_table_present_init;
+  pos_table.entries = pos_table_entries_init;
+  memset(pos_table_present_init, 0, sizeof(pos_table_present_init));
+}
+
+/* Free the position table */
+
+static void extern_free_position_table(void)
+{
+  if (pos_table.present != pos_table_present_init) {
+    caml_stat_free(pos_table.present);
+    caml_stat_free(pos_table.entries);
+    /* Protect against repeated calls to extern_free_position_table */
+    pos_table.present = pos_table_present_init;
+  }
+}
+
+/* Accessing bitvectors */
+
+Caml_inline uintnat bitvect_test(uintnat * bv, uintnat i)
+{
+  return bv[i / Bits_word] & ((uintnat) 1 << (i & (Bits_word - 1)));
+}
+
+Caml_inline void bitvect_set(uintnat * bv, uintnat i)
+{
+  bv[i / Bits_word] |= ((uintnat) 1 << (i & (Bits_word - 1)));
+}
+
+/* Grow the position table */
+
+static void extern_resize_position_table(void)
+{
+  mlsize_t new_size, new_byte_size;
+  int new_shift;
+  uintnat * new_present;
+  struct object_position * new_entries;
+  uintnat i, h;
+  struct position_table old = pos_table;
+
+  /* Grow the table quickly (x 8) up to 10^6 entries,
+     more slowly (x 2) afterwards. */
+  if (old.size < 1000000) {
+    new_size = 8 * old.size;
+    new_shift = old.shift - 3;
+  } else {
+    new_size = 2 * old.size;
+    new_shift = old.shift - 1;
+  }
+  if (new_size == 0
+      || caml_umul_overflow(new_size, sizeof(struct object_position),
+                            &new_byte_size))
+    extern_out_of_memory();
+  new_entries = caml_stat_alloc_noexc(new_byte_size);
+  if (new_entries == NULL) extern_out_of_memory();
+  new_present =
+    caml_stat_calloc_noexc(Bitvect_size(new_size), sizeof(uintnat));
+  if (new_present == NULL) {
+    caml_stat_free(new_entries);
+    extern_out_of_memory();
+  }
+  pos_table.size = new_size;
+  pos_table.shift = new_shift;
+  pos_table.mask = new_size - 1;
+  pos_table.threshold = Threshold(new_size);
+  pos_table.present = new_present;
+  pos_table.entries = new_entries;
+
+  /* Insert every entry of the old table in the new table */
+  for (i = 0; i < old.size; i++) {
+    if (! bitvect_test(old.present, i)) continue;
+    h = Hash(old.entries[i].obj);
+    while (bitvect_test(new_present, h)) {
+      h = (h + 1) & pos_table.mask;
+    }
+    bitvect_set(new_present, h);
+    new_entries[h] = old.entries[i];
+  }
+
+  /* Free the old tables if not statically allocated */
+  if (old.present != pos_table_present_init) {
+    caml_stat_free(old.present);
+    caml_stat_free(old.entries);
+  }
+}
+
+/* Determine whether the given object [obj] is in the hash table.
+   If so, set [*pos_out] to its position in the output and return 1.
+   If not, set [*h_out] to the hash value appropriate for
+   [extern_record_location] and return 0. */
+
+Caml_inline int extern_lookup_position(value obj,
+                                       uintnat * pos_out, uintnat * h_out)
+{
+  uintnat h = Hash(obj);
+  while (1) {
+    if (! bitvect_test(pos_table.present, h)) {
+      *h_out = h;
+      return 0;
+    }
+    if (pos_table.entries[h].obj == obj) {
+      *pos_out = pos_table.entries[h].pos;
+      return 1;
+    }
+    h = (h + 1) & pos_table.mask;
+  }
+}
+
+/* Record the output position for the given object [obj]. */
+/* The [h] parameter is the index in the hash table where the object
+   must be inserted.  It was determined during lookup. */
+
+static void extern_record_location(value obj, uintnat h)
+{
+  if (extern_flags & NO_SHARING) return;
+  bitvect_set(pos_table.present, h);
+  pos_table.entries[h].obj = obj;
+  pos_table.entries[h].pos = obj_counter;
+  obj_counter++;
+  if (obj_counter >= pos_table.threshold) extern_resize_position_table();
+}
+
+/* To buffer the output */
+
+static char * extern_userprovided_output;
+static char * extern_ptr, * extern_limit;
+
+struct output_block {
+  struct output_block * next;
+  char * end;
+  char data[SIZE_EXTERN_OUTPUT_BLOCK];
+};
+
+static struct output_block * extern_output_first, * extern_output_block;
+
+static void init_extern_output(void)
+{
+  extern_userprovided_output = NULL;
+  extern_output_first = caml_stat_alloc_noexc(sizeof(struct output_block));
+  if (extern_output_first == NULL) caml_raise_out_of_memory();
+  extern_output_block = extern_output_first;
+  extern_output_block->next = NULL;
+  extern_ptr = extern_output_block->data;
+  extern_limit = extern_output_block->data + SIZE_EXTERN_OUTPUT_BLOCK;
+}
+
+static void close_extern_output(void)
+{
+  if (extern_userprovided_output == NULL){
+    extern_output_block->end = extern_ptr;
+  }
+}
+
+static void free_extern_output(void)
+{
+  struct output_block * blk, * nextblk;
+
+  if (extern_userprovided_output == NULL) {
+    for (blk = extern_output_first; blk != NULL; blk = nextblk) {
+      nextblk = blk->next;
+      caml_stat_free(blk);
+    }
+    extern_output_first = NULL;
+  }
+  extern_free_stack();
+  extern_free_position_table();
+}
+
+static void grow_extern_output(intnat required)
+{
+  struct output_block * blk;
+  intnat extra;
+
+  if (extern_userprovided_output != NULL) {
+    extern_failwith("Marshal.to_buffer: buffer overflow");
+  }
+  extern_output_block->end = extern_ptr;
+  if (required <= SIZE_EXTERN_OUTPUT_BLOCK / 2)
+    extra = 0;
+  else
+    extra = required;
+  blk = caml_stat_alloc_noexc(sizeof(struct output_block) + extra);
+  if (blk == NULL) extern_out_of_memory();
+  extern_output_block->next = blk;
+  extern_output_block = blk;
+  extern_output_block->next = NULL;
+  extern_ptr = extern_output_block->data;
+  extern_limit = extern_output_block->data + SIZE_EXTERN_OUTPUT_BLOCK + extra;
+}
+
+static intnat extern_output_length(void)
+{
+  struct output_block * blk;
+  intnat len;
+
+  if (extern_userprovided_output != NULL) {
+    return extern_ptr - extern_userprovided_output;
+  } else {
+    for (len = 0, blk = extern_output_first; blk != NULL; blk = blk->next)
+      len += blk->end - blk->data;
+    return len;
+  }
+}
+
+/* Exception raising, with cleanup */
+
+static void extern_out_of_memory(void)
+{
+  free_extern_output();
+  caml_raise_out_of_memory();
+}
+
+static void extern_invalid_argument(char *msg)
+{
+  free_extern_output();
+  caml_invalid_argument(msg);
+}
+
+static void extern_failwith(char *msg)
+{
+  free_extern_output();
+  caml_failwith(msg);
+}
+
+static void extern_stack_overflow(void)
+{
+  caml_gc_message (0x04, "Stack overflow in marshaling value\n");
+  free_extern_output();
+  caml_raise_out_of_memory();
+}
+
+/* Conversion to big-endian */
+
+Caml_inline void store16(char * dst, int n)
+{
+  dst[0] = n >> 8;  dst[1] = n;
+}
+
+Caml_inline void store32(char * dst, intnat n)
+{
+  dst[0] = n >> 24;  dst[1] = n >> 16;  dst[2] = n >> 8;  dst[3] = n;
+}
+
+Caml_inline void store64(char * dst, int64_t n)
+{
+  dst[0] = n >> 56;  dst[1] = n >> 48;  dst[2] = n >> 40;  dst[3] = n >> 32;
+  dst[4] = n >> 24;  dst[5] = n >> 16;  dst[6] = n >> 8;   dst[7] = n;
+}
+
+/* Write characters, integers, and blocks in the output buffer */
+
+Caml_inline void write(int c)
+{
+  if (extern_ptr >= extern_limit) grow_extern_output(1);
+  *extern_ptr++ = c;
+}
+
+static void writeblock(const char * data, intnat len)
+{
+  if (extern_ptr + len > extern_limit) grow_extern_output(len);
+  memcpy(extern_ptr, data, len);
+  extern_ptr += len;
+}
+
+Caml_inline void writeblock_float8(const double * data, intnat ndoubles)
+{
+#if ARCH_FLOAT_ENDIANNESS == 0x01234567 || ARCH_FLOAT_ENDIANNESS == 0x76543210
+  writeblock((const char *) data, ndoubles * 8);
+#else
+  caml_serialize_block_float_8(data, ndoubles);
+#endif
+}
+
+static void writecode8(int code, intnat val)
+{
+  if (extern_ptr + 2 > extern_limit) grow_extern_output(2);
+  extern_ptr[0] = code;
+  extern_ptr[1] = val;
+  extern_ptr += 2;
+}
+
+static void writecode16(int code, intnat val)
+{
+  if (extern_ptr + 3 > extern_limit) grow_extern_output(3);
+  extern_ptr[0] = code;
+  store16(extern_ptr + 1, (int) val);
+  extern_ptr += 3;
+}
+
+static void writecode32(int code, intnat val)
+{
+  if (extern_ptr + 5 > extern_limit) grow_extern_output(5);
+  extern_ptr[0] = code;
+  store32(extern_ptr + 1, val);
+  extern_ptr += 5;
+}
+
+#ifdef ARCH_SIXTYFOUR
+static void writecode64(int code, intnat val)
+{
+  if (extern_ptr + 9 > extern_limit) grow_extern_output(9);
+  extern_ptr[0] = code;
+  store64(extern_ptr + 1, val);
+  extern_ptr += 9;
+}
+#endif
+
+/* Marshal the given value in the output buffer */
+
+int caml_extern_allow_out_of_heap = 0;
+
+static void extern_rec(value v)
+{
+  struct code_fragment * cf;
+  struct extern_item * sp;
+  uintnat h = 0;
+  uintnat pos = 0;
+
+  extern_init_position_table();
+  sp = extern_stack;
+
+  while(1) {
+  if (Is_long(v)) {
+    intnat n = Long_val(v);
+    if (n >= 0 && n < 0x40) {
+      write(PREFIX_SMALL_INT + n);
+    } else if (n >= -(1 << 7) && n < (1 << 7)) {
+      writecode8(CODE_INT8, n);
+    } else if (n >= -(1 << 15) && n < (1 << 15)) {
+      writecode16(CODE_INT16, n);
+#ifdef ARCH_SIXTYFOUR
+    } else if (n < -((intnat)1 << 30) || n >= ((intnat)1 << 30)) {
+      if (extern_flags & COMPAT_32)
+        extern_failwith("output_value: integer cannot be read back on "
+                        "32-bit platform");
+      writecode64(CODE_INT64, n);
+#endif
+    } else
+      writecode32(CODE_INT32, n);
+    goto next_item;
+  }
+  if (Is_in_value_area(v) || caml_extern_allow_out_of_heap) {
+    header_t hd = Hd_val(v);
+    tag_t tag = Tag_hd(hd);
+    mlsize_t sz = Wosize_hd(hd);
+
+    if (tag == Forward_tag) {
+      value f = Forward_val (v);
+      if (Is_block (f)
+          && (!Is_in_value_area(f) || Tag_val (f) == Forward_tag
+              || Tag_val (f) == Lazy_tag
+#ifdef FLAT_FLOAT_ARRAY
+              || Tag_val (f) == Double_tag
+#endif
+              )){
+        /* Do not short-circuit the pointer. */
+      }else{
+        v = f;
+        continue;
+      }
+    }
+    /* Atoms are treated specially for two reasons: they are not allocated
+       in the externed block, and they are automatically shared. */
+    if (sz == 0) {
+      if (tag < 16) {
+        write(PREFIX_SMALL_BLOCK + tag);
+      } else {
+#ifdef WITH_PROFINFO
+        writecode32(CODE_BLOCK32, Hd_no_profinfo(hd));
+#else
+        writecode32(CODE_BLOCK32, hd);
+#endif
+      }
+      goto next_item;
+    }
+    /* Check if object already seen */
+    if (! (extern_flags & NO_SHARING)) {
+      if (extern_lookup_position(v, &pos, &h)) {
+        uintnat d = obj_counter - pos;
+        if (d < 0x100) {
+          writecode8(CODE_SHARED8, d);
+        } else if (d < 0x10000) {
+          writecode16(CODE_SHARED16, d);
+#ifdef ARCH_SIXTYFOUR
+        } else if (d >= (uintnat)1 << 32) {
+          writecode64(CODE_SHARED64, d);
+#endif
+        } else {
+          writecode32(CODE_SHARED32, d);
+        }
+        goto next_item;
+      }
+    }
+
+    /* Output the contents of the object */
+    switch(tag) {
+    case String_tag: {
+      mlsize_t len = caml_string_length(v);
+      if (len < 0x20) {
+        write(PREFIX_SMALL_STRING + len);
+      } else if (len < 0x100) {
+        writecode8(CODE_STRING8, len);
+      } else {
+#ifdef ARCH_SIXTYFOUR
+        if (len > 0xFFFFFB && (extern_flags & COMPAT_32))
+          extern_failwith("output_value: string cannot be read back on "
+                          "32-bit platform");
+        if (len < (uintnat)1 << 32)
+          writecode32(CODE_STRING32, len);
+        else
+          writecode64(CODE_STRING64, len);
+#else
+        writecode32(CODE_STRING32, len);
+#endif
+      }
+      writeblock(String_val(v), len);
+      size_32 += 1 + (len + 4) / 4;
+      size_64 += 1 + (len + 8) / 8;
+      extern_record_location(v, h);
+      break;
+    }
+    case Double_tag: {
+      if (sizeof(double) != 8)
+        extern_invalid_argument("output_value: non-standard floats");
+      write(CODE_DOUBLE_NATIVE);
+      writeblock_float8((double *) v, 1);
+      size_32 += 1 + 2;
+      size_64 += 1 + 1;
+      extern_record_location(v, h);
+      break;
+    }
+    case Double_array_tag: {
+      mlsize_t nfloats;
+      if (sizeof(double) != 8)
+        extern_invalid_argument("output_value: non-standard floats");
+      nfloats = Wosize_val(v) / Double_wosize;
+      if (nfloats < 0x100) {
+        writecode8(CODE_DOUBLE_ARRAY8_NATIVE, nfloats);
+      } else {
+#ifdef ARCH_SIXTYFOUR
+        if (nfloats > 0x1FFFFF && (extern_flags & COMPAT_32))
+          extern_failwith("output_value: float array cannot be read back on "
+                          "32-bit platform");
+        if (nfloats < (uintnat) 1 << 32)
+          writecode32(CODE_DOUBLE_ARRAY32_NATIVE, nfloats);
+        else
+          writecode64(CODE_DOUBLE_ARRAY64_NATIVE, nfloats);
+#else
+        writecode32(CODE_DOUBLE_ARRAY32_NATIVE, nfloats);
+#endif
+      }
+      writeblock_float8((double *) v, nfloats);
+      size_32 += 1 + nfloats * 2;
+      size_64 += 1 + nfloats;
+      extern_record_location(v, h);
+      break;
+    }
+    case Abstract_tag:
+      extern_invalid_argument("output_value: abstract value (Abstract)");
+      break;
+    case Infix_tag:
+      writecode32(CODE_INFIXPOINTER, Infix_offset_hd(hd));
+      v = v - Infix_offset_hd(hd); /* PR#5772 */
+      continue;
+    case Custom_tag: {
+      uintnat sz_32, sz_64;
+      char * size_header;
+      char const * ident = Custom_ops_val(v)->identifier;
+      void (*serialize)(value v, uintnat * bsize_32,
+                        uintnat * bsize_64)
+        = Custom_ops_val(v)->serialize;
+      const struct custom_fixed_length* fixed_length
+        = Custom_ops_val(v)->fixed_length;
+      if (serialize == NULL)
+        extern_invalid_argument("output_value: abstract value (Custom)");
+      if (fixed_length == NULL) {
+        write(CODE_CUSTOM_LEN);
+        writeblock(ident, strlen(ident) + 1);
+        /* Reserve 12 bytes for the lengths (sz_32 and sz_64). */
+        if (extern_ptr + 12 >= extern_limit) grow_extern_output(12);
+        size_header = extern_ptr;
+        extern_ptr += 12;
+        serialize(v, &sz_32, &sz_64);
+        /* Store length before serialized block */
+        store32(size_header, sz_32);
+        store64(size_header + 4, sz_64);
+      } else {
+        write(CODE_CUSTOM_FIXED);
+        writeblock(ident, strlen(ident) + 1);
+        serialize(v, &sz_32, &sz_64);
+        if (sz_32 != fixed_length->bsize_32 ||
+            sz_64 != fixed_length->bsize_64)
+          caml_fatal_error(
+            "output_value: incorrect fixed sizes specified by %s",
+            ident);
+      }
+      size_32 += 2 + ((sz_32 + 3) >> 2);  /* header + ops + data */
+      size_64 += 2 + ((sz_64 + 7) >> 3);
+      extern_record_location(v, h);
+      break;
+    }
+    default: {
+      value field0;
+      if (tag < 16 && sz < 8) {
+        write(PREFIX_SMALL_BLOCK + tag + (sz << 4));
+      } else {
+#ifdef ARCH_SIXTYFOUR
+#ifdef WITH_PROFINFO
+        header_t hd_erased = Hd_no_profinfo(hd);
+#else
+        header_t hd_erased = hd;
+#endif
+        if (sz > 0x3FFFFF && (extern_flags & COMPAT_32))
+          extern_failwith("output_value: array cannot be read back on "
+                          "32-bit platform");
+        if (hd_erased < (uintnat)1 << 32)
+          writecode32(CODE_BLOCK32, Whitehd_hd (hd_erased));
+        else
+          writecode64(CODE_BLOCK64, Whitehd_hd (hd_erased));
+#else
+        writecode32(CODE_BLOCK32, Whitehd_hd (hd));
+#endif
+      }
+      size_32 += 1 + sz;
+      size_64 += 1 + sz;
+      field0 = Field(v, 0);
+      extern_record_location(v, h);
+      /* Remember that we still have to serialize fields 1 ... sz - 1 */
+      if (sz > 1) {
+        sp++;
+        if (sp >= extern_stack_limit) sp = extern_resize_stack(sp);
+        sp->v = &Field(v,1);
+        sp->count = sz-1;
+      }
+      /* Continue serialization with the first field */
+      v = field0;
+      continue;
+    }
+    }
+  }
+  else if (caml_find_code_fragment((char*) v, NULL, &cf)) {
+    if ((extern_flags & CLOSURES) == 0)
+      extern_invalid_argument("output_value: functional value");
+    if (! cf->digest_computed) {
+      caml_md5_block(cf->digest, cf->code_start, cf->code_end - cf->code_start);
+      cf->digest_computed = 1;
+    }
+    writecode32(CODE_CODEPOINTER, (char *) v - cf->code_start);
+    writeblock((const char *)cf->digest, 16);
+  } else {
+    extern_invalid_argument("output_value: abstract value (outside heap)");
+  }
+  next_item:
+    /* Pop one more item to marshal, if any */
+    if (sp == extern_stack) {
+        /* We are done.   Cleanup the stack and leave the function */
+        extern_free_stack();
+        extern_free_position_table();
+        return;
+    }
+    v = *((sp->v)++);
+    if (--(sp->count) == 0) sp--;
+  }
+  /* Never reached as function leaves with return */
+}
+
+static int extern_flag_values[] = { NO_SHARING, CLOSURES, COMPAT_32 };
+
+static intnat extern_value(value v, value flags,
+                           /*out*/ char header[32],
+                           /*out*/ int * header_len)
+{
+  intnat res_len;
+  /* Parse flag list */
+  extern_flags = caml_convert_flag_list(flags, extern_flag_values);
+  /* Initializations */
+  obj_counter = 0;
+  size_32 = 0;
+  size_64 = 0;
+  /* Marshal the object */
+  extern_rec(v);
+  /* Record end of output */
+  close_extern_output();
+  /* Write the header */
+  res_len = extern_output_length();
+#ifdef ARCH_SIXTYFOUR
+  if (res_len >= ((intnat)1 << 32) ||
+      size_32 >= ((intnat)1 << 32) || size_64 >= ((intnat)1 << 32)) {
+    /* The object is too big for the small header format.
+       Fail if we are in compat32 mode, or use big header. */
+    if (extern_flags & COMPAT_32) {
+      free_extern_output();
+      caml_failwith("output_value: object too big to be read back on "
+                    "32-bit platform");
+    }
+    store32(header, Intext_magic_number_big);
+    store32(header + 4, 0);
+    store64(header + 8, res_len);
+    store64(header + 16, obj_counter);
+    store64(header + 24, size_64);
+    *header_len = 32;
+    return res_len;
+  }
+#endif
+  /* Use the small header format */
+  store32(header, Intext_magic_number_small);
+  store32(header + 4, res_len);
+  store32(header + 8, obj_counter);
+  store32(header + 12, size_32);
+  store32(header + 16, size_64);
+  *header_len = 20;
+  return res_len;
+}
+
+void caml_output_val(struct channel *chan, value v, value flags)
+{
+  char header[32];
+  int header_len;
+  struct output_block * blk, * nextblk;
+
+  if (! caml_channel_binary_mode(chan))
+    caml_failwith("output_value: not a binary channel");
+  init_extern_output();
+  extern_value(v, flags, header, &header_len);
+  /* During [caml_really_putblock], concurrent [caml_output_val] operations
+     can take place (via signal handlers or context switching in systhreads),
+     and [extern_output_first] may change. So, save it in a local variable. */
+  blk = extern_output_first;
+  caml_really_putblock(chan, header, header_len);
+  while (blk != NULL) {
+    caml_really_putblock(chan, blk->data, blk->end - blk->data);
+    nextblk = blk->next;
+    caml_stat_free(blk);
+    blk = nextblk;
+  }
+}
+
+CAMLprim value caml_output_value(value vchan, value v, value flags)
+{
+  CAMLparam3 (vchan, v, flags);
+  struct channel * channel = Channel(vchan);
+
+  Lock(channel);
+  caml_output_val(channel, v, flags);
+  Unlock(channel);
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value caml_output_value_to_bytes(value v, value flags)
+{
+  char header[32];
+  int header_len;
+  intnat data_len, ofs;
+  value res;
+  struct output_block * blk, * nextblk;
+
+  init_extern_output();
+  data_len = extern_value(v, flags, header, &header_len);
+  /* PR#4030: it is prudent to save extern_output_first before allocating
+     the result, as in caml_output_val */
+  blk = extern_output_first;
+  res = caml_alloc_string(header_len + data_len);
+  ofs = 0;
+  memcpy(&Byte(res, ofs), header, header_len);
+  ofs += header_len;
+  while (blk != NULL) {
+    intnat n = blk->end - blk->data;
+    memcpy(&Byte(res, ofs), blk->data, n);
+    ofs += n;
+    nextblk = blk->next;
+    caml_stat_free(blk);
+    blk = nextblk;
+  }
+  return res;
+}
+
+CAMLprim value caml_output_value_to_string(value v, value flags)
+{
+  return caml_output_value_to_bytes(v,flags);
+}
+
+CAMLexport intnat caml_output_value_to_block(value v, value flags,
+                                             char * buf, intnat len)
+{
+  char header[32];
+  int header_len;
+  intnat data_len;
+  /* At this point we don't know the size of the header.
+     Guess that it is small, and fix up later if not. */
+  extern_userprovided_output = buf + 20;
+  extern_ptr = extern_userprovided_output;
+  extern_limit = buf + len;
+  data_len = extern_value(v, flags, header, &header_len);
+  if (header_len != 20) {
+    /* Bad guess!  Need to shift the output to make room for big header.
+       Make sure there is room. */
+    if (header_len + data_len > len)
+      caml_failwith("Marshal.to_buffer: buffer overflow");
+    memmove(buf + header_len, buf + 20, data_len);
+  }
+  memcpy(buf, header, header_len);
+  return header_len + data_len;
+}
+
+CAMLprim value caml_output_value_to_buffer(value buf, value ofs, value len,
+                                           value v, value flags)
+{
+  intnat l =
+    caml_output_value_to_block(v, flags,
+                               &Byte(buf, Long_val(ofs)), Long_val(len));
+  return Val_long(l);
+}
+
+CAMLexport void caml_output_value_to_malloc(value v, value flags,
+                                            /*out*/ char ** buf,
+                                            /*out*/ intnat * len)
+{
+  char header[32];
+  int header_len;
+  intnat data_len;
+  char * res;
+  struct output_block * blk, * nextblk;
+
+  init_extern_output();
+  data_len = extern_value(v, flags, header, &header_len);
+  res = caml_stat_alloc_noexc(header_len + data_len);
+  if (res == NULL) extern_out_of_memory();
+  *buf = res;
+  *len = header_len + data_len;
+  memcpy(res, header, header_len);
+  res += header_len;
+  for (blk = extern_output_first; blk != NULL; blk = nextblk) {
+    intnat n = blk->end - blk->data;
+    memcpy(res, blk->data, n);
+    res += n;
+    nextblk = blk->next;
+    caml_stat_free(blk);
+  }
+}
+
+/* Functions for writing user-defined marshallers */
+
+CAMLexport void caml_serialize_int_1(int i)
+{
+  if (extern_ptr + 1 > extern_limit) grow_extern_output(1);
+  extern_ptr[0] = i;
+  extern_ptr += 1;
+}
+
+CAMLexport void caml_serialize_int_2(int i)
+{
+  if (extern_ptr + 2 > extern_limit) grow_extern_output(2);
+  store16(extern_ptr, i);
+  extern_ptr += 2;
+}
+
+CAMLexport void caml_serialize_int_4(int32_t i)
+{
+  if (extern_ptr + 4 > extern_limit) grow_extern_output(4);
+  store32(extern_ptr, i);
+  extern_ptr += 4;
+}
+
+CAMLexport void caml_serialize_int_8(int64_t i)
+{
+  if (extern_ptr + 8 > extern_limit) grow_extern_output(8);
+  store64(extern_ptr, i);
+  extern_ptr += 8;
+}
+
+CAMLexport void caml_serialize_float_4(float f)
+{
+  caml_serialize_block_4(&f, 1);
+}
+
+CAMLexport void caml_serialize_float_8(double f)
+{
+  caml_serialize_block_float_8(&f, 1);
+}
+
+CAMLexport void caml_serialize_block_1(void * data, intnat len)
+{
+  if (extern_ptr + len > extern_limit) grow_extern_output(len);
+  memcpy(extern_ptr, data, len);
+  extern_ptr += len;
+}
+
+CAMLexport void caml_serialize_block_2(void * data, intnat len)
+{
+  if (extern_ptr + 2 * len > extern_limit) grow_extern_output(2 * len);
+#ifndef ARCH_BIG_ENDIAN
+  {
+    unsigned char * p;
+    char * q;
+    for (p = data, q = extern_ptr; len > 0; len--, p += 2, q += 2)
+      Reverse_16(q, p);
+    extern_ptr = q;
+  }
+#else
+  memcpy(extern_ptr, data, len * 2);
+  extern_ptr += len * 2;
+#endif
+}
+
+CAMLexport void caml_serialize_block_4(void * data, intnat len)
+{
+  if (extern_ptr + 4 * len > extern_limit) grow_extern_output(4 * len);
+#ifndef ARCH_BIG_ENDIAN
+  {
+    unsigned char * p;
+    char * q;
+    for (p = data, q = extern_ptr; len > 0; len--, p += 4, q += 4)
+      Reverse_32(q, p);
+    extern_ptr = q;
+  }
+#else
+  memcpy(extern_ptr, data, len * 4);
+  extern_ptr += len * 4;
+#endif
+}
+
+CAMLexport void caml_serialize_block_8(void * data, intnat len)
+{
+  if (extern_ptr + 8 * len > extern_limit) grow_extern_output(8 * len);
+#ifndef ARCH_BIG_ENDIAN
+  {
+    unsigned char * p;
+    char * q;
+    for (p = data, q = extern_ptr; len > 0; len--, p += 8, q += 8)
+      Reverse_64(q, p);
+    extern_ptr = q;
+  }
+#else
+  memcpy(extern_ptr, data, len * 8);
+  extern_ptr += len * 8;
+#endif
+}
+
+CAMLexport void caml_serialize_block_float_8(void * data, intnat len)
+{
+  if (extern_ptr + 8 * len > extern_limit) grow_extern_output(8 * len);
+#if ARCH_FLOAT_ENDIANNESS == 0x01234567
+  memcpy(extern_ptr, data, len * 8);
+  extern_ptr += len * 8;
+#elif ARCH_FLOAT_ENDIANNESS == 0x76543210
+  {
+    unsigned char * p;
+    char * q;
+    for (p = data, q = extern_ptr; len > 0; len--, p += 8, q += 8)
+      Reverse_64(q, p);
+    extern_ptr = q;
+  }
+#else
+  {
+    unsigned char * p;
+    char * q;
+    for (p = data, q = extern_ptr; len > 0; len--, p += 8, q += 8)
+      Permute_64(q, 0x01234567, p, ARCH_FLOAT_ENDIANNESS);
+    extern_ptr = q;
+  }
+#endif
+}
diff --git a/runtime/fail_byt.c b/runtime/fail_byt.c
new file mode 100644
index 00000000..b2e8d8b7
--- /dev/null
+++ b/runtime/fail_byt.c
@@ -0,0 +1,208 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 1996 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU 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 <stdio.h>
+#include <stdlib.h>
+#include "caml/alloc.h"
+#include "caml/callback.h"
+#include "caml/fail.h"
+#include "caml/gc.h"
+#include "caml/io.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/printexc.h"
+#include "caml/signals.h"
+#include "caml/stacks.h"
+
+CAMLexport void caml_raise(value v)
+{
+  Unlock_exn();
+  Caml_state->exn_bucket = v;
+  if (Caml_state->external_raise == NULL) caml_fatal_uncaught_exception(v);
+  siglongjmp(Caml_state->external_raise->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].
+
+   We check against this issue here in runtime/fail_byt.c instead of
+   runtime/intern.c. Having the check here means that these calls will
+   be slightly slower for all bytecode programs (not just the calls
+   coming from intern). Because intern.c is shared between the bytecode and
+   the native runtimes, putting checks there would slow do input_value for
+   natively-compiled programs that do not need these checks.
+*/
+static void check_global_data(char const *exception_name)
+{
+  if (caml_global_data == 0) {
+    fprintf(stderr, "Fatal error: exception %s\n", exception_name);
+    exit(2);
+  }
+}
+
+static void check_global_data_param(char const *exception_name, char const *msg)
+{
+  if (caml_global_data == 0) {
+    fprintf(stderr, "Fatal error: exception %s(\"%s\")\n", exception_name, msg);
+    exit(2);
+  }
+}
+
+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)
+{
+  caml_raise_with_string(caml_get_failwith_tag(msg), msg);
+}
+
+CAMLexport void caml_failwith_value (value msg)
+{
+  CAMLparam1(msg);
+  value tag = caml_get_failwith_tag(String_val(msg));
+  caml_raise_with_arg(tag, msg);
+  CAMLnoreturn;
+}
+
+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)
+{
+  caml_raise_with_string(caml_get_invalid_argument_tag(msg), msg);
+}
+
+CAMLexport void caml_invalid_argument_value (value msg)
+{
+  CAMLparam1(msg);
+  value tag = caml_get_invalid_argument_tag(String_val(msg));
+  caml_raise_with_arg(tag, msg);
+  CAMLnoreturn;
+}
+
+CAMLexport void caml_array_bound_error(void)
+{
+  caml_invalid_argument("index out of bounds");
+}
+
+CAMLexport void caml_raise_out_of_memory(void)
+{
+  check_global_data("Out_of_memory");
+  caml_raise_constant(Field(caml_global_data, OUT_OF_MEMORY_EXN));
+}
+
+CAMLexport void caml_raise_stack_overflow(void)
+{
+  check_global_data("Stack_overflow");
+  caml_raise_constant(Field(caml_global_data, STACK_OVERFLOW_EXN));
+}
+
+CAMLexport void caml_raise_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);
+}
+
+CAMLexport void caml_raise_end_of_file(void)
+{
+  check_global_data("End_of_file");
+  caml_raise_constant(Field(caml_global_data, END_OF_FILE_EXN));
+}
+
+CAMLexport void caml_raise_zero_divide(void)
+{
+  check_global_data("Division_by_zero");
+  caml_raise_constant(Field(caml_global_data, ZERO_DIVIDE_EXN));
+}
+
+CAMLexport void caml_raise_not_found(void)
+{
+  check_global_data("Not_found");
+  caml_raise_constant(Field(caml_global_data, NOT_FOUND_EXN));
+}
+
+CAMLexport void caml_raise_sys_blocked_io(void)
+{
+  check_global_data("Sys_blocked_io");
+  caml_raise_constant(Field(caml_global_data, SYS_BLOCKED_IO));
+}
+
+value caml_raise_if_exception(value res)
+{
+  if (Is_exception_result(res)) caml_raise(Extract_exception(res));
+  return res;
+}
+
+int caml_is_special_exception(value exn) {
+  /* this function is only used in caml_format_exception to produce
+     a more readable textual representation of some exceptions. It is
+     better to fall back to the general, less readable representation
+     than to abort with a fatal error as above. */
+  if (caml_global_data == 0) return 0;
+  return exn == Field(caml_global_data, MATCH_FAILURE_EXN)
+    || exn == Field(caml_global_data, ASSERT_FAILURE_EXN)
+    || exn == Field(caml_global_data, UNDEFINED_RECURSIVE_MODULE_EXN);
+}
diff --git a/runtime/fail_nat.c b/runtime/fail_nat.c
new file mode 100644
index 00000000..380578ac
--- /dev/null
+++ b/runtime/fail_nat.c
@@ -0,0 +1,206 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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 <stdio.h>
+#include <signal.h>
+#include "caml/alloc.h"
+#include "caml/domain.h"
+#include "caml/fail.h"
+#include "caml/io.h"
+#include "caml/gc.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "caml/printexc.h"
+#include "caml/signals.h"
+#include "caml/stack.h"
+#include "caml/roots.h"
+#include "caml/callback.h"
+
+/* The globals holding predefined exceptions */
+
+typedef value caml_generated_constant[1];
+
+extern caml_generated_constant
+  caml_exn_Out_of_memory,
+  caml_exn_Sys_error,
+  caml_exn_Failure,
+  caml_exn_Invalid_argument,
+  caml_exn_End_of_file,
+  caml_exn_Division_by_zero,
+  caml_exn_Not_found,
+  caml_exn_Match_failure,
+  caml_exn_Sys_blocked_io,
+  caml_exn_Stack_overflow,
+  caml_exn_Assert_failure,
+  caml_exn_Undefined_recursive_module;
+
+/* Exception raising */
+
+CAMLnoreturn_start
+  extern void caml_raise_exception (caml_domain_state* state, value bucket)
+CAMLnoreturn_end;
+
+/* Used by the stack overflow handler -> deactivate ASAN (see
+   segv_handler in signals_nat.c). */
+CAMLno_asan
+void caml_raise(value v)
+{
+  Unlock_exn();
+  if (Caml_state->exception_pointer == NULL) caml_fatal_uncaught_exception(v);
+
+  while (Caml_state->local_roots != NULL &&
+         (char *) Caml_state->local_roots < Caml_state->exception_pointer) {
+    Caml_state->local_roots = Caml_state->local_roots->next;
+  }
+
+  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)
+{
+  CAMLparam2 (tag, arg);
+  CAMLlocal1 (bucket);
+
+  bucket = caml_alloc_small (2, 0);
+  Field(bucket, 0) = tag;
+  Field(bucket, 1) = arg;
+  caml_raise(bucket);
+  CAMLnoreturn;
+}
+
+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;
+}
+
+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;
+}
+
+void caml_failwith (char const *msg)
+{
+  caml_raise_with_string((value) caml_exn_Failure, msg);
+}
+
+void caml_failwith_value (value msg)
+{
+  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);
+}
+
+/* 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)
+{
+  caml_raise_with_arg((value) caml_exn_Sys_error, msg);
+}
+
+void caml_raise_end_of_file(void)
+{
+  caml_raise_constant((value) caml_exn_End_of_file);
+}
+
+void caml_raise_zero_divide(void)
+{
+  caml_raise_constant((value) caml_exn_Division_by_zero);
+}
+
+void caml_raise_not_found(void)
+{
+  caml_raise_constant((value) caml_exn_Not_found);
+}
+
+void caml_raise_sys_blocked_io(void)
+{
+  caml_raise_constant((value) caml_exn_Sys_blocked_io);
+}
+
+value caml_raise_if_exception(value res)
+{
+  if (Is_exception_result(res)) caml_raise(Extract_exception(res));
+  return res;
+}
+
+/* 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 const value * caml_array_bound_error_exn = NULL;
+
+void caml_array_bound_error(void)
+{
+  if (caml_array_bound_error_exn == NULL) {
+    caml_array_bound_error_exn =
+      caml_named_value("Pervasives.array_bound_error");
+    if (caml_array_bound_error_exn == NULL) {
+      fprintf(stderr, "Fatal error: exception "
+                      "Invalid_argument(\"index out of bounds\")\n");
+      exit(2);
+    }
+  }
+  caml_raise(*caml_array_bound_error_exn);
+}
+
+int caml_is_special_exception(value exn) {
+  return exn == (value) caml_exn_Match_failure
+    || exn == (value) caml_exn_Assert_failure
+    || exn == (value) caml_exn_Undefined_recursive_module;
+}
diff --git a/runtime/finalise.c b/runtime/finalise.c
new file mode 100644
index 00000000..455f91ae
--- /dev/null
+++ b/runtime/finalise.c
@@ -0,0 +1,446 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*           Damien Doligez, projet Moscova, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2000 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
+
+/* Handling of finalised values. */
+
+#include "caml/callback.h"
+#include "caml/compact.h"
+#include "caml/fail.h"
+#include "caml/finalise.h"
+#include "caml/minor_gc.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/signals.h"
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+#include "caml/spacetime.h"
+#endif
+
+struct final {
+  value fun;
+  value val;
+  int offset;
+};
+
+struct finalisable {
+  struct final *table;
+  uintnat old;
+  uintnat young;
+  uintnat size;
+};
+/* [0..old) : finalisable set, the values are in the major heap
+   [old..young) : recent set, the values could be in the minor heap
+   [young..size) : free space
+
+   The element of the finalisable set are moved to the finalising set
+   below when the value are unreachable (for the first or last time).
+
+*/
+
+static struct finalisable finalisable_first = {NULL,0,0,0};
+static struct finalisable finalisable_last = {NULL,0,0,0};
+
+struct to_do {
+  struct to_do *next;
+  int size;
+  struct final item[1];  /* variable size */
+};
+
+static struct to_do *to_do_hd = NULL;
+static struct to_do *to_do_tl = NULL;
+/*
+  to_do_hd: head of the list of finalisation functions that can be run.
+  to_do_tl: tail of the list of finalisation functions that can be run.
+
+  It is the finalising set.
+*/
+
+static int running_finalisation_function = 0;
+
+/* [size] is a number of elements for the [to_do.item] array */
+static void alloc_to_do (int size)
+{
+  struct to_do *result = caml_stat_alloc_noexc (sizeof (struct to_do) +
+                                                size * sizeof (struct final));
+  if (result == NULL) caml_fatal_error ("out of memory");
+  result->next = NULL;
+  result->size = size;
+  if (to_do_tl == NULL){
+    to_do_hd = result;
+    to_do_tl = result;
+    if(!running_finalisation_function) caml_set_action_pending();
+  }else{
+    CAMLassert (to_do_tl->next == NULL);
+    to_do_tl->next = result;
+    to_do_tl = result;
+  }
+}
+
+/* Find white finalisable values, move them to the finalising set, and
+   darken them (if darken_value is true).
+*/
+static void generic_final_update (struct finalisable * final, int darken_value)
+{
+  uintnat i, j, k;
+  uintnat todo_count = 0;
+
+  CAMLassert (final->old <= final->young);
+  for (i = 0; i < final->old; i++){
+    CAMLassert (Is_block (final->table[i].val));
+    CAMLassert (Is_in_heap (final->table[i].val));
+    if (Is_white_val (final->table[i].val)){
+      ++ todo_count;
+    }
+  }
+
+  /** invariant:
+      - 0 <= j <= i /\ 0 <= k <= i /\ 0 <= k <= todo_count
+      - i : index in final_table, before i all the values are black
+      (alive or in the minor heap) or the finalizer have been copied
+      in to_do_tl.
+      - j : index in final_table, before j all the values are black
+      (alive or in the minor heap), next available slot.
+      - k : index in to_do_tl, next available slot.
+  */
+  if (todo_count > 0){
+    alloc_to_do (todo_count);
+    j = k = 0;
+    for (i = 0; i < final->old; i++){
+      CAMLassert (Is_block (final->table[i].val));
+      CAMLassert (Is_in_heap (final->table[i].val));
+      CAMLassert (Tag_val (final->table[i].val) != Forward_tag);
+      if(Is_white_val (final->table[i].val)){
+        /** dead */
+        to_do_tl->item[k] = final->table[i];
+        if(!darken_value){
+          /* The value is not darken so the finalisation function
+             is called with unit not with the value */
+          to_do_tl->item[k].val = Val_unit;
+          to_do_tl->item[k].offset = 0;
+        };
+        k++;
+      }else{
+        /** alive */
+        final->table[j++] = final->table[i];
+      }
+    }
+    CAMLassert (i == final->old);
+    CAMLassert (k == todo_count);
+    final->old = j;
+    for(;i < final->young; i++){
+      final->table[j++] = final->table[i];
+    }
+    final->young = j;
+    to_do_tl->size = k;
+    if(darken_value){
+      for (i = 0; i < k; i++){
+        /* Note that item may already be dark due to multiple entries in
+           the final table. */
+        caml_darken (to_do_tl->item[i].val, NULL);
+      }
+    }
+  }
+}
+
+void caml_final_update_mark_phase (){
+  generic_final_update(&finalisable_first, /* darken_value */ 1);
+}
+
+void caml_final_update_clean_phase (){
+  generic_final_update(&finalisable_last, /* darken_value */ 0);
+}
+
+/* Call the finalisation functions for the finalising set.
+   Note that this function must be reentrant.
+*/
+value caml_final_do_calls_exn (void)
+{
+  struct final f;
+  value res;
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+  void* saved_spacetime_trie_node_ptr;
+#endif
+
+  if (!running_finalisation_function && to_do_hd != NULL){
+    if (caml_finalise_begin_hook != NULL) (*caml_finalise_begin_hook) ();
+    caml_gc_message (0x80, "Calling finalisation functions.\n");
+    while (1){
+      while (to_do_hd != NULL && to_do_hd->size == 0){
+        struct to_do *next_hd = to_do_hd->next;
+        caml_stat_free (to_do_hd);
+        to_do_hd = next_hd;
+        if (to_do_hd == NULL) to_do_tl = NULL;
+      }
+      if (to_do_hd == NULL) break;
+      CAMLassert (to_do_hd->size > 0);
+      -- to_do_hd->size;
+      f = to_do_hd->item[to_do_hd->size];
+      running_finalisation_function = 1;
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+      /* We record the finaliser's execution separately.
+         (The code of [caml_callback_exn] will do the hard work of finding
+         the correct place in the trie.) */
+      saved_spacetime_trie_node_ptr = caml_spacetime_trie_node_ptr;
+      caml_spacetime_trie_node_ptr = caml_spacetime_finaliser_trie_root;
+#endif
+      res = caml_callback_exn (f.fun, f.val + f.offset);
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+      caml_spacetime_trie_node_ptr = saved_spacetime_trie_node_ptr;
+#endif
+      running_finalisation_function = 0;
+      if (Is_exception_result (res)) return res;
+    }
+    caml_gc_message (0x80, "Done calling finalisation functions.\n");
+    if (caml_finalise_end_hook != NULL) (*caml_finalise_end_hook) ();
+  }
+  return Val_unit;
+}
+
+/* Call a scanning_action [f] on [x]. */
+#define Call_action(f,x) (*(f)) ((x), &(x))
+
+/* Call [*f] on the closures of the finalisable set and
+   the closures and values of the finalising set.
+   This is called by the major GC [caml_darken_all_roots]
+   and by the compactor through [caml_do_roots]
+*/
+void caml_final_do_roots (scanning_action f)
+{
+  uintnat i;
+  struct to_do *todo;
+
+  CAMLassert (finalisable_first.old <= finalisable_first.young);
+  for (i = 0; i < finalisable_first.young; i++){
+    Call_action (f, finalisable_first.table[i].fun);
+  };
+
+  CAMLassert (finalisable_last.old <= finalisable_last.young);
+  for (i = 0; i < finalisable_last.young; i++){
+    Call_action (f, finalisable_last.table[i].fun);
+  };
+
+  for (todo = to_do_hd; todo != NULL; todo = todo->next){
+    for (i = 0; i < todo->size; i++){
+      Call_action (f, todo->item[i].fun);
+      Call_action (f, todo->item[i].val);
+    }
+  }
+}
+
+/* Call caml_invert_root on the values of the finalisable set. This is called
+   directly by the compactor.
+*/
+void caml_final_invert_finalisable_values ()
+{
+  uintnat i;
+
+  CAMLassert (finalisable_first.old <= finalisable_first.young);
+  for (i = 0; i < finalisable_first.young; i++){
+    caml_invert_root(finalisable_first.table[i].val,
+                &finalisable_first.table[i].val);
+  };
+
+  CAMLassert (finalisable_last.old <= finalisable_last.young);
+  for (i = 0; i < finalisable_last.young; i++){
+    caml_invert_root(finalisable_last.table[i].val,
+                &finalisable_last.table[i].val);
+  };
+}
+
+/* Call [caml_oldify_one] on the closures and values of the recent set.
+   This is called by the minor GC through [caml_oldify_local_roots].
+*/
+void caml_final_oldify_young_roots ()
+{
+  uintnat i;
+
+  CAMLassert (finalisable_first.old <= finalisable_first.young);
+  for (i = finalisable_first.old; i < finalisable_first.young; i++){
+    caml_oldify_one(finalisable_first.table[i].fun,
+                    &finalisable_first.table[i].fun);
+    caml_oldify_one(finalisable_first.table[i].val,
+                    &finalisable_first.table[i].val);
+  }
+
+  CAMLassert (finalisable_last.old <= finalisable_last.young);
+  for (i = finalisable_last.old; i < finalisable_last.young; i++){
+    caml_oldify_one(finalisable_last.table[i].fun,
+                    &finalisable_last.table[i].fun);
+  }
+
+}
+
+static void generic_final_minor_update (struct finalisable * final)
+{
+  uintnat i, j, k;
+  uintnat todo_count = 0;
+
+  CAMLassert (final->old <= final->young);
+  for (i = final->old; i < final->young; i++){
+    CAMLassert (Is_block (final->table[i].val));
+    CAMLassert (Is_in_heap_or_young (final->table[i].val));
+    if (Is_young(final->table[i].val) && Hd_val(final->table[i].val) != 0){
+      ++ todo_count;
+    }
+  }
+
+  /** invariant:
+      - final->old <= j <= i /\ final->old <= k <= i /\ 0 <= k <= todo_count
+      - i : index in final_table, before i all the values are alive
+            or the finalizer have been copied in to_do_tl.
+      - j : index in final_table, before j all the values are alive,
+            next available slot.
+      - k : index in to_do_tl, next available slot.
+  */
+  if (todo_count > 0){
+    alloc_to_do (todo_count);
+    k = 0;
+    j = final->old;
+    for (i = final->old; i < final->young; i++){
+      CAMLassert (Is_block (final->table[i].val));
+      CAMLassert (Is_in_heap_or_young (final->table[i].val));
+      CAMLassert (Tag_val (final->table[i].val) != Forward_tag);
+      if(Is_young(final->table[i].val) && Hd_val(final->table[i].val) != 0){
+        /** dead */
+        to_do_tl->item[k] = final->table[i];
+        /* The finalisation function is called with unit not with the value */
+        to_do_tl->item[k].val = Val_unit;
+        to_do_tl->item[k].offset = 0;
+        k++;
+      }else{
+        /** alive */
+        final->table[j++] = final->table[i];
+      }
+    }
+    CAMLassert (i == final->young);
+    CAMLassert (k == todo_count);
+    final->young = j;
+    to_do_tl->size = todo_count;
+  }
+
+  /** update the minor value to the copied major value */
+  for (i = final->old; i < final->young; i++){
+    CAMLassert (Is_block (final->table[i].val));
+    CAMLassert (Is_in_heap_or_young (final->table[i].val));
+    if (Is_young(final->table[i].val)) {
+      CAMLassert (Hd_val(final->table[i].val) == 0);
+      final->table[i].val = Field(final->table[i].val,0);
+    }
+  }
+
+  /** check invariant */
+  CAMLassert (final->old <= final->young);
+  for (i = 0; i < final->young; i++){
+    CAMLassert( Is_in_heap(final->table[i].val) );
+  };
+
+}
+
+/* At the end of minor collection update the finalise_last roots in
+   minor heap when moved to major heap or moved them to the finalising
+   set when dead.
+*/
+void caml_final_update_minor_roots ()
+{
+  generic_final_minor_update(&finalisable_last);
+}
+
+/* Empty the recent set into the finalisable set.
+   This is called at the end of each minor collection.
+   The minor heap must be empty when this is called.
+*/
+void caml_final_empty_young (void)
+{
+  finalisable_first.old = finalisable_first.young;
+  finalisable_last.old = finalisable_last.young;
+}
+
+/* Put (f,v) in the recent set. */
+static void generic_final_register (struct finalisable *final, value f, value v)
+{
+  if (!Is_block (v)
+      || !Is_in_heap_or_young(v)
+      || Tag_val (v) == Lazy_tag
+#ifdef FLAT_FLOAT_ARRAY
+      || Tag_val (v) == Double_tag
+#endif
+      || Tag_val (v) == Forward_tag) {
+    caml_invalid_argument ("Gc.finalise");
+  }
+  CAMLassert (final->old <= final->young);
+
+  if (final->young >= final->size){
+    if (final->table == NULL){
+      uintnat new_size = 30;
+      final->table = caml_stat_alloc (new_size * sizeof (struct final));
+      CAMLassert (final->old == 0);
+      CAMLassert (final->young == 0);
+      final->size = new_size;
+    }else{
+      uintnat new_size = final->size * 2;
+      final->table = caml_stat_resize (final->table,
+                                      new_size * sizeof (struct final));
+      final->size = new_size;
+    }
+  }
+  CAMLassert (final->young < final->size);
+  final->table[final->young].fun = f;
+  if (Tag_val (v) == Infix_tag){
+    final->table[final->young].offset = Infix_offset_val (v);
+    final->table[final->young].val = v - Infix_offset_val (v);
+  }else{
+    final->table[final->young].offset = 0;
+    final->table[final->young].val = v;
+  }
+  ++ final->young;
+
+}
+
+CAMLprim value caml_final_register (value f, value v){
+  generic_final_register(&finalisable_first, f, v);
+  return Val_unit;
+}
+
+CAMLprim value caml_final_register_called_without_value (value f, value v){
+  generic_final_register(&finalisable_last, f, v);
+  return Val_unit;
+}
+
+CAMLprim value caml_final_release (value unit)
+{
+  running_finalisation_function = 0;
+  /* Some finalisers might be waiting. */
+  if (to_do_tl != NULL)
+    caml_set_action_pending();
+  return Val_unit;
+}
+
+static void gen_final_invariant_check(struct finalisable *final){
+  uintnat i;
+
+  CAMLassert (final->old <= final->young);
+  for (i = 0; i < final->old; i++){
+    CAMLassert( Is_in_heap(final->table[i].val) );
+  };
+  for (i = final->old; i < final->young; i++){
+    CAMLassert( Is_in_heap_or_young(final->table[i].val) );
+  };
+}
+
+void caml_final_invariant_check(void){
+  gen_final_invariant_check(&finalisable_first);
+  gen_final_invariant_check(&finalisable_last);
+}
diff --git a/runtime/fix_code.c b/runtime/fix_code.c
new file mode 100644
index 00000000..3cfcac49
--- /dev/null
+++ b/runtime/fix_code.c
@@ -0,0 +1,184 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* Handling of blocks of bytecode (endianness switch, threading). */
+
+#include "caml/config.h"
+
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#else
+#include <io.h>
+#endif
+
+#include "caml/debugger.h"
+#include "caml/fix_code.h"
+#include "caml/instruct.h"
+#include "caml/intext.h"
+#include "caml/md5.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/reverse.h"
+
+code_t caml_start_code;
+asize_t caml_code_size;
+struct ext_table caml_code_fragments_table;
+
+/* Read the main bytecode block from a file */
+
+void caml_init_code_fragments(void) {
+  struct code_fragment * cf;
+  /* Register the code in the table of code fragments */
+  cf = caml_stat_alloc(sizeof(struct code_fragment));
+  cf->code_start = (char *) caml_start_code;
+  cf->code_end = (char *) caml_start_code + caml_code_size;
+  caml_md5_block(cf->digest, caml_start_code, caml_code_size);
+  cf->digest_computed = 1;
+  caml_ext_table_init(&caml_code_fragments_table, 8);
+  caml_ext_table_add(&caml_code_fragments_table, cf);
+}
+
+void caml_load_code(int fd, asize_t len)
+{
+  caml_code_size = len;
+  caml_start_code = (code_t) caml_stat_alloc(caml_code_size);
+  if (read(fd, (char *) caml_start_code, caml_code_size) != caml_code_size)
+    caml_fatal_error("truncated bytecode file");
+  caml_init_code_fragments();
+  /* Prepare the code for execution */
+#ifdef ARCH_BIG_ENDIAN
+  caml_fixup_endianness(caml_start_code, caml_code_size);
+#endif
+#ifdef THREADED_CODE
+  caml_thread_code(caml_start_code, caml_code_size);
+#endif
+}
+
+/* This code is needed only if the processor is big endian */
+
+#ifdef ARCH_BIG_ENDIAN
+
+void caml_fixup_endianness(code_t code, asize_t len)
+{
+  code_t p;
+  len /= sizeof(opcode_t);
+  for (p = code; p < code + len; p++) {
+    Reverse_32(p, p);
+  }
+}
+
+#endif
+
+/* This code is needed only if we're using threaded code */
+
+#ifdef THREADED_CODE
+
+char ** caml_instr_table;
+char * caml_instr_base;
+
+static int* opcode_nargs = NULL;
+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++) {
+      l [i] = 0;
+    }
+    /* Instructions with one operand */
+    l[PUSHACC] = l[ACC] = l[POP] = l[ASSIGN] =
+      l[PUSHENVACC] = l[ENVACC] = l[PUSH_RETADDR] = l[APPLY] =
+      l[APPTERM1] = l[APPTERM2] = l[APPTERM3] = l[RETURN] =
+      l[GRAB] = l[PUSHGETGLOBAL] = l[GETGLOBAL] = l[SETGLOBAL] =
+      l[PUSHATOM] = l[ATOM] = l[MAKEBLOCK1] = l[MAKEBLOCK2] =
+      l[MAKEBLOCK3] = l[MAKEFLOATBLOCK] = l[GETFIELD] =
+      l[GETFLOATFIELD] = l[SETFIELD] = l[SETFLOATFIELD] =
+      l[BRANCH] = l[BRANCHIF] = l[BRANCHIFNOT] = l[PUSHTRAP] =
+      l[C_CALL1] = l[C_CALL2] = l[C_CALL3] = l[C_CALL4] = l[C_CALL5] =
+      l[CONSTINT] = l[PUSHCONSTINT] = l[OFFSETINT] =
+      l[OFFSETREF] = l[OFFSETCLOSURE] = l[PUSHOFFSETCLOSURE] = 1;
+
+    /* Instructions with two operands */
+    l[APPTERM] = l[CLOSURE] = l[PUSHGETGLOBALFIELD] =
+      l[GETGLOBALFIELD] = l[MAKEBLOCK] = l[C_CALLN] =
+      l[BEQ] = l[BNEQ] = l[BLTINT] = l[BLEINT] = l[BGTINT] = l[BGEINT] =
+      l[BULTINT] = l[BUGEINT] = l[GETPUBMET] = 2;
+
+    opcode_nargs = l;
+  }
+  return opcode_nargs;
+}
+
+void caml_thread_code (code_t code, asize_t len)
+{
+  code_t p;
+  int* l = caml_init_opcode_nargs();
+  len /= sizeof(opcode_t);
+  for (p = code; p < code + len; /*nothing*/) {
+    opcode_t instr = *p;
+    if (instr < 0 || instr >= FIRST_UNIMPLEMENTED_OP){
+      /* FIXME -- should Assert(false) ?
+      caml_fatal_error ("in fix_code: bad opcode (%lx)",
+                            (char *)(long)instr);
+      */
+      instr = STOP;
+    }
+    *p++ = (opcode_t)(caml_instr_table[instr] - caml_instr_base);
+    if (instr == SWITCH) {
+      uint32_t sizes = *p++;
+      uint32_t const_size = sizes & 0xFFFF;
+      uint32_t block_size = sizes >> 16;
+      p += const_size + block_size;
+    } else if (instr == CLOSUREREC) {
+      uint32_t nfuncs = *p++;
+      p++;                      /* skip nvars */
+      p += nfuncs;
+    } else {
+      p += l[instr];
+    }
+  }
+  CAMLassert(p == code + len);
+}
+
+#else
+
+int* caml_init_opcode_nargs()
+{
+  return NULL;
+}
+
+#endif /* THREADED_CODE */
+
+void caml_set_instruction(code_t pos, opcode_t instr)
+{
+#ifdef THREADED_CODE
+  *pos = (opcode_t)(caml_instr_table[instr] - caml_instr_base);
+#else
+  *pos = instr;
+#endif
+}
+
+int caml_is_instruction(opcode_t instr1, opcode_t instr2)
+{
+#ifdef THREADED_CODE
+  return instr1 == (opcode_t)(caml_instr_table[instr2] - caml_instr_base);
+#else
+  return instr1 == instr2;
+#endif
+}
diff --git a/runtime/floats.c b/runtime/floats.c
new file mode 100644
index 00000000..c8176502
--- /dev/null
+++ b/runtime/floats.c
@@ -0,0 +1,1069 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* The interface of this file is in "caml/mlvalues.h" and "caml/alloc.h" */
+
+/* Needed for uselocale */
+#define _XOPEN_SOURCE 700
+
+/* Needed for strtod_l */
+#define _GNU_SOURCE
+
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <float.h>
+#include <limits.h>
+
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "caml/misc.h"
+#include "caml/reverse.h"
+#include "caml/stacks.h"
+
+#if defined(HAS_LOCALE) || defined(__MINGW32__)
+
+#if defined(HAS_LOCALE_H) || defined(__MINGW32__)
+#include <locale.h>
+#endif
+
+#if defined(HAS_XLOCALE_H)
+#include <xlocale.h>
+#endif
+
+#if defined(_MSC_VER)
+#ifndef locale_t
+#define locale_t _locale_t
+#endif
+#ifndef freelocale
+#define freelocale _free_locale
+#endif
+#ifndef strtod_l
+#define strtod_l _strtod_l
+#endif
+#endif
+
+#endif /* defined(HAS_LOCALE) */
+
+#ifdef _MSC_VER
+#include <float.h>
+#ifndef isnan
+#define isnan _isnan
+#endif
+#ifndef isfinite
+#define isfinite _finite
+#endif
+#ifndef nextafter
+#define nextafter _nextafter
+#endif
+#endif
+
+#ifdef ARCH_ALIGN_DOUBLE
+
+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;
+}
+
+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];
+}
+
+#endif
+
+/*
+ OCaml runtime itself doesn't call setlocale, i.e. it is using
+ standard "C" locale by default, but it is possible that
+ third-party code loaded into process does.
+*/
+#ifdef HAS_LOCALE
+locale_t caml_locale = (locale_t)0;
+#endif
+
+#if defined(_MSC_VER) || defined(__MINGW32__)
+/* there is no analogue to uselocale in MSVC so just set locale for thread */
+#define USE_LOCALE setlocale(LC_NUMERIC,"C")
+#define RESTORE_LOCALE do {} while(0)
+#elif defined(HAS_LOCALE)
+#define USE_LOCALE locale_t saved_locale = uselocale(caml_locale)
+#define RESTORE_LOCALE uselocale(saved_locale)
+#else
+#define USE_LOCALE do {} while(0)
+#define RESTORE_LOCALE do {} while(0)
+#endif
+
+void caml_init_locale(void)
+{
+#if defined(_MSC_VER) || defined(__MINGW32__)
+  _configthreadlocale(_ENABLE_PER_THREAD_LOCALE);
+#endif
+#ifdef HAS_LOCALE
+  if ((locale_t)0 == caml_locale)
+  {
+#if defined(_MSC_VER)
+    caml_locale = _create_locale(LC_NUMERIC, "C");
+#else
+    caml_locale = newlocale(LC_NUMERIC_MASK,"C",(locale_t)0);
+#endif
+  }
+#endif
+}
+
+void caml_free_locale(void)
+{
+#ifdef HAS_LOCALE
+  if ((locale_t)0 != caml_locale) freelocale(caml_locale);
+  caml_locale = (locale_t)0;
+#endif
+}
+
+CAMLexport value caml_copy_double(double d)
+{
+  value res;
+
+#define Setup_for_gc
+#define Restore_after_gc
+  Alloc_small(res, Double_wosize, Double_tag);
+#undef Setup_for_gc
+#undef Restore_after_gc
+  Store_double_val(res, d);
+  return res;
+}
+
+#ifndef FLAT_FLOAT_ARRAY
+CAMLexport void caml_Store_double_array_field(value val, mlsize_t i, double dbl)
+{
+  CAMLparam1 (val);
+  value d = caml_copy_double (dbl);
+
+  CAMLassert (Tag_val (val) != Double_array_tag);
+  caml_modify (&Field(val, i), d);
+  CAMLreturn0;
+}
+#endif /* ! FLAT_FLOAT_ARRAY */
+
+CAMLprim value caml_format_float(value fmt, value arg)
+{
+  value res;
+  double d = Double_val(arg);
+
+#ifdef HAS_BROKEN_PRINTF
+  if (isfinite(d)) {
+#endif
+    USE_LOCALE;
+    res = caml_alloc_sprintf(String_val(fmt), d);
+    RESTORE_LOCALE;
+#ifdef HAS_BROKEN_PRINTF
+  } else {
+    if (isnan(d)) {
+      res = caml_copy_string("nan");
+    } else {
+      if (d > 0)
+        res = caml_copy_string("inf");
+      else
+        res = caml_copy_string("-inf");
+    }
+  }
+#endif
+  return res;
+}
+
+CAMLprim value caml_hexstring_of_float(value arg, value vprec, value vstyle)
+{
+  union { uint64_t i; double d; } u;
+  int sign, exp;
+  uint64_t m;
+  char buffer[64];
+  char * buf, * p;
+  intnat prec;
+  int d;
+  value res;
+
+  /* Allocate output buffer */
+  prec = Long_val(vprec);
+                  /* 12 chars for sign, 0x, decimal point, exponent */
+  buf = (prec + 12 <= 64 ? buffer : caml_stat_alloc(prec + 12));
+  /* Extract sign, mantissa, and exponent */
+  u.d = Double_val(arg);
+  sign = u.i >> 63;
+  exp = (u.i >> 52) & 0x7FF;
+  m = u.i & (((uint64_t) 1 << 52) - 1);
+  /* Put sign */
+  p = buf;
+  if (sign) {
+    *p++ = '-';
+  } else {
+    switch (Int_val(vstyle)) {
+    case '+': *p++ = '+'; break;
+    case ' ': *p++ = ' '; break;
+    }
+  }
+  /* Treat special cases */
+  if (exp == 0x7FF) {
+    char * txt;
+    if (m == 0) txt = "infinity"; else txt = "nan";
+    memcpy(p, txt, strlen(txt));
+    p[strlen(txt)] = 0;
+    res = caml_copy_string(buf);
+  } else {
+    /* Output "0x" prefix */
+    *p++ = '0'; *p++ = 'x';
+    /* Normalize exponent and mantissa */
+    if (exp == 0) {
+      if (m != 0) exp = -1022;    /* denormal */
+    } else {
+      exp = exp - 1023;
+      m = m | ((uint64_t) 1 << 52);
+    }
+    /* If a precision is given, and is small, round mantissa accordingly */
+    prec = Long_val(vprec);
+    if (prec >= 0 && prec < 13) {
+      int i = 52 - prec * 4;
+      uint64_t unit = (uint64_t) 1 << i;
+      uint64_t half = unit >> 1;
+      uint64_t mask = unit - 1;
+      uint64_t frac = m & mask;
+      m = m & ~mask;
+      /* Round to nearest, ties to even */
+      if (frac > half || (frac == half && (m & unit) != 0)) {
+        m += unit;
+      }
+    }
+    /* Leading digit */
+    d = m >> 52;
+    *p++ = (d < 10 ? d + '0' : d - 10 + 'a');
+    m = (m << 4) & (((uint64_t) 1 << 56) - 1);
+    /* Fractional digits.  If a precision is given, print that number of
+       digits.  Otherwise, print as many digits as needed to represent
+       the mantissa exactly. */
+    if (prec >= 0 ? prec > 0 : m != 0) {
+      *p++ = '.';
+      while (prec >= 0 ? prec > 0 : m != 0) {
+        d = m >> 52;
+        *p++ = (d < 10 ? d + '0' : d - 10 + 'a');
+        m = (m << 4) & (((uint64_t) 1 << 56) - 1);
+        prec--;
+      }
+    }
+    *p = 0;
+    /* Add exponent */
+    res = caml_alloc_sprintf("%sp%+d", buf, exp);
+  }
+  if (buf != buffer) caml_stat_free(buf);
+  return res;
+}
+
+static int caml_float_of_hex(const char * s, const char * end, double * res)
+{
+  int64_t m = 0;                /* the mantissa - top 60 bits at most */
+  int n_bits = 0;               /* total number of bits read */
+  int m_bits = 0;               /* number of bits in mantissa */
+  int x_bits = 0;               /* number of bits after mantissa */
+  int dec_point = -1;           /* bit count corresponding to decimal point */
+                                /* -1 if no decimal point seen */
+  int exp = 0;                  /* exponent */
+  char * p;                     /* for converting the exponent */
+  double f;
+
+  while (s < end) {
+    char c = *s++;
+    switch (c) {
+    case '.':
+      if (dec_point >= 0) return -1; /* multiple decimal points */
+      dec_point = n_bits;
+      break;
+    case 'p': case 'P': {
+      long e;
+      if (*s == 0) return -1;   /* nothing after exponent mark */
+      e = strtol(s, &p, 10);
+      if (p != end) return -1;  /* ill-formed exponent */
+      /* Handle exponents larger than int by returning 0/infinity directly.
+         Mind that INT_MIN/INT_MAX are included in the test so as to capture
+         the overflow case of strtol on Win64 -- long and int have the same
+         size there. */
+      if (e <= INT_MIN) {
+        *res = 0.;
+        return 0;
+      }
+      else if (e >= INT_MAX) {
+        *res = m == 0 ? 0. : HUGE_VAL;
+        return 0;
+      }
+      /* regular exponent value */
+      exp = e;
+      s = p;                    /* stop at next loop iteration */
+      break;
+    }
+    default: {                  /* Nonzero digit */
+      int d;
+      if (c >= '0' && c <= '9') d = c - '0';
+      else if (c >= 'A' && c <= 'F') d = c - 'A' + 10;
+      else if (c >= 'a' && c <= 'f') d = c - 'a' + 10;
+      else return -1;           /* bad digit */
+      n_bits += 4;
+      if (d == 0 && m == 0) break; /* leading zeros are skipped */
+      if (m_bits < 60) {
+        /* There is still room in m.  Add this digit to the mantissa. */
+        m = (m << 4) + d;
+        m_bits += 4;
+      } else {
+        /* We've already collected 60 significant bits in m.
+           Now all we care about is whether there is a nonzero bit
+           after. In this case, round m to odd so that the later
+           rounding of m to FP produces the correct result. */
+        if (d != 0) m |= 1;        /* round to odd */
+        x_bits += 4;
+      }
+      break;
+    }
+    }
+  }
+  if (n_bits == 0) return -1;
+  /* Convert mantissa to FP.  We use a signed conversion because we can
+     (m has 60 bits at most) and because it is faster
+     on several architectures. */
+  f = (double) (int64_t) m;
+  /* Adjust exponent to take decimal point and extra digits into account */
+  {
+    int adj = x_bits;
+    if (dec_point >= 0) adj = adj + (dec_point - n_bits);
+    /* saturated addition exp + adj */
+    if (adj > 0 && exp > INT_MAX - adj)
+      exp = INT_MAX;
+    else if (adj < 0 && exp < INT_MIN - adj)
+      exp = INT_MIN;
+    else
+      exp = exp + adj;
+  }
+  /* Apply exponent if needed */
+  if (exp != 0) f = ldexp(f, exp);
+  /* Done! */
+  *res = f;
+  return 0;
+}
+
+CAMLprim value caml_float_of_string(value vs)
+{
+  char parse_buffer[64];
+  char * buf, * dst, * end;
+  const char *src;
+  mlsize_t len;
+  int sign;
+  double d;
+
+  /* Remove '_' characters before conversion */
+  len = caml_string_length(vs);
+  buf = len < sizeof(parse_buffer) ? parse_buffer : caml_stat_alloc(len + 1);
+  src = String_val(vs);
+  dst = buf;
+  while (len--) {
+    char c = *src++;
+    if (c != '_') *dst++ = c;
+  }
+  *dst = 0;
+  if (dst == buf) goto error;
+  /* Check for hexadecimal FP constant */
+  src = buf;
+  sign = 1;
+  if (*src == '-') { sign = -1; src++; }
+  else if (*src == '+') { src++; };
+  if (src[0] == '0' && (src[1] == 'x' || src[1] == 'X')) {
+    /* Convert using our hexadecimal FP parser */
+    if (caml_float_of_hex(src + 2, dst, &d) == -1) goto error;
+    if (sign < 0) d = -d;
+  } else {
+    /* Convert using strtod */
+#if defined(HAS_STRTOD_L) && defined(HAS_LOCALE)
+    d = strtod_l((const char *) buf, &end, caml_locale);
+#else
+    USE_LOCALE;
+    d = strtod((const char *) buf, &end);
+    RESTORE_LOCALE;
+#endif /* HAS_STRTOD_L */
+    if (end != dst) goto error;
+  }
+  if (buf != parse_buffer) caml_stat_free(buf);
+  return caml_copy_double(d);
+ error:
+  if (buf != parse_buffer) caml_stat_free(buf);
+  caml_failwith("float_of_string");
+  return Val_unit; /* not reached */
+}
+
+CAMLprim value caml_int_of_float(value f)
+{
+  return Val_long((intnat) Double_val(f));
+}
+
+CAMLprim value caml_float_of_int(value n)
+{
+  return caml_copy_double((double) Long_val(n));
+}
+
+CAMLprim value caml_neg_float(value f)
+{
+  return caml_copy_double(- Double_val(f));
+}
+
+CAMLprim value caml_abs_float(value f)
+{
+  return caml_copy_double(fabs(Double_val(f)));
+}
+
+CAMLprim value caml_add_float(value f, value g)
+{
+  return caml_copy_double(Double_val(f) + Double_val(g));
+}
+
+CAMLprim value caml_sub_float(value f, value g)
+{
+  return caml_copy_double(Double_val(f) - Double_val(g));
+}
+
+CAMLprim value caml_mul_float(value f, value g)
+{
+  return caml_copy_double(Double_val(f) * Double_val(g));
+}
+
+CAMLprim value caml_div_float(value f, value g)
+{
+  return caml_copy_double(Double_val(f) / Double_val(g));
+}
+
+CAMLprim value caml_exp_float(value f)
+{
+  return caml_copy_double(exp(Double_val(f)));
+}
+
+CAMLexport double caml_trunc(double x)
+{
+#ifdef HAS_C99_FLOAT_OPS
+  return trunc(x);
+#else
+  return (x >= 0.0)? floor(x) : ceil(x);
+#endif
+}
+
+CAMLprim value caml_trunc_float(value f)
+{
+  return caml_copy_double(caml_trunc(Double_val(f)));
+}
+
+CAMLexport double caml_round(double f)
+{
+#ifdef HAS_C99_FLOAT_OPS
+  return round(f);
+#else
+  union { uint64_t i; double d; } u, pred_one_half; /* predecessor of 0.5 */
+  int e;  /* exponent */
+  u.d = f;
+  e = (u.i >> 52) & 0x7ff; /* - 0x3ff for the actual exponent */
+  pred_one_half.i = 0x3FDFFFFFFFFFFFFF; /* 0x1.FFFFFFFFFFFFFp-2 */
+
+  if (isfinite(f) && f != 0.) {
+    if (e >= 52 + 0x3ff) return f; /* f is an integer already */
+    if (f > 0.0)
+      /* If we added 0.5 instead of its predecessor, then the
+         predecessor of 0.5 would be rounded to 1. instead of 0. */
+      return floor(f + pred_one_half.d);
+    else
+      return ceil(f - pred_one_half.d);
+  }
+  else
+    return f;
+#endif
+}
+
+CAMLprim value caml_round_float(value f)
+{
+  return caml_copy_double(caml_round(Double_val(f)));
+}
+
+CAMLprim value caml_floor_float(value f)
+{
+  return caml_copy_double(floor(Double_val(f)));
+}
+
+CAMLexport double caml_nextafter(double x, double y)
+{
+  return nextafter(x, y);
+}
+
+CAMLprim value caml_nextafter_float(value x, value y)
+{
+  return caml_copy_double(caml_nextafter(Double_val(x), Double_val(y)));
+}
+
+#ifndef HAS_WORKING_FMA
+union double_as_int64 { double d; uint64_t i; };
+#define IEEE754_DOUBLE_BIAS 0x3ff
+#define IEEE_EXPONENT(N) (((N) >> 52) & 0x7ff)
+#define IEEE_NEGATIVE(N) ((N) >> 63)
+//C99 hexa float literals cannot be used, use pow() instead.
+#define FL53    (pow(2,53)) //0x1p53
+#define FLM53   (pow(2,-53)) //0x1p-53
+#define FL54    (pow(2,54)) //0x1p54
+#define FLM54   (pow(2,-54)) //0x1p-54
+#define FL108   (pow(2,108)) //0x1p108
+#define FLM108  (pow(2,-108)) //0x1p-108
+#define FLM1074 (pow(2,-1074)) //0x1p-1074
+#endif
+
+CAMLexport double caml_fma(double x, double y, double z)
+{
+#ifdef HAS_WORKING_FMA
+  return fma(x, y, z);
+#else // Emulation of FMA, from S. Boldo and G. Melquiond, "Emulation
+      // of a FMA and Correctly Rounded Sums: Proved Algorithms Using
+      // Rounding to Odd," in IEEE Transactions on Computers, vol. 57,
+      // no. 4, pp. 462-471, April 2008. Special cases implementation
+      // comes from glibc's IEEE754 FMA emulation.
+      // Only valid for double precision and round-to-nearest mode.
+
+  union double_as_int64 u, v, w;
+  union double_as_int64 ora;
+  double mh, ml, xh, xl, yh, yl, t;
+  double ah, al;
+  double orah, oral;
+  double t1, t2;
+  double tiny;
+  int neg, adjust = 0;
+  u.d = x;
+  v.d = y;
+  w.d = z;
+
+  if ( IEEE_EXPONENT(u.i) + IEEE_EXPONENT(v.i) >= 0x7FF +
+       IEEE754_DOUBLE_BIAS - DBL_MANT_DIG
+       || IEEE_EXPONENT(u.i) >= 0x7ff - DBL_MANT_DIG
+       || IEEE_EXPONENT(v.i) >= 0x7ff - DBL_MANT_DIG
+       || IEEE_EXPONENT(w.i) >= 0x7ff - DBL_MANT_DIG
+       || IEEE_EXPONENT(u.i) + IEEE_EXPONENT(v.i) <=
+         IEEE754_DOUBLE_BIAS + DBL_MANT_DIG )
+    {
+      /* If z is Inf, but x and y are finite, the result should be z
+       * rather than NaN. */
+      if (IEEE_EXPONENT(w.i) == 0x7ff &&
+          IEEE_EXPONENT(u.i) != 0x7ff &&
+          IEEE_EXPONENT(v.i) != 0x7ff)
+              return (z + x) + y;
+      /* If z is zero and x and y are nonzero, compute the result as
+         x * y to avoid the wrong sign of a zero result if x * y
+         underflows to 0. */
+      if (z == 0 && x != 0 && y != 0)
+        return x * y;
+      /* If x or y or z is Inf/NaN, or if x * y is zero, compute as
+         x * y + z.  */
+      if (IEEE_EXPONENT(u.i) == 0x7ff
+          || IEEE_EXPONENT(v.i) == 0x7ff
+          || IEEE_EXPONENT(w.i) == 0x7ff
+          || x == 0
+          || y == 0)
+        return x * y + z;
+      /* If fma will certainly overflow, compute as x * y. */
+      if ((IEEE_EXPONENT(u.i) + IEEE_EXPONENT(v.i))
+          > 0x7ff + IEEE754_DOUBLE_BIAS)
+        return x * y;
+      /* If x * y is less than 1/4 of DBL_TRUE_MIN, neither the result
+         nor whether there is underflow depends on its exact value,
+         only on its sign. */
+      if (IEEE_EXPONENT(u.i) + IEEE_EXPONENT(v.i)
+          < IEEE754_DOUBLE_BIAS - DBL_MANT_DIG - 2)
+        {
+          neg = IEEE_NEGATIVE(u.i) ^ IEEE_NEGATIVE(v.i) ;
+          tiny = neg ? -FLM1074 : FLM1074;
+          if (IEEE_EXPONENT(w.i) >= 3)
+            return tiny + z;
+          /* Scaling up, adding TINY and scaling down produces the
+             correct result, because in round-to-nearest mode adding
+             TINY has no effect and in other modes double rounding is
+             harmless. But it may not produce required underflow
+             exceptions. */
+          v.d = z * FL54 + tiny;
+          return v.d * FLM54;
+        }
+      if (IEEE_EXPONENT(u.i) + IEEE_EXPONENT(v.i)
+          >= 0x7ff + IEEE754_DOUBLE_BIAS - DBL_MANT_DIG)
+        {
+          /* Compute 1p-53 times smaller result and multiply at the
+             end.  */
+          if (IEEE_EXPONENT(u.i) > IEEE_EXPONENT(v.i))
+            x *= FLM53;
+          else
+            y *= FLM53;
+          /* If x + y exponent is very large and z exponent is very small,
+             it doesn't matter if we don't adjust it.  */
+          if (IEEE_EXPONENT(w.i) > DBL_MANT_DIG)
+            z *= FLM53;
+          adjust = 1;
+        }
+      else if (IEEE_EXPONENT(w.i) >= 0x7ff - DBL_MANT_DIG)
+        {
+          /* Similarly. If z exponent is very large and x and y
+             exponents are very small, adjust them up to avoid
+             spurious underflows, rather than down.  */
+          if (IEEE_EXPONENT(u.i) + IEEE_EXPONENT(v.i)
+              <= IEEE754_DOUBLE_BIAS + 2 * DBL_MANT_DIG)
+            {
+              if (IEEE_EXPONENT(u.i) > IEEE_EXPONENT(v.i))
+                x *= FL108;
+              else
+                y *= FL108;
+            }
+          else if (IEEE_EXPONENT(u.i) > IEEE_EXPONENT(v.i))
+            {
+              if (IEEE_EXPONENT(u.i) > DBL_MANT_DIG)
+                x *= FLM53;
+            }
+          else if (IEEE_EXPONENT(v.i) > DBL_MANT_DIG)
+            y *= FLM53;
+          z *= FLM53;
+          adjust = 1;
+        }
+      else if (IEEE_EXPONENT(u.i) >= 0x7ff - DBL_MANT_DIG)
+        {
+          x *= FLM53;
+          y *= FL53;
+        }
+      else if (IEEE_EXPONENT(v.i) >= 0x7ff - DBL_MANT_DIG)
+        {
+          y *= FLM53;
+          x *= FL53;
+        }
+      else /* if (IEEE_EXPONENT(u.i) + IEEE_EXPONENT(v.i) <=
+              IEEE754_DOUBLE_BIAS + DBL_MANT_DIG) */
+        {
+          if (IEEE_EXPONENT(u.i) > IEEE_EXPONENT(v.i))
+            x *= FL108;
+          else
+            y *= FL108;
+          if (IEEE_EXPONENT(w.i) <= 4 * DBL_MANT_DIG + 6)
+            {
+              z *= FL108;
+              adjust = -1;
+            }
+        }
+    }
+
+  /* Ensure correct sign of exact 0 + 0.  */
+  if ((x == 0 || y == 0) && z == 0)
+    return x * y + z;
+
+  // Error-free multiplication: mh + ml = x * y
+  mh = x * y;
+  t = x * 134217729.0;
+  xh = t - (t - x);
+  xl = x - xh;
+  t = y * 134217729.0;
+  yh = t - (t - y);
+  yl = y - yh;
+  ml = xl * yl - (((mh - xh * yh) - xl * yh) - xh * yl);
+  // Error-free addition: ah + al = z + mh
+  ah = z + mh;
+  t = ah - z;
+  al = (z - (ah - t)) + (mh - t);
+
+  /* If the result is an exact zero, ensure it has the correct sign. */
+  if (ah == 0 && ml == 0)
+    return z + mh;
+
+  // Normalize ah, al, ml.
+  t1 = al + ml;
+  t = t1 - al;
+  t2 = (al - (t1 - t)) + (ml - t);
+  al = t1;
+  ml = t2;
+  t1 = ah + al;
+  t = t1 - ah;
+  t2 = (ah - (t1 - t)) + (al - t);
+  ah = t1;
+  al = t2;
+
+  // Odd-rounded addition: ora = al + ml.
+  orah = al + ml;
+  oral = (al - orah) + ml;
+
+  if ( oral != 0.0 )
+    {
+      ora.d = orah;
+      if ( !(ora.i & 1) )
+        {
+          if ( (oral > 0.0) ^ (orah < 0.0) )
+            ora.i++;
+          else
+            ora.i--;
+          orah = ora.d;
+        }
+    }
+
+  // Rounded addition: ra = ah + orah.
+  if ( adjust > 0 )
+    return (ah + orah) * FL53;
+  else if ( adjust < 0 )
+    return (ah + orah) * FLM108;
+  else
+    return ah + orah;
+#endif
+}
+
+CAMLprim value caml_fma_float(value f1, value f2, value f3)
+{
+  return caml_copy_double(caml_fma(Double_val(f1),
+                                   Double_val(f2), Double_val(f3)));
+}
+
+CAMLprim value caml_fmod_float(value f1, value f2)
+{
+  return caml_copy_double(fmod(Double_val(f1), Double_val(f2)));
+}
+
+CAMLprim value caml_frexp_float(value f)
+{
+  CAMLparam1 (f);
+  CAMLlocal2 (res, mantissa);
+  int exponent;
+
+  mantissa = caml_copy_double(frexp (Double_val(f), &exponent));
+  res = caml_alloc_tuple(2);
+  Field(res, 0) = mantissa;
+  Field(res, 1) = Val_int(exponent);
+  CAMLreturn (res);
+}
+
+// Seems dumb but intnat could not correspond to int type.
+double caml_ldexp_float_unboxed(double f, intnat i)
+{
+  return ldexp(f, (int) i);
+}
+
+
+CAMLprim value caml_ldexp_float(value f, value i)
+{
+  return caml_copy_double(ldexp(Double_val(f), Int_val(i)));
+}
+
+CAMLprim value caml_log_float(value f)
+{
+  return caml_copy_double(log(Double_val(f)));
+}
+
+CAMLprim value caml_log10_float(value f)
+{
+  return caml_copy_double(log10(Double_val(f)));
+}
+
+CAMLprim value caml_modf_float(value f)
+{
+  double frem;
+
+  CAMLparam1 (f);
+  CAMLlocal3 (res, quo, rem);
+
+  quo = caml_copy_double(modf (Double_val(f), &frem));
+  rem = caml_copy_double(frem);
+  res = caml_alloc_tuple(2);
+  Field(res, 0) = quo;
+  Field(res, 1) = rem;
+  CAMLreturn (res);
+}
+
+CAMLprim value caml_sqrt_float(value f)
+{
+  return caml_copy_double(sqrt(Double_val(f)));
+}
+
+CAMLprim value caml_power_float(value f, value g)
+{
+  return caml_copy_double(pow(Double_val(f), Double_val(g)));
+}
+
+CAMLprim value caml_sin_float(value f)
+{
+  return caml_copy_double(sin(Double_val(f)));
+}
+
+CAMLprim value caml_sinh_float(value f)
+{
+  return caml_copy_double(sinh(Double_val(f)));
+}
+
+CAMLprim value caml_cos_float(value f)
+{
+  return caml_copy_double(cos(Double_val(f)));
+}
+
+CAMLprim value caml_cosh_float(value f)
+{
+  return caml_copy_double(cosh(Double_val(f)));
+}
+
+CAMLprim value caml_tan_float(value f)
+{
+  return caml_copy_double(tan(Double_val(f)));
+}
+
+CAMLprim value caml_tanh_float(value f)
+{
+  return caml_copy_double(tanh(Double_val(f)));
+}
+
+CAMLprim value caml_asin_float(value f)
+{
+  return caml_copy_double(asin(Double_val(f)));
+}
+
+CAMLprim value caml_acos_float(value f)
+{
+  return caml_copy_double(acos(Double_val(f)));
+}
+
+CAMLprim value caml_atan_float(value f)
+{
+  return caml_copy_double(atan(Double_val(f)));
+}
+
+CAMLprim value caml_atan2_float(value f, value g)
+{
+  return caml_copy_double(atan2(Double_val(f), Double_val(g)));
+}
+
+CAMLprim value caml_ceil_float(value f)
+{
+  return caml_copy_double(ceil(Double_val(f)));
+}
+
+CAMLexport double caml_hypot(double x, double y)
+{
+#ifdef HAS_C99_FLOAT_OPS
+  return hypot(x, y);
+#else
+  double tmp, ratio;
+  x = fabs(x); y = fabs(y);
+  if (x != x) /* x is NaN */
+    return y > DBL_MAX ? y : x;  /* PR#6321 */
+  if (y != y) /* y is NaN */
+    return x > DBL_MAX ? x : y;  /* PR#6321 */
+  if (x < y) { tmp = x; x = y; y = tmp; }
+  if (x == 0.0) return 0.0;
+  ratio = y / x;
+  return x * sqrt(1.0 + ratio * ratio);
+#endif
+}
+
+CAMLprim value caml_hypot_float(value f, value g)
+{
+  return caml_copy_double(caml_hypot(Double_val(f), Double_val(g)));
+}
+
+/* These emulations of expm1() and log1p() are due to William Kahan.
+   See http://www.plunk.org/~hatch/rightway.php */
+CAMLexport double caml_expm1(double x)
+{
+#ifdef HAS_C99_FLOAT_OPS
+  return expm1(x);
+#else
+  double u = exp(x);
+  if (u == 1.)
+    return x;
+  if (u - 1. == -1.)
+    return -1.;
+  return (u - 1.) * x / log(u);
+#endif
+}
+
+CAMLexport double caml_log1p(double x)
+{
+#ifdef HAS_C99_FLOAT_OPS
+  return log1p(x);
+#else
+  double u = 1. + x;
+  if (u == 1.)
+    return x;
+  else
+    return log(u) * x / (u - 1.);
+#endif
+}
+
+CAMLprim value caml_expm1_float(value f)
+{
+  return caml_copy_double(caml_expm1(Double_val(f)));
+}
+
+CAMLprim value caml_log1p_float(value f)
+{
+  return caml_copy_double(caml_log1p(Double_val(f)));
+}
+
+union double_as_two_int32 {
+    double d;
+#if defined(ARCH_BIG_ENDIAN) || (defined(__arm__) && !defined(__ARM_EABI__))
+    struct { uint32_t h; uint32_t l; } i;
+#else
+    struct { uint32_t l; uint32_t h; } i;
+#endif
+};
+
+CAMLexport double caml_copysign(double x, double y)
+{
+#ifdef HAS_C99_FLOAT_OPS
+  return copysign(x, y);
+#else
+  union double_as_two_int32 ux, uy;
+  ux.d = x;
+  uy.d = y;
+  ux.i.h &= 0x7FFFFFFFU;
+  ux.i.h |= (uy.i.h & 0x80000000U);
+  return ux.d;
+#endif
+}
+
+CAMLprim value caml_copysign_float(value f, value g)
+{
+  return caml_copy_double(caml_copysign(Double_val(f), Double_val(g)));
+}
+
+CAMLprim value caml_signbit(double x)
+{
+#ifdef HAS_C99_FLOAT_OPS
+  return Val_bool(signbit(x));
+#else
+  union double_as_two_int32 ux;
+  ux.d = x;
+  return Val_bool(ux.i.h >> 31);
+#endif
+}
+
+CAMLprim value caml_signbit_float(value f)
+{
+  return caml_signbit(Double_val(f));
+}
+
+CAMLprim value caml_neq_float(value f, value g)
+{
+  return Val_bool(Double_val(f) != Double_val(g));
+}
+
+#define DEFINE_NAN_CMP(op) (value f, value g) \
+{ \
+  return Val_bool(Double_val(f) op Double_val(g)); \
+}
+
+intnat caml_float_compare_unboxed(double f, double g)
+{
+  /* If one or both of f and g is NaN, order according to the convention
+     NaN = NaN and NaN < x for all other floats x. */
+  /* This branchless implementation is from GPR#164.
+     Note that [f == f] if and only if f is not NaN.
+     We expand each subresult of the expression to
+     avoid sign-extension on 64bit. GPR#2250.
+     See also translation of Pcompare_floats in asmcomp/cmmgen.ml  */
+  intnat res =
+    (intnat)(f > g) - (intnat)(f < g) + (intnat)(f == f) - (intnat)(g == g);
+  return res;
+}
+
+CAMLprim value caml_eq_float DEFINE_NAN_CMP(==)
+CAMLprim value caml_le_float DEFINE_NAN_CMP(<=)
+CAMLprim value caml_lt_float DEFINE_NAN_CMP(<)
+CAMLprim value caml_ge_float DEFINE_NAN_CMP(>=)
+CAMLprim value caml_gt_float DEFINE_NAN_CMP(>)
+
+CAMLprim value caml_float_compare(value vf, value vg)
+{
+  return Val_int(caml_float_compare_unboxed(Double_val(vf),Double_val(vg)));
+}
+
+enum { FP_normal, FP_subnormal, FP_zero, FP_infinite, FP_nan };
+
+value caml_classify_float_unboxed(double vd)
+{
+#ifdef ARCH_SIXTYFOUR
+  union { double d; uint64_t i; } u;
+  uint64_t n;
+  uint32_t e;
+
+  u.d = vd;
+  n = u.i << 1;                 /* shift sign bit off */
+  if (n == 0) return Val_int(FP_zero);
+  e = n >> 53;                  /* extract exponent */
+  if (e == 0) return Val_int(FP_subnormal);
+  if (e == 0x7FF) {
+    if (n << 11 == 0)           /* shift exponent off */
+      return Val_int(FP_infinite);
+    else
+      return Val_int(FP_nan);
+  }
+  return Val_int(FP_normal);
+#else
+  union double_as_two_int32 u;
+  uint32_t h, l;
+
+  u.d = vd;
+  h = u.i.h;  l = u.i.l;
+  l = l | (h & 0xFFFFF);
+  h = h & 0x7FF00000;
+  if ((h | l) == 0)
+    return Val_int(FP_zero);
+  if (h == 0)
+    return Val_int(FP_subnormal);
+  if (h == 0x7FF00000) {
+    if (l == 0)
+      return Val_int(FP_infinite);
+    else
+      return Val_int(FP_nan);
+  }
+  return Val_int(FP_normal);
+#endif
+}
+
+CAMLprim value caml_classify_float(value vd)
+{
+  return caml_classify_float_unboxed(Double_val(vd));
+}
+
+/* The [caml_init_ieee_float] function should initialize floating-point hardware
+   so that it behaves as much as possible like the IEEE standard.
+   In particular, return special numbers like Infinity and NaN instead
+   of signalling exceptions.  Currently, everyone is in IEEE mode
+   at program startup, except FreeBSD prior to 4.0R. */
+
+#ifdef __FreeBSD__
+#include <osreldate.h>
+#if (__FreeBSD_version < 400017)
+#include <floatingpoint.h>
+#endif
+#endif
+
+void caml_init_ieee_floats(void)
+{
+#if defined(__FreeBSD__) && (__FreeBSD_version < 400017)
+  fpsetmask(0);
+#endif
+}
diff --git a/runtime/freelist.c b/runtime/freelist.c
new file mode 100644
index 00000000..363adaaf
--- /dev/null
+++ b/runtime/freelist.c
@@ -0,0 +1,1858 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*              Damien Doligez, projet Para, 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
+
+#define FREELIST_DEBUG 0
+#if FREELIST_DEBUG
+#include <stdio.h>
+#endif
+
+#include <string.h>
+
+#include "caml/config.h"
+#include "caml/custom.h"
+#include "caml/freelist.h"
+#include "caml/gc.h"
+#include "caml/gc_ctrl.h"
+#include "caml/memory.h"
+#include "caml/major_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/eventlog.h"
+
+/*************** declarations common to all policies ******************/
+
+/* A block in a small free list is a [value] (integer representing a
+   pointer to the first word after the block's header). The end of the
+  list is NULL.
+*/
+#define Val_NULL ((value) NULL)
+
+asize_t caml_fl_cur_wsz = 0;     /* Number of words in the free set,
+                                    including headers but not fragments. */
+
+value caml_fl_merge = Val_NULL;  /* Current insertion pointer.  Managed
+                                    jointly with [sweep_slice]. */
+
+/* Next in list */
+#define Next_small(v) Field ((v), 0)
+
+/* Next in memory order */
+Caml_inline value Next_in_mem (value v) {
+  return (value) &Field ((v), Whsize_val (v));
+}
+
+#ifdef CAML_INSTR
+
+/* number of pointers followed to allocate from the free set */
+uintnat caml_instr_alloc_jump = 0;
+
+#define EV_ALLOC_JUMP(n) (caml_instr_alloc_jump += (n))
+
+#endif /*CAML_INSTR*/
+
+
+
+/********************* next-fit allocation policy *********************/
+
+/* The free-list is kept sorted by increasing addresses.
+   This makes the merging of adjacent free blocks possible.
+   (See [nf_merge_block].)
+*/
+
+/* The sentinel can be located anywhere in memory, but it must not be
+   adjacent to any heap object. */
+static struct {
+  value filler1; /* Make sure the sentinel is never adjacent to any block. */
+  header_t h;
+  value first_field;
+  value filler2; /* Make sure the sentinel is never adjacent to any block. */
+} nf_sentinel = {0, Make_header (0, 0, Caml_blue), Val_NULL, 0};
+
+#define Nf_head (Val_bp (&(nf_sentinel.first_field)))
+
+static value nf_prev = Nf_head;  /* Current allocation pointer. */
+static value nf_last = Val_NULL; /* Last block in the list.  Only valid
+                                    just after [nf_allocate] returns NULL. */
+
+#if defined (DEBUG) || FREELIST_DEBUG
+static void nf_check (void)
+{
+  value cur;
+  int prev_found = 0, merge_found = 0;
+  uintnat size_found = 0;
+
+  cur = Next_small (Nf_head);
+  while (cur != Val_NULL){
+    size_found += Whsize_bp (cur);
+    CAMLassert (Is_in_heap (cur));
+    if (cur == nf_prev) prev_found = 1;
+    if (cur == caml_fl_merge) merge_found = 1;
+    cur = Next_small (cur);
+  }
+  CAMLassert (prev_found || nf_prev == Nf_head);
+  CAMLassert (merge_found || caml_fl_merge == Nf_head);
+  CAMLassert (size_found == caml_fl_cur_wsz);
+}
+
+#endif /* DEBUG || FREELIST_DEBUG */
+
+/* [nf_allocate_block] is called by [nf_allocate].  Given a suitable free
+   block and the requested size, it allocates a new block from the free
+   block.  There are three cases:
+   0. The free block has the requested size. Detach the block from the
+      free-list and return it.
+   1. The free block is 1 word longer than the requested size. Detach
+      the block from the free list.  The remaining word cannot be linked:
+      turn it into an empty block (header only), and return the rest.
+   2. The free block is large enough. Split it in two and return the right
+      block.
+   In all cases, the allocated block is right-justified in the free block:
+   it is located in the high-address words of the free block, so that
+   the linking of the free-list does not change in case 2.
+*/
+static header_t *nf_allocate_block (mlsize_t wh_sz, value prev, value cur)
+{
+  header_t h = Hd_bp (cur);
+  CAMLassert (Whsize_hd (h) >= wh_sz);
+  if (Wosize_hd (h) < wh_sz + 1){                        /* Cases 0 and 1. */
+    caml_fl_cur_wsz -= Whsize_hd (h);
+    Next_small (prev) = Next_small (cur);
+    CAMLassert (Is_in_heap (Next_small (prev))
+                || Next_small (prev) == Val_NULL);
+    if (caml_fl_merge == cur) caml_fl_merge = prev;
+#ifdef DEBUG
+    nf_last = Val_NULL;
+#endif
+      /* In case 1, the following creates the empty block correctly.
+         In case 0, it gives an invalid header to the block.  The function
+         calling [nf_allocate] will overwrite it. */
+    Hd_op (cur) = Make_header (0, 0, Caml_white);
+  }else{                                                        /* Case 2. */
+    caml_fl_cur_wsz -= wh_sz;
+    Hd_op (cur) = Make_header (Wosize_hd (h) - wh_sz, 0, Caml_blue);
+  }
+  nf_prev = prev;
+  return (header_t *) &Field (cur, Wosize_hd (h) - wh_sz);
+}
+
+static header_t *nf_allocate (mlsize_t wo_sz)
+{
+  value cur = Val_NULL, prev;
+  CAMLassert (sizeof (char *) == sizeof (value));
+  CAMLassert (wo_sz >= 1);
+
+    CAMLassert (nf_prev != Val_NULL);
+    /* Search from [nf_prev] to the end of the list. */
+    prev = nf_prev;
+    cur = Next_small (prev);
+    while (cur != Val_NULL){
+      CAMLassert (Is_in_heap (cur));
+      if (Wosize_bp (cur) >= wo_sz){
+        return nf_allocate_block (Whsize_wosize (wo_sz), prev, cur);
+      }
+      prev = cur;
+      cur = Next_small (prev);
+      CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1));
+    }
+    nf_last = prev;
+    /* Search from the start of the list to [nf_prev]. */
+    prev = Nf_head;
+    cur = Next_small (prev);
+    while (prev != nf_prev){
+      if (Wosize_bp (cur) >= wo_sz){
+        return nf_allocate_block (Whsize_wosize (wo_sz), prev, cur);
+      }
+      prev = cur;
+      cur = Next_small (prev);
+      CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1));
+    }
+    /* No suitable block was found. */
+    return NULL;
+}
+
+/* Location of the last fragment seen by the sweeping code.
+   This is a pointer to the first word after the fragment, which is
+   the header of the next block.
+   Note that [last_fragment] doesn't point to the fragment itself,
+   but to the block after it.
+*/
+static header_t *nf_last_fragment;
+
+static void nf_init_merge (void)
+{
+  CAML_EV_ALLOC_FLUSH();
+  nf_last_fragment = NULL;
+  caml_fl_merge = Nf_head;
+#ifdef DEBUG
+  nf_check ();
+#endif
+}
+
+static void nf_init (void)
+{
+  Next_small (Nf_head) = Val_NULL;
+  nf_prev = Nf_head;
+  caml_fl_cur_wsz = 0;
+}
+
+static void nf_reset (void)
+{
+  nf_init ();
+}
+
+/* Note: the [limit] parameter is unused because we merge blocks one by one. */
+static header_t *nf_merge_block (value bp, char *limit)
+{
+  value prev, cur, adj;
+  header_t hd = Hd_val (bp);
+  mlsize_t prev_wosz;
+
+  caml_fl_cur_wsz += Whsize_hd (hd);
+
+  /* [merge_block] is now responsible for calling the finalization function. */
+  if (Tag_hd (hd) == Custom_tag){
+    void (*final_fun)(value) = Custom_ops_val(bp)->finalize;
+    if (final_fun != NULL) final_fun(bp);
+  }
+
+#ifdef DEBUG
+  caml_set_fields (bp, 0, Debug_free_major);
+#endif
+  prev = caml_fl_merge;
+  cur = Next_small (prev);
+  /* The sweep code makes sure that this is the right place to insert
+     this block: */
+  CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Nf_head);
+  CAMLassert (Bp_val (cur) > Bp_val (bp) || cur == Val_NULL);
+
+  /* If [last_fragment] and [bp] are adjacent, merge them. */
+  if (nf_last_fragment == Hp_val (bp)){
+    mlsize_t bp_whsz = Whsize_val (bp);
+    if (bp_whsz <= Max_wosize){
+      hd = Make_header (bp_whsz, 0, Caml_white);
+      bp = (value) nf_last_fragment;
+      Hd_val (bp) = hd;
+      caml_fl_cur_wsz += Whsize_wosize (0);
+    }
+  }
+
+  /* If [bp] and [cur] are adjacent, remove [cur] from the free-list
+     and merge them. */
+  adj = Next_in_mem (bp);
+  if (adj == cur){
+    value next_cur = Next_small (cur);
+    mlsize_t cur_whsz = Whsize_val (cur);
+
+    if (Wosize_hd (hd) + cur_whsz <= Max_wosize){
+      Next_small (prev) = next_cur;
+      if (nf_prev == cur) nf_prev = prev;
+      hd = Make_header (Wosize_hd (hd) + cur_whsz, 0, Caml_blue);
+      Hd_val (bp) = hd;
+      adj = Next_in_mem (bp);
+#ifdef DEBUG
+      nf_last = Val_NULL;
+      Next_small (cur) = (value) Debug_free_major;
+      Hd_val (cur) = Debug_free_major;
+#endif
+      cur = next_cur;
+    }
+  }
+  /* If [prev] and [bp] are adjacent merge them, else insert [bp] into
+     the free-list if it is big enough. */
+  prev_wosz = Wosize_val (prev);
+  if (Next_in_mem (prev) == bp && prev_wosz + Whsize_hd (hd) < Max_wosize){
+    Hd_val (prev) = Make_header (prev_wosz + Whsize_hd (hd), 0, Caml_blue);
+#ifdef DEBUG
+    Hd_val (bp) = Debug_free_major;
+#endif
+    CAMLassert (caml_fl_merge == prev);
+  }else if (Wosize_hd (hd) != 0){
+    Hd_val (bp) = Bluehd_hd (hd);
+    Next_small (bp) = cur;
+    Next_small (prev) = bp;
+    caml_fl_merge = bp;
+  }else{
+    /* This is a fragment.  Leave it in white but remember it for eventual
+       merging with the next block. */
+    nf_last_fragment = (header_t *) bp;
+    caml_fl_cur_wsz -= Whsize_wosize (0);
+  }
+  return Hp_val (adj);
+}
+
+/* This is a heap extension.  We have to insert it in the right place
+   in the free-list.
+   [nf_add_blocks] can only be called right after a call to
+   [nf_allocate] that returned Val_NULL.
+   Most of the heap extensions are expected to be at the end of the
+   free list.  (This depends on the implementation of [malloc].)
+
+   [bp] must point to a list of blocks chained by their field 0,
+   terminated by Val_NULL, and field 1 of the first block must point to
+   the last block.
+*/
+static void nf_add_blocks (value bp)
+{
+  value cur = bp;
+  CAMLassert (nf_last != Val_NULL);
+  CAMLassert (Next_small (nf_last) == Val_NULL);
+  do {
+    caml_fl_cur_wsz += Whsize_bp (cur);
+    cur = Field(cur, 0);
+  } while (cur != Val_NULL);
+
+  if (Bp_val (bp) > Bp_val (nf_last)){
+    Next_small (nf_last) = bp;
+    if (nf_last == caml_fl_merge && (char *) bp < caml_gc_sweep_hp){
+      caml_fl_merge = Field (bp, 1);
+    }
+  }else{
+    value prev;
+
+    prev = Nf_head;
+    cur = Next_small (prev);
+    while (cur != Val_NULL && Bp_val (cur) < Bp_val (bp)){
+      CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Nf_head);
+      prev = cur;
+      cur = Next_small (prev);
+    }
+    CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Nf_head);
+    CAMLassert (Bp_val (cur) > Bp_val (bp) || cur == Val_NULL);
+    Next_small (Field (bp, 1)) = cur;
+    Next_small (prev) = bp;
+    /* When inserting blocks between [caml_fl_merge] and [caml_gc_sweep_hp],
+       we must advance [caml_fl_merge] to the new block, so that [caml_fl_merge]
+       is always the last free-list block before [caml_gc_sweep_hp]. */
+    if (prev == caml_fl_merge && (char *) bp < caml_gc_sweep_hp){
+      caml_fl_merge = Field (bp, 1);
+    }
+  }
+}
+
+static void nf_make_free_blocks
+  (value *p, mlsize_t size, int do_merge, int color)
+{
+  mlsize_t sz;
+
+  while (size > 0){
+    if (size > Whsize_wosize (Max_wosize)){
+      sz = Whsize_wosize (Max_wosize);
+    }else{
+      sz = size;
+    }
+    *(header_t *)p = Make_header (Wosize_whsize (sz), 0, color);
+    if (do_merge) nf_merge_block (Val_hp (p), NULL);
+    size -= sz;
+    p += sz;
+  }
+}
+
+/******************** first-fit allocation policy *********************/
+
+#define FLP_MAX 1000
+static value flp [FLP_MAX];
+static int flp_size = 0;
+static value beyond = Val_NULL;
+
+/* The sentinel can be located anywhere in memory, but it must not be
+   adjacent to any heap object. */
+static struct {
+  value filler1; /* Make sure the sentinel is never adjacent to any block. */
+  header_t h;
+  value first_field;
+  value filler2; /* Make sure the sentinel is never adjacent to any block. */
+} ff_sentinel = {0, Make_header (0, 0, Caml_blue), Val_NULL, 0};
+
+#define Ff_head (Val_bp (&(ff_sentinel.first_field)))
+static value ff_last = Val_NULL; /* Last block in the list.  Only valid
+                                    just after [ff_allocate] returns NULL. */
+
+
+#if defined (DEBUG) || FREELIST_DEBUG
+static void ff_check (void)
+{
+  value cur;
+  int flp_found = 0, merge_found = 0;
+  uintnat size_found = 0;
+  int sz = 0;
+
+  cur = Next_small (Ff_head);
+  while (cur != Val_NULL){
+    size_found += Whsize_bp (cur);
+    CAMLassert (Is_in_heap (cur));
+    if (Wosize_bp (cur) > sz){
+      sz = Wosize_bp (cur);
+      if (flp_found < flp_size){
+        CAMLassert (Next_small (flp[flp_found]) == cur);
+        ++ flp_found;
+      }else{
+        CAMLassert (beyond == Val_NULL
+                    || Bp_val (cur) >= Bp_val (Next_small (beyond)));
+      }
+    }
+    if (cur == caml_fl_merge) merge_found = 1;
+    cur = Next_small (cur);
+  }
+  CAMLassert (flp_found == flp_size);
+  CAMLassert (merge_found || caml_fl_merge == Ff_head);
+  CAMLassert (size_found == caml_fl_cur_wsz);
+}
+#endif /* DEBUG || FREELIST_DEBUG */
+
+/* [ff_allocate_block] is called by [ff_allocate].  Given a suitable free
+   block and the requested size, it allocates a new block from the free
+   block.  There are three cases:
+   0. The free block has the requested size. Detach the block from the
+      free-list and return it.
+   1. The free block is 1 word longer than the requested size. Detach
+      the block from the free list.  The remaining word cannot be linked:
+      turn it into an empty block (header only), and return the rest.
+   2. The free block is large enough. Split it in two and return the right
+      block.
+   In all cases, the allocated block is right-justified in the free block:
+   it is located in the high-address words of the free block, so that
+   the linking of the free-list does not change in case 2.
+*/
+static header_t *ff_allocate_block (mlsize_t wh_sz, int flpi, value prev,
+                                    value cur)
+{
+  header_t h = Hd_bp (cur);
+  CAMLassert (Whsize_hd (h) >= wh_sz);
+  if (Wosize_hd (h) < wh_sz + 1){                        /* Cases 0 and 1. */
+    caml_fl_cur_wsz -= Whsize_hd (h);
+    Next_small (prev) = Next_small (cur);
+    CAMLassert (Is_in_heap (Next_small (prev))
+                || Next_small (prev) == Val_NULL);
+    if (caml_fl_merge == cur) caml_fl_merge = prev;
+#ifdef DEBUG
+    ff_last = Val_NULL;
+#endif
+      /* In case 1, the following creates the empty block correctly.
+         In case 0, it gives an invalid header to the block.  The function
+         calling [ff_allocate] will overwrite it. */
+    Hd_op (cur) = Make_header (0, 0, Caml_white);
+    if (flpi + 1 < flp_size && flp[flpi + 1] == cur){
+      flp[flpi + 1] = prev;
+    }else if (flpi == flp_size - 1){
+      beyond = (prev == Ff_head) ? Val_NULL : prev;
+      -- flp_size;
+    }
+  }else{                                                        /* Case 2. */
+    caml_fl_cur_wsz -= wh_sz;
+    Hd_op (cur) = Make_header (Wosize_hd (h) - wh_sz, 0, Caml_blue);
+  }
+  return (header_t *) &Field (cur, Wosize_hd (h) - wh_sz);
+}
+
+static header_t *ff_allocate (mlsize_t wo_sz)
+{
+  value cur = Val_NULL, prev;
+  header_t *result;
+  int i;
+  mlsize_t sz, prevsz;
+  CAMLassert (sizeof (char *) == sizeof (value));
+  CAMLassert (wo_sz >= 1);
+
+    /* Search in the flp array. */
+    for (i = 0; i < flp_size; i++){
+      sz = Wosize_bp (Next_small (flp[i]));
+      if (sz >= wo_sz){
+#if FREELIST_DEBUG
+        if (i > 5) fprintf (stderr, "FLP: found at %d  size=%d\n", i, wo_sz);
+#endif
+        result = ff_allocate_block (Whsize_wosize (wo_sz), i, flp[i],
+                                    Next_small (flp[i]));
+        goto update_flp;
+      }
+    }
+    /* Extend the flp array. */
+    if (flp_size == 0){
+      prev = Ff_head;
+      prevsz = 0;
+    }else{
+      prev = Next_small (flp[flp_size - 1]);
+      prevsz = Wosize_bp (prev);
+      if (beyond != Val_NULL) prev = beyond;
+    }
+    while (flp_size < FLP_MAX){
+      cur = Next_small (prev);
+      if (cur == Val_NULL){
+        ff_last = prev;
+        beyond = (prev == Ff_head) ? Val_NULL : prev;
+        return NULL;
+      }else{
+        sz = Wosize_bp (cur);
+        if (sz > prevsz){
+          flp[flp_size] = prev;
+          ++ flp_size;
+          if (sz >= wo_sz){
+            beyond = cur;
+            i = flp_size - 1;
+#if FREELIST_DEBUG
+            if (flp_size > 5){
+              fprintf (stderr, "FLP: extended to %d\n", flp_size);
+            }
+#endif
+            result = ff_allocate_block (Whsize_wosize (wo_sz), flp_size - 1,
+                                        prev, cur);
+            goto update_flp;
+          }
+          prevsz = sz;
+        }
+      }
+      prev = cur;
+    }
+    beyond = cur;
+
+    /* The flp table is full.  Do a slow first-fit search. */
+#if FREELIST_DEBUG
+    fprintf (stderr, "FLP: table is full -- slow first-fit\n");
+#endif
+    if (beyond != Val_NULL){
+      prev = beyond;
+    }else{
+      prev = flp[flp_size - 1];
+    }
+    prevsz = Wosize_bp (Next_small (flp[FLP_MAX-1]));
+    CAMLassert (prevsz < wo_sz);
+    cur = Next_small (prev);
+    while (cur != Val_NULL){
+      CAMLassert (Is_in_heap (cur));
+      sz = Wosize_bp (cur);
+      if (sz < prevsz){
+        beyond = cur;
+      }else if (sz >= wo_sz){
+        return ff_allocate_block (Whsize_wosize (wo_sz), flp_size, prev, cur);
+      }
+      prev = cur;
+      cur = Next_small (prev);
+    }
+    ff_last = prev;
+    return NULL;
+
+  update_flp: /* (i, sz) */
+    /* The block at [i] was removed or reduced.  Update the table. */
+    CAMLassert (0 <= i && i < flp_size + 1);
+    if (i < flp_size){
+      if (i > 0){
+        prevsz = Wosize_bp (Next_small (flp[i-1]));
+      }else{
+        prevsz = 0;
+      }
+      if (i == flp_size - 1){
+        if (Wosize_bp (Next_small (flp[i])) <= prevsz){
+          beyond = Next_small (flp[i]);
+          -- flp_size;
+        }else{
+          beyond = Val_NULL;
+        }
+      }else{
+        value buf [FLP_MAX];
+        int j = 0;
+        mlsize_t oldsz = sz;
+
+        prev = flp[i];
+        while (prev != flp[i+1] && j < FLP_MAX - i){
+          cur = Next_small (prev);
+          sz = Wosize_bp (cur);
+          if (sz > prevsz){
+            buf[j++] = prev;
+            prevsz = sz;
+            if (sz >= oldsz){
+              CAMLassert (sz == oldsz);
+              break;
+            }
+          }
+          prev = cur;
+        }
+#if FREELIST_DEBUG
+        if (j > 2) fprintf (stderr, "FLP: update; buf size = %d\n", j);
+#endif
+        if (FLP_MAX >= flp_size + j - 1){
+          if (j != 1){
+            memmove (&flp[i+j], &flp[i+1], sizeof (value) * (flp_size-i-1));
+          }
+          if (j > 0) memmove (&flp[i], &buf[0], sizeof (value) * j);
+          flp_size += j - 1;
+        }else{
+          if (FLP_MAX > i + j){
+            if (j != 1){
+              memmove (&flp[i+j], &flp[i+1], sizeof (value) * (FLP_MAX-i-j));
+            }
+            if (j > 0) memmove (&flp[i], &buf[0], sizeof (value) * j);
+          }else{
+            if (i != FLP_MAX){
+              memmove (&flp[i], &buf[0], sizeof (value) * (FLP_MAX - i));
+            }
+          }
+          flp_size = FLP_MAX - 1;
+          beyond = Next_small (flp[FLP_MAX - 1]);
+        }
+      }
+    }
+    return result;
+}
+
+/* Location of the last fragment seen by the sweeping code.
+   This is a pointer to the first word after the fragment, which is
+   the header of the next block.
+   Note that [ff_last_fragment] doesn't point to the fragment itself,
+   but to the block after it.
+*/
+static header_t *ff_last_fragment;
+
+static void ff_init_merge (void)
+{
+  CAML_EV_ALLOC_FLUSH();
+  ff_last_fragment = NULL;
+  caml_fl_merge = Ff_head;
+#ifdef DEBUG
+  ff_check ();
+#endif
+}
+
+static void ff_truncate_flp (value changed)
+{
+  if (changed == Ff_head){
+    flp_size = 0;
+    beyond = Val_NULL;
+  }else{
+    while (flp_size > 0 &&
+           Bp_val (Next_small (flp[flp_size - 1])) >= Bp_val (changed))
+      -- flp_size;
+    if (Bp_val (beyond) >= Bp_val (changed)) beyond = Val_NULL;
+  }
+}
+
+static void ff_init (void)
+{
+  Next_small (Ff_head) = Val_NULL;
+  ff_truncate_flp (Ff_head);
+  caml_fl_cur_wsz = 0;
+}
+
+static void ff_reset (void)
+{
+  ff_init ();
+}
+
+/* Note: the [limit] parameter is unused because we merge blocks one by one. */
+static header_t *ff_merge_block (value bp, char *limit)
+{
+  value prev, cur, adj;
+  header_t hd = Hd_val (bp);
+  mlsize_t prev_wosz;
+
+  caml_fl_cur_wsz += Whsize_hd (hd);
+
+  /* [merge_block] is now responsible for calling the finalization function. */
+  if (Tag_hd (hd) == Custom_tag){
+    void (*final_fun)(value) = Custom_ops_val(bp)->finalize;
+    if (final_fun != NULL) final_fun(bp);
+  }
+
+#ifdef DEBUG
+  caml_set_fields (bp, 0, Debug_free_major);
+#endif
+  prev = caml_fl_merge;
+  cur = Next_small (prev);
+  /* The sweep code makes sure that this is the right place to insert
+     this block: */
+  CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Ff_head);
+  CAMLassert (Bp_val (cur) > Bp_val (bp) || cur == Val_NULL);
+
+  ff_truncate_flp (prev);
+
+  /* If [ff_last_fragment] and [bp] are adjacent, merge them. */
+  if (ff_last_fragment == Hp_bp (bp)){
+    mlsize_t bp_whsz = Whsize_val (bp);
+    if (bp_whsz <= Max_wosize){
+      hd = Make_header (bp_whsz, 0, Caml_white);
+      bp = (value) ff_last_fragment;
+      Hd_val (bp) = hd;
+      caml_fl_cur_wsz += Whsize_wosize (0);
+    }
+  }
+
+  /* If [bp] and [cur] are adjacent, remove [cur] from the free-list
+     and merge them. */
+  adj = Next_in_mem (bp);
+  if (adj == cur){
+    value next_cur = Next_small (cur);
+    mlsize_t cur_whsz = Whsize_val (cur);
+
+    if (Wosize_hd (hd) + cur_whsz <= Max_wosize){
+      Next_small (prev) = next_cur;
+      hd = Make_header (Wosize_hd (hd) + cur_whsz, 0, Caml_blue);
+      Hd_val (bp) = hd;
+      adj = Next_in_mem (bp);
+#ifdef DEBUG
+      ff_last = Val_NULL;
+      Next_small (cur) = (value) Debug_free_major;
+      Hd_val (cur) = Debug_free_major;
+#endif
+      cur = next_cur;
+    }
+  }
+  /* If [prev] and [bp] are adjacent merge them, else insert [bp] into
+     the free-list if it is big enough. */
+  prev_wosz = Wosize_val (prev);
+  if (Next_in_mem (prev) == bp && prev_wosz + Whsize_hd (hd) < Max_wosize){
+    Hd_val (prev) = Make_header (prev_wosz + Whsize_hd (hd), 0, Caml_blue);
+#ifdef DEBUG
+    Hd_val (bp) = Debug_free_major;
+#endif
+    CAMLassert (caml_fl_merge == prev);
+  }else if (Wosize_hd (hd) != 0){
+    Hd_val (bp) = Bluehd_hd (hd);
+    Next_small (bp) = cur;
+    Next_small (prev) = bp;
+    caml_fl_merge = bp;
+  }else{
+    /* This is a fragment.  Leave it in white but remember it for eventual
+       merging with the next block. */
+    ff_last_fragment = (header_t *) bp;
+    caml_fl_cur_wsz -= Whsize_wosize (0);
+  }
+  return Hp_val (adj);
+}
+
+/* This is a heap extension.  We have to insert it in the right place
+   in the free-list.
+   [ff_add_blocks] can only be called right after a call to
+   [ff_allocate] that returned Val_NULL.
+   Most of the heap extensions are expected to be at the end of the
+   free list.  (This depends on the implementation of [malloc].)
+
+   [bp] must point to a list of blocks chained by their field 0,
+   terminated by Val_NULL, and field 1 of the first block must point to
+   the last block.
+*/
+static void ff_add_blocks (value bp)
+{
+  value cur = bp;
+  CAMLassert (ff_last != Val_NULL);
+  CAMLassert (Next_small (ff_last) == Val_NULL);
+  do {
+    caml_fl_cur_wsz += Whsize_bp (cur);
+    cur = Field(cur, 0);
+  } while (cur != Val_NULL);
+
+  if (Bp_val (bp) > Bp_val (ff_last)){
+    Next_small (ff_last) = bp;
+    if (ff_last == caml_fl_merge && (char *) bp < caml_gc_sweep_hp){
+      caml_fl_merge = Field (bp, 1);
+    }
+    if (flp_size < FLP_MAX){
+      flp [flp_size++] = ff_last;
+    }
+  }else{
+    value prev;
+
+    prev = Ff_head;
+    cur = Next_small (prev);
+    while (cur != Val_NULL && Bp_val (cur) < Bp_val (bp)){
+      CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Ff_head);
+      /* XXX TODO: extend flp on the fly */
+      prev = cur;
+      cur = Next_small (prev);
+    }
+    CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Ff_head);
+    CAMLassert (Bp_val (cur) > Bp_val (bp) || cur == Val_NULL);
+    Next_small (Field (bp, 1)) = cur;
+    Next_small (prev) = bp;
+    /* When inserting blocks between [caml_fl_merge] and [caml_gc_sweep_hp],
+       we must advance [caml_fl_merge] to the new block, so that [caml_fl_merge]
+       is always the last free-list block before [caml_gc_sweep_hp]. */
+    if (prev == caml_fl_merge && (char *) bp < caml_gc_sweep_hp){
+      caml_fl_merge = Field (bp, 1);
+    }
+    ff_truncate_flp (bp);
+  }
+}
+
+static void ff_make_free_blocks
+  (value *p, mlsize_t size, int do_merge, int color)
+{
+  mlsize_t sz;
+
+  while (size > 0){
+    if (size > Whsize_wosize (Max_wosize)){
+      sz = Whsize_wosize (Max_wosize);
+    }else{
+      sz = size;
+    }
+    *(header_t *)p = Make_header (Wosize_whsize (sz), 0, color);
+    if (do_merge) ff_merge_block (Val_hp (p), NULL);
+    size -= sz;
+    p += sz;
+  }
+}
+
+/********************* best-fit allocation policy *********************/
+
+/* quick-fit + FIFO-ordered best fit (Wilson's nomenclature)
+   We use Standish's data structure (a tree of doubly-linked lists)
+   with a splay tree (Sleator & Tarjan).
+*/
+
+/* [BF_NUM_SMALL] must be at least 4 for this code to work
+   and at least 5 for good performance on typical OCaml programs.
+   For portability reasons, BF_NUM_SMALL cannot be more than 32.
+*/
+#define BF_NUM_SMALL 16
+
+/* Note that indexing into [bf_small_fl] starts at 1, so the first entry
+   in this array is unused.
+*/
+static struct {
+  value free;
+  value *merge;
+} bf_small_fl [BF_NUM_SMALL + 1];
+static int bf_small_map = 0;
+
+/* Small free blocks have only one pointer to the next block.
+   Large free blocks have 5 fields:
+   tree fields:
+     - isnode flag
+     - left child
+     - right child
+   list fields:
+     - next
+     - prev
+*/
+typedef struct large_free_block {
+  int isnode;
+  struct large_free_block *left;
+  struct large_free_block *right;
+  struct large_free_block *prev;
+  struct large_free_block *next;
+} large_free_block;
+
+Caml_inline mlsize_t bf_large_wosize (struct large_free_block *n) {
+  return Wosize_val((value)(n));
+}
+
+static struct large_free_block *bf_large_tree;
+static struct large_free_block *bf_large_least;
+/* [bf_large_least] is either NULL or a pointer to the smallest (leftmost)
+   block in the tree. In this latter case, the block must be alone in its
+   doubly-linked list (i.e. have [isnode] true and [prev] and [next]
+   both pointing back to this block)
+*/
+
+/* Auxiliary functions for bitmap */
+
+/* Find first (i.e. least significant) bit set in a word. */
+#ifdef HAS_FFS
+#include <strings.h>
+#elif defined(HAS_BITSCANFORWARD)
+#include <intrin.h>
+Caml_inline int ffs (int x)
+{
+  unsigned long index;
+  unsigned char result;
+  result = _BitScanForward (&index, (unsigned long) x);
+  return result ? (int) index + 1 : 0;
+}
+#else
+Caml_inline int ffs (int x)
+{
+  /* adapted from Hacker's Delight */
+  int bnz, b0, b1, b2, b3, b4;
+  CAMLassert ((x & 0xFFFFFFFF) == x);
+  x = x & -x;
+  bnz = x != 0;
+  b4 = !!(x & 0xFFFF0000) << 4;
+  b3 = !!(x & 0xFF00FF00) << 3;
+  b2 = !!(x & 0xF0F0F0F0) << 2;
+  b1 = !!(x & 0xCCCCCCCC) << 1;
+  b0 = !!(x & 0xAAAAAAAA);
+  return bnz + b0 + b1 + b2 + b3 + b4;
+}
+#endif /* HAS_FFS or HAS_BITSCANFORWARD */
+
+/* Indexing starts at 1 because that's the minimum block size. */
+Caml_inline void set_map (int index)
+{
+  bf_small_map |= (1 << (index - 1));
+}
+Caml_inline void unset_map (int index)
+{
+  bf_small_map &= ~(1 << (index - 1));
+}
+
+
+/* debug functions for checking the data structures */
+
+#if defined (DEBUG) || FREELIST_DEBUG
+
+static mlsize_t bf_check_cur_size = 0;
+static asize_t bf_check_subtree (large_free_block *p)
+{
+  mlsize_t wosz;
+  large_free_block *cur, *next;
+  asize_t total_size = 0;
+
+  if (p == NULL) return 0;
+
+  wosz = bf_large_wosize(p);
+  CAMLassert (p->isnode == 1);
+  total_size += bf_check_subtree (p->left);
+  CAMLassert (wosz > BF_NUM_SMALL);
+  CAMLassert (wosz > bf_check_cur_size);
+  bf_check_cur_size = wosz;
+  cur = p;
+  while (1){
+    CAMLassert (bf_large_wosize (cur) == wosz);
+    CAMLassert (Color_val ((value) cur) == Caml_blue);
+    CAMLassert ((cur == p && cur->isnode == 1) || cur->isnode == 0);
+    total_size += Whsize_wosize (wosz);
+    next = cur->next;
+    CAMLassert (next->prev == cur);
+    if (next == p) break;
+    cur = next;
+  }
+  total_size += bf_check_subtree (p->right);
+  return total_size;
+}
+
+static void bf_check (void)
+{
+  mlsize_t i;
+  asize_t total_size = 0;
+  int map = 0;
+
+  /* check free lists */
+  CAMLassert (BF_NUM_SMALL <= 8 * sizeof (int));
+  for (i = 1; i <= BF_NUM_SMALL; i++){
+    value b;
+    int col = 0;
+    int merge_found = 0;
+
+    if (bf_small_fl[i].merge == &bf_small_fl[i].free){
+      merge_found = 1;
+    }else{
+      CAMLassert (caml_gc_phase != Phase_sweep
+                  || caml_fl_merge == Val_NULL
+                  || bf_small_fl[i].merge < &Next_small(caml_fl_merge));
+    }
+    CAMLassert (*bf_small_fl[i].merge == Val_NULL
+                || Color_val (*bf_small_fl[i].merge) == Caml_blue);
+    if (bf_small_fl[i].free != Val_NULL) map |= 1 << (i-1);
+    for (b = bf_small_fl[i].free; b != Val_NULL; b = Next_small (b)){
+      if (bf_small_fl[i].merge == &Next_small (b)) merge_found = 1;
+      CAMLassert (Wosize_val (b) == i);
+      total_size += Whsize_wosize (i);
+      if (Color_val (b) == Caml_blue){
+        col = 1;
+        CAMLassert (Next_small (b) == Val_NULL
+                    || Bp_val (Next_small (b)) > Bp_val (b));
+      }else{
+        CAMLassert (col == 0);
+        CAMLassert (Color_val (b) == Caml_white);
+      }
+    }
+    if (caml_gc_phase == Phase_sweep) CAMLassert (merge_found);
+  }
+  CAMLassert (map == bf_small_map);
+  /* check [caml_fl_merge] */
+  CAMLassert (caml_gc_phase != Phase_sweep
+              || caml_fl_merge == Val_NULL
+              || Hp_val (caml_fl_merge) < (header_t *) caml_gc_sweep_hp);
+  /* check the tree */
+  bf_check_cur_size = 0;
+  total_size += bf_check_subtree (bf_large_tree);
+  /* check the total free set size */
+  CAMLassert (total_size == caml_fl_cur_wsz);
+  /* check the smallest-block pointer */
+  if (bf_large_least != NULL){
+    large_free_block *x = bf_large_tree;
+    while (x->left != NULL) x = x->left;
+    CAMLassert (x == bf_large_least);
+    CAMLassert (x->isnode == 1);
+    CAMLassert (x->prev == x);
+    CAMLassert (x->next == x);
+  }
+}
+
+#endif /* DEBUG || FREELIST_DEBUG */
+
+#if FREELIST_DEBUG
+#define FREELIST_DEBUG_bf_check() bf_check ()
+#else
+#define FREELIST_DEBUG_bf_check()
+#endif
+
+/**************************************************************************/
+/* splay trees */
+
+/* Our tree is composed of nodes. Each node is the head of a doubly-linked
+   circular list of blocks, all of the same size.
+*/
+
+/* Search for the node of the given size. Return a pointer to the pointer
+   to the node, or a pointer to the NULL where the node should have been
+   (it can be inserted here).
+*/
+static large_free_block **bf_search (mlsize_t wosz)
+{
+  large_free_block **p = &bf_large_tree;
+  large_free_block *cur;
+  mlsize_t cursz;
+
+  while (1){
+    cur = *p;
+    CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1));
+    if (cur == NULL) break;
+    cursz = bf_large_wosize (cur);
+    if (cursz == wosz){
+      break;
+    }else if (cursz > wosz){
+      p = &(cur->left);
+    }else{
+      CAMLassert (cursz < wosz);
+      p = &(cur->right);
+    }
+  }
+  return p;
+}
+
+/* Search for the least node that is large enough to accommodate the given
+   size. Return in [next_lower] an upper bound on either the size of the
+   next-lower node in the tree, or BF_NUM_SMALL if there is no such node.
+*/
+static large_free_block **bf_search_best (mlsize_t wosz, mlsize_t *next_lower)
+{
+  large_free_block **p = &bf_large_tree;
+  large_free_block **best = NULL;
+  mlsize_t lowsz = BF_NUM_SMALL;
+  large_free_block *cur;
+  mlsize_t cursz;
+
+  while (1){
+    cur = *p;
+    CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1));
+    if (cur == NULL){
+      *next_lower = lowsz;
+      break;
+    }
+    cursz = bf_large_wosize (cur);
+    if (cursz == wosz){
+      best = p;
+      *next_lower = wosz;
+      break;
+    }else if (cursz > wosz){
+      best = p;
+      p = &(cur->left);
+    }else{
+      CAMLassert (cursz < wosz);
+      lowsz = cursz;
+      p = &(cur->right);
+    }
+  }
+  return best;
+}
+
+/* Splay the tree at the given size. If a node of this size exists, it will
+   become the root. If not, the last visited node will be the root. This is
+   either the least node larger or the greatest node smaller than the given
+   size.
+   We use simple top-down splaying as described in S&T 85.
+*/
+static void bf_splay (mlsize_t wosz)
+{
+  large_free_block *x, *y;
+  mlsize_t xsz;
+  large_free_block *left_top = NULL;
+  large_free_block *right_top = NULL;
+  large_free_block **left_bottom = &left_top;
+  large_free_block **right_bottom = &right_top;
+
+  x = bf_large_tree;
+  if (x == NULL) return;
+  while (1){
+    xsz = bf_large_wosize (x);
+    if (xsz == wosz) break;
+    if (xsz > wosz){
+      /* zig */
+      y = x->left;
+      CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1));
+      if (y == NULL) break;
+      if (bf_large_wosize (y) > wosz){
+        /* zig-zig: rotate right */
+        x->left = y->right;
+        y->right = x;
+        x = y;
+        y = x->left;
+        CAML_EVENTLOG_DO(EV_ALLOC_JUMP (2));
+        if (y == NULL) break;
+      }
+      /* link right */
+      *right_bottom = x;
+      right_bottom = &(x->left);
+      x = y;
+    }else{
+      CAMLassert (xsz < wosz);
+      /* zag */
+      y = x->right;
+      CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1));
+      if (y == NULL) break;
+      if (bf_large_wosize (y) < wosz){
+        /* zag-zag : rotate left */
+        x->right = y->left;
+        y->left = x;
+        x = y;
+        y = x->right;
+        CAML_EVENTLOG_DO(EV_ALLOC_JUMP (2));
+        if (y == NULL) break;
+      }
+      /* link left */
+      *left_bottom = x;
+      left_bottom = &(x->right);
+      x = y;
+    }
+  }
+  /* reassemble the tree */
+  *left_bottom = x->left;
+  *right_bottom = x->right;
+  x->left = left_top;
+  x->right = right_top;
+  CAML_EVENTLOG_DO(EV_ALLOC_JUMP (2));
+  bf_large_tree = x;
+}
+
+/* Splay the subtree at [p] on its leftmost (least) node. After this
+   operation, the root node of the subtree is the least node and it
+   has no left child.
+   The subtree must not be empty.
+*/
+static void bf_splay_least (large_free_block **p)
+{
+  large_free_block *x, *y;
+  large_free_block *right_top = NULL;
+  large_free_block **right_bottom = &right_top;
+
+  x = *p;
+  CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1));
+  CAMLassert (x != NULL);
+  while (1){
+    /* We are always in the zig case. */
+    y = x->left;
+    CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1));
+    if (y == NULL) break;
+    /* And in the zig-zig case. rotate right */
+    x->left = y->right;
+    y->right = x;
+    x = y;
+    y = x->left;
+    CAML_EVENTLOG_DO(EV_ALLOC_JUMP (2));
+    if (y == NULL) break;
+    /* link right */
+    *right_bottom = x;
+    right_bottom = &(x->left);
+    x = y;
+  }
+  /* reassemble the tree */
+  CAMLassert (x->left == NULL);
+  *right_bottom = x->right;
+  CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1));
+  x->right = right_top;
+  *p = x;
+}
+
+/* Remove the node at [p], if any. */
+static void bf_remove_node (large_free_block **p)
+{
+  large_free_block *x;
+  large_free_block *l, *r;
+
+  x = *p;
+  CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1));
+  if (x == NULL) return;
+  if (x == bf_large_least) bf_large_least = NULL;
+  l = x->left;
+  r = x->right;
+  CAML_EVENTLOG_DO(EV_ALLOC_JUMP (2));
+  if (l == NULL){
+    *p = r;
+  }else if (r == NULL){
+    *p = l;
+  }else{
+    bf_splay_least (&r);
+    r->left = l;
+    *p = r;
+  }
+}
+
+/* Insert a block into the tree, either as a new node or as a block in an
+   existing list.
+   Splay if the list is already present.
+*/
+static void bf_insert_block (large_free_block *n)
+{
+  mlsize_t sz = bf_large_wosize (n);
+  large_free_block **p = bf_search (sz);
+  large_free_block *x = *p;
+  CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1));
+
+  if (bf_large_least != NULL){
+    mlsize_t least_sz = bf_large_wosize (bf_large_least);
+    if (sz < least_sz){
+      CAMLassert (x == NULL);
+      bf_large_least = n;
+    }else if (sz == least_sz){
+      CAMLassert (x == bf_large_least);
+      bf_large_least = NULL;
+    }
+  }
+
+  CAMLassert (Color_val ((value) n) == Caml_blue);
+  CAMLassert (Wosize_val ((value) n) > BF_NUM_SMALL);
+  if (x == NULL){
+    /* add new node */
+    n->isnode = 1;
+    n->left = n->right = NULL;
+    n->prev = n->next = n;
+    *p = n;
+  }else{
+    /* insert at tail of doubly-linked list */
+    CAMLassert (x->isnode == 1);
+    n->isnode = 0;
+#ifdef DEBUG
+    n->left = n->right = (large_free_block *) Debug_free_unused;
+#endif
+    n->prev = x->prev;
+    n->next = x;
+    x->prev->next = n;
+    x->prev = n;
+    CAML_EVENTLOG_DO(EV_ALLOC_JUMP (2));
+    bf_splay (sz);
+  }
+}
+
+#if defined (DEBUG) || FREELIST_DEBUG
+static int bf_is_in_tree (large_free_block *b)
+{
+  int wosz = bf_large_wosize (b);
+  large_free_block **p = bf_search (wosz);
+  large_free_block *n = *p;
+  large_free_block *cur = n;
+
+  if (n == NULL) return 0;
+  while (1){
+    if (cur == b) return 1;
+    cur = cur->next;
+    if (cur == n) return 0;
+  }
+}
+#endif /* DEBUG || FREELIST_DEBUG */
+
+/**************************************************************************/
+
+/* Add back a remnant into a small free list. The block must be small
+   and white (or a 0-size fragment).
+   The block may be left out of the list depending on the sweeper's state.
+   The free list size is updated accordingly.
+
+   The block will be left out of the list if the GC is in its Sweep phase
+   and the block is in the still-to-be-swept region because every block of
+   the free list encountered by the sweeper must be blue and linked in
+   its proper place in the increasing-addresses order of the list. This is
+   to ensure that coalescing is always done when two or more free blocks
+   are adjacent.
+*/
+static void bf_insert_remnant_small (value v)
+{
+  mlsize_t wosz = Wosize_val (v);
+
+  CAMLassert (Color_val (v) == Caml_white);
+  CAMLassert (wosz <= BF_NUM_SMALL);
+  if (wosz != 0
+      && (caml_gc_phase != Phase_sweep
+          || (char *) Hp_val (v) < (char *) caml_gc_sweep_hp)){
+    caml_fl_cur_wsz += Whsize_wosize (wosz);
+    Next_small (v) = bf_small_fl[wosz].free;
+    bf_small_fl[wosz].free = v;
+    if (bf_small_fl[wosz].merge == &bf_small_fl[wosz].free){
+      bf_small_fl[wosz].merge = &Next_small (v);
+    }
+    set_map (wosz);
+  }
+}
+
+/* Add back a remnant into the free set. The block must have the
+   appropriate color:
+   - White if it is a fragment or a small block (wosize <= BF_NUM_SMALL)
+   - Blue if it is a large block (BF_NUM_SMALL < wosize)
+   The block may be left out or the set, depending on its size and the
+   sweeper's state.
+   The free list size is updated accordingly.
+*/
+static void bf_insert_remnant (value v)
+{
+  mlsize_t wosz = Wosize_val (v);
+
+  if (wosz <= BF_NUM_SMALL){
+    CAMLassert (Color_val (v) == Caml_white);
+    bf_insert_remnant_small (v);
+  }else{
+    CAMLassert (Color_val (v) == Caml_blue);
+    bf_insert_block ((large_free_block *) v);
+    caml_fl_cur_wsz += Whsize_wosize (wosz);
+  }
+}
+/* Insert the block into the free set during sweep. The block must be blue. */
+static void bf_insert_sweep (value v)
+{
+  mlsize_t wosz = Wosize_val (v);
+  value next;
+
+  CAMLassert (Color_val (v) == Caml_blue);
+  if (wosz <= BF_NUM_SMALL){
+    while (1){
+      next = *bf_small_fl[wosz].merge;
+      if (next == Val_NULL){
+        set_map (wosz);
+        break;
+      }
+      if (Bp_val (next) >= Bp_val (v)) break;
+      bf_small_fl[wosz].merge = &Next_small (next);
+    }
+    Next_small (v) = *bf_small_fl[wosz].merge;
+    *bf_small_fl[wosz].merge = v;
+    bf_small_fl[wosz].merge = &Next_small (v);
+  }else{
+    bf_insert_block ((large_free_block *) v);
+  }
+}
+
+/* Remove a given block from the free set. */
+static void bf_remove (value v)
+{
+  mlsize_t wosz = Wosize_val (v);
+
+  CAMLassert (Color_val (v) == Caml_blue);
+  if (wosz <= BF_NUM_SMALL){
+    while (*bf_small_fl[wosz].merge != v){
+      CAMLassert (Bp_val (*bf_small_fl[wosz].merge) < Bp_val (v));
+      bf_small_fl[wosz].merge = &Next_small (*bf_small_fl[wosz].merge);
+    }
+    *bf_small_fl[wosz].merge = Next_small (v);
+    if (bf_small_fl[wosz].free == Val_NULL) unset_map (wosz);
+  }else{
+    large_free_block *b = (large_free_block *) v;
+    CAMLassert (bf_is_in_tree (b));
+    CAMLassert (b->prev->next == b);
+    CAMLassert (b->next->prev == b);
+    if (b->isnode){
+      large_free_block **p = bf_search (bf_large_wosize (b));
+      CAMLassert (*p != NULL);
+      if (b->next == b){
+        bf_remove_node (p);
+      }else{
+        large_free_block *n = b->next;
+        n->prev = b->prev;
+        b->prev->next = n;
+        *p = n;
+        n->isnode = 1;
+        n->left = b->left;
+        n->right = b->right;
+#ifdef DEBUG
+        Field ((value) b, 0) = Debug_free_major;
+        b->left = b->right = b->next = b->prev =
+          (large_free_block *) Debug_free_major;
+#endif
+      }
+    }else{
+      b->prev->next = b->next;
+      b->next->prev = b->prev;
+    }
+  }
+}
+
+/* Split the given block, return a new block of the given size.
+   The remnant is still at the same address, its size is changed
+   and its color becomes white.
+   The size of the free set is decremented by the whole block size
+   and the caller must readjust it if the remnant is reinserted or
+   remains in the free set.
+   The size of [v] must be strictly greater than [wosz].
+*/
+static header_t *bf_split_small (mlsize_t wosz, value v)
+{
+  intnat blocksz = Whsize_val (v);
+  intnat remwhsz = blocksz - Whsize_wosize (wosz);
+
+  CAMLassert (Wosize_val (v) > wosz);
+  caml_fl_cur_wsz -= blocksz;
+  Hd_val (v) = Make_header (Wosize_whsize (remwhsz), Abstract_tag, Caml_white);
+  return (header_t *) &Field (v, Wosize_whsize (remwhsz));
+}
+
+/* Split the given block, return a new block of the given size.
+   The original block is at the same address but its size is changed.
+   Its color and tag are changed as appropriate for calling the
+   insert_remnant* functions.
+   The size of the free set is decremented by the whole block size
+   and the caller must readjust it if the remnant is reinserted or
+   remains in the free set.
+   The size of [v] must be strictly greater than [wosz].
+*/
+static header_t *bf_split (mlsize_t wosz, value v)
+{
+  header_t hd = Hd_val (v);
+  mlsize_t remwhsz = Whsize_hd (hd) - Whsize_wosize (wosz);
+
+  CAMLassert (Wosize_val (v) > wosz);
+  CAMLassert (remwhsz > 0);
+  caml_fl_cur_wsz -= Whsize_hd (hd);
+  if (remwhsz <= Whsize_wosize (BF_NUM_SMALL)){
+    /* Same as bf_split_small. */
+    Hd_val (v) = Make_header (Wosize_whsize(remwhsz), Abstract_tag, Caml_white);
+  }else{
+    Hd_val (v) = Make_header (Wosize_whsize (remwhsz), 0, Caml_blue);
+  }
+  return (header_t *) &Field (v, Wosize_whsize (remwhsz));
+}
+
+/* Allocate from a large block at [p]. If the node is single and the remaining
+   size is greater than [bound], it stays at the same place in the tree.
+   If [set_least] is true, [wosz] is guaranteed to be [<= BF_NUM_SMALL], so
+   the block has the smallest size in the tree.
+   In this case, the large block becomes (or remains) the single smallest
+   in the tree and we set the [bf_large_least] pointer.
+*/
+static header_t *bf_alloc_from_large (mlsize_t wosz, large_free_block **p,
+                                      mlsize_t bound, int set_least)
+{
+  large_free_block *n = *p;
+  large_free_block *b;
+  header_t *result;
+  mlsize_t wosize_n = bf_large_wosize (n);
+
+  CAMLassert (bf_large_wosize (n) >= wosz);
+  if (n->next == n){
+    if (wosize_n > bound + Whsize_wosize (wosz)){
+      /* TODO splay at [n]? if the remnant is larger than [wosz]? */
+      if (set_least){
+        CAMLassert (bound == BF_NUM_SMALL);
+        bf_large_least = n;
+      }
+      result = bf_split (wosz, (value) n);
+      caml_fl_cur_wsz += Whsize_wosize (wosize_n) - Whsize_wosize (wosz);
+        /* remnant stays in tree */
+      return result;
+    }else{
+      bf_remove_node (p);
+      if (wosize_n == wosz){
+        caml_fl_cur_wsz -= Whsize_wosize (wosz);
+        return Hp_val ((value) n);
+      }else{
+        result = bf_split (wosz, (value) n);
+        bf_insert_remnant ((value) n);
+        return result;
+      }
+    }
+  }else{
+    b = n->next;
+    CAMLassert (bf_large_wosize (b) == bf_large_wosize (n));
+    n->next = b->next;
+    b->next->prev = n;
+    if (wosize_n == wosz){
+      caml_fl_cur_wsz -= Whsize_wosize (wosz);
+      return Hp_val ((value) b);
+    }else{
+      result = bf_split (wosz, (value) b);
+      bf_insert_remnant ((value) b);
+      /* TODO: splay at [n] if the remnant is smaller than [wosz] */
+      if (set_least){
+        CAMLassert (bound == BF_NUM_SMALL);
+        if (bf_large_wosize (b) > BF_NUM_SMALL){
+          bf_large_least = b;
+        }
+      }
+      return result;
+    }
+  }
+}
+
+static header_t *bf_allocate_from_tree (mlsize_t wosz, int set_least)
+{
+  large_free_block **n;
+  mlsize_t bound;
+
+  n = bf_search_best (wosz, &bound);
+  if (n == NULL) return NULL;
+  return bf_alloc_from_large (wosz, n, bound, set_least);
+}
+
+static header_t *bf_allocate (mlsize_t wosz)
+{
+  value block;
+  header_t *result;
+
+  CAMLassert (sizeof (char *) == sizeof (value));
+  CAMLassert (wosz >= 1);
+
+  if (wosz <= BF_NUM_SMALL){
+    if (bf_small_fl[wosz].free != Val_NULL){
+      /* fast path: allocate from the corresponding free list */
+      block = bf_small_fl[wosz].free;
+      if (bf_small_fl[wosz].merge == &Next_small (block)){
+        bf_small_fl[wosz].merge = &bf_small_fl[wosz].free;
+      }
+      bf_small_fl[wosz].free = Next_small (block);
+      if (bf_small_fl[wosz].free == Val_NULL) unset_map (wosz);
+      caml_fl_cur_wsz -= Whsize_wosize (wosz);
+      FREELIST_DEBUG_bf_check ();
+      return Hp_val (block);
+    }else{
+      /* allocate from the next available size */
+      mlsize_t s = ffs (bf_small_map & ((-1) << wosz));
+      FREELIST_DEBUG_bf_check ();
+      if (s != 0){
+        block = bf_small_fl[s].free;
+        CAMLassert (block != Val_NULL);
+        if (bf_small_fl[s].merge == &Next_small (block)){
+          bf_small_fl[s].merge = &bf_small_fl[s].free;
+        }
+        bf_small_fl[s].free = Next_small (block);
+        if (bf_small_fl[s].free == Val_NULL) unset_map (s);
+        result = bf_split_small (wosz, block);
+        bf_insert_remnant_small (block);
+        FREELIST_DEBUG_bf_check ();
+        return result;
+      }
+    }
+    /* Failed to find a suitable small block: try [bf_large_least]. */
+    if (bf_large_least != NULL){
+      mlsize_t least_wosz = bf_large_wosize (bf_large_least);
+      if (least_wosz > BF_NUM_SMALL + Whsize_wosize (wosz)){
+        result = bf_split (wosz, (value) bf_large_least);
+        caml_fl_cur_wsz += Whsize_wosize (least_wosz) - Whsize_wosize (wosz);
+          /* remnant stays in tree */
+        CAMLassert (Color_val ((value) bf_large_least) == Caml_blue);
+        return result;
+      }
+    }
+
+    /* Allocate from the tree and update [bf_large_least]. */
+    result = bf_allocate_from_tree (wosz, 1);
+    FREELIST_DEBUG_bf_check ();
+    return result;
+  }else{
+    result = bf_allocate_from_tree (wosz, 0);
+    FREELIST_DEBUG_bf_check ();
+    return result;
+  }
+}
+
+static void bf_init_merge (void)
+{
+  mlsize_t i;
+
+  CAML_EV_ALLOC_FLUSH();
+
+  caml_fl_merge = Val_NULL;
+
+  for (i = 1; i <= BF_NUM_SMALL; i++){
+    /* At the beginning of each small free list is a segment of remnants
+       that were pushed back to the list after splitting. These are white
+       and they are not in order. We need to remove them
+       from the list for coalescing to work. They
+       will be picked up by the sweeping code and inserted in the right
+       place in the list.
+    */
+    value p = bf_small_fl[i].free;
+    while (1){
+      if (p == Val_NULL){
+        unset_map (i);
+        break;
+      }
+      if (Color_val (p) == Caml_blue) break;
+      CAMLassert (Color_val (p) == Caml_white);
+      caml_fl_cur_wsz -= Whsize_val (p);
+      p = Next_small (p);
+    }
+    bf_small_fl[i].free = p;
+    /* Set the merge pointer to its initial value */
+    bf_small_fl[i].merge = &bf_small_fl[i].free;
+  }
+}
+
+static void bf_init (void)
+{
+  mlsize_t i;
+
+  for (i = 1; i <= BF_NUM_SMALL; i++){
+    bf_small_fl[i].free = Val_NULL;
+    bf_small_fl[i].merge = &bf_small_fl[i].free;
+  }
+  bf_small_map = 0;
+  bf_large_tree = NULL;
+  bf_large_least = NULL;
+  caml_fl_cur_wsz = 0;
+}
+
+/* Make sure all free blocks are blue and tear down the BF data structures. */
+static void bf_reset (void)
+{
+  mlsize_t i;
+
+  for (i = 1; i <= BF_NUM_SMALL; i++){
+    /* At the beginning of each small free list is a segment of remnants
+       that were pushed back to the list after splitting. These are white
+       and they are not in order. We must make them blue before we can
+       compact or change the allocator policy.
+    */
+    value p = bf_small_fl[i].free;
+    while (1){
+      if (p == Val_NULL || Color_val (p) == Caml_blue) break;
+      CAMLassert (Color_val (p) == Caml_white);
+      Hd_val (p) = Bluehd_hd (Hd_val (p));
+      p = Next_small (p);
+    }
+  }
+  /* We have no malloced data structures, so we can just call [bf_init] to
+     clear all our pointers. */
+  bf_init ();
+}
+
+static header_t *bf_merge_block (value bp, char *limit)
+{
+  value start;
+  value cur;
+  mlsize_t wosz;
+
+  CAMLassert (Color_val (bp) == Caml_white);
+  /* Find the starting point of the current run of free blocks. */
+  if (caml_fl_merge != Val_NULL && Next_in_mem (caml_fl_merge) == bp
+      && Color_val (caml_fl_merge) == Caml_blue){
+    start = caml_fl_merge;
+    bf_remove (start);
+  }else{
+    start = bp;
+  }
+  cur = bp;
+  while (1){
+    /* This slightly convoluted loop is just going over the run of
+       white or blue blocks, doing the right thing for each color, and
+       stopping on a gray or black block or when limit is passed.
+       It is convoluted because we start knowing that the first block
+       is white. */
+  white:
+    if (Tag_val (cur) == Custom_tag){
+      void (*final_fun)(value) = Custom_ops_val(cur)->finalize;
+      if (final_fun != NULL) final_fun(cur);
+    }
+    caml_fl_cur_wsz += Whsize_val (cur);
+  next:
+    cur = Next_in_mem (cur);
+    if (Hp_val (cur) >= (header_t *) limit){
+      CAMLassert (Hp_val (cur) == (header_t *) limit);
+      goto end_of_run;
+    }
+    switch (Color_val (cur)){
+    case Caml_white: goto white;
+    case Caml_blue: bf_remove (cur); goto next;
+    case Caml_gray:
+    case Caml_black:
+      goto end_of_run;
+    }
+  }
+ end_of_run:
+  wosz = Wosize_whsize ((value *) cur - (value *) start);
+#ifdef DEBUG
+  {
+    value *p;
+    for (p = (value *) start; p < (value *) Hp_val (cur); p++){
+      *p = Debug_free_major;
+    }
+  }
+#endif
+  while (wosz > Max_wosize){
+    Hd_val (start) = Make_header (Max_wosize, 0, Caml_blue);
+    bf_insert_sweep (start);
+    start = Next_in_mem (start);
+    wosz -= Whsize_wosize (Max_wosize);
+  }
+  if (wosz > 0){
+    Hd_val (start) = Make_header (wosz, 0, Caml_blue);
+    bf_insert_sweep (start);
+  }else{
+    Hd_val (start) = Make_header (0, 0, Caml_white);
+    caml_fl_cur_wsz -= Whsize_wosize (0);
+  }
+  FREELIST_DEBUG_bf_check ();
+  return Hp_val (cur);
+}
+
+static void bf_add_blocks (value bp)
+{
+  while (bp != Val_NULL){
+    value next = Next_small (bp);
+    mlsize_t wosz = Wosize_val (bp);
+
+    if (wosz > BF_NUM_SMALL){
+      caml_fl_cur_wsz += Whsize_wosize (wosz);
+      bf_insert_block ((large_free_block *) bp);
+    }else{
+      Hd_val (bp) = Make_header (wosz, Abstract_tag, Caml_white);
+      bf_insert_remnant_small (bp);
+    }
+    bp = next;
+  }
+}
+
+static void bf_make_free_blocks (value *p, mlsize_t size, int do_merge,
+                                 int color)
+{
+  mlsize_t sz, wosz;
+
+  while (size > 0){
+    if (size > Whsize_wosize (Max_wosize)){
+      sz = Whsize_wosize (Max_wosize);
+    }else{
+      sz = size;
+    }
+    wosz = Wosize_whsize (sz);
+    if (do_merge){
+      if (wosz <= BF_NUM_SMALL){
+        color = Caml_white;
+      }else{
+        color = Caml_blue;
+      }
+      *(header_t *)p = Make_header (wosz, 0, color);
+      bf_insert_remnant (Val_hp (p));
+    }else{
+      *(header_t *)p = Make_header (wosz, 0, color);
+    }
+    size -= sz;
+    p += sz;
+  }
+}
+
+/*********************** policy selection *****************************/
+
+enum {
+  policy_next_fit = 0,
+  policy_first_fit = 1,
+  policy_best_fit = 2,
+};
+
+uintnat caml_allocation_policy = policy_next_fit;
+
+/********************* exported functions *****************************/
+
+/* [caml_fl_allocate] does not set the header of the newly allocated block.
+   The calling function must do it before any GC function gets called.
+   [caml_fl_allocate] returns a head pointer, or NULL if no suitable block
+   is found in the free set.
+*/
+header_t *(*caml_fl_p_allocate) (mlsize_t wo_sz) = &nf_allocate;
+
+/* Initialize the merge_block machinery (at start of sweeping). */
+void (*caml_fl_p_init_merge) (void) = &nf_init_merge;
+
+/* These are called internally. */
+static void (*caml_fl_p_init) (void) = &nf_init;
+static void (*caml_fl_p_reset) (void) = &nf_reset;
+
+/* [caml_fl_merge_block] returns the head pointer of the next block after [bp],
+   because merging blocks may change the size of [bp]. */
+header_t *(*caml_fl_p_merge_block) (value bp, char *limit) = &nf_merge_block;
+
+/* [bp] must point to a list of blocks of wosize >= 1 chained by their field 0,
+   terminated by Val_NULL, and field 1 of the first block must point to
+   the last block.
+   The blocks must be blue.
+*/
+void (*caml_fl_p_add_blocks) (value bp) = &nf_add_blocks;
+
+/* Cut a block of memory into pieces of size [Max_wosize], give them headers,
+   and optionally merge them into the free list.
+   arguments:
+   p: pointer to the first word of the block
+   size: size of the block (in words)
+   do_merge: 1 -> do merge; 0 -> do not merge
+   color: which color to give to the pieces; if [do_merge] is 1, this
+          is overridden by the merge code, but we have historically used
+          [Caml_white].
+*/
+void (*caml_fl_p_make_free_blocks)
+  (value *p, mlsize_t size, int do_merge, int color)
+  = &nf_make_free_blocks;
+#ifdef DEBUG
+void (*caml_fl_p_check) (void) = &nf_check;
+#endif
+
+void caml_set_allocation_policy (intnat p)
+{
+  switch (p){
+  case policy_next_fit: default:
+    caml_allocation_policy = policy_next_fit;
+    caml_fl_p_allocate = &nf_allocate;
+    caml_fl_p_init_merge = &nf_init_merge;
+    caml_fl_p_reset = &nf_reset;
+    caml_fl_p_init = &nf_init;
+    caml_fl_p_merge_block = &nf_merge_block;
+    caml_fl_p_add_blocks = &nf_add_blocks;
+    caml_fl_p_make_free_blocks = &nf_make_free_blocks;
+#ifdef DEBUG
+    caml_fl_p_check = &nf_check;
+#endif
+    break;
+  case policy_first_fit:
+    caml_allocation_policy = policy_first_fit;
+    caml_fl_p_allocate = &ff_allocate;
+    caml_fl_p_init_merge = &ff_init_merge;
+    caml_fl_p_reset = &ff_reset;
+    caml_fl_p_init = &ff_init;
+    caml_fl_p_merge_block = &ff_merge_block;
+    caml_fl_p_add_blocks = &ff_add_blocks;
+    caml_fl_p_make_free_blocks = &ff_make_free_blocks;
+#ifdef DEBUG
+    caml_fl_p_check = &ff_check;
+#endif
+    break;
+  case policy_best_fit:
+    caml_allocation_policy = policy_best_fit;
+    caml_fl_p_allocate = &bf_allocate;
+    caml_fl_p_init_merge = &bf_init_merge;
+    caml_fl_p_reset = &bf_reset;
+    caml_fl_p_init = &bf_init;
+    caml_fl_p_merge_block = &bf_merge_block;
+    caml_fl_p_add_blocks = &bf_add_blocks;
+    caml_fl_p_make_free_blocks = &bf_make_free_blocks;
+#ifdef DEBUG
+    caml_fl_p_check = &bf_check;
+#endif
+    break;
+  }
+}
+
+/* This is called by caml_compact_heap. */
+void caml_fl_reset_and_switch_policy (intnat new_allocation_policy)
+{
+  /* reset the fl data structures */
+  (*caml_fl_p_reset) ();
+  if (new_allocation_policy != -1){
+    caml_set_allocation_policy (new_allocation_policy);
+    (*caml_fl_p_init) (); /* initialize the new allocation policy */
+  }
+}
diff --git a/runtime/gc_ctrl.c b/runtime/gc_ctrl.c
new file mode 100644
index 00000000..956cbcbb
--- /dev/null
+++ b/runtime/gc_ctrl.c
@@ -0,0 +1,767 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*              Damien Doligez, projet Para, 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
+
+#include "caml/alloc.h"
+#include "caml/backtrace.h"
+#include "caml/compact.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/finalise.h"
+#include "caml/freelist.h"
+#include "caml/gc.h"
+#include "caml/gc_ctrl.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/signals.h"
+#include "caml/eventlog.h"
+#ifdef NATIVE_CODE
+#include "caml/stack.h"
+#else
+#include "caml/stacks.h"
+#endif
+#include "caml/startup_aux.h"
+
+#ifndef NATIVE_CODE
+extern uintnat caml_max_stack_size;    /* defined in stacks.c */
+#endif
+
+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_custom_minor_max_bsz; /* see custom.c */
+
+#define Next(hp) ((header_t *)(hp) + Whsize_hp (hp))
+
+#ifdef DEBUG
+
+/* Check that [v]'s header looks good.  [v] must be a block in the heap. */
+static void check_head (value v)
+{
+  CAMLassert (Is_block (v));
+  CAMLassert (Is_in_heap (v));
+
+  CAMLassert (Wosize_val (v) != 0);
+  CAMLassert (Color_hd (Hd_val (v)) != Caml_blue);
+  CAMLassert (Is_in_heap (v));
+  if (Tag_val (v) == Infix_tag){
+    int offset = Wsize_bsize (Infix_offset_val (v));
+    value trueval = Val_op (&Field (v, -offset));
+    CAMLassert (Tag_val (trueval) == Closure_tag);
+    CAMLassert (Wosize_val (trueval) > offset);
+    CAMLassert (Is_in_heap (&Field (trueval, Wosize_val (trueval) - 1)));
+  }else{
+    CAMLassert (Is_in_heap (&Field (v, Wosize_val (v) - 1)));
+  }
+  if (Tag_val (v) ==  Double_tag){
+    CAMLassert (Wosize_val (v) == Double_wosize);
+  }else if (Tag_val (v) == Double_array_tag){
+    CAMLassert (Wosize_val (v) % Double_wosize == 0);
+  }
+}
+
+static void check_block (header_t *hp)
+{
+  mlsize_t i;
+  value v = Val_hp (hp);
+  value f;
+
+  check_head (v);
+  switch (Tag_hp (hp)){
+  case Abstract_tag: break;
+  case String_tag:
+    break;
+  case Double_tag:
+    CAMLassert (Wosize_val (v) == Double_wosize);
+    break;
+  case Double_array_tag:
+    CAMLassert (Wosize_val (v) % Double_wosize == 0);
+    break;
+  case Custom_tag:
+    CAMLassert (!Is_in_heap (Custom_ops_val (v)));
+    break;
+
+  case Infix_tag:
+    CAMLassert (0);
+    break;
+
+  default:
+    CAMLassert (Tag_hp (hp) < No_scan_tag);
+    for (i = 0; i < Wosize_hp (hp); i++){
+      f = Field (v, i);
+      if (Is_block (f) && Is_in_heap (f)){
+        check_head (f);
+        CAMLassert (Color_val (f) != Caml_blue);
+      }
+    }
+  }
+}
+
+#endif /* DEBUG */
+
+/* Check the heap structure (if compiled in debug mode) and
+   gather statistics; return the stats if [returnstats] is true,
+   otherwise return [Val_unit].
+*/
+static value heap_stats (int returnstats)
+{
+  CAMLparam0 ();
+  intnat live_words = 0, live_blocks = 0,
+         free_words = 0, free_blocks = 0, largest_free = 0,
+         fragments = 0, heap_chunks = 0;
+  char *chunk = caml_heap_start, *chunk_end;
+  header_t *cur_hp;
+#ifdef DEBUG
+  header_t *prev_hp;
+#endif
+  header_t cur_hd;
+
+#ifdef DEBUG
+  caml_gc_message (-1, "### OCaml runtime: heap check ###\n");
+#endif
+
+  while (chunk != NULL){
+    ++ heap_chunks;
+    chunk_end = chunk + Chunk_size (chunk);
+#ifdef DEBUG
+    prev_hp = NULL;
+#endif
+    cur_hp = (header_t *) chunk;
+    while (cur_hp < (header_t *) chunk_end){
+      cur_hd = Hd_hp (cur_hp);
+      CAMLassert (Next (cur_hp) <= (header_t *) chunk_end);
+      switch (Color_hd (cur_hd)){
+      case Caml_white:
+        if (Wosize_hd (cur_hd) == 0){
+          ++ fragments;
+          CAMLassert (prev_hp == NULL
+                      || Color_hp (prev_hp) != Caml_blue
+                      || cur_hp == (header_t *) caml_gc_sweep_hp);
+        }else{
+          if (caml_gc_phase == Phase_sweep
+              && cur_hp >= (header_t *) caml_gc_sweep_hp){
+            ++ free_blocks;
+            free_words += Whsize_hd (cur_hd);
+            if (Whsize_hd (cur_hd) > largest_free){
+              largest_free = Whsize_hd (cur_hd);
+            }
+          }else{
+            ++ live_blocks;
+            live_words += Whsize_hd (cur_hd);
+#ifdef DEBUG
+            check_block (cur_hp);
+#endif
+          }
+        }
+        break;
+      case Caml_gray: case Caml_black:
+        CAMLassert (Wosize_hd (cur_hd) > 0);
+        ++ live_blocks;
+        live_words += Whsize_hd (cur_hd);
+#ifdef DEBUG
+        check_block (cur_hp);
+#endif
+        break;
+      case Caml_blue:
+        CAMLassert (Wosize_hd (cur_hd) > 0);
+        ++ free_blocks;
+        free_words += Whsize_hd (cur_hd);
+        if (Whsize_hd (cur_hd) > largest_free){
+          largest_free = Whsize_hd (cur_hd);
+        }
+        /* not true any more with big heap chunks
+        CAMLassert (prev_hp == NULL
+                    || (Color_hp (prev_hp) != Caml_blue
+                        && Wosize_hp (prev_hp) > 0)
+                    || cur_hp == caml_gc_sweep_hp);
+        CAMLassert (Next (cur_hp) == chunk_end
+                    || (Color_hp (Next (cur_hp)) != Caml_blue
+                       && Wosize_hp (Next (cur_hp)) > 0)
+                    || (Whsize_hd (cur_hd) + Wosize_hp (Next (cur_hp))
+                       > Max_wosize)
+                    || Next (cur_hp) == caml_gc_sweep_hp);
+        */
+        break;
+      }
+#ifdef DEBUG
+      prev_hp = cur_hp;
+#endif
+      cur_hp = Next (cur_hp);
+    }
+    CAMLassert (cur_hp == (header_t *) chunk_end);
+    chunk = Chunk_next (chunk);
+  }
+
+#ifdef DEBUG
+  caml_final_invariant_check();
+  caml_fl_check ();
+#endif
+
+  CAMLassert (heap_chunks == Caml_state->stat_heap_chunks);
+  CAMLassert (live_words + free_words + fragments == Caml_state->stat_heap_wsz);
+
+  if (returnstats){
+    CAMLlocal1 (res);
+
+    /* get a copy of these before allocating anything... */
+    double minwords =
+      Caml_state->stat_minor_words
+      + (double) (Caml_state->young_alloc_end - Caml_state->young_ptr);
+    double prowords = Caml_state->stat_promoted_words;
+    double majwords =
+      Caml_state->stat_major_words + (double) caml_allocated_words;
+    intnat mincoll = Caml_state->stat_minor_collections;
+    intnat majcoll = Caml_state->stat_major_collections;
+    intnat heap_words = Caml_state->stat_heap_wsz;
+    intnat cpct = Caml_state->stat_compactions;
+    intnat top_heap_words = Caml_state->stat_top_heap_wsz;
+
+    res = caml_alloc_tuple (16);
+    Store_field (res, 0, caml_copy_double (minwords));
+    Store_field (res, 1, caml_copy_double (prowords));
+    Store_field (res, 2, caml_copy_double (majwords));
+    Store_field (res, 3, Val_long (mincoll));
+    Store_field (res, 4, Val_long (majcoll));
+    Store_field (res, 5, Val_long (heap_words));
+    Store_field (res, 6, Val_long (heap_chunks));
+    Store_field (res, 7, Val_long (live_words));
+    Store_field (res, 8, Val_long (live_blocks));
+    Store_field (res, 9, Val_long (free_words));
+    Store_field (res, 10, Val_long (free_blocks));
+    Store_field (res, 11, Val_long (largest_free));
+    Store_field (res, 12, Val_long (fragments));
+    Store_field (res, 13, Val_long (cpct));
+    Store_field (res, 14, Val_long (top_heap_words));
+    Store_field (res, 15, Val_long (caml_stack_usage()));
+    CAMLreturn (res);
+  }else{
+    CAMLreturn (Val_unit);
+  }
+}
+
+#ifdef DEBUG
+void caml_heap_check (void)
+{
+  heap_stats (0);
+}
+#endif
+
+CAMLprim value caml_gc_stat(value v)
+{
+  value result;
+  CAML_EV_BEGIN(EV_EXPLICIT_GC_STAT);
+  CAMLassert (v == Val_unit);
+  result = heap_stats (1);
+  CAML_EV_END(EV_EXPLICIT_GC_STAT);
+  return result;
+}
+
+CAMLprim value caml_gc_quick_stat(value v)
+{
+  CAMLparam0 ();
+  CAMLlocal1 (res);
+
+  /* get a copy of these before allocating anything... */
+  double minwords =
+    Caml_state->stat_minor_words
+    + (double) (Caml_state->young_alloc_end - Caml_state->young_ptr);
+  double prowords = Caml_state->stat_promoted_words;
+  double majwords =
+    Caml_state->stat_major_words + (double) caml_allocated_words;
+  intnat mincoll = Caml_state->stat_minor_collections;
+  intnat majcoll = Caml_state->stat_major_collections;
+  intnat heap_words = Caml_state->stat_heap_wsz;
+  intnat top_heap_words = Caml_state->stat_top_heap_wsz;
+  intnat cpct = Caml_state->stat_compactions;
+  intnat heap_chunks = Caml_state->stat_heap_chunks;
+
+  res = caml_alloc_tuple (16);
+  Store_field (res, 0, caml_copy_double (minwords));
+  Store_field (res, 1, caml_copy_double (prowords));
+  Store_field (res, 2, caml_copy_double (majwords));
+  Store_field (res, 3, Val_long (mincoll));
+  Store_field (res, 4, Val_long (majcoll));
+  Store_field (res, 5, Val_long (heap_words));
+  Store_field (res, 6, Val_long (heap_chunks));
+  Store_field (res, 7, Val_long (0));
+  Store_field (res, 8, Val_long (0));
+  Store_field (res, 9, Val_long (0));
+  Store_field (res, 10, Val_long (0));
+  Store_field (res, 11, Val_long (0));
+  Store_field (res, 12, Val_long (0));
+  Store_field (res, 13, Val_long (cpct));
+  Store_field (res, 14, Val_long (top_heap_words));
+  Store_field (res, 15, Val_long (caml_stack_usage()));
+  CAMLreturn (res);
+}
+
+double caml_gc_minor_words_unboxed()
+{
+  return (Caml_state->stat_minor_words
+          + (double) (Caml_state->young_alloc_end - Caml_state->young_ptr));
+}
+
+CAMLprim value caml_gc_minor_words(value v)
+{
+  CAMLparam0 ();   /* v is ignored */
+  CAMLreturn(caml_copy_double(caml_gc_minor_words_unboxed()));
+}
+
+CAMLprim value caml_gc_counters(value v)
+{
+  CAMLparam0 ();   /* v is ignored */
+  CAMLlocal1 (res);
+
+  /* get a copy of these before allocating anything... */
+  double minwords =
+    Caml_state->stat_minor_words
+    + (double) (Caml_state->young_alloc_end - Caml_state->young_ptr);
+  double prowords = Caml_state->stat_promoted_words;
+  double majwords =
+    Caml_state->stat_major_words + (double) caml_allocated_words;
+
+  res = caml_alloc_tuple (3);
+  Store_field (res, 0, caml_copy_double (minwords));
+  Store_field (res, 1, caml_copy_double (prowords));
+  Store_field (res, 2, caml_copy_double (majwords));
+  CAMLreturn (res);
+}
+
+CAMLprim value caml_gc_huge_fallback_count (value v)
+{
+  return Val_long (caml_huge_fallback_count);
+}
+
+CAMLprim value caml_gc_get(value v)
+{
+  CAMLparam0 ();   /* v is ignored */
+  CAMLlocal1 (res);
+
+  res = caml_alloc_tuple (11);
+  Store_field (res, 0, Val_long (Caml_state->minor_heap_wsz));          /* s */
+  Store_field (res, 1, Val_long (caml_major_heap_increment));           /* i */
+  Store_field (res, 2, Val_long (caml_percent_free));                   /* o */
+  Store_field (res, 3, Val_long (caml_verb_gc));                        /* v */
+  Store_field (res, 4, Val_long (caml_percent_max));                    /* O */
+#ifndef NATIVE_CODE
+  Store_field (res, 5, Val_long (caml_max_stack_size));                 /* l */
+#else
+  Store_field (res, 5, Val_long (0));
+#endif
+  Store_field (res, 6, Val_long (caml_allocation_policy));              /* a */
+  Store_field (res, 7, Val_long (caml_major_window));                   /* w */
+  Store_field (res, 8, Val_long (caml_custom_major_ratio));             /* M */
+  Store_field (res, 9, Val_long (caml_custom_minor_ratio));             /* m */
+  Store_field (res, 10, Val_long (caml_custom_minor_max_bsz));          /* n */
+  CAMLreturn (res);
+}
+
+#define Max(x,y) ((x) < (y) ? (y) : (x))
+
+static uintnat norm_pfree (uintnat p)
+{
+  return Max (p, 1);
+}
+
+static uintnat norm_pmax (uintnat p)
+{
+  return p;
+}
+
+static intnat norm_minsize (intnat s)
+{
+  intnat page_wsize = Wsize_bsize(Page_size);
+  if (s < Minor_heap_min) s = Minor_heap_min;
+  if (s > Minor_heap_max) s = Minor_heap_max;
+  /* PR#9128 : Make sure the minor heap occupies an integral number of
+     pages, so that no page contains both bytecode and OCaml
+     values. This would confuse, e.g., caml_hash. */
+  s = (s + page_wsize - 1) / page_wsize * page_wsize;
+  return s;
+}
+
+static uintnat norm_window (intnat w)
+{
+  if (w < 1) w = 1;
+  if (w > Max_major_window) w = Max_major_window;
+  return w;
+}
+
+static uintnat norm_custom_maj (uintnat p)
+{
+  return Max (p, 1);
+}
+
+static uintnat norm_custom_min (uintnat p)
+{
+  return Max (p, 1);
+}
+
+CAMLprim value caml_gc_set(value v)
+{
+  uintnat newpf, newpm;
+  asize_t newheapincr;
+  asize_t newminwsz;
+  uintnat newpolicy;
+  uintnat new_custom_maj, new_custom_min, new_custom_sz;
+  CAML_EV_BEGIN(EV_EXPLICIT_GC_SET);
+
+  caml_verb_gc = Long_val (Field (v, 3));
+
+#ifndef NATIVE_CODE
+  caml_change_max_stack_size (Long_val (Field (v, 5)));
+#endif
+
+  newpf = norm_pfree (Long_val (Field (v, 2)));
+  if (newpf != caml_percent_free){
+    caml_percent_free = newpf;
+    caml_gc_message (0x20, "New space overhead: %"
+                     ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_percent_free);
+  }
+
+  newpm = norm_pmax (Long_val (Field (v, 4)));
+  if (newpm != caml_percent_max){
+    caml_percent_max = newpm;
+    caml_gc_message (0x20, "New max overhead: %"
+                     ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_percent_max);
+  }
+
+  newheapincr = Long_val (Field (v, 1));
+  if (newheapincr != caml_major_heap_increment){
+    caml_major_heap_increment = newheapincr;
+    if (newheapincr > 1000){
+      caml_gc_message (0x20, "New heap increment size: %"
+                       ARCH_INTNAT_PRINTF_FORMAT "uk words\n",
+                       caml_major_heap_increment/1024);
+    }else{
+      caml_gc_message (0x20, "New heap increment size: %"
+                       ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
+                       caml_major_heap_increment);
+    }
+  }
+
+  /* This field was added in 4.03.0. */
+  if (Wosize_val (v) >= 8){
+    int old_window = caml_major_window;
+    caml_set_major_window (norm_window (Long_val (Field (v, 7))));
+    if (old_window != caml_major_window){
+      caml_gc_message (0x20, "New smoothing window size: %d\n",
+                       caml_major_window);
+    }
+  }
+
+  /* These fields were added in 4.08.0. */
+  if (Wosize_val (v) >= 11){
+    new_custom_maj = norm_custom_maj (Field (v, 8));
+    if (new_custom_maj != caml_custom_major_ratio){
+      caml_custom_major_ratio = new_custom_maj;
+      caml_gc_message (0x20, "New custom major ratio: %"
+                       ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
+                       caml_custom_major_ratio);
+    }
+    new_custom_min = norm_custom_min (Field (v, 9));
+    if (new_custom_min != caml_custom_minor_ratio){
+      caml_custom_minor_ratio = new_custom_min;
+      caml_gc_message (0x20, "New custom minor ratio: %"
+                       ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
+                       caml_custom_minor_ratio);
+    }
+    new_custom_sz = Field (v, 10);
+    if (new_custom_sz != caml_custom_minor_max_bsz){
+      caml_custom_minor_max_bsz = new_custom_sz;
+      caml_gc_message (0x20, "New custom minor size limit: %"
+                       ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
+                       caml_custom_minor_max_bsz);
+    }
+  }
+
+  /* Save field 0 before [v] is invalidated. */
+  newminwsz = norm_minsize (Long_val (Field (v, 0)));
+
+  /* Switching allocation policies must trigger a compaction, so it
+     invalidates [v]. */
+  newpolicy = Long_val (Field (v, 6));
+  if (newpolicy != caml_allocation_policy){
+    caml_empty_minor_heap ();
+    caml_finish_major_cycle ();
+    caml_finish_major_cycle ();
+    caml_compact_heap (newpolicy);
+    caml_gc_message (0x20, "New allocation policy: %"
+                     ARCH_INTNAT_PRINTF_FORMAT "u\n", newpolicy);
+  }
+
+  /* Minor heap size comes last because it can raise [Out_of_memory]. */
+  if (newminwsz != Caml_state->minor_heap_wsz){
+    caml_gc_message (0x20, "New minor heap size: %"
+                     ARCH_SIZET_PRINTF_FORMAT "uk words\n", newminwsz / 1024);
+    caml_set_minor_heap_size (Bsize_wsize (newminwsz));
+  }
+  CAML_EV_END(EV_EXPLICIT_GC_SET);
+
+  /* The compaction may have triggered some finalizers that we need to call. */
+  caml_process_pending_actions();
+
+  return Val_unit;
+}
+
+CAMLprim value caml_gc_minor(value v)
+{
+  value exn;
+
+  CAML_EV_BEGIN(EV_EXPLICIT_GC_MINOR);
+  CAMLassert (v == Val_unit);
+  caml_request_minor_gc ();
+  // call the gc and call finalisers
+  exn = caml_process_pending_actions_exn();
+  CAML_EV_END(EV_EXPLICIT_GC_MINOR);
+  caml_raise_if_exception(exn);
+  return Val_unit;
+}
+
+static void test_and_compact (void)
+{
+  double fp;
+
+  fp = 100.0 * caml_fl_cur_wsz / (Caml_state->stat_heap_wsz - caml_fl_cur_wsz);
+  if (fp > 999999.0) fp = 999999.0;
+  caml_gc_message (0x200, "Estimated overhead (lower bound) = %"
+                          ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
+                   (uintnat) fp);
+  if (fp >= caml_percent_max){
+    caml_gc_message (0x200, "Automatic compaction triggered.\n");
+    caml_compact_heap (-1);
+  }
+}
+
+CAMLprim value caml_gc_major(value v)
+{
+  value exn;
+
+  CAML_EV_BEGIN(EV_EXPLICIT_GC_MAJOR);
+  CAMLassert (v == Val_unit);
+  caml_gc_message (0x1, "Major GC cycle requested\n");
+  caml_empty_minor_heap ();
+  caml_finish_major_cycle ();
+  test_and_compact ();
+  // call finalisers
+  exn = caml_process_pending_actions_exn();
+  CAML_EV_END(EV_EXPLICIT_GC_MAJOR);
+  caml_raise_if_exception(exn);
+  return Val_unit;
+}
+
+CAMLprim value caml_gc_full_major(value v)
+{
+  value exn;
+
+  CAML_EV_BEGIN(EV_EXPLICIT_GC_FULL_MAJOR);
+  CAMLassert (v == Val_unit);
+  caml_gc_message (0x1, "Full major GC cycle requested\n");
+  caml_empty_minor_heap ();
+  caml_finish_major_cycle ();
+  // call finalisers
+  exn = caml_process_pending_actions_exn();
+  if (Is_exception_result(exn)) goto cleanup;
+  caml_empty_minor_heap ();
+  caml_finish_major_cycle ();
+  test_and_compact ();
+  // call finalisers
+  exn = caml_process_pending_actions_exn();
+
+cleanup:
+  CAML_EV_END(EV_EXPLICIT_GC_FULL_MAJOR);
+  caml_raise_if_exception(exn);
+
+  return Val_unit;
+}
+
+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));
+  CAML_EV_END(EV_EXPLICIT_GC_MAJOR_SLICE);
+  return Val_long (0);
+}
+
+CAMLprim value caml_gc_compaction(value v)
+{
+  value exn;
+
+  CAML_EV_BEGIN(EV_EXPLICIT_GC_COMPACT);
+  CAMLassert (v == Val_unit);
+  caml_gc_message (0x10, "Heap compaction requested\n");
+  caml_empty_minor_heap ();
+  caml_finish_major_cycle ();
+  // call finalisers
+  exn = caml_process_pending_actions_exn();
+  if (Is_exception_result(exn)) goto cleanup;
+  caml_empty_minor_heap ();
+  caml_finish_major_cycle ();
+  caml_compact_heap (-1);
+  // call finalisers
+  exn = caml_process_pending_actions_exn();
+
+ cleanup:
+  CAML_EV_END(EV_EXPLICIT_GC_COMPACT);
+  caml_raise_if_exception(exn);
+  return Val_unit;
+}
+
+CAMLprim value caml_get_minor_free (value v)
+{
+  return Val_int (Caml_state->young_ptr - Caml_state->young_alloc_start);
+}
+
+CAMLprim value caml_get_major_bucket (value v)
+{
+  long i = Long_val (v);
+  if (i < 0) caml_invalid_argument ("Gc.get_bucket");
+  if (i < caml_major_window){
+    i += caml_major_ring_index;
+    if (i >= caml_major_window) i -= caml_major_window;
+    CAMLassert (0 <= i && i < caml_major_window);
+    return Val_long ((long) (caml_major_ring[i] * 1e6));
+  }else{
+    return Val_long (0);
+  }
+}
+
+CAMLprim value caml_get_major_credit (value v)
+{
+  CAMLassert (v == Val_unit);
+  return Val_long ((long) (caml_major_work_credit * 1e6));
+}
+
+/* [minor_size] and [major_size] are numbers of words
+   [major_incr] is either a percentage or a number of words */
+void caml_init_gc (uintnat minor_size, uintnat major_size,
+                   uintnat major_incr, uintnat percent_fr,
+                   uintnat percent_m, uintnat window,
+                   uintnat custom_maj, uintnat custom_min,
+                   uintnat custom_bsz)
+{
+  uintnat major_bsize;
+  if (major_size < Heap_chunk_min) major_size = Heap_chunk_min;
+  major_bsize = Bsize_wsize(major_size);
+  major_bsize = ((major_bsize + Page_size - 1) >> Page_log) << Page_log;
+
+  if (caml_page_table_initialize(Bsize_wsize(minor_size) + major_bsize)){
+    caml_fatal_error ("cannot initialize page table");
+  }
+  caml_set_minor_heap_size (Bsize_wsize (norm_minsize (minor_size)));
+  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_bsize);
+  caml_major_window = norm_window (window);
+  caml_custom_major_ratio = norm_custom_maj (custom_maj);
+  caml_custom_minor_ratio = norm_custom_min (custom_min);
+  caml_custom_minor_max_bsz = custom_bsz;
+  caml_gc_message (0x20, "Initial minor heap size: %"
+                   ARCH_SIZET_PRINTF_FORMAT "uk words\n",
+                   Caml_state->minor_heap_wsz / 1024);
+  caml_gc_message (0x20, "Initial major heap size: %"
+                   ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
+                   major_bsize / 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: %"
+                   ARCH_INTNAT_PRINTF_FORMAT "u\n", caml_allocation_policy);
+  caml_gc_message (0x20, "Initial smoothing window: %d\n",
+                   caml_major_window);
+}
+
+
+/* FIXME After the startup_aux.c unification, move these functions there. */
+
+CAMLprim value caml_runtime_variant (value unit)
+{
+  CAMLassert (unit == Val_unit);
+#if defined (DEBUG)
+  return caml_copy_string ("d");
+#elif defined (CAML_INSTR)
+  return caml_copy_string ("i");
+#else
+  return caml_copy_string ("");
+#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);
+  return caml_alloc_sprintf
+    ("a=%d,b=%d,H=%"F_Z"u,i=%"F_Z"u,l=%"F_Z"u,o=%"F_Z"u,O=%"F_Z"u,p=%d,"
+     "s=%"F_S"u,t=%"F_Z"u,v=%"F_Z"u,w=%d,W=%"F_Z"u",
+     /* a */ (int) caml_allocation_policy,
+     /* b */ (int) Caml_state->backtrace_active,
+     /* h */ /* missing */ /* FIXME add when changed to min_heap_size */
+     /* H */ caml_use_huge_pages,
+     /* i */ caml_major_heap_increment,
+#ifdef NATIVE_CODE
+     /* l */ (uintnat) 0,
+#else
+     /* l */ caml_max_stack_size,
+#endif
+     /* o */ caml_percent_free,
+     /* O */ caml_percent_max,
+     /* p */ caml_parser_trace,
+     /* R */ /* missing */
+     /* s */ Caml_state->minor_heap_wsz,
+     /* t */ caml_trace_level,
+     /* v */ caml_verb_gc,
+     /* w */ caml_major_window,
+     /* W */ caml_runtime_warnings
+     );
+#undef F_Z
+#undef F_S
+}
+
+/* Control runtime warnings */
+
+CAMLprim value caml_ml_enable_runtime_warnings(value vbool)
+{
+  caml_runtime_warnings = Bool_val(vbool);
+  return Val_unit;
+}
+
+CAMLprim value caml_ml_runtime_warnings_enabled(value unit)
+{
+  CAMLassert (unit == Val_unit);
+  return Val_bool(caml_runtime_warnings);
+}
diff --git a/runtime/gen_domain_state32_inc.awk b/runtime/gen_domain_state32_inc.awk
new file mode 100644
index 00000000..f8409023
--- /dev/null
+++ b/runtime/gen_domain_state32_inc.awk
@@ -0,0 +1,36 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*         KC Sivaramakrishnan, Indian Institute of Technology, Madras    *
+#*                                                                        *
+#*   Copyright 2019 Indian Institute of Technology, Madras                *
+#*                                                                        *
+#*   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.          *
+#*                                                                        *
+#**************************************************************************
+
+BEGIN{FS="[,)] *";count=0};
+/DOMAIN_STATE/{
+  print "Store_" $2 " MACRO reg1, reg2";
+  print "  mov [reg1+" count "], reg2";
+  print "ENDM";
+  print "Load_" $2 " MACRO reg1, reg2";
+  print "  mov reg2, [reg1+" count "]";
+  print  "ENDM";
+  print "Push_" $2 " MACRO reg1";
+  print "  push [reg1+" count "]";
+  print "ENDM";
+  print "Pop_" $2 " MACRO reg1";
+  print "  pop [reg1+" count "]";
+  print "ENDM";
+  print "Cmp_" $2 " MACRO reg1, reg2";
+  print "  cmp reg2, [reg1+" count "]";
+  print "ENDM";
+  print "Sub_" $2 " MACRO reg1, reg2";
+  print "  sub reg2, [reg1+" count "]";
+  print "ENDM";
+  count+=8
+}
diff --git a/runtime/gen_domain_state64_inc.awk b/runtime/gen_domain_state64_inc.awk
new file mode 100644
index 00000000..8280d4d1
--- /dev/null
+++ b/runtime/gen_domain_state64_inc.awk
@@ -0,0 +1,33 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*         KC Sivaramakrishnan, Indian Institute of Technology, Madras    *
+#*                                                                        *
+#*   Copyright 2019 Indian Institute of Technology, Madras                *
+#*                                                                        *
+#*   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.          *
+#*                                                                        *
+#**************************************************************************
+
+BEGIN{FS="[,)] *";count=0};
+/DOMAIN_STATE/{
+  print "Store_" $2 " MACRO reg";
+  print "  mov [r14+" count "], reg";
+  print "ENDM";
+  print "Load_" $2 " MACRO reg";
+  print "  mov reg, [r14+" count "]";
+  print  "ENDM";
+  print "Push_" $2 " MACRO";
+  print "  push [r14+" count "]";
+  print "ENDM";
+  print "Pop_" $2 " MACRO";
+  print "  pop [r14+" count "]";
+  print "ENDM";
+  print "Cmp_" $2 " MACRO reg";
+  print "  cmp reg, [r14+" count "]";
+  print "ENDM";
+  count+=8
+}
diff --git a/runtime/gen_primitives.sh b/runtime/gen_primitives.sh
new file mode 100755
index 00000000..8816ccb4
--- /dev/null
+++ b/runtime/gen_primitives.sh
@@ -0,0 +1,34 @@
+#!/bin/sh
+
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# duplicated from $(ROOTDIR)/runtime/Makefile
+
+# #8985: the meaning of character range a-z depends on the locale, so force C
+#        locale throughout.
+export LC_ALL=C
+(
+  for prim in \
+      alloc array compare extern floats gc_ctrl hash intern interp ints io \
+      lexing md5 meta memprof obj parsing signals str sys callback weak \
+      finalise stacks dynlink backtrace_byt backtrace spacetime_byt afl \
+      bigarray eventlog
+  do
+      sed -n -e 's/^CAMLprim value \([a-z0-9_][a-z0-9_]*\).*/\1/p' "$prim.c"
+  done
+  sed -n -e 's/^CAMLprim_int64_[0-9](\([a-z0-9_][a-z0-9_]*\)).*/caml_int64_\1\
+caml_int64_\1_native/p' ints.c
+) | sort | uniq
diff --git a/runtime/globroots.c b/runtime/globroots.c
new file mode 100644
index 00000000..54fc8b8f
--- /dev/null
+++ b/runtime/globroots.c
@@ -0,0 +1,313 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            */
+/*                                                                        */
+/*   Copyright 2001 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+#define CAML_INTERNALS
+
+/* Registration of global memory roots */
+
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/globroots.h"
+
+/* The sets of global memory roots are represented as skip lists
+   (see William Pugh, "Skip lists: a probabilistic alternative to
+   balanced binary trees", Comm. ACM 33(6), 1990). */
+
+struct global_root {
+  value * root;                    /* the address of the root */
+  struct global_root * forward[1]; /* variable-length array */
+};
+
+#define NUM_LEVELS 17
+
+struct global_root_list {
+  value * root;                 /* dummy value for layout compatibility */
+  struct global_root * forward[NUM_LEVELS]; /* forward chaining */
+  int level;                    /* max used level */
+};
+
+/* Generate a random level for a new node: 0 with probability 3/4,
+   1 with probability 3/16, 2 with probability 3/64, etc.
+   We use a simple linear congruential PRNG (see Knuth vol 2) instead
+   of random(), because we need exactly 32 bits of pseudo-random data
+   (i.e. 2 * (NUM_LEVELS - 1)).  Moreover, the congruential PRNG
+   is faster and guaranteed to be deterministic (to reproduce bugs). */
+
+static uint32_t random_seed = 0;
+
+static int random_level(void)
+{
+  uint32_t r;
+  int level = 0;
+
+  /* Linear congruence with modulus = 2^32, multiplier = 69069
+     (Knuth vol 2 p. 106, line 15 of table 1), additive = 25173. */
+  r = random_seed = random_seed * 69069 + 25173;
+  /* Knuth (vol 2 p. 13) shows that the least significant bits are
+     "less random" than the most significant bits with a modulus of 2^m,
+     so consume most significant bits first */
+  while ((r & 0xC0000000U) == 0xC0000000U) { level++; r = r << 2; }
+  CAMLassert(level < NUM_LEVELS);
+  return level;
+}
+
+/* Insertion in a global root list */
+
+static void caml_insert_global_root(struct global_root_list * rootlist,
+                                    value * r)
+{
+  struct global_root * update[NUM_LEVELS];
+  struct global_root * e, * f;
+  int i, new_level;
+
+  CAMLassert(0 <= rootlist->level && rootlist->level < NUM_LEVELS);
+
+  /* Init "cursor" to list head */
+  e = (struct global_root *) rootlist;
+  /* Find place to insert new node */
+  for (i = rootlist->level; i >= 0; i--) {
+    while (1) {
+      f = e->forward[i];
+      if (f == NULL || f->root >= r) break;
+      e = f;
+    }
+    update[i] = e;
+  }
+  e = e->forward[0];
+  /* If already present, don't do anything */
+  if (e != NULL && e->root == r) return;
+  /* Insert additional element, updating list level if necessary */
+  new_level = random_level();
+  if (new_level > rootlist->level) {
+    for (i = rootlist->level + 1; i <= new_level; i++)
+      update[i] = (struct global_root *) rootlist;
+    rootlist->level = new_level;
+  }
+  e = caml_stat_alloc(sizeof(struct global_root) +
+                      new_level * sizeof(struct global_root *));
+  e->root = r;
+  for (i = 0; i <= new_level; i++) {
+    e->forward[i] = update[i]->forward[i];
+    update[i]->forward[i] = e;
+  }
+}
+
+/* Deletion in a global root list */
+
+static void caml_delete_global_root(struct global_root_list * rootlist,
+                                    value * r)
+{
+  struct global_root * update[NUM_LEVELS];
+  struct global_root * e, * f;
+  int i;
+
+  CAMLassert(0 <= rootlist->level && rootlist->level < NUM_LEVELS);
+
+  /* Init "cursor" to list head */
+  e = (struct global_root *) rootlist;
+  /* Find element in list */
+  for (i = rootlist->level; i >= 0; i--) {
+    while (1) {
+      f = e->forward[i];
+      if (f == NULL || f->root >= r) break;
+      e = f;
+    }
+    update[i] = e;
+  }
+  e = e->forward[0];
+  /* If not found, nothing to do */
+  if (e == NULL || e->root != r) return;
+  /* Rebuild list without node */
+  for (i = 0; i <= rootlist->level; i++) {
+    if (update[i]->forward[i] == e)
+      update[i]->forward[i] = e->forward[i];
+  }
+  /* Reclaim list element */
+  caml_stat_free(e);
+  /* Down-correct list level */
+  while (rootlist->level > 0 &&
+         rootlist->forward[rootlist->level] == NULL)
+    rootlist->level--;
+}
+
+/* Iterate over a global root list */
+
+static void caml_iterate_global_roots(scanning_action f,
+                                      struct global_root_list * rootlist)
+{
+  struct global_root * gr;
+
+  for (gr = rootlist->forward[0]; gr != NULL; gr = gr->forward[0]) {
+    f(*(gr->root), gr->root);
+  }
+}
+
+/* Empty a global root list */
+
+static void caml_empty_global_roots(struct global_root_list * rootlist)
+{
+  struct global_root * gr, * next;
+  int i;
+
+  CAMLassert(0 <= rootlist->level && rootlist->level < NUM_LEVELS);
+
+  for (gr = rootlist->forward[0]; gr != NULL; /**/) {
+    next = gr->forward[0];
+    caml_stat_free(gr);
+    gr = next;
+  }
+  for (i = 0; i <= rootlist->level; i++) rootlist->forward[i] = NULL;
+  rootlist->level = 0;
+}
+
+/* The three global root lists */
+
+struct global_root_list caml_global_roots = { NULL, { NULL, }, 0 };
+                  /* mutable roots, don't know whether old or young */
+struct global_root_list caml_global_roots_young = { NULL, { NULL, }, 0 };
+                 /* generational roots pointing to minor or major heap */
+struct global_root_list caml_global_roots_old = { NULL, { NULL, }, 0 };
+                  /* generational roots pointing to major heap */
+
+/* The invariant of the generational roots is the following:
+   - If the global root contains a pointer to the minor heap, then the root is
+     in [caml_global_roots_young];
+   - If the global root contains a pointer to the major heap, then the root is
+     in [caml_global_roots_old] or in [caml_global_roots_young];
+   - Otherwise (the root contains a pointer outside of the heap or an integer),
+     then neither [caml_global_roots_young] nor [caml_global_roots_old] contain
+     it.
+ */
+
+/* Register a global C root of the mutable kind */
+
+CAMLexport void caml_register_global_root(value *r)
+{
+  CAMLassert (((intnat) r & 3) == 0);  /* compact.c demands this (for now) */
+  caml_insert_global_root(&caml_global_roots, r);
+}
+
+/* Un-register a global C root of the mutable kind */
+
+CAMLexport void caml_remove_global_root(value *r)
+{
+  caml_delete_global_root(&caml_global_roots, r);
+}
+
+enum gc_root_class {
+  YOUNG,
+  OLD,
+  UNTRACKED
+};
+
+static enum gc_root_class classify_gc_root(value v)
+{
+  if(!Is_block(v)) return UNTRACKED;
+  if(Is_young(v)) return YOUNG;
+  if(Is_in_heap(v)) return OLD;
+  return UNTRACKED;
+}
+
+/* Register a global C root of the generational kind */
+
+CAMLexport void caml_register_generational_global_root(value *r)
+{
+  CAMLassert (((intnat) r & 3) == 0);  /* compact.c demands this (for now) */
+
+  switch(classify_gc_root(*r)) {
+    case YOUNG:
+      caml_insert_global_root(&caml_global_roots_young, r);
+      break;
+    case OLD:
+      caml_insert_global_root(&caml_global_roots_old, r);
+      break;
+    case UNTRACKED: break;
+  }
+}
+
+/* Un-register a global C root of the generational kind */
+
+CAMLexport void caml_remove_generational_global_root(value *r)
+{
+  switch(classify_gc_root(*r)) {
+    case OLD:
+      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. */
+    case YOUNG:
+      caml_delete_global_root(&caml_global_roots_young, r);
+      break;
+    case UNTRACKED: break;
+  }
+}
+
+/* Modify the value of a global C root of the generational kind */
+
+CAMLexport void caml_modify_generational_global_root(value *r, value newval)
+{
+  enum gc_root_class c;
+  /* See PRs #4704, #607 and #8656 */
+  switch(classify_gc_root(newval)) {
+    case YOUNG:
+      c = classify_gc_root(*r);
+      if(c == OLD)
+        caml_delete_global_root(&caml_global_roots_old, r);
+      if(c != YOUNG)
+        caml_insert_global_root(&caml_global_roots_young, r);
+      break;
+
+    case OLD:
+      /* If the old class is YOUNG, then we do not need to do
+         anything: It is OK to have a root in roots_young that
+         suddenly points to the old generation -- the next minor GC
+         will take care of that. */
+      if(classify_gc_root(*r) == UNTRACKED)
+        caml_insert_global_root(&caml_global_roots_old, r);
+      break;
+
+    case UNTRACKED:
+      caml_remove_generational_global_root(r);
+      break;
+  }
+
+  *r = newval;
+}
+
+/* Scan all global roots */
+
+void caml_scan_global_roots(scanning_action f)
+{
+  caml_iterate_global_roots(f, &caml_global_roots);
+  caml_iterate_global_roots(f, &caml_global_roots_young);
+  caml_iterate_global_roots(f, &caml_global_roots_old);
+}
+
+/* Scan global roots for a minor collection */
+
+void caml_scan_global_young_roots(scanning_action f)
+{
+  struct global_root * gr;
+
+  caml_iterate_global_roots(f, &caml_global_roots);
+  caml_iterate_global_roots(f, &caml_global_roots_young);
+  /* Move young roots to old roots */
+  for (gr = caml_global_roots_young.forward[0];
+       gr != NULL; gr = gr->forward[0]) {
+    caml_insert_global_root(&caml_global_roots_old, gr->root);
+  }
+  caml_empty_global_roots(&caml_global_roots_young);
+}
diff --git a/runtime/hash.c b/runtime/hash.c
new file mode 100644
index 00000000..f7d0d222
--- /dev/null
+++ b/runtime/hash.c
@@ -0,0 +1,419 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* The generic hashing primitive */
+
+/* The interface of this file is in "mlvalues.h" (for [caml_hash_variant])
+   and in "hash.h" (for the other exported functions). */
+
+#include "caml/mlvalues.h"
+#include "caml/custom.h"
+#include "caml/memory.h"
+#include "caml/hash.h"
+
+/* The new implementation, based on MurmurHash 3,
+     http://code.google.com/p/smhasher/  */
+
+#define ROTL32(x,n) ((x) << n | (x) >> (32-n))
+
+#define MIX(h,d) \
+  d *= 0xcc9e2d51; \
+  d = ROTL32(d, 15); \
+  d *= 0x1b873593; \
+  h ^= d; \
+  h = ROTL32(h, 13); \
+  h = h * 5 + 0xe6546b64;
+
+#define FINAL_MIX(h) \
+  h ^= h >> 16; \
+  h *= 0x85ebca6b; \
+  h ^= h >> 13; \
+  h *= 0xc2b2ae35; \
+  h ^= h >> 16;
+
+CAMLexport uint32_t caml_hash_mix_uint32(uint32_t h, uint32_t d)
+{
+  MIX(h, d);
+  return h;
+}
+
+/* Mix a platform-native integer. */
+
+CAMLexport uint32_t caml_hash_mix_intnat(uint32_t h, intnat d)
+{
+  uint32_t n;
+#ifdef ARCH_SIXTYFOUR
+  /* Mix the low 32 bits and the high 32 bits, in a way that preserves
+     32/64 compatibility: we want n = (uint32_t) d
+     if d is in the range [-2^31, 2^31-1]. */
+  n = (d >> 32) ^ (d >> 63) ^ d;
+  /* If 0 <= d < 2^31:   d >> 32 = 0     d >> 63 = 0
+     If -2^31 <= d < 0:  d >> 32 = -1    d >> 63 = -1
+     In both cases, n = (uint32_t) d.  */
+#else
+  n = d;
+#endif
+  MIX(h, n);
+  return h;
+}
+
+/* Mix a 64-bit integer. */
+
+CAMLexport uint32_t caml_hash_mix_int64(uint32_t h, int64_t d)
+{
+  uint32_t hi = (uint32_t) (d >> 32), lo = (uint32_t) d;
+  MIX(h, lo);
+  MIX(h, hi);
+  return h;
+}
+
+/* Mix a double-precision float.
+   Treats +0.0 and -0.0 identically.
+   Treats all NaNs identically.
+*/
+
+CAMLexport uint32_t caml_hash_mix_double(uint32_t hash, double d)
+{
+  union {
+    double d;
+#if defined(ARCH_BIG_ENDIAN) || (defined(__arm__) && !defined(__ARM_EABI__))
+    struct { uint32_t h; uint32_t l; } i;
+#else
+    struct { uint32_t l; uint32_t h; } i;
+#endif
+  } u;
+  uint32_t h, l;
+  /* Convert to two 32-bit halves */
+  u.d = d;
+  h = u.i.h; l = u.i.l;
+  /* Normalize NaNs */
+  if ((h & 0x7FF00000) == 0x7FF00000 && (l | (h & 0xFFFFF)) != 0) {
+    h = 0x7FF00000;
+    l = 0x00000001;
+  }
+  /* Normalize -0 into +0 */
+  else if (h == 0x80000000 && l == 0) {
+    h = 0;
+  }
+  MIX(hash, l);
+  MIX(hash, h);
+  return hash;
+}
+
+/* Mix a single-precision float.
+   Treats +0.0 and -0.0 identically.
+   Treats all NaNs identically.
+*/
+
+CAMLexport uint32_t caml_hash_mix_float(uint32_t hash, float d)
+{
+  union {
+    float f;
+    uint32_t i;
+  } u;
+  uint32_t n;
+  /* Convert to int32_t */
+  u.f = d;  n = u.i;
+  /* Normalize NaNs */
+  if ((n & 0x7F800000) == 0x7F800000 && (n & 0x007FFFFF) != 0) {
+    n = 0x7F800001;
+  }
+  /* Normalize -0 into +0 */
+  else if (n == 0x80000000) {
+    n = 0;
+  }
+  MIX(hash, n);
+  return hash;
+}
+
+/* Mix an OCaml string */
+
+CAMLexport uint32_t caml_hash_mix_string(uint32_t h, value s)
+{
+  mlsize_t len = caml_string_length(s);
+  mlsize_t i;
+  uint32_t w;
+
+  /* Mix by 32-bit blocks (little-endian) */
+  for (i = 0; i + 4 <= len; i += 4) {
+#ifdef ARCH_BIG_ENDIAN
+    w = Byte_u(s, i)
+        | (Byte_u(s, i+1) << 8)
+        | (Byte_u(s, i+2) << 16)
+        | (Byte_u(s, i+3) << 24);
+#else
+    w = *((uint32_t *) &Byte_u(s, i));
+#endif
+    MIX(h, w);
+  }
+  /* 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 1: w |= Byte_u(s, i);
+          MIX(h, w);
+  default: /*skip*/;     /* len & 3 == 0, no extra bytes, do nothing */
+  }
+  /* Finally, mix in the length.  Ignore the upper 32 bits, generally 0. */
+  h ^= (uint32_t) len;
+  return h;
+}
+
+/* Maximal size of the queue used for breadth-first traversal.  */
+#define HASH_QUEUE_SIZE 256
+/* Maximal number of Forward_tag links followed in one step */
+#define MAX_FORWARD_DEREFERENCE 1000
+
+/* The generic hash function */
+
+CAMLprim value caml_hash(value count, value limit, value seed, value obj)
+{
+  value queue[HASH_QUEUE_SIZE]; /* Queue of values to examine */
+  intnat rd;                    /* Position of first value in queue */
+  intnat wr;                    /* One past position of last value in queue */
+  intnat sz;                    /* Max number of values to put in queue */
+  intnat num;                   /* Max number of meaningful values to see */
+  uint32_t h;                     /* Rolling hash */
+  value v;
+  mlsize_t i, len;
+
+  sz = Long_val(limit);
+  if (sz < 0 || sz > HASH_QUEUE_SIZE) sz = HASH_QUEUE_SIZE;
+  num = Long_val(count);
+  h = Int_val(seed);
+  queue[0] = obj; rd = 0; wr = 1;
+
+  while (rd < wr && num > 0) {
+    v = queue[rd++];
+  again:
+    if (Is_long(v)) {
+      h = caml_hash_mix_intnat(h, v);
+      num--;
+    }
+    else if (Is_in_value_area(v)) {
+      switch (Tag_val(v)) {
+      case String_tag:
+        h = caml_hash_mix_string(h, v);
+        num--;
+        break;
+      case Double_tag:
+        h = caml_hash_mix_double(h, Double_val(v));
+        num--;
+        break;
+      case Double_array_tag:
+        for (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;
+        }
+        break;
+      case Abstract_tag:
+        /* Block contents unknown.  Do nothing. */
+        break;
+      case Infix_tag:
+        /* Mix in the offset to distinguish different functions from
+           the same mutually-recursive definition */
+        h = caml_hash_mix_uint32(h, Infix_offset_val(v));
+        v = v - Infix_offset_val(v);
+        goto again;
+      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--) {
+          v = Forward_val(v);
+          if (Is_long(v) || !Is_in_value_area(v) || Tag_val(v) != Forward_tag)
+            goto again;
+        }
+        /* Give up on this object and move to the next */
+        break;
+      case Object_tag:
+        h = caml_hash_mix_intnat(h, Oid_val(v));
+        num--;
+        break;
+      case Custom_tag:
+        /* If no hashing function provided, do nothing. */
+        /* Only use low 32 bits of custom hash, for 32/64 compatibility */
+        if (Custom_ops_val(v)->hash != NULL) {
+          uint32_t n = (uint32_t) Custom_ops_val(v)->hash(v);
+          h = caml_hash_mix_uint32(h, n);
+          num--;
+        }
+        break;
+      default:
+        /* Mix in the tag and size, but do not count this towards [num] */
+        h = caml_hash_mix_uint32(h, Whitehd_hd(Hd_val(v)));
+        /* Copy fields into queue, not exceeding the total size [sz] */
+        for (i = 0, len = Wosize_val(v); i < len; i++) {
+          if (wr >= sz) break;
+          queue[wr++] = Field(v, i);
+        }
+        break;
+      }
+    } else {
+      /* v is a pointer outside the heap, probably a code pointer.
+         Shall we count it?  Let's say yes by compatibility with old code. */
+      h = caml_hash_mix_intnat(h, v);
+      num--;
+    }
+  }
+  /* Final mixing of bits */
+  FINAL_MIX(h);
+  /* Fold result to the range [0, 2^30-1] so that it is a nonnegative
+     OCaml integer both on 32 and 64-bit platforms. */
+  return Val_int(h & 0x3FFFFFFFU);
+}
+
+/* The old implementation */
+
+struct hash_state {
+  uintnat accu;
+  intnat univ_limit, univ_count;
+};
+
+static void hash_aux(struct hash_state*, value obj);
+
+CAMLprim value caml_hash_univ_param(value count, value limit, value obj)
+{
+  struct hash_state h;
+  h.univ_limit = Long_val(limit);
+  h.univ_count = Long_val(count);
+  h.accu = 0;
+  hash_aux(&h, obj);
+  return Val_long(h.accu & 0x3FFFFFFF);
+  /* The & has two purposes: ensure that the return value is positive
+     and give the same result on 32 bit and 64 bit architectures. */
+}
+
+#define Alpha 65599
+#define Beta 19
+#define Combine(new)  (h->accu = h->accu * Alpha + (new))
+#define Combine_small(new) (h->accu = h->accu * Beta + (new))
+
+static void hash_aux(struct hash_state* h, value obj)
+{
+  unsigned char * p;
+  mlsize_t i, j;
+  tag_t tag;
+
+  h->univ_limit--;
+  if (h->univ_count < 0 || h->univ_limit < 0) return;
+
+ again:
+  if (Is_long(obj)) {
+    h->univ_count--;
+    Combine(Long_val(obj));
+    return;
+  }
+
+  /* Pointers into the heap are well-structured blocks. So are atoms.
+     We can inspect the block contents. */
+
+  CAMLassert (Is_block (obj));
+  if (Is_in_value_area(obj)) {
+    tag = Tag_val(obj);
+    switch (tag) {
+    case String_tag:
+      h->univ_count--;
+      i = caml_string_length(obj);
+      for (p = &Byte_u(obj, 0); i > 0; i--, p++)
+        Combine_small(*p);
+      break;
+    case Double_tag:
+      /* For doubles, we inspect their binary representation, LSB first.
+         The results are consistent among all platforms with IEEE floats. */
+      h->univ_count--;
+#ifdef ARCH_BIG_ENDIAN
+      for (p = &Byte_u(obj, sizeof(double) - 1), i = sizeof(double);
+           i > 0;
+           p--, i--)
+#else
+      for (p = &Byte_u(obj, 0), i = sizeof(double);
+           i > 0;
+           p++, i--)
+#endif
+        Combine_small(*p);
+      break;
+    case Double_array_tag:
+      h->univ_count--;
+      for (j = 0; j < Bosize_val(obj); j += sizeof(double)) {
+#ifdef ARCH_BIG_ENDIAN
+      for (p = &Byte_u(obj, j + sizeof(double) - 1), i = sizeof(double);
+           i > 0;
+           p--, i--)
+#else
+      for (p = &Byte_u(obj, j), i = sizeof(double);
+           i > 0;
+           p++, i--)
+#endif
+        Combine_small(*p);
+      }
+      break;
+    case Abstract_tag:
+      /* We don't know anything about the contents of the block.
+         Better do nothing. */
+      break;
+    case Infix_tag:
+      hash_aux(h, obj - Infix_offset_val(obj));
+      break;
+    case Forward_tag:
+      obj = Forward_val (obj);
+      goto again;
+    case Object_tag:
+      h->univ_count--;
+      Combine(Oid_val(obj));
+      break;
+    case Custom_tag:
+      /* If no hashing function provided, do nothing */
+      if (Custom_ops_val(obj)->hash != NULL) {
+        h->univ_count--;
+        Combine(Custom_ops_val(obj)->hash(obj));
+      }
+      break;
+    default:
+      h->univ_count--;
+      Combine_small(tag);
+      i = Wosize_val(obj);
+      while (i != 0) {
+        i--;
+        hash_aux(h, Field(obj, i));
+      }
+      break;
+    }
+    return;
+  }
+
+  /* Otherwise, obj is a pointer outside the heap, to an object with
+     a priori unknown structure. Use its physical address as hash key. */
+  Combine((intnat) obj);
+}
+
+/* Hashing variant tags */
+
+CAMLexport value caml_hash_variant(char const * tag)
+{
+  value accu;
+  /* Same hashing algorithm as in ../typing/btype.ml, function hash_variant */
+  for (accu = Val_int(0); *tag != 0; tag++)
+    accu = Val_int(223 * Int_val(accu) + *((unsigned char *) tag));
+#ifdef ARCH_SIXTYFOUR
+  accu = accu & Val_long(0x7FFFFFFFL);
+#endif
+  /* Force sign extension of bit 31 for compatibility between 32 and 64-bit
+     platforms */
+  return (int32_t) accu;
+}
diff --git a/runtime/i386.S b/runtime/i386.S
new file mode 100644
index 00000000..e3b8cc2e
--- /dev/null
+++ b/runtime/i386.S
@@ -0,0 +1,446 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Asm part of the runtime system, Intel 386 processor */
+/* Must be preprocessed by cpp */
+
+#include "caml/m.h"
+
+/* Linux/BSD with ELF binaries and Solaris do not prefix identifiers with _.
+   Linux/BSD with a.out binaries and NextStep do. */
+
+#if (defined(SYS_solaris) && !defined(__GNUC__))
+#define CONCAT(a,b) a/**/b
+#else
+#define CONCAT(a,b) a##b
+#endif
+
+#if defined(SYS_linux_elf) || defined(SYS_bsd_elf) \
+ || defined(SYS_solaris) || defined(SYS_beos) || defined(SYS_gnu)
+#define G(x) x
+#define LBL(x) CONCAT(.L,x)
+#else
+#define G(x) CONCAT(_,x)
+#define LBL(x) CONCAT(L,x)
+#endif
+
+#if defined(SYS_linux_elf) || defined(SYS_bsd_elf) \
+ || defined(SYS_solaris) || defined(SYS_beos) || defined(SYS_cygwin) \
+ || defined(SYS_mingw) || defined(SYS_gnu)
+#define FUNCTION_ALIGN 4
+#else
+#define FUNCTION_ALIGN 2
+#endif
+
+#if defined(FUNCTION_SECTIONS)
+#if defined(SYS_macosx) || defined(SYS_mingw) || defined(SYS_cygwin)
+#define TEXT_SECTION(name)
+#else
+#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
+#endif
+#else
+#define TEXT_SECTION(name)
+#endif
+
+#define FUNCTION(name) \
+        TEXT_SECTION(caml.##name); \
+        .globl G(name); \
+        .align FUNCTION_ALIGN; \
+        G(name):
+
+#if defined(SYS_linux_elf) || defined(SYS_bsd_elf) || defined(SYS_gnu)
+#define ENDFUNCTION(name) \
+        .type name,@function; \
+        .size name, . - name
+#else
+#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
+#else
+#define CFI_STARTPROC
+#define CFI_ENDPROC
+#define CFI_ADJUST(n)
+#endif
+
+#if !defined(SYS_mingw) && !defined(SYS_cygwin)
+#define STACK_PROBE_SIZE 16384
+#endif
+
+        .set    domain_curr_field, 0
+#define DOMAIN_STATE(c_type, name) \
+        .equ    domain_field_caml_##name, domain_curr_field ; \
+        .set    domain_curr_field, domain_curr_field + 1
+#include "../runtime/caml/domain_state.tbl"
+#undef DOMAIN_STATE
+
+#define CAML_STATE(var,reg) 8*domain_field_caml_##var(reg)
+
+/* PR#6038: GCC and Clang seem to require 16-byte alignment nowadays,
+   even if only MacOS X's ABI formally requires it. */
+#define ALIGN_STACK(amount) subl $ amount, %esp ; CFI_ADJUST(amount)
+#define UNDO_ALIGN_STACK(amount) addl $ amount, %esp ; CFI_ADJUST(-amount)
+
+#if defined(FUNCTION_SECTIONS)
+        TEXT_SECTION(caml_hot__code_begin)
+        .globl  G(caml_hot__code_begin)
+G(caml_hot__code_begin):
+
+        TEXT_SECTION(caml_hot__code_end)
+        .globl  G(caml_hot__code_end)
+G(caml_hot__code_end):
+#endif
+
+/* Allocation */
+        .text
+        .globl  G(caml_system__code_begin)
+G(caml_system__code_begin):
+
+FUNCTION(caml_call_gc)
+        CFI_STARTPROC
+LBL(caml_call_gc):
+    /* Record lowest stack address and return address */
+        movl    G(Caml_state), %ebx
+        movl    (%esp), %eax
+        movl    %eax, CAML_STATE(last_return_address, %ebx)
+        leal    4(%esp), %eax
+        movl    %eax, CAML_STATE(bottom_of_stack, %ebx)
+#if !defined(SYS_mingw) && !defined(SYS_cygwin)
+    /* Touch the stack to trigger a recoverable segfault
+       if insufficient space remains */
+        subl    $(STACK_PROBE_SIZE), %esp; CFI_ADJUST(STACK_PROBE_SIZE);
+        movl    %eax, 0(%esp)
+        addl    $(STACK_PROBE_SIZE), %esp; CFI_ADJUST(-STACK_PROBE_SIZE);
+#endif
+    /* Build array of registers, save it into Caml_state->gc_regs */
+        pushl   %ebp; CFI_ADJUST(4)
+        pushl   %edi; CFI_ADJUST(4)
+        pushl   %esi; CFI_ADJUST(4)
+        pushl   %edx; CFI_ADJUST(4)
+        pushl   %ecx; CFI_ADJUST(4)
+        pushl   %ebx; CFI_ADJUST(4)
+        pushl   %eax; CFI_ADJUST(4)
+        movl    %esp, CAML_STATE(gc_regs, %ebx)
+        /* MacOSX note: 16-alignment of stack preserved at this point */
+    /* Call the garbage collector */
+        call    G(caml_garbage_collection)
+    /* Restore all regs used by the code generator */
+        popl    %eax; CFI_ADJUST(-4)
+        popl    %ebx; CFI_ADJUST(-4)
+        popl    %ecx; CFI_ADJUST(-4)
+        popl    %edx; CFI_ADJUST(-4)
+        popl    %esi; CFI_ADJUST(-4)
+        popl    %edi; CFI_ADJUST(-4)
+        popl    %ebp; CFI_ADJUST(-4)
+    /* Return to caller. Returns young_ptr in %eax. */
+        movl    CAML_STATE(young_ptr, %ebx), %eax
+        ret
+        CFI_ENDPROC
+        ENDFUNCTION(caml_call_gc)
+
+FUNCTION(caml_alloc1)
+        CFI_STARTPROC
+        movl    G(Caml_state), %ebx
+        movl    CAML_STATE(young_ptr, %ebx), %eax
+        subl    $8, %eax
+        movl    %eax, CAML_STATE(young_ptr, %ebx)
+        cmpl    CAML_STATE(young_limit, %ebx), %eax
+        jb      LBL(caml_call_gc)
+        ret
+        CFI_ENDPROC
+        ENDFUNCTION(caml_alloc1)
+
+FUNCTION(caml_alloc2)
+        CFI_STARTPROC
+        movl    G(Caml_state), %ebx
+        movl    CAML_STATE(young_ptr, %ebx), %eax
+        subl    $12, %eax
+        movl    %eax, CAML_STATE(young_ptr, %ebx)
+        cmpl    CAML_STATE(young_limit, %ebx), %eax
+        jb      LBL(caml_call_gc)
+        ret
+        CFI_ENDPROC
+        ENDFUNCTION(caml_alloc2)
+
+FUNCTION(caml_alloc3)
+        CFI_STARTPROC
+        movl    G(Caml_state), %ebx
+        movl    CAML_STATE(young_ptr, %ebx), %eax
+        subl    $16, %eax
+        movl    %eax, CAML_STATE(young_ptr, %ebx)
+        cmpl    CAML_STATE(young_limit, %ebx), %eax
+        jb      LBL(caml_call_gc)
+        ret
+        CFI_ENDPROC
+        ENDFUNCTION(caml_alloc3)
+
+FUNCTION(caml_allocN)
+        CFI_STARTPROC
+        movl    G(Caml_state), %ebx
+        /* eax = size - Caml_state->young_ptr */
+        subl    CAML_STATE(young_ptr, %ebx), %eax
+        negl    %eax              /* eax = Caml_state->young_ptr - size */
+        movl    %eax, CAML_STATE(young_ptr, %ebx)
+        cmpl    CAML_STATE(young_limit, %ebx), %eax
+        jb      LBL(caml_call_gc)
+        ret
+        CFI_ENDPROC
+        ENDFUNCTION(caml_allocN)
+
+/* Call a C function from OCaml */
+
+FUNCTION(caml_c_call)
+        CFI_STARTPROC
+    /* Record lowest stack address and return address */
+    /* ecx and edx are destroyed at C call. Use them as temp. */
+        movl    G(Caml_state), %ecx
+        movl    (%esp), %edx
+        movl    %edx, CAML_STATE(last_return_address, %ecx)
+        leal    4(%esp), %edx
+        movl    %edx, CAML_STATE(bottom_of_stack, %ecx)
+#if !defined(SYS_mingw) && !defined(SYS_cygwin)
+    /* Touch the stack to trigger a recoverable segfault
+       if insufficient space remains */
+        subl    $(STACK_PROBE_SIZE), %esp; CFI_ADJUST(STACK_PROBE_SIZE);
+        movl    %eax, 0(%esp)
+        addl    $(STACK_PROBE_SIZE), %esp; CFI_ADJUST(-STACK_PROBE_SIZE);
+#endif
+    /* Call the function (address in %eax) */
+        jmp     *%eax
+        CFI_ENDPROC
+        ENDFUNCTION(caml_c_call)
+
+/* Start the OCaml program */
+
+FUNCTION(caml_start_program)
+        CFI_STARTPROC
+    /* Save callee-save registers */
+        pushl   %ebx; CFI_ADJUST(4)
+        pushl   %esi; CFI_ADJUST(4)
+        pushl   %edi; CFI_ADJUST(4)
+        pushl   %ebp; CFI_ADJUST(4)
+    /* Initial entry point is caml_program */
+        movl    $ G(caml_program), %esi
+    /* Common code for caml_start_program and caml_callback* */
+LBL(106):
+        movl    G(Caml_state), %edi
+    /* Build a callback link */
+        pushl   CAML_STATE(gc_regs, %edi); CFI_ADJUST(4)
+        pushl   CAML_STATE(last_return_address, %edi); CFI_ADJUST(4)
+        pushl   CAML_STATE(bottom_of_stack, %edi); CFI_ADJUST(4)
+        /* Note: 16-alignment preserved on MacOSX at this point */
+    /* Build an exception handler */
+        pushl   $ LBL(108); CFI_ADJUST(4)
+        ALIGN_STACK(8)
+        pushl   CAML_STATE(exception_pointer, %edi); CFI_ADJUST(4)
+        movl    %esp, CAML_STATE(exception_pointer, %edi)
+    /* Call the OCaml code */
+        call    *%esi
+LBL(107):
+        movl    G(Caml_state), %edi
+    /* Pop the exception handler */
+        popl    CAML_STATE(exception_pointer, %edi); CFI_ADJUST(-4)
+        addl    $12, %esp       ; CFI_ADJUST(-12)
+LBL(109):
+        movl    G(Caml_state), %edi /* Reload for LBL(109) entry */
+    /* Pop the callback link, restoring the global variables */
+        popl    CAML_STATE(bottom_of_stack, %edi); CFI_ADJUST(-4)
+        popl    CAML_STATE(last_return_address, %edi); CFI_ADJUST(-4)
+        popl    CAML_STATE(gc_regs, %edi); CFI_ADJUST(-4)
+    /* Restore callee-save registers. */
+        popl    %ebp; CFI_ADJUST(-4)
+        popl    %edi; CFI_ADJUST(-4)
+        popl    %esi; CFI_ADJUST(-4)
+        popl    %ebx; CFI_ADJUST(-4)
+    /* Return to caller. */
+        ret
+LBL(108):
+    /* Exception handler*/
+    /* Mark the bucket as an exception result and return it */
+        orl     $2, %eax
+        jmp     LBL(109)
+        CFI_ENDPROC
+        ENDFUNCTION(caml_start_program)
+
+/* Raise an exception from OCaml */
+
+FUNCTION(caml_raise_exn)
+        CFI_STARTPROC
+        movl    G(Caml_state), %ebx
+        testl   $1, CAML_STATE(backtrace_active, %ebx)
+        jne     LBL(110)
+        movl    CAML_STATE(exception_pointer, %ebx), %esp
+        popl    CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4)
+        UNDO_ALIGN_STACK(8)
+        ret
+LBL(110):
+        movl    %eax, %esi          /* Save exception bucket in esi */
+        movl    CAML_STATE(exception_pointer, %ebx), %edi /* SP of handler */
+        movl    0(%esp), %eax       /* PC of raise */
+        leal    4(%esp), %edx       /* SP of raise */
+        ALIGN_STACK(12)
+        pushl   %edi; CFI_ADJUST(4)         /* arg 4: sp of handler */
+        pushl   %edx; CFI_ADJUST(4)         /* arg 3: sp of raise */
+        pushl   %eax; CFI_ADJUST(4)         /* arg 2: pc of raise */
+        pushl   %esi; CFI_ADJUST(4)         /* arg 1: exception bucket */
+        call    G(caml_stash_backtrace)
+        movl    %esi, %eax              /* Recover exception bucket */
+        movl    %edi, %esp
+        popl    CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4)
+        UNDO_ALIGN_STACK(8)
+        ret
+        CFI_ENDPROC
+        ENDFUNCTION(caml_raise_exn)
+
+/* Raise an exception from C */
+
+FUNCTION(caml_raise_exception)
+        CFI_STARTPROC
+        movl    G(Caml_state), %ebx
+        testl   $1, CAML_STATE(backtrace_active, %ebx)
+        jne     LBL(112)
+        movl    8(%esp), %eax
+        movl    CAML_STATE(exception_pointer, %ebx), %esp
+        popl    CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4)
+        UNDO_ALIGN_STACK(8)
+        ret
+LBL(112):
+        movl    8(%esp), %esi          /* Save exception bucket in esi */
+        ALIGN_STACK(12)
+        /* 4: sp of handler */
+        pushl   CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(4)
+        /* 3: sp of raise */
+        pushl   CAML_STATE(bottom_of_stack, %ebx); CFI_ADJUST(4)
+        /* 2: pc of raise */
+        pushl   CAML_STATE(last_return_address, %ebx); CFI_ADJUST(4)
+        /* 1: exception bucket */
+        pushl   %esi; CFI_ADJUST(4)
+        call    G(caml_stash_backtrace)
+        movl    %esi, %eax              /* Recover exception bucket */
+        movl    CAML_STATE(exception_pointer, %ebx), %esp
+        popl    CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4)
+        UNDO_ALIGN_STACK(8)
+        ret
+        CFI_ENDPROC
+        ENDFUNCTION(caml_raise_exception)
+
+/* Callback from C to OCaml */
+
+FUNCTION(caml_callback_asm)
+        CFI_STARTPROC
+    /* Save callee-save registers */
+        pushl   %ebx; CFI_ADJUST(4)
+        pushl   %esi; CFI_ADJUST(4)
+        pushl   %edi; CFI_ADJUST(4)
+        pushl   %ebp; CFI_ADJUST(4)
+    /* Initial loading of arguments */
+        movl    24(%esp), %ebx   /* arg2: closure */
+        movl    28(%esp), %edi   /* arguments array */
+        movl    0(%edi), %eax    /* arg1: argument */
+        movl    0(%ebx), %esi    /* code pointer */
+        jmp     LBL(106)
+        CFI_ENDPROC
+ENDFUNCTION(caml_callback_asm)
+
+FUNCTION(caml_callback2_asm)
+        CFI_STARTPROC
+    /* Save callee-save registers */
+        pushl   %ebx; CFI_ADJUST(4)
+        pushl   %esi; CFI_ADJUST(4)
+        pushl   %edi; CFI_ADJUST(4)
+        pushl   %ebp; CFI_ADJUST(4)
+    /* Initial loading of arguments */
+        movl    24(%esp), %ecx   /* arg3: closure */
+        movl    28(%esp), %edi   /* arguments array */
+        movl    0(%edi), %eax    /* arg1: first argument */
+        movl    4(%edi), %ebx    /* arg2: second argument */
+        movl    $ G(caml_apply2), %esi   /* code pointer */
+        jmp     LBL(106)
+        CFI_ENDPROC
+ENDFUNCTION(caml_callback2_asm)
+
+FUNCTION(caml_callback3_asm)
+        CFI_STARTPROC
+    /* Save callee-save registers */
+        pushl   %ebx; CFI_ADJUST(4)
+        pushl   %esi; CFI_ADJUST(4)
+        pushl   %edi; CFI_ADJUST(4)
+        pushl   %ebp; CFI_ADJUST(4)
+    /* Initial loading of arguments */
+        movl    24(%esp), %edx   /* arg4: closure */
+        movl    28(%esp), %edi   /* arguments array */
+        movl    0(%edi), %eax    /* arg1: first argument */
+        movl    4(%edi), %ebx    /* arg2: second argument */
+        movl    8(%edi), %ecx    /* arg3: third argument */
+        movl    $ G(caml_apply3), %esi   /* code pointer */
+        jmp     LBL(106)
+        CFI_ENDPROC
+ENDFUNCTION(caml_callback3_asm)
+
+FUNCTION(caml_ml_array_bound_error)
+        CFI_STARTPROC
+    /* Empty the floating-point stack */
+        ffree   %st(0)
+        ffree   %st(1)
+        ffree   %st(2)
+        ffree   %st(3)
+        ffree   %st(4)
+        ffree   %st(5)
+        ffree   %st(6)
+        ffree   %st(7)
+    /* Record lowest stack address and return address */
+        movl    G(Caml_state), %ebx
+        movl    (%esp), %edx
+        movl    %edx, CAML_STATE(last_return_address, %ebx)
+        leal    4(%esp), %edx
+        movl    %edx, CAML_STATE(bottom_of_stack, %ebx)
+    /* Re-align the stack */
+        andl    $-16, %esp
+    /* Branch to [caml_array_bound_error] (never returns) */
+        call    G(caml_array_bound_error)
+        CFI_ENDPROC
+        ENDFUNCTION(caml_ml_array_bound_error)
+
+        .globl  G(caml_system__code_end)
+G(caml_system__code_end):
+
+        .data
+        .globl  G(caml_system__frametable)
+G(caml_system__frametable):
+        .long   1               /* one descriptor */
+        .long   LBL(107)        /* return address into callback */
+#ifndef SYS_solaris
+        .word   -1              /* negative frame size => use callback link */
+        .word   0               /* no roots here */
+#else
+        .value  -1              /* negative frame size => use callback link */
+        .value  0               /* no roots here */
+#endif
+
+        .globl  G(caml_extra_params)
+G(caml_extra_params):
+#ifndef SYS_solaris
+        .space  64
+#else
+        .zero   64
+#endif
+
+#if defined(SYS_linux_elf)
+    /* Mark stack as non-executable, PR#4564 */
+        .section .note.GNU-stack,"",%progbits
+#endif
diff --git a/runtime/i386nt.asm b/runtime/i386nt.asm
new file mode 100644
index 00000000..548aa9dc
--- /dev/null
+++ b/runtime/i386nt.asm
@@ -0,0 +1,307 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 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.          *
+;*                                                                        *
+;**************************************************************************
+
+; Asm part of the runtime system, Intel 386 processor, Intel syntax
+
+        .386
+        .MODEL FLAT
+
+        EXTERN  _caml_garbage_collection: PROC
+        EXTERN  _caml_apply2: PROC
+        EXTERN  _caml_apply3: PROC
+        EXTERN  _caml_program: PROC
+        EXTERN  _caml_array_bound_error: PROC
+        EXTERN  _caml_stash_backtrace: PROC
+        EXTERN  _Caml_state: DWORD
+
+; Allocation
+
+        .CODE
+        PUBLIC  _caml_call_gc
+        PUBLIC  _caml_alloc1
+        PUBLIC  _caml_alloc2
+        PUBLIC  _caml_alloc3
+        PUBLIC  _caml_allocN
+
+INCLUDE domain_state32.inc
+
+_caml_call_gc:
+    ; Record lowest stack address and return address
+        mov     ebx, _Caml_state
+        mov     eax, [esp]
+        Store_last_return_address ebx, eax
+        lea     eax, [esp+4]
+        Store_bottom_of_stack ebx, eax
+    ; Save all regs used by the code generator
+        push    ebp
+        push    edi
+        push    esi
+        push    edx
+        push    ecx
+        push    ebx
+        push    eax
+        Store_gc_regs ebx, esp
+    ; Call the garbage collector
+        call    _caml_garbage_collection
+    ; Restore all regs used by the code generator
+        pop     eax
+        pop     ebx
+        pop     ecx
+        pop     edx
+        pop     esi
+        pop     edi
+        pop     ebp
+    ; Return to caller. Returns young_ptr in eax
+        Load_young_ptr ebx, eax
+        ret
+
+        ALIGN  4
+_caml_alloc1:
+        mov     ebx, _Caml_state
+        Load_young_ptr ebx, eax
+        sub     eax, 8
+        Store_young_ptr ebx, eax
+        Cmp_young_limit ebx, eax
+        jb      _caml_call_gc
+        ret
+
+        ALIGN  4
+_caml_alloc2:
+        mov     ebx, _Caml_state
+        Load_young_ptr ebx, eax
+        sub     eax, 12
+        Store_young_ptr ebx, eax
+        Cmp_young_limit ebx, eax
+        jb      _caml_call_gc
+        ret
+
+        ALIGN  4
+_caml_alloc3:
+        mov     ebx, _Caml_state
+        Load_young_ptr ebx, eax
+        sub     eax, 16
+        Store_young_ptr ebx, eax
+        Cmp_young_limit ebx, eax
+        jb      _caml_call_gc
+        ret
+
+        ALIGN  4
+_caml_allocN:
+        mov     ebx, _Caml_state
+        Sub_young_ptr ebx, eax ; eax = size - young_ptr
+        neg     eax            ; eax = young_ptr - size
+        Store_young_ptr ebx, eax
+        Cmp_young_limit ebx, eax
+        jb      _caml_call_gc
+        ret
+
+; Call a C function from OCaml
+
+        PUBLIC  _caml_c_call
+        ALIGN  4
+_caml_c_call:
+    ; Record lowest stack address and return address
+    ; ecx and edx are destroyed at C call. Use them as temp.
+        mov     ecx, _Caml_state
+        mov     edx, [esp]
+        Store_last_return_address ecx, edx
+        lea     edx, [esp+4]
+        Store_bottom_of_stack ecx, edx
+    ; Call the function (address in %eax)
+        jmp     eax
+
+; Start the OCaml program
+
+        PUBLIC  _caml_start_program
+        ALIGN  4
+_caml_start_program:
+    ; Save callee-save registers
+        push    ebx
+        push    esi
+        push    edi
+        push    ebp
+    ; Initial code pointer is caml_program
+        mov     esi, offset _caml_program
+
+; Code shared between caml_start_program and callback*
+
+L106:
+        mov     edi, _Caml_state
+    ; Build a callback link
+        Push_gc_regs edi
+        Push_last_return_address edi
+        Push_bottom_of_stack edi
+    ; Build an exception handler
+        push    L108
+        Push_exception_pointer edi
+        Store_exception_pointer edi, esp
+    ; Call the OCaml code
+        call    esi
+L107:
+        mov     edi, _Caml_state
+    ; Pop the exception handler
+        Pop_exception_pointer edi
+        add     esp, 4
+L109:
+        mov     edi, _Caml_state
+    ; Pop the callback link, restoring the global variables
+    ; used by caml_c_call
+        Pop_bottom_of_stack edi
+        Pop_last_return_address edi
+        Pop_gc_regs edi
+    ; Restore callee-save registers.
+        pop     ebp
+        pop     edi
+        pop     esi
+        pop     ebx
+    ; Return to caller.
+        ret
+L108:
+    ; Exception handler
+    ; Mark the bucket as an exception result and return it
+        or      eax, 2
+        jmp     L109
+
+; Raise an exception for OCaml
+
+        PUBLIC  _caml_raise_exn
+        ALIGN   4
+_caml_raise_exn:
+        mov     ebx, _Caml_state
+        Load_backtrace_active ebx, ecx
+        test    ecx, 1
+        jne     L110
+        Load_exception_pointer ebx, esp
+        Pop_exception_pointer ebx
+        ret
+L110:
+        mov     esi, eax                ; Save exception bucket in esi
+        Load_exception_pointer ebx, edi ; SP of handler
+        mov     eax, [esp]              ; PC of raise
+        lea     edx, [esp+4]            ; SP of raise
+        push    edi                     ; arg 4: SP of handler
+        push    edx                     ; arg 3: SP of raise
+        push    eax                     ; arg 2: PC of raise
+        push    esi                     ; arg 1: exception bucket
+        call    _caml_stash_backtrace
+        mov     eax, esi                ; recover exception bucket
+        mov     esp, edi                ; cut the stack
+        Pop_exception_pointer ebx
+        ret
+
+; Raise an exception from C
+
+        PUBLIC  _caml_raise_exception
+        ALIGN  4
+_caml_raise_exception:
+        mov     ebx, _Caml_state
+        Load_backtrace_active ebx, ecx
+        test    ecx, 1
+        jne     L112
+        mov     eax, [esp+8]
+        Load_exception_pointer ebx, esp
+        Pop_exception_pointer ebx
+        ret
+L112:
+        mov     esi, [esp+8]            ; Save exception bucket in esi
+        Push_exception_pointer ebx      ; arg 4: SP of handler
+        Push_bottom_of_stack ebx        ; arg 3: SP of raise
+        Push_last_return_address ebx    ; arg 2: PC of raise
+        push    esi                     ; arg 1: exception bucket
+        call    _caml_stash_backtrace
+        mov     eax, esi                ; recover exception bucket
+        Load_exception_pointer ebx, esp ; cut the stack
+        Pop_exception_pointer ebx
+        ret
+
+; Callback from C to OCaml
+
+        PUBLIC  _caml_callback_asm
+        ALIGN  4
+_caml_callback_asm:
+    ; Save callee-save registers
+        push    ebx
+        push    esi
+        push    edi
+        push    ebp
+    ; Initial loading of arguments
+        mov     ebx, [esp+24]   ; arg2: closure
+        mov     edi, [esp+28]   ; arguments array
+        mov     eax, [edi]      ; arg1: argument
+        mov     esi, [ebx]      ; code pointer
+        jmp     L106
+
+        PUBLIC  _caml_callback2_asm
+        ALIGN  4
+_caml_callback2_asm:
+    ; Save callee-save registers
+        push    ebx
+        push    esi
+        push    edi
+        push    ebp
+    ; Initial loading of arguments
+        mov     ecx, [esp+24]   ; arg3: closure
+        mov     edi, [esp+28]   ; arguments array
+        mov     eax, [edi]      ; arg1: first argument
+        mov     ebx, [edi+4]    ; arg2: second argument
+        mov     esi, offset _caml_apply2   ; code pointer
+        jmp     L106
+
+        PUBLIC  _caml_callback3_asm
+        ALIGN   4
+_caml_callback3_asm:
+    ; Save callee-save registers
+        push    ebx
+        push    esi
+        push    edi
+        push    ebp
+    ; Initial loading of arguments
+        mov     edx, [esp+24]   ; arg4: closure
+        mov     edi, [esp+28]   ; arguments array
+        mov     eax, [edi]      ; arg1: first argument
+        mov     ebx, [edi+4]    ; arg2: second argument
+        mov     ecx, [edi+8]    ; arg3: third argument
+        mov     esi, offset _caml_apply3   ; code pointer
+        jmp     L106
+
+        PUBLIC  _caml_ml_array_bound_error
+        ALIGN   4
+_caml_ml_array_bound_error:
+    ; Empty the floating-point stack
+        ffree   st(0)
+        ffree   st(1)
+        ffree   st(2)
+        ffree   st(3)
+        ffree   st(4)
+        ffree   st(5)
+        ffree   st(6)
+        ffree   st(7)
+    ; Branch to caml_array_bound_error
+        mov     eax, offset _caml_array_bound_error
+        jmp     _caml_c_call
+
+        .DATA
+        PUBLIC  _caml_system__frametable
+_caml_system__frametable LABEL DWORD
+        DWORD   1               ; one descriptor
+        DWORD   L107            ; return address into callback
+        WORD    -1              ; negative frame size => use callback link
+        WORD    0               ; no roots here
+
+        PUBLIC  _caml_extra_params
+_caml_extra_params LABEL DWORD
+        BYTE    64 DUP (?)
+
+        END
diff --git a/runtime/instrtrace.c b/runtime/instrtrace.c
new file mode 100644
index 00000000..3e5cbb56
--- /dev/null
+++ b/runtime/instrtrace.c
@@ -0,0 +1,271 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* Trace the instructions executed */
+
+#ifdef DEBUG
+
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+
+#include "caml/instrtrace.h"
+#include "caml/instruct.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/opnames.h"
+#include "caml/prims.h"
+#include "caml/stacks.h"
+#include "caml/startup_aux.h"
+
+extern code_t caml_start_code;
+
+intnat caml_icount = 0;
+
+void caml_stop_here () {}
+
+void caml_disasm_instr(pc)
+     code_t pc;
+{
+  int instr = *pc;
+  printf("%6ld  %s", (long) (pc - caml_start_code),
+         instr < 0 || instr > STOP ? "???" : names_of_instructions[instr]);
+  pc++;
+  switch(instr) {
+    /* Instructions with one integer operand */
+  case PUSHACC: case ACC: case POP: case ASSIGN:
+  case PUSHENVACC: case ENVACC: case PUSH_RETADDR: case APPLY:
+  case APPTERM1: case APPTERM2: case APPTERM3: case RETURN:
+  case GRAB: case PUSHGETGLOBAL: case GETGLOBAL: case SETGLOBAL:
+  case PUSHATOM: case ATOM: case MAKEBLOCK1: case MAKEBLOCK2:
+  case MAKEBLOCK3: case MAKEFLOATBLOCK:
+  case GETFIELD: case SETFIELD: case GETFLOATFIELD: case SETFLOATFIELD:
+  case BRANCH: case BRANCHIF: case BRANCHIFNOT: case PUSHTRAP:
+  case CONSTINT: case PUSHCONSTINT: case OFFSETINT: case OFFSETREF:
+  case OFFSETCLOSURE: case PUSHOFFSETCLOSURE:
+    printf(" %d\n", pc[0]); break;
+    /* Instructions with two operands */
+  case APPTERM: case CLOSURE: case CLOSUREREC: case PUSHGETGLOBALFIELD:
+  case GETGLOBALFIELD: case MAKEBLOCK:
+  case BEQ: case BNEQ: case BLTINT: case BLEINT: case BGTINT: case BGEINT:
+  case BULTINT: case BUGEINT:
+    printf(" %d, %d\n", pc[0], pc[1]); break;
+    /* Instructions with a C primitive as operand */
+  case C_CALLN:
+    printf(" %d,", pc[0]); pc++;
+    /* fallthrough */
+  case C_CALL1: case C_CALL2: case C_CALL3: case C_CALL4: case C_CALL5:
+    if (pc[0] < 0 || pc[0] >= caml_prim_name_table.size)
+      printf(" unknown primitive %d\n", pc[0]);
+    else
+      printf(" %s\n", (char *) caml_prim_name_table.contents[pc[0]]);
+    break;
+  default:
+    printf("\n");
+  }
+  fflush (stdout);
+}
+
+char * caml_instr_string (code_t pc)
+{
+  static char buf[256];
+  char nambuf[128];
+  int instr = *pc;
+  char *nam;
+
+  nam = (instr < 0 || instr > STOP)
+    ? (snprintf (nambuf, sizeof(nambuf), "???%d", instr), nambuf)
+    : names_of_instructions[instr];
+  pc++;
+  switch (instr) {
+    /* Instructions with one integer operand */
+  case PUSHACC:
+  case ACC:
+  case POP:
+  case ASSIGN:
+  case PUSHENVACC:
+  case ENVACC:
+  case PUSH_RETADDR:
+  case APPLY:
+  case APPTERM1:
+  case APPTERM2:
+  case APPTERM3:
+  case RETURN:
+  case GRAB:
+  case PUSHGETGLOBAL:
+  case GETGLOBAL:
+  case SETGLOBAL:
+  case PUSHATOM:
+  case ATOM:
+  case MAKEBLOCK1:
+  case MAKEBLOCK2:
+  case MAKEBLOCK3:
+  case MAKEFLOATBLOCK:
+  case GETFIELD:
+  case SETFIELD:
+  case GETFLOATFIELD:
+  case SETFLOATFIELD:
+  case BRANCH:
+  case BRANCHIF:
+  case BRANCHIFNOT:
+  case PUSHTRAP:
+  case CONSTINT:
+  case PUSHCONSTINT:
+  case OFFSETINT:
+  case OFFSETREF:
+  case OFFSETCLOSURE:
+  case PUSHOFFSETCLOSURE:
+    snprintf(buf, sizeof(buf), "%s %d", nam, pc[0]);
+    break;
+    /* Instructions with two operands */
+  case APPTERM:
+  case CLOSURE:
+  case CLOSUREREC:
+  case PUSHGETGLOBALFIELD:
+  case GETGLOBALFIELD:
+  case MAKEBLOCK:
+  case BEQ:
+  case BNEQ:
+  case BLTINT:
+  case BLEINT:
+  case BGTINT:
+  case BGEINT:
+  case BULTINT:
+  case BUGEINT:
+    snprintf(buf, sizeof(buf), "%s %d, %d", nam, pc[0], pc[1]);
+    break;
+  case SWITCH:
+    snprintf(buf, sizeof(buf), "SWITCH sz%#lx=%ld::ntag%ld nint%ld",
+            (long) pc[0], (long) pc[0], (unsigned long) pc[0] >> 16,
+            (unsigned long) pc[0] & 0xffff);
+    break;
+    /* Instructions with a C primitive as operand */
+  case C_CALLN:
+    snprintf(buf, sizeof(buf), "%s %d,", nam, pc[0]);
+    pc++;
+    /* fallthrough */
+  case C_CALL1:
+  case C_CALL2:
+  case C_CALL3:
+  case C_CALL4:
+  case C_CALL5:
+    if (pc[0] < 0 || pc[0] >= caml_prim_name_table.size)
+      snprintf(buf, sizeof(buf), "%s unknown primitive %d", nam, pc[0]);
+    else
+      snprintf(buf, sizeof(buf), "%s %s",
+               nam, (char *) caml_prim_name_table.contents[pc[0]]);
+    break;
+  default:
+    snprintf(buf, sizeof(buf), "%s", nam);
+    break;
+  };
+  return buf;
+}
+
+
+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;
+  if (prog && v % sizeof (int) == 0
+           && (code_t) v >= prog
+           && (code_t) v < (code_t) ((char *) prog + proglen))
+    fprintf (f, "=code@%ld", (long) ((code_t) v - prog));
+  else if (Is_long (v))
+    fprintf (f, "=long%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val (v));
+  else if ((void*)v >= (void*)Caml_state->stack_low
+           && (void*)v < (void*)Caml_state->stack_high)
+    fprintf (f, "=stack_%ld",
+             (long) ((intnat*)Caml_state->stack_high - (intnat*)v));
+  else if (Is_block (v)) {
+    int s = Wosize_val (v);
+    int tg = Tag_val (v);
+    int l = 0;
+    switch (tg) {
+    case Closure_tag:
+      fprintf (f, "=closure[s%d,cod%ld]",
+               s, (long) ((code_t) (Code_val (v)) - prog));
+      goto displayfields;
+    case String_tag:
+      l = caml_string_length (v);
+      fprintf (f, "=string[s%dL%d]'", s, l);
+      for (i = 0; i < ((l>0x1f)?0x1f:l) ; i++) {
+        if (isprint ((int) Byte (v, i)))
+          putc (Byte (v, i), f);
+        else
+          putc ('?', f);
+      };
+      fprintf (f, "'");
+      goto displayfields;
+    case Double_tag:
+      fprintf (f, "=float[s%d]=%g", s, Double_val (v));
+      goto displayfields;
+    case Double_array_tag:
+      fprintf (f, "=floatarray[s%d]", s);
+      for (i = 0; i < ((s>0xf)?0xf:s); i++)
+        fprintf (f, " %g", Double_flat_field (v, i));
+      goto displayfields;
+    case Abstract_tag:
+      fprintf (f, "=abstract[s%d]", s);
+      goto displayfields;
+    case Custom_tag:
+      fprintf (f, "=custom[s%d]", s);
+      goto displayfields;
+    default:
+      fprintf (f, "=block<T%d/s%d>", tg, s);
+    displayfields:
+      if (s > 0)
+        fputs ("=(", f);
+      for (i = 0; i < s; i++) {
+        if (i > 20) {
+          fputs ("....", f);
+          break;
+        };
+        if (i > 0)
+          putc (' ', f);
+        fprintf (f, "%#" ARCH_INTNAT_PRINTF_FORMAT "x", Field (v, i));
+      };
+      if (s > 0)
+        putc (')', f);
+    };
+  }
+}
+
+void
+caml_trace_accu_sp_file (value accu, value * sp, code_t prog, asize_t proglen,
+                         FILE * f)
+{
+  int i;
+  value *p;
+  fprintf (f, "accu=");
+  caml_trace_value_file (accu, prog, proglen, f);
+  fprintf (f, "\n sp=%#" ARCH_INTNAT_PRINTF_FORMAT "x @%ld:",
+           (intnat) sp, (long) (Caml_state->stack_high - sp));
+  for (p = sp, i = 0;
+       i < 12 + (1 << caml_trace_level) && p < Caml_state->stack_high;
+       p++, i++) {
+    fprintf (f, "\n[%ld] ", (long) (Caml_state->stack_high - p));
+    caml_trace_value_file (*p, prog, proglen, f);
+  };
+  putc ('\n', f);
+  fflush (f);
+}
+
+#endif /* DEBUG */
diff --git a/runtime/intern.c b/runtime/intern.c
new file mode 100644
index 00000000..5d7d3817
--- /dev/null
+++ b/runtime/intern.c
@@ -0,0 +1,1114 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* Structured input, compact format */
+
+/* The interface of this file is "caml/intext.h" */
+
+#include <string.h>
+#include <stdio.h>
+#include "caml/alloc.h"
+#include "caml/callback.h"
+#include "caml/config.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/gc.h"
+#include "caml/intext.h"
+#include "caml/io.h"
+#include "caml/md5.h"
+#include "caml/memory.h"
+#include "caml/memprof.h"
+#include "caml/mlvalues.h"
+#include "caml/misc.h"
+#include "caml/reverse.h"
+#include "caml/signals.h"
+
+
+static unsigned char * intern_src;
+/* Reading pointer in block holding input data. */
+
+static unsigned char * intern_input = NULL;
+/* Pointer to beginning of block holding input data,
+   if non-NULL this pointer will be freed by the cleanup function. */
+
+static header_t * intern_dest;
+/* Writing pointer in destination block */
+
+static char * intern_extra_block = NULL;
+/* If non-NULL, point to new heap chunk allocated with caml_alloc_for_heap. */
+
+static asize_t obj_counter;
+/* Count how many objects seen so far */
+
+static value * intern_obj_table = NULL;
+/* The pointers to objects already seen */
+
+static color_t intern_color;
+/* Color to assign to newly created headers */
+
+static header_t intern_header;
+/* Original header of the destination block.
+   Meaningful only if intern_extra_block is NULL. */
+
+static value intern_block = 0;
+/* Point to the heap block allocated as destination block.
+   Meaningful only if intern_extra_block is NULL. */
+
+static char * intern_resolve_code_pointer(unsigned char digest[16],
+                                          asize_t offset);
+
+CAMLnoreturn_start
+static void intern_bad_code_pointer(unsigned char digest[16])
+CAMLnoreturn_end;
+
+static void intern_free_stack(void);
+
+Caml_inline unsigned char read8u(void)
+{ return *intern_src++; }
+
+Caml_inline signed char read8s(void)
+{ return *intern_src++; }
+
+Caml_inline uint16_t read16u(void)
+{
+  uint16_t res = (intern_src[0] << 8) + intern_src[1];
+  intern_src += 2;
+  return res;
+}
+
+Caml_inline int16_t read16s(void)
+{
+  int16_t res = (intern_src[0] << 8) + intern_src[1];
+  intern_src += 2;
+  return res;
+}
+
+Caml_inline uint32_t read32u(void)
+{
+  uint32_t res =
+    ((uint32_t)(intern_src[0]) << 24) + (intern_src[1] << 16)
+    + (intern_src[2] << 8) + intern_src[3];
+  intern_src += 4;
+  return res;
+}
+
+Caml_inline int32_t read32s(void)
+{
+  int32_t res =
+    ((uint32_t)(intern_src[0]) << 24) + (intern_src[1] << 16)
+    + (intern_src[2] << 8) + intern_src[3];
+  intern_src += 4;
+  return res;
+}
+
+#ifdef ARCH_SIXTYFOUR
+static uintnat read64u(void)
+{
+  uintnat res =
+    ((uintnat) (intern_src[0]) << 56)
+    + ((uintnat) (intern_src[1]) << 48)
+    + ((uintnat) (intern_src[2]) << 40)
+    + ((uintnat) (intern_src[3]) << 32)
+    + ((uintnat) (intern_src[4]) << 24)
+    + ((uintnat) (intern_src[5]) << 16)
+    + ((uintnat) (intern_src[6]) << 8)
+    + (uintnat) (intern_src[7]);
+  intern_src += 8;
+  return res;
+}
+#endif
+
+Caml_inline void readblock(void * dest, intnat len)
+{
+  memcpy(dest, intern_src, len);
+  intern_src += len;
+}
+
+static void intern_init(void * src, void * input)
+{
+  /* 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 (intern_input == NULL && intern_obj_table == NULL \
+     && intern_extra_block == NULL && intern_block == 0);
+  intern_src = src;
+  intern_input = input;
+}
+
+static void intern_cleanup(void)
+{
+  if (intern_input != NULL) {
+     caml_stat_free(intern_input);
+     intern_input = NULL;
+  }
+  if (intern_obj_table != NULL) {
+    caml_stat_free(intern_obj_table);
+    intern_obj_table = NULL;
+  }
+  if (intern_extra_block != NULL) {
+    /* free newly allocated heap chunk */
+    caml_free_for_heap(intern_extra_block);
+    intern_extra_block = NULL;
+  } else if (intern_block != 0) {
+    /* restore original header for heap block, otherwise GC is confused */
+    Hd_val(intern_block) = intern_header;
+    intern_block = 0;
+  }
+  /* free the recursion stack */
+  intern_free_stack();
+}
+
+static void readfloat(double * dest, unsigned int code)
+{
+  if (sizeof(double) != 8) {
+    intern_cleanup();
+    caml_invalid_argument("input_value: non-standard floats");
+  }
+  readblock((char *) dest, 8);
+  /* Fix up endianness, if needed */
+#if ARCH_FLOAT_ENDIANNESS == 0x76543210
+  /* Host is big-endian; fix up if data read is little-endian */
+  if (code != CODE_DOUBLE_BIG) Reverse_64(dest, dest);
+#elif ARCH_FLOAT_ENDIANNESS == 0x01234567
+  /* Host is little-endian; fix up if data read is big-endian */
+  if (code != CODE_DOUBLE_LITTLE) Reverse_64(dest, dest);
+#else
+  /* Host is neither big nor little; permute as appropriate */
+  if (code == CODE_DOUBLE_LITTLE)
+    Permute_64(dest, ARCH_FLOAT_ENDIANNESS, dest, 0x01234567)
+  else
+    Permute_64(dest, ARCH_FLOAT_ENDIANNESS, dest, 0x76543210);
+#endif
+}
+
+/* [len] is a number of floats */
+static void readfloats(double * dest, mlsize_t len, unsigned int code)
+{
+  mlsize_t i;
+  if (sizeof(double) != 8) {
+    intern_cleanup();
+    caml_invalid_argument("input_value: non-standard floats");
+  }
+  readblock((char *) dest, len * 8);
+  /* Fix up endianness, if needed */
+#if ARCH_FLOAT_ENDIANNESS == 0x76543210
+  /* 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);
+  }
+#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);
+  }
+#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++)
+      Permute_64(dest + i, ARCH_FLOAT_ENDIANNESS, dest + i, 0x01234567);
+  } else {
+    for (i = 0; i < len; i++)
+      Permute_64(dest + i, ARCH_FLOAT_ENDIANNESS, dest + i, 0x76543210);
+  }
+#endif
+}
+
+/* Item on the stack with defined operation */
+struct intern_item {
+  value * dest;
+  intnat arg;
+  enum {
+    OReadItems, /* read arg items and store them in dest[0], dest[1], ... */
+    OFreshOID,  /* generate a fresh OID and store it in *dest */
+    OShift      /* offset *dest by arg */
+  } op;
+};
+
+/* FIXME: This is duplicated in two other places, with the only difference of
+   the type of elements stored in the stack. Possible solution in C would
+   be to instantiate stack these function via. C preprocessor macro.
+ */
+
+#define INTERN_STACK_INIT_SIZE 256
+#define INTERN_STACK_MAX_SIZE (1024*1024*100)
+
+static struct intern_item intern_stack_init[INTERN_STACK_INIT_SIZE];
+
+static struct intern_item * intern_stack = intern_stack_init;
+static struct intern_item * intern_stack_limit = intern_stack_init
+                                                   + INTERN_STACK_INIT_SIZE;
+
+/* Free the recursion stack if needed */
+static void intern_free_stack(void)
+{
+  if (intern_stack != intern_stack_init) {
+    caml_stat_free(intern_stack);
+    /* Reinitialize the globals for next time around */
+    intern_stack = intern_stack_init;
+    intern_stack_limit = intern_stack + INTERN_STACK_INIT_SIZE;
+  }
+}
+
+/* Same, then raise Out_of_memory */
+CAMLnoreturn_start
+static void intern_stack_overflow(void)
+CAMLnoreturn_end;
+
+static void intern_stack_overflow(void)
+{
+  caml_gc_message (0x04, "Stack overflow in un-marshaling value\n");
+  intern_free_stack();
+  caml_raise_out_of_memory();
+}
+
+static struct intern_item * intern_resize_stack(struct intern_item * sp)
+{
+  asize_t newsize = 2 * (intern_stack_limit - intern_stack);
+  asize_t sp_offset = sp - intern_stack;
+  struct intern_item * newstack;
+
+  if (newsize >= INTERN_STACK_MAX_SIZE) intern_stack_overflow();
+  if (intern_stack == intern_stack_init) {
+    newstack = caml_stat_alloc_noexc(sizeof(struct intern_item) * newsize);
+    if (newstack == NULL) intern_stack_overflow();
+    memcpy(newstack, intern_stack_init,
+           sizeof(struct intern_item) * INTERN_STACK_INIT_SIZE);
+  } else {
+    newstack = caml_stat_resize_noexc(intern_stack,
+                                      sizeof(struct intern_item) * newsize);
+    if (newstack == NULL) intern_stack_overflow();
+  }
+  intern_stack = newstack;
+  intern_stack_limit = newstack + newsize;
+  return newstack + sp_offset;
+}
+
+/* Convenience macros for requesting operation on the stack */
+#define PushItem()                                                      \
+  do {                                                                  \
+    sp++;                                                               \
+    if (sp >= intern_stack_limit) sp = intern_resize_stack(sp);         \
+  } while(0)
+
+#define ReadItems(_dest,_n)                                             \
+  do {                                                                  \
+    if (_n > 0) {                                                       \
+      PushItem();                                                       \
+      sp->op = OReadItems;                                              \
+      sp->dest = _dest;                                                 \
+      sp->arg = _n;                                                     \
+    }                                                                   \
+  } while(0)
+
+static void intern_rec(value *dest)
+{
+  unsigned int code;
+  tag_t tag;
+  mlsize_t size, len, ofs_ind;
+  value v;
+  asize_t ofs;
+  header_t header;
+  unsigned char digest[16];
+  struct custom_operations * ops;
+  char * codeptr;
+  struct intern_item * sp;
+
+  sp = intern_stack;
+
+  /* Initially let's try to read the first object from the stream */
+  ReadItems(dest, 1);
+
+  /* The un-marshaler loop, the recursion is unrolled */
+  while(sp != intern_stack) {
+
+  /* Interpret next item on the stack */
+  dest = sp->dest;
+  switch (sp->op) {
+  case OFreshOID:
+    /* Refresh the object ID */
+    /* but do not do it for predefined exception slots */
+    if (Long_val(Field((value)dest, 1)) >= 0)
+      caml_set_oo_id((value)dest);
+    /* Pop item and iterate */
+    sp--;
+    break;
+  case OShift:
+    /* Shift value by an offset */
+    *dest += sp->arg;
+    /* Pop item and iterate */
+    sp--;
+    break;
+  case OReadItems:
+    /* Pop item */
+    sp->dest++;
+    if (--(sp->arg) == 0) sp--;
+    /* Read a value and set v to this value */
+  code = read8u();
+  if (code >= PREFIX_SMALL_INT) {
+    if (code >= PREFIX_SMALL_BLOCK) {
+      /* Small block */
+      tag = code & 0xF;
+      size = (code >> 4) & 0x7;
+    read_block:
+      if (size == 0) {
+        v = Atom(tag);
+      } else {
+        v = Val_hp(intern_dest);
+        if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
+        *intern_dest = Make_header_allocated_here(size, tag, intern_color);
+        intern_dest += 1 + size;
+        /* For objects, we need to freshen the oid */
+        if (tag == Object_tag) {
+          CAMLassert(size >= 2);
+          /* Request to read rest of the elements of the block */
+          ReadItems(&Field(v, 2), size - 2);
+          /* Request freshing OID */
+          PushItem();
+          sp->op = OFreshOID;
+          sp->dest = (value*) v;
+          sp->arg = 1;
+          /* Finally read first two block elements: method table and old OID */
+          ReadItems(&Field(v, 0), 2);
+        } else
+          /* If it's not an object then read the contents of the block */
+          ReadItems(&Field(v, 0), size);
+      }
+    } else {
+      /* Small integer */
+      v = Val_int(code & 0x3F);
+    }
+  } else {
+    if (code >= PREFIX_SMALL_STRING) {
+      /* Small string */
+      len = (code & 0x1F);
+    read_string:
+      size = (len + sizeof(value)) / sizeof(value);
+      v = Val_hp(intern_dest);
+      if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
+      *intern_dest = Make_header_allocated_here(size, String_tag, intern_color);
+      intern_dest += 1 + size;
+      Field(v, size - 1) = 0;
+      ofs_ind = Bsize_wsize(size) - 1;
+      Byte(v, ofs_ind) = ofs_ind - len;
+      readblock((char *)String_val(v), len);
+    } else {
+      switch(code) {
+      case CODE_INT8:
+        v = Val_long(read8s());
+        break;
+      case CODE_INT16:
+        v = Val_long(read16s());
+        break;
+      case CODE_INT32:
+        v = Val_long(read32s());
+        break;
+      case CODE_INT64:
+#ifdef ARCH_SIXTYFOUR
+        v = Val_long((intnat) (read64u()));
+        break;
+#else
+        intern_cleanup();
+        caml_failwith("input_value: integer too large");
+        break;
+#endif
+      case CODE_SHARED8:
+        ofs = read8u();
+      read_shared:
+        CAMLassert (ofs > 0);
+        CAMLassert (ofs <= obj_counter);
+        CAMLassert (intern_obj_table != NULL);
+        v = intern_obj_table[obj_counter - ofs];
+        break;
+      case CODE_SHARED16:
+        ofs = read16u();
+        goto read_shared;
+      case CODE_SHARED32:
+        ofs = read32u();
+        goto read_shared;
+#ifdef ARCH_SIXTYFOUR
+      case CODE_SHARED64:
+        ofs = read64u();
+        goto read_shared;
+#endif
+      case CODE_BLOCK32:
+        header = (header_t) read32u();
+        tag = Tag_hd(header);
+        size = Wosize_hd(header);
+        goto read_block;
+#ifdef ARCH_SIXTYFOUR
+      case CODE_BLOCK64:
+        header = (header_t) read64u();
+        tag = Tag_hd(header);
+        size = Wosize_hd(header);
+        goto read_block;
+#endif
+      case CODE_STRING8:
+        len = read8u();
+        goto read_string;
+      case CODE_STRING32:
+        len = read32u();
+        goto read_string;
+#ifdef ARCH_SIXTYFOUR
+      case CODE_STRING64:
+        len = read64u();
+        goto read_string;
+#endif
+      case CODE_DOUBLE_LITTLE:
+      case CODE_DOUBLE_BIG:
+        v = Val_hp(intern_dest);
+        if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
+        *intern_dest = Make_header_allocated_here(Double_wosize, Double_tag,
+                                                  intern_color);
+        intern_dest += 1 + Double_wosize;
+        readfloat((double *) v, code);
+        break;
+      case CODE_DOUBLE_ARRAY8_LITTLE:
+      case CODE_DOUBLE_ARRAY8_BIG:
+        len = read8u();
+      read_double_array:
+        size = len * Double_wosize;
+        v = Val_hp(intern_dest);
+        if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
+        *intern_dest = Make_header_allocated_here(size, Double_array_tag,
+                                                  intern_color);
+        intern_dest += 1 + size;
+        readfloats((double *) v, len, code);
+        break;
+      case CODE_DOUBLE_ARRAY32_LITTLE:
+      case CODE_DOUBLE_ARRAY32_BIG:
+        len = read32u();
+        goto read_double_array;
+#ifdef ARCH_SIXTYFOUR
+      case CODE_DOUBLE_ARRAY64_LITTLE:
+      case CODE_DOUBLE_ARRAY64_BIG:
+        len = read64u();
+        goto read_double_array;
+#endif
+      case CODE_CODEPOINTER:
+        ofs = read32u();
+        readblock(digest, 16);
+        codeptr = intern_resolve_code_pointer(digest, ofs);
+        if (codeptr != NULL) {
+          v = (value) codeptr;
+        } else {
+          const value * function_placeholder =
+            caml_named_value ("Debugger.function_placeholder");
+          if (function_placeholder != NULL) {
+            v = *function_placeholder;
+          } else {
+            intern_cleanup();
+            intern_bad_code_pointer(digest);
+          }
+        }
+        break;
+      case CODE_INFIXPOINTER:
+        ofs = read32u();
+        /* Read a value to *dest, then offset *dest by ofs */
+        PushItem();
+        sp->dest = dest;
+        sp->op = OShift;
+        sp->arg = ofs;
+        ReadItems(dest, 1);
+        continue;  /* with next iteration of main loop, skipping *dest = v */
+      case CODE_CUSTOM:
+      case CODE_CUSTOM_LEN:
+      case CODE_CUSTOM_FIXED: {
+        ops = caml_find_custom_operations((char *) intern_src);
+        if (ops == NULL) {
+          intern_cleanup();
+          caml_failwith("input_value: unknown custom block identifier");
+        }
+        if (code == CODE_CUSTOM_FIXED && ops->fixed_length == NULL) {
+          intern_cleanup();
+          caml_failwith("input_value: expected a fixed-size custom block");
+        }
+        while (*intern_src++ != 0) /*nothing*/;  /*skip identifier*/
+        if (code == CODE_CUSTOM) {
+          /* deprecated */
+          size = ops->deserialize((void *) (intern_dest + 2));
+        } else {
+          uintnat expected_size;
+#ifdef ARCH_SIXTYFOUR
+          if (code == CODE_CUSTOM_FIXED) {
+            expected_size = ops->fixed_length->bsize_64;
+          } else {
+            intern_src += 4;
+            expected_size = read64u();
+          }
+#else
+          if (code == CODE_CUSTOM_FIXED) {
+            expected_size = ops->fixed_length->bsize_32;
+          } else {
+            expected_size = read32u();
+            intern_src += 8;
+          }
+#endif
+          size = ops->deserialize((void *) (intern_dest + 2));
+          if (size != expected_size) {
+            intern_cleanup();
+            caml_failwith(
+              "input_value: incorrect length of serialized custom block");
+          }
+        }
+        size = 1 + (size + sizeof(value) - 1) / sizeof(value);
+        v = Val_hp(intern_dest);
+        if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
+        *intern_dest = Make_header_allocated_here(size, Custom_tag,
+                                                  intern_color);
+        Custom_ops_val(v) = ops;
+
+        if (ops->finalize != NULL && Is_young(v)) {
+          /* Remember that the block has a finalizer. */
+          add_to_custom_table (Caml_state->custom_table, v, 0, 1);
+        }
+
+        intern_dest += 1 + size;
+        break;
+      }
+      default:
+        intern_cleanup();
+        caml_failwith("input_value: ill-formed message");
+      }
+    }
+  }
+  /* end of case OReadItems */
+  *dest = v;
+  break;
+  default:
+    CAMLassert(0);
+  }
+  }
+  /* We are done. Cleanup the stack and leave the function */
+  intern_free_stack();
+}
+
+static void intern_alloc(mlsize_t whsize, mlsize_t num_objects,
+      int outside_heap)
+{
+  mlsize_t wosize;
+
+  if (whsize == 0) {
+    CAMLassert (intern_extra_block == NULL && intern_block == 0
+         && intern_obj_table == NULL);
+    return;
+  }
+  wosize = Wosize_whsize(whsize);
+  if (outside_heap || wosize > Max_wosize) {
+    /* Round desired size up to next page */
+    asize_t request =
+      ((Bsize_wsize(whsize) + Page_size - 1) >> Page_log) << Page_log;
+    intern_extra_block = caml_alloc_for_heap(request);
+    if (intern_extra_block == NULL) {
+      intern_cleanup();
+      caml_raise_out_of_memory();
+    }
+    intern_color =
+      outside_heap ? Caml_black : caml_allocation_color(intern_extra_block);
+    intern_dest = (header_t *) intern_extra_block;
+    CAMLassert (intern_block == 0);
+  } else {
+    /* this is a specialised version of caml_alloc from alloc.c */
+    if (wosize <= Max_young_wosize){
+      if (wosize == 0){
+        intern_block = Atom (String_tag);
+      }else{
+#define Setup_for_gc
+#define Restore_after_gc
+        Alloc_small_no_track(intern_block, wosize, String_tag);
+#undef Setup_for_gc
+#undef Restore_after_gc
+      }
+    }else{
+      intern_block = caml_alloc_shr_no_track_noexc (wosize, String_tag);
+      /* do not do the urgent_gc check here because it might darken
+         intern_block into gray and break the intern_color assertion below */
+      if (intern_block == 0) {
+        intern_cleanup();
+        caml_raise_out_of_memory();
+      }
+    }
+    intern_header = Hd_val(intern_block);
+    intern_color = Color_hd(intern_header);
+    CAMLassert (intern_color == Caml_white || intern_color == Caml_black);
+    intern_dest = (header_t *) Hp_val(intern_block);
+    CAMLassert (intern_extra_block == NULL);
+  }
+  obj_counter = 0;
+  if (num_objects > 0) {
+    intern_obj_table =
+      (value *) caml_stat_alloc_noexc(num_objects * sizeof(value));
+    if (intern_obj_table == NULL) {
+      intern_cleanup();
+      caml_raise_out_of_memory();
+    }
+  } else
+    CAMLassert(intern_obj_table == NULL);
+}
+
+static header_t* intern_add_to_heap(mlsize_t whsize)
+{
+  header_t* res = NULL;
+  /* Add new heap chunk to heap if needed */
+  if (intern_extra_block != NULL) {
+    /* If heap chunk not filled totally, build free block at end */
+    asize_t request = Chunk_size (intern_extra_block);
+    header_t * end_extra_block =
+      (header_t *) intern_extra_block + Wsize_bsize(request);
+    CAMLassert(intern_block == 0);
+    CAMLassert(intern_dest <= end_extra_block);
+    if (intern_dest < end_extra_block){
+      caml_make_free_blocks ((value *) intern_dest,
+                             end_extra_block - intern_dest, 0, Caml_white);
+    }
+    caml_allocated_words +=
+      Wsize_bsize ((char *) intern_dest - intern_extra_block);
+    if(caml_add_to_heap(intern_extra_block) != 0) {
+      intern_cleanup();
+      caml_raise_out_of_memory();
+    }
+    res = (header_t*)intern_extra_block;
+    intern_extra_block = NULL; // To prevent intern_cleanup freeing it
+  } else if(intern_block != 0) { /* [intern_block = 0] when [whsize = 0]  */
+    res = Hp_val(intern_block);
+    intern_block = 0; // To prevent intern_cleanup rewriting its header
+  }
+  return res;
+}
+
+static value intern_end(value res, mlsize_t whsize)
+{
+  CAMLparam1(res);
+  header_t *block = intern_add_to_heap(whsize);
+  header_t *blockend = intern_dest;
+
+  /* Free everything */
+  intern_cleanup();
+
+  /* Memprof tracking has to be done here, because unmarshalling can
+     still fail until now. */
+  if(block != NULL)
+    caml_memprof_track_interned(block, blockend);
+
+  // Give gc a chance to run, and run memprof callbacks
+  caml_process_pending_actions();
+
+  CAMLreturn(res);
+}
+
+/* Parsing the header */
+
+struct marshal_header {
+  uint32_t magic;
+  int header_len;
+  uintnat data_len;
+  uintnat num_objects;
+  uintnat whsize;
+};
+
+static void caml_parse_header(char * fun_name,
+                              /*out*/ struct marshal_header * h)
+{
+  char errmsg[100];
+
+  h->magic = read32u();
+  switch(h->magic) {
+  case Intext_magic_number_small:
+    h->header_len = 20;
+    h->data_len = read32u();
+    h->num_objects = read32u();
+#ifdef ARCH_SIXTYFOUR
+    read32u();
+    h->whsize = read32u();
+#else
+    h->whsize = read32u();
+    read32u();
+#endif
+    break;
+  case Intext_magic_number_big:
+#ifdef ARCH_SIXTYFOUR
+    h->header_len = 32;
+    read32u();
+    h->data_len = read64u();
+    h->num_objects = read64u();
+    h->whsize = read64u();
+#else
+    errmsg[sizeof(errmsg) - 1] = 0;
+    snprintf(errmsg, sizeof(errmsg) - 1,
+             "%s: object too large to be read back on a 32-bit platform",
+             fun_name);
+    caml_failwith(errmsg);
+#endif
+    break;
+  default:
+    errmsg[sizeof(errmsg) - 1] = 0;
+    snprintf(errmsg, sizeof(errmsg) - 1,
+             "%s: bad object",
+             fun_name);
+    caml_failwith(errmsg);
+  }
+}
+
+/* Reading from a channel */
+
+static value caml_input_val_core(struct channel *chan, int outside_heap)
+{
+  intnat r;
+  char header[32];
+  struct marshal_header h;
+  char * block;
+  value res;
+
+  if (! caml_channel_binary_mode(chan))
+    caml_failwith("input_value: not a binary channel");
+  /* Read and parse the header */
+  r = caml_really_getblock(chan, header, 20);
+  if (r == 0)
+    caml_raise_end_of_file();
+  else if (r < 20)
+    caml_failwith("input_value: truncated object");
+  intern_src = (unsigned char *) header;
+  if (read32u() == Intext_magic_number_big) {
+    /* Finish reading the header */
+    if (caml_really_getblock(chan, header + 20, 32 - 20) < 32 - 20)
+      caml_failwith("input_value: truncated object");
+  }
+  intern_src = (unsigned char *) header;
+  caml_parse_header("input_value", &h);
+  /* Read block from channel */
+  block = caml_stat_alloc(h.data_len);
+  /* During [caml_really_getblock], concurrent [caml_input_val] operations
+     can take place (via signal handlers or context switching in systhreads),
+     and [intern_input] may change.  So, wait until [caml_really_getblock]
+     is over before using [intern_input] and the other global vars. */
+  if (caml_really_getblock(chan, block, h.data_len) < h.data_len) {
+    caml_stat_free(block);
+    caml_failwith("input_value: truncated object");
+  }
+  /* Initialize global state */
+  intern_init(block, block);
+  intern_alloc(h.whsize, h.num_objects, outside_heap);
+  /* Fill it in */
+  intern_rec(&res);
+  if (!outside_heap)
+    return intern_end(res, h.whsize);
+  else {
+    caml_disown_for_heap(intern_extra_block);
+    intern_extra_block = NULL;
+    intern_block = 0;
+    /* Free everything */
+    intern_cleanup();
+    return caml_check_urgent_gc(res);
+  }
+}
+
+value caml_input_val(struct channel* chan)
+{
+  return caml_input_val_core(chan, 0);
+}
+
+CAMLprim value caml_input_value(value vchan)
+{
+  CAMLparam1 (vchan);
+  struct channel * chan = Channel(vchan);
+  CAMLlocal1 (res);
+
+  Lock(chan);
+  res = caml_input_val(chan);
+  Unlock(chan);
+  CAMLreturn (res);
+}
+
+/* Reading from memory-resident blocks */
+
+CAMLprim value caml_input_value_to_outside_heap(value vchan)
+{
+  CAMLparam1 (vchan);
+  struct channel * chan = Channel(vchan);
+  CAMLlocal1 (res);
+
+  Lock(chan);
+  res = caml_input_val_core(chan, 1);
+  Unlock(chan);
+  CAMLreturn (res);
+}
+
+CAMLexport value caml_input_val_from_bytes(value str, intnat ofs)
+{
+  CAMLparam1 (str);
+  CAMLlocal1 (obj);
+  struct marshal_header h;
+
+  /* Initialize global state */
+  intern_init(&Byte_u(str, ofs), NULL);
+  caml_parse_header("input_val_from_string", &h);
+  if (ofs + h.header_len + h.data_len > caml_string_length(str))
+    caml_failwith("input_val_from_string: bad length");
+  /* Allocate result */
+  intern_alloc(h.whsize, h.num_objects, 0);
+  intern_src = &Byte_u(str, ofs + h.header_len); /* If a GC occurred */
+  /* Fill it in */
+  intern_rec(&obj);
+  CAMLreturn (intern_end(obj, h.whsize));
+}
+
+CAMLprim value caml_input_value_from_string(value str, value ofs)
+{
+  return caml_input_val_from_bytes(str, Long_val(ofs));
+}
+
+CAMLprim value caml_input_value_from_bytes(value str, value ofs)
+{
+  return caml_input_val_from_bytes(str, Long_val(ofs));
+}
+
+static value input_val_from_block(struct marshal_header * h)
+{
+  value obj;
+  /* Allocate result */
+  intern_alloc(h->whsize, h->num_objects, 0);
+  /* Fill it in */
+  intern_rec(&obj);
+  return (intern_end(obj, h->whsize));
+}
+
+CAMLexport value caml_input_value_from_malloc(char * data, intnat ofs)
+{
+  struct marshal_header h;
+
+  intern_init(data + ofs, data);
+
+  caml_parse_header("input_value_from_malloc", &h);
+
+  return input_val_from_block(&h);
+}
+
+/* [len] is a number of bytes */
+CAMLexport value caml_input_value_from_block(char * data, intnat len)
+{
+  struct marshal_header h;
+
+  /* Initialize global state */
+  intern_init(data, NULL);
+  caml_parse_header("input_value_from_block", &h);
+  if (h.header_len + h.data_len > len)
+    caml_failwith("input_val_from_block: bad length");
+  return input_val_from_block(&h);
+}
+
+/* [ofs] is a [value] that represents a number of bytes
+   result is a [value] that represents a number of bytes
+   To handle both the small and the big format,
+   we assume 20 bytes are available at [buff + ofs],
+   and we return the data size + the length of the part of the header
+   that remains to be read. */
+
+CAMLprim value caml_marshal_data_size(value buff, value ofs)
+{
+  uint32_t magic;
+  int header_len;
+  uintnat data_len;
+
+  intern_src = &Byte_u(buff, Long_val(ofs));
+  magic = read32u();
+  switch(magic) {
+  case Intext_magic_number_small:
+    header_len = 20;
+    data_len = read32u();
+    break;
+  case Intext_magic_number_big:
+#ifdef ARCH_SIXTYFOUR
+    header_len = 32;
+    read32u();
+    data_len = read64u();
+#else
+    caml_failwith("Marshal.data_size: "
+                  "object too large to be read back on a 32-bit platform");
+#endif
+    break;
+  default:
+    caml_failwith("Marshal.data_size: bad object");
+  }
+  return Val_long((header_len - 20) + data_len);
+}
+
+/* Resolution of code pointers */
+
+static char * intern_resolve_code_pointer(unsigned char digest[16],
+                                          asize_t offset)
+{
+  int i;
+  for (i = caml_code_fragments_table.size - 1; i >= 0; i--) {
+    struct code_fragment * cf = caml_code_fragments_table.contents[i];
+    if (! cf->digest_computed) {
+      caml_md5_block(cf->digest, cf->code_start, cf->code_end - cf->code_start);
+      cf->digest_computed = 1;
+    }
+    if (memcmp(digest, cf->digest, 16) == 0) {
+      if (cf->code_start + offset < cf->code_end)
+        return cf->code_start + offset;
+      else
+        return NULL;
+    }
+  }
+  return NULL;
+}
+
+static void intern_bad_code_pointer(unsigned char digest[16])
+{
+  char msg[256];
+  snprintf(msg, sizeof(msg),
+               "input_value: unknown code module "
+               "%02X%02X%02X%02X%02X%02X%02X%02X"
+               "%02X%02X%02X%02X%02X%02X%02X%02X",
+          digest[0], digest[1], digest[2], digest[3],
+          digest[4], digest[5], digest[6], digest[7],
+          digest[8], digest[9], digest[10], digest[11],
+          digest[12], digest[13], digest[14], digest[15]);
+  caml_failwith(msg);
+}
+
+/* Functions for writing user-defined marshallers */
+
+CAMLexport int caml_deserialize_uint_1(void)
+{
+  return read8u();
+}
+
+CAMLexport int caml_deserialize_sint_1(void)
+{
+  return read8s();
+}
+
+CAMLexport int caml_deserialize_uint_2(void)
+{
+  return read16u();
+}
+
+CAMLexport int caml_deserialize_sint_2(void)
+{
+  return read16s();
+}
+
+CAMLexport uint32_t caml_deserialize_uint_4(void)
+{
+  return read32u();
+}
+
+CAMLexport int32_t caml_deserialize_sint_4(void)
+{
+  return read32s();
+}
+
+CAMLexport uint64_t caml_deserialize_uint_8(void)
+{
+  uint64_t i;
+  caml_deserialize_block_8(&i, 1);
+  return i;
+}
+
+CAMLexport int64_t caml_deserialize_sint_8(void)
+{
+  int64_t i;
+  caml_deserialize_block_8(&i, 1);
+  return i;
+}
+
+CAMLexport float caml_deserialize_float_4(void)
+{
+  float f;
+  caml_deserialize_block_4(&f, 1);
+  return f;
+}
+
+CAMLexport double caml_deserialize_float_8(void)
+{
+  double f;
+  caml_deserialize_block_float_8(&f, 1);
+  return f;
+}
+
+CAMLexport void caml_deserialize_block_1(void * data, intnat len)
+{
+  memcpy(data, intern_src, len);
+  intern_src += len;
+}
+
+CAMLexport void caml_deserialize_block_2(void * data, intnat len)
+{
+#ifndef ARCH_BIG_ENDIAN
+  unsigned char * p, * q;
+  for (p = intern_src, q = data; len > 0; len--, p += 2, q += 2)
+    Reverse_16(q, p);
+  intern_src = p;
+#else
+  memcpy(data, intern_src, len * 2);
+  intern_src += len * 2;
+#endif
+}
+
+CAMLexport void caml_deserialize_block_4(void * data, intnat len)
+{
+#ifndef ARCH_BIG_ENDIAN
+  unsigned char * p, * q;
+  for (p = intern_src, q = data; len > 0; len--, p += 4, q += 4)
+    Reverse_32(q, p);
+  intern_src = p;
+#else
+  memcpy(data, intern_src, len * 4);
+  intern_src += len * 4;
+#endif
+}
+
+CAMLexport void caml_deserialize_block_8(void * data, intnat len)
+{
+#ifndef ARCH_BIG_ENDIAN
+  unsigned char * p, * q;
+  for (p = intern_src, q = data; len > 0; len--, p += 8, q += 8)
+    Reverse_64(q, p);
+  intern_src = p;
+#else
+  memcpy(data, intern_src, len * 8);
+  intern_src += len * 8;
+#endif
+}
+
+CAMLexport void caml_deserialize_block_float_8(void * data, intnat len)
+{
+#if ARCH_FLOAT_ENDIANNESS == 0x01234567
+  memcpy(data, intern_src, len * 8);
+  intern_src += len * 8;
+#elif ARCH_FLOAT_ENDIANNESS == 0x76543210
+  unsigned char * p, * q;
+  for (p = intern_src, q = data; len > 0; len--, p += 8, q += 8)
+    Reverse_64(q, p);
+  intern_src = p;
+#else
+  unsigned char * p, * q;
+  for (p = intern_src, q = data; len > 0; len--, p += 8, q += 8)
+    Permute_64(q, ARCH_FLOAT_ENDIANNESS, p, 0x01234567);
+  intern_src = p;
+#endif
+}
+
+CAMLexport void caml_deserialize_error(char * msg)
+{
+  intern_cleanup();
+  caml_failwith(msg);
+}
diff --git a/runtime/interp.c b/runtime/interp.c
new file mode 100644
index 00000000..443dc2e7
--- /dev/null
+++ b/runtime/interp.c
@@ -0,0 +1,1200 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* The bytecode interpreter */
+#include <stdio.h>
+#include "caml/alloc.h"
+#include "caml/backtrace.h"
+#include "caml/callback.h"
+#include "caml/debugger.h"
+#include "caml/fail.h"
+#include "caml/fix_code.h"
+#include "caml/instrtrace.h"
+#include "caml/instruct.h"
+#include "caml/interp.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/prims.h"
+#include "caml/signals.h"
+#include "caml/stacks.h"
+#include "caml/startup_aux.h"
+
+/* Registers for the abstract machine:
+        pc         the code pointer
+        sp         the stack pointer (grows downward)
+        accu       the accumulator
+        env        heap-allocated environment
+        Caml_state->trapsp pointer to the current trap frame
+        extra_args number of extra arguments provided by the caller
+
+sp is a local copy of the global variable Caml_state->extern_sp. */
+
+/* Instruction decoding */
+
+#ifdef THREADED_CODE
+#  define Instruct(name) lbl_##name
+#  if defined(ARCH_SIXTYFOUR) && !defined(ARCH_CODE32)
+#    define Jumptbl_base ((char *) &&lbl_ACC0)
+#  else
+#    define Jumptbl_base ((char *) 0)
+#    define jumptbl_base ((char *) 0)
+#  endif
+#  ifdef DEBUG
+#    define Next goto next_instr
+#  else
+#    define Next goto *(void *)(jumptbl_base + *pc++)
+#  endif
+#else
+#  define Instruct(name) case name
+#  define Next break
+#endif
+
+/* GC interface */
+
+#undef Alloc_small_origin
+// Do call asynchronous callbacks from allocation functions
+#define Alloc_small_origin CAML_FROM_CAML
+#define Setup_for_gc \
+  { sp -= 3; sp[0] = accu; sp[1] = env; sp[2] = (value)pc; \
+    Caml_state->extern_sp = sp; }
+#define Restore_after_gc \
+  { sp = Caml_state->extern_sp; accu = sp[0]; env = sp[1]; sp += 3; }
+
+/* We store [pc+1] in the stack so that, in case of an exception, the
+   first backtrace slot points to the event following the C call
+   instruction. */
+#define Setup_for_c_call \
+  { sp -= 2; sp[0] = env; sp[1] = (value)(pc + 1); Caml_state->extern_sp = sp; }
+#define Restore_after_c_call \
+  { sp = Caml_state->extern_sp; env = *sp; sp += 2; }
+
+/* For VM threads purposes, an event frame must look like accu + a
+   C_CALL frame + a RETURN 1 frame.
+   TODO: now that VM threads are gone, we could get rid of that. But
+   we need to make sure that this is not used elsewhere. */
+#define Setup_for_event \
+  { sp -= 6; \
+    sp[0] = accu; /* accu */ \
+    sp[1] = Val_unit; /* C_CALL frame: dummy environment */ \
+    sp[2] = Val_unit; /* RETURN frame: dummy local 0 */ \
+    sp[3] = (value) pc; /* RETURN frame: saved return address */ \
+    sp[4] = env; /* RETURN frame: saved environment */ \
+    sp[5] = Val_long(extra_args); /* RETURN frame: saved extra args */ \
+    Caml_state->extern_sp = sp; }
+#define Restore_after_event \
+  { sp = Caml_state->extern_sp; accu = sp[0]; \
+    pc = (code_t) sp[3]; env = sp[4]; extra_args = Long_val(sp[5]); \
+    sp += 6; }
+
+/* Debugger interface */
+
+#define Setup_for_debugger \
+   { sp -= 4; \
+     sp[0] = accu; sp[1] = (value)(pc - 1); \
+     sp[2] = env; sp[3] = Val_long(extra_args); \
+     Caml_state->extern_sp = sp; }
+#define Restore_after_debugger \
+   { CAMLassert(sp == Caml_state->extern_sp); \
+     CAMLassert(sp[0] == accu); \
+     CAMLassert(sp[2] == env); \
+     sp += 4; }
+
+#ifdef THREADED_CODE
+#define Restart_curr_instr \
+  goto *((void*)(jumptbl_base + caml_debugger_saved_instruction(pc - 1)))
+#else
+#define Restart_curr_instr \
+  curr_instr = caml_debugger_saved_instruction(pc - 1); \
+  goto dispatch_instr
+#endif
+
+#define Check_trap_barrier \
+  if (Caml_state->trapsp >= Caml_state->trap_barrier) \
+    caml_debugger(TRAP_BARRIER, Val_unit)
+
+/* Register optimization.
+   Some compilers underestimate the use of the local variables representing
+   the abstract machine registers, and don't put them in hardware registers,
+   which slows down the interpreter considerably.
+   For GCC, I have hand-assigned hardware registers for several architectures.
+*/
+
+#if defined(__GNUC__) && !defined(DEBUG) && !defined(__INTEL_COMPILER) \
+    && !defined(__llvm__)
+#ifdef __mips__
+#define PC_REG asm("$16")
+#define SP_REG asm("$17")
+#define ACCU_REG asm("$18")
+#endif
+#ifdef __sparc__
+#define PC_REG asm("%l0")
+#define SP_REG asm("%l1")
+#define ACCU_REG asm("%l2")
+#endif
+#ifdef __alpha__
+#ifdef __CRAY__
+#define PC_REG asm("r9")
+#define SP_REG asm("r10")
+#define ACCU_REG asm("r11")
+#define JUMPTBL_BASE_REG asm("r12")
+#else
+#define PC_REG asm("$9")
+#define SP_REG asm("$10")
+#define ACCU_REG asm("$11")
+#define JUMPTBL_BASE_REG asm("$12")
+#endif
+#endif
+#ifdef __i386__
+#define PC_REG asm("%esi")
+#define SP_REG asm("%edi")
+#define ACCU_REG
+#endif
+#if defined(__ppc__) || defined(__ppc64__)
+#define PC_REG asm("26")
+#define SP_REG asm("27")
+#define ACCU_REG asm("28")
+#endif
+#ifdef __hppa__
+#define PC_REG asm("%r18")
+#define SP_REG asm("%r17")
+#define ACCU_REG asm("%r16")
+#endif
+#ifdef __mc68000__
+#define PC_REG asm("a5")
+#define SP_REG asm("a4")
+#define ACCU_REG asm("d7")
+#endif
+/* PR#4953: these specific registers not available in Thumb mode */
+#if defined (__arm__) && !defined(__thumb__)
+#define PC_REG asm("r6")
+#define SP_REG asm("r8")
+#define ACCU_REG asm("r7")
+#endif
+#ifdef __ia64__
+#define PC_REG asm("36")
+#define SP_REG asm("37")
+#define ACCU_REG asm("38")
+#define JUMPTBL_BASE_REG asm("39")
+#endif
+#ifdef __x86_64__
+#define PC_REG asm("%r15")
+#define SP_REG asm("%r14")
+#define ACCU_REG asm("%r13")
+#endif
+#ifdef __aarch64__
+#define PC_REG asm("%x19")
+#define SP_REG asm("%x20")
+#define ACCU_REG asm("%x21")
+#define JUMPTBL_BASE_REG asm("%x22")
+#endif
+#endif
+
+#ifdef DEBUG
+static intnat caml_bcodcount;
+#endif
+
+/* The interpreter itself */
+
+value caml_interprete(code_t prog, asize_t prog_size)
+{
+#ifdef PC_REG
+  register code_t pc PC_REG;
+  register value * sp SP_REG;
+  register value accu ACCU_REG;
+#else
+  register code_t pc;
+  register value * sp;
+  register value accu;
+#endif
+#if defined(THREADED_CODE) && defined(ARCH_SIXTYFOUR) && !defined(ARCH_CODE32)
+#ifdef JUMPTBL_BASE_REG
+  register char * jumptbl_base JUMPTBL_BASE_REG;
+#else
+  register char * jumptbl_base;
+#endif
+#endif
+  value env;
+  intnat extra_args;
+  struct longjmp_buffer * initial_external_raise;
+  intnat initial_sp_offset;
+  /* volatile ensures that initial_local_roots
+     will keep correct value across longjmp */
+  struct caml__roots_block * volatile initial_local_roots;
+  struct longjmp_buffer raise_buf;
+#ifndef THREADED_CODE
+  opcode_t curr_instr;
+#endif
+
+#ifdef THREADED_CODE
+  static void * jumptable[] = {
+#    include "caml/jumptbl.h"
+  };
+#endif
+
+  if (prog == NULL) {           /* Interpreter is initializing */
+#ifdef THREADED_CODE
+    caml_instr_table = (char **) jumptable;
+    caml_instr_base = Jumptbl_base;
+#endif
+    return Val_unit;
+  }
+
+#if defined(THREADED_CODE) && defined(ARCH_SIXTYFOUR) && !defined(ARCH_CODE32)
+  jumptbl_base = Jumptbl_base;
+#endif
+  initial_local_roots = Caml_state->local_roots;
+  initial_sp_offset =
+    (char *) Caml_state->stack_high - (char *) Caml_state->extern_sp;
+  initial_external_raise = Caml_state->external_raise;
+  caml_callback_depth++;
+
+  if (sigsetjmp(raise_buf.buf, 0)) {
+    Caml_state->local_roots = initial_local_roots;
+    sp = Caml_state->extern_sp;
+    accu = Caml_state->exn_bucket;
+
+    Check_trap_barrier;
+    if (Caml_state->backtrace_active) {
+      /* pc has already been pushed on the stack when calling the C
+         function that raised the exception. No need to push it again
+         here. */
+      caml_stash_backtrace(accu, sp, 0);
+    }
+    goto raise_notrace;
+  }
+  Caml_state->external_raise = &raise_buf;
+
+  sp = Caml_state->extern_sp;
+  pc = prog;
+  extra_args = 0;
+  env = Atom(0);
+  accu = Val_int(0);
+
+#ifdef THREADED_CODE
+#ifdef DEBUG
+ next_instr:
+  if (caml_icount-- == 0) caml_stop_here ();
+  CAMLassert(sp >= Caml_state->stack_low);
+  CAMLassert(sp <= Caml_state->stack_high);
+#endif
+  goto *(void *)(jumptbl_base + *pc++); /* Jump to the first instruction */
+#else
+  while(1) {
+#ifdef DEBUG
+    caml_bcodcount++;
+    if (caml_icount-- == 0) caml_stop_here ();
+    if (caml_trace_level>1) printf("\n##%" ARCH_INTNAT_PRINTF_FORMAT "d\n",
+                                   caml_bcodcount);
+    if (caml_trace_level>0) caml_disasm_instr(pc);
+    if (caml_trace_level>1) {
+      printf("env=");
+      caml_trace_value_file(env,prog,prog_size,stdout);
+      putchar('\n');
+      caml_trace_accu_sp_file(accu,sp,prog,prog_size,stdout);
+      fflush(stdout);
+    };
+    CAMLassert(sp >= Caml_state->stack_low);
+    CAMLassert(sp <= Caml_state->stack_high);
+#endif
+    curr_instr = *pc++;
+
+  dispatch_instr:
+    switch(curr_instr) {
+#endif
+
+/* Basic stack operations */
+
+    Instruct(ACC0):
+      accu = sp[0]; Next;
+    Instruct(ACC1):
+      accu = sp[1]; Next;
+    Instruct(ACC2):
+      accu = sp[2]; Next;
+    Instruct(ACC3):
+      accu = sp[3]; Next;
+    Instruct(ACC4):
+      accu = sp[4]; Next;
+    Instruct(ACC5):
+      accu = sp[5]; Next;
+    Instruct(ACC6):
+      accu = sp[6]; Next;
+    Instruct(ACC7):
+      accu = sp[7]; Next;
+
+    Instruct(PUSH): Instruct(PUSHACC0):
+      *--sp = accu; Next;
+    Instruct(PUSHACC1):
+      *--sp = accu; accu = sp[1]; Next;
+    Instruct(PUSHACC2):
+      *--sp = accu; accu = sp[2]; Next;
+    Instruct(PUSHACC3):
+      *--sp = accu; accu = sp[3]; Next;
+    Instruct(PUSHACC4):
+      *--sp = accu; accu = sp[4]; Next;
+    Instruct(PUSHACC5):
+      *--sp = accu; accu = sp[5]; Next;
+    Instruct(PUSHACC6):
+      *--sp = accu; accu = sp[6]; Next;
+    Instruct(PUSHACC7):
+      *--sp = accu; accu = sp[7]; Next;
+
+    Instruct(PUSHACC):
+      *--sp = accu;
+      /* Fallthrough */
+    Instruct(ACC):
+      accu = sp[*pc++];
+      Next;
+
+    Instruct(POP):
+      sp += *pc++;
+      Next;
+    Instruct(ASSIGN):
+      sp[*pc++] = accu;
+      accu = Val_unit;
+      Next;
+
+/* Access in heap-allocated environment */
+
+    Instruct(ENVACC1):
+      accu = Field(env, 1); Next;
+    Instruct(ENVACC2):
+      accu = Field(env, 2); Next;
+    Instruct(ENVACC3):
+      accu = Field(env, 3); Next;
+    Instruct(ENVACC4):
+      accu = Field(env, 4); Next;
+
+    Instruct(PUSHENVACC1):
+      *--sp = accu; accu = Field(env, 1); Next;
+    Instruct(PUSHENVACC2):
+      *--sp = accu; accu = Field(env, 2); Next;
+    Instruct(PUSHENVACC3):
+      *--sp = accu; accu = Field(env, 3); Next;
+    Instruct(PUSHENVACC4):
+      *--sp = accu; accu = Field(env, 4); Next;
+
+    Instruct(PUSHENVACC):
+      *--sp = accu;
+      /* Fallthrough */
+    Instruct(ENVACC):
+      accu = Field(env, *pc++);
+      Next;
+
+/* Function application */
+
+    Instruct(PUSH_RETADDR): {
+      sp -= 3;
+      sp[0] = (value) (pc + *pc);
+      sp[1] = env;
+      sp[2] = Val_long(extra_args);
+      pc++;
+      Next;
+    }
+    Instruct(APPLY): {
+      extra_args = *pc - 1;
+      pc = Code_val(accu);
+      env = accu;
+      goto check_stacks;
+    }
+    Instruct(APPLY1): {
+      value arg1 = sp[0];
+      sp -= 3;
+      sp[0] = arg1;
+      sp[1] = (value)pc;
+      sp[2] = env;
+      sp[3] = Val_long(extra_args);
+      pc = Code_val(accu);
+      env = accu;
+      extra_args = 0;
+      goto check_stacks;
+    }
+    Instruct(APPLY2): {
+      value arg1 = sp[0];
+      value arg2 = sp[1];
+      sp -= 3;
+      sp[0] = arg1;
+      sp[1] = arg2;
+      sp[2] = (value)pc;
+      sp[3] = env;
+      sp[4] = Val_long(extra_args);
+      pc = Code_val(accu);
+      env = accu;
+      extra_args = 1;
+      goto check_stacks;
+    }
+    Instruct(APPLY3): {
+      value arg1 = sp[0];
+      value arg2 = sp[1];
+      value arg3 = sp[2];
+      sp -= 3;
+      sp[0] = arg1;
+      sp[1] = arg2;
+      sp[2] = arg3;
+      sp[3] = (value)pc;
+      sp[4] = env;
+      sp[5] = Val_long(extra_args);
+      pc = Code_val(accu);
+      env = accu;
+      extra_args = 2;
+      goto check_stacks;
+    }
+
+    Instruct(APPTERM): {
+      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];
+      sp = newsp;
+      pc = Code_val(accu);
+      env = accu;
+      extra_args += nargs - 1;
+      goto check_stacks;
+    }
+    Instruct(APPTERM1): {
+      value arg1 = sp[0];
+      sp = sp + *pc - 1;
+      sp[0] = arg1;
+      pc = Code_val(accu);
+      env = accu;
+      goto check_stacks;
+    }
+    Instruct(APPTERM2): {
+      value arg1 = sp[0];
+      value arg2 = sp[1];
+      sp = sp + *pc - 2;
+      sp[0] = arg1;
+      sp[1] = arg2;
+      pc = Code_val(accu);
+      env = accu;
+      extra_args += 1;
+      goto check_stacks;
+    }
+    Instruct(APPTERM3): {
+      value arg1 = sp[0];
+      value arg2 = sp[1];
+      value arg3 = sp[2];
+      sp = sp + *pc - 3;
+      sp[0] = arg1;
+      sp[1] = arg2;
+      sp[2] = arg3;
+      pc = Code_val(accu);
+      env = accu;
+      extra_args += 2;
+      goto check_stacks;
+    }
+
+    Instruct(RETURN): {
+      sp += *pc++;
+      if (extra_args > 0) {
+        extra_args--;
+        pc = Code_val(accu);
+        env = accu;
+      } else {
+        pc = (code_t)(sp[0]);
+        env = sp[1];
+        extra_args = Long_val(sp[2]);
+        sp += 3;
+      }
+      Next;
+    }
+
+    Instruct(RESTART): {
+      int num_args = Wosize_val(env) - 2;
+      int i;
+      sp -= num_args;
+      for (i = 0; i < num_args; i++) sp[i] = Field(env, i + 2);
+      env = Field(env, 1);
+      extra_args += num_args;
+      Next;
+    }
+
+    Instruct(GRAB): {
+      int required = *pc++;
+      if (extra_args >= required) {
+        extra_args -= required;
+      } else {
+        mlsize_t num_args, i;
+        num_args = 1 + extra_args; /* arg1 + extra args */
+        Alloc_small(accu, num_args + 2, Closure_tag);
+        Field(accu, 1) = env;
+        for (i = 0; i < num_args; i++) Field(accu, i + 2) = sp[i];
+        CAMLassert(!Is_in_value_area(pc-3));
+        Code_val(accu) = pc - 3; /* Point to the preceding RESTART instr. */
+        sp += num_args;
+        pc = (code_t)(sp[0]);
+        env = sp[1];
+        extra_args = Long_val(sp[2]);
+        sp += 3;
+      }
+      Next;
+    }
+
+    Instruct(CLOSURE): {
+      int nvars = *pc++;
+      int i;
+      if (nvars > 0) *--sp = accu;
+      if (nvars < Max_young_wosize) {
+        /* nvars + 1 <= Max_young_wosize, can allocate in minor heap */
+        Alloc_small(accu, 1 + nvars, Closure_tag);
+        for (i = 0; i < nvars; i++) Field(accu, i + 1) = sp[i];
+      } else {
+        /* PR#6385: must allocate in major heap */
+        /* caml_alloc_shr and caml_initialize never trigger a GC,
+           so no need to Setup_for_gc */
+        accu = caml_alloc_shr(1 + nvars, Closure_tag);
+        for (i = 0; i < nvars; i++) caml_initialize(&Field(accu, i + 1), sp[i]);
+      }
+      /* The code pointer is not in the heap, so no need to go through
+         caml_initialize. */
+      CAMLassert(!Is_in_value_area(pc + *pc));
+      Code_val(accu) = pc + *pc;
+      pc++;
+      sp += nvars;
+      Next;
+    }
+
+    Instruct(CLOSUREREC): {
+      int nfuncs = *pc++;
+      int nvars = *pc++;
+      mlsize_t blksize = nfuncs * 2 - 1 + nvars;
+      int i;
+      value * p;
+      if (nvars > 0) *--sp = accu;
+      if (blksize <= Max_young_wosize) {
+        Alloc_small(accu, blksize, Closure_tag);
+        p = &Field(accu, nfuncs * 2 - 1);
+        for (i = 0; i < nvars; i++, p++) *p = sp[i];
+      } else {
+        /* PR#6385: must allocate in major heap */
+        /* caml_alloc_shr and caml_initialize never trigger a GC,
+           so no need to Setup_for_gc */
+        accu = caml_alloc_shr(blksize, Closure_tag);
+        p = &Field(accu, nfuncs * 2 - 1);
+        for (i = 0; i < nvars; i++, p++) caml_initialize(p, sp[i]);
+      }
+      sp += nvars;
+      /* The code pointers and infix headers are not in the heap,
+         so no need to go through caml_initialize. */
+      p = &Field(accu, 0);
+      *p = (value) (pc + pc[0]);
+      *--sp = accu;
+      p++;
+      for (i = 1; i < nfuncs; i++) {
+        *p = Make_header(i * 2, Infix_tag, Caml_white);  /* color irrelevant. */
+        p++;
+        *p = (value) (pc + pc[i]);
+        *--sp = (value) p;
+        p++;
+      }
+      pc += nfuncs;
+      Next;
+    }
+
+    Instruct(PUSHOFFSETCLOSURE):
+      *--sp = accu; /* fallthrough */
+    Instruct(OFFSETCLOSURE):
+      accu = env + *pc++ * sizeof(value); Next;
+
+    Instruct(PUSHOFFSETCLOSUREM2):
+      *--sp = accu; /* fallthrough */
+    Instruct(OFFSETCLOSUREM2):
+      accu = env - 2 * sizeof(value); Next;
+    Instruct(PUSHOFFSETCLOSURE0):
+      *--sp = accu; /* fallthrough */
+    Instruct(OFFSETCLOSURE0):
+      accu = env; Next;
+    Instruct(PUSHOFFSETCLOSURE2):
+      *--sp = accu; /* fallthrough */
+    Instruct(OFFSETCLOSURE2):
+      accu = env + 2 * sizeof(value); Next;
+
+
+/* Access to global variables */
+
+    Instruct(PUSHGETGLOBAL):
+      *--sp = accu;
+      /* Fallthrough */
+    Instruct(GETGLOBAL):
+      accu = Field(caml_global_data, *pc);
+      pc++;
+      Next;
+
+    Instruct(PUSHGETGLOBALFIELD):
+      *--sp = accu;
+      /* Fallthrough */
+    Instruct(GETGLOBALFIELD): {
+      accu = Field(caml_global_data, *pc);
+      pc++;
+      accu = Field(accu, *pc);
+      pc++;
+      Next;
+    }
+
+    Instruct(SETGLOBAL):
+      caml_modify(&Field(caml_global_data, *pc), accu);
+      accu = Val_unit;
+      pc++;
+      Next;
+
+/* Allocation of blocks */
+
+    Instruct(PUSHATOM0):
+      *--sp = accu;
+      /* Fallthrough */
+    Instruct(ATOM0):
+      accu = Atom(0); Next;
+
+    Instruct(PUSHATOM):
+      *--sp = accu;
+      /* 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);
+        Field(block, 0) = accu;
+        for (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++);
+      }
+      accu = block;
+      Next;
+    }
+    Instruct(MAKEBLOCK1): {
+      tag_t tag = *pc++;
+      value block;
+      Alloc_small(block, 1, tag);
+      Field(block, 0) = accu;
+      accu = block;
+      Next;
+    }
+    Instruct(MAKEBLOCK2): {
+      tag_t tag = *pc++;
+      value block;
+      Alloc_small(block, 2, tag);
+      Field(block, 0) = accu;
+      Field(block, 1) = sp[0];
+      sp += 1;
+      accu = block;
+      Next;
+    }
+    Instruct(MAKEBLOCK3): {
+      tag_t tag = *pc++;
+      value block;
+      Alloc_small(block, 3, tag);
+      Field(block, 0) = accu;
+      Field(block, 1) = sp[0];
+      Field(block, 2) = sp[1];
+      sp += 2;
+      accu = block;
+      Next;
+    }
+    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);
+      } else {
+        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++){
+        Store_double_flat_field(block, i, Double_val(*sp));
+        ++ sp;
+      }
+      accu = block;
+      Next;
+    }
+
+/* Access to components of blocks */
+
+    Instruct(GETFIELD0):
+      accu = Field(accu, 0); Next;
+    Instruct(GETFIELD1):
+      accu = Field(accu, 1); Next;
+    Instruct(GETFIELD2):
+      accu = Field(accu, 2); Next;
+    Instruct(GETFIELD3):
+      accu = Field(accu, 3); Next;
+    Instruct(GETFIELD):
+      accu = Field(accu, *pc); pc++; Next;
+    Instruct(GETFLOATFIELD): {
+      double d = Double_flat_field(accu, *pc++);
+      Alloc_small(accu, Double_wosize, Double_tag);
+      Store_double_val(accu, d);
+      Next;
+    }
+
+    Instruct(SETFIELD0):
+      caml_modify(&Field(accu, 0), *sp++);
+      accu = Val_unit;
+      Next;
+    Instruct(SETFIELD1):
+      caml_modify(&Field(accu, 1), *sp++);
+      accu = Val_unit;
+      Next;
+    Instruct(SETFIELD2):
+      caml_modify(&Field(accu, 2), *sp++);
+      accu = Val_unit;
+      Next;
+    Instruct(SETFIELD3):
+      caml_modify(&Field(accu, 3), *sp++);
+      accu = Val_unit;
+      Next;
+    Instruct(SETFIELD):
+      caml_modify(&Field(accu, *pc), *sp++);
+      accu = Val_unit;
+      pc++;
+      Next;
+    Instruct(SETFLOATFIELD):
+      Store_double_flat_field(accu, *pc, Double_val(*sp));
+      accu = Val_unit;
+      sp++;
+      pc++;
+      Next;
+
+/* Array operations */
+
+    Instruct(VECTLENGTH): {
+      /* Todo: when FLAT_FLOAT_ARRAY is false, this instruction should
+         be split into VECTLENGTH and FLOATVECTLENGTH because we know
+         statically which one it is. */
+      mlsize_t size = Wosize_val(accu);
+      if (Tag_val(accu) == Double_array_tag) size = size / Double_wosize;
+      accu = Val_long(size);
+      Next;
+    }
+    Instruct(GETVECTITEM):
+      accu = Field(accu, Long_val(sp[0]));
+      sp += 1;
+      Next;
+    Instruct(SETVECTITEM):
+      caml_modify(&Field(accu, Long_val(sp[0])), sp[1]);
+      accu = Val_unit;
+      sp += 2;
+      Next;
+
+/* Bytes/String operations */
+    Instruct(GETSTRINGCHAR):
+    Instruct(GETBYTESCHAR):
+      accu = Val_int(Byte_u(accu, Long_val(sp[0])));
+      sp += 1;
+      Next;
+    Instruct(SETBYTESCHAR):
+      Byte_u(accu, Long_val(sp[0])) = Int_val(sp[1]);
+      sp += 2;
+      accu = Val_unit;
+      Next;
+
+/* Branches and conditional branches */
+
+    Instruct(BRANCH):
+      pc += *pc;
+      Next;
+    Instruct(BRANCHIF):
+      if (accu != Val_false) pc += *pc; else pc++;
+      Next;
+    Instruct(BRANCHIFNOT):
+      if (accu == Val_false) pc += *pc; else pc++;
+      Next;
+    Instruct(SWITCH): {
+      uint32_t sizes = *pc++;
+      if (Is_block(accu)) {
+        intnat index = Tag_val(accu);
+        CAMLassert ((uintnat) index < (sizes >> 16));
+        pc += pc[(sizes & 0xFFFF) + index];
+      } else {
+        intnat index = Long_val(accu);
+        CAMLassert ((uintnat) index < (sizes & 0xFFFF)) ;
+        pc += pc[index];
+      }
+      Next;
+    }
+    Instruct(BOOLNOT):
+      accu = Val_not(accu);
+      Next;
+
+/* Exceptions */
+
+    Instruct(PUSHTRAP):
+      sp -= 4;
+      Trap_pc(sp) = pc + *pc;
+      Trap_link(sp) = Caml_state->trapsp;
+      sp[2] = env;
+      sp[3] = Val_long(extra_args);
+      Caml_state->trapsp = sp;
+      pc++;
+      Next;
+
+    Instruct(POPTRAP):
+      if (caml_something_to_do) {
+        /* We must check here so that if a signal is pending and its
+           handler triggers an exception, the exception is trapped
+           by the current try...with, not the enclosing one. */
+        pc--; /* restart the POPTRAP after processing the signal */
+        goto process_actions;
+      }
+      Caml_state->trapsp = Trap_link(sp);
+      sp += 4;
+      Next;
+
+    Instruct(RAISE_NOTRACE):
+      Check_trap_barrier;
+      goto raise_notrace;
+
+    Instruct(RERAISE):
+      Check_trap_barrier;
+      if (Caml_state->backtrace_active) {
+        *--sp = (value)(pc - 1);
+        caml_stash_backtrace(accu, sp, 1);
+      }
+      goto raise_notrace;
+
+    Instruct(RAISE):
+      Check_trap_barrier;
+      if (Caml_state->backtrace_active) {
+        *--sp = (value)(pc - 1);
+        caml_stash_backtrace(accu, sp, 0);
+      }
+    raise_notrace:
+      if ((char *) Caml_state->trapsp
+          >= (char *) Caml_state->stack_high - initial_sp_offset) {
+        Caml_state->external_raise = initial_external_raise;
+        Caml_state->extern_sp = (value *) ((char *) Caml_state->stack_high
+                                    - initial_sp_offset);
+        caml_callback_depth--;
+        return Make_exception_result(accu);
+      }
+      sp = Caml_state->trapsp;
+      pc = Trap_pc(sp);
+      Caml_state->trapsp = Trap_link(sp);
+      env = sp[2];
+      extra_args = Long_val(sp[3]);
+      sp += 4;
+      Next;
+
+/* Stack checks */
+
+    check_stacks:
+      if (sp < Caml_state->stack_threshold) {
+        Caml_state->extern_sp = sp;
+        caml_realloc_stack(Stack_threshold / sizeof(value));
+        sp = Caml_state->extern_sp;
+      }
+      /* Fall through CHECK_SIGNALS */
+
+/* Signal handling */
+
+    Instruct(CHECK_SIGNALS):    /* accu not preserved */
+      if (caml_something_to_do) goto process_actions;
+      Next;
+
+    process_actions:
+      Setup_for_event;
+      caml_process_pending_actions();
+      Restore_after_event;
+      Next;
+
+/* Calling C functions */
+
+    Instruct(C_CALL1):
+      Setup_for_c_call;
+      accu = Primitive(*pc)(accu);
+      Restore_after_c_call;
+      pc++;
+      Next;
+    Instruct(C_CALL2):
+      Setup_for_c_call;
+      accu = Primitive(*pc)(accu, sp[2]);
+      Restore_after_c_call;
+      sp += 1;
+      pc++;
+      Next;
+    Instruct(C_CALL3):
+      Setup_for_c_call;
+      accu = Primitive(*pc)(accu, sp[2], sp[3]);
+      Restore_after_c_call;
+      sp += 2;
+      pc++;
+      Next;
+    Instruct(C_CALL4):
+      Setup_for_c_call;
+      accu = Primitive(*pc)(accu, sp[2], sp[3], sp[4]);
+      Restore_after_c_call;
+      sp += 3;
+      pc++;
+      Next;
+    Instruct(C_CALL5):
+      Setup_for_c_call;
+      accu = Primitive(*pc)(accu, sp[2], sp[3], sp[4], sp[5]);
+      Restore_after_c_call;
+      sp += 4;
+      pc++;
+      Next;
+    Instruct(C_CALLN): {
+      int nargs = *pc++;
+      *--sp = accu;
+      Setup_for_c_call;
+      accu = Primitive(*pc)(sp + 2, nargs);
+      Restore_after_c_call;
+      sp += nargs;
+      pc++;
+      Next;
+    }
+
+/* Integer constants */
+
+    Instruct(CONST0):
+      accu = Val_int(0); Next;
+    Instruct(CONST1):
+      accu = Val_int(1); Next;
+    Instruct(CONST2):
+      accu = Val_int(2); Next;
+    Instruct(CONST3):
+      accu = Val_int(3); Next;
+
+    Instruct(PUSHCONST0):
+      *--sp = accu; accu = Val_int(0); Next;
+    Instruct(PUSHCONST1):
+      *--sp = accu; accu = Val_int(1); Next;
+    Instruct(PUSHCONST2):
+      *--sp = accu; accu = Val_int(2); Next;
+    Instruct(PUSHCONST3):
+      *--sp = accu; accu = Val_int(3); Next;
+
+    Instruct(PUSHCONSTINT):
+      *--sp = accu;
+      /* Fallthrough */
+    Instruct(CONSTINT):
+      accu = Val_int(*pc);
+      pc++;
+      Next;
+
+/* Integer arithmetic */
+
+    Instruct(NEGINT):
+      accu = (value)(2 - (intnat)accu); Next;
+    Instruct(ADDINT):
+      accu = (value)((intnat) accu + (intnat) *sp++ - 1); Next;
+    Instruct(SUBINT):
+      accu = (value)((intnat) accu - (intnat) *sp++ + 1); Next;
+    Instruct(MULINT):
+      accu = Val_long(Long_val(accu) * Long_val(*sp++)); Next;
+
+    Instruct(DIVINT): {
+      intnat divisor = Long_val(*sp++);
+      if (divisor == 0) { Setup_for_c_call; caml_raise_zero_divide(); }
+      accu = Val_long(Long_val(accu) / divisor);
+      Next;
+    }
+    Instruct(MODINT): {
+      intnat divisor = Long_val(*sp++);
+      if (divisor == 0) { Setup_for_c_call; caml_raise_zero_divide(); }
+      accu = Val_long(Long_val(accu) % divisor);
+      Next;
+    }
+    Instruct(ANDINT):
+      accu = (value)((intnat) accu & (intnat) *sp++); Next;
+    Instruct(ORINT):
+      accu = (value)((intnat) accu | (intnat) *sp++); Next;
+    Instruct(XORINT):
+      accu = (value)(((intnat) accu ^ (intnat) *sp++) | 1); Next;
+    Instruct(LSLINT):
+      accu = (value)((((intnat) accu - 1) << Long_val(*sp++)) + 1); Next;
+    Instruct(LSRINT):
+      accu = (value)((((uintnat) accu) >> Long_val(*sp++)) | 1); Next;
+    Instruct(ASRINT):
+      accu = (value)((((intnat) accu) >> Long_val(*sp++)) | 1); Next;
+
+#define Integer_comparison(typ,opname,tst) \
+    Instruct(opname): \
+      accu = Val_int((typ) accu tst (typ) *sp++); Next;
+
+    Integer_comparison(intnat,EQ, ==)
+    Integer_comparison(intnat,NEQ, !=)
+    Integer_comparison(intnat,LTINT, <)
+    Integer_comparison(intnat,LEINT, <=)
+    Integer_comparison(intnat,GTINT, >)
+    Integer_comparison(intnat,GEINT, >=)
+    Integer_comparison(uintnat,ULTINT, <)
+    Integer_comparison(uintnat,UGEINT, >=)
+
+#define Integer_branch_comparison(typ,opname,tst,debug) \
+    Instruct(opname): \
+      if ( *pc++ tst (typ) Long_val(accu)) { \
+        pc += *pc ; \
+      } else { \
+        pc++ ; \
+      } ; Next;
+
+    Integer_branch_comparison(intnat,BEQ, ==, "==")
+    Integer_branch_comparison(intnat,BNEQ, !=, "!=")
+    Integer_branch_comparison(intnat,BLTINT, <, "<")
+    Integer_branch_comparison(intnat,BLEINT, <=, "<=")
+    Integer_branch_comparison(intnat,BGTINT, >, ">")
+    Integer_branch_comparison(intnat,BGEINT, >=, ">=")
+    Integer_branch_comparison(uintnat,BULTINT, <, "<")
+    Integer_branch_comparison(uintnat,BUGEINT, >=, ">=")
+
+    Instruct(OFFSETINT):
+      accu += *pc << 1;
+      pc++;
+      Next;
+    Instruct(OFFSETREF):
+      Field(accu, 0) += *pc << 1;
+      accu = Val_unit;
+      pc++;
+      Next;
+    Instruct(ISINT):
+      accu = Val_long(accu & 1);
+      Next;
+
+/* Object-oriented operations */
+
+#define Lookup(obj, lab) Field (Field (obj, 0), Int_val(lab))
+
+      /* please don't forget to keep below code in sync with the
+         functions caml_cache_public_method and
+         caml_cache_public_method2 in obj.c */
+
+    Instruct(GETMETHOD):
+      accu = Lookup(sp[0], accu);
+      Next;
+
+#define CAML_METHOD_CACHE
+#ifdef CAML_METHOD_CACHE
+    Instruct(GETPUBMET): {
+      /* accu == object, pc[0] == tag, pc[1] == cache */
+      value meths = Field (accu, 0);
+      value ofs;
+#ifdef CAML_TEST_CACHE
+      static int calls = 0, hits = 0;
+      if (calls >= 10000000) {
+        fprintf(stderr, "cache hit = %d%%\n", hits / 100000);
+        calls = 0; hits = 0;
+      }
+      calls++;
+#endif
+      *--sp = accu;
+      accu = Val_int(*pc++);
+      ofs = *pc & Field(meths,1);
+      if (*(value*)(((char*)&Field(meths,3)) + ofs) == accu) {
+#ifdef CAML_TEST_CACHE
+        hits++;
+#endif
+        accu = *(value*)(((char*)&Field(meths,2)) + ofs);
+      }
+      else
+      {
+        int li = 3, hi = Field(meths,0), mi;
+        while (li < hi) {
+          mi = ((li+hi) >> 1) | 1;
+          if (accu < Field(meths,mi)) hi = mi-2;
+          else li = mi;
+        }
+        *pc = (li-3)*sizeof(value);
+        accu = Field (meths, li-1);
+      }
+      pc++;
+      Next;
+    }
+#else
+    Instruct(GETPUBMET):
+      *--sp = accu;
+      accu = Val_int(*pc);
+      pc += 2;
+      /* Fallthrough */
+#endif
+    Instruct(GETDYNMET): {
+      /* accu == tag, sp[0] == object, *pc == cache */
+      value meths = Field (sp[0], 0);
+      int li = 3, hi = Field(meths,0), mi;
+      while (li < hi) {
+        mi = ((li+hi) >> 1) | 1;
+        if (accu < Field(meths,mi)) hi = mi-2;
+        else li = mi;
+      }
+      accu = Field (meths, li-1);
+      Next;
+    }
+
+/* Debugging and machine control */
+
+    Instruct(STOP):
+      Caml_state->external_raise = initial_external_raise;
+      Caml_state->extern_sp = sp;
+      caml_callback_depth--;
+      return accu;
+
+    Instruct(EVENT):
+      if (--caml_event_count == 0) {
+        Setup_for_debugger;
+        caml_debugger(EVENT_COUNT, Val_unit);
+        Restore_after_debugger;
+      }
+      Restart_curr_instr;
+
+    Instruct(BREAK):
+      Setup_for_debugger;
+      caml_debugger(BREAKPOINT, Val_unit);
+      Restore_after_debugger;
+      Restart_curr_instr;
+
+#ifndef THREADED_CODE
+    default:
+#if _MSC_VER >= 1200
+      __assume(0);
+#else
+      caml_fatal_error("bad opcode (%"
+                           ARCH_INTNAT_PRINTF_FORMAT "x)",
+                           (intnat) *(pc-1));
+#endif
+    }
+  }
+#endif
+}
+
+void caml_prepare_bytecode(code_t prog, asize_t prog_size) {
+  /* other implementations of the interpreter (such as an hypothetical
+     JIT translator) might want to do something with a bytecode before
+     running it */
+  CAMLassert(prog);
+  CAMLassert(prog_size>0);
+  /* actually, the threading of the bytecode might be done here */
+}
+
+void caml_release_bytecode(code_t prog, asize_t prog_size) {
+  /* other implementations of the interpreter (such as an hypothetical
+     JIT translator) might want to know when a bytecode is removed */
+  /* check that we have a program */
+  CAMLassert(prog);
+  CAMLassert(prog_size>0);
+}
diff --git a/runtime/ints.c b/runtime/ints.c
new file mode 100644
index 00000000..c9584e4a
--- /dev/null
+++ b/runtime/ints.c
@@ -0,0 +1,851 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <stdio.h>
+#include <string.h>
+#include "caml/alloc.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/intext.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+
+/* Comparison resulting in -1,0,1, with type intnat,
+   without extra integer width conversion (GPR#2250). */
+#define COMPARE_INT(v1, v2) \
+  (intnat)(v1 > v2) - (intnat)(v1 < v2)
+
+static const char * parse_sign_and_base(const char * p,
+                                        /*out*/ int * base,
+                                        /*out*/ int * signedness,
+                                        /*out*/ int * sign)
+{
+  *sign = 1;
+  if (*p == '-') {
+    *sign = -1;
+    p++;
+  } else if (*p == '+')
+    p++;
+  *base = 10; *signedness = 1;
+  if (*p == '0') {
+    switch (p[1]) {
+    case 'x': case 'X':
+      *base = 16; *signedness = 0; p += 2; break;
+    case 'o': case 'O':
+      *base = 8; *signedness = 0; p += 2; break;
+    case 'b': case 'B':
+      *base = 2; *signedness = 0; p += 2; break;
+    case 'u': case 'U':
+      *signedness = 0; p += 2; break;
+    }
+  }
+  return p;
+}
+
+static int parse_digit(char c)
+{
+  if (c >= '0' && c <= '9')
+    return c - '0';
+  else if (c >= 'A' && c <= 'F')
+    return c - 'A' + 10;
+  else if (c >= 'a' && c <= 'f')
+    return c - 'a' + 10;
+  else
+    return -1;
+}
+
+#define INT_ERRMSG "int_of_string"
+#define INT32_ERRMSG "Int32.of_string"
+#define INT64_ERRMSG "Int64.of_string"
+#define INTNAT_ERRMSG "Nativeint.of_string"
+
+static intnat parse_intnat(value s, int nbits, const char *errmsg)
+{
+  const char * p;
+  uintnat res, threshold;
+  int sign, base, signedness, d;
+
+  p = parse_sign_and_base(String_val(s), &base, &signedness, &sign);
+  threshold = ((uintnat) -1) / base;
+  d = parse_digit(*p);
+  if (d < 0 || d >= base) caml_failwith(errmsg);
+  for (p++, res = d; /*nothing*/; p++) {
+    char c = *p;
+    if (c == '_') continue;
+    d = parse_digit(c);
+    if (d < 0 || d >= base) break;
+    /* Detect overflow in multiplication base * res */
+    if (res > threshold) caml_failwith(errmsg);
+    res = base * res + d;
+    /* Detect overflow in addition (base * res) + d */
+    if (res < (uintnat) d) caml_failwith(errmsg);
+  }
+  if (p != String_val(s) + caml_string_length(s)){
+    caml_failwith(errmsg);
+  }
+  if (signedness) {
+    /* Signed representation expected, allow -2^(nbits-1) to 2^(nbits-1) - 1 */
+    if (sign >= 0) {
+      if (res >= (uintnat)1 << (nbits - 1)) caml_failwith(errmsg);
+    } else {
+      if (res >  (uintnat)1 << (nbits - 1)) caml_failwith(errmsg);
+    }
+  } else {
+    /* Unsigned representation expected, allow 0 to 2^nbits - 1
+       and tolerate -(2^nbits - 1) to 0 */
+    if (nbits < sizeof(uintnat) * 8 && res >= (uintnat)1 << nbits)
+      caml_failwith(errmsg);
+  }
+  return sign < 0 ? -((intnat) res) : (intnat) res;
+}
+
+value caml_bswap16_direct(value x)
+{
+  return ((((x & 0x00FF) << 8) |
+           ((x & 0xFF00) >> 8)));
+}
+
+CAMLprim value caml_bswap16(value v)
+{
+  intnat x = Int_val(v);
+  return (Val_int ((((x & 0x00FF) << 8) |
+                    ((x & 0xFF00) >> 8))));
+}
+
+/* Tagged integers */
+
+CAMLprim value caml_int_compare(value v1, value v2)
+{
+  return Val_long(COMPARE_INT(v1, v2));
+}
+
+CAMLprim value caml_int_of_string(value s)
+{
+    return Val_long(parse_intnat(s, 8 * sizeof(value) - 1, INT_ERRMSG));
+}
+
+#define FORMAT_BUFFER_SIZE 32
+
+static char parse_format(value fmt,
+                         char * suffix,
+                         char format_string[FORMAT_BUFFER_SIZE])
+{
+  char * p;
+  char lastletter;
+  mlsize_t len, len_suffix;
+
+  /* Copy OCaml format fmt to format_string,
+     adding the suffix before the last letter of the format */
+  len = caml_string_length(fmt);
+  len_suffix = strlen(suffix);
+  if (len + len_suffix + 1 >= FORMAT_BUFFER_SIZE)
+    caml_invalid_argument("format_int: format too long");
+  memmove(format_string, String_val(fmt), len);
+  p = format_string + len - 1;
+  lastletter = *p;
+  /* Compress two-letter formats, ignoring the [lnL] annotation */
+  if (p[-1] == 'l' || p[-1] == 'n' || p[-1] == 'L') p--;
+  memmove(p, suffix, len_suffix);  p += len_suffix;
+  *p++ = lastletter;
+  *p = 0;
+  /* Return the conversion type (last letter) */
+  return lastletter;
+}
+
+CAMLprim value caml_format_int(value fmt, value arg)
+{
+  char format_string[FORMAT_BUFFER_SIZE];
+  char conv;
+  value res;
+
+  conv = parse_format(fmt, ARCH_INTNAT_PRINTF_FORMAT, format_string);
+  switch (conv) {
+  case 'u': case 'x': case 'X': case 'o':
+    res = caml_alloc_sprintf(format_string, Unsigned_long_val(arg));
+    break;
+  default:
+    res = caml_alloc_sprintf(format_string, Long_val(arg));
+    break;
+  }
+  return res;
+}
+
+/* 32-bit integers */
+
+static int int32_cmp(value v1, value v2)
+{
+  int32_t i1 = Int32_val(v1);
+  int32_t i2 = Int32_val(v2);
+  return (i1 > i2) - (i1 < i2);
+}
+
+static intnat int32_hash(value v)
+{
+  return Int32_val(v);
+}
+
+static void int32_serialize(value v, uintnat * bsize_32,
+                            uintnat * bsize_64)
+{
+  caml_serialize_int_4(Int32_val(v));
+  *bsize_32 = *bsize_64 = 4;
+}
+
+static uintnat int32_deserialize(void * dst)
+{
+  *((int32_t *) dst) = caml_deserialize_sint_4();
+  return 4;
+}
+
+static const struct custom_fixed_length int32_length = { 4, 4 };
+
+CAMLexport struct custom_operations caml_int32_ops = {
+  "_i",
+  custom_finalize_default,
+  int32_cmp,
+  int32_hash,
+  int32_serialize,
+  int32_deserialize,
+  custom_compare_ext_default,
+  &int32_length
+};
+
+CAMLexport value caml_copy_int32(int32_t i)
+{
+  value res = caml_alloc_custom(&caml_int32_ops, 4, 0, 1);
+  Int32_val(res) = i;
+  return res;
+}
+
+CAMLprim value caml_int32_neg(value v)
+{ return caml_copy_int32(- Int32_val(v)); }
+
+CAMLprim value caml_int32_add(value v1, value v2)
+{ return caml_copy_int32(Int32_val(v1) + Int32_val(v2)); }
+
+CAMLprim value caml_int32_sub(value v1, value v2)
+{ return caml_copy_int32(Int32_val(v1) - Int32_val(v2)); }
+
+CAMLprim value caml_int32_mul(value v1, value v2)
+{ return caml_copy_int32(Int32_val(v1) * Int32_val(v2)); }
+
+CAMLprim value caml_int32_div(value v1, value v2)
+{
+  int32_t dividend = Int32_val(v1);
+  int32_t divisor = Int32_val(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;
+  return caml_copy_int32(dividend / divisor);
+}
+
+CAMLprim value caml_int32_mod(value v1, value v2)
+{
+  int32_t dividend = Int32_val(v1);
+  int32_t divisor = Int32_val(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);
+  return caml_copy_int32(dividend % divisor);
+}
+
+CAMLprim value caml_int32_and(value v1, value v2)
+{ return caml_copy_int32(Int32_val(v1) & Int32_val(v2)); }
+
+CAMLprim value caml_int32_or(value v1, value v2)
+{ return caml_copy_int32(Int32_val(v1) | Int32_val(v2)); }
+
+CAMLprim value caml_int32_xor(value v1, value v2)
+{ return caml_copy_int32(Int32_val(v1) ^ Int32_val(v2)); }
+
+CAMLprim value caml_int32_shift_left(value v1, value v2)
+{ return caml_copy_int32(Int32_val(v1) << Int_val(v2)); }
+
+CAMLprim value caml_int32_shift_right(value v1, value v2)
+{ return caml_copy_int32(Int32_val(v1) >> Int_val(v2)); }
+
+CAMLprim value caml_int32_shift_right_unsigned(value v1, value v2)
+{ return caml_copy_int32((uint32_t)Int32_val(v1) >> Int_val(v2)); }
+
+static int32_t caml_swap32(int32_t x)
+{
+  return (((x & 0x000000FF) << 24) |
+          ((x & 0x0000FF00) << 8) |
+          ((x & 0x00FF0000) >> 8) |
+          ((x & 0xFF000000) >> 24));
+}
+
+value caml_int32_direct_bswap(value v)
+{ return caml_swap32((int32_t) v); }
+
+CAMLprim value caml_int32_bswap(value v)
+{ return caml_copy_int32(caml_swap32(Int32_val(v))); }
+
+CAMLprim value caml_int32_of_int(value v)
+{ return caml_copy_int32((int32_t) Long_val(v)); }
+
+CAMLprim value caml_int32_to_int(value v)
+{ return Val_long(Int32_val(v)); }
+
+int32_t caml_int32_of_float_unboxed(double x)
+{ return (int32_t) x; }
+
+CAMLprim value caml_int32_of_float(value v)
+{ return caml_copy_int32((int32_t)(Double_val(v))); }
+
+double caml_int32_to_float_unboxed(int32_t x)
+{ return (double) x; }
+
+CAMLprim value caml_int32_to_float(value v)
+{ return caml_copy_double((double)(Int32_val(v))); }
+
+intnat caml_int32_compare_unboxed(int32_t i1, int32_t i2)
+{
+  return COMPARE_INT(i1, i2);
+}
+
+CAMLprim value caml_int32_compare(value v1, value v2)
+{
+  return Val_int(caml_int32_compare_unboxed(Int32_val(v1),Int32_val(v2)));
+}
+
+CAMLprim value caml_int32_format(value fmt, value arg)
+{
+  char format_string[FORMAT_BUFFER_SIZE];
+
+  parse_format(fmt, ARCH_INT32_PRINTF_FORMAT, format_string);
+  return caml_alloc_sprintf(format_string, Int32_val(arg));
+}
+
+CAMLprim value caml_int32_of_string(value s)
+{
+  return caml_copy_int32((int32_t) parse_intnat(s, 32, INT32_ERRMSG));
+}
+
+int32_t caml_int32_bits_of_float_unboxed(double d)
+{
+  union { float f; int32_t i; } u;
+  u.f = (float) d;
+  return u.i;
+}
+
+double caml_int32_float_of_bits_unboxed(int32_t i)
+{
+  union { float f; int32_t i; } u;
+  u.i = i;
+  return (double) u.f;
+}
+
+CAMLprim value caml_int32_bits_of_float(value vd)
+{
+  return caml_copy_int32(caml_int32_bits_of_float_unboxed(Double_val(vd)));
+}
+
+CAMLprim value caml_int32_float_of_bits(value vi)
+{
+  return caml_copy_double(caml_int32_float_of_bits_unboxed(Int32_val(vi)));
+}
+
+/* 64-bit integers */
+
+#ifdef ARCH_ALIGN_INT64
+
+CAMLexport int64_t caml_Int64_val(value v)
+{
+  union { int32_t i[2]; int64_t j; } buffer;
+  buffer.i[0] = ((int32_t *) Data_custom_val(v))[0];
+  buffer.i[1] = ((int32_t *) Data_custom_val(v))[1];
+  return buffer.j;
+}
+
+#endif
+
+static int int64_cmp(value v1, value v2)
+{
+  int64_t i1 = Int64_val(v1);
+  int64_t i2 = Int64_val(v2);
+  return (i1 > i2) - (i1 < i2);
+}
+
+static intnat int64_hash(value v)
+{
+  int64_t x = Int64_val(v);
+  uint32_t lo = (uint32_t) x, hi = (uint32_t) (x >> 32);
+  return hi ^ lo;
+}
+
+static void int64_serialize(value v, uintnat * bsize_32,
+                            uintnat * bsize_64)
+{
+  caml_serialize_int_8(Int64_val(v));
+  *bsize_32 = *bsize_64 = 8;
+}
+
+static uintnat int64_deserialize(void * dst)
+{
+#ifndef ARCH_ALIGN_INT64
+  *((int64_t *) dst) = caml_deserialize_sint_8();
+#else
+  union { int32_t i[2]; int64_t j; } buffer;
+  buffer.j = caml_deserialize_sint_8();
+  ((int32_t *) dst)[0] = buffer.i[0];
+  ((int32_t *) dst)[1] = buffer.i[1];
+#endif
+  return 8;
+}
+
+static const struct custom_fixed_length int64_length = { 8, 8 };
+
+CAMLexport struct custom_operations caml_int64_ops = {
+  "_j",
+  custom_finalize_default,
+  int64_cmp,
+  int64_hash,
+  int64_serialize,
+  int64_deserialize,
+  custom_compare_ext_default,
+  &int64_length
+};
+
+CAMLexport value caml_copy_int64(int64_t i)
+{
+  value res = caml_alloc_custom(&caml_int64_ops, 8, 0, 1);
+#ifndef ARCH_ALIGN_INT64
+  Int64_val(res) = i;
+#else
+  union { int32_t i[2]; int64_t j; } buffer;
+  buffer.j = i;
+  ((int32_t *) Data_custom_val(res))[0] = buffer.i[0];
+  ((int32_t *) Data_custom_val(res))[1] = buffer.i[1];
+#endif
+  return res;
+}
+
+#define CAMLprim_int64_1(name)                                          \
+  CAMLprim int64_t caml_int64_##name##_native(int64_t);                 \
+                                                                        \
+  CAMLprim value caml_int64_##name(value v)                             \
+  { return caml_copy_int64(caml_int64_##name##_native(Int64_val(v))); } \
+                                                                        \
+  CAMLprim int64_t caml_int64_##name##_native
+
+#define CAMLprim_int64_2(name)                                          \
+  CAMLprim int64_t caml_int64_##name##_native(int64_t, int64_t);        \
+                                                                        \
+  CAMLprim value caml_int64_##name(value v1, value v2)                  \
+  { return caml_copy_int64(caml_int64_##name##_native(Int64_val(v1),    \
+                                                      Int64_val(v2))); } \
+                                                                        \
+  CAMLprim int64_t caml_int64_##name##_native
+
+CAMLprim_int64_1(neg)(int64_t i)
+{ return -i; }
+
+CAMLprim_int64_2(add)(int64_t i1, int64_t i2)
+{ return i1 + i2; }
+
+CAMLprim_int64_2(sub)(int64_t i1, int64_t i2)
+{ return i1 - i2; }
+
+CAMLprim_int64_2(mul)(int64_t i1, int64_t i2)
+{ return i1 * i2; }
+
+CAMLprim_int64_2(div)(int64_t dividend, int64_t divisor)
+{
+  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 dividend;
+  return dividend / divisor;
+}
+
+CAMLprim_int64_2(mod)(int64_t dividend, int64_t divisor)
+{
+  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 0;
+  return dividend % divisor;
+}
+
+CAMLprim_int64_2(and)(int64_t i1, int64_t i2)
+{ return i1 & i2; }
+
+CAMLprim_int64_2(or)(int64_t i1, int64_t i2)
+{ return i1 | i2; }
+
+CAMLprim_int64_2(xor)(int64_t i1, int64_t i2)
+{ return i1 ^ i2; }
+
+CAMLprim value caml_int64_shift_left(value v1, value v2)
+{ return caml_copy_int64(Int64_val(v1) << Int_val(v2)); }
+
+CAMLprim value caml_int64_shift_right(value v1, value v2)
+{ return caml_copy_int64(Int64_val(v1) >> Int_val(v2)); }
+
+CAMLprim value caml_int64_shift_right_unsigned(value v1, value v2)
+{ return caml_copy_int64((uint64_t) (Int64_val(v1)) >>  Int_val(v2)); }
+
+#ifdef ARCH_SIXTYFOUR
+static value caml_swap64(value x)
+{
+  return (((((x) & 0x00000000000000FF) << 56) |
+           (((x) & 0x000000000000FF00) << 40) |
+           (((x) & 0x0000000000FF0000) << 24) |
+           (((x) & 0x00000000FF000000) << 8) |
+           (((x) & 0x000000FF00000000) >> 8) |
+           (((x) & 0x0000FF0000000000) >> 24) |
+           (((x) & 0x00FF000000000000) >> 40) |
+           (((x) & 0xFF00000000000000) >> 56)));
+}
+
+value caml_int64_direct_bswap(value v)
+{ return caml_swap64(v); }
+#endif
+
+CAMLprim value caml_int64_bswap(value v)
+{
+  int64_t x = Int64_val(v);
+  return caml_copy_int64
+    (((x & INT64_LITERAL(0x00000000000000FFU)) << 56) |
+     ((x & INT64_LITERAL(0x000000000000FF00U)) << 40) |
+     ((x & INT64_LITERAL(0x0000000000FF0000U)) << 24) |
+     ((x & INT64_LITERAL(0x00000000FF000000U)) << 8) |
+     ((x & INT64_LITERAL(0x000000FF00000000U)) >> 8) |
+     ((x & INT64_LITERAL(0x0000FF0000000000U)) >> 24) |
+     ((x & INT64_LITERAL(0x00FF000000000000U)) >> 40) |
+     ((x & INT64_LITERAL(0xFF00000000000000U)) >> 56));
+}
+
+CAMLprim value caml_int64_of_int(value v)
+{ return caml_copy_int64((int64_t) (Long_val(v))); }
+
+CAMLprim value caml_int64_to_int(value v)
+{ return Val_long((intnat) (Int64_val(v))); }
+
+int64_t caml_int64_of_float_unboxed(double x)
+{ return (int64_t) x; }
+
+CAMLprim value caml_int64_of_float(value v)
+{ return caml_copy_int64((int64_t) (Double_val(v))); }
+
+double caml_int64_to_float_unboxed(int64_t x)
+{ return (double) x; }
+
+CAMLprim value caml_int64_to_float(value v)
+{ return caml_copy_double((double) (Int64_val(v))); }
+
+CAMLprim value caml_int64_of_int32(value v)
+{ return caml_copy_int64((int64_t) (Int32_val(v))); }
+
+CAMLprim value caml_int64_to_int32(value v)
+{ return caml_copy_int32((int32_t) (Int64_val(v))); }
+
+CAMLprim value caml_int64_of_nativeint(value v)
+{ return caml_copy_int64((int64_t) (Nativeint_val(v))); }
+
+CAMLprim value caml_int64_to_nativeint(value v)
+{ return caml_copy_nativeint((intnat) (Int64_val(v))); }
+
+intnat caml_int64_compare_unboxed(int64_t i1, int64_t i2)
+{
+  return COMPARE_INT(i1, i2);
+}
+
+CAMLprim value caml_int64_compare(value v1, value v2)
+{
+  return Val_int(caml_int64_compare_unboxed(Int64_val(v1),Int64_val(v2)));
+}
+
+CAMLprim value caml_int64_format(value fmt, value arg)
+{
+  char format_string[FORMAT_BUFFER_SIZE];
+
+  parse_format(fmt, ARCH_INT64_PRINTF_FORMAT, format_string);
+  return caml_alloc_sprintf(format_string, Int64_val(arg));
+}
+
+CAMLprim value caml_int64_of_string(value s)
+{
+  const char * p;
+  uint64_t res, threshold;
+  int sign, base, signedness, d;
+
+  p = parse_sign_and_base(String_val(s), &base, &signedness, &sign);
+  threshold = ((uint64_t) -1) / base;
+  d = parse_digit(*p);
+  if (d < 0 || d >= base) caml_failwith(INT64_ERRMSG);
+  res = d;
+  for (p++; /*nothing*/; p++) {
+    char c = *p;
+    if (c == '_') continue;
+    d = parse_digit(c);
+    if (d < 0 || d >= base) break;
+    /* Detect overflow in multiplication base * res */
+    if (res > threshold) caml_failwith(INT64_ERRMSG);
+    res = base * res + d;
+    /* Detect overflow in addition (base * res) + d */
+    if (res < (uint64_t) d) caml_failwith(INT64_ERRMSG);
+  }
+  if (p != String_val(s) + caml_string_length(s)){
+    caml_failwith(INT64_ERRMSG);
+  }
+  if (signedness) {
+    /* Signed representation expected, allow -2^63 to 2^63 - 1 only */
+    if (sign >= 0) {
+      if (res >= (uint64_t)1 << 63) caml_failwith(INT64_ERRMSG);
+    } else {
+      if (res >  (uint64_t)1 << 63) caml_failwith(INT64_ERRMSG);
+    }
+  }
+  if (sign < 0) res = - res;
+  return caml_copy_int64(res);
+}
+
+int64_t caml_int64_bits_of_float_unboxed(double d)
+{
+  union { double d; int64_t i; int32_t h[2]; } u;
+  u.d = d;
+#if defined(__arm__) && !defined(__ARM_EABI__)
+  { int32_t t = u.h[0]; u.h[0] = u.h[1]; u.h[1] = t; }
+#endif
+  return u.i;
+}
+
+double caml_int64_float_of_bits_unboxed(int64_t i)
+{
+  union { double d; int64_t i; int32_t h[2]; } u;
+  u.i = i;
+#if defined(__arm__) && !defined(__ARM_EABI__)
+  { int32_t t = u.h[0]; u.h[0] = u.h[1]; u.h[1] = t; }
+#endif
+  return u.d;
+}
+
+CAMLprim value caml_int64_bits_of_float(value vd)
+{
+  return caml_copy_int64(caml_int64_bits_of_float_unboxed(Double_val(vd)));
+}
+
+CAMLprim value caml_int64_float_of_bits(value vi)
+{
+  return caml_copy_double(caml_int64_float_of_bits_unboxed(Int64_val(vi)));
+}
+
+/* Native integers */
+
+static int nativeint_cmp(value v1, value v2)
+{
+  intnat i1 = Nativeint_val(v1);
+  intnat i2 = Nativeint_val(v2);
+  return (i1 > i2) - (i1 < i2);
+}
+
+static intnat nativeint_hash(value v)
+{
+  intnat n = Nativeint_val(v);
+#ifdef ARCH_SIXTYFOUR
+  /* 32/64 bits compatibility trick.  See explanations in file "hash.c",
+     function caml_hash_mix_intnat. */
+  return (n >> 32) ^ (n >> 63) ^ n;
+#else
+  return n;
+#endif
+}
+
+static void nativeint_serialize(value v, uintnat * bsize_32,
+                                uintnat * bsize_64)
+{
+  intnat l = Nativeint_val(v);
+#ifdef ARCH_SIXTYFOUR
+  if (l >= -((intnat)1 << 31) && l < ((intnat)1 << 31)) {
+    caml_serialize_int_1(1);
+    caml_serialize_int_4((int32_t) l);
+  } else {
+    caml_serialize_int_1(2);
+    caml_serialize_int_8(l);
+  }
+#else
+  caml_serialize_int_1(1);
+  caml_serialize_int_4(l);
+#endif
+  *bsize_32 = 4;
+  *bsize_64 = 8;
+}
+
+static uintnat nativeint_deserialize(void * dst)
+{
+  switch (caml_deserialize_uint_1()) {
+  case 1:
+    *((intnat *) dst) = caml_deserialize_sint_4();
+    break;
+  case 2:
+#ifdef ARCH_SIXTYFOUR
+    *((intnat *) dst) = caml_deserialize_sint_8();
+#else
+    caml_deserialize_error("input_value: native integer value too large");
+#endif
+    break;
+  default:
+    caml_deserialize_error("input_value: ill-formed native integer");
+  }
+  return sizeof(intnat);
+}
+
+static const struct custom_fixed_length nativeint_length = { 4, 8 };
+CAMLexport struct custom_operations caml_nativeint_ops = {
+  "_n",
+  custom_finalize_default,
+  nativeint_cmp,
+  nativeint_hash,
+  nativeint_serialize,
+  nativeint_deserialize,
+  custom_compare_ext_default,
+  &nativeint_length
+};
+
+CAMLexport value caml_copy_nativeint(intnat i)
+{
+  value res = caml_alloc_custom(&caml_nativeint_ops, sizeof(intnat), 0, 1);
+  Nativeint_val(res) = i;
+  return res;
+}
+
+CAMLprim value caml_nativeint_neg(value v)
+{ return caml_copy_nativeint(- Nativeint_val(v)); }
+
+CAMLprim value caml_nativeint_add(value v1, value v2)
+{ return caml_copy_nativeint(Nativeint_val(v1) + Nativeint_val(v2)); }
+
+CAMLprim value caml_nativeint_sub(value v1, value v2)
+{ return caml_copy_nativeint(Nativeint_val(v1) - Nativeint_val(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);
+  intnat divisor = Nativeint_val(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;
+  return caml_copy_nativeint(dividend / divisor);
+}
+
+CAMLprim value caml_nativeint_mod(value v1, value v2)
+{
+  intnat dividend = Nativeint_val(v1);
+  intnat divisor = Nativeint_val(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 caml_copy_nativeint(0);
+  }
+  return caml_copy_nativeint(dividend % divisor);
+}
+
+CAMLprim value caml_nativeint_and(value v1, value v2)
+{ return caml_copy_nativeint(Nativeint_val(v1) & Nativeint_val(v2)); }
+
+CAMLprim value caml_nativeint_or(value v1, value v2)
+{ return caml_copy_nativeint(Nativeint_val(v1) | Nativeint_val(v2)); }
+
+CAMLprim value caml_nativeint_xor(value v1, value v2)
+{ return caml_copy_nativeint(Nativeint_val(v1) ^ Nativeint_val(v2)); }
+
+CAMLprim value caml_nativeint_shift_left(value v1, value v2)
+{ return caml_copy_nativeint(Nativeint_val(v1) << Int_val(v2)); }
+
+CAMLprim value caml_nativeint_shift_right(value v1, value v2)
+{ return caml_copy_nativeint(Nativeint_val(v1) >> Int_val(v2)); }
+
+CAMLprim value caml_nativeint_shift_right_unsigned(value v1, value v2)
+{ return caml_copy_nativeint((uintnat)Nativeint_val(v1) >> Int_val(v2)); }
+
+value caml_nativeint_direct_bswap(value v)
+{
+#ifdef ARCH_SIXTYFOUR
+  return caml_swap64(v);
+#else
+  return caml_swap32(v);
+#endif
+}
+
+CAMLprim value caml_nativeint_bswap(value v)
+{
+#ifdef ARCH_SIXTYFOUR
+  return caml_copy_nativeint(caml_swap64(Nativeint_val(v)));
+#else
+  return caml_copy_nativeint(caml_swap32(Nativeint_val(v)));
+#endif
+}
+
+CAMLprim value caml_nativeint_of_int(value v)
+{ return caml_copy_nativeint(Long_val(v)); }
+
+CAMLprim value caml_nativeint_to_int(value v)
+{ return Val_long(Nativeint_val(v)); }
+
+intnat caml_nativeint_of_float_unboxed(double x)
+{ return (intnat) x; }
+
+CAMLprim value caml_nativeint_of_float(value v)
+{ return caml_copy_nativeint((intnat)(Double_val(v))); }
+
+double caml_nativeint_to_float_unboxed(intnat x)
+{ return (double) x; }
+
+CAMLprim value caml_nativeint_to_float(value v)
+{ return caml_copy_double((double)(Nativeint_val(v))); }
+
+CAMLprim value caml_nativeint_of_int32(value v)
+{ return caml_copy_nativeint(Int32_val(v)); }
+
+CAMLprim value caml_nativeint_to_int32(value v)
+{ return caml_copy_int32((int32_t) Nativeint_val(v)); }
+
+intnat caml_nativeint_compare_unboxed(intnat i1, intnat i2)
+{
+  return COMPARE_INT(i1, i2);
+}
+
+CAMLprim value caml_nativeint_compare(value v1, value v2)
+{
+  return Val_int(caml_nativeint_compare_unboxed(Nativeint_val(v1),
+                                                Nativeint_val(v2)));
+}
+
+CAMLprim value caml_nativeint_format(value fmt, value arg)
+{
+  char format_string[FORMAT_BUFFER_SIZE];
+
+  parse_format(fmt, ARCH_INTNAT_PRINTF_FORMAT, format_string);
+  return caml_alloc_sprintf(format_string, Nativeint_val(arg));
+}
+
+CAMLprim value caml_nativeint_of_string(value s)
+{
+  return caml_copy_nativeint(parse_intnat(s, 8 * sizeof(value), INTNAT_ERRMSG));
+}
diff --git a/runtime/io.c b/runtime/io.c
new file mode 100644
index 00000000..90a1aa64
--- /dev/null
+++ b/runtime/io.c
@@ -0,0 +1,835 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* Buffered input/output. */
+
+#include <errno.h>
+#include <fcntl.h>
+#include <limits.h>
+#include <string.h>
+#include <stdio.h>
+#include <sys/types.h>
+#include "caml/config.h"
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#ifdef __CYGWIN__
+#include </usr/include/io.h>
+#endif
+#include "caml/alloc.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/io.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/osdeps.h"
+#include "caml/signals.h"
+#include "caml/sys.h"
+
+#ifndef SEEK_SET
+#define SEEK_SET 0
+#define SEEK_CUR 1
+#define SEEK_END 2
+#endif
+
+#if defined(_WIN32)
+#include <io.h>
+#define lseek _lseeki64
+#endif
+
+
+/* Hooks for locking channels */
+
+CAMLexport void (*caml_channel_mutex_free) (struct channel *) = NULL;
+CAMLexport void (*caml_channel_mutex_lock) (struct channel *) = NULL;
+CAMLexport void (*caml_channel_mutex_unlock) (struct channel *) = NULL;
+CAMLexport void (*caml_channel_mutex_unlock_exn) (void) = NULL;
+
+/* List of opened channels */
+CAMLexport struct channel * caml_all_opened_channels = NULL;
+
+/* Basic functions over type struct channel *.
+   These functions can be called directly from C.
+   No locking is performed. */
+
+/* Functions shared between input and output */
+
+CAMLexport struct channel * caml_open_descriptor_in(int fd)
+{
+  struct channel * channel;
+
+  channel = (struct channel *) caml_stat_alloc(sizeof(struct channel));
+  channel->fd = fd;
+  caml_enter_blocking_section();
+  channel->offset = lseek(fd, 0, SEEK_CUR);
+  caml_leave_blocking_section();
+  channel->curr = channel->max = channel->buff;
+  channel->end = channel->buff + IO_BUFFER_SIZE;
+  channel->mutex = NULL;
+  channel->revealed = 0;
+  channel->old_revealed = 0;
+  channel->refcount = 0;
+  channel->flags = 0;
+  channel->next = caml_all_opened_channels;
+  channel->prev = NULL;
+  channel->name = NULL;
+  if (caml_all_opened_channels != NULL)
+    caml_all_opened_channels->prev = channel;
+  caml_all_opened_channels = channel;
+  return channel;
+}
+
+CAMLexport struct channel * caml_open_descriptor_out(int fd)
+{
+  struct channel * channel;
+
+  channel = caml_open_descriptor_in(fd);
+  channel->max = NULL;
+  return channel;
+}
+
+static void unlink_channel(struct channel *channel)
+{
+  if (channel->prev == NULL) {
+    CAMLassert (channel == caml_all_opened_channels);
+    caml_all_opened_channels = caml_all_opened_channels->next;
+    if (caml_all_opened_channels != NULL)
+      caml_all_opened_channels->prev = NULL;
+  } else {
+    channel->prev->next = channel->next;
+    if (channel->next != NULL) channel->next->prev = channel->prev;
+  }
+}
+
+CAMLexport void caml_close_channel(struct channel *channel)
+{
+  close(channel->fd);
+  if (channel->refcount > 0) return;
+  if (caml_channel_mutex_free != NULL) (*caml_channel_mutex_free)(channel);
+  unlink_channel(channel);
+  caml_stat_free(channel->name);
+  caml_stat_free(channel);
+}
+
+CAMLexport file_offset caml_channel_size(struct channel *channel)
+{
+  file_offset offset;
+  file_offset end;
+  int fd;
+
+  /* We extract data from [channel] before dropping the OCaml lock, in case
+     someone else touches the block. */
+  fd = channel->fd;
+  offset = channel->offset;
+  caml_enter_blocking_section();
+  end = lseek(fd, 0, SEEK_END);
+  if (end == -1 || lseek(fd, offset, SEEK_SET) != offset) {
+    caml_leave_blocking_section();
+    caml_sys_error(NO_ARG);
+  }
+  caml_leave_blocking_section();
+  return end;
+}
+
+CAMLexport int caml_channel_binary_mode(struct channel *channel)
+{
+#if defined(_WIN32) || defined(__CYGWIN__)
+  int oldmode = setmode(channel->fd, O_BINARY);
+  if (oldmode == O_TEXT) setmode(channel->fd, O_TEXT);
+  return oldmode == O_BINARY;
+#else
+  return 1;
+#endif
+}
+
+/* Output */
+
+/* Attempt to flush the buffer. This will make room in the buffer for
+   at least one character. Returns true if the buffer is empty at the
+   end of the flush, or false if some data remains in the buffer.
+ */
+
+CAMLexport int caml_flush_partial(struct channel *channel)
+{
+  int towrite, written;
+
+  towrite = channel->curr - channel->buff;
+  CAMLassert (towrite >= 0);
+  if (towrite > 0) {
+    written = caml_write_fd(channel->fd, channel->flags,
+                            channel->buff, towrite);
+    channel->offset += written;
+    if (written < towrite)
+      memmove(channel->buff, channel->buff + written, towrite - written);
+    channel->curr -= written;
+  }
+  return (channel->curr == channel->buff);
+}
+
+/* Flush completely the buffer. */
+
+CAMLexport void caml_flush(struct channel *channel)
+{
+  while (! caml_flush_partial(channel)) /*nothing*/;
+}
+
+/* Output data */
+
+CAMLexport void caml_putword(struct channel *channel, uint32_t w)
+{
+  if (! caml_channel_binary_mode(channel))
+    caml_failwith("output_binary_int: not a binary channel");
+  caml_putch(channel, w >> 24);
+  caml_putch(channel, w >> 16);
+  caml_putch(channel, w >> 8);
+  caml_putch(channel, w);
+}
+
+CAMLexport int caml_putblock(struct channel *channel, char *p, intnat len)
+{
+  int n, free, towrite, written;
+
+  n = len >= INT_MAX ? INT_MAX : (int) len;
+  free = channel->end - channel->curr;
+  if (n < free) {
+    /* Write request small enough to fit in buffer: transfer to buffer. */
+    memmove(channel->curr, p, n);
+    channel->curr += n;
+    return n;
+  } else {
+    /* Write request overflows buffer (or just fills it up): transfer whatever
+       fits to buffer and write the buffer */
+    memmove(channel->curr, p, free);
+    towrite = channel->end - channel->buff;
+    written = caml_write_fd(channel->fd, channel->flags,
+                            channel->buff, towrite);
+    if (written < towrite)
+      memmove(channel->buff, channel->buff + written, towrite - written);
+    channel->offset += written;
+    channel->curr = channel->end - written;
+    return free;
+  }
+}
+
+CAMLexport void caml_really_putblock(struct channel *channel,
+                                     char *p, intnat len)
+{
+  int written;
+  while (len > 0) {
+    written = caml_putblock(channel, p, len);
+    p += written;
+    len -= written;
+  }
+}
+
+CAMLexport void caml_seek_out(struct channel *channel, file_offset dest)
+{
+  caml_flush(channel);
+  caml_enter_blocking_section();
+  if (lseek(channel->fd, dest, SEEK_SET) != dest) {
+    caml_leave_blocking_section();
+    caml_sys_error(NO_ARG);
+  }
+  caml_leave_blocking_section();
+  channel->offset = dest;
+}
+
+CAMLexport file_offset caml_pos_out(struct channel *channel)
+{
+  return channel->offset + (file_offset)(channel->curr - channel->buff);
+}
+
+/* Input */
+
+/* caml_do_read is exported for Cash */
+CAMLexport int caml_do_read(int fd, char *p, unsigned int n)
+{
+  return caml_read_fd(fd, 0, p, n);
+}
+
+CAMLexport unsigned char caml_refill(struct channel *channel)
+{
+  int n;
+
+  n = caml_read_fd(channel->fd, channel->flags,
+                   channel->buff, channel->end - channel->buff);
+  if (n == 0) caml_raise_end_of_file();
+  channel->offset += n;
+  channel->max = channel->buff + n;
+  channel->curr = channel->buff + 1;
+  return (unsigned char)(channel->buff[0]);
+}
+
+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++) {
+    res = (res << 8) + caml_getch(channel);
+  }
+  return res;
+}
+
+CAMLexport int caml_getblock(struct channel *channel, char *p, intnat len)
+{
+  int n, avail, nread;
+
+  n = len >= INT_MAX ? INT_MAX : (int) len;
+  avail = channel->max - channel->curr;
+  if (n <= avail) {
+    memmove(p, channel->curr, n);
+    channel->curr += n;
+    return n;
+  } else if (avail > 0) {
+    memmove(p, channel->curr, avail);
+    channel->curr += avail;
+    return avail;
+  } else {
+    nread = caml_read_fd(channel->fd, channel->flags, channel->buff,
+                         channel->end - channel->buff);
+    channel->offset += nread;
+    channel->max = channel->buff + nread;
+    if (n > nread) n = nread;
+    memmove(p, channel->buff, n);
+    channel->curr = channel->buff + n;
+    return n;
+  }
+}
+
+/* Returns the number of bytes read. */
+CAMLexport intnat caml_really_getblock(struct channel *chan, char *p, intnat n)
+{
+  intnat k = n;
+  int r;
+  while (k > 0) {
+    r = caml_getblock(chan, p, k);
+    if (r == 0) break;
+    p += r;
+    k -= r;
+  }
+  return n - k;
+}
+
+CAMLexport void caml_seek_in(struct channel *channel, file_offset dest)
+{
+  if (dest >= channel->offset - (channel->max - channel->buff) &&
+      dest <= channel->offset) {
+    channel->curr = channel->max - (channel->offset - dest);
+  } else {
+    caml_enter_blocking_section();
+    if (lseek(channel->fd, dest, SEEK_SET) != dest) {
+      caml_leave_blocking_section();
+      caml_sys_error(NO_ARG);
+    }
+    caml_leave_blocking_section();
+    channel->offset = dest;
+    channel->curr = channel->max = channel->buff;
+  }
+}
+
+CAMLexport file_offset caml_pos_in(struct channel *channel)
+{
+  return channel->offset - (file_offset)(channel->max - channel->curr);
+}
+
+CAMLexport intnat caml_input_scan_line(struct channel *channel)
+{
+  char * p;
+  int n;
+
+  p = channel->curr;
+  do {
+    if (p >= channel->max) {
+      /* No more characters available in the buffer */
+      if (channel->curr > channel->buff) {
+        /* Try to make some room in the buffer by shifting the unread
+           portion at the beginning */
+        memmove(channel->buff, channel->curr, channel->max - channel->curr);
+        n = channel->curr - channel->buff;
+        channel->curr -= n;
+        channel->max -= n;
+        p -= n;
+      }
+      if (channel->max >= channel->end) {
+        /* Buffer is full, no room to read more characters from the input.
+           Return the number of characters in the buffer, with negative
+           sign to indicate that no newline was encountered. */
+        return -(channel->max - channel->curr);
+      }
+      /* Fill the buffer as much as possible */
+      n = caml_read_fd(channel->fd, channel->flags,
+                       channel->max, channel->end - channel->max);
+      if (n == 0) {
+        /* End-of-file encountered. Return the number of characters in the
+           buffer, with negative sign since we haven't encountered
+           a newline. */
+        return -(channel->max - channel->curr);
+      }
+      channel->offset += n;
+      channel->max += n;
+    }
+  } while (*p++ != '\n');
+  /* Found a newline. Return the length of the line, newline included. */
+  return (p - channel->curr);
+}
+
+/* OCaml entry points for the I/O functions.  Wrap struct channel *
+   objects into a heap-allocated object.  Perform locking
+   and unlocking around the I/O operations. */
+
+/* FIXME CAMLexport, but not in io.h  exported for Cash ? */
+CAMLexport void caml_finalize_channel(value vchan)
+{
+  struct channel * chan = Channel(vchan);
+  if ((chan->flags & CHANNEL_FLAG_MANAGED_BY_GC) == 0) return;
+  if (--chan->refcount > 0) return;
+  if (caml_channel_mutex_free != NULL) (*caml_channel_mutex_free)(chan);
+
+  if (chan->fd != -1 && chan->name && caml_runtime_warnings_active())
+    fprintf(stderr,
+            "[ocaml] channel opened on file '%s' dies without being closed\n",
+            chan->name
+            );
+
+  if (chan->max == NULL && chan->curr != chan->buff){
+    /*
+      This is an unclosed out channel (chan->max == NULL) with a
+      non-empty buffer: keep it around so the OCaml [at_exit] function
+      gets a chance to flush it.  We would want to simply flush the
+      channel now, but (i) flushing can raise exceptions, and (ii) it
+      is potentially a blocking operation.  Both are forbidden in a
+      finalization function.
+
+      Refs:
+      http://caml.inria.fr/mantis/view.php?id=6902
+      https://github.com/ocaml/ocaml/pull/210
+    */
+    if (chan->name && caml_runtime_warnings_active())
+      fprintf(stderr,
+              "[ocaml] (moreover, it has unflushed data)\n"
+              );
+  } else {
+    unlink_channel(chan);
+    caml_stat_free(chan->name);
+    caml_stat_free(chan);
+  }
+}
+
+static int compare_channel(value vchan1, value vchan2)
+{
+  struct channel * chan1 = Channel(vchan1);
+  struct channel * chan2 = Channel(vchan2);
+  return (chan1 == chan2) ? 0 : (chan1 < chan2) ? -1 : 1;
+}
+
+static intnat hash_channel(value vchan)
+{
+  return (intnat) (Channel(vchan));
+}
+
+static struct custom_operations channel_operations = {
+  "_chan",
+  caml_finalize_channel,
+  compare_channel,
+  hash_channel,
+  custom_serialize_default,
+  custom_deserialize_default,
+  custom_compare_ext_default,
+  custom_fixed_length_default
+};
+
+CAMLexport value caml_alloc_channel(struct channel *chan)
+{
+  value res;
+  chan->refcount++;             /* prevent finalization during next alloc */
+  res = caml_alloc_custom_mem(&channel_operations, sizeof(struct channel *),
+                              sizeof(struct channel));
+  Channel(res) = chan;
+  return res;
+}
+
+CAMLprim value caml_ml_open_descriptor_in(value fd)
+{
+  struct channel * chan = caml_open_descriptor_in(Int_val(fd));
+  chan->flags |= CHANNEL_FLAG_MANAGED_BY_GC;
+  return caml_alloc_channel(chan);
+}
+
+CAMLprim value caml_ml_open_descriptor_out(value fd)
+{
+  struct channel * chan = caml_open_descriptor_out(Int_val(fd));
+  chan->flags |= CHANNEL_FLAG_MANAGED_BY_GC;
+  return caml_alloc_channel(chan);
+}
+
+CAMLprim value caml_ml_set_channel_name(value vchannel, value vname)
+{
+  struct channel * channel = Channel(vchannel);
+  caml_stat_free(channel->name);
+  if (caml_string_length(vname) > 0)
+    channel->name = caml_stat_strdup(String_val(vname));
+  else
+    channel->name = NULL;
+  return Val_unit;
+}
+
+#define Pair_tag 0
+
+CAMLprim value caml_ml_out_channels_list (value unit)
+{
+  CAMLparam0 ();
+  CAMLlocal3 (res, tail, chan);
+  struct channel * channel;
+
+  res = Val_emptylist;
+  for (channel = caml_all_opened_channels;
+       channel != NULL;
+       channel = channel->next)
+    /* Testing channel->fd >= 0 looks unnecessary, as
+       caml_ml_close_channel changes max when setting fd to -1. */
+    if (channel->max == NULL) {
+      chan = caml_alloc_channel (channel);
+      tail = res;
+      res = caml_alloc_small (2, Pair_tag);
+      Field (res, 0) = chan;
+      Field (res, 1) = tail;
+    }
+  CAMLreturn (res);
+}
+
+CAMLprim value caml_channel_descriptor(value vchannel)
+{
+  int fd = Channel(vchannel)->fd;
+  if (fd == -1) { errno = EBADF; caml_sys_error(NO_ARG); }
+  return Val_int(fd);
+}
+
+CAMLprim value caml_ml_close_channel(value vchannel)
+{
+  int result;
+  int do_syscall;
+  int fd;
+
+  /* For output channels, must have flushed before */
+  struct channel * channel = Channel(vchannel);
+  if (channel->fd != -1){
+    fd = channel->fd;
+    channel->fd = -1;
+    do_syscall = 1;
+  }else{
+    do_syscall = 0;
+    result = 0;
+  }
+  /* Ensure that every read or write on the channel will cause an
+     immediate caml_flush_partial or caml_refill, thus raising a Sys_error
+     exception */
+  channel->curr = channel->max = channel->end;
+
+  if (do_syscall) {
+    caml_enter_blocking_section();
+    result = close(fd);
+    caml_leave_blocking_section();
+  }
+
+  if (result == -1) caml_sys_error (NO_ARG);
+  return Val_unit;
+}
+
+/* EOVERFLOW is the Unix98 error indicating that a file position or file
+   size is not representable.
+   ERANGE is the ANSI C error indicating that some argument to some
+   function is out of range.  This is less precise than EOVERFLOW,
+   but guaranteed to be defined on all ANSI C environments. */
+#ifndef EOVERFLOW
+#define EOVERFLOW ERANGE
+#endif
+
+CAMLprim value caml_ml_channel_size(value vchannel)
+{
+  file_offset size = caml_channel_size(Channel(vchannel));
+  if (size > Max_long) { errno = EOVERFLOW; caml_sys_error(NO_ARG); }
+  return Val_long(size);
+}
+
+CAMLprim value caml_ml_channel_size_64(value vchannel)
+{
+  return Val_file_offset(caml_channel_size(Channel(vchannel)));
+}
+
+CAMLprim value caml_ml_set_binary_mode(value vchannel, value mode)
+{
+#if defined(_WIN32) || defined(__CYGWIN__)
+  struct channel * channel = Channel(vchannel);
+#if defined(_WIN32)
+  /* The implementation of [caml_read_fd] and [caml_write_fd] in win32.c
+     doesn't support socket I/O with CRLF conversion. */
+  if ((channel->flags & CHANNEL_FLAG_FROM_SOCKET) != 0
+      && ! Bool_val(mode)) {
+    errno = EINVAL;
+    caml_sys_error(NO_ARG);
+  }
+#endif
+  if (setmode(channel->fd, Bool_val(mode) ? O_BINARY : O_TEXT) == -1)
+    caml_sys_error(NO_ARG);
+#endif
+  return Val_unit;
+}
+
+/*
+   If the channel is closed, DO NOT raise a "bad file descriptor"
+   exception, but do nothing (the buffer is already empty).
+   This is because some libraries will flush at exit, even on
+   file descriptors that may be closed.
+*/
+
+CAMLprim value caml_ml_flush_partial(value vchannel)
+{
+  CAMLparam1 (vchannel);
+  struct channel * channel = Channel(vchannel);
+  int res;
+
+  if (channel->fd == -1) CAMLreturn(Val_true);
+  Lock(channel);
+  res = caml_flush_partial(channel);
+  Unlock(channel);
+  CAMLreturn (Val_bool(res));
+}
+
+CAMLprim value caml_ml_flush(value vchannel)
+{
+  CAMLparam1 (vchannel);
+  struct channel * channel = Channel(vchannel);
+
+  if (channel->fd == -1) CAMLreturn(Val_unit);
+  Lock(channel);
+  caml_flush(channel);
+  Unlock(channel);
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value caml_ml_output_char(value vchannel, value ch)
+{
+  CAMLparam2 (vchannel, ch);
+  struct channel * channel = Channel(vchannel);
+
+  Lock(channel);
+  caml_putch(channel, Long_val(ch));
+  Unlock(channel);
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value caml_ml_output_int(value vchannel, value w)
+{
+  CAMLparam2 (vchannel, w);
+  struct channel * channel = Channel(vchannel);
+
+  Lock(channel);
+  caml_putword(channel, (uint32_t) Long_val(w));
+  Unlock(channel);
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value caml_ml_output_partial(value vchannel, value buff, value start,
+                                      value length)
+{
+  CAMLparam4 (vchannel, buff, start, length);
+  struct channel * channel = Channel(vchannel);
+  int res;
+
+  Lock(channel);
+  res = caml_putblock(channel, &Byte(buff, Long_val(start)), Long_val(length));
+  Unlock(channel);
+  CAMLreturn (Val_int(res));
+}
+
+CAMLprim value caml_ml_output_bytes(value vchannel, value buff, value start,
+                              value length)
+{
+  CAMLparam4 (vchannel, buff, start, length);
+  struct channel * channel = Channel(vchannel);
+  intnat pos = Long_val(start);
+  intnat len = Long_val(length);
+
+  Lock(channel);
+    /* We cannot call caml_really_putblock here because buff may move
+       during caml_write_fd */
+    while (len > 0) {
+      int written = caml_putblock(channel, &Byte(buff, pos), len);
+      pos += written;
+      len -= written;
+    }
+  Unlock(channel);
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value caml_ml_output(value vchannel, value buff, value start,
+                              value length)
+{
+  return caml_ml_output_bytes (vchannel, buff, start, length);
+}
+
+CAMLprim value caml_ml_seek_out(value vchannel, value pos)
+{
+  CAMLparam2 (vchannel, pos);
+  struct channel * channel = Channel(vchannel);
+
+  Lock(channel);
+  caml_seek_out(channel, Long_val(pos));
+  Unlock(channel);
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value caml_ml_seek_out_64(value vchannel, value pos)
+{
+  CAMLparam2 (vchannel, pos);
+  struct channel * channel = Channel(vchannel);
+
+  Lock(channel);
+  caml_seek_out(channel, File_offset_val(pos));
+  Unlock(channel);
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value caml_ml_pos_out(value vchannel)
+{
+  file_offset pos = caml_pos_out(Channel(vchannel));
+  if (pos > Max_long) { errno = EOVERFLOW; caml_sys_error(NO_ARG); }
+  return Val_long(pos);
+}
+
+CAMLprim value caml_ml_pos_out_64(value vchannel)
+{
+  return Val_file_offset(caml_pos_out(Channel(vchannel)));
+}
+
+CAMLprim value caml_ml_input_char(value vchannel)
+{
+  CAMLparam1 (vchannel);
+  struct channel * channel = Channel(vchannel);
+  unsigned char c;
+
+  Lock(channel);
+  c = caml_getch(channel);
+  Unlock(channel);
+  CAMLreturn (Val_long(c));
+}
+
+CAMLprim value caml_ml_input_int(value vchannel)
+{
+  CAMLparam1 (vchannel);
+  struct channel * channel = Channel(vchannel);
+  intnat i;
+
+  Lock(channel);
+  i = caml_getword(channel);
+  Unlock(channel);
+#ifdef ARCH_SIXTYFOUR
+  i = (i << 32) >> 32;          /* Force sign extension */
+#endif
+  CAMLreturn (Val_long(i));
+}
+
+CAMLprim value caml_ml_input(value vchannel, value buff, value vstart,
+                             value vlength)
+{
+  CAMLparam4 (vchannel, buff, vstart, vlength);
+  struct channel * channel = Channel(vchannel);
+  intnat start, len;
+  int n, avail, nread;
+
+  Lock(channel);
+  /* We cannot call caml_getblock here because buff may move during
+     caml_read_fd */
+  start = Long_val(vstart);
+  len = Long_val(vlength);
+  n = len >= INT_MAX ? INT_MAX : (int) len;
+  avail = channel->max - channel->curr;
+  if (n <= avail) {
+    memmove(&Byte(buff, start), channel->curr, n);
+    channel->curr += n;
+  } else if (avail > 0) {
+    memmove(&Byte(buff, start), channel->curr, avail);
+    channel->curr += avail;
+    n = avail;
+  } else {
+    nread = caml_read_fd(channel->fd, channel->flags, channel->buff,
+                         channel->end - channel->buff);
+    channel->offset += nread;
+    channel->max = channel->buff + nread;
+    if (n > nread) n = nread;
+    memmove(&Byte(buff, start), channel->buff, n);
+    channel->curr = channel->buff + n;
+  }
+  Unlock(channel);
+  CAMLreturn (Val_long(n));
+}
+
+CAMLprim value caml_ml_seek_in(value vchannel, value pos)
+{
+  CAMLparam2 (vchannel, pos);
+  struct channel * channel = Channel(vchannel);
+
+  Lock(channel);
+  caml_seek_in(channel, Long_val(pos));
+  Unlock(channel);
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value caml_ml_seek_in_64(value vchannel, value pos)
+{
+  CAMLparam2 (vchannel, pos);
+  struct channel * channel = Channel(vchannel);
+
+  Lock(channel);
+  caml_seek_in(channel, File_offset_val(pos));
+  Unlock(channel);
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value caml_ml_pos_in(value vchannel)
+{
+  file_offset pos = caml_pos_in(Channel(vchannel));
+  if (pos > Max_long) { errno = EOVERFLOW; caml_sys_error(NO_ARG); }
+  return Val_long(pos);
+}
+
+CAMLprim value caml_ml_pos_in_64(value vchannel)
+{
+  return Val_file_offset(caml_pos_in(Channel(vchannel)));
+}
+
+CAMLprim value caml_ml_input_scan_line(value vchannel)
+{
+  CAMLparam1 (vchannel);
+  struct channel * channel = Channel(vchannel);
+  intnat res;
+
+  Lock(channel);
+  res = caml_input_scan_line(channel);
+  Unlock(channel);
+  CAMLreturn (Val_long(res));
+}
+
+CAMLprim value caml_terminfo_rows(value vchannel)
+{
+  return Val_int(caml_num_rows_fd(Channel(vchannel)->fd));
+}
diff --git a/runtime/lexing.c b/runtime/lexing.c
new file mode 100644
index 00000000..b1049904
--- /dev/null
+++ b/runtime/lexing.c
@@ -0,0 +1,233 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* The table-driven automaton for lexers generated by camllex. */
+
+#include "caml/fail.h"
+#include "caml/mlvalues.h"
+#include "caml/stacks.h"
+
+struct lexer_buffer {
+  value refill_buff;
+  value lex_buffer;
+  value lex_buffer_len;
+  value lex_abs_pos;
+  value lex_start_pos;
+  value lex_curr_pos;
+  value lex_last_pos;
+  value lex_last_action;
+  value lex_eof_reached;
+  value lex_mem;
+  value lex_start_p;
+  value lex_curr_p;
+};
+
+struct lexing_table {
+  value lex_base;
+  value lex_backtrk;
+  value lex_default;
+  value lex_trans;
+  value lex_check;
+  value lex_base_code;
+  value lex_backtrk_code;
+  value lex_default_code;
+  value lex_trans_code;
+  value lex_check_code;
+  value lex_code;
+};
+
+#if defined(ARCH_BIG_ENDIAN) || SIZEOF_SHORT != 2
+#define Short(tbl,n) \
+  (*((unsigned char *)((tbl) + (n) * 2)) + \
+          (*((signed char *)((tbl) + (n) * 2 + 1)) << 8))
+#else
+#define Short(tbl,n) (((short *)(tbl))[(n)])
+#endif
+
+CAMLprim value caml_lex_engine(struct lexing_table *tbl, value start_state,
+                               struct lexer_buffer *lexbuf)
+{
+  int state, base, backtrk, c;
+
+  state = Int_val(start_state);
+  if (state >= 0) {
+    /* First entry */
+    lexbuf->lex_last_pos = lexbuf->lex_start_pos = lexbuf->lex_curr_pos;
+    lexbuf->lex_last_action = Val_int(-1);
+  } else {
+    /* Reentry after refill */
+    state = -state - 1;
+  }
+  while(1) {
+    /* Lookup base address or action number for current state */
+    base = Short(tbl->lex_base, state);
+    if (base < 0) return Val_int(-base-1);
+    /* See if it's a backtrack point */
+    backtrk = Short(tbl->lex_backtrk, state);
+    if (backtrk >= 0) {
+      lexbuf->lex_last_pos = lexbuf->lex_curr_pos;
+      lexbuf->lex_last_action = Val_int(backtrk);
+    }
+    /* See if we need a refill */
+    if (lexbuf->lex_curr_pos >= lexbuf->lex_buffer_len){
+      if (lexbuf->lex_eof_reached == Val_bool (0)){
+        return Val_int(-state - 1);
+      }else{
+        c = 256;
+      }
+    }else{
+      /* Read next input char */
+      c = Byte_u(lexbuf->lex_buffer, Long_val(lexbuf->lex_curr_pos));
+      lexbuf->lex_curr_pos += 2;
+    }
+    /* Determine next state */
+    if (Short(tbl->lex_check, base + c) == state)
+      state = Short(tbl->lex_trans, base + c);
+    else
+      state = Short(tbl->lex_default, state);
+    /* If no transition on this char, return to last backtrack point */
+    if (state < 0) {
+      lexbuf->lex_curr_pos = lexbuf->lex_last_pos;
+      if (lexbuf->lex_last_action == Val_int(-1)) {
+        caml_failwith("lexing: empty token");
+      } else {
+        return lexbuf->lex_last_action;
+      }
+    }else{
+      /* Erase the EOF condition only if the EOF pseudo-character was
+         consumed by the automaton (i.e. there was no backtrack above)
+       */
+      if (c == 256) lexbuf->lex_eof_reached = Val_bool (0);
+    }
+  }
+}
+
+/***********************************************/
+/* New lexer engine, with memory of positions  */
+/***********************************************/
+
+static void run_mem(char *pc, value mem, value curr_pos) {
+  for (;;) {
+    unsigned char dst, src ;
+
+    dst = *pc++ ;
+    if (dst == 0xff)
+      return ;
+    src = *pc++ ;
+    if (src == 0xff) {
+      /*      fprintf(stderr,"[%hhu] <- %d\n",dst,Int_val(curr_pos)) ;*/
+      Field(mem,dst) = curr_pos ;
+    } else {
+      /*      fprintf(stderr,"[%hhu] <- [%hhu]\n",dst,src) ; */
+      Field(mem,dst) = Field(mem,src) ;
+    }
+  }
+}
+
+static void run_tag(char *pc, value mem) {
+  for (;;) {
+    unsigned char dst, src ;
+
+    dst = *pc++ ;
+    if (dst == 0xff)
+      return ;
+    src = *pc++ ;
+    if (src == 0xff) {
+      /*      fprintf(stderr,"[%hhu] <- -1\n",dst) ; */
+      Field(mem,dst) = Val_int(-1) ;
+    } else {
+      /*      fprintf(stderr,"[%hhu] <- [%hhu]\n",dst,src) ; */
+      Field(mem,dst) = Field(mem,src) ;
+    }
+  }
+}
+
+CAMLprim value caml_new_lex_engine(struct lexing_table *tbl, value start_state,
+                                   struct lexer_buffer *lexbuf)
+{
+  int state, base, backtrk, c, pstate ;
+  state = Int_val(start_state);
+  if (state >= 0) {
+    /* First entry */
+    lexbuf->lex_last_pos = lexbuf->lex_start_pos = lexbuf->lex_curr_pos;
+    lexbuf->lex_last_action = Val_int(-1);
+  } else {
+    /* Reentry after refill */
+    state = -state - 1;
+  }
+  while(1) {
+    /* Lookup base address or action number for current state */
+    base = Short(tbl->lex_base, state);
+    if (base < 0) {
+      int pc_off = Short(tbl->lex_base_code, state) ;
+      run_tag(Bp_val(tbl->lex_code) + pc_off, lexbuf->lex_mem);
+      /*      fprintf(stderr,"Perform: %d\n",-base-1) ; */
+      return Val_int(-base-1);
+    }
+    /* See if it's a backtrack point */
+    backtrk = Short(tbl->lex_backtrk, state);
+    if (backtrk >= 0) {
+      int pc_off =  Short(tbl->lex_backtrk_code, state);
+      run_tag(Bp_val(tbl->lex_code) + pc_off, lexbuf->lex_mem);
+      lexbuf->lex_last_pos = lexbuf->lex_curr_pos;
+      lexbuf->lex_last_action = Val_int(backtrk);
+
+    }
+    /* See if we need a refill */
+    if (lexbuf->lex_curr_pos >= lexbuf->lex_buffer_len){
+      if (lexbuf->lex_eof_reached == Val_bool (0)){
+        return Val_int(-state - 1);
+      }else{
+        c = 256;
+      }
+    }else{
+      /* Read next input char */
+      c = Byte_u(lexbuf->lex_buffer, Long_val(lexbuf->lex_curr_pos));
+      lexbuf->lex_curr_pos += 2;
+    }
+    /* Determine next state */
+    pstate=state ;
+    if (Short(tbl->lex_check, base + c) == state)
+      state = Short(tbl->lex_trans, base + c);
+    else
+      state = Short(tbl->lex_default, state);
+    /* If no transition on this char, return to last backtrack point */
+    if (state < 0) {
+      lexbuf->lex_curr_pos = lexbuf->lex_last_pos;
+      if (lexbuf->lex_last_action == Val_int(-1)) {
+        caml_failwith("lexing: empty token");
+      } else {
+        return lexbuf->lex_last_action;
+      }
+    }else{
+      /* If some transition, get and perform memory moves */
+      int base_code = Short(tbl->lex_base_code, pstate) ;
+      int pc_off ;
+      if (Short(tbl->lex_check_code, base_code + c) == pstate)
+        pc_off = Short(tbl->lex_trans_code, base_code + c) ;
+      else
+        pc_off = Short(tbl->lex_default_code, pstate) ;
+      if (pc_off > 0)
+        run_mem(Bp_val(tbl->lex_code) + pc_off, lexbuf->lex_mem,
+                lexbuf->lex_curr_pos) ;
+      /* Erase the EOF condition only if the EOF pseudo-character was
+         consumed by the automaton (i.e. there was no backtrack above)
+       */
+      if (c == 256) lexbuf->lex_eof_reached = Val_bool (0);
+    }
+  }
+}
diff --git a/runtime/main.c b/runtime/main.c
new file mode 100644
index 00000000..5e5839ff
--- /dev/null
+++ b/runtime/main.c
@@ -0,0 +1,47 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, 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
+
+/* Main entry point (can be overridden by a user-provided main()
+   function that calls caml_main() later). */
+
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/sys.h"
+#include "caml/osdeps.h"
+#ifdef _WIN32
+#include <windows.h>
+#endif
+
+CAMLextern void caml_main (char_os **);
+
+#ifdef _WIN32
+CAMLextern void caml_expand_command_line (int *, wchar_t ***);
+
+int wmain(int argc, wchar_t **argv)
+#else
+int main(int argc, char **argv)
+#endif
+{
+#ifdef _WIN32
+  /* Expand wildcards and diversions in command line */
+  caml_expand_command_line(&argc, &argv);
+#endif
+
+  caml_main(argv);
+  caml_sys_exit(Val_int(0));
+  return 0; /* not reached */
+}
diff --git a/runtime/major_gc.c b/runtime/major_gc.c
new file mode 100644
index 00000000..5e4f06bc
--- /dev/null
+++ b/runtime/major_gc.c
@@ -0,0 +1,936 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*              Damien Doligez, projet Para, 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
+
+#include <limits.h>
+#include <math.h>
+
+#include "caml/compact.h"
+#include "caml/custom.h"
+#include "caml/config.h"
+#include "caml/fail.h"
+#include "caml/finalise.h"
+#include "caml/freelist.h"
+#include "caml/gc.h"
+#include "caml/gc_ctrl.h"
+#include "caml/major_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/signals.h"
+#include "caml/weak.h"
+#include "caml/memprof.h"
+#include "caml/eventlog.h"
+
+#if defined (NATIVE_CODE) && defined (NO_NAKED_POINTERS)
+#define NATIVE_CODE_AND_NO_NAKED_POINTERS
+#else
+#undef NATIVE_CODE_AND_NO_NAKED_POINTERS
+#endif
+
+#ifdef _MSC_VER
+Caml_inline double fmin(double a, double b) {
+  return (a < b) ? a : b;
+}
+#endif
+
+uintnat caml_percent_free;
+uintnat caml_major_heap_increment;
+CAMLexport char *caml_heap_start;
+char *caml_gc_sweep_hp;
+int caml_gc_phase;        /* always Phase_mark, Pase_clean,
+                             Phase_sweep, or Phase_idle */
+static value *gray_vals;
+static value *gray_vals_cur, *gray_vals_end;
+static asize_t gray_vals_size;
+static int heap_is_pure;   /* The heap is pure if the only gray objects
+                              below [markhp] are also in [gray_vals]. */
+uintnat caml_allocated_words;
+uintnat caml_dependent_size, caml_dependent_allocated;
+double caml_extra_heap_resources;
+uintnat caml_fl_wsz_at_phase_change = 0;
+
+extern char *caml_fl_merge;  /* Defined in freelist.c. */
+
+static char *markhp, *chunk, *limit;
+static double p_backlog = 0.0; /* backlog for the gc speedup parameter */
+
+int caml_gc_subphase;     /* Subphase_{mark_roots,mark_main,mark_final} */
+
+/**
+   Ephemerons:
+   During mark phase the list caml_ephe_list_head of ephemerons
+   is iterated by different pointers that follow the invariants:
+   caml_ephe_list_head ->* ephes_checked_if_pure ->* ephes_to_check ->* null
+                        |                         |                  |
+                       (1)                       (2)                (3)
+
+    At the start of mark phase, (1) and (2) are empty.
+
+    In mark phase:
+      - the ephemerons in (1) have a data alive or none
+        (nb: new ephemerons are added in this part by weak.c)
+      - the ephemerons in (2) have at least a white key or are white
+        if ephe_list_pure is true, otherwise they are in an unknown state and
+        must be checked again.
+      - the ephemerons in (3) are in an unknown state and must be checked
+
+    At the end of mark phase, (3) is empty and ephe_list_pure is true.
+    The ephemeron in (1) and (2) will be cleaned (white keys and data
+    replaced by none or the ephemeron is removed from the list if it is white)
+    in clean phase.
+
+    In clean phase:
+    caml_ephe_list_head ->*                           ephes_to_check ->* null
+                         |                                            |
+                        (1)                                          (3)
+
+    In clean phase, (2) is not used, ephes_to_check is initialized at
+    caml_ephe_list_head:
+    - the ephemerons in (1) are clean.
+    - the ephemerons in (3) should be cleaned or removed if white.
+
+ */
+static int ephe_list_pure;
+/** The ephemerons is pure if since the start of its iteration
+    no value have been darken. */
+static value *ephes_checked_if_pure;
+static value *ephes_to_check;
+
+int caml_major_window = 1;
+double caml_major_ring[Max_major_window] = { 0. };
+int caml_major_ring_index = 0;
+double caml_major_work_credit = 0.0;
+double caml_gc_clock = 0.0;
+
+#ifdef DEBUG
+static unsigned long major_gc_counter = 0;
+#endif
+
+void (*caml_major_gc_hook)(void) = NULL;
+
+static void realloc_gray_vals (void)
+{
+  value *new;
+
+  CAMLassert (gray_vals_cur == gray_vals_end);
+  if (gray_vals_size < Caml_state->stat_heap_wsz / 32){
+    caml_gc_message (0x08, "Growing gray_vals to %"
+                           ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
+                     (intnat) gray_vals_size * sizeof (value) / 512);
+    new = (value *) caml_stat_resize_noexc ((char *) gray_vals,
+                                            2 * gray_vals_size *
+                                            sizeof (value));
+    if (new == NULL){
+      caml_gc_message (0x08, "No room for growing gray_vals\n");
+      gray_vals_cur = gray_vals;
+      heap_is_pure = 0;
+    }else{
+      gray_vals = new;
+      gray_vals_cur = gray_vals + gray_vals_size;
+      gray_vals_size *= 2;
+      gray_vals_end = gray_vals + gray_vals_size;
+    }
+  }else{
+    gray_vals_cur = gray_vals + gray_vals_size / 2;
+    heap_is_pure = 0;
+  }
+}
+
+void caml_darken (value v, value *p /* not used */)
+{
+#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
+  if (Is_block (v) && !Is_young (v) && Wosize_val (v) > 0) {
+#else
+  if (Is_block (v) && Is_in_heap (v)) {
+#endif
+    header_t h = Hd_val (v);
+    tag_t t = Tag_hd (h);
+    if (t == Infix_tag){
+      v -= Infix_offset_val(v);
+      h = Hd_val (v);
+      t = Tag_hd (h);
+    }
+#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
+    /* We insist that naked pointers to outside the heap point to things that
+       look like values with headers coloured black.  This isn't always
+       strictly necessary but is essential in certain cases---in particular
+       when the value is allocated in a read-only section.  (For the values
+       where it would be safe it is a performance improvement since we avoid
+       putting them on the grey list.) */
+    CAMLassert (Is_in_heap (v) || Is_black_hd (h));
+#endif
+    CAMLassert (!Is_blue_hd (h));
+    if (Is_white_hd (h)){
+      ephe_list_pure = 0;
+      if (t < No_scan_tag){
+        Hd_val (v) = Grayhd_hd (h);
+        *gray_vals_cur++ = v;
+        if (gray_vals_cur >= gray_vals_end) realloc_gray_vals ();
+      }else{
+        Hd_val (v) = Blackhd_hd (h);
+      }
+    }
+  }
+}
+
+static void start_cycle (void)
+{
+  CAMLassert (caml_gc_phase == Phase_idle);
+  CAMLassert (gray_vals_cur == gray_vals);
+  caml_gc_message (0x01, "Starting new major GC cycle\n");
+  caml_darken_all_roots_start ();
+  caml_gc_phase = Phase_mark;
+  caml_gc_subphase = Subphase_mark_roots;
+  markhp = NULL;
+  ephe_list_pure = 1;
+  ephes_checked_if_pure = &caml_ephe_list_head;
+  ephes_to_check = &caml_ephe_list_head;
+#ifdef DEBUG
+  ++ major_gc_counter;
+  caml_heap_check ();
+#endif
+}
+
+/* We may stop the slice inside values, in order to avoid large latencies
+   on large arrays. In this case, [current_value] is the partially-marked
+   value and [current_index] is the index of the next field to be marked.
+*/
+static value current_value = 0;
+static mlsize_t current_index = 0;
+
+static void init_sweep_phase(void)
+{
+  /* Phase_clean is done. */
+  /* Initialise the sweep phase. */
+  caml_gc_sweep_hp = caml_heap_start;
+  caml_fl_init_merge ();
+  caml_gc_phase = Phase_sweep;
+  chunk = caml_heap_start;
+  caml_gc_sweep_hp = chunk;
+  limit = chunk + Chunk_size (chunk);
+  caml_fl_wsz_at_phase_change = caml_fl_cur_wsz;
+  if (caml_major_gc_hook) (*caml_major_gc_hook)();
+}
+
+/* auxiliary function of mark_slice */
+Caml_inline value* mark_slice_darken(value *gray_vals_ptr,
+                                     value v, mlsize_t i,
+                                     int in_ephemeron, int *slice_pointers)
+{
+  value child;
+  header_t chd;
+
+  child = Field (v, i);
+
+#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
+  if (Is_block (child)
+        && ! Is_young (child)
+        && Wosize_val (child) > 0  /* Atoms never need to be marked. */
+        /* Closure blocks contain code pointers at offsets that cannot
+           be reliably determined, so we always use the page table when
+           marking such values. */
+        && (!(Tag_val (v) == Closure_tag || Tag_val (v) == Infix_tag) ||
+            Is_in_heap (child))) {
+#else
+  if (Is_block (child) && Is_in_heap (child)) {
+#endif
+    CAML_EVENTLOG_DO (++ *slice_pointers);
+    chd = Hd_val (child);
+    if (Tag_hd (chd) == Forward_tag){
+      value f = Forward_val (child);
+      if ((in_ephemeron && Is_long(f)) ||
+          (Is_block (f)
+           && (!Is_in_value_area(f) || Tag_val (f) == Forward_tag
+               || Tag_val (f) == Lazy_tag
+#ifdef FLAT_FLOAT_ARRAY
+               || Tag_val (f) == Double_tag
+#endif
+               ))){
+        /* Do not short-circuit the pointer. */
+      }else{
+        /* The variable child is not changed because it must be mark alive */
+        Field (v, i) = f;
+        if (Is_block (f) && Is_young (f) && !Is_young (child)){
+          if(in_ephemeron) {
+            add_to_ephe_ref_table (Caml_state->ephe_ref_table, v, i);
+          } else {
+            add_to_ref_table (Caml_state->ref_table, &Field (v, i));
+          }
+        }
+      }
+    }
+    else if (Tag_hd(chd) == Infix_tag) {
+      child -= Infix_offset_val(child);
+      chd = Hd_val(child);
+    }
+#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
+    /* See [caml_darken] for a description of this assertion. */
+    CAMLassert (Is_in_heap (child) || Is_black_hd (chd));
+#endif
+    if (Is_white_hd (chd)){
+      ephe_list_pure = 0;
+      Hd_val (child) = Grayhd_hd (chd);
+      *gray_vals_ptr++ = child;
+      if (gray_vals_ptr >= gray_vals_end) {
+        gray_vals_cur = gray_vals_ptr;
+        realloc_gray_vals ();
+        gray_vals_ptr = gray_vals_cur;
+      }
+    }
+  }
+
+  return gray_vals_ptr;
+}
+
+static value* mark_ephe_aux (value *gray_vals_ptr, intnat *work,
+                             int *slice_pointers)
+{
+  value v, data, key;
+  header_t hd;
+  mlsize_t size, i;
+
+  v = *ephes_to_check;
+  hd = Hd_val(v);
+  CAMLassert(Tag_val (v) == Abstract_tag);
+  data = Field(v,CAML_EPHE_DATA_OFFSET);
+  if ( data != caml_ephe_none &&
+       Is_block (data) && Is_in_heap (data) && Is_white_val (data)){
+
+    int alive_data = 1;
+
+    /* The liveness of the ephemeron is one of the condition */
+    if (Is_white_hd (hd)) alive_data = 0;
+
+    /* The liveness of the keys not caml_ephe_none is the other condition */
+    size = Wosize_hd (hd);
+    for (i = CAML_EPHE_FIRST_KEY; alive_data && i < size; i++){
+      key = Field (v, i);
+    ephemeron_again:
+      if (key != caml_ephe_none &&
+          Is_block (key) && Is_in_heap (key)){
+        if (Tag_val (key) == Forward_tag){
+          value f = Forward_val (key);
+          if (Is_long (f) ||
+              (Is_block (f) &&
+               (!Is_in_value_area(f) || Tag_val (f) == Forward_tag
+                || Tag_val (f) == Lazy_tag
+#ifdef FLAT_FLOAT_ARRAY
+                || Tag_val (f) == Double_tag
+#endif
+                ))){
+            /* Do not short-circuit the pointer. */
+          }else{
+            Field (v, i) = key = f;
+            goto ephemeron_again;
+          }
+        }
+        if (Is_white_val (key)){
+          alive_data = 0;
+        }
+      }
+    }
+    *work -= Whsize_wosize(i);
+
+    if (alive_data){
+      gray_vals_ptr = mark_slice_darken(gray_vals_ptr,v,
+                                        CAML_EPHE_DATA_OFFSET,
+                                        /*in_ephemeron=*/1,
+                                        slice_pointers);
+    } else { /* not triggered move to the next one */
+      ephes_to_check = &Field(v,CAML_EPHE_LINK_OFFSET);
+      return gray_vals_ptr;
+    }
+  } else {  /* a simily weak pointer or an already alive data */
+    *work -= 1;
+  }
+
+  /* all keys black or data none or black
+     move the ephemerons from (3) to the end of (1) */
+  if ( ephes_checked_if_pure == ephes_to_check ) {
+    /* corner case and optim */
+    ephes_checked_if_pure = &Field(v,CAML_EPHE_LINK_OFFSET);
+    ephes_to_check = ephes_checked_if_pure;
+  } else {
+    /*  - remove v from the list (3) */
+    *ephes_to_check = Field(v,CAML_EPHE_LINK_OFFSET);
+    /*  - insert it at the end of (1) */
+    Field(v,CAML_EPHE_LINK_OFFSET) = *ephes_checked_if_pure;
+    *ephes_checked_if_pure = v;
+    ephes_checked_if_pure = &Field(v,CAML_EPHE_LINK_OFFSET);
+  }
+  return gray_vals_ptr;
+}
+
+
+
+static void mark_slice (intnat work)
+{
+  value *gray_vals_ptr;  /* Local copy of [gray_vals_cur] */
+  value v;
+  header_t hd;
+  mlsize_t size, i, start, end; /* [start] is a local copy of [current_index] */
+#ifdef CAML_INSTR
+  int slice_fields = 0; /** eventlog counters */
+#endif /*CAML_INSTR*/
+  int slice_pointers = 0;
+
+  caml_gc_message (0x40, "Marking %"ARCH_INTNAT_PRINTF_FORMAT"d words\n", work);
+  caml_gc_message (0x40, "Subphase = %d\n", caml_gc_subphase);
+  gray_vals_ptr = gray_vals_cur;
+  v = current_value;
+  start = current_index;
+  while (work > 0){
+    if (v == 0 && gray_vals_ptr > gray_vals){
+      CAMLassert (start == 0);
+      v = *--gray_vals_ptr;
+      CAMLassert (Is_gray_val (v));
+    }
+    if (v != 0){
+      hd = Hd_val(v);
+      CAMLassert (Is_gray_hd (hd));
+      size = Wosize_hd (hd);
+      end = start + work;
+      if (Tag_hd (hd) < No_scan_tag){
+        start = size < start ? size : start;
+        end = size < end ? size : end;
+        CAMLassert (end >= start);
+        CAML_EVENTLOG_DO({
+          slice_fields += end - start;
+          if (size > end)
+            CAML_EV_COUNTER (EV_C_MAJOR_MARK_SLICE_REMAIN, size - end);
+        });
+        for (i = start; i < end; i++){
+          gray_vals_ptr = mark_slice_darken(gray_vals_ptr,v,i,
+                                            /*in_ephemeron=*/ 0,
+                                            &slice_pointers);
+        }
+        if (end < size){
+          work = 0;
+          start = end;
+          /* [v] doesn't change. */
+          CAMLassert (Is_gray_val (v));
+        }else{
+          CAMLassert (end == size);
+          Hd_val (v) = Blackhd_hd (hd);
+          work -= Whsize_wosize(end - start);
+          start = 0;
+          v = 0;
+        }
+      }else{
+        /* The block doesn't contain any pointers. */
+        CAMLassert (start == 0);
+        Hd_val (v) = Blackhd_hd (hd);
+        work -= Whsize_wosize(size);
+        v = 0;
+      }
+    }else if (markhp != NULL){
+      if (markhp == limit){
+        chunk = Chunk_next (chunk);
+        if (chunk == NULL){
+          markhp = NULL;
+        }else{
+          markhp = chunk;
+          limit = chunk + Chunk_size (chunk);
+        }
+      }else{
+        if (Is_gray_val (Val_hp (markhp))){
+          CAMLassert (gray_vals_ptr == gray_vals);
+          CAMLassert (v == 0 && start == 0);
+          v = Val_hp (markhp);
+        }
+        markhp += Bhsize_hp (markhp);
+      }
+    }else if (!heap_is_pure){
+      heap_is_pure = 1;
+      chunk = caml_heap_start;
+      markhp = chunk;
+      limit = chunk + Chunk_size (chunk);
+    } else if (caml_gc_subphase == Subphase_mark_roots) {
+      CAML_EV_BEGIN(EV_MAJOR_MARK_ROOTS);
+      gray_vals_cur = gray_vals_ptr;
+      work = caml_darken_all_roots_slice (work);
+      gray_vals_ptr = gray_vals_cur;
+      CAML_EV_END(EV_MAJOR_MARK_ROOTS);
+      if (work > 0){
+        caml_gc_subphase = Subphase_mark_main;
+      }
+    } else if (*ephes_to_check != (value) NULL) {
+      /* Continue to scan the list of ephe */
+      gray_vals_ptr = mark_ephe_aux(gray_vals_ptr,&work,&slice_pointers);
+    } else if (!ephe_list_pure){
+      /* We must scan again the list because some value have been darken */
+      ephe_list_pure = 1;
+      ephes_to_check = ephes_checked_if_pure;
+    }else{
+      switch (caml_gc_subphase){
+      case Subphase_mark_main: {
+          /* Subphase_mark_main is done.
+             Mark finalised values. */
+          CAML_EV_BEGIN(EV_MAJOR_MARK_MAIN);
+          gray_vals_cur = gray_vals_ptr;
+          caml_final_update_mark_phase ();
+          gray_vals_ptr = gray_vals_cur;
+          if (gray_vals_ptr > gray_vals){
+            v = *--gray_vals_ptr;
+            CAMLassert (start == 0);
+          }
+          /* Complete the marking */
+          ephes_to_check = ephes_checked_if_pure;
+          CAML_EV_END(EV_MAJOR_MARK_MAIN);
+          caml_gc_subphase = Subphase_mark_final;
+      }
+        break;
+      case Subphase_mark_final: {
+        /** The set of unreachable value will not change anymore for
+            this cycle. Start clean phase. */
+        CAML_EV_BEGIN(EV_MAJOR_MARK_FINAL);
+        caml_gc_phase = Phase_clean;
+        caml_final_update_clean_phase ();
+        caml_memprof_update_clean_phase ();
+        if (caml_ephe_list_head != (value) NULL){
+          /* Initialise the clean phase. */
+          ephes_to_check = &caml_ephe_list_head;
+        } else {
+          /* Initialise the sweep phase. */
+          init_sweep_phase();
+        }
+        work = 0;
+        CAML_EV_END(EV_MAJOR_MARK_FINAL);
+      }
+        break;
+      default: CAMLassert (0);
+      }
+    }
+  }
+  gray_vals_cur = gray_vals_ptr;
+  current_value = v;
+  current_index = start;
+  CAML_EV_COUNTER(EV_C_MAJOR_MARK_SLICE_FIELDS, slice_fields);
+  CAML_EV_COUNTER(EV_C_MAJOR_MARK_SLICE_POINTERS, slice_pointers);
+}
+
+/* Clean ephemerons */
+static void clean_slice (intnat work)
+{
+  value v;
+
+  caml_gc_message (0x40, "Cleaning %"
+                   ARCH_INTNAT_PRINTF_FORMAT "d words\n", work);
+  while (work > 0){
+    v = *ephes_to_check;
+    if (v != (value) NULL){
+      if (Is_white_val (v)){
+        /* The whole array is dead, remove it from the list. */
+        *ephes_to_check = Field (v, CAML_EPHE_LINK_OFFSET);
+        work -= 1;
+      }else{
+        caml_ephe_clean(v);
+        ephes_to_check = &Field (v, CAML_EPHE_LINK_OFFSET);
+        work -= Whsize_val (v);
+      }
+    }else{ /* End of list reached */
+      /* Phase_clean is done. */
+      /* Initialise the sweep phase. */
+      init_sweep_phase();
+      work = 0;
+    }
+  }
+}
+
+static void sweep_slice (intnat work)
+{
+  char *hp;
+  header_t hd;
+
+  caml_gc_message (0x40, "Sweeping %"
+                   ARCH_INTNAT_PRINTF_FORMAT "d words\n", work);
+  while (work > 0){
+    if (caml_gc_sweep_hp < limit){
+      hp = caml_gc_sweep_hp;
+      hd = Hd_hp (hp);
+      work -= Whsize_hd (hd);
+      caml_gc_sweep_hp += Bhsize_hd (hd);
+      switch (Color_hd (hd)){
+      case Caml_white:
+        caml_gc_sweep_hp = (char *) caml_fl_merge_block (Val_hp (hp), limit);
+        break;
+      case Caml_blue:
+        /* Only the blocks of the free-list are blue.  See [freelist.c]. */
+        caml_fl_merge = Bp_hp (hp);
+        break;
+      default:          /* gray or black */
+        CAMLassert (Color_hd (hd) == Caml_black);
+        Hd_hp (hp) = Whitehd_hd (hd);
+        break;
+      }
+      CAMLassert (caml_gc_sweep_hp <= limit);
+    }else{
+      chunk = Chunk_next (chunk);
+      if (chunk == NULL){
+        /* Sweeping is done. */
+        ++ Caml_state->stat_major_collections;
+        work = 0;
+        caml_gc_phase = Phase_idle;
+        caml_request_minor_gc ();
+      }else{
+        caml_gc_sweep_hp = chunk;
+        limit = chunk + Chunk_size (chunk);
+      }
+    }
+  }
+}
+
+/* The main entry point for the major GC. Called about once for each
+   minor GC. [howmuch] is the amount of work to do:
+   -1 if the GC is triggered automatically
+   0 to let the GC compute the amount of work
+   [n] to make the GC do enough work to (on average) free [n] words
+ */
+void caml_major_collection_slice (intnat howmuch)
+{
+  double p, dp, filt_p, spend;
+  intnat computed_work;
+  int i;
+  /*
+     Free memory at the start of the GC cycle (garbage + free list) (assumed):
+                 FM = Caml_state->stat_heap_wsz * caml_percent_free
+                      / (100 + caml_percent_free)
+
+     Assuming steady state and enforcing a constant allocation rate, then
+     FM is divided in 2/3 for garbage and 1/3 for free list.
+                 G = 2 * FM / 3
+     G is also the amount of memory that will be used during this cycle
+     (still assuming steady state).
+
+     Proportion of G consumed since the previous slice:
+                 PH = caml_allocated_words / G
+                    = caml_allocated_words * 3 * (100 + caml_percent_free)
+                      / (2 * Caml_state->stat_heap_wsz * caml_percent_free)
+     Proportion of extra-heap resources consumed since the previous slice:
+                 PE = caml_extra_heap_resources
+     Proportion of total work to do in this slice:
+                 P  = max (PH, PE)
+
+     Here, we insert a time-based filter on the P variable to avoid large
+     latency spikes in the GC, so the P below is a smoothed-out version of
+     the P above.
+
+     Amount of marking work for the GC cycle:
+             MW = Caml_state->stat_heap_wsz * 100 / (100 + caml_percent_free)
+                  + caml_incremental_roots_count
+     Amount of sweeping work for the GC cycle:
+             SW = Caml_state->stat_heap_wsz
+
+     In order to finish marking with a non-empty free list, we will
+     use 40% of the time for marking, and 60% for sweeping.
+
+     Let MT be the time spent marking, ST the time spent sweeping, and TT
+     the total time for this cycle. We have:
+                 MT = 40/100 * TT
+                 ST = 60/100 * TT
+
+     Amount of time to spend on this slice:
+                 T  = P * TT = P * MT / (40/100) = P * ST / (60/100)
+
+     Since we must do MW work in MT time or SW work in ST time, the amount
+     of work for this slice is:
+                 MS = P * MW / (40/100)  if marking
+                 SS = P * SW / (60/100)  if sweeping
+
+     Amount of marking work for a marking slice:
+                 MS = P * MW / (40/100)
+                 MS = P * (Caml_state->stat_heap_wsz * 250
+                           / (100 + caml_percent_free)
+                           + 2.5 * caml_incremental_roots_count)
+     Amount of sweeping work for a sweeping slice:
+                 SS = P * SW / (60/100)
+                 SS = P * Caml_state->stat_heap_wsz * 5 / 3
+
+     This slice will either mark MS words or sweep SS words.
+  */
+
+  if (caml_major_slice_begin_hook != NULL) (*caml_major_slice_begin_hook) ();
+
+  p = (double) caml_allocated_words * 3.0 * (100 + caml_percent_free)
+      / Caml_state->stat_heap_wsz / caml_percent_free / 2.0;
+  if (caml_dependent_size > 0){
+    dp = (double) caml_dependent_allocated * (100 + caml_percent_free)
+         / caml_dependent_size / caml_percent_free;
+  }else{
+    dp = 0.0;
+  }
+  if (p < dp) p = dp;
+  if (p < caml_extra_heap_resources) p = caml_extra_heap_resources;
+  p += p_backlog;
+  p_backlog = 0.0;
+  if (p > 0.3){
+    p_backlog = p - 0.3;
+    p = 0.3;
+  }
+
+  CAML_EV_COUNTER (EV_C_MAJOR_WORK_EXTRA,
+                  (uintnat) (caml_extra_heap_resources * 1000000));
+
+  caml_gc_message (0x40, "ordered work = %"
+                   ARCH_INTNAT_PRINTF_FORMAT "d words\n", howmuch);
+  caml_gc_message (0x40, "allocated_words = %"
+                         ARCH_INTNAT_PRINTF_FORMAT "u\n",
+                   caml_allocated_words);
+  caml_gc_message (0x40, "extra_heap_resources = %"
+                         ARCH_INTNAT_PRINTF_FORMAT "uu\n",
+                   (uintnat) (caml_extra_heap_resources * 1000000));
+  caml_gc_message (0x40, "raw work-to-do = %"
+                         ARCH_INTNAT_PRINTF_FORMAT "du\n",
+                   (intnat) (p * 1000000));
+  caml_gc_message (0x40, "work backlog = %"
+                         ARCH_INTNAT_PRINTF_FORMAT "du\n",
+                   (intnat) (p_backlog * 1000000));
+
+  for (i = 0; i < caml_major_window; i++){
+    caml_major_ring[i] += p / caml_major_window;
+  }
+
+  if (caml_gc_clock >= 1.0){
+    caml_gc_clock -= 1.0;
+    ++caml_major_ring_index;
+    if (caml_major_ring_index >= caml_major_window){
+      caml_major_ring_index = 0;
+    }
+  }
+  if (howmuch == -1){
+    /* auto-triggered GC slice: spend work credit on the current bucket,
+       then do the remaining work, if any */
+    /* Note that the minor GC guarantees that the major slice is called in
+       automatic mode (with [howmuch] = -1) at least once per clock tick.
+       This means we never leave a non-empty bucket behind. */
+    spend = fmin (caml_major_work_credit,
+                  caml_major_ring[caml_major_ring_index]);
+    caml_major_work_credit -= spend;
+    filt_p = caml_major_ring[caml_major_ring_index] - spend;
+    caml_major_ring[caml_major_ring_index] = 0.0;
+  }else{
+    /* forced GC slice: do work and add it to the credit */
+    if (howmuch == 0){
+      /* automatic setting: size of next bucket
+         we do not use the current bucket, as it may be empty */
+      int i = caml_major_ring_index + 1;
+      if (i >= caml_major_window) i = 0;
+      filt_p = caml_major_ring[i];
+    }else{
+      /* manual setting */
+      filt_p = (double) howmuch * 3.0 * (100 + caml_percent_free)
+               / Caml_state->stat_heap_wsz / caml_percent_free / 2.0;
+    }
+    caml_major_work_credit += filt_p;
+    /* Limit work credit to 1.0 */
+    caml_major_work_credit = fmin(caml_major_work_credit, 1.0);
+  }
+
+  p = filt_p;
+
+  caml_gc_message (0x40, "filtered work-to-do = %"
+                         ARCH_INTNAT_PRINTF_FORMAT "du\n",
+                   (intnat) (p * 1000000));
+
+  if (caml_gc_phase == Phase_idle){
+    if (Caml_state->young_ptr == Caml_state->young_alloc_end){
+      /* We can only start a major GC cycle if the minor allocation arena
+         is empty, otherwise we'd have to treat it as a set of roots. */
+      CAML_EV_BEGIN(EV_MAJOR_ROOTS);
+      start_cycle ();
+      CAML_EV_END(EV_MAJOR_ROOTS);
+    }
+    p = 0;
+    goto finished;
+  }
+
+  if (p < 0){
+    p = 0;
+    goto finished;
+  }
+
+  if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean){
+    computed_work = (intnat) (p * ((double) Caml_state->stat_heap_wsz * 250
+                                   / (100 + caml_percent_free)
+                                   + caml_incremental_roots_count));
+  }else{
+    computed_work = (intnat) (p * Caml_state->stat_heap_wsz * 5 / 3);
+  }
+  caml_gc_message (0x40, "computed work = %"
+                   ARCH_INTNAT_PRINTF_FORMAT "d words\n", computed_work);
+  if (caml_gc_phase == Phase_mark){
+    CAML_EV_COUNTER (EV_C_MAJOR_WORK_MARK, computed_work);
+    CAML_EV_BEGIN(EV_MAJOR_MARK);
+    mark_slice (computed_work);
+    CAML_EV_END(EV_MAJOR_MARK);
+    caml_gc_message (0x02, "!");
+  }else if (caml_gc_phase == Phase_clean){
+    clean_slice (computed_work);
+    caml_gc_message (0x02, "%%");
+  }else{
+    CAMLassert (caml_gc_phase == Phase_sweep);
+    CAML_EV_COUNTER (EV_C_MAJOR_WORK_SWEEP, computed_work);
+    CAML_EV_BEGIN(EV_MAJOR_SWEEP);
+    sweep_slice (computed_work);
+    CAML_EV_END(EV_MAJOR_SWEEP);
+    caml_gc_message (0x02, "$");
+  }
+
+  if (caml_gc_phase == Phase_idle){
+    CAML_EV_BEGIN(EV_MAJOR_CHECK_AND_COMPACT);
+    caml_compact_heap_maybe ();
+    CAML_EV_END(EV_MAJOR_CHECK_AND_COMPACT);
+  }
+
+ finished:
+  caml_gc_message (0x40, "work-done = %"
+                         ARCH_INTNAT_PRINTF_FORMAT "du\n",
+                   (intnat) (p * 1000000));
+
+  /* if some of the work was not done, take it back from the credit
+     or spread it over the buckets. */
+  p = filt_p - p;
+  spend = fmin (p, caml_major_work_credit);
+  caml_major_work_credit -= spend;
+  if (p > spend){
+    p -= spend;
+    p /= caml_major_window;
+    for (i = 0; i < caml_major_window; i++) caml_major_ring[i] += p;
+  }
+
+  Caml_state->stat_major_words += caml_allocated_words;
+  caml_allocated_words = 0;
+  caml_dependent_allocated = 0;
+  caml_extra_heap_resources = 0.0;
+  if (caml_major_slice_end_hook != NULL) (*caml_major_slice_end_hook) ();
+}
+
+/* This does not call [caml_compact_heap_maybe] because the estimates of
+   free and live memory are only valid for a cycle done incrementally.
+   Besides, this function itself is called by [caml_compact_heap_maybe].
+*/
+void caml_finish_major_cycle (void)
+{
+  if (caml_gc_phase == Phase_idle){
+    p_backlog = 0.0; /* full major GC cycle, the backlog becomes irrelevant */
+    start_cycle ();
+  }
+  while (caml_gc_phase == Phase_mark) mark_slice (LONG_MAX);
+  while (caml_gc_phase == Phase_clean) clean_slice (LONG_MAX);
+  CAMLassert (caml_gc_phase == Phase_sweep);
+  while (caml_gc_phase == Phase_sweep) sweep_slice (LONG_MAX);
+  CAMLassert (caml_gc_phase == Phase_idle);
+  Caml_state->stat_major_words += caml_allocated_words;
+  caml_allocated_words = 0;
+}
+
+/* Call this function to make sure [bsz] is greater than or equal
+   to both [Heap_chunk_min] and the current heap increment.
+*/
+asize_t caml_clip_heap_chunk_wsz (asize_t wsz)
+{
+  asize_t result = wsz;
+  uintnat incr;
+
+  /* Compute the heap increment as a word size. */
+  if (caml_major_heap_increment > 1000){
+    incr = caml_major_heap_increment;
+  }else{
+    incr = Caml_state->stat_heap_wsz / 100 * caml_major_heap_increment;
+  }
+
+  if (result < incr){
+    result = incr;
+  }
+  if (result < Heap_chunk_min){
+    result = Heap_chunk_min;
+  }
+  return result;
+}
+
+/* [heap_size] is a number of bytes */
+void caml_init_major_heap (asize_t heap_size)
+{
+  int i;
+
+  Caml_state->stat_heap_wsz =
+    caml_clip_heap_chunk_wsz (Wsize_bsize (heap_size));
+  Caml_state->stat_top_heap_wsz = Caml_state->stat_heap_wsz;
+  CAMLassert (Bsize_wsize (Caml_state->stat_heap_wsz) % Page_size == 0);
+  caml_heap_start =
+    (char *) caml_alloc_for_heap (Bsize_wsize (Caml_state->stat_heap_wsz));
+  if (caml_heap_start == NULL)
+    caml_fatal_error ("cannot allocate initial major heap");
+  Chunk_next (caml_heap_start) = NULL;
+  Caml_state->stat_heap_wsz = Wsize_bsize (Chunk_size (caml_heap_start));
+  Caml_state->stat_heap_chunks = 1;
+  Caml_state->stat_top_heap_wsz = Caml_state->stat_heap_wsz;
+
+  if (caml_page_table_add(In_heap, caml_heap_start,
+        caml_heap_start + Bsize_wsize (Caml_state->stat_heap_wsz))
+      != 0) {
+    caml_fatal_error ("cannot allocate initial page table");
+  }
+
+  caml_fl_init_merge ();
+  caml_make_free_blocks ((value *) caml_heap_start,
+                         Caml_state->stat_heap_wsz, 1, Caml_white);
+  caml_gc_phase = Phase_idle;
+  gray_vals_size = 2048;
+  gray_vals = (value *) caml_stat_alloc_noexc (gray_vals_size * sizeof (value));
+  if (gray_vals == NULL)
+    caml_fatal_error ("not enough memory for the gray cache");
+  gray_vals_cur = gray_vals;
+  gray_vals_end = gray_vals + gray_vals_size;
+  heap_is_pure = 1;
+  caml_allocated_words = 0;
+  caml_extra_heap_resources = 0.0;
+  for (i = 0; i < Max_major_window; i++) caml_major_ring[i] = 0.0;
+}
+
+void caml_set_major_window (int w){
+  uintnat total = 0;
+  int i;
+  if (w == caml_major_window) return;
+  CAMLassert (w <= Max_major_window);
+  /* Collect the current work-to-do from the buckets. */
+  for (i = 0; i < caml_major_window; i++){
+    total += caml_major_ring[i];
+  }
+  /* Redistribute to the new buckets. */
+  for (i = 0; i < w; i++){
+    caml_major_ring[i] = total / w;
+  }
+  caml_major_window = w;
+}
+
+void caml_finalise_heap (void)
+{
+  /* Finishing major cycle (all values become white) */
+  caml_empty_minor_heap ();
+  caml_finish_major_cycle ();
+  CAMLassert (caml_gc_phase == Phase_idle);
+
+  /* Finalising all values (by means of forced sweeping) */
+  caml_fl_init_merge ();
+  caml_gc_phase = Phase_sweep;
+  chunk = caml_heap_start;
+  caml_gc_sweep_hp = chunk;
+  limit = chunk + Chunk_size (chunk);
+  while (caml_gc_phase == Phase_sweep)
+    sweep_slice (LONG_MAX);
+}
diff --git a/runtime/md5.c b/runtime/md5.c
new file mode 100644
index 00000000..2e128010
--- /dev/null
+++ b/runtime/md5.c
@@ -0,0 +1,325 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+#include <string.h>
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/md5.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "caml/io.h"
+#include "caml/reverse.h"
+
+/* MD5 message digest */
+
+CAMLprim value caml_md5_string(value str, value ofs, value len)
+{
+  struct MD5Context ctx;
+  value res;
+  caml_MD5Init(&ctx);
+  caml_MD5Update(&ctx, &Byte_u(str, Long_val(ofs)), Long_val(len));
+  res = caml_alloc_string(16);
+  caml_MD5Final(&Byte_u(res, 0), &ctx);
+  return res;
+}
+
+CAMLexport value caml_md5_channel(struct channel *chan, intnat toread)
+{
+  CAMLparam0();
+  struct MD5Context ctx;
+  value res;
+  intnat read;
+  char buffer[4096];
+
+  Lock(chan);
+  caml_MD5Init(&ctx);
+  if (toread < 0){
+    while (1){
+      read = caml_getblock (chan, buffer, sizeof(buffer));
+      if (read == 0) break;
+      caml_MD5Update (&ctx, (unsigned char *) buffer, read);
+    }
+  }else{
+    while (toread > 0) {
+      read = caml_getblock(chan, buffer,
+                           toread > sizeof(buffer) ? sizeof(buffer) : toread);
+      if (read == 0) caml_raise_end_of_file();
+      caml_MD5Update(&ctx, (unsigned char *) buffer, read);
+      toread -= read;
+    }
+  }
+  res = caml_alloc_string(16);
+  caml_MD5Final(&Byte_u(res, 0), &ctx);
+  Unlock(chan);
+  CAMLreturn (res);
+}
+
+CAMLprim value caml_md5_chan(value vchan, value len)
+{
+   CAMLparam2 (vchan, len);
+   CAMLreturn (caml_md5_channel(Channel(vchan), Long_val(len)));
+}
+
+CAMLexport void caml_md5_block(unsigned char digest[16],
+                               void * data, uintnat len)
+{
+  struct MD5Context ctx;
+  caml_MD5Init(&ctx);
+  caml_MD5Update(&ctx, data, len);
+  caml_MD5Final(digest, &ctx);
+}
+
+/*
+ * This code implements the MD5 message-digest algorithm.
+ * The algorithm is due to Ron Rivest.  This code was
+ * written by Colin Plumb in 1993, no copyright is claimed.
+ * This code is in the public domain; do with it what you wish.
+ *
+ * Equivalent code is available from RSA Data Security, Inc.
+ * This code has been tested against that, and is equivalent,
+ * except that you don't need to include two pages of legalese
+ * with every copy.
+ *
+ * To compute the message digest of a chunk of bytes, declare an
+ * MD5Context structure, pass it to caml_MD5Init, call caml_MD5Update as
+ * needed on buffers full of bytes, and then call caml_MD5Final, which
+ * will fill a supplied 16-byte array with the digest.
+ */
+
+#ifndef ARCH_BIG_ENDIAN
+#define byteReverse(buf, len)   /* Nothing */
+#else
+static void byteReverse(unsigned char * buf, unsigned longs)
+{
+    uint32_t t;
+    do {
+        t = (uint32_t) ((unsigned) buf[3] << 8 | buf[2]) << 16 |
+            ((unsigned) buf[1] << 8 | buf[0]);
+        *(uint32_t *) buf = t;
+        buf += 4;
+    } while (--longs);
+}
+#endif
+
+/*
+ * Start MD5 accumulation.  Set bit count to 0 and buffer to mysterious
+ * initialization constants.
+ */
+CAMLexport void caml_MD5Init(struct MD5Context *ctx)
+{
+    ctx->buf[0] = 0x67452301;
+    ctx->buf[1] = 0xefcdab89;
+    ctx->buf[2] = 0x98badcfe;
+    ctx->buf[3] = 0x10325476;
+
+    ctx->bits[0] = 0;
+    ctx->bits[1] = 0;
+}
+
+/*
+ * Update context to reflect the concatenation of another buffer full
+ * of bytes.
+ */
+CAMLexport void caml_MD5Update(struct MD5Context *ctx, unsigned char *buf,
+                               uintnat len)
+{
+    uint32_t t;
+
+    /* Update bitcount */
+
+    t = ctx->bits[0];
+    if ((ctx->bits[0] = t + ((uint32_t) len << 3)) < t)
+        ctx->bits[1]++;         /* Carry from low to high */
+    ctx->bits[1] += len >> 29;
+
+    t = (t >> 3) & 0x3f;        /* Bytes already in shsInfo->data */
+
+    /* Handle any leading odd-sized chunks */
+
+    if (t) {
+        unsigned char *p = (unsigned char *) ctx->in + t;
+
+        t = 64 - t;
+        if (len < t) {
+            memcpy(p, buf, len);
+            return;
+        }
+        memcpy(p, buf, t);
+        byteReverse(ctx->in, 16);
+        caml_MD5Transform(ctx->buf, (uint32_t *) ctx->in);
+        buf += t;
+        len -= t;
+    }
+    /* Process data in 64-byte chunks */
+
+    while (len >= 64) {
+        memcpy(ctx->in, buf, 64);
+        byteReverse(ctx->in, 16);
+        caml_MD5Transform(ctx->buf, (uint32_t *) ctx->in);
+        buf += 64;
+        len -= 64;
+    }
+
+    /* Handle any remaining bytes of data. */
+
+    memcpy(ctx->in, buf, len);
+}
+
+/*
+ * Final wrapup - pad to 64-byte boundary with the bit pattern
+ * 1 0* (64-bit count of bits processed, MSB-first)
+ */
+CAMLexport void caml_MD5Final(unsigned char *digest, struct MD5Context *ctx)
+{
+    unsigned count;
+    unsigned char *p;
+
+    /* Compute number of bytes mod 64 */
+    count = (ctx->bits[0] >> 3) & 0x3F;
+
+    /* Set the first char of padding to 0x80.  This is safe since there is
+       always at least one byte free */
+    p = ctx->in + count;
+    *p++ = 0x80;
+
+    /* Bytes of padding needed to make 64 bytes */
+    count = 64 - 1 - count;
+
+    /* Pad out to 56 mod 64 */
+    if (count < 8) {
+        /* Two lots of padding:  Pad the first block to 64 bytes */
+        memset(p, 0, count);
+        byteReverse(ctx->in, 16);
+        caml_MD5Transform(ctx->buf, (uint32_t *) ctx->in);
+
+        /* Now fill the next block with 56 bytes */
+        memset(ctx->in, 0, 56);
+    } else {
+        /* Pad block to 56 bytes */
+        memset(p, 0, count - 8);
+    }
+    byteReverse(ctx->in, 14);
+
+    /* Append length in bits and transform */
+    ((uint32_t *) ctx->in)[14] = ctx->bits[0];
+    ((uint32_t *) ctx->in)[15] = ctx->bits[1];
+
+    caml_MD5Transform(ctx->buf, (uint32_t *) ctx->in);
+    byteReverse((unsigned char *) ctx->buf, 4);
+    memcpy(digest, ctx->buf, 16);
+    memset(ctx, 0, sizeof(*ctx));        /* In case it's sensitive */
+}
+
+/* The four core functions - F1 is optimized somewhat */
+
+/* #define F1(x, y, z) (x & y | ~x & z) */
+#define F1(x, y, z) (z ^ (x & (y ^ z)))
+#define F2(x, y, z) F1(z, x, y)
+#define F3(x, y, z) (x ^ y ^ z)
+#define F4(x, y, z) (y ^ (x | ~z))
+
+/* This is the central step in the MD5 algorithm. */
+#define MD5STEP(f, w, x, y, z, data, s) \
+        ( w += f(x, y, z) + data,  w = w<<s | w>>(32-s),  w += x )
+
+/*
+ * The core of the MD5 algorithm, this alters an existing MD5 hash to
+ * reflect the addition of 16 longwords of new data.  caml_MD5Update blocks
+ * the data and converts bytes into longwords for this routine.
+ */
+CAMLexport void caml_MD5Transform(uint32_t *buf, uint32_t *in)
+{
+    register uint32_t a, b, c, d;
+
+    a = buf[0];
+    b = buf[1];
+    c = buf[2];
+    d = buf[3];
+
+    MD5STEP(F1, a, b, c, d, in[0] + 0xd76aa478, 7);
+    MD5STEP(F1, d, a, b, c, in[1] + 0xe8c7b756, 12);
+    MD5STEP(F1, c, d, a, b, in[2] + 0x242070db, 17);
+    MD5STEP(F1, b, c, d, a, in[3] + 0xc1bdceee, 22);
+    MD5STEP(F1, a, b, c, d, in[4] + 0xf57c0faf, 7);
+    MD5STEP(F1, d, a, b, c, in[5] + 0x4787c62a, 12);
+    MD5STEP(F1, c, d, a, b, in[6] + 0xa8304613, 17);
+    MD5STEP(F1, b, c, d, a, in[7] + 0xfd469501, 22);
+    MD5STEP(F1, a, b, c, d, in[8] + 0x698098d8, 7);
+    MD5STEP(F1, d, a, b, c, in[9] + 0x8b44f7af, 12);
+    MD5STEP(F1, c, d, a, b, in[10] + 0xffff5bb1, 17);
+    MD5STEP(F1, b, c, d, a, in[11] + 0x895cd7be, 22);
+    MD5STEP(F1, a, b, c, d, in[12] + 0x6b901122, 7);
+    MD5STEP(F1, d, a, b, c, in[13] + 0xfd987193, 12);
+    MD5STEP(F1, c, d, a, b, in[14] + 0xa679438e, 17);
+    MD5STEP(F1, b, c, d, a, in[15] + 0x49b40821, 22);
+
+    MD5STEP(F2, a, b, c, d, in[1] + 0xf61e2562, 5);
+    MD5STEP(F2, d, a, b, c, in[6] + 0xc040b340, 9);
+    MD5STEP(F2, c, d, a, b, in[11] + 0x265e5a51, 14);
+    MD5STEP(F2, b, c, d, a, in[0] + 0xe9b6c7aa, 20);
+    MD5STEP(F2, a, b, c, d, in[5] + 0xd62f105d, 5);
+    MD5STEP(F2, d, a, b, c, in[10] + 0x02441453, 9);
+    MD5STEP(F2, c, d, a, b, in[15] + 0xd8a1e681, 14);
+    MD5STEP(F2, b, c, d, a, in[4] + 0xe7d3fbc8, 20);
+    MD5STEP(F2, a, b, c, d, in[9] + 0x21e1cde6, 5);
+    MD5STEP(F2, d, a, b, c, in[14] + 0xc33707d6, 9);
+    MD5STEP(F2, c, d, a, b, in[3] + 0xf4d50d87, 14);
+    MD5STEP(F2, b, c, d, a, in[8] + 0x455a14ed, 20);
+    MD5STEP(F2, a, b, c, d, in[13] + 0xa9e3e905, 5);
+    MD5STEP(F2, d, a, b, c, in[2] + 0xfcefa3f8, 9);
+    MD5STEP(F2, c, d, a, b, in[7] + 0x676f02d9, 14);
+    MD5STEP(F2, b, c, d, a, in[12] + 0x8d2a4c8a, 20);
+
+    MD5STEP(F3, a, b, c, d, in[5] + 0xfffa3942, 4);
+    MD5STEP(F3, d, a, b, c, in[8] + 0x8771f681, 11);
+    MD5STEP(F3, c, d, a, b, in[11] + 0x6d9d6122, 16);
+    MD5STEP(F3, b, c, d, a, in[14] + 0xfde5380c, 23);
+    MD5STEP(F3, a, b, c, d, in[1] + 0xa4beea44, 4);
+    MD5STEP(F3, d, a, b, c, in[4] + 0x4bdecfa9, 11);
+    MD5STEP(F3, c, d, a, b, in[7] + 0xf6bb4b60, 16);
+    MD5STEP(F3, b, c, d, a, in[10] + 0xbebfbc70, 23);
+    MD5STEP(F3, a, b, c, d, in[13] + 0x289b7ec6, 4);
+    MD5STEP(F3, d, a, b, c, in[0] + 0xeaa127fa, 11);
+    MD5STEP(F3, c, d, a, b, in[3] + 0xd4ef3085, 16);
+    MD5STEP(F3, b, c, d, a, in[6] + 0x04881d05, 23);
+    MD5STEP(F3, a, b, c, d, in[9] + 0xd9d4d039, 4);
+    MD5STEP(F3, d, a, b, c, in[12] + 0xe6db99e5, 11);
+    MD5STEP(F3, c, d, a, b, in[15] + 0x1fa27cf8, 16);
+    MD5STEP(F3, b, c, d, a, in[2] + 0xc4ac5665, 23);
+
+    MD5STEP(F4, a, b, c, d, in[0] + 0xf4292244, 6);
+    MD5STEP(F4, d, a, b, c, in[7] + 0x432aff97, 10);
+    MD5STEP(F4, c, d, a, b, in[14] + 0xab9423a7, 15);
+    MD5STEP(F4, b, c, d, a, in[5] + 0xfc93a039, 21);
+    MD5STEP(F4, a, b, c, d, in[12] + 0x655b59c3, 6);
+    MD5STEP(F4, d, a, b, c, in[3] + 0x8f0ccc92, 10);
+    MD5STEP(F4, c, d, a, b, in[10] + 0xffeff47d, 15);
+    MD5STEP(F4, b, c, d, a, in[1] + 0x85845dd1, 21);
+    MD5STEP(F4, a, b, c, d, in[8] + 0x6fa87e4f, 6);
+    MD5STEP(F4, d, a, b, c, in[15] + 0xfe2ce6e0, 10);
+    MD5STEP(F4, c, d, a, b, in[6] + 0xa3014314, 15);
+    MD5STEP(F4, b, c, d, a, in[13] + 0x4e0811a1, 21);
+    MD5STEP(F4, a, b, c, d, in[4] + 0xf7537e82, 6);
+    MD5STEP(F4, d, a, b, c, in[11] + 0xbd3af235, 10);
+    MD5STEP(F4, c, d, a, b, in[2] + 0x2ad7d2bb, 15);
+    MD5STEP(F4, b, c, d, a, in[9] + 0xeb86d391, 21);
+
+    buf[0] += a;
+    buf[1] += b;
+    buf[2] += c;
+    buf[3] += d;
+}
diff --git a/runtime/memory.c b/runtime/memory.c
new file mode 100644
index 00000000..6eb454b7
--- /dev/null
+++ b/runtime/memory.c
@@ -0,0 +1,1023 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*              Damien Doligez, projet Para, 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
+
+#include <stdlib.h>
+#include <string.h>
+#include <stdarg.h>
+#include <stddef.h>
+#include "caml/address_class.h"
+#include "caml/config.h"
+#include "caml/fail.h"
+#include "caml/freelist.h"
+#include "caml/gc.h"
+#include "caml/gc_ctrl.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/major_gc.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/signals.h"
+#include "caml/memprof.h"
+#include "caml/eventlog.h"
+
+int caml_huge_fallback_count = 0;
+/* Number of times that mmapping big pages fails and we fell back to small
+   pages. This counter is available to the program through
+   [Gc.huge_fallback_count].
+*/
+
+uintnat caml_use_huge_pages = 0;
+/* True iff the program allocates heap chunks by mmapping huge pages.
+   This is set when parsing [OCAMLRUNPARAM] and must stay constant
+   after that.
+*/
+
+extern uintnat caml_percent_free;                   /* major_gc.c */
+
+/* Page table management */
+
+#define Page(p) ((uintnat) (p) >> Page_log)
+#define Page_mask ((uintnat) -1 << Page_log)
+
+#ifdef ARCH_SIXTYFOUR
+
+/* 64-bit implementation:
+   The page table is represented sparsely as a hash table
+   with linear probing */
+
+struct page_table {
+  mlsize_t size;                /* size == 1 << (wordsize - shift) */
+  int shift;
+  mlsize_t mask;                /* mask == size - 1 */
+  mlsize_t occupancy;
+  uintnat * entries;            /* [size]  */
+};
+
+static struct page_table caml_page_table;
+
+/* Page table entries are the logical 'or' of
+   - the key: address of a page (low Page_log bits = 0)
+   - the data: a 8-bit integer */
+
+#define Page_entry_matches(entry,addr) \
+  ((((entry) ^ (addr)) & Page_mask) == 0)
+
+/* Multiplicative Fibonacci hashing
+   (Knuth, TAOCP vol 3, section 6.4, page 518).
+   HASH_FACTOR is (sqrt(5) - 1) / 2 * 2^wordsize. */
+#ifdef ARCH_SIXTYFOUR
+#define HASH_FACTOR 11400714819323198486UL
+#else
+#define HASH_FACTOR 2654435769UL
+#endif
+#define Hash(v) (((v) * HASH_FACTOR) >> caml_page_table.shift)
+
+int caml_page_table_lookup(void * addr)
+{
+  uintnat h, e;
+
+  h = Hash(Page(addr));
+  /* The first hit is almost always successful, so optimize for this case */
+  e = caml_page_table.entries[h];
+  if (Page_entry_matches(e, (uintnat)addr)) return e & 0xFF;
+  while(1) {
+    if (e == 0) return 0;
+    h = (h + 1) & caml_page_table.mask;
+    e = caml_page_table.entries[h];
+    if (Page_entry_matches(e, (uintnat)addr)) return e & 0xFF;
+  }
+}
+
+int caml_page_table_initialize(mlsize_t bytesize)
+{
+  uintnat pagesize = Page(bytesize);
+
+  caml_page_table.size = 1;
+  caml_page_table.shift = 8 * sizeof(uintnat);
+  /* Aim for initial load factor between 1/4 and 1/2 */
+  while (caml_page_table.size < 2 * pagesize) {
+    caml_page_table.size <<= 1;
+    caml_page_table.shift -= 1;
+  }
+  caml_page_table.mask = caml_page_table.size - 1;
+  caml_page_table.occupancy = 0;
+  caml_page_table.entries =
+    caml_stat_calloc_noexc(caml_page_table.size, sizeof(uintnat));
+  if (caml_page_table.entries == NULL)
+    return -1;
+  else
+    return 0;
+}
+
+static int caml_page_table_resize(void)
+{
+  struct page_table old = caml_page_table;
+  uintnat * new_entries;
+  uintnat i, h;
+
+  caml_gc_message (0x08, "Growing page table to %"
+                   ARCH_INTNAT_PRINTF_FORMAT "u entries\n",
+                   caml_page_table.size);
+
+  new_entries = caml_stat_calloc_noexc(2 * old.size, sizeof(uintnat));
+  if (new_entries == NULL) {
+    caml_gc_message (0x08, "No room for growing page table\n");
+    return -1;
+  }
+
+  caml_page_table.size = 2 * old.size;
+  caml_page_table.shift = old.shift - 1;
+  caml_page_table.mask = caml_page_table.size - 1;
+  caml_page_table.occupancy = old.occupancy;
+  caml_page_table.entries = new_entries;
+
+  for (i = 0; i < old.size; i++) {
+    uintnat e = old.entries[i];
+    if (e == 0) continue;
+    h = Hash(Page(e));
+    while (caml_page_table.entries[h] != 0)
+      h = (h + 1) & caml_page_table.mask;
+    caml_page_table.entries[h] = e;
+  }
+
+  caml_stat_free(old.entries);
+  return 0;
+}
+
+static int caml_page_table_modify(uintnat page, int toclear, int toset)
+{
+  uintnat h;
+
+  CAMLassert ((page & ~Page_mask) == 0);
+
+  /* Resize to keep load factor below 1/2 */
+  if (caml_page_table.occupancy * 2 >= caml_page_table.size) {
+    if (caml_page_table_resize() != 0) return -1;
+  }
+  h = Hash(Page(page));
+  while (1) {
+    if (caml_page_table.entries[h] == 0) {
+      caml_page_table.entries[h] = page | toset;
+      caml_page_table.occupancy++;
+      break;
+    }
+    if (Page_entry_matches(caml_page_table.entries[h], page)) {
+      caml_page_table.entries[h] =
+        (caml_page_table.entries[h] & ~toclear) | toset;
+      break;
+    }
+    h = (h + 1) & caml_page_table.mask;
+  }
+  return 0;
+}
+
+#else
+
+/* 32-bit implementation:
+   The page table is represented as a 2-level array of unsigned char */
+
+CAMLexport unsigned char * caml_page_table[Pagetable1_size];
+static unsigned char caml_page_table_empty[Pagetable2_size] = { 0, };
+
+int caml_page_table_initialize(mlsize_t bytesize)
+{
+  int i;
+  for (i = 0; i < Pagetable1_size; i++)
+    caml_page_table[i] = caml_page_table_empty;
+  return 0;
+}
+
+static int caml_page_table_modify(uintnat page, int toclear, int toset)
+{
+  uintnat i = Pagetable_index1(page);
+  uintnat j = Pagetable_index2(page);
+
+  if (caml_page_table[i] == caml_page_table_empty) {
+    unsigned char * new_tbl = caml_stat_calloc_noexc(Pagetable2_size, 1);
+    if (new_tbl == 0) return -1;
+    caml_page_table[i] = new_tbl;
+  }
+  caml_page_table[i][j] = (caml_page_table[i][j] & ~toclear) | toset;
+  return 0;
+}
+
+#endif
+
+int caml_page_table_add(int kind, void * start, void * end)
+{
+  uintnat pstart = (uintnat) start & Page_mask;
+  uintnat pend = ((uintnat) end - 1) & Page_mask;
+  uintnat p;
+
+  for (p = pstart; p <= pend; p += Page_size)
+    if (caml_page_table_modify(p, 0, kind) != 0) return -1;
+  return 0;
+}
+
+int caml_page_table_remove(int kind, void * start, void * end)
+{
+  uintnat pstart = (uintnat) start & Page_mask;
+  uintnat pend = ((uintnat) end - 1) & Page_mask;
+  uintnat p;
+
+  for (p = pstart; p <= pend; p += Page_size)
+    if (caml_page_table_modify(p, kind, 0) != 0) return -1;
+  return 0;
+}
+
+/* Allocate a block of the requested size, to be passed to
+   [caml_add_to_heap] later.
+   [request] will be rounded up to some implementation-dependent size.
+   The caller must use [Chunk_size] on the result to recover the actual
+   size.
+   Return NULL if the request cannot be satisfied. The returned pointer
+   is a hp, but the header (and the contents) must be initialized by the
+   caller.
+*/
+char *caml_alloc_for_heap (asize_t request)
+{
+  if (caml_use_huge_pages){
+#ifdef HAS_HUGE_PAGES
+    uintnat size = Round_mmap_size (sizeof (heap_chunk_head) + request);
+    void *block;
+    char *mem;
+    block = mmap (NULL, size, PROT_READ | PROT_WRITE,
+                  MAP_PRIVATE | MAP_ANONYMOUS | MAP_HUGETLB, -1, 0);
+    if (block == MAP_FAILED) return NULL;
+    mem = (char *) block + sizeof (heap_chunk_head);
+    Chunk_size (mem) = size - sizeof (heap_chunk_head);
+    Chunk_block (mem) = block;
+    return mem;
+#else
+    return NULL;
+#endif
+  }else{
+    char *mem;
+    void *block;
+
+    request = ((request + Page_size - 1) >> Page_log) << Page_log;
+    mem = caml_stat_alloc_aligned_noexc (request + sizeof (heap_chunk_head),
+                                         sizeof (heap_chunk_head), &block);
+    if (mem == NULL) return NULL;
+    mem += sizeof (heap_chunk_head);
+    Chunk_size (mem) = request;
+    Chunk_block (mem) = block;
+    return mem;
+  }
+}
+
+/* Use this function if a block allocated with [caml_alloc_for_heap] is
+   not actually going to be added to the heap.  The caller is responsible
+   for freeing it. */
+void caml_disown_for_heap (char* mem)
+{
+  /* Currently a no-op. */
+  (void)mem; /* can CAMLunused_{start,end} be used here? */
+}
+
+/* Use this function to free a block allocated with [caml_alloc_for_heap]
+   if you don't add it with [caml_add_to_heap].
+*/
+void caml_free_for_heap (char *mem)
+{
+  if (caml_use_huge_pages){
+#ifdef HAS_HUGE_PAGES
+    munmap (Chunk_block (mem), Chunk_size (mem) + sizeof (heap_chunk_head));
+#else
+    CAMLassert (0);
+#endif
+  }else{
+    caml_stat_free (Chunk_block (mem));
+  }
+}
+
+/* Take a chunk of memory as argument, which must be the result of a
+   call to [caml_alloc_for_heap], and insert it into the heap chaining.
+   The contents of the chunk must be a sequence of valid blocks and
+   fragments: no space between blocks and no trailing garbage.  If
+   some blocks are blue, they must be added to the free list by the
+   caller.  All other blocks must have the color [caml_allocation_color(m)].
+   The caller must update [caml_allocated_words] if applicable.
+   Return value: 0 if no error; -1 in case of error.
+
+   See also: caml_compact_heap, which duplicates most of this function.
+*/
+int caml_add_to_heap (char *m)
+{
+#ifdef DEBUG
+  /* Should check the contents of the block. */
+#endif /* DEBUG */
+
+  caml_gc_message (0x04, "Growing heap to %"
+                   ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
+     (Bsize_wsize (Caml_state->stat_heap_wsz) + Chunk_size (m)) / 1024);
+
+  /* Register block in page table */
+  if (caml_page_table_add(In_heap, m, m + Chunk_size(m)) != 0)
+    return -1;
+
+  /* Chain this heap chunk. */
+  {
+    char **last = &caml_heap_start;
+    char *cur = *last;
+
+    while (cur != NULL && cur < m){
+      last = &(Chunk_next (cur));
+      cur = *last;
+    }
+    Chunk_next (m) = cur;
+    *last = m;
+
+    ++ Caml_state->stat_heap_chunks;
+  }
+
+  Caml_state->stat_heap_wsz += Wsize_bsize (Chunk_size (m));
+  if (Caml_state->stat_heap_wsz > Caml_state->stat_top_heap_wsz){
+    Caml_state->stat_top_heap_wsz = Caml_state->stat_heap_wsz;
+  }
+  return 0;
+}
+
+/* Allocate more memory from malloc for the heap.
+   Return a blue block of at least the requested size.
+   The blue block is chained to a sequence of blue blocks (through their
+   field 0); the last block of the chain is pointed by field 1 of the
+   first.  There may be a fragment after the last block.
+   The caller must insert the blocks into the free list.
+   [request] is a number of words and must be less than or equal
+   to [Max_wosize].
+   Return NULL when out of memory.
+*/
+static value *expand_heap (mlsize_t request)
+{
+  /* these point to headers, but we do arithmetic on them, hence [value *]. */
+  value *mem, *hp, *prev;
+  asize_t over_request, malloc_request, remain;
+
+  CAMLassert (request <= Max_wosize);
+  over_request = request + request / 100 * caml_percent_free;
+  malloc_request = caml_clip_heap_chunk_wsz (over_request);
+  mem = (value *) caml_alloc_for_heap (Bsize_wsize (malloc_request));
+  if (mem == NULL){
+    caml_gc_message (0x04, "No room for growing heap\n");
+    return NULL;
+  }
+  remain = Wsize_bsize (Chunk_size (mem));
+  prev = hp = mem;
+  /* FIXME find a way to do this with a call to caml_make_free_blocks */
+  while (Wosize_whsize (remain) > Max_wosize){
+    Hd_hp (hp) = Make_header (Max_wosize, 0, Caml_blue);
+#ifdef DEBUG
+    caml_set_fields (Val_hp (hp), 0, Debug_free_major);
+#endif
+    hp += Whsize_wosize (Max_wosize);
+    remain -= Whsize_wosize (Max_wosize);
+    Field (Val_hp (mem), 1) = Field (Val_hp (prev), 0) = Val_hp (hp);
+    prev = hp;
+  }
+  if (remain > 1){
+    Hd_hp (hp) = Make_header (Wosize_whsize (remain), 0, Caml_blue);
+#ifdef DEBUG
+    caml_set_fields (Val_hp (hp), 0, Debug_free_major);
+#endif
+    Field (Val_hp (mem), 1) = Field (Val_hp (prev), 0) = Val_hp (hp);
+    Field (Val_hp (hp), 0) = (value) NULL;
+  }else{
+    Field (Val_hp (prev), 0) = (value) NULL;
+    if (remain == 1) {
+      Hd_hp (hp) = Make_header_allocated_here (0, 0, Caml_white);
+    }
+  }
+  CAMLassert (Wosize_hp (mem) >= request);
+  if (caml_add_to_heap ((char *) mem) != 0){
+    caml_free_for_heap ((char *) mem);
+    return NULL;
+  }
+  return Op_hp (mem);
+}
+
+/* Remove the heap chunk [chunk] from the heap and give the memory back
+   to [free].
+*/
+void caml_shrink_heap (char *chunk)
+{
+  char **cp;
+
+  /* Never deallocate the first chunk, because caml_heap_start is both the
+     first block and the base address for page numbers, and we don't
+     want to shift the page table, it's too messy (see above).
+     It will never happen anyway, because of the way compaction works.
+     (see compact.c)
+     XXX FIXME this has become false with the fix to PR#5389 (see compact.c)
+  */
+  if (chunk == caml_heap_start) return;
+
+  Caml_state->stat_heap_wsz -= Wsize_bsize (Chunk_size (chunk));
+  caml_gc_message (0x04, "Shrinking heap to %"
+                   ARCH_INTNAT_PRINTF_FORMAT "uk words\n",
+                   Caml_state->stat_heap_wsz / 1024);
+
+#ifdef DEBUG
+  {
+    mlsize_t i;
+    for (i = 0; i < Wsize_bsize (Chunk_size (chunk)); i++){
+      ((value *) chunk) [i] = Debug_free_shrink;
+    }
+  }
+#endif
+
+  -- Caml_state->stat_heap_chunks;
+
+  /* Remove [chunk] from the list of chunks. */
+  cp = &caml_heap_start;
+  while (*cp != chunk) cp = &(Chunk_next (*cp));
+  *cp = Chunk_next (chunk);
+
+  /* Remove the pages of [chunk] from the page table. */
+  caml_page_table_remove(In_heap, chunk, chunk + Chunk_size (chunk));
+
+  /* Free the [malloc] block that contains [chunk]. */
+  caml_free_for_heap (chunk);
+}
+
+color_t caml_allocation_color (void *hp)
+{
+  if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean ||
+      (caml_gc_phase == Phase_sweep && (char *)hp >= (char *)caml_gc_sweep_hp)){
+    return Caml_black;
+  }else{
+    CAMLassert (caml_gc_phase == Phase_idle
+            || (caml_gc_phase == Phase_sweep
+                && (char *)hp < (char *)caml_gc_sweep_hp));
+    return Caml_white;
+  }
+}
+
+Caml_inline value caml_alloc_shr_aux (mlsize_t wosize, tag_t tag, int track,
+                                      int raise_oom, uintnat profinfo)
+{
+  header_t *hp;
+  value *new_block;
+
+  if (wosize > Max_wosize) {
+    if (raise_oom)
+      caml_raise_out_of_memory ();
+    else
+      return 0;
+  }
+  CAML_EV_ALLOC(wosize);
+  hp = caml_fl_allocate (wosize);
+  if (hp == NULL){
+    new_block = expand_heap (wosize);
+    if (new_block == NULL) {
+      if (!raise_oom)
+        return 0;
+      else if (Caml_state->in_minor_collection)
+        caml_fatal_error ("out of memory");
+      else
+        caml_raise_out_of_memory ();
+    }
+    caml_fl_add_blocks ((value) new_block);
+    hp = caml_fl_allocate (wosize);
+  }
+
+  CAMLassert (Is_in_heap (Val_hp (hp)));
+
+  /* Inline expansion of caml_allocation_color. */
+  if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean ||
+      (caml_gc_phase == Phase_sweep && (char *)hp >= (char *)caml_gc_sweep_hp)){
+    Hd_hp (hp) = Make_header_with_profinfo (wosize, tag, Caml_black, profinfo);
+  }else{
+    CAMLassert (caml_gc_phase == Phase_idle
+            || (caml_gc_phase == Phase_sweep
+                && (char *)hp < (char *)caml_gc_sweep_hp));
+    Hd_hp (hp) = Make_header_with_profinfo (wosize, tag, Caml_white, profinfo);
+  }
+  CAMLassert (Hd_hp (hp)
+    == Make_header_with_profinfo (wosize, tag, caml_allocation_color (hp),
+                                  profinfo));
+  caml_allocated_words += Whsize_wosize (wosize);
+  if (caml_allocated_words > Caml_state->minor_heap_wsz){
+    CAML_EV_COUNTER (EV_C_REQUEST_MAJOR_ALLOC_SHR, 1);
+    caml_request_major_slice ();
+  }
+#ifdef DEBUG
+  {
+    uintnat i;
+    for (i = 0; i < wosize; i++){
+      Field (Val_hp (hp), i) = Debug_uninit_major;
+    }
+  }
+#endif
+  if(track)
+    caml_memprof_track_alloc_shr(Val_hp (hp));
+  return Val_hp (hp);
+}
+
+#ifdef WITH_PROFINFO
+
+/* Use this to debug problems with macros... */
+#define NO_PROFINFO 0xff
+
+CAMLexport value caml_alloc_shr_with_profinfo (mlsize_t wosize, tag_t tag,
+                                               intnat profinfo)
+{
+  return caml_alloc_shr_aux(wosize, tag, 1, 1, profinfo);
+}
+
+CAMLexport value caml_alloc_shr_for_minor_gc (mlsize_t wosize,
+                                              tag_t tag, header_t old_header)
+{
+  return caml_alloc_shr_aux (wosize, tag, 0, 1, Profinfo_hd(old_header));
+}
+
+#else
+#define NO_PROFINFO 0
+
+CAMLexport value caml_alloc_shr_for_minor_gc (mlsize_t wosize,
+                                              tag_t tag, header_t old_header)
+{
+  return caml_alloc_shr_aux (wosize, tag, 0, 1, NO_PROFINFO);
+}
+#endif /* WITH_PROFINFO */
+
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+#include "caml/spacetime.h"
+
+CAMLexport value caml_alloc_shr (mlsize_t wosize, tag_t tag)
+{
+  return caml_alloc_shr_with_profinfo (wosize, tag,
+    caml_spacetime_my_profinfo (NULL, wosize));
+}
+
+CAMLexport value caml_alloc_shr_no_track_noexc (mlsize_t wosize, tag_t tag)
+{
+  return caml_alloc_shr_aux (wosize, tag, 0, 0,
+                             caml_spacetime_my_profinfo (NULL, wosize));
+}
+#else
+CAMLexport value caml_alloc_shr (mlsize_t wosize, tag_t tag)
+{
+  return caml_alloc_shr_aux (wosize, tag, 1, 1, NO_PROFINFO);
+}
+
+CAMLexport value caml_alloc_shr_no_track_noexc (mlsize_t wosize, tag_t tag)
+{
+  return caml_alloc_shr_aux (wosize, tag, 0, 0, NO_PROFINFO);
+}
+#endif
+
+/* Dependent memory is all memory blocks allocated out of the heap
+   that depend on the GC (and finalizers) for deallocation.
+   For the GC to take dependent memory into account when computing
+   its automatic speed setting,
+   you must call [caml_alloc_dependent_memory] when you allocate some
+   dependent memory, and [caml_free_dependent_memory] when you
+   free it.  In both cases, you pass as argument the size (in bytes)
+   of the block being allocated or freed.
+*/
+CAMLexport void caml_alloc_dependent_memory (mlsize_t nbytes)
+{
+  caml_dependent_size += nbytes / sizeof (value);
+  caml_dependent_allocated += nbytes / sizeof (value);
+}
+
+CAMLexport void caml_free_dependent_memory (mlsize_t nbytes)
+{
+  if (caml_dependent_size < nbytes / sizeof (value)){
+    caml_dependent_size = 0;
+  }else{
+    caml_dependent_size -= nbytes / sizeof (value);
+  }
+}
+
+/* Use this function to tell the major GC to speed up when you use
+   finalized blocks to automatically deallocate resources (other
+   than memory). The GC will do at least one cycle every [max]
+   allocated resources; [res] is the number of resources allocated
+   this time.
+   Note that only [res/max] is relevant.  The units (and kind of
+   resource) can change between calls to [caml_adjust_gc_speed].
+*/
+CAMLexport void caml_adjust_gc_speed (mlsize_t res, mlsize_t max)
+{
+  if (max == 0) max = 1;
+  if (res > max) res = max;
+  caml_extra_heap_resources += (double) res / (double) max;
+  if (caml_extra_heap_resources > 1.0){
+    CAML_EV_COUNTER (EV_C_REQUEST_MAJOR_ADJUST_GC_SPEED, 1);
+    caml_extra_heap_resources = 1.0;
+    caml_request_major_slice ();
+  }
+}
+
+/* You must use [caml_initialize] to store the initial value in a field of
+   a shared block, unless you are sure the value is not a young block.
+   A block value [v] is a shared block if and only if [Is_in_heap (v)]
+   is true.
+*/
+/* [caml_initialize] never calls the GC, so you may call it while a block is
+   unfinished (i.e. just after a call to [caml_alloc_shr].) */
+/* PR#6084 workaround: define it as a weak symbol */
+CAMLexport CAMLweakdef void caml_initialize (value *fp, value val)
+{
+  CAMLassert(Is_in_heap_or_young(fp));
+  *fp = val;
+  if (!Is_young((value)fp) && Is_block (val) && Is_young (val)) {
+    add_to_ref_table (Caml_state->ref_table, fp);
+  }
+}
+
+/* You must use [caml_modify] to change a field of an existing shared block,
+   unless you are sure the value being overwritten is not a shared block and
+   the value being written is not a young block. */
+/* [caml_modify] never calls the GC. */
+/* [caml_modify] can also be used to do assignment on data structures that are
+   in the minor heap instead of in the major heap.  In this case, it
+   is a bit slower than simple assignment.
+   In particular, you can use [caml_modify] when you don't know whether the
+   block being changed is in the minor heap or the major heap. */
+/* PR#6084 workaround: define it as a weak symbol */
+
+CAMLexport CAMLweakdef void caml_modify (value *fp, value val)
+{
+  /* The write barrier implemented by [caml_modify] checks for the
+     following two conditions and takes appropriate action:
+     1- a pointer from the major heap to the minor heap is created
+        --> add [fp] to the remembered set
+     2- a pointer from the major heap to the major heap is overwritten,
+        while the GC is in the marking phase
+        --> call [caml_darken] on the overwritten pointer so that the
+            major GC treats it as an additional root.
+
+     The logic implemented below is duplicated in caml_array_fill to
+     avoid repeated calls to caml_modify and repeated tests on the
+     values.  Don't forget to update caml_array_fill if the logic
+     below changes!
+  */
+  value old;
+
+  if (Is_young((value)fp)) {
+    /* The modified object resides in the minor heap.
+       Conditions 1 and 2 cannot occur. */
+    *fp = val;
+  } else {
+    /* The modified object resides in the major heap. */
+    CAMLassert(Is_in_heap(fp));
+    old = *fp;
+    *fp = val;
+    if (Is_block(old)) {
+      /* If [old] is a pointer within the minor heap, we already
+         have a major->minor pointer and [fp] is already in the
+         remembered set.  Conditions 1 and 2 cannot occur. */
+      if (Is_young(old)) return;
+      /* Here, [old] can be a pointer within the major heap.
+         Check for condition 2. */
+      if (caml_gc_phase == Phase_mark) caml_darken(old, NULL);
+    }
+    /* Check for condition 1. */
+    if (Is_block(val) && Is_young(val)) {
+      add_to_ref_table (Caml_state->ref_table, fp);
+    }
+  }
+}
+
+
+/* Global memory pool.
+
+   The pool is structured as a ring of blocks, where each block's header
+   contains two links: to the previous and to the next block. The data
+   structure allows for insertions and removals of blocks in constant time,
+   given that a pointer to the operated block is provided.
+
+   Initially, the pool contains a single block -- a pivot with no data, the
+   guaranteed existence of which makes for a more concise implementation.
+
+   The API functions that operate on the pool receive not pointers to the
+   block's header, but rather pointers to the block's "data" field. This
+   behaviour is required to maintain compatibility with the interfaces of
+   [malloc], [realloc], and [free] family of functions, as well as to hide
+   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);
+};
+
+struct pool_block {
+#ifdef DEBUG
+  intnat magic;
+#endif
+  struct pool_block *next;
+  struct pool_block *prev;
+  /* Use C99's flexible array types if possible */
+#if (__STDC_VERSION__ >= 199901L)
+  union max_align data[];  /* not allocated, used for alignment purposes */
+#else
+  union max_align data[1];
+#endif
+};
+
+#if (__STDC_VERSION__ >= 199901L)
+#define SIZEOF_POOL_BLOCK sizeof(struct pool_block)
+#else
+#define SIZEOF_POOL_BLOCK offsetof(struct pool_block, data)
+#endif
+
+static struct pool_block *pool = NULL;
+
+
+/* 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)
+    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;
+  }
+}
+
+CAMLexport void caml_stat_create_pool(void)
+{
+  if (pool == NULL) {
+    pool = malloc(SIZEOF_POOL_BLOCK);
+    if (pool == NULL)
+      caml_fatal_error("out of memory");
+#ifdef DEBUG
+    pool->magic = Debug_pool_magic;
+#endif
+    pool->next = pool;
+    pool->prev = pool;
+  }
+}
+
+CAMLexport void caml_stat_destroy_pool(void)
+{
+  if (pool != NULL) {
+    pool->prev->next = NULL;
+    while (pool != NULL) {
+      struct pool_block *next = pool->next;
+      free(pool);
+      pool = next;
+    }
+    pool = NULL;
+  }
+}
+
+/* [sz] and [modulo] are numbers of bytes */
+CAMLexport void* caml_stat_alloc_aligned_noexc(asize_t sz, int modulo,
+                                               caml_stat_block *b)
+{
+  char *raw_mem;
+  uintnat aligned_mem;
+  CAMLassert (0 <= modulo && modulo < Page_size);
+  raw_mem = (char *) caml_stat_alloc_noexc(sz + Page_size);
+  if (raw_mem == NULL) return NULL;
+  *b = raw_mem;
+  raw_mem += modulo;                /* Address to be aligned */
+  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;
+  }
+#endif
+  return (char *) (aligned_mem - modulo);
+}
+
+/* [sz] and [modulo] are numbers of bytes */
+CAMLexport void* caml_stat_alloc_aligned(asize_t sz, int modulo,
+                                         caml_stat_block *b)
+{
+  void *result = caml_stat_alloc_aligned_noexc(sz, modulo, b);
+  /* malloc() may return NULL if size is 0 */
+  if ((result == NULL) && (sz != 0))
+    caml_raise_out_of_memory();
+  return result;
+}
+
+/* [sz] is a number of bytes */
+CAMLexport caml_stat_block caml_stat_alloc_noexc(asize_t sz)
+{
+  /* Backward compatibility mode */
+  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;
+#endif
+
+    /* Linking the block into the ring */
+    pb->next = pool->next;
+    pb->prev = pool;
+    pool->next->prev = pb;
+    pool->next = pb;
+
+    return &(pb->data);
+  }
+}
+
+/* [sz] is a number of bytes */
+CAMLexport caml_stat_block caml_stat_alloc(asize_t sz)
+{
+  void *result = caml_stat_alloc_noexc(sz);
+  /* malloc() may return NULL if size is 0 */
+  if ((result == NULL) && (sz != 0))
+    caml_raise_out_of_memory();
+  return result;
+}
+
+CAMLexport void caml_stat_free(caml_stat_block b)
+{
+  /* Backward compatibility mode */
+  if (pool == NULL)
+    free(b);
+  else {
+    struct pool_block *pb = get_pool_block(b);
+    if (pb == NULL) return;
+
+    /* Unlinking the block from the ring */
+    pb->prev->next = pb->next;
+    pb->next->prev = pb->prev;
+
+    free(pb);
+  }
+}
+
+/* [sz] is a number of bytes */
+CAMLexport caml_stat_block caml_stat_resize_noexc(caml_stat_block b, asize_t sz)
+{
+  if(b == NULL)
+    return caml_stat_alloc_noexc(sz);
+  /* Backward compatibility mode */
+  if (pool == NULL)
+    return realloc(b, sz);
+  else {
+    struct pool_block *pb = get_pool_block(b);
+    struct pool_block *pb_new = realloc(pb, sz + SIZEOF_POOL_BLOCK);
+    if (pb_new == NULL) return NULL;
+
+    /* Relinking the new block into the ring in place of the old one */
+    pb_new->prev->next = pb_new;
+    pb_new->next->prev = pb_new;
+
+    return &(pb_new->data);
+  }
+}
+
+/* [sz] is a number of bytes */
+CAMLexport caml_stat_block caml_stat_resize(caml_stat_block b, asize_t sz)
+{
+  void *result = caml_stat_resize_noexc(b, sz);
+  if (result == NULL)
+    caml_raise_out_of_memory();
+  return result;
+}
+
+/* [sz] is a number of bytes */
+CAMLexport caml_stat_block caml_stat_calloc_noexc(asize_t num, asize_t sz)
+{
+  uintnat total;
+  if (caml_umul_overflow(sz, num, &total))
+    return NULL;
+  else {
+    caml_stat_block result = caml_stat_alloc_noexc(total);
+    if (result != NULL)
+      memset(result, 0, total);
+    return result;
+  }
+}
+
+CAMLexport caml_stat_string caml_stat_strdup_noexc(const char *s)
+{
+  size_t slen = strlen(s);
+  caml_stat_block result = caml_stat_alloc_noexc(slen + 1);
+  if (result == NULL)
+    return NULL;
+  memcpy(result, s, slen + 1);
+  return result;
+}
+
+CAMLexport caml_stat_string caml_stat_strdup(const char *s)
+{
+  caml_stat_string result = caml_stat_strdup_noexc(s);
+  if (result == NULL)
+    caml_raise_out_of_memory();
+  return result;
+}
+
+#ifdef _WIN32
+
+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));
+  if (result == NULL)
+    caml_raise_out_of_memory();
+  memcpy(result, s, (slen + 1)*sizeof(wchar_t));
+  return result;
+}
+
+#endif
+
+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++) {
+    const char *s = va_arg(args, const char*);
+    len += strlen(s);
+  }
+  va_end(args);
+
+  result = caml_stat_alloc(len + 1);
+
+  va_start(args, n);
+  p = result;
+  for (i = 0; i < n; i++) {
+    const char *s = va_arg(args, const char*);
+    size_t l = strlen(s);
+    memcpy(p, s, l);
+    p += l;
+  }
+  va_end(args);
+
+  *p = 0;
+  return result;
+}
+
+#ifdef _WIN32
+
+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++) {
+    const wchar_t *s = va_arg(args, const wchar_t*);
+    len += wcslen(s);
+  }
+  va_end(args);
+
+  result = caml_stat_alloc((len + 1)*sizeof(wchar_t));
+
+  va_start(args, n);
+  p = result;
+  for (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));
+    p += l;
+  }
+  va_end(args);
+
+  *p = 0;
+  return result;
+}
+
+#endif
diff --git a/runtime/memprof.c b/runtime/memprof.c
new file mode 100644
index 00000000..aead07a0
--- /dev/null
+++ b/runtime/memprof.c
@@ -0,0 +1,977 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*            Jacques-Henri Jourdan, projet Gallium, INRIA Paris          */
+/*                                                                        */
+/*   Copyright 2016 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
+
+#include <math.h>
+#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/compact.h"
+#include "caml/printexc.h"
+#include "caml/eventlog.h"
+
+#define MT_STATE_SIZE 624
+
+static uint32_t mt_state[MT_STATE_SIZE];
+static uint32_t mt_index;
+
+/* [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 double one_log1m_lambda;
+
+/* [caml_memprof_suspended] is used for masking memprof callbacks when
+   a callback is running or when an uncaught exception handler is
+   called. */
+int caml_memprof_suspended = 0;
+
+/* [callback_running] is used to trigger a fatal error whenever
+   [Thread.exit] is called from a callback. */
+static int callback_running = 0;
+
+static intnat callstack_size;
+
+/* 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))
+
+static value tracker;
+
+
+/* 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;
+
+/* Whether memprof has been initialized.  */
+static int init = 0;
+
+/* Whether memprof is started. */
+static int started = 0;
+
+/* Buffer used to compute backtraces */
+static value* callstack_buffer = NULL;
+static intnat callstack_buffer_len = 0;
+
+/**** Statistical sampling ****/
+
+static double mt_generate_uniform(void)
+{
+  int i;
+  uint32_t y;
+
+  /* Mersenne twister PRNG */
+  if (mt_index == MT_STATE_SIZE) {
+    for (i = 0; i < 227; i++) {
+      y = (mt_state[i] & 0x80000000) + (mt_state[i+1] & 0x7fffffff);
+      mt_state[i] = mt_state[i+397] ^ (y >> 1) ^ ((-(y&1)) & 0x9908b0df);
+    }
+    for (i = 227; i < MT_STATE_SIZE - 1; i++) {
+      y = (mt_state[i] & 0x80000000) + (mt_state[i+1] & 0x7fffffff);
+      mt_state[i] = mt_state[i-227] ^ (y >> 1) ^ ((-(y&1)) & 0x9908b0df);
+    }
+    y = (mt_state[MT_STATE_SIZE - 1] & 0x80000000) + (mt_state[0] & 0x7fffffff);
+    mt_state[MT_STATE_SIZE - 1] =
+      mt_state[396] ^ (y >> 1) ^ ((-(y&1)) & 0x9908b0df);
+    mt_index = 0;
+  }
+
+  y = mt_state[mt_index];
+  y = y ^ (y >> 11);
+  y = y ^ ((y << 7) & 0x9d2c5680);
+  y = y ^ ((y << 15) & 0xefc60000);
+  y = y ^ (y >> 18);
+
+  mt_index++;
+  return y*2.3283064365386962890625e-10 + /* 2^-32 */
+          1.16415321826934814453125e-10; /* 2^-33 */
+}
+
+/* Simulate a geometric variable of parameter [lambda].
+   The result is clipped in [1..Max_long] */
+static uintnat mt_generate_geom(void)
+{
+  double res;
+  CAMLassert(lambda > 0.);
+  /* We use the float versions of exp/log, since these functions are
+     significantly faster, and we really don't need much precision
+     here. The entropy contained in [next_mt_generate_geom] is anyway
+     bounded by the entropy provided by [mt_generate_uniform], which
+     is 32bits. */
+  res = 1 + logf(mt_generate_uniform()) * one_log1m_lambda;
+  if (res > Max_long) return Max_long;
+  return (uintnat)res;
+}
+
+static uintnat next_mt_generate_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 mt_generate_binom(uintnat len)
+{
+  uintnat res;
+  CAMLassert(lambda > 0. && len < Max_long);
+  for (res = 0; next_mt_generate_geom < len; res++)
+    next_mt_generate_geom += mt_generate_geom();
+  next_mt_generate_geom -= len;
+  return res;
+}
+
+/**** 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()
+{
+  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;
+  }
+  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 [caml_memprof_suspended == 1] */
+static value capture_callstack(int alloc_idx)
+{
+  value res;
+  intnat callstack_len =
+    caml_collect_current_callstack(&callstack_buffer, &callstack_buffer_len,
+                                   callstack_size, alloc_idx);
+  CAMLassert(caml_memprof_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;
+  }
+  return res;
+}
+
+/**** Data structures for tracked blocks. ****/
+
+struct tracked {
+  /* Memory block being sampled. This is a weak GC root. */
+  value block;
+
+  /* Number of samples in this block. */
+  uintnat n_samples;
+
+  /* The size of this block. */
+  uintnat wosize;
+
+  /* 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;
+
+  /* Whether this block has been initially allocated in the minor heap. */
+  unsigned int alloc_young : 1;
+
+  /* Whether this block comes from unmarshalling. */
+  unsigned int unmarshalled : 1;
+
+  /* Whether this block has been promoted. Implies [alloc_young]. */
+  unsigned int promoted : 1;
+
+  /* Whether this block has been deallocated. */
+  unsigned int deallocated : 1;
+
+  /* Whether the allocation callback has been called. */
+  unsigned int cb_alloc_called : 1;
+
+  /* Whether the promotion callback has been called. */
+  unsigned int cb_promote_called : 1;
+
+  /* Whether the deallocation callback has been called. */
+  unsigned int cb_dealloc_called : 1;
+
+  /* Whether this entry is deleted. */
+  unsigned int deleted : 1;
+
+  /* Whether a callback is currently running for this entry. */
+  unsigned int callback_running : 1;
+
+  /* Pointer to the [t_idx] variable in the [run_callback] frame which
+     is currently running the callback for this entry. This is needed
+     to make [run_callback] reetrant, in the case it is called
+     simultaneously by several threads. */
+  uintnat* idx_ptr;
+};
+
+/* 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)
+
+/* When an entry is deleted, its index is replaced by that integer. */
+#define Invalid_index (~(uintnat)0)
+
+
+static struct tracking_state {
+  struct tracked* entries;
+  /* The allocated capacity of the entries array */
+  uintnat alloc_len;
+  /* The number of active entries. (len <= alloc_len) */
+  uintnat len;
+  /* Before this position, the [block] and [user_data] fields point to
+     the major heap (young <= len). */
+  uintnat young;
+  /* There are no pending callbacks before this position (callback <= len). */
+  uintnat callback;
+  /* There are no blocks to be deleted before this position */
+  uintnat delete;
+} trackst;
+
+#define MIN_TRACKST_ALLOC_LEN 128
+
+
+/* Reallocate the [trackst] array if it is either too small or too
+   large.
+   Returns 1 if reallocation succeeded --[trackst.alloc_len] is at
+   least [trackst.len]--, and 0 otherwise. */
+static int realloc_trackst(void) {
+  uintnat new_alloc_len;
+  struct tracked* new_entries;
+  if (trackst.len <= trackst.alloc_len &&
+     (4*trackst.len >= trackst.alloc_len ||
+      trackst.alloc_len == MIN_TRACKST_ALLOC_LEN))
+    return 1;
+  new_alloc_len = trackst.len * 2;
+  if (new_alloc_len < MIN_TRACKST_ALLOC_LEN)
+    new_alloc_len = MIN_TRACKST_ALLOC_LEN;
+  new_entries = caml_stat_resize_noexc(trackst.entries,
+      new_alloc_len * sizeof(struct tracked));
+  if (new_entries == NULL) return 0;
+  trackst.entries = new_entries;
+  trackst.alloc_len = new_alloc_len;
+  return 1;
+}
+
+Caml_inline uintnat new_tracked(uintnat n_samples, uintnat wosize,
+                                int is_unmarshalled, int is_young,
+                                value block, value user_data)
+{
+  struct tracked *t;
+  trackst.len++;
+  if (!realloc_trackst()) {
+    trackst.len--;
+    return Invalid_index;
+  }
+  t = &trackst.entries[trackst.len - 1];
+  t->block = block;
+  t->n_samples = n_samples;
+  t->wosize = wosize;
+  t->user_data = user_data;
+  t->idx_ptr = NULL;
+  t->alloc_young = is_young;
+  t->unmarshalled = is_unmarshalled;
+  t->promoted = 0;
+  t->deallocated = 0;
+  t->cb_alloc_called = t->cb_promote_called = t->cb_dealloc_called = 0;
+  t->deleted = 0;
+  t->callback_running = 0;
+  return trackst.len - 1;
+}
+
+static void mark_deleted(uintnat t_idx)
+{
+  struct tracked* t = &trackst.entries[t_idx];
+  t->deleted = 1;
+  t->user_data = Val_unit;
+  t->block = Val_unit;
+  if (t_idx < trackst.delete) trackst.delete = t_idx;
+  CAMLassert(t->idx_ptr == NULL);
+}
+
+/* The return value is an exception or [Val_unit] iff [*t_idx] is set to
+   [Invalid_index]. In this case, the entry is deleted.
+   Otherwise, the return value is a [Some(...)] block. */
+Caml_inline value run_callback_exn(uintnat *t_idx, value cb, value param) {
+  struct tracked* t = &trackst.entries[*t_idx];
+  value res;
+  CAMLassert(!t->callback_running && t->idx_ptr == NULL);
+  CAMLassert(lambda > 0.);
+
+  callback_running = t->callback_running = 1;
+  t->idx_ptr = t_idx;
+  res = caml_callback_exn(cb, param);
+  callback_running = 0;
+  /* The call above can modify [*t_idx] and thus invalidate [t]. */
+  if (*t_idx == Invalid_index) {
+    /* Make sure this entry has not been removed by [caml_memprof_set] */
+    return Val_unit;
+  }
+  t = &trackst.entries[*t_idx];
+  t->idx_ptr = NULL;
+  t->callback_running = 0;
+  if (Is_exception_result(res) || res == Val_unit) {
+    /* Callback raised an exception or returned None or (), discard
+       this entry. */
+    mark_deleted(*t_idx);
+    *t_idx = Invalid_index;
+  }
+  return res;
+}
+
+/* Run all the needed callbacks for a given entry.
+   In case of a thread context switch during a callback, this can be
+   called in a reetrant way.
+   If [*t_idx] equals [trackst.callback], then this function
+   increments [trackst.callback].
+   The index of the entry may change. It is set to [Invalid_index] if
+   the entry is discarded.
+   Returns:
+   - An exception result if the callback raised an exception
+   - Val_long(0) == Val_unit == None otherwise
+ */
+static value handle_entry_callbacks_exn(uintnat* t_idx)
+{
+  value sample_info, res, user_data;    /* No need to make these roots */
+  struct tracked* t = &trackst.entries[*t_idx];
+  if (*t_idx == trackst.callback) trackst.callback++;
+
+  if (t->deleted || t->callback_running) return Val_unit;
+
+  if (!t->cb_alloc_called) {
+    t->cb_alloc_called = 1;
+    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->unmarshalled);
+    Field(sample_info, 3) = t->user_data;
+    t->user_data = Val_unit;
+    res = run_callback_exn(t_idx,
+        t->alloc_young ? Alloc_minor(tracker) : Alloc_major(tracker),
+        sample_info);
+    if (*t_idx == Invalid_index)
+      return res;
+    CAMLassert(!Is_exception_result(res) && Is_block(res) && Tag_val(res) == 0
+               && Wosize_val(res) == 1);
+    t = &trackst.entries[*t_idx];
+    t->user_data = Field(res, 0);
+    if (Is_block(t->user_data) && Is_young(t->user_data) &&
+        *t_idx < trackst.young)
+      trackst.young = *t_idx;
+  }
+
+  if (t->promoted && !t->cb_promote_called) {
+    t->cb_promote_called = 1;
+    user_data = t->user_data;
+    t->user_data = Val_unit;
+    res = run_callback_exn(t_idx, Promote(tracker), user_data);
+    if (*t_idx == Invalid_index)
+      return res;
+    CAMLassert(!Is_exception_result(res) && Is_block(res) && Tag_val(res) == 0
+               && Wosize_val(res) == 1);
+    t = &trackst.entries[*t_idx];
+    t->user_data = Field(res, 0);
+    if (Is_block(t->user_data) && Is_young(t->user_data) &&
+        *t_idx < trackst.young)
+      trackst.young = *t_idx;
+  }
+
+  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;
+    user_data = t->user_data;
+    t->user_data = Val_unit;
+    res = run_callback_exn(t_idx, cb, user_data);
+    /* [t] is invalid, but we do no longer use it. */
+    CAMLassert(*t_idx == Invalid_index);
+    CAMLassert(Is_exception_result(res) || res == Val_unit);
+    return res;
+  }
+
+  return Val_unit;
+}
+
+/* Remove any deleted entries, updating callback and young */
+static void flush_deleted(void)
+{
+  uintnat i = trackst.delete, j = i;
+  while (i < trackst.len) {
+    if (!trackst.entries[i].deleted) {
+      if (trackst.entries[i].idx_ptr != NULL)
+        *trackst.entries[i].idx_ptr = j;
+      trackst.entries[j] = trackst.entries[i];
+      j++;
+    }
+    i++;
+    if (trackst.young == i) trackst.young = j;
+    if (trackst.callback == i) trackst.callback = j;
+  }
+  trackst.delete = trackst.len = j;
+  CAMLassert(trackst.callback <= trackst.len);
+  CAMLassert(trackst.young <= trackst.len);
+  realloc_trackst();
+}
+
+static void check_action_pending(void) {
+  if (!caml_memprof_suspended && trackst.callback < trackst.len)
+    caml_set_action_pending();
+}
+
+/* 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)
+{
+  value res = Val_unit;
+  if (caml_memprof_suspended) return res;
+  caml_memprof_suspended = 1;
+  while (trackst.callback < trackst.len) {
+    uintnat i = trackst.callback;
+    res = handle_entry_callbacks_exn(&i);
+    if (Is_exception_result(res)) break;
+  }
+  caml_memprof_suspended = 0;
+  check_action_pending();  /* Needed in case of an exception */
+  flush_deleted();
+  return res;
+}
+
+void caml_memprof_oldify_young_roots(void)
+{
+  uintnat i;
+  /* This loop should always have a small number of iteration (when
+     compared to the size of the minor heap), because the young
+     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 trackst
+     array. */
+  for (i = trackst.young; i < trackst.len; i++)
+    caml_oldify_one(trackst.entries[i].user_data,
+                    &trackst.entries[i].user_data);
+}
+
+void caml_memprof_minor_update(void)
+{
+  uintnat i;
+  /* See comment in [caml_memprof_oldify_young_roots] for the number
+     of iterations of this loop. */
+  for (i = trackst.young; i < trackst.len; i++) {
+    struct tracked *t = &trackst.entries[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 (trackst.callback > trackst.young) {
+    trackst.callback = trackst.young;
+    check_action_pending();
+  }
+  trackst.young = trackst.len;
+}
+
+void caml_memprof_do_roots(scanning_action f)
+{
+  uintnat i;
+  for (i = 0; i < trackst.len; i++)
+    f(trackst.entries[i].user_data, &trackst.entries[i].user_data);
+}
+
+void caml_memprof_update_clean_phase(void)
+{
+  uintnat i;
+  for (i = 0; i < trackst.len; i++) {
+    struct tracked *t = &trackst.entries[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;
+      }
+    }
+  }
+  trackst.callback = 0;
+  check_action_pending();
+}
+
+void caml_memprof_invert_tracked(void)
+{
+  uintnat i;
+  for (i = 0; i < trackst.len; i++)
+    caml_invert_root(trackst.entries[i].block, &trackst.entries[i].block);
+}
+
+/**** Sampling procedures ****/
+
+void caml_memprof_track_alloc_shr(value block)
+{
+  uintnat n_samples;
+  value callstack = 0;
+  CAMLassert(Is_in_heap(block));
+
+  /* This test also makes sure memprof is initialized. */
+  if (lambda == 0 || caml_memprof_suspended) return;
+
+  n_samples = mt_generate_binom(Whsize_val(block));
+  if (n_samples == 0) return;
+
+  callstack = capture_callstack_postponed();
+  if (callstack == 0) return;
+
+  new_tracked(n_samples, Wosize_val(block), 0, 0, block, callstack);
+  check_action_pending();
+}
+
+/* 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_update_young_limit();
+}
+
+/* Renew the next sample in the minor heap. This needs to be called
+   after each minor sampling and after each minor collection. In
+   practice, this is called at each sampling in the minor heap and at
+   each minor collection. Extra calls do not change the statistical
+   properties of the sampling because of the memorylessness of the
+   geometric distribution. */
+void caml_memprof_renew_minor_sample(void)
+{
+
+  if (lambda == 0) /* No trigger in the current minor heap. */
+    caml_memprof_young_trigger = Caml_state->young_alloc_start;
+  else {
+    uintnat geom = mt_generate_geom();
+    if (Caml_state->young_ptr - Caml_state->young_alloc_start < geom)
+      /* No trigger in the current minor heap. */
+      caml_memprof_young_trigger = Caml_state->young_alloc_start;
+    caml_memprof_young_trigger = Caml_state->young_ptr - (geom - 1);
+  }
+
+  caml_update_young_limit();
+}
+
+/* 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)
+{
+  uintnat whsize = Whsize_wosize(wosize);
+  value callstack, res = Val_unit;
+  int alloc_idx = 0, i, allocs_sampled = 0, has_delete = 0;
+  intnat alloc_ofs, trigger_ofs;
+  /* usually, only one allocation is sampled, even when the block contains
+     multiple combined allocations. So, we delay allocating the full
+     sampled_allocs array until we discover we actually need two entries */
+  uintnat first_idx, *idx_tab = &first_idx;
+  double saved_lambda = lambda;
+
+  if (caml_memprof_suspended) {
+    caml_memprof_renew_minor_sample();
+    return;
+  }
+
+  /* If [lambda == 0], 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(lambda > 0);
+
+  if (!from_caml) {
+    unsigned n_samples = 1 +
+      mt_generate_binom(caml_memprof_young_trigger - 1 - Caml_state->young_ptr);
+    CAMLassert(encoded_alloc_lens == NULL);    /* No Comballoc in C! */
+    caml_memprof_renew_minor_sample();
+
+    callstack = capture_callstack_postponed();
+    if (callstack == 0) return;
+
+    new_tracked(n_samples, wosize,
+                0, 1, Val_hp(Caml_state->young_ptr), callstack);
+    check_action_pending();
+    return;
+  }
+
+  /* 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. */
+  Caml_state->young_ptr += whsize;
+  caml_memprof_renew_minor_sample();
+  caml_memprof_suspended = 1;
+
+  /* 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);
+    while (alloc_ofs < trigger_ofs) {
+      n_samples++;
+      trigger_ofs -= mt_generate_geom();
+    }
+    if (n_samples > 0) {
+      uintnat *idx_ptr, t_idx;
+
+      callstack = capture_callstack(alloc_idx);
+      t_idx = new_tracked(n_samples, alloc_wosz,
+                          0, 1, Placeholder_offs(alloc_ofs), callstack);
+      if (t_idx == Invalid_index) continue;
+      res = handle_entry_callbacks_exn(&t_idx);
+      if (t_idx == Invalid_index) {
+        has_delete = 1;
+        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 - (mt_generate_geom() - 1);
+        }
+      }
+      if (Is_exception_result(res)) break;
+      if (t_idx == Invalid_index) continue;
+
+      if (allocs_sampled == 1) {
+        /* Found a second sampled allocation! Allocate a buffer for them */
+        idx_tab = caml_stat_alloc_noexc(sizeof(uintnat) * nallocs);
+        if (idx_tab == NULL) {
+          alloc_ofs = 0;
+          idx_tab = &first_idx;
+          break;
+        }
+        idx_tab[0] = first_idx;
+        if (idx_tab[0] != Invalid_index)
+          trackst.entries[idx_tab[0]].idx_ptr = &idx_tab[0];
+      }
+
+      /* Usually, trackst.entries[...].idx_ptr is owned by the thread
+         running a callback for the entry, if any. Here, we take ownership
+         of idx_ptr until the end of the function.
+
+         This does not conflict with the usual use of idx_ptr because no
+         callbacks can run on this entry until the end of the function:
+         the allocation callback has already run and the other callbacks
+         do not run on Placeholder values */
+      idx_ptr = &idx_tab[allocs_sampled];
+      *idx_ptr = t_idx;
+      trackst.entries[*idx_ptr].idx_ptr = idx_ptr;
+      allocs_sampled++;
+    }
+  }
+
+  CAMLassert(alloc_ofs == 0 || Is_exception_result(res));
+  CAMLassert(allocs_sampled <= nallocs);
+  caml_memprof_suspended = 0;
+  check_action_pending();
+  /* We need to call [check_action_pending] since we
+     reset [caml_memprof_suspended] to 0 (a GC collection may have
+     triggered some new callback).
+
+     We need to make sure that the action pending flag is not set
+     systematically, which is to be expected, since [new_tracked]
+     created a new block without updating
+     [trackst.callback]. Fortunately, [handle_entry_callback_exn]
+     increments [trackst.callback] if it is equal to [t_idx]. */
+
+  /* This condition happens either in the case of an exception or if
+     one of the callbacks returned [None]. If these cases happen
+     frequently, then we need to call [flush_deleted] somewhere to
+     prevent a leak. */
+  if (has_delete)
+    flush_deleted();
+
+  if (Is_exception_result(res)) {
+    for (i = 0; i < allocs_sampled; i++)
+      if (idx_tab[i] != Invalid_index) {
+        struct tracked* t = &trackst.entries[idx_tab[i]];
+        /* 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;
+        if (trackst.callback > idx_tab[i]) {
+          trackst.callback = idx_tab[i];
+          check_action_pending();
+        }
+      }
+    if (idx_tab != &first_idx) caml_stat_free(idx_tab);
+    caml_raise(Extract_exception(res));
+  }
+
+  /* We can now restore the minor heap in the state needed by
+     [Alloc_small_aux]. */
+  if (Caml_state->young_ptr - whsize < Caml_state->young_trigger) {
+    CAML_EV_COUNTER(EV_C_FORCE_MINOR_MEMPROF, 1);
+    caml_gc_dispatch();
+  }
+
+  /* Re-allocate the blocks in the minor heap. We should not call the
+     GC after this. */
+  Caml_state->young_ptr -= whsize;
+
+  /* Make sure this block is not going to be sampled again. */
+  shift_sample(whsize);
+
+  for (i = 0; i < allocs_sampled; i++) {
+    if (idx_tab[i] != Invalid_index) {
+      /* 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]. */
+      struct tracked *t = &trackst.entries[idx_tab[i]];
+      t->block = Val_hp(Caml_state->young_ptr + Offs_placeholder(t->block));
+      t->idx_ptr = NULL;
+      CAMLassert(t->cb_alloc_called);
+      if (idx_tab[i] < trackst.young) trackst.young = idx_tab[i];
+    }
+  }
+  if (idx_tab != &first_idx) caml_stat_free(idx_tab);
+
+  /* /!\ Since the heap is in an invalid state before initialization,
+     very little heap operations are allowed until then. */
+
+  return;
+}
+
+void caml_memprof_track_interned(header_t* block, header_t* blockend) {
+  header_t *p;
+  value callstack = 0;
+  int is_young = Is_young(Val_hp(block));
+
+  if (lambda == 0 || caml_memprof_suspended)
+    return;
+
+  p = block;
+  while (1) {
+    uintnat next_sample = mt_generate_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;
+    }
+
+    if (callstack == 0) callstack = capture_callstack_postponed();
+    if (callstack == 0) break;  /* OOM */
+    new_tracked(mt_generate_binom(next_p - next_sample_p) + 1,
+                Wosize_hp(p), 1, is_young, Val_hp(p), callstack);
+    p = next_p;
+  }
+  check_action_pending();
+}
+
+/**** Interface with the OCaml code. ****/
+
+static void caml_memprof_init(void) {
+  uintnat i;
+
+  init = 1;
+
+  mt_index = MT_STATE_SIZE;
+  mt_state[0] = 42;
+  for (i = 1; i < MT_STATE_SIZE; i++)
+    mt_state[i] = 0x6c078965 * (mt_state[i-1] ^ (mt_state[i-1] >> 30)) + i;
+}
+
+void caml_memprof_shutdown(void) {
+  init = 0;
+  started = 0;
+  lambda = 0.;
+  caml_memprof_suspended = 0;
+  trackst.len = 0;
+  trackst.callback = trackst.young = trackst.delete = 0;
+  caml_stat_free(trackst.entries);
+  trackst.entries = NULL;
+  trackst.alloc_len = 0;
+  caml_stat_free(callstack_buffer);
+  callstack_buffer = NULL;
+  callstack_buffer_len = 0;
+}
+
+CAMLprim value caml_memprof_start(value lv, value szv, value tracker_param)
+{
+  CAMLparam3(lv, szv, tracker_param);
+
+  double l = 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. */
+    caml_invalid_argument("Gc.Memprof.start");
+
+  if (!init) caml_memprof_init();
+
+  lambda = l;
+  if (l > 0) {
+    one_log1m_lambda = l == 1 ? 0 : 1/caml_log1p(-l);
+    next_mt_generate_geom = mt_generate_geom();
+  }
+
+  caml_memprof_renew_minor_sample();
+
+  callstack_size = sz;
+  started = 1;
+
+  tracker = tracker_param;
+  caml_register_generational_global_root(&tracker);
+
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value caml_memprof_stop(value unit)
+{
+  uintnat i;
+
+  if (!started) caml_failwith("Gc.Memprof.stop: not started.");
+
+  /* This call to [caml_memprof_stop] will discard all the previously
+     tracked blocks. We try one last time to call the postponed
+     callbacks. */
+  caml_raise_if_exception(caml_memprof_handle_postponed_exn());
+
+  /* Discard the tracked blocks. */
+  for (i = 0; i < trackst.len; i++)
+    if (trackst.entries[i].idx_ptr != NULL)
+      *trackst.entries[i].idx_ptr = Invalid_index;
+  trackst.len = 0;
+  trackst.callback = trackst.young = trackst.delete = 0;
+  caml_stat_free(trackst.entries);
+  trackst.entries = NULL;
+  trackst.alloc_len = 0;
+
+  lambda = 0;
+  caml_memprof_renew_minor_sample();
+  started = 0;
+
+  caml_remove_generational_global_root(&tracker);
+
+  caml_stat_free(callstack_buffer);
+  callstack_buffer = NULL;
+  callstack_buffer_len = 0;
+
+  return Val_unit;
+}
+
+/**** Interface with systhread. ****/
+
+void caml_memprof_init_th_ctx(struct caml_memprof_th_ctx* ctx) {
+  ctx->suspended = 0;
+  ctx->callback_running = 0;
+}
+
+void caml_memprof_stop_th_ctx(struct caml_memprof_th_ctx* ctx) {
+  /* Make sure that no memprof callback is being executed in this
+     thread. If so, memprof data structures may have pointers to the
+     thread's stack. */
+  if(ctx->callback_running)
+    caml_fatal_error("Thread.exit called from a memprof callback.");
+}
+
+void caml_memprof_save_th_ctx(struct caml_memprof_th_ctx* ctx) {
+  ctx->suspended = caml_memprof_suspended;
+  ctx->callback_running = callback_running;
+}
+
+void caml_memprof_restore_th_ctx(const struct caml_memprof_th_ctx* ctx) {
+  caml_memprof_suspended = ctx->suspended;
+  callback_running = ctx->callback_running;
+  check_action_pending();
+}
diff --git a/runtime/meta.c b/runtime/meta.c
new file mode 100644
index 00000000..28283328
--- /dev/null
+++ b/runtime/meta.c
@@ -0,0 +1,281 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* Primitives for the toplevel */
+
+#include <string.h>
+#include "caml/alloc.h"
+#include "caml/backtrace_prim.h"
+#include "caml/config.h"
+#include "caml/debugger.h"
+#include "caml/fail.h"
+#include "caml/fix_code.h"
+#include "caml/interp.h"
+#include "caml/intext.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/prims.h"
+#include "caml/signals.h"
+#include "caml/stacks.h"
+
+#ifndef NATIVE_CODE
+
+CAMLprim value caml_get_global_data(value unit)
+{
+  return caml_global_data;
+}
+
+char * caml_section_table = NULL;
+asize_t caml_section_table_size;
+
+CAMLprim value caml_get_section_table(value unit)
+{
+  if (caml_section_table == NULL) caml_raise_not_found();
+  return caml_input_value_from_block(caml_section_table,
+                                     caml_section_table_size);
+}
+
+struct bytecode {
+  code_t prog;
+  asize_t len;
+};
+#define Bytecode_val(p) ((struct bytecode*)Data_abstract_val(p))
+
+/* Convert a bytes array (= LongString.t) to a contiguous buffer.
+   The result is allocated with caml_stat_alloc */
+static char* buffer_of_bytes_array(value ls, asize_t *len)
+{
+  CAMLparam1(ls);
+  CAMLlocal1(s);
+  asize_t off;
+  char *ret;
+  int i;
+
+  *len = 0;
+  for (i = 0; i < Wosize_val(ls); i++) {
+    s = Field(ls, i);
+    *len += caml_string_length(s);
+  }
+
+  ret = caml_stat_alloc(*len);
+  off = 0;
+  for (i = 0; i < Wosize_val(ls); i++) {
+    size_t s_len;
+    s = Field(ls, i);
+    s_len = caml_string_length(s);
+    memcpy(ret + off, Bytes_val(s), s_len);
+    off += s_len;
+  }
+
+  CAMLreturnT (char*, ret);
+}
+
+CAMLprim value caml_reify_bytecode(value ls_prog,
+                                   value debuginfo,
+                                   value digest_opt)
+{
+  CAMLparam3(ls_prog, debuginfo, digest_opt);
+  CAMLlocal3(clos, bytecode, retval);
+  struct code_fragment * cf = caml_stat_alloc(sizeof(struct code_fragment));
+  code_t prog;
+  asize_t len;
+
+  prog = (code_t)buffer_of_bytes_array(ls_prog, &len);
+  caml_add_debug_info(prog, Val_long(len), debuginfo);
+  cf->code_start = (char *) prog;
+  cf->code_end = (char *) prog + len;
+  /* match (digest_opt : string option) with */
+  if (Is_block(digest_opt)) {
+    /* | Some digest -> */
+    memcpy(cf->digest, String_val(Field(digest_opt, 0)), 16);
+    cf->digest_computed = 1;
+  } else {
+    /* | None -> */
+    cf->digest_computed = 0;
+  }
+  caml_ext_table_add(&caml_code_fragments_table, cf);
+
+#ifdef ARCH_BIG_ENDIAN
+  caml_fixup_endianness((code_t) prog, len);
+#endif
+#ifdef THREADED_CODE
+  caml_thread_code((code_t) prog, len);
+#endif
+  caml_prepare_bytecode((code_t) prog, len);
+
+  /* Notify debugger after fragment gets added and reified. */
+  caml_debugger(CODE_LOADED, Val_long(caml_code_fragments_table.size - 1));
+
+  clos = caml_alloc_small (1, Closure_tag);
+  Code_val(clos) = (code_t) prog;
+  bytecode = caml_alloc_small (2, Abstract_tag);
+  Bytecode_val(bytecode)->prog = prog;
+  Bytecode_val(bytecode)->len = len;
+  retval = caml_alloc_small (2, 0);
+  Field(retval, 0) = bytecode;
+  Field(retval, 1) = clos;
+  CAMLreturn (retval);
+}
+
+/* signal to the interpreter machinery that a bytecode is no more
+   needed (before freeing it) - this might be useful for a JIT
+   implementation */
+
+CAMLprim value caml_static_release_bytecode(value bc)
+{
+  code_t prog;
+  asize_t len;
+  int found, index;
+  struct code_fragment *cf;
+
+  prog = Bytecode_val(bc)->prog;
+  len = Bytecode_val(bc)->len;
+  caml_remove_debug_info(prog);
+
+  found = caml_find_code_fragment((char*) prog, &index, &cf);
+  /* Not matched with a caml_reify_bytecode call; impossible. */
+  CAMLassert(found); (void) found; /* Silence unused variable warning. */
+
+  /* Notify debugger before the fragment gets destroyed. */
+  caml_debugger(CODE_UNLOADED, Val_long(index));
+
+  caml_ext_table_remove(&caml_code_fragments_table, cf);
+
+#ifndef NATIVE_CODE
+  caml_release_bytecode(prog, len);
+#else
+  caml_failwith("Meta.static_release_bytecode impossible with native code");
+#endif
+  caml_stat_free(prog);
+  return Val_unit;
+}
+
+CAMLprim value caml_realloc_global(value size)
+{
+  mlsize_t requested_size, actual_size, i;
+  value new_global_data;
+
+  requested_size = Long_val(size);
+  actual_size = Wosize_val(caml_global_data);
+  if (requested_size >= actual_size) {
+    requested_size = (requested_size + 0x100) & 0xFFFFFF00;
+    caml_gc_message (0x08, "Growing global data to %"
+                     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++)
+      caml_initialize(&Field(new_global_data, i), Field(caml_global_data, i));
+    for (i = actual_size; i < requested_size; i++){
+      Field (new_global_data, i) = Val_long (0);
+    }
+    // Give gc a chance to run, and run memprof callbacks
+    caml_global_data = new_global_data;
+    caml_process_pending_actions();
+  }
+  return Val_unit;
+}
+
+CAMLprim value caml_get_current_environment(value unit)
+{
+  return *Caml_state->extern_sp;
+}
+
+CAMLprim value caml_invoke_traced_function(value codeptr, value env, value arg)
+{
+  /* Stack layout on entry:
+       return frame into instrument_closure function
+       arg3 to call_original_code (arg)
+       arg2 to call_original_code (env)
+       arg1 to call_original_code (codeptr)
+       arg3 to call_original_code (arg)
+       arg2 to call_original_code (env)
+       saved pc
+       saved env */
+
+  /* Stack layout on exit:
+       return frame into instrument_closure function
+       actual arg to code (arg)
+       pseudo return frame into codeptr:
+         extra_args = 0
+         environment = env
+         PC = codeptr
+       arg3 to call_original_code (arg)                   same 7 bottom words as
+       arg2 to call_original_code (env)                   on entrance, but
+       arg1 to call_original_code (codeptr)               shifted down 4 words
+       arg3 to call_original_code (arg)
+       arg2 to call_original_code (env)
+       saved pc
+       saved env */
+
+  value * osp, * nsp;
+  int i;
+
+  osp = Caml_state->extern_sp;
+  Caml_state->extern_sp -= 4;
+  nsp = Caml_state->extern_sp;
+  for (i = 0; i < 7; i++) nsp[i] = osp[i];
+  nsp[7] = codeptr;
+  nsp[8] = env;
+  nsp[9] = Val_int(0);
+  nsp[10] = arg;
+  return Val_unit;
+}
+
+#else
+
+/* Dummy definitions to support compilation of ocamlc.opt */
+
+value caml_get_global_data(value unit)
+{
+  caml_invalid_argument("Meta.get_global_data");
+  return Val_unit; /* not reached */
+}
+
+value caml_get_section_table(value unit)
+{
+  caml_invalid_argument("Meta.get_section_table");
+  return Val_unit; /* not reached */
+}
+
+value caml_realloc_global(value size)
+{
+  caml_invalid_argument("Meta.realloc_global");
+  return Val_unit; /* not reached */
+}
+
+value caml_invoke_traced_function(value codeptr, value env, value arg)
+{
+  caml_invalid_argument("Meta.invoke_traced_function");
+  return Val_unit; /* not reached */
+}
+
+value caml_reify_bytecode(value prog, value len)
+{
+  caml_invalid_argument("Meta.reify_bytecode");
+  return Val_unit; /* not reached */
+}
+
+value caml_static_release_bytecode(value prog, value len)
+{
+  caml_invalid_argument("Meta.static_release_bytecode");
+  return Val_unit; /* not reached */
+}
+
+#endif
diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c
new file mode 100644
index 00000000..b8661bc7
--- /dev/null
+++ b/runtime/minor_gc.c
@@ -0,0 +1,642 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*              Damien Doligez, projet Para, 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
+
+#include <string.h>
+#include "caml/custom.h"
+#include "caml/config.h"
+#include "caml/fail.h"
+#include "caml/finalise.h"
+#include "caml/gc.h"
+#include "caml/gc_ctrl.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/signals.h"
+#include "caml/weak.h"
+#include "caml/memprof.h"
+#ifdef WITH_SPACETIME
+#include "caml/spacetime.h"
+#endif
+#include "caml/eventlog.h"
+
+/* Pointers into the minor heap.
+   [Caml_state->young_base]
+       The [malloc] block that contains the heap.
+   [Caml_state->young_start] ... [Caml_state->young_end]
+       The whole range of the minor heap: all young blocks are inside
+       this interval.
+   [Caml_state->young_alloc_start]...[Caml_state->young_alloc_end]
+       The allocation arena: newly-allocated blocks are carved from
+       this interval, starting at [Caml_state->young_alloc_end].
+   [Caml_state->young_alloc_mid] is the mid-point of this interval.
+   [Caml_state->young_ptr], [Caml_state->young_trigger],
+   [Caml_state->young_limit]
+       These pointers are all inside the allocation arena.
+       - [Caml_state->young_ptr] is where the next allocation will take place.
+       - [Caml_state->young_trigger] is how far we can allocate before
+         triggering [caml_gc_dispatch]. Currently, it is either
+         [Caml_state->young_alloc_start] or the mid-point of the allocation
+         arena.
+       - [Caml_state->young_limit] is the pointer that is compared to
+         [Caml_state->young_ptr] for allocation. It is either:
+            + [Caml_state->young_alloc_end] if a signal handler or
+              finaliser or memprof callback is pending, or if a major
+              or minor collection has been requested, or an
+              asynchronous callback has just raised an exception,
+            + [caml_memprof_young_trigger] if a memprof sample is planned,
+            + or [Caml_state->young_trigger].
+*/
+
+struct generic_table CAML_TABLE_STRUCT(char);
+
+void caml_alloc_minor_tables ()
+{
+  Caml_state->ref_table =
+    caml_stat_alloc_noexc(sizeof(struct caml_ref_table));
+  if (Caml_state->ref_table == NULL)
+    caml_fatal_error ("cannot initialize minor heap");
+  memset(Caml_state->ref_table, 0, sizeof(struct caml_ref_table));
+
+  Caml_state->ephe_ref_table =
+    caml_stat_alloc_noexc(sizeof(struct caml_ephe_ref_table));
+  if (Caml_state->ephe_ref_table == NULL)
+    caml_fatal_error ("cannot initialize minor heap");
+  memset(Caml_state->ephe_ref_table, 0, sizeof(struct caml_ephe_ref_table));
+
+  Caml_state->custom_table =
+    caml_stat_alloc_noexc(sizeof(struct caml_custom_table));
+  if (Caml_state->custom_table == NULL)
+    caml_fatal_error ("cannot initialize minor heap");
+  memset(Caml_state->custom_table, 0, sizeof(struct caml_custom_table));
+}
+
+/* [sz] and [rsv] are numbers of entries */
+static void alloc_generic_table (struct generic_table *tbl, asize_t sz,
+                                 asize_t rsv, asize_t element_size)
+{
+  void *new_table;
+
+  tbl->size = sz;
+  tbl->reserve = rsv;
+  new_table = (void *) caml_stat_alloc_noexc((tbl->size + tbl->reserve) *
+                                             element_size);
+  if (new_table == NULL) caml_fatal_error ("not enough memory");
+  if (tbl->base != NULL) caml_stat_free (tbl->base);
+  tbl->base = new_table;
+  tbl->ptr = tbl->base;
+  tbl->threshold = tbl->base + tbl->size * element_size;
+  tbl->limit = tbl->threshold;
+  tbl->end = tbl->base + (tbl->size + tbl->reserve) * element_size;
+}
+
+void caml_alloc_table (struct caml_ref_table *tbl, asize_t sz, asize_t rsv)
+{
+  alloc_generic_table ((struct generic_table *) tbl, sz, rsv, sizeof (value *));
+}
+
+void caml_alloc_ephe_table (struct caml_ephe_ref_table *tbl, asize_t sz,
+                            asize_t rsv)
+{
+  alloc_generic_table ((struct generic_table *) tbl, sz, rsv,
+                       sizeof (struct caml_ephe_ref_elt));
+}
+
+void caml_alloc_custom_table (struct caml_custom_table *tbl, asize_t sz,
+                              asize_t rsv)
+{
+  alloc_generic_table ((struct generic_table *) tbl, sz, rsv,
+                       sizeof (struct caml_custom_elt));
+}
+
+static void reset_table (struct generic_table *tbl)
+{
+  tbl->size = 0;
+  tbl->reserve = 0;
+  if (tbl->base != NULL) caml_stat_free (tbl->base);
+  tbl->base = tbl->ptr = tbl->threshold = tbl->limit = tbl->end = NULL;
+}
+
+static void clear_table (struct generic_table *tbl)
+{
+    tbl->ptr = tbl->base;
+    tbl->limit = tbl->threshold;
+}
+
+void caml_set_minor_heap_size (asize_t bsz)
+{
+  char *new_heap;
+  void *new_heap_base;
+
+  CAMLassert (bsz >= Bsize_wsize(Minor_heap_min));
+  CAMLassert (bsz <= Bsize_wsize(Minor_heap_max));
+  CAMLassert (bsz % Page_size == 0);
+  CAMLassert (bsz % sizeof (value) == 0);
+  if (Caml_state->young_ptr != Caml_state->young_alloc_end){
+    CAML_EV_COUNTER (EV_C_FORCE_MINOR_SET_MINOR_HEAP_SIZE, 1);
+    Caml_state->requested_minor_gc = 0;
+    Caml_state->young_trigger = Caml_state->young_alloc_mid;
+    caml_update_young_limit();
+    caml_empty_minor_heap ();
+  }
+  CAMLassert (Caml_state->young_ptr == Caml_state->young_alloc_end);
+  new_heap = caml_stat_alloc_aligned_noexc(bsz, 0, &new_heap_base);
+  if (new_heap == NULL) caml_raise_out_of_memory();
+  if (caml_page_table_add(In_young, new_heap, new_heap + bsz) != 0)
+    caml_raise_out_of_memory();
+
+  if (Caml_state->young_start != NULL){
+    caml_page_table_remove(In_young, Caml_state->young_start,
+                           Caml_state->young_end);
+    caml_stat_free (Caml_state->young_base);
+  }
+  Caml_state->young_base = new_heap_base;
+  Caml_state->young_start = (value *) new_heap;
+  Caml_state->young_end = (value *) (new_heap + bsz);
+  Caml_state->young_alloc_start = Caml_state->young_start;
+  Caml_state->young_alloc_mid =
+    Caml_state->young_alloc_start + Wsize_bsize (bsz) / 2;
+  Caml_state->young_alloc_end = Caml_state->young_end;
+  Caml_state->young_trigger = Caml_state->young_alloc_start;
+  caml_update_young_limit();
+  Caml_state->young_ptr = Caml_state->young_alloc_end;
+  Caml_state->minor_heap_wsz = Wsize_bsize (bsz);
+  caml_memprof_renew_minor_sample();
+
+  reset_table ((struct generic_table *) Caml_state->ref_table);
+  reset_table ((struct generic_table *) Caml_state->ephe_ref_table);
+  reset_table ((struct generic_table *) Caml_state->custom_table);
+}
+
+static value oldify_todo_list = 0;
+
+/* Note that the tests on the tag depend on the fact that Infix_tag,
+   Forward_tag, and No_scan_tag are contiguous. */
+
+void caml_oldify_one (value v, value *p)
+{
+  value result;
+  header_t hd;
+  mlsize_t sz, i;
+  tag_t tag;
+
+ tail_call:
+  if (Is_block (v) && Is_young (v)){
+    CAMLassert ((value *) Hp_val (v) >= Caml_state->young_ptr);
+    hd = Hd_val (v);
+    if (hd == 0){         /* If already forwarded */
+      *p = Field (v, 0);  /*  then forward pointer is first field. */
+    }else{
+      CAMLassert_young_header(hd);
+      tag = Tag_hd (hd);
+      if (tag < Infix_tag){
+        value field0;
+
+        sz = Wosize_hd (hd);
+        result = caml_alloc_shr_for_minor_gc (sz, tag, hd);
+        *p = result;
+        field0 = Field (v, 0);
+        Hd_val (v) = 0;            /* Set forward flag */
+        Field (v, 0) = result;     /*  and forward pointer. */
+        if (sz > 1){
+          Field (result, 0) = field0;
+          Field (result, 1) = oldify_todo_list;    /* Add this block */
+          oldify_todo_list = v;                    /*  to the "to do" list. */
+        }else{
+          CAMLassert (sz == 1);
+          p = &Field (result, 0);
+          v = field0;
+          goto tail_call;
+        }
+      }else if (tag >= No_scan_tag){
+        sz = Wosize_hd (hd);
+        result = caml_alloc_shr_for_minor_gc (sz, tag, hd);
+        for (i = 0; i < sz; i++) Field (result, i) = Field (v, i);
+        Hd_val (v) = 0;            /* Set forward flag */
+        Field (v, 0) = result;     /*  and forward pointer. */
+        *p = result;
+      }else if (tag == Infix_tag){
+        mlsize_t offset = Infix_offset_hd (hd);
+        caml_oldify_one (v - offset, p);   /* Cannot recurse deeper than 1. */
+        *p += offset;
+      }else{
+        value f = Forward_val (v);
+        tag_t ft = 0;
+        int vv = 1;
+
+        CAMLassert (tag == Forward_tag);
+        if (Is_block (f)){
+          if (Is_young (f)){
+            vv = 1;
+            ft = Tag_val (Hd_val (f) == 0 ? Field (f, 0) : f);
+          }else{
+            vv = Is_in_value_area(f);
+            if (vv){
+              ft = Tag_val (f);
+            }
+          }
+        }
+        if (!vv || ft == Forward_tag || ft == Lazy_tag
+#ifdef FLAT_FLOAT_ARRAY
+            || ft == Double_tag
+#endif
+            ){
+          /* Do not short-circuit the pointer.  Copy as a normal block. */
+          CAMLassert (Wosize_hd (hd) == 1);
+          result = caml_alloc_shr_for_minor_gc (1, Forward_tag, hd);
+          *p = result;
+          Hd_val (v) = 0;             /* Set (GC) forward flag */
+          Field (v, 0) = result;      /*  and forward pointer. */
+          p = &Field (result, 0);
+          v = f;
+          goto tail_call;
+        }else{
+          v = f;                        /* Follow the forwarding */
+          goto tail_call;               /*  then oldify. */
+        }
+      }
+    }
+  }else{
+    *p = v;
+  }
+}
+
+/* Test if the ephemeron is alive, everything outside minor heap is alive */
+Caml_inline int ephe_check_alive_data(struct caml_ephe_ref_elt *re){
+  mlsize_t i;
+  value child;
+  for (i = CAML_EPHE_FIRST_KEY; i < Wosize_val(re->ephe); i++){
+    child = Field (re->ephe, i);
+    if(child != caml_ephe_none
+       && Is_block (child) && Is_young (child)
+       && Hd_val (child) != 0){ /* Value not copied to major heap */
+      return 0;
+    }
+  }
+  return 1;
+}
+
+/* Finish the work that was put off by [caml_oldify_one].
+   Note that [caml_oldify_one] itself is called by oldify_mopup, so we
+   have to be careful to remove the first entry from the list before
+   oldifying its fields. */
+void caml_oldify_mopup (void)
+{
+  value v, new_v, f;
+  mlsize_t i;
+  struct caml_ephe_ref_elt *re;
+  int redo = 0;
+
+  while (oldify_todo_list != 0){
+    v = oldify_todo_list;                /* Get the head. */
+    CAMLassert (Hd_val (v) == 0);            /* It must be forwarded. */
+    new_v = Field (v, 0);                /* Follow forward pointer. */
+    oldify_todo_list = Field (new_v, 1); /* Remove from list. */
+
+    f = Field (new_v, 0);
+    if (Is_block (f) && Is_young (f)){
+      caml_oldify_one (f, &Field (new_v, 0));
+    }
+    for (i = 1; i < Wosize_val (new_v); i++){
+      f = Field (v, i);
+      if (Is_block (f) && Is_young (f)){
+        caml_oldify_one (f, &Field (new_v, i));
+      }else{
+        Field (new_v, i) = f;
+      }
+    }
+  }
+
+  /* Oldify the data in the minor heap of alive ephemeron
+     During minor collection keys outside the minor heap are considered alive */
+  for (re = Caml_state->ephe_ref_table->base;
+       re < Caml_state->ephe_ref_table->ptr; re++){
+    /* look only at ephemeron with data in the minor heap */
+    if (re->offset == 1){
+      value *data = &Field(re->ephe,1);
+      if (*data != caml_ephe_none && Is_block (*data) && Is_young (*data)){
+        if (Hd_val (*data) == 0){ /* Value copied to major heap */
+          *data = Field (*data, 0);
+        } else {
+          if (ephe_check_alive_data(re)){
+            caml_oldify_one(*data,data);
+            redo = 1; /* oldify_todo_list can still be 0 */
+          }
+        }
+      }
+    }
+  }
+
+  if (redo) caml_oldify_mopup ();
+}
+
+/* Make sure the minor heap is empty by performing a minor collection
+   if needed.
+*/
+void caml_empty_minor_heap (void)
+{
+  value **r;
+  struct caml_custom_elt *elt;
+  uintnat prev_alloc_words;
+  struct caml_ephe_ref_elt *re;
+
+  if (Caml_state->young_ptr != Caml_state->young_alloc_end){
+    CAMLassert_young_header(*(header_t*)Caml_state->young_ptr);
+    if (caml_minor_gc_begin_hook != NULL) (*caml_minor_gc_begin_hook) ();
+    prev_alloc_words = caml_allocated_words;
+    Caml_state->in_minor_collection = 1;
+    caml_gc_message (0x02, "<");
+    CAML_EV_BEGIN(EV_MINOR_LOCAL_ROOTS);
+    caml_oldify_local_roots();
+    CAML_EV_END(EV_MINOR_LOCAL_ROOTS);
+    CAML_EV_BEGIN(EV_MINOR_REF_TABLES);
+    for (r = Caml_state->ref_table->base;
+         r < Caml_state->ref_table->ptr; r++) {
+      caml_oldify_one (**r, *r);
+    }
+    CAML_EV_END(EV_MINOR_REF_TABLES);
+    CAML_EV_BEGIN(EV_MINOR_COPY);
+    caml_oldify_mopup ();
+    CAML_EV_END(EV_MINOR_COPY);
+    /* Update the ephemerons */
+    for (re = Caml_state->ephe_ref_table->base;
+         re < Caml_state->ephe_ref_table->ptr; re++){
+      if(re->offset < Wosize_val(re->ephe)){
+        /* If it is not the case, the ephemeron has been truncated */
+        value *key = &Field(re->ephe,re->offset);
+        if (*key != caml_ephe_none && Is_block (*key) && Is_young (*key)){
+          if (Hd_val (*key) == 0){ /* Value copied to major heap */
+            *key = Field (*key, 0);
+          }else{ /* Value not copied so it's dead */
+            CAMLassert(!ephe_check_alive_data(re));
+            *key = caml_ephe_none;
+            Field(re->ephe,1) = caml_ephe_none;
+          }
+        }
+      }
+    }
+    /* Update the OCaml finalise_last values */
+    CAML_EV_BEGIN(EV_MINOR_UPDATE_WEAK);
+    caml_final_update_minor_roots();
+    /* Trigger memprofs callbacks for blocks in the minor heap. */
+    caml_memprof_minor_update();
+    /* Run custom block finalisation of dead minor values */
+    for (elt = Caml_state->custom_table->base;
+         elt < Caml_state->custom_table->ptr; elt++){
+      value v = elt->block;
+      if (Hd_val (v) == 0){
+        /* Block was copied to the major heap: adjust GC speed numbers. */
+        caml_adjust_gc_speed(elt->mem, elt->max);
+      }else{
+        /* Block will be freed: call finalization function, if any. */
+        void (*final_fun)(value) = Custom_ops_val(v)->finalize;
+        if (final_fun != NULL) final_fun(v);
+      }
+    }
+    CAML_EV_END(EV_MINOR_UPDATE_WEAK);
+    CAML_EV_BEGIN(EV_MINOR_FINALIZED);
+    Caml_state->stat_minor_words +=
+      Caml_state->young_alloc_end - Caml_state->young_ptr;
+    caml_gc_clock +=
+      (double) (Caml_state->young_alloc_end - Caml_state->young_ptr)
+      / Caml_state->minor_heap_wsz;
+    Caml_state->young_ptr = Caml_state->young_alloc_end;
+    clear_table ((struct generic_table *) Caml_state->ref_table);
+    clear_table ((struct generic_table *) Caml_state->ephe_ref_table);
+    clear_table ((struct generic_table *) Caml_state->custom_table);
+    Caml_state->extra_heap_resources_minor = 0;
+    caml_gc_message (0x02, ">");
+    Caml_state->in_minor_collection = 0;
+    caml_final_empty_young ();
+    CAML_EV_END(EV_MINOR_FINALIZED);
+    Caml_state->stat_promoted_words += caml_allocated_words - prev_alloc_words;
+    CAML_EV_COUNTER (EV_C_MINOR_PROMOTED,
+                     caml_allocated_words - prev_alloc_words);
+    ++ Caml_state->stat_minor_collections;
+    caml_memprof_renew_minor_sample();
+    if (caml_minor_gc_end_hook != NULL) (*caml_minor_gc_end_hook) ();
+  }else{
+    /* The minor heap is empty nothing to do. */
+    caml_final_empty_young ();
+  }
+#ifdef DEBUG
+  {
+    value *p;
+    for (p = Caml_state->young_alloc_start; p < Caml_state->young_alloc_end;
+         ++p) {
+      *p = Debug_free_minor;
+    }
+  }
+#endif
+}
+
+#ifdef CAML_INSTR
+extern uintnat caml_instr_alloc_jump;
+#endif /*CAML_INSTR*/
+
+/* Do a minor collection or a slice of major collection, call finalisation
+   functions, etc.
+   Leave enough room in the minor heap to allocate at least one object.
+   Guaranteed not to call any OCaml callback.
+*/
+CAMLexport void caml_gc_dispatch (void)
+{
+  value *trigger = Caml_state->young_trigger; /* save old value of trigger */
+
+  CAML_EVENTLOG_DO({
+    CAML_EV_COUNTER(EV_C_ALLOC_JUMP, caml_instr_alloc_jump);
+    caml_instr_alloc_jump =  0;
+  });
+
+  if (trigger == Caml_state->young_alloc_start
+      || Caml_state->requested_minor_gc) {
+    /* The minor heap is full, we must do a minor collection. */
+    /* reset the pointers first because the end hooks might allocate */
+    CAML_EV_BEGIN(EV_MINOR);
+    Caml_state->requested_minor_gc = 0;
+    Caml_state->young_trigger = Caml_state->young_alloc_mid;
+    caml_update_young_limit();
+    caml_empty_minor_heap ();
+    /* The minor heap is empty, we can start a major collection. */
+    CAML_EV_END(EV_MINOR);
+    if (caml_gc_phase == Phase_idle)
+    {
+      CAML_EV_BEGIN(EV_MAJOR);
+      caml_major_collection_slice (-1);
+      CAML_EV_END(EV_MAJOR);
+    }
+  }
+  if (trigger != Caml_state->young_alloc_start
+      || Caml_state->requested_major_slice) {
+    /* The minor heap is half-full, do a major GC slice. */
+    Caml_state->requested_major_slice = 0;
+    Caml_state->young_trigger = Caml_state->young_alloc_start;
+    caml_update_young_limit();
+    CAML_EV_BEGIN(EV_MAJOR);
+    caml_major_collection_slice (-1);
+    CAML_EV_END(EV_MAJOR);
+  }
+}
+
+/* Called by young allocations when [Caml_state->young_ptr] reaches
+   [Caml_state->young_limit]. We may have to either call memprof or
+   the gc. */
+void caml_alloc_small_dispatch (intnat wosize, int flags,
+                                int nallocs, unsigned char* encoded_alloc_lens)
+{
+  intnat whsize = Whsize_wosize (wosize);
+
+  /* First, we un-do the allocation performed in [Alloc_small] */
+  Caml_state->young_ptr += whsize;
+
+  while(1) {
+    /* We might be here because of an async callback / urgent GC
+       request. Take the opportunity to do what has been requested. */
+    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 ());
+    else {
+      caml_check_urgent_gc (Val_unit);
+      /* In the case of long-running C code that regularly polls with
+         caml_process_pending_actions, force a query of all callbacks
+         at every minor collection or major slice. */
+      caml_something_to_do = 1;
+    }
+
+    /* Now, there might be enough room in the minor heap to do our
+       allocation. */
+    if (Caml_state->young_ptr - whsize >= Caml_state->young_trigger)
+      break;
+
+    /* If not, then empty the minor heap, and check again for async
+       callbacks. */
+    CAML_EV_COUNTER (EV_C_FORCE_MINOR_ALLOC_SMALL, 1);
+    caml_gc_dispatch ();
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+    if (caml_young_ptr == caml_young_alloc_end) {
+      caml_spacetime_automatic_snapshot();
+    }
+#endif
+  }
+
+  /* Re-do the allocation: we now have enough space in the minor heap. */
+  Caml_state->young_ptr -= whsize;
+
+  /* Check if the allocated block has been sampled by memprof. */
+  if(Caml_state->young_ptr < caml_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.
+      */
+    } else caml_memprof_renew_minor_sample();
+  }
+}
+
+/* Exported for backward compatibility with Lablgtk: do a minor
+   collection to ensure that the minor heap is empty.
+*/
+CAMLexport void caml_minor_collection (void)
+{
+  Caml_state->requested_minor_gc = 1;
+  caml_gc_dispatch ();
+}
+
+CAMLexport value caml_check_urgent_gc (value extra_root)
+{
+  if (Caml_state->requested_major_slice || Caml_state->requested_minor_gc){
+    CAMLparam1 (extra_root);
+    caml_gc_dispatch();
+    CAMLdrop;
+  }
+  return extra_root;
+}
+
+static void realloc_generic_table
+(struct generic_table *tbl, asize_t element_size,
+ ev_gc_counter ev_counter_name,
+ char *msg_threshold, char *msg_growing, char *msg_error)
+{
+  CAMLassert (tbl->ptr == tbl->limit);
+  CAMLassert (tbl->limit <= tbl->end);
+  CAMLassert (tbl->limit >= tbl->threshold);
+
+  if (tbl->base == NULL){
+    alloc_generic_table (tbl, Caml_state->minor_heap_wsz / 8, 256,
+                         element_size);
+  }else if (tbl->limit == tbl->threshold){
+    CAML_EV_COUNTER (ev_counter_name, 1);
+    caml_gc_message (0x08, msg_threshold, 0);
+    tbl->limit = tbl->end;
+    caml_request_minor_gc ();
+  }else{
+    asize_t sz;
+    asize_t cur_ptr = tbl->ptr - tbl->base;
+    CAMLassert (Caml_state->requested_minor_gc);
+
+    tbl->size *= 2;
+    sz = (tbl->size + tbl->reserve) * element_size;
+    caml_gc_message (0x08, msg_growing, (intnat) sz/1024);
+    tbl->base = caml_stat_resize_noexc (tbl->base, sz);
+    if (tbl->base == NULL){
+      caml_fatal_error ("%s", msg_error);
+    }
+    tbl->end = tbl->base + (tbl->size + tbl->reserve) * element_size;
+    tbl->threshold = tbl->base + tbl->size * element_size;
+    tbl->ptr = tbl->base + cur_ptr;
+    tbl->limit = tbl->end;
+  }
+}
+
+void caml_realloc_ref_table (struct caml_ref_table *tbl)
+{
+  realloc_generic_table
+    ((struct generic_table *) tbl, sizeof (value *),
+     EV_C_REQUEST_MINOR_REALLOC_REF_TABLE,
+     "ref_table threshold crossed\n",
+     "Growing ref_table to %" ARCH_INTNAT_PRINTF_FORMAT "dk bytes\n",
+     "ref_table overflow");
+}
+
+void caml_realloc_ephe_ref_table (struct caml_ephe_ref_table *tbl)
+{
+  realloc_generic_table
+    ((struct generic_table *) tbl, sizeof (struct caml_ephe_ref_elt),
+     EV_C_REQUEST_MINOR_REALLOC_EPHE_REF_TABLE,
+     "ephe_ref_table threshold crossed\n",
+     "Growing ephe_ref_table to %" ARCH_INTNAT_PRINTF_FORMAT "dk bytes\n",
+     "ephe_ref_table overflow");
+}
+
+void caml_realloc_custom_table (struct caml_custom_table *tbl)
+{
+  realloc_generic_table
+    ((struct generic_table *) tbl, sizeof (struct caml_custom_elt),
+     EV_C_REQUEST_MINOR_REALLOC_CUSTOM_TABLE,
+     "custom_table threshold crossed\n",
+     "Growing custom_table to %" ARCH_INTNAT_PRINTF_FORMAT "dk bytes\n",
+     "custom_table overflow");
+}
diff --git a/runtime/misc.c b/runtime/misc.c
new file mode 100644
index 00000000..8aa0d090
--- /dev/null
+++ b/runtime/misc.c
@@ -0,0 +1,223 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, 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
+
+#if _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>
+#include "caml/config.h"
+#include "caml/misc.h"
+#include "caml/memory.h"
+#include "caml/osdeps.h"
+#include "caml/version.h"
+
+caml_timing_hook caml_major_slice_begin_hook = NULL;
+caml_timing_hook caml_major_slice_end_hook = NULL;
+caml_timing_hook caml_minor_gc_begin_hook = NULL;
+caml_timing_hook caml_minor_gc_end_hook = NULL;
+caml_timing_hook caml_finalise_begin_hook = NULL;
+caml_timing_hook caml_finalise_end_hook = NULL;
+
+#ifdef DEBUG
+
+void caml_failed_assert (char * expr, char_os * file_os, int line)
+{
+  char* file = caml_stat_strdup_of_os(file_os);
+  fprintf (stderr, "file %s; line %d ### Assertion failed: %s\n",
+           file, line, expr);
+  fflush (stderr);
+  caml_stat_free(file);
+  abort();
+}
+
+void caml_set_fields (value v, uintnat start, uintnat filler)
+{
+  mlsize_t i;
+  for (i = start; i < Wosize_val (v); i++){
+    Field (v, i) = (value) filler;
+  }
+}
+
+#endif /* DEBUG */
+
+uintnat caml_verb_gc = 0;
+
+void caml_gc_message (int level, char *msg, ...)
+{
+  if ((caml_verb_gc & level) != 0){
+    va_list ap;
+    va_start(ap, msg);
+    vfprintf (stderr, msg, ap);
+    va_end(ap);
+    fflush (stderr);
+  }
+}
+
+void (*caml_fatal_error_hook) (char *msg, va_list args) = NULL;
+
+CAMLexport void caml_fatal_error (char *msg, ...)
+{
+  va_list ap;
+  va_start(ap, msg);
+  if(caml_fatal_error_hook != NULL) {
+    caml_fatal_error_hook(msg, ap);
+  } else {
+    fprintf (stderr, "Fatal error: ");
+    vfprintf (stderr, msg, ap);
+    fprintf (stderr, "\n");
+  }
+  va_end(ap);
+  abort();
+}
+
+/* If you change the caml_ext_table* functions, also update
+   runtime/spacetime_nat.c:find_trie_node_from_libunwind. */
+
+void caml_ext_table_init(struct ext_table * tbl, int init_capa)
+{
+  tbl->size = 0;
+  tbl->capacity = init_capa;
+  tbl->contents = caml_stat_alloc(sizeof(void *) * init_capa);
+}
+
+int caml_ext_table_add(struct ext_table * tbl, caml_stat_block data)
+{
+  int res;
+  if (tbl->size >= tbl->capacity) {
+    tbl->capacity *= 2;
+    tbl->contents =
+      caml_stat_resize(tbl->contents, sizeof(void *) * tbl->capacity);
+  }
+  res = tbl->size;
+  tbl->contents[res] = data;
+  tbl->size++;
+  return res;
+}
+
+void caml_ext_table_remove(struct ext_table * tbl, caml_stat_block data)
+{
+  int i;
+  for (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],
+              (tbl->size - i - 1) * sizeof(void *));
+      tbl->size--;
+    }
+  }
+}
+
+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]);
+  }
+  tbl->size = 0;
+}
+
+void caml_ext_table_free(struct ext_table * tbl, int free_entries)
+{
+  caml_ext_table_clear(tbl, free_entries);
+  caml_stat_free(tbl->contents);
+}
+
+/* Integer arithmetic with overflow detection */
+
+#if ! (__GNUC__ >= 5 || Caml_has_builtin(__builtin_mul_overflow))
+CAMLexport int caml_umul_overflow(uintnat a, uintnat b, uintnat * res)
+{
+#define HALF_SIZE (sizeof(uintnat) * 4)
+#define HALF_MASK (((uintnat)1 << HALF_SIZE) - 1)
+#define LOW_HALF(x) ((x) & HALF_MASK)
+#define HIGH_HALF(x) ((x) >> HALF_SIZE)
+  /* Cut in half words */
+  uintnat al = LOW_HALF(a);
+  uintnat ah = HIGH_HALF(a);
+  uintnat bl = LOW_HALF(b);
+  uintnat bh = HIGH_HALF(b);
+  /* Exact product is:
+              al * bl
+           +  ah * bl  << HALF_SIZE
+           +  al * bh  << HALF_SIZE
+           +  ah * bh  << 2*HALF_SIZE
+     Overflow occurs if:
+        ah * bh is not 0, i.e. ah != 0 and bh != 0
+     OR ah * bl has high half != 0
+     OR al * bh has high half != 0
+     OR the sum al * bl + LOW_HALF(ah * bl) << HALF_SIZE
+                        + LOW_HALF(al * bh) << HALF_SIZE overflows.
+     This sum is equal to p = (a * b) modulo word size. */
+  uintnat p = a * b;
+  uintnat p1 = al * bh;
+  uintnat p2 = ah * bl;
+  *res = p;
+  if (ah == 0 && bh == 0) return 0;
+  if (ah != 0 && bh != 0) return 1;
+  if (HIGH_HALF(p1) != 0 || HIGH_HALF(p2) != 0) return 1;
+  p1 <<= HALF_SIZE;
+  p2 <<= HALF_SIZE;
+  p1 += p2;
+  if (p < p1 || p1 < p2) return 1; /* overflow in sums */
+  return 0;
+#undef HALF_SIZE
+#undef HALF_MASK
+#undef LOW_HALF
+#undef HIGH_HALF
+}
+#endif
+
+/* Runtime warnings */
+
+uintnat caml_runtime_warnings = 0;
+static int caml_runtime_warnings_first = 1;
+
+int caml_runtime_warnings_active(void)
+{
+  if (!caml_runtime_warnings) return 0;
+  if (caml_runtime_warnings_first) {
+    fprintf(stderr, "[ocaml] (use Sys.enable_runtime_warnings to control "
+                    "these warnings)\n");
+    caml_runtime_warnings_first = 0;
+  }
+  return 1;
+}
+
+int caml_find_code_fragment(char *pc, int *index, struct code_fragment **cf)
+{
+  struct code_fragment *cfi;
+  int i;
+
+  for (i = 0; i < caml_code_fragments_table.size; i++) {
+    cfi = (struct code_fragment *) caml_code_fragments_table.contents[i];
+    if ((char*) pc >= cfi->code_start && (char*) pc < cfi->code_end) {
+      if (index != NULL) *index = i;
+      if (cf != NULL) *cf = cfi;
+      return 1;
+    }
+  }
+  return 0;
+}
diff --git a/runtime/obj.c b/runtime/obj.c
new file mode 100644
index 00000000..20fe1e8e
--- /dev/null
+++ b/runtime/obj.c
@@ -0,0 +1,407 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* Operations on objects */
+
+#include <string.h>
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/gc.h"
+#include "caml/interp.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/prims.h"
+#include "caml/signals.h"
+#include "caml/spacetime.h"
+
+/* [size] is a value encoding a number of bytes */
+CAMLprim value caml_static_alloc(value size)
+{
+  return (value) caml_stat_alloc((asize_t) Long_val(size));
+}
+
+CAMLprim value caml_static_free(value blk)
+{
+  caml_stat_free((void *) blk);
+  return Val_unit;
+}
+
+CAMLprim value caml_static_resize(value blk, value new_size)
+{
+  return (value) caml_stat_resize((char *) blk, (asize_t) Long_val(new_size));
+}
+
+/* unused since GPR#427 */
+CAMLprim value caml_obj_is_block(value arg)
+{
+  return Val_bool(Is_block(arg));
+}
+
+CAMLprim value caml_obj_tag(value arg)
+{
+  if (Is_long (arg)){
+    return Val_int (1000);   /* int_tag */
+  }else if ((long) arg & (sizeof (value) - 1)){
+    return Val_int (1002);   /* unaligned_tag */
+  }else if (Is_in_value_area (arg)){
+    return Val_int(Tag_val(arg));
+  }else{
+    return Val_int (1001);   /* out_of_heap_tag */
+  }
+}
+
+CAMLprim value caml_obj_set_tag (value arg, value new_tag)
+{
+  Tag_val (arg) = Int_val (new_tag);
+  return Val_unit;
+}
+
+CAMLprim value caml_obj_make_forward (value blk, value fwd)
+{
+  caml_modify(&Field(blk, 0), fwd);
+  Tag_val (blk) = Forward_tag;
+  return Val_unit;
+}
+
+/* [size] is a value encoding a number of blocks */
+CAMLprim value caml_obj_block(value tag, value size)
+{
+  value res;
+  mlsize_t sz, i;
+  tag_t tg;
+
+  sz = Long_val(size);
+  tg = Long_val(tag);
+  if (sz == 0) return Atom(tg);
+  res = caml_alloc(sz, tg);
+  for (i = 0; i < sz; i++)
+    Field(res, i) = Val_long(0);
+
+  return res;
+}
+
+/* Spacetime profiling assumes that this function is only called from OCaml. */
+CAMLprim value caml_obj_with_tag(value new_tag_v, value arg)
+{
+  CAMLparam2 (new_tag_v, arg);
+  CAMLlocal1 (res);
+  mlsize_t sz, i;
+  tag_t tg;
+
+  sz = Wosize_val(arg);
+  tg = (tag_t)Long_val(new_tag_v);
+  if (sz == 0) CAMLreturn (Atom(tg));
+  if (tg >= No_scan_tag) {
+    res = caml_alloc(sz, tg);
+    memcpy(Bp_val(res), Bp_val(arg), sz * sizeof(value));
+  } else if (sz <= Max_young_wosize) {
+    uintnat profinfo;
+    Get_my_profinfo_with_cached_backtrace(profinfo, sz);
+    res = caml_alloc_small_with_my_or_given_profinfo(sz, tg, profinfo);
+    for (i = 0; i < sz; i++) Field(res, i) = Field(arg, i);
+  } else {
+    res = caml_alloc_shr(sz, tg);
+    for (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();
+  }
+  CAMLreturn (res);
+}
+
+/* Spacetime profiling assumes that this function is only called from OCaml. */
+CAMLprim value caml_obj_dup(value arg)
+{
+  return caml_obj_with_tag(Val_long(Tag_val(arg)), arg);
+}
+
+/* Shorten the given block to the given size and return void.
+   Raise Invalid_argument if the given size is less than or equal
+   to 0 or greater than the current size.
+
+   algorithm:
+   Change the length field of the header.  Make up a black object
+   with the leftover part of the object: this is needed in the major
+   heap and harmless in the minor heap. The object cannot be white
+   because there may still be references to it in the ref table. By
+   using a black object we ensure that the ref table will be emptied
+   before the block is reallocated (since there must be a minor
+   collection within each major cycle).
+
+   [newsize] is a value encoding a number of fields (words, except
+   for float arrays on 32-bit architectures).
+*/
+CAMLprim value caml_obj_truncate (value v, value newsize)
+{
+  mlsize_t new_wosize = Long_val (newsize);
+  header_t hd = Hd_val (v);
+  tag_t tag = Tag_hd (hd);
+  color_t color = Color_hd (hd);
+  color_t frag_color = Is_young(v) ? 0 : Caml_black;
+  mlsize_t wosize = Wosize_hd (hd);
+  mlsize_t i;
+
+  if (tag == Double_array_tag) new_wosize *= Double_wosize;  /* PR#2520 */
+
+  if (new_wosize <= 0 || new_wosize > wosize){
+    caml_invalid_argument ("Obj.truncate");
+  }
+  if (new_wosize == wosize) return Val_unit;
+  /* PR#2400: since we're about to lose our references to the elements
+     beyond new_wosize in v, erase them explicitly so that the GC
+     can darken them as appropriate. */
+  if (tag < No_scan_tag) {
+    for (i = new_wosize; i < wosize; i++){
+      caml_modify(&Field(v, i), Val_unit);
+#ifdef DEBUG
+      Field (v, i) = Debug_free_truncate;
+#endif
+    }
+  }
+  /* We must use an odd tag for the header of the leftovers so it does not
+     look like a pointer because there may be some references to it in
+     ref_table. */
+  Field (v, new_wosize) =
+    Make_header (Wosize_whsize (wosize-new_wosize), Abstract_tag, frag_color);
+  Hd_val (v) =
+    Make_header_with_profinfo (new_wosize, tag, color, Profinfo_val(v));
+  return Val_unit;
+}
+
+CAMLprim value caml_obj_add_offset (value v, value offset)
+{
+  return v + (unsigned long) Int32_val (offset);
+}
+
+/* The following functions are used in stdlib/lazy.ml.
+   They are not written in OCaml because they must be atomic with respect
+   to the GC.
+ */
+
+CAMLprim value caml_lazy_follow_forward (value v)
+{
+  if (Is_block (v) && Is_in_value_area(v)
+      && Tag_val (v) == Forward_tag){
+    return Forward_val (v);
+  }else{
+    return v;
+  }
+}
+
+CAMLprim value caml_lazy_make_forward (value v)
+{
+  CAMLparam1 (v);
+  CAMLlocal1 (res);
+
+  res = caml_alloc_small (1, Forward_tag);
+  Field (res, 0) = v;
+  CAMLreturn (res);
+}
+
+/* For mlvalues.h and camlinternalOO.ml
+   See also GETPUBMET in interp.c
+ */
+
+CAMLprim value caml_get_public_method (value obj, value tag)
+{
+  value meths = Field (obj, 0);
+  int li = 3, hi = Field(meths,0), mi;
+  while (li < hi) {
+    mi = ((li+hi) >> 1) | 1;
+    if (tag < Field(meths,mi)) hi = mi-2;
+    else li = mi;
+  }
+  /* return 0 if tag is not there */
+  return (tag == Field(meths,li) ? Field (meths, li-1) : 0);
+}
+
+/* these two functions might be useful to an hypothetical JIT */
+
+#ifdef CAML_JIT
+#ifdef NATIVE_CODE
+#define MARK 1
+#else
+#define MARK 0
+#endif
+value caml_cache_public_method (value meths, value tag, value *cache)
+{
+  int li = 3, hi = Field(meths,0), mi;
+  while (li < hi) {
+    mi = ((li+hi) >> 1) | 1;
+    if (tag < Field(meths,mi)) hi = mi-2;
+    else li = mi;
+  }
+  *cache = (li-3)*sizeof(value) + MARK;
+  return Field (meths, li-1);
+}
+
+value caml_cache_public_method2 (value *meths, value tag, value *cache)
+{
+  value ofs = *cache & meths[1];
+  if (*(value*)(((char*)(meths+3)) + ofs - MARK) == tag)
+    return *(value*)(((char*)(meths+2)) + ofs - MARK);
+  {
+    int li = 3, hi = meths[0], mi;
+    while (li < hi) {
+      mi = ((li+hi) >> 1) | 1;
+      if (tag < meths[mi]) hi = mi-2;
+      else li = mi;
+    }
+    *cache = (li-3)*sizeof(value) + MARK;
+    return meths[li-1];
+  }
+}
+#endif /*CAML_JIT*/
+
+static value oo_last_id = Val_int(0);
+
+CAMLprim value caml_set_oo_id (value obj) {
+  Field(obj, 1) = oo_last_id;
+  oo_last_id += 2;
+  return obj;
+}
+
+CAMLprim value caml_fresh_oo_id (value v) {
+  v = oo_last_id;
+  oo_last_id += 2;
+  return v;
+}
+
+CAMLprim value caml_int_as_pointer (value n) {
+  return n - 1;
+}
+
+/* Compute how many words in the heap are occupied by blocks accessible
+   from a given value */
+
+#define ENTRIES_PER_QUEUE_CHUNK 4096
+struct queue_chunk {
+  struct queue_chunk *next;
+  value entries[ENTRIES_PER_QUEUE_CHUNK];
+};
+
+
+CAMLprim value caml_obj_reachable_words(value v)
+{
+  static struct queue_chunk first_chunk;
+  struct queue_chunk *read_chunk, *write_chunk;
+  int write_pos, read_pos, i;
+
+  intnat size = 0;
+  header_t hd;
+  mlsize_t sz;
+
+  if (Is_long(v) || !Is_in_heap_or_young(v)) return Val_int(0);
+  if (Tag_hd(Hd_val(v)) == Infix_tag) v -= Infix_offset_hd(Hd_val(v));
+  hd = Hd_val(v);
+  sz = Wosize_hd(hd);
+
+  read_chunk = write_chunk = &first_chunk;
+  read_pos = 0;
+  write_pos = 1;
+  write_chunk->entries[0] = v | Colornum_hd(hd);
+  Hd_val(v) = Bluehd_hd(hd);
+
+  /* We maintain a queue of "interesting" blocks that have been seen.
+     An interesting block is a block in the heap which does not
+     represent an infix pointer. Infix pointers are normalized to the
+     beginning of their block.  Blocks in the static data area are excluded.
+
+     The function maintains a queue of block pointers.  Concretely,
+     the queue is stored as a linked list of chunks, each chunk
+     holding a number of pointers to interesting blocks.  Initially,
+     it contains only the "root" value.  The first chunk of the queue
+     is allocated statically.  More chunks can be allocated as needed
+     and released before this function exits.
+
+     When a block is inserted in the queue, it is marked as blue.
+     This mark is used to avoid a second visit of the same block.
+     The real color is stored in the last 2 bits of the pointer in the
+     queue.  (Same technique as in extern.c.)
+
+     Note: we make the assumption that there is no pointer
+     from the static data area to the heap.
+  */
+
+  /* First pass: mark accessible blocks and compute their total size */
+  while (read_pos != write_pos || read_chunk != write_chunk) {
+    /* Pop the next element from the queue */
+    if (read_pos == ENTRIES_PER_QUEUE_CHUNK) {
+      read_pos = 0;
+      read_chunk = read_chunk->next;
+    }
+    v = read_chunk->entries[read_pos++] & ~3;
+
+    hd = Hd_val(v);
+    sz = Wosize_hd(hd);
+
+    size += Whsize_wosize(sz);
+
+    if (Tag_hd(hd) < No_scan_tag) {
+      /* Push the interesting fields on the queue */
+      for (i = 0; i < sz; i++) {
+        value v2 = Field(v, i);
+        if (Is_block(v2) && Is_in_heap_or_young(v2)) {
+          if (Tag_hd(Hd_val(v2)) == Infix_tag){
+            v2 -= Infix_offset_hd(Hd_val(v2));
+          }
+          hd = Hd_val(v2);
+          if (Color_hd(hd) != Caml_blue) {
+            if (write_pos == ENTRIES_PER_QUEUE_CHUNK) {
+              struct queue_chunk *new_chunk =
+                malloc(sizeof(struct queue_chunk));
+              if (new_chunk == NULL) {
+                size = (-1);
+                goto release;
+              }
+              write_chunk->next = new_chunk;
+              write_pos = 0;
+              write_chunk = new_chunk;
+            }
+            write_chunk->entries[write_pos++] = v2 | Colornum_hd(hd);
+            Hd_val(v2) = Bluehd_hd(hd);
+          }
+        }
+      }
+    }
+  }
+
+  /* Second pass: restore colors and free extra queue chunks */
+ release:
+  read_pos = 0;
+  read_chunk = &first_chunk;
+  while (read_pos != write_pos || read_chunk != write_chunk) {
+    color_t colornum;
+    if (read_pos == ENTRIES_PER_QUEUE_CHUNK) {
+      struct queue_chunk *prev = read_chunk;
+      read_pos = 0;
+      read_chunk = read_chunk->next;
+      if (prev != &first_chunk) free(prev);
+    }
+    v = read_chunk->entries[read_pos++];
+    colornum = v & 3;
+    v &= ~3;
+    Hd_val(v) = Coloredhd_hd(Hd_val(v), colornum);
+  }
+  if (read_chunk != &first_chunk) free(read_chunk);
+
+  if (size < 0)
+    caml_raise_out_of_memory();
+  return Val_int(size);
+}
diff --git a/runtime/parsing.c b/runtime/parsing.c
new file mode 100644
index 00000000..990eb1f6
--- /dev/null
+++ b/runtime/parsing.c
@@ -0,0 +1,304 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* The PDA automaton for parsers generated by camlyacc */
+
+#include <stdio.h>
+#include <string.h>
+#include "caml/config.h"
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+#include "caml/alloc.h"
+
+#define ERRCODE 256
+
+struct parser_tables {    /* Mirrors parse_tables in ../stdlib/parsing.mli */
+  value actions;
+  value transl_const;
+  value transl_block;
+  char * lhs;
+  char * len;
+  char * defred;
+  char * dgoto;
+  char * sindex;
+  char * rindex;
+  char * gindex;
+  value tablesize;
+  char * table;
+  char * check;
+  value error_function;
+  char * names_const;
+  char * names_block;
+};
+
+struct parser_env {       /* Mirrors parser_env in ../stdlib/parsing.ml */
+  value s_stack;
+  value v_stack;
+  value symb_start_stack;
+  value symb_end_stack;
+  value stacksize;
+  value stackbase;
+  value curr_char;
+  value lval;
+  value symb_start;
+  value symb_end;
+  value asp;
+  value rule_len;
+  value rule_number;
+  value sp;
+  value state;
+  value errflag;
+};
+
+#if defined(ARCH_BIG_ENDIAN) || SIZEOF_SHORT != 2
+#define Short(tbl,n) \
+  (*((unsigned char *)((tbl) + (n) * 2)) + \
+          (*((signed char *)((tbl) + (n) * 2 + 1)) << 8))
+#else
+#define Short(tbl,n) (((short *)(tbl))[n])
+#endif
+
+int caml_parser_trace = 0;
+
+/* 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
+
+/* Output codes */
+/* Mirrors parser_output in ../stdlib/parsing.ml */
+#define READ_TOKEN Val_int(0)
+#define RAISE_PARSE_ERROR Val_int(1)
+#define GROW_STACKS_1 Val_int(2)
+#define GROW_STACKS_2 Val_int(3)
+#define COMPUTE_SEMANTIC_ACTION Val_int(4)
+#define CALL_ERROR_FUNCTION Val_int(5)
+
+/* To preserve local variables when communicating with the ML code */
+
+#define SAVE \
+  env->sp = Val_int(sp), \
+  env->state = Val_int(state), \
+  env->errflag = Val_int(errflag)
+
+#define RESTORE \
+  sp = Int_val(env->sp), \
+  state = Int_val(env->state), \
+  errflag = Int_val(env->errflag)
+
+/* Auxiliary for printing token just read */
+
+static char * token_name(char * names, int number)
+{
+  for (/*nothing*/; number > 0; number--) {
+    if (names[0] == 0) return "<unknown token>";
+    names += strlen(names) + 1;
+  }
+  return names;
+}
+
+static void print_token(struct parser_tables *tables, int state, value tok)
+{
+  value v;
+
+  if (Is_long(tok)) {
+    fprintf(stderr, "State %d: read token %s\n",
+            state, token_name(tables->names_const, Int_val(tok)));
+  } else {
+    fprintf(stderr, "State %d: read token %s(",
+            state, token_name(tables->names_block, Tag_val(tok)));
+    v = Field(tok, 0);
+    if (Is_long(v))
+      fprintf(stderr, "%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val(v));
+    else if (Tag_val(v) == String_tag)
+      fprintf(stderr, "%s", String_val(v));
+    else if (Tag_val(v) == Double_tag)
+      fprintf(stderr, "%g", Double_val(v));
+    else
+      fprintf(stderr, "_");
+    fprintf(stderr, ")\n");
+  }
+}
+
+/* The pushdown automata */
+
+CAMLprim value caml_parse_engine(struct parser_tables *tables,
+                                 struct parser_env *env, value cmd, value arg)
+{
+  int state;
+  mlsize_t sp, asp;
+  int errflag;
+  int n, n1, n2, m, state1;
+
+  switch(Int_val(cmd)) {
+
+  case START:
+    state = 0;
+    sp = Int_val(env->sp);
+    errflag = 0;
+
+  loop:
+    n = Short(tables->defred, state);
+    if (n != 0) goto reduce;
+    if (Int_val(env->curr_char) >= 0) goto testshift;
+    SAVE;
+    return READ_TOKEN;
+                                /* The ML code calls the lexer and updates */
+                                /* symb_start and symb_end */
+  case TOKEN_READ:
+    RESTORE;
+    if (Is_block(arg)) {
+      env->curr_char = Field(tables->transl_block, Tag_val(arg));
+      caml_modify(&env->lval, Field(arg, 0));
+    } else {
+      env->curr_char = Field(tables->transl_const, Int_val(arg));
+      caml_modify(&env->lval, Val_long(0));
+    }
+    if (caml_parser_trace) print_token(tables, state, arg);
+
+  testshift:
+    n1 = Short(tables->sindex, state);
+    n2 = n1 + Int_val(env->curr_char);
+    if (n1 != 0 && n2 >= 0 && n2 <= Int_val(tables->tablesize) &&
+        Short(tables->check, n2) == Int_val(env->curr_char)) goto shift;
+    n1 = Short(tables->rindex, state);
+    n2 = n1 + Int_val(env->curr_char);
+    if (n1 != 0 && n2 >= 0 && n2 <= Int_val(tables->tablesize) &&
+        Short(tables->check, n2) == Int_val(env->curr_char)) {
+      n = Short(tables->table, n2);
+      goto reduce;
+    }
+    if (errflag > 0) goto recover;
+    SAVE;
+    return CALL_ERROR_FUNCTION;
+                                /* The ML code calls the error function */
+  case ERROR_DETECTED:
+    RESTORE;
+  recover:
+    if (errflag < 3) {
+      errflag = 3;
+      while (1) {
+        state1 = Int_val(Field(env->s_stack, sp));
+        n1 = Short(tables->sindex, state1);
+        n2 = n1 + ERRCODE;
+        if (n1 != 0 && n2 >= 0 && n2 <= Int_val(tables->tablesize) &&
+            Short(tables->check, n2) == ERRCODE) {
+          if (caml_parser_trace)
+            fprintf(stderr, "Recovering in state %d\n", state1);
+          goto shift_recover;
+        } else {
+          if (caml_parser_trace){
+            fprintf(stderr, "Discarding state %d\n", state1);
+          }
+          if (sp <= Int_val(env->stackbase)) {
+            if (caml_parser_trace){
+              fprintf(stderr, "No more states to discard\n");
+            }
+            return RAISE_PARSE_ERROR; /* The ML code raises Parse_error */
+          }
+          sp--;
+        }
+      }
+    } else {
+      if (Int_val(env->curr_char) == 0)
+        return RAISE_PARSE_ERROR; /* The ML code raises Parse_error */
+      if (caml_parser_trace) fprintf(stderr, "Discarding last token read\n");
+      env->curr_char = Val_int(-1);
+      goto loop;
+    }
+
+  shift:
+    env->curr_char = Val_int(-1);
+    if (errflag > 0) errflag--;
+  shift_recover:
+    if (caml_parser_trace)
+      fprintf(stderr, "State %d: shift to state %d\n",
+              state, Short(tables->table, n2));
+    state = Short(tables->table, n2);
+    sp++;
+    if (sp < Long_val(env->stacksize)) goto push;
+    SAVE;
+    return GROW_STACKS_1;
+                                 /* The ML code resizes the stacks */
+  case STACKS_GROWN_1:
+    RESTORE;
+  push:
+    Field(env->s_stack, sp) = Val_int(state);
+    caml_modify(&Field(env->v_stack, sp), env->lval);
+    Store_field (env->symb_start_stack, sp, env->symb_start);
+    Store_field (env->symb_end_stack, sp, env->symb_end);
+    goto loop;
+
+  reduce:
+    if (caml_parser_trace)
+      fprintf(stderr, "State %d: reduce by rule %d\n", state, n);
+    m = Short(tables->len, n);
+    env->asp = Val_int(sp);
+    env->rule_number = Val_int(n);
+    env->rule_len = Val_int(m);
+    sp = sp - m + 1;
+    m = Short(tables->lhs, n);
+    state1 = Int_val(Field(env->s_stack, sp - 1));
+    n1 = Short(tables->gindex, m);
+    n2 = n1 + state1;
+    if (n1 != 0 && n2 >= 0 && n2 <= Int_val(tables->tablesize) &&
+        Short(tables->check, n2) == state1) {
+      state = Short(tables->table, n2);
+    } else {
+      state = Short(tables->dgoto, m);
+    }
+    if (sp < Long_val(env->stacksize)) goto semantic_action;
+    SAVE;
+    return GROW_STACKS_2;
+                                /* The ML code resizes the stacks */
+  case STACKS_GROWN_2:
+    RESTORE;
+  semantic_action:
+    SAVE;
+    return COMPUTE_SEMANTIC_ACTION;
+                                /* The ML code calls the semantic action */
+  case SEMANTIC_ACTION_COMPUTED:
+    RESTORE;
+    Field(env->s_stack, sp) = Val_int(state);
+    caml_modify(&Field(env->v_stack, sp), arg);
+    asp = Int_val(env->asp);
+    Store_field (env->symb_end_stack, sp, Field(env->symb_end_stack, asp));
+    if (sp > asp) {
+      /* This is an epsilon production. Take symb_start equal to symb_end. */
+      Store_field (env->symb_start_stack, sp, Field(env->symb_end_stack, asp));
+    }
+    goto loop;
+
+  default:                      /* Should not happen */
+    CAMLassert(0);
+    return RAISE_PARSE_ERROR;   /* Keeps gcc -Wall happy */
+  }
+
+}
+
+/* Control printing of debugging info */
+
+CAMLprim value caml_set_parser_trace(value flag)
+{
+  value oldflag = Val_bool(caml_parser_trace);
+  caml_parser_trace = Bool_val(flag);
+  return oldflag;
+}
diff --git a/runtime/power.S b/runtime/power.S
new file mode 100644
index 00000000..1933a10e
--- /dev/null
+++ b/runtime/power.S
@@ -0,0 +1,676 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#if defined(MODEL_ppc64le)
+        .abiversion 2
+#endif
+
+/* Special registers */
+#define START_PRG_ARG 12
+#define START_PRG_DOMAIN_STATE_PTR 7
+#define C_CALL_FUN 25
+#define C_CALL_TOC 26
+#define C_CALL_RET_ADDR 27
+#define DOMAIN_STATE_PTR 28
+#define TRAP_PTR 29
+#define ALLOC_LIMIT 30
+#define ALLOC_PTR 31
+
+#if defined(MODEL_ppc64) || defined(MODEL_ppc64le)
+#define EITHER(a,b) b
+#else
+#define EITHER(a,b) a
+#endif
+
+#define WORD EITHER(4,8)
+#define lg EITHER(lwz,ld)
+#define lgu EITHER(lwzu,ldu)
+#define stg EITHER(stw,std)
+#define stgu EITHER(stwu,stdu)
+#define datag EITHER(.long,.quad)
+#define wordalign EITHER(2,3)
+
+/* Stack layout */
+#if defined(MODEL_ppc)
+#define RESERVED_STACK 16
+#define PARAM_SAVE_AREA 0
+#define LR_SAVE 4
+#define TRAP_SIZE 16
+#define TRAP_HANDLER_OFFSET 0
+#define TRAP_PREVIOUS_OFFSET 4
+#define CALLBACK_LINK_SIZE 16
+#define CALLBACK_LINK_OFFSET 0
+#endif
+#if defined(MODEL_ppc64)
+#define RESERVED_STACK 48
+#define PARAM_SAVE_AREA (8*8)
+#define LR_SAVE 16
+#define TOC_SAVE 40
+#define TOC_SAVE_PARENT 8
+#define TRAP_SIZE 32
+#define TRAP_HANDLER_OFFSET 56
+#define TRAP_PREVIOUS_OFFSET 64
+#define CALLBACK_LINK_SIZE 32
+#define CALLBACK_LINK_OFFSET 48
+#endif
+#if defined(MODEL_ppc64le)
+#define RESERVED_STACK 32
+#define PARAM_SAVE_AREA 0
+#define LR_SAVE 16
+#define TOC_SAVE_PARENT 8
+#define TOC_SAVE 24
+#define TRAP_SIZE 32
+#define TRAP_HANDLER_OFFSET 40
+#define TRAP_PREVIOUS_OFFSET 48
+#define CALLBACK_LINK_SIZE 32
+#define CALLBACK_LINK_OFFSET 32
+#endif
+
+/* Function definitions */
+
+#if defined(MODEL_ppc)
+#define FUNCTION(name) \
+  .section ".text"; \
+  .globl name; \
+  .type name, @function; \
+  .align 2; \
+  name:
+
+#define ENDFUNCTION(name) \
+  .size name, . - name
+
+#endif
+
+#if defined(MODEL_ppc64)
+#define FUNCTION(name) \
+  .section ".opd","aw"; \
+  .align 3; \
+  .globl name; \
+  .type name, @function; \
+  name: .quad .L.name,.TOC.@tocbase; \
+  .text; \
+  .align 2; \
+  .L.name:
+
+#define ENDFUNCTION(name) \
+  .size name, . - .L.name
+
+#endif
+
+#if defined(MODEL_ppc64le)
+#define FUNCTION(name) \
+  .section ".text"; \
+  .globl name; \
+  .type name, @function; \
+  .align 2; \
+  name: ; \
+  0: addis 2, 12, (.TOC. - 0b)@ha; \
+  addi 2, 2, (.TOC. - 0b)@l; \
+  .localentry name, . - 0b
+
+#define ENDFUNCTION(name) \
+  .size name, . - name
+
+#endif
+
+/* Accessing global variables.  */
+
+#if defined(MODEL_ppc)
+
+#define Addrglobal(reg,glob) \
+        addis   reg, 0, glob@ha; \
+        addi    reg, reg, glob@l
+#endif
+
+#if defined(MODEL_ppc64) || defined(MODEL_ppc64le)
+
+#define LSYMB(glob) .L##glob
+
+#define Addrglobal(reg,glob) \
+        ld      reg, LSYMB(glob)@toc(2)
+#endif
+
+        .set    domain_curr_field, 0
+#define DOMAIN_STATE(c_type, name) \
+        .equ    domain_field_caml_##name, domain_curr_field ; \
+        .set    domain_curr_field, domain_curr_field + 1
+#include "../runtime/caml/domain_state.tbl"
+#undef DOMAIN_STATE
+
+#define Caml_state(var) 8*domain_field_caml_##var(28)
+
+#if defined(MODEL_ppc64)
+        .section ".opd","aw"
+#else
+        .section ".text"
+#endif
+        .globl  caml_system__code_begin
+caml_system__code_begin:
+
+/* Invoke the garbage collector. */
+
+FUNCTION(caml_call_gc)
+#define STACKSIZE (WORD*32 + 8*32 + PARAM_SAVE_AREA + RESERVED_STACK)
+    /* 32 integer registers + 32 float registers + space for C call */
+    /* Set up stack frame */
+        stwu    1, -STACKSIZE(1)
+    /* Record return address into OCaml code */
+        mflr    0
+        stg     0, Caml_state(last_return_address)
+    /* Record lowest stack address */
+        addi    0, 1, STACKSIZE
+        stg     0, Caml_state(bottom_of_stack)
+    /* Record pointer to register array */
+        addi    0, 1, 8*32 + PARAM_SAVE_AREA + RESERVED_STACK
+        stg     0, Caml_state(gc_regs)
+    /* Save current allocation pointer for debugging purposes */
+        stg     ALLOC_PTR, Caml_state(young_ptr)
+    /* Save exception pointer (if e.g. a sighandler raises) */
+        stg     TRAP_PTR, Caml_state(exception_pointer)
+    /* Save all registers used by the code generator */
+        addi    11, 1, 8*32 + PARAM_SAVE_AREA + RESERVED_STACK - WORD
+        stgu    3, WORD(11)
+        stgu    4, WORD(11)
+        stgu    5, WORD(11)
+        stgu    6, WORD(11)
+        stgu    7, WORD(11)
+        stgu    8, WORD(11)
+        stgu    9, WORD(11)
+        stgu    10, WORD(11)
+        stgu    14, WORD(11)
+        stgu    15, WORD(11)
+        stgu    16, WORD(11)
+        stgu    17, WORD(11)
+        stgu    18, WORD(11)
+        stgu    19, WORD(11)
+        stgu    20, WORD(11)
+        stgu    21, WORD(11)
+        stgu    22, WORD(11)
+        stgu    23, WORD(11)
+        stgu    24, WORD(11)
+        stgu    25, WORD(11)
+        stgu    26, WORD(11)
+        stgu    27, WORD(11)
+        stgu    28, WORD(11)
+        addi    11, 1, PARAM_SAVE_AREA + RESERVED_STACK - 8
+        stfdu   1, 8(11)
+        stfdu   2, 8(11)
+        stfdu   3, 8(11)
+        stfdu   4, 8(11)
+        stfdu   5, 8(11)
+        stfdu   6, 8(11)
+        stfdu   7, 8(11)
+        stfdu   8, 8(11)
+        stfdu   9, 8(11)
+        stfdu   10, 8(11)
+        stfdu   11, 8(11)
+        stfdu   12, 8(11)
+        stfdu   13, 8(11)
+        stfdu   14, 8(11)
+        stfdu   15, 8(11)
+        stfdu   16, 8(11)
+        stfdu   17, 8(11)
+        stfdu   18, 8(11)
+        stfdu   19, 8(11)
+        stfdu   20, 8(11)
+        stfdu   21, 8(11)
+        stfdu   22, 8(11)
+        stfdu   23, 8(11)
+        stfdu   24, 8(11)
+        stfdu   25, 8(11)
+        stfdu   26, 8(11)
+        stfdu   27, 8(11)
+        stfdu   28, 8(11)
+        stfdu   29, 8(11)
+        stfdu   30, 8(11)
+        stfdu   31, 8(11)
+    /* Call the GC */
+        bl      caml_garbage_collection
+#if defined(MODEL_ppc64) || defined(MODEL_ppc64le)
+        nop
+#endif
+    /* Reload new allocation pointer and allocation limit */
+        lg      ALLOC_PTR, Caml_state(young_ptr)
+        lg      ALLOC_LIMIT, Caml_state(young_limit)
+    /* Restore all regs used by the code generator */
+        addi    11, 1, 8*32 + PARAM_SAVE_AREA + RESERVED_STACK - WORD
+        lgu     3, WORD(11)
+        lgu     4, WORD(11)
+        lgu     5, WORD(11)
+        lgu     6, WORD(11)
+        lgu     7, WORD(11)
+        lgu     8, WORD(11)
+        lgu     9, WORD(11)
+        lgu     10, WORD(11)
+        lgu     14, WORD(11)
+        lgu     15, WORD(11)
+        lgu     16, WORD(11)
+        lgu     17, WORD(11)
+        lgu     18, WORD(11)
+        lgu     19, WORD(11)
+        lgu     20, WORD(11)
+        lgu     21, WORD(11)
+        lgu     22, WORD(11)
+        lgu     23, WORD(11)
+        lgu     24, WORD(11)
+        lgu     25, WORD(11)
+        lgu     26, WORD(11)
+        lgu     27, WORD(11)
+        lgu     28, WORD(11)
+        addi    11, 1, PARAM_SAVE_AREA + RESERVED_STACK - 8
+        lfdu    1, 8(11)
+        lfdu    2, 8(11)
+        lfdu    3, 8(11)
+        lfdu    4, 8(11)
+        lfdu    5, 8(11)
+        lfdu    6, 8(11)
+        lfdu    7, 8(11)
+        lfdu    8, 8(11)
+        lfdu    9, 8(11)
+        lfdu    10, 8(11)
+        lfdu    11, 8(11)
+        lfdu    12, 8(11)
+        lfdu    13, 8(11)
+        lfdu    14, 8(11)
+        lfdu    15, 8(11)
+        lfdu    16, 8(11)
+        lfdu    17, 8(11)
+        lfdu    18, 8(11)
+        lfdu    19, 8(11)
+        lfdu    20, 8(11)
+        lfdu    21, 8(11)
+        lfdu    22, 8(11)
+        lfdu    23, 8(11)
+        lfdu    24, 8(11)
+        lfdu    25, 8(11)
+        lfdu    26, 8(11)
+        lfdu    27, 8(11)
+        lfdu    28, 8(11)
+        lfdu    29, 8(11)
+        lfdu    30, 8(11)
+        lfdu    31, 8(11)
+    /* Return to caller, resuming the allocation */
+        lg      11, Caml_state(last_return_address)
+        mtlr    11
+    /* For PPC64: restore the TOC that the caller saved at the usual place */
+#ifdef TOC_SAVE
+        ld      2, (STACKSIZE + TOC_SAVE)(1)
+#endif
+    /* Deallocate stack frame */
+        addi    1, 1, STACKSIZE
+        blr
+#undef STACKSIZE
+ENDFUNCTION(caml_call_gc)
+
+/* Call a C function from OCaml */
+
+FUNCTION(caml_c_call)
+        .cfi_startproc
+    /* Save return address in a callee-save register */
+        mflr    C_CALL_RET_ADDR
+        .cfi_register 65, C_CALL_RET_ADDR
+    /* Record lowest stack address and return address */
+        stg     1, Caml_state(bottom_of_stack)
+        stg     C_CALL_RET_ADDR, Caml_state(last_return_address)
+    /* Make the exception handler and alloc ptr available to the C code */
+        stg     ALLOC_PTR, Caml_state(young_ptr)
+        stg     TRAP_PTR, Caml_state(exception_pointer)
+    /* Call C function (address in C_CALL_FUN) */
+#if defined(MODEL_ppc)
+        mtctr   C_CALL_FUN
+        bctrl
+#elif defined(MODEL_ppc64)
+        ld      0, 0(C_CALL_FUN)
+        mr      C_CALL_TOC, 2   /* save current TOC in a callee-save register */
+        mtctr   0
+        ld      2, 8(C_CALL_FUN)
+        bctrl
+        mr      2, C_CALL_TOC   /* restore current TOC */
+#elif defined(MODEL_ppc64le)
+        mtctr   C_CALL_FUN
+        mr      12, C_CALL_FUN
+        mr      C_CALL_TOC, 2   /* save current TOC in a callee-save register */
+        bctrl
+        mr      2, C_CALL_TOC   /* restore current TOC */
+#else
+#error "wrong MODEL"
+#endif
+    /* Restore return address (in 27, preserved by the C function) */
+        mtlr    C_CALL_RET_ADDR
+    /* Reload allocation pointer and allocation limit*/
+        lg      ALLOC_PTR, Caml_state(young_ptr)
+        lg      ALLOC_LIMIT, Caml_state(young_limit)
+    /* Return to caller */
+        blr
+        .cfi_endproc
+ENDFUNCTION(caml_c_call)
+
+/* Raise an exception from OCaml */
+
+FUNCTION(caml_raise_exn)
+        lg      0, Caml_state(backtrace_active)
+        cmpwi   0, 0
+        bne     .L111
+.L110:
+    /* Pop trap frame */
+        lg      0, TRAP_HANDLER_OFFSET(TRAP_PTR)
+        mr      1, TRAP_PTR
+        mtctr   0
+        lg      TRAP_PTR, TRAP_PREVIOUS_OFFSET(1)
+        addi    1, 1, TRAP_SIZE
+    /* Branch to handler */
+        bctr
+.L111:
+        mr      27, 3           /* preserve exn bucket in callee-save reg */
+                                /* arg1: exception bucket, already in r3 */
+        mflr    4               /* arg2: PC of raise */
+        mr      5, 1            /* arg3: SP of raise */
+        mr      6, TRAP_PTR     /* arg4: SP of handler */
+        addi    1, 1, -(PARAM_SAVE_AREA + RESERVED_STACK)
+                                /* reserve stack space for C call */
+        bl      caml_stash_backtrace
+#if defined(MODEL_ppc64) || defined(MODEL_ppc64le)
+        nop
+#endif
+        mr      3, 27           /* restore exn bucket */
+        b       .L110           /* raise the exn */
+ENDFUNCTION(caml_raise_exn)
+
+/* Raise an exception from C */
+
+FUNCTION(caml_raise_exception)
+    /* Load domain state pointer */
+        mr      DOMAIN_STATE_PTR, 3
+        mr      3, 4
+        lg      0, Caml_state(backtrace_active)
+        cmpwi   0, 0
+        bne     .L121
+.L120:
+    /* Reload OCaml global registers */
+        lg      1, Caml_state(exception_pointer)
+        lg      ALLOC_PTR, Caml_state(young_ptr)
+        lg      ALLOC_LIMIT, Caml_state(young_limit)
+    /* Pop trap frame */
+        lg      0, TRAP_HANDLER_OFFSET(1)
+        mtctr   0
+        lg      TRAP_PTR, TRAP_PREVIOUS_OFFSET(1)
+        addi    1, 1, TRAP_SIZE
+    /* Branch to handler */
+        bctr
+.L121:
+        mr      27, 3           /* preserve exn bucket in callee-save reg */
+                                /* arg1: exception bucket, already in r3 */
+        lg      4, Caml_state(last_return_address) /* arg2: PC of raise */
+        lg      5, Caml_state(bottom_of_stack)     /* arg3: SP of raise */
+        lg      6, Caml_state(exception_pointer)   /* arg4: SP of handler */
+        addi    1, 1, -(PARAM_SAVE_AREA + RESERVED_STACK)
+                                         /* reserve stack space for C call */
+        bl      caml_stash_backtrace
+#if defined(MODEL_ppc64) || defined(MODEL_ppc64le)
+        nop
+#endif
+        mr      3, 27           /* restore exn bucket */
+        b       .L120           /* raise the exn */
+ENDFUNCTION(caml_raise_exception)
+
+/* Start the OCaml program */
+
+FUNCTION(caml_start_program)
+        .cfi_startproc
+#define STACKSIZE (WORD*18 + 8*18 + CALLBACK_LINK_SIZE + RESERVED_STACK)
+  /* 18 callee-save GPR14...GPR31 + 18 callee-save FPR14...FPR31 */
+  /* Domain state pointer is the first arg to caml_start_program. Move it */
+        mr      START_PRG_DOMAIN_STATE_PTR, 3
+        Addrglobal(START_PRG_ARG, caml_program)
+/* Code shared between caml_start_program and caml_callback */
+.L102:
+    /* Allocate and link stack frame */
+        stgu    1, -STACKSIZE(1)
+        .cfi_adjust_cfa_offset STACKSIZE
+    /* Save return address */
+        mflr    0
+        stg     0, (STACKSIZE + LR_SAVE)(1)
+        .cfi_offset 65, LR_SAVE
+    /* Save TOC pointer if applicable */
+#ifdef TOC_SAVE_PARENT
+        std     2, (STACKSIZE + TOC_SAVE_PARENT)(1)
+#endif
+    /* Save all callee-save registers */
+        addi    11, 1, CALLBACK_LINK_SIZE + RESERVED_STACK - WORD
+        stgu    14, WORD(11)
+        stgu    15, WORD(11)
+        stgu    16, WORD(11)
+        stgu    17, WORD(11)
+        stgu    18, WORD(11)
+        stgu    19, WORD(11)
+        stgu    20, WORD(11)
+        stgu    21, WORD(11)
+        stgu    22, WORD(11)
+        stgu    23, WORD(11)
+        stgu    24, WORD(11)
+        stgu    25, WORD(11)
+        stgu    26, WORD(11)
+        stgu    27, WORD(11)
+        stgu    28, WORD(11)
+        stgu    29, WORD(11)
+        stgu    30, WORD(11)
+        stgu    31, WORD(11)
+        stfdu   14, 8(11)
+        stfdu   15, 8(11)
+        stfdu   16, 8(11)
+        stfdu   17, 8(11)
+        stfdu   18, 8(11)
+        stfdu   19, 8(11)
+        stfdu   20, 8(11)
+        stfdu   21, 8(11)
+        stfdu   22, 8(11)
+        stfdu   23, 8(11)
+        stfdu   24, 8(11)
+        stfdu   25, 8(11)
+        stfdu   26, 8(11)
+        stfdu   27, 8(11)
+        stfdu   28, 8(11)
+        stfdu   29, 8(11)
+        stfdu   30, 8(11)
+        stfdu   31, 8(11)
+    /* Load domain state pointer from argument */
+        mr      DOMAIN_STATE_PTR, START_PRG_DOMAIN_STATE_PTR
+    /* Set up a callback link */
+        lg      11, Caml_state(bottom_of_stack)
+        stg     11, CALLBACK_LINK_OFFSET(1)
+        lg      11, Caml_state(last_return_address)
+        stg     11, (CALLBACK_LINK_OFFSET + WORD)(1)
+        lg      11, Caml_state(gc_regs)
+        stg     11, (CALLBACK_LINK_OFFSET + 2 * WORD)(1)
+    /* Build an exception handler to catch exceptions escaping out of OCaml */
+        bl      .L103
+        b       .L104
+.L103:
+        addi    1, 1, -TRAP_SIZE
+        .cfi_adjust_cfa_offset TRAP_SIZE
+        mflr    0
+        stg     0, TRAP_HANDLER_OFFSET(1)
+        lg      11, Caml_state(exception_pointer)
+        stg     11, TRAP_PREVIOUS_OFFSET(1)
+        mr      TRAP_PTR, 1
+    /* Reload allocation pointers */
+        lg      ALLOC_PTR, Caml_state(young_ptr)
+        lg      ALLOC_LIMIT, Caml_state(young_limit)
+    /* Call the OCaml code (address in r12) */
+#if defined(MODEL_ppc)
+        mtctr   12
+.L105:  bctrl
+#elif defined(MODEL_ppc64)
+        ld      0, 0(12)
+        mtctr   0
+        std     2, TOC_SAVE(1)
+        ld      2, 8(12)
+.L105:  bctrl
+        ld      2, TOC_SAVE(1)
+#elif defined(MODEL_ppc64le)
+        mtctr   12
+        std     2, TOC_SAVE(1)
+.L105:  bctrl
+        ld      2, TOC_SAVE(1)
+#else
+#error "wrong MODEL"
+#endif
+    /* Pop the trap frame, restoring caml_exception_pointer */
+        lg      0, TRAP_PREVIOUS_OFFSET(1)
+        stg     0, Caml_state(exception_pointer)
+        addi    1, 1, TRAP_SIZE
+        .cfi_adjust_cfa_offset -TRAP_SIZE
+    /* Pop the callback link, restoring the global variables */
+.L106:
+        lg      0, CALLBACK_LINK_OFFSET(1)
+        stg     0, Caml_state(bottom_of_stack)
+        lg      0, (CALLBACK_LINK_OFFSET + WORD)(1)
+        stg     0, Caml_state(last_return_address)
+        lg      0, (CALLBACK_LINK_OFFSET + 2 * WORD)(1)
+        stg     0, Caml_state(gc_regs)
+    /* Update allocation pointer */
+        stg     ALLOC_PTR, Caml_state(young_ptr)
+    /* Restore callee-save registers */
+        addi    11, 1, CALLBACK_LINK_SIZE + RESERVED_STACK - WORD
+        lgu     14, WORD(11)
+        lgu     15, WORD(11)
+        lgu     16, WORD(11)
+        lgu     17, WORD(11)
+        lgu     18, WORD(11)
+        lgu     19, WORD(11)
+        lgu     20, WORD(11)
+        lgu     21, WORD(11)
+        lgu     22, WORD(11)
+        lgu     23, WORD(11)
+        lgu     24, WORD(11)
+        lgu     25, WORD(11)
+        lgu     26, WORD(11)
+        lgu     27, WORD(11)
+        lgu     28, WORD(11)
+        lgu     29, WORD(11)
+        lgu     30, WORD(11)
+        lgu     31, WORD(11)
+        lfdu    14, 8(11)
+        lfdu    15, 8(11)
+        lfdu    16, 8(11)
+        lfdu    17, 8(11)
+        lfdu    18, 8(11)
+        lfdu    19, 8(11)
+        lfdu    20, 8(11)
+        lfdu    21, 8(11)
+        lfdu    22, 8(11)
+        lfdu    23, 8(11)
+        lfdu    24, 8(11)
+        lfdu    25, 8(11)
+        lfdu    26, 8(11)
+        lfdu    27, 8(11)
+        lfdu    28, 8(11)
+        lfdu    29, 8(11)
+        lfdu    30, 8(11)
+        lfdu    31, 8(11)
+    /* Reload return address */
+        lg      0, (STACKSIZE + LR_SAVE)(1)
+        mtlr    0
+    /* Return */
+        addi    1, 1, STACKSIZE
+        blr
+
+    /* The trap handler: */
+.L104:
+    /* Restore TOC pointer */
+#ifdef TOC_SAVE_PARENT
+        ld      2, (STACKSIZE + TOC_SAVE_PARENT)(1)
+#endif
+    /* Update caml_exception_pointer */
+        stg     TRAP_PTR, Caml_state(exception_pointer)
+    /* Encode exception bucket as an exception result and return it */
+        ori     3, 3, 2
+        b       .L106
+#undef STACKSIZE
+        .cfi_endproc
+ENDFUNCTION(caml_start_program)
+
+/* Callback from C to OCaml */
+
+FUNCTION(caml_callback_asm)
+    /* Initial shuffling of arguments */
+    /* r3 = Caml_state, r4 = closure, 0(r5) = first arg */
+        mr      START_PRG_DOMAIN_STATE_PTR, 3
+        lg      3, 0(5)             /* r3 = Argument */
+                                    /* r4 = Closure */
+        lg      START_PRG_ARG, 0(4) /* Code pointer */
+        b       .L102
+ENDFUNCTION(caml_callback_asm)
+
+FUNCTION(caml_callback2_asm)
+    /* r3 = Caml_state, r4 = closure, 0(r5) = first arg,
+       WORD(r5) = second arg */
+        mr      START_PRG_DOMAIN_STATE_PTR, 3
+        mr      0, 4
+        lg      3, 0(5)             /* r3 = First argument */
+        lg      4, WORD(5)          /* r4 = Second argument */
+        mr      5, 0                /* r5 = Closure */
+        Addrglobal(START_PRG_ARG, caml_apply2)
+        b       .L102
+ENDFUNCTION(caml_callback2_asm)
+
+FUNCTION(caml_callback3_asm)
+    /* r3 = Caml_state, r4 = closure, 0(r5) = first arg, WORD(r5) = second arg,
+       2*WORD(r5) = third arg */
+        mr      START_PRG_DOMAIN_STATE_PTR, 3
+        mr      6, 4                /* r6 = Closure */
+        lg      3, 0(5)             /* r3 = First argument */
+        lg      4, WORD(5)          /* r4 = Second argument */
+        lg      5, 2*WORD(5)        /* r5 = Third argument */
+        Addrglobal(START_PRG_ARG, caml_apply3)
+        b       .L102
+ENDFUNCTION(caml_callback3_asm)
+
+#if defined(MODEL_ppc64)
+        .section ".opd","aw"
+#else
+        .section ".text"
+#endif
+
+        .globl  caml_system__code_end
+caml_system__code_end:
+
+/* Frame table */
+
+        .section ".data"
+        .globl  caml_system__frametable
+        .type   caml_system__frametable, @object
+caml_system__frametable:
+        datag   1               /* one descriptor */
+        datag   .L105 + 4       /* return address into callback */
+        .short  -1              /* negative size count => use callback link */
+        .short  0               /* no roots here */
+
+/* TOC entries */
+
+#if defined(MODEL_ppc64) || defined(MODEL_ppc64le)
+
+        .section ".toc", "aw"
+
+#define TOCENTRY(glob) LSYMB(glob): .quad glob
+
+TOCENTRY(caml_apply2)
+TOCENTRY(caml_apply3)
+TOCENTRY(caml_program)
+
+#endif
+
+/* Mark stack as non-executable */
+        .section .note.GNU-stack,"",%progbits
diff --git a/runtime/printexc.c b/runtime/printexc.c
new file mode 100644
index 00000000..e18beda3
--- /dev/null
+++ b/runtime/printexc.c
@@ -0,0 +1,162 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* Print an uncaught exception and abort */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "caml/backtrace.h"
+#include "caml/callback.h"
+#include "caml/debugger.h"
+#include "caml/fail.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/printexc.h"
+#include "caml/memory.h"
+#include "caml/memprof.h"
+
+struct stringbuf {
+  char * ptr;
+  char * end;
+  char data[256];
+};
+
+static void add_char(struct stringbuf *buf, char c)
+{
+  if (buf->ptr < buf->end) *(buf->ptr++) = c;
+}
+
+static void add_string(struct stringbuf *buf, const char *s)
+{
+  size_t len = strlen(s);
+  if (buf->ptr + len > buf->end) len = buf->end - buf->ptr;
+  if (len > 0) memmove(buf->ptr, s, len);
+  buf->ptr += len;
+}
+
+CAMLexport char * caml_format_exception(value exn)
+{
+  mlsize_t start, i;
+  value bucket, v;
+  struct stringbuf buf;
+  char intbuf[64];
+  char * res;
+
+  buf.ptr = buf.data;
+  buf.end = buf.data + sizeof(buf.data) - 1;
+  if (Tag_val(exn) == 0) {
+    add_string(&buf, String_val(Field(Field(exn, 0), 0)));
+    /* Check for exceptions in the style of Match_failure and Assert_failure */
+    if (Wosize_val(exn) == 2 &&
+        Is_block(Field(exn, 1)) &&
+        Tag_val(Field(exn, 1)) == 0 &&
+        caml_is_special_exception(Field(exn, 0))) {
+      bucket = Field(exn, 1);
+      start = 0;
+    } else {
+      bucket = exn;
+      start = 1;
+    }
+    add_char(&buf, '(');
+    for (i = start; i < Wosize_val(bucket); i++) {
+      if (i > start) add_string(&buf, ", ");
+      v = Field(bucket, i);
+      if (Is_long(v)) {
+        snprintf(intbuf, sizeof(intbuf),
+                 "%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val(v));
+        add_string(&buf, intbuf);
+      } else if (Tag_val(v) == String_tag) {
+        add_char(&buf, '"');
+        add_string(&buf, String_val(v));
+        add_char(&buf, '"');
+      } else {
+        add_char(&buf, '_');
+      }
+    }
+    add_char(&buf, ')');
+  } else
+    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);
+  if (res == NULL) return NULL;
+  memmove(res, buf.data, i);
+  return res;
+}
+
+
+#ifdef NATIVE_CODE
+#  define DEBUGGER_IN_USE 0
+#else
+#  define DEBUGGER_IN_USE caml_debugger_in_use
+#endif
+
+/* Default C implementation in case the OCaml one is not registered. */
+static void default_fatal_uncaught_exception(value exn)
+{
+  char * msg;
+  const value * at_exit;
+  int saved_backtrace_active, saved_backtrace_pos;
+
+  /* Build a string representation of the exception */
+  msg = caml_format_exception(exn);
+  /* Perform "at_exit" processing, ignoring all exceptions that may
+     be triggered by this */
+  saved_backtrace_active = Caml_state->backtrace_active;
+  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);
+  Caml_state->backtrace_active = saved_backtrace_active;
+  Caml_state->backtrace_pos = saved_backtrace_pos;
+  /* Display the uncaught exception */
+  fprintf(stderr, "Fatal error: exception %s\n", msg);
+  caml_stat_free(msg);
+  /* Display the backtrace if available */
+  if (Caml_state->backtrace_active && !DEBUGGER_IN_USE)
+    caml_print_exception_backtrace();
+}
+
+int caml_abort_on_uncaught_exn = 0; /* see afl.c */
+
+void caml_fatal_uncaught_exception(value exn)
+{
+  const value *handle_uncaught_exception;
+
+  handle_uncaught_exception =
+    caml_named_value("Printexc.handle_uncaught_exception");
+
+  /* If the callback allocates, memprof could be called. In this case,
+     memprof's callback could raise an exception while
+     [handle_uncaught_exception] is running, so that the printing of
+     the exception fails. */
+  caml_memprof_suspended = 1;
+
+  if (handle_uncaught_exception != NULL)
+    /* [Printexc.handle_uncaught_exception] does not raise exception. */
+    caml_callback2(*handle_uncaught_exception, exn, Val_bool(DEBUGGER_IN_USE));
+  else
+    default_fatal_uncaught_exception(exn);
+  /* Terminate the process */
+  if (caml_abort_on_uncaught_exn) {
+    abort();
+  } else {
+    exit(2);
+  }
+}
diff --git a/runtime/riscv.S b/runtime/riscv.S
new file mode 100644
index 00000000..48e690e4
--- /dev/null
+++ b/runtime/riscv.S
@@ -0,0 +1,423 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                Nicolas Ojeda Bar <n.oje.bar@gmail.com>                 */
+/*                                                                        */
+/*   Copyright 2016 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Asm part of the runtime system, RISC-V processor, 64-bit mode */
+/* Must be preprocessed by cpp */
+
+#define ARG_DOMAIN_STATE_PTR t0
+#define DOMAIN_STATE_PTR s0
+#define TRAP_PTR s1
+#define ALLOC_PTR s10
+#define ALLOC_LIMIT s11
+#define TMP t1
+#define ARG t2
+
+#define STORE sd
+#define LOAD ld
+
+        .set    domain_curr_field, 0
+#define DOMAIN_STATE(c_type, name) \
+        .equ    domain_field_caml_##name, domain_curr_field ; \
+        .set    domain_curr_field, domain_curr_field + 1
+#include "../runtime/caml/domain_state.tbl"
+#undef DOMAIN_STATE
+
+#define Caml_state(var) (8*domain_field_caml_##var)(s0)
+
+#define FUNCTION(name) \
+        .align 2; \
+        .globl name; \
+        .type name, @function; \
+name:
+
+#if defined(__PIC__)
+        .option pic
+#define PLT(r) r@plt
+#else
+        .option nopic
+#define PLT(r) r
+#endif
+
+        .section        .text
+/* Invoke the garbage collector. */
+
+        .globl  caml_system__code_begin
+caml_system__code_begin:
+
+FUNCTION(caml_call_gc)
+.Lcaml_call_gc:
+        /* Record return address */
+        STORE   ra, Caml_state(last_return_address)
+        /* Record lowest stack address */
+        STORE   sp, Caml_state(bottom_of_stack)
+        /* Set up stack space, saving return address */
+        /* (1 reg for RA, 1 reg for FP, 21 allocatable int regs,
+            20 caller-save float regs) * 8 */
+        /* + 1 for alignment */
+        addi    sp, sp, -0x160
+        STORE   ra, 0x8(sp)
+        STORE   s0, 0x0(sp)
+        /* Save allocatable integer registers on the stack,
+           in the order given in proc.ml */
+        STORE   a0, 0x10(sp)
+        STORE   a1, 0x18(sp)
+        STORE   a2, 0x20(sp)
+        STORE   a3, 0x28(sp)
+        STORE   a4, 0x30(sp)
+        STORE   a5, 0x38(sp)
+        STORE   a6, 0x40(sp)
+        STORE   a7, 0x48(sp)
+        STORE   s2, 0x50(sp)
+        STORE   s3, 0x58(sp)
+        STORE   s4, 0x60(sp)
+        STORE   s5, 0x68(sp)
+        STORE   s6, 0x70(sp)
+        STORE   s7, 0x78(sp)
+        STORE   s8, 0x80(sp)
+        STORE   s9, 0x88(sp)
+        STORE   t2, 0x90(sp)
+        STORE   t3, 0x98(sp)
+        STORE   t4, 0xa0(sp)
+        STORE   t5, 0xa8(sp)
+        STORE   t6, 0xb0(sp)
+        /* Save caller-save floating-point registers on the stack
+           (callee-saves are preserved by caml_garbage_collection) */
+        fsd     ft0, 0xb8(sp)
+        fsd     ft1, 0xc0(sp)
+        fsd     ft2, 0xc8(sp)
+        fsd     ft3, 0xd0(sp)
+        fsd     ft4, 0xd8(sp)
+        fsd     ft5, 0xe0(sp)
+        fsd     ft6, 0xe8(sp)
+        fsd     ft7, 0xf0(sp)
+        fsd     fa0, 0xf8(sp)
+        fsd     fa1, 0x100(sp)
+        fsd     fa2, 0x108(sp)
+        fsd     fa3, 0x110(sp)
+        fsd     fa4, 0x118(sp)
+        fsd     fa5, 0x120(sp)
+        fsd     fa6, 0x128(sp)
+        fsd     fa7, 0x130(sp)
+        fsd     ft8, 0x138(sp)
+        fsd     ft9, 0x140(sp)
+        fsd     ft9, 0x148(sp)
+        fsd     ft10, 0x150(sp)
+        fsd     ft11, 0x158(sp)
+        /* Store pointer to saved integer registers in caml_gc_regs */
+        addi    TMP, sp, 0x10
+        STORE   TMP, Caml_state(gc_regs)
+        /* Save current allocation pointer for debugging purposes */
+        STORE   ALLOC_PTR, Caml_state(young_ptr)
+        /* Save trap pointer in case an exception is raised during GC */
+        STORE   TRAP_PTR, Caml_state(exception_pointer)
+        /* Call the garbage collector */
+        call    PLT(caml_garbage_collection)
+        /* Restore registers */
+        LOAD    a0, 0x10(sp)
+        LOAD    a1, 0x18(sp)
+        LOAD    a2, 0x20(sp)
+        LOAD    a3, 0x28(sp)
+        LOAD    a4, 0x30(sp)
+        LOAD    a5, 0x38(sp)
+        LOAD    a6, 0x40(sp)
+        LOAD    a7, 0x48(sp)
+        LOAD    s2, 0x50(sp)
+        LOAD    s3, 0x58(sp)
+        LOAD    s4, 0x60(sp)
+        LOAD    s5, 0x68(sp)
+        LOAD    s6, 0x70(sp)
+        LOAD    s7, 0x78(sp)
+        LOAD    s8, 0x80(sp)
+        LOAD    s9, 0x88(sp)
+        LOAD    t2, 0x90(sp)
+        LOAD    t3, 0x98(sp)
+        LOAD    t4, 0xa0(sp)
+        LOAD    t5, 0xa8(sp)
+        LOAD    t6, 0xb0(sp)
+        fld     ft0, 0xb8(sp)
+        fld     ft1, 0xc0(sp)
+        fld     ft2, 0xc8(sp)
+        fld     ft3, 0xd0(sp)
+        fld     ft4, 0xd8(sp)
+        fld     ft5, 0xe0(sp)
+        fld     ft6, 0xe8(sp)
+        fld     ft7, 0xf0(sp)
+        fld     fa0, 0xf8(sp)
+        fld     fa1, 0x100(sp)
+        fld     fa2, 0x108(sp)
+        fld     fa3, 0x110(sp)
+        fld     fa4, 0x118(sp)
+        fld     fa5, 0x120(sp)
+        fld     fa6, 0x128(sp)
+        fld     fa7, 0x130(sp)
+        fld     ft8, 0x138(sp)
+        fld     ft9, 0x140(sp)
+        fld     ft9, 0x148(sp)
+        fld     ft10, 0x150(sp)
+        fld     ft11, 0x158(sp)
+        /* Reload new allocation pointer and allocation limit */
+        LOAD    ALLOC_PTR, Caml_state(young_ptr)
+        LOAD    ALLOC_LIMIT, Caml_state(young_limit)
+        /* Free stack space and return to caller */
+        LOAD    ra, 0x8(sp)
+        LOAD    s0, 0x0(sp)
+        addi    sp, sp, 0x160
+        ret
+        .size   caml_call_gc, .-caml_call_gc
+
+/* Call a C function from OCaml */
+/* Function to call is in ARG */
+
+FUNCTION(caml_c_call)
+        /* Preserve return address in callee-save register s2 */
+        mv      s2, ra
+        /* Record lowest stack address and return address */
+        STORE   ra, Caml_state(last_return_address)
+        STORE   sp, Caml_state(bottom_of_stack)
+        /* Make the exception handler alloc ptr available to the C code */
+        STORE   ALLOC_PTR, Caml_state(young_ptr)
+        STORE   TRAP_PTR, Caml_state(exception_pointer)
+        /* Call the function */
+        jalr    ARG
+        /* Reload alloc ptr and alloc limit */
+        LOAD    ALLOC_PTR, Caml_state(young_ptr)
+        LOAD    ALLOC_LIMIT, Caml_state(young_limit)
+        /* Return */
+        jr      s2
+        .size   caml_c_call, .-caml_c_call
+
+/* Raise an exception from OCaml */
+FUNCTION(caml_raise_exn)
+        /* Test if backtrace is active */
+        LOAD    TMP, Caml_state(backtrace_active)
+        bnez    TMP, 2f
+1:      /* Cut stack at current trap handler */
+        mv      sp, TRAP_PTR
+        /* Pop previous handler and jump to it */
+        LOAD    TMP, 8(sp)
+        LOAD    TRAP_PTR, 0(sp)
+        addi    sp, sp, 16
+        jr      TMP
+2:      /* Preserve exception bucket in callee-save register s2 */
+        mv      s2, a0
+        /* Stash the backtrace */
+        mv      a1, ra
+        mv      a2, sp
+        mv      a3, TRAP_PTR
+        call    PLT(caml_stash_backtrace)
+        /* Restore exception bucket and raise */
+        mv      a0, s2
+        j       1b
+        .size   caml_raise_exn, .-caml_raise_exn
+
+        .globl  caml_reraise_exn
+        .type   caml_reraise_exn, @function
+
+/* Raise an exception from C */
+
+FUNCTION(caml_raise_exception)
+        mv      DOMAIN_STATE_PTR, a0
+        mv      a0, a1
+        LOAD    TRAP_PTR, Caml_state(exception_pointer)
+        LOAD    ALLOC_PTR, Caml_state(young_ptr)
+        LOAD    ALLOC_LIMIT, Caml_state(young_limit)
+        LOAD    TMP, Caml_state(backtrace_active)
+        bnez    TMP, 2f
+1:      /* Cut stack at current trap handler */
+        mv      sp, TRAP_PTR
+        LOAD    TMP, 8(sp)
+        LOAD    TRAP_PTR, 0(sp)
+        addi    sp, sp, 16
+        jr      TMP
+2:      /* Preserve exception bucket in callee-save register s2 */
+        mv      s2, a0
+        LOAD    a1, Caml_state(last_return_address)
+        LOAD    a2, Caml_state(bottom_of_stack)
+        mv      a3, TRAP_PTR
+        call    PLT(caml_stash_backtrace)
+        mv      a0, s2
+        j       1b
+        .size   caml_raise_exception, .-caml_raise_exception
+
+/* Start the OCaml program */
+
+FUNCTION(caml_start_program)
+        mv      ARG_DOMAIN_STATE_PTR, a0
+        la      ARG, caml_program
+        /* Code shared with caml_callback* */
+        /* Address of OCaml code to call is in ARG */
+        /* Arguments to the OCaml code are in a0 ... a7 */
+.Ljump_to_caml:
+        /* Set up stack frame and save callee-save registers */
+        addi    sp, sp, -0xd0
+        STORE   ra, 0xc0(sp)
+        STORE   s0, 0x0(sp)
+        STORE   s1, 0x8(sp)
+        STORE   s2, 0x10(sp)
+        STORE   s3, 0x18(sp)
+        STORE   s4, 0x20(sp)
+        STORE   s5, 0x28(sp)
+        STORE   s6, 0x30(sp)
+        STORE   s7, 0x38(sp)
+        STORE   s8, 0x40(sp)
+        STORE   s9, 0x48(sp)
+        STORE   s10, 0x50(sp)
+        STORE   s11, 0x58(sp)
+        fsd     fs0, 0x60(sp)
+        fsd     fs1, 0x68(sp)
+        fsd     fs2, 0x70(sp)
+        fsd     fs3, 0x78(sp)
+        fsd     fs4, 0x80(sp)
+        fsd     fs5, 0x88(sp)
+        fsd     fs6, 0x90(sp)
+        fsd     fs7, 0x98(sp)
+        fsd     fs8, 0xa0(sp)
+        fsd     fs9, 0xa8(sp)
+        fsd     fs10, 0xb0(sp)
+        fsd     fs11, 0xb8(sp)
+        addi    sp, sp, -32
+        /* Load domain state pointer from argument */
+        mv      DOMAIN_STATE_PTR, ARG_DOMAIN_STATE_PTR
+        /* Setup a callback link on the stack */
+        LOAD    TMP, Caml_state(bottom_of_stack)
+        STORE   TMP, 0(sp)
+        LOAD    TMP, Caml_state(last_return_address)
+        STORE   TMP, 8(sp)
+        LOAD    TMP, Caml_state(gc_regs)
+        STORE   TMP, 16(sp)
+        /* set up a trap frame */
+        addi    sp, sp, -16
+        LOAD    TMP, Caml_state(exception_pointer)
+        STORE   TMP, 0(sp)
+        lla     TMP, .Ltrap_handler
+        STORE   TMP, 8(sp)
+        mv      TRAP_PTR, sp
+        LOAD    ALLOC_PTR, Caml_state(young_ptr)
+        LOAD    ALLOC_LIMIT, Caml_state(young_limit)
+        STORE   x0, Caml_state(last_return_address)
+        jalr    ARG
+.Lcaml_retaddr:         /* pop trap frame, restoring caml_exception_pointer */
+        LOAD    TMP, 0(sp)
+        STORE   TMP, Caml_state(exception_pointer)
+        addi    sp, sp, 16
+.Lreturn_result:        /* pop callback link, restoring global variables */
+        LOAD    TMP, 0(sp)
+        STORE   TMP, Caml_state(bottom_of_stack)
+        LOAD    TMP, 8(sp)
+        STORE   TMP, Caml_state(last_return_address)
+        LOAD    TMP, 16(sp)
+        STORE   TMP, Caml_state(gc_regs)
+        addi    sp, sp, 32
+        /* Update allocation pointer */
+        STORE   ALLOC_PTR, Caml_state(young_ptr)
+        /* reload callee-save registers and return */
+        LOAD    ra, 0xc0(sp)
+        LOAD    s0, 0x0(sp)
+        LOAD    s1, 0x8(sp)
+        LOAD    s2, 0x10(sp)
+        LOAD    s3, 0x18(sp)
+        LOAD    s4, 0x20(sp)
+        LOAD    s5, 0x28(sp)
+        LOAD    s6, 0x30(sp)
+        LOAD    s7, 0x38(sp)
+        LOAD    s8, 0x40(sp)
+        LOAD    s9, 0x48(sp)
+        LOAD    s10, 0x50(sp)
+        LOAD    s11, 0x58(sp)
+        fld     fs0, 0x60(sp)
+        fld     fs1, 0x68(sp)
+        fld     fs2, 0x70(sp)
+        fld     fs3, 0x78(sp)
+        fld     fs4, 0x80(sp)
+        fld     fs5, 0x88(sp)
+        fld     fs6, 0x90(sp)
+        fld     fs7, 0x98(sp)
+        fld     fs8, 0xa0(sp)
+        fld     fs9, 0xa8(sp)
+        fld     fs10, 0xb0(sp)
+        fld     fs11, 0xb8(sp)
+        addi    sp, sp, 0xd0
+        ret
+        .type   .Lcaml_retaddr, @function
+        .size   .Lcaml_retaddr, .-.Lcaml_retaddr
+        .size   caml_start_program, .-caml_start_program
+
+        .align  2
+.Ltrap_handler:
+        STORE   TRAP_PTR, Caml_state(exception_pointer)
+        ori     a0, a0, 2
+        j       .Lreturn_result
+        .type   .Ltrap_handler, @function
+        .size   .Ltrap_handler, .-.Ltrap_handler
+
+/* Callback from C to OCaml */
+
+FUNCTION(caml_callback_asm)
+        /* Initial shuffling of arguments */
+        /* a0 = Caml_state, a1 = closure, (a2) = args */
+        mv      ARG_DOMAIN_STATE_PTR, a0
+        LOAD    a0, 0(a2)   /* a0 = first arg */
+                            /* a1 = closure environment */
+        LOAD    ARG, 0(a1)  /* code pointer */
+        j       .Ljump_to_caml
+        .size   caml_callback_asm, .-caml_callback_asm
+
+FUNCTION(caml_callback2_asm)
+        /* Initial shuffling of arguments */
+        /* a0 = Caml_state, a1 = closure, (a2) = args */
+        mv      ARG_DOMAIN_STATE_PTR, a0
+        mv      TMP, a1
+        LOAD    a0, 0(a2)
+        LOAD    a1, 8(a2)
+        mv      a2, TMP
+        la      ARG, caml_apply2
+        j       .Ljump_to_caml
+        .size   caml_callback2_asm, .-caml_callback2_asm
+
+FUNCTION(caml_callback3_asm)
+        /* Initial shuffling of arguments */
+        /* a0 = Caml_state, a1 = closure, (a2) = args */
+        mv      ARG_DOMAIN_STATE_PTR, a0
+        mv      a3, a1
+        LOAD    a0, 0(a2)
+        LOAD    a1, 8(a2)
+        LOAD    a2, 16(a2)
+        la      ARG, caml_apply3
+        j       .Ljump_to_caml
+        .size   caml_callback3_asm, .-caml_callback3_asm
+
+FUNCTION(caml_ml_array_bound_error)
+        /* Load address of [caml_array_bound_error] in ARG */
+        la      ARG, caml_array_bound_error
+        /* Call that function */
+        tail    caml_c_call
+        .size   caml_ml_array_bound_error, .-caml_ml_array_bound_error
+
+        .globl  caml_system__code_end
+caml_system__code_end:
+
+/* GC roots for callback */
+
+        .section .data
+        .align  3
+        .globl  caml_system__frametable
+        .type   caml_system__frametable, @object
+caml_system__frametable:
+        .quad   1               /* one descriptor */
+        .quad   .Lcaml_retaddr  /* return address into callback */
+        .short  -1              /* negative frame size => use callback link */
+        .short  0               /* no roots */
+        .align  3
+        .size   caml_system__frametable, .-caml_system__frametable
diff --git a/runtime/roots_byt.c b/runtime/roots_byt.c
new file mode 100644
index 00000000..bd549f14
--- /dev/null
+++ b/runtime/roots_byt.c
@@ -0,0 +1,131 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, 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
+
+/* To walk the memory roots for garbage collection */
+
+#include "caml/finalise.h"
+#include "caml/globroots.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/stacks.h"
+#include "caml/memprof.h"
+#include "caml/eventlog.h"
+
+CAMLexport void (*caml_scan_roots_hook) (scanning_action f) = NULL;
+
+/* FIXME should rename to [caml_oldify_minor_roots] and synchronise with
+   roots_nat.c */
+/* Call [caml_oldify_one] on (at least) all the roots that point to the minor
+   heap. */
+void caml_oldify_local_roots (void)
+{
+  register value * sp;
+  struct caml__roots_block *lr;
+  intnat i, j;
+
+  /* The stack */
+  for (sp = Caml_state->extern_sp; sp < Caml_state->stack_high; sp++) {
+    caml_oldify_one (*sp, sp);
+  }
+  /* Local C roots */  /* FIXME do the old-frame trick ? */
+  for (lr = Caml_state->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]);
+        caml_oldify_one (*sp, sp);
+      }
+    }
+  }
+  /* Global C roots */
+  caml_scan_global_young_roots(&caml_oldify_one);
+  /* Finalised values */
+  caml_final_oldify_young_roots ();
+  /* Memprof */
+  caml_memprof_oldify_young_roots ();
+  /* Hook */
+  if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(&caml_oldify_one);
+}
+
+/* Call [caml_darken] on all roots */
+
+void caml_darken_all_roots_start (void)
+{
+  caml_do_roots (caml_darken, 1);
+}
+
+uintnat caml_incremental_roots_count = 1;
+
+intnat caml_darken_all_roots_slice (intnat work)
+{
+  return work;
+}
+
+/* Note, in byte-code there is only one global root, so [do_globals] is
+   ignored and [caml_darken_all_roots_slice] does nothing. */
+void caml_do_roots (scanning_action f, int do_globals)
+{
+  /* Global variables */
+  CAML_EV_BEGIN(EV_MAJOR_ROOTS_GLOBAL);
+  f(caml_global_data, &caml_global_data);
+  CAML_EV_END(EV_MAJOR_ROOTS_GLOBAL);
+  /* The stack and the local C roots */
+  CAML_EV_BEGIN(EV_MAJOR_ROOTS_LOCAL);
+  caml_do_local_roots(f, Caml_state->extern_sp, Caml_state->stack_high,
+                      Caml_state->local_roots);
+  CAML_EV_END(EV_MAJOR_ROOTS_LOCAL);
+  /* Global C roots */
+  CAML_EV_BEGIN(EV_MAJOR_ROOTS_C);
+  caml_scan_global_roots(f);
+  CAML_EV_END(EV_MAJOR_ROOTS_C);
+  /* Finalised values */
+  CAML_EV_BEGIN(EV_MAJOR_ROOTS_FINALISED);
+  caml_final_do_roots (f);
+  CAML_EV_END(EV_MAJOR_ROOTS_FINALISED);
+  /* Memprof */
+  CAML_EV_BEGIN(EV_MAJOR_ROOTS_MEMPROF);
+  caml_memprof_do_roots (f);
+  CAML_EV_END(EV_MAJOR_ROOTS_MEMPROF);
+  /* Hook */
+  CAML_EV_BEGIN(EV_MAJOR_ROOTS_HOOK);
+  if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f);
+  CAML_EV_END(EV_MAJOR_ROOTS_HOOK);
+}
+
+CAMLexport void caml_do_local_roots (scanning_action f, value *stack_low,
+                                     value *stack_high,
+                                     struct caml__roots_block *local_roots)
+{
+  register value * sp;
+  struct caml__roots_block *lr;
+  int i, j;
+
+  for (sp = stack_low; sp < stack_high; sp++) {
+    f (*sp, 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]);
+        f (*sp, sp);
+      }
+    }
+  }
+}
diff --git a/runtime/roots_nat.c b/runtime/roots_nat.c
new file mode 100644
index 00000000..ec66e2db
--- /dev/null
+++ b/runtime/roots_nat.c
@@ -0,0 +1,524 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* To walk the memory roots for garbage collection */
+
+#include "caml/finalise.h"
+#include "caml/globroots.h"
+#include "caml/memory.h"
+#include "caml/major_gc.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/stack.h"
+#include "caml/roots.h"
+#include "caml/memprof.h"
+#include "caml/eventlog.h"
+#include <string.h>
+#include <stdio.h>
+
+/* Roots registered from C functions */
+
+void (*caml_scan_roots_hook) (scanning_action) = NULL;
+
+/* The hashtable of frame descriptors */
+frame_descr ** caml_frame_descriptors = NULL;
+uintnat caml_frame_descriptors_mask = 0;
+
+/* Linked-list */
+
+typedef struct link {
+  void *data;
+  struct link *next;
+} link;
+
+static link *cons(void *data, link *tl) {
+  link *lnk = caml_stat_alloc(sizeof(link));
+  lnk->data = data;
+  lnk->next = tl;
+  return lnk;
+}
+
+#define iter_list(list,lnk) \
+  for (lnk = list; lnk != NULL; lnk = lnk->next)
+
+/* Linked-list of frametables */
+
+static link *frametables = NULL;
+static intnat num_descr = 0;
+
+static intnat count_descriptors(link *list) {
+  intnat num_descr = 0;
+  link *lnk;
+  iter_list(list,lnk) {
+    num_descr += *((intnat*) lnk->data);
+  }
+  return num_descr;
+}
+
+static link* frametables_list_tail(link *list) {
+  link *lnk, *tail = NULL;
+  iter_list(list,lnk) {
+    tail = lnk;
+  }
+  return tail;
+}
+
+static frame_descr * next_frame_descr(frame_descr * d) {
+  unsigned char num_allocs = 0, *p;
+  CAMLassert(d->retaddr >= 4096);
+  /* Skip to end of live_ofs */
+  p = (unsigned char*)&d->live_ofs[d->num_live];
+  /* Skip alloc_lengths if present */
+  if (d->frame_size & 2) {
+    num_allocs = *p;
+    p += num_allocs + 1;
+  }
+  /* Skip debug info if present */
+  if (d->frame_size & 1) {
+    /* Align to 32 bits */
+    p = Align_to(p, uint32_t);
+    p += sizeof(uint32_t) * (d->frame_size & 2 ? num_allocs : 1);
+  }
+  /* Align to word size */
+  p = Align_to(p, void*);
+  return ((frame_descr*) p);
+}
+
+static void fill_hashtable(link *frametables) {
+  intnat len, j;
+  intnat * tbl;
+  frame_descr * d;
+  uintnat h;
+  link *lnk = NULL;
+
+  iter_list(frametables,lnk) {
+    tbl = (intnat*) lnk->data;
+    len = *tbl;
+    d = (frame_descr *)(tbl + 1);
+    for (j = 0; j < len; j++) {
+      h = Hash_retaddr(d->retaddr);
+      while (caml_frame_descriptors[h] != NULL) {
+        h = (h+1) & caml_frame_descriptors_mask;
+      }
+      caml_frame_descriptors[h] = d;
+      d = next_frame_descr(d);
+    }
+  }
+}
+
+static void init_frame_descriptors(link *new_frametables)
+{
+  intnat tblsize, increase, i;
+  link *tail = NULL;
+
+  CAMLassert(new_frametables);
+
+  tail = frametables_list_tail(new_frametables);
+  increase = count_descriptors(new_frametables);
+  tblsize = caml_frame_descriptors_mask + 1;
+
+  /* Reallocate the caml_frame_descriptor table if it is too small */
+  if(tblsize < (num_descr + increase) * 2) {
+
+    /* Merge both lists */
+    tail->next = frametables;
+    frametables = NULL;
+
+    /* [num_descr] can be less than [num_descr + increase] if frame
+       tables where unregistered */
+    num_descr = count_descriptors(new_frametables);
+
+    tblsize = 4;
+    while (tblsize < 2 * num_descr) tblsize *= 2;
+
+    caml_frame_descriptors_mask = tblsize - 1;
+    if(caml_frame_descriptors) caml_stat_free(caml_frame_descriptors);
+    caml_frame_descriptors =
+      (frame_descr **) caml_stat_alloc(tblsize * sizeof(frame_descr *));
+    for (i = 0; i < tblsize; i++) caml_frame_descriptors[i] = NULL;
+
+    fill_hashtable(new_frametables);
+  } else {
+    num_descr += increase;
+    fill_hashtable(new_frametables);
+    tail->next = frametables;
+  }
+
+  frametables = new_frametables;
+}
+
+void caml_init_frame_descriptors(void) {
+  intnat i;
+  link *new_frametables = NULL;
+  for (i = 0; caml_frametable[i] != 0; i++)
+    new_frametables = cons(caml_frametable[i],new_frametables);
+  init_frame_descriptors(new_frametables);
+}
+
+void caml_register_frametable(intnat *table) {
+  link *new_frametables = cons(table,NULL);
+  init_frame_descriptors(new_frametables);
+}
+
+static void remove_entry(frame_descr * d) {
+  uintnat i;
+  uintnat r;
+  uintnat j;
+
+  i = Hash_retaddr(d->retaddr);
+  while (caml_frame_descriptors[i] != d) {
+    i = (i+1) & caml_frame_descriptors_mask;
+  }
+
+ r1:
+  j = i;
+  caml_frame_descriptors[i] = NULL;
+ r2:
+  i = (i+1) & caml_frame_descriptors_mask;
+  // r3
+  if(caml_frame_descriptors[i] == NULL) return;
+  r = Hash_retaddr(caml_frame_descriptors[i]->retaddr);
+  /* If r is between i and j (cyclically), i.e. if
+     caml_frame_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
+  caml_frame_descriptors[j] = caml_frame_descriptors[i];
+  goto r1;
+}
+
+void caml_unregister_frametable(intnat *table) {
+  intnat len, j;
+  link *lnk;
+  link *previous = frametables;
+  frame_descr * d;
+
+  len = *table;
+  d = (frame_descr *)(table + 1);
+  for (j = 0; j < len; j++) {
+    remove_entry(d);
+    d = next_frame_descr(d);
+  }
+
+  iter_list(frametables,lnk) {
+    if(lnk->data == table) {
+      previous->next = lnk->next;
+      caml_stat_free(lnk);
+      break;
+    }
+    previous = lnk;
+  }
+}
+
+/* Communication with [caml_start_program] and [caml_call_gc]. */
+
+intnat caml_globals_inited = 0;
+static intnat caml_globals_scanned = 0;
+static link * caml_dyn_globals = NULL;
+
+void caml_register_dyn_global(void *v) {
+  caml_dyn_globals = cons((void*) v,caml_dyn_globals);
+}
+
+/* Call [caml_oldify_one] on (at least) all the roots that point to the minor
+   heap. */
+void caml_oldify_local_roots (void)
+{
+  char * sp;
+  uintnat retaddr;
+  value * regs;
+  frame_descr * d;
+  uintnat h;
+  intnat i, j;
+  int n, ofs;
+  unsigned short * p;
+  value * glob;
+  value * root;
+  struct caml__roots_block *lr;
+  link *lnk;
+
+  /* The global roots */
+  for (i = caml_globals_scanned;
+       i <= caml_globals_inited && caml_globals[i] != 0;
+       i++) {
+    for(glob = caml_globals[i]; *glob != 0; glob++) {
+      for (j = 0; j < Wosize_val(*glob); j++){
+        Oldify (&Field (*glob, j));
+      }
+    }
+  }
+  caml_globals_scanned = caml_globals_inited;
+
+  /* Dynamic global roots */
+  iter_list(caml_dyn_globals, lnk) {
+    for(glob = (value *) lnk->data; *glob != 0; glob++) {
+      for (j = 0; j < Wosize_val(*glob); j++){
+        Oldify (&Field (*glob, j));
+      }
+    }
+  }
+
+  /* The stack and local roots */
+  sp = Caml_state->bottom_of_stack;
+  retaddr = Caml_state->last_return_address;
+  regs = Caml_state->gc_regs;
+  if (sp != NULL) {
+    while (1) {
+      /* Find the descriptor corresponding to the return address */
+      h = Hash_retaddr(retaddr);
+      while(1) {
+        d = caml_frame_descriptors[h];
+        if (d->retaddr == retaddr) break;
+        h = (h+1) & caml_frame_descriptors_mask;
+      }
+      if (d->frame_size != 0xFFFF) {
+        /* Scan the roots in this frame */
+        for (p = d->live_ofs, n = d->num_live; n > 0; n--, p++) {
+          ofs = *p;
+          if (ofs & 1) {
+            root = regs + (ofs >> 1);
+          } else {
+            root = (value *)(sp + ofs);
+          }
+          Oldify (root);
+        }
+        /* Move to next frame */
+        sp += (d->frame_size & 0xFFFC);
+        retaddr = Saved_return_address(sp);
+#ifdef Already_scanned
+        /* Stop here if the frame has been scanned during earlier GCs  */
+        if (Already_scanned(sp, retaddr)) break;
+        /* Mark frame as already scanned */
+        Mark_scanned(sp, retaddr);
+#endif
+      } else {
+        /* This marks the top of a stack chunk for an ML callback.
+           Skip C portion of stack and continue with next ML stack chunk. */
+        struct caml_context * next_context = Callback_link(sp);
+        sp = next_context->bottom_of_stack;
+        retaddr = next_context->last_retaddr;
+        regs = next_context->gc_regs;
+        /* A null sp means no more ML stack chunks; stop here. */
+        if (sp == NULL) break;
+      }
+    }
+  }
+  /* Local C roots */
+  for (lr = Caml_state->local_roots; lr != NULL; lr = lr->next) {
+    for (i = 0; i < lr->ntables; i++){
+      for (j = 0; j < lr->nitems; j++){
+        root = &(lr->tables[i][j]);
+        Oldify (root);
+      }
+    }
+  }
+  /* Global C roots */
+  caml_scan_global_young_roots(&caml_oldify_one);
+  /* Finalised values */
+  caml_final_oldify_young_roots ();
+  /* Memprof */
+  caml_memprof_oldify_young_roots ();
+  /* Hook */
+  if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(&caml_oldify_one);
+}
+
+uintnat caml_incremental_roots_count = 0;
+
+/* Call [caml_darken] on all roots, incrementally:
+   [caml_darken_all_roots_start] does the non-incremental part and
+   sets things up for [caml_darken_all_roots_slice].
+*/
+void caml_darken_all_roots_start (void)
+{
+  caml_do_roots (caml_darken, 0);
+}
+
+/* Call [caml_darken] on at most [work] global roots. Return the
+   amount of work not done, if any. If this is strictly positive,
+   the darkening is done.
+ */
+intnat caml_darken_all_roots_slice (intnat work)
+{
+  static int i, j;
+  static value *glob;
+  static int do_resume = 0;
+  static mlsize_t roots_count = 0;
+  intnat remaining_work = work;
+  CAML_EV_BEGIN(EV_MAJOR_MARK_GLOBAL_ROOTS_SLICE);
+
+  /* If the loop was started in a previous call, resume it. */
+  if (do_resume) goto resume;
+
+  /* This is the same loop as in [caml_do_roots], but we make it
+     suspend itself when [work] reaches 0. */
+  for (i = 0; caml_globals[i] != 0; i++) {
+    for(glob = caml_globals[i]; *glob != 0; glob++) {
+      for (j = 0; j < Wosize_val(*glob); j++){
+        caml_darken (Field (*glob, j), &Field (*glob, j));
+        -- remaining_work;
+        if (remaining_work == 0){
+          roots_count += work;
+          do_resume = 1;
+          goto suspend;
+        }
+      resume: ;
+      }
+    }
+  }
+
+  /* The loop finished normally, so all roots are now darkened. */
+  caml_incremental_roots_count = roots_count + work - remaining_work;
+  /* Prepare for the next run. */
+  do_resume = 0;
+  roots_count = 0;
+
+ suspend:
+  /* Do this in both cases. */
+  CAML_EV_END(EV_MAJOR_MARK_GLOBAL_ROOTS_SLICE);
+  return remaining_work;
+}
+
+void caml_do_roots (scanning_action f, int do_globals)
+{
+  int i, j;
+  value * glob;
+  link *lnk;
+
+  CAML_EV_BEGIN(EV_MAJOR_ROOTS_DYNAMIC_GLOBAL);
+  if (do_globals){
+    /* 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++)
+          f (Field (*glob, j), &Field (*glob, j));
+      }
+    }
+  }
+  /* Dynamic global roots */
+  iter_list(caml_dyn_globals, lnk) {
+    for(glob = (value *) lnk->data; *glob != 0; glob++) {
+      for (j = 0; j < Wosize_val(*glob); j++){
+        f (Field (*glob, j), &Field (*glob, j));
+      }
+    }
+  }
+  CAML_EV_END(EV_MAJOR_ROOTS_DYNAMIC_GLOBAL);
+  /* The stack and local roots */
+  CAML_EV_BEGIN(EV_MAJOR_ROOTS_LOCAL);
+  caml_do_local_roots(f, Caml_state->bottom_of_stack,
+                      Caml_state->last_return_address, Caml_state->gc_regs,
+                      Caml_state->local_roots);
+  CAML_EV_END(EV_MAJOR_ROOTS_LOCAL);
+  /* Global C roots */
+  CAML_EV_BEGIN(EV_MAJOR_ROOTS_C);
+  caml_scan_global_roots(f);
+  CAML_EV_END(EV_MAJOR_ROOTS_C);
+  /* Finalised values */
+  CAML_EV_BEGIN(EV_MAJOR_ROOTS_FINALISED);
+  caml_final_do_roots (f);
+  CAML_EV_END(EV_MAJOR_ROOTS_FINALISED);
+  /* Memprof */
+  CAML_EV_BEGIN(EV_MAJOR_ROOTS_MEMPROF);
+  caml_memprof_do_roots (f);
+  CAML_EV_END(EV_MAJOR_ROOTS_MEMPROF);
+  /* Hook */
+  CAML_EV_BEGIN(EV_MAJOR_ROOTS_HOOK);
+  if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f);
+  CAML_EV_END(EV_MAJOR_ROOTS_HOOK);
+}
+
+void caml_do_local_roots(scanning_action f, char * bottom_of_stack,
+                         uintnat last_retaddr, value * gc_regs,
+                         struct caml__roots_block * local_roots)
+{
+  char * sp;
+  uintnat retaddr;
+  value * regs;
+  frame_descr * d;
+  uintnat h;
+  int i, j, n, ofs;
+  unsigned short * p;
+  value * root;
+  struct caml__roots_block *lr;
+
+  sp = bottom_of_stack;
+  retaddr = last_retaddr;
+  regs = gc_regs;
+  if (sp != NULL) {
+    while (1) {
+      /* Find the descriptor corresponding to the return address */
+      h = Hash_retaddr(retaddr);
+      while(1) {
+        d = caml_frame_descriptors[h];
+        if (d->retaddr == retaddr) break;
+        h = (h+1) & caml_frame_descriptors_mask;
+      }
+      if (d->frame_size != 0xFFFF) {
+        /* Scan the roots in this frame */
+        for (p = d->live_ofs, n = d->num_live; n > 0; n--, p++) {
+          ofs = *p;
+          if (ofs & 1) {
+            root = regs + (ofs >> 1);
+          } else {
+            root = (value *)(sp + ofs);
+          }
+          f (*root, root);
+        }
+        /* Move to next frame */
+        sp += (d->frame_size & 0xFFFC);
+        retaddr = Saved_return_address(sp);
+#ifdef Mask_already_scanned
+        retaddr = Mask_already_scanned(retaddr);
+#endif
+      } else {
+        /* This marks the top of a stack chunk for an ML callback.
+           Skip C portion of stack and continue with next ML stack chunk. */
+        struct caml_context * next_context = Callback_link(sp);
+        sp = next_context->bottom_of_stack;
+        retaddr = next_context->last_retaddr;
+        regs = next_context->gc_regs;
+        /* A null sp means no more ML stack chunks; stop here. */
+        if (sp == NULL) break;
+      }
+    }
+  }
+  /* Local C roots */
+  for (lr = local_roots; lr != NULL; lr = lr->next) {
+    for (i = 0; i < lr->ntables; i++){
+      for (j = 0; j < lr->nitems; j++){
+        root = &(lr->tables[i][j]);
+        f (*root, root);
+      }
+    }
+  }
+}
+
+uintnat (*caml_stack_usage_hook)(void) = NULL;
+
+uintnat caml_stack_usage (void)
+{
+  uintnat sz;
+  sz = (value *) Caml_state->top_of_stack -
+       (value *) Caml_state->bottom_of_stack;
+  if (caml_stack_usage_hook != NULL)
+    sz += (*caml_stack_usage_hook)();
+  return sz;
+}
diff --git a/runtime/s390x.S b/runtime/s390x.S
new file mode 100644
index 00000000..aab63e9b
--- /dev/null
+++ b/runtime/s390x.S
@@ -0,0 +1,355 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*            Xavier Leroy, projet Gallium, INRIA Rocquencourt            */
+/*                          Bill O'Farrell, IBM                           */
+/*                                                                        */
+/*   Copyright 2015 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*   Copyright 2015 IBM (Bill O'Farrell with help from Tristan Amini).    */
+/*                                                                        */
+/*   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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#if defined(__PIC__)
+
+#define Addrglobal(reg,glob) \
+        lgrl    reg, glob@GOTENT
+#else
+
+#define Addrglobal(reg,glob) \
+        larl    reg, glob
+#endif
+
+        .set    domain_curr_field, 0
+#define DOMAIN_STATE(c_type, name) \
+        .equ    domain_field_caml_##name, domain_curr_field ; \
+        .set    domain_curr_field, domain_curr_field + 1
+#include "../runtime/caml/domain_state.tbl"
+#undef DOMAIN_STATE
+
+#define Caml_state(var) 8*domain_field_caml_##var(%r10)
+
+        .section ".text"
+
+/* Invoke the garbage collector. */
+
+        .globl  caml_system__code_begin
+caml_system__code_begin:
+
+        .globl  caml_call_gc
+        .type   caml_call_gc, @function
+caml_call_gc:
+    /* Set up stack frame */
+#define FRAMESIZE (16*8 + 16*8)
+        lay     %r15, -FRAMESIZE(%r15)
+    /* Record return address into OCaml code */
+        stg     %r14, Caml_state(last_return_address)
+    /* Record lowest stack address */
+        lay     %r0, FRAMESIZE(%r15)
+        stg     %r0, Caml_state(bottom_of_stack)
+    /* Record pointer to register array */
+        lay     %r0, (8*16)(%r15)
+        stg     %r0, Caml_state(gc_regs)
+    /* Save current allocation pointer for debugging purposes */
+        stg     %r11, Caml_state(young_ptr)
+    /* Save exception pointer (if e.g. a sighandler raises) */
+        stg     %r13, Caml_state(exception_pointer)
+    /* Save all registers used by the code generator */
+        stmg    %r2,%r9, (8*16)(%r15)
+        stg     %r12, (8*16 + 8*8)(%r15)
+        std     %f0, 0(%r15)
+        std     %f1, 8(%r15)
+        std     %f2, 16(%r15)
+        std     %f3, 24(%r15)
+        std     %f4, 32(%r15)
+        std     %f5, 40(%r15)
+        std     %f6, 48(%r15)
+        std     %f7, 56(%r15)
+        std     %f8, 64(%r15)
+        std     %f9, 72(%r15)
+        std     %f10, 80(%r15)
+        std     %f11, 88(%r15)
+        std     %f12, 96(%r15)
+        std     %f13, 108(%r15)
+        std     %f14, 112(%r15)
+        std     %f15, 120(%r15)
+    /* Call the GC */
+        lay     %r15, -160(%r15)
+        stg     %r15, 0(%r15)
+        brasl   %r14, caml_garbage_collection@PLT
+        lay     %r15, 160(%r15)
+    /* Reload new allocation pointer */
+        lg      %r11, Caml_state(young_ptr)
+    /* Restore all regs used by the code generator */
+        lmg     %r2,%r9, (8*16)(%r15)
+        lg      %r12, (8*16 + 8*8)(%r15)
+        ld      %f0, 0(%r15)
+        ld      %f1, 8(%r15)
+        ld      %f2, 16(%r15)
+        ld      %f3, 24(%r15)
+        ld      %f4, 32(%r15)
+        ld      %f5, 40(%r15)
+        ld      %f6, 48(%r15)
+        ld      %f7, 56(%r15)
+        ld      %f8, 64(%r15)
+        ld      %f9, 72(%r15)
+        ld      %f10, 80(%r15)
+        ld      %f11, 88(%r15)
+        ld      %f12, 96(%r15)
+        ld      %f13, 108(%r15)
+        ld      %f14, 112(%r15)
+        ld      %f15, 120(%r15)
+    /* Return to caller */
+        lg      %r1, Caml_state(last_return_address)
+    /* Deallocate stack frame */
+        lay     %r15, FRAMESIZE(%r15)
+    /* Return */
+        br      %r1
+
+/* Call a C function from OCaml */
+
+        .globl  caml_c_call
+        .type   caml_c_call, @function
+caml_c_call:
+        stg     %r15, Caml_state(bottom_of_stack)
+.L101:
+    /* Save return address */
+        ldgr    %f15, %r14
+    /* Get ready to call C function (address in r7) */
+    /* Record lowest stack address and return address */
+        stg     %r14, Caml_state(last_return_address)
+    /* Make the exception handler and alloc ptr available to the C code */
+        stg     %r11, Caml_state(young_ptr)
+        stg     %r13, Caml_state(exception_pointer)
+    /* Call the function */
+        basr %r14, %r7
+    /* restore return address */
+        lgdr    %r14,%f15
+    /* Reload allocation pointer */
+        lg      %r11, Caml_state(young_ptr)
+    /* Return to caller */
+        br %r14
+
+/* Raise an exception from OCaml */
+        .globl  caml_raise_exn
+        .type   caml_raise_exn, @function
+caml_raise_exn:
+        lg      %r0, Caml_state(backtrace_active)
+        cgfi    %r0, 0
+        jne     .L110
+.L111:
+    /* Pop trap frame */
+        lg      %r1, 0(%r13)
+        lgr     %r15, %r13
+        lg      %r13, 8(13)
+        agfi    %r15, 16
+    /* Branch to handler */
+        br      %r1
+.L110:
+        ldgr    %f15, %r2       /* preserve exn bucket in callee-save reg */
+                                /* arg1: exception bucket, already in r2 */
+        lgr     %r3, %r14       /* arg2: PC of raise */
+        lgr     %r4, %r15       /* arg3: SP of raise */
+        lgr     %r5, %r13       /* arg4: SP of handler */
+        agfi    %r15, -160      /* reserve stack space for C call */
+        brasl   %r14, caml_stash_backtrace@PLT
+        agfi    %r15, 160
+        lgdr    %r2,%f15        /* restore exn bucket */
+        j       .L111           /* raise the exn */
+
+/* Raise an exception from C */
+
+        .globl  caml_raise_exception
+        .type   caml_raise_exception, @function
+caml_raise_exception:
+        lgr     %r10, %r2       /* Load domain state pointer */
+        lgr     %r2, %r3        /* Move exception bucket to arg1 register */
+        lg      %r0, Caml_state(backtrace_active)
+        cgfi    %r0, 0
+        jne    .L112
+.L113:
+    /* Reload OCaml global registers */
+        lg      %r15, Caml_state(exception_pointer)
+        lg      %r11, Caml_state(young_ptr)
+    /* Pop trap frame */
+        lg      %r1, 0(%r15)
+        lg      %r13, 8(%r15)
+        agfi    %r15, 16
+    /* Branch to handler */
+        br      %r1;
+.L112:
+        ldgr    %f15,%r2        /* preserve exn bucket in callee-save reg */
+                                /* arg1: exception bucket, already in r2 */
+        lg      %r3, Caml_state(last_return_address) /* arg2: PC of raise */
+        lg      %r4, Caml_state(bottom_of_stack)     /* arg3: SP of raise */
+        lg      %r5, Caml_state(exception_pointer)   /* arg4: SP of handler */
+    /* reserve stack space for C call */
+        lay     %r15, -160(%r15)
+        brasl   %r14, caml_stash_backtrace@PLT
+        lay     %r15, 160(%r15)
+        lgdr    %r2,%f15        /* restore exn bucket */
+        j       .L113           /* raise the exn */
+
+/* Start the OCaml program */
+
+        .globl  caml_start_program
+        .type   caml_start_program, @function
+caml_start_program:
+    /* Move Caml_state passed as first argument to r1 */
+        lgr     %r1, %r2
+        Addrglobal(%r0, caml_program)
+
+/* Code shared between caml_start_program and caml_callback */
+.L102:
+    /* Allocate stack frame */
+        lay     %r15, -144(%r15)
+    /* Save all callee-save registers + return address */
+    /* GPR 6..14 at sp + 0 ... sp + 64
+       FPR 10..15 at sp + 72 ... sp + 128 */
+        stmg    %r6,%r14, 0(%r15)
+        std     %f8, 72(%r15)
+        std     %f9, 80(%r15)
+        std     %f10, 88(%r15)
+        std     %f11, 96(%r15)
+        std     %f12, 104(%r15)
+        std     %f13, 112(%r15)
+        std     %f14, 120(%r15)
+        std     %f15, 128(%r15)
+
+    /* Load Caml_state to r10 register */
+        lgr     %r10, %r1
+    /* Set up a callback link */
+        lay     %r15, -32(%r15)
+        lg      %r1, Caml_state(bottom_of_stack)
+        stg     %r1, 0(%r15)
+        lg      %r1, Caml_state(last_return_address)
+        stg     %r1, 8(%r15)
+        lg      %r1, Caml_state(gc_regs)
+        stg     %r1, 16(%r15)
+    /* Build an exception handler to catch exceptions escaping out of OCaml */
+        brasl   %r14, .L103
+        j       .L104
+.L103:
+        lay     %r15, -16(%r15)
+        stg     %r14, 0(%r15)
+        lg      %r1, Caml_state(exception_pointer)
+        stg     %r1, 8(%r15)
+        lgr     %r13, %r15
+    /* Reload allocation pointer */
+        lg      %r11, Caml_state(young_ptr)
+    /* Call the OCaml code */
+        lgr     %r1,%r0
+        basr    %r14, %r1
+.L105:
+    /* Pop the trap frame, restoring caml_exception_pointer */
+        lg      %r0, 8(%r15)
+        stg     %r0, Caml_state(exception_pointer)
+        la      %r15, 16(%r15)
+    /* Pop the callback link, restoring the global variables */
+.L106:
+        lg      %r5, 0(%r15)
+        lg      %r6, 8(%r15)
+        lg      %r0, 16(%r15)
+        stg     %r5, Caml_state(bottom_of_stack)
+        stg     %r6, Caml_state(last_return_address)
+        stg     %r0, Caml_state(gc_regs)
+        la      %r15, 32(%r15)
+
+    /* Update allocation pointer */
+        stg     %r11, Caml_state(young_ptr)
+
+    /* Restore registers */
+        lmg     %r6,%r14, 0(%r15)
+        ld      %f8, 72(%r15)
+        ld      %f9, 80(%r15)
+        ld      %f10, 88(%r15)
+        ld      %f11, 96(%r15)
+        ld      %f12, 104(%r15)
+        ld      %f13, 112(%r15)
+        ld      %f14, 120(%r15)
+        ld      %f15, 128(%r15)
+
+    /* Return */
+        lay     %r15, 144(%r15)
+        br      %r14
+
+    /* The trap handler: */
+.L104:
+    /* Update caml_exception_pointer */
+        stg     %r13, Caml_state(exception_pointer)
+    /* Encode exception bucket as an exception result and return it */
+        oill     %r2,  2
+        j       .L106
+
+/* Callback from C to OCaml */
+
+        .globl  caml_callback_asm
+        .type   caml_callback_asm, @function
+caml_callback_asm:
+    /* Initial shuffling of arguments */
+    /* (r2 = Caml_state, r3 = closure, 0(r4) = arg1) */
+        lgr     %r1, %r2            /* r1 = Caml_state */
+        lg      %r2, 0(%r4)         /* r2 = Argument */
+                                    /* r3 = Closure */
+        lg      %r0, 0(%r3)         /* r0 = Code pointer */
+        j       .L102
+
+        .globl  caml_callback2_asm
+        .type   caml_callback2_asm, @function
+caml_callback2_asm:
+    /* Initial shuffling of arguments */
+    /* (r2 = Caml_state, r3 = closure, 0(r4) = arg1, 8(r4) = arg2) */
+        lgr      %r1, %r2            /* r1 = Caml_state */
+        lgr      %r0, %r3
+        lg       %r2, 0(%r4)         /* r2 = First argument */
+        lg       %r3, 8(%r4)         /* r3 = Second argument */
+        lgr      %r4, %r0            /* r4 = Closure */
+        Addrglobal(%r0, caml_apply2) /* r0 = Code pointer */
+        j       .L102
+
+        .globl  caml_callback3_asm
+        .type   caml_callback3_asm, @function
+caml_callback3_asm:
+    /* Initial shuffling of arguments */
+    /* (r2 = Caml_state, r3 = closure, 0(r4) = arg1, 8(r4) = arg2,
+        16(r4) = arg3) */
+        lgr      %r1, %r2            /* r1 = Caml_state */
+        lgr      %r5, %r3            /* r5 = Closure */
+        lg       %r2, 0(%r4)         /* r2 = First argument */
+        lg       %r3, 8(%r4)         /* r3 = Second argument */
+        lg       %r4, 16(%r4)        /* r4 = Third argument */
+        Addrglobal(%r0, caml_apply3) /* r0 = Code pointer */
+        j        .L102
+
+        .globl  caml_ml_array_bound_error
+        .type   caml_ml_array_bound_error, @function
+caml_ml_array_bound_error:
+        /* Save return address before decrementing SP, otherwise
+           the frame descriptor for the call site is not correct */
+        stg     %r15, Caml_state(bottom_of_stack)
+        lay     %r15, -160(%r15)    /* Reserve stack space for C call */
+        Addrglobal(%r7, caml_array_bound_error)
+        j       .L101
+        .globl  caml_system__code_end
+caml_system__code_end:
+
+/* Frame table */
+
+        .section ".data"
+        .align 8
+        .globl  caml_system__frametable
+        .type   caml_system__frametable, @object
+caml_system__frametable:
+        .quad   1               /* one descriptor */
+        .quad   .L105           /* return address into callback */
+        .short  -1              /* negative size count => use callback link */
+        .short  0               /* no roots here */
+        .align  8
+
+/* Mark stack as non-executable */
+        .section .note.GNU-stack,"",%progbits
diff --git a/runtime/signals.c b/runtime/signals.c
new file mode 100644
index 00000000..57bb3fc7
--- /dev/null
+++ b/runtime/signals.c
@@ -0,0 +1,528 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, 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
+
+/* Signal handling, code common to the bytecode and native systems */
+
+#include <signal.h>
+#include <errno.h>
+#include "caml/alloc.h"
+#include "caml/callback.h"
+#include "caml/config.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/signals.h"
+#include "caml/signals_machdep.h"
+#include "caml/sys.h"
+#include "caml/memprof.h"
+#include "caml/finalise.h"
+
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+#include "caml/spacetime.h"
+#endif
+
+#ifndef NSIG
+#define NSIG 64
+#endif
+
+CAMLexport int volatile caml_something_to_do = 0;
+
+/* The set of pending signals (received but not yet processed) */
+
+static intnat volatile signals_are_pending = 0;
+CAMLexport intnat volatile caml_pending_signals[NSIG];
+
+#ifdef POSIX_SIGNALS
+/* This wrapper makes [sigprocmask] compatible with
+   [pthread_sigmask]. Indeed, the latter returns the error code while
+   the former sets [errno].
+ */
+static int sigprocmask_wrapper(int how, const sigset_t *set, sigset_t *oldset) {
+  if(sigprocmask(how, set, oldset) != 0) return errno;
+  else return 0;
+}
+
+CAMLexport int (*caml_sigmask_hook)(int, const sigset_t *, sigset_t *)
+  = sigprocmask_wrapper;
+#endif
+
+/* Execute all pending signals */
+
+value caml_process_pending_signals_exn(void)
+{
+  int i;
+  int really_pending;
+#ifdef POSIX_SIGNALS
+  sigset_t set;
+#endif
+
+  if(!signals_are_pending)
+    return Val_unit;
+  signals_are_pending = 0;
+
+  /* Check that there is indeed a pending signal before issuing the
+     syscall in [caml_sigmask_hook]. */
+  really_pending = 0;
+  for (i = 0; i < NSIG; i++)
+    if (caml_pending_signals[i]) {
+      really_pending = 1;
+      break;
+    }
+  if(!really_pending)
+    return Val_unit;
+
+#ifdef POSIX_SIGNALS
+  caml_sigmask_hook(/* dummy */ SIG_BLOCK, NULL, &set);
+#endif
+  for (i = 0; i < NSIG; i++) {
+    if (!caml_pending_signals[i])
+      continue;
+#ifdef POSIX_SIGNALS
+    if(sigismember(&set, i))
+      continue;
+#endif
+    caml_pending_signals[i] = 0;
+    {
+      value exn = caml_execute_signal_exn(i, 0);
+      if (Is_exception_result(exn)) return exn;
+    }
+  }
+  return Val_unit;
+}
+
+CAMLno_tsan /* When called from [caml_record_signal], these memory
+               accesses may not be synchronized. */
+void caml_set_action_pending(void)
+{
+  caml_something_to_do = 1;
+
+  /* When this function is called without [caml_c_call] (e.g., in
+     [caml_modify]), this is only moderately effective on ports that cache
+     [Caml_state->young_limit] in a register, so it may take a while before the
+     register is reloaded from [Caml_state->young_limit]. */
+  Caml_state->young_limit = Caml_state->young_alloc_end;
+}
+
+/* Record the delivery of a signal, and arrange for it to be processed
+   as soon as possible:
+   - via caml_something_to_do, processed in
+     caml_process_pending_actions_exn.
+   - by playing with the allocation limit, processed in
+     caml_garbage_collection and caml_alloc_small_dispatch.
+*/
+
+CAMLno_tsan void caml_record_signal(int signal_number)
+{
+  caml_pending_signals[signal_number] = 1;
+  signals_are_pending = 1;
+  caml_set_action_pending();
+}
+
+/* Management of blocking sections. */
+
+static intnat volatile caml_async_signal_mode = 0;
+
+static void caml_enter_blocking_section_default(void)
+{
+  CAMLassert (caml_async_signal_mode == 0);
+  caml_async_signal_mode = 1;
+}
+
+static void caml_leave_blocking_section_default(void)
+{
+  CAMLassert (caml_async_signal_mode == 1);
+  caml_async_signal_mode = 0;
+}
+
+static int caml_try_leave_blocking_section_default(void)
+{
+  intnat res;
+  Read_and_clear(res, caml_async_signal_mode);
+  return res;
+}
+
+CAMLexport void (*caml_enter_blocking_section_hook)(void) =
+   caml_enter_blocking_section_default;
+CAMLexport void (*caml_leave_blocking_section_hook)(void) =
+   caml_leave_blocking_section_default;
+CAMLexport int (*caml_try_leave_blocking_section_hook)(void) =
+   caml_try_leave_blocking_section_default;
+
+CAMLno_tsan /* The read of [caml_something_to_do] is not synchronized. */
+CAMLexport void caml_enter_blocking_section(void)
+{
+  while (1){
+    /* Process all pending signals now */
+    caml_raise_if_exception(caml_process_pending_signals_exn());
+    caml_enter_blocking_section_hook ();
+    /* Check again for pending signals.
+       If none, done; otherwise, try again */
+    if (! signals_are_pending) break;
+    caml_leave_blocking_section_hook ();
+  }
+}
+
+CAMLexport void caml_leave_blocking_section(void)
+{
+  int saved_errno;
+  /* Save the value of errno (PR#5982). */
+  saved_errno = errno;
+  caml_leave_blocking_section_hook ();
+
+  /* Some other thread may have switched
+     [signals_are_pending] to 0 even though there are still
+     pending signals (masked in the other thread). To handle this
+     case, we force re-examination of all signals by setting it back
+     to 1.
+
+     Another case where this is necessary (even in a single threaded
+     setting) is when the blocking section unmasks a pending signal:
+     If the signal is pending and masked but has already been
+     examined by [caml_process_pending_signals_exn], then
+     [signals_are_pending] is 0 but the signal needs to be
+     handled at this point. */
+  signals_are_pending = 1;
+  caml_raise_if_exception(caml_process_pending_signals_exn());
+
+  errno = saved_errno;
+}
+
+/* Execute a signal handler immediately */
+
+static value caml_signal_handlers = 0;
+
+value caml_execute_signal_exn(int signal_number, int in_signal_handler)
+{
+  value res;
+  value handler;
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+  void* saved_spacetime_trie_node_ptr;
+#endif
+#ifdef POSIX_SIGNALS
+  sigset_t nsigs, sigs;
+  /* Block the signal before executing the handler, and record in sigs
+     the original signal mask */
+  sigemptyset(&nsigs);
+  sigaddset(&nsigs, signal_number);
+  caml_sigmask_hook(SIG_BLOCK, &nsigs, &sigs);
+#endif
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+  /* We record the signal handler's execution separately, in the same
+     trie used for finalisers. */
+  saved_spacetime_trie_node_ptr
+    = caml_spacetime_trie_node_ptr;
+  caml_spacetime_trie_node_ptr
+    = caml_spacetime_finaliser_trie_root;
+#endif
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+  /* Handled action may have no associated handler, which we interpret
+     as meaning the signal should be handled by a call to exit.  This is
+     used to allow spacetime profiles to be completed on interrupt */
+  if (caml_signal_handlers == 0) {
+    res = caml_sys_exit(Val_int(2));
+  } else {
+    handler = Field(caml_signal_handlers, signal_number);
+    if (!Is_block(handler)) {
+      res = caml_sys_exit(Val_int(2));
+    } else {
+#else
+  handler = Field(caml_signal_handlers, signal_number);
+#endif
+    res = caml_callback_exn(
+             handler,
+             Val_int(caml_rev_convert_signal_number(signal_number)));
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+    }
+  }
+  caml_spacetime_trie_node_ptr = saved_spacetime_trie_node_ptr;
+#endif
+#ifdef POSIX_SIGNALS
+  if (! in_signal_handler) {
+    /* Restore the original signal mask */
+    caml_sigmask_hook(SIG_SETMASK, &sigs, NULL);
+  } else if (Is_exception_result(res)) {
+    /* Restore the original signal mask and unblock the signal itself */
+    sigdelset(&sigs, signal_number);
+    caml_sigmask_hook(SIG_SETMASK, &sigs, NULL);
+  }
+#endif
+  return res;
+}
+
+void caml_update_young_limit (void)
+{
+  /* The minor heap grows downwards. The first trigger is the largest one. */
+  Caml_state->young_limit =
+    caml_memprof_young_trigger < Caml_state->young_trigger ?
+    Caml_state->young_trigger : caml_memprof_young_trigger;
+
+  if(caml_something_to_do)
+    Caml_state->young_limit = Caml_state->young_alloc_end;
+}
+
+/* Arrange for a garbage collection to be performed as soon as possible */
+
+void caml_request_major_slice (void)
+{
+  Caml_state->requested_major_slice = 1;
+  caml_set_action_pending();
+}
+
+void caml_request_minor_gc (void)
+{
+  Caml_state->requested_minor_gc = 1;
+  caml_set_action_pending();
+}
+
+value caml_do_pending_actions_exn(void)
+{
+  value exn;
+
+  caml_something_to_do = 0;
+
+  // Do any pending minor collection or major slice
+  caml_check_urgent_gc(Val_unit);
+
+  caml_update_young_limit();
+
+  // Call signal handlers first
+  exn = caml_process_pending_signals_exn();
+  if (Is_exception_result(exn)) goto exception;
+
+  // Call memprof callbacks
+  exn = caml_memprof_handle_postponed_exn();
+  if (Is_exception_result(exn)) goto exception;
+
+  // Call finalisers
+  exn = caml_final_do_calls_exn();
+  if (Is_exception_result(exn)) goto exception;
+
+  return Val_unit;
+
+exception:
+  /* If an exception is raised during an asynchronous callback, then
+     it might be the case that we did not run all the callbacks we
+     needed. Therefore, we set [caml_something_to_do] again in order
+     to force reexamination of callbacks. */
+  caml_set_action_pending();
+  return exn;
+}
+
+CAMLno_tsan /* The access to [caml_something_to_do] is not synchronized. */
+Caml_inline value process_pending_actions_with_root_exn(value extra_root)
+{
+  if (caml_something_to_do) {
+    CAMLparam1(extra_root);
+    value exn = caml_do_pending_actions_exn();
+    if (Is_exception_result(exn))
+      CAMLreturn(exn);
+    CAMLdrop;
+  }
+  return extra_root;
+}
+
+value caml_process_pending_actions_with_root(value extra_root)
+{
+  value res = process_pending_actions_with_root_exn(extra_root);
+  return caml_raise_if_exception(res);
+}
+
+CAMLexport value caml_process_pending_actions_exn(void)
+{
+  return process_pending_actions_with_root_exn(Val_unit);
+}
+
+CAMLexport void caml_process_pending_actions(void)
+{
+  value exn = process_pending_actions_with_root_exn(Val_unit);
+  caml_raise_if_exception(exn);
+}
+
+/* OS-independent numbering of signals */
+
+#ifndef SIGABRT
+#define SIGABRT -1
+#endif
+#ifndef SIGALRM
+#define SIGALRM -1
+#endif
+#ifndef SIGFPE
+#define SIGFPE -1
+#endif
+#ifndef SIGHUP
+#define SIGHUP -1
+#endif
+#ifndef SIGILL
+#define SIGILL -1
+#endif
+#ifndef SIGINT
+#define SIGINT -1
+#endif
+#ifndef SIGKILL
+#define SIGKILL -1
+#endif
+#ifndef SIGPIPE
+#define SIGPIPE -1
+#endif
+#ifndef SIGQUIT
+#define SIGQUIT -1
+#endif
+#ifndef SIGSEGV
+#define SIGSEGV -1
+#endif
+#ifndef SIGTERM
+#define SIGTERM -1
+#endif
+#ifndef SIGUSR1
+#define SIGUSR1 -1
+#endif
+#ifndef SIGUSR2
+#define SIGUSR2 -1
+#endif
+#ifndef SIGCHLD
+#define SIGCHLD -1
+#endif
+#ifndef SIGCONT
+#define SIGCONT -1
+#endif
+#ifndef SIGSTOP
+#define SIGSTOP -1
+#endif
+#ifndef SIGTSTP
+#define SIGTSTP -1
+#endif
+#ifndef SIGTTIN
+#define SIGTTIN -1
+#endif
+#ifndef SIGTTOU
+#define SIGTTOU -1
+#endif
+#ifndef SIGVTALRM
+#define SIGVTALRM -1
+#endif
+#ifndef SIGPROF
+#define SIGPROF -1
+#endif
+#ifndef SIGBUS
+#define SIGBUS -1
+#endif
+#ifndef SIGPOLL
+#define SIGPOLL -1
+#endif
+#ifndef SIGSYS
+#define SIGSYS -1
+#endif
+#ifndef SIGTRAP
+#define SIGTRAP -1
+#endif
+#ifndef SIGURG
+#define SIGURG -1
+#endif
+#ifndef SIGXCPU
+#define SIGXCPU -1
+#endif
+#ifndef SIGXFSZ
+#define SIGXFSZ -1
+#endif
+
+static int posix_signals[] = {
+  SIGABRT, SIGALRM, SIGFPE, SIGHUP, SIGILL, SIGINT, SIGKILL, SIGPIPE,
+  SIGQUIT, SIGSEGV, SIGTERM, SIGUSR1, SIGUSR2, SIGCHLD, SIGCONT,
+  SIGSTOP, SIGTSTP, SIGTTIN, SIGTTOU, SIGVTALRM, SIGPROF, SIGBUS,
+  SIGPOLL, SIGSYS, SIGTRAP, SIGURG, SIGXCPU, SIGXFSZ
+};
+
+CAMLexport int caml_convert_signal_number(int signo)
+{
+  if (signo < 0 && signo >= -(sizeof(posix_signals) / sizeof(int)))
+    return posix_signals[-signo-1];
+  else
+    return signo;
+}
+
+CAMLexport int caml_rev_convert_signal_number(int signo)
+{
+  int i;
+  for (i = 0; i < sizeof(posix_signals) / sizeof(int); i++)
+    if (signo == posix_signals[i]) return -i - 1;
+  return signo;
+}
+
+/* Installation of a signal handler (as per [Sys.signal]) */
+
+CAMLprim value caml_install_signal_handler(value signal_number, value action)
+{
+  CAMLparam2 (signal_number, action);
+  CAMLlocal1 (res);
+  int sig, act, oldact;
+
+  sig = caml_convert_signal_number(Int_val(signal_number));
+  if (sig < 0 || sig >= NSIG)
+    caml_invalid_argument("Sys.signal: unavailable signal");
+  switch(action) {
+  case Val_int(0):              /* Signal_default */
+    act = 0;
+    break;
+  case Val_int(1):              /* Signal_ignore */
+    act = 1;
+    break;
+  default:                      /* Signal_handle */
+    act = 2;
+    break;
+  }
+  oldact = caml_set_signal_action(sig, act);
+  switch (oldact) {
+  case 0:                       /* was Signal_default */
+    res = Val_int(0);
+    break;
+  case 1:                       /* was Signal_ignore */
+    res = Val_int(1);
+    break;
+  case 2:                       /* was Signal_handle */
+    #if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+      /* Handled action may have no associated handler
+         which we treat as Signal_default */
+      if (caml_signal_handlers == 0) {
+        res = Val_int(0);
+      } else {
+        if (!Is_block(Field(caml_signal_handlers, sig))) {
+          res = Val_int(0);
+        } else {
+          res = caml_alloc_small (1, 0);
+          Field(res, 0) = Field(caml_signal_handlers, sig);
+        }
+      }
+    #else
+    res = caml_alloc_small (1, 0);
+    Field(res, 0) = Field(caml_signal_handlers, sig);
+    #endif
+    break;
+  default:                      /* error in caml_set_signal_action */
+    caml_sys_error(NO_ARG);
+  }
+  if (Is_block(action)) {
+    if (caml_signal_handlers == 0) {
+      caml_signal_handlers = caml_alloc(NSIG, 0);
+      caml_register_global_root(&caml_signal_handlers);
+    }
+    caml_modify(&Field(caml_signal_handlers, sig), Field(action, 0));
+  }
+  caml_raise_if_exception(caml_process_pending_signals_exn());
+  CAMLreturn (res);
+}
diff --git a/runtime/signals_byt.c b/runtime/signals_byt.c
new file mode 100644
index 00000000..040de03c
--- /dev/null
+++ b/runtime/signals_byt.c
@@ -0,0 +1,89 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2007 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
+
+/* Signal handling, code specific to the bytecode interpreter */
+
+#include <signal.h>
+#include <errno.h>
+#include "caml/config.h"
+#include "caml/memory.h"
+#include "caml/fail.h"
+#include "caml/finalise.h"
+#include "caml/osdeps.h"
+#include "caml/signals.h"
+#include "caml/signals_machdep.h"
+
+#ifndef NSIG
+#define NSIG 64
+#endif
+
+#ifdef _WIN32
+typedef void (*sighandler)(int sig);
+extern sighandler caml_win32_signal(int sig, sighandler action);
+#define signal(sig,act) caml_win32_signal(sig,act)
+#endif
+
+static void handle_signal(int signal_number)
+{
+  int saved_errno;
+  /* Save the value of errno (PR#5982). */
+  saved_errno = errno;
+#if !defined(POSIX_SIGNALS) && !defined(BSD_SIGNALS)
+  signal(signal_number, handle_signal);
+#endif
+  if (signal_number < 0 || signal_number >= NSIG) return;
+  if (caml_try_leave_blocking_section_hook()) {
+    caml_raise_if_exception(caml_execute_signal_exn(signal_number, 1));
+    caml_enter_blocking_section_hook();
+  }else{
+    caml_record_signal(signal_number);
+  }
+  errno = saved_errno;
+}
+
+int caml_set_signal_action(int signo, int action)
+{
+  void (*act)(int signo), (*oldact)(int signo);
+#ifdef POSIX_SIGNALS
+  struct sigaction sigact, oldsigact;
+#endif
+
+  switch (action) {
+  case 0:  act = SIG_DFL; break;
+  case 1:  act = SIG_IGN; break;
+  default: act = handle_signal; break;
+  }
+
+#ifdef POSIX_SIGNALS
+  sigact.sa_handler = act;
+  sigemptyset(&sigact.sa_mask);
+  sigact.sa_flags = 0;
+  if (sigaction(signo, &sigact, &oldsigact) == -1) return -1;
+  oldact = oldsigact.sa_handler;
+#else
+  oldact = signal(signo, act);
+  if (oldact == SIG_ERR) return -1;
+#endif
+  if (oldact == handle_signal)
+    return 2;
+  else if (oldact == SIG_IGN)
+    return 1;
+  else
+    return 0;
+}
+
+void caml_setup_stack_overflow_detection(void) {}
diff --git a/runtime/signals_nat.c b/runtime/signals_nat.c
new file mode 100644
index 00000000..fc5a77f8
--- /dev/null
+++ b/runtime/signals_nat.c
@@ -0,0 +1,309 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2007 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
+
+/* Signal handling, code specific to the native-code compiler */
+
+#if defined(TARGET_amd64) && defined (SYS_linux)
+#define _GNU_SOURCE
+#endif
+#include <signal.h>
+#include <errno.h>
+#include <stdio.h>
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/osdeps.h"
+#include "caml/signals.h"
+#include "caml/signals_machdep.h"
+#include "signals_osdep.h"
+#include "caml/stack.h"
+#include "caml/spacetime.h"
+#include "caml/memprof.h"
+#include "caml/finalise.h"
+
+#ifndef NSIG
+#define NSIG 64
+#endif
+
+typedef void (*signal_handler)(int signo);
+
+#ifdef _WIN32
+extern signal_handler caml_win32_signal(int sig, signal_handler action);
+#define signal(sig,act) caml_win32_signal(sig,act)
+extern void caml_win32_overflow_detection();
+#endif
+
+extern char * caml_code_area_start, * caml_code_area_end;
+extern char caml_system__code_begin, caml_system__code_end;
+
+/* Do not use the macro from address_class.h here. */
+#undef Is_in_code_area
+#define Is_in_code_area(pc) \
+ ( ((char *)(pc) >= caml_code_area_start && \
+    (char *)(pc) <= caml_code_area_end)     \
+|| ((char *)(pc) >= &caml_system__code_begin && \
+    (char *)(pc) <= &caml_system__code_end)     \
+|| (Classify_addr(pc) & In_code_area) )
+
+/* This routine is the common entry point for garbage collection
+   and signal handling.  It can trigger a callback to OCaml code.
+   With system threads, this callback can cause a context switch.
+   Hence [caml_garbage_collection] must not be called from regular C code
+   (e.g. the [caml_alloc] function) because the context of the call
+   (e.g. [intern_val]) may not allow context switching.
+   Only generated assembly code can call [caml_garbage_collection],
+   via the caml_call_gc assembly stubs.  */
+
+void caml_garbage_collection(void)
+{
+  frame_descr* d;
+  intnat allocsz = 0, i, nallocs;
+  unsigned char* alloc_len;
+
+  { /* Find the frame descriptor for the current allocation */
+    uintnat h = Hash_retaddr(Caml_state->last_return_address);
+    while (1) {
+      d = caml_frame_descriptors[h];
+      if (d->retaddr == Caml_state->last_return_address) break;
+      h = (h + 1) & caml_frame_descriptors_mask;
+    }
+    /* Must be an allocation frame */
+    CAMLassert(d && d->frame_size != 0xFFFF && (d->frame_size & 2));
+  }
+
+  /* Compute the total allocation size at this point,
+     including allocations combined by Comballoc */
+  alloc_len = (unsigned char*)(&d->live_ofs[d->num_live]);
+  nallocs = *alloc_len++;
+  for (i = 0; i < nallocs; i++) {
+    allocsz += Whsize_wosize(Wosize_encoded_alloc_len(alloc_len[i]));
+  }
+  /* We have computed whsize (including header), but need wosize (without) */
+  allocsz -= 1;
+
+  caml_alloc_small_dispatch(allocsz, CAML_DO_TRACK | CAML_FROM_CAML,
+                            nallocs, alloc_len);
+}
+
+DECLARE_SIGNAL_HANDLER(handle_signal)
+{
+  int saved_errno;
+  /* Save the value of errno (PR#5982). */
+  saved_errno = errno;
+#if !defined(POSIX_SIGNALS) && !defined(BSD_SIGNALS)
+  signal(sig, handle_signal);
+#endif
+  if (sig < 0 || sig >= NSIG) return;
+  if (caml_try_leave_blocking_section_hook ()) {
+    caml_raise_if_exception(caml_execute_signal_exn(sig, 1));
+    caml_enter_blocking_section_hook();
+  } else {
+    caml_record_signal(sig);
+  /* Some ports cache [Caml_state->young_limit] in a register.
+     Use the signal context to modify that register too, but only if
+     we are inside OCaml code (not inside C code). */
+#if defined(CONTEXT_PC) && defined(CONTEXT_YOUNG_LIMIT)
+    if (Is_in_code_area(CONTEXT_PC))
+      CONTEXT_YOUNG_LIMIT = (context_reg) Caml_state->young_limit;
+#endif
+  }
+  errno = saved_errno;
+}
+
+int caml_set_signal_action(int signo, int action)
+{
+  signal_handler oldact;
+#ifdef POSIX_SIGNALS
+  struct sigaction sigact, oldsigact;
+#else
+  signal_handler act;
+#endif
+
+#ifdef POSIX_SIGNALS
+  switch(action) {
+  case 0:
+    sigact.sa_handler = SIG_DFL;
+    sigact.sa_flags = 0;
+    break;
+  case 1:
+    sigact.sa_handler = SIG_IGN;
+    sigact.sa_flags = 0;
+    break;
+  default:
+    SET_SIGACT(sigact, handle_signal);
+    break;
+  }
+  sigemptyset(&sigact.sa_mask);
+  if (sigaction(signo, &sigact, &oldsigact) == -1) return -1;
+  oldact = oldsigact.sa_handler;
+#else
+  switch(action) {
+  case 0:  act = SIG_DFL; break;
+  case 1:  act = SIG_IGN; break;
+  default: act = handle_signal; break;
+  }
+  oldact = signal(signo, act);
+  if (oldact == SIG_ERR) return -1;
+#endif
+  if (oldact == (signal_handler) handle_signal)
+    return 2;
+  else if (oldact == SIG_IGN)
+    return 1;
+  else
+    return 0;
+}
+
+/* Machine- and OS-dependent handling of bound check trap */
+
+#if defined(TARGET_power) \
+  || defined(TARGET_s390x)
+DECLARE_SIGNAL_HANDLER(trap_handler)
+{
+#if defined(SYS_rhapsody)
+  /* Unblock SIGTRAP */
+  { sigset_t mask;
+    sigemptyset(&mask);
+    sigaddset(&mask, SIGTRAP);
+    caml_sigmask_hook(SIG_UNBLOCK, &mask, NULL);
+  }
+#endif
+  Caml_state->exception_pointer = (char *) CONTEXT_EXCEPTION_POINTER;
+  Caml_state->young_ptr = (value *) CONTEXT_YOUNG_PTR;
+  Caml_state->bottom_of_stack = (char *) CONTEXT_SP;
+  Caml_state->last_return_address = (uintnat) CONTEXT_PC;
+  caml_array_bound_error();
+}
+#endif
+
+/* Machine- and OS-dependent handling of stack overflow */
+
+#ifdef HAS_STACK_OVERFLOW_DETECTION
+#ifndef CONTEXT_SP
+#error "CONTEXT_SP is required if HAS_STACK_OVERFLOW_DETECTION is defined"
+#endif
+
+static char sig_alt_stack[SIGSTKSZ];
+
+/* Code compiled with ocamlopt never accesses more than
+   EXTRA_STACK bytes below the stack pointer. */
+#define EXTRA_STACK 256
+
+#ifdef RETURN_AFTER_STACK_OVERFLOW
+extern void caml_stack_overflow(caml_domain_state*);
+#endif
+
+/* Address sanitizer is confused when running the stack overflow
+   handler in an alternate stack. We deactivate it for all the
+   functions used by the stack overflow handler. */
+CAMLno_asan
+DECLARE_SIGNAL_HANDLER(segv_handler)
+{
+  struct sigaction act;
+  char * fault_addr;
+
+  /* Sanity checks:
+     - faulting address is word-aligned
+     - faulting address is on the stack, or within EXTRA_STACK of it
+     - we are in OCaml code */
+  fault_addr = CONTEXT_FAULTING_ADDRESS;
+  if (((uintnat) fault_addr & (sizeof(intnat) - 1)) == 0
+      && fault_addr < Caml_state->top_of_stack
+      && (uintnat)fault_addr >= CONTEXT_SP - EXTRA_STACK
+#ifdef CONTEXT_PC
+      && Is_in_code_area(CONTEXT_PC)
+#endif
+      ) {
+#ifdef RETURN_AFTER_STACK_OVERFLOW
+    /* Tweak the PC part of the context so that on return from this
+       handler, we jump to the asm function [caml_stack_overflow]
+       (from $ARCH.S). */
+#ifdef CONTEXT_PC
+    CONTEXT_C_ARG_1 = (context_reg) Caml_state;
+    CONTEXT_PC = (context_reg) &caml_stack_overflow;
+#else
+#error "CONTEXT_PC must be defined if RETURN_AFTER_STACK_OVERFLOW is"
+#endif
+#else
+    /* Raise a Stack_overflow exception straight from this signal handler */
+#if defined(CONTEXT_YOUNG_PTR) && defined(CONTEXT_EXCEPTION_POINTER)
+    Caml_state->exception_pointer == (char *) CONTEXT_EXCEPTION_POINTER;
+    Caml_state->young_ptr = (value *) CONTEXT_YOUNG_PTR;
+#endif
+    caml_raise_stack_overflow();
+#endif
+  } else {
+    /* Otherwise, deactivate our exception handler and return,
+       causing fatal signal to be generated at point of error. */
+    act.sa_handler = SIG_DFL;
+    act.sa_flags = 0;
+    sigemptyset(&act.sa_mask);
+    sigaction(SIGSEGV, &act, NULL);
+  }
+}
+
+#endif
+
+/* Initialization of signal stuff */
+
+void caml_init_signals(void)
+{
+  /* Bound-check trap handling */
+
+#if defined(TARGET_power)
+  { struct sigaction act;
+    sigemptyset(&act.sa_mask);
+    SET_SIGACT(act, trap_handler);
+#if !defined(SYS_rhapsody)
+    act.sa_flags |= SA_NODEFER;
+#endif
+    sigaction(SIGTRAP, &act, NULL);
+  }
+#endif
+
+#if defined(TARGET_s390x)
+  { struct sigaction act;
+    sigemptyset(&act.sa_mask);
+    SET_SIGACT(act, trap_handler);
+    sigaction(SIGFPE, &act, NULL);
+  }
+#endif
+
+#ifdef HAS_STACK_OVERFLOW_DETECTION
+  {
+    stack_t stk;
+    struct sigaction act;
+    stk.ss_sp = sig_alt_stack;
+    stk.ss_size = SIGSTKSZ;
+    stk.ss_flags = 0;
+    SET_SIGACT(act, segv_handler);
+    act.sa_flags |= SA_ONSTACK | SA_NODEFER;
+    sigemptyset(&act.sa_mask);
+    if (sigaltstack(&stk, NULL) == 0) { sigaction(SIGSEGV, &act, NULL); }
+  }
+#endif
+}
+
+void caml_setup_stack_overflow_detection(void)
+{
+#ifdef HAS_STACK_OVERFLOW_DETECTION
+  stack_t stk;
+  stk.ss_sp = malloc(SIGSTKSZ);
+  stk.ss_size = SIGSTKSZ;
+  stk.ss_flags = 0;
+  if (stk.ss_sp)
+    sigaltstack(&stk, NULL);
+#endif
+}
diff --git a/runtime/signals_osdep.h b/runtime/signals_osdep.h
new file mode 100644
index 00000000..d507d5a6
--- /dev/null
+++ b/runtime/signals_osdep.h
@@ -0,0 +1,406 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2004 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Processor- and OS-dependent signal interface */
+
+/****************** AMD64, Linux */
+
+#if defined(TARGET_amd64) && defined (SYS_linux)
+
+  #define DECLARE_SIGNAL_HANDLER(name) \
+    static void name(int sig, siginfo_t * info, ucontext_t * context)
+
+  #define SET_SIGACT(sigact,name) \
+     sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+     sigact.sa_flags = SA_SIGINFO
+
+  typedef greg_t context_reg;
+  #define CONTEXT_C_ARG_1 (context->uc_mcontext.gregs[REG_RDI])
+  #define CONTEXT_PC (context->uc_mcontext.gregs[REG_RIP])
+  #define CONTEXT_SP (context->uc_mcontext.gregs[REG_RSP])
+  #define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[REG_R15])
+  #define CONTEXT_FAULTING_ADDRESS ((char *)context->uc_mcontext.gregs[REG_CR2])
+
+/****************** AMD64, MacOSX */
+
+#elif defined(TARGET_amd64) && defined (SYS_macosx)
+
+  #define DECLARE_SIGNAL_HANDLER(name) \
+    static void name(int sig, siginfo_t * info, void * context)
+
+  #define SET_SIGACT(sigact,name) \
+     sigact.sa_sigaction = (name); \
+     sigact.sa_flags = SA_SIGINFO | SA_64REGSET
+
+  #include <sys/ucontext.h>
+  #include <AvailabilityMacros.h>
+
+  #if !defined(MAC_OS_X_VERSION_10_5) \
+      || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5
+    #define CONTEXT_REG(r) r
+  #else
+    #define CONTEXT_REG(r) __##r
+  #endif
+
+  typedef unsigned long long context_reg;
+  #define CONTEXT_STATE (((ucontext_t *)context)->uc_mcontext->CONTEXT_REG(ss))
+  #define CONTEXT_C_ARG_1 (CONTEXT_STATE.CONTEXT_REG(rdi))
+  #define CONTEXT_PC (CONTEXT_STATE.CONTEXT_REG(rip))
+  #define CONTEXT_YOUNG_PTR (CONTEXT_STATE.CONTEXT_REG(r15))
+  #define CONTEXT_SP (CONTEXT_STATE.CONTEXT_REG(rsp))
+  #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
+  #define RETURN_AFTER_STACK_OVERFLOW
+
+/****************** ARM, Linux */
+
+#elif defined(TARGET_arm) && (defined(SYS_linux_eabi) \
+      || defined(SYS_linux_eabihf))
+
+  #include <sys/ucontext.h>
+
+  #define DECLARE_SIGNAL_HANDLER(name) \
+    static void name(int sig, siginfo_t * info, ucontext_t * context)
+
+  #define SET_SIGACT(sigact,name) \
+     sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+     sigact.sa_flags = SA_SIGINFO
+
+  typedef unsigned long context_reg;
+  #define CONTEXT_PC (context->uc_mcontext.arm_pc)
+  #define CONTEXT_SP (context->uc_mcontext.arm_sp)
+  #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.arm_fp)
+  #define CONTEXT_YOUNG_PTR (context->uc_mcontext.arm_r8)
+  #define CONTEXT_FAULTING_ADDRESS ((char *) context->uc_mcontext.fault_address)
+
+/****************** ARM64, Linux */
+
+#elif defined(TARGET_arm64) && defined(SYS_linux)
+
+  #include <sys/ucontext.h>
+
+  #define DECLARE_SIGNAL_HANDLER(name) \
+    static void name(int sig, siginfo_t * info, ucontext_t * context)
+
+  #define SET_SIGACT(sigact,name) \
+     sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+     sigact.sa_flags = SA_SIGINFO
+
+  typedef unsigned long context_reg;
+  #define CONTEXT_PC (context->uc_mcontext.pc)
+  #define CONTEXT_SP (context->uc_mcontext.sp)
+  #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.regs[26])
+  #define CONTEXT_YOUNG_PTR (context->uc_mcontext.regs[27])
+  #define CONTEXT_FAULTING_ADDRESS ((char *) context->uc_mcontext.fault_address)
+
+/****************** ARM64, FreeBSD */
+
+#elif defined(TARGET_arm64) && defined(SYS_freebsd)
+
+  #include <sys/ucontext.h>
+
+  #define DECLARE_SIGNAL_HANDLER(name) \
+    static void name(int sig, siginfo_t * info, ucontext_t * context)
+
+  #define SET_SIGACT(sigact,name) \
+     sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+     sigact.sa_flags = SA_SIGINFO
+
+  typedef unsigned long context_reg;
+  #define CONTEXT_PC (context->uc_mcontext.mc_gpregs.gp_elr)
+  #define CONTEXT_SP (context->uc_mcontext.mc_gpregs.gp_sp)
+  #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.mc_gpregs.gp_x[26])
+  #define CONTEXT_YOUNG_PTR (context->uc_mcontext.mc_gpregs.gp_x[27])
+  #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
+
+/****************** AMD64, Solaris x86 */
+
+#elif defined(TARGET_amd64) && defined (SYS_solaris)
+
+  #include <ucontext.h>
+
+  #define DECLARE_SIGNAL_HANDLER(name) \
+    static void name(int sig, siginfo_t * info, ucontext_t * context)
+
+  #define SET_SIGACT(sigact,name) \
+    sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+    sigact.sa_flags = SA_SIGINFO
+
+  typedef greg_t context_reg;
+  #define CONTEXT_PC (context->uc_mcontext.gregs[REG_RIP])
+  #define CONTEXT_C_ARG_1 (context->uc_mcontext.gregs[REG_RDI])
+  #define CONTEXT_SP (context->uc_mcontext.gregs[REG_RSP])
+  #define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[REG_R15])
+  #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
+/****************** AMD64, OpenBSD */
+
+#elif defined(TARGET_amd64) && defined (SYS_openbsd)
+
+ #define DECLARE_SIGNAL_HANDLER(name) \
+ static void name(int sig, siginfo_t * info, struct sigcontext * context)
+
+ #define SET_SIGACT(sigact,name) \
+ sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+ sigact.sa_flags = SA_SIGINFO
+
+ #define CONTEXT_PC (context->sc_rip)
+ #define CONTEXT_C_ARG_1 (context->sc_rdi)
+ #define CONTEXT_SP (context->sc_rsp)
+ #define CONTEXT_YOUNG_PTR (context->sc_r15)
+ #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
+/****************** AMD64, NetBSD */
+
+#elif defined(TARGET_amd64) && defined (SYS_netbsd)
+
+ #include <ucontext.h>
+ #define DECLARE_SIGNAL_HANDLER(name) \
+ static void name(int sig, siginfo_t * info, ucontext_t * context)
+
+ #define SET_SIGACT(sigact,name) \
+ sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+ sigact.sa_flags = SA_SIGINFO
+
+ #define CONTEXT_PC (_UC_MACHINE_PC(context))
+ #define CONTEXT_C_ARG_1 (context->uc_mcontext.gregs[REG_RDI])
+ #define CONTEXT_SP (_UC_MACHINE_SP(context))
+ #define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[REG_R15])
+ #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
+/****************** I386, Linux */
+
+#elif defined(TARGET_i386) && defined(SYS_linux_elf)
+
+  #define DECLARE_SIGNAL_HANDLER(name) \
+    static void name(int sig, struct sigcontext context)
+
+  #define SET_SIGACT(sigact,name) \
+     sigact.sa_handler = (void (*)(int)) (name); \
+     sigact.sa_flags = 0
+
+  #define CONTEXT_FAULTING_ADDRESS ((char *) context.cr2)
+  #define CONTEXT_PC (context.eip)
+  #define CONTEXT_SP (context.esp)
+
+/****************** I386, BSD_ELF */
+
+#elif defined(TARGET_i386) && defined(SYS_bsd_elf)
+
+ #if defined (__NetBSD__)
+  #include <ucontext.h>
+  #define DECLARE_SIGNAL_HANDLER(name) \
+  static void name(int sig, siginfo_t * info, ucontext_t * context)
+ #else
+  #define DECLARE_SIGNAL_HANDLER(name) \
+  static void name(int sig, siginfo_t * info, struct sigcontext * context)
+ #endif
+
+ #define SET_SIGACT(sigact,name) \
+ sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+ sigact.sa_flags = SA_SIGINFO
+
+ #if defined (__NetBSD__)
+  #define CONTEXT_PC (_UC_MACHINE_PC(context))
+  #define CONTEXT_SP (_UC_MACHINE_SP(context))
+ #else
+  #define CONTEXT_PC (context->sc_eip)
+  #define CONTEXT_SP (context->sc_esp)
+ #endif
+ #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
+/****************** I386, BSD */
+
+#elif defined(TARGET_i386) && defined(SYS_bsd)
+
+  #define DECLARE_SIGNAL_HANDLER(name) \
+    static void name(int sig, siginfo_t * info, void * context)
+
+  #define SET_SIGACT(sigact,name) \
+     sigact.sa_sigaction = (name); \
+     sigact.sa_flags = SA_SIGINFO
+
+  #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
+/****************** I386, MacOS X */
+
+#elif defined(TARGET_i386) && defined(SYS_macosx)
+
+  #define DECLARE_SIGNAL_HANDLER(name) \
+    static void name(int sig, siginfo_t * info, void * context)
+
+  #define SET_SIGACT(sigact,name) \
+     sigact.sa_sigaction = (name); \
+     sigact.sa_flags = SA_SIGINFO
+
+  #include <sys/ucontext.h>
+  #include <AvailabilityMacros.h>
+
+  #if !defined(MAC_OS_X_VERSION_10_5) \
+      || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5
+    #define CONTEXT_REG(r) r
+  #else
+    #define CONTEXT_REG(r) __##r
+  #endif
+
+  #define CONTEXT_STATE (((ucontext_t *)context)->uc_mcontext->CONTEXT_REG(ss))
+  #define CONTEXT_PC (CONTEXT_STATE.CONTEXT_REG(eip))
+  #define CONTEXT_SP (CONTEXT_STATE.CONTEXT_REG(esp))
+  #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
+/****************** I386, Solaris x86 */
+
+#elif defined(TARGET_i386) && defined(SYS_solaris)
+
+  #define DECLARE_SIGNAL_HANDLER(name) \
+    static void name(int sig, siginfo_t * info, void * context)
+
+  #define SET_SIGACT(sigact,name) \
+    sigact.sa_sigaction = (name); \
+    sigact.sa_flags = SA_SIGINFO
+
+  #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
+/****************** PowerPC, MacOS X */
+
+#elif defined(TARGET_power) && defined(SYS_rhapsody)
+
+  #define DECLARE_SIGNAL_HANDLER(name) \
+     static void name(int sig, siginfo_t * info, void * context)
+
+  #include <sys/ucontext.h>
+  #include <AvailabilityMacros.h>
+
+  #ifdef __LP64__
+    #define SET_SIGACT(sigact,name) \
+       sigact.sa_sigaction = (name); \
+       sigact.sa_flags = SA_SIGINFO | SA_64REGSET
+
+    typedef unsigned long long context_reg;
+
+    #define CONTEXT_MCONTEXT (((ucontext64_t *)context)->uc_mcontext64)
+  #else
+    #define SET_SIGACT(sigact,name) \
+       sigact.sa_sigaction = (name); \
+       sigact.sa_flags = SA_SIGINFO
+
+    typedef unsigned long context_reg;
+
+    #define CONTEXT_MCONTEXT (((ucontext_t *)context)->uc_mcontext)
+  #endif
+
+  #if !defined(MAC_OS_X_VERSION_10_5) \
+      || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5
+    #define CONTEXT_REG(r) r
+  #else
+    #define CONTEXT_REG(r) __##r
+  #endif
+
+  #define CONTEXT_STATE (CONTEXT_MCONTEXT->CONTEXT_REG(ss))
+  #define CONTEXT_PC (CONTEXT_STATE.CONTEXT_REG(srr0))
+  #define CONTEXT_EXCEPTION_POINTER (CONTEXT_STATE.CONTEXT_REG(r29))
+  #define CONTEXT_YOUNG_LIMIT (CONTEXT_STATE.CONTEXT_REG(r30))
+  #define CONTEXT_YOUNG_PTR (CONTEXT_STATE.CONTEXT_REG(r31))
+  #define CONTEXT_SP (CONTEXT_STATE.CONTEXT_REG(r1))
+  #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
+/****************** PowerPC, ELF (Linux) */
+
+#elif defined(TARGET_power) && defined(SYS_elf)
+
+  #define DECLARE_SIGNAL_HANDLER(name) \
+    static void name(int sig, struct sigcontext * context)
+
+  #define SET_SIGACT(sigact,name) \
+     sigact.sa_handler = (void (*)(int)) (name); \
+     sigact.sa_flags = 0
+
+  typedef unsigned long context_reg;
+  #define CONTEXT_PC (context->regs->nip)
+  #define CONTEXT_EXCEPTION_POINTER (context->regs->gpr[29])
+  #define CONTEXT_YOUNG_LIMIT (context->regs->gpr[30])
+  #define CONTEXT_YOUNG_PTR (context->regs->gpr[31])
+  #define CONTEXT_SP (context->regs->gpr[1])
+
+/****************** PowerPC, NetBSD */
+
+#elif defined(TARGET_power) && defined (SYS_netbsd)
+
+  #include <ucontext.h>
+  #define DECLARE_SIGNAL_HANDLER(name) \
+  static void name(int sig, siginfo_t * info, ucontext_t * context)
+
+  #define SET_SIGACT(sigact,name) \
+  sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+  sigact.sa_flags = SA_SIGINFO
+
+  typedef long context_reg;
+  #define CONTEXT_PC (_UC_MACHINE_PC(context))
+  #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.__gregs[_REG_R29])
+  #define CONTEXT_YOUNG_LIMIT (context->uc_mcontext.__gregs[_REG_R30])
+  #define CONTEXT_YOUNG_PTR (context->uc_mcontext.__gregs[_REG_R31])
+  #define CONTEXT_SP (_UC_MACHINE_SP(context))
+  #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
+
+/****************** PowerPC, other BSDs */
+
+#elif defined(TARGET_power) && \
+    (defined(SYS_bsd) || defined(SYS_bsd_elf))
+
+  #define DECLARE_SIGNAL_HANDLER(name) \
+    static void name(int sig, int code, struct sigcontext * context)
+
+  #define SET_SIGACT(sigact,name) \
+     sigact.sa_handler = (void (*)(int)) (name); \
+     sigact.sa_flags = 0
+
+  typedef unsigned long context_reg;
+  #define CONTEXT_PC (context->sc_frame.srr0)
+  #define CONTEXT_EXCEPTION_POINTER (context->sc_frame.fixreg[29])
+  #define CONTEXT_YOUNG_LIMIT (context->sc_frame.fixreg[30])
+  #define CONTEXT_YOUNG_PTR (context->sc_frame.fixreg[31])
+  #define CONTEXT_SP (context->sc_frame.fixreg[1])
+
+/****************** s390x, ELF (Linux) */
+#elif defined(TARGET_s390x) && defined(SYS_elf)
+
+  #define DECLARE_SIGNAL_HANDLER(name) \
+    static void name(int sig, struct sigcontext * context)
+
+  #define SET_SIGACT(sigact,name) \
+     sigact.sa_handler = (void (*)(int)) (name); \
+     sigact.sa_flags = 0
+
+  typedef unsigned long context_reg;
+  #define CONTEXT_PC (context->sregs->regs.psw.addr)
+  #define CONTEXT_EXCEPTION_POINTER (context->sregs->regs.gprs[13])
+  #define CONTEXT_YOUNG_LIMIT (context->sregs->regs.gprs[10])
+  #define CONTEXT_YOUNG_PTR (context->sregs->regs.gprs[11])
+  #define CONTEXT_SP (context->sregs->regs.gprs[15])
+
+/******************** Default */
+
+#else
+
+  #define DECLARE_SIGNAL_HANDLER(name) \
+    static void name(int sig)
+
+  #define SET_SIGACT(sigact,name) \
+     sigact.sa_handler = (name); \
+     sigact.sa_flags = 0
+
+#endif
diff --git a/runtime/spacetime_byt.c b/runtime/spacetime_byt.c
new file mode 100644
index 00000000..2b0bf1dc
--- /dev/null
+++ b/runtime/spacetime_byt.c
@@ -0,0 +1,38 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*            Mark Shinwell and Leo White, Jane Street Europe             */
+/*                                                                        */
+/*   Copyright 2013--2016, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include "caml/fail.h"
+#include "caml/mlvalues.h"
+
+int caml_ensure_spacetime_dot_o_is_included = 42;
+
+CAMLprim value caml_spacetime_only_works_for_native_code(value foo, ...)
+{
+  caml_failwith("Spacetime profiling only works for native code");
+}
+
+uintnat caml_spacetime_my_profinfo (void)
+{
+  return 0;
+}
+
+CAMLprim value caml_spacetime_enabled (value v_unit)
+{
+  return Val_false;  /* running in bytecode */
+}
+
+CAMLprim value caml_register_channel_for_spacetime (value v_channel)
+{
+  return Val_unit;
+}
diff --git a/runtime/spacetime_nat.c b/runtime/spacetime_nat.c
new file mode 100644
index 00000000..7e85e96e
--- /dev/null
+++ b/runtime/spacetime_nat.c
@@ -0,0 +1,1160 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*            Mark Shinwell and Leo White, Jane Street Europe             */
+/*                                                                        */
+/*   Copyright 2013--2016, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#define CAML_INTERNALS
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include <math.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <signal.h>
+#include "caml/config.h"
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#ifdef _WIN32
+#include <process.h> /* for _getpid */
+#include <direct.h> /* for _wgetcwd */
+#endif
+
+#include "caml/alloc.h"
+#include "caml/backtrace_prim.h"
+#include "caml/fail.h"
+#include "caml/gc.h"
+#include "caml/intext.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/osdeps.h"
+#include "caml/roots.h"
+#include "caml/signals.h"
+#include "caml/stack.h"
+#include "caml/sys.h"
+#include "caml/spacetime.h"
+
+#ifdef WITH_SPACETIME
+
+/* We force "noinline" in certain places to be sure we know how many
+   frames there will be on the stack. */
+#ifdef _MSC_VER
+#define NOINLINE __declspec(noinline)
+#else
+#define NOINLINE __attribute__((noinline))
+#endif
+
+#ifdef HAS_LIBUNWIND
+#define UNW_LOCAL_ONLY
+#include "libunwind.h"
+#endif
+
+static int automatic_snapshots = 0;
+static double snapshot_interval = 0.0;
+static double next_snapshot_time = 0.0;
+static struct channel *snapshot_channel;
+static int pid_when_snapshot_channel_opened;
+
+extern value caml_spacetime_debug(value);
+
+static char* start_of_free_node_block;
+static char* end_of_free_node_block;
+
+typedef struct per_thread {
+  value* trie_node_root;
+  value* finaliser_trie_node_root;
+  struct per_thread* next;
+} per_thread;
+
+/* List of tries corresponding to threads that have been created. */
+/* CR-soon mshinwell: just include the main trie in this list. */
+static per_thread* per_threads = NULL;
+static int num_per_threads = 0;
+
+/* [caml_spacetime_shapes] is defined in the startup file. */
+extern uint64_t* caml_spacetime_shapes;
+
+uint64_t** caml_spacetime_static_shape_tables = NULL;
+shape_table* caml_spacetime_dynamic_shape_tables = NULL;
+
+static uintnat caml_spacetime_profinfo = (uintnat) 0;
+
+value caml_spacetime_trie_root = Val_unit;
+value* caml_spacetime_trie_node_ptr = &caml_spacetime_trie_root;
+
+static value caml_spacetime_finaliser_trie_root_main_thread = Val_unit;
+value* caml_spacetime_finaliser_trie_root
+  = &caml_spacetime_finaliser_trie_root_main_thread;
+
+/* CR-someday mshinwell: think about thread safety of the manipulation of
+   this list for multicore */
+allocation_point* caml_all_allocation_points = NULL;
+
+static const uintnat chunk_size = 1024 * 1024;
+
+#ifdef _WIN32
+#define strdup_os wcsdup
+#else
+#define strdup_os strdup
+#endif
+
+static void reinitialise_free_node_block(void)
+{
+  size_t index;
+
+  start_of_free_node_block = (char*) caml_stat_alloc_noexc(chunk_size);
+  end_of_free_node_block = start_of_free_node_block + chunk_size;
+
+  for (index = 0; index < chunk_size / sizeof(value); index++) {
+    ((value*) start_of_free_node_block)[index] = Val_unit;
+  }
+}
+
+#ifndef O_BINARY
+#define O_BINARY 0
+#endif
+
+enum {
+  FEATURE_CALL_COUNTS = 1,
+} features;
+
+static uint16_t version_number = 0;
+static uint32_t magic_number_base = 0xace00ace;
+
+static void caml_spacetime_write_magic_number_internal(struct channel* chan)
+{
+  value magic_number;
+  uint16_t features = 0;
+
+#ifdef ENABLE_CALL_COUNTS
+  features |= FEATURE_CALL_COUNTS;
+#endif
+
+  magic_number =
+    Val_long(((uint64_t) magic_number_base)
+             | (((uint64_t) version_number) << 32)
+             | (((uint64_t) features) << 48));
+
+  Lock(chan);
+  caml_output_val(chan, magic_number, Val_long(0));
+  Unlock(chan);
+}
+
+CAMLprim value caml_spacetime_write_magic_number(value v_channel)
+{
+  caml_spacetime_write_magic_number_internal(Channel(v_channel));
+  return Val_unit;
+}
+
+static char_os* automatic_snapshot_dir;
+
+static void open_snapshot_channel(void)
+{
+  int fd;
+  char_os filename[8192];
+  int pid;
+  int filename_len = sizeof(filename)/sizeof(char_os);
+#ifdef _WIN32
+  pid = _getpid();
+#else
+  pid = getpid();
+#endif
+  snprintf_os(filename, filename_len, T("%s/spacetime-%d"),
+              automatic_snapshot_dir, pid);
+  filename[filename_len-1] = '\0';
+  fd = open_os(filename, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY, 0666);
+  if (fd == -1) {
+    automatic_snapshots = 0;
+  }
+  else {
+    snapshot_channel = caml_open_descriptor_out(fd);
+    snapshot_channel->flags |= CHANNEL_FLAG_BLOCKING_WRITE;
+    pid_when_snapshot_channel_opened = pid;
+    caml_spacetime_write_magic_number_internal(snapshot_channel);
+  }
+}
+
+static void maybe_reopen_snapshot_channel(void)
+{
+  /* This function should be used before writing to the automatic snapshot
+     channel.  It detects whether we have forked since the channel was opened.
+     If so, we close the old channel (ignoring any errors just in case the
+     old fd has been closed, e.g. in a double-fork situation where the middle
+     process has a loop to manually close all fds and no Spacetime snapshot
+     was written during that time) and then open a new one. */
+
+  int pid;
+#ifdef _WIN32
+  pid = _getpid();
+#else
+  pid = getpid();
+#endif
+
+  if (pid != pid_when_snapshot_channel_opened) {
+    caml_close_channel(snapshot_channel);
+    open_snapshot_channel();
+  }
+}
+
+extern void caml_spacetime_automatic_save(void);
+
+void caml_spacetime_initialize(void)
+{
+  /* Note that this is called very early (even prior to GC initialisation). */
+
+  char_os *ap_interval;
+
+  reinitialise_free_node_block();
+
+  caml_spacetime_static_shape_tables = &caml_spacetime_shapes;
+
+  ap_interval = caml_secure_getenv (T("OCAML_SPACETIME_INTERVAL"));
+  if (ap_interval != NULL) {
+    unsigned int interval = 0;
+    sscanf_os(ap_interval, T("%u"), &interval);
+    if (interval != 0) {
+      double time;
+      char_os cwd[4096];
+      char_os* user_specified_automatic_snapshot_dir;
+      int dir_ok = 1;
+
+      user_specified_automatic_snapshot_dir =
+        caml_secure_getenv(T("OCAML_SPACETIME_SNAPSHOT_DIR"));
+
+      if (user_specified_automatic_snapshot_dir == NULL) {
+#if defined(HAS_GETCWD)
+        if (getcwd_os(cwd, sizeof(cwd)/sizeof(char_os)) == NULL) {
+          dir_ok = 0;
+        }
+#else
+        dir_ok = 0;
+#endif
+        if (dir_ok) {
+          automatic_snapshot_dir = strdup_os(cwd);
+        }
+      }
+      else {
+        automatic_snapshot_dir =
+          strdup_os(user_specified_automatic_snapshot_dir);
+      }
+
+      if (dir_ok) {
+        automatic_snapshots = 1;
+        open_snapshot_channel();
+        if (automatic_snapshots) {
+#ifdef SIGINT
+          /* Catch interrupt so that the profile can be completed.
+             We do this by marking the signal as handled without
+             specifying an actual handler. This causes the signal
+             to be handled by a call to exit. */
+          caml_set_signal_action(SIGINT, 2);
+#endif
+          snapshot_interval = interval / 1e3;
+          time = caml_sys_time_unboxed(Val_unit);
+          next_snapshot_time = time + snapshot_interval;
+          atexit(&caml_spacetime_automatic_save);
+        }
+      }
+    }
+  }
+}
+
+void caml_spacetime_register_shapes(void* dynlinked_table)
+{
+  shape_table* table;
+  table = (shape_table*) caml_stat_alloc_noexc(sizeof(shape_table));
+  if (table == NULL) {
+    fprintf(stderr, "Out of memory whilst registering shape table");
+    abort();
+  }
+  table->table = (uint64_t*) dynlinked_table;
+  table->next = caml_spacetime_dynamic_shape_tables;
+  caml_spacetime_dynamic_shape_tables = table;
+}
+
+CAMLprim value caml_spacetime_trie_is_initialized (value v_unit)
+{
+  return (caml_spacetime_trie_root == Val_unit) ? Val_false : Val_true;
+}
+
+CAMLprim value caml_spacetime_get_trie_root (value v_unit)
+{
+  return caml_spacetime_trie_root;
+}
+
+void caml_spacetime_register_thread(
+  value* trie_node_root, value* finaliser_trie_node_root)
+{
+  per_thread* thr;
+
+  thr = (per_thread*) caml_stat_alloc_noexc(sizeof(per_thread));
+  if (thr == NULL) {
+    fprintf(stderr, "Out of memory while registering thread for profiling\n");
+    abort();
+  }
+  thr->next = per_threads;
+  per_threads = thr;
+
+  thr->trie_node_root = trie_node_root;
+  thr->finaliser_trie_node_root = finaliser_trie_node_root;
+
+  /* CR-soon mshinwell: record thread ID (and for the main thread too) */
+
+  num_per_threads++;
+}
+
+static void caml_spacetime_save_event_internal (value v_time_opt,
+                                                struct channel* chan,
+                                                value v_event_name)
+{
+  value v_time;
+  double time_override = 0.0;
+  int use_time_override = 0;
+
+  if (Is_block(v_time_opt)) {
+    time_override = Double_field(Field(v_time_opt, 0), 0);
+    use_time_override = 1;
+  }
+  v_time = caml_spacetime_timestamp(time_override, use_time_override);
+
+  Lock(chan);
+  caml_output_val(chan, Val_long(2), Val_long(0));
+  caml_output_val(chan, v_event_name, Val_long(0));
+  caml_extern_allow_out_of_heap = 1;
+  caml_output_val(chan, v_time, Val_long(0));
+  caml_extern_allow_out_of_heap = 0;
+  Unlock(chan);
+
+  caml_stat_free(Hp_val(v_time));
+}
+
+CAMLprim value caml_spacetime_save_event (value v_time_opt,
+                                          value v_channel,
+                                          value v_event_name)
+{
+  struct channel* chan = Channel(v_channel);
+
+  caml_spacetime_save_event_internal(v_time_opt, chan, v_event_name);
+
+  return Val_unit;
+}
+
+
+void save_trie (struct channel *chan, double time_override,
+                int use_time_override)
+{
+  value v_time, v_frames, v_shapes;
+  /* CR-someday mshinwell: The commented-out changes here are for multicore,
+     where we think we should have one trie per domain. */
+  /* int num_marshalled = 0;
+  per_thread* thr = per_threads; */
+
+  Lock(chan);
+
+  caml_output_val(chan, Val_long(1), Val_long(0));
+
+  v_time = caml_spacetime_timestamp(time_override, use_time_override);
+  v_frames = caml_spacetime_frame_table();
+  v_shapes = caml_spacetime_shape_table();
+
+  caml_extern_allow_out_of_heap = 1;
+  caml_output_val(chan, v_time, Val_long(0));
+  caml_output_val(chan, v_frames, Val_long(0));
+  caml_output_val(chan, v_shapes, Val_long(0));
+  caml_extern_allow_out_of_heap = 0;
+
+  caml_output_val(chan, Val_long(1) /* Val_long(num_per_threads + 1) */,
+    Val_long(0));
+
+  /* Marshal both the main and finaliser tries, for all threads that have
+     been created, to an [out_channel].  This can be done by using the
+     extern.c code as usual, since the trie looks like standard OCaml values;
+     but we must allow it to traverse outside the heap. */
+
+  caml_extern_allow_out_of_heap = 1;
+  caml_output_val(chan, caml_spacetime_trie_root, Val_long(0));
+  caml_output_val(chan,
+    caml_spacetime_finaliser_trie_root_main_thread, Val_long(0));
+  /* while (thr != NULL) {
+    caml_output_val(chan, *(thr->trie_node_root), Val_long(0));
+    caml_output_val(chan, *(thr->finaliser_trie_node_root),
+      Val_long(0));
+    thr = thr->next;
+    num_marshalled++;
+  }
+  CAMLassert(num_marshalled == num_per_threads); */
+  caml_extern_allow_out_of_heap = 0;
+
+  Unlock(chan);
+}
+
+CAMLprim value caml_spacetime_save_trie (value v_time_opt, value v_channel)
+{
+  struct channel* channel = Channel(v_channel);
+  double time_override = 0.0;
+  int use_time_override = 0;
+
+  if (Is_block(v_time_opt)) {
+    time_override = Double_field(Field(v_time_opt, 0), 0);
+    use_time_override = 1;
+  }
+
+  save_trie(channel, time_override, use_time_override);
+
+  return Val_unit;
+}
+
+c_node_type caml_spacetime_classify_c_node(c_node* node)
+{
+  return (node->pc & 2) ? CALL : ALLOCATION;
+}
+
+c_node* caml_spacetime_c_node_of_stored_pointer(value node_stored)
+{
+  CAMLassert(node_stored == Val_unit || Is_c_node(node_stored));
+  return (node_stored == Val_unit) ? NULL : (c_node*) Hp_val(node_stored);
+}
+
+c_node* caml_spacetime_c_node_of_stored_pointer_not_null(
+      value node_stored)
+{
+  CAMLassert(Is_c_node(node_stored));
+  return (c_node*) Hp_val(node_stored);
+}
+
+value caml_spacetime_stored_pointer_of_c_node(c_node* c_node)
+{
+  value node;
+  CAMLassert(c_node != NULL);
+  node = Val_hp(c_node);
+  CAMLassert(Is_c_node(node));
+  return node;
+}
+
+#ifdef HAS_LIBUNWIND
+static int pc_inside_c_node_matches(c_node* node, void* pc)
+{
+  return Decode_c_node_pc(node->pc) == pc;
+}
+#endif
+
+static value allocate_uninitialized_ocaml_node(int size_including_header)
+{
+  void* node;
+  uintnat size;
+
+  CAMLassert(size_including_header >= 3);
+  node = caml_stat_alloc(sizeof(uintnat) * size_including_header);
+
+  size = size_including_header * sizeof(value);
+
+  node = (void*) start_of_free_node_block;
+  if (end_of_free_node_block - start_of_free_node_block < size) {
+    reinitialise_free_node_block();
+    node = (void*) start_of_free_node_block;
+    CAMLassert(end_of_free_node_block - start_of_free_node_block >= size);
+  }
+
+  start_of_free_node_block += size;
+
+  /* We don't currently rely on [uintnat] alignment, but we do need some
+     alignment, so just be sure. */
+  CAMLassert (((uintnat) node) % sizeof(uintnat) == 0);
+  return Val_hp(node);
+}
+
+static value find_tail_node(value node, void* callee)
+{
+  /* Search the tail chain within [node] (which corresponds to an invocation
+     of a caller of [callee]) to determine whether it contains a tail node
+     corresponding to [callee].  Returns any such node, or [Val_unit] if no
+     such node exists. */
+
+  value starting_node;
+  value pc;
+  value found = Val_unit;
+
+  starting_node = node;
+  pc = Encode_node_pc(callee);
+
+  do {
+    CAMLassert(Is_ocaml_node(node));
+    if (Node_pc(node) == pc) {
+      found = node;
+    }
+    else {
+      node = Tail_link(node);
+    }
+  } while (found == Val_unit && starting_node != node);
+
+  return found;
+}
+
+CAMLprim value caml_spacetime_allocate_node(
+      int size_including_header, void* pc, value* node_hole)
+{
+  value node;
+  value caller_node = Val_unit;
+
+  node = *node_hole;
+  /* The node hole should either contain [Val_unit], indicating that this
+     function was not tail called and we have not been to this point in the
+     trie before; or it should contain a value encoded using
+     [Encoded_tail_caller_node] that points at the node of a caller
+     that tail called the current function.  (Such a value is necessary to
+     be able to find the start of the caller's node, and hence its tail
+     chain, so we as a tail-called callee can link ourselves in.) */
+  CAMLassert(Is_tail_caller_node_encoded(node));
+
+  if (node != Val_unit) {
+    value tail_node;
+    /* The callee was tail called.  Find whether there already exists a node
+       for it in the tail call chain within the caller's node.  The caller's
+       node must always be an OCaml node. */
+    caller_node = Decode_tail_caller_node(node);
+    tail_node = find_tail_node(caller_node, pc);
+    if (tail_node != Val_unit) {
+      /* This tail calling sequence has happened before; just fill the hole
+         with the existing node and return. */
+      *node_hole = tail_node;
+      return 0;  /* indicates an existing node was returned */
+    }
+  }
+
+  node = allocate_uninitialized_ocaml_node(size_including_header);
+  Hd_val(node) =
+    Make_header(size_including_header - 1, OCaml_node_tag, Caml_black);
+  CAMLassert((((uintnat) pc) % 1) == 0);
+  Node_pc(node) = Encode_node_pc(pc);
+  /* If the callee was tail called, then the tail link field will link this
+     new node into an existing tail chain.  Otherwise, it is initialized with
+     the empty tail chain, i.e. the one pointing directly at [node]. */
+  if (caller_node == Val_unit) {
+    Tail_link(node) = node;
+  }
+  else {
+    Tail_link(node) = Tail_link(caller_node);
+    Tail_link(caller_node) = node;
+  }
+
+  /* The callee node pointers for direct tail call points are
+     initialized from code emitted by the OCaml compiler.  This is done to
+     avoid having to pass this function a description of which nodes are
+     direct tail call points.  (We cannot just count them and put them at the
+     beginning of the node because we need the indexes of elements within the
+     node during instruction selection before we have found all call points.)
+
+     All other fields have already been initialised by
+     [reinitialise_free_node_block].
+  */
+
+  *node_hole = node;
+
+  return 1;  /* indicates a new node was created */
+}
+
+static c_node* allocate_c_node(void)
+{
+  c_node* node;
+  size_t index;
+
+  node = (c_node*) start_of_free_node_block;
+  if (end_of_free_node_block - start_of_free_node_block < sizeof(c_node)) {
+    reinitialise_free_node_block();
+    node = (c_node*) start_of_free_node_block;
+    CAMLassert(end_of_free_node_block - start_of_free_node_block
+      >= sizeof(c_node));
+  }
+  start_of_free_node_block += sizeof(c_node);
+
+  CAMLassert((sizeof(c_node) % sizeof(uintnat)) == 0);
+
+  /* CR-soon mshinwell: remove this and pad the structure properly */
+  for (index = 0; index < sizeof(c_node) / sizeof(value); index++) {
+    ((value*) node)[index] = Val_unit;
+  }
+
+  node->gc_header =
+    Make_header(sizeof(c_node)/sizeof(uintnat) - 1, C_node_tag, Caml_black);
+  node->data.call.callee_node = Val_unit;
+  node->data.call.call_count = Val_long(0);
+  node->next = Val_unit;
+
+  return node;
+}
+
+/* Since a given indirect call site either always yields tail calls or
+   always yields non-tail calls, the output of
+   [caml_spacetime_indirect_node_hole_ptr] is uniquely determined by its
+   first two arguments (the callee and the node hole).  We cache these
+   to increase performance of recursive functions containing an indirect
+   call (e.g. [List.map] when not inlined). */
+static void* last_indirect_node_hole_ptr_callee;
+static value* last_indirect_node_hole_ptr_node_hole;
+static call_point* last_indirect_node_hole_ptr_result;
+
+CAMLprim value* caml_spacetime_indirect_node_hole_ptr
+      (void* callee, value* node_hole, value caller_node)
+{
+  /* Find the address of the node hole for an indirect call to [callee].
+     If [caller_node] is not [Val_unit], it is a pointer to the caller's
+     node, and indicates that this is a tail call site. */
+
+  c_node* c_node;
+  value encoded_callee;
+
+  if (callee == last_indirect_node_hole_ptr_callee
+      && node_hole == last_indirect_node_hole_ptr_node_hole) {
+#ifdef ENABLE_CALL_COUNTS
+    last_indirect_node_hole_ptr_result->call_count =
+      Val_long (Long_val (last_indirect_node_hole_ptr_result->call_count) + 1);
+#endif
+    return &(last_indirect_node_hole_ptr_result->callee_node);
+  }
+
+  last_indirect_node_hole_ptr_callee = callee;
+  last_indirect_node_hole_ptr_node_hole = node_hole;
+
+  encoded_callee = Encode_c_node_pc_for_call(callee);
+
+  while (*node_hole != Val_unit) {
+    CAMLassert(((uintnat) *node_hole) % sizeof(value) == 0);
+
+    c_node = caml_spacetime_c_node_of_stored_pointer_not_null(*node_hole);
+
+    CAMLassert(c_node != NULL);
+    CAMLassert(caml_spacetime_classify_c_node(c_node) == CALL);
+
+    if (c_node->pc == encoded_callee) {
+#ifdef ENABLE_CALL_COUNTS
+      c_node->data.call.call_count =
+        Val_long (Long_val(c_node->data.call.call_count) + 1);
+#endif
+      last_indirect_node_hole_ptr_result = &(c_node->data.call);
+      return &(last_indirect_node_hole_ptr_result->callee_node);
+    }
+    else {
+      node_hole = &c_node->next;
+    }
+  }
+
+  c_node = allocate_c_node();
+  c_node->pc = encoded_callee;
+
+  if (caller_node != Val_unit) {
+    /* This is a tail call site.
+       Perform the initialization equivalent to that emitted by
+       [Spacetime.code_for_function_prologue] for direct tail call
+       sites. */
+    c_node->data.call.callee_node = Encode_tail_caller_node(caller_node);
+  }
+
+  *node_hole = caml_spacetime_stored_pointer_of_c_node(c_node);
+
+  CAMLassert(((uintnat) *node_hole) % sizeof(value) == 0);
+  CAMLassert(*node_hole != Val_unit);
+
+#ifdef ENABLE_CALL_COUNTS
+  c_node->data.call.call_count =
+    Val_long (Long_val(c_node->data.call.call_count) + 1);
+#endif
+  last_indirect_node_hole_ptr_result = &(c_node->data.call);
+
+  return &(last_indirect_node_hole_ptr_result->callee_node);
+}
+
+/* Some notes on why caml_call_gc doesn't need a distinguished node.
+   (Remember that thread switches are irrelevant here because each thread
+   has its own trie.)
+
+   caml_call_gc only invokes OCaml functions in the following circumstances:
+   1. running an OCaml finaliser;
+   2. executing an OCaml signal handler;
+   3. executing memprof callbacks.
+   All of these are done on the finaliser trie.  Furthermore, all of
+   these invocations start via caml_callback; the code in this file for
+   handling that (caml_spacetime_c_to_ocaml) correctly copes with that by
+   attaching a single "caml_start_program" node that can cope with any
+   number of indirect OCaml calls from that point.
+
+   caml_call_gc may also invoke C functions that cause allocation.  All of
+   these (assuming libunwind support is present) will cause a chain of
+   c_node structures to be attached to the trie, starting at the node hole
+   passed to caml_call_gc from OCaml code.  These structures are extensible
+   and can thus accommodate any number of C backtraces leading from
+   caml_call_gc.
+*/
+/* CR-soon mshinwell: it might in fact be the case now that nothing called
+   from caml_call_gc will do any allocation that ends up on the trie.  We
+   can revisit this after the first release. */
+
+static NOINLINE void* find_trie_node_from_libunwind(int for_allocation,
+    uintnat wosize, struct ext_table** cached_frames)
+{
+#ifdef HAS_LIBUNWIND
+  /* Given that [Caml_state->last_return_address] is the most recent call site
+     in OCaml code, and that we are now in C (or other) code called from that
+     site, obtain a backtrace using libunwind and graft the most recent
+     portion (everything back to but not including [last_return_address])
+     onto the trie.  See the important comment below regarding the fact that
+     call site, and not callee, addresses are recorded during this process.
+
+     If [for_allocation] is non-zero, the final node recorded will be for
+     an allocation, and the returned pointer is to the allocation node.
+     Otherwise, no node is recorded for the innermost frame, and the
+     returned pointer is a pointer to the *node hole* where a node for that
+     frame should be attached.
+
+     If [for_allocation] is non-zero then [wosize] must give the size in
+     words, excluding the header, of the value being allocated.
+
+     If [cached_frames != NULL] then:
+     1. If [*cached_frames] is NULL then save the captured backtrace in a
+        newly-allocated table and store the pointer to that table in
+        [*cached_frames];
+     2. Otherwise use [*cached_frames] as the unwinding information.
+     The intention is that when the context is known (e.g. a function such
+     as [caml_make_vect] known to have been directly invoked from OCaml),
+     we can avoid expensive calls to libunwind.
+  */
+
+  unw_cursor_t cur;
+  unw_context_t ctx;
+  int ret;
+  int innermost_frame;
+  int frame;
+  static struct ext_table frames_local;
+  struct ext_table* frames;
+  static int ext_table_initialised = 0;
+  int have_frames_already = 0;
+  value* node_hole;
+  c_node* node = NULL;
+  int initial_table_size = 1000;
+  int must_initialise_node_for_allocation = 0;
+
+  if (!cached_frames) {
+    if (!ext_table_initialised) {
+      caml_ext_table_init(&frames_local, initial_table_size);
+      ext_table_initialised = 1;
+    }
+    else {
+      caml_ext_table_clear(&frames_local, 0);
+    }
+    frames = &frames_local;
+  } else {
+    if (*cached_frames) {
+      frames = *cached_frames;
+      have_frames_already = 1;
+    }
+    else {
+      frames =
+        (struct ext_table*) caml_stat_alloc_noexc(sizeof(struct ext_table));
+      if (!frames) {
+        caml_fatal_error("not enough memory for ext_table allocation");
+      }
+      caml_ext_table_init(frames, initial_table_size);
+      *cached_frames = frames;
+    }
+  }
+
+  if (!have_frames_already) {
+    /* Get the stack backtrace as far as [Caml_state->last_return_address]. */
+
+    ret = unw_getcontext(&ctx);
+    if (ret != UNW_ESUCCESS) {
+      return NULL;
+    }
+
+    ret = unw_init_local(&cur, &ctx);
+    if (ret != UNW_ESUCCESS) {
+      return NULL;
+    }
+
+    while ((ret = unw_step(&cur)) > 0) {
+      unw_word_t ip;
+      unw_get_reg(&cur, UNW_REG_IP, &ip);
+      if (Caml_state->last_return_address == (uintnat) ip) {
+        break;
+      }
+      else {
+        /* Inlined some of [caml_ext_table_add] for speed. */
+        if (frames->size < frames->capacity) {
+          frames->contents[frames->size++] = (void*) ip;
+        } else {
+          caml_ext_table_add(frames, (void*) ip);
+        }
+      }
+    }
+  }
+
+  /* We always need to ignore the frames for:
+      #0  find_trie_node_from_libunwind
+      #1  caml_spacetime_c_to_ocaml
+     Further, if this is not an allocation point, we should not create the
+     node for the current C function that triggered us (i.e. frame #2). */
+  innermost_frame = for_allocation ? 1 : 2;
+
+  if (frames->size - 1 < innermost_frame) {
+    /* Insufficiently many frames (maybe no frames) returned from
+       libunwind; just don't do anything. */
+    return NULL;
+  }
+
+  node_hole = caml_spacetime_trie_node_ptr;
+  /* Note that if [node_hole] is filled, then it must point to a C node,
+     since it is not possible for there to be a call point in an OCaml
+     function that sometimes calls C and sometimes calls OCaml. */
+
+  for (frame = frames->size - 1; frame >= innermost_frame; frame--) {
+    c_node_type expected_type;
+    void* pc = frames->contents[frame];
+    CAMLassert (pc != (void*) Caml_state->last_return_address);
+
+    if (!for_allocation) {
+      expected_type = CALL;
+    }
+    else {
+      expected_type = (frame > innermost_frame ? CALL : ALLOCATION);
+    }
+
+    if (*node_hole == Val_unit) {
+      node = allocate_c_node();
+      /* Note: for CALL nodes, the PC is the program counter at each call
+         site.  We do not store program counter addresses of the start of
+         callees, unlike for OCaml nodes.  This means that some trie nodes
+         will become conflated.  These can be split during post-processing by
+         working out which function each call site was in. */
+      node->pc = (expected_type == CALL ? Encode_c_node_pc_for_call(pc)
+        : Encode_c_node_pc_for_alloc_point(pc));
+      *node_hole = caml_spacetime_stored_pointer_of_c_node(node);
+      if (expected_type == ALLOCATION) {
+        must_initialise_node_for_allocation = 1;
+      }
+    }
+    else {
+      c_node* prev;
+      int found = 0;
+
+      node = caml_spacetime_c_node_of_stored_pointer_not_null(*node_hole);
+      CAMLassert(node != NULL);
+      CAMLassert(node->next == Val_unit
+        || (((uintnat) (node->next)) % sizeof(value) == 0));
+
+      prev = NULL;
+
+      while (!found && node != NULL) {
+        if (caml_spacetime_classify_c_node(node) == expected_type
+            && pc_inside_c_node_matches(node, pc)) {
+          found = 1;
+        }
+        else {
+          prev = node;
+          node = caml_spacetime_c_node_of_stored_pointer(node->next);
+        }
+      }
+      if (!found) {
+        CAMLassert(prev != NULL);
+        node = allocate_c_node();
+        node->pc = (expected_type == CALL ? Encode_c_node_pc_for_call(pc)
+          : Encode_c_node_pc_for_alloc_point(pc));
+        if (expected_type == ALLOCATION) {
+          must_initialise_node_for_allocation = 1;
+        }
+        prev->next = caml_spacetime_stored_pointer_of_c_node(node);
+      }
+    }
+
+    CAMLassert(node != NULL);
+
+    CAMLassert(caml_spacetime_classify_c_node(node) == expected_type);
+    CAMLassert(pc_inside_c_node_matches(node, pc));
+    node_hole = &node->data.call.callee_node;
+  }
+
+  if (must_initialise_node_for_allocation) {
+    caml_spacetime_profinfo++;
+    if (caml_spacetime_profinfo > PROFINFO_MASK) {
+      /* Profiling counter overflow. */
+      caml_spacetime_profinfo = PROFINFO_MASK;
+    }
+    node->data.allocation.profinfo =
+      Make_header_with_profinfo(
+        /* "-1" because [c_node] has the GC header as its first
+           element. */
+        offsetof(c_node, data.allocation.count)/sizeof(value) - 1,
+        Infix_tag,
+        Caml_black,
+        caml_spacetime_profinfo);
+    node->data.allocation.count = Val_long(0);
+
+    /* Add the new allocation point into the linked list of all allocation
+       points. */
+    if (caml_all_allocation_points != NULL) {
+      node->data.allocation.next =
+        (value) &caml_all_allocation_points->count;
+    } else {
+      node->data.allocation.next = Val_unit;
+    }
+    caml_all_allocation_points = &node->data.allocation;
+  }
+
+  if (for_allocation) {
+    CAMLassert(caml_spacetime_classify_c_node(node) == ALLOCATION);
+    CAMLassert(caml_spacetime_c_node_of_stored_pointer(node->next) != node);
+    CAMLassert(Profinfo_hd(node->data.allocation.profinfo) > 0);
+    node->data.allocation.count =
+      Val_long(Long_val(node->data.allocation.count) + (1 + wosize));
+  }
+
+  CAMLassert(node->next != (value) NULL);
+
+  return for_allocation ? (void*) node : (void*) node_hole;
+#else
+  return NULL;
+#endif
+}
+
+void caml_spacetime_c_to_ocaml(void* ocaml_entry_point,
+      void* identifying_pc_for_caml_start_program)
+{
+  /* Called in [caml_start_program] and [caml_callback*] when we are about
+     to cross from C into OCaml.  [ocaml_entry_point] is the branch target.
+     This situation is handled by ensuring the presence of a new OCaml node
+     for the callback veneer; the node contains a single indirect call point
+     which accumulates the [ocaml_entry_point]s.
+
+     The layout of the node is described in the "system shape table"; see
+     amd64.S.
+  */
+
+  value node;
+
+  /* Update the trie with the current backtrace, as far back as
+     [Caml_state->last_return_address], and leave the node hole pointer at
+     the correct place for attachment of a [caml_start_program] node. */
+
+#ifdef HAS_LIBUNWIND
+  value* node_temp;
+  node_temp = (value*) find_trie_node_from_libunwind(0, 0, NULL);
+  if (node_temp != NULL) {
+    caml_spacetime_trie_node_ptr = node_temp;
+  }
+#endif
+
+  if (*caml_spacetime_trie_node_ptr == Val_unit) {
+    uintnat size_including_header;
+
+    size_including_header =
+      1 /* GC header */ + Node_num_header_words + Indirect_num_fields;
+
+    node = allocate_uninitialized_ocaml_node(size_including_header);
+    Hd_val(node) =
+      Make_header(size_including_header - 1, OCaml_node_tag, Caml_black);
+    CAMLassert((((uintnat) identifying_pc_for_caml_start_program) % 1) == 0);
+    Node_pc(node) = Encode_node_pc(identifying_pc_for_caml_start_program);
+    Tail_link(node) = node;
+    Indirect_pc_linked_list(node, Node_num_header_words) = Val_unit;
+    *caml_spacetime_trie_node_ptr = node;
+  }
+  else {
+    node = *caml_spacetime_trie_node_ptr;
+    /* If there is a node here already, it should never be an initialized
+       (but as yet unused) tail call point, since calls from OCaml into C
+       are never tail calls (and no C -> C call is marked as tail). */
+    CAMLassert(!Is_tail_caller_node_encoded(node));
+  }
+
+  CAMLassert(Is_ocaml_node(node));
+  CAMLassert(Decode_node_pc(Node_pc(node))
+    == identifying_pc_for_caml_start_program);
+  CAMLassert(Tail_link(node) == node);
+  CAMLassert(Wosize_val(node) == Node_num_header_words + Indirect_num_fields);
+
+  /* Search the node to find the node hole corresponding to the indirect
+     call to the OCaml function. */
+  caml_spacetime_trie_node_ptr =
+    caml_spacetime_indirect_node_hole_ptr(
+      ocaml_entry_point,
+      &Indirect_pc_linked_list(node, Node_num_header_words),
+      Val_unit);
+  CAMLassert(*caml_spacetime_trie_node_ptr == Val_unit
+    || Is_ocaml_node(*caml_spacetime_trie_node_ptr));
+}
+
+extern void caml_garbage_collection(void);  /* signals_nat.c */
+extern void caml_array_bound_error(void);  /* fail.c */
+
+CAMLprim uintnat caml_spacetime_generate_profinfo (void* profinfo_words,
+                                                   uintnat index_within_node)
+{
+  /* Called from code that creates a value's header inside an OCaml
+     function. */
+
+  value node;
+  uintnat profinfo;
+
+  caml_spacetime_profinfo++;
+  if (caml_spacetime_profinfo > PROFINFO_MASK) {
+    /* Profiling counter overflow. */
+    caml_spacetime_profinfo = PROFINFO_MASK;
+  }
+  profinfo = caml_spacetime_profinfo;
+
+  /* CR-someday mshinwell: we could always use the [struct allocation_point]
+     overlay instead of the macros now. */
+
+  /* [node] isn't really a node; it points into the middle of
+     one---specifically to the "profinfo" word of an allocation point.
+     It's done like this to avoid re-calculating the place in the node
+     (which already has to be done in the OCaml-generated code run before
+     this function). */
+  node = (value) profinfo_words;
+  CAMLassert(Alloc_point_profinfo(node, 0) == Val_unit);
+
+  /* The profinfo value is stored shifted to reduce the number of
+     instructions required on the OCaml side.  It also enables us to use
+     [Infix_tag] to obtain valid value pointers into the middle of nodes,
+     which is used for the linked list of all allocation points. */
+  profinfo = Make_header_with_profinfo(
+    index_within_node, Infix_tag, Caml_black, profinfo);
+
+  CAMLassert(!Is_block(profinfo));
+  Alloc_point_profinfo(node, 0) = profinfo;
+  /* The count is set to zero by the initialisation when the node was
+     created (see above). */
+  CAMLassert(Alloc_point_count(node, 0) == Val_long(0));
+
+  /* Add the new allocation point into the linked list of all allocation
+     points. */
+  if (caml_all_allocation_points != NULL) {
+    Alloc_point_next_ptr(node, 0) = (value) &caml_all_allocation_points->count;
+  }
+  else {
+    CAMLassert(Alloc_point_next_ptr(node, 0) == Val_unit);
+  }
+  caml_all_allocation_points = (allocation_point*) node;
+
+  return profinfo;
+}
+
+uintnat caml_spacetime_my_profinfo (struct ext_table** cached_frames,
+                                    uintnat wosize)
+{
+  /* Return the profinfo value that should be written into a value's header
+     during an allocation from C.  This may necessitate extending the trie
+     with information obtained from libunwind. */
+
+  c_node* node;
+  uintnat profinfo = 0;
+
+  node = find_trie_node_from_libunwind(1, wosize, cached_frames);
+  if (node != NULL) {
+    profinfo = ((uintnat) (node->data.allocation.profinfo)) >> PROFINFO_SHIFT;
+  }
+
+  return profinfo;  /* N.B. not shifted by PROFINFO_SHIFT */
+}
+
+void caml_spacetime_automatic_snapshot (void)
+{
+  if (automatic_snapshots) {
+    double start_time, end_time;
+    start_time = caml_sys_time_unboxed(Val_unit);
+    if (start_time >= next_snapshot_time) {
+      maybe_reopen_snapshot_channel();
+      caml_spacetime_save_snapshot(snapshot_channel, 0.0, 0);
+      end_time = caml_sys_time_unboxed(Val_unit);
+      next_snapshot_time = end_time + snapshot_interval;
+    }
+  }
+}
+
+CAMLprim value caml_spacetime_save_event_for_automatic_snapshots
+  (value v_event_name)
+{
+  if (automatic_snapshots) {
+    maybe_reopen_snapshot_channel();
+    caml_spacetime_save_event_internal (Val_unit, snapshot_channel,
+                                        v_event_name);
+  }
+  return Val_unit;
+}
+
+void caml_spacetime_automatic_save (void)
+{
+  /* Called from [atexit]. */
+
+  if (automatic_snapshots) {
+    automatic_snapshots = 0;
+    maybe_reopen_snapshot_channel();
+    save_trie(snapshot_channel, 0.0, 0);
+    caml_flush(snapshot_channel);
+    caml_close_channel(snapshot_channel);
+  }
+}
+
+CAMLprim value caml_spacetime_enabled (value v_unit)
+{
+  return Val_true;
+}
+
+CAMLprim value caml_register_channel_for_spacetime (value v_channel)
+{
+  struct channel* channel = Channel(v_channel);
+  channel->flags |= CHANNEL_FLAG_BLOCKING_WRITE;
+  return Val_unit;
+}
+
+#else
+
+/* Functions for when the compiler was not configured with "-spacetime". */
+
+CAMLprim value caml_spacetime_write_magic_number(value v_channel)
+{
+  return Val_unit;
+}
+
+CAMLprim value caml_spacetime_enabled (value v_unit)
+{
+  return Val_false;
+}
+
+CAMLprim value caml_spacetime_save_event (value v_time_opt,
+                                          value v_channel,
+                                          value v_event_name)
+{
+  return Val_unit;
+}
+
+CAMLprim value caml_spacetime_save_event_for_automatic_snapshots
+  (value v_event_name)
+{
+  return Val_unit;
+}
+
+CAMLprim value caml_spacetime_save_trie (value ignored)
+{
+  return Val_unit;
+}
+
+CAMLprim value caml_register_channel_for_spacetime (value v_channel)
+{
+  return Val_unit;
+}
+
+#endif
diff --git a/runtime/spacetime_snapshot.c b/runtime/spacetime_snapshot.c
new file mode 100644
index 00000000..4ce31ceb
--- /dev/null
+++ b/runtime/spacetime_snapshot.c
@@ -0,0 +1,600 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*            Mark Shinwell and Leo White, Jane Street Europe             */
+/*                                                                        */
+/*   Copyright 2013--2016, 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#define CAML_INTERNALS
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include <math.h>
+
+#include "caml/alloc.h"
+#include "caml/backtrace_prim.h"
+#include "caml/config.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/gc.h"
+#include "caml/gc_ctrl.h"
+#include "caml/intext.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/signals.h"
+#include "caml/stack.h"
+#include "caml/sys.h"
+#include "caml/spacetime.h"
+
+#ifdef WITH_SPACETIME
+
+/* The following structures must match the type definitions in the
+   [Spacetime] module. */
+
+typedef struct {
+  /* (GC header here.) */
+  value minor_words;
+  value promoted_words;
+  value major_words;
+  value minor_collections;
+  value major_collections;
+  value heap_words;
+  value heap_chunks;
+  value compactions;
+  value top_heap_words;
+} gc_stats;
+
+typedef struct {
+  value profinfo;
+  value num_blocks;
+  value num_words_including_headers;
+} snapshot_entry;
+
+typedef struct {
+  /* (GC header here.) */
+  snapshot_entry entries[0];
+} snapshot_entries;
+
+typedef struct {
+  /* (GC header here.) */
+  value time;
+  value gc_stats;
+  value entries;
+  value words_scanned;
+  value words_scanned_with_profinfo;
+  value total_allocations;
+} snapshot;
+
+typedef struct {
+  uintnat num_blocks;
+  uintnat num_words_including_headers;
+} raw_snapshot_entry;
+
+static value allocate_outside_heap_with_tag(mlsize_t size_in_bytes, tag_t tag)
+{
+  /* CR-soon mshinwell: this function should live somewhere else */
+  header_t* block;
+
+  CAMLassert(size_in_bytes % sizeof(value) == 0);
+  block = caml_stat_alloc(sizeof(header_t) + size_in_bytes);
+  *block = Make_header(size_in_bytes / sizeof(value), tag, Caml_black);
+  return (value) &block[1];
+}
+
+static value allocate_outside_heap(mlsize_t size_in_bytes)
+{
+  CAMLassert(size_in_bytes > 0);
+  return allocate_outside_heap_with_tag(size_in_bytes, 0);
+}
+
+static value take_gc_stats(void)
+{
+  value v_stats;
+  gc_stats* stats;
+
+  v_stats = allocate_outside_heap(sizeof(gc_stats));
+  stats = (gc_stats*) v_stats;
+
+  stats->minor_words = Val_long(Caml_state->stat_minor_words);
+  stats->promoted_words = Val_long(Caml_state->stat_promoted_words);
+  stats->major_words =
+    Val_long(((uintnat) Caml_state->stat_major_words)
+             + ((uintnat) caml_allocated_words));
+  stats->minor_collections = Val_long(Caml_state->stat_minor_collections);
+  stats->major_collections = Val_long(Caml_state->stat_major_collections);
+  stats->heap_words = Val_long(Caml_state->stat_heap_wsz / sizeof(value));
+  stats->heap_chunks = Val_long(Caml_state->stat_heap_chunks);
+  stats->compactions = Val_long(Caml_state->stat_compactions);
+  stats->top_heap_words =
+    Val_long(Caml_state->stat_top_heap_wsz / sizeof(value));
+
+  return v_stats;
+}
+
+static value get_total_allocations(void)
+{
+  value v_total_allocations = Val_unit;
+  allocation_point* total = caml_all_allocation_points;
+
+  while (total != NULL) {
+    value v_total;
+    v_total = allocate_outside_heap_with_tag(3 * sizeof(value), 0);
+
+    /* [v_total] is of type [Raw_spacetime_lib.total_allocations]. */
+    Field(v_total, 0) = Val_long(Profinfo_hd(total->profinfo));
+    Field(v_total, 1) = total->count;
+    Field(v_total, 2) = v_total_allocations;
+    v_total_allocations = v_total;
+
+    CAMLassert (total->next == Val_unit
+      || (Is_block(total->next) && Tag_val(total->next) == Infix_tag));
+    if (total->next == Val_unit) {
+      total = NULL;
+    }
+    else {
+      total = (allocation_point*) Hp_val(total->next);
+    }
+  }
+
+  return v_total_allocations;
+}
+
+static value take_snapshot(double time_override, int use_time_override)
+{
+  value v_snapshot;
+  snapshot* heap_snapshot;
+  value v_entries;
+  snapshot_entries* entries;
+  char* chunk;
+  value gc_stats;
+  uintnat index;
+  uintnat target_index;
+  value v_time;
+  double time;
+  uintnat profinfo;
+  uintnat num_distinct_profinfos;
+  /* Fixed size buffer to avoid needing a hash table: */
+  static raw_snapshot_entry* raw_entries = NULL;
+  uintnat words_scanned = 0;
+  uintnat words_scanned_with_profinfo = 0;
+  value v_total_allocations;
+
+  if (!use_time_override) {
+    time = caml_sys_time_unboxed(Val_unit);
+  }
+  else {
+    time = time_override;
+  }
+
+  gc_stats = take_gc_stats();
+
+  if (raw_entries == NULL) {
+    size_t size = (PROFINFO_MASK + 1) * sizeof(raw_snapshot_entry);
+    raw_entries = caml_stat_alloc(size);
+    memset(raw_entries, '\0', size);
+  } else {
+    size_t size = (PROFINFO_MASK + 1) * sizeof(raw_snapshot_entry);
+    memset(raw_entries, '\0', size);
+  }
+
+  num_distinct_profinfos = 0;
+
+  /* CR-someday mshinwell: consider reintroducing minor heap scanning,
+     properly from roots, which would then give a snapshot function
+     that doesn't do a minor GC.  Although this may not be that important
+     and potentially not worth the effort (it's quite tricky). */
+
+  /* Scan the major heap. */
+  chunk = caml_heap_start;
+  while (chunk != NULL) {
+    char* hp;
+    char* limit;
+
+    hp = chunk;
+    limit = chunk + Chunk_size (chunk);
+
+    while (hp < limit) {
+      header_t hd = Hd_hp (hp);
+      switch (Color_hd(hd)) {
+        case Caml_blue:
+          break;
+
+        default:
+          if (Wosize_hd(hd) > 0) { /* ignore atoms */
+            profinfo = Profinfo_hd(hd);
+            words_scanned += Whsize_hd(hd);
+            if (profinfo > 0 && profinfo < PROFINFO_MASK) {
+              words_scanned_with_profinfo += Whsize_hd(hd);
+              CAMLassert (raw_entries[profinfo].num_blocks >= 0);
+              if (raw_entries[profinfo].num_blocks == 0) {
+                num_distinct_profinfos++;
+              }
+              raw_entries[profinfo].num_blocks++;
+              raw_entries[profinfo].num_words_including_headers +=
+                Whsize_hd(hd);
+            }
+          }
+          break;
+      }
+      hp += Bhsize_hd (hd);
+      CAMLassert (hp <= limit);
+    }
+
+    chunk = Chunk_next (chunk);
+  }
+
+  if (num_distinct_profinfos > 0) {
+    v_entries = allocate_outside_heap(
+      num_distinct_profinfos*sizeof(snapshot_entry));
+    entries = (snapshot_entries*) v_entries;
+    target_index = 0;
+    for (index = 0; index <= PROFINFO_MASK; index++) {
+      CAMLassert(raw_entries[index].num_blocks >= 0);
+      if (raw_entries[index].num_blocks > 0) {
+        CAMLassert(target_index < num_distinct_profinfos);
+        entries->entries[target_index].profinfo = Val_long(index);
+        entries->entries[target_index].num_blocks
+          = Val_long(raw_entries[index].num_blocks);
+        entries->entries[target_index].num_words_including_headers
+          = Val_long(raw_entries[index].num_words_including_headers);
+        target_index++;
+      }
+    }
+  } else {
+    v_entries = Atom(0);
+  }
+
+  CAMLassert(sizeof(double) == sizeof(value));
+  v_time = allocate_outside_heap_with_tag(sizeof(double), Double_tag);
+  Store_double_val(v_time, time);
+
+  v_snapshot = allocate_outside_heap(sizeof(snapshot));
+  heap_snapshot = (snapshot*) v_snapshot;
+
+  v_total_allocations = get_total_allocations();
+
+  heap_snapshot->time = v_time;
+  heap_snapshot->gc_stats = gc_stats;
+  heap_snapshot->entries = v_entries;
+  heap_snapshot->words_scanned
+    = Val_long(words_scanned);
+  heap_snapshot->words_scanned_with_profinfo
+    = Val_long(words_scanned_with_profinfo);
+  heap_snapshot->total_allocations = v_total_allocations;
+
+  return v_snapshot;
+}
+
+void caml_spacetime_save_snapshot (struct channel *chan, double time_override,
+                                   int use_time_override)
+{
+  value v_snapshot;
+  value v_total_allocations;
+  snapshot* heap_snapshot;
+
+  Lock(chan);
+
+  v_snapshot = take_snapshot(time_override, use_time_override);
+
+  caml_output_val(chan, Val_long(0), Val_long(0));
+
+  caml_extern_allow_out_of_heap = 1;
+  caml_output_val(chan, v_snapshot, Val_long(0));
+  caml_extern_allow_out_of_heap = 0;
+
+  Unlock(chan);
+
+  heap_snapshot = (snapshot*) v_snapshot;
+  caml_stat_free(Hp_val(heap_snapshot->time));
+  caml_stat_free(Hp_val(heap_snapshot->gc_stats));
+  if (Wosize_val(heap_snapshot->entries) > 0) {
+    caml_stat_free(Hp_val(heap_snapshot->entries));
+  }
+  v_total_allocations = heap_snapshot->total_allocations;
+  while (v_total_allocations != Val_unit) {
+    value next = Field(v_total_allocations, 2);
+    caml_stat_free(Hp_val(v_total_allocations));
+    v_total_allocations = next;
+  }
+
+  caml_stat_free(Hp_val(v_snapshot));
+}
+
+CAMLprim value caml_spacetime_take_snapshot(value v_time_opt, value v_channel)
+{
+  struct channel * channel = Channel(v_channel);
+  double time_override = 0.0;
+  int use_time_override = 0;
+
+  if (Is_block(v_time_opt)) {
+    time_override = Double_field(Field(v_time_opt, 0), 0);
+    use_time_override = 1;
+  }
+
+  caml_spacetime_save_snapshot(channel, time_override, use_time_override);
+
+  return Val_unit;
+}
+
+extern struct custom_operations caml_int64_ops;  /* ints.c */
+
+static value
+allocate_int64_outside_heap(uint64_t i)
+{
+  value v;
+
+  v = allocate_outside_heap_with_tag(2 * sizeof(value), Custom_tag);
+  Custom_ops_val(v) = &caml_int64_ops;
+  Int64_val(v) = i;
+
+  return v;
+}
+
+static value
+copy_string_outside_heap(char const *s)
+{
+  int len;
+  mlsize_t wosize, offset_index;
+  value result;
+
+  len = strlen(s);
+  wosize = (len + sizeof (value)) / sizeof (value);
+  result = allocate_outside_heap_with_tag(wosize * sizeof(value), String_tag);
+
+  Field (result, wosize - 1) = 0;
+  offset_index = Bsize_wsize (wosize) - 1;
+  Byte (result, offset_index) = offset_index - len;
+  memmove(Bytes_val(result), s, len);
+
+  return result;
+}
+
+static value
+allocate_loc_outside_heap(struct caml_loc_info li)
+{
+  value result;
+
+  if (li.loc_valid) {
+    result = allocate_outside_heap_with_tag(5 * sizeof(value), 0);
+    Field(result, 0) = Val_bool(li.loc_is_raise);
+    Field(result, 1) = copy_string_outside_heap(li.loc_filename);
+    Field(result, 2) = Val_int(li.loc_lnum);
+    Field(result, 3) = Val_int(li.loc_startchr);
+    Field(result, 4) = Val_int(li.loc_endchr);
+  } else {
+    result = allocate_outside_heap_with_tag(sizeof(value), 1);
+    Field(result, 0) = Val_bool(li.loc_is_raise);
+  }
+
+  return result;
+}
+
+value caml_spacetime_timestamp(double time_override, int use_time_override)
+{
+  double time;
+  value v_time;
+
+  if (!use_time_override) {
+    time = caml_sys_time_unboxed(Val_unit);
+  }
+  else {
+    time = time_override;
+  }
+
+  v_time = allocate_outside_heap_with_tag(sizeof(double), Double_tag);
+  Store_double_val(v_time, time);
+
+  return v_time;
+}
+
+value caml_spacetime_frame_table(void)
+{
+  /* Flatten the frame table into a single associative list. */
+
+  value list = Val_long(0);  /* the empty list */
+  uintnat i;
+
+  if (!caml_debug_info_available()) {
+    return list;
+  }
+
+  if (caml_frame_descriptors == NULL) {
+    caml_init_frame_descriptors();
+  }
+
+  for (i = 0; i <= caml_frame_descriptors_mask; i++) {
+    frame_descr* descr = caml_frame_descriptors[i];
+    if (descr != NULL) {
+      value location, return_address, pair, new_list_element, location_list;
+      struct caml_loc_info li;
+      debuginfo dbg;
+      if (descr->frame_size != 0xffff) {
+        dbg = caml_debuginfo_extract(descr);
+        if (dbg != NULL) {
+          location_list = Val_unit;
+          while (dbg != NULL) {
+            value list_element;
+
+            caml_debuginfo_location(dbg, &li);
+            location = allocate_loc_outside_heap(li);
+
+            list_element =
+              allocate_outside_heap_with_tag(2 * sizeof(value), 0 /* (::) */);
+            Field(list_element, 0) = location;
+            Field(list_element, 1) = location_list;
+            location_list = list_element;
+
+            dbg = caml_debuginfo_next(dbg);
+          }
+
+          return_address = allocate_int64_outside_heap(descr->retaddr);
+          pair = allocate_outside_heap_with_tag(2 * sizeof(value), 0);
+          Field(pair, 0) = return_address;
+          Field(pair, 1) = location_list;
+
+          new_list_element =
+            allocate_outside_heap_with_tag(2 * sizeof(value), 0 /* (::) */);
+          Field(new_list_element, 0) = pair;
+          Field(new_list_element, 1) = list;
+          list = new_list_element;
+        }
+      }
+    }
+  }
+
+  return list;
+}
+
+static void add_unit_to_shape_table(uint64_t *unit_table, value *list)
+{
+  /* This function reverses the order of the lists giving the layout of each
+     node; however, spacetime_profiling.ml ensures they are emitted in
+     reverse order, so at the end of it all they're not reversed. */
+
+  uint64_t* ptr = unit_table;
+
+  while (*ptr != (uint64_t) 0) {
+    value new_list_element, pair, function_address, layout;
+
+    function_address =
+      allocate_int64_outside_heap(*ptr++);
+
+    layout = Val_long(0);  /* the empty list */
+    while (*ptr != (uint64_t) 0) {
+      int tag;
+      int stored_tag;
+      value part_of_shape;
+      value new_part_list_element;
+      value location;
+      int has_extra_argument = 0;
+
+      stored_tag = *ptr++;
+      /* CR-soon mshinwell: share with emit.mlp */
+      switch (stored_tag) {
+        case 1:  /* direct call to given location */
+          tag = 0;
+          has_extra_argument = 1;  /* the address of the callee */
+          break;
+
+        case 2:  /* indirect call to given location */
+          tag = 1;
+          break;
+
+        case 3:  /* allocation at given location */
+          tag = 2;
+          break;
+
+        default:
+          CAMLassert(0);
+          abort();  /* silence compiler warning */
+      }
+
+      location = allocate_int64_outside_heap(*ptr++);
+
+      part_of_shape = allocate_outside_heap_with_tag(
+        sizeof(value) * (has_extra_argument ? 2 : 1), tag);
+      Field(part_of_shape, 0) = location;
+      if (has_extra_argument) {
+        Field(part_of_shape, 1) =
+          allocate_int64_outside_heap(*ptr++);
+      }
+
+      new_part_list_element =
+        allocate_outside_heap_with_tag(2 * sizeof(value), 0 /* (::) */);
+      Field(new_part_list_element, 0) = part_of_shape;
+      Field(new_part_list_element, 1) = layout;
+      layout = new_part_list_element;
+    }
+
+    pair = allocate_outside_heap_with_tag(2 * sizeof(value), 0);
+    Field(pair, 0) = function_address;
+    Field(pair, 1) = layout;
+
+    new_list_element =
+      allocate_outside_heap_with_tag(2 * sizeof(value), 0 /* (::) */);
+    Field(new_list_element, 0) = pair;
+    Field(new_list_element, 1) = *list;
+    *list = new_list_element;
+
+    ptr++;
+  }
+}
+
+value caml_spacetime_shape_table(void)
+{
+  value list;
+  uint64_t* unit_table;
+  shape_table *dynamic_table;
+  uint64_t** static_table;
+
+  /* Flatten the hierarchy of shape tables into a single associative list
+     mapping from function symbols to node layouts.  The node layouts are
+     themselves lists. */
+
+  list = Val_long(0);  /* the empty list */
+
+  /* Add static shape tables */
+  static_table = caml_spacetime_static_shape_tables;
+  while (*static_table != (uint64_t) 0) {
+    unit_table = *static_table++;
+    add_unit_to_shape_table(unit_table, &list);
+  }
+
+  /* Add dynamic shape tables */
+  dynamic_table = caml_spacetime_dynamic_shape_tables;
+
+  while (dynamic_table != NULL) {
+    unit_table = dynamic_table->table;
+    add_unit_to_shape_table(unit_table, &list);
+    dynamic_table = dynamic_table->next;
+  }
+
+  return list;
+}
+
+#else
+
+static value spacetime_disabled()
+{
+  caml_failwith("Spacetime profiling not enabled");
+}
+
+CAMLprim value caml_spacetime_take_snapshot(value ignored)
+{
+  return Val_unit;
+}
+
+CAMLprim value caml_spacetime_marshal_frame_table ()
+{
+  return spacetime_disabled();
+}
+
+CAMLprim value caml_spacetime_frame_table ()
+{
+  return spacetime_disabled();
+}
+
+CAMLprim value caml_spacetime_marshal_shape_table ()
+{
+  return spacetime_disabled();
+}
+
+CAMLprim value caml_spacetime_shape_table ()
+{
+  return spacetime_disabled();
+}
+
+#endif
diff --git a/runtime/stacks.c b/runtime/stacks.c
new file mode 100644
index 00000000..2e3be6a0
--- /dev/null
+++ b/runtime/stacks.c
@@ -0,0 +1,117 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* To initialize and resize the stacks */
+
+#include <string.h>
+#include "caml/config.h"
+#include "caml/fail.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/stacks.h"
+
+value caml_global_data = 0;
+
+uintnat caml_max_stack_size;            /* also used in gc_ctrl.c */
+
+void caml_init_stack (uintnat initial_max_size)
+{
+  Caml_state->stack_low = (value *) caml_stat_alloc(Stack_size);
+  Caml_state->stack_high = Caml_state->stack_low + Stack_size / sizeof (value);
+  Caml_state->stack_threshold =
+    Caml_state->stack_low + Stack_threshold / sizeof (value);
+  Caml_state->extern_sp = Caml_state->stack_high;
+  Caml_state->trapsp = Caml_state->stack_high;
+  Caml_state->trap_barrier = Caml_state->stack_high + 1;
+  caml_max_stack_size = initial_max_size;
+  caml_gc_message (0x08, "Initial stack limit: %"
+                   ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
+                   caml_max_stack_size / 1024 * sizeof (value));
+}
+
+void caml_realloc_stack(asize_t required_space)
+{
+  asize_t size;
+  value * new_low, * new_high, * new_sp;
+  value * p;
+
+  CAMLassert(Caml_state->extern_sp >= Caml_state->stack_low);
+  size = Caml_state->stack_high - Caml_state->stack_low;
+  do {
+    if (size >= caml_max_stack_size) caml_raise_stack_overflow();
+    size *= 2;
+  } while (size < Caml_state->stack_high - Caml_state->extern_sp
+                  + required_space);
+  caml_gc_message (0x08, "Growing stack to %"
+                         ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
+                   (uintnat) size * sizeof(value) / 1024);
+  new_low = (value *) caml_stat_alloc(size * sizeof(value));
+  new_high = new_low + size;
+
+#define shift(ptr) \
+    ((char *) new_high - ((char *) Caml_state->stack_high - (char *) (ptr)))
+
+  new_sp = (value *) shift(Caml_state->extern_sp);
+  memmove((char *) new_sp,
+          (char *) Caml_state->extern_sp,
+          (Caml_state->stack_high - Caml_state->extern_sp) * sizeof(value));
+  caml_stat_free(Caml_state->stack_low);
+  Caml_state->trapsp = (value *) shift(Caml_state->trapsp);
+  Caml_state->trap_barrier = (value *) shift(Caml_state->trap_barrier);
+  for (p = Caml_state->trapsp; p < new_high; p = Trap_link(p))
+    Trap_link(p) = (value *) shift(Trap_link(p));
+  Caml_state->stack_low = new_low;
+  Caml_state->stack_high = new_high;
+  Caml_state->stack_threshold =
+    Caml_state->stack_low + Stack_threshold / sizeof (value);
+  Caml_state->extern_sp = new_sp;
+
+#undef shift
+}
+
+CAMLprim value caml_ensure_stack_capacity(value required_space)
+{
+  asize_t req = Long_val(required_space);
+  if (Caml_state->extern_sp - req < Caml_state->stack_low)
+    caml_realloc_stack(req);
+  return Val_unit;
+}
+
+void caml_change_max_stack_size (uintnat new_max_size)
+{
+  asize_t size = Caml_state->stack_high - Caml_state->extern_sp
+                 + Stack_threshold / sizeof (value);
+
+  if (new_max_size < size) new_max_size = size;
+  if (new_max_size != caml_max_stack_size){
+    caml_gc_message (0x08, "Changing stack limit to %"
+                     ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
+                     new_max_size * sizeof (value) / 1024);
+  }
+  caml_max_stack_size = new_max_size;
+}
+
+CAMLexport uintnat (*caml_stack_usage_hook)(void) = NULL;
+
+uintnat caml_stack_usage(void)
+{
+  uintnat sz;
+  sz = Caml_state->stack_high - Caml_state->extern_sp;
+  if (caml_stack_usage_hook != NULL)
+    sz += (*caml_stack_usage_hook)();
+  return sz;
+}
diff --git a/runtime/startup_aux.c b/runtime/startup_aux.c
new file mode 100644
index 00000000..5db9f480
--- /dev/null
+++ b/runtime/startup_aux.c
@@ -0,0 +1,204 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, 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
+
+/* Some runtime initialization functions that are common to bytecode
+   and native code. */
+
+#include <stdio.h>
+#include "caml/backtrace.h"
+#include "caml/memory.h"
+#include "caml/callback.h"
+#include "caml/major_gc.h"
+#ifndef NATIVE_CODE
+#include "caml/dynlink.h"
+#endif
+#include "caml/osdeps.h"
+#include "caml/startup_aux.h"
+#include "caml/memprof.h"
+
+
+#ifdef _WIN32
+extern void caml_win32_unregister_overflow_detection (void);
+#endif
+
+CAMLexport header_t *caml_atom_table = NULL;
+
+/* Initialize the atom table */
+void caml_init_atom_table(void)
+{
+  caml_stat_block b;
+  int i;
+
+  /* PR#9128: We need to give the atom table its own page to make sure
+     it does not share a page with a non-value, which would break code
+     which depend on the correctness of the page table. For example,
+     if the atom table shares a page with bytecode, then functions in
+     the runtime may decide to follow a code pointer in a closure, as
+     if it were a pointer to a value.
+
+     We add 1 padding at the end of the atom table because the atom
+     pointer actually points to the word *following* the corresponding
+     entry in the table (the entry is an empty block *header*).
+  */
+  asize_t request = (256 + 1) * sizeof(header_t);
+  request = (request + Page_size - 1) / Page_size * Page_size;
+  caml_atom_table =
+    caml_stat_alloc_aligned_noexc(request, 0, &b);
+
+  for(i = 0; i < 256; i++) {
+#ifdef NATIVE_CODE
+    caml_atom_table[i] = Make_header_allocated_here(0, i, Caml_white);
+#else
+    caml_atom_table[i] = Make_header(0, i, Caml_white);
+#endif
+  }
+  if (caml_page_table_add(In_static_data,
+                          caml_atom_table, caml_atom_table + 256 + 1) != 0) {
+    caml_fatal_error("not enough memory for initial page table");
+  }
+}
+
+
+/* Parse the OCAMLRUNPARAM environment variable. */
+
+uintnat caml_init_percent_free = Percent_free_def;
+uintnat caml_init_max_percent_free = Max_percent_free_def;
+uintnat caml_init_minor_heap_wsz = Minor_heap_def;
+uintnat caml_init_heap_chunk_sz = Heap_chunk_def;
+uintnat caml_init_heap_wsz = Init_heap_def;
+uintnat caml_init_max_stack_wsz = Max_stack_def;
+uintnat caml_init_major_window = Major_window_def;
+uintnat caml_init_custom_major_ratio = Custom_major_ratio_def;
+uintnat caml_init_custom_minor_ratio = Custom_minor_ratio_def;
+uintnat caml_init_custom_minor_max_bsz = Custom_minor_max_bsz_def;
+extern int caml_parser_trace;
+uintnat caml_trace_level = 0;
+int caml_cleanup_on_exit = 0;
+
+
+static void scanmult (char_os *opt, uintnat *var)
+{
+  char_os mult = ' ';
+  unsigned int val = 1;
+  sscanf_os (opt, T("=%u%c"), &val, &mult);
+  sscanf_os (opt, T("=0x%x%c"), &val, &mult);
+  switch (mult) {
+  case 'k':   *var = (uintnat) val * 1024; break;
+  case 'M':   *var = (uintnat) val * (1024 * 1024); break;
+  case 'G':   *var = (uintnat) val * (1024 * 1024 * 1024); break;
+  default:    *var = (uintnat) val; break;
+  }
+}
+
+void caml_parse_ocamlrunparam(void)
+{
+  char_os *opt = caml_secure_getenv (T("OCAMLRUNPARAM"));
+  uintnat p;
+
+  if (opt == NULL) opt = caml_secure_getenv (T("CAMLRUNPARAM"));
+
+  if (opt != NULL){
+    while (*opt != '\0'){
+      switch (*opt++){
+      case 'a': scanmult (opt, &p); caml_set_allocation_policy ((intnat) p);
+        break;
+      case 'b': scanmult (opt, &p); caml_record_backtrace(Val_bool (p));
+        break;
+      case 'c': scanmult (opt, &p); caml_cleanup_on_exit = (p != 0); break;
+      case 'h': scanmult (opt, &caml_init_heap_wsz); break;
+      case 'H': scanmult (opt, &caml_use_huge_pages); break;
+      case 'i': scanmult (opt, &caml_init_heap_chunk_sz); break;
+      case 'l': scanmult (opt, &caml_init_max_stack_wsz); break;
+      case 'M': scanmult (opt, &caml_init_custom_major_ratio); break;
+      case 'm': scanmult (opt, &caml_init_custom_minor_ratio); break;
+      case 'n': scanmult (opt, &caml_init_custom_minor_max_bsz); break;
+      case 'o': scanmult (opt, &caml_init_percent_free); break;
+      case 'O': scanmult (opt, &caml_init_max_percent_free); break;
+      case 'p': scanmult (opt, &p); caml_parser_trace = (p != 0); break;
+      case 'R': break; /*  see stdlib/hashtbl.mli */
+      case 's': scanmult (opt, &caml_init_minor_heap_wsz); break;
+      case 't': scanmult (opt, &caml_trace_level); break;
+      case 'v': scanmult (opt, &caml_verb_gc); break;
+      case 'w': scanmult (opt, &caml_init_major_window); break;
+      case 'W': scanmult (opt, &caml_runtime_warnings); break;
+      }
+      while (*opt != '\0'){
+        if (*opt++ == ',') break;
+      }
+    }
+  }
+}
+
+
+/* The number of outstanding calls to caml_startup */
+static int startup_count = 0;
+
+/* Has the runtime been shut down already? */
+static int shutdown_happened = 0;
+
+
+int caml_startup_aux(int pooling)
+{
+  if (shutdown_happened == 1)
+    caml_fatal_error("caml_startup was called after the runtime "
+                     "was shut down with caml_shutdown");
+
+  /* Second and subsequent calls are ignored,
+     since the runtime has already started */
+  startup_count++;
+  if (startup_count > 1)
+    return 0;
+
+  if (pooling)
+    caml_stat_create_pool();
+
+  return 1;
+}
+
+static void call_registered_value(char* name)
+{
+  const value *f = caml_named_value(name);
+  if (f != NULL)
+    caml_callback_exn(*f, Val_unit);
+}
+
+CAMLexport void caml_shutdown(void)
+{
+  if (startup_count <= 0)
+    caml_fatal_error("a call to caml_shutdown has no "
+                     "corresponding call to caml_startup");
+
+  /* Do nothing unless it's the last call remaining */
+  startup_count--;
+  if (startup_count > 0)
+    return;
+
+  call_registered_value("Pervasives.do_at_exit");
+  call_registered_value("Thread.at_shutdown");
+  caml_finalise_heap();
+  caml_memprof_shutdown();
+  caml_free_locale();
+#ifndef NATIVE_CODE
+  caml_free_shared_libs();
+#endif
+  caml_stat_destroy_pool();
+#if defined(_WIN32) && defined(NATIVE_CODE)
+  caml_win32_unregister_overflow_detection();
+#endif
+
+  shutdown_happened = 1;
+}
diff --git a/runtime/startup_byt.c b/runtime/startup_byt.c
new file mode 100644
index 00000000..60ffea77
--- /dev/null
+++ b/runtime/startup_byt.c
@@ -0,0 +1,578 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, 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
+
+/* Start-up code */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <fcntl.h>
+#include "caml/config.h"
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#ifdef _WIN32
+#include <process.h>
+#endif
+#include "caml/alloc.h"
+#include "caml/backtrace.h"
+#include "caml/callback.h"
+#include "caml/custom.h"
+#include "caml/debugger.h"
+#include "caml/domain.h"
+#include "caml/dynlink.h"
+#include "caml/eventlog.h"
+#include "caml/exec.h"
+#include "caml/fail.h"
+#include "caml/fix_code.h"
+#include "caml/freelist.h"
+#include "caml/gc_ctrl.h"
+#include "caml/instrtrace.h"
+#include "caml/interp.h"
+#include "caml/intext.h"
+#include "caml/io.h"
+#include "caml/memory.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/osdeps.h"
+#include "caml/prims.h"
+#include "caml/printexc.h"
+#include "caml/reverse.h"
+#include "caml/signals.h"
+#include "caml/stacks.h"
+#include "caml/sys.h"
+#include "caml/startup.h"
+#include "caml/startup_aux.h"
+#include "caml/version.h"
+
+#ifndef O_BINARY
+#define O_BINARY 0
+#endif
+
+#ifndef SEEK_END
+#define SEEK_END 2
+#endif
+
+static char magicstr[EXEC_MAGIC_LENGTH+1];
+static int print_magic = 0;
+
+/* Print the specified error message followed by an end-of-line and exit */
+static void error(char *msg, ...)
+{
+  va_list ap;
+  va_start(ap, msg);
+  vfprintf (stderr, msg, ap);
+  va_end(ap);
+  fprintf(stderr, "\n");
+  exit(127);
+}
+
+/* Read the trailer of a bytecode file */
+
+static void fixup_endianness_trailer(uint32_t * p)
+{
+#ifndef ARCH_BIG_ENDIAN
+  Reverse_32(p, p);
+#endif
+}
+
+static int read_trailer(int fd, struct exec_trailer *trail)
+{
+  if (lseek(fd, (long) -TRAILER_SIZE, SEEK_END) == -1)
+    return BAD_BYTECODE;
+  if (read(fd, (char *) trail, TRAILER_SIZE) < TRAILER_SIZE)
+    return BAD_BYTECODE;
+  fixup_endianness_trailer(&trail->num_sections);
+  memcpy(magicstr, trail->magic, EXEC_MAGIC_LENGTH);
+  magicstr[EXEC_MAGIC_LENGTH] = 0;
+
+  if (print_magic) {
+    printf("%s\n", magicstr);
+    exit(0);
+  }
+  return
+    (strncmp(trail->magic, EXEC_MAGIC, sizeof(trail->magic)) == 0)
+      ? 0 : WRONG_MAGIC;
+}
+
+enum caml_byte_program_mode caml_byte_program_mode = STANDARD;
+
+int caml_attempt_open(char_os **name, struct exec_trailer *trail,
+                      int do_open_script)
+{
+  char_os * truename;
+  int fd;
+  int err;
+  char buf [2], * u8;
+
+  truename = caml_search_exe_in_path(*name);
+  u8 = caml_stat_strdup_of_os(truename);
+  caml_gc_message(0x100, "Opening bytecode executable %s\n", u8);
+  caml_stat_free(u8);
+  fd = open_os(truename, O_RDONLY | O_BINARY);
+  if (fd == -1) {
+    caml_stat_free(truename);
+    caml_gc_message(0x100, "Cannot open file\n");
+    return FILE_NOT_FOUND;
+  }
+  if (!do_open_script) {
+    err = read (fd, buf, 2);
+    if (err < 2 || (buf [0] == '#' && buf [1] == '!')) {
+      close(fd);
+      caml_stat_free(truename);
+      caml_gc_message(0x100, "Rejected #! script\n");
+      return BAD_BYTECODE;
+    }
+  }
+  err = read_trailer(fd, trail);
+  if (err != 0) {
+    close(fd);
+    caml_stat_free(truename);
+    caml_gc_message(0x100, "Not a bytecode executable\n");
+    return err;
+  }
+  *name = truename;
+  return fd;
+}
+
+/* Read the section descriptors */
+
+void caml_read_section_descriptors(int fd, struct exec_trailer *trail)
+{
+  int toc_size, i;
+
+  toc_size = trail->num_sections * 8;
+  trail->section = caml_stat_alloc(toc_size);
+  lseek(fd, - (long) (TRAILER_SIZE + toc_size), SEEK_END);
+  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++)
+    fixup_endianness_trailer(&(trail->section[i].len));
+}
+
+/* Position fd at the beginning of the section having the given name.
+   Return the length of the section data in bytes, or -1 if no section
+   found with that name. */
+
+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--) {
+    ofs += trail->section[i].len;
+    if (strncmp(trail->section[i].name, name, 4) == 0) {
+      lseek(fd, -ofs, SEEK_END);
+      return trail->section[i].len;
+    }
+  }
+  return -1;
+}
+
+/* Position fd at the beginning of the section having the given name.
+   Return the length of the section data in bytes. */
+
+int32_t caml_seek_section(int fd, struct exec_trailer *trail, char *name)
+{
+  int32_t len = caml_seek_optional_section(fd, trail, name);
+  if (len == -1)
+    caml_fatal_error("section `%s' is missing", name);
+  return len;
+}
+
+/* Read and return the contents of the section having the given name.
+   Add a terminating 0.  Return NULL if no such section. */
+
+static char * read_section(int fd, struct exec_trailer *trail, char *name)
+{
+  int32_t len;
+  char * data;
+
+  len = caml_seek_optional_section(fd, trail, name);
+  if (len == -1) return NULL;
+  data = caml_stat_alloc(len + 1);
+  if (read(fd, data, len) != len)
+    caml_fatal_error("error reading section %s", name);
+  data[len] = 0;
+  return data;
+}
+
+#ifdef _WIN32
+
+static char_os * read_section_to_os(int fd, struct exec_trailer *trail,
+                                    char *name)
+{
+  int32_t len, wlen;
+  char * data;
+  wchar_t * wdata;
+
+  len = caml_seek_optional_section(fd, trail, name);
+  if (len == -1) return NULL;
+  data = caml_stat_alloc(len + 1);
+  if (read(fd, data, len) != len)
+    caml_fatal_error("error reading section %s", name);
+  data[len] = 0;
+  wlen = win_multi_byte_to_wide_char(data, len, NULL, 0);
+  wdata = caml_stat_alloc((wlen + 1)*sizeof(wchar_t));
+  win_multi_byte_to_wide_char(data, len, wdata, wlen);
+  wdata[wlen] = 0;
+  caml_stat_free(data);
+  return wdata;
+}
+
+#else
+
+#define read_section_to_os read_section
+
+#endif
+
+/* Invocation of ocamlrun: 4 cases.
+
+   1.  runtime + bytecode
+       user types:  ocamlrun [options] bytecode args...
+       arguments:  ocamlrun [options] bytecode args...
+
+   2.  bytecode script
+       user types:  bytecode args...
+   2a  (kernel 1) arguments:  ocamlrun ./bytecode args...
+   2b  (kernel 2) arguments:  bytecode bytecode args...
+
+   3.  concatenated runtime and bytecode
+       user types:  composite args...
+       arguments:  composite args...
+
+Algorithm:
+  1-  If argument 0 is a valid byte-code file that does not start with #!,
+      then we are in case 3 and we pass the same command line to the
+      OCaml program.
+  2-  In all other cases, we parse the command line as:
+        (whatever) [options] bytecode args...
+      and we strip "(whatever) [options]" from the command line.
+
+*/
+
+/* Parse options on the command line */
+
+static int parse_command_line(char_os **argv)
+{
+  int i, j;
+
+  for(i = 1; argv[i] != NULL && argv[i][0] == '-'; i++) {
+    switch(argv[i][1]) {
+    case 't':
+      ++ caml_trace_level; /* ignored unless DEBUG mode */
+      break;
+    case 'v':
+      if (!strcmp_os (argv[i], T("-version"))){
+        printf ("%s\n", "The OCaml runtime, version " OCAML_VERSION_STRING);
+        exit (0);
+      }else if (!strcmp_os (argv[i], T("-vnum"))){
+        printf ("%s\n", OCAML_VERSION_STRING);
+        exit (0);
+      }else{
+        caml_verb_gc = 0x001+0x004+0x008+0x010+0x020;
+      }
+      break;
+    case 'p':
+      for (j = 0; caml_names_of_builtin_cprim[j] != NULL; j++)
+        printf("%s\n", caml_names_of_builtin_cprim[j]);
+      exit(0);
+      break;
+    case 'b':
+      caml_record_backtrace(Val_true);
+      break;
+    case 'I':
+      if (argv[i + 1] != NULL) {
+        caml_ext_table_add(&caml_shared_libs_path, argv[i + 1]);
+        i++;
+      }
+      break;
+    case 'm':
+      print_magic = 1;
+      break;
+    case 'M':
+      printf ( "%s\n", EXEC_MAGIC);
+      exit(0);
+      break;
+    default:
+      error("unknown option %s", caml_stat_strdup_of_os(argv[i]));
+    }
+  }
+  return i;
+}
+
+extern void caml_init_ieee_floats (void);
+
+#ifdef _WIN32
+extern void caml_signal_thread(void * lpParam);
+#endif
+
+#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
+
+/* PR 4887: avoid crash box of windows runtime on some system calls */
+extern void caml_install_invalid_parameter_handler();
+
+#endif
+
+extern int caml_ensure_spacetime_dot_o_is_included;
+
+/* Main entry point when loading code from a file */
+
+CAMLexport void caml_main(char_os **argv)
+{
+  int fd, pos;
+  struct exec_trailer trail;
+  struct channel * chan;
+  value res;
+  char * req_prims;
+  char_os * shared_lib_path, * shared_libs;
+  char_os * exe_name, * proc_self_exe;
+
+  caml_ensure_spacetime_dot_o_is_included++;
+
+  /* Initialize the domain */
+  caml_init_domain();
+
+  /* Determine options */
+#ifdef DEBUG
+  caml_verb_gc = 0x3F;
+#endif
+  caml_parse_ocamlrunparam();
+  CAML_EVENTLOG_INIT();
+#ifdef DEBUG
+  caml_gc_message (-1, "### OCaml runtime: debug mode ###\n");
+#endif
+  if (!caml_startup_aux(/* pooling */ caml_cleanup_on_exit))
+    return;
+
+  /* Machine-dependent initialization of the floating-point hardware
+     so that it behaves as much as possible as specified in IEEE */
+  caml_init_ieee_floats();
+  caml_init_locale();
+#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
+  caml_install_invalid_parameter_handler();
+#endif
+  caml_init_custom_operations();
+  caml_ext_table_init(&caml_shared_libs_path, 8);
+
+  /* Determine position of bytecode file */
+  pos = 0;
+
+  /* First, try argv[0] (when ocamlrun is called by a bytecode program) */
+  exe_name = argv[0];
+  fd = caml_attempt_open(&exe_name, &trail, 0);
+
+  /* Little grasshopper wonders why we do that at all, since
+     "The current executable is ocamlrun itself, it's never a bytecode
+     program".  Little grasshopper "ocamlc -custom" in mind should keep.
+     With -custom, we have an executable that is ocamlrun itself
+     concatenated with the bytecode.  So, if the attempt with argv[0]
+     failed, it is worth trying again with executable_name. */
+  if (fd < 0 && (proc_self_exe = caml_executable_name()) != NULL) {
+    exe_name = proc_self_exe;
+    fd = caml_attempt_open(&exe_name, &trail, 0);
+  }
+
+  if (fd < 0) {
+    pos = parse_command_line(argv);
+    if (argv[pos] == 0) {
+      error("no bytecode file specified");
+    }
+    exe_name = argv[pos];
+    fd = caml_attempt_open(&exe_name, &trail, 1);
+    switch(fd) {
+    case FILE_NOT_FOUND:
+      error("cannot find file '%s'",
+                       caml_stat_strdup_of_os(argv[pos]));
+      break;
+    case BAD_BYTECODE:
+      error(
+        "the file '%s' is not a bytecode executable file",
+        caml_stat_strdup_of_os(exe_name));
+      break;
+    case WRONG_MAGIC:
+      error(
+        "the file '%s' has not the right magic number: "\
+        "expected %s, got %s",
+        caml_stat_strdup_of_os(exe_name),
+        EXEC_MAGIC,
+        magicstr);
+      break;
+    }
+  }
+  /* Read the table of contents (section descriptors) */
+  caml_read_section_descriptors(fd, &trail);
+  /* Initialize the abstract machine */
+  caml_init_gc (caml_init_minor_heap_wsz, caml_init_heap_wsz,
+                caml_init_heap_chunk_sz, caml_init_percent_free,
+                caml_init_max_percent_free, caml_init_major_window,
+                caml_init_custom_major_ratio, caml_init_custom_minor_ratio,
+                caml_init_custom_minor_max_bsz);
+  caml_init_stack (caml_init_max_stack_wsz);
+  caml_init_atom_table();
+  caml_init_backtrace();
+  /* Initialize the interpreter */
+  caml_interprete(NULL, 0);
+  /* Initialize the debugger, if needed */
+  caml_debugger_init();
+  /* Load the code */
+  caml_code_size = caml_seek_section(fd, &trail, "CODE");
+  caml_load_code(fd, caml_code_size);
+  caml_init_debug_info();
+  /* Build the table of primitives */
+  shared_lib_path = read_section_to_os(fd, &trail, "DLPT");
+  shared_libs = read_section_to_os(fd, &trail, "DLLS");
+  req_prims = read_section(fd, &trail, "PRIM");
+  if (req_prims == NULL) caml_fatal_error("no PRIM section");
+  caml_build_primitive_table(shared_lib_path, shared_libs, req_prims);
+  caml_stat_free(shared_lib_path);
+  caml_stat_free(shared_libs);
+  caml_stat_free(req_prims);
+  /* Load the globals */
+  caml_seek_section(fd, &trail, "DATA");
+  chan = caml_open_descriptor_in(fd);
+  caml_global_data = caml_input_val(chan);
+  caml_close_channel(chan); /* this also closes fd */
+  caml_stat_free(trail.section);
+  /* Ensure that the globals are in the major heap. */
+  caml_oldify_one (caml_global_data, &caml_global_data);
+  caml_oldify_mopup ();
+  /* Initialize system libraries */
+  caml_sys_init(exe_name, argv + pos);
+#ifdef _WIN32
+  /* Start a thread to handle signals */
+  if (caml_secure_getenv(T("CAMLSIGPIPE")))
+    _beginthread(caml_signal_thread, 4096, NULL);
+#endif
+  /* Execute the program */
+  caml_debugger(PROGRAM_START, Val_unit);
+  res = caml_interprete(caml_start_code, caml_code_size);
+  if (Is_exception_result(res)) {
+    Caml_state->exn_bucket = Extract_exception(res);
+    if (caml_debugger_in_use) {
+      Caml_state->extern_sp = &Caml_state->exn_bucket; /* The debugger needs the
+                                            exception value.*/
+      caml_debugger(UNCAUGHT_EXC, Val_unit);
+    }
+    caml_fatal_uncaught_exception(Caml_state->exn_bucket);
+  }
+}
+
+/* Main entry point when code is linked in as initialized data */
+
+CAMLexport value caml_startup_code_exn(
+           code_t code, asize_t code_size,
+           char *data, asize_t data_size,
+           char *section_table, asize_t section_table_size,
+           int pooling,
+           char_os **argv)
+{
+  char_os * cds_file;
+  char_os * exe_name;
+
+  /* Initialize the domain */
+  caml_init_domain();
+  /* Determine options */
+#ifdef DEBUG
+  caml_verb_gc = 0x3F;
+#endif
+  caml_parse_ocamlrunparam();
+  CAML_EVENTLOG_INIT();
+#ifdef DEBUG
+  caml_gc_message (-1, "### OCaml runtime: debug mode ###\n");
+#endif
+  if (caml_cleanup_on_exit)
+    pooling = 1;
+  if (!caml_startup_aux(pooling))
+    return Val_unit;
+
+  caml_init_ieee_floats();
+  caml_init_locale();
+#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
+  caml_install_invalid_parameter_handler();
+#endif
+  caml_init_custom_operations();
+  cds_file = caml_secure_getenv(T("CAML_DEBUG_FILE"));
+  if (cds_file != NULL) {
+    caml_cds_file = caml_stat_strdup_os(cds_file);
+  }
+  exe_name = caml_executable_name();
+  if (exe_name == NULL) exe_name = caml_search_exe_in_path(argv[0]);
+  /* Initialize the abstract machine */
+  caml_init_gc (caml_init_minor_heap_wsz, caml_init_heap_wsz,
+                caml_init_heap_chunk_sz, caml_init_percent_free,
+                caml_init_max_percent_free, caml_init_major_window,
+                caml_init_custom_major_ratio, caml_init_custom_minor_ratio,
+                caml_init_custom_minor_max_bsz);
+  caml_init_stack (caml_init_max_stack_wsz);
+  caml_init_atom_table();
+  caml_init_backtrace();
+  /* Initialize the interpreter */
+  caml_interprete(NULL, 0);
+  /* Initialize the debugger, if needed */
+  caml_debugger_init();
+  /* Load the code */
+  caml_start_code = code;
+  caml_code_size = code_size;
+  caml_init_code_fragments();
+  caml_init_debug_info();
+#ifdef THREADED_CODE
+  caml_thread_code(caml_start_code, code_size);
+#endif
+  /* Use the builtin table of primitives */
+  caml_build_primitive_table_builtin();
+  /* Load the globals */
+  caml_global_data = caml_input_value_from_block(data, data_size);
+  /* Ensure that the globals are in the major heap. */
+  caml_oldify_one (caml_global_data, &caml_global_data);
+  caml_oldify_mopup ();
+  /* Record the sections (for caml_get_section_table in meta.c) */
+  caml_section_table = section_table;
+  caml_section_table_size = section_table_size;
+  /* Initialize system libraries */
+  caml_sys_init(exe_name, argv);
+  /* Execute the program */
+  caml_debugger(PROGRAM_START, Val_unit);
+  return caml_interprete(caml_start_code, caml_code_size);
+}
+
+CAMLexport void caml_startup_code(
+           code_t code, asize_t code_size,
+           char *data, asize_t data_size,
+           char *section_table, asize_t section_table_size,
+           int pooling,
+           char_os **argv)
+{
+  value res;
+
+  res = caml_startup_code_exn(code, code_size, data, data_size,
+                              section_table, section_table_size,
+                              pooling, argv);
+  if (Is_exception_result(res)) {
+    Caml_state->exn_bucket = Extract_exception(res);
+    if (caml_debugger_in_use) {
+      Caml_state->extern_sp = &Caml_state->exn_bucket; /* The debugger needs the
+                                            exception value.*/
+      caml_debugger(UNCAUGHT_EXC, Val_unit);
+    }
+    caml_fatal_uncaught_exception(Caml_state->exn_bucket);
+  }
+}
diff --git a/runtime/startup_nat.c b/runtime/startup_nat.c
new file mode 100644
index 00000000..725598f6
--- /dev/null
+++ b/runtime/startup_nat.c
@@ -0,0 +1,194 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*          Xavier Leroy and Damien Doligez, 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
+
+/* Start-up code */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "caml/callback.h"
+#include "caml/backtrace.h"
+#include "caml/custom.h"
+#include "caml/debugger.h"
+#include "caml/domain.h"
+#include "caml/eventlog.h"
+#include "caml/fail.h"
+#include "caml/freelist.h"
+#include "caml/gc.h"
+#include "caml/gc_ctrl.h"
+#include "caml/intext.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/osdeps.h"
+#include "caml/printexc.h"
+#include "caml/stack.h"
+#include "caml/startup_aux.h"
+#include "caml/sys.h"
+#ifdef WITH_SPACETIME
+#include "caml/spacetime.h"
+#endif
+#ifdef HAS_UI
+#include "caml/ui.h"
+#endif
+
+extern int caml_parser_trace;
+char * caml_code_area_start, * caml_code_area_end;
+struct ext_table caml_code_fragments_table;
+
+/* Initialize the atom table and the static data and code area limits. */
+
+struct segment { char * begin; char * end; };
+
+static void init_static(void)
+{
+  extern struct segment caml_data_segments[], caml_code_segments[];
+  int i;
+  struct code_fragment * cf;
+
+  caml_init_atom_table ();
+
+  for (i = 0; caml_data_segments[i].begin != 0; i++) {
+    /* PR#5509: we must include the zero word at end of data segment,
+       because pointers equal to caml_data_segments[i].end are static data. */
+    if (caml_page_table_add(In_static_data,
+                            caml_data_segments[i].begin,
+                            caml_data_segments[i].end + sizeof(value)) != 0)
+      caml_fatal_error("not enough memory for initial page table");
+  }
+
+  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++) {
+    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)
+      caml_code_area_end = caml_code_segments[i].end;
+  }
+  /* Register the code in the table of code fragments */
+  cf = caml_stat_alloc(sizeof(struct code_fragment));
+  cf->code_start = caml_code_area_start;
+  cf->code_end = caml_code_area_end;
+  cf->digest_computed = 0;
+  caml_ext_table_init(&caml_code_fragments_table, 8);
+  caml_ext_table_add(&caml_code_fragments_table, cf);
+}
+
+/* These are termination hooks used by the systhreads library */
+struct longjmp_buffer caml_termination_jmpbuf;
+void (*caml_termination_hook)(void *) = NULL;
+
+extern value caml_start_program (caml_domain_state*);
+extern void caml_init_ieee_floats (void);
+extern void caml_init_signals (void);
+#ifdef _WIN32
+extern void caml_win32_overflow_detection (void);
+#endif
+
+#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
+
+/* PR 4887: avoid crash box of windows runtime on some system calls */
+extern void caml_install_invalid_parameter_handler();
+
+#endif
+
+value caml_startup_common(char_os **argv, int pooling)
+{
+  char_os * exe_name, * proc_self_exe;
+  char tos;
+
+  /* Initialize the domain */
+  caml_init_domain();
+  /* Determine options */
+#ifdef DEBUG
+  caml_verb_gc = 0x3F;
+#endif
+  caml_parse_ocamlrunparam();
+  CAML_EVENTLOG_INIT();
+#ifdef DEBUG
+  caml_gc_message (-1, "### OCaml runtime: debug mode ###\n");
+#endif
+  if (caml_cleanup_on_exit)
+    pooling = 1;
+  if (!caml_startup_aux(pooling))
+    return Val_unit;
+
+#ifdef WITH_SPACETIME
+  caml_spacetime_initialize();
+#endif
+  caml_init_frame_descriptors();
+  caml_init_ieee_floats();
+  caml_init_locale();
+#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
+  caml_install_invalid_parameter_handler();
+#endif
+  caml_init_custom_operations();
+  Caml_state->top_of_stack = &tos;
+  caml_init_gc (caml_init_minor_heap_wsz, caml_init_heap_wsz,
+                caml_init_heap_chunk_sz, caml_init_percent_free,
+                caml_init_max_percent_free, caml_init_major_window,
+                caml_init_custom_major_ratio, caml_init_custom_minor_ratio,
+                caml_init_custom_minor_max_bsz);
+  init_static();
+  caml_init_signals();
+#ifdef _WIN32
+  caml_win32_overflow_detection();
+#endif
+  caml_init_backtrace();
+  caml_debugger_init (); /* force debugger.o stub to be linked */
+  exe_name = argv[0];
+  if (exe_name == NULL) exe_name = T("");
+  proc_self_exe = caml_executable_name();
+  if (proc_self_exe != NULL)
+    exe_name = proc_self_exe;
+  else
+    exe_name = caml_search_exe_in_path(exe_name);
+  caml_sys_init(exe_name, argv);
+  if (sigsetjmp(caml_termination_jmpbuf.buf, 0)) {
+    if (caml_termination_hook != NULL) caml_termination_hook(NULL);
+    return Val_unit;
+  }
+  return caml_start_program(Caml_state);
+}
+
+value caml_startup_exn(char_os **argv)
+{
+  return caml_startup_common(argv, /* pooling */ 0);
+}
+
+void caml_startup(char_os **argv)
+{
+  value res = caml_startup_exn(argv);
+  if (Is_exception_result(res))
+    caml_fatal_uncaught_exception(Extract_exception(res));
+}
+
+void caml_main(char_os **argv)
+{
+  caml_startup(argv);
+}
+
+value caml_startup_pooled_exn(char_os **argv)
+{
+  return caml_startup_common(argv, /* pooling */ 1);
+}
+
+void caml_startup_pooled(char_os **argv)
+{
+  value res = caml_startup_pooled_exn(argv);
+  if (Is_exception_result(res))
+    caml_fatal_uncaught_exception(Extract_exception(res));
+}
diff --git a/runtime/str.c b/runtime/str.c
new file mode 100644
index 00000000..32ca54c7
--- /dev/null
+++ b/runtime/str.c
@@ -0,0 +1,474 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* Operations on strings */
+
+#include <string.h>
+#include <ctype.h>
+#include <stdio.h>
+#include <stdarg.h>
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "caml/misc.h"
+
+/* returns a number of bytes (chars) */
+CAMLexport mlsize_t caml_string_length(value s)
+{
+  mlsize_t temp;
+  temp = Bosize_val(s) - 1;
+  CAMLassert (Byte (s, temp - Byte (s, temp)) == 0);
+  return temp - Byte (s, temp);
+}
+
+/* returns a value that represents a number of bytes (chars) */
+CAMLprim value caml_ml_string_length(value s)
+{
+  mlsize_t temp;
+  temp = Bosize_val(s) - 1;
+  CAMLassert (Byte (s, temp - Byte (s, temp)) == 0);
+  return Val_long(temp - Byte (s, temp));
+}
+
+CAMLprim value caml_ml_bytes_length(value s)
+{
+  return caml_ml_string_length(s);
+}
+
+CAMLexport int caml_string_is_c_safe (value s)
+{
+  return strlen(String_val(s)) == caml_string_length(s);
+}
+
+/**
+ * [caml_create_string] is deprecated,
+ * use [caml_create_bytes] instead
+ */
+CAMLprim value caml_create_string(value len)
+{
+  mlsize_t size = Long_val(len);
+  if (size > Bsize_wsize (Max_wosize) - 1){
+    caml_invalid_argument("String.create");
+  }
+  return caml_alloc_string(size);
+}
+
+/* [len] is a value that represents a number of bytes (chars) */
+CAMLprim value caml_create_bytes(value len)
+{
+  mlsize_t size = Long_val(len);
+  if (size > Bsize_wsize (Max_wosize) - 1){
+    caml_invalid_argument("Bytes.create");
+  }
+  return caml_alloc_string(size);
+}
+
+
+
+CAMLprim value caml_string_get(value str, value index)
+{
+  intnat idx = Long_val(index);
+  if (idx < 0 || idx >= caml_string_length(str)) caml_array_bound_error();
+  return Val_int(Byte_u(str, idx));
+}
+
+CAMLprim value caml_bytes_get(value str, value index)
+{
+  return caml_string_get(str, index);
+}
+
+CAMLprim value caml_bytes_set(value str, value index, value newval)
+{
+  intnat idx = Long_val(index);
+  if (idx < 0 || idx >= caml_string_length(str)) caml_array_bound_error();
+  Byte_u(str, idx) = Int_val(newval);
+  return Val_unit;
+}
+
+/**
+ * [caml_string_set] is deprecated,
+ * use [caml_bytes_set] instead
+ */
+CAMLprim value caml_string_set(value str, value index, value newval)
+{
+  return caml_bytes_set(str,index,newval);
+}
+
+
+CAMLprim value caml_string_get16(value str, value index)
+{
+  intnat res;
+  unsigned char b1, b2;
+  intnat idx = Long_val(index);
+  if (idx < 0 || idx + 1 >= caml_string_length(str)) caml_array_bound_error();
+  b1 = Byte_u(str, idx);
+  b2 = Byte_u(str, idx + 1);
+#ifdef ARCH_BIG_ENDIAN
+  res = b1 << 8 | b2;
+#else
+  res = b2 << 8 | b1;
+#endif
+  return Val_int(res);
+}
+
+CAMLprim value caml_bytes_get16(value str, value index)
+{
+  return caml_string_get16(str,index);
+}
+
+CAMLprim value caml_string_get32(value str, value index)
+{
+  int32_t res;
+  unsigned char b1, b2, b3, b4;
+  intnat idx = Long_val(index);
+  if (idx < 0 || idx + 3 >= caml_string_length(str)) caml_array_bound_error();
+  b1 = Byte_u(str, idx);
+  b2 = Byte_u(str, idx + 1);
+  b3 = Byte_u(str, idx + 2);
+  b4 = Byte_u(str, idx + 3);
+#ifdef ARCH_BIG_ENDIAN
+  res = b1 << 24 | b2 << 16 | b3 << 8 | b4;
+#else
+  res = b4 << 24 | b3 << 16 | b2 << 8 | b1;
+#endif
+  return caml_copy_int32(res);
+}
+
+CAMLprim value caml_bytes_get32(value str, value index)
+{
+  return caml_string_get32(str,index);
+}
+
+CAMLprim value caml_string_get64(value str, value index)
+{
+  uint64_t res;
+  unsigned char b1, b2, b3, b4, b5, b6, b7, b8;
+  intnat idx = Long_val(index);
+  if (idx < 0 || idx + 7 >= caml_string_length(str)) caml_array_bound_error();
+  b1 = Byte_u(str, idx);
+  b2 = Byte_u(str, idx + 1);
+  b3 = Byte_u(str, idx + 2);
+  b4 = Byte_u(str, idx + 3);
+  b5 = Byte_u(str, idx + 4);
+  b6 = Byte_u(str, idx + 5);
+  b7 = Byte_u(str, idx + 6);
+  b8 = Byte_u(str, idx + 7);
+#ifdef ARCH_BIG_ENDIAN
+  res = (uint64_t) b1 << 56 | (uint64_t) b2 << 48
+        | (uint64_t) b3 << 40 | (uint64_t) b4 << 32
+        | (uint64_t) b5 << 24 | (uint64_t) b6 << 16
+        | (uint64_t) b7 << 8 | (uint64_t) b8;
+#else
+  res = (uint64_t) b8 << 56 | (uint64_t) b7 << 48
+        | (uint64_t) b6 << 40 | (uint64_t) b5 << 32
+        | (uint64_t) b4 << 24 | (uint64_t) b3 << 16
+        | (uint64_t) b2 << 8 | (uint64_t) b1;
+#endif
+  return caml_copy_int64(res);
+}
+
+CAMLprim value caml_bytes_get64(value str, value index)
+{
+  return caml_string_get64(str,index);
+}
+
+CAMLprim value caml_bytes_set16(value str, value index, value newval)
+{
+  unsigned char b1, b2;
+  intnat val;
+  intnat idx = Long_val(index);
+  if (idx < 0 || idx + 1 >= caml_string_length(str)) caml_array_bound_error();
+  val = Long_val(newval);
+#ifdef ARCH_BIG_ENDIAN
+  b1 = 0xFF & val >> 8;
+  b2 = 0xFF & val;
+#else
+  b2 = 0xFF & val >> 8;
+  b1 = 0xFF & val;
+#endif
+  Byte_u(str, idx) = b1;
+  Byte_u(str, idx + 1) = b2;
+  return Val_unit;
+}
+
+CAMLprim value caml_bytes_set32(value str, value index, value newval)
+{
+  unsigned char b1, b2, b3, b4;
+  intnat val;
+  intnat idx = Long_val(index);
+  if (idx < 0 || idx + 3 >= caml_string_length(str)) caml_array_bound_error();
+  val = Int32_val(newval);
+#ifdef ARCH_BIG_ENDIAN
+  b1 = 0xFF & val >> 24;
+  b2 = 0xFF & val >> 16;
+  b3 = 0xFF & val >> 8;
+  b4 = 0xFF & val;
+#else
+  b4 = 0xFF & val >> 24;
+  b3 = 0xFF & val >> 16;
+  b2 = 0xFF & val >> 8;
+  b1 = 0xFF & val;
+#endif
+  Byte_u(str, idx) = b1;
+  Byte_u(str, idx + 1) = b2;
+  Byte_u(str, idx + 2) = b3;
+  Byte_u(str, idx + 3) = b4;
+  return Val_unit;
+}
+
+CAMLprim value caml_bytes_set64(value str, value index, value newval)
+{
+  unsigned char b1, b2, b3, b4, b5, b6, b7, b8;
+  int64_t val;
+  intnat idx = Long_val(index);
+  if (idx < 0 || idx + 7 >= caml_string_length(str)) caml_array_bound_error();
+  val = Int64_val(newval);
+#ifdef ARCH_BIG_ENDIAN
+  b1 = 0xFF & val >> 56;
+  b2 = 0xFF & val >> 48;
+  b3 = 0xFF & val >> 40;
+  b4 = 0xFF & val >> 32;
+  b5 = 0xFF & val >> 24;
+  b6 = 0xFF & val >> 16;
+  b7 = 0xFF & val >> 8;
+  b8 = 0xFF & val;
+#else
+  b8 = 0xFF & val >> 56;
+  b7 = 0xFF & val >> 48;
+  b6 = 0xFF & val >> 40;
+  b5 = 0xFF & val >> 32;
+  b4 = 0xFF & val >> 24;
+  b3 = 0xFF & val >> 16;
+  b2 = 0xFF & val >> 8;
+  b1 = 0xFF & val;
+#endif
+  Byte_u(str, idx) = b1;
+  Byte_u(str, idx + 1) = b2;
+  Byte_u(str, idx + 2) = b3;
+  Byte_u(str, idx + 3) = b4;
+  Byte_u(str, idx + 4) = b5;
+  Byte_u(str, idx + 5) = b6;
+  Byte_u(str, idx + 6) = b7;
+  Byte_u(str, idx + 7) = b8;
+  return Val_unit;
+}
+
+CAMLprim value caml_string_equal(value s1, value s2)
+{
+  mlsize_t sz1, sz2;
+  value * p1, * p2;
+
+  if (s1 == s2) return Val_true;
+  sz1 = Wosize_val(s1);
+  sz2 = Wosize_val(s2);
+  if (sz1 != sz2) return Val_false;
+  for(p1 = Op_val(s1), p2 = Op_val(s2); sz1 > 0; sz1--, p1++, p2++)
+    if (*p1 != *p2) return Val_false;
+  return Val_true;
+}
+
+CAMLprim value caml_bytes_equal(value s1, value s2)
+{
+  return caml_string_equal(s1,s2);
+}
+
+CAMLprim value caml_string_notequal(value s1, value s2)
+{
+  return Val_not(caml_string_equal(s1, s2));
+}
+
+CAMLprim value caml_bytes_notequal(value s1, value s2)
+{
+  return caml_string_notequal(s1,s2);
+}
+
+CAMLprim value caml_string_compare(value s1, value s2)
+{
+  mlsize_t len1, len2;
+  int res;
+
+  if (s1 == s2) return Val_int(0);
+  len1 = caml_string_length(s1);
+  len2 = caml_string_length(s2);
+  res = memcmp(String_val(s1), String_val(s2), len1 <= len2 ? len1 : len2);
+  if (res < 0) return Val_int(-1);
+  if (res > 0) return Val_int(1);
+  if (len1 < len2) return Val_int(-1);
+  if (len1 > len2) return Val_int(1);
+  return Val_int(0);
+}
+
+CAMLprim value caml_bytes_compare(value s1, value s2)
+{
+  return caml_string_compare(s1,s2);
+}
+
+CAMLprim value caml_string_lessthan(value s1, value s2)
+{
+  return caml_string_compare(s1, s2) < Val_int(0) ? Val_true : Val_false;
+}
+
+CAMLprim value caml_bytes_lessthan(value s1, value s2)
+{
+  return caml_string_lessthan(s1,s2);
+}
+
+
+CAMLprim value caml_string_lessequal(value s1, value s2)
+{
+  return caml_string_compare(s1, s2) <= Val_int(0) ? Val_true : Val_false;
+}
+
+CAMLprim value caml_bytes_lessequal(value s1, value s2)
+{
+  return caml_string_lessequal(s1,s2);
+}
+
+
+CAMLprim value caml_string_greaterthan(value s1, value s2)
+{
+  return caml_string_compare(s1, s2) > Val_int(0) ? Val_true : Val_false;
+}
+
+CAMLprim value caml_bytes_greaterthan(value s1, value s2)
+{
+  return caml_string_greaterthan(s1,s2);
+}
+
+CAMLprim value caml_string_greaterequal(value s1, value s2)
+{
+  return caml_string_compare(s1, s2) >= Val_int(0) ? Val_true : Val_false;
+}
+
+CAMLprim value caml_bytes_greaterequal(value s1, value s2)
+{
+  return caml_string_greaterequal(s1,s2);
+}
+
+CAMLprim value caml_blit_bytes(value s1, value ofs1, value s2, value ofs2,
+                                value n)
+{
+  memmove(&Byte(s2, Long_val(ofs2)), &Byte(s1, Long_val(ofs1)), Long_val(n));
+  return Val_unit;
+}
+
+CAMLprim value caml_blit_string(value s1, value ofs1, value s2, value ofs2,
+                                value n)
+{
+  return caml_blit_bytes (s1, ofs1, s2, ofs2, n);
+}
+
+CAMLprim value caml_fill_bytes(value s, value offset, value len, value init)
+{
+  memset(&Byte(s, Long_val(offset)), Int_val(init), Long_val(len));
+  return Val_unit;
+}
+
+/**
+ * [caml_fill_string] is deprecated, use [caml_fill_bytes] instead
+ */
+CAMLprim value caml_fill_string(value s, value offset, value len, value init)
+{
+  return caml_fill_bytes (s, offset, len, init);
+}
+
+CAMLexport value caml_alloc_sprintf(const char * format, ...)
+{
+  va_list args;
+  char buf[128];
+  int n;
+  value res;
+
+#if !defined(_WIN32) || defined(_UCRT)
+  /* C99-compliant implementation */
+  va_start(args, format);
+  /* "vsnprintf(dest, sz, format, args)" writes at most "sz" characters
+     into "dest", including the terminating '\0'.
+     It returns the number of characters of the formatted string,
+     excluding the terminating '\0'. */
+  n = vsnprintf(buf, sizeof(buf), format, args);
+  va_end(args);
+  if (n < sizeof(buf)) {
+    /* All output characters were written to buf, including the
+       terminating '\0'.  Allocate a Caml string with length "n"
+       as computed by vsnprintf, and copy the output of vsnprintf into it. */
+    res = caml_alloc_initialized_string(n, buf);
+  } else {
+    /* PR#7568: if the format is in the Caml heap, the following
+       caml_alloc_string could move or free the format.  To prevent
+       this, take a copy of the format outside the Caml heap. */
+    char * saved_format = caml_stat_strdup(format);
+    /* Allocate a Caml string with length "n" as computed by vsnprintf. */
+    res = caml_alloc_string(n);
+    /* Re-do the formatting, outputting directly in the Caml string.
+       Note that caml_alloc_string left room for a '\0' at position n,
+       so the size passed to vsnprintf is n+1. */
+    va_start(args, format);
+    vsnprintf((char *)String_val(res), n + 1, saved_format, args);
+    va_end(args);
+    caml_stat_free(saved_format);
+  }
+  return res;
+#else
+  /* Implementation specific to the Microsoft CRT library */
+  va_start(args, format);
+  /* "_vsnprintf(dest, sz, format, args)" writes at most "sz" characters
+     into "dest".  Let "len" be the number of characters of the formatted
+     string.
+     If "len" < "sz", a null terminator was appended, and "len" is returned.
+     If "len" == "sz", no null termination, and "len" is returned.
+     If "len" > "sz", a negative value is returned. */
+  n = _vsnprintf(buf, sizeof(buf), format, args);
+  va_end(args);
+  if (n >= 0 && n <= sizeof(buf)) {
+    /* All output characters were written to buf.
+       "n" is the actual length of the output.
+       Allocate a Caml string of length "n" and copy the characters into it. */
+    res = caml_alloc_string(n);
+    memcpy((char *)String_val(res), buf, n);
+  } else {
+    /* PR#7568: if the format is in the Caml heap, the following
+       caml_alloc_string could move or free the format.  To prevent
+       this, take a copy of the format outside the Caml heap. */
+    char * saved_format = caml_stat_strdup(format);
+    /* Determine actual length of output, excluding final '\0' */
+    va_start(args, format);
+    n = _vscprintf(format, args);
+    va_end(args);
+    res = caml_alloc_string(n);
+    /* Re-do the formatting, outputting directly in the Caml string.
+       Note that caml_alloc_string left room for a '\0' at position n,
+       so the size passed to _vsnprintf is n+1. */
+    va_start(args, format);
+    _vsnprintf((char *)String_val(res), n + 1, saved_format, args);
+    va_end(args);
+    caml_stat_free(saved_format);
+  }
+  return res;
+#endif
+}
+
+CAMLprim value caml_string_of_bytes(value bv)
+{
+  return bv;
+}
+
+CAMLprim value caml_bytes_of_string(value bv)
+{
+  return bv;
+}
diff --git a/runtime/sys.c b/runtime/sys.c
new file mode 100644
index 00000000..4da107a9
--- /dev/null
+++ b/runtime/sys.c
@@ -0,0 +1,659 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* Basic system calls */
+
+#include <errno.h>
+#include <fcntl.h>
+#include <signal.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <time.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#ifdef _WIN32
+#include <direct.h> /* for _wchdir and _wgetcwd */
+#else
+#include <sys/wait.h>
+#endif
+#include "caml/config.h"
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#ifdef HAS_TIMES
+#include <sys/times.h>
+#endif
+#ifdef HAS_GETRUSAGE
+#include <sys/time.h>
+#include <sys/resource.h>
+#endif
+#ifdef HAS_GETTIMEOFDAY
+#include <sys/time.h>
+#endif
+#include "caml/alloc.h"
+#include "caml/debugger.h"
+#include "caml/fail.h"
+#include "caml/gc_ctrl.h"
+#include "caml/io.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/osdeps.h"
+#include "caml/signals.h"
+#include "caml/stacks.h"
+#include "caml/sys.h"
+#include "caml/version.h"
+#include "caml/callback.h"
+#include "caml/startup_aux.h"
+
+static char * error_message(void)
+{
+  return strerror(errno);
+}
+
+#ifndef EAGAIN
+#define EAGAIN (-1)
+#endif
+#ifndef EWOULDBLOCK
+#define EWOULDBLOCK (-1)
+#endif
+
+CAMLexport void caml_sys_error(value arg)
+{
+  CAMLparam1 (arg);
+  char * err;
+  CAMLlocal1 (str);
+
+  err = error_message();
+  if (arg == NO_ARG) {
+    str = caml_copy_string(err);
+  } else {
+    mlsize_t err_len = strlen(err);
+    mlsize_t arg_len = caml_string_length(arg);
+    str = caml_alloc_string(arg_len + 2 + err_len);
+    memmove(&Byte(str, 0), String_val(arg), arg_len);
+    memmove(&Byte(str, arg_len), ": ", 2);
+    memmove(&Byte(str, arg_len + 2), err, err_len);
+  }
+  caml_raise_sys_error(str);
+  CAMLnoreturn;
+}
+
+CAMLexport void caml_sys_io_error(value arg)
+{
+  if (errno == EAGAIN || errno == EWOULDBLOCK) {
+    caml_raise_sys_blocked_io();
+  } else {
+    caml_sys_error(arg);
+  }
+}
+
+/* Check that [name] can safely be used as a file path */
+
+static void caml_sys_check_path(value name)
+{
+  if (! caml_string_is_c_safe(name)) {
+    errno = ENOENT;
+    caml_sys_error(name);
+  }
+}
+
+CAMLprim value caml_sys_exit(value retcode_v)
+{
+  int retcode = Int_val(retcode_v);
+
+  if ((caml_verb_gc & 0x400) != 0) {
+    /* cf caml_gc_counters */
+    double minwords = Caml_state->stat_minor_words
+      + (double) (Caml_state->young_end - Caml_state->young_ptr);
+    double prowords = Caml_state->stat_promoted_words;
+    double majwords =
+      Caml_state->stat_major_words + (double) caml_allocated_words;
+    double allocated_words = minwords + majwords - prowords;
+    intnat mincoll = Caml_state->stat_minor_collections;
+    intnat majcoll = Caml_state->stat_major_collections;
+    intnat heap_words = Caml_state->stat_heap_wsz;
+    intnat heap_chunks = Caml_state->stat_heap_chunks;
+    intnat top_heap_words = Caml_state->stat_top_heap_wsz;
+    intnat cpct = Caml_state->stat_compactions;
+    caml_gc_message(0x400, "allocated_words: %.0f\n", allocated_words);
+    caml_gc_message(0x400, "minor_words: %.0f\n", minwords);
+    caml_gc_message(0x400, "promoted_words: %.0f\n", prowords);
+    caml_gc_message(0x400, "major_words: %.0f\n", majwords);
+    caml_gc_message(0x400, "minor_collections: %"ARCH_INTNAT_PRINTF_FORMAT"d\n",
+                    mincoll);
+    caml_gc_message(0x400, "major_collections: %"ARCH_INTNAT_PRINTF_FORMAT"d\n",
+                    majcoll);
+    caml_gc_message(0x400, "heap_words: %"ARCH_INTNAT_PRINTF_FORMAT"d\n",
+                    heap_words);
+    caml_gc_message(0x400, "heap_chunks: %"ARCH_INTNAT_PRINTF_FORMAT"d\n",
+                    heap_chunks);
+    caml_gc_message(0x400, "top_heap_words: %"ARCH_INTNAT_PRINTF_FORMAT"d\n",
+                    top_heap_words);
+    caml_gc_message(0x400, "compactions: %"ARCH_INTNAT_PRINTF_FORMAT"d\n",
+                    cpct);
+  }
+
+#ifndef NATIVE_CODE
+  caml_debugger(PROGRAM_EXIT, Val_unit);
+#endif
+  if (caml_cleanup_on_exit)
+    caml_shutdown();
+#ifdef _WIN32
+  caml_restore_win32_terminal();
+#endif
+  exit(retcode);
+}
+
+#ifndef O_BINARY
+#define O_BINARY 0
+#endif
+#ifndef O_TEXT
+#define O_TEXT 0
+#endif
+#ifndef O_NONBLOCK
+#ifdef O_NDELAY
+#define O_NONBLOCK O_NDELAY
+#else
+#define O_NONBLOCK 0
+#endif
+#endif
+
+static int sys_open_flags[] = {
+  O_RDONLY, O_WRONLY, O_APPEND | O_WRONLY, O_CREAT, O_TRUNC, O_EXCL,
+  O_BINARY, O_TEXT, O_NONBLOCK
+};
+
+CAMLprim value caml_sys_open(value path, value vflags, value vperm)
+{
+  CAMLparam3(path, vflags, vperm);
+  int fd, flags, perm;
+  char_os * p;
+
+#if defined(O_CLOEXEC)
+  flags = O_CLOEXEC;
+#elif defined(_WIN32)
+  flags = _O_NOINHERIT;
+#else
+  flags = 0;
+#endif
+
+  caml_sys_check_path(path);
+  p = caml_stat_strdup_to_os(String_val(path));
+  flags |= caml_convert_flag_list(vflags, sys_open_flags);
+  perm = Int_val(vperm);
+  /* open on a named FIFO can block (PR#8005) */
+  caml_enter_blocking_section();
+  fd = open_os(p, flags, perm);
+  /* fcntl on a fd can block (PR#5069)*/
+#if defined(F_SETFD) && defined(FD_CLOEXEC) && !defined(_WIN32) \
+  && !defined(O_CLOEXEC)
+  if (fd != -1)
+    fcntl(fd, F_SETFD, FD_CLOEXEC);
+#endif
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (fd == -1) caml_sys_error(path);
+  CAMLreturn(Val_long(fd));
+}
+
+CAMLprim value caml_sys_close(value fd_v)
+{
+  int fd = Int_val(fd_v);
+  caml_enter_blocking_section();
+  close(fd);
+  caml_leave_blocking_section();
+  return Val_unit;
+}
+
+CAMLprim value caml_sys_file_exists(value name)
+{
+#ifdef _WIN32
+  struct _stati64 st;
+#else
+  struct stat st;
+#endif
+  char_os * p;
+  int ret;
+
+  if (! caml_string_is_c_safe(name)) return Val_false;
+  p = caml_stat_strdup_to_os(String_val(name));
+  caml_enter_blocking_section();
+  ret = stat_os(p, &st);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+
+  return Val_bool(ret == 0);
+}
+
+CAMLprim value caml_sys_is_directory(value name)
+{
+  CAMLparam1(name);
+#ifdef _WIN32
+  struct _stati64 st;
+#else
+  struct stat st;
+#endif
+  char_os * p;
+  int ret;
+
+  caml_sys_check_path(name);
+  p = caml_stat_strdup_to_os(String_val(name));
+  caml_enter_blocking_section();
+  ret = stat_os(p, &st);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+
+  if (ret == -1) caml_sys_error(name);
+#ifdef S_ISDIR
+  CAMLreturn(Val_bool(S_ISDIR(st.st_mode)));
+#else
+  CAMLreturn(Val_bool(st.st_mode & S_IFDIR));
+#endif
+}
+
+CAMLprim value caml_sys_remove(value name)
+{
+  CAMLparam1(name);
+  char_os * p;
+  int ret;
+  caml_sys_check_path(name);
+  p = caml_stat_strdup_to_os(String_val(name));
+  caml_enter_blocking_section();
+  ret = unlink_os(p);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret != 0) caml_sys_error(name);
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value caml_sys_rename(value oldname, value newname)
+{
+  char_os * p_old;
+  char_os * p_new;
+  int ret;
+  caml_sys_check_path(oldname);
+  caml_sys_check_path(newname);
+  p_old = caml_stat_strdup_to_os(String_val(oldname));
+  p_new = caml_stat_strdup_to_os(String_val(newname));
+  caml_enter_blocking_section();
+  ret = rename_os(p_old, p_new);
+  caml_leave_blocking_section();
+  caml_stat_free(p_new);
+  caml_stat_free(p_old);
+  if (ret != 0)
+    caml_sys_error(NO_ARG);
+  return Val_unit;
+}
+
+CAMLprim value caml_sys_chdir(value dirname)
+{
+  CAMLparam1(dirname);
+  char_os * p;
+  int ret;
+  caml_sys_check_path(dirname);
+  p = caml_stat_strdup_to_os(String_val(dirname));
+  caml_enter_blocking_section();
+  ret = chdir_os(p);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret != 0) caml_sys_error(dirname);
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value caml_sys_getcwd(value unit)
+{
+  char_os buff[4096];
+  char_os * ret;
+#ifdef HAS_GETCWD
+  ret = getcwd_os(buff, sizeof(buff)/sizeof(*buff));
+#else
+  caml_invalid_argument("Sys.getcwd not implemented");
+#endif /* HAS_GETCWD */
+  if (ret == 0) caml_sys_error(NO_ARG);
+  return caml_copy_string_of_os(buff);
+}
+
+CAMLprim value caml_sys_unsafe_getenv(value var)
+{
+  char_os * res, * p;
+  value val;
+
+  if (! caml_string_is_c_safe(var)) caml_raise_not_found();
+  p = caml_stat_strdup_to_os(String_val(var));
+#ifdef _WIN32
+  res = caml_win32_getenv(p);
+#else
+  res = getenv(p);
+#endif
+  caml_stat_free(p);
+  if (res == 0) caml_raise_not_found();
+  val = caml_copy_string_of_os(res);
+#ifdef _WIN32
+  caml_stat_free(res);
+#endif
+  return val;
+}
+
+CAMLprim value caml_sys_getenv(value var)
+{
+  char_os * res, * p;
+  value val;
+
+  if (! caml_string_is_c_safe(var)) caml_raise_not_found();
+  p = caml_stat_strdup_to_os(String_val(var));
+#ifdef _WIN32
+  res = caml_win32_getenv(p);
+#else
+  res = caml_secure_getenv(p);
+#endif
+  caml_stat_free(p);
+  if (res == 0) caml_raise_not_found();
+  val = caml_copy_string_of_os(res);
+#ifdef _WIN32
+  caml_stat_free(res);
+#endif
+  return val;
+}
+
+char_os * caml_exe_name;
+static value main_argv;
+
+CAMLprim value caml_sys_get_argv(value unit)
+{
+  CAMLparam0 ();   /* unit is unused */
+  CAMLlocal2 (exe_name, res);
+  exe_name = caml_copy_string_of_os(caml_exe_name);
+  res = caml_alloc_small(2, 0);
+  Field(res, 0) = exe_name;
+  Field(res, 1) = main_argv;
+  CAMLreturn(res);
+}
+
+CAMLprim value caml_sys_argv(value unit)
+{
+  return main_argv;
+}
+
+CAMLprim value caml_sys_modify_argv(value new_argv)
+{
+  caml_modify_generational_global_root(&main_argv, new_argv);
+  return Val_unit;
+}
+
+CAMLprim value caml_sys_executable_name(value unit)
+{
+  return caml_copy_string_of_os(caml_exe_name);
+}
+
+void caml_sys_init(char_os * exe_name, char_os **argv)
+{
+#ifdef _WIN32
+  /* Initialises the caml_win32_* globals on Windows with the version of
+     Windows which is running */
+  caml_probe_win32_version();
+#if WINDOWS_UNICODE
+  caml_setup_win32_terminal();
+#endif
+#endif
+  caml_exe_name = exe_name;
+  main_argv = caml_alloc_array((void *)caml_copy_string_of_os,
+                               (char const **) argv);
+  caml_register_generational_global_root(&main_argv);
+}
+
+#ifdef _WIN32
+#define WIFEXITED(status) 1
+#define WEXITSTATUS(status) (status)
+#else
+#if !(defined(WIFEXITED) && defined(WEXITSTATUS))
+/* Assume old-style V7 status word */
+#define WIFEXITED(status) (((status) & 0xFF) == 0)
+#define WEXITSTATUS(status) (((status) >> 8) & 0xFF)
+#endif
+#endif
+
+CAMLprim value caml_sys_system_command(value command)
+{
+  CAMLparam1 (command);
+  int status, retcode;
+  char_os *buf;
+
+  if (! caml_string_is_c_safe (command)) {
+    errno = EINVAL;
+    caml_sys_error(command);
+  }
+  buf = caml_stat_strdup_to_os(String_val(command));
+  caml_enter_blocking_section ();
+  status = system_os(buf);
+  caml_leave_blocking_section ();
+  caml_stat_free(buf);
+  if (status == -1) caml_sys_error(command);
+  if (WIFEXITED(status))
+    retcode = WEXITSTATUS(status);
+  else
+    retcode = 255;
+  CAMLreturn (Val_int(retcode));
+}
+
+double caml_sys_time_include_children_unboxed(value include_children)
+{
+#ifdef HAS_GETRUSAGE
+  struct rusage ru;
+  double acc = 0.;
+
+  getrusage (RUSAGE_SELF, &ru);
+  acc += ru.ru_utime.tv_sec + ru.ru_utime.tv_usec / 1e6
+    + ru.ru_stime.tv_sec + ru.ru_stime.tv_usec / 1e6;
+
+  if (Bool_val(include_children)) {
+    getrusage (RUSAGE_CHILDREN, &ru);
+    acc += ru.ru_utime.tv_sec + ru.ru_utime.tv_usec / 1e6
+      + ru.ru_stime.tv_sec + ru.ru_stime.tv_usec / 1e6;
+  }
+
+  return acc;
+#else
+  #ifdef HAS_TIMES
+    #ifndef CLK_TCK
+      #ifdef HZ
+        #define CLK_TCK HZ
+      #else
+        #define CLK_TCK 60
+      #endif
+    #endif
+    struct tms t;
+    clock_t acc = 0;
+    times(&t);
+    acc += t.tms_utime + t.tms_stime;
+    if (Bool_val(include_children)) {
+      acc += t.tms_cutime + t.tms_cstime;
+    }
+    return (double)acc / CLK_TCK;
+  #else
+    /* clock() is standard ANSI C. We have no way of getting
+       subprocess times in this branch. */
+    return (double)clock() / CLOCKS_PER_SEC;
+  #endif
+#endif
+}
+
+CAMLprim value caml_sys_time_include_children(value include_children)
+{
+  return caml_copy_double(
+      caml_sys_time_include_children_unboxed(include_children));
+}
+
+double caml_sys_time_unboxed(value unit) {
+  return caml_sys_time_include_children_unboxed(Val_false);
+}
+
+CAMLprim value caml_sys_time(value unit)
+{
+  return caml_copy_double(caml_sys_time_unboxed(unit));
+}
+
+#ifdef _WIN32
+extern int caml_win32_random_seed (intnat data[16]);
+#endif
+
+CAMLprim value caml_sys_random_seed (value unit)
+{
+  intnat data[16];
+  int n, i;
+  value res;
+#ifdef _WIN32
+  n = caml_win32_random_seed(data);
+#else
+  int fd;
+  n = 0;
+  /* Try /dev/urandom first */
+  fd = open("/dev/urandom", O_RDONLY, 0);
+  if (fd != -1) {
+    unsigned char buffer[12];
+    int nread = read(fd, buffer, 12);
+    close(fd);
+    while (nread > 0) data[n++] = buffer[--nread];
+  }
+  /* If the read from /dev/urandom fully succeeded, we now have 96 bits
+     of good random data and can stop here.  Otherwise, complement
+     whatever we got (probably nothing) with some not-very-random data. */
+  if (n < 12) {
+#ifdef HAS_GETTIMEOFDAY
+    struct timeval tv;
+    gettimeofday(&tv, NULL);
+    data[n++] = tv.tv_usec;
+    data[n++] = tv.tv_sec;
+#else
+    data[n++] = time(NULL);
+#endif
+#ifdef HAS_UNISTD
+    data[n++] = getpid();
+    data[n++] = getppid();
+#endif
+  }
+#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]);
+  return res;
+}
+
+CAMLprim value caml_sys_const_big_endian(value unit)
+{
+#ifdef ARCH_BIG_ENDIAN
+  return Val_true;
+#else
+  return Val_false;
+#endif
+}
+
+/* returns a value that represents a number of bits */
+CAMLprim value caml_sys_const_word_size(value unit)
+{
+  return Val_long(8 * sizeof(value));
+}
+
+/* returns a value that represents a number of bits */
+CAMLprim value caml_sys_const_int_size(value unit)
+{
+  return Val_long(8 * sizeof(value) - 1) ;
+}
+
+/* returns a value that represents a number of words */
+CAMLprim value caml_sys_const_max_wosize(value unit)
+{
+  return Val_long(Max_wosize) ;
+}
+
+CAMLprim value caml_sys_const_ostype_unix(value unit)
+{
+  return Val_bool(0 == strcmp(OCAML_OS_TYPE,"Unix"));
+}
+
+CAMLprim value caml_sys_const_ostype_win32(value unit)
+{
+  return Val_bool(0 == strcmp(OCAML_OS_TYPE,"Win32"));
+}
+
+CAMLprim value caml_sys_const_ostype_cygwin(value unit)
+{
+  return Val_bool(0 == strcmp(OCAML_OS_TYPE,"Cygwin"));
+}
+
+CAMLprim value caml_sys_const_backend_type(value unit)
+{
+  return Val_int(1); /* Bytecode backed */
+}
+CAMLprim value caml_sys_get_config(value unit)
+{
+  CAMLparam0 ();   /* unit is unused */
+  CAMLlocal2 (result, ostype);
+
+  ostype = caml_copy_string(OCAML_OS_TYPE);
+  result = caml_alloc_small (3, 0);
+  Field(result, 0) = ostype;
+  Field(result, 1) = Val_long (8 * sizeof(value));
+#ifdef ARCH_BIG_ENDIAN
+  Field(result, 2) = Val_true;
+#else
+  Field(result, 2) = Val_false;
+#endif
+  CAMLreturn (result);
+}
+
+CAMLprim value caml_sys_read_directory(value path)
+{
+  CAMLparam1(path);
+  CAMLlocal1(result);
+  struct ext_table tbl;
+  char_os * p;
+  int ret;
+
+  caml_sys_check_path(path);
+  caml_ext_table_init(&tbl, 50);
+  p = caml_stat_strdup_to_os(String_val(path));
+  caml_enter_blocking_section();
+  ret = caml_read_directory(p, &tbl);
+  caml_leave_blocking_section();
+  caml_stat_free(p);
+  if (ret == -1){
+    caml_ext_table_free(&tbl, 1);
+    caml_sys_error(path);
+  }
+  caml_ext_table_add(&tbl, NULL);
+  result = caml_copy_string_array((char const **) tbl.contents);
+  caml_ext_table_free(&tbl, 1);
+  CAMLreturn(result);
+}
+
+/* Return true if the value is a filedescriptor (int) that is
+ * (presumably) open on an interactive terminal */
+CAMLprim value caml_sys_isatty(value chan)
+{
+  int fd;
+  value ret;
+
+  fd = (Channel(chan))->fd;
+#ifdef _WIN32
+  ret = Val_bool(caml_win32_isatty(fd));
+#else
+  ret = Val_bool(isatty(fd));
+#endif
+
+  return ret;
+}
diff --git a/runtime/unix.c b/runtime/unix.c
new file mode 100644
index 00000000..c0ddbaaa
--- /dev/null
+++ b/runtime/unix.c
@@ -0,0 +1,442 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            */
+/*                                                                        */
+/*   Copyright 2001 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+#define CAML_INTERNALS
+
+/* Unix-specific stuff */
+
+#define _GNU_SOURCE
+           /* Helps finding RTLD_DEFAULT in glibc */
+           /* also secure_getenv */
+
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <errno.h>
+#include <sys/ioctl.h>
+#include <fcntl.h>
+#include "caml/config.h"
+#ifdef SUPPORT_DYNAMIC_LINKING
+#ifdef __CYGWIN__
+#include "flexdll.h"
+#else
+#include <dlfcn.h>
+#endif
+#endif
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#ifdef HAS_DIRENT
+#include <dirent.h>
+#else
+#include <sys/dir.h>
+#endif
+#ifdef __APPLE__
+#include <mach-o/dyld.h>
+#endif
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/osdeps.h"
+#include "caml/signals.h"
+#include "caml/sys.h"
+#include "caml/io.h"
+#include "caml/alloc.h"
+
+#ifndef S_ISREG
+#define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG)
+#endif
+
+#ifndef EINTR
+#define EINTR (-1)
+#endif
+#ifndef EAGAIN
+#define EAGAIN (-1)
+#endif
+#ifndef EWOULDBLOCK
+#define EWOULDBLOCK (-1)
+#endif
+
+int caml_read_fd(int fd, int flags, void * buf, int n)
+{
+  int retcode;
+  do {
+    caml_enter_blocking_section();
+    retcode = read(fd, buf, n);
+    caml_leave_blocking_section();
+  } while (retcode == -1 && errno == EINTR);
+  if (retcode == -1) caml_sys_io_error(NO_ARG);
+  return retcode;
+}
+
+int caml_write_fd(int fd, int flags, void * buf, int n)
+{
+  int retcode;
+ again:
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+  if (flags & CHANNEL_FLAG_BLOCKING_WRITE) {
+    retcode = write(fd, buf, n);
+  } else {
+#endif
+  caml_enter_blocking_section();
+  retcode = write(fd, buf, n);
+  caml_leave_blocking_section();
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+  }
+#endif
+  if (retcode == -1) {
+    if (errno == EINTR) goto again;
+    if ((errno == EAGAIN || errno == EWOULDBLOCK) && n > 1) {
+      /* We couldn't do a partial write here, probably because
+         n <= PIPE_BUF and POSIX says that writes of less than
+         PIPE_BUF characters must be atomic.
+         We first try again with a partial write of 1 character.
+         If that fails too, we'll return an error code. */
+      n = 1; goto again;
+    }
+  }
+  if (retcode == -1) caml_sys_io_error(NO_ARG);
+  CAMLassert (retcode > 0);
+  return retcode;
+}
+
+caml_stat_string caml_decompose_path(struct ext_table * tbl, char * path)
+{
+  char * p, * q;
+  size_t n;
+
+  if (path == NULL) return NULL;
+  p = caml_stat_strdup(path);
+  q = p;
+  while (1) {
+    for (n = 0; q[n] != 0 && q[n] != ':'; n++) /*nothing*/;
+    caml_ext_table_add(tbl, q);
+    q = q + n;
+    if (*q == 0) break;
+    *q = 0;
+    q += 1;
+  }
+  return p;
+}
+
+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++) {
+    if (*p == '/') goto not_found;
+  }
+  for (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);
+    if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode))
+      return fullname;
+    caml_stat_free(fullname);
+  }
+ not_found:
+  return caml_stat_strdup(name);
+}
+
+#ifdef __CYGWIN__
+
+/* Cygwin needs special treatment because of the implicit ".exe" at the
+   end of executable file names */
+
+static int cygwin_file_exists(const char * name)
+{
+  int fd, ret;
+  struct stat st;
+  /* Cannot use stat() here because it adds ".exe" implicitly */
+  fd = open(name, O_RDONLY);
+  if (fd == -1) return 0;
+  ret = fstat(fd, &st);
+  close(fd);
+  return ret == 0 && S_ISREG(st.st_mode);
+}
+
+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++) {
+    if (*p == '/' || *p == '\\') goto not_found;
+  }
+  for (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);
+    if (cygwin_file_exists(fullname)) return fullname;
+    caml_stat_free(fullname);
+    fullname = caml_stat_strconcat(4, dir, "/", name, ".exe");
+    if (cygwin_file_exists(fullname)) return fullname;
+    caml_stat_free(fullname);
+  }
+ not_found:
+  if (cygwin_file_exists(name)) return caml_stat_strdup(name);
+  fullname = caml_stat_strconcat(2, name, ".exe");
+  if (cygwin_file_exists(fullname)) return fullname;
+  caml_stat_free(fullname);
+  return caml_stat_strdup(name);
+}
+
+#endif
+
+caml_stat_string caml_search_exe_in_path(const char * name)
+{
+  struct ext_table path;
+  char * tofree;
+  caml_stat_string res;
+
+  caml_ext_table_init(&path, 8);
+  tofree = caml_decompose_path(&path, getenv("PATH"));
+#ifndef __CYGWIN__
+  res = caml_search_in_path(&path, name);
+#else
+  res = cygwin_search_exe_in_path(&path, name);
+#endif
+  caml_stat_free(tofree);
+  caml_ext_table_free(&path, 0);
+  return res;
+}
+
+caml_stat_string caml_search_dll_in_path(struct ext_table * path,
+                                         const char * name)
+{
+  caml_stat_string dllname;
+  caml_stat_string res;
+
+  dllname = caml_stat_strconcat(2, name, ".so");
+  res = caml_search_in_path(path, dllname);
+  caml_stat_free(dllname);
+  return res;
+}
+
+#ifdef SUPPORT_DYNAMIC_LINKING
+#ifdef __CYGWIN__
+/* Use flexdll */
+
+void * caml_dlopen(char * libname, int for_execution, int global)
+{
+  int flags = (global ? FLEXDLL_RTLD_GLOBAL : 0);
+  if (!for_execution) flags |= FLEXDLL_RTLD_NOEXEC;
+  return flexdll_dlopen(libname, flags);
+}
+
+void caml_dlclose(void * handle)
+{
+  flexdll_dlclose(handle);
+}
+
+void * caml_dlsym(void * handle, const char * name)
+{
+  return flexdll_dlsym(handle, name);
+}
+
+void * caml_globalsym(const char * name)
+{
+  return flexdll_dlsym(flexdll_dlopen(NULL,0), name);
+}
+
+char * caml_dlerror(void)
+{
+  return flexdll_dlerror();
+}
+
+#else
+/* Use normal dlopen */
+
+#ifndef RTLD_GLOBAL
+#define RTLD_GLOBAL 0
+#endif
+#ifndef RTLD_LOCAL
+#define RTLD_LOCAL 0
+#endif
+
+void * caml_dlopen(char * libname, int for_execution, int global)
+{
+  return dlopen(libname, RTLD_NOW | (global ? RTLD_GLOBAL : RTLD_LOCAL));
+  /* Could use RTLD_LAZY if for_execution == 0, but needs testing */
+}
+
+void caml_dlclose(void * handle)
+{
+  dlclose(handle);
+}
+
+void * caml_dlsym(void * handle, const char * name)
+{
+  return dlsym(handle, name);
+}
+
+void * caml_globalsym(const char * name)
+{
+#ifdef RTLD_DEFAULT
+  return caml_dlsym(RTLD_DEFAULT, name);
+#else
+  return NULL;
+#endif
+}
+
+char * caml_dlerror(void)
+{
+  return (char*) dlerror();
+}
+
+#endif
+#else
+
+void * caml_dlopen(char * libname, int for_execution, int global)
+{
+  return NULL;
+}
+
+void caml_dlclose(void * handle)
+{
+}
+
+void * caml_dlsym(void * handle, const char * name)
+{
+  return NULL;
+}
+
+void * caml_globalsym(const char * name)
+{
+  return NULL;
+}
+
+char * caml_dlerror(void)
+{
+  return "dynamic loading not supported on this platform";
+}
+
+#endif
+
+/* Add to [contents] the (short) names of the files contained in
+   the directory named [dirname].  No entries are added for [.] and [..].
+   Return 0 on success, -1 on error; set errno in the case of error. */
+
+CAMLexport int caml_read_directory(char * dirname, struct ext_table * contents)
+{
+  DIR * d;
+#ifdef HAS_DIRENT
+  struct dirent * e;
+#else
+  struct direct * e;
+#endif
+
+  d = opendir(dirname);
+  if (d == NULL) return -1;
+  while (1) {
+    e = readdir(d);
+    if (e == NULL) break;
+    if (strcmp(e->d_name, ".") == 0 || strcmp(e->d_name, "..") == 0) continue;
+    caml_ext_table_add(contents, caml_stat_strdup(e->d_name));
+  }
+  closedir(d);
+  return 0;
+}
+
+/* Recover executable name from /proc/self/exe if possible */
+
+char * caml_executable_name(void)
+{
+#if defined(__linux__)
+  int namelen, retcode;
+  char * name;
+  struct stat st;
+
+  /* lstat("/proc/self/exe") returns st_size == 0 so we cannot use it
+     to determine the size of the buffer.  Instead, we guess and adjust. */
+  namelen = 256;
+  while (1) {
+    name = caml_stat_alloc(namelen);
+    retcode = readlink("/proc/self/exe", name, namelen);
+    if (retcode == -1) { caml_stat_free(name); return NULL; }
+    if (retcode < namelen) break;
+    caml_stat_free(name);
+    if (namelen >= 1024*1024) return NULL; /* avoid runaway and overflow */
+    namelen *= 2;
+  }
+  /* readlink() does not zero-terminate its result.
+     There is room for a final zero since retcode < namelen. */
+  name[retcode] = 0;
+  /* Make sure that the contents of /proc/self/exe is a regular file.
+     (Old Linux kernels return an inode number instead.) */
+  if (stat(name, &st) == -1 || ! S_ISREG(st.st_mode)) {
+    caml_stat_free(name); return NULL;
+  }
+  return name;
+
+#elif defined(__APPLE__)
+  unsigned int namelen;
+  char * name;
+
+  namelen = 256;
+  name = caml_stat_alloc(namelen);
+  if (_NSGetExecutablePath(name, &namelen) == 0) return name;
+  caml_stat_free(name);
+  /* Buffer is too small, but namelen now contains the size needed */
+  name = caml_stat_alloc(namelen);
+  if (_NSGetExecutablePath(name, &namelen) == 0) return name;
+  caml_stat_free(name);
+  return NULL;
+
+#else
+  return NULL;
+
+#endif
+}
+
+char *caml_secure_getenv (char const *var)
+{
+#ifdef HAS_SECURE_GETENV
+  return secure_getenv (var);
+#elif defined (HAS___SECURE_GETENV)
+  return __secure_getenv (var);
+#elif defined(HAS_ISSETUGID)
+  if (!issetugid ())
+    return getenv(var);
+  else
+    return NULL;
+#else
+  if (geteuid () == getuid () && getegid () == getgid ())
+    return getenv(var);
+  else
+    return NULL;
+#endif
+}
+
+int caml_num_rows_fd(int fd)
+{
+#ifdef TIOCGWINSZ
+  struct winsize w;
+  w.ws_row = -1;
+  if (ioctl(fd, TIOCGWINSZ, &w) == 0)
+    return w.ws_row;
+  else
+    return -1;
+#else
+  return -1;
+#endif
+}
diff --git a/runtime/weak.c b/runtime/weak.c
new file mode 100644
index 00000000..85315263
--- /dev/null
+++ b/runtime/weak.c
@@ -0,0 +1,583 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*              Damien Doligez, projet Para, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 1997 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
+
+/* Operations on weak arrays and ephemerons (named ephe here)*/
+
+#include <string.h>
+
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "caml/weak.h"
+#include "caml/minor_gc.h"
+#include "caml/signals.h"
+#include "caml/eventlog.h"
+
+value caml_ephe_list_head = 0;
+
+static value ephe_dummy = 0;
+value caml_ephe_none = (value) &ephe_dummy;
+
+#define CAMLassert_valid_ephemeron(eph) do{                             \
+    CAMLassert (Is_in_heap (eph));                                      \
+    CAMLassert (Tag_val(eph) == Abstract_tag);                          \
+    CAMLassert (CAML_EPHE_FIRST_KEY <= Wosize_val (eph));               \
+}while(0)
+
+#define CAMLassert_valid_offset(eph, offset) do{                        \
+    CAMLassert_valid_ephemeron(eph);                                    \
+    CAMLassert (0 <= offset);                                           \
+    CAMLassert (offset < Wosize_val (eph) - CAML_EPHE_FIRST_KEY);       \
+}while(0)
+
+#define CAMLassert_not_dead_value(v) do{        \
+    CAMLassert ( caml_gc_phase != Phase_clean   \
+                 || !Is_block(v)                \
+                 || !Is_in_heap (v)             \
+                 || !Is_white_val(v) );         \
+}while(0)
+
+CAMLexport mlsize_t caml_ephemeron_num_keys(value eph)
+{
+  CAMLassert_valid_ephemeron(eph);
+  return Wosize_val (eph) - CAML_EPHE_FIRST_KEY;
+}
+
+/** The minor heap is considered alive. */
+#if defined (NATIVE_CODE) && defined (NO_NAKED_POINTERS)
+/** Outside minor and major heap, x must be black. */
+Caml_inline int Is_Dead_during_clean(value x)
+{
+  CAMLassert (x != caml_ephe_none);
+  CAMLassert (caml_gc_phase == Phase_clean);
+  return Is_block (x) && !Is_young (x) && Is_white_val(x);
+}
+/** The minor heap doesn't have to be marked, outside they should
+    already be black
+*/
+Caml_inline int Must_be_Marked_during_mark(value x)
+{
+  CAMLassert (x != caml_ephe_none);
+  CAMLassert (caml_gc_phase == Phase_mark);
+  return Is_block (x) && !Is_young (x);
+}
+#else
+Caml_inline int Is_Dead_during_clean(value x)
+{
+  CAMLassert (x != caml_ephe_none);
+  CAMLassert (caml_gc_phase == Phase_clean);
+  return Is_block (x) && Is_in_heap (x) && Is_white_val(x);
+}
+Caml_inline int Must_be_Marked_during_mark(value x)
+{
+  CAMLassert (x != caml_ephe_none);
+  CAMLassert (caml_gc_phase == Phase_mark);
+  return Is_block (x) && Is_in_heap (x);
+}
+#endif
+
+/* [len] is a number of words (fields) */
+CAMLexport value caml_ephemeron_create (mlsize_t len)
+{
+  mlsize_t size, i;
+  value res;
+
+  CAMLassert(len <= CAML_EPHE_MAX_WOSIZE);
+  size = len + CAML_EPHE_FIRST_KEY;
+  if (size < CAML_EPHE_FIRST_KEY || size > Max_wosize)
+    caml_invalid_argument ("Weak.create");
+  res = caml_alloc_shr (size, Abstract_tag);
+  for (i = 1; i < size; i++) Field (res, i) = caml_ephe_none;
+  Field (res, CAML_EPHE_LINK_OFFSET) = caml_ephe_list_head;
+  caml_ephe_list_head = res;
+  return res;
+}
+
+CAMLprim value caml_ephe_create (value len)
+{
+  value res = caml_ephemeron_create(Long_val(len));
+  // run memprof callbacks
+  return caml_process_pending_actions_with_root(res);
+}
+
+CAMLprim value caml_weak_create (value len)
+{
+  return caml_ephe_create(len);
+}
+
+/**
+   Specificity of the cleaning phase (Phase_clean):
+
+   The dead keys must be removed from the ephemerons and data removed
+   when one the keys is dead. Here we call it cleaning the ephemerons.
+   A specific phase of the GC is dedicated to this, Phase_clean. This
+   phase is just after the mark phase, so the white values are dead
+   values. It iterates the function caml_ephe_clean through all the
+   ephemerons.
+
+   However the GC is incremental and ocaml code can run on the middle
+   of this cleaning phase. In order to respect the semantic of the
+   ephemerons concerning dead values, the getter and setter must work
+   as if the cleaning of all the ephemerons have been done at once.
+
+   - key getter: Even if a dead key have not yet been replaced by
+     caml_ephe_none, getting it should return none.
+   - key setter: If we replace a dead key we need to set the data to
+     caml_ephe_none and clean the ephemeron.
+
+     This two cases are dealt by a call to do_check_key_clean that
+     trigger the cleaning of the ephemerons when the accessed key is
+     dead. This test is fast.
+
+     In the case of value getter and value setter, there is no fast
+     test because the removing of the data depend of the deadliness of the keys.
+     We must always try to clean the ephemerons.
+
+ */
+
+#define None_val (Val_int(0))
+#define Some_tag 0
+
+/* If we are in Phase_clean we need to check if the key
+   that is going to disappear is dead and so should trigger a cleaning
+ */
+static void do_check_key_clean(value ar, mlsize_t offset)
+{
+  CAMLassert (offset >= CAML_EPHE_FIRST_KEY);
+  if (caml_gc_phase == Phase_clean){
+    value elt = Field (ar, offset);
+    if (elt != caml_ephe_none && Is_Dead_during_clean(elt)){
+      Field(ar, offset) = caml_ephe_none;
+      Field(ar, CAML_EPHE_DATA_OFFSET) = caml_ephe_none;
+    };
+  };
+}
+
+/* If we are in Phase_clean we need to do as if the key is empty when
+   it will be cleaned during this phase */
+Caml_inline int is_ephe_key_none(value ar, mlsize_t offset)
+{
+  value elt = Field (ar, offset);
+  if (elt == caml_ephe_none){
+    return 1;
+  }else if (caml_gc_phase == Phase_clean && Is_Dead_during_clean(elt)){
+    Field(ar, offset) = caml_ephe_none;
+    Field(ar, CAML_EPHE_DATA_OFFSET) = caml_ephe_none;
+    return 1;
+  } else {
+    return 0;
+  }
+}
+
+static void do_set (value ar, mlsize_t offset, value v)
+{
+  if (Is_block (v) && Is_young (v)){
+    /* modified version of caml_modify */
+    value old = Field (ar, offset);
+    Field (ar, offset) = v;
+    if (!(Is_block (old) && Is_young (old))){
+      add_to_ephe_ref_table (Caml_state->ephe_ref_table, ar, offset);
+    }
+  }else{
+    Field (ar, offset) = v;
+  }
+}
+
+CAMLexport void caml_ephemeron_set_key(value ar, mlsize_t offset, value k)
+{
+  CAMLassert_valid_offset(ar, offset);
+  CAMLassert (Is_in_heap (ar));
+
+  offset += CAML_EPHE_FIRST_KEY;
+  do_check_key_clean(ar, offset);
+  do_set (ar, offset, k);
+}
+
+CAMLprim value caml_ephe_set_key (value ar, value n, value el)
+{
+  caml_ephemeron_set_key(ar, Long_val(n), el);
+  return Val_unit;
+}
+
+CAMLexport void caml_ephemeron_unset_key(value ar, mlsize_t offset)
+{
+  CAMLassert_valid_offset(ar, offset);
+  CAMLassert (Is_in_heap (ar));
+
+  offset += CAML_EPHE_FIRST_KEY;
+
+  do_check_key_clean(ar, offset);
+  Field (ar, offset) = caml_ephe_none;
+}
+
+CAMLprim value caml_ephe_unset_key (value ar, value n)
+{
+  caml_ephemeron_unset_key(ar, Long_val(n));
+  return Val_unit;
+}
+
+/* deprecated (03/2016) */
+value caml_ephe_set_key_option (value ar, value n, value el)
+{
+  if (Is_block (el)){
+    CAMLassert (Wosize_val (el) == 1);
+    caml_ephe_set_key(ar, n, Field (el, 0));
+  }else{
+    CAMLassert (el == None_val);
+    caml_ephe_unset_key(ar, n);
+  }
+  return Val_unit;
+}
+
+/* deprecated (03/2016) */
+CAMLprim value caml_weak_set (value ar, value n, value el)
+{
+  return caml_ephe_set_key_option(ar, n, el);
+}
+
+CAMLexport void caml_ephemeron_set_data (value ar, value el)
+{
+  CAMLassert_valid_ephemeron(ar);
+
+  if (caml_gc_phase == Phase_clean){
+    /* During this phase since we don't know which ephemerons have been
+       cleaned we always need to check it. */
+    caml_ephe_clean(ar);
+  };
+  do_set (ar, CAML_EPHE_DATA_OFFSET, el);
+}
+
+CAMLprim value caml_ephe_set_data (value ar, value el)
+{
+  caml_ephemeron_set_data (ar, el);
+  return Val_unit;
+}
+
+CAMLexport void caml_ephemeron_unset_data (value ar)
+{
+  CAMLassert_valid_ephemeron(ar);
+
+  Field (ar, CAML_EPHE_DATA_OFFSET) = caml_ephe_none;
+}
+
+CAMLprim value caml_ephe_unset_data (value ar)
+{
+  caml_ephemeron_unset_data (ar);
+  return Val_unit;
+}
+
+static value optionalize(int status, value *x)
+{
+  CAMLparam0();
+  CAMLlocal2(res, v);
+  if(status) {
+    v = *x;
+    res = caml_alloc_small (1, Some_tag);
+    Field (res, 0) = v;
+  } else {
+    res = None_val;
+  }
+  // run memprof callbacks both for the option we are allocating here
+  // and the calling function.
+  caml_process_pending_actions();
+  CAMLreturn(res);
+}
+
+CAMLexport int caml_ephemeron_get_key (value ar, mlsize_t offset, value *key)
+{
+  value elt;
+  CAMLassert_valid_offset(ar, offset);
+
+  offset += CAML_EPHE_FIRST_KEY;
+
+  if (is_ephe_key_none(ar, offset)){
+    return 0;
+  }else{
+    elt = Field (ar, offset);
+    if (caml_gc_phase == Phase_mark && Must_be_Marked_during_mark(elt)){
+      caml_darken (elt, NULL);
+    }
+    *key = elt;
+    CAMLassert_not_dead_value(elt);
+    return 1;
+  }
+}
+
+CAMLprim value caml_ephe_get_key (value ar, value n)
+{
+  value data;
+  return optionalize(caml_ephemeron_get_key(ar, Long_val(n), &data), &data);
+}
+
+CAMLprim value caml_weak_get (value ar, value n)
+{
+  return caml_ephe_get_key(ar, n);
+}
+
+CAMLexport int caml_ephemeron_get_data (value ar, value *data)
+{
+  value elt;
+  CAMLassert_valid_ephemeron(ar);
+
+  if(caml_gc_phase == Phase_clean) caml_ephe_clean(ar);
+  elt = Field (ar, CAML_EPHE_DATA_OFFSET);
+  if (elt == caml_ephe_none){
+    return 0;
+  }else{
+    if (caml_gc_phase == Phase_mark && Must_be_Marked_during_mark(elt)){
+      caml_darken (elt, NULL);
+    }
+    *data = elt;
+    CAMLassert_not_dead_value(elt);
+    return 1;
+  }
+}
+
+CAMLprim value caml_ephe_get_data (value ar)
+{
+  value data;
+  return optionalize(caml_ephemeron_get_data(ar, &data), &data);
+}
+
+
+Caml_inline void copy_value(value src, value dst)
+{
+  if (Tag_val (src) < No_scan_tag){
+    mlsize_t i;
+    for (i = 0; i < Wosize_val (src); i++){
+      value f = Field (src, i);
+      if (caml_gc_phase == Phase_mark && Must_be_Marked_during_mark(f)){
+        caml_darken (f, NULL);
+      }
+      caml_modify (&Field (dst, i), f);
+    }
+  }else{
+    memmove (Bp_val (dst), Bp_val (src), Bosize_val (src));
+  }
+}
+
+CAMLexport int caml_ephemeron_get_key_copy(value ar, mlsize_t offset,
+                                           value *key)
+{
+  mlsize_t loop = 0;
+  CAMLparam1(ar);
+  value elt = Val_unit, v; /* Caution: they are NOT local roots. */
+  CAMLassert_valid_offset(ar, offset);
+
+  offset += CAML_EPHE_FIRST_KEY;
+
+  while(1) {
+    if(is_ephe_key_none(ar, offset)) CAMLreturn(0);
+    v = Field (ar, offset);
+    /** Don't copy custom_block #7279 */
+    if(!(Is_block (v) && Is_in_heap_or_young(v)  && Tag_val(v) != Custom_tag)) {
+      if ( caml_gc_phase == Phase_mark && Must_be_Marked_during_mark(v) ){
+        caml_darken (v, NULL);
+      };
+      *key = v;
+      CAMLreturn(1);
+    }
+    if (elt != Val_unit &&
+        Wosize_val(v) == Wosize_val(elt) && Tag_val(v) == Tag_val(elt)) {
+      /* The allocation may trigger a finaliser that change the tag
+         and size of the block. Therefore, in addition to checking
+         that the pointer is still alive, we have to check that it
+         still has the same tag and size.
+       */
+      CAMLassert_not_dead_value(v);
+      copy_value(v, elt);
+      *key = elt;
+      CAMLreturn(1);
+    }
+
+    CAMLassert(loop < 10);
+    if(8 == loop){ /** One minor gc must be enough */
+      elt = Val_unit;
+      CAML_EV_COUNTER (EV_C_FORCE_MINOR_WEAK, 1);
+      caml_minor_collection ();
+    } else {
+      /* cases where loop is between 0 to 7 and where loop is equal to 9 */
+      elt = caml_alloc (Wosize_val (v), Tag_val (v));
+      /* The GC may erase, move or even change v during this call to
+         caml_alloc. */
+    }
+    ++loop;
+  }
+}
+
+CAMLprim value caml_ephe_get_key_copy (value ar, value n)
+{
+  value key;
+  int status = caml_ephemeron_get_key_copy(ar, Long_val(n), &key);
+  return optionalize(status, &key);
+}
+
+CAMLprim value caml_weak_get_copy (value ar, value n)
+{
+  return caml_ephe_get_key_copy(ar, n);
+}
+
+CAMLexport int caml_ephemeron_get_data_copy (value ar, value *data)
+{
+  mlsize_t loop = 0;
+  CAMLparam1 (ar);
+  value elt = Val_unit, v; /* Caution: they are NOT local roots. */
+  CAMLassert_valid_ephemeron(ar);
+
+  while(1) {
+    if (caml_gc_phase == Phase_clean) caml_ephe_clean(ar);
+    v = Field (ar, CAML_EPHE_DATA_OFFSET);
+    if (v == caml_ephe_none) CAMLreturn(0);
+    /** Don't copy custom_block #7279 */
+    if (!(Is_block (v) && Is_in_heap_or_young(v) && Tag_val(v) != Custom_tag)) {
+      if ( caml_gc_phase == Phase_mark && Must_be_Marked_during_mark(v) ){
+        caml_darken (v, NULL);
+      };
+      *data = v;
+      CAMLreturn(1);
+    }
+    if (elt != Val_unit &&
+        Wosize_val(v) == Wosize_val(elt) && Tag_val(v) == Tag_val(elt)) {
+      /** cf caml_ephemeron_get_key_copy */
+      CAMLassert_not_dead_value(v);
+      copy_value(v, elt);
+      *data = elt;
+      CAMLreturn(1);
+    }
+
+    CAMLassert(loop < 10);
+    if(8 == loop){ /** One minor gc must be enough */
+      elt = Val_unit;
+      CAML_EV_COUNTER (EV_C_FORCE_MINOR_WEAK, 1);
+      caml_minor_collection ();
+    } else {
+      /* cases where loop is between 0 to 7 and where loop is equal to 9 */
+      elt = caml_alloc (Wosize_val (v), Tag_val (v));
+      /** cf caml_ephemeron_get_key_copy */
+    }
+    ++loop;
+  }
+}
+
+
+CAMLprim value caml_ephe_get_data_copy (value ar)
+{
+  value data;
+  int status = caml_ephemeron_get_data_copy(ar, &data);
+  return optionalize(status, &data);
+}
+
+CAMLexport int caml_ephemeron_key_is_set(value ar, mlsize_t offset)
+{
+  CAMLassert_valid_offset(ar, offset);
+
+  offset += CAML_EPHE_FIRST_KEY;
+  return !is_ephe_key_none(ar, offset);
+}
+
+CAMLprim value caml_ephe_check_key (value ar, value n)
+{
+  return Val_bool (caml_ephemeron_key_is_set(ar, Long_val(n)));
+}
+
+CAMLprim value caml_weak_check (value ar, value n)
+{
+  return caml_ephe_check_key(ar, n);
+}
+
+CAMLexport int caml_ephemeron_data_is_set (value ar)
+{
+  CAMLassert_valid_ephemeron(ar);
+
+  if(caml_gc_phase == Phase_clean) caml_ephe_clean(ar);
+  return Field (ar, CAML_EPHE_DATA_OFFSET) != caml_ephe_none;
+}
+
+CAMLprim value caml_ephe_check_data (value ar)
+{
+  return Val_bool (caml_ephemeron_data_is_set(ar));
+}
+
+CAMLexport void caml_ephemeron_blit_key(value ars, mlsize_t offset_s,
+                                        value ard, mlsize_t offset_d,
+                                        mlsize_t length)
+{
+  intnat i; /** intnat because the second for-loop stops with i == -1 */
+  if (length == 0) return;
+  CAMLassert_valid_offset(ars, offset_s);
+  CAMLassert_valid_offset(ard, offset_d);
+  CAMLassert(length <= Wosize_val(ars) - CAML_EPHE_FIRST_KEY);
+  CAMLassert(length <= Wosize_val(ard) - CAML_EPHE_FIRST_KEY);
+  CAMLassert(offset_s <= Wosize_val(ars) - CAML_EPHE_FIRST_KEY - length);
+  CAMLassert(offset_d <= Wosize_val(ard) - CAML_EPHE_FIRST_KEY - length);
+
+  offset_s += CAML_EPHE_FIRST_KEY;
+  offset_d += CAML_EPHE_FIRST_KEY;
+
+  if (caml_gc_phase == Phase_clean){
+    caml_ephe_clean_partial(ars, offset_s, offset_s + length);
+    /* We don't need to clean the keys that are about to be overwritten,
+       except where cleaning them could result in releasing the data,
+       which can't happen if data is already released. */
+    if (Field (ard, CAML_EPHE_DATA_OFFSET) != caml_ephe_none)
+      caml_ephe_clean_partial(ard, offset_d, offset_d + length);
+  }
+  if (offset_d < offset_s){
+    for (i = 0; i < length; i++){
+      do_set (ard, offset_d + i, Field (ars, offset_s + i));
+    }
+  }else{
+    for (i = length - 1; i >= 0; i--){
+      do_set (ard, offset_d + i,  Field (ars, offset_s + i));
+    }
+  }
+}
+
+CAMLprim value caml_ephe_blit_key (value ars, value ofs,
+                                   value ard, value ofd, value len)
+{
+  if (Long_val(len) == 0) return Val_unit;
+
+  caml_ephemeron_blit_key(ars,Long_val(ofs),ard,Long_val(ofd),Long_val(len));
+  return Val_unit;
+}
+
+CAMLprim value caml_weak_blit (value ars, value ofs,
+                      value ard, value ofd, value len)
+{
+  return caml_ephe_blit_key (ars, ofs, ard, ofd, len);
+}
+
+CAMLexport void caml_ephemeron_blit_data (value ars, value ard)
+{
+  CAMLassert_valid_ephemeron(ars);
+  CAMLassert_valid_ephemeron(ard);
+
+  if(caml_gc_phase == Phase_clean) {
+    caml_ephe_clean(ars);
+    caml_ephe_clean(ard);
+  };
+  do_set (ard, CAML_EPHE_DATA_OFFSET, Field (ars, CAML_EPHE_DATA_OFFSET));
+}
+
+CAMLprim value caml_ephe_blit_data (value ars, value ard)
+{
+  caml_ephemeron_blit_data(ars, ard);
+  return Val_unit;
+}
diff --git a/runtime/win32.c b/runtime/win32.c
new file mode 100644
index 00000000..9c5f7fc2
--- /dev/null
+++ b/runtime/win32.c
@@ -0,0 +1,1032 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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
+
+/* Win32-specific stuff */
+
+/* FILE_INFO_BY_HANDLE_CLASS and FILE_NAME_INFO are only available from Windows
+   Vista onwards */
+#undef _WIN32_WINNT
+#define _WIN32_WINNT 0x0600
+
+#define WIN32_LEAN_AND_MEAN
+#include <wtypes.h>
+#include <winbase.h>
+#include <winsock2.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <stdarg.h>
+#include <io.h>
+#include <fcntl.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <ctype.h>
+#include <errno.h>
+#include <string.h>
+#include <signal.h>
+#include "caml/alloc.h"
+#include "caml/address_class.h"
+#include "caml/fail.h"
+#include "caml/io.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/osdeps.h"
+#include "caml/signals.h"
+#include "caml/sys.h"
+
+#include "caml/config.h"
+#ifdef SUPPORT_DYNAMIC_LINKING
+#include <flexdll.h>
+#endif
+
+#ifndef S_ISREG
+#define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG)
+#endif
+
+unsigned short caml_win32_major = 0;
+unsigned short caml_win32_minor = 0;
+unsigned short caml_win32_build = 0;
+unsigned short caml_win32_revision = 0;
+
+CAMLnoreturn_start
+static void caml_win32_sys_error (int errnum)
+CAMLnoreturn_end;
+
+static void caml_win32_sys_error(int errnum)
+{
+  wchar_t buffer[512];
+  value msg;
+  if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
+                    NULL,
+                    errnum,
+                    0,
+                    buffer,
+                    sizeof(buffer)/sizeof(wchar_t),
+                    NULL)) {
+    msg = caml_copy_string_of_utf16(buffer);
+  } else {
+    msg = caml_alloc_sprintf("unknown error #%d", errnum);
+  }
+  caml_raise_sys_error(msg);
+}
+
+int caml_read_fd(int fd, int flags, void * buf, int n)
+{
+  int retcode;
+  if ((flags & CHANNEL_FLAG_FROM_SOCKET) == 0) {
+    caml_enter_blocking_section();
+    retcode = read(fd, buf, n);
+    /* Large reads from console can fail with ENOMEM.  Reduce requested size
+       and try again. */
+    if (retcode == -1 && errno == ENOMEM && n > 16384) {
+      retcode = read(fd, buf, 16384);
+    }
+    caml_leave_blocking_section();
+    if (retcode == -1) caml_sys_io_error(NO_ARG);
+  } else {
+    caml_enter_blocking_section();
+    retcode = recv((SOCKET) _get_osfhandle(fd), buf, n, 0);
+    caml_leave_blocking_section();
+    if (retcode == -1) caml_win32_sys_error(WSAGetLastError());
+  }
+  return retcode;
+}
+
+int caml_write_fd(int fd, int flags, void * buf, int n)
+{
+  int retcode;
+  if ((flags & CHANNEL_FLAG_FROM_SOCKET) == 0) {
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+  if (flags & CHANNEL_FLAG_BLOCKING_WRITE) {
+    retcode = write(fd, buf, n);
+  } else {
+#endif
+    caml_enter_blocking_section();
+    retcode = write(fd, buf, n);
+    caml_leave_blocking_section();
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+  }
+#endif
+    if (retcode == -1) caml_sys_io_error(NO_ARG);
+  } else {
+    caml_enter_blocking_section();
+    retcode = send((SOCKET) _get_osfhandle(fd), buf, n, 0);
+    caml_leave_blocking_section();
+    if (retcode == -1) caml_win32_sys_error(WSAGetLastError());
+  }
+  CAMLassert (retcode > 0);
+  return retcode;
+}
+
+wchar_t * caml_decompose_path(struct ext_table * tbl, wchar_t * path)
+{
+  wchar_t * p, * q;
+  int n;
+
+  if (path == NULL) return NULL;
+  p = caml_stat_wcsdup(path);
+  q = p;
+  while (1) {
+    for (n = 0; q[n] != 0 && q[n] != L';'; n++) /*nothing*/;
+    caml_ext_table_add(tbl, q);
+    q = q + n;
+    if (*q == 0) break;
+    *q = 0;
+    q += 1;
+  }
+  return p;
+}
+
+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++) {
+    if (*p == '/' || *p == '\\') goto not_found;
+  }
+  for (i = 0; i < path->size; i++) {
+    dir = path->contents[i];
+    if (dir[0] == 0) continue;
+         /* not sure what empty path components mean under Windows */
+    fullname = caml_stat_wcsconcat(3, dir, L"\\", name);
+    u8 = caml_stat_strdup_of_utf16(fullname);
+    caml_gc_message(0x100, "Searching %s\n", u8);
+    caml_stat_free(u8);
+    if (_wstati64(fullname, &st) == 0 && S_ISREG(st.st_mode))
+      return fullname;
+    caml_stat_free(fullname);
+  }
+ not_found:
+  u8 = caml_stat_strdup_of_utf16(name);
+  caml_gc_message(0x100, "%s not found in search path\n", u8);
+  caml_stat_free(u8);
+  return caml_stat_wcsdup(name);
+}
+
+CAMLexport wchar_t * caml_search_exe_in_path(const wchar_t * name)
+{
+  wchar_t * fullname, * filepart;
+  char * u8;
+  size_t fullnamelen;
+  DWORD retcode;
+
+  fullnamelen = wcslen(name) + 1;
+  if (fullnamelen < 256) fullnamelen = 256;
+  while (1) {
+    fullname = caml_stat_alloc(fullnamelen*sizeof(wchar_t));
+    retcode = SearchPath(NULL,              /* use system search path */
+                         name,
+                         L".exe",            /* add .exe extension if needed */
+                         fullnamelen,
+                         fullname,
+                         &filepart);
+    if (retcode == 0) {
+      u8 = caml_stat_strdup_of_utf16(name);
+      caml_gc_message(0x100, "%s not found in search path\n", u8);
+      caml_stat_free(u8);
+      caml_stat_free(fullname);
+      return caml_stat_strdup_os(name);
+    }
+    if (retcode < fullnamelen)
+      return fullname;
+    caml_stat_free(fullname);
+    fullnamelen = retcode + 1;
+  }
+}
+
+wchar_t * caml_search_dll_in_path(struct ext_table * path, const wchar_t * name)
+{
+  wchar_t * dllname;
+  wchar_t * res;
+
+  dllname = caml_stat_wcsconcat(2, name, L".dll");
+  res = caml_search_in_path(path, dllname);
+  caml_stat_free(dllname);
+  return res;
+}
+
+#ifdef SUPPORT_DYNAMIC_LINKING
+
+void * caml_dlopen(wchar_t * libname, int for_execution, int global)
+{
+  void *handle;
+  int flags = (global ? FLEXDLL_RTLD_GLOBAL : 0);
+  if (!for_execution) flags |= FLEXDLL_RTLD_NOEXEC;
+  handle = flexdll_wdlopen(libname, flags);
+  if ((handle != NULL) && ((caml_verb_gc & 0x100) != 0)) {
+    flexdll_dump_exports(handle);
+    fflush(stdout);
+  }
+  return handle;
+}
+
+void caml_dlclose(void * handle)
+{
+  flexdll_dlclose(handle);
+}
+
+void * caml_dlsym(void * handle, const char * name)
+{
+  return flexdll_dlsym(handle, name);
+}
+
+void * caml_globalsym(const char * name)
+{
+  return flexdll_dlsym(flexdll_dlopen(NULL,0), name);
+}
+
+char * caml_dlerror(void)
+{
+  return flexdll_dlerror();
+}
+
+#else
+
+void * caml_dlopen(wchar_t * libname, int for_execution, int global)
+{
+  return NULL;
+}
+
+void caml_dlclose(void * handle)
+{
+}
+
+void * caml_dlsym(void * handle, const char * name)
+{
+  return NULL;
+}
+
+void * caml_globalsym(const char * name)
+{
+  return NULL;
+}
+
+char * caml_dlerror(void)
+{
+  return "dynamic loading not supported on this platform";
+}
+
+#endif
+
+/* Proper emulation of signal(), including ctrl-C and ctrl-break */
+
+typedef void (*sighandler)(int sig);
+static int ctrl_handler_installed = 0;
+static volatile sighandler ctrl_handler_action = SIG_DFL;
+
+static BOOL WINAPI ctrl_handler(DWORD event)
+{
+  /* Only ctrl-C and ctrl-Break are handled */
+  if (event != CTRL_C_EVENT && event != CTRL_BREAK_EVENT) return FALSE;
+  /* Default behavior is to exit, which we get by not handling the event */
+  if (ctrl_handler_action == SIG_DFL) return FALSE;
+  /* Ignore behavior is to do nothing, which we get by claiming that we
+     have handled the event */
+  if (ctrl_handler_action == SIG_IGN) return TRUE;
+  /* Win32 doesn't like it when we do a longjmp() at this point
+     (it looks like we're running in a different thread than
+     the main program!).  So, just record the signal. */
+  caml_record_signal(SIGINT);
+  /* We have handled the event */
+  return TRUE;
+}
+
+sighandler caml_win32_signal(int sig, sighandler action)
+{
+  sighandler oldaction;
+
+  if (sig != SIGINT) return signal(sig, action);
+  if (! ctrl_handler_installed) {
+    SetConsoleCtrlHandler(ctrl_handler, TRUE);
+    ctrl_handler_installed = 1;
+  }
+  oldaction = ctrl_handler_action;
+  ctrl_handler_action = action;
+  return oldaction;
+}
+
+/* Expansion of @responsefile and *? file patterns in the command line */
+
+static int argc;
+static wchar_t ** argv;
+static int argvsize;
+
+static void store_argument(wchar_t * arg);
+static void expand_argument(wchar_t * arg);
+static void expand_pattern(wchar_t * arg);
+
+static void out_of_memory(void)
+{
+  caml_fatal_error("out of memory while expanding command line");
+}
+
+static void store_argument(wchar_t * arg)
+{
+  if (argc + 1 >= argvsize) {
+    argvsize *= 2;
+    argv =
+      (wchar_t **) caml_stat_resize_noexc(argv, argvsize * sizeof(wchar_t *));
+    if (argv == NULL) out_of_memory();
+  }
+  argv[argc++] = arg;
+}
+
+static void expand_argument(wchar_t * arg)
+{
+  wchar_t * p;
+
+  for (p = arg; *p != 0; p++) {
+    if (*p == L'*' || *p == L'?') {
+      expand_pattern(arg);
+      return;
+    }
+  }
+  store_argument(arg);
+}
+
+static void expand_pattern(wchar_t * pat)
+{
+  wchar_t * prefix, * p, * name;
+  intptr_t handle;
+  struct _wfinddata_t ffblk;
+  size_t i;
+
+  handle = _wfindfirst(pat, &ffblk);
+  if (handle == -1) {
+    store_argument(pat); /* a la Bourne shell */
+    return;
+  }
+  prefix = caml_stat_wcsdup(pat);
+  /* We need to stop at the first directory or drive boundary, because the
+   * _findata_t structure contains the filename, not the leading directory. */
+  for (i = wcslen(prefix); i > 0; i--) {
+    wchar_t c = prefix[i - 1];
+    if (c == L'\\' || c == L'/' || c == L':') { prefix[i] = 0; break; }
+  }
+  /* No separator was found, it's a filename pattern without a leading
+     directory. */
+  if (i == 0)
+    prefix[0] = 0;
+  do {
+    name = caml_stat_wcsconcat(2, prefix, ffblk.name);
+    store_argument(name);
+  } while (_wfindnext(handle, &ffblk) != -1);
+  _findclose(handle);
+  caml_stat_free(prefix);
+}
+
+
+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]);
+  argv[argc] = NULL;
+  *argcp = argc;
+  *argvp = argv;
+}
+
+/* Add to [contents] the (short) names of the files contained in
+   the directory named [dirname].  No entries are added for [.] and [..].
+   Return 0 on success, -1 on error; set errno in the case of error. */
+
+int caml_read_directory(wchar_t * dirname, struct ext_table * contents)
+{
+  size_t dirnamelen;
+  wchar_t * template;
+  intptr_t h;
+  struct _wfinddata_t fileinfo;
+
+  dirnamelen = wcslen(dirname);
+  if (dirnamelen > 0 &&
+      (dirname[dirnamelen - 1] == L'/'
+       || dirname[dirnamelen - 1] == L'\\'
+       || dirname[dirnamelen - 1] == L':'))
+    template = caml_stat_wcsconcat(2, dirname, L"*.*");
+  else
+    template = caml_stat_wcsconcat(2, dirname, L"\\*.*");
+  h = _wfindfirst(template, &fileinfo);
+  if (h == -1) {
+    caml_stat_free(template);
+    return errno == ENOENT ? 0 : -1;
+  }
+  do {
+    if (wcscmp(fileinfo.name, L".") != 0 && wcscmp(fileinfo.name, L"..") != 0) {
+      caml_ext_table_add(contents, caml_stat_strdup_of_utf16(fileinfo.name));
+    }
+  } while (_wfindnext(h, &fileinfo) == 0);
+  _findclose(h);
+  caml_stat_free(template);
+  return 0;
+}
+
+#ifndef NATIVE_CODE
+
+/* Set up a new thread for control-C emulation and termination */
+
+void caml_signal_thread(void * lpParam)
+{
+  wchar_t *endptr;
+  HANDLE h;
+  /* Get an hexa-code raw handle through the environment */
+  h = (HANDLE) (uintptr_t)
+    wcstol(caml_secure_getenv(T("CAMLSIGPIPE")), &endptr, 16);
+  while (1) {
+    DWORD numread;
+    BOOL ret;
+    char iobuf[2];
+    /* This shall always return a single character */
+    ret = ReadFile(h, iobuf, 1, &numread, NULL);
+    if (!ret || numread != 1) caml_sys_exit(Val_int(2));
+    switch (iobuf[0]) {
+    case 'C':
+      caml_record_signal(SIGINT);
+      break;
+    case 'T':
+      raise(SIGTERM);
+      return;
+    }
+  }
+}
+
+#endif /* NATIVE_CODE */
+
+#if defined(NATIVE_CODE)
+
+/* Handling of system stack overflow.
+ * Based on code provided by Olivier Andrieu.
+
+ * An EXCEPTION_STACK_OVERFLOW is signaled when the guard page at the
+ * end of the stack has been accessed. Windows clears the PAGE_GUARD
+ * protection (making it a regular PAGE_READWRITE) and then calls our
+ * exception handler. This means that although we're handling an "out
+ * of stack" condition, there is a bit of stack available to call
+ * functions and allocate temporaries.
+ *
+ * PAGE_GUARD is a one-shot access protection mechanism: we need to
+ * restore the PAGE_GUARD protection on this page otherwise the next
+ * stack overflow won't be detected and the program will abruptly exit
+ * with STATUS_ACCESS_VIOLATION.
+ *
+ * Visual Studio 2003 and later (_MSC_VER >= 1300) have a
+ * _resetstkoflw() function that resets this protection.
+ * Unfortunately, it cannot work when called directly from the
+ * exception handler because at this point we are using the page that
+ * is to be protected.
+ *
+ * A solution is to use an alternate stack when restoring the
+ * protection. However it's not possible to use _resetstkoflw() then
+ * since it determines the stack pointer by calling alloca(): it would
+ * try to protect the alternate stack.
+ *
+ * Finally, we call caml_raise_stack_overflow; it will either call
+ * caml_raise_exception which switches back to the normal stack, or
+ * call caml_fatal_uncaught_exception which terminates the program
+ * quickly.
+ */
+
+static uintnat win32_alt_stack[0x100];
+
+static void caml_reset_stack (void *faulting_address)
+{
+  SYSTEM_INFO si;
+  DWORD page_size;
+  MEMORY_BASIC_INFORMATION mbi;
+  DWORD oldprot;
+
+  /* get the system's page size. */
+  GetSystemInfo (&si);
+  page_size = si.dwPageSize;
+
+  /* get some information on the page the fault occurred */
+  if (! VirtualQuery (faulting_address, &mbi, sizeof mbi))
+    goto failed;
+
+  VirtualProtect (mbi.BaseAddress, page_size,
+                  mbi.Protect | PAGE_GUARD, &oldprot);
+
+ failed:
+  caml_raise_stack_overflow();
+}
+
+
+#ifndef _WIN64
+static LONG CALLBACK
+    caml_stack_overflow_VEH (EXCEPTION_POINTERS* exn_info)
+{
+  DWORD code   = exn_info->ExceptionRecord->ExceptionCode;
+  CONTEXT *ctx = exn_info->ContextRecord;
+  DWORD *ctx_ip = &(ctx->Eip);
+  DWORD *ctx_sp = &(ctx->Esp);
+
+  if (code == EXCEPTION_STACK_OVERFLOW && Is_in_code_area (*ctx_ip))
+    {
+      uintnat faulting_address;
+      uintnat * alt_esp;
+
+      /* grab the address that caused the fault */
+      faulting_address = exn_info->ExceptionRecord->ExceptionInformation[1];
+
+      /* call caml_reset_stack(faulting_address) using the alternate stack */
+      alt_esp  = win32_alt_stack + sizeof(win32_alt_stack) / sizeof(uintnat);
+      *--alt_esp = faulting_address;
+      *ctx_sp = (uintnat) (alt_esp - 1);
+      *ctx_ip = (uintnat) &caml_reset_stack;
+
+      return EXCEPTION_CONTINUE_EXECUTION;
+    }
+
+  return EXCEPTION_CONTINUE_SEARCH;
+}
+
+#else
+
+/* Do not use the macro from address_class.h here. */
+#undef Is_in_code_area
+#define Is_in_code_area(pc) \
+ ( ((char *)(pc) >= caml_code_area_start && \
+    (char *)(pc) <= caml_code_area_end)     \
+|| ((char *)(pc) >= &caml_system__code_begin && \
+    (char *)(pc) <= &caml_system__code_end)     \
+|| (Classify_addr(pc) & In_code_area) )
+extern char caml_system__code_begin, caml_system__code_end;
+
+
+static LONG CALLBACK
+    caml_stack_overflow_VEH (EXCEPTION_POINTERS* exn_info)
+{
+  DWORD code   = exn_info->ExceptionRecord->ExceptionCode;
+  CONTEXT *ctx = exn_info->ContextRecord;
+
+  if (code == EXCEPTION_STACK_OVERFLOW && Is_in_code_area (ctx->Rip))
+    {
+      uintnat faulting_address;
+      uintnat * alt_rsp;
+
+      /* grab the address that caused the fault */
+      faulting_address = exn_info->ExceptionRecord->ExceptionInformation[1];
+
+      /* refresh runtime parameters from registers */
+      Caml_state->young_ptr = (value *) ctx->R15;
+
+      /* call caml_reset_stack(faulting_address) using the alternate stack */
+      alt_rsp  = win32_alt_stack + sizeof(win32_alt_stack) / sizeof(uintnat);
+      ctx->Rcx = faulting_address;
+      ctx->Rsp = (uintnat) (alt_rsp - 4 - 1);
+      ctx->Rip = (uintnat) &caml_reset_stack;
+
+      return EXCEPTION_CONTINUE_EXECUTION;
+    }
+
+  return EXCEPTION_CONTINUE_SEARCH;
+}
+#endif /* _WIN64 */
+
+static PVOID caml_stack_overflow_handle;
+
+void caml_win32_overflow_detection(void)
+{
+  caml_stack_overflow_handle =
+    AddVectoredExceptionHandler(1, caml_stack_overflow_VEH);
+  if (caml_stack_overflow_handle == NULL) {
+    caml_fatal_error("cannot install stack overflow detection");
+  }
+}
+
+void caml_win32_unregister_overflow_detection(void)
+{
+  RemoveVectoredExceptionHandler(caml_stack_overflow_handle);
+}
+
+#endif /* NATIVE_CODE */
+
+/* Seeding of pseudo-random number generators */
+
+int caml_win32_random_seed (intnat data[16])
+{
+  /* For better randomness, consider:
+     http://msdn.microsoft.com/library/en-us/seccrypto/security/rtlgenrandom.asp
+     http://blogs.msdn.com/b/michael_howard/archive/2005/01/14/353379.aspx
+  */
+  FILETIME t;
+  LARGE_INTEGER pc;
+  GetSystemTimeAsFileTime(&t);
+  QueryPerformanceCounter(&pc);  /* PR#6032 */
+  data[0] = t.dwLowDateTime;
+  data[1] = t.dwHighDateTime;
+  data[2] = GetCurrentProcessId();
+  data[3] = pc.LowPart;
+  data[4] = pc.HighPart;
+  return 5;
+}
+
+
+#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
+
+static void invalid_parameter_handler(const wchar_t* expression,
+   const wchar_t* function,
+   const wchar_t* file,
+   unsigned int line,
+   uintptr_t pReserved)
+{
+  /* no crash box */
+}
+
+
+void caml_install_invalid_parameter_handler()
+{
+  _set_invalid_parameter_handler(invalid_parameter_handler);
+}
+
+#endif
+
+
+/* Recover executable name  */
+
+wchar_t * caml_executable_name(void)
+{
+  wchar_t * name;
+  DWORD namelen, ret;
+
+  namelen = 256;
+  while (1) {
+    name = caml_stat_alloc(namelen*sizeof(wchar_t));
+    ret = GetModuleFileName(NULL, name, namelen);
+    if (ret == 0) { caml_stat_free(name); return NULL; }
+    if (ret < namelen) break;
+    caml_stat_free(name);
+    if (namelen >= 1024*1024) return NULL; /* avoid runaway and overflow */
+    namelen *= 2;
+  }
+  return name;
+}
+
+/* snprintf emulation */
+
+#define CAML_SNPRINTF(_vsnprintf, _vscprintf) \
+{ \
+  int len; \
+  va_list args; \
+\
+  if (size > 0) { \
+    va_start(args, format); \
+    len = _vsnprintf(buf, size, format, args); \
+    va_end(args); \
+    if (len >= 0 && len < size) { \
+      /* [len] characters were stored in [buf], \
+         a null-terminator was appended. */ \
+      return len; \
+    } \
+    /* [size] characters were stored in [buf], without null termination. \
+       Put a null terminator, truncating the output. */ \
+    buf[size - 1] = 0; \
+  } \
+  /* Compute the actual length of output, excluding null terminator */ \
+  va_start(args, format); \
+  len = _vscprintf(format, args); \
+  va_end(args); \
+  return len; \
+}
+
+#ifndef _UCRT
+int caml_snprintf(char * buf, size_t size, const char * format, ...)
+CAML_SNPRINTF(_vsnprintf, _vscprintf)
+#endif
+
+int caml_snwprintf(wchar_t * buf, size_t size, const wchar_t * format, ...)
+CAML_SNPRINTF(_vsnwprintf, _vscwprintf)
+
+#undef CAML_SNPRINTF
+
+wchar_t *caml_secure_getenv (wchar_t const *var)
+{
+  /* Win32 doesn't have a notion of setuid bit, so getenv is safe. */
+  return _wgetenv(var);
+}
+
+/* caml_win32_getenv is used to implement Sys.getenv and Unix.getenv in such a
+   way that they get direct access to the Win32 environment rather than to the
+   copy that is cached by the C runtime system. The result of caml_win32_getenv
+   is dynamically allocated and must be explicitly deallocated.
+
+   In contrast, the OCaml runtime system still calls _wgetenv from the C runtime
+   system, via caml_secure_getenv. The result is statically allocated and needs
+   no deallocation. */
+CAMLexport wchar_t *caml_win32_getenv(wchar_t const *lpName)
+{
+  wchar_t * lpBuffer;
+  DWORD nSize = 256, res;
+
+  lpBuffer = caml_stat_alloc_noexc(nSize * sizeof(wchar_t));
+
+  if (lpBuffer == NULL)
+    return NULL;
+
+  res = GetEnvironmentVariable(lpName, lpBuffer, nSize);
+
+  if (res == 0) {
+    caml_stat_free(lpBuffer);
+    return NULL;
+  }
+
+  if (res < nSize)
+    return lpBuffer;
+
+  nSize = res;
+  lpBuffer = caml_stat_resize_noexc(lpBuffer, nSize * sizeof(wchar_t));
+
+  if (lpBuffer == NULL)
+    return NULL;
+
+  res = GetEnvironmentVariable(lpName, lpBuffer, nSize);
+
+  if (res == 0 || res >= nSize) {
+    caml_stat_free(lpBuffer);
+    return NULL;
+  }
+
+  return lpBuffer;
+}
+
+/* The rename() implementation in MSVC's CRT is based on MoveFile()
+   and therefore fails if the new name exists.  This is inconsistent
+   with POSIX and a problem in practice.  Here we reimplement
+   rename() using MoveFileEx() to make it more POSIX-like.
+   There are no official guarantee that the rename operation is atomic,
+   but it is widely believed to be atomic on NTFS. */
+
+int caml_win32_rename(const wchar_t * oldpath, const wchar_t * newpath)
+{
+  /* MOVEFILE_REPLACE_EXISTING: to be closer to POSIX
+     MOVEFILE_COPY_ALLOWED: MoveFile performs a copy if old and new
+       paths are on different devices, so we do the same here for
+       compatibility with the old rename()-based implementation.
+     MOVEFILE_WRITE_THROUGH: not sure it's useful; affects only
+       the case where a copy is done. */
+  if (MoveFileEx(oldpath, newpath,
+                 MOVEFILE_REPLACE_EXISTING | MOVEFILE_WRITE_THROUGH |
+                 MOVEFILE_COPY_ALLOWED)) {
+    return 0;
+  }
+  /* Modest attempt at mapping Win32 error codes to POSIX error codes.
+     The __dosmaperr() function from the CRT does a better job but is
+     generally not accessible. */
+  switch (GetLastError()) {
+  case ERROR_FILE_NOT_FOUND: case ERROR_PATH_NOT_FOUND:
+    errno = ENOENT; break;
+  case ERROR_ACCESS_DENIED: case ERROR_WRITE_PROTECT: case ERROR_CANNOT_MAKE:
+    errno = EACCES; break;
+  case ERROR_CURRENT_DIRECTORY: case ERROR_BUSY:
+    errno = EBUSY; break;
+  case ERROR_NOT_SAME_DEVICE:
+    errno = EXDEV; break;
+  case ERROR_ALREADY_EXISTS:
+    errno = EEXIST; break;
+  default:
+    errno = EINVAL;
+  }
+  return -1;
+}
+
+/* Windows Unicode support */
+static uintnat windows_unicode_enabled = WINDOWS_UNICODE;
+
+/* If [windows_unicode_strict] is non-zero, then illegal UTF-8 characters (on
+   the OCaml side) or illegal UTF-16 characters (on the Windows side) cause an
+   error to be signaled.  What happens then depends on the variable
+   [windows_unicode_fallback].
+
+   If [windows_unicode_strict] is zero, then illegal characters are silently
+   dropped. */
+static uintnat windows_unicode_strict = 1;
+
+/* If [windows_unicode_fallback] is non-zero, then if an error is signaled when
+   translating to UTF-16, the translation is re-done under the assumption that
+   the argument string is encoded in the local codepage. */
+static uintnat windows_unicode_fallback = 1;
+
+CAMLexport int win_multi_byte_to_wide_char(const char *s, int slen,
+                                           wchar_t *out, int outlen)
+{
+  int retcode;
+
+  CAMLassert (s != NULL);
+
+  if (slen == 0)
+    return 0;
+
+  if (windows_unicode_enabled != 0) {
+    retcode =
+      MultiByteToWideChar(CP_UTF8,
+                          windows_unicode_strict ? MB_ERR_INVALID_CHARS : 0,
+                          s, slen, out, outlen);
+    if (retcode == 0 && windows_unicode_fallback != 0)
+      retcode = MultiByteToWideChar(CP_ACP, 0, s, slen, out, outlen);
+  } else {
+    retcode = MultiByteToWideChar(CP_ACP, 0, s, slen, out, outlen);
+  }
+
+  if (retcode == 0)
+    caml_win32_sys_error(GetLastError());
+
+  return retcode;
+}
+
+/* For old versions of Windows we simply ignore the flag */
+#ifndef WC_ERR_INVALID_CHARS
+#define WC_ERR_INVALID_CHARS 0
+#endif
+
+CAMLexport int win_wide_char_to_multi_byte(const wchar_t *s, int slen,
+                                           char *out, int outlen)
+{
+  int retcode;
+
+  CAMLassert(s != NULL);
+
+  if (slen == 0)
+    return 0;
+
+  if (windows_unicode_enabled != 0)
+    retcode =
+      WideCharToMultiByte(CP_UTF8,
+                          windows_unicode_strict ? WC_ERR_INVALID_CHARS : 0,
+                          s, slen, out, outlen, NULL, NULL);
+  else
+    retcode =
+      WideCharToMultiByte(CP_ACP, 0, s, slen, out, outlen, NULL, NULL);
+
+  if (retcode == 0)
+    caml_win32_sys_error(GetLastError());
+
+  return retcode;
+}
+
+CAMLexport value caml_copy_string_of_utf16(const wchar_t *s)
+{
+  int retcode, slen;
+  value v;
+
+  slen = wcslen(s);
+  /* Do not include final NULL */
+  retcode = win_wide_char_to_multi_byte(s, slen, NULL, 0);
+  v = caml_alloc_string(retcode);
+  win_wide_char_to_multi_byte(s, slen, (char *)String_val(v), retcode);
+
+  return v;
+}
+
+CAMLexport wchar_t* caml_stat_strdup_to_utf16(const char *s)
+{
+  wchar_t * ws;
+  int retcode;
+
+  retcode = win_multi_byte_to_wide_char(s, -1, NULL, 0);
+  ws = caml_stat_alloc_noexc(retcode * sizeof(*ws));
+  win_multi_byte_to_wide_char(s, -1, ws, retcode);
+
+  return ws;
+}
+
+CAMLexport caml_stat_string caml_stat_strdup_of_utf16(const wchar_t *s)
+{
+  caml_stat_string out;
+  int retcode;
+
+  retcode = win_wide_char_to_multi_byte(s, -1, NULL, 0);
+  out = caml_stat_alloc(retcode);
+  win_wide_char_to_multi_byte(s, -1, out, retcode);
+
+  return out;
+}
+
+void caml_probe_win32_version(void)
+{
+  /* Determine the version of Windows we're running, and cache it */
+  WCHAR fileName[MAX_PATH];
+  DWORD size =
+    GetModuleFileName(GetModuleHandle(L"kernel32"), fileName, MAX_PATH);
+  DWORD dwHandle = 0;
+  BYTE* versionInfo;
+  fileName[size] = 0;
+  size = GetFileVersionInfoSize(fileName, &dwHandle);
+  versionInfo = (BYTE*)malloc(size * sizeof(BYTE));
+  if (GetFileVersionInfo(fileName, 0, size, versionInfo)) {
+    UINT len = 0;
+    VS_FIXEDFILEINFO* vsfi = NULL;
+    VerQueryValue(versionInfo, L"\\", (void**)&vsfi, &len);
+    caml_win32_major = HIWORD(vsfi->dwProductVersionMS);
+    caml_win32_minor = LOWORD(vsfi->dwProductVersionMS);
+    caml_win32_build = HIWORD(vsfi->dwProductVersionLS);
+    caml_win32_revision = LOWORD(vsfi->dwProductVersionLS);
+  }
+  free(versionInfo);
+}
+
+static UINT startup_codepage = 0;
+
+void caml_setup_win32_terminal(void)
+{
+  if (caml_win32_major >= 10) {
+    startup_codepage = GetConsoleOutputCP();
+    if (startup_codepage != CP_UTF8)
+      SetConsoleOutputCP(CP_UTF8);
+  }
+}
+
+void caml_restore_win32_terminal(void)
+{
+  if (startup_codepage != 0)
+    SetConsoleOutputCP(startup_codepage);
+}
+
+/* Detect if a named pipe corresponds to a Cygwin/MSYS pty: see
+   https://github.com/mirror/newlib-cygwin/blob/00e9bf2/winsup/cygwin/dtable.cc#L932
+*/
+typedef
+BOOL (WINAPI *tGetFileInformationByHandleEx)(HANDLE, FILE_INFO_BY_HANDLE_CLASS,
+                                             LPVOID, DWORD);
+
+static int caml_win32_is_cygwin_pty(HANDLE hFile)
+{
+  char buffer[1024];
+  FILE_NAME_INFO * nameinfo = (FILE_NAME_INFO *) buffer;
+  static tGetFileInformationByHandleEx pGetFileInformationByHandleEx =
+    INVALID_HANDLE_VALUE;
+
+  if (pGetFileInformationByHandleEx == INVALID_HANDLE_VALUE)
+    pGetFileInformationByHandleEx =
+      (tGetFileInformationByHandleEx)GetProcAddress(
+        GetModuleHandle(L"KERNEL32.DLL"), "GetFileInformationByHandleEx");
+
+  if (pGetFileInformationByHandleEx == NULL)
+    return 0;
+
+  /* Get pipe name. GetFileInformationByHandleEx does not NULL-terminate the
+     string, so reduce the buffer size to allow for adding one. */
+  if (! pGetFileInformationByHandleEx(hFile,
+                                      FileNameInfo,
+                                      buffer,
+                                      sizeof(buffer) - sizeof(WCHAR)))
+    return 0;
+
+  nameinfo->FileName[nameinfo->FileNameLength / sizeof(WCHAR)] = L'\0';
+
+  /* check if this could be a msys pty pipe ('msys-XXXX-ptyN-XX')
+     or a cygwin pty pipe ('cygwin-XXXX-ptyN-XX') */
+  if ((wcsstr(nameinfo->FileName, L"msys-") ||
+       wcsstr(nameinfo->FileName, L"cygwin-")) &&
+         wcsstr(nameinfo->FileName, L"-pty"))
+    return 1;
+
+  return 0;
+}
+
+CAMLexport int caml_win32_isatty(int fd)
+{
+  DWORD lpMode;
+  HANDLE hFile = (HANDLE)_get_osfhandle(fd);
+
+  if (hFile == INVALID_HANDLE_VALUE)
+    return 0;
+
+  switch (GetFileType(hFile)) {
+    case FILE_TYPE_CHAR:
+      /* Both console handles and the NUL device are FILE_TYPE_CHAR.  The NUL
+         device returns FALSE for a GetConsoleMode call. _isatty incorrectly
+         only uses GetFileType (see GPR#1321). */
+      return GetConsoleMode(hFile, &lpMode);
+    case FILE_TYPE_PIPE:
+      /* Cygwin PTYs are implemented using named pipes */
+      return caml_win32_is_cygwin_pty(hFile);
+    default:
+      break;
+  }
+
+  return 0;
+}
+
+int caml_num_rows_fd(int fd)
+{
+  return -1;
+}
diff --git a/stdlib/.depend b/stdlib/.depend
new file mode 100644
index 00000000..2c167666
--- /dev/null
+++ b/stdlib/.depend
@@ -0,0 +1,688 @@
+stdlib__arg.cmo : \
+    stdlib__sys.cmi \
+    stdlib__string.cmi \
+    stdlib__printf.cmi \
+    stdlib__list.cmi \
+    stdlib__buffer.cmi \
+    stdlib__array.cmi \
+    stdlib__arg.cmi
+stdlib__arg.cmx : \
+    stdlib__sys.cmx \
+    stdlib__string.cmx \
+    stdlib__printf.cmx \
+    stdlib__list.cmx \
+    stdlib__buffer.cmx \
+    stdlib__array.cmx \
+    stdlib__arg.cmi
+stdlib__arg.cmi :
+stdlib__array.cmo : \
+    stdlib__seq.cmi \
+    stdlib__array.cmi
+stdlib__array.cmx : \
+    stdlib__seq.cmx \
+    stdlib__array.cmi
+stdlib__array.cmi : \
+    stdlib__seq.cmi
+stdlib__arrayLabels.cmo : \
+    stdlib__array.cmi \
+    stdlib__arrayLabels.cmi
+stdlib__arrayLabels.cmx : \
+    stdlib__array.cmx \
+    stdlib__arrayLabels.cmi
+stdlib__arrayLabels.cmi : \
+    stdlib__seq.cmi
+stdlib__bigarray.cmo : \
+    stdlib__sys.cmi \
+    stdlib__complex.cmi \
+    stdlib__array.cmi \
+    stdlib__bigarray.cmi
+stdlib__bigarray.cmx : \
+    stdlib__sys.cmx \
+    stdlib__complex.cmx \
+    stdlib__array.cmx \
+    stdlib__bigarray.cmi
+stdlib__bigarray.cmi : \
+    stdlib__complex.cmi
+stdlib__bool.cmo : \
+    stdlib.cmi \
+    stdlib__bool.cmi
+stdlib__bool.cmx : \
+    stdlib.cmx \
+    stdlib__bool.cmi
+stdlib__bool.cmi :
+stdlib__buffer.cmo : \
+    stdlib__uchar.cmi \
+    stdlib__sys.cmi \
+    stdlib__string.cmi \
+    stdlib__seq.cmi \
+    stdlib__char.cmi \
+    stdlib__bytes.cmi \
+    stdlib__buffer.cmi
+stdlib__buffer.cmx : \
+    stdlib__uchar.cmx \
+    stdlib__sys.cmx \
+    stdlib__string.cmx \
+    stdlib__seq.cmx \
+    stdlib__char.cmx \
+    stdlib__bytes.cmx \
+    stdlib__buffer.cmi
+stdlib__buffer.cmi : \
+    stdlib__uchar.cmi \
+    stdlib__seq.cmi
+stdlib__bytes.cmo : \
+    stdlib__sys.cmi \
+    stdlib.cmi \
+    stdlib__seq.cmi \
+    stdlib__char.cmi \
+    stdlib__bytes.cmi
+stdlib__bytes.cmx : \
+    stdlib__sys.cmx \
+    stdlib.cmx \
+    stdlib__seq.cmx \
+    stdlib__char.cmx \
+    stdlib__bytes.cmi
+stdlib__bytes.cmi : \
+    stdlib__seq.cmi
+stdlib__bytesLabels.cmo : \
+    stdlib__bytes.cmi \
+    stdlib__bytesLabels.cmi
+stdlib__bytesLabels.cmx : \
+    stdlib__bytes.cmx \
+    stdlib__bytesLabels.cmi
+stdlib__bytesLabels.cmi : \
+    stdlib__seq.cmi
+stdlib__callback.cmo : \
+    stdlib__obj.cmi \
+    stdlib__callback.cmi
+stdlib__callback.cmx : \
+    stdlib__obj.cmx \
+    stdlib__callback.cmi
+stdlib__callback.cmi :
+camlinternalFormat.cmo : \
+    stdlib__sys.cmi \
+    stdlib__string.cmi \
+    stdlib__int.cmi \
+    stdlib__char.cmi \
+    camlinternalFormatBasics.cmi \
+    stdlib__bytes.cmi \
+    stdlib__buffer.cmi \
+    camlinternalFormat.cmi
+camlinternalFormat.cmx : \
+    stdlib__sys.cmx \
+    stdlib__string.cmx \
+    stdlib__int.cmx \
+    stdlib__char.cmx \
+    camlinternalFormatBasics.cmx \
+    stdlib__bytes.cmx \
+    stdlib__buffer.cmx \
+    camlinternalFormat.cmi
+camlinternalFormat.cmi : \
+    camlinternalFormatBasics.cmi \
+    stdlib__buffer.cmi
+camlinternalFormatBasics.cmo : \
+    camlinternalFormatBasics.cmi
+camlinternalFormatBasics.cmx : \
+    camlinternalFormatBasics.cmi
+camlinternalFormatBasics.cmi :
+camlinternalLazy.cmo : \
+    stdlib__obj.cmi \
+    camlinternalLazy.cmi
+camlinternalLazy.cmx : \
+    stdlib__obj.cmx \
+    camlinternalLazy.cmi
+camlinternalLazy.cmi :
+camlinternalMod.cmo : \
+    stdlib__sys.cmi \
+    stdlib__obj.cmi \
+    camlinternalOO.cmi \
+    stdlib__array.cmi \
+    camlinternalMod.cmi
+camlinternalMod.cmx : \
+    stdlib__sys.cmx \
+    stdlib__obj.cmx \
+    camlinternalOO.cmx \
+    stdlib__array.cmx \
+    camlinternalMod.cmi
+camlinternalMod.cmi : \
+    stdlib__obj.cmi
+camlinternalOO.cmo : \
+    stdlib__sys.cmi \
+    stdlib__string.cmi \
+    stdlib__obj.cmi \
+    stdlib__map.cmi \
+    stdlib__list.cmi \
+    stdlib__char.cmi \
+    stdlib__array.cmi \
+    camlinternalOO.cmi
+camlinternalOO.cmx : \
+    stdlib__sys.cmx \
+    stdlib__string.cmx \
+    stdlib__obj.cmx \
+    stdlib__map.cmx \
+    stdlib__list.cmx \
+    stdlib__char.cmx \
+    stdlib__array.cmx \
+    camlinternalOO.cmi
+camlinternalOO.cmi : \
+    stdlib__obj.cmi
+stdlib__char.cmo : \
+    stdlib__char.cmi
+stdlib__char.cmx : \
+    stdlib__char.cmi
+stdlib__char.cmi :
+stdlib__complex.cmo : \
+    stdlib__complex.cmi
+stdlib__complex.cmx : \
+    stdlib__complex.cmi
+stdlib__complex.cmi :
+stdlib__digest.cmo : \
+    stdlib__string.cmi \
+    stdlib__char.cmi \
+    stdlib__bytes.cmi \
+    stdlib__digest.cmi
+stdlib__digest.cmx : \
+    stdlib__string.cmx \
+    stdlib__char.cmx \
+    stdlib__bytes.cmx \
+    stdlib__digest.cmi
+stdlib__digest.cmi :
+stdlib__ephemeron.cmo : \
+    stdlib__sys.cmi \
+    stdlib__seq.cmi \
+    stdlib__random.cmi \
+    stdlib__obj.cmi \
+    stdlib__lazy.cmi \
+    stdlib__hashtbl.cmi \
+    stdlib__array.cmi \
+    stdlib__ephemeron.cmi
+stdlib__ephemeron.cmx : \
+    stdlib__sys.cmx \
+    stdlib__seq.cmx \
+    stdlib__random.cmx \
+    stdlib__obj.cmx \
+    stdlib__lazy.cmx \
+    stdlib__hashtbl.cmx \
+    stdlib__array.cmx \
+    stdlib__ephemeron.cmi
+stdlib__ephemeron.cmi : \
+    stdlib__hashtbl.cmi
+stdlib__filename.cmo : \
+    stdlib__sys.cmi \
+    stdlib__string.cmi \
+    stdlib__random.cmi \
+    stdlib__printf.cmi \
+    stdlib__list.cmi \
+    stdlib__lazy.cmi \
+    stdlib__buffer.cmi \
+    stdlib__filename.cmi
+stdlib__filename.cmx : \
+    stdlib__sys.cmx \
+    stdlib__string.cmx \
+    stdlib__random.cmx \
+    stdlib__printf.cmx \
+    stdlib__list.cmx \
+    stdlib__lazy.cmx \
+    stdlib__buffer.cmx \
+    stdlib__filename.cmi
+stdlib__filename.cmi :
+stdlib__float.cmo : \
+    stdlib.cmi \
+    stdlib__seq.cmi \
+    stdlib__list.cmi \
+    stdlib__array.cmi \
+    stdlib__float.cmi
+stdlib__float.cmx : \
+    stdlib.cmx \
+    stdlib__seq.cmx \
+    stdlib__list.cmx \
+    stdlib__array.cmx \
+    stdlib__float.cmi
+stdlib__float.cmi : \
+    stdlib.cmi \
+    stdlib__seq.cmi
+stdlib__format.cmo : \
+    stdlib__string.cmi \
+    stdlib.cmi \
+    stdlib__stack.cmi \
+    stdlib__queue.cmi \
+    stdlib__list.cmi \
+    stdlib__int.cmi \
+    camlinternalFormatBasics.cmi \
+    camlinternalFormat.cmi \
+    stdlib__buffer.cmi \
+    stdlib__format.cmi
+stdlib__format.cmx : \
+    stdlib__string.cmx \
+    stdlib.cmx \
+    stdlib__stack.cmx \
+    stdlib__queue.cmx \
+    stdlib__list.cmx \
+    stdlib__int.cmx \
+    camlinternalFormatBasics.cmx \
+    camlinternalFormat.cmx \
+    stdlib__buffer.cmx \
+    stdlib__format.cmi
+stdlib__format.cmi : \
+    stdlib.cmi \
+    stdlib__buffer.cmi
+stdlib__fun.cmo : \
+    stdlib__printexc.cmi \
+    stdlib__fun.cmi
+stdlib__fun.cmx : \
+    stdlib__printexc.cmx \
+    stdlib__fun.cmi
+stdlib__fun.cmi :
+stdlib__gc.cmo : \
+    stdlib__sys.cmi \
+    stdlib__string.cmi \
+    stdlib__printf.cmi \
+    stdlib__printexc.cmi \
+    stdlib__gc.cmi
+stdlib__gc.cmx : \
+    stdlib__sys.cmx \
+    stdlib__string.cmx \
+    stdlib__printf.cmx \
+    stdlib__printexc.cmx \
+    stdlib__gc.cmi
+stdlib__gc.cmi : \
+    stdlib__printexc.cmi
+stdlib__genlex.cmo : \
+    stdlib__string.cmi \
+    stdlib__stream.cmi \
+    stdlib__list.cmi \
+    stdlib__hashtbl.cmi \
+    stdlib__char.cmi \
+    stdlib__bytes.cmi \
+    stdlib__genlex.cmi
+stdlib__genlex.cmx : \
+    stdlib__string.cmx \
+    stdlib__stream.cmx \
+    stdlib__list.cmx \
+    stdlib__hashtbl.cmx \
+    stdlib__char.cmx \
+    stdlib__bytes.cmx \
+    stdlib__genlex.cmi
+stdlib__genlex.cmi : \
+    stdlib__stream.cmi
+stdlib__hashtbl.cmo : \
+    stdlib__sys.cmi \
+    stdlib__string.cmi \
+    stdlib__seq.cmi \
+    stdlib__random.cmi \
+    stdlib__obj.cmi \
+    stdlib__lazy.cmi \
+    stdlib__array.cmi \
+    stdlib__hashtbl.cmi
+stdlib__hashtbl.cmx : \
+    stdlib__sys.cmx \
+    stdlib__string.cmx \
+    stdlib__seq.cmx \
+    stdlib__random.cmx \
+    stdlib__obj.cmx \
+    stdlib__lazy.cmx \
+    stdlib__array.cmx \
+    stdlib__hashtbl.cmi
+stdlib__hashtbl.cmi : \
+    stdlib__seq.cmi
+stdlib__int.cmo : \
+    stdlib.cmi \
+    stdlib__int.cmi
+stdlib__int.cmx : \
+    stdlib.cmx \
+    stdlib__int.cmi
+stdlib__int.cmi :
+stdlib__int32.cmo : \
+    stdlib__sys.cmi \
+    stdlib.cmi \
+    stdlib__int32.cmi
+stdlib__int32.cmx : \
+    stdlib__sys.cmx \
+    stdlib.cmx \
+    stdlib__int32.cmi
+stdlib__int32.cmi :
+stdlib__int64.cmo : \
+    stdlib.cmi \
+    stdlib__int64.cmi
+stdlib__int64.cmx : \
+    stdlib.cmx \
+    stdlib__int64.cmi
+stdlib__int64.cmi :
+stdlib__lazy.cmo : \
+    stdlib__obj.cmi \
+    camlinternalLazy.cmi \
+    stdlib__lazy.cmi
+stdlib__lazy.cmx : \
+    stdlib__obj.cmx \
+    camlinternalLazy.cmx \
+    stdlib__lazy.cmi
+stdlib__lazy.cmi : \
+    camlinternalLazy.cmi
+stdlib__lexing.cmo : \
+    stdlib__sys.cmi \
+    stdlib__string.cmi \
+    stdlib__bytes.cmi \
+    stdlib__array.cmi \
+    stdlib__lexing.cmi
+stdlib__lexing.cmx : \
+    stdlib__sys.cmx \
+    stdlib__string.cmx \
+    stdlib__bytes.cmx \
+    stdlib__array.cmx \
+    stdlib__lexing.cmi
+stdlib__lexing.cmi :
+stdlib__list.cmo : \
+    stdlib__sys.cmi \
+    stdlib__seq.cmi \
+    stdlib__list.cmi
+stdlib__list.cmx : \
+    stdlib__sys.cmx \
+    stdlib__seq.cmx \
+    stdlib__list.cmi
+stdlib__list.cmi : \
+    stdlib__seq.cmi
+stdlib__listLabels.cmo : \
+    stdlib__list.cmi \
+    stdlib__listLabels.cmi
+stdlib__listLabels.cmx : \
+    stdlib__list.cmx \
+    stdlib__listLabels.cmi
+stdlib__listLabels.cmi : \
+    stdlib__seq.cmi
+stdlib__map.cmo : \
+    stdlib__seq.cmi \
+    stdlib__map.cmi
+stdlib__map.cmx : \
+    stdlib__seq.cmx \
+    stdlib__map.cmi
+stdlib__map.cmi : \
+    stdlib__seq.cmi
+stdlib__marshal.cmo : \
+    stdlib__bytes.cmi \
+    stdlib__marshal.cmi
+stdlib__marshal.cmx : \
+    stdlib__bytes.cmx \
+    stdlib__marshal.cmi
+stdlib__marshal.cmi :
+stdlib__moreLabels.cmo : \
+    stdlib__set.cmi \
+    stdlib__map.cmi \
+    stdlib__hashtbl.cmi \
+    stdlib__moreLabels.cmi
+stdlib__moreLabels.cmx : \
+    stdlib__set.cmx \
+    stdlib__map.cmx \
+    stdlib__hashtbl.cmx \
+    stdlib__moreLabels.cmi
+stdlib__moreLabels.cmi : \
+    stdlib__set.cmi \
+    stdlib__seq.cmi \
+    stdlib__map.cmi \
+    stdlib__hashtbl.cmi
+stdlib__nativeint.cmo : \
+    stdlib__sys.cmi \
+    stdlib.cmi \
+    stdlib__nativeint.cmi
+stdlib__nativeint.cmx : \
+    stdlib__sys.cmx \
+    stdlib.cmx \
+    stdlib__nativeint.cmi
+stdlib__nativeint.cmi :
+stdlib__obj.cmo : \
+    stdlib__sys.cmi \
+    stdlib__marshal.cmi \
+    stdlib__int32.cmi \
+    stdlib__obj.cmi
+stdlib__obj.cmx : \
+    stdlib__sys.cmx \
+    stdlib__marshal.cmx \
+    stdlib__int32.cmx \
+    stdlib__obj.cmi
+stdlib__obj.cmi : \
+    stdlib__int32.cmi
+stdlib__oo.cmo : \
+    camlinternalOO.cmi \
+    stdlib__oo.cmi
+stdlib__oo.cmx : \
+    camlinternalOO.cmx \
+    stdlib__oo.cmi
+stdlib__oo.cmi : \
+    camlinternalOO.cmi
+stdlib__option.cmo : \
+    stdlib__seq.cmi \
+    stdlib__option.cmi
+stdlib__option.cmx : \
+    stdlib__seq.cmx \
+    stdlib__option.cmi
+stdlib__option.cmi : \
+    stdlib__seq.cmi
+stdlib__parsing.cmo : \
+    stdlib__obj.cmi \
+    stdlib__lexing.cmi \
+    stdlib__array.cmi \
+    stdlib__parsing.cmi
+stdlib__parsing.cmx : \
+    stdlib__obj.cmx \
+    stdlib__lexing.cmx \
+    stdlib__array.cmx \
+    stdlib__parsing.cmi
+stdlib__parsing.cmi : \
+    stdlib__obj.cmi \
+    stdlib__lexing.cmi
+stdlib__pervasives.cmo : \
+    camlinternalFormatBasics.cmi
+stdlib__pervasives.cmx : \
+    camlinternalFormatBasics.cmx
+stdlib__printexc.cmo : \
+    stdlib.cmi \
+    stdlib__printf.cmi \
+    stdlib__obj.cmi \
+    stdlib__buffer.cmi \
+    stdlib__array.cmi \
+    stdlib__printexc.cmi
+stdlib__printexc.cmx : \
+    stdlib.cmx \
+    stdlib__printf.cmx \
+    stdlib__obj.cmx \
+    stdlib__buffer.cmx \
+    stdlib__array.cmx \
+    stdlib__printexc.cmi
+stdlib__printexc.cmi :
+stdlib__printf.cmo : \
+    camlinternalFormatBasics.cmi \
+    camlinternalFormat.cmi \
+    stdlib__buffer.cmi \
+    stdlib__printf.cmi
+stdlib__printf.cmx : \
+    camlinternalFormatBasics.cmx \
+    camlinternalFormat.cmx \
+    stdlib__buffer.cmx \
+    stdlib__printf.cmi
+stdlib__printf.cmi : \
+    stdlib__buffer.cmi
+stdlib__queue.cmo : \
+    stdlib__seq.cmi \
+    stdlib__queue.cmi
+stdlib__queue.cmx : \
+    stdlib__seq.cmx \
+    stdlib__queue.cmi
+stdlib__queue.cmi : \
+    stdlib__seq.cmi
+stdlib__random.cmo : \
+    stdlib__string.cmi \
+    stdlib.cmi \
+    stdlib__nativeint.cmi \
+    stdlib__int64.cmi \
+    stdlib__int32.cmi \
+    stdlib__int.cmi \
+    stdlib__digest.cmi \
+    stdlib__char.cmi \
+    stdlib__array.cmi \
+    stdlib__random.cmi
+stdlib__random.cmx : \
+    stdlib__string.cmx \
+    stdlib.cmx \
+    stdlib__nativeint.cmx \
+    stdlib__int64.cmx \
+    stdlib__int32.cmx \
+    stdlib__int.cmx \
+    stdlib__digest.cmx \
+    stdlib__char.cmx \
+    stdlib__array.cmx \
+    stdlib__random.cmi
+stdlib__random.cmi : \
+    stdlib__nativeint.cmi \
+    stdlib__int64.cmi \
+    stdlib__int32.cmi
+stdlib__result.cmo : \
+    stdlib__seq.cmi \
+    stdlib__result.cmi
+stdlib__result.cmx : \
+    stdlib__seq.cmx \
+    stdlib__result.cmi
+stdlib__result.cmi : \
+    stdlib__seq.cmi
+stdlib__scanf.cmo : \
+    stdlib__string.cmi \
+    stdlib.cmi \
+    stdlib__printf.cmi \
+    stdlib__list.cmi \
+    camlinternalFormatBasics.cmi \
+    camlinternalFormat.cmi \
+    stdlib__bytes.cmi \
+    stdlib__buffer.cmi \
+    stdlib__scanf.cmi
+stdlib__scanf.cmx : \
+    stdlib__string.cmx \
+    stdlib.cmx \
+    stdlib__printf.cmx \
+    stdlib__list.cmx \
+    camlinternalFormatBasics.cmx \
+    camlinternalFormat.cmx \
+    stdlib__bytes.cmx \
+    stdlib__buffer.cmx \
+    stdlib__scanf.cmi
+stdlib__scanf.cmi : \
+    stdlib.cmi
+stdlib__seq.cmo : \
+    stdlib__seq.cmi
+stdlib__seq.cmx : \
+    stdlib__seq.cmi
+stdlib__seq.cmi :
+stdlib__set.cmo : \
+    stdlib__seq.cmi \
+    stdlib__list.cmi \
+    stdlib__set.cmi
+stdlib__set.cmx : \
+    stdlib__seq.cmx \
+    stdlib__list.cmx \
+    stdlib__set.cmi
+stdlib__set.cmi : \
+    stdlib__seq.cmi
+stdlib__spacetime.cmo : \
+    stdlib__gc.cmi \
+    stdlib__spacetime.cmi
+stdlib__spacetime.cmx : \
+    stdlib__gc.cmx \
+    stdlib__spacetime.cmi
+stdlib__spacetime.cmi :
+stdlib__stack.cmo : \
+    stdlib__seq.cmi \
+    stdlib__list.cmi \
+    stdlib__stack.cmi
+stdlib__stack.cmx : \
+    stdlib__seq.cmx \
+    stdlib__list.cmx \
+    stdlib__stack.cmi
+stdlib__stack.cmi : \
+    stdlib__seq.cmi
+stdlib__stdLabels.cmo : \
+    stdlib__stringLabels.cmi \
+    stdlib__listLabels.cmi \
+    stdlib__bytesLabels.cmi \
+    stdlib__arrayLabels.cmi \
+    stdlib__stdLabels.cmi
+stdlib__stdLabels.cmx : \
+    stdlib__stringLabels.cmx \
+    stdlib__listLabels.cmx \
+    stdlib__bytesLabels.cmx \
+    stdlib__arrayLabels.cmx \
+    stdlib__stdLabels.cmi
+stdlib__stdLabels.cmi : \
+    stdlib__stringLabels.cmi \
+    stdlib__listLabels.cmi \
+    stdlib__bytesLabels.cmi \
+    stdlib__arrayLabels.cmi
+std_exit.cmo :
+std_exit.cmx :
+stdlib__stream.cmo : \
+    stdlib__string.cmi \
+    stdlib__list.cmi \
+    stdlib__lazy.cmi \
+    stdlib__bytes.cmi \
+    stdlib__stream.cmi
+stdlib__stream.cmx : \
+    stdlib__string.cmx \
+    stdlib__list.cmx \
+    stdlib__lazy.cmx \
+    stdlib__bytes.cmx \
+    stdlib__stream.cmi
+stdlib__stream.cmi :
+stdlib__string.cmo : \
+    stdlib.cmi \
+    stdlib__bytes.cmi \
+    stdlib__string.cmi
+stdlib__string.cmx : \
+    stdlib.cmx \
+    stdlib__bytes.cmx \
+    stdlib__string.cmi
+stdlib__string.cmi : \
+    stdlib__seq.cmi
+stdlib__stringLabels.cmo : \
+    stdlib__string.cmi \
+    stdlib__stringLabels.cmi
+stdlib__stringLabels.cmx : \
+    stdlib__string.cmx \
+    stdlib__stringLabels.cmi
+stdlib__stringLabels.cmi : \
+    stdlib__seq.cmi
+stdlib__sys.cmo : \
+    stdlib__sys.cmi
+stdlib__sys.cmx : \
+    stdlib__sys.cmi
+stdlib__sys.cmi :
+stdlib__uchar.cmo : \
+    stdlib.cmi \
+    stdlib__char.cmi \
+    stdlib__uchar.cmi
+stdlib__uchar.cmx : \
+    stdlib.cmx \
+    stdlib__char.cmx \
+    stdlib__uchar.cmi
+stdlib__uchar.cmi :
+stdlib__unit.cmo : \
+    stdlib__unit.cmi
+stdlib__unit.cmx : \
+    stdlib__unit.cmi
+stdlib__unit.cmi :
+stdlib__weak.cmo : \
+    stdlib__sys.cmi \
+    stdlib__obj.cmi \
+    stdlib__hashtbl.cmi \
+    stdlib__array.cmi \
+    stdlib__weak.cmi
+stdlib__weak.cmx : \
+    stdlib__sys.cmx \
+    stdlib__obj.cmx \
+    stdlib__hashtbl.cmx \
+    stdlib__array.cmx \
+    stdlib__weak.cmi
+stdlib__weak.cmi : \
+    stdlib__hashtbl.cmi
+stdlib.cmo : \
+    camlinternalFormatBasics.cmi \
+    stdlib.cmi
+stdlib.cmx : \
+    camlinternalFormatBasics.cmx \
+    stdlib.cmi
+stdlib.cmi : \
+    camlinternalFormatBasics.cmi
diff --git a/stdlib/Compflags b/stdlib/Compflags
new file mode 100755
index 00000000..e2262d3c
--- /dev/null
+++ b/stdlib/Compflags
@@ -0,0 +1,35 @@
+#!/bin/sh
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 2004 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.          *
+#*                                                                        *
+#**************************************************************************
+
+case $1 in
+  stdlib.cm[iox])
+      echo ' -nopervasives -no-alias-deps -w -49' \
+           ' -pp "$AWK -f ./expand_module_aliases.awk"';;
+  camlinternalOO.cmx) echo ' -inline 0 -afl-inst-ratio 0';;
+  camlinternalLazy.cmx) echo ' -afl-inst-ratio 0';;
+    # never instrument camlinternalOO or camlinternalLazy (PR#7725)
+  stdlib__buffer.cmx) echo ' -inline 3';;
+                           # make sure add_char is inlined (PR#5872)
+  stdlib__buffer.cm[io]) echo ' -w A';;
+  camlinternalFormat.cm[io]) echo ' -w Ae';;
+  camlinternalFormatBasics*.cm[iox]) echo ' -nopervasives';;
+  stdlib__printf.cm[io]|stdlib__format.cm[io]|stdlib__scanf.cm[io])
+      echo ' -w Ae';;
+  stdlib__scanf.cmx) echo ' -inline 9';;
+  *Labels.cm[ox]) echo ' -nolabels -no-alias-deps';;
+  stdlib__float.cm[ox]) echo ' -nolabels -no-alias-deps';;
+  *) echo ' ';;
+esac
diff --git a/stdlib/HACKING.adoc b/stdlib/HACKING.adoc
new file mode 100644
index 00000000..c29a513a
--- /dev/null
+++ b/stdlib/HACKING.adoc
@@ -0,0 +1,30 @@
+= Contributing to the standard library
+
+For guidelines about standard library content, see
+link:../CONTRIBUTING.md#contributing-to-the-standard-library[].
+
+Note: All paths are given relative to the root of the repository.
+
+First, build the compiler. Run `./configure`, then `make`. See
+link:../HACKING.adoc[].
+
+To add a new module, you must:
+
+* Create new `.mli` and `.ml` files for the modules, obviously.
+
+* Define the module in `stdlib/stdlib.mli` and `stdlib/stdlib.ml` in
+  the section of the code commented "MODULE ALIASES". Please maintain
+  the same style as the rest of the code, in particular the
+  alphabetical ordering and whitespace alignment of module aliases.
+
+* Add `module_name` to the definition of `STDLIB_MODS` in
+  `stdlib/StdlibModules`. You must keep the list sorted in dependency order.
+
+* Run `make alldepend` to update all the `.depend` files. These files are not
+  edited by hand.
+
+* Run `make clean` or `make partialclean`, then `make`.
+
+If you are adding multiple modules, follow the steps above and rebuild the
+compiler after adding each module. If you add multiple modules before
+rebuilding, the build may fail.
diff --git a/stdlib/Makefile b/stdlib/Makefile
new file mode 100644
index 00000000..0b92fe1e
--- /dev/null
+++ b/stdlib/Makefile
@@ -0,0 +1,258 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+ROOTDIR = ..
+
+-include $(ROOTDIR)/Makefile.config
+-include $(ROOTDIR)/Makefile.common
+
+TARGET_BINDIR ?= $(BINDIR)
+
+COMPILER=$(ROOTDIR)/ocamlc
+CAMLC=$(CAMLRUN) $(COMPILER)
+COMPFLAGS=-strict-sequence -absname -w +a-4-9-41-42-44-45-48 \
+          -g -warn-error A -bin-annot -nostdlib \
+          -safe-string -strict-formats
+ifeq "$(FLAMBDA)" "true"
+OPTCOMPFLAGS += -O3
+endif
+OPTCOMPILER=$(ROOTDIR)/ocamlopt
+CAMLOPT=$(CAMLRUN) $(OPTCOMPILER)
+CAMLDEP=$(BOOT_OCAMLC) -depend
+DEPFLAGS=-slash
+
+OC_CPPFLAGS += -I$(ROOTDIR)/runtime
+
+include StdlibModules
+
+OBJS=$(addsuffix .cmo,$(STDLIB_MODULES))
+OTHERS=$(filter-out camlinternalFormatBasics.cmo stdlib.cmo,$(OBJS))
+
+PREFIXED_OBJS=$(filter stdlib__%.cmo,$(OBJS))
+UNPREFIXED_OBJS=$(PREFIXED_OBJS:stdlib__%.cmo=%)
+
+.PHONY: all
+all: stdlib.cma std_exit.cmo camlheader target_camlheader camlheader_ur
+
+ifeq "$(RUNTIMED)" "true"
+all: camlheaderd target_camlheaderd
+endif
+
+ifeq "$(RUNTIMEI)" "true"
+all: camlheaderi target_camlheaderi
+endif
+
+.PHONY: allopt opt.opt # allopt and opt.opt are synonyms
+allopt: stdlib.cmxa std_exit.cmx
+opt.opt: allopt
+
+LEGACY_OBJS=$(patsubst stdlib__%,"$(INSTALL_LIBDIR)/%", \
+                                  $(filter stdlib__%,$(OBJS)))
+.PHONY: install
+install::
+# Transitional: when upgrading from 4.06 -> 4.07, module M is in stdlib__m.cm*,
+# while previously it was in m.cm*, which confuses the compiler.
+	rm -f $(LEGACY_OBJS)
+# Remove "old" pervasives.* and bigarray.* to avoid getting confused with the
+# Stdlib versions.
+	rm -f "$(INSTALL_LIBDIR)/pervasives.*" "$(INSTALL_LIBDIR)/bigarray.*"
+# End transitional
+	$(INSTALL_DATA) \
+	  stdlib.cma std_exit.cmo *.cmi camlheader_ur \
+	  "$(INSTALL_LIBDIR)"
+ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
+	$(INSTALL_DATA) \
+	  *.cmt *.cmti *.mli *.ml \
+	  "$(INSTALL_LIBDIR)"
+endif
+	$(INSTALL_DATA) target_camlheader "$(INSTALL_LIBDIR)/camlheader"
+
+ifeq "$(RUNTIMED)" "true"
+install::
+	$(INSTALL_DATA) target_camlheaderd "$(INSTALL_LIBDIR)/camlheaderd"
+endif
+
+ifeq "$(RUNTIMEI)" "true"
+install::
+	$(INSTALL_DATA) target_camlheaderi "$(INSTALL_LIBDIR)/camlheaderi"
+endif
+
+.PHONY: installopt
+installopt: installopt-default
+
+.PHONY: installopt-default
+installopt-default:
+	$(INSTALL_DATA) \
+	  stdlib.cmxa stdlib.$(A) std_exit.$(O) *.cmx \
+	  "$(INSTALL_LIBDIR)"
+	cd "$(INSTALL_LIBDIR)"; $(RANLIB) stdlib.$(A)
+
+ifeq "$(UNIX_OR_WIN32)" "unix"
+HEADERPROGRAM = header
+HEADER_PATH = $(BINDIR)/
+HEADER_TARGET_PATH = $(TARGET_BINDIR)/
+else # Windows
+HEADERPROGRAM = headernt
+HEADER_PATH =
+HEADER_TARGET_PATH =
+endif
+
+TARGETHEADERPROGRAM = target_$(HEADERPROGRAM)
+
+# The shebang test in configure.ac will need updating if any runtime is
+# introduced with a suffix more than one character long (camlheader_ur doesn't
+# matter).
+CAMLHEADERS =\
+  camlheader target_camlheader camlheader_ur \
+  camlheaderd target_camlheaderd \
+  camlheaderi target_camlheaderi
+
+# The % in pattern rules must always match something, hence the slightly strange
+# patterns and $(subst ...) since `camlheader%:` wouldn't match `camlheader`
+ifeq "$(SHEBANGSCRIPTS)" "true"
+camlhead%: $(ROOTDIR)/Makefile.config Makefile
+ifeq "$(LONG_SHEBANG)" "true"
+	echo '#!/bin/sh' > $@
+	echo 'exec "$(BINDIR)/ocamlrun$(subst er,,$*)" "$$0" "$$@"' >> $@
+else
+	echo '#!$(BINDIR)/ocamlrun$(subst er,,$*)' > $@
+endif
+
+# TODO This does not take long shebangs into account (since TARGET_BINDIR is not
+#      yet processed by configure)
+target_%: $(ROOTDIR)/Makefile.config Makefile
+	echo '#!$(TARGET_BINDIR)/ocamlrun$(subst camlheader,,$*)' > $@
+
+camlheader_ur: Makefile
+	echo '#!' | tr -d '\012' > $@
+
+else # Hashbang scripts not supported
+
+$(CAMLHEADERS): $(HEADERPROGRAM).c $(ROOTDIR)/Makefile.config Makefile
+
+# $@.exe is deleted to ensure no Cygwin .exe mangling takes place
+camlhead%: tmphead%.exe
+	rm -f $@.exe
+	mv $< $@
+
+# Again, pattern weirdness here means that the dot is always present so that
+# tmpheader.exe matches.
+tmpheader%exe: $(HEADERPROGRAM)%$(O)
+	$(call MKEXE_BOOT,$@,$^ $(EXTRALIBS))
+# FIXME This is wrong - mingw could invoke strip; MSVC equivalent?
+ifneq "$(UNIX_OR_WIN32)" "win32"
+	strip $@
+endif
+
+$(HEADERPROGRAM)%$(O): \
+  OC_CPPFLAGS += -DRUNTIME_NAME='"$(HEADER_PATH)ocamlrun$(subst .,,$*)"'
+
+$(HEADERPROGRAM)%$(O): $(HEADERPROGRAM).c
+	$(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $^
+
+camlheader_ur: camlheader
+	cp camlheader $@
+
+ifeq "$(UNIX_OR_WIN32)" "unix"
+tmptargetcamlheader%exe: $(TARGETHEADERPROGRAM)%$(O)
+	$(call MKEXE_BOOT,$@,$^ $(EXTRALIBS))
+	strip $@
+
+$(TARGETHEADERPROGRAM)%$(O): $(HEADERPROGRAM).c
+	$(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) \
+	      -DRUNTIME_NAME='"$(HEADER_TARGET_PATH)ocamlrun$(subst .,,$*)"' \
+	      $(OUTPUTOBJ)$@ $^
+
+target_%: tmptarget%.exe
+	rm -f $@.exe
+	mv $< $@
+else
+target_%: %
+	cp $< $@
+endif
+
+endif # ifeq "$(SHEBANGSCRIPTS)" "true"
+
+stdlib.cma: $(OBJS)
+	$(CAMLC) -a -o $@ $^
+
+stdlib.cmxa: $(OBJS:.cmo=.cmx)
+	$(CAMLOPT) -a -o $@ $^
+
+sys.ml: $(ROOTDIR)/VERSION sys.mlp
+	sed -e "s|%%VERSION%%|`sed -e 1q $< | tr -d '\r'`|" sys.mlp > $@
+
+.PHONY: clean
+clean::
+	rm -f sys.ml
+
+clean::
+	rm -f $(CAMLHEADERS)
+
+.SUFFIXES: .mli .ml .cmi .cmo .cmx
+
+export AWK
+
+%.cmi: %.mli
+	$(CAMLC) $(COMPFLAGS) $(shell ./Compflags $@) -c $<
+
+stdlib__%.cmi: %.mli
+	$(CAMLC) $(COMPFLAGS) $(shell ./Compflags $@) -o $@ -c $<
+
+%.cmo: %.ml
+	$(CAMLC) $(COMPFLAGS) $(shell ./Compflags $@) -c $<
+
+stdlib__%.cmo: %.ml
+	$(CAMLC) $(COMPFLAGS) $(shell ./Compflags $@) -o $@ -c $<
+
+%.cmx: %.ml
+	$(CAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) $(shell ./Compflags $@) -c $<
+
+stdlib__%.cmx: %.ml
+	$(CAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) $(shell ./Compflags $@) \
+	           -o $@ -c $<
+
+# Dependencies on the compiler
+COMPILER_DEPS=$(filter-out -use-prims $(CAMLRUN), $(CAMLC))
+$(OBJS) std_exit.cmo: $(COMPILER_DEPS)
+$(OBJS:.cmo=.cmi) std_exit.cmi: $(COMPILER_DEPS)
+$(OBJS:.cmo=.cmx) std_exit.cmx: $(OPTCOMPILER)
+
+# Dependencies on Stdlib (not tracked by ocamlc -depend)
+
+$(OTHERS) std_exit.cmo: stdlib.cmi
+$(OTHERS:.cmo=.cmi) std_exit.cmi: stdlib.cmi
+$(OBJS:.cmo=.cmx) std_exit.cmx: stdlib.cmi
+$(OTHERS:.cmo=.cmx) std_exit.cmx: stdlib.cmx
+
+clean::
+	rm -f *.cm* *.o *.obj *.a *.lib *.odoc
+	rm -f camlheader*
+
+include .depend
+
+EMPTY :=
+SPACE := $(EMPTY) $(EMPTY)
+
+.PHONY: depend
+depend:
+	$(CAMLDEP) $(DEPFLAGS) $(filter-out stdlib.%,$(wildcard *.mli *.ml)) \
+	  > .depend.tmp
+	$(CAMLDEP) $(DEPFLAGS) -pp "$(AWK) -f ./remove_module_aliases.awk" \
+	  stdlib.ml stdlib.mli >> .depend.tmp
+	sed -Ee \
+	  's#(^| )(${subst ${SPACE},|,${UNPREFIXED_OBJS}})[.]#\1stdlib__\2.#g' \
+	  .depend.tmp > .depend
+	rm -f .depend.tmp
diff --git a/stdlib/StdlibModules b/stdlib/StdlibModules
new file mode 100644
index 00000000..cb21a671
--- /dev/null
+++ b/stdlib/StdlibModules
@@ -0,0 +1,42 @@
+# -*- Makefile -*-
+
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 2002 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 lists all standard library modules.
+# It is used by:
+# 1. stdlib/Makefile when building stdlib.cma
+# 2. Makefile to expunge the toplevels
+# 3. ocamldoc/Makefile.docfiles to compute all documentation files
+#    which need to be generated for the stdlib
+
+# add stdlib__ as prefix to a module except for internal modules
+# and the stdlib module itself
+define add_stdlib_prefix
+  $(or $(filter stdlib camlinternal%,$1), stdlib__$1)
+endef
+
+# Modules should be listed in dependency order.
+STDLIB_MODS=\
+  camlinternalFormatBasics stdlib pervasives seq option result bool char uchar \
+  sys list bytes string unit marshal obj array float int int32 int64 nativeint \
+  lexing parsing set map stack queue camlinternalLazy lazy stream buffer \
+  camlinternalFormat printf arg printexc fun gc digest random hashtbl weak \
+  format scanf callback camlinternalOO oo camlinternalMod genlex ephemeron \
+  filename complex arrayLabels listLabels bytesLabels stringLabels moreLabels \
+  stdLabels spacetime bigarray
+
+STDLIB_MODULES=\
+  $(foreach module, $(STDLIB_MODS), $(call add_stdlib_prefix,$(module)))
diff --git a/stdlib/arg.ml b/stdlib/arg.ml
new file mode 100644
index 00000000..64e63d77
--- /dev/null
+++ b/stdlib/arg.ml
@@ -0,0 +1,407 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*              Damien Doligez, projet Para, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type key = string
+type doc = string
+type usage_msg = string
+type anon_fun = (string -> unit)
+
+type spec =
+  | Unit of (unit -> unit)     (* Call the function with unit argument *)
+  | Bool of (bool -> unit)     (* Call the function with a bool argument *)
+  | Set of bool ref            (* Set the reference to true *)
+  | Clear of bool ref          (* Set the reference to false *)
+  | String of (string -> unit) (* Call the function with a string argument *)
+  | Set_string of string ref   (* Set the reference to the string argument *)
+  | Int of (int -> unit)       (* Call the function with an int argument *)
+  | Set_int of int ref         (* Set the reference to the int argument *)
+  | Float of (float -> unit)   (* Call the function with a float argument *)
+  | Set_float of float ref     (* Set the reference to the float argument *)
+  | Tuple of spec list         (* Take several arguments according to the
+                                  spec list *)
+  | Symbol of string list * (string -> unit)
+                               (* Take one of the symbols as argument and
+                                  call the function with the symbol. *)
+  | Rest of (string -> unit)   (* Stop interpreting keywords and call the
+                                  function with each remaining argument *)
+  | Expand of (string -> string array) (* If the remaining arguments to process
+                                          are of the form
+                                          [["-foo"; "arg"] @ rest] where "foo"
+                                          is registered as [Expand f], then the
+                                          arguments [f "arg" @ rest] are
+                                          processed. Only allowed in
+                                          [parse_and_expand_argv_dynamic]. *)
+
+exception Bad of string
+exception Help of string
+
+type error =
+  | Unknown of string
+  | Wrong of string * string * string  (* option, actual, expected *)
+  | Missing of string
+  | Message of string
+
+exception Stop of error (* used internally *)
+
+open Printf
+
+let rec assoc3 x l =
+  match l with
+  | [] -> raise Not_found
+  | (y1, y2, _) :: _ when y1 = x -> y2
+  | _ :: t -> assoc3 x t
+
+
+let split s =
+  let i = String.index s '=' in
+  let len = String.length s in
+  String.sub s 0 i, String.sub s (i+1) (len-(i+1))
+
+
+let make_symlist prefix sep suffix l =
+  match l with
+  | [] -> "<none>"
+  | h::t -> (List.fold_left (fun x y -> x ^ sep ^ y) (prefix ^ h) t) ^ suffix
+
+
+let print_spec buf (key, spec, doc) =
+  if String.length doc > 0 then
+    match spec with
+    | Symbol (l, _) ->
+        bprintf buf "  %s %s%s\n" key (make_symlist "{" "|" "}" l) doc
+    | _ ->
+        bprintf buf "  %s %s\n" key doc
+
+
+let help_action () = raise (Stop (Unknown "-help"))
+
+let add_help speclist =
+  let add1 =
+    try ignore (assoc3 "-help" speclist); []
+    with Not_found ->
+            ["-help", Unit help_action, " Display this list of options"]
+  and add2 =
+    try ignore (assoc3 "--help" speclist); []
+    with Not_found ->
+            ["--help", Unit help_action, " Display this list of options"]
+  in
+  speclist @ (add1 @ add2)
+
+
+let usage_b buf speclist errmsg =
+  bprintf buf "%s\n" errmsg;
+  List.iter (print_spec buf) (add_help speclist)
+
+
+let usage_string speclist errmsg =
+  let b = Buffer.create 200 in
+  usage_b b speclist errmsg;
+  Buffer.contents b
+
+
+let usage speclist errmsg =
+  eprintf "%s" (usage_string speclist errmsg)
+
+
+let current = ref 0
+
+let bool_of_string_opt x =
+  try Some (bool_of_string x)
+  with Invalid_argument _ -> None
+
+let int_of_string_opt x =
+  try Some (int_of_string x)
+  with Failure _ -> None
+
+let float_of_string_opt x =
+  try Some (float_of_string x)
+  with Failure _ -> None
+
+let parse_and_expand_argv_dynamic_aux allow_expand current argv speclist anonfun
+                                      errmsg =
+  let initpos = !current in
+  let convert_error error =
+    (* convert an internal error to a Bad/Help exception
+       *or* add the program name as a prefix and the usage message as a suffix
+       to an user-raised Bad exception.
+    *)
+    let b = Buffer.create 200 in
+    let progname =
+      if initpos < (Array.length !argv) then !argv.(initpos) else "(?)" in
+    begin match error with
+      | Unknown "-help" -> ()
+      | Unknown "--help" -> ()
+      | Unknown s ->
+          bprintf b "%s: unknown option '%s'.\n" progname s
+      | Missing s ->
+          bprintf b "%s: option '%s' needs an argument.\n" progname s
+      | Wrong (opt, arg, expected) ->
+          bprintf b "%s: wrong argument '%s'; option '%s' expects %s.\n"
+                  progname arg opt expected
+      | Message s -> (* user error message *)
+          bprintf b "%s: %s.\n" progname s
+    end;
+    usage_b b !speclist errmsg;
+    if error = Unknown "-help" || error = Unknown "--help"
+    then Help (Buffer.contents b)
+    else Bad (Buffer.contents b)
+  in
+  incr current;
+  while !current < (Array.length !argv) do
+    begin try
+      let s = !argv.(!current) in
+      if String.length s >= 1 && s.[0] = '-' then begin
+        let action, follow =
+          try assoc3 s !speclist, None
+          with Not_found ->
+          try
+            let keyword, arg = split s in
+            assoc3 keyword !speclist, Some arg
+          with Not_found -> raise (Stop (Unknown s))
+        in
+        let no_arg () =
+          match follow with
+          | None -> ()
+          | Some arg -> raise (Stop (Wrong (s, arg, "no argument"))) in
+        let get_arg () =
+          match follow with
+          | None ->
+              if !current + 1 < (Array.length !argv) then !argv.(!current + 1)
+              else raise (Stop (Missing s))
+          | Some arg -> arg
+        in
+        let consume_arg () =
+          match follow with
+          | None -> incr current
+          | Some _ -> ()
+        in
+        let rec treat_action = function
+        | Unit f -> no_arg (); f ();
+        | Bool f ->
+            let arg = get_arg () in
+            begin match bool_of_string_opt arg with
+            | None -> raise (Stop (Wrong (s, arg, "a boolean")))
+            | Some s -> f s
+            end;
+            consume_arg ();
+        | Set r -> no_arg (); r := true;
+        | Clear r -> no_arg (); r := false;
+        | String f ->
+            let arg = get_arg () in
+            f arg;
+            consume_arg ();
+        | Symbol (symb, f) ->
+            let arg = get_arg () in
+            if List.mem arg symb then begin
+              f arg;
+              consume_arg ();
+            end else begin
+              raise (Stop (Wrong (s, arg, "one of: "
+                                          ^ (make_symlist "" " " "" symb))))
+            end
+        | Set_string r ->
+            r := get_arg ();
+            consume_arg ();
+        | Int f ->
+            let arg = get_arg () in
+            begin match int_of_string_opt arg with
+            | None -> raise (Stop (Wrong (s, arg, "an integer")))
+            | Some x -> f x
+            end;
+            consume_arg ();
+        | Set_int r ->
+            let arg = get_arg () in
+            begin match int_of_string_opt arg with
+            | None -> raise (Stop (Wrong (s, arg, "an integer")))
+            | Some x -> r := x
+            end;
+            consume_arg ();
+        | Float f ->
+            let arg = get_arg () in
+            begin match float_of_string_opt arg with
+            | None -> raise (Stop (Wrong (s, arg, "a float")))
+            | Some x -> f x
+            end;
+            consume_arg ();
+        | Set_float r ->
+            let arg = get_arg () in
+            begin match float_of_string_opt arg with
+            | None -> raise (Stop (Wrong (s, arg, "a float")))
+            | Some x -> r := x
+            end;
+            consume_arg ();
+        | Tuple specs ->
+            no_arg ();
+            List.iter treat_action specs;
+        | Rest f ->
+            no_arg ();
+            while !current < (Array.length !argv) - 1 do
+              f !argv.(!current + 1);
+              consume_arg ();
+            done;
+        | Expand f ->
+            if not allow_expand then
+              raise (Invalid_argument "Arg.Expand is is only allowed with \
+                                       Arg.parse_and_expand_argv_dynamic");
+            let arg = get_arg () in
+            let newarg = f arg in
+            consume_arg ();
+            let before = Array.sub !argv 0 (!current + 1)
+            and after =
+              Array.sub !argv (!current + 1)
+                        ((Array.length !argv) - !current - 1) in
+            argv:= Array.concat [before;newarg;after];
+        in
+        treat_action action end
+      else anonfun s
+    with | Bad m -> raise (convert_error (Message m));
+         | Stop e -> raise (convert_error e);
+    end;
+    incr current
+  done
+
+let parse_and_expand_argv_dynamic current argv speclist anonfun errmsg =
+  parse_and_expand_argv_dynamic_aux true current argv speclist anonfun errmsg
+
+let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg =
+  parse_and_expand_argv_dynamic_aux false current (ref argv) speclist anonfun
+    errmsg
+
+
+let parse_argv ?(current=current) argv speclist anonfun errmsg =
+  parse_argv_dynamic ~current:current argv (ref speclist) anonfun errmsg
+
+
+let parse l f msg =
+  try
+    parse_argv Sys.argv l f msg
+  with
+  | Bad msg -> eprintf "%s" msg; exit 2
+  | Help msg -> printf "%s" msg; exit 0
+
+
+let parse_dynamic l f msg =
+  try
+    parse_argv_dynamic Sys.argv l f msg
+  with
+  | Bad msg -> eprintf "%s" msg; exit 2
+  | Help msg -> printf "%s" msg; exit 0
+
+let parse_expand l f msg =
+  try
+    let argv = ref Sys.argv in
+    let spec = ref l in
+    let current = ref (!current) in
+    parse_and_expand_argv_dynamic current argv spec f msg
+  with
+  | Bad msg -> eprintf "%s" msg; exit 2
+  | Help msg -> printf "%s" msg; exit 0
+
+
+let second_word s =
+  let len = String.length s in
+  let rec loop n =
+    if n >= len then len
+    else if s.[n] = ' ' then loop (n+1)
+    else n
+  in
+  match String.index s '\t' with
+  | n -> loop (n+1)
+  | exception Not_found ->
+      begin match String.index s ' ' with
+      | n -> loop (n+1)
+      | exception Not_found -> len
+      end
+
+
+let max_arg_len cur (kwd, spec, doc) =
+  match spec with
+  | Symbol _ -> max cur (String.length kwd)
+  | _ -> max cur (String.length kwd + second_word doc)
+
+
+let replace_leading_tab s =
+  let seen = ref false in
+  String.map (function '\t' when not !seen -> seen := true; ' ' | c -> c) s
+
+let add_padding len ksd =
+  match ksd with
+  | (_, _, "") ->
+      (* Do not pad undocumented options, so that they still don't show up when
+       * run through [usage] or [parse]. *)
+      ksd
+  | (kwd, (Symbol _ as spec), msg) ->
+      let cutcol = second_word msg in
+      let spaces = String.make ((max 0 (len - cutcol)) + 3) ' ' in
+      (kwd, spec, "\n" ^ spaces ^ replace_leading_tab msg)
+  | (kwd, spec, msg) ->
+      let cutcol = second_word msg in
+      let kwd_len = String.length kwd in
+      let diff = len - kwd_len - cutcol in
+      if diff <= 0 then
+        (kwd, spec, replace_leading_tab msg)
+      else
+        let spaces = String.make diff ' ' in
+        let prefix = String.sub (replace_leading_tab msg) 0 cutcol in
+        let suffix = String.sub msg cutcol (String.length msg - cutcol) in
+        (kwd, spec, prefix ^ spaces ^ suffix)
+
+
+let align ?(limit=max_int) speclist =
+  let completed = add_help speclist in
+  let len = List.fold_left max_arg_len 0 completed in
+  let len = min len limit in
+  List.map (add_padding len) completed
+
+let trim_cr s =
+  let len = String.length s in
+  if len > 0 && String.get s (len - 1) = '\r' then
+    String.sub s 0 (len - 1)
+  else
+    s
+
+let read_aux trim sep file =
+  let ic = open_in_bin file in
+  let buf = Buffer.create 200 in
+  let words = ref [] in
+  let stash () =
+    let word = Buffer.contents buf in
+    let word = if trim then trim_cr word else word in
+    words := word :: !words;
+    Buffer.clear buf
+  in
+  begin
+    try while true do
+        let c = input_char ic in
+        if c = sep then stash () else Buffer.add_char buf c
+      done
+    with End_of_file -> ()
+  end;
+  if Buffer.length buf > 0 then stash ();
+  close_in ic;
+  Array.of_list (List.rev !words)
+
+let read_arg = read_aux true '\n'
+
+let read_arg0 = read_aux false '\x00'
+
+let write_aux sep file args =
+  let oc = open_out_bin file in
+  Array.iter (fun s -> fprintf oc "%s%c" s sep) args;
+  close_out oc
+
+let write_arg = write_aux '\n'
+
+let write_arg0 = write_aux '\x00'
diff --git a/stdlib/arg.mli b/stdlib/arg.mli
new file mode 100644
index 00000000..3f3116c5
--- /dev/null
+++ b/stdlib/arg.mli
@@ -0,0 +1,206 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*              Damien Doligez, projet Para, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Parsing of command line arguments.
+
+   This module provides a general mechanism for extracting options and
+   arguments from the command line to the program.
+
+   Syntax of command lines:
+    A keyword is a character string starting with a [-].
+    An option is a keyword alone or followed by an argument.
+    The types of keywords are: [Unit], [Bool], [Set], [Clear],
+    [String], [Set_string], [Int], [Set_int], [Float], [Set_float],
+    [Tuple], [Symbol], and [Rest].
+    [Unit], [Set] and [Clear] keywords take no argument. A [Rest]
+    keyword takes the remaining of the command line as arguments.
+    Every other keyword takes the following word on the command line
+    as argument.  For compatibility with GNU getopt_long, [keyword=arg]
+    is also allowed.
+    Arguments not preceded by a keyword are called anonymous arguments.
+
+   Examples ([cmd] is assumed to be the command name):
+-   [cmd -flag           ](a unit option)
+-   [cmd -int 1          ](an int option with argument [1])
+-   [cmd -string foobar  ](a string option with argument ["foobar"])
+-   [cmd -float 12.34    ](a float option with argument [12.34])
+-   [cmd a b c           ](three anonymous arguments: ["a"], ["b"], and ["c"])
+-   [cmd a b -- c d      ](two anonymous arguments and a rest option with
+                           two arguments)
+*)
+
+type spec =
+  | Unit of (unit -> unit)     (** Call the function with unit argument *)
+  | Bool of (bool -> unit)     (** Call the function with a bool argument *)
+  | Set of bool ref            (** Set the reference to true *)
+  | Clear of bool ref          (** Set the reference to false *)
+  | String of (string -> unit) (** Call the function with a string argument *)
+  | Set_string of string ref   (** Set the reference to the string argument *)
+  | Int of (int -> unit)       (** Call the function with an int argument *)
+  | Set_int of int ref         (** Set the reference to the int argument *)
+  | Float of (float -> unit)   (** Call the function with a float argument *)
+  | Set_float of float ref     (** Set the reference to the float argument *)
+  | Tuple of spec list         (** Take several arguments according to the
+                                   spec list *)
+  | Symbol of string list * (string -> unit)
+                               (** Take one of the symbols as argument and
+                                   call the function with the symbol *)
+  | Rest of (string -> unit)   (** Stop interpreting keywords and call the
+                                   function with each remaining argument *)
+  | Expand of (string -> string array) (** If the remaining arguments to process
+                                           are of the form
+                                           [["-foo"; "arg"] @ rest] where "foo"
+                                           is registered as [Expand f], then the
+                                           arguments [f "arg" @ rest] are
+                                           processed. Only allowed in
+                                           [parse_and_expand_argv_dynamic]. *)
+(** The concrete type describing the behavior associated
+   with a keyword. *)
+
+type key = string
+type doc = string
+type usage_msg = string
+type anon_fun = (string -> unit)
+
+val parse :
+  (key * spec * doc) list -> anon_fun -> usage_msg -> unit
+(** [Arg.parse speclist anon_fun usage_msg] parses the command line.
+    [speclist] is a list of triples [(key, spec, doc)].
+    [key] is the option keyword, it must start with a ['-'] character.
+    [spec] gives the option type and the function to call when this option
+    is found on the command line.
+    [doc] is a one-line description of this option.
+    [anon_fun] is called on anonymous arguments.
+    The functions in [spec] and [anon_fun] are called in the same order
+    as their arguments appear on the command line.
+
+    If an error occurs, [Arg.parse] exits the program, after printing
+    to standard error an error message as follows:
+-   The reason for the error: unknown option, invalid or missing argument, etc.
+-   [usage_msg]
+-   The list of options, each followed by the corresponding [doc] string.
+    Beware: options that have an empty [doc] string will not be included in the
+    list.
+
+    For the user to be able to specify anonymous arguments starting with a
+    [-], include for example [("-", String anon_fun, doc)] in [speclist].
+
+    By default, [parse] recognizes two unit options, [-help] and [--help],
+    which will print to standard output [usage_msg] and the list of
+    options, and exit the program.  You can override this behaviour
+    by specifying your own [-help] and [--help] options in [speclist].
+*)
+
+val parse_dynamic :
+  (key * spec * doc) list ref -> anon_fun -> usage_msg -> unit
+(** Same as {!Arg.parse}, except that the [speclist] argument is a reference
+    and may be updated during the parsing. A typical use for this feature
+    is to parse command lines of the form:
+-     command subcommand [options]
+    where the list of options depends on the value of the subcommand argument.
+    @since 4.01.0
+*)
+
+val parse_argv : ?current: int ref -> string array ->
+  (key * spec * doc) list -> anon_fun -> usage_msg -> unit
+(** [Arg.parse_argv ~current args speclist anon_fun usage_msg] parses
+  the array [args] as if it were the command line.  It uses and updates
+  the value of [~current] (if given), or {!Arg.current}.  You must set
+  it before calling [parse_argv].  The initial value of [current]
+  is the index of the program name (argument 0) in the array.
+  If an error occurs, [Arg.parse_argv] raises {!Arg.Bad} with
+  the error message as argument.  If option [-help] or [--help] is
+  given, [Arg.parse_argv] raises {!Arg.Help} with the help message
+  as argument.
+*)
+
+val parse_argv_dynamic : ?current:int ref -> string array ->
+  (key * spec * doc) list ref -> anon_fun -> string -> unit
+(** Same as {!Arg.parse_argv}, except that the [speclist] argument is a
+    reference and may be updated during the parsing.
+    See {!Arg.parse_dynamic}.
+    @since 4.01.0
+*)
+
+val parse_and_expand_argv_dynamic : int ref -> string array ref ->
+  (key * spec * doc) list ref -> anon_fun -> string -> unit
+(** Same as {!Arg.parse_argv_dynamic}, except that the [argv] argument is a
+    reference and may be updated during the parsing of [Expand] arguments.
+    See {!Arg.parse_argv_dynamic}.
+    @since 4.05.0
+*)
+
+val parse_expand:
+  (key * spec * doc) list -> anon_fun -> usage_msg -> unit
+(** Same as {!Arg.parse}, except that the [Expand] arguments are allowed and
+    the {!current} reference is not updated.
+    @since 4.05.0
+*)
+
+exception Help of string
+(** Raised by [Arg.parse_argv] when the user asks for help. *)
+
+exception Bad of string
+(** Functions in [spec] or [anon_fun] can raise [Arg.Bad] with an error
+    message to reject invalid arguments.
+    [Arg.Bad] is also raised by {!Arg.parse_argv} in case of an error. *)
+
+val usage : (key * spec * doc) list -> usage_msg -> unit
+(** [Arg.usage speclist usage_msg] prints to standard error
+    an error message that includes the list of valid options.  This is
+    the same message that {!Arg.parse} prints in case of error.
+    [speclist] and [usage_msg] are the same as for {!Arg.parse}. *)
+
+val usage_string : (key * spec * doc) list -> usage_msg -> string
+(** Returns the message that would have been printed by {!Arg.usage},
+    if provided with the same parameters. *)
+
+val align: ?limit: int -> (key * spec * doc) list -> (key * spec * doc) list
+(** Align the documentation strings by inserting spaces at the first alignment
+    separator (tab or, if tab is not found, space), according to the length of
+    the keyword.  Use a alignment separator as the first character in a doc
+    string if you want to align the whole string.  The doc strings corresponding
+    to [Symbol] arguments are aligned on the next line.
+    @param limit options with keyword and message longer than [limit] will not
+    be used to compute the alignment. *)
+
+val current : int ref
+(** Position (in {!Sys.argv}) of the argument being processed.  You can
+    change this value, e.g. to force {!Arg.parse} to skip some arguments.
+    {!Arg.parse} uses the initial value of {!Arg.current} as the index of
+    argument 0 (the program name) and starts parsing arguments
+    at the next element. *)
+
+val read_arg: string -> string array
+(** [Arg.read_arg file] reads newline-terminated command line arguments from
+    file [file].
+    @since 4.05.0 *)
+
+val read_arg0: string -> string array
+(** Identical to {!Arg.read_arg} but assumes null character terminated command
+    line arguments.
+    @since 4.05.0 *)
+
+
+val write_arg: string -> string array -> unit
+(** [Arg.write_arg file args] writes the arguments [args] newline-terminated
+    into the file [file]. If the any of the arguments in [args] contains a
+    newline, use {!Arg.write_arg0} instead.
+    @since 4.05.0 *)
+
+val write_arg0: string -> string array -> unit
+(** Identical to {!Arg.write_arg} but uses the null character for terminator
+    instead of newline.
+    @since 4.05.0 *)
diff --git a/stdlib/array.ml b/stdlib/array.ml
new file mode 100644
index 00000000..9e8122ba
--- /dev/null
+++ b/stdlib/array.ml
@@ -0,0 +1,366 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* An alias for the type of arrays. *)
+type 'a t = 'a array
+
+(* Array operations *)
+
+external length : 'a array -> int = "%array_length"
+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 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"
+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"
+let make_float = create_float
+
+module Floatarray = struct
+  external create : int -> floatarray = "caml_floatarray_create"
+  external length : floatarray -> int = "%floatarray_length"
+  external get : floatarray -> int -> float = "%floatarray_safe_get"
+  external set : floatarray -> int -> float -> unit = "%floatarray_safe_set"
+  external unsafe_get : floatarray -> int -> float = "%floatarray_unsafe_get"
+  external unsafe_set : floatarray -> int -> float -> unit
+      = "%floatarray_unsafe_set"
+end
+
+let init l f =
+  if l = 0 then [||] else
+  if l < 0 then invalid_arg "Array.init"
+  (* See #6575. We could also check for maximum array size, but this depends
+     on whether we create a float array or a regular one... *)
+  else
+   let res = create l (f 0) in
+   for i = 1 to pred l do
+     unsafe_set res i (f i)
+   done;
+   res
+
+let make_matrix sx sy init =
+  let res = create sx [||] in
+  for x = 0 to pred sx do
+    unsafe_set res x (create sy init)
+  done;
+  res
+
+let create_matrix = make_matrix
+
+let copy a =
+  let l = length a in if l = 0 then [||] 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 sub a ofs len =
+  if ofs < 0 || len < 0 || ofs > length a - len
+  then invalid_arg "Array.sub"
+  else unsafe_sub a ofs len
+
+let fill a ofs len v =
+  if ofs < 0 || len < 0 || ofs > length a - len
+  then invalid_arg "Array.fill"
+  else unsafe_fill a ofs len v
+
+let blit a1 ofs1 a2 ofs2 len =
+  if len < 0 || ofs1 < 0 || ofs1 > length a1 - len
+             || ofs2 < 0 || ofs2 > length a2 - len
+  then invalid_arg "Array.blit"
+  else unsafe_blit a1 ofs1 a2 ofs2 len
+
+let iter f a =
+  for i = 0 to length a - 1 do f(unsafe_get a i) done
+
+let iter2 f a b =
+  if length a <> length b then
+    invalid_arg "Array.iter2: arrays must have the same length"
+  else
+    for i = 0 to length a - 1 do f (unsafe_get a i) (unsafe_get b i) done
+
+let map f a =
+  let l = length a in
+  if l = 0 then [||] else begin
+    let r = create l (f(unsafe_get a 0)) in
+    for i = 1 to l - 1 do
+      unsafe_set r i (f(unsafe_get a i))
+    done;
+    r
+  end
+
+let map2 f a b =
+  let la = length a in
+  let lb = length b in
+  if la <> lb then
+    invalid_arg "Array.map2: arrays must have the same length"
+  else begin
+    if la = 0 then [||] else begin
+      let r = create la (f (unsafe_get a 0) (unsafe_get b 0)) in
+      for i = 1 to la - 1 do
+        unsafe_set r i (f (unsafe_get a i) (unsafe_get b i))
+      done;
+      r
+    end
+  end
+
+let iteri f a =
+  for i = 0 to length a - 1 do f i (unsafe_get a i) done
+
+let mapi f a =
+  let l = length a in
+  if l = 0 then [||] else begin
+    let r = create l (f 0 (unsafe_get a 0)) in
+    for i = 1 to l - 1 do
+      unsafe_set r i (f i (unsafe_get a i))
+    done;
+    r
+  end
+
+let to_list a =
+  let rec tolist i res =
+    if i < 0 then res else tolist (i - 1) (unsafe_get a i :: res) in
+  tolist (length a - 1) []
+
+(* Cannot use List.length here because the List module depends on Array. *)
+let rec list_length accu = function
+  | [] -> accu
+  | _::t -> list_length (succ accu) t
+
+let of_list = function
+    [] -> [||]
+  | hd::tl as l ->
+      let a = create (list_length 0 l) hd in
+      let rec fill i = function
+          [] -> a
+        | hd::tl -> unsafe_set a i hd; fill (i+1) tl in
+      fill 1 tl
+
+let fold_left f x a =
+  let r = ref x in
+  for i = 0 to length a - 1 do
+    r := f !r (unsafe_get a i)
+  done;
+  !r
+
+let fold_right f a x =
+  let r = ref x in
+  for i = length a - 1 downto 0 do
+    r := f (unsafe_get a i) !r
+  done;
+  !r
+
+let exists p a =
+  let n = length a in
+  let rec loop i =
+    if i = n then false
+    else if p (unsafe_get a i) then true
+    else loop (succ i) in
+  loop 0
+
+let for_all p a =
+  let n = length a in
+  let rec loop i =
+    if i = n then true
+    else if p (unsafe_get a i) then loop (succ i)
+    else false in
+  loop 0
+
+let for_all2 p l1 l2 =
+  let n1 = length l1
+  and n2 = length l2 in
+  if n1 <> n2 then invalid_arg "Array.for_all2"
+  else let rec loop i =
+    if i = n1 then true
+    else if p (unsafe_get l1 i) (unsafe_get l2 i) then loop (succ i)
+    else false in
+  loop 0
+
+let exists2 p l1 l2 =
+  let n1 = length l1
+  and n2 = length l2 in
+  if n1 <> n2 then invalid_arg "Array.exists2"
+  else let rec loop i =
+    if i = n1 then false
+    else if p (unsafe_get l1 i) (unsafe_get l2 i) then true
+    else loop (succ i) in
+  loop 0
+
+let mem x a =
+  let n = length a in
+  let rec loop i =
+    if i = n then false
+    else if compare (unsafe_get a i) x = 0 then true
+    else loop (succ i) in
+  loop 0
+
+let memq x a =
+  let n = length a in
+  let rec loop i =
+    if i = n then false
+    else if x == (unsafe_get a i) then true
+    else loop (succ i) in
+  loop 0
+
+exception Bottom of int
+let sort cmp a =
+  let maxson l i =
+    let i31 = i+i+i+1 in
+    let x = ref i31 in
+    if i31+2 < l then begin
+      if cmp (get a i31) (get a (i31+1)) < 0 then x := i31+1;
+      if cmp (get a !x) (get a (i31+2)) < 0 then x := i31+2;
+      !x
+    end else
+      if i31+1 < l && cmp (get a i31) (get a (i31+1)) < 0
+      then i31+1
+      else if i31 < l then i31 else raise (Bottom i)
+  in
+  let rec trickledown l i e =
+    let j = maxson l i in
+    if cmp (get a j) e > 0 then begin
+      set a i (get a j);
+      trickledown l j e;
+    end else begin
+      set a i e;
+    end;
+  in
+  let trickle l i e = try trickledown l i e with Bottom i -> set a i e in
+  let rec bubbledown l i =
+    let j = maxson l i in
+    set a i (get a j);
+    bubbledown l j
+  in
+  let bubble l i = try bubbledown l i with Bottom i -> i in
+  let rec trickleup i e =
+    let father = (i - 1) / 3 in
+    assert (i <> father);
+    if cmp (get a father) e < 0 then begin
+      set a i (get a father);
+      if father > 0 then trickleup father e else set a 0 e;
+    end else begin
+      set a i e;
+    end;
+  in
+  let l = length a in
+  for i = (l + 1) / 3 - 1 downto 0 do trickle l i (get a i); done;
+  for i = l - 1 downto 2 do
+    let e = (get a i) in
+    set a i (get a 0);
+    trickleup (bubble i 0) e;
+  done;
+  if l > 1 then (let e = (get a 1) in set a 1 (get a 0); set a 0 e)
+
+
+let cutoff = 5
+let stable_sort cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
+    let rec loop i1 s1 i2 s2 d =
+      if cmp s1 s2 <= 0 then begin
+        set dst d s1;
+        let i1 = i1 + 1 in
+        if i1 < src1r then
+          loop i1 (get a i1) i2 s2 (d + 1)
+        else
+          blit src2 i2 dst (d + 1) (src2r - i2)
+      end else begin
+        set dst d s2;
+        let i2 = i2 + 1 in
+        if i2 < src2r then
+          loop i1 s1 i2 (get src2 i2) (d + 1)
+        else
+          blit a i1 dst (d + 1) (src1r - i1)
+      end
+    in loop src1ofs (get a src1ofs) src2ofs (get src2 src2ofs) dstofs;
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len - 1 do
+      let e = (get a (srcofs + i)) in
+      let j = ref (dstofs + i - 1) in
+      while (!j >= dstofs && cmp (get dst !j) e > 0) do
+        set dst (!j + 1) (get dst !j);
+        decr j;
+      done;
+      set dst (!j + 1) e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else begin
+      let l1 = len / 2 in
+      let l2 = len - l1 in
+      sortto (srcofs + l1) dst (dstofs + l1) l2;
+      sortto srcofs a (srcofs + l2) l1;
+      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
+    end;
+  in
+  let l = length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = make l2 (get a 0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end
+
+
+let fast_sort = stable_sort
+
+(** {1 Iterators} *)
+
+let to_seq a =
+  let rec aux i () =
+    if i < length a
+    then
+      let x = unsafe_get a i in
+      Seq.Cons (x, aux (i+1))
+    else Seq.Nil
+  in
+  aux 0
+
+let to_seqi a =
+  let rec aux i () =
+    if i < length a
+    then
+      let x = unsafe_get a i in
+      Seq.Cons ((i,x), aux (i+1))
+    else Seq.Nil
+  in
+  aux 0
+
+let of_rev_list = function
+    [] -> [||]
+  | hd::tl as l ->
+      let len = list_length 0 l in
+      let a = create len hd in
+      let rec fill i = function
+          [] -> a
+        | hd::tl -> unsafe_set a i hd; fill (i-1) tl
+      in
+      fill (len-2) tl
+
+let of_seq i =
+  let l = Seq.fold_left (fun acc x -> x::acc) [] i in
+  of_rev_list l
diff --git a/stdlib/array.mli b/stdlib/array.mli
new file mode 100644
index 00000000..9a08d666
--- /dev/null
+++ b/stdlib/array.mli
@@ -0,0 +1,301 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type 'a t = 'a array
+(** An alias for the type of arrays. *)
+
+(** Array operations. *)
+
+external length : 'a array -> int = "%array_length"
+(** Return the length (number of elements) of the given array. *)
+
+external get : 'a array -> int -> 'a = "%array_safe_get"
+(** [Array.get a n] returns the element number [n] of array [a].
+   The first element has number 0.
+   The last element has number [Array.length a - 1].
+   You can also write [a.(n)] instead of [Array.get a n].
+   @raise Invalid_argument
+   if [n] is outside the range 0 to [(Array.length a - 1)]. *)
+
+external set : 'a array -> int -> 'a -> unit = "%array_safe_set"
+(** [Array.set a n x] modifies array [a] in place, replacing
+   element number [n] with [x].
+   You can also write [a.(n) <- x] instead of [Array.set a n x].
+   @raise Invalid_argument
+   if [n] is outside the range 0 to [Array.length a - 1]. *)
+
+external make : int -> 'a -> 'a array = "caml_make_vect"
+(** [Array.make n x] returns a fresh array of length [n],
+   initialized with [x].
+   All the elements of this new array are initially
+   physically equal to [x] (in the sense of the [==] predicate).
+   Consequently, if [x] is mutable, it is shared among all elements
+   of the array, and modifying [x] through one of the array entries
+   will modify all other entries at the same time.
+   @raise Invalid_argument if [n < 0] or [n > Sys.max_array_length].
+   If the value of [x] is a floating-point number, then the maximum
+   size is only [Sys.max_array_length / 2].*)
+
+external create : int -> 'a -> 'a array = "caml_make_vect"
+  [@@ocaml.deprecated "Use Array.make instead."]
+(** @deprecated [Array.create] is an alias for {!Array.make}. *)
+
+external create_float: int -> float array = "caml_make_float_vect"
+(** [Array.create_float n] returns a fresh float array of length [n],
+    with uninitialized data.
+    @since 4.03 *)
+
+val make_float: int -> float array
+  [@@ocaml.deprecated "Use Array.create_float instead."]
+(** @deprecated [Array.make_float] is an alias for {!Array.create_float}. *)
+
+val init : int -> (int -> 'a) -> 'a array
+(** [Array.init n f] returns a fresh array of length [n],
+   with element number [i] initialized to the result of [f i].
+   In other terms, [Array.init n f] tabulates the results of [f]
+   applied to the integers [0] to [n-1].
+   @raise Invalid_argument if [n < 0] or [n > Sys.max_array_length].
+   If the return type of [f] is [float], then the maximum
+   size is only [Sys.max_array_length / 2].*)
+
+val make_matrix : int -> int -> 'a -> 'a array array
+(** [Array.make_matrix dimx dimy e] returns a two-dimensional array
+   (an array of arrays) with first dimension [dimx] and
+   second dimension [dimy]. All the elements of this new matrix
+   are initially physically equal to [e].
+   The element ([x,y]) of a matrix [m] is accessed
+   with the notation [m.(x).(y)].
+   @raise Invalid_argument if [dimx] or [dimy] is negative or
+   greater than {!Sys.max_array_length}.
+   If the value of [e] is a floating-point number, then the maximum
+   size is only [Sys.max_array_length / 2]. *)
+
+val create_matrix : int -> int -> 'a -> 'a array array
+  [@@ocaml.deprecated "Use Array.make_matrix instead."]
+(** @deprecated [Array.create_matrix] is an alias for {!Array.make_matrix}. *)
+
+val append : 'a array -> 'a array -> 'a array
+(** [Array.append v1 v2] returns a fresh array containing the
+   concatenation of the arrays [v1] and [v2].
+   @raise Invalid_argument if
+   [Array.length v1 + Array.length v2 > Sys.max_array_length]. *)
+
+val concat : 'a array list -> 'a array
+(** Same as {!Array.append}, but concatenates a list of arrays. *)
+
+val sub : 'a array -> int -> int -> 'a array
+(** [Array.sub a start len] returns a fresh array of length [len],
+   containing the elements number [start] to [start + len - 1]
+   of array [a].
+   @raise Invalid_argument if [start] and [len] do not
+   designate a valid subarray of [a]; that is, if
+   [start < 0], or [len < 0], or [start + len > Array.length a]. *)
+
+val copy : 'a array -> 'a array
+(** [Array.copy a] returns a copy of [a], that is, a fresh array
+   containing the same elements as [a]. *)
+
+val fill : 'a array -> int -> int -> 'a -> unit
+(** [Array.fill a ofs len x] modifies the array [a] in place,
+   storing [x] in elements number [ofs] to [ofs + len - 1].
+   @raise Invalid_argument if [ofs] and [len] do not
+   designate a valid subarray of [a]. *)
+
+val blit : 'a array -> int -> 'a array -> int -> int -> unit
+(** [Array.blit v1 o1 v2 o2 len] copies [len] elements
+   from array [v1], starting at element number [o1], to array [v2],
+   starting at element number [o2]. It works correctly even if
+   [v1] and [v2] are the same array, and the source and
+   destination chunks overlap.
+   @raise Invalid_argument if [o1] and [len] do not
+   designate a valid subarray of [v1], or if [o2] and [len] do not
+   designate a valid subarray of [v2]. *)
+
+val to_list : 'a array -> 'a list
+(** [Array.to_list a] returns the list of all the elements of [a]. *)
+
+val of_list : 'a list -> 'a array
+(** [Array.of_list l] returns a fresh array containing the elements
+   of [l].
+   @raise Invalid_argument if the length of [l] is greater than
+   [Sys.max_array_length].*)
+
+
+(** {1 Iterators} *)
+
+
+val iter : ('a -> unit) -> 'a array -> unit
+(** [Array.iter f a] applies function [f] in turn to all
+   the elements of [a].  It is equivalent to
+   [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. *)
+
+val iteri : (int -> 'a -> unit) -> 'a array -> unit
+(** Same as {!Array.iter}, but the
+   function is applied with the index of the element as first argument,
+   and the element itself as second argument. *)
+
+val map : ('a -> 'b) -> 'a array -> 'b array
+(** [Array.map f a] applies function [f] to all the elements of [a],
+   and builds an array with the results returned by [f]:
+   [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. *)
+
+val mapi : (int -> 'a -> 'b) -> 'a array -> 'b array
+(** Same as {!Array.map}, but the
+   function is applied to the index of the element as first argument,
+   and the element itself as second argument. *)
+
+val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a
+(** [Array.fold_left f x a] computes
+   [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)],
+   where [n] is the length of the array [a]. *)
+
+val fold_right : ('b -> 'a -> 'a) -> 'b array -> 'a -> 'a
+(** [Array.fold_right f a x] computes
+   [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))],
+   where [n] is the length of the array [a]. *)
+
+
+(** {1 Iterators on two arrays} *)
+
+
+val iter2 : ('a -> 'b -> unit) -> 'a array -> 'b array -> unit
+(** [Array.iter2 f a b] applies function [f] to all the elements of [a]
+   and [b].
+   @raise Invalid_argument if the arrays are not the same size.
+   @since 4.03.0 *)
+
+val map2 : ('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
+(** [Array.map2 f a b] applies function [f] to all the elements of [a]
+   and [b], and builds an array with the results returned by [f]:
+   [[| f a.(0) b.(0); ...; f a.(Array.length a - 1) b.(Array.length b - 1)|]].
+   @raise Invalid_argument if the arrays are not the same size.
+   @since 4.03.0 *)
+
+
+(** {1 Array scanning} *)
+
+
+val for_all : ('a -> bool) -> 'a array -> bool
+(** [Array.for_all p [|a1; ...; an|]] checks if all elements of the array
+   satisfy the predicate [p]. That is, it returns
+   [(p a1) && (p a2) && ... && (p an)].
+   @since 4.03.0 *)
+
+val exists : ('a -> bool) -> 'a array -> bool
+(** [Array.exists p [|a1; ...; an|]] checks if at least one element of
+    the array satisfies the predicate [p]. That is, it returns
+    [(p a1) || (p a2) || ... || (p an)].
+    @since 4.03.0 *)
+
+val for_all2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool
+(** Same as {!Array.for_all}, but for a two-argument predicate.
+   @raise Invalid_argument if the two arrays have different lengths.
+   @since 4.11.0 *)
+
+val exists2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool
+(** Same as {!Array.exists}, but for a two-argument predicate.
+   @raise Invalid_argument if the two arrays have different lengths.
+   @since 4.11.0 *)
+
+val mem : 'a -> 'a array -> bool
+(** [mem a l] is true if and only if [a] is structurally equal
+    to an element of [l] (i.e. there is an [x] in [l] such that
+    [compare a x = 0]).
+    @since 4.03.0 *)
+
+val memq : 'a -> 'a array -> bool
+(** Same as {!Array.mem}, but uses physical equality instead of structural
+   equality to compare elements.
+   @since 4.03.0 *)
+
+
+(** {1 Sorting} *)
+
+
+val sort : ('a -> 'a -> int) -> 'a array -> unit
+(** Sort an array in increasing order according to a comparison
+   function.  The comparison function must return 0 if its arguments
+   compare as equal, a positive integer if the first is greater,
+   and a negative integer if the first is smaller (see below for a
+   complete specification).  For example, {!Stdlib.compare} is
+   a suitable comparison function.  After calling [Array.sort], the
+   array is sorted in place in increasing order.
+   [Array.sort] is guaranteed to run in constant heap space
+   and (at most) logarithmic stack space.
+
+   The current implementation uses Heap Sort.  It runs in constant
+   stack space.
+
+   Specification of the comparison function:
+   Let [a] be the array and [cmp] the comparison function.  The following
+   must be true for all [x], [y], [z] in [a] :
+-   [cmp x y] > 0 if and only if [cmp y x] < 0
+-   if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0
+
+   When [Array.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
+*)
+
+val stable_sort : ('a -> 'a -> int) -> 'a array -> unit
+(** Same as {!Array.sort}, but the sorting algorithm is stable (i.e.
+   elements that compare equal are kept in their original order) and
+   not guaranteed to run in constant heap space.
+
+   The current implementation uses Merge Sort. It uses a temporary
+   array of length [n/2], where [n] is the length of the array.
+   It is usually faster than the current implementation of {!Array.sort}.
+*)
+
+val fast_sort : ('a -> 'a -> int) -> 'a array -> unit
+(** Same as {!Array.sort} or {!Array.stable_sort}, whichever is faster
+    on typical input.
+*)
+
+
+(** {1 Iterators} *)
+
+val to_seq : 'a array -> 'a Seq.t
+(** Iterate on the array, in increasing order. Modifications of the
+    array during iteration will be reflected in the iterator.
+    @since 4.07 *)
+
+val to_seqi : 'a array -> (int * 'a) Seq.t
+(** Iterate on the array, in increasing order, yielding indices along elements.
+    Modifications of the array during iteration will be reflected in the
+    iterator.
+    @since 4.07 *)
+
+val of_seq : 'a Seq.t -> 'a array
+(** Create an array from the generator
+    @since 4.07 *)
+
+(**/**)
+(** {1 Undocumented functions} *)
+
+(* The following is for system use only. Do not call directly. *)
+
+external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get"
+external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set"
+
+module Floatarray : sig
+  external create : int -> floatarray = "caml_floatarray_create"
+  external length : floatarray -> int = "%floatarray_length"
+  external get : floatarray -> int -> float = "%floatarray_safe_get"
+  external set : floatarray -> int -> float -> unit = "%floatarray_safe_set"
+  external unsafe_get : floatarray -> int -> float = "%floatarray_unsafe_get"
+  external unsafe_set : floatarray -> int -> float -> unit
+      = "%floatarray_unsafe_set"
+end
diff --git a/stdlib/arrayLabels.ml b/stdlib/arrayLabels.ml
new file mode 100644
index 00000000..f7a460a1
--- /dev/null
+++ b/stdlib/arrayLabels.ml
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Jacques Garrigue, Kyoto University RIMS                 *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Module [ArrayLabels]: labelled Array module *)
+
+include Array
diff --git a/stdlib/arrayLabels.mli b/stdlib/arrayLabels.mli
new file mode 100644
index 00000000..a83a3ea4
--- /dev/null
+++ b/stdlib/arrayLabels.mli
@@ -0,0 +1,310 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Array operations
+
+   This module is intended to be used via {!StdLabels} which replaces
+   {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts
+
+   For example:
+   {[
+      open StdLabels
+
+      let everything = Array.create_matrix ~dimx:42 ~dimy:42 42
+   ]} *)
+
+type 'a t = 'a array
+(** An alias for the type of arrays. *)
+
+external length : 'a array -> int = "%array_length"
+(** Return the length (number of elements) of the given array. *)
+
+external get : 'a array -> int -> 'a = "%array_safe_get"
+(** [get a n] returns the element number [n] of array [a].
+   The first element has number 0.
+   The last element has number [length a - 1].
+   You can also write [a.(n)] instead of [get a n].
+
+   @raise Invalid_argument
+   if [n] is outside the range 0 to [(length a - 1)]. *)
+
+external set : 'a array -> int -> 'a -> unit = "%array_safe_set"
+(** [set a n x] modifies array [a] in place, replacing
+   element number [n] with [x].
+   You can also write [a.(n) <- x] instead of [set a n x].
+
+   @raise Invalid_argument
+   if [n] is outside the range 0 to [length a - 1]. *)
+
+external make : int -> 'a -> 'a array = "caml_make_vect"
+(** [make n x] returns a fresh array of length [n],
+   initialized with [x].
+   All the elements of this new array are initially
+   physically equal to [x] (in the sense of the [==] predicate).
+   Consequently, if [x] is mutable, it is shared among all elements
+   of the array, and modifying [x] through one of the array entries
+   will modify all other entries at the same time.
+
+   @raise Invalid_argument if [n < 0] or [n > Sys.max_array_length].
+   If the value of [x] is a floating-point number, then the maximum
+   size is only [Sys.max_array_length / 2].*)
+
+external create : int -> 'a -> 'a array = "caml_make_vect"
+  [@@ocaml.deprecated "Use Array.make instead."]
+(** @deprecated [create] is an alias for {!make}. *)
+
+val init : int -> f:(int -> 'a) -> 'a array
+(** [init n ~f] returns a fresh array of length [n],
+   with element number [i] initialized to the result of [f i].
+   In other terms, [init n ~f] tabulates the results of [f]
+   applied to the integers [0] to [n-1].
+
+   @raise Invalid_argument if [n < 0] or [n > Sys.max_array_length].
+   If the return type of [f] is [float], then the maximum
+   size is only [Sys.max_array_length / 2].*)
+
+val make_matrix : dimx:int -> dimy:int -> 'a -> 'a array array
+(** [make_matrix ~dimx ~dimy e] returns a two-dimensional array
+   (an array of arrays) with first dimension [dimx] and
+   second dimension [dimy]. All the elements of this new matrix
+   are initially physically equal to [e].
+   The element ([x,y]) of a matrix [m] is accessed
+   with the notation [m.(x).(y)].
+
+   @raise Invalid_argument if [dimx] or [dimy] is negative or
+   greater than {!Sys.max_array_length}.
+   If the value of [e] is a floating-point number, then the maximum
+   size is only [Sys.max_array_length / 2]. *)
+
+val create_matrix : dimx:int -> dimy:int -> 'a -> 'a array array
+  [@@ocaml.deprecated "Use Array.make_matrix instead."]
+(** @deprecated [create_matrix] is an alias for {!make_matrix}. *)
+
+val append : 'a array -> 'a array -> 'a array
+(** [append v1 v2] returns a fresh array containing the
+   concatenation of the arrays [v1] and [v2]. *)
+
+val concat : 'a array list -> 'a array
+(** Same as {!append}, but concatenates a list of arrays. *)
+
+val sub : 'a array -> pos:int -> len:int -> 'a array
+(** [sub a ~pos ~len] returns a fresh array of length [len],
+   containing the elements number [pos] to [pos + len - 1]
+   of array [a].
+
+   @raise Invalid_argument if [pos] and [len] do not
+   designate a valid subarray of [a]; that is, if
+   [pos < 0], or [len < 0], or [pos + len > length a]. *)
+
+val copy : 'a array -> 'a array
+(** [copy a] returns a copy of [a], that is, a fresh array
+   containing the same elements as [a]. *)
+
+val fill : 'a array -> pos:int -> len:int -> 'a -> unit
+(** [fill a ~pos ~len x] modifies the array [a] in place,
+   storing [x] in elements number [pos] to [pos + len - 1].
+
+   @raise Invalid_argument if [pos] and [len] do not
+   designate a valid subarray of [a]. *)
+
+val blit :
+  src:'a array -> src_pos:int -> dst:'a array -> dst_pos:int -> len:int ->
+    unit
+(** [blit ~src ~src_pos ~dst ~dst_pos ~len] copies [len] elements
+   from array [src], starting at element number [src_pos], to array [dst],
+   starting at element number [dst_pos]. It works correctly even if
+   [src] and [dst] are the same array, and the source and
+   destination chunks overlap.
+
+   @raise Invalid_argument if [src_pos] and [len] do not
+   designate a valid subarray of [src], or if [dst_pos] and [len] do not
+   designate a valid subarray of [dst]. *)
+
+val to_list : 'a array -> 'a list
+(** [to_list a] returns the list of all the elements of [a]. *)
+
+val of_list : 'a list -> 'a array
+(** [of_list l] returns a fresh array containing the elements
+   of [l]. *)
+
+val iter : f:('a -> unit) -> 'a array -> unit
+(** [iter ~f a] applies function [f] in turn to all
+   the elements of [a].  It is equivalent to
+   [f a.(0); f a.(1); ...; f a.(length a - 1); ()]. *)
+
+val map : f:('a -> 'b) -> 'a array -> 'b array
+(** [map ~f a] applies function [f] to all the elements of [a],
+   and builds an array with the results returned by [f]:
+   [[| f a.(0); f a.(1); ...; f a.(length a - 1) |]]. *)
+
+val iteri : f:(int -> 'a -> unit) -> 'a array -> unit
+(** Same as {!iter}, but the
+   function is applied to the index of the element as first argument,
+   and the element itself as second argument. *)
+
+val mapi : f:(int -> 'a -> 'b) -> 'a array -> 'b array
+(** Same as {!map}, but the
+   function is applied to the index of the element as first argument,
+   and the element itself as second argument. *)
+
+val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b array -> 'a
+(** [fold_left ~f ~init a] computes
+   [f (... (f (f init a.(0)) a.(1)) ...) a.(n-1)],
+   where [n] is the length of the array [a]. *)
+
+val fold_right : f:('b -> 'a -> 'a) -> 'b array -> init:'a -> 'a
+(** [fold_right ~f a ~init] computes
+   [f a.(0) (f a.(1) ( ... (f a.(n-1) init) ...))],
+   where [n] is the length of the array [a]. *)
+
+
+(** {1 Iterators on two arrays} *)
+
+
+val iter2 : f:('a -> 'b -> unit) -> 'a array -> 'b array -> unit
+(** [iter2 ~f a b] applies function [f] to all the elements of [a]
+   and [b].
+   @raise Invalid_argument if the arrays are not the same size.
+   @since 4.05.0 *)
+
+val map2 : f:('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
+(** [map2 ~f a b] applies function [f] to all the elements of [a]
+   and [b], and builds an array with the results returned by [f]:
+   [[| f a.(0) b.(0); ...; f a.(length a - 1) b.(length b - 1)|]].
+   @raise Invalid_argument if the arrays are not the same size.
+   @since 4.05.0 *)
+
+
+(** {1 Array scanning} *)
+
+
+val exists : f:('a -> bool) -> 'a array -> bool
+(** [exists ~f [|a1; ...; an|]] checks if at least one element of
+    the array satisfies the predicate [f]. That is, it returns
+    [(f a1) || (f a2) || ... || (f an)].
+    @since 4.03.0 *)
+
+val for_all : f:('a -> bool) -> 'a array -> bool
+(** [for_all ~f [|a1; ...; an|]] checks if all elements
+   of the array satisfy the predicate [f]. That is, it returns
+   [(f a1) && (f a2) && ... && (f an)].
+   @since 4.03.0 *)
+
+val for_all2 : f:('a -> 'b -> bool) -> 'a array -> 'b array -> bool
+(** Same as {!ArrayLabels.for_all}, but for a two-argument predicate.
+   @raise Invalid_argument if the two arrays have different lengths.
+   @since 4.11.0 *)
+
+val exists2 : f:('a -> 'b -> bool) -> 'a array -> 'b array -> bool
+(** Same as {!ArrayLabels.exists}, but for a two-argument predicate.
+   @raise Invalid_argument if the two arrays have different lengths.
+   @since 4.11.0 *)
+
+val mem : 'a -> set:'a array -> bool
+(** [mem x ~set] is true if and only if [x] is equal
+   to an element of [set].
+   @since 4.03.0 *)
+
+val memq : 'a -> set:'a array -> bool
+(** Same as {!mem}, but uses physical equality
+   instead of structural equality to compare list elements.
+   @since 4.03.0 *)
+
+external create_float: int -> float array = "caml_make_float_vect"
+(** [create_float n] returns a fresh float array of length [n],
+    with uninitialized data.
+    @since 4.03 *)
+
+val make_float: int -> float array
+  [@@ocaml.deprecated "Use Array.create_float instead."]
+(** @deprecated {!make_float} is an alias for
+    {!create_float}. *)
+
+
+(** {1 Sorting} *)
+
+
+val sort : cmp:('a -> 'a -> int) -> 'a array -> unit
+(** Sort an array in increasing order according to a comparison
+   function.  The comparison function must return 0 if its arguments
+   compare as equal, a positive integer if the first is greater,
+   and a negative integer if the first is smaller (see below for a
+   complete specification).  For example, {!Stdlib.compare} is
+   a suitable comparison function, provided there are no floating-point
+   NaN values in the data.  After calling [sort], the
+   array is sorted in place in increasing order.
+   [sort] is guaranteed to run in constant heap space
+   and (at most) logarithmic stack space.
+
+   The current implementation uses Heap Sort.  It runs in constant
+   stack space.
+
+   Specification of the comparison function:
+   Let [a] be the array and [cmp] the comparison function.  The following
+   must be true for all x, y, z in a :
+-   [cmp x y] > 0 if and only if [cmp y x] < 0
+-   if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0
+
+   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
+*)
+
+val stable_sort : cmp:('a -> 'a -> int) -> 'a array -> unit
+(** Same as {!sort}, but the sorting algorithm is stable (i.e.
+   elements that compare equal are kept in their original order) and
+   not guaranteed to run in constant heap space.
+
+   The current implementation uses Merge Sort. It uses [n/2]
+   words of heap space, where [n] is the length of the array.
+   It is usually faster than the current implementation of {!sort}.
+*)
+
+val fast_sort : cmp:('a -> 'a -> int) -> 'a array -> unit
+(** Same as {!sort} or {!stable_sort}, whichever is faster on typical input. *)
+
+
+(** {1 Iterators} *)
+
+val to_seq : 'a array -> 'a Seq.t
+(** Iterate on the array, in increasing order
+    @since 4.07 *)
+
+val to_seqi : 'a array -> (int * 'a) Seq.t
+(** Iterate on the array, in increasing order, yielding indices along elements
+    @since 4.07 *)
+
+val of_seq : 'a Seq.t -> 'a array
+(** Create an array from the generator
+    @since 4.07 *)
+
+(**/**)
+
+(** {1 Undocumented functions} *)
+
+(* The following is for system use only. Do not call directly. *)
+
+external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get"
+external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set"
+
+module Floatarray : sig
+  external create : int -> floatarray = "caml_floatarray_create"
+  external length : floatarray -> int = "%floatarray_length"
+  external get : floatarray -> int -> float = "%floatarray_safe_get"
+  external set : floatarray -> int -> float -> unit = "%floatarray_safe_set"
+  external unsafe_get : floatarray -> int -> float = "%floatarray_unsafe_get"
+  external unsafe_set : floatarray -> int -> float -> unit
+      = "%floatarray_unsafe_set"
+end
diff --git a/stdlib/bigarray.ml b/stdlib/bigarray.ml
new file mode 100644
index 00000000..86c737ae
--- /dev/null
+++ b/stdlib/bigarray.ml
@@ -0,0 +1,349 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Manuel Serrano et Xavier Leroy, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2000 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 [Bigarray]: large, multi-dimensional, numerical arrays *)
+
+(* These types in must be kept in sync with the tables in
+   ../typing/typeopt.ml *)
+
+type float32_elt = Float32_elt
+type float64_elt = Float64_elt
+type int8_signed_elt = Int8_signed_elt
+type int8_unsigned_elt = Int8_unsigned_elt
+type int16_signed_elt = Int16_signed_elt
+type int16_unsigned_elt = Int16_unsigned_elt
+type int32_elt = Int32_elt
+type int64_elt = Int64_elt
+type int_elt = Int_elt
+type nativeint_elt = Nativeint_elt
+type complex32_elt = Complex32_elt
+type complex64_elt = Complex64_elt
+
+type ('a, 'b) kind =
+    Float32 : (float, float32_elt) kind
+  | Float64 : (float, float64_elt) kind
+  | Int8_signed : (int, int8_signed_elt) kind
+  | Int8_unsigned : (int, int8_unsigned_elt) kind
+  | Int16_signed : (int, int16_signed_elt) kind
+  | Int16_unsigned : (int, int16_unsigned_elt) kind
+  | Int32 : (int32, int32_elt) kind
+  | Int64 : (int64, int64_elt) kind
+  | Int : (int, int_elt) kind
+  | Nativeint : (nativeint, nativeint_elt) kind
+  | Complex32 : (Complex.t, complex32_elt) kind
+  | Complex64 : (Complex.t, complex64_elt) kind
+  | Char : (char, int8_unsigned_elt) kind
+
+type c_layout = C_layout_typ
+type fortran_layout = Fortran_layout_typ (**)
+
+type 'a layout =
+    C_layout: c_layout layout
+  | Fortran_layout: fortran_layout layout
+
+(* Keep those constants in sync with the caml_ba_kind enumeration
+   in bigarray.h *)
+
+let float32 = Float32
+let float64 = Float64
+let int8_signed = Int8_signed
+let int8_unsigned = Int8_unsigned
+let int16_signed = Int16_signed
+let int16_unsigned = Int16_unsigned
+let int32 = Int32
+let int64 = Int64
+let int = Int
+let nativeint = Nativeint
+let complex32 = Complex32
+let complex64 = Complex64
+let char = Char
+
+let kind_size_in_bytes : type a b. (a, b) kind -> int = function
+  | Float32 -> 4
+  | Float64 -> 8
+  | Int8_signed -> 1
+  | Int8_unsigned -> 1
+  | Int16_signed -> 2
+  | Int16_unsigned -> 2
+  | Int32 -> 4
+  | Int64 -> 8
+  | Int -> Sys.word_size / 8
+  | Nativeint -> Sys.word_size / 8
+  | Complex32 -> 8
+  | Complex64 -> 16
+  | Char -> 1
+
+(* Keep those constants in sync with the caml_ba_layout enumeration
+   in bigarray.h *)
+
+let c_layout = C_layout
+let fortran_layout = Fortran_layout
+
+module Genarray = struct
+  type ('a, 'b, 'c) t
+  external create: ('a, 'b) kind -> 'c layout -> int array -> ('a, 'b, 'c) t
+     = "caml_ba_create"
+  external get: ('a, 'b, 'c) t -> int array -> 'a
+     = "caml_ba_get_generic"
+  external set: ('a, 'b, 'c) t -> int array -> 'a -> unit
+     = "caml_ba_set_generic"
+  external num_dims: ('a, 'b, 'c) t -> int = "caml_ba_num_dims"
+  external nth_dim: ('a, 'b, 'c) t -> int -> int = "caml_ba_dim"
+  let dims a =
+    let n = num_dims a in
+    let d = Array.make n 0 in
+    for i = 0 to n-1 do d.(i) <- nth_dim a i done;
+    d
+
+  external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
+  external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
+  external change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
+     = "caml_ba_change_layout"
+
+  let size_in_bytes arr =
+    (kind_size_in_bytes (kind arr)) * (Array.fold_left ( * ) 1 (dims arr))
+
+  external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
+     = "caml_ba_sub"
+  external sub_right: ('a, 'b, fortran_layout) t -> int -> int ->
+                          ('a, 'b, fortran_layout) t
+     = "caml_ba_sub"
+  external slice_left: ('a, 'b, c_layout) t -> int array ->
+                          ('a, 'b, c_layout) t
+     = "caml_ba_slice"
+  external slice_right: ('a, 'b, fortran_layout) t -> int array ->
+                          ('a, 'b, fortran_layout) t
+     = "caml_ba_slice"
+  external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit
+     = "caml_ba_blit"
+  external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
+end
+
+module Array0 = struct
+  type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
+  let create kind layout =
+    Genarray.create kind layout [||]
+  let get arr = Genarray.get arr [||]
+  let set arr = Genarray.set arr [||]
+  external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
+  external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
+
+  external change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
+    = "caml_ba_change_layout"
+
+  let size_in_bytes arr = kind_size_in_bytes (kind arr)
+
+  external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
+  external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
+
+  let of_value kind layout v =
+    let a = create kind layout in
+    set a v;
+    a
+end
+
+module Array1 = struct
+  type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
+  let create kind layout dim =
+    Genarray.create kind layout [|dim|]
+  external get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_ref_1"
+  external set: ('a, 'b, 'c) t -> int -> 'a -> unit = "%caml_ba_set_1"
+  external unsafe_get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_unsafe_ref_1"
+  external unsafe_set: ('a, 'b, 'c) t -> int -> 'a -> unit
+     = "%caml_ba_unsafe_set_1"
+  external dim: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
+  external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
+  external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
+
+  external change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
+    = "caml_ba_change_layout"
+
+  let size_in_bytes arr =
+    (kind_size_in_bytes (kind arr)) * (dim arr)
+
+  external sub: ('a, 'b, 'c) t -> int -> int -> ('a, 'b, 'c) t = "caml_ba_sub"
+  let slice (type t) (a : (_, _, t) Genarray.t) n =
+    match layout a with
+    | C_layout -> (Genarray.slice_left a [|n|] : (_, _, t) Genarray.t)
+    | Fortran_layout -> (Genarray.slice_right a [|n|]: (_, _, t) Genarray.t)
+  external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
+  external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
+  let of_array (type t) kind (layout: t layout) data =
+    let ba = create kind layout (Array.length data) in
+    let ofs =
+      match layout with
+        C_layout -> 0
+      | Fortran_layout -> 1
+    in
+    for i = 0 to Array.length data - 1 do unsafe_set ba (i + ofs) data.(i) done;
+    ba
+end
+
+module Array2 = struct
+  type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
+  let create kind layout dim1 dim2 =
+    Genarray.create kind layout [|dim1; dim2|]
+  external get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_ref_2"
+  external set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit = "%caml_ba_set_2"
+  external unsafe_get: ('a, 'b, 'c) t -> int -> int -> 'a
+     = "%caml_ba_unsafe_ref_2"
+  external unsafe_set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit
+     = "%caml_ba_unsafe_set_2"
+  external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
+  external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
+  external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
+  external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
+
+  external change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
+    = "caml_ba_change_layout"
+
+  let size_in_bytes arr =
+    (kind_size_in_bytes (kind arr)) * (dim1 arr) * (dim2 arr)
+
+  external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
+     = "caml_ba_sub"
+  external sub_right:
+    ('a, 'b, fortran_layout) t -> int -> int -> ('a, 'b, fortran_layout) t
+     = "caml_ba_sub"
+  let slice_left a n = Genarray.slice_left a [|n|]
+  let slice_right a n = Genarray.slice_right a [|n|]
+  external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
+  external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
+  let of_array (type t) kind (layout: t layout) data =
+    let dim1 = Array.length data in
+    let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in
+    let ba = create kind layout dim1 dim2 in
+    let ofs =
+      match layout with
+        C_layout -> 0
+      | Fortran_layout -> 1
+    in
+    for i = 0 to dim1 - 1 do
+      let row = data.(i) in
+      if Array.length row <> dim2 then
+        invalid_arg("Bigarray.Array2.of_array: non-rectangular data");
+      for j = 0 to dim2 - 1 do
+        unsafe_set ba (i + ofs) (j + ofs) row.(j)
+      done
+    done;
+    ba
+end
+
+module Array3 = struct
+  type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
+  let create kind layout dim1 dim2 dim3 =
+    Genarray.create kind layout [|dim1; dim2; dim3|]
+  external get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_ref_3"
+  external set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit
+     = "%caml_ba_set_3"
+  external unsafe_get: ('a, 'b, 'c) t -> int -> int -> int -> 'a
+     = "%caml_ba_unsafe_ref_3"
+  external unsafe_set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit
+     = "%caml_ba_unsafe_set_3"
+  external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
+  external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
+  external dim3: ('a, 'b, 'c) t -> int = "%caml_ba_dim_3"
+  external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
+  external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
+
+  external change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
+    = "caml_ba_change_layout"
+
+  let size_in_bytes arr =
+    (kind_size_in_bytes (kind arr)) * (dim1 arr) * (dim2 arr) * (dim3 arr)
+
+  external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
+     = "caml_ba_sub"
+  external sub_right:
+     ('a, 'b, fortran_layout) t -> int -> int -> ('a, 'b, fortran_layout) t
+     = "caml_ba_sub"
+  let slice_left_1 a n m = Genarray.slice_left a [|n; m|]
+  let slice_right_1 a n m = Genarray.slice_right a [|n; m|]
+  let slice_left_2 a n = Genarray.slice_left a [|n|]
+  let slice_right_2 a n = Genarray.slice_right a [|n|]
+  external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
+  external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
+  let of_array (type t) kind (layout: t layout) data =
+    let dim1 = Array.length data in
+    let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in
+    let dim3 = if dim2 = 0 then 0 else Array.length data.(0).(0) in
+    let ba = create kind layout dim1 dim2 dim3 in
+    let ofs =
+      match layout with
+        C_layout -> 0
+      | Fortran_layout -> 1
+    in
+    for i = 0 to dim1 - 1 do
+      let row = data.(i) in
+      if Array.length row <> dim2 then
+        invalid_arg("Bigarray.Array3.of_array: non-cubic data");
+      for j = 0 to dim2 - 1 do
+        let col = row.(j) in
+        if Array.length col <> dim3 then
+          invalid_arg("Bigarray.Array3.of_array: non-cubic data");
+        for k = 0 to dim3 - 1 do
+          unsafe_set ba (i + ofs) (j + ofs) (k + ofs) col.(k)
+        done
+      done
+    done;
+    ba
+end
+
+external genarray_of_array0: ('a, 'b, 'c) Array0.t -> ('a, 'b, 'c) Genarray.t
+   = "%identity"
+external genarray_of_array1: ('a, 'b, 'c) Array1.t -> ('a, 'b, 'c) Genarray.t
+   = "%identity"
+external genarray_of_array2: ('a, 'b, 'c) Array2.t -> ('a, 'b, 'c) Genarray.t
+   = "%identity"
+external genarray_of_array3: ('a, 'b, 'c) Array3.t -> ('a, 'b, 'c) Genarray.t
+   = "%identity"
+let array0_of_genarray a =
+  if Genarray.num_dims a = 0 then a
+  else invalid_arg "Bigarray.array0_of_genarray"
+let array1_of_genarray a =
+  if Genarray.num_dims a = 1 then a
+  else invalid_arg "Bigarray.array1_of_genarray"
+let array2_of_genarray a =
+  if Genarray.num_dims a = 2 then a
+  else invalid_arg "Bigarray.array2_of_genarray"
+let array3_of_genarray a =
+  if Genarray.num_dims a = 3 then a
+  else invalid_arg "Bigarray.array3_of_genarray"
+
+external reshape:
+   ('a, 'b, 'c) Genarray.t -> int array -> ('a, 'b, 'c) Genarray.t
+   = "caml_ba_reshape"
+let reshape_0 a = reshape a [||]
+let reshape_1 a dim1 = reshape a [|dim1|]
+let reshape_2 a dim1 dim2 = reshape a [|dim1;dim2|]
+let reshape_3 a dim1 dim2 dim3 = reshape a [|dim1;dim2;dim3|]
+
+(* Force caml_ba_get_{1,2,3,N} to be linked in, since we don't refer
+   to those primitives directly in this file *)
+
+let _ =
+  let _ = Genarray.get in
+  let _ = Array1.get in
+  let _ = Array2.get in
+  let _ = Array3.get in
+  ()
+
+[@@@ocaml.warning "-32"]
+external get1: unit -> unit = "caml_ba_get_1"
+external get2: unit -> unit = "caml_ba_get_2"
+external get3: unit -> unit = "caml_ba_get_3"
+external set1: unit -> unit = "caml_ba_set_1"
+external set2: unit -> unit = "caml_ba_set_2"
+external set3: unit -> unit = "caml_ba_set_3"
diff --git a/stdlib/bigarray.mli b/stdlib/bigarray.mli
new file mode 100644
index 00000000..a474d559
--- /dev/null
+++ b/stdlib/bigarray.mli
@@ -0,0 +1,967 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          Manuel Serrano and Xavier Leroy, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2000 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Large, multi-dimensional, numerical arrays.
+
+   This module implements multi-dimensional arrays of integers and
+   floating-point numbers, thereafter referred to as 'Bigarrays',
+   to distinguish them from the standard OCaml arrays described in
+   {!module:Array}.
+
+   The implementation allows efficient sharing of large numerical
+   arrays between OCaml code and C or Fortran numerical libraries.
+
+   The main differences between 'Bigarrays' and standard OCaml
+   arrays are as follows:
+   - Bigarrays are not limited in size, unlike OCaml arrays.
+     (Normal float arrays are limited to 2,097,151 elements on a 32-bit
+     platform, and normal arrays of other types to 4,194,303 elements.)
+   - Bigarrays are multi-dimensional.  Any number of dimensions
+     between 0 and 16 is supported.  In contrast, OCaml arrays
+     are mono-dimensional and require encoding multi-dimensional
+     arrays as arrays of arrays.
+   - Bigarrays can only contain integers and floating-point numbers,
+     while OCaml arrays can contain arbitrary OCaml data types.
+   - Bigarrays provide more space-efficient storage of
+     integer and floating-point elements than normal OCaml arrays, in
+     particular because they support 'small' types such as
+     single-precision floats and 8 and 16-bit integers, in addition to
+     the standard OCaml types of double-precision floats and 32 and
+     64-bit integers.
+   - The memory layout of Bigarrays is entirely compatible with that
+     of arrays in C and Fortran, allowing large arrays to be passed
+     back and forth between OCaml code and C / Fortran code with no
+     data copying at all.
+   - Bigarrays support interesting high-level operations that normal
+     arrays do not provide efficiently, such as extracting sub-arrays
+     and 'slicing' a multi-dimensional array along certain dimensions,
+     all without any copying.
+
+   Users of this module are encouraged to do [open Bigarray] in their
+   source, then refer to array types and operations via short dot
+   notation, e.g. [Array1.t] or [Array2.sub].
+
+   Bigarrays support all the OCaml ad-hoc polymorphic operations:
+   - comparisons ([=], [<>], [<=], etc, as well as {!Stdlib.compare});
+   - hashing (module [Hash]);
+   - and structured input-output (the functions from the
+     {!Marshal} module, as well as {!Stdlib.output_value}
+     and {!Stdlib.input_value}).
+*)
+
+(** {1 Element kinds} *)
+
+(** Bigarrays can contain elements of the following kinds:
+- IEEE single precision (32 bits) floating-point numbers
+   ({!Bigarray.float32_elt}),
+- IEEE double precision (64 bits) floating-point numbers
+   ({!Bigarray.float64_elt}),
+- IEEE single precision (2 * 32 bits) floating-point complex numbers
+   ({!Bigarray.complex32_elt}),
+- IEEE double precision (2 * 64 bits) floating-point complex numbers
+   ({!Bigarray.complex64_elt}),
+- 8-bit integers (signed or unsigned)
+   ({!Bigarray.int8_signed_elt} or {!Bigarray.int8_unsigned_elt}),
+- 16-bit integers (signed or unsigned)
+   ({!Bigarray.int16_signed_elt} or {!Bigarray.int16_unsigned_elt}),
+- OCaml integers (signed, 31 bits on 32-bit architectures,
+   63 bits on 64-bit architectures) ({!Bigarray.int_elt}),
+- 32-bit signed integers ({!Bigarray.int32_elt}),
+- 64-bit signed integers ({!Bigarray.int64_elt}),
+- platform-native signed integers (32 bits on 32-bit architectures,
+   64 bits on 64-bit architectures) ({!Bigarray.nativeint_elt}).
+
+   Each element kind is represented at the type level by one of the
+   [*_elt] types defined below (defined with a single constructor instead
+   of abstract types for technical injectivity reasons).
+
+   @since 4.07.0 Moved from otherlibs to stdlib.
+*)
+
+type float32_elt = Float32_elt
+type float64_elt = Float64_elt
+type int8_signed_elt = Int8_signed_elt
+type int8_unsigned_elt = Int8_unsigned_elt
+type int16_signed_elt = Int16_signed_elt
+type int16_unsigned_elt = Int16_unsigned_elt
+type int32_elt = Int32_elt
+type int64_elt = Int64_elt
+type int_elt = Int_elt
+type nativeint_elt = Nativeint_elt
+type complex32_elt = Complex32_elt
+type complex64_elt = Complex64_elt
+
+type ('a, 'b) kind =
+    Float32 : (float, float32_elt) kind
+  | Float64 : (float, float64_elt) kind
+  | Int8_signed : (int, int8_signed_elt) kind
+  | Int8_unsigned : (int, int8_unsigned_elt) kind
+  | Int16_signed : (int, int16_signed_elt) kind
+  | Int16_unsigned : (int, int16_unsigned_elt) kind
+  | Int32 : (int32, int32_elt) kind
+  | Int64 : (int64, int64_elt) kind
+  | Int : (int, int_elt) kind
+  | Nativeint : (nativeint, nativeint_elt) kind
+  | Complex32 : (Complex.t, complex32_elt) kind
+  | Complex64 : (Complex.t, complex64_elt) kind
+  | Char : (char, int8_unsigned_elt) kind (**)
+(** To each element kind is associated an OCaml type, which is
+   the type of OCaml values that can be stored in the Bigarray
+   or read back from it.  This type is not necessarily the same
+   as the type of the array elements proper: for instance,
+   a Bigarray whose elements are of kind [float32_elt] contains
+   32-bit single precision floats, but reading or writing one of
+   its elements from OCaml uses the OCaml type [float], which is
+   64-bit double precision floats.
+
+   The GADT type [('a, 'b) kind] captures this association
+   of an OCaml type ['a] for values read or written in the Bigarray,
+   and of an element kind ['b] which represents the actual contents
+   of the Bigarray. Its constructors list all possible associations
+   of OCaml types with element kinds, and are re-exported below for
+   backward-compatibility reasons.
+
+   Using a generalized algebraic datatype (GADT) here allows writing
+   well-typed polymorphic functions whose return type depend on the
+   argument type, such as:
+
+{[
+  let zero : type a b. (a, b) kind -> a = function
+    | Float32 -> 0.0 | Complex32 -> Complex.zero
+    | Float64 -> 0.0 | Complex64 -> Complex.zero
+    | Int8_signed -> 0 | Int8_unsigned -> 0
+    | Int16_signed -> 0 | Int16_unsigned -> 0
+    | Int32 -> 0l | Int64 -> 0L
+    | Int -> 0 | Nativeint -> 0n
+    | Char -> '\000'
+]}
+*)
+
+val float32 : (float, float32_elt) kind
+(** See {!Bigarray.char}. *)
+
+val float64 : (float, float64_elt) kind
+(** See {!Bigarray.char}. *)
+
+val complex32 : (Complex.t, complex32_elt) kind
+(** See {!Bigarray.char}. *)
+
+val complex64 : (Complex.t, complex64_elt) kind
+(** See {!Bigarray.char}. *)
+
+val int8_signed : (int, int8_signed_elt) kind
+(** See {!Bigarray.char}. *)
+
+val int8_unsigned : (int, int8_unsigned_elt) kind
+(** See {!Bigarray.char}. *)
+
+val int16_signed : (int, int16_signed_elt) kind
+(** See {!Bigarray.char}. *)
+
+val int16_unsigned : (int, int16_unsigned_elt) kind
+(** See {!Bigarray.char}. *)
+
+val int : (int, int_elt) kind
+(** See {!Bigarray.char}. *)
+
+val int32 : (int32, int32_elt) kind
+(** See {!Bigarray.char}. *)
+
+val int64 : (int64, int64_elt) kind
+(** See {!Bigarray.char}. *)
+
+val nativeint : (nativeint, nativeint_elt) kind
+(** See {!Bigarray.char}. *)
+
+val char : (char, int8_unsigned_elt) kind
+(** As shown by the types of the values above,
+   Bigarrays of kind [float32_elt] and [float64_elt] are
+   accessed using the OCaml type [float].  Bigarrays of complex kinds
+   [complex32_elt], [complex64_elt] are accessed with the OCaml type
+   {!Complex.t}. Bigarrays of
+   integer kinds are accessed using the smallest OCaml integer
+   type large enough to represent the array elements:
+   [int] for 8- and 16-bit integer Bigarrays, as well as OCaml-integer
+   Bigarrays; [int32] for 32-bit integer Bigarrays; [int64]
+   for 64-bit integer Bigarrays; and [nativeint] for
+   platform-native integer Bigarrays.  Finally, Bigarrays of
+   kind [int8_unsigned_elt] can also be accessed as arrays of
+   characters instead of arrays of small integers, by using
+   the kind value [char] instead of [int8_unsigned]. *)
+
+val kind_size_in_bytes : ('a, 'b) kind -> int
+(** [kind_size_in_bytes k] is the number of bytes used to store
+   an element of type [k].
+
+   @since 4.03.0 *)
+
+(** {1 Array layouts} *)
+
+type c_layout = C_layout_typ (**)
+(** See {!Bigarray.fortran_layout}.*)
+
+type fortran_layout = Fortran_layout_typ (**)
+(** To facilitate interoperability with existing C and Fortran code,
+   this library supports two different memory layouts for Bigarrays,
+   one compatible with the C conventions,
+   the other compatible with the Fortran conventions.
+
+   In the C-style layout, array indices start at 0, and
+   multi-dimensional arrays are laid out in row-major format.
+   That is, for a two-dimensional array, all elements of
+   row 0 are contiguous in memory, followed by all elements of
+   row 1, etc.  In other terms, the array elements at [(x,y)]
+   and [(x, y+1)] are adjacent in memory.
+
+   In the Fortran-style layout, array indices start at 1, and
+   multi-dimensional arrays are laid out in column-major format.
+   That is, for a two-dimensional array, all elements of
+   column 0 are contiguous in memory, followed by all elements of
+   column 1, etc.  In other terms, the array elements at [(x,y)]
+   and [(x+1, y)] are adjacent in memory.
+
+   Each layout style is identified at the type level by the
+   phantom types {!Bigarray.c_layout} and {!Bigarray.fortran_layout}
+   respectively. *)
+
+(** {7 Supported layouts}
+
+   The GADT type ['a layout] represents one of the two supported
+   memory layouts: C-style or Fortran-style. Its constructors are
+   re-exported as values below for backward-compatibility reasons.
+*)
+
+type 'a layout =
+    C_layout: c_layout layout
+  | Fortran_layout: fortran_layout layout
+
+val c_layout : c_layout layout
+val fortran_layout : fortran_layout layout
+
+
+(** {1 Generic arrays (of arbitrarily many dimensions)} *)
+
+module Genarray :
+  sig
+  type ('a, 'b, 'c) t
+  (** The type [Genarray.t] is the type of Bigarrays with variable
+     numbers of dimensions.  Any number of dimensions between 0 and 16
+     is supported.
+
+     The three type parameters to [Genarray.t] identify the array element
+     kind and layout, as follows:
+     - the first parameter, ['a], is the OCaml type for accessing array
+       elements ([float], [int], [int32], [int64], [nativeint]);
+     - the second parameter, ['b], is the actual kind of array elements
+       ([float32_elt], [float64_elt], [int8_signed_elt], [int8_unsigned_elt],
+       etc);
+     - the third parameter, ['c], identifies the array layout
+       ([c_layout] or [fortran_layout]).
+
+     For instance, [(float, float32_elt, fortran_layout) Genarray.t]
+     is the type of generic Bigarrays containing 32-bit floats
+     in Fortran layout; reads and writes in this array use the
+     OCaml type [float]. *)
+
+  external create: ('a, 'b) kind -> 'c layout -> int array -> ('a, 'b, 'c) t
+    = "caml_ba_create"
+  (** [Genarray.create kind layout dimensions] returns a new Bigarray
+     whose element kind is determined by the parameter [kind] (one of
+     [float32], [float64], [int8_signed], etc) and whose layout is
+     determined by the parameter [layout] (one of [c_layout] or
+     [fortran_layout]).  The [dimensions] parameter is an array of
+     integers that indicate the size of the Bigarray in each dimension.
+     The length of [dimensions] determines the number of dimensions
+     of the Bigarray.
+
+     For instance, [Genarray.create int32 c_layout [|4;6;8|]]
+     returns a fresh Bigarray of 32-bit integers, in C layout,
+     having three dimensions, the three dimensions being 4, 6 and 8
+     respectively.
+
+     Bigarrays returned by [Genarray.create] are not initialized:
+     the initial values of array elements is unspecified.
+
+     [Genarray.create] raises [Invalid_argument] if the number of dimensions
+     is not in the range 0 to 16 inclusive, or if one of the dimensions
+     is negative. *)
+
+  external num_dims: ('a, 'b, 'c) t -> int = "caml_ba_num_dims"
+  (** Return the number of dimensions of the given Bigarray. *)
+
+  val dims : ('a, 'b, 'c) t -> int array
+  (** [Genarray.dims a] returns all dimensions of the Bigarray [a],
+     as an array of integers of length [Genarray.num_dims a]. *)
+
+  external nth_dim: ('a, 'b, 'c) t -> int -> int = "caml_ba_dim"
+  (** [Genarray.nth_dim a n] returns the [n]-th dimension of the
+     Bigarray [a].  The first dimension corresponds to [n = 0];
+     the second dimension corresponds to [n = 1]; the last dimension,
+     to [n = Genarray.num_dims a - 1].
+     @raise Invalid_argument if [n] is less than 0 or greater or equal than
+     [Genarray.num_dims a]. *)
+
+  external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
+  (** Return the kind of the given Bigarray. *)
+
+  external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
+  (** Return the layout of the given Bigarray. *)
+
+  external change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
+      = "caml_ba_change_layout"
+  (** [Genarray.change_layout a layout] returns a Bigarray with the
+      specified [layout], sharing the data with [a] (and hence having
+      the same dimensions as [a]). No copying of elements is involved: the
+      new array and the original array share the same storage space.
+      The dimensions are reversed, such that [get v [| a; b |]] in
+      C layout becomes [get v [| b+1; a+1 |]] in Fortran layout.
+
+      @since 4.04.0
+  *)
+
+  val size_in_bytes : ('a, 'b, 'c) t -> int
+  (** [size_in_bytes a] is the number of elements in [a] multiplied
+    by [a]'s {!kind_size_in_bytes}.
+
+    @since 4.03.0 *)
+
+  external get: ('a, 'b, 'c) t -> int array -> 'a = "caml_ba_get_generic"
+  (** Read an element of a generic Bigarray.
+     [Genarray.get a [|i1; ...; iN|]] returns the element of [a]
+     whose coordinates are [i1] in the first dimension, [i2] in
+     the second dimension, ..., [iN] in the [N]-th dimension.
+
+     If [a] has C layout, the coordinates must be greater or equal than 0
+     and strictly less than the corresponding dimensions of [a].
+     If [a] has Fortran layout, the coordinates must be greater or equal
+     than 1 and less or equal than the corresponding dimensions of [a].
+
+     If [N > 3], alternate syntax is provided: you can write
+     [a.{i1, i2, ..., iN}] instead of [Genarray.get a [|i1; ...; iN|]].
+     (The syntax [a.{...}] with one, two or three coordinates is
+     reserved for accessing one-, two- and three-dimensional arrays
+     as described below.)
+
+     @raise Invalid_argument if the array [a] does not have exactly [N]
+     dimensions, or if the coordinates are outside the array bounds.
+  *)
+
+  external set: ('a, 'b, 'c) t -> int array -> 'a -> unit
+    = "caml_ba_set_generic"
+  (** Assign an element of a generic Bigarray.
+     [Genarray.set a [|i1; ...; iN|] v] stores the value [v] in the
+     element of [a] whose coordinates are [i1] in the first dimension,
+     [i2] in the second dimension, ..., [iN] in the [N]-th dimension.
+
+     The array [a] must have exactly [N] dimensions, and all coordinates
+     must lie inside the array bounds, as described for [Genarray.get];
+     otherwise, [Invalid_argument] is raised.
+
+     If [N > 3], alternate syntax is provided: you can write
+     [a.{i1, i2, ..., iN} <- v] instead of
+     [Genarray.set a [|i1; ...; iN|] v].
+     (The syntax [a.{...} <- v] with one, two or three coordinates is
+     reserved for updating one-, two- and three-dimensional arrays
+     as described below.) *)
+
+  external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
+    = "caml_ba_sub"
+  (** Extract a sub-array of the given Bigarray by restricting the
+     first (left-most) dimension.  [Genarray.sub_left a ofs len]
+     returns a Bigarray with the same number of dimensions as [a],
+     and the same dimensions as [a], except the first dimension,
+     which corresponds to the interval [[ofs ... ofs + len - 1]]
+     of the first dimension of [a].  No copying of elements is
+     involved: the sub-array and the original array share the same
+     storage space.  In other terms, the element at coordinates
+     [[|i1; ...; iN|]] of the sub-array is identical to the
+     element at coordinates [[|i1+ofs; ...; iN|]] of the original
+     array [a].
+
+     [Genarray.sub_left] applies only to Bigarrays in C layout.
+     @raise Invalid_argument if [ofs] and [len] do not designate
+     a valid sub-array of [a], that is, if [ofs < 0], or [len < 0],
+     or [ofs + len > Genarray.nth_dim a 0]. *)
+
+  external sub_right:
+    ('a, 'b, fortran_layout) t -> int -> int -> ('a, 'b, fortran_layout) t
+    = "caml_ba_sub"
+  (** Extract a sub-array of the given Bigarray by restricting the
+     last (right-most) dimension.  [Genarray.sub_right a ofs len]
+     returns a Bigarray with the same number of dimensions as [a],
+     and the same dimensions as [a], except the last dimension,
+     which corresponds to the interval [[ofs ... ofs + len - 1]]
+     of the last dimension of [a].  No copying of elements is
+     involved: the sub-array and the original array share the same
+     storage space.  In other terms, the element at coordinates
+     [[|i1; ...; iN|]] of the sub-array is identical to the
+     element at coordinates [[|i1; ...; iN+ofs|]] of the original
+     array [a].
+
+     [Genarray.sub_right] applies only to Bigarrays in Fortran layout.
+     @raise Invalid_argument if [ofs] and [len] do not designate
+     a valid sub-array of [a], that is, if [ofs < 1], or [len < 0],
+     or [ofs + len > Genarray.nth_dim a (Genarray.num_dims a - 1)]. *)
+
+  external slice_left:
+    ('a, 'b, c_layout) t -> int array -> ('a, 'b, c_layout) t
+    = "caml_ba_slice"
+  (** Extract a sub-array of lower dimension from the given Bigarray
+     by fixing one or several of the first (left-most) coordinates.
+     [Genarray.slice_left a [|i1; ... ; iM|]] returns the 'slice'
+     of [a] obtained by setting the first [M] coordinates to
+     [i1], ..., [iM].  If [a] has [N] dimensions, the slice has
+     dimension [N - M], and the element at coordinates
+     [[|j1; ...; j(N-M)|]] in the slice is identical to the element
+     at coordinates [[|i1; ...; iM; j1; ...; j(N-M)|]] in the original
+     array [a].  No copying of elements is involved: the slice and
+     the original array share the same storage space.
+
+     [Genarray.slice_left] applies only to Bigarrays in C layout.
+     @raise Invalid_argument if [M >= N], or if [[|i1; ... ; iM|]]
+     is outside the bounds of [a]. *)
+
+  external slice_right:
+    ('a, 'b, fortran_layout) t -> int array -> ('a, 'b, fortran_layout) t
+    = "caml_ba_slice"
+  (** Extract a sub-array of lower dimension from the given Bigarray
+     by fixing one or several of the last (right-most) coordinates.
+     [Genarray.slice_right a [|i1; ... ; iM|]] returns the 'slice'
+     of [a] obtained by setting the last [M] coordinates to
+     [i1], ..., [iM].  If [a] has [N] dimensions, the slice has
+     dimension [N - M], and the element at coordinates
+     [[|j1; ...; j(N-M)|]] in the slice is identical to the element
+     at coordinates [[|j1; ...; j(N-M); i1; ...; iM|]] in the original
+     array [a].  No copying of elements is involved: the slice and
+     the original array share the same storage space.
+
+     [Genarray.slice_right] applies only to Bigarrays in Fortran layout.
+     @raise Invalid_argument if [M >= N], or if [[|i1; ... ; iM|]]
+     is outside the bounds of [a]. *)
+
+  external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit
+      = "caml_ba_blit"
+  (** Copy all elements of a Bigarray in another Bigarray.
+     [Genarray.blit src dst] copies all elements of [src] into
+     [dst].  Both arrays [src] and [dst] must have the same number of
+     dimensions and equal dimensions.  Copying a sub-array of [src]
+     to a sub-array of [dst] can be achieved by applying [Genarray.blit]
+     to sub-array or slices of [src] and [dst]. *)
+
+  external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
+  (** Set all elements of a Bigarray to a given value.
+     [Genarray.fill a v] stores the value [v] in all elements of
+     the Bigarray [a].  Setting only some elements of [a] to [v]
+     can be achieved by applying [Genarray.fill] to a sub-array
+     or a slice of [a]. *)
+  end
+
+(** {1 Zero-dimensional arrays} *)
+
+(** Zero-dimensional arrays. The [Array0] structure provides operations
+   similar to those of {!Bigarray.Genarray}, but specialized to the case
+   of zero-dimensional arrays that only contain a single scalar value.
+   Statically knowing the number of dimensions of the array allows
+   faster operations, and more precise static type-checking.
+   @since 4.05.0 *)
+module Array0 : sig
+  type ('a, 'b, 'c) t
+  (** The type of zero-dimensional Bigarrays whose elements have
+     OCaml type ['a], representation kind ['b], and memory layout ['c]. *)
+
+  val create: ('a, 'b) kind -> 'c layout -> ('a, 'b, 'c) t
+  (** [Array0.create kind layout] returns a new Bigarray of zero dimension.
+     [kind] and [layout] determine the array element kind and the array
+     layout as described for {!Genarray.create}. *)
+
+  external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
+  (** Return the kind of the given Bigarray. *)
+
+  external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
+  (** Return the layout of the given Bigarray. *)
+
+  val change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
+  (** [Array0.change_layout a layout] returns a Bigarray with the
+      specified [layout], sharing the data with [a]. No copying of elements
+      is involved: the new array and the original array share the same
+      storage space.
+
+      @since 4.06.0
+  *)
+
+  val size_in_bytes : ('a, 'b, 'c) t -> int
+  (** [size_in_bytes a] is [a]'s {!kind_size_in_bytes}. *)
+
+  val get: ('a, 'b, 'c) t -> 'a
+  (** [Array0.get a] returns the only element in [a]. *)
+
+  val set: ('a, 'b, 'c) t -> 'a -> unit
+  (** [Array0.set a x v] stores the value [v] in [a]. *)
+
+  external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
+  (** Copy the first Bigarray to the second Bigarray.
+     See {!Genarray.blit} for more details. *)
+
+  external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
+  (** Fill the given Bigarray with the given value.
+     See {!Genarray.fill} for more details. *)
+
+  val of_value: ('a, 'b) kind -> 'c layout -> 'a -> ('a, 'b, 'c) t
+  (** Build a zero-dimensional Bigarray initialized from the
+     given value.  *)
+
+end
+
+
+(** {1 One-dimensional arrays} *)
+
+(** One-dimensional arrays. The [Array1] structure provides operations
+   similar to those of
+   {!Bigarray.Genarray}, but specialized to the case of one-dimensional arrays.
+   (The {!Array2} and {!Array3} structures below provide operations
+   specialized for two- and three-dimensional arrays.)
+   Statically knowing the number of dimensions of the array allows
+   faster operations, and more precise static type-checking. *)
+module Array1 : sig
+  type ('a, 'b, 'c) t
+  (** The type of one-dimensional Bigarrays whose elements have
+     OCaml type ['a], representation kind ['b], and memory layout ['c]. *)
+
+  val create: ('a, 'b) kind -> 'c layout -> int -> ('a, 'b, 'c) t
+  (** [Array1.create kind layout dim] returns a new Bigarray of
+     one dimension, whose size is [dim].  [kind] and [layout]
+     determine the array element kind and the array layout
+     as described for {!Genarray.create}. *)
+
+  external dim: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
+  (** Return the size (dimension) of the given one-dimensional
+     Bigarray. *)
+
+  external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
+  (** Return the kind of the given Bigarray. *)
+
+  external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
+  (** Return the layout of the given Bigarray. *)
+
+  val change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
+  (** [Array1.change_layout a layout] returns a Bigarray with the
+      specified [layout], sharing the data with [a] (and hence having
+      the same dimension as [a]). No copying of elements is involved: the
+      new array and the original array share the same storage space.
+
+      @since 4.06.0
+  *)
+
+
+  val size_in_bytes : ('a, 'b, 'c) t -> int
+  (** [size_in_bytes a] is the number of elements in [a]
+    multiplied by [a]'s {!kind_size_in_bytes}.
+
+    @since 4.03.0 *)
+
+  external get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_ref_1"
+  (** [Array1.get a x], or alternatively [a.{x}],
+     returns the element of [a] at index [x].
+     [x] must be greater or equal than [0] and strictly less than
+     [Array1.dim a] if [a] has C layout.  If [a] has Fortran layout,
+     [x] must be greater or equal than [1] and less or equal than
+     [Array1.dim a].  Otherwise, [Invalid_argument] is raised. *)
+
+  external set: ('a, 'b, 'c) t -> int -> 'a -> unit = "%caml_ba_set_1"
+  (** [Array1.set a x v], also written [a.{x} <- v],
+     stores the value [v] at index [x] in [a].
+     [x] must be inside the bounds of [a] as described in
+     {!Bigarray.Array1.get};
+     otherwise, [Invalid_argument] is raised. *)
+
+  external sub: ('a, 'b, 'c) t -> int -> int -> ('a, 'b, 'c) t
+      = "caml_ba_sub"
+  (** Extract a sub-array of the given one-dimensional Bigarray.
+     See {!Genarray.sub_left} for more details. *)
+
+  val slice: ('a, 'b, 'c) t -> int -> ('a, 'b, 'c) Array0.t
+  (** Extract a scalar (zero-dimensional slice) of the given one-dimensional
+     Bigarray.  The integer parameter is the index of the scalar to
+     extract.  See {!Bigarray.Genarray.slice_left} and
+     {!Bigarray.Genarray.slice_right} for more details.
+     @since 4.05.0 *)
+
+  external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit
+      = "caml_ba_blit"
+  (** Copy the first Bigarray to the second Bigarray.
+     See {!Genarray.blit} for more details. *)
+
+  external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
+  (** Fill the given Bigarray with the given value.
+     See {!Genarray.fill} for more details. *)
+
+  val of_array: ('a, 'b) kind -> 'c layout -> 'a array -> ('a, 'b, 'c) t
+  (** Build a one-dimensional Bigarray initialized from the
+     given array.  *)
+
+  external unsafe_get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_unsafe_ref_1"
+  (** Like {!Bigarray.Array1.get}, but bounds checking is not always performed.
+      Use with caution and only when the program logic guarantees that
+      the access is within bounds. *)
+
+  external unsafe_set: ('a, 'b, 'c) t -> int -> 'a -> unit
+                     = "%caml_ba_unsafe_set_1"
+  (** Like {!Bigarray.Array1.set}, but bounds checking is not always performed.
+      Use with caution and only when the program logic guarantees that
+      the access is within bounds. *)
+
+end
+
+
+(** {1 Two-dimensional arrays} *)
+
+(** Two-dimensional arrays. The [Array2] structure provides operations
+   similar to those of {!Bigarray.Genarray}, but specialized to the
+   case of two-dimensional arrays. *)
+module Array2 :
+  sig
+  type ('a, 'b, 'c) t
+  (** The type of two-dimensional Bigarrays whose elements have
+     OCaml type ['a], representation kind ['b], and memory layout ['c]. *)
+
+  val create: ('a, 'b) kind ->  'c layout -> int -> int -> ('a, 'b, 'c) t
+  (** [Array2.create kind layout dim1 dim2] returns a new Bigarray of
+     two dimension, whose size is [dim1] in the first dimension
+     and [dim2] in the second dimension.  [kind] and [layout]
+     determine the array element kind and the array layout
+     as described for {!Bigarray.Genarray.create}. *)
+
+  external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
+  (** Return the first dimension of the given two-dimensional Bigarray. *)
+
+  external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
+  (** Return the second dimension of the given two-dimensional Bigarray. *)
+
+  external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
+  (** Return the kind of the given Bigarray. *)
+
+  external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
+  (** Return the layout of the given Bigarray. *)
+
+  val change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
+  (** [Array2.change_layout a layout] returns a Bigarray with the
+      specified [layout], sharing the data with [a] (and hence having
+      the same dimensions as [a]). No copying of elements is involved: the
+      new array and the original array share the same storage space.
+      The dimensions are reversed, such that [get v [| a; b |]] in
+      C layout becomes [get v [| b+1; a+1 |]] in Fortran layout.
+
+      @since 4.06.0
+  *)
+
+
+  val size_in_bytes : ('a, 'b, 'c) t -> int
+  (** [size_in_bytes a] is the number of elements in [a]
+    multiplied by [a]'s {!kind_size_in_bytes}.
+
+    @since 4.03.0 *)
+
+  external get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_ref_2"
+  (** [Array2.get a x y], also written [a.{x,y}],
+     returns the element of [a] at coordinates ([x], [y]).
+     [x] and [y] must be within the bounds
+     of [a], as described for {!Bigarray.Genarray.get};
+     otherwise, [Invalid_argument] is raised. *)
+
+  external set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit = "%caml_ba_set_2"
+  (** [Array2.set a x y v], or alternatively [a.{x,y} <- v],
+     stores the value [v] at coordinates ([x], [y]) in [a].
+     [x] and [y] must be within the bounds of [a],
+     as described for {!Bigarray.Genarray.set};
+     otherwise, [Invalid_argument] is raised. *)
+
+  external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
+    = "caml_ba_sub"
+  (** Extract a two-dimensional sub-array of the given two-dimensional
+     Bigarray by restricting the first dimension.
+     See {!Bigarray.Genarray.sub_left} for more details.
+     [Array2.sub_left] applies only to arrays with C layout. *)
+
+  external sub_right:
+    ('a, 'b, fortran_layout) t -> int -> int -> ('a, 'b, fortran_layout) t
+    = "caml_ba_sub"
+  (** Extract a two-dimensional sub-array of the given two-dimensional
+     Bigarray by restricting the second dimension.
+     See {!Bigarray.Genarray.sub_right} for more details.
+     [Array2.sub_right] applies only to arrays with Fortran layout. *)
+
+  val slice_left: ('a, 'b, c_layout) t -> int -> ('a, 'b, c_layout) Array1.t
+  (** Extract a row (one-dimensional slice) of the given two-dimensional
+     Bigarray.  The integer parameter is the index of the row to
+     extract.  See {!Bigarray.Genarray.slice_left} for more details.
+     [Array2.slice_left] applies only to arrays with C layout. *)
+
+  val slice_right:
+    ('a, 'b, fortran_layout) t -> int -> ('a, 'b, fortran_layout) Array1.t
+  (** Extract a column (one-dimensional slice) of the given
+     two-dimensional Bigarray.  The integer parameter is the
+     index of the column to extract.  See {!Bigarray.Genarray.slice_right}
+     for more details.  [Array2.slice_right] applies only to arrays
+     with Fortran layout. *)
+
+  external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit
+    = "caml_ba_blit"
+  (** Copy the first Bigarray to the second Bigarray.
+     See {!Bigarray.Genarray.blit} for more details. *)
+
+  external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
+  (** Fill the given Bigarray with the given value.
+     See {!Bigarray.Genarray.fill} for more details. *)
+
+  val of_array: ('a, 'b) kind -> 'c layout -> 'a array array -> ('a, 'b, 'c) t
+  (** Build a two-dimensional Bigarray initialized from the
+     given array of arrays.  *)
+
+  external unsafe_get: ('a, 'b, 'c) t -> int -> int -> 'a
+                     = "%caml_ba_unsafe_ref_2"
+  (** Like {!Bigarray.Array2.get}, but bounds checking is not always
+      performed. *)
+
+  external unsafe_set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit
+                     = "%caml_ba_unsafe_set_2"
+  (** Like {!Bigarray.Array2.set}, but bounds checking is not always
+      performed. *)
+
+end
+
+(** {1 Three-dimensional arrays} *)
+
+(** Three-dimensional arrays. The [Array3] structure provides operations
+   similar to those of {!Bigarray.Genarray}, but specialized to the case
+   of three-dimensional arrays. *)
+module Array3 :
+  sig
+  type ('a, 'b, 'c) t
+  (** The type of three-dimensional Bigarrays whose elements have
+     OCaml type ['a], representation kind ['b], and memory layout ['c]. *)
+
+  val create: ('a, 'b) kind -> 'c layout -> int -> int -> int -> ('a, 'b, 'c) t
+  (** [Array3.create kind layout dim1 dim2 dim3] returns a new Bigarray of
+     three dimension, whose size is [dim1] in the first dimension,
+     [dim2] in the second dimension, and [dim3] in the third.
+     [kind] and [layout] determine the array element kind and
+     the array layout as described for {!Bigarray.Genarray.create}. *)
+
+  external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
+  (** Return the first dimension of the given three-dimensional Bigarray. *)
+
+  external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
+  (** Return the second dimension of the given three-dimensional Bigarray. *)
+
+  external dim3: ('a, 'b, 'c) t -> int = "%caml_ba_dim_3"
+  (** Return the third dimension of the given three-dimensional Bigarray. *)
+
+  external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
+  (** Return the kind of the given Bigarray. *)
+
+  external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
+  (** Return the layout of the given Bigarray. *)
+
+
+  val change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
+  (** [Array3.change_layout a layout] returns a Bigarray with the
+      specified [layout], sharing the data with [a] (and hence having
+      the same dimensions as [a]). No copying of elements is involved: the
+      new array and the original array share the same storage space.
+      The dimensions are reversed, such that [get v [| a; b; c |]] in
+      C layout becomes [get v [| c+1; b+1; a+1 |]] in Fortran layout.
+
+      @since 4.06.0
+  *)
+
+  val size_in_bytes : ('a, 'b, 'c) t -> int
+  (** [size_in_bytes a] is the number of elements in [a]
+    multiplied by [a]'s {!kind_size_in_bytes}.
+
+    @since 4.03.0 *)
+
+  external get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_ref_3"
+  (** [Array3.get a x y z], also written [a.{x,y,z}],
+     returns the element of [a] at coordinates ([x], [y], [z]).
+     [x], [y] and [z] must be within the bounds of [a],
+     as described for {!Bigarray.Genarray.get};
+     otherwise, [Invalid_argument] is raised. *)
+
+  external set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit
+    = "%caml_ba_set_3"
+  (** [Array3.set a x y v], or alternatively [a.{x,y,z} <- v],
+     stores the value [v] at coordinates ([x], [y], [z]) in [a].
+     [x], [y] and [z] must be within the bounds of [a],
+     as described for {!Bigarray.Genarray.set};
+     otherwise, [Invalid_argument] is raised. *)
+
+  external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
+    = "caml_ba_sub"
+  (** Extract a three-dimensional sub-array of the given
+     three-dimensional Bigarray by restricting the first dimension.
+     See {!Bigarray.Genarray.sub_left} for more details.  [Array3.sub_left]
+     applies only to arrays with C layout. *)
+
+  external sub_right:
+    ('a, 'b, fortran_layout) t -> int -> int -> ('a, 'b, fortran_layout) t
+    = "caml_ba_sub"
+  (** Extract a three-dimensional sub-array of the given
+     three-dimensional Bigarray by restricting the second dimension.
+     See {!Bigarray.Genarray.sub_right} for more details.  [Array3.sub_right]
+     applies only to arrays with Fortran layout. *)
+
+  val slice_left_1:
+    ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) Array1.t
+  (** Extract a one-dimensional slice of the given three-dimensional
+     Bigarray by fixing the first two coordinates.
+     The integer parameters are the coordinates of the slice to
+     extract.  See {!Bigarray.Genarray.slice_left} for more details.
+     [Array3.slice_left_1] applies only to arrays with C layout. *)
+
+  val slice_right_1:
+    ('a, 'b, fortran_layout) t ->
+    int -> int -> ('a, 'b, fortran_layout) Array1.t
+  (** Extract a one-dimensional slice of the given three-dimensional
+     Bigarray by fixing the last two coordinates.
+     The integer parameters are the coordinates of the slice to
+     extract.  See {!Bigarray.Genarray.slice_right} for more details.
+     [Array3.slice_right_1] applies only to arrays with Fortran
+     layout. *)
+
+  val slice_left_2: ('a, 'b, c_layout) t -> int -> ('a, 'b, c_layout) Array2.t
+  (** Extract a  two-dimensional slice of the given three-dimensional
+     Bigarray by fixing the first coordinate.
+     The integer parameter is the first coordinate of the slice to
+     extract.  See {!Bigarray.Genarray.slice_left} for more details.
+     [Array3.slice_left_2] applies only to arrays with C layout. *)
+
+  val slice_right_2:
+    ('a, 'b, fortran_layout) t -> int -> ('a, 'b, fortran_layout) Array2.t
+  (** Extract a two-dimensional slice of the given
+     three-dimensional Bigarray by fixing the last coordinate.
+     The integer parameter is the coordinate of the slice
+     to extract.  See {!Bigarray.Genarray.slice_right} for more details.
+     [Array3.slice_right_2] applies only to arrays with Fortran
+     layout. *)
+
+  external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit
+    = "caml_ba_blit"
+  (** Copy the first Bigarray to the second Bigarray.
+     See {!Bigarray.Genarray.blit} for more details. *)
+
+  external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
+  (** Fill the given Bigarray with the given value.
+     See {!Bigarray.Genarray.fill} for more details. *)
+
+  val of_array:
+    ('a, 'b) kind -> 'c layout -> 'a array array array -> ('a, 'b, 'c) t
+  (** Build a three-dimensional Bigarray initialized from the
+     given array of arrays of arrays.  *)
+
+  external unsafe_get: ('a, 'b, 'c) t -> int -> int -> int -> 'a
+                     = "%caml_ba_unsafe_ref_3"
+  (** Like {!Bigarray.Array3.get}, but bounds checking is not always
+      performed. *)
+
+  external unsafe_set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit
+                     = "%caml_ba_unsafe_set_3"
+  (** Like {!Bigarray.Array3.set}, but bounds checking is not always
+      performed. *)
+
+end
+
+(** {1 Coercions between generic Bigarrays and fixed-dimension Bigarrays} *)
+
+external genarray_of_array0 :
+  ('a, 'b, 'c) Array0.t -> ('a, 'b, 'c) Genarray.t = "%identity"
+(** Return the generic Bigarray corresponding to the given zero-dimensional
+   Bigarray. @since 4.05.0 *)
+
+external genarray_of_array1 :
+  ('a, 'b, 'c) Array1.t -> ('a, 'b, 'c) Genarray.t = "%identity"
+(** Return the generic Bigarray corresponding to the given one-dimensional
+   Bigarray. *)
+
+external genarray_of_array2 :
+  ('a, 'b, 'c) Array2.t -> ('a, 'b, 'c) Genarray.t = "%identity"
+(** Return the generic Bigarray corresponding to the given two-dimensional
+   Bigarray. *)
+
+external genarray_of_array3 :
+  ('a, 'b, 'c) Array3.t -> ('a, 'b, 'c) Genarray.t = "%identity"
+(** Return the generic Bigarray corresponding to the given three-dimensional
+   Bigarray. *)
+
+val array0_of_genarray : ('a, 'b, 'c) Genarray.t -> ('a, 'b, 'c) Array0.t
+(** Return the zero-dimensional Bigarray corresponding to the given
+   generic Bigarray.
+   @raise Invalid_argument if the generic Bigarray
+   does not have exactly zero dimension.
+   @since 4.05.0 *)
+
+val array1_of_genarray : ('a, 'b, 'c) Genarray.t -> ('a, 'b, 'c) Array1.t
+(** Return the one-dimensional Bigarray corresponding to the given
+   generic Bigarray.
+   @raise Invalid_argument if the generic Bigarray
+   does not have exactly one dimension. *)
+
+val array2_of_genarray : ('a, 'b, 'c) Genarray.t -> ('a, 'b, 'c) Array2.t
+(** Return the two-dimensional Bigarray corresponding to the given
+   generic Bigarray.
+   @raise Invalid_argument if the generic Bigarray
+   does not have exactly two dimensions. *)
+
+val array3_of_genarray : ('a, 'b, 'c) Genarray.t -> ('a, 'b, 'c) Array3.t
+(** Return the three-dimensional Bigarray corresponding to the given
+   generic Bigarray.
+   @raise Invalid_argument if the generic Bigarray
+   does not have exactly three dimensions. *)
+
+
+(** {1 Re-shaping Bigarrays} *)
+
+val reshape : ('a, 'b, 'c) Genarray.t -> int array -> ('a, 'b, 'c) Genarray.t
+(** [reshape b [|d1;...;dN|]] converts the Bigarray [b] to a
+   [N]-dimensional array of dimensions [d1]...[dN].  The returned
+   array and the original array [b] share their data
+   and have the same layout.  For instance, assuming that [b]
+   is a one-dimensional array of dimension 12, [reshape b [|3;4|]]
+   returns a two-dimensional array [b'] of dimensions 3 and 4.
+   If [b] has C layout, the element [(x,y)] of [b'] corresponds
+   to the element [x * 3 + y] of [b].  If [b] has Fortran layout,
+   the element [(x,y)] of [b'] corresponds to the element
+   [x + (y - 1) * 4] of [b].
+   The returned Bigarray must have exactly the same number of
+   elements as the original Bigarray [b].  That is, the product
+   of the dimensions of [b] must be equal to [i1 * ... * iN].
+   Otherwise, [Invalid_argument] is raised. *)
+
+val reshape_0 : ('a, 'b, 'c) Genarray.t -> ('a, 'b, 'c) Array0.t
+(** Specialized version of {!Bigarray.reshape} for reshaping to
+   zero-dimensional arrays.
+   @since 4.05.0 *)
+
+val reshape_1 : ('a, 'b, 'c) Genarray.t -> int -> ('a, 'b, 'c) Array1.t
+(** Specialized version of {!Bigarray.reshape} for reshaping to
+   one-dimensional arrays. *)
+
+val reshape_2 : ('a, 'b, 'c) Genarray.t -> int -> int -> ('a, 'b, 'c) Array2.t
+(** Specialized version of {!Bigarray.reshape} for reshaping to
+   two-dimensional arrays. *)
+
+val reshape_3 :
+  ('a, 'b, 'c) Genarray.t -> int -> int -> int -> ('a, 'b, 'c) Array3.t
+(** Specialized version of {!Bigarray.reshape} for reshaping to
+   three-dimensional arrays. *)
diff --git a/stdlib/bool.ml b/stdlib/bool.ml
new file mode 100644
index 00000000..5086f06b
--- /dev/null
+++ b/stdlib/bool.ml
@@ -0,0 +1,33 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         The OCaml programmers                          *)
+(*                                                                        *)
+(*   Copyright 2018 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 = bool = false | true
+
+external not : bool -> bool = "%boolnot"
+external ( && ) : bool -> bool -> bool = "%sequand"
+external ( || ) : bool -> bool -> bool = "%sequor"
+let equal : bool -> bool -> bool = ( = )
+let compare : bool -> bool -> int = Stdlib.compare
+external to_int : bool -> int = "%identity"
+let to_float = function false -> 0. | true -> 1.
+
+(*
+let of_string = function
+| "false" -> Some false
+| "true" -> Some true
+| _ -> None
+*)
+
+let to_string = function false -> "false" | true -> "true"
diff --git a/stdlib/bool.mli b/stdlib/bool.mli
new file mode 100644
index 00000000..f45caacb
--- /dev/null
+++ b/stdlib/bool.mli
@@ -0,0 +1,68 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         The OCaml programmers                          *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Boolean values.
+
+    @since 4.08 *)
+
+(** {1:bools Booleans} *)
+
+type t = bool = false | true (**)
+(** The type of booleans (truth values).
+
+    The constructors [false] and [true] are included here so that they have
+    paths, but they are not intended to be used in user-defined data types.
+ *)
+
+val not : bool -> bool
+(** [not b] is the boolean negation of [b]. *)
+
+external ( && ) : bool -> bool -> bool = "%sequand"
+(** [e0 && e1] is the lazy boolean conjunction of expressions [e0] and [e1].
+    If [e0] evaluates to [false], [e1] is not evaluated. Right-associative
+    operator at precedence level 3/11. *)
+
+external ( || ) : bool -> bool -> bool = "%sequor"
+(** [e0 || e1] is the lazy boolean disjunction of expressions [e0] and [e1].
+    If [e0] evaluates to [true], [e1] is not evaluated. Right-associative
+    operator at precedence level 2/11. *)
+
+(** {1:preds Predicates and comparisons} *)
+
+val equal : bool -> bool -> bool
+(** [equal b0 b1] is [true] iff [b0] and [b1] are both either [true]
+    or [false]. *)
+
+val compare : bool -> bool -> int
+(** [compare b0 b1] is a total order on boolean values. [false] is smaller
+    than [true]. *)
+
+(** {1:convert Converting} *)
+
+val to_int : bool -> int
+(** [to_int b] is [0] if [b] is [false] and [1] if [b] is [true]. *)
+
+val to_float : bool -> float
+(** [to_float b] is [0.] if [b] is [false] and [1.] if [b] is [true]. *)
+
+(*
+val of_string : string -> bool option
+(** [of_string s] is [Some true] if [s] is ["true"], [Some false] if [s]
+    is ["false"] and [None] otherwise. *)
+*)
+
+val to_string : bool -> string
+(** [to_string b] is ["true"] if [b] is [true] and ["false"] if [b] is
+    [false]. *)
diff --git a/stdlib/buffer.ml b/stdlib/buffer.ml
new file mode 100644
index 00000000..db218264
--- /dev/null
+++ b/stdlib/buffer.ml
@@ -0,0 +1,438 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*    Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt    *)
+(*                                                                        *)
+(*   Copyright 1999 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Extensible buffers *)
+
+type t =
+ {mutable buffer : bytes;
+  mutable position : int;
+  mutable length : int;
+  initial_buffer : bytes}
+(* Invariants: all parts of the code preserve the invariants that:
+   - [0 <= b.position <= b.length]
+   - [b.length = Bytes.length b.buffer]
+
+   Note in particular that [b.position = b.length] is legal,
+   it means that the buffer is full and will have to be extended
+   before any further addition. *)
+
+let create n =
+ let n = if n < 1 then 1 else n in
+ let n = if n > Sys.max_string_length then Sys.max_string_length else n in
+ let s = Bytes.create n in
+ {buffer = s; position = 0; length = n; initial_buffer = s}
+
+let contents b = Bytes.sub_string b.buffer 0 b.position
+let to_bytes b = Bytes.sub b.buffer 0 b.position
+
+let sub b ofs len =
+  if ofs < 0 || len < 0 || ofs > b.position - len
+  then invalid_arg "Buffer.sub"
+  else Bytes.sub_string b.buffer ofs len
+
+
+let blit src srcoff dst dstoff len =
+  if len < 0 || srcoff < 0 || srcoff > src.position - len
+             || dstoff < 0 || dstoff > (Bytes.length dst) - len
+  then invalid_arg "Buffer.blit"
+  else
+    Bytes.unsafe_blit src.buffer srcoff dst dstoff len
+
+
+let nth b ofs =
+  if ofs < 0 || ofs >= b.position then
+   invalid_arg "Buffer.nth"
+  else Bytes.unsafe_get b.buffer ofs
+
+
+let length b = b.position
+
+let clear b = b.position <- 0
+
+let reset b =
+  b.position <- 0;
+  b.buffer <- b.initial_buffer;
+  b.length <- Bytes.length b.buffer
+
+(* [resize b more] ensures that [b.position + more <= b.length] holds
+   by dynamically extending [b.buffer] if necessary -- and thus
+   increasing [b.length].
+
+   In particular, after [resize b more] is called, a direct access of
+   size [more] at [b.position] will always be in-bounds, so that
+   (unsafe_{get,set}) may be used for performance.
+*)
+let resize b more =
+  let old_pos = b.position in
+  let old_len = b.length in
+  let new_len = ref old_len in
+  while old_pos + more > !new_len do new_len := 2 * !new_len done;
+  if !new_len > Sys.max_string_length then begin
+    if old_pos + more <= Sys.max_string_length
+    then new_len := Sys.max_string_length
+    else failwith "Buffer.add: cannot grow buffer"
+  end;
+  let new_buffer = Bytes.create !new_len in
+  (* PR#6148: let's keep using [blit] rather than [unsafe_blit] in
+     this tricky function that is slow anyway. *)
+  Bytes.blit b.buffer 0 new_buffer 0 b.position;
+  b.buffer <- new_buffer;
+  b.length <- !new_len;
+  assert (b.position + more <= b.length);
+  assert (old_pos + more <= b.length);
+  ()
+  (* Note: there are various situations (preemptive threads, signals and
+     gc finalizers) where OCaml code may be run asynchronously; in
+     particular, there may be a race with another user of [b], changing
+     its mutable fields in the middle of the [resize] call. The Buffer
+     module does not provide any correctness guarantee if that happens,
+     but we must still ensure that the datastructure invariants hold for
+     memory-safety -- as we plan to use [unsafe_{get,set}].
+
+     There are two potential allocation points in this function,
+     [ref] and [Bytes.create], but all reads and writes to the fields
+     of [b] happen before both of them or after both of them.
+
+     We therefore assume that [b.position] may change at these allocations,
+     and check that the [b.position + more <= b.length] postcondition
+     holds for both values of [b.position], before or after the function
+     is called. More precisely, the following invariants must hold if the
+     function returns correctly, in addition to the usual buffer invariants:
+     - [old(b.position) + more <= new(b.length)]
+     - [new(b.position) + more <= new(b.length)]
+     - [old(b.length) <= new(b.length)]
+
+     Note: [b.position + more <= old(b.length)] does *not*
+     hold in general, as it is precisely the case where you need
+     to call [resize] to increase [b.length].
+
+     Note: [assert] above does not mean that we know the conditions
+     always hold, but that the function may return correctly
+     only if they hold.
+
+     Note: the other functions in this module does not need
+     to be checked with this level of scrutiny, given that they
+     read/write the buffer immediately after checking that
+     [b.position + more <= b.length] hold or calling [resize].
+  *)
+
+let add_char b c =
+  let pos = b.position in
+  if pos >= b.length then resize b 1;
+  Bytes.unsafe_set b.buffer pos c;
+  b.position <- pos + 1
+
+ let add_utf_8_uchar b u = match Uchar.to_int u with
+ | u when u < 0 -> assert false
+ | u when u <= 0x007F ->
+     add_char b (Char.unsafe_chr u)
+ | u when u <= 0x07FF ->
+     let pos = b.position in
+     if pos + 2 > b.length then resize b 2;
+     Bytes.unsafe_set b.buffer (pos    )
+       (Char.unsafe_chr (0xC0 lor (u lsr 6)));
+     Bytes.unsafe_set b.buffer (pos + 1)
+       (Char.unsafe_chr (0x80 lor (u land 0x3F)));
+     b.position <- pos + 2
+ | u when u <= 0xFFFF ->
+     let pos = b.position in
+     if pos + 3 > b.length then resize b 3;
+     Bytes.unsafe_set b.buffer (pos    )
+       (Char.unsafe_chr (0xE0 lor (u lsr 12)));
+     Bytes.unsafe_set b.buffer (pos + 1)
+       (Char.unsafe_chr (0x80 lor ((u lsr 6) land 0x3F)));
+     Bytes.unsafe_set b.buffer (pos + 2)
+       (Char.unsafe_chr (0x80 lor (u land 0x3F)));
+     b.position <- pos + 3
+ | u when u <= 0x10FFFF ->
+     let pos = b.position in
+     if pos + 4 > b.length then resize b 4;
+     Bytes.unsafe_set b.buffer (pos    )
+       (Char.unsafe_chr (0xF0 lor (u lsr 18)));
+     Bytes.unsafe_set b.buffer (pos + 1)
+       (Char.unsafe_chr (0x80 lor ((u lsr 12) land 0x3F)));
+     Bytes.unsafe_set b.buffer (pos + 2)
+       (Char.unsafe_chr (0x80 lor ((u lsr 6) land 0x3F)));
+     Bytes.unsafe_set b.buffer (pos + 3)
+       (Char.unsafe_chr (0x80 lor (u land 0x3F)));
+     b.position <- pos + 4
+ | _ -> assert false
+
+ let add_utf_16be_uchar b u = match Uchar.to_int u with
+ | u when u < 0 -> assert false
+ | u when u <= 0xFFFF ->
+     let pos = b.position in
+     if pos + 2 > b.length then resize b 2;
+     Bytes.unsafe_set b.buffer (pos    ) (Char.unsafe_chr (u lsr 8));
+     Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (u land 0xFF));
+     b.position <- pos + 2
+ | u when u <= 0x10FFFF ->
+     let u' = u - 0x10000 in
+     let hi = 0xD800 lor (u' lsr 10) in
+     let lo = 0xDC00 lor (u' land 0x3FF) in
+     let pos = b.position in
+     if pos + 4 > b.length then resize b 4;
+     Bytes.unsafe_set b.buffer (pos    ) (Char.unsafe_chr (hi lsr 8));
+     Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (hi land 0xFF));
+     Bytes.unsafe_set b.buffer (pos + 2) (Char.unsafe_chr (lo lsr 8));
+     Bytes.unsafe_set b.buffer (pos + 3) (Char.unsafe_chr (lo land 0xFF));
+     b.position <- pos + 4
+ | _ -> assert false
+
+ let add_utf_16le_uchar b u = match Uchar.to_int u with
+ | u when u < 0 -> assert false
+ | u when u <= 0xFFFF ->
+     let pos = b.position in
+     if pos + 2 > b.length then resize b 2;
+     Bytes.unsafe_set b.buffer (pos    ) (Char.unsafe_chr (u land 0xFF));
+     Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (u lsr 8));
+     b.position <- pos + 2
+ | u when u <= 0x10FFFF ->
+     let u' = u - 0x10000 in
+     let hi = 0xD800 lor (u' lsr 10) in
+     let lo = 0xDC00 lor (u' land 0x3FF) in
+     let pos = b.position in
+     if pos + 4 > b.length then resize b 4;
+     Bytes.unsafe_set b.buffer (pos    ) (Char.unsafe_chr (hi land 0xFF));
+     Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (hi lsr 8));
+     Bytes.unsafe_set b.buffer (pos + 2) (Char.unsafe_chr (lo land 0xFF));
+     Bytes.unsafe_set b.buffer (pos + 3) (Char.unsafe_chr (lo lsr 8));
+     b.position <- pos + 4
+ | _ -> assert false
+
+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";
+  let new_position = b.position + len in
+  if new_position > b.length then resize b len;
+  Bytes.unsafe_blit_string s offset b.buffer b.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 new_position = b.position + len in
+  if new_position > b.length then resize b len;
+  Bytes.unsafe_blit_string s 0 b.buffer b.position len;
+  b.position <- new_position
+
+let add_bytes b s = add_string b (Bytes.unsafe_to_string s)
+
+let add_buffer b bs =
+  add_subbytes b bs.buffer 0 bs.position
+
+(* this (private) function could move into the standard library *)
+let really_input_up_to ic buf ofs len =
+  let rec loop ic buf ~already_read ~ofs ~to_read =
+    if to_read = 0 then already_read
+    else begin
+      let r = input ic buf ofs to_read in
+      if r = 0 then already_read
+      else begin
+        let already_read = already_read + r in
+        let ofs = ofs + r in
+        let to_read = to_read - r in
+        loop ic buf ~already_read ~ofs ~to_read
+      end
+    end
+  in loop ic buf ~already_read:0 ~ofs ~to_read:len
+
+
+let unsafe_add_channel_up_to b ic len =
+  if b.position + len > b.length then resize b len;
+  let n = really_input_up_to ic b.buffer b.position len in
+  (* The assertion below may fail in weird scenario where
+     threaded/finalizer code, run asynchronously during the
+     [really_input_up_to] call, races on the buffer; we don't ensure
+     correctness in this case, but need to preserve the invariants for
+     memory-safety (see discussion of [resize]). *)
+  assert (b.position + n <= b.length);
+  b.position <- b.position + n;
+  n
+
+let add_channel b ic len =
+  if len < 0 || len > Sys.max_string_length then   (* PR#5004 *)
+    invalid_arg "Buffer.add_channel";
+  let n = unsafe_add_channel_up_to b ic len in
+  (* It is intentional that a consumer catching End_of_file
+     will see the data written (see #6719, #7136). *)
+  if n < len then raise End_of_file;
+  ()
+
+let output_buffer oc b =
+  output oc b.buffer 0 b.position
+
+let closing = function
+  | '(' -> ')'
+  | '{' -> '}'
+  | _ -> assert false
+
+(* opening and closing: open and close characters, typically ( and )
+   k: balance of opening and closing chars
+   s: the string where we are searching
+   start: the index where we start the search. *)
+let advance_to_closing opening closing k s start =
+  let rec advance k i lim =
+    if i >= lim then raise Not_found else
+    if s.[i] = opening then advance (k + 1) (i + 1) lim else
+    if s.[i] = closing then
+      if k = 0 then i else advance (k - 1) (i + 1) lim
+    else advance k (i + 1) lim in
+  advance k start (String.length s)
+
+let advance_to_non_alpha s start =
+  let rec advance i lim =
+    if i >= lim then lim else
+    match s.[i] with
+    | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> advance (i + 1) lim
+    | _ -> i in
+  advance start (String.length s)
+
+(* We are just at the beginning of an ident in s, starting at start. *)
+let find_ident s start lim =
+  if start >= lim then raise Not_found else
+  match s.[start] with
+  (* Parenthesized ident ? *)
+  | '(' | '{' as c ->
+     let new_start = start + 1 in
+     let stop = advance_to_closing c (closing c) 0 s new_start in
+     String.sub s new_start (stop - start - 1), stop + 1
+  (* Regular ident *)
+  | _ ->
+     let stop = advance_to_non_alpha s (start + 1) in
+     String.sub s start (stop - start), stop
+
+(* Substitute $ident, $(ident), or ${ident} in s,
+    according to the function mapping f. *)
+let add_substitute b f s =
+  let lim = String.length s in
+  let rec subst previous i =
+    if i < lim then begin
+      match s.[i] with
+      | '$' as current when previous = '\\' ->
+         add_char b current;
+         subst ' ' (i + 1)
+      | '$' ->
+         let j = i + 1 in
+         let ident, next_i = find_ident s j lim in
+         add_string b (f ident);
+         subst ' ' next_i
+      | current when previous == '\\' ->
+         add_char b '\\';
+         add_char b current;
+         subst ' ' (i + 1)
+      | '\\' as current ->
+         subst current (i + 1)
+      | current ->
+         add_char b current;
+         subst current (i + 1)
+    end else
+    if previous = '\\' then add_char b previous in
+  subst ' ' 0
+
+let truncate b len =
+    if len < 0 || len > length b then
+      invalid_arg "Buffer.truncate"
+    else
+      b.position <- len
+
+(** {1 Iterators} *)
+
+let to_seq b =
+  let rec aux i () =
+    (* Note that b.position is not a constant and cannot be lifted out of aux *)
+    if i >= b.position then Seq.Nil
+    else
+      let x = Bytes.unsafe_get b.buffer i in
+      Seq.Cons (x, aux (i+1))
+  in
+  aux 0
+
+let to_seqi b =
+  let rec aux i () =
+    (* Note that b.position is not a constant and cannot be lifted out of aux *)
+    if i >= b.position then Seq.Nil
+    else
+      let x = Bytes.unsafe_get b.buffer i in
+      Seq.Cons ((i,x), aux (i+1))
+  in
+  aux 0
+
+let add_seq b seq = Seq.iter (add_char b) seq
+
+let of_seq i =
+  let b = create 32 in
+  add_seq b i;
+  b
+
+(** {6 Binary encoding of integers} *)
+
+external unsafe_set_int8 : bytes -> int -> int -> unit = "%bytes_unsafe_set"
+external unsafe_set_int16 : bytes -> int -> int -> unit = "%caml_bytes_set16u"
+external unsafe_set_int32 : bytes -> int -> int32 -> unit = "%caml_bytes_set32u"
+external unsafe_set_int64 : bytes -> int -> int64 -> unit = "%caml_bytes_set64u"
+external swap16 : int -> int = "%bswap16"
+external swap32 : int32 -> int32 = "%bswap_int32"
+external swap64 : int64 -> int64 = "%bswap_int64"
+
+
+let add_int8 b x =
+  let new_position = b.position + 1 in
+  if new_position > b.length then resize b 1;
+  unsafe_set_int8 b.buffer b.position x;
+  b.position <- new_position
+
+let add_int16_ne b x =
+  let new_position = b.position + 2 in
+  if new_position > b.length then resize b 2;
+  unsafe_set_int16 b.buffer b.position x;
+  b.position <- new_position
+
+let add_int32_ne b x =
+  let new_position = b.position + 4 in
+  if new_position > b.length then resize b 4;
+  unsafe_set_int32 b.buffer b.position x;
+  b.position <- new_position
+
+let add_int64_ne b x =
+  let new_position = b.position + 8 in
+  if new_position > b.length then resize b 8;
+  unsafe_set_int64 b.buffer b.position x;
+  b.position <- new_position
+
+let add_int16_le b x =
+  add_int16_ne b (if Sys.big_endian then swap16 x else x)
+
+let add_int16_be b x =
+  add_int16_ne b (if Sys.big_endian then x else swap16 x)
+
+let add_int32_le b x =
+  add_int32_ne b (if Sys.big_endian then swap32 x else x)
+
+let add_int32_be b x =
+  add_int32_ne b (if Sys.big_endian then x else swap32 x)
+
+let add_int64_le b x =
+  add_int64_ne b (if Sys.big_endian then swap64 x else x)
+
+let add_int64_be b x =
+  add_int64_ne b (if Sys.big_endian then x else swap64 x)
+
+let add_uint8 = add_int8
+let add_uint16_ne = add_int16_ne
+let add_uint16_le = add_int16_le
+let add_uint16_be = add_int16_be
diff --git a/stdlib/buffer.mli b/stdlib/buffer.mli
new file mode 100644
index 00000000..c316a43e
--- /dev/null
+++ b/stdlib/buffer.mli
@@ -0,0 +1,282 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt     *)
+(*                                                                        *)
+(*   Copyright 1999 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Extensible buffers.
+
+   This module implements buffers that automatically expand
+   as necessary.  It provides accumulative concatenation of strings
+   in quasi-linear time (instead of quadratic time when strings are
+   concatenated pairwise).
+*)
+
+type t
+(** The abstract type of buffers. *)
+
+val create : int -> t
+(** [create n] returns a fresh buffer, initially empty.
+   The [n] parameter is the initial size of the internal byte sequence
+   that holds the buffer contents. That byte sequence is automatically
+   reallocated when more than [n] characters are stored in the buffer,
+   but shrinks back to [n] characters when [reset] is called.
+   For best performance, [n] should be of the same order of magnitude
+   as the number of characters that are expected to be stored in
+   the buffer (for instance, 80 for a buffer that holds one output
+   line).  Nothing bad will happen if the buffer grows beyond that
+   limit, however. In doubt, take [n = 16] for instance.
+   If [n] is not between 1 and {!Sys.max_string_length}, it will
+   be clipped to that interval. *)
+
+val contents : t -> string
+(** Return a copy of the current contents of the buffer.
+    The buffer itself is unchanged. *)
+
+val to_bytes : t -> bytes
+(** Return a copy of the current contents of the buffer.
+    The buffer itself is unchanged.
+    @since 4.02 *)
+
+val sub : t -> int -> int -> string
+(** [Buffer.sub b off len] returns a copy of [len] bytes from the
+    current contents of the buffer [b], starting at offset [off].
+    @raise Invalid_argument if [srcoff] and [len] do not designate a valid
+    range of [b]. *)
+
+val blit : t -> int -> bytes -> int -> int -> unit
+(** [Buffer.blit src srcoff dst dstoff len] copies [len] characters from
+   the current contents of the buffer [src], starting at offset [srcoff]
+   to [dst], starting at character [dstoff].
+   @raise Invalid_argument if [srcoff] and [len] do not designate a valid
+   range of [src], or if [dstoff] and [len] do not designate a valid
+   range of [dst].
+   @since 3.11.2
+*)
+
+val nth : t -> int -> char
+(** Get the n-th character of the buffer.
+    @raise Invalid_argument if
+    index out of bounds *)
+
+val length : t -> int
+(** Return the number of characters currently contained in the buffer. *)
+
+val clear : t -> unit
+(** Empty the buffer. *)
+
+val reset : t -> unit
+(** Empty the buffer and deallocate the internal byte sequence holding the
+   buffer contents, replacing it with the initial internal byte sequence
+   of length [n] that was allocated by {!Buffer.create} [n].
+   For long-lived buffers that may have grown a lot, [reset] allows
+   faster reclamation of the space used by the buffer. *)
+
+val add_char : t -> char -> unit
+(** [add_char b c] appends the character [c] at the end of buffer [b]. *)
+
+val add_utf_8_uchar : t -> Uchar.t -> unit
+(** [add_utf_8_uchar b u] appends the {{:https://tools.ietf.org/html/rfc3629}
+    UTF-8} encoding of [u] at the end of buffer [b].
+
+    @since 4.06.0 *)
+
+val add_utf_16le_uchar : t -> Uchar.t -> unit
+(** [add_utf_16le_uchar b u] appends the
+    {{:https://tools.ietf.org/html/rfc2781}UTF-16LE} encoding of [u]
+    at the end of buffer [b].
+
+    @since 4.06.0 *)
+
+val add_utf_16be_uchar : t -> Uchar.t -> unit
+(** [add_utf_16be_uchar b u] appends the
+    {{:https://tools.ietf.org/html/rfc2781}UTF-16BE} encoding of [u]
+    at the end of buffer [b].
+
+    @since 4.06.0 *)
+
+val add_string : t -> string -> unit
+(** [add_string b s] appends the string [s] at the end of buffer [b]. *)
+
+val add_bytes : t -> bytes -> unit
+(** [add_bytes b s] appends the byte sequence [s] at the end of buffer [b].
+    @since 4.02 *)
+
+val add_substring : t -> string -> int -> int -> unit
+(** [add_substring b s ofs len] takes [len] characters from offset
+   [ofs] in string [s] and appends them at the end of buffer [b]. *)
+
+val add_subbytes : t -> bytes -> int -> int -> unit
+(** [add_subbytes b s ofs len] takes [len] characters from offset
+    [ofs] in byte sequence [s] and appends them at the end of buffer [b].
+    @since 4.02 *)
+
+val add_substitute : t -> (string -> string) -> string -> unit
+(** [add_substitute b f s] appends the string pattern [s] at the end
+   of buffer [b] with substitution.
+   The substitution process looks for variables into
+   the pattern and substitutes each variable name by its value, as
+   obtained by applying the mapping [f] to the variable name. Inside the
+   string pattern, a variable name immediately follows a non-escaped
+   [$] character and is one of the following:
+   - a non empty sequence of alphanumeric or [_] characters,
+   - an arbitrary sequence of characters enclosed by a pair of
+   matching parentheses or curly brackets.
+   An escaped [$] character is a [$] that immediately follows a backslash
+   character; it then stands for a plain [$].
+   @raise Not_found if the closing character of a parenthesized variable
+   cannot be found. *)
+
+val add_buffer : t -> t -> unit
+(** [add_buffer b1 b2] appends the current contents of buffer [b2]
+   at the end of buffer [b1].  [b2] is not modified. *)
+
+val add_channel : t -> in_channel -> int -> unit
+(** [add_channel b ic n] reads at most [n] characters from the
+   input channel [ic] and stores them at the end of buffer [b].
+   @raise End_of_file if the channel contains fewer than [n]
+   characters. In this case, the characters are still added to
+   the buffer, so as to avoid loss of data. *)
+
+val output_buffer : out_channel -> t -> unit
+(** [output_buffer oc b] writes the current contents of buffer [b]
+   on the output channel [oc]. *)
+
+val truncate : t -> int -> unit
+(** [truncate b len] truncates the length of [b] to [len]
+  Note: the internal byte sequence is not shortened.
+  @raise Invalid_argument if [len < 0] or [len > length b].
+  @since 4.05.0 *)
+
+(** {1 Iterators} *)
+
+val to_seq : t -> char Seq.t
+(** Iterate on the buffer, in increasing order.
+    Modification of the buffer during iteration is undefined behavior.
+    @since 4.07 *)
+
+val to_seqi : t -> (int * char) Seq.t
+(** Iterate on the buffer, in increasing order, yielding indices along chars.
+    Modification of the buffer during iteration is undefined behavior.
+    @since 4.07 *)
+
+val add_seq : t -> char Seq.t -> unit
+(** Add chars to the buffer
+    @since 4.07 *)
+
+val of_seq : char Seq.t -> t
+(** Create a buffer from the generator
+    @since 4.07 *)
+
+(** {1 Binary encoding of integers} *)
+
+(** The functions in this section append binary encodings of integers
+    to buffers.
+
+    Little-endian (resp. big-endian) encoding means that least
+    (resp. most) significant bytes are stored first.  Big-endian is
+    also known as network byte order.  Native-endian encoding is
+    either little-endian or big-endian depending on {!Sys.big_endian}.
+
+    32-bit and 64-bit integers are represented by the [int32] and
+    [int64] types, which can be interpreted either as signed or
+    unsigned numbers.
+
+    8-bit and 16-bit integers are represented by the [int] type,
+    which has more bits than the binary encoding.  Functions that
+    encode these values truncate their inputs to their least
+    significant bytes.
+*)
+
+val add_uint8 : t -> int -> unit
+(** [add_uint8 b i] appends a binary unsigned 8-bit integer [i] to
+    [b].
+    @since 4.08
+*)
+
+val add_int8 : t -> int -> unit
+(** [add_int8 b i] appends a binary signed 8-bit integer [i] to
+    [b].
+    @since 4.08
+*)
+
+val add_uint16_ne : t -> int -> unit
+(** [add_uint16_ne b i] appends a binary native-endian unsigned 16-bit
+    integer [i] to [b].
+    @since 4.08
+*)
+
+val add_uint16_be : t -> int -> unit
+(** [add_uint16_be b i] appends a binary big-endian unsigned 16-bit
+    integer [i] to [b].
+    @since 4.08
+*)
+
+val add_uint16_le : t -> int -> unit
+(** [add_uint16_le b i] appends a binary little-endian unsigned 16-bit
+    integer [i] to [b].
+    @since 4.08
+*)
+
+val add_int16_ne : t -> int -> unit
+(** [add_int16_ne b i] appends a binary native-endian signed 16-bit
+    integer [i] to [b].
+    @since 4.08
+*)
+
+val add_int16_be : t -> int -> unit
+(** [add_int16_be b i] appends a binary big-endian signed 16-bit
+    integer [i] to [b].
+    @since 4.08
+*)
+
+val add_int16_le : t -> int -> unit
+(** [add_int16_le b i] appends a binary little-endian signed 16-bit
+    integer [i] to [b].
+    @since 4.08
+*)
+
+val add_int32_ne : t -> int32 -> unit
+(** [add_int32_ne b i] appends a binary native-endian 32-bit integer
+    [i] to [b].
+    @since 4.08
+*)
+
+val add_int32_be : t -> int32 -> unit
+(** [add_int32_be b i] appends a binary big-endian 32-bit integer
+    [i] to [b].
+    @since 4.08
+*)
+
+val add_int32_le : t -> int32 -> unit
+(** [add_int32_le b i] appends a binary little-endian 32-bit integer
+    [i] to [b].
+    @since 4.08
+*)
+
+val add_int64_ne  : t -> int64 -> unit
+(** [add_int64_ne b i] appends a binary native-endian 64-bit integer
+    [i] to [b].
+    @since 4.08
+*)
+
+val add_int64_be : t -> int64 -> unit
+(** [add_int64_be b i] appends a binary big-endian 64-bit integer
+    [i] to [b].
+    @since 4.08
+*)
+
+val add_int64_le : t -> int64 -> unit
+(** [add_int64_ne b i] appends a binary little-endian 64-bit integer
+    [i] to [b].
+    @since 4.08
+*)
diff --git a/stdlib/bytes.ml b/stdlib/bytes.ml
new file mode 100644
index 00000000..d89297e7
--- /dev/null
+++ b/stdlib/bytes.ml
@@ -0,0 +1,449 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Byte sequence operations *)
+
+(* WARNING: Some functions in this file are duplicated in string.ml for
+   efficiency reasons. When you modify the one in this file you need to
+   modify its duplicate in string.ml.
+   These functions have a "duplicated" comment above their definition.
+*)
+
+external length : bytes -> int = "%bytes_length"
+external string_length : string -> int = "%string_length"
+external get : bytes -> int -> char = "%bytes_safe_get"
+external set : bytes -> int -> char -> unit = "%bytes_safe_set"
+external create : int -> bytes = "caml_create_bytes"
+external unsafe_get : bytes -> int -> char = "%bytes_unsafe_get"
+external unsafe_set : bytes -> int -> char -> unit = "%bytes_unsafe_set"
+external unsafe_fill : bytes -> int -> int -> char -> unit
+                     = "caml_fill_bytes" [@@noalloc]
+external unsafe_to_string : bytes -> string = "%bytes_to_string"
+external unsafe_of_string : string -> bytes = "%bytes_of_string"
+
+external unsafe_blit : bytes -> int -> bytes -> int -> int -> unit
+                     = "caml_blit_bytes" [@@noalloc]
+external unsafe_blit_string : string -> int -> bytes -> int -> int -> unit
+                     = "caml_blit_string" [@@noalloc]
+
+let make n c =
+  let s = create n in
+  unsafe_fill s 0 n c;
+  s
+
+let init n f =
+  let s = create n in
+  for i = 0 to n - 1 do
+    unsafe_set s i (f i)
+  done;
+  s
+
+let empty = create 0
+
+let copy s =
+  let len = length s in
+  let r = create len in
+  unsafe_blit s 0 r 0 len;
+  r
+
+let to_string b = unsafe_to_string (copy b)
+let of_string s = copy (unsafe_of_string s)
+
+let sub s ofs len =
+  if ofs < 0 || len < 0 || ofs > length s - len
+  then invalid_arg "String.sub / Bytes.sub"
+  else begin
+    let r = create len in
+    unsafe_blit s ofs r 0 len;
+    r
+  end
+
+let sub_string b ofs len = unsafe_to_string (sub b ofs len)
+
+(* addition with an overflow check *)
+let (++) a b =
+  let c = a + b in
+  match a < 0, b < 0, c < 0 with
+  | true , true , false
+  | false, false, true  -> invalid_arg "Bytes.extend" (* overflow *)
+  | _ -> c
+
+let extend s left right =
+  let len = length s ++ left ++ right in
+  let r = create len in
+  let (srcoff, dstoff) = if left < 0 then -left, 0 else 0, left in
+  let cpylen = min (length s - srcoff) (len - dstoff) in
+  if cpylen > 0 then unsafe_blit s srcoff r dstoff cpylen;
+  r
+
+let fill s ofs len c =
+  if ofs < 0 || len < 0 || ofs > length s - len
+  then invalid_arg "String.fill / Bytes.fill"
+  else unsafe_fill s ofs len c
+
+let blit s1 ofs1 s2 ofs2 len =
+  if len < 0 || ofs1 < 0 || ofs1 > length s1 - len
+             || ofs2 < 0 || ofs2 > length s2 - len
+  then invalid_arg "Bytes.blit"
+  else unsafe_blit s1 ofs1 s2 ofs2 len
+
+let blit_string s1 ofs1 s2 ofs2 len =
+  if len < 0 || ofs1 < 0 || ofs1 > string_length s1 - len
+             || ofs2 < 0 || ofs2 > length s2 - len
+  then invalid_arg "String.blit / Bytes.blit_string"
+  else unsafe_blit_string s1 ofs1 s2 ofs2 len
+
+(* duplicated in string.ml *)
+let iter f a =
+  for i = 0 to length a - 1 do f(unsafe_get a i) done
+
+(* duplicated in string.ml *)
+let iteri f a =
+  for i = 0 to length a - 1 do f i (unsafe_get a i) done
+
+let ensure_ge (x:int) y = if x >= y then x else invalid_arg "Bytes.concat"
+
+let rec sum_lengths acc seplen = function
+  | [] -> acc
+  | hd :: [] -> length hd + acc
+  | hd :: tl -> sum_lengths (ensure_ge (length hd + seplen + acc) acc) seplen tl
+
+let rec unsafe_blits dst pos sep seplen = function
+    [] -> dst
+  | hd :: [] ->
+    unsafe_blit hd 0 dst pos (length hd); dst
+  | hd :: tl ->
+    unsafe_blit hd 0 dst pos (length hd);
+    unsafe_blit sep 0 dst (pos + length hd) seplen;
+    unsafe_blits dst (pos + length hd + seplen) sep seplen tl
+
+let concat sep = function
+    [] -> empty
+  | l -> let seplen = length sep in
+          unsafe_blits
+            (create (sum_lengths 0 seplen l))
+            0 sep seplen l
+
+let cat s1 s2 =
+  let l1 = length s1 in
+  let l2 = length s2 in
+  let r = create (l1 + l2) in
+  unsafe_blit s1 0 r 0 l1;
+  unsafe_blit s2 0 r l1 l2;
+  r
+
+
+external char_code: char -> int = "%identity"
+external char_chr: int -> char = "%identity"
+
+let is_space = function
+  | ' ' | '\012' | '\n' | '\r' | '\t' -> true
+  | _ -> false
+
+let trim s =
+  let len = length s in
+  let i = ref 0 in
+  while !i < len && is_space (unsafe_get s !i) do
+    incr i
+  done;
+  let j = ref (len - 1) in
+  while !j >= !i && is_space (unsafe_get s !j) do
+    decr j
+  done;
+  if !j >= !i then
+    sub s !i (!j - !i + 1)
+  else
+    empty
+
+let escaped s =
+  let n = ref 0 in
+  for i = 0 to length s - 1 do
+    n := !n +
+      (match unsafe_get s i with
+       | '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
+       | ' ' .. '~' -> 1
+       | _ -> 4)
+  done;
+  if !n = length s then copy s else begin
+    let s' = create !n in
+    n := 0;
+    for i = 0 to length s - 1 do
+      begin match unsafe_get s i with
+      | ('\"' | '\\') as c ->
+          unsafe_set s' !n '\\'; incr n; unsafe_set s' !n c
+      | '\n' ->
+          unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'n'
+      | '\t' ->
+          unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 't'
+      | '\r' ->
+          unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'r'
+      | '\b' ->
+          unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'b'
+      | (' ' .. '~') as c -> unsafe_set s' !n c
+      | c ->
+          let a = char_code c in
+          unsafe_set s' !n '\\';
+          incr n;
+          unsafe_set s' !n (char_chr (48 + a / 100));
+          incr n;
+          unsafe_set s' !n (char_chr (48 + (a / 10) mod 10));
+          incr n;
+          unsafe_set s' !n (char_chr (48 + a mod 10));
+      end;
+      incr n
+    done;
+    s'
+  end
+
+let map f s =
+  let l = length s in
+  if l = 0 then s else begin
+    let r = create l in
+    for i = 0 to l - 1 do unsafe_set r i (f (unsafe_get s i)) done;
+    r
+  end
+
+let mapi f s =
+  let l = length s in
+  if l = 0 then s else begin
+    let r = create l in
+    for i = 0 to l - 1 do unsafe_set r i (f i (unsafe_get s i)) done;
+    r
+  end
+
+let uppercase_ascii s = map Char.uppercase_ascii s
+let lowercase_ascii s = map Char.lowercase_ascii s
+
+let apply1 f s =
+  if length s = 0 then s else begin
+    let r = copy s in
+    unsafe_set r 0 (f(unsafe_get s 0));
+    r
+  end
+
+let capitalize_ascii s = apply1 Char.uppercase_ascii s
+let uncapitalize_ascii s = apply1 Char.lowercase_ascii s
+
+(* duplicated in string.ml *)
+let rec index_rec s lim i c =
+  if i >= lim then raise Not_found else
+  if unsafe_get s i = c then i else index_rec s lim (i + 1) c
+
+(* duplicated in string.ml *)
+let index s c = index_rec s (length s) 0 c
+
+(* duplicated in string.ml *)
+let rec index_rec_opt s lim i c =
+  if i >= lim then None else
+  if unsafe_get s i = c then Some i else index_rec_opt s lim (i + 1) c
+
+(* duplicated in string.ml *)
+let index_opt s c = index_rec_opt s (length s) 0 c
+
+(* duplicated in string.ml *)
+let index_from s i c =
+  let l = length s in
+  if i < 0 || i > l then invalid_arg "String.index_from / Bytes.index_from" else
+  index_rec s l i c
+
+(* duplicated in string.ml *)
+let index_from_opt s i c =
+  let l = length s in
+  if i < 0 || i > l then
+    invalid_arg "String.index_from_opt / Bytes.index_from_opt"
+  else
+    index_rec_opt s l i c
+
+(* duplicated in string.ml *)
+let rec rindex_rec s i c =
+  if i < 0 then raise Not_found else
+  if unsafe_get s i = c then i else rindex_rec s (i - 1) c
+
+(* duplicated in string.ml *)
+let rindex s c = rindex_rec s (length s - 1) c
+
+(* duplicated in string.ml *)
+let rindex_from s i c =
+  if i < -1 || i >= length s then
+    invalid_arg "String.rindex_from / Bytes.rindex_from"
+  else
+    rindex_rec s i c
+
+(* duplicated in string.ml *)
+let rec rindex_rec_opt s i c =
+  if i < 0 then None else
+  if unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c
+
+(* duplicated in string.ml *)
+let rindex_opt s c = rindex_rec_opt s (length s - 1) c
+
+(* duplicated in string.ml *)
+let rindex_from_opt s i c =
+  if i < -1 || i >= length s then
+    invalid_arg "String.rindex_from_opt / Bytes.rindex_from_opt"
+  else
+    rindex_rec_opt s i c
+
+
+(* duplicated in string.ml *)
+let contains_from s i c =
+  let l = length s in
+  if i < 0 || i > l then
+    invalid_arg "String.contains_from / Bytes.contains_from"
+  else
+    try ignore (index_rec s l i c); true with Not_found -> false
+
+
+(* duplicated in string.ml *)
+let contains s c = contains_from s 0 c
+
+(* duplicated in string.ml *)
+let rcontains_from s i c =
+  if i < 0 || i >= length s then
+    invalid_arg "String.rcontains_from / Bytes.rcontains_from"
+  else
+    try ignore (rindex_rec s i c); true with Not_found -> false
+
+
+type t = bytes
+
+let compare (x: t) (y: t) = Stdlib.compare x y
+external equal : t -> t -> bool = "caml_bytes_equal" [@@noalloc]
+
+(* Deprecated functions implemented via other deprecated functions *)
+[@@@ocaml.warning "-3"]
+let uppercase s = map Char.uppercase s
+let lowercase s = map Char.lowercase s
+
+let capitalize s = apply1 Char.uppercase s
+let uncapitalize s = apply1 Char.lowercase s
+
+(** {1 Iterators} *)
+
+let to_seq s =
+  let rec aux i () =
+    if i = length s then Seq.Nil
+    else
+      let x = get s i in
+      Seq.Cons (x, aux (i+1))
+  in
+  aux 0
+
+let to_seqi s =
+  let rec aux i () =
+    if i = length s then Seq.Nil
+    else
+      let x = get s i in
+      Seq.Cons ((i,x), aux (i+1))
+  in
+  aux 0
+
+let of_seq i =
+  let n = ref 0 in
+  let buf = ref (make 256 '\000') in
+  let resize () =
+    (* resize *)
+    let new_len = min (2 * length !buf) Sys.max_string_length in
+    if length !buf = new_len then failwith "Bytes.of_seq: cannot grow bytes";
+    let new_buf = make new_len '\000' in
+    blit !buf 0 new_buf 0 !n;
+    buf := new_buf
+  in
+  Seq.iter
+    (fun c ->
+       if !n = length !buf then resize();
+       set !buf !n c;
+       incr n)
+    i;
+  sub !buf 0 !n
+
+(** {6 Binary encoding/decoding of integers} *)
+
+external get_uint8 : bytes -> int -> int = "%bytes_safe_get"
+external get_uint16_ne : bytes -> int -> int = "%caml_bytes_get16"
+external get_int32_ne : bytes -> int -> int32 = "%caml_bytes_get32"
+external get_int64_ne : bytes -> int -> int64 = "%caml_bytes_get64"
+external set_int8 : bytes -> int -> int -> unit = "%bytes_safe_set"
+external set_int16_ne : bytes -> int -> int -> unit = "%caml_bytes_set16"
+external set_int32_ne : bytes -> int -> int32 -> unit = "%caml_bytes_set32"
+external set_int64_ne : bytes -> int -> int64 -> unit = "%caml_bytes_set64"
+external swap16 : int -> int = "%bswap16"
+external swap32 : int32 -> int32 = "%bswap_int32"
+external swap64 : int64 -> int64 = "%bswap_int64"
+
+let get_int8 b i =
+  ((get_uint8 b i) lsl (Sys.int_size - 8)) asr (Sys.int_size - 8)
+
+let get_uint16_le b i =
+  if Sys.big_endian then swap16 (get_uint16_ne b i)
+  else get_uint16_ne b i
+
+let get_uint16_be b i =
+  if not Sys.big_endian then swap16 (get_uint16_ne b i)
+  else get_uint16_ne b i
+
+let get_int16_ne b i =
+  ((get_uint16_ne b i) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16)
+
+let get_int16_le b i =
+  ((get_uint16_le b i) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16)
+
+let get_int16_be b i =
+  ((get_uint16_be b i) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16)
+
+let get_int32_le b i =
+  if Sys.big_endian then swap32 (get_int32_ne b i)
+  else get_int32_ne b i
+
+let get_int32_be b i =
+  if not Sys.big_endian then swap32 (get_int32_ne b i)
+  else get_int32_ne b i
+
+let get_int64_le b i =
+  if Sys.big_endian then swap64 (get_int64_ne b i)
+  else get_int64_ne b i
+
+let get_int64_be b i =
+  if not Sys.big_endian then swap64 (get_int64_ne b i)
+  else get_int64_ne b i
+
+let set_int16_le b i x =
+  if Sys.big_endian then set_int16_ne b i (swap16 x)
+  else set_int16_ne b i x
+
+let set_int16_be b i x =
+  if not Sys.big_endian then set_int16_ne b i (swap16 x)
+  else set_int16_ne b i x
+
+let set_int32_le b i x =
+  if Sys.big_endian then set_int32_ne b i (swap32 x)
+  else set_int32_ne b i x
+
+let set_int32_be b i x =
+  if not Sys.big_endian then set_int32_ne b i (swap32 x)
+  else set_int32_ne b i x
+
+let set_int64_le b i x =
+  if Sys.big_endian then set_int64_ne b i (swap64 x)
+  else set_int64_ne b i x
+
+let set_int64_be b i x =
+  if not Sys.big_endian then set_int64_ne b i (swap64 x)
+  else set_int64_ne b i x
+
+let set_uint8 = set_int8
+let set_uint16_ne = set_int16_ne
+let set_uint16_be = set_int16_be
+let set_uint16_le = set_int16_le
diff --git a/stdlib/bytes.mli b/stdlib/bytes.mli
new file mode 100644
index 00000000..abf3e90c
--- /dev/null
+++ b/stdlib/bytes.mli
@@ -0,0 +1,655 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Byte sequence operations.
+
+   A byte sequence is a mutable data structure that contains a
+   fixed-length sequence of bytes. Each byte can be indexed in
+   constant time for reading or writing.
+
+   Given a byte sequence [s] of length [l], we can access each of the
+   [l] bytes of [s] via its index in the sequence. Indexes start at
+   [0], and we will call an index valid in [s] if it falls within the
+   range [[0...l-1]] (inclusive). A position is the point between two
+   bytes or at the beginning or end of the sequence.  We call a
+   position valid in [s] if it falls within the range [[0...l]]
+   (inclusive). Note that the byte at index [n] is between positions
+   [n] and [n+1].
+
+   Two parameters [start] and [len] are said to designate a valid
+   range of [s] if [len >= 0] and [start] and [start+len] are valid
+   positions in [s].
+
+   Byte sequences can be modified in place, for instance via the [set]
+   and [blit] functions described below.  See also strings (module
+   {!String}), which are almost the same data structure, but cannot be
+   modified in place.
+
+   Bytes are represented by the OCaml type [char].
+
+   @since 4.02.0
+ *)
+
+external length : bytes -> int = "%bytes_length"
+(** Return the length (number of bytes) of the argument. *)
+
+external get : bytes -> int -> char = "%bytes_safe_get"
+(** [get s n] returns the byte at index [n] in argument [s].
+    @raise Invalid_argument if [n] is not a valid index in [s]. *)
+
+external set : bytes -> int -> char -> unit = "%bytes_safe_set"
+(** [set s n c] modifies [s] in place, replacing the byte at index [n]
+    with [c].
+    @raise Invalid_argument if [n] is not a valid index in [s]. *)
+
+external create : int -> bytes = "caml_create_bytes"
+(** [create n] returns a new byte sequence of length [n]. The
+    sequence is uninitialized and contains arbitrary bytes.
+    @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val make : int -> char -> bytes
+(** [make n c] returns a new byte sequence of length [n], filled with
+    the byte [c].
+    @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val init : int -> (int -> char) -> bytes
+(** [Bytes.init n f] returns a fresh byte sequence of length [n], with
+    character [i] initialized to the result of [f i] (in increasing
+    index order).
+    @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val empty : bytes
+(** A byte sequence of size 0. *)
+
+val copy : bytes -> bytes
+(** Return a new byte sequence that contains the same bytes as the
+    argument. *)
+
+val of_string : string -> bytes
+(** Return a new byte sequence that contains the same bytes as the
+    given string. *)
+
+val to_string : bytes -> string
+(** Return a new string that contains the same bytes as the given byte
+    sequence. *)
+
+val sub : bytes -> int -> int -> bytes
+(** [sub s start len] returns a new byte sequence of length [len],
+    containing the subsequence of [s] that starts at position [start]
+    and has length [len].
+    @raise Invalid_argument if [start] and [len] do not designate a
+    valid range of [s]. *)
+
+val sub_string : bytes -> int -> int -> string
+(** Same as [sub] but return a string instead of a byte sequence. *)
+
+val extend : bytes -> int -> int -> bytes
+(** [extend s left right] returns a new byte sequence that contains
+    the bytes of [s], with [left] uninitialized bytes prepended and
+    [right] uninitialized bytes appended to it. If [left] or [right]
+    is negative, then bytes are removed (instead of appended) from
+    the corresponding side of [s].
+    @raise Invalid_argument if the result length is negative or
+    longer than {!Sys.max_string_length} bytes. *)
+
+val fill : bytes -> int -> int -> char -> unit
+(** [fill s start len c] modifies [s] in place, replacing [len]
+    characters with [c], starting at [start].
+    @raise Invalid_argument if [start] and [len] do not designate a
+    valid range of [s]. *)
+
+val blit : bytes -> int -> bytes -> int -> int -> unit
+(** [blit src srcoff dst dstoff len] copies [len] bytes from sequence
+    [src], starting at index [srcoff], to sequence [dst], starting at
+    index [dstoff]. It works correctly even if [src] and [dst] are the
+    same byte sequence, and the source and destination intervals
+    overlap.
+    @raise Invalid_argument if [srcoff] and [len] do not
+    designate a valid range of [src], or if [dstoff] and [len]
+    do not designate a valid range of [dst]. *)
+
+val blit_string : string -> int -> bytes -> int -> int -> unit
+(** [blit_string src srcoff dst dstoff len] copies [len] bytes from
+    string [src], starting at index [srcoff], to byte sequence [dst],
+    starting at index [dstoff].
+    @raise Invalid_argument if [srcoff] and [len] do not
+    designate a valid range of [src], or if [dstoff] and [len]
+    do not designate a valid range of [dst]. *)
+
+val concat : bytes -> bytes list -> bytes
+(** [concat sep sl] concatenates the list of byte sequences [sl],
+    inserting the separator byte sequence [sep] between each, and
+    returns the result as a new byte sequence.
+    @raise Invalid_argument if the result is longer than
+    {!Sys.max_string_length} bytes. *)
+
+val cat : bytes -> bytes -> bytes
+(** [cat s1 s2] concatenates [s1] and [s2] and returns the result
+    as a new byte sequence.
+    @raise Invalid_argument if the result is longer than
+    {!Sys.max_string_length} bytes. *)
+
+val iter : (char -> unit) -> bytes -> unit
+(** [iter f s] applies function [f] in turn to all the bytes of [s].
+    It is equivalent to [f (get s 0); f (get s 1); ...; f (get s
+    (length s - 1)); ()]. *)
+
+val iteri : (int -> char -> unit) -> bytes -> unit
+(** Same as {!Bytes.iter}, but the function is applied to the index of
+    the byte as first argument and the byte itself as second
+    argument. *)
+
+val map : (char -> char) -> bytes -> bytes
+(** [map f s] applies function [f] in turn to all the bytes of [s]
+    (in increasing index order) and stores the resulting bytes in
+    a new sequence that is returned as the result. *)
+
+val mapi : (int -> char -> char) -> bytes -> bytes
+(** [mapi f s] calls [f] with each character of [s] and its
+    index (in increasing index order) and stores the resulting bytes
+    in a new sequence that is returned as the result. *)
+
+val trim : bytes -> bytes
+(** Return a copy of the argument, without leading and trailing
+    whitespace. The bytes regarded as whitespace are the ASCII
+    characters [' '], ['\012'], ['\n'], ['\r'], and ['\t']. *)
+
+val escaped : bytes -> bytes
+(** Return a copy of the argument, with special characters represented
+    by escape sequences, following the lexical conventions of OCaml.
+    All characters outside the ASCII printable range (32..126) are
+    escaped, as well as backslash and double-quote.
+    @raise Invalid_argument if the result is longer than
+    {!Sys.max_string_length} bytes. *)
+
+val index : bytes -> char -> int
+(** [index s c] returns the index of the first occurrence of byte [c]
+    in [s].
+    @raise Not_found if [c] does not occur in [s]. *)
+
+val index_opt: bytes -> char -> int option
+(** [index_opt s c] returns the index of the first occurrence of byte [c]
+    in [s] or [None] if [c] does not occur in [s].
+    @since 4.05 *)
+
+val rindex : bytes -> char -> int
+(** [rindex s c] returns the index of the last occurrence of byte [c]
+    in [s].
+    @raise Not_found if [c] does not occur in [s]. *)
+
+val rindex_opt: bytes -> char -> int option
+(** [rindex_opt s c] returns the index of the last occurrence of byte [c]
+    in [s] or [None] if [c] does not occur in [s].
+    @since 4.05 *)
+
+val index_from : bytes -> int -> char -> int
+(** [index_from s i c] returns the index of the first occurrence of
+    byte [c] in [s] after position [i].  [Bytes.index s c] is
+    equivalent to [Bytes.index_from s 0 c].
+    @raise Invalid_argument if [i] is not a valid position in [s].
+    @raise Not_found if [c] does not occur in [s] after position [i]. *)
+
+val index_from_opt: bytes -> int -> char -> int option
+(** [index_from_opt s i c] returns the index of the first occurrence of
+    byte [c] in [s] after position [i] or [None] if [c] does not occur in [s]
+    after position [i].
+    [Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c].
+    @raise Invalid_argument if [i] is not a valid position in [s].
+    @since 4.05 *)
+
+val rindex_from : bytes -> int -> char -> int
+(** [rindex_from s i c] returns the index of the last occurrence of
+    byte [c] in [s] before position [i+1].  [rindex s c] is equivalent
+    to [rindex_from s (Bytes.length s - 1) c].
+    @raise Invalid_argument if [i+1] is not a valid position in [s].
+    @raise Not_found if [c] does not occur in [s] before position [i+1]. *)
+
+val rindex_from_opt: bytes -> int -> char -> int option
+(** [rindex_from_opt s i c] returns the index of the last occurrence
+    of byte [c] in [s] before position [i+1] or [None] if [c] does not
+    occur in [s] before position [i+1].  [rindex_opt s c] is equivalent to
+    [rindex_from s (Bytes.length s - 1) c].
+    @raise Invalid_argument if [i+1] is not a valid position in [s].
+    @since 4.05 *)
+
+val contains : bytes -> char -> bool
+(** [contains s c] tests if byte [c] appears in [s]. *)
+
+val contains_from : bytes -> int -> char -> bool
+(** [contains_from s start c] tests if byte [c] appears in [s] after
+    position [start].  [contains s c] is equivalent to [contains_from
+    s 0 c].
+    @raise Invalid_argument if [start] is not a valid position in [s]. *)
+
+val rcontains_from : bytes -> int -> char -> bool
+(** [rcontains_from s stop c] tests if byte [c] appears in [s] before
+    position [stop+1].
+    @raise Invalid_argument if [stop < 0] or [stop+1] is not a valid
+    position in [s]. *)
+
+val uppercase : bytes -> bytes
+  [@@ocaml.deprecated "Use Bytes.uppercase_ascii instead."]
+(** Return a copy of the argument, with all lowercase letters
+   translated to uppercase, including accented letters of the ISO
+   Latin-1 (8859-1) character set.
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val lowercase : bytes -> bytes
+  [@@ocaml.deprecated "Use Bytes.lowercase_ascii instead."]
+(** Return a copy of the argument, with all uppercase letters
+   translated to lowercase, including accented letters of the ISO
+   Latin-1 (8859-1) character set.
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val capitalize : bytes -> bytes
+  [@@ocaml.deprecated "Use Bytes.capitalize_ascii instead."]
+(** Return a copy of the argument, with the first character set to uppercase,
+   using the ISO Latin-1 (8859-1) character set..
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val uncapitalize : bytes -> bytes
+  [@@ocaml.deprecated "Use Bytes.uncapitalize_ascii instead."]
+(** Return a copy of the argument, with the first character set to lowercase,
+   using the ISO Latin-1 (8859-1) character set..
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val uppercase_ascii : bytes -> bytes
+(** Return a copy of the argument, with all lowercase letters
+   translated to uppercase, using the US-ASCII character set.
+   @since 4.03.0 *)
+
+val lowercase_ascii : bytes -> bytes
+(** Return a copy of the argument, with all uppercase letters
+   translated to lowercase, using the US-ASCII character set.
+   @since 4.03.0 *)
+
+val capitalize_ascii : bytes -> bytes
+(** Return a copy of the argument, with the first character set to uppercase,
+   using the US-ASCII character set.
+   @since 4.03.0 *)
+
+val uncapitalize_ascii : bytes -> bytes
+(** Return a copy of the argument, with the first character set to lowercase,
+   using the US-ASCII character set.
+   @since 4.03.0 *)
+
+type t = bytes
+(** An alias for the type of byte sequences. *)
+
+val compare: t -> t -> int
+(** The comparison function for byte sequences, with the same
+    specification as {!Stdlib.compare}.  Along with the type [t],
+    this function [compare] allows the module [Bytes] to be passed as
+    argument to the functors {!Set.Make} and {!Map.Make}. *)
+
+val equal: t -> t -> bool
+(** The equality function for byte sequences.
+    @since 4.03.0 *)
+
+(** {1:unsafe Unsafe conversions (for advanced users)}
+
+    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 {!Bytes.to_string} and {!Bytes.of_string} instead.
+*)
+
+val unsafe_to_string : bytes -> string
+(** Unsafely convert a byte sequence into a string.
+
+    To reason about the use of [unsafe_to_string], it is convenient to
+    consider an "ownership" discipline. A piece of code that
+    manipulates some data "owns" it; there are several disjoint ownership
+    modes, including:
+    - Unique ownership: the data may be accessed and mutated
+    - Shared ownership: the data has several owners, that may only
+      access it, not mutate it.
+
+    Unique ownership is linear: passing the data to another piece of
+    code means giving up ownership (we cannot write the
+    data again). A unique owner may decide to make the data shared
+    (giving up mutation rights on it), but shared data may not become
+    uniquely-owned again.
+
+   [unsafe_to_string s] can only be used when the caller owns the byte
+   sequence [s] -- either uniquely or as shared immutable data. The
+   caller gives up ownership of [s], and gains ownership of the
+   returned string.
+
+   There are two valid use-cases that respect this ownership
+   discipline:
+
+   1. Creating a string by initializing and mutating a byte sequence
+   that is never changed after initialization is performed.
+
+   {[
+let string_init len f : string =
+  let s = Bytes.create len in
+  for i = 0 to len - 1 do Bytes.set s i (f i) done;
+  Bytes.unsafe_to_string s
+   ]}
+
+   This function is safe because the byte sequence [s] will never be
+   accessed or mutated after [unsafe_to_string] is called. The
+   [string_init] code gives up ownership of [s], and returns the
+   ownership of the resulting string to its caller.
+
+   Note that it would be unsafe if [s] was passed as an additional
+   parameter to the function [f] as it could escape this way and be
+   mutated in the future -- [string_init] would give up ownership of
+   [s] to pass it to [f], and could not call [unsafe_to_string]
+   safely.
+
+   We have provided the {!String.init}, {!String.map} and
+   {!String.mapi} functions to cover most cases of building
+   new strings. You should prefer those over [to_string] or
+   [unsafe_to_string] whenever applicable.
+
+   2. Temporarily giving ownership of a byte sequence to a function
+   that expects a uniquely owned string and returns ownership back, so
+   that we can mutate the sequence again after the call ended.
+
+   {[
+let bytes_length (s : bytes) =
+  String.length (Bytes.unsafe_to_string s)
+   ]}
+
+   In this use-case, we do not promise that [s] will never be mutated
+   after the call to [bytes_length s]. The {!String.length} function
+   temporarily borrows unique ownership of the byte sequence
+   (and sees it as a [string]), but returns this ownership back to
+   the caller, which may assume that [s] is still a valid byte
+   sequence after the call. Note that this is only correct because we
+   know that {!String.length} does not capture its argument -- it could
+   escape by a side-channel such as a memoization combinator.
+
+   The caller may not mutate [s] while the string is borrowed (it has
+   temporarily given up ownership). This affects concurrent programs,
+   but also higher-order functions: if {!String.length} returned
+   a closure to be called later, [s] should not be mutated until this
+   closure is fully applied and returns ownership.
+*)
+
+val unsafe_of_string : string -> bytes
+(** Unsafely convert a shared string to a byte sequence that should
+    not be mutated.
+
+    The same ownership discipline that makes [unsafe_to_string]
+    correct applies to [unsafe_of_string]: you may use it if you were
+    the owner of the [string] value, and you will own the return
+    [bytes] in the same mode.
+
+    In practice, unique ownership of string values is extremely
+    difficult to reason about correctly. You should always assume
+    strings are shared, never uniquely owned.
+
+    For example, string literals are implicitly shared by the
+    compiler, so you never uniquely own them.
+
+    {[
+let incorrect = Bytes.unsafe_of_string "hello"
+let s = Bytes.of_string "hello"
+    ]}
+
+    The first declaration is incorrect, because the string literal
+    ["hello"] could be shared by the compiler with other parts of the
+    program, and mutating [incorrect] is a bug. You must always use
+    the second version, which performs a copy and is thus correct.
+
+    Assuming unique ownership of strings that are not string
+    literals, but are (partly) built from string literals, is also
+    incorrect. For example, mutating [unsafe_of_string ("foo" ^ s)]
+    could mutate the shared string ["foo"] -- assuming a rope-like
+    representation of strings. More generally, functions operating on
+    strings will assume shared ownership, they do not preserve unique
+    ownership. It is thus incorrect to assume unique ownership of the
+    result of [unsafe_of_string].
+
+    The only case we have reasonable confidence is safe is if the
+    produced [bytes] is shared -- used as an immutable byte
+    sequence. This is possibly useful for incremental migration of
+    low-level programs that manipulate immutable sequences of bytes
+    (for example {!Marshal.from_bytes}) and previously used the
+    [string] type for this purpose.
+*)
+
+(** {1 Iterators} *)
+
+val to_seq : t -> char Seq.t
+(** Iterate on the string, in increasing index order. Modifications of the
+    string during iteration will be reflected in the iterator.
+    @since 4.07 *)
+
+val to_seqi : t -> (int * char) Seq.t
+(** Iterate on the string, in increasing order, yielding indices along chars
+    @since 4.07 *)
+
+val of_seq : char Seq.t -> t
+(** Create a string from the generator
+    @since 4.07 *)
+
+(** {1 Binary encoding/decoding of integers} *)
+
+(** The functions in this section binary encode and decode integers to
+    and from byte sequences.
+
+    All following functions raise [Invalid_argument] if the space
+    needed at index [i] to decode or encode the integer is not
+    available.
+
+    Little-endian (resp. big-endian) encoding means that least
+    (resp. most) significant bytes are stored first.  Big-endian is
+    also known as network byte order.  Native-endian encoding is
+    either little-endian or big-endian depending on {!Sys.big_endian}.
+
+    32-bit and 64-bit integers are represented by the [int32] and
+    [int64] types, which can be interpreted either as signed or
+    unsigned numbers.
+
+    8-bit and 16-bit integers are represented by the [int] type,
+    which has more bits than the binary encoding.  These extra bits
+    are handled as follows: {ul
+    {- Functions that decode signed (resp. unsigned) 8-bit or 16-bit
+    integers represented by [int] values sign-extend
+    (resp. zero-extend) their result.}
+    {- Functions that encode 8-bit or 16-bit integers represented by
+    [int] values truncate their input to their least significant
+    bytes.}}
+*)
+
+val get_uint8 : bytes -> int -> int
+(** [get_uint8 b i] is [b]'s unsigned 8-bit integer starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int8 : bytes -> int -> int
+(** [get_int8 b i] is [b]'s signed 8-bit integer starting at byte index [i].
+    @since 4.08
+*)
+
+val get_uint16_ne : bytes -> int -> int
+(** [get_uint16_ne b i] is [b]'s native-endian unsigned 16-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_uint16_be : bytes -> int -> int
+(** [get_uint16_be b i] is [b]'s big-endian unsigned 16-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_uint16_le : bytes -> int -> int
+(** [get_uint16_le b i] is [b]'s little-endian unsigned 16-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int16_ne : bytes -> int -> int
+(** [get_int16_ne b i] is [b]'s native-endian signed 16-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int16_be : bytes -> int -> int
+(** [get_int16_be b i] is [b]'s big-endian signed 16-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int16_le : bytes -> int -> int
+(** [get_int16_le b i] is [b]'s little-endian signed 16-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int32_ne : bytes -> int -> int32
+(** [get_int32_ne b i] is [b]'s native-endian 32-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int32_be : bytes -> int -> int32
+(** [get_int32_be b i] is [b]'s big-endian 32-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int32_le : bytes -> int -> int32
+(** [get_int32_le b i] is [b]'s little-endian 32-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int64_ne : bytes -> int -> int64
+(** [get_int64_ne b i] is [b]'s native-endian 64-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int64_be : bytes -> int -> int64
+(** [get_int64_be b i] is [b]'s big-endian 64-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int64_le : bytes -> int -> int64
+(** [get_int64_le b i] is [b]'s little-endian 64-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val set_uint8 : bytes -> int -> int -> unit
+(** [set_uint8 b i v] sets [b]'s unsigned 8-bit integer starting at byte index
+    [i] to [v].
+    @since 4.08
+*)
+
+val set_int8 : bytes -> int -> int -> unit
+(** [set_int8 b i v] sets [b]'s signed 8-bit integer starting at byte index
+    [i] to [v].
+    @since 4.08
+*)
+
+val set_uint16_ne : bytes -> int -> int -> unit
+(** [set_uint16_ne b i v] sets [b]'s native-endian unsigned 16-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_uint16_be : bytes -> int -> int -> unit
+(** [set_uint16_be b i v] sets [b]'s big-endian unsigned 16-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_uint16_le : bytes -> int -> int -> unit
+(** [set_uint16_le b i v] sets [b]'s little-endian unsigned 16-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int16_ne : bytes -> int -> int -> unit
+(** [set_int16_ne b i v] sets [b]'s native-endian signed 16-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int16_be : bytes -> int -> int -> unit
+(** [set_int16_be b i v] sets [b]'s big-endian signed 16-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int16_le : bytes -> int -> int -> unit
+(** [set_int16_le b i v] sets [b]'s little-endian signed 16-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int32_ne : bytes -> int -> int32 -> unit
+(** [set_int32_ne b i v] sets [b]'s native-endian 32-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int32_be : bytes -> int -> int32 -> unit
+(** [set_int32_be b i v] sets [b]'s big-endian 32-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int32_le : bytes -> int -> int32 -> unit
+(** [set_int32_le b i v] sets [b]'s little-endian 32-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int64_ne : bytes -> int -> int64 -> unit
+(** [set_int64_ne b i v] sets [b]'s native-endian 64-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int64_be : bytes -> int -> int64 -> unit
+(** [set_int64_be b i v] sets [b]'s big-endian 64-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int64_le : bytes -> int -> int64 -> unit
+(** [set_int64_le b i v] sets [b]'s little-endian 64-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+
+
+(**/**)
+
+(* The following is for system use only. Do not call directly. *)
+
+external unsafe_get : bytes -> int -> char = "%bytes_unsafe_get"
+external unsafe_set : bytes -> int -> char -> unit = "%bytes_unsafe_set"
+external unsafe_blit :
+  bytes -> int -> bytes -> int -> int -> unit
+  = "caml_blit_bytes" [@@noalloc]
+external unsafe_blit_string :
+  string -> int -> bytes -> int -> int -> unit
+  = "caml_blit_string" [@@noalloc]
+external unsafe_fill :
+  bytes -> int -> int -> char -> unit = "caml_fill_bytes" [@@noalloc]
diff --git a/stdlib/bytesLabels.ml b/stdlib/bytesLabels.ml
new file mode 100644
index 00000000..0e984169
--- /dev/null
+++ b/stdlib/bytesLabels.ml
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Jacques Garrigue, Kyoto University RIMS                 *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Module [BytesLabels]: labelled Bytes module *)
+
+include Bytes
diff --git a/stdlib/bytesLabels.mli b/stdlib/bytesLabels.mli
new file mode 100644
index 00000000..e4f85d37
--- /dev/null
+++ b/stdlib/bytesLabels.mli
@@ -0,0 +1,512 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Byte sequence operations.
+    @since 4.02.0
+
+    This module is intended to be used through {!StdLabels} which replaces
+    {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts.
+
+    For example:
+    {[
+       open StdLabels
+
+       let first = Bytes.sub ~pos:0 ~len:1
+    ]} *)
+
+external length : bytes -> int = "%bytes_length"
+(** Return the length (number of bytes) of the argument. *)
+
+external get : bytes -> int -> char = "%bytes_safe_get"
+(** [get s n] returns the byte at index [n] in argument [s].
+    @raise Invalid_argument if [n] is not a valid index in [s]. *)
+
+
+external set : bytes -> int -> char -> unit = "%bytes_safe_set"
+(** [set s n c] modifies [s] in place, replacing the byte at index [n]
+    with [c].
+    @raise Invalid_argument if [n] is not a valid index in [s]. *)
+
+external create : int -> bytes = "caml_create_bytes"
+(** [create n] returns a new byte sequence of length [n]. The
+    sequence is uninitialized and contains arbitrary bytes.
+    @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val make : int -> char -> bytes
+(** [make n c] returns a new byte sequence of length [n], filled with
+    the byte [c].
+    @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val init : int -> f:(int -> char) -> bytes
+(** [init n f] returns a fresh byte sequence of length [n],
+    with character [i] initialized to the result of [f i].
+    @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val empty : bytes
+(** A byte sequence of size 0. *)
+
+val copy : bytes -> bytes
+(** Return a new byte sequence that contains the same bytes as the
+    argument. *)
+
+val of_string : string -> bytes
+(** Return a new byte sequence that contains the same bytes as the
+    given string. *)
+
+val to_string : bytes -> string
+(** Return a new string that contains the same bytes as the given byte
+    sequence. *)
+
+val sub : bytes -> pos:int -> len:int -> bytes
+(** [sub s start len] returns a new byte sequence of length [len],
+    containing the subsequence of [s] that starts at position [start]
+    and has length [len].
+    @raise Invalid_argument if [start] and [len] do not designate a
+    valid range of [s]. *)
+
+val sub_string : bytes -> pos:int -> len:int -> string
+(** Same as [sub] but return a string instead of a byte sequence. *)
+
+val extend : bytes -> left:int -> right:int -> bytes
+(** [extend s left right] returns a new byte sequence that contains
+    the bytes of [s], with [left] uninitialized bytes prepended and
+    [right] uninitialized bytes appended to it. If [left] or [right]
+    is negative, then bytes are removed (instead of appended) from
+    the corresponding side of [s].
+    @raise Invalid_argument if the result length is negative or
+    longer than {!Sys.max_string_length} bytes.
+    @since 4.05.0 *)
+
+val fill : bytes -> pos:int -> len:int -> char -> unit
+(** [fill s start len c] modifies [s] in place, replacing [len]
+    characters with [c], starting at [start].
+    @raise Invalid_argument if [start] and [len] do not designate a
+    valid range of [s]. *)
+
+val blit :
+  src:bytes -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int
+  -> unit
+(** [blit src srcoff dst dstoff len] copies [len] bytes from sequence
+    [src], starting at index [srcoff], to sequence [dst], starting at
+    index [dstoff]. It works correctly even if [src] and [dst] are the
+    same byte sequence, and the source and destination intervals
+    overlap.
+    @raise Invalid_argument if [srcoff] and [len] do not
+    designate a valid range of [src], or if [dstoff] and [len]
+    do not designate a valid range of [dst]. *)
+
+val blit_string :
+  src:string -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int
+  -> unit
+(** [blit src srcoff dst dstoff len] copies [len] bytes from string
+    [src], starting at index [srcoff], to byte sequence [dst],
+    starting at index [dstoff].
+    @raise Invalid_argument if [srcoff] and [len] do not
+    designate a valid range of [src], or if [dstoff] and [len]
+    do not designate a valid range of [dst].
+    @since 4.05.0 *)
+
+val concat : sep:bytes -> bytes list -> bytes
+(** [concat sep sl] concatenates the list of byte sequences [sl],
+    inserting the separator byte sequence [sep] between each, and
+    returns the result as a new byte sequence. *)
+
+val cat : bytes -> bytes -> bytes
+(** [cat s1 s2] concatenates [s1] and [s2] and returns the result
+    as new byte sequence.
+    @raise Invalid_argument if the result is longer than
+    {!Sys.max_string_length} bytes.
+    @since 4.05.0 *)
+
+val iter : f:(char -> unit) -> bytes -> unit
+(** [iter f s] applies function [f] in turn to all the bytes of [s].
+    It is equivalent to [f (get s 0); f (get s 1); ...; f (get s
+    (length s - 1)); ()]. *)
+
+val iteri : f:(int -> char -> unit) -> bytes -> unit
+(** Same as {!Bytes.iter}, but the function is applied to the index of
+    the byte as first argument and the byte itself as second
+    argument. *)
+
+val map : f:(char -> char) -> bytes -> bytes
+(** [map f s] applies function [f] in turn to all the bytes of [s] and
+    stores the resulting bytes in a new sequence that is returned as
+    the result. *)
+
+val mapi : f:(int -> char -> char) -> bytes -> bytes
+(** [mapi f s] calls [f] with each character of [s] and its
+    index (in increasing index order) and stores the resulting bytes
+    in a new sequence that is returned as the result. *)
+
+val trim : bytes -> bytes
+(** Return a copy of the argument, without leading and trailing
+    whitespace. The bytes regarded as whitespace are the ASCII
+    characters [' '], ['\012'], ['\n'], ['\r'], and ['\t']. *)
+
+val escaped : bytes -> bytes
+(** Return a copy of the argument, with special characters represented
+    by escape sequences, following the lexical conventions of OCaml. *)
+
+val index : bytes -> char -> int
+(** [index s c] returns the index of the first occurrence of byte [c]
+    in [s].
+    @raise Not_found if [c] does not occur in [s]. *)
+
+val index_opt: bytes -> char -> int option
+(** [index_opt s c] returns the index of the first occurrence of byte [c]
+    in [s] or [None] if [c] does not occur in [s].
+    @since 4.05 *)
+
+val rindex : bytes -> char -> int
+(** [rindex s c] returns the index of the last occurrence of byte [c]
+    in [s].
+    @raise Not_found if [c] does not occur in [s]. *)
+
+val rindex_opt: bytes -> char -> int option
+(** [rindex_opt s c] returns the index of the last occurrence of byte [c]
+    in [s] or [None] if [c] does not occur in [s].
+    @since 4.05 *)
+
+val index_from : bytes -> int -> char -> int
+(** [index_from s i c] returns the index of the first occurrence of
+    byte [c] in [s] after position [i].  [Bytes.index s c] is
+    equivalent to [Bytes.index_from s 0 c].
+    @raise Invalid_argument if [i] is not a valid position in [s].
+    @raise Not_found if [c] does not occur in [s] after position [i]. *)
+
+val index_from_opt: bytes -> int -> char -> int option
+(** [index_from _opts i c] returns the index of the first occurrence of
+    byte [c] in [s] after position [i] or [None] if [c] does not occur in [s]
+    after position [i].
+    [Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c].
+    @raise Invalid_argument if [i] is not a valid position in [s].
+    @since 4.05 *)
+
+val rindex_from : bytes -> int -> char -> int
+(** [rindex_from s i c] returns the index of the last occurrence of
+    byte [c] in [s] before position [i+1].  [rindex s c] is equivalent
+    to [rindex_from s (Bytes.length s - 1) c].
+    @raise Invalid_argument if [i+1] is not a valid position in [s].
+    @raise Not_found if [c] does not occur in [s] before position [i+1]. *)
+
+val rindex_from_opt: bytes -> int -> char -> int option
+(** [rindex_from_opt s i c] returns the index of the last occurrence
+    of byte [c] in [s] before position [i+1] or [None] if [c] does not
+    occur in [s] before position [i+1].  [rindex_opt s c] is equivalent to
+    [rindex_from s (Bytes.length s - 1) c].
+    @raise Invalid_argument if [i+1] is not a valid position in [s].
+    @since 4.05 *)
+
+val contains : bytes -> char -> bool
+(** [contains s c] tests if byte [c] appears in [s]. *)
+
+val contains_from : bytes -> int -> char -> bool
+(** [contains_from s start c] tests if byte [c] appears in [s] after
+    position [start].  [contains s c] is equivalent to [contains_from
+    s 0 c].
+    @raise Invalid_argument if [start] is not a valid position in [s]. *)
+
+val rcontains_from : bytes -> int -> char -> bool
+(** [rcontains_from s stop c] tests if byte [c] appears in [s] before
+    position [stop+1].
+    @raise Invalid_argument if [stop < 0] or [stop+1] is not a valid
+    position in [s]. *)
+
+val uppercase : bytes -> bytes
+  [@@ocaml.deprecated "Use Bytes.uppercase_ascii instead."]
+(** Return a copy of the argument, with all lowercase letters
+   translated to uppercase, including accented letters of the ISO
+   Latin-1 (8859-1) character set.
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val lowercase : bytes -> bytes
+  [@@ocaml.deprecated "Use Bytes.lowercase_ascii instead."]
+(** Return a copy of the argument, with all uppercase letters
+   translated to lowercase, including accented letters of the ISO
+   Latin-1 (8859-1) character set.
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val capitalize : bytes -> bytes
+  [@@ocaml.deprecated "Use Bytes.capitalize_ascii instead."]
+(** Return a copy of the argument, with the first character set to uppercase,
+   using the ISO Latin-1 (8859-1) character set..
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val uncapitalize : bytes -> bytes
+  [@@ocaml.deprecated "Use Bytes.uncapitalize_ascii instead."]
+(** Return a copy of the argument, with the first character set to lowercase,
+   using the ISO Latin-1 (8859-1) character set..
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val uppercase_ascii : bytes -> bytes
+(** Return a copy of the argument, with all lowercase letters
+   translated to uppercase, using the US-ASCII character set.
+   @since 4.05.0 *)
+
+val lowercase_ascii : bytes -> bytes
+(** Return a copy of the argument, with all uppercase letters
+   translated to lowercase, using the US-ASCII character set.
+   @since 4.05.0 *)
+
+val capitalize_ascii : bytes -> bytes
+(** Return a copy of the argument, with the first character set to uppercase,
+   using the US-ASCII character set.
+   @since 4.05.0 *)
+
+val uncapitalize_ascii : bytes -> bytes
+(** Return a copy of the argument, with the first character set to lowercase,
+   using the US-ASCII character set.
+   @since 4.05.0 *)
+
+type t = bytes
+(** An alias for the type of byte sequences. *)
+
+val compare: t -> t -> int
+(** The comparison function for byte sequences, with the same
+    specification as {!Stdlib.compare}.  Along with the type [t],
+    this function [compare] allows the module [Bytes] to be passed as
+    argument to the functors {!Set.Make} and {!Map.Make}. *)
+
+val equal: t -> t -> bool
+(** The equality function for byte sequences.
+    @since 4.05.0 *)
+
+(** {1 Iterators} *)
+
+val to_seq : t -> char Seq.t
+(** Iterate on the string, in increasing index order. Modifications of the
+    string during iteration will be reflected in the iterator.
+    @since 4.07 *)
+
+val to_seqi : t -> (int * char) Seq.t
+(** Iterate on the string, in increasing order, yielding indices along chars
+    @since 4.07 *)
+
+val of_seq : char Seq.t -> t
+(** Create a string from the generator
+    @since 4.07 *)
+
+(** {1 Binary encoding/decoding of integers} *)
+
+(** The functions in this section binary encode and decode integers to
+    and from byte sequences.
+
+    All following functions raise [Invalid_argument] if the space
+    needed at index [i] to decode or encode the integer is not
+    available.
+
+    Little-endian (resp. big-endian) encoding means that least
+    (resp. most) significant bytes are stored first.  Big-endian is
+    also known as network byte order.  Native-endian encoding is
+    either little-endian or big-endian depending on {!Sys.big_endian}.
+
+    32-bit and 64-bit integers are represented by the [int32] and
+    [int64] types, which can be interpreted either as signed or
+    unsigned numbers.
+
+    8-bit and 16-bit integers are represented by the [int] type,
+    which has more bits than the binary encoding.  These extra bits
+    are handled as follows: {ul
+    {- Functions that decode signed (resp. unsigned) 8-bit or 16-bit
+    integers represented by [int] values sign-extend
+    (resp. zero-extend) their result.}
+    {- Functions that encode 8-bit or 16-bit integers represented by
+    [int] values truncate their input to their least significant
+    bytes.}}
+*)
+
+val get_uint8 : bytes -> int -> int
+(** [get_uint8 b i] is [b]'s unsigned 8-bit integer starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int8 : bytes -> int -> int
+(** [get_int8 b i] is [b]'s signed 8-bit integer starting at byte index [i].
+    @since 4.08
+*)
+
+val get_uint16_ne : bytes -> int -> int
+(** [get_uint16_ne b i] is [b]'s native-endian unsigned 16-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_uint16_be : bytes -> int -> int
+(** [get_uint16_be b i] is [b]'s big-endian unsigned 16-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_uint16_le : bytes -> int -> int
+(** [get_uint16_le b i] is [b]'s little-endian unsigned 16-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int16_ne : bytes -> int -> int
+(** [get_int16_ne b i] is [b]'s native-endian signed 16-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int16_be : bytes -> int -> int
+(** [get_int16_be b i] is [b]'s big-endian signed 16-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int16_le : bytes -> int -> int
+(** [get_int16_le b i] is [b]'s little-endian signed 16-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int32_ne : bytes -> int -> int32
+(** [get_int32_ne b i] is [b]'s native-endian 32-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int32_be : bytes -> int -> int32
+(** [get_int32_be b i] is [b]'s big-endian 32-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int32_le : bytes -> int -> int32
+(** [get_int32_le b i] is [b]'s little-endian 32-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int64_ne : bytes -> int -> int64
+(** [get_int64_ne b i] is [b]'s native-endian 64-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int64_be : bytes -> int -> int64
+(** [get_int64_be b i] is [b]'s big-endian 64-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val get_int64_le : bytes -> int -> int64
+(** [get_int64_le b i] is [b]'s little-endian 64-bit integer
+    starting at byte index [i].
+    @since 4.08
+*)
+
+val set_uint8 : bytes -> int -> int -> unit
+(** [set_uint8 b i v] sets [b]'s unsigned 8-bit integer starting at byte index
+    [i] to [v].
+    @since 4.08
+*)
+
+val set_int8 : bytes -> int -> int -> unit
+(** [set_int8 b i v] sets [b]'s signed 8-bit integer starting at byte index
+    [i] to [v].
+    @since 4.08
+*)
+
+val set_uint16_ne : bytes -> int -> int -> unit
+(** [set_uint16_ne b i v] sets [b]'s native-endian unsigned 16-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_uint16_be : bytes -> int -> int -> unit
+(** [set_uint16_be b i v] sets [b]'s big-endian unsigned 16-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_uint16_le : bytes -> int -> int -> unit
+(** [set_uint16_le b i v] sets [b]'s little-endian unsigned 16-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int16_ne : bytes -> int -> int -> unit
+(** [set_int16_ne b i v] sets [b]'s native-endian signed 16-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int16_be : bytes -> int -> int -> unit
+(** [set_int16_be b i v] sets [b]'s big-endian signed 16-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int16_le : bytes -> int -> int -> unit
+(** [set_int16_le b i v] sets [b]'s little-endian signed 16-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int32_ne : bytes -> int -> int32 -> unit
+(** [set_int32_ne b i v] sets [b]'s native-endian 32-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int32_be : bytes -> int -> int32 -> unit
+(** [set_int32_be b i v] sets [b]'s big-endian 32-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int32_le : bytes -> int -> int32 -> unit
+(** [set_int32_le b i v] sets [b]'s little-endian 32-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int64_ne : bytes -> int -> int64 -> unit
+(** [set_int64_ne b i v] sets [b]'s native-endian 64-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int64_be : bytes -> int -> int64 -> unit
+(** [set_int64_be b i v] sets [b]'s big-endian 64-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+val set_int64_le : bytes -> int -> int64 -> unit
+(** [set_int64_le b i v] sets [b]'s little-endian 64-bit integer
+    starting at byte index [i] to [v].
+    @since 4.08
+*)
+
+
+(**/**)
+
+(* The following is for system use only. Do not call directly. *)
+
+external unsafe_get : bytes -> int -> char = "%bytes_unsafe_get"
+external unsafe_set : bytes -> int -> char -> unit = "%bytes_unsafe_set"
+external unsafe_blit :
+  src:bytes -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int ->
+    unit = "caml_blit_bytes" [@@noalloc]
+external unsafe_blit_string :
+  src:string -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int -> unit
+  = "caml_blit_string" [@@noalloc]
+external unsafe_fill :
+  bytes -> pos:int -> len:int -> char -> unit = "caml_fill_bytes" [@@noalloc]
+val unsafe_to_string : bytes -> string
+val unsafe_of_string : string -> bytes
diff --git a/stdlib/callback.ml b/stdlib/callback.ml
new file mode 100644
index 00000000..e0cfb655
--- /dev/null
+++ b/stdlib/callback.ml
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Registering OCaml values with the C runtime for later callbacks *)
+
+external register_named_value : string -> Obj.t -> unit
+                              = "caml_register_named_value"
+
+let register name v =
+  register_named_value name (Obj.repr v)
+
+let register_exception name (exn : exn) =
+  let exn = Obj.repr exn in
+  let slot = if Obj.tag exn = Obj.object_tag then exn else Obj.field exn 0 in
+  register_named_value name slot
diff --git a/stdlib/callback.mli b/stdlib/callback.mli
new file mode 100644
index 00000000..27c8b500
--- /dev/null
+++ b/stdlib/callback.mli
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Registering OCaml values with the C runtime.
+
+   This module allows OCaml values to be registered with the C runtime
+   under a symbolic name, so that C code can later call back registered
+   OCaml functions, or raise registered OCaml exceptions.
+*)
+
+val register : string -> 'a -> unit
+(** [Callback.register n v] registers the value [v] under
+   the name [n]. C code can later retrieve a handle to [v]
+   by calling [caml_named_value(n)]. *)
+
+val register_exception : string -> exn -> unit
+(** [Callback.register_exception n exn] registers the
+   exception contained in the exception value [exn]
+   under the name [n]. C code can later retrieve a handle to
+   the exception by calling [caml_named_value(n)]. The exception
+   value thus obtained is suitable for passing as first argument
+   to [raise_constant] or [raise_with_arg]. *)
diff --git a/stdlib/camlinternalFormat.ml b/stdlib/camlinternalFormat.ml
new file mode 100644
index 00000000..5c2a2b3b
--- /dev/null
+++ b/stdlib/camlinternalFormat.ml
@@ -0,0 +1,2991 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                          Benoit Vaugon, ENSTA                          *)
+(*                                                                        *)
+(*   Copyright 2014 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open CamlinternalFormatBasics
+
+(******************************************************************************)
+           (* Tools to manipulate scanning set of chars (see %[...]) *)
+
+type mutable_char_set = bytes
+
+(* Create a fresh, empty, mutable char set. *)
+let create_char_set () = Bytes.make 32 '\000'
+
+(* Add a char in a mutable char set. *)
+let add_in_char_set char_set c =
+  let ind = int_of_char c in
+  let str_ind = ind lsr 3 and mask = 1 lsl (ind land 0b111) in
+  Bytes.set char_set str_ind
+    (char_of_int (int_of_char (Bytes.get char_set str_ind) lor mask))
+
+let freeze_char_set char_set =
+  Bytes.to_string char_set
+
+(* Compute the complement of a char set. *)
+let rev_char_set char_set =
+  let char_set' = create_char_set () in
+  for i = 0 to 31 do
+    Bytes.set char_set' i
+      (char_of_int (int_of_char (String.get char_set i) lxor 0xFF));
+  done;
+  Bytes.unsafe_to_string char_set'
+
+(* Return true if a `c' is in `char_set'. *)
+let is_in_char_set char_set c =
+  let ind = int_of_char c in
+  let str_ind = ind lsr 3 and mask = 1 lsl (ind land 0b111) in
+  (int_of_char (String.get char_set str_ind) land mask) <> 0
+
+
+(******************************************************************************)
+                         (* Ignored param conversion *)
+
+(* GADT used to abstract an existential type parameter. *)
+(* See param_format_of_ignored_format. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb = Param_format_EBB :
+    ('x -> 'a, 'b, 'c, 'd, 'e, 'f) fmt ->
+    ('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb
+
+(* Compute a padding associated to a pad_option (see "%_42d"). *)
+let pad_of_pad_opt pad_opt = match pad_opt with
+  | None -> No_padding
+  | Some width -> Lit_padding (Right, width)
+
+(* Compute a precision associated to a prec_option (see "%_.42f"). *)
+let prec_of_prec_opt prec_opt = match prec_opt with
+  | None -> No_precision
+  | Some ndec -> Lit_precision ndec
+
+(* Turn an ignored param into its equivalent not-ignored format node. *)
+(* Used for format pretty-printing and Scanf. *)
+let param_format_of_ignored_format : type a b c d e f x y .
+    (a, b, c, d, y, x) ignored -> (x, b, c, y, e, f) fmt ->
+      (a, b, c, d, e, f) param_format_ebb =
+fun ign fmt -> match ign with
+  | Ignored_char ->
+    Param_format_EBB (Char fmt)
+  | Ignored_caml_char ->
+    Param_format_EBB (Caml_char fmt)
+  | Ignored_string pad_opt ->
+    Param_format_EBB (String (pad_of_pad_opt pad_opt, fmt))
+  | Ignored_caml_string pad_opt ->
+    Param_format_EBB (Caml_string (pad_of_pad_opt pad_opt, fmt))
+  | Ignored_int (iconv, pad_opt) ->
+    Param_format_EBB (Int (iconv, pad_of_pad_opt pad_opt, No_precision, fmt))
+  | Ignored_int32 (iconv, pad_opt) ->
+    Param_format_EBB
+      (Int32 (iconv, pad_of_pad_opt pad_opt, No_precision, fmt))
+  | Ignored_nativeint (iconv, pad_opt) ->
+    Param_format_EBB
+      (Nativeint (iconv, pad_of_pad_opt pad_opt, No_precision, fmt))
+  | Ignored_int64 (iconv, pad_opt) ->
+    Param_format_EBB
+      (Int64 (iconv, pad_of_pad_opt pad_opt, No_precision, fmt))
+  | Ignored_float (pad_opt, prec_opt) ->
+    Param_format_EBB
+      (Float ((Float_flag_, Float_f),
+              pad_of_pad_opt pad_opt, prec_of_prec_opt prec_opt, fmt))
+  | Ignored_bool pad_opt ->
+    Param_format_EBB (Bool (pad_of_pad_opt pad_opt, fmt))
+  | Ignored_format_arg (pad_opt, fmtty) ->
+    Param_format_EBB (Format_arg (pad_opt, fmtty, fmt))
+  | Ignored_format_subst (pad_opt, fmtty) ->
+    Param_format_EBB
+      (Format_subst (pad_opt, fmtty, fmt))
+  | Ignored_reader ->
+    Param_format_EBB (Reader fmt)
+  | Ignored_scan_char_set (width_opt, char_set) ->
+    Param_format_EBB (Scan_char_set (width_opt, char_set, fmt))
+  | Ignored_scan_get_counter counter ->
+    Param_format_EBB (Scan_get_counter (counter, fmt))
+  | Ignored_scan_next_char ->
+    Param_format_EBB (Scan_next_char fmt)
+
+
+(******************************************************************************)
+                                 (* Types *)
+
+type ('b, 'c) acc_formatting_gen =
+  | Acc_open_tag of ('b, 'c) acc
+  | Acc_open_box of ('b, 'c) acc
+
+(* Reversed list of printing atoms. *)
+(* Used to accumulate printf arguments. *)
+and ('b, 'c) acc =
+  | Acc_formatting_lit of ('b, 'c) acc * formatting_lit
+      (* Special fmtting (box) *)
+  | Acc_formatting_gen of ('b, 'c) acc * ('b, 'c) acc_formatting_gen
+      (* Special fmtting (box) *)
+  | Acc_string_literal of ('b, 'c) acc * string     (* Literal string *)
+  | Acc_char_literal   of ('b, 'c) acc * char       (* Literal char *)
+  | Acc_data_string    of ('b, 'c) acc * string     (* Generated string *)
+  | Acc_data_char      of ('b, 'c) acc * char       (* Generated char *)
+  | Acc_delay          of ('b, 'c) acc * ('b -> 'c)
+                                                (* Delayed printing (%a, %t) *)
+  | Acc_flush          of ('b, 'c) acc              (* Flush *)
+  | Acc_invalid_arg    of ('b, 'c) acc * string
+      (* Raise Invalid_argument msg *)
+  | End_of_acc
+
+(* List of heterogeneous values. *)
+(* Used to accumulate scanf callback arguments. *)
+type ('a, 'b) heter_list =
+  | Cons : 'c * ('a, 'b) heter_list -> ('c -> 'a, 'b) heter_list
+  | Nil : ('b, 'b) heter_list
+
+(* Existential Black Boxes. *)
+(* Used to abstract some existential type parameters. *)
+
+(* GADT type associating a padding and an fmtty. *)
+(* See the type_padding function. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) padding_fmtty_ebb = Padding_fmtty_EBB :
+     ('x, 'y) padding * ('y, 'b, 'c, 'd, 'e, 'f) fmtty ->
+     ('x, 'b, 'c, 'd, 'e, 'f) padding_fmtty_ebb
+
+(* GADT type associating a padding, a precision and an fmtty. *)
+(* See the type_padprec function. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) padprec_fmtty_ebb = Padprec_fmtty_EBB :
+     ('x, 'y) padding * ('y, 'z) precision * ('z, 'b, 'c, 'd, 'e, 'f) fmtty ->
+     ('x, 'b, 'c, 'd, 'e, 'f) padprec_fmtty_ebb
+
+(* GADT type associating a padding and an fmt. *)
+(* See make_padding_fmt_ebb and parse_format functions. *)
+type ('a, 'b, 'c, 'e, 'f) padding_fmt_ebb = Padding_fmt_EBB :
+     (_, 'x -> 'a) padding *
+     ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+     ('x, 'b, 'c, 'e, 'f) padding_fmt_ebb
+
+(* GADT type associating a precision and an fmt. *)
+(* See make_precision_fmt_ebb and parse_format functions. *)
+type ('a, 'b, 'c, 'e, 'f) precision_fmt_ebb = Precision_fmt_EBB :
+     (_, 'x -> 'a) precision *
+     ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+     ('x, 'b, 'c, 'e, 'f) precision_fmt_ebb
+
+(* GADT type associating a padding, a precision and an fmt. *)
+(* See make_padprec_fmt_ebb and parse_format functions. *)
+type ('p, 'b, 'c, 'e, 'f) padprec_fmt_ebb = Padprec_fmt_EBB :
+     ('x, 'y) padding * ('y, 'p -> 'a) precision *
+     ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+     ('p, 'b, 'c, 'e, 'f) padprec_fmt_ebb
+
+(* Abstract the 'a and 'd parameters of an fmt. *)
+(* Output type of the format parsing function. *)
+type ('b, 'c, 'e, 'f) fmt_ebb = Fmt_EBB :
+     ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+     ('b, 'c, 'e, 'f) fmt_ebb
+
+(* GADT type associating an fmtty and an fmt. *)
+(* See the type_format_gen function. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) fmt_fmtty_ebb = Fmt_fmtty_EBB :
+     ('a, 'b, 'c, 'd, 'y, 'x) fmt *
+     ('x, 'b, 'c, 'y, 'e, 'f) fmtty ->
+     ('a, 'b, 'c, 'd, 'e, 'f) fmt_fmtty_ebb
+
+(* GADT type associating an fmtty and an fmt. *)
+(* See the type_ignored_format_substitution function. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) fmtty_fmt_ebb = Fmtty_fmt_EBB :
+     ('a, 'b, 'c, 'd, 'y, 'x) fmtty *
+     ('x, 'b, 'c, 'y, 'e, 'f) fmt_fmtty_ebb ->
+     ('a, 'b, 'c, 'd, 'e, 'f) fmtty_fmt_ebb
+
+(* Abstract all fmtty type parameters. *)
+(* Used to compare format types. *)
+type fmtty_ebb = Fmtty_EBB : ('a, 'b, 'c, 'd, 'e, 'f) fmtty -> fmtty_ebb
+
+(* Abstract all padding type parameters. *)
+(* Used to compare paddings. *)
+type padding_ebb = Padding_EBB : ('a, 'b) padding -> padding_ebb
+
+(* Abstract all precision type parameters. *)
+(* Used to compare precisions. *)
+type precision_ebb = Precision_EBB : ('a, 'b) precision -> precision_ebb
+
+(******************************************************************************)
+                               (* Constants *)
+
+(* Default precision for float printing. *)
+let default_float_precision fconv =
+  match snd fconv with
+  | Float_f | Float_e | Float_E | Float_g | Float_G | Float_h | Float_H
+  | Float_CF -> -6
+  (* For %h %H and %#F formats, a negative precision means "as many digits as
+     necessary".  For the other FP formats, we take the absolute value
+     of the precision, hence 6 digits by default. *)
+  | Float_F -> 12
+  (* Default precision for OCaml float printing (%F). *)
+
+(******************************************************************************)
+                               (* Externals *)
+
+external format_float: string -> float -> string
+  = "caml_format_float"
+external format_int: string -> int -> string
+  = "caml_format_int"
+external format_int32: string -> int32 -> string
+  = "caml_int32_format"
+external format_nativeint: string -> nativeint -> string
+  = "caml_nativeint_format"
+external format_int64: string -> int64 -> string
+  = "caml_int64_format"
+external hexstring_of_float: float -> int -> char -> string
+  = "caml_hexstring_of_float"
+
+(******************************************************************************)
+                     (* Tools to pretty-print formats *)
+
+(* Type of extensible character buffers. *)
+type buffer = {
+  mutable ind : int;
+  mutable bytes : bytes;
+}
+
+(* Create a fresh buffer. *)
+let buffer_create init_size = { ind = 0; bytes = Bytes.create init_size }
+
+(* Check size of the buffer and grow it if needed. *)
+let buffer_check_size buf overhead =
+  let len = Bytes.length buf.bytes in
+  let min_len = buf.ind + overhead in
+  if min_len > len then (
+    let new_len = max (len * 2) min_len in
+    let new_str = Bytes.create new_len in
+    Bytes.blit buf.bytes 0 new_str 0 len;
+    buf.bytes <- new_str;
+  )
+
+(* Add the character `c' to the buffer `buf'. *)
+let buffer_add_char buf c =
+  buffer_check_size buf 1;
+  Bytes.set buf.bytes buf.ind c;
+  buf.ind <- buf.ind + 1
+
+(* Add the string `s' to the buffer `buf'. *)
+let buffer_add_string buf s =
+  let str_len = String.length s in
+  buffer_check_size buf str_len;
+  String.blit s 0 buf.bytes buf.ind str_len;
+  buf.ind <- buf.ind + str_len
+
+(* Get the content of the buffer. *)
+let buffer_contents buf =
+  Bytes.sub_string buf.bytes 0 buf.ind
+
+(***)
+
+(* Convert an integer conversion to char. *)
+let char_of_iconv iconv = match iconv with
+  | Int_d | Int_pd | Int_sd | Int_Cd -> 'd' | Int_i | Int_pi | Int_si
+  | Int_Ci -> 'i' | Int_x | Int_Cx -> 'x' | Int_X | Int_CX -> 'X' | Int_o
+  | Int_Co -> 'o' | Int_u | Int_Cu -> 'u'
+
+(* Convert a float conversion to char. *)
+(* `cF' will be 'F' for displaying format and 'g' to call libc printf *)
+let char_of_fconv ?(cF='F') fconv = match snd fconv with
+  | Float_f -> 'f' | Float_e -> 'e'
+  | Float_E -> 'E' | Float_g -> 'g'
+  | Float_G -> 'G' | Float_F -> cF
+  | Float_h -> 'h' | Float_H -> 'H'
+  | Float_CF -> 'F'
+
+
+(* Convert a scanning counter to char. *)
+let char_of_counter counter = match counter with
+  | Line_counter  -> 'l'
+  | Char_counter  -> 'n'
+  | Token_counter -> 'N'
+
+(***)
+
+(* Print a char_set in a buffer with the OCaml format lexical convention. *)
+let bprint_char_set buf char_set =
+  let rec print_start set =
+    let is_alone c =
+      let before, after = Char.(chr (code c - 1), chr (code c + 1)) in
+      is_in_char_set set c
+      && not (is_in_char_set set before && is_in_char_set set after) in
+    if is_alone ']' then buffer_add_char buf ']';
+    print_out set 1;
+    if is_alone '-' then buffer_add_char buf '-';
+  and print_out set i =
+    if i < 256 then
+      if is_in_char_set set (char_of_int i) then print_first set i
+      else print_out set (i + 1)
+  and print_first set i =
+    match char_of_int i with
+    | '\255' -> print_char buf 255;
+    | ']' | '-' -> print_out set (i + 1);
+    | _ -> print_second set (i + 1);
+  and print_second set i =
+    if is_in_char_set set (char_of_int i) then
+      match char_of_int i with
+      | '\255' ->
+        print_char buf 254;
+        print_char buf 255;
+      | ']' | '-' when not (is_in_char_set set (char_of_int (i + 1))) ->
+        print_char buf (i - 1);
+        print_out set (i + 1);
+      | _ when not (is_in_char_set set (char_of_int (i + 1))) ->
+        print_char buf (i - 1);
+        print_char buf i;
+        print_out set (i + 2);
+      | _ ->
+        print_in set (i - 1) (i + 2);
+    else (
+      print_char buf (i - 1);
+      print_out set (i + 1);
+    )
+  and print_in set i j =
+    if j = 256 || not (is_in_char_set set (char_of_int j)) then (
+      print_char buf i;
+      print_char buf (int_of_char '-');
+      print_char buf (j - 1);
+      if j < 256 then print_out set (j + 1);
+    ) else
+      print_in set i (j + 1);
+  and print_char buf i = match char_of_int i with
+    | '%' -> buffer_add_char buf '%'; buffer_add_char buf '%';
+    | '@' -> buffer_add_char buf '%'; buffer_add_char buf '@';
+    | c   -> buffer_add_char buf c;
+  in
+  buffer_add_char buf '[';
+  print_start (
+    if is_in_char_set char_set '\000'
+    then ( buffer_add_char buf '^'; rev_char_set char_set )
+    else char_set
+  );
+  buffer_add_char buf ']'
+
+(***)
+
+(* Print a padty in a buffer with the format-like syntax. *)
+let bprint_padty buf padty = match padty with
+  | Left  -> buffer_add_char buf '-'
+  | Right -> ()
+  | Zeros -> buffer_add_char buf '0'
+
+(* Print the '_' of an ignored flag if needed. *)
+let bprint_ignored_flag buf ign_flag =
+  if ign_flag then buffer_add_char buf '_'
+
+(***)
+
+let bprint_pad_opt buf pad_opt = match pad_opt with
+  | None -> ()
+  | Some width -> buffer_add_string buf (Int.to_string width)
+
+(***)
+
+(* Print padding in a buffer with the format-like syntax. *)
+let bprint_padding : type a b . buffer -> (a, b) padding -> unit =
+fun buf pad -> match pad with
+  | No_padding -> ()
+  | Lit_padding (padty, n) ->
+    bprint_padty buf padty;
+    buffer_add_string buf (Int.to_string n);
+  | Arg_padding padty ->
+    bprint_padty buf padty;
+    buffer_add_char buf '*'
+
+(* Print precision in a buffer with the format-like syntax. *)
+let bprint_precision : type a b . buffer -> (a, b) precision -> unit =
+  fun buf prec -> match prec with
+  | No_precision -> ()
+  | Lit_precision n ->
+    buffer_add_char buf '.';
+    buffer_add_string buf (Int.to_string n);
+  | Arg_precision ->
+    buffer_add_string buf ".*"
+
+(***)
+
+(* Print the optional '+', ' ' or '#' associated to an int conversion. *)
+let bprint_iconv_flag buf iconv = match iconv with
+  | Int_pd | Int_pi -> buffer_add_char buf '+'
+  | Int_sd | Int_si -> buffer_add_char buf ' '
+  | Int_Cx | Int_CX | Int_Co | Int_Cd | Int_Ci | Int_Cu ->
+      buffer_add_char buf '#'
+  | Int_d | Int_i | Int_x | Int_X | Int_o | Int_u -> ()
+
+(* Print an complete int format in a buffer (ex: "%3.*d"). *)
+let bprint_int_fmt buf ign_flag iconv pad prec =
+  buffer_add_char buf '%';
+  bprint_ignored_flag buf ign_flag;
+  bprint_iconv_flag buf iconv;
+  bprint_padding buf pad;
+  bprint_precision buf prec;
+  buffer_add_char buf (char_of_iconv iconv)
+
+(* Print a complete int32, nativeint or int64 format in a buffer. *)
+let bprint_altint_fmt buf ign_flag iconv pad prec c =
+  buffer_add_char buf '%';
+  bprint_ignored_flag buf ign_flag;
+  bprint_iconv_flag buf iconv;
+  bprint_padding buf pad;
+  bprint_precision buf prec;
+  buffer_add_char buf c;
+  buffer_add_char buf (char_of_iconv iconv)
+
+(***)
+
+(* Print the optional '+', ' ' and/or '#' associated to a float conversion. *)
+let bprint_fconv_flag buf fconv =
+  begin match fst fconv with
+  | Float_flag_p -> buffer_add_char buf '+'
+  | Float_flag_s -> buffer_add_char buf ' '
+  | Float_flag_ -> () end;
+  match snd fconv with
+  | Float_CF -> buffer_add_char buf '#'
+  | Float_f | Float_e | Float_E | Float_g | Float_G
+  | Float_F | Float_h | Float_H -> ()
+
+(* Print a complete float format in a buffer (ex: "%+*.3f"). *)
+let bprint_float_fmt buf ign_flag fconv pad prec =
+  buffer_add_char buf '%';
+  bprint_ignored_flag buf ign_flag;
+  bprint_fconv_flag buf fconv;
+  bprint_padding buf pad;
+  bprint_precision buf prec;
+  buffer_add_char buf (char_of_fconv fconv)
+
+(* Compute the literal string representation of a Formatting_lit. *)
+(* Used by Printf and Scanf where formatting is not interpreted. *)
+let string_of_formatting_lit formatting_lit = match formatting_lit with
+  | Close_box            -> "@]"
+  | Close_tag            -> "@}"
+  | Break (str, _, _)    -> str
+  | FFlush               -> "@?"
+  | Force_newline        -> "@\n"
+  | Flush_newline        -> "@."
+  | Magic_size (str, _)  -> str
+  | Escaped_at           -> "@@"
+  | Escaped_percent      -> "@%"
+  | Scan_indic c -> "@" ^ (String.make 1 c)
+
+(***)
+
+(* Print a literal char in a buffer, escape '%' by "%%". *)
+let bprint_char_literal buf chr = match chr with
+  | '%' -> buffer_add_string buf "%%"
+  | _ -> buffer_add_char buf chr
+
+(* Print a literal string in a buffer, escape all '%' by "%%". *)
+let bprint_string_literal buf str =
+  for i = 0 to String.length str - 1 do
+    bprint_char_literal buf str.[i]
+  done
+
+(******************************************************************************)
+                          (* Format pretty-printing *)
+
+(* Print a complete format type (an fmtty) in a buffer. *)
+let rec bprint_fmtty : type a b c d e f g h i j k l .
+    buffer -> (a, b, c, d, e, f, g, h, i, j, k, l) fmtty_rel -> unit =
+fun buf fmtty -> match fmtty with
+  | Char_ty rest      -> buffer_add_string buf "%c";  bprint_fmtty buf rest;
+  | String_ty rest    -> buffer_add_string buf "%s";  bprint_fmtty buf rest;
+  | Int_ty rest       -> buffer_add_string buf "%i";  bprint_fmtty buf rest;
+  | Int32_ty rest     -> buffer_add_string buf "%li"; bprint_fmtty buf rest;
+  | Nativeint_ty rest -> buffer_add_string buf "%ni"; bprint_fmtty buf rest;
+  | Int64_ty rest     -> buffer_add_string buf "%Li"; bprint_fmtty buf rest;
+  | Float_ty rest     -> buffer_add_string buf "%f";  bprint_fmtty buf rest;
+  | Bool_ty rest      -> buffer_add_string buf "%B";  bprint_fmtty buf rest;
+  | Alpha_ty rest     -> buffer_add_string buf "%a";  bprint_fmtty buf rest;
+  | Theta_ty rest     -> buffer_add_string buf "%t";  bprint_fmtty buf rest;
+  | Any_ty rest       -> buffer_add_string buf "%?";  bprint_fmtty buf rest;
+  | Reader_ty rest    -> buffer_add_string buf "%r";  bprint_fmtty buf rest;
+
+  | Ignored_reader_ty rest ->
+    buffer_add_string buf "%_r";
+    bprint_fmtty buf rest;
+
+  | Format_arg_ty (sub_fmtty, rest) ->
+    buffer_add_string buf "%{"; bprint_fmtty buf sub_fmtty;
+    buffer_add_string buf "%}"; bprint_fmtty buf rest;
+  | Format_subst_ty (sub_fmtty, _, rest) ->
+    buffer_add_string buf "%("; bprint_fmtty buf sub_fmtty;
+    buffer_add_string buf "%)"; bprint_fmtty buf rest;
+
+  | End_of_fmtty -> ()
+
+(***)
+
+let rec int_of_custom_arity : type a b c .
+  (a, b, c) custom_arity -> int =
+  function
+  | Custom_zero -> 0
+  | Custom_succ x -> 1 + int_of_custom_arity x
+
+(* Print a complete format in a buffer. *)
+let bprint_fmt buf fmt =
+  let rec fmtiter : type a b c d e f .
+      (a, b, c, d, e, f) fmt -> bool -> unit =
+  fun fmt ign_flag -> match fmt with
+    | String (pad, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_padding buf pad; buffer_add_char buf 's';
+      fmtiter rest false;
+    | Caml_string (pad, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_padding buf pad; buffer_add_char buf 'S';
+      fmtiter rest false;
+
+    | Int (iconv, pad, prec, rest) ->
+      bprint_int_fmt buf ign_flag iconv pad prec;
+      fmtiter rest false;
+    | Int32 (iconv, pad, prec, rest) ->
+      bprint_altint_fmt buf ign_flag iconv pad prec 'l';
+      fmtiter rest false;
+    | Nativeint (iconv, pad, prec, rest) ->
+      bprint_altint_fmt buf ign_flag iconv pad prec 'n';
+      fmtiter rest false;
+    | Int64 (iconv, pad, prec, rest) ->
+      bprint_altint_fmt buf ign_flag iconv pad prec 'L';
+      fmtiter rest false;
+    | Float (fconv, pad, prec, rest) ->
+      bprint_float_fmt buf ign_flag fconv pad prec;
+      fmtiter rest false;
+
+    | Char rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 'c'; fmtiter rest false;
+    | Caml_char rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 'C'; fmtiter rest false;
+    | Bool (pad, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_padding buf pad; buffer_add_char buf 'B';
+      fmtiter rest false;
+    | Alpha rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 'a'; fmtiter rest false;
+    | Theta rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 't'; fmtiter rest false;
+    | Custom (arity, _, rest) ->
+      for _i = 1 to int_of_custom_arity arity do
+        buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+        buffer_add_char buf '?';
+      done;
+      fmtiter rest false;
+    | Reader rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 'r'; fmtiter rest false;
+    | Flush rest ->
+      buffer_add_string buf "%!";
+      fmtiter rest ign_flag;
+
+    | String_literal (str, rest) ->
+      bprint_string_literal buf str;
+      fmtiter rest ign_flag;
+    | Char_literal (chr, rest) ->
+      bprint_char_literal buf chr;
+      fmtiter rest ign_flag;
+
+    | Format_arg (pad_opt, fmtty, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_pad_opt buf pad_opt; buffer_add_char buf '{';
+      bprint_fmtty buf fmtty; buffer_add_char buf '%'; buffer_add_char buf '}';
+      fmtiter rest false;
+    | Format_subst (pad_opt, fmtty, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_pad_opt buf pad_opt; buffer_add_char buf '(';
+      bprint_fmtty buf fmtty; buffer_add_char buf '%'; buffer_add_char buf ')';
+      fmtiter rest false;
+
+    | Scan_char_set (width_opt, char_set, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_pad_opt buf width_opt; bprint_char_set buf char_set;
+      fmtiter rest false;
+    | Scan_get_counter (counter, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf (char_of_counter counter);
+      fmtiter rest false;
+    | Scan_next_char rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_string_literal buf "0c"; fmtiter rest false;
+
+    | Ignored_param (ign, rest) ->
+      let Param_format_EBB fmt' = param_format_of_ignored_format ign rest in
+      fmtiter fmt' true;
+
+    | Formatting_lit (fmting_lit, rest) ->
+      bprint_string_literal buf (string_of_formatting_lit fmting_lit);
+      fmtiter rest ign_flag;
+    | Formatting_gen (fmting_gen, rest) ->
+      begin match fmting_gen with
+      | Open_tag (Format (_, str)) ->
+        buffer_add_string buf "@{"; buffer_add_string buf str
+      | Open_box (Format (_, str)) ->
+        buffer_add_string buf "@["; buffer_add_string buf str
+      end;
+      fmtiter rest ign_flag;
+
+    | End_of_format -> ()
+
+  in fmtiter fmt false
+
+(***)
+
+(* Convert a format to string. *)
+let string_of_fmt fmt =
+  let buf = buffer_create 16 in
+  bprint_fmt buf fmt;
+  buffer_contents buf
+
+(******************************************************************************)
+                          (* Type extraction *)
+
+type (_, _) eq = Refl : ('a, 'a) eq
+
+(* Invariant: this function is the identity on values.
+
+   In particular, if (ty1, ty2) have equal values, then
+   (trans (symm ty1) ty2) respects the 'trans' precondition. *)
+let rec symm : type a1 b1 c1 d1 e1 f1 a2 b2 c2 d2 e2 f2 .
+   (a1, b1, c1, d1, e1, f1,
+    a2, b2, c2, d2, e2, f2) fmtty_rel
+-> (a2, b2, c2, d2, e2, f2,
+    a1, b1, c1, d1, e1, f1) fmtty_rel
+= function
+  | Char_ty rest -> Char_ty (symm rest)
+  | Int_ty rest -> Int_ty (symm rest)
+  | Int32_ty rest -> Int32_ty (symm rest)
+  | Int64_ty rest -> Int64_ty (symm rest)
+  | Nativeint_ty rest -> Nativeint_ty (symm rest)
+  | Float_ty rest -> Float_ty (symm rest)
+  | Bool_ty rest -> Bool_ty (symm rest)
+  | String_ty rest -> String_ty (symm rest)
+  | Theta_ty rest -> Theta_ty (symm rest)
+  | Alpha_ty rest -> Alpha_ty (symm rest)
+  | Any_ty rest -> Any_ty (symm rest)
+  | Reader_ty rest -> Reader_ty (symm rest)
+  | Ignored_reader_ty rest -> Ignored_reader_ty (symm rest)
+  | Format_arg_ty (ty, rest) ->
+    Format_arg_ty (ty, symm rest)
+  | Format_subst_ty (ty1, ty2, rest) ->
+    Format_subst_ty (ty2, ty1, symm rest)
+  | End_of_fmtty -> End_of_fmtty
+
+let rec fmtty_rel_det : type a1 b c d1 e1 f1 a2 d2 e2 f2 .
+  (a1, b, c, d1, e1, f1,
+   a2, b, c, d2, e2, f2) fmtty_rel ->
+    ((f1, f2) eq -> (a1, a2) eq)
+  * ((a1, a2) eq -> (f1, f2) eq)
+  * ((e1, e2) eq -> (d1, d2) eq)
+  * ((d1, d2) eq -> (e1, e2) eq)
+= function
+  | End_of_fmtty ->
+    (fun Refl -> Refl),
+    (fun Refl -> Refl),
+    (fun Refl -> Refl),
+    (fun Refl -> Refl)
+  | Char_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | String_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Int_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Int32_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Int64_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Nativeint_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Float_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Bool_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+
+  | Theta_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Alpha_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Any_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Reader_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    (fun Refl -> let Refl = ed Refl in Refl),
+    (fun Refl -> let Refl = de Refl in Refl)
+  | Ignored_reader_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    (fun Refl -> let Refl = ed Refl in Refl),
+    (fun Refl -> let Refl = de Refl in Refl)
+  | Format_arg_ty (_ty, rest) ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Format_subst_ty (ty1, ty2, rest) ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    let ty = trans (symm ty1) ty2 in
+    let ag, ga, dj, jd = fmtty_rel_det ty in
+    (fun Refl -> let Refl = fa Refl in let Refl = ag Refl in Refl),
+    (fun Refl -> let Refl = ga Refl in let Refl = af Refl in Refl),
+    (fun Refl -> let Refl = ed Refl in let Refl = dj Refl in Refl),
+    (fun Refl -> let Refl = jd Refl in let Refl = de Refl in Refl)
+
+(* Precondition: we assume that the two fmtty_rel arguments have equal
+   values (at possibly distinct types); this invariant comes from the way
+   fmtty_rel witnesses are produced by the type-checker
+
+   The code below uses (assert false) when this assumption is broken. The
+   code pattern is the following:
+
+     | Foo x, Foo y ->
+       (* case where indeed both values
+          start with constructor Foo *)
+     | Foo _, _
+     | _, Foo _ ->
+       (* different head constructors: broken precondition *)
+       assert false
+*)
+and trans : type
+  a1 b1 c1 d1 e1 f1
+  a2 b2 c2 d2 e2 f2
+  a3 b3 c3 d3 e3 f3
+.
+   (a1, b1, c1, d1, e1, f1,
+    a2, b2, c2, d2, e2, f2) fmtty_rel
+-> (a2, b2, c2, d2, e2, f2,
+    a3, b3, c3, d3, e3, f3) fmtty_rel
+-> (a1, b1, c1, d1, e1, f1,
+    a3, b3, c3, d3, e3, f3) fmtty_rel
+= fun ty1 ty2 -> match ty1, ty2 with
+  | Char_ty rest1, Char_ty rest2 -> Char_ty (trans rest1 rest2)
+  | String_ty rest1, String_ty rest2 -> String_ty (trans rest1 rest2)
+  | Bool_ty rest1, Bool_ty rest2 -> Bool_ty (trans rest1 rest2)
+  | Int_ty rest1, Int_ty rest2 -> Int_ty (trans rest1 rest2)
+  | Int32_ty rest1, Int32_ty rest2 -> Int32_ty (trans rest1 rest2)
+  | Int64_ty rest1, Int64_ty rest2 -> Int64_ty (trans rest1 rest2)
+  | Nativeint_ty rest1, Nativeint_ty rest2 -> Nativeint_ty (trans rest1 rest2)
+  | Float_ty rest1, Float_ty rest2 -> Float_ty (trans rest1 rest2)
+
+  | Alpha_ty rest1, Alpha_ty rest2 -> Alpha_ty (trans rest1 rest2)
+  | Alpha_ty _, _ -> assert false
+  | _, Alpha_ty _ -> assert false
+
+  | Theta_ty rest1, Theta_ty rest2 -> Theta_ty (trans rest1 rest2)
+  | Theta_ty _, _ -> assert false
+  | _, Theta_ty _ -> assert false
+
+  | Any_ty rest1, Any_ty rest2 -> Any_ty (trans rest1 rest2)
+  | Any_ty _, _ -> assert false
+  | _, Any_ty _ -> assert false
+
+  | Reader_ty rest1, Reader_ty rest2 -> Reader_ty (trans rest1 rest2)
+  | Reader_ty _, _ -> assert false
+  | _, Reader_ty _ -> assert false
+
+  | Ignored_reader_ty rest1, Ignored_reader_ty rest2 ->
+    Ignored_reader_ty (trans rest1 rest2)
+  | Ignored_reader_ty _, _ -> assert false
+  | _, Ignored_reader_ty _ -> assert false
+
+  | Format_arg_ty (ty1, rest1), Format_arg_ty (ty2, rest2) ->
+    Format_arg_ty (trans ty1 ty2, trans rest1 rest2)
+  | Format_arg_ty _, _ -> assert false
+  | _, Format_arg_ty _ -> assert false
+
+  | Format_subst_ty (ty11, ty12, rest1),
+    Format_subst_ty (ty21, ty22, rest2) ->
+    let ty = trans (symm ty12) ty21 in
+    let _, f2, _, f4 = fmtty_rel_det ty in
+    let Refl = f2 Refl in
+    let Refl = f4 Refl in
+    Format_subst_ty (ty11, ty22, trans rest1 rest2)
+  | Format_subst_ty _, _ -> assert false
+  | _, Format_subst_ty _ -> assert false
+
+  | End_of_fmtty, End_of_fmtty -> End_of_fmtty
+  | End_of_fmtty, _ -> assert false
+  | _, End_of_fmtty -> assert false
+
+let rec fmtty_of_formatting_gen : type a b c d e f .
+  (a, b, c, d, e, f) formatting_gen ->
+    (a, b, c, d, e, f) fmtty =
+fun formatting_gen -> match formatting_gen with
+  | Open_tag (Format (fmt, _)) -> fmtty_of_fmt fmt
+  | Open_box (Format (fmt, _)) -> fmtty_of_fmt fmt
+
+(* Extract the type representation (an fmtty) of a format. *)
+and fmtty_of_fmt : type a b c d e f .
+  (a, b, c, d, e, f) fmt -> (a, b, c, d, e, f) fmtty =
+fun fmtty -> match fmtty with
+  | String (pad, rest) ->
+    fmtty_of_padding_fmtty pad (String_ty (fmtty_of_fmt rest))
+  | Caml_string (pad, rest) ->
+    fmtty_of_padding_fmtty pad (String_ty (fmtty_of_fmt rest))
+
+  | Int (_, pad, prec, rest) ->
+    let ty_rest = fmtty_of_fmt rest in
+    let prec_ty = fmtty_of_precision_fmtty prec (Int_ty ty_rest) in
+    fmtty_of_padding_fmtty pad prec_ty
+  | Int32 (_, pad, prec, rest) ->
+    let ty_rest = fmtty_of_fmt rest in
+    let prec_ty = fmtty_of_precision_fmtty prec (Int32_ty ty_rest) in
+    fmtty_of_padding_fmtty pad prec_ty
+  | Nativeint (_, pad, prec, rest) ->
+    let ty_rest = fmtty_of_fmt rest in
+    let prec_ty = fmtty_of_precision_fmtty prec (Nativeint_ty ty_rest) in
+    fmtty_of_padding_fmtty pad prec_ty
+  | Int64 (_, pad, prec, rest) ->
+    let ty_rest = fmtty_of_fmt rest in
+    let prec_ty = fmtty_of_precision_fmtty prec (Int64_ty ty_rest) in
+    fmtty_of_padding_fmtty pad prec_ty
+  | Float (_, pad, prec, rest) ->
+    let ty_rest = fmtty_of_fmt rest in
+    let prec_ty = fmtty_of_precision_fmtty prec (Float_ty ty_rest) in
+    fmtty_of_padding_fmtty pad prec_ty
+
+  | Char rest                  -> Char_ty (fmtty_of_fmt rest)
+  | Caml_char rest             -> Char_ty (fmtty_of_fmt rest)
+  | Bool (pad, rest)           ->
+      fmtty_of_padding_fmtty pad (Bool_ty (fmtty_of_fmt rest))
+  | Alpha rest                 -> Alpha_ty (fmtty_of_fmt rest)
+  | Theta rest                 -> Theta_ty (fmtty_of_fmt rest)
+  | Custom (arity, _, rest)    -> fmtty_of_custom arity (fmtty_of_fmt rest)
+  | Reader rest                -> Reader_ty (fmtty_of_fmt rest)
+
+  | Format_arg (_, ty, rest) ->
+    Format_arg_ty (ty, fmtty_of_fmt rest)
+  | Format_subst (_, ty, rest) ->
+    Format_subst_ty (ty, ty, fmtty_of_fmt rest)
+
+  | Flush rest                 -> fmtty_of_fmt rest
+  | String_literal (_, rest)   -> fmtty_of_fmt rest
+  | Char_literal (_, rest)     -> fmtty_of_fmt rest
+
+  | Scan_char_set (_, _, rest) -> String_ty (fmtty_of_fmt rest)
+  | Scan_get_counter (_, rest) -> Int_ty (fmtty_of_fmt rest)
+  | Scan_next_char rest        -> Char_ty (fmtty_of_fmt rest)
+  | Ignored_param (ign, rest)  -> fmtty_of_ignored_format ign rest
+  | Formatting_lit (_, rest)   -> fmtty_of_fmt rest
+  | Formatting_gen (fmting_gen, rest)  ->
+    concat_fmtty (fmtty_of_formatting_gen fmting_gen) (fmtty_of_fmt rest)
+
+  | End_of_format              -> End_of_fmtty
+
+and fmtty_of_custom : type x y a b c d e f .
+  (a, x, y) custom_arity -> (a, b, c, d, e, f) fmtty ->
+  (y, b, c, d, e, f) fmtty =
+fun arity fmtty -> match arity with
+  | Custom_zero -> fmtty
+  | Custom_succ arity -> Any_ty (fmtty_of_custom arity fmtty)
+
+(* Extract the fmtty of an ignored parameter followed by the rest of
+   the format. *)
+and fmtty_of_ignored_format : type x y a b c d e f .
+    (a, b, c, d, y, x) ignored ->
+    (x, b, c, y, e, f) fmt ->
+    (a, b, c, d, e, f) fmtty =
+fun ign fmt -> match ign with
+  | Ignored_char                    -> fmtty_of_fmt fmt
+  | Ignored_caml_char               -> fmtty_of_fmt fmt
+  | Ignored_string _                -> fmtty_of_fmt fmt
+  | Ignored_caml_string _           -> fmtty_of_fmt fmt
+  | Ignored_int (_, _)              -> fmtty_of_fmt fmt
+  | Ignored_int32 (_, _)            -> fmtty_of_fmt fmt
+  | Ignored_nativeint (_, _)        -> fmtty_of_fmt fmt
+  | Ignored_int64 (_, _)            -> fmtty_of_fmt fmt
+  | Ignored_float (_, _)            -> fmtty_of_fmt fmt
+  | Ignored_bool _                  -> fmtty_of_fmt fmt
+  | Ignored_format_arg _            -> fmtty_of_fmt fmt
+  | Ignored_format_subst (_, fmtty) -> concat_fmtty fmtty (fmtty_of_fmt fmt)
+  | Ignored_reader                  -> Ignored_reader_ty (fmtty_of_fmt fmt)
+  | Ignored_scan_char_set _         -> fmtty_of_fmt fmt
+  | Ignored_scan_get_counter _      -> fmtty_of_fmt fmt
+  | Ignored_scan_next_char          -> fmtty_of_fmt fmt
+
+(* Add an Int_ty node if padding is taken as an extra argument (ex: "%*s"). *)
+and fmtty_of_padding_fmtty : type x a b c d e f .
+    (x, a) padding -> (a, b, c, d, e, f) fmtty -> (x, b, c, d, e, f) fmtty =
+  fun pad fmtty -> match pad with
+    | No_padding    -> fmtty
+    | Lit_padding _ -> fmtty
+    | Arg_padding _ -> Int_ty fmtty
+
+(* Add an Int_ty node if precision is taken as an extra argument (ex: "%.*f").*)
+and fmtty_of_precision_fmtty : type x a b c d e f .
+    (x, a) precision -> (a, b, c, d, e, f) fmtty -> (x, b, c, d, e, f) fmtty =
+  fun prec fmtty -> match prec with
+    | No_precision    -> fmtty
+    | Lit_precision _ -> fmtty
+    | Arg_precision   -> Int_ty fmtty
+
+(******************************************************************************)
+                            (* Format typing *)
+
+(* Exception raised when a format does not match a given format type. *)
+exception Type_mismatch
+
+(* Type a padding. *)
+(* Take an Int_ty from the fmtty if the integer should be kept as argument. *)
+(* Raise Type_mismatch in case of type mismatch. *)
+let type_padding : type a b c d e f x y .
+    (x, y) padding -> (a, b, c, d, e, f) fmtty ->
+      (a, b, c, d, e, f) padding_fmtty_ebb =
+fun pad fmtty -> match pad, fmtty with
+  | No_padding, _ -> Padding_fmtty_EBB (No_padding, fmtty)
+  | Lit_padding (padty, w), _ -> Padding_fmtty_EBB (Lit_padding (padty,w),fmtty)
+  | Arg_padding padty, Int_ty rest -> Padding_fmtty_EBB (Arg_padding padty,rest)
+  | _ -> raise Type_mismatch
+
+(* Convert a (upadding, uprecision) to a (padding, precision). *)
+(* Take one or two Int_ty from the fmtty if needed. *)
+(* Raise Type_mismatch in case of type mismatch. *)
+let type_padprec : type a b c d e f x y z .
+  (x, y) padding -> (y, z) precision -> (a, b, c, d, e, f) fmtty ->
+    (a, b, c, d, e, f) padprec_fmtty_ebb =
+fun pad prec fmtty -> match prec, type_padding pad fmtty with
+  | No_precision, Padding_fmtty_EBB (pad, rest) ->
+    Padprec_fmtty_EBB (pad, No_precision, rest)
+  | Lit_precision p, Padding_fmtty_EBB (pad, rest) ->
+    Padprec_fmtty_EBB (pad, Lit_precision p, rest)
+  | Arg_precision, Padding_fmtty_EBB (pad, Int_ty rest) ->
+    Padprec_fmtty_EBB (pad, Arg_precision, rest)
+  | _, Padding_fmtty_EBB (_, _) -> raise Type_mismatch
+
+(* Type a format according to an fmtty. *)
+(* If typing succeed, generate a copy of the format with the same
+    type parameters as the fmtty. *)
+(* Raise [Failure] with an error message in case of type mismatch. *)
+let rec type_format :
+  type a1 b1 c1 d1 e1 f1
+       a2 b2 c2 d2 e2 f2  .
+     (a1, b1, c1, d1, e1, f1) fmt
+  -> (a2, b2, c2, d2, e2, f2) fmtty
+  -> (a2, b2, c2, d2, e2, f2) fmt
+= fun fmt fmtty -> match type_format_gen fmt fmtty with
+  | Fmt_fmtty_EBB (fmt', End_of_fmtty) -> fmt'
+  | _ -> raise Type_mismatch
+
+and type_format_gen :
+  type a1 b1 c1 d1 e1 f1
+       a2 b2 c2 d2 e2 f2  .
+     (a1, b1, c1, d1, e1, f1) fmt
+  -> (a2, b2, c2, d2, e2, f2) fmtty
+  -> (a2, b2, c2, d2, e2, f2) fmt_fmtty_ebb
+= fun fmt fmtty -> match fmt, fmtty with
+  | Char fmt_rest, Char_ty fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Char fmt', fmtty')
+  | Caml_char fmt_rest, Char_ty fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Caml_char fmt', fmtty')
+  | String (pad, fmt_rest), _ -> (
+    match type_padding pad fmtty with
+    | Padding_fmtty_EBB (pad, String_ty fmtty_rest) ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (String (pad, fmt'), fmtty')
+    | Padding_fmtty_EBB (_, _) -> raise Type_mismatch
+  )
+  | Caml_string (pad, fmt_rest), _ -> (
+    match type_padding pad fmtty with
+    | Padding_fmtty_EBB (pad, String_ty fmtty_rest) ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Caml_string (pad, fmt'), fmtty')
+    | Padding_fmtty_EBB (_, _) -> raise Type_mismatch
+  )
+  | Int (iconv, pad, prec, fmt_rest), _ -> (
+    match type_padprec pad prec fmtty with
+    | Padprec_fmtty_EBB (pad, prec, Int_ty fmtty_rest) ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Int (iconv, pad, prec, fmt'), fmtty')
+    | Padprec_fmtty_EBB (_, _, _) -> raise Type_mismatch
+  )
+  | Int32 (iconv, pad, prec, fmt_rest), _ -> (
+    match type_padprec pad prec fmtty with
+    | Padprec_fmtty_EBB (pad, prec, Int32_ty fmtty_rest) ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Int32 (iconv, pad, prec, fmt'), fmtty')
+    | Padprec_fmtty_EBB (_, _, _) -> raise Type_mismatch
+  )
+  | Nativeint (iconv, pad, prec, fmt_rest), _ -> (
+    match type_padprec pad prec fmtty with
+    | Padprec_fmtty_EBB (pad, prec, Nativeint_ty fmtty_rest) ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Nativeint (iconv, pad, prec, fmt'), fmtty')
+    | Padprec_fmtty_EBB (_, _, _) -> raise Type_mismatch
+  )
+  | Int64 (iconv, pad, prec, fmt_rest), _ -> (
+    match type_padprec pad prec fmtty with
+    | Padprec_fmtty_EBB (pad, prec, Int64_ty fmtty_rest) ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Int64 (iconv, pad, prec, fmt'), fmtty')
+    | Padprec_fmtty_EBB (_, _, _) -> raise Type_mismatch
+  )
+  | Float (fconv, pad, prec, fmt_rest), _ -> (
+    match type_padprec pad prec fmtty with
+    | Padprec_fmtty_EBB (pad, prec, Float_ty fmtty_rest) ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Float (fconv, pad, prec, fmt'), fmtty')
+    | Padprec_fmtty_EBB (_, _, _) -> raise Type_mismatch
+  )
+  | Bool (pad, fmt_rest), _ -> (
+    match type_padding pad fmtty with
+    | Padding_fmtty_EBB (pad, Bool_ty fmtty_rest) ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Bool (pad, fmt'), fmtty')
+    | Padding_fmtty_EBB (_, _) -> raise Type_mismatch
+  )
+  | Flush fmt_rest, fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Flush fmt', fmtty')
+
+  | String_literal (str, fmt_rest), fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (String_literal (str, fmt'), fmtty')
+  | Char_literal (chr, fmt_rest), fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Char_literal (chr, fmt'), fmtty')
+
+  | Format_arg (pad_opt, sub_fmtty, fmt_rest),
+    Format_arg_ty (sub_fmtty', fmtty_rest) ->
+    if Fmtty_EBB sub_fmtty <> Fmtty_EBB sub_fmtty' then raise Type_mismatch;
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Format_arg (pad_opt, sub_fmtty', fmt'), fmtty')
+  | Format_subst (pad_opt, sub_fmtty, fmt_rest),
+    Format_subst_ty (sub_fmtty1, _sub_fmtty2, fmtty_rest) ->
+    if Fmtty_EBB (erase_rel sub_fmtty) <> Fmtty_EBB (erase_rel sub_fmtty1) then
+      raise Type_mismatch;
+    let Fmt_fmtty_EBB (fmt', fmtty') =
+      type_format_gen fmt_rest (erase_rel fmtty_rest)
+    in
+    Fmt_fmtty_EBB (Format_subst (pad_opt, sub_fmtty1, fmt'), fmtty')
+  (* Printf and Format specific constructors: *)
+  | Alpha fmt_rest, Alpha_ty fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Alpha fmt', fmtty')
+  | Theta fmt_rest, Theta_ty fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Theta fmt', fmtty')
+
+  (* Format specific constructors: *)
+  | Formatting_lit (formatting_lit, fmt_rest), fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Formatting_lit (formatting_lit, fmt'), fmtty')
+  | Formatting_gen (formatting_gen, fmt_rest), fmtty_rest ->
+    type_formatting_gen formatting_gen fmt_rest fmtty_rest
+
+  (* Scanf specific constructors: *)
+  | Reader fmt_rest, Reader_ty fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Reader fmt', fmtty')
+  | Scan_char_set (width_opt, char_set, fmt_rest), String_ty fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Scan_char_set (width_opt, char_set, fmt'), fmtty')
+  | Scan_get_counter (counter, fmt_rest), Int_ty fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Scan_get_counter (counter, fmt'), fmtty')
+  | Ignored_param (ign, rest), fmtty_rest ->
+    type_ignored_param ign rest fmtty_rest
+
+  | End_of_format, fmtty_rest -> Fmt_fmtty_EBB (End_of_format, fmtty_rest)
+
+  | _ -> raise Type_mismatch
+
+and type_formatting_gen : type a1 a3 b1 b3 c1 c3 d1 d3 e1 e2 e3 f1 f2 f3 .
+    (a1, b1, c1, d1, e1, f1) formatting_gen ->
+    (f1, b1, c1, e1, e2, f2) fmt ->
+    (a3, b3, c3, d3, e3, f3) fmtty ->
+    (a3, b3, c3, d3, e3, f3) fmt_fmtty_ebb =
+fun formatting_gen fmt0 fmtty0 -> match formatting_gen with
+  | Open_tag (Format (fmt1, str)) ->
+    let Fmt_fmtty_EBB (fmt2, fmtty2) = type_format_gen fmt1 fmtty0 in
+    let Fmt_fmtty_EBB (fmt3, fmtty3) = type_format_gen fmt0 fmtty2 in
+    Fmt_fmtty_EBB (Formatting_gen (Open_tag (Format (fmt2, str)), fmt3), fmtty3)
+  | Open_box (Format (fmt1, str)) ->
+    let Fmt_fmtty_EBB (fmt2, fmtty2) = type_format_gen fmt1 fmtty0 in
+    let Fmt_fmtty_EBB (fmt3, fmtty3) = type_format_gen fmt0 fmtty2 in
+    Fmt_fmtty_EBB (Formatting_gen (Open_box (Format (fmt2, str)), fmt3), fmtty3)
+
+(* Type an Ignored_param node according to an fmtty. *)
+and type_ignored_param : type p q x y z t u v a b c d e f .
+    (x, y, z, t, q, p) ignored ->
+    (p, y, z, q, u, v) fmt ->
+    (a, b, c, d, e, f) fmtty ->
+    (a, b, c, d, e, f) fmt_fmtty_ebb =
+fun ign fmt fmtty -> match ign with
+  | Ignored_char               as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_caml_char          as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_string _           as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_caml_string _      as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_int _              as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_int32 _            as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_nativeint _        as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_int64 _            as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_float _            as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_bool _             as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_scan_char_set _    as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_scan_get_counter _ as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_scan_next_char     as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_format_arg (pad_opt, sub_fmtty) ->
+    type_ignored_param_one (Ignored_format_arg (pad_opt, sub_fmtty)) fmt fmtty
+  | Ignored_format_subst (pad_opt, sub_fmtty) ->
+    let Fmtty_fmt_EBB (sub_fmtty', Fmt_fmtty_EBB (fmt', fmtty')) =
+      type_ignored_format_substitution sub_fmtty fmt fmtty in
+    Fmt_fmtty_EBB (Ignored_param (Ignored_format_subst (pad_opt, sub_fmtty'),
+                                  fmt'),
+                   fmtty')
+  | Ignored_reader -> (
+    match fmtty with
+    | Ignored_reader_ty fmtty_rest ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt fmtty_rest in
+      Fmt_fmtty_EBB (Ignored_param (Ignored_reader, fmt'), fmtty')
+    | _ -> raise Type_mismatch
+  )
+
+and type_ignored_param_one : type a1 a2 b1 b2 c1 c2 d1 d2 e1 e2 f1 f2 .
+    (a2, b2, c2, d2, d2, a2) ignored ->
+    (a1, b1, c1, d1, e1, f1) fmt ->
+    (a2, b2, c2, d2, e2, f2) fmtty ->
+    (a2, b2, c2, d2, e2, f2) fmt_fmtty_ebb
+= fun ign fmt fmtty ->
+  let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt fmtty in
+  Fmt_fmtty_EBB (Ignored_param (ign, fmt'), fmtty')
+
+(* Typing of the complex case: "%_(...%)". *)
+and type_ignored_format_substitution : type w x y z p s t u a b c d e f .
+    (w, x, y, z, s, p) fmtty ->
+    (p, x, y, s, t, u) fmt ->
+    (a, b, c, d, e, f) fmtty -> (a, b, c, d, e, f) fmtty_fmt_ebb =
+fun sub_fmtty fmt fmtty -> match sub_fmtty, fmtty with
+  | Char_ty sub_fmtty_rest, Char_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Char_ty sub_fmtty_rest', fmt')
+  | String_ty sub_fmtty_rest, String_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (String_ty sub_fmtty_rest', fmt')
+  | Int_ty sub_fmtty_rest, Int_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Int_ty sub_fmtty_rest', fmt')
+  | Int32_ty sub_fmtty_rest, Int32_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Int32_ty sub_fmtty_rest', fmt')
+  | Nativeint_ty sub_fmtty_rest, Nativeint_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Nativeint_ty sub_fmtty_rest', fmt')
+  | Int64_ty sub_fmtty_rest, Int64_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Int64_ty sub_fmtty_rest', fmt')
+  | Float_ty sub_fmtty_rest, Float_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Float_ty sub_fmtty_rest', fmt')
+  | Bool_ty sub_fmtty_rest, Bool_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Bool_ty sub_fmtty_rest', fmt')
+  | Alpha_ty sub_fmtty_rest, Alpha_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Alpha_ty sub_fmtty_rest', fmt')
+  | Theta_ty sub_fmtty_rest, Theta_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Theta_ty sub_fmtty_rest', fmt')
+  | Reader_ty sub_fmtty_rest, Reader_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Reader_ty sub_fmtty_rest', fmt')
+  | Ignored_reader_ty sub_fmtty_rest, Ignored_reader_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Ignored_reader_ty sub_fmtty_rest', fmt')
+
+  | Format_arg_ty (sub2_fmtty, sub_fmtty_rest),
+    Format_arg_ty (sub2_fmtty', fmtty_rest) ->
+    if Fmtty_EBB sub2_fmtty <> Fmtty_EBB sub2_fmtty' then raise Type_mismatch;
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Format_arg_ty (sub2_fmtty', sub_fmtty_rest'), fmt')
+  | Format_subst_ty (sub1_fmtty,  sub2_fmtty,  sub_fmtty_rest),
+    Format_subst_ty (sub1_fmtty', sub2_fmtty', fmtty_rest) ->
+    (* TODO define Fmtty_rel_EBB to remove those erase_rel *)
+    if Fmtty_EBB (erase_rel sub1_fmtty) <> Fmtty_EBB (erase_rel sub1_fmtty')
+    then raise Type_mismatch;
+    if Fmtty_EBB (erase_rel sub2_fmtty) <> Fmtty_EBB (erase_rel sub2_fmtty')
+    then raise Type_mismatch;
+    let sub_fmtty' = trans (symm sub1_fmtty') sub2_fmtty' in
+    let _, f2, _, f4 = fmtty_rel_det sub_fmtty' in
+    let Refl = f2 Refl in
+    let Refl = f4 Refl in
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution (erase_rel sub_fmtty_rest) fmt fmtty_rest
+    in
+    Fmtty_fmt_EBB (Format_subst_ty (sub1_fmtty', sub2_fmtty',
+                                    symm sub_fmtty_rest'),
+                   fmt')
+  | End_of_fmtty, fmtty ->
+    Fmtty_fmt_EBB (End_of_fmtty, type_format_gen fmt fmtty)
+  | _ -> raise Type_mismatch
+
+(* This implementation of `recast` is a bit disappointing. The
+   invariant provided by the type are very strong: the input format's
+   type is in relation to the output type's as witnessed by the
+   fmtty_rel argument. One would at first expect this function to be
+   total, and implementable by exhaustive pattern matching. Instead,
+   we reuse the highly partial and much less well-defined function
+   `type_format` that has lost all knowledge of the correspondence
+   between the argument's types.
+
+   Besides the fact that this function reuses a lot of the
+   `type_format` logic (eg.: seeing Int_ty in the fmtty parameter does
+   not let you match on Int only, as you may in fact have Float
+   (Arg_padding, ...) ("%.*d") beginning with an Int_ty), it is also
+   a partial function, because the typing information in a format is
+   not quite enough to reconstruct it unambiguously. For example, the
+   format types of "%d%_r" and "%_r%d" have the same format6
+   parameters, but they are not at all exchangeable, and putting one
+   in place of the other must result in a dynamic failure.
+
+   Given that:
+   - we'd have to duplicate a lot of non-trivial typing logic from type_format
+   - this wouldn't even eliminate (all) the dynamic failures
+   we decided to just reuse type_format directly for now.
+*)
+let recast :
+  type a1 b1 c1 d1 e1 f1
+       a2 b2 c2 d2 e2 f2
+  .
+     (a1, b1, c1, d1, e1, f1) fmt
+  -> (a1, b1, c1, d1, e1, f1,
+      a2, b2, c2, d2, e2, f2) fmtty_rel
+  -> (a2, b2, c2, d2, e2, f2) fmt
+= fun fmt fmtty ->
+  type_format fmt (erase_rel (symm fmtty))
+
+(******************************************************************************)
+                             (* Printing tools *)
+
+(* Add padding spaces around a string. *)
+let fix_padding padty width str =
+  let len = String.length str in
+  let width, padty =
+    abs width,
+    (* while literal padding widths are always non-negative,
+       dynamically-set widths (Arg_padding, eg. %*d) may be negative;
+       we interpret those as specifying a padding-to-the-left; this
+       means that '0' may get dropped even if it was explicitly set,
+       but:
+       - this is what the legacy implementation does, and
+         we preserve compatibility if possible
+       - we could only signal this issue by failing at runtime,
+         which is not very nice... *)
+    if width < 0 then Left else padty in
+  if width <= len then str else
+    let res = Bytes.make width (if padty = Zeros then '0' else ' ') in
+    begin match padty with
+    | Left  -> String.blit str 0 res 0 len
+    | Right -> String.blit str 0 res (width - len) len
+    | Zeros when len > 0 && (str.[0] = '+' || str.[0] = '-' || str.[0] = ' ') ->
+      Bytes.set res 0 str.[0];
+      String.blit str 1 res (width - len + 1) (len - 1)
+    | Zeros when len > 1 && str.[0] = '0' && (str.[1] = 'x' || str.[1] = 'X') ->
+      Bytes.set res 1 str.[1];
+      String.blit str 2 res (width - len + 2) (len - 2)
+    | Zeros ->
+      String.blit str 0 res (width - len) len
+    end;
+    Bytes.unsafe_to_string res
+
+(* Add '0' padding to int, int32, nativeint or int64 string representation. *)
+let fix_int_precision prec str =
+  let prec = abs prec in
+  let len = String.length str in
+  match str.[0] with
+  | ('+' | '-' | ' ') as c when prec + 1 > len ->
+    let res = Bytes.make (prec + 1) '0' in
+    Bytes.set res 0 c;
+    String.blit str 1 res (prec - len + 2) (len - 1);
+    Bytes.unsafe_to_string res
+  | '0' when prec + 2 > len && len > 1 && (str.[1] = 'x' || str.[1] = 'X') ->
+    let res = Bytes.make (prec + 2) '0' in
+    Bytes.set res 1 str.[1];
+    String.blit str 2 res (prec - len + 4) (len - 2);
+    Bytes.unsafe_to_string res
+  | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' when prec > len ->
+    let res = Bytes.make prec '0' in
+    String.blit str 0 res (prec - len) len;
+    Bytes.unsafe_to_string res
+  | _ ->
+    str
+
+(* Escape a string according to the OCaml lexing convention. *)
+let string_to_caml_string str =
+  let str = String.escaped str in
+  let l = String.length str in
+  let res = Bytes.make (l + 2) '\"' in
+  String.unsafe_blit str 0 res 1 l;
+  Bytes.unsafe_to_string res
+
+(* Generate the format_int/int32/nativeint/int64 first argument
+   from an int_conv. *)
+let format_of_iconv = function
+  | Int_d | Int_Cd -> "%d" | Int_pd -> "%+d" | Int_sd -> "% d"
+  | Int_i | Int_Ci -> "%i" | Int_pi -> "%+i" | Int_si -> "% i"
+  | Int_x -> "%x" | Int_Cx -> "%#x"
+  | Int_X -> "%X" | Int_CX -> "%#X"
+  | Int_o -> "%o" | Int_Co -> "%#o"
+  | Int_u | Int_Cu -> "%u"
+
+let format_of_iconvL = function
+  | Int_d | Int_Cd -> "%Ld" | Int_pd -> "%+Ld" | Int_sd -> "% Ld"
+  | Int_i | Int_Ci -> "%Li" | Int_pi -> "%+Li" | Int_si -> "% Li"
+  | Int_x -> "%Lx" | Int_Cx -> "%#Lx"
+  | Int_X -> "%LX" | Int_CX -> "%#LX"
+  | Int_o -> "%Lo" | Int_Co -> "%#Lo"
+  | Int_u | Int_Cu -> "%Lu"
+
+let format_of_iconvl = function
+  | Int_d | Int_Cd -> "%ld" | Int_pd -> "%+ld" | Int_sd -> "% ld"
+  | Int_i | Int_Ci -> "%li" | Int_pi -> "%+li" | Int_si -> "% li"
+  | Int_x -> "%lx" | Int_Cx -> "%#lx"
+  | Int_X -> "%lX" | Int_CX -> "%#lX"
+  | Int_o -> "%lo" | Int_Co -> "%#lo"
+  | Int_u | Int_Cu -> "%lu"
+
+let format_of_iconvn = function
+  | Int_d | Int_Cd -> "%nd" | Int_pd -> "%+nd" | Int_sd -> "% nd"
+  | Int_i | Int_Ci -> "%ni" | Int_pi -> "%+ni" | Int_si -> "% ni"
+  | Int_x -> "%nx" | Int_Cx -> "%#nx"
+  | Int_X -> "%nX" | Int_CX -> "%#nX"
+  | Int_o -> "%no" | Int_Co -> "%#no"
+  | Int_u | Int_Cu -> "%nu"
+
+(* Generate the format_float first argument from a float_conv. *)
+let format_of_fconv fconv prec =
+    let prec = abs prec in
+    let symb = char_of_fconv ~cF:'g' fconv in
+    let buf = buffer_create 16 in
+    buffer_add_char buf '%';
+    bprint_fconv_flag buf fconv;
+    buffer_add_char buf '.';
+    buffer_add_string buf (Int.to_string prec);
+    buffer_add_char buf symb;
+    buffer_contents buf
+
+let transform_int_alt iconv s =
+  match iconv with
+  | Int_Cd | Int_Ci | Int_Cu ->
+    let digits =
+      let n = ref 0 in
+      for i = 0 to String.length s - 1 do
+        match String.unsafe_get s i with
+        | '0'..'9' -> incr n
+        | _ -> ()
+      done;
+      !n
+    in
+    let buf = Bytes.create (String.length s + (digits - 1) / 3) in
+    let pos = ref 0 in
+    let put c = Bytes.set buf !pos c; incr pos in
+    let left = ref ((digits - 1) mod 3 + 1) in
+    for i = 0 to String.length s - 1 do
+      match String.unsafe_get s i with
+      | '0'..'9' as c ->
+          if !left = 0 then (put '_'; left := 3); decr left; put c
+      | c -> put c
+    done;
+    Bytes.unsafe_to_string buf
+  | _ -> s
+
+(* Convert an integer to a string according to a conversion. *)
+let convert_int iconv n =
+  transform_int_alt iconv (format_int (format_of_iconv iconv) n)
+let convert_int32 iconv n =
+  transform_int_alt iconv (format_int32 (format_of_iconvl iconv) n)
+let convert_nativeint iconv n =
+  transform_int_alt iconv (format_nativeint (format_of_iconvn iconv) n)
+let convert_int64 iconv n =
+  transform_int_alt iconv (format_int64 (format_of_iconvL iconv) n)
+
+(* Convert a float to string. *)
+(* Fix special case of "OCaml float format". *)
+let convert_float fconv prec x =
+  let hex () =
+    let sign =
+      match fst fconv with
+      | Float_flag_p -> '+'
+      | Float_flag_s -> ' '
+      | _ -> '-' in
+    hexstring_of_float x prec sign in
+  let add_dot_if_needed str =
+    let len = String.length str in
+    let rec is_valid i =
+      if i = len then false else
+        match str.[i] with
+        | '.' | 'e' | 'E' -> true
+        | _ -> is_valid (i + 1) in
+    if is_valid 0 then str else str ^ "." in
+  let caml_special_val str = match classify_float x with
+    | FP_normal | FP_subnormal | FP_zero -> str
+    | FP_infinite -> if x < 0.0 then "neg_infinity" else "infinity"
+    | FP_nan -> "nan" in
+  match snd fconv with
+  | Float_h -> hex ()
+  | Float_H -> String.uppercase_ascii (hex ())
+  | Float_CF -> caml_special_val (hex ())
+  | Float_F ->
+    let str = format_float (format_of_fconv fconv prec) x in
+    caml_special_val (add_dot_if_needed str)
+  | Float_f | Float_e | Float_E | Float_g | Float_G ->
+    format_float (format_of_fconv fconv prec) x
+
+(* Convert a char to a string according to the OCaml lexical convention. *)
+let format_caml_char c =
+  let str = Char.escaped c in
+  let l = String.length str in
+  let res = Bytes.make (l + 2) '\'' in
+  String.unsafe_blit str 0 res 1 l;
+  Bytes.unsafe_to_string res
+
+(* Convert a format type to string *)
+let string_of_fmtty fmtty =
+  let buf = buffer_create 16 in
+  bprint_fmtty buf fmtty;
+  buffer_contents buf
+
+(******************************************************************************)
+                        (* Generic printing function *)
+
+(* Make a generic printing function. *)
+(* Used to generate Printf and Format printing functions. *)
+(* Parameters:
+     k: a continuation finally applied to the output stream and the accumulator.
+     o: the output stream (see k, %a and %t).
+     acc: rev list of printing entities (string, char, flush, formatting, ...).
+     fmt: the format. *)
+let rec make_printf : type a b c d e f .
+    ((b, c) acc -> f) -> (b, c) acc ->
+    (a, b, c, d, e, f) fmt -> a =
+fun k acc fmt -> match fmt with
+  | Char rest ->
+    fun c ->
+      let new_acc = Acc_data_char (acc, c) in
+      make_printf k new_acc rest
+  | Caml_char rest ->
+    fun c ->
+      let new_acc = Acc_data_string (acc, format_caml_char c) in
+      make_printf k new_acc rest
+  | String (pad, rest) ->
+    make_padding k acc rest pad (fun str -> str)
+  | Caml_string (pad, rest) ->
+    make_padding k acc rest pad string_to_caml_string
+  | Int (iconv, pad, prec, rest) ->
+    make_int_padding_precision k acc rest pad prec convert_int iconv
+  | Int32 (iconv, pad, prec, rest) ->
+    make_int_padding_precision k acc rest pad prec convert_int32 iconv
+  | Nativeint (iconv, pad, prec, rest) ->
+    make_int_padding_precision k acc rest pad prec convert_nativeint iconv
+  | Int64 (iconv, pad, prec, rest) ->
+    make_int_padding_precision k acc rest pad prec convert_int64 iconv
+  | Float (fconv, pad, prec, rest) ->
+    make_float_padding_precision k acc rest pad prec fconv
+  | Bool (pad, rest) ->
+    make_padding k acc rest pad string_of_bool
+  | Alpha rest ->
+    fun f x -> make_printf k (Acc_delay (acc, fun o -> f o x)) rest
+  | Theta rest ->
+    fun f -> make_printf k (Acc_delay (acc, f)) rest
+  | Custom (arity, f, rest) ->
+    make_custom k acc rest arity (f ())
+  | Reader _ ->
+    (* This case is impossible, by typing of formats. *)
+    (* Indeed, since printf and co. take a format4 as argument, the 'd and 'e
+       type parameters of fmt are obviously equals. The Reader is the
+       only constructor which touch 'd and 'e type parameters of the format
+       type, it adds an (->) to the 'd parameters. Consequently, a format4
+       cannot contain a Reader node, except in the sub-format associated to
+       an %{...%}. It's not a problem because make_printf do not call
+       itself recursively on the sub-format associated to %{...%}. *)
+    assert false
+  | Flush rest ->
+    make_printf k (Acc_flush acc) rest
+
+  | String_literal (str, rest) ->
+    make_printf k (Acc_string_literal (acc, str)) rest
+  | Char_literal (chr, rest) ->
+    make_printf k (Acc_char_literal (acc, chr)) rest
+
+  | Format_arg (_, sub_fmtty, rest) ->
+    let ty = string_of_fmtty sub_fmtty in
+    (fun str ->
+      ignore str;
+      make_printf k (Acc_data_string (acc, ty)) rest)
+  | Format_subst (_, fmtty, rest) ->
+    fun (Format (fmt, _)) -> make_printf k acc
+      (concat_fmt (recast fmt fmtty) rest)
+
+  | Scan_char_set (_, _, rest) ->
+    let new_acc = Acc_invalid_arg (acc, "Printf: bad conversion %[") in
+    fun _ -> make_printf k new_acc rest
+  | Scan_get_counter (_, rest) ->
+    (* This case should be refused for Printf. *)
+    (* Accepted for backward compatibility. *)
+    (* Interpret %l, %n and %L as %u. *)
+    fun n ->
+      let new_acc = Acc_data_string (acc, format_int "%u" n) in
+      make_printf k new_acc rest
+  | Scan_next_char rest ->
+    fun c ->
+      let new_acc = Acc_data_char (acc, c) in
+      make_printf k new_acc rest
+  | Ignored_param (ign, rest) ->
+    make_ignored_param k acc ign rest
+
+  | Formatting_lit (fmting_lit, rest) ->
+    make_printf k (Acc_formatting_lit (acc, fmting_lit)) rest
+  | Formatting_gen (Open_tag (Format (fmt', _)), rest) ->
+    let k' kacc =
+      make_printf k (Acc_formatting_gen (acc, Acc_open_tag kacc)) rest in
+    make_printf k' End_of_acc fmt'
+  | Formatting_gen (Open_box (Format (fmt', _)), rest) ->
+    let k' kacc =
+      make_printf k (Acc_formatting_gen (acc, Acc_open_box kacc)) rest in
+    make_printf k' End_of_acc fmt'
+
+  | End_of_format ->
+    k acc
+
+(* Delay the error (Invalid_argument "Printf: bad conversion %_"). *)
+(* Generate functions to take remaining arguments (after the "%_"). *)
+and make_ignored_param : type x y a b c d e f .
+    ((b, c) acc -> f) -> (b, c) acc ->
+    (a, b, c, d, y, x) ignored ->
+    (x, b, c, y, e, f) fmt -> a =
+fun k acc ign fmt -> match ign with
+  | Ignored_char                    -> make_invalid_arg k acc fmt
+  | Ignored_caml_char               -> make_invalid_arg k acc fmt
+  | Ignored_string _                -> make_invalid_arg k acc fmt
+  | Ignored_caml_string _           -> make_invalid_arg k acc fmt
+  | Ignored_int (_, _)              -> make_invalid_arg k acc fmt
+  | Ignored_int32 (_, _)            -> make_invalid_arg k acc fmt
+  | Ignored_nativeint (_, _)        -> make_invalid_arg k acc fmt
+  | Ignored_int64 (_, _)            -> make_invalid_arg k acc fmt
+  | Ignored_float (_, _)            -> make_invalid_arg k acc fmt
+  | Ignored_bool _                  -> make_invalid_arg k acc fmt
+  | Ignored_format_arg _            -> make_invalid_arg k acc fmt
+  | Ignored_format_subst (_, fmtty) -> make_from_fmtty k acc fmtty fmt
+  | Ignored_reader                  -> assert false
+  | Ignored_scan_char_set _         -> make_invalid_arg k acc fmt
+  | Ignored_scan_get_counter _      -> make_invalid_arg k acc fmt
+  | Ignored_scan_next_char          -> make_invalid_arg k acc fmt
+
+
+(* Special case of printf "%_(". *)
+and make_from_fmtty : type x y a b c d e f .
+    ((b, c) acc -> f) -> (b, c) acc ->
+    (a, b, c, d, y, x) fmtty ->
+    (x, b, c, y, e, f) fmt -> a =
+fun k acc fmtty fmt -> match fmtty with
+  | Char_ty rest            -> fun _ -> make_from_fmtty k acc rest fmt
+  | String_ty rest          -> fun _ -> make_from_fmtty k acc rest fmt
+  | Int_ty rest             -> fun _ -> make_from_fmtty k acc rest fmt
+  | Int32_ty rest           -> fun _ -> make_from_fmtty k acc rest fmt
+  | Nativeint_ty rest       -> fun _ -> make_from_fmtty k acc rest fmt
+  | Int64_ty rest           -> fun _ -> make_from_fmtty k acc rest fmt
+  | Float_ty rest           -> fun _ -> make_from_fmtty k acc rest fmt
+  | Bool_ty rest            -> fun _ -> make_from_fmtty k acc rest fmt
+  | Alpha_ty rest           -> fun _ _ -> make_from_fmtty k acc rest fmt
+  | Theta_ty rest           -> fun _ -> make_from_fmtty k acc rest fmt
+  | Any_ty rest             -> fun _ -> make_from_fmtty k acc rest fmt
+  | Reader_ty _             -> assert false
+  | Ignored_reader_ty _     -> assert false
+  | Format_arg_ty (_, rest) -> fun _ -> make_from_fmtty k acc rest fmt
+  | End_of_fmtty            -> make_invalid_arg k acc fmt
+  | Format_subst_ty (ty1, ty2, rest) ->
+    let ty = trans (symm ty1) ty2 in
+    fun _ -> make_from_fmtty k acc (concat_fmtty ty rest) fmt
+
+(* Insert an Acc_invalid_arg in the accumulator and continue to generate
+   closures to get the remaining arguments. *)
+and make_invalid_arg : type a b c d e f .
+    ((b, c) acc -> f) -> (b, c) acc ->
+    (a, b, c, d, e, f) fmt -> a =
+fun k acc fmt ->
+  make_printf k (Acc_invalid_arg (acc, "Printf: bad conversion %_")) fmt
+
+(* Fix padding, take it as an extra integer argument if needed. *)
+and make_padding : type x z a b c d e f .
+    ((b, c) acc -> f) -> (b, c) acc ->
+    (a, b, c, d, e, f) fmt ->
+    (x, z -> a) padding -> (z -> string) -> x =
+  fun k acc fmt pad trans -> match pad with
+  | No_padding ->
+    fun x ->
+      let new_acc = Acc_data_string (acc, trans x) in
+      make_printf k new_acc fmt
+  | Lit_padding (padty, width) ->
+    fun x ->
+      let new_acc = Acc_data_string (acc, fix_padding padty width (trans x)) in
+      make_printf k new_acc fmt
+  | Arg_padding padty ->
+    fun w x ->
+      let new_acc = Acc_data_string (acc, fix_padding padty w (trans x)) in
+      make_printf k new_acc fmt
+
+(* Fix padding and precision for int, int32, nativeint or int64. *)
+(* Take one or two extra integer arguments if needed. *)
+and make_int_padding_precision : type x y z a b c d e f .
+    ((b, c) acc -> f) -> (b, c) acc ->
+    (a, b, c, d, e, f) fmt ->
+    (x, y) padding -> (y, z -> a) precision -> (int_conv -> z -> string) ->
+    int_conv -> x =
+  fun k acc fmt pad prec trans iconv -> match pad, prec with
+  | No_padding, No_precision ->
+    fun x ->
+      let str = trans iconv x in
+      make_printf k (Acc_data_string (acc, str)) fmt
+  | No_padding, Lit_precision p ->
+    fun x ->
+      let str = fix_int_precision p (trans iconv x) in
+      make_printf k (Acc_data_string (acc, str)) fmt
+  | No_padding, Arg_precision ->
+    fun p x ->
+      let str = fix_int_precision p (trans iconv x) in
+      make_printf k (Acc_data_string (acc, str)) fmt
+  | Lit_padding (padty, w), No_precision ->
+    fun x ->
+      let str = fix_padding padty w (trans iconv x) in
+      make_printf k (Acc_data_string (acc, str)) fmt
+  | Lit_padding (padty, w), Lit_precision p ->
+    fun x ->
+      let str = fix_padding padty w (fix_int_precision p (trans iconv x)) in
+      make_printf k (Acc_data_string (acc, str)) fmt
+  | Lit_padding (padty, w), Arg_precision ->
+    fun p x ->
+      let str = fix_padding padty w (fix_int_precision p (trans iconv x)) in
+      make_printf k (Acc_data_string (acc, str)) fmt
+  | Arg_padding padty, No_precision ->
+    fun w x ->
+      let str = fix_padding padty w (trans iconv x) in
+      make_printf k (Acc_data_string (acc, str)) fmt
+  | Arg_padding padty, Lit_precision p ->
+    fun w x ->
+      let str = fix_padding padty w (fix_int_precision p (trans iconv x)) in
+      make_printf k (Acc_data_string (acc, str)) fmt
+  | Arg_padding padty, Arg_precision ->
+    fun w p x ->
+      let str = fix_padding padty w (fix_int_precision p (trans iconv x)) in
+      make_printf k (Acc_data_string (acc, str)) fmt
+
+(* Convert a float, fix padding and precision if needed. *)
+(* Take the float argument and one or two extra integer arguments if needed. *)
+and make_float_padding_precision : type x y a b c d e f .
+    ((b, c) acc -> f) -> (b, c) acc ->
+    (a, b, c, d, e, f) fmt ->
+    (x, y) padding -> (y, float -> a) precision -> float_conv -> x =
+  fun k acc fmt pad prec fconv -> match pad, prec with
+  | No_padding, No_precision ->
+    fun x ->
+      let str = convert_float fconv (default_float_precision fconv) x in
+      make_printf k (Acc_data_string (acc, str)) fmt
+  | No_padding, Lit_precision p ->
+    fun x ->
+      let str = convert_float fconv p x in
+      make_printf k (Acc_data_string (acc, str)) fmt
+  | No_padding, Arg_precision ->
+    fun p x ->
+      let str = convert_float fconv p x in
+      make_printf k (Acc_data_string (acc, str)) fmt
+  | Lit_padding (padty, w), No_precision ->
+    fun x ->
+      let str = convert_float fconv (default_float_precision fconv) x in
+      let str' = fix_padding padty w str in
+      make_printf k (Acc_data_string (acc, str')) fmt
+  | Lit_padding (padty, w), Lit_precision p ->
+    fun x ->
+      let str = fix_padding padty w (convert_float fconv p x) in
+      make_printf k (Acc_data_string (acc, str)) fmt
+  | Lit_padding (padty, w), Arg_precision ->
+    fun p x ->
+      let str = fix_padding padty w (convert_float fconv p x) in
+      make_printf k (Acc_data_string (acc, str)) fmt
+  | Arg_padding padty, No_precision ->
+    fun w x ->
+      let str = convert_float fconv (default_float_precision fconv) x in
+      let str' = fix_padding padty w str in
+      make_printf k (Acc_data_string (acc, str')) fmt
+  | Arg_padding padty, Lit_precision p ->
+    fun w x ->
+      let str = fix_padding padty w (convert_float fconv p x) in
+      make_printf k (Acc_data_string (acc, str)) fmt
+  | Arg_padding padty, Arg_precision ->
+    fun w p x ->
+      let str = fix_padding padty w (convert_float fconv p x) in
+      make_printf k (Acc_data_string (acc, str)) fmt
+and make_custom : type x y a b c d e f .
+  ((b, c) acc -> f) -> (b, c) acc ->
+  (a, b, c, d, e, f) fmt ->
+  (a, x, y) custom_arity -> x -> y =
+  fun k acc rest arity f -> match arity with
+  | Custom_zero -> make_printf k (Acc_data_string (acc, f)) rest
+  | Custom_succ arity ->
+    fun x ->
+      make_custom k acc rest arity (f x)
+
+let const x _ = x
+
+let rec make_iprintf : type a b c d e f state.
+  (state -> f) -> state -> (a, b, c, d, e, f) fmt -> a =
+  fun k o fmt -> match fmt with
+    | Char rest ->
+        const (make_iprintf k o rest)
+    | Caml_char rest ->
+        const (make_iprintf k o rest)
+    | String (No_padding, rest) ->
+        const (make_iprintf k o rest)
+    | String (Lit_padding _, rest) ->
+        const (make_iprintf k o rest)
+    | String (Arg_padding _, rest) ->
+        const (const (make_iprintf k o rest))
+    | Caml_string (No_padding, rest) ->
+        const (make_iprintf k o rest)
+    | Caml_string (Lit_padding _, rest) ->
+        const (make_iprintf k o rest)
+    | Caml_string (Arg_padding _, rest) ->
+        const (const (make_iprintf k o rest))
+    | Int (_, pad, prec, rest) ->
+        fn_of_padding_precision k o rest pad prec
+    | Int32 (_, pad, prec, rest) ->
+        fn_of_padding_precision k o rest pad prec
+    | Nativeint (_, pad, prec, rest) ->
+        fn_of_padding_precision k o rest pad prec
+    | Int64 (_, pad, prec, rest) ->
+        fn_of_padding_precision k o rest pad prec
+    | Float (_, pad, prec, rest) ->
+        fn_of_padding_precision k o rest pad prec
+    | Bool (No_padding, rest) ->
+        const (make_iprintf k o rest)
+    | Bool (Lit_padding _, rest) ->
+        const (make_iprintf k o rest)
+    | Bool (Arg_padding _, rest) ->
+        const (const (make_iprintf k o rest))
+    | Alpha rest ->
+        const (const (make_iprintf k o rest))
+    | Theta rest ->
+        const (make_iprintf k o rest)
+    | Custom (arity, _, rest) ->
+        fn_of_custom_arity k o rest arity
+    | Reader _ ->
+        (* This case is impossible, by typing of formats.  See the
+           note in the corresponding case for make_printf. *)
+        assert false
+    | Flush rest ->
+        make_iprintf k o rest
+    | String_literal (_, rest) ->
+        make_iprintf k o rest
+    | Char_literal (_, rest) ->
+        make_iprintf k o rest
+    | Format_arg (_, _, rest) ->
+        const (make_iprintf k o rest)
+    | Format_subst (_, fmtty, rest) ->
+        fun (Format (fmt, _)) ->
+          make_iprintf k o
+            (concat_fmt (recast fmt fmtty) rest)
+    | Scan_char_set (_, _, rest) ->
+        const (make_iprintf k o rest)
+    | Scan_get_counter (_, rest) ->
+        const (make_iprintf k o rest)
+    | Scan_next_char rest ->
+        const (make_iprintf k o rest)
+    | Ignored_param (ign, rest) ->
+        make_ignored_param (fun _ -> k o) (End_of_acc) ign rest
+    | Formatting_lit (_, rest) ->
+        make_iprintf k o rest
+    | Formatting_gen (Open_tag (Format (fmt', _)), rest) ->
+        make_iprintf (fun koc -> make_iprintf k koc rest) o fmt'
+    | Formatting_gen (Open_box (Format (fmt', _)), rest) ->
+        make_iprintf (fun koc -> make_iprintf k koc rest) o fmt'
+    | End_of_format ->
+        k o
+and fn_of_padding_precision :
+  type x y z a b c d e f state.
+  (state -> f) -> state -> (a, b, c, d, e, f) fmt ->
+  (x, y) padding -> (y, z -> a) precision -> x =
+  fun k o fmt pad prec -> match pad, prec with
+    | No_padding   , No_precision    ->
+        const (make_iprintf k o fmt)
+    | No_padding   , Lit_precision _ ->
+        const (make_iprintf k o fmt)
+    | No_padding   , Arg_precision   ->
+        const (const (make_iprintf k o fmt))
+    | Lit_padding _, No_precision    ->
+        const (make_iprintf k o fmt)
+    | Lit_padding _, Lit_precision _ ->
+        const (make_iprintf k o fmt)
+    | Lit_padding _, Arg_precision   ->
+        const (const (make_iprintf k o fmt))
+    | Arg_padding _, No_precision    ->
+        const (const (make_iprintf k o fmt))
+    | Arg_padding _, Lit_precision _ ->
+        const (const (make_iprintf k o fmt))
+    | Arg_padding _, Arg_precision   ->
+        const (const (const (make_iprintf k o fmt)))
+and fn_of_custom_arity : type x y a b c d e f state.
+  (state -> f) ->
+  state -> (a, b, c, d, e, f) fmt -> (a, x, y) custom_arity -> y =
+  fun k o fmt -> function
+    | Custom_zero ->
+        make_iprintf k o fmt
+    | Custom_succ arity ->
+        const (fn_of_custom_arity k o fmt arity)
+
+(******************************************************************************)
+                          (* Continuations for make_printf *)
+
+(* Recursively output an "accumulator" containing a reversed list of
+   printing entities (string, char, flus, ...) in an output_stream. *)
+(* Used as a continuation of make_printf. *)
+let rec output_acc o acc = match acc with
+  | Acc_formatting_lit (p, fmting_lit) ->
+    let s = string_of_formatting_lit fmting_lit in
+    output_acc o p; output_string o s;
+  | Acc_formatting_gen (p, Acc_open_tag acc') ->
+    output_acc o p; output_string o "@{"; output_acc o acc';
+  | Acc_formatting_gen (p, Acc_open_box acc') ->
+    output_acc o p; output_string o "@["; output_acc o acc';
+  | Acc_string_literal (p, s)
+  | Acc_data_string (p, s)   -> output_acc o p; output_string o s
+  | Acc_char_literal (p, c)
+  | Acc_data_char (p, c)     -> output_acc o p; output_char o c
+  | Acc_delay (p, f)         -> output_acc o p; f o
+  | Acc_flush p              -> output_acc o p; flush o
+  | Acc_invalid_arg (p, msg) -> output_acc o p; invalid_arg msg;
+  | End_of_acc               -> ()
+
+(* Recursively output an "accumulator" containing a reversed list of
+   printing entities (string, char, flus, ...) in a buffer. *)
+(* Used as a continuation of make_printf. *)
+let rec bufput_acc b acc = match acc with
+  | Acc_formatting_lit (p, fmting_lit) ->
+    let s = string_of_formatting_lit fmting_lit in
+    bufput_acc b p; Buffer.add_string b s;
+  | Acc_formatting_gen (p, Acc_open_tag acc') ->
+    bufput_acc b p; Buffer.add_string b "@{"; bufput_acc b acc';
+  | Acc_formatting_gen (p, Acc_open_box acc') ->
+    bufput_acc b p; Buffer.add_string b "@["; bufput_acc b acc';
+  | Acc_string_literal (p, s)
+  | Acc_data_string (p, s)   -> bufput_acc b p; Buffer.add_string b s
+  | Acc_char_literal (p, c)
+  | Acc_data_char (p, c)     -> bufput_acc b p; Buffer.add_char b c
+  | Acc_delay (p, f)         -> bufput_acc b p; f b
+  | Acc_flush p              -> bufput_acc b p;
+  | Acc_invalid_arg (p, msg) -> bufput_acc b p; invalid_arg msg;
+  | End_of_acc               -> ()
+
+(* Recursively output an "accumulator" containing a reversed list of
+   printing entities (string, char, flus, ...) in a buffer. *)
+(* Differ from bufput_acc by the interpretation of %a and %t. *)
+(* Used as a continuation of make_printf. *)
+let rec strput_acc b acc = match acc with
+  | Acc_formatting_lit (p, fmting_lit) ->
+    let s = string_of_formatting_lit fmting_lit in
+    strput_acc b p; Buffer.add_string b s;
+  | Acc_formatting_gen (p, Acc_open_tag acc') ->
+    strput_acc b p; Buffer.add_string b "@{"; strput_acc b acc';
+  | Acc_formatting_gen (p, Acc_open_box acc') ->
+    strput_acc b p; Buffer.add_string b "@["; strput_acc b acc';
+  | Acc_string_literal (p, s)
+  | Acc_data_string (p, s)   -> strput_acc b p; Buffer.add_string b s
+  | Acc_char_literal (p, c)
+  | Acc_data_char (p, c)     -> strput_acc b p; Buffer.add_char b c
+  | Acc_delay (p, f)         -> strput_acc b p; Buffer.add_string b (f ())
+  | Acc_flush p              -> strput_acc b p;
+  | Acc_invalid_arg (p, msg) -> strput_acc b p; invalid_arg msg;
+  | End_of_acc               -> ()
+
+(******************************************************************************)
+                          (* Error management *)
+
+(* Raise [Failure] with a pretty-printed error message. *)
+let failwith_message (Format (fmt, _)) =
+  let buf = Buffer.create 256 in
+  let k acc = strput_acc buf acc; failwith (Buffer.contents buf) in
+  make_printf k End_of_acc fmt
+
+(******************************************************************************)
+                            (* Formatting tools *)
+
+(* Convert a string to an open block description (indent, block_type) *)
+let open_box_of_string str =
+  if str = "" then (0, Pp_box) else
+    let len = String.length str in
+    let invalid_box () = failwith_message "invalid box description %S" str in
+    let rec parse_spaces i =
+      if i = len then i else
+        match str.[i] with
+        | ' ' | '\t' -> parse_spaces (i + 1)
+        | _ -> i
+    and parse_lword i j =
+      if j = len then j else
+        match str.[j] with
+        | 'a' .. 'z' -> parse_lword i (j + 1)
+        | _ -> j
+    and parse_int i j =
+      if j = len then j else
+        match str.[j] with
+        | '0' .. '9' | '-' -> parse_int i (j + 1)
+        | _ -> j in
+    let wstart = parse_spaces 0 in
+    let wend = parse_lword wstart wstart in
+    let box_name = String.sub str wstart (wend - wstart) in
+    let nstart = parse_spaces wend in
+    let nend = parse_int nstart nstart in
+    let indent =
+      if nstart = nend then 0 else
+        try int_of_string (String.sub str nstart (nend - nstart))
+        with Failure _ -> invalid_box () in
+    let exp_end = parse_spaces nend in
+    if exp_end <> len then invalid_box ();
+    let box_type = match box_name with
+      | "" | "b" -> Pp_box
+      | "h"      -> Pp_hbox
+      | "v"      -> Pp_vbox
+      | "hv"     -> Pp_hvbox
+      | "hov"    -> Pp_hovbox
+      | _        -> invalid_box () in
+    (indent, box_type)
+
+(******************************************************************************)
+                            (* Parsing tools *)
+
+(* Create a padding_fmt_ebb from a padding and a format. *)
+(* Copy the padding to disjoin the type parameters of argument and result. *)
+let make_padding_fmt_ebb : type x y .
+    (x, y) padding -> (_, _, _, _, _, _) fmt ->
+      (_, _, _, _, _) padding_fmt_ebb =
+fun pad fmt -> match pad with
+  | No_padding         -> Padding_fmt_EBB (No_padding, fmt)
+  | Lit_padding (s, w) -> Padding_fmt_EBB (Lit_padding (s, w), fmt)
+  | Arg_padding s      -> Padding_fmt_EBB (Arg_padding s, fmt)
+
+(* Create a precision_fmt_ebb from a precision and a format. *)
+(* Copy the precision to disjoin the type parameters of argument and result. *)
+let make_precision_fmt_ebb : type x y .
+    (x, y) precision -> (_, _, _, _, _, _) fmt ->
+      (_, _, _, _, _) precision_fmt_ebb =
+fun prec fmt -> match prec with
+  | No_precision    -> Precision_fmt_EBB (No_precision, fmt)
+  | Lit_precision p -> Precision_fmt_EBB (Lit_precision p, fmt)
+  | Arg_precision   -> Precision_fmt_EBB (Arg_precision, fmt)
+
+(* Create a padprec_fmt_ebb from a padding, a precision and a format. *)
+(* Copy the padding and the precision to disjoin type parameters of arguments
+   and result. *)
+let make_padprec_fmt_ebb : type x y z t .
+    (x, y) padding -> (z, t) precision ->
+    (_, _, _, _, _, _) fmt ->
+    (_, _, _, _, _) padprec_fmt_ebb =
+fun pad prec fmt ->
+  let Precision_fmt_EBB (prec, fmt') = make_precision_fmt_ebb prec fmt in
+  match pad with
+  | No_padding         -> Padprec_fmt_EBB (No_padding, prec, fmt')
+  | Lit_padding (s, w) -> Padprec_fmt_EBB (Lit_padding (s, w), prec, fmt')
+  | Arg_padding s      -> Padprec_fmt_EBB (Arg_padding s, prec, fmt')
+
+(******************************************************************************)
+                             (* Format parsing *)
+
+(* Parse a string representing a format and create a fmt_ebb. *)
+(* Raise [Failure] in case of invalid format. *)
+let fmt_ebb_of_string ?legacy_behavior str =
+  (* Parameters naming convention:                                    *)
+  (*   - lit_start: start of the literal sequence.                    *)
+  (*   - str_ind: current index in the string.                        *)
+  (*   - end_ind: end of the current (sub-)format.                    *)
+  (*   - pct_ind: index of the '%' in the current micro-format.       *)
+  (*   - zero:  is the '0' flag defined in the current micro-format.  *)
+  (*   - minus: is the '-' flag defined in the current micro-format.  *)
+  (*   - plus:  is the '+' flag defined in the current micro-format.  *)
+  (*   - hash:  is the '#' flag defined in the current micro-format.  *)
+  (*   - space: is the ' ' flag defined in the current micro-format.  *)
+  (*   - ign:   is the '_' flag defined in the current micro-format.  *)
+  (*   - pad: padding of the current micro-format.                    *)
+  (*   - prec: precision of the current micro-format.                 *)
+  (*   - symb: char representing the conversion ('c', 's', 'd', ...). *)
+  (*   - char_set: set of characters as bitmap (see scanf %[...]).    *)
+
+  let legacy_behavior = match legacy_behavior with
+    | Some flag -> flag
+    | None -> true
+  (*  When this flag is enabled, the format parser tries to behave as
+      the <4.02 implementations, in particular it ignores most benine
+      nonsensical format. When the flag is disabled, it will reject any
+      format that is not accepted by the specification.
+
+      A typical example would be "%+ d": specifying both '+' (if the
+      number is positive, pad with a '+' to get the same width as
+      negative numbers) and ' ' (if the number is positive, pad with
+      a space) does not make sense, but the legacy (< 4.02)
+      implementation was happy to just ignore the space.
+  *)
+  in
+
+  (* Raise [Failure] with a friendly error message. *)
+  let invalid_format_message str_ind msg =
+    failwith_message
+      "invalid format %S: at character number %d, %s"
+      str str_ind msg
+  in
+
+  (* Used when the end of the format (or the current sub-format) was encountered
+      unexpectedly. *)
+  let unexpected_end_of_format end_ind =
+    invalid_format_message end_ind
+      "unexpected end of format"
+  in
+
+  (* Used for %0c: no other widths are implemented *)
+  let invalid_nonnull_char_width str_ind =
+    invalid_format_message str_ind
+      "non-zero widths are unsupported for %c conversions"
+  in
+  (* Raise [Failure] with a friendly error message about an option dependency
+     problem. *)
+  let invalid_format_without str_ind c s =
+    failwith_message
+      "invalid format %S: at character number %d, '%c' without %s"
+      str str_ind c s
+  in
+
+  (* Raise [Failure] with a friendly error message about an unexpected
+     character. *)
+  let expected_character str_ind expected read =
+    failwith_message
+     "invalid format %S: at character number %d, %s expected, read %C"
+      str str_ind expected read
+  in
+
+  (* Parse the string from beg_ind (included) to end_ind (excluded). *)
+  let rec parse : type e f . int -> int -> (_, _, e, f) fmt_ebb =
+  fun beg_ind end_ind -> parse_literal beg_ind beg_ind end_ind
+
+  (* Read literal characters up to '%' or '@' special characters. *)
+  and parse_literal : type e f . int -> int -> int -> (_, _, e, f) fmt_ebb =
+  fun lit_start str_ind end_ind ->
+    if str_ind = end_ind then add_literal lit_start str_ind End_of_format else
+      match str.[str_ind] with
+      | '%' ->
+        let Fmt_EBB fmt_rest = parse_format str_ind end_ind in
+        add_literal lit_start str_ind fmt_rest
+      | '@' ->
+        let Fmt_EBB fmt_rest = parse_after_at (str_ind + 1) end_ind in
+        add_literal lit_start str_ind fmt_rest
+      | _ ->
+        parse_literal lit_start (str_ind + 1) end_ind
+
+  (* Parse a format after '%' *)
+  and parse_format : type e f . int -> int -> (_, _, e, f) fmt_ebb =
+  fun pct_ind end_ind -> parse_ign pct_ind (pct_ind + 1) end_ind
+
+  and parse_ign : type e f . int -> int -> int -> (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind ->
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    match str.[str_ind] with
+      | '_' -> parse_flags pct_ind (str_ind+1) end_ind true
+      | _ -> parse_flags pct_ind str_ind end_ind false
+
+  and parse_flags : type e f . int -> int -> int -> bool -> (_, _, e, f) fmt_ebb
+  =
+  fun pct_ind str_ind end_ind ign ->
+    let zero = ref false and minus = ref false
+    and plus = ref false and space = ref false
+    and hash = ref false in
+    let set_flag str_ind flag =
+      (* in legacy mode, duplicate flags are accepted *)
+      if !flag && not legacy_behavior then
+        failwith_message
+          "invalid format %S: at character number %d, duplicate flag %C"
+          str str_ind str.[str_ind];
+      flag := true;
+    in
+    let rec read_flags str_ind =
+      if str_ind = end_ind then unexpected_end_of_format end_ind;
+      begin match str.[str_ind] with
+      | '0' -> set_flag str_ind zero;  read_flags (str_ind + 1)
+      | '-' -> set_flag str_ind minus; read_flags (str_ind + 1)
+      | '+' -> set_flag str_ind plus;  read_flags (str_ind + 1)
+      | '#' -> set_flag str_ind hash; read_flags (str_ind + 1)
+      | ' ' -> set_flag str_ind space; read_flags (str_ind + 1)
+      | _ ->
+        parse_padding pct_ind str_ind end_ind
+          !zero !minus !plus !hash !space ign
+      end
+    in
+    read_flags str_ind
+
+  (* Try to read a digital or a '*' padding. *)
+  and parse_padding : type e f .
+      int -> int -> int -> bool -> bool -> bool -> bool -> bool -> bool ->
+        (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind zero minus plus hash space ign ->
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    let padty = match zero, minus with
+      | false, false -> Right
+      | false, true  -> Left
+      |  true, false -> Zeros
+      |  true, true  ->
+        if legacy_behavior then Left
+        else incompatible_flag pct_ind str_ind '-' "0" in
+    match str.[str_ind] with
+    | '0' .. '9' ->
+      let new_ind, width = parse_positive str_ind end_ind 0 in
+      parse_after_padding pct_ind new_ind end_ind minus plus hash space ign
+        (Lit_padding (padty, width))
+    | '*' ->
+      parse_after_padding pct_ind (str_ind + 1) end_ind minus plus hash space
+        ign (Arg_padding padty)
+    | _ ->
+      begin match padty with
+      | Left  ->
+        if not legacy_behavior then
+          invalid_format_without (str_ind - 1) '-' "padding";
+        parse_after_padding pct_ind str_ind end_ind minus plus hash space ign
+          No_padding
+      | Zeros ->
+         (* a '0' padding indication not followed by anything should
+           be interpreted as a Right padding of width 0. This is used
+           by scanning conversions %0s and %0c *)
+        parse_after_padding pct_ind str_ind end_ind minus plus hash space ign
+          (Lit_padding (Right, 0))
+      | Right ->
+        parse_after_padding pct_ind str_ind end_ind minus plus hash space ign
+          No_padding
+      end
+
+  (* Is precision defined? *)
+  and parse_after_padding : type x e f .
+      int -> int -> int -> bool -> bool -> bool -> bool -> bool ->
+        (x, _) padding -> (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind minus plus hash space ign pad ->
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    match str.[str_ind] with
+    | '.' ->
+      parse_precision pct_ind (str_ind + 1) end_ind minus plus hash space ign
+        pad
+    | symb ->
+      parse_conversion pct_ind (str_ind + 1) end_ind plus hash space ign pad
+        No_precision pad symb
+
+  (* Read the digital or '*' precision. *)
+  and parse_precision : type x e f .
+      int -> int -> int -> bool -> bool -> bool -> bool -> bool ->
+        (x, _) padding -> (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind minus plus hash space ign pad ->
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    let parse_literal minus str_ind =
+      let new_ind, prec = parse_positive str_ind end_ind 0 in
+      parse_after_precision pct_ind new_ind end_ind minus plus hash space ign
+        pad (Lit_precision prec) in
+    match str.[str_ind] with
+    | '0' .. '9' -> parse_literal minus str_ind
+    | ('+' | '-') as symb when legacy_behavior ->
+      (* Legacy mode would accept and ignore '+' or '-' before the
+         integer describing the desired precision; note that this
+         cannot happen for padding width, as '+' and '-' already have
+         a semantics there.
+
+         That said, the idea (supported by this tweak) that width and
+         precision literals are "integer literals" in the OCaml sense is
+         still blatantly wrong, as 123_456 or 0xFF are rejected. *)
+      parse_literal (minus || symb = '-') (str_ind + 1)
+    | '*' ->
+      parse_after_precision pct_ind (str_ind + 1) end_ind minus plus hash space
+        ign pad Arg_precision
+    | _ ->
+      if legacy_behavior then
+        (* note that legacy implementation did not ignore '.' without
+           a number (as it does for padding indications), but
+           interprets it as '.0' *)
+        parse_after_precision pct_ind str_ind end_ind minus plus hash space ign
+          pad (Lit_precision 0)
+      else
+        invalid_format_without (str_ind - 1) '.' "precision"
+
+  (* Try to read the conversion. *)
+  and parse_after_precision : type x y z t e f .
+      int -> int -> int -> bool -> bool -> bool -> bool -> bool ->
+        (x, y) padding -> (z, t) precision -> (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind minus plus hash space ign pad prec ->
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    let parse_conv (type u) (type v) (padprec : (u, v) padding) =
+      parse_conversion pct_ind (str_ind + 1) end_ind plus hash space ign pad
+        prec padprec str.[str_ind] in
+    (* in legacy mode, some formats (%s and %S) accept a weird mix of
+       padding and precision, which is merged as a single padding
+       information. For example, in %.10s the precision is implicitly
+       understood as padding %10s, but the left-padding component may
+       be specified either as a left padding or a negative precision:
+       %-.3s and %.-3s are equivalent to %-3s *)
+    match pad with
+    | No_padding -> (
+      match minus, prec with
+        | _, No_precision -> parse_conv No_padding
+        | false, Lit_precision n -> parse_conv (Lit_padding (Right, n))
+        | true, Lit_precision n -> parse_conv (Lit_padding (Left, n))
+        | false, Arg_precision -> parse_conv (Arg_padding Right)
+        | true, Arg_precision -> parse_conv (Arg_padding Left)
+    )
+    | pad -> parse_conv pad
+
+  (* Case analysis on conversion. *)
+  and parse_conversion : type x y z t u v e f .
+      int -> int -> int -> bool -> bool -> bool -> bool -> (x, y) padding ->
+        (z, t) precision -> (u, v) padding -> char -> (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind plus hash space ign pad prec padprec symb ->
+    (* Flags used to check option usages/compatibilities. *)
+    let plus_used  = ref false and hash_used = ref false
+    and space_used = ref false and ign_used   = ref false
+    and pad_used   = ref false and prec_used  = ref false in
+
+    (* Access to options, update flags. *)
+    let get_plus    () = plus_used  := true; plus
+    and get_hash   () = hash_used := true; hash
+    and get_space   () = space_used := true; space
+    and get_ign     () = ign_used   := true; ign
+    and get_pad     () = pad_used   := true; pad
+    and get_prec    () = prec_used  := true; prec
+    and get_padprec () = pad_used   := true; padprec in
+
+    let get_int_pad () =
+      (* %5.3d is accepted and meaningful: pad to length 5 with
+         spaces, but first pad with zeros upto length 3 (0-padding
+         is the interpretation of "precision" for integer formats).
+
+         %05.3d is redundant: pad to length 5 *with zeros*, but
+         first pad with zeros... To add insult to the injury, the
+         legacy implementation ignores the 0-padding indication and
+         does the 5 padding with spaces instead. We reuse this
+         interpretation for compatibility, but statically reject this
+         format when the legacy mode is disabled, to protect strict
+         users from this corner case. *)
+       match get_pad (), get_prec () with
+         | pad, No_precision -> pad
+         | No_padding, _     -> No_padding
+         | Lit_padding (Zeros, n), _ ->
+           if legacy_behavior then Lit_padding (Right, n)
+           else incompatible_flag pct_ind str_ind '0' "precision"
+         | Arg_padding Zeros, _ ->
+           if legacy_behavior then Arg_padding Right
+           else incompatible_flag pct_ind str_ind '0' "precision"
+         | Lit_padding _ as pad, _ -> pad
+         | Arg_padding _ as pad, _ -> pad in
+
+    (* Check that padty <> Zeros. *)
+    let check_no_0 symb (type a) (type b) (pad : (a, b) padding) =
+      match pad with
+      | No_padding -> pad
+      | Lit_padding ((Left | Right), _) -> pad
+      | Arg_padding (Left | Right) -> pad
+      | Lit_padding (Zeros, width) ->
+        if legacy_behavior then Lit_padding (Right, width)
+        else incompatible_flag pct_ind str_ind symb "0"
+      | Arg_padding Zeros ->
+        if legacy_behavior then Arg_padding Right
+        else incompatible_flag pct_ind str_ind symb "0"
+    in
+
+    (* Get padding as a pad_option (see "%_", "%{", "%(" and "%[").
+       (no need for legacy mode tweaking, those were rejected by the
+       legacy parser as well) *)
+    let opt_of_pad c (type a) (type b) (pad : (a, b) padding) = match pad with
+      | No_padding -> None
+      | Lit_padding (Right, width) -> Some width
+      | Lit_padding (Zeros, width) ->
+        if legacy_behavior then Some width
+        else incompatible_flag pct_ind str_ind c "'0'"
+      | Lit_padding (Left, width) ->
+        if legacy_behavior then Some width
+        else incompatible_flag pct_ind str_ind c "'-'"
+      | Arg_padding _ -> incompatible_flag pct_ind str_ind c "'*'"
+    in
+    let get_pad_opt c = opt_of_pad c (get_pad ()) in
+    let get_padprec_opt c = opt_of_pad c (get_padprec ()) in
+
+    (* Get precision as a prec_option (see "%_f").
+       (no need for legacy mode tweaking, those were rejected by the
+       legacy parser as well) *)
+    let get_prec_opt () = match get_prec () with
+      | No_precision       -> None
+      | Lit_precision ndec -> Some ndec
+      | Arg_precision      -> incompatible_flag pct_ind str_ind '_' "'*'"
+    in
+
+    let fmt_result = match symb with
+    | ',' ->
+      parse str_ind end_ind
+    | 'c' ->
+      let char_format fmt_rest = (* %c *)
+        if get_ign ()
+        then Fmt_EBB (Ignored_param (Ignored_char, fmt_rest))
+        else Fmt_EBB (Char fmt_rest)
+      in
+      let scan_format fmt_rest = (* %0c *)
+        if get_ign ()
+        then Fmt_EBB (Ignored_param (Ignored_scan_next_char, fmt_rest))
+        else Fmt_EBB (Scan_next_char fmt_rest)
+      in
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      begin match get_pad_opt 'c' with
+        | None -> char_format fmt_rest
+        | Some 0 -> scan_format fmt_rest
+        | Some _n ->
+           if not legacy_behavior
+           then invalid_nonnull_char_width str_ind
+           else (* legacy ignores %c widths *) char_format fmt_rest
+      end
+    | 'C' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then Fmt_EBB (Ignored_param (Ignored_caml_char,fmt_rest))
+      else Fmt_EBB (Caml_char fmt_rest)
+    | 's' ->
+      let pad = check_no_0 symb (get_padprec ()) in
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then
+        let ignored = Ignored_string (get_padprec_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padding_fmt_EBB (pad', fmt_rest') =
+          make_padding_fmt_ebb pad fmt_rest in
+        Fmt_EBB (String (pad', fmt_rest'))
+    | 'S' ->
+      let pad = check_no_0 symb (get_padprec ()) in
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then
+        let ignored = Ignored_caml_string (get_padprec_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padding_fmt_EBB (pad', fmt_rest') =
+          make_padding_fmt_ebb pad fmt_rest in
+        Fmt_EBB (Caml_string (pad', fmt_rest'))
+    | 'd' | 'i' | 'x' | 'X' | 'o' | 'u' ->
+      let iconv = compute_int_conv pct_ind str_ind (get_plus ()) (get_hash ())
+        (get_space ()) symb in
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then
+        let ignored = Ignored_int (iconv, get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padprec_fmt_EBB (pad', prec', fmt_rest') =
+          make_padprec_fmt_ebb (get_int_pad ()) (get_prec ()) fmt_rest in
+        Fmt_EBB (Int (iconv, pad', prec', fmt_rest'))
+    | 'N' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      let counter = Token_counter in
+      if get_ign () then
+        let ignored = Ignored_scan_get_counter counter in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        Fmt_EBB (Scan_get_counter (counter, fmt_rest))
+    | 'l' | 'n' | 'L' when str_ind=end_ind || not (is_int_base str.[str_ind]) ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      let counter = counter_of_char symb in
+      if get_ign () then
+        let ignored = Ignored_scan_get_counter counter in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        Fmt_EBB (Scan_get_counter (counter, fmt_rest))
+    | 'l' ->
+      let iconv =
+        compute_int_conv pct_ind (str_ind + 1) (get_plus ()) (get_hash ())
+          (get_space ()) str.[str_ind] in
+      let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+      if get_ign () then
+        let ignored = Ignored_int32 (iconv, get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padprec_fmt_EBB (pad', prec', fmt_rest') =
+          make_padprec_fmt_ebb (get_int_pad ()) (get_prec ()) fmt_rest in
+        Fmt_EBB (Int32 (iconv, pad', prec', fmt_rest'))
+    | 'n' ->
+      let iconv =
+        compute_int_conv pct_ind (str_ind + 1) (get_plus ())
+          (get_hash ()) (get_space ()) str.[str_ind] in
+      let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+      if get_ign () then
+        let ignored = Ignored_nativeint (iconv, get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padprec_fmt_EBB (pad', prec', fmt_rest') =
+          make_padprec_fmt_ebb (get_int_pad ()) (get_prec ()) fmt_rest in
+        Fmt_EBB (Nativeint (iconv, pad', prec', fmt_rest'))
+    | 'L' ->
+      let iconv =
+        compute_int_conv pct_ind (str_ind + 1) (get_plus ()) (get_hash ())
+          (get_space ()) str.[str_ind] in
+      let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+      if get_ign () then
+        let ignored = Ignored_int64 (iconv, get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padprec_fmt_EBB (pad', prec', fmt_rest') =
+          make_padprec_fmt_ebb (get_int_pad ()) (get_prec ()) fmt_rest in
+        Fmt_EBB (Int64 (iconv, pad', prec', fmt_rest'))
+    | 'f' | 'e' | 'E' | 'g' | 'G' | 'F' | 'h' | 'H' ->
+      let fconv =
+        compute_float_conv pct_ind str_ind
+          (get_plus ()) (get_hash ()) (get_space ()) symb in
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then
+        let ignored = Ignored_float (get_pad_opt '_', get_prec_opt ()) in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padprec_fmt_EBB (pad', prec', fmt_rest') =
+          make_padprec_fmt_ebb (get_pad ()) (get_prec ()) fmt_rest in
+        Fmt_EBB (Float (fconv, pad', prec', fmt_rest'))
+    | 'b' | 'B' ->
+      let pad = check_no_0 symb (get_padprec ()) in
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then
+        let ignored = Ignored_bool (get_padprec_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padding_fmt_EBB (pad', fmt_rest') =
+          make_padding_fmt_ebb pad fmt_rest in
+        Fmt_EBB (Bool (pad', fmt_rest'))
+    | 'a' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Alpha fmt_rest)
+    | 't' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Theta fmt_rest)
+    | 'r' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then Fmt_EBB (Ignored_param (Ignored_reader, fmt_rest))
+      else Fmt_EBB (Reader fmt_rest)
+    | '!' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Flush fmt_rest)
+    | ('%' | '@') as c ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Char_literal (c, fmt_rest))
+    | '{' ->
+      let sub_end = search_subformat_end str_ind end_ind '}' in
+      let Fmt_EBB sub_fmt = parse str_ind sub_end in
+      let Fmt_EBB fmt_rest = parse (sub_end + 2) end_ind in
+      let sub_fmtty = fmtty_of_fmt sub_fmt in
+      if get_ign () then
+        let ignored = Ignored_format_arg (get_pad_opt '_', sub_fmtty) in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        Fmt_EBB (Format_arg (get_pad_opt '{', sub_fmtty, fmt_rest))
+    | '(' ->
+      let sub_end = search_subformat_end str_ind end_ind ')' in
+      let Fmt_EBB fmt_rest = parse (sub_end + 2) end_ind in
+      let Fmt_EBB sub_fmt = parse str_ind sub_end in
+      let sub_fmtty = fmtty_of_fmt sub_fmt in
+      if get_ign () then
+        let ignored = Ignored_format_subst (get_pad_opt '_', sub_fmtty) in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        Fmt_EBB (Format_subst (get_pad_opt '(', sub_fmtty, fmt_rest))
+    | '[' ->
+      let next_ind, char_set = parse_char_set str_ind end_ind in
+      let Fmt_EBB fmt_rest = parse next_ind end_ind in
+      if get_ign () then
+        let ignored = Ignored_scan_char_set (get_pad_opt '_', char_set) in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        Fmt_EBB (Scan_char_set (get_pad_opt '[', char_set, fmt_rest))
+    | '-' | '+' | '#' | ' ' | '_' ->
+      failwith_message
+        "invalid format %S: at character number %d, \
+         flag %C is only allowed after the '%%', before padding and precision"
+        str pct_ind symb
+    | _ ->
+      failwith_message
+        "invalid format %S: at character number %d, \
+         invalid conversion \"%%%c\"" str (str_ind - 1) symb
+    in
+    (* Check for unused options, and reject them as incompatible.
+
+       Such checks need to be disabled in legacy mode, as the legacy
+       parser silently ignored incompatible flags. *)
+    if not legacy_behavior then begin
+    if not !plus_used && plus then
+      incompatible_flag pct_ind str_ind symb "'+'";
+    if not !hash_used && hash then
+      incompatible_flag pct_ind str_ind symb "'#'";
+    if not !space_used && space then
+      incompatible_flag pct_ind str_ind symb "' '";
+    if not !pad_used  && Padding_EBB pad <> Padding_EBB No_padding then
+      incompatible_flag pct_ind str_ind symb "`padding'";
+    if not !prec_used && Precision_EBB prec <> Precision_EBB No_precision then
+      incompatible_flag pct_ind str_ind (if ign then '_' else symb)
+        "`precision'";
+    if ign && plus then incompatible_flag pct_ind str_ind '_' "'+'";
+    end;
+    (* this last test must not be disabled in legacy mode,
+       as ignoring it would typically result in a different typing
+       than what the legacy parser used *)
+    if not !ign_used && ign then
+      begin match symb with
+        (* argument-less formats can safely be ignored in legacy mode *)
+        | ('@' | '%' | '!' | ',') when legacy_behavior -> ()
+        | _ ->
+          incompatible_flag pct_ind str_ind symb "'_'"
+      end;
+    fmt_result
+
+  (* Parse formatting information (after '@'). *)
+  and parse_after_at : type e f . int -> int -> (_, _, e, f) fmt_ebb =
+  fun str_ind end_ind ->
+    if str_ind = end_ind then Fmt_EBB (Char_literal ('@', End_of_format))
+    else
+      match str.[str_ind] with
+      | '[' ->
+        parse_tag false (str_ind + 1) end_ind
+      | ']' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Close_box, fmt_rest))
+      | '{' ->
+        parse_tag true (str_ind + 1) end_ind
+      | '}' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Close_tag, fmt_rest))
+      | ',' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Break ("@,", 0, 0), fmt_rest))
+      | ' ' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Break ("@ ", 1, 0), fmt_rest))
+      | ';' ->
+        parse_good_break (str_ind + 1) end_ind
+      | '?' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (FFlush, fmt_rest))
+      | '\n' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Force_newline, fmt_rest))
+      | '.' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Flush_newline, fmt_rest))
+      | '<' ->
+        parse_magic_size (str_ind + 1) end_ind
+      | '@' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Escaped_at, fmt_rest))
+      | '%' when str_ind + 1 < end_ind && str.[str_ind + 1] = '%' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 2) end_ind in
+        Fmt_EBB (Formatting_lit (Escaped_percent, fmt_rest))
+      | '%' ->
+        let Fmt_EBB fmt_rest = parse str_ind end_ind in
+        Fmt_EBB (Char_literal ('@', fmt_rest))
+      | c ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Scan_indic c, fmt_rest))
+
+  (* Try to read the optional <name> after "@{" or "@[". *)
+  and parse_tag : type e f . bool -> int -> int -> (_, _, e, f) fmt_ebb =
+  fun is_open_tag str_ind end_ind ->
+    try
+      if str_ind = end_ind then raise Not_found;
+      match str.[str_ind] with
+      | '<' ->
+        let ind = String.index_from str (str_ind + 1) '>' in
+        if ind >= end_ind then raise Not_found;
+        let sub_str = String.sub str str_ind (ind - str_ind + 1) in
+        let Fmt_EBB fmt_rest = parse (ind + 1) end_ind in
+        let Fmt_EBB sub_fmt = parse str_ind (ind + 1) in
+        let sub_format = Format (sub_fmt, sub_str) in
+        let formatting =
+          if is_open_tag then Open_tag sub_format else Open_box sub_format in
+        Fmt_EBB (Formatting_gen (formatting, fmt_rest))
+      | _ ->
+        raise Not_found
+    with Not_found ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      let sub_format = Format (End_of_format, "") in
+      let formatting =
+        if is_open_tag then Open_tag sub_format else Open_box sub_format in
+      Fmt_EBB (Formatting_gen (formatting, fmt_rest))
+
+  (* Try to read the optional <width offset> after "@;". *)
+  and parse_good_break : type e f . int -> int -> (_, _, e, f) fmt_ebb =
+  fun str_ind end_ind ->
+    let next_ind, formatting_lit =
+      try
+        if str_ind = end_ind || str.[str_ind] <> '<' then raise Not_found;
+        let str_ind_1 = parse_spaces (str_ind + 1) end_ind in
+        match str.[str_ind_1] with
+        | '0' .. '9' | '-' -> (
+          let str_ind_2, width = parse_integer str_ind_1 end_ind in
+            let str_ind_3 = parse_spaces str_ind_2 end_ind in
+            match str.[str_ind_3] with
+              | '>' ->
+                let s = String.sub str (str_ind-2) (str_ind_3-str_ind+3) in
+                str_ind_3 + 1, Break (s, width, 0)
+              | '0' .. '9' | '-' ->
+                let str_ind_4, offset = parse_integer str_ind_3 end_ind in
+                let str_ind_5 = parse_spaces str_ind_4 end_ind in
+                if str.[str_ind_5] <> '>' then raise Not_found;
+                let s = String.sub str (str_ind-2) (str_ind_5-str_ind+3) in
+                str_ind_5 + 1, Break (s, width, offset)
+              | _ -> raise Not_found
+        )
+        | _ -> raise Not_found
+      with Not_found | Failure _ ->
+        str_ind, Break ("@;", 1, 0)
+    in
+    let Fmt_EBB fmt_rest = parse next_ind end_ind in
+    Fmt_EBB (Formatting_lit (formatting_lit, fmt_rest))
+
+  (* Parse the size in a <n>. *)
+  and parse_magic_size : type e f . int -> int -> (_, _, e, f) fmt_ebb =
+  fun str_ind end_ind ->
+    match
+      try
+        let str_ind_1 = parse_spaces str_ind end_ind in
+        match str.[str_ind_1] with
+        | '0' .. '9' | '-' ->
+          let str_ind_2, size = parse_integer str_ind_1 end_ind in
+          let str_ind_3 = parse_spaces str_ind_2 end_ind in
+          if str.[str_ind_3] <> '>' then raise Not_found;
+          let s = String.sub str (str_ind - 2) (str_ind_3 - str_ind + 3) in
+          Some (str_ind_3 + 1, Magic_size (s, size))
+        | _ -> None
+      with Not_found | Failure _ ->
+        None
+    with
+    | Some (next_ind, formatting_lit) ->
+      let Fmt_EBB fmt_rest = parse next_ind end_ind in
+      Fmt_EBB (Formatting_lit (formatting_lit, fmt_rest))
+    | None ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Formatting_lit (Scan_indic '<', fmt_rest))
+
+  (* Parse and construct a char set. *)
+  and parse_char_set str_ind end_ind =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+
+    let char_set = create_char_set () in
+    let add_char c =
+      add_in_char_set char_set c;
+    in
+    let add_range c c' =
+      for i = int_of_char c to int_of_char c' do
+        add_in_char_set char_set (char_of_int i);
+      done;
+    in
+
+    let fail_single_percent str_ind =
+      failwith_message
+        "invalid format %S: '%%' alone is not accepted in character sets, \
+         use %%%% instead at position %d." str str_ind
+    in
+
+    (* Parse the first character of a char set. *)
+    let rec parse_char_set_start str_ind end_ind =
+      if str_ind = end_ind then unexpected_end_of_format end_ind;
+      let c = str.[str_ind] in
+      parse_char_set_after_char (str_ind + 1) end_ind c
+
+    (* Parse the content of a char set until the first ']'. *)
+    and parse_char_set_content str_ind end_ind =
+      if str_ind = end_ind then unexpected_end_of_format end_ind;
+      match str.[str_ind] with
+      | ']' ->
+        str_ind + 1
+      | '-' ->
+        add_char '-';
+        parse_char_set_content (str_ind + 1) end_ind
+      | c ->
+        parse_char_set_after_char (str_ind + 1) end_ind c
+
+    (* Test for range in char set. *)
+    and parse_char_set_after_char str_ind end_ind c =
+      if str_ind = end_ind then unexpected_end_of_format end_ind;
+      match str.[str_ind] with
+      | ']' ->
+        add_char c;
+        str_ind + 1
+      | '-' ->
+        parse_char_set_after_minus (str_ind + 1) end_ind c
+      | ('%' | '@') as c' when c = '%' ->
+        add_char c';
+        parse_char_set_content (str_ind + 1) end_ind
+      | c' ->
+        if c = '%' then fail_single_percent str_ind;
+        (* note that '@' alone is accepted, as done by the legacy
+           implementation; the documentation specifically requires %@
+           so we could warn on that *)
+        add_char c;
+        parse_char_set_after_char (str_ind + 1) end_ind c'
+
+    (* Manage range in char set (except if the '-' the last char before ']') *)
+    and parse_char_set_after_minus str_ind end_ind c =
+      if str_ind = end_ind then unexpected_end_of_format end_ind;
+      match str.[str_ind] with
+      | ']' ->
+        add_char c;
+        add_char '-';
+        str_ind + 1
+      | '%' ->
+        if str_ind + 1 = end_ind then unexpected_end_of_format end_ind;
+        begin match str.[str_ind + 1] with
+          | ('%' | '@') as c' ->
+            add_range c c';
+            parse_char_set_content (str_ind + 2) end_ind
+          | _ -> fail_single_percent str_ind
+        end
+      | c' ->
+        add_range c c';
+        parse_char_set_content (str_ind + 1) end_ind
+    in
+    let str_ind, reverse =
+      if str_ind = end_ind then unexpected_end_of_format end_ind;
+      match str.[str_ind] with
+        | '^' -> str_ind + 1, true
+        | _ -> str_ind, false in
+    let next_ind = parse_char_set_start str_ind end_ind in
+    let char_set = freeze_char_set char_set in
+    next_ind, (if reverse then rev_char_set char_set else char_set)
+
+  (* Consume all next spaces, raise an Failure if end_ind is reached. *)
+  and parse_spaces str_ind end_ind =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    if str.[str_ind] = ' ' then parse_spaces (str_ind + 1) end_ind else str_ind
+
+  (* Read a positive integer from the string, raise a Failure if end_ind is
+     reached. *)
+  and parse_positive str_ind end_ind acc =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    match str.[str_ind] with
+    | '0' .. '9' as c ->
+      let new_acc = acc * 10 + (int_of_char c - int_of_char '0') in
+      if new_acc > Sys.max_string_length then
+        failwith_message
+          "invalid format %S: integer %d is greater than the limit %d"
+          str new_acc Sys.max_string_length
+      else
+        parse_positive (str_ind + 1) end_ind new_acc
+    | _ -> str_ind, acc
+
+  (* Read a positive or negative integer from the string, raise a Failure
+     if end_ind is reached. *)
+  and parse_integer str_ind end_ind =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    match str.[str_ind] with
+    | '0' .. '9' -> parse_positive str_ind end_ind 0
+    | '-' -> (
+      if str_ind + 1 = end_ind then unexpected_end_of_format end_ind;
+      match str.[str_ind + 1] with
+      | '0' .. '9' ->
+        let next_ind, n = parse_positive (str_ind + 1) end_ind 0 in
+        next_ind, -n
+      | c ->
+        expected_character (str_ind + 1) "digit" c
+    )
+    | _ -> assert false
+
+  (* Add a literal to a format from a literal character sub-sequence. *)
+  and add_literal : type a d e f .
+      int -> int -> (a, _, _, d, e, f) fmt ->
+      (_, _, e, f) fmt_ebb =
+  fun lit_start str_ind fmt -> match str_ind - lit_start with
+    | 0    -> Fmt_EBB fmt
+    | 1    -> Fmt_EBB (Char_literal (str.[lit_start], fmt))
+    | size -> Fmt_EBB (String_literal (String.sub str lit_start size, fmt))
+
+  (* Search the end of the current sub-format
+     (i.e. the corresponding "%}" or "%)") *)
+  and search_subformat_end str_ind end_ind c =
+    if str_ind = end_ind then
+      failwith_message
+        "invalid format %S: unclosed sub-format, \
+         expected \"%%%c\" at character number %d" str c end_ind;
+    match str.[str_ind] with
+    | '%' ->
+      if str_ind + 1 = end_ind then unexpected_end_of_format end_ind;
+      if str.[str_ind + 1] = c then (* End of format found *) str_ind else
+        begin match str.[str_ind + 1] with
+        | '_' ->
+          (* Search for "%_(" or "%_{". *)
+          if str_ind + 2 = end_ind then unexpected_end_of_format end_ind;
+          begin match str.[str_ind + 2] with
+          | '{' ->
+            let sub_end = search_subformat_end (str_ind + 3) end_ind '}' in
+            search_subformat_end (sub_end + 2) end_ind c
+          | '(' ->
+            let sub_end = search_subformat_end (str_ind + 3) end_ind ')' in
+            search_subformat_end (sub_end + 2) end_ind c
+          | _ -> search_subformat_end (str_ind + 3) end_ind c
+          end
+        | '{' ->
+          (* %{...%} sub-format found. *)
+          let sub_end = search_subformat_end (str_ind + 2) end_ind '}' in
+          search_subformat_end (sub_end + 2) end_ind c
+        | '(' ->
+          (* %(...%) sub-format found. *)
+          let sub_end = search_subformat_end (str_ind + 2) end_ind ')' in
+          search_subformat_end (sub_end + 2) end_ind c
+        | '}' ->
+          (* Error: %(...%}. *)
+          expected_character (str_ind + 1) "character ')'" '}'
+        | ')' ->
+          (* Error: %{...%). *)
+          expected_character (str_ind + 1) "character '}'" ')'
+        | _ ->
+          search_subformat_end (str_ind + 2) end_ind c
+        end
+    | _ -> search_subformat_end (str_ind + 1) end_ind c
+
+  (* Check if symb is a valid int conversion after "%l", "%n" or "%L" *)
+  and is_int_base symb = match symb with
+    | 'd' | 'i' | 'x' | 'X' | 'o' | 'u' -> true
+    | _ -> false
+
+  (* Convert a char (l, n or L) to its associated counter. *)
+  and counter_of_char symb = match symb with
+    | 'l' -> Line_counter  | 'n' -> Char_counter
+    | 'L' -> Token_counter | _ -> assert false
+
+  (* Convert (plus, symb) to its associated int_conv. *)
+  and compute_int_conv pct_ind str_ind plus hash space symb =
+    match plus, hash, space, symb with
+    | false, false, false, 'd' -> Int_d  | false, false, false, 'i' -> Int_i
+    | false, false,  true, 'd' -> Int_sd | false, false,  true, 'i' -> Int_si
+    |  true, false, false, 'd' -> Int_pd |  true, false, false, 'i' -> Int_pi
+    | false, false, false, 'x' -> Int_x  | false, false, false, 'X' -> Int_X
+    | false,  true, false, 'x' -> Int_Cx | false,  true, false, 'X' -> Int_CX
+    | false, false, false, 'o' -> Int_o
+    | false,  true, false, 'o' -> Int_Co
+    | false, false, false, 'u' -> Int_u
+    | false,  true, false, 'd' -> Int_Cd
+    | false,  true, false, 'i' -> Int_Ci
+    | false,  true, false, 'u' -> Int_Cu
+    | _, true, _, 'x' when legacy_behavior -> Int_Cx
+    | _, true, _, 'X' when legacy_behavior -> Int_CX
+    | _, true, _, 'o' when legacy_behavior -> Int_Co
+    | _, true, _, ('d' | 'i' | 'u') ->
+      if legacy_behavior then (* ignore *)
+        compute_int_conv pct_ind str_ind plus false space symb
+      else incompatible_flag pct_ind str_ind symb "'#'"
+    | true, _, true, _ ->
+      if legacy_behavior then
+        (* plus and space: legacy implementation prefers plus *)
+        compute_int_conv pct_ind str_ind plus hash false symb
+      else incompatible_flag pct_ind str_ind ' ' "'+'"
+    | false, _, true, _    ->
+      if legacy_behavior then (* ignore *)
+        compute_int_conv pct_ind str_ind plus hash false symb
+      else incompatible_flag pct_ind str_ind symb "' '"
+    | true, _, false, _    ->
+      if legacy_behavior then (* ignore *)
+        compute_int_conv pct_ind str_ind false hash space symb
+      else incompatible_flag pct_ind str_ind symb "'+'"
+    | false, _, false, _ -> assert false
+
+  (* Convert (plus, space, symb) to its associated float_conv. *)
+  and compute_float_conv pct_ind str_ind plus hash space symb =
+    let flag = match plus, space with
+    | false, false -> Float_flag_
+    | false,  true -> Float_flag_s
+    |  true, false -> Float_flag_p
+    |  true,  true ->
+      (* plus and space: legacy implementation prefers plus *)
+      if legacy_behavior then Float_flag_p
+      else incompatible_flag pct_ind str_ind ' ' "'+'" in
+    let kind = match hash, symb with
+    | _, 'f' -> Float_f
+    | _, 'e' -> Float_e
+    | _, 'E' -> Float_E
+    | _, 'g' -> Float_g
+    | _, 'G' -> Float_G
+    | _, 'h' -> Float_h
+    | _, 'H' -> Float_H
+    | false, 'F' -> Float_F
+    | true, 'F' -> Float_CF
+    | _ -> assert false in
+    flag, kind
+
+  (* Raise [Failure] with a friendly error message about incompatible options.*)
+  and incompatible_flag : type a . int -> int -> char -> string -> a =
+    fun pct_ind str_ind symb option ->
+      let subfmt = String.sub str pct_ind (str_ind - pct_ind) in
+      failwith_message
+        "invalid format %S: at character number %d, \
+         %s is incompatible with '%c' in sub-format %S"
+        str pct_ind option symb subfmt
+
+  in parse 0 (String.length str)
+
+(******************************************************************************)
+                  (* Guarded string to format conversions *)
+
+(* Convert a string to a format according to an fmtty. *)
+(* Raise [Failure] with an error message in case of type mismatch. *)
+let format_of_string_fmtty str fmtty =
+  let Fmt_EBB fmt = fmt_ebb_of_string str in
+  try Format (type_format fmt fmtty, str)
+  with Type_mismatch ->
+    failwith_message
+      "bad input: format type mismatch between %S and %S"
+      str (string_of_fmtty fmtty)
+
+(* Convert a string to a format compatible with an other format. *)
+(* Raise [Failure] with an error message in case of type mismatch. *)
+let format_of_string_format str (Format (fmt', str')) =
+  let Fmt_EBB fmt = fmt_ebb_of_string str in
+  try Format (type_format fmt (fmtty_of_fmt fmt'), str)
+  with Type_mismatch ->
+    failwith_message
+      "bad input: format type mismatch between %S and %S" str str'
diff --git a/stdlib/camlinternalFormat.mli b/stdlib/camlinternalFormat.mli
new file mode 100644
index 00000000..bd97a793
--- /dev/null
+++ b/stdlib/camlinternalFormat.mli
@@ -0,0 +1,120 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                          Benoit Vaugon, ENSTA                          *)
+(*                                                                        *)
+(*   Copyright 2014 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* No comments, OCaml stdlib internal use only. *)
+
+open CamlinternalFormatBasics
+
+val is_in_char_set : char_set -> char -> bool
+val rev_char_set : char_set -> char_set
+
+type mutable_char_set = bytes
+val create_char_set : unit -> mutable_char_set
+val add_in_char_set : mutable_char_set -> char -> unit
+val freeze_char_set : mutable_char_set -> char_set
+
+type ('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb = Param_format_EBB :
+     ('x -> 'a, 'b, 'c, 'd, 'e, 'f) fmt ->
+     ('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb
+
+val param_format_of_ignored_format :
+  ('a, 'b, 'c, 'd, 'y, 'x) ignored -> ('x, 'b, 'c, 'y, 'e, 'f) fmt ->
+  ('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb
+
+type ('b, 'c) acc_formatting_gen =
+  | Acc_open_tag of ('b, 'c) acc
+  | Acc_open_box of ('b, 'c) acc
+
+and ('b, 'c) acc =
+  | Acc_formatting_lit of ('b, 'c) acc * formatting_lit
+  | Acc_formatting_gen of ('b, 'c) acc * ('b, 'c) acc_formatting_gen
+  | Acc_string_literal of ('b, 'c) acc * string
+  | Acc_char_literal   of ('b, 'c) acc * char
+  | Acc_data_string    of ('b, 'c) acc * string
+  | Acc_data_char      of ('b, 'c) acc * char
+  | Acc_delay          of ('b, 'c) acc * ('b -> 'c)
+  | Acc_flush          of ('b, 'c) acc
+  | Acc_invalid_arg    of ('b, 'c) acc * string
+  | End_of_acc
+
+type ('a, 'b) heter_list =
+  | Cons : 'c * ('a, 'b) heter_list -> ('c -> 'a, 'b) heter_list
+  | Nil : ('b, 'b) heter_list
+
+type ('b, 'c, 'e, 'f) fmt_ebb = Fmt_EBB :
+     ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt ->
+     ('b, 'c, 'e, 'f) fmt_ebb
+
+val make_printf :
+  (('b, 'c) acc -> 'd) -> ('b, 'c) acc ->
+  ('a, 'b, 'c, 'c, 'c, 'd) CamlinternalFormatBasics.fmt -> 'a
+
+val make_iprintf : ('s -> 'f) -> 's -> ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 'a
+
+val output_acc : out_channel -> (out_channel, unit) acc -> unit
+val bufput_acc : Buffer.t -> (Buffer.t, unit) acc -> unit
+val strput_acc : Buffer.t -> (unit, string) acc -> unit
+
+val type_format :
+  ('x, 'b, 'c, 't, 'u, 'v) CamlinternalFormatBasics.fmt ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmtty ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt
+
+val fmt_ebb_of_string :
+  ?legacy_behavior:bool -> string -> ('b, 'c, 'e, 'f) fmt_ebb
+(* warning: the optional flag legacy_behavior is EXPERIMENTAL and will
+   be removed in the next version. You must not set it explicitly. It
+   is only used by the type-checker implementation.
+*)
+
+val format_of_string_fmtty :
+  string ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmtty ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
+
+val format_of_string_format :
+  string ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6 ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
+
+val char_of_iconv : CamlinternalFormatBasics.int_conv -> char
+val string_of_formatting_lit : CamlinternalFormatBasics.formatting_lit -> string
+
+val string_of_fmtty :
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmtty -> string
+val string_of_fmt :
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt -> string
+
+val open_box_of_string : string -> int * block_type
+
+val symm :
+   ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+    'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+-> ('a2, 'b2, 'c2, 'd2, 'e2, 'f2,
+    'a1, 'b1, 'c1, 'd1, 'e1, 'f1) fmtty_rel
+
+val trans :
+   ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+    'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+-> ('a2, 'b2, 'c2, 'd2, 'e2, 'f2,
+    'a3, 'b3, 'c3, 'd3, 'e3, 'f3) fmtty_rel
+-> ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+    'a3, 'b3, 'c3, 'd3, 'e3, 'f3) fmtty_rel
+
+val recast :
+   ('a1, 'b1, 'c1, 'd1, 'e1, 'f1) fmt
+-> ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+    'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+-> ('a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmt
diff --git a/stdlib/camlinternalFormatBasics.ml b/stdlib/camlinternalFormatBasics.ml
new file mode 100644
index 00000000..61088232
--- /dev/null
+++ b/stdlib/camlinternalFormatBasics.ml
@@ -0,0 +1,690 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                          Benoit Vaugon, ENSTA                          *)
+(*                                                                        *)
+(*   Copyright 2014 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Padding position. *)
+type padty =
+  | Left   (* Text is left justified ('-' option).               *)
+  | Right  (* Text is right justified (no '-' option).           *)
+  | Zeros  (* Text is right justified by zeros (see '0' option). *)
+
+(***)
+
+(* Integer conversion. *)
+type int_conv =
+  | Int_d | Int_pd | Int_sd        (*  %d | %+d | % d  *)
+  | Int_i | Int_pi | Int_si        (*  %i | %+i | % i  *)
+  | Int_x | Int_Cx                 (*  %x | %#x        *)
+  | Int_X | Int_CX                 (*  %X | %#X        *)
+  | Int_o | Int_Co                 (*  %o | %#o        *)
+  | Int_u                          (*  %u              *)
+  | Int_Cd | Int_Ci | Int_Cu       (*  %#d | %#i | %#u *)
+
+(* Float conversion. *)
+type float_flag_conv =
+  | Float_flag_                    (* %[feEgGFhH] *)
+  | Float_flag_p                   (* %+[feEgGFhH] *)
+  | Float_flag_s                   (* % [feEgGFhH] *)
+type float_kind_conv =
+  | Float_f                        (*  %f | %+f | % f  *)
+  | Float_e                        (*  %e | %+e | % e  *)
+  | Float_E                        (*  %E | %+E | % E  *)
+  | Float_g                        (*  %g | %+g | % g  *)
+  | Float_G                        (*  %G | %+G | % G  *)
+  | Float_F                        (*  %F | %+F | % F  *)
+  | Float_h                        (*  %h | %+h | % h  *)
+  | Float_H                        (*  %H | %+H | % H  *)
+  | Float_CF                       (*  %#F| %+#F| % #F *)
+type float_conv = float_flag_conv * float_kind_conv
+
+(***)
+
+(* Char sets (see %[...]) are bitmaps implemented as 32-char strings. *)
+type char_set = string
+
+(***)
+
+(* Counter used in Scanf. *)
+type counter =
+  | Line_counter     (*  %l      *)
+  | Char_counter     (*  %n      *)
+  | Token_counter    (*  %N, %L  *)
+
+(***)
+
+(* Padding of strings and numbers. *)
+type ('a, 'b) padding =
+  (* No padding (ex: "%d") *)
+  | No_padding  : ('a, 'a) padding
+  (* Literal padding (ex: "%8d") *)
+  | Lit_padding : padty * int -> ('a, 'a) padding
+  (* Padding as extra argument (ex: "%*d") *)
+  | Arg_padding : padty -> (int -> 'a, 'a) padding
+
+(* Some formats, such as %_d,
+   only accept an optional number as padding option (no extra argument) *)
+type pad_option = int option
+
+(* Precision of floats and '0'-padding of integers. *)
+type ('a, 'b) precision =
+  (* No precision (ex: "%f") *)
+  | No_precision : ('a, 'a) precision
+  (* Literal precision (ex: "%.3f") *)
+  | Lit_precision : int -> ('a, 'a) precision
+  (* Precision as extra argument (ex: "%.*f") *)
+  | Arg_precision : (int -> 'a, 'a) precision
+
+(* Some formats, such as %_f,
+   only accept an optional number as precision option (no extra argument) *)
+type prec_option = int option
+
+(* see the Custom format combinator *)
+type ('a, 'b, 'c) custom_arity =
+  | Custom_zero : ('a, string, 'a) custom_arity
+  | Custom_succ : ('a, 'b, 'c) custom_arity ->
+    ('a, 'x -> 'b, 'x -> 'c) custom_arity
+
+(***)
+
+(*        Relational format types
+
+In the first format+gadts implementation, the type for %(..%) in the
+fmt GADT was as follows:
+
+| Format_subst :                                           (* %(...%) *)
+    pad_option * ('d1, 'q1, 'd2, 'q2) reader_nb_unifier *
+    ('x, 'b, 'c, 'd1, 'q1, 'u) fmtty *
+    ('u, 'b, 'c, 'q1, 'e1, 'f) fmt ->
+      (('x, 'b, 'c, 'd2, 'q2, 'u) format6 -> 'x, 'b, 'c, 'd1, 'e1, 'f) fmt
+
+Notice that the 'u parameter in 'f position in the format argument
+(('x, .., 'u) format6 -> ..) is equal to the 'u parameter in 'a
+position in the format tail (('u, .., 'f) fmt). This means that the
+type of the expected format parameter depends of where the %(...%)
+are in the format string:
+
+  # Printf.printf "%(%)"
+  - : (unit, out_channel, unit, '_a, '_a, unit)
+      CamlinternalFormatBasics.format6 -> unit
+  = <fun>
+  # Printf.printf "%(%)%d"
+  - : (int -> unit, out_channel, unit, '_a, '_a, int -> unit)
+      CamlinternalFormatBasics.format6 -> int -> unit
+  = <fun>
+
+On the contrary, the legacy typer gives a clever type that does not
+depend on the position of %(..%) in the format string. For example,
+%(%) will have the polymorphic type ('a, 'b, 'c, 'd, 'd, 'a): it can
+be concatenated to any format type, and only enforces the constraint
+that its 'a and 'f parameters are equal (no format arguments) and 'd
+and 'e are equal (no reader argument).
+
+The weakening of this parameter type in the GADT version broke user
+code (in fact it essentially made %(...%) unusable except at the last
+position of a format). In particular, the following would not work
+anymore:
+
+  fun sep ->
+    Format.printf "foo%(%)bar%(%)baz" sep sep
+
+As the type-checker would require two *incompatible* types for the %(%)
+in different positions.
+
+The solution to regain a general type for %(..%) is to generalize this
+technique, not only on the 'd, 'e parameters, but on all six
+parameters of a format: we introduce a "relational" type
+  ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+   'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+whose values are proofs that ('a1, .., 'f1) and ('a2, .., 'f2) morally
+correspond to the same format type: 'a1 is obtained from 'f1,'b1,'c1
+in the exact same way that 'a2 is obtained from 'f2,'b2,'c2, etc.
+
+For example, the relation between two format types beginning with a Char
+parameter is as follows:
+
+| Char_ty :                                                 (* %c  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (char -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     char -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+
+In the general case, the term structure of fmtty_rel is (almost[1])
+isomorphic to the fmtty of the previous implementation: every
+constructor is re-read with a binary, relational type, instead of the
+previous unary typing. fmtty can then be re-defined as the diagonal of
+fmtty_rel:
+
+  type ('a, 'b, 'c, 'd, 'e, 'f) fmtty =
+       ('a, 'b, 'c, 'd, 'e, 'f,
+        'a, 'b, 'c, 'd, 'e, 'f) fmtty_rel
+
+Once we have this fmtty_rel type in place, we can give the more
+general type to %(...%):
+
+| Format_subst :                                           (* %(...%) *)
+    pad_option *
+    ('g, 'h, 'i, 'j, 'k, 'l,
+     'g2, 'b, 'c, 'j2, 'd, 'a) fmtty_rel *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+    (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b, 'c, 'j2, 'e, 'f) fmt
+
+We accept any format (('g, 'h, 'i, 'j, 'k, 'l) format6) (this is
+completely unrelated to the type of the current format), but also
+require a proof that this format is in relation to another format that
+is concatenable to the format tail. When executing a %(...%) format
+(in camlinternalFormat.ml:make_printf or scanf.ml:make_scanf), we
+transtype the format along this relation using the 'recast' function
+to transpose between related format types.
+
+  val recast :
+     ('a1, 'b1, 'c1, 'd1, 'e1, 'f1) fmt
+  -> ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+      'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  -> ('a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmt
+
+NOTE [1]: the typing of Format_subst_ty requires not one format type, but
+two, one to establish the link between the format argument and the
+first six parameters, and the other for the link between the format
+argument and the last six parameters.
+
+| Format_subst_ty :                                         (* %(...%) *)
+    ('g, 'h, 'i, 'j, 'k, 'l,
+     'g1, 'b1, 'c1, 'j1, 'd1, 'a1) fmtty_rel *
+    ('g, 'h, 'i, 'j, 'k, 'l,
+     'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel *
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g1, 'b1, 'c1, 'j1, 'e1, 'f1,
+     ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b2, 'c2, 'j2, 'e2, 'f2) fmtty_rel
+
+When we generate a format AST, we generate exactly the same witness
+for both relations, and the witness-conversion functions in
+camlinternalFormat do rely on this invariant. For example, the
+function that proves that the relation is transitive
+
+  val trans :
+     ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+      'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  -> ('a2, 'b2, 'c2, 'd2, 'e2, 'f2,
+      'a3, 'b3, 'c3, 'd3, 'e3, 'f3) fmtty_rel
+  -> ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+      'a3, 'b3, 'c3, 'd3, 'e3, 'f3) fmtty_rel
+
+does assume that the two inputs have exactly the same term structure
+(and is only every used for argument witnesses of the
+Format_subst_ty constructor).
+*)
+
+(* Type of a block used by the Format pretty-printer. *)
+type block_type =
+  | Pp_hbox   (* Horizontal block no line breaking *)
+  | Pp_vbox   (* Vertical block each break leads to a new line *)
+  | Pp_hvbox  (* Horizontal-vertical block: same as vbox, except if this block
+                 is small enough to fit on a single line *)
+  | Pp_hovbox (* Horizontal or Vertical block: breaks lead to new line
+                 only when necessary to print the content of the block *)
+  | Pp_box    (* Horizontal or Indent block: breaks lead to new line
+                 only when necessary to print the content of the block, or
+                 when it leads to a new indentation of the current line *)
+  | Pp_fits   (* Internal usage: when a block fits on a single line *)
+
+(* Formatting element used by the Format pretty-printer. *)
+type formatting_lit =
+  | Close_box                                           (* @]   *)
+  | Close_tag                                           (* @}   *)
+  | Break of string * int * int          (* @, | @  | @; | @;<> *)
+  | FFlush                                              (* @?   *)
+  | Force_newline                                       (* @\n  *)
+  | Flush_newline                                       (* @.   *)
+  | Magic_size of string * int                          (* @<n> *)
+  | Escaped_at                                          (* @@   *)
+  | Escaped_percent                                     (* @%%  *)
+  | Scan_indic of char                                  (* @X   *)
+
+(* Formatting element used by the Format pretty-printer. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen =
+  | Open_tag : ('a, 'b, 'c, 'd, 'e, 'f) format6 ->      (* @{   *)
+    ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen
+  | Open_box : ('a, 'b, 'c, 'd, 'e, 'f) format6 ->      (* @[   *)
+    ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen
+
+(***)
+
+(* List of format type elements. *)
+(* In particular used to represent %(...%) and %{...%} contents. *)
+and ('a, 'b, 'c, 'd, 'e, 'f) fmtty =
+     ('a, 'b, 'c, 'd, 'e, 'f,
+      'a, 'b, 'c, 'd, 'e, 'f) fmtty_rel
+and ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel =
+  | Char_ty :                                                 (* %c  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (char -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       char -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | String_ty :                                               (* %s  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (string -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       string -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Int_ty :                                                  (* %d  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (int -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       int -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Int32_ty :                                                (* %ld *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (int32 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       int32 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Nativeint_ty :                                            (* %nd *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (nativeint -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       nativeint -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Int64_ty :                                                (* %Ld *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (int64 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       int64 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Float_ty :                                                (* %f  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (float -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       float -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Bool_ty :                                                 (* %B  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (bool -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       bool -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+
+  | Format_arg_ty :                                           (* %{...%} *)
+      ('g, 'h, 'i, 'j, 'k, 'l) fmtty *
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2)
+           fmtty_rel
+  | Format_subst_ty :                                         (* %(...%) *)
+      ('g, 'h, 'i, 'j, 'k, 'l,
+       'g1, 'b1, 'c1, 'j1, 'd1, 'a1) fmtty_rel *
+      ('g, 'h, 'i, 'j, 'k, 'l,
+       'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel *
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g1, 'b1, 'c1, 'j1, 'e1, 'f1,
+       ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b2, 'c2, 'j2, 'e2, 'f2)
+           fmtty_rel
+
+  (* Printf and Format specific constructors. *)
+  | Alpha_ty :                                                (* %a  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (('b1 -> 'x -> 'c1) -> 'x -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       ('b2 -> 'x -> 'c2) -> 'x -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Theta_ty :                                                (* %t  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (('b1 -> 'c1) -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       ('b2 -> 'c2) -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Any_ty :                                    (* Used for custom formats *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      ('x -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'x -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+
+  (* Scanf specific constructor. *)
+  | Reader_ty :                                               (* %r  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      ('x -> 'a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1,
+       'x -> 'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel
+  | Ignored_reader_ty :                                       (* %_r  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      ('a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel
+
+  | End_of_fmtty :
+      ('f1, 'b1, 'c1, 'd1, 'd1, 'f1,
+       'f2, 'b2, 'c2, 'd2, 'd2, 'f2) fmtty_rel
+
+(***)
+
+(* List of format elements. *)
+and ('a, 'b, 'c, 'd, 'e, 'f) fmt =
+  | Char :                                                   (* %c *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Caml_char :                                              (* %C *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  | String :                                                 (* %s *)
+      ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x, 'b, 'c, 'd, 'e, 'f) fmt
+  | Caml_string :                                            (* %S *)
+      ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x, 'b, 'c, 'd, 'e, 'f) fmt
+  | Int :                                                    (* %[dixXuo] *)
+      int_conv * ('x, 'y) padding * ('y, int -> 'a) precision *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x, 'b, 'c, 'd, 'e, 'f) fmt
+  | Int32 :                                                  (* %l[dixXuo] *)
+      int_conv * ('x, 'y) padding * ('y, int32 -> 'a) precision *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x, 'b, 'c, 'd, 'e, 'f) fmt
+  | Nativeint :                                              (* %n[dixXuo] *)
+      int_conv * ('x, 'y) padding * ('y, nativeint -> 'a) precision *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x, 'b, 'c, 'd, 'e, 'f) fmt
+  | Int64 :                                                  (* %L[dixXuo] *)
+      int_conv * ('x, 'y) padding * ('y, int64 -> 'a) precision *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x, 'b, 'c, 'd, 'e, 'f) fmt
+  | Float :                                                  (* %[feEgGFhH] *)
+      float_conv * ('x, 'y) padding * ('y, float -> 'a) precision *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x, 'b, 'c, 'd, 'e, 'f) fmt
+  | Bool :                                                   (* %[bB] *)
+      ('x, bool -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x, 'b, 'c, 'd, 'e, 'f) fmt
+  | Flush :                                                  (* %! *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt
+
+  | String_literal :                                         (* abc *)
+      string * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Char_literal :                                           (* x *)
+      char * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt
+
+  | Format_arg :                                             (* %{...%} *)
+      pad_option * ('g, 'h, 'i, 'j, 'k, 'l) fmtty *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Format_subst :                                           (* %(...%) *)
+      pad_option *
+      ('g, 'h, 'i, 'j, 'k, 'l,
+       'g2, 'b, 'c, 'j2, 'd, 'a) fmtty_rel *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b, 'c, 'j2, 'e, 'f) fmt
+
+  (* Printf and Format specific constructor. *)
+  | Alpha :                                                  (* %a *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (('b -> 'x -> 'c) -> 'x -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Theta :                                                  (* %t *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (('b -> 'c) -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+
+  (* Format specific constructor: *)
+  | Formatting_lit :                                         (* @_ *)
+      formatting_lit * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Formatting_gen :                                             (* @_ *)
+      ('a1, 'b, 'c, 'd1, 'e1, 'f1) formatting_gen *
+      ('f1, 'b, 'c, 'e1, 'e2, 'f2) fmt -> ('a1, 'b, 'c, 'd1, 'e2, 'f2) fmt
+
+  (* Scanf specific constructors: *)
+  | Reader :                                                 (* %r *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x -> 'a, 'b, 'c, ('b -> 'x) -> 'd, 'e, 'f) fmt
+  | Scan_char_set :                                          (* %[...] *)
+      pad_option * char_set * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (string -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Scan_get_counter :                                       (* %[nlNL] *)
+      counter * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (int -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Scan_next_char :                                         (* %0c *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Ignored_param :                                          (* %_ *)
+      ('a, 'b, 'c, 'd, 'y, 'x) ignored * ('x, 'b, 'c, 'y, 'e, 'f) fmt ->
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt
+
+  (* Custom printing format (PR#6452, GPR#140)
+
+     We include a type Custom of "custom converters", where an
+     arbitrary function can be used to convert one or more
+     arguments. There is no syntax for custom converters, it is only
+     intended for custom processors that wish to rely on the
+     stdlib-defined format GADTs.
+
+     For instance a pre-processor could choose to interpret strings
+     prefixed with ["!"] as format strings where [%{{ ... }}] is
+     a special form to pass a to_string function, so that one could
+     write:
+
+     {[
+       type t = { x : int; y : int }
+
+       let string_of_t t = Printf.sprintf "{ x = %d; y = %d }" t.x t.y
+
+       Printf.printf !"t = %{{string_of_t}}" { x = 42; y = 42 }
+     ]}
+  *)
+  | Custom :
+      ('a, 'x, 'y) custom_arity * (unit -> 'x) * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('y, 'b, 'c, 'd, 'e, 'f) fmt
+
+  (* end of a format specification *)
+  | End_of_format :
+        ('f, 'b, 'c, 'e, 'e, 'f) fmt
+
+(***)
+
+(* Type for ignored parameters (see "%_"). *)
+and ('a, 'b, 'c, 'd, 'e, 'f) ignored =
+  | Ignored_char :                                           (* %_c *)
+      ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_caml_char :                                      (* %_C *)
+      ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_string :                                         (* %_s *)
+      pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_caml_string :                                    (* %_S *)
+      pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_int :                                            (* %_d *)
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_int32 :                                          (* %_ld *)
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_nativeint :                                      (* %_nd *)
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_int64 :                                          (* %_Ld *)
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_float :                                          (* %_f *)
+      pad_option * prec_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_bool :                                           (* %_B *)
+      pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_format_arg :                                     (* %_{...%} *)
+      pad_option * ('g, 'h, 'i, 'j, 'k, 'l) fmtty ->
+        ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_format_subst :                                   (* %_(...%) *)
+      pad_option * ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        ('a, 'b, 'c, 'd, 'e, 'f) ignored
+  | Ignored_reader :                                         (* %_r *)
+      ('a, 'b, 'c, ('b -> 'x) -> 'd, 'd, 'a) ignored
+  | Ignored_scan_char_set :                                  (* %_[...] *)
+      pad_option * char_set -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_scan_get_counter :                               (* %_[nlNL] *)
+      counter -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_scan_next_char :                                 (* %_0c *)
+      ('a, 'b, 'c, 'd, 'd, 'a) ignored
+
+and ('a, 'b, 'c, 'd, 'e, 'f) format6 =
+  Format of ('a, 'b, 'c, 'd, 'e, 'f) fmt * string
+
+let rec erase_rel : type a b c d e f g h i j k l .
+  (a, b, c, d, e, f,
+   g, h, i, j, k, l) fmtty_rel -> (a, b, c, d, e, f) fmtty
+= function
+  | Char_ty rest ->
+    Char_ty (erase_rel rest)
+  | String_ty rest ->
+    String_ty (erase_rel rest)
+  | Int_ty rest ->
+    Int_ty (erase_rel rest)
+  | Int32_ty rest ->
+    Int32_ty (erase_rel rest)
+  | Int64_ty rest ->
+    Int64_ty (erase_rel rest)
+  | Nativeint_ty rest ->
+    Nativeint_ty (erase_rel rest)
+  | Float_ty rest ->
+    Float_ty (erase_rel rest)
+  | Bool_ty rest ->
+    Bool_ty (erase_rel rest)
+  | Format_arg_ty (ty, rest) ->
+    Format_arg_ty (ty, erase_rel rest)
+  | Format_subst_ty (ty1, _ty2, rest) ->
+    Format_subst_ty (ty1, ty1, erase_rel rest)
+  | Alpha_ty rest ->
+    Alpha_ty (erase_rel rest)
+  | Theta_ty rest ->
+    Theta_ty (erase_rel rest)
+  | Any_ty rest ->
+    Any_ty (erase_rel rest)
+  | Reader_ty rest ->
+    Reader_ty (erase_rel rest)
+  | Ignored_reader_ty rest ->
+    Ignored_reader_ty (erase_rel rest)
+  | End_of_fmtty -> End_of_fmtty
+
+(******************************************************************************)
+                         (* Format type concatenation *)
+
+(* Concatenate two format types. *)
+(* Used by:
+   * reader_nb_unifier_of_fmtty to count readers in an fmtty,
+   * Scanf.take_fmtty_format_readers to extract readers inside %(...%),
+   * CamlinternalFormat.fmtty_of_ignored_format to extract format type. *)
+
+(*
+let rec concat_fmtty : type a b c d e f g h .
+    (a, b, c, d, e, f) fmtty ->
+    (f, b, c, e, g, h) fmtty ->
+    (a, b, c, d, g, h) fmtty =
+*)
+let rec concat_fmtty :
+  type a1 b1 c1 d1 e1 f1
+       a2 b2 c2 d2 e2 f2
+       g1 j1 g2 j2
+  .
+    (g1, b1, c1, j1, d1, a1,
+     g2, b2, c2, j2, d2, a2) fmtty_rel ->
+    (a1, b1, c1, d1, e1, f1,
+     a2, b2, c2, d2, e2, f2) fmtty_rel ->
+    (g1, b1, c1, j1, e1, f1,
+     g2, b2, c2, j2, e2, f2) fmtty_rel =
+fun fmtty1 fmtty2 -> match fmtty1 with
+  | Char_ty rest ->
+    Char_ty (concat_fmtty rest fmtty2)
+  | String_ty rest ->
+    String_ty (concat_fmtty rest fmtty2)
+  | Int_ty rest ->
+    Int_ty (concat_fmtty rest fmtty2)
+  | Int32_ty rest ->
+    Int32_ty (concat_fmtty rest fmtty2)
+  | Nativeint_ty rest ->
+    Nativeint_ty (concat_fmtty rest fmtty2)
+  | Int64_ty rest ->
+    Int64_ty (concat_fmtty rest fmtty2)
+  | Float_ty rest ->
+    Float_ty (concat_fmtty rest fmtty2)
+  | Bool_ty rest ->
+    Bool_ty (concat_fmtty rest fmtty2)
+  | Alpha_ty rest ->
+    Alpha_ty (concat_fmtty rest fmtty2)
+  | Theta_ty rest ->
+    Theta_ty (concat_fmtty rest fmtty2)
+  | Any_ty rest ->
+    Any_ty (concat_fmtty rest fmtty2)
+  | Reader_ty rest ->
+    Reader_ty (concat_fmtty rest fmtty2)
+  | Ignored_reader_ty rest ->
+    Ignored_reader_ty (concat_fmtty rest fmtty2)
+  | Format_arg_ty (ty, rest) ->
+    Format_arg_ty (ty, concat_fmtty rest fmtty2)
+  | Format_subst_ty (ty1, ty2, rest) ->
+    Format_subst_ty (ty1, ty2, concat_fmtty rest fmtty2)
+  | End_of_fmtty -> fmtty2
+
+(******************************************************************************)
+                           (* Format concatenation *)
+
+(* Concatenate two formats. *)
+let rec concat_fmt : type a b c d e f g h .
+    (a, b, c, d, e, f) fmt ->
+    (f, b, c, e, g, h) fmt ->
+    (a, b, c, d, g, h) fmt =
+fun fmt1 fmt2 -> match fmt1 with
+  | String (pad, rest) ->
+    String (pad, concat_fmt rest fmt2)
+  | Caml_string (pad, rest) ->
+    Caml_string (pad, concat_fmt rest fmt2)
+
+  | Int (iconv, pad, prec, rest) ->
+    Int (iconv, pad, prec, concat_fmt rest fmt2)
+  | Int32 (iconv, pad, prec, rest) ->
+    Int32 (iconv, pad, prec, concat_fmt rest fmt2)
+  | Nativeint (iconv, pad, prec, rest) ->
+    Nativeint (iconv, pad, prec, concat_fmt rest fmt2)
+  | Int64 (iconv, pad, prec, rest) ->
+    Int64 (iconv, pad, prec, concat_fmt rest fmt2)
+  | Float (fconv, pad, prec, rest) ->
+    Float (fconv, pad, prec, concat_fmt rest fmt2)
+
+  | Char (rest) ->
+    Char (concat_fmt rest fmt2)
+  | Caml_char rest ->
+    Caml_char (concat_fmt rest fmt2)
+  | Bool (pad, rest) ->
+    Bool (pad, concat_fmt rest fmt2)
+  | Alpha rest ->
+    Alpha (concat_fmt rest fmt2)
+  | Theta rest ->
+    Theta (concat_fmt rest fmt2)
+  | Custom (arity, f, rest) ->
+    Custom (arity, f, concat_fmt rest fmt2)
+  | Reader rest ->
+    Reader (concat_fmt rest fmt2)
+  | Flush rest ->
+    Flush (concat_fmt rest fmt2)
+
+  | String_literal (str, rest) ->
+    String_literal (str, concat_fmt rest fmt2)
+  | Char_literal (chr, rest) ->
+    Char_literal   (chr, concat_fmt rest fmt2)
+
+  | Format_arg (pad, fmtty, rest) ->
+    Format_arg   (pad, fmtty, concat_fmt rest fmt2)
+  | Format_subst (pad, fmtty, rest) ->
+    Format_subst (pad, fmtty, concat_fmt rest fmt2)
+
+  | Scan_char_set (width_opt, char_set, rest) ->
+    Scan_char_set (width_opt, char_set, concat_fmt rest fmt2)
+  | Scan_get_counter (counter, rest) ->
+    Scan_get_counter (counter, concat_fmt rest fmt2)
+  | Scan_next_char (rest) ->
+    Scan_next_char (concat_fmt rest fmt2)
+  | Ignored_param (ign, rest) ->
+    Ignored_param (ign, concat_fmt rest fmt2)
+
+  | Formatting_lit (fmting_lit, rest) ->
+    Formatting_lit (fmting_lit, concat_fmt rest fmt2)
+  | Formatting_gen (fmting_gen, rest) ->
+    Formatting_gen (fmting_gen, concat_fmt rest fmt2)
+
+  | End_of_format ->
+    fmt2
diff --git a/stdlib/camlinternalFormatBasics.mli b/stdlib/camlinternalFormatBasics.mli
new file mode 100644
index 00000000..adf76a26
--- /dev/null
+++ b/stdlib/camlinternalFormatBasics.mli
@@ -0,0 +1,327 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                          Benoit Vaugon, ENSTA                          *)
+(*                                                                        *)
+(*   Copyright 2014 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* No comments, OCaml stdlib internal use only. *)
+
+type padty = Left | Right | Zeros
+
+type int_conv =
+  | Int_d | Int_pd | Int_sd | Int_i | Int_pi | Int_si
+  | Int_x | Int_Cx | Int_X | Int_CX | Int_o | Int_Co | Int_u
+  | Int_Cd | Int_Ci | Int_Cu
+
+type float_flag_conv =
+  | Float_flag_ | Float_flag_p | Float_flag_s
+type float_kind_conv =
+  | Float_f | Float_e | Float_E | Float_g | Float_G
+  | Float_F | Float_h | Float_H | Float_CF
+type float_conv = float_flag_conv * float_kind_conv
+
+type char_set = string
+
+type counter = Line_counter | Char_counter | Token_counter
+
+type ('a, 'b) padding =
+  | No_padding  : ('a, 'a) padding
+  | Lit_padding : padty * int -> ('a, 'a) padding
+  | Arg_padding : padty -> (int -> 'a, 'a) padding
+
+type pad_option = int option
+
+type ('a, 'b) precision =
+  | No_precision : ('a, 'a) precision
+  | Lit_precision : int -> ('a, 'a) precision
+  | Arg_precision : (int -> 'a, 'a) precision
+
+type prec_option = int option
+
+type ('a, 'b, 'c) custom_arity =
+  | Custom_zero : ('a, string, 'a) custom_arity
+  | Custom_succ : ('a, 'b, 'c) custom_arity ->
+    ('a, 'x -> 'b, 'x -> 'c) custom_arity
+
+type block_type = Pp_hbox | Pp_vbox | Pp_hvbox | Pp_hovbox | Pp_box | Pp_fits
+
+type formatting_lit =
+  | Close_box
+  | Close_tag
+  | Break of string * int * int
+  | FFlush
+  | Force_newline
+  | Flush_newline
+  | Magic_size of string * int
+  | Escaped_at
+  | Escaped_percent
+  | Scan_indic of char
+
+type ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen =
+  | Open_tag : ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+    ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen
+  | Open_box : ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+    ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen
+
+and ('a, 'b, 'c, 'd, 'e, 'f) fmtty =
+    ('a, 'b, 'c, 'd, 'e, 'f,
+     'a, 'b, 'c, 'd, 'e, 'f) fmtty_rel
+and ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+   'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel =
+| Char_ty :                                                 (* %c  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (char -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     char -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| String_ty :                                               (* %s  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (string -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     string -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Int_ty :                                                  (* %d  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (int -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     int -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Int32_ty :                                                (* %ld *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (int32 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     int32 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Nativeint_ty :                                            (* %nd *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (nativeint -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     nativeint -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Int64_ty :                                                (* %Ld *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (int64 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     int64 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Float_ty :                                                (* %f  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (float -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     float -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Bool_ty :                                                 (* %B  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (bool -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     bool -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Format_arg_ty :                                           (* %{...%} *)
+    ('g, 'h, 'i, 'j, 'k, 'l) fmtty *
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Format_subst_ty :                                         (* %(...%) *)
+    ('g, 'h, 'i, 'j, 'k, 'l,
+     'g1, 'b1, 'c1, 'j1, 'd1, 'a1) fmtty_rel *
+    ('g, 'h, 'i, 'j, 'k, 'l,
+     'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel *
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g1, 'b1, 'c1, 'j1, 'e1, 'f1,
+     ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b2, 'c2, 'j2, 'e2, 'f2) fmtty_rel
+
+(* Printf and Format specific constructors. *)
+| Alpha_ty :                                                (* %a  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (('b1 -> 'x -> 'c1) -> 'x -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     ('b2 -> 'x -> 'c2) -> 'x -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Theta_ty :                                                (* %t  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (('b1 -> 'c1) -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     ('b2 -> 'c2) -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Any_ty :                                         (* Used for custom formats *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    ('x -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'x -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+
+(* Scanf specific constructor. *)
+| Reader_ty :                                               (* %r  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    ('x -> 'a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1,
+     'x -> 'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel
+| Ignored_reader_ty :                                       (* %_r  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    ('a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel
+
+| End_of_fmtty :
+    ('f1, 'b1, 'c1, 'd1, 'd1, 'f1,
+     'f2, 'b2, 'c2, 'd2, 'd2, 'f2) fmtty_rel
+
+(**)
+
+(** List of format elements. *)
+and ('a, 'b, 'c, 'd, 'e, 'f) fmt =
+| Char :                                                   (* %c *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Caml_char :                                              (* %C *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| String :                                                 (* %s *)
+    ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Caml_string :                                            (* %S *)
+    ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Int :                                                    (* %[dixXuo] *)
+    int_conv * ('x, 'y) padding * ('y, int -> 'a) precision *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Int32 :                                                  (* %l[dixXuo] *)
+    int_conv * ('x, 'y) padding * ('y, int32 -> 'a) precision *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Nativeint :                                              (* %n[dixXuo] *)
+    int_conv * ('x, 'y) padding * ('y, nativeint -> 'a) precision *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Int64 :                                                  (* %L[dixXuo] *)
+    int_conv * ('x, 'y) padding * ('y, int64 -> 'a) precision *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Float :                                                  (* %[feEgGFhH] *)
+    float_conv * ('x, 'y) padding * ('y, float -> 'a) precision *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Bool :                                                   (* %[bB] *)
+    ('x, bool -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Flush :                                                  (* %! *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt
+
+| String_literal :                                         (* abc *)
+    string * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt
+| Char_literal :                                           (* x *)
+    char * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt
+
+| Format_arg :                                             (* %{...%} *)
+    pad_option * ('g, 'h, 'i, 'j, 'k, 'l) fmtty *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Format_subst :                                           (* %(...%) *)
+    pad_option *
+    ('g, 'h, 'i, 'j, 'k, 'l,
+     'g2, 'b, 'c, 'j2, 'd, 'a) fmtty_rel *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+    (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b, 'c, 'j2, 'e, 'f) fmt
+
+(* Printf and Format specific constructor. *)
+| Alpha :                                                  (* %a *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (('b -> 'x -> 'c) -> 'x -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Theta :                                                  (* %t *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (('b -> 'c) -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+
+(* Format specific constructor: *)
+| Formatting_lit :                                         (* @_ *)
+    formatting_lit * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt
+| Formatting_gen :                                             (* @_ *)
+    ('a1, 'b, 'c, 'd1, 'e1, 'f1) formatting_gen *
+    ('f1, 'b, 'c, 'e1, 'e2, 'f2) fmt -> ('a1, 'b, 'c, 'd1, 'e2, 'f2) fmt
+
+(* Scanf specific constructors: *)
+| Reader :                                                 (* %r *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x -> 'a, 'b, 'c, ('b -> 'x) -> 'd, 'e, 'f) fmt
+| Scan_char_set :                                          (* %[...] *)
+    pad_option * char_set * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (string -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Scan_get_counter :                                       (* %[nlNL] *)
+    counter * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (int -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Scan_next_char :                                         (* %0c *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+    (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  (* %0c behaves as %c for printing, but when scanning it does not
+     consume the character from the input stream *)
+| Ignored_param :                                          (* %_ *)
+    ('a, 'b, 'c, 'd, 'y, 'x) ignored * ('x, 'b, 'c, 'y, 'e, 'f) fmt ->
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt
+
+(* Custom printing format *)
+| Custom :
+    ('a, 'x, 'y) custom_arity * (unit -> 'x) * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+    ('y, 'b, 'c, 'd, 'e, 'f) fmt
+
+| End_of_format :
+      ('f, 'b, 'c, 'e, 'e, 'f) fmt
+
+and ('a, 'b, 'c, 'd, 'e, 'f) ignored =
+  | Ignored_char :
+      ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_caml_char :
+      ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_string :
+      pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_caml_string :
+      pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_int :
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_int32 :
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_nativeint :
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_int64 :
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_float :
+      pad_option * prec_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_bool :
+      pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_format_arg :
+      pad_option * ('g, 'h, 'i, 'j, 'k, 'l) fmtty ->
+        ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_format_subst :
+      pad_option * ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        ('a, 'b, 'c, 'd, 'e, 'f) ignored
+  | Ignored_reader :
+      ('a, 'b, 'c, ('b -> 'x) -> 'd, 'd, 'a) ignored
+  | Ignored_scan_char_set :
+      pad_option * char_set -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_scan_get_counter :
+      counter -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_scan_next_char :
+      ('a, 'b, 'c, 'd, 'd, 'a) ignored
+
+and ('a, 'b, 'c, 'd, 'e, 'f) format6 =
+  Format of ('a, 'b, 'c, 'd, 'e, 'f) fmt * string
+
+val concat_fmtty :
+  ('g1, 'b1, 'c1, 'j1, 'd1, 'a1,
+   'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel ->
+  ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+   'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+  ('g1, 'b1, 'c1, 'j1, 'e1, 'f1,
+   'g2, 'b2, 'c2, 'j2, 'e2, 'f2) fmtty_rel
+
+val erase_rel :
+  ('a, 'b, 'c, 'd, 'e, 'f,
+   'g, 'h, 'i, 'j, 'k, 'l) fmtty_rel -> ('a, 'b, 'c, 'd, 'e, 'f) fmtty
+
+val concat_fmt :
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+    ('f, 'b, 'c, 'e, 'g, 'h) fmt ->
+    ('a, 'b, 'c, 'd, 'g, 'h) fmt
diff --git a/stdlib/camlinternalLazy.ml b/stdlib/camlinternalLazy.ml
new file mode 100644
index 00000000..8226ffda
--- /dev/null
+++ b/stdlib/camlinternalLazy.ml
@@ -0,0 +1,65 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Damien Doligez, projet Para, INRIA Rocquencourt            *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Internals of forcing lazy values. *)
+
+type 'a t = 'a lazy_t
+
+exception Undefined
+
+let raise_undefined = Obj.repr (fun () -> raise Undefined)
+
+external make_forward : Obj.t -> Obj.t -> unit = "caml_obj_make_forward"
+
+(* Assume [blk] is a block with tag lazy *)
+let force_lazy_block (blk : 'arg lazy_t) =
+  let closure = (Obj.obj (Obj.field (Obj.repr blk) 0) : unit -> 'arg) in
+  Obj.set_field (Obj.repr blk) 0 raise_undefined;
+  try
+    let result = closure () in
+    make_forward (Obj.repr blk) (Obj.repr result);
+    result
+  with e ->
+    Obj.set_field (Obj.repr blk) 0 (Obj.repr (fun () -> raise e));
+    raise e
+
+
+(* Assume [blk] is a block with tag lazy *)
+let force_val_lazy_block (blk : 'arg lazy_t) =
+  let closure = (Obj.obj (Obj.field (Obj.repr blk) 0) : unit -> 'arg) in
+  Obj.set_field (Obj.repr blk) 0 raise_undefined;
+  let result = closure () in
+  make_forward (Obj.repr blk) (Obj.repr result);
+  result
+
+
+(* [force] is not used, since [Lazy.force] is declared as a primitive
+   whose code inlines the tag tests of its argument.  This function is
+   here for the sake of completeness, and for debugging purpose. *)
+
+let force (lzv : 'arg lazy_t) =
+  let x = Obj.repr lzv in
+  let t = Obj.tag x in
+  if t = Obj.forward_tag then (Obj.obj (Obj.field x 0) : 'arg) else
+  if t <> Obj.lazy_tag then (Obj.obj x : 'arg)
+  else force_lazy_block lzv
+
+
+let force_val (lzv : 'arg lazy_t) =
+  let x = Obj.repr lzv in
+  let t = Obj.tag x in
+  if t = Obj.forward_tag then (Obj.obj (Obj.field x 0) : 'arg) else
+  if t <> Obj.lazy_tag then (Obj.obj x : 'arg)
+  else force_val_lazy_block lzv
diff --git a/stdlib/camlinternalLazy.mli b/stdlib/camlinternalLazy.mli
new file mode 100644
index 00000000..7d04087f
--- /dev/null
+++ b/stdlib/camlinternalLazy.mli
@@ -0,0 +1,29 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Damien Doligez, projet Para, INRIA Rocquencourt            *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Run-time support for lazy values.
+    All functions in this module are for system use only, not for the
+    casual user. *)
+
+exception Undefined
+
+type 'a t = 'a lazy_t
+
+val force_lazy_block : 'a lazy_t -> 'a
+
+val force_val_lazy_block : 'a lazy_t -> 'a
+
+val force : 'a lazy_t -> 'a
+val force_val : 'a lazy_t -> 'a
diff --git a/stdlib/camlinternalMod.ml b/stdlib/camlinternalMod.ml
new file mode 100644
index 00000000..bfc3b12a
--- /dev/null
+++ b/stdlib/camlinternalMod.ml
@@ -0,0 +1,83 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          Xavier Leroy, projet Cristal, INRIA Rocquencourt              *)
+(*                                                                        *)
+(*   Copyright 2004 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+external make_forward : Obj.t -> Obj.t -> unit = "caml_obj_make_forward"
+
+type shape =
+  | Function
+  | Lazy
+  | Class
+  | Module of shape array
+  | Value of Obj.t
+
+let overwrite o n =
+  assert (Obj.size o >= Obj.size n);
+  for i = 0 to Obj.size n - 1 do
+    Obj.set_field o i (Obj.field n i)
+  done
+
+let rec init_mod loc shape =
+  match shape with
+  | Function ->
+      (* Two code pointer words (curried and full application), arity
+         and eight environment entries makes 11 words. *)
+      let closure = Obj.new_block Obj.closure_tag 11 in
+      let template =
+        Obj.repr (fun _ -> raise (Undefined_recursive_module loc))
+      in
+      overwrite closure template;
+      closure
+  | Lazy ->
+      Obj.repr (lazy (raise (Undefined_recursive_module loc)))
+  | Class ->
+      Obj.repr (CamlinternalOO.dummy_class loc)
+  | Module comps ->
+      Obj.repr (Array.map (init_mod loc) comps)
+  | Value v ->
+      v
+
+let rec update_mod shape o n =
+  match shape with
+  | Function ->
+      (* In bytecode, the RESTART instruction checks the size of closures.
+         Hence, the optimized case [overwrite o n] is valid only if [o] and
+         [n] have the same size.  (See PR#4008.)
+         In native code, the size of closures does not matter, so overwriting
+         is possible so long as the size of [n] is no greater than that of [o].
+      *)
+      if Obj.tag n = Obj.closure_tag
+      && (Obj.size n = Obj.size o
+          || (Sys.backend_type = Sys.Native
+              && Obj.size n <= Obj.size o))
+      then begin overwrite o n end
+      else overwrite o (Obj.repr (fun x -> (Obj.obj n : _ -> _) x))
+  | Lazy ->
+      if Obj.tag n = Obj.lazy_tag then
+        Obj.set_field o 0 (Obj.field n 0)
+      else if Obj.tag n = Obj.forward_tag then begin (* PR#4316 *)
+        make_forward o (Obj.field n 0)
+      end else begin
+        (* forwarding pointer was shortcut by GC *)
+        make_forward o n
+      end
+  | Class ->
+      assert (Obj.tag n = 0 && Obj.size n = 4);
+      overwrite o n
+  | Module comps ->
+      assert (Obj.tag n = 0 && Obj.size n >= Array.length comps);
+      for i = 0 to Array.length comps - 1 do
+        update_mod comps.(i) (Obj.field o i) (Obj.field n i)
+      done
+  | Value _ -> () (* the value is already there *)
diff --git a/stdlib/camlinternalMod.mli b/stdlib/camlinternalMod.mli
new file mode 100644
index 00000000..cf7ffb09
--- /dev/null
+++ b/stdlib/camlinternalMod.mli
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          Xavier Leroy, projet Cristal, INRIA Rocquencourt              *)
+(*                                                                        *)
+(*   Copyright 2004 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Run-time support for recursive modules.
+    All functions in this module are for system use only, not for the
+    casual user. *)
+
+type shape =
+  | Function
+  | Lazy
+  | Class
+  | Module of shape array
+  | Value of Obj.t
+
+val init_mod: string * int * int -> shape -> Obj.t
+val update_mod: shape -> Obj.t -> Obj.t -> unit
diff --git a/stdlib/camlinternalOO.ml b/stdlib/camlinternalOO.ml
new file mode 100644
index 00000000..0188c148
--- /dev/null
+++ b/stdlib/camlinternalOO.ml
@@ -0,0 +1,613 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          Jerome Vouillon, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Obj
+
+(**** Object representation ****)
+
+external set_id: 'a -> 'a = "caml_set_oo_id" [@@noalloc]
+
+(**** Object copy ****)
+
+let copy o =
+  let o = (Obj.obj (Obj.dup (Obj.repr o))) in
+  set_id o
+
+(**** Compression options ****)
+(* Parameters *)
+type params = {
+    mutable compact_table : bool;
+    mutable copy_parent : bool;
+    mutable clean_when_copying : bool;
+    mutable retry_count : int;
+    mutable bucket_small_size : int
+  }
+
+let params = {
+  compact_table = true;
+  copy_parent = true;
+  clean_when_copying = true;
+  retry_count = 3;
+  bucket_small_size = 16
+}
+
+(**** Parameters ****)
+
+let initial_object_size = 2
+
+(**** Items ****)
+
+type item = DummyA | DummyB | DummyC of int
+let _ = [DummyA; DummyB; DummyC 0] (* to avoid warnings *)
+
+let dummy_item = (magic () : item)
+
+(**** Types ****)
+
+type tag
+type label = int
+type closure = item
+type t = DummyA | DummyB | DummyC of int
+let _ = [DummyA; DummyB; DummyC 0] (* to avoid warnings *)
+
+type obj = t array
+external ret : (obj -> 'a) -> closure = "%identity"
+
+(**** Labels ****)
+
+let public_method_label s : tag =
+  let accu = ref 0 in
+  for i = 0 to String.length s - 1 do
+    accu := 223 * !accu + Char.code s.[i]
+  done;
+  (* reduce to 31 bits *)
+  accu := !accu land (1 lsl 31 - 1);
+  (* make it signed for 64 bits architectures *)
+  let tag = if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu in
+  (* Printf.eprintf "%s = %d\n" s tag; flush stderr; *)
+  magic tag
+
+(**** Sparse array ****)
+
+module Vars =
+  Map.Make(struct type t = string let compare (x:t) y = compare x y end)
+type vars = int Vars.t
+
+module Meths =
+  Map.Make(struct type t = string let compare (x:t) y = compare x y end)
+type meths = label Meths.t
+module Labs =
+  Map.Make(struct type t = label let compare (x:t) y = compare x y end)
+type labs = bool Labs.t
+
+(* The compiler assumes that the first field of this structure is [size]. *)
+type table =
+ { mutable size: int;
+   mutable methods: closure array;
+   mutable methods_by_name: meths;
+   mutable methods_by_label: labs;
+   mutable previous_states:
+     (meths * labs * (label * item) list * vars *
+      label list * string list) list;
+   mutable hidden_meths: (label * item) list;
+   mutable vars: vars;
+   mutable initializers: (obj -> unit) list }
+
+let dummy_table =
+  { methods = [| dummy_item |];
+    methods_by_name = Meths.empty;
+    methods_by_label = Labs.empty;
+    previous_states = [];
+    hidden_meths = [];
+    vars = Vars.empty;
+    initializers = [];
+    size = 0 }
+
+let table_count = ref 0
+
+(* dummy_met should be a pointer, so use an atom *)
+let dummy_met : item = obj (Obj.new_block 0 0)
+(* if debugging is needed, this could be a good idea: *)
+(* let dummy_met () = failwith "Undefined method" *)
+
+let rec fit_size n =
+  if n <= 2 then n else
+  fit_size ((n+1)/2) * 2
+
+let new_table pub_labels =
+  incr table_count;
+  let len = Array.length pub_labels in
+  let methods = Array.make (len*2+2) dummy_met in
+  methods.(0) <- magic len;
+  methods.(1) <- magic (fit_size len * Sys.word_size / 8 - 1);
+  for i = 0 to len - 1 do methods.(i*2+3) <- magic pub_labels.(i) done;
+  { methods = methods;
+    methods_by_name = Meths.empty;
+    methods_by_label = Labs.empty;
+    previous_states = [];
+    hidden_meths = [];
+    vars = Vars.empty;
+    initializers = [];
+    size = initial_object_size }
+
+let resize array new_size =
+  let old_size = Array.length array.methods in
+  if new_size > old_size then begin
+    let new_buck = Array.make new_size dummy_met in
+    Array.blit array.methods 0 new_buck 0 old_size;
+    array.methods <- new_buck
+ end
+
+let put array label element =
+  resize array (label + 1);
+  array.methods.(label) <- element
+
+(**** Classes ****)
+
+let method_count = ref 0
+let inst_var_count = ref 0
+
+(* type t *)
+type meth = item
+
+let new_method table =
+  let index = Array.length table.methods in
+  resize table (index + 1);
+  index
+
+let get_method_label table name =
+  try
+    Meths.find name table.methods_by_name
+  with Not_found ->
+    let label = new_method table in
+    table.methods_by_name <- Meths.add name label table.methods_by_name;
+    table.methods_by_label <- Labs.add label true table.methods_by_label;
+    label
+
+let get_method_labels table names =
+  Array.map (get_method_label table) names
+
+let set_method table label element =
+  incr method_count;
+  if Labs.find label table.methods_by_label then
+    put table label element
+  else
+    table.hidden_meths <- (label, element) :: table.hidden_meths
+
+let get_method table label =
+  try List.assoc label table.hidden_meths
+  with Not_found -> table.methods.(label)
+
+let to_list arr =
+  if arr == magic 0 then [] else Array.to_list arr
+
+let narrow table vars virt_meths concr_meths =
+  let vars = to_list vars
+  and virt_meths = to_list virt_meths
+  and concr_meths = to_list concr_meths in
+  let virt_meth_labs = List.map (get_method_label table) virt_meths in
+  let concr_meth_labs = List.map (get_method_label table) concr_meths in
+  table.previous_states <-
+     (table.methods_by_name, table.methods_by_label, table.hidden_meths,
+      table.vars, virt_meth_labs, vars)
+     :: table.previous_states;
+  table.vars <-
+    Vars.fold
+      (fun lab info tvars ->
+        if List.mem lab vars then Vars.add lab info tvars else tvars)
+      table.vars Vars.empty;
+  let by_name = ref Meths.empty in
+  let by_label = ref Labs.empty in
+  List.iter2
+    (fun met label ->
+       by_name := Meths.add met label !by_name;
+       by_label :=
+          Labs.add label
+            (try Labs.find label table.methods_by_label with Not_found -> true)
+            !by_label)
+    concr_meths concr_meth_labs;
+  List.iter2
+    (fun met label ->
+       by_name := Meths.add met label !by_name;
+       by_label := Labs.add label false !by_label)
+    virt_meths virt_meth_labs;
+  table.methods_by_name <- !by_name;
+  table.methods_by_label <- !by_label;
+  table.hidden_meths <-
+     List.fold_right
+       (fun ((lab, _) as met) hm ->
+          if List.mem lab virt_meth_labs then hm else met::hm)
+       table.hidden_meths
+       []
+
+let widen table =
+  let (by_name, by_label, saved_hidden_meths, saved_vars, virt_meths, vars) =
+    List.hd table.previous_states
+  in
+  table.previous_states <- List.tl table.previous_states;
+  table.vars <-
+     List.fold_left
+       (fun s v -> Vars.add v (Vars.find v table.vars) s)
+       saved_vars vars;
+  table.methods_by_name <- by_name;
+  table.methods_by_label <- by_label;
+  table.hidden_meths <-
+     List.fold_right
+       (fun ((lab, _) as met) hm ->
+          if List.mem lab virt_meths then hm else met::hm)
+       table.hidden_meths
+       saved_hidden_meths
+
+let new_slot table =
+  let index = table.size in
+  table.size <- index + 1;
+  index
+
+let new_variable table name =
+  try Vars.find name table.vars
+  with Not_found ->
+    let index = new_slot table in
+    if name <> "" then table.vars <- Vars.add name index table.vars;
+    index
+
+let to_array arr =
+  if arr = Obj.magic 0 then [||] else arr
+
+let new_methods_variables table meths vals =
+  let meths = to_array meths in
+  let nmeths = Array.length meths and nvals = Array.length vals in
+  let res = Array.make (nmeths + nvals) 0 in
+  for i = 0 to nmeths - 1 do
+    res.(i) <- get_method_label table meths.(i)
+  done;
+  for i = 0 to nvals - 1 do
+    res.(i+nmeths) <- new_variable table vals.(i)
+  done;
+  res
+
+let get_variable table name =
+  try Vars.find name table.vars with Not_found -> assert false
+
+let get_variables table names =
+  Array.map (get_variable table) names
+
+let add_initializer table f =
+  table.initializers <- f::table.initializers
+
+(*
+module Keys =
+  Map.Make(struct type t = tag array let compare (x:t) y = compare x y end)
+let key_map = ref Keys.empty
+let get_key tags : item =
+  try magic (Keys.find tags !key_map : tag array)
+  with Not_found ->
+    key_map := Keys.add tags tags !key_map;
+    magic tags
+*)
+
+let create_table public_methods =
+  if public_methods == magic 0 then new_table [||] else
+  (* [public_methods] must be in ascending order for bytecode *)
+  let tags = Array.map public_method_label public_methods in
+  let table = new_table tags in
+  Array.iteri
+    (fun i met ->
+      let lab = i*2+2 in
+      table.methods_by_name  <- Meths.add met lab table.methods_by_name;
+      table.methods_by_label <- Labs.add lab true table.methods_by_label)
+    public_methods;
+  table
+
+let init_class table =
+  inst_var_count := !inst_var_count + table.size - 1;
+  table.initializers <- List.rev table.initializers;
+  resize table (3 + magic table.methods.(1) * 16 / Sys.word_size)
+
+let inherits cla vals virt_meths concr_meths (_, super, _, env) top =
+  narrow cla vals virt_meths concr_meths;
+  let init =
+    if top then super cla env else Obj.repr (super cla) in
+  widen cla;
+  Array.concat
+    [[| repr init |];
+     magic (Array.map (get_variable cla) (to_array vals) : int array);
+     Array.map
+       (fun nm -> repr (get_method cla (get_method_label cla nm) : closure))
+       (to_array concr_meths) ]
+
+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)
+
+type init_table = { mutable env_init: t; mutable class_init: table -> t }
+
+let make_class_store pub_meths class_init init_table =
+  let table = create_table pub_meths in
+  let env_init = class_init table in
+  init_class table;
+  init_table.class_init <- class_init;
+  init_table.env_init <- env_init
+
+let dummy_class loc =
+  let undef = fun _ -> raise (Undefined_recursive_module loc) in
+  (Obj.magic undef, undef, undef, Obj.repr 0)
+
+(**** Objects ****)
+
+let create_object table =
+  (* XXX Appel de [obj_block] | Call to [obj_block]  *)
+  let obj = Obj.new_block Obj.object_tag table.size in
+  (* XXX Appel de [caml_modify] | Call to [caml_modify] *)
+  Obj.set_field obj 0 (Obj.repr table.methods);
+  Obj.obj (set_id obj)
+
+let create_object_opt obj_0 table =
+  if (Obj.magic obj_0 : bool) then obj_0 else begin
+    (* XXX Appel de [obj_block] | Call to [obj_block]  *)
+    let obj = Obj.new_block Obj.object_tag table.size in
+    (* XXX Appel de [caml_modify] | Call to [caml_modify] *)
+    Obj.set_field obj 0 (Obj.repr table.methods);
+    Obj.obj (set_id obj)
+  end
+
+let rec iter_f obj =
+  function
+    []   -> ()
+  | f::l -> f obj; iter_f obj l
+
+let run_initializers obj table =
+  let inits = table.initializers in
+  if inits <> [] then
+    iter_f obj inits
+
+let run_initializers_opt obj_0 obj table =
+  if (Obj.magic obj_0 : bool) then obj else begin
+    let inits = table.initializers in
+    if inits <> [] then iter_f obj inits;
+    obj
+  end
+
+let create_object_and_run_initializers obj_0 table =
+  if (Obj.magic obj_0 : bool) then obj_0 else begin
+    let obj = create_object table in
+    run_initializers obj table;
+    obj
+  end
+
+(* Equivalent primitive below
+let sendself obj lab =
+  (magic obj : (obj -> t) array array).(0).(lab) obj
+*)
+external send : obj -> tag -> 'a = "%send"
+external sendcache : obj -> tag -> t -> int -> 'a = "%sendcache"
+external sendself : obj -> label -> 'a = "%sendself"
+external get_public_method : obj -> tag -> closure
+    = "caml_get_public_method" [@@noalloc]
+
+(**** table collection access ****)
+
+type tables =
+  | Empty
+  | Cons of {key : closure; mutable data: tables; mutable next: tables}
+
+let set_data tables v = match tables with
+  | Empty -> assert false
+  | Cons tables -> tables.data <- v
+let set_next tables v = match tables with
+  | Empty -> assert false
+  | Cons tables -> tables.next <- v
+let get_key = function
+  | Empty -> assert false
+  | Cons tables -> tables.key
+let get_data = function
+  | Empty -> assert false
+  | Cons tables -> tables.data
+let get_next = function
+  | Empty -> assert false
+  | Cons tables -> tables.next
+
+let build_path n keys tables =
+  let res = Cons {key = Obj.magic 0; data = Empty; next = Empty} in
+  let r = ref res in
+  for i = 0 to n do
+    r := Cons {key = keys.(i); data = !r; next = Empty}
+  done;
+  set_data tables !r;
+  res
+
+let rec lookup_keys i keys tables =
+  if i < 0 then tables else
+  let key = keys.(i) in
+  let rec lookup_key (tables:tables) =
+    if get_key tables == key then
+      match get_data tables with
+      | Empty -> assert false
+      | Cons _ as tables_data ->
+          lookup_keys (i-1) keys tables_data
+    else
+      match get_next tables with
+      | Cons _ as next -> lookup_key next
+      | Empty ->
+          let next : tables = Cons {key; data = Empty; next = Empty} in
+          set_next tables next;
+          build_path (i-1) keys next
+  in
+  lookup_key tables
+
+let lookup_tables root keys =
+  match get_data root with
+  | Cons _ as root_data ->
+    lookup_keys (Array.length keys - 1) keys root_data
+  | Empty ->
+    build_path (Array.length keys - 1) keys root
+
+(**** builtin methods ****)
+
+let get_const x = ret (fun _obj -> x)
+let get_var n   = ret (fun obj -> Array.unsafe_get obj n)
+let get_env e n =
+  ret (fun obj ->
+    Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n)
+let get_meth n  = ret (fun obj -> sendself obj n)
+let set_var n   = ret (fun obj x -> Array.unsafe_set obj n x)
+let app_const f x = ret (fun _obj -> f x)
+let app_var f n   = ret (fun obj -> f (Array.unsafe_get obj n))
+let app_env f e n =
+  ret (fun obj ->
+    f (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n))
+let app_meth f n  = ret (fun obj -> f (sendself obj n))
+let app_const_const f x y = ret (fun _obj -> f x y)
+let app_const_var f x n   = ret (fun obj -> f x (Array.unsafe_get obj n))
+let app_const_meth f x n = ret (fun obj -> f x (sendself obj n))
+let app_var_const f n x = ret (fun obj -> f (Array.unsafe_get obj n) x)
+let app_meth_const f n x = ret (fun obj -> f (sendself obj n) x)
+let app_const_env f x e n =
+  ret (fun obj ->
+    f x (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n))
+let app_env_const f e n x =
+  ret (fun obj ->
+    f (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n) x)
+let meth_app_const n x = ret (fun obj -> (sendself obj n : _ -> _) x)
+let meth_app_var n m =
+  ret (fun obj -> (sendself obj n : _ -> _) (Array.unsafe_get obj m))
+let meth_app_env n e m =
+  ret (fun obj -> (sendself obj n : _ -> _)
+      (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) m))
+let meth_app_meth n m =
+  ret (fun obj -> (sendself obj n : _ -> _) (sendself obj m))
+let send_const m x c =
+  ret (fun obj -> sendcache x m (Array.unsafe_get obj 0) c)
+let send_var m n c =
+  ret (fun obj ->
+    sendcache (Obj.magic (Array.unsafe_get obj n) : obj) m
+      (Array.unsafe_get obj 0) c)
+let send_env m e n c =
+  ret (fun obj ->
+    sendcache
+      (Obj.magic (Array.unsafe_get
+                    (Obj.magic (Array.unsafe_get obj e) : obj) n) : obj)
+      m (Array.unsafe_get obj 0) c)
+let send_meth m n c =
+  ret (fun obj ->
+    sendcache (sendself obj n) m (Array.unsafe_get obj 0) c)
+let new_cache table =
+  let n = new_method table in
+  let n =
+    if n mod 2 = 0 || n > 2 + magic table.methods.(1) * 16 / Sys.word_size
+    then n else new_method table
+  in
+  table.methods.(n) <- Obj.magic 0;
+  n
+
+type impl =
+    GetConst
+  | GetVar
+  | GetEnv
+  | GetMeth
+  | SetVar
+  | AppConst
+  | AppVar
+  | AppEnv
+  | AppMeth
+  | AppConstConst
+  | AppConstVar
+  | AppConstEnv
+  | AppConstMeth
+  | AppVarConst
+  | AppEnvConst
+  | AppMethConst
+  | MethAppConst
+  | MethAppVar
+  | MethAppEnv
+  | MethAppMeth
+  | SendConst
+  | SendVar
+  | SendEnv
+  | SendMeth
+  | Closure of closure
+
+let method_impl table i arr =
+  let next () = incr i; magic arr.(!i) in
+  match next() with
+    GetConst -> let x : t = next() in get_const x
+  | GetVar   -> let n = next() in get_var n
+  | GetEnv   -> let e = next() in let n = next() in get_env e n
+  | GetMeth  -> let n = next() in get_meth n
+  | SetVar   -> let n = next() in set_var n
+  | AppConst -> let f = next() in let x = next() in app_const f x
+  | AppVar   -> let f = next() in let n = next () in app_var f n
+  | AppEnv   ->
+      let f = next() in  let e = next() in let n = next() in
+      app_env f e n
+  | AppMeth  -> let f = next() in let n = next () in app_meth f n
+  | AppConstConst ->
+      let f = next() in let x = next() in let y = next() in
+      app_const_const f x y
+  | AppConstVar ->
+      let f = next() in let x = next() in let n = next() in
+      app_const_var f x n
+  | AppConstEnv ->
+      let f = next() in let x = next() in let e = next () in let n = next() in
+      app_const_env f x e n
+  | AppConstMeth ->
+      let f = next() in let x = next() in let n = next() in
+      app_const_meth f x n
+  | AppVarConst ->
+      let f = next() in let n = next() in let x = next() in
+      app_var_const f n x
+  | AppEnvConst ->
+      let f = next() in let e = next () in let n = next() in let x = next() in
+      app_env_const f e n x
+  | AppMethConst ->
+      let f = next() in let n = next() in let x = next() in
+      app_meth_const f n x
+  | MethAppConst ->
+      let n = next() in let x = next() in meth_app_const n x
+  | MethAppVar ->
+      let n = next() in let m = next() in meth_app_var n m
+  | MethAppEnv ->
+      let n = next() in let e = next() in let m = next() in
+      meth_app_env n e m
+  | MethAppMeth ->
+      let n = next() in let m = next() in meth_app_meth n m
+  | SendConst ->
+      let m = next() in let x = next() in send_const m x (new_cache table)
+  | SendVar ->
+      let m = next() in let n = next () in send_var m n (new_cache table)
+  | SendEnv ->
+      let m = next() in let e = next() in let n = next() in
+      send_env m e n (new_cache table)
+  | SendMeth ->
+      let m = next() in let n = next () in send_meth m n (new_cache table)
+  | Closure _ as clo -> magic clo
+
+let set_methods table methods =
+  let len = Array.length methods in let i = ref 0 in
+  while !i < len do
+    let label = methods.(!i) in let clo = method_impl table i methods in
+    set_method table label clo;
+    incr i
+  done
+
+(**** Statistics ****)
+
+type stats =
+  { classes: int; methods: int; inst_vars: int; }
+
+let stats () =
+  { classes = !table_count;
+    methods = !method_count; inst_vars = !inst_var_count; }
diff --git a/stdlib/camlinternalOO.mli b/stdlib/camlinternalOO.mli
new file mode 100644
index 00000000..b6ffc70d
--- /dev/null
+++ b/stdlib/camlinternalOO.mli
@@ -0,0 +1,153 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Run-time support for objects and classes.
+    All functions in this module are for system use only, not for the
+    casual user. *)
+
+(** {1 Classes} *)
+
+type tag
+type label
+type table
+type meth
+type t
+type obj
+type closure
+val public_method_label : string -> tag
+val new_method : table -> label
+val new_variable : table -> string -> int
+val new_methods_variables :
+    table -> string array -> string array -> label array
+val get_variable : table -> string -> int
+val get_variables : table -> string array -> int array
+val get_method_label : table -> string -> label
+val get_method_labels : table -> string array -> label array
+val get_method : table -> label -> meth
+val set_method : table -> label -> meth -> unit
+val set_methods : table -> label array -> unit
+val narrow : table -> string array -> string array -> string array -> unit
+val widen : table -> unit
+val add_initializer : table -> (obj -> unit) -> unit
+val dummy_table : table
+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
+val make_class :
+    string array -> (table -> Obj.t -> t) ->
+    (t * (table -> Obj.t -> t) * (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)
+
+(** {1 Objects} *)
+
+val copy : (< .. > as 'a) -> 'a
+val create_object : table -> obj
+val create_object_opt : obj -> table -> obj
+val run_initializers : obj -> table -> unit
+val run_initializers_opt : obj -> obj -> table -> obj
+val create_object_and_run_initializers : obj -> table -> obj
+external send : obj -> tag -> t = "%send"
+external sendcache : obj -> tag -> t -> int -> t = "%sendcache"
+external sendself : obj -> label -> t = "%sendself"
+external get_public_method : obj -> tag -> closure
+    = "caml_get_public_method" [@@noalloc]
+
+(** {1 Table cache} *)
+
+type tables
+val lookup_tables : tables -> closure array -> tables
+
+(** {1 Builtins to reduce code size} *)
+
+(*
+val get_const : t -> closure
+val get_var : int -> closure
+val get_env : int -> int -> closure
+val get_meth : label -> closure
+val set_var : int -> closure
+val app_const : (t -> t) -> t -> closure
+val app_var : (t -> t) -> int -> closure
+val app_env : (t -> t) -> int -> int -> closure
+val app_meth : (t -> t) -> label -> closure
+val app_const_const : (t -> t -> t) -> t -> t -> closure
+val app_const_var : (t -> t -> t) -> t -> int -> closure
+val app_const_env : (t -> t -> t) -> t -> int -> int -> closure
+val app_const_meth : (t -> t -> t) -> t -> label -> closure
+val app_var_const : (t -> t -> t) -> int -> t -> closure
+val app_env_const : (t -> t -> t) -> int -> int -> t -> closure
+val app_meth_const : (t -> t -> t) -> label -> t -> closure
+val meth_app_const : label -> t -> closure
+val meth_app_var : label -> int -> closure
+val meth_app_env : label -> int -> int -> closure
+val meth_app_meth : label -> label -> closure
+val send_const : tag -> obj -> int -> closure
+val send_var : tag -> int -> int -> closure
+val send_env : tag -> int -> int -> int -> closure
+val send_meth : tag -> label -> int -> closure
+*)
+
+type impl =
+    GetConst
+  | GetVar
+  | GetEnv
+  | GetMeth
+  | SetVar
+  | AppConst
+  | AppVar
+  | AppEnv
+  | AppMeth
+  | AppConstConst
+  | AppConstVar
+  | AppConstEnv
+  | AppConstMeth
+  | AppVarConst
+  | AppEnvConst
+  | AppMethConst
+  | MethAppConst
+  | MethAppVar
+  | MethAppEnv
+  | MethAppMeth
+  | SendConst
+  | SendVar
+  | SendEnv
+  | SendMeth
+  | Closure of closure
+
+(** {1 Parameters} *)
+
+(* currently disabled *)
+type params =
+  { mutable compact_table : bool;
+    mutable copy_parent : bool;
+    mutable clean_when_copying : bool;
+    mutable retry_count : int;
+    mutable bucket_small_size : int }
+
+val params : params
+
+(** {1 Statistics} *)
+
+type stats =
+  { classes : int;
+    methods : int;
+    inst_vars : int }
+val stats : unit -> stats
diff --git a/stdlib/char.ml b/stdlib/char.ml
new file mode 100644
index 00000000..052949d0
--- /dev/null
+++ b/stdlib/char.ml
@@ -0,0 +1,74 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Character operations *)
+
+external code: char -> int = "%identity"
+external unsafe_chr: int -> char = "%identity"
+
+let chr n =
+  if n < 0 || n > 255 then invalid_arg "Char.chr" else unsafe_chr n
+
+external bytes_create: int -> bytes = "caml_create_bytes"
+external bytes_unsafe_set : bytes -> int -> char -> unit
+                           = "%bytes_unsafe_set"
+external unsafe_to_string : bytes -> string = "%bytes_to_string"
+
+let escaped = function
+  | '\'' -> "\\'"
+  | '\\' -> "\\\\"
+  | '\n' -> "\\n"
+  | '\t' -> "\\t"
+  | '\r' -> "\\r"
+  | '\b' -> "\\b"
+  | ' ' .. '~' as c ->
+      let s = bytes_create 1 in
+      bytes_unsafe_set s 0 c;
+      unsafe_to_string s
+  | c ->
+      let n = code c in
+      let s = bytes_create 4 in
+      bytes_unsafe_set s 0 '\\';
+      bytes_unsafe_set s 1 (unsafe_chr (48 + n / 100));
+      bytes_unsafe_set s 2 (unsafe_chr (48 + (n / 10) mod 10));
+      bytes_unsafe_set s 3 (unsafe_chr (48 + n mod 10));
+      unsafe_to_string s
+
+let lowercase = function
+  | 'A' .. 'Z'
+  | '\192' .. '\214'
+  | '\216' .. '\222' as c ->
+    unsafe_chr(code c + 32)
+  | c -> c
+
+let uppercase = function
+  | 'a' .. 'z'
+  | '\224' .. '\246'
+  | '\248' .. '\254' as c ->
+    unsafe_chr(code c - 32)
+  | c -> c
+
+let lowercase_ascii = function
+  | 'A' .. 'Z' as c -> unsafe_chr(code c + 32)
+  | c -> c
+
+let uppercase_ascii = function
+  | 'a' .. 'z' as c -> unsafe_chr(code c - 32)
+  | c -> c
+
+type t = char
+
+let compare c1 c2 = code c1 - code c2
+let equal (c1: t) (c2: t) = compare c1 c2 = 0
diff --git a/stdlib/char.mli b/stdlib/char.mli
new file mode 100644
index 00000000..233208c3
--- /dev/null
+++ b/stdlib/char.mli
@@ -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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Character operations. *)
+
+external code : char -> int = "%identity"
+(** Return the ASCII code of the argument. *)
+
+val chr : int -> char
+(** Return the character with the given ASCII code.
+   @raise Invalid_argument if the argument is
+   outside the range 0--255. *)
+
+val escaped : char -> string
+(** Return a string representing the given character,
+    with special characters escaped following the lexical conventions
+    of OCaml.
+    All characters outside the ASCII printable range (32..126) are
+    escaped, as well as backslash, double-quote, and single-quote. *)
+
+val lowercase : char -> char
+  [@@ocaml.deprecated "Use Char.lowercase_ascii instead."]
+(** Convert the given character to its equivalent lowercase character,
+   using the ISO Latin-1 (8859-1) character set.
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val uppercase : char -> char
+  [@@ocaml.deprecated "Use Char.uppercase_ascii instead."]
+(** Convert the given character to its equivalent uppercase character,
+   using the ISO Latin-1 (8859-1) character set.
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val lowercase_ascii : char -> char
+(** Convert the given character to its equivalent lowercase character,
+   using the US-ASCII character set.
+   @since 4.03.0 *)
+
+val uppercase_ascii : char -> char
+(** Convert the given character to its equivalent uppercase character,
+   using the US-ASCII character set.
+   @since 4.03.0 *)
+
+type t = char
+(** An alias for the type of characters. *)
+
+val compare: t -> t -> int
+(** The comparison function for characters, with the same specification as
+    {!Stdlib.compare}.  Along with the type [t], this function [compare]
+    allows the module [Char] to be passed as argument to the functors
+    {!Set.Make} and {!Map.Make}. *)
+
+val equal: t -> t -> bool
+(** The equal function for chars.
+    @since 4.03.0 *)
+
+(**/**)
+
+(* The following is for system use only. Do not call directly. *)
+
+external unsafe_chr : int -> char = "%identity"
diff --git a/stdlib/complex.ml b/stdlib/complex.ml
new file mode 100644
index 00000000..4df53cba
--- /dev/null
+++ b/stdlib/complex.ml
@@ -0,0 +1,87 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Complex numbers *)
+
+type t = { re: float; im: float }
+
+let zero = { re = 0.0; im = 0.0 }
+let one = { re = 1.0; im = 0.0 }
+let i = { re = 0.0; im = 1.0 }
+
+let add x y = { re = x.re +. y.re; im = x.im +. y.im }
+
+let sub x y = { re = x.re -. y.re; im = x.im -. y.im }
+
+let neg x = { re = -. x.re; im = -. x.im }
+
+let conj x = { re = x.re; im = -. x.im }
+
+let mul x y = { re = x.re *. y.re -. x.im *. y.im;
+                im = x.re *. y.im +. x.im *. y.re }
+
+let div x y =
+  if abs_float y.re >= abs_float y.im then
+    let r = y.im /. y.re in
+    let d = y.re +. r *. y.im in
+    { re = (x.re +. r *. x.im) /. d;
+      im = (x.im -. r *. x.re) /. d }
+  else
+    let r = y.re /. y.im in
+    let d = y.im +. r *. y.re in
+    { re = (r *. x.re +. x.im) /. d;
+      im = (r *. x.im -. x.re) /. d }
+
+let inv x = div one x
+
+let norm2 x = x.re *. x.re +. x.im *. x.im
+
+let norm x =
+  (* Watch out for overflow in computing re^2 + im^2 *)
+  let r = abs_float x.re and i = abs_float x.im in
+  if r = 0.0 then i
+  else if i = 0.0 then r
+  else if r >= i then
+    let q = i /. r in r *. sqrt(1.0 +. q *. q)
+  else
+    let q = r /. i in i *. sqrt(1.0 +. q *. q)
+
+let arg x = atan2 x.im x.re
+
+let polar n a = { re = cos a *. n; im = sin a *. n }
+
+let sqrt x =
+  if x.re = 0.0 && x.im = 0.0 then { re = 0.0; im = 0.0 }
+  else begin
+    let r = abs_float x.re and i = abs_float x.im in
+    let w =
+      if r >= i then begin
+        let q = i /. r in
+        sqrt(r) *. sqrt(0.5 *. (1.0 +. sqrt(1.0 +. q *. q)))
+      end else begin
+        let q = r /. i in
+        sqrt(i) *. sqrt(0.5 *. (q +. sqrt(1.0 +. q *. q)))
+      end in
+    if x.re >= 0.0
+    then { re = w;  im = 0.5 *. x.im /. w }
+    else { re = 0.5 *. i /. w;  im = if x.im >= 0.0 then w else -. w }
+  end
+
+let exp x =
+  let e = exp x.re in { re = e *. cos x.im; im = e *. sin x.im }
+
+let log x = { re = log (norm x); im = atan2 x.im x.re }
+
+let pow x y = exp (mul y (log x))
diff --git a/stdlib/complex.mli b/stdlib/complex.mli
new file mode 100644
index 00000000..2080eccc
--- /dev/null
+++ b/stdlib/complex.mli
@@ -0,0 +1,86 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Complex numbers.
+
+    This module provides arithmetic operations on complex numbers.
+    Complex numbers are represented by their real and imaginary parts
+    (cartesian representation).  Each part is represented by a
+    double-precision floating-point number (type [float]).   *)
+
+type t = { re: float; im: float }
+(** The type of complex numbers.  [re] is the real part and [im] the
+    imaginary part. *)
+
+val zero: t
+(** The complex number [0]. *)
+
+val one: t
+(** The complex number [1]. *)
+
+val i: t
+(** The complex number [i]. *)
+
+val neg: t -> t
+(** Unary negation. *)
+
+val conj: t -> t
+(** Conjugate: given the complex [x + i.y], returns [x - i.y]. *)
+
+val add: t -> t -> t
+(** Addition *)
+
+val sub: t -> t -> t
+(** Subtraction *)
+
+val mul: t -> t -> t
+(** Multiplication *)
+
+val inv: t -> t
+(** Multiplicative inverse ([1/z]). *)
+
+val div: t -> t -> t
+(** Division *)
+
+val sqrt: t -> t
+(** Square root.  The result [x + i.y] is such that [x > 0] or
+    [x = 0] and [y >= 0].
+    This function has a discontinuity along the negative real axis. *)
+
+val norm2: t -> float
+(** Norm squared: given [x + i.y], returns [x^2 + y^2]. *)
+
+val norm: t -> float
+(** Norm: given [x + i.y], returns [sqrt(x^2 + y^2)]. *)
+
+val arg: t -> float
+(** Argument.  The argument of a complex number is the angle
+    in the complex plane between the positive real axis and a line
+    passing through zero and the number.  This angle ranges from
+    [-pi] to [pi].  This function has a discontinuity along the
+    negative real axis. *)
+
+val polar: float -> float -> t
+(** [polar norm arg] returns the complex having norm [norm]
+    and argument [arg]. *)
+
+val exp: t -> t
+(** Exponentiation.  [exp z] returns [e] to the [z] power. *)
+
+val log: t -> t
+(** Natural logarithm (in base [e]). *)
+
+val pow: t -> t -> t
+(** Power function.  [pow z1 z2] returns [z1] to the [z2] power. *)
diff --git a/stdlib/digest.ml b/stdlib/digest.ml
new file mode 100644
index 00000000..408194b5
--- /dev/null
+++ b/stdlib/digest.ml
@@ -0,0 +1,76 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Message digest (MD5) *)
+
+type t = string
+
+let compare = String.compare
+let equal = String.equal
+
+external unsafe_string: string -> int -> int -> t = "caml_md5_string"
+external channel: in_channel -> int -> t = "caml_md5_chan"
+
+let string str =
+  unsafe_string str 0 (String.length str)
+
+let bytes b = string (Bytes.unsafe_to_string b)
+
+let substring str ofs len =
+  if ofs < 0 || len < 0 || ofs > String.length str - len
+  then invalid_arg "Digest.substring"
+  else unsafe_string str ofs len
+
+let subbytes b ofs len = substring (Bytes.unsafe_to_string b) ofs len
+
+let file filename =
+  let ic = open_in_bin filename in
+  match channel ic (-1) with
+    | d -> close_in ic; d
+    | exception e -> close_in ic; raise e
+
+let output chan digest =
+  output_string chan digest
+
+let input chan = really_input_string chan 16
+
+let char_hex n =
+  Char.unsafe_chr (n + if n < 10 then Char.code '0' else (Char.code 'a' - 10))
+
+let to_hex d =
+  if String.length d <> 16 then invalid_arg "Digest.to_hex";
+  let result = Bytes.create 32 in
+  for i = 0 to 15 do
+    let x = Char.code d.[i] in
+    Bytes.unsafe_set result (i*2) (char_hex (x lsr 4));
+    Bytes.unsafe_set result (i*2+1) (char_hex (x land 0x0f));
+  done;
+  Bytes.unsafe_to_string result
+
+let from_hex s =
+  if String.length s <> 32 then invalid_arg "Digest.from_hex";
+  let digit c =
+    match c with
+    | '0'..'9' -> Char.code c - Char.code '0'
+    | 'A'..'F' -> Char.code c - Char.code 'A' + 10
+    | 'a'..'f' -> Char.code c - Char.code 'a' + 10
+    | _ -> raise (Invalid_argument "Digest.from_hex")
+  in
+  let byte i = digit s.[i] lsl 4 + digit s.[i+1] in
+  let result = Bytes.create 16 in
+  for i = 0 to 15 do
+    Bytes.set result i (Char.chr (byte (2 * i)));
+  done;
+  Bytes.unsafe_to_string result
diff --git a/stdlib/digest.mli b/stdlib/digest.mli
new file mode 100644
index 00000000..c69b41a5
--- /dev/null
+++ b/stdlib/digest.mli
@@ -0,0 +1,84 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** MD5 message digest.
+
+   This module provides functions to compute 128-bit 'digests' of
+   arbitrary-length strings or files. The digests are of cryptographic
+   quality: it is very hard, given a digest, to forge a string having
+   that digest. The algorithm used is MD5. This module should not be
+   used for secure and sensitive cryptographic applications. For these
+   kind of applications more recent and stronger cryptographic
+   primitives should be used instead.
+*)
+
+type t = string
+(** The type of digests: 16-character strings. *)
+
+val compare : t -> t -> int
+(** The comparison function for 16-character digest, with the same
+    specification as {!Stdlib.compare} and the implementation
+    shared with {!String.compare}. Along with the type [t], this
+    function [compare] allows the module [Digest] to be passed as
+    argument to the functors {!Set.Make} and {!Map.Make}.
+    @since 4.00.0 *)
+
+val equal : t -> t -> bool
+(** The equal function for 16-character digest.
+    @since 4.03.0 *)
+
+val string : string -> t
+(** Return the digest of the given string. *)
+
+val bytes : bytes -> t
+(** Return the digest of the given byte sequence.
+    @since 4.02.0 *)
+
+val substring : string -> int -> int -> t
+(** [Digest.substring s ofs len] returns the digest of the substring
+   of [s] starting at index [ofs] and containing [len] characters. *)
+
+val subbytes : bytes -> int -> int -> t
+(** [Digest.subbytes s ofs len] returns the digest of the subsequence
+    of [s] starting at index [ofs] and containing [len] bytes.
+    @since 4.02.0 *)
+
+external channel : in_channel -> int -> t = "caml_md5_chan"
+(** If [len] is nonnegative, [Digest.channel ic len] reads [len]
+   characters from channel [ic] and returns their digest, or raises
+   [End_of_file] if end-of-file is reached before [len] characters
+   are read.  If [len] is negative, [Digest.channel ic len] reads
+   all characters from [ic] until end-of-file is reached and return
+   their digest. *)
+
+val file : string -> t
+(** Return the digest of the file whose name is given. *)
+
+val output : out_channel -> t -> unit
+(** Write a digest on the given output channel. *)
+
+val input : in_channel -> t
+(** Read a digest from the given input channel. *)
+
+val to_hex : t -> string
+(** Return the printable hexadecimal representation of the given digest.
+    @raise Invalid_argument if the argument is not exactly 16 bytes.
+ *)
+
+val from_hex : string -> t
+(** Convert a hexadecimal representation back into the corresponding digest.
+    @raise Invalid_argument if the argument is not exactly 32 hexadecimal
+   characters.
+   @since 4.00.0 *)
diff --git a/stdlib/dune b/stdlib/dune
new file mode 100644
index 00000000..ee66f6e7
--- /dev/null
+++ b/stdlib/dune
@@ -0,0 +1,36 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+(library
+ (name stdlib)
+ (stdlib
+   (exit_module std_exit)
+   (internal_modules Camlinternal*)
+   (modules_before_stdlib
+     camlinternalFormatBasics))
+ (flags (:standard -w -9 -nolabels))
+ (preprocess
+   (per_module
+     ((action
+        (run awk -v dune_wrapped=true
+               -f %{dep:expand_module_aliases.awk} %{input-file}))
+      stdlib))))
+
+(rule
+ (targets sys.ml)
+ (deps (:version ../VERSION) (:p sys.mlp))
+ (action
+   (with-stdout-to %{targets}
+     (bash
+       "sed -e \"s|%%VERSION%%|`sed -e 1q %{version} | tr -d '\r'`|\" %{p}"))))
diff --git a/stdlib/ephemeron.ml b/stdlib/ephemeron.ml
new file mode 100644
index 00000000..b630c15b
--- /dev/null
+++ b/stdlib/ephemeron.ml
@@ -0,0 +1,686 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Damien Doligez, projet Para, INRIA Rocquencourt            *)
+(*                                                                        *)
+(*   Copyright 1997 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 type SeededS = sig
+  include Hashtbl.SeededS
+  val clean: 'a t -> unit
+  val stats_alive: 'a t -> Hashtbl.statistics
+    (** same as {!stats} but only count the alive bindings *)
+end
+
+module type S = sig
+  include Hashtbl.S
+  val clean: 'a t -> unit
+  val stats_alive: 'a t -> Hashtbl.statistics
+    (** same as {!stats} but only count the alive bindings *)
+end
+
+module GenHashTable = struct
+
+  type equal =
+  | ETrue | EFalse
+  | EDead (** the garbage collector reclaimed the data *)
+
+  module MakeSeeded(H: sig
+    type t
+    type 'a container
+    val create: t -> 'a -> 'a container
+    val hash: int -> t -> int
+    val equal: 'a container -> t -> equal
+    val get_data: 'a container -> 'a option
+    val get_key: 'a container -> t option
+    val set_key_data: 'a container -> t -> 'a -> unit
+    val check_key: 'a container -> bool
+  end) : SeededS with type key = H.t
+  = struct
+
+    type 'a t =
+      { mutable size: int;                  (* number of entries *)
+        mutable data: 'a bucketlist array;  (* the buckets *)
+        mutable seed: int;                  (* for randomization *)
+        initial_size: int;                  (* initial array size *)
+      }
+
+    and 'a bucketlist =
+    | Empty
+    | Cons of int (* hash of the key *) * 'a H.container * 'a bucketlist
+
+    (** the hash of the key is kept in order to test the equality of the hash
+      before the key. Same reason as for Weak.Make *)
+
+    type key = H.t
+
+    let rec power_2_above x n =
+      if x >= n then x
+      else if x * 2 > Sys.max_array_length then x
+      else power_2_above (x * 2) n
+
+    let prng = lazy (Random.State.make_self_init())
+
+    let create ?(random = (Hashtbl.is_randomized ())) initial_size =
+      let s = power_2_above 16 initial_size in
+      let seed = if random then Random.State.bits (Lazy.force prng) else 0 in
+      { initial_size = s; size = 0; seed = seed; data = Array.make s Empty }
+
+    let clear h =
+      h.size <- 0;
+      let len = Array.length h.data in
+      for i = 0 to len - 1 do
+        h.data.(i) <- Empty
+      done
+
+    let reset h =
+      let len = Array.length h.data in
+      if len = h.initial_size then
+        clear h
+      else begin
+        h.size <- 0;
+        h.data <- Array.make h.initial_size Empty
+      end
+
+    let copy h = { h with data = Array.copy h.data }
+
+    let key_index h hkey =
+      hkey land (Array.length h.data - 1)
+
+    let clean h =
+      let rec do_bucket = function
+        | Empty ->
+            Empty
+        | Cons(_, c, rest) when not (H.check_key c) ->
+            h.size <- h.size - 1;
+            do_bucket rest
+        | Cons(hkey, c, rest) ->
+            Cons(hkey, c, do_bucket rest)
+      in
+      let d = h.data in
+      for i = 0 to Array.length d - 1 do
+        d.(i) <- do_bucket d.(i)
+      done
+
+    (** resize is the only function to do the actual cleaning of dead keys
+        (remove does it just because it could).
+
+        The goal is to:
+
+        - not resize infinitely when the actual number of alive keys is
+        bounded but keys are continuously added. That would happen if
+        this function always resize.
+        - not call this function after each addition, that would happen if this
+        function don't resize even when only one key is dead.
+
+        So the algorithm:
+        - clean the keys before resizing
+        - if the number of remaining keys is less than half the size of the
+        array, don't resize.
+        - if it is more, resize.
+
+        The second problem remains if the table reaches {!Sys.max_array_length}.
+
+    *)
+    let resize h =
+      let odata = h.data in
+      let osize = Array.length odata in
+      let nsize = osize * 2 in
+      clean h;
+      if nsize < Sys.max_array_length && h.size >= osize lsr 1 then begin
+        let ndata = Array.make nsize Empty in
+        h.data <- ndata;       (* so that key_index sees the new bucket count *)
+        let rec insert_bucket = function
+            Empty -> ()
+          | Cons(hkey, data, rest) ->
+              insert_bucket rest; (* preserve original order of elements *)
+              let nidx = key_index h hkey in
+              ndata.(nidx) <- Cons(hkey, data, ndata.(nidx)) in
+        for i = 0 to osize - 1 do
+          insert_bucket odata.(i)
+        done
+      end
+
+    let add h key info =
+      let hkey = H.hash h.seed key in
+      let i = key_index h hkey in
+      let container = H.create key info in
+      let bucket = Cons(hkey, container, h.data.(i)) in
+      h.data.(i) <- bucket;
+      h.size <- h.size + 1;
+      if h.size > Array.length h.data lsl 1 then resize h
+
+    let remove h key =
+      let hkey = H.hash h.seed key in
+      let rec remove_bucket = function
+        | Empty -> Empty
+        | Cons(hk, c, next) when hkey = hk ->
+            begin match H.equal c key with
+            | ETrue -> h.size <- h.size - 1; next
+            | EFalse -> Cons(hk, c, remove_bucket next)
+            | EDead ->
+                (* The dead key is automatically removed. It is acceptable
+                    for this function since it already removes a binding *)
+                h.size <- h.size - 1;
+                remove_bucket next
+            end
+        | Cons(hk,c,next) -> Cons(hk, c, remove_bucket next) in
+      let i = key_index h hkey in
+      h.data.(i) <- remove_bucket h.data.(i)
+
+    (** {!find} don't remove dead keys because it would be surprising for
+        the user that a read-only function mutates the state (eg. concurrent
+        access). Same for {!iter}, {!fold}, {!mem}.
+    *)
+    let rec find_rec key hkey = function
+      | Empty ->
+          raise Not_found
+      | Cons(hk, c, rest) when hkey = hk  ->
+          begin match H.equal c key with
+          | ETrue ->
+              begin match H.get_data c with
+              | None ->
+                  (* This case is not impossible because the gc can run between
+                      H.equal and H.get_data *)
+                  find_rec key hkey rest
+              | Some d -> d
+              end
+          | EFalse -> find_rec key hkey rest
+          | EDead ->
+              find_rec key hkey rest
+          end
+      | Cons(_, _, rest) ->
+          find_rec key hkey rest
+
+    let find h key =
+      let hkey = H.hash h.seed key in
+      (* TODO inline 3 iterations *)
+      find_rec key hkey (h.data.(key_index h hkey))
+
+    let rec find_rec_opt key hkey = function
+      | Empty ->
+          None
+      | Cons(hk, c, rest) when hkey = hk  ->
+          begin match H.equal c key with
+          | ETrue ->
+              begin match H.get_data c with
+              | None ->
+                  (* This case is not impossible because the gc can run between
+                      H.equal and H.get_data *)
+                  find_rec_opt key hkey rest
+              | Some _ as d -> d
+              end
+          | EFalse -> find_rec_opt key hkey rest
+          | EDead ->
+              find_rec_opt key hkey rest
+          end
+      | Cons(_, _, rest) ->
+          find_rec_opt key hkey rest
+
+    let find_opt h key =
+      let hkey = H.hash h.seed key in
+      (* TODO inline 3 iterations *)
+      find_rec_opt key hkey (h.data.(key_index h hkey))
+
+    let find_all h key =
+      let hkey = H.hash h.seed key in
+      let rec find_in_bucket = function
+      | Empty -> []
+      | Cons(hk, c, rest) when hkey = hk  ->
+          begin match H.equal c key with
+          | ETrue -> begin match H.get_data c with
+              | None ->
+                  find_in_bucket rest
+              | Some d -> d::find_in_bucket rest
+            end
+          | EFalse -> find_in_bucket rest
+          | EDead ->
+              find_in_bucket rest
+          end
+      | Cons(_, _, rest) ->
+          find_in_bucket rest in
+      find_in_bucket h.data.(key_index h hkey)
+
+
+    let replace h key info =
+      let hkey = H.hash h.seed key in
+      let rec replace_bucket = function
+        | Empty -> raise Not_found
+        | Cons(hk, c, next) when hkey = hk ->
+            begin match H.equal c key with
+            | ETrue -> H.set_key_data c key info
+            | EFalse | EDead -> replace_bucket next
+            end
+        | Cons(_,_,next) -> replace_bucket next
+      in
+      let i = key_index h hkey in
+      let l = h.data.(i) in
+      try
+        replace_bucket l
+      with Not_found ->
+        let container = H.create key info in
+        h.data.(i) <- Cons(hkey, container, l);
+        h.size <- h.size + 1;
+        if h.size > Array.length h.data lsl 1 then resize h
+
+    let mem h key =
+      let hkey = H.hash h.seed key in
+      let rec mem_in_bucket = function
+      | Empty ->
+          false
+      | Cons(hk, c, rest) when hk = hkey ->
+          begin match H.equal c key with
+          | ETrue -> true
+          | EFalse | EDead -> mem_in_bucket rest
+          end
+      | Cons(_hk, _c, rest) -> mem_in_bucket rest in
+      mem_in_bucket h.data.(key_index h hkey)
+
+    let iter f h =
+      let rec do_bucket = function
+        | Empty ->
+            ()
+        | Cons(_, c, rest) ->
+            begin match H.get_key c, H.get_data c with
+            | None, _ | _, None -> ()
+            | Some k, Some d -> f k d
+            end; do_bucket rest in
+      let d = h.data in
+      for i = 0 to Array.length d - 1 do
+        do_bucket d.(i)
+      done
+
+    let fold f h init =
+      let rec do_bucket b accu =
+        match b with
+          Empty ->
+            accu
+        | Cons(_, c, rest) ->
+            let accu = begin match H.get_key c, H.get_data c with
+              | None, _ | _, None -> accu
+              | Some k, Some d -> f k d accu
+            end in
+            do_bucket rest accu  in
+      let d = h.data in
+      let accu = ref init in
+      for i = 0 to Array.length d - 1 do
+        accu := do_bucket d.(i) !accu
+      done;
+      !accu
+
+    let filter_map_inplace f h =
+      let rec do_bucket = function
+        | Empty ->
+            Empty
+        | Cons(hk, c, rest) ->
+            match H.get_key c, H.get_data c with
+            | None, _ | _, None ->
+                do_bucket rest
+            | Some k, Some d ->
+                match f k d with
+                | None ->
+                    do_bucket rest
+                | Some new_d ->
+                    H.set_key_data c k new_d;
+                    Cons(hk, c, do_bucket rest)
+      in
+      let d = h.data in
+      for i = 0 to Array.length d - 1 do
+        d.(i) <- do_bucket d.(i)
+      done
+
+    let length h = h.size
+
+    let rec bucket_length accu = function
+      | Empty -> accu
+      | Cons(_, _, rest) -> bucket_length (accu + 1) rest
+
+    let stats h =
+      let mbl =
+        Array.fold_left (fun m b -> max m (bucket_length 0 b)) 0 h.data in
+      let histo = Array.make (mbl + 1) 0 in
+      Array.iter
+        (fun b ->
+           let l = bucket_length 0 b in
+           histo.(l) <- histo.(l) + 1)
+        h.data;
+      { Hashtbl.num_bindings = h.size;
+        num_buckets = Array.length h.data;
+        max_bucket_length = mbl;
+        bucket_histogram = histo }
+
+    let rec bucket_length_alive accu = function
+      | Empty -> accu
+      | Cons(_, c, rest) when H.check_key c ->
+          bucket_length_alive (accu + 1) rest
+      | Cons(_, _, rest) -> bucket_length_alive accu rest
+
+    let stats_alive h =
+      let size = ref 0 in
+      let mbl =
+        Array.fold_left (fun m b -> max m (bucket_length_alive 0 b)) 0 h.data in
+      let histo = Array.make (mbl + 1) 0 in
+      Array.iter
+        (fun b ->
+           let l = bucket_length_alive 0 b in
+           size := !size + l;
+           histo.(l) <- histo.(l) + 1)
+        h.data;
+      { Hashtbl.num_bindings = !size;
+        num_buckets = Array.length h.data;
+        max_bucket_length = mbl;
+        bucket_histogram = histo }
+
+    let to_seq tbl =
+      (* capture current array, so that even if the table is resized we
+         keep iterating on the same array *)
+      let tbl_data = tbl.data in
+      (* state: index * next bucket to traverse *)
+      let rec aux i buck () = match buck with
+        | Empty ->
+            if i = Array.length tbl_data
+            then Seq.Nil
+            else aux(i+1) tbl_data.(i) ()
+        | Cons (_, c, next) ->
+            begin match H.get_key c, H.get_data c with
+              | None, _ | _, None -> aux i next ()
+              | Some key, Some data ->
+                  Seq.Cons ((key, data), aux i next)
+            end
+      in
+      aux 0 Empty
+
+    let to_seq_keys m = Seq.map fst (to_seq m)
+
+    let to_seq_values m = Seq.map snd (to_seq m)
+
+    let add_seq tbl i =
+      Seq.iter (fun (k,v) -> add tbl k v) i
+
+    let replace_seq tbl i =
+      Seq.iter (fun (k,v) -> replace tbl k v) i
+
+    let of_seq i =
+      let tbl = create 16 in
+      replace_seq tbl i;
+      tbl
+
+  end
+end
+
+module ObjEph = Obj.Ephemeron
+
+let _obj_opt : Obj.t option -> 'a option = fun x ->
+  match x with
+  | None -> x
+  | Some v -> Some (Obj.obj v)
+
+(** The previous function is typed so this one is also correct *)
+let obj_opt : Obj.t option -> 'a option = fun x -> Obj.magic x
+
+
+module K1 = struct
+  type ('k,'d) t = ObjEph.t
+
+  let create () : ('k,'d) t = ObjEph.create 1
+
+  let get_key (t:('k,'d) t) : 'k option = obj_opt (ObjEph.get_key t 0)
+  let get_key_copy (t:('k,'d) t) : 'k option = obj_opt (ObjEph.get_key_copy t 0)
+  let set_key (t:('k,'d) t) (k:'k) : unit = ObjEph.set_key t 0 (Obj.repr k)
+  let unset_key (t:('k,'d) t) : unit = ObjEph.unset_key t 0
+  let check_key (t:('k,'d) t) : bool = ObjEph.check_key t 0
+
+  let blit_key (t1:('k,'d) t) (t2:('k,'d) t): unit =
+    ObjEph.blit_key t1 0 t2 0 1
+
+  let get_data (t:('k,'d) t) : 'd option = obj_opt (ObjEph.get_data t)
+  let get_data_copy (t:('k,'d) t) : 'd option = obj_opt (ObjEph.get_data_copy t)
+  let set_data (t:('k,'d) t) (d:'d) : unit = ObjEph.set_data t (Obj.repr d)
+  let unset_data (t:('k,'d) t) : unit = ObjEph.unset_data t
+  let check_data (t:('k,'d) t) : bool = ObjEph.check_data t
+  let blit_data (t1:(_,'d) t) (t2:(_,'d) t) : unit = ObjEph.blit_data t1 t2
+
+  module MakeSeeded (H:Hashtbl.SeededHashedType) =
+    GenHashTable.MakeSeeded(struct
+      type 'a container = (H.t,'a) t
+      type t = H.t
+      let create k d =
+        let c = create () in
+        set_data c d;
+        set_key c k;
+        c
+      let hash = H.hash
+      let equal c k =
+        (* {!get_key_copy} is not used because the equality of the user can be
+            the physical equality *)
+        match get_key c with
+        | None -> GenHashTable.EDead
+        | Some k' ->
+            if H.equal k k' then GenHashTable.ETrue else GenHashTable.EFalse
+      let get_data = get_data
+      let get_key = get_key
+      let set_key_data c k d =
+        unset_data c;
+        set_key c k;
+        set_data c d
+      let check_key = check_key
+    end)
+
+  module Make(H: Hashtbl.HashedType): (S with type key = H.t) =
+  struct
+    include MakeSeeded(struct
+        type t = H.t
+        let equal = H.equal
+        let hash (_seed: int) x = H.hash x
+      end)
+    let create sz = create ~random:false sz
+    let of_seq i =
+      let tbl = create 16 in
+      replace_seq tbl i;
+      tbl
+  end
+
+end
+
+module K2 = struct
+  type ('k1, 'k2, 'd) t = ObjEph.t
+
+  let create () : ('k1,'k2,'d) t = ObjEph.create 2
+
+  let get_key1 (t:('k1,'k2,'d) t) : 'k1 option = obj_opt (ObjEph.get_key t 0)
+  let get_key1_copy (t:('k1,'k2,'d) t) : 'k1 option =
+    obj_opt (ObjEph.get_key_copy t 0)
+  let set_key1 (t:('k1,'k2,'d) t) (k:'k1) : unit =
+    ObjEph.set_key t 0 (Obj.repr k)
+  let unset_key1 (t:('k1,'k2,'d) t) : unit = ObjEph.unset_key t 0
+  let check_key1 (t:('k1,'k2,'d) t) : bool = ObjEph.check_key t 0
+
+  let get_key2 (t:('k1,'k2,'d) t) : 'k2 option = obj_opt (ObjEph.get_key t 1)
+  let get_key2_copy (t:('k1,'k2,'d) t) : 'k2 option =
+    obj_opt (ObjEph.get_key_copy t 1)
+  let set_key2 (t:('k1,'k2,'d) t) (k:'k2) : unit =
+    ObjEph.set_key t 1 (Obj.repr k)
+  let unset_key2 (t:('k1,'k2,'d) t) : unit = ObjEph.unset_key t 1
+  let check_key2 (t:('k1,'k2,'d) t) : bool = ObjEph.check_key t 1
+
+
+  let blit_key1 (t1:('k1,_,_) t) (t2:('k1,_,_) t) : unit =
+    ObjEph.blit_key t1 0 t2 0 1
+  let blit_key2 (t1:(_,'k2,_) t) (t2:(_,'k2,_) t) : unit =
+    ObjEph.blit_key t1 1 t2 1 1
+  let blit_key12 (t1:('k1,'k2,_) t) (t2:('k1,'k2,_) t) : unit =
+    ObjEph.blit_key t1 0 t2 0 2
+
+  let get_data (t:('k1,'k2,'d) t) : 'd option = obj_opt (ObjEph.get_data t)
+  let get_data_copy (t:('k1,'k2,'d) t) : 'd option =
+    obj_opt (ObjEph.get_data_copy t)
+  let set_data (t:('k1,'k2,'d) t) (d:'d) : unit =
+    ObjEph.set_data t (Obj.repr d)
+  let unset_data (t:('k1,'k2,'d) t) : unit = ObjEph.unset_data t
+  let check_data (t:('k1,'k2,'d) t) : bool = ObjEph.check_data t
+  let blit_data (t1:(_,_,'d) t) (t2:(_,_,'d) t) : unit = ObjEph.blit_data t1 t2
+
+  module MakeSeeded
+      (H1:Hashtbl.SeededHashedType)
+      (H2:Hashtbl.SeededHashedType) =
+    GenHashTable.MakeSeeded(struct
+      type 'a container = (H1.t,H2.t,'a) t
+      type t = H1.t * H2.t
+      let create (k1,k2) d =
+        let c = create () in
+        set_data c d;
+        set_key1 c k1; set_key2 c k2;
+        c
+      let hash seed (k1,k2) =
+        H1.hash seed k1 + H2.hash seed k2 * 65599
+      let equal c (k1,k2) =
+        match get_key1 c, get_key2 c with
+        | None, _ | _ , None -> GenHashTable.EDead
+        | Some k1', Some k2' ->
+            if H1.equal k1 k1' && H2.equal k2 k2'
+            then GenHashTable.ETrue else GenHashTable.EFalse
+      let get_data = get_data
+      let get_key c =
+        match get_key1 c, get_key2 c with
+        | None, _ | _ , None -> None
+        | Some k1', Some k2' -> Some (k1', k2')
+      let set_key_data c (k1,k2) d =
+        unset_data c;
+        set_key1 c k1; set_key2 c k2;
+        set_data c d
+      let check_key c = check_key1 c && check_key2 c
+    end)
+
+  module Make(H1: Hashtbl.HashedType)(H2: Hashtbl.HashedType):
+    (S with type key = H1.t * H2.t) =
+  struct
+    include MakeSeeded
+        (struct
+          type t = H1.t
+          let equal = H1.equal
+          let hash (_seed: int) x = H1.hash x
+        end)
+        (struct
+          type t = H2.t
+          let equal = H2.equal
+          let hash (_seed: int) x = H2.hash x
+        end)
+    let create sz = create ~random:false sz
+    let of_seq i =
+      let tbl = create 16 in
+      replace_seq tbl i;
+      tbl
+  end
+
+end
+
+module Kn = struct
+  type ('k,'d) t = ObjEph.t
+
+  let create n : ('k,'d) t = ObjEph.create n
+  let length (k:('k,'d) t) : int = ObjEph.length k
+
+  let get_key (t:('k,'d) t) (n:int) : 'k option = obj_opt (ObjEph.get_key t n)
+  let get_key_copy (t:('k,'d) t) (n:int) : 'k option =
+    obj_opt (ObjEph.get_key_copy t n)
+  let set_key (t:('k,'d) t) (n:int) (k:'k) : unit =
+    ObjEph.set_key t n (Obj.repr k)
+  let unset_key (t:('k,'d) t) (n:int) : unit = ObjEph.unset_key t n
+  let check_key (t:('k,'d) t) (n:int) : bool = ObjEph.check_key t n
+
+  let blit_key (t1:('k,'d) t) (o1:int) (t2:('k,'d) t) (o2:int) (l:int) : unit =
+    ObjEph.blit_key t1 o1 t2 o2 l
+
+  let get_data (t:('k,'d) t) : 'd option = obj_opt (ObjEph.get_data t)
+  let get_data_copy (t:('k,'d) t) : 'd option = obj_opt (ObjEph.get_data_copy t)
+  let set_data (t:('k,'d) t) (d:'d) : unit = ObjEph.set_data t (Obj.repr d)
+  let unset_data (t:('k,'d) t) : unit = ObjEph.unset_data t
+  let check_data (t:('k,'d) t) : bool = ObjEph.check_data t
+  let blit_data (t1:(_,'d) t) (t2:(_,'d) t) : unit = ObjEph.blit_data t1 t2
+
+  module MakeSeeded (H:Hashtbl.SeededHashedType) =
+    GenHashTable.MakeSeeded(struct
+      type 'a container = (H.t,'a) t
+      type t = H.t array
+      let create k d =
+        let c = create (Array.length k) in
+        set_data c d;
+        for i=0 to Array.length k -1 do
+          set_key c i k.(i);
+        done;
+        c
+      let hash seed k =
+        let h = ref 0 in
+        for i=0 to Array.length k -1 do
+          h := H.hash seed k.(i) * 65599 + !h;
+        done;
+        !h
+      let equal c k =
+        let len  = Array.length k in
+        let len' = length c in
+        if len != len' then GenHashTable.EFalse
+        else
+          let rec equal_array k c i =
+            if i < 0 then GenHashTable.ETrue
+            else
+              match get_key c i with
+              | None -> GenHashTable.EDead
+              | Some ki ->
+                  if H.equal k.(i) ki
+                  then equal_array k c (i-1)
+                  else GenHashTable.EFalse
+          in
+          equal_array k c (len-1)
+      let get_data = get_data
+      let get_key c =
+        let len = length c in
+        if len = 0 then Some [||]
+        else
+          match get_key c 0 with
+          | None -> None
+          | Some k0 ->
+              let rec fill a i =
+                if i < 1 then Some a
+                else
+                  match get_key c i with
+                  | None -> None
+                  | Some ki ->
+                      a.(i) <- ki;
+                      fill a (i-1)
+              in
+              let a = Array.make len k0 in
+              fill a (len-1)
+      let set_key_data c k d =
+        unset_data c;
+        for i=0 to Array.length k -1 do
+          set_key c i k.(i);
+        done;
+        set_data c d
+      let check_key c =
+        let rec check c i =
+          i < 0 || (check_key c i && check c (i-1)) in
+        check c (length c - 1)
+    end)
+
+  module Make(H: Hashtbl.HashedType): (S with type key = H.t array) =
+  struct
+    include MakeSeeded(struct
+        type t = H.t
+        let equal = H.equal
+        let hash (_seed: int) x = H.hash x
+      end)
+    let create sz = create ~random:false sz
+    let of_seq i =
+      let tbl = create 16 in
+      replace_seq tbl i;
+      tbl
+  end
+end
diff --git a/stdlib/ephemeron.mli b/stdlib/ephemeron.mli
new file mode 100644
index 00000000..434115e9
--- /dev/null
+++ b/stdlib/ephemeron.mli
@@ -0,0 +1,371 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Damien Doligez, projet Para, INRIA Rocquencourt            *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Ephemerons and weak hash tables *)
+
+(** Ephemerons and weak hash tables are useful when one wants to cache
+    or memorize the computation of a function, as long as the
+    arguments and the function are used, without creating memory leaks
+    by continuously keeping old computation results that are not
+    useful anymore because one argument or the function is freed. An
+    implementation using {!Hashtbl.t} is not suitable because all
+    associations would keep the arguments and the result in memory.
+
+    Ephemerons can also be used for "adding" a field to an arbitrary
+    boxed OCaml value: you can attach some information to a value
+    created by an external library without memory leaks.
+
+    Ephemerons hold some keys and one or no data. They are all boxed
+    OCaml values. The keys of an ephemeron have the same behavior
+    as weak pointers according to the garbage collector. In fact
+    OCaml weak pointers are implemented as ephemerons without data.
+
+    The keys and data of an ephemeron are said to be full if they
+    point to a value, or empty if the value has never been set, has
+    been unset, or was erased by the GC. In the function that accesses
+    the keys or data these two states are represented by the [option]
+    type.
+
+    The data is considered by the garbage collector alive if all the
+    full keys are alive and if the ephemeron is alive. When one of the
+    keys is not considered alive anymore by the GC, the data is
+    emptied from the ephemeron. The data could be alive for another
+    reason and in that case the GC will not free it, but the ephemeron
+    will not hold the data anymore.
+
+    The ephemerons complicate the notion of liveness of values, because
+    it is not anymore an equivalence with the reachability from root
+    value by usual pointers (not weak and not ephemerons). With ephemerons
+    the notion of liveness is constructed by the least fixpoint of:
+       A value is alive if:
+        - it is a root value
+        - it is reachable from alive value by usual pointers
+        - it is the data of an alive ephemeron with all its full keys alive
+
+    Notes:
+    - All the types defined in this module cannot be marshaled
+    using {!Stdlib.output_value} or the functions of the
+    {!Marshal} module.
+
+    Ephemerons are defined in a language agnostic way in this paper:
+    B. Hayes, Ephemerons: A New Finalization Mechanism, OOPSLA'97
+
+    @since 4.03.0
+*)
+
+module type S = sig
+  (** Propose the same interface as usual hash table. However since
+      the bindings are weak, even if [mem h k] is true, a subsequent
+      [find h k] may raise [Not_found] because the garbage collector
+      can run between the two.
+
+      Moreover, the table shouldn't be modified during a call to [iter].
+      Use [filter_map_inplace] in this case.
+  *)
+
+  include Hashtbl.S
+
+  val clean: 'a t -> unit
+  (** remove all dead bindings. Done automatically during automatic resizing. *)
+
+  val stats_alive: 'a t -> Hashtbl.statistics
+  (** same as {!Hashtbl.SeededS.stats} but only count the alive bindings *)
+end
+(** The output signature of the functor {!K1.Make} and {!K2.Make}.
+    These hash tables are weak in the keys. If all the keys of a binding are
+    alive the binding is kept, but if one of the keys of the binding
+    is dead then the binding is removed.
+*)
+
+module type SeededS = sig
+  include Hashtbl.SeededS
+  val clean: 'a t -> unit
+  (** remove all dead bindings. Done automatically during automatic resizing. *)
+
+  val stats_alive: 'a t -> Hashtbl.statistics
+  (** same as {!Hashtbl.SeededS.stats} but only count the alive bindings *)
+end
+(** The output signature of the functor {!K1.MakeSeeded} and {!K2.MakeSeeded}.
+*)
+
+module K1 : sig
+  type ('k,'d) t (** an ephemeron with one key *)
+
+  val create: unit -> ('k,'d) t
+  (** [Ephemeron.K1.create ()] creates an ephemeron with one key. The
+      data and the key are empty *)
+
+  val get_key: ('k,'d) t -> 'k option
+  (** [Ephemeron.K1.get_key eph] returns [None] if the key of [eph] is
+      empty, [Some x] (where [x] is the key) if it is full. *)
+
+  val get_key_copy: ('k,'d) t -> 'k option
+  (** [Ephemeron.K1.get_key_copy eph] returns [None] if the key of [eph] is
+      empty, [Some x] (where [x] is a (shallow) copy of the key) if
+      it is full. This function has the same GC friendliness as {!Weak.get_copy}
+
+      If the element is a custom block it is not copied.
+  *)
+
+  val set_key: ('k,'d) t -> 'k -> unit
+  (** [Ephemeron.K1.set_key eph el] sets the key of [eph] to be a
+      (full) key to [el]
+  *)
+
+  val unset_key: ('k,'d) t -> unit
+  (** [Ephemeron.K1.unset_key eph el] sets the key of [eph] to be an
+      empty key. Since there is only one key, the ephemeron starts
+      behaving like a reference on the data. *)
+
+  val check_key: ('k,'d) t -> bool
+  (** [Ephemeron.K1.check_key eph] returns [true] if the key of the [eph]
+      is full, [false] if it is empty. Note that even if
+      [Ephemeron.K1.check_key eph] returns [true], a subsequent
+      {!Ephemeron.K1.get_key}[eph] can return [None].
+  *)
+
+
+  val blit_key : ('k,_) t -> ('k,_) t -> unit
+  (** [Ephemeron.K1.blit_key eph1 eph2] sets the key of [eph2] with
+      the key of [eph1]. Contrary to using {!Ephemeron.K1.get_key}
+      followed by {!Ephemeron.K1.set_key} or {!Ephemeron.K1.unset_key}
+      this function does not prevent the incremental GC from erasing
+      the value in its current cycle. *)
+
+  val get_data: ('k,'d) t -> 'd option
+  (** [Ephemeron.K1.get_data eph] returns [None] if the data of [eph] is
+      empty, [Some x] (where [x] is the data) if it is full. *)
+
+  val get_data_copy: ('k,'d) t -> 'd option
+  (** [Ephemeron.K1.get_data_copy eph] returns [None] if the data of [eph] is
+      empty, [Some x] (where [x] is a (shallow) copy of the data) if
+      it is full. This function has the same GC friendliness as {!Weak.get_copy}
+
+      If the element is a custom block it is not copied.
+  *)
+
+  val set_data: ('k,'d) t -> 'd -> unit
+  (** [Ephemeron.K1.set_data eph el] sets the data of [eph] to be a
+      (full) data to [el]
+  *)
+
+  val unset_data: ('k,'d) t -> unit
+  (** [Ephemeron.K1.unset_data eph el] sets the key of [eph] to be an
+      empty key. The ephemeron starts behaving like a weak pointer.
+  *)
+
+  val check_data: ('k,'d) t -> bool
+  (** [Ephemeron.K1.check_data eph] returns [true] if the data of the [eph]
+      is full, [false] if it is empty. Note that even if
+      [Ephemeron.K1.check_data eph] returns [true], a subsequent
+      {!Ephemeron.K1.get_data}[eph] can return [None].
+  *)
+
+  val blit_data : (_,'d) t -> (_,'d) t -> unit
+  (** [Ephemeron.K1.blit_data eph1 eph2] sets the data of [eph2] with
+      the data of [eph1]. Contrary to using {!Ephemeron.K1.get_data}
+      followed by {!Ephemeron.K1.set_data} or {!Ephemeron.K1.unset_data}
+      this function does not prevent the incremental GC from erasing
+      the value in its current cycle. *)
+
+  module Make (H:Hashtbl.HashedType) : S with type key = H.t
+  (** Functor building an implementation of a weak hash table *)
+
+  module MakeSeeded (H:Hashtbl.SeededHashedType) : SeededS with type key = H.t
+  (** Functor building an implementation of a weak hash table.
+      The seed is similar to the one of {!Hashtbl.MakeSeeded}. *)
+
+end
+
+module K2 : sig
+  type ('k1,'k2,'d) t (** an ephemeron with two keys *)
+
+  val create: unit -> ('k1,'k2,'d) t
+  (** Same as {!Ephemeron.K1.create} *)
+
+  val get_key1: ('k1,'k2,'d) t -> 'k1 option
+  (** Same as {!Ephemeron.K1.get_key} *)
+
+  val get_key1_copy: ('k1,'k2,'d) t -> 'k1 option
+  (** Same as {!Ephemeron.K1.get_key_copy} *)
+
+  val set_key1: ('k1,'k2,'d) t -> 'k1 -> unit
+  (** Same as {!Ephemeron.K1.set_key} *)
+
+  val unset_key1: ('k1,'k2,'d) t -> unit
+  (** Same as {!Ephemeron.K1.unset_key} *)
+
+  val check_key1: ('k1,'k2,'d) t ->  bool
+  (** Same as {!Ephemeron.K1.check_key} *)
+
+  val get_key2: ('k1,'k2,'d) t -> 'k2 option
+  (** Same as {!Ephemeron.K1.get_key} *)
+
+  val get_key2_copy: ('k1,'k2,'d) t -> 'k2 option
+  (** Same as {!Ephemeron.K1.get_key_copy} *)
+
+  val set_key2: ('k1,'k2,'d) t -> 'k2 -> unit
+  (** Same as {!Ephemeron.K1.set_key} *)
+
+  val unset_key2: ('k1,'k2,'d) t -> unit
+  (** Same as {!Ephemeron.K1.unset_key} *)
+
+  val check_key2: ('k1,'k2,'d) t -> bool
+  (** Same as {!Ephemeron.K1.check_key} *)
+
+  val blit_key1: ('k1,_,_) t -> ('k1,_,_) t -> unit
+  (** Same as {!Ephemeron.K1.blit_key} *)
+
+  val blit_key2: (_,'k2,_) t -> (_,'k2,_) t -> unit
+  (** Same as {!Ephemeron.K1.blit_key} *)
+
+  val blit_key12: ('k1,'k2,_) t -> ('k1,'k2,_) t -> unit
+  (** Same as {!Ephemeron.K1.blit_key} *)
+
+  val get_data: ('k1,'k2,'d) t -> 'd option
+  (** Same as {!Ephemeron.K1.get_data} *)
+
+  val get_data_copy: ('k1,'k2,'d) t -> 'd option
+  (** Same as {!Ephemeron.K1.get_data_copy} *)
+
+  val set_data: ('k1,'k2,'d) t -> 'd -> unit
+  (** Same as {!Ephemeron.K1.set_data} *)
+
+  val unset_data: ('k1,'k2,'d) t -> unit
+  (** Same as {!Ephemeron.K1.unset_data} *)
+
+  val check_data: ('k1,'k2,'d) t -> bool
+  (** Same as {!Ephemeron.K1.check_data} *)
+
+  val blit_data: ('k1,'k2,'d) t -> ('k1,'k2,'d) t -> unit
+  (** Same as {!Ephemeron.K1.blit_data} *)
+
+  module Make
+      (H1:Hashtbl.HashedType)
+      (H2:Hashtbl.HashedType) :
+    S with type key = H1.t * H2.t
+  (** Functor building an implementation of a weak hash table *)
+
+  module MakeSeeded
+      (H1:Hashtbl.SeededHashedType)
+      (H2:Hashtbl.SeededHashedType) :
+    SeededS with type key = H1.t * H2.t
+  (** Functor building an implementation of a weak hash table.
+      The seed is similar to the one of {!Hashtbl.MakeSeeded}. *)
+
+end
+
+module Kn : sig
+  type ('k,'d) t (** an ephemeron with an arbitrary number of keys
+                      of the same type *)
+
+  val create: int -> ('k,'d) t
+  (** Same as {!Ephemeron.K1.create} *)
+
+  val get_key: ('k,'d) t -> int -> 'k option
+  (** Same as {!Ephemeron.K1.get_key} *)
+
+  val get_key_copy: ('k,'d) t -> int -> 'k option
+  (** Same as {!Ephemeron.K1.get_key_copy} *)
+
+  val set_key: ('k,'d) t -> int -> 'k -> unit
+  (** Same as {!Ephemeron.K1.set_key} *)
+
+  val unset_key: ('k,'d) t -> int -> unit
+  (** Same as {!Ephemeron.K1.unset_key} *)
+
+  val check_key: ('k,'d) t -> int ->  bool
+  (** Same as {!Ephemeron.K1.check_key} *)
+
+  val blit_key: ('k,_) t -> int -> ('k,_) t -> int -> int -> unit
+  (** Same as {!Ephemeron.K1.blit_key} *)
+
+  val get_data: ('k,'d) t -> 'd option
+  (** Same as {!Ephemeron.K1.get_data} *)
+
+  val get_data_copy: ('k,'d) t -> 'd option
+  (** Same as {!Ephemeron.K1.get_data_copy} *)
+
+  val set_data: ('k,'d) t -> 'd -> unit
+  (** Same as {!Ephemeron.K1.set_data} *)
+
+  val unset_data: ('k,'d) t -> unit
+  (** Same as {!Ephemeron.K1.unset_data} *)
+
+  val check_data: ('k,'d) t -> bool
+  (** Same as {!Ephemeron.K1.check_data} *)
+
+  val blit_data: ('k,'d) t -> ('k,'d) t -> unit
+  (** Same as {!Ephemeron.K1.blit_data} *)
+
+  module Make
+      (H:Hashtbl.HashedType) :
+    S with type key = H.t array
+  (** Functor building an implementation of a weak hash table *)
+
+  module MakeSeeded
+      (H:Hashtbl.SeededHashedType) :
+    SeededS with type key = H.t array
+  (** Functor building an implementation of a weak hash table.
+      The seed is similar to the one of {!Hashtbl.MakeSeeded}. *)
+
+end
+
+module GenHashTable: sig
+  (** Define a hash table on generic containers which have a notion of
+      "death" and aliveness. If a binding is dead the hash table can
+      automatically remove it. *)
+
+  type equal =
+  | ETrue | EFalse
+  | EDead (** the container is dead *)
+
+  module MakeSeeded(H:
+  sig
+    type t
+    (** keys *)
+
+    type 'a container
+    (** contains keys and the associated data *)
+
+    val hash: int -> t -> int
+    (** same as {!Hashtbl.SeededHashedType} *)
+
+    val equal: 'a container -> t -> equal
+    (** equality predicate used to compare a key with the one in a
+        container. Can return [EDead] if the keys in the container are
+        dead *)
+
+    val create: t -> 'a -> 'a container
+    (** [create key data] creates a container from
+        some initials keys and one data *)
+
+    val get_key: 'a container -> t option
+    (** [get_key cont] returns the keys if they are all alive *)
+
+    val get_data: 'a container -> 'a option
+    (** [get_data cont] returns the data if it is alive *)
+
+    val set_key_data: 'a container -> t -> 'a -> unit
+    (** [set_key_data cont] modifies the key and data *)
+
+    val check_key: 'a container -> bool
+    (** [check_key cont] checks if all the keys contained in the data
+        are alive *)
+  end) : SeededS with type key = H.t
+  (** Functor building an implementation of an hash table that use the container
+      for keeping the information given *)
+
+end
diff --git a/stdlib/expand_module_aliases.awk b/stdlib/expand_module_aliases.awk
new file mode 100644
index 00000000..7f1e49ba
--- /dev/null
+++ b/stdlib/expand_module_aliases.awk
@@ -0,0 +1,33 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                 Jeremie Dimino, Jane Street Europe                     *
+#*                                                                        *
+#*   Copyright 2017 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.          *
+#*                                                                        *
+#**************************************************************************
+
+# This script adds the Stdlib__ prefixes to the module aliases in
+# stdlib.ml and stdlib.mli
+BEGIN { state=0 }
+NR == 1 { printf ("# 1 \"%s\"\n", FILENAME) }
+/\(\*MODULE_ALIASES\*\)\r?/ { state=1 }
+{ if (state==0)
+    print;
+  else if (state==1)
+    state=2;
+  else if ($1 == "module")
+  { if (ocamldoc!="true") printf("\n(** @canonical %s *)", $2);
+    first_letter=substr($4,1,1);
+    if (dune_wrapped!="true")
+      first_letter=tolower(first_letter);
+    printf("\nmodule %s = Stdlib__%s%s\n", $2, first_letter, substr($4,2));
+  }
+  else
+    print
+}
diff --git a/stdlib/filename.ml b/stdlib/filename.ml
new file mode 100644
index 00000000..b0dd5c21
--- /dev/null
+++ b/stdlib/filename.ml
@@ -0,0 +1,361 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Xavier Leroy and Damien Doligez, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let generic_quote quotequote s =
+  let l = String.length s in
+  let b = Buffer.create (l + 20) in
+  Buffer.add_char b '\'';
+  for i = 0 to l - 1 do
+    if s.[i] = '\''
+    then Buffer.add_string b quotequote
+    else Buffer.add_char b  s.[i]
+  done;
+  Buffer.add_char b '\'';
+  Buffer.contents b
+
+(* This function implements the Open Group specification found here:
+  [[1]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/basename.html
+  In step 1 of [[1]], we choose to return "." for empty input.
+    (for compatibility with previous versions of OCaml)
+  In step 2, we choose to process "//" normally.
+  Step 6 is not implemented: we consider that the [suffix] operand is
+    always absent.  Suffixes are handled by [chop_suffix] and [chop_extension].
+*)
+let generic_basename is_dir_sep current_dir_name name =
+  let rec find_end n =
+    if n < 0 then String.sub name 0 1
+    else if is_dir_sep name n then find_end (n - 1)
+    else find_beg n (n + 1)
+  and find_beg n p =
+    if n < 0 then String.sub name 0 p
+    else if is_dir_sep name n then String.sub name (n + 1) (p - n - 1)
+    else find_beg (n - 1) p
+  in
+  if name = ""
+  then current_dir_name
+  else find_end (String.length name - 1)
+
+(* This function implements the Open Group specification found here:
+  [[2]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/dirname.html
+  In step 6 of [[2]], we choose to process "//" normally.
+*)
+let generic_dirname is_dir_sep current_dir_name name =
+  let rec trailing_sep n =
+    if n < 0 then String.sub name 0 1
+    else if is_dir_sep name n then trailing_sep (n - 1)
+    else base n
+  and base n =
+    if n < 0 then current_dir_name
+    else if is_dir_sep name n then intermediate_sep n
+    else base (n - 1)
+  and intermediate_sep n =
+    if n < 0 then String.sub name 0 1
+    else if is_dir_sep name n then intermediate_sep (n - 1)
+    else String.sub name 0 (n + 1)
+  in
+  if name = ""
+  then current_dir_name
+  else trailing_sep (String.length name - 1)
+
+module type SYSDEPS = sig
+  val null : string
+  val current_dir_name : string
+  val parent_dir_name : string
+  val dir_sep : string
+  val is_dir_sep : string -> int -> bool
+  val is_relative : string -> bool
+  val is_implicit : string -> bool
+  val check_suffix : string -> string -> bool
+  val chop_suffix_opt : suffix:string -> string -> string option
+  val temp_dir_name : string
+  val quote : string -> string
+  val quote_command :
+    string -> ?stdin: string -> ?stdout: string -> ?stderr: string
+           -> string list -> string
+  val basename : string -> string
+  val dirname : string -> string
+end
+
+module Unix : SYSDEPS = struct
+  let null = "/dev/null"
+  let current_dir_name = "."
+  let parent_dir_name = ".."
+  let dir_sep = "/"
+  let is_dir_sep s i = s.[i] = '/'
+  let is_relative n = String.length n < 1 || n.[0] <> '/'
+  let is_implicit n =
+    is_relative n
+    && (String.length n < 2 || String.sub n 0 2 <> "./")
+    && (String.length n < 3 || String.sub n 0 3 <> "../")
+  let check_suffix name suff =
+    String.length name >= String.length suff &&
+    String.sub name (String.length name - String.length suff)
+                    (String.length suff) = suff
+
+  let chop_suffix_opt ~suffix filename =
+    let len_s = String.length suffix and len_f = String.length filename in
+    if len_f >= len_s then
+      let r = String.sub filename (len_f - len_s) len_s in
+      if r = suffix then
+        Some (String.sub filename 0 (len_f - len_s))
+      else
+        None
+    else
+      None
+
+  let temp_dir_name =
+    try Sys.getenv "TMPDIR" with Not_found -> "/tmp"
+  let quote = generic_quote "'\\''"
+  let quote_command cmd ?stdin ?stdout ?stderr args =
+    String.concat " " (List.map quote (cmd :: args))
+    ^ (match stdin  with None -> "" | Some f -> " <" ^ quote f)
+    ^ (match stdout with None -> "" | Some f -> " >" ^ quote f)
+    ^ (match stderr with None -> "" | Some f -> if stderr = stdout
+                                                then " 2>&1"
+                                                else " 2>" ^ quote f)
+  let basename = generic_basename is_dir_sep current_dir_name
+  let dirname = generic_dirname is_dir_sep current_dir_name
+end
+
+module Win32 : SYSDEPS = struct
+  let null = "NUL"
+  let current_dir_name = "."
+  let parent_dir_name = ".."
+  let dir_sep = "\\"
+  let is_dir_sep s i = let c = s.[i] in c = '/' || c = '\\' || c = ':'
+  let is_relative n =
+    (String.length n < 1 || n.[0] <> '/')
+    && (String.length n < 1 || n.[0] <> '\\')
+    && (String.length n < 2 || n.[1] <> ':')
+  let is_implicit n =
+    is_relative n
+    && (String.length n < 2 || String.sub n 0 2 <> "./")
+    && (String.length n < 2 || String.sub n 0 2 <> ".\\")
+    && (String.length n < 3 || String.sub n 0 3 <> "../")
+    && (String.length n < 3 || String.sub n 0 3 <> "..\\")
+  let check_suffix name suff =
+   String.length name >= String.length suff &&
+   (let s = String.sub name (String.length name - String.length suff)
+                            (String.length suff) in
+    String.lowercase_ascii s = String.lowercase_ascii suff)
+
+  let chop_suffix_opt ~suffix filename =
+    let len_s = String.length suffix and len_f = String.length filename in
+    if len_f >= len_s then
+      let r = String.sub filename (len_f - len_s) len_s in
+      if String.lowercase_ascii r = String.lowercase_ascii suffix then
+        Some (String.sub filename 0 (len_f - len_s))
+      else
+        None
+    else
+      None
+
+
+  let temp_dir_name =
+    try Sys.getenv "TEMP" with Not_found -> "."
+  let quote s =
+    let l = String.length s in
+    let b = Buffer.create (l + 20) in
+    Buffer.add_char b '\"';
+    let rec loop i =
+      if i = l then Buffer.add_char b '\"' else
+      match s.[i] with
+      | '\"' -> loop_bs 0 i;
+      | '\\' -> loop_bs 0 i;
+      | c    -> Buffer.add_char b c; loop (i+1);
+    and loop_bs n i =
+      if i = l then begin
+        Buffer.add_char b '\"';
+        add_bs n;
+      end else begin
+        match s.[i] with
+        | '\"' -> add_bs (2*n+1); Buffer.add_char b '\"'; loop (i+1);
+        | '\\' -> loop_bs (n+1) (i+1);
+        | _    -> add_bs n; loop i
+      end
+    and add_bs n = for _j = 1 to n do Buffer.add_char b '\\'; done
+    in
+    loop 0;
+    Buffer.contents b
+(*
+Quoting commands for execution by cmd.exe is difficult.
+1- Each argument is first quoted using the "quote" function above, to
+   protect it against the processing performed by the C runtime system,
+   then cmd.exe's special characters are escaped with '^', using
+   the "quote_cmd" function below.  For more details, see
+   https://blogs.msdn.microsoft.com/twistylittlepassagesallalike/2011/04/23
+2- The command and the redirection files, if any, must be double-quoted
+   in case they contain spaces.  This quoting is interpreted by cmd.exe,
+   not by the C runtime system, hence the "quote" function above
+   cannot be used.  The two characters we don't know how to quote
+   inside a double-quoted cmd.exe string are double-quote and percent.
+   We just fail if the command name or the redirection file names
+   contain a double quote (not allowed in Windows file names, anyway)
+   or a percent.  See function "quote_cmd_filename" below.
+3- The whole string passed to Sys.command is then enclosed in double
+   quotes, which are immediately stripped by cmd.exe.  Otherwise,
+   some of the double quotes from step 2 above can be misparsed.
+   See e.g. https://stackoverflow.com/a/9965141
+*)
+  let quote_cmd s =
+    let b = Buffer.create (String.length s + 20) in
+    String.iter
+      (fun c ->
+        match c with
+        | '(' | ')' | '!' | '^' | '%' | '\"' | '<' | '>' | '&' | '|' ->
+            Buffer.add_char b '^'; Buffer.add_char b c
+        | _ ->
+            Buffer.add_char b c)
+      s;
+    Buffer.contents b
+  let quote_cmd_filename f =
+    if String.contains f '\"' || String.contains f '%' then
+      failwith ("Filename.quote_command: bad file name " ^ f)
+    else if String.contains f ' ' then
+      "\"" ^ f ^ "\""
+    else
+      f
+  (* Redirections in cmd.exe: see https://ss64.com/nt/syntax-redirection.html
+     and https://docs.microsoft.com/en-us/previous-versions/windows/it-pro/windows-xp/bb490982(v=technet.10)
+  *)
+  let quote_command cmd ?stdin ?stdout ?stderr args =
+    String.concat "" [
+      "\"";
+      quote_cmd_filename cmd;
+      " ";
+      quote_cmd (String.concat " " (List.map quote args));
+      (match stdin  with None -> "" | Some f -> " <" ^ quote_cmd_filename f);
+      (match stdout with None -> "" | Some f -> " >" ^ quote_cmd_filename f);
+      (match stderr with None -> "" | Some f ->
+                                        if stderr = stdout
+                                        then " 2>&1"
+                                        else " 2>" ^ quote_cmd_filename f);
+      "\""
+    ]
+  let has_drive s =
+    let is_letter = function
+      | 'A' .. 'Z' | 'a' .. 'z' -> true
+      | _ -> false
+    in
+    String.length s >= 2 && is_letter s.[0] && s.[1] = ':'
+  let drive_and_path s =
+    if has_drive s
+    then (String.sub s 0 2, String.sub s 2 (String.length s - 2))
+    else ("", s)
+  let dirname s =
+    let (drive, path) = drive_and_path s in
+    let dir = generic_dirname is_dir_sep current_dir_name path in
+    drive ^ dir
+  let basename s =
+    let (_drive, path) = drive_and_path s in
+    generic_basename is_dir_sep current_dir_name path
+end
+
+module Cygwin : SYSDEPS = struct
+  let null = "/dev/null"
+  let current_dir_name = "."
+  let parent_dir_name = ".."
+  let dir_sep = "/"
+  let is_dir_sep = Win32.is_dir_sep
+  let is_relative = Win32.is_relative
+  let is_implicit = Win32.is_implicit
+  let check_suffix = Win32.check_suffix
+  let chop_suffix_opt = Win32.chop_suffix_opt
+  let temp_dir_name = Unix.temp_dir_name
+  let quote = Unix.quote
+  let quote_command = Unix.quote_command
+  let basename = generic_basename is_dir_sep current_dir_name
+  let dirname = generic_dirname is_dir_sep current_dir_name
+end
+
+module Sysdeps =
+  (val (match Sys.os_type with
+       | "Win32" -> (module Win32: SYSDEPS)
+       | "Cygwin" -> (module Cygwin: SYSDEPS)
+       | _ -> (module Unix: SYSDEPS)))
+
+include Sysdeps
+
+let concat dirname filename =
+  let l = String.length dirname in
+  if l = 0 || is_dir_sep dirname (l-1)
+  then dirname ^ filename
+  else dirname ^ dir_sep ^ filename
+
+let chop_suffix name suff =
+  let n = String.length name - String.length suff in
+  if n < 0 then invalid_arg "Filename.chop_suffix" else String.sub name 0 n
+
+let extension_len name =
+  let rec check i0 i =
+    if i < 0 || is_dir_sep name i then 0
+    else if name.[i] = '.' then check i0 (i - 1)
+    else String.length name - i0
+  in
+  let rec search_dot i =
+    if i < 0 || is_dir_sep name i then 0
+    else if name.[i] = '.' then check i (i - 1)
+    else search_dot (i - 1)
+  in
+  search_dot (String.length name - 1)
+
+let extension name =
+  let l = extension_len name in
+  if l = 0 then "" else String.sub name (String.length name - l) l
+
+let chop_extension name =
+  let l = extension_len name in
+  if l = 0 then invalid_arg "Filename.chop_extension"
+  else String.sub name 0 (String.length name - l)
+
+let remove_extension name =
+  let l = extension_len name in
+  if l = 0 then name else String.sub name 0 (String.length name - l)
+
+external open_desc: string -> open_flag list -> int -> int = "caml_sys_open"
+external close_desc: int -> unit = "caml_sys_close"
+
+let prng = lazy(Random.State.make_self_init ())
+
+let temp_file_name temp_dir prefix suffix =
+  let rnd = (Random.State.bits (Lazy.force prng)) land 0xFFFFFF in
+  concat temp_dir (Printf.sprintf "%s%06x%s" prefix rnd suffix)
+
+
+let current_temp_dir_name = ref temp_dir_name
+
+let set_temp_dir_name s = current_temp_dir_name := s
+let get_temp_dir_name () = !current_temp_dir_name
+
+let temp_file ?(temp_dir = !current_temp_dir_name) prefix suffix =
+  let rec try_name counter =
+    let name = temp_file_name temp_dir prefix suffix in
+    try
+      close_desc(open_desc name [Open_wronly; Open_creat; Open_excl] 0o600);
+      name
+    with Sys_error _ as e ->
+      if counter >= 1000 then raise e else try_name (counter + 1)
+  in try_name 0
+
+let open_temp_file ?(mode = [Open_text]) ?(perms = 0o600)
+                   ?(temp_dir = !current_temp_dir_name) prefix suffix =
+  let rec try_name counter =
+    let name = temp_file_name temp_dir prefix suffix in
+    try
+      (name,
+       open_out_gen (Open_wronly::Open_creat::Open_excl::mode) perms name)
+    with Sys_error _ as e ->
+      if counter >= 1000 then raise e else try_name (counter + 1)
+  in try_name 0
diff --git a/stdlib/filename.mli b/stdlib/filename.mli
new file mode 100644
index 00000000..9f99d2c5
--- /dev/null
+++ b/stdlib/filename.mli
@@ -0,0 +1,225 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Operations on file names. *)
+
+val current_dir_name : string
+(** The conventional name for the current directory (e.g. [.] in Unix). *)
+
+val parent_dir_name : string
+(** The conventional name for the parent of the current directory
+   (e.g. [..] in Unix). *)
+
+val dir_sep : string
+(** The directory separator (e.g. [/] in Unix). @since 3.11.2 *)
+
+val concat : string -> string -> string
+(** [concat dir file] returns a file name that designates file
+   [file] in directory [dir]. *)
+
+val is_relative : string -> bool
+(** Return [true] if the file name is relative to the current
+   directory, [false] if it is absolute (i.e. in Unix, starts
+   with [/]). *)
+
+val is_implicit : string -> bool
+(** Return [true] if the file name is relative and does not start
+   with an explicit reference to the current directory ([./] or
+   [../] in Unix), [false] if it starts with an explicit reference
+   to the root directory or the current directory. *)
+
+val check_suffix : string -> string -> bool
+(** [check_suffix name suff] returns [true] if the filename [name]
+    ends with the suffix [suff].
+
+    Under Windows ports (including Cygwin), comparison is
+    case-insensitive, relying on [String.lowercase_ascii].  Note that
+    this does not match exactly the interpretation of case-insensitive
+    filename equivalence from Windows.  *)
+
+val chop_suffix : string -> string -> string
+(** [chop_suffix name suff] removes the suffix [suff] from
+   the filename [name]. The behavior is undefined if [name] does not
+   end with the suffix [suff]. [chop_suffix_opt] is thus recommended
+   instead.
+*)
+
+val chop_suffix_opt: suffix:string -> string -> string option
+(** [chop_suffix_opt ~suffix filename] removes the suffix from
+    the [filename] if possible, or returns [None] if the
+    filename does not end with the suffix.
+
+    Under Windows ports (including Cygwin), comparison is
+    case-insensitive, relying on [String.lowercase_ascii].  Note that
+    this does not match exactly the interpretation of case-insensitive
+    filename equivalence from Windows.
+
+    @since 4.08
+*)
+
+
+val extension : string -> string
+(** [extension name] is the shortest suffix [ext] of [name0] where:
+
+    - [name0] is the longest suffix of [name] that does not
+      contain a directory separator;
+    - [ext] starts with a period;
+    - [ext] is preceded by at least one non-period character
+      in [name0].
+
+    If such a suffix does not exist, [extension name] is the empty
+    string.
+
+    @since 4.04
+*)
+
+val remove_extension : string -> string
+(** Return the given file name without its extension, as defined
+    in {!Filename.extension}. If the extension is empty, the function
+    returns the given file name.
+
+    The following invariant holds for any file name [s]:
+
+    [remove_extension s ^ extension s = s]
+
+    @since 4.04
+*)
+
+val chop_extension : string -> string
+(** Same as {!Filename.remove_extension}, but raise [Invalid_argument]
+    if the given name has an empty extension. *)
+
+
+val basename : string -> string
+(** Split a file name into directory name / base file name.
+   If [name] is a valid file name, then [concat (dirname name) (basename name)]
+   returns a file name which is equivalent to [name]. Moreover,
+   after setting the current directory to [dirname name] (with {!Sys.chdir}),
+   references to [basename name] (which is a relative file name)
+   designate the same file as [name] before the call to {!Sys.chdir}.
+
+   This function conforms to the specification of POSIX.1-2008 for the
+   [basename] utility. *)
+
+val dirname : string -> string
+(** See {!Filename.basename}.
+   This function conforms to the specification of POSIX.1-2008 for the
+   [dirname] utility. *)
+
+val null : string
+(** [null] is ["/dev/null"] on POSIX and ["NUL"] on Windows. It represents a
+    file on the OS that discards all writes and returns end of file on reads.
+
+    @since 4.10.0 *)
+
+val temp_file : ?temp_dir: string -> string -> string -> string
+(** [temp_file prefix suffix] returns the name of a
+   fresh temporary file in the temporary directory.
+   The base name of the temporary file is formed by concatenating
+   [prefix], then a suitably chosen integer number, then [suffix].
+   The optional argument [temp_dir] indicates the temporary directory
+   to use, defaulting to the current result of {!Filename.get_temp_dir_name}.
+   The temporary file is created empty, with permissions [0o600]
+   (readable and writable only by the file owner).  The file is
+   guaranteed to be different from any other file that existed when
+   [temp_file] was called.
+   @raise Sys_error if the file could not be created.
+   @before 3.11.2 no ?temp_dir optional argument
+*)
+
+val open_temp_file :
+      ?mode: open_flag list -> ?perms: int -> ?temp_dir: string -> string ->
+      string -> string * out_channel
+(** Same as {!Filename.temp_file}, but returns both the name of a fresh
+   temporary file, and an output channel opened (atomically) on
+   this file.  This function is more secure than [temp_file]: there
+   is no risk that the temporary file will be modified (e.g. replaced
+   by a symbolic link) before the program opens it.  The optional argument
+   [mode] is a list of additional flags to control the opening of the file.
+   It can contain one or several of [Open_append], [Open_binary],
+   and [Open_text].  The default is [[Open_text]] (open in text mode). The
+   file is created with permissions [perms] (defaults to readable and
+   writable only by the file owner, [0o600]).
+
+   @raise Sys_error if the file could not be opened.
+   @before 4.03.0 no ?perms optional argument
+   @before 3.11.2 no ?temp_dir optional argument
+*)
+
+val get_temp_dir_name : unit -> string
+(** The name of the temporary directory:
+    Under Unix, the value of the [TMPDIR] environment variable, or "/tmp"
+    if the variable is not set.
+    Under Windows, the value of the [TEMP] environment variable, or "."
+    if the variable is not set.
+    The temporary directory can be changed with {!Filename.set_temp_dir_name}.
+    @since 4.00.0
+*)
+
+val set_temp_dir_name : string -> unit
+(** Change the temporary directory returned by {!Filename.get_temp_dir_name}
+    and used by {!Filename.temp_file} and {!Filename.open_temp_file}.
+    @since 4.00.0
+*)
+
+val temp_dir_name : string
+  [@@ocaml.deprecated "Use Filename.get_temp_dir_name instead"]
+(** The name of the initial temporary directory:
+    Under Unix, the value of the [TMPDIR] environment variable, or "/tmp"
+    if the variable is not set.
+    Under Windows, the value of the [TEMP] environment variable, or "."
+    if the variable is not set.
+    @deprecated You should use {!Filename.get_temp_dir_name} instead.
+    @since 3.09.1
+*)
+
+val quote : string -> string
+(** Return a quoted version of a file name, suitable for use as
+    one argument in a command line, escaping all meta-characters.
+    Warning: under Windows, the output is only suitable for use
+    with programs that follow the standard Windows quoting
+    conventions.
+ *)
+
+val quote_command :
+       string -> ?stdin:string -> ?stdout:string -> ?stderr:string
+              -> string list -> string
+(** [quote_command cmd args] returns a quoted command line, suitable
+    for use as an argument to {!Sys.command}, {!Unix.system}, and the
+    {!Unix.open_process} functions.
+
+    The string [cmd] is the command to call.  The list [args] is
+    the list of arguments to pass to this command.  It can be empty.
+
+    The optional arguments [?stdin] and [?stdout] and [?stderr] are
+    file names used to redirect the standard input, the standard
+    output, or the standard error of the command.
+    If [~stdin:f] is given, a redirection [< f] is performed and the
+    standard input of the command reads from file [f].
+    If [~stdout:f] is given, a redirection [> f] is performed and the
+    standard output of the command is written to file [f].
+    If [~stderr:f] is given, a redirection [2> f] is performed and the
+    standard error of the command is written to file [f].
+    If both [~stdout:f] and [~stderr:f] are given, with the exact
+    same file name [f], a [2>&1] redirection is performed so that the
+    standard output and the standard error of the command are interleaved
+    and redirected to the same file [f].
+
+    Under Unix and Cygwin, the command, the arguments, and the redirections
+    if any are quoted using {!Filename.quote}, then concatenated.
+    Under Win32, additional quoting is performed as required by the
+    [cmd.exe] shell that is called by {!Sys.command}.
+    @raise Failure if the command cannot be escaped on the current platform.
+*)
diff --git a/stdlib/float.ml b/stdlib/float.ml
new file mode 100644
index 00000000..3145f1c6
--- /dev/null
+++ b/stdlib/float.ml
@@ -0,0 +1,511 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                        Nicolas Ojeda Bar, LexiFi                       *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+external neg : float -> float = "%negfloat"
+external add : float -> float -> float = "%addfloat"
+external sub : float -> float -> float = "%subfloat"
+external mul : float -> float -> float = "%mulfloat"
+external div : float -> float -> float = "%divfloat"
+external rem : float -> float -> float = "caml_fmod_float" "fmod"
+  [@@unboxed] [@@noalloc]
+external fma : float -> float -> float -> float = "caml_fma_float" "caml_fma"
+  [@@unboxed] [@@noalloc]
+external abs : float -> float = "%absfloat"
+
+let zero = 0.
+let one = 1.
+let minus_one = -1.
+let infinity = Stdlib.infinity
+let neg_infinity = Stdlib.neg_infinity
+let nan = Stdlib.nan
+let is_finite (x: float) = x -. x = 0.
+let is_infinite (x: float) = 1. /. x = 0.
+let is_nan (x: float) = x <> x
+
+let pi = 0x1.921fb54442d18p+1
+let max_float = Stdlib.max_float
+let min_float = Stdlib.min_float
+let epsilon = Stdlib.epsilon_float
+external of_int : int -> float = "%floatofint"
+external to_int : float -> int = "%intoffloat"
+external of_string : string -> float = "caml_float_of_string"
+let of_string_opt = Stdlib.float_of_string_opt
+let to_string = Stdlib.string_of_float
+type fpclass = Stdlib.fpclass =
+    FP_normal
+  | FP_subnormal
+  | FP_zero
+  | FP_infinite
+  | FP_nan
+external classify_float : (float [@unboxed]) -> fpclass =
+  "caml_classify_float" "caml_classify_float_unboxed" [@@noalloc]
+external pow : float -> float -> float = "caml_power_float" "pow"
+  [@@unboxed] [@@noalloc]
+external sqrt : float -> float = "caml_sqrt_float" "sqrt"
+  [@@unboxed] [@@noalloc]
+external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc]
+external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc]
+external log10 : float -> float = "caml_log10_float" "log10"
+  [@@unboxed] [@@noalloc]
+external expm1 : float -> float = "caml_expm1_float" "caml_expm1"
+  [@@unboxed] [@@noalloc]
+external log1p : float -> float = "caml_log1p_float" "caml_log1p"
+  [@@unboxed] [@@noalloc]
+external cos : float -> float = "caml_cos_float" "cos" [@@unboxed] [@@noalloc]
+external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc]
+external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc]
+external acos : float -> float = "caml_acos_float" "acos"
+  [@@unboxed] [@@noalloc]
+external asin : float -> float = "caml_asin_float" "asin"
+  [@@unboxed] [@@noalloc]
+external atan : float -> float = "caml_atan_float" "atan"
+  [@@unboxed] [@@noalloc]
+external atan2 : float -> float -> float = "caml_atan2_float" "atan2"
+  [@@unboxed] [@@noalloc]
+external hypot : float -> float -> float
+               = "caml_hypot_float" "caml_hypot" [@@unboxed] [@@noalloc]
+external cosh : float -> float = "caml_cosh_float" "cosh"
+  [@@unboxed] [@@noalloc]
+external sinh : float -> float = "caml_sinh_float" "sinh"
+  [@@unboxed] [@@noalloc]
+external tanh : float -> float = "caml_tanh_float" "tanh"
+  [@@unboxed] [@@noalloc]
+external trunc : float -> float = "caml_trunc_float" "caml_trunc"
+  [@@unboxed] [@@noalloc]
+external round : float -> float = "caml_round_float" "caml_round"
+  [@@unboxed] [@@noalloc]
+external ceil : float -> float = "caml_ceil_float" "ceil"
+  [@@unboxed] [@@noalloc]
+external floor : float -> float = "caml_floor_float" "floor"
+[@@unboxed] [@@noalloc]
+
+let is_integer x = x = trunc x && is_finite x
+
+external next_after : float -> float -> float
+  = "caml_nextafter_float" "caml_nextafter" [@@unboxed] [@@noalloc]
+
+let succ x = next_after x infinity
+let pred x = next_after x neg_infinity
+
+external copy_sign : float -> float -> float
+                  = "caml_copysign_float" "caml_copysign"
+                  [@@unboxed] [@@noalloc]
+external sign_bit : (float [@unboxed]) -> bool
+  = "caml_signbit_float" "caml_signbit" [@@noalloc]
+
+external frexp : float -> float * int = "caml_frexp_float"
+external ldexp : (float [@unboxed]) -> (int [@untagged]) -> (float [@unboxed]) =
+  "caml_ldexp_float" "caml_ldexp_float_unboxed" [@@noalloc]
+external modf : float -> float * float = "caml_modf_float"
+type t = float
+external compare : float -> float -> int = "%compare"
+let equal x y = compare x y = 0
+
+let[@inline] min (x: float) (y: float) =
+  if y > x || (not(sign_bit y) && sign_bit x) then
+    if is_nan y then y else x
+  else if is_nan x then x else y
+
+let[@inline] max (x: float) (y: float) =
+  if y > x || (not(sign_bit y) && sign_bit x) then
+    if is_nan x then x else y
+  else if is_nan y then y else x
+
+let[@inline] min_max (x: float) (y: float) =
+  if is_nan x || is_nan y then (nan, nan)
+  else if y > x || (not(sign_bit y) && sign_bit x) then (x, y) else (y, x)
+
+let[@inline] min_num (x: float) (y: float) =
+  if y > x || (not(sign_bit y) && sign_bit x) then
+    if is_nan x then y else x
+  else if is_nan y then x else y
+
+let[@inline] max_num (x: float) (y: float) =
+  if y > x || (not(sign_bit y) && sign_bit x) then
+    if is_nan y then x else y
+  else if is_nan x then y else x
+
+let[@inline] min_max_num (x: float) (y: float) =
+  if is_nan x then (y,y)
+  else if is_nan y then (x,x)
+  else if y > x || (not(sign_bit y) && sign_bit x) then (x,y) else (y,x)
+
+external seeded_hash_param : int -> int -> int -> float -> int
+                           = "caml_hash" [@@noalloc]
+let hash x = seeded_hash_param 10 100 0 x
+
+module Array = struct
+
+  type t = floatarray
+
+  external length : t -> int = "%floatarray_length"
+  external get : t -> int -> float = "%floatarray_safe_get"
+  external set : t -> int -> float -> unit = "%floatarray_safe_set"
+  external create : int -> t = "caml_floatarray_create"
+  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
+
+  let unsafe_blit src sofs dst dofs len =
+    for i = 0 to len - 1 do
+      unsafe_set dst (dofs + i) (unsafe_get src (sofs + i))
+    done
+
+  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 init l f =
+    if l < 0 then invalid_arg "Float.Array.init"
+    else
+      let res = create l in
+      for i = 0 to l - 1 do
+        unsafe_set res i (f i)
+      done;
+      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"
+
+  let rec sum_lengths acc = function
+    | [] -> acc
+    | hd :: tl -> sum_lengths (ensure_ge (length hd + acc) acc) tl
+
+  let concat l =
+    let len = sum_lengths 0 l in
+    let result = create len in
+    let rec loop l i =
+      match l with
+      | [] -> assert (i = len)
+      | hd :: tl ->
+        let hlen = length hd in
+        unsafe_blit hd 0 result i hlen;
+        loop tl (i + hlen)
+    in
+    loop l 0;
+    result
+
+  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
+
+  let copy a =
+    let l = length a in
+    let result = create l in
+    unsafe_blit a 0 result 0 l;
+    result
+
+  let fill a ofs len v =
+    check a ofs len "Float.Array.fill";
+    unsafe_fill a ofs len v
+
+  let blit src sofs dst dofs len =
+    check src sofs len "Float.array.blit";
+    check dst dofs len "Float.array.blit";
+    unsafe_blit src sofs dst dofs len
+
+  let to_list a =
+    List.init (length a) (unsafe_get a)
+
+  let of_list l =
+    let result = create (List.length l) in
+    let rec fill i l =
+      match l with
+      | [] -> result
+      | h :: t -> unsafe_set result i h; fill (i + 1) t
+    in
+    fill 0 l
+
+  (* duplicated from array.ml *)
+  let iter f a =
+    for i = 0 to length a - 1 do f (unsafe_get a i) done
+
+  (* duplicated from array.ml *)
+  let iter2 f a b =
+    if length a <> length b then
+      invalid_arg "Float.Array.iter2: arrays must have the same length"
+    else
+      for i = 0 to length a - 1 do f (unsafe_get a i) (unsafe_get b i) done
+
+  let map f a =
+    let l = length a in
+    let r = create l in
+    for i = 0 to l - 1 do
+      unsafe_set r i (f (unsafe_get a i))
+    done;
+    r
+
+  let map2 f a b =
+    let la = length a in
+    let lb = length b in
+    if la <> lb then
+      invalid_arg "Float.Array.map2: arrays must have the same length"
+    else begin
+      let r = create la in
+      for i = 0 to la - 1 do
+        unsafe_set r i (f (unsafe_get a i) (unsafe_get b i))
+      done;
+      r
+    end
+
+  (* duplicated from array.ml *)
+  let iteri f a =
+    for i = 0 to length a - 1 do f i (unsafe_get a i) done
+
+  let mapi f a =
+    let l = length a in
+    let r = create l in
+    for i = 0 to l - 1 do
+      unsafe_set r i (f i (unsafe_get a i))
+    done;
+    r
+
+  (* duplicated from array.ml *)
+  let fold_left f x a =
+    let r = ref x in
+    for i = 0 to length a - 1 do
+      r := f !r (unsafe_get a i)
+    done;
+    !r
+
+  (* duplicated from array.ml *)
+  let fold_right f a x =
+    let r = ref x in
+    for i = length a - 1 downto 0 do
+      r := f (unsafe_get a i) !r
+    done;
+    !r
+
+  (* duplicated from array.ml *)
+  let exists p a =
+    let n = length a in
+    let rec loop i =
+      if i = n then false
+      else if p (unsafe_get a i) then true
+      else loop (i + 1) in
+    loop 0
+
+  (* duplicated from array.ml *)
+  let for_all p a =
+    let n = length a in
+    let rec loop i =
+      if i = n then true
+      else if p (unsafe_get a i) then loop (i + 1)
+      else false in
+    loop 0
+
+  (* duplicated from array.ml *)
+  let mem x a =
+    let n = length a in
+    let rec loop i =
+      if i = n then false
+      else if compare (unsafe_get a i) x = 0 then true
+      else loop (i + 1)
+    in
+    loop 0
+
+  (* mostly duplicated from array.ml, but slightly different *)
+  let mem_ieee x a =
+    let n = length a in
+    let rec loop i =
+      if i = n then false
+      else if x = (unsafe_get a i) then true
+      else loop (i + 1)
+    in
+    loop 0
+
+  (* duplicated from array.ml *)
+  exception Bottom of int
+  let sort cmp a =
+    let maxson l i =
+      let i31 = i+i+i+1 in
+      let x = ref i31 in
+      if i31+2 < l then begin
+        if cmp (get a i31) (get a (i31+1)) < 0 then x := i31+1;
+        if cmp (get a !x) (get a (i31+2)) < 0 then x := i31+2;
+        !x
+      end else
+        if i31+1 < l && cmp (get a i31) (get a (i31+1)) < 0
+        then i31+1
+        else if i31 < l then i31 else raise (Bottom i)
+    in
+    let rec trickledown l i e =
+      let j = maxson l i in
+      if cmp (get a j) e > 0 then begin
+        set a i (get a j);
+        trickledown l j e;
+      end else begin
+        set a i e;
+      end;
+    in
+    let trickle l i e = try trickledown l i e with Bottom i -> set a i e in
+    let rec bubbledown l i =
+      let j = maxson l i in
+      set a i (get a j);
+      bubbledown l j
+    in
+    let bubble l i = try bubbledown l i with Bottom i -> i in
+    let rec trickleup i e =
+      let father = (i - 1) / 3 in
+      assert (i <> father);
+      if cmp (get a father) e < 0 then begin
+        set a i (get a father);
+        if father > 0 then trickleup father e else set a 0 e;
+      end else begin
+        set a i e;
+      end;
+    in
+    let l = length a in
+    for i = (l + 1) / 3 - 1 downto 0 do trickle l i (get a i); done;
+    for i = l - 1 downto 2 do
+      let e = (get a i) in
+      set a i (get a 0);
+      trickleup (bubble i 0) e;
+    done;
+    if l > 1 then (let e = (get a 1) in set a 1 (get a 0); set a 0 e)
+
+  (* duplicated from array.ml, except for the call to [create] *)
+  let cutoff = 5
+  let stable_sort cmp a =
+    let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+      let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
+      let rec loop i1 s1 i2 s2 d =
+        if cmp s1 s2 <= 0 then begin
+          set dst d s1;
+          let i1 = i1 + 1 in
+          if i1 < src1r then
+            loop i1 (get a i1) i2 s2 (d + 1)
+          else
+            blit src2 i2 dst (d + 1) (src2r - i2)
+        end else begin
+          set dst d s2;
+          let i2 = i2 + 1 in
+          if i2 < src2r then
+            loop i1 s1 i2 (get src2 i2) (d + 1)
+          else
+            blit a i1 dst (d + 1) (src1r - i1)
+        end
+      in loop src1ofs (get a src1ofs) src2ofs (get src2 src2ofs) dstofs;
+    in
+    let isortto srcofs dst dstofs len =
+      for i = 0 to len - 1 do
+        let e = (get a (srcofs + i)) in
+        let j = ref (dstofs + i - 1) in
+        while (!j >= dstofs && cmp (get dst !j) e > 0) do
+          set dst (!j + 1) (get dst !j);
+          decr j;
+        done;
+        set dst (!j + 1) e;
+      done;
+    in
+    let rec sortto srcofs dst dstofs len =
+      if len <= cutoff then isortto srcofs dst dstofs len else begin
+        let l1 = len / 2 in
+        let l2 = len - l1 in
+        sortto (srcofs + l1) dst (dstofs + l1) l2;
+        sortto srcofs a (srcofs + l2) l1;
+        merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
+      end;
+    in
+    let l = length a in
+    if l <= cutoff then isortto 0 a 0 l else begin
+      let l1 = l / 2 in
+      let l2 = l - l1 in
+      let t = create l2 in
+      sortto l1 t 0 l2;
+      sortto 0 a l2 l1;
+      merge l2 l1 t 0 l2 a 0;
+    end
+
+  let fast_sort = stable_sort
+
+  (* duplicated from array.ml *)
+  let to_seq a =
+    let rec aux i () =
+      if i < length a
+      then
+        let x = unsafe_get a i in
+        Seq.Cons (x, aux (i+1))
+      else Seq.Nil
+    in
+    aux 0
+
+  (* duplicated from array.ml *)
+  let to_seqi a =
+    let rec aux i () =
+      if i < length a
+      then
+        let x = unsafe_get a i in
+        Seq.Cons ((i,x), aux (i+1))
+      else Seq.Nil
+    in
+    aux 0
+
+  (* mostly duplicated from array.ml *)
+  let of_rev_list l =
+    let len = List.length l in
+    let a = create len in
+    let rec fill i = function
+        [] -> a
+      | hd::tl -> unsafe_set a i hd; fill (i-1) tl
+    in
+    fill (len-1) l
+
+  (* duplicated from array.ml *)
+  let of_seq i =
+    let l = Seq.fold_left (fun acc x -> x::acc) [] i in
+    of_rev_list l
+
+
+  let map_to_array f a =
+    let l = length a in
+    if l = 0 then [| |] else begin
+      let r = Array.make l (f (unsafe_get a 0)) in
+      for i = 1 to l - 1 do
+        Array.unsafe_set r i (f (unsafe_get a i))
+      done;
+      r
+    end
+
+  let map_from_array f a =
+    let l = Array.length a in
+    let r = create l in
+    for i = 0 to l - 1 do
+      unsafe_set r i (f (Array.unsafe_get a i))
+    done;
+    r
+
+end
+
+module ArrayLabels = Array
diff --git a/stdlib/float.mli b/stdlib/float.mli
new file mode 100644
index 00000000..51263be7
--- /dev/null
+++ b/stdlib/float.mli
@@ -0,0 +1,648 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                        Nicolas Ojeda Bar, LexiFi                       *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** {1 Floating-point arithmetic}
+
+    OCaml's floating-point numbers follow the
+    IEEE 754 standard, using double precision (64 bits) numbers.
+    Floating-point operations never raise an exception on overflow,
+    underflow, division by zero, etc.  Instead, special IEEE numbers
+    are returned as appropriate, such as [infinity] for [1.0 /. 0.0],
+    [neg_infinity] for [-1.0 /. 0.0], and [nan] ('not a number')
+    for [0.0 /. 0.0].  These special numbers then propagate through
+    floating-point computations as expected: for instance,
+    [1.0 /. infinity] is [0.0], and any arithmetic operation with [nan]
+    as argument returns [nan] as result.
+
+    @since 4.07.0
+*)
+
+val zero : float
+(** The floating point 0.
+   @since 4.08.0 *)
+
+val one : float
+(** The floating-point 1.
+   @since 4.08.0 *)
+
+val minus_one : float
+(** The floating-point -1.
+   @since 4.08.0 *)
+
+external neg : float -> float = "%negfloat"
+(** Unary negation. *)
+
+external add : float -> float -> float = "%addfloat"
+(** Floating-point addition. *)
+
+external sub : float -> float -> float = "%subfloat"
+(** Floating-point subtraction. *)
+
+external mul : float -> float -> float = "%mulfloat"
+(** Floating-point multiplication. *)
+
+external div : float -> float -> float = "%divfloat"
+(** Floating-point division. *)
+
+external fma : float -> float -> float -> float =
+  "caml_fma_float" "caml_fma" [@@unboxed] [@@noalloc]
+(** [fma x y z] returns [x * y + z], with a best effort for computing
+   this expression with a single rounding, using either hardware
+   instructions (providing full IEEE compliance) or a software
+   emulation.  Note: since software emulation of the fma is costly,
+   make sure that you are using hardware fma support if performance
+   matters.  @since 4.08.0 *)
+
+external rem : float -> float -> float = "caml_fmod_float" "fmod"
+[@@unboxed] [@@noalloc]
+(** [rem a b] returns the remainder of [a] with respect to [b].  The returned
+    value is [a -. n *. b], where [n] is the quotient [a /. b] rounded towards
+    zero to an integer. *)
+
+val succ : float -> float
+(** [succ x] returns the floating point number right after [x] i.e.,
+   the smallest floating-point number greater than [x].  See also
+   {!next_after}.
+   @since 4.08.0 *)
+
+val pred : float -> float
+(** [pred x] returns the floating-point number right before [x] i.e.,
+   the greatest floating-point number smaller than [x].  See also
+   {!next_after}.
+   @since 4.08.0 *)
+
+external abs : float -> float = "%absfloat"
+(** [abs f] returns the absolute value of [f]. *)
+
+val infinity : float
+(** Positive infinity. *)
+
+val neg_infinity : float
+(** Negative infinity. *)
+
+val nan : float
+(** A special floating-point value denoting the result of an
+    undefined operation such as [0.0 /. 0.0].  Stands for
+    'not a number'.  Any floating-point operation with [nan] as
+    argument returns [nan] as result.  As for floating-point comparisons,
+    [=], [<], [<=], [>] and [>=] return [false] and [<>] returns [true]
+    if one or both of their arguments is [nan]. *)
+
+val pi : float
+(** The constant pi. *)
+
+val max_float : float
+(** The largest positive finite value of type [float]. *)
+
+val min_float : float
+(** The smallest positive, non-zero, non-denormalized value of type [float]. *)
+
+val epsilon : float
+(** The difference between [1.0] and the smallest exactly representable
+    floating-point number greater than [1.0]. *)
+
+val is_finite : float -> bool
+(** [is_finite x] is [true] iff [x] is finite i.e., not infinite and
+   not {!nan}.
+
+   @since 4.08.0 *)
+
+val is_infinite : float -> bool
+(** [is_infinite x] is [true] iff [x] is {!infinity} or {!neg_infinity}.
+
+   @since 4.08.0 *)
+
+val is_nan : float -> bool
+(** [is_nan x] is [true] iff [x] is not a number (see {!nan}).
+
+   @since 4.08.0 *)
+
+val is_integer : float -> bool
+(** [is_integer x] is [true] iff [x] is an integer.
+
+   @since 4.08.0 *)
+
+external of_int : int -> float = "%floatofint"
+(** Convert an integer to floating-point. *)
+
+external to_int : float -> int = "%intoffloat"
+(** Truncate the given floating-point number to an integer.
+    The result is unspecified if the argument is [nan] or falls outside the
+    range of representable integers. *)
+
+external of_string : string -> float = "caml_float_of_string"
+(** Convert the given string to a float.  The string is read in decimal
+    (by default) or in hexadecimal (marked by [0x] or [0X]).
+    The format of decimal floating-point numbers is
+    [ [-] dd.ddd (e|E) [+|-] dd ], where [d] stands for a decimal digit.
+    The format of hexadecimal floating-point numbers is
+    [ [-] 0(x|X) hh.hhh (p|P) [+|-] dd ], where [h] stands for an
+    hexadecimal digit and [d] for a decimal digit.
+    In both cases, at least one of the integer and fractional parts must be
+    given; the exponent part is optional.
+    The [_] (underscore) character can appear anywhere in the string
+    and is ignored.
+    Depending on the execution platforms, other representations of
+    floating-point numbers can be accepted, but should not be relied upon.
+    @raise Failure if the given string is not a valid
+    representation of a float. *)
+
+val of_string_opt: string -> float option
+(** Same as [of_string], but returns [None] instead of raising. *)
+
+val to_string : float -> string
+(** Return the string representation of a floating-point number. *)
+
+type fpclass = Stdlib.fpclass =
+    FP_normal           (** Normal number, none of the below *)
+  | FP_subnormal        (** Number very close to 0.0, has reduced precision *)
+  | FP_zero             (** Number is 0.0 or -0.0 *)
+  | FP_infinite         (** Number is positive or negative infinity *)
+  | FP_nan              (** Not a number: result of an undefined operation *)
+(** The five classes of floating-point numbers, as determined by
+    the {!classify_float} function. *)
+
+external classify_float : (float [@unboxed]) -> fpclass =
+  "caml_classify_float" "caml_classify_float_unboxed" [@@noalloc]
+(** Return the class of the given floating-point number:
+    normal, subnormal, zero, infinite, or not a number. *)
+
+external pow : float -> float -> float = "caml_power_float" "pow"
+[@@unboxed] [@@noalloc]
+(** Exponentiation. *)
+
+external sqrt : float -> float = "caml_sqrt_float" "sqrt"
+[@@unboxed] [@@noalloc]
+(** Square root. *)
+
+external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc]
+(** Exponential. *)
+
+external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc]
+(** Natural logarithm. *)
+
+external log10 : float -> float = "caml_log10_float" "log10"
+[@@unboxed] [@@noalloc]
+(** Base 10 logarithm. *)
+
+external expm1 : float -> float = "caml_expm1_float" "caml_expm1"
+[@@unboxed] [@@noalloc]
+(** [expm1 x] computes [exp x -. 1.0], giving numerically-accurate results
+    even if [x] is close to [0.0]. *)
+
+external log1p : float -> float = "caml_log1p_float" "caml_log1p"
+[@@unboxed] [@@noalloc]
+(** [log1p x] computes [log(1.0 +. x)] (natural logarithm),
+    giving numerically-accurate results even if [x] is close to [0.0]. *)
+
+external cos : float -> float = "caml_cos_float" "cos" [@@unboxed] [@@noalloc]
+(** Cosine.  Argument is in radians. *)
+
+external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc]
+(** Sine.  Argument is in radians. *)
+
+external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc]
+(** Tangent.  Argument is in radians. *)
+
+external acos : float -> float = "caml_acos_float" "acos"
+[@@unboxed] [@@noalloc]
+(** Arc cosine.  The argument must fall within the range [[-1.0, 1.0]].
+    Result is in radians and is between [0.0] and [pi]. *)
+
+external asin : float -> float = "caml_asin_float" "asin"
+[@@unboxed] [@@noalloc]
+(** Arc sine.  The argument must fall within the range [[-1.0, 1.0]].
+    Result is in radians and is between [-pi/2] and [pi/2]. *)
+
+external atan : float -> float = "caml_atan_float" "atan"
+[@@unboxed] [@@noalloc]
+(** Arc tangent.
+    Result is in radians and is between [-pi/2] and [pi/2]. *)
+
+external atan2 : float -> float -> float = "caml_atan2_float" "atan2"
+[@@unboxed] [@@noalloc]
+(** [atan2 y x] returns the arc tangent of [y /. x].  The signs of [x]
+    and [y] are used to determine the quadrant of the result.
+    Result is in radians and is between [-pi] and [pi]. *)
+
+external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot"
+[@@unboxed] [@@noalloc]
+(** [hypot x y] returns [sqrt(x *. x + y *. y)], that is, the length
+    of the hypotenuse of a right-angled triangle with sides of length
+    [x] and [y], or, equivalently, the distance of the point [(x,y)]
+    to origin.  If one of [x] or [y] is infinite, returns [infinity]
+    even if the other is [nan]. *)
+
+external cosh : float -> float = "caml_cosh_float" "cosh"
+[@@unboxed] [@@noalloc]
+(** Hyperbolic cosine.  Argument is in radians. *)
+
+external sinh : float -> float = "caml_sinh_float" "sinh"
+[@@unboxed] [@@noalloc]
+(** Hyperbolic sine.  Argument is in radians. *)
+
+external tanh : float -> float = "caml_tanh_float" "tanh"
+[@@unboxed] [@@noalloc]
+(** Hyperbolic tangent.  Argument is in radians. *)
+
+external trunc : float -> float = "caml_trunc_float" "caml_trunc"
+                                    [@@unboxed] [@@noalloc]
+(** [trunc x] rounds [x] to the nearest integer whose absolute value is
+   less than or equal to [x].
+
+   @since 4.08.0 *)
+
+external round : float -> float = "caml_round_float" "caml_round"
+                                    [@@unboxed] [@@noalloc]
+(** [round x] rounds [x] to the nearest integer with ties (fractional
+   values of 0.5) rounded away from zero, regardless of the current
+   rounding direction.  If [x] is an integer, [+0.], [-0.], [nan], or
+   infinite, [x] itself is returned.
+
+   @since 4.08.0 *)
+
+external ceil : float -> float = "caml_ceil_float" "ceil"
+[@@unboxed] [@@noalloc]
+(** Round above to an integer value.
+    [ceil f] returns the least integer value greater than or equal to [f].
+    The result is returned as a float. *)
+
+external floor : float -> float = "caml_floor_float" "floor"
+[@@unboxed] [@@noalloc]
+(** Round below to an integer value.
+    [floor f] returns the greatest integer value less than or
+    equal to [f].
+    The result is returned as a float. *)
+
+external next_after : float -> float -> float
+  = "caml_nextafter_float" "caml_nextafter" [@@unboxed] [@@noalloc]
+(** [next_after x y] returns the next representable floating-point
+   value following [x] in the direction of [y].  More precisely, if
+   [y] is greater (resp. less) than [x], it returns the smallest
+   (resp. largest) representable number greater (resp. less) than [x].
+   If [x] equals [y], the function returns [y].  If [x] or [y] is
+   [nan], a [nan] is returned.
+   Note that [next_after max_float infinity = infinity] and that
+   [next_after 0. infinity] is the smallest denormalized positive number.
+   If [x] is the smallest denormalized positive number,
+   [next_after x 0. = 0.]
+
+   @since 4.08.0 *)
+
+external copy_sign : float -> float -> float
+  = "caml_copysign_float" "caml_copysign"
+[@@unboxed] [@@noalloc]
+(** [copy_sign x y] returns a float whose absolute value is that of [x]
+    and whose sign is that of [y].  If [x] is [nan], returns [nan].
+    If [y] is [nan], returns either [x] or [-. x], but it is not
+    specified which. *)
+
+external sign_bit : (float [@unboxed]) -> bool
+  = "caml_signbit_float" "caml_signbit" [@@noalloc]
+(** [sign_bit x] is [true] iff the sign bit of [x] is set.
+    For example [sign_bit 1.] and [signbit 0.] are [false] while
+    [sign_bit (-1.)] and [sign_bit (-0.)] are [true].
+
+    @since 4.08.0 *)
+
+external frexp : float -> float * int = "caml_frexp_float"
+(** [frexp f] returns the pair of the significant
+    and the exponent of [f].  When [f] is zero, the
+    significant [x] and the exponent [n] of [f] are equal to
+    zero.  When [f] is non-zero, they are defined by
+    [f = x *. 2 ** n] and [0.5 <= x < 1.0]. *)
+
+external ldexp : (float [@unboxed]) -> (int [@untagged]) -> (float [@unboxed]) =
+  "caml_ldexp_float" "caml_ldexp_float_unboxed" [@@noalloc]
+(** [ldexp x n] returns [x *. 2 ** n]. *)
+
+external modf : float -> float * float = "caml_modf_float"
+(** [modf f] returns the pair of the fractional and integral
+    part of [f]. *)
+
+type t = float
+(** An alias for the type of floating-point numbers. *)
+
+val compare: t -> t -> int
+(** [compare x y] returns [0] if [x] is equal to [y], a negative integer if [x]
+    is less than [y], and a positive integer if [x] is greater than
+    [y]. [compare] treats [nan] as equal to itself and less than any other float
+    value.  This treatment of [nan] ensures that [compare] defines a total
+    ordering relation.  *)
+
+val equal: t -> t -> bool
+(** The equal function for floating-point numbers, compared using {!compare}. *)
+
+val min : t -> t -> t
+(** [min x y] returns the minimum of [x] and [y].  It returns [nan]
+   when [x] or [y] is [nan].  Moreover [min (-0.) (+0.) = -0.]
+
+   @since 4.08.0 *)
+
+val max : float -> float -> float
+(** [max x y] returns the maximum of [x] and [y].  It returns [nan]
+   when [x] or [y] is [nan].  Moreover [max (-0.) (+0.) = +0.]
+
+   @since 4.08.0 *)
+
+val min_max : float -> float -> float * float
+(** [min_max x y] is [(min x y, max x y)], just more efficient.
+
+   @since 4.08.0 *)
+
+val min_num : t -> t -> t
+(** [min_num x y] returns the minimum of [x] and [y] treating [nan] as
+   missing values.  If both [x] and [y] are [nan], [nan] is returned.
+   Moreover [min_num (-0.) (+0.) = -0.]
+
+   @since 4.08.0 *)
+
+val max_num : t -> t -> t
+(** [max_num x y] returns the maximum of [x] and [y] treating [nan] as
+   missing values.  If both [x] and [y] are [nan] [nan] is returned.
+   Moreover [max_num (-0.) (+0.) = +0.]
+
+   @since 4.08.0 *)
+
+val min_max_num : float -> float -> float * float
+(** [min_max_num x y] is [(min_num x y, max_num x y)], just more
+   efficient.  Note that in particular [min_max_num x nan = (x, x)]
+   and [min_max_num nan y = (y, y)].
+
+   @since 4.08.0 *)
+
+
+val hash: t -> int
+(** The hash function for floating-point numbers. *)
+
+module Array : sig
+
+  type t = floatarray
+  (** The type of float arrays with packed representation.  @since 4.08.0 *)
+
+  val length : t -> int
+  (** Return the length (number of elements) of the given floatarray. *)
+
+  val get : t -> int -> float
+  (** [get a n] returns the element number [n] of floatarray [a].
+      @raise Invalid_argument if [n] is outside the range 0 to
+      [(length a - 1)]. *)
+
+  val set : t -> int -> float -> unit
+  (** [set a n x] modifies floatarray [a] in place, replacing element
+      number [n] with [x].
+      @raise Invalid_argument if [n] is outside the range 0 to
+      [(length a - 1)]. *)
+
+  val make : int -> float -> t
+  (** [make n x] returns a fresh floatarray of length [n], initialized with [x].
+      @raise Invalid_argument if [n < 0] or [n > Sys.max_floatarray_length]. *)
+
+  val create : int -> t
+  (** [create n] returns a fresh floatarray of length [n],
+      with uninitialized data.
+      @raise Invalid_argument if [n < 0] or [n > Sys.max_floatarray_length]. *)
+
+  val init : int -> (int -> float) -> t
+  (** [init n f] returns a fresh floatarray of length [n],
+      with element number [i] initialized to the result of [f i].
+      In other terms, [init n f] tabulates the results of [f]
+      applied to the integers [0] to [n-1].
+      @raise Invalid_argument if [n < 0] or [n > Sys.max_floatarray_length]. *)
+
+  val append : t -> t -> t
+  (** [append v1 v2] returns a fresh floatarray containing the
+      concatenation of the floatarrays [v1] and [v2].
+      @raise Invalid_argument if
+      [length v1 + length v2 > Sys.max_floatarray_length]. *)
+
+  val concat : t list -> t
+  (** Same as {!append}, but concatenates a list of floatarrays. *)
+
+  val sub : t -> int -> int -> t
+  (** [sub a start len] returns a fresh floatarray of length [len],
+      containing the elements number [start] to [start + len - 1]
+      of floatarray [a].
+      @raise Invalid_argument if [start] and [len] do not
+      designate a valid subarray of [a]; that is, if
+      [start < 0], or [len < 0], or [start + len > length a]. *)
+
+  val copy : t -> t
+  (** [copy a] returns a copy of [a], that is, a fresh floatarray
+      containing the same elements as [a]. *)
+
+  val fill : t -> int -> int -> float -> unit
+  (** [fill a ofs len x] modifies the floatarray [a] in place,
+      storing [x] in elements number [ofs] to [ofs + len - 1].
+      @raise Invalid_argument if [ofs] and [len] do not
+      designate a valid subarray of [a]. *)
+
+  val blit : t -> int -> t -> int -> int -> unit
+  (** [blit v1 o1 v2 o2 len] copies [len] elements
+      from floatarray [v1], starting at element number [o1], to floatarray [v2],
+      starting at element number [o2]. It works correctly even if
+      [v1] and [v2] are the same floatarray, and the source and
+      destination chunks overlap.
+      @raise Invalid_argument if [o1] and [len] do not
+      designate a valid subarray of [v1], or if [o2] and [len] do not
+      designate a valid subarray of [v2]. *)
+
+  val to_list : t -> float list
+  (** [to_list a] returns the list of all the elements of [a]. *)
+
+  val of_list : float list -> t
+  (** [of_list l] returns a fresh floatarray containing the elements
+      of [l].
+      @raise Invalid_argument if the length of [l] is greater than
+      [Sys.max_floatarray_length].*)
+
+  (** {2 Iterators} *)
+
+  val iter : (float -> unit) -> t -> unit
+  (** [iter f a] applies function [f] in turn to all
+      the elements of [a].  It is equivalent to
+      [f a.(0); f a.(1); ...; f a.(length a - 1); ()]. *)
+
+  val iteri : (int -> float -> unit) -> t -> unit
+  (** Same as {!iter}, but the
+      function is applied with the index of the element as first argument,
+      and the element itself as second argument. *)
+
+  val map : (float -> float) -> t -> t
+  (** [map f a] applies function [f] to all the elements of [a],
+      and builds a floatarray with the results returned by [f]. *)
+
+  val mapi : (int -> float -> float) -> t -> t
+  (** Same as {!map}, but the
+      function is applied to the index of the element as first argument,
+      and the element itself as second argument. *)
+
+  val fold_left : ('a -> float -> 'a) -> 'a -> t -> 'a
+  (** [fold_left f x a] computes
+      [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)],
+      where [n] is the length of the floatarray [a]. *)
+
+  val fold_right : (float -> 'a -> 'a) -> t -> 'a -> 'a
+  (** [fold_right f a x] computes
+      [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))],
+      where [n] is the length of the floatarray [a]. *)
+
+  (** {2 Iterators on two arrays} *)
+
+  val iter2 : (float -> float -> unit) -> t -> t -> unit
+  (** [Array.iter2 f a b] applies function [f] to all the elements of [a]
+      and [b].
+      @raise Invalid_argument if the floatarrays are not the same size. *)
+
+  val map2 : (float -> float -> float) -> t -> t -> t
+  (** [map2 f a b] applies function [f] to all the elements of [a]
+      and [b], and builds a floatarray with the results returned by [f]:
+      [[| f a.(0) b.(0); ...; f a.(length a - 1) b.(length b - 1)|]].
+      @raise Invalid_argument if the floatarrays are not the same size. *)
+
+  (** {2 Array scanning} *)
+
+  val for_all : (float -> bool) -> t -> bool
+  (** [for_all p [|a1; ...; an|]] checks if all elements of the floatarray
+      satisfy the predicate [p]. That is, it returns
+      [(p a1) && (p a2) && ... && (p an)]. *)
+
+  val exists : (float -> bool) -> t -> bool
+  (** [exists p [|a1; ...; an|]] checks if at least one element of
+      the floatarray satisfies the predicate [p]. That is, it returns
+      [(p a1) || (p a2) || ... || (p an)]. *)
+
+  val mem : float -> t -> bool
+  (** [mem a l] is true if and only if there is an element of [l] that is
+      structurally equal to [a], i.e. there is an [x] in [l] such
+      that [compare a x = 0]. *)
+
+  val mem_ieee : float -> t -> bool
+  (** Same as {!mem}, but uses IEEE equality instead of structural equality. *)
+
+  (** {2 Sorting} *)
+
+  val sort : (float -> float -> int) -> t -> unit
+  (** Sort a floatarray in increasing order according to a comparison
+      function.  The comparison function must return 0 if its arguments
+      compare as equal, a positive integer if the first is greater,
+      and a negative integer if the first is smaller (see below for a
+      complete specification).  For example, {!Stdlib.compare} is
+      a suitable comparison function.  After calling [sort], the
+      array is sorted in place in increasing order.
+      [sort] is guaranteed to run in constant heap space
+      and (at most) logarithmic stack space.
+
+      The current implementation uses Heap Sort.  It runs in constant
+      stack space.
+
+      Specification of the comparison function:
+      Let [a] be the floatarray and [cmp] the comparison function. The following
+      must be true for all [x], [y], [z] in [a] :
+-      [cmp x y] > 0 if and only if [cmp y x] < 0
+-      if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0
+
+      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
+  *)
+
+  val stable_sort : (float -> float -> int) -> t -> unit
+  (** Same as {!sort}, but the sorting algorithm is stable (i.e.
+       elements that compare equal are kept in their original order) and
+       not guaranteed to run in constant heap space.
+
+       The current implementation uses Merge Sort. It uses a temporary
+       floatarray of length [n/2], where [n] is the length of the floatarray.
+       It is usually faster than the current implementation of {!sort}. *)
+
+  val fast_sort : (float -> float -> int) -> t -> unit
+  (** Same as {!sort} or {!stable_sort}, whichever is faster
+      on typical input. *)
+
+  (** {2 Iterators} *)
+
+  val to_seq : t -> float Seq.t
+  (** Iterate on the floatarray, in increasing order. Modifications of the
+      floatarray during iteration will be reflected in the iterator. *)
+
+  val to_seqi : t -> (int * float) Seq.t
+  (** Iterate on the floatarray, in increasing order, yielding indices along
+      elements. Modifications of the floatarray during iteration will be
+      reflected in the iterator. *)
+
+  val of_seq : float Seq.t -> t
+  (** Create an array from the generator. *)
+
+
+  val map_to_array : (float -> 'a) -> t -> 'a array
+  (** [map_to_array f a] applies function [f] to all the elements of [a],
+      and builds an array with the results returned by [f]:
+      [[| f a.(0); f a.(1); ...; f a.(length a - 1) |]]. *)
+
+  val map_from_array : ('a -> float) -> 'a array -> t
+  (** [map_from_array f a] applies function [f] to all the elements of [a],
+      and builds a floatarray with the results returned by [f]. *)
+
+  (** {2 Undocumented functions} *)
+
+  (* These functions are for system use only. Do not call directly. *)
+  external unsafe_get : t -> int -> float = "%floatarray_unsafe_get"
+  external unsafe_set : t -> int -> float -> unit = "%floatarray_unsafe_set"
+end
+
+module ArrayLabels : sig
+
+  type t = floatarray
+  val length : t -> int
+  val get : t -> int -> float
+  val set : t -> int -> float -> unit
+  val make : int -> float -> t
+  val create : int -> t
+  val init : int -> f:(int -> float) -> t
+  val append : t -> t -> t
+  val concat : t list -> t
+  val sub : t -> pos:int -> len:int -> t
+  val copy : t -> t
+  val fill : t -> pos:int -> len:int -> float -> unit
+  val blit : src:t -> src_pos:int -> dst:t -> dst_pos:int -> len:int -> unit
+  val to_list : t -> float list
+  val of_list : float list -> t
+  val iter : f:(float -> unit) -> t -> unit
+  val iteri : f:(int -> float -> unit) -> t -> unit
+  val map : f:(float -> float) -> t -> t
+  val mapi : f:(int -> float -> float) -> t -> t
+  val fold_left : f:('a -> float -> 'a) -> init:'a -> t -> 'a
+  val fold_right : f:(float -> 'a -> 'a) -> t -> init:'a -> 'a
+  val iter2 : f:(float -> float -> unit) -> t -> t -> unit
+  val map2 : f:(float -> float -> float) -> t -> t -> t
+  val for_all : f:(float -> bool) -> t -> bool
+  val exists : f:(float -> bool) -> t -> bool
+  val mem : float -> set:t -> bool
+  val mem_ieee : float -> set:t -> bool
+  val sort : cmp:(float -> float -> int) -> t -> unit
+  val stable_sort : cmp:(float -> float -> int) -> t -> unit
+  val fast_sort : cmp:(float -> float -> int) -> t -> unit
+  val to_seq : t -> float Seq.t
+  val to_seqi : t -> (int * float) Seq.t
+  val of_seq : float Seq.t -> t
+  val map_to_array : f:(float -> 'a) -> t -> 'a array
+  val map_from_array : f:('a -> float) -> 'a array -> t
+
+  (* These functions are for system use only. Do not call directly. *)
+  external unsafe_get : t -> int -> float = "%floatarray_unsafe_get"
+  external unsafe_set : t -> int -> float -> unit = "%floatarray_unsafe_set"
+end
diff --git a/stdlib/format.ml b/stdlib/format.ml
new file mode 100644
index 00000000..2ed7bc6d
--- /dev/null
+++ b/stdlib/format.ml
@@ -0,0 +1,1463 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Pierre Weis, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* A pretty-printing facility and definition of formatters for 'parallel'
+   (i.e. unrelated or independent) pretty-printing on multiple out channels. *)
+
+(*
+   The pretty-printing engine internal data structures.
+*)
+
+let id x = x
+
+(* A devoted type for sizes to avoid confusion
+   between sizes and mere integers. *)
+module Size : sig
+  type t
+
+  val to_int : t -> int
+  val of_int : int -> t
+  val zero : t
+  val unknown : t
+  val is_known : t -> bool
+end  = struct
+  type t = int
+
+  let to_int = id
+  let of_int = id
+  let zero = 0
+  let unknown = -1
+  let is_known n = n >= 0
+end
+
+
+
+(* The pretty-printing boxes definition:
+   a pretty-printing box is either
+   - hbox: horizontal box (no line splitting)
+   - vbox: vertical box (every break hint splits the line)
+   - hvbox: horizontal/vertical box
+     (the box behaves as an horizontal box if it fits on
+      the current line, otherwise the box behaves as a vertical box)
+   - hovbox: horizontal or vertical compacting box
+     (the box is compacting material, printing as much material as possible
+      on every lines)
+   - box: horizontal or vertical compacting box with enhanced box structure
+     (the box behaves as an horizontal or vertical box but break hints split
+      the line if splitting would move to the left)
+*)
+type box_type = CamlinternalFormatBasics.block_type =
+  | Pp_hbox | Pp_vbox | Pp_hvbox | Pp_hovbox | Pp_box | Pp_fits
+
+
+(* The pretty-printing tokens definition:
+   are either text to print or pretty printing
+   elements that drive indentation and line splitting. *)
+type pp_token =
+  | Pp_text of string          (* normal text *)
+  | Pp_break of {              (* complete break *)
+      fits: string * int * string;   (* line is not split *)
+      breaks: string * int * string; (* line is split *)
+    }
+  | Pp_tbreak of int * int     (* go to next tabulation *)
+  | Pp_stab                    (* set a tabulation *)
+  | Pp_begin of int * box_type (* beginning of a box *)
+  | Pp_end                     (* end of a box *)
+  | Pp_tbegin of tbox          (* beginning of a tabulation box *)
+  | Pp_tend                    (* end of a tabulation box *)
+  | Pp_newline                 (* to force a newline inside a box *)
+  | Pp_if_newline              (* to do something only if this very
+                                  line has been broken *)
+  | Pp_open_tag of stag         (* opening a tag name *)
+  | Pp_close_tag               (* closing the most recently open tag *)
+
+and stag = ..
+
+and tbox = Pp_tbox of int list ref  (* Tabulation box *)
+
+type tag = string
+type stag += String_tag of tag
+
+
+(* The pretty-printer queue:
+   pretty-printing material is not written in the output as soon as emitted;
+   instead, the material is simply recorded in the pretty-printer queue,
+   until the enclosing box has a known computed size and proper splitting
+   decisions can be made.
+
+   The pretty-printer queue contains formatting elements to be printed.
+   Each formatting element is a tuple (size, token, length), where
+   - length is the declared length of the token,
+   - size is effective size of the token when it is printed
+     (size is set when the size of the box is known, so that size of break
+      hints are definitive). *)
+type pp_queue_elem = {
+  mutable size : Size.t;
+  token : pp_token;
+  length : int;
+}
+
+
+(* The pretty-printer queue definition. *)
+type pp_queue = pp_queue_elem Queue.t
+
+(* The pretty-printer scanning stack. *)
+
+(* The pretty-printer scanning stack: scanning element definition. *)
+type pp_scan_elem = {
+  left_total : int; (* Value of pp_left_total when the element was enqueued. *)
+  queue_elem : pp_queue_elem
+}
+
+(* The pretty-printer formatting stack:
+   the formatting stack contains the description of all the currently active
+   boxes; the pretty-printer formatting stack is used to split the lines
+   while printing tokens. *)
+
+(* The pretty-printer formatting stack: formatting stack element definition.
+   Each stack element describes a pretty-printing box. *)
+type pp_format_elem = { box_type : box_type; width : int }
+
+(* The formatter definition.
+   Each formatter value is a pretty-printer instance with all its
+   machinery. *)
+type formatter = {
+  (* The pretty-printer scanning stack. *)
+  pp_scan_stack : pp_scan_elem Stack.t;
+  (* The pretty-printer formatting stack. *)
+  pp_format_stack : pp_format_elem Stack.t;
+  pp_tbox_stack : tbox Stack.t;
+  (* The pretty-printer semantics tag stack. *)
+  pp_tag_stack : stag Stack.t;
+  pp_mark_stack : stag Stack.t;
+  (* Value of right margin. *)
+  mutable pp_margin : int;
+  (* Minimal space left before margin, when opening a box. *)
+  mutable pp_min_space_left : int;
+  (* Maximum value of indentation:
+     no box can be opened further. *)
+  mutable pp_max_indent : int;
+  (* Space remaining on the current line. *)
+  mutable pp_space_left : int;
+  (* Current value of indentation. *)
+  mutable pp_current_indent : int;
+  (* True when the line has been broken by the pretty-printer. *)
+  mutable pp_is_new_line : bool;
+  (* Total width of tokens already printed. *)
+  mutable pp_left_total : int;
+  (* Total width of tokens ever put in queue. *)
+  mutable pp_right_total : int;
+  (* Current number of open boxes. *)
+  mutable pp_curr_depth : int;
+  (* Maximum number of boxes which can be simultaneously open. *)
+  mutable pp_max_boxes : int;
+  (* Ellipsis string. *)
+  mutable pp_ellipsis : string;
+  (* Output function. *)
+  mutable pp_out_string : string -> int -> int -> unit;
+  (* Flushing function. *)
+  mutable pp_out_flush : unit -> unit;
+  (* Output of new lines. *)
+  mutable pp_out_newline : unit -> unit;
+  (* Output of break hints spaces. *)
+  mutable pp_out_spaces : int -> unit;
+  (* Output of indentation of new lines. *)
+  mutable pp_out_indent : int -> unit;
+  (* Are tags printed ? *)
+  mutable pp_print_tags : bool;
+  (* Are tags marked ? *)
+  mutable pp_mark_tags : bool;
+  (* Find opening and closing markers of tags. *)
+  mutable pp_mark_open_tag : stag -> string;
+  mutable pp_mark_close_tag : stag -> string;
+  mutable pp_print_open_tag : stag -> unit;
+  mutable pp_print_close_tag : stag -> unit;
+  (* The pretty-printer queue. *)
+  pp_queue : pp_queue;
+}
+
+
+(* The formatter specific tag handling functions. *)
+type formatter_stag_functions = {
+  mark_open_stag : stag -> string;
+  mark_close_stag : stag -> string;
+  print_open_stag : stag -> unit;
+  print_close_stag : stag -> unit;
+}
+
+
+(* The formatter functions to output material. *)
+type formatter_out_functions = {
+  out_string : string -> int -> int -> unit;
+  out_flush : unit -> unit;
+  out_newline : unit -> unit;
+  out_spaces : int -> unit;
+  out_indent : int -> unit;
+}
+
+
+(*
+
+  Auxiliaries and basic functions.
+
+*)
+
+(* Enter a token in the pretty-printer queue. *)
+let pp_enqueue state token =
+  state.pp_right_total <- state.pp_right_total + token.length;
+  Queue.add token state.pp_queue
+
+
+let pp_clear_queue state =
+  state.pp_left_total <- 1; state.pp_right_total <- 1;
+  Queue.clear state.pp_queue
+
+
+(* Pp_infinity: large value for default tokens size.
+
+   Pp_infinity is documented as being greater than 1e10; to avoid
+   confusion about the word 'greater', we choose pp_infinity greater
+   than 1e10 + 1; for correct handling of tests in the algorithm,
+   pp_infinity must be even one more than 1e10 + 1; let's stand on the
+   safe side by choosing 1.e10+10.
+
+   Pp_infinity could probably be 1073741823 that is 2^30 - 1, that is
+   the minimal upper bound for integers; now that max_int is defined,
+   this limit could also be defined as max_int - 1.
+
+   However, before setting pp_infinity to something around max_int, we
+   must carefully double-check all the integer arithmetic operations
+   that involve pp_infinity, since any overflow would wreck havoc the
+   pretty-printing algorithm's invariants. Given that this arithmetic
+   correctness check is difficult and error prone and given that 1e10
+   + 1 is in practice large enough, there is no need to attempt to set
+   pp_infinity to the theoretically maximum limit. It is not worth the
+   burden ! *)
+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_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
+
+(* Format a textual token *)
+let format_pp_text state size text =
+  state.pp_space_left <- state.pp_space_left - size;
+  pp_output_string state text;
+  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
+
+(* To format a break, indenting a new line. *)
+let break_new_line state (before, offset, after) width =
+  format_string state before;
+  pp_output_newline state;
+  state.pp_is_new_line <- true;
+  let indent = state.pp_margin - width + offset in
+  (* Don't indent more than pp_max_indent. *)
+  let real_indent = min state.pp_max_indent indent in
+  state.pp_current_indent <- real_indent;
+  state.pp_space_left <- state.pp_margin - state.pp_current_indent;
+  pp_output_indent state state.pp_current_indent;
+  format_string state after
+
+
+(* To force a line break inside a box: no offset is added. *)
+let break_line state width = break_new_line state ("", 0, "") width
+
+(* To format a break that fits on the current line. *)
+let break_same_line state (before, width, after) =
+  format_string state before;
+  state.pp_space_left <- state.pp_space_left - width;
+  pp_output_spaces state width;
+  format_string state after
+
+
+(* To indent no more than pp_max_indent, if one tries to open a box
+   beyond pp_max_indent, then the box is rejected on the left
+   by simulating a break. *)
+let pp_force_break_line state =
+  match Stack.top_opt state.pp_format_stack with
+  | None -> pp_output_newline state
+  | Some { box_type; width } ->
+    if width > state.pp_space_left then
+      match box_type with
+      | Pp_fits | Pp_hbox -> ()
+      | Pp_vbox | Pp_hvbox | Pp_hovbox | Pp_box -> break_line state width
+
+
+(* To skip a token, if the previous line has been broken. *)
+let pp_skip_token state =
+  match Queue.take_opt state.pp_queue with
+  | None -> () (* print_if_newline must have been the last printing command *)
+  | Some { size; length; _ } ->
+    state.pp_left_total <- state.pp_left_total - length;
+    state.pp_space_left <- state.pp_space_left + Size.to_int size
+
+
+(*
+
+  The main pretty printing functions.
+
+*)
+
+(* Formatting a token with a given size. *)
+let format_pp_token state size = function
+
+  | Pp_text s ->
+    format_pp_text state size s
+
+  | Pp_begin (off, ty) ->
+    let insertion_point = state.pp_margin - state.pp_space_left in
+    if insertion_point > state.pp_max_indent then
+      (* can not open a box right there. *)
+      begin pp_force_break_line state end;
+    let width = state.pp_space_left - off in
+    let box_type =
+      match ty with
+      | Pp_vbox -> Pp_vbox
+      | Pp_hbox | Pp_hvbox | Pp_hovbox | Pp_box | Pp_fits ->
+        if size > state.pp_space_left then ty else Pp_fits in
+    Stack.push { box_type; width } state.pp_format_stack
+
+  | Pp_end ->
+    Stack.pop_opt state.pp_format_stack |> ignore
+
+  | Pp_tbegin (Pp_tbox _ as tbox) ->
+    Stack.push tbox state.pp_tbox_stack
+
+  | Pp_tend ->
+    Stack.pop_opt state.pp_tbox_stack |> ignore
+
+  | Pp_stab ->
+    begin match Stack.top_opt state.pp_tbox_stack with
+    | None -> () (* No open tabulation box. *)
+    | Some (Pp_tbox tabs) ->
+      let rec add_tab n = function
+        | [] -> [n]
+        | x :: l as ls -> if n < x then n :: ls else x :: add_tab n l in
+      tabs := add_tab (state.pp_margin - state.pp_space_left) !tabs
+    end
+
+  | Pp_tbreak (n, off) ->
+    let insertion_point = state.pp_margin - state.pp_space_left in
+    begin match Stack.top_opt state.pp_tbox_stack with
+    | None -> () (* No open tabulation box. *)
+    | Some (Pp_tbox tabs) ->
+      let tab =
+        match !tabs with
+        | [] -> insertion_point
+        | first :: _ ->
+          let rec find = function
+            | head :: tail ->
+              if head >= insertion_point then head else find tail
+            | [] -> first in
+          find !tabs in
+      let offset = tab - insertion_point in
+      if offset >= 0
+      then break_same_line state ("", offset + n, "")
+      else break_new_line state ("", tab + off, "") state.pp_margin
+    end
+
+  | Pp_newline ->
+    begin match Stack.top_opt state.pp_format_stack with
+    | None -> pp_output_newline state (* No open box. *)
+    | Some { width; _} -> break_line state width
+    end
+
+  | Pp_if_newline ->
+    if state.pp_current_indent != state.pp_margin - state.pp_space_left
+    then pp_skip_token state
+
+  | Pp_break { fits; breaks } ->
+    let before, off, _ = breaks in
+    begin match Stack.top_opt state.pp_format_stack with
+    | None -> () (* No open box. *)
+    | Some { box_type; width } ->
+      begin match box_type with
+      | Pp_hovbox ->
+        if size + String.length before > state.pp_space_left
+        then break_new_line state breaks width
+        else break_same_line state fits
+      | Pp_box ->
+        (* Have the line just been broken here ? *)
+        if state.pp_is_new_line then break_same_line state fits else
+        if size + String.length before > state.pp_space_left
+          then break_new_line state breaks width else
+        (* break the line here leads to new indentation ? *)
+        if state.pp_current_indent > state.pp_margin - width + off
+        then break_new_line state breaks width
+        else break_same_line state fits
+      | Pp_hvbox -> break_new_line state breaks width
+      | Pp_fits -> break_same_line state fits
+      | Pp_vbox -> break_new_line state breaks width
+      | Pp_hbox -> break_same_line state fits
+      end
+    end
+
+   | Pp_open_tag tag_name ->
+     let marker = state.pp_mark_open_tag tag_name in
+     pp_output_string state marker;
+     Stack.push tag_name state.pp_mark_stack
+
+   | Pp_close_tag ->
+     begin match Stack.pop_opt state.pp_mark_stack with
+     | None -> () (* No more tag to close. *)
+     | Some tag_name ->
+       let marker = state.pp_mark_close_tag tag_name in
+       pp_output_string state marker
+     end
+
+
+(* Print if token size is known else printing is delayed.
+   Printing is delayed when the text waiting in the queue requires
+   more room to format than exists on the current line. *)
+let rec advance_left state =
+  match Queue.peek_opt state.pp_queue with
+  | None -> () (* No tokens to print *)
+  | Some { size; token; length } ->
+    let pending_count = state.pp_right_total - state.pp_left_total in
+    if Size.is_known size || pending_count >= state.pp_space_left then begin
+      Queue.take state.pp_queue |> ignore; (* Not empty: we peek into it *)
+      let size = if Size.is_known size then Size.to_int size else pp_infinity in
+      format_pp_token state size token;
+      state.pp_left_total <- length + state.pp_left_total;
+      (advance_left [@tailcall]) state
+    end
+
+
+(* To enqueue a token : try to advance. *)
+let enqueue_advance state tok = pp_enqueue state tok; advance_left state
+
+
+(* To enqueue strings. *)
+let enqueue_string_as state size s =
+  enqueue_advance state { size; token = Pp_text s; length = Size.to_int size }
+
+
+let enqueue_string state s =
+  enqueue_string_as state (Size.of_int (String.length s)) s
+
+
+(* Routines for scan stack
+   determine size of boxes. *)
+
+(* The scan_stack is never empty. *)
+let initialize_scan_stack stack =
+  Stack.clear stack;
+  let queue_elem = { size = Size.unknown; token = Pp_text ""; length = 0 } in
+  Stack.push { left_total = -1; queue_elem } stack
+
+(* Setting the size of boxes on scan stack:
+   if ty = true then size of break is set else size of box is set;
+   in each case pp_scan_stack is popped.
+
+   Note:
+   Pattern matching on scan stack is exhaustive, since scan_stack is never
+   empty.
+   Pattern matching on token in scan stack is also exhaustive,
+   since scan_push is used on breaks and opening of boxes. *)
+let set_size state ty =
+  match Stack.top_opt state.pp_scan_stack with
+  | None -> () (* scan_stack is never empty. *)
+  | Some { left_total; queue_elem } ->
+    let size = Size.to_int queue_elem.size in
+    (* test if scan stack contains any data that is not obsolete. *)
+    if left_total < state.pp_left_total then
+      initialize_scan_stack state.pp_scan_stack
+    else
+      match queue_elem.token with
+      | Pp_break _ | Pp_tbreak (_, _) ->
+        if ty then begin
+          queue_elem.size <- Size.of_int (state.pp_right_total + size);
+          Stack.pop_opt state.pp_scan_stack |> ignore
+        end
+      | Pp_begin (_, _) ->
+        if not ty then begin
+          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_newline | Pp_if_newline | Pp_open_tag _ | Pp_close_tag ->
+        () (* scan_push is only used for breaks and boxes. *)
+
+
+(* Push a token on pretty-printer scanning stack.
+   If b is true set_size is called. *)
+let scan_push state b token =
+  pp_enqueue state token;
+  if b then set_size state true;
+  let elem = { left_total = state.pp_right_total; queue_elem = token } in
+  Stack.push elem state.pp_scan_stack
+
+
+(* To open a new box :
+   the user may set the depth bound pp_max_boxes
+   any text nested deeper is printed as the ellipsis string. *)
+let pp_open_box_gen state indent br_ty =
+  state.pp_curr_depth <- state.pp_curr_depth + 1;
+  if state.pp_curr_depth < state.pp_max_boxes then
+    let size = Size.of_int (- state.pp_right_total) in
+    let elem = { size; token = Pp_begin (indent, br_ty); length = 0 } in
+    scan_push state false elem else
+  if state.pp_curr_depth = state.pp_max_boxes
+  then enqueue_string state state.pp_ellipsis
+
+
+(* The box which is always open. *)
+let pp_open_sys_box state = pp_open_box_gen state 0 Pp_hovbox
+
+(* Close a box, setting sizes of its sub boxes. *)
+let pp_close_box state () =
+  if state.pp_curr_depth > 1 then
+  begin
+    if state.pp_curr_depth < state.pp_max_boxes then
+    begin
+      pp_enqueue state { size = Size.zero; token = Pp_end; length = 0 };
+      set_size state true; set_size state false
+    end;
+    state.pp_curr_depth <- state.pp_curr_depth - 1;
+  end
+
+
+(* Open a tag, pushing it on the tag stack. *)
+let pp_open_stag state tag_name =
+  if state.pp_print_tags then
+  begin
+    Stack.push tag_name state.pp_tag_stack;
+    state.pp_print_open_tag tag_name
+  end;
+  if state.pp_mark_tags then
+    let token = Pp_open_tag tag_name in
+    pp_enqueue state { size = Size.zero; token; length = 0 }
+
+
+(* Close a tag, popping it from the tag stack. *)
+let pp_close_stag state () =
+  if state.pp_mark_tags then
+    pp_enqueue state { size = Size.zero; token = Pp_close_tag; length = 0 };
+  if state.pp_print_tags then
+    match Stack.pop_opt state.pp_tag_stack with
+    | None -> () (* No more tag to close. *)
+    | Some tag_name ->
+      state.pp_print_close_tag tag_name
+
+let pp_open_tag state s = pp_open_stag state (String_tag s)
+let pp_close_tag state () = pp_close_stag state ()
+
+let pp_set_print_tags state b = state.pp_print_tags <- b
+let pp_set_mark_tags state b = state.pp_mark_tags <- b
+let pp_get_print_tags state () = state.pp_print_tags
+let pp_get_mark_tags state () = state.pp_mark_tags
+let pp_set_tags state b =
+  pp_set_print_tags state b; pp_set_mark_tags state b
+
+
+(* Handling tag handling functions: get/set functions. *)
+let pp_get_formatter_stag_functions state () = {
+  mark_open_stag = state.pp_mark_open_tag;
+  mark_close_stag = state.pp_mark_close_tag;
+  print_open_stag = state.pp_print_open_tag;
+  print_close_stag = state.pp_print_close_tag;
+}
+
+
+let pp_set_formatter_stag_functions state {
+     mark_open_stag = mot;
+     mark_close_stag = mct;
+     print_open_stag = pot;
+     print_close_stag = pct;
+  } =
+  state.pp_mark_open_tag <- mot;
+  state.pp_mark_close_tag <- mct;
+  state.pp_print_open_tag <- pot;
+  state.pp_print_close_tag <- pct
+
+
+(* Initialize pretty-printer. *)
+let pp_rinit state =
+  pp_clear_queue state;
+  initialize_scan_stack state.pp_scan_stack;
+  Stack.clear state.pp_format_stack;
+  Stack.clear state.pp_tbox_stack;
+  Stack.clear state.pp_tag_stack;
+  Stack.clear state.pp_mark_stack;
+  state.pp_current_indent <- 0;
+  state.pp_curr_depth <- 0;
+  state.pp_space_left <- state.pp_margin;
+  pp_open_sys_box state
+
+let clear_tag_stack state =
+  Stack.iter (fun _ -> pp_close_tag state ()) state.pp_tag_stack
+
+
+(* Flushing pretty-printer queue. *)
+let pp_flush_queue state b =
+  clear_tag_stack state;
+  while state.pp_curr_depth > 1 do
+    pp_close_box state ()
+  done;
+  state.pp_right_total <- pp_infinity;
+  advance_left state;
+  if b then pp_output_newline state;
+  pp_rinit state
+
+(*
+
+  Procedures to format values and use boxes.
+
+*)
+
+(* To format a string. *)
+let pp_print_as_size state size s =
+  if state.pp_curr_depth < state.pp_max_boxes
+  then enqueue_string_as state size s
+
+
+let pp_print_as state isize s =
+  pp_print_as_size state (Size.of_int isize) s
+
+
+let pp_print_string state s =
+  pp_print_as state (String.length s) s
+
+
+(* To format an integer. *)
+let pp_print_int state i = pp_print_string state (Int.to_string i)
+
+(* To format a float. *)
+let pp_print_float state f = pp_print_string state (string_of_float f)
+
+(* To format a boolean. *)
+let pp_print_bool state b = pp_print_string state (string_of_bool b)
+
+(* To format a char. *)
+let pp_print_char state c =
+  pp_print_as state 1 (String.make 1 c)
+
+
+(* Opening boxes. *)
+let pp_open_hbox state () = pp_open_box_gen state 0 Pp_hbox
+and pp_open_vbox state indent = pp_open_box_gen state indent Pp_vbox
+
+and pp_open_hvbox state indent = pp_open_box_gen state indent Pp_hvbox
+and pp_open_hovbox state indent = pp_open_box_gen state indent Pp_hovbox
+and pp_open_box state indent = pp_open_box_gen state indent Pp_box
+
+
+(* Printing queued text.
+
+   [pp_print_flush] prints all pending items in the pretty-printer queue and
+   then flushes the low level output device of the formatter to actually
+   display printing material.
+
+   [pp_print_newline] behaves as [pp_print_flush] after printing an additional
+   new line. *)
+let pp_print_newline state () =
+  pp_flush_queue state true; state.pp_out_flush ()
+and pp_print_flush state () =
+  pp_flush_queue state false; state.pp_out_flush ()
+
+
+(* To get a newline when one does not want to close the current box. *)
+let pp_force_newline state () =
+  if state.pp_curr_depth < state.pp_max_boxes then
+    enqueue_advance state { size = Size.zero; token = Pp_newline; length = 0 }
+
+
+(* To format something, only in case the line has just been broken. *)
+let pp_print_if_newline state () =
+  if state.pp_curr_depth < state.pp_max_boxes then
+    enqueue_advance state
+      { size = Size.zero; token = Pp_if_newline; length = 0 }
+
+
+(* Generalized break hint that allows printing strings before/after
+   same-line offset (width) or new-line offset *)
+let pp_print_custom_break state ~fits ~breaks =
+  let before, width, after = fits in
+  if state.pp_curr_depth < state.pp_max_boxes then
+    let size = Size.of_int (- state.pp_right_total) in
+    let token = Pp_break { fits; breaks } in
+    let length = String.length before + width + String.length after in
+    let elem = { size; token; length } in
+    scan_push state true elem
+
+(* Printing break hints:
+   A break hint indicates where a box may be broken.
+   If line is broken then offset is added to the indentation of the current
+   box else (the value of) width blanks are printed. *)
+let pp_print_break state width offset =
+  pp_print_custom_break state
+    ~fits:("", width, "") ~breaks:("", offset, "")
+
+
+(* Print a space :
+   a space is a break hint that prints a single space if the break does not
+   split the line;
+   a cut is a break hint that prints nothing if the break does not split the
+   line. *)
+let pp_print_space state () = pp_print_break state 1 0
+and pp_print_cut state () = pp_print_break state 0 0
+
+
+(* Tabulation boxes. *)
+let pp_open_tbox state () =
+  state.pp_curr_depth <- state.pp_curr_depth + 1;
+  if state.pp_curr_depth < state.pp_max_boxes then
+    let size = Size.zero in
+    let elem = { size; token = Pp_tbegin (Pp_tbox (ref [])); length = 0 } in
+    enqueue_advance state elem
+
+
+(* Close a tabulation box. *)
+let pp_close_tbox state () =
+  if state.pp_curr_depth > 1 then
+  begin
+   if state.pp_curr_depth < state.pp_max_boxes then
+     let elem = { size = Size.zero; token = Pp_tend; length = 0 } in
+     enqueue_advance state elem;
+     state.pp_curr_depth <- state.pp_curr_depth - 1
+  end
+
+
+(* Print a tabulation break. *)
+let pp_print_tbreak state width offset =
+  if state.pp_curr_depth < state.pp_max_boxes then
+    let size = Size.of_int (- state.pp_right_total) in
+    let elem = { size; token = Pp_tbreak (width, offset); length = width } in
+    scan_push state true elem
+
+
+let pp_print_tab state () = pp_print_tbreak state 0 0
+
+let pp_set_tab state () =
+  if state.pp_curr_depth < state.pp_max_boxes then
+    let elem = { size = Size.zero; token = Pp_stab; length = 0 } in
+    enqueue_advance state elem
+
+
+(*
+
+  Procedures to control the pretty-printers
+
+*)
+
+(* Set_max_boxes. *)
+let pp_set_max_boxes state n = if n > 1 then state.pp_max_boxes <- n
+
+(* To know the current maximum number of boxes allowed. *)
+let pp_get_max_boxes state () = state.pp_max_boxes
+
+let pp_over_max_boxes state () = state.pp_curr_depth = state.pp_max_boxes
+
+(* Ellipsis. *)
+let pp_set_ellipsis_text state s = state.pp_ellipsis <- s
+and pp_get_ellipsis_text state () = state.pp_ellipsis
+
+
+(* To set the margin of pretty-printer. *)
+let pp_limit n =
+  if n < pp_infinity then n else pred pp_infinity
+
+
+(* Internal pretty-printer functions. *)
+let pp_set_min_space_left state n =
+  if n >= 1 then
+    let n = pp_limit n in
+    state.pp_min_space_left <- n;
+    state.pp_max_indent <- state.pp_margin - state.pp_min_space_left;
+    pp_rinit state
+
+
+(* Initially, we have :
+   pp_max_indent = pp_margin - pp_min_space_left, and
+   pp_space_left = pp_margin. *)
+let pp_set_max_indent state n =
+  if n > 1 then
+    pp_set_min_space_left state (state.pp_margin - n)
+
+
+let pp_get_max_indent state () = state.pp_max_indent
+
+let pp_set_margin state n =
+  if n >= 1 then
+    let n = pp_limit n in
+    state.pp_margin <- n;
+    let new_max_indent =
+      (* Try to maintain max_indent to its actual value. *)
+      if state.pp_max_indent <= state.pp_margin
+      then state.pp_max_indent else
+      (* If possible maintain pp_min_space_left to its actual value,
+         if this leads to a too small max_indent, take half of the
+         new margin, if it is greater than 1. *)
+       max (max (state.pp_margin - state.pp_min_space_left)
+                (state.pp_margin / 2)) 1 in
+    (* Rebuild invariants. *)
+    pp_set_max_indent state new_max_indent
+
+
+(** Geometry functions and types *)
+type geometry = { max_indent:int; margin: int}
+
+let validate_geometry {margin; max_indent} =
+  if max_indent < 2 then
+    Error "max_indent < 2"
+  else if margin <= max_indent then
+    Error "margin <= max_indent"
+  else Ok ()
+
+let check_geometry geometry =
+  match validate_geometry geometry with
+  | Ok () -> true
+  | Error _ -> false
+
+let pp_get_margin state () = state.pp_margin
+
+let pp_set_full_geometry state {margin; max_indent} =
+  pp_set_margin state margin;
+  pp_set_max_indent state max_indent;
+  ()
+
+let pp_set_geometry state ~max_indent ~margin =
+  let geometry = { max_indent; margin } in
+  match validate_geometry geometry with
+  | Error msg ->
+    raise (Invalid_argument ("Format.pp_set_geometry: " ^ msg))
+  | Ok () ->
+    pp_set_full_geometry state geometry
+
+let pp_safe_set_geometry state ~max_indent ~margin =
+  let geometry = { max_indent; margin } in
+  match validate_geometry geometry with
+  | Error _msg ->
+     ()
+  | Ok () ->
+    pp_set_full_geometry state geometry
+
+let pp_get_geometry state () =
+  { margin = pp_get_margin state (); max_indent = pp_get_max_indent state () }
+
+let pp_update_geometry state update =
+  let geometry = pp_get_geometry state () in
+  pp_set_full_geometry state (update geometry)
+
+(* Setting a formatter basic output functions. *)
+let pp_set_formatter_out_functions state {
+      out_string = f;
+      out_flush = g;
+      out_newline = h;
+      out_spaces = i;
+      out_indent = j;
+    } =
+  state.pp_out_string <- f;
+  state.pp_out_flush <- g;
+  state.pp_out_newline <- h;
+  state.pp_out_spaces <- i;
+  state.pp_out_indent <- j
+
+let pp_get_formatter_out_functions state () = {
+  out_string = state.pp_out_string;
+  out_flush = state.pp_out_flush;
+  out_newline = state.pp_out_newline;
+  out_spaces = state.pp_out_spaces;
+  out_indent = state.pp_out_indent;
+}
+
+
+(* Setting a formatter basic string output and flush functions. *)
+let pp_set_formatter_output_functions state f g =
+  state.pp_out_string <- f; state.pp_out_flush <- g
+
+let pp_get_formatter_output_functions state () =
+  (state.pp_out_string, state.pp_out_flush)
+
+
+(* The default function to output new lines. *)
+let display_newline state () = state.pp_out_string "\n" 0  1
+
+(* The default function to output spaces. *)
+let blank_line = String.make 80 ' '
+let rec display_blanks state n =
+  if n > 0 then
+  if n <= 80 then state.pp_out_string blank_line 0 n else
+  begin
+    state.pp_out_string blank_line 0 80;
+    display_blanks state (n - 80)
+  end
+
+
+(* The default function to output indentation of new lines. *)
+let display_indent = display_blanks
+
+(* Setting a formatter basic output functions as printing to a given
+   [Pervasive.out_channel] value. *)
+let pp_set_formatter_out_channel state oc =
+  state.pp_out_string <- output_substring oc;
+  state.pp_out_flush <- (fun () -> flush oc);
+  state.pp_out_newline <- display_newline state;
+  state.pp_out_spaces <- display_blanks state;
+  state.pp_out_indent <- display_indent state
+
+(*
+
+  Defining specific formatters
+
+*)
+
+let default_pp_mark_open_tag = function
+  | String_tag s -> "<" ^ s ^ ">"
+  | _ -> ""
+let default_pp_mark_close_tag = function
+  | String_tag s -> "</" ^ s ^ ">"
+  | _ -> ""
+
+let default_pp_print_open_tag = ignore
+let default_pp_print_close_tag = ignore
+
+(* Building a formatter given its basic output functions.
+   Other fields get reasonable default values. *)
+let pp_make_formatter f g h i j =
+  (* The initial state of the formatter contains a dummy box. *)
+  let pp_queue = Queue.create () in
+  let sys_tok =
+    { size = Size.unknown; token = Pp_begin (0, Pp_hovbox); length = 0 } in
+  Queue.add sys_tok pp_queue;
+  let scan_stack = Stack.create () in
+  initialize_scan_stack scan_stack;
+  Stack.push { left_total = 1; queue_elem = sys_tok } scan_stack;
+  let pp_margin = 78
+  and pp_min_space_left = 10 in
+  {
+    pp_scan_stack = scan_stack;
+    pp_format_stack = Stack.create ();
+    pp_tbox_stack = Stack.create ();
+    pp_tag_stack = Stack.create ();
+    pp_mark_stack = Stack.create ();
+    pp_margin = pp_margin;
+    pp_min_space_left = pp_min_space_left;
+    pp_max_indent = pp_margin - pp_min_space_left;
+    pp_space_left = pp_margin;
+    pp_current_indent = 0;
+    pp_is_new_line = true;
+    pp_left_total = 1;
+    pp_right_total = 1;
+    pp_curr_depth = 1;
+    pp_max_boxes = max_int;
+    pp_ellipsis = ".";
+    pp_out_string = f;
+    pp_out_flush = g;
+    pp_out_newline = h;
+    pp_out_spaces = i;
+    pp_out_indent = j;
+    pp_print_tags = false;
+    pp_mark_tags = false;
+    pp_mark_open_tag = default_pp_mark_open_tag;
+    pp_mark_close_tag = default_pp_mark_close_tag;
+    pp_print_open_tag = default_pp_print_open_tag;
+    pp_print_close_tag = default_pp_print_close_tag;
+    pp_queue = pp_queue;
+  }
+
+
+(* Build a formatter out of its out functions. *)
+let formatter_of_out_functions out_funs =
+  pp_make_formatter
+    out_funs.out_string
+    out_funs.out_flush
+    out_funs.out_newline
+    out_funs.out_spaces
+    out_funs.out_indent
+
+
+(* Make a formatter with default functions to output spaces,
+  indentation, and new lines. *)
+let make_formatter output flush =
+  let ppf = pp_make_formatter output flush ignore ignore ignore in
+  ppf.pp_out_newline <- display_newline ppf;
+  ppf.pp_out_spaces <- display_blanks ppf;
+  ppf.pp_out_indent <- display_indent ppf;
+  ppf
+
+
+(* Make a formatter writing to a given [Pervasive.out_channel] value. *)
+let formatter_of_out_channel oc =
+  make_formatter (output_substring oc) (fun () -> flush oc)
+
+
+(* Make a formatter writing to a given [Buffer.t] value. *)
+let formatter_of_buffer b =
+  make_formatter (Buffer.add_substring b) ignore
+
+
+(* Allocating buffer for pretty-printing purposes.
+   Default buffer size is pp_buffer_size or 512.
+*)
+let pp_buffer_size = 512
+let pp_make_buffer () = Buffer.create pp_buffer_size
+
+(* The standard (shared) buffer. *)
+let stdbuf = pp_make_buffer ()
+
+(* Predefined formatters standard formatter to print
+   to [Stdlib.stdout], [Stdlib.stderr], and {!stdbuf}. *)
+let std_formatter = formatter_of_out_channel Stdlib.stdout
+and err_formatter = formatter_of_out_channel Stdlib.stderr
+and str_formatter = formatter_of_buffer stdbuf
+
+
+(* [flush_buffer_formatter buf ppf] flushes formatter [ppf],
+   then returns the contents of buffer [buf] that is reset.
+   Formatter [ppf] is supposed to print to buffer [buf], otherwise this
+   function is not really useful. *)
+let flush_buffer_formatter buf ppf =
+  pp_flush_queue ppf false;
+  let s = Buffer.contents buf in
+  Buffer.reset buf;
+  s
+
+
+(* Flush [str_formatter] and get the contents of [stdbuf]. *)
+let flush_str_formatter () = flush_buffer_formatter stdbuf str_formatter
+
+(*
+  Symbolic pretty-printing
+*)
+
+(*
+  Symbolic pretty-printing is pretty-printing with no low level output.
+
+  When using a symbolic formatter, all regular pretty-printing activities
+  occur but output material is symbolic and stored in a buffer of output
+  items. At the end of pretty-printing, flushing the output buffer allows
+  post-processing of symbolic output before low level output operations.
+*)
+
+type symbolic_output_item =
+  | Output_flush
+  | Output_newline
+  | Output_string of string
+  | Output_spaces of int
+  | Output_indent of int
+
+type symbolic_output_buffer = {
+  mutable symbolic_output_contents : symbolic_output_item list;
+}
+
+let make_symbolic_output_buffer () =
+  { symbolic_output_contents = [] }
+
+let clear_symbolic_output_buffer sob =
+  sob.symbolic_output_contents <- []
+
+let get_symbolic_output_buffer sob =
+  List.rev sob.symbolic_output_contents
+
+let flush_symbolic_output_buffer sob =
+  let items = get_symbolic_output_buffer sob in
+  clear_symbolic_output_buffer sob;
+  items
+
+let add_symbolic_output_item sob item =
+  sob.symbolic_output_contents <- item :: sob.symbolic_output_contents
+
+let formatter_of_symbolic_output_buffer sob =
+  let symbolic_flush sob () =
+    add_symbolic_output_item sob Output_flush
+  and symbolic_newline sob () =
+    add_symbolic_output_item sob Output_newline
+  and symbolic_string sob s i n =
+    add_symbolic_output_item sob (Output_string (String.sub s i n))
+  and symbolic_spaces sob n =
+    add_symbolic_output_item sob (Output_spaces n)
+  and symbolic_indent sob n =
+    add_symbolic_output_item sob (Output_indent n) in
+
+  let f = symbolic_string sob
+  and g = symbolic_flush sob
+  and h = symbolic_newline sob
+  and i = symbolic_spaces sob
+  and j = symbolic_indent sob in
+  pp_make_formatter f g h i j
+
+(*
+
+  Basic functions on the 'standard' formatter
+  (the formatter that prints to [Stdlib.stdout]).
+
+*)
+
+let open_hbox = pp_open_hbox std_formatter
+and open_vbox = pp_open_vbox std_formatter
+and open_hvbox = pp_open_hvbox std_formatter
+and open_hovbox = pp_open_hovbox std_formatter
+and open_box = pp_open_box std_formatter
+and close_box = pp_close_box std_formatter
+and open_tag = pp_open_tag std_formatter
+and close_tag = pp_close_tag std_formatter
+and open_stag = pp_open_stag std_formatter
+and close_stag = pp_close_stag std_formatter
+and print_as = pp_print_as std_formatter
+and print_string = pp_print_string std_formatter
+and print_int = pp_print_int std_formatter
+and print_float = pp_print_float std_formatter
+and print_char = pp_print_char std_formatter
+and print_bool = pp_print_bool std_formatter
+and print_break = pp_print_break std_formatter
+and print_cut = pp_print_cut std_formatter
+and print_space = pp_print_space std_formatter
+and force_newline = pp_force_newline std_formatter
+and print_flush = pp_print_flush std_formatter
+and print_newline = pp_print_newline std_formatter
+and print_if_newline = pp_print_if_newline std_formatter
+
+and open_tbox = pp_open_tbox std_formatter
+and close_tbox = pp_close_tbox std_formatter
+and print_tbreak = pp_print_tbreak std_formatter
+
+and set_tab = pp_set_tab std_formatter
+and print_tab = pp_print_tab std_formatter
+
+and set_margin = pp_set_margin std_formatter
+and get_margin = pp_get_margin std_formatter
+
+and set_max_indent = pp_set_max_indent std_formatter
+and get_max_indent = pp_get_max_indent std_formatter
+
+and set_geometry = pp_set_geometry std_formatter
+and safe_set_geometry = pp_safe_set_geometry std_formatter
+and get_geometry = pp_get_geometry std_formatter
+and update_geometry = pp_update_geometry std_formatter
+
+and set_max_boxes = pp_set_max_boxes std_formatter
+and get_max_boxes = pp_get_max_boxes std_formatter
+and over_max_boxes = pp_over_max_boxes std_formatter
+
+and set_ellipsis_text = pp_set_ellipsis_text std_formatter
+and get_ellipsis_text = pp_get_ellipsis_text std_formatter
+
+and set_formatter_out_channel =
+  pp_set_formatter_out_channel std_formatter
+
+and set_formatter_out_functions =
+  pp_set_formatter_out_functions std_formatter
+and get_formatter_out_functions =
+  pp_get_formatter_out_functions std_formatter
+
+and set_formatter_output_functions =
+  pp_set_formatter_output_functions std_formatter
+and get_formatter_output_functions =
+  pp_get_formatter_output_functions std_formatter
+
+and set_formatter_stag_functions =
+  pp_set_formatter_stag_functions std_formatter
+and get_formatter_stag_functions =
+  pp_get_formatter_stag_functions std_formatter
+and set_print_tags =
+  pp_set_print_tags std_formatter
+and get_print_tags =
+  pp_get_print_tags std_formatter
+and set_mark_tags =
+  pp_set_mark_tags std_formatter
+and get_mark_tags =
+  pp_get_mark_tags std_formatter
+and set_tags =
+  pp_set_tags std_formatter
+
+
+(* Convenience functions *)
+
+(* To format a list *)
+let rec pp_print_list ?(pp_sep = pp_print_cut) pp_v ppf = function
+  | [] -> ()
+  | [v] -> pp_v ppf v
+  | v :: vs ->
+    pp_v ppf v;
+    pp_sep ppf ();
+    pp_print_list ~pp_sep pp_v ppf vs
+
+(* To format free-flowing text *)
+let pp_print_text ppf s =
+  let len = String.length s in
+  let left = ref 0 in
+  let right = ref 0 in
+  let flush () =
+    pp_print_string ppf (String.sub s !left (!right - !left));
+    incr right; left := !right;
+  in
+  while (!right <> len) do
+    match s.[!right] with
+      | '\n' ->
+        flush ();
+        pp_force_newline ppf ()
+      | ' ' ->
+        flush (); pp_print_space ppf ()
+      (* there is no specific support for '\t'
+         as it is unclear what a right semantics would be *)
+      | _ -> incr right
+  done;
+  if !left <> len then flush ()
+
+let pp_print_option ?(none = fun _ () -> ()) pp_v ppf = function
+| None -> none ppf ()
+| Some v -> pp_v ppf v
+
+let pp_print_result ~ok ~error ppf = function
+| Ok v -> ok ppf v
+| Error e -> error ppf e
+
+ (**************************************************************)
+
+let compute_tag output tag_acc =
+  let buf = Buffer.create 16 in
+  let ppf = formatter_of_buffer buf in
+  output ppf tag_acc;
+  pp_print_flush ppf ();
+  let len = Buffer.length buf in
+  if len < 2 then Buffer.contents buf
+  else Buffer.sub buf 1 (len - 2)
+
+ (**************************************************************
+
+  Defining continuations to be passed as arguments of
+  CamlinternalFormat.make_printf.
+
+  **************************************************************)
+
+open CamlinternalFormatBasics
+open CamlinternalFormat
+
+(* Interpret a formatting entity on a formatter. *)
+let output_formatting_lit ppf fmting_lit = match fmting_lit with
+  | Close_box                 -> pp_close_box ppf ()
+  | Close_tag                 -> pp_close_tag ppf ()
+  | Break (_, width, offset)  -> pp_print_break ppf width offset
+  | FFlush                    -> pp_print_flush ppf ()
+  | Force_newline             -> pp_force_newline ppf ()
+  | Flush_newline             -> pp_print_newline ppf ()
+  | Magic_size (_, _)         -> ()
+  | Escaped_at                -> pp_print_char ppf '@'
+  | Escaped_percent           -> pp_print_char ppf '%'
+  | Scan_indic c              -> pp_print_char ppf '@'; pp_print_char ppf c
+
+(* Recursively output an "accumulator" containing a reversed list of
+   printing entities (string, char, flus, ...) in an output_stream. *)
+(* Differ from Printf.output_acc by the interpretation of formatting. *)
+(* Used as a continuation of CamlinternalFormat.make_printf. *)
+let rec output_acc ppf acc = match acc with
+  | Acc_string_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_size ppf (Size.of_int 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_size ppf (Size.of_int size) (String.make 1 c);
+  | Acc_formatting_lit (p, f) ->
+    output_acc ppf p;
+    output_formatting_lit ppf f;
+  | Acc_formatting_gen (p, Acc_open_tag acc') ->
+    output_acc ppf p;
+    pp_open_stag ppf (String_tag (compute_tag output_acc acc'))
+  | Acc_formatting_gen (p, Acc_open_box acc') ->
+    output_acc ppf p;
+    let (indent, bty) = open_box_of_string (compute_tag output_acc acc') 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               -> ()
+
+(* Recursively output an "accumulator" containing a reversed list of
+   printing entities (string, char, flus, ...) in a buffer. *)
+(* Differ from Printf.bufput_acc by the interpretation of formatting. *)
+(* Used as a continuation of CamlinternalFormat.make_printf. *)
+let rec strput_acc ppf acc = match acc with
+  | Acc_string_literal (Acc_formatting_lit (p, Magic_size (_, size)), s)
+  | Acc_data_string (Acc_formatting_lit (p, Magic_size (_, size)), s) ->
+    strput_acc ppf p;
+    pp_print_as_size ppf (Size.of_int size) s;
+  | Acc_char_literal (Acc_formatting_lit (p, Magic_size (_, size)), c)
+  | Acc_data_char (Acc_formatting_lit (p, Magic_size (_, size)), c) ->
+    strput_acc ppf p;
+    pp_print_as_size ppf (Size.of_int size) (String.make 1 c);
+  | Acc_delay (Acc_formatting_lit (p, Magic_size (_, size)), f) ->
+    strput_acc ppf p;
+    pp_print_as_size ppf (Size.of_int size) (f ());
+  | Acc_formatting_lit (p, f) ->
+    strput_acc ppf p;
+    output_formatting_lit ppf f;
+  | Acc_formatting_gen (p, Acc_open_tag acc') ->
+    strput_acc ppf p;
+    pp_open_stag ppf (String_tag (compute_tag strput_acc acc'))
+  | Acc_formatting_gen (p, Acc_open_box acc') ->
+    strput_acc ppf p;
+    let (indent, bty) = open_box_of_string (compute_tag strput_acc acc') in
+    pp_open_box_gen ppf indent bty
+  | Acc_string_literal (p, s)
+  | Acc_data_string (p, s)   -> strput_acc ppf p; pp_print_string ppf s;
+  | Acc_char_literal (p, c)
+  | Acc_data_char (p, c)     -> strput_acc ppf p; pp_print_char ppf c;
+  | Acc_delay (p, f)         -> strput_acc ppf p; pp_print_string ppf (f ());
+  | Acc_flush p              -> strput_acc ppf p; pp_print_flush ppf ();
+  | Acc_invalid_arg (p, msg) -> strput_acc ppf p; invalid_arg msg;
+  | End_of_acc               -> ()
+
+(*
+
+  Defining [fprintf] and various flavors of [fprintf].
+
+*)
+
+let kfprintf k ppf (Format (fmt, _)) =
+  make_printf
+    (fun acc -> output_acc ppf acc; k ppf)
+    End_of_acc fmt
+
+and ikfprintf k ppf (Format (fmt, _)) =
+  make_iprintf k ppf fmt
+
+let ifprintf _ppf (Format (fmt, _)) =
+  make_iprintf ignore () fmt
+
+let fprintf ppf = kfprintf ignore ppf
+let printf fmt = fprintf std_formatter fmt
+let eprintf fmt = fprintf err_formatter fmt
+
+let kdprintf k (Format (fmt, _)) =
+  make_printf
+    (fun acc -> k (fun ppf -> output_acc ppf acc))
+    End_of_acc fmt
+
+let dprintf fmt = kdprintf (fun i -> i) fmt
+
+let ksprintf k (Format (fmt, _)) =
+  let b = pp_make_buffer () in
+  let ppf = formatter_of_buffer b in
+  let k acc =
+    strput_acc ppf acc;
+    k (flush_buffer_formatter b ppf) in
+  make_printf k End_of_acc fmt
+
+
+let sprintf fmt = ksprintf id fmt
+
+let kasprintf k (Format (fmt, _)) =
+  let b = pp_make_buffer () in
+  let ppf = formatter_of_buffer b in
+  let k acc =
+    output_acc ppf acc;
+    k (flush_buffer_formatter b ppf) in
+  make_printf k End_of_acc fmt
+
+
+let asprintf fmt = kasprintf id fmt
+
+(* Flushing standard formatters at end of execution. *)
+
+let flush_standard_formatters () =
+  pp_print_flush std_formatter ();
+  pp_print_flush err_formatter ()
+
+let () = at_exit flush_standard_formatters
+
+(*
+
+  Deprecated stuff.
+
+*)
+
+(* Deprecated : subsumed by pp_set_formatter_out_functions *)
+let pp_set_all_formatter_output_functions state
+    ~out:f ~flush:g ~newline:h ~spaces:i =
+  pp_set_formatter_output_functions state f g;
+  state.pp_out_newline <- h;
+  state.pp_out_spaces <- i
+
+(* Deprecated : subsumed by pp_get_formatter_out_functions *)
+let pp_get_all_formatter_output_functions state () =
+  (state.pp_out_string, state.pp_out_flush,
+   state.pp_out_newline, state.pp_out_spaces)
+
+
+(* Deprecated : subsumed by set_formatter_out_functions *)
+let set_all_formatter_output_functions =
+  pp_set_all_formatter_output_functions std_formatter
+
+
+(* Deprecated : subsumed by get_formatter_out_functions *)
+let get_all_formatter_output_functions =
+  pp_get_all_formatter_output_functions std_formatter
+
+
+(* Deprecated : error prone function, do not use it.
+   This function is neither compositional nor incremental, since it flushes
+   the pretty-printer queue at each call.
+   To get the same functionality, define a formatter of your own writing to
+   the buffer argument, as in
+   let ppf = formatter_of_buffer b
+   then use {!fprintf ppf} as usual. *)
+let bprintf b (Format (fmt, _) : ('a, formatter, unit) format) =
+  let ppf = formatter_of_buffer b in
+  let k acc = output_acc ppf acc; pp_flush_queue ppf false in
+  make_printf k End_of_acc fmt
+
+
+(* Deprecated : alias for ksprintf. *)
+let kprintf = ksprintf
+
+
+
+(* Deprecated tag functions *)
+
+type formatter_tag_functions = {
+  mark_open_tag : tag -> string;
+  mark_close_tag : tag -> string;
+  print_open_tag : tag -> unit;
+  print_close_tag : tag -> unit;
+}
+
+
+let pp_set_formatter_tag_functions state {
+     mark_open_tag = mot;
+     mark_close_tag = mct;
+     print_open_tag = pot;
+     print_close_tag = pct;
+   } =
+  let stringify f e = function String_tag s -> f s | _ -> e in
+  state.pp_mark_open_tag <- stringify mot "";
+  state.pp_mark_close_tag <- stringify mct "";
+  state.pp_print_open_tag <- stringify pot ();
+  state.pp_print_close_tag <- stringify pct ()
+
+let pp_get_formatter_tag_functions fmt () =
+  let funs = pp_get_formatter_stag_functions fmt () in
+  let mark_open_tag s = funs.mark_open_stag (String_tag s) in
+  let mark_close_tag s = funs.mark_close_stag (String_tag s) in
+  let print_open_tag s = funs.print_open_stag (String_tag s) in
+  let print_close_tag s = funs.print_close_stag (String_tag s) in
+  {mark_open_tag; mark_close_tag; print_open_tag; print_close_tag}
+
+let set_formatter_tag_functions =
+  pp_set_formatter_tag_functions std_formatter
+and get_formatter_tag_functions =
+  pp_get_formatter_tag_functions std_formatter
diff --git a/stdlib/format.mli b/stdlib/format.mli
new file mode 100644
index 00000000..00aae365
--- /dev/null
+++ b/stdlib/format.mli
@@ -0,0 +1,1395 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Pierre Weis, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Pretty-printing.
+
+   This module implements a pretty-printing facility to format values
+   within {{!boxes}'pretty-printing boxes'} and {{!tags}'semantic tags'}
+   combined with a set of {{!fpp}printf-like functions}.
+   The pretty-printer splits lines at specified {{!breaks}break hints},
+   and indents lines according to the box structure.
+   Similarly, {{!tags}semantic tags} can be used to decouple text
+   presentation from its contents.
+
+   This pretty-printing facility is implemented as an overlay on top of
+   abstract {{!section:formatter}formatters} which provide basic output
+   functions.
+   Some formatters are predefined, notably:
+   - {!std_formatter} outputs to {{!Stdlib.stdout}stdout}
+   - {!err_formatter} outputs to {{!Stdlib.stderr}stderr}
+
+   Most functions in the {!Format} module come in two variants:
+   a short version that operates on {!std_formatter} and the
+   generic version prefixed by [pp_] that takes a formatter
+   as its first argument.
+
+   More formatters can be created with {!formatter_of_out_channel},
+   {!formatter_of_buffer}, {!formatter_of_symbolic_output_buffer}
+   or using {{!section:formatter}custom formatters}.
+
+*)
+
+(** {1 Introduction}
+   For a gentle introduction to the basics of pretty-printing using
+   [Format], read
+   {{:http://caml.inria.fr/resources/doc/guides/format.en.html}
+    http://caml.inria.fr/resources/doc/guides/format.en.html}.
+
+   You may consider this module as providing an extension to the
+   [printf] facility to provide automatic line splitting. The addition of
+   pretty-printing annotations to your regular [printf] format strings gives
+   you fancy indentation and line breaks.
+   Pretty-printing annotations are described below in the documentation of
+   the function {!Format.fprintf}.
+
+   You may also use the explicit pretty-printing box management and printing
+   functions provided by this module. This style is more basic but more
+   verbose than the concise [fprintf] format strings.
+
+   For instance, the sequence
+   [open_box 0; print_string "x ="; print_space ();
+    print_int 1; close_box (); print_newline ()]
+   that prints [x = 1] within a pretty-printing box, can be
+   abbreviated as [printf "@[%s@ %i@]@." "x =" 1], or even shorter
+   [printf "@[x =@ %i@]@." 1].
+
+   Rule of thumb for casual users of this library:
+ - use simple pretty-printing boxes (as obtained by [open_box 0]);
+ - use simple break hints as obtained by [print_cut ()] that outputs a
+   simple break hint, or by [print_space ()] that outputs a space
+   indicating a break hint;
+ - once a pretty-printing box is open, display its material with basic
+   printing functions (e. g. [print_int] and [print_string]);
+ - when the material for a pretty-printing box has been printed, call
+   [close_box ()] to close the box;
+ - at the end of pretty-printing, flush the pretty-printer to display all
+   the remaining material, e.g. evaluate [print_newline ()].
+
+   The behavior of pretty-printing commands is unspecified
+   if there is no open pretty-printing box. Each box opened by
+   one of the [open_] functions below must be closed using [close_box]
+   for proper formatting. Otherwise, some of the material printed in the
+   boxes may not be output, or may be formatted incorrectly.
+
+   In case of interactive use, each phrase is executed in the initial state
+   of the standard pretty-printer: after each phrase execution, the
+   interactive system closes all open pretty-printing boxes, flushes all
+   pending text, and resets the standard pretty-printer.
+
+   Warning: mixing calls to pretty-printing functions of this module with
+   calls to {!Stdlib} low level output functions is error prone.
+
+   The pretty-printing functions output material that is delayed in the
+   pretty-printer queue and stacks in order to compute proper line
+   splitting. In contrast, basic I/O output functions write directly in
+   their output device. As a consequence, the output of a basic I/O function
+   may appear before the output of a pretty-printing function that has been
+   called before. For instance,
+   [
+    Stdlib.print_string "<";
+    Format.print_string "PRETTY";
+    Stdlib.print_string ">";
+    Format.print_string "TEXT";
+   ]
+   leads to output [<>PRETTYTEXT].
+
+*)
+
+type formatter
+(** Abstract data corresponding to a pretty-printer (also called a
+    formatter) and all its machinery. See also {!section:formatter}. *)
+
+(** {1:boxes Pretty-printing boxes} *)
+
+(** The pretty-printing engine uses the concepts of pretty-printing box and
+  break hint to drive indentation and line splitting behavior of the
+  pretty-printer.
+
+  Each different pretty-printing box kind introduces a specific line splitting
+  policy:
+
+  - within an {e horizontal} box, break hints never split the line (but the
+    line may be split in a box nested deeper),
+  - within a {e vertical} box, break hints always split the line,
+  - within an {e horizontal/vertical} box, if the box fits on the current line
+    then break hints never split the line, otherwise break hint always split
+    the line,
+  - within a {e compacting} box, a break hint never splits the line,
+    unless there is no more room on the current line.
+
+  Note that line splitting policy is box specific: the policy of a box does
+  not rule the policy of inner boxes. For instance, if a vertical box is
+  nested in an horizontal box, all break hints within the vertical box will
+  split the line.
+
+  Moreover, opening a box after the {{!maxindent}maximum indentation limit}
+  splits the line whether or not the box would end up fitting on the line.
+
+*)
+
+val pp_open_box : formatter -> int -> unit
+val open_box : int -> unit
+(** [pp_open_box ppf d] opens a new compacting pretty-printing box with
+    offset [d] in the formatter [ppf].
+
+   Within this box, the pretty-printer prints as much as possible material on
+   every line.
+
+   A break hint splits the line if there is no more room on the line to
+   print the remainder of the box.
+
+   Within this box, the pretty-printer emphasizes the box structure:
+   if a structural box does not fit fully on a simple line, a break
+   hint also splits the line if the splitting ``moves to the left''
+   (i.e. the new line gets an indentation smaller than the one of the current
+   line).
+
+   This box is the general purpose pretty-printing box.
+
+   If the pretty-printer splits the line in the box, offset [d] is added to
+   the current indentation.
+*)
+
+
+val pp_close_box : formatter -> unit -> unit
+val close_box : unit -> unit
+(** Closes the most recently open pretty-printing box. *)
+
+val pp_open_hbox : formatter -> unit -> unit
+val open_hbox : unit -> unit
+(** [pp_open_hbox ppf ()] opens a new 'horizontal' pretty-printing box.
+
+  This box prints material on a single line.
+
+  Break hints in a horizontal box never split the line.
+  (Line splitting may still occur inside boxes nested deeper).
+*)
+
+val pp_open_vbox : formatter -> int -> unit
+val open_vbox : int -> unit
+(** [pp_open_vbox ppf d] opens a new 'vertical' pretty-printing box
+  with offset [d].
+
+  This box prints material on as many lines as break hints in the box.
+
+  Every break hint in a vertical box splits the line.
+
+  If the pretty-printer splits the line in the box, [d] is added to the
+  current indentation.
+*)
+
+val pp_open_hvbox : formatter -> int -> unit
+val open_hvbox : int -> unit
+(** [pp_open_hvbox ppf d] opens a new 'horizontal/vertical' pretty-printing box
+  with offset [d].
+
+  This box behaves as an horizontal box if it fits on a single line,
+  otherwise it behaves as a vertical box.
+
+  If the pretty-printer splits the line in the box, [d] is added to the
+  current indentation.
+*)
+
+val pp_open_hovbox : formatter -> int -> unit
+val open_hovbox : int -> unit
+(** [pp_open_hovbox ppf d] opens a new 'horizontal-or-vertical'
+  pretty-printing box with offset [d].
+
+  This box prints material as much as possible on every line.
+
+  A break hint splits the line if there is no more room on the line to
+  print the remainder of the box.
+
+  If the pretty-printer splits the line in the box, [d] is added to the
+  current indentation.
+*)
+
+(** {1 Formatting functions} *)
+
+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_as : formatter -> int -> string -> unit
+val print_as : int -> string -> unit
+(** [pp_print_as ppf len s] prints [s] in the current pretty-printing box.
+  The pretty-printer formats [s] as if it were of length [len].
+*)
+
+val pp_print_int : formatter -> int -> unit
+val print_int : int -> unit
+(** Print an integer in the current pretty-printing box. *)
+
+val pp_print_float : formatter -> float -> unit
+val print_float : float -> unit
+(** Print a floating point number in the current pretty-printing box. *)
+
+val pp_print_char : formatter -> char -> unit
+val print_char : char -> unit
+(** Print a character in the current pretty-printing box. *)
+
+val pp_print_bool : formatter -> bool -> unit
+val print_bool : bool -> unit
+(** Print a boolean in the current pretty-printing box. *)
+
+(** {1:breaks Break hints} *)
+
+(** A 'break hint' tells the pretty-printer to output some space or split the
+  line whichever way is more appropriate to the current pretty-printing box
+  splitting rules.
+
+  Break hints are used to separate printing items and are mandatory to let
+  the pretty-printer correctly split lines and indent items.
+
+  Simple break hints are:
+  - the 'space': output a space or split the line if appropriate,
+  - the 'cut': split the line if appropriate.
+
+  Note: the notions of space and line splitting are abstract for the
+  pretty-printing engine, since those notions can be completely redefined
+  by the programmer.
+  However, in the pretty-printer default setting, ``output a space'' simply
+  means printing a space character (ASCII code 32) and ``split the line''
+  means printing a newline character (ASCII code 10).
+*)
+
+val pp_print_space : formatter -> unit -> unit
+val print_space : unit -> unit
+(** [pp_print_space ppf ()] emits a 'space' break hint:
+  the pretty-printer may split the line at this point,
+  otherwise it prints one space.
+
+  [pp_print_space ppf ()] is equivalent to [pp_print_break ppf 1 0].
+*)
+
+val pp_print_cut : formatter -> unit -> unit
+val print_cut : unit -> unit
+(** [pp_print_cut ppf ()] emits a 'cut' break hint:
+  the pretty-printer may split the line at this point,
+  otherwise it prints nothing.
+
+  [pp_print_cut ppf ()] is equivalent to [pp_print_break ppf 0 0].
+*)
+
+val pp_print_break : formatter -> int -> int -> unit
+val print_break : int -> int -> unit
+(** [pp_print_break ppf nspaces offset] emits a 'full' break hint:
+  the pretty-printer may split the line at this point,
+  otherwise it prints [nspaces] spaces.
+
+  If the pretty-printer splits the line, [offset] is added to
+  the current indentation.
+*)
+
+val pp_print_custom_break :
+  formatter ->
+  fits:(string * int * string) ->
+  breaks:(string * int * string) ->
+  unit
+(** [pp_print_custom_break ppf ~fits:(s1, n, s2) ~breaks:(s3, m, s4)] emits a
+   custom break hint: the pretty-printer may split the line at this point.
+
+   If it does not split the line, then the [s1] is emitted, then [n] spaces,
+   then [s2].
+
+   If it splits the line, then it emits the [s3] string, then an indent
+   (according to the box rules), then an offset of [m] spaces, then the [s4]
+   string.
+
+   While [n] and [m] are handled by [formatter_out_functions.out_indent], the
+   strings will be handled by [formatter_out_functions.out_string]. This allows
+   for a custom formatter that handles indentation distinctly, for example,
+   outputs [<br/>] tags or [ ] entities.
+
+   The custom break is useful if you want to change which visible
+   (non-whitespace) characters are printed in case of break or no break. For
+   example, when printing a list {[ [a; b; c] ]}, you might want to add a
+   trailing semicolon when it is printed vertically:
+
+   {[
+[
+  a;
+  b;
+  c;
+]
+   ]}
+
+   You can do this as follows:
+   {[
+printf "@[<v 0>[@;<0 2>@[<v 0>a;@,b;@,c@]%t]@]@\n"
+  (pp_print_custom_break ~fits:("", 0, "") ~breaks:(";", 0, ""))
+   ]}
+
+  @since 4.08.0
+*)
+
+val pp_force_newline : formatter -> unit -> unit
+val force_newline : unit -> unit
+(** Force a new line in the current pretty-printing box.
+
+  The pretty-printer must split the line at this point,
+
+  Not the normal way of pretty-printing, since imperative line splitting may
+  interfere with current line counters and box size calculation.
+  Using break hints within an enclosing vertical box is a better
+  alternative.
+*)
+
+val pp_print_if_newline : formatter -> unit -> unit
+val print_if_newline : unit -> unit
+(** Execute the next formatting command if the preceding line
+  has just been split. Otherwise, ignore the next formatting
+  command.
+*)
+
+(** {1 Pretty-printing termination} *)
+
+val pp_print_flush : formatter -> unit -> unit
+val print_flush : unit -> unit
+(** End of pretty-printing: resets the pretty-printer to initial state.
+
+  All open pretty-printing boxes are closed, all pending text is printed.
+  In addition, the pretty-printer low level output device is flushed to
+  ensure that all pending text is really displayed.
+
+  Note: never use [print_flush] in the normal course of a pretty-printing
+  routine, since the pretty-printer uses a complex buffering machinery to
+  properly indent the output; manually flushing those buffers at random
+  would conflict with the pretty-printer strategy and result to poor
+  rendering.
+
+  Only consider using [print_flush] when displaying all pending material is
+  mandatory (for instance in case of interactive use when you want the user
+  to read some text) and when resetting the pretty-printer state will not
+  disturb further pretty-printing.
+
+  Warning: If the output device of the pretty-printer is an output channel,
+  repeated calls to [print_flush] means repeated calls to {!Stdlib.flush}
+  to flush the out channel; these explicit flush calls could foil the
+  buffering strategy of output channels and could dramatically impact
+  efficiency.
+*)
+
+val pp_print_newline : formatter -> unit -> unit
+val print_newline : unit -> unit
+(** End of pretty-printing: resets the pretty-printer to initial state.
+
+  All open pretty-printing boxes are closed, all pending text is printed.
+
+  Equivalent to {!print_flush} followed by a new line.
+  See corresponding words of caution for {!print_flush}.
+
+  Note: this is not the normal way to output a new line;
+  the preferred method is using break hints within a vertical pretty-printing
+  box.
+*)
+
+(** {1 Margin} *)
+
+val pp_set_margin : formatter -> int -> unit
+val set_margin : int -> unit
+(** [pp_set_margin ppf d] sets the right margin to [d] (in characters):
+  the pretty-printer splits lines that overflow the right margin according to
+  the break hints given.
+  Setting the margin to [d] means that the formatting engine aims at
+  printing at most [d-1] characters per line.
+  Nothing happens if [d] is smaller than 2.
+  If [d] is too large, the right margin is set to the maximum
+  admissible value (which is greater than [10 ^ 9]).
+  If [d] is less than the current maximum indentation limit, the
+  maximum indentation limit is decreased while trying to preserve
+  a minimal ratio [max_indent/margin>=50%] and if possible
+  the current difference [margin - max_indent].
+
+  See also {!pp_set_geometry}.
+*)
+
+val pp_get_margin : formatter -> unit -> int
+val get_margin : unit -> int
+(** Returns the position of the right margin. *)
+
+(** {1:maxindent Maximum indentation limit} *)
+
+val pp_set_max_indent : formatter -> int -> unit
+val set_max_indent : int -> unit
+(** [pp_set_max_indent ppf d] sets the maximum indentation limit of lines
+  to [d] (in characters):
+  once this limit is reached, new pretty-printing boxes are rejected to the
+  left, unless the enclosing box fully fits on the current line.
+  As an illustration,
+  {[ set_margin 10; set_max_indent 5; printf "@[123456@[7@]89A@]@." ]}
+  yields
+  {[
+    123456
+    789A
+  ]}
+  because the nested box ["@[7@]"] is opened after the maximum indentation
+  limit ([7>5]) and its parent box does not fit on the current line.
+  Either decreasing the length of the parent box to make it fit on a line:
+  {[ printf "@[123456@[7@]89@]@." ]}
+  or opening an intermediary box before the maximum indentation limit which
+  fits on the current line
+  {[ printf "@[123@[456@[7@]89@]A@]@." ]}
+  avoids the rejection to the left of the inner boxes and print respectively
+  ["123456789"] and ["123456789A"] .
+  Note also that vertical boxes never fit on a line whereas horizontal boxes
+  always fully fit on the current line.
+  Opening a box may split a line whereas the contents may have fit.
+  If this behavior is problematic, it can be curtailed by setting the maximum
+  indentation limit to [margin - 1]. Note that setting the maximum indentation
+  limit to [margin] is invalid.
+
+  Nothing happens if [d] is smaller than 2.
+
+  If [d] is too large, the limit is set to the maximum
+  admissible value (which is greater than [10 ^ 9]).
+
+  If [d] is greater or equal than the current margin, it is ignored,
+  and the current maximum indentation limit is kept.
+
+  See also {!pp_set_geometry}.
+*)
+
+val pp_get_max_indent : formatter -> unit -> int
+val get_max_indent : unit -> int
+(** Return the maximum indentation limit (in characters). *)
+
+(** {1 Geometry }
+
+Geometric functions can be used to manipulate simultaneously the
+coupled variables, margin and maxixum indentation limit.
+
+*)
+
+type geometry = { max_indent:int; margin: int}
+
+val check_geometry: geometry -> bool
+(** Check if the formatter geometry is valid: [1 < max_indent < margin] *)
+
+val pp_set_geometry : formatter -> max_indent:int -> margin:int -> unit
+val set_geometry : max_indent:int -> margin:int -> unit
+val pp_safe_set_geometry : formatter -> max_indent:int -> margin:int -> unit
+val safe_set_geometry : max_indent:int -> margin:int -> unit
+(**
+   [pp_set_geometry ppf ~max_indent ~margin] sets both the margin
+   and maximum indentation limit for [ppf].
+
+   When [1 < max_indent < margin],
+   [pp_set_geometry ppf ~max_indent ~margin]
+   is equivalent to
+   [pp_set_margin ppf margin; pp_set_max_indent ppf max_indent];
+   and avoids the subtly incorrect
+   [pp_set_max_indent ppf max_indent; pp_set_margin ppf margin];
+
+   Outside of this domain, [pp_set_geometry] raises an invalid argument
+   exception whereas [pp_safe_set_geometry] does nothing.
+
+   @since 4.08.0
+*)
+
+(**
+   [pp_update_geometry ppf (fun geo -> { geo with ... })] lets you
+   update a formatter's geometry in a way that is robust to extension
+   of the [geometry] record with new fields.
+
+   Raises an invalid argument exception if the returned geometry
+   does not satisfy {!check_geometry}.
+
+   @since 4.11.0
+*)
+val pp_update_geometry : formatter -> (geometry -> geometry) -> unit
+val update_geometry : (geometry -> geometry) -> unit
+
+val pp_get_geometry: formatter -> unit -> geometry
+val get_geometry: unit -> geometry
+(** Return the current geometry of the formatter
+
+    @since 4.08.0
+*)
+
+
+
+(** {1 Maximum formatting depth} *)
+
+(** The maximum formatting depth is the maximum number of pretty-printing
+  boxes simultaneously open.
+
+  Material inside boxes nested deeper is printed as an ellipsis (more
+  precisely as the text returned by {!get_ellipsis_text} [()]).
+*)
+
+val pp_set_max_boxes : formatter -> int -> unit
+val set_max_boxes : int -> unit
+(** [pp_set_max_boxes ppf max] sets the maximum number of pretty-printing
+    boxes simultaneously open.
+
+  Material inside boxes nested deeper is printed as an ellipsis (more
+  precisely as the text returned by {!get_ellipsis_text} [()]).
+
+  Nothing happens if [max] is smaller than 2.
+*)
+
+val pp_get_max_boxes : formatter -> unit -> int
+val get_max_boxes : unit -> int
+(** Returns the maximum number of pretty-printing boxes allowed before
+  ellipsis.
+*)
+
+val pp_over_max_boxes : formatter -> unit -> bool
+val over_max_boxes : unit -> bool
+(** Tests if the maximum number of pretty-printing boxes allowed have already
+  been opened.
+*)
+
+(** {1 Tabulation boxes} *)
+
+(**
+
+  A {e tabulation box} prints material on lines divided into cells of fixed
+  length. A tabulation box provides a simple way to display vertical columns
+  of left adjusted text.
+
+  This box features command [set_tab] to define cell boundaries, and command
+  [print_tab] to move from cell to cell and split the line when there is no
+  more cells to print on the line.
+
+  Note: printing within tabulation box is line directed, so arbitrary line
+  splitting inside a tabulation box leads to poor rendering. Yet, controlled
+  use of tabulation boxes allows simple printing of columns within
+  module {!Format}.
+*)
+
+val pp_open_tbox : formatter -> unit -> unit
+val open_tbox : unit -> unit
+(** [open_tbox ()] opens a new tabulation box.
+
+  This box prints lines separated into cells of fixed width.
+
+  Inside a tabulation box, special {e tabulation markers} defines points of
+  interest on the line (for instance to delimit cell boundaries).
+  Function {!Format.set_tab} sets a tabulation marker at insertion point.
+
+  A tabulation box features specific {e tabulation breaks} to move to next
+  tabulation marker or split the line. Function {!Format.print_tbreak} prints
+  a tabulation break.
+*)
+
+val pp_close_tbox : formatter -> unit -> unit
+val close_tbox : unit -> unit
+(** Closes the most recently opened tabulation box. *)
+
+val pp_set_tab : formatter -> unit -> unit
+val set_tab : unit -> unit
+(** Sets a tabulation marker at current insertion point. *)
+
+val pp_print_tab : formatter -> unit -> unit
+val print_tab : unit -> unit
+(** [print_tab ()] emits a 'next' tabulation break hint: if not already set on
+  a tabulation marker, the insertion point moves to the first tabulation
+  marker on the right, or the pretty-printer splits the line and insertion
+  point moves to the leftmost tabulation marker.
+
+  It is equivalent to [print_tbreak 0 0]. *)
+
+val pp_print_tbreak : formatter -> int -> int -> unit
+val print_tbreak : int -> int -> unit
+(** [print_tbreak nspaces offset] emits a 'full' tabulation break hint.
+
+  If not already set on a tabulation marker, the insertion point moves to the
+  first tabulation marker on the right and the pretty-printer prints
+  [nspaces] spaces.
+
+  If there is no next tabulation marker on the right, the pretty-printer
+  splits the line at this point, then insertion point moves to the leftmost
+  tabulation marker of the box.
+
+  If the pretty-printer splits the line, [offset] is added to
+  the current indentation.
+*)
+
+(** {1 Ellipsis} *)
+
+val pp_set_ellipsis_text : formatter -> string -> unit
+val set_ellipsis_text : string -> unit
+(** Set the text of the ellipsis printed when too many pretty-printing boxes
+  are open (a single dot, [.], by default).
+*)
+
+val pp_get_ellipsis_text : formatter -> unit -> string
+val get_ellipsis_text : unit -> string
+(** Return the text of the ellipsis. *)
+
+(** {1:tags Semantic tags} *)
+
+type stag = ..
+(** {i Semantic tags} (or simply {e tags}) are user's defined annotations
+  to associate user's specific operations to printed entities.
+
+  Common usage of semantic tags is text decoration to get specific font or
+  text size rendering for a display device, or marking delimitation of
+  entities (e.g. HTML or TeX elements or terminal escape sequences).
+  More sophisticated usage of semantic tags could handle dynamic
+  modification of the pretty-printer behavior to properly print the material
+  within some specific tags.
+  For instance, we can define an RGB tag like so:
+{[
+type stag += RGB of {r:int;g:int;b:int}
+]}
+
+  In order to properly delimit printed entities, a semantic tag must be
+  opened before and closed after the entity. Semantic tags must be properly
+  nested like parentheses using {!pp_open_stag} and {!pp_close_stag}.
+
+  Tag specific operations occur any time a tag is opened or closed, At each
+  occurrence, two kinds of operations are performed {e tag-marking} and
+  {e tag-printing}:
+- The tag-marking operation is the simpler tag specific operation: it simply
+  writes a tag specific string into the output device of the
+  formatter. Tag-marking does not interfere with line-splitting computation.
+- The tag-printing operation is the more involved tag specific operation: it
+  can print arbitrary material to the formatter. Tag-printing is tightly
+  linked to the current pretty-printer operations.
+
+  Roughly speaking, tag-marking is commonly used to get a better rendering of
+  texts in the rendering device, while tag-printing allows fine tuning of
+  printing routines to print the same entity differently according to the
+  semantic tags (i.e. print additional material or even omit parts of the
+  output).
+
+  More precisely: when a semantic tag is opened or closed then both and
+  successive 'tag-printing' and 'tag-marking' operations occur:
+  - Tag-printing a semantic tag means calling the formatter specific function
+  [print_open_stag] (resp. [print_close_stag]) with the name of the tag as
+  argument: that tag-printing function can then print any regular material
+  to the formatter (so that this material is enqueued as usual in the
+  formatter queue for further line splitting computation).
+  - Tag-marking a semantic tag means calling the formatter specific function
+  [mark_open_stag] (resp. [mark_close_stag]) with the name of the tag as
+  argument: that tag-marking function can then return the 'tag-opening
+  marker' (resp. `tag-closing marker') for direct output into the output
+  device of the formatter.
+
+  Being written directly into the output device of the formatter, semantic
+  tag marker strings are not considered as part of the printing material that
+  drives line splitting (in other words, the length of the strings
+  corresponding to tag markers is considered as zero for line splitting).
+
+  Thus, semantic tag handling is in some sense transparent to pretty-printing
+  and does not interfere with usual indentation. Hence, a single
+  pretty-printing routine can output both simple 'verbatim' material or
+  richer decorated output depending on the treatment of tags. By default,
+  tags are not active, hence the output is not decorated with tag
+  information. Once [set_tags] is set to [true], the pretty-printer engine
+  honors tags and decorates the output accordingly.
+
+  Default tag-marking functions behave the HTML way: {{!tag}string tags} are
+  enclosed in "<" and ">" while other tags are ignored;
+  hence, opening marker for tag string ["t"] is ["<t>"] and closing marker
+  is ["</t>"].
+
+  Default tag-printing functions just do nothing.
+
+  Tag-marking and tag-printing functions are user definable and can
+  be set by calling {!set_formatter_stag_functions}.
+
+  Semantic tag operations may be set on or off with {!set_tags}.
+  Tag-marking operations may be set on or off with {!set_mark_tags}.
+  Tag-printing operations may be set on or off with {!set_print_tags}.
+*)
+
+type tag = string
+type stag += String_tag of tag
+(** [String_tag s] is a string tag [s]. String tags can be inserted either
+    by explicitly using the constructor [String_tag] or by using the dedicated
+    format syntax ["@{<s> ... @}"].
+*)
+
+val pp_open_stag : formatter -> stag -> unit
+val open_stag : stag -> unit
+(** [pp_open_stag ppf t] opens the semantic tag named [t].
+
+  The [print_open_stag] tag-printing function of the formatter is called with
+  [t] as argument; then the opening tag marker for [t], as given by
+  [mark_open_stag t], is written into the output device of the formatter.
+*)
+
+val pp_close_stag : formatter -> unit -> unit
+val close_stag : unit -> unit
+(** [pp_close_stag ppf ()] closes the most recently opened semantic tag [t].
+
+  The closing tag marker, as given by [mark_close_stag t], is written into the
+  output device of the formatter; then the [print_close_stag] tag-printing
+  function of the formatter is called with [t] as argument.
+*)
+
+val pp_set_tags : formatter -> bool -> unit
+val set_tags : bool -> unit
+(** [pp_set_tags ppf b] turns on or off the treatment of semantic tags
+  (default is off).
+*)
+
+val pp_set_print_tags : formatter -> bool -> unit
+val set_print_tags : bool -> unit
+(** [pp_set_print_tags ppf b] turns on or off the tag-printing operations. *)
+
+val pp_set_mark_tags : formatter -> bool -> unit
+val set_mark_tags : bool -> unit
+(** [pp_set_mark_tags ppf b] turns on or off the tag-marking operations. *)
+
+val pp_get_print_tags : formatter -> unit -> bool
+val get_print_tags : unit -> bool
+(** Return the current status of tag-printing operations. *)
+
+val pp_get_mark_tags : formatter -> unit -> bool
+val get_mark_tags : unit -> bool
+(** Return the current status of tag-marking operations. *)
+
+(** {1 Redirecting the standard formatter output} *)
+val pp_set_formatter_out_channel :
+  formatter -> Stdlib.out_channel -> unit
+val set_formatter_out_channel : Stdlib.out_channel -> unit
+(** Redirect the standard pretty-printer output to the given channel.
+  (All the output functions of the standard formatter are set to the
+   default output functions printing to the given channel.)
+
+  [set_formatter_out_channel] is equivalent to
+  {!pp_set_formatter_out_channel} [std_formatter].
+*)
+
+val pp_set_formatter_output_functions :
+  formatter -> (string -> int -> int -> unit) -> (unit -> unit) -> unit
+val set_formatter_output_functions :
+  (string -> int -> int -> unit) -> (unit -> unit) -> unit
+(** [pp_set_formatter_output_functions ppf out flush] redirects the
+  standard pretty-printer output functions to the functions [out] and
+  [flush].
+
+  The [out] function performs all the pretty-printer string output.
+  It is called with a string [s], a start position [p], and a number of
+  characters [n]; it is supposed to output characters [p] to [p + n - 1] of
+  [s].
+
+  The [flush] function is called whenever the pretty-printer is flushed
+  (via conversion [%!], or pretty-printing indications [@?] or [@.], or
+  using low level functions [print_flush] or [print_newline]).
+*)
+
+val pp_get_formatter_output_functions :
+  formatter -> unit -> (string -> int -> int -> unit) * (unit -> unit)
+val get_formatter_output_functions :
+  unit -> (string -> int -> int -> unit) * (unit -> unit)
+(** Return the current output functions of the standard pretty-printer. *)
+
+(** {1:meaning Redefining formatter output} *)
+
+(** The [Format] module is versatile enough to let you completely redefine
+  the meaning of pretty-printing output: you may provide your own functions
+  to define how to handle indentation, line splitting, and even printing of
+  all the characters that have to be printed!
+*)
+
+(** {2 Redefining output functions} *)
+
+type formatter_out_functions = {
+  out_string : string -> int -> int -> unit;
+  out_flush : unit -> unit;
+  out_newline : unit -> unit;
+  out_spaces : int -> unit;
+  out_indent : int -> unit;
+}
+(** The set of output functions specific to a formatter:
+- the [out_string] function performs all the pretty-printer string output.
+  It is called with a string [s], a start position [p], and a number of
+  characters [n]; it is supposed to output characters [p] to [p + n - 1] of
+  [s].
+- the [out_flush] function flushes the pretty-printer output device.
+- [out_newline] is called to open a new line when the pretty-printer splits
+  the line.
+- the [out_spaces] function outputs spaces when a break hint leads to spaces
+  instead of a line split. It is called with the number of spaces to output.
+- the [out_indent] function performs new line indentation when the
+  pretty-printer splits the line. It is called with the indentation value of
+  the new line.
+
+  By default:
+- fields [out_string] and [out_flush] are output device specific;
+  (e.g. {!Stdlib.output_string} and {!Stdlib.flush} for a
+   {!Stdlib.out_channel} device, or [Buffer.add_substring] and
+   {!Stdlib.ignore} for a [Buffer.t] output device),
+- field [out_newline] is equivalent to [out_string "\n" 0 1];
+- fields [out_spaces] and [out_indent] are equivalent to
+  [out_string (String.make n ' ') 0 n].
+  @since 4.01.0
+*)
+
+val pp_set_formatter_out_functions :
+  formatter -> formatter_out_functions -> unit
+val set_formatter_out_functions : formatter_out_functions -> unit
+(** [pp_set_formatter_out_functions ppf out_funs]
+  Set all the pretty-printer output functions of [ppf] to those of
+  argument [out_funs],
+
+  This way, you can change the meaning of indentation (which can be
+  something else than just printing space characters) and the meaning of new
+  lines opening (which can be connected to any other action needed by the
+  application at hand).
+
+  Reasonable defaults for functions [out_spaces] and [out_newline] are
+  respectively [out_funs.out_string (String.make n ' ') 0 n] and
+  [out_funs.out_string "\n" 0 1].
+  @since 4.01.0
+*)
+
+val pp_get_formatter_out_functions :
+  formatter -> unit -> formatter_out_functions
+val get_formatter_out_functions : unit -> formatter_out_functions
+(** Return the current output functions of the pretty-printer,
+  including line splitting and indentation functions. Useful to record the
+  current setting and restore it afterwards.
+  @since 4.01.0
+*)
+
+(** {1:tagsmeaning Redefining semantic tag operations} *)
+
+type formatter_stag_functions = {
+  mark_open_stag : stag -> string;
+  mark_close_stag : stag -> string;
+  print_open_stag : stag -> unit;
+  print_close_stag : stag -> unit;
+}
+(** The semantic tag handling functions specific to a formatter:
+  [mark] versions are the 'tag-marking' functions that associate a string
+  marker to a tag in order for the pretty-printing engine to write
+  those markers as 0 length tokens in the output device of the formatter.
+  [print] versions are the 'tag-printing' functions that can perform
+  regular printing when a tag is closed or opened.
+*)
+
+val pp_set_formatter_stag_functions :
+  formatter -> formatter_stag_functions -> unit
+val set_formatter_stag_functions : formatter_stag_functions -> unit
+(** [pp_set_formatter_stag_functions ppf tag_funs] changes the meaning of
+  opening and closing semantic tag operations to use the functions in
+  [tag_funs] when printing on [ppf].
+
+  When opening a semantic tag with name [t], the string [t] is passed to the
+  opening tag-marking function (the [mark_open_stag] field of the
+  record [tag_funs]), that must return the opening tag marker for
+  that name. When the next call to [close_stag ()] happens, the semantic tag
+  name [t] is sent back to the closing tag-marking function (the
+  [mark_close_stag] field of record [tag_funs]), that must return a
+  closing tag marker for that name.
+
+  The [print_] field of the record contains the tag-printing functions that
+  are called at tag opening and tag closing time, to output regular material
+  in the pretty-printer queue.
+*)
+
+val pp_get_formatter_stag_functions :
+  formatter -> unit -> formatter_stag_functions
+val get_formatter_stag_functions : unit -> formatter_stag_functions
+(** Return the current semantic tag operation functions of the standard
+  pretty-printer. *)
+
+(** {1:formatter Defining formatters}
+
+  Defining new formatters permits unrelated output of material in
+  parallel on several output devices.
+  All the parameters of a formatter are local to the formatter:
+  right margin, maximum indentation limit, maximum number of pretty-printing
+  boxes simultaneously open, ellipsis, and so on, are specific to
+  each formatter and may be fixed independently.
+
+  For instance, given a {!Buffer.t} buffer [b], {!formatter_of_buffer} [b]
+  returns a new formatter using buffer [b] as its output device.
+  Similarly, given a {!Stdlib.out_channel} output channel [oc],
+  {!formatter_of_out_channel} [oc] returns a new formatter using
+  channel [oc] as its output device.
+
+  Alternatively, given [out_funs], a complete set of output functions for a
+  formatter, then {!formatter_of_out_functions} [out_funs] computes a new
+  formatter using those functions for output.
+*)
+
+val formatter_of_out_channel : out_channel -> formatter
+(** [formatter_of_out_channel oc] returns a new formatter writing
+  to the corresponding output channel [oc].
+*)
+
+val std_formatter : formatter
+(** The standard formatter to write to standard output.
+
+  It is defined as {!formatter_of_out_channel} {!Stdlib.stdout}.
+*)
+
+val err_formatter : formatter
+(** A formatter to write to standard error.
+
+  It is defined as {!formatter_of_out_channel} {!Stdlib.stderr}.
+*)
+
+val formatter_of_buffer : Buffer.t -> formatter
+(** [formatter_of_buffer b] returns a new formatter writing to
+  buffer [b]. At the end of pretty-printing, the formatter must be flushed
+  using {!pp_print_flush} or {!pp_print_newline}, to print all the
+  pending material into the buffer.
+*)
+
+val stdbuf : Buffer.t
+(** The string buffer in which [str_formatter] writes. *)
+
+val str_formatter : formatter
+(** A formatter to output to the {!stdbuf} string buffer.
+
+  [str_formatter] is defined as {!formatter_of_buffer} {!stdbuf}.
+*)
+
+val flush_str_formatter : unit -> string
+(** Returns the material printed with [str_formatter], flushes
+  the formatter and resets the corresponding buffer.
+*)
+
+val make_formatter :
+  (string -> int -> int -> unit) -> (unit -> unit) -> formatter
+(** [make_formatter out flush] returns a new formatter that outputs with
+  function [out], and flushes with function [flush].
+
+  For instance, {[
+    make_formatter
+      (Stdlib.output oc)
+      (fun () -> Stdlib.flush oc) ]}
+  returns a formatter to the {!Stdlib.out_channel} [oc].
+*)
+
+val formatter_of_out_functions :
+  formatter_out_functions -> formatter
+(** [formatter_of_out_functions out_funs] returns a new formatter that writes
+  with the set of output functions [out_funs].
+
+  See definition of type {!formatter_out_functions} for the meaning of argument
+  [out_funs].
+
+  @since 4.06.0
+*)
+
+(** {2:symbolic Symbolic pretty-printing} *)
+
+(**
+  Symbolic pretty-printing is pretty-printing using a symbolic formatter,
+  i.e. a formatter that outputs symbolic pretty-printing items.
+
+  When using a symbolic formatter, all regular pretty-printing activities
+  occur but output material is symbolic and stored in a buffer of output items.
+  At the end of pretty-printing, flushing the output buffer allows
+  post-processing of symbolic output before performing low level output
+  operations.
+
+  In practice, first define a symbolic output buffer [b] using:
+  - [let sob = make_symbolic_output_buffer ()].
+  Then define a symbolic formatter with:
+  - [let ppf = formatter_of_symbolic_output_buffer sob]
+
+  Use symbolic formatter [ppf] as usual, and retrieve symbolic items at end
+  of pretty-printing by flushing symbolic output buffer [sob] with:
+  - [flush_symbolic_output_buffer sob].
+*)
+
+type symbolic_output_item =
+  | Output_flush (** symbolic flush command *)
+  | Output_newline (** symbolic newline command *)
+  | Output_string of string
+  (** [Output_string s]: symbolic output for string [s]*)
+  | Output_spaces of int
+  (** [Output_spaces n]: symbolic command to output [n] spaces *)
+  | Output_indent of int
+  (** [Output_indent i]: symbolic indentation of size [i] *)
+(** Items produced by symbolic pretty-printers
+    @since 4.06.0
+*)
+
+type symbolic_output_buffer
+(**
+  The output buffer of a symbolic pretty-printer.
+
+  @since 4.06.0
+*)
+
+val make_symbolic_output_buffer : unit -> symbolic_output_buffer
+(** [make_symbolic_output_buffer ()] returns a fresh buffer for
+  symbolic output.
+
+  @since 4.06.0
+*)
+
+val clear_symbolic_output_buffer : symbolic_output_buffer -> unit
+(** [clear_symbolic_output_buffer sob] resets buffer [sob].
+
+  @since 4.06.0
+*)
+
+val get_symbolic_output_buffer :
+  symbolic_output_buffer -> symbolic_output_item list
+(** [get_symbolic_output_buffer sob] returns the contents of buffer [sob].
+
+  @since 4.06.0
+*)
+
+val flush_symbolic_output_buffer :
+  symbolic_output_buffer -> symbolic_output_item list
+(** [flush_symbolic_output_buffer sob] returns the contents of buffer
+  [sob] and resets buffer [sob].
+  [flush_symbolic_output_buffer sob] is equivalent to
+  [let items = get_symbolic_output_buffer sob in
+   clear_symbolic_output_buffer sob; items]
+
+  @since 4.06.0
+*)
+
+val add_symbolic_output_item :
+  symbolic_output_buffer -> symbolic_output_item -> unit
+(** [add_symbolic_output_item sob itm] adds item [itm] to buffer [sob].
+
+  @since 4.06.0
+*)
+
+val formatter_of_symbolic_output_buffer : symbolic_output_buffer -> formatter
+(** [formatter_of_symbolic_output_buffer sob] returns a symbolic formatter
+  that outputs to [symbolic_output_buffer] [sob].
+
+  @since 4.06.0
+*)
+
+(** {1 Convenience formatting functions.} *)
+
+val pp_print_list:
+  ?pp_sep:(formatter -> unit -> unit) ->
+  (formatter -> 'a -> unit) -> (formatter -> 'a list -> unit)
+(** [pp_print_list ?pp_sep pp_v ppf l] prints items of list [l],
+  using [pp_v] to print each item, and calling [pp_sep]
+  between items ([pp_sep] defaults to {!pp_print_cut}.
+  Does nothing on empty lists.
+
+  @since 4.02.0
+*)
+
+val pp_print_text : formatter -> string -> unit
+(** [pp_print_text ppf s] prints [s] with spaces and newlines respectively
+  printed using {!pp_print_space} and {!pp_force_newline}.
+
+  @since 4.02.0
+*)
+
+val pp_print_option :
+  ?none:(formatter -> unit -> unit) ->
+  (formatter -> 'a -> unit) -> (formatter -> 'a option -> unit)
+(** [pp_print_option ?none pp_v ppf o] prints [o] on [ppf]
+    using [pp_v] if [o] is [Some v] and [none] if it is [None]. [none]
+    prints nothing by default.
+
+    @since 4.08 *)
+
+val pp_print_result :
+  ok:(formatter -> 'a -> unit) -> error:(formatter -> 'e -> unit) ->
+  formatter -> ('a, 'e) result -> unit
+(** [pp_print_result ~ok ~error ppf r] prints [r] on [ppf] using
+    [ok] if [r] is [Ok _] and [error] if [r] is [Error _].
+
+    @since 4.08 *)
+
+(** {1:fpp Formatted pretty-printing} *)
+
+(**
+  Module [Format] provides a complete set of [printf] like functions for
+  pretty-printing using format string specifications.
+
+  Specific annotations may be added in the format strings to give
+  pretty-printing commands to the pretty-printing engine.
+
+  Those annotations are introduced in the format strings using the [@]
+  character. For instance, [@ ] means a space break, [@,] means a cut,
+  [@\[] opens a new box, and [@\]] closes the last open box.
+
+*)
+
+val fprintf : formatter -> ('a, formatter, unit) format -> 'a
+
+(** [fprintf ff fmt arg1 ... argN] formats the arguments [arg1] to [argN]
+  according to the format string [fmt], and outputs the resulting string on
+  the formatter [ff].
+
+  The format string [fmt] is a character string which contains three types of
+  objects: plain characters and conversion specifications as specified in
+  the {!Printf} module, and pretty-printing indications specific to the
+  [Format] module.
+
+  The pretty-printing indication characters are introduced by
+  a [@] character, and their meanings are:
+  - [@\[]: open a pretty-printing box. The type and offset of the
+    box may be optionally specified with the following syntax:
+    the [<] character, followed by an optional box type indication,
+    then an optional integer offset, and the closing [>] character.
+    Pretty-printing box type is one of [h], [v], [hv], [b], or [hov].
+    '[h]' stands for an 'horizontal' pretty-printing box,
+    '[v]' stands for a 'vertical' pretty-printing box,
+    '[hv]' stands for an 'horizontal/vertical' pretty-printing box,
+    '[b]' stands for an 'horizontal-or-vertical' pretty-printing box
+    demonstrating indentation,
+    '[hov]' stands a simple 'horizontal-or-vertical' pretty-printing box.
+    For instance, [@\[<hov 2>] opens an 'horizontal-or-vertical'
+    pretty-printing box with indentation 2 as obtained with [open_hovbox 2].
+    For more details about pretty-printing boxes, see the various box opening
+    functions [open_*box].
+  - [@\]]: close the most recently opened pretty-printing box.
+  - [@,]: output a 'cut' break hint, as with [print_cut ()].
+  - [@ ]: output a 'space' break hint, as with [print_space ()].
+  - [@;]: output a 'full' break hint as with [print_break]. The
+    [nspaces] and [offset] parameters of the break hint may be
+    optionally specified with the following syntax:
+    the [<] character, followed by an integer [nspaces] value,
+    then an integer [offset], and a closing [>] character.
+    If no parameters are provided, the good break defaults to a
+    'space' break hint.
+  - [@.]: flush the pretty-printer and split the line, as with
+    [print_newline ()].
+  - [@<n>]: print the following item as if it were of length [n].
+    Hence, [printf "@<0>%s" arg] prints [arg] as a zero length string.
+    If [@<n>] is not followed by a conversion specification,
+    then the following character of the format is printed as if
+    it were of length [n].
+  - [@\{]: open a semantic tag. The name of the tag may be optionally
+    specified with the following syntax:
+    the [<] character, followed by an optional string
+    specification, and the closing [>] character. The string
+    specification is any character string that does not contain the
+    closing character ['>']. If omitted, the tag name defaults to the
+    empty string.
+    For more details about semantic tags, see the functions {!open_stag} and
+    {!close_stag}.
+  - [@\}]: close the most recently opened semantic tag.
+  - [@?]: flush the pretty-printer as with [print_flush ()].
+    This is equivalent to the conversion [%!].
+  - [@\n]: force a newline, as with [force_newline ()], not the normal way
+    of pretty-printing, you should prefer using break hints inside a vertical
+    pretty-printing box.
+
+  Note: To prevent the interpretation of a [@] character as a
+  pretty-printing indication, escape it with a [%] character.
+  Old quotation mode [@@] is deprecated since it is not compatible with
+  formatted input interpretation of character ['@'].
+
+  Example: [printf "@[%s@ %d@]@." "x =" 1] is equivalent to
+  [open_box (); print_string "x ="; print_space ();
+   print_int 1; close_box (); print_newline ()].
+  It prints [x = 1] within a pretty-printing 'horizontal-or-vertical' box.
+
+*)
+
+val printf : ('a, formatter, unit) format -> 'a
+(** Same as [fprintf] above, but output on [std_formatter]. *)
+
+val eprintf : ('a, formatter, unit) format -> 'a
+(** Same as [fprintf] above, but output on [err_formatter]. *)
+
+val sprintf : ('a, unit, string) format -> 'a
+(** Same as [printf] above, but instead of printing on a formatter,
+  returns a string containing the result of formatting the arguments.
+  Note that the pretty-printer queue is flushed at the end of {e each
+  call} to [sprintf].
+
+  In case of multiple and related calls to [sprintf] to output
+  material on a single string, you should consider using [fprintf]
+  with the predefined formatter [str_formatter] and call
+  [flush_str_formatter ()] to get the final result.
+
+  Alternatively, you can use [Format.fprintf] with a formatter writing to a
+  buffer of your own: flushing the formatter and the buffer at the end of
+  pretty-printing returns the desired string.
+*)
+
+val asprintf : ('a, formatter, unit, string) format4 -> 'a
+(** Same as [printf] above, but instead of printing on a formatter,
+  returns a string containing the result of formatting the arguments.
+  The type of [asprintf] is general enough to interact nicely with [%a]
+  conversions.
+
+  @since 4.01.0
+*)
+
+val dprintf :
+  ('a, formatter, unit, formatter -> unit) format4 -> 'a
+(** Same as {!fprintf}, except the formatter is the last argument.
+  [dprintf "..." a b c] is a function of type
+  [formatter -> unit] which can be given to a format specifier [%t].
+
+  This can be used as a replacement for {!asprintf} to delay
+  formatting decisions. Using the string returned by {!asprintf} in a
+  formatting context forces formatting decisions to be taken in
+  isolation, and the final string may be created
+  prematurely. {!dprintf} allows delay of formatting decisions until
+  the final formatting context is known.
+  For example:
+{[
+  let t = Format.dprintf "%i@ %i@ %i" 1 2 3 in
+  ...
+  Format.printf "@[<v>%t@]" t
+]}
+
+  @since 4.08.0
+*)
+
+
+val ifprintf : formatter -> ('a, formatter, unit) format -> 'a
+(** Same as [fprintf] above, but does not print anything.
+  Useful to ignore some material when conditionally printing.
+
+  @since 3.10.0
+*)
+
+(** Formatted Pretty-Printing with continuations. *)
+
+val kfprintf :
+  (formatter -> 'a) -> formatter ->
+  ('b, formatter, unit, 'a) format4 -> 'b
+(** Same as [fprintf] above, but instead of returning immediately,
+  passes the formatter to its first argument at the end of printing. *)
+
+val kdprintf :
+  ((formatter -> unit) -> 'a) ->
+  ('b, formatter, unit, 'a) format4 -> 'b
+(** Same as {!dprintf} above, but instead of returning immediately,
+  passes the suspended printer to its first argument at the end of printing.
+
+  @since 4.08.0
+*)
+
+val ikfprintf :
+  (formatter -> 'a) -> formatter ->
+  ('b, formatter, unit, 'a) format4 -> 'b
+(** Same as [kfprintf] above, but does not print anything.
+  Useful to ignore some material when conditionally printing.
+
+  @since 3.12.0
+*)
+
+val ksprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b
+(** Same as [sprintf] above, but instead of returning the string,
+  passes it to the first argument. *)
+
+val kasprintf : (string -> 'a) -> ('b, formatter, unit, 'a) format4 -> 'b
+(** Same as [asprintf] above, but instead of returning the string,
+  passes it to the first argument.
+
+  @since 4.03
+*)
+
+(** {1 Deprecated} *)
+
+val bprintf : Buffer.t -> ('a, formatter, unit) format -> 'a
+  [@@ocaml.deprecated]
+(** @deprecated This function is error prone. Do not use it.
+  This function is neither compositional nor incremental, since it flushes
+  the pretty-printer queue at each call.
+
+  If you need to print to some buffer [b], you must first define a
+  formatter writing to [b], using [let to_b = formatter_of_buffer b]; then
+  use regular calls to [Format.fprintf] with formatter [to_b].
+*)
+
+val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b
+  [@@ocaml.deprecated "Use Format.ksprintf instead."]
+(** @deprecated An alias for [ksprintf]. *)
+
+val set_all_formatter_output_functions :
+  out:(string -> int -> int -> unit) ->
+  flush:(unit -> unit) ->
+  newline:(unit -> unit) ->
+  spaces:(int -> unit) ->
+  unit
+[@@ocaml.deprecated "Use Format.set_formatter_out_functions instead."]
+(** @deprecated Subsumed by [set_formatter_out_functions]. *)
+
+val get_all_formatter_output_functions :
+  unit ->
+  (string -> int -> int -> unit) *
+  (unit -> unit) *
+  (unit -> unit) *
+  (int -> unit)
+[@@ocaml.deprecated "Use Format.get_formatter_out_functions instead."]
+(** @deprecated Subsumed by [get_formatter_out_functions]. *)
+
+val pp_set_all_formatter_output_functions :
+  formatter -> out:(string -> int -> int -> unit) -> flush:(unit -> unit) ->
+  newline:(unit -> unit) -> spaces:(int -> unit) -> unit
+[@@ocaml.deprecated "Use Format.pp_set_formatter_out_functions instead."]
+(** @deprecated Subsumed by [pp_set_formatter_out_functions]. *)
+
+val pp_get_all_formatter_output_functions :
+  formatter -> unit ->
+  (string -> int -> int -> unit) * (unit -> unit) * (unit -> unit) *
+  (int -> unit)
+[@@ocaml.deprecated "Use Format.pp_get_formatter_out_functions instead."]
+(** @deprecated Subsumed by [pp_get_formatter_out_functions]. *)
+
+(** {2 String tags} *)
+
+val pp_open_tag : formatter -> tag -> unit
+[@@ocaml.deprecated "Use Format.pp_open_stag."]
+(** @deprecated Subsumed by {!pp_open_stag}. *)
+
+val open_tag : tag -> unit
+[@@ocaml.deprecated "Use Format.open_stag."]
+(** @deprecated Subsumed by {!open_stag}. *)
+
+val pp_close_tag : formatter -> unit -> unit
+[@@ocaml.deprecated "Use Format.pp_close_stag."]
+(** @deprecated Subsumed by {!pp_close_stag}. *)
+
+val close_tag : unit -> unit
+[@@ocaml.deprecated "Use Format.close_stag."]
+(** @deprecated Subsumed by {!close_stag}. *)
+
+type formatter_tag_functions = {
+  mark_open_tag : tag -> string;
+  mark_close_tag : tag -> string;
+  print_open_tag : tag -> unit;
+  print_close_tag : tag -> unit;
+}
+[@@ocaml.deprecated "Use formatter_stag_functions."]
+(** @deprecated Subsumed by {!formatter_stag_functions}. *)
+
+val pp_set_formatter_tag_functions :
+  formatter -> formatter_tag_functions -> unit
+[@@ocaml.deprecated
+  "This function will erase non-string tag formatting functions. \
+   Use Format.pp_set_formatter_stag_functions."]
+[@@warning "-3"]
+(** This function will erase non-string tag formatting functions.
+    @deprecated Subsumed by {!pp_set_formatter_stag_functions}. *)
+
+val set_formatter_tag_functions : formatter_tag_functions -> unit
+[@@ocaml.deprecated "Use Format.set_formatter_stag_functions."]
+[@@warning "-3"]
+(** @deprecated Subsumed by {!set_formatter_stag_functions}. *)
+
+val pp_get_formatter_tag_functions :
+  formatter -> unit -> formatter_tag_functions
+[@@ocaml.deprecated "Use Format.pp_get_formatter_stag_functions."]
+[@@warning "-3"]
+(** @deprecated Subsumed by {!pp_get_formatter_stag_functions}. *)
+
+val get_formatter_tag_functions : unit -> formatter_tag_functions
+[@@ocaml.deprecated "Use Format.get_formatter_stag_functions."]
+[@@warning "-3"]
+(** @deprecated Subsumed by {!get_formatter_stag_functions}. *)
diff --git a/stdlib/fun.ml b/stdlib/fun.ml
new file mode 100644
index 00000000..d8bb0165
--- /dev/null
+++ b/stdlib/fun.ml
@@ -0,0 +1,38 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         The OCaml programmers                          *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+external id : 'a -> 'a = "%identity"
+let const c _ = c
+let flip f x y = f y x
+let negate p v = not (p v)
+
+exception Finally_raised of exn
+
+let () = Printexc.register_printer @@ function
+| Finally_raised exn -> Some ("Fun.Finally_raised: " ^ Printexc.to_string exn)
+| _ -> None
+
+let protect ~(finally : unit -> unit) work =
+  let finally_no_exn () =
+    try finally () with e ->
+      let bt = Printexc.get_raw_backtrace () in
+      Printexc.raise_with_backtrace (Finally_raised e) bt
+  in
+  match work () with
+  | result -> finally_no_exn () ; result
+  | exception work_exn ->
+      let work_bt = Printexc.get_raw_backtrace () in
+      finally_no_exn () ;
+      Printexc.raise_with_backtrace work_exn work_bt
diff --git a/stdlib/fun.mli b/stdlib/fun.mli
new file mode 100644
index 00000000..32eff8b2
--- /dev/null
+++ b/stdlib/fun.mli
@@ -0,0 +1,63 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         The OCaml programmers                          *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Function manipulation.
+
+    @since 4.08 *)
+
+(** {1:combinators Combinators} *)
+
+external id : 'a -> 'a = "%identity"
+(** [id] is the identity function. For any argument [x], [id x] is [x]. *)
+
+val const : 'a -> (_ -> 'a)
+(** [const c] is a function that always returns the value [c]. For any
+    argument [x], [(const c) x] is [c]. *)
+
+val flip : ('a -> 'b -> 'c) -> ('b -> 'a -> 'c)
+(** [flip f] reverses the argument order of the binary function
+    [f]. For any arguments [x] and [y], [(flip f) x y] is [f y x]. *)
+
+val negate : ('a -> bool) -> ('a -> bool)
+(** [negate p] is the negation of the predicate function [p]. For any
+    argument [x], [(negate p) x] is [not (p x)]. *)
+
+(** {1:exception Exception handling} *)
+
+val protect : finally:(unit -> unit) -> (unit -> 'a) -> 'a
+(** [protect ~finally work] invokes [work ()] and then [finally ()]
+    before [work ()] returns with its value or an exception. In the
+    latter case the exception is re-raised after [finally ()]. If
+    [finally ()] raises an exception, then the exception
+    {!Finally_raised} is raised instead.
+
+    [protect] can be used to enforce local invariants whether [work ()]
+    returns normally or raises an exception. However, it does not
+    protect against unexpected exceptions raised inside [finally ()]
+    such as {!Stdlib.Out_of_memory}, {!Stdlib.Stack_overflow}, or
+    asynchronous exceptions raised by signal handlers
+    (e.g. {!Sys.Break}).
+
+    Note: It is a {e programming error} if other kinds of exceptions
+    are raised by [finally], as any exception raised in [work ()] will
+    be lost in the event of a {!Finally_raised} exception. Therefore,
+    one should make sure to handle those inside the finally. *)
+
+exception Finally_raised of exn
+(** [Finally_raised exn] is raised by [protect ~finally work] when
+    [finally] raises an exception [exn]. This exception denotes either
+    an unexpected exception or a programming error. As a general rule,
+    one should not catch a [Finally_raised] exception except as part of
+    a catch-all handler. *)
diff --git a/stdlib/gc.ml b/stdlib/gc.ml
new file mode 100644
index 00000000..9a5c004e
--- /dev/null
+++ b/stdlib/gc.ml
@@ -0,0 +1,159 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*            Damien Doligez, projet Para, INRIA Rocquencourt             *)
+(*            Jacques-Henri Jourdan, projet Gallium, INRIA Paris          *)
+(*                                                                        *)
+(*   Copyright 1996-2016 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 stat = {
+  minor_words : float;
+  promoted_words : float;
+  major_words : float;
+  minor_collections : int;
+  major_collections : int;
+  heap_words : int;
+  heap_chunks : int;
+  live_words : int;
+  live_blocks : int;
+  free_words : int;
+  free_blocks : int;
+  largest_free : int;
+  fragments : int;
+  compactions : int;
+  top_heap_words : int;
+  stack_size : int;
+}
+
+type control = {
+  mutable minor_heap_size : int;
+  mutable major_heap_increment : int;
+  mutable space_overhead : int;
+  mutable verbose : int;
+  mutable max_overhead : int;
+  mutable stack_limit : int;
+  mutable allocation_policy : int;
+  window_size : int;
+  custom_major_ratio : int;
+  custom_minor_ratio : int;
+  custom_minor_max_size : int;
+}
+
+external stat : unit -> stat = "caml_gc_stat"
+external quick_stat : unit -> stat = "caml_gc_quick_stat"
+external counters : unit -> (float * float * float) = "caml_gc_counters"
+external minor_words : unit -> (float [@unboxed])
+  = "caml_gc_minor_words" "caml_gc_minor_words_unboxed"
+external get : unit -> control = "caml_gc_get"
+external set : control -> unit = "caml_gc_set"
+external minor : unit -> unit = "caml_gc_minor"
+external major_slice : int -> int = "caml_gc_major_slice"
+external major : unit -> unit = "caml_gc_major"
+external full_major : unit -> unit = "caml_gc_full_major"
+external compact : unit -> unit = "caml_gc_compaction"
+external get_minor_free : unit -> int = "caml_get_minor_free"
+external get_bucket : int -> int = "caml_get_major_bucket" [@@noalloc]
+external get_credit : unit -> int = "caml_get_major_credit" [@@noalloc]
+external huge_fallback_count : unit -> int = "caml_gc_huge_fallback_count"
+external eventlog_pause : unit -> unit = "caml_eventlog_pause"
+external eventlog_resume : unit -> unit = "caml_eventlog_resume"
+
+open Printf
+
+let print_stat c =
+  let st = stat () in
+  fprintf c "minor_collections: %d\n" st.minor_collections;
+  fprintf c "major_collections: %d\n" st.major_collections;
+  fprintf c "compactions:       %d\n" st.compactions;
+  fprintf c "\n";
+  let l1 = String.length (sprintf "%.0f" st.minor_words) in
+  fprintf c "minor_words:    %*.0f\n" l1 st.minor_words;
+  fprintf c "promoted_words: %*.0f\n" l1 st.promoted_words;
+  fprintf c "major_words:    %*.0f\n" l1 st.major_words;
+  fprintf c "\n";
+  let l2 = String.length (sprintf "%d" st.top_heap_words) in
+  fprintf c "top_heap_words: %*d\n" l2 st.top_heap_words;
+  fprintf c "heap_words:     %*d\n" l2 st.heap_words;
+  fprintf c "live_words:     %*d\n" l2 st.live_words;
+  fprintf c "free_words:     %*d\n" l2 st.free_words;
+  fprintf c "largest_free:   %*d\n" l2 st.largest_free;
+  fprintf c "fragments:      %*d\n" l2 st.fragments;
+  fprintf c "\n";
+  fprintf c "live_blocks: %d\n" st.live_blocks;
+  fprintf c "free_blocks: %d\n" st.free_blocks;
+  fprintf c "heap_chunks: %d\n" st.heap_chunks
+
+
+let allocated_bytes () =
+  let (mi, pro, ma) = counters () in
+  (mi +. ma -. pro) *. float_of_int (Sys.word_size / 8)
+
+
+external finalise : ('a -> unit) -> 'a -> unit = "caml_final_register"
+external finalise_last : (unit -> unit) -> 'a -> unit =
+  "caml_final_register_called_without_value"
+external finalise_release : unit -> unit = "caml_final_release"
+
+
+type alarm = bool ref
+type alarm_rec = {active : alarm; f : unit -> unit}
+
+let rec call_alarm arec =
+  if !(arec.active) then begin
+    finalise call_alarm arec;
+    arec.f ();
+  end
+
+
+let create_alarm f =
+  let arec = { active = ref true; f = f } in
+  finalise call_alarm arec;
+  arec.active
+
+
+let delete_alarm a = a := false
+
+module Memprof =
+  struct
+    type allocation =
+      { n_samples : int;
+        size : int;
+        unmarshalled : bool;
+        callstack : Printexc.raw_backtrace }
+
+    type ('minor, 'major) tracker = {
+      alloc_minor: allocation -> 'minor option;
+      alloc_major: allocation -> 'major option;
+      promote: 'minor -> 'major option;
+      dealloc_minor: 'minor -> unit;
+      dealloc_major: 'major -> unit;
+    }
+
+    let null_tracker = {
+      alloc_minor = (fun _ -> None);
+      alloc_major = (fun _ -> None);
+      promote = (fun _ -> None);
+      dealloc_minor = (fun _ -> ());
+      dealloc_major = (fun _ -> ());
+    }
+
+    external c_start :
+      float -> int -> ('minor, 'major) tracker -> unit
+      = "caml_memprof_start"
+
+    let start
+      ~sampling_rate
+      ?(callstack_size = max_int)
+      tracker =
+      c_start sampling_rate callstack_size tracker
+
+    external stop : unit -> unit = "caml_memprof_stop"
+  end
diff --git a/stdlib/gc.mli b/stdlib/gc.mli
new file mode 100644
index 00000000..567e4d78
--- /dev/null
+++ b/stdlib/gc.mli
@@ -0,0 +1,543 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*            Damien Doligez, projet Para, INRIA Rocquencourt             *)
+(*            Jacques-Henri Jourdan, projet Gallium, INRIA Paris          *)
+(*                                                                        *)
+(*   Copyright 1996-2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Memory management control and statistics; finalised values. *)
+
+type stat =
+  { minor_words : float;
+    (** Number of words allocated in the minor heap since
+       the program was started. *)
+
+    promoted_words : float;
+    (** Number of words allocated in the minor heap that
+       survived a minor collection and were moved to the major heap
+       since the program was started. *)
+
+    major_words : float;
+    (** Number of words allocated in the major heap, including
+       the promoted words, since the program was started. *)
+
+    minor_collections : int;
+    (** Number of minor collections since the program was started. *)
+
+    major_collections : int;
+    (** Number of major collection cycles completed since the program
+        was started. *)
+
+    heap_words : int;
+    (** Total size of the major heap, in words. *)
+
+    heap_chunks : int;
+    (** Number of contiguous pieces of memory that make up the major heap. *)
+
+    live_words : int;
+    (** Number of words of live data in the major heap, including the header
+       words. *)
+
+    live_blocks : int;
+    (** Number of live blocks in the major heap. *)
+
+    free_words : int;
+    (** Number of words in the free list. *)
+
+    free_blocks : int;
+    (** Number of blocks in the free list. *)
+
+    largest_free : int;
+    (** Size (in words) of the largest block in the free list. *)
+
+    fragments : int;
+    (** Number of wasted words due to fragmentation.  These are
+       1-words free blocks placed between two live blocks.  They
+       are not available for allocation. *)
+
+    compactions : int;
+    (** Number of heap compactions since the program was started. *)
+
+    top_heap_words : int;
+    (** Maximum size reached by the major heap, in words. *)
+
+    stack_size: int;
+    (** Current size of the stack, in words. @since 3.12.0 *)
+}
+(** The memory management counters are returned in a [stat] record.
+
+   The total amount of memory allocated by the program since it was started
+   is (in words) [minor_words + major_words - promoted_words].  Multiply by
+   the word size (4 on a 32-bit machine, 8 on a 64-bit machine) to get
+   the number of bytes.
+*)
+
+type control =
+  { mutable minor_heap_size : int;
+    [@ocaml.deprecated_mutable "Use {(Gc.get()) with Gc.minor_heap_size = ...}"]
+    (** The size (in words) of the minor heap.  Changing
+       this parameter will trigger a minor collection.  Default: 256k. *)
+
+    mutable major_heap_increment : int;
+    [@ocaml.deprecated_mutable
+         "Use {(Gc.get()) with Gc.major_heap_increment = ...}"]
+    (** How much to add to the major heap when increasing it. If this
+        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. *)
+
+    mutable space_overhead : int;
+    [@ocaml.deprecated_mutable "Use {(Gc.get()) with Gc.space_overhead = ...}"]
+    (** The major GC speed is computed from this parameter.
+       This is the memory that will be "wasted" because the GC does not
+       immediately collect unreachable blocks.  It is expressed as a
+       percentage of the memory used for live data.
+       The GC will work more (use more CPU time and collect
+       blocks more eagerly) if [space_overhead] is smaller.
+       Default: 80. *)
+
+    mutable verbose : int;
+    [@ocaml.deprecated_mutable "Use {(Gc.get()) with Gc.verbose = ...}"]
+    (** This value controls the GC messages on standard error output.
+       It is a sum of some of the following flags, to print messages
+       on the corresponding events:
+       - [0x001] Start of major GC cycle.
+       - [0x002] Minor collection and major GC slice.
+       - [0x004] Growing and shrinking of the heap.
+       - [0x008] Resizing of stacks and memory manager tables.
+       - [0x010] Heap compaction.
+       - [0x020] Change of GC parameters.
+       - [0x040] Computation of major GC slice size.
+       - [0x080] Calling of finalisation functions.
+       - [0x100] Bytecode executable and shared library search at start-up.
+       - [0x200] Computation of compaction-triggering condition.
+       - [0x400] Output GC statistics at program exit.
+       Default: 0. *)
+
+    mutable max_overhead : int;
+    [@ocaml.deprecated_mutable "Use {(Gc.get()) with Gc.max_overhead = ...}"]
+    (** Heap compaction is triggered when the estimated amount
+       of "wasted" memory is more than [max_overhead] percent of the
+       amount of live data.  If [max_overhead] is set to 0, heap
+       compaction is triggered at the end of each major GC cycle
+       (this setting is intended for testing purposes only).
+       If [max_overhead >= 1000000], compaction is never triggered.
+       If compaction is permanently disabled, it is strongly suggested
+       to set [allocation_policy] to 2.
+       Default: 500. *)
+
+    mutable stack_limit : int;
+    [@ocaml.deprecated_mutable "Use {(Gc.get()) with Gc.stack_limit = ...}"]
+    (** The maximum size of the stack (in words).  This is only
+       relevant to the byte-code runtime, as the native code runtime
+       uses the operating system's stack.  Default: 1024k. *)
+
+    mutable allocation_policy : int;
+    [@ocaml.deprecated_mutable
+         "Use {(Gc.get()) with Gc.allocation_policy = ...}"]
+    (** The policy used for allocating in the major heap.
+        Possible values are 0, 1 and 2.
+
+        - 0 is the next-fit policy, which is usually fast but can
+          result in fragmentation, increasing memory consumption.
+
+        - 1 is the first-fit policy, which avoids fragmentation but
+          has corner cases (in certain realistic workloads) where it
+          is sensibly slower.
+
+        - 2 is the best-fit policy, which is fast and avoids
+          fragmentation. In our experiments it is faster and uses less
+          memory than both next-fit and first-fit.
+          (since OCaml 4.10)
+
+        The current default is next-fit, as the best-fit policy is new
+        and not yet widely tested. We expect best-fit to become the
+        default in the future.
+
+        On one example that was known to be bad for next-fit and first-fit,
+        next-fit takes 28s using 855Mio of memory,
+        first-fit takes 47s using 566Mio of memory,
+        best-fit takes 27s using 545Mio of memory.
+
+        Note: When changing to a low-fragmentation policy, you may
+        need to augment the [space_overhead] setting, for example
+        using [100] instead of the default [80] which is tuned for
+        next-fit. Indeed, the difference in fragmentation behavior
+        means that different policies will have different proportion
+        of "wasted space" for a given program. Less fragmentation
+        means a smaller heap so, for the same amount of wasted space,
+        a higher proportion of wasted space. This makes the GC work
+        harder, unless you relax it by increasing [space_overhead].
+
+        Note: changing the allocation policy at run-time forces
+        a heap compaction, which is a lengthy operation unless the
+        heap is small (e.g. at the start of the program).
+
+        Default: 0.
+
+        @since 3.11.0 *)
+
+    window_size : int;
+    (** 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.0 *)
+
+    custom_major_ratio : int;
+    (** Target ratio of floating garbage to major heap size for
+        out-of-heap memory held by custom values located in the major
+        heap. The GC speed is adjusted to try to use this much memory
+        for dead values that are not yet collected. Expressed as a
+        percentage of major heap size. The default value keeps the
+        out-of-heap floating garbage about the same size as the
+        in-heap overhead.
+        Note: this only applies to values allocated with
+        [caml_alloc_custom_mem] (e.g. bigarrays).
+        Default: 44.
+        @since 4.08.0 *)
+
+    custom_minor_ratio : int;
+    (** Bound on floating garbage for out-of-heap memory held by
+        custom values in the minor heap. A minor GC is triggered when
+        this much memory is held by custom values located in the minor
+        heap. Expressed as a percentage of minor heap size.
+        Note: this only applies to values allocated with
+        [caml_alloc_custom_mem] (e.g. bigarrays).
+        Default: 100.
+        @since 4.08.0 *)
+
+    custom_minor_max_size : int;
+    (** Maximum amount of out-of-heap memory for each custom value
+        allocated in the minor heap. When a custom value is allocated
+        on the minor heap and holds more than this many bytes, only
+        this value is counted against [custom_minor_ratio] and the
+        rest is directly counted against [custom_major_ratio].
+        Note: this only applies to values allocated with
+        [caml_alloc_custom_mem] (e.g. bigarrays).
+        Default: 8192 bytes.
+        @since 4.08.0 *)
+  }
+(** The GC parameters are given as a [control] record.  Note that
+    these parameters can also be initialised by setting the
+    OCAMLRUNPARAM environment variable.  See the documentation of
+    [ocamlrun]. *)
+
+external stat : unit -> stat = "caml_gc_stat"
+(** Return the current values of the memory management counters in a
+   [stat] record.  This function examines every heap block to get the
+   statistics. *)
+
+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.  This
+    function is much faster than [stat] because it does not need to go
+    through the heap. *)
+
+external counters : unit -> float * float * float = "caml_gc_counters"
+(** Return [(minor_words, promoted_words, major_words)].  This function
+    is as fast as [quick_stat]. *)
+
+external minor_words : unit -> (float [@unboxed])
+  = "caml_gc_minor_words" "caml_gc_minor_words_unboxed"
+(** Number of words allocated in the minor heap since the program was
+    started. This number is accurate in byte-code programs, but only an
+    approximation in programs compiled to native code.
+
+    In native code this function does not allocate.
+
+    @since 4.04 *)
+
+external get : unit -> control = "caml_gc_get"
+(** Return the current values of the GC parameters in a [control] record. *)
+
+external set : control -> unit = "caml_gc_set"
+(** [set r] changes the GC parameters according to the [control] record [r].
+   The normal usage is: [Gc.set { (Gc.get()) with Gc.verbose = 0x00d }] *)
+
+external minor : unit -> unit = "caml_gc_minor"
+(** Trigger a minor collection. *)
+
+external major_slice : int -> int = "caml_gc_major_slice"
+(** [major_slice n]
+    Do a minor collection and a slice of major collection. [n] is the
+    size of the slice: the GC will do enough work to free (on average)
+    [n] words of memory. If [n] = 0, the GC will try to do enough work
+    to ensure that the next automatic slice has no work to do.
+    This function returns an unspecified integer (currently: 0). *)
+
+external major : unit -> unit = "caml_gc_major"
+(** Do a minor collection and finish the current major collection cycle. *)
+
+external full_major : unit -> unit = "caml_gc_full_major"
+(** Do a minor collection, finish the current major collection cycle,
+   and perform a complete new cycle.  This will collect all currently
+   unreachable blocks. *)
+
+external compact : unit -> unit = "caml_gc_compaction"
+(** Perform a full major collection and compact the heap.  Note that heap
+   compaction is a lengthy operation. *)
+
+val print_stat : out_channel -> unit
+(** Print the current values of the memory management counters (in
+   human-readable form) into the channel argument. *)
+
+val allocated_bytes : unit -> float
+(** Return the total number of bytes allocated since the program was
+   started.  It is returned as a [float] to avoid overflow problems
+   with [int] on 32-bit machines. *)
+
+external get_minor_free : unit -> int = "caml_get_minor_free"
+(** Return the current size of the free space inside the minor heap.
+
+    @since 4.03.0 *)
+
+external get_bucket : int -> int = "caml_get_major_bucket" [@@noalloc]
+(** [get_bucket n] returns the current size of the [n]-th future bucket
+    of the GC smoothing system. The unit is one millionth of a full GC.
+    @raise Invalid_argument if [n] is negative, return 0 if n is larger
+    than the smoothing window.
+
+    @since 4.03.0 *)
+
+external get_credit : unit -> int = "caml_get_major_credit" [@@noalloc]
+(** [get_credit ()] returns the current size of the "work done in advance"
+    counter of the GC smoothing system. The unit is one millionth of a
+    full GC.
+
+    @since 4.03.0 *)
+
+external huge_fallback_count : unit -> int = "caml_gc_huge_fallback_count"
+(** Return the number of times we tried to map huge pages and had to fall
+    back to small pages. This is always 0 if [OCAMLRUNPARAM] contains [H=1].
+    @since 4.03.0 *)
+
+val finalise : ('a -> unit) -> 'a -> unit
+(** [finalise f v] registers [f] as a finalisation function for [v].
+   [v] must be heap-allocated.  [f] will be called with [v] as
+   argument at some point between the first time [v] becomes unreachable
+   (including through weak pointers) and the time [v] is collected by
+   the GC. Several functions can
+   be registered for the same value, or even several instances of the
+   same function.  Each instance will be called once (or never,
+   if the program terminates before [v] becomes unreachable).
+
+   The GC will call the finalisation functions in the order of
+   deallocation.  When several values become unreachable at the
+   same time (i.e. during the same GC cycle), the finalisation
+   functions will be called in the reverse order of the corresponding
+   calls to [finalise].  If [finalise] is called in the same order
+   as the values are allocated, that means each value is finalised
+   before the values it depends upon.  Of course, this becomes
+   false if additional dependencies are introduced by assignments.
+
+   In the presence of multiple OCaml threads it should be assumed that
+   any particular finaliser may be executed in any of the threads.
+
+   Anything reachable from the closure of finalisation functions
+   is considered reachable, so the following code will not work
+   as expected:
+   - [ let v = ... in Gc.finalise (fun _ -> ...v...) v ]
+
+   Instead you should make sure that [v] is not in the closure of
+   the finalisation function by writing:
+   - [ let f = fun x -> ...  let v = ... in Gc.finalise f v ]
+
+
+   The [f] function can use all features of OCaml, including
+   assignments that make the value reachable again.  It can also
+   loop forever (in this case, the other
+   finalisation functions will not be called during the execution of f,
+   unless it calls [finalise_release]).
+   It can call [finalise] on [v] or other values to register other
+   functions or even itself.  It can raise an exception; in this case
+   the exception will interrupt whatever the program was doing when
+   the function was called.
+
+
+   [finalise] will raise [Invalid_argument] if [v] is not
+   guaranteed to be heap-allocated.  Some examples of values that are not
+   heap-allocated are integers, constant constructors, booleans,
+   the empty array, the empty list, the unit value.  The exact list
+   of what is heap-allocated or not is implementation-dependent.
+   Some constant values can be heap-allocated but never deallocated
+   during the lifetime of the program, for example a list of integer
+   constants; this is also implementation-dependent.
+   Note that values of types [float] are sometimes allocated and
+   sometimes not, so finalising them is unsafe, and [finalise] will
+   also raise [Invalid_argument] for them. Values of type ['a Lazy.t]
+   (for any ['a]) are like [float] in this respect, except that the
+   compiler sometimes optimizes them in a way that prevents [finalise]
+   from detecting them. In this case, it will not raise
+   [Invalid_argument], but you should still avoid calling [finalise]
+   on lazy values.
+
+
+   The results of calling {!String.make}, {!Bytes.make}, {!Bytes.create},
+   {!Array.make}, and {!Stdlib.ref} are guaranteed to be
+   heap-allocated and non-constant except when the length argument is [0].
+*)
+
+val finalise_last : (unit -> unit) -> 'a -> unit
+(** same as {!finalise} except the value is not given as argument. So
+    you can't use the given value for the computation of the
+    finalisation function. The benefit is that the function is called
+    after the value is unreachable for the last time instead of the
+    first time. So contrary to {!finalise} the value will never be
+    reachable again or used again. In particular every weak pointer
+    and ephemeron that contained this value as key or data is unset
+    before running the finalisation function. Moreover the finalisation
+    functions attached with {!finalise} are always called before the
+    finalisation functions attached with {!finalise_last}.
+
+    @since 4.04
+*)
+
+val finalise_release : unit -> unit
+(** A finalisation function may call [finalise_release] to tell the
+    GC that it can launch the next finalisation function without waiting
+    for the current one to return. *)
+
+type alarm
+(** An alarm is a piece of data that calls a user function at the end of
+   each major GC cycle.  The following functions are provided to create
+   and delete alarms. *)
+
+val create_alarm : (unit -> unit) -> alarm
+(** [create_alarm f] will arrange for [f] to be called at the end of each
+   major GC cycle, starting with the current cycle or the next one.
+   A value of type [alarm] is returned that you can
+   use to call [delete_alarm]. *)
+
+val delete_alarm : alarm -> unit
+(** [delete_alarm a] will stop the calls to the function associated
+   to [a]. Calling [delete_alarm a] again has no effect. *)
+
+external eventlog_pause : unit -> unit = "caml_eventlog_pause"
+(** [eventlog_pause ()] will pause the collection of traces in the
+   runtime.
+   Traces are collected if the program is linked to the instrumented runtime
+   and started with the environment variable OCAML_EVENTLOG_ENABLED.
+   Events are flushed to disk after pausing, and no new events will be
+   recorded until [eventlog_resume] is called. *)
+
+external eventlog_resume : unit -> unit = "caml_eventlog_resume"
+(** [eventlog_resume ()] will resume the collection of traces in the
+   runtime.
+   Traces are collected if the program is linked to the instrumented runtime
+   and started with the environment variable OCAML_EVENTLOG_ENABLED.
+   This call can be used after calling [eventlog_pause], or if the program
+   was started with OCAML_EVENTLOG_ENABLED=p. (which pauses the collection of
+   traces before the first event.) *)
+
+
+(** [Memprof] is a sampling engine for allocated memory words. Every
+   allocated word has a probability of being sampled equal to a
+   configurable sampling rate. Once a block is sampled, it becomes
+   tracked. A tracked block triggers a user-defined callback as soon
+   as it is allocated, promoted or deallocated.
+
+   Since blocks are composed of several words, a block can potentially
+   be sampled several times. If a block is sampled several times, then
+   each of the callback is called once for each event of this block:
+   the multiplicity is given in the [n_samples] field of the
+   [allocation] structure.
+
+   This engine makes it possible to implement a low-overhead memory
+   profiler as an OCaml library.
+
+   Note: this API is EXPERIMENTAL. It may change without prior
+   notice. *)
+module Memprof :
+  sig
+    type allocation = private
+      { n_samples : int;
+        (** The number of samples in this block (>= 1). *)
+
+        size : int;
+        (** The size of the block, in words, excluding the header. *)
+
+        unmarshalled : bool;
+        (** Whether the block comes from unmarshalling. *)
+
+        callstack : Printexc.raw_backtrace
+        (** The callstack for the allocation. *)
+      }
+    (** The type of metadata associated with allocations. This is the
+       type of records passed to the callback triggered by the
+       sampling of an allocation. *)
+
+    type ('minor, 'major) tracker = {
+      alloc_minor: allocation -> 'minor option;
+      alloc_major: allocation -> 'major option;
+      promote: 'minor -> 'major option;
+      dealloc_minor: 'minor -> unit;
+      dealloc_major: 'major -> unit;
+    }
+    (**
+       A [('minor, 'major) tracker] describes how memprof should track
+       sampled blocks over their lifetime, keeping a user-defined piece
+       of metadata for each of them: ['minor] is the type of metadata
+       to keep for minor blocks, and ['major] the type of metadata
+       for major blocks.
+
+       If an allocation-tracking or promotion-tracking function returns [None],
+       memprof stops tracking the corresponding value.
+     *)
+
+    val null_tracker: ('minor, 'major) tracker
+    (** Default callbacks simply return [None] or [()] *)
+
+    val start :
+      sampling_rate:float ->
+      ?callstack_size:int ->
+      ('minor, 'major) tracker ->
+      unit
+    (** Start the sampling with the given parameters. Fails if
+       sampling is already active.
+
+       The parameter [sampling_rate] is 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
+
+       The parameter [callstack_size] is the length of the callstack
+       recorded at every sample. Its default is [max_int].
+
+       The parameter [tracker] determines how to track sampled blocks
+       over their lifetime in the minor and major heap.
+
+       Sampling is temporarily disabled when calling a callback
+       for the current thread. So they do not need to be reentrant if
+       the program is single-threaded. However, if threads are used,
+       it is possible that a context switch occurs during a callback,
+       in this case the callback functions must be reentrant.
+
+       Note that the callback can be postponed slightly after the
+       actual event. The callstack passed to the callback is always
+       accurate, but the program state may have evolved.
+
+       Calling [Thread.exit] in a callback is currently unsafe and can
+       result in undefined behavior. *)
+
+    val stop : unit -> unit
+    (** Stop the sampling. Fails if sampling is not active.
+
+        This function does not allocate memory, but tries to run the
+        postponed callbacks for already allocated memory blocks (of
+        course, these callbacks may allocate).
+
+        All the already tracked blocks are discarded.
+
+        Calling [stop] when a callback is running can lead to
+        callbacks not being called even though some events happened. *)
+end
diff --git a/stdlib/genlex.ml b/stdlib/genlex.ml
new file mode 100644
index 00000000..b015bb95
--- /dev/null
+++ b/stdlib/genlex.ml
@@ -0,0 +1,201 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type token =
+    Kwd of string
+  | Ident of string
+  | Int of int
+  | Float of float
+  | String of string
+  | Char of char
+
+(* The string buffering machinery *)
+
+let initial_buffer = Bytes.create 32
+
+let buffer = ref initial_buffer
+let bufpos = ref 0
+
+let reset_buffer () = buffer := initial_buffer; bufpos := 0
+
+let store c =
+  if !bufpos >= Bytes.length !buffer then begin
+    let newbuffer = Bytes.create (2 * !bufpos) in
+    Bytes.blit !buffer 0 newbuffer 0 !bufpos;
+    buffer := newbuffer
+  end;
+  Bytes.set !buffer !bufpos c;
+  incr bufpos
+
+let get_string () =
+  let s = Bytes.sub_string !buffer 0 !bufpos in buffer := initial_buffer; s
+
+(* The lexer *)
+
+let make_lexer keywords =
+  let kwd_table = Hashtbl.create 17 in
+  List.iter (fun s -> Hashtbl.add kwd_table s (Kwd s)) keywords;
+  let ident_or_keyword id =
+    try Hashtbl.find kwd_table id with
+      Not_found -> Ident id
+  and keyword_or_error c =
+    let s = String.make 1 c in
+    try Hashtbl.find kwd_table s with
+      Not_found -> raise (Stream.Error ("Illegal character " ^ s))
+  in
+  let rec next_token (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some (' ' | '\010' | '\013' | '\009' | '\026' | '\012') ->
+        Stream.junk strm__; next_token strm__
+    | Some ('A'..'Z' | 'a'..'z' | '_' | '\192'..'\255' as c) ->
+        Stream.junk strm__;
+        let s = strm__ in reset_buffer (); store c; ident s
+    | Some
+        ('!' | '%' | '&' | '$' | '#' | '+' | '/' | ':' | '<' | '=' | '>' |
+         '?' | '@' | '\\' | '~' | '^' | '|' | '*' as c) ->
+        Stream.junk strm__;
+        let s = strm__ in reset_buffer (); store c; ident2 s
+    | Some ('0'..'9' as c) ->
+        Stream.junk strm__;
+        let s = strm__ in reset_buffer (); store c; number s
+    | Some '\'' ->
+        Stream.junk strm__;
+        let c =
+          try char strm__ with
+            Stream.Failure -> raise (Stream.Error "")
+        in
+        begin match Stream.peek strm__ with
+          Some '\'' -> Stream.junk strm__; Some (Char c)
+        | _ -> raise (Stream.Error "")
+        end
+    | Some '\"' ->
+        Stream.junk strm__;
+        let s = strm__ in reset_buffer (); Some (String (string s))
+    | Some '-' -> Stream.junk strm__; neg_number strm__
+    | Some '(' -> Stream.junk strm__; maybe_comment strm__
+    | Some c -> Stream.junk strm__; Some (keyword_or_error c)
+    | _ -> None
+  and ident (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some
+        ('A'..'Z' | 'a'..'z' | '\192'..'\255' | '0'..'9' | '_' | '\'' as c) ->
+        Stream.junk strm__; let s = strm__ in store c; ident s
+    | _ -> Some (ident_or_keyword (get_string ()))
+  and ident2 (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some
+        ('!' | '%' | '&' | '$' | '#' | '+' | '-' | '/' | ':' | '<' | '=' |
+         '>' | '?' | '@' | '\\' | '~' | '^' | '|' | '*' as c) ->
+        Stream.junk strm__; let s = strm__ in store c; ident2 s
+    | _ -> Some (ident_or_keyword (get_string ()))
+  and neg_number (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some ('0'..'9' as c) ->
+        Stream.junk strm__;
+        let s = strm__ in reset_buffer (); store '-'; store c; number s
+    | _ -> let s = strm__ in reset_buffer (); store '-'; ident2 s
+  and number (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some ('0'..'9' as c) ->
+        Stream.junk strm__; let s = strm__ in store c; number s
+    | Some '.' ->
+        Stream.junk strm__; let s = strm__ in store '.'; decimal_part s
+    | Some ('e' | 'E') ->
+        Stream.junk strm__; let s = strm__ in store 'E'; exponent_part s
+    | _ -> Some (Int (int_of_string (get_string ())))
+  and decimal_part (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some ('0'..'9' as c) ->
+        Stream.junk strm__; let s = strm__ in store c; decimal_part s
+    | Some ('e' | 'E') ->
+        Stream.junk strm__; let s = strm__ in store 'E'; exponent_part s
+    | _ -> Some (Float (float_of_string (get_string ())))
+  and exponent_part (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some ('+' | '-' as c) ->
+        Stream.junk strm__; let s = strm__ in store c; end_exponent_part s
+    | _ -> end_exponent_part strm__
+  and end_exponent_part (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some ('0'..'9' as c) ->
+        Stream.junk strm__; let s = strm__ in store c; end_exponent_part s
+    | _ -> Some (Float (float_of_string (get_string ())))
+  and string (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some '\"' -> Stream.junk strm__; get_string ()
+    | Some '\\' ->
+        Stream.junk strm__;
+        let c =
+          try escape strm__ with
+            Stream.Failure -> raise (Stream.Error "")
+        in
+        let s = strm__ in store c; string s
+    | Some c -> Stream.junk strm__; let s = strm__ in store c; string s
+    | _ -> raise Stream.Failure
+  and char (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some '\\' ->
+        Stream.junk strm__;
+        begin try escape strm__ with
+          Stream.Failure -> raise (Stream.Error "")
+        end
+    | Some c -> Stream.junk strm__; c
+    | _ -> raise Stream.Failure
+  and escape (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some 'n' -> Stream.junk strm__; '\n'
+    | Some 'r' -> Stream.junk strm__; '\r'
+    | Some 't' -> Stream.junk strm__; '\t'
+    | Some ('0'..'9' as c1) ->
+        Stream.junk strm__;
+        begin match Stream.peek strm__ with
+          Some ('0'..'9' as c2) ->
+            Stream.junk strm__;
+            begin match Stream.peek strm__ with
+              Some ('0'..'9' as c3) ->
+                Stream.junk strm__;
+                Char.chr
+                  ((Char.code c1 - 48) * 100 + (Char.code c2 - 48) * 10 +
+                     (Char.code c3 - 48))
+            | _ -> raise (Stream.Error "")
+            end
+        | _ -> raise (Stream.Error "")
+        end
+    | Some c -> Stream.junk strm__; c
+    | _ -> raise Stream.Failure
+  and maybe_comment (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some '*' ->
+        Stream.junk strm__; let s = strm__ in comment s; next_token s
+    | _ -> Some (keyword_or_error '(')
+  and comment (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some '(' -> Stream.junk strm__; maybe_nested_comment strm__
+    | Some '*' -> Stream.junk strm__; maybe_end_comment strm__
+    | Some _ -> Stream.junk strm__; comment strm__
+    | _ -> raise Stream.Failure
+  and maybe_nested_comment (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some '*' -> Stream.junk strm__; let s = strm__ in comment s; comment s
+    | Some _ -> Stream.junk strm__; comment strm__
+    | _ -> raise Stream.Failure
+  and maybe_end_comment (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some ')' -> Stream.junk strm__; ()
+    | Some '*' -> Stream.junk strm__; maybe_end_comment strm__
+    | Some _ -> Stream.junk strm__; comment strm__
+    | _ -> raise Stream.Failure
+  in
+  fun input -> Stream.from (fun _count -> next_token input)
diff --git a/stdlib/genlex.mli b/stdlib/genlex.mli
new file mode 100644
index 00000000..47394926
--- /dev/null
+++ b/stdlib/genlex.mli
@@ -0,0 +1,73 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** A generic lexical analyzer.
+
+
+   This module implements a simple 'standard' lexical analyzer, presented
+   as a function from character streams to token streams. It implements
+   roughly the lexical conventions of OCaml, but is parameterized by the
+   set of keywords of your language.
+
+
+   Example: a lexer suitable for a desk calculator is obtained by
+   {[     let lexer = make_lexer ["+";"-";"*";"/";"let";"="; "("; ")"]  ]}
+
+   The associated parser would be a function from [token stream]
+   to, for instance, [int], and would have rules such as:
+
+   {[
+           let rec parse_expr = parser
+             | [< n1 = parse_atom; n2 = parse_remainder n1 >] -> n2
+           and parse_atom = parser
+             | [< 'Int n >] -> n
+             | [< 'Kwd "("; n = parse_expr; 'Kwd ")" >] -> n
+           and parse_remainder n1 = parser
+             | [< 'Kwd "+"; n2 = parse_expr >] -> n1+n2
+             | [< >] -> n1
+   ]}
+
+   One should notice that the use of the [parser] keyword and associated
+   notation for streams are only available through camlp4 extensions. This
+   means that one has to preprocess its sources {i e. g.} by using the
+   ["-pp"] command-line switch of the compilers.
+*)
+
+(** The type of tokens. The lexical classes are: [Int] and [Float]
+   for integer and floating-point numbers; [String] for
+   string literals, enclosed in double quotes; [Char] for
+   character literals, enclosed in single quotes; [Ident] for
+   identifiers (either sequences of letters, digits, underscores
+   and quotes, or sequences of 'operator characters' such as
+   [+], [*], etc); and [Kwd] for keywords (either identifiers or
+   single 'special characters' such as [(], [}], etc). *)
+type token =
+    Kwd of string
+  | Ident of string
+  | Int of int
+  | Float of float
+  | String of string
+  | Char of char
+
+val make_lexer : string list -> char Stream.t -> token Stream.t
+(** Construct the lexer function. The first argument is the list of
+   keywords. An identifier [s] is returned as [Kwd s] if [s]
+   belongs to this list, and as [Ident s] otherwise.
+   A special character [s] is returned as [Kwd s] if [s]
+   belongs to this list, and cause a lexical error (exception
+   {!Stream.Error} with the offending lexeme as its parameter) otherwise.
+   Blanks and newlines are skipped. Comments delimited by [(*] and [*)]
+   are skipped as well, and can be nested. A {!Stream.Failure} exception
+   is raised if end of stream is unexpectedly reached.*)
diff --git a/stdlib/hashbang b/stdlib/hashbang
new file mode 100644
index 00000000..04c9334b
--- /dev/null
+++ b/stdlib/hashbang
@@ -0,0 +1 @@
+#! 
\ No newline at end of file
diff --git a/stdlib/hashtbl.ml b/stdlib/hashtbl.ml
new file mode 100644
index 00000000..97bc5321
--- /dev/null
+++ b/stdlib/hashtbl.ml
@@ -0,0 +1,613 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Hash tables *)
+
+(* We do dynamic hashing, and resize the table and rehash the elements
+   when buckets become too long. *)
+
+type ('a, 'b) t =
+  { mutable size: int;                        (* number of entries *)
+    mutable data: ('a, 'b) bucketlist array;  (* the buckets *)
+    mutable seed: int;                        (* for randomization *)
+    mutable initial_size: int;                (* initial array size *)
+  }
+
+and ('a, 'b) bucketlist =
+    Empty
+  | Cons of { mutable key: 'a;
+              mutable data: 'b;
+              mutable next: ('a, 'b) bucketlist }
+
+(* The sign of initial_size encodes the fact that a traversal is
+   ongoing or not.
+
+   This disables the efficient in place implementation of resizing.
+*)
+
+let ongoing_traversal h =
+  Obj.size (Obj.repr h) < 4 (* compatibility with old hash tables *)
+  || h.initial_size < 0
+
+let flip_ongoing_traversal h =
+  h.initial_size <- - h.initial_size
+
+(* To pick random seeds if requested *)
+
+let randomized_default =
+  let params =
+    try Sys.getenv "OCAMLRUNPARAM" with Not_found ->
+    try Sys.getenv "CAMLRUNPARAM" with Not_found -> "" in
+  String.contains params 'R'
+
+let randomized = ref randomized_default
+
+let randomize () = randomized := true
+let is_randomized () = !randomized
+
+let prng = lazy (Random.State.make_self_init())
+
+(* Functions which appear before the functorial interface must either be
+   independent of the hash function or take it as a parameter (see #2202 and
+   code below the functor definitions. *)
+
+(* Creating a fresh, empty table *)
+
+let rec power_2_above x n =
+  if x >= n then x
+  else if x * 2 > Sys.max_array_length then x
+  else power_2_above (x * 2) n
+
+let create ?(random = !randomized) initial_size =
+  let s = power_2_above 16 initial_size in
+  let seed = if random then Random.State.bits (Lazy.force prng) else 0 in
+  { initial_size = s; size = 0; seed = seed; data = Array.make s Empty }
+
+let clear h =
+  if h.size > 0 then begin
+    h.size <- 0;
+    Array.fill h.data 0 (Array.length h.data) Empty
+  end
+
+let reset h =
+  let len = Array.length h.data in
+  if Obj.size (Obj.repr h) < 4 (* compatibility with old hash tables *)
+    || len = abs h.initial_size then
+    clear h
+  else begin
+    h.size <- 0;
+    h.data <- Array.make (abs h.initial_size) Empty
+  end
+
+let copy_bucketlist = function
+  | Empty -> Empty
+  | Cons {key; data; next} ->
+      let rec loop prec = function
+        | Empty -> ()
+        | Cons {key; data; next} ->
+            let r = Cons {key; data; next} in
+            begin match prec with
+            | Empty -> assert false
+            | Cons prec ->  prec.next <- r
+            end;
+            loop r next
+      in
+      let r = Cons {key; data; next} in
+      loop r next;
+      r
+
+let copy h = { h with data = Array.map copy_bucketlist h.data }
+
+let length h = h.size
+
+let resize indexfun h =
+  let odata = h.data in
+  let osize = Array.length odata in
+  let nsize = osize * 2 in
+  if nsize < Sys.max_array_length then begin
+    let ndata = Array.make nsize Empty in
+    let ndata_tail = Array.make nsize Empty in
+    let inplace = not (ongoing_traversal h) in
+    h.data <- ndata;          (* so that indexfun sees the new bucket count *)
+    let rec insert_bucket = function
+      | Empty -> ()
+      | Cons {key; data; next} as cell ->
+          let cell =
+            if inplace then cell
+            else Cons {key; data; next = Empty}
+          in
+          let nidx = indexfun h key in
+          begin match ndata_tail.(nidx) with
+          | Empty -> ndata.(nidx) <- cell;
+          | Cons tail -> tail.next <- cell;
+          end;
+          ndata_tail.(nidx) <- cell;
+          insert_bucket next
+    in
+    for i = 0 to osize - 1 do
+      insert_bucket odata.(i)
+    done;
+    if inplace then
+      for i = 0 to nsize - 1 do
+        match ndata_tail.(i) with
+        | Empty -> ()
+        | Cons tail -> tail.next <- Empty
+      done;
+  end
+
+let iter f h =
+  let rec do_bucket = function
+    | Empty ->
+        ()
+    | Cons{key; data; next} ->
+        f key data; do_bucket next in
+  let old_trav = ongoing_traversal h in
+  if not old_trav then flip_ongoing_traversal h;
+  try
+    let d = h.data in
+    for i = 0 to Array.length d - 1 do
+      do_bucket d.(i)
+    done;
+    if not old_trav then flip_ongoing_traversal h;
+  with exn when not old_trav ->
+    flip_ongoing_traversal h;
+    raise exn
+
+let rec filter_map_inplace_bucket f h i prec = function
+  | Empty ->
+      begin match prec with
+      | Empty -> h.data.(i) <- Empty
+      | Cons c -> c.next <- Empty
+      end
+  | (Cons ({key; data; next} as c)) as slot ->
+      begin match f key data with
+      | None ->
+          h.size <- h.size - 1;
+          filter_map_inplace_bucket f h i prec next
+      | Some data ->
+          begin match prec with
+          | Empty -> h.data.(i) <- slot
+          | Cons c -> c.next <- slot
+          end;
+          c.data <- data;
+          filter_map_inplace_bucket f h i slot next
+      end
+
+let filter_map_inplace f h =
+  let d = h.data in
+  let old_trav = ongoing_traversal h in
+  if not old_trav then flip_ongoing_traversal h;
+  try
+    for i = 0 to Array.length d - 1 do
+      filter_map_inplace_bucket f h i Empty h.data.(i)
+    done
+  with exn when not old_trav ->
+    flip_ongoing_traversal h;
+    raise exn
+
+let fold f h init =
+  let rec do_bucket b accu =
+    match b with
+      Empty ->
+        accu
+    | Cons{key; data; next} ->
+        do_bucket next (f key data accu) in
+  let old_trav = ongoing_traversal h in
+  if not old_trav then flip_ongoing_traversal h;
+  try
+    let d = h.data in
+    let accu = ref init in
+    for i = 0 to Array.length d - 1 do
+      accu := do_bucket d.(i) !accu
+    done;
+    if not old_trav then flip_ongoing_traversal h;
+    !accu
+  with exn when not old_trav ->
+    flip_ongoing_traversal h;
+    raise exn
+
+type statistics = {
+  num_bindings: int;
+  num_buckets: int;
+  max_bucket_length: int;
+  bucket_histogram: int array
+}
+
+let rec bucket_length accu = function
+  | Empty -> accu
+  | Cons{next} -> bucket_length (accu + 1) next
+
+let stats h =
+  let mbl =
+    Array.fold_left (fun m b -> max m (bucket_length 0 b)) 0 h.data in
+  let histo = Array.make (mbl + 1) 0 in
+  Array.iter
+    (fun b ->
+      let l = bucket_length 0 b in
+      histo.(l) <- histo.(l) + 1)
+    h.data;
+  { num_bindings = h.size;
+    num_buckets = Array.length h.data;
+    max_bucket_length = mbl;
+    bucket_histogram = histo }
+
+(** {1 Iterators} *)
+
+let to_seq tbl =
+  (* capture current array, so that even if the table is resized we
+     keep iterating on the same array *)
+  let tbl_data = tbl.data in
+  (* state: index * next bucket to traverse *)
+  let rec aux i buck () = match buck with
+    | Empty ->
+        if i = Array.length tbl_data
+        then Seq.Nil
+        else aux(i+1) tbl_data.(i) ()
+    | Cons {key; data; next} ->
+        Seq.Cons ((key, data), aux i next)
+  in
+  aux 0 Empty
+
+let to_seq_keys m = Seq.map fst (to_seq m)
+
+let to_seq_values m = Seq.map snd (to_seq m)
+
+(* Functorial interface *)
+
+module type HashedType =
+  sig
+    type t
+    val equal: t -> t -> bool
+    val hash: t -> int
+  end
+
+module type SeededHashedType =
+  sig
+    type t
+    val equal: t -> t -> bool
+    val hash: int -> t -> int
+  end
+
+module type S =
+  sig
+    type key
+    type 'a t
+    val create: int -> 'a t
+    val clear : 'a t -> unit
+    val reset : 'a t -> unit
+    val copy: 'a t -> 'a t
+    val add: 'a t -> key -> 'a -> unit
+    val remove: 'a t -> key -> unit
+    val find: 'a t -> key -> 'a
+    val find_opt: 'a t -> key -> 'a option
+    val find_all: 'a t -> key -> 'a list
+    val replace : 'a t -> key -> 'a -> unit
+    val mem : 'a t -> key -> bool
+    val iter: (key -> 'a -> unit) -> 'a t -> unit
+    val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit
+    val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val length: 'a t -> int
+    val stats: 'a t -> statistics
+    val to_seq : 'a t -> (key * 'a) Seq.t
+    val to_seq_keys : _ t -> key Seq.t
+    val to_seq_values : 'a t -> 'a Seq.t
+    val add_seq : 'a t -> (key * 'a) Seq.t -> unit
+    val replace_seq : 'a t -> (key * 'a) Seq.t -> unit
+    val of_seq : (key * 'a) Seq.t -> 'a t
+  end
+
+module type SeededS =
+  sig
+    type key
+    type 'a t
+    val create : ?random:bool -> int -> 'a t
+    val clear : 'a t -> unit
+    val reset : 'a t -> unit
+    val copy : 'a t -> 'a t
+    val add : 'a t -> key -> 'a -> unit
+    val remove : 'a t -> key -> unit
+    val find : 'a t -> key -> 'a
+    val find_opt: 'a t -> key -> 'a option
+    val find_all : 'a t -> key -> 'a list
+    val replace : 'a t -> key -> 'a -> unit
+    val mem : 'a t -> key -> bool
+    val iter : (key -> 'a -> unit) -> 'a t -> unit
+    val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit
+    val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val length : 'a t -> int
+    val stats: 'a t -> statistics
+    val to_seq : 'a t -> (key * 'a) Seq.t
+    val to_seq_keys : _ t -> key Seq.t
+    val to_seq_values : 'a t -> 'a Seq.t
+    val add_seq : 'a t -> (key * 'a) Seq.t -> unit
+    val replace_seq : 'a t -> (key * 'a) Seq.t -> unit
+    val of_seq : (key * 'a) Seq.t -> 'a t
+  end
+
+module MakeSeeded(H: SeededHashedType): (SeededS with type key = H.t) =
+  struct
+    type key = H.t
+    type 'a hashtbl = (key, 'a) t
+    type 'a t = 'a hashtbl
+    let create = create
+    let clear = clear
+    let reset = reset
+    let copy = copy
+
+    let key_index h key =
+      (H.hash h.seed key) land (Array.length h.data - 1)
+
+    let add h key data =
+      let i = key_index h key in
+      let bucket = Cons{key; data; next=h.data.(i)} in
+      h.data.(i) <- bucket;
+      h.size <- h.size + 1;
+      if h.size > Array.length h.data lsl 1 then resize key_index h
+
+    let rec remove_bucket h i key prec = function
+      | Empty ->
+          ()
+      | (Cons {key=k; next}) as c ->
+          if H.equal k key
+          then begin
+            h.size <- h.size - 1;
+            match prec with
+            | Empty -> h.data.(i) <- next
+            | Cons c -> c.next <- next
+          end
+          else remove_bucket h i key c next
+
+    let remove h key =
+      let i = key_index h key in
+      remove_bucket h i key Empty h.data.(i)
+
+    let rec find_rec key = function
+      | Empty ->
+          raise Not_found
+      | Cons{key=k; data; next} ->
+          if H.equal key k then data else find_rec key next
+
+    let find h key =
+      match h.data.(key_index h key) with
+      | Empty -> raise Not_found
+      | Cons{key=k1; data=d1; next=next1} ->
+          if H.equal key k1 then d1 else
+          match next1 with
+          | Empty -> raise Not_found
+          | Cons{key=k2; data=d2; next=next2} ->
+              if H.equal key k2 then d2 else
+              match next2 with
+              | Empty -> raise Not_found
+              | Cons{key=k3; data=d3; next=next3} ->
+                  if H.equal key k3 then d3 else find_rec key next3
+
+    let rec find_rec_opt key = function
+      | Empty ->
+          None
+      | Cons{key=k; data; next} ->
+          if H.equal key k then Some data else find_rec_opt key next
+
+    let find_opt h key =
+      match h.data.(key_index h key) with
+      | Empty -> None
+      | Cons{key=k1; data=d1; next=next1} ->
+          if H.equal key k1 then Some d1 else
+          match next1 with
+          | Empty -> None
+          | Cons{key=k2; data=d2; next=next2} ->
+              if H.equal key k2 then Some d2 else
+              match next2 with
+              | Empty -> None
+              | Cons{key=k3; data=d3; next=next3} ->
+                  if H.equal key k3 then Some d3 else find_rec_opt key next3
+
+    let find_all h key =
+      let rec find_in_bucket = function
+      | Empty ->
+          []
+      | Cons{key=k; data=d; next} ->
+          if H.equal k key
+          then d :: find_in_bucket next
+          else find_in_bucket next in
+      find_in_bucket h.data.(key_index h key)
+
+    let rec replace_bucket key data = function
+      | Empty ->
+          true
+      | Cons ({key=k; next} as slot) ->
+          if H.equal k key
+          then (slot.key <- key; slot.data <- data; false)
+          else replace_bucket key data next
+
+    let replace h key data =
+      let i = key_index h key in
+      let l = h.data.(i) in
+      if replace_bucket key data l then begin
+        h.data.(i) <- Cons{key; data; next=l};
+        h.size <- h.size + 1;
+        if h.size > Array.length h.data lsl 1 then resize key_index h
+      end
+
+    let mem h key =
+      let rec mem_in_bucket = function
+      | Empty ->
+          false
+      | Cons{key=k; next} ->
+          H.equal k key || mem_in_bucket next in
+      mem_in_bucket h.data.(key_index h key)
+
+    let add_seq tbl i =
+      Seq.iter (fun (k,v) -> add tbl k v) i
+
+    let replace_seq tbl i =
+      Seq.iter (fun (k,v) -> replace tbl k v) i
+
+    let of_seq i =
+      let tbl = create 16 in
+      replace_seq tbl i;
+      tbl
+
+    let iter = iter
+    let filter_map_inplace = filter_map_inplace
+    let fold = fold
+    let length = length
+    let stats = stats
+    let to_seq = to_seq
+    let to_seq_keys = to_seq_keys
+    let to_seq_values = to_seq_values
+  end
+
+module Make(H: HashedType): (S with type key = H.t) =
+  struct
+    include MakeSeeded(struct
+        type t = H.t
+        let equal = H.equal
+        let hash (_seed: int) x = H.hash x
+      end)
+    let create sz = create ~random:false sz
+    let of_seq i =
+      let tbl = create 16 in
+      replace_seq tbl i;
+      tbl
+  end
+
+(* Polymorphic hash function-based tables *)
+(* Code included below the functorial interface to guard against accidental
+   use - see #2202 *)
+
+external seeded_hash_param :
+  int -> int -> int -> 'a -> int = "caml_hash" [@@noalloc]
+external old_hash_param :
+  int -> int -> 'a -> int = "caml_hash_univ_param" [@@noalloc]
+
+let hash x = seeded_hash_param 10 100 0 x
+let hash_param n1 n2 x = seeded_hash_param n1 n2 0 x
+let seeded_hash seed x = seeded_hash_param 10 100 seed x
+
+let key_index h key =
+  (* compatibility with old hash tables *)
+  if Obj.size (Obj.repr h) >= 3
+  then (seeded_hash_param 10 100 h.seed key) land (Array.length h.data - 1)
+  else (old_hash_param 10 100 key) mod (Array.length h.data)
+
+let add h key data =
+  let i = key_index h key in
+  let bucket = Cons{key; data; next=h.data.(i)} in
+  h.data.(i) <- bucket;
+  h.size <- h.size + 1;
+  if h.size > Array.length h.data lsl 1 then resize key_index h
+
+let rec remove_bucket h i key prec = function
+  | Empty ->
+      ()
+  | (Cons {key=k; next}) as c ->
+      if compare k key = 0
+      then begin
+        h.size <- h.size - 1;
+        match prec with
+        | Empty -> h.data.(i) <- next
+        | Cons c -> c.next <- next
+      end
+      else remove_bucket h i key c next
+
+let remove h key =
+  let i = key_index h key in
+  remove_bucket h i key Empty h.data.(i)
+
+let rec find_rec key = function
+  | Empty ->
+      raise Not_found
+  | Cons{key=k; data; next} ->
+      if compare key k = 0 then data else find_rec key next
+
+let find h key =
+  match h.data.(key_index h key) with
+  | Empty -> raise Not_found
+  | Cons{key=k1; data=d1; next=next1} ->
+      if compare key k1 = 0 then d1 else
+      match next1 with
+      | Empty -> raise Not_found
+      | Cons{key=k2; data=d2; next=next2} ->
+          if compare key k2 = 0 then d2 else
+          match next2 with
+          | Empty -> raise Not_found
+          | Cons{key=k3; data=d3; next=next3} ->
+              if compare key k3 = 0 then d3 else find_rec key next3
+
+let rec find_rec_opt key = function
+  | Empty ->
+      None
+  | Cons{key=k; data; next} ->
+      if compare key k = 0 then Some data else find_rec_opt key next
+
+let find_opt h key =
+  match h.data.(key_index h key) with
+  | Empty -> None
+  | Cons{key=k1; data=d1; next=next1} ->
+      if compare key k1 = 0 then Some d1 else
+      match next1 with
+      | Empty -> None
+      | Cons{key=k2; data=d2; next=next2} ->
+          if compare key k2 = 0 then Some d2 else
+          match next2 with
+          | Empty -> None
+          | Cons{key=k3; data=d3; next=next3} ->
+              if compare key k3 = 0 then Some d3 else find_rec_opt key next3
+
+let find_all h key =
+  let rec find_in_bucket = function
+  | Empty ->
+      []
+  | Cons{key=k; data; next} ->
+      if compare k key = 0
+      then data :: find_in_bucket next
+      else find_in_bucket next in
+  find_in_bucket h.data.(key_index h key)
+
+let rec replace_bucket key data = function
+  | Empty ->
+      true
+  | Cons ({key=k; next} as slot) ->
+      if compare k key = 0
+      then (slot.key <- key; slot.data <- data; false)
+      else replace_bucket key data next
+
+let replace h key data =
+  let i = key_index h key in
+  let l = h.data.(i) in
+  if replace_bucket key data l then begin
+    h.data.(i) <- Cons{key; data; next=l};
+    h.size <- h.size + 1;
+    if h.size > Array.length h.data lsl 1 then resize key_index h
+  end
+
+let mem h key =
+  let rec mem_in_bucket = function
+  | Empty ->
+      false
+  | Cons{key=k; next} ->
+      compare k key = 0 || mem_in_bucket next in
+  mem_in_bucket h.data.(key_index h key)
+
+let add_seq tbl i =
+  Seq.iter (fun (k,v) -> add tbl k v) i
+
+let replace_seq tbl i =
+  Seq.iter (fun (k,v) -> replace tbl k v) i
+
+let of_seq i =
+  let tbl = create 16 in
+  replace_seq tbl i;
+  tbl
diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli
new file mode 100644
index 00000000..5a9d825a
--- /dev/null
+++ b/stdlib/hashtbl.mli
@@ -0,0 +1,483 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Hash tables and hash functions.
+
+   Hash tables are hashed association tables, with in-place modification.
+*)
+
+
+(** {1 Generic interface} *)
+
+
+type ('a, 'b) t
+(** The type of hash tables from type ['a] to type ['b]. *)
+
+val create : ?random: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.
+
+   The optional [random] parameter (a boolean) controls whether
+   the internal organization of the hash table is randomized at each
+   execution of [Hashtbl.create] or deterministic over all executions.
+
+   A hash table that is created with [~random:false] uses a
+   fixed hash function ({!Hashtbl.hash}) to distribute keys among
+   buckets.  As a consequence, collisions between keys happen
+   deterministically.  In Web-facing applications or other
+   security-sensitive applications, the deterministic collision
+   patterns can be exploited by a malicious user to create a
+   denial-of-service attack: the attacker sends input crafted to
+   create many collisions in the table, slowing the application down.
+
+   A hash table that is created with [~random:true] uses the seeded
+   hash function {!Hashtbl.seeded_hash} with a seed that is randomly
+   chosen at hash table creation time.  In effect, the hash function
+   used is randomly selected among [2^{30}] different hash functions.
+   All these hash functions have different collision patterns,
+   rendering ineffective the denial-of-service attack described above.
+   However, because of randomization, enumerating all elements of the
+   hash table using {!Hashtbl.fold} or {!Hashtbl.iter} is no longer
+   deterministic: elements are enumerated in different orders at
+   different runs of the program.
+
+   If no [~random] parameter is given, hash tables are created
+   in non-random mode by default.  This default can be changed
+   either programmatically by calling {!Hashtbl.randomize} or by
+   setting the [R] flag in the [OCAMLRUNPARAM] environment variable.
+
+   @before 4.00.0 the [random] parameter was not present and all
+   hash tables were created in non-randomized mode. *)
+
+val clear : ('a, 'b) t -> unit
+(** Empty a hash table. Use [reset] instead of [clear] to shrink the
+    size of the bucket table to its initial size. *)
+
+val reset : ('a, 'b) t -> unit
+(** Empty a hash table and shrink the size of the bucket table
+    to its initial size.
+    @since 4.00.0 *)
+
+val copy : ('a, 'b) t -> ('a, 'b) t
+(** Return a copy of the given hashtable. *)
+
+val add : ('a, 'b) t -> 'a -> 'b -> unit
+(** [Hashtbl.add tbl x y] adds a binding of [x] to [y] in table [tbl].
+   Previous bindings for [x] are not removed, but simply
+   hidden. That is, after performing {!Hashtbl.remove}[ tbl x],
+   the previous binding for [x], if any, is restored.
+   (Same behavior as with association lists.) *)
+
+val find : ('a, 'b) t -> 'a -> 'b
+(** [Hashtbl.find tbl x] returns the current binding of [x] in [tbl],
+   or raises [Not_found] if no such binding exists. *)
+
+val find_opt : ('a, 'b) t -> 'a -> 'b option
+(** [Hashtbl.find_opt tbl x] returns the current binding of [x] in [tbl],
+    or [None] if no such binding exists.
+    @since 4.05 *)
+
+val find_all : ('a, 'b) t -> 'a -> 'b list
+(** [Hashtbl.find_all tbl x] returns the list of all data
+   associated with [x] in [tbl].
+   The current binding is returned first, then the previous
+   bindings, in reverse order of introduction in the table. *)
+
+val mem : ('a, 'b) t -> 'a -> bool
+(** [Hashtbl.mem tbl x] checks if [x] is bound in [tbl]. *)
+
+val remove : ('a, 'b) t -> 'a -> unit
+(** [Hashtbl.remove tbl x] removes the current binding of [x] in [tbl],
+   restoring the previous binding if it exists.
+   It does nothing if [x] is not bound in [tbl]. *)
+
+val replace : ('a, 'b) t -> 'a -> 'b -> unit
+(** [Hashtbl.replace tbl x y] replaces the current binding of [x]
+   in [tbl] by a binding of [x] to [y].  If [x] is unbound in [tbl],
+   a binding of [x] to [y] is added to [tbl].
+   This is functionally equivalent to {!Hashtbl.remove}[ tbl x]
+   followed by {!Hashtbl.add}[ tbl x y]. *)
+
+val iter : ('a -> 'b -> unit) -> ('a, 'b) t -> unit
+(** [Hashtbl.iter f tbl] applies [f] to all bindings in table [tbl].
+   [f] receives the key as first argument, and the associated value
+   as second argument. Each binding is presented exactly once to [f].
+
+   The order in which the bindings are passed to [f] is unspecified.
+   However, if the table contains several bindings for the same key,
+   they are passed to [f] in reverse order of introduction, that is,
+   the most recent binding is passed first.
+
+   If the hash table was created in non-randomized mode, the order
+   in which the bindings are enumerated is reproducible between
+   successive runs of the program, and even between minor versions
+   of OCaml.  For randomized hash tables, the order of enumeration
+   is entirely random.
+
+   The behavior is not defined if the hash table is modified
+   by [f] during the iteration.
+*)
+
+val filter_map_inplace: ('a -> 'b -> 'b option) -> ('a, 'b) t -> unit
+(** [Hashtbl.filter_map_inplace f tbl] applies [f] to all bindings in
+    table [tbl] and update each binding depending on the result of
+    [f].  If [f] returns [None], the binding is discarded.  If it
+    returns [Some new_val], the binding is update to associate the key
+    to [new_val].
+
+    Other comments for {!Hashtbl.iter} apply as well.
+    @since 4.03.0 *)
+
+val fold : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c
+(** [Hashtbl.fold f tbl init] computes
+   [(f kN dN ... (f k1 d1 init)...)],
+   where [k1 ... kN] are the keys of all bindings in [tbl],
+   and [d1 ... dN] are the associated values.
+   Each binding is presented exactly once to [f].
+
+   The order in which the bindings are passed to [f] is unspecified.
+   However, if the table contains several bindings for the same key,
+   they are passed to [f] in reverse order of introduction, that is,
+   the most recent binding is passed first.
+
+   If the hash table was created in non-randomized mode, the order
+   in which the bindings are enumerated is reproducible between
+   successive runs of the program, and even between minor versions
+   of OCaml.  For randomized hash tables, the order of enumeration
+   is entirely random.
+
+   The behavior is not defined if the hash table is modified
+   by [f] during the iteration.
+*)
+
+val length : ('a, 'b) t -> int
+(** [Hashtbl.length tbl] returns the number of bindings in [tbl].
+   It takes constant time.  Multiple bindings are counted once each, so
+   [Hashtbl.length] gives the number of times [Hashtbl.iter] calls its
+   first argument. *)
+
+val randomize : unit -> unit
+(** After a call to [Hashtbl.randomize()], hash tables are created in
+    randomized mode by default: {!Hashtbl.create} returns randomized
+    hash tables, unless the [~random:false] optional parameter is given.
+    The same effect can be achieved by setting the [R] parameter in
+    the [OCAMLRUNPARAM] environment variable.
+
+    It is recommended that applications or Web frameworks that need to
+    protect themselves against the denial-of-service attack described
+    in {!Hashtbl.create} call [Hashtbl.randomize()] at initialization
+    time.
+
+    Note that once [Hashtbl.randomize()] was called, there is no way
+    to revert to the non-randomized default behavior of {!Hashtbl.create}.
+    This is intentional.  Non-randomized hash tables can still be
+    created using [Hashtbl.create ~random:false].
+
+    @since 4.00.0 *)
+
+val is_randomized : unit -> bool
+(** return if the tables are currently created in randomized mode by default
+
+    @since 4.03.0 *)
+
+(** @since 4.00.0 *)
+type statistics = {
+  num_bindings: int;
+    (** Number of bindings present in the table.
+        Same value as returned by {!Hashtbl.length}. *)
+  num_buckets: int;
+    (** Number of buckets in the table. *)
+  max_bucket_length: int;
+    (** Maximal number of bindings per bucket. *)
+  bucket_histogram: int array
+    (** Histogram of bucket sizes.  This array [histo] has
+        length [max_bucket_length + 1].  The value of
+        [histo.(i)] is the number of buckets whose size is [i]. *)
+}
+
+val stats : ('a, 'b) t -> statistics
+(** [Hashtbl.stats tbl] returns statistics about the table [tbl]:
+   number of buckets, size of the biggest bucket, distribution of
+   buckets by size.
+   @since 4.00.0 *)
+
+(** {1 Iterators} *)
+
+val to_seq : ('a,'b) t -> ('a * 'b) Seq.t
+(** Iterate on the whole table.  The order in which the bindings
+    appear in the sequence is unspecified. However, if the table contains
+    several bindings for the same key, they appear in reversed order of
+    introduction, that is, the most recent binding appears first.
+
+    The behavior is not defined if the hash table is modified
+    during the iteration.
+
+    @since 4.07 *)
+
+val to_seq_keys : ('a,_) t -> 'a Seq.t
+(** Same as [Seq.map fst (to_seq m)]
+    @since 4.07 *)
+
+val to_seq_values : (_,'b) t -> 'b Seq.t
+(** Same as [Seq.map snd (to_seq m)]
+    @since 4.07 *)
+
+val add_seq : ('a,'b) t -> ('a * 'b) Seq.t -> unit
+(** Add the given bindings to the table, using {!add}
+    @since 4.07 *)
+
+val replace_seq : ('a,'b) t -> ('a * 'b) Seq.t -> unit
+(** Add the given bindings to the table, using {!replace}
+    @since 4.07 *)
+
+val of_seq : ('a * 'b) Seq.t -> ('a, 'b) t
+(** Build a table from the given bindings. The bindings are added
+    in the same order they appear in the sequence, using {!replace_seq},
+    which means that if two pairs have the same key, only the latest one
+    will appear in the table.
+    @since 4.07 *)
+
+(** {1 Functorial interface} *)
+
+(** The functorial interface allows the use of specific comparison
+    and hash functions, either for performance/security concerns,
+    or because keys are not hashable/comparable with the polymorphic builtins.
+
+    For instance, one might want to specialize a table for integer keys:
+    {[
+      module IntHash =
+        struct
+          type t = int
+          let equal i j = i=j
+          let hash i = i land max_int
+        end
+
+      module IntHashtbl = Hashtbl.Make(IntHash)
+
+      let h = IntHashtbl.create 17 in
+      IntHashtbl.add h 12 "hello"
+    ]}
+
+    This creates a new module [IntHashtbl], with a new type ['a
+    IntHashtbl.t] of tables from [int] to ['a]. In this example, [h]
+    contains [string] values so its type is [string IntHashtbl.t].
+
+    Note that the new type ['a IntHashtbl.t] is not compatible with
+    the type [('a,'b) Hashtbl.t] of the generic interface. For
+    example, [Hashtbl.length h] would not type-check, you must use
+    [IntHashtbl.length].
+*)
+
+module type HashedType =
+  sig
+    type t
+    (** The type of the hashtable keys. *)
+
+    val equal : t -> t -> bool
+    (** The equality predicate used to compare keys. *)
+
+    val hash : t -> int
+      (** A hashing function on keys. It must be such that if two keys are
+          equal according to [equal], then they have identical hash values
+          as computed by [hash].
+          Examples: suitable ([equal], [hash]) pairs for arbitrary key
+          types include
+-         ([(=)], {!Hashtbl.hash}) for comparing objects by structure
+              (provided objects do not contain floats)
+-         ([(fun x y -> compare x y = 0)], {!Hashtbl.hash})
+              for comparing objects by structure
+              and handling {!Stdlib.nan} correctly
+-         ([(==)], {!Hashtbl.hash}) for comparing objects by physical
+              equality (e.g. for mutable or cyclic objects). *)
+   end
+(** The input signature of the functor {!Hashtbl.Make}. *)
+
+module type S =
+  sig
+    type key
+    type 'a t
+    val create : int -> 'a t
+    val clear : 'a t -> unit
+    val reset : 'a t -> unit (** @since 4.00.0 *)
+
+    val copy : 'a t -> 'a t
+    val add : 'a t -> key -> 'a -> unit
+    val remove : 'a t -> key -> unit
+    val find : 'a t -> key -> 'a
+    val find_opt : 'a t -> key -> 'a option
+    (** @since 4.05.0 *)
+
+    val find_all : 'a t -> key -> 'a list
+    val replace : 'a t -> key -> 'a -> unit
+    val mem : 'a t -> key -> bool
+    val iter : (key -> 'a -> unit) -> 'a t -> unit
+    val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit
+    (** @since 4.03.0 *)
+
+    val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val length : 'a t -> int
+    val stats: 'a t -> statistics (** @since 4.00.0 *)
+
+    val to_seq : 'a t -> (key * 'a) Seq.t
+    (** @since 4.07 *)
+
+    val to_seq_keys : _ t -> key Seq.t
+    (** @since 4.07 *)
+
+    val to_seq_values : 'a t -> 'a Seq.t
+    (** @since 4.07 *)
+
+    val add_seq : 'a t -> (key * 'a) Seq.t -> unit
+    (** @since 4.07 *)
+
+    val replace_seq : 'a t -> (key * 'a) Seq.t -> unit
+    (** @since 4.07 *)
+
+    val of_seq : (key * 'a) Seq.t -> 'a t
+    (** @since 4.07 *)
+  end
+(** The output signature of the functor {!Hashtbl.Make}. *)
+
+module Make (H : HashedType) : S with type key = H.t
+(** Functor building an implementation of the hashtable structure.
+    The functor [Hashtbl.Make] returns a structure containing
+    a type [key] of keys and a type ['a t] of hash tables
+    associating data of type ['a] to keys of type [key].
+    The operations perform similarly to those of the generic
+    interface, but use the hashing and equality functions
+    specified in the functor argument [H] instead of generic
+    equality and hashing.  Since the hash function is not seeded,
+    the [create] operation of the result structure always returns
+    non-randomized hash tables. *)
+
+module type SeededHashedType =
+  sig
+    type t
+    (** The type of the hashtable keys. *)
+
+    val equal: t -> t -> bool
+    (** The equality predicate used to compare keys. *)
+
+    val hash: int -> t -> int
+      (** A seeded hashing function on keys.  The first argument is
+          the seed.  It must be the case that if [equal x y] is true,
+          then [hash seed x = hash seed y] for any value of [seed].
+          A suitable choice for [hash] is the function {!Hashtbl.seeded_hash}
+          below. *)
+  end
+(** The input signature of the functor {!Hashtbl.MakeSeeded}.
+    @since 4.00.0 *)
+
+module type SeededS =
+  sig
+    type key
+    type 'a t
+    val create : ?random:bool -> int -> 'a t
+    val clear : 'a t -> unit
+    val reset : 'a t -> unit
+    val copy : 'a t -> 'a t
+    val add : 'a t -> key -> 'a -> unit
+    val remove : 'a t -> key -> unit
+    val find : 'a t -> key -> 'a
+    val find_opt : 'a t -> key -> 'a option (** @since 4.05.0 *)
+
+    val find_all : 'a t -> key -> 'a list
+    val replace : 'a t -> key -> 'a -> unit
+    val mem : 'a t -> key -> bool
+    val iter : (key -> 'a -> unit) -> 'a t -> unit
+    val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit
+    (** @since 4.03.0 *)
+
+    val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val length : 'a t -> int
+    val stats: 'a t -> statistics
+
+    val to_seq : 'a t -> (key * 'a) Seq.t
+    (** @since 4.07 *)
+
+    val to_seq_keys : _ t -> key Seq.t
+    (** @since 4.07 *)
+
+    val to_seq_values : 'a t -> 'a Seq.t
+    (** @since 4.07 *)
+
+    val add_seq : 'a t -> (key * 'a) Seq.t -> unit
+    (** @since 4.07 *)
+
+    val replace_seq : 'a t -> (key * 'a) Seq.t -> unit
+    (** @since 4.07 *)
+
+    val of_seq : (key * 'a) Seq.t -> 'a t
+    (** @since 4.07 *)
+  end
+(** The output signature of the functor {!Hashtbl.MakeSeeded}.
+    @since 4.00.0 *)
+
+module MakeSeeded (H : SeededHashedType) : SeededS with type key = H.t
+(** Functor building an implementation of the hashtable structure.
+    The functor [Hashtbl.MakeSeeded] returns a structure containing
+    a type [key] of keys and a type ['a t] of hash tables
+    associating data of type ['a] to keys of type [key].
+    The operations perform similarly to those of the generic
+    interface, but use the seeded hashing and equality functions
+    specified in the functor argument [H] instead of generic
+    equality and hashing.  The [create] operation of the
+    result structure supports the [~random] optional parameter
+    and returns randomized hash tables if [~random:true] is passed
+    or if randomization is globally on (see {!Hashtbl.randomize}).
+    @since 4.00.0 *)
+
+
+(** {1 The polymorphic hash functions} *)
+
+
+val hash : 'a -> int
+(** [Hashtbl.hash x] associates a nonnegative integer to any value of
+   any type. It is guaranteed that
+   if [x = y] or [Stdlib.compare x y = 0], then [hash x = hash y].
+   Moreover, [hash] always terminates, even on cyclic structures. *)
+
+val seeded_hash : int -> 'a -> int
+(** A variant of {!Hashtbl.hash} that is further parameterized by
+   an integer seed.
+   @since 4.00.0 *)
+
+val hash_param : int -> int -> 'a -> int
+(** [Hashtbl.hash_param meaningful total x] computes a hash value for [x],
+   with the same properties as for [hash]. The two extra integer
+   parameters [meaningful] and [total] give more precise control over
+   hashing. Hashing performs a breadth-first, left-to-right traversal
+   of the structure [x], stopping after [meaningful] meaningful nodes
+   were encountered, or [total] nodes (meaningful or not) were
+   encountered.  If [total] as specified by the user exceeds a certain
+   value, currently 256, then it is capped to that value.
+   Meaningful nodes are: integers; floating-point
+   numbers; strings; characters; booleans; and constant
+   constructors. Larger values of [meaningful] and [total] means that
+   more nodes are taken into account to compute the final hash value,
+   and therefore collisions are less likely to happen.  However,
+   hashing takes longer. The parameters [meaningful] and [total]
+   govern the tradeoff between accuracy and speed.  As default
+   choices, {!Hashtbl.hash} and {!Hashtbl.seeded_hash} take
+   [meaningful = 10] and [total = 100]. *)
+
+val seeded_hash_param : int -> int -> int -> 'a -> int
+(** A variant of {!Hashtbl.hash_param} that is further parameterized by
+   an integer seed.  Usage:
+   [Hashtbl.seeded_hash_param meaningful total seed x].
+   @since 4.00.0 *)
diff --git a/stdlib/header.c b/stdlib/header.c
new file mode 100644
index 00000000..426b064e
--- /dev/null
+++ b/stdlib/header.c
@@ -0,0 +1,193 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 1998 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
+
+/* The launcher for bytecode executables (if #! is not working) */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "caml/s.h"
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#include <fcntl.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include "caml/mlvalues.h"
+#include "caml/exec.h"
+
+char * default_runtime_path = RUNTIME_NAME;
+
+#ifndef MAXPATHLEN
+#define MAXPATHLEN 1024
+#endif
+
+#ifndef S_ISREG
+#define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG)
+#endif
+
+#ifndef SEEK_END
+#define SEEK_END 2
+#endif
+
+#ifndef __CYGWIN__
+
+/* Normal Unix search path function */
+
+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++) {
+    if (*p == '/') return name;
+  }
+  path = getenv("PATH");
+  if (path == NULL) return name;
+  while(1) {
+    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++)
+      if (p < fullname + MAXPATHLEN) *p = *q;
+    *p = 0;
+    if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode)) break;
+    if (*path == 0) return name;
+    path++;
+  }
+  return fullname;
+}
+
+#else
+
+/* Special version for Cygwin32: takes care of the ".exe" implicit suffix */
+
+static int file_ok(char * name)
+{
+  int fd;
+  /* Cannot use stat() here because it adds ".exe" implicitly */
+  fd = open(name, O_RDONLY);
+  if (fd == -1) return 0;
+  close(fd);
+  return 1;
+}
+
+static char * searchpath(char * name)
+{
+  char * path, * fullname, * p;
+
+  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++) {
+    if (*p == '/' || *p == '\\') {
+      if (file_ok(name)) return name;
+      strcpy(fullname, name);
+      strcat(fullname, ".exe");
+      if (file_ok(fullname)) return fullname;
+      return name;
+    }
+  }
+  /* Search in path */
+  if (path == NULL) return name;
+  while(1) {
+    for (p = fullname; *path != 0 && *path != ':'; p++, path++) *p = *path;
+    if (p != fullname) *p++ = '/';
+    strcpy(p, name);
+    if (file_ok(fullname)) return fullname;
+    strcat(fullname, ".exe");
+    if (file_ok(fullname)) return fullname;
+    if (*path == 0) break;
+    path++;
+  }
+  return name;
+}
+
+#endif
+
+static unsigned long read_size(char * ptr)
+{
+  unsigned char * p = (unsigned char *) ptr;
+  return ((unsigned long) p[0] << 24) + ((unsigned long) p[1] << 16) +
+         ((unsigned long) p[2] << 8) + p[3];
+}
+
+static char * read_runtime_path(int fd)
+{
+  char buffer[TRAILER_SIZE];
+  static char runtime_path[MAXPATHLEN];
+  int num_sections, i;
+  uint32_t path_size;
+  long ofs;
+
+  lseek(fd, (long) -TRAILER_SIZE, SEEK_END);
+  if (read(fd, buffer, TRAILER_SIZE) < TRAILER_SIZE) return NULL;
+  num_sections = read_size(buffer);
+  ofs = TRAILER_SIZE + num_sections * 8;
+  lseek(fd, -ofs, SEEK_END);
+  path_size = 0;
+  for (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') {
+      path_size = read_size(buffer + 4);
+      ofs += path_size;
+    } else if (path_size > 0)
+      ofs += read_size(buffer + 4);
+  }
+  if (path_size == 0) return default_runtime_path;
+  if (path_size >= MAXPATHLEN) return NULL;
+  lseek(fd, -ofs, SEEK_END);
+  if (read(fd, runtime_path, path_size) != path_size) return NULL;
+  runtime_path[path_size - 1] = 0;
+  return runtime_path;
+}
+
+static void errwrite(char * msg)
+{
+  write(2, msg, strlen(msg));
+}
+
+#ifndef O_BINARY
+#define O_BINARY 0
+#endif
+
+int main(int argc, char ** argv)
+{
+  char * truename, * runtime_path;
+  int fd;
+
+  truename = searchpath(argv[0]);
+  fd = open(truename, O_RDONLY | O_BINARY);
+  if (fd == -1 || (runtime_path = read_runtime_path(fd)) == NULL) {
+    errwrite(truename);
+    errwrite(" not found or is not a bytecode executable file\n");
+    return 2;
+  }
+  argv[0] = truename;
+  execv(runtime_path, argv);
+  errwrite("Cannot exec ");
+  errwrite(runtime_path);
+  errwrite("\n");
+  return 2;
+}
diff --git a/stdlib/headernt.c b/stdlib/headernt.c
new file mode 100644
index 00000000..43109c86
--- /dev/null
+++ b/stdlib/headernt.c
@@ -0,0 +1,196 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 1998 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
+
+#define STRICT
+#define WIN32_LEAN_AND_MEAN
+
+#include <windows.h>
+#include "caml/mlvalues.h"
+#include "caml/exec.h"
+
+#ifndef __MINGW32__
+#pragma comment(linker , "/subsystem:console")
+#pragma comment(lib , "kernel32")
+#ifdef _UCRT
+#pragma comment(lib , "ucrt.lib")
+#pragma comment(lib , "vcruntime.lib")
+#endif
+#endif
+
+char * default_runtime_name = RUNTIME_NAME;
+
+static
+#if _MSC_VER >= 1200
+__forceinline
+#else
+__inline
+#endif
+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)
+{
+  char buffer[TRAILER_SIZE];
+  static char runtime_path[MAX_PATH];
+  DWORD nread;
+  int num_sections, path_size, i;
+  long ofs;
+
+  if (SetFilePointer(h, -TRAILER_SIZE, NULL, FILE_END) == -1) return NULL;
+  if (! ReadFile(h, buffer, TRAILER_SIZE, &nread, NULL)) return NULL;
+  if (nread != TRAILER_SIZE) return NULL;
+  num_sections = read_size(buffer);
+  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++) {
+    if (! ReadFile(h, buffer, 8, &nread, NULL) || nread != 8) return NULL;
+    if (buffer[0] == 'R' && buffer[1] == 'N' &&
+        buffer[2] == 'T' && buffer[3] == 'M') {
+      path_size = read_size(buffer + 4);
+      ofs += path_size;
+    } else if (path_size > 0)
+      ofs += read_size(buffer + 4);
+  }
+  if (path_size == 0) return default_runtime_name;
+  if (path_size >= MAX_PATH) return NULL;
+  if (SetFilePointer(h, -ofs, NULL, FILE_END) == -1) return NULL;
+  if (! ReadFile(h, runtime_path, path_size, &nread, NULL)) return NULL;
+  if (nread != path_size) return NULL;
+  runtime_path[path_size - 1] = 0;
+  return runtime_path;
+}
+
+static BOOL WINAPI ctrl_handler(DWORD event)
+{
+  if (event == CTRL_C_EVENT || event == CTRL_BREAK_EVENT)
+    return TRUE;                /* pretend we've handled them */
+  else
+    return FALSE;
+}
+
+#if WINDOWS_UNICODE
+#define CP CP_UTF8
+#else
+#define CP CP_ACP
+#endif
+
+static void write_console(HANDLE hOut, WCHAR *wstr)
+{
+  DWORD consoleMode, numwritten, len;
+  static char str[MAX_PATH];
+
+  if (GetConsoleMode(hOut, &consoleMode) != 0) {
+    /* The output stream is a Console */
+    WriteConsole(hOut, wstr, wcslen(wstr), &numwritten, NULL);
+  } else { /* The output stream is redirected */
+    len =
+      WideCharToMultiByte(CP, 0, wstr, wcslen(wstr), str, sizeof(str),
+                          NULL, NULL);
+    WriteFile(hOut, str, len, &numwritten, NULL);
+  }
+}
+
+static __inline void __declspec(noreturn) run_runtime(wchar_t * runtime,
+         wchar_t * const cmdline)
+{
+  wchar_t path[MAX_PATH];
+  STARTUPINFO stinfo;
+  PROCESS_INFORMATION procinfo;
+  DWORD retcode;
+  if (SearchPath(NULL, runtime, L".exe", sizeof(path)/sizeof(wchar_t),
+                 path, &runtime) == 0) {
+    HANDLE errh;
+    errh = GetStdHandle(STD_ERROR_HANDLE);
+    write_console(errh, L"Cannot exec ");
+    write_console(errh, runtime);
+    write_console(errh, L"\r\n");
+    ExitProcess(2);
+#if _MSC_VER >= 1200
+    __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! */
+  SetConsoleCtrlHandler(ctrl_handler, TRUE);
+
+  stinfo.cb = sizeof(stinfo);
+  stinfo.lpReserved = NULL;
+  stinfo.lpDesktop = NULL;
+  stinfo.lpTitle = NULL;
+  stinfo.dwFlags = 0;
+  stinfo.cbReserved2 = 0;
+  stinfo.lpReserved2 = NULL;
+  if (!CreateProcess(path, cmdline, NULL, NULL, TRUE, 0, NULL, NULL,
+                     &stinfo, &procinfo)) {
+    HANDLE errh;
+    errh = GetStdHandle(STD_ERROR_HANDLE);
+    write_console(errh, L"Cannot exec ");
+    write_console(errh, runtime);
+    write_console(errh, L"\r\n");
+    ExitProcess(2);
+#if _MSC_VER >= 1200
+    __assume(0); /* Not reached */
+#endif
+  }
+  CloseHandle(procinfo.hThread);
+  WaitForSingleObject(procinfo.hProcess , INFINITE);
+  GetExitCodeProcess(procinfo.hProcess , &retcode);
+  CloseHandle(procinfo.hProcess);
+  ExitProcess(retcode);
+#if _MSC_VER >= 1200
+    __assume(0); /* Not reached */
+#endif
+}
+
+int wmain(void)
+{
+  wchar_t truename[MAX_PATH];
+  wchar_t * cmdline = GetCommandLine();
+  char * runtime_path;
+  wchar_t wruntime_path[MAX_PATH];
+  HANDLE h;
+
+  GetModuleFileName(NULL, truename, sizeof(truename)/sizeof(wchar_t));
+  h = CreateFile(truename, GENERIC_READ, FILE_SHARE_READ | FILE_SHARE_WRITE,
+                 NULL, OPEN_EXISTING, 0, NULL);
+  if (h == INVALID_HANDLE_VALUE ||
+      (runtime_path = read_runtime_path(h)) == NULL) {
+    HANDLE errh;
+    errh = GetStdHandle(STD_ERROR_HANDLE);
+    write_console(errh, truename);
+    write_console(errh, L" not found or is not a bytecode executable file\r\n");
+    ExitProcess(2);
+#if _MSC_VER >= 1200
+    __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);
+#if _MSC_VER >= 1200
+    __assume(0); /* Not reached */
+#endif
+#ifdef __MINGW32__
+    return 0;
+#endif
+}
diff --git a/stdlib/int.ml b/stdlib/int.ml
new file mode 100644
index 00000000..b8f32cc0
--- /dev/null
+++ b/stdlib/int.ml
@@ -0,0 +1,50 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         The OCaml programmers                          *)
+(*                                                                        *)
+(*   Copyright 2018 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 = int
+
+let zero = 0
+let one = 1
+let minus_one = -1
+external neg : int -> int = "%negint"
+external add : int -> int -> int = "%addint"
+external sub : int -> int -> int = "%subint"
+external mul : int -> int -> int = "%mulint"
+external div : int -> int -> int = "%divint"
+external rem : int -> int -> int = "%modint"
+external succ : int -> int = "%succint"
+external pred : int -> int = "%predint"
+let abs x = if x >= 0 then x else -x
+let max_int = (-1) lsr 1
+let min_int = max_int + 1
+external logand : int -> int -> int = "%andint"
+external logor : int -> int -> int = "%orint"
+external logxor : int -> int -> int = "%xorint"
+let lognot x = logxor x (-1)
+external shift_left : int -> int -> int = "%lslint"
+external shift_right : int -> int -> int = "%asrint"
+external shift_right_logical : int -> int -> int = "%lsrint"
+let equal : int -> int -> bool = ( = )
+let compare : int -> int -> int = Stdlib.compare
+external to_float : int -> float = "%floatofint"
+external of_float : float -> int = "%intoffloat"
+
+(*
+external int_of_string : string -> int = "caml_int_of_string"
+let of_string s = try Some (int_of_string s) with Failure _ -> None
+*)
+
+external format_int : string -> int -> string = "caml_format_int"
+let to_string x = format_int "%d" x
diff --git a/stdlib/int.mli b/stdlib/int.mli
new file mode 100644
index 00000000..12a0167d
--- /dev/null
+++ b/stdlib/int.mli
@@ -0,0 +1,144 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         The OCaml programmers                          *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Integer values.
+
+    Integers are {!Sys.int_size} bits wide and use two's complement
+    representation. All operations are taken modulo
+    2{^[Sys.int_size]}. They do not fail on overflow.
+
+    @since 4.08 *)
+
+(** {1:ints Integers} *)
+
+type t = int
+(** The type for integer values. *)
+
+val zero : int
+(** [zero] is the integer [0]. *)
+
+val one : int
+(** [one] is the integer [1]. *)
+
+val minus_one : int
+(** [minus_one] is the integer [-1]. *)
+
+external neg : int -> int = "%negint"
+(** [neg x] is [~-x]. *)
+
+external add : int -> int -> int = "%addint"
+(** [add x y] is the addition [x + y]. *)
+
+external sub : int -> int -> int = "%subint"
+(** [sub x y] is the subtraction [x - y]. *)
+
+external mul : int -> int -> int = "%mulint"
+(** [mul x y] is the multiplication [x * y]. *)
+
+external div : int -> int -> int = "%divint"
+(** [div x y] is the division [x / y]. See {!Stdlib.( / )} for details. *)
+
+external rem : int -> int -> int = "%modint"
+(** [rem x y] is the remainder [x mod y]. See {!Stdlib.( mod )} for details. *)
+
+external succ : int -> int = "%succint"
+(** [succ x] is [add x 1]. *)
+
+external pred : int -> int = "%predint"
+(** [pred x] is [sub x 1]. *)
+
+val abs : int -> int
+(** [abs x] is the absolute value of [x]. That is [x] if [x] is positive
+    and [neg x] if [x] is negative. {b Warning.} This may be negative if
+    the argument is {!min_int}. *)
+
+val max_int : int
+(** [max_int] is the greatest representable integer,
+    [2{^[Sys.int_size - 1]} - 1]. *)
+
+val min_int : int
+(** [min_int] is the smallest representable integer,
+    [-2{^[Sys.int_size - 1]}]. *)
+
+external logand : int -> int -> int = "%andint"
+(** [logand x y] is the bitwise logical and of [x] and [y]. *)
+
+external logor : int -> int -> int = "%orint"
+(** [logor x y] is the bitwise logical or of [x] and [y]. *)
+
+external logxor : int -> int -> int = "%xorint"
+(** [logxor x y] is the bitwise logical exclusive or of [x] and [y]. *)
+
+val lognot : int -> int
+(** [lognot x] is the bitwise logical negation of [x]. *)
+
+external shift_left : int -> int -> int = "%lslint"
+(** [shift_left x n] shifts [x] to the left by [n] bits. The result
+    is unspecified if [n < 0] or [n > ]{!Sys.int_size}. *)
+
+external shift_right : int -> int -> int = "%asrint"
+(** [shift_right x n] shifts [x] to the right by [n] bits. This is an
+    arithmetic shift: the sign bit of [x] is replicated and inserted
+    in the vacated bits. The result is unspecified if [n < 0] or
+    [n > ]{!Sys.int_size}. *)
+
+external shift_right_logical : int -> int -> int = "%lsrint"
+(** [shift_right x n] shifts [x] to the right by [n] bits. This is a
+    logical shift: zeroes are inserted in the vacated bits regardless
+    of the sign of [x]. The result is unspecified if [n < 0] or
+    [n > ]{!Sys.int_size}. *)
+
+(** {1:preds Predicates and comparisons} *)
+
+val equal : int -> int -> bool
+(** [equal x y] is [true] iff [x = y]. *)
+
+val compare : int -> int -> int
+(** [compare x y] is {!Stdlib.compare}[ x y] but more efficient. *)
+
+(** {1:convert Converting} *)
+
+external to_float : int -> float = "%floatofint"
+(** [to_float x] is [x] as a floating point number. *)
+
+external of_float : float -> int = "%intoffloat"
+(** [of_float x] truncates [x] to an integer. The result is
+    unspecified if the argument is [nan] or falls outside the range of
+    representable integers. *)
+
+(*
+val of_string : string -> int option
+(** [of_string s] is [Some s] if [s] can be parsed to an integer
+    in the range representable by the type [int] (note that this
+    depends on {!Sys.int_size}) and [None] otherwise.
+
+    The string may start with an optional ['-'] or ['+'] sign, and may
+    be followed by an optional prefix that specifies the base in which
+    the number is expressed. If there is not prefix or if the prefix
+    is [0u] or [0U] it is expressed in decimal. If the prefix is [0x]
+    or [0X] it is expressed in hexadecimal. If the prefix is [0o] or
+    [0O] it is expressed in octal. If the prefix is [0b] or [0B] it is
+    expressed in binary.
+
+    When the [0u] or [0U] prefix is used, the represented number may
+    exceed {!max_int} or {!min_int} in which case it wraps around
+    modulo 2{^[Sys.int_size]} like arithmetic operations do.
+
+    The ['_'] (underscore) character can appear anywhere between two
+    digits of the number. *)
+*)
+
+val to_string : int -> string
+(** [to_string x] is the written representation of [x] in decimal. *)
diff --git a/stdlib/int32.ml b/stdlib/int32.ml
new file mode 100644
index 00000000..e159851e
--- /dev/null
+++ b/stdlib/int32.ml
@@ -0,0 +1,101 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Module [Int32]: 32-bit integers *)
+
+external neg : int32 -> int32 = "%int32_neg"
+external add : int32 -> int32 -> int32 = "%int32_add"
+external sub : int32 -> int32 -> int32 = "%int32_sub"
+external mul : int32 -> int32 -> int32 = "%int32_mul"
+external div : int32 -> int32 -> int32 = "%int32_div"
+external rem : int32 -> int32 -> int32 = "%int32_mod"
+external logand : int32 -> int32 -> int32 = "%int32_and"
+external logor : int32 -> int32 -> int32 = "%int32_or"
+external logxor : int32 -> int32 -> int32 = "%int32_xor"
+external shift_left : int32 -> int -> int32 = "%int32_lsl"
+external shift_right : int32 -> int -> int32 = "%int32_asr"
+external shift_right_logical : int32 -> int -> int32 = "%int32_lsr"
+external of_int : int -> int32 = "%int32_of_int"
+external to_int : int32 -> int = "%int32_to_int"
+external of_float : float -> int32
+  = "caml_int32_of_float" "caml_int32_of_float_unboxed"
+  [@@unboxed] [@@noalloc]
+external to_float : int32 -> float
+  = "caml_int32_to_float" "caml_int32_to_float_unboxed"
+  [@@unboxed] [@@noalloc]
+external bits_of_float : float -> int32
+  = "caml_int32_bits_of_float" "caml_int32_bits_of_float_unboxed"
+  [@@unboxed] [@@noalloc]
+external float_of_bits : int32 -> float
+  = "caml_int32_float_of_bits" "caml_int32_float_of_bits_unboxed"
+  [@@unboxed] [@@noalloc]
+
+let zero = 0l
+let one = 1l
+let minus_one = -1l
+let succ n = add n 1l
+let pred n = sub n 1l
+let abs n = if n >= 0l then n else neg n
+let min_int = 0x80000000l
+let max_int = 0x7FFFFFFFl
+let lognot n = logxor n (-1l)
+
+let unsigned_to_int =
+  match Sys.word_size with
+  | 32 ->
+      let max_int = of_int Stdlib.max_int in
+      fun n ->
+        if compare zero n <= 0 && compare n max_int <= 0 then
+          Some (to_int n)
+        else
+          None
+  | 64 ->
+      (* So that it compiles in 32-bit *)
+      let move = int_of_string "0x1_0000_0000" in
+      fun n -> let i = to_int n in Some (if i < 0 then i + move else i)
+  | _ ->
+      assert false
+
+external format : string -> int32 -> string = "caml_int32_format"
+let to_string n = format "%d" n
+
+external of_string : string -> int32 = "caml_int32_of_string"
+
+let of_string_opt s =
+  (* TODO: expose a non-raising primitive directly. *)
+  try Some (of_string s)
+  with Failure _ -> None
+
+type t = int32
+
+let compare (x: t) (y: t) = Stdlib.compare x y
+let equal (x: t) (y: t) = compare x y = 0
+
+let unsigned_compare n m =
+  compare (sub n min_int) (sub m min_int)
+
+(* Unsigned division from signed division of the same
+   bitness. See Warren Jr., Henry S. (2013). Hacker's Delight (2 ed.), Sec 9-3.
+*)
+let unsigned_div n d =
+  if d < zero then
+    if unsigned_compare n d < 0 then zero else one
+  else
+    let q = shift_left (div (shift_right_logical n 1) d) 1 in
+    let r = sub n (mul q d) in
+    if unsigned_compare r d >= 0 then succ q else q
+
+let unsigned_rem n d =
+  sub n (mul (unsigned_div n d) d)
diff --git a/stdlib/int32.mli b/stdlib/int32.mli
new file mode 100644
index 00000000..a80258c8
--- /dev/null
+++ b/stdlib/int32.mli
@@ -0,0 +1,224 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** 32-bit integers.
+
+   This module provides operations on the type [int32]
+   of signed 32-bit integers.  Unlike the built-in [int] type,
+   the type [int32] is guaranteed to be exactly 32-bit wide on all
+   platforms.  All arithmetic operations over [int32] are taken
+   modulo 2{^32}.
+
+   Performance notice: values of type [int32] occupy more memory
+   space than values of type [int], and arithmetic operations on
+   [int32] are generally slower than those on [int].  Use [int32]
+   only when the application requires exact 32-bit arithmetic.
+
+    Literals for 32-bit integers are suffixed by l:
+    {[
+      let zero: int32 = 0l
+      let one: int32 = 1l
+      let m_one: int32 = -1l
+    ]}
+*)
+
+val zero : int32
+(** The 32-bit integer 0. *)
+
+val one : int32
+(** The 32-bit integer 1. *)
+
+val minus_one : int32
+(** The 32-bit integer -1. *)
+
+external neg : int32 -> int32 = "%int32_neg"
+(** Unary negation. *)
+
+external add : int32 -> int32 -> int32 = "%int32_add"
+(** Addition. *)
+
+external sub : int32 -> int32 -> int32 = "%int32_sub"
+(** Subtraction. *)
+
+external mul : int32 -> int32 -> int32 = "%int32_mul"
+(** Multiplication. *)
+
+external div : int32 -> int32 -> int32 = "%int32_div"
+(** Integer division. This division rounds the real quotient of
+   its arguments towards zero, as specified for {!Stdlib.(/)}.
+   @raise Division_by_zero if the second
+   argument is zero.  *)
+
+val unsigned_div : int32 -> int32 -> int32
+(** Same as {!div}, except that arguments and result are interpreted as {e
+    unsigned} 32-bit integers.
+
+    @since 4.08.0 *)
+
+external rem : int32 -> int32 -> int32 = "%int32_mod"
+(** Integer remainder.  If [y] is not zero, the result
+   of [Int32.rem x y] satisfies the following property:
+   [x = Int32.add (Int32.mul (Int32.div x y) y) (Int32.rem x y)].
+   If [y = 0], [Int32.rem x y] raises [Division_by_zero]. *)
+
+val unsigned_rem : int32 -> int32 -> int32
+(** Same as {!rem}, except that arguments and result are interpreted as {e
+    unsigned} 32-bit integers.
+
+    @since 4.08.0 *)
+
+val succ : int32 -> int32
+(** Successor.  [Int32.succ x] is [Int32.add x Int32.one]. *)
+
+val pred : int32 -> int32
+(** Predecessor.  [Int32.pred x] is [Int32.sub x Int32.one]. *)
+
+val abs : int32 -> int32
+(** Return the absolute value of its argument. *)
+
+val max_int : int32
+(** The greatest representable 32-bit integer, 2{^31} - 1. *)
+
+val min_int : int32
+(** The smallest representable 32-bit integer, -2{^31}. *)
+
+
+external logand : int32 -> int32 -> int32 = "%int32_and"
+(** Bitwise logical and. *)
+
+external logor : int32 -> int32 -> int32 = "%int32_or"
+(** Bitwise logical or. *)
+
+external logxor : int32 -> int32 -> int32 = "%int32_xor"
+(** Bitwise logical exclusive or. *)
+
+val lognot : int32 -> int32
+(** Bitwise logical negation. *)
+
+external shift_left : int32 -> int -> int32 = "%int32_lsl"
+(** [Int32.shift_left x y] shifts [x] to the left by [y] bits.
+   The result is unspecified if [y < 0] or [y >= 32]. *)
+
+external shift_right : int32 -> int -> int32 = "%int32_asr"
+(** [Int32.shift_right x y] shifts [x] to the right by [y] bits.
+   This is an arithmetic shift: the sign bit of [x] is replicated
+   and inserted in the vacated bits.
+   The result is unspecified if [y < 0] or [y >= 32]. *)
+
+external shift_right_logical : int32 -> int -> int32 = "%int32_lsr"
+(** [Int32.shift_right_logical x y] shifts [x] to the right by [y] bits.
+   This is a logical shift: zeroes are inserted in the vacated bits
+   regardless of the sign of [x].
+   The result is unspecified if [y < 0] or [y >= 32]. *)
+
+external of_int : int -> int32 = "%int32_of_int"
+(** Convert the given integer (type [int]) to a 32-bit integer
+    (type [int32]). On 64-bit platforms, the argument is taken
+    modulo 2{^32}. *)
+
+external to_int : int32 -> int = "%int32_to_int"
+(** Convert the given 32-bit integer (type [int32]) to an
+   integer (type [int]).  On 32-bit platforms, the 32-bit integer
+   is taken modulo 2{^31}, i.e. the high-order bit is lost
+   during the conversion.  On 64-bit platforms, the conversion
+   is exact. *)
+
+val unsigned_to_int : int32 -> int option
+(** Same as {!to_int}, but interprets the argument as an {e unsigned} integer.
+    Returns [None] if the unsigned value of the argument cannot fit into an
+    [int].
+
+    @since 4.08.0 *)
+
+external of_float : float -> int32
+  = "caml_int32_of_float" "caml_int32_of_float_unboxed"
+  [@@unboxed] [@@noalloc]
+(** Convert the given floating-point number to a 32-bit integer,
+   discarding the fractional part (truncate towards 0).
+   The result of the conversion is undefined if, after truncation,
+   the number is outside the range \[{!Int32.min_int}, {!Int32.max_int}\]. *)
+
+external to_float : int32 -> float
+  = "caml_int32_to_float" "caml_int32_to_float_unboxed"
+  [@@unboxed] [@@noalloc]
+(** Convert the given 32-bit integer to a floating-point number. *)
+
+external of_string : string -> int32 = "caml_int32_of_string"
+(** Convert the given string to a 32-bit integer.
+   The string is read in decimal (by default, or if the string
+   begins with [0u]) or in hexadecimal, octal or binary if the
+   string begins with [0x], [0o] or [0b] respectively.
+
+   The [0u] prefix reads the input as an unsigned integer in the range
+   [[0, 2*Int32.max_int+1]].  If the input exceeds {!Int32.max_int}
+   it is converted to the signed integer
+   [Int32.min_int + input - Int32.max_int - 1].
+
+   The [_] (underscore) character can appear anywhere in the string
+   and is ignored.
+   @raise Failure if the given string is not
+   a valid representation of an integer, or if the integer represented
+   exceeds the range of integers representable in type [int32]. *)
+
+val of_string_opt: string -> int32 option
+(** Same as [of_string], but return [None] instead of raising.
+    @since 4.05 *)
+
+
+val to_string : int32 -> string
+(** Return the string representation of its argument, in signed decimal. *)
+
+external bits_of_float : float -> int32
+  = "caml_int32_bits_of_float" "caml_int32_bits_of_float_unboxed"
+  [@@unboxed] [@@noalloc]
+(** Return the internal representation of the given float according
+   to the IEEE 754 floating-point 'single format' bit layout.
+   Bit 31 of the result represents the sign of the float;
+   bits 30 to 23 represent the (biased) exponent; bits 22 to 0
+   represent the mantissa. *)
+
+external float_of_bits : int32 -> float
+  = "caml_int32_float_of_bits" "caml_int32_float_of_bits_unboxed"
+  [@@unboxed] [@@noalloc]
+(** Return the floating-point number whose internal representation,
+   according to the IEEE 754 floating-point 'single format' bit layout,
+   is the given [int32]. *)
+
+type t = int32
+(** An alias for the type of 32-bit integers. *)
+
+val compare: t -> t -> int
+(** The comparison function for 32-bit integers, with the same specification as
+    {!Stdlib.compare}.  Along with the type [t], this function [compare]
+    allows the module [Int32] to be passed as argument to the functors
+    {!Set.Make} and {!Map.Make}. *)
+
+val unsigned_compare: t -> t -> int
+(** Same as {!compare}, except that arguments are interpreted as {e unsigned}
+    32-bit integers.
+
+    @since 4.08.0 *)
+
+val equal: t -> t -> bool
+(** The equal function for int32s.
+    @since 4.03.0 *)
+
+(**/**)
+
+(** {1 Deprecated functions} *)
+
+external format : string -> int32 -> string = "caml_int32_format"
+(** Do not use this deprecated function.  Instead,
+   used {!Printf.sprintf} with a [%l...] format. *)
diff --git a/stdlib/int64.ml b/stdlib/int64.ml
new file mode 100644
index 00000000..1640368d
--- /dev/null
+++ b/stdlib/int64.ml
@@ -0,0 +1,100 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Module [Int64]: 64-bit integers *)
+
+external neg : int64 -> int64 = "%int64_neg"
+external add : int64 -> int64 -> int64 = "%int64_add"
+external sub : int64 -> int64 -> int64 = "%int64_sub"
+external mul : int64 -> int64 -> int64 = "%int64_mul"
+external div : int64 -> int64 -> int64 = "%int64_div"
+external rem : int64 -> int64 -> int64 = "%int64_mod"
+external logand : int64 -> int64 -> int64 = "%int64_and"
+external logor : int64 -> int64 -> int64 = "%int64_or"
+external logxor : int64 -> int64 -> int64 = "%int64_xor"
+external shift_left : int64 -> int -> int64 = "%int64_lsl"
+external shift_right : int64 -> int -> int64 = "%int64_asr"
+external shift_right_logical : int64 -> int -> int64 = "%int64_lsr"
+external of_int : int -> int64 = "%int64_of_int"
+external to_int : int64 -> int = "%int64_to_int"
+external of_float : float -> int64
+  = "caml_int64_of_float" "caml_int64_of_float_unboxed"
+  [@@unboxed] [@@noalloc]
+external to_float : int64 -> float
+  = "caml_int64_to_float" "caml_int64_to_float_unboxed"
+  [@@unboxed] [@@noalloc]
+external of_int32 : int32 -> int64 = "%int64_of_int32"
+external to_int32 : int64 -> int32 = "%int64_to_int32"
+external of_nativeint : nativeint -> int64 = "%int64_of_nativeint"
+external to_nativeint : int64 -> nativeint = "%int64_to_nativeint"
+
+let zero = 0L
+let one = 1L
+let minus_one = -1L
+let succ n = add n 1L
+let pred n = sub n 1L
+let abs n = if n >= 0L then n else neg n
+let min_int = 0x8000000000000000L
+let max_int = 0x7FFFFFFFFFFFFFFFL
+let lognot n = logxor n (-1L)
+
+let unsigned_to_int =
+  let max_int = of_int Stdlib.max_int in
+  fun n ->
+    if compare zero n <= 0 && compare n max_int <= 0 then
+      Some (to_int n)
+    else
+      None
+
+external format : string -> int64 -> string = "caml_int64_format"
+let to_string n = format "%d" n
+
+external of_string : string -> int64 = "caml_int64_of_string"
+
+let of_string_opt s =
+  (* TODO: expose a non-raising primitive directly. *)
+  try Some (of_string s)
+  with Failure _ -> None
+
+
+
+external bits_of_float : float -> int64
+  = "caml_int64_bits_of_float" "caml_int64_bits_of_float_unboxed"
+  [@@unboxed] [@@noalloc]
+external float_of_bits : int64 -> float
+  = "caml_int64_float_of_bits" "caml_int64_float_of_bits_unboxed"
+  [@@unboxed] [@@noalloc]
+
+type t = int64
+
+let compare (x: t) (y: t) = Stdlib.compare x y
+let equal (x: t) (y: t) = compare x y = 0
+
+let unsigned_compare n m =
+  compare (sub n min_int) (sub m min_int)
+
+(* Unsigned division from signed division of the same
+   bitness. See Warren Jr., Henry S. (2013). Hacker's Delight (2 ed.), Sec 9-3.
+*)
+let unsigned_div n d =
+  if d < zero then
+    if unsigned_compare n d < 0 then zero else one
+  else
+    let q = shift_left (div (shift_right_logical n 1) d) 1 in
+    let r = sub n (mul q d) in
+    if unsigned_compare r d >= 0 then succ q else q
+
+let unsigned_rem n d =
+  sub n (mul (unsigned_div n d) d)
diff --git a/stdlib/int64.mli b/stdlib/int64.mli
new file mode 100644
index 00000000..07f51fb1
--- /dev/null
+++ b/stdlib/int64.mli
@@ -0,0 +1,243 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** 64-bit integers.
+
+   This module provides operations on the type [int64] of
+   signed 64-bit integers.  Unlike the built-in [int] type,
+   the type [int64] is guaranteed to be exactly 64-bit wide on all
+   platforms.  All arithmetic operations over [int64] are taken
+   modulo 2{^64}
+
+   Performance notice: values of type [int64] occupy more memory
+   space than values of type [int], and arithmetic operations on
+   [int64] are generally slower than those on [int].  Use [int64]
+   only when the application requires exact 64-bit arithmetic.
+
+    Literals for 64-bit integers are suffixed by L:
+    {[
+      let zero: int64 = 0L
+      let one: int64 = 1L
+      let m_one: int64 = -1L
+    ]}
+*)
+
+val zero : int64
+(** The 64-bit integer 0. *)
+
+val one : int64
+(** The 64-bit integer 1. *)
+
+val minus_one : int64
+(** The 64-bit integer -1. *)
+
+external neg : int64 -> int64 = "%int64_neg"
+(** Unary negation. *)
+
+external add : int64 -> int64 -> int64 = "%int64_add"
+(** Addition. *)
+
+external sub : int64 -> int64 -> int64 = "%int64_sub"
+(** Subtraction. *)
+
+external mul : int64 -> int64 -> int64 = "%int64_mul"
+(** Multiplication. *)
+
+external div : int64 -> int64 -> int64 = "%int64_div"
+(** Integer division.
+   @raise Division_by_zero if the second
+   argument is zero.  This division rounds the real quotient of
+   its arguments towards zero, as specified for {!Stdlib.(/)}. *)
+
+val unsigned_div : int64 -> int64 -> int64
+(** Same as {!div}, except that arguments and result are interpreted as {e
+    unsigned} 64-bit integers.
+
+    @since 4.08.0 *)
+
+external rem : int64 -> int64 -> int64 = "%int64_mod"
+(** Integer remainder.  If [y] is not zero, the result
+   of [Int64.rem x y] satisfies the following property:
+   [x = Int64.add (Int64.mul (Int64.div x y) y) (Int64.rem x y)].
+   If [y = 0], [Int64.rem x y] raises [Division_by_zero]. *)
+
+val unsigned_rem : int64 -> int64 -> int64
+(** Same as {!rem}, except that arguments and result are interpreted as {e
+    unsigned} 64-bit integers.
+
+    @since 4.08.0 *)
+
+val succ : int64 -> int64
+(** Successor.  [Int64.succ x] is [Int64.add x Int64.one]. *)
+
+val pred : int64 -> int64
+(** Predecessor.  [Int64.pred x] is [Int64.sub x Int64.one]. *)
+
+val abs : int64 -> int64
+(** Return the absolute value of its argument. *)
+
+val max_int : int64
+(** The greatest representable 64-bit integer, 2{^63} - 1. *)
+
+val min_int : int64
+(** The smallest representable 64-bit integer, -2{^63}. *)
+
+external logand : int64 -> int64 -> int64 = "%int64_and"
+(** Bitwise logical and. *)
+
+external logor : int64 -> int64 -> int64 = "%int64_or"
+(** Bitwise logical or. *)
+
+external logxor : int64 -> int64 -> int64 = "%int64_xor"
+(** Bitwise logical exclusive or. *)
+
+val lognot : int64 -> int64
+(** Bitwise logical negation. *)
+
+external shift_left : int64 -> int -> int64 = "%int64_lsl"
+(** [Int64.shift_left x y] shifts [x] to the left by [y] bits.
+   The result is unspecified if [y < 0] or [y >= 64]. *)
+
+external shift_right : int64 -> int -> int64 = "%int64_asr"
+(** [Int64.shift_right x y] shifts [x] to the right by [y] bits.
+   This is an arithmetic shift: the sign bit of [x] is replicated
+   and inserted in the vacated bits.
+   The result is unspecified if [y < 0] or [y >= 64]. *)
+
+external shift_right_logical : int64 -> int -> int64 = "%int64_lsr"
+(** [Int64.shift_right_logical x y] shifts [x] to the right by [y] bits.
+   This is a logical shift: zeroes are inserted in the vacated bits
+   regardless of the sign of [x].
+   The result is unspecified if [y < 0] or [y >= 64]. *)
+
+external of_int : int -> int64 = "%int64_of_int"
+(** Convert the given integer (type [int]) to a 64-bit integer
+    (type [int64]). *)
+
+external to_int : int64 -> int = "%int64_to_int"
+(** Convert the given 64-bit integer (type [int64]) to an
+   integer (type [int]).  On 64-bit platforms, the 64-bit integer
+   is taken modulo 2{^63}, i.e. the high-order bit is lost
+   during the conversion.  On 32-bit platforms, the 64-bit integer
+   is taken modulo 2{^31}, i.e. the top 33 bits are lost
+   during the conversion. *)
+
+val unsigned_to_int : int64 -> int option
+(** Same as {!to_int}, but interprets the argument as an {e unsigned} integer.
+    Returns [None] if the unsigned value of the argument cannot fit into an
+    [int].
+
+    @since 4.08.0 *)
+
+external of_float : float -> int64
+  = "caml_int64_of_float" "caml_int64_of_float_unboxed"
+  [@@unboxed] [@@noalloc]
+(** Convert the given floating-point number to a 64-bit integer,
+   discarding the fractional part (truncate towards 0).
+   The result of the conversion is undefined if, after truncation,
+   the number is outside the range \[{!Int64.min_int}, {!Int64.max_int}\]. *)
+
+external to_float : int64 -> float
+  = "caml_int64_to_float" "caml_int64_to_float_unboxed"
+  [@@unboxed] [@@noalloc]
+(** Convert the given 64-bit integer to a floating-point number. *)
+
+
+external of_int32 : int32 -> int64 = "%int64_of_int32"
+(** Convert the given 32-bit integer (type [int32])
+   to a 64-bit integer (type [int64]). *)
+
+external to_int32 : int64 -> int32 = "%int64_to_int32"
+(** Convert the given 64-bit integer (type [int64]) to a
+   32-bit integer (type [int32]). The 64-bit integer
+   is taken modulo 2{^32}, i.e. the top 32 bits are lost
+   during the conversion.  *)
+
+external of_nativeint : nativeint -> int64 = "%int64_of_nativeint"
+(** Convert the given native integer (type [nativeint])
+   to a 64-bit integer (type [int64]). *)
+
+external to_nativeint : int64 -> nativeint = "%int64_to_nativeint"
+(** Convert the given 64-bit integer (type [int64]) to a
+   native integer.  On 32-bit platforms, the 64-bit integer
+   is taken modulo 2{^32}.  On 64-bit platforms,
+   the conversion is exact. *)
+
+external of_string : string -> int64 = "caml_int64_of_string"
+(** Convert the given string to a 64-bit integer.
+   The string is read in decimal (by default, or if the string
+   begins with [0u]) or in hexadecimal, octal or binary if the
+   string begins with [0x], [0o] or [0b] respectively.
+
+   The [0u] prefix reads the input as an unsigned integer in the range
+   [[0, 2*Int64.max_int+1]].  If the input exceeds {!Int64.max_int}
+   it is converted to the signed integer
+   [Int64.min_int + input - Int64.max_int - 1].
+
+   The [_] (underscore) character can appear anywhere in the string
+   and is ignored.
+   @raise Failure if the given string is not
+   a valid representation of an integer, or if the integer represented
+   exceeds the range of integers representable in type [int64]. *)
+
+val of_string_opt: string -> int64 option
+(** Same as [of_string], but return [None] instead of raising.
+    @since 4.05 *)
+
+val to_string : int64 -> string
+(** Return the string representation of its argument, in decimal. *)
+
+external bits_of_float : float -> int64
+  = "caml_int64_bits_of_float" "caml_int64_bits_of_float_unboxed"
+  [@@unboxed] [@@noalloc]
+(** Return the internal representation of the given float according
+   to the IEEE 754 floating-point 'double format' bit layout.
+   Bit 63 of the result represents the sign of the float;
+   bits 62 to 52 represent the (biased) exponent; bits 51 to 0
+   represent the mantissa. *)
+
+external float_of_bits : int64 -> float
+  = "caml_int64_float_of_bits" "caml_int64_float_of_bits_unboxed"
+  [@@unboxed] [@@noalloc]
+(** Return the floating-point number whose internal representation,
+   according to the IEEE 754 floating-point 'double format' bit layout,
+   is the given [int64]. *)
+
+type t = int64
+(** An alias for the type of 64-bit integers. *)
+
+val compare: t -> t -> int
+(** The comparison function for 64-bit integers, with the same specification as
+    {!Stdlib.compare}.  Along with the type [t], this function [compare]
+    allows the module [Int64] to be passed as argument to the functors
+    {!Set.Make} and {!Map.Make}. *)
+
+val unsigned_compare: t -> t -> int
+(** Same as {!compare}, except that arguments are interpreted as {e unsigned}
+    64-bit integers.
+
+    @since 4.08.0 *)
+
+val equal: t -> t -> bool
+(** The equal function for int64s.
+    @since 4.03.0 *)
+
+(**/**)
+
+(** {1 Deprecated functions} *)
+
+external format : string -> int64 -> string = "caml_int64_format"
+(** Do not use this deprecated function.  Instead,
+   used {!Printf.sprintf} with a [%L...] format. *)
diff --git a/stdlib/lazy.ml b/stdlib/lazy.ml
new file mode 100644
index 00000000..317f925c
--- /dev/null
+++ b/stdlib/lazy.ml
@@ -0,0 +1,83 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Damien Doligez, projet Para, INRIA Rocquencourt            *)
+(*                                                                        *)
+(*   Copyright 1997 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 [Lazy]: deferred computations *)
+
+
+(*
+   WARNING: some purple magic is going on here.  Do not take this file
+   as an example of how to program in OCaml.
+*)
+
+
+(* We make use of two special tags provided by the runtime:
+   [lazy_tag] and [forward_tag].
+
+   A value of type ['a Lazy.t] can be one of three things:
+   1. A block of size 1 with tag [lazy_tag].  Its field is a closure of
+      type [unit -> 'a] that computes the value.
+   2. A block of size 1 with tag [forward_tag].  Its field is the value
+      of type ['a] that was computed.
+   3. Anything else except a float.  This has type ['a] and is the value
+      that was computed.
+   Exceptions are stored in format (1).
+   The GC will magically change things from (2) to (3) according to its
+   fancy.
+
+   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
+   [Double_tag].
+
+   We have to use the built-in type constructor [lazy_t] to
+   let the compiler implement the special typing and compilation
+   rules for the [lazy] keyword.
+*)
+
+type 'a t = 'a CamlinternalLazy.t
+
+exception Undefined = CamlinternalLazy.Undefined
+
+external make_forward : 'a -> 'a lazy_t = "caml_lazy_make_forward"
+
+external force : 'a t -> 'a = "%lazy_force"
+
+(* let force = force *)
+
+let force_val = CamlinternalLazy.force_val
+
+let from_fun (f : unit -> 'arg) =
+  let x = Obj.new_block Obj.lazy_tag 1 in
+  Obj.set_field x 0 (Obj.repr f);
+  (Obj.obj x : 'arg t)
+
+
+let from_val (v : 'arg) =
+  let t = Obj.tag (Obj.repr v) in
+  if t = Obj.forward_tag || t = Obj.lazy_tag || t = Obj.double_tag then begin
+    make_forward v
+  end else begin
+    (Obj.magic v : 'arg t)
+  end
+
+
+let is_val (l : 'arg t) = Obj.tag (Obj.repr l) <> Obj.lazy_tag
+
+let lazy_from_fun = from_fun
+
+let lazy_from_val = from_val
+
+let lazy_is_val = is_val
diff --git a/stdlib/lazy.mli b/stdlib/lazy.mli
new file mode 100644
index 00000000..b71e21bb
--- /dev/null
+++ b/stdlib/lazy.mli
@@ -0,0 +1,111 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Damien Doligez, projet Para, INRIA Rocquencourt            *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Deferred computations. *)
+
+type 'a t = 'a CamlinternalLazy.t
+(** A value of type ['a Lazy.t] is a deferred computation, called
+   a suspension, that has a result of type ['a].  The special
+   expression syntax [lazy (expr)] makes a suspension of the
+   computation of [expr], without computing [expr] itself yet.
+   "Forcing" the suspension will then compute [expr] and return its
+   result. Matching a suspension with the special pattern syntax
+   [lazy(pattern)] also computes the underlying expression and
+   tries to bind it to [pattern]:
+
+  {[
+    let lazy_option_map f x =
+    match x with
+    | lazy (Some x) -> Some (Lazy.force f x)
+    | _ -> None
+  ]}
+
+   Note: If lazy patterns appear in multiple cases in a pattern-matching,
+   lazy expressions may be forced even outside of the case ultimately selected
+   by the pattern matching. In the example above, the suspension [x] is always
+   computed.
+
+
+   Note: [lazy_t] is the built-in type constructor used by the compiler
+   for the [lazy] keyword.  You should not use it directly.  Always use
+   [Lazy.t] instead.
+
+   Note: [Lazy.force] is not thread-safe.  If you use this module in
+   a multi-threaded program, you will need to add some locks.
+
+   Note: if the program is compiled with the [-rectypes] option,
+   ill-founded recursive definitions of the form [let rec x = lazy x]
+   or [let rec x = lazy(lazy(...(lazy x)))] are accepted by the type-checker
+   and lead, when forced, to ill-formed values that trigger infinite
+   loops in the garbage collector and other parts of the run-time system.
+   Without the [-rectypes] option, such ill-founded recursive definitions
+   are rejected by the type-checker.
+*)
+
+
+exception Undefined
+
+(* val force : 'a t -> 'a  *)
+external force : 'a t -> 'a = "%lazy_force"
+(** [force x] forces the suspension [x] and returns its result.
+   If [x] has already been forced, [Lazy.force x] returns the
+   same value again without recomputing it.  If it raised an exception,
+   the same exception is raised again.
+   @raise Undefined if the forcing of [x] tries to force [x] itself
+   recursively.
+*)
+
+val force_val : 'a t -> 'a
+(** [force_val x] forces the suspension [x] and returns its
+    result.  If [x] has already been forced, [force_val x]
+    returns the same value again without recomputing it.
+
+    If the computation of [x] raises an exception, it is unspecified
+    whether [force_val x] raises the same exception or {!Undefined}.
+    @raise Undefined if the forcing of [x] tries to force [x] itself
+    recursively.
+*)
+
+val from_fun : (unit -> 'a) -> 'a t
+(** [from_fun f] is the same as [lazy (f ())] but slightly more efficient.
+
+    [from_fun] should only be used if the function [f] is already defined.
+    In particular it is always less efficient to write
+    [from_fun (fun () -> expr)] than [lazy expr].
+
+    @since 4.00.0 *)
+
+val from_val : 'a -> 'a t
+(** [from_val v] returns an already-forced suspension of [v].
+    This is for special purposes only and should not be confused with
+    [lazy (v)].
+    @since 4.00.0 *)
+
+val is_val : 'a t -> bool
+(** [is_val x] returns [true] if [x] has already been forced and
+    did not raise an exception.
+    @since 4.00.0 *)
+
+val lazy_from_fun : (unit -> 'a) -> 'a t
+  [@@ocaml.deprecated "Use Lazy.from_fun instead."]
+(** @deprecated synonym for [from_fun]. *)
+
+val lazy_from_val : 'a -> 'a t
+  [@@ocaml.deprecated "Use Lazy.from_val instead."]
+(** @deprecated synonym for [from_val]. *)
+
+val lazy_is_val : 'a t -> bool
+  [@@ocaml.deprecated "Use Lazy.is_val instead."]
+(** @deprecated synonym for [is_val]. *)
diff --git a/stdlib/lexing.ml b/stdlib/lexing.ml
new file mode 100644
index 00000000..265ee270
--- /dev/null
+++ b/stdlib/lexing.ml
@@ -0,0 +1,244 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The run-time library for lexers generated by camllex *)
+
+type position = {
+  pos_fname : string;
+  pos_lnum : int;
+  pos_bol : int;
+  pos_cnum : int;
+}
+
+let dummy_pos = {
+  pos_fname = "";
+  pos_lnum = 0;
+  pos_bol = 0;
+  pos_cnum = -1;
+}
+
+type lexbuf =
+  { refill_buff : lexbuf -> unit;
+    mutable lex_buffer : bytes;
+    mutable lex_buffer_len : int;
+    mutable lex_abs_pos : int;
+    mutable lex_start_pos : int;
+    mutable lex_curr_pos : int;
+    mutable lex_last_pos : int;
+    mutable lex_last_action : int;
+    mutable lex_eof_reached : bool;
+    mutable lex_mem : int array;
+    mutable lex_start_p : position;
+    mutable lex_curr_p : position;
+  }
+
+type lex_tables =
+  { lex_base: string;
+    lex_backtrk: string;
+    lex_default: string;
+    lex_trans: string;
+    lex_check: string;
+    lex_base_code : string;
+    lex_backtrk_code : string;
+    lex_default_code : string;
+    lex_trans_code : string;
+    lex_check_code : string;
+    lex_code: string;}
+
+external c_engine : lex_tables -> int -> lexbuf -> int = "caml_lex_engine"
+external c_new_engine : lex_tables -> int -> lexbuf -> int
+                      = "caml_new_lex_engine"
+
+let engine tbl state buf =
+  let result = c_engine tbl state buf in
+  if result >= 0 && buf.lex_curr_p != dummy_pos then begin
+    buf.lex_start_p <- buf.lex_curr_p;
+    buf.lex_curr_p <- {buf.lex_curr_p
+                       with pos_cnum = buf.lex_abs_pos + buf.lex_curr_pos};
+  end;
+  result
+
+
+let new_engine tbl state buf =
+  let result = c_new_engine tbl state buf in
+  if result >= 0 && buf.lex_curr_p != dummy_pos then begin
+    buf.lex_start_p <- buf.lex_curr_p;
+    buf.lex_curr_p <- {buf.lex_curr_p
+                       with pos_cnum = buf.lex_abs_pos + buf.lex_curr_pos};
+  end;
+  result
+
+
+let lex_refill read_fun aux_buffer lexbuf =
+  let read =
+    read_fun aux_buffer (Bytes.length aux_buffer) in
+  let n =
+    if read > 0
+    then read
+    else (lexbuf.lex_eof_reached <- true; 0) in
+  (* Current state of the buffer:
+        <-------|---------------------|----------->
+        |  junk |      valid data     |   junk    |
+        ^       ^                     ^           ^
+        0    start_pos             buffer_end    Bytes.length buffer
+  *)
+  if lexbuf.lex_buffer_len + n > Bytes.length lexbuf.lex_buffer then begin
+    (* There is not enough space at the end of the buffer *)
+    if lexbuf.lex_buffer_len - lexbuf.lex_start_pos + n
+       <= Bytes.length lexbuf.lex_buffer
+    then begin
+      (* But there is enough space if we reclaim the junk at the beginning
+         of the buffer *)
+      Bytes.blit lexbuf.lex_buffer lexbuf.lex_start_pos
+                  lexbuf.lex_buffer 0
+                  (lexbuf.lex_buffer_len - lexbuf.lex_start_pos)
+    end else begin
+      (* We must grow the buffer.  Doubling its size will provide enough
+         space since n <= String.length aux_buffer <= String.length buffer.
+         Watch out for string length overflow, though. *)
+      let newlen =
+        min (2 * Bytes.length lexbuf.lex_buffer) Sys.max_string_length in
+      if lexbuf.lex_buffer_len - lexbuf.lex_start_pos + n > newlen
+      then failwith "Lexing.lex_refill: cannot grow buffer";
+      let newbuf = Bytes.create newlen in
+      (* Copy the valid data to the beginning of the new buffer *)
+      Bytes.blit lexbuf.lex_buffer lexbuf.lex_start_pos
+                  newbuf 0
+                  (lexbuf.lex_buffer_len - lexbuf.lex_start_pos);
+      lexbuf.lex_buffer <- newbuf
+    end;
+    (* Reallocation or not, we have shifted the data left by
+       start_pos characters; update the positions *)
+    let s = lexbuf.lex_start_pos in
+    lexbuf.lex_abs_pos <- lexbuf.lex_abs_pos + s;
+    lexbuf.lex_curr_pos <- lexbuf.lex_curr_pos - s;
+    lexbuf.lex_start_pos <- 0;
+    lexbuf.lex_last_pos <- lexbuf.lex_last_pos - s;
+    lexbuf.lex_buffer_len <- lexbuf.lex_buffer_len - s ;
+    let t = lexbuf.lex_mem in
+    for i = 0 to Array.length t-1 do
+      let v = t.(i) in
+      if v >= 0 then
+        t.(i) <- v-s
+    done
+  end;
+  (* There is now enough space at the end of the buffer *)
+  Bytes.blit aux_buffer 0 lexbuf.lex_buffer lexbuf.lex_buffer_len n;
+  lexbuf.lex_buffer_len <- lexbuf.lex_buffer_len + n
+
+let zero_pos = {
+  pos_fname = "";
+  pos_lnum = 1;
+  pos_bol = 0;
+  pos_cnum = 0;
+}
+
+let from_function ?(with_positions = true) f =
+  { refill_buff = lex_refill f (Bytes.create 512);
+    lex_buffer = Bytes.create 1024;
+    lex_buffer_len = 0;
+    lex_abs_pos = 0;
+    lex_start_pos = 0;
+    lex_curr_pos = 0;
+    lex_last_pos = 0;
+    lex_last_action = 0;
+    lex_mem = [||];
+    lex_eof_reached = false;
+    lex_start_p = if with_positions then zero_pos else dummy_pos;
+    lex_curr_p = if with_positions then zero_pos else dummy_pos;
+  }
+
+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 =
+  { 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_abs_pos = 0;
+    lex_start_pos = 0;
+    lex_curr_pos = 0;
+    lex_last_pos = 0;
+    lex_last_action = 0;
+    lex_mem = [||];
+    lex_eof_reached = true;
+    lex_start_p = if with_positions then zero_pos else dummy_pos;
+    lex_curr_p = if with_positions then zero_pos else dummy_pos;
+  }
+
+let set_position lexbuf position =
+  lexbuf.lex_curr_p  <- {position with pos_fname = lexbuf.lex_curr_p.pos_fname};
+  lexbuf.lex_abs_pos <- position.pos_cnum
+
+let set_filename lexbuf fname =
+  lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname = fname}
+
+let with_positions lexbuf = lexbuf.lex_curr_p != dummy_pos
+
+let lexeme lexbuf =
+  let len = lexbuf.lex_curr_pos - lexbuf.lex_start_pos in
+  Bytes.sub_string lexbuf.lex_buffer lexbuf.lex_start_pos len
+
+let sub_lexeme lexbuf i1 i2 =
+  let len = i2-i1 in
+  Bytes.sub_string lexbuf.lex_buffer i1 len
+
+let sub_lexeme_opt lexbuf i1 i2 =
+  if i1 >= 0 then begin
+    let len = i2-i1 in
+    Some (Bytes.sub_string lexbuf.lex_buffer i1 len)
+  end else begin
+    None
+  end
+
+let sub_lexeme_char lexbuf i = Bytes.get lexbuf.lex_buffer i
+
+let sub_lexeme_char_opt lexbuf i =
+  if i >= 0 then
+    Some (Bytes.get lexbuf.lex_buffer i)
+  else
+    None
+
+
+let lexeme_char lexbuf i =
+  Bytes.get lexbuf.lex_buffer (lexbuf.lex_start_pos + i)
+
+let lexeme_start lexbuf = lexbuf.lex_start_p.pos_cnum
+let lexeme_end lexbuf = lexbuf.lex_curr_p.pos_cnum
+
+let lexeme_start_p lexbuf = lexbuf.lex_start_p
+let lexeme_end_p lexbuf = lexbuf.lex_curr_p
+
+let new_line lexbuf =
+  let lcp = lexbuf.lex_curr_p in
+  if lcp != dummy_pos then
+    lexbuf.lex_curr_p <-
+      { lcp with
+        pos_lnum = lcp.pos_lnum + 1;
+        pos_bol = lcp.pos_cnum;
+      }
+
+
+
+(* Discard data left in lexer buffer. *)
+
+let flush_input lb =
+  lb.lex_curr_pos <- 0;
+  lb.lex_abs_pos <- 0;
+  let lcp = lb.lex_curr_p in
+  if lcp != dummy_pos then
+    lb.lex_curr_p <- {zero_pos with pos_fname = lcp.pos_fname};
+  lb.lex_buffer_len <- 0;
diff --git a/stdlib/lexing.mli b/stdlib/lexing.mli
new file mode 100644
index 00000000..0dfe6656
--- /dev/null
+++ b/stdlib/lexing.mli
@@ -0,0 +1,214 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The run-time library for lexers generated by [ocamllex]. *)
+
+(** {1 Positions} *)
+
+type position = {
+  pos_fname : string;
+  pos_lnum : int;
+  pos_bol : int;
+  pos_cnum : int;
+}
+(** A value of type [position] describes a point in a source file.
+   [pos_fname] is the file name; [pos_lnum] is the line number;
+   [pos_bol] is the offset of the beginning of the line (number
+   of characters between the beginning of the lexbuf and the beginning
+   of the line); [pos_cnum] is the offset of the position (number of
+   characters between the beginning of the lexbuf and the position).
+   The difference between [pos_cnum] and [pos_bol] is the character
+   offset within the line (i.e. the column number, assuming each
+   character is one column wide).
+
+   See the documentation of type [lexbuf] for information about
+   how the lexing engine will manage positions.
+ *)
+
+val dummy_pos : position
+(** A value of type [position], guaranteed to be different from any
+   valid position.
+ *)
+
+
+(** {1 Lexer buffers} *)
+
+
+type lexbuf =
+  { refill_buff : lexbuf -> unit;
+    mutable lex_buffer : bytes;
+    mutable lex_buffer_len : int;
+    mutable lex_abs_pos : int;
+    mutable lex_start_pos : int;
+    mutable lex_curr_pos : int;
+    mutable lex_last_pos : int;
+    mutable lex_last_action : int;
+    mutable lex_eof_reached : bool;
+    mutable lex_mem : int array;
+    mutable lex_start_p : position;
+    mutable lex_curr_p : position;
+  }
+(** The type of lexer buffers. A lexer buffer is the argument passed
+   to the scanning functions defined by the generated scanners.
+   The lexer buffer holds the current state of the scanner, plus
+   a function to refill the buffer from the input.
+
+   Lexers can optionally maintain the [lex_curr_p] and [lex_start_p]
+   position fields.  This "position tracking" mode is the default, and
+   it corresponds to passing [~with_position:true] to functions that
+   create lexer buffers. In this mode, the lexing engine and lexer
+   actions are co-responsible for properly updating the position
+   fields, as described in the next paragraph.  When the mode is
+   explicitly disabled (with [~with_position:false]), the lexing
+   engine will not touch the position fields and the lexer actions
+   should be careful not to do it either; the [lex_curr_p] and
+   [lex_start_p] field will then always hold the [dummy_pos] invalid
+   position.  Not tracking positions avoids allocations and memory
+   writes and can significantly improve the performance of the lexer
+   in contexts where [lex_start_p] and [lex_curr_p] are not needed.
+
+   Position tracking mode works as follows.  At each token, the lexing
+   engine will copy [lex_curr_p] to [lex_start_p], then change the
+   [pos_cnum] field of [lex_curr_p] by updating it with the number of
+   characters read since the start of the [lexbuf].  The other fields
+   are left unchanged by the lexing engine.  In order to keep them
+   accurate, they must be initialised before the first use of the
+   lexbuf, and updated by the relevant lexer actions (i.e. at each end
+   of line -- see also [new_line]).
+*)
+
+val from_channel : ?with_positions:bool -> in_channel -> lexbuf
+(** Create a lexer buffer on the given input channel.
+   [Lexing.from_channel inchan] returns a lexer buffer which reads
+   from the input channel [inchan], at the current reading position. *)
+
+val from_string : ?with_positions:bool -> string -> lexbuf
+(** Create a lexer buffer which reads from
+   the given string. Reading starts from the first character in
+   the string. An end-of-input condition is generated when the
+   end of the string is reached. *)
+
+val from_function : ?with_positions:bool -> (bytes -> int -> int) -> lexbuf
+(** Create a lexer buffer with the given function as its reading method.
+   When the scanner needs more characters, it will call the given
+   function, giving it a byte sequence [s] and a byte
+   count [n]. The function should put [n] bytes or fewer in [s],
+   starting at index 0, and return the number of bytes
+   provided. A return value of 0 means end of input. *)
+
+val set_position : lexbuf -> position -> unit
+(** Set the initial tracked input position for [lexbuf] to a custom value.
+   Ignores [pos_fname]. See {!set_filename} for changing this field.
+   @since 4.11 *)
+
+val set_filename: lexbuf -> string -> unit
+(** Set filename in the initial tracked position to [file] in
+   [lexbuf].
+   @since 4.11 *)
+
+val with_positions : lexbuf -> bool
+(** Tell whether the lexer buffer keeps track of position fields
+    [lex_curr_p] / [lex_start_p], as determined by the corresponding
+    optional argument for functions that create lexer buffers
+    (whose default value is [true]).
+
+    When [with_positions] is [false], lexer actions should not
+    modify position fields.  Doing it nevertheless could
+    re-enable the [with_position] mode and degrade performances.
+*)
+
+
+(** {1 Functions for lexer semantic actions} *)
+
+
+(** The following functions can be called from the semantic actions
+   of lexer definitions (the ML code enclosed in braces that
+   computes the value returned by lexing functions). They give
+   access to the character string matched by the regular expression
+   associated with the semantic action. These functions must be
+   applied to the argument [lexbuf], which, in the code generated by
+   [ocamllex], is bound to the lexer buffer passed to the parsing
+   function. *)
+
+val lexeme : lexbuf -> string
+(** [Lexing.lexeme lexbuf] returns the string matched by
+           the regular expression. *)
+
+val lexeme_char : lexbuf -> int -> char
+(** [Lexing.lexeme_char lexbuf i] returns character number [i] in
+   the matched string. *)
+
+val lexeme_start : lexbuf -> int
+(** [Lexing.lexeme_start lexbuf] returns the offset in the
+   input stream of the first character of the matched string.
+   The first character of the stream has offset 0. *)
+
+val lexeme_end : lexbuf -> int
+(** [Lexing.lexeme_end lexbuf] returns the offset in the input stream
+   of the character following the last character of the matched
+   string. The first character of the stream has offset 0. *)
+
+val lexeme_start_p : lexbuf -> position
+(** Like [lexeme_start], but return a complete [position] instead
+    of an offset.  When position tracking is disabled, the function
+    returns [dummy_pos]. *)
+
+val lexeme_end_p : lexbuf -> position
+(** Like [lexeme_end], but return a complete [position] instead
+    of an offset.  When position tracking is disabled, the function
+    returns [dummy_pos]. *)
+
+val new_line : lexbuf -> unit
+(** Update the [lex_curr_p] field of the lexbuf to reflect the start
+    of a new line.  You can call this function in the semantic action
+    of the rule that matches the end-of-line character.  The function
+    does nothing when position tracking is disabled.
+    @since 3.11.0
+*)
+
+(** {1 Miscellaneous functions} *)
+
+val flush_input : lexbuf -> unit
+(** Discard the contents of the buffer and reset the current
+    position to 0.  The next use of the lexbuf will trigger a
+    refill. *)
+
+(**/**)
+
+(** {1  } *)
+
+(** The following definitions are used by the generated scanners only.
+   They are not intended to be used directly by user programs. *)
+
+val sub_lexeme : lexbuf -> int -> int -> string
+val sub_lexeme_opt : lexbuf -> int -> int -> string option
+val sub_lexeme_char : lexbuf -> int -> char
+val sub_lexeme_char_opt : lexbuf -> int -> char option
+
+type lex_tables =
+  { lex_base : string;
+    lex_backtrk : string;
+    lex_default : string;
+    lex_trans : string;
+    lex_check : string;
+    lex_base_code : string;
+    lex_backtrk_code : string;
+    lex_default_code : string;
+    lex_trans_code : string;
+    lex_check_code : string;
+    lex_code: string;}
+
+val engine : lex_tables -> int -> lexbuf -> int
+val new_engine : lex_tables -> int -> lexbuf -> int
diff --git a/stdlib/list.ml b/stdlib/list.ml
new file mode 100644
index 00000000..a624f3b4
--- /dev/null
+++ b/stdlib/list.ml
@@ -0,0 +1,560 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* An alias for the type of lists. *)
+type 'a t = 'a list = [] | (::) of 'a * 'a list
+
+(* List operations *)
+
+let rec length_aux len = function
+    [] -> len
+  | _::l -> length_aux (len + 1) l
+
+let length l = length_aux 0 l
+
+let cons a l = a::l
+
+let hd = function
+    [] -> failwith "hd"
+  | a::_ -> a
+
+let tl = function
+    [] -> failwith "tl"
+  | _::l -> l
+
+let nth l n =
+  if n < 0 then invalid_arg "List.nth" else
+  let rec nth_aux l n =
+    match l with
+    | [] -> failwith "nth"
+    | a::l -> if n = 0 then a else nth_aux l (n-1)
+  in nth_aux l n
+
+let nth_opt l n =
+  if n < 0 then invalid_arg "List.nth" else
+  let rec nth_aux l n =
+    match l with
+    | [] -> None
+    | a::l -> if n = 0 then Some a else nth_aux l (n-1)
+  in nth_aux l n
+
+let append = (@)
+
+let rec rev_append l1 l2 =
+  match l1 with
+    [] -> l2
+  | a :: l -> rev_append l (a :: l2)
+
+let rev l = rev_append l []
+
+let rec init_tailrec_aux acc i n f =
+  if i >= n then acc
+  else init_tailrec_aux (f i :: acc) (i+1) n f
+
+let rec init_aux i n f =
+  if i >= n then []
+  else
+    let r = f i in
+    r :: init_aux (i+1) n f
+
+let rev_init_threshold =
+  match Sys.backend_type with
+  | Sys.Native | Sys.Bytecode -> 10_000
+  (* We don't know the size of the stack, better be safe and assume it's
+     small. *)
+  | Sys.Other _ -> 50
+
+let init len f =
+  if len < 0 then invalid_arg "List.init" else
+  if len > rev_init_threshold then rev (init_tailrec_aux [] 0 len f)
+  else init_aux 0 len f
+
+let rec flatten = function
+    [] -> []
+  | l::r -> l @ flatten r
+
+let concat = flatten
+
+let rec map f = function
+    [] -> []
+  | a::l -> let r = f a in r :: map f l
+
+let rec mapi i f = function
+    [] -> []
+  | a::l -> let r = f i a in r :: mapi (i + 1) f l
+
+let mapi f l = mapi 0 f l
+
+let rev_map f l =
+  let rec rmap_f accu = function
+    | [] -> accu
+    | a::l -> rmap_f (f a :: accu) l
+  in
+  rmap_f [] l
+
+
+let rec iter f = function
+    [] -> ()
+  | a::l -> f a; iter f l
+
+let rec iteri i f = function
+    [] -> ()
+  | a::l -> f i a; iteri (i + 1) f l
+
+let iteri f l = iteri 0 f l
+
+let rec fold_left f accu l =
+  match l with
+    [] -> accu
+  | a::l -> fold_left f (f accu a) l
+
+let rec fold_right f l accu =
+  match l with
+    [] -> accu
+  | a::l -> f a (fold_right f l accu)
+
+let rec map2 f l1 l2 =
+  match (l1, l2) with
+    ([], []) -> []
+  | (a1::l1, a2::l2) -> let r = f a1 a2 in r :: map2 f l1 l2
+  | (_, _) -> invalid_arg "List.map2"
+
+let rev_map2 f l1 l2 =
+  let rec rmap2_f accu l1 l2 =
+    match (l1, l2) with
+    | ([], []) -> accu
+    | (a1::l1, a2::l2) -> rmap2_f (f a1 a2 :: accu) l1 l2
+    | (_, _) -> invalid_arg "List.rev_map2"
+  in
+  rmap2_f [] l1 l2
+
+
+let rec iter2 f l1 l2 =
+  match (l1, l2) with
+    ([], []) -> ()
+  | (a1::l1, a2::l2) -> f a1 a2; iter2 f l1 l2
+  | (_, _) -> invalid_arg "List.iter2"
+
+let rec fold_left2 f accu l1 l2 =
+  match (l1, l2) with
+    ([], []) -> accu
+  | (a1::l1, a2::l2) -> fold_left2 f (f accu a1 a2) l1 l2
+  | (_, _) -> invalid_arg "List.fold_left2"
+
+let rec fold_right2 f l1 l2 accu =
+  match (l1, l2) with
+    ([], []) -> accu
+  | (a1::l1, a2::l2) -> f a1 a2 (fold_right2 f l1 l2 accu)
+  | (_, _) -> invalid_arg "List.fold_right2"
+
+let rec for_all p = function
+    [] -> true
+  | a::l -> p a && for_all p l
+
+let rec exists p = function
+    [] -> false
+  | a::l -> p a || exists p l
+
+let rec for_all2 p l1 l2 =
+  match (l1, l2) with
+    ([], []) -> true
+  | (a1::l1, a2::l2) -> p a1 a2 && for_all2 p l1 l2
+  | (_, _) -> invalid_arg "List.for_all2"
+
+let rec exists2 p l1 l2 =
+  match (l1, l2) with
+    ([], []) -> false
+  | (a1::l1, a2::l2) -> p a1 a2 || exists2 p l1 l2
+  | (_, _) -> invalid_arg "List.exists2"
+
+let rec mem x = function
+    [] -> false
+  | a::l -> compare a x = 0 || mem x l
+
+let rec memq x = function
+    [] -> false
+  | a::l -> a == x || memq x l
+
+let rec assoc x = function
+    [] -> raise Not_found
+  | (a,b)::l -> if compare a x = 0 then b else assoc x l
+
+let rec assoc_opt x = function
+    [] -> None
+  | (a,b)::l -> if compare a x = 0 then Some b else assoc_opt x l
+
+let rec assq x = function
+    [] -> raise Not_found
+  | (a,b)::l -> if a == x then b else assq x l
+
+let rec assq_opt x = function
+    [] -> None
+  | (a,b)::l -> if a == x then Some b else assq_opt x l
+
+let rec mem_assoc x = function
+  | [] -> false
+  | (a, _) :: l -> compare a x = 0 || mem_assoc x l
+
+let rec mem_assq x = function
+  | [] -> false
+  | (a, _) :: l -> a == x || mem_assq x l
+
+let rec remove_assoc x = function
+  | [] -> []
+  | (a, _ as pair) :: l ->
+      if compare a x = 0 then l else pair :: remove_assoc x l
+
+let rec remove_assq x = function
+  | [] -> []
+  | (a, _ as pair) :: l -> if a == x then l else pair :: remove_assq x l
+
+let rec find p = function
+  | [] -> raise Not_found
+  | x :: l -> if p x then x else find p l
+
+let rec find_opt p = function
+  | [] -> None
+  | x :: l -> if p x then Some x else find_opt p l
+
+let rec find_map f = function
+  | [] -> None
+  | x :: l ->
+     begin match f x with
+       | Some _ as result -> result
+       | None -> find_map f l
+     end
+
+let find_all p =
+  let rec find accu = function
+  | [] -> rev accu
+  | x :: l -> if p x then find (x :: accu) l else find accu l in
+  find []
+
+let filter = find_all
+
+let filteri p l =
+  let rec aux i acc = function
+  | [] -> rev acc
+  | x::l -> aux (i + 1) (if p i x then x::acc else acc) l
+  in
+  aux 0 [] l
+
+let filter_map f =
+  let rec aux accu = function
+    | [] -> rev accu
+    | x :: l ->
+        match f x with
+        | None -> aux accu l
+        | Some v -> aux (v :: accu) l
+  in
+  aux []
+
+let concat_map f l =
+  let rec aux f acc = function
+    | [] -> rev acc
+    | x :: l ->
+       let xs = f x in
+       aux f (rev_append xs acc) l
+  in aux f [] l
+
+let fold_left_map f accu l =
+  let rec aux accu l_accu = function
+    | [] -> accu, rev l_accu
+    | x :: l ->
+        let accu, x = f accu x in
+        aux accu (x :: l_accu) l in
+  aux accu [] l
+
+let partition p l =
+  let rec part yes no = function
+  | [] -> (rev yes, rev no)
+  | x :: l -> if p x then part (x :: yes) no l else part yes (x :: no) l in
+  part [] [] l
+
+let rec split = function
+    [] -> ([], [])
+  | (x,y)::l ->
+      let (rx, ry) = split l in (x::rx, y::ry)
+
+let rec combine l1 l2 =
+  match (l1, l2) with
+    ([], []) -> []
+  | (a1::l1, a2::l2) -> (a1, a2) :: combine l1 l2
+  | (_, _) -> invalid_arg "List.combine"
+
+(** sorting *)
+
+let rec merge cmp l1 l2 =
+  match l1, l2 with
+  | [], l2 -> l2
+  | l1, [] -> l1
+  | h1 :: t1, h2 :: t2 ->
+      if cmp h1 h2 <= 0
+      then h1 :: merge cmp t1 l2
+      else h2 :: merge cmp l1 t2
+
+
+let stable_sort cmp l =
+  let rec rev_merge l1 l2 accu =
+    match l1, l2 with
+    | [], l2 -> rev_append l2 accu
+    | l1, [] -> rev_append l1 accu
+    | h1::t1, h2::t2 ->
+        if cmp h1 h2 <= 0
+        then rev_merge t1 l2 (h1::accu)
+        else rev_merge l1 t2 (h2::accu)
+  in
+  let rec rev_merge_rev l1 l2 accu =
+    match l1, l2 with
+    | [], l2 -> rev_append l2 accu
+    | l1, [] -> rev_append l1 accu
+    | h1::t1, h2::t2 ->
+        if cmp h1 h2 > 0
+        then rev_merge_rev t1 l2 (h1::accu)
+        else rev_merge_rev l1 t2 (h2::accu)
+  in
+  let rec sort n l =
+    match n, l with
+    | 2, x1 :: x2 :: tl ->
+        let s = if cmp x1 x2 <= 0 then [x1; x2] else [x2; x1] in
+        (s, tl)
+    | 3, x1 :: x2 :: x3 :: tl ->
+        let s =
+          if cmp x1 x2 <= 0 then
+            if cmp x2 x3 <= 0 then [x1; x2; x3]
+            else if cmp x1 x3 <= 0 then [x1; x3; x2]
+            else [x3; x1; x2]
+          else if cmp x1 x3 <= 0 then [x2; x1; x3]
+          else if cmp x2 x3 <= 0 then [x2; x3; x1]
+          else [x3; x2; x1]
+        in
+        (s, tl)
+    | n, l ->
+        let n1 = n asr 1 in
+        let n2 = n - n1 in
+        let s1, l2 = rev_sort n1 l in
+        let s2, tl = rev_sort n2 l2 in
+        (rev_merge_rev s1 s2 [], tl)
+  and rev_sort n l =
+    match n, l with
+    | 2, x1 :: x2 :: tl ->
+        let s = if cmp x1 x2 > 0 then [x1; x2] else [x2; x1] in
+        (s, tl)
+    | 3, x1 :: x2 :: x3 :: tl ->
+        let s =
+          if cmp x1 x2 > 0 then
+            if cmp x2 x3 > 0 then [x1; x2; x3]
+            else if cmp x1 x3 > 0 then [x1; x3; x2]
+            else [x3; x1; x2]
+          else if cmp x1 x3 > 0 then [x2; x1; x3]
+          else if cmp x2 x3 > 0 then [x2; x3; x1]
+          else [x3; x2; x1]
+        in
+        (s, tl)
+    | n, l ->
+        let n1 = n asr 1 in
+        let n2 = n - n1 in
+        let s1, l2 = sort n1 l in
+        let s2, tl = sort n2 l2 in
+        (rev_merge s1 s2 [], tl)
+  in
+  let len = length l in
+  if len < 2 then l else fst (sort len l)
+
+
+let sort = stable_sort
+let fast_sort = stable_sort
+
+(* Note: on a list of length between about 100000 (depending on the minor
+   heap size and the type of the list) and Sys.max_array_size, it is
+   actually faster to use the following, but it might also use more memory
+   because the argument list cannot be deallocated incrementally.
+
+   Also, there seems to be a bug in this code or in the
+   implementation of obj_truncate.
+
+external obj_truncate : 'a array -> int -> unit = "caml_obj_truncate"
+
+let array_to_list_in_place a =
+  let l = Array.length a in
+  let rec loop accu n p =
+    if p <= 0 then accu else begin
+      if p = n then begin
+        obj_truncate a p;
+        loop (a.(p-1) :: accu) (n-1000) (p-1)
+      end else begin
+        loop (a.(p-1) :: accu) n (p-1)
+      end
+    end
+  in
+  loop [] (l-1000) l
+
+
+let stable_sort cmp l =
+  let a = Array.of_list l in
+  Array.stable_sort cmp a;
+  array_to_list_in_place a
+
+*)
+
+
+(** sorting + removing duplicates *)
+
+let sort_uniq cmp l =
+  let rec rev_merge l1 l2 accu =
+    match l1, l2 with
+    | [], l2 -> rev_append l2 accu
+    | l1, [] -> rev_append l1 accu
+    | h1::t1, h2::t2 ->
+        let c = cmp h1 h2 in
+        if c = 0 then rev_merge t1 t2 (h1::accu)
+        else if c < 0
+        then rev_merge t1 l2 (h1::accu)
+        else rev_merge l1 t2 (h2::accu)
+  in
+  let rec rev_merge_rev l1 l2 accu =
+    match l1, l2 with
+    | [], l2 -> rev_append l2 accu
+    | l1, [] -> rev_append l1 accu
+    | h1::t1, h2::t2 ->
+        let c = cmp h1 h2 in
+        if c = 0 then rev_merge_rev t1 t2 (h1::accu)
+        else if c > 0
+        then rev_merge_rev t1 l2 (h1::accu)
+        else rev_merge_rev l1 t2 (h2::accu)
+  in
+  let rec sort n l =
+    match n, l with
+    | 2, x1 :: x2 :: tl ->
+        let s =
+          let c = cmp x1 x2 in
+          if c = 0 then [x1] else if c < 0 then [x1; x2] else [x2; x1]
+        in
+        (s, tl)
+    | 3, x1 :: x2 :: x3 :: tl ->
+        let s =
+          let c = cmp x1 x2 in
+          if c = 0 then
+            let c = cmp x2 x3 in
+            if c = 0 then [x2] else if c < 0 then [x2; x3] else [x3; x2]
+          else if c < 0 then
+            let c = cmp x2 x3 in
+            if c = 0 then [x1; x2]
+            else if c < 0 then [x1; x2; x3]
+            else
+              let c = cmp x1 x3 in
+              if c = 0 then [x1; x2]
+              else if c < 0 then [x1; x3; x2]
+              else [x3; x1; x2]
+          else
+            let c = cmp x1 x3 in
+            if c = 0 then [x2; x1]
+            else if c < 0 then [x2; x1; x3]
+            else
+              let c = cmp x2 x3 in
+              if c = 0 then [x2; x1]
+              else if c < 0 then [x2; x3; x1]
+              else [x3; x2; x1]
+        in
+        (s, tl)
+    | n, l ->
+        let n1 = n asr 1 in
+        let n2 = n - n1 in
+        let s1, l2 = rev_sort n1 l in
+        let s2, tl = rev_sort n2 l2 in
+        (rev_merge_rev s1 s2 [], tl)
+  and rev_sort n l =
+    match n, l with
+    | 2, x1 :: x2 :: tl ->
+        let s =
+          let c = cmp x1 x2 in
+          if c = 0 then [x1] else if c > 0 then [x1; x2] else [x2; x1]
+        in
+        (s, tl)
+    | 3, x1 :: x2 :: x3 :: tl ->
+        let s =
+          let c = cmp x1 x2 in
+          if c = 0 then
+            let c = cmp x2 x3 in
+            if c = 0 then [x2] else if c > 0 then [x2; x3] else [x3; x2]
+          else if c > 0 then
+            let c = cmp x2 x3 in
+            if c = 0 then [x1; x2]
+            else if c > 0 then [x1; x2; x3]
+            else
+              let c = cmp x1 x3 in
+              if c = 0 then [x1; x2]
+              else if c > 0 then [x1; x3; x2]
+              else [x3; x1; x2]
+          else
+            let c = cmp x1 x3 in
+            if c = 0 then [x2; x1]
+            else if c > 0 then [x2; x1; x3]
+            else
+              let c = cmp x2 x3 in
+              if c = 0 then [x2; x1]
+              else if c > 0 then [x2; x3; x1]
+              else [x3; x2; x1]
+        in
+        (s, tl)
+    | n, l ->
+        let n1 = n asr 1 in
+        let n2 = n - n1 in
+        let s1, l2 = sort n1 l in
+        let s2, tl = sort n2 l2 in
+        (rev_merge s1 s2 [], tl)
+  in
+  let len = length l in
+  if len < 2 then l else fst (sort len l)
+
+
+let rec compare_lengths l1 l2 =
+  match l1, l2 with
+  | [], [] -> 0
+  | [], _ -> -1
+  | _, [] -> 1
+  | _ :: l1, _ :: l2 -> compare_lengths l1 l2
+;;
+
+let rec compare_length_with l n =
+  match l with
+  | [] ->
+    if n = 0 then 0 else
+      if n > 0 then -1 else 1
+  | _ :: l ->
+    if n <= 0 then 1 else
+      compare_length_with l (n-1)
+;;
+
+(** {1 Iterators} *)
+
+let to_seq l =
+  let rec aux l () = match l with
+    | [] -> Seq.Nil
+    | x :: tail -> Seq.Cons (x, aux tail)
+  in
+  aux l
+
+let of_seq seq =
+  let rec direct depth seq : _ list =
+    if depth=0
+    then
+      Seq.fold_left (fun acc x -> x::acc) [] seq
+      |> rev (* tailrec *)
+    else match seq() with
+      | Seq.Nil -> []
+      | Seq.Cons (x, next) -> x :: direct (depth-1) next
+  in
+  direct 500 seq
diff --git a/stdlib/list.mli b/stdlib/list.mli
new file mode 100644
index 00000000..77714f1f
--- /dev/null
+++ b/stdlib/list.mli
@@ -0,0 +1,396 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** List operations.
+
+   Some functions are flagged as not tail-recursive.  A tail-recursive
+   function uses constant stack space, while a non-tail-recursive function
+   uses stack space proportional to the length of its list argument, which
+   can be a problem with very long lists.  When the function takes several
+   list arguments, an approximate formula giving stack usage (in some
+   unspecified constant unit) is shown in parentheses.
+
+   The above considerations can usually be ignored if your lists are not
+   longer than about 10000 elements.
+*)
+
+type 'a t = 'a list = [] | (::) of 'a * 'a list (**)
+(** An alias for the type of lists. *)
+
+val length : 'a list -> int
+(** Return the length (number of elements) of the given list. *)
+
+val compare_lengths : 'a list -> 'b list -> int
+(** Compare the lengths of two lists. [compare_lengths l1 l2] is
+   equivalent to [compare (length l1) (length l2)], except that
+   the computation stops after itering on the shortest list.
+   @since 4.05.0
+ *)
+
+val compare_length_with : 'a list -> int -> int
+(** Compare the length of a list to an integer. [compare_length_with l n] is
+   equivalent to [compare (length l) n], except that
+   the computation stops after at most [n] iterations on the list.
+   @since 4.05.0
+*)
+
+val cons : 'a -> 'a list -> 'a list
+(** [cons x xs] is [x :: xs]
+    @since 4.03.0
+*)
+
+val hd : 'a list -> 'a
+(** Return the first element of the given list.
+    @raise Failure if the list is empty. *)
+
+val tl : 'a list -> 'a list
+(** Return the given list without its first element.
+    @raise Failure if the list is empty. *)
+
+val nth: 'a list -> int -> 'a
+(** Return the [n]-th element of the given list.
+   The first element (head of the list) is at position 0.
+   @raise Failure if the list is too short.
+   @raise Invalid_argument if [n] is negative. *)
+
+val nth_opt: 'a list -> int -> 'a option
+(** Return the [n]-th element of the given list.
+    The first element (head of the list) is at position 0.
+    Return [None] if the list is too short.
+    @raise Invalid_argument if [n] is negative.
+    @since 4.05
+*)
+
+val rev : 'a list -> 'a list
+(** List reversal. *)
+
+val init : int -> (int -> 'a) -> 'a list
+(** [List.init len f] is [[f 0; f 1; ...; f (len-1)]], evaluated left to right.
+
+    @raise Invalid_argument if len < 0.
+    @since 4.06.0
+*)
+
+val append : 'a list -> 'a list -> 'a list
+(** Concatenate two lists.  Same as the infix operator [@].
+   Not tail-recursive (length of the first argument).  *)
+
+val rev_append : 'a list -> 'a list -> 'a list
+(** [List.rev_append l1 l2] reverses [l1] and concatenates it to [l2].
+   This is equivalent to {!List.rev}[ l1 @ l2], but [rev_append] is
+   tail-recursive and more efficient. *)
+
+val concat : 'a list list -> 'a list
+(** Concatenate a list of lists.  The elements of the argument are all
+   concatenated together (in the same order) to give the result.
+   Not tail-recursive
+   (length of the argument + length of the longest sub-list). *)
+
+val flatten : 'a list list -> 'a list
+(** An alias for [concat]. *)
+
+
+(** {1 Iterators} *)
+
+
+val iter : ('a -> unit) -> 'a list -> unit
+(** [List.iter f [a1; ...; an]] applies function [f] in turn to
+   [a1; ...; an]. It is equivalent to
+   [begin f a1; f a2; ...; f an; () end]. *)
+
+val iteri : (int -> 'a -> unit) -> 'a list -> unit
+(** Same as {!List.iter}, but the function is applied to the index of
+   the element as first argument (counting from 0), and the element
+   itself as second argument.
+   @since 4.00.0
+*)
+
+val map : ('a -> 'b) -> 'a list -> 'b list
+(** [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an],
+   and builds the list [[f a1; ...; f an]]
+   with the results returned by [f].  Not tail-recursive. *)
+
+val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
+(** Same as {!List.map}, but the function is applied to the index of
+   the element as first argument (counting from 0), and the element
+   itself as second argument.  Not tail-recursive.
+   @since 4.00.0
+*)
+
+val rev_map : ('a -> 'b) -> 'a list -> 'b list
+(** [List.rev_map f l] gives the same result as
+   {!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and
+   more efficient. *)
+
+val filter_map : ('a -> 'b option) -> 'a list -> 'b list
+(** [filter_map f l] applies [f] to every element of [l], filters
+    out the [None] elements and returns the list of the arguments of
+    the [Some] elements.
+    @since 4.08.0
+*)
+
+val concat_map : ('a -> 'b list) -> 'a list -> 'b list
+(** [List.concat_map f l] gives the same result as
+    {!List.concat}[ (]{!List.map}[ f l)]. Tail-recursive.
+
+    @since 4.10.0
+*)
+
+val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+(** [fold_left_map] is  a combination of [fold_left] and [map] that threads an
+    accumulator through calls to [f]
+    @since 4.11.0
+*)
+
+val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
+(** [List.fold_left f a [b1; ...; bn]] is
+   [f (... (f (f a b1) b2) ...) bn]. *)
+
+val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
+(** [List.fold_right f [a1; ...; an] b] is
+   [f a1 (f a2 (... (f an b) ...))].  Not tail-recursive. *)
+
+
+(** {1 Iterators on two lists} *)
+
+
+val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit
+(** [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn
+   [f a1 b1; ...; f an bn].
+   @raise Invalid_argument if the two lists are determined
+   to have different lengths. *)
+
+val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
+(** [List.map2 f [a1; ...; an] [b1; ...; bn]] is
+   [[f a1 b1; ...; f an bn]].
+   @raise Invalid_argument if the two lists are determined
+   to have different lengths.  Not tail-recursive. *)
+
+val rev_map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
+(** [List.rev_map2 f l1 l2] gives the same result as
+   {!List.rev}[ (]{!List.map2}[ f l1 l2)], but is tail-recursive and
+   more efficient. *)
+
+val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a
+(** [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is
+   [f (... (f (f a b1 c1) b2 c2) ...) bn cn].
+   @raise Invalid_argument if the two lists are determined
+   to have different lengths. *)
+
+val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
+(** [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is
+   [f a1 b1 (f a2 b2 (... (f an bn c) ...))].
+   @raise Invalid_argument if the two lists are determined
+   to have different lengths.  Not tail-recursive. *)
+
+
+(** {1 List scanning} *)
+
+
+val for_all : ('a -> bool) -> 'a list -> bool
+(** [for_all p [a1; ...; an]] checks if all elements of the list
+   satisfy the predicate [p]. That is, it returns
+   [(p a1) && (p a2) && ... && (p an)] for a non-empty list and
+   [true] if the list is empty. *)
+
+val exists : ('a -> bool) -> 'a list -> bool
+(** [exists p [a1; ...; an]] checks if at least one element of
+   the list satisfies the predicate [p]. That is, it returns
+   [(p a1) || (p a2) || ... || (p an)] for a non-empty list and
+   [false] if the list is empty. *)
+
+val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
+(** Same as {!List.for_all}, but for a two-argument predicate.
+   @raise Invalid_argument if the two lists are determined
+   to have different lengths. *)
+
+val exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
+(** Same as {!List.exists}, but for a two-argument predicate.
+   @raise Invalid_argument if the two lists are determined
+   to have different lengths. *)
+
+val mem : 'a -> 'a list -> bool
+(** [mem a l] is true if and only if [a] is equal
+   to an element of [l]. *)
+
+val memq : 'a -> 'a list -> bool
+(** Same as {!List.mem}, but uses physical equality instead of structural
+   equality to compare list elements. *)
+
+
+(** {1 List searching} *)
+
+
+val find : ('a -> bool) -> 'a list -> 'a
+(** [find p l] returns the first element of the list [l]
+   that satisfies the predicate [p].
+   @raise Not_found if there is no value that satisfies [p] in the
+   list [l]. *)
+
+val find_opt: ('a -> bool) -> 'a list -> 'a option
+(** [find_opt p l] returns the first element of the list [l] that
+    satisfies the predicate [p], or [None] if there is no value that
+    satisfies [p] in the list [l].
+    @since 4.05 *)
+
+val find_map: ('a -> 'b option) -> 'a list -> 'b option
+(** [find_map f l] applies [f] to the elements of [l] in order,
+    and returns the first result of the form [Some v], or [None]
+    if none exist.
+    @since 4.10.0
+*)
+
+val filter : ('a -> bool) -> 'a list -> 'a list
+(** [filter p l] returns all the elements of the list [l]
+   that satisfy the predicate [p].  The order of the elements
+   in the input list is preserved.  *)
+
+val find_all : ('a -> bool) -> 'a list -> 'a list
+(** [find_all] is another name for {!List.filter}. *)
+
+val filteri : (int -> 'a -> bool) -> 'a list -> 'a list
+(** Same as {!List.filter}, 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 4.11.0
+*)
+
+val partition : ('a -> bool) -> 'a list -> 'a list * 'a list
+(** [partition p l] returns a pair of lists [(l1, l2)], where
+   [l1] is the list of all the elements of [l] that
+   satisfy the predicate [p], and [l2] is the list of all the
+   elements of [l] that do not satisfy [p].
+   The order of the elements in the input list is preserved. *)
+
+
+(** {1 Association lists} *)
+
+
+val assoc : 'a -> ('a * 'b) list -> 'b
+(** [assoc a l] returns the value associated with key [a] in the list of
+   pairs [l]. That is,
+   [assoc a [ ...; (a,b); ...] = b]
+   if [(a,b)] is the leftmost binding of [a] in list [l].
+   @raise Not_found if there is no value associated with [a] in the
+   list [l]. *)
+
+val assoc_opt: 'a -> ('a * 'b) list -> 'b option
+(** [assoc_opt a l] returns the value associated with key [a] in the list of
+   pairs [l]. That is,
+   [assoc_opt a [ ...; (a,b); ...] = b]
+   if [(a,b)] is the leftmost binding of [a] in list [l].
+   Returns [None] if there is no value associated with [a] in the
+   list [l].
+   @since 4.05 *)
+
+val assq : 'a -> ('a * 'b) list -> 'b
+(** Same as {!List.assoc}, but uses physical equality instead of structural
+   equality to compare keys. *)
+
+val assq_opt : 'a -> ('a * 'b) list -> 'b option
+(** Same as {!List.assoc_opt}, but uses physical equality instead of structural
+    equality to compare keys.
+    @since 4.05 *)
+
+val mem_assoc : 'a -> ('a * 'b) list -> bool
+(** Same as {!List.assoc}, but simply return true if a binding exists,
+   and false if no bindings exist for the given key. *)
+
+val mem_assq : 'a -> ('a * 'b) list -> bool
+(** Same as {!List.mem_assoc}, but uses physical equality instead of
+   structural equality to compare keys. *)
+
+val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list
+(** [remove_assoc a l] returns the list of
+   pairs [l] without the first pair with key [a], if any.
+   Not tail-recursive. *)
+
+val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list
+(** Same as {!List.remove_assoc}, but uses physical equality instead
+   of structural equality to compare keys.  Not tail-recursive. *)
+
+
+(** {1 Lists of pairs} *)
+
+
+val split : ('a * 'b) list -> 'a list * 'b list
+(** Transform a list of pairs into a pair of lists:
+   [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])].
+   Not tail-recursive.
+*)
+
+val combine : 'a list -> 'b list -> ('a * 'b) list
+(** Transform a pair of lists into a list of pairs:
+   [combine [a1; ...; an] [b1; ...; bn]] is
+   [[(a1,b1); ...; (an,bn)]].
+   @raise Invalid_argument if the two lists
+   have different lengths.  Not tail-recursive. *)
+
+
+(** {1 Sorting} *)
+
+
+val sort : ('a -> 'a -> int) -> 'a list -> 'a list
+(** Sort a list in increasing order according to a comparison
+   function.  The comparison function must return 0 if its arguments
+   compare as equal, a positive integer if the first is greater,
+   and a negative integer if the first is smaller (see Array.sort for
+   a complete specification).  For example,
+   {!Stdlib.compare} is a suitable comparison function.
+   The resulting list is sorted in increasing order.
+   [List.sort] is guaranteed to run in constant heap space
+   (in addition to the size of the result list) and logarithmic
+   stack space.
+
+   The current implementation uses Merge Sort. It runs in constant
+   heap space and logarithmic stack space.
+*)
+
+val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list
+(** Same as {!List.sort}, but the sorting algorithm is guaranteed to
+   be stable (i.e. elements that compare equal are kept in their
+   original order) .
+
+   The current implementation uses Merge Sort. It runs in constant
+   heap space and logarithmic stack space.
+*)
+
+val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list
+(** Same as {!List.sort} or {!List.stable_sort}, whichever is faster
+    on typical input. *)
+
+val sort_uniq : ('a -> 'a -> int) -> 'a list -> 'a list
+(** Same as {!List.sort}, but also remove duplicates.
+    @since 4.02.0 *)
+
+val merge : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
+(** Merge two lists:
+    Assuming that [l1] and [l2] are sorted according to the
+    comparison function [cmp], [merge cmp l1 l2] will return a
+    sorted list containing all the elements of [l1] and [l2].
+    If several elements compare equal, the elements of [l1] will be
+    before the elements of [l2].
+    Not tail-recursive (sum of the lengths of the arguments).
+*)
+
+(** {1 Iterators} *)
+
+val to_seq : 'a list -> 'a Seq.t
+(** Iterate on the list
+    @since 4.07 *)
+
+val of_seq : 'a Seq.t -> 'a list
+(** Create a list from the iterator
+    @since 4.07 *)
diff --git a/stdlib/listLabels.ml b/stdlib/listLabels.ml
new file mode 100644
index 00000000..d782261b
--- /dev/null
+++ b/stdlib/listLabels.ml
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Jacques Garrigue, Kyoto University RIMS                 *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Module [ListLabels]: labelled List module *)
+
+include List
diff --git a/stdlib/listLabels.mli b/stdlib/listLabels.mli
new file mode 100644
index 00000000..c98eaeef
--- /dev/null
+++ b/stdlib/listLabels.mli
@@ -0,0 +1,453 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type 'a t = 'a list = [] | (::) of 'a * 'a list (**)
+(** An alias for the type of lists.
+ *)
+
+(** List operations.
+
+   Some functions are flagged as not tail-recursive.  A tail-recursive
+   function uses constant stack space, while a non-tail-recursive function
+   uses stack space proportional to the length of its list argument, which
+   can be a problem with very long lists.  When the function takes several
+   list arguments, an approximate formula giving stack usage (in some
+   unspecified constant unit) is shown in parentheses.
+
+   The above considerations can usually be ignored if your lists are not
+   longer than about 10000 elements.
+
+   This module is intended to be used through {!StdLabels} which replaces
+   {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts.
+
+   For example:
+   {[
+      open StdLabels
+
+      let seq len = List.init ~f:(function i -> i) ~len
+   ]}
+ *)
+
+val length : 'a list -> int
+(** Return the length (number of elements) of the given list.
+ *)
+
+val hd : 'a list -> 'a
+(** Return the first element of the given list.
+   @raise Failure if the list is empty.
+ *)
+
+val compare_lengths : 'a list -> 'b list -> int
+(** Compare the lengths of two lists. [compare_lengths l1 l2] is
+   equivalent to [compare (length l1) (length l2)], except that
+   the computation stops after itering on the shortest list.
+   @since 4.05.0
+ *)
+
+val compare_length_with : 'a list -> len:int -> int
+(** Compare the length of a list to an integer. [compare_length_with l n] is
+   equivalent to [compare (length l) n], except that
+   the computation stops after at most [n] iterations on the list.
+   @since 4.05.0
+ *)
+
+val cons : 'a -> 'a list -> 'a list
+(** [cons x xs] is [x :: xs]
+    @since 4.05.0
+ *)
+
+val tl : 'a list -> 'a list
+(** Return the given list without its first element.
+   @raise Failure if the list is empty.
+ *)
+
+val nth : 'a list -> int -> 'a
+(** Return the [n]-th element of the given list.
+   The first element (head of the list) is at position 0.
+   @raise Failure if the list is too short.
+   @raise Invalid_argument if [n] is negative.
+ *)
+
+val nth_opt: 'a list -> int -> 'a option
+(** Return the [n]-th element of the given list.
+    The first element (head of the list) is at position 0.
+    Return [None] if the list is too short.
+    @raise Invalid_argument if [n] is negative.
+    @since 4.05
+ *)
+
+val rev : 'a list -> 'a list
+(** List reversal.
+ *)
+
+val init : len:int -> f:(int -> 'a) -> 'a list
+(** [List.init len f] is [f 0; f 1; ...; f (len-1)], evaluated left to right.
+    @raise Invalid_argument if [len < 0].
+    @since 4.06.0
+ *)
+
+val append : 'a list -> 'a list -> 'a list
+(** Catenate two lists. Same function as the infix operator [@].
+   Not tail-recursive (length of the first argument). The [@]
+   operator is not tail-recursive either.
+ *)
+
+val rev_append : 'a list -> 'a list -> 'a list
+(** [List.rev_append l1 l2] reverses [l1] and concatenates it with [l2].
+   This is equivalent to [(]{!List.rev}[ l1) @ l2], but [rev_append] is
+   tail-recursive and more efficient.
+ *)
+
+val concat : 'a list list -> 'a list
+(** Concatenate a list of lists. The elements of the argument are all
+   concatenated together (in the same order) to give the result.
+   Not tail-recursive
+   (length of the argument + length of the longest sub-list).
+ *)
+
+val flatten : 'a list list -> 'a list
+(** Same as [concat]. Not tail-recursive
+   (length of the argument + length of the longest sub-list).
+ *)
+
+
+(** {1 Iterators} *)
+
+
+val iter : f:('a -> unit) -> 'a list -> unit
+(** [List.iter f [a1; ...; an]] applies function [f] in turn to
+   [a1; ...; an]. It is equivalent to
+   [begin f a1; f a2; ...; f an; () end].
+ *)
+
+val iteri : f:(int -> 'a -> unit) -> 'a list -> unit
+(** Same as {!List.iter}, but the function is applied to the index of
+   the element as first argument (counting from 0), and the element
+   itself as second argument.
+   @since 4.00.0
+ *)
+
+val map : f:('a -> 'b) -> 'a list -> 'b list
+(** [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an],
+   and builds the list [[f a1; ...; f an]]
+   with the results returned by [f]. Not tail-recursive.
+ *)
+
+val mapi : f:(int -> 'a -> 'b) -> 'a list -> 'b list
+(** Same as {!List.map}, but the function is applied to the index of
+   the element as first argument (counting from 0), and the element
+   itself as second argument.
+   @since 4.00.0
+ *)
+
+val rev_map : f:('a -> 'b) -> 'a list -> 'b list
+(** [List.rev_map f l] gives the same result as
+   {!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and
+   more efficient.
+ *)
+
+val filter_map : f:('a -> 'b option) -> 'a list -> 'b list
+(** [filter_map f l] applies [f] to every element of [l], filters
+    out the [None] elements and returns the list of the arguments of
+    the [Some] elements.
+    @since 4.08.0
+ *)
+
+val concat_map : f:('a -> 'b list) -> 'a list -> 'b list
+(** [List.concat_map f l] gives the same result as
+    {!List.concat}[ (]{!List.map}[ f l)]. Tail-recursive.
+
+    @since 4.10.0
+*)
+
+val fold_left_map :
+  f:('a -> 'b -> 'a * 'c) -> init:'a -> 'b list -> 'a * 'c list
+(** [fold_left_map] is  a combination of [fold_left] and [map] hat threads an
+    accumulator through calls to [f]
+    @since 4.11.0
+*)
+
+val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b list -> 'a
+(** [List.fold_left f a [b1; ...; bn]] is
+   [f (... (f (f a b1) b2) ...) bn].
+ *)
+
+val fold_right : f:('a -> 'b -> 'b) -> 'a list -> init:'b -> 'b
+(** [List.fold_right f [a1; ...; an] b] is
+   [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive.
+ *)
+
+
+(** {1 Iterators on two lists} *)
+
+
+val iter2 : f:('a -> 'b -> unit) -> 'a list -> 'b list -> unit
+(** [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn
+   [f a1 b1; ...; f an bn].
+   @raise Invalid_argument if the two lists are determined
+   to have different lengths.
+ *)
+
+val map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
+(** [List.map2 f [a1; ...; an] [b1; ...; bn]] is
+   [[f a1 b1; ...; f an bn]].
+   @raise Invalid_argument if the two lists are determined
+   to have different lengths. Not tail-recursive.
+ *)
+
+val rev_map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
+(** [List.rev_map2 f l1 l2] gives the same result as
+   {!List.rev}[ (]{!List.map2}[ f l1 l2)], but is tail-recursive and
+   more efficient.
+ *)
+
+val fold_left2 :
+  f:('a -> 'b -> 'c -> 'a) -> init:'a -> 'b list -> 'c list -> 'a
+(** [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is
+   [f (... (f (f a b1 c1) b2 c2) ...) bn cn].
+   @raise Invalid_argument if the two lists are determined
+   to have different lengths.
+ *)
+
+val fold_right2 :
+  f:('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> init:'c -> 'c
+(** [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is
+   [f a1 b1 (f a2 b2 (... (f an bn c) ...))].
+   @raise Invalid_argument if the two lists are determined
+   to have different lengths. Not tail-recursive.
+ *)
+
+
+(** {1 List scanning} *)
+
+
+val for_all : f:('a -> bool) -> 'a list -> bool
+(** [for_all p [a1; ...; an]] checks if all elements of the list
+   satisfy the predicate [p]. That is, it returns
+   [(p a1) && (p a2) && ... && (p an)].
+ *)
+
+val exists : f:('a -> bool) -> 'a list -> bool
+(** [exists p [a1; ...; an]] checks if at least one element of
+   the list satisfies the predicate [p]. That is, it returns
+   [(p a1) || (p a2) || ... || (p an)].
+ *)
+
+val for_all2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool
+(** Same as {!List.for_all}, but for a two-argument predicate.
+   @raise Invalid_argument if the two lists are determined
+   to have different lengths.
+ *)
+
+val exists2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool
+(** Same as {!List.exists}, but for a two-argument predicate.
+   @raise Invalid_argument if the two lists are determined
+   to have different lengths.
+ *)
+
+val mem : 'a -> set:'a list -> bool
+(** [mem a l] is true if and only if [a] is equal
+   to an element of [l].
+ *)
+
+val memq : 'a -> set:'a list -> bool
+(** Same as {!List.mem}, but uses physical equality instead of structural
+   equality to compare list elements.
+ *)
+
+
+(** {1 List searching} *)
+
+
+val find : f:('a -> bool) -> 'a list -> 'a
+(** [find p l] returns the first element of the list [l]
+   that satisfies the predicate [p].
+   @raise Not_found if there is no value that satisfies [p] in the
+   list [l].
+ *)
+
+val find_opt: f:('a -> bool) -> 'a list -> 'a option
+(** [find p l] returns the first element of the list [l]
+   that satisfies the predicate [p].
+   Returns [None] if there is no value that satisfies [p] in the
+   list [l].
+   @since 4.05
+ *)
+
+val find_map: f:('a -> 'b option) -> 'a list -> 'b option
+(** [find_map f l] applies [f] to the elements of [l] in order,
+    and returns the first result of the form [Some v], or [None]
+    if none exist.
+    @since 4.10.0
+*)
+
+val filter : f:('a -> bool) -> 'a list -> 'a list
+(** [filter p l] returns all the elements of the list [l]
+   that satisfy the predicate [p]. The order of the elements
+   in the input list is preserved.
+ *)
+
+val find_all : f:('a -> bool) -> 'a list -> 'a list
+(** [find_all] is another name for {!List.filter}.
+ *)
+
+val filteri : f:(int -> 'a -> bool) -> 'a list -> 'a list
+(** Same as {!List.filter}, 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 4.11.0
+*)
+
+val partition : f:('a -> bool) -> 'a list -> 'a list * 'a list
+(** [partition p l] returns a pair of lists [(l1, l2)], where
+   [l1] is the list of all the elements of [l] that
+   satisfy the predicate [p], and [l2] is the list of all the
+   elements of [l] that do not satisfy [p].
+   The order of the elements in the input list is preserved.
+ *)
+
+
+(** {1 Association lists} *)
+
+
+val assoc : 'a -> ('a * 'b) list -> 'b
+(** [assoc a l] returns the value associated with key [a] in the list of
+   pairs [l]. That is,
+   [assoc a [ ...; (a,b); ...] = b]
+   if [(a,b)] is the leftmost binding of [a] in list [l].
+   @raise Not_found if there is no value associated with [a] in the
+   list [l].
+ *)
+
+val assoc_opt: 'a -> ('a * 'b) list -> 'b option
+(** [assoc_opt a l] returns the value associated with key [a] in the list of
+    pairs [l]. That is,
+    [assoc a [ ...; (a,b); ...] = b]
+    if [(a,b)] is the leftmost binding of [a] in list [l].
+    Returns [None] if there is no value associated with [a] in the
+    list [l].
+    @since 4.05
+ *)
+
+val assq : 'a -> ('a * 'b) list -> 'b
+(** Same as {!List.assoc}, but uses physical equality instead of
+   structural equality to compare keys.
+ *)
+
+val assq_opt: 'a -> ('a * 'b) list -> 'b option
+(** Same as {!List.assoc_opt}, but uses physical equality instead of
+   structural equality to compare keys.
+   @since 4.05.0
+ *)
+
+val mem_assoc : 'a -> map:('a * 'b) list -> bool
+(** Same as {!List.assoc}, but simply return true if a binding exists,
+   and false if no bindings exist for the given key.
+ *)
+
+val mem_assq : 'a -> map:('a * 'b) list -> bool
+(** Same as {!List.mem_assoc}, but uses physical equality instead of
+   structural equality to compare keys.
+ *)
+
+val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list
+(** [remove_assoc a l] returns the list of
+   pairs [l] without the first pair with key [a], if any.
+   Not tail-recursive.
+ *)
+
+val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list
+(** Same as {!List.remove_assoc}, but uses physical equality instead
+   of structural equality to compare keys. Not tail-recursive.
+ *)
+
+
+(** {1 Lists of pairs} *)
+
+
+val split : ('a * 'b) list -> 'a list * 'b list
+(** Transform a list of pairs into a pair of lists:
+   [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])].
+   Not tail-recursive.
+ *)
+
+val combine : 'a list -> 'b list -> ('a * 'b) list
+(** Transform a pair of lists into a list of pairs:
+   [combine [a1; ...; an] [b1; ...; bn]] is
+   [[(a1,b1); ...; (an,bn)]].
+   @raise Invalid_argument if the two lists
+   have different lengths. Not tail-recursive.
+ *)
+
+
+(** {1 Sorting} *)
+
+
+val sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list
+(** Sort a list in increasing order according to a comparison
+   function. The comparison function must return 0 if its arguments
+   compare as equal, a positive integer if the first is greater,
+   and a negative integer if the first is smaller (see Array.sort for
+   a complete specification). For example,
+   {!Stdlib.compare} is a suitable comparison function.
+   The resulting list is sorted in increasing order.
+   [List.sort] is guaranteed to run in constant heap space
+   (in addition to the size of the result list) and logarithmic
+   stack space.
+
+   The current implementation uses Merge Sort. It runs in constant
+   heap space and logarithmic stack space.
+ *)
+
+val stable_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list
+(** Same as {!List.sort}, but the sorting algorithm is guaranteed to
+   be stable (i.e. elements that compare equal are kept in their
+   original order) .
+
+   The current implementation uses Merge Sort. It runs in constant
+   heap space and logarithmic stack space.
+ *)
+
+val fast_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list
+(** Same as {!List.sort} or {!List.stable_sort}, whichever is
+    faster on typical input.
+ *)
+
+val sort_uniq : cmp:('a -> 'a -> int) -> 'a list -> 'a list
+(** Same as {!List.sort}, but also remove duplicates.
+    @since 4.03.0
+ *)
+
+val merge : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
+(** Merge two lists:
+    Assuming that [l1] and [l2] are sorted according to the
+    comparison function [cmp], [merge cmp l1 l2] will return a
+    sorted list containing all the elements of [l1] and [l2].
+    If several elements compare equal, the elements of [l1] will be
+    before the elements of [l2].
+    Not tail-recursive (sum of the lengths of the arguments).
+ *)
+
+(** {1 Iterators} *)
+
+val to_seq : 'a list -> 'a Seq.t
+(** Iterate on the list
+    @since 4.07
+ *)
+
+val of_seq : 'a Seq.t -> 'a list
+(** Create a list from the iterator
+    @since 4.07
+ *)
diff --git a/stdlib/map.ml b/stdlib/map.ml
new file mode 100644
index 00000000..479f2646
--- /dev/null
+++ b/stdlib/map.ml
@@ -0,0 +1,522 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+module type OrderedType =
+  sig
+    type t
+    val compare: t -> t -> int
+  end
+
+module type S =
+  sig
+    type key
+    type +'a t
+    val empty: 'a t
+    val is_empty: 'a t -> bool
+    val mem:  key -> 'a t -> bool
+    val add: key -> 'a -> 'a t -> 'a t
+    val update: key -> ('a option -> 'a option) -> 'a t -> 'a t
+    val singleton: key -> 'a -> 'a t
+    val remove: key -> 'a t -> 'a t
+    val merge:
+          (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+    val union: (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+    val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
+    val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+    val iter: (key -> 'a -> unit) -> 'a t -> unit
+    val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val for_all: (key -> 'a -> bool) -> 'a t -> bool
+    val exists: (key -> 'a -> bool) -> 'a t -> bool
+    val filter: (key -> 'a -> bool) -> 'a t -> 'a t
+    val filter_map: (key -> 'a -> 'b option) -> 'a t -> 'b t
+    val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+    val cardinal: 'a t -> int
+    val bindings: 'a t -> (key * 'a) list
+    val min_binding: 'a t -> (key * 'a)
+    val min_binding_opt: 'a t -> (key * 'a) option
+    val max_binding: 'a t -> (key * 'a)
+    val max_binding_opt: 'a t -> (key * 'a) option
+    val choose: 'a t -> (key * 'a)
+    val choose_opt: 'a t -> (key * 'a) option
+    val split: key -> 'a t -> 'a t * 'a option * 'a t
+    val find: key -> 'a t -> 'a
+    val find_opt: key -> 'a t -> 'a option
+    val find_first: (key -> bool) -> 'a t -> key * 'a
+    val find_first_opt: (key -> bool) -> 'a t -> (key * 'a) option
+    val find_last: (key -> bool) -> 'a t -> key * 'a
+    val find_last_opt: (key -> bool) -> 'a t -> (key * 'a) option
+    val map: ('a -> 'b) -> 'a t -> 'b t
+    val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
+    val to_seq : 'a t -> (key * 'a) Seq.t
+    val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
+    val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
+    val of_seq : (key * 'a) Seq.t -> 'a t
+  end
+
+module Make(Ord: OrderedType) = struct
+
+    type key = Ord.t
+
+    type 'a t =
+        Empty
+      | Node of {l:'a t; v:key; d:'a; r:'a t; h:int}
+
+    let height = function
+        Empty -> 0
+      | Node {h} -> h
+
+    let create l x d r =
+      let hl = height l and hr = height r in
+      Node{l; v=x; d; r; h=(if hl >= hr then hl + 1 else hr + 1)}
+
+    let singleton x d = Node{l=Empty; v=x; d; r=Empty; h=1}
+
+    let bal l x d r =
+      let hl = match l with Empty -> 0 | Node {h} -> h in
+      let hr = match r with Empty -> 0 | Node {h} -> h in
+      if hl > hr + 2 then begin
+        match l with
+          Empty -> invalid_arg "Map.bal"
+        | Node{l=ll; v=lv; d=ld; r=lr} ->
+            if height ll >= height lr then
+              create ll lv ld (create lr x d r)
+            else begin
+              match lr with
+                Empty -> invalid_arg "Map.bal"
+              | Node{l=lrl; v=lrv; d=lrd; r=lrr}->
+                  create (create ll lv ld lrl) lrv lrd (create lrr x d r)
+            end
+      end else if hr > hl + 2 then begin
+        match r with
+          Empty -> invalid_arg "Map.bal"
+        | Node{l=rl; v=rv; d=rd; r=rr} ->
+            if height rr >= height rl then
+              create (create l x d rl) rv rd rr
+            else begin
+              match rl with
+                Empty -> invalid_arg "Map.bal"
+              | Node{l=rll; v=rlv; d=rld; r=rlr} ->
+                  create (create l x d rll) rlv rld (create rlr rv rd rr)
+            end
+      end else
+        Node{l; v=x; d; r; h=(if hl >= hr then hl + 1 else hr + 1)}
+
+    let empty = Empty
+
+    let is_empty = function Empty -> true | _ -> false
+
+    let rec add x data = function
+        Empty ->
+          Node{l=Empty; v=x; d=data; r=Empty; h=1}
+      | Node {l; v; d; r; h} as m ->
+          let c = Ord.compare x v in
+          if c = 0 then
+            if d == data then m else Node{l; v=x; d=data; r; h}
+          else if c < 0 then
+            let ll = add x data l in
+            if l == ll then m else bal ll v d r
+          else
+            let rr = add x data r in
+            if r == rr then m else bal l v d rr
+
+    let rec find x = function
+        Empty ->
+          raise Not_found
+      | Node {l; v; d; r} ->
+          let c = Ord.compare x v in
+          if c = 0 then d
+          else find x (if c < 0 then l else r)
+
+    let rec find_first_aux v0 d0 f = function
+        Empty ->
+          (v0, d0)
+      | Node {l; v; d; r} ->
+          if f v then
+            find_first_aux v d f l
+          else
+            find_first_aux v0 d0 f r
+
+    let rec find_first f = function
+        Empty ->
+          raise Not_found
+      | Node {l; v; d; r} ->
+          if f v then
+            find_first_aux v d f l
+          else
+            find_first f r
+
+    let rec find_first_opt_aux v0 d0 f = function
+        Empty ->
+          Some (v0, d0)
+      | Node {l; v; d; r} ->
+          if f v then
+            find_first_opt_aux v d f l
+          else
+            find_first_opt_aux v0 d0 f r
+
+    let rec find_first_opt f = function
+        Empty ->
+          None
+      | Node {l; v; d; r} ->
+          if f v then
+            find_first_opt_aux v d f l
+          else
+            find_first_opt f r
+
+    let rec find_last_aux v0 d0 f = function
+        Empty ->
+          (v0, d0)
+      | Node {l; v; d; r} ->
+          if f v then
+            find_last_aux v d f r
+          else
+            find_last_aux v0 d0 f l
+
+    let rec find_last f = function
+        Empty ->
+          raise Not_found
+      | Node {l; v; d; r} ->
+          if f v then
+            find_last_aux v d f r
+          else
+            find_last f l
+
+    let rec find_last_opt_aux v0 d0 f = function
+        Empty ->
+          Some (v0, d0)
+      | Node {l; v; d; r} ->
+          if f v then
+            find_last_opt_aux v d f r
+          else
+            find_last_opt_aux v0 d0 f l
+
+    let rec find_last_opt f = function
+        Empty ->
+          None
+      | Node {l; v; d; r} ->
+          if f v then
+            find_last_opt_aux v d f r
+          else
+            find_last_opt f l
+
+    let rec find_opt x = function
+        Empty ->
+          None
+      | Node {l; v; d; r} ->
+          let c = Ord.compare x v in
+          if c = 0 then Some d
+          else find_opt x (if c < 0 then l else r)
+
+    let rec mem x = function
+        Empty ->
+          false
+      | Node {l; v; r} ->
+          let c = Ord.compare x v in
+          c = 0 || mem x (if c < 0 then l else r)
+
+    let rec min_binding = function
+        Empty -> raise Not_found
+      | Node {l=Empty; v; d} -> (v, d)
+      | Node {l} -> min_binding l
+
+    let rec min_binding_opt = function
+        Empty -> None
+      | Node {l=Empty; v; d} -> Some (v, d)
+      | Node {l}-> min_binding_opt l
+
+    let rec max_binding = function
+        Empty -> raise Not_found
+      | Node {v; d; r=Empty} -> (v, d)
+      | Node {r} -> max_binding r
+
+    let rec max_binding_opt = function
+        Empty -> None
+      | Node {v; d; r=Empty} -> Some (v, d)
+      | Node {r} -> max_binding_opt r
+
+    let rec remove_min_binding = function
+        Empty -> invalid_arg "Map.remove_min_elt"
+      | Node {l=Empty; r} -> r
+      | Node {l; v; d; r} -> bal (remove_min_binding l) v d r
+
+    let merge t1 t2 =
+      match (t1, t2) with
+        (Empty, t) -> t
+      | (t, Empty) -> t
+      | (_, _) ->
+          let (x, d) = min_binding t2 in
+          bal t1 x d (remove_min_binding t2)
+
+    let rec remove x = function
+        Empty ->
+          Empty
+      | (Node {l; v; d; r} as m) ->
+          let c = Ord.compare x v in
+          if c = 0 then merge l r
+          else if c < 0 then
+            let ll = remove x l in if l == ll then m else bal ll v d r
+          else
+            let rr = remove x r in if r == rr then m else bal l v d rr
+
+    let rec update x f = function
+        Empty ->
+          begin match f None with
+          | None -> Empty
+          | Some data -> Node{l=Empty; v=x; d=data; r=Empty; h=1}
+          end
+      | Node {l; v; d; r; h} as m ->
+          let c = Ord.compare x v in
+          if c = 0 then begin
+            match f (Some d) with
+            | None -> merge l r
+            | Some data ->
+                if d == data then m else Node{l; v=x; d=data; r; h}
+          end else if c < 0 then
+            let ll = update x f l in
+            if l == ll then m else bal ll v d r
+          else
+            let rr = update x f r in
+            if r == rr then m else bal l v d rr
+
+    let rec iter f = function
+        Empty -> ()
+      | Node {l; v; d; r} ->
+          iter f l; f v d; iter f r
+
+    let rec map f = function
+        Empty ->
+          Empty
+      | Node {l; v; d; r; h} ->
+          let l' = map f l in
+          let d' = f d in
+          let r' = map f r in
+          Node{l=l'; v; d=d'; r=r'; h}
+
+    let rec mapi f = function
+        Empty ->
+          Empty
+      | Node {l; v; d; r; h} ->
+          let l' = mapi f l in
+          let d' = f v d in
+          let r' = mapi f r in
+          Node{l=l'; v; d=d'; r=r'; h}
+
+    let rec fold f m accu =
+      match m with
+        Empty -> accu
+      | Node {l; v; d; r} ->
+          fold f r (f v d (fold f l accu))
+
+    let rec for_all p = function
+        Empty -> true
+      | Node {l; v; d; r} -> p v d && for_all p l && for_all p r
+
+    let rec exists p = function
+        Empty -> false
+      | Node {l; v; d; r} -> p v d || exists p l || exists p r
+
+    (* Beware: those two functions assume that the added k is *strictly*
+       smaller (or bigger) than all the present keys in the tree; it
+       does not test for equality with the current min (or max) key.
+
+       Indeed, they are only used during the "join" operation which
+       respects this precondition.
+    *)
+
+    let rec add_min_binding k x = function
+      | Empty -> singleton k x
+      | Node {l; v; d; r} ->
+        bal (add_min_binding k x l) v d r
+
+    let rec add_max_binding k x = function
+      | Empty -> singleton k x
+      | Node {l; v; d; r} ->
+        bal l v d (add_max_binding k x r)
+
+    (* Same as create and bal, but no assumptions are made on the
+       relative heights of l and r. *)
+
+    let rec join l v d r =
+      match (l, r) with
+        (Empty, _) -> add_min_binding v d r
+      | (_, Empty) -> add_max_binding v d l
+      | (Node{l=ll; v=lv; d=ld; r=lr; h=lh},
+         Node{l=rl; v=rv; d=rd; r=rr; h=rh}) ->
+          if lh > rh + 2 then bal ll lv ld (join lr v d r) else
+          if rh > lh + 2 then bal (join l v d rl) rv rd rr else
+          create l v d r
+
+    (* Merge two trees l and r into one.
+       All elements of l must precede the elements of r.
+       No assumption on the heights of l and r. *)
+
+    let concat t1 t2 =
+      match (t1, t2) with
+        (Empty, t) -> t
+      | (t, Empty) -> t
+      | (_, _) ->
+          let (x, d) = min_binding t2 in
+          join t1 x d (remove_min_binding t2)
+
+    let concat_or_join t1 v d t2 =
+      match d with
+      | Some d -> join t1 v d t2
+      | None -> concat t1 t2
+
+    let rec split x = function
+        Empty ->
+          (Empty, None, Empty)
+      | Node {l; v; d; r} ->
+          let c = Ord.compare x v in
+          if c = 0 then (l, Some d, r)
+          else if c < 0 then
+            let (ll, pres, rl) = split x l in (ll, pres, join rl v d r)
+          else
+            let (lr, pres, rr) = split x r in (join l v d lr, pres, rr)
+
+    let rec merge f s1 s2 =
+      match (s1, s2) with
+        (Empty, Empty) -> Empty
+      | (Node {l=l1; v=v1; d=d1; r=r1; h=h1}, _) when h1 >= height s2 ->
+          let (l2, d2, r2) = split v1 s2 in
+          concat_or_join (merge f l1 l2) v1 (f v1 (Some d1) d2) (merge f r1 r2)
+      | (_, Node {l=l2; v=v2; d=d2; r=r2}) ->
+          let (l1, d1, r1) = split v2 s1 in
+          concat_or_join (merge f l1 l2) v2 (f v2 d1 (Some d2)) (merge f r1 r2)
+      | _ ->
+          assert false
+
+    let rec union f s1 s2 =
+      match (s1, s2) with
+      | (Empty, s) | (s, Empty) -> s
+      | (Node {l=l1; v=v1; d=d1; r=r1; h=h1},
+         Node {l=l2; v=v2; d=d2; r=r2; h=h2}) ->
+          if h1 >= h2 then
+            let (l2, d2, r2) = split v1 s2 in
+            let l = union f l1 l2 and r = union f r1 r2 in
+            match d2 with
+            | None -> join l v1 d1 r
+            | Some d2 -> concat_or_join l v1 (f v1 d1 d2) r
+          else
+            let (l1, d1, r1) = split v2 s1 in
+            let l = union f l1 l2 and r = union f r1 r2 in
+            match d1 with
+            | None -> join l v2 d2 r
+            | Some d1 -> concat_or_join l v2 (f v2 d1 d2) r
+
+    let rec filter p = function
+        Empty -> Empty
+      | Node {l; v; d; r} as m ->
+          (* call [p] in the expected left-to-right order *)
+          let l' = filter p l in
+          let pvd = p v d in
+          let r' = filter p r in
+          if pvd then if l==l' && r==r' then m else join l' v d r'
+          else concat l' r'
+
+    let rec filter_map f = function
+        Empty -> Empty
+      | Node {l; v; d; r} ->
+          (* call [f] in the expected left-to-right order *)
+          let l' = filter_map f l in
+          let fvd = f v d in
+          let r' = filter_map f r in
+          begin match fvd with
+            | Some d' -> join l' v d' r'
+            | None -> concat l' r'
+          end
+
+    let rec partition p = function
+        Empty -> (Empty, Empty)
+      | Node {l; v; d; r} ->
+          (* call [p] in the expected left-to-right order *)
+          let (lt, lf) = partition p l in
+          let pvd = p v d in
+          let (rt, rf) = partition p r in
+          if pvd
+          then (join lt v d rt, concat lf rf)
+          else (concat lt rt, join lf v d rf)
+
+    type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration
+
+    let rec cons_enum m e =
+      match m with
+        Empty -> e
+      | Node {l; v; d; r} -> cons_enum l (More(v, d, r, e))
+
+    let compare cmp m1 m2 =
+      let rec compare_aux e1 e2 =
+          match (e1, e2) with
+          (End, End) -> 0
+        | (End, _)  -> -1
+        | (_, End) -> 1
+        | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
+            let c = Ord.compare v1 v2 in
+            if c <> 0 then c else
+            let c = cmp d1 d2 in
+            if c <> 0 then c else
+            compare_aux (cons_enum r1 e1) (cons_enum r2 e2)
+      in compare_aux (cons_enum m1 End) (cons_enum m2 End)
+
+    let equal cmp m1 m2 =
+      let rec equal_aux e1 e2 =
+          match (e1, e2) with
+          (End, End) -> true
+        | (End, _)  -> false
+        | (_, End) -> false
+        | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
+            Ord.compare v1 v2 = 0 && cmp d1 d2 &&
+            equal_aux (cons_enum r1 e1) (cons_enum r2 e2)
+      in equal_aux (cons_enum m1 End) (cons_enum m2 End)
+
+    let rec cardinal = function
+        Empty -> 0
+      | Node {l; r} -> cardinal l + 1 + cardinal r
+
+    let rec bindings_aux accu = function
+        Empty -> accu
+      | Node {l; v; d; r} -> bindings_aux ((v, d) :: bindings_aux accu r) l
+
+    let bindings s =
+      bindings_aux [] s
+
+    let choose = min_binding
+
+    let choose_opt = min_binding_opt
+
+    let add_seq i m =
+      Seq.fold_left (fun m (k,v) -> add k v m) m i
+
+    let of_seq i = add_seq i empty
+
+    let rec seq_of_enum_ c () = match c with
+      | End -> Seq.Nil
+      | More (k,v,t,rest) -> Seq.Cons ((k,v), seq_of_enum_ (cons_enum t rest))
+
+    let to_seq m =
+      seq_of_enum_ (cons_enum m End)
+
+    let to_seq_from low m =
+      let rec aux low m c = match m with
+        | Empty -> c
+        | Node {l; v; d; r; _} ->
+            begin match Ord.compare v low with
+              | 0 -> More (v, d, r, c)
+              | n when n<0 -> aux low r c
+              | _ -> aux low l (More (v, d, r, c))
+            end
+      in
+      seq_of_enum_ (aux low m End)
+end
diff --git a/stdlib/map.mli b/stdlib/map.mli
new file mode 100644
index 00000000..6ec8249a
--- /dev/null
+++ b/stdlib/map.mli
@@ -0,0 +1,352 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Association tables over ordered types.
+
+   This module implements applicative association tables, also known as
+   finite maps or dictionaries, given a total ordering function
+   over the keys.
+   All operations over maps are purely applicative (no side-effects).
+   The implementation uses balanced binary trees, and therefore searching
+   and insertion take time logarithmic in the size of the map.
+
+   For instance:
+   {[
+     module IntPairs =
+       struct
+         type t = int * int
+         let compare (x0,y0) (x1,y1) =
+           match Stdlib.compare x0 x1 with
+               0 -> Stdlib.compare y0 y1
+             | c -> c
+       end
+
+     module PairsMap = Map.Make(IntPairs)
+
+     let m = PairsMap.(empty |> add (0,1) "hello" |> add (1,0) "world")
+   ]}
+
+   This creates a new module [PairsMap], with a new type ['a PairsMap.t]
+   of maps from [int * int] to ['a]. In this example, [m] contains [string]
+   values so its type is [string PairsMap.t].
+*)
+
+module type OrderedType =
+  sig
+    type t
+      (** The type of the map keys. *)
+
+    val compare : t -> t -> int
+      (** A total ordering function over the keys.
+          This is a two-argument function [f] such that
+          [f e1 e2] is zero if the keys [e1] and [e2] are equal,
+          [f e1 e2] is strictly negative if [e1] is smaller than [e2],
+          and [f e1 e2] is strictly positive if [e1] is greater than [e2].
+          Example: a suitable ordering function is the generic structural
+          comparison function {!Stdlib.compare}. *)
+  end
+(** Input signature of the functor {!Map.Make}. *)
+
+module type S =
+  sig
+    type key
+    (** The type of the map keys. *)
+
+    type (+'a) t
+    (** The type of maps from type [key] to type ['a]. *)
+
+    val empty: 'a t
+    (** The empty map. *)
+
+    val is_empty: 'a t -> bool
+    (** Test whether a map is empty or not. *)
+
+    val mem: key -> 'a t -> bool
+    (** [mem x m] returns [true] if [m] contains a binding for [x],
+       and [false] otherwise. *)
+
+    val add: key -> 'a -> 'a t -> 'a t
+    (** [add x y m] returns a map containing the same bindings as
+       [m], plus a binding of [x] to [y]. If [x] was already bound
+       in [m] to a value that is physically equal to [y],
+       [m] is returned unchanged (the result of the function is
+       then physically equal to [m]). Otherwise, the previous binding
+       of [x] in [m] disappears.
+       @before 4.03 Physical equality was not ensured. *)
+
+    val update: key -> ('a option -> 'a option) -> 'a t -> 'a t
+    (** [update x f m] returns a map containing the same bindings as
+        [m], except for the binding of [x]. Depending on the value of
+        [y] where [y] is [f (find_opt x m)], the binding of [x] is
+        added, removed or updated. If [y] is [None], the binding is
+        removed if it exists; otherwise, if [y] is [Some z] then [x]
+        is associated to [z] in the resulting map.  If [x] was already
+        bound in [m] to a value that is physically equal to [z], [m]
+        is returned unchanged (the result of the function is then
+        physically equal to [m]).
+        @since 4.06.0
+    *)
+
+    val singleton: key -> 'a -> 'a t
+    (** [singleton x y] returns the one-element map that contains a binding [y]
+        for [x].
+        @since 3.12.0
+     *)
+
+    val remove: key -> 'a t -> 'a t
+    (** [remove x m] returns a map containing the same bindings as
+       [m], except for [x] which is unbound in the returned map.
+       If [x] was not in [m], [m] is returned unchanged
+       (the result of the function is then physically equal to [m]).
+       @before 4.03 Physical equality was not ensured. *)
+
+    val merge:
+         (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+    (** [merge f m1 m2] computes a map whose keys are a subset of the keys of
+        [m1] and of [m2]. The presence of each such binding, and the
+        corresponding value, is determined with the function [f].
+        In terms of the [find_opt] operation, we have
+        [find_opt x (merge f m1 m2) = f x (find_opt x m1) (find_opt x m2)]
+        for any key [x], provided that [f x None None = None].
+        @since 3.12.0
+     *)
+
+    val union: (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+    (** [union f m1 m2] computes a map whose keys are a subset of the keys
+        of [m1] and of [m2].  When the same binding is defined in both
+        arguments, the function [f] is used to combine them.
+        This is a special case of [merge]: [union f m1 m2] is equivalent
+        to [merge f' m1 m2], where
+        - [f' _key None None = None]
+        - [f' _key (Some v) None = Some v]
+        - [f' _key None (Some v) = Some v]
+        - [f' key (Some v1) (Some v2) = f key v1 v2]
+
+        @since 4.03.0
+    *)
+
+    val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
+    (** Total ordering between maps.  The first argument is a total ordering
+        used to compare data associated with equal keys in the two maps. *)
+
+    val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+    (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are
+       equal, that is, contain equal keys and associate them with
+       equal data.  [cmp] is the equality predicate used to compare
+       the data associated with the keys. *)
+
+    val iter: (key -> 'a -> unit) -> 'a t -> unit
+    (** [iter f m] applies [f] to all bindings in map [m].
+       [f] receives the key as first argument, and the associated value
+       as second argument.  The bindings are passed to [f] in increasing
+       order with respect to the ordering over the type of the keys. *)
+
+    val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)],
+       where [k1 ... kN] are the keys of all bindings in [m]
+       (in increasing order), and [d1 ... dN] are the associated data. *)
+
+    val for_all: (key -> 'a -> bool) -> 'a t -> bool
+    (** [for_all p m] checks if all the bindings of the map
+        satisfy the predicate [p].
+        @since 3.12.0
+     *)
+
+    val exists: (key -> 'a -> bool) -> 'a t -> bool
+    (** [exists p m] checks if at least one binding of the map
+        satisfies the predicate [p].
+        @since 3.12.0
+     *)
+
+    val filter: (key -> 'a -> bool) -> 'a t -> 'a t
+    (** [filter p m] returns the map with all the bindings in [m]
+        that satisfy predicate [p]. If every binding in [m] satisfies [p],
+        [m] is returned unchanged (the result of the function is then
+        physically equal to [m])
+        @since 3.12.0
+       @before 4.03 Physical equality was not ensured.
+     *)
+
+    val filter_map: (key -> 'a -> 'b option) -> 'a t -> 'b t
+    (** [filter_map f m] applies the function [f] to every binding of
+        [m], and builds a map from the results. For each binding
+        [(k, v)] in the input map:
+        - if [f k v] is [None] then [k] is not in the result,
+        - if [f k v] is [Some v'] then the binding [(k, v')]
+          is in the output map.
+
+        For example, the following function on maps whose values are lists
+        {[
+        filter_map
+          (fun _k li -> match li with [] -> None | _::tl -> Some tl)
+          m
+        ]}
+        drops all bindings of [m] whose value is an empty list, and pops
+        the first element of each value that is non-empty.
+
+        @since 4.11.0
+     *)
+
+    val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+    (** [partition p m] returns a pair of maps [(m1, m2)], where
+        [m1] contains all the bindings of [m] that satisfy the
+        predicate [p], and [m2] is the map with all the bindings of
+        [m] that do not satisfy [p].
+        @since 3.12.0
+     *)
+
+    val cardinal: 'a t -> int
+    (** Return the number of bindings of a map.
+        @since 3.12.0
+     *)
+
+    val bindings: 'a t -> (key * 'a) list
+    (** Return the list of all bindings of the given map.
+       The returned list is sorted in increasing order of keys with respect
+       to the ordering [Ord.compare], where [Ord] is the argument
+       given to {!Map.Make}.
+        @since 3.12.0
+     *)
+
+    val min_binding: 'a t -> (key * 'a)
+    (** Return the binding with the smallest key in a given map
+       (with respect to the [Ord.compare] ordering), or raise
+       [Not_found] if the map is empty.
+        @since 3.12.0
+     *)
+
+    val min_binding_opt: 'a t -> (key * 'a) option
+    (** Return the binding with the smallest key in the given map
+       (with respect to the [Ord.compare] ordering), or [None]
+       if the map is empty.
+        @since 4.05
+     *)
+
+    val max_binding: 'a t -> (key * 'a)
+    (** Same as {!Map.S.min_binding}, but returns the binding with
+        the largest key in the given map.
+        @since 3.12.0
+     *)
+
+    val max_binding_opt: 'a t -> (key * 'a) option
+    (** Same as {!Map.S.min_binding_opt}, but returns the binding with
+        the largest key in the given map.
+        @since 4.05
+     *)
+
+    val choose: 'a t -> (key * 'a)
+    (** Return one binding of the given map, or raise [Not_found] if
+       the map is empty. Which binding is chosen is unspecified,
+       but equal bindings will be chosen for equal maps.
+        @since 3.12.0
+     *)
+
+    val choose_opt: 'a t -> (key * 'a) option
+    (** Return one binding of the given map, or [None] if
+       the map is empty. Which binding is chosen is unspecified,
+       but equal bindings will be chosen for equal maps.
+        @since 4.05
+     *)
+
+    val split: key -> 'a t -> 'a t * 'a option * 'a t
+    (** [split x m] returns a triple [(l, data, r)], where
+          [l] is the map with all the bindings of [m] whose key
+        is strictly less than [x];
+          [r] is the map with all the bindings of [m] whose key
+        is strictly greater than [x];
+          [data] is [None] if [m] contains no binding for [x],
+          or [Some v] if [m] binds [v] to [x].
+        @since 3.12.0
+     *)
+
+    val find: key -> 'a t -> 'a
+    (** [find x m] returns the current value of [x] in [m],
+       or raises [Not_found] if no binding for [x] exists. *)
+
+    val find_opt: key -> 'a t -> 'a option
+    (** [find_opt x m] returns [Some v] if the current value of [x]
+        in [m] is [v], or [None] if no binding for [x] exists.
+        @since 4.05
+    *)
+
+    val find_first: (key -> bool) -> 'a t -> key * 'a
+    (** [find_first f m], where [f] is a monotonically increasing function,
+       returns the binding of [m] with the lowest key [k] such that [f k],
+       or raises [Not_found] if no such key exists.
+
+       For example, [find_first (fun k -> Ord.compare k x >= 0) m] will return
+       the first binding [k, v] of [m] where [Ord.compare k x >= 0]
+       (intuitively: [k >= x]), or raise [Not_found] if [x] is greater than any
+       element of [m].
+
+        @since 4.05
+       *)
+
+    val find_first_opt: (key -> bool) -> 'a t -> (key * 'a) option
+    (** [find_first_opt f m], where [f] is a monotonically increasing function,
+       returns an option containing the binding of [m] with the lowest key [k]
+       such that [f k], or [None] if no such key exists.
+        @since 4.05
+       *)
+
+    val find_last: (key -> bool) -> 'a t -> key * 'a
+    (** [find_last f m], where [f] is a monotonically decreasing function,
+       returns the binding of [m] with the highest key [k] such that [f k],
+       or raises [Not_found] if no such key exists.
+        @since 4.05
+       *)
+
+    val find_last_opt: (key -> bool) -> 'a t -> (key * 'a) option
+    (** [find_last_opt f m], where [f] is a monotonically decreasing function,
+       returns an option containing the binding of [m] with the highest key [k]
+       such that [f k], or [None] if no such key exists.
+        @since 4.05
+       *)
+
+    val map: ('a -> 'b) -> 'a t -> 'b t
+    (** [map f m] returns a map with same domain as [m], where the
+       associated value [a] of all bindings of [m] has been
+       replaced by the result of the application of [f] to [a].
+       The bindings are passed to [f] in increasing order
+       with respect to the ordering over the type of the keys. *)
+
+    val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
+    (** Same as {!Map.S.map}, but the function receives as arguments both the
+       key and the associated value for each binding of the map. *)
+
+    (** {1 Iterators} *)
+
+    val to_seq : 'a t -> (key * 'a) Seq.t
+    (** Iterate on the whole map, in ascending order of keys
+        @since 4.07 *)
+
+    val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
+    (** [to_seq_from k m] iterates on a subset of the bindings of [m],
+        in ascending order of keys, from key [k] or above.
+        @since 4.07 *)
+
+    val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
+    (** Add the given bindings to the map, in order.
+        @since 4.07 *)
+
+    val of_seq : (key * 'a) Seq.t -> 'a t
+    (** Build a map from the given bindings
+        @since 4.07 *)
+  end
+(** Output signature of the functor {!Map.Make}. *)
+
+module Make (Ord : OrderedType) : S with type key = Ord.t
+(** Functor building an implementation of the map structure
+   given a totally ordered type. *)
diff --git a/stdlib/marshal.ml b/stdlib/marshal.ml
new file mode 100644
index 00000000..d9f158a4
--- /dev/null
+++ b/stdlib/marshal.ml
@@ -0,0 +1,67 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1997 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 extern_flags =
+    No_sharing
+  | Closures
+  | Compat_32
+(* note: this type definition is used in 'runtime/debugger.c' *)
+
+external to_channel: out_channel -> 'a -> extern_flags list -> unit
+    = "caml_output_value"
+external to_bytes: 'a -> extern_flags list -> bytes
+    = "caml_output_value_to_bytes"
+external to_string: 'a -> extern_flags list -> string
+    = "caml_output_value_to_string"
+external to_buffer_unsafe:
+      bytes -> int -> int -> 'a -> extern_flags list -> int
+    = "caml_output_value_to_buffer"
+
+let to_buffer buff ofs len v flags =
+  if ofs < 0 || len < 0 || ofs > Bytes.length buff - len
+  then invalid_arg "Marshal.to_buffer: substring out of bounds"
+  else to_buffer_unsafe buff ofs len v flags
+
+(* The functions below use byte sequences as input, never using any
+   mutation. It makes sense to use non-mutated [bytes] rather than
+   [string], because we really work with sequences of bytes, not
+   a text representation.
+*)
+
+external from_channel: in_channel -> 'a = "caml_input_value"
+external from_bytes_unsafe: bytes -> int -> 'a = "caml_input_value_from_bytes"
+external data_size_unsafe: bytes -> int -> int = "caml_marshal_data_size"
+
+let header_size = 20
+let data_size buff ofs =
+  if ofs < 0 || ofs > Bytes.length buff - header_size
+  then invalid_arg "Marshal.data_size"
+  else data_size_unsafe buff ofs
+let total_size buff ofs = header_size + data_size buff ofs
+
+let from_bytes buff ofs =
+  if ofs < 0 || ofs > Bytes.length buff - header_size
+  then invalid_arg "Marshal.from_bytes"
+  else begin
+    let len = data_size_unsafe buff ofs in
+    if ofs > Bytes.length buff - (header_size + len)
+    then invalid_arg "Marshal.from_bytes"
+    else from_bytes_unsafe buff ofs
+  end
+
+let from_string buff ofs =
+  (* Bytes.unsafe_of_string is safe here, as the produced byte
+     sequence is never mutated *)
+  from_bytes (Bytes.unsafe_of_string buff) ofs
diff --git a/stdlib/marshal.mli b/stdlib/marshal.mli
new file mode 100644
index 00000000..53e3fb75
--- /dev/null
+++ b/stdlib/marshal.mli
@@ -0,0 +1,185 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Marshaling of data structures.
+
+   This module provides functions to encode arbitrary data structures
+   as sequences of bytes, which can then be written on a file or
+   sent over a pipe or network connection.  The bytes can then
+   be read back later, possibly in another process, and decoded back
+   into a data structure. The format for the byte sequences
+   is compatible across all machines for a given version of OCaml.
+
+   Warning: marshaling is currently not type-safe. The type
+   of marshaled data is not transmitted along the value of the data,
+   making it impossible to check that the data read back possesses the
+   type expected by the context. In particular, the result type of
+   the [Marshal.from_*] functions is given as ['a], but this is
+   misleading: the returned OCaml value does not possess type ['a]
+   for all ['a]; it has one, unique type which cannot be determined
+   at compile-time.  The programmer should explicitly give the expected
+   type of the returned value, using the following syntax:
+   - [(Marshal.from_channel chan : type)].
+   Anything can happen at run-time if the object in the file does not
+   belong to the given type.
+
+   Values of extensible variant types, for example exceptions (of
+   extensible type [exn]), returned by the unmarshaller should not be
+   pattern-matched over through [match ... with] or [try ... with],
+   because unmarshalling does not preserve the information required for
+   matching their constructors. Structural equalities with other
+   extensible variant values does not work either.  Most other uses such
+   as Printexc.to_string, will still work as expected.
+
+   The representation of marshaled values is not human-readable,
+   and uses bytes that are not printable characters. Therefore,
+   input and output channels used in conjunction with [Marshal.to_channel]
+   and [Marshal.from_channel] must be opened in binary mode, using e.g.
+   [open_out_bin] or [open_in_bin]; channels opened in text mode will
+   cause unmarshaling errors on platforms where text channels behave
+   differently than binary channels, e.g. Windows.
+ *)
+
+type extern_flags =
+    No_sharing                          (** Don't preserve sharing *)
+  | Closures                            (** Send function closures *)
+  | Compat_32                           (** Ensure 32-bit compatibility *)
+(** The flags to the [Marshal.to_*] functions below. *)
+
+val to_channel : out_channel -> 'a -> extern_flags list -> unit
+(** [Marshal.to_channel chan v flags] writes the representation
+   of [v] on channel [chan]. The [flags] argument is a
+   possibly empty list of flags that governs the marshaling
+   behavior with respect to sharing, functional values, and compatibility
+   between 32- and 64-bit platforms.
+
+   If [flags] does not contain [Marshal.No_sharing], circularities
+   and sharing inside the value [v] are detected and preserved
+   in the sequence of bytes produced. In particular, this
+   guarantees that marshaling always terminates. Sharing
+   between values marshaled by successive calls to
+   [Marshal.to_channel] is neither detected nor preserved, though.
+   If [flags] contains [Marshal.No_sharing], sharing is ignored.
+   This results in faster marshaling if [v] contains no shared
+   substructures, but may cause slower marshaling and larger
+   byte representations if [v] actually contains sharing,
+   or even non-termination if [v] contains cycles.
+
+   If [flags] does not contain [Marshal.Closures], marshaling fails
+   when it encounters a functional value inside [v]: only 'pure' data
+   structures, containing neither functions nor objects, can safely be
+   transmitted between different programs. If [flags] contains
+   [Marshal.Closures], functional values will be marshaled as a the
+   position in the code of the program together with the values
+   corresponding to the free variables captured in the closure.  In
+   this case, the output of marshaling can only be read back in
+   processes that run exactly the same program, with exactly the same
+   compiled code. (This is checked at un-marshaling time, using an MD5
+   digest of the code transmitted along with the code position.)
+
+   The exact definition of which free variables are captured in a
+   closure is not specified and can vary between bytecode and native
+   code (and according to optimization flags).  In particular, a
+   function value accessing a global reference may or may not include
+   the reference in its closure.  If it does, unmarshaling the
+   corresponding closure will create a new reference, different from
+   the global one.
+
+
+   If [flags] contains [Marshal.Compat_32], marshaling fails when
+   it encounters an integer value outside the range [[-2{^30}, 2{^30}-1]]
+   of integers that are representable on a 32-bit platform.  This
+   ensures that marshaled data generated on a 64-bit platform can be
+   safely read back on a 32-bit platform.  If [flags] does not
+   contain [Marshal.Compat_32], integer values outside the
+   range [[-2{^30}, 2{^30}-1]] are marshaled, and can be read back on
+   a 64-bit platform, but will cause an error at un-marshaling time
+   when read back on a 32-bit platform.  The [Mashal.Compat_32] flag
+   only matters when marshaling is performed on a 64-bit platform;
+   it has no effect if marshaling is performed on a 32-bit platform.
+ *)
+
+external to_bytes :
+  'a -> extern_flags list -> bytes = "caml_output_value_to_bytes"
+(** [Marshal.to_bytes v flags] returns a byte sequence containing
+   the representation of [v].
+   The [flags] argument has the same meaning as for
+   {!Marshal.to_channel}.
+   @since 4.02.0 *)
+
+external to_string :
+  'a -> extern_flags list -> string = "caml_output_value_to_string"
+(** Same as [to_bytes] but return the result as a string instead of
+    a byte sequence. *)
+
+val to_buffer : bytes -> int -> int -> 'a -> extern_flags list -> int
+(** [Marshal.to_buffer buff ofs len v flags] marshals the value [v],
+   storing its byte representation in the sequence [buff],
+   starting at index [ofs], and writing at most
+   [len] bytes.  It returns the number of bytes
+   actually written to the sequence. If the byte representation
+   of [v] does not fit in [len] characters, the exception [Failure]
+   is raised. *)
+
+val from_channel : in_channel -> 'a
+(** [Marshal.from_channel chan] reads from channel [chan] the
+   byte representation of a structured value, as produced by
+   one of the [Marshal.to_*] functions, and reconstructs and
+   returns the corresponding value.
+
+   It raises [End_of_file] if the function has already reached the
+   end of file when starting to read from the channel, and raises
+   [Failure "input_value: truncated object"] if it reaches the end
+   of file later during the unmarshalling. *)
+
+val from_bytes : bytes -> int -> 'a
+(** [Marshal.from_bytes buff ofs] unmarshals a structured value
+   like {!Marshal.from_channel} does, except that the byte
+   representation is not read from a channel, but taken from
+   the byte sequence [buff], starting at position [ofs].
+   The byte sequence is not mutated.
+   @since 4.02.0 *)
+
+val from_string : string -> int -> 'a
+(** Same as [from_bytes] but take a string as argument instead of a
+    byte sequence. *)
+
+val header_size : int
+(** The bytes representing a marshaled value are composed of
+   a fixed-size header and a variable-sized data part,
+   whose size can be determined from the header.
+   {!Marshal.header_size} is the size, in bytes, of the header.
+   {!Marshal.data_size}[ buff ofs] is the size, in bytes,
+   of the data part, assuming a valid header is stored in
+   [buff] starting at position [ofs].
+   Finally, {!Marshal.total_size} [buff ofs] is the total size,
+   in bytes, of the marshaled value.
+   Both {!Marshal.data_size} and {!Marshal.total_size} raise [Failure]
+   if [buff], [ofs] does not contain a valid header.
+
+   To read the byte representation of a marshaled value into
+   a byte sequence, the program needs to read first
+   {!Marshal.header_size} bytes into the sequence,
+   then determine the length of the remainder of the
+   representation using {!Marshal.data_size},
+   make sure the sequence is large enough to hold the remaining
+   data, then read it, and finally call {!Marshal.from_bytes}
+   to unmarshal the value. *)
+
+val data_size : bytes -> int -> int
+(** See {!Marshal.header_size}.*)
+
+val total_size : bytes -> int -> int
+(** See {!Marshal.header_size}.*)
diff --git a/stdlib/moreLabels.ml b/stdlib/moreLabels.ml
new file mode 100644
index 00000000..7b93668a
--- /dev/null
+++ b/stdlib/moreLabels.ml
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Jacques Garrigue, Kyoto University RIMS                 *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Module [MoreLabels]: meta-module for compatibility labelled libraries *)
+
+module Hashtbl = Hashtbl
+
+module Map = Map
+
+module Set = Set
diff --git a/stdlib/moreLabels.mli b/stdlib/moreLabels.mli
new file mode 100644
index 00000000..eae749c7
--- /dev/null
+++ b/stdlib/moreLabels.mli
@@ -0,0 +1,235 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Jacques Garrigue, Kyoto University RIMS                 *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Extra labeled libraries.
+
+   This meta-module provides labelized version of the {!Hashtbl},
+   {!Map} and {!Set} modules.
+
+   They only differ by their labels. They are provided to help
+   porting from previous versions of OCaml.
+   The contents of this module are subject to change.
+*)
+
+module Hashtbl : sig
+  type ('a, 'b) t = ('a, 'b) Hashtbl.t
+  val create : ?random:bool -> int -> ('a, 'b) t
+  val clear : ('a, 'b) t -> unit
+  val reset : ('a, 'b) t -> unit
+  val copy : ('a, 'b) t -> ('a, 'b) t
+  val add : ('a, 'b) t -> key:'a -> data:'b -> unit
+  val find : ('a, 'b) t -> 'a -> 'b
+  val find_opt : ('a, 'b) t -> 'a -> 'b option
+  val find_all : ('a, 'b) t -> 'a -> 'b list
+  val mem : ('a, 'b) t -> 'a -> bool
+  val remove : ('a, 'b) t -> 'a -> unit
+  val replace : ('a, 'b) t -> key:'a -> data:'b -> unit
+  val iter : f:(key:'a -> data:'b -> unit) -> ('a, 'b) t -> unit
+  val filter_map_inplace:
+    f:(key:'a -> data:'b -> 'b option) -> ('a, 'b) t -> unit
+  val fold :
+      f:(key:'a -> data:'b -> 'c -> 'c) ->
+        ('a, 'b) t -> init:'c -> 'c
+  val length : ('a, 'b) t -> int
+  val randomize : unit -> unit
+  val is_randomized : unit -> bool
+  type statistics = Hashtbl.statistics
+  val stats : ('a, 'b) t -> statistics
+  val to_seq : ('a,'b) t -> ('a * 'b) Seq.t
+  val to_seq_keys : ('a,_) t -> 'a Seq.t
+  val to_seq_values : (_,'b) t -> 'b Seq.t
+  val add_seq : ('a,'b) t -> ('a * 'b) Seq.t -> unit
+  val replace_seq : ('a,'b) t -> ('a * 'b) Seq.t -> unit
+  val of_seq : ('a * 'b) Seq.t -> ('a, 'b) t
+  module type HashedType = Hashtbl.HashedType
+  module type SeededHashedType = Hashtbl.SeededHashedType
+  module type S =
+    sig
+      type key
+      and 'a t
+      val create : int -> 'a t
+      val clear : 'a t -> unit
+      val reset : 'a t -> unit
+      val copy : 'a t -> 'a t
+      val add : 'a t -> key:key -> data:'a -> unit
+      val remove : 'a t -> key -> unit
+      val find : 'a t -> key -> 'a
+      val find_opt: 'a t -> key -> 'a option
+      val find_all : 'a t -> key -> 'a list
+      val replace : 'a t -> key:key -> data:'a -> unit
+      val mem : 'a t -> key -> bool
+      val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit
+      val filter_map_inplace:
+        f:(key:key -> data:'a -> 'a option) -> 'a t -> unit
+      val fold :
+          f:(key:key -> data:'a -> 'b -> 'b) ->
+          'a t -> init:'b -> 'b
+      val length : 'a t -> int
+      val stats: 'a t -> statistics
+      val to_seq : 'a t -> (key * 'a) Seq.t
+      val to_seq_keys : _ t -> key Seq.t
+      val to_seq_values : 'a t -> 'a Seq.t
+      val add_seq : 'a t -> (key * 'a) Seq.t -> unit
+      val replace_seq : 'a t -> (key * 'a) Seq.t -> unit
+      val of_seq : (key * 'a) Seq.t -> 'a t
+    end
+  module type SeededS =
+    sig
+      type key
+      and 'a t
+      val create : ?random:bool -> int -> 'a t
+      val clear : 'a t -> unit
+      val reset : 'a t -> unit
+      val copy : 'a t -> 'a t
+      val add : 'a t -> key:key -> data:'a -> unit
+      val remove : 'a t -> key -> unit
+      val find : 'a t -> key -> 'a
+      val find_opt : 'a t -> key -> 'a option
+      val find_all : 'a t -> key -> 'a list
+      val replace : 'a t -> key:key -> data:'a -> unit
+      val mem : 'a t -> key -> bool
+      val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit
+      val filter_map_inplace:
+        f:(key:key -> data:'a -> 'a option) -> 'a t -> unit
+      val fold :
+          f:(key:key -> data:'a -> 'b -> 'b) ->
+          'a t -> init:'b -> 'b
+      val length : 'a t -> int
+      val stats: 'a t -> statistics
+      val to_seq : 'a t -> (key * 'a) Seq.t
+      val to_seq_keys : _ t -> key Seq.t
+      val to_seq_values : 'a t -> 'a Seq.t
+      val add_seq : 'a t -> (key * 'a) Seq.t -> unit
+      val replace_seq : 'a t -> (key * 'a) Seq.t -> unit
+      val of_seq : (key * 'a) Seq.t -> 'a t
+    end
+  module Make : functor (H : HashedType) -> S
+    with type key = H.t
+     and type 'a t = 'a Hashtbl.Make(H).t
+  module MakeSeeded (H : SeededHashedType) : SeededS
+    with type key = H.t
+     and type 'a t = 'a Hashtbl.MakeSeeded(H).t
+  val hash : 'a -> int
+  val seeded_hash : int -> 'a -> int
+  val hash_param : int -> int -> 'a -> int
+  val seeded_hash_param : int -> int -> int -> 'a -> int
+end
+
+module Map : sig
+  module type OrderedType = Map.OrderedType
+  module type S =
+    sig
+      type key
+      and (+'a) t
+      val empty : 'a t
+      val is_empty: 'a t -> bool
+      val mem : key -> 'a t -> bool
+      val add : key:key -> data:'a -> 'a t -> 'a t
+      val update: key:key -> f:('a option -> 'a option) -> 'a t -> 'a t
+      val singleton: key -> 'a -> 'a t
+      val remove : key -> 'a t -> 'a t
+      val merge:
+          f:(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+      val union: f:(key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+      val compare: cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
+      val equal: cmp:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+      val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit
+      val fold :
+          f:(key:key -> data:'a -> 'b -> 'b) ->
+          'a t -> init:'b -> 'b
+      val for_all: f:(key -> 'a -> bool) -> 'a t -> bool
+      val exists: f:(key -> 'a -> bool) -> 'a t -> bool
+      val filter: f:(key -> 'a -> bool) -> 'a t -> 'a t
+      val filter_map: f:(key -> 'a -> 'b option) -> 'a t -> 'b t
+      val partition: f:(key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+      val cardinal: 'a t -> int
+      val bindings: 'a t -> (key * 'a) list
+      val min_binding: 'a t -> (key * 'a)
+      val min_binding_opt: 'a t -> (key * 'a) option
+      val max_binding: 'a t -> (key * 'a)
+      val max_binding_opt: 'a t -> (key * 'a) option
+      val choose: 'a t -> (key * 'a)
+      val choose_opt: 'a t -> (key * 'a) option
+      val split: key -> 'a t -> 'a t * 'a option * 'a t
+      val find : key -> 'a t -> 'a
+      val find_opt: key -> 'a t -> 'a option
+      val find_first : f:(key -> bool) -> 'a t -> key * 'a
+      val find_first_opt : f:(key -> bool) -> 'a t -> (key * 'a) option
+      val find_last : f:(key -> bool) -> 'a t -> key * 'a
+      val find_last_opt : f:(key -> bool) -> 'a t -> (key * 'a) option
+      val map : f:('a -> 'b) -> 'a t -> 'b t
+      val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t
+      val to_seq : 'a t -> (key * 'a) Seq.t
+      val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
+      val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
+      val of_seq : (key * 'a) Seq.t -> 'a t
+  end
+  module Make : functor (Ord : OrderedType) -> S
+    with type key = Ord.t
+     and type 'a t = 'a Map.Make(Ord).t
+end
+
+module Set : sig
+  module type OrderedType = Set.OrderedType
+  module type S =
+    sig
+      type elt
+      and t
+      val empty : t
+      val is_empty : t -> bool
+      val mem : elt -> t -> bool
+      val add : elt -> t -> t
+      val singleton : elt -> t
+      val remove : elt -> t -> t
+      val union : t -> t -> t
+      val inter : t -> t -> t
+      val disjoint : t -> t -> bool
+      val diff : t -> t -> t
+      val compare : t -> t -> int
+      val equal : t -> t -> bool
+      val subset : t -> t -> bool
+      val iter : f:(elt -> unit) -> t -> unit
+      val map : f:(elt -> elt) -> t -> t
+      val fold : f:(elt -> 'a -> 'a) -> t -> init:'a -> 'a
+      val for_all : f:(elt -> bool) -> t -> bool
+      val exists : f:(elt -> bool) -> t -> bool
+      val filter : f:(elt -> bool) -> t -> t
+      val filter_map : f:(elt -> elt option) -> t -> t
+      val partition : f:(elt -> bool) -> t -> t * t
+      val cardinal : t -> int
+      val elements : t -> elt list
+      val min_elt : t -> elt
+      val min_elt_opt: t -> elt option
+      val max_elt : t -> elt
+      val max_elt_opt: t -> elt option
+      val choose : t -> elt
+      val choose_opt: t -> elt option
+      val split: elt -> t -> t * bool * t
+      val find: elt -> t -> elt
+      val find_opt: elt -> t -> elt option
+      val find_first: f:(elt -> bool) -> t -> elt
+      val find_first_opt: f:(elt -> bool) -> t -> elt option
+      val find_last: f:(elt -> bool) -> t -> elt
+      val find_last_opt: f:(elt -> bool) -> t -> elt option
+      val of_list: elt list -> t
+      val to_seq_from : elt -> t -> elt Seq.t
+      val to_seq : t -> elt Seq.t
+      val add_seq : elt Seq.t -> t -> t
+      val of_seq : elt Seq.t -> t
+    end
+  module Make : functor (Ord : OrderedType) -> S
+    with type elt = Ord.t
+     and type t = Set.Make(Ord).t
+end
diff --git a/stdlib/nativeint.ml b/stdlib/nativeint.ml
new file mode 100644
index 00000000..5d8b4e61
--- /dev/null
+++ b/stdlib/nativeint.ml
@@ -0,0 +1,90 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Module [Nativeint]: processor-native integers *)
+
+external neg: nativeint -> nativeint = "%nativeint_neg"
+external add: nativeint -> nativeint -> nativeint = "%nativeint_add"
+external sub: nativeint -> nativeint -> nativeint = "%nativeint_sub"
+external mul: nativeint -> nativeint -> nativeint = "%nativeint_mul"
+external div: nativeint -> nativeint -> nativeint = "%nativeint_div"
+external rem: nativeint -> nativeint -> nativeint = "%nativeint_mod"
+external logand: nativeint -> nativeint -> nativeint = "%nativeint_and"
+external logor: nativeint -> nativeint -> nativeint = "%nativeint_or"
+external logxor: nativeint -> nativeint -> nativeint = "%nativeint_xor"
+external shift_left: nativeint -> int -> nativeint = "%nativeint_lsl"
+external shift_right: nativeint -> int -> nativeint = "%nativeint_asr"
+external shift_right_logical: nativeint -> int -> nativeint = "%nativeint_lsr"
+external of_int: int -> nativeint = "%nativeint_of_int"
+external to_int: nativeint -> int = "%nativeint_to_int"
+external of_float : float -> nativeint
+  = "caml_nativeint_of_float" "caml_nativeint_of_float_unboxed"
+  [@@unboxed] [@@noalloc]
+external to_float : nativeint -> float
+  = "caml_nativeint_to_float" "caml_nativeint_to_float_unboxed"
+  [@@unboxed] [@@noalloc]
+external of_int32: int32 -> nativeint = "%nativeint_of_int32"
+external to_int32: nativeint -> int32 = "%nativeint_to_int32"
+
+let zero = 0n
+let one = 1n
+let minus_one = -1n
+let succ n = add n 1n
+let pred n = sub n 1n
+let abs n = if n >= 0n then n else neg n
+let size = Sys.word_size
+let min_int = shift_left 1n (size - 1)
+let max_int = sub min_int 1n
+let lognot n = logxor n (-1n)
+
+let unsigned_to_int =
+  let max_int = of_int Stdlib.max_int in
+  fun n ->
+    if compare zero n <= 0 && compare n max_int <= 0 then
+      Some (to_int n)
+    else
+      None
+
+external format : string -> nativeint -> string = "caml_nativeint_format"
+let to_string n = format "%d" n
+
+external of_string: string -> nativeint = "caml_nativeint_of_string"
+
+let of_string_opt s =
+  (* TODO: expose a non-raising primitive directly. *)
+  try Some (of_string s)
+  with Failure _ -> None
+
+type t = nativeint
+
+let compare (x: t) (y: t) = Stdlib.compare x y
+let equal (x: t) (y: t) = compare x y = 0
+
+let unsigned_compare n m =
+  compare (sub n min_int) (sub m min_int)
+
+(* Unsigned division from signed division of the same
+   bitness. See Warren Jr., Henry S. (2013). Hacker's Delight (2 ed.), Sec 9-3.
+*)
+let unsigned_div n d =
+  if d < zero then
+    if unsigned_compare n d < 0 then zero else one
+  else
+    let q = shift_left (div (shift_right_logical n 1) d) 1 in
+    let r = sub n (mul q d) in
+    if unsigned_compare r d >= 0 then succ q else q
+
+let unsigned_rem n d =
+  sub n (mul (unsigned_div n d) d)
diff --git a/stdlib/nativeint.mli b/stdlib/nativeint.mli
new file mode 100644
index 00000000..fdf24eb8
--- /dev/null
+++ b/stdlib/nativeint.mli
@@ -0,0 +1,238 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Processor-native integers.
+
+   This module provides operations on the type [nativeint] of
+   signed 32-bit integers (on 32-bit platforms) or
+   signed 64-bit integers (on 64-bit platforms).
+   This integer type has exactly the same width as that of a
+   pointer type in the C compiler.  All arithmetic operations over
+   [nativeint] are taken modulo 2{^32} or 2{^64} depending
+   on the word size of the architecture.
+
+   Performance notice: values of type [nativeint] occupy more memory
+   space than values of type [int], and arithmetic operations on
+   [nativeint] are generally slower than those on [int].  Use [nativeint]
+   only when the application requires the extra bit of precision
+   over the [int] type.
+
+    Literals for native integers are suffixed by n:
+    {[
+      let zero: nativeint = 0n
+      let one: nativeint = 1n
+      let m_one: nativeint = -1n
+    ]}
+*)
+
+val zero : nativeint
+(** The native integer 0.*)
+
+val one : nativeint
+(** The native integer 1.*)
+
+val minus_one : nativeint
+(** The native integer -1.*)
+
+external neg : nativeint -> nativeint = "%nativeint_neg"
+(** Unary negation. *)
+
+external add : nativeint -> nativeint -> nativeint = "%nativeint_add"
+(** Addition. *)
+
+external sub : nativeint -> nativeint -> nativeint = "%nativeint_sub"
+(** Subtraction. *)
+
+external mul : nativeint -> nativeint -> nativeint = "%nativeint_mul"
+(** Multiplication. *)
+
+external div : nativeint -> nativeint -> nativeint = "%nativeint_div"
+(** Integer division. This division rounds the real quotient of
+   its arguments towards zero, as specified for {!Stdlib.(/)}.
+
+   @raise Division_by_zero if the second
+   argument is zero. *)
+
+val unsigned_div : nativeint -> nativeint -> nativeint
+(** Same as {!div}, except that arguments and result are interpreted as {e
+    unsigned} native integers.
+
+    @since 4.08.0 *)
+
+external rem : nativeint -> nativeint -> nativeint = "%nativeint_mod"
+(** Integer remainder.  If [y] is not zero, the result
+   of [Nativeint.rem x y] satisfies the following properties:
+   [Nativeint.zero <= Nativeint.rem x y < Nativeint.abs y] and
+   [x = Nativeint.add (Nativeint.mul (Nativeint.div x y) y)
+                      (Nativeint.rem x y)].
+   If [y = 0], [Nativeint.rem x y] raises [Division_by_zero]. *)
+
+val unsigned_rem : nativeint -> nativeint -> nativeint
+(** Same as {!rem}, except that arguments and result are interpreted as {e
+    unsigned} native integers.
+
+    @since 4.08.0 *)
+
+val succ : nativeint -> nativeint
+(** Successor.
+   [Nativeint.succ x] is [Nativeint.add x Nativeint.one]. *)
+
+val pred : nativeint -> nativeint
+(** Predecessor.
+   [Nativeint.pred x] is [Nativeint.sub x Nativeint.one]. *)
+
+val abs : nativeint -> nativeint
+(** Return the absolute value of its argument. *)
+
+val size : int
+(** The size in bits of a native integer.  This is equal to [32]
+   on a 32-bit platform and to [64] on a 64-bit platform. *)
+
+val max_int : nativeint
+(** The greatest representable native integer,
+   either 2{^31} - 1 on a 32-bit platform,
+   or 2{^63} - 1 on a 64-bit platform. *)
+
+val min_int : nativeint
+(** The smallest representable native integer,
+   either -2{^31} on a 32-bit platform,
+   or -2{^63} on a 64-bit platform. *)
+
+external logand : nativeint -> nativeint -> nativeint = "%nativeint_and"
+(** Bitwise logical and. *)
+
+external logor : nativeint -> nativeint -> nativeint = "%nativeint_or"
+(** Bitwise logical or. *)
+
+external logxor : nativeint -> nativeint -> nativeint = "%nativeint_xor"
+(** Bitwise logical exclusive or. *)
+
+val lognot : nativeint -> nativeint
+(** Bitwise logical negation. *)
+
+external shift_left : nativeint -> int -> nativeint = "%nativeint_lsl"
+(** [Nativeint.shift_left x y] shifts [x] to the left by [y] bits.
+   The result is unspecified if [y < 0] or [y >= bitsize],
+   where [bitsize] is [32] on a 32-bit platform and
+   [64] on a 64-bit platform. *)
+
+external shift_right : nativeint -> int -> nativeint = "%nativeint_asr"
+(** [Nativeint.shift_right x y] shifts [x] to the right by [y] bits.
+   This is an arithmetic shift: the sign bit of [x] is replicated
+   and inserted in the vacated bits.
+   The result is unspecified if [y < 0] or [y >= bitsize]. *)
+
+external shift_right_logical :
+  nativeint -> int -> nativeint = "%nativeint_lsr"
+(** [Nativeint.shift_right_logical x y] shifts [x] to the right
+   by [y] bits.
+   This is a logical shift: zeroes are inserted in the vacated bits
+   regardless of the sign of [x].
+   The result is unspecified if [y < 0] or [y >= bitsize]. *)
+
+
+external of_int : int -> nativeint = "%nativeint_of_int"
+(** Convert the given integer (type [int]) to a native integer
+   (type [nativeint]). *)
+
+external to_int : nativeint -> int = "%nativeint_to_int"
+(** Convert the given native integer (type [nativeint]) to an
+   integer (type [int]).  The high-order bit is lost during
+   the conversion. *)
+
+val unsigned_to_int : nativeint -> int option
+(** Same as {!to_int}, but interprets the argument as an {e unsigned} integer.
+    Returns [None] if the unsigned value of the argument cannot fit into an
+    [int].
+
+    @since 4.08.0 *)
+
+external of_float : float -> nativeint
+  = "caml_nativeint_of_float" "caml_nativeint_of_float_unboxed"
+  [@@unboxed] [@@noalloc]
+(** Convert the given floating-point number to a native integer,
+   discarding the fractional part (truncate towards 0).
+   The result of the conversion is undefined if, after truncation,
+   the number is outside the range
+   \[{!Nativeint.min_int}, {!Nativeint.max_int}\]. *)
+
+external to_float : nativeint -> float
+  = "caml_nativeint_to_float" "caml_nativeint_to_float_unboxed"
+  [@@unboxed] [@@noalloc]
+(** Convert the given native integer to a floating-point number. *)
+
+external of_int32 : int32 -> nativeint = "%nativeint_of_int32"
+(** Convert the given 32-bit integer (type [int32])
+   to a native integer. *)
+
+external to_int32 : nativeint -> int32 = "%nativeint_to_int32"
+(** Convert the given native integer to a
+   32-bit integer (type [int32]).  On 64-bit platforms,
+   the 64-bit native integer is taken modulo 2{^32},
+   i.e. the top 32 bits are lost.  On 32-bit platforms,
+   the conversion is exact. *)
+
+external of_string : string -> nativeint = "caml_nativeint_of_string"
+(** Convert the given string to a native integer.
+   The string is read in decimal (by default, or if the string
+   begins with [0u]) or in hexadecimal, octal or binary if the
+   string begins with [0x], [0o] or [0b] respectively.
+
+   The [0u] prefix reads the input as an unsigned integer in the range
+   [[0, 2*Nativeint.max_int+1]].  If the input exceeds {!Nativeint.max_int}
+   it is converted to the signed integer
+   [Int64.min_int + input - Nativeint.max_int - 1].
+
+   @raise Failure if the given string is not
+   a valid representation of an integer, or if the integer represented
+   exceeds the range of integers representable in type [nativeint]. *)
+
+val of_string_opt: string -> nativeint option
+(** Same as [of_string], but return [None] instead of raising.
+    @since 4.05 *)
+
+val to_string : nativeint -> string
+(** Return the string representation of its argument, in decimal. *)
+
+type t = nativeint
+(** An alias for the type of native integers. *)
+
+val compare: t -> t -> int
+(** The comparison function for native integers, with the same specification as
+    {!Stdlib.compare}.  Along with the type [t], this function [compare]
+    allows the module [Nativeint] to be passed as argument to the functors
+    {!Set.Make} and {!Map.Make}. *)
+
+val unsigned_compare: t -> t -> int
+(** Same as {!compare}, except that arguments are interpreted as {e unsigned}
+    native integers.
+
+    @since 4.08.0 *)
+
+val equal: t -> t -> bool
+(** The equal function for native ints.
+    @since 4.03.0 *)
+
+(**/**)
+
+(** {1 Deprecated functions} *)
+
+external format : string -> nativeint -> string = "caml_nativeint_format"
+(** [Nativeint.format fmt n] return the string representation of the
+   native integer [n] in the format specified by [fmt].
+   [fmt] is a [Printf]-style format consisting of exactly
+   one [%d], [%i], [%u], [%x], [%X] or [%o] conversion specification.
+   This function is deprecated; use {!Printf.sprintf} with a [%nx] format
+   instead. *)
diff --git a/stdlib/obj.ml b/stdlib/obj.ml
new file mode 100644
index 00000000..32049d72
--- /dev/null
+++ b/stdlib/obj.ml
@@ -0,0 +1,160 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Operations on internal representations of values *)
+
+type t
+
+external repr : 'a -> t = "%identity"
+external obj : t -> 'a = "%identity"
+external magic : 'a -> 'b = "%identity"
+external is_int : t -> bool = "%obj_is_int"
+let [@inline always] is_block a = not (is_int a)
+external tag : t -> int = "caml_obj_tag"
+external set_tag : t -> int -> unit = "caml_obj_set_tag"
+external size : t -> int = "%obj_size"
+external reachable_words : t -> int = "caml_obj_reachable_words"
+external field : t -> int -> t = "%obj_field"
+external set_field : t -> int -> t -> unit = "%obj_set_field"
+external floatarray_get : floatarray -> int -> float = "caml_floatarray_get"
+external floatarray_set :
+    floatarray -> int -> float -> unit = "caml_floatarray_set"
+let [@inline always] double_field x i = floatarray_get (obj x : floatarray) i
+let [@inline always] set_double_field x i v =
+  floatarray_set (obj x : floatarray) i v
+external new_block : int -> int -> t = "caml_obj_block"
+external dup : t -> t = "caml_obj_dup"
+external truncate : t -> int -> unit = "caml_obj_truncate"
+external add_offset : t -> Int32.t -> t = "caml_obj_add_offset"
+external with_tag : int -> t -> t = "caml_obj_with_tag"
+
+let marshal (obj : t) =
+  Marshal.to_bytes obj []
+let unmarshal str pos =
+  (Marshal.from_bytes str pos, pos + Marshal.total_size str pos)
+
+let first_non_constant_constructor_tag = 0
+let last_non_constant_constructor_tag = 245
+
+let lazy_tag = 246
+let closure_tag = 247
+let object_tag = 248
+let infix_tag = 249
+let forward_tag = 250
+
+let no_scan_tag = 251
+
+let abstract_tag = 251
+let string_tag = 252
+let double_tag = 253
+let double_array_tag = 254
+let custom_tag = 255
+let final_tag = custom_tag
+
+
+let int_tag = 1000
+let out_of_heap_tag = 1001
+let unaligned_tag = 1002
+
+module Extension_constructor =
+struct
+  type t = extension_constructor
+  let of_val x =
+    let x = repr x in
+    let slot =
+      if (is_block x) && (tag x) <> object_tag && (size x) >= 1 then field x 0
+      else x
+    in
+    let name =
+      if (is_block slot) && (tag slot) = object_tag then field slot 0
+      else invalid_arg "Obj.extension_constructor"
+    in
+      if (tag name) = string_tag then (obj slot : t)
+      else invalid_arg "Obj.extension_constructor"
+
+  let [@inline always] name (slot : t) =
+    (obj (field (repr slot) 0) : string)
+
+  let [@inline always] id (slot : t) =
+    (obj (field (repr slot) 1) : int)
+end
+
+let extension_constructor = Extension_constructor.of_val
+let extension_name = Extension_constructor.name
+let extension_id = Extension_constructor.id
+
+module Ephemeron = struct
+  type obj_t = t
+
+  type t (** ephemeron *)
+
+   (** To change in sync with weak.h *)
+  let additional_values = 2
+  let max_ephe_length = Sys.max_array_length - additional_values
+
+  external create : int -> t = "caml_ephe_create";;
+  let create l =
+    if not (0 <= l && l <= max_ephe_length) then
+      invalid_arg "Obj.Ephemeron.create";
+    create l
+
+  let length x = size(repr x) - additional_values
+
+  let raise_if_invalid_offset e o msg =
+    if not (0 <= o && o < length e) then
+      invalid_arg msg
+
+  external get_key: t -> int -> obj_t option = "caml_ephe_get_key"
+  let get_key e o =
+    raise_if_invalid_offset e o "Obj.Ephemeron.get_key";
+    get_key e o
+
+  external get_key_copy: t -> int -> obj_t option = "caml_ephe_get_key_copy"
+  let get_key_copy e o =
+    raise_if_invalid_offset e o "Obj.Ephemeron.get_key_copy";
+    get_key_copy e o
+
+  external set_key: t -> int -> obj_t -> unit = "caml_ephe_set_key"
+  let set_key e o x =
+    raise_if_invalid_offset e o "Obj.Ephemeron.set_key";
+    set_key e o x
+
+  external unset_key: t -> int -> unit = "caml_ephe_unset_key"
+  let unset_key e o =
+    raise_if_invalid_offset e o "Obj.Ephemeron.unset_key";
+    unset_key e o
+
+  external check_key: t -> int -> bool = "caml_ephe_check_key"
+  let check_key e o =
+    raise_if_invalid_offset e o "Obj.Ephemeron.check_key";
+    check_key e o
+
+  external blit_key : t -> int -> t -> int -> int -> unit
+    = "caml_ephe_blit_key"
+
+  let blit_key e1 o1 e2 o2 l =
+    if l < 0 || o1 < 0 || o1 > length e1 - l
+       || o2 < 0 || o2 > length e2 - l
+    then invalid_arg "Obj.Ephemeron.blit_key"
+    else if l <> 0 then blit_key e1 o1 e2 o2 l
+
+  external get_data: t -> obj_t option = "caml_ephe_get_data"
+  external get_data_copy: t -> obj_t option = "caml_ephe_get_data_copy"
+  external set_data: t -> obj_t -> unit = "caml_ephe_set_data"
+  external unset_data: t -> unit = "caml_ephe_unset_data"
+  external check_data: t -> bool = "caml_ephe_check_data"
+  external blit_data : t -> t -> unit = "caml_ephe_blit_data"
+
+end
diff --git a/stdlib/obj.mli b/stdlib/obj.mli
new file mode 100644
index 00000000..818f315f
--- /dev/null
+++ b/stdlib/obj.mli
@@ -0,0 +1,173 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Operations on internal representations of values.
+
+   Not for the casual user.
+*)
+
+type t
+
+external repr : 'a -> t = "%identity"
+external obj : t -> 'a = "%identity"
+external magic : 'a -> 'b = "%identity"
+val [@inline always] is_block : t -> bool
+external is_int : t -> bool = "%obj_is_int"
+external tag : t -> int = "caml_obj_tag"
+external size : t -> int = "%obj_size"
+external reachable_words : t -> int = "caml_obj_reachable_words"
+  (**
+     Computes the total size (in words, including the headers) of all
+     heap blocks accessible from the argument.  Statically
+     allocated blocks are excluded.
+
+     @Since 4.04
+  *)
+
+external field : t -> int -> t = "%obj_field"
+
+(** When using flambda:
+
+    [set_field] MUST NOT be called on immutable blocks.  (Blocks allocated
+    in C stubs, or with [new_block] below, are always considered mutable.)
+
+    The same goes for [set_double_field] and [set_tag].  However, for
+    [set_tag], in the case of immutable blocks where the middle-end optimizers
+    never see code that discriminates on their tag (for example records), the
+    operation should be safe.  Such uses are nonetheless discouraged.
+
+    For experts only:
+    [set_field] et al can be made safe by first wrapping the block in
+    {!Sys.opaque_identity}, so any information about its contents will not
+    be propagated.
+*)
+external set_field : t -> int -> t -> unit = "%obj_set_field"
+external set_tag : t -> int -> unit = "caml_obj_set_tag"
+  [@@ocaml.deprecated "Use with_tag instead."]
+
+val [@inline always] double_field : t -> int -> float  (* @since 3.11.2 *)
+val [@inline always] set_double_field : t -> int -> float -> unit
+  (* @since 3.11.2 *)
+external new_block : int -> int -> t = "caml_obj_block"
+external dup : t -> t = "caml_obj_dup"
+external truncate : t -> int -> unit = "caml_obj_truncate"
+  [@@ocaml.deprecated]
+external add_offset : t -> Int32.t -> t = "caml_obj_add_offset"
+         (* @since 3.12.0 *)
+external with_tag : int -> t -> t = "caml_obj_with_tag"
+  (* @since 4.09.0 *)
+
+val first_non_constant_constructor_tag : int
+val last_non_constant_constructor_tag : int
+
+val lazy_tag : int
+val closure_tag : int
+val object_tag : int
+val infix_tag : int
+val forward_tag : int
+val no_scan_tag : int
+val abstract_tag : int
+val string_tag : int   (* both [string] and [bytes] *)
+val double_tag : int
+val double_array_tag : int
+val custom_tag : int
+val final_tag : int
+  [@@ocaml.deprecated "Replaced by custom_tag."]
+
+val int_tag : int
+val out_of_heap_tag : int
+val unaligned_tag : int   (* should never happen @since 3.11.0 *)
+
+module Extension_constructor :
+sig
+  type t = extension_constructor
+  val of_val : 'a -> t
+  val [@inline always] name : t -> string
+  val [@inline always] id : t -> int
+end
+val extension_constructor : 'a -> extension_constructor
+  [@@ocaml.deprecated "use Obj.Extension_constructor.of_val"]
+val [@inline always] extension_name : extension_constructor -> string
+  [@@ocaml.deprecated "use Obj.Extension_constructor.name"]
+val [@inline always] extension_id : extension_constructor -> int
+  [@@ocaml.deprecated "use Obj.Extension_constructor.id"]
+
+(** The following two functions are deprecated.  Use module {!Marshal}
+    instead. *)
+
+val marshal : t -> bytes
+  [@@ocaml.deprecated "Use Marshal.to_bytes instead."]
+val unmarshal : bytes -> int -> t * int
+  [@@ocaml.deprecated "Use Marshal.from_bytes and Marshal.total_size instead."]
+
+module Ephemeron: sig
+  (** Ephemeron with arbitrary arity and untyped *)
+
+  type obj_t = t
+  (** alias for {!Obj.t} *)
+
+  type t
+  (** an ephemeron cf {!Ephemeron} *)
+
+  val create: int -> t
+  (** [create n] returns an ephemeron with [n] keys.
+      All the keys and the data are initially empty.
+      The argument [n] must be between zero
+      and {!max_ephe_length} (limits included).
+  *)
+
+  val length: t -> int
+  (** return the number of keys *)
+
+  val get_key: t -> int -> obj_t option
+  (** Same as {!Ephemeron.K1.get_key} *)
+
+  val get_key_copy: t -> int -> obj_t option
+  (** Same as {!Ephemeron.K1.get_key_copy} *)
+
+  val set_key: t -> int -> obj_t -> unit
+  (** Same as {!Ephemeron.K1.set_key} *)
+
+  val unset_key: t -> int -> unit
+  (** Same as {!Ephemeron.K1.unset_key} *)
+
+  val check_key: t -> int -> bool
+  (** Same as {!Ephemeron.K1.check_key} *)
+
+  val blit_key : t -> int -> t -> int -> int -> unit
+  (** Same as {!Ephemeron.K1.blit_key} *)
+
+  val get_data: t -> obj_t option
+  (** Same as {!Ephemeron.K1.get_data} *)
+
+  val get_data_copy: t -> obj_t option
+  (** Same as {!Ephemeron.K1.get_data_copy} *)
+
+  val set_data: t -> obj_t -> unit
+  (** Same as {!Ephemeron.K1.set_data} *)
+
+  val unset_data: t -> unit
+  (** Same as {!Ephemeron.K1.unset_data} *)
+
+  val check_data: t -> bool
+  (** Same as {!Ephemeron.K1.check_data} *)
+
+  val blit_data : t -> t -> unit
+  (** Same as {!Ephemeron.K1.blit_data} *)
+
+  val max_ephe_length: int
+  (** Maximum length of an ephemeron, ie the maximum number of keys an
+      ephemeron could contain *)
+end
diff --git a/stdlib/ocaml_operators.mld b/stdlib/ocaml_operators.mld
new file mode 100644
index 00000000..de7f30ef
--- /dev/null
+++ b/stdlib/ocaml_operators.mld
@@ -0,0 +1,100 @@
+Precedence level and associativity of operators
+
+The following table lists the precedence level of all operator classes
+from the highest to the lowest precedence. A few other syntactic constructions
+are also listed as references.
+
+{%latex:
+%
+% Note: the tables below should be kept in sync with the one in
+% manual/manual/refman/expr.etex .
+%
+\begin{tabular}{cc}
+\hline
+Operator class                                       & Associativity \\
+\hline
+$!\ldots$ $\tilde{}\ldots$                                    &  --   \\
+$.\cdots()$ $.\cdots[]$ $.\cdots\\{\\}$                       &  --   \\
+\#\ldots                                                      & left  \\
+function application                                          & left  \\
+- -.                                                          &  --   \\
+$**\ldots$ lsl lsr asr                                        & right \\
+$*\ldots$ /\ldots \%\ldots  mod land lor lxor                 & left  \\
++\ldots -\ldots                                               & left  \\
+::                                                            & right \\
+@\ldots \textasciicircum\ldots                                & right \\
+=\ldots <\ldots >\ldots |\ldots \&\ldots \$\ldots !=          & left  \\
+\& \&\&                                                       & right \\
+or ||                                                         & right \\
+,                                                             &  --   \\
+<- :=                                                         & right \\
+if                                                            &  --   \\
+;                                                             & right \\
+\hline
+\end{tabular}
+%}
+
+{%html:
+<table align=center border=1>
+<thead><tr><th>Operator class</th><th>Associativity </th></tr></thead>
+<tr><td><code class=code>!… ~…</code>     </td><td>–</td></tr>
+<tr><td><code class=code>.…() .…[] .…{} </code>
+                                                      </td><td>–</td></tr>
+<tr><td><code class=code>#…</code>              </td><td> left </td></tr>
+<tr><td><code class=code>function application</code>  </td><td> left </td></tr>
+<tr><td><code class=code>- -.</code>                  </td><td>–</td></tr>
+<tr><td><code class=code>**… lsl lsr asr </code></td><td> right </td></tr>
+<tr><td><code class=code>*…  /… %… mod land lor lxor</code>
+                                                      </td><td> left  </td></tr>
+<tr><td><code class=code>+… -…</code>     </td><td> left  </td></tr>
+<tr><td><code class=code>::</code>                    </td><td> right </td></tr>
+<tr><td><code class=code>@… ^…            </td><td> right </td></tr>
+<tr><td><code class=code>=… <…
+>… |… &… $… !=</code>     </td><td> left  </td></tr>
+<tr><td><code class=code>& &&</code>      </td><td> right </td></tr>
+<tr><td><code class=code>or || </code>                </td><td> right </td></tr>
+<tr><td><code class=code>,</code>                     </td><td>–</td></tr>
+<tr><td><code class=code><- :=</code>                 </td><td> right </td></tr>
+<tr><td><code class=code>if</code>                    </td><td>–</td></tr>
+<tr><td><code class=code>;</code>                     </td><td> right </td></tr>
+</table>
+%}
+
+{%man:
+.IP Associativity
+Operator class
+.IP -
+!.. ~..
+.IP -
+\&.() .[] .{}
+.IP left
+#..
+.IP left
+function application
+.IP -
+- -.
+.IP right
+**.. lsl lsr asr
+.IP left
+*..  /.. %.. mod land lor lxor
+.IP left
++.. -..
+.IP right
+::
+.IP right
+@.. ^..
+.IP left
+=.. <.. >.. |.. &.. $.. !=
+.IP right
+& &&
+.IP right
+or ||
+.IP -
+,
+.IP right
+<- :=
+.IP -
+if
+.IP right
+;
+%}
diff --git a/stdlib/oo.ml b/stdlib/oo.ml
new file mode 100644
index 00000000..3833b972
--- /dev/null
+++ b/stdlib/oo.ml
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let copy = CamlinternalOO.copy
+external id : < .. > -> int = "%field1"
+let new_method = CamlinternalOO.public_method_label
+let public_method_label = CamlinternalOO.public_method_label
diff --git a/stdlib/oo.mli b/stdlib/oo.mli
new file mode 100644
index 00000000..9be20c14
--- /dev/null
+++ b/stdlib/oo.mli
@@ -0,0 +1,38 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Operations on objects *)
+
+val copy : (< .. > as 'a) -> 'a
+(** [Oo.copy o] returns a copy of object [o], that is a fresh
+   object with the same methods and instance variables as [o]. *)
+
+external id : < .. > -> int = "%field1"
+(** Return an integer identifying this object, unique for
+    the current execution of the program. The generic comparison
+    and hashing functions are based on this integer. When an object
+    is obtained by unmarshaling, the id is refreshed, and thus
+    different from the original object. As a consequence, the internal
+    invariants of data structures such as hash table or sets containing
+    objects are broken after unmarshaling the data structures.
+  *)
+
+(**/**)
+
+(* The following is for system use only. Do not call directly. *)
+
+(** For internal use (CamlIDL) *)
+val new_method : string -> CamlinternalOO.tag
+val public_method_label : string -> CamlinternalOO.tag
diff --git a/stdlib/option.ml b/stdlib/option.ml
new file mode 100644
index 00000000..c6a56bef
--- /dev/null
+++ b/stdlib/option.ml
@@ -0,0 +1,43 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         The OCaml programmers                          *)
+(*                                                                        *)
+(*   Copyright 2018 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 'a t = 'a option = None | Some of 'a
+
+let none = None
+let some v = Some v
+let value o ~default = match o with Some v -> v | None -> default
+let get = function Some v -> v | None -> invalid_arg "option is None"
+let bind o f = match o with None -> None | Some v -> f v
+let join = function Some o -> o | None -> None
+let map f o = match o with None -> None | Some v -> Some (f v)
+let fold ~none ~some = function Some v -> some v | None -> none
+let iter f = function Some v -> f v | None -> ()
+let is_none = function None -> true | Some _ -> false
+let is_some = function None -> false | Some _ -> true
+
+let equal eq o0 o1 = match o0, o1 with
+| Some v0, Some v1 -> eq v0 v1
+| None, None -> true
+| _ -> false
+
+let compare cmp o0 o1 = match o0, o1 with
+| Some v0, Some v1 -> cmp v0 v1
+| None, None -> 0
+| None, Some _ -> -1
+| Some _, None -> 1
+
+let to_result ~none = function None -> Error none | Some v -> Ok v
+let to_list = function None -> [] | Some v -> [v]
+let to_seq = function None -> Seq.empty | Some v -> Seq.return v
diff --git a/stdlib/option.mli b/stdlib/option.mli
new file mode 100644
index 00000000..01b665fc
--- /dev/null
+++ b/stdlib/option.mli
@@ -0,0 +1,82 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         The OCaml programmers                          *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Option values.
+
+    Option values explicitly indicate the presence or absence of a value.
+
+    @since 4.08 *)
+
+(** {1:options Options} *)
+
+type 'a t = 'a option = None | Some of 'a (**)
+(** The type for option values. Either [None] or a value [Some v]. *)
+
+val none : 'a option
+(** [none] is [None]. *)
+
+val some : 'a -> 'a option
+(** [some v] is [Some v]. *)
+
+val value : 'a option -> default:'a -> 'a
+(** [value o ~default] is [v] if [o] is [Some v] and [default] otherwise. *)
+
+val get : 'a option -> 'a
+(** [get o] is [v] if [o] is [Some v] and @raise Invalid_argument otherwise. *)
+
+val bind : 'a option -> ('a -> 'b option) -> 'b option
+(** [bind o f] is [f v] if [o] is [Some v] and [None] if [o] is [None]. *)
+
+val join : 'a option option -> 'a option
+(** [join oo] is [Some v] if [oo] is [Some (Some v)] and [None] otherwise. *)
+
+val map : ('a -> 'b) -> 'a option -> 'b option
+(** [map f o] is [None] if [o] is [None] and [Some (f v)] is [o] is [Some v]. *)
+
+val fold : none:'a -> some:('b -> 'a) -> 'b option -> 'a
+(** [fold ~none ~some o] is [none] if [o] is [None] and [some v] if [o] is
+    [Some v]. *)
+
+val iter : ('a -> unit) -> 'a option -> unit
+(** [iter f o] is [f v] if [o] is [Some v] and [()] otherwise. *)
+
+(** {1:preds Predicates and comparisons} *)
+
+val is_none : 'a option -> bool
+(** [is_none o] is [true] iff [o] is [None]. *)
+
+val is_some : 'a option -> bool
+(** [is_some o] is [true] iff [o] is [Some o]. *)
+
+val equal : ('a -> 'a -> bool) -> 'a option -> 'a option -> bool
+(** [equal eq o0 o1] is [true] iff [o0] and [o1] are both [None] or if
+    they are [Some v0] and [Some v1] and [eq v0 v1] is [true]. *)
+
+val compare : ('a -> 'a -> int) -> 'a option -> 'a option -> int
+(** [compare cmp o0 o1] is a total order on options using [cmp] to compare
+    values wrapped by [Some _]. [None] is smaller than [Some _] values. *)
+
+(** {1:convert Converting} *)
+
+val to_result : none:'e -> 'a option -> ('a, 'e) result
+(** [to_result ~none o] is [Ok v] if [o] is [Some v] and [Error none]
+    otherwise. *)
+
+val to_list : 'a option -> 'a list
+(** [to_list o] is [[]] if [o] is [None] and [[v]] if [o] is [Some v]. *)
+
+val to_seq : 'a option -> 'a Seq.t
+(** [to_seq o] is [o] as a sequence. [None] is the empty sequence and
+    [Some v] is the singleton sequence containing [v]. *)
diff --git a/stdlib/parsing.ml b/stdlib/parsing.ml
new file mode 100644
index 00000000..3b779f5c
--- /dev/null
+++ b/stdlib/parsing.ml
@@ -0,0 +1,211 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The parsing engine *)
+
+open Lexing
+
+(* Internal interface to the parsing engine *)
+
+type parser_env =
+  { mutable s_stack : int array;        (* States *)
+    mutable v_stack : Obj.t array;      (* Semantic attributes *)
+    mutable symb_start_stack : position array; (* Start positions *)
+    mutable symb_end_stack : position array;   (* End positions *)
+    mutable stacksize : int;            (* Size of the stacks *)
+    mutable stackbase : int;            (* Base sp for current parse *)
+    mutable curr_char : int;            (* Last token read *)
+    mutable lval : Obj.t;               (* Its semantic attribute *)
+    mutable symb_start : position;      (* Start pos. of the current symbol*)
+    mutable symb_end : position;        (* End pos. of the current symbol *)
+    mutable asp : int;                  (* The stack pointer for attributes *)
+    mutable rule_len : int;             (* Number of rhs items in the rule *)
+    mutable rule_number : int;          (* Rule number to reduce by *)
+    mutable sp : int;                   (* Saved sp for parse_engine *)
+    mutable state : int;                (* Saved state for parse_engine *)
+    mutable errflag : int }             (* Saved error flag for parse_engine *)
+
+type parse_tables =
+  { actions : (parser_env -> Obj.t) array;
+    transl_const : int array;
+    transl_block : int array;
+    lhs : string;
+    len : string;
+    defred : string;
+    dgoto : string;
+    sindex : string;
+    rindex : string;
+    gindex : string;
+    tablesize : int;
+    table : string;
+    check : string;
+    error_function : string -> unit;
+    names_const : string;
+    names_block : string }
+
+exception YYexit of Obj.t
+exception Parse_error
+
+type parser_input =
+    Start
+  | Token_read
+  | Stacks_grown_1
+  | Stacks_grown_2
+  | Semantic_action_computed
+  | Error_detected
+
+type parser_output =
+    Read_token
+  | Raise_parse_error
+  | Grow_stacks_1
+  | Grow_stacks_2
+  | Compute_semantic_action
+  | Call_error_function
+
+(* to avoid warnings *)
+let _ = [Read_token; Raise_parse_error; Grow_stacks_1; Grow_stacks_2;
+         Compute_semantic_action; Call_error_function]
+
+external parse_engine :
+    parse_tables -> parser_env -> parser_input -> Obj.t -> parser_output
+    = "caml_parse_engine"
+
+external set_trace: bool -> bool
+    = "caml_set_parser_trace"
+
+let env =
+  { s_stack = Array.make 100 0;
+    v_stack = Array.make 100 (Obj.repr ());
+    symb_start_stack = Array.make 100 dummy_pos;
+    symb_end_stack = Array.make 100 dummy_pos;
+    stacksize = 100;
+    stackbase = 0;
+    curr_char = 0;
+    lval = Obj.repr ();
+    symb_start = dummy_pos;
+    symb_end = dummy_pos;
+    asp = 0;
+    rule_len = 0;
+    rule_number = 0;
+    sp = 0;
+    state = 0;
+    errflag = 0 }
+
+let grow_stacks() =
+  let oldsize = env.stacksize in
+  let newsize = oldsize * 2 in
+  let new_s = Array.make newsize 0
+  and new_v = Array.make newsize (Obj.repr ())
+  and new_start = Array.make newsize dummy_pos
+  and new_end = Array.make newsize dummy_pos in
+    Array.blit env.s_stack 0 new_s 0 oldsize;
+    env.s_stack <- new_s;
+    Array.blit env.v_stack 0 new_v 0 oldsize;
+    env.v_stack <- new_v;
+    Array.blit env.symb_start_stack 0 new_start 0 oldsize;
+    env.symb_start_stack <- new_start;
+    Array.blit env.symb_end_stack 0 new_end 0 oldsize;
+    env.symb_end_stack <- new_end;
+    env.stacksize <- newsize
+
+let clear_parser() =
+  Array.fill env.v_stack 0 env.stacksize (Obj.repr ());
+  env.lval <- Obj.repr ()
+
+let current_lookahead_fun = ref (fun (_ : Obj.t) -> false)
+
+let yyparse tables start lexer lexbuf =
+  let rec loop cmd arg =
+    match parse_engine tables env cmd arg with
+      Read_token ->
+        let t = Obj.repr(lexer lexbuf) in
+        env.symb_start <- lexbuf.lex_start_p;
+        env.symb_end <- lexbuf.lex_curr_p;
+        loop Token_read t
+    | Raise_parse_error ->
+        raise Parse_error
+    | Compute_semantic_action ->
+        let (action, value) =
+          try
+            (Semantic_action_computed, tables.actions.(env.rule_number) env)
+          with Parse_error ->
+            (Error_detected, Obj.repr ()) in
+        loop action value
+    | Grow_stacks_1 ->
+        grow_stacks(); loop Stacks_grown_1 (Obj.repr ())
+    | Grow_stacks_2 ->
+        grow_stacks(); loop Stacks_grown_2 (Obj.repr ())
+    | Call_error_function ->
+        tables.error_function "syntax error";
+        loop Error_detected (Obj.repr ()) in
+  let init_asp = env.asp
+  and init_sp = env.sp
+  and init_stackbase = env.stackbase
+  and init_state = env.state
+  and init_curr_char = env.curr_char
+  and init_lval = env.lval
+  and init_errflag = env.errflag in
+  env.stackbase <- env.sp + 1;
+  env.curr_char <- start;
+  env.symb_end <- lexbuf.lex_curr_p;
+  try
+    loop Start (Obj.repr ())
+  with exn ->
+    let curr_char = env.curr_char in
+    env.asp <- init_asp;
+    env.sp <- init_sp;
+    env.stackbase <- init_stackbase;
+    env.state <- init_state;
+    env.curr_char <- init_curr_char;
+    env.lval <- init_lval;
+    env.errflag <- init_errflag;
+    match exn with
+      YYexit v ->
+        Obj.magic v
+    | _ ->
+        current_lookahead_fun :=
+          (fun tok ->
+            if Obj.is_block tok
+            then tables.transl_block.(Obj.tag tok) = curr_char
+            else tables.transl_const.(Obj.magic tok) = curr_char);
+        raise exn
+
+let peek_val env n =
+  Obj.magic env.v_stack.(env.asp - n)
+
+let symbol_start_pos () =
+  let rec loop i =
+    if i <= 0 then env.symb_end_stack.(env.asp)
+    else begin
+      let st = env.symb_start_stack.(env.asp - i + 1) in
+      let en = env.symb_end_stack.(env.asp - i + 1) in
+      if st <> en then st else loop (i - 1)
+    end
+  in
+  loop env.rule_len
+
+let symbol_end_pos () = env.symb_end_stack.(env.asp)
+let rhs_start_pos n = env.symb_start_stack.(env.asp - (env.rule_len - n))
+let rhs_end_pos n = env.symb_end_stack.(env.asp - (env.rule_len - n))
+
+let symbol_start () = (symbol_start_pos ()).pos_cnum
+let symbol_end () = (symbol_end_pos ()).pos_cnum
+let rhs_start n = (rhs_start_pos n).pos_cnum
+let rhs_end n = (rhs_end_pos n).pos_cnum
+
+let is_current_lookahead tok =
+  (!current_lookahead_fun)(Obj.repr tok)
+
+let parse_error (_ : string) = ()
diff --git a/stdlib/parsing.mli b/stdlib/parsing.mli
new file mode 100644
index 00000000..73b9504d
--- /dev/null
+++ b/stdlib/parsing.mli
@@ -0,0 +1,105 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The run-time library for parsers generated by [ocamlyacc]. *)
+
+val symbol_start : unit -> int
+(** [symbol_start] and {!Parsing.symbol_end} are to be called in the
+   action part of a grammar rule only. They return the offset of the
+   string that matches the left-hand side of the rule: [symbol_start()]
+   returns the offset of the first character; [symbol_end()] returns the
+   offset after the last character. The first character in a file is at
+   offset 0. *)
+
+val symbol_end : unit -> int
+(** See {!Parsing.symbol_start}. *)
+
+val rhs_start : int -> int
+(** Same as {!Parsing.symbol_start} and {!Parsing.symbol_end}, but
+   return the offset of the string matching the [n]th item on the
+   right-hand side of the rule, where [n] is the integer parameter
+   to [rhs_start] and [rhs_end]. [n] is 1 for the leftmost item. *)
+
+val rhs_end : int -> int
+(** See {!Parsing.rhs_start}. *)
+
+val symbol_start_pos : unit -> Lexing.position
+(** Same as [symbol_start], but return a [position] instead of an offset. *)
+
+val symbol_end_pos : unit -> Lexing.position
+(** Same as [symbol_end], but return a [position] instead of an offset. *)
+
+val rhs_start_pos : int -> Lexing.position
+(** Same as [rhs_start], but return a [position] instead of an offset. *)
+
+val rhs_end_pos : int -> Lexing.position
+(** Same as [rhs_end], but return a [position] instead of an offset. *)
+
+val clear_parser : unit -> unit
+(** Empty the parser stack. Call it just after a parsing function
+   has returned, to remove all pointers from the parser stack
+   to structures that were built by semantic actions during parsing.
+   This is optional, but lowers the memory requirements of the
+   programs. *)
+
+exception Parse_error
+(** Raised when a parser encounters a syntax error.
+   Can also be raised from the action part of a grammar rule,
+   to initiate error recovery. *)
+
+val set_trace: bool -> bool
+(** Control debugging support for [ocamlyacc]-generated parsers.
+    After [Parsing.set_trace true], the pushdown automaton that
+    executes the parsers prints a trace of its actions (reading a token,
+    shifting a state, reducing by a rule) on standard output.
+    [Parsing.set_trace false] turns this debugging trace off.
+    The boolean returned is the previous state of the trace flag.
+    @since 3.11.0
+*)
+
+(**/**)
+
+(** {1  } *)
+
+(** The following definitions are used by the generated parsers only.
+   They are not intended to be used directly by user programs. *)
+
+type parser_env
+
+type parse_tables =
+  { actions : (parser_env -> Obj.t) array;
+    transl_const : int array;
+    transl_block : int array;
+    lhs : string;
+    len : string;
+    defred : string;
+    dgoto : string;
+    sindex : string;
+    rindex : string;
+    gindex : string;
+    tablesize : int;
+    table : string;
+    check : string;
+    error_function : string -> unit;
+    names_const : string;
+    names_block : string }
+
+exception YYexit of Obj.t
+
+val yyparse :
+  parse_tables -> int -> (Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> 'b
+val peek_val : parser_env -> int -> 'a
+val is_current_lookahead : 'a -> bool
+val parse_error : string -> unit
diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
new file mode 100644
index 00000000..e9b2e5cd
--- /dev/null
+++ b/stdlib/pervasives.ml
@@ -0,0 +1,244 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Jeremie Dimino, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** @deprecated Use {!Stdlib} *)
+
+external raise : exn -> 'a = "%raise"
+external raise_notrace : exn -> 'a = "%raise_notrace"
+let invalid_arg = invalid_arg
+let failwith = failwith
+exception Exit
+external ( = ) : 'a -> 'a -> bool = "%equal"
+external ( <> ) : 'a -> 'a -> bool = "%notequal"
+external ( < ) : 'a -> 'a -> bool = "%lessthan"
+external ( > ) : 'a -> 'a -> bool = "%greaterthan"
+external ( <= ) : 'a -> 'a -> bool = "%lessequal"
+external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
+external compare : 'a -> 'a -> int = "%compare"
+let min = min
+let max = max
+external ( == ) : 'a -> 'a -> bool = "%eq"
+external ( != ) : 'a -> 'a -> bool = "%noteq"
+external not : bool -> bool = "%boolnot"
+external ( && ) : bool -> bool -> bool = "%sequand"
+external ( & ) : bool -> bool -> bool = "%sequand"
+  [@@ocaml.deprecated "Use (&&) instead."]
+external ( || ) : bool -> bool -> bool = "%sequor"
+external ( or ) : bool -> bool -> bool = "%sequor"
+  [@@ocaml.deprecated "Use (||) instead."]
+external __LOC__ : string = "%loc_LOC"
+external __FILE__ : string = "%loc_FILE"
+external __LINE__ : int = "%loc_LINE"
+external __MODULE__ : string = "%loc_MODULE"
+external __POS__ : string * int * int * int = "%loc_POS"
+external __LOC_OF__ : 'a -> string * 'a = "%loc_LOC"
+external __LINE_OF__ : 'a -> int * 'a = "%loc_LINE"
+external __POS_OF__ : 'a -> (string * int * int * int) * 'a = "%loc_POS"
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
+external ( ~- ) : int -> int = "%negint"
+external ( ~+ ) : int -> int = "%identity"
+external succ : int -> int = "%succint"
+external pred : int -> int = "%predint"
+external ( + ) : int -> int -> int = "%addint"
+external ( - ) : int -> int -> int = "%subint"
+external ( * ) : int -> int -> int = "%mulint"
+external ( / ) : int -> int -> int = "%divint"
+external ( mod ) : int -> int -> int = "%modint"
+let abs = abs
+let max_int = max_int
+let min_int = min_int
+external ( land ) : int -> int -> int = "%andint"
+external ( lor ) : int -> int -> int = "%orint"
+external ( lxor ) : int -> int -> int = "%xorint"
+let lnot = lnot
+external ( lsl ) : int -> int -> int = "%lslint"
+external ( lsr ) : int -> int -> int = "%lsrint"
+external ( asr ) : int -> int -> int = "%asrint"
+external ( ~-. ) : float -> float = "%negfloat"
+external ( ~+. ) : float -> float = "%identity"
+external ( +. ) : float -> float -> float = "%addfloat"
+external ( -. ) : float -> float -> float = "%subfloat"
+external ( *. ) : float -> float -> float = "%mulfloat"
+external ( /. ) : float -> float -> float = "%divfloat"
+external ( ** ) : float -> float -> float = "caml_power_float" "pow"
+  [@@unboxed] [@@noalloc]
+external sqrt : float -> float = "caml_sqrt_float" "sqrt"
+  [@@unboxed] [@@noalloc]
+external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc]
+external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc]
+external log10 : float -> float = "caml_log10_float" "log10"
+  [@@unboxed] [@@noalloc]
+external expm1 : float -> float = "caml_expm1_float" "caml_expm1"
+  [@@unboxed] [@@noalloc]
+external log1p : float -> float = "caml_log1p_float" "caml_log1p"
+  [@@unboxed] [@@noalloc]
+external cos : float -> float = "caml_cos_float" "cos" [@@unboxed] [@@noalloc]
+external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc]
+external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc]
+external acos : float -> float = "caml_acos_float" "acos"
+  [@@unboxed] [@@noalloc]
+external asin : float -> float = "caml_asin_float" "asin"
+  [@@unboxed] [@@noalloc]
+external atan : float -> float = "caml_atan_float" "atan"
+  [@@unboxed] [@@noalloc]
+external atan2 : float -> float -> float = "caml_atan2_float" "atan2"
+  [@@unboxed] [@@noalloc]
+external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot"
+  [@@unboxed] [@@noalloc]
+external cosh : float -> float = "caml_cosh_float" "cosh"
+  [@@unboxed] [@@noalloc]
+external sinh : float -> float = "caml_sinh_float" "sinh"
+  [@@unboxed] [@@noalloc]
+external tanh : float -> float = "caml_tanh_float" "tanh"
+  [@@unboxed] [@@noalloc]
+external ceil : float -> float = "caml_ceil_float" "ceil"
+  [@@unboxed] [@@noalloc]
+external floor : float -> float = "caml_floor_float" "floor"
+  [@@unboxed] [@@noalloc]
+external abs_float : float -> float = "%absfloat"
+external copysign : float -> float -> float
+                  = "caml_copysign_float" "caml_copysign"
+                  [@@unboxed] [@@noalloc]
+external mod_float : float -> float -> float = "caml_fmod_float" "fmod"
+  [@@unboxed] [@@noalloc]
+external frexp : float -> float * int = "caml_frexp_float"
+external ldexp : (float [@unboxed]) -> (int [@untagged]) -> (float [@unboxed]) =
+  "caml_ldexp_float" "caml_ldexp_float_unboxed" [@@noalloc]
+external modf : float -> float * float = "caml_modf_float"
+external float : int -> float = "%floatofint"
+external float_of_int : int -> float = "%floatofint"
+external truncate : float -> int = "%intoffloat"
+external int_of_float : float -> int = "%intoffloat"
+let infinity = infinity
+let neg_infinity = neg_infinity
+let nan = nan
+let max_float = max_float
+let min_float = min_float
+let epsilon_float = epsilon_float
+type nonrec fpclass = fpclass =
+    FP_normal
+  | FP_subnormal
+  | FP_zero
+  | FP_infinite
+  | FP_nan
+external classify_float : (float [@unboxed]) -> fpclass =
+  "caml_classify_float" "caml_classify_float_unboxed" [@@noalloc]
+let ( ^ ) = ( ^ )
+external int_of_char : char -> int = "%identity"
+let char_of_int = char_of_int
+external ignore : 'a -> unit = "%ignore"
+let string_of_bool = string_of_bool
+let bool_of_string = bool_of_string
+let bool_of_string_opt = bool_of_string_opt
+let string_of_int = string_of_int
+external int_of_string : string -> int = "caml_int_of_string"
+let int_of_string_opt = int_of_string_opt
+let string_of_float = string_of_float
+external float_of_string : string -> float = "caml_float_of_string"
+let float_of_string_opt = float_of_string_opt
+external fst : 'a * 'b -> 'a = "%field0"
+external snd : 'a * 'b -> 'b = "%field1"
+let ( @ )  = ( @ )
+type nonrec in_channel = in_channel
+type nonrec out_channel = out_channel
+let stdin = stdin
+let stdout = stdout
+let stderr = stderr
+let print_char = print_char
+let print_string = print_string
+let print_bytes = print_bytes
+let print_int = print_int
+let print_float = print_float
+let print_endline = print_endline
+let print_newline = print_newline
+let prerr_char = prerr_char
+let prerr_string = prerr_string
+let prerr_bytes = prerr_bytes
+let prerr_int = prerr_int
+let prerr_float = prerr_float
+let prerr_endline = prerr_endline
+let prerr_newline = prerr_newline
+let read_line = read_line
+let read_int = read_int
+let read_int_opt = read_int_opt
+let read_float = read_float
+let read_float_opt = read_float_opt
+type nonrec open_flag = open_flag =
+    Open_rdonly
+  | Open_wronly
+  | Open_append
+  | Open_creat
+  | Open_trunc
+  | Open_excl
+  | Open_binary
+  | Open_text
+  | Open_nonblock
+let open_out = open_out
+let open_out_bin = open_out_bin
+let open_out_gen = open_out_gen
+let flush = flush
+let flush_all = flush_all
+let output_char = output_char
+let output_string = output_string
+let output_bytes = output_bytes
+let output = output
+let output_substring = output_substring
+let output_byte = output_byte
+let output_binary_int = output_binary_int
+let output_value = output_value
+let seek_out = seek_out
+let pos_out = pos_out
+let out_channel_length = out_channel_length
+let close_out = close_out
+let close_out_noerr = close_out_noerr
+let set_binary_mode_out = set_binary_mode_out
+let open_in = open_in
+let open_in_bin = open_in_bin
+let open_in_gen = open_in_gen
+let input_char = input_char
+let input_line = input_line
+let input = input
+let really_input = really_input
+let really_input_string = really_input_string
+let input_byte = input_byte
+let input_binary_int = input_binary_int
+let input_value = input_value
+let seek_in = seek_in
+let pos_in = pos_in
+let in_channel_length = in_channel_length
+let close_in = close_in
+let close_in_noerr = close_in_noerr
+let set_binary_mode_in = set_binary_mode_in
+module LargeFile = LargeFile
+type nonrec 'a ref = 'a ref = { mutable contents : 'a }
+external ref : 'a -> 'a ref = "%makemutable"
+external ( ! ) : 'a ref -> 'a = "%field0"
+external ( := ) : 'a ref -> 'a -> unit = "%setfield0"
+external incr : int ref -> unit = "%incr"
+external decr : int ref -> unit = "%decr"
+type nonrec ('a,'b) result = ('a,'b) result = Ok of 'a | Error of 'b
+type ('a, 'b, 'c, 'd, 'e, 'f) format6 =
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
+type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
+type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
+let string_of_format = string_of_format
+external format_of_string :
+  ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+  ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
+let ( ^^ ) = ( ^^ )
+let exit = exit
+let at_exit = at_exit
+let valid_float_lexem = valid_float_lexem
+let do_at_exit = do_at_exit
diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml
new file mode 100644
index 00000000..8b6822d1
--- /dev/null
+++ b/stdlib/printexc.ml
@@ -0,0 +1,337 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Printf
+
+type t = exn = ..
+
+let printers = ref []
+
+let locfmt = format_of_string "File \"%s\", line %d, characters %d-%d: %s"
+
+let field x i =
+  let f = Obj.field x i in
+  if not (Obj.is_block f) then
+    sprintf "%d" (Obj.magic f : int)           (* can also be a char *)
+  else if Obj.tag f = Obj.string_tag then
+    sprintf "%S" (Obj.magic f : string)
+  else if Obj.tag f = Obj.double_tag then
+    string_of_float (Obj.magic f : float)
+  else
+    "_"
+
+let rec other_fields x i =
+  if i >= Obj.size x then ""
+  else sprintf ", %s%s" (field x i) (other_fields x (i+1))
+
+let fields x =
+  match Obj.size x with
+  | 0 -> ""
+  | 1 -> ""
+  | 2 -> sprintf "(%s)" (field x 1)
+  | _ -> sprintf "(%s%s)" (field x 1) (other_fields x 2)
+
+let use_printers x =
+  let rec conv = function
+    | hd :: tl ->
+        (match hd x with
+         | None | exception _ -> conv tl
+         | Some s -> Some s)
+    | [] -> None in
+  conv !printers
+
+let to_string_default = function
+  | Out_of_memory -> "Out of memory"
+  | Stack_overflow -> "Stack overflow"
+  | Match_failure(file, line, char) ->
+      sprintf locfmt file line char (char+5) "Pattern matching failed"
+  | Assert_failure(file, line, char) ->
+      sprintf locfmt file line char (char+6) "Assertion failed"
+  | Undefined_recursive_module(file, line, char) ->
+      sprintf locfmt file line char (char+6) "Undefined recursive module"
+  | x ->
+      let x = Obj.repr x in
+      if Obj.tag x <> 0 then
+        (Obj.magic (Obj.field x 0) : string)
+      else
+        let constructor =
+          (Obj.magic (Obj.field (Obj.field x 0) 0) : string) in
+        constructor ^ (fields x)
+
+let to_string e =
+  match use_printers e with
+  | Some s -> s
+  | None -> to_string_default e
+
+let print fct arg =
+  try
+    fct arg
+  with x ->
+    eprintf "Uncaught exception: %s\n" (to_string x);
+    flush stderr;
+    raise x
+
+let catch fct arg =
+  try
+    fct arg
+  with x ->
+    flush stdout;
+    eprintf "Uncaught exception: %s\n" (to_string x);
+    exit 2
+
+type raw_backtrace_slot
+type raw_backtrace
+
+external get_raw_backtrace:
+  unit -> raw_backtrace = "caml_get_exception_raw_backtrace"
+
+external raise_with_backtrace: exn -> raw_backtrace -> 'a
+  = "%raise_with_backtrace"
+
+type backtrace_slot =
+  | Known_location of {
+      is_raise    : bool;
+      filename    : string;
+      line_number : int;
+      start_char  : int;
+      end_char    : int;
+      is_inline   : bool;
+      defname     : string;
+    }
+  | Unknown_location of {
+      is_raise : bool
+    }
+
+(* to avoid warning *)
+let _ = [Known_location { is_raise = false; filename = "";
+                          line_number = 0; start_char = 0; end_char = 0;
+                          is_inline = false; defname = "" };
+         Unknown_location { is_raise = false }]
+
+external convert_raw_backtrace_slot:
+  raw_backtrace_slot -> backtrace_slot = "caml_convert_raw_backtrace_slot"
+
+external convert_raw_backtrace:
+  raw_backtrace -> backtrace_slot array = "caml_convert_raw_backtrace"
+
+let convert_raw_backtrace bt =
+  try Some (convert_raw_backtrace bt)
+  with Failure _ -> None
+
+let format_backtrace_slot pos slot =
+  let info is_raise =
+    if is_raise then
+      if pos = 0 then "Raised at" else "Re-raised at"
+    else
+      if pos = 0 then "Raised by primitive operation at" else "Called from"
+  in
+  match slot with
+  | Unknown_location l ->
+      if l.is_raise then
+        (* compiler-inserted re-raise, skipped *) None
+      else
+        Some (sprintf "%s unknown location" (info false))
+  | Known_location l ->
+      Some (sprintf "%s %s in file \"%s\"%s, line %d, characters %d-%d"
+              (info l.is_raise) l.defname l.filename
+              (if l.is_inline then " (inlined)" else "")
+              l.line_number l.start_char l.end_char)
+
+let print_exception_backtrace outchan backtrace =
+  match backtrace with
+  | None ->
+      fprintf outchan
+        "(Program not linked with -g, cannot print stack backtrace)\n"
+  | Some a ->
+      for i = 0 to Array.length a - 1 do
+        match format_backtrace_slot i a.(i) with
+          | None -> ()
+          | Some str -> fprintf outchan "%s\n" str
+      done
+
+let print_raw_backtrace outchan raw_backtrace =
+  print_exception_backtrace outchan (convert_raw_backtrace raw_backtrace)
+
+(* confusingly named: prints the global current backtrace *)
+let print_backtrace outchan =
+  print_raw_backtrace outchan (get_raw_backtrace ())
+
+let backtrace_to_string backtrace =
+  match backtrace with
+  | None ->
+     "(Program not linked with -g, cannot print stack backtrace)\n"
+  | Some a ->
+      let b = Buffer.create 1024 in
+      for i = 0 to Array.length a - 1 do
+        match format_backtrace_slot i a.(i) with
+          | None -> ()
+          | Some str -> bprintf b "%s\n" str
+      done;
+      Buffer.contents b
+
+let raw_backtrace_to_string raw_backtrace =
+  backtrace_to_string (convert_raw_backtrace raw_backtrace)
+
+let backtrace_slot_is_raise = function
+  | Known_location l -> l.is_raise
+  | Unknown_location l -> l.is_raise
+
+let backtrace_slot_is_inline = function
+  | Known_location l -> l.is_inline
+  | Unknown_location _ -> false
+
+type location = {
+  filename : string;
+  line_number : int;
+  start_char : int;
+  end_char : int;
+}
+
+let backtrace_slot_location = function
+  | Unknown_location _ -> None
+  | Known_location l ->
+    Some {
+      filename    = l.filename;
+      line_number = l.line_number;
+      start_char  = l.start_char;
+      end_char    = l.end_char;
+    }
+
+let backtrace_slot_defname = function
+  | Unknown_location _
+  | Known_location { defname = "" } -> None
+  | Known_location l -> Some l.defname
+
+let backtrace_slots raw_backtrace =
+  (* The documentation of this function guarantees that Some is
+     returned only if a part of the trace is usable. This gives us
+     a bit more work than just convert_raw_backtrace, but it makes the
+     API more user-friendly -- otherwise most users would have to
+     reimplement the "Program not linked with -g, sorry" logic
+     themselves. *)
+  match convert_raw_backtrace raw_backtrace with
+    | None -> None
+    | Some backtrace ->
+      let usable_slot = function
+        | Unknown_location _ -> false
+        | Known_location _ -> true in
+      let rec exists_usable = function
+        | (-1) -> false
+        | i -> usable_slot backtrace.(i) || exists_usable (i - 1) in
+      if exists_usable (Array.length backtrace - 1)
+      then Some backtrace
+      else None
+
+module Slot = struct
+  type t = backtrace_slot
+  let format = format_backtrace_slot
+  let is_raise = backtrace_slot_is_raise
+  let is_inline = backtrace_slot_is_inline
+  let location = backtrace_slot_location
+  let name = backtrace_slot_defname
+end
+
+external raw_backtrace_length :
+  raw_backtrace -> int = "caml_raw_backtrace_length" [@@noalloc]
+
+external get_raw_backtrace_slot :
+  raw_backtrace -> int -> raw_backtrace_slot = "caml_raw_backtrace_slot"
+
+external get_raw_backtrace_next_slot :
+  raw_backtrace_slot -> raw_backtrace_slot option
+  = "caml_raw_backtrace_next_slot"
+
+(* confusingly named:
+   returns the *string* corresponding to the global current backtrace *)
+let get_backtrace () = raw_backtrace_to_string (get_raw_backtrace ())
+
+external record_backtrace: bool -> unit = "caml_record_backtrace"
+external backtrace_status: unit -> bool = "caml_backtrace_status"
+
+let register_printer fn =
+  printers := fn :: !printers
+
+external get_callstack: int -> raw_backtrace = "caml_get_current_callstack"
+
+let exn_slot x =
+  let x = Obj.repr x in
+  if Obj.tag x = 0 then Obj.field x 0 else x
+
+let exn_slot_id x =
+  let slot = exn_slot x in
+  (Obj.obj (Obj.field slot 1) : int)
+
+let exn_slot_name x =
+  let slot = exn_slot x in
+  (Obj.obj (Obj.field slot 0) : string)
+
+let default_uncaught_exception_handler exn raw_backtrace =
+  eprintf "Fatal error: exception %s\n" (to_string exn);
+  print_raw_backtrace stderr raw_backtrace;
+  flush stderr
+
+let uncaught_exception_handler = ref default_uncaught_exception_handler
+
+let set_uncaught_exception_handler fn = uncaught_exception_handler := fn
+
+let empty_backtrace : raw_backtrace = Obj.obj (Obj.new_block Obj.abstract_tag 0)
+
+let try_get_raw_backtrace () =
+  try
+    get_raw_backtrace ()
+  with _ (* Out_of_memory? *) ->
+    empty_backtrace
+
+let handle_uncaught_exception' exn debugger_in_use =
+  try
+    (* Get the backtrace now, in case one of the [at_exit] function
+       destroys it. *)
+    let raw_backtrace =
+      if debugger_in_use (* Same test as in [runtime/printexc.c] *) then
+        empty_backtrace
+      else
+        try_get_raw_backtrace ()
+    in
+    (try Stdlib.do_at_exit () with _ -> ());
+    try
+      !uncaught_exception_handler exn raw_backtrace
+    with exn' ->
+      let raw_backtrace' = try_get_raw_backtrace () in
+      eprintf "Fatal error: exception %s\n" (to_string exn);
+      print_raw_backtrace stderr raw_backtrace;
+      eprintf "Fatal error in uncaught exception handler: exception %s\n"
+        (to_string exn');
+      print_raw_backtrace stderr raw_backtrace';
+      flush stderr
+  with
+    | Out_of_memory ->
+        prerr_endline
+          "Fatal error: out of memory in uncaught exception handler"
+
+(* This function is called by [caml_fatal_uncaught_exception] in
+   [runtime/printexc.c] which expects no exception is raised. *)
+let handle_uncaught_exception exn debugger_in_use =
+  try
+    handle_uncaught_exception' exn debugger_in_use
+  with _ ->
+    (* There is not much we can do at this point *)
+    ()
+
+external register_named_value : string -> 'a -> unit
+  = "caml_register_named_value"
+
+let () =
+  register_named_value "Printexc.handle_uncaught_exception"
+    handle_uncaught_exception
diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli
new file mode 100644
index 00000000..585c4a69
--- /dev/null
+++ b/stdlib/printexc.mli
@@ -0,0 +1,374 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Facilities for printing exceptions and inspecting current call stack. *)
+
+type t = exn = ..
+(** The type of exception values. *)
+
+val to_string: exn -> string
+(** [Printexc.to_string e] returns a string representation of
+   the exception [e]. *)
+
+val to_string_default: exn -> string
+(** [Printexc.to_string_default e] returns a string representation of the
+    exception [e], ignoring all registered exception printers.
+    @since 4.09
+*)
+
+val print: ('a -> 'b) -> 'a -> 'b
+(** [Printexc.print fn x] applies [fn] to [x] and returns the result.
+   If the evaluation of [fn x] raises any exception, the
+   name of the exception is printed on standard error output,
+   and the exception is raised again.
+   The typical use is to catch and report exceptions that
+   escape a function application. *)
+
+val catch: ('a -> 'b) -> 'a -> 'b
+(** [Printexc.catch fn x] is similar to {!Printexc.print}, but
+   aborts the program with exit code 2 after printing the
+   uncaught exception.  This function is deprecated: the runtime
+   system is now able to print uncaught exceptions as precisely
+   as [Printexc.catch] does.  Moreover, calling [Printexc.catch]
+   makes it harder to track the location of the exception
+   using the debugger or the stack backtrace facility.
+   So, do not use [Printexc.catch] in new code.  *)
+
+val print_backtrace: out_channel -> unit
+(** [Printexc.print_backtrace oc] prints an exception backtrace
+    on the output channel [oc].  The backtrace lists the program
+    locations where the most-recently raised exception was raised
+    and where it was propagated through function calls.
+
+    If the call is not inside an exception handler, the returned
+    backtrace is unspecified. If the call is after some
+    exception-catching code (before in the handler, or in a when-guard
+    during the matching of the exception handler), the backtrace may
+    correspond to a later exception than the handled one.
+
+    @since 3.11.0
+*)
+
+val get_backtrace: unit -> string
+(** [Printexc.get_backtrace ()] returns a string containing the
+    same exception backtrace that [Printexc.print_backtrace] would
+    print. Same restriction usage than {!print_backtrace}.
+    @since 3.11.0
+*)
+
+val record_backtrace: bool -> unit
+(** [Printexc.record_backtrace b] turns recording of exception backtraces
+    on (if [b = true]) or off (if [b = false]).  Initially, backtraces
+    are not recorded, unless the [b] flag is given to the program
+    through the [OCAMLRUNPARAM] variable.
+    @since 3.11.0
+*)
+
+val backtrace_status: unit -> bool
+(** [Printexc.backtrace_status()] returns [true] if exception
+    backtraces are currently recorded, [false] if not.
+    @since 3.11.0
+*)
+
+val register_printer: (exn -> string option) -> unit
+(** [Printexc.register_printer fn] registers [fn] as an exception
+    printer.  The printer should return [None] or raise an exception
+    if it does not know how to convert the passed exception, and [Some
+    s] with [s] the resulting string if it can convert the passed
+    exception. Exceptions raised by the printer are ignored.
+
+    When converting an exception into a string, the printers will be invoked
+    in the reverse order of their registrations, until a printer returns
+    a [Some s] value (if no such printer exists, the runtime will use a
+    generic printer).
+
+    When using this mechanism, one should be aware that an exception backtrace
+    is attached to the thread that saw it raised, rather than to the exception
+    itself. Practically, it means that the code related to [fn] should not use
+    the backtrace if it has itself raised an exception before.
+    @since 3.11.2
+*)
+
+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.
+    @since 4.09
+*)
+
+(** {1 Raw backtraces} *)
+
+type raw_backtrace
+(** The abstract type [raw_backtrace] stores a backtrace in
+    a low-level format, instead of directly exposing them as string as
+    the [get_backtrace()] function does.
+
+    This allows delaying the formatting of backtraces to when they are
+    actually printed, which may be useful if you record more
+    backtraces than you print.
+
+    Raw backtraces cannot be marshalled. If you need marshalling, you
+    should use the array returned by the [backtrace_slots] function of
+    the next section.
+
+    @since 4.01.0
+*)
+
+val get_raw_backtrace: unit -> raw_backtrace
+(** [Printexc.get_raw_backtrace ()] returns the same exception
+    backtrace that [Printexc.print_backtrace] would print, but in
+    a raw format. Same restriction usage than {!print_backtrace}.
+
+    @since 4.01.0
+*)
+
+val print_raw_backtrace: out_channel -> raw_backtrace -> unit
+(** Print a raw backtrace in the same format
+    [Printexc.print_backtrace] uses.
+
+    @since 4.01.0
+*)
+
+val raw_backtrace_to_string: raw_backtrace -> string
+(** Return a string from a raw backtrace, in the same format
+    [Printexc.get_backtrace] uses.
+
+    @since 4.01.0
+*)
+
+external raise_with_backtrace: exn -> raw_backtrace -> 'a
+  = "%raise_with_backtrace"
+(** Reraise the exception using the given raw_backtrace for the
+    origin of the exception
+
+    @since 4.05.0
+*)
+
+(** {1 Current call stack} *)
+
+external get_callstack: int -> raw_backtrace = "caml_get_current_callstack"
+(** [Printexc.get_callstack n] returns a description of the top of the
+    call stack on the current program point (for the current thread),
+    with at most [n] entries.  (Note: this function is not related to
+    exceptions at all, despite being part of the [Printexc] module.)
+
+    @since 4.01.0
+*)
+
+(** {1 Uncaught exceptions} *)
+
+val default_uncaught_exception_handler: exn -> raw_backtrace -> unit
+(** [Printexc.default_uncaught_exception_handler] prints the exception and
+    backtrace on standard error output.
+
+    @since 4.11
+*)
+
+val set_uncaught_exception_handler: (exn -> raw_backtrace -> unit) -> unit
+(** [Printexc.set_uncaught_exception_handler fn] registers [fn] as the handler
+    for uncaught exceptions. The default handler is
+    {!Printexc.default_uncaught_exception_handler}.
+
+    Note that when [fn] is called all the functions registered with
+    {!Stdlib.at_exit} have already been called. Because of this you must
+    make sure any output channel [fn] writes on is flushed.
+
+    Also note that exceptions raised by user code in the interactive toplevel
+    are not passed to this function as they are caught by the toplevel itself.
+
+    If [fn] raises an exception, both the exceptions passed to [fn] and raised
+    by [fn] will be printed with their respective backtrace.
+
+    @since 4.02.0
+*)
+
+
+(** {1 Manipulation of backtrace information}
+
+    These functions are used to traverse the slots of a raw backtrace
+    and extract information from them in a programmer-friendly format.
+*)
+
+type backtrace_slot
+(** The abstract type [backtrace_slot] represents a single slot of
+    a backtrace.
+
+    @since 4.02
+*)
+
+val backtrace_slots : raw_backtrace -> backtrace_slot array option
+(** Returns the slots of a raw backtrace, or [None] if none of them
+    contain useful information.
+
+    In the return array, the slot at index [0] corresponds to the most
+    recent function call, raise, or primitive [get_backtrace] call in
+    the trace.
+
+    Some possible reasons for returning [None] are as follow:
+    - none of the slots in the trace come from modules compiled with
+    debug information ([-g])
+    - the program is a bytecode program that has not been linked with
+    debug information enabled ([ocamlc -g])
+
+    @since 4.02.0
+*)
+
+type location = {
+  filename : string;
+  line_number : int;
+  start_char : int;
+  end_char : int;
+}
+(** The type of location information found in backtraces. [start_char]
+    and [end_char] are positions relative to the beginning of the
+    line.
+
+    @since 4.02
+*)
+
+(** @since 4.02.0 *)
+module Slot : sig
+  type t = backtrace_slot
+
+  val is_raise : t -> bool
+  (** [is_raise slot] is [true] when [slot] refers to a raising
+      point in the code, and [false] when it comes from a simple
+      function call.
+
+      @since 4.02
+  *)
+
+  val is_inline : t -> bool
+  (** [is_inline slot] is [true] when [slot] refers to a call
+      that got inlined by the compiler, and [false] when it comes from
+      any other context.
+
+      @since 4.04.0
+  *)
+
+  val location : t -> location option
+  (** [location slot] returns the location information of the slot,
+      if available, and [None] otherwise.
+
+      Some possible reasons for failing to return a location are as follow:
+      - the slot corresponds to a compiler-inserted raise
+      - the slot corresponds to a part of the program that has not been
+      compiled with debug information ([-g])
+
+      @since 4.02
+  *)
+
+  val name : t -> string option
+  (** [name slot] returns the name of the function or definition
+      enclosing the location referred to by the slot.
+
+      [name slot] returns None if the name is unavailable, which
+      may happen for the same reasons as [location] returning None.
+
+      @since 4.11
+  *)
+
+  val format : int -> t -> string option
+  (** [format pos slot] returns the string representation of [slot] as
+      [raw_backtrace_to_string] would format it, assuming it is the
+      [pos]-th element of the backtrace: the [0]-th element is
+      pretty-printed differently than the others.
+
+      Whole-backtrace printing functions also skip some uninformative
+      slots; in that case, [format pos slot] returns [None].
+
+      @since 4.02
+  *)
+end
+
+
+(** {1 Raw backtrace slots} *)
+
+type raw_backtrace_slot
+(** This type allows direct access to raw backtrace slots, without any
+    conversion in an OCaml-usable data-structure. Being
+    process-specific, they must absolutely not be marshalled, and are
+    unsafe to use for this reason (marshalling them may not fail, but
+    un-marshalling and using the result will result in
+    undefined behavior).
+
+    Elements of this type can still be compared and hashed: when two
+    elements are equal, then they represent the same source location
+    (the converse is not necessarily true in presence of inlining,
+    for example).
+
+    @since 4.02.0
+*)
+
+val raw_backtrace_length : raw_backtrace -> int
+(** [raw_backtrace_length bckt] returns the number of slots in the
+    backtrace [bckt].
+
+    @since 4.02
+*)
+
+val get_raw_backtrace_slot : raw_backtrace -> int -> raw_backtrace_slot
+(** [get_raw_backtrace_slot bckt pos] returns the slot in position [pos] in the
+    backtrace [bckt].
+
+    @since 4.02
+*)
+
+val convert_raw_backtrace_slot : raw_backtrace_slot -> backtrace_slot
+(** Extracts the user-friendly [backtrace_slot] from a low-level
+    [raw_backtrace_slot].
+
+    @since 4.02
+*)
+
+
+val get_raw_backtrace_next_slot :
+    raw_backtrace_slot -> raw_backtrace_slot option
+(** [get_raw_backtrace_next_slot slot] returns the next slot inlined, if any.
+
+    Sample code to iterate over all frames (inlined and non-inlined):
+    {[
+      (* Iterate over inlined frames *)
+      let rec iter_raw_backtrace_slot f slot =
+        f slot;
+        match get_raw_backtrace_next_slot slot with
+        | None -> ()
+        | Some slot' -> iter_raw_backtrace_slot f slot'
+
+      (* Iterate over stack frames *)
+      let iter_raw_backtrace f bt =
+        for i = 0 to raw_backtrace_length bt - 1 do
+          iter_raw_backtrace_slot f (get_raw_backtrace_slot bt i)
+        done
+    ]}
+
+    @since 4.04.0
+*)
+
+(** {1 Exception slots} *)
+
+val exn_slot_id: exn -> int
+(** [Printexc.exn_slot_id] returns an integer which uniquely identifies
+    the constructor used to create the exception value [exn]
+    (in the current runtime).
+
+    @since 4.02.0
+*)
+
+val exn_slot_name: exn -> string
+(** [Printexc.exn_slot_name exn] returns the internal name of the constructor
+    used to create the exception value [exn].
+
+    @since 4.02.0
+*)
diff --git a/stdlib/printf.ml b/stdlib/printf.ml
new file mode 100644
index 00000000..af32fd1d
--- /dev/null
+++ b/stdlib/printf.ml
@@ -0,0 +1,43 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Xavier Leroy and Pierre Weis, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open CamlinternalFormatBasics
+open CamlinternalFormat
+
+let kfprintf k o (Format (fmt, _)) =
+  make_printf (fun acc -> output_acc o acc; k o) End_of_acc fmt
+let kbprintf k b (Format (fmt, _)) =
+  make_printf (fun acc -> bufput_acc b acc; k b) End_of_acc fmt
+let ikfprintf k oc (Format (fmt, _)) =
+  make_iprintf k oc fmt
+let ikbprintf = ikfprintf
+
+let fprintf oc fmt = kfprintf ignore oc fmt
+let bprintf b fmt = kbprintf ignore b fmt
+let ifprintf oc fmt = ikfprintf ignore oc fmt
+let ibprintf b fmt = ikbprintf ignore b fmt
+let printf fmt = fprintf stdout fmt
+let eprintf fmt = fprintf stderr fmt
+
+let ksprintf k (Format (fmt, _)) =
+  let k' acc =
+    let buf = Buffer.create 64 in
+    strput_acc buf acc;
+    k (Buffer.contents buf) in
+  make_printf k' End_of_acc fmt
+
+let sprintf fmt = ksprintf (fun s -> s) fmt
+
+let kprintf = ksprintf
diff --git a/stdlib/printf.mli b/stdlib/printf.mli
new file mode 100644
index 00000000..470af847
--- /dev/null
+++ b/stdlib/printf.mli
@@ -0,0 +1,194 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Xavier Leroy and Pierre Weis, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Formatted output functions. *)
+
+val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a
+(** [fprintf outchan format arg1 ... argN] formats the arguments
+   [arg1] to [argN] according to the format string [format], and
+   outputs the resulting string on the channel [outchan].
+
+   The format string is a character string which contains two types of
+   objects: plain characters, which are simply copied to the output
+   channel, and conversion specifications, each of which causes
+   conversion and printing of arguments.
+
+   Conversion specifications have the following form:
+
+   [% [flags] [width] [.precision] type]
+
+   In short, a conversion specification consists in the [%] character,
+   followed by optional modifiers and a type which is made of one or
+   two characters.
+
+   The types and their meanings are:
+
+   - [d], [i]: convert an integer argument to signed decimal.
+     The flag [#] adds underscores to large values for readability.
+   - [u], [n], [l], [L], or [N]: convert an integer argument to
+     unsigned decimal.  Warning: [n], [l], [L], and [N] are
+     used for [scanf], and should not be used for [printf].
+     The flag [#] adds underscores to large values for readability.
+   - [x]: convert an integer argument to unsigned hexadecimal,
+     using lowercase letters.
+     The flag [#] adds a [0x] prefix to non zero values.
+   - [X]: convert an integer argument to unsigned hexadecimal,
+     using uppercase letters.
+     The flag [#] adds a [0X] prefix to non zero values.
+   - [o]: convert an integer argument to unsigned octal.
+     The flag [#] adds a [0] prefix to non zero values.
+   - [s]: insert a string argument.
+   - [S]: convert a string argument to OCaml syntax (double quotes, escapes).
+   - [c]: insert a character argument.
+   - [C]: convert a character argument to OCaml syntax
+     (single quotes, escapes).
+   - [f]: convert a floating-point argument to decimal notation,
+     in the style [dddd.ddd].
+   - [F]: convert a floating-point argument to OCaml syntax ([dddd.]
+     or [dddd.ddd] or [d.ddd e+-dd]).
+     Converts to hexadecimal with the [#] flag (see [h]).
+   - [e] or [E]: convert a floating-point argument to decimal notation,
+     in the style [d.ddd e+-dd] (mantissa and exponent).
+   - [g] or [G]: convert a floating-point argument to decimal notation,
+     in style [f] or [e], [E] (whichever is more compact). Moreover,
+     any trailing zeros are removed from the fractional part of the result
+     and the decimal-point character is removed if there is no fractional
+     part remaining.
+   - [h] or [H]: convert a floating-point argument to hexadecimal notation,
+     in the style [0xh.hhhh p+-dd] (hexadecimal mantissa, exponent in
+     decimal and denotes a power of 2).
+   - [B]: convert a boolean argument to the string [true] or [false]
+   - [b]: convert a boolean argument (deprecated; do not use in new
+     programs).
+   - [ld], [li], [lu], [lx], [lX], [lo]: convert an [int32] argument to
+     the format specified by the second letter (decimal, hexadecimal, etc).
+   - [nd], [ni], [nu], [nx], [nX], [no]: convert a [nativeint] argument to
+     the format specified by the second letter.
+   - [Ld], [Li], [Lu], [Lx], [LX], [Lo]: convert an [int64] argument to
+     the format specified by the second letter.
+   - [a]: user-defined printer. Take two arguments and apply the
+     first one to [outchan] (the current output channel) and to the
+     second argument. The first argument must therefore have type
+     [out_channel -> 'b -> unit] and the second ['b].
+     The output produced by the function is inserted in the output of
+     [fprintf] at the current point.
+   - [t]: same as [%a], but take only one argument (with type
+     [out_channel -> unit]) and apply it to [outchan].
+   - [\{ fmt %\}]: convert a format string argument to its type digest.
+     The argument must have the same type as the internal format string
+     [fmt].
+   - [( fmt %)]: format string substitution. Take a format string
+     argument and substitute it to the internal format string [fmt]
+     to print following arguments. The argument must have the same
+     type as the internal format string [fmt].
+   - [!]: take no argument and flush the output.
+   - [%]: take no argument and output one [%] character.
+   - [\@]: take no argument and output one [\@] character.
+   - [,]: take no argument and output nothing: a no-op delimiter for
+     conversion specifications.
+
+   The optional [flags] are:
+   - [-]: left-justify the output (default is right justification).
+   - [0]: for numerical conversions, pad with zeroes instead of spaces.
+   - [+]: for signed numerical conversions, prefix number with a [+]
+     sign if positive.
+   - space: for signed numerical conversions, prefix number with a
+     space if positive.
+   - [#]: request an alternate formatting style for the integer types
+     and the floating-point type [F].
+
+   The optional [width] is an integer indicating the minimal
+   width of the result. For instance, [%6d] prints an integer,
+   prefixing it with spaces to fill at least 6 characters.
+
+   The optional [precision] is a dot [.] followed by an integer
+   indicating how many digits follow the decimal point in the [%f],
+   [%e], [%E], [%h], and [%H] conversions or the maximum number of
+   significant digits to appear for the [%F], [%g] and [%G] conversions.
+   For instance, [%.4f] prints a [float] with 4 fractional digits.
+
+   The integer in a [width] or [precision] can also be specified as
+   [*], in which case an extra integer argument is taken to specify
+   the corresponding [width] or [precision]. This integer argument
+   precedes immediately the argument to print.
+   For instance, [%.*f] prints a [float] with as many fractional
+   digits as the value of the argument given before the float. *)
+
+val printf : ('a, out_channel, unit) format -> 'a
+(** Same as {!Printf.fprintf}, but output on [stdout]. *)
+
+val eprintf : ('a, out_channel, unit) format -> 'a
+(** Same as {!Printf.fprintf}, but output on [stderr]. *)
+
+val sprintf : ('a, unit, string) format -> 'a
+(** Same as {!Printf.fprintf}, but instead of printing on an output channel,
+   return a string containing the result of formatting the arguments. *)
+
+val bprintf : Buffer.t -> ('a, Buffer.t, unit) format -> 'a
+(** Same as {!Printf.fprintf}, but instead of printing on an output channel,
+   append the formatted arguments to the given extensible buffer
+   (see module {!Buffer}). *)
+
+val ifprintf : 'b -> ('a, 'b, 'c, unit) format4 -> 'a
+(** Same as {!Printf.fprintf}, but does not print anything.
+    Useful to ignore some material when conditionally printing.
+    @since 3.10.0
+*)
+
+val ibprintf : Buffer.t -> ('a, Buffer.t, unit) format -> 'a
+(** Same as {!Printf.bprintf}, but does not print anything.
+    Useful to ignore some material when conditionally printing.
+    @since 4.11.0
+*)
+
+(** Formatted output functions with continuations. *)
+
+val kfprintf : (out_channel -> 'd) -> out_channel ->
+              ('a, out_channel, unit, 'd) format4 -> 'a
+(** Same as [fprintf], but instead of returning immediately,
+   passes the out channel to its first argument at the end of printing.
+   @since 3.09.0
+*)
+
+val ikfprintf : ('b -> 'd) -> 'b -> ('a, 'b, 'c, 'd) format4 -> 'a
+(** Same as [kfprintf] above, but does not print anything.
+   Useful to ignore some material when conditionally printing.
+   @since 4.01.0
+*)
+
+val ksprintf : (string -> 'd) -> ('a, unit, string, 'd) format4 -> 'a
+(** Same as [sprintf] above, but instead of returning the string,
+   passes it to the first argument.
+   @since 3.09.0
+*)
+
+val kbprintf : (Buffer.t -> 'd) -> Buffer.t ->
+              ('a, Buffer.t, unit, 'd) format4 -> 'a
+(** Same as [bprintf], but instead of returning immediately,
+   passes the buffer to its first argument at the end of printing.
+   @since 3.10.0
+*)
+
+val ikbprintf : (Buffer.t -> 'd) -> Buffer.t ->
+               ('a, Buffer.t, unit, 'd) format4 -> 'a
+(** Same as [kbprintf] above, but does not print anything.
+   Useful to ignore some material when conditionally printing.
+   @since 4.11.0
+*)
+
+(** Deprecated *)
+
+val kprintf : (string -> 'b) -> ('a, unit, string, 'b) format4 -> 'a
+(** A deprecated synonym for [ksprintf]. *)
diff --git a/stdlib/queue.ml b/stdlib/queue.ml
new file mode 100644
index 00000000..f8d8b251
--- /dev/null
+++ b/stdlib/queue.ml
@@ -0,0 +1,164 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*         Francois Pottier, projet Cristal, INRIA Rocquencourt           *)
+(*                  Jeremie Dimino, Jane Street Europe                    *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+exception Empty
+
+type 'a cell =
+  | Nil
+  | Cons of { content: 'a; mutable next: 'a cell }
+
+type 'a t = {
+  mutable length: int;
+  mutable first: 'a cell;
+  mutable last: 'a cell
+}
+
+let create () = {
+  length = 0;
+  first = Nil;
+  last = Nil
+}
+
+let clear q =
+  q.length <- 0;
+  q.first <- Nil;
+  q.last <- Nil
+
+let add x q =
+  let cell = Cons {
+    content = x;
+    next = Nil
+  } in
+  match q.last with
+  | Nil ->
+    q.length <- 1;
+    q.first <- cell;
+    q.last <- cell
+  | Cons last ->
+    q.length <- q.length + 1;
+    last.next <- cell;
+    q.last <- cell
+
+let push =
+  add
+
+let peek q =
+  match q.first with
+  | Nil -> raise Empty
+  | Cons { content } -> content
+
+let peek_opt q =
+  match q.first with
+  | Nil -> None
+  | Cons { content } -> Some content
+
+let top =
+  peek
+
+let take q =
+  match q.first with
+  | Nil -> raise Empty
+  | Cons { content; next = Nil } ->
+    clear q;
+    content
+  | Cons { content; next } ->
+    q.length <- q.length - 1;
+    q.first <- next;
+    content
+
+let take_opt q =
+  match q.first with
+  | Nil -> None
+  | Cons { content; next = Nil } ->
+    clear q;
+    Some content
+  | Cons { content; next } ->
+    q.length <- q.length - 1;
+    q.first <- next;
+    Some content
+
+let pop =
+  take
+
+let copy =
+  let rec copy q_res prev cell =
+    match cell with
+    | Nil -> q_res.last <- prev; q_res
+    | Cons { content; next } ->
+      let res = Cons { content; next = Nil } in
+      begin match prev with
+      | Nil -> q_res.first <- res
+      | Cons p -> p.next <- res
+      end;
+      copy q_res res next
+  in
+  fun q -> copy { length = q.length; first = Nil; last = Nil } Nil q.first
+
+let is_empty q =
+  q.length = 0
+
+let length q =
+  q.length
+
+let iter =
+  let rec iter f cell =
+    match cell with
+    | Nil -> ()
+    | Cons { content; next } ->
+      f content;
+      iter f next
+  in
+  fun f q -> iter f q.first
+
+let fold =
+  let rec fold f accu cell =
+    match cell with
+    | Nil -> accu
+    | Cons { content; next } ->
+      let accu = f accu content in
+      fold f accu next
+  in
+  fun f accu q -> fold f accu q.first
+
+let transfer q1 q2 =
+  if q1.length > 0 then
+    match q2.last with
+    | Nil ->
+      q2.length <- q1.length;
+      q2.first <- q1.first;
+      q2.last <- q1.last;
+      clear q1
+    | Cons last ->
+      q2.length <- q2.length + q1.length;
+      last.next <- q1.first;
+      q2.last <- q1.last;
+      clear q1
+
+(** {1 Iterators} *)
+
+let to_seq q =
+  let rec aux c () = match c with
+    | Nil -> Seq.Nil
+    | Cons { content=x; next; } -> Seq.Cons (x, aux next)
+  in
+  aux q.first
+
+let add_seq q i = Seq.iter (fun x -> push x q) i
+
+let of_seq g =
+  let q = create() in
+  add_seq q g;
+  q
diff --git a/stdlib/queue.mli b/stdlib/queue.mli
new file mode 100644
index 00000000..12c99f3f
--- /dev/null
+++ b/stdlib/queue.mli
@@ -0,0 +1,108 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** First-in first-out queues.
+
+   This module implements queues (FIFOs), with in-place modification.
+
+   {b Warning} This module is not thread-safe: each {!Queue.t} value
+   must be protected from concurrent access (e.g. with a [Mutex.t]).
+   Failure to do so can lead to a crash.
+*)
+
+type 'a t
+(** The type of queues containing elements of type ['a]. *)
+
+
+exception Empty
+(** Raised when {!Queue.take} or {!Queue.peek} is applied to an empty queue. *)
+
+
+val create : unit -> 'a t
+(** Return a new queue, initially empty. *)
+
+val add : 'a -> 'a t -> unit
+(** [add x q] adds the element [x] at the end of the queue [q]. *)
+
+val push : 'a -> 'a t -> unit
+(** [push] is a synonym for [add]. *)
+
+val take : 'a t -> 'a
+(** [take q] removes and returns the first element in queue [q],
+   or raises {!Empty} if the queue is empty. *)
+
+val take_opt : 'a t -> 'a option
+(** [take_opt q] removes and returns the first element in queue [q],
+   or returns [None] if the queue is empty.
+   @since 4.08 *)
+
+val pop : 'a t -> 'a
+(** [pop] is a synonym for [take]. *)
+
+val peek : 'a t -> 'a
+(** [peek q] returns the first element in queue [q], without removing
+   it from the queue, or raises {!Empty} if the queue is empty. *)
+
+val peek_opt : 'a t -> 'a option
+(** [peek_opt q] returns the first element in queue [q], without removing
+   it from the queue, or returns [None] if the queue is empty.
+   @since 4.08 *)
+
+val top : 'a t -> 'a
+(** [top] is a synonym for [peek]. *)
+
+val clear : 'a t -> unit
+(** Discard all elements from a queue. *)
+
+val copy : 'a t -> 'a t
+(** Return a copy of the given queue. *)
+
+val is_empty : 'a t -> bool
+(** Return [true] if the given queue is empty, [false] otherwise. *)
+
+val length : 'a t -> int
+(** Return the number of elements in a queue. *)
+
+val iter : ('a -> unit) -> 'a t -> unit
+(** [iter f q] applies [f] in turn to all elements of [q],
+   from the least recently entered to the most recently entered.
+   The queue itself is unchanged. *)
+
+val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
+(** [fold f accu q] is equivalent to [List.fold_left f accu l],
+   where [l] is the list of [q]'s elements. The queue remains
+   unchanged. *)
+
+val transfer : 'a t -> 'a t -> unit
+(** [transfer q1 q2] adds all of [q1]'s elements at the end of
+   the queue [q2], then clears [q1]. It is equivalent to the
+   sequence [iter (fun x -> add x q2) q1; clear q1], but runs
+   in constant time. *)
+
+(** {1 Iterators} *)
+
+val to_seq : 'a t -> 'a Seq.t
+(** Iterate on the queue, in front-to-back order.
+    The behavior is not defined if the queue is modified
+    during the iteration.
+    @since 4.07 *)
+
+val add_seq : 'a t -> 'a Seq.t -> unit
+(** Add the elements from the generator to the end of the queue
+    @since 4.07 *)
+
+val of_seq : 'a Seq.t -> 'a t
+(** Create a queue from the generator
+    @since 4.07 *)
diff --git a/stdlib/random.ml b/stdlib/random.ml
new file mode 100644
index 00000000..a88a5f87
--- /dev/null
+++ b/stdlib/random.ml
@@ -0,0 +1,277 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*               Damien Doligez, projet Para, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Pseudo-random number generator
+   This is a lagged-Fibonacci F(55, 24, +) with a modified addition
+   function to enhance the mixing of bits.
+   If we use normal addition, the low-order bit fails tests 1 and 7
+   of the Diehard test suite, and bits 1 and 2 also fail test 7.
+   If we use multiplication as suggested by Marsaglia, it doesn't fare
+   much better.
+   By mixing the bits of one of the numbers before addition (XOR the
+   5 high-order bits into the low-order bits), we get a generator that
+   passes all the Diehard tests.
+*)
+
+external random_seed: unit -> int array = "caml_sys_random_seed"
+
+module State = struct
+
+  type t = { st : int array; mutable idx : int }
+
+  let new_state () = { st = Array.make 55 0; idx = 0 }
+  let assign st1 st2 =
+    Array.blit st2.st 0 st1.st 0 55;
+    st1.idx <- st2.idx
+
+
+  let full_init s seed =
+    let combine accu x = Digest.string (accu ^ Int.to_string x) in
+    let extract d =
+      Char.code d.[0] + (Char.code d.[1] lsl 8) + (Char.code d.[2] lsl 16)
+      + (Char.code d.[3] lsl 24)
+    in
+    let seed = if Array.length seed = 0 then [| 0 |] else seed in
+    let l = Array.length seed in
+    for i = 0 to 54 do
+      s.st.(i) <- i;
+    done;
+    let accu = ref "x" in
+    for i = 0 to 54 + max 55 l do
+      let j = i mod 55 in
+      let k = i mod l in
+      accu := combine !accu seed.(k);
+      s.st.(j) <- (s.st.(j) lxor extract !accu) land 0x3FFFFFFF;  (* PR#5575 *)
+    done;
+    s.idx <- 0
+
+
+  let make seed =
+    let result = new_state () in
+    full_init result seed;
+    result
+
+
+  let make_self_init () = make (random_seed ())
+
+  let copy s =
+    let result = new_state () in
+    assign result s;
+    result
+
+
+  (* Returns 30 random bits as an integer 0 <= x < 1073741824 *)
+  let bits s =
+    s.idx <- (s.idx + 1) mod 55;
+    let curval = s.st.(s.idx) in
+    let newval = s.st.((s.idx + 24) mod 55)
+                 + (curval lxor ((curval lsr 25) land 0x1F)) in
+    let newval30 = newval land 0x3FFFFFFF in  (* PR#5575 *)
+    s.st.(s.idx) <- newval30;
+    newval30
+
+
+  let rec intaux s n =
+    let r = bits s in
+    let v = r mod n in
+    if r - v > 0x3FFFFFFF - n + 1 then intaux s n else v
+
+  let int s bound =
+    if bound > 0x3FFFFFFF || bound <= 0
+    then invalid_arg "Random.int"
+    else intaux s bound
+
+
+  let rec int32aux s n =
+    let b1 = Int32.of_int (bits s) in
+    let b2 = Int32.shift_left (Int32.of_int (bits s land 1)) 30 in
+    let r = Int32.logor b1 b2 in
+    let v = Int32.rem r n in
+    if Int32.sub r v > Int32.add (Int32.sub Int32.max_int n) 1l
+    then int32aux s n
+    else v
+
+  let int32 s bound =
+    if bound <= 0l
+    then invalid_arg "Random.int32"
+    else int32aux s bound
+
+
+  let rec int64aux s n =
+    let b1 = Int64.of_int (bits s) in
+    let b2 = Int64.shift_left (Int64.of_int (bits s)) 30 in
+    let b3 = Int64.shift_left (Int64.of_int (bits s land 7)) 60 in
+    let r = Int64.logor b1 (Int64.logor b2 b3) in
+    let v = Int64.rem r n in
+    if Int64.sub r v > Int64.add (Int64.sub Int64.max_int n) 1L
+    then int64aux s n
+    else v
+
+  let int64 s bound =
+    if bound <= 0L
+    then invalid_arg "Random.int64"
+    else int64aux s bound
+
+
+  let nativeint =
+    if Nativeint.size = 32
+    then fun s bound -> Nativeint.of_int32 (int32 s (Nativeint.to_int32 bound))
+    else fun s bound -> Int64.to_nativeint (int64 s (Int64.of_nativeint bound))
+
+
+  (* Returns a float 0 <= x <= 1 with at most 60 bits of precision. *)
+  let rawfloat s =
+    let scale = 1073741824.0  (* 2^30 *)
+    and r1 = Stdlib.float (bits s)
+    and r2 = Stdlib.float (bits s)
+    in (r1 /. scale +. r2) /. scale
+
+
+  let float s bound = rawfloat s *. bound
+
+  let bool s = (bits s land 1 = 0)
+
+end
+
+(* This is the state you get with [init 27182818] and then applying
+   the "land 0x3FFFFFFF" filter to them.  See #5575, #5793, #5977. *)
+let default = {
+  State.st = [|
+      0x3ae2522b; 0x1d8d4634; 0x15b4fad0; 0x18b14ace; 0x12f8a3c4; 0x3b086c47;
+      0x16d467d6; 0x101d91c7; 0x321df177; 0x0176c193; 0x1ff72bf1; 0x1e889109;
+      0x0b464b18; 0x2b86b97c; 0x0891da48; 0x03137463; 0x085ac5a1; 0x15d61f2f;
+      0x3bced359; 0x29c1c132; 0x3a86766e; 0x366d8c86; 0x1f5b6222; 0x3ce1b59f;
+      0x2ebf78e1; 0x27cd1b86; 0x258f3dc3; 0x389a8194; 0x02e4c44c; 0x18c43f7d;
+      0x0f6e534f; 0x1e7df359; 0x055d0b7e; 0x10e84e7e; 0x126198e4; 0x0e7722cb;
+      0x1cbede28; 0x3391b964; 0x3d40e92a; 0x0c59933d; 0x0b8cd0b7; 0x24efff1c;
+      0x2803fdaa; 0x08ebc72e; 0x0f522e32; 0x05398edc; 0x2144a04c; 0x0aef3cbd;
+      0x01ad4719; 0x35b93cd6; 0x2a559d4f; 0x1e6fd768; 0x26e27f36; 0x186f18c3;
+      0x2fbf967a;
+    |];
+  State.idx = 0;
+}
+
+let bits () = State.bits default
+let int bound = State.int default bound
+let int32 bound = State.int32 default bound
+let nativeint bound = State.nativeint default bound
+let int64 bound = State.int64 default bound
+let float scale = State.float default scale
+let bool () = State.bool default
+
+let full_init seed = State.full_init default seed
+let init seed = State.full_init default [| seed |]
+let self_init () = full_init (random_seed())
+
+(* Manipulating the current state. *)
+
+let get_state () = State.copy default
+let set_state s = State.assign default s
+
+(********************
+
+(* Test functions.  Not included in the library.
+   The [chisquare] function should be called with n > 10r.
+   It returns a triple (low, actual, high).
+   If low <= actual <= high, the [g] function passed the test,
+   otherwise it failed.
+
+  Some results:
+
+init 27182818; chisquare int 100000 1000
+init 27182818; chisquare int 100000 100
+init 27182818; chisquare int 100000 5000
+init 27182818; chisquare int 1000000 1000
+init 27182818; chisquare int 100000 1024
+init 299792643; chisquare int 100000 1024
+init 14142136; chisquare int 100000 1024
+init 27182818; init_diff 1024; chisquare diff 100000 1024
+init 27182818; init_diff 100; chisquare diff 100000 100
+init 27182818; init_diff2 1024; chisquare diff2 100000 1024
+init 27182818; init_diff2 100; chisquare diff2 100000 100
+init 14142136; init_diff2 100; chisquare diff2 100000 100
+init 299792643; init_diff2 100; chisquare diff2 100000 100
+- : float * float * float = (936.754446796632465, 997.5, 1063.24555320336754)
+# - : float * float * float = (80., 89.7400000000052387, 120.)
+# - : float * float * float = (4858.57864376269, 5045.5, 5141.42135623731)
+# - : float * float * float =
+(936.754446796632465, 944.805999999982305, 1063.24555320336754)
+# - : float * float * float = (960., 1019.19744000000355, 1088.)
+# - : float * float * float = (960., 1059.31776000000536, 1088.)
+# - : float * float * float = (960., 1039.98463999999512, 1088.)
+# - : float * float * float = (960., 1054.38207999999577, 1088.)
+# - : float * float * float = (80., 90.096000000005, 120.)
+# - : float * float * float = (960., 1076.78720000000612, 1088.)
+# - : float * float * float = (80., 85.1760000000067521, 120.)
+# - : float * float * float = (80., 85.2160000000003492, 120.)
+# - : float * float * float = (80., 80.6220000000030268, 120.)
+
+*)
+
+(* Return the sum of the squares of v[i0,i1[ *)
+let rec sumsq v i0 i1 =
+  if i0 >= i1 then 0.0
+  else if i1 = i0 + 1 then Stdlib.float v.(i0) *. Stdlib.float v.(i0)
+  else sumsq v i0 ((i0+i1)/2) +. sumsq v ((i0+i1)/2) i1
+
+
+let chisquare g n r =
+  if n <= 10 * r then invalid_arg "chisquare";
+  let f = Array.make r 0 in
+  for i = 1 to n do
+    let t = g r in
+    f.(t) <- f.(t) + 1
+  done;
+  let t = sumsq f 0 r
+  and r = Stdlib.float r
+  and n = Stdlib.float n in
+  let sr = 2.0 *. sqrt r in
+  (r -. sr,   (r *. t /. n) -. n,   r +. sr)
+
+
+(* This is to test for linear dependencies between successive random numbers.
+*)
+let st = ref 0
+let init_diff r = st := int r
+let diff r =
+  let x1 = !st
+  and x2 = int r
+  in
+  st := x2;
+  if x1 >= x2 then
+    x1 - x2
+  else
+    r + x1 - x2
+
+
+let st1 = ref 0
+and st2 = ref 0
+
+
+(* This is to test for quadratic dependencies between successive random
+   numbers.
+*)
+let init_diff2 r = st1 := int r; st2 := int r
+let diff2 r =
+  let x1 = !st1
+  and x2 = !st2
+  and x3 = int r
+  in
+  st1 := x2;
+  st2 := x3;
+  (x3 - x2 - x2 + x1 + 2*r) mod r
+
+
+********************)
diff --git a/stdlib/random.mli b/stdlib/random.mli
new file mode 100644
index 00000000..f8eae5fa
--- /dev/null
+++ b/stdlib/random.mli
@@ -0,0 +1,107 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*               Damien Doligez, projet Para, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Pseudo-random number generators (PRNG). *)
+
+(** {1 Basic functions} *)
+
+val init : int -> unit
+(** Initialize the generator, using the argument as a seed.
+     The same seed will always yield the same sequence of numbers. *)
+
+val full_init : int array -> unit
+(** Same as {!Random.init} but takes more data as seed. *)
+
+val self_init : unit -> unit
+(** Initialize the generator with a random seed chosen
+   in a system-dependent way.  If [/dev/urandom] is available on
+   the host machine, it is used to provide a highly random initial
+   seed.  Otherwise, a less random seed is computed from system
+   parameters (current time, process IDs). *)
+
+val bits : unit -> int
+(** Return 30 random bits in a nonnegative integer.
+    @before 3.12.0 used a different algorithm (affects all the following
+                   functions)
+*)
+
+val int : int -> int
+(** [Random.int bound] returns a random integer between 0 (inclusive)
+     and [bound] (exclusive).  [bound] must be greater than 0 and less
+     than 2{^30}. *)
+
+val int32 : Int32.t -> Int32.t
+(** [Random.int32 bound] returns a random integer between 0 (inclusive)
+     and [bound] (exclusive).  [bound] must be greater than 0. *)
+
+val nativeint : Nativeint.t -> Nativeint.t
+(** [Random.nativeint bound] returns a random integer between 0 (inclusive)
+     and [bound] (exclusive).  [bound] must be greater than 0. *)
+
+val int64 : Int64.t -> Int64.t
+(** [Random.int64 bound] returns a random integer between 0 (inclusive)
+     and [bound] (exclusive).  [bound] must be greater than 0. *)
+
+val float : float -> float
+(** [Random.float bound] returns a random floating-point number
+   between 0 and [bound] (inclusive).  If [bound] is
+   negative, the result is negative or zero.  If [bound] is 0,
+   the result is 0. *)
+
+val bool : unit -> bool
+(** [Random.bool ()] returns [true] or [false] with probability 0.5 each. *)
+
+
+(** {1 Advanced functions} *)
+
+(** The functions from module {!State} manipulate the current state
+    of the random generator explicitly.
+    This allows using one or several deterministic PRNGs,
+    even in a multi-threaded program, without interference from
+    other parts of the program.
+*)
+
+module State : sig
+  type t
+  (** The type of PRNG states. *)
+
+  val make : int array -> t
+  (** Create a new state and initialize it with the given seed. *)
+
+  val make_self_init : unit -> t
+  (** Create a new state and initialize it with a system-dependent
+      low-entropy seed. *)
+
+  val copy : t -> t
+  (** Return a copy of the given state. *)
+
+  val bits : t -> int
+  val int : t -> int -> int
+  val int32 : t -> Int32.t -> Int32.t
+  val nativeint : t -> Nativeint.t -> Nativeint.t
+  val int64 : t -> Int64.t -> Int64.t
+  val float : t -> float -> float
+  val bool : t -> bool
+  (** These functions are the same as the basic functions, except that they
+      use (and update) the given PRNG state instead of the default one.
+  *)
+end
+
+
+val get_state : unit -> State.t
+(** Return the current state of the generator used by the basic functions. *)
+
+val set_state : State.t -> unit
+(** Set the state of the generator used by the basic functions. *)
diff --git a/stdlib/remove_module_aliases.awk b/stdlib/remove_module_aliases.awk
new file mode 100644
index 00000000..1551cb10
--- /dev/null
+++ b/stdlib/remove_module_aliases.awk
@@ -0,0 +1,21 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                 Jeremie Dimino, Jane Street Europe                     *
+#*                                                                        *
+#*   Copyright 2017 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.          *
+#*                                                                        *
+#**************************************************************************
+
+# This script remove the module aliases from stdlib.ml and stdlib.mli
+# so that ocamldep doesn't register dependencies from stdlib to all
+# other modules
+BEGIN { in_aliases=0 }
+NR == 1 { printf ("# 1 \"%s\"\n", FILENAME) }
+/^\(\*MODULE_ALIASES\*\)\r?$/ { in_aliases=1 }
+!in_aliases { print }
diff --git a/stdlib/result.ml b/stdlib/result.ml
new file mode 100644
index 00000000..6d172702
--- /dev/null
+++ b/stdlib/result.ml
@@ -0,0 +1,46 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         The OCaml programmers                          *)
+(*                                                                        *)
+(*   Copyright 2018 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 ('a, 'e) t = ('a, 'e) result = Ok of 'a | Error of 'e
+
+let ok v = Ok v
+let error e = Error e
+let value r ~default = match r with Ok v -> v | Error _ -> default
+let get_ok = function Ok v -> v | Error _ -> invalid_arg "result is Error _"
+let get_error = function Error e -> e | Ok _ -> invalid_arg "result is Ok _"
+let bind r f = match r with Ok v -> f v | Error _ as e -> e
+let join = function Ok r -> r | Error _ as e -> e
+let map f = function Ok v -> Ok (f v) | Error _ as e -> e
+let map_error f = function Error e -> Error (f e) | Ok _ as v -> v
+let fold ~ok ~error = function Ok v -> ok v | Error e -> error e
+let iter f = function Ok v -> f v | Error _ -> ()
+let iter_error f = function Error e -> f e | Ok _ -> ()
+let is_ok = function Ok _ -> true | Error _ -> false
+let is_error = function Error _ -> true | Ok _ -> false
+
+let equal ~ok ~error r0 r1 = match r0, r1 with
+| Ok v0, Ok v1 -> ok v0 v1
+| Error e0, Error e1 -> error e0 e1
+| _, _ -> false
+
+let compare ~ok ~error r0 r1 = match r0, r1 with
+| Ok v0, Ok v1 -> ok v0 v1
+| Error e0, Error e1 -> error e0 e1
+| Ok _, Error _ -> -1
+| Error _, Ok _ -> 1
+
+let to_option = function Ok v -> Some v | Error _ -> None
+let to_list = function Ok v -> [v] | Error _ -> []
+let to_seq = function Ok v -> Seq.return v | Error _ -> Seq.empty
diff --git a/stdlib/result.mli b/stdlib/result.mli
new file mode 100644
index 00000000..96f85dc4
--- /dev/null
+++ b/stdlib/result.mli
@@ -0,0 +1,101 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         The OCaml programmers                          *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Result values.
+
+    Result values handle computation results and errors in an explicit
+    and declarative manner without resorting to exceptions.
+
+    @since 4.08 *)
+
+(** {1:results Results} *)
+
+type ('a, 'e) t = ('a, 'e) result = Ok of 'a | Error of 'e (**)
+(** The type for result values. Either a value [Ok v] or an error [Error e]. *)
+
+val ok : 'a -> ('a, 'e) result
+(** [ok v] is [Ok v]. *)
+
+val error : 'e -> ('a, 'e) result
+(** [error e] is [Error e]. *)
+
+val value : ('a, 'e) result -> default:'a -> 'a
+(** [value r ~default] is [v] if [r] is [Ok v] and [default] otherwise. *)
+
+val get_ok : ('a, 'e) result -> 'a
+(** [get_ok r] is [v] if [r] is [Ok v] and @raise Invalid_argument
+    otherwise. *)
+
+val get_error : ('a, 'e) result -> 'e
+(** [get_error r] is [e] if [r] is [Error e] and @raise Invalid_argument
+    otherwise. *)
+
+val bind : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result
+(** [bind r f] is [f v] if [r] is [Ok v] and [r] if [r] is [Error _]. *)
+
+val join : (('a, 'e) result, 'e) result -> ('a, 'e) result
+(** [join rr] is [r] if [rr] is [Ok r] and [rr] if [rr] is [Error _]. *)
+
+val map : ('a -> 'b) -> ('a, 'e) result -> ('b, 'e) result
+(** [map f r] is [Ok (f v)] if [r] is [Ok v] and [r] if [r] is [Error _]. *)
+
+val map_error : ('e -> 'f) -> ('a, 'e) result -> ('a, 'f) result
+(** [map_error f r] is [Error (f e)] if [r] is [Error e] and [r] if
+    [r] is [Ok _]. *)
+
+val fold : ok:('a -> 'c) -> error:('e -> 'c) -> ('a, 'e) result -> 'c
+(** [fold ~ok ~error r] is [ok v] if [r] is [Ok v] and [error e] if [r]
+    is [Error e]. *)
+
+val iter : ('a -> unit) -> ('a, 'e) result -> unit
+(** [iter f r] is [f v] if [r] is [Ok v] and [()] otherwise. *)
+
+val iter_error : ('e -> unit) -> ('a, 'e) result -> unit
+(** [iter_error f r] is [f e] if [r] is [Error e] and [()] otherwise. *)
+
+(** {1:preds Predicates and comparisons} *)
+
+val is_ok : ('a, 'e) result -> bool
+(** [is_ok r] is [true] iff [r] is [Ok _]. *)
+
+val is_error : ('a, 'e) result -> bool
+(** [is_error r] is [true] iff [r] is [Error _]. *)
+
+val equal :
+  ok:('a -> 'a -> bool) -> error:('e -> 'e -> bool) -> ('a, 'e) result ->
+  ('a, 'e) result -> bool
+(** [equal ~ok ~error r0 r1] tests equality of [r0] and [r1] using [ok]
+    and [error] to respectively compare values wrapped by [Ok _] and
+    [Error _]. *)
+
+val compare :
+  ok:('a -> 'a -> int) -> error:('e -> 'e -> int) -> ('a, 'e) result ->
+  ('a, 'e) result -> int
+(** [compare ~ok ~error r0 r1] totally orders [r0] and [r1] using [ok] and
+    [error] to respectively compare values wrapped by [Ok _ ] and [Error _].
+    [Ok _] values are smaller than [Error _] values. *)
+
+(** {1:convert Converting} *)
+
+val to_option : ('a, 'e) result -> 'a option
+(** [to_option r] is [r] as an option, mapping [Ok v] to [Some v] and
+    [Error _] to [None]. *)
+
+val to_list : ('a, 'e) result -> 'a list
+(** [to_list r] is [[v]] if [r] is [Ok v] and [[]] otherwise. *)
+
+val to_seq : ('a, 'e) result -> 'a Seq.t
+(** [to_seq r] is [r] as a sequence. [Ok v] is the singleton sequence
+    containing [v] and [Error _] is the empty sequence. *)
diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml
new file mode 100644
index 00000000..91fcd66d
--- /dev/null
+++ b/stdlib/scanf.ml
@@ -0,0 +1,1558 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Pierre Weis, projet Cristal, INRIA Rocquencourt            *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open CamlinternalFormatBasics
+open CamlinternalFormat
+
+(* alias to avoid warning for ambiguity between
+   Stdlib.format6
+   and CamlinternalFormatBasics.format6
+
+   (the former is in fact an alias for the latter,
+    but the ambiguity warning doesn't care)
+*)
+type ('a, 'b, 'c, 'd, 'e, 'f) format6 =
+  ('a, 'b, 'c, 'd, 'e, 'f) Stdlib.format6
+
+
+(* The run-time library for scanners. *)
+
+(* Scanning buffers. *)
+module type SCANNING = sig
+
+  type in_channel
+
+  type scanbuf = in_channel
+
+  type file_name = string
+
+  val stdin : in_channel
+  (* The scanning buffer reading from [Stdlib.stdin].
+     [stdib] is equivalent to [Scanning.from_channel Stdlib.stdin]. *)
+
+  val stdib : in_channel
+  (* An alias for [Scanf.stdin], the scanning buffer reading from
+     [Stdlib.stdin]. *)
+
+  val next_char : scanbuf -> char
+  (* [Scanning.next_char ib] advance the scanning buffer for
+     one character.
+     If no more character can be read, sets a end of file condition and
+     returns '\000'. *)
+
+  val invalidate_current_char : scanbuf -> unit
+  (* [Scanning.invalidate_current_char ib] mark the current_char as already
+     scanned. *)
+
+  val peek_char : scanbuf -> char
+  (* [Scanning.peek_char ib] returns the current char available in
+     the buffer or reads one if necessary (when the current character is
+     already scanned).
+     If no character can be read, sets an end of file condition and
+     returns '\000'. *)
+
+  val checked_peek_char : scanbuf -> char
+  (* Same as [Scanning.peek_char] above but always returns a valid char or
+     fails: instead of returning a null char when the reading method of the
+     input buffer has reached an end of file, the function raises exception
+     [End_of_file]. *)
+
+  val store_char : int -> scanbuf -> char -> int
+  (* [Scanning.store_char lim ib c] adds [c] to the token buffer
+     of the scanning buffer [ib]. It also advances the scanning buffer for
+     one character and returns [lim - 1], indicating the new limit for the
+     length of the current token. *)
+
+  val skip_char : int -> scanbuf -> int
+  (* [Scanning.skip_char lim ib] ignores the current character. *)
+
+  val ignore_char : int -> scanbuf -> int
+  (* [Scanning.ignore_char ib lim] ignores the current character and
+     decrements the limit. *)
+
+  val token : scanbuf -> string
+  (* [Scanning.token ib] returns the string stored into the token
+     buffer of the scanning buffer: it returns the token matched by the
+     format. *)
+
+  val reset_token : scanbuf -> unit
+  (* [Scanning.reset_token ib] resets the token buffer of
+     the given scanning buffer. *)
+
+  val char_count : scanbuf -> int
+  (* [Scanning.char_count ib] returns the number of characters
+     read so far from the given buffer. *)
+
+  val line_count : scanbuf -> int
+  (* [Scanning.line_count ib] returns the number of new line
+     characters read so far from the given buffer. *)
+
+  val token_count : scanbuf -> int
+  (* [Scanning.token_count ib] returns the number of tokens read
+     so far from [ib]. *)
+
+  val eof : scanbuf -> bool
+  (* [Scanning.eof ib] returns the end of input condition
+     of the given buffer. *)
+
+  val end_of_input : scanbuf -> bool
+  (* [Scanning.end_of_input ib] tests the end of input condition
+     of the given buffer (if no char has ever been read, an attempt to
+     read one is performed). *)
+
+  val beginning_of_input : scanbuf -> bool
+  (* [Scanning.beginning_of_input ib] tests the beginning of input
+     condition of the given buffer. *)
+
+  val name_of_input : scanbuf -> string
+  (* [Scanning.name_of_input ib] returns the name of the character
+     source for input buffer [ib]. *)
+
+  val open_in : file_name -> in_channel
+  val open_in_bin : file_name -> in_channel
+  val from_file : file_name -> in_channel
+  val from_file_bin : file_name -> in_channel
+  val from_string : string -> in_channel
+  val from_function : (unit -> char) -> in_channel
+  val from_channel : Stdlib.in_channel -> in_channel
+
+  val close_in : in_channel -> unit
+
+  val memo_from_channel : Stdlib.in_channel -> in_channel
+  (* Obsolete. *)
+
+end
+
+
+module Scanning : SCANNING = struct
+
+  (* The run-time library for scanf. *)
+
+  type file_name = string
+
+  type in_channel_name =
+    | From_channel of Stdlib.in_channel
+    | From_file of file_name * Stdlib.in_channel
+    | From_function
+    | From_string
+
+
+  type in_channel = {
+    mutable ic_eof : bool;
+    mutable ic_current_char : char;
+    mutable ic_current_char_is_valid : bool;
+    mutable ic_char_count : int;
+    mutable ic_line_count : int;
+    mutable ic_token_count : int;
+    mutable ic_get_next_char : unit -> char;
+    ic_token_buffer : Buffer.t;
+    ic_input_name : in_channel_name;
+  }
+
+
+  type scanbuf = in_channel
+
+  let null_char = '\000'
+
+  (* Reads a new character from input buffer.
+     Next_char never fails, even in case of end of input:
+     it then simply sets the end of file condition. *)
+  let next_char ib =
+    try
+      let c = ib.ic_get_next_char () in
+      ib.ic_current_char <- c;
+      ib.ic_current_char_is_valid <- true;
+      ib.ic_char_count <- succ ib.ic_char_count;
+      if c = '\n' then ib.ic_line_count <- succ ib.ic_line_count;
+      c with
+    | End_of_file ->
+      let c = null_char in
+      ib.ic_current_char <- c;
+      ib.ic_current_char_is_valid <- false;
+      ib.ic_eof <- true;
+      c
+
+
+  let peek_char ib =
+    if ib.ic_current_char_is_valid
+    then ib.ic_current_char
+    else next_char ib
+
+
+  (* Returns a valid current char for the input buffer. In particular
+     no irrelevant null character (as set by [next_char] in case of end
+     of input) is returned, since [End_of_file] is raised when
+     [next_char] sets the end of file condition while trying to read a
+     new character. *)
+  let checked_peek_char ib =
+    let c = peek_char ib in
+    if ib.ic_eof then raise End_of_file;
+    c
+
+
+  let end_of_input ib =
+    ignore (peek_char ib);
+    ib.ic_eof
+
+
+  let eof ib = ib.ic_eof
+
+  let beginning_of_input ib = ib.ic_char_count = 0
+
+  let name_of_input ib =
+    match ib.ic_input_name with
+    | From_channel _ic -> "unnamed Stdlib input channel"
+    | From_file (fname, _ic) -> fname
+    | From_function -> "unnamed function"
+    | From_string -> "unnamed character string"
+
+
+  let char_count ib =
+    if ib.ic_current_char_is_valid
+    then ib.ic_char_count - 1
+    else ib.ic_char_count
+
+
+  let line_count ib = ib.ic_line_count
+
+  let reset_token ib = Buffer.reset ib.ic_token_buffer
+
+  let invalidate_current_char ib = ib.ic_current_char_is_valid <- false
+
+  let token ib =
+    let token_buffer = ib.ic_token_buffer in
+    let tok = Buffer.contents token_buffer in
+    Buffer.clear token_buffer;
+    ib.ic_token_count <- succ ib.ic_token_count;
+    tok
+
+
+  let token_count ib = ib.ic_token_count
+
+  let skip_char width ib =
+    invalidate_current_char ib;
+    width
+
+
+  let ignore_char width ib = skip_char (width - 1) ib
+
+  let store_char width ib c =
+    Buffer.add_char ib.ic_token_buffer c;
+    ignore_char width ib
+
+
+  let default_token_buffer_size = 1024
+
+  let create iname next = {
+    ic_eof = false;
+    ic_current_char = null_char;
+    ic_current_char_is_valid = false;
+    ic_char_count = 0;
+    ic_line_count = 0;
+    ic_token_count = 0;
+    ic_get_next_char = next;
+    ic_token_buffer = Buffer.create default_token_buffer_size;
+    ic_input_name = iname;
+  }
+
+
+  let from_string s =
+    let i = ref 0 in
+    let len = String.length s in
+    let next () =
+      if !i >= len then raise End_of_file else
+      let c = s.[!i] in
+      incr i;
+      c in
+    create From_string next
+
+
+  let from_function = create From_function
+
+  (* Scanning from an input channel. *)
+
+  (* Position of the problem:
+
+     We cannot prevent the scanning mechanism to use one lookahead character,
+     if needed by the semantics of the format string specifications (e.g. a
+     trailing 'skip space' specification in the format string); in this case,
+     the mandatory lookahead character is indeed read from the input and not
+     used to return the token read. It is thus mandatory to be able to store
+     an unused lookahead character somewhere to get it as the first character
+     of the next scan.
+
+     To circumvent this problem, all the scanning functions get a low level
+     input buffer argument where they store the lookahead character when
+     needed; additionally, the input buffer is the only source of character of
+     a scanner. The [scanbuf] input buffers are defined in module {!Scanning}.
+
+     Now we understand that it is extremely important that related and
+     successive calls to scanners indeed read from the same input buffer.
+     In effect, if a scanner [scan1] is reading from [ib1] and stores an
+     unused lookahead character [c1] into its input buffer [ib1], then
+     another scanner [scan2] not reading from the same buffer [ib1] will miss
+     the character [c1], seemingly vanished in the air from the point of view
+     of [scan2].
+
+     This mechanism works perfectly to read from strings, from files, and from
+     functions, since in those cases, allocating two buffers reading from the
+     same source is unnatural.
+
+     Still, there is a difficulty in the case of scanning from an input
+     channel. In effect, when scanning from an input channel [ic], this channel
+     may not have been allocated from within this library. Hence, it may be
+     shared (two functions of the user's program may successively read from
+     [ic]). This is highly error prone since, one of the function may seek the
+     input channel, while the other function has still an unused lookahead
+     character in its input buffer. In conclusion, you should never mix direct
+     low level reading and high level scanning from the same input channel.
+
+  *)
+
+  (* Perform bufferized input to improve efficiency. *)
+  let file_buffer_size = ref 1024
+
+  (* The scanner closes the input channel at end of input. *)
+  let scan_close_at_end ic = Stdlib.close_in ic; raise End_of_file
+
+  (* The scanner does not close the input channel at end of input:
+     it just raises [End_of_file]. *)
+  let scan_raise_at_end _ic = raise End_of_file
+
+  let from_ic scan_close_ic iname ic =
+    let len = !file_buffer_size in
+    let buf = Bytes.create len in
+    let i = ref 0 in
+    let lim = ref 0 in
+    let eof = ref false in
+    let next () =
+      if !i < !lim then begin let c = Bytes.get buf !i in incr i; c end else
+      if !eof then raise End_of_file else begin
+        lim := input ic buf 0 len;
+        if !lim = 0 then begin eof := true; scan_close_ic ic end else begin
+          i := 1;
+          Bytes.get buf 0
+        end
+      end in
+    create iname next
+
+
+  let from_ic_close_at_end = from_ic scan_close_at_end
+  let from_ic_raise_at_end = from_ic scan_raise_at_end
+
+  (* The scanning buffer reading from [Stdlib.stdin].
+     One could try to define [stdib] as a scanning buffer reading a character
+     at a time (no bufferization at all), but unfortunately the top-level
+     interaction would be wrong. This is due to some kind of
+     'race condition' when reading from [Stdlib.stdin],
+     since the interactive compiler and [Scanf.scanf] will simultaneously
+     read the material they need from [Stdlib.stdin]; then, confusion
+     will result from what should be read by the top-level and what should be
+     read by [Scanf.scanf].
+     This is even more complicated by the one character lookahead that
+     [Scanf.scanf] is sometimes obliged to maintain: the lookahead character
+     will be available for the next [Scanf.scanf] entry, seemingly coming from
+     nowhere.
+     Also no [End_of_file] is raised when reading from stdin: if not enough
+     characters have been read, we simply ask to read more. *)
+  let stdin =
+    from_ic scan_raise_at_end
+      (From_file ("-", Stdlib.stdin)) Stdlib.stdin
+
+
+  let stdib = stdin
+
+  let open_in_file open_in fname =
+    match fname with
+    | "-" -> stdin
+    | fname ->
+      let ic = open_in fname in
+      from_ic_close_at_end (From_file (fname, ic)) ic
+
+
+  let open_in = open_in_file Stdlib.open_in
+  let open_in_bin = open_in_file Stdlib.open_in_bin
+
+  let from_file = open_in
+  let from_file_bin = open_in_bin
+
+  let from_channel ic =
+    from_ic_raise_at_end (From_channel ic) ic
+
+
+  let close_in ib =
+    match ib.ic_input_name with
+    | From_channel ic ->
+      Stdlib.close_in ic
+    | From_file (_fname, ic) -> Stdlib.close_in ic
+    | From_function | From_string -> ()
+
+
+  (*
+     Obsolete: a memo [from_channel] version to build a [Scanning.in_channel]
+     scanning buffer out of a [Stdlib.in_channel].
+     This function was used to try to preserve the scanning
+     semantics for the (now obsolete) function [fscanf].
+     Given that all scanner must read from a [Scanning.in_channel] scanning
+     buffer, [fscanf] must read from one!
+     More precisely, given [ic], all successive calls [fscanf ic] must read
+     from the same scanning buffer.
+     This obliged this library to allocated scanning buffers that were
+     not properly garbage collectable, hence leading to memory leaks.
+     If you need to read from a [Stdlib.in_channel] input channel
+     [ic], simply define a [Scanning.in_channel] formatted input channel as in
+     [let ib = Scanning.from_channel ic], then use [Scanf.bscanf ib] as usual.
+  *)
+  let memo_from_ic =
+    let memo = ref [] in
+    (fun scan_close_ic ic ->
+     try List.assq ic !memo with
+     | Not_found ->
+       let ib =
+         from_ic scan_close_ic (From_channel ic) ic in
+       memo := (ic, ib) :: !memo;
+       ib)
+
+
+  (* Obsolete: see {!memo_from_ic} above. *)
+  let memo_from_channel = memo_from_ic scan_raise_at_end
+
+end
+
+
+(* Formatted input functions. *)
+
+type ('a, 'b, 'c, 'd) scanner =
+     ('a, Scanning.in_channel, 'b, 'c, 'a -> 'd, 'd) format6 -> 'c
+
+
+(* Reporting errors. *)
+exception Scan_failure of string
+
+let bad_input s = raise (Scan_failure s)
+
+let bad_input_escape c =
+  bad_input (Printf.sprintf "illegal escape character %C" c)
+
+
+let bad_token_length message =
+  bad_input
+    (Printf.sprintf
+       "scanning of %s failed: \
+        the specified length was too short for token"
+       message)
+
+
+let bad_end_of_input message =
+  bad_input
+    (Printf.sprintf
+       "scanning of %s failed: \
+        premature end of file occurred before end of token"
+       message)
+
+
+let bad_float () =
+  bad_input "no dot or exponent part found in float token"
+
+
+let bad_hex_float () =
+  bad_input "not a valid float in hexadecimal notation"
+
+
+let character_mismatch_err c ci =
+  Printf.sprintf "looking for %C, found %C" c ci
+
+
+let character_mismatch c ci =
+  bad_input (character_mismatch_err c ci)
+
+
+let rec skip_whites ib =
+  let c = Scanning.peek_char ib in
+  if not (Scanning.eof ib) then begin
+    match c with
+    | ' ' | '\t' | '\n' | '\r' ->
+      Scanning.invalidate_current_char ib; skip_whites ib
+    | _ -> ()
+  end
+
+
+(* Checking that [c] is indeed in the input, then skips it.
+   In this case, the character [c] has been explicitly specified in the
+   format as being mandatory in the input; hence we should fail with
+   [End_of_file] in case of end_of_input.
+   (Remember that [Scan_failure] is raised only when (we can prove by
+   evidence) that the input does not match the format string given. We must
+   thus differentiate [End_of_file] as an error due to lack of input, and
+   [Scan_failure] which is due to provably wrong input. I am not sure this is
+   worth the burden: it is complex and somehow subliminal; should be clearer
+   to fail with Scan_failure "Not enough input to complete scanning"!)
+
+   That's why, waiting for a better solution, we use checked_peek_char here.
+   We are also careful to treat "\r\n" in the input as an end of line marker:
+   it always matches a '\n' specification in the input format string. *)
+let rec check_char ib c =
+  match c with
+  | ' ' -> skip_whites ib
+  | '\n' -> check_newline ib
+  | c -> check_this_char ib c
+
+and check_this_char ib c =
+  let ci = Scanning.checked_peek_char ib in
+  if ci = c then Scanning.invalidate_current_char ib else
+  character_mismatch c ci
+
+and check_newline ib =
+  let ci = Scanning.checked_peek_char ib in
+  match ci with
+  | '\n' -> Scanning.invalidate_current_char ib
+  | '\r' -> Scanning.invalidate_current_char ib; check_this_char ib '\n'
+  | _ -> character_mismatch '\n' ci
+
+
+(* Extracting tokens from the output token buffer. *)
+
+let token_char ib = (Scanning.token ib).[0]
+
+let token_string = Scanning.token
+
+let token_bool ib =
+  match Scanning.token ib with
+  | "true" -> true
+  | "false" -> false
+  | s -> bad_input (Printf.sprintf "invalid boolean '%s'" s)
+
+
+(* The type of integer conversions. *)
+type integer_conversion =
+  | B_conversion (* Unsigned binary conversion *)
+  | D_conversion (* Signed decimal conversion *)
+  | I_conversion (* Signed integer conversion *)
+  | O_conversion (* Unsigned octal conversion *)
+  | U_conversion (* Unsigned decimal conversion *)
+  | X_conversion (* Unsigned hexadecimal conversion *)
+
+
+let integer_conversion_of_char = function
+  | 'b' -> B_conversion
+  | 'd' -> D_conversion
+  | 'i' -> I_conversion
+  | 'o' -> O_conversion
+  | 'u' -> U_conversion
+  | 'x' | 'X' -> X_conversion
+  | _ -> assert false
+
+
+(* Extract an integer literal token.
+   Since the functions Stdlib.*int*_of_string do not accept a leading +,
+   we skip it if necessary. *)
+let token_int_literal conv ib =
+  let tok =
+    match conv with
+    | D_conversion | I_conversion -> Scanning.token ib
+    | U_conversion -> "0u" ^ Scanning.token ib
+    | O_conversion -> "0o" ^ Scanning.token ib
+    | X_conversion -> "0x" ^ Scanning.token ib
+    | B_conversion -> "0b" ^ Scanning.token ib in
+  let l = String.length tok in
+  if l = 0 || tok.[0] <> '+' then tok else String.sub tok 1 (l - 1)
+
+
+(* All the functions that convert a string to a number raise the exception
+   Failure when the conversion is not possible.
+   This exception is then trapped in [kscanf]. *)
+let token_int conv ib = int_of_string (token_int_literal conv ib)
+
+let token_float ib = float_of_string (Scanning.token ib)
+
+(* To scan native ints, int32 and int64 integers.
+   We cannot access to conversions to/from strings for those types,
+   Nativeint.of_string, Int32.of_string, and Int64.of_string,
+   since those modules are not available to [Scanf].
+   However, we can bind and use the corresponding primitives that are
+   available in the runtime. *)
+external nativeint_of_string : string -> nativeint
+  = "caml_nativeint_of_string"
+
+external int32_of_string : string -> int32
+  = "caml_int32_of_string"
+
+external int64_of_string : string -> int64
+  = "caml_int64_of_string"
+
+
+let token_nativeint conv ib = nativeint_of_string (token_int_literal conv ib)
+let token_int32 conv ib = int32_of_string (token_int_literal conv ib)
+let token_int64 conv ib = int64_of_string (token_int_literal conv ib)
+
+(* Scanning numbers. *)
+
+(* Digits scanning functions suppose that one character has been checked and
+   is available, since they return at end of file with the currently found
+   token selected.
+
+   Put it in another way, the digits scanning functions scan for a possibly
+   empty sequence of digits, (hence, a successful scanning from one of those
+   functions does not imply that the token is a well-formed number: to get a
+   true number, it is mandatory to check that at least one valid digit is
+   available before calling one of the digit scanning functions). *)
+
+(* The decimal case is treated especially for optimization purposes. *)
+let rec scan_decimal_digit_star width ib =
+  if width = 0 then width else
+  let c = Scanning.peek_char ib in
+  if Scanning.eof ib then width else
+  match c with
+  | '0' .. '9' as c ->
+    let width = Scanning.store_char width ib c in
+    scan_decimal_digit_star width ib
+  | '_' ->
+    let width = Scanning.ignore_char width ib in
+    scan_decimal_digit_star width ib
+  | _ -> width
+
+
+let scan_decimal_digit_plus width ib =
+  if width = 0 then bad_token_length "decimal digits" else
+  let c = Scanning.checked_peek_char ib in
+  match c with
+  | '0' .. '9' ->
+    let width = Scanning.store_char width ib c in
+    scan_decimal_digit_star width ib
+  | c ->
+    bad_input (Printf.sprintf "character %C is not a decimal digit" c)
+
+
+(* To scan numbers from other bases, we use a predicate argument to
+   scan digits. *)
+let scan_digit_star digitp width ib =
+  let rec scan_digits width ib =
+    if width = 0 then width else
+    let c = Scanning.peek_char ib in
+    if Scanning.eof ib then width else
+    match c with
+    | c when digitp c ->
+      let width = Scanning.store_char width ib c in
+      scan_digits width ib
+    | '_' ->
+      let width = Scanning.ignore_char width ib in
+      scan_digits width ib
+    | _ -> width in
+  scan_digits width ib
+
+
+let scan_digit_plus basis digitp width ib =
+  (* Ensure we have got enough width left,
+     and read at least one digit. *)
+  if width = 0 then bad_token_length "digits" else
+  let c = Scanning.checked_peek_char ib in
+  if digitp c then
+    let width = Scanning.store_char width ib c in
+    scan_digit_star digitp width ib
+  else
+    bad_input (Printf.sprintf "character %C is not a valid %s digit" c basis)
+
+
+let is_binary_digit = function
+  | '0' .. '1' -> true
+  | _ -> false
+
+
+let scan_binary_int = scan_digit_plus "binary" is_binary_digit
+
+let is_octal_digit = function
+  | '0' .. '7' -> true
+  | _ -> false
+
+
+let scan_octal_int = scan_digit_plus "octal" is_octal_digit
+
+let is_hexa_digit = function
+  | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true
+  | _ -> false
+
+
+let scan_hexadecimal_int = scan_digit_plus "hexadecimal" is_hexa_digit
+
+(* Scan a decimal integer. *)
+let scan_unsigned_decimal_int = scan_decimal_digit_plus
+
+let scan_sign width ib =
+  let c = Scanning.checked_peek_char ib in
+  match c with
+  | '+' -> Scanning.store_char width ib c
+  | '-' -> Scanning.store_char width ib c
+  | _ -> width
+
+
+let scan_optionally_signed_decimal_int width ib =
+  let width = scan_sign width ib in
+  scan_unsigned_decimal_int width ib
+
+
+(* Scan an unsigned integer that could be given in any (common) basis.
+   If digits are prefixed by one of 0x, 0X, 0o, or 0b, the number is
+   assumed to be written respectively in hexadecimal, hexadecimal,
+   octal, or binary. *)
+let scan_unsigned_int width ib =
+  match Scanning.checked_peek_char ib with
+  | '0' as c ->
+    let width = Scanning.store_char width ib c in
+    if width = 0 then width else
+    let c = Scanning.peek_char ib in
+    if Scanning.eof ib then width else
+    begin match c with
+    | 'x' | 'X' -> scan_hexadecimal_int (Scanning.store_char width ib c) ib
+    | 'o' -> scan_octal_int (Scanning.store_char width ib c) ib
+    | 'b' -> scan_binary_int (Scanning.store_char width ib c) ib
+    | _ -> scan_decimal_digit_star width ib end
+  | _ -> scan_unsigned_decimal_int width ib
+
+
+let scan_optionally_signed_int width ib =
+  let width = scan_sign width ib in
+  scan_unsigned_int width ib
+
+
+let scan_int_conversion conv width ib =
+  match conv with
+  | B_conversion -> scan_binary_int width ib
+  | D_conversion -> scan_optionally_signed_decimal_int width ib
+  | I_conversion -> scan_optionally_signed_int width ib
+  | O_conversion -> scan_octal_int width ib
+  | U_conversion -> scan_unsigned_decimal_int width ib
+  | X_conversion -> scan_hexadecimal_int width ib
+
+
+(* Scanning floating point numbers. *)
+
+(* Fractional part is optional and can be reduced to 0 digits. *)
+let scan_fractional_part width ib =
+  if width = 0 then width else
+  let c = Scanning.peek_char ib in
+  if Scanning.eof ib then width else
+  match c with
+  | '0' .. '9' as c ->
+    scan_decimal_digit_star (Scanning.store_char width ib c) ib
+  | _ -> width
+
+
+(* Exp part is optional and can be reduced to 0 digits. *)
+let scan_exponent_part width ib =
+  if width = 0 then width else
+  let c = Scanning.peek_char ib in
+  if Scanning.eof ib then width else
+  match c with
+  | 'e' | 'E' as c ->
+    scan_optionally_signed_decimal_int (Scanning.store_char width ib c) ib
+  | _ -> width
+
+
+(* Scan the integer part of a floating point number, (not using the
+   OCaml lexical convention since the integer part can be empty):
+   an optional sign, followed by a possibly empty sequence of decimal
+   digits (e.g. -.1). *)
+let scan_integer_part width ib =
+  let width = scan_sign width ib in
+  scan_decimal_digit_star width ib
+
+
+(*
+   For the time being we have (as found in scanf.mli):
+   the field width is composed of an optional integer literal
+   indicating the maximal width of the token to read.
+   Unfortunately, the type-checker let the user write an optional precision,
+   since this is valid for printf format strings.
+
+   Thus, the next step for Scanf is to support a full width and precision
+   indication, more or less similar to the one for printf, possibly extended
+   to the specification of a [max, min] range for the width of the token read
+   for strings. Something like the following spec for scanf.mli:
+
+   The optional [width] is an integer indicating the maximal
+   width of the token read. For instance, [%6d] reads an integer,
+   having at most 6 characters.
+
+   The optional [precision] is a dot [.] followed by an integer:
+
+   - in the floating point number conversions ([%f], [%e], [%g], [%F], [%E],
+   and [%F] conversions, the [precision] indicates the maximum number of
+   digits that may follow the decimal point. For instance, [%.4f] reads a
+   [float] with at most 4 fractional digits,
+
+   - in the string conversions ([%s], [%S], [%\[ range \]]), and in the
+   integer number conversions ([%i], [%d], [%u], [%x], [%o], and their
+   [int32], [int64], and [native_int] correspondent), the [precision]
+   indicates the required minimum width of the token read,
+
+   - on all other conversions, the width and precision specify the [max, min]
+   range for the width of the token read.
+*)
+let scan_float width precision ib =
+  let width = scan_integer_part width ib in
+  if width = 0 then width, precision else
+  let c = Scanning.peek_char ib in
+  if Scanning.eof ib then width, precision else
+  match c with
+  | '.' ->
+    let width = Scanning.store_char width ib c in
+    let precision = min width precision in
+    let width = width - (precision - scan_fractional_part precision ib) in
+    scan_exponent_part width ib, precision
+  | _ ->
+    scan_exponent_part width ib, precision
+
+
+let check_case_insensitive_string width ib error str =
+  let lowercase c =
+    match c with
+    | 'A' .. 'Z' ->
+      char_of_int (int_of_char c - int_of_char 'A' + int_of_char 'a')
+    | _ -> c in
+  let len = String.length str in
+  let width = ref width in
+  for i = 0 to len - 1 do
+    let c = Scanning.peek_char ib in
+    if lowercase c <> lowercase str.[i] then error ();
+    if !width = 0 then error ();
+    width := Scanning.store_char !width ib c;
+  done;
+  !width
+
+
+let scan_hex_float width precision ib =
+  if width = 0 || Scanning.end_of_input ib then bad_hex_float ();
+  let width = scan_sign width ib in
+  if width = 0 || Scanning.end_of_input ib then bad_hex_float ();
+  match Scanning.peek_char ib with
+  | '0' as c -> (
+    let width = Scanning.store_char width ib c in
+    if width = 0 || Scanning.end_of_input ib then bad_hex_float ();
+    let width = check_case_insensitive_string width ib bad_hex_float "x" in
+    if width = 0 || Scanning.end_of_input ib then width else
+      let width = match Scanning.peek_char ib with
+        | '.' | 'p' | 'P' -> width
+        | _ -> scan_hexadecimal_int width ib in
+      if width = 0 || Scanning.end_of_input ib then width else
+        let width = match Scanning.peek_char ib with
+          | '.' as c -> (
+            let width = Scanning.store_char width ib c in
+            if width = 0 || Scanning.end_of_input ib then width else
+              match Scanning.peek_char ib with
+              | 'p' | 'P' -> width
+              | _ ->
+                let precision = min width precision in
+                width - (precision - scan_hexadecimal_int precision ib)
+          )
+          | _ -> width in
+        if width = 0 || Scanning.end_of_input ib then width else
+          match Scanning.peek_char ib with
+          | 'p' | 'P' as c ->
+            let width = Scanning.store_char width ib c in
+            if width = 0 || Scanning.end_of_input ib then bad_hex_float ();
+            scan_optionally_signed_decimal_int width ib
+          | _ -> width
+  )
+  | 'n' | 'N' as c ->
+    let width = Scanning.store_char width ib c in
+    if width = 0 || Scanning.end_of_input ib then bad_hex_float ();
+    check_case_insensitive_string width ib bad_hex_float "an"
+  | 'i' | 'I' as c ->
+    let width = Scanning.store_char width ib c in
+    if width = 0 || Scanning.end_of_input ib then bad_hex_float ();
+    check_case_insensitive_string width ib bad_hex_float "nfinity"
+  | _ -> bad_hex_float ()
+
+
+let scan_caml_float_rest width precision ib =
+  if width = 0 || Scanning.end_of_input ib then bad_float ();
+  let width = scan_decimal_digit_star width ib in
+  if width = 0 || Scanning.end_of_input ib then bad_float ();
+  let c = Scanning.peek_char ib in
+  match c with
+  | '.' ->
+    let width = Scanning.store_char width ib c in
+    (* The effective width available for scanning the fractional part is
+       the minimum of declared precision and width left. *)
+    let precision = min width precision in
+    (* After scanning the fractional part with [precision] provisional width,
+       [width_precision] is left. *)
+    let width_precision = scan_fractional_part precision ib in
+    (* Hence, scanning the fractional part took exactly
+       [precision - width_precision] chars. *)
+    let frac_width = precision - width_precision in
+    (* And new provisional width is [width - width_precision. *)
+    let width = width - frac_width in
+    scan_exponent_part width ib
+  | 'e' | 'E' ->
+    scan_exponent_part width ib
+  | _ -> bad_float ()
+
+
+let scan_caml_float width precision ib =
+  if width = 0 || Scanning.end_of_input ib then bad_float ();
+  let width = scan_sign width ib in
+  if width = 0 || Scanning.end_of_input ib then bad_float ();
+  match Scanning.peek_char ib with
+  | '0' as c -> (
+    let width = Scanning.store_char width ib c in
+    if width = 0 || Scanning.end_of_input ib then bad_float ();
+    match Scanning.peek_char ib with
+    | 'x' | 'X' as c -> (
+      let width = Scanning.store_char width ib c in
+      if width = 0 || Scanning.end_of_input ib then bad_float ();
+      let width = scan_hexadecimal_int width ib in
+      if width = 0 || Scanning.end_of_input ib then bad_float ();
+      let width = match Scanning.peek_char ib with
+        | '.' as c -> (
+          let width = Scanning.store_char width ib c in
+          if width = 0 || Scanning.end_of_input ib then width else
+            match Scanning.peek_char ib with
+            | 'p' | 'P' -> width
+            | _ ->
+              let precision = min width precision in
+              width - (precision - scan_hexadecimal_int precision ib)
+        )
+        | 'p' | 'P' -> width
+        | _ -> bad_float () in
+      if width = 0 || Scanning.end_of_input ib then width else
+        match Scanning.peek_char ib with
+        | 'p' | 'P' as c ->
+          let width = Scanning.store_char width ib c in
+          if width = 0 || Scanning.end_of_input ib then bad_hex_float ();
+          scan_optionally_signed_decimal_int width ib
+        | _ -> width
+    )
+    | _ ->
+      scan_caml_float_rest width precision ib
+  )
+  | '1' .. '9' as c ->
+    let width = Scanning.store_char width ib c in
+    if width = 0 || Scanning.end_of_input ib then bad_float ();
+    scan_caml_float_rest width precision ib
+(* Special case of nan and infinity:
+  | 'i' ->
+  | 'n' ->
+*)
+  | _ -> bad_float ()
+
+
+(* Scan a regular string:
+   stops when encountering a space, if no scanning indication has been given;
+   otherwise, stops when encountering the characters in the scanning
+   indication [stp].
+   It also stops at end of file or when the maximum number of characters has
+   been read. *)
+let scan_string stp width ib =
+  let rec loop width =
+    if width = 0 then width else
+    let c = Scanning.peek_char ib in
+    if Scanning.eof ib then width else
+      match stp with
+      | Some c' when c = c' -> Scanning.skip_char width ib
+      | Some _ -> loop (Scanning.store_char width ib c)
+      | None ->
+        match c with
+        | ' ' | '\t' | '\n' | '\r' -> width
+        | _ -> loop (Scanning.store_char width ib c) in
+  loop width
+
+
+(* Scan a char: peek strictly one character in the input, whatsoever. *)
+let scan_char width ib =
+  (* The case width = 0 could not happen here, since it is tested before
+     calling scan_char, in the main scanning function.
+    if width = 0 then bad_token_length "a character" else *)
+  Scanning.store_char width ib (Scanning.checked_peek_char ib)
+
+
+let char_for_backslash = function
+  | 'n' -> '\010'
+  | 'r' -> '\013'
+  | 'b' -> '\008'
+  | 't' -> '\009'
+  | c -> c
+
+
+(* The integer value corresponding to the facial value of a valid
+   decimal digit character. *)
+let decimal_value_of_char c = int_of_char c - int_of_char '0'
+
+let char_for_decimal_code c0 c1 c2 =
+  let c =
+    100 * decimal_value_of_char c0 +
+     10 * decimal_value_of_char c1 +
+          decimal_value_of_char c2 in
+  if c < 0 || c > 255 then
+    bad_input
+      (Printf.sprintf
+         "bad character decimal encoding \\%c%c%c" c0 c1 c2) else
+  char_of_int c
+
+
+(* The integer value corresponding to the facial value of a valid
+   hexadecimal digit character. *)
+let hexadecimal_value_of_char c =
+  let d = int_of_char c in
+  (* Could also be:
+    if d <= int_of_char '9' then d - int_of_char '0' else
+    if d <= int_of_char 'F' then 10 + d - int_of_char 'A' else
+    if d <= int_of_char 'f' then 10 + d - int_of_char 'a' else assert false
+  *)
+  if d >= int_of_char 'a' then
+    d - 87 (* 10 + int_of_char c - int_of_char 'a' *) else
+  if d >= int_of_char 'A' then
+    d - 55  (* 10 + int_of_char c - int_of_char 'A' *) else
+    d - int_of_char '0'
+
+
+let char_for_hexadecimal_code c1 c2 =
+  let c =
+    16 * hexadecimal_value_of_char c1 +
+         hexadecimal_value_of_char c2 in
+  if c < 0 || c > 255 then
+    bad_input
+      (Printf.sprintf "bad character hexadecimal encoding \\%c%c" c1 c2) else
+  char_of_int c
+
+
+(* Called in particular when encountering '\\' as starter of a char.
+   Stops before the corresponding '\''. *)
+let check_next_char message width ib =
+  if width = 0 then bad_token_length message else
+  let c = Scanning.peek_char ib in
+  if Scanning.eof ib then bad_end_of_input message else
+  c
+
+
+let check_next_char_for_char = check_next_char "a Char"
+let check_next_char_for_string = check_next_char "a String"
+
+let scan_backslash_char width ib =
+  match check_next_char_for_char width ib with
+  | '\\' | '\'' | '\"' | 'n' | 't' | 'b' | 'r' as c ->
+    Scanning.store_char width ib (char_for_backslash c)
+  | '0' .. '9' as c ->
+    let get_digit () =
+      let c = Scanning.next_char ib in
+      match c with
+      | '0' .. '9' as c -> c
+      | c -> bad_input_escape c in
+    let c0 = c in
+    let c1 = get_digit () in
+    let c2 = get_digit () in
+    Scanning.store_char (width - 2) ib (char_for_decimal_code c0 c1 c2)
+  | 'x' ->
+    let get_digit () =
+      let c = Scanning.next_char ib in
+      match c with
+      | '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' as c -> c
+      | c -> bad_input_escape c in
+    let c1 = get_digit () in
+    let c2 = get_digit () in
+    Scanning.store_char (width - 2) ib (char_for_hexadecimal_code c1 c2)
+  | c ->
+    bad_input_escape c
+
+
+(* Scan a character (an OCaml token). *)
+let scan_caml_char width ib =
+
+  let rec find_start width =
+    match Scanning.checked_peek_char ib with
+    | '\'' -> find_char (Scanning.ignore_char width ib)
+    | c -> character_mismatch '\'' c
+
+  and find_char width =
+    match check_next_char_for_char width ib with
+    | '\\' ->
+      find_stop (scan_backslash_char (Scanning.ignore_char width ib) ib)
+    | c ->
+      find_stop (Scanning.store_char width ib c)
+
+  and find_stop width =
+    match check_next_char_for_char width ib with
+    | '\'' -> Scanning.ignore_char width ib
+    | c -> character_mismatch '\'' c in
+
+  find_start width
+
+
+(* Scan a delimited string (an OCaml token). *)
+let scan_caml_string width ib =
+
+  let rec find_start width =
+    match Scanning.checked_peek_char ib with
+    | '\"' -> find_stop (Scanning.ignore_char width ib)
+    | c -> character_mismatch '\"' c
+
+  and find_stop width =
+    match check_next_char_for_string width ib with
+    | '\"' -> Scanning.ignore_char width ib
+    | '\\' -> scan_backslash (Scanning.ignore_char width ib)
+    | c -> find_stop (Scanning.store_char width ib c)
+
+  and scan_backslash width =
+    match check_next_char_for_string width ib with
+    | '\r' -> skip_newline (Scanning.ignore_char width ib)
+    | '\n' -> skip_spaces (Scanning.ignore_char width ib)
+    | _ -> find_stop (scan_backslash_char width ib)
+
+  and skip_newline width =
+    match check_next_char_for_string width ib with
+    | '\n' -> skip_spaces (Scanning.ignore_char width ib)
+    | _ -> find_stop (Scanning.store_char width ib '\r')
+
+  and skip_spaces width =
+    match check_next_char_for_string width ib with
+    | ' ' -> skip_spaces (Scanning.ignore_char width ib)
+    | _ -> find_stop width in
+
+  find_start width
+
+
+(* Scan a boolean (an OCaml token). *)
+let scan_bool ib =
+  let c = Scanning.checked_peek_char ib in
+  let m =
+    match c with
+    | 't' -> 4
+    | 'f' -> 5
+    | c ->
+      bad_input
+        (Printf.sprintf "the character %C cannot start a boolean" c) in
+  scan_string None m ib
+
+
+(* Scan a string containing elements in char_set and terminated by scan_indic
+   if provided. *)
+let scan_chars_in_char_set char_set scan_indic width ib =
+  let rec scan_chars i stp =
+    let c = Scanning.peek_char ib in
+    if i > 0 && not (Scanning.eof ib) &&
+       is_in_char_set char_set c &&
+       int_of_char c <> stp then
+      let _ = Scanning.store_char max_int ib c in
+      scan_chars (i - 1) stp in
+  match scan_indic with
+  | None -> scan_chars width (-1);
+  | Some c ->
+    scan_chars width (int_of_char c);
+    if not (Scanning.eof ib) then
+      let ci = Scanning.peek_char ib in
+      if c = ci
+      then Scanning.invalidate_current_char ib
+      else character_mismatch c ci
+
+
+(* The global error report function for [Scanf]. *)
+let scanf_bad_input ib = function
+  | Scan_failure s | Failure s ->
+    let i = Scanning.char_count ib in
+    bad_input (Printf.sprintf "scanf: bad input at char number %i: %s" i s)
+  | x -> raise x
+
+
+(* Get the content of a counter from an input buffer. *)
+let get_counter ib counter =
+  match counter with
+  | Line_counter -> Scanning.line_count ib
+  | Char_counter -> Scanning.char_count ib
+  | Token_counter -> Scanning.token_count ib
+
+
+(* Compute the width of a padding option (see "%42{" and "%123("). *)
+let width_of_pad_opt pad_opt = match pad_opt with
+  | None -> max_int
+  | Some width -> width
+
+
+let stopper_of_formatting_lit fmting =
+  if fmting = Escaped_percent then '%', "" else
+    let str = string_of_formatting_lit fmting in
+    let stp = str.[1] in
+    let sub_str = String.sub str 2 (String.length str - 2) in
+    stp, sub_str
+
+
+(******************************************************************************)
+                           (* Reader management *)
+
+(* A call to take_format_readers on a format is evaluated into functions
+   taking readers as arguments and aggregate them into an heterogeneous list *)
+(* When all readers are taken, finally pass the list of the readers to the
+   continuation k. *)
+let rec take_format_readers : type a c d e f .
+    ((d, e) heter_list -> e) -> (a, Scanning.in_channel, c, d, e, f) fmt ->
+    d =
+fun k fmt -> match fmt with
+  | Reader fmt_rest ->
+    fun reader ->
+      let new_k readers_rest = k (Cons (reader, readers_rest)) in
+      take_format_readers new_k fmt_rest
+  | Char rest                        -> take_format_readers k rest
+  | Caml_char rest                   -> take_format_readers k rest
+  | String (_, rest)                 -> take_format_readers k rest
+  | Caml_string (_, rest)            -> take_format_readers k rest
+  | Int (_, _, _, rest)              -> take_format_readers k rest
+  | Int32 (_, _, _, rest)            -> take_format_readers k rest
+  | Nativeint (_, _, _, rest)        -> take_format_readers k rest
+  | Int64 (_, _, _, rest)            -> take_format_readers k rest
+  | Float (_, _, _, rest)            -> take_format_readers k rest
+  | Bool (_, rest)                   -> take_format_readers k rest
+  | Alpha rest                       -> take_format_readers k rest
+  | Theta rest                       -> take_format_readers k rest
+  | Flush rest                       -> take_format_readers k rest
+  | String_literal (_, rest)         -> take_format_readers k rest
+  | Char_literal (_, rest)           -> take_format_readers k rest
+  | Custom (_, _, rest)              -> take_format_readers k rest
+
+  | Scan_char_set (_, _, rest)       -> take_format_readers k rest
+  | Scan_get_counter (_, rest)       -> take_format_readers k rest
+  | Scan_next_char rest              -> take_format_readers k rest
+
+  | Formatting_lit (_, rest)         -> take_format_readers k rest
+  | Formatting_gen (Open_tag (Format (fmt, _)), rest) ->
+      take_format_readers k (concat_fmt fmt rest)
+  | Formatting_gen (Open_box (Format (fmt, _)), rest) ->
+      take_format_readers k (concat_fmt fmt rest)
+
+  | Format_arg (_, _, rest)          -> take_format_readers k rest
+  | Format_subst (_, fmtty, rest)    ->
+     take_fmtty_format_readers k (erase_rel (symm fmtty)) rest
+  | Ignored_param (ign, rest)        -> take_ignored_format_readers k ign rest
+
+  | End_of_format                    -> k Nil
+
+(* Take readers associated to an fmtty coming from a Format_subst "%(...%)". *)
+and take_fmtty_format_readers : type x y a c d e f .
+    ((d, e) heter_list -> e) -> (a, Scanning.in_channel, c, d, x, y) fmtty ->
+      (y, Scanning.in_channel, c, x, e, f) fmt -> d =
+fun k fmtty fmt -> match fmtty with
+  | Reader_ty fmt_rest ->
+    fun reader ->
+      let new_k readers_rest = k (Cons (reader, readers_rest)) in
+      take_fmtty_format_readers new_k fmt_rest fmt
+  | Ignored_reader_ty fmt_rest ->
+    fun reader ->
+      let new_k readers_rest = k (Cons (reader, readers_rest)) in
+      take_fmtty_format_readers new_k fmt_rest fmt
+  | Char_ty rest                -> take_fmtty_format_readers k rest fmt
+  | String_ty rest              -> take_fmtty_format_readers k rest fmt
+  | Int_ty rest                 -> take_fmtty_format_readers k rest fmt
+  | Int32_ty rest               -> take_fmtty_format_readers k rest fmt
+  | Nativeint_ty rest           -> take_fmtty_format_readers k rest fmt
+  | Int64_ty rest               -> take_fmtty_format_readers k rest fmt
+  | Float_ty rest               -> take_fmtty_format_readers k rest fmt
+  | Bool_ty rest                -> take_fmtty_format_readers k rest fmt
+  | Alpha_ty rest               -> take_fmtty_format_readers k rest fmt
+  | Theta_ty rest               -> take_fmtty_format_readers k rest fmt
+  | Any_ty rest                 -> take_fmtty_format_readers k rest fmt
+  | Format_arg_ty (_, rest)     -> take_fmtty_format_readers k rest fmt
+  | End_of_fmtty                -> take_format_readers k fmt
+  | Format_subst_ty (ty1, ty2, rest) ->
+    let ty = trans (symm ty1) ty2 in
+    take_fmtty_format_readers k (concat_fmtty ty rest) fmt
+
+(* Take readers associated to an ignored parameter. *)
+and take_ignored_format_readers : type x y a c d e f .
+    ((d, e) heter_list -> e) -> (a, Scanning.in_channel, c, d, x, y) ignored ->
+      (y, Scanning.in_channel, c, x, e, f) fmt -> d =
+fun k ign fmt -> match ign with
+  | Ignored_reader ->
+    fun reader ->
+      let new_k readers_rest = k (Cons (reader, readers_rest)) in
+      take_format_readers new_k fmt
+  | Ignored_char                    -> take_format_readers k fmt
+  | Ignored_caml_char               -> take_format_readers k fmt
+  | Ignored_string _                -> take_format_readers k fmt
+  | Ignored_caml_string _           -> take_format_readers k fmt
+  | Ignored_int (_, _)              -> take_format_readers k fmt
+  | Ignored_int32 (_, _)            -> take_format_readers k fmt
+  | Ignored_nativeint (_, _)        -> take_format_readers k fmt
+  | Ignored_int64 (_, _)            -> take_format_readers k fmt
+  | Ignored_float (_, _)            -> take_format_readers k fmt
+  | Ignored_bool _                  -> take_format_readers k fmt
+  | Ignored_format_arg _            -> take_format_readers k fmt
+  | Ignored_format_subst (_, fmtty) -> take_fmtty_format_readers k fmtty fmt
+  | Ignored_scan_char_set _         -> take_format_readers k fmt
+  | Ignored_scan_get_counter _      -> take_format_readers k fmt
+  | Ignored_scan_next_char          -> take_format_readers k fmt
+
+(******************************************************************************)
+                          (* Generic scanning *)
+
+(* Make a generic scanning function. *)
+(* Scan a stream according to a format and readers obtained by
+   take_format_readers, and aggregate scanned values into an
+   heterogeneous list. *)
+(* Return the heterogeneous list of scanned values. *)
+let rec make_scanf : type a c d e f.
+    Scanning.in_channel -> (a, Scanning.in_channel, c, d, e, f) fmt ->
+      (d, e) heter_list -> (a, f) heter_list =
+fun ib fmt readers -> match fmt with
+  | Char rest ->
+    let _ = scan_char 0 ib in
+    let c = token_char ib in
+    Cons (c, make_scanf ib rest readers)
+  | Caml_char rest ->
+    let _ = scan_caml_char 0 ib in
+    let c = token_char ib in
+    Cons (c, make_scanf ib rest readers)
+
+  | String (pad, Formatting_lit (fmting_lit, rest)) ->
+    let stp, str = stopper_of_formatting_lit fmting_lit in
+    let scan width _ ib = scan_string (Some stp) width ib in
+    let str_rest = String_literal (str, rest) in
+    pad_prec_scanf ib str_rest readers pad No_precision scan token_string
+  | String (pad, Formatting_gen (Open_tag (Format (fmt', _)), rest)) ->
+    let scan width _ ib = scan_string (Some '{') width ib in
+    pad_prec_scanf ib (concat_fmt fmt' rest) readers pad No_precision scan
+                   token_string
+  | String (pad, Formatting_gen (Open_box (Format (fmt', _)), rest)) ->
+    let scan width _ ib = scan_string (Some '[') width ib in
+    pad_prec_scanf ib (concat_fmt fmt' rest) readers pad No_precision scan
+                   token_string
+  | String (pad, rest) ->
+    let scan width _ ib = scan_string None width ib in
+    pad_prec_scanf ib rest readers pad No_precision scan token_string
+
+  | Caml_string (pad, rest) ->
+    let scan width _ ib = scan_caml_string width ib in
+    pad_prec_scanf ib rest readers pad No_precision scan token_string
+  | Int (iconv, pad, prec, rest) ->
+    let c = integer_conversion_of_char (char_of_iconv iconv) in
+    let scan width _ ib = scan_int_conversion c width ib in
+    pad_prec_scanf ib rest readers pad prec scan (token_int c)
+  | Int32 (iconv, pad, prec, rest) ->
+    let c = integer_conversion_of_char (char_of_iconv iconv) in
+    let scan width _ ib = scan_int_conversion c width ib in
+    pad_prec_scanf ib rest readers pad prec scan (token_int32 c)
+  | Nativeint (iconv, pad, prec, rest) ->
+    let c = integer_conversion_of_char (char_of_iconv iconv) in
+    let scan width _ ib = scan_int_conversion c width ib in
+    pad_prec_scanf ib rest readers pad prec scan (token_nativeint c)
+  | Int64 (iconv, pad, prec, rest) ->
+    let c = integer_conversion_of_char (char_of_iconv iconv) in
+    let scan width _ ib = scan_int_conversion c width ib in
+    pad_prec_scanf ib rest readers pad prec scan (token_int64 c)
+  | Float ((_, (Float_F | Float_CF)), pad, prec, rest) ->
+    pad_prec_scanf ib rest readers pad prec scan_caml_float token_float
+  | Float ((_, (Float_f | Float_e | Float_E | Float_g | Float_G)),
+           pad, prec, rest) ->
+    pad_prec_scanf ib rest readers pad prec scan_float token_float
+  | Float ((_, (Float_h | Float_H)), pad, prec, rest) ->
+    pad_prec_scanf ib rest readers pad prec scan_hex_float token_float
+  | Bool (pad, rest) ->
+    let scan _ _ ib = scan_bool ib in
+    pad_prec_scanf ib rest readers pad No_precision scan token_bool
+  | Alpha _ ->
+    invalid_arg "scanf: bad conversion \"%a\""
+  | Theta _ ->
+    invalid_arg "scanf: bad conversion \"%t\""
+  | Custom _ ->
+    invalid_arg "scanf: bad conversion \"%?\" (custom converter)"
+  | Reader fmt_rest ->
+    begin match readers with
+    | Cons (reader, readers_rest) ->
+        let x = reader ib in
+        Cons (x, make_scanf ib fmt_rest readers_rest)
+    | Nil ->
+        invalid_arg "scanf: missing reader"
+    end
+  | Flush rest ->
+    if Scanning.end_of_input ib then make_scanf ib rest readers
+    else bad_input "end of input not found"
+
+  | String_literal (str, rest) ->
+    String.iter (check_char ib) str;
+    make_scanf ib rest readers
+  | Char_literal (chr, rest) ->
+    check_char ib chr;
+    make_scanf ib rest readers
+
+  | Format_arg (pad_opt, fmtty, rest) ->
+    let _ = scan_caml_string (width_of_pad_opt pad_opt) ib in
+    let s = token_string ib in
+    let fmt =
+      try format_of_string_fmtty s fmtty
+      with Failure msg -> bad_input msg
+    in
+    Cons (fmt, make_scanf ib rest readers)
+  | Format_subst (pad_opt, fmtty, rest) ->
+    let _ = scan_caml_string (width_of_pad_opt pad_opt) ib in
+    let s = token_string ib in
+    let fmt, fmt' =
+      try
+        let Fmt_EBB fmt = fmt_ebb_of_string s in
+        let Fmt_EBB fmt' = fmt_ebb_of_string s in
+        (* TODO: find a way to avoid reparsing twice *)
+
+        (* TODO: these type-checks below *can* fail because of type
+           ambiguity in presence of ignored-readers: "%_r%d" and "%d%_r"
+           are typed in the same way.
+
+           # Scanf.sscanf "\"%_r%d\"3" "%(%d%_r%)" ignore
+             (fun fmt n -> string_of_format fmt, n)
+           Exception: CamlinternalFormat.Type_mismatch.
+
+           We should properly catch this exception.
+        *)
+        type_format fmt (erase_rel fmtty),
+        type_format fmt' (erase_rel (symm fmtty))
+      with Failure msg -> bad_input msg
+    in
+    Cons (Format (fmt, s),
+          make_scanf ib (concat_fmt fmt' rest) readers)
+
+  | Scan_char_set (width_opt, char_set, Formatting_lit (fmting_lit, rest)) ->
+    let stp, str = stopper_of_formatting_lit fmting_lit in
+    let width = width_of_pad_opt width_opt in
+    scan_chars_in_char_set char_set (Some stp) width ib;
+    let s = token_string ib in
+    let str_rest = String_literal (str, rest) in
+    Cons (s, make_scanf ib str_rest readers)
+  | Scan_char_set (width_opt, char_set, rest) ->
+    let width = width_of_pad_opt width_opt in
+    scan_chars_in_char_set char_set None width ib;
+    let s = token_string ib in
+    Cons (s, make_scanf ib rest readers)
+  | Scan_get_counter (counter, rest) ->
+    let count = get_counter ib counter in
+    Cons (count, make_scanf ib rest readers)
+  | Scan_next_char rest ->
+    let c = Scanning.checked_peek_char ib in
+    Cons (c, make_scanf ib rest readers)
+
+  | Formatting_lit (formatting_lit, rest) ->
+    String.iter (check_char ib) (string_of_formatting_lit formatting_lit);
+    make_scanf ib rest readers
+  | Formatting_gen (Open_tag (Format (fmt', _)), rest) ->
+    check_char ib '@'; check_char ib '{';
+    make_scanf ib (concat_fmt fmt' rest) readers
+  | Formatting_gen (Open_box (Format (fmt', _)), rest) ->
+    check_char ib '@'; check_char ib '[';
+    make_scanf ib (concat_fmt fmt' rest) readers
+
+  | Ignored_param (ign, rest) ->
+    let Param_format_EBB fmt' = param_format_of_ignored_format ign rest in
+    begin match make_scanf ib fmt' readers with
+    | Cons (_, arg_rest) -> arg_rest
+    | Nil -> assert false
+    end
+
+  | End_of_format ->
+    Nil
+
+(* Case analysis on padding and precision. *)
+(* Reject formats containing "%*" or "%.*". *)
+(* Pass padding and precision to the generic scanner `scan'. *)
+and pad_prec_scanf : type a c d e f x y z t .
+    Scanning.in_channel -> (a, Scanning.in_channel, c, d, e, f) fmt ->
+      (d, e) heter_list -> (x, y) padding -> (y, z -> a) precision ->
+      (int -> int -> Scanning.in_channel -> t) ->
+      (Scanning.in_channel -> z) ->
+      (x, f) heter_list =
+fun ib fmt readers pad prec scan token -> match pad, prec with
+  | No_padding, No_precision ->
+    let _ = scan max_int max_int ib in
+    let x = token ib in
+    Cons (x, make_scanf ib fmt readers)
+  | No_padding, Lit_precision p ->
+    let _ = scan max_int p ib in
+    let x = token ib in
+    Cons (x, make_scanf ib fmt readers)
+  | Lit_padding ((Right | Zeros), w), No_precision ->
+    let _ = scan w max_int ib in
+    let x = token ib in
+    Cons (x, make_scanf ib fmt readers)
+  | Lit_padding ((Right | Zeros), w), Lit_precision p ->
+    let _ = scan w p ib in
+    let x = token ib in
+    Cons (x, make_scanf ib fmt readers)
+  | Lit_padding (Left, _), _ ->
+    invalid_arg "scanf: bad conversion \"%-\""
+  | Lit_padding ((Right | Zeros), _), Arg_precision ->
+    invalid_arg "scanf: bad conversion \"%*\""
+  | Arg_padding _, _ ->
+    invalid_arg "scanf: bad conversion \"%*\""
+  | No_padding, Arg_precision ->
+    invalid_arg "scanf: bad conversion \"%*\""
+
+(******************************************************************************)
+            (* Defining [scanf] and various flavors of [scanf] *)
+
+type 'a kscanf_result = Args of 'a | Exc of exn
+
+let kscanf ib ef (Format (fmt, str)) =
+  let rec apply : type a b . a -> (a, b) heter_list -> b =
+    fun f args -> match args with
+    | Cons (x, r) -> apply (f x) r
+    | Nil -> f
+  in
+  let k readers f =
+    Scanning.reset_token ib;
+    match try Args (make_scanf ib fmt readers) with
+      | (Scan_failure _ | Failure _ | End_of_file) as exc -> Exc exc
+      | Invalid_argument msg ->
+        invalid_arg (msg ^ " in format \"" ^ String.escaped str ^ "\"")
+    with
+      | Args args -> apply f args
+      | Exc exc -> ef ib exc
+  in
+  take_format_readers k fmt
+
+(***)
+
+let kbscanf = kscanf
+let bscanf ib fmt = kbscanf ib scanf_bad_input fmt
+
+let ksscanf s ef fmt = kbscanf (Scanning.from_string s) ef fmt
+let sscanf s fmt = kbscanf (Scanning.from_string s) scanf_bad_input fmt
+
+let scanf fmt = kscanf Scanning.stdib scanf_bad_input fmt
+
+(***)
+
+(* Scanning format strings. *)
+let bscanf_format :
+  Scanning.in_channel -> ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+  (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g =
+  fun ib format f ->
+    let _ = scan_caml_string max_int ib in
+    let str = token_string ib in
+    let fmt' =
+      try format_of_string_format str format
+      with Failure msg -> bad_input msg in
+    f fmt'
+
+
+let sscanf_format :
+  string -> ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+  (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g =
+  fun s format f -> bscanf_format (Scanning.from_string s) format f
+
+
+let format_from_string s fmt =
+  sscanf_format ("\"" ^ String.escaped s ^ "\"") fmt (fun x -> x)
+
+
+let unescaped s =
+  sscanf ("\"" ^ s ^ "\"") "%S%!" (fun x -> x)
+
+
+(* Deprecated *)
+let kfscanf ic ef fmt = kbscanf (Scanning.memo_from_channel ic) ef fmt
+let fscanf ic fmt = kscanf (Scanning.memo_from_channel ic) scanf_bad_input fmt
diff --git a/stdlib/scanf.mli b/stdlib/scanf.mli
new file mode 100644
index 00000000..865ca8d1
--- /dev/null
+++ b/stdlib/scanf.mli
@@ -0,0 +1,559 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Pierre Weis, projet Cristal, INRIA Rocquencourt            *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Formatted input functions. *)
+
+(** {1 Introduction} *)
+
+(** {2 Functional input with format strings} *)
+
+(** The module {!Scanf} provides formatted input functions or {e scanners}.
+
+    The formatted input functions can read from any kind of input, including
+    strings, files, or anything that can return characters. The more general
+    source of characters is named a {e formatted input channel} (or {e
+    scanning buffer}) and has type {!Scanning.in_channel}. The more general
+    formatted input function reads from any scanning buffer and is named
+    [bscanf].
+
+    Generally speaking, the formatted input functions have 3 arguments:
+    - the first argument is a source of characters for the input,
+    - the second argument is a format string that specifies the values to
+      read,
+    - the third argument is a {e receiver function} that is applied to the
+      values read.
+
+    Hence, a typical call to the formatted input function {!Scanf.bscanf} is
+    [bscanf ic fmt f], where:
+
+    - [ic] is a source of characters (typically a {e
+    formatted input channel} with type {!Scanning.in_channel}),
+
+    - [fmt] is a format string (the same format strings as those used to print
+    material with module {!Printf} or {!Format}),
+
+    - [f] is a function that has as many arguments as the number of values to
+    read in the input according to [fmt].
+*)
+
+(** {2 A simple example} *)
+
+(** As suggested above, the expression [bscanf ic "%d" f] reads a decimal
+    integer [n] from the source of characters [ic] and returns [f n].
+
+    For instance,
+
+    - if we use [stdin] as the source of characters ({!Scanning.stdin} is
+    the predefined formatted input channel that reads from standard input),
+
+    - if we define the receiver [f] as [let f x = x + 1],
+
+    then [bscanf Scanning.stdin "%d" f] reads an integer [n] from the
+    standard input and returns [f n] (that is [n + 1]). Thus, if we
+    evaluate [bscanf stdin "%d" f], and then enter [41] at the
+    keyboard, the result we get is [42].
+*)
+
+(** {2 Formatted input as a functional feature} *)
+
+(** The OCaml scanning facility is reminiscent of the corresponding C feature.
+    However, it is also largely different, simpler, and yet more powerful:
+    the formatted input functions are higher-order functionals and the
+    parameter passing mechanism is just the regular function application not
+    the variable assignment based mechanism which is typical for formatted
+    input in imperative languages; the OCaml format strings also feature
+    useful additions to easily define complex tokens; as expected within a
+    functional programming language, the formatted input functions also
+    support polymorphism, in particular arbitrary interaction with
+    polymorphic user-defined scanners. Furthermore, the OCaml formatted input
+    facility is fully type-checked at compile time.
+*)
+
+(** {1 Formatted input channel} *)
+
+module Scanning : sig
+
+type in_channel
+(** The notion of input channel for the {!Scanf} module:
+   those channels provide all the machinery necessary to read from any source
+   of characters, including a {!Stdlib.in_channel} value.
+   A Scanf.Scanning.in_channel value is also called a {i formatted input
+   channel} or equivalently a {i scanning buffer}.
+   The type {!Scanning.scanbuf} below is an alias for [Scanning.in_channel].
+   @since 3.12.0
+*)
+
+type scanbuf = in_channel
+(** The type of scanning buffers. A scanning buffer is the source from which a
+    formatted input function gets characters. The scanning buffer holds the
+    current state of the scan, plus a function to get the next char from the
+    input, and a token buffer to store the string matched so far.
+
+    Note: a scanning action may often require to examine one character in
+    advance; when this 'lookahead' character does not belong to the token
+    read, it is stored back in the scanning buffer and becomes the next
+    character yet to be read.
+*)
+
+val stdin : in_channel
+(** The standard input notion for the {!Scanf} module.
+    [Scanning.stdin] is the {!Scanning.in_channel} formatted input channel
+    attached to {!Stdlib.stdin}.
+
+    Note: in the interactive system, when input is read from
+    {!Stdlib.stdin}, the newline character that triggers evaluation is
+    part of the input; thus, the scanning specifications must properly skip
+    this additional newline character (for instance, simply add a ['\n'] as
+    the last character of the format string).
+    @since 3.12.0
+*)
+
+type file_name = string
+(** A convenient alias to designate a file name.
+    @since 4.00.0
+*)
+
+val open_in : file_name -> in_channel
+(** [Scanning.open_in fname] returns a {!Scanning.in_channel} formatted input
+    channel for bufferized reading in text mode from file [fname].
+
+    Note:
+    [open_in] returns a formatted input channel that efficiently reads
+    characters in large chunks; in contrast, [from_channel] below returns
+    formatted input channels that must read one character at a time, leading
+    to a much slower scanning rate.
+    @since 3.12.0
+*)
+
+val open_in_bin : file_name -> in_channel
+(** [Scanning.open_in_bin fname] returns a {!Scanning.in_channel} formatted
+    input channel for bufferized reading in binary mode from file [fname].
+    @since 3.12.0
+*)
+
+val close_in : in_channel -> unit
+(** Closes the {!Stdlib.in_channel} associated with the given
+  {!Scanning.in_channel} formatted input channel.
+  @since 3.12.0
+*)
+
+val from_file : file_name -> in_channel
+(** An alias for {!Scanning.open_in} above. *)
+
+val from_file_bin : string -> in_channel
+(** An alias for {!Scanning.open_in_bin} above. *)
+
+val from_string : string -> in_channel
+(** [Scanning.from_string s] returns a {!Scanning.in_channel} formatted
+    input channel which reads from the given string.
+    Reading starts from the first character in the string.
+    The end-of-input condition is set when the end of the string is reached.
+*)
+
+val from_function : (unit -> char) -> in_channel
+(** [Scanning.from_function f] returns a {!Scanning.in_channel} formatted
+    input channel with the given function as its reading method.
+
+    When scanning needs one more character, the given function is called.
+
+    When the function has no more character to provide, it {e must} signal an
+    end-of-input condition by raising the exception [End_of_file].
+*)
+
+val from_channel : Stdlib.in_channel -> in_channel
+(** [Scanning.from_channel ic] returns a {!Scanning.in_channel} formatted
+    input channel which reads from the regular {!Stdlib.in_channel} input
+    channel [ic] argument.
+    Reading starts at current reading position of [ic].
+*)
+
+val end_of_input : in_channel -> bool
+(** [Scanning.end_of_input ic] tests the end-of-input condition of the given
+    {!Scanning.in_channel} formatted input channel.
+*)
+
+val beginning_of_input : in_channel -> bool
+(** [Scanning.beginning_of_input ic] tests the beginning of input condition
+    of the given {!Scanning.in_channel} formatted input channel.
+*)
+
+val name_of_input : in_channel -> string
+(** [Scanning.name_of_input ic] returns the name of the character source
+    for the given {!Scanning.in_channel} formatted input channel.
+    @since 3.09.0
+*)
+
+val stdib : in_channel
+  [@@ocaml.deprecated "Use Scanf.Scanning.stdin instead."]
+(** A deprecated alias for {!Scanning.stdin}, the scanning buffer reading from
+    {!Stdlib.stdin}.
+*)
+
+end
+
+(** {1 Type of formatted input functions} *)
+
+type ('a, 'b, 'c, 'd) scanner =
+     ('a, Scanning.in_channel, 'b, 'c, 'a -> 'd, 'd) format6 -> 'c
+(** The type of formatted input scanners: [('a, 'b, 'c, 'd) scanner]
+    is the type of a formatted input function that reads from some
+    formatted input channel according to some format string; more
+    precisely, if [scan] is some formatted input function, then [scan
+    ic fmt f] applies [f] to all the arguments specified by format
+    string [fmt], when [scan] has read those arguments from the
+    {!Scanning.in_channel} formatted input channel [ic].
+
+    For instance, the {!Scanf.scanf} function below has type
+    [('a, 'b, 'c, 'd) scanner], since it is a formatted input function that
+    reads from {!Scanning.stdin}: [scanf fmt f] applies [f] to the arguments
+    specified by [fmt], reading those arguments from {!Stdlib.stdin} as
+    expected.
+
+    If the format [fmt] has some [%r] indications, the corresponding
+    formatted input functions must be provided {e before} receiver function
+    [f]. For instance, if [read_elem] is an input function for values of type
+    [t], then [bscanf ic "%r;" read_elem f] reads a value [v] of type [t]
+    followed by a [';'] character, and returns [f v].
+    @since 3.10.0
+*)
+
+exception Scan_failure of string
+(** When the input can not be read according to the format string
+    specification, formatted input functions typically raise exception
+    [Scan_failure].
+*)
+
+(** {1 The general formatted input function} *)
+
+val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner
+
+(** [bscanf ic fmt r1 ... rN f] reads characters from the
+    {!Scanning.in_channel} formatted input channel [ic] and converts them to
+    values according to format string [fmt].
+    As a final step, receiver function [f] is applied to the values read and
+    gives the result of the [bscanf] call.
+
+    For instance, if [f] is the function [fun s i -> i + 1], then
+    [Scanf.sscanf "x= 1" "%s = %i" f] returns [2].
+
+    Arguments [r1] to [rN] are user-defined input functions that read the
+    argument corresponding to the [%r] conversions specified in the format
+    string.
+*)
+
+(** {1 Format string description} *)
+
+(** The format string is a character string which contains three types of
+    objects:
+    - plain characters, which are simply matched with the characters of the
+      input (with a special case for space and line feed, see {!Scanf.space}),
+    - conversion specifications, each of which causes reading and conversion of
+      one argument for the function [f] (see {!Scanf.conversion}),
+    - scanning indications to specify boundaries of tokens
+      (see scanning {!Scanf.indication}).
+*)
+
+(** {2:space The space character in format strings} *)
+
+(** As mentioned above, a plain character in the format string is just
+    matched with the next character of the input; however, two characters are
+    special exceptions to this rule: the space character ([' '] or ASCII code
+    32) and the line feed character (['\n'] or ASCII code 10).
+    A space does not match a single space character, but any amount of
+    'whitespace' in the input. More precisely, a space inside the format
+    string matches {e any number} of tab, space, line feed and carriage
+    return characters. Similarly, a line feed character in the format string
+    matches either a single line feed or a carriage return followed by a line
+    feed.
+
+    Matching {e any} amount of whitespace, a space in the format string
+    also matches no amount of whitespace at all; hence, the call [bscanf ib
+    "Price = %d $" (fun p -> p)] succeeds and returns [1] when reading an
+    input with various whitespace in it, such as [Price = 1 $],
+    [Price  =  1    $], or even [Price=1$].
+*)
+
+(** {2:conversion Conversion specifications in format strings} *)
+
+(** Conversion specifications consist in the [%] character, followed by
+    an optional flag, an optional field width, and followed by one or
+    two conversion characters.
+
+    The conversion characters and their meanings are:
+
+    - [d]: reads an optionally signed decimal integer ([0-9]+).
+    - [i]: reads an optionally signed integer
+      (usual input conventions for decimal ([0-9]+), hexadecimal
+       ([0x[0-9a-f]+] and [0X[0-9A-F]+]), octal ([0o[0-7]+]), and binary
+       ([0b[0-1]+]) notations are understood).
+    - [u]: reads an unsigned decimal integer.
+    - [x] or [X]: reads an unsigned hexadecimal integer ([[0-9a-fA-F]+]).
+    - [o]: reads an unsigned octal integer ([[0-7]+]).
+    - [s]: reads a string argument that spreads as much as possible, until the
+      following bounding condition holds: {ul
+      {- a whitespace has been found (see {!Scanf.space}),}
+      {- a scanning indication (see scanning {!Scanf.indication}) has been
+         encountered,}
+      {- the end-of-input has been reached.}}
+      Hence, this conversion always succeeds: it returns an empty
+      string if the bounding condition holds when the scan begins.
+    - [S]: reads a delimited string argument (delimiters and special
+      escaped characters follow the lexical conventions of OCaml).
+    - [c]: reads a single character. To test the current input character
+      without reading it, specify a null field width, i.e. use
+      specification [%0c]. Raise [Invalid_argument], if the field width
+      specification is greater than 1.
+    - [C]: reads a single delimited character (delimiters and special
+      escaped characters follow the lexical conventions of OCaml).
+    - [f], [e], [E], [g], [G]: reads an optionally signed
+      floating-point number in decimal notation, in the style [dddd.ddd
+      e/E+-dd].
+    - [h], [H]: reads an optionally signed floating-point number
+      in hexadecimal notation.
+    - [F]: reads a floating point number according to the lexical
+      conventions of OCaml (hence the decimal point is mandatory if the
+      exponent part is not mentioned).
+    - [B]: reads a boolean argument ([true] or [false]).
+    - [b]: reads a boolean argument (for backward compatibility; do not use
+      in new programs).
+    - [ld], [li], [lu], [lx], [lX], [lo]: reads an [int32] argument to
+      the format specified by the second letter for regular integers.
+    - [nd], [ni], [nu], [nx], [nX], [no]: reads a [nativeint] argument to
+      the format specified by the second letter for regular integers.
+    - [Ld], [Li], [Lu], [Lx], [LX], [Lo]: reads an [int64] argument to
+      the format specified by the second letter for regular integers.
+    - [[ range ]]: reads characters that matches one of the characters
+      mentioned in the range of characters [range] (or not mentioned in
+      it, if the range starts with [^]). Reads a [string] that can be
+      empty, if the next input character does not match the range. The set of
+      characters from [c1] to [c2] (inclusively) is denoted by [c1-c2].
+      Hence, [%[0-9]] returns a string representing a decimal number
+      or an empty string if no decimal digit is found; similarly,
+      [%[0-9a-f]] returns a string of hexadecimal digits.
+      If a closing bracket appears in a range, it must occur as the
+      first character of the range (or just after the [^] in case of
+      range negation); hence [[\]]] matches a [\]] character and
+      [[^\]]] matches any character that is not [\]].
+      Use [%%] and [%@] to include a [%] or a [@] in a range.
+    - [r]: user-defined reader. Takes the next [ri] formatted input
+      function and applies it to the scanning buffer [ib] to read the
+      next argument. The input function [ri] must therefore have type
+      [Scanning.in_channel -> 'a] and the argument read has type ['a].
+    - [{ fmt %}]: reads a format string argument. The format string
+      read must have the same type as the format string specification
+      [fmt]. For instance, ["%{ %i %}"] reads any format string that
+      can read a value of type [int]; hence, if [s] is the string
+      ["fmt:\"number is %u\""], then [Scanf.sscanf s "fmt: %{%i%}"]
+      succeeds and returns the format string ["number is %u"].
+    - [( fmt %)]: scanning sub-format substitution.
+      Reads a format string [rf] in the input, then goes on scanning with
+      [rf] instead of scanning with [fmt].
+      The format string [rf] must have the same type as the format string
+      specification [fmt] that it replaces.
+      For instance, ["%( %i %)"] reads any format string that can read a value
+      of type [int].
+      The conversion returns the format string read [rf], and then a value
+      read using [rf].
+      Hence, if [s] is the string ["\"%4d\"1234.00"], then
+      [Scanf.sscanf s "%(%i%)" (fun fmt i -> fmt, i)] evaluates to
+      [("%4d", 1234)].
+      This behaviour is not mere format substitution, since the conversion
+      returns the format string read as additional argument. If you need
+      pure format substitution, use special flag [_] to discard the
+      extraneous argument: conversion [%_( fmt %)] reads a format string
+      [rf] and then behaves the same as format string [rf].  Hence, if [s] is
+      the string ["\"%4d\"1234.00"], then [Scanf.sscanf s "%_(%i%)"] is
+      simply equivalent to [Scanf.sscanf "1234.00" "%4d"].
+    - [l]: returns the number of lines read so far.
+    - [n]: returns the number of characters read so far.
+    - [N] or [L]: returns the number of tokens read so far.
+    - [!]: matches the end of input condition.
+    - [%]: matches one [%] character in the input.
+    - [@]: matches one [@] character in the input.
+    - [,]: does nothing.
+
+    Following the [%] character that introduces a conversion, there may be
+    the special flag [_]: the conversion that follows occurs as usual,
+    but the resulting value is discarded.
+    For instance, if [f] is the function [fun i -> i + 1], and [s] is the
+    string ["x = 1"], then [Scanf.sscanf s "%_s = %i" f] returns [2].
+
+    The field width is composed of an optional integer literal
+    indicating the maximal width of the token to read.
+    For instance, [%6d] reads an integer, having at most 6 decimal digits;
+    [%4f] reads a float with at most 4 characters; and [%8[\000-\255]]
+    returns the next 8 characters (or all the characters still available,
+    if fewer than 8 characters are available in the input).
+
+    Notes:
+
+    - as mentioned above, a [%s] conversion always succeeds, even if there is
+      nothing to read in the input: in this case, it simply returns [""].
+
+    - in addition to the relevant digits, ['_'] characters may appear
+    inside numbers (this is reminiscent to the usual OCaml lexical
+    conventions). If stricter scanning is desired, use the range
+    conversion facility instead of the number conversions.
+
+    - the [scanf] facility is not intended for heavy duty lexical
+    analysis and parsing. If it appears not expressive enough for your
+    needs, several alternative exists: regular expressions (module
+    {!Str}), stream parsers, [ocamllex]-generated lexers,
+    [ocamlyacc]-generated parsers.
+*)
+
+(** {2:indication Scanning indications in format strings} *)
+
+(** Scanning indications appear just after the string conversions [%s]
+    and [%[ range ]] to delimit the end of the token. A scanning
+    indication is introduced by a [@] character, followed by some
+    plain character [c]. It means that the string token should end
+    just before the next matching [c] (which is skipped). If no [c]
+    character is encountered, the string token spreads as much as
+    possible. For instance, ["%s@\t"] reads a string up to the next
+    tab character or to the end of input. If a [@] character appears
+    anywhere else in the format string, it is treated as a plain character.
+
+    Note:
+
+    - As usual in format strings, [%] and [@] characters must be escaped
+    using [%%] and [%@]; this rule still holds within range specifications
+    and scanning indications.
+    For instance, format ["%s@%%"] reads a string up to the next [%]
+    character, and format ["%s@%@"] reads a string up to the next [@].
+    - The scanning indications introduce slight differences in the syntax of
+    {!Scanf} format strings, compared to those used for the {!Printf}
+    module. However, the scanning indications are similar to those used in
+    the {!Format} module; hence, when producing formatted text to be scanned
+    by {!Scanf.bscanf}, it is wise to use printing functions from the
+    {!Format} module (or, if you need to use functions from {!Printf}, banish
+    or carefully double check the format strings that contain ['@']
+    characters).
+*)
+
+(** {2 Exceptions during scanning} *)
+
+(** Scanners may raise the following exceptions when the input cannot be read
+    according to the format string:
+
+    - Raise {!Scanf.Scan_failure} if the input does not match the format.
+
+    - Raise [Failure] if a conversion to a number is not possible.
+
+    - Raise [End_of_file] if the end of input is encountered while some more
+      characters are needed to read the current conversion specification.
+
+    - Raise [Invalid_argument] if the format string is invalid.
+
+    Note:
+
+    - as a consequence, scanning a [%s] conversion never raises exception
+    [End_of_file]: if the end of input is reached the conversion succeeds and
+    simply returns the characters read so far, or [""] if none were ever read.
+*)
+
+(** {1 Specialised formatted input functions} *)
+
+val sscanf : string -> ('a, 'b, 'c, 'd) scanner
+(** Same as {!Scanf.bscanf}, but reads from the given string. *)
+
+val scanf : ('a, 'b, 'c, 'd) scanner
+(** Same as {!Scanf.bscanf}, but reads from the predefined formatted input
+    channel {!Scanf.Scanning.stdin} that is connected to {!Stdlib.stdin}.
+*)
+
+val kscanf :
+  Scanning.in_channel -> (Scanning.in_channel -> exn -> 'd) ->
+    ('a, 'b, 'c, 'd) scanner
+(** Same as {!Scanf.bscanf}, but takes an additional function argument
+    [ef] that is called in case of error: if the scanning process or
+    some conversion fails, the scanning function aborts and calls the
+    error handling function [ef] with the formatted input channel and the
+    exception that aborted the scanning process as arguments.
+*)
+
+val ksscanf :
+  string -> (Scanning.in_channel -> exn -> 'd) ->
+    ('a, 'b, 'c, 'd) scanner
+(** Same as {!Scanf.kscanf} but reads from the given string.
+    @since 4.02.0 *)
+
+(** {1 Reading format strings from input} *)
+
+val bscanf_format :
+  Scanning.in_channel -> ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+    (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g
+(** [bscanf_format ic fmt f] reads a format string token from the formatted
+    input channel [ic], according to the given format string [fmt], and
+    applies [f] to the resulting format string value.
+    @raise Scan_failure if the format string value read does not have the
+    same type as [fmt].
+    @since 3.09.0
+*)
+
+val sscanf_format :
+  string -> ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+    (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g
+(** Same as {!Scanf.bscanf_format}, but reads from the given string.
+    @since 3.09.0
+*)
+
+val format_from_string :
+  string ->
+    ('a, 'b, 'c, 'd, 'e, 'f) format6 -> ('a, 'b, 'c, 'd, 'e, 'f) format6
+(** [format_from_string s fmt] converts a string argument to a format string,
+    according to the given format string [fmt].
+    @raise Scan_failure if [s], considered as a format string, does not
+    have the same type as [fmt].
+    @since 3.10.0
+*)
+
+val unescaped : string -> string
+(** [unescaped s] return a copy of [s] with escape sequences (according to
+    the lexical conventions of OCaml) replaced by their corresponding special
+    characters.
+    More precisely, [Scanf.unescaped] has the following property:
+    for all string [s], [Scanf.unescaped (String.escaped s) = s].
+
+    Always return a copy of the argument, even if there is no escape sequence
+    in the argument.
+    @raise Scan_failure if [s] is not properly escaped (i.e. [s] has invalid
+    escape sequences or special characters that are not properly escaped).
+    For instance, [Scanf.unescaped "\""] will fail.
+    @since 4.00.0
+*)
+
+(** {1 Deprecated} *)
+
+val fscanf : Stdlib.in_channel -> ('a, 'b, 'c, 'd) scanner
+  [@@ocaml.deprecated "Use Scanning.from_channel then Scanf.bscanf."]
+(** @deprecated [Scanf.fscanf] is error prone and deprecated since 4.03.0.
+
+    This function violates the following invariant of the {!Scanf} module:
+    To preserve scanning semantics, all scanning functions defined in {!Scanf}
+    must read from a user defined {!Scanning.in_channel} formatted input
+    channel.
+
+    If you need to read from a {!Stdlib.in_channel} input channel
+    [ic], simply define a {!Scanning.in_channel} formatted input channel as in
+    [let ib = Scanning.from_channel ic],
+    then use [Scanf.bscanf ib] as usual.
+*)
+
+val kfscanf :
+  Stdlib.in_channel -> (Scanning.in_channel -> exn -> 'd) ->
+    ('a, 'b, 'c, 'd) scanner
+  [@@ocaml.deprecated "Use Scanning.from_channel then Scanf.kscanf."]
+(** @deprecated [Scanf.kfscanf] is error prone and deprecated since 4.03.0. *)
diff --git a/stdlib/seq.ml b/stdlib/seq.ml
new file mode 100644
index 00000000..88ac7935
--- /dev/null
+++ b/stdlib/seq.ml
@@ -0,0 +1,85 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                 Simon Cruanes                                          *)
+(*                                                                        *)
+(*   Copyright 2017 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 [Seq]: functional iterators *)
+
+type +'a node =
+  | Nil
+  | Cons of 'a * 'a t
+
+and 'a t = unit -> 'a node
+
+let empty () = Nil
+
+let return x () = Cons (x, empty)
+
+let cons x next () = Cons (x, next)
+
+let rec append seq1 seq2 () =
+  match seq1() with
+  | Nil -> seq2()
+  | Cons (x, next) -> Cons (x, append next seq2)
+
+let rec map f seq () = match seq() with
+  | Nil -> Nil
+  | Cons (x, next) -> Cons (f x, map f next)
+
+let rec filter_map f seq () = match seq() with
+  | Nil -> Nil
+  | Cons (x, next) ->
+      match f x with
+        | None -> filter_map f next ()
+        | Some y -> Cons (y, filter_map f next)
+
+let rec filter f seq () = match seq() with
+  | Nil -> Nil
+  | Cons (x, next) ->
+      if f x
+      then Cons (x, filter f next)
+      else filter f next ()
+
+let rec flat_map f seq () = match seq () with
+  | Nil -> Nil
+  | Cons (x, next) ->
+    flat_map_app f (f x) next ()
+
+(* this is [append seq (flat_map f tail)] *)
+and flat_map_app f seq tail () = match seq () with
+  | Nil -> flat_map f tail ()
+  | Cons (x, next) ->
+    Cons (x, flat_map_app f next tail)
+
+let fold_left f acc seq =
+  let rec aux f acc seq = match seq () with
+    | Nil -> acc
+    | Cons (x, next) ->
+        let acc = f acc x in
+        aux f acc next
+  in
+  aux f acc seq
+
+let iter f seq =
+  let rec aux seq = match seq () with
+    | Nil -> ()
+    | Cons (x, next) ->
+        f x;
+        aux next
+  in
+  aux seq
+
+let rec unfold f u () =
+  match f u with
+  | None -> Nil
+  | Some (x, u') -> Cons (x, unfold f u')
diff --git a/stdlib/seq.mli b/stdlib/seq.mli
new file mode 100644
index 00000000..8f730318
--- /dev/null
+++ b/stdlib/seq.mli
@@ -0,0 +1,99 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                 Simon Cruanes                                          *)
+(*                                                                        *)
+(*   Copyright 2017 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 [Seq]: functional iterators *)
+
+(** {1 Functional Iterators} *)
+
+(** The type ['a t] is a {b delayed list}, i.e. a list where some evaluation
+    is needed to access the next element. This makes it possible to build
+    infinite sequences, to build sequences as we traverse them, and to transform
+    them in a lazy fashion rather than upfront.
+*)
+
+(** @since 4.07 *)
+
+type 'a t = unit -> 'a node
+(** The type of delayed lists containing elements of type ['a].
+    Note that the concrete list node ['a node] is delayed under a closure,
+    not a [lazy] block, which means it might be recomputed every time
+    we access it. *)
+
+and +'a node =
+  | Nil
+  | Cons of 'a * 'a t (**)
+(** A fully-evaluated list node, either empty or containing an element
+    and a delayed tail. *)
+
+val empty : 'a t
+(** The empty sequence, containing no elements. *)
+
+val return : 'a -> 'a t
+(** The singleton sequence containing only the given element. *)
+
+val cons : 'a -> 'a t -> 'a t
+(** [cons x xs] is the sequence containing the element [x] followed by
+    the sequence [xs] @since 4.11 *)
+
+val append : 'a t -> 'a t -> 'a t
+(** [append xs ys] is the sequence [xs] followed by the sequence [ys]
+    @since 4.11 *)
+
+val map : ('a -> 'b) -> 'a t -> 'b t
+(** [map f seq] returns a new sequence whose elements are the elements of
+    [seq], transformed by [f].
+    This transformation is lazy, it only applies when the result is traversed.
+
+    If [seq = [1;2;3]], then [map f seq = [f 1; f 2; f 3]]. *)
+
+val filter : ('a -> bool) -> 'a t -> 'a t
+(** Remove from the sequence the elements that do not satisfy the
+    given predicate.
+    This transformation is lazy, it only applies when the result is
+    traversed. *)
+
+val filter_map : ('a -> 'b option) -> 'a t -> 'b t
+(** Apply the function to every element; if [f x = None] then [x] is dropped;
+    if [f x = Some y] then [y] is returned.
+    This transformation is lazy, it only applies when the result is
+    traversed. *)
+
+val flat_map : ('a -> 'b t) -> 'a t -> 'b t
+(** Map each element to a subsequence, then return each element of this
+    sub-sequence in turn.
+    This transformation is lazy, it only applies when the result is
+    traversed. *)
+
+val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
+(** Traverse the sequence from left to right, combining each element with the
+    accumulator using the given function.
+    The traversal happens immediately and will not terminate on infinite
+    sequences.
+
+    Also see {!List.fold_left} *)
+
+val iter : ('a -> unit) -> 'a t -> unit
+(** Iterate on the sequence, calling the (imperative) function on every element.
+    The traversal happens immediately and will not terminate on infinite
+    sequences. *)
+
+val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t
+(** Build a sequence from a step function and an initial value.
+    [unfold f u] returns [empty] if [f u] returns [None],
+    or [fun () -> Cons (x, unfold f y)] if [f u] returns [Some (x, y)].
+
+    For example, [unfold (function [] -> None | h::t -> Some (h,t)) l]
+    is equivalent to [List.to_seq l].
+    @since 4.11 *)
diff --git a/stdlib/set.ml b/stdlib/set.ml
new file mode 100644
index 00000000..d8b8a459
--- /dev/null
+++ b/stdlib/set.ml
@@ -0,0 +1,608 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Sets over ordered types *)
+
+module type OrderedType =
+  sig
+    type t
+    val compare: t -> t -> int
+  end
+
+module type S =
+  sig
+    type elt
+    type t
+    val empty: t
+    val is_empty: t -> bool
+    val mem: elt -> t -> bool
+    val add: elt -> t -> t
+    val singleton: elt -> t
+    val remove: elt -> t -> t
+    val union: t -> t -> t
+    val inter: t -> t -> t
+    val disjoint: t -> t -> bool
+    val diff: t -> t -> t
+    val compare: t -> t -> int
+    val equal: t -> t -> bool
+    val subset: t -> t -> bool
+    val iter: (elt -> unit) -> t -> unit
+    val map: (elt -> elt) -> t -> t
+    val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a
+    val for_all: (elt -> bool) -> t -> bool
+    val exists: (elt -> bool) -> t -> bool
+    val filter: (elt -> bool) -> t -> t
+    val filter_map: (elt -> elt option) -> t -> t
+    val partition: (elt -> bool) -> t -> t * t
+    val cardinal: t -> int
+    val elements: t -> elt list
+    val min_elt: t -> elt
+    val min_elt_opt: t -> elt option
+    val max_elt: t -> elt
+    val max_elt_opt: t -> elt option
+    val choose: t -> elt
+    val choose_opt: t -> elt option
+    val split: elt -> t -> t * bool * t
+    val find: elt -> t -> elt
+    val find_opt: elt -> t -> elt option
+    val find_first: (elt -> bool) -> t -> elt
+    val find_first_opt: (elt -> bool) -> t -> elt option
+    val find_last: (elt -> bool) -> t -> elt
+    val find_last_opt: (elt -> bool) -> t -> elt option
+    val of_list: elt list -> t
+    val to_seq_from : elt -> t -> elt Seq.t
+    val to_seq : t -> elt Seq.t
+    val add_seq : elt Seq.t -> t -> t
+    val of_seq : elt Seq.t -> t
+  end
+
+module Make(Ord: OrderedType) =
+  struct
+    type elt = Ord.t
+    type t = Empty | Node of {l:t; v:elt; r:t; h:int}
+
+    (* Sets are represented by balanced binary trees (the heights of the
+       children differ by at most 2 *)
+
+    let height = function
+        Empty -> 0
+      | Node {h} -> h
+
+    (* Creates a new node with left son l, value v and right son r.
+       We must have all elements of l < v < all elements of r.
+       l and r must be balanced and | height l - height r | <= 2.
+       Inline expansion of height for better speed. *)
+
+    let create l v r =
+      let hl = match l with Empty -> 0 | Node {h} -> h in
+      let hr = match r with Empty -> 0 | Node {h} -> h in
+      Node{l; v; r; h=(if hl >= hr then hl + 1 else hr + 1)}
+
+    (* Same as create, but performs one step of rebalancing if necessary.
+       Assumes l and r balanced and | height l - height r | <= 3.
+       Inline expansion of create for better speed in the most frequent case
+       where no rebalancing is required. *)
+
+    let bal l v r =
+      let hl = match l with Empty -> 0 | Node {h} -> h in
+      let hr = match r with Empty -> 0 | Node {h} -> h in
+      if hl > hr + 2 then begin
+        match l with
+          Empty -> invalid_arg "Set.bal"
+        | Node{l=ll; v=lv; r=lr} ->
+            if height ll >= height lr then
+              create ll lv (create lr v r)
+            else begin
+              match lr with
+                Empty -> invalid_arg "Set.bal"
+              | Node{l=lrl; v=lrv; r=lrr}->
+                  create (create ll lv lrl) lrv (create lrr v r)
+            end
+      end else if hr > hl + 2 then begin
+        match r with
+          Empty -> invalid_arg "Set.bal"
+        | Node{l=rl; v=rv; r=rr} ->
+            if height rr >= height rl then
+              create (create l v rl) rv rr
+            else begin
+              match rl with
+                Empty -> invalid_arg "Set.bal"
+              | Node{l=rll; v=rlv; r=rlr} ->
+                  create (create l v rll) rlv (create rlr rv rr)
+            end
+      end else
+        Node{l; v; r; h=(if hl >= hr then hl + 1 else hr + 1)}
+
+    (* Insertion of one element *)
+
+    let rec add x = function
+        Empty -> Node{l=Empty; v=x; r=Empty; h=1}
+      | Node{l; v; r} as t ->
+          let c = Ord.compare x v in
+          if c = 0 then t else
+          if c < 0 then
+            let ll = add x l in
+            if l == ll then t else bal ll v r
+          else
+            let rr = add x r in
+            if r == rr then t else bal l v rr
+
+    let singleton x = Node{l=Empty; v=x; r=Empty; h=1}
+
+    (* Beware: those two functions assume that the added v is *strictly*
+       smaller (or bigger) than all the present elements in the tree; it
+       does not test for equality with the current min (or max) element.
+       Indeed, they are only used during the "join" operation which
+       respects this precondition.
+    *)
+
+    let rec add_min_element x = function
+      | Empty -> singleton x
+      | Node {l; v; r} ->
+        bal (add_min_element x l) v r
+
+    let rec add_max_element x = function
+      | Empty -> singleton x
+      | Node {l; v; r} ->
+        bal l v (add_max_element x r)
+
+    (* Same as create and bal, but no assumptions are made on the
+       relative heights of l and r. *)
+
+    let rec join l v r =
+      match (l, r) with
+        (Empty, _) -> add_min_element v r
+      | (_, Empty) -> add_max_element v l
+      | (Node{l=ll; v=lv; r=lr; h=lh}, Node{l=rl; v=rv; r=rr; h=rh}) ->
+          if lh > rh + 2 then bal ll lv (join lr v r) else
+          if rh > lh + 2 then bal (join l v rl) rv rr else
+          create l v r
+
+    (* Smallest and greatest element of a set *)
+
+    let rec min_elt = function
+        Empty -> raise Not_found
+      | Node{l=Empty; v} -> v
+      | Node{l} -> min_elt l
+
+    let rec min_elt_opt = function
+        Empty -> None
+      | Node{l=Empty; v} -> Some v
+      | Node{l} -> min_elt_opt l
+
+    let rec max_elt = function
+        Empty -> raise Not_found
+      | Node{v; r=Empty} -> v
+      | Node{r} -> max_elt r
+
+    let rec max_elt_opt = function
+        Empty -> None
+      | Node{v; r=Empty} -> Some v
+      | Node{r} -> max_elt_opt r
+
+    (* Remove the smallest element of the given set *)
+
+    let rec remove_min_elt = function
+        Empty -> invalid_arg "Set.remove_min_elt"
+      | Node{l=Empty; r} -> r
+      | Node{l; v; r} -> bal (remove_min_elt l) v r
+
+    (* Merge two trees l and r into one.
+       All elements of l must precede the elements of r.
+       Assume | height l - height r | <= 2. *)
+
+    let merge t1 t2 =
+      match (t1, t2) with
+        (Empty, t) -> t
+      | (t, Empty) -> t
+      | (_, _) -> bal t1 (min_elt t2) (remove_min_elt t2)
+
+    (* Merge two trees l and r into one.
+       All elements of l must precede the elements of r.
+       No assumption on the heights of l and r. *)
+
+    let concat t1 t2 =
+      match (t1, t2) with
+        (Empty, t) -> t
+      | (t, Empty) -> t
+      | (_, _) -> join t1 (min_elt t2) (remove_min_elt t2)
+
+    (* Splitting.  split x s returns a triple (l, present, r) where
+        - l is the set of elements of s that are < x
+        - r is the set of elements of s that are > x
+        - present is false if s contains no element equal to x,
+          or true if s contains an element equal to x. *)
+
+    let rec split x = function
+        Empty ->
+          (Empty, false, Empty)
+      | Node{l; v; r} ->
+          let c = Ord.compare x v in
+          if c = 0 then (l, true, r)
+          else if c < 0 then
+            let (ll, pres, rl) = split x l in (ll, pres, join rl v r)
+          else
+            let (lr, pres, rr) = split x r in (join l v lr, pres, rr)
+
+    (* Implementation of the set operations *)
+
+    let empty = Empty
+
+    let is_empty = function Empty -> true | _ -> false
+
+    let rec mem x = function
+        Empty -> false
+      | Node{l; v; r} ->
+          let c = Ord.compare x v in
+          c = 0 || mem x (if c < 0 then l else r)
+
+    let rec remove x = function
+        Empty -> Empty
+      | (Node{l; v; r} as t) ->
+          let c = Ord.compare x v in
+          if c = 0 then merge l r
+          else
+            if c < 0 then
+              let ll = remove x l in
+              if l == ll then t
+              else bal ll v r
+            else
+              let rr = remove x r in
+              if r == rr then t
+              else bal l v rr
+
+    let rec union s1 s2 =
+      match (s1, s2) with
+        (Empty, t2) -> t2
+      | (t1, Empty) -> t1
+      | (Node{l=l1; v=v1; r=r1; h=h1}, Node{l=l2; v=v2; r=r2; h=h2}) ->
+          if h1 >= h2 then
+            if h2 = 1 then add v2 s1 else begin
+              let (l2, _, r2) = split v1 s2 in
+              join (union l1 l2) v1 (union r1 r2)
+            end
+          else
+            if h1 = 1 then add v1 s2 else begin
+              let (l1, _, r1) = split v2 s1 in
+              join (union l1 l2) v2 (union r1 r2)
+            end
+
+    let rec inter s1 s2 =
+      match (s1, s2) with
+        (Empty, _) -> Empty
+      | (_, Empty) -> Empty
+      | (Node{l=l1; v=v1; r=r1}, t2) ->
+          match split v1 t2 with
+            (l2, false, r2) ->
+              concat (inter l1 l2) (inter r1 r2)
+          | (l2, true, r2) ->
+              join (inter l1 l2) v1 (inter r1 r2)
+
+    (* Same as split, but compute the left and right subtrees
+       only if the pivot element is not in the set.  The right subtree
+       is computed on demand. *)
+
+    type split_bis =
+      | Found
+      | NotFound of t * (unit -> t)
+
+    let rec split_bis x = function
+        Empty ->
+          NotFound (Empty, (fun () -> Empty))
+      | Node{l; v; r; _} ->
+          let c = Ord.compare x v in
+          if c = 0 then Found
+          else if c < 0 then
+            match split_bis x l with
+            | Found -> Found
+            | NotFound (ll, rl) -> NotFound (ll, (fun () -> join (rl ()) v r))
+          else
+            match split_bis x r with
+            | Found -> Found
+            | NotFound (lr, rr) -> NotFound (join l v lr, rr)
+
+    let rec disjoint s1 s2 =
+      match (s1, s2) with
+        (Empty, _) | (_, Empty) -> true
+      | (Node{l=l1; v=v1; r=r1}, t2) ->
+          if s1 == s2 then false
+          else match split_bis v1 t2 with
+              NotFound(l2, r2) -> disjoint l1 l2 && disjoint r1 (r2 ())
+            | Found -> false
+
+    let rec diff s1 s2 =
+      match (s1, s2) with
+        (Empty, _) -> Empty
+      | (t1, Empty) -> t1
+      | (Node{l=l1; v=v1; r=r1}, t2) ->
+          match split v1 t2 with
+            (l2, false, r2) ->
+              join (diff l1 l2) v1 (diff r1 r2)
+          | (l2, true, r2) ->
+              concat (diff l1 l2) (diff r1 r2)
+
+    type enumeration = End | More of elt * t * enumeration
+
+    let rec cons_enum s e =
+      match s with
+        Empty -> e
+      | Node{l; v; r} -> cons_enum l (More(v, r, e))
+
+    let rec compare_aux e1 e2 =
+        match (e1, e2) with
+        (End, End) -> 0
+      | (End, _)  -> -1
+      | (_, End) -> 1
+      | (More(v1, r1, e1), More(v2, r2, e2)) ->
+          let c = Ord.compare v1 v2 in
+          if c <> 0
+          then c
+          else compare_aux (cons_enum r1 e1) (cons_enum r2 e2)
+
+    let compare s1 s2 =
+      compare_aux (cons_enum s1 End) (cons_enum s2 End)
+
+    let equal s1 s2 =
+      compare s1 s2 = 0
+
+    let rec subset s1 s2 =
+      match (s1, s2) with
+        Empty, _ ->
+          true
+      | _, Empty ->
+          false
+      | Node {l=l1; v=v1; r=r1}, (Node {l=l2; v=v2; r=r2} as t2) ->
+          let c = Ord.compare v1 v2 in
+          if c = 0 then
+            subset l1 l2 && subset r1 r2
+          else if c < 0 then
+            subset (Node {l=l1; v=v1; r=Empty; h=0}) l2 && subset r1 t2
+          else
+            subset (Node {l=Empty; v=v1; r=r1; h=0}) r2 && subset l1 t2
+
+    let rec iter f = function
+        Empty -> ()
+      | Node{l; v; r} -> iter f l; f v; iter f r
+
+    let rec fold f s accu =
+      match s with
+        Empty -> accu
+      | Node{l; v; r} -> fold f r (f v (fold f l accu))
+
+    let rec for_all p = function
+        Empty -> true
+      | Node{l; v; r} -> p v && for_all p l && for_all p r
+
+    let rec exists p = function
+        Empty -> false
+      | Node{l; v; r} -> p v || exists p l || exists p r
+
+    let rec filter p = function
+        Empty -> Empty
+      | (Node{l; v; r}) as t ->
+          (* call [p] in the expected left-to-right order *)
+          let l' = filter p l in
+          let pv = p v in
+          let r' = filter p r in
+          if pv then
+            if l==l' && r==r' then t else join l' v r'
+          else concat l' r'
+
+    let rec partition p = function
+        Empty -> (Empty, Empty)
+      | Node{l; v; r} ->
+          (* call [p] in the expected left-to-right order *)
+          let (lt, lf) = partition p l in
+          let pv = p v in
+          let (rt, rf) = partition p r in
+          if pv
+          then (join lt v rt, concat lf rf)
+          else (concat lt rt, join lf v rf)
+
+    let rec cardinal = function
+        Empty -> 0
+      | Node{l; r} -> cardinal l + 1 + cardinal r
+
+    let rec elements_aux accu = function
+        Empty -> accu
+      | Node{l; v; r} -> elements_aux (v :: elements_aux accu r) l
+
+    let elements s =
+      elements_aux [] s
+
+    let choose = min_elt
+
+    let choose_opt = min_elt_opt
+
+    let rec find x = function
+        Empty -> raise Not_found
+      | Node{l; v; r} ->
+          let c = Ord.compare x v in
+          if c = 0 then v
+          else find x (if c < 0 then l else r)
+
+    let rec find_first_aux v0 f = function
+        Empty ->
+          v0
+      | Node{l; v; r} ->
+          if f v then
+            find_first_aux v f l
+          else
+            find_first_aux v0 f r
+
+    let rec find_first f = function
+        Empty ->
+          raise Not_found
+      | Node{l; v; r} ->
+          if f v then
+            find_first_aux v f l
+          else
+            find_first f r
+
+    let rec find_first_opt_aux v0 f = function
+        Empty ->
+          Some v0
+      | Node{l; v; r} ->
+          if f v then
+            find_first_opt_aux v f l
+          else
+            find_first_opt_aux v0 f r
+
+    let rec find_first_opt f = function
+        Empty ->
+          None
+      | Node{l; v; r} ->
+          if f v then
+            find_first_opt_aux v f l
+          else
+            find_first_opt f r
+
+    let rec find_last_aux v0 f = function
+        Empty ->
+          v0
+      | Node{l; v; r} ->
+          if f v then
+            find_last_aux v f r
+          else
+            find_last_aux v0 f l
+
+    let rec find_last f = function
+        Empty ->
+          raise Not_found
+      | Node{l; v; r} ->
+          if f v then
+            find_last_aux v f r
+          else
+            find_last f l
+
+    let rec find_last_opt_aux v0 f = function
+        Empty ->
+          Some v0
+      | Node{l; v; r} ->
+          if f v then
+            find_last_opt_aux v f r
+          else
+            find_last_opt_aux v0 f l
+
+    let rec find_last_opt f = function
+        Empty ->
+          None
+      | Node{l; v; r} ->
+          if f v then
+            find_last_opt_aux v f r
+          else
+            find_last_opt f l
+
+    let rec find_opt x = function
+        Empty -> None
+      | Node{l; v; r} ->
+          let c = Ord.compare x v in
+          if c = 0 then Some v
+          else find_opt x (if c < 0 then l else r)
+
+    let try_join l v r =
+      (* [join l v r] can only be called when (elements of l < v <
+         elements of r); use [try_join l v r] when this property may
+         not hold, but you hope it does hold in the common case *)
+      if (l = Empty || Ord.compare (max_elt l) v < 0)
+      && (r = Empty || Ord.compare v (min_elt r) < 0)
+      then join l v r
+      else union l (add v r)
+
+    let rec map f = function
+      | Empty -> Empty
+      | Node{l; v; r} as t ->
+         (* enforce left-to-right evaluation order *)
+         let l' = map f l in
+         let v' = f v in
+         let r' = map f r in
+         if l == l' && v == v' && r == r' then t
+         else try_join l' v' r'
+
+    let try_concat t1 t2 =
+      match (t1, t2) with
+        (Empty, t) -> t
+      | (t, Empty) -> t
+      | (_, _) -> try_join t1 (min_elt t2) (remove_min_elt t2)
+
+    let rec filter_map f = function
+      | Empty -> Empty
+      | Node{l; v; r} as t ->
+         (* enforce left-to-right evaluation order *)
+         let l' = filter_map f l in
+         let v' = f v in
+         let r' = filter_map f r in
+         begin match v' with
+           | Some v' ->
+              if l == l' && v == v' && r == r' then t
+              else try_join l' v' r'
+           | None ->
+              try_concat l' r'
+         end
+
+    let of_sorted_list l =
+      let rec sub n l =
+        match n, l with
+        | 0, l -> Empty, l
+        | 1, x0 :: l -> Node {l=Empty; v=x0; r=Empty; h=1}, l
+        | 2, x0 :: x1 :: l ->
+            Node{l=Node{l=Empty; v=x0; r=Empty; h=1}; v=x1; r=Empty; h=2}, l
+        | 3, x0 :: x1 :: x2 :: l ->
+            Node{l=Node{l=Empty; v=x0; r=Empty; h=1}; v=x1;
+                 r=Node{l=Empty; v=x2; r=Empty; h=1}; h=2}, l
+        | n, l ->
+          let nl = n / 2 in
+          let left, l = sub nl l in
+          match l with
+          | [] -> assert false
+          | mid :: l ->
+            let right, l = sub (n - nl - 1) l in
+            create left mid right, l
+      in
+      fst (sub (List.length l) l)
+
+    let of_list l =
+      match l with
+      | [] -> empty
+      | [x0] -> singleton x0
+      | [x0; x1] -> add x1 (singleton x0)
+      | [x0; x1; x2] -> add x2 (add x1 (singleton x0))
+      | [x0; x1; x2; x3] -> add x3 (add x2 (add x1 (singleton x0)))
+      | [x0; x1; x2; x3; x4] -> add x4 (add x3 (add x2 (add x1 (singleton x0))))
+      | _ -> of_sorted_list (List.sort_uniq Ord.compare l)
+
+    let add_seq i m =
+      Seq.fold_left (fun s x -> add x s) m i
+
+    let of_seq i = add_seq i empty
+
+    let rec seq_of_enum_ c () = match c with
+      | End -> Seq.Nil
+      | More (x, t, rest) -> Seq.Cons (x, seq_of_enum_ (cons_enum t rest))
+
+    let to_seq c = seq_of_enum_ (cons_enum c End)
+
+    let to_seq_from low s =
+      let rec aux low s c = match s with
+        | Empty -> c
+        | Node {l; r; v; _} ->
+            begin match Ord.compare v low with
+              | 0 -> More (v, r, c)
+              | n when n<0 -> aux low r c
+              | _ -> aux low l (More (v, r, c))
+            end
+      in
+      seq_of_enum_ (aux low s End)
+  end
diff --git a/stdlib/set.mli b/stdlib/set.mli
new file mode 100644
index 00000000..91e39238
--- /dev/null
+++ b/stdlib/set.mli
@@ -0,0 +1,306 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Sets over ordered types.
+
+   This module implements the set data structure, given a total ordering
+   function over the set elements. All operations over sets
+   are purely applicative (no side-effects).
+   The implementation uses balanced binary trees, and is therefore
+   reasonably efficient: insertion and membership take time
+   logarithmic in the size of the set, for instance.
+
+   The {!Make} functor constructs implementations for any type, given a
+   [compare] function.
+   For instance:
+   {[
+     module IntPairs =
+       struct
+         type t = int * int
+         let compare (x0,y0) (x1,y1) =
+           match Stdlib.compare x0 x1 with
+               0 -> Stdlib.compare y0 y1
+             | c -> c
+       end
+
+     module PairsSet = Set.Make(IntPairs)
+
+     let m = PairsSet.(empty |> add (2,3) |> add (5,7) |> add (11,13))
+   ]}
+
+   This creates a new module [PairsSet], with a new type [PairsSet.t]
+   of sets of [int * int].
+*)
+
+module type OrderedType =
+  sig
+    type t
+      (** The type of the set elements. *)
+
+    val compare : t -> t -> int
+      (** A total ordering function over the set elements.
+          This is a two-argument function [f] such that
+          [f e1 e2] is zero if the elements [e1] and [e2] are equal,
+          [f e1 e2] is strictly negative if [e1] is smaller than [e2],
+          and [f e1 e2] is strictly positive if [e1] is greater than [e2].
+          Example: a suitable ordering function is the generic structural
+          comparison function {!Stdlib.compare}. *)
+  end
+(** Input signature of the functor {!Set.Make}. *)
+
+module type S =
+  sig
+    type elt
+    (** The type of the set elements. *)
+
+    type t
+    (** The type of sets. *)
+
+    val empty: t
+    (** The empty set. *)
+
+    val is_empty: t -> bool
+    (** Test whether a set is empty or not. *)
+
+    val mem: elt -> t -> bool
+    (** [mem x s] tests whether [x] belongs to the set [s]. *)
+
+    val add: elt -> t -> t
+    (** [add x s] returns a set containing all elements of [s],
+       plus [x]. If [x] was already in [s], [s] is returned unchanged
+       (the result of the function is then physically equal to [s]).
+       @before 4.03 Physical equality was not ensured. *)
+
+    val singleton: elt -> t
+    (** [singleton x] returns the one-element set containing only [x]. *)
+
+    val remove: elt -> t -> t
+    (** [remove x s] returns a set containing all elements of [s],
+       except [x]. If [x] was not in [s], [s] is returned unchanged
+       (the result of the function is then physically equal to [s]).
+       @before 4.03 Physical equality was not ensured. *)
+
+    val union: t -> t -> t
+    (** Set union. *)
+
+    val inter: t -> t -> t
+    (** Set intersection. *)
+
+    val disjoint: t -> t -> bool
+    (** Test if two sets are disjoint.
+        @since 4.08.0 *)
+
+    val diff: t -> t -> t
+    (** Set difference: [diff s1 s2] contains the elements of [s1]
+       that are not in [s2]. *)
+
+    val compare: t -> t -> int
+    (** Total ordering between sets. Can be used as the ordering function
+       for doing sets of sets. *)
+
+    val equal: t -> t -> bool
+    (** [equal s1 s2] tests whether the sets [s1] and [s2] are
+       equal, that is, contain equal elements. *)
+
+    val subset: t -> t -> bool
+    (** [subset s1 s2] tests whether the set [s1] is a subset of
+       the set [s2]. *)
+
+    val iter: (elt -> unit) -> t -> unit
+    (** [iter f s] applies [f] in turn to all elements of [s].
+       The elements of [s] are presented to [f] in increasing order
+       with respect to the ordering over the type of the elements. *)
+
+    val map: (elt -> elt) -> t -> t
+    (** [map f s] is the set whose elements are [f a0],[f a1]... [f
+        aN], where [a0],[a1]...[aN] are the elements of [s].
+
+       The elements are passed to [f] in increasing order
+       with respect to the ordering over the type of the elements.
+
+       If no element of [s] is changed by [f], [s] is returned
+       unchanged. (If each output of [f] is physically equal to its
+       input, the returned set is physically equal to [s].)
+       @since 4.04.0 *)
+
+    val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a
+    (** [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)],
+       where [x1 ... xN] are the elements of [s], in increasing order. *)
+
+    val for_all: (elt -> bool) -> t -> bool
+    (** [for_all p s] checks if all elements of the set
+       satisfy the predicate [p]. *)
+
+    val exists: (elt -> bool) -> t -> bool
+    (** [exists p s] checks if at least one element of
+       the set satisfies the predicate [p]. *)
+
+    val filter: (elt -> bool) -> t -> t
+    (** [filter p s] returns the set of all elements in [s]
+       that satisfy predicate [p]. If [p] satisfies every element in [s],
+       [s] is returned unchanged (the result of the function is then
+       physically equal to [s]).
+       @before 4.03 Physical equality was not ensured.*)
+
+    val filter_map: (elt -> elt option) -> t -> t
+    (** [filter_map f s] returns the set of all [v] such that
+        [f x = Some v] for some element [x] of [s].
+
+       For example,
+       {[filter_map (fun n -> if n mod 2 = 0 then Some (n / 2) else None) s]}
+       is the set of halves of the even elements of [s].
+
+       If no element of [s] is changed or dropped by [f] (if
+       [f x = Some x] for each element [x]), then
+       [s] is returned unchanged: the result of the function
+       is then physically equal to [s].
+
+       @since 4.11.0
+     *)
+
+    val partition: (elt -> bool) -> t -> t * t
+    (** [partition p s] returns a pair of sets [(s1, s2)], where
+       [s1] is the set of all the elements of [s] that satisfy the
+       predicate [p], and [s2] is the set of all the elements of
+       [s] that do not satisfy [p]. *)
+
+    val cardinal: t -> int
+    (** Return the number of elements of a set. *)
+
+    val elements: t -> elt list
+    (** Return the list of all elements of the given set.
+       The returned list is sorted in increasing order with respect
+       to the ordering [Ord.compare], where [Ord] is the argument
+       given to {!Set.Make}. *)
+
+    val min_elt: t -> elt
+    (** Return the smallest element of the given set
+       (with respect to the [Ord.compare] ordering), or raise
+       [Not_found] if the set is empty. *)
+
+    val min_elt_opt: t -> elt option
+    (** Return the smallest element of the given set
+       (with respect to the [Ord.compare] ordering), or [None]
+       if the set is empty.
+        @since 4.05
+    *)
+
+    val max_elt: t -> elt
+    (** Same as {!Set.S.min_elt}, but returns the largest element of the
+       given set. *)
+
+    val max_elt_opt: t -> elt option
+    (** Same as {!Set.S.min_elt_opt}, but returns the largest element of the
+        given set.
+        @since 4.05
+    *)
+
+    val choose: t -> elt
+    (** Return one element of the given set, or raise [Not_found] if
+       the set is empty. Which element is chosen is unspecified,
+       but equal elements will be chosen for equal sets. *)
+
+    val choose_opt: t -> elt option
+    (** Return one element of the given set, or [None] if
+        the set is empty. Which element is chosen is unspecified,
+        but equal elements will be chosen for equal sets.
+        @since 4.05
+    *)
+
+    val split: elt -> t -> t * bool * t
+    (** [split x s] returns a triple [(l, present, r)], where
+          [l] is the set of elements of [s] that are
+          strictly less than [x];
+          [r] is the set of elements of [s] that are
+          strictly greater than [x];
+          [present] is [false] if [s] contains no element equal to [x],
+          or [true] if [s] contains an element equal to [x]. *)
+
+    val find: elt -> t -> elt
+    (** [find x s] returns the element of [s] equal to [x] (according
+        to [Ord.compare]), or raise [Not_found] if no such element
+        exists.
+        @since 4.01.0 *)
+
+    val find_opt: elt -> t -> elt option
+    (** [find_opt x s] returns the element of [s] equal to [x] (according
+        to [Ord.compare]), or [None] if no such element
+        exists.
+        @since 4.05 *)
+
+    val find_first: (elt -> bool) -> t -> elt
+    (** [find_first f s], where [f] is a monotonically increasing function,
+       returns the lowest element [e] of [s] such that [f e],
+       or raises [Not_found] if no such element exists.
+
+       For example, [find_first (fun e -> Ord.compare e x >= 0) s] will return
+       the first element [e] of [s] where [Ord.compare e x >= 0] (intuitively:
+       [e >= x]), or raise [Not_found] if [x] is greater than any element of
+       [s].
+
+        @since 4.05
+       *)
+
+    val find_first_opt: (elt -> bool) -> t -> elt option
+    (** [find_first_opt f s], where [f] is a monotonically increasing function,
+       returns an option containing the lowest element [e] of [s] such that
+       [f e], or [None] if no such element exists.
+        @since 4.05
+       *)
+
+    val find_last: (elt -> bool) -> t -> elt
+    (** [find_last f s], where [f] is a monotonically decreasing function,
+       returns the highest element [e] of [s] such that [f e],
+       or raises [Not_found] if no such element exists.
+        @since 4.05
+       *)
+
+    val find_last_opt: (elt -> bool) -> t -> elt option
+    (** [find_last_opt f s], where [f] is a monotonically decreasing function,
+       returns an option containing the highest element [e] of [s] such that
+       [f e], or [None] if no such element exists.
+        @since 4.05
+       *)
+
+    val of_list: elt list -> t
+    (** [of_list l] creates a set from a list of elements.
+        This is usually more efficient than folding [add] over the list,
+        except perhaps for lists with many duplicated elements.
+        @since 4.02.0 *)
+
+    (** {1 Iterators} *)
+
+    val to_seq_from : elt -> t -> elt Seq.t
+    (** [to_seq_from x s] iterates on a subset of the elements of [s]
+        in ascending order, from [x] or above.
+        @since 4.07 *)
+
+    val to_seq : t -> elt Seq.t
+    (** Iterate on the whole set, in ascending order
+        @since 4.07 *)
+
+    val add_seq : elt Seq.t -> t -> t
+    (** Add the given elements to the set, in order.
+        @since 4.07 *)
+
+    val of_seq : elt Seq.t -> t
+    (** Build a set from the given bindings
+        @since 4.07 *)
+  end
+(** Output signature of the functor {!Set.Make}. *)
+
+module Make (Ord : OrderedType) : S with type elt = Ord.t
+(** Functor building an implementation of the set structure
+   given a totally ordered type. *)
diff --git a/stdlib/spacetime.ml b/stdlib/spacetime.ml
new file mode 100644
index 00000000..3e8abe1d
--- /dev/null
+++ b/stdlib/spacetime.ml
@@ -0,0 +1,91 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2015--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+external spacetime_enabled : unit -> bool
+  = "caml_spacetime_enabled" [@@noalloc]
+
+let enabled = spacetime_enabled ()
+
+let if_spacetime_enabled f =
+  if enabled then f () else ()
+
+module Series = struct
+  type t = {
+    channel : out_channel;
+    mutable closed : bool;
+  }
+
+  external write_magic_number : out_channel -> unit
+    = "caml_spacetime_only_works_for_native_code"
+      "caml_spacetime_write_magic_number"
+
+  external register_channel_for_spacetime : out_channel -> unit
+    = "caml_register_channel_for_spacetime"
+
+  let create ~path =
+    if spacetime_enabled () then begin
+      let channel = open_out path in
+      register_channel_for_spacetime channel;
+      let t =
+        { channel = channel;
+          closed = false;
+        }
+      in
+      write_magic_number t.channel;
+      t
+    end else begin
+      { channel = stdout;  (* arbitrary value *)
+        closed = true;
+      }
+    end
+
+  external save_event : ?time:float -> out_channel -> event_name:string -> unit
+    = "caml_spacetime_only_works_for_native_code"
+      "caml_spacetime_save_event"
+
+  let save_event ?time t ~event_name =
+    if_spacetime_enabled (fun () ->
+      save_event ?time t.channel ~event_name)
+
+  external save_trie : ?time:float -> out_channel -> unit
+    = "caml_spacetime_only_works_for_native_code"
+      "caml_spacetime_save_trie"
+
+  let save_and_close ?time t =
+    if_spacetime_enabled (fun () ->
+      if t.closed then failwith "Series is closed";
+      save_trie ?time t.channel;
+      close_out t.channel;
+      t.closed <- true)
+end
+
+module Snapshot = struct
+  external take : ?time:float -> out_channel -> unit
+    = "caml_spacetime_only_works_for_native_code"
+      "caml_spacetime_take_snapshot"
+
+  let take ?time { Series.closed; channel } =
+    if_spacetime_enabled (fun () ->
+      if closed then failwith "Series is closed";
+      Gc.minor ();
+      take ?time channel)
+end
+
+external save_event_for_automatic_snapshots : event_name:string -> unit
+  = "caml_spacetime_only_works_for_native_code"
+    "caml_spacetime_save_event_for_automatic_snapshots"
+
+let save_event_for_automatic_snapshots ~event_name =
+  if_spacetime_enabled (fun () ->
+    save_event_for_automatic_snapshots ~event_name)
diff --git a/stdlib/spacetime.mli b/stdlib/spacetime.mli
new file mode 100644
index 00000000..1f770905
--- /dev/null
+++ b/stdlib/spacetime.mli
@@ -0,0 +1,99 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2015--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Profiling of a program's space behaviour over time.
+    Currently only supported on x86-64 platforms running 64-bit code.
+
+    To use the functions in this module you must:
+    - configure the compiler with "-spacetime";
+    - compile to native code.
+    Without these conditions being satisfied the functions in this module
+    will have no effect.
+
+    Instead of manually taking profiling heap snapshots with this module it is
+    possible to use an automatic snapshot facility that writes profiling
+    information at fixed intervals to a file. To enable this, all that needs to
+    be done is to build the relevant program using a compiler configured with
+    -spacetime; and set the environment variable OCAML_SPACETIME_INTERVAL to an
+    integer number of milliseconds giving the interval between profiling heap
+    snapshots. This interval should not be made excessively small relative to
+    the running time of the program. A typical interval to start with might be
+    1/100 of the running time of the program.  The program must exit "normally"
+    (i.e. by calling [exit], with whatever exit code, rather than being
+    abnormally terminated by a signal) so that the snapshot file is
+    correctly completed.
+
+    When using the automatic snapshot mode the profiling output is written
+    to a file called "spacetime-<pid>" where <pid> is the process ID of the
+    program.  (If the program forks and continues executing then multiple
+    files may be produced with different pid numbers.)  The profiling output
+    is by default written to the current working directory when the program
+    starts.  This may be customised by setting the OCAML_SPACETIME_SNAPSHOT_DIR
+    environment variable to the name of the desired directory.
+
+    If using automatic snapshots the presence of the
+    [save_event_for_automatic_snapshots] function, below, should be noted.
+
+    The functions in this module are thread safe.
+
+    For functions to decode the information recorded by the profiler,
+    see the Spacetime offline library in otherlibs/. *)
+
+(** [enabled] is [true] if the compiler is configured with spacetime and [false]
+    otherwise *)
+val enabled : bool
+
+module Series : sig
+  (** Type representing a file that will hold a series of heap snapshots
+      together with additional information required to interpret those
+      snapshots. *)
+  type t
+
+  (** [create ~path] creates a series file at [path]. *)
+  val create : path:string -> t
+
+  (** [save_event] writes an event, which is an arbitrary string, into the
+      given series file.  This may be used for identifying particular points
+      during program execution when analysing the profile.
+      The optional [time] parameter is as for {!Snapshot.take}.
+  *)
+  val save_event : ?time:float -> t -> event_name:string -> unit
+
+  (** [save_and_close series] writes information into [series] required for
+      interpreting the snapshots that [series] contains and then closes the
+      [series] file. This function must be called to produce a valid series
+      file.
+      The optional [time] parameter is as for {!Snapshot.take}.
+  *)
+  val save_and_close : ?time:float -> t -> unit
+end
+
+module Snapshot : sig
+  (** [take series] takes a snapshot of the profiling annotations on the values
+      in the minor and major heaps, together with GC stats, and write the
+      result to the [series] file.  This function triggers a minor GC but does
+      not allocate any memory itself.
+      If the optional [time] is specified, it will be used instead of the
+      result of {!Sys.time} as the timestamp of the snapshot.  Such [time]s
+      should start from zero and be monotonically increasing.  This parameter
+      is intended to be used so that snapshots can be correlated against wall
+      clock time (which is not supported in the standard library) rather than
+      elapsed CPU time.
+  *)
+  val take : ?time:float -> Series.t -> unit
+end
+
+(** Like {!Series.save_event}, but writes to the automatic snapshot file.
+    This function is a no-op if OCAML_SPACETIME_INTERVAL was not set. *)
+val save_event_for_automatic_snapshots : event_name:string -> unit
diff --git a/stdlib/stack.ml b/stdlib/stack.ml
new file mode 100644
index 00000000..c46161f0
--- /dev/null
+++ b/stdlib/stack.ml
@@ -0,0 +1,65 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type 'a t = { mutable c : 'a list; mutable len : int; }
+
+exception Empty
+
+let create () = { c = []; len = 0; }
+
+let clear s = s.c <- []; s.len <- 0
+
+let copy s = { c = s.c; len = s.len; }
+
+let push x s = s.c <- x :: s.c; s.len <- s.len + 1
+
+let pop s =
+  match s.c with
+  | hd::tl -> s.c <- tl; s.len <- s.len - 1; hd
+  | []     -> raise Empty
+
+let pop_opt s =
+  match s.c with
+  | hd::tl -> s.c <- tl; s.len <- s.len - 1; Some hd
+  | []     -> None
+
+let top s =
+  match s.c with
+  | hd::_ -> hd
+  | []    -> raise Empty
+
+let top_opt s =
+  match s.c with
+  | hd::_ -> Some hd
+  | []    -> None
+
+let is_empty s = (s.c = [])
+
+let length s = s.len
+
+let iter f s = List.iter f s.c
+
+let fold f acc s = List.fold_left f acc s.c
+
+(** {1 Iterators} *)
+
+let to_seq s = List.to_seq s.c
+
+let add_seq q i = Seq.iter (fun x -> push x q) i
+
+let of_seq g =
+  let s = create() in
+  add_seq s g;
+  s
diff --git a/stdlib/stack.mli b/stdlib/stack.mli
new file mode 100644
index 00000000..26ea3cc6
--- /dev/null
+++ b/stdlib/stack.mli
@@ -0,0 +1,88 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Last-in first-out stacks.
+
+   This module implements stacks (LIFOs), with in-place modification.
+*)
+
+type 'a t
+(** The type of stacks containing elements of type ['a]. *)
+
+exception Empty
+(** Raised when {!Stack.pop} or {!Stack.top} is applied to an empty stack. *)
+
+
+val create : unit -> 'a t
+(** Return a new stack, initially empty. *)
+
+val push : 'a -> 'a t -> unit
+(** [push x s] adds the element [x] at the top of stack [s]. *)
+
+val pop : 'a t -> 'a
+(** [pop s] removes and returns the topmost element in stack [s],
+   or raises {!Empty} if the stack is empty. *)
+
+val pop_opt : 'a t -> 'a option
+(** [pop_opt s] removes and returns the topmost element in stack [s],
+   or returns [None] if the stack is empty.
+   @since 4.08 *)
+
+val top : 'a t -> 'a
+(** [top s] returns the topmost element in stack [s],
+   or raises {!Empty} if the stack is empty. *)
+
+val top_opt : 'a t -> 'a option
+(** [top_opt s] returns the topmost element in stack [s],
+   or [None] if the stack is empty.
+   @since 4.08 *)
+
+val clear : 'a t -> unit
+(** Discard all elements from a stack. *)
+
+val copy : 'a t -> 'a t
+(** Return a copy of the given stack. *)
+
+val is_empty : 'a t -> bool
+(** Return [true] if the given stack is empty, [false] otherwise. *)
+
+val length : 'a t -> int
+(** Return the number of elements in a stack. Time complexity O(1) *)
+
+val iter : ('a -> unit) -> 'a t -> unit
+(** [iter f s] applies [f] in turn to all elements of [s],
+   from the element at the top of the stack to the element at the
+   bottom of the stack. The stack itself is unchanged. *)
+
+val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
+(** [fold f accu s] is [(f (... (f (f accu x1) x2) ...) xn)]
+    where [x1] is the top of the stack, [x2] the second element,
+    and [xn] the bottom element. The stack is unchanged.
+    @since 4.03 *)
+
+(** {1 Iterators} *)
+
+val to_seq : 'a t -> 'a Seq.t
+(** Iterate on the stack, top to bottom.
+    It is safe to modify the stack during iteration.
+    @since 4.07 *)
+
+val add_seq : 'a t -> 'a Seq.t -> unit
+(** Add the elements from the iterator on the top of the stack.
+    @since 4.07 *)
+
+val of_seq : 'a Seq.t -> 'a t
+(** Create a stack from the iterator
+    @since 4.07 *)
diff --git a/stdlib/stdLabels.ml b/stdlib/stdLabels.ml
new file mode 100644
index 00000000..664472b1
--- /dev/null
+++ b/stdlib/stdLabels.ml
@@ -0,0 +1,24 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Jacques Garrigue, Kyoto University RIMS                 *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Module [StdLabels]: meta-module for labelled libraries *)
+
+module Array = ArrayLabels
+
+module List = ListLabels
+
+module String = StringLabels
+
+module Bytes = BytesLabels
diff --git a/stdlib/stdLabels.mli b/stdlib/stdLabels.mli
new file mode 100644
index 00000000..4b24fd2b
--- /dev/null
+++ b/stdlib/stdLabels.mli
@@ -0,0 +1,29 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Jacques Garrigue, Kyoto University RIMS                 *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Standard labeled libraries.
+
+   This meta-module provides labelized version of the {!Array},
+   {!Bytes}, {!List} and {!String} modules.
+
+   They only differ by their labels. Detailed interfaces can be found
+   in [arrayLabels.mli], [bytesLabels.mli], [listLabels.mli]
+   and [stringLabels.mli].
+*)
+
+module Array = ArrayLabels
+module Bytes = BytesLabels
+module List = ListLabels
+module String = StringLabels
diff --git a/stdlib/std_exit.ml b/stdlib/std_exit.ml
new file mode 100644
index 00000000..1b97652d
--- /dev/null
+++ b/stdlib/std_exit.ml
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Ensure that [at_exit] functions are called at the end of every program *)
+
+let _ = do_at_exit()
diff --git a/stdlib/stdlib.ml b/stdlib/stdlib.ml
new file mode 100644
index 00000000..5cef512c
--- /dev/null
+++ b/stdlib/stdlib.ml
@@ -0,0 +1,618 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Exceptions *)
+
+external register_named_value : string -> 'a -> unit
+                              = "caml_register_named_value"
+
+let () =
+  (* for runtime/fail_nat.c *)
+  register_named_value "Pervasives.array_bound_error"
+    (Invalid_argument "index out of bounds")
+
+external raise : exn -> 'a = "%raise"
+external raise_notrace : exn -> 'a = "%raise_notrace"
+
+let failwith s = raise(Failure s)
+let invalid_arg s = raise(Invalid_argument s)
+
+exception Exit
+exception Match_failure = Match_failure
+exception Assert_failure = Assert_failure
+exception Invalid_argument = Invalid_argument
+exception Failure = Failure
+exception Not_found = Not_found
+exception Out_of_memory = Out_of_memory
+exception Stack_overflow = Stack_overflow
+exception Sys_error = Sys_error
+exception End_of_file = End_of_file
+exception Division_by_zero = Division_by_zero
+exception Sys_blocked_io = Sys_blocked_io
+exception Undefined_recursive_module = Undefined_recursive_module
+
+(* Composition operators *)
+
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
+
+(* Debugging *)
+
+external __LOC__ : string = "%loc_LOC"
+external __FILE__ : string = "%loc_FILE"
+external __LINE__ : int = "%loc_LINE"
+external __MODULE__ : string = "%loc_MODULE"
+external __POS__ : string * int * int * int = "%loc_POS"
+
+external __LOC_OF__ : 'a -> string * 'a = "%loc_LOC"
+external __LINE_OF__ : 'a -> int * 'a = "%loc_LINE"
+external __POS_OF__ : 'a -> (string * int * int * int) * 'a = "%loc_POS"
+
+(* Comparisons *)
+
+external ( = ) : 'a -> 'a -> bool = "%equal"
+external ( <> ) : 'a -> 'a -> bool = "%notequal"
+external ( < ) : 'a -> 'a -> bool = "%lessthan"
+external ( > ) : 'a -> 'a -> bool = "%greaterthan"
+external ( <= ) : 'a -> 'a -> bool = "%lessequal"
+external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
+external compare : 'a -> 'a -> int = "%compare"
+
+let min x y = if x <= y then x else y
+let max x y = if x >= y then x else y
+
+external ( == ) : 'a -> 'a -> bool = "%eq"
+external ( != ) : 'a -> 'a -> bool = "%noteq"
+
+(* Boolean operations *)
+
+external not : bool -> bool = "%boolnot"
+external ( & ) : bool -> bool -> bool = "%sequand"
+external ( && ) : bool -> bool -> bool = "%sequand"
+external ( or ) : bool -> bool -> bool = "%sequor"
+external ( || ) : bool -> bool -> bool = "%sequor"
+
+(* Integer operations *)
+
+external ( ~- ) : int -> int = "%negint"
+external ( ~+ ) : int -> int = "%identity"
+external succ : int -> int = "%succint"
+external pred : int -> int = "%predint"
+external ( + ) : int -> int -> int = "%addint"
+external ( - ) : int -> int -> int = "%subint"
+external ( * ) : int -> int -> int = "%mulint"
+external ( / ) : int -> int -> int = "%divint"
+external ( mod ) : int -> int -> int = "%modint"
+
+let abs x = if x >= 0 then x else -x
+
+external ( land ) : int -> int -> int = "%andint"
+external ( lor ) : int -> int -> int = "%orint"
+external ( lxor ) : int -> int -> int = "%xorint"
+
+let lnot x = x lxor (-1)
+
+external ( lsl ) : int -> int -> int = "%lslint"
+external ( lsr ) : int -> int -> int = "%lsrint"
+external ( asr ) : int -> int -> int = "%asrint"
+
+let max_int = (-1) lsr 1
+let min_int = max_int + 1
+
+(* Floating-point operations *)
+
+external ( ~-. ) : float -> float = "%negfloat"
+external ( ~+. ) : float -> float = "%identity"
+external ( +. ) : float -> float -> float = "%addfloat"
+external ( -. ) : float -> float -> float = "%subfloat"
+external ( *. ) : float -> float -> float = "%mulfloat"
+external ( /. ) : float -> float -> float = "%divfloat"
+external ( ** ) : float -> float -> float = "caml_power_float" "pow"
+  [@@unboxed] [@@noalloc]
+external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc]
+external expm1 : float -> float = "caml_expm1_float" "caml_expm1"
+  [@@unboxed] [@@noalloc]
+external acos : float -> float = "caml_acos_float" "acos"
+  [@@unboxed] [@@noalloc]
+external asin : float -> float = "caml_asin_float" "asin"
+  [@@unboxed] [@@noalloc]
+external atan : float -> float = "caml_atan_float" "atan"
+  [@@unboxed] [@@noalloc]
+external atan2 : float -> float -> float = "caml_atan2_float" "atan2"
+  [@@unboxed] [@@noalloc]
+external hypot : float -> float -> float
+               = "caml_hypot_float" "caml_hypot" [@@unboxed] [@@noalloc]
+external cos : float -> float = "caml_cos_float" "cos" [@@unboxed] [@@noalloc]
+external cosh : float -> float = "caml_cosh_float" "cosh"
+  [@@unboxed] [@@noalloc]
+external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc]
+external log10 : float -> float = "caml_log10_float" "log10"
+  [@@unboxed] [@@noalloc]
+external log1p : float -> float = "caml_log1p_float" "caml_log1p"
+  [@@unboxed] [@@noalloc]
+external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc]
+external sinh : float -> float = "caml_sinh_float" "sinh"
+  [@@unboxed] [@@noalloc]
+external sqrt : float -> float = "caml_sqrt_float" "sqrt"
+  [@@unboxed] [@@noalloc]
+external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc]
+external tanh : float -> float = "caml_tanh_float" "tanh"
+  [@@unboxed] [@@noalloc]
+external ceil : float -> float = "caml_ceil_float" "ceil"
+  [@@unboxed] [@@noalloc]
+external floor : float -> float = "caml_floor_float" "floor"
+  [@@unboxed] [@@noalloc]
+external abs_float : float -> float = "%absfloat"
+external copysign : float -> float -> float
+                  = "caml_copysign_float" "caml_copysign"
+                  [@@unboxed] [@@noalloc]
+external mod_float : float -> float -> float = "caml_fmod_float" "fmod"
+  [@@unboxed] [@@noalloc]
+external frexp : float -> float * int = "caml_frexp_float"
+external ldexp : (float [@unboxed]) -> (int [@untagged]) -> (float [@unboxed]) =
+  "caml_ldexp_float" "caml_ldexp_float_unboxed" [@@noalloc]
+external modf : float -> float * float = "caml_modf_float"
+external float : int -> float = "%floatofint"
+external float_of_int : int -> float = "%floatofint"
+external truncate : float -> int = "%intoffloat"
+external int_of_float : float -> int = "%intoffloat"
+external float_of_bits : int64 -> float
+  = "caml_int64_float_of_bits" "caml_int64_float_of_bits_unboxed"
+  [@@unboxed] [@@noalloc]
+let infinity =
+  float_of_bits 0x7F_F0_00_00_00_00_00_00L
+let neg_infinity =
+  float_of_bits 0xFF_F0_00_00_00_00_00_00L
+let nan =
+  float_of_bits 0x7F_F0_00_00_00_00_00_01L
+let max_float =
+  float_of_bits 0x7F_EF_FF_FF_FF_FF_FF_FFL
+let min_float =
+  float_of_bits 0x00_10_00_00_00_00_00_00L
+let epsilon_float =
+  float_of_bits 0x3C_B0_00_00_00_00_00_00L
+
+type fpclass =
+    FP_normal
+  | FP_subnormal
+  | FP_zero
+  | FP_infinite
+  | FP_nan
+external classify_float : (float [@unboxed]) -> fpclass =
+  "caml_classify_float" "caml_classify_float_unboxed" [@@noalloc]
+
+(* String and byte sequence operations -- more in modules String and Bytes *)
+
+external string_length : string -> int = "%string_length"
+external bytes_length : bytes -> int = "%bytes_length"
+external bytes_create : int -> bytes = "caml_create_bytes"
+external string_blit : string -> int -> bytes -> int -> int -> unit
+                     = "caml_blit_string" [@@noalloc]
+external bytes_blit : bytes -> int -> bytes -> int -> int -> unit
+                        = "caml_blit_bytes" [@@noalloc]
+external bytes_unsafe_to_string : bytes -> string = "%bytes_to_string"
+
+let ( ^ ) s1 s2 =
+  let l1 = string_length s1 and l2 = string_length s2 in
+  let s = bytes_create (l1 + l2) in
+  string_blit s1 0 s 0 l1;
+  string_blit s2 0 s l1 l2;
+  bytes_unsafe_to_string s
+
+(* Character operations -- more in module Char *)
+
+external int_of_char : char -> int = "%identity"
+external unsafe_char_of_int : int -> char = "%identity"
+let char_of_int n =
+  if n < 0 || n > 255 then invalid_arg "char_of_int" else unsafe_char_of_int n
+
+(* Unit operations *)
+
+external ignore : 'a -> unit = "%ignore"
+
+(* Pair operations *)
+
+external fst : 'a * 'b -> 'a = "%field0"
+external snd : 'a * 'b -> 'b = "%field1"
+
+(* References *)
+
+type 'a ref = { mutable contents : 'a }
+external ref : 'a -> 'a ref = "%makemutable"
+external ( ! ) : 'a ref -> 'a = "%field0"
+external ( := ) : 'a ref -> 'a -> unit = "%setfield0"
+external incr : int ref -> unit = "%incr"
+external decr : int ref -> unit = "%decr"
+
+(* Result type *)
+
+type ('a,'b) result = Ok of 'a | Error of 'b
+
+(* String conversion functions *)
+
+external format_int : string -> int -> string = "caml_format_int"
+external format_float : string -> float -> string = "caml_format_float"
+
+let string_of_bool b =
+  if b then "true" else "false"
+let bool_of_string = function
+  | "true" -> true
+  | "false" -> false
+  | _ -> invalid_arg "bool_of_string"
+
+let bool_of_string_opt = function
+  | "true" -> Some true
+  | "false" -> Some false
+  | _ -> None
+
+let string_of_int n =
+  format_int "%d" 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. *)
+  try Some (int_of_string s)
+  with Failure _ -> None
+
+external string_get : string -> int -> char = "%string_safe_get"
+
+let valid_float_lexem s =
+  let l = string_length s in
+  let rec loop i =
+    if i >= l then s ^ "." else
+    match string_get s i with
+    | '0' .. '9' | '-' -> loop (i + 1)
+    | _ -> s
+  in
+  loop 0
+
+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. *)
+  try Some (float_of_string s)
+  with Failure _ -> None
+
+(* List operations -- more in module List *)
+
+let rec ( @ ) l1 l2 =
+  match l1 with
+    [] -> l2
+  | hd :: tl -> hd :: (tl @ l2)
+
+(* I/O operations *)
+
+type in_channel
+type out_channel
+
+external open_descriptor_out : int -> out_channel
+                             = "caml_ml_open_descriptor_out"
+external open_descriptor_in : int -> in_channel = "caml_ml_open_descriptor_in"
+
+let stdin = open_descriptor_in 0
+let stdout = open_descriptor_out 1
+let stderr = open_descriptor_out 2
+
+(* General output functions *)
+
+type open_flag =
+    Open_rdonly | Open_wronly | Open_append
+  | Open_creat | Open_trunc | Open_excl
+  | Open_binary | Open_text | Open_nonblock
+
+external open_desc : string -> open_flag list -> int -> int = "caml_sys_open"
+
+external set_out_channel_name: out_channel -> string -> unit =
+  "caml_ml_set_channel_name"
+
+let open_out_gen mode perm name =
+  let c = open_descriptor_out(open_desc name mode perm) in
+  set_out_channel_name c name;
+  c
+
+let open_out name =
+  open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_text] 0o666 name
+
+let open_out_bin name =
+  open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o666 name
+
+external flush : out_channel -> unit = "caml_ml_flush"
+
+external out_channels_list : unit -> out_channel list
+                           = "caml_ml_out_channels_list"
+
+let flush_all () =
+  let rec iter = function
+      [] -> ()
+    | a::l ->
+        begin try
+            flush a
+        with Sys_error _ ->
+          () (* ignore channels closed during a preceding flush. *)
+        end;
+        iter l
+  in iter (out_channels_list ())
+
+external unsafe_output : out_channel -> bytes -> int -> int -> unit
+                       = "caml_ml_output_bytes"
+external unsafe_output_string : out_channel -> string -> int -> int -> unit
+                              = "caml_ml_output"
+
+external output_char : out_channel -> char -> unit = "caml_ml_output_char"
+
+let output_bytes oc s =
+  unsafe_output oc s 0 (bytes_length s)
+
+let output_string oc s =
+  unsafe_output_string oc s 0 (string_length s)
+
+let output oc s ofs len =
+  if ofs < 0 || len < 0 || ofs > bytes_length s - len
+  then invalid_arg "output"
+  else unsafe_output oc s ofs len
+
+let output_substring oc s ofs len =
+  if ofs < 0 || len < 0 || ofs > string_length s - len
+  then invalid_arg "output_substring"
+  else unsafe_output_string oc s ofs len
+
+external output_byte : out_channel -> int -> unit = "caml_ml_output_char"
+external output_binary_int : out_channel -> int -> unit = "caml_ml_output_int"
+
+external marshal_to_channel : out_channel -> 'a -> unit list -> unit
+     = "caml_output_value"
+let output_value chan v = marshal_to_channel chan v []
+
+external seek_out : out_channel -> int -> unit = "caml_ml_seek_out"
+external pos_out : out_channel -> int = "caml_ml_pos_out"
+external out_channel_length : out_channel -> int = "caml_ml_channel_size"
+external close_out_channel : out_channel -> unit = "caml_ml_close_channel"
+let close_out oc = flush oc; close_out_channel oc
+let close_out_noerr oc =
+  (try flush oc with _ -> ());
+  (try close_out_channel oc with _ -> ())
+external set_binary_mode_out : out_channel -> bool -> unit
+                             = "caml_ml_set_binary_mode"
+
+(* General input functions *)
+
+external set_in_channel_name: in_channel -> string -> unit =
+  "caml_ml_set_channel_name"
+
+let open_in_gen mode perm name =
+  let c = open_descriptor_in(open_desc name mode perm) in
+  set_in_channel_name c name;
+  c
+
+let open_in name =
+  open_in_gen [Open_rdonly; Open_text] 0 name
+
+let open_in_bin name =
+  open_in_gen [Open_rdonly; Open_binary] 0 name
+
+external input_char : in_channel -> char = "caml_ml_input_char"
+
+external unsafe_input : in_channel -> bytes -> int -> int -> int
+                      = "caml_ml_input"
+
+let input ic s ofs len =
+  if ofs < 0 || len < 0 || ofs > bytes_length s - len
+  then invalid_arg "input"
+  else unsafe_input ic s ofs len
+
+let rec unsafe_really_input ic s ofs len =
+  if len <= 0 then () else begin
+    let r = unsafe_input ic s ofs len in
+    if r = 0
+    then raise End_of_file
+    else unsafe_really_input ic s (ofs + r) (len - r)
+  end
+
+let really_input ic s ofs len =
+  if ofs < 0 || len < 0 || ofs > bytes_length s - len
+  then invalid_arg "really_input"
+  else unsafe_really_input ic s ofs len
+
+let really_input_string ic len =
+  let s = bytes_create len in
+  really_input ic s 0 len;
+  bytes_unsafe_to_string s
+
+external input_scan_line : in_channel -> int = "caml_ml_input_scan_line"
+
+let input_line chan =
+  let rec build_result buf pos = function
+    [] -> buf
+  | hd :: tl ->
+      let len = bytes_length hd in
+      bytes_blit hd 0 buf (pos - len) len;
+      build_result buf (pos - len) tl in
+  let rec scan accu len =
+    let n = input_scan_line chan in
+    if n = 0 then begin                   (* n = 0: we are at EOF *)
+      match accu with
+        [] -> raise End_of_file
+      | _  -> build_result (bytes_create len) len accu
+    end else if n > 0 then begin          (* n > 0: newline found in buffer *)
+      let res = bytes_create (n - 1) in
+      ignore (unsafe_input chan res 0 (n - 1));
+      ignore (input_char chan);           (* skip the newline *)
+      match accu with
+        [] -> res
+      |  _ -> let len = len + n - 1 in
+              build_result (bytes_create len) len (res :: accu)
+    end else begin                        (* n < 0: newline not found *)
+      let beg = bytes_create (-n) in
+      ignore(unsafe_input chan beg 0 (-n));
+      scan (beg :: accu) (len - n)
+    end
+  in bytes_unsafe_to_string (scan [] 0)
+
+external input_byte : in_channel -> int = "caml_ml_input_char"
+external input_binary_int : in_channel -> int = "caml_ml_input_int"
+external input_value : in_channel -> 'a = "caml_input_value"
+external seek_in : in_channel -> int -> unit = "caml_ml_seek_in"
+external pos_in : in_channel -> int = "caml_ml_pos_in"
+external in_channel_length : in_channel -> int = "caml_ml_channel_size"
+external close_in : in_channel -> unit = "caml_ml_close_channel"
+let close_in_noerr ic = (try close_in ic with _ -> ())
+external set_binary_mode_in : in_channel -> bool -> unit
+                            = "caml_ml_set_binary_mode"
+
+(* Output functions on standard output *)
+
+let print_char c = output_char stdout c
+let print_string s = output_string stdout s
+let print_bytes s = output_bytes stdout s
+let print_int i = output_string stdout (string_of_int i)
+let print_float f = output_string stdout (string_of_float f)
+let print_endline s =
+  output_string stdout s; output_char stdout '\n'; flush stdout
+let print_newline () = output_char stdout '\n'; flush stdout
+
+(* Output functions on standard error *)
+
+let prerr_char c = output_char stderr c
+let prerr_string s = output_string stderr s
+let prerr_bytes s = output_bytes stderr s
+let prerr_int i = output_string stderr (string_of_int i)
+let prerr_float f = output_string stderr (string_of_float f)
+let prerr_endline s =
+  output_string stderr s; output_char stderr '\n'; flush stderr
+let prerr_newline () = output_char stderr '\n'; flush stderr
+
+(* Input functions on standard input *)
+
+let read_line () = flush stdout; input_line stdin
+let read_int () = int_of_string(read_line())
+let read_int_opt () = int_of_string_opt(read_line())
+let read_float () = float_of_string(read_line())
+let read_float_opt () = float_of_string_opt(read_line())
+
+(* Operations on large files *)
+
+module LargeFile =
+  struct
+    external seek_out : out_channel -> int64 -> unit = "caml_ml_seek_out_64"
+    external pos_out : out_channel -> int64 = "caml_ml_pos_out_64"
+    external out_channel_length : out_channel -> int64
+                                = "caml_ml_channel_size_64"
+    external seek_in : in_channel -> int64 -> unit = "caml_ml_seek_in_64"
+    external pos_in : in_channel -> int64 = "caml_ml_pos_in_64"
+    external in_channel_length : in_channel -> int64 = "caml_ml_channel_size_64"
+  end
+
+(* Formats *)
+
+type ('a, 'b, 'c, 'd, 'e, 'f) format6
+   = ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
+   = Format of ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt
+               * string
+
+type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
+
+type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
+
+let string_of_format (Format (_fmt, str)) = str
+
+external format_of_string :
+ ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+ ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
+
+let ( ^^ ) (Format (fmt1, str1)) (Format (fmt2, str2)) =
+  Format (CamlinternalFormatBasics.concat_fmt fmt1 fmt2,
+          str1 ^ "%," ^ str2)
+
+(* Miscellaneous *)
+
+external sys_exit : int -> 'a = "caml_sys_exit"
+
+let exit_function = ref flush_all
+
+let at_exit f =
+  let g = !exit_function in
+  (* MPR#7253, MPR#7796: make sure "f" is executed only once *)
+  let f_already_ran = ref false in
+  exit_function :=
+    (fun () ->
+      if not !f_already_ran then begin f_already_ran := true; f() end;
+      g())
+
+let do_at_exit () = (!exit_function) ()
+
+let exit retcode =
+  do_at_exit ();
+  sys_exit retcode
+
+let _ = register_named_value "Pervasives.do_at_exit" do_at_exit
+
+(*MODULE_ALIASES*)
+module Arg          = Arg
+module Array        = Array
+module ArrayLabels  = ArrayLabels
+module Bigarray     = Bigarray
+module Bool         = Bool
+module Buffer       = Buffer
+module Bytes        = Bytes
+module BytesLabels  = BytesLabels
+module Callback     = Callback
+module Char         = Char
+module Complex      = Complex
+module Digest       = Digest
+module Ephemeron    = Ephemeron
+module Filename     = Filename
+module Float        = Float
+module Format       = Format
+module Fun          = Fun
+module Gc           = Gc
+module Genlex       = Genlex
+module Hashtbl      = Hashtbl
+module Int          = Int
+module Int32        = Int32
+module Int64        = Int64
+module Lazy         = Lazy
+module Lexing       = Lexing
+module List         = List
+module ListLabels   = ListLabels
+module Map          = Map
+module Marshal      = Marshal
+module MoreLabels   = MoreLabels
+module Nativeint    = Nativeint
+module Obj          = Obj
+module Oo           = Oo
+module Option       = Option
+module Parsing      = Parsing
+module Pervasives   = Pervasives
+module Printexc     = Printexc
+module Printf       = Printf
+module Queue        = Queue
+module Random       = Random
+module Result       = Result
+module Scanf        = Scanf
+module Seq          = Seq
+module Set          = Set
+module Spacetime    = Spacetime
+module Stack        = Stack
+module StdLabels    = StdLabels
+module Stream       = Stream
+module String       = String
+module StringLabels = StringLabels
+module Sys          = Sys
+module Uchar        = Uchar
+module Unit         = Unit
+module Weak         = Weak
diff --git a/stdlib/stdlib.mli b/stdlib/stdlib.mli
new file mode 100644
index 00000000..c16acb51
--- /dev/null
+++ b/stdlib/stdlib.mli
@@ -0,0 +1,1388 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The OCaml Standard library.
+
+    This module is automatically opened at the beginning of each
+    compilation. All components of this module can therefore be
+    referred by their short name, without prefixing them by [Stdlib].
+
+    It particular, it provides the basic operations over the built-in
+    types (numbers, booleans, byte sequences, strings, exceptions,
+    references, lists, arrays, input-output channels, ...) and the
+    {{!modules}standard library modules}.
+*)
+
+(** {1 Exceptions} *)
+
+external raise : exn -> 'a = "%raise"
+(** Raise the given exception value *)
+
+external raise_notrace : exn -> 'a = "%raise_notrace"
+(** A faster version [raise] which does not record the backtrace.
+    @since 4.02.0
+*)
+
+val invalid_arg : string -> 'a
+(** Raise exception [Invalid_argument] with the given string. *)
+
+val failwith : string -> 'a
+(** Raise exception [Failure] with the given string. *)
+
+exception Exit
+(** The [Exit] exception is not raised by any library function.  It is
+    provided for use in your programs. *)
+
+exception Match_failure of (string * int * int)
+  [@ocaml.warn_on_literal_pattern]
+(** Exception raised when none of the cases of a pattern-matching
+   apply. The arguments are the location of the match keyword in the
+   source code (file name, line number, column number). *)
+
+exception Assert_failure of (string * int * int)
+  [@ocaml.warn_on_literal_pattern]
+(** Exception raised when an assertion fails. The arguments are the
+   location of the assert keyword in the source code (file name, line
+   number, column number). *)
+
+exception Invalid_argument of string
+  [@ocaml.warn_on_literal_pattern]
+(** Exception raised by library functions to signal that the given
+   arguments do not make sense. The string gives some information to
+   the programmer. As a general rule, this exception should not be
+   caught, it denotes a programming error and the code should be
+   modified not to trigger it. *)
+
+exception Failure of string
+  [@ocaml.warn_on_literal_pattern]
+(** Exception raised by library functions to signal that they are
+   undefined on the given arguments. The string is meant to give some
+   information to the programmer; you must not pattern match on the
+   string literal because it may change in future versions (use
+   Failure _ instead). *)
+
+exception Not_found
+(** Exception raised by search functions when the desired object could
+   not be found. *)
+
+exception Out_of_memory
+(** Exception raised by the garbage collector when there is
+   insufficient memory to complete the computation. (Not reliable for
+   allocations on the minor heap.) *)
+
+exception Stack_overflow
+(** Exception raised by the bytecode interpreter when the evaluation
+   stack reaches its maximal size. This often indicates infinite or
+   excessively deep recursion in the user's program.
+
+   Before 4.10, it was not fully implemented by the native-code
+   compiler. *)
+
+exception Sys_error of string
+  [@ocaml.warn_on_literal_pattern]
+(** Exception raised by the input/output functions to report an
+   operating system error. The string is meant to give some
+   information to the programmer; you must not pattern match on the
+   string literal because it may change in future versions (use
+   Sys_error _ instead). *)
+
+exception End_of_file
+(** Exception raised by input functions to signal that the end of file
+   has been reached. *)
+
+exception Division_by_zero
+(** Exception raised by integer division and remainder operations when
+   their second argument is zero. *)
+
+exception Sys_blocked_io
+(** A special case of Sys_error raised when no I/O is possible on a
+   non-blocking I/O channel. *)
+
+exception Undefined_recursive_module of (string * int * int)
+  [@ocaml.warn_on_literal_pattern]
+(** Exception raised when an ill-founded recursive module definition
+   is evaluated. The arguments are the location of the definition in
+   the source code (file name, line number, column number). *)
+
+(** {1 Comparisons} *)
+
+external ( = ) : 'a -> 'a -> bool = "%equal"
+(** [e1 = e2] tests for structural equality of [e1] and [e2].
+   Mutable structures (e.g. references and arrays) are equal
+   if and only if their current contents are structurally equal,
+   even if the two mutable objects are not the same physical object.
+   Equality between functional values raises [Invalid_argument].
+   Equality between cyclic data structures may not terminate.
+   Left-associative operator, see {!Ocaml_operators} for more information. *)
+
+external ( <> ) : 'a -> 'a -> bool = "%notequal"
+(** Negation of {!Stdlib.( = )}.
+    Left-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external ( < ) : 'a -> 'a -> bool = "%lessthan"
+(** See {!Stdlib.( >= )}.
+    Left-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external ( > ) : 'a -> 'a -> bool = "%greaterthan"
+(** See {!Stdlib.( >= )}.
+    Left-associative operator,  see {!Ocaml_operators} for more information.
+*)
+
+external ( <= ) : 'a -> 'a -> bool = "%lessequal"
+(** See {!Stdlib.( >= )}.
+    Left-associative operator,  see {!Ocaml_operators} for more information.
+*)
+
+external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
+(** Structural ordering functions. These functions coincide with
+   the usual orderings over integers, characters, strings, byte sequences
+   and floating-point numbers, and extend them to a
+   total ordering over all types.
+   The ordering is compatible with [( = )]. As in the case
+   of [( = )], mutable structures are compared by contents.
+   Comparison between functional values raises [Invalid_argument].
+   Comparison between cyclic structures may not terminate.
+   Left-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external compare : 'a -> 'a -> int = "%compare"
+(** [compare x y] returns [0] if [x] is equal to [y],
+   a negative integer if [x] is less than [y], and a positive integer
+   if [x] is greater than [y].  The ordering implemented by [compare]
+   is compatible with the comparison predicates [=], [<] and [>]
+   defined above,  with one difference on the treatment of the float value
+   {!Stdlib.nan}.  Namely, the comparison predicates treat [nan]
+   as different from any other float value, including itself;
+   while [compare] treats [nan] as equal to itself and less than any
+   other float value.  This treatment of [nan] ensures that [compare]
+   defines a total ordering relation.
+
+   [compare] applied to functional values may raise [Invalid_argument].
+   [compare] applied to cyclic structures may not terminate.
+
+   The [compare] function can be used as the comparison function
+   required by the {!Set.Make} and {!Map.Make} functors, as well as
+   the {!List.sort} and {!Array.sort} functions. *)
+
+val min : 'a -> 'a -> 'a
+(** Return the smaller of the two arguments.
+    The result is unspecified if one of the arguments contains
+    the float value [nan]. *)
+
+val max : 'a -> 'a -> 'a
+(** Return the greater of the two arguments.
+    The result is unspecified if one of the arguments contains
+    the float value [nan]. *)
+
+external ( == ) : 'a -> 'a -> bool = "%eq"
+(** [e1 == e2] tests for physical equality of [e1] and [e2].
+   On mutable types such as references, arrays, byte sequences, records with
+   mutable fields and objects with mutable instance variables,
+   [e1 == e2] is true if and only if physical modification of [e1]
+   also affects [e2].
+   On non-mutable types, the behavior of [( == )] is
+   implementation-dependent; however, it is guaranteed that
+   [e1 == e2] implies [compare e1 e2 = 0].
+   Left-associative operator,  see {!Ocaml_operators} for more information.
+*)
+
+external ( != ) : 'a -> 'a -> bool = "%noteq"
+(** Negation of {!Stdlib.( == )}.
+    Left-associative operator,  see {!Ocaml_operators} for more information.
+*)
+
+
+(** {1 Boolean operations} *)
+
+external not : bool -> bool = "%boolnot"
+(** The boolean negation. *)
+
+external ( && ) : bool -> bool -> bool = "%sequand"
+(** The boolean 'and'. Evaluation is sequential, left-to-right:
+   in [e1 && e2], [e1] is evaluated first, and if it returns [false],
+   [e2] is not evaluated at all.
+   Right-associative operator,  see {!Ocaml_operators} for more information.
+*)
+
+external ( & ) : bool -> bool -> bool = "%sequand"
+  [@@ocaml.deprecated "Use (&&) instead."]
+(** @deprecated {!Stdlib.( && )} should be used instead.
+    Right-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external ( || ) : bool -> bool -> bool = "%sequor"
+(** The boolean 'or'. Evaluation is sequential, left-to-right:
+   in [e1 || e2], [e1] is evaluated first, and if it returns [true],
+   [e2] is not evaluated at all.
+   Right-associative operator,  see {!Ocaml_operators} for more information.
+*)
+
+external ( or ) : bool -> bool -> bool = "%sequor"
+  [@@ocaml.deprecated "Use (||) instead."]
+(** @deprecated {!Stdlib.( || )} should be used instead.
+    Right-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+(** {1 Debugging} *)
+
+external __LOC__ : string = "%loc_LOC"
+(** [__LOC__] returns the location at which this expression appears in
+    the file currently being parsed by the compiler, with the standard
+    error format of OCaml: "File %S, line %d, characters %d-%d".
+    @since 4.02.0
+*)
+
+external __FILE__ : string = "%loc_FILE"
+(** [__FILE__] returns the name of the file currently being
+    parsed by the compiler.
+    @since 4.02.0
+*)
+
+external __LINE__ : int = "%loc_LINE"
+(** [__LINE__] returns the line number at which this expression
+    appears in the file currently being parsed by the compiler.
+    @since 4.02.0
+*)
+
+external __MODULE__ : string = "%loc_MODULE"
+(** [__MODULE__] returns the module name of the file being
+    parsed by the compiler.
+    @since 4.02.0
+*)
+
+external __POS__ : string * int * int * int = "%loc_POS"
+(** [__POS__] returns a tuple [(file,lnum,cnum,enum)], corresponding
+    to the location at which this expression appears in the file
+    currently being parsed by the compiler. [file] is the current
+    filename, [lnum] the line number, [cnum] the character position in
+    the line and [enum] the last character position in the line.
+    @since 4.02.0
+ *)
+
+external __LOC_OF__ : 'a -> string * 'a = "%loc_LOC"
+(** [__LOC_OF__ expr] returns a pair [(loc, expr)] where [loc] is the
+    location of [expr] in the file currently being parsed by the
+    compiler, with the standard error format of OCaml: "File %S, line
+    %d, characters %d-%d".
+    @since 4.02.0
+*)
+
+external __LINE_OF__ : 'a -> int * 'a = "%loc_LINE"
+(** [__LINE_OF__ expr] returns a pair [(line, expr)], where [line] is the
+    line number at which the expression [expr] appears in the file
+    currently being parsed by the compiler.
+    @since 4.02.0
+ *)
+
+external __POS_OF__ : 'a -> (string * int * int * int) * 'a = "%loc_POS"
+(** [__POS_OF__ expr] returns a pair [(loc,expr)], where [loc] is a
+    tuple [(file,lnum,cnum,enum)] corresponding to the location at
+    which the expression [expr] appears in the file currently being
+    parsed by the compiler. [file] is the current filename, [lnum] the
+    line number, [cnum] the character position in the line and [enum]
+    the last character position in the line.
+    @since 4.02.0
+ *)
+
+(** {1 Composition operators} *)
+
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+(** Reverse-application operator: [x |> f |> g] is exactly equivalent
+ to [g (f (x))].
+ Left-associative operator, see {!Ocaml_operators} for more information.
+ @since 4.01
+*)
+
+external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
+(** Application operator: [g @@ f @@ x] is exactly equivalent to
+ [g (f (x))].
+ Right-associative operator, see {!Ocaml_operators} for more information.
+ @since 4.01
+*)
+
+(** {1 Integer arithmetic} *)
+
+(** Integers are [Sys.int_size] bits wide.
+    All operations are taken modulo 2{^[Sys.int_size]}.
+    They do not fail on overflow. *)
+
+external ( ~- ) : int -> int = "%negint"
+(** Unary negation. You can also write [- e] instead of [~- e].
+    Unary operator, see {!Ocaml_operators} for more information.
+*)
+
+
+external ( ~+ ) : int -> int = "%identity"
+(** Unary addition. You can also write [+ e] instead of [~+ e].
+    Unary operator, see {!Ocaml_operators} for more information.
+    @since 3.12.0
+*)
+
+external succ : int -> int = "%succint"
+(** [succ x] is [x + 1]. *)
+
+external pred : int -> int = "%predint"
+(** [pred x] is [x - 1]. *)
+
+external ( + ) : int -> int -> int = "%addint"
+(** Integer addition.
+    Left-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external ( - ) : int -> int -> int = "%subint"
+(** Integer subtraction.
+    Left-associative operator, , see {!Ocaml_operators} for more information.
+*)
+
+external ( * ) : int -> int -> int = "%mulint"
+(** Integer multiplication.
+    Left-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external ( / ) : int -> int -> int = "%divint"
+(** Integer division.
+   Integer division rounds the real quotient of its arguments towards zero.
+   More precisely, if [x >= 0] and [y > 0], [x / y] is the greatest integer
+   less than or equal to the real quotient of [x] by [y].  Moreover,
+   [(- x) / y = x / (- y) = - (x / y)].
+   Left-associative operator, see {!Ocaml_operators} for more information.
+
+   @raise Division_by_zero if the second argument is 0.
+*)
+
+external ( mod ) : int -> int -> int = "%modint"
+(** Integer remainder.  If [y] is not zero, the result
+   of [x mod y] satisfies the following properties:
+   [x = (x / y) * y + x mod y] and
+   [abs(x mod y) <= abs(y) - 1].
+   If [y = 0], [x mod y] raises [Division_by_zero].
+   Note that [x mod y] is negative only if [x < 0].
+   Left-associative operator, see {!Ocaml_operators} for more information.
+
+   @raise Division_by_zero if [y] is zero.
+*)
+
+val abs : int -> int
+(** Return the absolute value of the argument.  Note that this may be
+  negative if the argument is [min_int]. *)
+
+val max_int : int
+(** The greatest representable integer. *)
+
+val min_int : int
+(** The smallest representable integer. *)
+
+
+(** {2 Bitwise operations} *)
+
+external ( land ) : int -> int -> int = "%andint"
+(** Bitwise logical and.
+    Left-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external ( lor ) : int -> int -> int = "%orint"
+(** Bitwise logical or.
+    Left-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external ( lxor ) : int -> int -> int = "%xorint"
+(** Bitwise logical exclusive or.
+    Left-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+val lnot : int -> int
+(** Bitwise logical negation. *)
+
+external ( lsl ) : int -> int -> int = "%lslint"
+(** [n lsl m] shifts [n] to the left by [m] bits.
+    The result is unspecified if [m < 0] or [m > Sys.int_size].
+    Right-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external ( lsr ) : int -> int -> int = "%lsrint"
+(** [n lsr m] shifts [n] to the right by [m] bits.
+    This is a logical shift: zeroes are inserted regardless of
+    the sign of [n].
+    The result is unspecified if [m < 0] or [m > Sys.int_size].
+    Right-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external ( asr ) : int -> int -> int = "%asrint"
+(** [n asr m] shifts [n] to the right by [m] bits.
+    This is an arithmetic shift: the sign bit of [n] is replicated.
+    The result is unspecified if [m < 0] or [m > Sys.int_size].
+    Right-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+(** {1 Floating-point arithmetic}
+
+   OCaml's floating-point numbers follow the
+   IEEE 754 standard, using double precision (64 bits) numbers.
+   Floating-point operations never raise an exception on overflow,
+   underflow, division by zero, etc.  Instead, special IEEE numbers
+   are returned as appropriate, such as [infinity] for [1.0 /. 0.0],
+   [neg_infinity] for [-1.0 /. 0.0], and [nan] ('not a number')
+   for [0.0 /. 0.0].  These special numbers then propagate through
+   floating-point computations as expected: for instance,
+   [1.0 /. infinity] is [0.0], and any arithmetic operation with [nan]
+   as argument returns [nan] as result.
+*)
+
+external ( ~-. ) : float -> float = "%negfloat"
+(** Unary negation. You can also write [-. e] instead of [~-. e].
+    Unary operator, see {!Ocaml_operators} for more information.
+*)
+
+external ( ~+. ) : float -> float = "%identity"
+(** Unary addition. You can also write [+. e] instead of [~+. e].
+    Unary operator, see {!Ocaml_operators} for more information.
+    @since 3.12.0
+*)
+
+external ( +. ) : float -> float -> float = "%addfloat"
+(** Floating-point addition.
+    Left-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external ( -. ) : float -> float -> float = "%subfloat"
+(** Floating-point subtraction.
+    Left-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external ( *. ) : float -> float -> float = "%mulfloat"
+(** Floating-point multiplication.
+    Left-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external ( /. ) : float -> float -> float = "%divfloat"
+(** Floating-point division.
+    Left-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external ( ** ) : float -> float -> float = "caml_power_float" "pow"
+  [@@unboxed] [@@noalloc]
+(** Exponentiation.
+    Right-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external sqrt : float -> float = "caml_sqrt_float" "sqrt"
+  [@@unboxed] [@@noalloc]
+(** Square root. *)
+
+external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc]
+(** Exponential. *)
+
+external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc]
+(** Natural logarithm. *)
+
+external log10 : float -> float = "caml_log10_float" "log10"
+  [@@unboxed] [@@noalloc]
+(** Base 10 logarithm. *)
+
+external expm1 : float -> float = "caml_expm1_float" "caml_expm1"
+  [@@unboxed] [@@noalloc]
+(** [expm1 x] computes [exp x -. 1.0], giving numerically-accurate results
+    even if [x] is close to [0.0].
+    @since 3.12.0
+*)
+
+external log1p : float -> float = "caml_log1p_float" "caml_log1p"
+  [@@unboxed] [@@noalloc]
+(** [log1p x] computes [log(1.0 +. x)] (natural logarithm),
+    giving numerically-accurate results even if [x] is close to [0.0].
+    @since 3.12.0
+*)
+
+external cos : float -> float = "caml_cos_float" "cos" [@@unboxed] [@@noalloc]
+(** Cosine.  Argument is in radians. *)
+
+external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc]
+(** Sine.  Argument is in radians. *)
+
+external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc]
+(** Tangent.  Argument is in radians. *)
+
+external acos : float -> float = "caml_acos_float" "acos"
+  [@@unboxed] [@@noalloc]
+(** Arc cosine.  The argument must fall within the range [[-1.0, 1.0]].
+    Result is in radians and is between [0.0] and [pi]. *)
+
+external asin : float -> float = "caml_asin_float" "asin"
+  [@@unboxed] [@@noalloc]
+(** Arc sine.  The argument must fall within the range [[-1.0, 1.0]].
+    Result is in radians and is between [-pi/2] and [pi/2]. *)
+
+external atan : float -> float = "caml_atan_float" "atan"
+  [@@unboxed] [@@noalloc]
+(** Arc tangent.
+    Result is in radians and is between [-pi/2] and [pi/2]. *)
+
+external atan2 : float -> float -> float = "caml_atan2_float" "atan2"
+  [@@unboxed] [@@noalloc]
+(** [atan2 y x] returns the arc tangent of [y /. x].  The signs of [x]
+    and [y] are used to determine the quadrant of the result.
+    Result is in radians and is between [-pi] and [pi]. *)
+
+external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot"
+  [@@unboxed] [@@noalloc]
+(** [hypot x y] returns [sqrt(x *. x + y *. y)], that is, the length
+  of the hypotenuse of a right-angled triangle with sides of length
+  [x] and [y], or, equivalently, the distance of the point [(x,y)]
+  to origin.  If one of [x] or [y] is infinite, returns [infinity]
+  even if the other is [nan].
+  @since 4.00.0  *)
+
+external cosh : float -> float = "caml_cosh_float" "cosh"
+  [@@unboxed] [@@noalloc]
+(** Hyperbolic cosine.  Argument is in radians. *)
+
+external sinh : float -> float = "caml_sinh_float" "sinh"
+  [@@unboxed] [@@noalloc]
+(** Hyperbolic sine.  Argument is in radians. *)
+
+external tanh : float -> float = "caml_tanh_float" "tanh"
+  [@@unboxed] [@@noalloc]
+(** Hyperbolic tangent.  Argument is in radians. *)
+
+external ceil : float -> float = "caml_ceil_float" "ceil"
+  [@@unboxed] [@@noalloc]
+(** Round above to an integer value.
+    [ceil f] returns the least integer value greater than or equal to [f].
+    The result is returned as a float. *)
+
+external floor : float -> float = "caml_floor_float" "floor"
+  [@@unboxed] [@@noalloc]
+(** Round below to an integer value.
+    [floor f] returns the greatest integer value less than or
+    equal to [f].
+    The result is returned as a float. *)
+
+external abs_float : float -> float = "%absfloat"
+(** [abs_float f] returns the absolute value of [f]. *)
+
+external copysign : float -> float -> float
+                  = "caml_copysign_float" "caml_copysign"
+                  [@@unboxed] [@@noalloc]
+(** [copysign x y] returns a float whose absolute value is that of [x]
+  and whose sign is that of [y].  If [x] is [nan], returns [nan].
+  If [y] is [nan], returns either [x] or [-. x], but it is not
+  specified which.
+  @since 4.00.0  *)
+
+external mod_float : float -> float -> float = "caml_fmod_float" "fmod"
+  [@@unboxed] [@@noalloc]
+(** [mod_float a b] returns the remainder of [a] with respect to
+   [b].  The returned value is [a -. n *. b], where [n]
+   is the quotient [a /. b] rounded towards zero to an integer. *)
+
+external frexp : float -> float * int = "caml_frexp_float"
+(** [frexp f] returns the pair of the significant
+   and the exponent of [f].  When [f] is zero, the
+   significant [x] and the exponent [n] of [f] are equal to
+   zero.  When [f] is non-zero, they are defined by
+   [f = x *. 2 ** n] and [0.5 <= x < 1.0]. *)
+
+
+external ldexp : (float [@unboxed]) -> (int [@untagged]) -> (float [@unboxed]) =
+  "caml_ldexp_float" "caml_ldexp_float_unboxed" [@@noalloc]
+(** [ldexp x n] returns [x *. 2 ** n]. *)
+
+external modf : float -> float * float = "caml_modf_float"
+(** [modf f] returns the pair of the fractional and integral
+   part of [f]. *)
+
+external float : int -> float = "%floatofint"
+(** Same as {!Stdlib.float_of_int}. *)
+
+external float_of_int : int -> float = "%floatofint"
+(** Convert an integer to floating-point. *)
+
+external truncate : float -> int = "%intoffloat"
+(** Same as {!Stdlib.int_of_float}. *)
+
+external int_of_float : float -> int = "%intoffloat"
+(** Truncate the given floating-point number to an integer.
+   The result is unspecified if the argument is [nan] or falls outside the
+   range of representable integers. *)
+
+val infinity : float
+(** Positive infinity. *)
+
+val neg_infinity : float
+(** Negative infinity. *)
+
+val nan : float
+(** A special floating-point value denoting the result of an
+   undefined operation such as [0.0 /. 0.0].  Stands for
+   'not a number'.  Any floating-point operation with [nan] as
+   argument returns [nan] as result.  As for floating-point comparisons,
+   [=], [<], [<=], [>] and [>=] return [false] and [<>] returns [true]
+   if one or both of their arguments is [nan]. *)
+
+val max_float : float
+(** The largest positive finite value of type [float]. *)
+
+val min_float : float
+(** The smallest positive, non-zero, non-denormalized value of type [float]. *)
+
+val epsilon_float : float
+(** The difference between [1.0] and the smallest exactly representable
+    floating-point number greater than [1.0]. *)
+
+type fpclass =
+    FP_normal           (** Normal number, none of the below *)
+  | FP_subnormal        (** Number very close to 0.0, has reduced precision *)
+  | FP_zero             (** Number is 0.0 or -0.0 *)
+  | FP_infinite         (** Number is positive or negative infinity *)
+  | FP_nan              (** Not a number: result of an undefined operation *)
+(** The five classes of floating-point numbers, as determined by
+   the {!Stdlib.classify_float} function. *)
+
+external classify_float : (float [@unboxed]) -> fpclass =
+  "caml_classify_float" "caml_classify_float_unboxed" [@@noalloc]
+(** Return the class of the given floating-point number:
+   normal, subnormal, zero, infinite, or not a number. *)
+
+
+(** {1 String operations}
+
+   More string operations are provided in module {!String}.
+*)
+
+val ( ^ ) : string -> string -> string
+(** String concatenation.
+    Right-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+(** {1 Character operations}
+
+   More character operations are provided in module {!Char}.
+*)
+
+external int_of_char : char -> int = "%identity"
+(** Return the ASCII code of the argument. *)
+
+val char_of_int : int -> char
+(** Return the character with the given ASCII code.
+   @raise Invalid_argument if the argument is
+   outside the range 0--255. *)
+
+
+(** {1 Unit operations} *)
+
+external ignore : 'a -> unit = "%ignore"
+(** Discard the value of its argument and return [()].
+   For instance, [ignore(f x)] discards the result of
+   the side-effecting function [f].  It is equivalent to
+   [f x; ()], except that the latter may generate a
+   compiler warning; writing [ignore(f x)] instead
+   avoids the warning. *)
+
+
+(** {1 String conversion functions} *)
+
+val string_of_bool : bool -> string
+(** Return the string representation of a boolean. As the returned values
+   may be shared, the user should not modify them directly.
+*)
+
+val bool_of_string_opt: string -> bool option
+(** Convert the given string to a boolean.
+
+   Return [None] if the string is not ["true"] or ["false"].
+   @since 4.05
+*)
+
+val bool_of_string : string -> bool
+(** Same as {!Stdlib.bool_of_string_opt}, but raise
+   [Invalid_argument "bool_of_string"] instead of returning [None]. *)
+
+val string_of_int : int -> string
+(** Return the string representation of an integer, in decimal. *)
+
+val int_of_string_opt: string -> int option
+(** Convert the given string to an integer.
+   The string is read in decimal (by default, or if the string
+   begins with [0u]), in hexadecimal (if it begins with [0x] or
+   [0X]), in octal (if it begins with [0o] or [0O]), or in binary
+   (if it begins with [0b] or [0B]).
+
+   The [0u] prefix reads the input as an unsigned integer in the range
+   [[0, 2*max_int+1]].  If the input exceeds {!max_int}
+   it is converted to the signed integer
+   [min_int + input - max_int - 1].
+
+   The [_] (underscore) character can appear anywhere in the string
+   and is ignored.
+
+   Return [None] if the given string is not a valid representation of an
+   integer, or if the integer represented exceeds the range of integers
+   representable in type [int].
+   @since 4.05
+*)
+
+external int_of_string : string -> int = "caml_int_of_string"
+(** Same as {!Stdlib.int_of_string_opt}, but raise
+   [Failure "int_of_string"] instead of returning [None]. *)
+
+val string_of_float : float -> string
+(** Return the string representation of a floating-point number. *)
+
+val float_of_string_opt: string -> float option
+(** Convert the given string to a float.  The string is read in decimal
+   (by default) or in hexadecimal (marked by [0x] or [0X]).
+
+   The format of decimal floating-point numbers is
+   [ [-] dd.ddd (e|E) [+|-] dd ], where [d] stands for a decimal digit.
+
+   The format of hexadecimal floating-point numbers is
+   [ [-] 0(x|X) hh.hhh (p|P) [+|-] dd ], where [h] stands for an
+   hexadecimal digit and [d] for a decimal digit.
+
+   In both cases, at least one of the integer and fractional parts must be
+   given; the exponent part is optional.
+
+   The [_] (underscore) character can appear anywhere in the string
+   and is ignored.
+
+   Depending on the execution platforms, other representations of
+   floating-point numbers can be accepted, but should not be relied upon.
+
+   Return [None] if the given string is not a valid representation of a float.
+   @since 4.05
+*)
+
+external float_of_string : string -> float = "caml_float_of_string"
+(** Same as {!Stdlib.float_of_string_opt}, but raise
+   [Failure "float_of_string"] instead of returning [None]. *)
+
+(** {1 Pair operations} *)
+
+external fst : 'a * 'b -> 'a = "%field0"
+(** Return the first component of a pair. *)
+
+external snd : 'a * 'b -> 'b = "%field1"
+(** Return the second component of a pair. *)
+
+
+(** {1 List operations}
+
+   More list operations are provided in module {!List}.
+*)
+
+val ( @ ) : 'a list -> 'a list -> 'a list
+(** List concatenation.  Not tail-recursive (length of the first argument).
+  Right-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+(** {1 Input/output}
+    Note: all input/output functions can raise [Sys_error] when the system
+    calls they invoke fail. *)
+
+type in_channel
+(** The type of input channel. *)
+
+type out_channel
+(** The type of output channel. *)
+
+val stdin : in_channel
+(** The standard input for the process. *)
+
+val stdout : out_channel
+(** The standard output for the process. *)
+
+val stderr : out_channel
+(** The standard error output for the process. *)
+
+
+(** {2 Output functions on standard output} *)
+
+val print_char : char -> unit
+(** Print a character on standard output. *)
+
+val print_string : string -> unit
+(** Print a string on standard output. *)
+
+val print_bytes : bytes -> unit
+(** Print a byte sequence on standard output.
+   @since 4.02.0 *)
+
+val print_int : int -> unit
+(** Print an integer, in decimal, on standard output. *)
+
+val print_float : float -> unit
+(** Print a floating-point number, in decimal, on standard output. *)
+
+val print_endline : string -> unit
+(** Print a string, followed by a newline character, on
+   standard output and flush standard output. *)
+
+val print_newline : unit -> unit
+(** Print a newline character on standard output, and flush
+   standard output. This can be used to simulate line
+   buffering of standard output. *)
+
+
+(** {2 Output functions on standard error} *)
+
+val prerr_char : char -> unit
+(** Print a character on standard error. *)
+
+val prerr_string : string -> unit
+(** Print a string on standard error. *)
+
+val prerr_bytes : bytes -> unit
+(** Print a byte sequence on standard error.
+   @since 4.02.0 *)
+
+val prerr_int : int -> unit
+(** Print an integer, in decimal, on standard error. *)
+
+val prerr_float : float -> unit
+(** Print a floating-point number, in decimal, on standard error. *)
+
+val prerr_endline : string -> unit
+(** Print a string, followed by a newline character on standard
+   error and flush standard error. *)
+
+val prerr_newline : unit -> unit
+(** Print a newline character on standard error, and flush
+   standard error. *)
+
+
+(** {2 Input functions on standard input} *)
+
+val read_line : unit -> string
+(** Flush standard output, then read characters from standard input
+   until a newline character is encountered. Return the string of
+   all characters read, without the newline character at the end. *)
+
+val read_int_opt: unit -> int option
+(** Flush standard output, then read one line from standard input
+   and convert it to an integer.
+
+   Return [None] if the line read is not a valid representation of an integer.
+   @since 4.05
+*)
+
+val read_int : unit -> int
+(** Same as {!Stdlib.read_int_opt}, but raise [Failure "int_of_string"]
+   instead of returning [None]. *)
+
+val read_float_opt: unit -> float option
+(** Flush standard output, then read one line from standard input
+   and convert it to a floating-point number.
+
+   Return [None] if the line read is not a valid representation of a
+   floating-point number.
+   @since 4.05.0
+*)
+
+val read_float : unit -> float
+(** Same as {!Stdlib.read_float_opt}, but raise [Failure "float_of_string"]
+   instead of returning [None]. *)
+
+
+(** {2 General output functions} *)
+
+type open_flag =
+    Open_rdonly      (** open for reading. *)
+  | Open_wronly      (** open for writing. *)
+  | Open_append      (** open for appending: always write at end of file. *)
+  | Open_creat       (** create the file if it does not exist. *)
+  | Open_trunc       (** empty the file if it already exists. *)
+  | Open_excl        (** fail if Open_creat and the file already exists. *)
+  | Open_binary      (** open in binary mode (no conversion). *)
+  | Open_text        (** open in text mode (may perform conversions). *)
+  | Open_nonblock    (** open in non-blocking mode. *)
+(** Opening modes for {!Stdlib.open_out_gen} and
+  {!Stdlib.open_in_gen}. *)
+
+val open_out : string -> out_channel
+(** Open the named file for writing, and return a new output channel
+   on that file, positioned at the beginning of the file. The
+   file is truncated to zero length if it already exists. It
+   is created if it does not already exists. *)
+
+val open_out_bin : string -> out_channel
+(** Same as {!Stdlib.open_out}, but the file is opened in binary mode,
+   so that no translation takes place during writes. On operating
+   systems that do not distinguish between text mode and binary
+   mode, this function behaves like {!Stdlib.open_out}. *)
+
+val open_out_gen : open_flag list -> int -> string -> out_channel
+(** [open_out_gen mode perm filename] opens the named file for writing,
+   as described above. The extra argument [mode]
+   specifies the opening mode. The extra argument [perm] specifies
+   the file permissions, in case the file must be created.
+   {!Stdlib.open_out} and {!Stdlib.open_out_bin} are special
+   cases of this function. *)
+
+val flush : out_channel -> unit
+(** Flush the buffer associated with the given output channel,
+   performing all pending writes on that channel.
+   Interactive programs must be careful about flushing standard
+   output and standard error at the right time. *)
+
+val flush_all : unit -> unit
+(** Flush all open output channels; ignore errors. *)
+
+val output_char : out_channel -> char -> unit
+(** Write the character on the given output channel. *)
+
+val output_string : out_channel -> string -> unit
+(** Write the string on the given output channel. *)
+
+val output_bytes : out_channel -> bytes -> unit
+(** Write the byte sequence on the given output channel.
+   @since 4.02.0 *)
+
+val output : out_channel -> bytes -> int -> int -> unit
+(** [output oc buf pos len] writes [len] characters from byte sequence [buf],
+   starting at offset [pos], to the given output channel [oc].
+   @raise Invalid_argument if [pos] and [len] do not
+   designate a valid range of [buf]. *)
+
+val output_substring : out_channel -> string -> int -> int -> unit
+(** Same as [output] but take a string as argument instead of
+   a byte sequence.
+   @since 4.02.0 *)
+
+val output_byte : out_channel -> int -> unit
+(** Write one 8-bit integer (as the single character with that code)
+   on the given output channel. The given integer is taken modulo
+   256. *)
+
+val output_binary_int : out_channel -> int -> unit
+(** Write one integer in binary format (4 bytes, big-endian)
+   on the given output channel.
+   The given integer is taken modulo 2{^32}.
+   The only reliable way to read it back is through the
+   {!Stdlib.input_binary_int} function. The format is compatible across
+   all machines for a given version of OCaml. *)
+
+val output_value : out_channel -> 'a -> unit
+(** Write the representation of a structured value of any type
+   to a channel. Circularities and sharing inside the value
+   are detected and preserved. The object can be read back,
+   by the function {!Stdlib.input_value}. See the description of module
+   {!Marshal} for more information. {!Stdlib.output_value} is equivalent
+   to {!Marshal.to_channel} with an empty list of flags. *)
+
+val seek_out : out_channel -> int -> unit
+(** [seek_out chan pos] sets the current writing position to [pos]
+   for channel [chan]. This works only for regular files. On
+   files of other kinds (such as terminals, pipes and sockets),
+   the behavior is unspecified. *)
+
+val pos_out : out_channel -> int
+(** Return the current writing position for the given channel.  Does
+    not work on channels opened with the [Open_append] flag (returns
+    unspecified results). *)
+
+val out_channel_length : out_channel -> int
+(** Return the size (number of characters) of the regular file
+   on which the given channel is opened.  If the channel is opened
+    on a file that is not a regular file, the result is meaningless. *)
+
+val close_out : out_channel -> unit
+(** Close the given channel, flushing all buffered write operations.
+   Output functions raise a [Sys_error] exception when they are
+   applied to a closed output channel, except [close_out] and [flush],
+   which do nothing when applied to an already closed channel.
+   Note that [close_out] may raise [Sys_error] if the operating
+   system signals an error when flushing or closing. *)
+
+val close_out_noerr : out_channel -> unit
+(** Same as [close_out], but ignore all errors. *)
+
+val set_binary_mode_out : out_channel -> bool -> unit
+(** [set_binary_mode_out oc true] sets the channel [oc] to binary
+   mode: no translations take place during output.
+   [set_binary_mode_out oc false] sets the channel [oc] to text
+   mode: depending on the operating system, some translations
+   may take place during output.  For instance, under Windows,
+   end-of-lines will be translated from [\n] to [\r\n].
+   This function has no effect under operating systems that
+   do not distinguish between text mode and binary mode. *)
+
+
+(** {2 General input functions} *)
+
+val open_in : string -> in_channel
+(** Open the named file for reading, and return a new input channel
+   on that file, positioned at the beginning of the file. *)
+
+val open_in_bin : string -> in_channel
+(** Same as {!Stdlib.open_in}, but the file is opened in binary mode,
+   so that no translation takes place during reads. On operating
+   systems that do not distinguish between text mode and binary
+   mode, this function behaves like {!Stdlib.open_in}. *)
+
+val open_in_gen : open_flag list -> int -> string -> in_channel
+(** [open_in_gen mode perm filename] opens the named file for reading,
+   as described above. The extra arguments
+   [mode] and [perm] specify the opening mode and file permissions.
+   {!Stdlib.open_in} and {!Stdlib.open_in_bin} are special
+   cases of this function. *)
+
+val input_char : in_channel -> char
+(** Read one character from the given input channel.
+   @raise End_of_file if there are no more characters to read. *)
+
+val input_line : in_channel -> string
+(** Read characters from the given input channel, until a
+   newline character is encountered. Return the string of
+   all characters read, without the newline character at the end.
+   @raise End_of_file if the end of the file is reached
+   at the beginning of line. *)
+
+val input : in_channel -> bytes -> int -> int -> int
+(** [input ic buf pos len] reads up to [len] characters from
+   the given channel [ic], storing them in byte sequence [buf], starting at
+   character number [pos].
+   It returns the actual number of characters read, between 0 and
+   [len] (inclusive).
+   A return value of 0 means that the end of file was reached.
+   A return value between 0 and [len] exclusive means that
+   not all requested [len] characters were read, either because
+   no more characters were available at that time, or because
+   the implementation found it convenient to do a partial read;
+   [input] must be called again to read the remaining characters,
+   if desired.  (See also {!Stdlib.really_input} for reading
+   exactly [len] characters.)
+   Exception [Invalid_argument "input"] is raised if [pos] and [len]
+   do not designate a valid range of [buf]. *)
+
+val really_input : in_channel -> bytes -> int -> int -> unit
+(** [really_input ic buf pos len] reads [len] characters from channel [ic],
+   storing them in byte sequence [buf], starting at character number [pos].
+   @raise End_of_file if the end of file is reached before [len]
+   characters have been read.
+   @raise Invalid_argument if
+   [pos] and [len] do not designate a valid range of [buf]. *)
+
+val really_input_string : in_channel -> int -> string
+(** [really_input_string ic len] reads [len] characters from channel [ic]
+   and returns them in a new string.
+   @raise End_of_file if the end of file is reached before [len]
+   characters have been read.
+   @since 4.02.0 *)
+
+val input_byte : in_channel -> int
+(** Same as {!Stdlib.input_char}, but return the 8-bit integer representing
+   the character.
+   @raise End_of_file if an end of file was reached. *)
+
+val input_binary_int : in_channel -> int
+(** Read an integer encoded in binary format (4 bytes, big-endian)
+   from the given input channel. See {!Stdlib.output_binary_int}.
+   @raise End_of_file if an end of file was reached while reading the
+   integer. *)
+
+val input_value : in_channel -> 'a
+(** Read the representation of a structured value, as produced
+   by {!Stdlib.output_value}, and return the corresponding value.
+   This function is identical to {!Marshal.from_channel};
+   see the description of module {!Marshal} for more information,
+   in particular concerning the lack of type safety. *)
+
+val seek_in : in_channel -> int -> unit
+(** [seek_in chan pos] sets the current reading position to [pos]
+   for channel [chan]. This works only for regular files. On
+   files of other kinds, the behavior is unspecified. *)
+
+val pos_in : in_channel -> int
+(** Return the current reading position for the given channel. *)
+
+val in_channel_length : in_channel -> int
+(** Return the size (number of characters) of the regular file
+    on which the given channel is opened.  If the channel is opened
+    on a file that is not a regular file, the result is meaningless.
+    The returned size does not take into account the end-of-line
+    translations that can be performed when reading from a channel
+    opened in text mode. *)
+
+val close_in : in_channel -> unit
+(** Close the given channel.  Input functions raise a [Sys_error]
+  exception when they are applied to a closed input channel,
+  except [close_in], which does nothing when applied to an already
+  closed channel. *)
+
+val close_in_noerr : in_channel -> unit
+(** Same as [close_in], but ignore all errors. *)
+
+val set_binary_mode_in : in_channel -> bool -> unit
+(** [set_binary_mode_in ic true] sets the channel [ic] to binary
+   mode: no translations take place during input.
+   [set_binary_mode_out ic false] sets the channel [ic] to text
+   mode: depending on the operating system, some translations
+   may take place during input.  For instance, under Windows,
+   end-of-lines will be translated from [\r\n] to [\n].
+   This function has no effect under operating systems that
+   do not distinguish between text mode and binary mode. *)
+
+
+(** {2 Operations on large files} *)
+
+module LargeFile :
+  sig
+    val seek_out : out_channel -> int64 -> unit
+    val pos_out : out_channel -> int64
+    val out_channel_length : out_channel -> int64
+    val seek_in : in_channel -> int64 -> unit
+    val pos_in : in_channel -> int64
+    val in_channel_length : in_channel -> int64
+  end
+(** Operations on large files.
+  This sub-module provides 64-bit variants of the channel functions
+  that manipulate file positions and file sizes.  By representing
+  positions and sizes by 64-bit integers (type [int64]) instead of
+  regular integers (type [int]), these alternate functions allow
+  operating on files whose sizes are greater than [max_int]. *)
+
+(** {1 References} *)
+
+type 'a ref = { mutable contents : 'a }
+(** The type of references (mutable indirection cells) containing
+   a value of type ['a]. *)
+
+external ref : 'a -> 'a ref = "%makemutable"
+(** Return a fresh reference containing the given value. *)
+
+external ( ! ) : 'a ref -> 'a = "%field0"
+(** [!r] returns the current contents of reference [r].
+   Equivalent to [fun r -> r.contents].
+   Unary operator, see {!Ocaml_operators} for more information.
+*)
+
+external ( := ) : 'a ref -> 'a -> unit = "%setfield0"
+(** [r := a] stores the value of [a] in reference [r].
+   Equivalent to [fun r v -> r.contents <- v].
+   Right-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+external incr : int ref -> unit = "%incr"
+(** Increment the integer contained in the given reference.
+   Equivalent to [fun r -> r := succ !r]. *)
+
+external decr : int ref -> unit = "%decr"
+(** Decrement the integer contained in the given reference.
+   Equivalent to [fun r -> r := pred !r]. *)
+
+(** {1 Result type} *)
+
+(** @since 4.03.0 *)
+type ('a,'b) result = Ok of 'a | Error of 'b
+
+(** {1 Operations on format strings} *)
+
+(** Format strings are character strings with special lexical conventions
+  that defines the functionality of formatted input/output functions. Format
+  strings are used to read data with formatted input functions from module
+  {!Scanf} and to print data with formatted output functions from modules
+  {!Printf} and {!Format}.
+
+  Format strings are made of three kinds of entities:
+  - {e conversions specifications}, introduced by the special character ['%']
+    followed by one or more characters specifying what kind of argument to
+    read or print,
+  - {e formatting indications}, introduced by the special character ['@']
+    followed by one or more characters specifying how to read or print the
+    argument,
+  - {e plain characters} that are regular characters with usual lexical
+    conventions. Plain characters specify string literals to be read in the
+    input or printed in the output.
+
+  There is an additional lexical rule to escape the special characters ['%']
+  and ['@'] in format strings: if a special character follows a ['%']
+  character, it is treated as a plain character. In other words, ["%%"] is
+  considered as a plain ['%'] and ["%@"] as a plain ['@'].
+
+  For more information about conversion specifications and formatting
+  indications available, read the documentation of modules {!Scanf},
+  {!Printf} and {!Format}.
+*)
+
+(** Format strings have a general and highly polymorphic type
+    [('a, 'b, 'c, 'd, 'e, 'f) format6].
+    The two simplified types, [format] and [format4] below are
+    included for backward compatibility with earlier releases of
+    OCaml.
+
+    The meaning of format string type parameters is as follows:
+
+    - ['a] is the type of the parameters of the format for formatted output
+      functions ([printf]-style functions);
+      ['a] is the type of the values read by the format for formatted input
+      functions ([scanf]-style functions).
+
+    - ['b] is the type of input source for formatted input functions and the
+      type of output target for formatted output functions.
+      For [printf]-style functions from module {!Printf}, ['b] is typically
+      [out_channel];
+      for [printf]-style functions from module {!Format}, ['b] is typically
+      {!Format.formatter};
+      for [scanf]-style functions from module {!Scanf}, ['b] is typically
+      {!Scanf.Scanning.in_channel}.
+
+      Type argument ['b] is also the type of the first argument given to
+      user's defined printing functions for [%a] and [%t] conversions,
+      and user's defined reading functions for [%r] conversion.
+
+    - ['c] is the type of the result of the [%a] and [%t] printing
+      functions, and also the type of the argument transmitted to the
+      first argument of [kprintf]-style functions or to the
+      [kscanf]-style functions.
+
+    - ['d] is the type of parameters for the [scanf]-style functions.
+
+    - ['e] is the type of the receiver function for the [scanf]-style functions.
+
+    - ['f] is the final result type of a formatted input/output function
+      invocation: for the [printf]-style functions, it is typically [unit];
+      for the [scanf]-style functions, it is typically the result type of the
+      receiver function.
+*)
+
+type ('a, 'b, 'c, 'd, 'e, 'f) format6 =
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
+
+type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
+
+type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
+
+val string_of_format : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
+(** Converts a format string into a string. *)
+
+external format_of_string :
+  ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+  ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
+(** [format_of_string s] returns a format string read from the string
+    literal [s].
+    Note: [format_of_string] can not convert a string argument that is not a
+    literal. If you need this functionality, use the more general
+    {!Scanf.format_from_string} function.
+*)
+
+val ( ^^ ) :
+  ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+  ('f, 'b, 'c, 'e, 'g, 'h) format6 ->
+  ('a, 'b, 'c, 'd, 'g, 'h) format6
+(** [f1 ^^ f2] catenates format strings [f1] and [f2]. The result is a
+  format string that behaves as the concatenation of format strings [f1] and
+  [f2]: in case of formatted output, it accepts arguments from [f1], then
+  arguments from [f2]; in case of formatted input, it returns results from
+  [f1], then results from [f2].
+  Right-associative operator, see {!Ocaml_operators} for more information.
+*)
+
+(** {1 Program termination} *)
+
+val exit : int -> 'a
+(** Terminate the process, returning the given status code
+   to the operating system: usually 0 to indicate no errors,
+   and a small positive integer to indicate failure.
+   All open output channels are flushed with [flush_all].
+   An implicit [exit 0] is performed each time a program
+   terminates normally.  An implicit [exit 2] is performed if the program
+   terminates early because of an uncaught exception. *)
+
+val at_exit : (unit -> unit) -> unit
+(** Register the given function to be called at program termination
+   time. The functions registered with [at_exit] will be called when
+   the program does any of the following:
+   - executes {!Stdlib.exit}
+   - terminates, either normally or because of an uncaught
+     exception
+   - executes the C function [caml_shutdown].
+   The functions are called in 'last in, first out' order: the
+   function most recently added with [at_exit] is called first. *)
+
+(**/**)
+
+(* The following is for system use only. Do not call directly. *)
+
+val valid_float_lexem : string -> string
+
+val unsafe_really_input : in_channel -> bytes -> int -> int -> unit
+
+val do_at_exit : unit -> unit
+
+(**/**)
+
+(** {1:modules Standard library modules } *)
+
+(*MODULE_ALIASES*)
+module Arg          = Arg
+module Array        = Array
+module ArrayLabels  = ArrayLabels
+module Bigarray     = Bigarray
+module Bool         = Bool
+module Buffer       = Buffer
+module Bytes        = Bytes
+module BytesLabels  = BytesLabels
+module Callback     = Callback
+module Char         = Char
+module Complex      = Complex
+module Digest       = Digest
+module Ephemeron    = Ephemeron
+module Filename     = Filename
+module Float        = Float
+module Format       = Format
+module Fun          = Fun
+module Gc           = Gc
+module Genlex       = Genlex
+module Hashtbl      = Hashtbl
+module Int          = Int
+module Int32        = Int32
+module Int64        = Int64
+module Lazy         = Lazy
+module Lexing       = Lexing
+module List         = List
+module ListLabels   = ListLabels
+module Map          = Map
+module Marshal      = Marshal
+module MoreLabels   = MoreLabels
+module Nativeint    = Nativeint
+module Obj          = Obj
+module Oo           = Oo
+module Option       = Option
+module Parsing      = Parsing
+module Pervasives   = Pervasives
+[@@deprecated "Use Stdlib instead.\n\
+\n\
+If you need to stay compatible with OCaml < 4.07, you can use the \n\
+stdlib-shims library: https://github.com/ocaml/stdlib-shims"]
+module Printexc     = Printexc
+module Printf       = Printf
+module Queue        = Queue
+module Random       = Random
+module Result       = Result
+module Scanf        = Scanf
+module Seq          = Seq
+module Set          = Set
+module Spacetime    = Spacetime
+module Stack        = Stack
+module StdLabels    = StdLabels
+module Stream       = Stream
+module String       = String
+module StringLabels = StringLabels
+module Sys          = Sys
+module Uchar        = Uchar
+module Unit         = Unit
+module Weak         = Weak
diff --git a/stdlib/stream.ml b/stdlib/stream.ml
new file mode 100644
index 00000000..2bfef709
--- /dev/null
+++ b/stdlib/stream.ml
@@ -0,0 +1,236 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*         Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt       *)
+(*                                                                        *)
+(*   Copyright 1997 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 'a t = 'a cell option
+and 'a cell = { mutable count : int; mutable data : 'a data }
+and 'a data =
+    Sempty
+  | Scons of 'a * 'a data
+  | Sapp of 'a data * 'a data
+  | Slazy of 'a data Lazy.t
+  | Sgen of 'a gen
+  | Sbuffio : buffio -> char data
+and 'a gen = { mutable curr : 'a option option; func : int -> 'a option }
+and buffio =
+  { ic : in_channel; buff : bytes; mutable len : int; mutable ind : int }
+
+exception Failure
+exception Error of string
+
+let count = function
+  | None -> 0
+  | Some { count } -> count
+let data = function
+  | None -> Sempty
+  | Some { data } -> data
+
+let fill_buff b =
+  b.len <- input b.ic b.buff 0 (Bytes.length b.buff); b.ind <- 0
+
+
+let rec get_data : type v. int -> v data -> v data = fun count d -> match d with
+ (* Returns either Sempty or Scons(a, _) even when d is a generator
+    or a buffer. In those cases, the item a is seen as extracted from
+ the generator/buffer.
+ The count parameter is used for calling `Sgen-functions'.  *)
+   Sempty | Scons (_, _) -> d
+ | Sapp (d1, d2) ->
+     begin match get_data count d1 with
+       Scons (a, d11) -> Scons (a, Sapp (d11, d2))
+     | Sempty -> get_data count d2
+     | _ -> assert false
+     end
+ | Sgen {curr = Some None} -> Sempty
+ | Sgen ({curr = Some(Some a)} as g) ->
+     g.curr <- None; Scons(a, d)
+ | Sgen g ->
+     begin match g.func count with
+       None -> g.curr <- Some(None); Sempty
+     | Some a -> Scons(a, d)
+         (* Warning: anyone using g thinks that an item has been read *)
+     end
+ | Sbuffio b ->
+     if b.ind >= b.len then fill_buff b;
+     if b.len == 0 then Sempty else
+       let r = Bytes.unsafe_get b.buff b.ind in
+       (* Warning: anyone using g thinks that an item has been read *)
+       b.ind <- succ b.ind; Scons(r, d)
+ | Slazy f -> get_data count (Lazy.force f)
+
+
+let rec peek_data : type v. v cell -> v option = fun s ->
+ (* consult the first item of s *)
+ match s.data with
+   Sempty -> None
+ | Scons (a, _) -> Some a
+ | Sapp (_, _) ->
+     begin match get_data s.count s.data with
+       Scons(a, _) as d -> s.data <- d; Some a
+     | Sempty -> None
+     | _ -> assert false
+     end
+ | Slazy f -> s.data <- (Lazy.force f); peek_data s
+ | Sgen {curr = Some a} -> a
+ | Sgen g -> let x = g.func s.count in g.curr <- Some x; x
+ | Sbuffio b ->
+     if b.ind >= b.len then fill_buff b;
+     if b.len == 0 then begin s.data <- Sempty; None end
+     else Some (Bytes.unsafe_get b.buff b.ind)
+
+
+let peek = function
+  | None -> None
+  | Some s -> peek_data s
+
+
+let rec junk_data : type v. v cell -> unit = fun s ->
+  match s.data with
+    Scons (_, d) -> s.count <- (succ s.count); s.data <- d
+  | Sgen ({curr = Some _} as g) -> s.count <- (succ s.count); g.curr <- None
+  | Sbuffio b ->
+      if b.ind >= b.len then fill_buff b;
+      if b.len == 0 then s.data <- Sempty
+      else (s.count <- (succ s.count); b.ind <- succ b.ind)
+  | _ ->
+      match peek_data s with
+        None -> ()
+      | Some _ -> junk_data s
+
+
+let junk = function
+  | None -> ()
+  | Some data -> junk_data data
+
+let rec nget_data n s =
+  if n <= 0 then [], s.data, 0
+  else
+    match peek_data s with
+      Some a ->
+        junk_data s;
+        let (al, d, k) = nget_data (pred n) s in a :: al, Scons (a, d), succ k
+    | None -> [], s.data, 0
+
+
+let npeek_data n s =
+  let (al, d, len) = nget_data n s in
+  s.count <- (s.count - len);
+  s.data <- d;
+  al
+
+
+let npeek n = function
+  | None -> []
+  | Some d -> npeek_data n d
+
+let next s =
+  match peek s with
+    Some a -> junk s; a
+  | None -> raise Failure
+
+
+let empty s =
+  match peek s with
+    Some _ -> raise Failure
+  | None -> ()
+
+
+let iter f strm =
+  let rec do_rec () =
+    match peek strm with
+      Some a -> junk strm; ignore(f a); do_rec ()
+    | None -> ()
+  in
+  do_rec ()
+
+
+(* Stream building functions *)
+
+let from f = Some {count = 0; data = Sgen {curr = None; func = f}}
+
+let of_list l =
+  Some {count = 0; data = List.fold_right (fun x l -> Scons (x, l)) l Sempty}
+
+
+let of_string s =
+  let count = ref 0 in
+  from (fun _ ->
+    (* We cannot use the index passed by the [from] function directly
+       because it returns the current stream count, with absolutely no
+       guarantee that it will start from 0. For example, in the case
+       of [Stream.icons 'c' (Stream.from_string "ab")], the first
+       access to the string will be made with count [1] already.
+    *)
+    let c = !count in
+    if c < String.length s
+    then (incr count; Some s.[c])
+    else None)
+
+
+let of_bytes s =
+  let count = ref 0 in
+  from (fun _ ->
+    let c = !count in
+    if c < Bytes.length s
+    then (incr count; Some (Bytes.get s c))
+    else None)
+
+
+let of_channel ic =
+  Some {count = 0;
+        data = Sbuffio {ic = ic; buff = Bytes.create 4096; len = 0; ind = 0}}
+
+
+(* Stream expressions builders *)
+
+let iapp i s = Some {count = 0; data = Sapp (data i, data s)}
+let icons i s = Some {count = 0; data = Scons (i, data s)}
+let ising i = Some {count = 0; data = Scons (i, Sempty)}
+
+let lapp f s =
+  Some {count = 0; data = Slazy (lazy(Sapp (data (f ()), data s)))}
+
+let lcons f s = Some {count = 0; data = Slazy (lazy(Scons (f (), data s)))}
+let lsing f = Some {count = 0; data = Slazy (lazy(Scons (f (), Sempty)))}
+
+let sempty = None
+let slazy f = Some {count = 0; data = Slazy (lazy(data (f ())))}
+
+(* For debugging use *)
+
+let rec dump : type v. (v -> unit) -> v t -> unit = fun f s ->
+  print_string "{count = ";
+  print_int (count s);
+  print_string "; data = ";
+  dump_data f (data s);
+  print_string "}";
+  print_newline ()
+and dump_data : type v. (v -> unit) -> v data -> unit = fun f ->
+  function
+    Sempty -> print_string "Sempty"
+  | Scons (a, d) ->
+      print_string "Scons (";
+      f a;
+      print_string ", ";
+      dump_data f d;
+      print_string ")"
+  | Sapp (d1, d2) ->
+      print_string "Sapp (";
+      dump_data f d1;
+      print_string ", ";
+      dump_data f d2;
+      print_string ")"
+  | Slazy _ -> print_string "Slazy"
+  | Sgen _ -> print_string "Sgen"
+  | Sbuffio _ -> print_string "Sbuffio"
diff --git a/stdlib/stream.mli b/stdlib/stream.mli
new file mode 100644
index 00000000..93c2c315
--- /dev/null
+++ b/stdlib/stream.mli
@@ -0,0 +1,111 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*         Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt       *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Streams and parsers. *)
+
+type 'a t
+(** The type of streams holding values of type ['a]. *)
+
+exception Failure
+(** Raised by parsers when none of the first components of the stream
+   patterns is accepted. *)
+
+exception Error of string
+(** Raised by parsers when the first component of a stream pattern is
+   accepted, but one of the following components is rejected. *)
+
+
+(** {1 Stream builders} *)
+
+val from : (int -> 'a option) -> 'a t
+(** [Stream.from f] returns a stream built from the function [f].
+   To create a new stream element, the function [f] is called with
+   the current stream count. The user function [f] must return either
+   [Some <value>] for a value or [None] to specify the end of the
+   stream.
+
+   Do note that the indices passed to [f] may not start at [0] in the
+   general case. For example, [[< '0; '1; Stream.from f >]] would call
+   [f] the first time with count [2].
+*)
+
+val of_list : 'a list -> 'a t
+(** Return the stream holding the elements of the list in the same
+   order. *)
+
+val of_string : string -> char t
+(** Return the stream of the characters of the string parameter. *)
+
+val of_bytes : bytes -> char t
+(** Return the stream of the characters of the bytes parameter.
+    @since 4.02.0 *)
+
+val of_channel : in_channel -> char t
+(** Return the stream of the characters read from the input channel. *)
+
+
+(** {1 Stream iterator} *)
+
+val iter : ('a -> unit) -> 'a t -> unit
+(** [Stream.iter f s] scans the whole stream s, applying function [f]
+   in turn to each stream element encountered. *)
+
+
+(** {1 Predefined parsers} *)
+
+val next : 'a t -> 'a
+(** Return the first element of the stream and remove it from the
+   stream.
+   @raise Stream.Failure if the stream is empty. *)
+
+val empty : 'a t -> unit
+(** Return [()] if the stream is empty, else raise {!Stream.Failure}. *)
+
+
+(** {1 Useful functions} *)
+
+val peek : 'a t -> 'a option
+(** Return [Some] of "the first element" of the stream, or [None] if
+   the stream is empty. *)
+
+val junk : 'a t -> unit
+(** Remove the first element of the stream, possibly unfreezing
+   it before. *)
+
+val count : 'a t -> int
+(** Return the current count of the stream elements, i.e. the number
+   of the stream elements discarded. *)
+
+val npeek : int -> 'a t -> 'a list
+(** [npeek n] returns the list of the [n] first elements of
+   the stream, or all its remaining elements if less than [n]
+   elements are available. *)
+
+(**/**)
+
+(* The following is for system use only. Do not call directly. *)
+
+val iapp : 'a t -> 'a t -> 'a t
+val icons : 'a -> 'a t -> 'a t
+val ising : 'a -> 'a t
+
+val lapp : (unit -> 'a t) -> 'a t -> 'a t
+val lcons : (unit -> 'a) -> 'a t -> 'a t
+val lsing : (unit -> 'a) -> 'a t
+
+val sempty : 'a t
+val slazy : (unit -> 'a t) -> 'a t
+
+val dump : ('a -> unit) -> 'a t -> unit
diff --git a/stdlib/string.ml b/stdlib/string.ml
new file mode 100644
index 00000000..12a627f3
--- /dev/null
+++ b/stdlib/string.ml
@@ -0,0 +1,233 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Damien Doligez, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2014 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* String operations, based on byte sequence operations *)
+
+(* WARNING: Some functions in this file are duplicated in bytes.ml for
+   efficiency reasons. When you modify the one in this file you need to
+   modify its duplicate in bytes.ml.
+   These functions have a "duplicated" comment above their definition.
+*)
+
+external length : string -> int = "%string_length"
+external get : string -> int -> char = "%string_safe_get"
+external set : bytes -> int -> char -> unit = "%string_safe_set"
+external create : int -> bytes = "caml_create_string"
+external unsafe_get : string -> int -> char = "%string_unsafe_get"
+external unsafe_set : bytes -> int -> char -> unit = "%string_unsafe_set"
+external unsafe_blit : string -> int ->  bytes -> int -> int -> unit
+                     = "caml_blit_string" [@@noalloc]
+external unsafe_fill : bytes -> int -> int -> char -> unit
+                     = "caml_fill_string" [@@noalloc]
+
+module B = Bytes
+
+let bts = B.unsafe_to_string
+let bos = B.unsafe_of_string
+
+let make n c =
+  B.make n c |> bts
+let init n f =
+  B.init n f |> bts
+let copy s =
+  B.copy (bos s) |> bts
+let sub s ofs len =
+  B.sub (bos s) ofs len |> bts
+let fill =
+  B.fill
+let blit =
+  B.blit_string
+
+let ensure_ge (x:int) y = if x >= y then x else invalid_arg "String.concat"
+
+let rec sum_lengths acc seplen = function
+  | [] -> acc
+  | hd :: [] -> length hd + acc
+  | hd :: tl -> sum_lengths (ensure_ge (length hd + seplen + acc) acc) seplen tl
+
+let rec unsafe_blits dst pos sep seplen = function
+    [] -> dst
+  | hd :: [] ->
+    unsafe_blit hd 0 dst pos (length hd); dst
+  | hd :: tl ->
+    unsafe_blit hd 0 dst pos (length hd);
+    unsafe_blit sep 0 dst (pos + length hd) seplen;
+    unsafe_blits dst (pos + length hd + seplen) sep seplen tl
+
+let concat sep = function
+    [] -> ""
+  | l -> let seplen = length sep in bts @@
+          unsafe_blits
+            (B.create (sum_lengths 0 seplen l))
+            0 sep seplen l
+
+(* duplicated in bytes.ml *)
+let iter f s =
+  for i = 0 to length s - 1 do f (unsafe_get s i) done
+
+(* duplicated in bytes.ml *)
+let iteri f s =
+  for i = 0 to length s - 1 do f i (unsafe_get s i) done
+
+let map f s =
+  B.map f (bos s) |> bts
+let mapi f s =
+  B.mapi f (bos s) |> bts
+
+(* Beware: we cannot use B.trim or B.escape because they always make a
+   copy, but String.mli spells out some cases where we are not allowed
+   to make a copy. *)
+
+let is_space = function
+  | ' ' | '\012' | '\n' | '\r' | '\t' -> true
+  | _ -> false
+
+let trim s =
+  if s = "" then s
+  else if is_space (unsafe_get s 0) || is_space (unsafe_get s (length s - 1))
+    then bts (B.trim (bos s))
+  else s
+
+let escaped s =
+  let rec escape_if_needed s n i =
+    if i >= n then s else
+      match unsafe_get s i with
+      | '\"' | '\\' | '\000'..'\031' | '\127'.. '\255' ->
+          bts (B.escaped (bos s))
+      | _ -> escape_if_needed s n (i+1)
+  in
+  escape_if_needed s (length s) 0
+
+(* duplicated in bytes.ml *)
+let rec index_rec s lim i c =
+  if i >= lim then raise Not_found else
+  if unsafe_get s i = c then i else index_rec s lim (i + 1) c
+
+(* duplicated in bytes.ml *)
+let index s c = index_rec s (length s) 0 c
+
+(* duplicated in bytes.ml *)
+let rec index_rec_opt s lim i c =
+  if i >= lim then None else
+  if unsafe_get s i = c then Some i else index_rec_opt s lim (i + 1) c
+
+(* duplicated in bytes.ml *)
+let index_opt s c = index_rec_opt s (length s) 0 c
+
+(* duplicated in bytes.ml *)
+let index_from s i c =
+  let l = length s in
+  if i < 0 || i > l then invalid_arg "String.index_from / Bytes.index_from" else
+    index_rec s l i c
+
+(* duplicated in bytes.ml *)
+let index_from_opt s i c =
+  let l = length s in
+  if i < 0 || i > l then
+    invalid_arg "String.index_from_opt / Bytes.index_from_opt"
+  else
+    index_rec_opt s l i c
+
+(* duplicated in bytes.ml *)
+let rec rindex_rec s i c =
+  if i < 0 then raise Not_found else
+  if unsafe_get s i = c then i else rindex_rec s (i - 1) c
+
+(* duplicated in bytes.ml *)
+let rindex s c = rindex_rec s (length s - 1) c
+
+(* duplicated in bytes.ml *)
+let rindex_from s i c =
+  if i < -1 || i >= length s then
+    invalid_arg "String.rindex_from / Bytes.rindex_from"
+  else
+    rindex_rec s i c
+
+(* duplicated in bytes.ml *)
+let rec rindex_rec_opt s i c =
+  if i < 0 then None else
+  if unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c
+
+(* duplicated in bytes.ml *)
+let rindex_opt s c = rindex_rec_opt s (length s - 1) c
+
+(* duplicated in bytes.ml *)
+let rindex_from_opt s i c =
+  if i < -1 || i >= length s then
+    invalid_arg "String.rindex_from_opt / Bytes.rindex_from_opt"
+  else
+    rindex_rec_opt s i c
+
+(* duplicated in bytes.ml *)
+let contains_from s i c =
+  let l = length s in
+  if i < 0 || i > l then
+    invalid_arg "String.contains_from / Bytes.contains_from"
+  else
+    try ignore (index_rec s l i c); true with Not_found -> false
+
+(* duplicated in bytes.ml *)
+let contains s c = contains_from s 0 c
+
+(* duplicated in bytes.ml *)
+let rcontains_from s i c =
+  if i < 0 || i >= length s then
+    invalid_arg "String.rcontains_from / Bytes.rcontains_from"
+  else
+    try ignore (rindex_rec s i c); true with Not_found -> false
+
+let uppercase_ascii s =
+  B.uppercase_ascii (bos s) |> bts
+let lowercase_ascii s =
+  B.lowercase_ascii (bos s) |> bts
+let capitalize_ascii s =
+  B.capitalize_ascii (bos s) |> bts
+let uncapitalize_ascii s =
+  B.uncapitalize_ascii (bos s) |> bts
+
+type t = string
+
+let compare (x: t) (y: t) = Stdlib.compare x y
+external equal : string -> string -> bool = "caml_string_equal" [@@noalloc]
+
+let split_on_char sep s =
+  let r = ref [] in
+  let j = ref (length s) in
+  for i = length s - 1 downto 0 do
+    if unsafe_get s i = sep then begin
+      r := sub s (i + 1) (!j - i - 1) :: !r;
+      j := i
+    end
+  done;
+  sub s 0 !j :: !r
+
+(* Deprecated functions implemented via other deprecated functions *)
+[@@@ocaml.warning "-3"]
+let uppercase s =
+  B.uppercase (bos s) |> bts
+let lowercase s =
+  B.lowercase (bos s) |> bts
+let capitalize s =
+  B.capitalize (bos s) |> bts
+let uncapitalize s =
+  B.uncapitalize (bos s) |> bts
+
+(** {1 Iterators} *)
+
+let to_seq s = bos s |> B.to_seq
+
+let to_seqi s = bos s |> B.to_seqi
+
+let of_seq g = B.of_seq g |> bts
diff --git a/stdlib/string.mli b/stdlib/string.mli
new file mode 100644
index 00000000..82dda271
--- /dev/null
+++ b/stdlib/string.mli
@@ -0,0 +1,345 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** String operations.
+
+  A string is an immutable data structure that contains a
+  fixed-length sequence of (single-byte) characters. Each character
+  can be accessed in constant time through its index.
+
+  Given a string [s] of length [l], we can access each of the [l]
+  characters of [s] via its index in the sequence. Indexes start at
+  [0], and we will call an index valid in [s] if it falls within the
+  range [[0...l-1]] (inclusive). A position is the point between two
+  characters or at the beginning or end of the string.  We call a
+  position valid in [s] if it falls within the range [[0...l]]
+  (inclusive). Note that the character at index [n] is between
+  positions [n] and [n+1].
+
+  Two parameters [start] and [len] are said to designate a valid
+  substring of [s] if [len >= 0] and [start] and [start+len] are
+  valid positions in [s].
+
+  Note: OCaml strings used to be modifiable in place, for instance via
+  the {!String.set} and {!String.blit} functions described below. This
+  usage is only possible when the compiler is put in "unsafe-string"
+  mode by giving the [-unsafe-string] command-line option. This
+  compatibility mode makes the types [string] and [bytes] (see module
+  {!Bytes}) interchangeable so that functions expecting byte sequences
+  can also accept strings as arguments and modify them.
+
+  The distinction between [bytes] and [string] was introduced in OCaml
+  4.02, and the "unsafe-string" compatibility mode was the default
+  until OCaml 4.05. Starting with 4.06, the compatibility mode is
+  opt-in; we intend to remove the option in the future.
+*)
+
+external length : string -> int = "%string_length"
+(** Return the length (number of characters) of the given string. *)
+
+external get : string -> int -> char = "%string_safe_get"
+(** [String.get s n] returns the character at index [n] in string [s].
+   You can also write [s.[n]] instead of [String.get s n].
+   @raise Invalid_argument if [n] not a valid index in [s]. *)
+
+
+external set : bytes -> int -> char -> unit = "%string_safe_set"
+  [@@ocaml.deprecated "Use Bytes.set instead."]
+(** [String.set s n c] modifies byte sequence [s] in place,
+   replacing the byte at index [n] with [c].
+   You can also write [s.[n] <- c] instead of [String.set s n c].
+   @raise Invalid_argument if [n] is not a valid index in [s].
+
+   @deprecated This is a deprecated alias of {!Bytes.set}.[ ] *)
+
+external create : int -> bytes = "caml_create_string"
+  [@@ocaml.deprecated "Use Bytes.create instead."]
+(** [String.create n] returns a fresh byte sequence of length [n].
+   The sequence is uninitialized and contains arbitrary bytes.
+   @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}.
+
+   @deprecated This is a deprecated alias of {!Bytes.create}.[ ] *)
+
+val make : int -> char -> string
+(** [String.make n c] returns a fresh string of length [n],
+   filled with the character [c].
+   @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val init : int -> (int -> char) -> string
+(** [String.init n f] returns a string of length [n], with character
+    [i] initialized to the result of [f i] (called in increasing
+    index order).
+
+    @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}.
+    @since 4.02.0
+*)
+
+val copy : string -> string [@@ocaml.deprecated]
+(** Return a copy of the given string.
+
+    @deprecated Because strings are immutable, it doesn't make much
+    sense to make identical copies of them. *)
+
+val sub : string -> int -> int -> string
+(** [String.sub s start len] returns a fresh string of length [len],
+   containing the substring of [s] that starts at position [start] and
+   has length [len].
+   @raise Invalid_argument if [start] and [len] do not
+   designate a valid substring of [s]. *)
+
+val fill : bytes -> int -> int -> char -> unit
+  [@@ocaml.deprecated "Use Bytes.fill instead."]
+(** [String.fill s start len c] modifies byte sequence [s] in place,
+   replacing [len] bytes with [c], starting at [start].
+   @raise Invalid_argument if [start] and [len] do not
+   designate a valid range of [s].
+
+   @deprecated This is a deprecated alias of {!Bytes.fill}.[ ] *)
+
+val blit : string -> int -> bytes -> int -> int -> unit
+(** Same as {!Bytes.blit_string}. *)
+
+val concat : string -> string list -> string
+(** [String.concat sep sl] concatenates the list of strings [sl],
+    inserting the separator string [sep] between each.
+    @raise Invalid_argument if the result is longer than
+    {!Sys.max_string_length} bytes. *)
+
+val iter : (char -> unit) -> string -> unit
+(** [String.iter f s] applies function [f] in turn to all
+   the characters of [s].  It is equivalent to
+   [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. *)
+
+val iteri : (int -> char -> unit) -> string -> unit
+(** Same as {!String.iter}, but the
+   function is applied to the index of the element as first argument
+   (counting from 0), and the character itself as second argument.
+   @since 4.00.0 *)
+
+val map : (char -> char) -> string -> string
+(** [String.map f s] applies function [f] in turn to all the
+    characters of [s] (in increasing index order) and stores the
+    results in a new string that is returned.
+    @since 4.00.0 *)
+
+val mapi : (int -> char -> char) -> string -> string
+(** [String.mapi f s] calls [f] with each character of [s] and its
+    index (in increasing index order) and stores the results in a new
+    string that is returned.
+    @since 4.02.0 *)
+
+val trim : string -> string
+(** Return a copy of the argument, without leading and trailing
+   whitespace.  The characters regarded as whitespace are: [' '],
+   ['\012'], ['\n'], ['\r'], and ['\t'].  If there is neither leading nor
+   trailing whitespace character in the argument, return the original
+   string itself, not a copy.
+   @since 4.00.0 *)
+
+val escaped : string -> string
+(** Return a copy of the argument, with special characters
+    represented by escape sequences, following the lexical
+    conventions of OCaml.
+    All characters outside the ASCII printable range (32..126) are
+    escaped, as well as backslash and double-quote.
+
+    If there is no special character in the argument that needs
+    escaping, return the original string itself, not a copy.
+    @raise Invalid_argument if the result is longer than
+    {!Sys.max_string_length} bytes.
+
+    The function {!Scanf.unescaped} is a left inverse of [escaped],
+    i.e. [Scanf.unescaped (escaped s) = s] for any string [s] (unless
+    [escape s] fails). *)
+
+val index : string -> char -> int
+(** [String.index s c] returns the index of the first
+   occurrence of character [c] in string [s].
+   @raise Not_found if [c] does not occur in [s]. *)
+
+val index_opt: string -> char -> int option
+(** [String.index_opt s c] returns the index of the first
+    occurrence of character [c] in string [s], or
+    [None] if [c] does not occur in [s].
+    @since 4.05 *)
+
+val rindex : string -> char -> int
+(** [String.rindex s c] returns the index of the last
+   occurrence of character [c] in string [s].
+   @raise Not_found if [c] does not occur in [s]. *)
+
+val rindex_opt: string -> char -> int option
+(** [String.rindex_opt s c] returns the index of the last occurrence
+    of character [c] in string [s], or [None] if [c] does not occur in
+    [s].
+    @since 4.05 *)
+
+val index_from : string -> int -> char -> int
+(** [String.index_from s i c] returns the index of the
+   first occurrence of character [c] in string [s] after position [i].
+   [String.index s c] is equivalent to [String.index_from s 0 c].
+   @raise Invalid_argument if [i] is not a valid position in [s].
+   @raise Not_found if [c] does not occur in [s] after position [i]. *)
+
+val index_from_opt: string -> int -> char -> int option
+(** [String.index_from_opt s i c] returns the index of the
+    first occurrence of character [c] in string [s] after position [i]
+    or [None] if [c] does not occur in [s] after position [i].
+
+    [String.index_opt s c] is equivalent to [String.index_from_opt s 0 c].
+    @raise Invalid_argument if [i] is not a valid position in [s].
+
+    @since 4.05
+*)
+
+val rindex_from : string -> int -> char -> int
+(** [String.rindex_from s i c] returns the index of the
+   last occurrence of character [c] in string [s] before position [i+1].
+   [String.rindex s c] is equivalent to
+   [String.rindex_from s (String.length s - 1) c].
+   @raise Invalid_argument if [i+1] is not a valid position in [s].
+   @raise Not_found if [c] does not occur in [s] before position [i+1]. *)
+
+val rindex_from_opt: string -> int -> char -> int option
+(** [String.rindex_from_opt s i c] returns the index of the
+   last occurrence of character [c] in string [s] before position [i+1]
+   or [None] if [c] does not occur in [s] before position [i+1].
+
+   [String.rindex_opt s c] is equivalent to
+   [String.rindex_from_opt s (String.length s - 1) c].
+   @raise Invalid_argument if [i+1] is not a valid position in [s].
+
+    @since 4.05
+*)
+
+val contains : string -> char -> bool
+(** [String.contains s c] tests if character [c]
+   appears in the string [s]. *)
+
+val contains_from : string -> int -> char -> bool
+(** [String.contains_from s start c] tests if character [c]
+   appears in [s] after position [start].
+   [String.contains s c] is equivalent to
+   [String.contains_from s 0 c].
+   @raise Invalid_argument if [start] is not a valid position in [s]. *)
+
+val rcontains_from : string -> int -> char -> bool
+(** [String.rcontains_from s stop c] tests if character [c]
+   appears in [s] before position [stop+1].
+   @raise Invalid_argument if [stop < 0] or [stop+1] is not a valid
+   position in [s]. *)
+
+val uppercase : string -> string
+  [@@ocaml.deprecated "Use String.uppercase_ascii instead."]
+(** Return a copy of the argument, with all lowercase letters
+   translated to uppercase, including accented letters of the ISO
+   Latin-1 (8859-1) character set.
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val lowercase : string -> string
+  [@@ocaml.deprecated "Use String.lowercase_ascii instead."]
+(** Return a copy of the argument, with all uppercase letters
+   translated to lowercase, including accented letters of the ISO
+   Latin-1 (8859-1) character set.
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val capitalize : string -> string
+  [@@ocaml.deprecated "Use String.capitalize_ascii instead."]
+(** Return a copy of the argument, with the first character set to uppercase,
+   using the ISO Latin-1 (8859-1) character set..
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val uncapitalize : string -> string
+  [@@ocaml.deprecated "Use String.uncapitalize_ascii instead."]
+(** Return a copy of the argument, with the first character set to lowercase,
+   using the ISO Latin-1 (8859-1) character set..
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val uppercase_ascii : string -> string
+(** Return a copy of the argument, with all lowercase letters
+   translated to uppercase, using the US-ASCII character set.
+   @since 4.03.0 *)
+
+val lowercase_ascii : string -> string
+(** Return a copy of the argument, with all uppercase letters
+   translated to lowercase, using the US-ASCII character set.
+   @since 4.03.0 *)
+
+val capitalize_ascii : string -> string
+(** Return a copy of the argument, with the first character set to uppercase,
+   using the US-ASCII character set.
+   @since 4.03.0 *)
+
+val uncapitalize_ascii : string -> string
+(** Return a copy of the argument, with the first character set to lowercase,
+   using the US-ASCII character set.
+   @since 4.03.0 *)
+
+type t = string
+(** An alias for the type of strings. *)
+
+val compare: t -> t -> int
+(** The comparison function for strings, with the same specification as
+    {!Stdlib.compare}.  Along with the type [t], this function [compare]
+    allows the module [String] to be passed as argument to the functors
+    {!Set.Make} and {!Map.Make}. *)
+
+val equal: t -> t -> bool
+(** The equal function for strings.
+    @since 4.03.0 *)
+
+val split_on_char: char -> string -> string list
+(** [String.split_on_char sep s] returns the list of all (possibly empty)
+    substrings of [s] that are delimited by the [sep] character.
+
+    The function's output is specified by the following invariants:
+
+    - The list is not empty.
+    - Concatenating its elements using [sep] as a separator returns a
+      string equal to the input ([String.concat (String.make 1 sep)
+      (String.split_on_char sep s) = s]).
+    - No string in the result contains the [sep] character.
+
+    @since 4.04.0
+*)
+
+(** {1 Iterators} *)
+
+val to_seq : t -> char Seq.t
+(** Iterate on the string, in increasing index order. Modifications of the
+    string during iteration will be reflected in the iterator.
+    @since 4.07 *)
+
+val to_seqi : t -> (int * char) Seq.t
+(** Iterate on the string, in increasing order, yielding indices along chars
+    @since 4.07 *)
+
+val of_seq : char Seq.t -> t
+(** Create a string from the generator
+    @since 4.07 *)
+
+(**/**)
+
+(* The following is for system use only. Do not call directly. *)
+
+external unsafe_get : string -> int -> char = "%string_unsafe_get"
+external unsafe_set : bytes -> int -> char -> unit = "%string_unsafe_set"
+  [@@ocaml.deprecated]
+external unsafe_blit :
+  string -> int -> bytes -> int -> int -> unit
+  = "caml_blit_string" [@@noalloc]
+external unsafe_fill :
+  bytes -> int -> int -> char -> unit = "caml_fill_string" [@@noalloc]
+  [@@ocaml.deprecated]
diff --git a/stdlib/stringLabels.ml b/stdlib/stringLabels.ml
new file mode 100644
index 00000000..9675b7a2
--- /dev/null
+++ b/stdlib/stringLabels.ml
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Jacques Garrigue, Kyoto University RIMS                 *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Module [StringLabels]: labelled String module *)
+
+include String
diff --git a/stdlib/stringLabels.mli b/stdlib/stringLabels.mli
new file mode 100644
index 00000000..ca4289df
--- /dev/null
+++ b/stdlib/stringLabels.mli
@@ -0,0 +1,312 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** String operations.
+   This module is intended to be used through {!StdLabels} which replaces
+   {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts
+
+   For example:
+   {[
+      open StdLabels
+
+      let to_upper = String.map ~f:Char.uppercase_ascii
+   ]} *)
+
+external length : string -> int = "%string_length"
+(** Return the length (number of characters) of the given string. *)
+
+external get : string -> int -> char = "%string_safe_get"
+(** [String.get s n] returns the character at index [n] in string [s].
+   You can also write [s.[n]] instead of [String.get s n].
+   @raise Invalid_argument if [n] not a valid index in [s]. *)
+
+external set : bytes -> int -> char -> unit = "%string_safe_set"
+  [@@ocaml.deprecated "Use BytesLabels.set instead."]
+(** [String.set s n c] modifies byte sequence [s] in place,
+   replacing the byte at index [n] with [c].
+   You can also write [s.[n] <- c] instead of [String.set s n c].
+   @raise Invalid_argument if [n] is not a valid index in [s].
+
+   @deprecated This is a deprecated alias of {!BytesLabels.set}. *)
+
+external create : int -> bytes = "caml_create_string"
+  [@@ocaml.deprecated "Use BytesLabels.create instead."]
+(** [String.create n] returns a fresh byte sequence of length [n].
+   The sequence is uninitialized and contains arbitrary bytes.
+   @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}.
+
+   @deprecated This is a deprecated alias of {!BytesLabels.create}. *)
+
+val make : int -> char -> string
+(** [String.make n c] returns a fresh string of length [n],
+   filled with the character [c].
+   @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val init : int -> f:(int -> char) -> string
+(** [init n f] returns a string of length [n],
+    with character [i] initialized to the result of [f i].
+   @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}.
+   @since 4.02.0 *)
+
+val copy : string -> string  [@@ocaml.deprecated]
+(** Return a copy of the given string. *)
+
+val sub : string -> pos:int -> len:int -> string
+(** [String.sub s start len] returns a fresh string of length [len],
+   containing the substring of [s] that starts at position [start] and
+   has length [len].
+   @raise Invalid_argument if [start] and [len] do not
+   designate a valid substring of [s]. *)
+
+val fill : bytes -> pos:int -> len:int -> char -> unit
+  [@@ocaml.deprecated "Use BytesLabels.fill instead."]
+(** [String.fill s start len c] modifies byte sequence [s] in place,
+   replacing [len] bytes by [c], starting at [start].
+   @raise Invalid_argument if [start] and [len] do not
+   designate a valid substring of [s].
+
+   @deprecated This is a deprecated alias of {!BytesLabels.fill}. *)
+
+val blit :
+  src:string -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int
+  -> unit
+(** [String.blit src srcoff dst dstoff len] copies [len] bytes
+   from the string [src], starting at index [srcoff],
+   to byte sequence [dst], starting at character number [dstoff].
+   @raise Invalid_argument if [srcoff] and [len] do not
+   designate a valid range of [src], or if [dstoff] and [len]
+   do not designate a valid range of [dst]. *)
+
+val concat : sep:string -> string list -> string
+(** [String.concat sep sl] concatenates the list of strings [sl],
+   inserting the separator string [sep] between each. *)
+
+val iter : f:(char -> unit) -> string -> unit
+(** [String.iter f s] applies function [f] in turn to all
+   the characters of [s].  It is equivalent to
+   [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. *)
+
+val iteri : f:(int -> char -> unit) -> string -> unit
+(** Same as {!String.iter}, but the
+   function is applied to the index of the element as first argument
+   (counting from 0), and the character itself as second argument.
+   @since 4.00.0 *)
+
+val map : f:(char -> char) -> string -> string
+(** [String.map f s] applies function [f] in turn to all
+   the characters of [s] and stores the results in a new string that
+   is returned.
+   @since 4.00.0 *)
+
+val mapi : f:(int -> char -> char) -> string -> string
+(** [String.mapi f s] calls [f] with each character of [s] and its
+    index (in increasing index order) and stores the results in a new
+    string that is returned.
+    @since 4.02.0 *)
+
+val trim : string -> string
+(** Return a copy of the argument, without leading and trailing
+   whitespace.  The characters regarded as whitespace are: [' '],
+   ['\012'], ['\n'], ['\r'], and ['\t'].  If there is no leading nor
+   trailing whitespace character in the argument, return the original
+   string itself, not a copy.
+   @since 4.00.0 *)
+
+val escaped : string -> string
+(** Return a copy of the argument, with special characters
+   represented by escape sequences, following the lexical
+   conventions of OCaml.  If there is no special
+   character in the argument, return the original string itself,
+   not a copy. Its inverse function is Scanf.unescaped. *)
+
+val index : string -> char -> int
+(** [String.index s c] returns the index of the first
+   occurrence of character [c] in string [s].
+   @raise Not_found if [c] does not occur in [s]. *)
+
+val index_opt: string -> char -> int option
+(** [String.index_opt s c] returns the index of the first
+    occurrence of character [c] in string [s], or
+    [None] if [c] does not occur in [s].
+    @since 4.05 *)
+
+val rindex : string -> char -> int
+(** [String.rindex s c] returns the index of the last
+   occurrence of character [c] in string [s].
+   @raise Not_found if [c] does not occur in [s]. *)
+
+val rindex_opt: string -> char -> int option
+(** [String.rindex_opt s c] returns the index of the last occurrence
+    of character [c] in string [s], or [None] if [c] does not occur in
+    [s].
+    @since 4.05 *)
+
+val index_from : string -> int -> char -> int
+(** [String.index_from s i c] returns the index of the
+   first occurrence of character [c] in string [s] after position [i].
+   [String.index s c] is equivalent to [String.index_from s 0 c].
+   @raise Invalid_argument if [i] is not a valid position in [s].
+   @raise Not_found if [c] does not occur in [s] after position [i]. *)
+
+val index_from_opt: string -> int -> char -> int option
+(** [String.index_from_opt s i c] returns the index of the
+    first occurrence of character [c] in string [s] after position [i]
+    or [None] if [c] does not occur in [s] after position [i].
+
+    [String.index_opt s c] is equivalent to [String.index_from_opt s 0 c].
+    @raise Invalid_argument if [i] is not a valid position in [s].
+
+    @since 4.05
+*)
+
+val rindex_from : string -> int -> char -> int
+(** [String.rindex_from s i c] returns the index of the
+   last occurrence of character [c] in string [s] before position [i+1].
+   [String.rindex s c] is equivalent to
+   [String.rindex_from s (String.length s - 1) c].
+   @raise Invalid_argument if [i+1] is not a valid position in [s].
+   @raise Not_found if [c] does not occur in [s] before position [i+1]. *)
+
+val rindex_from_opt: string -> int -> char -> int option
+(** [String.rindex_from_opt s i c] returns the index of the
+   last occurrence of character [c] in string [s] before position [i+1]
+   or [None] if [c] does not occur in [s] before position [i+1].
+
+   [String.rindex_opt s c] is equivalent to
+   [String.rindex_from_opt s (String.length s - 1) c].
+   @raise Invalid_argument if [i+1] is not a valid position in [s].
+
+    @since 4.05
+*)
+
+val contains : string -> char -> bool
+(** [String.contains s c] tests if character [c]
+   appears in the string [s]. *)
+
+val contains_from : string -> int -> char -> bool
+(** [String.contains_from s start c] tests if character [c]
+   appears in [s] after position [start].
+   [String.contains s c] is equivalent to
+   [String.contains_from s 0 c].
+   @raise Invalid_argument if [start] is not a valid position in [s]. *)
+
+val rcontains_from : string -> int -> char -> bool
+(** [String.rcontains_from s stop c] tests if character [c]
+   appears in [s] before position [stop+1].
+   @raise Invalid_argument if [stop < 0] or [stop+1] is not a valid
+   position in [s]. *)
+
+val uppercase : string -> string
+  [@@ocaml.deprecated "Use String.uppercase_ascii instead."]
+(** Return a copy of the argument, with all lowercase letters
+   translated to uppercase, including accented letters of the ISO
+   Latin-1 (8859-1) character set.
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val lowercase : string -> string
+  [@@ocaml.deprecated "Use String.lowercase_ascii instead."]
+(** Return a copy of the argument, with all uppercase letters
+   translated to lowercase, including accented letters of the ISO
+   Latin-1 (8859-1) character set.
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val capitalize : string -> string
+  [@@ocaml.deprecated "Use String.capitalize_ascii instead."]
+(** Return a copy of the argument, with the first character set to uppercase,
+   using the ISO Latin-1 (8859-1) character set..
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val uncapitalize : string -> string
+  [@@ocaml.deprecated "Use String.uncapitalize_ascii instead."]
+(** Return a copy of the argument, with the first character set to lowercase,
+   using the ISO Latin-1 (8859-1) character set..
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val uppercase_ascii : string -> string
+(** Return a copy of the argument, with all lowercase letters
+   translated to uppercase, using the US-ASCII character set.
+   @since 4.05.0 *)
+
+val lowercase_ascii : string -> string
+(** Return a copy of the argument, with all uppercase letters
+   translated to lowercase, using the US-ASCII character set.
+   @since 4.05.0 *)
+
+val capitalize_ascii : string -> string
+(** Return a copy of the argument, with the first character set to uppercase,
+   using the US-ASCII character set.
+   @since 4.05.0 *)
+
+val uncapitalize_ascii : string -> string
+(** Return a copy of the argument, with the first character set to lowercase,
+   using the US-ASCII character set.
+   @since 4.05.0 *)
+
+type t = string
+(** An alias for the type of strings. *)
+
+val compare: t -> t -> int
+(** The comparison function for strings, with the same specification as
+    {!Stdlib.compare}.  Along with the type [t], this function [compare]
+    allows the module [String] to be passed as argument to the functors
+    {!Set.Make} and {!Map.Make}. *)
+
+val equal: t -> t -> bool
+(** The equal function for strings.
+    @since 4.05.0 *)
+
+val split_on_char: sep:char -> string -> string list
+(** [String.split_on_char sep s] returns the list of all (possibly empty)
+    substrings of [s] that are delimited by the [sep] character.
+
+    The function's output is specified by the following invariants:
+
+    - The list is not empty.
+    - Concatenating its elements using [sep] as a separator returns a
+      string equal to the input ([String.concat (String.make 1 sep)
+      (String.split_on_char sep s) = s]).
+    - No string in the result contains the [sep] character.
+
+    @since 4.05.0
+*)
+
+(** {1 Iterators} *)
+
+val to_seq : t -> char Seq.t
+(** Iterate on the string, in increasing index order. Modifications of the
+    string during iteration will be reflected in the iterator.
+    @since 4.07 *)
+
+val to_seqi : t -> (int * char) Seq.t
+(** Iterate on the string, in increasing order, yielding indices along chars
+    @since 4.07 *)
+
+val of_seq : char Seq.t -> t
+(** Create a string from the generator
+    @since 4.07 *)
+
+(**/**)
+
+(* The following is for system use only. Do not call directly. *)
+
+external unsafe_get : string -> int -> char = "%string_unsafe_get"
+external unsafe_set : bytes -> int -> char -> unit = "%string_unsafe_set"
+  [@@ocaml.deprecated]
+external unsafe_blit :
+  src:string -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int ->
+    unit = "caml_blit_string" [@@noalloc]
+external unsafe_fill :
+  bytes -> pos:int -> len:int -> char -> unit = "caml_fill_string" [@@noalloc]
+  [@@ocaml.deprecated]
diff --git a/stdlib/sys.mli b/stdlib/sys.mli
new file mode 100644
index 00000000..368baa0f
--- /dev/null
+++ b/stdlib/sys.mli
@@ -0,0 +1,387 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** System interface.
+
+  Every function in this module raises [Sys_error] with an
+  informative message when the underlying system call signal
+  an error.
+*)
+
+external argv : string array = "%sys_argv"
+(** The command line arguments given to the process.
+   The first element is the command name used to invoke the program.
+   The following elements are the command-line arguments
+   given to the program. *)
+
+val executable_name : string
+(** The name of the file containing the executable currently running.
+    This name may be absolute or relative to the current directory, depending
+    on the platform and whether the program was compiled to bytecode or a native
+    executable. *)
+
+external file_exists : string -> bool = "caml_sys_file_exists"
+(** Test if a file with the given name exists. *)
+
+external is_directory : string -> bool = "caml_sys_is_directory"
+(** Returns [true] if the given name refers to a directory,
+    [false] if it refers to another kind of file.
+    @raise Sys_error if no file exists with the given name.
+    @since 3.10.0
+*)
+
+external remove : string -> unit = "caml_sys_remove"
+(** Remove the given file name from the file system. *)
+
+external rename : string -> string -> unit = "caml_sys_rename"
+(** Rename a file.  [rename oldpath newpath] renames the file
+    called [oldpath], giving it [newpath] as its new name,
+    moving it between directories if needed.  If [newpath] already
+    exists, its contents will be replaced with those of [oldpath].
+    Depending on the operating system, the metadata (permissions,
+    owner, etc) of [newpath] can either be preserved or be replaced by
+    those of [oldpath].
+   @since 4.06 concerning the "replace existing file" behavior *)
+
+external getenv : string -> string = "caml_sys_getenv"
+(** Return the value associated to a variable in the process
+   environment.
+   @raise Not_found if the variable is unbound. *)
+
+val getenv_opt: string -> string option
+(** Return the value associated to a variable in the process
+    environment or [None] if the variable is unbound.
+    @since 4.05
+*)
+
+external command : string -> int = "caml_sys_system_command"
+(** Execute the given shell command and return its exit code.
+
+  The argument of {!Sys.command} is generally the name of a
+  command followed by zero, one or several arguments, separated
+  by whitespace.  The given argument is interpreted by a
+  shell: either the Windows shell [cmd.exe] for the Win32 ports of
+  OCaml, or the POSIX shell [sh] for other ports.  It can contain
+  shell builtin commands such as [echo], and also special characters
+  such as file redirections [>] and [<], which will be honored by the
+  shell.
+
+  Conversely, whitespace or special shell characters occurring in
+  command names or in their arguments must be quoted or escaped
+  so that the shell does not interpret them.  The quoting rules vary
+  between the POSIX shell and the Windows shell.
+  The {!Filename.quote_command} performs the appropriate quoting
+  given a command name, a list of arguments, and optional file redirections.
+*)
+
+external time : unit -> (float [@unboxed]) =
+  "caml_sys_time" "caml_sys_time_unboxed" [@@noalloc]
+(** Return the processor time, in seconds, used by the program
+   since the beginning of execution. *)
+
+external chdir : string -> unit = "caml_sys_chdir"
+(** Change the current working directory of the process. *)
+
+external getcwd : unit -> string = "caml_sys_getcwd"
+(** Return the current working directory of the process. *)
+
+external readdir : string -> string array = "caml_sys_read_directory"
+(** Return the names of all files present in the given directory.
+   Names denoting the current directory and the parent directory
+   (["."] and [".."] in Unix) are not returned.  Each string in the
+   result is a file name rather than a complete path.  There is no
+   guarantee that the name strings in the resulting array will appear
+   in any specific order; they are not, in particular, guaranteed to
+   appear in alphabetical order. *)
+
+val interactive : bool ref
+(** This reference is initially set to [false] in standalone
+   programs and to [true] if the code is being executed under
+   the interactive toplevel system [ocaml]. *)
+
+val os_type : string
+(** Operating system currently executing the OCaml program. One of
+-  ["Unix"] (for all Unix versions, including Linux and Mac OS X),
+-  ["Win32"] (for MS-Windows, OCaml compiled with MSVC++ or Mingw),
+-  ["Cygwin"] (for MS-Windows, OCaml compiled with Cygwin). *)
+
+type backend_type =
+  | Native
+  | Bytecode
+  | Other of string (**)
+(** Currently, the official distribution only supports [Native] and
+    [Bytecode], but it can be other backends with alternative
+    compilers, for example, javascript.
+
+    @since 4.04.0
+*)
+
+val backend_type : backend_type
+(** Backend type  currently executing the OCaml program.
+    @since 4.04.0
+ *)
+
+val unix : bool
+(** True if [Sys.os_type = "Unix"].
+    @since 4.01.0 *)
+
+val win32 : bool
+(** True if [Sys.os_type = "Win32"].
+    @since 4.01.0 *)
+
+val cygwin : bool
+(** True if [Sys.os_type = "Cygwin"].
+    @since 4.01.0 *)
+
+val word_size : int
+(** Size of one word on the machine currently executing the OCaml
+    program, in bits: 32 or 64. *)
+
+val int_size : int
+(** Size of [int], in bits. It is 31 (resp. 63) when using OCaml on a
+    32-bit (resp. 64-bit) platform. It may differ for other implementations,
+    e.g. it can be 32 bits when compiling to JavaScript.
+    @since 4.03.0 *)
+
+val big_endian : bool
+(** Whether the machine currently executing the Caml program is big-endian.
+    @since 4.00.0 *)
+
+val max_string_length : int
+(** Maximum length of strings and byte sequences. *)
+
+val max_array_length : int
+(** Maximum length of a normal array (i.e. any array whose elements are
+    not of type [float]). The maximum length of a [float array]
+    is [max_floatarray_length] if OCaml was configured with
+    [--enable-flat-float-array] and [max_array_length] if configured
+    with [--disable-flat-float-array]. *)
+
+val max_floatarray_length : int
+(** Maximum length of a floatarray. This is also the maximum length of
+    a [float array] when OCaml is configured with
+    [--enable-flat-float-array]. *)
+
+external runtime_variant : unit -> string = "caml_runtime_variant"
+(** Return the name of the runtime variant the program is running on.
+    This is normally the argument given to [-runtime-variant] at compile
+    time, but for byte-code it can be changed after compilation.
+    @since 4.03.0 *)
+
+external runtime_parameters : unit -> string = "caml_runtime_parameters"
+(** Return the value of the runtime parameters, in the same format
+    as the contents of the [OCAMLRUNPARAM] environment variable.
+    @since 4.03.0 *)
+
+
+(** {1 Signal handling} *)
+
+
+type signal_behavior =
+    Signal_default
+  | Signal_ignore
+  | Signal_handle of (int -> unit)   (** *)
+(** What to do when receiving a signal:
+   - [Signal_default]: take the default behavior
+     (usually: abort the program)
+   - [Signal_ignore]: ignore the signal
+   - [Signal_handle f]: call function [f], giving it the signal
+   number as argument. *)
+
+external signal :
+  int -> signal_behavior -> signal_behavior = "caml_install_signal_handler"
+(** Set the behavior of the system on receipt of a given signal.  The
+   first argument is the signal number.  Return the behavior
+   previously associated with the signal. If the signal number is
+   invalid (or not available on your system), an [Invalid_argument]
+   exception is raised. *)
+
+val set_signal : int -> signal_behavior -> unit
+(** Same as {!Sys.signal} but return value is ignored. *)
+
+
+(** {2 Signal numbers for the standard POSIX signals.} *)
+
+val sigabrt : int
+(** Abnormal termination *)
+
+val sigalrm : int
+(** Timeout *)
+
+val sigfpe : int
+(** Arithmetic exception *)
+
+val sighup : int
+(** Hangup on controlling terminal *)
+
+val sigill : int
+(** Invalid hardware instruction *)
+
+val sigint : int
+(** Interactive interrupt (ctrl-C) *)
+
+val sigkill : int
+(** Termination (cannot be ignored) *)
+
+val sigpipe : int
+(** Broken pipe *)
+
+val sigquit : int
+(** Interactive termination *)
+
+val sigsegv : int
+(** Invalid memory reference *)
+
+val sigterm : int
+(** Termination *)
+
+val sigusr1 : int
+(** Application-defined signal 1 *)
+
+val sigusr2 : int
+(** Application-defined signal 2 *)
+
+val sigchld : int
+(** Child process terminated *)
+
+val sigcont : int
+(** Continue *)
+
+val sigstop : int
+(** Stop *)
+
+val sigtstp : int
+(** Interactive stop *)
+
+val sigttin : int
+(** Terminal read from background process *)
+
+val sigttou : int
+(** Terminal write from background process *)
+
+val sigvtalrm : int
+(** Timeout in virtual time *)
+
+val sigprof : int
+(** Profiling interrupt *)
+
+val sigbus : int
+(** Bus error
+    @since 4.03 *)
+
+val sigpoll : int
+(** Pollable event
+    @since 4.03 *)
+
+val sigsys : int
+(** Bad argument to routine
+    @since 4.03 *)
+
+val sigtrap : int
+(** Trace/breakpoint trap
+    @since 4.03 *)
+
+val sigurg : int
+(** Urgent condition on socket
+    @since 4.03 *)
+
+val sigxcpu : int
+(** Timeout in cpu time
+    @since 4.03 *)
+
+val sigxfsz : int
+(** File size limit exceeded
+    @since 4.03 *)
+
+
+exception Break
+(** Exception raised on interactive interrupt if {!Sys.catch_break}
+   is on. *)
+
+
+val catch_break : bool -> unit
+(** [catch_break] governs whether interactive interrupt (ctrl-C)
+   terminates the program or raises the [Break] exception.
+   Call [catch_break true] to enable raising [Break],
+   and [catch_break false] to let the system
+   terminate the program on user interrupt. *)
+
+
+val ocaml_version : string
+(** [ocaml_version] is the version of OCaml.
+    It is a string of the form
+      ["major.minor[.patchlevel][(+|~)additional-info]"],
+    where [major], [minor], and [patchlevel] are integers, and
+    [additional-info] is an arbitrary string.
+    The [[.patchlevel]] part is absent for versions anterior to 3.08.0.
+    The [[(+|~)additional-info]] part may be absent. *)
+
+
+val enable_runtime_warnings: bool -> unit
+(** Control whether the OCaml runtime system can emit warnings
+    on stderr.  Currently, the only supported warning is triggered
+    when a channel created by [open_*] functions is finalized without
+    being closed.  Runtime warnings are disabled by default.
+
+    @since 4.03.0 *)
+
+val runtime_warnings_enabled: unit -> bool
+(** Return whether runtime warnings are currently enabled.
+
+    @since 4.03.0 *)
+
+(** {1 Optimization} *)
+
+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.
+
+    A typical use of this function is to prevent pure computations from being
+    optimized away in benchmarking loops.  For example:
+    {[
+      for _round = 1 to 100_000 do
+        ignore (Sys.opaque_identity (my_pure_computation ()))
+      done
+    ]}
+
+    @since 4.03.0
+*)
+
+module Immediate64 : sig
+  (** This module allows to define a type [t] with the [immediate64]
+      attribute. This attribute means that the type is immediate on 64
+      bit architectures. On other architectures, it might or might not
+      be immediate.
+
+      @since 4.10.0
+  *)
+
+  module type Non_immediate = sig
+    type t
+  end
+  module type Immediate = sig
+    type t [@@immediate]
+  end
+
+  module Make(Immediate : Immediate)(Non_immediate : Non_immediate) : sig
+    type t [@@immediate64]
+    type 'a repr =
+      | Immediate : Immediate.t repr
+      | Non_immediate : Non_immediate.t repr
+    val repr : t repr
+  end
+end
diff --git a/stdlib/sys.mlp b/stdlib/sys.mlp
new file mode 100644
index 00000000..e89dd458
--- /dev/null
+++ b/stdlib/sys.mlp
@@ -0,0 +1,155 @@
+#2 "stdlib/sys.mlp"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* WARNING: sys.ml is generated from sys.mlp.  DO NOT EDIT sys.ml or
+   your changes will be lost.
+*)
+
+type backend_type =
+  | Native
+  | Bytecode
+  | Other of string
+(* System interface *)
+
+external get_config: unit -> string * int * bool = "caml_sys_get_config"
+external get_executable_name : unit -> string = "caml_sys_executable_name"
+external argv : string array = "%sys_argv"
+external big_endian : unit -> bool = "%big_endian"
+external word_size : unit -> int = "%word_size"
+external int_size : unit -> int = "%int_size"
+external max_wosize : unit -> int = "%max_wosize"
+external unix : unit -> bool = "%ostype_unix"
+external win32 : unit -> bool = "%ostype_win32"
+external cygwin : unit -> bool = "%ostype_cygwin"
+external get_backend_type : unit -> backend_type = "%backend_type"
+
+let executable_name = get_executable_name()
+let (os_type, _, _) = get_config()
+let backend_type = get_backend_type ()
+let big_endian = big_endian ()
+let word_size = word_size ()
+let int_size = int_size ()
+let unix = unix ()
+let win32 = win32 ()
+let cygwin = cygwin ()
+let max_array_length = max_wosize ()
+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 file_exists: string -> bool = "caml_sys_file_exists"
+external is_directory : string -> bool = "caml_sys_is_directory"
+external remove: string -> unit = "caml_sys_remove"
+external rename : string -> string -> unit = "caml_sys_rename"
+external getenv: string -> string = "caml_sys_getenv"
+
+let getenv_opt s =
+  (* TODO: expose a non-raising primitive directly. *)
+  try Some (getenv s)
+  with Not_found -> None
+
+external command: string -> int = "caml_sys_system_command"
+external time: unit -> (float [@unboxed]) =
+  "caml_sys_time" "caml_sys_time_unboxed" [@@noalloc]
+external chdir: string -> unit = "caml_sys_chdir"
+external getcwd: unit -> string = "caml_sys_getcwd"
+external readdir : string -> string array = "caml_sys_read_directory"
+
+let interactive = ref false
+
+type signal_behavior =
+    Signal_default
+  | Signal_ignore
+  | Signal_handle of (int -> unit)
+
+external signal : int -> signal_behavior -> signal_behavior
+                = "caml_install_signal_handler"
+
+let set_signal sig_num sig_beh = ignore(signal sig_num sig_beh)
+
+let sigabrt = -1
+let sigalrm = -2
+let sigfpe = -3
+let sighup = -4
+let sigill = -5
+let sigint = -6
+let sigkill = -7
+let sigpipe = -8
+let sigquit = -9
+let sigsegv = -10
+let sigterm = -11
+let sigusr1 = -12
+let sigusr2 = -13
+let sigchld = -14
+let sigcont = -15
+let sigstop = -16
+let sigtstp = -17
+let sigttin = -18
+let sigttou = -19
+let sigvtalrm = -20
+let sigprof = -21
+let sigbus = -22
+let sigpoll = -23
+let sigsys = -24
+let sigtrap = -25
+let sigurg = -26
+let sigxcpu = -27
+let sigxfsz = -28
+
+exception Break
+
+let catch_break on =
+  if on then
+    set_signal sigint (Signal_handle(fun _ -> raise Break))
+  else
+    set_signal sigint Signal_default
+
+
+external enable_runtime_warnings: bool -> unit =
+  "caml_ml_enable_runtime_warnings"
+external runtime_warnings_enabled: unit -> bool =
+  "caml_ml_runtime_warnings_enabled"
+
+(* The version string is found in file ../VERSION *)
+
+let ocaml_version = "%%VERSION%%"
+
+(* Optimization *)
+
+external opaque_identity : 'a -> 'a = "%opaque"
+
+module Immediate64 = struct
+  module type Non_immediate = sig
+    type t
+  end
+  module type Immediate = sig
+    type t [@@immediate]
+  end
+
+  module Make(Immediate : Immediate)(Non_immediate : Non_immediate) = struct
+    type t [@@immediate64]
+    type 'a repr =
+      | Immediate : Immediate.t repr
+      | Non_immediate : Non_immediate.t repr
+    external magic : _ repr -> t repr = "%identity"
+    let repr =
+      if word_size = 64 then
+        magic Immediate
+      else
+        magic Non_immediate
+  end
+end
diff --git a/stdlib/uchar.ml b/stdlib/uchar.ml
new file mode 100644
index 00000000..f48e1b10
--- /dev/null
+++ b/stdlib/uchar.ml
@@ -0,0 +1,58 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                           Daniel C. Buenzli                            *)
+(*                                                                        *)
+(*   Copyright 2014 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+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_latin1 u = "U+" ^ format_int "%04X" u ^ " is not a latin1 character"
+
+type t = int
+
+let min = 0x0000
+let max = 0x10FFFF
+let lo_bound = 0xD7FF
+let hi_bound = 0xE000
+
+let bom = 0xFEFF
+let rep = 0xFFFD
+
+let succ u =
+  if u = lo_bound then hi_bound else
+  if u = max then invalid_arg err_no_succ else
+  u + 1
+
+let pred u =
+  if u = hi_bound then lo_bound else
+  if u = min then invalid_arg err_no_pred else
+  u - 1
+
+let is_valid i = (min <= i && i <= lo_bound) || (hi_bound <= i && i <= max)
+let of_int i = if is_valid i then i else invalid_arg (err_not_sv i)
+external unsafe_of_int : int -> t = "%identity"
+external to_int : t -> int = "%identity"
+
+let is_char u = u < 256
+let of_char c = Char.code c
+let to_char u =
+  if u > 255 then invalid_arg (err_not_latin1 u) else
+  Char.unsafe_chr u
+
+let unsafe_to_char = Char.unsafe_chr
+
+let equal : int -> int -> bool = ( = )
+let compare : int -> int -> int = Stdlib.compare
+let hash = to_int
diff --git a/stdlib/uchar.mli b/stdlib/uchar.mli
new file mode 100644
index 00000000..8ce7a35a
--- /dev/null
+++ b/stdlib/uchar.mli
@@ -0,0 +1,98 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                           Daniel C. Buenzli                            *)
+(*                                                                        *)
+(*   Copyright 2014 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Unicode characters.
+
+    @since 4.03 *)
+
+type t
+(** The type for Unicode characters.
+
+    A value of this type represents a Unicode
+    {{:http://unicode.org/glossary/#unicode_scalar_value}scalar
+    value} which is an integer in the ranges [0x0000]...[0xD7FF] or
+    [0xE000]...[0x10FFFF]. *)
+
+val min : t
+(** [min] is U+0000. *)
+
+val max : t
+(** [max] is U+10FFFF. *)
+
+val bom : t
+(** [bom] is U+FEFF, the
+    {{:http://unicode.org/glossary/#byte_order_mark}byte order mark} (BOM)
+    character.
+
+    @since 4.06.0 *)
+
+val rep : t
+(** [rep] is U+FFFD, the
+    {{:http://unicode.org/glossary/#replacement_character}replacement}
+    character.
+
+    @since 4.06.0 *)
+
+val succ : t -> t
+(** [succ u] is the scalar value after [u] in the set of Unicode scalar
+    values.
+
+    @raise Invalid_argument if [u] is {!max}. *)
+
+val pred : t -> t
+(** [pred u] is the scalar value before [u] in the set of Unicode scalar
+    values.
+
+    @raise Invalid_argument if [u] is {!min}. *)
+
+val is_valid : int -> bool
+(** [is_valid n] is [true] iff [n] is a Unicode scalar value
+    (i.e. in the ranges [0x0000]...[0xD7FF] or [0xE000]...[0x10FFFF]).*)
+
+val of_int : int -> t
+(** [of_int i] is [i] as a Unicode character.
+
+    @raise Invalid_argument if [i] does not satisfy {!is_valid}. *)
+
+(**/**)
+val unsafe_of_int : int -> t
+(**/**)
+
+val to_int : t -> int
+(** [to_int u] is [u] as an integer. *)
+
+val is_char : t -> bool
+(** [is_char u] is [true] iff [u] is a latin1 OCaml character. *)
+
+val of_char : char -> t
+(** [of_char c] is [c] as a Unicode character. *)
+
+val to_char : t -> char
+(** [to_char u] is [u] as an OCaml latin1 character.
+
+    @raise Invalid_argument if [u] does not satisfy {!is_char}. *)
+
+(**/**)
+val unsafe_to_char : t -> char
+(**/**)
+
+val equal : t -> t -> bool
+(** [equal u u'] is [u = u']. *)
+
+val compare : t -> t -> int
+(** [compare u u'] is [Stdlib.compare u u']. *)
+
+val hash : t -> int
+(** [hash u] associates a non-negative integer to [u]. *)
diff --git a/stdlib/unit.ml b/stdlib/unit.ml
new file mode 100644
index 00000000..402c2593
--- /dev/null
+++ b/stdlib/unit.ml
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         The OCaml programmers                          *)
+(*                                                                        *)
+(*   Copyright 2018 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 = unit = ()
+
+let equal () () = true
+let compare () () = 0
+let to_string () = "()"
diff --git a/stdlib/unit.mli b/stdlib/unit.mli
new file mode 100644
index 00000000..e71f279a
--- /dev/null
+++ b/stdlib/unit.mli
@@ -0,0 +1,36 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         The OCaml programmers                          *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Unit values.
+
+    @since 4.08 *)
+
+(** {1:unit The unit type} *)
+
+type t = unit = () (**)
+(** The unit type.
+
+    The constructor [()] is included here so that it has a path,
+    but it is not intended to be used in user-defined data types.
+ *)
+
+val equal : t -> t -> bool
+(** [equal u1 u2] is [true]. *)
+
+val compare : t -> t -> int
+(** [compare u1 u2] is [0]. *)
+
+val to_string : t -> string
+(** [to_string b] is ["()"]. *)
diff --git a/stdlib/weak.ml b/stdlib/weak.ml
new file mode 100644
index 00000000..1746574f
--- /dev/null
+++ b/stdlib/weak.ml
@@ -0,0 +1,372 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Damien Doligez, projet Para, INRIA Rocquencourt            *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Weak array operations *)
+
+type 'a t
+
+external create : int -> 'a t = "caml_weak_create"
+
+let create l =
+  if not (0 <= l && l <= Obj.Ephemeron.max_ephe_length) then
+    invalid_arg("Weak.create");
+  create l
+
+(** number of additional values in a weak pointer *)
+let additional_values = 2
+
+let length x = Obj.size(Obj.repr x) - additional_values
+
+let raise_if_invalid_offset e o msg =
+  if not (0 <= o && o < length e) then
+    invalid_arg(msg)
+
+external set' : 'a t -> int -> 'a -> unit = "caml_ephe_set_key"
+external unset : 'a t -> int -> unit = "caml_ephe_unset_key"
+let set e o x =
+  raise_if_invalid_offset e o "Weak.set";
+  match x with
+  | None -> unset e o
+  | Some x -> set' e o x
+
+external get : 'a t -> int -> 'a option = "caml_weak_get"
+let get e o =
+  raise_if_invalid_offset e o "Weak.get";
+  get e o
+
+external get_copy : 'a t -> int -> 'a option = "caml_weak_get_copy"
+let get_copy e o =
+  raise_if_invalid_offset e o "Weak.get_copy";
+  get_copy e o
+
+external check : 'a t -> int -> bool = "caml_weak_check"
+let check e o =
+  raise_if_invalid_offset e o "Weak.check";
+  check e o
+
+external blit : 'a t -> int -> 'a t -> int -> int -> unit = "caml_weak_blit"
+
+(* blit: src srcoff dst dstoff len *)
+let blit e1 o1 e2 o2 l =
+  if l < 0 || o1 < 0 || o1 > length e1 - l
+     || o2 < 0 || o2 > length e2 - l
+  then invalid_arg "Weak.blit"
+  else if l <> 0 then blit e1 o1 e2 o2 l
+
+let fill ar ofs len x =
+  if ofs < 0 || len < 0 || ofs > length ar - len
+  then raise (Invalid_argument "Weak.fill")
+  else begin
+    for i = ofs to (ofs + len - 1) do
+      set ar i x
+    done
+  end
+
+
+(** Weak hash tables *)
+
+module type S = sig
+  type data
+  type t
+  val create : int -> t
+  val clear : t -> unit
+  val merge : t -> data -> data
+  val add : t -> data -> unit
+  val remove : t -> data -> unit
+  val find : t -> data -> data
+  val find_opt : t -> data -> data option
+  val find_all : t -> data -> data list
+  val mem : t -> data -> bool
+  val iter : (data -> unit) -> t -> unit
+  val fold : (data -> 'a -> 'a) -> t -> 'a -> 'a
+  val count : t -> int
+  val stats : t -> int * int * int * int * int * int
+end
+
+module Make (H : Hashtbl.HashedType) : (S with type data = H.t) = struct
+
+  type 'a weak_t = 'a t
+  let weak_create = create
+  let emptybucket = weak_create 0
+
+  type data = H.t
+
+  type t = {
+    mutable table : data weak_t array;
+    mutable hashes : int array array;
+    mutable limit : int;               (* bucket size limit *)
+    mutable oversize : int;            (* number of oversize buckets *)
+    mutable rover : int;               (* for internal bookkeeping *)
+  }
+
+  let get_index t h = (h land max_int) mod (Array.length t.table)
+
+  let limit = 7
+  let over_limit = 2
+
+  let create sz =
+    let sz = if sz < 7 then 7 else sz in
+    let sz = if sz > Sys.max_array_length then Sys.max_array_length else sz in
+    {
+      table = Array.make sz emptybucket;
+      hashes = Array.make sz [| |];
+      limit = limit;
+      oversize = 0;
+      rover = 0;
+    }
+
+  let clear t =
+    for i = 0 to Array.length t.table - 1 do
+      t.table.(i) <- emptybucket;
+      t.hashes.(i) <- [| |];
+    done;
+    t.limit <- limit;
+    t.oversize <- 0
+
+
+  let fold f t init =
+    let rec fold_bucket i b accu =
+      if i >= length b then accu else
+      match get b i with
+      | Some v -> fold_bucket (i+1) b (f v accu)
+      | None -> fold_bucket (i+1) b accu
+    in
+    Array.fold_right (fold_bucket 0) t.table init
+
+
+  let iter f t =
+    let rec iter_bucket i b =
+      if i >= length b then () else
+      match get b i with
+      | Some v -> f v; iter_bucket (i+1) b
+      | None -> iter_bucket (i+1) b
+    in
+    Array.iter (iter_bucket 0) t.table
+
+
+  let iter_weak f t =
+    let rec iter_bucket i j b =
+      if i >= length b then () else
+      match check b i with
+      | true -> f b t.hashes.(j) i; iter_bucket (i+1) j b
+      | false -> iter_bucket (i+1) j b
+    in
+    Array.iteri (iter_bucket 0) t.table
+
+
+  let rec count_bucket i b accu =
+    if i >= length b then accu else
+    count_bucket (i+1) b (accu + (if check b i then 1 else 0))
+
+
+  let count t =
+    Array.fold_right (count_bucket 0) t.table 0
+
+
+  let next_sz n = min (3 * n / 2 + 3) Sys.max_array_length
+  let prev_sz n = ((n - 3) * 2 + 2) / 3
+
+  let test_shrink_bucket t =
+    let bucket = t.table.(t.rover) in
+    let hbucket = t.hashes.(t.rover) in
+    let len = length bucket in
+    let prev_len = prev_sz len in
+    let live = count_bucket 0 bucket 0 in
+    if live <= prev_len then begin
+      let rec loop i j =
+        if j >= prev_len then begin
+          if check bucket i then loop (i + 1) j
+          else if check bucket j then begin
+            blit bucket j bucket i 1;
+            hbucket.(i) <- hbucket.(j);
+            loop (i + 1) (j - 1);
+          end else loop i (j - 1);
+        end;
+      in
+      loop 0 (length bucket - 1);
+      if prev_len = 0 then begin
+        t.table.(t.rover) <- emptybucket;
+        t.hashes.(t.rover) <- [| |];
+      end else begin
+        let newbucket = weak_create prev_len in
+        blit bucket 0 newbucket 0 prev_len;
+        t.table.(t.rover) <- newbucket;
+        t.hashes.(t.rover) <- Array.sub hbucket 0 prev_len
+      end;
+      if len > t.limit && prev_len <= t.limit then t.oversize <- t.oversize - 1;
+    end;
+    t.rover <- (t.rover + 1) mod (Array.length t.table)
+
+
+  let rec resize t =
+    let oldlen = Array.length t.table in
+    let newlen = next_sz oldlen in
+    if newlen > oldlen then begin
+      let newt = create newlen in
+      let add_weak ob oh oi =
+        let setter nb ni _ = blit ob oi nb ni 1 in
+        let h = oh.(oi) in
+        add_aux newt setter None h (get_index newt h);
+      in
+      iter_weak add_weak t;
+      t.table <- newt.table;
+      t.hashes <- newt.hashes;
+      t.limit <- newt.limit;
+      t.oversize <- newt.oversize;
+      t.rover <- t.rover mod Array.length newt.table;
+    end else begin
+      t.limit <- max_int;             (* maximum size already reached *)
+      t.oversize <- 0;
+    end
+
+  and add_aux t setter d h index =
+    let bucket = t.table.(index) in
+    let hashes = t.hashes.(index) in
+    let sz = length bucket in
+    let rec loop i =
+      if i >= sz then begin
+        let newsz =
+          min (3 * sz / 2 + 3) (Sys.max_array_length - additional_values)
+        in
+        if newsz <= sz then failwith "Weak.Make: hash bucket cannot grow more";
+        let newbucket = weak_create newsz in
+        let newhashes = Array.make newsz 0 in
+        blit bucket 0 newbucket 0 sz;
+        Array.blit hashes 0 newhashes 0 sz;
+        setter newbucket sz d;
+        newhashes.(sz) <- h;
+        t.table.(index) <- newbucket;
+        t.hashes.(index) <- newhashes;
+        if sz <= t.limit && newsz > t.limit then begin
+          t.oversize <- t.oversize + 1;
+          for _i = 0 to over_limit do test_shrink_bucket t done;
+        end;
+        if t.oversize > Array.length t.table / over_limit then resize t;
+      end else if check bucket i then begin
+        loop (i + 1)
+      end else begin
+        setter bucket i d;
+        hashes.(i) <- h;
+      end;
+    in
+    loop 0
+
+
+  let add t d =
+    let h = H.hash d in
+    add_aux t set (Some d) h (get_index t h)
+
+
+  let find_or t d ifnotfound =
+    let h = H.hash d in
+    let index = get_index t h in
+    let bucket = t.table.(index) in
+    let hashes = t.hashes.(index) in
+    let sz = length bucket in
+    let rec loop i =
+      if i >= sz then ifnotfound h index
+      else if h = hashes.(i) then begin
+        match get_copy bucket i with
+        | Some v when H.equal v d
+           -> begin match get bucket i with
+              | Some v -> v
+              | None -> loop (i + 1)
+              end
+        | _ -> loop (i + 1)
+      end else loop (i + 1)
+    in
+    loop 0
+
+
+  let merge t d =
+    find_or t d (fun h index -> add_aux t set (Some d) h index; d)
+
+
+  let find t d = find_or t d (fun _h _index -> raise Not_found)
+
+  let find_opt t d =
+    let h = H.hash d in
+    let index = get_index t h in
+    let bucket = t.table.(index) in
+    let hashes = t.hashes.(index) in
+    let sz = length bucket in
+    let rec loop i =
+      if i >= sz then None
+      else if h = hashes.(i) then begin
+        match get_copy bucket i with
+        | Some v when H.equal v d
+           -> begin match get bucket i with
+              | Some _ as v -> v
+              | None -> loop (i + 1)
+              end
+        | _ -> loop (i + 1)
+      end else loop (i + 1)
+    in
+    loop 0
+
+
+  let find_shadow t d iffound ifnotfound =
+    let h = H.hash d in
+    let index = get_index t h in
+    let bucket = t.table.(index) in
+    let hashes = t.hashes.(index) in
+    let sz = length bucket in
+    let rec loop i =
+      if i >= sz then ifnotfound
+      else if h = hashes.(i) then begin
+        match get_copy bucket i with
+        | Some v when H.equal v d -> iffound bucket i
+        | _ -> loop (i + 1)
+      end else loop (i + 1)
+    in
+    loop 0
+
+
+  let remove t d = find_shadow t d (fun w i -> set w i None) ()
+
+
+  let mem t d = find_shadow t d (fun _w _i -> true) false
+
+
+  let find_all t d =
+    let h = H.hash d in
+    let index = get_index t h in
+    let bucket = t.table.(index) in
+    let hashes = t.hashes.(index) in
+    let sz = length bucket in
+    let rec loop i accu =
+      if i >= sz then accu
+      else if h = hashes.(i) then begin
+        match get_copy bucket i with
+        | Some v when H.equal v d
+           -> begin match get bucket i with
+              | Some v -> loop (i + 1) (v :: accu)
+              | None -> loop (i + 1) accu
+              end
+        | _ -> loop (i + 1) accu
+      end else loop (i + 1) accu
+    in
+    loop 0 []
+
+
+  let stats t =
+    let len = Array.length t.table in
+    let lens = Array.map length t.table in
+    Array.sort compare lens;
+    let totlen = Array.fold_left ( + ) 0 lens in
+    (len, count t, totlen, lens.(0), lens.(len/2), lens.(len-1))
+
+
+end
diff --git a/stdlib/weak.mli b/stdlib/weak.mli
new file mode 100644
index 00000000..878e590a
--- /dev/null
+++ b/stdlib/weak.mli
@@ -0,0 +1,190 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Damien Doligez, projet Para, INRIA Rocquencourt            *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Arrays of weak pointers and hash sets of weak pointers. *)
+
+
+(** {1 Low-level functions} *)
+
+type 'a t
+(** The type of arrays of weak pointers (weak arrays).  A weak
+   pointer is a value that the garbage collector may erase whenever
+   the value is not used any more (through normal pointers) by the
+   program.  Note that finalisation functions are run before the
+   weak pointers are erased, because the finalisation functions
+   can make values alive again (before 4.03 the finalisation
+   functions were run after).
+
+   A weak pointer is said to be full if it points to a value,
+   empty if the value was erased by the GC.
+
+   Notes:
+   - Integers are not allocated and cannot be stored in weak arrays.
+   - Weak arrays cannot be marshaled using {!Stdlib.output_value}
+     nor the functions of the {!Marshal} module.
+*)
+
+
+val create : int -> 'a t
+(** [Weak.create n] returns a new weak array of length [n].
+   All the pointers are initially empty.
+   @raise Invalid_argument
+   if [n] is not comprised between zero and
+   {!Obj.Ephemeron.max_ephe_length} (limits included).*)
+
+val length : 'a t -> int
+(** [Weak.length ar] returns the length (number of elements) of
+   [ar].*)
+
+val set : 'a t -> int -> 'a option -> unit
+(** [Weak.set ar n (Some el)] sets the [n]th cell of [ar] to be a
+   (full) pointer to [el]; [Weak.set ar n None] sets the [n]th
+   cell of [ar] to empty.
+   @raise Invalid_argument if [n] is not in the range
+   0 to {!Weak.length}[ a - 1].*)
+
+val get : 'a t -> int -> 'a option
+(** [Weak.get ar n] returns None if the [n]th cell of [ar] is
+   empty, [Some x] (where [x] is the value) if it is full.
+   @raise Invalid_argument if [n] is not in the range
+   0 to {!Weak.length}[ a - 1].*)
+
+val get_copy : 'a t -> int -> 'a option
+(** [Weak.get_copy ar n] returns None if the [n]th cell of [ar] is
+   empty, [Some x] (where [x] is a (shallow) copy of the value) if
+   it is full.
+   In addition to pitfalls with mutable values, the interesting
+   difference with [get] is that [get_copy] does not prevent
+   the incremental GC from erasing the value in its current cycle
+   ([get] may delay the erasure to the next GC cycle).
+   @raise Invalid_argument if [n] is not in the range
+   0 to {!Weak.length}[ a - 1].
+
+   If the element is a custom block it is not copied.
+
+*)
+
+
+val check : 'a t -> int -> bool
+(** [Weak.check ar n] returns [true] if the [n]th cell of [ar] is
+   full, [false] if it is empty.  Note that even if [Weak.check ar n]
+   returns [true], a subsequent {!Weak.get}[ ar n] can return [None].*)
+
+val fill : 'a t -> int -> int -> 'a option -> unit
+(** [Weak.fill ar ofs len el] sets to [el] all pointers of [ar] from
+   [ofs] to [ofs + len - 1].
+   @raise Invalid_argument
+   if [ofs] and [len] do not designate a valid subarray of [a].*)
+
+val blit : 'a t -> int -> 'a t -> int -> int -> unit
+(** [Weak.blit ar1 off1 ar2 off2 len] copies [len] weak pointers
+   from [ar1] (starting at [off1]) to [ar2] (starting at [off2]).
+   It works correctly even if [ar1] and [ar2] are the same.
+   @raise Invalid_argument if [off1] and [len] do
+   not designate a valid subarray of [ar1], or if [off2] and [len]
+   do not designate a valid subarray of [ar2].*)
+
+
+(** {1 Weak hash sets} *)
+
+(** A weak hash set is a hashed set of values.  Each value may
+    magically disappear from the set when it is not used by the
+    rest of the program any more.  This is normally used to share
+    data structures without inducing memory leaks.
+    Weak hash sets are defined on values from a {!Hashtbl.HashedType}
+    module; the [equal] relation and [hash] function are taken from that
+    module.  We will say that [v] is an instance of [x] if [equal x v]
+    is [true].
+
+    The [equal] relation must be able to work on a shallow copy of
+    the values and give the same result as with the values themselves.
+    *)
+
+module type S = sig
+  type data
+  (** The type of the elements stored in the table. *)
+
+  type t
+    (** The type of tables that contain elements of type [data].
+        Note that weak hash sets cannot be marshaled using
+        {!Stdlib.output_value} or the functions of the {!Marshal}
+        module. *)
+
+  val create : int -> t
+    (** [create n] creates a new empty weak hash set, of initial
+        size [n].  The table will grow as needed. *)
+
+  val clear : t -> unit
+  (** Remove all elements from the table. *)
+
+  val merge : t -> data -> data
+    (** [merge t x] returns an instance of [x] found in [t] if any,
+        or else adds [x] to [t] and return [x]. *)
+
+  val add : t -> data -> unit
+    (** [add t x] adds [x] to [t].  If there is already an instance
+        of [x] in [t], it is unspecified which one will be
+        returned by subsequent calls to [find] and [merge]. *)
+
+  val remove : t -> data -> unit
+    (** [remove t x] removes from [t] one instance of [x].  Does
+        nothing if there is no instance of [x] in [t]. *)
+
+  val find : t -> data -> data
+    (** [find t x] returns an instance of [x] found in [t].
+        @raise Not_found if there is no such element. *)
+
+  val find_opt: t -> data -> data option
+    (** [find_opt t x] returns an instance of [x] found in [t]
+        or [None] if there is no such element.
+        @since 4.05
+    *)
+
+  val find_all : t -> data -> data list
+    (** [find_all t x] returns a list of all the instances of [x]
+        found in [t]. *)
+
+  val mem : t -> data -> bool
+    (** [mem t x] returns [true] if there is at least one instance
+        of [x] in [t], false otherwise. *)
+
+  val iter : (data -> unit) -> t -> unit
+    (** [iter f t] calls [f] on each element of [t], in some unspecified
+        order.  It is not specified what happens if [f] tries to change
+        [t] itself. *)
+
+  val fold : (data -> 'a -> 'a) -> t -> 'a -> 'a
+    (** [fold f t init] computes [(f d1 (... (f dN init)))] where
+        [d1 ... dN] are the elements of [t] in some unspecified order.
+        It is not specified what happens if [f] tries to change [t]
+        itself. *)
+
+  val count : t -> int
+    (** Count the number of elements in the table.  [count t] gives the
+        same result as [fold (fun _ n -> n+1) t 0] but does not delay the
+        deallocation of the dead elements. *)
+
+  val stats : t -> int * int * int * int * int * int
+    (** Return statistics on the table.  The numbers are, in order:
+        table length, number of entries, sum of bucket lengths,
+        smallest bucket length, median bucket length, biggest bucket length. *)
+end
+(** The output signature of the functor {!Weak.Make}. *)
+
+module Make (H : Hashtbl.HashedType) : S with type data = H.t
+(** Functor building an implementation of the weak hash set structure.
+    [H.equal] can't be the physical equality, since only shallow
+    copies of the elements in the set are given to it.
+ *)
diff --git a/testsuite/HACKING.adoc b/testsuite/HACKING.adoc
new file mode 100644
index 00000000..3d010e54
--- /dev/null
+++ b/testsuite/HACKING.adoc
@@ -0,0 +1,32 @@
+== Running the testsuite
+
+== Creating a new test
+
+== Useful Makefile targets
+
+`make parallel`::
+  runs the tests in parallel using the
+  link:https://www.gnu.org/software/parallel/[GNU parallel] tool: tests run
+  twice as fast with no difference in output order.
+
+`make all-foo`, `make parallel-foo`::
+  runs only the tests in the directories whose name starts with `foo`:
+  `parallel-typing`, `all-lib`, etc.
+
+`make one DIR=tests/foo`::
+  runs only the tests in the directory `tests/foo`. This is often equivalent to
+  `cd tests/foo && make`, but sometimes the latter breaks the test makefile if
+  it contains fragile relative filesystem paths. Such errors should be fixed if
+  you find them, but `make one DIR=...` is the more reliable option as it runs
+  exactly as `make all` which is heavily tested.
+
+`make promote DIR=tests/foo`::
+  Most tests run a program and compare the result of the program, store in a file
+  `foo.result`, with a reference output stored in `foo.reference` -- the test
+  fails if the two output differ. Sometimes a change in result is innocuous, it
+  comes from an intended change in output instead of a regression.
+  `make promote` copies the new result file into the reference file, making the
+  test pass again. Whenever you use this rule please check carefully, using
+  `git diff`, that the change really corresponds to an intended output
+  difference, and not to a regression. You then need to commit the change to
+  reference file, and your commit message should explain why the output changed.
diff --git a/testsuite/Makefile b/testsuite/Makefile
new file mode 100644
index 00000000..5cd2d6df
--- /dev/null
+++ b/testsuite/Makefile
@@ -0,0 +1,307 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                 Xavier Clerc, SED, INRIA Rocquencourt                  *
+#*                                                                        *
+#*   Copyright 2010 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+.NOTPARALLEL:
+
+BASEDIR := $(shell pwd)
+NO_PRINT=`$(MAKE) empty --no-print-directory >/dev/null 2>&1 \
+	  && echo --no-print-directory`
+
+FIND=find
+TOPDIR := ..
+include $(TOPDIR)/Makefile.tools
+
+OCAMLTESTDIR_CYGPATH=$(shell $(CYGPATH) $(BASEDIR)/$(DIR)/_ocamltest)
+
+failstamp := failure.stamp
+
+TESTLOG ?= _log
+
+ocamltest_directory := ../ocamltest
+
+ocamltest_program := $(or \
+  $(wildcard $(ocamltest_directory)/ocamltest.opt$(EXE)),\
+  $(wildcard $(ocamltest_directory)/ocamltest$(EXE)))
+
+ifeq "$(UNIX_OR_WIN32)" "unix"
+  ifeq "$(SYSTEM)" "cygwin"
+    find := /usr/bin/find
+  else # Non-cygwin Unix
+    find := find
+  endif
+  FLEXLINK_ENV =
+else # Windows
+  find := /usr/bin/find
+  FLEXDLL_SUBMODULE_PRESENT := $(wildcard ../flexdll/Makefile)
+  ifeq "$(FLEXDLL_SUBMODULE_PRESENT)" ""
+    FLEXLINK_ENV =
+  else
+    ROOT := $(shell cd .. && pwd| cygpath -m -f -)
+    FLEXLINK_ENV = \
+      OCAML_FLEXLINK="$(ROOT)/boot/ocamlrun $(ROOT)/flexdll/flexlink.exe"
+  endif
+endif
+
+ifeq "$(FLEXLINK_ENV)" ""
+  ocamltest := MKDLL="$(MKDLL)" SORT=$(SORT) MAKE=$(MAKE) $(ocamltest_program)
+else
+  MKDLL=$(WINTOPDIR)/boot/ocamlrun $(WINTOPDIR)/flexdll/flexlink.exe \
+                                   $(FLEXLINK_FLAGS)
+
+  ocamltest := $(FLEXLINK_ENV) MKDLL="$(MKDLL)" SORT=$(SORT) MAKE=$(MAKE) \
+                               $(ocamltest_program)
+endif
+
+# PROMOTE is only meant to be used internally in recursive calls;
+# users should call the 'promote' target explicitly.
+PROMOTE =
+ifeq "$(PROMOTE)" ""
+  OCAMLTEST_PROMOTE_FLAG :=
+else
+  OCAMLTEST_PROMOTE_FLAG := -promote
+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 succesful tests.
+KEEP_TEST_DIR_ON_SUCCESS ?=
+ifeq "$(KEEP_TEST_DIR_ON_SUCCESS)" ""
+  OCAMLTEST_KEEP_TEST_DIR_ON_SUCCESS_FLAG :=
+else
+  OCAMLTEST_KEEP_TEST_DIR_ON_SUCCESS_FLAG := -keep-test-dir-on-success
+endif
+
+OCAMLTESTFLAGS := \
+  $(OCAMLTEST_PROMOTE_FLAG) \
+  $(OCAMLTEST_KEEP_TEST_DIR_ON_SUCCESS_FLAG)
+
+.PHONY: default
+default:
+	@echo "Available targets:"
+	@echo "  all             launch all tests"
+	@echo "  all-foo         launch all tests beginning with foo"
+	@echo "  parallel        launch all tests using GNU parallel"
+	@echo "  parallel-foo    launch all tests beginning with foo using \
+	GNU parallel"
+	@echo "  list FILE=f     launch the tests listed in f (one per line)"
+	@echo "  one DIR=p       launch the tests located in path p"
+	@echo "  promote DIR=p   promote the reference files for the tests in p"
+	@echo "  lib             build library modules"
+	@echo "  tools           build test tools"
+	@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))"
+
+.PHONY: all
+all:
+	@rm -f $(TESTLOG)
+	@$(MAKE) $(NO_PRINT) new-without-report
+	@$(MAKE) $(NO_PRINT) report
+
+.PHONY: new-without-report
+new-without-report: lib tools
+	@rm -f $(failstamp)
+	@(IFS=$$(printf "\r\n"); \
+	$(ocamltest) -find-test-dirs tests | while read dir; do \
+	  echo Running tests from \'$$dir\' ... ; \
+	  $(MAKE) exec-ocamltest DIR=$$dir \
+	    OCAMLTESTENV=""; \
+	done || echo outer loop >> $(failstamp)) 2>&1 | tee -a $(TESTLOG)
+	@$(MAKE) check-failstamp
+
+.PHONY: check-failstamp
+check-failstamp:
+	@if [ -f $(failstamp) ]; then \
+	  echo 'Unexpected error in the test infrastructure:'; \
+	  cat $(failstamp); \
+	  rm $(failstamp); \
+	  exit 1; \
+	fi
+
+.PHONY: all-%
+all-%: lib tools
+	@for dir in tests/$**; do \
+	  $(MAKE) $(NO_PRINT) exec-one DIR=$$dir; \
+	done 2>&1 | tee $(TESTLOG)
+	@$(MAKE) $(NO_PRINT) retries
+	@$(MAKE) report
+
+# The targets below use GNU parallel to parallelize tests
+# 'make all' and 'make parallel' should be equivalent
+#
+# parallel uses specific logic to make sure the output of the commands
+# run in parallel are not mangled. By default, it will reproduce
+# the output of each completed command atomically, in order of completion.
+#
+# With the --keep-order option, we ask it to save the completed output
+# and replay them in invocation order instead. In theory this costs
+# a tiny bit of performance, but I could not measure any difference.
+# In theory again, the reporting logic works fine with test outputs
+# coming in in arbitrary order (so we should not need --keep-order),
+# but keeping the output deterministic is guaranteed to make
+# someone's life easier at least once in the future.
+#
+# Finally, note that the command we run has a 2>&1 redirection, as
+# in the other make targets. If we removed the quoting around
+# "$(MAKE) ... 2>&1", the rediction would apply to the complete output
+# of parallel, and have a slightly different behavior: by default parallel
+# cleanly separates the stdout and stderr output of each completed command,
+# printing stderr first then stdout second (for each command).
+# I chose to keep the previous behavior exactly unchanged,
+# but the demangling separation is arguably nicer behavior that we might
+# want to implement at the exec-one level to also have it in the 'all' target.
+.PHONY: parallel-%
+parallel-%: lib tools
+	@echo | parallel >/dev/null 2>/dev/null \
+	 || (echo "Unable to run the GNU parallel tool;";\
+	     echo "You should install it before using the parallel* targets.";\
+	     exit 1)
+	@echo | parallel --gnu --no-notice >/dev/null 2>/dev/null \
+	 || (echo "Your 'parallel' tool seems incompatible with GNU parallel.";\
+	     echo "This target requires GNU parallel.";\
+	     exit 1)
+	@for dir in tests/$**; do echo $$dir; done \
+	 | parallel --gnu --no-notice --keep-order \
+	     "$(MAKE) $(NO_PRINT) exec-one DIR={} 2>&1" \
+	 | tee $(TESTLOG)
+	@$(MAKE) $(NO_PRINT) retries
+	@$(MAKE) report
+
+.PHONY: parallel
+parallel: parallel-*
+
+.PHONY: list
+list: lib tools
+	@if [ -z "$(FILE)" ]; \
+	  then echo "No value set for variable 'FILE'."; \
+	  exit 1; \
+	fi
+	@while read LINE; do \
+	  $(MAKE) $(NO_PRINT) exec-one DIR=$$LINE; \
+	done <$(FILE) 2>&1 | tee $(TESTLOG)
+	@$(MAKE) $(NO_PRINT) retries
+	@$(MAKE) report
+
+.PHONY: one
+one: lib tools
+	@if [ -z "$(DIR)" ]; then \
+	  echo "No value set for variable 'DIR'."; \
+	  exit 1; \
+	fi
+	@if [ ! -d $(DIR) ]; then \
+	  echo "Directory '$(DIR)' does not exist."; \
+	  exit 1; \
+	fi
+	@$(MAKE) $(NO_PRINT) exec-one DIR=$(DIR)
+	@$(MAKE) check-failstamp
+
+.PHONY: exec-one
+exec-one:
+	@if $(ocamltest) -list-tests $(DIR) >/dev/null 2>&1; then \
+	  echo "Running tests from '$$DIR' ..."; \
+	  $(MAKE) exec-ocamltest DIR=$(DIR) \
+	    OCAMLTESTENV="OCAMLTESTDIR=$(OCAMLTESTDIR_CYGPATH)"; \
+	else \
+	  for dir in $(DIR)/*; do \
+	    if [ -d $$dir ]; then \
+	      $(MAKE) exec-one DIR=$$dir; \
+	    fi; \
+	  done; \
+	fi
+
+.PHONY: exec-ocamltest
+exec-ocamltest:
+	@if [ -z "$(DIR)" ]; then exit 1; fi
+	@if [ ! -d "$(DIR)" ]; then exit 1; fi
+	@(IFS=$$(printf "\r\n"); \
+	$(ocamltest) -list-tests $(DIR) | while read testfile; do \
+	   TERM=dumb $(OCAMLTESTENV) \
+	     $(ocamltest) $(OCAMLTESTFLAGS) $(DIR)/$$testfile || \
+	   echo " ... testing '$$testfile' => unexpected error"; \
+	done) || echo directory "$(DIR)" >>$(failstamp)
+
+.PHONY: clean-one
+clean-one:
+	@if [ ! -f $(DIR)/Makefile ]; then \
+	  for dir in $(DIR)/*; do \
+	    if [ -d $$dir ]; then \
+	      $(MAKE) clean-one DIR=$$dir; \
+	    fi; \
+	  done; \
+	else \
+	  cd $(DIR) && $(MAKE) TERM=dumb BASEDIR=$(BASEDIR) clean; \
+	fi
+
+.PHONY: promote
+promote:
+	@if [ -z "$(DIR)" ]; then \
+	  echo "No value set for variable 'DIR'."; \
+	  exit 1; \
+	fi
+	@if [ ! -d $(DIR) ]; then \
+	  echo "Directory '$(DIR)' does not exist."; \
+	  exit 1; \
+	fi
+	@if $(ocamltest) -list-tests $(DIR) >/dev/null 2>&1; then \
+	  $(MAKE) exec-ocamltest DIR=$(DIR) \
+	    OCAMLTESTENV="OCAMLTESTDIR=$(OCAMLTESTDIR_CYGPATH)" \
+	    PROMOTE="true"; \
+	else \
+	  cd $(DIR) && $(MAKE) TERM=dumb BASEDIR=$(BASEDIR) promote; \
+	fi
+
+.PHONY: lib
+lib:
+	@$(MAKE) -s -C lib
+
+.PHONY: tools
+tools:
+	@cd tools && $(MAKE) -s BASEDIR=$(BASEDIR)
+
+.PHONY: clean
+clean:
+	@$(MAKE) -C lib clean
+	@cd tools && $(MAKE) BASEDIR=$(BASEDIR) clean
+	$(FIND) . -name '*_ocamltest*' | xargs rm -rf
+	rm -f $(failstamp)
+
+.PHONY: report
+report:
+	@if [ ! -f $(TESTLOG) ]; then echo "No $(TESTLOG) file."; exit 1; fi
+	@$(AWK) -f ./summarize.awk < $(TESTLOG)
+
+.PHONY: retry-list
+retry-list:
+	@while read LINE; do \
+	  if [ -n "$$LINE" ] ; then \
+	    echo re-ran $$LINE>> $(TESTLOG); \
+	    $(MAKE) $(NO_PRINT) clean-one DIR=$$LINE; \
+	    $(MAKE) $(NO_PRINT) exec-one DIR=$$LINE 2>&1 | tee -a $(TESTLOG) ; \
+	  fi \
+	done <_retries;
+	@$(MAKE) $(NO_PRINT) retries
+
+.PHONY: retries
+retries:
+	@$(AWK) -v retries=1 -v max_retries=$(MAX_TESTSUITE_DIR_RETRIES) \
+	     -f ./summarize.awk < $(TESTLOG) > _retries
+	@test `cat _retries | wc -l` -eq 0 || $(MAKE) $(NO_PRINT) retry-list
+	@rm -f _retries
+
+.PHONY: empty
+empty:
diff --git a/testsuite/lib/Makefile b/testsuite/lib/Makefile
new file mode 100644
index 00000000..740a9ca8
--- /dev/null
+++ b/testsuite/lib/Makefile
@@ -0,0 +1,52 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                 Xavier Clerc, SED, INRIA Rocquencourt                  *
+#*                                                                        *
+#*   Copyright 2010 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+.NOTPARALLEL:
+
+TOPDIR = ../..
+COMPFLAGS ?=
+RUNTIME_VARIANT ?=
+
+include $(TOPDIR)/Makefile.tools
+
+libraries := testing.cmi testing.cma lib.cmo
+
+# If the native compiler is enabled, then also compile testing.cmxa
+ifeq "$(NATIVE_COMPILER)" "true"
+libraries += testing.cmxa
+endif
+
+all: $(libraries)
+
+testing.cma: testing.cmo
+	$(OCAMLC) -a -linkall -o $@ $<
+
+testing.cmxa: testing.cmx
+	$(OCAMLOPT) -a -linkall -o $@ $<
+
+testing.cmo : testing.cmi
+
+%.cmi: %.mli
+	$(OCAMLC) -c $<
+
+%.cmo: %.ml
+	$(OCAMLC) -c $<
+
+%.cmx: %.ml
+	$(OCAMLOPT) -c $<
+
+.PHONY: clean
+clean:
+	rm -f *.cm* *.o *.obj *.a *.lib
diff --git a/testsuite/lib/lib.ml b/testsuite/lib/lib.ml
new file mode 100644
index 00000000..59b8549d
--- /dev/null
+++ b/testsuite/lib/lib.ml
@@ -0,0 +1,57 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Damien Doligez, projet Para, INRIA Rocquencourt            *)
+(*                                                                        *)
+(*   Copyright 1999 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+external raise : exn -> 'a = "%raise"
+
+external not : bool -> bool = "%boolnot"
+
+external (=) : 'a -> 'a -> bool = "%equal"
+external (<>) : 'a -> 'a -> bool = "%notequal"
+external (<) : 'a -> 'a -> bool = "%lessthan"
+external (>) : 'a -> 'a -> bool = "%greaterthan"
+external (<=) : 'a -> 'a -> bool = "%lessequal"
+external (>=) : 'a -> 'a -> bool = "%greaterequal"
+
+external (~-) : int -> int = "%negint"
+external (+) : int -> int -> int = "%addint"
+external (-) : int -> int -> int = "%subint"
+external ( * ) : int -> int -> int = "%mulint"
+external (/) : int -> int -> int = "%divint"
+external (mod) : int -> int -> int = "%modint"
+
+external (land) : int -> int -> int = "%andint"
+external (lor) : int -> int -> int = "%orint"
+external (lxor) : int -> int -> int = "%xorint"
+external (lsl) : int -> int -> int = "%lslint"
+external (lsr) : int -> int -> int = "%lsrint"
+external (asr) : int -> int -> int = "%asrint"
+
+external ignore : 'a -> unit = "%ignore"
+
+type 'a ref = { mutable contents: 'a }
+external ref : 'a -> 'a ref = "%makemutable"
+external (!) : 'a ref -> 'a = "%field0"
+external (:=) : 'a ref -> 'a -> unit = "%setfield0"
+external incr : int ref -> unit = "%incr"
+external decr : int ref -> unit = "%decr"
+
+type 'a option = None | Some of 'a
+
+type 'a weak_t;;
+external weak_create: int -> 'a weak_t = "caml_weak_create";;
+external weak_set : 'a weak_t -> int -> 'a option -> unit = "caml_weak_set";;
+external weak_get: 'a weak_t -> int -> 'a option = "caml_weak_get";;
+
+let x = 42;;
diff --git a/testsuite/lib/testing.ml b/testsuite/lib/testing.ml
new file mode 100644
index 00000000..4111ca51
--- /dev/null
+++ b/testsuite/lib/testing.ml
@@ -0,0 +1,96 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*              Pierre Weis, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2006 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Testing auxiliaries. *)
+
+open Scanf;;
+
+let all_tests_ok = ref true;;
+
+let finish () =
+  match !all_tests_ok with
+  | true ->
+      print_endline "\nAll tests succeeded."
+  | _ ->
+      print_endline "\n\n********* Test suite failed. ***********\n";;
+
+at_exit finish;;
+
+let test_num = ref (-1);;
+
+let print_test_number () =
+  print_string " "; print_int !test_num; flush stdout;;
+
+let next_test () =
+  incr test_num;
+  print_test_number ();;
+
+let print_test_fail () =
+  all_tests_ok := false;
+  print_string
+   (Printf.sprintf "\n********* Test number %i failed ***********\n"
+    !test_num);;
+
+let print_failure_test_fail () =
+  all_tests_ok := false;
+  print_string
+   (Printf.sprintf
+      "\n********* Failure Test number %i incorrectly failed ***********\n"
+    !test_num);;
+
+let print_failure_test_succeed () =
+  all_tests_ok := false;
+  print_string
+   (Printf.sprintf
+      "\n********* Failure Test number %i failed to fail ***********\n"
+    !test_num);;
+
+let test b =
+  next_test ();
+  if not b then print_test_fail ();;
+
+(* Applies f to x and checks that the evaluation indeed
+   raises an exception that verifies the predicate [pred]. *)
+let test_raises_exc_p pred f x =
+  next_test ();
+  try
+    ignore (f x);
+    print_failure_test_succeed ();
+    false
+  with
+  | x ->
+    pred x || (print_failure_test_fail (); false);;
+
+(* Applies f to x and checks that the evaluation indeed
+   raises some exception. *)
+let test_raises_some_exc f = test_raises_exc_p (fun _ -> true) f;;
+let test_raises_this_exc exc = test_raises_exc_p (fun x -> x = exc);;
+
+(* Applies f to x and checks that the evaluation indeed
+   raises exception Failure s. *)
+
+let test_raises_this_failure s f x =
+  test_raises_exc_p (fun x -> x = Failure s) f x;;
+
+(* Applies f to x and checks that the evaluation indeed
+   raises the exception Failure. *)
+let test_raises_some_failure f x =
+  test_raises_exc_p (function Failure _ -> true | _ -> false) f x;;
+
+let failure_test f x s = test_raises_this_failure s f x;;
+let any_failure_test = test_raises_some_failure;;
+
+let scan_failure_test f x =
+  test_raises_exc_p (function Scan_failure _ -> true | _ -> false) f x;;
diff --git a/testsuite/lib/testing.mli b/testsuite/lib/testing.mli
new file mode 100644
index 00000000..ce054156
--- /dev/null
+++ b/testsuite/lib/testing.mli
@@ -0,0 +1,35 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*              Pierre Weis, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2006 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Testing auxiliaries. *)
+
+val test : bool -> unit;;
+(** [test e] tests that [e] evaluates to [true]. *)
+val failure_test : ('a -> 'b) -> 'a -> string -> bool;;
+(** [failure_test f x s] tests that [f x] raises the exception [Failure s]. *)
+
+val test_raises_some_exc : ('a -> 'b) -> 'a -> bool;;
+(** [test_raises_some_exc f x] tests that [f x] raises an exception. *)
+
+val test_raises_this_exc : exn -> ('a -> 'b) -> 'a -> bool;;
+(** [test_raises_this_exc exc f x] tests that [f x]
+    raises the exception [exc]. *)
+
+val test_raises_exc_p : (exn -> bool) -> ('a -> 'b) -> 'a -> bool;;
+(** [test_raises_exc_p p f x] tests that [f x] raises an exception that
+    verifies predicate [p]. *)
+
+val scan_failure_test : ('a -> 'b) -> 'a -> bool;;
+(** [scan_failure_test f x] tests that [f x] raises [Scanf.Scan_failure]. *)
diff --git a/testsuite/summarize.awk b/testsuite/summarize.awk
new file mode 100644
index 00000000..b185c672
--- /dev/null
+++ b/testsuite/summarize.awk
@@ -0,0 +1,227 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*         Damien Doligez, projet Gallium, INRIA Rocquencourt             *
+#*                                                                        *
+#*   Copyright 2013 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.          *
+#*                                                                        *
+#**************************************************************************
+
+function check() {
+    if (!in_test){
+        printf("error at line %d: found test result without test start\n", NR);
+        errored = 1;
+    }
+}
+
+function clear() {
+    curfile = "";
+    in_test = 0;
+}
+
+function record_pass() {
+    check();
+    if (!(key in RESULTS)) ++nresults;
+    RESULTS[key] = "p";
+    delete SKIPPED[curdir];
+    clear();
+}
+
+function record_skip() {
+    check();
+    if (!(key in RESULTS)) ++nresults;
+    RESULTS[key] = "s";
+    if (curdir in SKIPPED) SKIPPED[curdir] = 1;
+    clear();
+}
+
+function record_na() {
+    check();
+    if (!(key in RESULTS)) ++nresults;
+    RESULTS[key] = "n";
+    if (curdir in SKIPPED) SKIPPED[curdir] = 1;
+    clear();
+}
+
+# The output cares only if the test passes at least once so if a test passes,
+# but then fails in a re-run triggered by a different test, ignore it.
+function record_fail() {
+    check();
+    if (!(key in RESULTS) || RESULTS[key] == "s"){
+        if (!(key in RESULTS)) ++nresults;
+        RESULTS[key] = "f";
+    }
+    delete SKIPPED[curdir];
+    clear();
+}
+
+function record_unexp() {
+    if (!(key in RESULTS) || RESULTS[key] == "s"){
+        if (!(key in RESULTS)) ++nresults;
+        RESULTS[key] = "e";
+    }
+    delete SKIPPED[curdir];
+    clear();
+}
+
+/Running tests from '[^']*'/ {
+    if (in_test) record_unexp();
+    match($0, /Running tests from '[^']*'/);
+    curdir = substr($0, RSTART+20, RLENGTH - 21);
+    # Use SKIPPED[curdir] as a sentinel to detect no output
+    SKIPPED[curdir] = 0;
+    key = curdir;
+    DIRS[key] = key;
+    curfile = "";
+}
+
+/ ... testing.* ... testing/ {
+    printf("error at line %d: found two test results on the same line\n", NR);
+    errored = 1;
+}
+
+/^ ... 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);
+    }
+    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;
+}
+
+/=> passed/ {
+    record_pass();
+}
+
+/=> skipped/ {
+    record_skip();
+}
+
+/=> n\/a/ {
+    record_na();
+}
+
+/=> failed/ {
+    record_fail();
+}
+
+/=> unexpected error/ {
+    record_unexp();
+}
+
+/^re-ran / {
+    if (in_test){
+        printf("error at line %d: found re-ran inside a test\n", NR);
+        errored = 1;
+    }else{
+        RERAN[substr($0, 8, length($0)-7)] += 1;
+        ++ reran;
+    }
+}
+
+END {
+    if (errored){
+        printf ("\n#### Some fatal error occurred during testing.\n\n");
+        exit (3);
+    }else{
+        if (!retries){
+            for (key in SKIPPED){
+                if (!SKIPPED[key]){
+                    ++ empty;
+                    blanks[emptyidx++] = key;
+                    delete SKIPPED[key];
+                }
+            }
+            for (key in RESULTS){
+                r = RESULTS[key];
+                if (r == "p"){
+                    ++ passed;
+                }else if (r == "f"){
+                    ++ failed;
+                    fail[failidx++] = key;
+                }else if (r == "e"){
+                    ++ unexped;
+                    unexp[unexpidx++] = key;
+                }else if (r == "s"){
+                    ++ skipped;
+                    curdir = DIRS[key];
+                    if (curdir in SKIPPED){
+                        if (SKIPPED[curdir]){
+                            SKIPPED[curdir] = 0;
+                            skips[skipidx++] = curdir;
+                        }
+                    }else{
+                        skips[skipidx++] = key;
+                    }
+                }else if (r == "n"){
+                    ++ ignored;
+                }
+            }
+            printf("\n");
+            if (skipped != 0){
+                printf("\nList of skipped tests:\n");
+                for (i=0; i < skipidx; i++) printf("    %s\n", skips[i]);
+            }
+            if (empty != 0){
+                printf("\nList of directories returning no results:\n");
+                for (i=0; i < empty; i++) printf("    %s\n", blanks[i]);
+            }
+            if (failed != 0){
+                printf("\nList of failed tests:\n");
+                for (i=0; i < failed; i++) printf("    %s\n", fail[i]);
+            }
+            if (unexped != 0){
+                printf("\nList of unexpected errors:\n");
+                for (i=0; i < unexped; i++) printf("    %s\n", unexp[i]);
+            }
+            printf("\n");
+            printf("Summary:\n");
+            printf("  %3d tests passed\n", passed);
+            printf("  %3d tests skipped\n", skipped);
+            printf("  %3d tests failed\n", failed);
+            printf("  %3d tests not started (parent test skipped or failed)\n",
+                   ignored);
+            printf("  %3d unexpected errors\n", unexped);
+            printf("  %3d tests considered", nresults);
+            if (nresults != passed + skipped + ignored + failed + unexped){
+                printf (" (totals don't add up??)");
+            }
+            printf ("\n");
+            if (reran != 0){
+                printf("  %3d test dir re-runs\n", reran);
+            }
+            if (failed || unexped){
+                printf("#### Something failed. Exiting with error status.\n\n");
+                exit 4;
+            }
+        }else{
+            for (key in RESULTS){
+                if (RESULTS[key] == "f" || RESULTS[key] == "e"){
+                    key = DIRS[key];
+                    if (!(key in RERUNS)){
+                        RERUNS[key] = 1;
+                        if (RERAN[key] < max_retries){
+                            printf("%s\n", key);
+                        }
+                    }
+                }
+            }
+        }
+    }
+}
diff --git a/testsuite/tests/afl-instrumentation/afltest.ml b/testsuite/tests/afl-instrumentation/afltest.ml
new file mode 100644
index 00000000..630990a3
--- /dev/null
+++ b/testsuite/tests/afl-instrumentation/afltest.ml
@@ -0,0 +1,16 @@
+(* TEST (* Just a test-driver *)
+   * native-compiler
+   ** script
+       script = "sh ${test_source_directory}/has-afl-showmap.sh"
+       files = "harness.ml  test.ml"
+   *** setup-ocamlopt.byte-build-env
+   **** ocamlopt.byte
+         module = "test.ml"
+         flags = "-afl-instrument"
+   ***** ocamlopt.byte
+          module = ""
+          program = "${test_build_directory}/test"
+          flags = "-afl-inst-ratio 0"
+          all_modules = "test.cmx harness.ml"
+   ****** run
+*)
diff --git a/testsuite/tests/afl-instrumentation/afltest.run b/testsuite/tests/afl-instrumentation/afltest.run
new file mode 100755
index 00000000..6e84cdbe
--- /dev/null
+++ b/testsuite/tests/afl-instrumentation/afltest.run
@@ -0,0 +1,36 @@
+#!/usr/bin/env bash
+
+set -e
+
+output="${program}".output
+exec > ${output} 2>&1
+
+NTESTS=`./test len`
+failures=''
+echo "running $NTESTS tests..."
+for t in `seq 1 $NTESTS`; do
+  printf "%14s: " `./test name $t`
+  # when run twice, the instrumentation output should double
+  afl-showmap -q -o output-1 -- ./test 1 $t
+  afl-showmap -q -o output-2 -- ./test 2 $t
+  # see afl-showmap.c for what the numbers mean
+  cat output-1 | sed '
+    s/:6/:7/; s/:5/:6/;
+    s/:4/:5/; s/:3/:4/;
+    s/:2/:4/; s/:1/:2/;
+  ' > output-2-predicted
+  if cmp -s output-2-predicted output-2; then
+    echo "passed."
+  else
+    echo "failed:"
+    paste output-2 output-1
+    failures=1
+  fi
+done
+
+if [ -z "$failures" ]; then
+  echo "all tests passed";
+  exit ${TEST_PASS}
+else
+  exit ${TEST_FAIL};
+fi
diff --git a/testsuite/tests/afl-instrumentation/harness.ml b/testsuite/tests/afl-instrumentation/harness.ml
new file mode 100644
index 00000000..dddbec36
--- /dev/null
+++ b/testsuite/tests/afl-instrumentation/harness.ml
@@ -0,0 +1,27 @@
+external reset_instrumentation : bool -> unit = "caml_reset_afl_instrumentation"
+external sys_exit : int -> 'a = "caml_sys_exit"
+
+let name n =
+  fst (Test.tests.(int_of_string n - 1))
+let run n =
+  snd (Test.tests.(int_of_string n - 1)) ()
+
+let orig_random = Random.get_state ()
+
+let () =
+  (* Random.set_state orig_random; *)
+  reset_instrumentation true;
+  begin
+    match Sys.argv with
+    | [| _; "len" |] ->
+        print_int (Array.length Test.tests); print_newline (); flush stdout
+    | [| _; "name"; n |] -> print_string (name n); flush stdout
+    | [| _; "1"; n |] -> run n
+    | [| _; "2"; n |] ->
+        run n;
+        (* Random.set_state orig_random; *)
+        reset_instrumentation false;
+        run n
+    | _ -> failwith "error"
+  end;
+  sys_exit 0
diff --git a/testsuite/tests/afl-instrumentation/has-afl-showmap.sh b/testsuite/tests/afl-instrumentation/has-afl-showmap.sh
new file mode 100644
index 00000000..27396415
--- /dev/null
+++ b/testsuite/tests/afl-instrumentation/has-afl-showmap.sh
@@ -0,0 +1,7 @@
+#!/bin/sh
+if ! which afl-showmap > /dev/null 2>&1; then
+  echo "afl-showmap not available" > ${ocamltest_response}
+  exit ${TEST_SKIP}
+else
+  exit ${TEST_PASS}
+fi
diff --git a/testsuite/tests/afl-instrumentation/test.ml b/testsuite/tests/afl-instrumentation/test.ml
new file mode 100644
index 00000000..63f0a205
--- /dev/null
+++ b/testsuite/tests/afl-instrumentation/test.ml
@@ -0,0 +1,80 @@
+let opaque = Sys.opaque_identity
+
+let lists n =
+  let l = opaque [n; n; n] in
+  match List.rev l with
+  | [a; b; c] when a = n && b = n && c = n -> ()
+  | _ -> assert false
+
+let fresh_exception x =
+  opaque @@
+    let module M = struct
+        exception E of int
+        let throw () = raise (E x)
+      end in
+    try
+      M.throw ()
+    with
+      M.E n -> assert (n = x)
+
+let obj_with_closure x =
+  opaque (object method foo = x end)
+
+let r = ref 42
+let state () =
+  incr r;
+  if !r > 43 then print_string "woo" else ()
+
+let classes (x : int) =
+  opaque @@
+    let module M = struct
+        class a = object
+          method foo = x
+        end
+        class c = object
+          inherit a
+        end
+      end in
+    let o = new M.c in
+    assert (o#foo = x)
+
+
+class c_global = object
+  method foo = 42
+end
+let obj_ordering () = opaque @@
+  (* Object IDs change, but should be in the same relative order *)
+  let a = new c_global in
+  let b = new c_global in
+  if a < b then print_string "a" else print_string "b"
+
+let random () = opaque @@
+  (* as long as there's no self_init, this should be deterministic *)
+  if Random.int 100 < 50 then print_string "a" else print_string "b";
+  if Random.int 100 < 50 then print_string "a" else print_string "b";
+  if Random.int 100 < 50 then print_string "a" else print_string "b";
+  if Random.int 100 < 50 then print_string "a" else print_string "b";
+  if Random.int 100 < 50 then print_string "a" else print_string "b";
+  if Random.int 100 < 50 then print_string "a" else print_string "b";
+  if Random.int 100 < 50 then print_string "a" else print_string "b";
+  if Random.int 100 < 50 then print_string "a" else print_string "b";
+  if Random.int 100 < 50 then print_string "a" else print_string "b"
+
+let already_forced = lazy (ref 42)
+let _ = Lazy.force already_forced
+
+let laziness () = opaque @@
+  let _ = Lazy.force already_forced in
+  Gc.major ()
+
+let tests =
+  [| ("lists", fun () -> lists 42);
+     ("manylists", fun () -> for i = 1 to 10 do lists 42 done);
+     ("exceptions", fun () -> fresh_exception 100);
+     ("objects", fun () -> ignore (obj_with_closure 42));
+     (* ("state", state); *) (* this one should fail *)
+     ("classes", fun () -> classes 42);
+     ("obj_ordering", obj_ordering);
+     (* ("random", random); *)
+     ("laziness", laziness);
+  |]
diff --git a/testsuite/tests/arch-power/exn_raise.ml b/testsuite/tests/arch-power/exn_raise.ml
new file mode 100644
index 00000000..a68eb875
--- /dev/null
+++ b/testsuite/tests/arch-power/exn_raise.ml
@@ -0,0 +1,19 @@
+(* TEST
+  * arch_power
+  ** native
+  *** ocamlopt.byte
+  ocamlopt_flags = "-flarge-toc"
+  **** run
+*)
+
+(* GPR#8506
+
+   This isn't guaranteed to fail even without the fix from #8506, because
+   the @ha relocation on the TOC entry for the exception handler's address
+   might be zero, in which case the linker optimises the code sequence to one
+   that will not fail.
+*)
+
+let () =
+  try failwith "foo"
+  with (Failure _) -> ()
diff --git a/testsuite/tests/arch-power/exn_raise.reference b/testsuite/tests/arch-power/exn_raise.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/array-functions/test.ml b/testsuite/tests/array-functions/test.ml
new file mode 100644
index 00000000..272b1c58
--- /dev/null
+++ b/testsuite/tests/array-functions/test.ml
@@ -0,0 +1,281 @@
+(* TEST *)
+
+let () =
+  let a = [|0;1;2;3;4;5;6;7;8;9|] in
+  assert (Array.exists (fun a -> a < 10) a);
+  assert (Array.exists (fun a -> a > 0) a);
+  assert (Array.exists (fun a -> a = 0) a);
+  assert (Array.exists (fun a -> a = 1) a);
+  assert (Array.exists (fun a -> a = 2) a);
+  assert (Array.exists (fun a -> a = 3) a);
+  assert (Array.exists (fun a -> a = 4) a);
+  assert (Array.exists (fun a -> a = 5) a);
+  assert (Array.exists (fun a -> a = 6) a);
+  assert (Array.exists (fun a -> a = 7) a);
+  assert (Array.exists (fun a -> a = 8) a);
+  assert (Array.exists (fun a -> a = 9) a);
+  assert (not (Array.exists (fun a -> a < 0) a));
+  assert (not (Array.exists (fun a -> a > 9) a));
+  assert (Array.exists (fun _ -> true) a);
+;;
+
+let () =
+  let a = [|1;2;3|] in
+  assert (Array.exists (fun a -> a < 3) a);
+  assert (Array.exists (fun a -> a < 2) a);
+  assert (not (Array.exists (fun a -> a < 1) a));
+  assert (Array.exists (fun a -> a mod 2 = 0)  [|1;4;5|]);
+  assert (not (Array.exists (fun a -> a mod 2 = 0)  [|1;3;5|]));
+  assert (not (Array.exists (fun _ -> true) [||]));
+  assert (Array.exists (fun a -> a.(9) = 1) (Array.make_matrix 10 10 1));
+  let f = Array.create_float 10 in
+  Array.fill f 0 10 1.0;
+  assert (Array.exists (fun a -> a = 1.0) f);
+;;
+
+let () =
+  let a: int array = [||] in
+  assert (not (Array.exists (fun a -> a = 0) a));
+  assert (not (Array.exists (fun a -> a = 1) a));
+  assert (not (Array.exists (fun a -> a = 2) a));
+  assert (not (Array.exists (fun a -> a = 3) a));
+  assert (not (Array.exists (fun a -> a = 4) a));
+  assert (not (Array.exists (fun a -> a = 5) a));
+  assert (not (Array.exists (fun a -> a = 6) a));
+  assert (not (Array.exists (fun a -> a = 7) a));
+  assert (not (Array.exists (fun a -> a = 8) a));
+  assert (not (Array.exists (fun a -> a = 9) a));
+  assert (not (Array.exists (fun a -> a <> 0) a));
+  assert (not (Array.exists (fun a -> a <> 1) a));
+  assert (not (Array.exists (fun a -> a <> 2) a));
+  assert (not (Array.exists (fun a -> a <> 3) a));
+  assert (not (Array.exists (fun a -> a <> 4) a));
+  assert (not (Array.exists (fun a -> a <> 5) a));
+  assert (not (Array.exists (fun a -> a <> 6) a));
+  assert (not (Array.exists (fun a -> a <> 7) a));
+  assert (not (Array.exists (fun a -> a <> 8) a));
+  assert (not (Array.exists (fun a -> a <> 9) a));
+  assert (not (Array.exists (fun a -> a < 0) a));
+  assert (not (Array.exists (fun a -> a < 1) a));
+  assert (not (Array.exists (fun a -> a < 2) a));
+  assert (not (Array.exists (fun a -> a < 3) a));
+  assert (not (Array.exists (fun a -> a < 4) a));
+  assert (not (Array.exists (fun a -> a < 5) a));
+  assert (not (Array.exists (fun a -> a < 6) a));
+  assert (not (Array.exists (fun a -> a < 7) a));
+  assert (not (Array.exists (fun a -> a < 8) a));
+  assert (not (Array.exists (fun a -> a < 9) a));
+  assert (not (Array.exists (fun a -> a > 0) a));
+  assert (not (Array.exists (fun a -> a > 1) a));
+  assert (not (Array.exists (fun a -> a > 2) a));
+  assert (not (Array.exists (fun a -> a > 3) a));
+  assert (not (Array.exists (fun a -> a > 4) a));
+  assert (not (Array.exists (fun a -> a > 5) a));
+  assert (not (Array.exists (fun a -> a > 6) a));
+  assert (not (Array.exists (fun a -> a > 7) a));
+  assert (not (Array.exists (fun a -> a > 8) a));
+  assert (not (Array.exists (fun a -> a > 9) a));
+;;
+
+let () =
+  let a = [|0;1;2;3;4;5;6;7;8;9|] in
+  assert (Array.for_all (fun a -> a < 10) a);
+  assert (Array.for_all (fun a -> a >= 0) a);
+  assert (not (Array.for_all (fun a -> a = 0) a));
+  assert (not (Array.for_all (fun a -> a = 1) a));
+  assert (not (Array.for_all (fun a -> a = 2) a));
+  assert (not (Array.for_all (fun a -> a = 3) a));
+  assert (not (Array.for_all (fun a -> a = 4) a));
+  assert (not (Array.for_all (fun a -> a = 5) a));
+  assert (not (Array.for_all (fun a -> a = 6) a));
+  assert (not (Array.for_all (fun a -> a = 7) a));
+  assert (not (Array.for_all (fun a -> a = 8) a));
+  assert (not (Array.for_all (fun a -> a = 9) a));
+  assert (Array.for_all (fun a -> a <> 10) a);
+  assert (Array.for_all (fun a -> a <> (-1)) a);
+  assert (Array.for_all (fun _ -> true) a);
+;;
+
+let () =
+  assert (Array.for_all (fun x -> x mod 2 = 0) [|2;4;6|]);
+  assert (not (Array.for_all (fun x -> x mod 2 = 0) [|2;3;6|]));
+  assert (Array.for_all (fun _ -> false) [||]);
+  assert (Array.for_all (fun a -> a.(9) = 1) (Array.make_matrix 10 10 1));
+  let f = Array.create_float 10 in
+  Array.fill f 0 10 1.0;
+  assert (Array.for_all (fun a -> a = 1.0) f);
+;;
+;;
+
+let () =
+  let a = [||] in
+  assert (Array.for_all (fun a -> a < 10) a);
+  assert (Array.for_all (fun a -> a >= 0) a);
+  assert (Array.for_all (fun a -> a = 0) a);
+  assert (Array.for_all (fun a -> a = 1) a);
+  assert (Array.for_all (fun a -> a = 2) a);
+  assert (Array.for_all (fun a -> a = 3) a);
+  assert (Array.for_all (fun a -> a = 4) a);
+  assert (Array.for_all (fun a -> a = 5) a);
+  assert (Array.for_all (fun a -> a = 6) a);
+  assert (Array.for_all (fun a -> a = 7) a);
+  assert (Array.for_all (fun a -> a = 8) a);
+  assert (Array.for_all (fun a -> a = 9) a);
+  assert (Array.for_all (fun a -> a <> 10) a);
+  assert (Array.for_all (fun a -> a <> (-1)) a);
+  assert (Array.for_all (fun _ -> true) a);
+;;
+
+let does_raise3 f a b c =
+  try
+    ignore (f a b c);
+    false
+  with _ ->
+    true
+
+let () =
+  let a = [|1;2;3;4;5;6;7;8;9|]
+  and b = [|1;2;3;4;5;6;7;8;9|] in
+  assert (Array.exists2 (fun a b -> a = b) a b);
+  assert (Array.exists2 (fun a b -> a - b = 0) a b);
+  assert (Array.exists2 (fun a b -> a = 1 && b = 1) a b);
+  assert (Array.exists2 (fun a b -> a = 2 && b = 2) a b);
+  assert (Array.exists2 (fun a b -> a = 3 && b = 3) a b);
+  assert (Array.exists2 (fun a b -> a = 4 && b = 4) a b);
+  assert (Array.exists2 (fun a b -> a = 5 && b = 5) a b);
+  assert (Array.exists2 (fun a b -> a = 6 && b = 6) a b);
+  assert (Array.exists2 (fun a b -> a = 7 && b = 7) a b);
+  assert (Array.exists2 (fun a b -> a = 8 && b = 8) a b);
+  assert (Array.exists2 (fun a b -> a = 9 && b = 9) a b);
+  assert (not (Array.exists2 (fun a b -> a <> b) a b));
+;;
+
+let () =
+  let a = [|1|]
+  and b = [|1;2|] in
+  assert (does_raise3 Array.exists2 (fun a b -> a = b) a b);
+  assert (does_raise3 Array.exists2 (fun _ _ -> true) a b);
+  assert (does_raise3 Array.exists2 (fun _ _ -> false) a b);
+  assert (does_raise3 Array.exists2 (fun a b -> a = 1 && b = 1) a b);
+  assert (does_raise3 Array.exists2 (fun a b -> a = 2 && b = 2) a b);
+  assert (does_raise3 Array.exists2 (fun a b -> a = 3 && b = 3) a b);
+  assert (does_raise3 Array.exists2 (fun a b -> a = 4 && b = 4) a b);
+  assert (does_raise3 Array.exists2 (fun a b -> a = 5 && b = 5) a b);
+  assert (does_raise3 Array.exists2 (fun a b -> a = 6 && b = 6) a b);
+  assert (does_raise3 Array.exists2 (fun a b -> a = 7 && b = 7) a b);
+  assert (does_raise3 Array.exists2 (fun a b -> a = 8 && b = 8) a b);
+  assert (does_raise3 Array.exists2 (fun a b -> a = 9 && b = 9) a b);
+;;
+
+let () =
+  assert (Array.exists2 (=) [|1;2;3|] [|3;2;1|]);
+  assert (not (Array.exists2 (<>) [|1;2;3|] [|1;2;3|]));
+  assert (does_raise3 Array.exists2 (=) [|1;2|] [|3|]);
+  let f = Array.create_float 10 in
+  let g = Array.create_float 10 in
+  Array.fill f 0 10 1.0;
+  Array.fill g 0 10 1.0;
+  assert (Array.exists2 (fun a b -> a = 1.0 && b = 1.0) f g);
+;;
+
+let () =
+  let a = [|1;2;3;4;5;6;7;8;9|]
+  and b = [|1;2;3;4;5;6;7;8;9|] in
+  assert (Array.for_all2 (fun a b -> a = b) a b);
+  assert (Array.for_all2 (fun a b -> a - b = 0) a b);
+  assert (Array.for_all2 (fun a b -> a > 0 && b > 0) a b);
+  assert (Array.for_all2 (fun a b -> a < 10 && b < 10) a b);
+  assert (Array.for_all2 (fun a b -> if a = 1 then b = 1 else b <> 1) a b);
+  assert (Array.for_all2 (fun a b -> if a = 2 then b = 2 else b <> 2) a b);
+  assert (Array.for_all2 (fun a b -> if a = 3 then b = 3 else b <> 3) a b);
+  assert (Array.for_all2 (fun a b -> if a = 4 then b = 4 else b <> 4) a b);
+  assert (Array.for_all2 (fun a b -> if a = 5 then b = 5 else b <> 5) a b);
+  assert (Array.for_all2 (fun a b -> if a = 6 then b = 6 else b <> 6) a b);
+  assert (Array.for_all2 (fun a b -> if a = 7 then b = 7 else b <> 7) a b);
+  assert (Array.for_all2 (fun a b -> if a = 8 then b = 8 else b <> 8) a b);
+  assert (Array.for_all2 (fun a b -> if a = 9 then b = 9 else b <> 9) a b);
+  assert (not (Array.for_all2 (fun a b -> a <> b) a b));
+;;
+
+let () =
+  let a = [|1|]
+  and b = [|1;2|] in
+  assert (does_raise3 Array.for_all2 (fun a b -> a = b) a b);
+  assert (does_raise3 Array.for_all2 (fun _ _ -> true) a b);
+  assert (does_raise3 Array.for_all2 (fun _ _ -> false) a b);
+  assert (does_raise3 Array.for_all2 (fun a b -> a = 1 && b = 1) a b);
+  assert (does_raise3 Array.for_all2 (fun a b -> a = 2 && b = 2) a b);
+  assert (does_raise3 Array.for_all2 (fun a b -> a = 3 && b = 3) a b);
+  assert (does_raise3 Array.for_all2 (fun a b -> a = 4 && b = 4) a b);
+  assert (does_raise3 Array.for_all2 (fun a b -> a = 5 && b = 5) a b);
+  assert (does_raise3 Array.for_all2 (fun a b -> a = 6 && b = 6) a b);
+  assert (does_raise3 Array.for_all2 (fun a b -> a = 7 && b = 7) a b);
+  assert (does_raise3 Array.for_all2 (fun a b -> a = 8 && b = 8) a b);
+  assert (does_raise3 Array.for_all2 (fun a b -> a = 9 && b = 9) a b);
+;;
+
+let () =
+  assert (not (Array.for_all2 (=) [|1;2;3|] [|3;2;1|]));
+  assert (Array.for_all2 (=) [|1;2;3|] [|1;2;3|]);
+  assert (not (Array.for_all2 (<>) [|1;2;3|] [|3;2;1|]));
+  assert (does_raise3 Array.for_all2 (=) [|1;2;3|] [|1;2;3;4|]);
+  assert (does_raise3 Array.for_all2 (=) [|1;2|] [||]);
+;;
+
+let () =
+  let a = [|1;2;3;4;5;6;7;8;9|] in
+  assert (Array.mem 1 a);
+  assert (Array.mem 2 a);
+  assert (Array.mem 3 a);
+  assert (Array.mem 4 a);
+  assert (Array.mem 5 a);
+  assert (Array.mem 6 a);
+  assert (Array.mem 7 a);
+  assert (Array.mem 8 a);
+  assert (Array.mem 9 a);
+  assert (not (Array.mem 0 a));
+  assert (not (Array.mem 10 a));
+;;
+
+let () =
+  assert (Array.mem 2 [|1;2;3|]);
+  assert (not (Array.mem 2 [||]));
+  assert (Array.mem (ref 3) [|ref 1; ref 2; ref 3|]);
+  assert (Array.mem [|1;2;3|] [|[|1;2;3|];[|2;3;4|];[|0|]|]);
+  assert (Array.mem 1 (Array.make 100 1));
+  assert (Array.mem (ref 1) (Array.make 100 (ref 1)));
+  let f = Array.create_float 10 in
+  Array.fill f 0 10 1.0;
+  assert (Array.mem 1.0 f);
+;;
+
+let () =
+  let a = [|1;2;3;4;5;6;7;8;9|] in
+  assert (Array.memq 1 a);
+  assert (Array.memq 2 a);
+  assert (Array.memq 3 a);
+  assert (Array.memq 4 a);
+  assert (Array.memq 5 a);
+  assert (Array.memq 6 a);
+  assert (Array.memq 7 a);
+  assert (Array.memq 8 a);
+  assert (Array.memq 9 a);
+  assert (not (Array.memq 0 a));
+  assert (not (Array.memq 10 a));
+;;
+
+let () =
+  assert (Array.memq 2 [|1;2;3|]);
+  assert (not (Array.memq 2 [||]));
+  assert (not (Array.memq (ref 3) [|ref 1; ref 2; ref 3|]));
+  assert (not (Array.memq [|1;2;3|] [|[|1;2;3|];[|2;3;4|];[|0|]|]));
+  assert (Array.memq 1 (Array.make 100 1));
+  assert (not (Array.memq (ref 1) (Array.make 100 (ref 1))));
+  let f = Array.create_float 10 in
+  Array.fill f 0 10 1.0;
+  (* FIXME
+  if Config.flat_float_array then assert (not (Array.memq 1.0 f));
+  *)
+;;
+
+let () = print_endline "OK"
diff --git a/testsuite/tests/array-functions/test.reference b/testsuite/tests/array-functions/test.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/array-functions/test.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/asmcomp/0001-test.compilers.reference b/testsuite/tests/asmcomp/0001-test.compilers.reference
new file mode 100644
index 00000000..c2c5166b
--- /dev/null
+++ b/testsuite/tests/asmcomp/0001-test.compilers.reference
@@ -0,0 +1,2 @@
+File "0001-test.ml", line 1:
+Warning 24: bad source file name: "0001-test" is not a valid module name.
diff --git a/testsuite/tests/asmcomp/0001-test.ml b/testsuite/tests/asmcomp/0001-test.ml
new file mode 100644
index 00000000..bffd6f1c
--- /dev/null
+++ b/testsuite/tests/asmcomp/0001-test.ml
@@ -0,0 +1 @@
+(* TEST *)
diff --git a/testsuite/tests/asmcomp/bind_tuples.ml b/testsuite/tests/asmcomp/bind_tuples.ml
new file mode 100644
index 00000000..156b0872
--- /dev/null
+++ b/testsuite/tests/asmcomp/bind_tuples.ml
@@ -0,0 +1,44 @@
+(* TEST
+  * native
+*)
+
+(* Check the effectiveness of optimized compilation of tuple binding
+
+   Ref: http://caml.inria.fr/mantis/view.php?id=4800
+*)
+
+let f () =
+  let x0 = Gc.allocated_bytes () in
+  let x1 = Gc.allocated_bytes () in
+
+  let r = ref 0 in
+  for i = 1 to 20 do
+    let (x, y) =
+      try
+        if i mod 2 = 0 then (1, i * 2)
+        else if i mod 5 = 0 then raise Exit
+        else (-1, i * 3)
+      with Exit ->
+        (1, -1)
+    in
+    r := !r * x + y
+  done;
+  let x2 = Gc.allocated_bytes () in
+  assert (!r = 82);
+  assert(x1 -. x0 = x2 -. x1) (* check no allocation between x1 and x2 *)
+  [@@inline never]
+
+let () = f ()
+
+
+
+(* MPR#7680 *)
+
+let f () =
+  let (a,b) =
+    try (1,2)
+    with _ -> assert false
+  in
+  if a + b = 3 then raise Not_found
+
+let () = try f (); assert false with Not_found -> ()
diff --git a/testsuite/tests/asmcomp/compare.ml b/testsuite/tests/asmcomp/compare.ml
new file mode 100644
index 00000000..b51116e3
--- /dev/null
+++ b/testsuite/tests/asmcomp/compare.ml
@@ -0,0 +1,10 @@
+(* TEST
+   * native
+*)
+let[@inline never] float () = print_string "hello\n"; 42.
+let[@inline never] f () = compare (float ()) 0.5;;
+let _ = f ()
+
+let[@inline never] myint () = print_string "bye\n"; 42
+let[@inline never] g () = compare (myint ()) 5;;
+let _ = g ()
diff --git a/testsuite/tests/asmcomp/compare.reference b/testsuite/tests/asmcomp/compare.reference
new file mode 100644
index 00000000..410ca140
--- /dev/null
+++ b/testsuite/tests/asmcomp/compare.reference
@@ -0,0 +1,2 @@
+hello
+bye
diff --git a/testsuite/tests/asmcomp/func_sections.arm.reference b/testsuite/tests/asmcomp/func_sections.arm.reference
new file mode 100644
index 00000000..b6a7d89c
--- /dev/null
+++ b/testsuite/tests/asmcomp/func_sections.arm.reference
@@ -0,0 +1 @@
+16
diff --git a/testsuite/tests/asmcomp/func_sections.ml b/testsuite/tests/asmcomp/func_sections.ml
new file mode 100644
index 00000000..7a58afc6
--- /dev/null
+++ b/testsuite/tests/asmcomp/func_sections.ml
@@ -0,0 +1,73 @@
+(* TEST
+* function_sections
+flags = "-S -function-sections"
+** arch_arm
+*** native
+reference = "${test_source_directory}/func_sections.arm.reference"
+** arch_arm64
+*** native
+reference = "${test_source_directory}/func_sections.arm.reference"
+** arch_amd64
+*** native
+reference = "${test_source_directory}/func_sections.reference"
+** arch_i386
+*** native
+reference = "${test_source_directory}/func_sections.reference"
+*)
+
+(* We have a separate reference output for ARM because
+   it doesn't emit .text after jump tables. *)
+
+(* Test for anonymous functions which result in a mangled symbol *)
+let f4 list =
+  List.map (fun s -> String.length s) list
+
+let test1 () =
+  f4 ["a";"asfda";"afda"]
+
+(* Test for jump tables*)
+
+let g1 s = s^"*"
+let g2 s = "*"^s
+let g3 s = "*"^s^"*"
+
+let f5 = function
+  | 1 -> g1 "a"
+  | 2 -> g2 "b"
+  | 3 -> g3 "c"
+  | 4 -> g1 "d"
+  | 5 -> g2 "e"
+  | 6 -> g3 "f"
+  | _ -> "x"
+
+let test2 () =
+  let list =    [f5 5;
+                f5 7;
+                f5 15;
+                f5 26]
+  in
+  ignore list
+
+let iter = 1_000
+
+let f0 x = x - 7;
+[@@inline never]
+
+let f1 x = x + iter
+[@@inline never]
+
+let f2 x = f1(x)
+[@@inline never]
+
+let f3 x = f2(x)*f0(x)
+[@@inline never]
+
+let test3 () =
+  f3 iter
+
+
+let () =
+  ignore (test1 ());
+  ignore (test2 ());
+  ignore (test3 ());
+  ()
diff --git a/testsuite/tests/asmcomp/func_sections.reference b/testsuite/tests/asmcomp/func_sections.reference
new file mode 100644
index 00000000..98d9bcb7
--- /dev/null
+++ b/testsuite/tests/asmcomp/func_sections.reference
@@ -0,0 +1 @@
+17
diff --git a/testsuite/tests/asmcomp/func_sections.run b/testsuite/tests/asmcomp/func_sections.run
new file mode 100755
index 00000000..a9323be0
--- /dev/null
+++ b/testsuite/tests/asmcomp/func_sections.run
@@ -0,0 +1,10 @@
+#!/bin/sh
+
+exec > "${output}" 2>&1
+
+# first, run the program to make sure it doesn't crash
+${program}
+
+# now check the assembly file produced during compilation
+asm=${test_build_directory}/func_sections.s
+grep ".section .text.caml.camlFunc_sections__" "$asm" | wc -l | tr -d ' ' | sed '/^$/d'
diff --git a/testsuite/tests/asmcomp/is_in_static_data.c b/testsuite/tests/asmcomp/is_in_static_data.c
new file mode 100644
index 00000000..ccf0582c
--- /dev/null
+++ b/testsuite/tests/asmcomp/is_in_static_data.c
@@ -0,0 +1,5 @@
+#include "caml/address_class.h"
+
+value caml_is_in_static_data(value v) {
+  return(Val_bool(Is_in_static_data(v)));
+}
diff --git a/testsuite/tests/asmcomp/is_static.ml b/testsuite/tests/asmcomp/is_static.ml
new file mode 100644
index 00000000..60263692
--- /dev/null
+++ b/testsuite/tests/asmcomp/is_static.ml
@@ -0,0 +1,39 @@
+(* TEST
+   modules = "is_in_static_data.c"
+   * native
+*)
+
+(* Data that should be statically allocated by the compiler (all versions) *)
+
+external is_in_static_data : 'a -> bool = "caml_is_in_static_data"
+
+(* Basic constant blocks should be static *)
+let block1 = (1,2)
+let () = assert(is_in_static_data block1)
+
+(* as pattern shouldn't prevent it *)
+let (a, b) as block2 = (1,2)
+let () = assert(is_in_static_data block2)
+
+(* Also in functions *)
+let f () =
+  let block = (1,2) in
+  assert(is_in_static_data block)
+
+let () = (f [@inlined never]) ()
+
+(* Closed functions should be static *)
+let closed_function x = x + 1 (* + is a primitive, it cannot be in the closure*)
+let () = assert(is_in_static_data closed_function)
+
+(* And functions using closed functions *)
+let almost_closed_function x =
+  (closed_function [@inlined never]) x
+let () = assert(is_in_static_data almost_closed_function)
+
+(* Recursive constant functions should be static *)
+let rec f1 a = g1 a
+and g1 a = f1 a
+let () =
+  assert(is_in_static_data f1);
+  assert(is_in_static_data g1)
diff --git a/testsuite/tests/asmcomp/is_static_flambda.ml b/testsuite/tests/asmcomp/is_static_flambda.ml
new file mode 100644
index 00000000..7ddf7e92
--- /dev/null
+++ b/testsuite/tests/asmcomp/is_static_flambda.ml
@@ -0,0 +1,206 @@
+(* TEST
+   modules = "is_in_static_data.c is_static_flambda_dep.ml"
+   * flambda
+   ** native
+*)
+
+(* Data that should be statically allocated by the compiler (flambda only) *)
+
+external is_in_static_data : 'a -> bool = "caml_is_in_static_data"
+
+(* Also after inlining *)
+let g x =
+  let block = (1,x) in
+  assert(is_in_static_data block)
+
+let () = (g [@inlined always]) 2
+
+(* Toplevel immutable blocks should be static *)
+let block3 = (Sys.opaque_identity 1, Sys.opaque_identity 2)
+let () = assert(is_in_static_data block3)
+
+(* Not being bound shouldn't prevent it *)
+let () =
+  assert(is_in_static_data (Sys.opaque_identity 1, Sys.opaque_identity 2))
+
+(* Only with rounds >= 2 currently !
+(* Also after inlining *)
+let h x =
+  let block = (Sys.opaque_identity 1,x) in
+  assert(is_in_static_data block)
+
+let () = (h [@inlined always]) (Sys.opaque_identity 2)
+*)
+
+(* Recursive constant values should be static *)
+let rec a = 1 :: b
+and b = 2 :: a
+let () =
+  assert(is_in_static_data a);
+  assert(is_in_static_data b)
+
+(* And a mix *)
+type e = E : 'a -> e
+
+let rec f1 a = E (g1 a, l1)
+and g1 a = E (f1 a, l2)
+and l1 = E (f1, l2)
+and l2 = E (g1, l1)
+
+let () =
+  assert(is_in_static_data f1);
+  assert(is_in_static_data g1);
+  assert(is_in_static_data l1);
+  assert(is_in_static_data l2)
+
+(* Also in functions *)
+let i () =
+  let rec f1 a = E (g1 a, l1)
+  and g1 a = E (f1 a, l2)
+  and l1 = E (f1, l2)
+  and l2 = E (g1, l1) in
+
+  assert(is_in_static_data f1);
+  assert(is_in_static_data g1);
+  assert(is_in_static_data l1);
+  assert(is_in_static_data l2)
+
+let () = (i [@inlined never]) ()
+
+module type P = module type of Stdlib
+(* Top-level modules should be static *)
+let () = assert(is_in_static_data (module Stdlib:P))
+
+(* Not constant let rec to test extraction to initialize_symbol *)
+let r = ref 0
+let rec a = (incr r; !r) :: b
+and b = (incr r; !r) :: a
+
+let next =
+  let r = ref 0 in
+  fun () -> incr r; !r
+
+let () =
+  assert(is_in_static_data next)
+
+(* Exceptions without arguments should be static *)
+exception No_argument
+let () = assert(is_in_static_data No_argument)
+
+(* And also with constant arguments *)
+exception Some_argument of string
+let () = assert(is_in_static_data (Some_argument "some string"))
+
+(* Even when exposed by inlining *)
+let () =
+  let exn =
+    try (failwith [@inlined always]) "some other string" with exn -> exn
+  in
+  assert(is_in_static_data exn)
+
+(* Verify that approximation intersection correctly loads exported
+   approximations.
+
+   Is_static_flambda_dep.pair is a pair with 1 as first element. The
+   intersection of approximations should return a block with
+   approximation: [tag 0: [tag 0: Int 1, Unknown], Unknown] *)
+let f x =
+  let pair =
+    if Sys.opaque_identity x then
+      (1, 2), 3
+    else
+      Is_static_flambda_dep.pair, 4
+  in
+  let n = fst (fst pair) in
+  let res = n, n in
+  assert(is_in_static_data res)
+  [@@inline never]
+
+let () =
+  f true;
+  f false
+
+(* Verify that physical equality/inequality is correctly propagated *)
+
+(* In these tests, tuple can be statically allocated only if it is a
+   known constant since the function is never inlined (hence this
+   code is never at toplevel) *)
+
+let () =
+  let f () =
+    let v = (1, 2) in
+    (* eq is supposed to be considered always true since v is a
+       constant, hence aliased to a symbol.
+       It is not yet optimized away if it is not constant *)
+    let eq = v == v in
+    let n = if eq then 1 else 2 in
+    let tuple = (n,n) in
+    assert(is_in_static_data tuple)
+  in
+  (f [@inlined never]) ()
+
+let () =
+  let f () =
+    let v = (1, 2) in
+    (* same with inequality *)
+    let eq = v != v in
+    let n = if eq then 1 else 2 in
+    let tuple = (n,n) in
+    assert(is_in_static_data tuple)
+  in
+  (f [@inlined never]) ()
+
+let () =
+  let f x =
+    let v1 = Some x in
+    let v2 = None in
+    let eq = v1 == v2 in
+    (* The values are structurally different, so must be physically
+       different *)
+    let n = if eq then 1 else 2 in
+    let tuple = (n,n) in
+    assert(is_in_static_data tuple)
+  in
+  (f [@inlined never]) ()
+
+let () =
+  let f x =
+    let v1 = Some x in
+    let v2 = None in
+    let eq = v1 != v2 in
+    (* same with inequality *)
+    let n = if eq then 1 else 2 in
+    let tuple = (n,n) in
+    assert(is_in_static_data tuple)
+  in
+  (f [@inlined never]) ()
+
+let () =
+  let f x =
+    let v1 = (1, 2) in
+    let v2 = (3, 2) in
+    let eq = v1 == v2 in
+    (* difference is deeper *)
+    let n = if eq then 1 else 2 in
+    let tuple = (n,n) in
+    assert(is_in_static_data tuple)
+  in
+  (f [@inlined never]) ()
+
+module Int = struct
+  type t = int
+  let compare (a:int) b = compare a b
+end
+module IntMap = Map.Make (Int)
+
+let () =
+  let f () =
+    let a = IntMap.empty in
+    let b = (IntMap.add [@inlined]) 1 (Some 1) a in
+    assert(is_in_static_data b);
+    let c = (IntMap.add [@inlined]) 1 (Some 2) b in
+    assert(is_in_static_data c);
+    let d = (IntMap.add [@inlined]) 1 (Some 2) c in
+    assert(is_in_static_data d);
+  in
+  (f [@inlined never]) ()
diff --git a/testsuite/tests/asmcomp/is_static_flambda_dep.ml b/testsuite/tests/asmcomp/is_static_flambda_dep.ml
new file mode 100644
index 00000000..3a50f7ca
--- /dev/null
+++ b/testsuite/tests/asmcomp/is_static_flambda_dep.ml
@@ -0,0 +1 @@
+let pair = 1, 12
diff --git a/testsuite/tests/asmcomp/lift_mutable_let_flambda.ml b/testsuite/tests/asmcomp/lift_mutable_let_flambda.ml
new file mode 100644
index 00000000..8c8b017d
--- /dev/null
+++ b/testsuite/tests/asmcomp/lift_mutable_let_flambda.ml
@@ -0,0 +1,29 @@
+(* TEST
+   * flambda
+   ** native
+*)
+
+type t = T of { pos : int }
+
+let[@inline always] find_pos i =
+  let i = ref i in
+  let pos = !i in
+  T {pos}
+
+let[@inline always] use_pos i =
+  let (T {pos}) = find_pos i in
+  pos * 2
+
+
+let f () =
+  let x0 = Gc.allocated_bytes () in
+  let x1 = Gc.allocated_bytes () in
+
+  let n : int = (Sys.opaque_identity use_pos) 10 in
+
+  let x2 = Gc.allocated_bytes () in
+  assert (n = 20);
+  assert(x1 -. x0 = x2 -. x1) (* check no allocation between x1 and x2 *)
+  [@@inline never]
+
+let () = f ()
diff --git a/testsuite/tests/asmcomp/optargs.ml b/testsuite/tests/asmcomp/optargs.ml
new file mode 100644
index 00000000..ccc27dcb
--- /dev/null
+++ b/testsuite/tests/asmcomp/optargs.ml
@@ -0,0 +1,27 @@
+(* TEST
+   flags = "-g"
+   compare_programs = "false"
+   * native
+*)
+
+(* Check the effectiveness of inlining the wrapper which fills in
+   default values for optional arguments.
+
+   Ref: http://caml.inria.fr/mantis/view.php?id=6345
+*)
+
+
+let rec f ?(flag = false) ?(acc = 0) = function
+  | [] -> if flag then acc else acc + 1
+  | hd :: tl -> f ~flag ~acc:(acc + hd) tl
+
+let () =
+  let l = [1;2;3;4;5;6;7;8;9] in
+  let x0 = Gc.allocated_bytes () in
+  let x1 = Gc.allocated_bytes () in
+  for i = 1 to 1000 do
+    ignore (f l)
+  done;
+  let x2 = Gc.allocated_bytes () in
+  assert(x1 -. x0 = x2 -. x1)
+     (* check that we have not allocated anything between x1 and x2 *)
diff --git a/testsuite/tests/asmcomp/register_typing.ml b/testsuite/tests/asmcomp/register_typing.ml
new file mode 100644
index 00000000..3bf3104f
--- /dev/null
+++ b/testsuite/tests/asmcomp/register_typing.ml
@@ -0,0 +1,24 @@
+(* TEST
+   * native
+*)
+
+type 'a typ = Int : int typ | Ptr : int list typ
+
+let f (type a) (t : a typ) (p : int list) : a =
+  match t with
+  | Int -> 100
+  | Ptr -> p
+
+let allocate_garbage () =
+  for i = 0 to 100 do
+    ignore (Array.make 200 0.0)
+  done
+
+let g (t : int list typ) x =
+  Gc.minor ();
+  let x = f t ([x; x; x; x; x]) in
+  Gc.minor ();
+  allocate_garbage ();
+  ignore (String.length (String.concat " " (List.map Int.to_string x)))
+
+let () = g Ptr 5
diff --git a/testsuite/tests/asmcomp/register_typing_switch.ml b/testsuite/tests/asmcomp/register_typing_switch.ml
new file mode 100644
index 00000000..73960c4b
--- /dev/null
+++ b/testsuite/tests/asmcomp/register_typing_switch.ml
@@ -0,0 +1,25 @@
+(* TEST
+   * native
+*)
+
+type 'a typ = Int : int typ | Ptr : int list typ | Int2 : int typ
+
+let f (type a) (t : a typ) (p : int list) : a =
+  match t with
+  | Int -> 100
+  | Ptr -> p
+  | Int2 -> 200
+
+let allocate_garbage () =
+  for i = 0 to 100 do
+    ignore (Array.make 200 0.0)
+  done
+
+let g (t : int list typ) x =
+  Gc.minor ();
+  let x = f t ([x; x; x; x; x]) in
+  Gc.minor ();
+  allocate_garbage ();
+  ignore (String.length (String.concat " " (List.map Int.to_string x)))
+
+let () = g Ptr 5
diff --git a/testsuite/tests/asmcomp/simple_float_const.ml b/testsuite/tests/asmcomp/simple_float_const.ml
new file mode 100644
index 00000000..1aca414f
--- /dev/null
+++ b/testsuite/tests/asmcomp/simple_float_const.ml
@@ -0,0 +1 @@
+let f = 3.14
diff --git a/testsuite/tests/asmcomp/simple_float_const_opaque.ml b/testsuite/tests/asmcomp/simple_float_const_opaque.ml
new file mode 100644
index 00000000..1aca414f
--- /dev/null
+++ b/testsuite/tests/asmcomp/simple_float_const_opaque.ml
@@ -0,0 +1 @@
+let f = 3.14
diff --git a/testsuite/tests/asmcomp/static_float_array_flambda.ml b/testsuite/tests/asmcomp/static_float_array_flambda.ml
new file mode 100644
index 00000000..8401ca1e
--- /dev/null
+++ b/testsuite/tests/asmcomp/static_float_array_flambda.ml
@@ -0,0 +1,25 @@
+(* TEST
+   modules = "is_in_static_data.c simple_float_const.ml"
+   * flambda
+   ** flat-float-array
+   *** native
+*)
+
+external is_in_static_data : 'a -> bool = "caml_is_in_static_data"
+
+let a = [|0.; 1.|]
+let f = 1.23
+let b = [|0.; f; f|]
+let g = Sys.opaque_identity 1.23
+let c = [|0.; g|]
+let d = [|0.; Simple_float_const.f|]
+
+let () = assert(is_in_static_data a)
+let () = assert(is_in_static_data f)
+let () = assert(is_in_static_data b)
+
+let () = assert(not (is_in_static_data c))
+(* In fact this one could be static by preallocating the array then
+   patching it when g is available *)
+
+let () = assert(is_in_static_data d)
diff --git a/testsuite/tests/asmcomp/static_float_array_flambda_opaque.ml b/testsuite/tests/asmcomp/static_float_array_flambda_opaque.ml
new file mode 100644
index 00000000..63c08c1b
--- /dev/null
+++ b/testsuite/tests/asmcomp/static_float_array_flambda_opaque.ml
@@ -0,0 +1,29 @@
+(* TEST
+   modules = "is_in_static_data.c simple_float_const_opaque.ml"
+   flags = "-opaque"
+   * flambda
+   ** flat-float-array
+   *** native
+*)
+
+external is_in_static_data : 'a -> bool = "caml_is_in_static_data"
+
+let a = [|0.; 1.|]
+let f = 1.23
+let b = [|0.; f; f|]
+let g = Sys.opaque_identity 1.23
+let c = [|0.; g|]
+let d = [|0.; Simple_float_const_opaque.f|]
+
+let () = assert(is_in_static_data a)
+let () = assert(is_in_static_data f)
+let () = assert(is_in_static_data b)
+
+let () = assert(not (is_in_static_data c))
+(* In fact this one could be static by preallocating the array then
+   patching it when g is available *)
+
+let () = assert(not (is_in_static_data d))
+(* The dependency Simple_float_const_opaque is built with opaque,
+   hence the value of Simple_float_const_opaque.f cannot be known
+   preventing the static allocation of d *)
diff --git a/testsuite/tests/asmcomp/staticalloc.ml b/testsuite/tests/asmcomp/staticalloc.ml
new file mode 100644
index 00000000..16eae1d4
--- /dev/null
+++ b/testsuite/tests/asmcomp/staticalloc.ml
@@ -0,0 +1,26 @@
+(* TEST
+  include config
+  * native
+    flags = "config.cmx"
+*)
+
+(* Check the effectiveness of structured constant propagation and
+   static allocation.
+
+   Ref: http://caml.inria.fr/mantis/view.php?id=5779
+*)
+
+let () =
+  let x0 = Gc.allocated_bytes () in
+  let x1 = Gc.allocated_bytes () in
+  let pair x y = (x, y) in
+  let a = pair 1 2 in
+  let b = pair a ["x";"y"] in
+  let[@local never] g () = (a, fst b) in
+  assert (g () == ((1,2), (1,2)));
+  assert (fst (pair a a) == (1, 2));
+  assert (snd b != ["x"; "y"] || Config.safe_string);  (* mutable "constant",
+                                                          cannot be shared *)
+  let x2 = Gc.allocated_bytes () in
+  assert(x1 -. x0 = x2 -. x1)
+     (* check that we did not allocated anything between x1 and x2 *)
diff --git a/testsuite/tests/asmcomp/unrolling_flambda.ml b/testsuite/tests/asmcomp/unrolling_flambda.ml
new file mode 100644
index 00000000..dcfcb033
--- /dev/null
+++ b/testsuite/tests/asmcomp/unrolling_flambda.ml
@@ -0,0 +1,11 @@
+(* TEST
+   * flambda
+   ** native
+*)
+
+let rec f x =
+  if x > 0 then f (x - 1)
+  else 0
+[@@inline]
+
+let _ = f 0
diff --git a/testsuite/tests/asmcomp/unrolling_flambda2.ml b/testsuite/tests/asmcomp/unrolling_flambda2.ml
new file mode 100644
index 00000000..3079b732
--- /dev/null
+++ b/testsuite/tests/asmcomp/unrolling_flambda2.ml
@@ -0,0 +1,24 @@
+(* TEST
+   * flambda
+   ** native
+*)
+
+type t = { fn : t -> t -> int -> unit -> unit }
+
+let rec foo f b n x =
+  if n < 0 then ()
+  else begin
+    foo f b (n - 1) x;
+    b.fn f b (n - 1) x
+  end
+[@@specialise always]
+
+let rec bar f b n x =
+  if n < 0 then ()
+  else begin
+    bar f b (n - 1) x;
+    f.fn f b (n - 1) x
+  end
+[@@specialise always]
+
+let () = foo {fn = foo} {fn = bar} 10 ()
diff --git a/testsuite/tests/asmgen/arith.cmm b/testsuite/tests/asmgen/arith.cmm
new file mode 100644
index 00000000..4d26aac1
--- /dev/null
+++ b/testsuite/tests/asmgen/arith.cmm
@@ -0,0 +1,227 @@
+(* TEST
+files = "mainarith.c"
+arguments = "mainarith.c"
+* asmgen
+*)
+
+(**************************************************************************)
+(*                                                                        *)
+(*                                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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Regression test for arithmetic instructions *)
+
+(function "testarith" ()
+   (let r "R"
+   (let d "D"
+   (let x (load int "X")
+   (let y (load int "Y")
+   (let f (load float "F")
+   (let g (load float "G")
+      (addraset r 0 0)
+      (addraset r 1 1)
+      (addraset r 2 -1)
+      (addraset r 3 256)
+      (addraset r 4 65536)
+      (addraset r 5 16777216)
+      (addraset r 6 -256)
+      (addraset r 7 -65536)
+      (addraset r 8 -16777216)
+
+      (addraset r 9 (+ x y))
+      (addraset r 10 (+ x 1))
+      (addraset r 11 (+ x -1))
+
+      (addraset r 12 (+a "R" 8))
+      (addraset r 13 (+a "R" y))
+
+      (addraset r 14 (- x y))
+      (addraset r 15 (- x 1))
+      (addraset r 16 (- x -1))
+
+      (addraset r 17 (- "R" 8))
+      (addraset r 18 (- "R" y))
+
+      (addraset r 19 ( * x 2))
+      (addraset r 20 ( * 2 x))
+      (addraset r 21 ( * x 16))
+      (addraset r 22 ( * 16 x))
+      (addraset r 23 ( * x 12345))
+      (addraset r 24 ( * 12345 x))
+      (addraset r 25 ( * x y))
+
+      (addraset r 26 (/ x 2))
+      (addraset r 27 (/ x 16))
+      (addraset r 28 (/ x 7))
+      (addraset r 29 (if (!= y 0) (/ x y) 0))
+
+      (addraset r 30 (mod x 2))
+      (addraset r 31 (mod x 16))
+      (addraset r 32 (if (!= y 0) (mod x y) 0))
+
+      (addraset r 33 (and x y))
+      (addraset r 34 (and x 3))
+      (addraset r 35 (and 3 x))
+
+      (addraset r 36 (or x y))
+      (addraset r 37 (or x 3))
+      (addraset r 38 (or 3 x))
+
+      (addraset r 39 (xor x y))
+      (addraset r 40 (xor x 3))
+      (addraset r 41 (xor 3 x))
+
+      (addraset r 42 (<< x y))
+      (addraset r 43 (<< x 1))
+      (addraset r 44 (<< x 8))
+
+      (addraset r 45 (>>u x y))
+      (addraset r 46 (>>u x 1))
+      (addraset r 47 (>>u x 8))
+
+      (addraset r 48 (>>s x y))
+      (addraset r 49 (>>s x 1))
+      (addraset r 50 (>>s x 8))
+
+      (addraset r 51 (== x y))
+      (addraset r 52 (!= x y))
+      (addraset r 53 (< x y))
+      (addraset r 54 (> x y))
+      (addraset r 55 (<= x y))
+      (addraset r 56 (>= x y))
+      (addraset r 57 (== x 1))
+      (addraset r 58 (!= x 1))
+      (addraset r 59 (< x 1))
+      (addraset r 60 (> x 1))
+      (addraset r 61 (<= x 1))
+      (addraset r 62 (>= x 1))
+
+      (addraset r 63 (==a x y))
+      (addraset r 64 (!=a x y))
+      (addraset r 65 (<a x y))
+      (addraset r 66 (>a x y))
+      (addraset r 67 (<=a x y))
+      (addraset r 68 (>=a x y))
+      (addraset r 69 (==a x 1))
+      (addraset r 70 (!=a x 1))
+      (addraset r 71 (<a x 1))
+      (addraset r 72 (>a x 1))
+      (addraset r 73 (<=a x 1))
+      (addraset r 74 (>=a x 1))
+
+      (addraset r 75 (+ x (<< y 1)))
+      (addraset r 76 (+ x (<< y 2)))
+      (addraset r 77 (+ x (<< y 3)))
+      (addraset r 78 (- x (<< y 1)))
+      (addraset r 79 (- x (<< y 2)))
+      (addraset r 80 (- x (<< y 3)))
+
+      (floataset d 0 0.0)
+      (floataset d 1 1.0)
+      (floataset d 2 -1.0)
+      (floataset d 3 (+f f g))
+      (floataset d 4 (-f f g))
+      (floataset d 5 ( *f f g))
+      (floataset d 6 (/f f g))
+
+      (floataset d 7 (+f f (+f g 1.0)))
+      (floataset d 8 (-f f (+f g 1.0)))
+      (floataset d 9 ( *f f (+f g 1.0)))
+      (floataset d 10 (/f f (+f g 1.0)))
+
+      (floataset d 11 (+f (+f f 1.0) g))
+      (floataset d 12 (-f (+f f 1.0) g))
+      (floataset d 13 ( *f (+f f 1.0) g))
+      (floataset d 14 (/f (+f f 1.0) g))
+
+      (floataset d 15 (+f (+f f 1.0) (+f g 1.0)))
+      (floataset d 16 (-f (+f f 1.0) (+f g 1.0)))
+      (floataset d 17 ( *f (+f f 1.0) (+f g 1.0)))
+      (floataset d 18 (/f (+f f 1.0) (+f g 1.0)))
+
+      (addraset r 81 (==f f g))
+      (addraset r 82 (!=f f g))
+      (addraset r 83 (<f f g))
+      (addraset r 84 (>f f g))
+      (addraset r 85 (<=f f g))
+      (addraset r 86 (>=f f g))
+
+      (floataset d 19 (floatofint x))
+      (addraset r 87 (intoffloat f))
+
+      (if (and (>= x 0) (< x y))
+          (seq (checkbound y x) (addraset r 88 1))
+        (addraset r 88 0))
+
+      (if (< 0 y)
+          (seq (checkbound y 0) (addraset r 89 1))
+        (addraset r 89 0))
+
+      (if (< 5 y)
+          (seq (checkbound y 5) (addraset r 90 1))
+        (addraset r 90 0))
+
+      (addraset r 91 (letmut res int 1 (if (==f f g) [] (assign res 0)) res))
+      (addraset r 92 (letmut res int 1 (if (!=f f g) [] (assign res 0)) res))
+      (addraset r 93 (letmut res int 1 (if (<f f g) [] (assign res 0)) res))
+      (addraset r 94 (letmut res int 1 (if (>f f g) [] (assign res 0)) res))
+      (addraset r 95 (letmut res int 1 (if (<=f f g) [] (assign res 0)) res))
+      (addraset r 96 (letmut res int 1 (if (>=f f g) [] (assign res 0)) res))
+
+      (addraset r 97 (==f (+f f 1.0) (+f g 1.0)))
+      (addraset r 98 (!=f (+f f 1.0) (+f g 1.0)))
+      (addraset r 99 (<f (+f f 1.0) (+f g 1.0)))
+      (addraset r 100 (>f (+f f 1.0) (+f g 1.0)))
+      (addraset r 101 (<=f (+f f 1.0) (+f g 1.0)))
+      (addraset r 102 (>=f (+f f 1.0) (+f g 1.0)))
+
+      (addraset r 103 (==f f (+f g 1.0)))
+      (addraset r 104 (!=f f (+f g 1.0)))
+      (addraset r 105 (<f f (+f g 1.0)))
+      (addraset r 106 (>f f (+f g 1.0)))
+      (addraset r 107 (<=f f (+f g 1.0)))
+      (addraset r 108 (>=f f (+f g 1.0)))
+
+      (addraset r 109 (==f (+f f 1.0) g))
+      (addraset r 110 (!=f (+f f 1.0) g))
+      (addraset r 111 (<f (+f f 1.0) g))
+      (addraset r 112 (>f (+f f 1.0) g))
+      (addraset r 113 (<=f (+f f 1.0) g))
+      (addraset r 114 (>=f (+f f 1.0) g))
+
+      (floataset d 20 (+f (floatofint x) 1.0))
+      (addraset r 115 (intoffloat (+f f 1.0)))
+
+      (floataset d 21 (+f f (load float "G")))
+      (floataset d 22 (+f (load float "G") f))
+      (floataset d 23 (-f f (load float "G")))
+      (floataset d 24 (-f (load float "G") f))
+      (floataset d 25 ( *f f (load float "G")))
+      (floataset d 26 ( *f (load float "G") f))
+      (floataset d 27 (/f f (load float "G")))
+      (floataset d 28 (/f (load float "G") f))
+
+      (floataset d 29 (+f ( *f f 2.0) (load float "G")))
+      (floataset d 30 (+f (load float "G") ( *f f 2.0)))
+      (floataset d 31 (-f ( *f f 2.0) (load float "G")))
+      (floataset d 32 (-f (load float "G") ( *f f 2.0)))
+      (floataset d 33 ( *f ( +f f 2.0) (load float "G")))
+      (floataset d 34 ( *f (load float "G") ( +f f 2.0)))
+      (floataset d 35 (/f ( *f f 2.0) (load float "G")))
+      (floataset d 36 (/f (load float "G") ( *f f 2.0)))
+
+      (floataset d 37 (-f f))
+      (floataset d 38 (absf f))
+
+      (addraset r 116 (mulh x y))
+)))))))
diff --git a/testsuite/tests/asmgen/catch-float.cmm b/testsuite/tests/asmgen/catch-float.cmm
new file mode 100644
index 00000000..9d1d1683
--- /dev/null
+++ b/testsuite/tests/asmgen/catch-float.cmm
@@ -0,0 +1,11 @@
+(* TEST
+files = "main.c"
+arguments = "-DFLOAT_CATCH -DFUN=catch_float main.c"
+* asmgen
+*)
+
+(function "catch_float" (b:int)
+  (+f 10.0
+  (catch
+    (exit lbl 100.0)
+   with (lbl x:float) (+f x 1000.0))))
diff --git a/testsuite/tests/asmgen/catch-multiple.cmm b/testsuite/tests/asmgen/catch-multiple.cmm
new file mode 100644
index 00000000..1510fcea
--- /dev/null
+++ b/testsuite/tests/asmgen/catch-multiple.cmm
@@ -0,0 +1,20 @@
+(* TEST
+files = "main.c"
+arguments = "-DINT_INT -DFUN=catch_multiple main.c"
+* asmgen
+*)
+
+(*
+Expected output:
+catch_multiple(0) == -1
+catch_multiple(1) == 1
+*)
+
+(function "catch_multiple" (b:int)
+  (let x
+    (catch
+      (if (== b 0) (exit zero)
+          (exit other))
+     with (zero) -1
+     and (other) ( * b b))
+    x))
diff --git a/testsuite/tests/asmgen/catch-rec-deadhandler.cmm b/testsuite/tests/asmgen/catch-rec-deadhandler.cmm
new file mode 100644
index 00000000..34dc8a26
--- /dev/null
+++ b/testsuite/tests/asmgen/catch-rec-deadhandler.cmm
@@ -0,0 +1,17 @@
+(* TEST
+flags = "-dlive"
+files = "main.c"
+arguments = "-DUNIT_INT -DFUN=catch_rec_deadhandler main.c"
+* asmgen
+** run
+*** check-program-output
+*)
+
+(function "catch_rec_deadhandler" ()
+  (let x
+    (catch
+      (exit one)
+     with (one) 1
+     and (two) (exit three)
+     and (three) 3)
+    x))
diff --git a/testsuite/tests/asmgen/catch-rec-deadhandler.reference b/testsuite/tests/asmgen/catch-rec-deadhandler.reference
new file mode 100644
index 00000000..6ac08fb0
--- /dev/null
+++ b/testsuite/tests/asmgen/catch-rec-deadhandler.reference
@@ -0,0 +1,6 @@
+  catch rec
+    exit(1)
+  with(1)
+  catch rec
+    exit(1)
+  with(1)
diff --git a/testsuite/tests/asmgen/catch-rec-deadhandler.run b/testsuite/tests/asmgen/catch-rec-deadhandler.run
new file mode 100755
index 00000000..bad9f117
--- /dev/null
+++ b/testsuite/tests/asmgen/catch-rec-deadhandler.run
@@ -0,0 +1,5 @@
+#!/bin/sh
+
+exec > "${output}" 2>&1
+
+grep -E "catch |with\(|and\(|exit\(" "${compiler_output}"
diff --git a/testsuite/tests/asmgen/catch-rec.cmm b/testsuite/tests/asmgen/catch-rec.cmm
new file mode 100644
index 00000000..17f9884a
--- /dev/null
+++ b/testsuite/tests/asmgen/catch-rec.cmm
@@ -0,0 +1,11 @@
+(* TEST
+files = "main.c"
+arguments = "-DINT_INT -DFUN=catch_fact main.c"
+* asmgen
+*)
+
+(function "catch_fact" (b:int)
+  (catch (exit fact b 1)
+   with (fact c:val acc:val)
+     (if (== c 0) acc
+         (exit fact (- c 1) ( * c acc)))))
diff --git a/testsuite/tests/asmgen/catch-try-float.cmm b/testsuite/tests/asmgen/catch-try-float.cmm
new file mode 100644
index 00000000..23287298
--- /dev/null
+++ b/testsuite/tests/asmgen/catch-try-float.cmm
@@ -0,0 +1,12 @@
+(* TEST
+files = "main.c"
+arguments = "-DFLOAT_CATCH -DFUN=catch_try_float main.c"
+* asmgen
+*)
+
+(function "catch_try_float" (b:float)
+  (+f 10.0
+  (catch
+    (try (exit lbl 100.0)
+     with var 456.0)
+   with (lbl x:float) (+f x 1000.0))))
diff --git a/testsuite/tests/asmgen/catch-try.cmm b/testsuite/tests/asmgen/catch-try.cmm
new file mode 100644
index 00000000..7537c656
--- /dev/null
+++ b/testsuite/tests/asmgen/catch-try.cmm
@@ -0,0 +1,12 @@
+(* TEST
+files = "main.c"
+arguments = "-DINT_INT -DFUN=catch_exit main.c"
+* asmgen
+*)
+
+(function "catch_exit" (b:int)
+  (+ 33
+  (catch
+    (try (exit lbl 12)
+     with var 456)
+   with (lbl x:val) (+ x 789))))
diff --git a/testsuite/tests/asmgen/checkbound.cmm b/testsuite/tests/asmgen/checkbound.cmm
new file mode 100644
index 00000000..0b864d5b
--- /dev/null
+++ b/testsuite/tests/asmgen/checkbound.cmm
@@ -0,0 +1,26 @@
+(* TEST
+files = "main.c"
+arguments = "-DCHECKBOUND main.c"
+* asmgen
+*)
+
+(**************************************************************************)
+(*                                                                        *)
+(*                                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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(function "checkbound2" (x: int y: int)
+  (checkbound x y))
+
+(function "checkbound1" (x: int)
+  (checkbound x 2))
diff --git a/testsuite/tests/asmgen/even-odd-spill-float.cmm b/testsuite/tests/asmgen/even-odd-spill-float.cmm
new file mode 100644
index 00000000..1603aa80
--- /dev/null
+++ b/testsuite/tests/asmgen/even-odd-spill-float.cmm
@@ -0,0 +1,27 @@
+(* TEST
+files = "main.c"
+arguments = "-DINT_FLOAT -DFUN=is_even main.c"
+* asmgen
+*)
+
+("format_odd": string "odd %d\n\000")
+("format_even": string "even %d\n\000")
+
+(function "force_spill" (a:int) 0)
+(function "force_spill_float" (f:float) 0.0)
+
+(function "is_even" (b:int)
+  (catch (exit even b 0.0)
+   with (odd v:val f:float)
+     (if (== v 0) f
+         (seq
+           (extcall "printf_int" "format_odd" v unit)
+           (let v2 (- v 1)
+             (app "force_spill" 0 int)
+             (app "force_spill_float" 0.0 float)
+             (exit even v2 (+f 1.0 f)))))
+   and (even v:val f:float)
+     (if (== v 0) f
+         (seq
+           (extcall "printf_int" "format_even" v unit)
+           (exit odd (- v 1) (+f 1.0 f))))))
diff --git a/testsuite/tests/asmgen/even-odd-spill.cmm b/testsuite/tests/asmgen/even-odd-spill.cmm
new file mode 100644
index 00000000..f0b9a70f
--- /dev/null
+++ b/testsuite/tests/asmgen/even-odd-spill.cmm
@@ -0,0 +1,25 @@
+(* TEST
+files = "main.c"
+arguments = "-DINT_INT -DFUN=is_even main.c"
+* asmgen
+*)
+
+("format_odd": string "odd %d\n\000")
+("format_even": string "even %d\n\000")
+
+(function "force_spill" (a:int) 0)
+
+(function "is_even" (b:int)
+  (catch (exit even b)
+   with (odd v:val)
+     (if (== v 0) 0
+         (seq
+           (extcall "printf_int" "format_odd" v unit)
+           (let v2 (- v 1)
+             (app "force_spill" 0 int)
+             (exit even v2))))
+   and (even v:val)
+     (if (== v 0) 1
+         (seq
+           (extcall "printf_int" "format_even" v unit)
+           (exit odd (- v 1))))))
diff --git a/testsuite/tests/asmgen/even-odd.cmm b/testsuite/tests/asmgen/even-odd.cmm
new file mode 100644
index 00000000..adf0d0b8
--- /dev/null
+++ b/testsuite/tests/asmgen/even-odd.cmm
@@ -0,0 +1,14 @@
+(* TEST
+files= "main.c"
+arguments = "-DINT_INT -DFUN=is_even main.c"
+* asmgen
+*)
+
+(function "is_even" (b:int)
+  (catch (exit even b)
+   with (odd v:val)
+     (if (== v 0) 0
+         (exit even (- v 1)))
+   and (even v:val)
+     (if (== v 0) 1
+         (exit odd (- v 1)))))
diff --git a/testsuite/tests/asmgen/fib.cmm b/testsuite/tests/asmgen/fib.cmm
new file mode 100644
index 00000000..c1a82de2
--- /dev/null
+++ b/testsuite/tests/asmgen/fib.cmm
@@ -0,0 +1,26 @@
+(* TEST
+files = "main.c"
+arguments = "-DINT_INT -DFUN=fib main.c"
+* asmgen
+*)
+
+(**************************************************************************)
+(*                                                                        *)
+(*                                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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(function "fib" (n: int)
+  (if (< n 2)
+      1
+    (+ (app "fib" (- n 1) int)
+       (app "fib" (- n 2) int))))
diff --git a/testsuite/tests/asmgen/integr.cmm b/testsuite/tests/asmgen/integr.cmm
new file mode 100644
index 00000000..84a3895c
--- /dev/null
+++ b/testsuite/tests/asmgen/integr.cmm
@@ -0,0 +1,39 @@
+(* TEST
+files = "main.c"
+arguments = "-DINT_FLOAT -DFUN=test main.c"
+* skip
+reason = "This test is currently broken"
+** asmgen
+*)
+
+(**************************************************************************)
+(*                                                                        *)
+(*                                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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(function "square" (x: float)
+   ( *f x x))
+
+(function "integr" (f: addr low: float high: float n: int)
+  (let (h (/f (-f high low) (floatofint n))
+        x low
+        s 0.0
+        i n)
+    (while (> i 0)
+      (assign s (+f s (app f x float)))
+      (assign x (+f x h))
+      (assign i (- i 1)))
+    ( *f s h)))
+
+(function "test" (n: int)
+  (app "integr" "square" 0.0 1.0 n float))
diff --git a/testsuite/tests/asmgen/main.c b/testsuite/tests/asmgen/main.c
new file mode 100644
index 00000000..103e022b
--- /dev/null
+++ b/testsuite/tests/asmgen/main.c
@@ -0,0 +1,143 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <stddef.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+
+void caml_ml_array_bound_error(void)
+{
+  fprintf(stderr, "Fatal error: out-of-bound access in array or string\n");
+  exit(2);
+}
+
+void print_string(char * s)
+{
+  fputs(s, stdout);
+}
+
+void printf_int(char * fmt, int arg)
+{
+  printf(fmt, arg);
+}
+
+#define FLOATTEST(arg,res) \
+  { double result = (res); \
+    if (arg < result || arg > result) { \
+      printf("Failed test \"%s == %s\": " \
+             "result %.15g, expected %.15g\n", \
+             #arg, #res, arg, result); \
+      return(2); \
+    } \
+  }
+
+#ifdef SORT
+
+int cmpint(const void * i, const void * j)
+{
+  long vi = *((long *) i);
+  long vj = *((long *) j);
+  if (vi == vj) return 0;
+  if (vi < vj) return -1;
+  return 1;
+}
+
+#endif
+
+int main(int argc, char **argv)
+{
+#ifdef UNIT_INT
+  { extern long FUN(void);
+    extern long call_gen_code(long (*)(void));
+    printf("%ld\n", call_gen_code(FUN));
+  }
+#else
+  if (argc < 2) {
+    fprintf(stderr, "Usage: %s [int arg]\n", argv[0]);
+    exit(2);
+  }
+#ifdef INT_INT
+  { extern long FUN(long);
+    extern long call_gen_code(long (*)(long), long);
+    printf("%ld\n", call_gen_code(FUN, atoi(argv[1])));
+  }
+#endif
+#ifdef INT_FLOAT
+  { extern double FUN(long);
+    extern double call_gen_code(double (*)(long), long);
+    printf("%f\n", call_gen_code(FUN, atoi(argv[1])));
+  }
+#endif
+#ifdef FLOAT_CATCH
+  { extern double FUN(long);
+    extern double call_gen_code(double (*)(long), long);
+    double result = call_gen_code(FUN, 1);
+    FLOATTEST(result, 1110.0)
+    printf("%f\n", result);
+  }
+#endif
+#ifdef SORT
+  { extern void FUN(long, long, long *);
+    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;
+#ifdef DEBUG
+    for (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];
+    call_gen_code(FUN, 0, n-1, a);
+#ifdef DEBUG
+    for (i = 0; i < n; i++) printf("%ld ", a[i]); printf("\n");
+#endif
+    qsort(b, n, sizeof(long), cmpint);
+    for (i = 0; i < n; i++) {
+      if (a[i] != b[i]) { printf("Bug!\n"); return 2; }
+    }
+    printf("OK\n");
+  }
+#endif
+#endif
+#ifdef CHECKBOUND
+  { extern void checkbound1(long), checkbound2(long, long);
+    extern void call_gen_code(void *, ...);
+    long x, y;
+    x = atoi(argv[1]);
+    if (argc >= 3) {
+      y = atoi(argv[2]);
+      if ((unsigned long) x < (unsigned long) y)
+        printf("Should not trap\n");
+      else
+        printf("Should trap\n");
+      call_gen_code(checkbound2, y, x);
+    } else {
+      if (2 < (unsigned long) x)
+        printf("Should not trap\n");
+      else
+        printf("Should trap\n");
+      call_gen_code(checkbound1, x);
+    }
+    printf("OK\n");
+  }
+#endif
+  return 0;
+}
diff --git a/testsuite/tests/asmgen/mainarith.c b/testsuite/tests/asmgen/mainarith.c
new file mode 100644
index 00000000..354ab02d
--- /dev/null
+++ b/testsuite/tests/asmgen/mainarith.c
@@ -0,0 +1,346 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <stdio.h>
+#include <math.h>
+#include <time.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include <caml/config.h>
+#define FMT ARCH_INTNAT_PRINTF_FORMAT
+
+void caml_ml_array_bound_error(void)
+{
+  fprintf(stderr, "Fatal error: out-of-bound access in array or string\n");
+  exit(2);
+}
+
+intnat R[200];
+double D[40];
+intnat X, Y;
+double F, G;
+volatile double H;
+
+#define INTTEST(arg,res) \
+  { intnat result = (res); \
+    if (arg != result) \
+      printf("Failed test \"%s == %s\" for X=%"FMT"d and Y=%"FMT"d: " \
+             "result %"FMT"d, expected %"FMT"d\n",                    \
+             #arg, #res, X, Y, arg, result); \
+  }
+#define INTFLOATTEST(arg,res) \
+  { intnat result = (res); \
+    if (arg != result) \
+      printf("Failed test \"%s == %s\" for F=%.15g and G=%.15g: "\
+             "result %"FMT"d, expected %"FMT"d\n",               \
+             #arg, #res, F, G, arg, result); \
+  }
+#define FLOATTEST(arg,res) \
+  { double result; \
+    H = (res); \
+    result = H; \
+    if (arg < result || arg > result) \
+      printf("Failed test \"%s == %s\" for F=%.15g and G=%.15g: "\
+             "result %.15g, expected %.15g\n",                   \
+             #arg, #res, F, G, arg, result); \
+  }
+#define FLOATINTTEST(arg,res) \
+  { double result = (res); \
+    if (arg < result || arg > result) \
+      printf("Failed test \"%s == %s\" for X=%"FMT"d and Y=%"FMT"d: "\
+             "result %.15g, expected %.15g\n",                       \
+             #arg, #res, X, Y, arg, result); \
+  }
+
+extern void call_gen_code(void (*)(void));
+extern void testarith(void);
+static intnat mulhs(intnat x, intnat y);
+
+void do_test(void)
+{
+      call_gen_code(testarith);
+
+      INTTEST(R[0], 0);
+      INTTEST(R[1], 1);
+      INTTEST(R[2], -1);
+      INTTEST(R[3], 256);
+      INTTEST(R[4], 65536);
+      INTTEST(R[5], 16777216);
+      INTTEST(R[6], -256);
+      INTTEST(R[7], -65536);
+      INTTEST(R[8], -16777216);
+
+      INTTEST(R[9], (X + Y));
+      INTTEST(R[10], (X + 1));
+      INTTEST(R[11], (X + -1));
+
+      INTTEST(R[12], ((intnat) ((char *)R + 8)));
+      INTTEST(R[13], ((intnat) ((char *)R + Y)));
+
+      INTTEST(R[14], (X - Y));
+      INTTEST(R[15], (X - 1));
+      INTTEST(R[16], (X - -1));
+
+      INTTEST(R[17], ((intnat) ((uintnat)R - 8)));
+      INTTEST(R[18], ((intnat) ((char *)R - Y)));
+
+      INTTEST(R[19], (X * 2));
+      INTTEST(R[20], (2 * X));
+      INTTEST(R[21], (X * 16));
+      INTTEST(R[22], (16 * X));
+      INTTEST(R[23], (X * 12345));
+      INTTEST(R[24], (12345 * X));
+      INTTEST(R[25], (X * Y));
+
+      INTTEST(R[26], (X / 2));
+      INTTEST(R[27], (X / 16));
+      INTTEST(R[28], (X / 7));
+      INTTEST(R[29], (Y != 0 ? X / Y : 0));
+
+      INTTEST(R[30], (X % 2));
+      INTTEST(R[31], (X % 16));
+      INTTEST(R[32], (Y != 0 ? X % Y : 0));
+
+      INTTEST(R[33], (X & Y));
+      INTTEST(R[34], (X & 3));
+      INTTEST(R[35], (3 & X));
+
+      INTTEST(R[36], (X | Y));
+      INTTEST(R[37], (X | 3));
+      INTTEST(R[38], (3 | X));
+
+      INTTEST(R[39], (X ^ Y));
+      INTTEST(R[40], (X ^ 3));
+      INTTEST(R[41], (3 ^ X));
+
+      INTTEST(R[42], (X << Y));
+      INTTEST(R[43], (X << 1));
+      INTTEST(R[44], (X << 8));
+
+      INTTEST(R[45], ((uintnat) X >> Y));
+      INTTEST(R[46], ((uintnat) X >> 1));
+      INTTEST(R[47], ((uintnat) X >> 8));
+
+      INTTEST(R[48], (X >> Y));
+      INTTEST(R[49], (X >> 1));
+      INTTEST(R[50], (X >> 8));
+
+      INTTEST(R[51], (X == Y));
+      INTTEST(R[52], (X != Y));
+      INTTEST(R[53], (X < Y));
+      INTTEST(R[54], (X > Y));
+      INTTEST(R[55], (X <= Y));
+      INTTEST(R[56], (X >= Y));
+      INTTEST(R[57], (X == 1));
+      INTTEST(R[58], (X != 1));
+      INTTEST(R[59], (X < 1));
+      INTTEST(R[60], (X > 1));
+      INTTEST(R[61], (X <= 1));
+      INTTEST(R[62], (X >= 1));
+
+      INTTEST(R[63], ((char *)X == (char *)Y));
+      INTTEST(R[64], ((char *)X != (char *)Y));
+      INTTEST(R[65], ((char *)X < (char *)Y));
+      INTTEST(R[66], ((char *)X > (char *)Y));
+      INTTEST(R[67], ((char *)X <= (char *)Y));
+      INTTEST(R[68], ((char *)X >= (char *)Y));
+      INTTEST(R[69], ((char *)X == (char *)1));
+      INTTEST(R[70], ((char *)X != (char *)1));
+      INTTEST(R[71], ((char *)X < (char *)1));
+      INTTEST(R[72], ((char *)X > (char *)1));
+      INTTEST(R[73], ((char *)X <= (char *)1));
+      INTTEST(R[74], ((char *)X >= (char *)1));
+
+      INTTEST(R[75], (X + (Y << 1)));
+      INTTEST(R[76], (X + (Y << 2)));
+      INTTEST(R[77], (X + (Y << 3)));
+      INTTEST(R[78], (X - (Y << 1)));
+      INTTEST(R[79], (X - (Y << 2)));
+      INTTEST(R[80], (X - (Y << 3)));
+
+      FLOATTEST(D[0], 0.0);
+      FLOATTEST(D[1], 1.0);
+      FLOATTEST(D[2], -1.0);
+      FLOATTEST(D[3], (F + G));
+      FLOATTEST(D[4], (F - G));
+      FLOATTEST(D[5], (F * G));
+      FLOATTEST(D[6], F / G);
+
+      FLOATTEST(D[7], (F + (G + 1.0)));
+      FLOATTEST(D[8], (F - (G + 1.0)));
+      FLOATTEST(D[9], (F * (G + 1.0)));
+      FLOATTEST(D[10], F / (G + 1.0));
+
+      FLOATTEST(D[11], ((F + 1.0) + G));
+      FLOATTEST(D[12], ((F + 1.0) - G));
+      FLOATTEST(D[13], ((F + 1.0) * G));
+      FLOATTEST(D[14], (F + 1.0) / G);
+
+      FLOATTEST(D[15], ((F + 1.0) + (G + 1.0)));
+      FLOATTEST(D[16], ((F + 1.0) - (G + 1.0)));
+      FLOATTEST(D[17], ((F + 1.0) * (G + 1.0)));
+      FLOATTEST(D[18], (F + 1.0) / (G + 1.0));
+
+      INTFLOATTEST(R[81], (F == G));
+      INTFLOATTEST(R[82], (F != G));
+      INTFLOATTEST(R[83], (F < G));
+      INTFLOATTEST(R[84], (F > G));
+      INTFLOATTEST(R[85], (F <= G));
+      INTFLOATTEST(R[86], (F >= G));
+
+      FLOATINTTEST(D[19], (double) X);
+      INTFLOATTEST(R[87], (intnat) F);
+
+      INTTEST(R[88], (X >= 0) && (X < Y));
+      INTTEST(R[89], (0 < Y));
+      INTTEST(R[90], (5 < Y));
+
+      INTFLOATTEST(R[91], (F == G));
+      INTFLOATTEST(R[92], (F != G));
+      INTFLOATTEST(R[93], (F < G));
+      INTFLOATTEST(R[94], (F > G));
+      INTFLOATTEST(R[95], (F <= G));
+      INTFLOATTEST(R[96], (F >= G));
+
+      INTFLOATTEST(R[97], (F + 1.0 == G + 1.0));
+      INTFLOATTEST(R[98], (F + 1.0 != G + 1.0));
+      INTFLOATTEST(R[99], (F + 1.0 < G + 1.0));
+      INTFLOATTEST(R[100], (F + 1.0 > G + 1.0));
+      INTFLOATTEST(R[101], (F + 1.0 <= G + 1.0));
+      INTFLOATTEST(R[102], (F + 1.0 >= G + 1.0));
+
+      INTFLOATTEST(R[103], (F == G + 1.0));
+      INTFLOATTEST(R[104], (F != G + 1.0));
+      INTFLOATTEST(R[105], (F < G + 1.0));
+      INTFLOATTEST(R[106], (F > G + 1.0));
+      INTFLOATTEST(R[107], (F <= G + 1.0));
+      INTFLOATTEST(R[108], (F >= G + 1.0));
+
+      INTFLOATTEST(R[109], (F + 1.0 == G));
+      INTFLOATTEST(R[110], (F + 1.0 != G));
+      INTFLOATTEST(R[111], (F + 1.0 < G));
+      INTFLOATTEST(R[112], (F + 1.0 > G));
+      INTFLOATTEST(R[113], (F + 1.0 <= G));
+      INTFLOATTEST(R[114], (F + 1.0 >= G));
+
+      FLOATINTTEST(D[20], ((double) X) + 1.0);
+      INTFLOATTEST(R[115], (intnat)(F + 1.0));
+
+      FLOATTEST(D[21], F + G);
+      FLOATTEST(D[22], G + F);
+      FLOATTEST(D[23], F - G);
+      FLOATTEST(D[24], G - F);
+      FLOATTEST(D[25], F * G);
+      FLOATTEST(D[26], G * F);
+      FLOATTEST(D[27], F / G);
+      FLOATTEST(D[28], G / F);
+
+      FLOATTEST(D[29], (F * 2.0) + G);
+      FLOATTEST(D[30], G + (F * 2.0));
+      FLOATTEST(D[31], (F * 2.0) - G);
+      FLOATTEST(D[32], G - (F * 2.0));
+      FLOATTEST(D[33], (F + 2.0) * G);
+      FLOATTEST(D[34], G * (F + 2.0));
+      FLOATTEST(D[35], (F * 2.0) / G);
+      FLOATTEST(D[36], G / (F * 2.0));
+
+      FLOATTEST(D[37], - F);
+      FLOATTEST(D[38], fabs(F));
+
+      INTTEST(R[116], mulhs(X, Y));
+}
+
+/* Multiply-high signed.  Hacker's Delight section 8.2 */
+
+#define HALFSIZE (4 * sizeof(intnat))
+#define HALFMASK (((intnat)1 << HALFSIZE) - 1)
+
+static intnat mulhs(intnat u, intnat v)
+{
+  uintnat u0, v0, w0;
+  intnat u1, v1, w1, w2, t;
+  u0 = u & HALFMASK; u1 = u >> HALFSIZE;
+  v0 = v & HALFMASK; v1 = v >> HALFSIZE;
+  w0 = u0*v0;
+  t = u1*v0 + (w0 >> HALFSIZE);
+  w1 = t & HALFMASK;
+  w2 = t >> HALFSIZE;
+  w1 = u0*v1 + w1;
+  return u1*v1 + w2 + (w1 >> HALFSIZE);
+}
+
+/* A simple linear congruential PRNG */
+
+#ifdef ARCH_SIXTYFOUR
+#define RAND_A 6364136223846793005ULL
+#define RAND_C 1442695040888963407ULL
+#else
+#define RAND_A 214013U
+#define RAND_C 2531011U
+#endif
+
+static intnat rnd(void)
+{
+  static uintnat seed = 0;
+  seed = seed * RAND_A + RAND_C;
+  return (intnat) seed;
+}
+
+/* Test harness */
+
+#define NUM_RANDOM_ITERATIONS 1000000
+
+int main(int argc, char **argv)
+{
+  int i;
+  double weird[4];
+
+  if (argc >= 5) {
+    X = atoi(argv[1]);
+    Y = atoi(argv[2]);
+    sscanf(argv[3], "%lf", &F);
+    sscanf(argv[4], "%lf", &G);
+    do_test();
+    return 0;
+  }
+  printf("Testing -2...2\n");
+  for(Y = -2; Y <= 2; Y++) {
+    for (X = -2; X <= 2; X++) {
+      F = X; G = Y; do_test();
+    }
+  }
+  if (!(argc >= 2 && strcmp(argv[1], "noinf"))) {
+    printf("Testing special FP values\n");
+    weird[0] = 0.0;
+    weird[1] = 1.0 / weird[0];         /* +infty */
+    weird[2] = -1.0 / weird[0];        /* -infty */
+    weird[3] = 0.0 / weird[0];         /* NaN */
+    for (X = 0; X < 4; X++) {
+      for (Y = 0; Y < 4; Y++) {
+        F = weird[X]; G = weird[Y]; do_test();
+      }
+    }
+  }
+  printf("Testing %d random values\n", NUM_RANDOM_ITERATIONS);
+  for (i = 0; i < NUM_RANDOM_ITERATIONS; i++) {
+    X = rnd();
+    Y = rnd();
+    F = X / 1e3;
+    G = Y / 1e3;
+    do_test();
+  }
+  return 0;
+}
diff --git a/testsuite/tests/asmgen/pgcd.cmm b/testsuite/tests/asmgen/pgcd.cmm
new file mode 100644
index 00000000..3bd067c8
--- /dev/null
+++ b/testsuite/tests/asmgen/pgcd.cmm
@@ -0,0 +1,15 @@
+(* TEST
+files = "main.c"
+arguments = "-DINT_INT -DFUN=pgcd_30030 main.c"
+* asmgen
+*)
+
+(function "pgcd_30030" (a:int)
+  (catch (exit pgcd a 30030)
+   with (pgcd n:val m:val)
+     (if (> n m)
+         (exit pgcd m n)
+         (if (== n 0)
+             m
+             (let (r (mod m n))
+                     (exit pgcd r n))))))
diff --git a/testsuite/tests/asmgen/quicksort.cmm b/testsuite/tests/asmgen/quicksort.cmm
new file mode 100644
index 00000000..5ac97a41
--- /dev/null
+++ b/testsuite/tests/asmgen/quicksort.cmm
@@ -0,0 +1,50 @@
+(* TEST
+files = "main.c"
+arguments = "-DSORT -DFUN=quicksort main.c"
+* asmgen
+*)
+
+(**************************************************************************)
+(*                                                                        *)
+(*                                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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(function "quicksort" (lo: int hi: int a: val)
+  (if (< lo hi)
+      (letmut (i int lo
+               j int hi
+               pivot int (addraref a hi))
+        (while (< i j)
+          (catch
+              (while 1
+                (if (>= i hi) (exit n25) [])
+                (if (> (addraref a i) pivot) (exit n25) [])
+                (assign i (+ i 1)))
+           with (n25) [])
+          (catch
+              (while 1
+                (if (<= j lo) (exit n35) [])
+                (if (< (addraref a j) pivot) (exit n35) [])
+                (assign j (- j 1)))
+           with (n35) [])
+          (if (< i j)
+              (let temp (addraref a i)
+                   (addraset a i (addraref a j))
+                   (addraset a j temp))
+            []))
+        (let temp (addraref a i)
+             (addraset a i (addraref a hi))
+             (addraset a hi temp))
+        (app "quicksort" lo (- i 1) a unit)
+        (app "quicksort" (+ i 1) hi a unit))
+    []))
diff --git a/testsuite/tests/asmgen/quicksort2.cmm b/testsuite/tests/asmgen/quicksort2.cmm
new file mode 100644
index 00000000..b5822eca
--- /dev/null
+++ b/testsuite/tests/asmgen/quicksort2.cmm
@@ -0,0 +1,56 @@
+(* TEST
+files = "main.c"
+arguments = "-DSORT -DFUN=quicksort main.c"
+* asmgen
+*)
+
+(**************************************************************************)
+(*                                                                        *)
+(*                                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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(function "cmp" (i: int j: int)
+  (- i j))
+
+(function "quick" (lo: int hi: int a: val cmp: val)
+  (if (< lo hi)
+      (letmut (i int lo
+               j int hi
+               pivot int (intaref a hi))
+        (while (< i j)
+          (catch
+            (while 1
+              (if (>= i hi) (exit n25) [])
+              (if (> (app cmp (intaref a i) pivot int) 0) (exit n25) [])
+              (assign i (+ i 1)))
+            with (n25) [])
+          (catch
+            (while 1
+              (if (<= j lo) (exit n35) [])
+              (if (< (app cmp (intaref a j) pivot int) 0) (exit n35) [])
+              (assign j (- j 1)))
+           with (n35) [])
+          (if (< i j)
+              (let temp (intaref a i)
+                   (intaset a i (intaref a j))
+                   (intaset a j temp))
+            []))
+        (let temp (intaref a i)
+             (intaset a i (intaref a hi))
+             (intaset a hi temp))
+        (app "quick" lo (- i 1) a cmp unit)
+        (app "quick" (+ i 1) hi a cmp unit))
+    []))
+
+(function "quicksort" (lo: int hi: int a: val)
+  (app "quick" lo hi a "cmp" unit))
diff --git a/testsuite/tests/asmgen/soli.cmm b/testsuite/tests/asmgen/soli.cmm
new file mode 100644
index 00000000..93be3aab
--- /dev/null
+++ b/testsuite/tests/asmgen/soli.cmm
@@ -0,0 +1,116 @@
+(* TEST
+files = "main.c"
+arguments = "-DUNIT_INT -DFUN=solitaire main.c"
+* asmgen
+*)
+
+(**************************************************************************)
+(*                                                                        *)
+(*                                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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+("d1": int 0 int 1
+ "d2": int 1 int 0
+ "d3": int 0 int -1
+ "d4": int -1 int 0
+ "dir": val "d1" val "d2" val "d3" val "d4")
+
+("counter": int 0)
+
+(* Out = 0  Empty = 1  Peg = 2 *)
+
+("line0": int 0 int 0 int 0 int 0 int 0 int 0 int 0 int 0 int 0
+ "line1": int 0 int 0 int 0 int 2 int 2 int 2 int 0 int 0 int 0
+ "line2": int 0 int 0 int 0 int 2 int 2 int 2 int 0 int 0 int 0
+ "line3": int 0 int 2 int 2 int 2 int 2 int 2 int 2 int 2 int 0
+ "line4": int 0 int 2 int 2 int 2 int 1 int 2 int 2 int 2 int 0
+ "line5": int 0 int 2 int 2 int 2 int 2 int 2 int 2 int 2 int 0
+ "line6": int 0 int 0 int 0 int 2 int 2 int 2 int 0 int 0 int 0
+ "line7": int 0 int 0 int 0 int 2 int 2 int 2 int 0 int 0 int 0
+ "line8": int 0 int 0 int 0 int 0 int 0 int 0 int 0 int 0 int 0
+ "board": val "line0" val "line1" val "line2" val "line3"
+          val "line4" val "line5" val "line6" val "line7" val "line8")
+
+("format": string "%d\n\000")
+
+(function "solve" (m: int)
+  (store int "counter" (+ (load int "counter") 1))
+  (if (== m 31)
+      (== (intaref (addraref "board" 4) 4) 2)
+    (try
+     (if (== (mod (load int "counter") 500) 0)
+          (extcall "printf_int" "format" (load int "counter") unit)
+       [])
+     (letmut i int 1
+       (while (<= i 7)
+         (letmut j int 1
+           (while (<= j 7)
+             (if (== (intaref (addraref "board" i) j) 2)
+                 (seq
+                  (letmut k int 0
+                    (while (<= k 3)
+                      (let (d1 (intaref (addraref "dir" k) 0)
+                            d2 (intaref (addraref "dir" k) 1)
+                            i1 (+ i d1)
+                            i2 (+ i1 d1)
+                            j1 (+ j d2)
+                            j2 (+ j1 d2))
+                        (if (== (intaref (addraref "board" i1) j1) 2)
+                            (if (== (intaref (addraref "board" i2) j2) 1)
+                                (seq
+                                 (intaset (addraref "board" i) j 1)
+                                 (intaset (addraref "board" i1) j1 1)
+                                 (intaset (addraref "board" i2) j2 2)
+                                 (if (app "solve" (+ m 1) int)
+                                     (raise_notrace 0a)
+                                   [])
+                                 (intaset (addraref "board" i) j 2)
+                                 (intaset (addraref "board" i1) j1 2)
+                                 (intaset (addraref "board" i2) j2 1))
+                              [])
+                          []))
+                      (assign k (+ k 1)))))
+               [])
+             (assign j (+ j 1))))
+         (assign i (+ i 1))))
+     0
+   with bucket
+     1)))
+
+("format_out": string ".\000")
+("format_empty": string " \000")
+("format_peg": string "$\000")
+("format_newline": string "\n\000")
+
+(function "print_board" ()
+  (letmut i int 0
+    (while (< i 9)
+      (letmut j int 0
+        (while (< j 9)
+          (switch 3 (intaref (addraref "board" i) j)
+            case 0:
+              (extcall "print_string" "format_out" unit)
+            case 1:
+              (extcall "print_string" "format_empty" unit)
+            case 2:
+              (extcall "print_string" "format_peg" unit))
+          (assign j (+ j 1))))
+      (extcall "print_string" "format_newline" unit)
+      (assign i (+ i 1)))))
+
+(function "solitaire" ()
+  (seq
+    (if (app "solve" 0 int)
+        (app "print_board" [] unit)
+      [])
+    0))
diff --git a/testsuite/tests/asmgen/tagged-fib.cmm b/testsuite/tests/asmgen/tagged-fib.cmm
new file mode 100644
index 00000000..b9b96152
--- /dev/null
+++ b/testsuite/tests/asmgen/tagged-fib.cmm
@@ -0,0 +1,25 @@
+(* TEST
+files = "main.c"
+arguments = "-DINT_INT -DFUN=fib main.c"
+* asmgen
+*)
+
+(**************************************************************************)
+(*                                                                        *)
+(*                                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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(function "fib" (n: int)
+  (if (< n 5)
+      3
+    (-  (+ (app "fib" (- n 2) int) (app "fib" (- n 4) int)) 1)))
diff --git a/testsuite/tests/asmgen/tagged-integr.cmm b/testsuite/tests/asmgen/tagged-integr.cmm
new file mode 100644
index 00000000..8903405f
--- /dev/null
+++ b/testsuite/tests/asmgen/tagged-integr.cmm
@@ -0,0 +1,51 @@
+(* TEST
+files = "main.c"
+arguments = "-DINT_FLOAT -DFUN=test main.c"
+* asmgen
+*)
+
+(**************************************************************************)
+(*                                                                        *)
+(*                                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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+("res_square": skip 8)
+("h": skip 8)
+("x": skip 8)
+("s": skip 8)
+("res_integr": skip 8)
+
+(function "square" (x: val)
+   (let r "res_square"
+        (store float r ( *f (load float x) (load float x)))
+        r))
+
+(function "integr" (f: val low: val high: val n: int)
+  (letmut (h val "h" x val "x" s val "s" i int n)
+    (store float h (/f (-f (load float high) (load float low)) (floatofint n)))
+    (store float x (load float low))
+    (store float s 0.0)
+    (while (> i 0)
+      (store float s (+f (load float s) (load float (app f x val))))
+      (store float x (+f (load float x) (load float h)))
+      (assign i (- i 1)))
+    (store float "res_integr" ( *f (load float s) (load float h)))
+    "res_integr"))
+
+("low": skip 8)
+("hi": skip 8)
+
+(function "test" (n: int)
+  (store float "low" 0.0)
+  (store float "hi" 1.0)
+  (load float (app "integr" "square" "low" "hi" n val)))
diff --git a/testsuite/tests/asmgen/tagged-quicksort.cmm b/testsuite/tests/asmgen/tagged-quicksort.cmm
new file mode 100644
index 00000000..631dd6aa
--- /dev/null
+++ b/testsuite/tests/asmgen/tagged-quicksort.cmm
@@ -0,0 +1,53 @@
+(* TEST
+files = "main.c"
+arguments = "-DSORT -DFUN=quicksort main.c"
+* asmgen
+*)
+
+(**************************************************************************)
+(*                                                                        *)
+(*                                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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(function "quick" (lo: int hi: int a: val)
+  (if (< lo hi)
+      (letmut (i int lo
+               j int hi
+               pivot int (addraref a (>>s hi 1)))
+        (while (< i j)
+          (catch
+              (while 1
+                (if (>= i hi) (exit n25) [])
+                (if (> (addraref a (>>s i 1)) pivot) (exit n25) [])
+                (assign i (+ i 2)))
+           with (n25) [])
+          (catch
+              (while 1
+                (if (<= j lo) (exit n35) [])
+                (if (< (addraref a (>>s j 1)) pivot) (exit n35) [])
+                (assign j (- j 2)))
+           with (n35) [])
+          (if (< i j)
+              (let temp (addraref a (>>s i 1))
+                   (addraset a (>>s i 1) (addraref a (>>s j 1)))
+                   (addraset a (>>s j 1) temp))
+            []))
+        (let temp (addraref a (>>s i 1))
+             (addraset a (>>s i 1) (addraref a (>>s hi 1)))
+             (addraset a (>>s hi 1) temp))
+        (app "quick" lo (- i 2) a unit)
+        (app "quick" (+ i 2) hi a unit))
+    []))
+
+(function "quicksort" (lo: int hi: int a: val)
+   (app "quick" (+ (<< lo 1) 1) (+ (<< hi 1) 1) a unit))
diff --git a/testsuite/tests/asmgen/tagged-tak.cmm b/testsuite/tests/asmgen/tagged-tak.cmm
new file mode 100644
index 00000000..3ff6ea4f
--- /dev/null
+++ b/testsuite/tests/asmgen/tagged-tak.cmm
@@ -0,0 +1,30 @@
+(* TEST
+files = "main.c"
+arguments = "-DUNIT_INT -DFUN=takmain main.c"
+* asmgen
+*)
+
+(**************************************************************************)
+(*                                                                        *)
+(*                                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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(function "tak" (x:int y:int z:int)
+  (if (> x y)
+      (app "tak" (app "tak" (- x 2) y z int)
+                 (app "tak" (- y 2) z x int)
+                 (app "tak" (- z 2) x y int) int)
+      z))
+
+(function "takmain" (dummy: int)
+   (app "tak" 37 25 13 int))
diff --git a/testsuite/tests/asmgen/tak.cmm b/testsuite/tests/asmgen/tak.cmm
new file mode 100644
index 00000000..1835ef66
--- /dev/null
+++ b/testsuite/tests/asmgen/tak.cmm
@@ -0,0 +1,30 @@
+(* TEST
+files = "main.c"
+arguments = "-DUNIT_INT -DFUN=takmain main.c"
+* asmgen
+*)
+
+(**************************************************************************)
+(*                                                                        *)
+(*                                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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(function "tak" (x:int y:int z:int)
+  (if (> x y)
+      (app "tak" (app "tak" (- x 1) y z int)
+                 (app "tak" (- y 1) z x int)
+                 (app "tak" (- z 1) x y int) int)
+      z))
+
+(function "takmain" (dummy: int)
+   (app "tak" 18 12 6 int))
diff --git a/testsuite/tests/ast-invariants/test.ml b/testsuite/tests/ast-invariants/test.ml
new file mode 100644
index 00000000..314c668b
--- /dev/null
+++ b/testsuite/tests/ast-invariants/test.ml
@@ -0,0 +1,80 @@
+(* TEST
+   include ocamlcommon
+   * hasunix
+   include unix
+   arguments = "${ocamlsrcdir}"
+   ** native
+*)
+
+(* This test checks all ml files in the ocaml repository that are accepted
+   by the parser satisfy [Ast_invariants].
+
+   We don't check the invariants on the output of the parser, so this test
+   is to ensure that the parser doesn't accept more than [Ast_invariants].
+*)
+
+let root = Sys.argv.(1)
+
+let () = assert (Sys.file_exists (Filename.concat root "VERSION"))
+
+type _ kind =
+  | Implem : Parsetree.structure kind
+  | Interf : Parsetree.signature kind
+
+let parse : type a. a kind -> Lexing.lexbuf -> a = function
+  | Implem -> Parse.implementation
+  | Interf -> Parse.interface
+
+let invariants : type a. a kind -> a -> unit = function
+  | Implem -> Ast_invariants.structure
+  | Interf -> Ast_invariants.signature
+
+let check_file kind fn =
+  Warnings.parse_options false "-a";
+  let ic = open_in fn in
+  Location.input_name := fn;
+  let lexbuf = Lexing.from_channel ic in
+  Location.init lexbuf fn;
+  match parse kind lexbuf with
+  | exception _ ->
+    (* A few files don't parse as they are meant for the toplevel;
+       ignore them *)
+    close_in ic
+  | ast ->
+    close_in ic;
+    try
+      invariants kind ast
+    with exn ->
+      Location.report_exception Format.std_formatter exn
+
+type file_kind =
+  | Regular_file
+  | Directory
+  | Other
+
+let kind fn =
+  match Unix.lstat fn with
+  | exception _ -> Other
+  | { Unix.st_kind = Unix.S_DIR } -> Directory
+  | { Unix.st_kind = Unix.S_REG } -> Regular_file
+  | { Unix.st_kind = _          } -> Other
+
+let rec walk dir =
+  Array.iter
+    (fun fn ->
+       if fn = "" || fn.[0] = '.' then
+         ()
+       else begin
+         let fn = Filename.concat dir fn in
+         match kind fn with
+         | Other -> ()
+         | Directory -> walk fn
+         | Regular_file ->
+           if Filename.check_suffix fn ".mli" then
+             check_file Interf fn
+           else if Filename.check_suffix fn ".ml" then
+             check_file Implem fn
+       end)
+    (Sys.readdir dir)
+
+let () = walk root
diff --git a/testsuite/tests/ast-invariants/test.reference b/testsuite/tests/ast-invariants/test.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/backtrace/backtrace.ml b/testsuite/tests/backtrace/backtrace.ml
new file mode 100644
index 00000000..02a9343e
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace.ml
@@ -0,0 +1,23 @@
+(* TEST
+   flags = "-g"
+   ocamlrunparam += ",b=1"
+   compare_programs = "false"
+*)
+
+(* A test for stack backtraces *)
+
+exception Error of string
+
+let rec f msg n =
+  if n = 0 then raise(Error msg) else 1 + f msg (n-1)
+
+let g msg =
+  try
+    f msg 5
+  with Error "a" -> print_string "a"; print_newline(); 0
+     | Error "b" as exn -> print_string "b"; print_newline(); raise exn
+     | Error "c" -> raise (Error "c")
+
+let _ =
+  Printexc.record_backtrace true;
+  ignore (g Sys.argv.(1))
diff --git a/testsuite/tests/backtrace/backtrace.reference b/testsuite/tests/backtrace/backtrace.reference
new file mode 100644
index 00000000..ad4e1fa4
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace.reference
@@ -0,0 +1,26 @@
+a
+b
+Fatal error: exception Backtrace.Error("b")
+Raised at Backtrace.f in file "backtrace.ml", line 12, characters 16-32
+Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
+Called from Backtrace.g in file "backtrace.ml", line 16, characters 4-11
+Re-raised at Backtrace.g in file "backtrace.ml", line 18, characters 62-71
+Called from Backtrace in file "backtrace.ml", line 23, characters 9-25
+Fatal error: exception Backtrace.Error("c")
+Raised at Backtrace.g in file "backtrace.ml", line 19, characters 20-37
+Called from Backtrace in file "backtrace.ml", line 23, characters 9-25
+Fatal error: exception Backtrace.Error("d")
+Raised at Backtrace.f in file "backtrace.ml", line 12, characters 16-32
+Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
+Called from Backtrace.g in file "backtrace.ml", line 16, characters 4-11
+Called from Backtrace in file "backtrace.ml", line 23, characters 9-25
+Fatal error: exception Invalid_argument("index out of bounds")
+Raised by primitive operation at Backtrace in file "backtrace.ml", line 23, characters 12-24
diff --git a/testsuite/tests/backtrace/backtrace.run b/testsuite/tests/backtrace/backtrace.run
new file mode 100644
index 00000000..a1bbd91c
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace.run
@@ -0,0 +1,8 @@
+#!/bin/sh
+# Run the backtrace test
+
+exec > "${output}" 2>&1
+
+for arg in a b c d ''; do
+  "${program}" ${arg} || true
+done
diff --git a/testsuite/tests/backtrace/backtrace2.ml b/testsuite/tests/backtrace/backtrace2.ml
new file mode 100644
index 00000000..5b620866
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace2.ml
@@ -0,0 +1,80 @@
+(* TEST
+   flags = "-g"
+   ocamlrunparam += ",b=1"
+   compare_programs = "false"
+*)
+
+(* A test for stack backtraces *)
+
+exception Error of string
+
+let test_Error msg =
+  let rec f msg n =
+    if n = 0 then raise(Error msg) else 1 + f msg (n-1) in
+  let exception_raised_internally () =
+    try Hashtbl.find (Hashtbl.create 3) 0
+    with Not_found -> false in
+  try
+    f msg 5
+  with Error "a" -> print_string "a"; print_newline(); 0
+     | Error "b" as exn -> print_string "b"; print_newline(); raise exn
+     | Error "c" -> raise (Error "c")
+     (** [Error "d"] not caught *)
+     (** Test reraise when an exception is used in the middle of the exception
+         handler. Currently the wrong backtrace is used. *)
+     | Error "e" as exn ->
+         print_string "e"; print_newline ();
+         ignore (exception_raised_internally ()); raise exn
+     (** Test reraise of backtrace when a `when` clause use exceptions.
+         Currently the wrong backtrace is used.
+     *)
+     | Error "f" when exception_raised_internally () ->
+         assert false (** absurd: when false *)
+     | Error "f" as exn -> print_string "f"; print_newline(); raise exn
+
+let test_Not_found () =
+  let rec aux n =
+    if n = 0 then raise Not_found else 1 + aux (n-1)
+  in
+  try aux 5
+  (** Test the raise to reraise heuristic with included try_with.
+      Currently the wrong backtrace is used. *)
+  with exn ->
+    print_string "test_Not_found"; print_newline();
+    (try Hashtbl.find (Hashtbl.create 3) 0 with Not_found -> raise exn)
+
+let test_lazy =
+  let rec aux n =
+    if n = 0 then raise Not_found else 1 + aux (n-1)
+  in
+  let exception_raised_internally () =
+    try Hashtbl.find (Hashtbl.create 3) 0
+    with Not_found -> () in
+  let l = lazy (aux 5) in
+  (** Test the backtrace obtained from a lazy value.
+      Currently the second time the value is forced the
+      wrong backtrace is used. *)
+  fun () ->
+    exception_raised_internally ();
+    Lazy.force l
+
+let run g args =
+  try
+    ignore (g args.(0)); print_string "No exception\n"
+  with exn ->
+    Printf.printf "Uncaught exception %s\n" (Printexc.to_string exn);
+    Printexc.print_backtrace stdout
+
+let _ =
+  Printexc.record_backtrace true;
+  run test_Error [| "a" |];
+  run test_Error [| "b" |];
+  run test_Error [| "c" |];
+  run test_Error [| "d" |];
+  run test_Error [| "e" |];
+  run test_Error [| "f" |];
+  run test_Error [| |];
+  run test_Not_found  [| () |];
+  run test_lazy  [| () |];
+  run test_lazy  [| () |];
+  ()
diff --git a/testsuite/tests/backtrace/backtrace2.reference b/testsuite/tests/backtrace/backtrace2.reference
new file mode 100644
index 00000000..22666a7a
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace2.reference
@@ -0,0 +1,58 @@
+a
+No exception
+b
+Uncaught exception Backtrace2.Error("b")
+Raised at Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 18-34
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
+Called from Backtrace2.test_Error in file "backtrace2.ml", line 18, characters 4-11
+Re-raised at Backtrace2.test_Error in file "backtrace2.ml", line 20, characters 62-71
+Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
+Uncaught exception Backtrace2.Error("c")
+Raised at Backtrace2.test_Error in file "backtrace2.ml", line 21, characters 20-37
+Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
+Uncaught exception Backtrace2.Error("d")
+Raised at Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 18-34
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
+Called from Backtrace2.test_Error in file "backtrace2.ml", line 18, characters 4-11
+Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
+e
+Uncaught exception Backtrace2.Error("e")
+Raised at Backtrace2.test_Error in file "backtrace2.ml", line 27, characters 50-59
+Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
+f
+Uncaught exception Backtrace2.Error("f")
+Raised at Backtrace2.test_Error in file "backtrace2.ml", line 33, characters 62-71
+Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
+Uncaught exception Invalid_argument("index out of bounds")
+Raised by primitive operation at Backtrace2.run in file "backtrace2.ml", line 63, characters 14-22
+test_Not_found
+Uncaught exception Not_found
+Raised at Stdlib__hashtbl.find in file "hashtbl.ml", line 537, characters 13-28
+Called from Backtrace2.test_Not_found in file "backtrace2.ml", line 44, characters 9-42
+Re-raised at Backtrace2.test_Not_found in file "backtrace2.ml", line 44, characters 61-70
+Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
+Uncaught exception Not_found
+Raised at Backtrace2.test_lazy.aux in file "backtrace2.ml", line 48, characters 18-33
+Called from Backtrace2.test_lazy.aux in file "backtrace2.ml", line 48, characters 43-52
+Called from Backtrace2.test_lazy.aux in file "backtrace2.ml", line 48, characters 43-52
+Called from Backtrace2.test_lazy.aux in file "backtrace2.ml", line 48, characters 43-52
+Called from Backtrace2.test_lazy.aux in file "backtrace2.ml", line 48, characters 43-52
+Called from Backtrace2.test_lazy.aux in file "backtrace2.ml", line 48, characters 43-52
+Called from CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 31, characters 17-27
+Re-raised at CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 36, characters 4-11
+Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
+Uncaught exception Not_found
+Raised at Stdlib__hashtbl.find in file "hashtbl.ml", line 537, characters 13-28
+Called from Backtrace2.test_lazy.exception_raised_internally in file "backtrace2.ml", line 51, characters 8-41
+Re-raised at CamlinternalLazy.force_lazy_block.(fun) in file "camlinternalLazy.ml", line 35, characters 56-63
+Called from CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 31, characters 17-27
+Re-raised at CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 36, characters 4-11
+Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
diff --git a/testsuite/tests/backtrace/backtrace3.ml b/testsuite/tests/backtrace/backtrace3.ml
new file mode 100644
index 00000000..5f81bb85
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace3.ml
@@ -0,0 +1,65 @@
+(* TEST
+   flags = "-g"
+   ocamlrunparam += ",b=1"
+   compare_programs = "false"
+*)
+
+(* A test for stack backtraces *)
+
+exception Error of string
+
+let rec f msg n =
+  if n = 0 then raise(Error msg) else 1 + f msg (n-1)
+
+let g msg =
+  match
+    f msg 5
+  with
+  | _ ->
+     (* value return does not happen *)
+     assert false
+  | exception (Error "a") ->
+      print_string "a"; print_newline(); 0
+  | exception (Error "b" as exn) ->
+      (* this should Re-raise, appending to the current backtrace *)
+      print_string "b"; print_newline(); raise exn
+  | exception (Error "c") ->
+      (* according to the current re-raise policy (a static condition),
+         this does not re-raise *)
+      print_string "c"; print_newline(); raise (Error "c")
+  | exception (Error "d" as exn as _exn2) ->
+      (* this should Re-raise, appending to the current backtrace *)
+      print_string "d"; print_newline(); raise exn
+  | exception (Error "e" as _exn as exn2) ->
+      (* this should Re-raise, appending to the current backtrace *)
+      print_string "e"; print_newline(); raise exn2
+  | exception (exn as exn2) ->
+      match exn with
+      | Error "f" ->
+          (* this should Re-raise, appending to the current backtrace *)
+          print_string "f"; print_newline(); raise exn
+      | Error "g" ->
+          (* this should Re-raise, appending to the current backtrace *)
+          print_string "g"; print_newline(); raise exn2
+      | x ->
+          (* this should *not* Re-raise *)
+          raise x
+
+let run args =
+  try
+    ignore (g args.(0)); print_string "No exception\n"
+  with exn ->
+    Printf.printf "Uncaught exception %s\n" (Printexc.to_string exn);
+    Printexc.print_backtrace stdout
+
+let _ =
+  Printexc.record_backtrace true;
+  run [| "a" |];
+  run [| "b" |];
+  run [| "c" |];
+  run [| "d" |];
+  run [| "e" |];
+  run [| "f" |];
+  run [| "g" |];
+  run [| "h" |];
+  run [| |]
diff --git a/testsuite/tests/backtrace/backtrace3.reference b/testsuite/tests/backtrace/backtrace3.reference
new file mode 100644
index 00000000..b8b0456d
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace3.reference
@@ -0,0 +1,66 @@
+a
+No exception
+b
+Uncaught exception Backtrace3.Error("b")
+Raised at Backtrace3.f in file "backtrace3.ml", line 12, characters 16-32
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.g in file "backtrace3.ml", line 16, characters 4-11
+Re-raised at Backtrace3.g in file "backtrace3.ml", line 25, characters 41-50
+Called from Backtrace3.run in file "backtrace3.ml", line 50, characters 11-23
+c
+Uncaught exception Backtrace3.Error("c")
+Raised at Backtrace3.g in file "backtrace3.ml", line 29, characters 41-58
+Called from Backtrace3.run in file "backtrace3.ml", line 50, characters 11-23
+d
+Uncaught exception Backtrace3.Error("d")
+Raised at Backtrace3.f in file "backtrace3.ml", line 12, characters 16-32
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.g in file "backtrace3.ml", line 16, characters 4-11
+Re-raised at Backtrace3.g in file "backtrace3.ml", line 32, characters 41-50
+Called from Backtrace3.run in file "backtrace3.ml", line 50, characters 11-23
+e
+Uncaught exception Backtrace3.Error("e")
+Raised at Backtrace3.f in file "backtrace3.ml", line 12, characters 16-32
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.g in file "backtrace3.ml", line 16, characters 4-11
+Re-raised at Backtrace3.g in file "backtrace3.ml", line 35, characters 41-51
+Called from Backtrace3.run in file "backtrace3.ml", line 50, characters 11-23
+f
+Uncaught exception Backtrace3.Error("f")
+Raised at Backtrace3.f in file "backtrace3.ml", line 12, characters 16-32
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.g in file "backtrace3.ml", line 16, characters 4-11
+Re-raised at Backtrace3.g in file "backtrace3.ml", line 40, characters 45-54
+Called from Backtrace3.run in file "backtrace3.ml", line 50, characters 11-23
+g
+Uncaught exception Backtrace3.Error("g")
+Raised at Backtrace3.f in file "backtrace3.ml", line 12, characters 16-32
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
+Called from Backtrace3.g in file "backtrace3.ml", line 16, characters 4-11
+Re-raised at Backtrace3.g in file "backtrace3.ml", line 43, characters 45-55
+Called from Backtrace3.run in file "backtrace3.ml", line 50, characters 11-23
+Uncaught exception Backtrace3.Error("h")
+Raised at Backtrace3.g in file "backtrace3.ml", line 46, characters 10-17
+Called from Backtrace3.run in file "backtrace3.ml", line 50, characters 11-23
+Uncaught exception Invalid_argument("index out of bounds")
+Raised by primitive operation at Backtrace3.run in file "backtrace3.ml", line 50, characters 14-22
diff --git a/testsuite/tests/backtrace/backtrace_deprecated.ml b/testsuite/tests/backtrace/backtrace_deprecated.ml
new file mode 100644
index 00000000..5840112b
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace_deprecated.ml
@@ -0,0 +1,44 @@
+(* TEST
+   flags = "-g"
+   ocamlrunparam += ",b=1"
+   compare_programs = "false"
+*)
+
+(* A test for stack backtraces *)
+
+external get_backtrace : unit -> Printexc.backtrace_slot array option
+  = "caml_get_exception_backtrace"
+
+exception Error of string
+
+let rec f msg n =
+  if n = 0 then raise(Error msg) else 1 + f msg (n-1)
+
+let g msg =
+  try
+    f msg 5
+  with Error "a" -> print_string "a"; print_newline(); 0
+     | Error "b" as exn -> print_string "b"; print_newline(); raise exn
+     | Error "c" -> raise (Error "c")
+
+let run args =
+  try
+    ignore (g args.(0)); print_string "No exception\n"
+  with exn ->
+    Printf.printf "Uncaught exception %s\n" (Printexc.to_string exn);
+    get_backtrace () |> function
+    | None -> ()
+    | Some trace ->
+      Array.iteri
+        (fun i slot -> match Printexc.Slot.format i slot with
+          | None -> ()
+          | Some line -> print_endline line)
+        trace
+
+let _ =
+  Printexc.record_backtrace true;
+  run [| "a" |];
+  run [| "b" |];
+  run [| "c" |];
+  run [| "d" |];
+  run [| |]
diff --git a/testsuite/tests/backtrace/backtrace_deprecated.reference b/testsuite/tests/backtrace/backtrace_deprecated.reference
new file mode 100644
index 00000000..bbfd0205
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace_deprecated.reference
@@ -0,0 +1,27 @@
+a
+No exception
+b
+Uncaught exception Backtrace_deprecated.Error("b")
+Raised at Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 16-32
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
+Called from Backtrace_deprecated.g in file "backtrace_deprecated.ml", line 19, characters 4-11
+Re-raised at Backtrace_deprecated.g in file "backtrace_deprecated.ml", line 21, characters 62-71
+Called from Backtrace_deprecated.run in file "backtrace_deprecated.ml", line 26, characters 11-23
+Uncaught exception Backtrace_deprecated.Error("c")
+Raised at Backtrace_deprecated.g in file "backtrace_deprecated.ml", line 22, characters 20-37
+Called from Backtrace_deprecated.run in file "backtrace_deprecated.ml", line 26, characters 11-23
+Uncaught exception Backtrace_deprecated.Error("d")
+Raised at Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 16-32
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
+Called from Backtrace_deprecated.g in file "backtrace_deprecated.ml", line 19, characters 4-11
+Called from Backtrace_deprecated.run in file "backtrace_deprecated.ml", line 26, characters 11-23
+Uncaught exception Invalid_argument("index out of bounds")
+Raised by primitive operation at Backtrace_deprecated.run in file "backtrace_deprecated.ml", line 26, characters 14-22
diff --git a/testsuite/tests/backtrace/backtrace_or_exception.ml b/testsuite/tests/backtrace/backtrace_or_exception.ml
new file mode 100644
index 00000000..cdb10cdd
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace_or_exception.ml
@@ -0,0 +1,50 @@
+(* TEST
+   flags = "-g"
+   ocamlrunparam += ",b=1"
+   compare_programs = "false"
+*)
+
+exception Exn
+
+let return_exn ?(raise_it_instead=false) () =
+  if raise_it_instead then
+    raise Exn
+  else
+    Exn
+[@@inline never]
+
+let without_reraise () =
+  match return_exn () with
+  | Exn as exn
+  | exception (Exn as exn) ->
+    raise exn
+  | _ -> assert false
+
+let with_reraise () =
+  match return_exn ~raise_it_instead:true () with
+  | Exn as exn
+  | exception (Exn as exn) ->
+    raise exn
+  | _ -> assert false
+
+let trickier () =
+  try raise Not_found
+  with e ->
+    match return_exn () with
+    | Exn as exn
+    | exception (Exn as exn) ->
+      raise exn
+    | _ -> assert false
+
+let run f =
+  try f ()
+  with exn ->
+    Printf.printf "exception %s\n" (Printexc.to_string exn);
+    Printexc.print_backtrace stdout;
+    Printf.printf "---------------------------\n%!"
+
+let _ =
+  Printexc.record_backtrace true;
+  run without_reraise;
+  run with_reraise;
+  run trickier
diff --git a/testsuite/tests/backtrace/backtrace_or_exception.reference b/testsuite/tests/backtrace/backtrace_or_exception.reference
new file mode 100644
index 00000000..53baeb40
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace_or_exception.reference
@@ -0,0 +1,14 @@
+exception Backtrace_or_exception.Exn
+Raised at Backtrace_or_exception.without_reraise in file "backtrace_or_exception.ml", line 20, characters 4-13
+Called from Backtrace_or_exception.run in file "backtrace_or_exception.ml", line 40, characters 6-10
+---------------------------
+exception Backtrace_or_exception.Exn
+Raised at Backtrace_or_exception.return_exn in file "backtrace_or_exception.ml", line 11, characters 4-13
+Called from Backtrace_or_exception.with_reraise in file "backtrace_or_exception.ml", line 24, characters 8-44
+Re-raised at Backtrace_or_exception.with_reraise in file "backtrace_or_exception.ml", line 27, characters 4-13
+Called from Backtrace_or_exception.run in file "backtrace_or_exception.ml", line 40, characters 6-10
+---------------------------
+exception Backtrace_or_exception.Exn
+Raised at Backtrace_or_exception.trickier in file "backtrace_or_exception.ml", line 36, characters 6-15
+Called from Backtrace_or_exception.run in file "backtrace_or_exception.ml", line 40, characters 6-10
+---------------------------
diff --git a/testsuite/tests/backtrace/backtrace_slots.ml b/testsuite/tests/backtrace/backtrace_slots.ml
new file mode 100644
index 00000000..2d9cc20d
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace_slots.ml
@@ -0,0 +1,66 @@
+(* TEST
+   flags = "-g"
+   ocamlrunparam += ",b=1"
+   compare_programs = "false"
+*)
+
+(* A test for stack backtraces *)
+
+let get_backtrace () =
+  let raw_backtrace = Printexc.get_raw_backtrace () in
+  let raw_slots =
+    Array.init (Printexc.raw_backtrace_length raw_backtrace)
+               (Printexc.get_raw_backtrace_slot raw_backtrace) in
+  let convert = Printexc.convert_raw_backtrace_slot in
+  let backtrace = Array.map convert raw_slots in
+  (* we'll play with raw slots a bit to check that hashing and comparison work:
+     - create a hashtable that maps slots to their index in the raw backtrace
+     - create a balanced set of all slots
+  *)
+  let table = Hashtbl.create 100 in
+  Array.iteri (fun i slot -> Hashtbl.add table slot i) raw_slots;
+  let module S = Set.Make(struct
+    type t = Printexc.raw_backtrace_slot
+    let compare = Stdlib.compare
+  end) in
+  let slots = Array.fold_right S.add raw_slots S.empty in
+  Array.iteri (fun i slot ->
+    assert (S.mem slot slots);
+    assert (Hashtbl.mem table slot);
+    let j =
+      (* position in the table of the last slot equal to [slot] *)
+      Hashtbl.find table slot in
+    assert (slot = raw_slots.(j));
+    assert (backtrace.(i) = backtrace.(j));
+  ) raw_slots;
+  backtrace
+
+exception Error of string
+
+let rec f msg n =
+  if n = 0 then raise(Error msg) else 1 + f msg (n-1)
+
+let g msg =
+  try
+    f msg 5
+  with Error "a" -> print_string "a"; print_newline(); 0
+     | Error "b" as exn -> print_string "b"; print_newline(); raise exn
+     | Error "c" -> raise (Error "c")
+
+let run args =
+  try
+    ignore (g args.(0)); print_string "No exception\n"
+  with exn ->
+    Printf.printf "Uncaught exception %s\n" (Printexc.to_string exn);
+    get_backtrace () |> Array.iteri
+        (fun i slot -> match Printexc.Slot.format i slot with
+          | None -> ()
+          | Some line -> print_endline line)
+
+let _ =
+  Printexc.record_backtrace true;
+  run [| "a" |];
+  run [| "b" |];
+  run [| "c" |];
+  run [| "d" |];
+  run [| |]
diff --git a/testsuite/tests/backtrace/backtrace_slots.reference b/testsuite/tests/backtrace/backtrace_slots.reference
new file mode 100644
index 00000000..a012b5cf
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace_slots.reference
@@ -0,0 +1,27 @@
+a
+No exception
+b
+Uncaught exception Backtrace_slots.Error("b")
+Raised at Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 16-32
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
+Called from Backtrace_slots.g in file "backtrace_slots.ml", line 45, characters 4-11
+Re-raised at Backtrace_slots.g in file "backtrace_slots.ml", line 47, characters 62-71
+Called from Backtrace_slots.run in file "backtrace_slots.ml", line 52, characters 11-23
+Uncaught exception Backtrace_slots.Error("c")
+Raised at Backtrace_slots.g in file "backtrace_slots.ml", line 48, characters 20-37
+Called from Backtrace_slots.run in file "backtrace_slots.ml", line 52, characters 11-23
+Uncaught exception Backtrace_slots.Error("d")
+Raised at Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 16-32
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
+Called from Backtrace_slots.g in file "backtrace_slots.ml", line 45, characters 4-11
+Called from Backtrace_slots.run in file "backtrace_slots.ml", line 52, characters 11-23
+Uncaught exception Invalid_argument("index out of bounds")
+Raised by primitive operation at Backtrace_slots.run in file "backtrace_slots.ml", line 52, characters 14-22
diff --git a/testsuite/tests/backtrace/backtraces_and_finalizers.ml b/testsuite/tests/backtrace/backtraces_and_finalizers.ml
new file mode 100644
index 00000000..8ea69593
--- /dev/null
+++ b/testsuite/tests/backtrace/backtraces_and_finalizers.ml
@@ -0,0 +1,32 @@
+(* TEST
+   flags = "-g -inline 0"
+   ocamlrunparam += ",b=1"
+   compare_programs = "false"
+   * native
+*)
+
+let () = Printexc.record_backtrace true
+
+let finaliser _ = try raise Exit with _ -> ()
+
+let create () =
+  let x = ref () in
+  Gc.finalise finaliser x;
+  x
+
+let f () = raise Exit
+
+let () =
+  let minor_size = (Gc.get ()).Gc.minor_heap_size in
+  for i = 1 to 100 do
+    Gc.minor ();
+    try
+      ignore (create () : unit ref);
+      f ()
+    with _ ->
+      for i = 1 to minor_size / 2 - 1 do
+        ignore (ref ())
+      done;
+      ignore (Printexc.get_backtrace () : string)
+  done;
+  Printf.printf "ok\n"
diff --git a/testsuite/tests/backtrace/backtraces_and_finalizers.reference b/testsuite/tests/backtrace/backtraces_and_finalizers.reference
new file mode 100644
index 00000000..9766475a
--- /dev/null
+++ b/testsuite/tests/backtrace/backtraces_and_finalizers.reference
@@ -0,0 +1 @@
+ok
diff --git a/testsuite/tests/backtrace/callstack.ml b/testsuite/tests/backtrace/callstack.ml
new file mode 100644
index 00000000..fc39ec1a
--- /dev/null
+++ b/testsuite/tests/backtrace/callstack.ml
@@ -0,0 +1,32 @@
+(* TEST
+   flags = "-g"
+   * hassysthreads
+   include systhreads
+   compare_programs = "false"
+   ** no-flambda
+   *** native
+   *** bytecode
+*)
+
+let[@inline never] f0 () =
+  Printexc.print_raw_backtrace stdout (Printexc.get_callstack 100); ()
+let[@inline never] f1 () = f0 (); ()
+let[@inline never] f2 () = f1 (); ()
+let[@inline never] f3 () = f2 (); ()
+
+let () = Printf.printf "main thread:\n"
+let () = f3 ()
+
+let () = Printf.printf "from finalizer:\n"
+let () =
+  Gc.finalise (fun _ -> f0 ()) [|1|];
+  Gc.full_major ();
+  ()
+
+(* We run this last, because the initialization of the thread library
+   starts the "tick thread", which periodically send a signal for
+   thread preemption. If the preempion occurs exactly when the
+   finalizer above runs, then a new row for [Thread.yield] appears in
+   the callstack, which breaks the test. *)
+let () = Printf.printf "new thread:\n"
+let () = Thread.join (Thread.create f3 ())
diff --git a/testsuite/tests/backtrace/callstack.reference b/testsuite/tests/backtrace/callstack.reference
new file mode 100644
index 00000000..e6c202d4
--- /dev/null
+++ b/testsuite/tests/backtrace/callstack.reference
@@ -0,0 +1,15 @@
+main thread:
+Raised by primitive operation at Callstack.f0 in file "callstack.ml", line 12, characters 38-66
+Called from Callstack.f1 in file "callstack.ml", line 13, characters 27-32
+Called from Callstack.f2 in file "callstack.ml", line 14, characters 27-32
+Called from Callstack.f3 in file "callstack.ml", line 15, characters 27-32
+Called from Callstack in file "callstack.ml", line 18, characters 9-14
+from finalizer:
+Raised by primitive operation at Callstack.f0 in file "callstack.ml", line 12, characters 38-66
+Called from Callstack in file "callstack.ml", line 23, characters 2-18
+new thread:
+Raised by primitive operation at Callstack.f0 in file "callstack.ml", line 12, characters 38-66
+Called from Callstack.f1 in file "callstack.ml", line 13, characters 27-32
+Called from Callstack.f2 in file "callstack.ml", line 14, characters 27-32
+Called from Callstack.f3 in file "callstack.ml", line 15, characters 27-32
+Called from Thread.create.(fun) in file "thread.ml", line 39, characters 8-14
diff --git a/testsuite/tests/backtrace/event_after_prim.ml b/testsuite/tests/backtrace/event_after_prim.ml
new file mode 100644
index 00000000..f57b00bb
--- /dev/null
+++ b/testsuite/tests/backtrace/event_after_prim.ml
@@ -0,0 +1,14 @@
+(* TEST
+   flags = "-g"
+   compare_programs = "false" *)
+
+let f n b =
+  let arr = Array.make n 42 in
+  if b then (arr, [| |]) else ([| |], arr)
+
+let () =
+  Printexc.record_backtrace true;
+  match Sys.opaque_identity f (-1) true with
+  | _ -> assert false
+  | exception _ ->
+    Printexc.print_backtrace stdout
diff --git a/testsuite/tests/backtrace/event_after_prim.reference b/testsuite/tests/backtrace/event_after_prim.reference
new file mode 100644
index 00000000..0678173c
--- /dev/null
+++ b/testsuite/tests/backtrace/event_after_prim.reference
@@ -0,0 +1,2 @@
+Raised by primitive operation at Event_after_prim.f in file "event_after_prim.ml", line 6, characters 12-27
+Called from Event_after_prim in file "event_after_prim.ml", line 11, characters 8-39
diff --git a/testsuite/tests/backtrace/filter-locations.sh b/testsuite/tests/backtrace/filter-locations.sh
new file mode 100755
index 00000000..6d9757f4
--- /dev/null
+++ b/testsuite/tests/backtrace/filter-locations.sh
@@ -0,0 +1,2 @@
+#!/bin/sh
+grep -oE '[a-zA-Z_]+\.ml(:[0-9]+)?|(line|characters) [0-9-]+'
diff --git a/testsuite/tests/backtrace/inline_test.ml b/testsuite/tests/backtrace/inline_test.ml
new file mode 100644
index 00000000..756dc148
--- /dev/null
+++ b/testsuite/tests/backtrace/inline_test.ml
@@ -0,0 +1,29 @@
+(* TEST
+   flags = "-g"
+   ocamlrunparam += ",b=1"
+   * bytecode
+   * native
+     compare_programs = "false"
+   * native
+     ocamlopt_flags = "-O3"
+     compiler_directory_suffix = ".O3"
+     compare_programs = "false"
+*)
+
+(* A test for inlined stack backtraces *)
+
+let f x =
+  raise (Failure "test") + 1
+
+let g x =
+  f x + 1
+
+let h x =
+  print_int (g x); print_endline "h"
+
+let i x =
+  if h x = () then ()
+
+let () =
+  Printexc.record_backtrace true;
+  i ()
diff --git a/testsuite/tests/backtrace/inline_test.reference b/testsuite/tests/backtrace/inline_test.reference
new file mode 100644
index 00000000..556ef2fc
--- /dev/null
+++ b/testsuite/tests/backtrace/inline_test.reference
@@ -0,0 +1,15 @@
+inline_test.ml
+line 16
+characters 2-24
+inline_test.ml
+line 19
+characters 2-5
+inline_test.ml
+line 22
+characters 12-17
+inline_test.ml
+line 25
+characters 5-8
+inline_test.ml
+line 29
+characters 2-6
diff --git a/testsuite/tests/backtrace/inline_test.run b/testsuite/tests/backtrace/inline_test.run
new file mode 100755
index 00000000..497b1940
--- /dev/null
+++ b/testsuite/tests/backtrace/inline_test.run
@@ -0,0 +1,3 @@
+#!/bin/sh
+(${program} 2>&1 || true) | \
+  ${test_source_directory}/filter-locations.sh > ${output}
diff --git a/testsuite/tests/backtrace/inline_traversal_test.ml b/testsuite/tests/backtrace/inline_traversal_test.ml
new file mode 100644
index 00000000..c4393bc9
--- /dev/null
+++ b/testsuite/tests/backtrace/inline_traversal_test.ml
@@ -0,0 +1,57 @@
+(* TEST
+   flags = "-g"
+   ocamlrunparam += ",b=1"
+   * bytecode
+   * native
+     compare_programs = "false"
+   * native
+     ocamlopt_flags = "-O3"
+     compiler_directory_suffix = ".O3"
+     compare_programs = "false"
+*)
+
+(* A test for inlined stack backtraces *)
+
+let f x =
+  raise (Failure "test") + 1
+
+let g x =
+  f x + 1
+
+let h x =
+  print_int (g x); print_endline "h"
+
+let i x =
+  if h x = () then ()
+
+let () =
+  let open Printexc in
+  record_backtrace true;
+  try i ()
+  with _ ->
+    let trace = get_raw_backtrace () in
+    let print_slot slot =
+      let x = convert_raw_backtrace_slot slot in
+      let is_raise = Slot.is_raise x in
+      let is_inline = Slot.is_inline x in
+      let location = match Slot.location x with
+        | None -> "<unknown>"
+        | Some {filename; line_number; _} ->
+            filename ^ ":" ^ Int.to_string line_number
+      in
+      Printf.printf "- %s%s%s\n"
+        location
+        (if is_inline then " inlined" else "")
+        (if is_raise then ", raise" else "")
+    in
+    let rec print_slots = function
+      | None -> ()
+      | Some slot ->
+        print_slot slot;
+        print_slots (get_raw_backtrace_next_slot slot)
+    in
+    for i = 0 to raw_backtrace_length trace - 1 do
+      let slot = get_raw_backtrace_slot trace i in
+      Printf.printf "Frame %d\n" i;
+      print_slots (Some slot)
+    done
diff --git a/testsuite/tests/backtrace/inline_traversal_test.reference b/testsuite/tests/backtrace/inline_traversal_test.reference
new file mode 100644
index 00000000..8dcdf455
--- /dev/null
+++ b/testsuite/tests/backtrace/inline_traversal_test.reference
@@ -0,0 +1,5 @@
+inline_traversal_test.ml:16
+inline_traversal_test.ml:19
+inline_traversal_test.ml:22
+inline_traversal_test.ml:25
+inline_traversal_test.ml:30
diff --git a/testsuite/tests/backtrace/inline_traversal_test.run b/testsuite/tests/backtrace/inline_traversal_test.run
new file mode 100755
index 00000000..497b1940
--- /dev/null
+++ b/testsuite/tests/backtrace/inline_traversal_test.run
@@ -0,0 +1,3 @@
+#!/bin/sh
+(${program} 2>&1 || true) | \
+  ${test_source_directory}/filter-locations.sh > ${output}
diff --git a/testsuite/tests/backtrace/methods.ml b/testsuite/tests/backtrace/methods.ml
new file mode 100644
index 00000000..0ea147c1
--- /dev/null
+++ b/testsuite/tests/backtrace/methods.ml
@@ -0,0 +1,28 @@
+(* TEST
+   flags = "-g"
+   compare_programs = "false" *)
+
+let[@inline never] id x = Sys.opaque_identity x
+
+class foo = object (self)
+  val other = new bar "asdf"
+  method go : unit =
+    id (other#go 1 2 3)
+end
+and bar _v = object (self)
+  method go _ _ _ : unit =
+    id (self#bang)
+  method bang : unit =
+    raise Exit
+end
+
+let () =
+  Printexc.record_backtrace true;
+  let obj = object (self)
+    method meth : unit =
+      id ((new foo)#go)
+  end in
+  match obj#meth with
+  | _ -> assert false
+  | exception Exit ->
+     Printexc.print_backtrace stdout
diff --git a/testsuite/tests/backtrace/methods.reference b/testsuite/tests/backtrace/methods.reference
new file mode 100644
index 00000000..f6420ee6
--- /dev/null
+++ b/testsuite/tests/backtrace/methods.reference
@@ -0,0 +1,5 @@
+Raised at Methods.bar#bang in file "methods.ml", line 16, characters 4-14
+Called from Methods.bar#go in file "methods.ml", line 14, characters 7-18
+Called from Methods.foo#go in file "methods.ml", line 10, characters 7-23
+Called from Methods.object#meth in file "methods.ml", line 23, characters 9-23
+Called from Methods in file "methods.ml", line 25, characters 8-16
diff --git a/testsuite/tests/backtrace/names.ml b/testsuite/tests/backtrace/names.ml
new file mode 100644
index 00000000..ff4af583
--- /dev/null
+++ b/testsuite/tests/backtrace/names.ml
@@ -0,0 +1,124 @@
+(* TEST
+   flags = "-g"
+   compare_programs = "false"
+ *)
+
+
+let id x = Sys.opaque_identity x
+
+let[@inline never] bang () = raise Exit
+
+
+let[@inline never] fn_multi _ _ f = f 42 + 1
+
+let[@inline never] fn_function = function
+  | f -> f 42 + 1
+
+let[@inline never] fn_poly : 'a . 'a -> ('a -> int) -> int = fun x f ->
+  f x + 1
+
+module Mod1 = struct
+  module Nested = struct
+    let[@inline never] apply f = f 42 + 1
+  end
+end
+
+let[@inline never] anon f =
+  let fn = id (fun () -> f 42 + 1) in
+  fn ()
+
+let[@inline never] double_anon f =
+  let fn = id (fun () ->
+    let fn = id (fun () ->
+      f 42 + 1) in
+    fn ()) in
+  fn ()
+
+let[@inline never] local f =
+  let[@inline never] inner () = f 42 + 1 in
+  (id inner) () + 1
+
+let[@inline never] double_local f =
+  let inner1 () =
+    let inner2 () = f 42 + 1 in
+    (id inner2) () + 1 in
+  (id inner1) () + 1
+
+let local_no_arg =
+  let inner f = f 42 + 1 in
+  fun[@inline never] f -> (id inner) f + 1
+
+let[@inline never] curried () =
+  let inner () f = f 42 in
+  id (inner ())
+
+let[@inline never] local_module f =
+  let module N = struct
+    let[@inline never] foo () =
+      f 42 + 1
+    let r = ref 0    let () = r := id (id foo ())
+  end in
+  !N.r
+
+module Functor (X : sig end) = struct
+  let[@inline never] fn f = f 42 + 1
+end
+module Inst = Functor (struct end)
+
+module rec Rec1 : sig
+  val fn : (int -> int) -> int
+end = struct
+  module M = Rec2 (struct end)
+  let[@inline never] fn f = M.fn f + 1
+end
+and Rec2 : functor (X : sig end) -> sig
+  val fn : (int -> int) -> int
+end = functor (X : sig end) -> struct
+  let[@inline never] fn f = f 42 + 1
+end
+
+let[@inline never] (+@+) n f = f 42 + 1
+
+class klass = object (self)
+  val other = new klass2 "asdf"
+  method meth f : int =
+    other#othermeth 1 1 f 1 + 1
+end
+and klass2 _v = object (self)
+  method othermeth _ _ f _ =
+    (id (fun g -> g 42 + 1) f) + 1
+end
+
+let inline_object f =
+  let obj = object (self)
+    method meth : int =
+      self#othermeth 1 f 1 + 1
+    method othermeth _ _ _ =
+      f 42 + 1
+  end in
+  obj#meth
+
+let () =
+  Printexc.record_backtrace true;
+  match
+    fn_multi 1 1 @@ fun _ ->
+    fn_function @@ fun _ ->
+    fn_poly 42 @@ fun _ ->
+    Mod1.Nested.apply @@ fun _ ->
+    anon @@ fun _ ->
+    double_anon @@ fun _ ->
+    local @@ fun _ ->
+    double_local @@ fun _ ->
+    local_no_arg @@ fun _ ->
+    curried () @@ fun _ ->
+    local_module @@ fun _ ->
+    Inst.fn @@ fun _ ->
+    Rec1.fn @@ fun _ ->
+    42 +@+ fun _ ->
+    (new klass)#meth @@ fun _ ->
+    inline_object @@ fun _ ->
+    bang ()
+  with
+  | _ -> assert false
+  | exception Exit ->
+     Printexc.print_backtrace stdout
diff --git a/testsuite/tests/backtrace/names.reference b/testsuite/tests/backtrace/names.reference
new file mode 100644
index 00000000..8ded55a4
--- /dev/null
+++ b/testsuite/tests/backtrace/names.reference
@@ -0,0 +1,26 @@
+Raised at Names.bang in file "names.ml", line 9, characters 29-39
+Called from Names.inline_object.object#othermeth in file "names.ml", line 97, characters 6-10
+Called from Names.inline_object.object#meth in file "names.ml", line 95, characters 6-26
+Called from Names.klass2#othermeth.(fun) in file "names.ml", line 89, characters 18-22
+Called from Names.klass2#othermeth in file "names.ml", line 89, characters 4-30
+Called from Names.klass#meth in file "names.ml", line 85, characters 4-27
+Called from Names.(+@+) in file "names.ml", line 80, characters 31-35
+Called from Names.Rec2.fn in file "names.ml", line 77, characters 28-32
+Called from Names.Rec1.fn in file "names.ml", line 72, characters 28-34
+Called from Names.Functor.fn in file "names.ml", line 64, characters 28-32
+Called from Names.local_module.N.foo in file "names.ml", line 58, characters 6-10
+Called from Names.local_module.N in file "names.ml", line 59, characters 38-49
+Called from Names.local_no_arg.inner in file "names.ml", line 48, characters 16-20
+Called from Names.local_no_arg.(fun) in file "names.ml", line 49, characters 26-38
+Called from Names.double_local.inner1.inner2 in file "names.ml", line 43, characters 20-24
+Called from Names.double_local.inner1 in file "names.ml", line 44, characters 4-18
+Called from Names.double_local in file "names.ml", line 45, characters 2-16
+Called from Names.local.inner in file "names.ml", line 38, characters 32-36
+Called from Names.local in file "names.ml", line 39, characters 2-15
+Called from Names.double_anon.(fun) in file "names.ml", line 33, characters 6-10
+Called from Names.anon.(fun) in file "names.ml", line 27, characters 25-29
+Called from Names.Mod1.Nested.apply in file "names.ml", line 22, characters 33-37
+Called from Names.fn_poly in file "names.ml", line 18, characters 2-5
+Called from Names.fn_function in file "names.ml", line 15, characters 9-13
+Called from Names.fn_multi in file "names.ml", line 12, characters 36-40
+Called from Names in file "names.ml", line 104, characters 4-445
diff --git a/testsuite/tests/backtrace/pr6920_why_at.ml b/testsuite/tests/backtrace/pr6920_why_at.ml
new file mode 100644
index 00000000..4b955667
--- /dev/null
+++ b/testsuite/tests/backtrace/pr6920_why_at.ml
@@ -0,0 +1,17 @@
+(* TEST
+   flags = "-g"
+   ocamlrunparam += ",b=1"
+   ocamlopt_flags = "-inline 0"
+   exit_status = "2"
+   compare_programs = "false"
+*)
+
+let why : unit -> unit = fun () -> raise Exit [@@inline never]
+let f () =
+  why @@ ();
+  ignore (3 + 2);
+  () [@@inline never]
+
+let () =
+  Printexc.record_backtrace true;
+  f ()
diff --git a/testsuite/tests/backtrace/pr6920_why_at.native.reference b/testsuite/tests/backtrace/pr6920_why_at.native.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/backtrace/pr6920_why_at.reference b/testsuite/tests/backtrace/pr6920_why_at.reference
new file mode 100644
index 00000000..5f71d817
--- /dev/null
+++ b/testsuite/tests/backtrace/pr6920_why_at.reference
@@ -0,0 +1,4 @@
+Fatal error: exception Stdlib.Exit
+Raised at Pr6920_why_at.why in file "pr6920_why_at.ml", line 9, characters 35-45
+Called from Pr6920_why_at.f in file "pr6920_why_at.ml", line 11, characters 2-11
+Called from Pr6920_why_at in file "pr6920_why_at.ml", line 17, characters 2-6
diff --git a/testsuite/tests/backtrace/pr6920_why_swallow.ml b/testsuite/tests/backtrace/pr6920_why_swallow.ml
new file mode 100644
index 00000000..b67e034d
--- /dev/null
+++ b/testsuite/tests/backtrace/pr6920_why_swallow.ml
@@ -0,0 +1,19 @@
+(* TEST
+   flags = "-g"
+   ocamlrunparam += ",b=1"
+   ocamlopt_flags = "-inline 0"
+   exit_status = "2"
+   compare_programs = "false"
+*)
+
+let why : unit -> unit = fun () -> raise Exit [@@inline never]
+let f () =
+  for i = 1 to 10 do
+    why @@ ();
+  done;
+  ignore (3 + 2);
+  () [@@inline never]
+
+let () =
+  Printexc.record_backtrace true;
+  f ()
diff --git a/testsuite/tests/backtrace/pr6920_why_swallow.native.reference b/testsuite/tests/backtrace/pr6920_why_swallow.native.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/backtrace/pr6920_why_swallow.reference b/testsuite/tests/backtrace/pr6920_why_swallow.reference
new file mode 100644
index 00000000..dda5d39d
--- /dev/null
+++ b/testsuite/tests/backtrace/pr6920_why_swallow.reference
@@ -0,0 +1,4 @@
+Fatal error: exception Stdlib.Exit
+Raised at Pr6920_why_swallow.why in file "pr6920_why_swallow.ml", line 9, characters 35-45
+Called from Pr6920_why_swallow.f in file "pr6920_why_swallow.ml", line 12, characters 4-13
+Called from Pr6920_why_swallow in file "pr6920_why_swallow.ml", line 19, characters 2-6
diff --git a/testsuite/tests/backtrace/raw_backtrace.ml b/testsuite/tests/backtrace/raw_backtrace.ml
new file mode 100644
index 00000000..f200c797
--- /dev/null
+++ b/testsuite/tests/backtrace/raw_backtrace.ml
@@ -0,0 +1,64 @@
+(* TEST
+   flags = "-g"
+   ocamlrunparam += ",b=1"
+   compare_programs = "false"
+*)
+
+(* A test for stack backtraces *)
+
+exception Error of string
+
+let rec f msg n =
+  if n = 0 then raise(Error msg) else 1 + f msg (n-1)
+
+exception Localized of exn
+
+let g msg =
+  let exception_raised_internally () =
+    try Hashtbl.find (Hashtbl.create 3) 0
+    with Not_found -> false in
+  try
+    f msg 5
+  with Error "a" -> print_string "a"; print_newline(); 0
+     | Error "b" as exn -> print_string "b"; print_newline(); raise exn
+     | Error "c" -> raise (Error "c")
+     (** [Error "d"] not caught *)
+     | Error "e" as exn ->
+         let bt = Printexc.get_raw_backtrace () in
+         print_string "e"; print_newline ();
+         ignore (exception_raised_internally ());
+         Printexc.raise_with_backtrace exn bt
+     | Error "f" as exn ->
+         let bt = Printexc.get_raw_backtrace () in
+         print_string "f"; print_newline ();
+         Printexc.raise_with_backtrace (Localized exn) bt
+
+let backtrace args =
+  try
+    ignore (g args.(0)); None
+  with exn ->
+    let exn = Printexc.to_string exn in
+    let trace = Printexc.get_raw_backtrace () in
+    Some (exn, trace)
+
+let run args =
+  match backtrace args with
+    | None -> print_string "No exception\n"
+    | Some (exn, trace) ->
+      begin
+        (* raise another exception to stash the global backtrace *)
+        try ignore (f "c" 5); assert false with Error _ -> ();
+      end;
+      Printf.printf "Uncaught exception %s\n" exn;
+      Printexc.print_raw_backtrace stdout trace;
+      flush stdout
+
+let _ =
+  Printexc.record_backtrace true;
+  run [| "a" |];
+  run [| "b" |];
+  run [| "c" |];
+  run [| "d" |];
+  run [| "e" |];
+  run [| "f" |];
+  run [| |]
diff --git a/testsuite/tests/backtrace/raw_backtrace.reference b/testsuite/tests/backtrace/raw_backtrace.reference
new file mode 100644
index 00000000..5416fa72
--- /dev/null
+++ b/testsuite/tests/backtrace/raw_backtrace.reference
@@ -0,0 +1,49 @@
+a
+No exception
+b
+Uncaught exception Raw_backtrace.Error("b")
+Raised at Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 16-32
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.g in file "raw_backtrace.ml", line 21, characters 4-11
+Re-raised at Raw_backtrace.g in file "raw_backtrace.ml", line 23, characters 62-71
+Called from Raw_backtrace.backtrace in file "raw_backtrace.ml", line 38, characters 11-23
+Uncaught exception Raw_backtrace.Error("c")
+Raised at Raw_backtrace.g in file "raw_backtrace.ml", line 24, characters 20-37
+Called from Raw_backtrace.backtrace in file "raw_backtrace.ml", line 38, characters 11-23
+Uncaught exception Raw_backtrace.Error("d")
+Raised at Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 16-32
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.g in file "raw_backtrace.ml", line 21, characters 4-11
+Called from Raw_backtrace.backtrace in file "raw_backtrace.ml", line 38, characters 11-23
+e
+Uncaught exception Raw_backtrace.Error("e")
+Raised at Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 16-32
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.g in file "raw_backtrace.ml", line 21, characters 4-11
+Re-raised at Raw_backtrace.g in file "raw_backtrace.ml", line 30, characters 9-45
+Called from Raw_backtrace.backtrace in file "raw_backtrace.ml", line 38, characters 11-23
+f
+Uncaught exception Raw_backtrace.Localized(_)
+Raised at Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 16-32
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
+Called from Raw_backtrace.g in file "raw_backtrace.ml", line 21, characters 4-11
+Re-raised at Raw_backtrace.g in file "raw_backtrace.ml", line 34, characters 9-57
+Called from Raw_backtrace.backtrace in file "raw_backtrace.ml", line 38, characters 11-23
+Uncaught exception Invalid_argument("index out of bounds")
+Raised by primitive operation at Raw_backtrace.backtrace in file "raw_backtrace.ml", line 38, characters 14-22
diff --git a/testsuite/tests/basic-float/float_compare.ml b/testsuite/tests/basic-float/float_compare.ml
new file mode 100644
index 00000000..1c9faf39
--- /dev/null
+++ b/testsuite/tests/basic-float/float_compare.ml
@@ -0,0 +1,112 @@
+
+let equal (x : float) (y : float) =
+  x, "=", y, (x = y)
+[@@inline never]
+
+let not_equal (x : float) (y : float) =
+  x, "!=", y, (x <> y)
+[@@inline never]
+
+let less_than (x : float) (y : float) =
+  x, "<", y, (x < y)
+[@@inline never]
+
+let not_less_than (x : float) (y : float) =
+  x, "!<", y, not (x < y)
+[@@inline never]
+
+let less_equal (x : float) (y : float) =
+  x, "<=", y, (x <= y)
+[@@inline never]
+
+let not_less_equal (x : float) (y : float) =
+  x, "!<=", y, not (x <= y)
+[@@inline never]
+
+let greater_than (x : float) (y : float) =
+  x, ">", y, (x > y)
+[@@inline never]
+
+let not_greater_than (x : float) (y : float) =
+  x, "!>", y, not (x > y)
+[@@inline never]
+
+let greater_equal (x : float) (y : float) =
+  x, ">=", y, (x >= y)
+[@@inline never]
+
+let not_greater_equal (x : float) (y : float) =
+  x, "!>=", y, not (x >= y)
+[@@inline never]
+
+let show (x, op, y, b) =
+  print_float x;
+  print_string " ";
+  print_string op;
+  print_string " ";
+  print_float y;
+  print_string ": ";
+  print_endline (string_of_bool b)
+
+let print_line () =
+  print_endline "------------------"
+
+let () = show (equal 1.0 2.0)
+let () = show (equal 1.0 1.0)
+let () = show (equal 2.0 1.0)
+let () = show (equal 1.0 nan)
+let () = print_line ()
+
+let () = show (not_equal 1.0 2.0)
+let () = show (not_equal 1.0 1.0)
+let () = show (not_equal 2.0 1.0)
+let () = show (not_equal 1.0 nan)
+let () = print_line ()
+
+let () = show (less_than 1.0 2.0)
+let () = show (less_than 1.0 1.0)
+let () = show (less_than 2.0 1.0)
+let () = show (less_than 1.0 nan)
+let () = print_line ()
+
+let () = show (not_less_than 1.0 2.0)
+let () = show (not_less_than 1.0 1.0)
+let () = show (not_less_than 2.0 1.0)
+let () = show (not_less_than 1.0 nan)
+let () = print_line ()
+
+let () = show (less_equal 1.0 2.0)
+let () = show (less_equal 1.0 1.0)
+let () = show (less_equal 2.0 1.0)
+let () = show (less_equal 1.0 nan)
+let () = print_line ()
+
+let () = show (not_less_equal 1.0 2.0)
+let () = show (not_less_equal 1.0 1.0)
+let () = show (not_less_equal 2.0 1.0)
+let () = show (not_less_equal 1.0 nan)
+let () = print_line ()
+
+let () = show (greater_than 1.0 2.0)
+let () = show (greater_than 1.0 1.0)
+let () = show (greater_than 2.0 1.0)
+let () = show (greater_than 1.0 nan)
+let () = print_line ()
+
+let () = show (not_greater_than 1.0 2.0)
+let () = show (not_greater_than 1.0 1.0)
+let () = show (not_greater_than 2.0 1.0)
+let () = show (not_greater_than 1.0 nan)
+let () = print_line ()
+
+let () = show (greater_equal 1.0 2.0)
+let () = show (greater_equal 1.0 1.0)
+let () = show (greater_equal 2.0 1.0)
+let () = show (greater_equal 1.0 nan)
+let () = print_line ()
+
+let () = show (not_greater_equal 1.0 2.0)
+let () = show (not_greater_equal 1.0 1.0)
+let () = show (not_greater_equal 2.0 1.0)
+let () = show (not_greater_equal 1.0 nan)
+let () = print_line ()
diff --git a/testsuite/tests/basic-float/float_compare.reference b/testsuite/tests/basic-float/float_compare.reference
new file mode 100644
index 00000000..52efc29a
--- /dev/null
+++ b/testsuite/tests/basic-float/float_compare.reference
@@ -0,0 +1,50 @@
+1. = 2.: false
+1. = 1.: true
+2. = 1.: false
+1. = nan: false
+------------------
+1. != 2.: true
+1. != 1.: false
+2. != 1.: true
+1. != nan: true
+------------------
+1. < 2.: true
+1. < 1.: false
+2. < 1.: false
+1. < nan: false
+------------------
+1. !< 2.: false
+1. !< 1.: true
+2. !< 1.: true
+1. !< nan: true
+------------------
+1. <= 2.: true
+1. <= 1.: true
+2. <= 1.: false
+1. <= nan: false
+------------------
+1. !<= 2.: false
+1. !<= 1.: false
+2. !<= 1.: true
+1. !<= nan: true
+------------------
+1. > 2.: false
+1. > 1.: false
+2. > 1.: true
+1. > nan: false
+------------------
+1. !> 2.: true
+1. !> 1.: true
+2. !> 1.: false
+1. !> nan: true
+------------------
+1. >= 2.: false
+1. >= 1.: true
+2. >= 1.: true
+1. >= nan: false
+------------------
+1. !>= 2.: true
+1. !>= 1.: false
+2. !>= 1.: false
+1. !>= nan: true
+------------------
diff --git a/testsuite/tests/basic-float/float_literals.ml b/testsuite/tests/basic-float/float_literals.ml
new file mode 100644
index 00000000..3d1f12ad
--- /dev/null
+++ b/testsuite/tests/basic-float/float_literals.ml
@@ -0,0 +1,285 @@
+(* TEST *)
+
+open Printf
+
+(* By making the field "f" mutable, we prevent the creation of structured
+   constants and force the FP values to be loaded in an FP register,
+   then stored in memory and passed to the "test" function. *)
+
+type t = { mutable f : float }
+
+let test x y =
+  if Int64.bits_of_float x.f <> y then
+    printf "Error: bits_of_float %h <> 0x%Lx\n" x.f y
+[@@inline never]
+
+(* The values tested include
+     - those that are loaded by special x87 instructions on i386:
+         +0.0, -0.0, +1.0, -1.0
+     - those that are loaded by xorpd on amd64:
+         +0.0;
+     - those that are loaded by "fmov immediate" on arm64:
+         see list below
+*)
+let _ =
+  test { f = 0.0 } 0L;
+  test { f = (-0.0) } 0x8000000000000000L;
+  (* The following are the "fmov immediate" of arm64 *)
+  (* They include +1.0 and -1.0 *)
+  test { f = 0x1p-3 } 0x3fc0000000000000L;
+  test { f = 0x1.1p-3 } 0x3fc1000000000000L;
+  test { f = 0x1.2p-3 } 0x3fc2000000000000L;
+  test { f = 0x1.3p-3 } 0x3fc3000000000000L;
+  test { f = 0x1.4p-3 } 0x3fc4000000000000L;
+  test { f = 0x1.5p-3 } 0x3fc5000000000000L;
+  test { f = 0x1.6p-3 } 0x3fc6000000000000L;
+  test { f = 0x1.7p-3 } 0x3fc7000000000000L;
+  test { f = 0x1.8p-3 } 0x3fc8000000000000L;
+  test { f = 0x1.9p-3 } 0x3fc9000000000000L;
+  test { f = 0x1.ap-3 } 0x3fca000000000000L;
+  test { f = 0x1.bp-3 } 0x3fcb000000000000L;
+  test { f = 0x1.cp-3 } 0x3fcc000000000000L;
+  test { f = 0x1.dp-3 } 0x3fcd000000000000L;
+  test { f = 0x1.ep-3 } 0x3fce000000000000L;
+  test { f = 0x1.fp-3 } 0x3fcf000000000000L;
+  test { f = 0x1p-2 } 0x3fd0000000000000L;
+  test { f = 0x1.1p-2 } 0x3fd1000000000000L;
+  test { f = 0x1.2p-2 } 0x3fd2000000000000L;
+  test { f = 0x1.3p-2 } 0x3fd3000000000000L;
+  test { f = 0x1.4p-2 } 0x3fd4000000000000L;
+  test { f = 0x1.5p-2 } 0x3fd5000000000000L;
+  test { f = 0x1.6p-2 } 0x3fd6000000000000L;
+  test { f = 0x1.7p-2 } 0x3fd7000000000000L;
+  test { f = 0x1.8p-2 } 0x3fd8000000000000L;
+  test { f = 0x1.9p-2 } 0x3fd9000000000000L;
+  test { f = 0x1.ap-2 } 0x3fda000000000000L;
+  test { f = 0x1.bp-2 } 0x3fdb000000000000L;
+  test { f = 0x1.cp-2 } 0x3fdc000000000000L;
+  test { f = 0x1.dp-2 } 0x3fdd000000000000L;
+  test { f = 0x1.ep-2 } 0x3fde000000000000L;
+  test { f = 0x1.fp-2 } 0x3fdf000000000000L;
+  test { f = 0x1p-1 } 0x3fe0000000000000L;
+  test { f = 0x1.1p-1 } 0x3fe1000000000000L;
+  test { f = 0x1.2p-1 } 0x3fe2000000000000L;
+  test { f = 0x1.3p-1 } 0x3fe3000000000000L;
+  test { f = 0x1.4p-1 } 0x3fe4000000000000L;
+  test { f = 0x1.5p-1 } 0x3fe5000000000000L;
+  test { f = 0x1.6p-1 } 0x3fe6000000000000L;
+  test { f = 0x1.7p-1 } 0x3fe7000000000000L;
+  test { f = 0x1.8p-1 } 0x3fe8000000000000L;
+  test { f = 0x1.9p-1 } 0x3fe9000000000000L;
+  test { f = 0x1.ap-1 } 0x3fea000000000000L;
+  test { f = 0x1.bp-1 } 0x3feb000000000000L;
+  test { f = 0x1.cp-1 } 0x3fec000000000000L;
+  test { f = 0x1.dp-1 } 0x3fed000000000000L;
+  test { f = 0x1.ep-1 } 0x3fee000000000000L;
+  test { f = 0x1.fp-1 } 0x3fef000000000000L;
+  test { f = 0x1p+0 } 0x3ff0000000000000L;
+  test { f = 0x1.1p+0 } 0x3ff1000000000000L;
+  test { f = 0x1.2p+0 } 0x3ff2000000000000L;
+  test { f = 0x1.3p+0 } 0x3ff3000000000000L;
+  test { f = 0x1.4p+0 } 0x3ff4000000000000L;
+  test { f = 0x1.5p+0 } 0x3ff5000000000000L;
+  test { f = 0x1.6p+0 } 0x3ff6000000000000L;
+  test { f = 0x1.7p+0 } 0x3ff7000000000000L;
+  test { f = 0x1.8p+0 } 0x3ff8000000000000L;
+  test { f = 0x1.9p+0 } 0x3ff9000000000000L;
+  test { f = 0x1.ap+0 } 0x3ffa000000000000L;
+  test { f = 0x1.bp+0 } 0x3ffb000000000000L;
+  test { f = 0x1.cp+0 } 0x3ffc000000000000L;
+  test { f = 0x1.dp+0 } 0x3ffd000000000000L;
+  test { f = 0x1.ep+0 } 0x3ffe000000000000L;
+  test { f = 0x1.fp+0 } 0x3fff000000000000L;
+  test { f = 0x1p+1 } 0x4000000000000000L;
+  test { f = 0x1.1p+1 } 0x4001000000000000L;
+  test { f = 0x1.2p+1 } 0x4002000000000000L;
+  test { f = 0x1.3p+1 } 0x4003000000000000L;
+  test { f = 0x1.4p+1 } 0x4004000000000000L;
+  test { f = 0x1.5p+1 } 0x4005000000000000L;
+  test { f = 0x1.6p+1 } 0x4006000000000000L;
+  test { f = 0x1.7p+1 } 0x4007000000000000L;
+  test { f = 0x1.8p+1 } 0x4008000000000000L;
+  test { f = 0x1.9p+1 } 0x4009000000000000L;
+  test { f = 0x1.ap+1 } 0x400a000000000000L;
+  test { f = 0x1.bp+1 } 0x400b000000000000L;
+  test { f = 0x1.cp+1 } 0x400c000000000000L;
+  test { f = 0x1.dp+1 } 0x400d000000000000L;
+  test { f = 0x1.ep+1 } 0x400e000000000000L;
+  test { f = 0x1.fp+1 } 0x400f000000000000L;
+  test { f = 0x1p+2 } 0x4010000000000000L;
+  test { f = 0x1.1p+2 } 0x4011000000000000L;
+  test { f = 0x1.2p+2 } 0x4012000000000000L;
+  test { f = 0x1.3p+2 } 0x4013000000000000L;
+  test { f = 0x1.4p+2 } 0x4014000000000000L;
+  test { f = 0x1.5p+2 } 0x4015000000000000L;
+  test { f = 0x1.6p+2 } 0x4016000000000000L;
+  test { f = 0x1.7p+2 } 0x4017000000000000L;
+  test { f = 0x1.8p+2 } 0x4018000000000000L;
+  test { f = 0x1.9p+2 } 0x4019000000000000L;
+  test { f = 0x1.ap+2 } 0x401a000000000000L;
+  test { f = 0x1.bp+2 } 0x401b000000000000L;
+  test { f = 0x1.cp+2 } 0x401c000000000000L;
+  test { f = 0x1.dp+2 } 0x401d000000000000L;
+  test { f = 0x1.ep+2 } 0x401e000000000000L;
+  test { f = 0x1.fp+2 } 0x401f000000000000L;
+  test { f = 0x1p+3 } 0x4020000000000000L;
+  test { f = 0x1.1p+3 } 0x4021000000000000L;
+  test { f = 0x1.2p+3 } 0x4022000000000000L;
+  test { f = 0x1.3p+3 } 0x4023000000000000L;
+  test { f = 0x1.4p+3 } 0x4024000000000000L;
+  test { f = 0x1.5p+3 } 0x4025000000000000L;
+  test { f = 0x1.6p+3 } 0x4026000000000000L;
+  test { f = 0x1.7p+3 } 0x4027000000000000L;
+  test { f = 0x1.8p+3 } 0x4028000000000000L;
+  test { f = 0x1.9p+3 } 0x4029000000000000L;
+  test { f = 0x1.ap+3 } 0x402a000000000000L;
+  test { f = 0x1.bp+3 } 0x402b000000000000L;
+  test { f = 0x1.cp+3 } 0x402c000000000000L;
+  test { f = 0x1.dp+3 } 0x402d000000000000L;
+  test { f = 0x1.ep+3 } 0x402e000000000000L;
+  test { f = 0x1.fp+3 } 0x402f000000000000L;
+  test { f = 0x1p+4 } 0x4030000000000000L;
+  test { f = 0x1.1p+4 } 0x4031000000000000L;
+  test { f = 0x1.2p+4 } 0x4032000000000000L;
+  test { f = 0x1.3p+4 } 0x4033000000000000L;
+  test { f = 0x1.4p+4 } 0x4034000000000000L;
+  test { f = 0x1.5p+4 } 0x4035000000000000L;
+  test { f = 0x1.6p+4 } 0x4036000000000000L;
+  test { f = 0x1.7p+4 } 0x4037000000000000L;
+  test { f = 0x1.8p+4 } 0x4038000000000000L;
+  test { f = 0x1.9p+4 } 0x4039000000000000L;
+  test { f = 0x1.ap+4 } 0x403a000000000000L;
+  test { f = 0x1.bp+4 } 0x403b000000000000L;
+  test { f = 0x1.cp+4 } 0x403c000000000000L;
+  test { f = 0x1.dp+4 } 0x403d000000000000L;
+  test { f = 0x1.ep+4 } 0x403e000000000000L;
+  test { f = 0x1.fp+4 } 0x403f000000000000L;
+  test { f = (-0x1p-3) } 0xbfc0000000000000L;
+  test { f = (-0x1.1p-3) } 0xbfc1000000000000L;
+  test { f = (-0x1.2p-3) } 0xbfc2000000000000L;
+  test { f = (-0x1.3p-3) } 0xbfc3000000000000L;
+  test { f = (-0x1.4p-3) } 0xbfc4000000000000L;
+  test { f = (-0x1.5p-3) } 0xbfc5000000000000L;
+  test { f = (-0x1.6p-3) } 0xbfc6000000000000L;
+  test { f = (-0x1.7p-3) } 0xbfc7000000000000L;
+  test { f = (-0x1.8p-3) } 0xbfc8000000000000L;
+  test { f = (-0x1.9p-3) } 0xbfc9000000000000L;
+  test { f = (-0x1.ap-3) } 0xbfca000000000000L;
+  test { f = (-0x1.bp-3) } 0xbfcb000000000000L;
+  test { f = (-0x1.cp-3) } 0xbfcc000000000000L;
+  test { f = (-0x1.dp-3) } 0xbfcd000000000000L;
+  test { f = (-0x1.ep-3) } 0xbfce000000000000L;
+  test { f = (-0x1.fp-3) } 0xbfcf000000000000L;
+  test { f = (-0x1p-2) } 0xbfd0000000000000L;
+  test { f = (-0x1.1p-2) } 0xbfd1000000000000L;
+  test { f = (-0x1.2p-2) } 0xbfd2000000000000L;
+  test { f = (-0x1.3p-2) } 0xbfd3000000000000L;
+  test { f = (-0x1.4p-2) } 0xbfd4000000000000L;
+  test { f = (-0x1.5p-2) } 0xbfd5000000000000L;
+  test { f = (-0x1.6p-2) } 0xbfd6000000000000L;
+  test { f = (-0x1.7p-2) } 0xbfd7000000000000L;
+  test { f = (-0x1.8p-2) } 0xbfd8000000000000L;
+  test { f = (-0x1.9p-2) } 0xbfd9000000000000L;
+  test { f = (-0x1.ap-2) } 0xbfda000000000000L;
+  test { f = (-0x1.bp-2) } 0xbfdb000000000000L;
+  test { f = (-0x1.cp-2) } 0xbfdc000000000000L;
+  test { f = (-0x1.dp-2) } 0xbfdd000000000000L;
+  test { f = (-0x1.ep-2) } 0xbfde000000000000L;
+  test { f = (-0x1.fp-2) } 0xbfdf000000000000L;
+  test { f = (-0x1p-1) } 0xbfe0000000000000L;
+  test { f = (-0x1.1p-1) } 0xbfe1000000000000L;
+  test { f = (-0x1.2p-1) } 0xbfe2000000000000L;
+  test { f = (-0x1.3p-1) } 0xbfe3000000000000L;
+  test { f = (-0x1.4p-1) } 0xbfe4000000000000L;
+  test { f = (-0x1.5p-1) } 0xbfe5000000000000L;
+  test { f = (-0x1.6p-1) } 0xbfe6000000000000L;
+  test { f = (-0x1.7p-1) } 0xbfe7000000000000L;
+  test { f = (-0x1.8p-1) } 0xbfe8000000000000L;
+  test { f = (-0x1.9p-1) } 0xbfe9000000000000L;
+  test { f = (-0x1.ap-1) } 0xbfea000000000000L;
+  test { f = (-0x1.bp-1) } 0xbfeb000000000000L;
+  test { f = (-0x1.cp-1) } 0xbfec000000000000L;
+  test { f = (-0x1.dp-1) } 0xbfed000000000000L;
+  test { f = (-0x1.ep-1) } 0xbfee000000000000L;
+  test { f = (-0x1.fp-1) } 0xbfef000000000000L;
+  test { f = (-0x1p+0) } 0xbff0000000000000L;
+  test { f = (-0x1.1p+0) } 0xbff1000000000000L;
+  test { f = (-0x1.2p+0) } 0xbff2000000000000L;
+  test { f = (-0x1.3p+0) } 0xbff3000000000000L;
+  test { f = (-0x1.4p+0) } 0xbff4000000000000L;
+  test { f = (-0x1.5p+0) } 0xbff5000000000000L;
+  test { f = (-0x1.6p+0) } 0xbff6000000000000L;
+  test { f = (-0x1.7p+0) } 0xbff7000000000000L;
+  test { f = (-0x1.8p+0) } 0xbff8000000000000L;
+  test { f = (-0x1.9p+0) } 0xbff9000000000000L;
+  test { f = (-0x1.ap+0) } 0xbffa000000000000L;
+  test { f = (-0x1.bp+0) } 0xbffb000000000000L;
+  test { f = (-0x1.cp+0) } 0xbffc000000000000L;
+  test { f = (-0x1.dp+0) } 0xbffd000000000000L;
+  test { f = (-0x1.ep+0) } 0xbffe000000000000L;
+  test { f = (-0x1.fp+0) } 0xbfff000000000000L;
+  test { f = (-0x1p+1) } 0xc000000000000000L;
+  test { f = (-0x1.1p+1) } 0xc001000000000000L;
+  test { f = (-0x1.2p+1) } 0xc002000000000000L;
+  test { f = (-0x1.3p+1) } 0xc003000000000000L;
+  test { f = (-0x1.4p+1) } 0xc004000000000000L;
+  test { f = (-0x1.5p+1) } 0xc005000000000000L;
+  test { f = (-0x1.6p+1) } 0xc006000000000000L;
+  test { f = (-0x1.7p+1) } 0xc007000000000000L;
+  test { f = (-0x1.8p+1) } 0xc008000000000000L;
+  test { f = (-0x1.9p+1) } 0xc009000000000000L;
+  test { f = (-0x1.ap+1) } 0xc00a000000000000L;
+  test { f = (-0x1.bp+1) } 0xc00b000000000000L;
+  test { f = (-0x1.cp+1) } 0xc00c000000000000L;
+  test { f = (-0x1.dp+1) } 0xc00d000000000000L;
+  test { f = (-0x1.ep+1) } 0xc00e000000000000L;
+  test { f = (-0x1.fp+1) } 0xc00f000000000000L;
+  test { f = (-0x1p+2) } 0xc010000000000000L;
+  test { f = (-0x1.1p+2) } 0xc011000000000000L;
+  test { f = (-0x1.2p+2) } 0xc012000000000000L;
+  test { f = (-0x1.3p+2) } 0xc013000000000000L;
+  test { f = (-0x1.4p+2) } 0xc014000000000000L;
+  test { f = (-0x1.5p+2) } 0xc015000000000000L;
+  test { f = (-0x1.6p+2) } 0xc016000000000000L;
+  test { f = (-0x1.7p+2) } 0xc017000000000000L;
+  test { f = (-0x1.8p+2) } 0xc018000000000000L;
+  test { f = (-0x1.9p+2) } 0xc019000000000000L;
+  test { f = (-0x1.ap+2) } 0xc01a000000000000L;
+  test { f = (-0x1.bp+2) } 0xc01b000000000000L;
+  test { f = (-0x1.cp+2) } 0xc01c000000000000L;
+  test { f = (-0x1.dp+2) } 0xc01d000000000000L;
+  test { f = (-0x1.ep+2) } 0xc01e000000000000L;
+  test { f = (-0x1.fp+2) } 0xc01f000000000000L;
+  test { f = (-0x1p+3) } 0xc020000000000000L;
+  test { f = (-0x1.1p+3) } 0xc021000000000000L;
+  test { f = (-0x1.2p+3) } 0xc022000000000000L;
+  test { f = (-0x1.3p+3) } 0xc023000000000000L;
+  test { f = (-0x1.4p+3) } 0xc024000000000000L;
+  test { f = (-0x1.5p+3) } 0xc025000000000000L;
+  test { f = (-0x1.6p+3) } 0xc026000000000000L;
+  test { f = (-0x1.7p+3) } 0xc027000000000000L;
+  test { f = (-0x1.8p+3) } 0xc028000000000000L;
+  test { f = (-0x1.9p+3) } 0xc029000000000000L;
+  test { f = (-0x1.ap+3) } 0xc02a000000000000L;
+  test { f = (-0x1.bp+3) } 0xc02b000000000000L;
+  test { f = (-0x1.cp+3) } 0xc02c000000000000L;
+  test { f = (-0x1.dp+3) } 0xc02d000000000000L;
+  test { f = (-0x1.ep+3) } 0xc02e000000000000L;
+  test { f = (-0x1.fp+3) } 0xc02f000000000000L;
+  test { f = (-0x1p+4) } 0xc030000000000000L;
+  test { f = (-0x1.1p+4) } 0xc031000000000000L;
+  test { f = (-0x1.2p+4) } 0xc032000000000000L;
+  test { f = (-0x1.3p+4) } 0xc033000000000000L;
+  test { f = (-0x1.4p+4) } 0xc034000000000000L;
+  test { f = (-0x1.5p+4) } 0xc035000000000000L;
+  test { f = (-0x1.6p+4) } 0xc036000000000000L;
+  test { f = (-0x1.7p+4) } 0xc037000000000000L;
+  test { f = (-0x1.8p+4) } 0xc038000000000000L;
+  test { f = (-0x1.9p+4) } 0xc039000000000000L;
+  test { f = (-0x1.ap+4) } 0xc03a000000000000L;
+  test { f = (-0x1.bp+4) } 0xc03b000000000000L;
+  test { f = (-0x1.cp+4) } 0xc03c000000000000L;
+  test { f = (-0x1.dp+4) } 0xc03d000000000000L;
+  test { f = (-0x1.ep+4) } 0xc03e000000000000L;
+  test { f = (-0x1.fp+4) } 0xc03f000000000000L;
+  ()
diff --git a/testsuite/tests/basic-float/tfloat_hex.ml b/testsuite/tests/basic-float/tfloat_hex.ml
new file mode 100644
index 00000000..3fee64cd
--- /dev/null
+++ b/testsuite/tests/basic-float/tfloat_hex.ml
@@ -0,0 +1,56 @@
+(* TEST *)
+
+let try_float_of_string str =
+  try
+    print_float (float_of_string str);
+    print_newline ()
+  with exn ->
+    print_endline (Printexc.to_string exn)
+;;
+
+let () =
+  try_float_of_string "0x1A";
+  try_float_of_string "0x1Ap3";
+  try_float_of_string "0x";
+  try_float_of_string "0x.";
+  try_float_of_string "0xp0";
+  try_float_of_string "0x.p0";
+
+  (* MPR#7690 *)
+  try_float_of_string "0x1.0p-2147483648";
+  try_float_of_string "0x123456789ABCDEF0p2147483647";
+  try_float_of_string "0x1p2147483648";
+
+  (* Allow underscore almost everywhere *)
+  try_float_of_string "_0x1.1";
+  try_float_of_string "0_x1.1";
+  try_float_of_string "0x_1.1";
+  try_float_of_string "0x1_.1";
+  try_float_of_string "0x1._";
+  try_float_of_string "0x1.1_";
+  try_float_of_string "0x1_p1";
+  try_float_of_string "0x1p_1";
+  try_float_of_string "0x1p1_";
+  try_float_of_string "0x1p-1_1";
+  try_float_of_string "0x1p-1_";
+  try_float_of_string "0x1p+1_1";
+  try_float_of_string "0x1p+1_";
+
+  try_float_of_string "0x1p1\000suffix"
+
+let () =
+  (* check that the compiler can also parse tokens *)
+  let _ = 0x1A in
+  let _ = 0x1Ap3 in
+
+  let _ = 0x1.0p-2147483648 in
+  let _ = 0x123456789ABCDEF0p2147483647 in
+  let _ = 0x1p2147483648 in
+
+  let _ = 0x1_._1p1_1 in
+  let _ = 0x1_._1p1_ in
+  let _ = 0x1_._1p-1_1 in
+  let _ = 0x1_._1p-1_ in
+  let _ = 0x1_._1p+1_1 in
+  let _ = 0x1_._1p+1_ in
+  ()
diff --git a/testsuite/tests/basic-float/tfloat_hex.reference b/testsuite/tests/basic-float/tfloat_hex.reference
new file mode 100644
index 00000000..3d4c6e6f
--- /dev/null
+++ b/testsuite/tests/basic-float/tfloat_hex.reference
@@ -0,0 +1,23 @@
+26.
+208.
+Failure("float_of_string")
+Failure("float_of_string")
+Failure("float_of_string")
+Failure("float_of_string")
+0.
+inf
+inf
+1.0625
+1.0625
+1.0625
+1.0625
+1.
+1.0625
+2.
+2.
+2.
+0.00048828125
+0.5
+2048.
+2.
+Failure("float_of_string")
diff --git a/testsuite/tests/basic-float/tfloat_record.ml b/testsuite/tests/basic-float/tfloat_record.ml
new file mode 100644
index 00000000..a0d2e2c7
--- /dev/null
+++ b/testsuite/tests/basic-float/tfloat_record.ml
@@ -0,0 +1,48 @@
+(* TEST *)
+
+module Float_record : sig
+  type t = private float;;
+
+  val make : float -> t;;
+  val from : t -> float;;
+
+  type s = {f : t};;
+end = struct
+  type t = float;;
+
+  let make f = f;;
+
+  let from t = t;;
+
+  type s = {f : t};;
+end
+
+module Float_array = struct
+  let small_float_array x =
+    [|1.;2.;3.|], x
+
+  let longer_float_array x =
+    [|1.;2.;3.;4.;5.;6.;7.;8.;9.;0.;
+      1.;2.;3.;4.;5.;6.;7.;8.;9.;0.;
+      1.;2.;3.;4.;5.;6.;7.;8.;9.;0.;
+      1.;2.;3.;4.;5.;6.;7.;8.;9.;0.;|], x
+end
+
+let s = { Float_record.f = Float_record.make 1.0 };;
+
+print_float (Float_record.from s.Float_record.f);;
+print_newline ();;
+
+
+let b = Float_array.small_float_array 12
+let c = (Float_array.longer_float_array [@inlined]) 34
+
+let print_array a =
+  Array.iter (fun f ->
+      print_float f;
+      print_newline ()) a;
+  print_newline ()
+
+let () =
+  print_array (fst b);
+  print_array (fst c);
diff --git a/testsuite/tests/basic-float/tfloat_record.reference b/testsuite/tests/basic-float/tfloat_record.reference
new file mode 100644
index 00000000..b0ed5f4e
--- /dev/null
+++ b/testsuite/tests/basic-float/tfloat_record.reference
@@ -0,0 +1,46 @@
+1.
+1.
+2.
+3.
+
+1.
+2.
+3.
+4.
+5.
+6.
+7.
+8.
+9.
+0.
+1.
+2.
+3.
+4.
+5.
+6.
+7.
+8.
+9.
+0.
+1.
+2.
+3.
+4.
+5.
+6.
+7.
+8.
+9.
+0.
+1.
+2.
+3.
+4.
+5.
+6.
+7.
+8.
+9.
+0.
+
diff --git a/testsuite/tests/basic-float/zero_sized_float_arrays.ml b/testsuite/tests/basic-float/zero_sized_float_arrays.ml
new file mode 100644
index 00000000..51657d3e
--- /dev/null
+++ b/testsuite/tests/basic-float/zero_sized_float_arrays.ml
@@ -0,0 +1,17 @@
+(* TEST *)
+
+let non_float_array : int array = [| |]
+
+let float_array : float array = [| |]
+
+let non_float_array_from_runtime : int array =
+  Array.make 0 0
+
+let float_array_from_runtime : float array =
+  Array.make 0 0.0
+
+let () =
+  assert (Stdlib.compare non_float_array non_float_array_from_runtime = 0);
+  assert (Stdlib.compare non_float_array non_float_array_from_runtime = 0);
+  assert (Stdlib.compare float_array float_array_from_runtime = 0);
+  assert (Stdlib.compare float_array float_array_from_runtime = 0)
diff --git a/testsuite/tests/basic-float/zero_sized_float_arrays.reference b/testsuite/tests/basic-float/zero_sized_float_arrays.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/basic-io-2/io.ml b/testsuite/tests/basic-io-2/io.ml
new file mode 100644
index 00000000..c6d3e535
--- /dev/null
+++ b/testsuite/tests/basic-io-2/io.ml
@@ -0,0 +1,108 @@
+(* TEST
+  arguments = "io.ml"
+  files = "test-file-short-lines"
+*)
+
+(* Test a file copy function *)
+
+let test msg funct f1 f2 =
+  print_string msg; print_newline();
+  funct f1 f2;
+  if Sys.command ("cmp " ^ f1 ^ " " ^ f2) = 0
+  then print_string "passed"
+  else print_string "FAILED";
+  print_newline()
+
+(* File copy with constant-sized chunks *)
+
+let copy_file sz infile ofile =
+  let ic = open_in_bin infile in
+  let oc = open_out_bin ofile in
+  let buffer = Bytes.create sz in
+  let rec copy () =
+    let n = input ic buffer 0 sz in
+    if n = 0 then () else begin
+      output oc buffer 0 n;
+      copy ()
+    end in
+  copy();
+  close_in ic;
+  close_out oc
+
+(* File copy with random-sized chunks *)
+
+let copy_random sz infile ofile =
+  let ic = open_in_bin infile in
+  let oc = open_out_bin ofile in
+  let buffer = Bytes.create sz in
+  let rec copy () =
+    let s = 1 + Random.int sz in
+    let n = input ic buffer 0 s in
+    if n = 0 then () else begin
+      output oc buffer 0 n;
+      copy ()
+    end in
+  copy();
+  close_in ic;
+  close_out oc
+
+(* File copy line per line *)
+
+let copy_line infile ofile =
+  let ic = open_in_bin infile in
+  let oc = open_out_bin ofile in
+  try
+    while true do
+      output_string oc (input_line ic); output_char oc '\n'
+    done
+  with End_of_file ->
+    close_in ic;
+    close_out oc
+
+(* Backward copy, with lots of seeks *)
+
+let copy_seek chunksize infile ofile =
+  let ic = open_in_bin infile in
+  let oc = open_out_bin ofile in
+  let size = in_channel_length ic in
+  let buffer = Bytes.create chunksize in
+  for i = (size - 1) / chunksize downto 0 do
+    seek_in ic (i * chunksize);
+    seek_out oc (i * chunksize);
+    let n = input ic buffer 0 chunksize in
+    output oc buffer 0 n
+  done;
+  close_in ic;
+  close_out oc
+
+(* Create long lines of text *)
+
+let make_lines ofile =
+  let oc = open_out_bin ofile in
+  for i = 1 to 256 do
+    output_string oc (String.make (i*64) '.'); output_char oc '\n'
+  done;
+  close_out oc
+
+(* The test *)
+
+let _ =
+  let src = Sys.argv.(1) in
+  let testio = Filename.temp_file "testio" "" in
+  let lines = Filename.temp_file "lines" "" in
+  test "16-byte chunks" (copy_file 16) src testio;
+  test "256-byte chunks" (copy_file 256) src testio;
+  test "4096-byte chunks" (copy_file 4096) src testio;
+  test "65536-byte chunks" (copy_file 65536) src testio;
+  test "19-byte chunks" (copy_file 19) src testio;
+  test "263-byte chunks" (copy_file 263) src testio;
+  test "4011-byte chunks" (copy_file 4011) src testio;
+  test "0...8192 byte chunks" (copy_random 8192) src testio;
+  test "line per line, short lines" copy_line "test-file-short-lines" testio;
+  make_lines lines;
+  test "line per line, short and long lines" copy_line lines testio;
+  test "backwards, 4096-byte chunks" (copy_seek 4096) src testio;
+  test "backwards, 64-byte chunks" (copy_seek 64) src testio;
+  Sys.remove lines;
+  Sys.remove testio;
+  exit 0
diff --git a/testsuite/tests/basic-io-2/io.reference b/testsuite/tests/basic-io-2/io.reference
new file mode 100644
index 00000000..06740020
--- /dev/null
+++ b/testsuite/tests/basic-io-2/io.reference
@@ -0,0 +1,24 @@
+16-byte chunks
+passed
+256-byte chunks
+passed
+4096-byte chunks
+passed
+65536-byte chunks
+passed
+19-byte chunks
+passed
+263-byte chunks
+passed
+4011-byte chunks
+passed
+0...8192 byte chunks
+passed
+line per line, short lines
+passed
+line per line, short and long lines
+passed
+backwards, 4096-byte chunks
+passed
+backwards, 64-byte chunks
+passed
diff --git a/testsuite/tests/basic-io-2/test-file-short-lines b/testsuite/tests/basic-io-2/test-file-short-lines
new file mode 100644
index 00000000..979aa0a2
--- /dev/null
+++ b/testsuite/tests/basic-io-2/test-file-short-lines
@@ -0,0 +1,10 @@
+##
+# Host Database
+#
+# localhost is used to configure the loopback interface
+# when the system is booting.  Do not change this entry.
+##
+127.0.0.1       localhost
+255.255.255.255 broadcasthost
+::1             localhost
+fe80::1%lo0     localhost
diff --git a/testsuite/tests/basic-io/wc.ml b/testsuite/tests/basic-io/wc.ml
new file mode 100644
index 00000000..33e79115
--- /dev/null
+++ b/testsuite/tests/basic-io/wc.ml
@@ -0,0 +1,58 @@
+(* TEST
+  arguments = "wc.ml"
+*)
+
+(* Counts characters, lines and words in one or several files. *)
+
+let chars = ref 0
+and words = ref 0
+and lines = ref 0
+
+type state = Inside_word | Outside_word
+
+let count_channel in_channel =
+  let rec count status =
+    let c = input_char in_channel in
+    incr chars;
+    match c with
+      '\n' ->
+        incr lines; count Outside_word
+    | ' ' | '\t' ->
+        count Outside_word
+    | _ ->
+        if status = Outside_word then begin incr words; () end;
+        count Inside_word
+  in
+    try
+      count Outside_word
+    with End_of_file ->
+      ()
+
+let count_file name =
+  let ic = open_in name in
+  count_channel ic;
+  close_in ic
+
+let print_result () =
+  print_int !chars; print_string " characters, ";
+  print_int !words; print_string " words, ";
+  print_int !lines; print_string " lines";
+  print_newline()
+
+let count name =
+  count_file name;
+  print_result ()
+
+let _ =
+try
+  if Array.length Sys.argv <= 1 then
+    count_channel stdin                (* No command-line arguments *)
+  else
+    for i = 1 to Array.length Sys.argv - 1 do
+      count_file  Sys.argv.(i)
+    done;
+  print_result ()
+with Sys_error s ->
+  print_string "I/O error: ";
+  print_string s;
+  print_newline()
diff --git a/testsuite/tests/basic-io/wc.reference b/testsuite/tests/basic-io/wc.reference
new file mode 100644
index 00000000..3c812841
--- /dev/null
+++ b/testsuite/tests/basic-io/wc.reference
@@ -0,0 +1 @@
+1232 characters, 184 words, 58 lines
diff --git a/testsuite/tests/basic-manyargs/manyargs.ml b/testsuite/tests/basic-manyargs/manyargs.ml
new file mode 100644
index 00000000..53d3a595
--- /dev/null
+++ b/testsuite/tests/basic-manyargs/manyargs.ml
@@ -0,0 +1,49 @@
+(* TEST
+   modules = "manyargsprim.c"
+*)
+
+let manyargs a b c d e f g h i j k l m n o =
+  print_string "a = "; print_int a; print_newline();
+  print_string "b = "; print_int b; print_newline();
+  print_string "c = "; print_int c; print_newline();
+  print_string "d = "; print_int d; print_newline();
+  print_string "e = "; print_int e; print_newline();
+  print_string "f = "; print_int f; print_newline();
+  print_string "g = "; print_int g; print_newline();
+  print_string "h = "; print_int h; print_newline();
+  print_string "i = "; print_int i; print_newline();
+  print_string "j = "; print_int j; print_newline();
+  print_string "k = "; print_int k; print_newline();
+  print_string "l = "; print_int l; print_newline();
+  print_string "m = "; print_int m; print_newline();
+  print_string "n = "; print_int n; print_newline();
+  print_string "o = "; print_int o; print_newline();
+  print_string "---"; print_newline()
+
+let manyargs_tail1 a b c d e f g h i j k l m n o =
+  print_string "tail1:\n";
+  manyargs a b c d e f g h i j k l m n o
+
+let manyargs_tail2 a b =
+  print_string "tail2:\n";
+  manyargs a b a b a b a b a b a b a b a
+
+let manyargs_tail3 a b c d e f g h i j k l m n o =
+  print_string "tail3:\n";
+  print_string "o = "; print_int o; print_newline();
+  print_string "---"; print_newline()
+
+let _ =
+  manyargs 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15;
+  manyargs_tail1 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15;
+  manyargs_tail2 0 1;
+  manyargs_tail3 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+
+external manyargs_ext:
+  int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> int ->
+    int
+  = "manyargs_argv" "manyargs"
+
+let _ =
+  print_string "external:\n"; flush stdout;
+  manyargs_ext 1 2 3 4 5 6 7 8 9 10 11
diff --git a/testsuite/tests/basic-manyargs/manyargs.reference b/testsuite/tests/basic-manyargs/manyargs.reference
new file mode 100644
index 00000000..24e9d3df
--- /dev/null
+++ b/testsuite/tests/basic-manyargs/manyargs.reference
@@ -0,0 +1,65 @@
+a = 1
+b = 2
+c = 3
+d = 4
+e = 5
+f = 6
+g = 7
+h = 8
+i = 9
+j = 10
+k = 11
+l = 12
+m = 13
+n = 14
+o = 15
+---
+tail1:
+a = 1
+b = 2
+c = 3
+d = 4
+e = 5
+f = 6
+g = 7
+h = 8
+i = 9
+j = 10
+k = 11
+l = 12
+m = 13
+n = 14
+o = 15
+---
+tail2:
+a = 0
+b = 1
+c = 0
+d = 1
+e = 0
+f = 1
+g = 0
+h = 1
+i = 0
+j = 1
+k = 0
+l = 1
+m = 0
+n = 1
+o = 0
+---
+tail3:
+o = 15
+---
+external:
+a = 1
+b = 2
+c = 3
+d = 4
+e = 5
+f = 6
+g = 7
+h = 8
+i = 9
+j = 10
+k = 11
diff --git a/testsuite/tests/basic-manyargs/manyargsprim.c b/testsuite/tests/basic-manyargs/manyargsprim.c
new file mode 100644
index 00000000..b8b44d87
--- /dev/null
+++ b/testsuite/tests/basic-manyargs/manyargsprim.c
@@ -0,0 +1,40 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 1995 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#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)
+{
+  printf("a = %d\n", Int_val(a));
+  printf("b = %d\n", Int_val(b));
+  printf("c = %d\n", Int_val(c));
+  printf("d = %d\n", Int_val(d));
+  printf("e = %d\n", Int_val(e));
+  printf("f = %d\n", Int_val(f));
+  printf("g = %d\n", Int_val(g));
+  printf("h = %d\n", Int_val(h));
+  printf("i = %d\n", Int_val(i));
+  printf("j = %d\n", Int_val(j));
+  printf("k = %d\n", Int_val(k));
+  return Val_unit;
+}
+
+value manyargs_argv(value *argv, int argc)
+{
+  return manyargs(argv[0], argv[1], argv[2], argv[3], argv[4],
+                  argv[5], argv[6], argv[7], argv[8], argv[9], argv[10]);
+}
diff --git a/testsuite/tests/basic-modules/anonymous.ml b/testsuite/tests/basic-modules/anonymous.ml
new file mode 100644
index 00000000..20e67cca
--- /dev/null
+++ b/testsuite/tests/basic-modules/anonymous.ml
@@ -0,0 +1,55 @@
+(* TEST
+flags = "-c -nostdlib -nopervasives -dlambda -dno-unique-ids"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+compiler_reference = "${test_source_directory}/anonymous.ocamlc.reference"
+
+* setup-ocamlopt.byte-build-env
+** ocamlopt.byte
+*** no-flambda
+**** check-ocamlopt.byte-output
+compiler_reference = "${test_source_directory}/anonymous.ocamlopt.reference"
+*** flambda
+**** check-ocamlc.byte-output
+compiler_reference =
+   "${test_source_directory}/anonymous.ocamlopt.flambda.reference"
+*)
+
+module _ = struct
+  let x = 13, 37
+end
+
+module rec A : sig
+  type t = B.t
+end = A
+and _ : sig
+  type t = A.t
+  val x : int * int
+end = struct
+  type t = B.t
+  let x = 4, 2
+end
+and B : sig
+  type t
+end = struct
+  type t
+
+  let x = "foo", "bar"
+end
+
+module type S
+
+let f (module _ : S) = ()
+
+type re = { mutable cell : string; }
+
+let s = { cell = "" }
+
+module _ = struct
+ let () = s.cell <- "Hello World!"
+end
+
+let drop _ = ()
+
+let () = drop s.cell
diff --git a/testsuite/tests/basic-modules/anonymous.ocamlc.reference b/testsuite/tests/basic-modules/anonymous.ocamlc.reference
new file mode 100644
index 00000000..aba92cbd
--- /dev/null
+++ b/testsuite/tests/basic-modules/anonymous.ocamlc.reference
@@ -0,0 +1,23 @@
+(setglobal Anonymous!
+  (seq (ignore (let (x = [0: 13 37]) (makeblock 0 x)))
+    (let
+      (A =
+         (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 25 6]
+           [0: [0]])
+       B =
+         (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 35 6]
+           [0: [0]]))
+      (seq (ignore (let (x = [0: 4 2]) (makeblock 0 x)))
+        (apply (field 1 (global CamlinternalMod!)) [0: [0]] A
+          (module-defn(A) Anonymous anonymous.ml(23):567-608 A))
+        (apply (field 1 (global CamlinternalMod!)) [0: [0]] B
+          (module-defn(B) Anonymous anonymous.ml(33):703-773
+            (let (x = [0: "foo" "bar"]) (makeblock 0))))
+        (let (f = (function param 0a) s = (makemutable 0 ""))
+          (seq
+            (ignore
+              (let (*match* = (setfield_ptr 0 s "Hello World!"))
+                (makeblock 0)))
+            (let
+              (drop = (function param 0a) *match* = (apply drop (field 0 s)))
+              (makeblock 0 A B f s drop))))))))
diff --git a/testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference b/testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference
new file mode 100644
index 00000000..6f9a7cba
--- /dev/null
+++ b/testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference
@@ -0,0 +1,21 @@
+(seq (ignore (let (x = [0: 13 37]) (makeblock 0 x)))
+  (let
+    (A =
+       (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 25 6]
+         [0: [0]])
+     B =
+       (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 35 6]
+         [0: [0]]))
+    (seq (ignore (let (x = [0: 4 2]) (makeblock 0 x)))
+      (apply (field 1 (global CamlinternalMod!)) [0: [0]] A
+        (module-defn(A) Anonymous anonymous.ml(23):567-608 A))
+      (apply (field 1 (global CamlinternalMod!)) [0: [0]] B
+        (module-defn(B) Anonymous anonymous.ml(33):703-773
+          (let (x = [0: "foo" "bar"]) (makeblock 0))))
+      (let (f = (function param 0a) s = (makemutable 0 ""))
+        (seq
+          (ignore
+            (let (*match* = (setfield_ptr 0 s "Hello World!")) (makeblock 0)))
+          (let
+            (drop = (function param 0a) *match* = (apply drop (field 0 s)))
+            (makeblock 0 A B f s drop)))))))
diff --git a/testsuite/tests/basic-modules/anonymous.ocamlopt.reference b/testsuite/tests/basic-modules/anonymous.ocamlopt.reference
new file mode 100644
index 00000000..6d29841f
--- /dev/null
+++ b/testsuite/tests/basic-modules/anonymous.ocamlopt.reference
@@ -0,0 +1,31 @@
+(seq (ignore (let (x = [0: 13 37]) (makeblock 0 x)))
+  (let
+    (A =
+       (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 25 6]
+         [0: [0]])
+     B =
+       (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 35 6]
+         [0: [0]]))
+    (seq (ignore (let (x = [0: 4 2]) (makeblock 0 x)))
+      (apply (field 1 (global CamlinternalMod!)) [0: [0]] A A)
+      (apply (field 1 (global CamlinternalMod!)) [0: [0]] B
+        (let (x = [0: "foo" "bar"]) (makeblock 0)))
+      (setfield_ptr(root-init) 0 (global Anonymous!) A)
+      (setfield_ptr(root-init) 1 (global Anonymous!) B)
+      (let (f = (function param 0a))
+        (setfield_ptr(root-init) 2 (global Anonymous!) f))
+      (let (s = (makemutable 0 ""))
+        (setfield_ptr(root-init) 3 (global Anonymous!) s))
+      (ignore
+        (let
+          (*match* =
+             (setfield_ptr 0 (field 3 (global Anonymous!)) "Hello World!"))
+          (makeblock 0)))
+      (let (drop = (function param 0a))
+        (setfield_ptr(root-init) 4 (global Anonymous!) drop))
+      (let
+        (*match* =
+           (apply (field 4 (global Anonymous!))
+             (field 0 (field 3 (global Anonymous!)))))
+        0a)
+      0a)))
diff --git a/testsuite/tests/basic-modules/main.ml b/testsuite/tests/basic-modules/main.ml
new file mode 100644
index 00000000..bd6d4ff3
--- /dev/null
+++ b/testsuite/tests/basic-modules/main.ml
@@ -0,0 +1,27 @@
+(* TEST
+  modules = "offset.ml pr6726.ml pr7427.ml pr4008.ml"
+*)
+
+(* PR#6435 *)
+
+module F (M : sig
+           type t
+           module Set : Set.S with type elt = t
+         end) =
+struct
+ let test set = Printf.printf "%d\n" (M.Set.cardinal set)
+end
+
+module M = F (Offset)
+
+let () = M.test (Offset.M.Set.singleton "42")
+let v = Pr6726.Test.v
+let v = Pr4008.v
+
+(* PR#7427 *)
+
+let () =
+  try
+    let module M = Pr7427.F () in
+    failwith "Test failed"
+  with Assert_failure _ -> ()
diff --git a/testsuite/tests/basic-modules/main.mli b/testsuite/tests/basic-modules/main.mli
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/basic-modules/main.reference b/testsuite/tests/basic-modules/main.reference
new file mode 100644
index 00000000..d00491fd
--- /dev/null
+++ b/testsuite/tests/basic-modules/main.reference
@@ -0,0 +1 @@
+1
diff --git a/testsuite/tests/basic-modules/offset.ml b/testsuite/tests/basic-modules/offset.ml
new file mode 100644
index 00000000..457947dc
--- /dev/null
+++ b/testsuite/tests/basic-modules/offset.ml
@@ -0,0 +1,10 @@
+module M = struct
+ type t = string
+
+ let x = 0
+ let x = 1
+
+ module Set = Set.Make(String)
+end
+
+include M
diff --git a/testsuite/tests/basic-modules/pr4008.ml b/testsuite/tests/basic-modules/pr4008.ml
new file mode 100644
index 00000000..bb0df2d5
--- /dev/null
+++ b/testsuite/tests/basic-modules/pr4008.ml
@@ -0,0 +1,6 @@
+module rec M : sig
+  val f : int list -> int list
+end = struct
+  let f = List.map succ
+end
+let v = M.f []
diff --git a/testsuite/tests/basic-modules/pr6726.ml b/testsuite/tests/basic-modules/pr6726.ml
new file mode 100644
index 00000000..7b503501
--- /dev/null
+++ b/testsuite/tests/basic-modules/pr6726.ml
@@ -0,0 +1,18 @@
+module ExtUnixAll = struct
+ external unused : unit -> unit = "caml_blit_string"
+ module BigEndian = struct
+   let get_uint8 str off = 33
+ end
+end
+
+module ExtUnix = struct
+ module All = ExtUnixAll
+end
+
+module Test = struct
+ open ExtUnix.All
+ let test_endian_string x =
+   let module B = BigEndian in
+   B.get_uint8 x 0
+ let v = test_endian_string 1
+end
diff --git a/testsuite/tests/basic-modules/pr7427.ml b/testsuite/tests/basic-modules/pr7427.ml
new file mode 100644
index 00000000..bb00ce93
--- /dev/null
+++ b/testsuite/tests/basic-modules/pr7427.ml
@@ -0,0 +1,7 @@
+module F() = struct
+  module M = struct
+    let aaa = assert false
+    let bbb () = assert false
+  end
+  let ccc () = M.bbb ()
+end
diff --git a/testsuite/tests/basic-modules/recursive_module_evaluation_errors.ml b/testsuite/tests/basic-modules/recursive_module_evaluation_errors.ml
new file mode 100644
index 00000000..1eb63ef1
--- /dev/null
+++ b/testsuite/tests/basic-modules/recursive_module_evaluation_errors.ml
@@ -0,0 +1,119 @@
+(* TEST
+   * expect
+*)
+
+module rec A: sig val x: int end = struct let x = B.x end
+and B:sig val x: int end = struct let x = E.y end
+and C:sig val x: int end = struct let x = B.x end
+and D:sig val x: int end = struct let x = C.x end
+and E:sig val x: int val y:int end = struct let x = D.x let y = 0 end
+[%%expect {|
+Line 2, characters 27-49:
+2 | and B:sig val x: int end = struct let x = E.y end
+                               ^^^^^^^^^^^^^^^^^^^^^^
+Error: Cannot safely evaluate the definition of the following cycle
+       of recursively-defined modules: B -> E -> D -> C -> B.
+       There are no safe modules in this cycle (see manual section 8.2).
+Line 2, characters 10-20:
+2 | and B:sig val x: int end = struct let x = E.y end
+              ^^^^^^^^^^
+  Module B defines an unsafe value, x .
+Line 5, characters 10-20:
+5 | and E:sig val x: int val y:int end = struct let x = D.x let y = 0 end
+              ^^^^^^^^^^
+  Module E defines an unsafe value, x .
+Line 4, characters 10-20:
+4 | and D:sig val x: int end = struct let x = C.x end
+              ^^^^^^^^^^
+  Module D defines an unsafe value, x .
+Line 3, characters 10-20:
+3 | and C:sig val x: int end = struct let x = B.x end
+              ^^^^^^^^^^
+  Module C defines an unsafe value, x .
+|}]
+
+type t = ..
+module rec A: sig type t += A end = struct type t += A = B.A end
+and B:sig type t += A end = struct type t += A = A.A end
+[%%expect {|
+type t = ..
+Line 2, characters 36-64:
+2 | module rec A: sig type t += A end = struct type t += A = B.A end
+                                        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Cannot safely evaluate the definition of the following cycle
+       of recursively-defined modules: A -> B -> A.
+       There are no safe modules in this cycle (see manual section 8.2).
+Line 2, characters 28-29:
+2 | module rec A: sig type t += A end = struct type t += A = B.A end
+                                ^
+  Module A defines an unsafe extension constructor, A .
+Line 3, characters 20-21:
+3 | and B:sig type t += A end = struct type t += A = A.A end
+                        ^
+  Module B defines an unsafe extension constructor, A .
+|}]
+
+
+module rec A: sig
+  module F: functor(X:sig end) -> sig end
+  val f: unit -> unit
+end = struct
+  module F(X:sig end) = struct end
+  let f () = B.value
+end
+and B: sig val value: unit end = struct let value = A.f () end
+[%%expect {|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 |   module F(X:sig end) = struct end
+6 |   let f () = B.value
+7 | end
+Error: Cannot safely evaluate the definition of the following cycle
+       of recursively-defined modules: A -> B -> A.
+       There are no safe modules in this cycle (see manual section 8.2).
+Line 2, characters 2-41:
+2 |   module F: functor(X:sig end) -> sig end
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Module A defines an unsafe functor, F .
+Line 8, characters 11-26:
+8 | and B: sig val value: unit end = struct let value = A.f () end
+               ^^^^^^^^^^^^^^^
+  Module B defines an unsafe value, value .
+|}]
+
+
+module F(X: sig module type t module M: t end) = struct
+  module rec A: sig
+    module M: X.t
+    val f: unit -> unit
+  end = struct
+    module M = X.M
+    let f () = B.value
+  end
+  and B: sig val value: unit end = struct let value  = A.f () end
+end
+[%%expect {|
+Lines 5-8, characters 8-5:
+5 | ........struct
+6 |     module M = X.M
+7 |     let f () = B.value
+8 |   end
+Error: Cannot safely evaluate the definition of the following cycle
+       of recursively-defined modules: A -> B -> A.
+       There are no safe modules in this cycle (see manual section 8.2).
+Line 3, characters 4-17:
+3 |     module M: X.t
+        ^^^^^^^^^^^^^
+  Module A defines an unsafe module, M .
+Line 9, characters 13-28:
+9 |   and B: sig val value: unit end = struct let value  = A.f () end
+                 ^^^^^^^^^^^^^^^
+  Module B defines an unsafe value, value .
+|}]
+
+
+module rec M: sig val f: unit -> int end = struct let f () = N.x end
+and N:sig val x: int end = struct let x = M.f () end;;
+[%%expect {|
+Exception: Undefined_recursive_module ("", 1, 43).
+|}]
diff --git a/testsuite/tests/basic-more/bounds.ml b/testsuite/tests/basic-more/bounds.ml
new file mode 100644
index 00000000..9915853f
--- /dev/null
+++ b/testsuite/tests/basic-more/bounds.ml
@@ -0,0 +1,30 @@
+(* TEST
+   include testing
+*)
+
+(* Test bound checks *)
+
+let a = [| 0; 1; 2 |]
+
+let trail = ref []
+
+let test n =
+  let result =
+    try
+      trail := n :: !trail; ignore a.(n); "doesn't fail"
+    with Invalid_argument s ->
+           (* Check well-formedness of s *)
+           if String.length s = 19
+           && s = "index out of bounds"
+           then "fails"
+           else "bad Invalid_argument"
+       | _ -> "bad exception"
+  in
+    print_int n; print_string ": "; print_string result; print_newline()
+
+let _ =
+  test 0; test 1; test 2; test 3; test 4; test (-1);
+  Gc.full_major();
+  print_string "Trail:";
+  List.iter (fun n -> print_string " "; print_int n) !trail;
+  print_newline()
diff --git a/testsuite/tests/basic-more/bounds.reference b/testsuite/tests/basic-more/bounds.reference
new file mode 100644
index 00000000..5d34a602
--- /dev/null
+++ b/testsuite/tests/basic-more/bounds.reference
@@ -0,0 +1,9 @@
+0: doesn't fail
+1: doesn't fail
+2: doesn't fail
+3: fails
+4: fails
+-1: fails
+Trail: -1 4 3 2 1 0
+
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/div_by_zero.ml b/testsuite/tests/basic-more/div_by_zero.ml
new file mode 100644
index 00000000..7cd91076
--- /dev/null
+++ b/testsuite/tests/basic-more/div_by_zero.ml
@@ -0,0 +1,70 @@
+(* TEST
+   include testing
+*)
+
+let check f n =
+  assert (
+    try ignore ((Sys.opaque_identity f) n); false with
+      Division_by_zero -> true
+  )
+
+let div_int n  = n / 0
+let div_int32 n = Int32.div n 0l
+let div_int64 n = Int64.div n 0L
+let div_nativeint n = Nativeint.div n 0n
+
+let mod_int n  = n mod 0
+let mod_int32 n = Int32.rem n 0l
+let mod_int64 n = Int64.rem n 0L
+let mod_nativeint n = Nativeint.rem n 0n
+
+let div_int_opaque n  = n / (Sys.opaque_identity 0)
+let div_int32_opaque n = Int32.div n (Sys.opaque_identity 0l)
+let div_int64_opaque n = Int64.div n (Sys.opaque_identity 0L)
+let div_nativeint_opaque n = Nativeint.div n (Sys.opaque_identity 0n)
+
+let mod_int_opaque n  = n mod (Sys.opaque_identity 0)
+let mod_int32_opaque n = Int32.rem n (Sys.opaque_identity 0l)
+let mod_int64_opaque n = Int64.rem n (Sys.opaque_identity 0L)
+let mod_nativeint_opaque n = Nativeint.rem n (Sys.opaque_identity 0n)
+
+let () =
+  check div_int 33;
+  check div_int 0;
+  check div_int32 33l;
+  check div_int32 0l;
+  check div_int64 33L;
+  check div_int64 0L;
+  check div_nativeint 33n;
+  check div_nativeint 0n;
+
+  check mod_int 33;
+  check mod_int 0;
+  check mod_int32 33l;
+  check mod_int32 0l;
+  check mod_int64 33L;
+  check mod_int64 0L;
+  check mod_nativeint 33n;
+  check mod_nativeint 0n;
+
+  check div_int_opaque 33;
+  check div_int_opaque 0;
+  check div_int32_opaque 33l;
+  check div_int32_opaque 0l;
+  check div_int64_opaque 33L;
+  check div_int64_opaque 0L;
+  check div_nativeint_opaque 33n;
+  check div_nativeint_opaque 0n;
+
+  check mod_int_opaque 33;
+  check mod_int_opaque 0;
+  check mod_int32_opaque 33l;
+  check mod_int32_opaque 0l;
+  check mod_int64_opaque 33L;
+  check mod_int64_opaque 0L;
+  check mod_nativeint_opaque 33n;
+  check mod_nativeint_opaque 0n;
+  ()
+
+let () =
+  print_endline "***** OK *****"
diff --git a/testsuite/tests/basic-more/div_by_zero.reference b/testsuite/tests/basic-more/div_by_zero.reference
new file mode 100644
index 00000000..e6b95628
--- /dev/null
+++ b/testsuite/tests/basic-more/div_by_zero.reference
@@ -0,0 +1,3 @@
+***** OK *****
+
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/function_in_ref.ml b/testsuite/tests/basic-more/function_in_ref.ml
new file mode 100644
index 00000000..48138409
--- /dev/null
+++ b/testsuite/tests/basic-more/function_in_ref.ml
@@ -0,0 +1,12 @@
+(* TEST
+   include testing
+*)
+
+let f x = x + 1
+let g x = x - 1
+
+let run () =
+  let r = ref f in
+  r := g;
+  let n = !r 1 in
+  assert(n = 0)
diff --git a/testsuite/tests/basic-more/function_in_ref.reference b/testsuite/tests/basic-more/function_in_ref.reference
new file mode 100644
index 00000000..197c9280
--- /dev/null
+++ b/testsuite/tests/basic-more/function_in_ref.reference
@@ -0,0 +1,2 @@
+
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/if_in_if.ml b/testsuite/tests/basic-more/if_in_if.ml
new file mode 100644
index 00000000..cf3525d2
--- /dev/null
+++ b/testsuite/tests/basic-more/if_in_if.ml
@@ -0,0 +1,47 @@
+(* TEST
+   include testing
+*)
+
+let sequor b1 b2 =
+  let b1 = ref b1 in
+  let b2 = ref b2 in
+  let b1 = !b1 in
+  let b2 = !b2 in
+  if (if b1 then true else b2 && if b1 then true else b2)
+  then "true" else "false"
+
+let sequand b1 b2 =
+  let b1 = ref b1 in
+  let b2 = ref b2 in
+  let b1 = !b1 in
+  let b2 = !b2 in
+  if (if b1 then b2 else false && if b1 then b2 else false)
+  then "true" else "false"
+
+let sequor' b1 b2 =
+  let b1 = ref b1 in
+  let b2 = ref b2 in
+  let b1 = !b1 in
+  let b2 = !b2 in
+  if (if b1 then true else b2 || if b1 then true else b2)
+  then "true" else "false"
+
+let sequand' b1 b2 =
+  let b1 = ref b1 in
+  let b2 = ref b2 in
+  let b1 = !b1 in
+  let b2 = !b2 in
+  if (if b1 then b2 else false || if b1 then b2 else false)
+  then "true" else "false"
+
+let test b1 b2 =
+  assert(sequor b1 b2 = if b1 || b2 then "true" else "false");
+  assert(sequor' b1 b2 = if b1 || b2 then "true" else "false");
+  assert(sequand b1 b2 = if b1 && b2 then "true" else "false");
+  assert(sequand' b1 b2 = if b1 && b2 then "true" else "false")
+
+let () =
+  test false false;
+  test false true;
+  test true false;
+  test true true
diff --git a/testsuite/tests/basic-more/if_in_if.reference b/testsuite/tests/basic-more/if_in_if.reference
new file mode 100644
index 00000000..197c9280
--- /dev/null
+++ b/testsuite/tests/basic-more/if_in_if.reference
@@ -0,0 +1,2 @@
+
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/morematch.compilers.reference b/testsuite/tests/basic-more/morematch.compilers.reference
new file mode 100644
index 00000000..9404040d
--- /dev/null
+++ b/testsuite/tests/basic-more/morematch.compilers.reference
@@ -0,0 +1,60 @@
+File "morematch.ml", line 67, characters 2-5:
+67 | | 4|5|7 -> 100
+       ^^^
+Warning 12: this sub-pattern is unused.
+File "morematch.ml", line 68, characters 2-3:
+68 | | 7 | 8 -> 6
+       ^
+Warning 12: this sub-pattern is unused.
+File "morematch.ml", line 219, characters 33-47:
+219 | let f = function (([]|[_]) as x)|(_::([] as x))|(_::_::x)  -> x
+                                       ^^^^^^^^^^^^^^
+Warning 12: this sub-pattern is unused.
+File "morematch.ml", line 388, characters 2-15:
+388 | | A,_,(100|103) -> 5
+        ^^^^^^^^^^^^^
+Warning 11: this match case is unused.
+File "morematch.ml", line 401, characters 2-20:
+401 | | [],_,(100|103|104) -> 5
+        ^^^^^^^^^^^^^^^^^^
+Warning 11: this match case is unused.
+File "morematch.ml", line 402, characters 2-16:
+402 | | [],_,(100|103) -> 6
+        ^^^^^^^^^^^^^^
+Warning 11: this match case is unused.
+File "morematch.ml", line 403, characters 2-29:
+403 | | [],_,(1000|1001|1002|20000) -> 7
+        ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 11: this match case is unused.
+File "morematch.ml", line 413, characters 5-12:
+413 |   | (100|103|101) -> 2
+           ^^^^^^^
+Warning 12: this sub-pattern is unused.
+File "morematch.ml", line 432, characters 43-44:
+432 | | (J,J,((C|D) as x |E x|F (_,x))) | (J,_,((C|J) as x)) -> autre (x,x,x)
+                                                 ^
+Warning 12: this sub-pattern is unused.
+File "morematch.ml", line 455, characters 7-8:
+455 | | _,_,(X|U _) -> 8
+             ^
+Warning 12: this sub-pattern is unused.
+File "morematch.ml", line 456, characters 2-7:
+456 | | _,_,Y -> 5
+        ^^^^^
+Warning 11: this match case is unused.
+File "morematch.ml", lines 1050-1053, characters 8-10:
+1050 | ........function
+1051 |   | A (`A|`C) -> 0
+1052 |   | B (`B,`D) -> 1
+1053 |   | C -> 2
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(A `D|B (`B, (`A|`C)))
+File "morematch.ml", line 1084, characters 5-51:
+1084 |   |  _, _, _, _, _, A, _, _, _, _, B, _, _, _, _, _ -> "11"
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 11: this match case is unused.
+File "morematch.ml", line 1086, characters 5-51:
+1086 |   |  _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ -> "13"
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 11: this match case is unused.
diff --git a/testsuite/tests/basic-more/morematch.ml b/testsuite/tests/basic-more/morematch.ml
new file mode 100644
index 00000000..998daee6
--- /dev/null
+++ b/testsuite/tests/basic-more/morematch.ml
@@ -0,0 +1,1159 @@
+(* TEST
+   include testing
+*)
+
+(**************************************************************)
+(*  This suite tests the pattern-matching compiler            *)
+(*  it should just compile and run.                           *)
+(*  While compiling the following messages are normal:        *)
+(**************************************************************)
+
+let test msg f arg r =
+  if f arg <> r then begin
+    prerr_endline msg ;
+    failwith "Malaise"
+  end
+;;
+
+type t = A | B | C | D | E | F
+  ;;
+
+let f x = match x with
+| A | B | C -> 1
+| D | E -> 2
+| F -> 3;;
+
+test "un" f C 1 ;
+test "un" f D 2 ;
+test "un" f F 3 ; ()
+;;
+
+let g x = match x with
+  1 -> 1
+| 2 -> 2
+| 3 -> 3
+| 4 | 5 -> 4
+| 6 -> 5
+| 7 | 8 -> 6
+| 9 -> 7
+| _ -> assert false
+;;
+
+test "deux" g 5 4 ;
+test "deux" g 6 5 ;
+test "deux" g 9 7 ; ()
+;;
+
+
+let g x = match x with
+  1 -> 1
+| 2 -> 2
+| 3 -> 3
+| 4 | 5 -> 4
+| 6 -> 5
+| 7 | 8 -> 6
+| 9 -> 7
+| _ -> 8;;
+
+test "trois" g 10 8
+;;
+
+let g x= match  x with
+  1 -> 1
+| 2 -> 2
+| 3 -> 3
+| 4 | 5 -> 4
+| 6 -> 5
+| 4|5|7 -> 100
+| 7 | 8 -> 6
+| 9 -> 7
+| _ -> 8
+;;
+
+test "quatre" g 4 4 ;
+test "quatre" g 7 100 ; ()
+;;
+
+let h x =
+ match x with
+   (1,1) -> 1
+| (2|3), 1 -> 2
+| 2,(2|3) -> 3
+| (4,4) -> 5
+| _ -> 100
+;;
+
+test "cinq" h (2,2) 3 ;
+test "cinq" h (2,1) 2 ;
+test "cinq" h (2,4) 100 ; ()
+;;
+
+(* idem hh (2,5) *)
+
+let hh x = match x with
+| 1,1 -> 1
+| 2,1 -> 2
+| (2|3),(1|2|3|4) -> 3
+| 2,5 -> 4
+| (4,4) -> 5
+| _ -> 100
+;;
+
+let hhh x = match x with
+| 1,1 -> 1
+| (2|3),1 -> 2
+| 2,2 -> 3
+| _ -> 100
+;;
+
+let h x =
+ match x with
+   (1,1) -> 1
+| 3,1 -> 2
+| 2,(2|3) -> 3
+| (4,4) -> 5
+| _ -> 100
+;;
+
+let h x = match x with
+  1 -> 1
+| 2|3 -> 2
+| 4 -> 4
+| 5 -> 5
+| 6|7 -> 6
+| 8 -> 8
+| _ -> 100
+;;
+let f x = match x with
+| ((1|2),(3|4))|((3|4),(1|2)) -> 1
+| (3,(5|6)) -> 2
+| _ -> 3
+;;
+
+test "six" f (1,3) 1 ;
+test "six" f (3,2) 1 ;
+test "six" f (3,5) 2 ;
+test "six" f (3,7) 3 ; ()
+;;
+
+type tt = {a : bool list ; b : bool}
+
+let f = function
+  | {a=([]|[true])} -> 1
+  | {a=false::_}|{b=(true|false)}    -> 2
+;;
+
+test "sept" f {a=[] ; b = true} 1 ;
+test "sept" f {a=[true] ; b = false} 1 ;
+test "sept" f {a=[false ; true] ; b = true} 2 ;
+test "sept" f {a=[false] ; b = false} 2 ; ()
+;;
+
+let f = function
+  | (([]|[true]),_) -> 1
+  | (false::_,_)|(_,(true|false)) -> 2
+;;
+
+test "huit" f ([],true) 1 ;
+test "huit" f ([true],false) 1 ;
+test "huit" f ([false ; true], true) 2 ;
+test "huit" f ([false], false) 2 ; ()
+;;
+
+
+let split_cases = function
+   | `Nil | `Cons _ as x -> `A x
+   | `Snoc _ as x -> `B x
+;;
+
+test "oubli" split_cases `Nil (`A `Nil);
+test "oubli" split_cases (`Cons 1) (`A (`Cons 1));
+test "oubli" split_cases (`Snoc 1) (`B (`Snoc 1)) ; ()
+;;
+
+type t1 = A of int | B of int
+let f1 = function
+  | (A x | B x) -> x
+;;
+
+test "neuf" f1 (A 1) 1 ;
+test "neuf" f1 (B 1) 1 ;
+;;
+
+type coucou = A of int | B of int * int | C
+;;
+
+
+let g = function
+  | (A x | B (_,x)) -> x
+  | C -> 0
+;;
+
+
+test "dix" g (A 1) 1 ;
+test "dix" g (B (1,2)) 2 ;
+;;
+
+
+
+let h = function
+  | ([x]|[1 ; x ]|[1 ; 2 ; x]) -> x
+  | _ -> 0
+;;
+
+test "encore" h [1] 1 ;
+test "encore" h [1;2] 2 ;
+test "encore" h [1;2;3] 3 ;
+test "encore" h [0 ; 0] 0 ; ()
+;;
+
+let f = function
+| (x,(0 as y)) | (y,x) -> y-x
+;;
+
+test "foo1" f (1,0) (-1);
+test "foo1" f (1,2) (-1)
+;;
+
+
+let f = function (([]|[_]) as x)|(_::([] as x))|(_::_::x)  -> x
+;;
+
+test "zob" f [] [] ;
+test "zob" f [1] [1] ;
+test "zob" f [1;2;3] [3]
+;;
+
+
+type zob = A | B | C | D of zob * int | E of zob * zob
+
+let rec f = function
+  | (A | B | C) -> A
+  | D (x,i) -> D (f x,i)
+  | E (x,_) -> D (f x,0)
+;;
+
+
+test "fin" f B A ;
+test "fin" f (D (C,1)) (D (A,1)) ;
+test "fin" f (E (C,A)) (D (A,0)) ; ()
+;;
+
+type length =
+    Char of int | Pixel of int | Percent of int | No of string | Default
+
+let length = function
+  | Char n -> n | Pixel n -> n
+  | _       -> 0
+;;
+
+test "length" length (Char 10) 10 ;
+test "length" length (Pixel 20) 20 ;
+test "length" length Default 0 ;
+test "length" length (Percent 100) 0 ; ()
+;;
+
+let length2 = function
+  | Char n -> n | Percent n -> n
+  | _       -> 0
+;;
+
+test "length2" length2 (Char 10) 10 ;
+test "length2" length2 (Pixel 20) 0 ;
+test "length2" length2 Default 0 ;
+test "length2" length2(Percent 100) 100 ; ()
+;;
+
+let length3 = function
+  | Char _ | No _ -> true
+  | _ -> false
+;;
+
+test "length3" length3 (Char 10) true ;
+test "length3" length3 (No "") true ;
+test "length3" length3 (Pixel 20) false ;
+test "length3" length3 Default false ;
+test "length3" length3(Percent 100) false ; ()
+;;
+
+type hevea = A | B | C
+
+let h x = match x with
+| A -> 1
+| B|C -> 2
+;;
+
+test "hevea" h A 1 ;
+test "hevea" h B 2 ;
+test "hevea" h B 2 ; ()
+;;
+type lambda =
+    Lvar of int
+  | Lconst of int
+  | Lapply of lambda * lambda list
+  | Lfunction of bool  * int list * lambda
+  | Llet of  bool * int * lambda * lambda
+  | Lletrec of (int * lambda) list * lambda
+  | Lprim of string * lambda list
+  | Lswitch of lambda * lambda_switch
+  | Lstaticfail
+  | Lcatch of lambda * lambda
+  | Lstaticraise of int * lambda list
+  | Lstaticcatch of lambda * (int * int list) * lambda
+  | Ltrywith of lambda * int * lambda
+  | Lifthenelse of lambda * lambda * lambda
+  | Lsequence of lambda * lambda
+  | Lwhile of lambda * lambda
+  | Lfor of int * lambda * lambda * bool * lambda
+  | Lassign of int * lambda
+  | Lsend of lambda * lambda * lambda list
+  | Levent of lambda * lambda_event
+  | Lifused of int * lambda
+and lambda_switch =
+  { sw_numconsts: int;                  (* Number of integer cases *)
+    sw_consts: (int * lambda) list;     (* Integer cases *)
+    sw_numblocks: int;                  (* Number of tag block cases *)
+    sw_blocks: (int * lambda) list;     (* Tag block cases *)
+    sw_checked: bool ;                  (* True if bound checks needed *)
+    sw_nofail: bool}                    (* True if should not fail *)
+and lambda_event =
+  { lev_loc: int;
+    lev_kind: bool ;
+    lev_repr: int ref option;
+    lev_env: int list }
+
+let rec approx_present v l = true
+
+let rec lower_bind v arg lam = match lam with
+| Lifthenelse (cond, ifso, ifnot) -> 1
+| Lswitch (ls,({sw_consts=[i,act] ; sw_blocks = []} as _sw))
+    when not (approx_present v ls) -> 2
+| Lswitch (ls,({sw_consts=[] ; sw_blocks = [i,act]} as _sw))
+    when not (approx_present v ls) -> 3
+| Llet (true , vv, lv, l) -> 4
+| _ -> 5
+;;
+
+test "lower_bind" (lower_bind 0 0) (Llet (true,0, Lvar 1, Lvar 2)) 4 ;
+test "lower_bind" (lower_bind 0 0) (Lvar 0) 5 ;
+test "lower_bind" (lower_bind 0 0) (Lifthenelse (Lvar 0, Lvar 1, Lvar 2)) 1
+;;
+
+
+type field_kind =
+    Fvar of field_kind option ref
+  | Fpresent
+  | Fabsent
+
+let unify_kind (k1, k2) =  match k1, k2 with
+    (Fvar r, (Fvar _ | Fpresent))             -> 1
+  | (Fpresent, Fvar r)                        -> 2
+  | (Fpresent, Fpresent)                      -> 3
+  | _                                         -> 4
+
+
+let r = ref (Some Fpresent)
+;;
+
+test "unify"  unify_kind (Fvar r, Fpresent) 1 ;
+test "unify"  unify_kind (Fvar r, Fvar r) 1 ;
+test "unify"  unify_kind (Fvar r, Fabsent) 4 ;
+test "unify"  unify_kind (Fpresent, Fvar r) 2 ;
+test "unify"  unify_kind (Fpresent, Fpresent) 3 ;
+test "unify"  unify_kind (Fabsent, Fpresent) 4 ; ()
+;;
+
+
+type youyou = A | B | C | D of youyou
+
+let foo (k1, k2) = match k1,k2 with
+| D _, (A|D _) -> 1
+| (A|B),D _ -> 2
+| C,_       -> 3
+| _, (A|B|C) -> 4
+;;
+
+test "foo2" foo (D A,A) 1 ;
+test "foo2" foo (D A,B) 4 ;
+test "foo2" foo (A,A) 4 ; ()
+;;
+
+type yaya = A | B
+;;
+
+let yaya = function
+| A,_,_ -> 1
+| _,A,_ -> 2
+| B,B,_ -> 3
+| A,_,(100|103) -> 5
+;;
+
+test "yaya" yaya (A,A,0) 1 ;
+test "yaya" yaya (B,A,0) 2 ;
+test "yaya" yaya (B,B,100) 3 ; ()
+;;
+
+
+let yoyo =  function
+| [],_,_ -> 1
+| _,[],_ -> 2
+| _::_,_::_,_ -> 3
+| [],_,(100|103|104) -> 5
+| [],_,(100|103) -> 6
+| [],_,(1000|1001|1002|20000) -> 7
+;;
+
+test "yoyo" yoyo ([],[],0) 1 ;
+test "yoyo" yoyo ([1],[],0) 2 ;
+test "yoyo" yoyo ([1],[1],100) 3 ; ()
+;;
+
+let youyou = function
+  | (100|103|104) -> 1
+  | (100|103|101) -> 2
+  | (1000|1001|1002|20000) -> 3
+  | _ -> -1
+;;
+
+test "youyou" youyou 100 1 ;
+test "youyou" youyou 101 2 ;
+test "youyou" youyou 1000 3
+;;
+
+type autre =
+  |  C | D | E of autre | F of autre * autre | H of autre | I | J | K of string
+
+let rec autre = function
+| C,_,_ -> 1
+| _,C,_ -> 2
+| D,D,_ -> 3
+| (D|F (_,_)|H _|K _),_,_ -> 4
+| (_, (D|I|E _|F (_, _)|H _|K _), _) -> 8
+| (J,J,((C|D) as x |E x|F (_,x))) | (J,_,((C|J) as x)) -> autre (x,x,x)
+| (J, J, (I|H _|K _)) -> 9
+| I,_,_ -> 6
+| E _,_,_ -> 7
+;;
+
+
+test "autre" autre (J,J,F (D,D)) 3 ;
+test "autre" autre (J,J,D) 3 ;
+test "autre" autre (J,J,I) 9 ;
+test "autre" autre (H I,I,I) 4 ;
+test "autre" autre (J,J,H I) 9 ; ()
+;;
+
+
+type youpi = YA | YB | YC
+and hola = X | Y | Z | T of hola | U of hola | V of hola
+
+let xyz = function
+| YA,_,_ -> 1
+| _,YA,_ -> 2
+| YB,YB,_ -> 3
+| ((YB|YC), (YB|YC), (X|Y|Z|V _|T _)) -> 6
+| _,_,(X|U _) -> 8
+| _,_,Y -> 5
+;;
+
+test "xyz" xyz (YC,YC,X) 6 ;
+test "xyz" xyz (YC,YB,U X) 8 ;
+test "xyz" xyz (YB,YC,X) 6 ; ()
+;;
+
+
+(* This test is for the compiler itself *)
+let eq (x,y) = x=y
+;;
+
+test "eq" eq ("coucou", "coucou") true ; ()
+;;
+
+(* Test guards, non trivial *)
+
+let is_none = function
+  | None -> true
+  | _ -> false
+
+let guard x = match x with
+| (Some _, _) when is_none (snd x) -> 1
+| (Some (pc, _), Some pc') when pc = pc' -> 2
+| _ -> 3
+;;
+
+test "guard" guard (Some (1,1),None) 1 ;
+test "guard" guard (Some (1,1),Some 1) 2 ;
+test "guard" guard (Some (2,1),Some 1) 3 ; ()
+;;
+
+let orstring = function
+  | ("A"|"B"|"C") -> 2
+  | "D" -> 3
+  | _ -> 4
+;;
+
+test "orstring" orstring "A" 2 ;
+test "orstring" orstring "B" 2 ;
+test "orstring" orstring "C" 2 ;
+test "orstring" orstring "D" 3 ;
+test "orstring" orstring "E" 4 ; ()
+;;
+
+type var_t = [`Variant of [ `Some of string | `None | `Foo] ]
+
+let crash (pat:var_t) =
+      match pat with
+      | `Variant (`Some tag) -> tag
+      | `Variant (`None) -> "none"
+      | _ -> "foo"
+
+;;
+
+test "crash" crash (`Variant `None) "none" ;
+test "crash" crash (`Variant (`Some "coucou")) "coucou" ;
+test "crash" crash (`Variant (`Foo)) "foo" ; ()
+;;
+
+let flatguard c =
+let x,y = c in
+match x,y with
+| (1,2)|(2,3) when y=2 -> 1
+| (1,_)|(_,3) -> 2
+| _ -> 3
+;;
+
+test "flatguard" flatguard (1,2) 1 ;
+test "flatguard" flatguard (1,3) 2 ;
+test "flatguard" flatguard (2,3) 2 ;
+test "flatguard" flatguard (2,4) 3 ; ()
+;;
+
+
+(* Jerome's bugs *)
+type f =
+  | ABSENT
+  | FILE
+  | SYMLINK
+  | DIRECTORY
+
+type r =
+  | Unchanged
+  | Deleted
+  | Modified
+  | PropsChanged
+  | Created
+
+let replicaContent2shortString rc =
+    let (typ, status) = rc in
+    match typ, status with
+      _, Unchanged             -> "        "
+    | ABSENT, Deleted         -> "deleted "
+    | FILE, Created           -> "new file"
+    | FILE, Modified          -> "changed "
+    | FILE, PropsChanged      -> "props   "
+    | SYMLINK, Created        -> "new link"
+    | SYMLINK, Modified       -> "chgd lnk"
+    | DIRECTORY, Created      -> "new dir "
+    | DIRECTORY, Modified     -> "chgd dir"
+    | DIRECTORY, PropsChanged -> "props   "
+    (* Cases that can't happen... *)
+
+    | ABSENT, (Created | Modified | PropsChanged)
+    | SYMLINK, PropsChanged
+    | (FILE|SYMLINK|DIRECTORY), Deleted
+                                -> "assert false"
+;;
+
+
+test "jerome_constr"
+   replicaContent2shortString (ABSENT, Unchanged) "        " ;
+test "jerome_constr"
+   replicaContent2shortString (ABSENT, Deleted) "deleted " ;
+test "jerome_constr"
+   replicaContent2shortString (FILE, Modified) "changed " ;
+test "jerome_constr"
+   replicaContent2shortString (DIRECTORY, PropsChanged) "props   " ;
+test "jerome_constr"
+   replicaContent2shortString (FILE, Deleted) "assert false" ;
+test "jerome_constr"
+   replicaContent2shortString (SYMLINK, Deleted) "assert false" ;
+test "jerome_constr"
+   replicaContent2shortString (SYMLINK, PropsChanged) "assert false" ;
+test "jerome_constr"
+   replicaContent2shortString (DIRECTORY, Deleted) "assert false" ;
+test "jerome_constr"
+   replicaContent2shortString (ABSENT, Created) "assert false" ;
+test "jerome_constr"
+   replicaContent2shortString (ABSENT, Modified) "assert false" ;
+test "jerome_constr"
+   replicaContent2shortString (ABSENT, PropsChanged) "assert false" ;
+;;
+
+
+let replicaContent2shortString rc =
+    let (typ, status) = rc in
+    match typ, status with
+      _, `Unchanged             -> "        "
+    | `ABSENT, `Deleted         -> "deleted "
+    | `FILE, `Created           -> "new file"
+    | `FILE, `Modified          -> "changed "
+    | `FILE, `PropsChanged      -> "props   "
+    | `SYMLINK, `Created        -> "new link"
+    | `SYMLINK, `Modified       -> "chgd lnk"
+    | `DIRECTORY, `Created      -> "new dir "
+    | `DIRECTORY, `Modified     -> "chgd dir"
+    | `DIRECTORY, `PropsChanged -> "props   "
+    (* Cases that can't happen... *)
+
+    | `ABSENT, (`Created | `Modified | `PropsChanged)
+    | `SYMLINK, `PropsChanged
+    | (`FILE|`SYMLINK|`DIRECTORY), `Deleted
+                                -> "assert false"
+;;
+
+
+test "jerome_variant"
+   replicaContent2shortString (`ABSENT, `Unchanged) "        " ;
+test "jerome_variant"
+   replicaContent2shortString (`ABSENT, `Deleted) "deleted " ;
+test "jerome_variant"
+   replicaContent2shortString (`FILE, `Modified) "changed " ;
+test "jerome_variant"
+   replicaContent2shortString (`DIRECTORY, `PropsChanged) "props   " ;
+test "jerome_variant"
+   replicaContent2shortString (`FILE, `Deleted) "assert false" ;
+test "jerome_variant"
+   replicaContent2shortString (`SYMLINK, `Deleted) "assert false" ;
+test "jerome_variant"
+   replicaContent2shortString (`SYMLINK, `PropsChanged) "assert false" ;
+test "jerome_variant"
+   replicaContent2shortString (`DIRECTORY, `Deleted) "assert false" ;
+test "jerome_variant"
+   replicaContent2shortString (`ABSENT, `Created) "assert false" ;
+test "jerome_variant"
+   replicaContent2shortString (`ABSENT, `Modified) "assert false" ;
+test "jerome_variant"
+   replicaContent2shortString (`ABSENT, `PropsChanged) "assert false" ;
+;;
+
+(* bug 319 *)
+
+type ab = A of int | B of int
+type cd = C | D
+
+let ohl = function
+  | (A (p) | B (p)), C -> p
+  | (A (p) | B (p)), D -> p
+;;
+
+test "ohl" ohl (A 0,C) 0 ;
+test "ohl" ohl (B 0,D) 0 ; ()
+;;
+
+(* bug 324 *)
+type pottier =
+  | A
+  | B
+;;
+
+let pottier x =
+  match x with
+  | (( (A, 1) | (B, 2)),A) -> false
+  | _ -> true
+;;
+
+test "pottier" pottier ((B,2),A) false ;
+test "pottier" pottier ((B,2),B) true ;
+test "pottier" pottier ((A,2),A) true ; ()
+;;
+
+(* bug 325 in bytecode compiler *)
+let coquery q =  match q with
+| y,0,([modu;defs]| [defs;modu;_]) -> y+defs-modu
+| _ -> 0
+;;
+
+test "coquery" coquery (1,0,[1 ; 2 ; 3]) 0 ;
+test "coquery" coquery (1,0,[1 ; 2]) 2 ; ()
+;;
+
+(*
+  Two other variable in or-pat tests
+*)
+type vars = A of int | B of (int * int) | C
+;;
+
+
+let vars1 = function
+  | (A x | B (_,x)) -> x
+  | C -> 0
+;;
+
+test "vars1" vars1 (A 1) 1 ;
+test "vars1" vars1 (B (1,2)) 2 ; ()
+;;
+
+let vars2 = function
+  | ([x]|[1 ; x ]|[1 ; 2 ; x]) -> x
+  | _ -> 0
+;;
+
+test"vars2" vars2 [1] 1 ;
+test"vars2" vars2 [1;2] 2 ;
+test"vars2" vars2 [1;2;3] 3 ;
+test"vars2" vars2 [0 ; 0] 0 ; ()
+;;
+
+(* Bug 342 *)
+type eber = {x:int; y: int; z:bool}
+
+let eber = function
+  | {x=a; z=true}
+  | {y=a; z=false} -> a
+;;
+
+test "eber" eber {x=0 ; y=1 ; z=true} 0 ;
+test "eber" eber {x=1 ; y=0 ; z=false} 0 ; ()
+;;
+
+
+(* Chaining interval tests *)
+
+let escaped = function
+  | '\"' | '\\' | '\n' | '\t' -> 2
+  | c -> 1
+;;
+
+test "escaped" escaped '\"' 2 ;
+test "escaped" escaped '\\' 2 ;
+test "escaped" escaped '\n' 2 ;
+test "escaped" escaped '\t' 2 ;
+test "escaped" escaped '\000' 1 ;
+test "escaped" escaped ' ' 1 ;
+test "escaped" escaped '\000' 1 ;
+test "escaped" escaped '[' 1 ;
+test "escaped" escaped ']' 1 ;
+test "escaped" escaped '!' 1 ;
+test "escaped" escaped '#' 1 ;
+()
+;;
+
+(* For compilation speed (due to J. Garigue) *)
+exception Unknown_Reply of int
+
+type command_reply =
+   RPL_TRYAGAIN
+ | RPL_TRACEEND
+ | RPL_TRACELOG
+ | RPL_ADMINEMAIL
+ | RPL_ADMINLOC2
+ | RPL_ADMINLOC1
+ | RPL_ADMINME
+ | RPL_LUSERME
+ | RPL_LUSERCHANNELS
+ | RPL_LUSERUNKNOWN
+ | RPL_LUSEROP
+ | RPL_LUSERCLIENT
+ | RPL_STATSDLINE
+ | RPL_STATSDEBUG
+ | RPL_STATSDEFINE
+ | RPL_STATSBLINE
+ | RPL_STATSPING
+ | RPL_STATSSLINE
+ | RPL_STATSHLINE
+ | RPL_STATSOLINE
+ | RPL_STATSUPTIME
+ | RPL_STATSLLINE
+ | RPL_STATSVLINE
+ | RPL_SERVLISTEND
+ | RPL_SERVLIST
+ | RPL_SERVICE
+ | RPL_ENDOFSERVICES
+ | RPL_SERVICEINFO
+ | RPL_UMODEIS
+ | RPL_ENDOFSTATS
+ | RPL_STATSYLINE
+ | RPL_STATSQLINE
+ | RPL_STATSKLINE
+ | RPL_STATSILINE
+ | RPL_STATSNLINE
+ | RPL_STATSCLINE
+ | RPL_STATSCOMMANDS
+ | RPL_STATSLINKINFO
+ | RPL_TRACERECONNECT
+ | RPL_TRACECLASS
+ | RPL_TRACENEWTYPE
+ | RPL_TRACESERVICE
+ | RPL_TRACESERVER
+ | RPL_TRACEUSER
+ | RPL_TRACEOPERATOR
+ | RPL_TRACEUNKNOWN
+ | RPL_TRACEHANDSHAKE
+ | RPL_TRACECONNECTING
+ | RPL_TRACELINK
+ | RPL_NOUSERS
+ | RPL_ENDOFUSERS
+ | RPL_USERS
+ | RPL_USERSSTART
+ | RPL_TIME
+ | RPL_NOTOPERANYMORE
+ | RPL_MYPORTIS
+ | RPL_YOURESERVICE
+ | RPL_REHASHING
+ | RPL_YOUREOPER
+ | RPL_ENDOFMOTD
+ | RPL_MOTDSTART
+ | RPL_ENDOFINFO
+ | RPL_INFOSTART
+ | RPL_MOTD
+ | RPL_INFO
+ | RPL_ENDOFBANLIST
+ | RPL_BANLIST
+ | RPL_ENDOFLINKS
+ | RPL_LINKS
+ | RPL_CLOSEEND
+ | RPL_CLOSING
+ | RPL_KILLDONE
+ | RPL_ENDOFNAMES
+ | RPL_NAMREPLY
+ | RPL_ENDOFWHO
+ | RPL_WHOREPLY
+ | RPL_VERSION
+ | RPL_SUMMONING
+ | RPL_INVITING
+ | RPL_TOPIC
+ | RPL_NOTOPIC
+ | RPL_CHANNELMODEIS
+ | RPL_LISTEND
+ | RPL_LIST
+ | RPL_LISTSTART
+ | RPL_WHOISCHANNELS
+ | RPL_ENDOFWHOIS
+ | RPL_WHOISIDLE
+ | RPL_WHOISCHANOP
+ | RPL_ENDOFWHOWAS
+ | RPL_WHOWASUSER
+ | RPL_WHOISOPERATOR
+ | RPL_WHOISSERVER
+ | RPL_WHOISUSER
+ | RPL_NOWAWAY
+ | RPL_UNAWAY
+ | RPL_TEXT
+ | RPL_ISON
+ | RPL_USERHOST
+ | RPL_AWAY
+ | RPL_NONE
+
+let get_command_reply n =
+match n with
+   263    ->     RPL_TRYAGAIN
+ | 319    ->     RPL_WHOISCHANNELS
+ | 318    ->     RPL_ENDOFWHOIS
+ | 317    ->     RPL_WHOISIDLE
+ | 316    ->     RPL_WHOISCHANOP
+ | 369    ->     RPL_ENDOFWHOWAS
+ | 314    ->     RPL_WHOWASUSER
+ | 313    ->     RPL_WHOISOPERATOR
+ | 312    ->     RPL_WHOISSERVER
+ | 311    ->     RPL_WHOISUSER
+ | 262    ->     RPL_TRACEEND
+ | 261    ->     RPL_TRACELOG
+ | 259    ->     RPL_ADMINEMAIL
+ | 258    ->     RPL_ADMINLOC2
+ | 257    ->     RPL_ADMINLOC1
+ | 256    ->     RPL_ADMINME
+ | 255    ->     RPL_LUSERME
+ | 254    ->     RPL_LUSERCHANNELS
+ | 253    ->     RPL_LUSERUNKNOWN
+ | 252    ->     RPL_LUSEROP
+ | 251    ->     RPL_LUSERCLIENT
+ | 250    ->     RPL_STATSDLINE
+ | 249    ->     RPL_STATSDEBUG
+ | 248    ->     RPL_STATSDEFINE
+ | 247    ->     RPL_STATSBLINE
+ | 246    ->     RPL_STATSPING
+ | 245    ->     RPL_STATSSLINE
+ | 244    ->     RPL_STATSHLINE
+ | 243    ->     RPL_STATSOLINE
+ | 242    ->     RPL_STATSUPTIME
+ | 241    ->     RPL_STATSLLINE
+ | 240    ->     RPL_STATSVLINE
+ | 235    ->     RPL_SERVLISTEND
+ | 234    ->     RPL_SERVLIST
+ | 233    ->     RPL_SERVICE
+ | 232    ->     RPL_ENDOFSERVICES
+ | 231    ->     RPL_SERVICEINFO
+ | 221    ->     RPL_UMODEIS
+ | 219    ->     RPL_ENDOFSTATS
+ | 218    ->     RPL_STATSYLINE
+ | 217    ->     RPL_STATSQLINE
+ | 216    ->     RPL_STATSKLINE
+ | 215    ->     RPL_STATSILINE
+ | 214    ->     RPL_STATSNLINE
+ | 213    ->     RPL_STATSCLINE
+ | 212    ->     RPL_STATSCOMMANDS
+ | 211    ->     RPL_STATSLINKINFO
+ | 210    ->     RPL_TRACERECONNECT
+ | 209    ->     RPL_TRACECLASS
+ | 208    ->     RPL_TRACENEWTYPE
+ | 207    ->     RPL_TRACESERVICE
+ | 206    ->     RPL_TRACESERVER
+ | 205    ->     RPL_TRACEUSER
+ | 204    ->     RPL_TRACEOPERATOR
+ | 203    ->     RPL_TRACEUNKNOWN
+ | 202    ->     RPL_TRACEHANDSHAKE
+ | 201    ->     RPL_TRACECONNECTING
+ | 200    ->     RPL_TRACELINK
+ | 395    ->     RPL_NOUSERS
+ | 394    ->     RPL_ENDOFUSERS
+ | 393    ->     RPL_USERS
+ | 392    ->     RPL_USERSSTART
+ | 391    ->     RPL_TIME
+ | 385    ->     RPL_NOTOPERANYMORE
+ | 384    ->     RPL_MYPORTIS
+ | 383    ->     RPL_YOURESERVICE
+ | 382    ->     RPL_REHASHING
+ | 381    ->     RPL_YOUREOPER
+ | 376    ->     RPL_ENDOFMOTD
+ | 375    ->     RPL_MOTDSTART
+ | 374    ->     RPL_ENDOFINFO
+ | 373    ->     RPL_INFOSTART
+ | 372    ->     RPL_MOTD
+ | 371    ->     RPL_INFO
+ | 368    ->     RPL_ENDOFBANLIST
+ | 367    ->     RPL_BANLIST
+ | 365    ->     RPL_ENDOFLINKS
+ | 364    ->     RPL_LINKS
+ | 363    ->     RPL_CLOSEEND
+ | 362    ->     RPL_CLOSING
+ | 361    ->     RPL_KILLDONE
+ | 366    ->     RPL_ENDOFNAMES
+ | 353    ->     RPL_NAMREPLY
+ | 315    ->     RPL_ENDOFWHO
+ | 352    ->     RPL_WHOREPLY
+ | 351    ->     RPL_VERSION
+ | 342    ->     RPL_SUMMONING
+ | 341    ->     RPL_INVITING
+ | 332    ->     RPL_TOPIC
+ | 331    ->     RPL_NOTOPIC
+ | 324    ->     RPL_CHANNELMODEIS
+ | 323    ->     RPL_LISTEND
+ | 322    ->     RPL_LIST
+ | 321    ->     RPL_LISTSTART
+ | 306    ->     RPL_NOWAWAY
+ | 305    ->     RPL_UNAWAY
+ | 304    ->     RPL_TEXT
+ | 303    ->     RPL_ISON
+ | 302    ->     RPL_USERHOST
+ | 301    ->     RPL_AWAY
+ | 300    ->     RPL_NONE
+ | _ -> raise (Unknown_Reply n)
+
+(* Bug 454 *)
+type  habert_a=
+  | A of habert_c
+  | B of habert_c
+
+and habert_c= {lvar:int; lassoc: habert_c;lnb:int}
+
+
+let habert=function
+  | (A {lnb=i}|B {lnb=i}) when i=0 -> 1
+  | A {lassoc=({lnb=j});lnb=i} -> 2
+  | _ -> 3
+;;
+
+let rec ex0 = {lvar=0 ; lnb=0 ; lassoc=ex1}
+and ex1 = {lvar=1 ; lnb=1 ; lassoc=ex0} in
+
+test "habert" habert (A ex0) 1 ;
+test "habert" habert (B ex0) 1 ;
+test "habert" habert (A ex1) 2 ;
+test "habert" habert (B ex1) 3 ;
+
+(* Problems with interval test in arithmetic mod 2^31, bug #359 *)
+(* From manuel Fahndrich *)
+
+type type_expr = [
+  | `TTuple of type_expr list
+  | `TConstr of type_expr list
+  | `TVar of string
+  | `TVariant of string list
+  | `TBlock of int
+  | `TCopy of type_expr
+  ]
+
+and recurs_type_expr = [
+  | `TTuple of type_expr list
+  | `TConstr of type_expr list
+  | `TVariant of string list
+  ]
+
+
+let rec maf te =
+    match te with
+    | `TCopy te -> 1
+    | `TVar _ -> 2
+    | `TBlock _ -> 2
+    | #recurs_type_expr as desc ->
+
+        let te =
+          (match desc with
+            `TTuple tl ->
+              4
+          | `TConstr tl ->
+              5
+          | `TVariant (row) ->
+              6
+                )
+        in
+
+        te
+;;
+
+let base = `TBlock 0
+;;
+
+test "maf" maf (`TCopy base) 1 ;
+test "maf" maf (`TVar "test") 2 ;
+test "maf" maf (`TBlock 0) 2 ;
+test "maf" maf (`TTuple []) 4 ;
+test "maf" maf (`TConstr []) 5 ;
+test "maf" maf (`TVariant []) 6
+;;
+
+(* PR#3517
+  Using ``get_args'' in place or an ad-hoc ``matcher'' function for tuples.
+  Has made the compiler [3.05] to fail.
+*)
+type t_seb = Uin | Uout
+;;
+
+let rec seb = function
+  | ((i, Uin) | (i, Uout)), Uout -> 1
+  | ((j, Uin) | (j, Uout)), Uin ->  2
+;;
+
+test "seb" seb ((0,Uin),Uout) 1 ;
+test "seb" seb ((0,Uout),Uin) 2 ;
+()
+;;
+
+(* Talk with Jacques
+     - type 'b is still open ??
+     - better case generation, accept intervals of size 1 when ok_inter is
+       false (in Switch)
+*)
+
+type ('a, 'b) t_j = A of 'a | B of 'b * 'a | C
+
+let f = function
+  | A (`A|`C) -> 0
+  | B (`B,`D) -> 1
+  | C -> 2
+
+let g x = try f x with Match_failure _ -> 3
+
+let _ =
+  test "jacques" g (A `A) 0 ;
+  test "jacques" g (A `C) 0 ;
+  test "jacques" g (B (`B,`D)) 1 ;
+  test "jacaues" g C 2 ;
+(*  test "jacques" g (B (`A,`D)) 3 ; (* type incorrect expected behavior ? *)*)
+  ()
+
+(*
+  Compilation bug, segfault, because of incorrect compilation
+  of unused match case .. -> "11"
+*)
+
+type t_l = A | B
+
+let f = function
+  |  _, _, _, _, _, _, _, _, _, _, _, _, _, B, _, _ -> "0"
+  |  _, _, _, B, A, _, _, _, _, _, _, _, _, _, _, _ -> "1"
+  |  _, _, _, B, _, A, _, _, A, _, _, _, _, _, _, _ -> "2"
+  |  _, _, _, _, _, _, _, _, _, _, B, A, _, A, _, _ -> "3"
+  |  _, _, _, _, _, _, _, B, _, _, _, _, B, _, A, A -> "4"
+  |  A, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ -> "5"
+  |  _, _, _, _, _, _, _, B, _, B, _, _, _, _, _, _ -> "6"
+  |  _, B, _, _, _, _, _, _, _, _, _, _, _, _, _, _ -> "7"
+  |  _, A, A, _, A, _, B, _, _, _, _, _, _, _, _, B -> "8"
+  |  _, _, _, _, B, _, _, _, _, _, _, _, _, _, B, _ -> "9"
+  |  _, _, _, _, _, _, _, _, _, _, _, B, _, _, _, _ -> "10"
+  |  _, _, _, _, _, A, _, _, _, _, B, _, _, _, _, _ -> "11"
+  |  B, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ -> "12"
+  |  _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ -> "13"
+
+
+let _  =
+  test "luc"  f (B, A, A, A, A, A, A, A, A, A, A, B, A, A, A, A) "10" ;
+  test "luc"  f (B, A, A, A, A, A, A, A, A, A, A, A, A, A, A, A) "12" ;
+ ()
+
+(*
+  By Gilles Peskine, compilation raised some assert false i make_failactionneg
+*)
+
+type bg = [
+  | `False
+  | `True
+  ]
+
+type vg = [
+  | `A
+  | `B
+  | `U of int
+  | `V of int
+  ]
+
+type tg = {
+    v : vg;
+    x : bg;
+  }
+
+let predg x = true
+
+let rec gilles o = match o with
+  | {v = (`U data | `V data); x = `False} when predg o -> 1
+  | {v = (`A|`B) ; x = `False}
+  | {v = (`U _ | `V _); x = `False}
+  | {v = _ ; x = `True}
+    -> 2
+
+(*
+  Match in trywith should always have a default case
+*)
+
+exception Found of string * int
+exception Error of string
+
+
+let lucexn  e =
+  try
+    try  raise e  with Error msg -> msg
+  with Found (s,r) -> s^Int.to_string r
+
+let () =
+  test "lucexn1" lucexn  (Error "coucou") "coucou" ;
+  test "lucexn2" lucexn (Found ("int: ",0)) "int: 0" ;
+  ()
+
+(*
+  PR#5758: different representations of floats
+*)
+
+let pr5758 x str =
+  match (x, str) with
+  | (1. , "A") -> "Matched A"
+  | (1.0, "B") -> "Matched B"
+  | (1. , "C") -> "Matched C"
+  | result ->
+    match result with
+    | (1., "A") -> "Failed match A then later matched"
+    | _ -> "Failed twice"
+;;
+
+let () =
+  test "pr5758" (pr5758 1.) "A" "Matched A"
+;;
diff --git a/testsuite/tests/basic-more/morematch.reference b/testsuite/tests/basic-more/morematch.reference
new file mode 100644
index 00000000..197c9280
--- /dev/null
+++ b/testsuite/tests/basic-more/morematch.reference
@@ -0,0 +1,2 @@
+
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/opaque_prim.ml b/testsuite/tests/basic-more/opaque_prim.ml
new file mode 100644
index 00000000..bdb60250
--- /dev/null
+++ b/testsuite/tests/basic-more/opaque_prim.ml
@@ -0,0 +1,10 @@
+(* TEST
+   include testing
+*)
+
+let f x = Sys.opaque_identity x
+
+let () =
+  assert(f f == f);
+  assert(Sys.opaque_identity 1 = 1);
+  assert(Sys.opaque_identity 1. = 1.)
diff --git a/testsuite/tests/basic-more/opaque_prim.reference b/testsuite/tests/basic-more/opaque_prim.reference
new file mode 100644
index 00000000..197c9280
--- /dev/null
+++ b/testsuite/tests/basic-more/opaque_prim.reference
@@ -0,0 +1,2 @@
+
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/pr1271.ml b/testsuite/tests/basic-more/pr1271.ml
new file mode 100644
index 00000000..adbb8734
--- /dev/null
+++ b/testsuite/tests/basic-more/pr1271.ml
@@ -0,0 +1,292 @@
+(* TEST
+   include testing
+*)
+
+(* GPR#1271 *)
+
+module F (X : sig val x : int end) = struct
+  let rec f1 y = f270 (X.x + y)
+  and f2 y = (f1 [@inlined never]) y
+  and f3 y = (f2 [@inlined never]) y
+  and f4 y = (f3 [@inlined never]) y
+  and f5 y = (f4 [@inlined never]) y
+  and f6 y = (f5 [@inlined never]) y
+  and f7 y = (f6 [@inlined never]) y
+  and f8 y = (f7 [@inlined never]) y
+  and f9 y = (f8 [@inlined never]) y
+  and f10 y = (f9 [@inlined never]) y
+  and f11 y = (f10 [@inlined never]) y
+  and f12 y = (f11 [@inlined never]) y
+  and f13 y = (f12 [@inlined never]) y
+  and f14 y = (f13 [@inlined never]) y
+  and f15 y = (f14 [@inlined never]) y
+  and f16 y = (f15 [@inlined never]) y
+  and f17 y = (f16 [@inlined never]) y
+  and f18 y = (f17 [@inlined never]) y
+  and f19 y = (f18 [@inlined never]) y
+  and f20 y = (f19 [@inlined never]) y
+  and f21 y = (f20 [@inlined never]) y
+  and f22 y = (f21 [@inlined never]) y
+  and f23 y = (f22 [@inlined never]) y
+  and f24 y = (f23 [@inlined never]) y
+  and f25 y = (f24 [@inlined never]) y
+  and f26 y = (f25 [@inlined never]) y
+  and f27 y = (f26 [@inlined never]) y
+  and f28 y = (f27 [@inlined never]) y
+  and f29 y = (f28 [@inlined never]) y
+  and f30 y = (f29 [@inlined never]) y
+  and f31 y = (f30 [@inlined never]) y
+  and f32 y = (f31 [@inlined never]) y
+  and f33 y = (f32 [@inlined never]) y
+  and f34 y = (f33 [@inlined never]) y
+  and f35 y = (f34 [@inlined never]) y
+  and f36 y = (f35 [@inlined never]) y
+  and f37 y = (f36 [@inlined never]) y
+  and f38 y = (f37 [@inlined never]) y
+  and f39 y = (f38 [@inlined never]) y
+  and f40 y = (f39 [@inlined never]) y
+  and f41 y = (f40 [@inlined never]) y
+  and f42 y = (f41 [@inlined never]) y
+  and f43 y = (f42 [@inlined never]) y
+  and f44 y = (f43 [@inlined never]) y
+  and f45 y = (f44 [@inlined never]) y
+  and f46 y = (f45 [@inlined never]) y
+  and f47 y = (f46 [@inlined never]) y
+  and f48 y = (f47 [@inlined never]) y
+  and f49 y = (f48 [@inlined never]) y
+  and f50 y = (f49 [@inlined never]) y
+  and f51 y = (f50 [@inlined never]) y
+  and f52 y = (f51 [@inlined never]) y
+  and f53 y = (f52 [@inlined never]) y
+  and f54 y = (f53 [@inlined never]) y
+  and f55 y = (f54 [@inlined never]) y
+  and f56 y = (f55 [@inlined never]) y
+  and f57 y = (f56 [@inlined never]) y
+  and f58 y = (f57 [@inlined never]) y
+  and f59 y = (f58 [@inlined never]) y
+  and f60 y = (f59 [@inlined never]) y
+  and f61 y = (f60 [@inlined never]) y
+  and f62 y = (f61 [@inlined never]) y
+  and f63 y = (f62 [@inlined never]) y
+  and f64 y = (f63 [@inlined never]) y
+  and f65 y = (f64 [@inlined never]) y
+  and f66 y = (f65 [@inlined never]) y
+  and f67 y = (f66 [@inlined never]) y
+  and f68 y = (f67 [@inlined never]) y
+  and f69 y = (f68 [@inlined never]) y
+  and f70 y = (f69 [@inlined never]) y
+  and f71 y = (f70 [@inlined never]) y
+  and f72 y = (f71 [@inlined never]) y
+  and f73 y = (f72 [@inlined never]) y
+  and f74 y = (f73 [@inlined never]) y
+  and f75 y = (f74 [@inlined never]) y
+  and f76 y = (f75 [@inlined never]) y
+  and f77 y = (f76 [@inlined never]) y
+  and f78 y = (f77 [@inlined never]) y
+  and f79 y = (f78 [@inlined never]) y
+  and f80 y = (f79 [@inlined never]) y
+  and f81 y = (f80 [@inlined never]) y
+  and f82 y = (f81 [@inlined never]) y
+  and f83 y = (f82 [@inlined never]) y
+  and f84 y = (f83 [@inlined never]) y
+  and f85 y = (f84 [@inlined never]) y
+  and f86 y = (f85 [@inlined never]) y
+  and f87 y = (f86 [@inlined never]) y
+  and f88 y = (f87 [@inlined never]) y
+  and f89 y = (f88 [@inlined never]) y
+  and f90 y = (f89 [@inlined never]) y
+  and f91 y = (f90 [@inlined never]) y
+  and f92 y = (f91 [@inlined never]) y
+  and f93 y = (f92 [@inlined never]) y
+  and f94 y = (f93 [@inlined never]) y
+  and f95 y = (f94 [@inlined never]) y
+  and f96 y = (f95 [@inlined never]) y
+  and f97 y = (f96 [@inlined never]) y
+  and f98 y = (f97 [@inlined never]) y
+  and f99 y = (f98 [@inlined never]) y
+  and f100 y = (f99 [@inlined never]) y
+  and f101 y = (f100 [@inlined never]) y
+  and f102 y = (f101 [@inlined never]) y
+  and f103 y = (f102 [@inlined never]) y
+  and f104 y = (f103 [@inlined never]) y
+  and f105 y = (f104 [@inlined never]) y
+  and f106 y = (f105 [@inlined never]) y
+  and f107 y = (f106 [@inlined never]) y
+  and f108 y = (f107 [@inlined never]) y
+  and f109 y = (f108 [@inlined never]) y
+  and f110 y = (f109 [@inlined never]) y
+  and f111 y = (f110 [@inlined never]) y
+  and f112 y = (f111 [@inlined never]) y
+  and f113 y = (f112 [@inlined never]) y
+  and f114 y = (f113 [@inlined never]) y
+  and f115 y = (f114 [@inlined never]) y
+  and f116 y = (f115 [@inlined never]) y
+  and f117 y = (f116 [@inlined never]) y
+  and f118 y = (f117 [@inlined never]) y
+  and f119 y = (f118 [@inlined never]) y
+  and f120 y = (f119 [@inlined never]) y
+  and f121 y = (f120 [@inlined never]) y
+  and f122 y = (f121 [@inlined never]) y
+  and f123 y = (f122 [@inlined never]) y
+  and f124 y = (f123 [@inlined never]) y
+  and f125 y = (f124 [@inlined never]) y
+  and f126 y = (f125 [@inlined never]) y
+  and f127 y = (f126 [@inlined never]) y
+  and f128 y = (f127 [@inlined never]) y
+  and f129 y = (f128 [@inlined never]) y
+  and f130 y = (f129 [@inlined never]) y
+  and f131 y = (f130 [@inlined never]) y
+  and f132 y = (f131 [@inlined never]) y
+  and f133 y = (f132 [@inlined never]) y
+  and f134 y = (f133 [@inlined never]) y
+  and f135 y = (f134 [@inlined never]) y
+  and f136 y = (f135 [@inlined never]) y
+  and f137 y = (f136 [@inlined never]) y
+  and f138 y = (f137 [@inlined never]) y
+  and f139 y = (f138 [@inlined never]) y
+  and f140 y = (f139 [@inlined never]) y
+  and f141 y = (f140 [@inlined never]) y
+  and f142 y = (f141 [@inlined never]) y
+  and f143 y = (f142 [@inlined never]) y
+  and f144 y = (f143 [@inlined never]) y
+  and f145 y = (f144 [@inlined never]) y
+  and f146 y = (f145 [@inlined never]) y
+  and f147 y = (f146 [@inlined never]) y
+  and f148 y = (f147 [@inlined never]) y
+  and f149 y = (f148 [@inlined never]) y
+  and f150 y = (f149 [@inlined never]) y
+  and f151 y = (f150 [@inlined never]) y
+  and f152 y = (f151 [@inlined never]) y
+  and f153 y = (f152 [@inlined never]) y
+  and f154 y = (f153 [@inlined never]) y
+  and f155 y = (f154 [@inlined never]) y
+  and f156 y = (f155 [@inlined never]) y
+  and f157 y = (f156 [@inlined never]) y
+  and f158 y = (f157 [@inlined never]) y
+  and f159 y = (f158 [@inlined never]) y
+  and f160 y = (f159 [@inlined never]) y
+  and f161 y = (f160 [@inlined never]) y
+  and f162 y = (f161 [@inlined never]) y
+  and f163 y = (f162 [@inlined never]) y
+  and f164 y = (f163 [@inlined never]) y
+  and f165 y = (f164 [@inlined never]) y
+  and f166 y = (f165 [@inlined never]) y
+  and f167 y = (f166 [@inlined never]) y
+  and f168 y = (f167 [@inlined never]) y
+  and f169 y = (f168 [@inlined never]) y
+  and f170 y = (f169 [@inlined never]) y
+  and f171 y = (f170 [@inlined never]) y
+  and f172 y = (f171 [@inlined never]) y
+  and f173 y = (f172 [@inlined never]) y
+  and f174 y = (f173 [@inlined never]) y
+  and f175 y = (f174 [@inlined never]) y
+  and f176 y = (f175 [@inlined never]) y
+  and f177 y = (f176 [@inlined never]) y
+  and f178 y = (f177 [@inlined never]) y
+  and f179 y = (f178 [@inlined never]) y
+  and f180 y = (f179 [@inlined never]) y
+  and f181 y = (f180 [@inlined never]) y
+  and f182 y = (f181 [@inlined never]) y
+  and f183 y = (f182 [@inlined never]) y
+  and f184 y = (f183 [@inlined never]) y
+  and f185 y = (f184 [@inlined never]) y
+  and f186 y = (f185 [@inlined never]) y
+  and f187 y = (f186 [@inlined never]) y
+  and f188 y = (f187 [@inlined never]) y
+  and f189 y = (f188 [@inlined never]) y
+  and f190 y = (f189 [@inlined never]) y
+  and f191 y = (f190 [@inlined never]) y
+  and f192 y = (f191 [@inlined never]) y
+  and f193 y = (f192 [@inlined never]) y
+  and f194 y = (f193 [@inlined never]) y
+  and f195 y = (f194 [@inlined never]) y
+  and f196 y = (f195 [@inlined never]) y
+  and f197 y = (f196 [@inlined never]) y
+  and f198 y = (f197 [@inlined never]) y
+  and f199 y = (f198 [@inlined never]) y
+  and f200 y = (f199 [@inlined never]) y
+  and f201 y = (f200 [@inlined never]) y
+  and f202 y = (f201 [@inlined never]) y
+  and f203 y = (f202 [@inlined never]) y
+  and f204 y = (f203 [@inlined never]) y
+  and f205 y = (f204 [@inlined never]) y
+  and f206 y = (f205 [@inlined never]) y
+  and f207 y = (f206 [@inlined never]) y
+  and f208 y = (f207 [@inlined never]) y
+  and f209 y = (f208 [@inlined never]) y
+  and f210 y = (f209 [@inlined never]) y
+  and f211 y = (f210 [@inlined never]) y
+  and f212 y = (f211 [@inlined never]) y
+  and f213 y = (f212 [@inlined never]) y
+  and f214 y = (f213 [@inlined never]) y
+  and f215 y = (f214 [@inlined never]) y
+  and f216 y = (f215 [@inlined never]) y
+  and f217 y = (f216 [@inlined never]) y
+  and f218 y = (f217 [@inlined never]) y
+  and f219 y = (f218 [@inlined never]) y
+  and f220 y = (f219 [@inlined never]) y
+  and f221 y = (f220 [@inlined never]) y
+  and f222 y = (f221 [@inlined never]) y
+  and f223 y = (f222 [@inlined never]) y
+  and f224 y = (f223 [@inlined never]) y
+  and f225 y = (f224 [@inlined never]) y
+  and f226 y = (f225 [@inlined never]) y
+  and f227 y = (f226 [@inlined never]) y
+  and f228 y = (f227 [@inlined never]) y
+  and f229 y = (f228 [@inlined never]) y
+  and f230 y = (f229 [@inlined never]) y
+  and f231 y = (f230 [@inlined never]) y
+  and f232 y = (f231 [@inlined never]) y
+  and f233 y = (f232 [@inlined never]) y
+  and f234 y = (f233 [@inlined never]) y
+  and f235 y = (f234 [@inlined never]) y
+  and f236 y = (f235 [@inlined never]) y
+  and f237 y = (f236 [@inlined never]) y
+  and f238 y = (f237 [@inlined never]) y
+  and f239 y = (f238 [@inlined never]) y
+  and f240 y = (f239 [@inlined never]) y
+  and f241 y = (f240 [@inlined never]) y
+  and f242 y = (f241 [@inlined never]) y
+  and f243 y = (f242 [@inlined never]) y
+  and f244 y = (f243 [@inlined never]) y
+  and f245 y = (f244 [@inlined never]) y
+  and f246 y = (f245 [@inlined never]) y
+  and f247 y = (f246 [@inlined never]) y
+  and f248 y = (f247 [@inlined never]) y
+  and f249 y = (f248 [@inlined never]) y
+  and f250 y = (f249 [@inlined never]) y
+  and f251 y = (f250 [@inlined never]) y
+  and f252 y = (f251 [@inlined never]) y
+  and f253 y = (f252 [@inlined never]) y
+  and f254 y = (f253 [@inlined never]) y
+  and f255 y = (f254 [@inlined never]) y
+  and f256 y = (f255 [@inlined never]) y
+  and f257 y = (f256 [@inlined never]) y
+  and f258 y = (f257 [@inlined never]) y
+  and f259 y = (f258 [@inlined never]) y
+  and f260 y = (f259 [@inlined never]) y
+  and f261 y = (f260 [@inlined never]) y
+  and f262 y = (f261 [@inlined never]) y
+  and f263 y = (f262 [@inlined never]) y
+  and f264 y = (f263 [@inlined never]) y
+  and f265 y = (f264 [@inlined never]) y
+  and f266 y = (f265 [@inlined never]) y
+  and f267 y = (f266 [@inlined never]) y
+  and f268 y = (f267 [@inlined never]) y
+  and f269 y = (f268 [@inlined never]) y
+  and f270 y = (f269 [@inlined never]) y
+end
+
+let words0 = Gc.minor_words ()
+let words1 = Gc.minor_words ()
+module X = F (struct let x = 42 end)
+let words2 = Gc.minor_words ()
+
+let expected = words1 -. words0
+
+let () =
+  match Sys.backend_type with
+  | Sys.Native ->
+    Printf.printf "%.0f" ((words2 -. words1) -. expected)
+  | Sys.Bytecode | Sys.Other _ ->
+    print_string "0"
diff --git a/testsuite/tests/basic-more/pr1271.reference b/testsuite/tests/basic-more/pr1271.reference
new file mode 100644
index 00000000..6e374c16
--- /dev/null
+++ b/testsuite/tests/basic-more/pr1271.reference
@@ -0,0 +1,2 @@
+0
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/pr2719.ml b/testsuite/tests/basic-more/pr2719.ml
new file mode 100644
index 00000000..cb69aeae
--- /dev/null
+++ b/testsuite/tests/basic-more/pr2719.ml
@@ -0,0 +1,21 @@
+(* TEST
+   include testing
+*)
+
+open Printf
+
+let bug () =
+  let mat = [| [|false|] |]
+  and test = ref false in
+    printf "Value of test at the beginning : %B\n" !test; flush stdout;
+    (try let _ = mat.(0).(-1) in
+       (test := true;
+        printf "Am I going through this block of instructions ?\n";
+        flush stdout)
+     with Invalid_argument _ -> printf "Value of test now : %B\n" !test
+    );
+    (try if mat.(0).(-1) then ()
+     with Invalid_argument _ -> ()
+    )
+
+let () = bug ()
diff --git a/testsuite/tests/basic-more/pr2719.reference b/testsuite/tests/basic-more/pr2719.reference
new file mode 100644
index 00000000..073d0916
--- /dev/null
+++ b/testsuite/tests/basic-more/pr2719.reference
@@ -0,0 +1,4 @@
+Value of test at the beginning : false
+Value of test now : false
+
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/pr6216.ml b/testsuite/tests/basic-more/pr6216.ml
new file mode 100644
index 00000000..3f6b4109
--- /dev/null
+++ b/testsuite/tests/basic-more/pr6216.ml
@@ -0,0 +1,17 @@
+(* TEST
+   include testing
+   ocamlopt_flags ="-inline 20"
+*)
+
+(* PR6216: wrong inlining of GADT match *)
+
+type _ t =
+ | Float : float t
+ | String : string t
+
+let f : type a . a t -> a -> unit = fun t a ->
+ match t with
+ | Float -> ()
+ | String -> ignore (String.length a : int)
+
+let _g (kind : float t) (x : float) : unit = f kind (x *. 13.)
diff --git a/testsuite/tests/basic-more/pr6216.reference b/testsuite/tests/basic-more/pr6216.reference
new file mode 100644
index 00000000..197c9280
--- /dev/null
+++ b/testsuite/tests/basic-more/pr6216.reference
@@ -0,0 +1,2 @@
+
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/pr7683.ml b/testsuite/tests/basic-more/pr7683.ml
new file mode 100644
index 00000000..ad9bb904
--- /dev/null
+++ b/testsuite/tests/basic-more/pr7683.ml
@@ -0,0 +1,10 @@
+(* TEST *)
+
+let f () n () =
+  n
+
+let g () =
+  let r = ref 0 in
+  f (incr r) !r (incr r)
+
+let () = print_int (g ())
diff --git a/testsuite/tests/basic-more/pr7683.reference b/testsuite/tests/basic-more/pr7683.reference
new file mode 100644
index 00000000..56a6051c
--- /dev/null
+++ b/testsuite/tests/basic-more/pr7683.reference
@@ -0,0 +1 @@
+1
\ No newline at end of file
diff --git a/testsuite/tests/basic-more/record_evaluation_order.ml b/testsuite/tests/basic-more/record_evaluation_order.ml
new file mode 100644
index 00000000..f8d1d568
--- /dev/null
+++ b/testsuite/tests/basic-more/record_evaluation_order.ml
@@ -0,0 +1,92 @@
+(* TEST
+   include testing
+*)
+
+type r =
+  { a : unit;
+    b : int;
+    c : char;
+    d : float; }
+
+let r1 =
+  {
+    c = (print_endline "c1"; 'c');
+    a = print_endline "a1";
+    d = (print_endline "d1"; 1.);
+    b = (print_endline "b1"; 2);
+  }
+
+let r2 =
+  {
+    b = (print_endline "b2"; 2);
+    d = (print_endline "d2"; 1.);
+    a = print_endline "a2";
+    c = (print_endline "c2"; 'c');
+  }
+
+let r3 =
+  { (print_endline "default"; r1) with
+    d = (print_endline "d3"; 1.);
+    c = (print_endline "c3"; 'c');
+    a = print_endline "a3";
+  }
+
+let () = print_endline ""
+
+type r2 =
+  { x1 : unit;
+    x2 : unit;
+    x3 : unit;
+    x4 : unit;
+    x5 : unit;
+    x6 : unit;
+    x7 : unit;
+    x8 : unit;
+    x9 : unit; }
+
+let a =
+  {
+    x5 = print_endline "x5";
+    x6 = print_endline "x6";
+    x1 = print_endline "x1";
+    x3 = print_endline "x3";
+    x4 = print_endline "x4";
+    x9 = print_endline "x9";
+    x7 = print_endline "x7";
+    x8 = print_endline "x8";
+    x2 = print_endline "x2";
+  }
+
+let () = print_endline ""
+
+let b =
+  { a with
+    x7 = print_endline "x7";
+    x2 = print_endline "x2";
+  }
+
+let () = print_endline ""
+
+let c =
+  { a with
+    x2 = print_endline "x2";
+    x7 = print_endline "x7";
+  }
+
+let () = print_endline ""
+
+let c =
+  { a with
+    x2 = print_endline "x2";
+    x7 = print_endline "x7";
+    x5 = print_endline "x5";
+  }
+
+let () = print_endline ""
+
+let d =
+  { a with
+    x5 = print_endline "x5";
+    x7 = print_endline "x7";
+    x2 = print_endline "x2";
+  }
diff --git a/testsuite/tests/basic-more/record_evaluation_order.reference b/testsuite/tests/basic-more/record_evaluation_order.reference
new file mode 100644
index 00000000..f4186851
--- /dev/null
+++ b/testsuite/tests/basic-more/record_evaluation_order.reference
@@ -0,0 +1,38 @@
+d1
+c1
+b1
+a1
+d2
+c2
+b2
+a2
+default
+d3
+c3
+a3
+
+x9
+x8
+x7
+x6
+x5
+x4
+x3
+x2
+x1
+
+x7
+x2
+
+x7
+x2
+
+x7
+x5
+x2
+
+x7
+x5
+x2
+
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/robustmatch.compilers.reference b/testsuite/tests/basic-more/robustmatch.compilers.reference
new file mode 100644
index 00000000..fc580197
--- /dev/null
+++ b/testsuite/tests/basic-more/robustmatch.compilers.reference
@@ -0,0 +1,205 @@
+File "robustmatch.ml", lines 33-37, characters 6-23:
+33 | ......match t1, t2, x with
+34 |       | AB, AB, A -> ()
+35 |       | MAB, _, A -> ()
+36 |       | _,  AB, B -> ()
+37 |       | _, MAB, B -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(AB, MAB, A)
+File "robustmatch.ml", lines 43-47, characters 4-21:
+43 | ....match t1, t2, x with
+44 |     | AB,  AB, A -> ()
+45 |     | MAB, _, A -> ()
+46 |     | _,  AB, B -> ()
+47 |     | _, MAB, B -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(AB, MAB, A)
+File "robustmatch.ml", lines 54-56, characters 4-27:
+54 | ....match r1, r2, a with
+55 |     | R1, _, 0 -> ()
+56 |     | _, R2, "coucou" -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R1, R1, 1)
+File "robustmatch.ml", lines 64-66, characters 4-27:
+64 | ....match r1, r2, a with
+65 |     | R1, _, A -> ()
+66 |     | _, R2, "coucou" -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R1, R1, (B|C))
+File "robustmatch.ml", lines 69-71, characters 4-20:
+69 | ....match r1, r2, a with
+70 |     | _, R2, "coucou" -> ()
+71 |     | R1, _, A -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R1, R1, (B|C))
+File "robustmatch.ml", lines 74-76, characters 4-20:
+74 | ....match r1, r2, a with
+75 |     | _, R2, "coucou" -> ()
+76 |     | R1, _, _ -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R2, R2, "")
+File "robustmatch.ml", lines 85-87, characters 4-20:
+85 | ....match r1, r2, a with
+86 |     | R1, _, A -> ()
+87 |     | _, R2, X -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R1, R1, (B|C))
+File "robustmatch.ml", lines 90-93, characters 4-20:
+90 | ....match r1, r2, a with
+91 |     | R1, _, A -> ()
+92 |     | _, R2, X -> ()
+93 |     | R1, _, _ -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R2, R2, (Y|Z))
+File "robustmatch.ml", lines 96-98, characters 4-20:
+96 | ....match r1, r2, a with
+97 |     | R1, _, _ -> ()
+98 |     | _, R2, X -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R2, R2, (Y|Z))
+File "robustmatch.ml", lines 107-109, characters 4-20:
+107 | ....match r1, r2, a with
+108 |     | R1, _, A -> ()
+109 |     | _, R2, X -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R1, R1, (B|C))
+File "robustmatch.ml", lines 129-131, characters 4-20:
+129 | ....match r1, r2, a with
+130 |     | R1, _, A -> ()
+131 |     | _, R2, X -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R1, R1, B)
+File "robustmatch.ml", lines 151-153, characters 4-20:
+151 | ....match r1, r2, a with
+152 |     | R1, _, A -> ()
+153 |     | _, R2, X -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R1, R1, B)
+File "robustmatch.ml", lines 156-159, characters 4-20:
+156 | ....match r1, r2, a with
+157 |     | R1, _, A -> ()
+158 |     | _, R2, X -> ()
+159 |     | R1, _, _ -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R2, R2, Y)
+File "robustmatch.ml", lines 162-164, characters 4-20:
+162 | ....match r1, r2, a with
+163 |     | R1, _, _ -> ()
+164 |     | _, R2, X -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R2, R2, Y)
+File "robustmatch.ml", lines 167-169, characters 4-20:
+167 | ....match r1, r2, a with
+168 |     | R1, _, C -> ()
+169 |     | _, R2, Y -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R1, R1, A)
+File "robustmatch.ml", lines 176-179, characters 4-20:
+176 | ....match r1, r2, a with
+177 |     | _, R1, 0 -> ()
+178 |     | R2, _, [||] -> ()
+179 |     | _, R1, 1 -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R2, R2, [| _ |])
+File "robustmatch.ml", lines 182-184, characters 4-23:
+182 | ....match r1, r2, a with
+183 |     | R1, _, _ -> ()
+184 |     | _, R2, [||] -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R2, R2, [| _ |])
+File "robustmatch.ml", lines 187-190, characters 4-20:
+187 | ....match r1, r2, a with
+188 |     | _, R2, [||] -> ()
+189 |     | R1, _, 0 -> ()
+190 |     | R1, _, _ -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R2, R2, [| _ |])
+File "robustmatch.ml", lines 200-203, characters 4-19:
+200 | ....match r1, r2, a with
+201 |     | _, R2, [||] -> ()
+202 |     | R1, _, 0 -> ()
+203 |     | _, _, _ -> ()
+Warning 4: this pattern-matching is fragile.
+It will remain exhaustive when constructors are added to type repr.
+File "robustmatch.ml", lines 210-212, characters 4-27:
+210 | ....match r1, r2, a with
+211 |     | R1, _, 'c' -> ()
+212 |     | _, R2, "coucou" -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R1, R1, 'a')
+File "robustmatch.ml", lines 219-221, characters 4-27:
+219 | ....match r1, r2, a with
+220 |     | R1, _, `A -> ()
+221 |     | _, R2, "coucou" -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R1, R1, `B)
+File "robustmatch.ml", lines 228-230, characters 4-37:
+228 | ....match r1, r2, a with
+229 |     | R1, _, (3, "") -> ()
+230 |     | _, R2, (1, "coucou", 'a') -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R1, R1, (3, "*"))
+File "robustmatch.ml", lines 239-241, characters 4-51:
+239 | ....match r1, r2, a with
+240 |     | R1, _, { x = 3; y = "" } -> ()
+241 |     | _, R2, { a = 1; b = "coucou"; c = 'a' } -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R1, R1, {x=3; y="*"})
+File "robustmatch.ml", lines 244-246, characters 4-36:
+244 | ....match r1, r2, a with
+245 |     | R2, _, { a = 1; b = "coucou"; c = 'a' } -> ()
+246 |     | _, R1, { x = 3; y = "" } -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R2, R2, {a=1; b="coucou"; c='b'})
+File "robustmatch.ml", lines 253-255, characters 4-20:
+253 | ....match r1, r2, a with
+254 |     | R1, _, (3, "") -> ()
+255 |     | _, R2, 1 -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R1, R1, (3, "*"))
+File "robustmatch.ml", lines 263-265, characters 4-20:
+263 | ....match r1, r2, a with
+264 |     | R1, _, { x = 3; y = "" } -> ()
+265 |     | _, R2, 1 -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R1, R1, {x=3; y="*"})
+File "robustmatch.ml", lines 272-274, characters 4-20:
+272 | ....match r1, r2, a with
+273 |     | R1, _, lazy 1 -> ()
+274 |     | _, R2, 1 -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R1, R1, lazy 0)
+File "robustmatch.ml", lines 281-284, characters 4-24:
+281 | ....match r1, r2, a with
+282 |     | R1, _, () -> ()
+283 |     | _, R2, "coucou" -> ()
+284 |     | _, R2, "foo" -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(R2, R2, "")
diff --git a/testsuite/tests/basic-more/robustmatch.ml b/testsuite/tests/basic-more/robustmatch.ml
new file mode 100644
index 00000000..e4768d0a
--- /dev/null
+++ b/testsuite/tests/basic-more/robustmatch.ml
@@ -0,0 +1,285 @@
+(* TEST
+   flags += "-w +4+8+9+11+12+52+56+57"
+   include testing
+*)
+
+module GPR1493 = struct
+  type t1 = { x : int; y : string; }
+  type t2 = { a : int; b : string; c : string list; }
+
+  type t = ..
+  type t += C1 of t1 | C2 of t2
+
+  let f (x : t) =
+    match x with
+    | C1 { x; y } -> ()
+    | C2 { a;b;c } -> ()
+    | _ -> ()
+end
+
+module Coherence_illustration = struct
+  type ab = A | B
+
+  module M : sig
+    type mab = A | B
+
+    type _ t = AB : ab t | MAB : mab t
+  end = struct
+    type mab = ab = A | B
+
+    type _ t = AB : ab t | MAB : mab t
+
+    let f (type x) (t1 : x t) (t2 : x t) (x : x) =
+      match t1, t2, x with
+      | AB, AB, A -> ()
+      | MAB, _, A -> ()
+      | _,  AB, B -> ()
+      | _, MAB, B -> ()
+  end
+
+  open M
+
+  let f (type x) (t1 : x t) (t2 : x t) (x : x) =
+    match t1, t2, x with
+    | AB,  AB, A -> ()
+    | MAB, _, A -> ()
+    | _,  AB, B -> ()
+    | _, MAB, B -> ()
+end
+
+module M1 = struct
+  type _ repr = R1 : int repr | R2 : string repr
+
+  let f (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, 0 -> ()
+    | _, R2, "coucou" -> ()
+end
+
+module M2 = struct
+  type c = A | B | C
+  type _ repr = R1 : c repr | R2 : string repr
+
+  let f (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, A -> ()
+    | _, R2, "coucou" -> ()
+
+  let g (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | _, R2, "coucou" -> ()
+    | R1, _, A -> ()
+
+  let h (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | _, R2, "coucou" -> ()
+    | R1, _, _ -> ()
+end
+
+module M3 = struct
+  type c1 = A | B | C
+  type c2 = X | Y | Z
+  type _ repr = R1 : c1 repr | R2 : c2 repr
+
+  let f (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, A -> ()
+    | _, R2, X -> ()
+
+  let g (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, A -> ()
+    | _, R2, X -> ()
+    | R1, _, _ -> ()
+
+  let h (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, _ -> ()
+    | _, R2, X -> ()
+end
+
+module M3_gadt = struct
+  type c1 = A | B | C
+  type _ c2 = X : int c2 | Y : char c2 | Z : char c2
+  type _ repr = R1 : c1 repr | R2 : int c2 repr
+
+  let f (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, A -> ()
+    | _, R2, X -> ()
+
+  let g (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, A -> ()
+    | _, R2, X -> ()
+    | R1, _, _ -> ()
+
+  let h (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, _ -> ()
+    | _, R2, X -> ()
+end
+
+module M3_gadt_bis = struct
+  type _ c1 = A : int c1 | B : int c1 | C : char c1
+  type _ c2 = X : int c2 | Y : char c2 | Z : char c2
+  type _ repr = R1 : int c1 repr | R2 : int c2 repr
+
+  let f (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, A -> ()
+    | _, R2, X -> ()
+
+  let g (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, A -> ()
+    | _, R2, X -> ()
+    | R1, _, B -> ()
+
+  let h (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, _ -> ()
+    | _, R2, X -> ()
+end
+
+module M3_gadt_bis_harder = struct
+  type _ c1 = A : int c1 | B : int c1 | C : char c1
+  type _ c2 = X : int c2 | Y : char c2 | Z : char c2
+  type _ repr = R1 : 'a c1 repr | R2 : 'a c2 repr
+
+  let f (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, A -> ()
+    | _, R2, X -> ()
+
+  let g (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, A -> ()
+    | _, R2, X -> ()
+    | R1, _, _ -> ()
+
+  let h (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, _ -> ()
+    | _, R2, X -> ()
+
+  let h (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, C -> ()
+    | _, R2, Y -> ()
+end
+
+module M4 = struct
+  type _ repr = R1 : int repr | R2 : int array repr
+
+  let f (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | _, R1, 0 -> ()
+    | R2, _, [||] -> ()
+    | _, R1, 1 -> ()
+
+  let g (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, _ -> ()
+    | _, R2, [||] -> ()
+
+  let h (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | _, R2, [||] -> ()
+    | R1, _, 0 -> ()
+    | R1, _, _ -> ()
+
+  let i (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | _, R2, [||] -> ()
+    | R1, _, 0 -> ()
+    | R1, _, _ -> ()
+    | _, R2, _ -> ()
+
+  let j (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | _, R2, [||] -> ()
+    | R1, _, 0 -> ()
+    | _, _, _ -> ()
+end
+
+module M5 = struct
+  type _ repr = R1 : char repr | R2 : string repr
+
+  let f (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, 'c' -> ()
+    | _, R2, "coucou" -> ()
+end
+
+module M6 = struct
+  type _ repr = R1 : [ `A | `B ] repr | R2 : string repr
+
+  let f (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, `A -> ()
+    | _, R2, "coucou" -> ()
+end
+
+module M7 = struct
+  type _ repr = R1 : (int * string) repr | R2 : (int * string * char) repr
+
+  let f (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, (3, "") -> ()
+    | _, R2, (1, "coucou", 'a') -> ()
+end
+
+module M8 = struct
+  type r1 = { x : int; y : string }
+  type r2 = { a : int; b : string; c : char }
+  type _ repr = R1 : r1 repr | R2 : r2 repr
+
+  let f (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, { x = 3; y = "" } -> ()
+    | _, R2, { a = 1; b = "coucou"; c = 'a' } -> ()
+
+  let g (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R2, _, { a = 1; b = "coucou"; c = 'a' } -> ()
+    | _, R1, { x = 3; y = "" } -> ()
+end
+
+module M9 = struct
+  type _ repr = R1 : (int * string) repr | R2 : int repr
+
+  let f (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, (3, "") -> ()
+    | _, R2, 1 -> ()
+end
+
+module M10 = struct
+  type r = { x : int; y : string }
+  type _ repr = R1 : r repr | R2 : int repr
+
+  let f (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, { x = 3; y = "" } -> ()
+    | _, R2, 1 -> ()
+end
+
+module M11 = struct
+  type _ repr = R1 : int lazy_t repr | R2 : int repr
+
+  let f (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, lazy 1 -> ()
+    | _, R2, 1 -> ()
+end
+
+module M12 = struct
+  type _ repr = R1 : unit repr | R2 : string repr
+
+  let f (type a) (r1 : a repr) (r2 : a repr) (a : a) =
+    match r1, r2, a with
+    | R1, _, () -> ()
+    | _, R2, "coucou" -> ()
+    | _, R2, "foo" -> ()
+end
diff --git a/testsuite/tests/basic-more/robustmatch.reference b/testsuite/tests/basic-more/robustmatch.reference
new file mode 100644
index 00000000..197c9280
--- /dev/null
+++ b/testsuite/tests/basic-more/robustmatch.reference
@@ -0,0 +1,2 @@
+
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/sequential_and_or.ml b/testsuite/tests/basic-more/sequential_and_or.ml
new file mode 100644
index 00000000..926cb9ab
--- /dev/null
+++ b/testsuite/tests/basic-more/sequential_and_or.ml
@@ -0,0 +1,126 @@
+(* TEST
+   include testing
+*)
+
+let r = ref 0
+
+let true_effect () =
+  incr r;
+  print_int !r; print_char ' ';
+  true
+
+let false_effect () =
+  incr r;
+  print_int !r; print_char ' ';
+  false
+
+let test i f =
+  print_int i;
+  print_string ": ";
+  print_endline (string_of_bool (f ()))
+
+let s = Bytes.of_string "\000"
+let () =
+  (* ensure that the string is not constant *)
+  Bytes.set s 0 '\001'
+
+let unknown_true =
+  Bytes.get s 0 = '\001'
+
+let unknown_false =
+  Bytes.get s 0 <> '\001'
+
+let () =
+  test 1 (fun () -> true || true);
+  test 2 (fun () -> true || false);
+  test 3 (fun () -> true || true_effect ());
+  test 4 (fun () -> true || false_effect ());
+  test 5 (fun () -> true || unknown_true);
+  test 6 (fun () -> true || unknown_false);
+  test 7 (fun () -> false || true);
+  test 8 (fun () -> false || false);
+  test 9 (fun () -> false || true_effect ());
+  test 10 (fun () -> false || false_effect ());
+  test 11 (fun () -> false || unknown_true);
+  test 12 (fun () -> false || unknown_false);
+  test 13 (fun () -> true_effect () || true);
+  test 14 (fun () -> true_effect () || false);
+  test 15 (fun () -> true_effect () || true_effect ());
+  test 16 (fun () -> true_effect () || false_effect ());
+  test 17 (fun () -> true_effect () || unknown_true);
+  test 18 (fun () -> true_effect () || unknown_false);
+  test 19 (fun () -> false_effect () || true);
+  test 20 (fun () -> false_effect () || false);
+  test 21 (fun () -> false_effect () || true_effect ());
+  test 22 (fun () -> false_effect () || false_effect ());
+  test 23 (fun () -> false_effect () || unknown_true);
+  test 24 (fun () -> false_effect () || unknown_false);
+  test 25 (fun () -> unknown_true || true);
+  test 26 (fun () -> unknown_true || false);
+  test 27 (fun () -> unknown_true || true_effect ());
+  test 28 (fun () -> unknown_true || false_effect ());
+  test 29 (fun () -> unknown_true || unknown_true);
+  test 30 (fun () -> unknown_true || unknown_false);
+  test 31 (fun () -> unknown_false || true);
+  test 32 (fun () -> unknown_false || false);
+  test 33 (fun () -> unknown_false || true_effect ());
+  test 34 (fun () -> unknown_false || false_effect ());
+  test 35 (fun () -> unknown_false || unknown_true);
+  test 36 (fun () -> unknown_false || unknown_false);
+  test 37 (fun () -> true && true);
+  test 38 (fun () -> true && false);
+  test 39 (fun () -> true && true_effect ());
+  test 40 (fun () -> true && false_effect ());
+  test 41 (fun () -> true && unknown_true);
+  test 42 (fun () -> true && unknown_false);
+  test 43 (fun () -> false && true);
+  test 44 (fun () -> false && false);
+  test 45 (fun () -> false && true_effect ());
+  test 46 (fun () -> false && false_effect ());
+  test 47 (fun () -> false && unknown_true);
+  test 48 (fun () -> false && unknown_false);
+  test 49 (fun () -> true_effect () && true);
+  test 50 (fun () -> true_effect () && false);
+  test 51 (fun () -> true_effect () && true_effect ());
+  test 52 (fun () -> true_effect () && false_effect ());
+  test 53 (fun () -> true_effect () && unknown_true);
+  test 54 (fun () -> true_effect () && unknown_false);
+  test 55 (fun () -> false_effect () && true);
+  test 56 (fun () -> false_effect () && false);
+  test 57 (fun () -> false_effect () && true_effect ());
+  test 58 (fun () -> false_effect () && false_effect ());
+  test 59 (fun () -> false_effect () && unknown_true);
+  test 60 (fun () -> false_effect () && unknown_false);
+  test 61 (fun () -> unknown_true && true);
+  test 62 (fun () -> unknown_true && false);
+  test 63 (fun () -> unknown_true && true_effect ());
+  test 64 (fun () -> unknown_true && false_effect ());
+  test 65 (fun () -> unknown_true && unknown_true);
+  test 66 (fun () -> unknown_true && unknown_false);
+  test 67 (fun () -> unknown_false && true);
+  test 68 (fun () -> unknown_false && false);
+  test 69 (fun () -> unknown_false && true_effect ());
+  test 70 (fun () -> unknown_false && false_effect ());
+  test 71 (fun () -> unknown_false && unknown_true);
+  test 72 (fun () -> unknown_false && unknown_false);
+  ()
+
+(* test generation *)
+
+(*
+let values = ["true"; "false"; "true_effect ()"; "false_effect ()";
+              "unknown_true"; "unknown_false"]
+let ops = ["||"; "&&"]
+let count = ref 0
+let f op v1 v2 =
+  incr count;
+  Printf.sprintf "  test %i (fun () -> %s %s %s);" !count v1 op v2
+
+let s =
+  List.iter (fun op ->
+      List.iter (fun v1 ->
+          List.iter (fun v2 -> print_endline (f op v1 v2))
+            values)
+        values)
+    ops
+*)
diff --git a/testsuite/tests/basic-more/sequential_and_or.reference b/testsuite/tests/basic-more/sequential_and_or.reference
new file mode 100644
index 00000000..229f1403
--- /dev/null
+++ b/testsuite/tests/basic-more/sequential_and_or.reference
@@ -0,0 +1,74 @@
+1: true
+2: true
+3: true
+4: true
+5: true
+6: true
+7: true
+8: false
+9: 1 true
+10: 2 false
+11: true
+12: false
+13: 3 true
+14: 4 true
+15: 5 true
+16: 6 true
+17: 7 true
+18: 8 true
+19: 9 true
+20: 10 false
+21: 11 12 true
+22: 13 14 false
+23: 15 true
+24: 16 false
+25: true
+26: true
+27: true
+28: true
+29: true
+30: true
+31: true
+32: false
+33: 17 true
+34: 18 false
+35: true
+36: false
+37: true
+38: false
+39: 19 true
+40: 20 false
+41: true
+42: false
+43: false
+44: false
+45: false
+46: false
+47: false
+48: false
+49: 21 true
+50: 22 false
+51: 23 24 true
+52: 25 26 false
+53: 27 true
+54: 28 false
+55: 29 false
+56: 30 false
+57: 31 false
+58: 32 false
+59: 33 false
+60: 34 false
+61: true
+62: false
+63: 35 true
+64: 36 false
+65: true
+66: false
+67: false
+68: false
+69: false
+70: false
+71: false
+72: false
+
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/structural_constants.ml b/testsuite/tests/basic-more/structural_constants.ml
new file mode 100644
index 00000000..66cff92b
--- /dev/null
+++ b/testsuite/tests/basic-more/structural_constants.ml
@@ -0,0 +1,227 @@
+(* TEST
+   include testing
+*)
+
+type t1 =
+  | A | B | C of t1 | D of float
+
+let a = [A; B; C A; C (C A); D 1.234]
+let () =
+  match Sys.opaque_identity a with
+  | [A; B; C A; C (C A); D 1.234] -> ()
+  | _ -> assert false
+
+let () =
+  match a with
+  | [A; B; C A; C (C A); D 1.234] -> ()
+  | _ -> assert false
+
+let b = [|A; B; C A; C (C A); D 1.234|]
+let () =
+  match Sys.opaque_identity b with
+  | [|A; B; C A; C (C A); D 1.234|] -> ()
+  | _ -> assert false
+
+let () =
+  match b with
+  | [|A; B; C A; C (C A); D 1.234|] -> ()
+  | _ -> assert false
+
+let c = [1.; 2.]
+let () =
+  match Sys.opaque_identity c with
+  | [1.; 2.] -> ()
+  | _ -> assert false
+
+let () =
+  match c with
+  | [1.; 2.] -> ()
+  | _ -> assert false
+
+let d = [|1.; 2.|]
+let () =
+  match Sys.opaque_identity d with
+  | [|1.; 2.|] -> ()
+  | _ -> assert false
+
+let () =
+  match d with
+  | [|1.; 2.|] -> ()
+  | _ -> assert false
+
+let long_array =
+  [|0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12;
+    13; 14; 15; 16; 17; 18; 19; 20; 21; 22; 23; 24; 25;
+    26; 27; 28; 29; 30; 31; 32; 33; 34; 35; 36; 37; 38;
+    39; 40; 41; 42; 43; 44; 45; 46; 47; 48; 49; 50; 51;
+    52; 53; 54; 55; 56; 57; 58; 59; 60; 61; 62; 63; 64;
+    65; 66; 67; 68; 69; 70; 71; 72; 73; 74; 75; 76; 77;
+    78; 79; 80; 81; 82; 83; 84; 85; 86; 87; 88; 89; 90;
+    91; 92; 93; 94; 95; 96; 97; 98; 99; 100; 101; 102; 103;
+    104; 105; 106; 107; 108; 109; 110; 111; 112; 113; 114; 115; 116;
+    117; 118; 119; 120; 121; 122; 123; 124; 125; 126; 127; 128; 129;
+    130; 131; 132; 133; 134; 135; 136; 137; 138; 139; 140; 141; 142;
+    143; 144; 145; 146; 147; 148; 149; 150; 151; 152; 153; 154; 155;
+    156; 157; 158; 159; 160; 161; 162; 163; 164; 165; 166; 167; 168;
+    169; 170; 171; 172; 173; 174; 175; 176; 177; 178; 179; 180; 181;
+    182; 183; 184; 185; 186; 187; 188; 189; 190; 191; 192; 193; 194;
+    195; 196; 197; 198; 199; 200; 201; 202; 203; 204; 205; 206; 207;
+    208; 209; 210; 211; 212; 213; 214; 215; 216; 217; 218; 219; 220;
+    221; 222; 223; 224; 225; 226; 227; 228; 229; 230; 231; 232; 233;
+    234; 235; 236; 237; 238; 239; 240; 241; 242; 243; 244; 245; 246;
+    247; 248; 249; 250; 251; 252; 253; 254; 255; 256; 257; 258; 259;
+    260; 261; 262; 263; 264; 265; 266; 267; 268; 269; 270; 271; 272;
+    273; 274; 275; 276; 277; 278; 279; 280; 281; 282; 283; 284; 285;
+    286; 287; 288; 289; 290; 291; 292; 293; 294; 295; 296; 297; 298;
+    299; 300; 301; 302; 303; 304; 305; 306; 307; 308; 309; 310; 311;
+    312; 313; 314; 315; 316; 317; 318; 319; 320; 321; 322; 323; 324;
+    325; 326; 327; 328; 329; 330; 331; 332; 333; 334; 335; 336; 337;
+    338; 339; 340; 341; 342; 343; 344; 345; 346; 347; 348; 349; 350;
+    351; 352; 353; 354; 355; 356; 357; 358; 359; 360; 361; 362; 363;
+    364; 365; 366; 367; 368; 369; 370; 371; 372; 373; 374; 375; 376;
+    377; 378; 379; 380; 381; 382; 383; 384; 385; 386; 387; 388; 389;
+    390; 391; 392; 393; 394; 395; 396; 397; 398; 399; 400; 401; 402;
+    403; 404; 405; 406; 407; 408; 409; 410; 411; 412; 413; 414; 415;
+    416; 417; 418; 419; 420; 421; 422; 423; 424; 425; 426; 427; 428;
+    429; 430; 431; 432; 433; 434; 435; 436; 437; 438; 439; 440; 441;
+    442; 443; 444; 445; 446; 447; 448; 449; 450; 451; 452; 453; 454;
+    455; 456; 457; 458; 459; 460; 461; 462; 463; 464; 465; 466; 467;
+    468; 469; 470; 471; 472; 473; 474; 475; 476; 477; 478; 479; 480;
+    481; 482; 483; 484; 485; 486; 487; 488; 489; 490; 491; 492; 493;
+    494; 495; 496; 497; 498; 499; 500; 501; 502; 503; 504; 505; 506;
+    507; 508; 509; 510; 511; 512; 513; 514; 515; 516; 517; 518; 519;
+    520; 521; 522; 523; 524; 525; 526; 527; 528; 529; 530; 531; 532;
+    533; 534; 535; 536; 537; 538; 539; 540; 541; 542; 543; 544; 545;
+    546; 547; 548; 549; 550; 551; 552; 553; 554; 555; 556; 557; 558;
+    559; 560; 561; 562; 563; 564; 565; 566; 567; 568; 569; 570; 571;
+    572; 573; 574; 575; 576; 577; 578; 579; 580; 581; 582; 583; 584;
+    585; 586; 587; 588; 589; 590; 591; 592; 593; 594; 595; 596; 597;
+    598; 599; 600; 601; 602; 603; 604; 605; 606; 607; 608; 609; 610;
+    611; 612; 613; 614; 615; 616; 617; 618; 619; 620; 621; 622; 623;
+    624; 625; 626; 627; 628; 629; 630; 631; 632; 633; 634; 635; 636;
+    637; 638; 639; 640; 641; 642; 643; 644; 645; 646; 647; 648; 649;
+    650; 651; 652; 653; 654; 655; 656; 657; 658; 659; 660; 661; 662;
+    663; 664; 665; 666; 667; 668; 669; 670; 671; 672; 673; 674; 675;
+    676; 677; 678; 679; 680; 681; 682; 683; 684; 685; 686; 687; 688;
+    689; 690; 691; 692; 693; 694; 695; 696; 697; 698; 699; 700; 701;
+    702; 703; 704; 705; 706; 707; 708; 709; 710; 711; 712; 713; 714;
+    715; 716; 717; 718; 719; 720; 721; 722; 723; 724; 725; 726; 727;
+    728; 729; 730; 731; 732; 733; 734; 735; 736; 737; 738; 739; 740;
+    741; 742; 743; 744; 745; 746; 747; 748; 749; 750; 751; 752; 753;
+    754; 755; 756; 757; 758; 759; 760; 761; 762; 763; 764; 765; 766;
+    767; 768; 769; 770; 771; 772; 773; 774; 775; 776; 777; 778; 779;
+    780; 781; 782; 783; 784; 785; 786; 787; 788; 789; 790; 791; 792;
+    793; 794; 795; 796; 797; 798; 799; 800; 801; 802; 803; 804; 805;
+    806; 807; 808; 809; 810; 811; 812; 813; 814; 815; 816; 817; 818;
+    819; 820; 821; 822; 823; 824; 825; 826; 827; 828; 829; 830; 831;
+    832; 833; 834; 835; 836; 837; 838; 839; 840; 841; 842; 843; 844;
+    845; 846; 847; 848; 849; 850; 851; 852; 853; 854; 855; 856; 857;
+    858; 859; 860; 861; 862; 863; 864; 865; 866; 867; 868; 869; 870;
+    871; 872; 873; 874; 875; 876; 877; 878; 879; 880; 881; 882; 883;
+    884; 885; 886; 887; 888; 889; 890; 891; 892; 893; 894; 895; 896;
+    897; 898; 899; 900; 901; 902; 903; 904; 905; 906; 907; 908; 909;
+    910; 911; 912; 913; 914; 915; 916; 917; 918; 919; 920; 921; 922;
+    923; 924; 925; 926; 927; 928; 929; 930; 931; 932; 933; 934; 935;
+    936; 937; 938; 939; 940; 941; 942; 943; 944; 945; 946; 947; 948;
+    949; 950; 951; 952; 953; 954; 955; 956; 957; 958; 959; 960; 961;
+    962; 963; 964; 965; 966; 967; 968; 969; 970; 971; 972; 973; 974;
+    975; 976; 977; 978; 979; 980; 981; 982; 983; 984; 985; 986; 987;
+    988; 989; 990; 991; 992; 993; 994; 995; 996; 997; 998; 999; 1000;
+    1001; 1002; 1003; 1004; 1005; 1006; 1007; 1008; 1009; 1010; 1011; 1012;
+    1013; 1014; 1015; 1016; 1017; 1018; 1019; 1020; 1021; 1022; 1023; 1024;
+    1025; 1026; 1027; 1028; 1029; 1030; 1031; 1032; 1033; 1034; 1035; 1036;
+    1037; 1038; 1039; 1040; 1041; 1042; 1043; 1044; 1045; 1046; 1047; 1048;
+    1049; 1050; 1051; 1052; 1053; 1054; 1055; 1056; 1057; 1058; 1059; 1060;
+    1061; 1062; 1063; 1064; 1065; 1066; 1067; 1068; 1069; 1070; 1071; 1072;
+    1073; 1074; 1075; 1076; 1077; 1078; 1079; 1080; 1081; 1082; 1083; 1084;
+    1085; 1086; 1087; 1088; 1089; 1090; 1091; 1092; 1093; 1094; 1095; 1096;
+    1097; 1098; 1099; 1100; 1101; 1102; 1103; 1104; 1105; 1106; 1107; 1108;
+    1109; 1110; 1111; 1112; 1113; 1114; 1115; 1116; 1117; 1118; 1119; 1120;
+    1121; 1122; 1123; 1124; 1125; 1126; 1127; 1128; 1129; 1130; 1131; 1132;
+    1133; 1134; 1135; 1136; 1137; 1138; 1139; 1140; 1141; 1142; 1143; 1144;
+    1145; 1146; 1147; 1148; 1149; 1150; 1151; 1152; 1153; 1154; 1155; 1156;
+    1157; 1158; 1159; 1160; 1161; 1162; 1163; 1164; 1165; 1166; 1167; 1168;
+    1169; 1170; 1171; 1172; 1173; 1174; 1175; 1176; 1177; 1178; 1179; 1180;
+    1181; 1182; 1183; 1184; 1185; 1186; 1187; 1188; 1189; 1190; 1191; 1192;
+    1193; 1194; 1195; 1196; 1197; 1198; 1199; 1200; 1201; 1202; 1203; 1204;
+    1205; 1206; 1207; 1208; 1209; 1210; 1211; 1212; 1213; 1214; 1215; 1216;
+    1217; 1218; 1219; 1220; 1221; 1222; 1223; 1224; 1225; 1226; 1227; 1228;
+    1229; 1230; 1231; 1232; 1233; 1234; 1235; 1236; 1237; 1238; 1239; 1240;
+    1241; 1242; 1243; 1244; 1245; 1246; 1247; 1248; 1249; 1250; 1251; 1252;
+    1253; 1254; 1255; 1256; 1257; 1258; 1259; 1260; 1261; 1262; 1263; 1264;
+    1265; 1266; 1267; 1268; 1269; 1270; 1271; 1272; 1273; 1274; 1275; 1276;
+    1277; 1278; 1279; 1280; 1281; 1282; 1283; 1284; 1285; 1286; 1287; 1288;
+    1289; 1290; 1291; 1292; 1293; 1294; 1295; 1296; 1297; 1298; 1299; 1300;
+    1301; 1302; 1303; 1304; 1305; 1306; 1307; 1308; 1309; 1310; 1311; 1312;
+    1313; 1314; 1315; 1316; 1317; 1318; 1319; 1320; 1321; 1322; 1323; 1324;
+    1325; 1326; 1327; 1328; 1329; 1330; 1331; 1332; 1333; 1334; 1335; 1336;
+    1337; 1338; 1339; 1340; 1341; 1342; 1343; 1344; 1345; 1346; 1347; 1348;
+    1349; 1350; 1351; 1352; 1353; 1354; 1355; 1356; 1357; 1358; 1359; 1360;
+    1361; 1362; 1363; 1364; 1365; 1366; 1367; 1368; 1369; 1370; 1371; 1372;
+    1373; 1374; 1375; 1376; 1377; 1378; 1379; 1380; 1381; 1382; 1383; 1384;
+    1385; 1386; 1387; 1388; 1389; 1390; 1391; 1392; 1393; 1394; 1395; 1396;
+    1397; 1398; 1399; 1400; 1401; 1402; 1403; 1404; 1405; 1406; 1407; 1408;
+    1409; 1410; 1411; 1412; 1413; 1414; 1415; 1416; 1417; 1418; 1419; 1420;
+    1421; 1422; 1423; 1424; 1425; 1426; 1427; 1428; 1429; 1430; 1431; 1432;
+    1433; 1434; 1435; 1436; 1437; 1438; 1439; 1440; 1441; 1442; 1443; 1444;
+    1445; 1446; 1447; 1448; 1449; 1450; 1451; 1452; 1453; 1454; 1455; 1456;
+    1457; 1458; 1459; 1460; 1461; 1462; 1463; 1464; 1465; 1466; 1467; 1468;
+    1469; 1470; 1471; 1472; 1473; 1474; 1475; 1476; 1477; 1478; 1479; 1480;
+    1481; 1482; 1483; 1484; 1485; 1486; 1487; 1488; 1489; 1490; 1491; 1492;
+    1493; 1494; 1495; 1496; 1497; 1498; 1499; 1500; 1501; 1502; 1503; 1504;
+    1505; 1506; 1507; 1508; 1509; 1510; 1511; 1512; 1513; 1514; 1515; 1516;
+    1517; 1518; 1519; 1520; 1521; 1522; 1523; 1524; 1525; 1526; 1527; 1528;
+    1529; 1530; 1531; 1532; 1533; 1534; 1535; 1536; 1537; 1538; 1539; 1540;
+    1541; 1542; 1543; 1544; 1545; 1546; 1547; 1548; 1549; 1550; 1551; 1552;
+    1553; 1554; 1555; 1556; 1557; 1558; 1559; 1560; 1561; 1562; 1563; 1564;
+    1565; 1566; 1567; 1568; 1569; 1570; 1571; 1572; 1573; 1574; 1575; 1576;
+    1577; 1578; 1579; 1580; 1581; 1582; 1583; 1584; 1585; 1586; 1587; 1588;
+    1589; 1590; 1591; 1592; 1593; 1594; 1595; 1596; 1597; 1598; 1599; 1600;
+    1601; 1602; 1603; 1604; 1605; 1606; 1607; 1608; 1609; 1610; 1611; 1612;
+    1613; 1614; 1615; 1616; 1617; 1618; 1619; 1620; 1621; 1622; 1623; 1624;
+    1625; 1626; 1627; 1628; 1629; 1630; 1631; 1632; 1633; 1634; 1635; 1636;
+    1637; 1638; 1639; 1640; 1641; 1642; 1643; 1644; 1645; 1646; 1647; 1648;
+    1649; 1650; 1651; 1652; 1653; 1654; 1655; 1656; 1657; 1658; 1659; 1660;
+    1661; 1662; 1663; 1664; 1665; 1666; 1667; 1668; 1669; 1670; 1671; 1672;
+    1673; 1674; 1675; 1676; 1677; 1678; 1679; 1680; 1681; 1682; 1683; 1684;
+    1685; 1686; 1687; 1688; 1689; 1690; 1691; 1692; 1693; 1694; 1695; 1696;
+    1697; 1698; 1699; 1700; 1701; 1702; 1703; 1704; 1705; 1706; 1707; 1708;
+    1709; 1710; 1711; 1712; 1713; 1714; 1715; 1716; 1717; 1718; 1719; 1720;
+    1721; 1722; 1723; 1724; 1725; 1726; 1727; 1728; 1729; 1730; 1731; 1732;
+    1733; 1734; 1735; 1736; 1737; 1738; 1739; 1740; 1741; 1742; 1743; 1744;
+    1745; 1746; 1747; 1748; 1749; 1750; 1751; 1752; 1753; 1754; 1755; 1756;
+    1757; 1758; 1759; 1760; 1761; 1762; 1763; 1764; 1765; 1766; 1767; 1768;
+    1769; 1770; 1771; 1772; 1773; 1774; 1775; 1776; 1777; 1778; 1779; 1780;
+    1781; 1782; 1783; 1784; 1785; 1786; 1787; 1788; 1789; 1790; 1791; 1792;
+    1793; 1794; 1795; 1796; 1797; 1798; 1799; 1800; 1801; 1802; 1803; 1804;
+    1805; 1806; 1807; 1808; 1809; 1810; 1811; 1812; 1813; 1814; 1815; 1816;
+    1817; 1818; 1819; 1820; 1821; 1822; 1823; 1824; 1825; 1826; 1827; 1828;
+    1829; 1830; 1831; 1832; 1833; 1834; 1835; 1836; 1837; 1838; 1839; 1840;
+    1841; 1842; 1843; 1844; 1845; 1846; 1847; 1848; 1849; 1850; 1851; 1852;
+    1853; 1854; 1855; 1856; 1857; 1858; 1859; 1860; 1861; 1862; 1863; 1864;
+    1865; 1866; 1867; 1868; 1869; 1870; 1871; 1872; 1873; 1874; 1875; 1876;
+    1877; 1878; 1879; 1880; 1881; 1882; 1883; 1884; 1885; 1886; 1887; 1888;
+    1889; 1890; 1891; 1892; 1893; 1894; 1895; 1896; 1897; 1898; 1899; 1900;
+    1901; 1902; 1903; 1904; 1905; 1906; 1907; 1908; 1909; 1910; 1911; 1912;
+    1913; 1914; 1915; 1916; 1917; 1918; 1919; 1920; 1921; 1922; 1923; 1924;
+    1925; 1926; 1927; 1928; 1929; 1930; 1931; 1932; 1933; 1934; 1935; 1936;
+    1937; 1938; 1939; 1940; 1941; 1942; 1943; 1944; 1945; 1946; 1947; 1948;
+    1949; 1950; 1951; 1952; 1953; 1954; 1955; 1956; 1957; 1958; 1959; 1960;
+    1961; 1962; 1963; 1964; 1965; 1966; 1967; 1968; 1969; 1970; 1971; 1972;
+    1973; 1974; 1975; 1976; 1977; 1978; 1979; 1980; 1981; 1982; 1983; 1984;
+    1985; 1986; 1987; 1988; 1989; 1990; 1991; 1992; 1993; 1994; 1995; 1996;
+    1997; 1998; 1999; 2000; 2001; 2002; 2003; 2004; 2005; 2006; 2007; 2008;
+    2009; 2010; 2011; 2012; 2013; 2014; 2015; 2016; 2017; 2018; 2019; 2020;
+    2021; 2022; 2023; 2024; 2025; 2026; 2027; 2028; 2029; 2030; 2031; 2032;
+    2033; 2034; 2035; 2036; 2037; 2038; 2039; 2040; 2041; 2042; 2043; 2044;
+    2045; 2046; 2047; 2048; 2049; 2050; 2051; 2052; 2053; 2054; 2055; 2056;
+    2057; 2058; 2059; 2060; 2061; 2062; 2063; 2064; 2065; 2066; 2067; 2068;
+    2069; 2070; 2071; 2072; 2073; 2074; 2075; 2076; 2077; 2078; 2079; 2080;
+    2081; 2082; 2083; 2084; 2085; 2086; 2087; 2088; 2089; 2090; 2091; 2092;
+    2093; 2094; |]
+
+let () =
+  let long_array = Sys.opaque_identity long_array in
+  for i = 0 to Array.length long_array - 1 do
+    assert(long_array.(i) = i)
+  done
diff --git a/testsuite/tests/basic-more/structural_constants.reference b/testsuite/tests/basic-more/structural_constants.reference
new file mode 100644
index 00000000..197c9280
--- /dev/null
+++ b/testsuite/tests/basic-more/structural_constants.reference
@@ -0,0 +1,2 @@
+
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/tbuffer.ml b/testsuite/tests/basic-more/tbuffer.ml
new file mode 100644
index 00000000..c3f96b73
--- /dev/null
+++ b/testsuite/tests/basic-more/tbuffer.ml
@@ -0,0 +1,30 @@
+(* TEST
+   include testing
+*)
+
+(* Dummy substitute function. *)
+
+open Testing;;
+open Buffer;;
+
+let identity s = s;;
+
+let b = Buffer.create 100;;
+
+(* Pattern with a '\\' character in it. *)
+let pat0 = "\\\\a" in
+let n0 = String.length pat0 in
+
+Buffer.add_substitute b identity pat0;
+
+test (String.length (Buffer.contents b) = n0)
+;;
+
+(* Pattern with a '\\' character at the end. *)
+let pat1 = "b\\" in
+let n1 = String.length pat1 in
+
+Buffer.clear b;
+Buffer.add_substitute b identity pat1;
+test (String.length (Buffer.contents b) = n1)
+;;
diff --git a/testsuite/tests/basic-more/tbuffer.reference b/testsuite/tests/basic-more/tbuffer.reference
new file mode 100644
index 00000000..f0f68347
--- /dev/null
+++ b/testsuite/tests/basic-more/tbuffer.reference
@@ -0,0 +1,2 @@
+ 0 1
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/testrandom.ml b/testsuite/tests/basic-more/testrandom.ml
new file mode 100644
index 00000000..dd4a76b3
--- /dev/null
+++ b/testsuite/tests/basic-more/testrandom.ml
@@ -0,0 +1,16 @@
+(* TEST
+   include testing
+*)
+
+open Random
+
+let _ =
+  for i = 0 to 20 do
+    print_char ' '; print_int (int 1000);
+  done;
+  print_newline ();  print_newline ();
+  for i = 0 to 20 do
+    print_char ' '; print_float (float 1000.);
+  done
+
+let _ = exit 0
diff --git a/testsuite/tests/basic-more/testrandom.reference b/testsuite/tests/basic-more/testrandom.reference
new file mode 100644
index 00000000..943addd1
--- /dev/null
+++ b/testsuite/tests/basic-more/testrandom.reference
@@ -0,0 +1,4 @@
+ 344 685 182 641 439 500 104 20 921 370 217 885 949 678 615 412 401 606 428 869 289
+
+ 122.128067547 461.324792129 360.006556146 768.75882284 396.500946942 190.217751234 567.660068681 403.59226778 59.8488223602 363.816246826 764.705761642 172.627051105 481.861849093 399.173195422 629.424106752 391.547032203 676.701133948 174.382120878 994.425675487 585.00027757 34.3270777955
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/top_level_patterns.ml b/testsuite/tests/basic-more/top_level_patterns.ml
new file mode 100644
index 00000000..aca641fc
--- /dev/null
+++ b/testsuite/tests/basic-more/top_level_patterns.ml
@@ -0,0 +1,11 @@
+(* TEST
+   include testing
+*)
+
+type t =
+  | A of (int * int * int)
+  | B of int * int
+
+let (A (a, _, b) | B (b, a)) = A (1, 2, 3)
+
+let () = print_int a; print_int b
diff --git a/testsuite/tests/basic-more/top_level_patterns.reference b/testsuite/tests/basic-more/top_level_patterns.reference
new file mode 100644
index 00000000..93efd505
--- /dev/null
+++ b/testsuite/tests/basic-more/top_level_patterns.reference
@@ -0,0 +1,2 @@
+13
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/tprintf.ml b/testsuite/tests/basic-more/tprintf.ml
new file mode 100644
index 00000000..e1cb4c0a
--- /dev/null
+++ b/testsuite/tests/basic-more/tprintf.ml
@@ -0,0 +1,79 @@
+(* TEST
+   include testing
+*)
+
+open Testing;;
+
+open Printf;;
+
+(* Padding floating point numbers.
+   Testing * width specifications. *)
+let test0 () =
+  sprintf "%.0f" 1.0 = "1" &&
+  sprintf "%.0f." 1.7 = "2." &&
+  sprintf "%.1f." 1.0 = "1.0." &&
+  (*sprintf "%0.1f." 12.0 = "12.0." &&*)
+    (* >> '0' w/o padding *)
+  sprintf "%3.1f." 12.0 = "12.0." &&
+  sprintf "%5.1f." 12.0 = " 12.0." &&
+  sprintf "%10.1f." 12.0 = "      12.0." &&
+  sprintf "%010.1f." 12.0 = "00000012.0." &&
+  sprintf "% 10.1f." 12.0 = "      12.0." &&
+  sprintf "%+10.1f." 12.0 = "     +12.0." &&
+  sprintf "%+10.1f." (-12.0) = "     -12.0." &&
+
+  sprintf "%010.5f." 12.0 = "0012.00000." &&
+  sprintf "%010.0f." 12.0 = "0000000012." &&
+  sprintf "% 10.0f." 12.0 = "        12." &&
+
+  (*sprintf "%0.1f." 12.0 = "12.0." &&*)
+    (* >> '0' w/o padding *)
+  sprintf "%10.1f." 1.001 = "       1.0." &&
+  sprintf "%05.1f." 1.001 = "001.0."
+;;
+
+test (test0 ());;
+
+(* Padding integers (cf bug 3955).
+   Testing * width specifications. *)
+let test1 () =
+  sprintf "%d\n" 1 = "1\n" &&
+  sprintf "%05d\n" 1 = "00001\n" &&
+  sprintf "%*d\n" 5 1 = "    1\n" &&
+  sprintf "%0*d\n" 5 1 = "00001\n";;
+
+test (test1 ());;
+
+(* FIXME: when positional specification will be OK. *)
+let test2 () = true
+(*  sprintf "%1$d\n" 5 1 = "    1\n" &&
+  sprintf "%01$d\n" 5 1 = "00001\n" *);;
+
+test (test2 ());;
+
+(* Testing meta format string printing. *)
+let test3 () =
+  sprintf "%{toto %S titi.\n%}" "Bonjour %S." = "%s" &&
+  sprintf "%{Bonjour %S.%}" "toto %S titi.\n" = "%s"
+;;
+test (test3 ());;
+
+(* Testing meta format string arguments. *)
+let test4 () =
+  sprintf "%(%s%)" "Bonjour %s" "toto" = "Bonjour toto" &&
+  sprintf "%(%s%)" "Bonjour %s." "vous" = "Bonjour vous." &&
+  sprintf "%(%s%)" "Hello %s." "you" = "Hello you."
+;;
+
+test (test4 ());;
+
+let test5 () =
+  sprintf "%(toto %s titi.\n%)"
+    "Bonjour %s." "vous" = "Bonjour vous." &&
+  sprintf "%(toto %s titi.\n%).\n"
+    "Bonjour %s" "toto" = "Bonjour toto.\n" &&
+  sprintf "%(toto %s titi.\n%)%s\n"
+    "Bonjour %s." "toto" " Ca va?" = "Bonjour toto. Ca va?\n"
+;;
+
+test (test5 ());;
diff --git a/testsuite/tests/basic-more/tprintf.reference b/testsuite/tests/basic-more/tprintf.reference
new file mode 100644
index 00000000..1fb209d4
--- /dev/null
+++ b/testsuite/tests/basic-more/tprintf.reference
@@ -0,0 +1,2 @@
+ 0 1 2 3 4 5
+All tests succeeded.
diff --git a/testsuite/tests/basic-multdef/multdef.ml b/testsuite/tests/basic-multdef/multdef.ml
new file mode 100644
index 00000000..46869c45
--- /dev/null
+++ b/testsuite/tests/basic-multdef/multdef.ml
@@ -0,0 +1,2 @@
+let f x = x + 1
+external g : string -> int = "caml_int_of_string"
diff --git a/testsuite/tests/basic-multdef/multdef.mli b/testsuite/tests/basic-multdef/multdef.mli
new file mode 100644
index 00000000..8d67a548
--- /dev/null
+++ b/testsuite/tests/basic-multdef/multdef.mli
@@ -0,0 +1,3 @@
+val f : int -> int
+val f : int -> int
+val g : string -> int
diff --git a/testsuite/tests/basic-multdef/usemultdef.ml b/testsuite/tests/basic-multdef/usemultdef.ml
new file mode 100644
index 00000000..477cf4ce
--- /dev/null
+++ b/testsuite/tests/basic-multdef/usemultdef.ml
@@ -0,0 +1,5 @@
+(* TEST
+  modules = "multdef.ml"
+*)
+
+let _ = print_int(Multdef.f 1); print_newline(); exit 0
diff --git a/testsuite/tests/basic-multdef/usemultdef.reference b/testsuite/tests/basic-multdef/usemultdef.reference
new file mode 100644
index 00000000..0cfbf088
--- /dev/null
+++ b/testsuite/tests/basic-multdef/usemultdef.reference
@@ -0,0 +1 @@
+2
diff --git a/testsuite/tests/basic-private/length.ml b/testsuite/tests/basic-private/length.ml
new file mode 100644
index 00000000..c36e6702
--- /dev/null
+++ b/testsuite/tests/basic-private/length.ml
@@ -0,0 +1,16 @@
+(*
+
+A testbed file for private type abbreviation definitions.
+
+We define a Length module to implement positive integers.
+
+*)
+
+type t = int;;
+
+let make x =
+  if x >= 0 then x else
+  failwith (Printf.sprintf "cannot build negative length : %i" x)
+;;
+
+external from : t -> int = "%identity";;
diff --git a/testsuite/tests/basic-private/length.mli b/testsuite/tests/basic-private/length.mli
new file mode 100644
index 00000000..67d055db
--- /dev/null
+++ b/testsuite/tests/basic-private/length.mli
@@ -0,0 +1,13 @@
+(*
+
+A testbed file for private type abbreviation definitions.
+
+We define a Length module to implement positive integers.
+
+*)
+
+type t = private int;;
+
+val make : int -> t;;
+
+external from : t -> int = "%identity";;
diff --git a/testsuite/tests/basic-private/tlength.ml b/testsuite/tests/basic-private/tlength.ml
new file mode 100644
index 00000000..00ce4cc8
--- /dev/null
+++ b/testsuite/tests/basic-private/tlength.ml
@@ -0,0 +1,27 @@
+(* TEST
+  modules = "length.ml"
+*)
+
+(*
+
+A testbed file for private type abbreviation definitions.
+
+We test the Length module that implements positive integers.
+
+*)
+
+(* We can build a null length. *)
+let l = Length.make 0;;
+
+
+(* We cannot build a negative length. *)
+try ignore (Length.make (-1)); assert false with
+| Failure _ -> ()
+;;
+
+
+(* We can build a positive length. *)
+let l3 = Length.make 3 in
+
+(* and use the associated injection and projection functions. *)
+Length.make (Length.from l3 + Length.from l3);;
diff --git a/testsuite/tests/basic-private/tlength.reference b/testsuite/tests/basic-private/tlength.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/basic/arrays.ml b/testsuite/tests/basic/arrays.ml
new file mode 100644
index 00000000..83cc796c
--- /dev/null
+++ b/testsuite/tests/basic/arrays.ml
@@ -0,0 +1,139 @@
+(* TEST *)
+
+let bigarray n = [|
+n+0; n+1; n+2; n+3; n+4; n+5; n+6; n+7; n+8; n+9; n+10; n+11; n+12;
+n+13; n+14; n+15; n+16; n+17; n+18; n+19; n+20; n+21; n+22; n+23;
+n+24; n+25; n+26; n+27; n+28; n+29; n+30; n+31; n+32; n+33; n+34;
+n+35; n+36; n+37; n+38; n+39; n+40; n+41; n+42; n+43; n+44; n+45;
+n+46; n+47; n+48; n+49; n+50; n+51; n+52; n+53; n+54; n+55; n+56;
+n+57; n+58; n+59; n+60; n+61; n+62; n+63; n+64; n+65; n+66; n+67;
+n+68; n+69; n+70; n+71; n+72; n+73; n+74; n+75; n+76; n+77; n+78;
+n+79; n+80; n+81; n+82; n+83; n+84; n+85; n+86; n+87; n+88; n+89;
+n+90; n+91; n+92; n+93; n+94; n+95; n+96; n+97; n+98; n+99; n+100;
+n+101; n+102; n+103; n+104; n+105; n+106; n+107; n+108; n+109; n+110;
+n+111; n+112; n+113; n+114; n+115; n+116; n+117; n+118; n+119; n+120;
+n+121; n+122; n+123; n+124; n+125; n+126; n+127; n+128; n+129; n+130;
+n+131; n+132; n+133; n+134; n+135; n+136; n+137; n+138; n+139; n+140;
+n+141; n+142; n+143; n+144; n+145; n+146; n+147; n+148; n+149; n+150;
+n+151; n+152; n+153; n+154; n+155; n+156; n+157; n+158; n+159; n+160;
+n+161; n+162; n+163; n+164; n+165; n+166; n+167; n+168; n+169; n+170;
+n+171; n+172; n+173; n+174; n+175; n+176; n+177; n+178; n+179; n+180;
+n+181; n+182; n+183; n+184; n+185; n+186; n+187; n+188; n+189; n+190;
+n+191; n+192; n+193; n+194; n+195; n+196; n+197; n+198; n+199; n+200;
+n+201; n+202; n+203; n+204; n+205; n+206; n+207; n+208; n+209; n+210;
+n+211; n+212; n+213; n+214; n+215; n+216; n+217; n+218; n+219; n+220;
+n+221; n+222; n+223; n+224; n+225; n+226; n+227; n+228; n+229; n+230;
+n+231; n+232; n+233; n+234; n+235; n+236; n+237; n+238; n+239; n+240;
+n+241; n+242; n+243; n+244; n+245; n+246; n+247; n+248; n+249; n+250;
+n+251; n+252; n+253; n+254; n+255; n+256; n+257; n+258; n+259; n+260;
+n+261; n+262; n+263; n+264; n+265; n+266; n+267; n+268; n+269; n+270;
+n+271; n+272; n+273; n+274; n+275; n+276; n+277; n+278; n+279; n+280;
+n+281; n+282; n+283; n+284; n+285; n+286; n+287; n+288; n+289; n+290;
+n+291; n+292; n+293; n+294; n+295; n+296; n+297; n+298; n+299
+|]
+
+let test1 () =
+  let a = bigarray 12345 in
+  Gc.full_major();
+  for i = 0 to Array.length a - 1 do
+    if a.(i) <> 12345 + i then print_string "Test1: error\n"
+  done
+
+let testcopy a =
+  Array.copy a = a
+
+let test2 () =
+  if not (testcopy [|1;2;3;4;5|]) then
+    print_string "Test2: failed on int array\n";
+  if not (testcopy [|1.2;2.3;3.4;4.5|]) then
+    print_string "Test2: failed on float array\n";
+  if not (testcopy [|"un"; "deux"; "trois"|]) then
+    print_string "Test2: failed on string array\n";
+  if not (testcopy (bigarray 42)) then
+    print_string "Test2: failed on big array\n"
+
+module AbstractFloat =
+  (struct
+    type t = float
+    let to_float x = x
+    let from_float x = x
+   end :
+   sig
+    type t
+    val to_float: t -> float
+    val from_float: float -> t
+   end)
+
+let test3 () =
+  let t1 = AbstractFloat.from_float 1.0
+  and t2 = AbstractFloat.from_float 2.0
+  and t3 = AbstractFloat.from_float 3.0 in
+  let v = [|t1;t2;t3|] in
+  let w = Array.make 2 t1 in
+  let u = Array.copy v in
+  if not (AbstractFloat.to_float v.(0) = 1.0 &&
+          AbstractFloat.to_float v.(1) = 2.0 &&
+          AbstractFloat.to_float v.(2) = 3.0) then
+    print_string "Test3: failed on v\n";
+  if not (AbstractFloat.to_float w.(0) = 1.0 &&
+          AbstractFloat.to_float w.(1) = 1.0) then
+    print_string "Test3: failed on w\n";
+  if not (AbstractFloat.to_float u.(0) = 1.0 &&
+          AbstractFloat.to_float u.(1) = 2.0 &&
+          AbstractFloat.to_float u.(2) = 3.0) then
+    print_string "Test3: failed on u\n"
+
+let test4 () =
+  let a = bigarray 0 in
+  let b = Array.sub a 50 10 in
+  if b <> [| 50;51;52;53;54;55;56;57;58;59 |] then
+    print_string "Test4: failed\n"
+
+let test5 () =
+  if Array.append [| 1;2;3 |] [| 4;5 |] <> [| 1;2;3;4;5 |] then
+    print_string "Test5: failed on int arrays\n";
+  if Array.append [| 1.0;2.0;3.0 |] [| 4.0;5.0 |] <> [| 1.0;2.0;3.0;4.0;5.0 |]
+  then
+    print_string "Test5: failed on float arrays\n"
+
+let test6 () =
+  let a = [| 0;1;2;3;4;5;6;7;8;9 |] in
+  let b = Array.concat [a;a;a;a;a;a;a;a;a;a] in
+  if not (Array.length b = 100 && b.(6) = 6 && b.(42) = 2 && b.(99) = 9) then
+    print_string "Test6: failed\n"
+
+let test7 () =
+  let a = Array.make 10 "a" in
+  let b = [| "b1"; "b2"; "b3" |] in
+  Array.blit b 0 a 5 3;
+  if a <> [|"a"; "a"; "a"; "a"; "a"; "b1"; "b2"; "b3"; "a"; "a"|]
+  || b <> [|"b1"; "b2"; "b3"|]
+  then print_string "Test7: failed(1)\n";
+  Array.blit a 5 a 6 4;
+  if a <> [|"a"; "a"; "a"; "a"; "a"; "b1"; "b1"; "b2"; "b3"; "a"|]
+  then print_string "Test7: failed(2)\n"
+
+let test8 () =
+  (try
+    ignore (Array.sub [||] 0 1); print_string "Test 8.1: failed\n"
+  with Invalid_argument _ -> ());
+  (try
+    ignore (Array.sub [|3;4|] 1 (-1)); print_string "Test 8.2: failed\n"
+  with Invalid_argument _ -> ());
+  (try
+    ignore (Array.sub [|3;4|] max_int 1); print_string "Test 8.3: failed\n"
+  with Invalid_argument _ -> ());
+  (try
+    ignore (Array.sub [|3;4|] (-1) 1); print_string "Test 8.4: failed\n"
+  with Invalid_argument _ -> ())
+
+let _ =
+  test1();
+  test2();
+  test3();
+  test4();
+  test5();
+  test6();
+  test7();
+  test8();
+  exit 0
diff --git a/testsuite/tests/basic/arrays.reference b/testsuite/tests/basic/arrays.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/basic/bigints.ml b/testsuite/tests/basic/bigints.ml
new file mode 100644
index 00000000..281c1b09
--- /dev/null
+++ b/testsuite/tests/basic/bigints.ml
@@ -0,0 +1,27 @@
+(* TEST *)
+
+let _ =
+  match Sys.word_size with
+  | 32 ->
+     print_int (1 * 1000000000); print_newline();
+     print_string "10000000000"; print_newline();
+     print_string "100000000000"; print_newline();
+     print_string "1000000000000"; print_newline();
+     print_string "10000000000000"; print_newline();
+     print_string "100000000000000"; print_newline();
+     print_string "1000000000000000"; print_newline();
+     print_string "10000000000000000"; print_newline();
+     print_string "100000000000000000"; print_newline();
+     print_string "1000000000000000000"; print_newline();
+  | 64 ->
+     print_int (1 * 1000000000); print_newline();
+     print_int (10 * 1000000000); print_newline();
+     print_int (100 * 1000000000); print_newline();
+     print_int (1000 * 1000000000); print_newline();
+     print_int (10000 * 1000000000); print_newline();
+     print_int (100000 * 1000000000); print_newline();
+     print_int (1000000 * 1000000000); print_newline();
+     print_int (10000000 * 1000000000); print_newline();
+     print_int (100000000 * 1000000000); print_newline();
+     print_int (1000000000 * 1000000000); print_newline()
+  | _ -> assert false
diff --git a/testsuite/tests/basic/bigints.reference b/testsuite/tests/basic/bigints.reference
new file mode 100644
index 00000000..512fd476
--- /dev/null
+++ b/testsuite/tests/basic/bigints.reference
@@ -0,0 +1,10 @@
+1000000000
+10000000000
+100000000000
+1000000000000
+10000000000000
+100000000000000
+1000000000000000
+10000000000000000
+100000000000000000
+1000000000000000000
diff --git a/testsuite/tests/basic/boxedints.ml b/testsuite/tests/basic/boxedints.ml
new file mode 100644
index 00000000..8705dbb8
--- /dev/null
+++ b/testsuite/tests/basic/boxedints.ml
@@ -0,0 +1,651 @@
+(* TEST *)
+
+(* Test the types nativeint, int32, int64 *)
+
+open Printf
+
+let error_occurred = ref false
+
+let function_tested = ref ""
+
+let testing_function s =
+    function_tested := s;
+    print_newline();
+    print_string s;
+    print_newline()
+
+let test test_number answer correct_answer =
+ flush stdout;
+ flush stderr;
+ if answer <> correct_answer then begin
+   eprintf "*** Bad result (%s, test %d)\n" !function_tested test_number;
+   flush stderr;
+   error_occurred := true
+ end else begin
+   printf " %d..." test_number
+ end
+
+(***** Tests on 32 bit arithmetic *****)
+
+module type TESTSIG = sig
+  type t
+  module Ops : sig
+    val neg: t -> t
+    val add: t -> t -> t
+    val sub: t -> t -> t
+    val mul: t -> t -> t
+    val div: t -> t -> t
+    val unsigned_div: t -> t -> t
+    val rem: t -> t -> t
+    val logand: t -> t -> t
+    val logor: t -> t -> t
+    val logxor: t -> t -> t
+    val shift_left: t -> int -> t
+    val shift_right: t -> int -> t
+    val shift_right_logical: t -> int -> t
+    val of_int: int -> t
+    val to_int: t -> int
+    val unsigned_to_int: t -> int option
+    val of_float: float -> t
+    val to_float: t -> float
+    val zero: t
+    val one: t
+    val minus_one: t
+    val min_int: t
+    val max_int: t
+    val format : string -> t -> string
+    val to_string: t -> string
+    val of_string: string -> t
+  end
+  val testcomp: t -> t -> bool*bool*bool*bool*bool*bool*int*int
+  val skip_float_tests: bool
+end
+
+module Test32(M: TESTSIG) =
+struct
+  open M
+  open Ops
+
+  let _ =
+    testing_function "of_int, to_int";
+    test 1 (to_int (of_int 0)) 0;
+    test 2 (to_int (of_int 123)) 123;
+    test 3 (to_int (of_int (-456))) (-456);
+    test 4 (to_int (of_int 0x3FFFFFFF)) 0x3FFFFFFF;
+    test 5 (to_int (of_int (-0x40000000))) (-0x40000000);
+
+    testing_function "unsigned_to_int";
+    test 1 (unsigned_to_int (of_int 0)) (Some 0);
+    test 2 (unsigned_to_int (of_int 123)) (Some 123);
+    test 3 (unsigned_to_int minus_one)
+      (match Sys.word_size with
+       | 32 -> None
+       | 64 -> Some (int_of_string "0xFFFFFFFF")
+       | _ -> assert false);
+    test 4 (unsigned_to_int max_int)
+      (match Sys.word_size with
+       | 32 -> None
+       | 64 -> Some (to_int max_int)
+       | _ -> assert false);
+    test 5 (unsigned_to_int min_int)
+      (match Sys.word_size with
+       | 32 -> None
+       | 64 -> Some (int_of_string "0x80000000")
+       | _ -> assert false);
+    test 6 (unsigned_to_int (of_int Stdlib.max_int))
+      (match Sys.word_size with
+       | 32 -> Some Stdlib.max_int
+       | 64 -> Some (int_of_string "0xFFFFFFFF")
+       | _ -> assert false);
+
+    testing_function "of_string";
+    test 1 (of_string "0") (of_int 0);
+    test 2 (of_string "123") (of_int 123);
+    test 3 (of_string "-456") (of_int (-456));
+    test 4 (of_string "123456789") (of_int 123456789);
+    test 5 (of_string "0xABCDEF") (of_int 0xABCDEF);
+    test 6 (of_string "-0o1234567012") (of_int (- 0o1234567012));
+    test 7 (of_string "0b01010111111000001100")
+           (of_int 0b01010111111000001100);
+    test 8 (of_string "0x7FFFFFFF") max_int;
+    test 9 (of_string "-0x80000000") min_int;
+    test 10 (of_string "0x80000000") min_int;
+    test 11 (of_string "0xFFFFFFFF") minus_one;
+
+    testing_function "to_string, format";
+    List.iter (fun (n, s) -> test n (to_string (of_string s)) s)
+      [1, "0"; 2, "123"; 3, "-456"; 4, "1234567890";
+       5, "1073741824"; 6, "2147483647"; 7, "-2147483648"];
+    List.iter (fun (n, s) -> test n (format "0x%X" (of_string s)) s)
+      [8, "0x0"; 9, "0x123"; 10, "0xABCDEF"; 11, "0x12345678";
+       12, "0x7FFFFFFF"; 13, "0x80000000"; 14, "0xFFFFFFFF"];
+    test 15 (to_string max_int) "2147483647";
+    test 16 (to_string min_int) "-2147483648";
+    test 17 (to_string zero) "0";
+    test 18 (to_string one) "1";
+    test 19 (to_string minus_one) "-1";
+
+    testing_function "neg";
+    test 1 (neg (of_int 0)) (of_int 0);
+    test 2 (neg (of_int 123)) (of_int (-123));
+    test 3 (neg (of_int (-456))) (of_int 456);
+    test 4 (neg (of_int 123456789)) (of_int (-123456789));
+    test 5 (neg max_int) (of_string "-0x7FFFFFFF");
+    test 6 (neg min_int) min_int;
+
+    testing_function "add";
+    test 1 (add (of_int 0) (of_int 0)) (of_int 0);
+    test 2 (add (of_int 123) (of_int 0)) (of_int 123);
+    test 3 (add (of_int 0) (of_int 456)) (of_int 456);
+    test 4 (add (of_int 123) (of_int 456)) (of_int 579);
+    test 5 (add (of_int (-123)) (of_int 456)) (of_int 333);
+    test 6 (add (of_int 123) (of_int (-456))) (of_int (-333));
+    test 7 (add (of_int (-123)) (of_int (-456))) (of_int (-579));
+    test 8 (add (of_string "0x12345678") (of_string "0x9ABCDEF"))
+           (of_string "0x1be02467");
+    test 9 (add max_int max_int) (of_int (-2));
+    test 10 (add min_int min_int) zero;
+    test 11 (add max_int one) min_int;
+    test 12 (add min_int minus_one) max_int;
+    test 13 (add max_int min_int) minus_one;
+
+    testing_function "sub";
+    test 1 (sub (of_int 0) (of_int 0)) (of_int 0);
+    test 2 (sub (of_int 123) (of_int 0)) (of_int 123);
+    test 3 (sub (of_int 0) (of_int 456)) (of_int (-456));
+    test 4 (sub (of_int 123) (of_int 456)) (of_int (-333));
+    test 5 (sub (of_int (-123)) (of_int 456)) (of_int (-579));
+    test 6 (sub (of_int 123) (of_int (-456))) (of_int 579);
+    test 7 (sub (of_int (-123)) (of_int (-456))) (of_int 333);
+    test 8 (sub (of_string "0x12345678") (of_string "0x9ABCDEF"))
+           (of_string "0x8888889");
+    test 9 (sub max_int min_int) minus_one;
+    test 10 (sub min_int max_int) one;
+    test 11 (sub min_int one) max_int;
+    test 12 (sub max_int minus_one) min_int;
+
+    testing_function "mul";
+    test 1 (mul (of_int 0) (of_int 0)) (of_int 0);
+    test 2 (mul (of_int 123) (of_int 0)) (of_int 0);
+    test 3 (mul (of_int 0) (of_int (-456))) (of_int 0);
+    test 4 (mul (of_int 123) (of_int 1)) (of_int 123);
+    test 5 (mul (of_int 1) (of_int (-456))) (of_int (-456));
+    test 6 (mul (of_int 123) (of_int (-1))) (of_int (-123));
+    test 7 (mul (of_int (-1)) (of_int (-456))) (of_int 456);
+    test 8 (mul (of_int 123) (of_int 456)) (of_int 56088);
+    test 9 (mul (of_int (-123)) (of_int 456)) (of_int (-56088));
+    test 10 (mul (of_int 123) (of_int (-456))) (of_int (-56088));
+    test 11 (mul (of_int (-123)) (of_int (-456))) (of_int 56088);
+    test 12 (mul (of_string "0x12345678") (of_string "0x9ABCDEF"))
+            (of_string "0xe242d208");
+    test 13 (mul max_int max_int) one;
+
+    testing_function "div";
+    List.iter
+      (fun (n, a, b) -> test n (div (of_int a) (of_int b)) (of_int (a / b)))
+      [1, 0, 2;
+       2, 123, 1;
+       3, -123, 1;
+       4, 123, -1;
+       5, -123, -1;
+       6, 127531236, 365;
+       7, 16384, 256;
+       8, -127531236, 365;
+       9, 127531236, -365;
+       10, 1234567, 12345678;
+       11, 1234567, -12345678];
+    test 12 (div min_int (of_int (-1))) min_int;
+
+    testing_function "unsigned_div";
+    List.iter
+      (fun (n, a, b, c) -> test n (unsigned_div a b) c)
+      [1, of_int 0, of_int 2, of_int 0;
+       2, of_int 123, of_int 1, of_int 123;
+       3, of_int (-123), of_int 1, of_int (-123);
+       4, of_int (123), of_int (-1), of_int 0;
+       5, of_int (-123), of_int (-1), of_int 0;
+       6, of_int 127531236, of_int 365, of_int (127531236/365);
+       7, of_int 16384, of_int 256, of_int (16384/256);
+       8, of_int (-1), of_int 2, max_int;
+       9, of_int (-1), max_int, of_int 2;
+       10, min_int, of_int 2, shift_left (of_int 1) 30;
+       11, of_int (-1), of_int 8, shift_right_logical (of_int (-1)) 3];
+
+    testing_function "mod";
+    List.iter
+      (fun (n, a, b) -> test n (rem (of_int a) (of_int b)) (of_int (a mod b)))
+      [1, 0, 2;
+       2, 123, 1;
+       3, -123, 1;
+       4, 123, -1;
+       5, -123, -1;
+       6, 127531236, 365;
+       7, 16384, 256;
+       8, -127531236, 365;
+       9, 127531236, -365;
+       10, 1234567, 12345678;
+       11, 1234567, -12345678];
+    test 12 (rem min_int (of_int (-1))) (of_int 0);
+
+    testing_function "and";
+    List.iter
+      (fun (n, a, b, c) -> test n (logand (of_string a) (of_string b))
+                                  (of_string c))
+      [1, "0x12345678", "0x9abcdef0", "0x12345670";
+       2, "0x12345678", "0x0fedcba9", "0x2244228";
+       3, "0xFFFFFFFF", "0x12345678", "0x12345678";
+       4, "0", "0x12345678", "0";
+       5, "0x55555555", "0xAAAAAAAA", "0"];
+
+    testing_function "or";
+    List.iter
+      (fun (n, a, b, c) -> test n (logor (of_string a) (of_string b))
+                                  (of_string c))
+      [1, "0x12345678", "0x9abcdef0", "0x9abcdef8";
+       2, "0x12345678", "0x0fedcba9", "0x1ffddff9";
+       3, "0xFFFFFFFF", "0x12345678", "0xFFFFFFFF";
+       4, "0", "0x12345678", "0x12345678";
+       5, "0x55555555", "0xAAAAAAAA", "0xFFFFFFFF"];
+
+    testing_function "xor";
+    List.iter
+      (fun (n, a, b, c) -> test n (logxor (of_string a) (of_string b))
+                                  (of_string c))
+      [1, "0x12345678", "0x9abcdef0", "0x88888888";
+       2, "0x12345678", "0x0fedcba9", "0x1dd99dd1";
+       3, "0xFFFFFFFF", "0x12345678", "0xedcba987";
+       4, "0", "0x12345678", "0x12345678";
+       5, "0x55555555", "0xAAAAAAAA", "0xFFFFFFFF"];
+
+    testing_function "shift_left";
+    List.iter
+      (fun (n, a, b, c) -> test n (shift_left (of_string a) b) (of_string c))
+      [1, "1", 1, "2";
+       2, "1", 2, "4";
+       3, "1", 4, "0x10";
+       4, "1", 30, "0x40000000";
+       5, "1", 31, "0x80000000";
+       6, "0x16236", 7, "0xb11b00";
+       7, "0x10", 27, "0x80000000";
+       8, "0x10", 28, "0"];
+
+    testing_function "shift_right";
+    List.iter
+      (fun (n, a, b, c) -> test n (shift_right (of_string a) b) (of_string c))
+      [1, "2", 1, "1";
+       2, "4", 2, "1";
+       3, "0x10", 4, "1";
+       4, "0x40000000", 10, "0x100000";
+       5, "0x80000000", 31, "-1";
+       6, "0xb11b00", 7, "0x16236";
+       7, "-0xb11b00", 7, "-90678"];
+
+    testing_function "shift_right_logical";
+    List.iter
+      (fun (n, a, b, c) -> test n (shift_right_logical (of_string a) b)
+                                  (of_string c))
+      [1, "2", 1, "1";
+       2, "4", 2, "1";
+       3, "0x10", 4, "1";
+       4, "0x40000000", 10, "0x100000";
+       5, "0x80000000", 31, "1";
+       6, "0xb11b00", 7, "0x16236";
+       7, "-0xb11b00", 7, "0x1fe9dca"];
+
+    if not (skip_float_tests) then begin
+      testing_function "of_float";
+      test 1 (of_float 0.0) (of_int 0);
+      test 2 (of_float 123.0) (of_int 123);
+      test 3 (of_float 123.456) (of_int 123);
+      test 4 (of_float 123.999) (of_int 123);
+      test 5 (of_float (-456.0)) (of_int (-456));
+      test 6 (of_float (-456.123)) (of_int (-456));
+      test 7 (of_float (-456.789)) (of_int (-456));
+
+      testing_function "to_float";
+      test 1 (to_float (of_int 0)) 0.0;
+      test 2 (to_float (of_int 123)) 123.0;
+      test 3 (to_float (of_int (-456))) (-456.0);
+      test 4 (to_float (of_int 0x3FFFFFFF)) 1073741823.0;
+      test 5 (to_float (of_int (-0x40000000))) (-1073741824.0)
+    end;
+
+    testing_function "Comparisons";
+    test 1 (testcomp (of_int 0) (of_int 0))
+           (true,false,false,false,true,true,0,0);
+    test 2 (testcomp (of_int 1234567) (of_int 1234567))
+           (true,false,false,false,true,true,0, 0);
+    test 3 (testcomp (of_int 0) (of_int 1))
+           (false,true,true,false,true,false,-1,-1);
+    test 4 (testcomp (of_int (-1)) (of_int 0))
+           (false,true,true,false,true,false,-1,1);
+    test 5 (testcomp (of_int 1) (of_int 0))
+           (false,true,false,true,false,true,1,1);
+    test 6 (testcomp (of_int 0) (of_int (-1)))
+           (false,true,false,true,false,true,1,-1);
+    test 7 (testcomp max_int min_int)
+           (false,true,false,true,false,true,1,-1);
+
+    ()
+end
+
+(********* Tests on 64-bit arithmetic ***********)
+
+module Test64(M: TESTSIG) =
+struct
+  open M
+  open Ops
+
+  let _ =
+    testing_function "of_int, to_int";
+    test 1 (to_int (of_int 0)) 0;
+    test 2 (to_int (of_int 123)) 123;
+    test 3 (to_int (of_int (-456))) (-456);
+    test 4 (to_int (of_int 0x3FFFFFFF)) 0x3FFFFFFF;
+    test 5 (to_int (of_int (-0x40000000))) (-0x40000000);
+
+    testing_function "unsigned_to_int";
+    test 1 (unsigned_to_int (of_int 0)) (Some 0);
+    test 2 (unsigned_to_int (of_int 123)) (Some 123);
+    test 3 (unsigned_to_int minus_one) None;
+    test 4 (unsigned_to_int max_int) None;
+    test 5 (unsigned_to_int min_int) None;
+    test 6 (unsigned_to_int (of_int Stdlib.max_int))
+      (Some Stdlib.max_int);
+
+    testing_function "of_string";
+    test 1 (of_string "0") (of_int 0);
+    test 2 (of_string "123") (of_int 123);
+    test 3 (of_string "-456") (of_int (-456));
+    test 4 (of_string "123456789") (of_int 123456789);
+    test 5 (of_string "0xABCDEF") (of_int 0xABCDEF);
+    test 6 (of_string "-0o1234567012") (of_int (- 0o1234567012));
+    test 7 (of_string "0b01010111111000001100")
+           (of_int 0b01010111111000001100);
+    test 8 (of_string "0x7FFFFFFFFFFFFFFF") max_int;
+    test 9 (of_string "-0x8000000000000000") min_int;
+    test 10 (of_string "0x8000000000000000") min_int;
+    test 11 (of_string "0xFFFFFFFFFFFFFFFF") minus_one;
+
+    testing_function "to_string, format";
+    List.iter (fun (n, s) -> test n (to_string (of_string s)) s)
+      [1, "0"; 2, "123"; 3, "-456"; 4, "1234567890";
+       5, "1234567890123456789";
+       6, "9223372036854775807";
+       7, "-9223372036854775808"];
+    List.iter (fun (n, s) -> test n ("0x" ^ format "%X" (of_string s)) s)
+      [8, "0x0"; 9, "0x123"; 10, "0xABCDEF"; 11, "0x1234567812345678";
+       12, "0x7FFFFFFFFFFFFFFF"; 13, "0x8000000000000000";
+       14, "0xFFFFFFFFFFFFFFFF"];
+    test 15 (to_string max_int) "9223372036854775807";
+    test 16 (to_string min_int) "-9223372036854775808";
+    test 17 (to_string zero) "0";
+    test 18 (to_string one) "1";
+    test 19 (to_string minus_one) "-1";
+
+    testing_function "neg";
+    test 1 (neg (of_int 0)) (of_int 0);
+    test 2 (neg (of_int 123)) (of_int (-123));
+    test 3 (neg (of_int (-456))) (of_int 456);
+    test 4 (neg (of_int 123456789)) (of_int (-123456789));
+    test 5 (neg max_int) (of_string "-0x7FFFFFFFFFFFFFFF");
+    test 6 (neg min_int) min_int;
+
+    testing_function "add";
+    test 1 (add (of_int 0) (of_int 0)) (of_int 0);
+    test 2 (add (of_int 123) (of_int 0)) (of_int 123);
+    test 3 (add (of_int 0) (of_int 456)) (of_int 456);
+    test 4 (add (of_int 123) (of_int 456)) (of_int 579);
+    test 5 (add (of_int (-123)) (of_int 456)) (of_int 333);
+    test 6 (add (of_int 123) (of_int (-456))) (of_int (-333));
+    test 7 (add (of_int (-123)) (of_int (-456))) (of_int (-579));
+    test 8 (add (of_string "0x1234567812345678")
+                (of_string "0x9ABCDEF09ABCDEF"))
+           (of_string "0x1be024671be02467");
+    test 9 (add max_int max_int) (of_int (-2));
+    test 10 (add min_int min_int) zero;
+    test 11 (add max_int one) min_int;
+    test 12 (add min_int minus_one) max_int;
+    test 13 (add max_int min_int) minus_one;
+
+    testing_function "sub";
+    test 1 (sub (of_int 0) (of_int 0)) (of_int 0);
+    test 2 (sub (of_int 123) (of_int 0)) (of_int 123);
+    test 3 (sub (of_int 0) (of_int 456)) (of_int (-456));
+    test 4 (sub (of_int 123) (of_int 456)) (of_int (-333));
+    test 5 (sub (of_int (-123)) (of_int 456)) (of_int (-579));
+    test 6 (sub (of_int 123) (of_int (-456))) (of_int 579);
+    test 7 (sub (of_int (-123)) (of_int (-456))) (of_int 333);
+    test 8 (sub (of_string "0x1234567812345678")
+                (of_string "0x9ABCDEF09ABCDEF"))
+           (of_string "0x888888908888889");
+    test 9 (sub max_int min_int) minus_one;
+    test 10 (sub min_int max_int) one;
+    test 11 (sub min_int one) max_int;
+    test 12 (sub max_int minus_one) min_int;
+
+    testing_function "mul";
+    test 1 (mul (of_int 0) (of_int 0)) (of_int 0);
+    test 2 (mul (of_int 123) (of_int 0)) (of_int 0);
+    test 3 (mul (of_int 0) (of_int (-456))) (of_int 0);
+    test 4 (mul (of_int 123) (of_int 1)) (of_int 123);
+    test 5 (mul (of_int 1) (of_int (-456))) (of_int (-456));
+    test 6 (mul (of_int 123) (of_int (-1))) (of_int (-123));
+    test 7 (mul (of_int (-1)) (of_int (-456))) (of_int 456);
+    test 8 (mul (of_int 123) (of_int 456)) (of_int 56088);
+    test 9 (mul (of_int (-123)) (of_int 456)) (of_int (-56088));
+    test 10 (mul (of_int 123) (of_int (-456))) (of_int (-56088));
+    test 11 (mul (of_int (-123)) (of_int (-456))) (of_int 56088);
+    test 12 (mul (of_string "0x12345678") (of_string "0x9ABCDEF"))
+           (of_string "0xb00ea4e242d208");
+    test 13 (mul max_int max_int) one;
+
+    testing_function "div";
+    List.iter
+      (fun (n, a, b) -> test n (div (of_int a) (of_int b)) (of_int (a / b)))
+      [1, 0, 2;
+       2, 123, 1;
+       3, -123, 1;
+       4, 123, -1;
+       5, -123, -1;
+       6, 127531236, 365;
+       7, 16384, 256;
+       8, -127531236, 365;
+       9, 127531236, -365;
+       10, 1234567, 12345678;
+       11, 1234567, -12345678];
+    test 12 (div min_int (of_int (-1))) min_int;
+
+    testing_function "unsigned_div";
+    List.iter
+      (fun (n, a, b, c) -> test n (unsigned_div a b) c)
+      [1, of_int 0, of_int 2, of_int 0;
+       2, of_int 123, of_int 1, of_int 123;
+       3, of_int (-123), of_int 1, of_int (-123);
+       4, of_int (123), of_int (-1), of_int 0;
+       5, of_int (-123), of_int (-1), of_int 0;
+       6, of_int 127531236, of_int 365, of_int (127531236/365);
+       7, of_int 16384, of_int 256, of_int (16384/256);
+       8, of_int (-1), of_int 2, max_int;
+       9, of_int (-1), max_int, of_int 2;
+       10, min_int, of_int 2, shift_left (of_int 1) 62;
+       11, of_int (-1), of_int 8, shift_right_logical (of_int (-1)) 3];
+
+    testing_function "mod";
+    List.iter
+      (fun (n, a, b) -> test n (rem (of_int a) (of_int b)) (of_int (a mod b)))
+      [1, 0, 2;
+       2, 123, 1;
+       3, -123, 1;
+       4, 123, -1;
+       5, -123, -1;
+       6, 127531236, 365;
+       7, 16384, 256;
+       8, -127531236, 365;
+       9, 127531236, -365;
+       10, 1234567, 12345678;
+       11, 1234567, -12345678];
+    test 12 (rem min_int (of_int (-1))) (of_int 0);
+
+    testing_function "and";
+    List.iter
+      (fun (n, a, b, c) -> test n (logand (of_string a) (of_string b))
+                                  (of_string c))
+      [1, "0x1234567812345678", "0x9abcdef09abcdef0", "0x1234567012345670";
+       2, "0x1234567812345678", "0x0fedcba90fedcba9", "0x224422802244228";
+       3, "0xFFFFFFFFFFFFFFFF", "0x1234000012345678", "0x1234000012345678";
+       4, "0", "0x1234567812345678", "0";
+       5, "0x5555555555555555", "0xAAAAAAAAAAAAAAAA", "0"];
+
+    testing_function "or";
+    List.iter
+      (fun (n, a, b, c) -> test n (logor (of_string a) (of_string b))
+                                  (of_string c))
+      [1, "0x1234567812345678", "0x9abcdef09abcdef0", "0x9abcdef89abcdef8";
+       2, "0x1234567812345678", "0x0fedcba90fedcba9", "0x1ffddff91ffddff9";
+       3, "0xFFFFFFFFFFFFFFFF", "0x12345678", "0xFFFFFFFFFFFFFFFF";
+       4, "0", "0x1234567812340000", "0x1234567812340000";
+       5, "0x5555555555555555", "0xAAAAAAAAAAAAAAAA", "0xFFFFFFFFFFFFFFFF"];
+
+    testing_function "xor";
+    List.iter
+      (fun (n, a, b, c) -> test n (logxor (of_string a) (of_string b))
+                                  (of_string c))
+      [1, "0x1234567812345678", "0x9abcdef09abcdef0", "0x8888888888888888";
+       2, "0x1234567812345678", "0x0fedcba90fedcba9", "0x1dd99dd11dd99dd1";
+       3, "0xFFFFFFFFFFFFFFFF", "0x123456789ABCDEF", "0xfedcba9876543210";
+       4, "0", "0x1234567812340000", "0x1234567812340000";
+       5, "0x5555555555555555", "0xAAAAAAAAAAAAAAAA", "0xFFFFFFFFFFFFFFFF"];
+
+    testing_function "shift_left";
+    List.iter
+      (fun (n, a, b, c) -> test n (shift_left (of_string a) b) (of_string c))
+      [1, "1", 1, "2";
+       2, "1", 2, "4";
+       3, "1", 4, "0x10";
+       4, "1", 62, "0x4000000000000000";
+       5, "1", 63, "0x8000000000000000";
+       6, "0x16236ABD45673", 7, "0xb11b55ea2b3980";
+       7, "0x10", 59, "0x8000000000000000";
+       8, "0x10", 60, "0"];
+
+    testing_function "shift_right";
+    List.iter
+      (fun (n, a, b, c) -> test n (shift_right (of_string a) b) (of_string c))
+      [1, "2", 1, "1";
+       2, "4", 2, "1";
+       3, "0x10", 4, "1";
+       4, "0x40000000", 10, "0x100000";
+       5, "0x8000000000000000", 63, "-1";
+       6, "0xb11b55ea2b3980", 7, "0x16236ABD45673";
+       7, "-0xb11b55ea2b3980", 7, "-389461927286387"];
+
+    testing_function "shift_right_logical";
+    List.iter
+      (fun (n, a, b, c) -> test n (shift_right_logical (of_string a) b)
+                                  (of_string c))
+      [1, "2", 1, "1";
+       2, "4", 2, "1";
+       3, "0x10", 4, "1";
+       4, "0x40000000", 10, "0x100000";
+       5, "0x8000000000000000", 63, "1";
+       6, "0xb11b55ea2b3980", 7, "0x16236ABD45673";
+       7, "-0xb11b55ea2b3980", 7, "0x1fe9dc9542ba98d"];
+
+    testing_function "Comparisons";
+    test 1 (testcomp (of_int 0) (of_int 0))
+           (true,false,false,false,true,true,0,0);
+    test 2 (testcomp (of_int 1234567) (of_int 1234567))
+           (true,false,false,false,true,true,0,0);
+    test 3 (testcomp (of_int 0) (of_int 1))
+           (false,true,true,false,true,false,-1,-1);
+    test 4 (testcomp (of_int (-1)) (of_int 0))
+           (false,true,true,false,true,false,-1,1);
+    test 5 (testcomp (of_int 1) (of_int 0))
+           (false,true,false,true,false,true,1,1);
+    test 6 (testcomp (of_int 0) (of_int (-1)))
+           (false,true,false,true,false,true,1,-1);
+    test 7 (testcomp max_int min_int)
+           (false,true,false,true,false,true,1,-1);
+
+    ()
+end
+
+(******** The test proper **********)
+
+let testcomp_int32 (a : int32) (b : int32) =
+  (a = b, a <> b, a < b, a > b, a <= b, a >= b, compare a b,
+   Int32.unsigned_compare a b)
+let testcomp_int64 (a : int64) (b : int64) =
+  (a = b, a <> b, a < b, a > b, a <= b, a >= b, compare a b,
+   Int64.unsigned_compare a b)
+let testcomp_nativeint (a : nativeint) (b : nativeint) =
+  (a = b, a <> b, a < b, a > b, a <= b, a >= b, compare a b,
+   Nativeint.unsigned_compare a b)
+
+let _ =
+  testing_function "-------- Int32 --------";
+  let module A = Test32(struct type t = int32
+                               module Ops = Int32
+                               let testcomp = testcomp_int32
+                               let skip_float_tests = false end) in
+  print_newline(); testing_function "-------- Int64 --------";
+  let module B = Test64(struct type t = int64
+                               module Ops = Int64
+                               let testcomp = testcomp_int64
+                               let skip_float_tests = false end) in
+  print_newline(); testing_function "-------- Nativeint --------";
+  begin match Sys.word_size with
+    32 ->
+      let module C =
+        Test32(struct type t = nativeint
+                      module Ops = Nativeint
+                      let testcomp = testcomp_nativeint
+                      let skip_float_tests = true end)
+      in ()
+  | 64 ->
+      let module C =
+        Test64(struct type t = nativeint
+                      module Ops = Nativeint
+                      let testcomp = testcomp_nativeint
+                      let skip_float_tests = true end)
+      in ()
+  | _ ->
+      assert false
+  end;
+  print_newline(); testing_function "--------- Conversions -----------";
+  testing_function "nativeint of/to int32";
+  test 1 (Nativeint.of_int32 (Int32.of_string "0x12345678"))
+         (Nativeint.of_string "0x12345678");
+  test 2 (Nativeint.to_int32 (Nativeint.of_string "0x12345678"))
+         (Int32.of_string "0x12345678");
+  if Sys.word_size = 64 then
+  test 3 (Nativeint.to_int32 (Nativeint.of_string "0x123456789ABCDEF0"))
+         (Int32.of_string "0x9ABCDEF0")
+  else
+  test 3 0 0; (* placeholder to have the same output on 32-bit and 64-bit *)
+  testing_function "int64 of/to int32";
+  test 1 (Int64.of_int32 (Int32.of_string "-0x12345678"))
+         (Int64.of_string "-0x12345678");
+  test 2 (Int64.to_int32 (Int64.of_string "-0x12345678"))
+         (Int32.of_string "-0x12345678");
+  test 3 (Int64.to_int32 (Int64.of_string "0x123456789ABCDEF0"))
+         (Int32.of_string "0x9ABCDEF0");
+  testing_function "int64 of/to nativeint";
+  test 1 (Int64.of_nativeint (Nativeint.of_string "0x12345678"))
+         (Int64.of_string "0x12345678");
+  test 2 (Int64.to_nativeint (Int64.of_string "-0x12345678"))
+         (Nativeint.of_string "-0x12345678");
+  test 3 (Int64.to_nativeint (Int64.of_string "0x123456789ABCDEF0"))
+         (if Sys.word_size = 64
+          then Nativeint.of_string "0x123456789ABCDEF0"
+          else Nativeint.of_string "0x9ABCDEF0")
+
+(********* End of test *********)
+
+let _ =
+  print_newline();
+  if !error_occurred then begin
+    prerr_endline "************* TEST FAILED ****************"; exit 2
+  end else
+    exit 0
diff --git a/testsuite/tests/basic/boxedints.reference b/testsuite/tests/basic/boxedints.reference
new file mode 100644
index 00000000..8aa45802
--- /dev/null
+++ b/testsuite/tests/basic/boxedints.reference
@@ -0,0 +1,130 @@
+
+-------- Int32 --------
+
+of_int, to_int
+ 1... 2... 3... 4... 5...
+unsigned_to_int
+ 1... 2... 3... 4... 5... 6...
+of_string
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
+to_string, format
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... 14... 15... 16... 17... 18... 19...
+neg
+ 1... 2... 3... 4... 5... 6...
+add
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13...
+sub
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+mul
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13...
+div
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+unsigned_div
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
+mod
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+and
+ 1... 2... 3... 4... 5...
+or
+ 1... 2... 3... 4... 5...
+xor
+ 1... 2... 3... 4... 5...
+shift_left
+ 1... 2... 3... 4... 5... 6... 7... 8...
+shift_right
+ 1... 2... 3... 4... 5... 6... 7...
+shift_right_logical
+ 1... 2... 3... 4... 5... 6... 7...
+of_float
+ 1... 2... 3... 4... 5... 6... 7...
+to_float
+ 1... 2... 3... 4... 5...
+Comparisons
+ 1... 2... 3... 4... 5... 6... 7...
+
+-------- Int64 --------
+
+of_int, to_int
+ 1... 2... 3... 4... 5...
+unsigned_to_int
+ 1... 2... 3... 4... 5... 6...
+of_string
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
+to_string, format
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... 14... 15... 16... 17... 18... 19...
+neg
+ 1... 2... 3... 4... 5... 6...
+add
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13...
+sub
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+mul
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13...
+div
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+unsigned_div
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
+mod
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+and
+ 1... 2... 3... 4... 5...
+or
+ 1... 2... 3... 4... 5...
+xor
+ 1... 2... 3... 4... 5...
+shift_left
+ 1... 2... 3... 4... 5... 6... 7... 8...
+shift_right
+ 1... 2... 3... 4... 5... 6... 7...
+shift_right_logical
+ 1... 2... 3... 4... 5... 6... 7...
+Comparisons
+ 1... 2... 3... 4... 5... 6... 7...
+
+-------- Nativeint --------
+
+of_int, to_int
+ 1... 2... 3... 4... 5...
+unsigned_to_int
+ 1... 2... 3... 4... 5... 6...
+of_string
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
+to_string, format
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... 14... 15... 16... 17... 18... 19...
+neg
+ 1... 2... 3... 4... 5... 6...
+add
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13...
+sub
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+mul
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13...
+div
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+unsigned_div
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
+mod
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+and
+ 1... 2... 3... 4... 5...
+or
+ 1... 2... 3... 4... 5...
+xor
+ 1... 2... 3... 4... 5...
+shift_left
+ 1... 2... 3... 4... 5... 6... 7... 8...
+shift_right
+ 1... 2... 3... 4... 5... 6... 7...
+shift_right_logical
+ 1... 2... 3... 4... 5... 6... 7...
+Comparisons
+ 1... 2... 3... 4... 5... 6... 7...
+
+--------- Conversions -----------
+
+nativeint of/to int32
+ 1... 2... 3...
+int64 of/to int32
+ 1... 2... 3...
+int64 of/to nativeint
+ 1... 2... 3...
diff --git a/testsuite/tests/basic/camlCase.ml b/testsuite/tests/basic/camlCase.ml
new file mode 100644
index 00000000..cd298427
--- /dev/null
+++ b/testsuite/tests/basic/camlCase.ml
@@ -0,0 +1 @@
+let answer = 42
diff --git a/testsuite/tests/basic/constprop.ml.c b/testsuite/tests/basic/constprop.ml.c
new file mode 100644
index 00000000..ee23d489
--- /dev/null
+++ b/testsuite/tests/basic/constprop.ml.c
@@ -0,0 +1,130 @@
+(* TEST
+   flags = "-pp '${c_preprocessor}'"
+   ocaml_filetype_flag = "-impl"
+   * bytecode
+     compare_programs = "false"
+   * native
+*)
+
+(* This file has extension .ml.c because it needs to be preprocessed
+   by the C preprocessor, which requires a .c extension when called
+   through the C compiler
+*)
+
+(* Test constant propagation through inlining *)
+
+(* constprop.ml is generated from constprop.mlp using
+      cpp constprop.mlp > constprop.ml
+*)
+
+#define tbool(x,y) \
+  (x && y, x || y, not x)
+
+#define tint(x,y,s)                                                         \
+  (-x, x + y, x - y, x * y, x / y, x mod y,                                 \
+   x land y, x lor y, x lxor y,                                             \
+   x lsl s, x lsr s, x asr s,                                               \
+   x = y, x <> y, x < y, x <= y, x > y, x >= y,                             \
+   succ x, pred y)
+
+#define tfloat(x,y)                                                         \
+  (int_of_float x,                                                          \
+   x +. y, x -. y, x *. y, x /. y,                                          \
+   x = y, x <> y, x < y, x <= y, x > y, x >= y)
+
+#define tconvint(i)                                                         \
+  (float_of_int i,                                                          \
+   Int32.of_int i,                                                          \
+   Nativeint.of_int i,                                                      \
+   Int64.of_int i)
+
+#define tconvint32(i)                                                       \
+  (Int32.to_int i,                                                          \
+   Nativeint.of_int32 i,                                                    \
+   Int64.of_int32 i)
+
+#define tconvnativeint(i)                                                   \
+  (Nativeint.to_int i,                                                      \
+   Nativeint.to_int32 i,                                                    \
+   Int64.of_nativeint i)
+
+#define tconvint64(i)                                                       \
+  (Int64.to_int i,                                                          \
+   Int64.to_int32 i,                                                        \
+   Int64.to_nativeint i)                                                    \
+
+#define tint32(x,y,s)                                                       \
+  Int32.(neg x, add x y, sub x y, mul x y, div x y, rem x y,                \
+         logand x y, logor x y, logxor x y,                                 \
+         shift_left x s, shift_right x s, shift_right_logical x s,          \
+         x = y, x <> y, x < y, x <= y, x > y, x >= y)
+
+#define tnativeint(x,y,s)                                                   \
+  Nativeint.(neg x, add x y, sub x y, mul x y, div x y, rem x y,            \
+         logand x y, logor x y, logxor x y,                                 \
+         shift_left x s, shift_right x s, shift_right_logical x s,          \
+         x = y, x <> y, x < y, x <= y, x > y, x >= y)
+
+#define tint64(x,y,s)                                                       \
+  Int64.(neg x, add x y, sub x y, mul x y, div x y, rem x y,                \
+         logand x y, logor x y, logxor x y,                                 \
+         shift_left x s, shift_right x s, shift_right_logical x s,          \
+         x = y, x <> y, x < y, x <= y, x > y, x >= y)
+
+let do_test msg res1 res2 =
+  Printf.printf "%s: %s\n" msg (if res1 = res2 then "passed" else "FAILED")
+
+(* Hide a constant from the optimizer, preventing constant propagation *)
+let hide x = List.nth [x] 0
+
+let _ =
+  begin
+    let x = true and y = false in
+    let xh = hide x and yh = hide y in
+    do_test "booleans" (tbool(x, y)) (tbool(xh,yh))
+  end;
+  begin
+    let x = 89809344 and y = 457455773 and s = 7 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "integers" (tint(x, y, s)) (tint(xh,yh,sh))
+  end;
+  begin
+    let x = 3.141592654 and y = 0.341638588598232096 in
+    let xh = hide x and yh = hide y in
+    do_test "floats" (tfloat(x, y)) (tfloat(xh, yh))
+  end;
+  begin
+    let x = 781944104l and y = 308219921l and s = 3 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "32-bit integers" (tint32(x, y, s)) (tint32(xh, yh, sh))
+  end;
+  begin
+    let x = 1828697041n and y = -521695949n and s = 8 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "native integers" (tnativeint(x, y, s)) (tnativeint(xh, yh, sh))
+  end;
+  begin
+    let x = 1511491586921138079L and y = 6677538715441746158L and s = 17 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "64-bit integers" (tint64(x, y, s)) (tint64(xh, yh, sh))
+  end;
+  begin
+    let x = 1000807289 in
+    let xh = hide x in
+    do_test "integer conversions" (tconvint(x)) (tconvint(xh))
+  end;
+  begin
+    let x = 10486393l in
+    let xh = hide x in
+    do_test "32-bit integer conversions" (tconvint32(x)) (tconvint32(xh))
+  end;
+  begin
+    let x = -131134014n in
+    let xh = hide x in
+    do_test "native integer conversions" (tconvnativeint(x))(tconvnativeint(xh))
+  end;
+  begin
+    let x = 531871273453404175L in
+    let xh = hide x in
+    do_test "64-bit integer conversions" (tconvint64(x)) (tconvint64(xh))
+  end
diff --git a/testsuite/tests/basic/constprop.ml.reference b/testsuite/tests/basic/constprop.ml.reference
new file mode 100644
index 00000000..59590530
--- /dev/null
+++ b/testsuite/tests/basic/constprop.ml.reference
@@ -0,0 +1,10 @@
+booleans: passed
+integers: passed
+floats: passed
+32-bit integers: passed
+native integers: passed
+64-bit integers: passed
+integer conversions: passed
+32-bit integer conversions: passed
+native integer conversions: passed
+64-bit integer conversions: passed
diff --git a/testsuite/tests/basic/divint.ml b/testsuite/tests/basic/divint.ml
new file mode 100644
index 00000000..e315ad70
--- /dev/null
+++ b/testsuite/tests/basic/divint.ml
@@ -0,0 +1,147 @@
+(* TEST *)
+
+open Printf
+
+(* Test integer division and modulus, esp. ocamlopt's optimization
+   when the divisor is a constant. *)
+
+let error = ref false
+
+module WithInt = struct
+
+let d = ref 0
+let divref n = n / !d
+let modref n = n mod !d
+
+let test_one (df: int -> int) (mf: int -> int) x =
+  if not (df x = divref x && mf x = modref x) then begin
+    printf "mismatch for %d\n" x;
+    error := true
+  end
+
+let do_test divisor (df: int -> int) (mf: int -> int) =
+  d := divisor;
+  List.iter (test_one df mf)
+    [0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10;
+     100; 1000; 10000; 100000; 1000000; max_int - 1; max_int;
+     -1; -2; -3; -4; -5; -6; -7; -8; -9; -10;
+     -100; -1000; -10000; -100000; -1000000; min_int + 1; min_int];
+  let seed = ref 0 in
+  for i = 1 to 1000 do
+    seed := !seed * 69069 + 25173;
+    test_one df mf !seed
+  done
+
+end
+
+module WithNat = struct
+
+let d = ref 0n
+let divref n = Nativeint.div n !d
+let modref n = Nativeint.rem n !d
+
+let test_one (df: nativeint -> nativeint) (mf: nativeint -> nativeint) x =
+  if not (df x = divref x && mf x = modref x) then begin
+    printf "mismatch for %nd\n" x;
+    error := true
+  end
+
+let do_test divisor (df: nativeint -> nativeint) (mf: nativeint -> nativeint) =
+  d := Nativeint.of_int divisor;
+  List.iter (test_one df mf)
+    [0n; 1n; 2n; 3n; 4n; 5n; 6n; 7n; 8n; 9n; 10n;
+     100n; 1000n; 10000n; 100000n; 1000000n;
+     Nativeint.(pred max_int); Nativeint.max_int;
+     -1n; -2n; -3n; -4n; -5n; -6n; -7n; -8n; -9n; -10n;
+     -100n; -1000n; -10000n; -100000n; -1000000n;
+     Nativeint.(succ min_int); Nativeint.min_int];
+  let seed = ref 0n in
+  for i = 1 to 1000 do
+    seed := Nativeint.(add (mul !seed 69069n) 25173n);
+    test_one df mf !seed
+  done
+
+end
+
+let _ =
+  printf "1 int\n"; WithInt.do_test 1 (fun x -> x / 1)(fun x -> x mod 1);
+  printf "2 int\n"; WithInt.do_test 2 (fun x -> x / 2)(fun x -> x mod 2);
+  printf "3 int\n"; WithInt.do_test 3 (fun x -> x / 3)(fun x -> x mod 3);
+  printf "4 int\n"; WithInt.do_test 4 (fun x -> x / 4)(fun x -> x mod 4);
+  printf "5 int\n"; WithInt.do_test 5 (fun x -> x / 5)(fun x -> x mod 5);
+  printf "6 int\n"; WithInt.do_test 6 (fun x -> x / 6)(fun x -> x mod 6);
+  printf "7 int\n"; WithInt.do_test 7 (fun x -> x / 7)(fun x -> x mod 7);
+  printf "9 int\n"; WithInt.do_test 9 (fun x -> x / 9)(fun x -> x mod 9);
+  printf "10 int\n"; WithInt.do_test 10 (fun x -> x / 10)(fun x -> x mod 10);
+  printf "11 int\n"; WithInt.do_test 11 (fun x -> x / 11)(fun x -> x mod 11);
+  printf "12 int\n"; WithInt.do_test 12 (fun x -> x / 12)(fun x -> x mod 12);
+  printf "25 int\n"; WithInt.do_test 25 (fun x -> x / 25)(fun x -> x mod 25);
+  printf "55 int\n"; WithInt.do_test 55 (fun x -> x / 55)(fun x -> x mod 55);
+  printf "125 int\n";
+  WithInt.do_test 125 (fun x -> x / 125)(fun x -> x mod 125);
+  printf "625 int\n";
+  WithInt.do_test 625 (fun x -> x / 625)(fun x -> x mod 625);
+  printf "-1 int\n";
+  WithInt.do_test (-1) (fun x -> x / (-1))(fun x -> x mod (-1));
+  printf "-2 int\n";
+  WithInt.do_test (-2) (fun x -> x / (-2))(fun x -> x mod (-2));
+  printf "-3 int\n";
+  WithInt.do_test (-3) (fun x -> x / (-3))(fun x -> x mod (-3));
+
+  printf "1 nat\n";
+  WithNat.do_test 1 (fun x -> Nativeint.div x 1n)(fun x -> Nativeint.rem x 1n);
+  printf "2 nat\n";
+  WithNat.do_test 2 (fun x -> Nativeint.div x 2n)(fun x -> Nativeint.rem x 2n);
+  printf "3 nat\n";
+  WithNat.do_test 3 (fun x -> Nativeint.div x 3n)(fun x -> Nativeint.rem x 3n);
+  printf "4 nat\n";
+  WithNat.do_test 4 (fun x -> Nativeint.div x 4n)(fun x -> Nativeint.rem x 4n);
+  printf "5 nat\n";
+  WithNat.do_test 5 (fun x -> Nativeint.div x 5n)(fun x -> Nativeint.rem x 5n);
+  printf "6 nat\n";
+  WithNat.do_test 6 (fun x -> Nativeint.div x 6n)(fun x -> Nativeint.rem x 6n);
+  printf "7 nat\n";
+  WithNat.do_test 7 (fun x -> Nativeint.div x 7n)(fun x -> Nativeint.rem x 7n);
+  printf "9 nat\n";
+  WithNat.do_test 9 (fun x -> Nativeint.div x 9n)(fun x -> Nativeint.rem x 9n);
+  printf "10 nat\n";
+  WithNat.do_test 10 (fun x -> Nativeint.div x 10n)
+                     (fun x -> Nativeint.rem x 10n);
+  printf "11 nat\n";
+  WithNat.do_test 11 (fun x -> Nativeint.div x 11n)
+                     (fun x -> Nativeint.rem x 11n);
+  printf "12 nat\n";
+  WithNat.do_test 12 (fun x -> Nativeint.div x 12n)
+                     (fun x -> Nativeint.rem x 12n);
+  printf "25 nat\n";
+  WithNat.do_test 25 (fun x -> Nativeint.div x 25n)
+                     (fun x -> Nativeint.rem x 25n);
+  printf "55 nat\n";
+  WithNat.do_test 55 (fun x -> Nativeint.div x 55n)
+                     (fun x -> Nativeint.rem x 55n);
+  printf "125 nat\n";
+  WithNat.do_test 125 (fun x -> Nativeint.div x 125n)
+                      (fun x -> Nativeint.rem x 125n);
+  printf "625 nat\n";
+  WithNat.do_test 625 (fun x -> Nativeint.div x 625n)
+                      (fun x -> Nativeint.rem x 625n);
+  printf "-1 nat\n";
+  WithNat.do_test (-1) (fun x -> Nativeint.div x (-1n))
+                       (fun x -> Nativeint.rem x (-1n));
+  printf "-2 nat\n";
+  WithNat.do_test (-2) (fun x -> Nativeint.div x (-2n))
+                       (fun x -> Nativeint.rem x (-2n));
+  printf "-3 nat\n";
+  WithNat.do_test (-3) (fun x -> Nativeint.div x (-3n))
+                       (fun x -> Nativeint.rem x (-3n));
+
+  if !error then printf "TEST FAILED.\n" else printf "Test passed.\n"
+
+(* PR#6879 *)
+let f n = assert (1 mod n = 0)
+let () = f 1
+
+
+type t = {x: int; y:int}
+let f x = {x; y = x/0}.x
+let () = try ignore (f 1); assert false with Division_by_zero -> ()
diff --git a/testsuite/tests/basic/divint.reference b/testsuite/tests/basic/divint.reference
new file mode 100644
index 00000000..e9a6387f
--- /dev/null
+++ b/testsuite/tests/basic/divint.reference
@@ -0,0 +1,37 @@
+1 int
+2 int
+3 int
+4 int
+5 int
+6 int
+7 int
+9 int
+10 int
+11 int
+12 int
+25 int
+55 int
+125 int
+625 int
+-1 int
+-2 int
+-3 int
+1 nat
+2 nat
+3 nat
+4 nat
+5 nat
+6 nat
+7 nat
+9 nat
+10 nat
+11 nat
+12 nat
+25 nat
+55 nat
+125 nat
+625 nat
+-1 nat
+-2 nat
+-3 nat
+Test passed.
diff --git a/testsuite/tests/basic/equality.ml b/testsuite/tests/basic/equality.ml
new file mode 100644
index 00000000..19d76e09
--- /dev/null
+++ b/testsuite/tests/basic/equality.ml
@@ -0,0 +1,106 @@
+(* TEST *)
+
+let test n check res =
+  print_string "Test "; print_int n;
+  if check res then print_string " passed.\n" else print_string " FAILED.\n";
+  flush stderr
+
+let eq0 = function 0 -> true | _ -> false
+let eqm1 = function -1 -> true | _ -> false
+let eq1 = function 1 -> true | _ -> false
+let eqtrue (b:bool) = b
+let eqftffff =
+  function (false,true,false,false,false,false) -> true | _ -> false
+
+let x = [1;2;3]
+
+let f x = 1 :: 2 :: 3 :: x
+
+let mklist len =
+  let l = ref [] in
+  for i = 1 to len do l := i :: !l done;
+  !l
+
+type tree = Dummy | Leaf | Node of tree * tree
+
+let rec mktree depth =
+  if depth <= 0 then Leaf else Node(mktree(depth - 1), mktree(depth - 1))
+
+type 'a leftlist = Nil | Cons of 'a leftlist * 'a
+
+let mkleftlist len =
+  let l = ref Nil in
+  for i = 1 to len do l := Cons(!l, i) done;
+  !l
+
+let _ =
+  test 1 eq0 (compare 0 0);
+  test 2 eqm1 (compare 0 1);
+  test 3 eq1 (compare 1 0);
+  test 4 eq0 (compare max_int max_int);
+  test 5 eqm1 (compare min_int max_int);
+  test 6 eq1 (compare max_int min_int);
+  test 7 eq0 (compare "foo" "foo");
+  test 8 eqm1 (compare "foo" "zorglub");
+  test 9 eqm1 (compare "abcdef" "foo");
+  test 10 eqm1 (compare "abcdefghij" "abcdefghijkl");
+  test 11 eq1 (compare "abcdefghij" "abcdefghi");
+  test 12 eq0 (compare (0,1) (0,1));
+  test 13 eqm1 (compare (0,1) (0,2));
+  test 14 eqm1 (compare (0,1) (1,0));
+  test 15 eq1 (compare (0,1) (0,0));
+  test 16 eq1 (compare (1,0) (0,1));
+  test 17 eq0 (compare 0.0 0.0);
+  test 18 eqm1 (compare 0.0 1.0);
+  test 19 eqm1 (compare (-1.0) 0.0);
+  test 20 eq0 (compare [| 0.0; 1.0; 2.0 |] [| 0.0; 1.0; 2.0 |]);
+  test 21 eqm1 (compare [| 0.0; 1.0; 2.0 |] [| 0.0; 1.0; 3.0 |]);
+  test 22 eq1 (compare [| 0.0; 5.0; 2.0 |] [| 0.0; 1.0; 2.0 |]);
+  test 23 eq0 (compare [1;2;3;4] [1;2;3;4]);
+  test 24 eqm1 (compare [1;2;3;4] [1;2;5;6]);
+  test 25 eqm1 (compare [1;2;3;4] [1;2;3;4;5]);
+  test 26 eq1 (compare [1;2;3;4] [1;2;3]);
+  test 27 eq1 (compare [1;2;3;4] [1;2;0;4]);
+  test 28 eq0 (compare (mklist 1000) (mklist 1000));
+  test 29 eq0 (compare (mkleftlist 1000) (mkleftlist 1000));
+  test 30 eq0 (compare (mktree 12) (mktree 12));
+  test 31 eqtrue (x = f []);
+  test 32 eqtrue (stdout <> stderr);
+  test 33 eqm1 (compare nan 0.0);
+  test 34 eqm1 (compare nan neg_infinity);
+  test 35 eq0 (compare nan nan);
+  test 36 eqm1 (compare (0.0, nan) (0.0, 0.0));
+  test 37 eqm1 (compare (0.0, nan) (0.0, neg_infinity));
+  test 38 eq0 (compare (nan, 0.0) (nan, 0.0));
+  let cmpgen x y = (x=y, x<>y, x<y, x<=y, x>y, x>=y) in
+  let cmpfloat (x:float) (y:float) = (x=y, x<>y, x<y, x<=y, x>y, x>=y) in
+  test 39 eqftffff (cmpgen nan nan);
+  test 40 eqftffff (cmpgen nan 0.0);
+  test 41 eqftffff (cmpfloat nan nan);
+  test 42 eqftffff (cmpfloat nan 0.0);
+  test 43 eqtrue ([||] = [||]);
+  (* Convoluted forms to test both the "positive" and "negative" cases
+     of float tests *)
+  let cmpfloatpos (x:float) (y:float) =
+    ((let r = ref false in (if x = y then r := true); !r),
+     (let r = ref false in (if x <> y then r := true); !r),
+     (let r = ref false in (if x < y then r := true); !r),
+     (let r = ref false in (if x <= y then r := true); !r),
+     (let r = ref false in (if x > y then r := true); !r),
+     (let r = ref false in (if x >= y then r := true); !r))
+  and cmpfloatneg (x:float) (y:float) =
+    ((let r = ref true in (if not (x = y) then r := false); !r),
+     (let r = ref true in (if not (x <> y) then r := false); !r),
+     (let r = ref true in (if not (x < y) then r := false); !r),
+     (let r = ref true in (if not (x <= y) then r := false); !r),
+     (let r = ref true in (if not (x > y) then r := false); !r),
+     (let r = ref true in (if not (x >= y) then r := false); !r)) in
+  let testcmpfloat x y =
+    cmpfloatpos x y = cmpgen x y &&
+    cmpfloatneg x y = cmpgen x y in
+  test 50 eqtrue (testcmpfloat nan nan);
+  test 51 eqtrue (testcmpfloat nan 0.0);
+  test 52 eqtrue (testcmpfloat 0.0 nan);
+  test 53 eqtrue (testcmpfloat 0.0 0.0);
+  test 54 eqtrue (testcmpfloat 1.0 0.0);
+  test 55 eqtrue (testcmpfloat 0.0 1.0)
diff --git a/testsuite/tests/basic/equality.reference b/testsuite/tests/basic/equality.reference
new file mode 100644
index 00000000..6070a6b0
--- /dev/null
+++ b/testsuite/tests/basic/equality.reference
@@ -0,0 +1,49 @@
+Test 1 passed.
+Test 2 passed.
+Test 3 passed.
+Test 4 passed.
+Test 5 passed.
+Test 6 passed.
+Test 7 passed.
+Test 8 passed.
+Test 9 passed.
+Test 10 passed.
+Test 11 passed.
+Test 12 passed.
+Test 13 passed.
+Test 14 passed.
+Test 15 passed.
+Test 16 passed.
+Test 17 passed.
+Test 18 passed.
+Test 19 passed.
+Test 20 passed.
+Test 21 passed.
+Test 22 passed.
+Test 23 passed.
+Test 24 passed.
+Test 25 passed.
+Test 26 passed.
+Test 27 passed.
+Test 28 passed.
+Test 29 passed.
+Test 30 passed.
+Test 31 passed.
+Test 32 passed.
+Test 33 passed.
+Test 34 passed.
+Test 35 passed.
+Test 36 passed.
+Test 37 passed.
+Test 38 passed.
+Test 39 passed.
+Test 40 passed.
+Test 41 passed.
+Test 42 passed.
+Test 43 passed.
+Test 50 passed.
+Test 51 passed.
+Test 52 passed.
+Test 53 passed.
+Test 54 passed.
+Test 55 passed.
diff --git a/testsuite/tests/basic/eval_order_1.ml b/testsuite/tests/basic/eval_order_1.ml
new file mode 100644
index 00000000..bad1d054
--- /dev/null
+++ b/testsuite/tests/basic/eval_order_1.ml
@@ -0,0 +1,6 @@
+(* TEST *)
+
+let f x y = Printf.printf "%d %d\n" x y
+
+let i = ref 0
+let () = f (incr i; !i) !i
diff --git a/testsuite/tests/basic/eval_order_1.reference b/testsuite/tests/basic/eval_order_1.reference
new file mode 100644
index 00000000..80c0cc79
--- /dev/null
+++ b/testsuite/tests/basic/eval_order_1.reference
@@ -0,0 +1 @@
+1 0
diff --git a/testsuite/tests/basic/eval_order_2.ml b/testsuite/tests/basic/eval_order_2.ml
new file mode 100644
index 00000000..e11da19b
--- /dev/null
+++ b/testsuite/tests/basic/eval_order_2.ml
@@ -0,0 +1,26 @@
+(* TEST *)
+
+(* PR#6136 *)
+
+exception Ok
+
+let first () =
+  let f g x = ignore (failwith "called f"); g in
+  let g x = x in
+  f g 2 (raise Ok)
+
+let second () =
+  let f g x = ignore (failwith "called f"); g in
+  let g x = x in
+  let h f = f g 2 (raise Ok) in
+  ignore (h f)
+
+let () =
+  try
+    ignore (first ());
+    assert false
+  with Ok ->
+    try
+      ignore (second ());
+      assert false
+    with Ok -> ()
diff --git a/testsuite/tests/basic/eval_order_2.reference b/testsuite/tests/basic/eval_order_2.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/basic/eval_order_3.ml b/testsuite/tests/basic/eval_order_3.ml
new file mode 100644
index 00000000..90a9eba9
--- /dev/null
+++ b/testsuite/tests/basic/eval_order_3.ml
@@ -0,0 +1,24 @@
+(* TEST *)
+
+let i = ref 0
+
+let f x y =
+  Printf.printf "%d %d\n" x y;
+  0
+[@@inline never]
+
+let foo _ = ()
+
+let foobar baz =
+  let incr_i _ =
+    incr i;
+    !i
+  in
+  let b = !i in
+  let z = foo 42 in
+  let a = (incr_i [@inlined never]) z in
+  let x = f a b in
+  x + 1
+
+let () =
+  ignore ((foobar 0) : int)
diff --git a/testsuite/tests/basic/eval_order_3.reference b/testsuite/tests/basic/eval_order_3.reference
new file mode 100644
index 00000000..80c0cc79
--- /dev/null
+++ b/testsuite/tests/basic/eval_order_3.reference
@@ -0,0 +1 @@
+1 0
diff --git a/testsuite/tests/basic/eval_order_4.ml b/testsuite/tests/basic/eval_order_4.ml
new file mode 100644
index 00000000..98de05fb
--- /dev/null
+++ b/testsuite/tests/basic/eval_order_4.ml
@@ -0,0 +1,19 @@
+(* TEST *)
+
+(* PR#7531 *)
+
+let f =
+  (let _i = print_endline "first"
+   in fun q -> fun i -> "") (print_endline "x")
+
+let _ =
+  let k =
+    (let _i = print_int 1
+     in fun q -> fun i -> "") ()
+  in k (print_int 0)
+
+let () =
+  print_endline "foo";
+  ignore ((f ()) : string);
+  ignore ((f ()) : string);
+  print_endline "bar"
diff --git a/testsuite/tests/basic/eval_order_4.reference b/testsuite/tests/basic/eval_order_4.reference
new file mode 100644
index 00000000..426ddfda
--- /dev/null
+++ b/testsuite/tests/basic/eval_order_4.reference
@@ -0,0 +1,4 @@
+x
+first
+10foo
+bar
diff --git a/testsuite/tests/basic/eval_order_6.ml b/testsuite/tests/basic/eval_order_6.ml
new file mode 100644
index 00000000..b9ecf42f
--- /dev/null
+++ b/testsuite/tests/basic/eval_order_6.ml
@@ -0,0 +1,18 @@
+(* TEST *)
+
+type t =
+  { mutable x : int;
+    y : int }
+
+let f { x = c } =
+    fun () -> c;;
+
+let r = { x = 10; y = 20 };;
+
+let h = f r;;
+
+print_endline (Int.to_string (h ()));;
+
+r.x <- 20;;
+
+print_endline (Int.to_string (h ()));;
diff --git a/testsuite/tests/basic/eval_order_6.reference b/testsuite/tests/basic/eval_order_6.reference
new file mode 100644
index 00000000..b2f7f08c
--- /dev/null
+++ b/testsuite/tests/basic/eval_order_6.reference
@@ -0,0 +1,2 @@
+10
+10
diff --git a/testsuite/tests/basic/float.ml b/testsuite/tests/basic/float.ml
new file mode 100644
index 00000000..a17c70fe
--- /dev/null
+++ b/testsuite/tests/basic/float.ml
@@ -0,0 +1,3 @@
+(* TEST *)
+
+Printf.printf "1./.0. = %f\n" (1.0 /. 0.0);;
diff --git a/testsuite/tests/basic/float.reference b/testsuite/tests/basic/float.reference
new file mode 100644
index 00000000..3e7bab44
--- /dev/null
+++ b/testsuite/tests/basic/float.reference
@@ -0,0 +1 @@
+1./.0. = inf
diff --git a/testsuite/tests/basic/float_physical_equality.ml b/testsuite/tests/basic/float_physical_equality.ml
new file mode 100644
index 00000000..5e826a71
--- /dev/null
+++ b/testsuite/tests/basic/float_physical_equality.ml
@@ -0,0 +1,12 @@
+(* TEST *)
+
+let a = -0.
+let b = +0.
+
+let _ =
+  assert(not (a == b))
+
+let f () =
+  let a = -0. in
+  let b = +0. in
+  assert(not (a == b))
diff --git a/testsuite/tests/basic/float_physical_equality.reference b/testsuite/tests/basic/float_physical_equality.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/basic/includestruct.ml b/testsuite/tests/basic/includestruct.ml
new file mode 100644
index 00000000..b141388b
--- /dev/null
+++ b/testsuite/tests/basic/includestruct.ml
@@ -0,0 +1,109 @@
+(* TEST *)
+
+(* Test for "include <module-expr>" inside structures *)
+
+module A =
+  struct
+    type t = int
+    let x = (1 : t)
+    let y = (2 : t)
+    let f (z : t) = (x + z : t)
+  end
+
+module B =
+  struct
+    include A
+    type u = t * t
+    let p = ((x, y) : u)
+    let g ((x, y) : u) = ((f x, f y) : u)
+  end
+
+let _ =
+  let print_pair (x,y) =
+    print_int x; print_string ", "; print_int y; print_newline() in
+  print_pair B.p;
+  print_pair (B.g B.p);
+  print_pair (B.g (123, 456))
+
+module H =
+  struct
+    include A
+    let f (z : t) = (x - 1 : t)
+  end
+
+let _ =
+  print_int (H.f H.x); print_newline()
+
+module C =
+  struct
+    include (A : sig type t val f : t -> int val x : t end)
+    let z = f x
+  end
+
+let _ =
+  print_int C.z; print_newline();
+  print_int (C.f C.x); print_newline()
+
+(* Toplevel inclusion *)
+
+include A
+
+let _ =
+  print_int x; print_newline();
+  print_int (f y); print_newline()
+
+(* With a functor *)
+
+module F(X: sig end) =
+  struct
+    let _ = print_string "F is called"; print_newline()
+    type t = A | B of int
+    let print_t = function A -> print_string "A"
+                         | B x -> print_int x
+  end
+
+module D =
+  struct
+    include F(struct end)
+    let test() = print_t A; print_newline(); print_t (B 42); print_newline()
+  end
+
+let _ =
+  D.test();
+  D.print_t D.A; print_newline(); D.print_t (D.B 42); print_newline()
+
+(* Exceptions and classes *)
+
+module E =
+  struct
+    exception Exn of string
+    class c = object method m = 1 end
+  end
+
+module G =
+  struct
+    include E
+    let _ =
+      begin try raise (Exn "foo") with Exn s -> print_string s end;
+      print_int ((new c)#m); print_newline()
+  end
+
+let _ =
+  begin try raise (G.Exn "foo") with G.Exn s -> print_string s end;
+  print_int ((new G.c)#m); print_newline()
+
+
+
+include (struct
+  let a = 10
+  module X = struct let x = 1 let z = 42 let y = 2 end
+  exception XXX
+end : sig
+  module X : sig val y: int val x: int end
+  exception XXX
+  val a: int
+end)
+
+let () =
+  Printf.printf "%i / %i / %i \n%!" X.x X.y a;
+  Printf.printf "%s\n%!" (Printexc.to_string XXX)
diff --git a/testsuite/tests/basic/includestruct.reference b/testsuite/tests/basic/includestruct.reference
new file mode 100644
index 00000000..70af2e3d
--- /dev/null
+++ b/testsuite/tests/basic/includestruct.reference
@@ -0,0 +1,17 @@
+1, 2
+2, 3
+124, 457
+0
+2
+2
+1
+3
+F is called
+A
+42
+A
+42
+foo1
+foo1
+1 / 2 / 10 
+XXX
diff --git a/testsuite/tests/basic/localexn.ml b/testsuite/tests/basic/localexn.ml
new file mode 100644
index 00000000..2654d9bf
--- /dev/null
+++ b/testsuite/tests/basic/localexn.ml
@@ -0,0 +1,11 @@
+(* TEST *)
+
+let f (type t) () =
+  let exception E of t in
+  (fun x -> E x), (function E _ -> print_endline "OK" | _ -> print_endline "KO")
+
+let inj1, proj1 = f ()
+let inj2, proj2 = f ()
+
+let () = proj1 (inj1 42)
+let () = proj1 (inj2 42)
diff --git a/testsuite/tests/basic/localexn.reference b/testsuite/tests/basic/localexn.reference
new file mode 100644
index 00000000..cd89967b
--- /dev/null
+++ b/testsuite/tests/basic/localexn.reference
@@ -0,0 +1,2 @@
+OK
+KO
diff --git a/testsuite/tests/basic/localfunction.ml b/testsuite/tests/basic/localfunction.ml
new file mode 100644
index 00000000..6ea7b5d7
--- /dev/null
+++ b/testsuite/tests/basic/localfunction.ml
@@ -0,0 +1,32 @@
+(* TEST *)
+
+let f x =
+  let r = ref 0 in
+  let ret x = r := x in
+  let[@local] g y = ret (x * y) in
+  begin match x with
+  | 0 -> ret 0
+  | 1 -> g 10
+  | _ ->
+      if x < 10 then g 20 else g 30
+  end;
+  !r
+
+let () =
+  let x0 = Gc.allocated_bytes () in
+  let x1 = Gc.allocated_bytes () in
+  let r = ref 0 in
+  for i = 0 to 20 do r := !r + f i done;
+  let x2 = Gc.allocated_bytes () in
+  Printf.printf "%i\n%!" !r;
+  assert(x1 -. x0 = x2 -. x1)
+     (* check that we did not allocated anything between x1 and x2 *)
+
+
+let () =
+  (* #8558 *)
+  let f () = () in
+  let r = ref 0 in
+  let g () = f (incr r) in
+  g ();
+  assert (!r = 1)
diff --git a/testsuite/tests/basic/localfunction.reference b/testsuite/tests/basic/localfunction.reference
new file mode 100644
index 00000000..e44974eb
--- /dev/null
+++ b/testsuite/tests/basic/localfunction.reference
@@ -0,0 +1 @@
+5840
diff --git a/testsuite/tests/basic/maps.ml b/testsuite/tests/basic/maps.ml
new file mode 100644
index 00000000..52504d06
--- /dev/null
+++ b/testsuite/tests/basic/maps.ml
@@ -0,0 +1,75 @@
+(* TEST *)
+
+module IntMap = Map.Make(struct type t = int let compare x y = x-y end)
+
+let m1 = IntMap.add 0 "A" (IntMap.add 4 "Y" (IntMap.singleton 3 "X1"))
+let m2 = IntMap.add 0 "B" (IntMap.add 4 "Y" (IntMap.singleton 5 "X2"))
+
+let show m = IntMap.iter (fun k v -> Printf.printf "%d %s\n" k v) m
+
+let () =
+  print_endline "Union+concat";
+  let f1 _ l r =
+    match l, r with
+    | Some x, None | None, Some x -> Some x
+    | Some x, Some y when x = y -> None
+    | Some x, Some y -> Some (x ^ y)
+    | _ -> assert false
+  in
+  show (IntMap.merge f1 m1 m2);
+
+  print_endline "Inter";
+  let f2 _ l r =
+    match l, r with
+    | Some x, Some y when x = y -> Some x
+    | _ -> None
+  in
+  show (IntMap.merge f2 m1 m2);
+
+  print_endline "Union+concat (with Map.union)";
+  let f3 _ l r = if l = r then None else Some (l ^ r) in
+  show (IntMap.union f3 m1 m2);
+  ()
+
+let show m = IntMap.iter (fun k v -> Printf.printf "%d -> %d\n" k v) m
+
+let update x f m =
+  let yp = IntMap.find_opt x m in
+  let y = f yp in
+  match yp, y with
+  | _, None -> IntMap.remove x m
+  | None, Some z -> IntMap.add x z m
+  | Some zp, Some z -> if zp == z then m else IntMap.add x z m
+
+let () =
+  print_endline "Update";
+  let rec init m  = function
+    | -1 -> m
+    | n -> init (IntMap.add n n m) (n - 1)
+  in
+  let n = 9 in
+  let m = init IntMap.empty n in
+  for i = 0 to n + 1 do
+    for j = 0 to n + 1 do
+      List.iter (function (k, f) ->
+          let m1 = update i f m in
+          let m2 = IntMap.update i f m in
+          if not (IntMap.equal ( = ) m1 m2 && ((m1 == m) = (m2 == m))) then
+          begin
+            Printf.printf "ERROR: %s: %d -> %d\n" k i j;
+            print_endline "expected result:";
+            show m1;
+            print_endline "result:";
+            show m2;
+          end
+        )
+      [
+        "replace",                 (function None -> None   | Some _ -> Some j);
+        "delete if exists, bind otherwise",
+                                   (function None -> Some j | Some _ -> None);
+        "delete",                  (function None -> None   | Some _ -> None);
+        "insert",                  (function None -> Some j | Some _ -> Some j);
+      ]
+    done;
+  done;
+;;
diff --git a/testsuite/tests/basic/maps.reference b/testsuite/tests/basic/maps.reference
new file mode 100644
index 00000000..b406eedb
--- /dev/null
+++ b/testsuite/tests/basic/maps.reference
@@ -0,0 +1,11 @@
+Union+concat
+0 AB
+3 X1
+5 X2
+Inter
+4 Y
+Union+concat (with Map.union)
+0 AB
+3 X1
+5 X2
+Update
diff --git a/testsuite/tests/basic/min_int.ml b/testsuite/tests/basic/min_int.ml
new file mode 100644
index 00000000..bfb2ff4a
--- /dev/null
+++ b/testsuite/tests/basic/min_int.ml
@@ -0,0 +1,12 @@
+(* TEST *)
+
+(* This will test the parsing of the smallest integer on 32-bit architectures.
+   It doesn't do much on 64-bit but at least it doesn't crash.
+ *)
+
+let min_int = -1073741824
+let () = match min_int with
+| -1073741824 as i ->
+  assert (Int.to_string i = "-1073741824");
+  print_endline "OK"
+| _ -> assert false
diff --git a/testsuite/tests/basic/min_int.reference b/testsuite/tests/basic/min_int.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/basic/min_int.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/basic/opt_variants.ml b/testsuite/tests/basic/opt_variants.ml
new file mode 100644
index 00000000..a75ca355
--- /dev/null
+++ b/testsuite/tests/basic/opt_variants.ml
@@ -0,0 +1,134 @@
+(* TEST *)
+
+let () =
+  assert(Sys.getenv_opt "FOOBAR_UNLIKELY_TO_EXIST_42" = None);
+
+  assert(int_of_string_opt "foo" = None);
+  assert(int_of_string_opt "42" = Some 42);
+  assert(int_of_string_opt (String.make 100 '9') = None);
+
+  assert(Nativeint.of_string_opt "foo" = None);
+  assert(Nativeint.of_string_opt "42" = Some 42n);
+  assert(Nativeint.of_string_opt (String.make 100 '9') = None);
+
+  assert(Int32.of_string_opt "foo" = None);
+  assert(Int32.of_string_opt "42" = Some 42l);
+  assert(Int32.of_string_opt (String.make 100 '9') = None);
+
+  assert(Int64.of_string_opt "foo" = None);
+  assert(Int64.of_string_opt "42" = Some 42L);
+  assert(Int64.of_string_opt (String.make 100 '9') = None);
+
+  assert(bool_of_string_opt "" = None);
+  assert(bool_of_string_opt "true" = Some true);
+  assert(bool_of_string_opt "false" = Some false);
+
+  assert(float_of_string_opt "foo" = None);
+  assert(float_of_string_opt "42." = Some 42.);
+  assert(float_of_string_opt (String.make 1000 '9') = Some infinity);
+
+  assert(List.nth_opt [] 0 = None);
+  assert(List.nth_opt [42] 0 = Some 42);
+  assert(List.nth_opt [42] 1 = None);
+
+  assert(List.find_opt (fun _ -> true) [] = None);
+  assert(List.find_opt (fun x -> x > 10) [4; 42] = Some 42);
+
+  assert(List.assoc_opt 42 [] = None);
+  assert(List.assoc_opt 42 [41, false; 42, true] = Some true);
+
+  assert(List.assq_opt 42 [] = None);
+  assert(List.assq_opt 42 [41, false; 42, true] = Some true);
+
+  let h = Hashtbl.create 5 in
+  assert(Hashtbl.find_opt h 42 = None);
+  Hashtbl.add h 42 ();
+  assert(Hashtbl.find_opt h 42 = Some ());
+
+
+  let module IntSet = Set.Make(struct
+      type t = int
+      let compare = compare
+    end)
+  in
+  let set = IntSet.of_list [42; 43] in
+  assert(IntSet.min_elt_opt IntSet.empty = None);
+  assert(IntSet.min_elt_opt set = Some 42);
+
+  assert(IntSet.max_elt_opt IntSet.empty = None);
+  assert(IntSet.max_elt_opt set = Some 43);
+
+  assert(IntSet.choose_opt IntSet.empty = None);
+  assert(IntSet.choose_opt set <> None);
+
+  assert(IntSet.find_opt 42 IntSet.empty = None);
+  assert(IntSet.find_opt 42 set = Some 42);
+  assert(IntSet.find_opt 0 set = None);
+
+
+  let module IntMap = Map.Make(struct
+      type t = int
+      let compare = compare
+    end)
+  in
+  let map = IntMap.add 42 "42" (IntMap.add 43 "43" IntMap.empty) in
+  assert(IntMap.min_binding_opt IntMap.empty = None);
+  assert(IntMap.min_binding_opt map = Some (42, "42"));
+
+  assert(IntMap.max_binding_opt IntMap.empty = None);
+  assert(IntMap.max_binding_opt map = Some (43, "43"));
+
+  assert(IntMap.choose_opt IntMap.empty = None);
+  assert(IntMap.choose_opt map <> None);
+
+  assert(IntMap.find_opt 42 IntMap.empty = None);
+  assert(IntMap.find_opt 42 map = Some "42");
+  assert(IntMap.find_opt 0 map = None);
+
+
+  let s = "Hello world !" in
+  assert(String.index_opt s 'x'  = None);
+  assert(String.index_opt s ' '  = Some 5);
+
+  assert(String.rindex_opt s 'x'  = None);
+  assert(String.rindex_opt s ' '  = Some 11);
+
+  assert(String.index_from_opt s 0 'x'  = None);
+  assert(String.index_from_opt s 6 ' '  = Some 11);
+
+  assert(String.rindex_from_opt s 0 'x'  = None);
+  assert(String.rindex_from_opt s 6 ' '  = Some 5);
+
+
+  let module W = Weak.Make(struct
+      type t = int ref
+      let equal = (=)
+      let hash = Hashtbl.hash
+    end)
+  in
+  let w = W.create 10 in
+  let x = Random.int 42 in
+  let r = ref x in
+  assert (W.find_opt w r = None);
+  W.add w r;
+  assert (W.find_opt w r = Some r);
+
+  let stack = Stack.create () in
+  Stack.push 41 stack;
+  Stack.push 42 stack;
+  assert(Stack.top_opt stack = Some 42);
+  assert(Stack.pop_opt stack = Some 42);
+  assert(Stack.pop_opt stack = Some 41);
+  assert(Stack.pop_opt stack = None);
+  assert(Stack.top_opt stack = None);
+
+  let queue = Queue.create () in
+  Queue.add 41 queue;
+  Queue.add 42 queue;
+  assert(Queue.peek_opt queue = Some 41);
+  assert(Queue.take_opt queue = Some 41);
+  assert(Queue.take_opt queue = Some 42);
+  assert(Queue.take_opt queue = None);
+  assert(Queue.peek_opt queue = None);
+
+  ()
diff --git a/testsuite/tests/basic/opt_variants.reference b/testsuite/tests/basic/opt_variants.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/basic/patmatch.ml b/testsuite/tests/basic/patmatch.ml
new file mode 100644
index 00000000..cbe1ca1e
--- /dev/null
+++ b/testsuite/tests/basic/patmatch.ml
@@ -0,0 +1,1876 @@
+(* TEST *)
+
+(* Tests for matchings on integers and characters *)
+
+(* Dense integer switch *)
+
+let f = function 1 -> 1 | 2 -> 2 | 3 -> 3 | 4 -> 4 | 5 -> 5 | 6 -> 6 | _ -> 0
+
+(* Sparse integer switch *)
+
+let g = function 303 -> 1 | 401 -> 2 | _ -> 0
+
+(* Very sparse integer switch *)
+
+let iszero = function 0 -> true | _ -> false
+
+(* Simple matching on characters *)
+
+let h = function
+    'a' -> "a"
+  | 'e' -> "e"
+  | 'i' -> "i"
+  | 'o' -> "o"
+  | 'u' -> "u"
+  | _ -> "?"
+
+(* Matching with orpats *)
+
+let k = function
+    ' ' | '\t' | '\n' | '\r' -> "blk"
+  | 'A'..'Z' | 'a'..'z' | '\192'..'\255' -> "letr"
+  | '0'..'9' -> "dig"
+  | '!'|'%'|'&'|'$'|'#'|'+'|'/'|':'|'<'|'='|'>'|'?'|'@'|'\\'|
+             '~'|'^'|'|'|'*' -> "oper"
+  | _ -> "othr"
+
+(* Matching on arrays *)
+
+let p = function [| x |] -> x | _ -> assert false
+
+let q = function [| x |] -> x | _ -> 0
+
+let r = function [| x |] -> x | _ -> 0.0
+
+let l = function
+    [||] -> 0
+  | [|x|] -> x + 1
+  | [|x;y|] -> x + y
+  | [|x;y;z|] -> x + y + z
+  | _ -> assert false
+
+(* The test *)
+
+open Printf
+
+external bytes_create: int -> bytes = "caml_create_bytes"
+external unsafe_chr: int -> char = "%identity"
+external bytes_unsafe_set : bytes -> int -> char -> unit
+                           = "%bytes_unsafe_set"
+
+external unsafe_to_string : bytes -> string = "%bytes_to_string"
+
+(* The following function is roughly equivalent to Char.escaped,
+   except that it is locale-independent. *)
+let escaped = function
+  | '\'' -> "\\'"
+  | '\\' -> "\\\\"
+  | '\n' -> "\\n"
+  | '\t' -> "\\t"
+  | '\r' -> "\\r"
+  | '\b' -> "\\b"
+  | c ->
+    if ((k c) <> "othr") && ((Char.code c) <= 191) then begin
+      let s = bytes_create 1 in
+      bytes_unsafe_set s 0 c;
+      unsafe_to_string s
+    end else begin
+      let n = Char.code c in
+      let s = bytes_create 4 in
+      bytes_unsafe_set s 0 '\\';
+      bytes_unsafe_set s 1 (unsafe_chr (48 + n / 100));
+      bytes_unsafe_set s 2 (unsafe_chr (48 + (n / 10) mod 10));
+      bytes_unsafe_set s 3 (unsafe_chr (48 + n mod 10));
+      unsafe_to_string s
+    end
+
+let _ =
+  for i = -5 to 10 do printf "f(%d) = %d\n" i (f i) done;
+  List.iter (fun i -> printf "g(%d) = %d\n" i (g i))
+            [0;300;303;305;400;401;402;999];
+  for i = -2 to 2 do printf "iszero(%d) = %B\n" i (iszero i) done;
+  for i = 97 to 126 do
+    let c = Char.chr i in
+    printf "h(%c) = %s\n" c (h c)
+  done;
+  for i = 0 to 255 do
+    let c = Char.chr i in
+    printf "\tk(%s) = %s" (escaped c) (k c)
+  done;
+  printf "\n";
+  printf "p([|\"hello\"|]) = %s\n" (p [|"hello"|]);
+  printf "p([|1.0|]) = %f\n" (p [|1.0|]);
+  printf "q([|2|]) = %d\n" (q [|2|]);
+  printf "r([|3.0|]) = %f\n" (r [|3.0|]);
+  printf "l([||]) = %d\n" (l [||]);
+  printf "l([|1|]) = %d\n" (l [|1|]);
+  printf "l([|2;3|]) = %d\n" (l [|2;3|]);
+  printf "l([|4;5;6|]) = %d\n" (l [|4;5;6|])
+
+(* PR #5992 *)
+(* Was segfaulting *)
+
+let f = function
+ | lazy (), _, {contents=None} -> 0
+ | _, lazy (), {contents=Some x} -> 1
+
+let s = ref None
+let set_true = lazy (s := Some 1)
+let set_false = lazy (s := None)
+
+let () =
+  let _r = try f (set_true, set_false, s) with Match_failure _ -> 2 in
+  printf "PR#5992=Ok\n"
+
+(* PR #5788, was giving wrong result 3 *)
+exception Foo
+exception Bar = Foo
+
+let test e b =
+  match e, b with
+  | Foo, true -> 1
+  | Bar, false -> 2
+  | _, _ -> 3
+
+let () =
+  let r = test Bar false in
+  if r = 2 then printf "PR#5788=Ok\n"
+
+let test e b =
+  match e, b with
+  | Bar, false -> 0
+  | (Foo|Bar), true -> 1
+  | Foo, false -> 2
+  | _, _ -> 3
+
+
+let () =
+  let r = test Foo false in
+  if r = 0 then printf "PR#5788=Ok\n"
+
+(* PR#6646 Avoid explosion of default cases when there are many constructors *)
+
+(* This took forever to compile *)
+
+type token =
+  | Abs
+  | Acload
+  | After
+  | And
+  | Annotate
+  | Apply
+  | Arc
+  | Array
+  | Arraymacro
+  | Arrayrelatedinfo
+  | Arraysite
+  | Assign
+  | Atleast
+  | Atmost
+  | Author
+  | Basearray
+  | Becomes
+  | Between
+  | Block
+  | Boolean
+  | Booleandisplay
+  | Booleanmap
+  | Booleanvalue
+  | Borderpattern
+  | Borderwidth
+  | Boundingbox
+  | Ceiling
+  | Cell
+  | Cellref
+  | Celltype
+  | Change
+  | Circle
+  | Color
+  | Comment
+  | Commentgraphics
+  | Compound
+  | Concat
+  | Connectlocation
+  | Constant
+  | Constraint
+  | Contents
+  | Cornertype
+  | Criticality
+  | Currentmap
+  | Curve
+  | Cycle
+  | Dataorigin
+  | Dcfaninload
+  | Dcfanoutload
+  | Dcmaxfanin
+  | Dcmaxfanout
+  | Delay
+  | Delta
+  | Derivation
+  | Design
+  | Designator
+  | Difference
+  | Direction
+  | Display
+  | Divide
+  | Dominates
+  | Dot
+  | Duration
+  | E
+  | Edif
+  | Ediflevel
+  | Edifversion
+  | Else
+  | Enclosuredistance
+  | Endtype
+  | Entry
+  | Equal
+  | Escape
+  | Event
+  | Exactly
+  | External
+  | Fabricate
+  | False
+  | Figure
+  | Figurearea
+  | Figuregroup
+  | Figuregroupobject
+  | Figuregroupoverride
+  | Figuregroupref
+  | Figureperimeter
+  | Figurewidth
+  | Fillpattern
+  | Fix
+  | Floor
+  | Follow
+  | Forbiddenevent
+  | Form
+  | Globalportref
+  | Greaterthan
+  | Gridmap
+  | If
+  | Ignore
+  | Includefiguregroup
+  | Increasing
+  | Initial
+  | Instance
+  | Instancebackannotate
+  | Instancegroup
+  | Instancemap
+  | Instancenamedef
+  | Instanceref
+  | Integer
+  | Integerdisplay
+  | Interface
+  | Interfiguregroupspacing
+  | Intersection
+  | Intrafiguregroupspacing
+  | Inverse
+  | Isolated
+  | Iterate
+  | Joined
+  | Justify
+  | Keyworddisplay
+  | Keywordlevel
+  | Keywordmap
+  | Lessthan
+  | Library
+  | Libraryref
+  | Listofnets
+  | Listofports
+  | Loaddelay
+  | Logicassign
+  | Logicinput
+  | Logiclist
+  | Logicmapinput
+  | Logicmapoutput
+  | Logiconeof
+  | Logicoutput
+  | Logicport
+  | Logicref
+  | Logicvalue
+  | Logicwaveform
+  | Maintain
+  | Match
+  | Max
+  | Member
+  | Min
+  | Minomax
+  | Minomaxdisplay
+  | Mnm
+  | Mod
+  | Multiplevalueset
+  | Mustjoin
+  | Name
+  | Negate
+  | Net
+  | Netbackannotate
+  | Netbundle
+  | Netdelay
+  | Netgroup
+  | Netmap
+  | Netref
+  | Nochange
+  | Nonpermutable
+  | Not
+  | Notallowed
+  | Notchspacing
+  | Number
+  | Numberdefinition
+  | Numberdisplay
+  | Offpageconnector
+  | Offsetevent
+  | Openshape
+  | Or
+  | Orientation
+  | Origin
+  | Overhangdistance
+  | Overlapdistance
+  | Oversize
+  | Owner
+  | Page
+  | Pagesize
+  | Parameter
+  | Parameterassign
+  | Parameterdisplay
+  | Path
+  | Pathdelay
+  | Pathwidth
+  | Permutable
+  | Physicaldesignrule
+  | Plug
+  | Point
+  | Pointdisplay
+  | Pointlist
+  | Pointsubtract
+  | Pointsum
+  | Polygon
+  | Port
+  | Portbackannotate
+  | Portbundle
+  | Portdelay
+  | Portgroup
+  | Portimplementation
+  | Portinstance
+  | Portlist
+  | Portlistalias
+  | Portmap
+  | Portref
+  | Product
+  | Program
+  | Property
+  | Propertydisplay
+  | Protectionframe
+  | Pt
+  | Rangevector
+  | Rectangle
+  | Rectanglesize
+  | Rename
+  | Resolves
+  | Scale
+  | Scalex
+  | Scaley
+  | Section
+  | Shape
+  | Simulate
+  | Simulationinfo
+  | Singlevalueset
+  | Site
+  | Socket
+  | Socketset
+  | Statement
+  | Status
+  | Steady
+  | Strictlyincreasing
+  | String
+  | Stringdisplay
+  | Strong
+  | Subtract
+  | Sum
+  | Symbol
+  | Symmetry
+  | Table
+  | Tabledefault
+  | Technology
+  | Textheight
+  | Then
+  | Timeinterval
+  | Timestamp
+  | Timing
+  | Transform
+  | Transition
+  | Trigger
+  | True
+  | Typedvalue
+  | Unconstrained
+  | Undefined
+  | Union
+  | Unit
+  | Unused
+  | Userdata
+  | Valuenameref
+  | Variable
+  | Version
+  | View
+  | Viewlist
+  | Viewmap
+  | Viewref
+  | Viewtype
+  | Visible
+  | Voltagemap
+  | Wavevalue
+  | Weak
+  | Weakjoined
+  | When
+  | While
+  | Written
+  | Xcoord
+  | Xor
+  | Ycoord
+  | ILLEGAL of (char)
+  | ID of (string)
+  | TLIST of (token list)
+  | TLIST2 of (token list*token list)
+  | ITEM of (token*token)
+  | ITEM2 of (token*token*token)
+  | STRING of (string)
+  | INT of (int)
+  | ENDOFFILE
+  | EOL
+  | LPAREN
+  | RPAREN
+  | EMPTY
+
+let test_match tok = match tok with
+  | ITEM2(Array, ITEM (Rename, TLIST [ID id; STRING str]), INT idx) ->
+      1
+  | ITEM2(Cellref, TLIST [ID id], TLIST lst) ->
+      2
+  | ITEM2(Cell, TLIST [ID cellid], TLIST lst) ->
+      3
+  | ITEM2(Contents, TLIST lst1, TLIST lst2) ->
+      4
+  | ITEM2(Design, TLIST [ID id], TLIST lst) ->
+      5
+  | ITEM2(Edif, TLIST [ID id], TLIST lst) ->
+      6
+  | ITEM2(Instance,
+          TLIST [ID instid],
+          TLIST[ITEM2(Viewref, TLIST [ID netlist],
+                      TLIST[ITEM(Cellref, TLIST [ID cellid])])]) ->
+      7
+
+
+  | ITEM2(Instance,
+          TLIST [ID instid],
+          TLIST[ITEM2(Viewref, TLIST [ID netlist],
+                      TLIST[ITEM2(Cellref, TLIST [ID cellid],
+                                  TLIST [ITEM (Libraryref,
+                                               TLIST [ID libid])])])]) ->
+      8
+(* *)
+  | ITEM2(Instance, TLIST [ID instid],
+                    TLIST [ITEM2(viewref,
+                                 TLIST [ID netlist],
+                                 TLIST [ITEM2(cellref,
+                                              TLIST [ID cellid],
+                                              TLIST [ITEM(libraryref,
+                                                          TLIST [ID libid])])]);
+                    ITEM2(property, TLIST [ID xstlib],
+                                    TLIST [ITEM2(bool1,
+                                                 TLIST [],
+                                                 TLIST [ITEM(True, TLIST [])]);
+                                    ITEM(owner, TLIST [str])])]) ->  9
+(* *)
+  | ITEM2(Interface, TLIST [], TLIST lst) -> 100
+  | ITEM2(Joined, TLIST [], TLIST lst) -> 10
+  | ITEM2(Keywordmap, TLIST lst1, TLIST lst2) -> 11
+  | ITEM2(Library, TLIST [], TLIST lst) -> 12
+  | ITEM2(Library, TLIST [ID libid], TLIST lst) -> 13
+  | ITEM2(Net, TLIST [], TLIST [ITEM (Rename, TLIST [ID oldid; STRING newid]);
+        ITEM2(Joined, TLIST [],
+          TLIST portlst)]) -> 14
+  | ITEM2(Net, TLIST [ID netid], TLIST [ITEM2(Joined, TLIST [],
+          TLIST portlst)]) -> 15
+  | ITEM2(Net, _, _) -> 16
+  | ITEM2(Port, TLIST [], TLIST lst) -> 17
+  | ITEM2(Port, TLIST [ID id], TLIST lst) -> 18
+  | ITEM2(Portref, TLIST [ID id], TLIST [ITEM (Instanceref, TLIST [ID ref])]) ->
+      19
+  | ITEM2(Portref, TLIST [], TLIST [ITEM (Member, TLIST [ID mref; INT idx])]) ->
+      20
+  | ITEM2(Portref, TLIST [], TLIST[ITEM (Member, TLIST [ID mref; INT idx]);
+                                   ITEM (Instanceref, TLIST [ID instref])]) ->
+      21
+  | ITEM2(Program, TLIST [STRING progid], TLIST lst) ->21
+  | ITEM2(Property, TLIST [ID part], TLIST lst) -> 22
+  | ITEM2(Status, TLIST lst1, TLIST lst2) -> 23
+  | ITEM2(Technology, TLIST lst1, TLIST lst2) -> 24
+  | ITEM2(View, TLIST [ID netlist], TLIST lst) -> 25
+  | ITEM2(Viewref, TLIST [ID "netlist"], TLIST lst) -> 26
+  | ITEM2(Written, TLIST lst1, TLIST lst2) ->  27
+  | ITEM2(External, TLIST lst1, TLIST lst2) -> 28
+  | ITEM(Integer, TLIST [INT n]) -> 29
+  | ITEM (Author, TLIST [STRING author]) -> 30
+  | ITEM (Cellref, TLIST [ID id]) -> 31
+  | ITEM (Celltype, TLIST [ID "GENERIC"]) -> 32
+  | ITEM (Direction, TLIST [ID dir]) -> 32 (* print_endline dir *)
+  | ITEM (Ediflevel, TLIST [INT 0]) -> 32
+  | ITEM (Edifversion, TLIST [INT 2; INT 0; INT 0]) -> 32
+  | ITEM (Instanceref, TLIST [ID id]) -> 32
+  | ITEM (Keywordlevel, TLIST [INT 0]) -> 32
+  | ITEM (Libraryref, TLIST [ID "work"]) -> 32
+  | ITEM (Libraryref, TLIST [ID "xilinx"]) -> 32
+  | ITEM (Member, TLIST [ID id; INT n]) -> 32
+  | ITEM (Numberdefinition, TLIST []) -> 32
+  | ITEM (Owner, TLIST [STRING "\"Xilinx\""]) -> 32
+  | ITEM (Portref, TLIST [ID id]) -> 32
+  | ITEM (Rename, TLIST [ID id; STRING str]) -> 33
+  | ITEM (String, TLIST [STRING str]) -> 32
+  | ITEM (String, TLIST lst) -> 34
+  | ITEM (Timestamp, TLIST [INT yr; INT mon; INT day; INT hour; INT min;
+                            INT sec]) ->
+      32
+  | ITEM (Version, TLIST [STRING str]) -> 32
+  | ITEM (Viewtype, TLIST [ID "NETLIST"]) -> 32
+  | ITEM (Designator, TLIST lst) -> 34
+  | Abs -> failwith " Abs "
+  | Acload -> failwith " Acload "
+  | After -> failwith " After "
+  | And -> failwith " And "
+  | Annotate -> failwith " Annotate "
+  | Apply -> failwith " Apply "
+  | Arc -> failwith " Arc "
+  | Array -> failwith " Array "
+  | Arraymacro -> failwith " Arraymacro "
+  | Arrayrelatedinfo -> failwith " Arrayrelatedinfo "
+  | Arraysite -> failwith " Arraysite "
+  | Assign -> failwith " Assign "
+  | Atleast -> failwith " Atleast "
+  | Atmost -> failwith " Atmost "
+  | Author -> failwith " Author "
+  | Basearray -> failwith " Basearray "
+  | Becomes -> failwith " Becomes "
+  | Between -> failwith " Between "
+  | Block -> failwith " Block "
+  | Boolean -> failwith " Boolean "
+  | Booleandisplay -> failwith " Booleandisplay "
+  | Booleanmap -> failwith " Booleanmap "
+  | Booleanvalue -> failwith " Booleanvalue "
+  | Borderpattern -> failwith " Borderpattern "
+  | Borderwidth -> failwith " Borderwidth "
+  | Boundingbox -> failwith " Boundingbox "
+  | Ceiling -> failwith " Ceiling "
+  | Cell -> failwith " Cell "
+  | Cellref -> failwith " Cellref "
+  | Celltype -> failwith " Celltype "
+  | Change -> failwith " Change "
+  | Circle -> failwith " Circle "
+  | Color -> failwith " Color "
+  | Comment -> failwith " Comment "
+  | Commentgraphics -> failwith " Commentgraphics "
+  | Compound -> failwith " Compound "
+  | Concat -> failwith " Concat "
+  | Connectlocation -> failwith " Connectlocation "
+  | Constant -> failwith " Constant "
+  | Constraint -> failwith " Constraint "
+  | Contents -> failwith " Contents "
+  | Cornertype -> failwith " Cornertype "
+  | Criticality -> failwith " Criticality "
+  | Currentmap -> failwith " Currentmap "
+  | Curve -> failwith " Curve "
+  | Cycle -> failwith " Cycle "
+  | Dataorigin -> failwith " Dataorigin "
+  | Dcfaninload -> failwith " Dcfaninload "
+  | Dcfanoutload -> failwith " Dcfanoutload "
+  | Dcmaxfanin -> failwith " Dcmaxfanin "
+  | Dcmaxfanout -> failwith " Dcmaxfanout "
+  | Delay -> failwith " Delay "
+  | Delta -> failwith " Delta "
+  | Derivation -> failwith " Derivation "
+  | Design -> failwith " Design "
+  | Designator -> failwith " Designator "
+  | Difference -> failwith " Difference "
+  | Direction -> failwith " Direction "
+  | Display -> failwith " Display "
+  | Divide -> failwith " Divide "
+  | Dominates -> failwith " Dominates "
+  | Dot -> failwith " Dot "
+  | Duration -> failwith " Duration "
+  | E -> failwith " E "
+  | Edif -> failwith " Edif "
+  | Ediflevel -> failwith " Ediflevel "
+  | Edifversion -> failwith " Edifversion "
+  | Else -> failwith " Else "
+  | Enclosuredistance -> failwith " Enclosuredistance "
+  | Endtype -> failwith " Endtype "
+  | Entry -> failwith " Entry "
+  | Equal -> failwith " Equal "
+  | Escape -> failwith " Escape "
+  | Event -> failwith " Event "
+  | Exactly -> failwith " Exactly "
+  | External -> failwith " External "
+  | Fabricate -> failwith " Fabricate "
+  | False -> failwith " False "
+  | Figure -> failwith " Figure "
+  | Figurearea -> failwith " Figurearea "
+  | Figuregroup -> failwith " Figuregroup "
+  | Figuregroupobject -> failwith " Figuregroupobject "
+  | Figuregroupoverride -> failwith " Figuregroupoverride "
+  | Figuregroupref -> failwith " Figuregroupref "
+  | Figureperimeter -> failwith " Figureperimeter "
+  | Figurewidth -> failwith " Figurewidth "
+  | Fillpattern -> failwith " Fillpattern "
+  | Fix -> failwith " Fix "
+  | Floor -> failwith " Floor "
+  | Follow -> failwith " Follow "
+  | Forbiddenevent -> failwith " Forbiddenevent "
+  | Form -> failwith " Form "
+  | Globalportref -> failwith " Globalportref "
+  | Greaterthan -> failwith " Greaterthan "
+  | Gridmap -> failwith " Gridmap "
+  | If -> failwith " If "
+  | Ignore -> failwith " Ignore "
+  | Includefiguregroup -> failwith " Includefiguregroup "
+  | Increasing -> failwith " Increasing "
+  | Initial -> failwith " Initial "
+  | Instance -> failwith " Instance "
+  | Instancebackannotate -> failwith " Instancebackannotate "
+  | Instancegroup -> failwith " Instancegroup "
+  | Instancemap -> failwith " Instancemap "
+  | Instancenamedef -> failwith " Instancenamedef "
+  | Instanceref -> failwith " Instanceref "
+  | Integer -> failwith " Integer "
+  | Integerdisplay -> failwith " Integerdisplay "
+  | Interface -> failwith " Interface "
+  | Interfiguregroupspacing -> failwith " Interfiguregroupspacing "
+  | Intersection -> failwith " Intersection "
+  | Intrafiguregroupspacing -> failwith " Intrafiguregroupspacing "
+  | Inverse -> failwith " Inverse "
+  | Isolated -> failwith " Isolated "
+  | Iterate -> failwith " Iterate "
+  | Joined -> failwith " Joined "
+  | Justify -> failwith " Justify "
+  | Keyworddisplay -> failwith " Keyworddisplay "
+  | Keywordlevel -> failwith " Keywordlevel "
+  | Keywordmap -> failwith " Keywordmap "
+  | Lessthan -> failwith " Lessthan "
+  | Library -> failwith " Library "
+  | Libraryref -> failwith " Libraryref "
+  | Listofnets -> failwith " Listofnets "
+  | Listofports -> failwith " Listofports "
+  | Loaddelay -> failwith " Loaddelay "
+  | Logicassign -> failwith " Logicassign "
+  | Logicinput -> failwith " Logicinput "
+  | Logiclist -> failwith " Logiclist "
+  | Logicmapinput -> failwith " Logicmapinput "
+  | Logicmapoutput -> failwith " Logicmapoutput "
+  | Logiconeof -> failwith " Logiconeof "
+  | Logicoutput -> failwith " Logicoutput "
+  | Logicport -> failwith " Logicport "
+  | Logicref -> failwith " Logicref "
+  | Logicvalue -> failwith " Logicvalue "
+  | Logicwaveform -> failwith " Logicwaveform "
+  | Maintain -> failwith " Maintain "
+  | Match -> failwith " Match "
+  | Max -> failwith " Max "
+  | Member -> failwith " Member "
+  | Min -> failwith " Min "
+  | Minomax -> failwith " Minomax "
+  | Minomaxdisplay -> failwith " Minomaxdisplay "
+  | Mnm -> failwith " Mnm "
+  | Mod -> failwith " Mod "
+  | Multiplevalueset -> failwith " Multiplevalueset "
+  | Mustjoin -> failwith " Mustjoin "
+  | Name -> failwith " Name "
+  | Negate -> failwith " Negate "
+  | Net -> failwith " Net "
+  | Netbackannotate -> failwith " Netbackannotate "
+  | Netbundle -> failwith " Netbundle "
+  | Netdelay -> failwith " Netdelay "
+  | Netgroup -> failwith " Netgroup "
+  | Netmap -> failwith " Netmap "
+  | Netref -> failwith " Netref "
+  | Nochange -> failwith " Nochange "
+  | Nonpermutable -> failwith " Nonpermutable "
+  | Not -> failwith " Not "
+  | Notallowed -> failwith " Notallowed "
+  | Notchspacing -> failwith " Notchspacing "
+  | Number -> failwith " Number "
+  | Numberdefinition -> failwith " Numberdefinition "
+  | Numberdisplay -> failwith " Numberdisplay "
+  | Offpageconnector -> failwith " Offpageconnector "
+  | Offsetevent -> failwith " Offsetevent "
+  | Openshape -> failwith " Openshape "
+  | Or -> failwith " Or "
+  | Orientation -> failwith " Orientation "
+  | Origin -> failwith " Origin "
+  | Overhangdistance -> failwith " Overhangdistance "
+  | Overlapdistance -> failwith " Overlapdistance "
+  | Oversize -> failwith " Oversize "
+  | Owner -> failwith " Owner "
+  | Page -> failwith " Page "
+  | Pagesize -> failwith " Pagesize "
+  | Parameter -> failwith " Parameter "
+  | Parameterassign -> failwith " Parameterassign "
+  | Parameterdisplay -> failwith " Parameterdisplay "
+  | Path -> failwith " Path "
+  | Pathdelay -> failwith " Pathdelay "
+  | Pathwidth -> failwith " Pathwidth "
+  | Permutable -> failwith " Permutable "
+  | Physicaldesignrule -> failwith " Physicaldesignrule "
+  | Plug -> failwith " Plug "
+  | Point -> failwith " Point "
+  | Pointdisplay -> failwith " Pointdisplay "
+  | Pointlist -> failwith " Pointlist "
+  | Pointsubtract -> failwith " Pointsubtract "
+  | Pointsum -> failwith " Pointsum "
+  | Polygon -> failwith " Polygon "
+  | Port -> failwith " Port "
+  | Portbackannotate -> failwith " Portbackannotate "
+  | Portbundle -> failwith " Portbundle "
+  | Portdelay -> failwith " Portdelay "
+  | Portgroup -> failwith " Portgroup "
+  | Portimplementation -> failwith " Portimplementation "
+  | Portinstance -> failwith " Portinstance "
+  | Portlist -> failwith " Portlist "
+  | Portlistalias -> failwith " Portlistalias "
+  | Portmap -> failwith " Portmap "
+  | Portref -> failwith " Portref "
+  | Product -> failwith " Product "
+  | Program -> failwith " Program "
+  | Property -> failwith " Property "
+  | Propertydisplay -> failwith " Propertydisplay "
+  | Protectionframe -> failwith " Protectionframe "
+  | Pt -> failwith " Pt "
+  | Rangevector -> failwith " Rangevector "
+  | Rectangle -> failwith " Rectangle "
+  | Rectanglesize -> failwith " Rectanglesize "
+  | Rename -> failwith " Rename "
+  | Resolves -> failwith " Resolves "
+  | Scale -> failwith " Scale "
+  | Scalex -> failwith " Scalex "
+  | Scaley -> failwith " Scaley "
+  | Section -> failwith " Section "
+  | Shape -> failwith " Shape "
+  | Simulate -> failwith " Simulate "
+  | Simulationinfo -> failwith " Simulationinfo "
+  | Singlevalueset -> failwith " Singlevalueset "
+  | Site -> failwith " Site "
+  | Socket -> failwith " Socket "
+  | Socketset -> failwith " Socketset "
+  | Statement -> failwith " Statement "
+  | Status -> failwith " Status "
+  | Steady -> failwith " Steady "
+  | Strictlyincreasing -> failwith " Strictlyincreasing "
+  | String -> failwith " String "
+  | Stringdisplay -> failwith " Stringdisplay "
+  | Strong -> failwith " Strong "
+  | Subtract -> failwith " Subtract "
+  | Sum -> failwith " Sum "
+  | Symbol -> failwith " Symbol "
+  | Symmetry -> failwith " Symmetry "
+  | Table -> failwith " Table "
+  | Tabledefault -> failwith " Tabledefault "
+  | Technology -> failwith " Technology "
+  | Textheight -> failwith " Textheight "
+  | Then -> failwith " Then "
+  | Timeinterval -> failwith " Timeinterval "
+  | Timestamp -> failwith " Timestamp "
+  | Timing -> failwith " Timing "
+  | Transform -> failwith " Transform "
+  | Transition -> failwith " Transition "
+  | Trigger -> failwith " Trigger "
+  | True -> failwith " True "
+  | Typedvalue -> failwith " Typedvalue "
+  | Unconstrained -> failwith " Unconstrained "
+  | Undefined -> failwith " Undefined "
+  | Union -> failwith " Union "
+  | Unit -> failwith " Unit "
+  | Unused -> failwith " Unused "
+  | Userdata -> failwith " Userdata "
+  | Valuenameref -> failwith " Valuenameref "
+  | Variable -> failwith " Variable "
+  | Version -> failwith " Version "
+  | View -> failwith " View "
+  | Viewlist -> failwith " Viewlist "
+  | Viewmap -> failwith " Viewmap "
+  | Viewref -> failwith " Viewref "
+  | Viewtype -> failwith " Viewtype "
+  | Visible -> failwith " Visible "
+  | Voltagemap -> failwith " Voltagemap "
+  | Wavevalue -> failwith " Wavevalue "
+  | Weak -> failwith " Weak "
+  | Weakjoined -> failwith " Weakjoined "
+  | When -> failwith " When "
+  | While -> failwith " While "
+  | Written -> failwith " Written "
+  | Xcoord -> failwith " Xcoord "
+  | Xor -> failwith " Xor "
+  | Ycoord -> failwith " Ycoord "
+  | ILLEGAL _ -> failwith " ILLEGAL _ "
+  | ID _ -> failwith " ID _ "
+  | TLIST _ -> failwith " TLIST _ "
+  | TLIST2 _ -> failwith " TLIST2 _ "
+  | STRING _ -> failwith " STRING _ "
+  | INT _ -> failwith " INT _ "
+  | ENDOFFILE -> failwith " ENDOFFILE "
+  | EOL -> failwith " EOL "
+  | LPAREN -> failwith " LPAREN "
+  | RPAREN -> failwith " RPAREN "
+  | EMPTY -> failwith " EMPTY "
+
+  | ITEM2(Abs, _, _) -> failwith " ITEM2(Abs, _, _) "
+  | ITEM2(Acload, _, _) -> failwith " ITEM2(Acload, _, _) "
+  | ITEM2(After, _, _) -> failwith " ITEM2(After, _, _) "
+  | ITEM2(And, _, _) -> failwith " ITEM2(And, _, _) "
+  | ITEM2(Annotate, _, _) -> failwith " ITEM2(Annotate, _, _) "
+  | ITEM2(Apply, _, _) -> failwith " ITEM2(Apply, _, _) "
+  | ITEM2(Arc, _, _) -> failwith " ITEM2(Arc, _, _) "
+  | ITEM2(Array, _, _) -> failwith " ITEM2(Array, _, _) "
+  | ITEM2(Arraymacro, _, _) -> failwith " ITEM2(Arraymacro, _, _) "
+  | ITEM2(Arrayrelatedinfo, _, _) -> failwith " ITEM2(Arrayrelatedinfo, _, _) "
+  | ITEM2(Arraysite, _, _) -> failwith " ITEM2(Arraysite, _, _) "
+  | ITEM2(Assign, _, _) -> failwith " ITEM2(Assign, _, _) "
+  | ITEM2(Atleast, _, _) -> failwith " ITEM2(Atleast, _, _) "
+  | ITEM2(Atmost, _, _) -> failwith " ITEM2(Atmost, _, _) "
+  | ITEM2(Author, _, _) -> failwith " ITEM2(Author, _, _) "
+  | ITEM2(Basearray, _, _) -> failwith " ITEM2(Basearray, _, _) "
+  | ITEM2(Becomes, _, _) -> failwith " ITEM2(Becomes, _, _) "
+  | ITEM2(Between, _, _) -> failwith " ITEM2(Between, _, _) "
+  | ITEM2(Block, _, _) -> failwith " ITEM2(Block, _, _) "
+  | ITEM2(Boolean, _, _) -> failwith " ITEM2(Boolean, _, _) "
+  | ITEM2(Booleandisplay, _, _) -> failwith " ITEM2(Booleandisplay, _, _) "
+  | ITEM2(Booleanmap, _, _) -> failwith " ITEM2(Booleanmap, _, _) "
+  | ITEM2(Booleanvalue, _, _) -> failwith " ITEM2(Booleanvalue, _, _) "
+  | ITEM2(Borderpattern, _, _) -> failwith " ITEM2(Borderpattern, _, _) "
+  | ITEM2(Borderwidth, _, _) -> failwith " ITEM2(Borderwidth, _, _) "
+  | ITEM2(Boundingbox, _, _) -> failwith " ITEM2(Boundingbox, _, _) "
+  | ITEM2(Ceiling, _, _) -> failwith " ITEM2(Ceiling, _, _) "
+  | ITEM2(Cell, _, _) -> failwith " ITEM2(Cell, _, _) "
+  | ITEM2(Cellref, _, _) -> failwith " ITEM2(Cellref, _, _) "
+  | ITEM2(Celltype, _, _) -> failwith " ITEM2(Celltype, _, _) "
+  | ITEM2(Change, _, _) -> failwith " ITEM2(Change, _, _) "
+  | ITEM2(Circle, _, _) -> failwith " ITEM2(Circle, _, _) "
+  | ITEM2(Color, _, _) -> failwith " ITEM2(Color, _, _) "
+  | ITEM2(Comment, _, _) -> failwith " ITEM2(Comment, _, _) "
+  | ITEM2(Commentgraphics, _, _) -> failwith " ITEM2(Commentgraphics, _, _) "
+  | ITEM2(Compound, _, _) -> failwith " ITEM2(Compound, _, _) "
+  | ITEM2(Concat, _, _) -> failwith " ITEM2(Concat, _, _) "
+  | ITEM2(Connectlocation, _, _) -> failwith " ITEM2(Connectlocation, _, _) "
+  | ITEM2(Constant, _, _) -> failwith " ITEM2(Constant, _, _) "
+  | ITEM2(Constraint, _, _) -> failwith " ITEM2(Constraint, _, _) "
+  | ITEM2(Contents, _, _) -> failwith " ITEM2(Contents, _, _) "
+  | ITEM2(Cornertype, _, _) -> failwith " ITEM2(Cornertype, _, _) "
+  | ITEM2(Criticality, _, _) -> failwith " ITEM2(Criticality, _, _) "
+  | ITEM2(Currentmap, _, _) -> failwith " ITEM2(Currentmap, _, _) "
+  | ITEM2(Curve, _, _) -> failwith " ITEM2(Curve, _, _) "
+  | ITEM2(Cycle, _, _) -> failwith " ITEM2(Cycle, _, _) "
+  | ITEM2(Dataorigin, _, _) -> failwith " ITEM2(Dataorigin, _, _) "
+  | ITEM2(Dcfaninload, _, _) -> failwith " ITEM2(Dcfaninload, _, _) "
+  | ITEM2(Dcfanoutload, _, _) -> failwith " ITEM2(Dcfanoutload, _, _) "
+  | ITEM2(Dcmaxfanin, _, _) -> failwith " ITEM2(Dcmaxfanin, _, _) "
+  | ITEM2(Dcmaxfanout, _, _) -> failwith " ITEM2(Dcmaxfanout, _, _) "
+  | ITEM2(Delay, _, _) -> failwith " ITEM2(Delay, _, _) "
+  | ITEM2(Delta, _, _) -> failwith " ITEM2(Delta, _, _) "
+  | ITEM2(Derivation, _, _) -> failwith " ITEM2(Derivation, _, _) "
+  | ITEM2(Design, _, _) -> failwith " ITEM2(Design, _, _) "
+  | ITEM2(Designator, _, _) -> failwith " ITEM2(Designator, _, _) "
+  | ITEM2(Difference, _, _) -> failwith " ITEM2(Difference, _, _) "
+  | ITEM2(Direction, _, _) -> failwith " ITEM2(Direction, _, _) "
+  | ITEM2(Display, _, _) -> failwith " ITEM2(Display, _, _) "
+  | ITEM2(Divide, _, _) -> failwith " ITEM2(Divide, _, _) "
+  | ITEM2(Dominates, _, _) -> failwith " ITEM2(Dominates, _, _) "
+  | ITEM2(Dot, _, _) -> failwith " ITEM2(Dot, _, _) "
+  | ITEM2(Duration, _, _) -> failwith " ITEM2(Duration, _, _) "
+  | ITEM2(E, _, _) -> failwith " ITEM2(E, _, _) "
+  | ITEM2(Edif, _, _) -> failwith " ITEM2(Edif, _, _) "
+  | ITEM2(Ediflevel, _, _) -> failwith " ITEM2(Ediflevel, _, _) "
+  | ITEM2(Edifversion, _, _) -> failwith " ITEM2(Edifversion, _, _) "
+  | ITEM2(Else, _, _) -> failwith " ITEM2(Else, _, _) "
+  | ITEM2(Enclosuredistance, _, _) ->
+      failwith " ITEM2(Enclosuredistance, _, _) "
+  | ITEM2(Endtype, _, _) -> failwith " ITEM2(Endtype, _, _) "
+  | ITEM2(Entry, _, _) -> failwith " ITEM2(Entry, _, _) "
+  | ITEM2(Equal, _, _) -> failwith " ITEM2(Equal, _, _) "
+  | ITEM2(Escape, _, _) -> failwith " ITEM2(Escape, _, _) "
+  | ITEM2(Event, _, _) -> failwith " ITEM2(Event, _, _) "
+  | ITEM2(Exactly, _, _) -> failwith " ITEM2(Exactly, _, _) "
+  | ITEM2(External, _, _) -> failwith " ITEM2(External, _, _) "
+  | ITEM2(Fabricate, _, _) -> failwith " ITEM2(Fabricate, _, _) "
+  | ITEM2(False, _, _) -> failwith " ITEM2(False, _, _) "
+  | ITEM2(Figure, _, _) -> failwith " ITEM2(Figure, _, _) "
+  | ITEM2(Figurearea, _, _) -> failwith " ITEM2(Figurearea, _, _) "
+  | ITEM2(Figuregroup, _, _) -> failwith " ITEM2(Figuregroup, _, _) "
+  | ITEM2(Figuregroupobject, _, _) ->
+      failwith " ITEM2(Figuregroupobject, _, _) "
+  | ITEM2(Figuregroupoverride, _, _) ->
+      failwith " ITEM2(Figuregroupoverride, _, _) "
+  | ITEM2(Figuregroupref, _, _) -> failwith " ITEM2(Figuregroupref, _, _) "
+  | ITEM2(Figureperimeter, _, _) -> failwith " ITEM2(Figureperimeter, _, _) "
+  | ITEM2(Figurewidth, _, _) -> failwith " ITEM2(Figurewidth, _, _) "
+  | ITEM2(Fillpattern, _, _) -> failwith " ITEM2(Fillpattern, _, _) "
+  | ITEM2(Fix, _, _) -> failwith " ITEM2(Fix, _, _) "
+  | ITEM2(Floor, _, _) -> failwith " ITEM2(Floor, _, _) "
+  | ITEM2(Follow, _, _) -> failwith " ITEM2(Follow, _, _) "
+  | ITEM2(Forbiddenevent, _, _) -> failwith " ITEM2(Forbiddenevent, _, _) "
+  | ITEM2(Form, _, _) -> failwith " ITEM2(Form, _, _) "
+  | ITEM2(Globalportref, _, _) -> failwith " ITEM2(Globalportref, _, _) "
+  | ITEM2(Greaterthan, _, _) -> failwith " ITEM2(Greaterthan, _, _) "
+  | ITEM2(Gridmap, _, _) -> failwith " ITEM2(Gridmap, _, _) "
+  | ITEM2(If, _, _) -> failwith " ITEM2(If, _, _) "
+  | ITEM2(Ignore, _, _) -> failwith " ITEM2(Ignore, _, _) "
+  | ITEM2(Includefiguregroup, _, _) ->
+      failwith " ITEM2(Includefiguregroup, _, _) "
+  | ITEM2(Increasing, _, _) -> failwith " ITEM2(Increasing, _, _) "
+  | ITEM2(Initial, _, _) -> failwith " ITEM2(Initial, _, _) "
+  | ITEM2(Instance, arg1, arg2) -> failwith (" ITEM2(Instance, ) ")
+  | ITEM2(Instancebackannotate, _, _) ->
+      failwith " ITEM2(Instancebackannotate, _, _) "
+  | ITEM2(Instancegroup, _, _) -> failwith " ITEM2(Instancegroup, _, _) "
+  | ITEM2(Instancemap, _, _) -> failwith " ITEM2(Instancemap, _, _) "
+  | ITEM2(Instancenamedef, _, _) -> failwith " ITEM2(Instancenamedef, _, _) "
+  | ITEM2(Instanceref, _, _) -> failwith " ITEM2(Instanceref, _, _) "
+  | ITEM2(Integer, _, _) -> failwith " ITEM2(Integer, _, _) "
+  | ITEM2(Integerdisplay, _, _) -> failwith " ITEM2(Integerdisplay, _, _) "
+  | ITEM2(Interface, _, _) -> failwith " ITEM2(Interface, _, _) "
+  | ITEM2(Interfiguregroupspacing, _, _) ->
+      failwith " ITEM2(Interfiguregroupspacing, _, _) "
+  | ITEM2(Intersection, _, _) -> failwith " ITEM2(Intersection, _, _) "
+  | ITEM2(Intrafiguregroupspacing, _, _) ->
+      failwith " ITEM2(Intrafiguregroupspacing, _, _) "
+  | ITEM2(Inverse, _, _) -> failwith " ITEM2(Inverse, _, _) "
+  | ITEM2(Isolated, _, _) -> failwith " ITEM2(Isolated, _, _) "
+  | ITEM2(Iterate, _, _) -> failwith " ITEM2(Iterate, _, _) "
+  | ITEM2(Joined, _, _) -> failwith " ITEM2(Joined, _, _) "
+  | ITEM2(Justify, _, _) -> failwith " ITEM2(Justify, _, _) "
+  | ITEM2(Keyworddisplay, _, _) -> failwith " ITEM2(Keyworddisplay, _, _) "
+  | ITEM2(Keywordlevel, _, _) -> failwith " ITEM2(Keywordlevel, _, _) "
+  | ITEM2(Keywordmap, _, _) -> failwith " ITEM2(Keywordmap, _, _) "
+  | ITEM2(Lessthan, _, _) -> failwith " ITEM2(Lessthan, _, _) "
+  | ITEM2(Library, _, _) -> failwith " ITEM2(Library, _, _) "
+  | ITEM2(Libraryref, _, _) -> failwith " ITEM2(Libraryref, _, _) "
+  | ITEM2(Listofnets, _, _) -> failwith " ITEM2(Listofnets, _, _) "
+  | ITEM2(Listofports, _, _) -> failwith " ITEM2(Listofports, _, _) "
+  | ITEM2(Loaddelay, _, _) -> failwith " ITEM2(Loaddelay, _, _) "
+  | ITEM2(Logicassign, _, _) -> failwith " ITEM2(Logicassign, _, _) "
+  | ITEM2(Logicinput, _, _) -> failwith " ITEM2(Logicinput, _, _) "
+  | ITEM2(Logiclist, _, _) -> failwith " ITEM2(Logiclist, _, _) "
+  | ITEM2(Logicmapinput, _, _) -> failwith " ITEM2(Logicmapinput, _, _) "
+  | ITEM2(Logicmapoutput, _, _) -> failwith " ITEM2(Logicmapoutput, _, _) "
+  | ITEM2(Logiconeof, _, _) -> failwith " ITEM2(Logiconeof, _, _) "
+  | ITEM2(Logicoutput, _, _) -> failwith " ITEM2(Logicoutput, _, _) "
+  | ITEM2(Logicport, _, _) -> failwith " ITEM2(Logicport, _, _) "
+  | ITEM2(Logicref, _, _) -> failwith " ITEM2(Logicref, _, _) "
+  | ITEM2(Logicvalue, _, _) -> failwith " ITEM2(Logicvalue, _, _) "
+  | ITEM2(Logicwaveform, _, _) -> failwith " ITEM2(Logicwaveform, _, _) "
+  | ITEM2(Maintain, _, _) -> failwith " ITEM2(Maintain, _, _) "
+  | ITEM2(Match, _, _) -> failwith " ITEM2(Match, _, _) "
+  | ITEM2(Max, _, _) -> failwith " ITEM2(Max, _, _) "
+  | ITEM2(Member, _, _) -> failwith " ITEM2(Member, _, _) "
+  | ITEM2(Min, _, _) -> failwith " ITEM2(Min, _, _) "
+  | ITEM2(Minomax, _, _) -> failwith " ITEM2(Minomax, _, _) "
+  | ITEM2(Minomaxdisplay, _, _) -> failwith " ITEM2(Minomaxdisplay, _, _) "
+  | ITEM2(Mnm, _, _) -> failwith " ITEM2(Mnm, _, _) "
+  | ITEM2(Mod, _, _) -> failwith " ITEM2(Mod, _, _) "
+  | ITEM2(Multiplevalueset, _, _) -> failwith " ITEM2(Multiplevalueset, _, _) "
+  | ITEM2(Mustjoin, _, _) -> failwith " ITEM2(Mustjoin, _, _) "
+  | ITEM2(Name, _, _) -> failwith " ITEM2(Name, _, _) "
+  | ITEM2(Negate, _, _) -> failwith " ITEM2(Negate, _, _) "
+(*
+  | ITEM2(Net, _, _) -> failwith " ITEM2(Net, _, _) "
+*)
+  | ITEM2(Netbackannotate, _, _) -> failwith " ITEM2(Netbackannotate, _, _) "
+  | ITEM2(Netbundle, _, _) -> failwith " ITEM2(Netbundle, _, _) "
+  | ITEM2(Netdelay, _, _) -> failwith " ITEM2(Netdelay, _, _) "
+  | ITEM2(Netgroup, _, _) -> failwith " ITEM2(Netgroup, _, _) "
+  | ITEM2(Netmap, _, _) -> failwith " ITEM2(Netmap, _, _) "
+  | ITEM2(Netref, _, _) -> failwith " ITEM2(Netref, _, _) "
+  | ITEM2(Nochange, _, _) -> failwith " ITEM2(Nochange, _, _) "
+  | ITEM2(Nonpermutable, _, _) -> failwith " ITEM2(Nonpermutable, _, _) "
+  | ITEM2(Not, _, _) -> failwith " ITEM2(Not, _, _) "
+  | ITEM2(Notallowed, _, _) -> failwith " ITEM2(Notallowed, _, _) "
+  | ITEM2(Notchspacing, _, _) -> failwith " ITEM2(Notchspacing, _, _) "
+  | ITEM2(Number, _, _) -> failwith " ITEM2(Number, _, _) "
+  | ITEM2(Numberdefinition, _, _) -> failwith " ITEM2(Numberdefinition, _, _) "
+  | ITEM2(Numberdisplay, _, _) -> failwith " ITEM2(Numberdisplay, _, _) "
+  | ITEM2(Offpageconnector, _, _) -> failwith " ITEM2(Offpageconnector, _, _) "
+  | ITEM2(Offsetevent, _, _) -> failwith " ITEM2(Offsetevent, _, _) "
+  | ITEM2(Openshape, _, _) -> failwith " ITEM2(Openshape, _, _) "
+  | ITEM2(Or, _, _) -> failwith " ITEM2(Or, _, _) "
+  | ITEM2(Orientation, _, _) -> failwith " ITEM2(Orientation, _, _) "
+  | ITEM2(Origin, _, _) -> failwith " ITEM2(Origin, _, _) "
+  | ITEM2(Overhangdistance, _, _) -> failwith " ITEM2(Overhangdistance, _, _) "
+  | ITEM2(Overlapdistance, _, _) -> failwith " ITEM2(Overlapdistance, _, _) "
+  | ITEM2(Oversize, _, _) -> failwith " ITEM2(Oversize, _, _) "
+  | ITEM2(Owner, _, _) -> failwith " ITEM2(Owner, _, _) "
+  | ITEM2(Page, _, _) -> failwith " ITEM2(Page, _, _) "
+  | ITEM2(Pagesize, _, _) -> failwith " ITEM2(Pagesize, _, _) "
+  | ITEM2(Parameter, _, _) -> failwith " ITEM2(Parameter, _, _) "
+  | ITEM2(Parameterassign, _, _) -> failwith " ITEM2(Parameterassign, _, _) "
+  | ITEM2(Parameterdisplay, _, _) -> failwith " ITEM2(Parameterdisplay, _, _) "
+  | ITEM2(Path, _, _) -> failwith " ITEM2(Path, _, _) "
+  | ITEM2(Pathdelay, _, _) -> failwith " ITEM2(Pathdelay, _, _) "
+  | ITEM2(Pathwidth, _, _) -> failwith " ITEM2(Pathwidth, _, _) "
+  | ITEM2(Permutable, _, _) -> failwith " ITEM2(Permutable, _, _) "
+  | ITEM2(Physicaldesignrule, _, _) ->
+      failwith " ITEM2(Physicaldesignrule, _, _) "
+  | ITEM2(Plug, _, _) -> failwith " ITEM2(Plug, _, _) "
+  | ITEM2(Point, _, _) -> failwith " ITEM2(Point, _, _) "
+  | ITEM2(Pointdisplay, _, _) -> failwith " ITEM2(Pointdisplay, _, _) "
+  | ITEM2(Pointlist, _, _) -> failwith " ITEM2(Pointlist, _, _) "
+  | ITEM2(Pointsubtract, _, _) -> failwith " ITEM2(Pointsubtract, _, _) "
+  | ITEM2(Pointsum, _, _) -> failwith " ITEM2(Pointsum, _, _) "
+  | ITEM2(Polygon, _, _) -> failwith " ITEM2(Polygon, _, _) "
+  | ITEM2(Port, _, _) -> failwith " ITEM2(Port, _, _) "
+  | ITEM2(Portbackannotate, _, _) -> failwith " ITEM2(Portbackannotate, _, _) "
+  | ITEM2(Portbundle, _, _) -> failwith " ITEM2(Portbundle, _, _) "
+  | ITEM2(Portdelay, _, _) -> failwith " ITEM2(Portdelay, _, _) "
+  | ITEM2(Portgroup, _, _) -> failwith " ITEM2(Portgroup, _, _) "
+  | ITEM2(Portimplementation, _, _) ->
+      failwith " ITEM2(Portimplementation, _, _) "
+  | ITEM2(Portinstance, _, _) -> failwith " ITEM2(Portinstance, _, _) "
+  | ITEM2(Portlist, _, _) -> failwith " ITEM2(Portlist, _, _) "
+  | ITEM2(Portlistalias, _, _) -> failwith " ITEM2(Portlistalias, _, _) "
+  | ITEM2(Portmap, _, _) -> failwith " ITEM2(Portmap, _, _) "
+  | ITEM2(Portref, _, _) -> failwith " ITEM2(Portref, _, _) "
+  | ITEM2(Product, _, _) -> failwith " ITEM2(Product, _, _) "
+  | ITEM2(Program, _, _) -> failwith " ITEM2(Program, _, _) "
+  | ITEM2(Property, _, _) -> failwith " ITEM2(Property, _, _) "
+  | ITEM2(Propertydisplay, _, _) -> failwith " ITEM2(Propertydisplay, _, _) "
+  | ITEM2(Protectionframe, _, _) -> failwith " ITEM2(Protectionframe, _, _) "
+  | ITEM2(Pt, _, _) -> failwith " ITEM2(Pt, _, _) "
+  | ITEM2(Rangevector, _, _) -> failwith " ITEM2(Rangevector, _, _) "
+  | ITEM2(Rectangle, _, _) -> failwith " ITEM2(Rectangle, _, _) "
+  | ITEM2(Rectanglesize, _, _) -> failwith " ITEM2(Rectanglesize, _, _) "
+  | ITEM2(Rename, _, _) -> failwith " ITEM2(Rename, _, _) "
+  | ITEM2(Resolves, _, _) -> failwith " ITEM2(Resolves, _, _) "
+  | ITEM2(Scale, _, _) -> failwith " ITEM2(Scale, _, _) "
+  | ITEM2(Scalex, _, _) -> failwith " ITEM2(Scalex, _, _) "
+  | ITEM2(Scaley, _, _) -> failwith " ITEM2(Scaley, _, _) "
+  | ITEM2(Section, _, _) -> failwith " ITEM2(Section, _, _) "
+  | ITEM2(Shape, _, _) -> failwith " ITEM2(Shape, _, _) "
+  | ITEM2(Simulate, _, _) -> failwith " ITEM2(Simulate, _, _) "
+  | ITEM2(Simulationinfo, _, _) -> failwith " ITEM2(Simulationinfo, _, _) "
+  | ITEM2(Singlevalueset, _, _) -> failwith " ITEM2(Singlevalueset, _, _) "
+  | ITEM2(Site, _, _) -> failwith " ITEM2(Site, _, _) "
+  | ITEM2(Socket, _, _) -> failwith " ITEM2(Socket, _, _) "
+  | ITEM2(Socketset, _, _) -> failwith " ITEM2(Socketset, _, _) "
+  | ITEM2(Statement, _, _) -> failwith " ITEM2(Statement, _, _) "
+  | ITEM2(Status, _, _) -> failwith " ITEM2(Status, _, _) "
+  | ITEM2(Steady, _, _) -> failwith " ITEM2(Steady, _, _) "
+  | ITEM2(Strictlyincreasing, _, _) ->
+      failwith " ITEM2(Strictlyincreasing, _, _) "
+  | ITEM2(String, _, _) -> failwith " ITEM2(String, _, _) "
+  | ITEM2(Stringdisplay, _, _) -> failwith " ITEM2(Stringdisplay, _, _) "
+  | ITEM2(Strong, _, _) -> failwith " ITEM2(Strong, _, _) "
+  | ITEM2(Subtract, _, _) -> failwith " ITEM2(Subtract, _, _) "
+  | ITEM2(Sum, _, _) -> failwith " ITEM2(Sum, _, _) "
+  | ITEM2(Symbol, _, _) -> failwith " ITEM2(Symbol, _, _) "
+  | ITEM2(Symmetry, _, _) -> failwith " ITEM2(Symmetry, _, _) "
+  | ITEM2(Table, _, _) -> failwith " ITEM2(Table, _, _) "
+  | ITEM2(Tabledefault, _, _) -> failwith " ITEM2(Tabledefault, _, _) "
+  | ITEM2(Technology, _, _) -> failwith " ITEM2(Technology, _, _) "
+  | ITEM2(Textheight, _, _) -> failwith " ITEM2(Textheight, _, _) "
+  | ITEM2(Then, _, _) -> failwith " ITEM2(Then, _, _) "
+  | ITEM2(Timeinterval, _, _) -> failwith " ITEM2(Timeinterval, _, _) "
+  | ITEM2(Timestamp, _, _) -> failwith " ITEM2(Timestamp, _, _) "
+  | ITEM2(Timing, _, _) -> failwith " ITEM2(Timing, _, _) "
+  | ITEM2(Transform, _, _) -> failwith " ITEM2(Transform, _, _) "
+  | ITEM2(Transition, _, _) -> failwith " ITEM2(Transition, _, _) "
+  | ITEM2(Trigger, _, _) -> failwith " ITEM2(Trigger, _, _) "
+  | ITEM2(True, _, _) -> failwith " ITEM2(True, _, _) "
+  | ITEM2(Typedvalue, _, _) -> failwith " ITEM2(Typedvalue, _, _) "
+  | ITEM2(Unconstrained, _, _) -> failwith " ITEM2(Unconstrained, _, _) "
+  | ITEM2(Undefined, _, _) -> failwith " ITEM2(Undefined, _, _) "
+  | ITEM2(Union, _, _) -> failwith " ITEM2(Union, _, _) "
+  | ITEM2(Unit, _, _) -> failwith " ITEM2(Unit, _, _) "
+  | ITEM2(Unused, _, _) -> failwith " ITEM2(Unused, _, _) "
+  | ITEM2(Userdata, _, _) -> failwith " ITEM2(Userdata, _, _) "
+  | ITEM2(Valuenameref, _, _) -> failwith " ITEM2(Valuenameref, _, _) "
+  | ITEM2(Variable, _, _) -> failwith " ITEM2(Variable, _, _) "
+  | ITEM2(Version, _, _) -> failwith " ITEM2(Version, _, _) "
+  | ITEM2(View, _, _) -> failwith " ITEM2(View, _, _) "
+  | ITEM2(Viewlist, _, _) -> failwith " ITEM2(Viewlist, _, _) "
+  | ITEM2(Viewmap, _, _) -> failwith " ITEM2(Viewmap, _, _) "
+  | ITEM2(Viewref, _, _) -> failwith " ITEM2(Viewref, _, _) "
+  | ITEM2(Viewtype, _, _) -> failwith " ITEM2(Viewtype, _, _) "
+  | ITEM2(Visible, _, _) -> failwith " ITEM2(Visible, _, _) "
+  | ITEM2(Voltagemap, _, _) -> failwith " ITEM2(Voltagemap, _, _) "
+  | ITEM2(Wavevalue, _, _) -> failwith " ITEM2(Wavevalue, _, _) "
+  | ITEM2(Weak, _, _) -> failwith " ITEM2(Weak, _, _) "
+  | ITEM2(Weakjoined, _, _) -> failwith " ITEM2(Weakjoined, _, _) "
+  | ITEM2(When, _, _) -> failwith " ITEM2(When, _, _) "
+  | ITEM2(While, _, _) -> failwith " ITEM2(While, _, _) "
+  | ITEM2(Written, _, _) -> failwith " ITEM2(Written, _, _) "
+  | ITEM2(Xcoord, _, _) -> failwith " ITEM2(Xcoord, _, _) "
+  | ITEM2(Xor, _, _) -> failwith " ITEM2(Xor, _, _) "
+  | ITEM2(Ycoord, _, _) -> failwith " ITEM2(Ycoord, _, _) "
+  | ITEM2(ILLEGAL _, _, _) -> failwith " ITEM2(ILLEGAL _, _, _) "
+  | ITEM2(ID _, _, _) -> failwith " ITEM2(ID _, _, _) "
+  | ITEM2(TLIST _, _, _) -> failwith " ITEM2(TLIST _, _, _) "
+  | ITEM2(TLIST2 _, _, _) -> failwith " ITEM2(TLIST2 _, _, _) "
+  | ITEM2(STRING _, _, _) -> failwith " ITEM2(STRING _, _, _) "
+  | ITEM2(INT _, _, _) -> failwith " ITEM2(INT _, _, _) "
+  | ITEM2(ENDOFFILE, _, _) -> failwith " ITEM2(ENDOFFILE, _, _) "
+  | ITEM2(EOL, _, _) -> failwith " ITEM2(EOL, _, _) "
+  | ITEM2(LPAREN, _, _) -> failwith " ITEM2(LPAREN, _, _) "
+  | ITEM2(RPAREN, _, _) -> failwith " ITEM2(RPAREN, _, _) "
+  | ITEM2(EMPTY, _, _) -> failwith " ITEM2(EMPTY, _, _) "
+
+  | ITEM(Abs, _) -> failwith " ITEM(Abs, _) "
+  | ITEM(Acload, _) -> failwith " ITEM(Acload, _) "
+  | ITEM(After, _) -> failwith " ITEM(After, _) "
+  | ITEM(And, _) -> failwith " ITEM(And, _) "
+  | ITEM(Annotate, _) -> failwith " ITEM(Annotate, _) "
+  | ITEM(Apply, _) -> failwith " ITEM(Apply, _) "
+  | ITEM(Arc, _) -> failwith " ITEM(Arc, _) "
+  | ITEM(Array, _) -> failwith " ITEM(Array, _) "
+  | ITEM(Arraymacro, _) -> failwith " ITEM(Arraymacro, _) "
+  | ITEM(Arrayrelatedinfo, _) -> failwith " ITEM(Arrayrelatedinfo, _) "
+  | ITEM(Arraysite, _) -> failwith " ITEM(Arraysite, _) "
+  | ITEM(Assign, _) -> failwith " ITEM(Assign, _) "
+  | ITEM(Atleast, _) -> failwith " ITEM(Atleast, _) "
+  | ITEM(Atmost, _) -> failwith " ITEM(Atmost, _) "
+  | ITEM(Author, _) -> failwith " ITEM(Author, _) "
+  | ITEM(Basearray, _) -> failwith " ITEM(Basearray, _) "
+  | ITEM(Becomes, _) -> failwith " ITEM(Becomes, _) "
+  | ITEM(Between, _) -> failwith " ITEM(Between, _) "
+  | ITEM(Block, _) -> failwith " ITEM(Block, _) "
+  | ITEM(Boolean, _) -> failwith " ITEM(Boolean, _) "
+  | ITEM(Booleandisplay, _) -> failwith " ITEM(Booleandisplay, _) "
+  | ITEM(Booleanmap, _) -> failwith " ITEM(Booleanmap, _) "
+  | ITEM(Booleanvalue, _) -> failwith " ITEM(Booleanvalue, _) "
+  | ITEM(Borderpattern, _) -> failwith " ITEM(Borderpattern, _) "
+  | ITEM(Borderwidth, _) -> failwith " ITEM(Borderwidth, _) "
+  | ITEM(Boundingbox, _) -> failwith " ITEM(Boundingbox, _) "
+  | ITEM(Ceiling, _) -> failwith " ITEM(Ceiling, _) "
+  | ITEM(Cell, _) -> failwith " ITEM(Cell, _) "
+  | ITEM(Cellref, _) -> failwith " ITEM(Cellref, _) "
+  | ITEM(Celltype, _) -> failwith " ITEM(Celltype, _) "
+  | ITEM(Change, _) -> failwith " ITEM(Change, _) "
+  | ITEM(Circle, _) -> failwith " ITEM(Circle, _) "
+  | ITEM(Color, _) -> failwith " ITEM(Color, _) "
+  | ITEM(Comment, _) -> 32
+  | ITEM(Commentgraphics, _) -> failwith " ITEM(Commentgraphics, _) "
+  | ITEM(Compound, _) -> failwith " ITEM(Compound, _) "
+  | ITEM(Concat, _) -> failwith " ITEM(Concat, _) "
+  | ITEM(Connectlocation, _) -> failwith " ITEM(Connectlocation, _) "
+  | ITEM(Constant, _) -> failwith " ITEM(Constant, _) "
+  | ITEM(Constraint, _) -> failwith " ITEM(Constraint, _) "
+  | ITEM(Contents, _) -> failwith " ITEM(Contents, _) "
+  | ITEM(Cornertype, _) -> failwith " ITEM(Cornertype, _) "
+  | ITEM(Criticality, _) -> failwith " ITEM(Criticality, _) "
+  | ITEM(Currentmap, _) -> failwith " ITEM(Currentmap, _) "
+  | ITEM(Curve, _) -> failwith " ITEM(Curve, _) "
+  | ITEM(Cycle, _) -> failwith " ITEM(Cycle, _) "
+  | ITEM(Dataorigin, _) -> failwith " ITEM(Dataorigin, _) "
+  | ITEM(Dcfaninload, _) -> failwith " ITEM(Dcfaninload, _) "
+  | ITEM(Dcfanoutload, _) -> failwith " ITEM(Dcfanoutload, _) "
+  | ITEM(Dcmaxfanin, _) -> failwith " ITEM(Dcmaxfanin, _) "
+  | ITEM(Dcmaxfanout, _) -> failwith " ITEM(Dcmaxfanout, _) "
+  | ITEM(Delay, _) -> failwith " ITEM(Delay, _) "
+  | ITEM(Delta, _) -> failwith " ITEM(Delta, _) "
+  | ITEM(Derivation, _) -> failwith " ITEM(Derivation, _) "
+  | ITEM(Design, _) -> failwith " ITEM(Design, _) "
+  | ITEM(Designator, _) -> failwith " ITEM(Designator, _) "
+  | ITEM(Difference, _) -> failwith " ITEM(Difference, _) "
+  | ITEM(Direction, _) -> failwith " ITEM(Direction, _) "
+  | ITEM(Display, _) -> failwith " ITEM(Display, _) "
+  | ITEM(Divide, _) -> failwith " ITEM(Divide, _) "
+  | ITEM(Dominates, _) -> failwith " ITEM(Dominates, _) "
+  | ITEM(Dot, _) -> failwith " ITEM(Dot, _) "
+  | ITEM(Duration, _) -> failwith " ITEM(Duration, _) "
+  | ITEM(E, _) -> failwith " ITEM(E, _) "
+  | ITEM(Edif, _) -> failwith " ITEM(Edif, _) "
+  | ITEM(Ediflevel, _) -> failwith " ITEM(Ediflevel, _) "
+  | ITEM(Edifversion, _) -> failwith " ITEM(Edifversion, _) "
+  | ITEM(Else, _) -> failwith " ITEM(Else, _) "
+  | ITEM(Enclosuredistance, _) -> failwith " ITEM(Enclosuredistance, _) "
+  | ITEM(Endtype, _) -> failwith " ITEM(Endtype, _) "
+  | ITEM(Entry, _) -> failwith " ITEM(Entry, _) "
+  | ITEM(Equal, _) -> failwith " ITEM(Equal, _) "
+  | ITEM(Escape, _) -> failwith " ITEM(Escape, _) "
+  | ITEM(Event, _) -> failwith " ITEM(Event, _) "
+  | ITEM(Exactly, _) -> failwith " ITEM(Exactly, _) "
+  | ITEM(External, _) -> failwith " ITEM(External, _) "
+  | ITEM(Fabricate, _) -> failwith " ITEM(Fabricate, _) "
+  | ITEM(False, _) -> failwith " ITEM(False, _) "
+  | ITEM(Figure, _) -> failwith " ITEM(Figure, _) "
+  | ITEM(Figurearea, _) -> failwith " ITEM(Figurearea, _) "
+  | ITEM(Figuregroup, _) -> failwith " ITEM(Figuregroup, _) "
+  | ITEM(Figuregroupobject, _) -> failwith " ITEM(Figuregroupobject, _) "
+  | ITEM(Figuregroupoverride, _) -> failwith " ITEM(Figuregroupoverride, _) "
+  | ITEM(Figuregroupref, _) -> failwith " ITEM(Figuregroupref, _) "
+  | ITEM(Figureperimeter, _) -> failwith " ITEM(Figureperimeter, _) "
+  | ITEM(Figurewidth, _) -> failwith " ITEM(Figurewidth, _) "
+  | ITEM(Fillpattern, _) -> failwith " ITEM(Fillpattern, _) "
+  | ITEM(Fix, _) -> failwith " ITEM(Fix, _) "
+  | ITEM(Floor, _) -> failwith " ITEM(Floor, _) "
+  | ITEM(Follow, _) -> failwith " ITEM(Follow, _) "
+  | ITEM(Forbiddenevent, _) -> failwith " ITEM(Forbiddenevent, _) "
+  | ITEM(Form, _) -> failwith " ITEM(Form, _) "
+  | ITEM(Globalportref, _) -> failwith " ITEM(Globalportref, _) "
+  | ITEM(Greaterthan, _) -> failwith " ITEM(Greaterthan, _) "
+  | ITEM(Gridmap, _) -> failwith " ITEM(Gridmap, _) "
+  | ITEM(If, _) -> failwith " ITEM(If, _) "
+  | ITEM(Ignore, _) -> failwith " ITEM(Ignore, _) "
+  | ITEM(Includefiguregroup, _) -> failwith " ITEM(Includefiguregroup, _) "
+  | ITEM(Increasing, _) -> failwith " ITEM(Increasing, _) "
+  | ITEM(Initial, _) -> failwith " ITEM(Initial, _) "
+  | ITEM(Instance, _) -> failwith " ITEM(Instance, _) "
+  | ITEM(Instancebackannotate, _) -> failwith " ITEM(Instancebackannotate, _) "
+  | ITEM(Instancegroup, _) -> failwith " ITEM(Instancegroup, _) "
+  | ITEM(Instancemap, _) -> failwith " ITEM(Instancemap, _) "
+  | ITEM(Instancenamedef, _) -> failwith " ITEM(Instancenamedef, _) "
+  | ITEM(Instanceref, _) -> failwith " ITEM(Instanceref, _) "
+  | ITEM(Integer, _) -> failwith " ITEM(Integer, _) "
+  | ITEM(Integerdisplay, _) -> failwith " ITEM(Integerdisplay, _) "
+  | ITEM(Interface, _) -> failwith " ITEM(Interface, _) "
+  | ITEM(Interfiguregroupspacing, _) ->
+      failwith " ITEM(Interfiguregroupspacing, _) "
+  | ITEM(Intersection, _) -> failwith " ITEM(Intersection, _) "
+  | ITEM(Intrafiguregroupspacing, _) ->
+      failwith " ITEM(Intrafiguregroupspacing, _) "
+  | ITEM(Inverse, _) -> failwith " ITEM(Inverse, _) "
+  | ITEM(Isolated, _) -> failwith " ITEM(Isolated, _) "
+  | ITEM(Iterate, _) -> failwith " ITEM(Iterate, _) "
+  | ITEM(Joined, _) -> failwith " ITEM(Joined, _) "
+  | ITEM(Justify, _) -> failwith " ITEM(Justify, _) "
+  | ITEM(Keyworddisplay, _) -> failwith " ITEM(Keyworddisplay, _) "
+  | ITEM(Keywordlevel, _) -> failwith " ITEM(Keywordlevel, _) "
+  | ITEM(Keywordmap, _) -> failwith " ITEM(Keywordmap, _) "
+  | ITEM(Lessthan, _) -> failwith " ITEM(Lessthan, _) "
+  | ITEM(Library, _) -> failwith " ITEM(Library, _) "
+  | ITEM(Libraryref, _) -> failwith " ITEM(Libraryref, _) "
+  | ITEM(Listofnets, _) -> failwith " ITEM(Listofnets, _) "
+  | ITEM(Listofports, _) -> failwith " ITEM(Listofports, _) "
+  | ITEM(Loaddelay, _) -> failwith " ITEM(Loaddelay, _) "
+  | ITEM(Logicassign, _) -> failwith " ITEM(Logicassign, _) "
+  | ITEM(Logicinput, _) -> failwith " ITEM(Logicinput, _) "
+  | ITEM(Logiclist, _) -> failwith " ITEM(Logiclist, _) "
+  | ITEM(Logicmapinput, _) -> failwith " ITEM(Logicmapinput, _) "
+  | ITEM(Logicmapoutput, _) -> failwith " ITEM(Logicmapoutput, _) "
+  | ITEM(Logiconeof, _) -> failwith " ITEM(Logiconeof, _) "
+  | ITEM(Logicoutput, _) -> failwith " ITEM(Logicoutput, _) "
+  | ITEM(Logicport, _) -> failwith " ITEM(Logicport, _) "
+  | ITEM(Logicref, _) -> failwith " ITEM(Logicref, _) "
+  | ITEM(Logicvalue, _) -> failwith " ITEM(Logicvalue, _) "
+  | ITEM(Logicwaveform, _) -> failwith " ITEM(Logicwaveform, _) "
+  | ITEM(Maintain, _) -> failwith " ITEM(Maintain, _) "
+  | ITEM(Match, _) -> failwith " ITEM(Match, _) "
+  | ITEM(Max, _) -> failwith " ITEM(Max, _) "
+  | ITEM(Member, _) -> failwith " ITEM(Member, _) "
+  | ITEM(Min, _) -> failwith " ITEM(Min, _) "
+  | ITEM(Minomax, _) -> failwith " ITEM(Minomax, _) "
+  | ITEM(Minomaxdisplay, _) -> failwith " ITEM(Minomaxdisplay, _) "
+  | ITEM(Mnm, _) -> failwith " ITEM(Mnm, _) "
+  | ITEM(Mod, _) -> failwith " ITEM(Mod, _) "
+  | ITEM(Multiplevalueset, _) -> failwith " ITEM(Multiplevalueset, _) "
+  | ITEM(Mustjoin, _) -> failwith " ITEM(Mustjoin, _) "
+  | ITEM(Name, _) -> failwith " ITEM(Name, _) "
+  | ITEM(Negate, _) -> failwith " ITEM(Negate, _) "
+  | ITEM(Net, _) -> failwith " ITEM(Net, _) "
+  | ITEM(Netbackannotate, _) -> failwith " ITEM(Netbackannotate, _) "
+  | ITEM(Netbundle, _) -> failwith " ITEM(Netbundle, _) "
+  | ITEM(Netdelay, _) -> failwith " ITEM(Netdelay, _) "
+  | ITEM(Netgroup, _) -> failwith " ITEM(Netgroup, _) "
+  | ITEM(Netmap, _) -> failwith " ITEM(Netmap, _) "
+  | ITEM(Netref, _) -> failwith " ITEM(Netref, _) "
+  | ITEM(Nochange, _) -> failwith " ITEM(Nochange, _) "
+  | ITEM(Nonpermutable, _) -> failwith " ITEM(Nonpermutable, _) "
+  | ITEM(Not, _) -> failwith " ITEM(Not, _) "
+  | ITEM(Notallowed, _) -> failwith " ITEM(Notallowed, _) "
+  | ITEM(Notchspacing, _) -> failwith " ITEM(Notchspacing, _) "
+  | ITEM(Number, _) -> failwith " ITEM(Number, _) "
+  | ITEM(Numberdefinition, _) -> failwith " ITEM(Numberdefinition, _) "
+  | ITEM(Numberdisplay, _) -> failwith " ITEM(Numberdisplay, _) "
+  | ITEM(Offpageconnector, _) -> failwith " ITEM(Offpageconnector, _) "
+  | ITEM(Offsetevent, _) -> failwith " ITEM(Offsetevent, _) "
+  | ITEM(Openshape, _) -> failwith " ITEM(Openshape, _) "
+  | ITEM(Or, _) -> failwith " ITEM(Or, _) "
+  | ITEM(Orientation, _) -> failwith " ITEM(Orientation, _) "
+  | ITEM(Origin, _) -> failwith " ITEM(Origin, _) "
+  | ITEM(Overhangdistance, _) -> failwith " ITEM(Overhangdistance, _) "
+  | ITEM(Overlapdistance, _) -> failwith " ITEM(Overlapdistance, _) "
+  | ITEM(Oversize, _) -> failwith " ITEM(Oversize, _) "
+  | ITEM(Owner, _) -> failwith " ITEM(Owner, _) "
+  | ITEM(Page, _) -> failwith " ITEM(Page, _) "
+  | ITEM(Pagesize, _) -> failwith " ITEM(Pagesize, _) "
+  | ITEM(Parameter, _) -> failwith " ITEM(Parameter, _) "
+  | ITEM(Parameterassign, _) -> failwith " ITEM(Parameterassign, _) "
+  | ITEM(Parameterdisplay, _) -> failwith " ITEM(Parameterdisplay, _) "
+  | ITEM(Path, _) -> failwith " ITEM(Path, _) "
+  | ITEM(Pathdelay, _) -> failwith " ITEM(Pathdelay, _) "
+  | ITEM(Pathwidth, _) -> failwith " ITEM(Pathwidth, _) "
+  | ITEM(Permutable, _) -> failwith " ITEM(Permutable, _) "
+  | ITEM(Physicaldesignrule, _) -> failwith " ITEM(Physicaldesignrule, _) "
+  | ITEM(Plug, _) -> failwith " ITEM(Plug, _) "
+  | ITEM(Point, _) -> failwith " ITEM(Point, _) "
+  | ITEM(Pointdisplay, _) -> failwith " ITEM(Pointdisplay, _) "
+  | ITEM(Pointlist, _) -> failwith " ITEM(Pointlist, _) "
+  | ITEM(Pointsubtract, _) -> failwith " ITEM(Pointsubtract, _) "
+  | ITEM(Pointsum, _) -> failwith " ITEM(Pointsum, _) "
+  | ITEM(Polygon, _) -> failwith " ITEM(Polygon, _) "
+  | ITEM(Port, _) -> failwith " ITEM(Port, _) "
+  | ITEM(Portbackannotate, _) -> failwith " ITEM(Portbackannotate, _) "
+  | ITEM(Portbundle, _) -> failwith " ITEM(Portbundle, _) "
+  | ITEM(Portdelay, _) -> failwith " ITEM(Portdelay, _) "
+  | ITEM(Portgroup, _) -> failwith " ITEM(Portgroup, _) "
+  | ITEM(Portimplementation, _) -> failwith " ITEM(Portimplementation, _) "
+  | ITEM(Portinstance, _) -> failwith " ITEM(Portinstance, _) "
+  | ITEM(Portlist, _) -> failwith " ITEM(Portlist, _) "
+  | ITEM(Portlistalias, _) -> failwith " ITEM(Portlistalias, _) "
+  | ITEM(Portmap, _) -> failwith " ITEM(Portmap, _) "
+  | ITEM(Portref, _) -> failwith " ITEM(Portref, _) "
+  | ITEM(Product, _) -> failwith " ITEM(Product, _) "
+  | ITEM(Program, _) -> failwith " ITEM(Program, _) "
+  | ITEM(Property, _) -> failwith " ITEM(Property, _) "
+  | ITEM(Propertydisplay, _) -> failwith " ITEM(Propertydisplay, _) "
+  | ITEM(Protectionframe, _) -> failwith " ITEM(Protectionframe, _) "
+  | ITEM(Pt, _) -> failwith " ITEM(Pt, _) "
+  | ITEM(Rangevector, _) -> failwith " ITEM(Rangevector, _) "
+  | ITEM(Rectangle, _) -> failwith " ITEM(Rectangle, _) "
+  | ITEM(Rectanglesize, _) -> failwith " ITEM(Rectanglesize, _) "
+  | ITEM(Rename, _) -> failwith " ITEM(Rename, _) "
+  | ITEM(Resolves, _) -> failwith " ITEM(Resolves, _) "
+  | ITEM(Scale, _) -> failwith " ITEM(Scale, _) "
+  | ITEM(Scalex, _) -> failwith " ITEM(Scalex, _) "
+  | ITEM(Scaley, _) -> failwith " ITEM(Scaley, _) "
+  | ITEM(Section, _) -> failwith " ITEM(Section, _) "
+  | ITEM(Shape, _) -> failwith " ITEM(Shape, _) "
+  | ITEM(Simulate, _) -> failwith " ITEM(Simulate, _) "
+  | ITEM(Simulationinfo, _) -> failwith " ITEM(Simulationinfo, _) "
+  | ITEM(Singlevalueset, _) -> failwith " ITEM(Singlevalueset, _) "
+  | ITEM(Site, _) -> failwith " ITEM(Site, _) "
+  | ITEM(Socket, _) -> failwith " ITEM(Socket, _) "
+  | ITEM(Socketset, _) -> failwith " ITEM(Socketset, _) "
+  | ITEM(Statement, _) -> failwith " ITEM(Statement, _) "
+  | ITEM(Status, _) -> failwith " ITEM(Status, _) "
+  | ITEM(Steady, _) -> failwith " ITEM(Steady, _) "
+  | ITEM(Strictlyincreasing, _) -> failwith " ITEM(Strictlyincreasing, _) "
+  | ITEM(String, _) -> failwith " ITEM(String, _) "
+  | ITEM(Stringdisplay, _) -> failwith " ITEM(Stringdisplay, _) "
+  | ITEM(Strong, _) -> failwith " ITEM(Strong, _) "
+  | ITEM(Subtract, _) -> failwith " ITEM(Subtract, _) "
+  | ITEM(Sum, _) -> failwith " ITEM(Sum, _) "
+  | ITEM(Symbol, _) -> failwith " ITEM(Symbol, _) "
+  | ITEM(Symmetry, _) -> failwith " ITEM(Symmetry, _) "
+  | ITEM(Table, _) -> failwith " ITEM(Table, _) "
+  | ITEM(Tabledefault, _) -> failwith " ITEM(Tabledefault, _) "
+  | ITEM(Technology, _) -> failwith " ITEM(Technology, _) "
+  | ITEM(Textheight, _) -> failwith " ITEM(Textheight, _) "
+  | ITEM(Then, _) -> failwith " ITEM(Then, _) "
+  | ITEM(Timeinterval, _) -> failwith " ITEM(Timeinterval, _) "
+  | ITEM(Timestamp, _) -> failwith " ITEM(Timestamp, _) "
+  | ITEM(Timing, _) -> failwith " ITEM(Timing, _) "
+  | ITEM(Transform, _) -> failwith " ITEM(Transform, _) "
+  | ITEM(Transition, _) -> failwith " ITEM(Transition, _) "
+  | ITEM(Trigger, _) -> failwith " ITEM(Trigger, _) "
+  | ITEM(True, _) -> failwith " ITEM(True, _) "
+  | ITEM(Typedvalue, _) -> failwith " ITEM(Typedvalue, _) "
+  | ITEM(Unconstrained, _) -> failwith " ITEM(Unconstrained, _) "
+  | ITEM(Undefined, _) -> failwith " ITEM(Undefined, _) "
+  | ITEM(Union, _) -> failwith " ITEM(Union, _) "
+  | ITEM(Unit, _) -> failwith " ITEM(Unit, _) "
+  | ITEM(Unused, _) -> failwith " ITEM(Unused, _) "
+  | ITEM(Userdata, _) -> failwith " ITEM(Userdata, _) "
+  | ITEM(Valuenameref, _) -> failwith " ITEM(Valuenameref, _) "
+  | ITEM(Variable, _) -> failwith " ITEM(Variable, _) "
+  | ITEM(Version, _) -> failwith " ITEM(Version, _) "
+  | ITEM(View, _) -> failwith " ITEM(View, _) "
+  | ITEM(Viewlist, _) -> failwith " ITEM(Viewlist, _) "
+  | ITEM(Viewmap, _) -> failwith " ITEM(Viewmap, _) "
+  | ITEM(Viewref, _) -> failwith " ITEM(Viewref, _) "
+  | ITEM(Viewtype, _) -> failwith " ITEM(Viewtype, _) "
+  | ITEM(Visible, _) -> failwith " ITEM(Visible, _) "
+  | ITEM(Voltagemap, _) -> failwith " ITEM(Voltagemap, _) "
+  | ITEM(Wavevalue, _) -> failwith " ITEM(Wavevalue, _) "
+  | ITEM(Weak, _) -> failwith " ITEM(Weak, _) "
+  | ITEM(Weakjoined, _) -> failwith " ITEM(Weakjoined, _) "
+  | ITEM(When, _) -> failwith " ITEM(When, _) "
+  | ITEM(While, _) -> failwith " ITEM(While, _) "
+  | ITEM(Written, _) -> failwith " ITEM(Written, _) "
+  | ITEM(Xcoord, _) -> failwith " ITEM(Xcoord, _) "
+  | ITEM(Xor, _) -> failwith " ITEM(Xor, _) "
+  | ITEM(Ycoord, _) -> failwith " ITEM(Ycoord, _) "
+  | ITEM(ILLEGAL _, _) -> failwith " ITEM(ILLEGAL _, _) "
+  | ITEM(ID _, _) -> failwith " ITEM(ID _, _) "
+  | ITEM(TLIST _, _) -> failwith " ITEM(TLIST _, _) "
+  | ITEM(TLIST2 _, _) -> failwith " ITEM(TLIST2 _, _) "
+  | ITEM(STRING _, _) -> failwith " ITEM(STRING _, _) "
+  | ITEM(INT _, _) -> failwith " ITEM(INT _, _) "
+  | ITEM(ENDOFFILE, _) -> failwith " ITEM(ENDOFFILE, _) "
+  | ITEM(EOL, _) -> failwith " ITEM(EOL, _) "
+  | ITEM(LPAREN, _) -> failwith " ITEM(LPAREN, _) "
+  | ITEM(RPAREN, _) -> failwith " ITEM(RPAREN, _) "
+  | ITEM(EMPTY, _) -> failwith " ITEM(EMPTY, _) "
+  | ITEM ((ITEM _|ITEM2 _), _) -> failwith " ITEM ((ITEM _|ITEM2 _), _) "
+  | ITEM2 ((ITEM _|ITEM2 _), _, _) ->
+      failwith " ITEM2 ((ITEM _|ITEM2 _), _, _) "
+
+let () =  printf "PR#6646=Ok\n%!"
+
+(* Simplified example, with application test *)
+
+type t =
+  | B of int
+  | C of int
+  | I of t list
+  | A00
+  | A01
+  | A02
+  | A03
+  | A04
+  | A05
+  | A06
+  | A07
+  | A08
+  | A09
+  | A10
+  | A11
+  | A12
+  | A13
+  | A14
+  | A15
+  | A16
+  | A17
+  | A18
+  | A19
+  | A20
+  | A21
+  | A22
+  | A23
+  | A24
+  | A25
+  | A26
+  | A27
+  | A28
+  | A29
+  | A30
+  | A31
+  | A32
+  | A33
+  | A34
+  | A35
+  | A36
+  | A37
+  | A38
+  | A39
+  | A40
+  | A41
+  | A42
+  | A43
+  | A44
+  | A45
+  | A46
+  | A47
+  | A48
+  | A49
+  | A50
+  | A51
+  | A52
+  | A53
+  | A54
+  | A55
+  | A56
+  | A57
+  | A58
+  | A59
+  | A60
+  | A61
+  | A62
+  | A63
+  | A64
+  | A65
+  | A66
+  | A67
+  | A68
+  | A69
+  | A70
+  | A71
+  | A72
+  | A73
+  | A74
+  | A75
+  | A76
+  | A77
+  | A78
+  | A79
+  | A80
+  | A81
+  | A82
+  | A83
+  | A84
+  | A85
+  | A86
+  | A87
+  | A88
+  | A89
+  | A90
+  | A91
+  | A92
+  | A93
+  | A94
+  | A95
+  | A96
+  | A97
+  | A98
+  | A99
+
+
+let test = function
+  | I [A00;I [I [A00;I [A00]]]] -> 1
+  | I [A00;I [I [A00;I [A01]]]] -> 2
+  | I [A00;I [I [A00;I [A02]]]] -> 3
+  | I [A00;I [I [A00;I [A03]]]] -> -3
+  | I [A00;I [I [A00;I [A04]]]] -> 4
+  | I [A00;I [I [A00;I [A05]]]] -> 5
+  | I [A00;I [I [A00;I [A06]]]] -> 6
+  | I [A00;I [I [A00;I [A07]]]] -> 7
+  | I [A00;I [I [A00;I [A08]]]] -> 8
+  | I [A00;I [I [A00;I [A09]]]] -> 9
+
+  | I [A00;I [I [_ ; I [A00]]]] -> 11
+  | I [A00;I [I [_ ; I [A01]]]] -> 12
+  | I [A00;I [I [_ ; I [A02]]]] -> 13
+  | _ -> -1
+
+
+let () =
+  assert (test (I [A00;I [I [A00;I [A00]]]]) = 1) ;
+  assert (test (I [A00;I [I [A20;I [A00]]]]) = 11) ;
+  assert (test (I [A00;I [I [A00;I [A01]]]]) = 2) ;
+  assert (test (I [A00;I [I [A20;I [A01]]]]) = 12) ;
+  assert (test (I [A00;I [I [A00;I [A02]]]]) = 3) ;
+  assert (test (I [A00;I [I [A20;I [A02]]]]) = 13) ;
+  assert (test (I [A00;I [I [A00;I [A03]]]]) = -3) ;
+  assert (test (I [A00;I [I [A20;I [A03]]]]) = -1) ;
+  printf "PR#6646=Ok\n%!"
+
+(* PR#6674, a compilation failure introduced by correcting PR#6646 *)
+
+type t6674 =
+  | A1
+  | A2
+  | A3
+  | A4
+  | A5
+  | A6
+  | A7
+  | A8
+  | A9
+  | A10
+  | A11
+  | A12
+  | A13
+  | A14
+  | A15
+  | A16
+  | A17
+  | A18
+  | A19
+  | A20
+  | A21
+  | A22
+  | A23
+  | A24
+  | A25
+  | A26
+  | A27
+  | A28
+  | A29
+  | A30
+  | A31
+  | A32
+  | X of string
+
+let f = function
+  | X _ -> true
+  | _ -> false
+
+let () =  printf "PR#6676=Ok\n%!"
+
+(* GPR#234, allow ``[]`` as a user defined constructor *)
+module GPR234HList = struct
+
+  type _ cell =
+    | Int : int -> int cell
+    | Pair : int * int -> (int * int) cell
+    | StrInt : string -> string cell
+    | List : int list -> int list cell
+
+  type hlist =
+    | [] : hlist
+    | ( :: ) : 'a cell * hlist -> hlist
+
+  type 'b foldf = {
+    f: 'a. 'a cell -> 'b -> 'b
+  }
+
+  let fold_hlist : 'b foldf -> 'b -> hlist -> 'b = fun f init l ->
+    let rec loop : hlist -> 'b -> 'b = fun l acc ->
+      match l with
+      | [] -> acc
+      | hd :: tl -> loop tl (f.f hd acc) in
+    loop l init
+
+  let to_int_fold : type a. a cell -> int -> int = fun cell acc ->
+    match cell with
+    | Int x -> x + acc
+    | Pair (x, y) -> x + y + acc
+    | StrInt str -> int_of_string str + acc
+    | List l -> acc + List.fold_left (+) 0 l
+
+  let sum l = fold_hlist {f=to_int_fold} 0 l
+
+  let l = List [1; 2; 3] (* still fine to use normal list here *)
+
+  let ll = [Int 3; Pair (4, 5); StrInt "30"; l]
+
+  let test () = Printf.printf "%d\n" (sum ll)
+
+end
+
+let () = GPR234HList.test ()
+
+let () = printf "GPR#234=Ok\n%!"
+
+module MPR7761 = struct
+
+  let zyva msg c r =
+    if r <> c then begin
+      Printf.printf "'%c' pas bon pour %s (should be '%c')\n%!"r  msg c
+    end else
+      Printf.printf "%s -> '%c'\n%!" msg r
+
+  module A = struct
+    type t = ..
+    type t +=
+      | A
+      | B
+
+    let f x y = match x, y with
+    | (A | B), A -> 'a'
+    | (A | B), B -> 'b'
+    | _, _ -> '_'
+
+    let () =
+      zyva "f A A" 'a' (f A A) ;
+      zyva "f A B" 'b' (f A B) ;
+      printf "PR#7661-A=Ok\n%!"
+  end
+
+  module B = struct
+    type t = ..
+    type t +=
+      | A
+      | B
+
+    type t += C
+    type t += D
+
+    let f x y = match x, y with
+    | B, C       -> 'x'
+    | (A | B), A -> 'a'
+    | (A | B), B -> 'b'
+    | (C | D), (A|B|C) -> 'c'
+    | _, _ -> '_'
+
+    let g x y = match x, y with
+    | Some B, C       -> 'x'
+    | (Some A | Some B), A -> 'a'
+    | (Some A | Some B), B -> 'b'
+    | (Some C | Some D), (A|B|C) -> 'c'
+    | _, _ -> '_'
+
+    let () =
+      zyva "f B C" 'x' (f B C) ;
+      zyva "f A A" 'a' (f A A) ;
+      zyva "f B A" 'a' (f B A) ;
+      zyva "f A B" 'b' (f A B) ;
+      zyva "f B B" 'b' (f B B) ;
+      zyva "f C B" 'c' (f C B) ;
+      zyva "f D B" 'c' (f D B) ;
+      zyva "f C A" 'c' (f C A) ;
+      zyva "f D A" 'c' (f D A) ;
+      zyva "f C C" 'c' (f C C) ;
+      zyva "f D C" 'c' (f D C) ;
+      zyva "f A D" '_' (f A D) ;
+      zyva "f C D" '_' (f C D) ;
+(***************)
+      zyva "g (Some B) C" 'x' (g (Some B) C) ;
+      zyva "g (Some A) A" 'a' (g (Some A) A) ;
+      zyva "g (Some B) A" 'a' (g (Some B) A) ;
+      zyva "g (Some A) B" 'b' (g (Some A) B) ;
+      zyva "g (Some B) B" 'b' (g (Some B) B) ;
+      zyva "g (Some C) B" 'c' (g (Some C) B) ;
+      zyva "g (Some D) B" 'c' (g (Some D) B) ;
+      zyva "g (Some C) A" 'c' (g (Some C) A) ;
+      zyva "g (Some D) A" 'c' (g (Some D) A) ;
+      zyva "g (Some C) C" 'c' (g (Some C) C) ;
+      zyva "g (Some D) C" 'c' (g (Some D) C) ;
+      zyva "g (Some A) D" '_' (g (Some A) D) ;
+      zyva "g (Some C) D" '_' (g (Some C) D) ;
+(***************)
+      printf "PR#7661-B=Ok\n%!"
+  end
+
+  module C = struct
+    type t = ..
+    type t +=
+      | A
+      | B
+
+    type t += C
+    type t += D=A
+
+    let f x y = match x, y with
+    | B, C       -> 'x'
+    | (A | B), A -> 'a'
+    | (A | B), B -> 'b'
+    | (C | D), (A|B|C) -> 'c'
+    | _, _ -> '_'
+
+    let g x y = match x, y with
+    | Some B, C       -> 'x'
+    | (Some A | Some B), A -> 'a'
+    | (Some A | Some B), B -> 'b'
+    | (Some C | Some D), (A|B|C) -> 'c'
+    | _, _ -> '_'
+
+    let () =
+      zyva "f B C" 'x' (f B C) ;
+      zyva "f A A" 'a' (f A A) ;
+      zyva "f B A" 'a' (f B A) ;
+      zyva "f A B" 'b' (f A B) ;
+      zyva "f B B" 'b' (f B B) ;
+      zyva "f C B" 'c' (f C B) ;
+      zyva "f D B" 'b' (f D B) ;
+      zyva "f C A" 'c' (f C A) ;
+      zyva "f D A" 'a' (f D A) ;
+      zyva "f C C" 'c' (f C C) ;
+      zyva "f D C" 'c' (f D C) ;
+      zyva "f A D" 'a' (f A D) ;
+      zyva "f B D" 'a' (f B D) ;
+      zyva "f C D" 'c' (f C D) ;
+      zyva "f D D" 'a' (f D D) ;
+(***************)
+      zyva "g (Some B) C" 'x' (g (Some B) C) ;
+      zyva "g (Some A) A" 'a' (g (Some A) A) ;
+      zyva "g (Some B) A" 'a' (g (Some B) A) ;
+      zyva "g (Some A) B" 'b' (g (Some A) B) ;
+      zyva "g (Some B) B" 'b' (g (Some B) B) ;
+      zyva "g (Some C) B" 'c' (g (Some C) B) ;
+      zyva "g (Some D) B" 'b' (g (Some D) B) ;
+      zyva "g (Some C) A" 'c' (g (Some C) A) ;
+      zyva "g (Some D) A" 'a' (g (Some D) A) ;
+      zyva "g (Some C) C" 'c' (g (Some C) C) ;
+      zyva "g (Some D) C" 'c' (g (Some D) C) ;
+      zyva "g (Some A) D" 'a' (g (Some A) D) ;
+      zyva "g (Some B) D" 'a' (g (Some B) D) ;
+      zyva "g (Some C) D" 'c' (g (Some C) D) ;
+      zyva "g (Some D) D" 'a' (g (Some D) D) ;
+(***************)
+      printf "PR#7661-C=Ok\n%!"
+  end
+
+  module D = struct
+    type t = ..
+    type t += A | B of int
+    type t += C=A
+
+    let f x y = match x,y with
+    | true,A -> 'a'
+    | _,B _  -> 'b'
+    | false,A -> 'c'
+    | _,_ -> '_'
+
+    let g x y = match x,y with
+    | true,A -> 'a'
+    | _,C  -> 'b'
+    | false,A -> 'c'
+    | _,_ -> '_'
+
+    let () =
+      zyva "f true A" 'a' (f true A) ;
+      zyva "f true (B 0)" 'b' (f true (B 0)) ;
+      zyva "f false A" 'c' (f false A) ;
+      zyva "g true A" 'a' (g true A) ;
+      zyva "g false A" 'b' (g false A) ;
+      zyva "g true (B 0)" '_' (g true (B 0)) ;
+(***************)
+      printf "PR#7661-D=Ok\n%!"
+  end
+
+  module E = struct
+
+    module type S = sig
+      type t = ..
+      type t += A|B|C
+      type u = X|Y|Z
+
+      val fAYX : char
+      val gAYX : char
+      val fAZY : char
+      val gAZY : char
+    end
+
+    module Z(T:S) : sig end = struct
+
+      open T
+
+      let f x y z = match x,y,z with
+      | A,X,_ -> '1'
+      | _,X,X -> '2'
+      | B,_,X -> '3'
+      | C,_,X -> '4'
+      | C,_,Y -> '5'
+      | _,_,_ -> '_'
+
+      let g x y z = match x,y,z with
+      | A,X,_     -> '1'
+      | _,X,X     -> '2'
+      | (B|C),_,X -> '3'
+      | C,_,Y     -> '5'
+      | _,_,_     -> '_'
+
+      let () =
+        zyva "f A Y X" fAYX  (f A Y X) ;
+        zyva "g A Y X" gAYX  (g A Y X) ;
+        zyva "f A Z Y" fAZY  (f A Z Y) ;
+        zyva "g A Z Y" gAZY  (g A Z Y) ;
+        ()
+    end
+
+    module A =
+      Z
+        (struct
+          type t = ..
+          type t += A|B
+          type t += C=A
+          type u = X|Y|Z
+
+          let fAYX = '4'
+          and gAYX = '3'
+          and fAZY = '5'
+          and gAZY = '5'
+        end)
+
+    module B =
+      Z
+        (struct
+          type t = ..
+          type t += A|B
+          type t += C
+          type u = X|Y|Z
+
+          let fAYX = '_'
+          and gAYX = '_'
+          and fAZY = '_'
+          and gAZY = '_'
+        end)
+
+    let () = printf "PR#7661-E=Ok\n%!"
+  end
+end
diff --git a/testsuite/tests/basic/patmatch.reference b/testsuite/tests/basic/patmatch.reference
new file mode 100644
index 00000000..79f68157
--- /dev/null
+++ b/testsuite/tests/basic/patmatch.reference
@@ -0,0 +1,153 @@
+f(-5) = 0
+f(-4) = 0
+f(-3) = 0
+f(-2) = 0
+f(-1) = 0
+f(0) = 0
+f(1) = 1
+f(2) = 2
+f(3) = 3
+f(4) = 4
+f(5) = 5
+f(6) = 6
+f(7) = 0
+f(8) = 0
+f(9) = 0
+f(10) = 0
+g(0) = 0
+g(300) = 0
+g(303) = 1
+g(305) = 0
+g(400) = 0
+g(401) = 2
+g(402) = 0
+g(999) = 0
+iszero(-2) = false
+iszero(-1) = false
+iszero(0) = true
+iszero(1) = false
+iszero(2) = false
+h(a) = a
+h(b) = ?
+h(c) = ?
+h(d) = ?
+h(e) = e
+h(f) = ?
+h(g) = ?
+h(h) = ?
+h(i) = i
+h(j) = ?
+h(k) = ?
+h(l) = ?
+h(m) = ?
+h(n) = ?
+h(o) = o
+h(p) = ?
+h(q) = ?
+h(r) = ?
+h(s) = ?
+h(t) = ?
+h(u) = u
+h(v) = ?
+h(w) = ?
+h(x) = ?
+h(y) = ?
+h(z) = ?
+h({) = ?
+h(|) = ?
+h(}) = ?
+h(~) = ?
+	k(\000) = othr	k(\001) = othr	k(\002) = othr	k(\003) = othr	k(\004) = othr	k(\005) = othr	k(\006) = othr	k(\007) = othr	k(\b) = othr	k(\t) = blk	k(\n) = blk	k(\011) = othr	k(\012) = othr	k(\r) = blk	k(\014) = othr	k(\015) = othr	k(\016) = othr	k(\017) = othr	k(\018) = othr	k(\019) = othr	k(\020) = othr	k(\021) = othr	k(\022) = othr	k(\023) = othr	k(\024) = othr	k(\025) = othr	k(\026) = othr	k(\027) = othr	k(\028) = othr	k(\029) = othr	k(\030) = othr	k(\031) = othr	k( ) = blk	k(!) = oper	k(\034) = othr	k(#) = oper	k($) = oper	k(%) = oper	k(&) = oper	k(\') = othr	k(\040) = othr	k(\041) = othr	k(*) = oper	k(+) = oper	k(\044) = othr	k(\045) = othr	k(\046) = othr	k(/) = oper	k(0) = dig	k(1) = dig	k(2) = dig	k(3) = dig	k(4) = dig	k(5) = dig	k(6) = dig	k(7) = dig	k(8) = dig	k(9) = dig	k(:) = oper	k(\059) = othr	k(<) = oper	k(=) = oper	k(>) = oper	k(?) = oper	k(@) = oper	k(A) = letr	k(B) = letr	k(C) = letr	k(D) = letr	k(E) = letr	k(F) = letr	k(G) = letr	k(H) = letr	k(I) = letr	k(J) = letr	k(K) = letr	k(L) = letr	k(M) = letr	k(N) = letr	k(O) = letr	k(P) = letr	k(Q) = letr	k(R) = letr	k(S) = letr	k(T) = letr	k(U) = letr	k(V) = letr	k(W) = letr	k(X) = letr	k(Y) = letr	k(Z) = letr	k(\091) = othr	k(\\) = oper	k(\093) = othr	k(^) = oper	k(\095) = othr	k(\096) = othr	k(a) = letr	k(b) = letr	k(c) = letr	k(d) = letr	k(e) = letr	k(f) = letr	k(g) = letr	k(h) = letr	k(i) = letr	k(j) = letr	k(k) = letr	k(l) = letr	k(m) = letr	k(n) = letr	k(o) = letr	k(p) = letr	k(q) = letr	k(r) = letr	k(s) = letr	k(t) = letr	k(u) = letr	k(v) = letr	k(w) = letr	k(x) = letr	k(y) = letr	k(z) = letr	k(\123) = othr	k(|) = oper	k(\125) = othr	k(~) = oper	k(\127) = othr	k(\128) = othr	k(\129) = othr	k(\130) = othr	k(\131) = othr	k(\132) = othr	k(\133) = othr	k(\134) = othr	k(\135) = othr	k(\136) = othr	k(\137) = othr	k(\138) = othr	k(\139) = othr	k(\140) = othr	k(\141) = othr	k(\142) = othr	k(\143) = othr	k(\144) = othr	k(\145) = othr	k(\146) = othr	k(\147) = othr	k(\148) = othr	k(\149) = othr	k(\150) = othr	k(\151) = othr	k(\152) = othr	k(\153) = othr	k(\154) = othr	k(\155) = othr	k(\156) = othr	k(\157) = othr	k(\158) = othr	k(\159) = othr	k(\160) = othr	k(\161) = othr	k(\162) = othr	k(\163) = othr	k(\164) = othr	k(\165) = othr	k(\166) = othr	k(\167) = othr	k(\168) = othr	k(\169) = othr	k(\170) = othr	k(\171) = othr	k(\172) = othr	k(\173) = othr	k(\174) = othr	k(\175) = othr	k(\176) = othr	k(\177) = othr	k(\178) = othr	k(\179) = othr	k(\180) = othr	k(\181) = othr	k(\182) = othr	k(\183) = othr	k(\184) = othr	k(\185) = othr	k(\186) = othr	k(\187) = othr	k(\188) = othr	k(\189) = othr	k(\190) = othr	k(\191) = othr	k(\192) = letr	k(\193) = letr	k(\194) = letr	k(\195) = letr	k(\196) = letr	k(\197) = letr	k(\198) = letr	k(\199) = letr	k(\200) = letr	k(\201) = letr	k(\202) = letr	k(\203) = letr	k(\204) = letr	k(\205) = letr	k(\206) = letr	k(\207) = letr	k(\208) = letr	k(\209) = letr	k(\210) = letr	k(\211) = letr	k(\212) = letr	k(\213) = letr	k(\214) = letr	k(\215) = letr	k(\216) = letr	k(\217) = letr	k(\218) = letr	k(\219) = letr	k(\220) = letr	k(\221) = letr	k(\222) = letr	k(\223) = letr	k(\224) = letr	k(\225) = letr	k(\226) = letr	k(\227) = letr	k(\228) = letr	k(\229) = letr	k(\230) = letr	k(\231) = letr	k(\232) = letr	k(\233) = letr	k(\234) = letr	k(\235) = letr	k(\236) = letr	k(\237) = letr	k(\238) = letr	k(\239) = letr	k(\240) = letr	k(\241) = letr	k(\242) = letr	k(\243) = letr	k(\244) = letr	k(\245) = letr	k(\246) = letr	k(\247) = letr	k(\248) = letr	k(\249) = letr	k(\250) = letr	k(\251) = letr	k(\252) = letr	k(\253) = letr	k(\254) = letr	k(\255) = letr
+p([|"hello"|]) = hello
+p([|1.0|]) = 1.000000
+q([|2|]) = 2
+r([|3.0|]) = 3.000000
+l([||]) = 0
+l([|1|]) = 2
+l([|2;3|]) = 5
+l([|4;5;6|]) = 15
+PR#5992=Ok
+PR#5788=Ok
+PR#5788=Ok
+PR#6646=Ok
+PR#6646=Ok
+PR#6676=Ok
+48
+GPR#234=Ok
+f A A -> 'a'
+f A B -> 'b'
+PR#7661-A=Ok
+f B C -> 'x'
+f A A -> 'a'
+f B A -> 'a'
+f A B -> 'b'
+f B B -> 'b'
+f C B -> 'c'
+f D B -> 'c'
+f C A -> 'c'
+f D A -> 'c'
+f C C -> 'c'
+f D C -> 'c'
+f A D -> '_'
+f C D -> '_'
+g (Some B) C -> 'x'
+g (Some A) A -> 'a'
+g (Some B) A -> 'a'
+g (Some A) B -> 'b'
+g (Some B) B -> 'b'
+g (Some C) B -> 'c'
+g (Some D) B -> 'c'
+g (Some C) A -> 'c'
+g (Some D) A -> 'c'
+g (Some C) C -> 'c'
+g (Some D) C -> 'c'
+g (Some A) D -> '_'
+g (Some C) D -> '_'
+PR#7661-B=Ok
+f B C -> 'x'
+f A A -> 'a'
+f B A -> 'a'
+f A B -> 'b'
+f B B -> 'b'
+f C B -> 'c'
+f D B -> 'b'
+f C A -> 'c'
+f D A -> 'a'
+f C C -> 'c'
+f D C -> 'c'
+f A D -> 'a'
+f B D -> 'a'
+f C D -> 'c'
+f D D -> 'a'
+g (Some B) C -> 'x'
+g (Some A) A -> 'a'
+g (Some B) A -> 'a'
+g (Some A) B -> 'b'
+g (Some B) B -> 'b'
+g (Some C) B -> 'c'
+g (Some D) B -> 'b'
+g (Some C) A -> 'c'
+g (Some D) A -> 'a'
+g (Some C) C -> 'c'
+g (Some D) C -> 'c'
+g (Some A) D -> 'a'
+g (Some B) D -> 'a'
+g (Some C) D -> 'c'
+g (Some D) D -> 'a'
+PR#7661-C=Ok
+f true A -> 'a'
+f true (B 0) -> 'b'
+f false A -> 'c'
+g true A -> 'a'
+g false A -> 'b'
+g true (B 0) -> '_'
+PR#7661-D=Ok
+f A Y X -> '4'
+g A Y X -> '3'
+f A Z Y -> '5'
+g A Z Y -> '5'
+f A Y X -> '_'
+g A Y X -> '_'
+f A Z Y -> '_'
+g A Z Y -> '_'
+PR#7661-E=Ok
diff --git a/testsuite/tests/basic/patmatch_incoherence.ml b/testsuite/tests/basic/patmatch_incoherence.ml
new file mode 100644
index 00000000..c54fd918
--- /dev/null
+++ b/testsuite/tests/basic/patmatch_incoherence.ml
@@ -0,0 +1,138 @@
+(* TEST
+   * expect
+*)
+
+type tlist = { x: 'a. 'a list };;
+[%%expect{|
+type tlist = { x : 'a. 'a list; }
+|}];;
+
+match { x = [] } with
+| { x = [] } -> ()
+| { x = 3 :: _ } -> ()
+| { x = "" :: _ } -> ()
+;;
+[%%expect{|
+- : unit = ()
+|}];;
+
+
+type t = { x: 'a. 'a };;
+[%%expect{|
+type t = { x : 'a. 'a; }
+|}];;
+
+match { x = assert false } with
+| { x = 3 } -> ()
+| { x = "" } -> ()
+;;
+[%%expect{|
+Exception: Assert_failure ("", 1, 12).
+|}];;
+
+match { x = assert false } with
+| { x = 3 } -> ()
+| { x = None } -> ()
+;;
+[%%expect{|
+Lines 1-3, characters 0-20:
+1 | match { x = assert false } with
+2 | | { x = 3 } -> ()
+3 | | { x = None } -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+{x=Some _}
+Exception: Assert_failure ("", 1, 12).
+|}];;
+
+match { x = assert false } with
+| { x = None } -> ()
+| { x = "" } -> ()
+;;
+[%%expect{|
+Lines 1-3, characters 0-18:
+1 | match { x = assert false } with
+2 | | { x = None } -> ()
+3 | | { x = "" } -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+{x="*"}
+Exception: Assert_failure ("", 1, 12).
+|}];;
+
+match { x = assert false } with
+| { x = None } -> ()
+| { x = `X } -> ()
+;;
+[%%expect{|
+Lines 1-3, characters 0-18:
+1 | match { x = assert false } with
+2 | | { x = None } -> ()
+3 | | { x = `X } -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+{x=`AnyOtherTag}
+Exception: Assert_failure ("", 1, 12).
+|}];;
+
+match { x = assert false } with
+| { x = [||] } -> ()
+| { x = 3 } -> ()
+;;
+[%%expect{|
+Lines 1-3, characters 0-17:
+1 | match { x = assert false } with
+2 | | { x = [||] } -> ()
+3 | | { x = 3 } -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+{x=0}
+Exception: Assert_failure ("", 1, 12).
+|}];;
+
+match { x = assert false } with
+| { x = `X } -> ()
+| { x = 3 } -> ()
+;;
+[%%expect{|
+Lines 1-3, characters 0-17:
+1 | match { x = assert false } with
+2 | | { x = `X } -> ()
+3 | | { x = 3 } -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+{x=0}
+Exception: Assert_failure ("", 1, 12).
+|}];;
+
+match { x = assert false } with
+| { x = `X "lol" } -> ()
+| { x = 3 } -> ()
+;;
+[%%expect{|
+Lines 1-3, characters 0-17:
+1 | match { x = assert false } with
+2 | | { x = `X "lol" } -> ()
+3 | | { x = 3 } -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+{x=0}
+Exception: Assert_failure ("", 1, 12).
+|}];;
+
+match { x = assert false } with
+| { x = (2., "") } -> ()
+| { x = None } -> ()
+| { x = 3 } -> ()
+;;
+[%%expect{|
+Lines 1-4, characters 0-17:
+1 | match { x = assert false } with
+2 | | { x = (2., "") } -> ()
+3 | | { x = None } -> ()
+4 | | { x = 3 } -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+{x=0}
+Exception: Assert_failure ("", 1, 12).
+|}];;
diff --git a/testsuite/tests/basic/patmatch_split_no_or.ml b/testsuite/tests/basic/patmatch_split_no_or.ml
new file mode 100644
index 00000000..4f494656
--- /dev/null
+++ b/testsuite/tests/basic/patmatch_split_no_or.ml
@@ -0,0 +1,90 @@
+(* TEST
+ flags = "-nostdlib -nopervasives -dlambda"
+ * expect
+ *)
+
+(******************************************************************************)
+
+(* Check that the extra split indeed happens when the last row is made of
+   "variables" only *)
+
+let last_is_anys = function
+  | true, false -> 1
+  | _, false -> 2
+  | _, _ -> 3
+;;
+[%%expect{|
+(let
+  (last_is_anys/10 =
+     (function param/12 : int
+       (catch
+         (if (field 0 param/12) (if (field 1 param/12) (exit 1) 1)
+           (if (field 1 param/12) (exit 1) 2))
+        with (1) 3)))
+  (apply (field 1 (global Toploop!)) "last_is_anys" last_is_anys/10))
+val last_is_anys : bool * bool -> int = <fun>
+|}]
+
+let last_is_vars = function
+  | true, false -> 1
+  | _, false -> 2
+  | _x, _y -> 3
+;;
+[%%expect{|
+(let
+  (last_is_vars/17 =
+     (function param/21 : int
+       (catch
+         (if (field 0 param/21) (if (field 1 param/21) (exit 3) 1)
+           (if (field 1 param/21) (exit 3) 2))
+        with (3) 3)))
+  (apply (field 1 (global Toploop!)) "last_is_vars" last_is_vars/17))
+val last_is_vars : bool * bool -> int = <fun>
+|}]
+
+(******************************************************************************)
+
+(* Check that the [| _, false, true -> 12] gets raised. *)
+
+type t = ..
+type t += A | B of unit | C of bool * int;;
+[%%expect{|
+0a
+type t = ..
+(let
+  (A/25 = (makeblock 248 "A" (caml_fresh_oo_id 0))
+   B/26 = (makeblock 248 "B" (caml_fresh_oo_id 0))
+   C/27 = (makeblock 248 "C" (caml_fresh_oo_id 0)))
+  (seq (apply (field 1 (global Toploop!)) "A/25" A/25)
+    (apply (field 1 (global Toploop!)) "B/26" B/26)
+    (apply (field 1 (global Toploop!)) "C/27" C/27)))
+type t += A | B of unit | C of bool * int
+|}]
+
+let f = function
+  | A, true, _ -> 1
+  | _, false, false -> 11
+  | B _, true, _ -> 2
+  | C _, true, _ -> 3
+  | _, false, true -> 12
+  | _ -> 4
+;;
+[%%expect{|
+(let
+  (C/27 = (apply (field 0 (global Toploop!)) "C/27")
+   B/26 = (apply (field 0 (global Toploop!)) "B/26")
+   A/25 = (apply (field 0 (global Toploop!)) "A/25")
+   f/28 =
+     (function param/30 : int
+       (let (*match*/31 =a (field 0 param/30))
+         (catch
+           (if (== *match*/31 A/25) (if (field 1 param/30) 1 (exit 8))
+             (exit 8))
+          with (8)
+           (if (field 1 param/30)
+             (if (== (field 0 *match*/31) B/26) 2
+               (if (== (field 0 *match*/31) C/27) 3 4))
+             (if (field 2 param/30) 12 11))))))
+  (apply (field 1 (global Toploop!)) "f" f/28))
+val f : t * bool * bool -> int = <fun>
+|}]
diff --git a/testsuite/tests/basic/pr7253.ml b/testsuite/tests/basic/pr7253.ml
new file mode 100644
index 00000000..23c51f21
--- /dev/null
+++ b/testsuite/tests/basic/pr7253.ml
@@ -0,0 +1,15 @@
+(* TEST *)
+
+(* MPR#7253: "at_exit functions get called twice if a callback raises
+   and prevents earlier handlers to execute." *)
+
+exception My_exception
+
+let () =
+  Printexc.set_uncaught_exception_handler (fun exn bt ->
+    match exn with
+    | My_exception -> print_endline "Caught"; exit 0
+    | _ -> print_endline "Unexpected uncaught exception");
+  at_exit (fun () -> print_endline "Last");
+  at_exit (fun () -> print_endline "Raise"; raise My_exception);
+  at_exit (fun () -> print_endline "First")
diff --git a/testsuite/tests/basic/pr7253.reference b/testsuite/tests/basic/pr7253.reference
new file mode 100644
index 00000000..009dd378
--- /dev/null
+++ b/testsuite/tests/basic/pr7253.reference
@@ -0,0 +1,4 @@
+First
+Raise
+Last
+Caught
diff --git a/testsuite/tests/basic/pr7533.ml b/testsuite/tests/basic/pr7533.ml
new file mode 100644
index 00000000..739e4cb8
--- /dev/null
+++ b/testsuite/tests/basic/pr7533.ml
@@ -0,0 +1,21 @@
+(* TEST *)
+
+(* PR#7533 *)
+
+exception Foo
+
+let f x =
+  if x > 42 then 1
+  else raise Foo
+
+let () =
+  let f = Sys.opaque_identity f in
+  match (f 0) / (List.hd (Sys.opaque_identity [0])) with
+  | exception Foo -> ()
+  | _ -> assert false
+
+let () =
+  let f = Sys.opaque_identity f in
+  match (f 0) mod (List.hd (Sys.opaque_identity [0])) with
+  | exception Foo -> ()
+  | _ -> assert false
diff --git a/testsuite/tests/basic/pr7533.reference b/testsuite/tests/basic/pr7533.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/basic/pr7657.ml b/testsuite/tests/basic/pr7657.ml
new file mode 100644
index 00000000..221506d0
--- /dev/null
+++ b/testsuite/tests/basic/pr7657.ml
@@ -0,0 +1,15 @@
+(* TEST *)
+
+[@@@ocaml.warning "-21-5"]
+
+let foo g () = g 1; ()
+let f1 ?x y = print_endline "f1"
+let f2 ?x y = print_endline "f2"
+
+let () =
+  try foo (raise Exit; f1); print_endline "FAIL"
+  with Exit -> print_endline "OK"
+
+let r : (?x:unit -> int -> unit) ref = ref f1
+let h = foo r.contents
+let () = h (); r := f2; h ()
diff --git a/testsuite/tests/basic/pr7657.reference b/testsuite/tests/basic/pr7657.reference
new file mode 100644
index 00000000..2268fbef
--- /dev/null
+++ b/testsuite/tests/basic/pr7657.reference
@@ -0,0 +1,3 @@
+OK
+f1
+f1
diff --git a/testsuite/tests/basic/recvalues.ml b/testsuite/tests/basic/recvalues.ml
new file mode 100644
index 00000000..5605202e
--- /dev/null
+++ b/testsuite/tests/basic/recvalues.ml
@@ -0,0 +1,40 @@
+(* TEST *)
+
+(* Recursive value definitions *)
+
+let _ =
+  let rec x = 1 :: x in
+  if match x with
+       1 :: x' -> x == x'
+     | _ -> false
+  then print_string "Test 1: passed\n"
+  else print_string "Test 1: FAILED\n";
+  let one = 1 in
+  let rec y = (one, one+1) :: y in
+  if match y with
+       (1,2) :: y' -> y == y'
+     | _ -> false
+  then print_string "Test 2: passed\n"
+  else print_string "Test 2: FAILED\n";
+  let rec z = (Gc.minor(); (one, one+1)) :: z in
+  (* Trash the minor generation *)
+  for i = 0 to 50000 do ignore (ref 0) done;
+  if match z with
+       (1,2) :: z' -> z == z'
+     | _ -> false
+  then print_string "Test 3: passed\n"
+  else print_string "Test 3: FAILED\n";
+;;
+
+let rec s = "bar"
+and idx = 1
+and x1 = let f x = Printf.printf "%s\n" x in f "foo"; s, x4
+and x2 = [| x1; x1 |]
+and x3 = (fun () -> fst (x2.(idx))) :: x3
+and x4 = {contents = x3}
+;;
+
+Gc.minor ();;
+if (List.hd (!(snd (x2.(0))))) () == s
+then print_string "Test 4: passed\n"
+else print_string "Test 4: FAILED\n"
diff --git a/testsuite/tests/basic/recvalues.reference b/testsuite/tests/basic/recvalues.reference
new file mode 100644
index 00000000..ac71fc1d
--- /dev/null
+++ b/testsuite/tests/basic/recvalues.reference
@@ -0,0 +1,5 @@
+Test 1: passed
+Test 2: passed
+Test 3: passed
+foo
+Test 4: passed
diff --git a/testsuite/tests/basic/sets.ml b/testsuite/tests/basic/sets.ml
new file mode 100644
index 00000000..ca5b14a1
--- /dev/null
+++ b/testsuite/tests/basic/sets.ml
@@ -0,0 +1,27 @@
+(* TEST *)
+
+module IntSet = Set.Make(struct type t = int let compare x y = x-y end)
+
+let even = List.fold_right IntSet.add [0; -2; 2; 4; 6; -10] IntSet.empty
+
+let odd = List.fold_right IntSet.add [9; -7; 5; 1; -3] IntSet.empty
+
+let _ =
+  for i = -10 to 10 do
+    Printf.printf "%d  %B  %B\n" i (IntSet.mem i even) (IntSet.mem i odd)
+  done
+
+module PowerSet(BaseSet: Set.S)
+               (SetOrd: functor(S: Set.S) -> Set.OrderedType) =
+  Set.Make(SetOrd(BaseSet))
+
+module IntSetSet = PowerSet(IntSet)(functor (S: Set.S) -> S)
+
+let setofset = List.fold_right IntSetSet.add [even; odd] IntSetSet.empty
+
+let _ =
+  List.iter
+    (fun s -> Printf.printf "%B\n" (IntSetSet.mem s setofset))
+    [IntSet.empty; even; odd; IntSet.union even odd]
+
+let _ = exit 0
diff --git a/testsuite/tests/basic/sets.reference b/testsuite/tests/basic/sets.reference
new file mode 100644
index 00000000..2d4ebc24
--- /dev/null
+++ b/testsuite/tests/basic/sets.reference
@@ -0,0 +1,25 @@
+-10  true  false
+-9  false  false
+-8  false  false
+-7  false  true
+-6  false  false
+-5  false  false
+-4  false  false
+-3  false  true
+-2  true  false
+-1  false  false
+0  true  false
+1  false  true
+2  true  false
+3  false  false
+4  true  false
+5  false  true
+6  true  false
+7  false  false
+8  false  false
+9  false  true
+10  false  false
+false
+true
+true
+false
diff --git a/testsuite/tests/basic/stringmatch.ml b/testsuite/tests/basic/stringmatch.ml
new file mode 100644
index 00000000..ac14c6de
--- /dev/null
+++ b/testsuite/tests/basic/stringmatch.ml
@@ -0,0 +1,740 @@
+(* TEST *)
+
+(* Empty string oddities *)
+
+let rec tst01 s = match s with
+| "" -> 0
+| _ -> 1
+
+let () =
+  assert (tst01 "" = 0) ;
+  assert (tst01  "\000\000\000\003" = 1) ;
+  assert (tst01  "\000\000\000\000\000\000\000\007" = 1) ;
+  ()
+
+(* A few when clauses *)
+
+let tst02 s =
+  let len = String.length s in
+  match s with
+  | "" when len < 0 -> assert false
+  | "" -> 1
+  | _ when len = 0 -> assert false
+  | "A" -> 2
+  | _ -> 3
+
+let () =
+  assert (tst02 "" = 1) ;
+  assert (tst02 "A" = 2) ;
+  assert (tst02 "B" = 3) ;
+  assert (tst02 "\000\000\000\000\000\000\000\007" = 3) ;
+  assert (tst02 "\000\000\000\003" = 3) ;
+  ()
+
+(* Keword reckognition *)
+
+let s00 = "get_const"
+let t00 = "set_congt"
+let s01 = "get_var"
+let t01 = "gat_ver"
+let s02 = "get_env"
+let t02 = "get_env"
+let s03 = "get_meth"
+let t03 = "met_geth"
+let s04 = "set_var"
+let t04 = "sev_tar"
+let s05 = "app_const"
+let t05 = "ppa_const"
+let s06 = "app_var"
+let t06 = "app_var"
+let s07 = "app_env"
+let t07 = "epp_anv"
+let s08 = "app_meth"
+let t08 = "atp_meph"
+let s09 = "app_const_const"
+let t09 = "app_const_const"
+let s10 = "app_const_var"
+let t10 = "atp_consp_var"
+let s11 = "app_const_env"
+let t11 = "app_constne_v"
+let s12 = "app_const_meth"
+let t12 = "spp_conat_meth"
+let s13 = "app_var_const"
+let t13 = "app_va_rconst"
+let s14 = "app_env_const"
+let t14 = "app_env_const"
+let s15 = "app_meth_const"
+let t15 = "app_teth_consm"
+let s16 = "meth_app_const"
+let t16 = "math_epp_const"
+let s17 = "meth_app_var"
+let t17 = "meth_app_var"
+let s18 = "meth_app_env"
+let t18 = "eeth_app_mnv"
+let s19 = "meth_app_meth"
+let t19 = "meth_apt_meph"
+let s20 = "send_const"
+let t20 = "tend_conss"
+let s21 = "send_var"
+let t21 = "serd_van"
+let s22 = "send_env"
+let t22 = "sen_denv"
+let s23 = "send_meth"
+let t23 = "tend_mesh"
+
+let tst03 s = match s with
+| "get_const" -> 0
+| "get_var" -> 1
+| "get_env" -> 2
+| "get_meth" -> 3
+| "set_var" -> 4
+| "app_const" -> 5
+| "app_var" -> 6
+| "app_env" -> 7
+| "app_meth" -> 8
+| "app_const_const" -> 9
+| "app_const_var" -> 10
+| "app_const_env" -> 11
+| "app_const_meth" -> 12
+| "app_var_const" -> 13
+| "app_env_const" -> 14
+| "app_meth_const" -> 15
+| "meth_app_const" -> 16
+| "meth_app_var" -> 17
+| "meth_app_env" -> 18
+| "meth_app_meth" -> 19
+| "send_const" -> 20
+| "send_var" -> 21
+| "send_env" -> 22
+| "send_meth" -> 23
+| _ -> -1
+
+let () =
+  assert (tst03 s00 = 0) ;
+  assert (tst03 t00 = -1) ;
+  assert (tst03 s01 = 1) ;
+  assert (tst03 t01 = -1) ;
+  assert (tst03 s02 = 2) ;
+  assert (tst03 t02 = 2) ;
+  assert (tst03 s03 = 3) ;
+  assert (tst03 t03 = -1) ;
+  assert (tst03 s04 = 4) ;
+  assert (tst03 t04 = -1) ;
+  assert (tst03 s05 = 5) ;
+  assert (tst03 t05 = -1) ;
+  assert (tst03 s06 = 6) ;
+  assert (tst03 t06 = 6) ;
+  assert (tst03 s07 = 7) ;
+  assert (tst03 t07 = -1) ;
+  assert (tst03 s08 = 8) ;
+  assert (tst03 t08 = -1) ;
+  assert (tst03 s09 = 9) ;
+  assert (tst03 t09 = 9) ;
+  assert (tst03 s10 = 10) ;
+  assert (tst03 t10 = -1) ;
+  assert (tst03 s11 = 11) ;
+  assert (tst03 t11 = -1) ;
+  assert (tst03 s12 = 12) ;
+  assert (tst03 t12 = -1) ;
+  assert (tst03 s13 = 13) ;
+  assert (tst03 t13 = -1) ;
+  assert (tst03 s14 = 14) ;
+  assert (tst03 t14 = 14) ;
+  assert (tst03 s15 = 15) ;
+  assert (tst03 t15 = -1) ;
+  assert (tst03 s16 = 16) ;
+  assert (tst03 t16 = -1) ;
+  assert (tst03 s17 = 17) ;
+  assert (tst03 t17 = 17) ;
+  assert (tst03 s18 = 18) ;
+  assert (tst03 t18 = -1) ;
+  assert (tst03 s19 = 19) ;
+  assert (tst03 t19 = -1) ;
+  assert (tst03 s20 = 20) ;
+  assert (tst03 t20 = -1) ;
+  assert (tst03 s21 = 21) ;
+  assert (tst03 t21 = -1) ;
+  assert (tst03 s22 = 22) ;
+  assert (tst03 t22 = -1) ;
+  assert (tst03 s23 = 23) ;
+  assert (tst03 t23 = -1) ;
+  ()
+
+(* Activate the test first column first heuristics *)
+
+let s00 = "AAAAAAAA"
+let s01 = "AAAAAAAAAAAAAAAA"
+let s02 = "AAAAAAAAAAAAAAAAAAAAAAAA"
+let s03 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let s04 = "BBBBBBBB"
+let s05 = "BBBBBBBBBBBBBBBB"
+let s06 = "BBBBBBBBBBBBBBBBBBBBBBBB"
+let s07 = "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB"
+let s08 = "CCCCCCCC"
+let s09 = "CCCCCCCCCCCCCCCC"
+let s10 = "CCCCCCCCCCCCCCCCCCCCCCCC"
+let s11 = "CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC"
+
+let tst04 s = match s with
+| "AAAAAAAA" -> 0
+| "AAAAAAAAAAAAAAAA" -> 1
+| "AAAAAAAAAAAAAAAAAAAAAAAA" -> 2
+| "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 3
+| "BBBBBBBB" -> 4
+| "BBBBBBBBBBBBBBBB" -> 5
+| "BBBBBBBBBBBBBBBBBBBBBBBB" -> 6
+| "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB" -> 7
+| "CCCCCCCC" -> 8
+| "CCCCCCCCCCCCCCCC" -> 9
+| "CCCCCCCCCCCCCCCCCCCCCCCC" -> 10
+| "CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC" -> 11
+| _ -> -1
+
+let () =
+  assert (tst04 s00 = 0) ;
+  assert (tst04 s01 = 1) ;
+  assert (tst04 s02 = 2) ;
+  assert (tst04 s03 = 3) ;
+  assert (tst04 s04 = 4) ;
+  assert (tst04 s05 = 5) ;
+  assert (tst04 s06 = 6) ;
+  assert (tst04 s07 = 7) ;
+  assert (tst04 s08 = 8) ;
+  assert (tst04 s09 = 9) ;
+  assert (tst04 s10 = 10) ;
+  assert (tst04 s11 = 11) ;
+  assert (tst04 "" = -1) ;
+  assert (tst04 "DDD" = -1) ;
+  assert (tst04 "DDDDDDD" = -1) ;
+  assert (tst04 "AAADDDD" = -1) ;
+  assert (tst04 "AAAAAAADDDDDDDD" = -1) ;
+  assert (tst04 "AAAAAAADDDD" = -1) ;
+  assert (tst04 "AAAAAAAAAAAAAAADDDD" = -1) ;
+  ()
+
+(* Similar *)
+
+let s00 = "AAA"
+let s01 = "AAAA"
+let s02 = "AAAAA"
+let s03 = "AAAAAA"
+let s04 = "AAAAAAA"
+let s05 = "AAAAAAAAAAAA"
+let s06 = "AAAAAAAAAAAAAAAA"
+let s07 = "AAAAAAAAAAAAAAAAAAAA"
+let s08 = "BBB"
+let s09 = "BBBB"
+let s10 = "BBBBB"
+let s11 = "BBBBBB"
+let s12 = "BBBBBBB"
+
+let tst05 s = match s with
+| "AAA" -> 0
+| "AAAA" -> 1
+| "AAAAA" -> 2
+| "AAAAAA" -> 3
+| "AAAAAAA" -> 4
+| "AAAAAAAAAAAA" -> 5
+| "AAAAAAAAAAAAAAAA" -> 6
+| "AAAAAAAAAAAAAAAAAAAA" -> 7
+| "BBB" -> 8
+| "BBBB" -> 9
+| "BBBBB" -> 10
+| "BBBBBB" -> 11
+| "BBBBBBB" -> 12
+| _ -> -1
+
+let () =
+  assert (tst05 s00 = 0) ;
+  assert (tst05 s01 = 1) ;
+  assert (tst05 s02 = 2) ;
+  assert (tst05 s03 = 3) ;
+  assert (tst05 s04 = 4) ;
+  assert (tst05 s05 = 5) ;
+  assert (tst05 s06 = 6) ;
+  assert (tst05 s07 = 7) ;
+  assert (tst05 s08 = 8) ;
+  assert (tst05 s09 = 9) ;
+  assert (tst05 s10 = 10) ;
+  assert (tst05 s11 = 11) ;
+  assert (tst05 s12 = 12) ;
+  assert (tst05 "" = -1) ;
+  assert (tst05 "AAD" = -1) ;
+  assert (tst05 "AAAD" = -1) ;
+  assert (tst05 "AAAAAAD" = -1) ;
+  assert (tst05 "AAAAAAAD" = -1) ;
+  assert (tst05 "BBD" = -1) ;
+  assert (tst05 "BBBD" = -1) ;
+  assert (tst05 "BBBBBBD" = -1) ;
+  assert (tst05 "BBBBBBBD" = -1) ;
+  ()
+
+(* Big test *)
+
+let s00 = "and"
+let t00 = "nad"
+let s01 = "as"
+let t01 = "sa"
+let s02 = "assert"
+let t02 = "asesrt"
+let s03 = "begin"
+let t03 = "negib"
+let s04 = "class"
+let t04 = "lcass"
+let s05 = "constraint"
+let t05 = "constiarnt"
+let s06 = "do"
+let t06 = "od"
+let s07 = "done"
+let t07 = "eond"
+let s08 = "downto"
+let t08 = "dowtno"
+let s09 = "else"
+let t09 = "lese"
+let s10 = "end"
+let t10 = "edn"
+let s11 = "exception"
+let t11 = "exception"
+let s12 = "external"
+let t12 = "external"
+let s13 = "false"
+let t13 = "fslae"
+let s14 = "for"
+let t14 = "ofr"
+let s15 = "fun"
+let t15 = "fnu"
+let s16 = "function"
+let t16 = "function"
+let s17 = "functor"
+let t17 = "ounctfr"
+let s18 = "if"
+let t18 = "fi"
+let s19 = "in"
+let t19 = "in"
+let s20 = "include"
+let t20 = "inculde"
+let s21 = "inherit"
+let t21 = "iehnrit"
+let s22 = "initializer"
+let t22 = "enitializir"
+let s23 = "lazy"
+let t23 = "zaly"
+let s24 = "let"
+let t24 = "elt"
+let s25 = "match"
+let t25 = "match"
+let s26 = "method"
+let t26 = "methdo"
+let s27 = "module"
+let t27 = "modelu"
+let s28 = "mutable"
+let t28 = "butamle"
+let s29 = "new"
+let t29 = "wen"
+let s30 = "object"
+let t30 = "objcet"
+let s31 = "of"
+let t31 = "of"
+let s32 = "open"
+let t32 = "epon"
+let s33 = "or"
+let t33 = "ro"
+let s34 = "private"
+let t34 = "privaet"
+let s35 = "rec"
+let t35 = "rec"
+let s36 = "sig"
+let t36 = "gis"
+let s37 = "struct"
+let t37 = "scrutt"
+let s38 = "then"
+let t38 = "hten"
+let s39 = "to"
+let t39 = "to"
+let s40 = "true"
+let t40 = "teur"
+let s41 = "try"
+let t41 = "try"
+let s42 = "type"
+let t42 = "pyte"
+let s43 = "val"
+let t43 = "val"
+let s44 = "virtual"
+let t44 = "vritual"
+let s45 = "when"
+let t45 = "whne"
+let s46 = "while"
+let t46 = "wlihe"
+let s47 = "with"
+let t47 = "iwth"
+let s48 = "mod"
+let t48 = "mod"
+let s49 = "land"
+let t49 = "alnd"
+let s50 = "lor"
+let t50 = "rol"
+let s51 = "lxor"
+let t51 = "lxor"
+let s52 = "lsl"
+let t52 = "lsl"
+let s53 = "lsr"
+let t53 = "lsr"
+let s54 = "asr"
+let t54 = "sar"
+let s55 = "A"
+let t55 = "A"
+let s56 = "AA"
+let t56 = "AA"
+let s57 = "AAA"
+let t57 = "AAA"
+let s58 = "AAAA"
+let t58 = "AAAA"
+let s59 = "AAAAA"
+let t59 = "AAAAA"
+let s60 = "AAAAAA"
+let t60 = "AAAAAA"
+let s61 = "AAAAAAA"
+let t61 = "AAAAAAA"
+let s62 = "AAAAAAAA"
+let t62 = "AAAAAAAA"
+let s63 = "AAAAAAAAA"
+let t63 = "AAAAAAAAA"
+let s64 = "AAAAAAAAAA"
+let t64 = "AAAAAAAAAA"
+let s65 = "AAAAAAAAAAA"
+let t65 = "AAAAAAAAAAA"
+let s66 = "AAAAAAAAAAAA"
+let t66 = "AAAAAAAAAAAA"
+let s67 = "AAAAAAAAAAAAA"
+let t67 = "AAAAAAAAAAAAA"
+let s68 = "AAAAAAAAAAAAAA"
+let t68 = "AAAAAAAAAAAAAA"
+let s69 = "AAAAAAAAAAAAAAA"
+let t69 = "AAAAAAAAAAAAAAA"
+let s70 = "AAAAAAAAAAAAAAAA"
+let t70 = "AAAAAAAAAAAAAAAA"
+let s71 = "AAAAAAAAAAAAAAAAA"
+let t71 = "AAAAAAAAAAAAAAAAA"
+let s72 = "AAAAAAAAAAAAAAAAAA"
+let t72 = "AAAAAAAAAAAAAAAAAA"
+let s73 = "AAAAAAAAAAAAAAAAAAA"
+let t73 = "AAAAAAAAAAAAAAAAAAA"
+let s74 = "AAAAAAAAAAAAAAAAAAAA"
+let t74 = "AAAAAAAAAAAAAAAAAAAA"
+let s75 = "AAAAAAAAAAAAAAAAAAAAA"
+let t75 = "AAAAAAAAAAAAAAAAAAAAA"
+let s76 = "AAAAAAAAAAAAAAAAAAAAAA"
+let t76 = "AAAAAAAAAAAAAAAAAAAAAA"
+let s77 = "AAAAAAAAAAAAAAAAAAAAAAA"
+let t77 = "AAAAAAAAAAAAAAAAAAAAAAA"
+let s78 = "AAAAAAAAAAAAAAAAAAAAAAAA"
+let t78 = "AAAAAAAAAAAAAAAAAAAAAAAA"
+let s79 = "AAAAAAAAAAAAAAAAAAAAAAAAA"
+let t79 = "AAAAAAAAAAAAAAAAAAAAAAAAA"
+let s80 = "AAAAAAAAAAAAAAAAAAAAAAAAAA"
+let t80 = "AAAAAAAAAAAAAAAAAAAAAAAAAA"
+let s81 = "AAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let t81 = "AAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let s82 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let t82 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let s83 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let t83 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let s84 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let t84 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let s85 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let t85 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let s86 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let t86 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let s87 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let t87 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let s88 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let t88 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+let s89 = "BBBBBBBBBBBBBBB"
+let t89 = "BBBBBBBBBBBBBBB"
+let s90 = "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB"
+let t90 = "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB"
+let s91 = "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB"
+let t91 = "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB"
+
+let tst06 s = match s with
+| "and" -> 0
+| "as" -> 1
+| "assert" -> 2
+| "begin" -> 3
+| "class" -> 4
+| "constraint" -> 5
+| "do" -> 6
+| "done" -> 7
+| "downto" -> 8
+| "else" -> 9
+| "end" -> 10
+| "exception" -> 11
+| "external" -> 12
+| "false" -> 13
+| "for" -> 14
+| "fun" -> 15
+| "function" -> 16
+| "functor" -> 17
+| "if" -> 18
+| "in" -> 19
+| "include" -> 20
+| "inherit" -> 21
+| "initializer" -> 22
+| "lazy" -> 23
+| "let" -> 24
+| "match" -> 25
+| "method" -> 26
+| "module" -> 27
+| "mutable" -> 28
+| "new" -> 29
+| "object" -> 30
+| "of" -> 31
+| "open" -> 32
+| "or" -> 33
+| "private" -> 34
+| "rec" -> 35
+| "sig" -> 36
+| "struct" -> 37
+| "then" -> 38
+| "to" -> 39
+| "true" -> 40
+| "try" -> 41
+| "type" -> 42
+| "val" -> 43
+| "virtual" -> 44
+| "when" -> 45
+| "while" -> 46
+| "with" -> 47
+| "mod" -> 48
+| "land" -> 49
+| "lor" -> 50
+| "lxor" -> 51
+| "lsl" -> 52
+| "lsr" -> 53
+| "asr" -> 54
+| "A" -> 55
+| "AA" -> 56
+| "AAA" -> 57
+| "AAAA" -> 58
+| "AAAAA" -> 59
+| "AAAAAA" -> 60
+| "AAAAAAA" -> 61
+| "AAAAAAAA" -> 62
+| "AAAAAAAAA" -> 63
+| "AAAAAAAAAA" -> 64
+| "AAAAAAAAAAA" -> 65
+| "AAAAAAAAAAAA" -> 66
+| "AAAAAAAAAAAAA" -> 67
+| "AAAAAAAAAAAAAA" -> 68
+| "AAAAAAAAAAAAAAA" -> 69
+| "AAAAAAAAAAAAAAAA" -> 70
+| "AAAAAAAAAAAAAAAAA" -> 71
+| "AAAAAAAAAAAAAAAAAA" -> 72
+| "AAAAAAAAAAAAAAAAAAA" -> 73
+| "AAAAAAAAAAAAAAAAAAAA" -> 74
+| "AAAAAAAAAAAAAAAAAAAAA" -> 75
+| "AAAAAAAAAAAAAAAAAAAAAA" -> 76
+| "AAAAAAAAAAAAAAAAAAAAAAA" -> 77
+| "AAAAAAAAAAAAAAAAAAAAAAAA" -> 78
+| "AAAAAAAAAAAAAAAAAAAAAAAAA" -> 79
+| "AAAAAAAAAAAAAAAAAAAAAAAAAA" -> 80
+| "AAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 81
+| "AAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 82
+| "AAAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 83
+| "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 84
+| "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 85
+| "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 86
+| "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 87
+| "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 88
+| "BBBBBBBBBBBBBBB" -> 89
+| "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB" -> 90
+| "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB" -> 91
+| _ -> -1
+
+let () =
+  assert (tst06 s00 = 0) ;
+  assert (tst06 t00 = -1) ;
+  assert (tst06 s01 = 1) ;
+  assert (tst06 t01 = -1) ;
+  assert (tst06 s02 = 2) ;
+  assert (tst06 t02 = -1) ;
+  assert (tst06 s03 = 3) ;
+  assert (tst06 t03 = -1) ;
+  assert (tst06 s04 = 4) ;
+  assert (tst06 t04 = -1) ;
+  assert (tst06 s05 = 5) ;
+  assert (tst06 t05 = -1) ;
+  assert (tst06 s06 = 6) ;
+  assert (tst06 t06 = -1) ;
+  assert (tst06 s07 = 7) ;
+  assert (tst06 t07 = -1) ;
+  assert (tst06 s08 = 8) ;
+  assert (tst06 t08 = -1) ;
+  assert (tst06 s09 = 9) ;
+  assert (tst06 t09 = -1) ;
+  assert (tst06 s10 = 10) ;
+  assert (tst06 t10 = -1) ;
+  assert (tst06 s11 = 11) ;
+  assert (tst06 t11 = 11) ;
+  assert (tst06 s12 = 12) ;
+  assert (tst06 t12 = 12) ;
+  assert (tst06 s13 = 13) ;
+  assert (tst06 t13 = -1) ;
+  assert (tst06 s14 = 14) ;
+  assert (tst06 t14 = -1) ;
+  assert (tst06 s15 = 15) ;
+  assert (tst06 t15 = -1) ;
+  assert (tst06 s16 = 16) ;
+  assert (tst06 t16 = 16) ;
+  assert (tst06 s17 = 17) ;
+  assert (tst06 t17 = -1) ;
+  assert (tst06 s18 = 18) ;
+  assert (tst06 t18 = -1) ;
+  assert (tst06 s19 = 19) ;
+  assert (tst06 t19 = 19) ;
+  assert (tst06 s20 = 20) ;
+  assert (tst06 t20 = -1) ;
+  assert (tst06 s21 = 21) ;
+  assert (tst06 t21 = -1) ;
+  assert (tst06 s22 = 22) ;
+  assert (tst06 t22 = -1) ;
+  assert (tst06 s23 = 23) ;
+  assert (tst06 t23 = -1) ;
+  assert (tst06 s24 = 24) ;
+  assert (tst06 t24 = -1) ;
+  assert (tst06 s25 = 25) ;
+  assert (tst06 t25 = 25) ;
+  assert (tst06 s26 = 26) ;
+  assert (tst06 t26 = -1) ;
+  assert (tst06 s27 = 27) ;
+  assert (tst06 t27 = -1) ;
+  assert (tst06 s28 = 28) ;
+  assert (tst06 t28 = -1) ;
+  assert (tst06 s29 = 29) ;
+  assert (tst06 t29 = -1) ;
+  assert (tst06 s30 = 30) ;
+  assert (tst06 t30 = -1) ;
+  assert (tst06 s31 = 31) ;
+  assert (tst06 t31 = 31) ;
+  assert (tst06 s32 = 32) ;
+  assert (tst06 t32 = -1) ;
+  assert (tst06 s33 = 33) ;
+  assert (tst06 t33 = -1) ;
+  assert (tst06 s34 = 34) ;
+  assert (tst06 t34 = -1) ;
+  assert (tst06 s35 = 35) ;
+  assert (tst06 t35 = 35) ;
+  assert (tst06 s36 = 36) ;
+  assert (tst06 t36 = -1) ;
+  assert (tst06 s37 = 37) ;
+  assert (tst06 t37 = -1) ;
+  assert (tst06 s38 = 38) ;
+  assert (tst06 t38 = -1) ;
+  assert (tst06 s39 = 39) ;
+  assert (tst06 t39 = 39) ;
+  assert (tst06 s40 = 40) ;
+  assert (tst06 t40 = -1) ;
+  assert (tst06 s41 = 41) ;
+  assert (tst06 t41 = 41) ;
+  assert (tst06 s42 = 42) ;
+  assert (tst06 t42 = -1) ;
+  assert (tst06 s43 = 43) ;
+  assert (tst06 t43 = 43) ;
+  assert (tst06 s44 = 44) ;
+  assert (tst06 t44 = -1) ;
+  assert (tst06 s45 = 45) ;
+  assert (tst06 t45 = -1) ;
+  assert (tst06 s46 = 46) ;
+  assert (tst06 t46 = -1) ;
+  assert (tst06 s47 = 47) ;
+  assert (tst06 t47 = -1) ;
+  assert (tst06 s48 = 48) ;
+  assert (tst06 t48 = 48) ;
+  assert (tst06 s49 = 49) ;
+  assert (tst06 t49 = -1) ;
+  assert (tst06 s50 = 50) ;
+  assert (tst06 t50 = -1) ;
+  assert (tst06 s51 = 51) ;
+  assert (tst06 t51 = 51) ;
+  assert (tst06 s52 = 52) ;
+  assert (tst06 t52 = 52) ;
+  assert (tst06 s53 = 53) ;
+  assert (tst06 t53 = 53) ;
+  assert (tst06 s54 = 54) ;
+  assert (tst06 t54 = -1) ;
+  assert (tst06 s55 = 55) ;
+  assert (tst06 t55 = 55) ;
+  assert (tst06 s56 = 56) ;
+  assert (tst06 t56 = 56) ;
+  assert (tst06 s57 = 57) ;
+  assert (tst06 t57 = 57) ;
+  assert (tst06 s58 = 58) ;
+  assert (tst06 t58 = 58) ;
+  assert (tst06 s59 = 59) ;
+  assert (tst06 t59 = 59) ;
+  assert (tst06 s60 = 60) ;
+  assert (tst06 t60 = 60) ;
+  assert (tst06 s61 = 61) ;
+  assert (tst06 t61 = 61) ;
+  assert (tst06 s62 = 62) ;
+  assert (tst06 t62 = 62) ;
+  assert (tst06 s63 = 63) ;
+  assert (tst06 t63 = 63) ;
+  assert (tst06 s64 = 64) ;
+  assert (tst06 t64 = 64) ;
+  assert (tst06 s65 = 65) ;
+  assert (tst06 t65 = 65) ;
+  assert (tst06 s66 = 66) ;
+  assert (tst06 t66 = 66) ;
+  assert (tst06 s67 = 67) ;
+  assert (tst06 t67 = 67) ;
+  assert (tst06 s68 = 68) ;
+  assert (tst06 t68 = 68) ;
+  assert (tst06 s69 = 69) ;
+  assert (tst06 t69 = 69) ;
+  assert (tst06 s70 = 70) ;
+  assert (tst06 t70 = 70) ;
+  assert (tst06 s71 = 71) ;
+  assert (tst06 t71 = 71) ;
+  assert (tst06 s72 = 72) ;
+  assert (tst06 t72 = 72) ;
+  assert (tst06 s73 = 73) ;
+  assert (tst06 t73 = 73) ;
+  assert (tst06 s74 = 74) ;
+  assert (tst06 t74 = 74) ;
+  assert (tst06 s75 = 75) ;
+  assert (tst06 t75 = 75) ;
+  assert (tst06 s76 = 76) ;
+  assert (tst06 t76 = 76) ;
+  assert (tst06 s77 = 77) ;
+  assert (tst06 t77 = 77) ;
+  assert (tst06 s78 = 78) ;
+  assert (tst06 t78 = 78) ;
+  assert (tst06 s79 = 79) ;
+  assert (tst06 t79 = 79) ;
+  assert (tst06 s80 = 80) ;
+  assert (tst06 t80 = 80) ;
+  assert (tst06 s81 = 81) ;
+  assert (tst06 t81 = 81) ;
+  assert (tst06 s82 = 82) ;
+  assert (tst06 t82 = 82) ;
+  assert (tst06 s83 = 83) ;
+  assert (tst06 t83 = 83) ;
+  assert (tst06 s84 = 84) ;
+  assert (tst06 t84 = 84) ;
+  assert (tst06 s85 = 85) ;
+  assert (tst06 t85 = 85) ;
+  assert (tst06 s86 = 86) ;
+  assert (tst06 t86 = 86) ;
+  assert (tst06 s87 = 87) ;
+  assert (tst06 t87 = 87) ;
+  assert (tst06 s88 = 88) ;
+  assert (tst06 t88 = 88) ;
+  assert (tst06 s89 = 89) ;
+  assert (tst06 t89 = 89) ;
+  assert (tst06 s90 = 90) ;
+  assert (tst06 t90 = 90) ;
+  assert (tst06 s91 = 91) ;
+  assert (tst06 t91 = 91) ;
+  assert (tst06 "" = -1) ;
+  ()
diff --git a/testsuite/tests/basic/stringmatch.reference b/testsuite/tests/basic/stringmatch.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/basic/switch_opts.ml b/testsuite/tests/basic/switch_opts.ml
new file mode 100644
index 00000000..b4e563fe
--- /dev/null
+++ b/testsuite/tests/basic/switch_opts.ml
@@ -0,0 +1,309 @@
+(* TEST *)
+
+(* Test for optimisation of jump tables to arrays of constants *)
+
+let p = Printf.printf
+
+type test =
+  Test : 'b * 'a * ('b -> 'a) -> test
+
+type t = A | B | C
+
+(* These test functions need to have at least three cases.
+   Functions with fewer cases don't trigger the optimisation,
+   as they are compiled to if-then-else, not switch *)
+
+let passes = ref 0
+
+let full_test line ~f ~results () =
+  let f = Sys.opaque_identity f in
+  List.iter
+    (fun (input, output) ->
+       let result = f input in
+       if result <> output
+       then raise (Assert_failure (__FILE__,line,0))
+    )
+    results;
+  incr passes
+
+let test_int_match =
+  full_test __LINE__
+    ~f:(function
+      | 1 -> 1
+      | 2 -> 2
+      | 3 -> 3
+      | _ -> 0
+    )
+    ~results:
+      [ 1,1; 2,2; 3,3; 4,0; 0,0 ]
+
+let test_int_match_reverse =
+  full_test __LINE__
+    ~f:(function
+      | 1 -> 3
+      | 2 -> 2
+      | 3 -> 1
+      | _ -> 0
+    )
+    ~results:
+      [ 1,3; 2,2; 3,1; 4,0; 0,0 ]
+
+let test_int_match_negative =
+  full_test __LINE__
+    ~f:(function
+      | 1 -> -1
+      | 2 -> -2
+      | 3 -> -3
+      | _ -> 0
+    )
+    ~results:
+      [ 1,-1; 2,-2; 3,-3; 4,0; 0,0 ]
+
+let test_int_match_negative_reverse =
+  full_test __LINE__
+    ~f:(function
+      | 1 -> -3
+      | 2 -> -2
+      | 3 -> -1
+      | _ -> 0
+    )
+    ~results:
+      [ 1,-3; 2,-2; 3,-1; 4,0; 0,0 ]
+
+let test_int_min_int =
+  full_test __LINE__
+    ~f:(function
+      | 1 -> 1
+      | 2 -> 2
+      | 3 -> min_int
+      | _ -> 0
+    )
+    ~results:
+      [ 1,1; 2,2; 3,min_int; 4,0; 0,0 ]
+
+let test_int_max_int =
+  full_test __LINE__
+    ~f:(function
+      | 1 -> 1
+      | 2 -> 2
+      | 3 -> max_int
+      | _ -> 0
+    )
+    ~results:
+      [ 1,1; 2,2; 3,max_int; 4,0; 0,0 ]
+
+let test_float =
+  full_test __LINE__
+    ~f:(function
+      | 1 -> 1.0
+      | 2 -> 2.0
+      | 3 -> 3.0
+      | _ -> 0.0
+    )
+    ~results:
+      [ 1,1.0; 2,2.0; 3,3.0; 4,0.0; 0,0.0 ]
+
+let test_string =
+  full_test __LINE__
+    ~f:(function
+      | 1 -> "a"
+      | 2 -> "b"
+      | 3 -> "cc"
+      | _ -> ""
+    )
+    ~results:
+      [ 1,"a"; 2, "b"
+      ; 3, Sys.opaque_identity "c" ^ Sys.opaque_identity "c"; 4, ""; 0, "" ]
+
+let test_list =
+  full_test __LINE__
+    ~f:(function
+      | 1 -> []
+      | 2 -> [ 42 ]
+      | 3 -> [ 1; 2; 3 ]
+      | _ -> [ 415 ]
+    )
+    ~results:
+      [ 1, []; 2, [ 42 ]; 3, List.rev [3;2;1]; 4, [ 415 ]; 0, [ 415 ] ]
+
+let test_abc =
+  full_test __LINE__
+    ~f:(function
+      | A -> 1
+      | B -> 2
+      | C -> 3
+    )
+    ~results:
+      [ A, 1; B, 2; C, 3]
+
+let test_abc_unsorted =
+  full_test __LINE__
+    ~f:(function
+      | C -> 3
+      | A -> 1
+      | B -> 2
+    )
+    ~results:
+      [ A, 1; B, 2; C, 3]
+
+let test_abc_neg3 =
+  full_test __LINE__
+    ~f:(function
+      | A -> 1
+      | B -> 2
+      | C -> -3
+    )
+    ~results:
+      [ A, 1; B, 2; C, -3]
+
+let test_abc_min_int =
+  full_test __LINE__
+    ~f:(function
+      | A -> 1
+      | B -> 2
+      | C -> min_int
+    )
+    ~results:
+      [ A, 1; B, 2; C, min_int ]
+
+let test_abc_max_int =
+  full_test __LINE__
+    ~f:(function
+      | A -> 1
+      | B -> 2
+      | C -> max_int
+    )
+    ~results:
+      [ A, 1; B, 2; C, max_int ]
+
+let test_abc_float =
+  full_test __LINE__
+    ~f:(function
+      | A -> 1.
+      | B -> 2.
+      | C -> 3.
+    )
+    ~results:
+      [ A, 1.; B, 2.; C, 3. ]
+
+let test_abc_string =
+  full_test __LINE__
+    ~f:(function
+      | A -> "a"
+      | B -> "b"
+      | C -> "c"
+    )
+    ~results:
+      [ A, "a"; B, "b"; C, "c" ]
+
+let test_abc_list =
+  full_test __LINE__
+    ~f:(function
+      | A -> []
+      | B -> [42]
+      | C -> [1;2;3]
+    )
+    ~results:
+      [ A, []; B, [42]; C, List.rev [3;2;1] ]
+
+let test_f99 =
+  full_test __LINE__
+    ~f:(function
+      | 1 -> 1 | 2 -> 2 | 3 -> 3 | 4 -> 4 | 5 -> 5 | 6 -> 6 | 7 -> 7 | 8 -> 8
+      | 9 -> 9 | 10 -> 10 | 11 -> 11 | 12 -> 12 | 13 -> 13 | 14 -> 14 | 15 -> 15
+      | 16 -> 16 | 17 -> 17 | 18 -> 18 | 19 -> 19 | 20 -> 20 | 21 -> 21 | 22 -> 22
+      | 23 -> 23 | 24 -> 24 | 25 -> 25 | 26 -> 26 | 27 -> 27 | 28 -> 28 | 29 -> 29
+      | 30 -> 30 | 31 -> 31 | 32 -> 32 | 33 -> 33 | 34 -> 34 | 35 -> 35 | 36 -> 36
+      | 37 -> 37 | 38 -> 38 | 39 -> 39 | 40 -> 40 | 41 -> 41 | 42 -> 42 | 43 -> 43
+      | 44 -> 44 | 45 -> 45 | 46 -> 46 | 47 -> 47 | 48 -> 48 | 49 -> 49 | 50 -> 50
+      | 51 -> 51 | 52 -> 52 | 53 -> 53 | 54 -> 54 | 55 -> 55 | 56 -> 56 | 57 -> 57
+      | 58 -> 58 | 59 -> 59 | 60 -> 60 | 61 -> 61 | 62 -> 62 | 63 -> 63 | 64 -> 64
+      | 65 -> 65 | 66 -> 66 | 67 -> 67 | 68 -> 68 | 69 -> 69 | 70 -> 70 | 71 -> 71
+      | 72 -> 72 | 73 -> 73 | 74 -> 74 | 75 -> 75 | 76 -> 76 | 77 -> 77 | 78 -> 78
+      | 79 -> 79 | 80 -> 80 | 81 -> 81 | 82 -> 82 | 83 -> 83 | 84 -> 84 | 85 -> 85
+      | 86 -> 86 | 87 -> 87 | 88 -> 88 | 89 -> 89 | 90 -> 90 | 91 -> 91 | 92 -> 92
+      | 93 -> 93 | 94 -> 94 | 95 -> 95 | 96 -> 96 | 97 -> 97 | 98 -> 98 | 99 -> 99
+      | _ -> 0
+    )
+    ~results:
+      [ 1,1; 42,42; 98, 98; 99,99; 100, 0 ]
+
+let test_poly =
+  full_test __LINE__
+    ~f:(function
+      | 1 -> `Primary
+      | 2 -> `Secondary
+      | 3 -> `Tertiary
+      | n -> invalid_arg "test"
+    )
+    ~results:
+      [ 1, `Primary; 2, `Secondary; 3, `Tertiary ]
+
+let test_or =
+  full_test __LINE__
+    ~f:(function
+      | 1 | 2 | 3 -> 0
+      | 4 | 5 | 6 -> 1
+      | 7 -> 2
+      | _ -> 0
+    )
+    ~results:
+      [ 1,0; 2,0; 3,0; 4,1; 5,1; 6,1; 7,2; 8,0; 0,0 ]
+
+type t' = E | F | G | H
+
+let test_or_efgh =
+  full_test __LINE__
+    ~f:(function
+      | E | H -> 0
+      | F -> 1
+      | G -> 2
+    )
+    ~results:
+      [ E,0; H,0; F,1; G,2 ]
+
+type 'a gadt =
+  | Ag : int gadt
+  | Bg : string gadt
+  | Cg : int gadt
+  | Dg : int gadt
+  | Eg : int gadt
+
+let test_gadt =
+  full_test __LINE__
+    ~f:(function
+      | Ag -> 1
+      | Cg -> 2
+      | Dg -> 3
+      | Eg -> 4
+    )
+    ~results:
+      [ Ag,1; Cg,2; Dg,3; Eg,4 ]
+
+let () =
+  test_int_match ();
+  test_int_match_reverse ();
+  test_int_match_negative ();
+  test_int_match_negative_reverse ();
+  test_int_min_int ();
+  test_int_max_int ();
+  test_float ();
+  test_string ();
+  test_list ();
+  test_abc ();
+  test_abc_unsorted ();
+  test_abc_neg3 ();
+  test_abc_min_int ();
+  test_abc_max_int ();
+  test_abc_float ();
+  test_abc_string ();
+  test_abc_list ();
+  test_f99 ();
+  test_poly ();
+  test_or ();
+  test_or_efgh ();
+  test_gadt ();
+  ()
+
+let () =
+  Printf.printf "%d tests passed\n" !passes
diff --git a/testsuite/tests/basic/switch_opts.reference b/testsuite/tests/basic/switch_opts.reference
new file mode 100644
index 00000000..cb07836c
--- /dev/null
+++ b/testsuite/tests/basic/switch_opts.reference
@@ -0,0 +1 @@
+22 tests passed
diff --git a/testsuite/tests/basic/tailcalls.ml b/testsuite/tests/basic/tailcalls.ml
new file mode 100644
index 00000000..32ac4744
--- /dev/null
+++ b/testsuite/tests/basic/tailcalls.ml
@@ -0,0 +1,43 @@
+(* TEST *)
+
+let rec tailcall4 a b c d =
+  if a < 0
+  then b
+  else tailcall4 (a-1) (b+1) (c+2) (d+3)
+
+let rec tailcall8 a b c d e f g h =
+  if a < 0
+  then b
+  else tailcall8 (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)
+
+let rec tailcall16 a b c d e f g h i j k l m n o p =
+  if a < 0
+  then b
+  else tailcall16 (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)
+                  (i+8) (j+9) (k+10) (l+11) (m+12) (n+13) (o+14) (p+15)
+
+let indtailcall8 fn a b c d e f g h =
+  fn a b c d e f g h
+
+let indtailcall16 fn a b c d e f g h i j k l m n o p =
+  fn a b c d e f g h i j k l m n o p
+
+(* regression test for PR#6441: *)
+let rec tailcall16_value_closures a b c d e f g h i j k l m n o p =
+  if a < 0
+  then b
+  else tailcall16_value_closures
+         (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)
+         (i+8) (j+9) (k+10) (l+11) (m+12) (n+13) (o+14) (p+15)
+and fs = [tailcall16_value_closures]
+
+let _ =
+  print_int (tailcall4 10000000 0 0 0); print_newline();
+  print_int (tailcall8 10000000 0 0 0 0 0 0 0); print_newline();
+  print_int (tailcall16 10000000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
+  print_newline();
+  print_int (indtailcall8 tailcall8 10 0 0 0 0 0 0 0); print_newline();
+  print_int (indtailcall16 tailcall16 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
+  print_newline();
+  print_int (tailcall16_value_closures 10000000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
+  print_newline()
diff --git a/testsuite/tests/basic/tailcalls.reference b/testsuite/tests/basic/tailcalls.reference
new file mode 100644
index 00000000..c7117bc9
--- /dev/null
+++ b/testsuite/tests/basic/tailcalls.reference
@@ -0,0 +1,6 @@
+10000001
+10000001
+10000001
+11
+11
+10000001
diff --git a/testsuite/tests/basic/trigraph.ml b/testsuite/tests/basic/trigraph.ml
new file mode 100644
index 00000000..871117fb
--- /dev/null
+++ b/testsuite/tests/basic/trigraph.ml
@@ -0,0 +1,5 @@
+(* TEST *)
+
+(* PR#6373 *)
+
+let () = print_string "??'"
diff --git a/testsuite/tests/basic/trigraph.reference b/testsuite/tests/basic/trigraph.reference
new file mode 100644
index 00000000..988082bf
--- /dev/null
+++ b/testsuite/tests/basic/trigraph.reference
@@ -0,0 +1 @@
+??'
\ No newline at end of file
diff --git a/testsuite/tests/basic/tuple_match.ml b/testsuite/tests/basic/tuple_match.ml
new file mode 100644
index 00000000..147a62a7
--- /dev/null
+++ b/testsuite/tests/basic/tuple_match.ml
@@ -0,0 +1,56 @@
+(* TEST *)
+
+let[@inline never] small_match n x =
+  let (left, right) = match x with
+    | 0 -> n, 42
+    | 1 -> 42, n
+    | _ -> assert false in
+  left - right
+
+let[@inline never] big_match n x =
+  let (left, right) = match x with
+    | 0 -> n, 42
+    | 1 -> 42, n
+    | 2 -> 42-n, 0
+    | 3 -> 0, 42-n
+    | 4 -> n/2, n/2
+    | 5 -> n, n
+    | _ -> assert false in
+  left - right
+
+let[@inline never] string_match n x =
+  let (left, right) = match x with
+    | "0" -> n, 42
+    | "1" -> 42, n
+    | "2" -> 42-n, 0
+    | "3" -> 0, 42-n
+    | "4" -> n/2, n/2
+    | "5" -> n, n
+    | _ -> assert false in
+  left - right
+
+
+
+
+let printf = Printf.printf
+
+let test f n i =
+  let mw_overhead =
+    let a = Gc.minor_words () in
+    let b = Gc.minor_words () in
+    b -. a in
+  let mw = Gc.minor_words () in
+  let k = f n i in
+  assert (k = 0);
+  let mw' = Gc.minor_words () in
+  let delta = int_of_float (mw' -. mw -. mw_overhead) in
+  printf "allocated %d words\n" delta
+
+let () =
+  let n = 42 in
+  printf "small_match:\n";
+  for i = 0 to 1 do test small_match n i done;
+  printf "big_match:\n";
+  for i = 0 to 5 do test big_match n i done;
+  printf "string_match:\n";
+  for i = 0 to 5 do test string_match n (string_of_int i) done
diff --git a/testsuite/tests/basic/tuple_match.reference b/testsuite/tests/basic/tuple_match.reference
new file mode 100644
index 00000000..fc2235d3
--- /dev/null
+++ b/testsuite/tests/basic/tuple_match.reference
@@ -0,0 +1,17 @@
+small_match:
+allocated 0 words
+allocated 0 words
+big_match:
+allocated 0 words
+allocated 0 words
+allocated 0 words
+allocated 0 words
+allocated 0 words
+allocated 0 words
+string_match:
+allocated 0 words
+allocated 0 words
+allocated 0 words
+allocated 0 words
+allocated 0 words
+allocated 0 words
diff --git a/testsuite/tests/basic/unit_naming.compilers.reference b/testsuite/tests/basic/unit_naming.compilers.reference
new file mode 100644
index 00000000..7a7a0898
--- /dev/null
+++ b/testsuite/tests/basic/unit_naming.compilers.reference
@@ -0,0 +1,4 @@
+File "unit_naming.ml", line 9, characters 10-25:
+9 | print_int Camlcase.answer
+              ^^^^^^^^^^^^^^^
+Error: Unbound module Camlcase
diff --git a/testsuite/tests/basic/unit_naming.ml b/testsuite/tests/basic/unit_naming.ml
new file mode 100644
index 00000000..6b7a65c2
--- /dev/null
+++ b/testsuite/tests/basic/unit_naming.ml
@@ -0,0 +1,9 @@
+(* TEST
+   modules = "camlCase.ml"
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+   ocamlc_byte_exit_status = "2"
+   *** check-ocamlc.byte-output
+*)
+
+print_int Camlcase.answer
diff --git a/testsuite/tests/basic/zero_divided_by_n.ml b/testsuite/tests/basic/zero_divided_by_n.ml
new file mode 100644
index 00000000..d977c897
--- /dev/null
+++ b/testsuite/tests/basic/zero_divided_by_n.ml
@@ -0,0 +1,19 @@
+(* TEST *)
+
+(* Mantis 7201 *)
+
+let f () = 0 [@@inline never]
+
+let () =
+  try
+    ignore ((0 / f ()) : int);
+    assert false
+  with Division_by_zero -> ()
+
+(* Not in Mantis 7201, but related: *)
+
+let () =
+  try
+    ignore ((0 mod f ()) : int);
+    assert false
+  with Division_by_zero -> ()
diff --git a/testsuite/tests/basic/zero_divided_by_n.reference b/testsuite/tests/basic/zero_divided_by_n.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/c-api/alloc_async.ml b/testsuite/tests/c-api/alloc_async.ml
new file mode 100644
index 00000000..0ed35acf
--- /dev/null
+++ b/testsuite/tests/c-api/alloc_async.ml
@@ -0,0 +1,17 @@
+(* TEST
+   modules = "alloc_async_stubs.c"
+*)
+
+external test : int ref -> unit = "stub"
+
+let f () =
+  let r = ref 42 in
+  Gc.finalise (fun s -> r := !s) (ref 17);
+  Printf.printf "OCaml, before: %d\n%!" !r;
+  test r;
+  Printf.printf "OCaml, after: %d\n%!" !r;
+  ignore (Sys.opaque_identity (ref 100));
+  Printf.printf "OCaml, after alloc: %d\n%!" !r;
+  ()
+
+let () = (f [@inlined never]) ()
diff --git a/testsuite/tests/c-api/alloc_async.reference b/testsuite/tests/c-api/alloc_async.reference
new file mode 100644
index 00000000..839271f5
--- /dev/null
+++ b/testsuite/tests/c-api/alloc_async.reference
@@ -0,0 +1,5 @@
+OCaml, before: 42
+C, before: 42
+C, after: 42
+OCaml, after: 42
+OCaml, after alloc: 17
diff --git a/testsuite/tests/c-api/alloc_async_stubs.c b/testsuite/tests/c-api/alloc_async_stubs.c
new file mode 100644
index 00000000..7dec51ea
--- /dev/null
+++ b/testsuite/tests/c-api/alloc_async_stubs.c
@@ -0,0 +1,54 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "caml/alloc.h"
+#include "caml/memory.h"
+
+const char* strs[] = { "foo", "bar", 0 };
+value stub(value ref)
+{
+  CAMLparam1(ref);
+  CAMLlocal2(x, y);
+  int i; char* s; intnat coll_before;
+
+  printf("C, before: %d\n", Int_val(Field(ref, 0)));
+
+  /* First, do enough major allocations to do a full major collection cycle */
+  coll_before = Caml_state_field(stat_major_collections);
+  while (Caml_state_field(stat_major_collections) <= coll_before+1) {
+    caml_alloc(10000, 0);
+  }
+
+  /* Now, call lots of allocation functions */
+
+  /* Small allocations */
+  caml_alloc(10, 0);
+  x = caml_alloc_small(2, 0);
+  Field(x, 0) = Val_unit;
+  Field(x, 1) = Val_unit;
+  caml_alloc_tuple(3);
+  caml_alloc_float_array(10);
+  caml_alloc_string(42);
+  caml_alloc_initialized_string(10, "abcdeabcde");
+  caml_copy_string("asoidjfa");
+  caml_copy_string_array(strs);
+  caml_copy_double(42.0);
+  caml_copy_int32(100);
+  caml_copy_int64(100);
+  caml_alloc_array(caml_copy_string, strs);
+  caml_alloc_sprintf("[%d]", 42);
+
+  /* Large allocations */
+  caml_alloc(1000, 0);
+  caml_alloc_shr(1000, 0);
+  caml_alloc_tuple(1000);
+  caml_alloc_float_array(1000);
+  caml_alloc_string(10000);
+  s = calloc(10000, 1);
+  caml_alloc_initialized_string(10000, s);
+  free(s);
+
+
+  printf("C, after: %d\n", Int_val(Field(ref, 0)));
+  fflush(stdout);
+  CAMLreturn (Val_unit);
+}
diff --git a/testsuite/tests/callback/callbackprim.c b/testsuite/tests/callback/callbackprim.c
new file mode 100644
index 00000000..45879a01
--- /dev/null
+++ b/testsuite/tests/callback/callbackprim.c
@@ -0,0 +1,69 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 1995 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+#include "caml/callback.h"
+
+value mycallback1(value fun, value arg)
+{
+  value res;
+  res = caml_callback(fun, arg);
+  return res;
+}
+
+value mycallback2(value fun, value arg1, value arg2)
+{
+  value res;
+  res = caml_callback2(fun, arg1, arg2);
+  return res;
+}
+
+value mycallback3(value fun, value arg1, value arg2, value arg3)
+{
+  value res;
+  res = caml_callback3(fun, arg1, arg2, arg3);
+  return res;
+}
+
+value mycallback4(value fun, value arg1, value arg2, value arg3, value arg4)
+{
+  value args[4];
+  value res;
+  args[0] = arg1;
+  args[1] = arg2;
+  args[2] = arg3;
+  args[3] = arg4;
+  res = caml_callbackN(fun, 4, args);
+  return res;
+}
+
+value mypushroot(value v, value fun, value arg)
+{
+  Begin_root(v)
+    caml_callback(fun, arg);
+  End_roots();
+  return v;
+}
+
+value mycamlparam (value v, value fun, value arg)
+{
+  CAMLparam3 (v, fun, arg);
+  CAMLlocal2 (x, y);
+  x = v;
+  y = caml_callback (fun, arg);
+  v = x;
+  CAMLreturn (v);
+}
diff --git a/testsuite/tests/callback/signals_alloc.ml b/testsuite/tests/callback/signals_alloc.ml
new file mode 100644
index 00000000..ae5f0d7f
--- /dev/null
+++ b/testsuite/tests/callback/signals_alloc.ml
@@ -0,0 +1,31 @@
+(* TEST
+   include unix
+   * libunix
+   ** bytecode
+   ** native
+*)
+
+let pid = Unix.getpid ()
+
+let do_test () =
+  let seen_states = Array.make 5 (-1) in
+  let pos = ref 0 in
+  let sighandler signo =
+    (* These two instructions are duplicated everywhere, but we cannot
+       encapsulate them in a function, because function calls check
+       for signals in bytecode mode. *)
+    seen_states.(!pos) <- 3; pos := !pos + 1;
+  in
+  seen_states.(!pos) <- 0; pos := !pos + 1;
+  Sys.set_signal Sys.sigusr1 (Sys.Signal_handle sighandler);
+  seen_states.(!pos) <- 1; pos := !pos + 1;
+  Unix.kill pid Sys.sigusr1;
+  seen_states.(!pos) <- 2; pos := !pos + 1;
+  let _ = Sys.opaque_identity (ref 1) in
+  seen_states.(!pos) <- 4; pos := !pos + 1;
+  Sys.set_signal Sys.sigusr1 Sys.Signal_default;
+  assert (seen_states = [|0;1;2;3;4|])
+
+let () =
+  for _ = 0 to 10 do do_test () done;
+  Printf.printf "OK\n"
diff --git a/testsuite/tests/callback/signals_alloc.reference b/testsuite/tests/callback/signals_alloc.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/callback/signals_alloc.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/callback/tcallback.ml b/testsuite/tests/callback/tcallback.ml
new file mode 100644
index 00000000..9e4e09f5
--- /dev/null
+++ b/testsuite/tests/callback/tcallback.ml
@@ -0,0 +1,79 @@
+(* TEST
+   include unix
+   modules = "callbackprim.c"
+   * libunix
+   ** bytecode
+   ** native
+*)
+
+(**************************************************************************)
+
+external mycallback1 : ('a -> 'b) -> 'a -> 'b = "mycallback1"
+external mycallback2 : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c = "mycallback2"
+external mycallback3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> 'd
+    = "mycallback3"
+external mycallback4 :
+    ('a -> 'b -> 'c -> 'd -> 'e) -> 'a -> 'b -> 'c -> 'd -> 'e = "mycallback4"
+
+let rec tak (x, y, z as _tuple) =
+  if x > y then tak(tak (x-1, y, z), tak (y-1, z, x), tak (z-1, x, y))
+           else z
+
+let tak2 x (y, z) = tak (x, y, z)
+
+let tak3 x y z = tak (x, y, z)
+
+let tak4 x y z u = tak (x, y, z + u)
+
+let raise_exit () = (raise Exit : unit)
+
+let trapexit () =
+  begin try
+    mycallback1 raise_exit ()
+  with Exit ->
+    ()
+  end;
+  tak (18, 12, 6)
+
+external mypushroot : 'a -> ('b -> 'c) -> 'b -> 'a = "mypushroot"
+external mycamlparam : 'a -> ('b -> 'c) -> 'b -> 'a = "mycamlparam"
+
+let tripwire f =
+  let s = String.make 5 'a' in
+  f s trapexit ()
+
+(* Test callbacks performed to handle signals *)
+
+let sighandler signo =
+(*
+  print_string "Got signal, triggering garbage collection...";
+  print_newline();
+*)
+  (* Thoroughly wipe the minor heap *)
+  ignore (tak (18, 12, 6))
+
+external unix_getpid : unit -> int = "unix_getpid" [@@noalloc]
+external unix_kill : int -> int -> unit = "unix_kill" [@@noalloc]
+
+let callbacksig () =
+  let pid = unix_getpid() in
+  (* Allocate a block in the minor heap *)
+  let s = String.make 5 'b' in
+  (* Send a signal to self.  We want s to remain in a register and
+     not be spilled on the stack, hence we declare unix_kill
+     [@@noalloc]. *)
+  unix_kill pid Sys.sigusr1;
+  (* Allocate some more so that the signal will be tested *)
+  let u = (s, s) in
+  fst u
+
+let _ =
+  print_int(mycallback1 tak (18, 12, 6)); print_newline();
+  print_int(mycallback2 tak2 18 (12, 6)); print_newline();
+  print_int(mycallback3 tak3 18 12 6); print_newline();
+  print_int(mycallback4 tak4 18 12 3 3); print_newline();
+  print_int(trapexit ()); print_newline();
+  print_string(tripwire mypushroot); print_newline();
+  print_string(tripwire mycamlparam); print_newline();
+  Sys.set_signal Sys.sigusr1 (Sys.Signal_handle sighandler);
+  print_string(callbacksig ()); print_newline()
diff --git a/testsuite/tests/callback/tcallback.reference b/testsuite/tests/callback/tcallback.reference
new file mode 100644
index 00000000..b35993aa
--- /dev/null
+++ b/testsuite/tests/callback/tcallback.reference
@@ -0,0 +1,8 @@
+7
+7
+7
+7
+7
+aaaaa
+aaaaa
+bbbbb
diff --git a/testsuite/tests/compatibility/main.ml b/testsuite/tests/compatibility/main.ml
new file mode 100644
index 00000000..c2e20712
--- /dev/null
+++ b/testsuite/tests/compatibility/main.ml
@@ -0,0 +1,16 @@
+(* TEST
+modules = "stub.c"
+* pass
+** bytecode
+** native
+* pass
+flags = "-ccopt -DCAML_NAME_SPACE"
+** bytecode
+** native
+*)
+
+external retrieve_young_limit : 'a -> nativeint = "retrieve_young_limit"
+
+let bar =
+  let foo = Bytes.create 4 in
+  retrieve_young_limit foo
diff --git a/testsuite/tests/compatibility/main.reference b/testsuite/tests/compatibility/main.reference
new file mode 100644
index 00000000..3e18d56d
--- /dev/null
+++ b/testsuite/tests/compatibility/main.reference
@@ -0,0 +1 @@
+v is young
diff --git a/testsuite/tests/compatibility/stub.c b/testsuite/tests/compatibility/stub.c
new file mode 100644
index 00000000..1bf4b4c8
--- /dev/null
+++ b/testsuite/tests/compatibility/stub.c
@@ -0,0 +1,20 @@
+#include <stdio.h>
+
+#include <caml/minor_gc.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/address_class.h>
+/* see PR#8892 */
+typedef char * addr;
+
+CAMLprim value retrieve_young_limit(value v)
+{
+  CAMLparam1(v);
+  printf("v is%s young\n", (Is_young(v) ? "" : " not"));
+#ifdef CAML_NAME_SPACE
+  CAMLreturn(caml_copy_nativeint((intnat)caml_young_limit));
+#else
+  CAMLreturn(copy_nativeint((intnat)young_limit));
+#endif
+}
diff --git a/testsuite/tests/compiler-libs/test_longident.ml b/testsuite/tests/compiler-libs/test_longident.ml
new file mode 100644
index 00000000..33bf09ff
--- /dev/null
+++ b/testsuite/tests/compiler-libs/test_longident.ml
@@ -0,0 +1,195 @@
+(* TEST
+   flags = "-I ${ocamlsrcdir}/parsing"
+   include ocamlcommon
+   * expect
+*)
+[@@@alert "-deprecated"]
+
+module L = Longident
+
+[%%expect {|
+module L = Longident
+|}]
+
+let flatten_ident = L.flatten (L.Lident "foo")
+[%%expect {|
+val flatten_ident : string list = ["foo"]
+|}]
+let flatten_dot = L.flatten (L.Ldot (L.Lident "M", "foo"))
+[%%expect {|
+val flatten_dot : string list = ["M"; "foo"]
+|}]
+let flatten_apply = L.flatten (L.Lapply (L.Lident "F", L.Lident "X"))
+[%%expect {|
+>> Fatal error: Longident.flat
+Exception: Misc.Fatal_error.
+|}]
+
+let unflatten_empty = L.unflatten []
+[%%expect {|
+val unflatten_empty : L.t option = None
+|}]
+let unflatten_sing = L.unflatten ["foo"]
+[%%expect {|
+val unflatten_sing : L.t option = Some (L.Lident "foo")
+|}]
+let unflatten_dot = L.unflatten ["M"; "N"; "foo"]
+[%%expect {|
+val unflatten_dot : L.t option =
+  Some (L.Ldot (L.Ldot (L.Lident "M", "N"), "foo"))
+|}]
+
+let last_ident = L.last (L.Lident "foo")
+[%%expect {|
+val last_ident : string = "foo"
+|}]
+let last_dot = L.last (L.Ldot (L.Lident "M", "foo"))
+[%%expect {|
+val last_dot : string = "foo"
+|}]
+let last_apply = L.last (L.Lapply (L.Lident "F", L.Lident "X"))
+[%%expect {|
+>> Fatal error: Longident.last
+Exception: Misc.Fatal_error.
+|}]
+let last_dot_apply = L.last
+    (L.Ldot (L.Lapply (L.Lident "F", L.Lident "X"), "foo"))
+[%%expect {|
+val last_dot_apply : string = "foo"
+|}];;
+
+type parse_result = { flat: L.t; spec:L.t; any_is_correct:bool }
+let test specialized s =
+  let spec = specialized (Lexing.from_string s) in
+  { flat = L.parse s;
+    spec;
+    any_is_correct = Parse.longident (Lexing.from_string s) = spec;
+  }
+
+let parse_empty = L.parse ""
+let parse_empty_val = Parse.longident (Lexing.from_string "")
+[%%expect {|
+type parse_result = { flat : L.t; spec : L.t; any_is_correct : bool; }
+val test : (Lexing.lexbuf -> L.t) -> string -> parse_result = <fun>
+val parse_empty : L.t = L.Lident ""
+Exception:
+Syntaxerr.Error
+ (Syntaxerr.Other
+   {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 = 0};
+    loc_ghost = false}).
+|}]
+let parse_ident = test Parse.val_ident "foo"
+[%%expect {|
+val parse_ident : parse_result =
+  {flat = L.Lident "foo"; spec = L.Lident "foo"; any_is_correct = true}
+|}]
+let parse_dot = test Parse.val_ident "M.foo"
+[%%expect {|
+val parse_dot : parse_result =
+  {flat = L.Ldot (L.Lident "M", "foo"); spec = L.Ldot (L.Lident "M", "foo");
+   any_is_correct = true}
+|}]
+let parse_path = test Parse.val_ident "M.N.foo"
+[%%expect {|
+val parse_path : parse_result =
+  {flat = L.Ldot (L.Ldot (L.Lident "M", "N"), "foo");
+   spec = L.Ldot (L.Ldot (L.Lident "M", "N"), "foo"); any_is_correct = true}
+|}]
+let parse_complex = test  Parse.type_ident "M.F(M.N).N.foo"
+(* the result below is a known misbehavior of Longident.parse
+   which does not handle applications properly. *)
+[%%expect {|
+val parse_complex : parse_result =
+  {flat =
+    L.Ldot (L.Ldot (L.Ldot (L.Ldot (L.Lident "M", "F(M"), "N)"), "N"), "foo");
+   spec =
+    L.Ldot
+     (L.Ldot
+       (L.Lapply (L.Ldot (L.Lident "M", "F"), L.Ldot (L.Lident "M", "N")),
+       "N"),
+     "foo");
+   any_is_correct = true}
+|}]
+
+let parse_op = test Parse.val_ident "M.(.%.()<-)"
+(* the result below is another known misbehavior of Longident.parse. *)
+[%%expect {|
+val parse_op : parse_result =
+  {flat = L.Ldot (L.Ldot (L.Ldot (L.Lident "M", "("), "%"), "()<-)");
+   spec = L.Ldot (L.Lident "M", ".%.()<-"); any_is_correct = true}
+|}]
+
+
+let parse_let_op = test Parse.val_ident "M.(let+*!)"
+[%%expect {|
+val parse_let_op : parse_result =
+  {flat = L.Ldot (L.Lident "M", "(let+*!)");
+   spec = L.Ldot (L.Lident "M", "let+*!"); any_is_correct = true}
+|}]
+
+let constr = test Parse.constr_ident "true"
+[%%expect{|
+val constr : parse_result =
+  {flat = L.Lident "true"; spec = L.Lident "true"; any_is_correct = true}
+|}]
+
+let prefix_constr = test Parse.constr_ident "A.B.C.(::)"
+[%%expect{|
+val prefix_constr : parse_result =
+  {flat = L.Ldot (L.Ldot (L.Ldot (L.Lident "A", "B"), "C"), "(::)");
+   spec = L.Ldot (L.Ldot (L.Ldot (L.Lident "A", "B"), "C"), "::");
+   any_is_correct = true}
+|}]
+
+
+
+let mod_ext = test Parse.extended_module_path "A.F(B.C(X)).G(Y).D"
+[%%expect{|
+val mod_ext : parse_result =
+  {flat =
+    L.Ldot (L.Ldot (L.Ldot (L.Ldot (L.Lident "A", "F(B"), "C(X))"), "G(Y)"),
+     "D");
+   spec =
+    L.Ldot
+     (L.Lapply
+       (L.Ldot
+         (L.Lapply (L.Ldot (L.Lident "A", "F"),
+           L.Lapply (L.Ldot (L.Lident "B", "C"), L.Lident "X")),
+         "G"),
+       L.Lident "Y"),
+     "D");
+   any_is_correct = true}
+|}]
+
+
+let string_of_longident lid = Format.asprintf "%a" Pprintast.longident lid
+[%%expect{|
+val string_of_longident : Longident.t -> string = <fun>
+|}]
+let str_empty   = string_of_longident parse_empty
+[%%expect {|
+val str_empty : string = ""
+|}]
+let str_ident   = string_of_longident parse_ident.flat
+[%%expect {|
+val str_ident : string = "foo"
+|}]
+let str_dot     = string_of_longident parse_dot.flat
+[%%expect {|
+val str_dot : string = "M.foo"
+|}]
+let str_path    = string_of_longident parse_path.flat
+[%%expect {|
+val str_path : string = "M.N.foo"
+|}]
+
+
+let str_complex = string_of_longident
+   (let (&.) p word = L.Ldot(p, word) in
+    L.Lapply(L.Lident "M" &. "F", L.Lident "M" &. "N") &. "N" &. "foo")
+[%%expect{|
+val str_complex : string = "M.F(M.N).N.foo"
+|}]
diff --git a/testsuite/tests/embedded/cmcaml.ml b/testsuite/tests/embedded/cmcaml.ml
new file mode 100644
index 00000000..005b489c
--- /dev/null
+++ b/testsuite/tests/embedded/cmcaml.ml
@@ -0,0 +1,20 @@
+(* TEST
+   modules = "cmstub.c cmmain.c"
+*)
+
+(* OCaml part of the code *)
+
+let rec fib n =
+  if n < 2 then 1 else fib(n-1) + fib(n-2)
+
+let format_result n =
+  let r = "Result = " ^ Int.to_string n in
+  (* Allocate gratuitously to test GC *)
+  for i = 1 to 1500 do ignore (Bytes.create 256) done;
+  r
+
+(* Registration *)
+
+let _ =
+  Callback.register "fib" fib;
+  Callback.register "format_result" format_result
diff --git a/testsuite/tests/embedded/cmcaml.reference b/testsuite/tests/embedded/cmcaml.reference
new file mode 100644
index 00000000..4f27810c
--- /dev/null
+++ b/testsuite/tests/embedded/cmcaml.reference
@@ -0,0 +1,4 @@
+Initializing OCaml code...
+Back in C code...
+Computing fib(20)...
+Result = 10946
diff --git a/testsuite/tests/embedded/cmmain.c b/testsuite/tests/embedded/cmmain.c
new file mode 100644
index 00000000..2fe048c1
--- /dev/null
+++ b/testsuite/tests/embedded/cmmain.c
@@ -0,0 +1,49 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1996 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License, with    */
+/*  the special exception on linking described in file ../LICENSE.     */
+/*                                                                     */
+/***********************************************************************/
+
+/* Main program -- in C */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <caml/callback.h>
+
+extern int fib(int n);
+extern char * format_result(int n);
+
+#ifdef _WIN32
+int wmain(int argc, wchar_t ** argv)
+#else
+int main(int argc, char ** argv)
+#endif
+{
+  printf("Initializing OCaml code...\n");
+
+  /* Initializing the runtime twice, to check that it's possible to
+     make nested calls to caml_startup/caml_shutdown. */
+#ifdef NO_BYTECODE_FILE
+  caml_startup(argv);
+  caml_startup(argv);
+#else
+  caml_main(argv);
+  caml_main(argv);
+#endif
+
+  printf("Back in C code...\n");
+  printf("Computing fib(20)...\n");
+  printf("%s\n", format_result(fib(20)));
+
+  caml_shutdown();
+  caml_shutdown();
+
+  return 0;
+}
diff --git a/testsuite/tests/embedded/cmstub.c b/testsuite/tests/embedded/cmstub.c
new file mode 100644
index 00000000..82599002
--- /dev/null
+++ b/testsuite/tests/embedded/cmstub.c
@@ -0,0 +1,30 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1996 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License, with    */
+/*  the special exception on linking described in file ../LICENSE.     */
+/*                                                                     */
+/***********************************************************************/
+
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/callback.h>
+
+/* Functions callable directly from C */
+
+int fib(int n)
+{
+  const value * fib_closure = caml_named_value("fib");
+  return Int_val(caml_callback(*fib_closure, Val_int(n)));
+}
+
+char * format_result(int n)
+{
+  const value * format_result_closure = caml_named_value("format_result");
+  return strdup(String_val(caml_callback(*format_result_closure, Val_int(n))));
+}
diff --git a/testsuite/tests/ephe-c-api/stubs.c b/testsuite/tests/ephe-c-api/stubs.c
new file mode 100644
index 00000000..2ea819f3
--- /dev/null
+++ b/testsuite/tests/ephe-c-api/stubs.c
@@ -0,0 +1,325 @@
+#include<stdio.h>
+#include "caml/alloc.h"
+#include "caml/memory.h"
+#include "caml/weak.h"
+
+/* C version of ephetest.ml */
+
+void is_true(const char* test, const char* s, int b) {
+  if(b) printf("%s %s: OK\n", test, s);
+  else printf("%s %s: FAIL\n", test, s);
+}
+
+void is_false(const char* test, const char* s, int b) {
+  is_true(test, s, !b);
+}
+
+void is_data_value(const char* test, value eph, intnat v) {
+  CAMLparam1(eph);
+  CAMLlocal1(x);
+
+  if(caml_ephemeron_get_data_copy(eph, &x))
+    if(Long_val(Field(x, 0)) == v) printf("%s data set: OK\n", test);
+    else printf("%s data set: FAIL(bad value %li)\n", test,
+                (long int)Long_val(Field(x, 0)));
+  else
+    printf("%s data set: FAIL\n", test);
+
+  CAMLreturn0;
+}
+
+void is_key_value(const char* test, value eph, intnat v) {
+  CAMLparam1(eph);
+  CAMLlocal1(x);
+
+  if(caml_ephemeron_get_key_copy(eph, 0, &x))
+    if(Long_val(Field(x, 0)) == v) printf("%s key set: OK\n", test);
+    else printf("%s key set: FAIL(bad value %li)\n", test,
+                (long int)Long_val(Field(x, 0)));
+  else
+    printf("%s key unset: FAIL\n", test);
+
+  CAMLreturn0;
+}
+
+void is_key_unset(const char* test, value eph) {
+  is_false(test, "key unset", caml_ephemeron_key_is_set(eph, 0));
+}
+
+void is_data_unset(const char* test, value eph) {
+  is_false(test, "data unset", caml_ephemeron_data_is_set(eph));
+}
+
+extern value caml_gc_minor(value);
+extern value caml_gc_full_major(value);
+
+CAMLprim value test1(value ra, value rb) {
+  CAMLparam2(ra, rb);
+  CAMLlocal1(eph);
+  value x;
+
+  const char* test = "test1";
+  caml_gc_minor(Val_unit);
+  caml_gc_full_major(Val_unit);
+  eph = caml_ephemeron_create(1);
+  caml_ephemeron_set_key(eph, 0, Field(ra, 0));
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = Val_long(42);
+  caml_ephemeron_set_data(eph, x);
+  is_key_value(test, eph, 1);
+  is_data_value(test, eph, 42);
+  caml_gc_minor(Val_unit);
+  is_key_value(test, eph, 1);
+  is_data_value(test, eph, 42);
+  caml_gc_full_major(Val_unit);
+  is_key_value(test, eph, 1);
+  is_data_value(test, eph, 42);
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = Val_long(12);
+  caml_modify(&Field(ra, 0), x);
+  caml_gc_full_major(Val_unit);
+  is_key_unset(test, eph);
+  is_data_unset(test, eph);
+
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value test2(value ra, value rb) {
+  CAMLparam2(ra, rb);
+  CAMLlocal1(eph);
+  value x;
+
+  const char* test = "test2";
+  caml_gc_minor(Val_unit);
+  caml_gc_full_major(Val_unit);
+  eph = caml_ephemeron_create(1);
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = Val_long(125);
+  caml_ephemeron_set_key(eph, 0, x);
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = Val_long(42);
+  caml_ephemeron_set_data(eph, x);
+  is_key_value(test, eph, 125);
+  is_data_value(test, eph, 42);
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = Val_long(13);
+  caml_modify(&Field(ra, 0), x);
+  caml_gc_minor(Val_unit);
+  is_key_unset(test, eph);
+  is_data_unset(test, eph);
+
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value test3(value ra, value rb) {
+  CAMLparam2(ra, rb);
+  CAMLlocal1(eph);
+  value x;
+
+  const char* test = "test3";
+  caml_gc_minor(Val_unit);
+  caml_gc_full_major(Val_unit);
+  eph = caml_ephemeron_create(1);
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = Val_long(125);
+  caml_ephemeron_set_key(eph, 0, x);
+  caml_ephemeron_set_data(eph, Field(ra, 0));
+  is_key_value(test, eph, 125);
+  is_data_value(test, eph, 13);
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = Val_long(14);
+  caml_modify(&Field(ra, 0), x);
+  caml_gc_minor(Val_unit);
+  is_key_unset(test, eph);
+  is_data_unset(test, eph);
+
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value test4(value ra, value rb) {
+  CAMLparam2(ra, rb);
+  CAMLlocal2(eph, y);
+  value x;
+
+  const char* test = "test4";
+  caml_gc_minor(Val_unit);
+  caml_gc_full_major(Val_unit);
+  eph = caml_ephemeron_create(1);
+  y = caml_alloc(1, 0);
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = y;
+  caml_modify(&Field(y, 0), Val_long(3));
+  caml_modify(&Field(rb, 0), x);
+  y = Val_unit;
+  caml_ephemeron_set_key(eph, 0, Field(Field(rb, 0), 0));
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = Val_long(43);
+  caml_ephemeron_set_data(eph, x);
+  is_key_value(test, eph, 3);
+  is_data_value(test, eph, 43);
+  caml_gc_minor(Val_unit);
+  caml_gc_minor(Val_unit);
+  is_key_value(test, eph, 3);
+  is_data_value(test, eph, 43);
+
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value test5(value ra, value rb) {
+  CAMLparam2(ra, rb);
+  CAMLlocal2(eph, y);
+  value x;
+
+  const char* test = "test5";
+  caml_gc_minor(Val_unit);
+  caml_gc_full_major(Val_unit);
+  eph = caml_ephemeron_create(1);
+  y = caml_alloc(1, 0);
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = y;
+  caml_modify(&Field(y, 0), Val_long(3));
+  caml_modify(&Field(rb, 0), x);
+  y = Val_unit;
+  caml_ephemeron_set_key(eph, 0, Field(Field(rb, 0), 0));
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = Val_long(43);
+  caml_ephemeron_set_data(eph, x);
+  is_key_value(test, eph, 3);
+  is_data_value(test, eph, 43);
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = Val_long(4);
+  caml_modify(&Field(rb, 0), x);
+  caml_gc_minor(Val_unit);
+  caml_gc_minor(Val_unit);
+  is_key_unset(test, eph);
+  is_data_unset(test, eph);
+
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value test6(value ra, value rb) {
+  CAMLparam2(ra, rb);
+  CAMLlocal2(eph, y);
+  value x;
+
+  const char* test = "test6";
+  caml_gc_minor(Val_unit);
+  caml_gc_full_major(Val_unit);
+  eph = caml_ephemeron_create(1);
+  y = caml_alloc(1, 0);
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = y;
+  caml_modify(&Field(y, 0), Val_long(3));
+  caml_modify(&Field(rb, 0), x);
+  y = Val_unit;
+  caml_ephemeron_set_key(eph, 0, Field(Field(rb, 0), 0));
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = Field(Field(rb, 0), 0);
+  caml_ephemeron_set_data(eph, x);
+  caml_gc_minor(Val_unit);
+  is_key_value(test, eph, 3);
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = Val_long(4);
+  caml_modify(&Field(rb, 0), x);
+  caml_gc_full_major(Val_unit);
+  is_key_unset(test, eph);
+  is_data_unset(test, eph);
+
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value test7(value ra, value rb) {
+  CAMLparam2(ra, rb);
+  CAMLlocal4(eph, weak, y, rc);
+  value x;
+
+  const char* test = "test7";
+  caml_gc_minor(Val_unit);
+  caml_gc_full_major(Val_unit);
+  x = caml_alloc_small(1, 0);
+  Field(x, 0) = Val_long(42);
+  caml_modify(&Field(ra, 0), x);
+  weak = caml_weak_array_create(1);
+  y = caml_ephemeron_create(1);
+  eph = caml_alloc_small(1, 0);
+  Field(eph, 0) = y;
+  y = Val_unit;
+  rc = caml_alloc_small(1, 0);
+  Field(rc, 0) = Field(eph, 0);
+  caml_weak_array_set(weak, 0, Field(rc, 0));
+  caml_ephemeron_set_key(Field(eph, 0), 0, Field(ra, 0));
+  caml_ephemeron_set_data(Field(eph, 0), Field(rc, 0));
+  caml_gc_minor(Val_unit);
+  is_true(test, "before", caml_weak_array_check(weak, 0));
+  caml_modify(&Field(eph, 0), caml_ephemeron_create(1));
+  caml_modify(&Field(rc, 0), Val_unit);
+  caml_gc_full_major(Val_unit);
+  caml_gc_full_major(Val_unit);
+  caml_gc_full_major(Val_unit);
+  is_false(test, "after", caml_weak_array_check(weak, 0));
+
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value test8(value ra, value rb) {
+  CAMLparam2(ra, rb);
+  CAMLlocal3(x, y, z);
+
+  const char* test = "test8";
+
+  x = caml_ephemeron_create(15);
+  z = caml_ephemeron_create(3);
+  is_true(test, "eph length=15", caml_ephemeron_num_keys(x) == 15);
+  is_true(test, "eph length=3", caml_ephemeron_num_keys(z) == 3);
+
+  is_false(test, "eph get empty nonull", caml_ephemeron_get_key(x, 5, &y));
+  is_false(test, "eph get copy empty nonnull", caml_ephemeron_get_key_copy(x, 5, &y));
+  caml_ephemeron_set_key(x, 5, ra);
+  is_true(test, "eph get nonull", caml_ephemeron_get_key(x, 5, &y));
+  is_true(test, "eph get eq", y == ra);
+  is_true(test, "eph get copy nonnull", caml_ephemeron_get_key_copy(x, 5, &y));
+  is_true(test, "eph get copy eq", y != ra);
+  caml_ephemeron_blit_key(x, 4, z, 0, 3);
+  caml_ephemeron_unset_key(x, 5);
+  is_false(test, "eph get unset nonull", caml_ephemeron_get_key(x, 5, &y));
+  is_false(test, "eph get copy unset nonnull", caml_ephemeron_get_key_copy(x, 5, &y));
+  is_true(test, "eph get nonull z", caml_ephemeron_get_key(z, 1, &y));
+  is_true(test, "eph get eq z", y == ra);
+  is_false(test, "eph get empty z", caml_ephemeron_get_key(z, 0, &y));
+
+  is_false(test, "eph get data empty nonull", caml_ephemeron_get_data(x, &y));
+  is_false(test, "eph get data copy empty nonnull", caml_ephemeron_get_data_copy(x, &y));
+  caml_ephemeron_set_data(x, ra);
+  is_true(test, "eph get data nonull", caml_ephemeron_get_data(x, &y));
+  is_true(test, "eph get data eq", y == ra);
+  is_true(test, "eph get data copy nonnull", caml_ephemeron_get_data_copy(x, &y));
+  is_true(test, "eph get data copy eq", y != ra);
+  caml_ephemeron_blit_data(x, z);
+  caml_ephemeron_unset_data(x);
+  is_false(test, "eph get data unset nonull", caml_ephemeron_get_data(x, &y));
+  is_false(test, "eph get data copy unset nonnull", caml_ephemeron_get_data_copy(x, &y));
+  is_true(test, "eph get nonull z", caml_ephemeron_get_data(z, &y));
+  is_true(test, "eph get eq z", y == ra);
+
+  x = caml_weak_array_create(15);
+  z = caml_weak_array_create(3);
+  is_true(test, "eph length=15", caml_weak_array_length(x) == 15);
+  is_true(test, "eph length=3", caml_weak_array_length(z) == 3);
+
+  is_false(test, "eph get empty nonull", caml_weak_array_get(x, 5, &y));
+  is_false(test, "eph get copy empty nonnull", caml_weak_array_get_copy(x, 5, &y));
+  caml_weak_array_set(x, 5, ra);
+  is_true(test, "eph get nonull", caml_weak_array_get(x, 5, &y));
+  is_true(test, "eph get eq", y == ra);
+  is_true(test, "eph get copy nonnull", caml_weak_array_get_copy(x, 5, &y));
+  is_true(test, "eph get copy eq", y != ra);
+  caml_weak_array_blit(x, 4, z, 0, 3);
+  caml_weak_array_unset(x, 5);
+  is_false(test, "eph get unset nonull", caml_weak_array_get(x, 5, &y));
+  is_false(test, "eph get copy unset nonnull", caml_weak_array_get_copy(x, 5, &y));
+  is_true(test, "eph get nonull z", caml_weak_array_get(z, 1, &y));
+  is_true(test, "eph get eq z", y == ra);
+  is_false(test, "eph get empty z", caml_weak_array_get(z, 0, &y));
+
+  CAMLreturn(Val_unit);
+}
diff --git a/testsuite/tests/ephe-c-api/test.ml b/testsuite/tests/ephe-c-api/test.ml
new file mode 100644
index 00000000..a29cd851
--- /dev/null
+++ b/testsuite/tests/ephe-c-api/test.ml
@@ -0,0 +1,24 @@
+(* TEST
+   modules = "stubs.c"
+*)
+
+(* C version of ephetest.ml *)
+
+let make_ra () = ref (ref 1) [@@inline never]
+let make_rb () = ref (ref (ref 2)) [@@inline never]
+
+let ra = make_ra ()
+let rb = make_rb ()
+
+external test1 : int ref ref -> int ref ref ref -> unit = "test1"
+external test2 : int ref ref -> int ref ref ref -> unit = "test2"
+external test3 : int ref ref -> int ref ref ref -> unit = "test3"
+external test4 : int ref ref -> int ref ref ref -> unit = "test4"
+external test5 : int ref ref -> int ref ref ref -> unit = "test5"
+external test6 : int ref ref -> int ref ref ref -> unit = "test6"
+external test7 : int ref ref -> int ref ref ref -> unit = "test7"
+external test8 : int ref ref -> int ref ref ref -> unit = "test8"
+
+let () =
+  test1 ra rb;  test2 ra rb;  test3 ra rb;  test4 ra rb;  test5 ra rb;
+  test6 ra rb;  test7 ra rb; test8 ra rb
diff --git a/testsuite/tests/ephe-c-api/test.reference b/testsuite/tests/ephe-c-api/test.reference
new file mode 100644
index 00000000..6afb35a6
--- /dev/null
+++ b/testsuite/tests/ephe-c-api/test.reference
@@ -0,0 +1,65 @@
+test1 key set: OK
+test1 data set: OK
+test1 key set: OK
+test1 data set: OK
+test1 key set: OK
+test1 data set: OK
+test1 key unset: OK
+test1 data unset: OK
+test2 key set: OK
+test2 data set: OK
+test2 key unset: OK
+test2 data unset: OK
+test3 key set: OK
+test3 data set: OK
+test3 key unset: OK
+test3 data unset: OK
+test4 key set: OK
+test4 data set: OK
+test4 key set: OK
+test4 data set: OK
+test5 key set: OK
+test5 data set: OK
+test5 key unset: OK
+test5 data unset: OK
+test6 key set: OK
+test6 key unset: OK
+test6 data unset: OK
+test7 before: OK
+test7 after: OK
+test8 eph length=15: OK
+test8 eph length=3: OK
+test8 eph get empty nonull: OK
+test8 eph get copy empty nonnull: OK
+test8 eph get nonull: OK
+test8 eph get eq: OK
+test8 eph get copy nonnull: OK
+test8 eph get copy eq: OK
+test8 eph get unset nonull: OK
+test8 eph get copy unset nonnull: OK
+test8 eph get nonull z: OK
+test8 eph get eq z: OK
+test8 eph get empty z: OK
+test8 eph get data empty nonull: OK
+test8 eph get data copy empty nonnull: OK
+test8 eph get data nonull: OK
+test8 eph get data eq: OK
+test8 eph get data copy nonnull: OK
+test8 eph get data copy eq: OK
+test8 eph get data unset nonull: OK
+test8 eph get data copy unset nonnull: OK
+test8 eph get nonull z: OK
+test8 eph get eq z: OK
+test8 eph length=15: OK
+test8 eph length=3: OK
+test8 eph get empty nonull: OK
+test8 eph get copy empty nonnull: OK
+test8 eph get nonull: OK
+test8 eph get eq: OK
+test8 eph get copy nonnull: OK
+test8 eph get copy eq: OK
+test8 eph get unset nonull: OK
+test8 eph get copy unset nonnull: OK
+test8 eph get nonull z: OK
+test8 eph get eq z: OK
+test8 eph get empty z: OK
diff --git a/testsuite/tests/exotic-syntax/exotic.ml b/testsuite/tests/exotic-syntax/exotic.ml
new file mode 100644
index 00000000..94666e7f
--- /dev/null
+++ b/testsuite/tests/exotic-syntax/exotic.ml
@@ -0,0 +1,162 @@
+(* TEST
+*)
+
+(* Exotic OCaml syntax constructs found in the manual that are not *)
+(* used in the source of the OCaml distribution (even in the tests). *)
+
+(* Spaces between the parts of the ?label: token in a typexpr.
+   (used in bin-prot) *)
+type t1 = ? label : int -> int -> int;;
+
+(* Lazy in a pattern. (used in advi) *)
+function lazy y -> y;;
+
+(* Spaces between the parts of the ?label: token in a class-type. *)
+class c1 =
+  (fun ?label:x y -> object end : ? label : int -> int -> object end)
+;;
+
+(* type-class annotation in class-expr *)
+class c2 = (object end : object end);;
+
+(* virtual object field *)
+class virtual c3 = object val virtual x : int end;;
+class virtual c4 = object val mutable virtual x : int end;;
+
+(* abstract module type in a signature *)
+module type T = sig
+  module type U
+end;;
+
+(* associativity rules for patterns *)
+function Some Some x -> x | _ -> 0;;
+function Some `Tag x -> x | _ -> 0;;
+function `Tag Some x -> x | _ -> 0;;
+function `Tag `Tag x -> x | _ -> 0;;
+
+(* negative int32, int64, nativeint constants in patterns *)
+function -1l -> () | _ -> ();;
+function -1L -> () | _ -> ();;
+function -1n -> () | _ -> ();;
+
+(* surprising places where you can use an operator as a variable name *)
+function (+) -> (+);;
+function _ as (+) -> (+);;
+for (+) = 0 to 1 do () done;;
+
+(* access a class-type through an extended-module-path *)
+module F (X : sig end) = struct
+  class type t = object end
+end;;
+module M1 = struct end;;
+class type u = F(M1).t;;
+
+(* conjunctive constraints on tags (used by the compiler to print some
+   inferred types) *)
+type 'a t2 = [< `A of int & int & int ] as 'a;;
+
+(* same for a parameterless tag (triggers a very strange error message) *)
+(*type ('a, 'b) t3 = [< `A of & 'b ] as 'a;;*)
+
+(* negative float constant in a pattern *)
+function -1.0 -> 1 | _ -> 2;;
+
+(* combining language extensions (sec. 7.13 and 7.17) *)
+class c5 = object method f = 1 end;;
+object
+  inherit c5
+  method! f : type t . int = 2
+end;;
+
+(* private polymorphic method with local type *)
+object method private f : type t . int = 1 end;;
+
+(* type annotations on record fields, both in patterns and expressions, and both
+   with and without punning *)
+let get_int { contents : int } = contents
+let get_int2 { contents : int = c } = c
+let set_int contents = { contents : int }
+let set_int2 c = { contents : int = c }
+;;
+
+(* applying a functor to the unpacking of a first-class module *)
+module M() = struct
+  module type String = module type of String
+  let string = (module String : String)
+  module M = Set.Make(val string)
+end ;;
+
+(* More exotic: not even found in the manual (up to version 4.00),
+   but used in some programs found in the wild.
+*)
+
+(* local functor *)
+let module M (M1 : sig end) = struct end in ();;
+
+(* let-binding with a type coercion *)
+let x :> int = 1;;
+let x : int :> int = 1;;
+
+(* "begin end" as an alias for "()" *)
+begin end;;
+
+(* putting "virtual" before "mutable" or "private" *)
+class type virtual ct = object
+  val mutable virtual x : int
+  val virtual mutable y : int
+  method private virtual f : int
+  method virtual private g : int
+end;;
+class virtual c = object
+  val mutable virtual x : int
+  val virtual mutable y : int
+  method private virtual f : int
+  method virtual private g : int
+end;;
+
+(* Double-semicolon at the beginning of a module body [ocp-indent] *)
+module M2 = struct ;; end;;
+
+
+(**********************
+
+(* Most exotic: not found in the manual (up to 4.00) and not used
+   deliberately by anyone, but still implemented by the compiler. *)
+
+(* whitespace inside val!, method!, inherit! [found in ocamlspot] *)
+object
+  val x = 1
+  val ! x = 2
+  method m = 1
+  method ! m = 2
+  inherit ! object val x = 3 end
+end;;
+
+(* Using () as a constructor name [found in gettext] *)
+type t = ();;
+let x : t = ();;
+
+(* Using :: as a constructor name *)
+type t = :: of int * int;;
+
+(* Prefix syntax for :: in expressions *)
+(::) (1, 1);;
+
+(* Prefix syntax for :: in patterns *)
+function (::) (_, _) -> 1;;
+
+(* Unary plus in expressions (ints and float) *)
++1;;
++1l;;
++1L;;
++1n;;
++1.0;;
+
+(* Unary plus in patterns (ints and floats) *)
+function +1 -> ();;
+function +1l -> ();;
+function +1L -> ();;
+function +1n -> ();;
+function +1.0 -> ();;
+
+**********************)
diff --git a/testsuite/tests/exotic-syntax/exotic.reference b/testsuite/tests/exotic-syntax/exotic.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/extension-constructor/test.ml b/testsuite/tests/extension-constructor/test.ml
new file mode 100644
index 00000000..227f420a
--- /dev/null
+++ b/testsuite/tests/extension-constructor/test.ml
@@ -0,0 +1,24 @@
+(* TEST
+*)
+
+type t = ..
+
+module M = struct
+  type t += A
+  type t += B of int
+end
+
+type t += C
+type t += D of int * string
+
+let () =
+  assert (Obj.Extension_constructor.of_val  M.A
+          == [%extension_constructor M.A]);
+  assert (Obj.Extension_constructor.of_val (M.B 42)
+          == [%extension_constructor M.B]);
+  assert (Obj.Extension_constructor.of_val  C
+          == [%extension_constructor C]);
+  assert (Obj.Extension_constructor.of_val (D (42, ""))
+          == [%extension_constructor D])
+
+let () = print_endline "OK"
diff --git a/testsuite/tests/extension-constructor/test.reference b/testsuite/tests/extension-constructor/test.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/extension-constructor/test.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/flambda/approx_meet.ml b/testsuite/tests/flambda/approx_meet.ml
new file mode 100644
index 00000000..c8a12769
--- /dev/null
+++ b/testsuite/tests/flambda/approx_meet.ml
@@ -0,0 +1,15 @@
+(* TEST
+   * flambda
+   * native
+*)
+
+(* from GPR#1794 *)
+
+let z =
+  let x = -0. and y = +0. in
+  if mod_float x 1. >= 0. then
+    x
+  else if false then x else y
+
+let () =
+  Printf.printf "%g\n" (1. /. z)
diff --git a/testsuite/tests/flambda/approx_meet.reference b/testsuite/tests/flambda/approx_meet.reference
new file mode 100644
index 00000000..ebd26be4
--- /dev/null
+++ b/testsuite/tests/flambda/approx_meet.reference
@@ -0,0 +1 @@
+-inf
diff --git a/testsuite/tests/flambda/gpr2239.ml b/testsuite/tests/flambda/gpr2239.ml
new file mode 100644
index 00000000..22c6555e
--- /dev/null
+++ b/testsuite/tests/flambda/gpr2239.ml
@@ -0,0 +1,16 @@
+(* TEST
+   * flambda
+   * native
+*)
+
+let do_something () =
+  Printf.printf "Hello world\n%!"; Ok ()
+[@@inline never]
+
+let f x =
+  match do_something () with
+  | Ok () -> x
+  | Error r -> let _ = !r in x
+[@@inline never]
+
+let () = f ()
diff --git a/testsuite/tests/flambda/gpr2239.reference b/testsuite/tests/flambda/gpr2239.reference
new file mode 100644
index 00000000..802992c4
--- /dev/null
+++ b/testsuite/tests/flambda/gpr2239.reference
@@ -0,0 +1 @@
+Hello world
diff --git a/testsuite/tests/flambda/gpr998.ml b/testsuite/tests/flambda/gpr998.ml
new file mode 100644
index 00000000..dfb06833
--- /dev/null
+++ b/testsuite/tests/flambda/gpr998.ml
@@ -0,0 +1,43 @@
+(* TEST
+   ocamlopt_flags = "-unbox-closures"
+*)
+
+(* This test attempts to check that unused closures are not deleted
+   during conversion from flambda to clambda. The idea is that there is
+   a direct call to [foo] in [bar] even though the closure for [foo] is
+   not used. This requires [bar] to be have a specialised parameter that
+   would be [foo]'s closure were there any calls to [bar], and for [bar]
+   to not be deleted even though there are no calls to it. Creating such
+   a situation is difficult, and the fact that the following code does so
+   is very fragile. This means two things:
+
+     1. This code only tests the appropriate property on amd64
+        architectures. Since the code conversion from flambda to
+        clambda is architecture independent, this should be fine
+        as long as the test is run on such an architecture as part
+        of CI.
+
+    2. It is likely that future changes to flambda will silently cause
+       this test to stop testing the desired property. It would be worth
+       periodically examining the flambda output for the code to check
+       that this test is still worth using.
+*)
+
+let main x =
+  let[@inline never] inner () =
+    let[@inline never] foo y () () () () () () () = x + y in
+    let x1, x2, x3 = x + 1, x + 2, x + 3 in
+    let bar p y () () () =
+      if p then foo y () () () () () () ()
+      else x1 + x2 + x3
+    in
+    let[@inline never] baz0 y () () () () () () () =
+      let y1 = y + 1 in
+      let[@inline never] baz1 () () () () () =
+        bar false y1 () () ()
+      in
+      baz1 () () () () ()
+    in
+    baz0 1 () () () () () () ()
+  in
+  inner ()
diff --git a/testsuite/tests/flambda/gpr998.reference b/testsuite/tests/flambda/gpr998.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/flambda/specialise.ml b/testsuite/tests/flambda/specialise.ml
new file mode 100644
index 00000000..b5e80c7b
--- /dev/null
+++ b/testsuite/tests/flambda/specialise.ml
@@ -0,0 +1,59 @@
+(* TEST
+   * flambda
+   ** native
+   ocamlopt_flags = "-O2 -inline-call-cost 1=20 -unbox-closures"
+*)
+
+let hide_until_round_2 init_in_hide f_in_hide =
+  let x1_in_hide =
+    match init_in_hide with
+    | 0 -> true
+    | _ -> false
+  in
+  ignore (Sys.opaque_identity x1_in_hide);
+  let x2_in_hide =
+    match init_in_hide with
+    | 0 -> true
+    | _ -> false
+  in
+  ignore (Sys.opaque_identity x2_in_hide);
+  f_in_hide
+
+let foo bar init a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 =
+  let f_outer =
+    let baz = bar + 1 in
+    let rec f_inner x_in_f y_in_f b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 =
+      let dec =
+        b1 + b2 + b3 + b4 + b5 + b6 + b7 + b8 + b9 + b10 + b11 + b12 + b13
+      in
+      match x_in_f with
+      | Some _ -> g_inner x_in_f (y_in_f - dec)
+      | None   -> g_inner x_in_f (y_in_f - 2)
+    and g_inner x_in_g y_in_g =
+      let a1  = baz + 1 in
+      let a2  = a1  + 1 in
+      let a3  = a2  + 1 in
+      let a4  = a3  + 1 in
+      let a5  = a4  + 1 in
+      let a6  = a5  + 1 in
+      let a7  = a6  + 1 in
+      let a8  = a7  + 1 in
+      let a9  = a8  + 1 in
+      let a10 = a9  + 1 in
+      let a11 = a10 + 1 in
+      let a12 = a11 + 1 in
+      let a13 = a12 + 1 in
+      match x_in_g with
+      | Some _ ->
+          f_inner x_in_g (y_in_g - baz)
+                  a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13
+      | None   ->
+          f_inner x_in_g (y_in_g - baz)
+                  a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13
+    in
+    f_inner
+  in
+  let s = Some init in
+  let f_through_hide = hide_until_round_2 init f_outer in
+  (f_through_hide [@specialised])
+    s 10 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13
diff --git a/testsuite/tests/flambda/specialise.reference b/testsuite/tests/flambda/specialise.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/float-unboxing/float_subst_boxed_number.ml b/testsuite/tests/float-unboxing/float_subst_boxed_number.ml
new file mode 100644
index 00000000..4ca01612
--- /dev/null
+++ b/testsuite/tests/float-unboxing/float_subst_boxed_number.ml
@@ -0,0 +1,187 @@
+(* TEST
+   include config
+   flags = "-w -55"
+   ocamlc_flags = "config.cmo"
+   ocamlopt_flags = "-inline 20 config.cmx"
+   * native
+     compare_programs = "false"
+*)
+
+let eliminate_intermediate_float_record () =
+  let r = ref 0. in
+  for n = 1 to 1000 do
+    let open Complex in
+    let c = { re = float n; im = 0. } in
+    (* The following line triggers warning 55 twice when compiled without
+       flambda. It would be better to disable this warning just here but since
+       this is a backend-warning, this is not currently possible. Hence the use
+       of the -w-55 command-line flag for this test *)
+    r := !r +. (norm [@inlined]) ((add [@inlined]) c i);
+  done;
+  ignore (Sys.opaque_identity !r)
+
+module PR_6686 = struct
+  type t =
+   | A of float
+   | B of (int * int)
+
+  let rec foo = function
+   | A x -> x
+   | B (x, y) -> float x +. float y
+
+  let (_ : float) = foo (A 4.)
+end
+
+module PR_6770 = struct
+  type t =
+  | Constant of float
+  | Exponent of (float * float)
+
+  let to_string = function
+    | Exponent (_b, _e) ->
+      ignore _b;
+      ignore _e;
+      ""
+    | Constant _ -> ""
+
+  let _ = to_string (Constant 4.)
+end
+
+
+let check_noalloc name f =
+  let a0 = Gc.allocated_bytes () in
+  let a1 = Gc.allocated_bytes () in
+  let _x = f () in
+  let a2 = Gc.allocated_bytes () in
+  let alloc = (a2 -. 2. *. a1 +. a0) in
+
+  match Sys.backend_type with
+  | Sys.Bytecode -> ()
+  | Sys.Native ->
+      if alloc > 100. then
+        failwith (Printf.sprintf "%s; alloc = %.0f" name alloc)
+  | _ -> assert false
+
+module GPR_109 = struct
+
+  let f () =
+    let r = ref 0. in
+    for i = 1 to 1000 do
+      let x = float i in
+      let y = if i mod 2 = 0 then x else x +. 1. in
+      r := !r +. y
+    done;
+    !r
+
+  let () = check_noalloc "gpr 1O9" f
+end
+
+
+let unbox_classify_float () =
+  let x = ref 100. in
+  for i = 1 to 1000 do
+    assert (classify_float !x = FP_normal);
+    x := !x +. 1.
+  done;
+  ignore (Sys.opaque_identity !x)
+
+let unbox_compare_float () =
+  let module M = struct type sf = { mutable x: float; y: float; } end in
+  let x = { M.x=100. ; y=1. } in
+  for i = 1 to 1000 do
+    assert (compare x.M.x x.M.y >= 0);
+    x.M.x <- x.M.x +. 1.
+  done;
+  ignore (Sys.opaque_identity x.M.x)
+
+let unbox_float_refs () =
+  let r = ref nan in
+  for i = 1 to 1000 do r := !r +. float i done;
+  ignore (Sys.opaque_identity !r)
+
+let unbox_let_float () =
+  let r = ref 0. in
+  for i = 1 to 1000 do
+    let y =
+      if i mod 2 = 0 then nan else float i
+    in
+    r := !r +. (y *. 2.)
+  done;
+  ignore (Sys.opaque_identity !r)
+
+type block =
+  { mutable float : float;
+    mutable int32 : int32 }
+
+let make_some_block record =
+  { record with int32 = record.int32 }
+
+let unbox_record_1 record =
+  (* There is some let lifting problem to handle that case with one
+     round, this currently requires 2 rounds to be correctly
+     recognized as a mutable variable pattern *)
+  (* let block = (make_some_block [@inlined]) record in *)
+  let block = { record with int32 = record.int32 } in
+  for i = 1 to 1000 do
+    let y_float =
+      if i mod 2 = 0 then nan else Stdlib.float i
+    in
+    block.float <- block.float +. (y_float *. 2.);
+    let y_int32 =
+      if i mod 2 = 0 then Int32.max_int else Int32.of_int i
+    in
+    block.int32 <- Int32.(add block.int32 (mul y_int32 2l))
+  done;
+  ignore (Sys.opaque_identity block.float);
+  ignore (Sys.opaque_identity block.int32)
+  [@@inline never]
+  (* Prevent inlining to test that the type is effectively used *)
+
+let float_int32_record = { float = 3.14; int32 = 12l }
+
+let unbox_record () =
+  unbox_record_1 float_int32_record
+
+let r = ref 0.
+
+let unbox_only_if_useful () =
+  for i = 1 to 1000 do
+    let x =
+      if i mod 2 = 0 then 1.
+      else 0.
+    in
+    r := x; (* would force boxing if the let binding above were unboxed *)
+    r := x  (* use [x] twice to avoid elimination of the let-binding *)
+  done;
+  ignore (Sys.opaque_identity !r)
+
+let unbox_minor_words () =
+  for i = 1 to 1000 do
+    ignore (Gc.minor_words () = 0.)
+  done
+
+let ignore_useless_args () =
+  let f x _y = int_of_float (cos x) in
+  let rec g a n x =
+    if n = 0
+    then a
+    else g (a + (f [@inlined always]) x (x +. 1.)) (n - 1) x
+  in
+  ignore (g 0 10 5.)
+
+let () =
+  check_noalloc "classify float" unbox_classify_float;
+  check_noalloc "compare float" unbox_compare_float;
+  check_noalloc "float refs" unbox_float_refs;
+  check_noalloc "unbox let float" unbox_let_float;
+  check_noalloc "unbox only if useful" unbox_only_if_useful;
+  check_noalloc "ignore useless args" ignore_useless_args;
+
+  if Config.flambda then begin
+    check_noalloc "float and int32 record" unbox_record;
+    check_noalloc "eliminate intermediate immutable float record"
+      eliminate_intermediate_float_record;
+  end;
+
+  check_noalloc "Gc.minor_words" unbox_minor_words;
+  ()
diff --git a/testsuite/tests/float-unboxing/unbox_under_assign.ml b/testsuite/tests/float-unboxing/unbox_under_assign.ml
new file mode 100644
index 00000000..46a6a18c
--- /dev/null
+++ b/testsuite/tests/float-unboxing/unbox_under_assign.ml
@@ -0,0 +1,75 @@
+(* TEST
+*)
+
+module Float = struct
+  type _ t =
+    | IO : int option t
+    | F : float t
+
+  let bar : type a. a t -> float -> int -> a =
+    fun t f i ->
+      match t with
+      | IO -> Some i
+      | F -> f
+  [@@inline always]
+
+  let foo (t : float t) f i =
+    let r = ref 0. in
+    r := bar t f i
+end
+
+(* These boxed integer cases were also fixed by GPR#2083, although
+   current compiler code would not actually cause a failure even
+   before that fix.  The tests here are given in case register
+   typing is tightened up in future (e.g. GPR#1192). *)
+
+module Int32 = struct
+  type _ t =
+    | IO : int option t
+    | F : int32 t
+
+  let bar : type a. a t -> int32 -> int -> a =
+    fun t f i ->
+      match t with
+      | IO -> Some i
+      | F -> f
+  [@@inline always]
+
+  let foo (t : int32 t) f i =
+    let r = ref 0l in
+    r := bar t f i
+end
+
+module Int64 = struct
+  type _ t =
+    | IO : int option t
+    | F : int64 t
+
+  let bar : type a. a t -> int64 -> int -> a =
+    fun t f i ->
+      match t with
+      | IO -> Some i
+      | F -> f
+  [@@inline always]
+
+  let foo (t : int64 t) f i =
+    let r = ref 0L in
+    r := bar t f i
+end
+
+module Nativeint = struct
+  type _ t =
+    | IO : int option t
+    | F : nativeint t
+
+  let bar : type a. a t -> nativeint -> int -> a =
+    fun t f i ->
+      match t with
+      | IO -> Some i
+      | F -> f
+  [@@inline always]
+
+  let foo (t : nativeint t) f i =
+    let r = ref 0n in
+    r := bar t f i
+end
diff --git a/testsuite/tests/fma/fma.ml b/testsuite/tests/fma/fma.ml
new file mode 100644
index 00000000..2a274405
--- /dev/null
+++ b/testsuite/tests/fma/fma.ml
@@ -0,0 +1,496 @@
+(* TEST *)
+
+(* modified glibc's fma() tests *)
+
+let error l x y z r c =
+  Printf.fprintf stdout
+                 "%s FAIL!\tfma (%h, %h, %h) returned %h instead of %h.\n"
+                 l x y z c (List.hd r)
+
+let success l =
+  Printf.fprintf stdout "%s OK!\n" l
+
+let fma_test l x y z r =
+  let c = Float.fma x y z in
+  if List.exists (fun i -> i = c) r
+  then success l
+  else error l x y z r c
+
+(* test case description:
+
+  (string * float * float * float * float list)
+   |        |       |       |       |
+   id       |       |       |       IEEE compliant result in head,
+            |       |       |       or, accepted fma emulation approximation
+            |       |       |       results in tail (if any)
+            |       |       |
+            x       y       z   -> operands as in fma x y z
+ *)
+let _ =
+  let cases = [
+      ("001", 0x1p+0, 0x2p+0, 0x3p+0, [0x5p+0]);
+      ("002", 0x1.4p+0, 0xcp-4, 0x1p-4, [0x1p+0]);
+      ("003", 0x0p+0, 0x0p+0, 0x0p+0, [0x0p+0]);
+      ("004", 0x0p+0, 0x0p+0, ~-.0x0p+0, [0x0p+0]);
+      ("005", 0x0p+0, ~-.0x0p+0, 0x0p+0, [0x0p+0]);
+      ("006", 0x0p+0, ~-.0x0p+0, ~-.0x0p+0, [~-.0x0p+0]);
+      ("007", ~-.0x0p+0, 0x0p+0, 0x0p+0, [0x0p+0]);
+      ("008", ~-.0x0p+0, 0x0p+0, ~-.0x0p+0, [~-.0x0p+0]);
+      ("009", ~-.0x0p+0, ~-.0x0p+0, 0x0p+0, [0x0p+0]);
+      ("010", ~-.0x0p+0, ~-.0x0p+0, ~-.0x0p+0, [0x0p+0]);
+      ("011", 0x1p+0, 0x0p+0, 0x0p+0, [0x0p+0]);
+      ("012", 0x1p+0, 0x0p+0, ~-.0x0p+0, [0x0p+0]);
+      ("013", 0x1p+0, ~-.0x0p+0, 0x0p+0, [0x0p+0]);
+      ("014", 0x1p+0, ~-.0x0p+0, ~-.0x0p+0, [~-.0x0p+0]);
+      ("015", ~-.0x1p+0, 0x0p+0, 0x0p+0, [0x0p+0]);
+      ("016", ~-.0x1p+0, 0x0p+0, ~-.0x0p+0, [~-.0x0p+0]);
+      ("017", ~-.0x1p+0, ~-.0x0p+0, 0x0p+0, [0x0p+0]);
+      ("018", ~-.0x1p+0, ~-.0x0p+0, ~-.0x0p+0, [0x0p+0]);
+      ("019", 0x0p+0, 0x1p+0, 0x0p+0, [0x0p+0]);
+      ("020", 0x0p+0, 0x1p+0, ~-.0x0p+0, [0x0p+0]);
+      ("021", 0x0p+0, ~-.0x1p+0, 0x0p+0, [0x0p+0]);
+      ("022", 0x0p+0, ~-.0x1p+0, ~-.0x0p+0, [~-.0x0p+0]);
+      ("023", ~-.0x0p+0, 0x1p+0, 0x0p+0, [0x0p+0]);
+      ("024", ~-.0x0p+0, 0x1p+0, ~-.0x0p+0, [~-.0x0p+0]);
+      ("025", ~-.0x0p+0, ~-.0x1p+0, 0x0p+0, [0x0p+0]);
+      ("026", ~-.0x0p+0, ~-.0x1p+0, ~-.0x0p+0, [0x0p+0]);
+      ("027", 0x1p+0, 0x1p+0, ~-.0x1p+0, [0x0p+0]);
+      ("028", 0x1p+0, ~-.0x1p+0, 0x1p+0, [0x0p+0]);
+      ("029", ~-.0x1p+0, 0x1p+0, 0x1p+0, [0x0p+0]);
+      ("030", ~-.0x1p+0, ~-.0x1p+0, ~-.0x1p+0, [0x0p+0]);
+      ("031", 0x0p+0, 0x0p+0, 0x1p+0, [0x1p+0]);
+      ("032", 0x0p+0, 0x0p+0, 0x2p+0, [0x2p+0]);
+      ("033", 0x0p+0, 0x0p+0, 0xf.fffffp+124, [0xf.fffffp+124]);
+      ("034", 0x0p+0, 0x0p+0, 0xf.ffffffffffff8p+1020,
+       [0xf.ffffffffffff8p+1020]);
+      ("035", 0x0p+0, 0x1p+0, 0x1p+0, [0x1p+0]);
+      ("036", 0x1p+0, 0x0p+0, 0x1p+0, [0x1p+0]);
+      ("037", 0x0p+0, 0x1p+0, 0x2p+0, [0x2p+0]);
+      ("038", 0x1p+0, 0x0p+0, 0x2p+0, [0x2p+0]);
+      ("039", 0x0p+0, 0x1p+0, 0xf.fffffp+124, [0xf.fffffp+124]);
+      ("040", 0x0p+0, 0x1p+0, 0xf.ffffffffffff8p+1020,
+       [0xf.ffffffffffff8p+1020]);
+      ("041", 0x1p+0, 0x0p+0, 0xf.fffffp+124, [0xf.fffffp+124]);
+      ("042", 0x1p+0, 0x0p+0, 0xf.ffffffffffff8p+1020,
+       [0xf.ffffffffffff8p+1020]);
+      ("043", 0x4p-128, 0x4p-128, 0x0p+0, [0x1p-252]);
+      ("044", 0x4p-128, 0x4p-1024, 0x0p+0, [0x0p+0]);
+      ("045", 0x4p-128, 0x8p-972, 0x0p+0, [0x0p+0]);
+      ("046", 0x4p-1024, 0x4p-128, 0x0p+0, [0x0p+0]);
+      ("047", 0x4p-1024, 0x4p-1024, 0x0p+0, [0x0p+0]);
+      ("048", 0x4p-1024, 0x8p-972, 0x0p+0, [0x0p+0]);
+      ("049", 0x8p-972, 0x4p-128, 0x0p+0, [0x0p+0]);
+      ("050", 0x8p-972, 0x4p-1024, 0x0p+0, [0x0p+0]);
+      ("051", 0x8p-972, 0x8p-972, 0x0p+0, [0x0p+0]);
+      ("052", 0x4p-128, 0x4p-128, ~-.0x0p+0, [0x1p-252]);
+      ("053", 0x4p-128, 0x4p-1024, ~-.0x0p+0, [0x0p+0]);
+      ("054", 0x4p-128, 0x8p-972, ~-.0x0p+0, [0x0p+0]);
+      ("055", 0x4p-1024, 0x4p-128, ~-.0x0p+0, [0x0p+0]);
+      ("056", 0x4p-1024, 0x4p-1024, ~-.0x0p+0, [0x0p+0]);
+      ("057", 0x4p-1024, 0x8p-972, ~-.0x0p+0, [0x0p+0]);
+      ("058", 0x8p-972, 0x4p-128, ~-.0x0p+0, [0x0p+0]);
+      ("059", 0x8p-972, 0x4p-1024, ~-.0x0p+0, [0x0p+0]);
+      ("060", 0x8p-972, 0x8p-972, ~-.0x0p+0, [0x0p+0]);
+      ("061", 0x4p-128, ~-.0x4p-128, 0x0p+0, [~-.0x1p-252]);
+      ("062", 0x4p-128, ~-.0x4p-1024, 0x0p+0, [~-.0x0p+0]);
+      ("063", 0x4p-128, ~-.0x8p-972, 0x0p+0, [~-.0x0p+0]);
+      ("064", 0x4p-1024, ~-.0x4p-128, 0x0p+0, [~-.0x0p+0]);
+      ("065", 0x4p-1024, ~-.0x4p-1024, 0x0p+0, [~-.0x0p+0]);
+      ("066", 0x4p-1024, ~-.0x8p-972, 0x0p+0, [~-.0x0p+0]);
+      ("067", 0x8p-972, ~-.0x4p-128, 0x0p+0, [~-.0x0p+0]);
+      ("068", 0x8p-972, ~-.0x4p-1024, 0x0p+0, [~-.0x0p+0]);
+      ("069", 0x8p-972, ~-.0x8p-972, 0x0p+0, [~-.0x0p+0]);
+      ("070", 0x4p-128, ~-.0x4p-128, ~-.0x0p+0, [~-.0x1p-252]);
+      ("071", 0x4p-128, ~-.0x4p-1024, ~-.0x0p+0, [~-.0x0p+0]);
+      ("072", 0x4p-128, ~-.0x8p-972, ~-.0x0p+0, [~-.0x0p+0]);
+      ("073", 0x4p-1024, ~-.0x4p-128, ~-.0x0p+0, [~-.0x0p+0]);
+      ("074", 0x4p-1024, ~-.0x4p-1024, ~-.0x0p+0, [~-.0x0p+0]);
+      ("075", 0x4p-1024, ~-.0x8p-972, ~-.0x0p+0, [~-.0x0p+0]);
+      ("076", 0x8p-972, ~-.0x4p-128, ~-.0x0p+0, [~-.0x0p+0]);
+      ("077", 0x8p-972, ~-.0x4p-1024, ~-.0x0p+0, [~-.0x0p+0]);
+      ("078", 0x8p-972, ~-.0x8p-972, ~-.0x0p+0, [~-.0x0p+0]);
+      ("079", ~-.0x4p-128, 0x4p-128, 0x0p+0, [~-.0x1p-252]);
+      ("080", ~-.0x4p-128, 0x4p-1024, 0x0p+0, [~-.0x0p+0]);
+      ("081", ~-.0x4p-128, 0x8p-972, 0x0p+0, [~-.0x0p+0]);
+      ("082", ~-.0x4p-1024, 0x4p-128, 0x0p+0, [~-.0x0p+0]);
+      ("083", ~-.0x4p-1024, 0x4p-1024, 0x0p+0, [~-.0x0p+0]);
+      ("084", ~-.0x4p-1024, 0x8p-972, 0x0p+0, [~-.0x0p+0]);
+      ("085", ~-.0x8p-972, 0x4p-128, 0x0p+0, [~-.0x0p+0]);
+      ("086", ~-.0x8p-972, 0x4p-1024, 0x0p+0, [~-.0x0p+0]);
+      ("087", ~-.0x8p-972, 0x8p-972, 0x0p+0, [~-.0x0p+0]);
+      ("088", ~-.0x4p-128, 0x4p-128, ~-.0x0p+0, [~-.0x1p-252]);
+      ("089", ~-.0x4p-128, 0x4p-1024, ~-.0x0p+0, [~-.0x0p+0]);
+      ("090", ~-.0x4p-128, 0x8p-972, ~-.0x0p+0, [~-.0x0p+0]);
+      ("091", ~-.0x4p-1024, 0x4p-128, ~-.0x0p+0, [~-.0x0p+0]);
+      ("092", ~-.0x4p-1024, 0x4p-1024, ~-.0x0p+0, [~-.0x0p+0]);
+      ("093", ~-.0x4p-1024, 0x8p-972, ~-.0x0p+0, [~-.0x0p+0]);
+      ("094", ~-.0x8p-972, 0x4p-128, ~-.0x0p+0, [~-.0x0p+0]);
+      ("095", ~-.0x8p-972, 0x4p-1024, ~-.0x0p+0, [~-.0x0p+0]);
+      ("096", ~-.0x8p-972, 0x8p-972, ~-.0x0p+0, [~-.0x0p+0]);
+      ("097", ~-.0x4p-128, ~-.0x4p-128, 0x0p+0, [0x1p-252]);
+      ("098", ~-.0x4p-128, ~-.0x4p-1024, 0x0p+0, [0x0p+0]);
+      ("099", ~-.0x4p-128, ~-.0x8p-972, 0x0p+0, [0x0p+0]);
+      ("100", ~-.0x4p-1024, ~-.0x4p-128, 0x0p+0, [0x0p+0]);
+      ("101", ~-.0x4p-1024, ~-.0x4p-1024, 0x0p+0, [0x0p+0]);
+      ("102", ~-.0x4p-1024, ~-.0x8p-972, 0x0p+0, [0x0p+0]);
+      ("103", ~-.0x8p-972, ~-.0x4p-128, 0x0p+0, [0x0p+0]);
+      ("104", ~-.0x8p-972, ~-.0x4p-1024, 0x0p+0, [0x0p+0]);
+      ("105", ~-.0x8p-972, ~-.0x8p-972, 0x0p+0, [0x0p+0]);
+      ("106", ~-.0x4p-128, ~-.0x4p-128, ~-.0x0p+0, [0x1p-252]);
+      ("107", ~-.0x4p-128, ~-.0x4p-1024, ~-.0x0p+0, [0x0p+0]);
+      ("108", ~-.0x4p-128, ~-.0x8p-972, ~-.0x0p+0, [0x0p+0]);
+      ("109", ~-.0x4p-1024, ~-.0x4p-128, ~-.0x0p+0, [0x0p+0]);
+      ("110", ~-.0x4p-1024, ~-.0x4p-1024, ~-.0x0p+0, [0x0p+0]);
+      ("111", ~-.0x4p-1024, ~-.0x8p-972, ~-.0x0p+0, [0x0p+0]);
+      ("112", ~-.0x8p-972, ~-.0x4p-128, ~-.0x0p+0, [0x0p+0]);
+      ("113", ~-.0x8p-972, ~-.0x4p-1024, ~-.0x0p+0, [0x0p+0]);
+      ("114", ~-.0x8p-972, ~-.0x8p-972, ~-.0x0p+0, [0x0p+0]);
+      ("115", 0xf.fffffp+124, 0xf.fffffp+124, 0x4p-128, [0xf.ffffe000001p+252]);
+      ("116", 0xf.fffffp+124, 0xf.fffffp+124, 0x4p-1024,
+       [0xf.ffffe000001p+252]);
+      ("117", 0xf.fffffp+124, 0xf.fffffp+124, 0x8p-972, [0xf.ffffe000001p+252]);
+      ("118", 0xf.fffffp+124, 0xf.ffffffffffff8p+1020, 0x4p-128, [infinity]);
+      ("119", 0xf.fffffp+124, 0xf.ffffffffffff8p+1020, 0x4p-1024, [infinity]);
+      ("120", 0xf.fffffp+124, 0xf.ffffffffffff8p+1020, 0x8p-972, [infinity]);
+      ("121", 0xf.ffffffffffff8p+1020, 0xf.fffffp+124, 0x4p-128, [infinity]);
+      ("122", 0xf.ffffffffffff8p+1020, 0xf.fffffp+124, 0x4p-1024, [infinity]);
+      ("123", 0xf.ffffffffffff8p+1020, 0xf.fffffp+124, 0x8p-972, [infinity]);
+      ("124", 0xf.ffffffffffff8p+1020, 0xf.ffffffffffff8p+1020, 0x4p-128,
+       [infinity]);
+      ("125", 0xf.ffffffffffff8p+1020, 0xf.ffffffffffff8p+1020, 0x4p-1024,
+       [infinity]);
+      ("126", 0xf.ffffffffffff8p+1020, 0xf.ffffffffffff8p+1020, 0x8p-972,
+       [infinity]);
+      ("127", 0xf.fffffp+124, 0xf.fffffp+124, ~-.0x4p-128,
+       [0xf.ffffe000001p+252]);
+      ("128", 0xf.fffffp+124, 0xf.fffffp+124, ~-.0x4p-1024,
+       [0xf.ffffe000001p+252]);
+      ("129", 0xf.fffffp+124, 0xf.fffffp+124, ~-.0x8p-972,
+       [0xf.ffffe000001p+252]);
+      ("130", 0xf.fffffp+124, 0xf.ffffffffffff8p+1020, ~-.0x4p-128, [infinity]);
+      ("131", 0xf.fffffp+124, 0xf.ffffffffffff8p+1020, ~-.0x4p-1024,
+       [infinity]);
+      ("132", 0xf.fffffp+124, 0xf.ffffffffffff8p+1020, ~-.0x8p-972, [infinity]);
+      ("133", 0xf.ffffffffffff8p+1020, 0xf.fffffp+124, ~-.0x4p-128, [infinity]);
+      ("134", 0xf.ffffffffffff8p+1020, 0xf.fffffp+124, ~-.0x4p-1024,
+       [infinity]);
+      ("135", 0xf.ffffffffffff8p+1020, 0xf.fffffp+124, ~-.0x8p-972, [infinity]);
+      ("136", 0xf.ffffffffffff8p+1020, 0xf.ffffffffffff8p+1020, ~-.0x4p-128,
+       [infinity]);
+      ("137", 0xf.ffffffffffff8p+1020, 0xf.ffffffffffff8p+1020, ~-.0x4p-1024,
+       [infinity]);
+      ("138", 0xf.ffffffffffff8p+1020, 0xf.ffffffffffff8p+1020, ~-.0x8p-972,
+       [infinity]);
+      ("139", 0xf.fffffp+124, ~-.0xf.fffffp+124, 0x4p-128,
+       [~-.0xf.ffffe000001p+252]);
+      ("140", 0xf.fffffp+124, ~-.0xf.fffffp+124, 0x4p-1024,
+       [~-.0xf.ffffe000001p+252]);
+      ("141", 0xf.fffffp+124, ~-.0xf.fffffp+124, 0x8p-972,
+       [~-.0xf.ffffe000001p+252]);
+      ("142", 0xf.fffffp+124, ~-.0xf.ffffffffffff8p+1020, 0x4p-128,
+       [~-.infinity]);
+      ("143", 0xf.fffffp+124, ~-.0xf.ffffffffffff8p+1020, 0x4p-1024,
+       [~-.infinity]);
+      ("144", 0xf.fffffp+124, ~-.0xf.ffffffffffff8p+1020, 0x8p-972,
+       [~-.infinity]);
+      ("145", 0xf.ffffffffffff8p+1020, ~-.0xf.fffffp+124, 0x4p-128,
+       [~-.infinity]);
+      ("146", 0xf.ffffffffffff8p+1020, ~-.0xf.fffffp+124, 0x4p-1024,
+       [~-.infinity]);
+      ("147", 0xf.ffffffffffff8p+1020, ~-.0xf.fffffp+124, 0x8p-972,
+       [~-.infinity]);
+      ("148", 0xf.ffffffffffff8p+1020, ~-.0xf.ffffffffffff8p+1020, 0x4p-128,
+       [~-.infinity]);
+      ("149", 0xf.ffffffffffff8p+1020, ~-.0xf.ffffffffffff8p+1020, 0x4p-1024,
+       [~-.infinity]);
+      ("150", 0xf.ffffffffffff8p+1020, ~-.0xf.ffffffffffff8p+1020, 0x8p-972,
+       [~-.infinity]);
+      ("151", 0xf.fffffp+124, ~-.0xf.fffffp+124, ~-.0x4p-128,
+       [~-.0xf.ffffe000001p+252]);
+      ("152", 0xf.fffffp+124, ~-.0xf.fffffp+124, ~-.0x4p-1024,
+       [~-.0xf.ffffe000001p+252]);
+      ("153", 0xf.fffffp+124, ~-.0xf.fffffp+124, ~-.0x8p-972,
+       [~-.0xf.ffffe000001p+252]);
+      ("154", 0xf.fffffp+124, ~-.0xf.ffffffffffff8p+1020, ~-.0x4p-128,
+       [~-.infinity]);
+      ("155", 0xf.fffffp+124, ~-.0xf.ffffffffffff8p+1020, ~-.0x4p-1024,
+       [~-.infinity]);
+      ("156", 0xf.fffffp+124, ~-.0xf.ffffffffffff8p+1020, ~-.0x8p-972,
+       [~-.infinity]);
+      ("157", 0xf.ffffffffffff8p+1020, ~-.0xf.fffffp+124, ~-.0x4p-128,
+       [~-.infinity]);
+      ("158", 0xf.ffffffffffff8p+1020, ~-.0xf.fffffp+124, ~-.0x4p-1024,
+       [~-.infinity]);
+      ("159", 0xf.ffffffffffff8p+1020, ~-.0xf.fffffp+124, ~-.0x8p-972,
+       [~-.infinity]);
+      ("160", 0xf.ffffffffffff8p+1020, ~-.0xf.ffffffffffff8p+1020, ~-.0x4p-128,
+       [~-.infinity]);
+      ("161", 0xf.ffffffffffff8p+1020, ~-.0xf.ffffffffffff8p+1020, ~-.0x4p-1024,
+       [~-.infinity]);
+      ("162", 0xf.ffffffffffff8p+1020, ~-.0xf.ffffffffffff8p+1020, ~-.0x8p-972,
+       [~-.infinity]);
+      ("163", ~-.0xf.fffffp+124, 0xf.fffffp+124, 0x4p-128,
+       [~-.0xf.ffffe000001p+252]);
+      ("164", ~-.0xf.fffffp+124, 0xf.fffffp+124, 0x4p-1024,
+       [~-.0xf.ffffe000001p+252]);
+      ("165", ~-.0xf.fffffp+124, 0xf.fffffp+124, 0x8p-972,
+       [~-.0xf.ffffe000001p+252]);
+      ("166", ~-.0xf.fffffp+124, 0xf.ffffffffffff8p+1020, 0x4p-128,
+       [~-.infinity]);
+      ("167", ~-.0xf.fffffp+124, 0xf.ffffffffffff8p+1020, 0x4p-1024,
+       [~-.infinity]);
+      ("168", ~-.0xf.fffffp+124, 0xf.ffffffffffff8p+1020, 0x8p-972,
+       [~-.infinity]);
+      ("169", ~-.0xf.ffffffffffff8p+1020, 0xf.fffffp+124, 0x4p-128,
+       [~-.infinity]);
+      ("170", ~-.0xf.ffffffffffff8p+1020, 0xf.fffffp+124, 0x4p-1024,
+       [~-.infinity]);
+      ("171", ~-.0xf.ffffffffffff8p+1020, 0xf.fffffp+124, 0x8p-972,
+       [~-.infinity]);
+      ("172", ~-.0xf.ffffffffffff8p+1020, 0xf.ffffffffffff8p+1020, 0x4p-128,
+       [~-.infinity]);
+      ("173", ~-.0xf.ffffffffffff8p+1020, 0xf.ffffffffffff8p+1020, 0x4p-1024,
+       [~-.infinity]);
+      ("174", ~-.0xf.ffffffffffff8p+1020, 0xf.ffffffffffff8p+1020, 0x8p-972,
+       [~-.infinity]);
+      ("175", ~-.0xf.fffffp+124, 0xf.fffffp+124, ~-.0x4p-128,
+       [~-.0xf.ffffe000001p+252]);
+      ("176", ~-.0xf.fffffp+124, 0xf.fffffp+124, ~-.0x4p-1024,
+       [~-.0xf.ffffe000001p+252]);
+      ("177", ~-.0xf.fffffp+124, 0xf.fffffp+124, ~-.0x8p-972,
+       [~-.0xf.ffffe000001p+252]);
+      ("178", ~-.0xf.fffffp+124, 0xf.ffffffffffff8p+1020, ~-.0x4p-128,
+       [~-.infinity]);
+      ("179", ~-.0xf.fffffp+124, 0xf.ffffffffffff8p+1020, ~-.0x4p-1024,
+       [~-.infinity]);
+      ("180", ~-.0xf.fffffp+124, 0xf.ffffffffffff8p+1020, ~-.0x8p-972,
+       [~-.infinity]);
+      ("181", ~-.0xf.ffffffffffff8p+1020, 0xf.fffffp+124, ~-.0x4p-128,
+       [~-.infinity]);
+      ("182", ~-.0xf.ffffffffffff8p+1020, 0xf.fffffp+124, ~-.0x4p-1024,
+       [~-.infinity]);
+      ("183", ~-.0xf.ffffffffffff8p+1020, 0xf.fffffp+124, ~-.0x8p-972,
+       [~-.infinity]);
+      ("184", ~-.0xf.ffffffffffff8p+1020, 0xf.ffffffffffff8p+1020, ~-.0x4p-128,
+       [~-.infinity]);
+      ("185", ~-.0xf.ffffffffffff8p+1020, 0xf.ffffffffffff8p+1020, ~-.0x4p-1024,
+       [~-.infinity]);
+      ("186", ~-.0xf.ffffffffffff8p+1020, 0xf.ffffffffffff8p+1020, ~-.0x8p-972,
+       [~-.infinity]);
+      ("187", ~-.0xf.fffffp+124, ~-.0xf.fffffp+124, 0x4p-128,
+       [0xf.ffffe000001p+252]);
+      ("188", ~-.0xf.fffffp+124, ~-.0xf.fffffp+124, 0x4p-1024,
+       [0xf.ffffe000001p+252]);
+      ("189", ~-.0xf.fffffp+124, ~-.0xf.fffffp+124, 0x8p-972,
+       [0xf.ffffe000001p+252]);
+      ("190", ~-.0xf.fffffp+124, ~-.0xf.ffffffffffff8p+1020, 0x4p-128,
+       [infinity]);
+      ("191", ~-.0xf.fffffp+124, ~-.0xf.ffffffffffff8p+1020, 0x4p-1024,
+       [infinity]);
+      ("192", ~-.0xf.fffffp+124, ~-.0xf.ffffffffffff8p+1020, 0x8p-972,
+       [infinity]);
+      ("193", ~-.0xf.ffffffffffff8p+1020, ~-.0xf.fffffp+124, 0x4p-128,
+       [infinity]);
+      ("194", ~-.0xf.ffffffffffff8p+1020, ~-.0xf.fffffp+124, 0x4p-1024,
+       [infinity]);
+      ("195", ~-.0xf.ffffffffffff8p+1020, ~-.0xf.fffffp+124, 0x8p-972,
+       [infinity]);
+      ("196", ~-.0xf.ffffffffffff8p+1020, ~-.0xf.ffffffffffff8p+1020, 0x4p-128,
+       [infinity]);
+      ("197", ~-.0xf.ffffffffffff8p+1020, ~-.0xf.ffffffffffff8p+1020, 0x4p-1024,
+       [infinity]);
+      ("198", ~-.0xf.ffffffffffff8p+1020, ~-.0xf.ffffffffffff8p+1020, 0x8p-972,
+       [infinity]);
+      ("199", ~-.0xf.fffffp+124, ~-.0xf.fffffp+124, ~-.0x4p-128,
+       [0xf.ffffe000001p+252]);
+      ("200", ~-.0xf.fffffp+124, ~-.0xf.fffffp+124, ~-.0x4p-1024,
+       [0xf.ffffe000001p+252]);
+      ("201", ~-.0xf.fffffp+124, ~-.0xf.fffffp+124, ~-.0x8p-972,
+       [0xf.ffffe000001p+252]);
+      ("202", ~-.0xf.fffffp+124, ~-.0xf.ffffffffffff8p+1020, ~-.0x4p-128,
+       [infinity]);
+      ("203", ~-.0xf.fffffp+124, ~-.0xf.ffffffffffff8p+1020, ~-.0x4p-1024,
+       [infinity]);
+      ("204", ~-.0xf.fffffp+124, ~-.0xf.ffffffffffff8p+1020, ~-.0x8p-972,
+       [infinity]);
+      ("205", ~-.0xf.ffffffffffff8p+1020, ~-.0xf.fffffp+124, ~-.0x4p-128,
+       [infinity]);
+      ("206", ~-.0xf.ffffffffffff8p+1020, ~-.0xf.fffffp+124, ~-.0x4p-1024,
+       [infinity]);
+      ("207", ~-.0xf.ffffffffffff8p+1020, ~-.0xf.fffffp+124, ~-.0x8p-972,
+       [infinity]);
+      ("208", ~-.0xf.ffffffffffff8p+1020, ~-.0xf.ffffffffffff8p+1020,
+       ~-.0x4p-128, [infinity]);
+      ("209", ~-.0xf.ffffffffffff8p+1020, ~-.0xf.ffffffffffff8p+1020,
+       ~-.0x4p-1024, [infinity]);
+      ("210", ~-.0xf.ffffffffffff8p+1020, ~-.0xf.ffffffffffff8p+1020,
+       ~-.0x8p-972, [infinity]);
+      ("211", 0x2.fffp+12, 0x1.000002p+0, 0x1.ffffp-24, [0x2.fff006p+12]);
+      ("212", 0x1.fffp+0, 0x1.00001p+0, ~-.0x1.fffp+0, [0x1.fffp-20]);
+      ("213", 0xc.d5e6fp+124, 0x2.6af378p-128, ~-.0x1.f08948p+0,
+       [0xd.da108p-28]);
+      ("214", 0x1.9abcdep+100, 0x2.6af378p-128, ~-.0x3.e1129p-28,
+       [0x1.bb421p-52]);
+      ("215", 0xf.fffffp+124, 0x1.001p+0, ~-.0xf.fffffp+124, [0xf.fffffp+112]);
+      ("216", ~-.0xf.fffffp+124, 0x1.fffffep+0, 0xf.fffffp+124,
+       [~-.0xf.ffffd000002p+124]);
+      ("217", 0xf.fffffp+124, 0x2p+0, ~-.0xf.fffffp+124, [0xf.fffffp+124]);
+      ("218", 0x5p-128, 0x8.00002p-4, 0x1p-128, [0x3.80000ap-128]);
+      ("219", ~-.0x5p-128, 0x8.00002p-4, ~-.0x1p-128, [~-.0x3.80000ap-128]);
+      ("220", 0x7.ffffep-128, 0x8.00001p-4, 0x8p-152, [0x3.ffffffffffep-128]);
+      ("221", ~-.0x7.ffffep-128, 0x8.00001p-4, ~-.0x8p-152,
+       [~-.0x3.ffffffffffep-128]);
+      ("222", 0x8p-152, 0x8p-4, 0x3.fffff8p-128, [0x3.fffffcp-128]);
+      ("223", ~-.0x8p-152, 0x8p-4, ~-.0x3.fffff8p-128, [~-.0x3.fffffcp-128]);
+      ("224", 0x8p-152, 0x8.8p-4, 0x3.fffff8p-128, [0x3.fffffc4p-128]);
+      ("225", ~-.0x8p-152, 0x8.8p-4, ~-.0x3.fffff8p-128, [~-.0x3.fffffc4p-128]);
+      ("226", 0x8p-152, 0x8p-152, 0x8p+124, [0x8p+124]);
+      ("227", 0x8p-152, ~-.0x8p-152, 0x8p+124, [0x8p+124]);
+      ("228", 0x8p-152, 0x8p-152, ~-.0x8p+124, [~-.0x8p+124]);
+      ("229", 0x8p-152, ~-.0x8p-152, ~-.0x8p+124, [~-.0x8p+124]);
+      ("230", 0x8p-152, 0x8p-152, 0x4p-128, [0x4p-128]);
+      ("231", 0x8p-152, ~-.0x8p-152, 0x4p-128, [0x4p-128]);
+      ("232", 0x8p-152, 0x8p-152, ~-.0x4p-128, [~-.0x4p-128]);
+      ("233", 0x8p-152, ~-.0x8p-152, ~-.0x4p-128, [~-.0x4p-128]);
+      ("234", 0x8p-152, 0x8p-152, 0x3.fffff8p-128, [0x3.fffff8p-128]);
+      ("235", 0x8p-152, ~-.0x8p-152, 0x3.fffff8p-128, [0x3.fffff8p-128]);
+      ("236", 0x8p-152, 0x8p-152, ~-.0x3.fffff8p-128, [~-.0x3.fffff8p-128]);
+      ("237", 0x8p-152, ~-.0x8p-152, ~-.0x3.fffff8p-128, [~-.0x3.fffff8p-128]);
+      ("238", 0x8p-152, 0x8p-152, 0x8p-152, [0x8p-152]);
+      ("239", 0x8p-152, ~-.0x8p-152, 0x8p-152, [0x8p-152]);
+      ("240", 0x8p-152, 0x8p-152, ~-.0x8p-152, [~-.0x8p-152]);
+      ("241", 0x8p-152, ~-.0x8p-152, ~-.0x8p-152, [~-.0x8p-152]);
+      ("242", 0xf.ffp-4, 0xf.ffp-4, ~-.0xf.fep-4, [0x1p-24]);
+      ("243", 0xf.ffp-4, ~-.0xf.ffp-4, 0xf.fep-4, [~-.0x1p-24]);
+      ("244", ~-.0xf.ffp-4, 0xf.ffp-4, 0xf.fep-4, [~-.0x1p-24]);
+      ("245", ~-.0xf.ffp-4, ~-.0xf.ffp-4, ~-.0xf.fep-4, [0x1p-24]);
+      ("246", 0x4.000008p-128, 0x4.000008p-28, 0x8p+124, [0x8p+124]);
+      ("247", 0x4.000008p-128, ~-.0x4.000008p-28, 0x8p+124, [0x8p+124]);
+      ("248", 0x4.000008p-128, 0x4.000008p-28, ~-.0x8p+124, [~-.0x8p+124]);
+      ("249", 0x4.000008p-128, ~-.0x4.000008p-28, ~-.0x8p+124, [~-.0x8p+124]);
+      ("250", 0x4.000008p-128, 0x4.000008p-28, 0x8p+100, [0x8p+100]);
+      ("251", 0x4.000008p-128, ~-.0x4.000008p-28, 0x8p+100, [0x8p+100]);
+      ("252", 0x4.000008p-128, 0x4.000008p-28, ~-.0x8p+100, [~-.0x8p+100]);
+      ("253", 0x4.000008p-128, ~-.0x4.000008p-28, ~-.0x8p+100, [~-.0x8p+100]);
+      ("254", 0x2.fep+12, 0x1.0000000000001p+0, 0x1.ffep-48,
+       [0x2.fe00000000002p+12; 0x1.7f00000000002p+13]);
+      ("255", 0x1.fffp+0, 0x1.0000000000001p+0, ~-.0x1.fffp+0,
+       [0x1.fffp-52; 0x1p-51]);
+      ("256", 0x1.0000002p+0, 0xf.fffffep-4, 0x1p-300, [0x1p+0]);
+      ("257", 0x1.0000002p+0, 0xf.fffffep-4, ~-.0x1p-300,
+       [0xf.ffffffffffff8p-4; 0x1p+0]);
+      ("258", 0xe.f56df7797f768p+1020, 0x3.7ab6fbbcbfbb4p-1024,
+       ~-.0x3.40bf1803497f6p+0,
+       [0x8.4c4b43de4ed2p-56; 0x1.095f287bc9da4p-53; 0x1.098p-53]);
+      ("259", 0x1.deadbeef2feedp+900, 0x3.7ab6fbbcbfbb4p-1024,
+       ~-.0x6.817e300692fecp-124,
+       [0x1.0989687bc9da4p-176; 0x1.095f287bc9da4p-176; 0x1.098p-176]);
+      ("260", 0xf.ffffffffffff8p+1020, 0x1.001p+0,
+       ~-.0xf.ffffffffffff8p+1020, [0xf.ffffffffffff8p+1008; 0x1p+1012]);
+      ("261", ~-.0xf.ffffffffffff8p+1020, 0x1.fffffffffffffp+0,
+       0xf.ffffffffffff8p+1020, [~-.0xf.fffffffffffe8p+1020]);
+      ("262", 0xf.ffffffffffff8p+1020, 0x2p+0, ~-.0xf.ffffffffffff8p+1020,
+       [0xf.ffffffffffff8p+1020]);
+      ("263", 0x5.a827999fcef3p-540, 0x5.a827999fcef3p-540, 0x0p+0, [0x0p+0]);
+      ("264", 0x3.bd5b7dde5fddap-496, 0x3.bd5b7dde5fddap-496,
+       ~-.0xd.fc352bc352bap-992,
+       [0x1.0989687cp-1044; 0x0.000004277ca1fp-1022; 0x0.00000428p-1022]);
+      ("265", 0x3.bd5b7dde5fddap-504, 0x3.bd5b7dde5fddap-504,
+       ~-.0xd.fc352bc352bap-1008,
+       [0x1.0988p-1060; 0x0.0000000004278p-1022; 0x0.000000000428p-1022]);
+      ("266", 0x8p-540, 0x4p-540, 0x4p-1076, [0x8p-1076]);
+      ("267", 0x1.7fffff8p-968, 0x4p-108, 0x4p-1048,
+       [0x4.0000004p-1048; 0x0.0000010000002p-1022]);
+      ("268", 0x2.8000008p-968, 0x4p-108, 0x4p-1048,
+       [0x4.000000cp-1048; 0x0.0000010000002p-1022]);
+      ("269", 0x2.8p-968, ~-.0x4p-108, ~-.0x4p-1048, [~-.0x4.0000008p-1048]);
+      ("270", ~-.0x2.33956cdae7c2ep-960, 0x3.8e211518bfea2p-108,
+       ~-.0x2.02c2b59766d9p-1024, [~-.0x2.02c2b59767564p-1024]);
+      ("271", ~-.0x3.a5d5dadd1d3a6p-980, ~-.0x2.9c0cd8c5593bap-64,
+       ~-.0x2.49179ac00d15p-1024, [~-.0x2.491702717ed74p-1024]);
+      ("272", 0x2.2a7aca1773e0cp-908, 0x9.6809186a42038p-128,
+       ~-.0x2.c9e356b3f0fp-1024,
+       [~-.0x2.c89d5c48eefa4p-1024; ~-.0x0.b22757123bbe8p-1022]);
+      ("273", ~-.0x3.ffffffffffffep-712, 0x3.ffffffffffffep-276,
+       0x3.fffffc0000ffep-984, [0x2.fffffc0000ffep-984; 0x1.7ffffe00008p-983]);
+      ("274", 0x5p-1024, 0x8.000000000001p-4, 0x1p-1024,
+       [0x3.8000000000004p-1024]);
+      ("275", ~-.0x5p-1024, 0x8.000000000001p-4, ~-.0x1p-1024,
+       [~-.0x3.8000000000004p-1024]);
+      ("276", 0x7.ffffffffffffp-1024, 0x8.0000000000008p-4, 0x4p-1076,
+       [0x4p-1024]);
+      ("277", ~-.0x7.ffffffffffffp-1024, 0x8.0000000000008p-4, ~-.0x4p-1076,
+       [~-.0x4p-1024]);
+      ("278", 0x4p-1076, 0x8p-4, 0x3.ffffffffffffcp-1024, [0x4p-1024]);
+      ("279", ~-.0x4p-1076, 0x8p-4, ~-.0x3.ffffffffffffcp-1024, [~-.0x4p-1024]);
+      ("280", 0x4p-1076, 0x8.8p-4, 0x3.ffffffffffffcp-1024, [0x4p-1024]);
+      ("281", ~-.0x4p-1076, 0x8.8p-4, ~-.0x3.ffffffffffffcp-1024,
+       [~-.0x4p-1024]);
+      ("282", 0x4p-1076, 0x4p-1076, 0x8p+1020, [0x8p+1020]);
+      ("283", 0x4p-1076, ~-.0x4p-1076, 0x8p+1020, [0x8p+1020]);
+      ("284", 0x4p-1076, 0x4p-1076, ~-.0x8p+1020, [~-.0x8p+1020]);
+      ("285", 0x4p-1076, ~-.0x4p-1076, ~-.0x8p+1020, [~-.0x8p+1020]);
+      ("286", 0x4p-1076, 0x4p-1076, 0x4p-1024, [0x4p-1024]);
+      ("287", 0x4p-1076, ~-.0x4p-1076, 0x4p-1024, [0x4p-1024]);
+      ("288", 0x4p-1076, 0x4p-1076, ~-.0x4p-1024, [~-.0x4p-1024]);
+      ("289", 0x4p-1076, ~-.0x4p-1076, ~-.0x4p-1024, [~-.0x4p-1024]);
+      ("290", 0x4p-1076, 0x4p-1076, 0x3.ffffffffffffcp-1024,
+       [0x3.ffffffffffffcp-1024]);
+      ("291", 0x4p-1076, ~-.0x4p-1076, 0x3.ffffffffffffcp-1024,
+       [0x3.ffffffffffffcp-1024]);
+      ("292", 0x4p-1076, 0x4p-1076, ~-.0x3.ffffffffffffcp-1024,
+       [~-.0x3.ffffffffffffcp-1024]);
+      ("293", 0x4p-1076, ~-.0x4p-1076, ~-.0x3.ffffffffffffcp-1024,
+       [~-.0x3.ffffffffffffcp-1024]);
+      ("294", 0x4p-1076, 0x4p-1076, 0x4p-1076, [0x4p-1076]);
+      ("295", 0x4p-1076, ~-.0x4p-1076, 0x4p-1076, [0x4p-1076]);
+      ("296", 0x4p-1076, 0x4p-1076, ~-.0x4p-1076, [~-.0x4p-1076]);
+      ("297", 0x4p-1076, ~-.0x4p-1076, ~-.0x4p-1076, [~-.0x4p-1076]);
+      ("298", 0xf.ffffffffffff8p-4, 0xf.ffffffffffff8p-4,
+       ~-.0xf.ffffffffffffp-4, [0x4p-108; 0x0p+0]);
+      ("299", 0xf.ffffffffffff8p-4, ~-.0xf.ffffffffffff8p-4,
+       0xf.ffffffffffffp-4, [~-.0x4p-108; 0x0p+0]);
+      ("300", ~-.0xf.ffffffffffff8p-4, 0xf.ffffffffffff8p-4,
+       0xf.ffffffffffffp-4, [~-.0x4p-108; 0x0p+0]);
+      ("301", ~-.0xf.ffffffffffff8p-4, ~-.0xf.ffffffffffff8p-4,
+       ~-.0xf.ffffffffffffp-4, [0x4p-108; 0x0p+0]);
+      ("302", 0x4.0000000000004p-1024, 0x2.0000000000002p-56, 0x8p+1020,
+       [0x8p+1020]);
+      ("303", 0x4.0000000000004p-1024, ~-.0x2.0000000000002p-56, 0x8p+1020,
+       [0x8p+1020]);
+      ("304", 0x4.0000000000004p-1024, 0x2.0000000000002p-56, ~-.0x8p+1020,
+       [~-.0x8p+1020]);
+      ("305", 0x4.0000000000004p-1024, ~-.0x2.0000000000002p-56, ~-.0x8p+1020,
+       [~-.0x8p+1020]);
+      ("306", 0x4.0000000000004p-1024, 0x2.0000000000002p-56, 0x4p+968,
+       [0x4p+968]);
+      ("307", 0x4.0000000000004p-1024, ~-.0x2.0000000000002p-56, 0x4p+968,
+       [0x4p+968]);
+      ("308", 0x4.0000000000004p-1024, 0x2.0000000000002p-56, ~-.0x4p+968,
+       [~-.0x4p+968]);
+      ("309", 0x4.0000000000004p-1024, ~-.0x2.0000000000002p-56, ~-.0x4p+968,
+       [~-.0x4p+968]);
+      ("310", 0x7.fffff8p-128, 0x3.fffffcp+24, 0xf.fffffp+124,
+       [0xf.fffffp+124]);
+      ("311", 0x7.fffff8p-128, ~-.0x3.fffffcp+24, 0xf.fffffp+124,
+       [0xf.fffffp+124]);
+      ("312", 0x7.fffff8p-128, 0x3.fffffcp+24, ~-.0xf.fffffp+124,
+       [~-.0xf.fffffp+124]);
+      ("313", 0x7.fffff8p-128, ~-.0x3.fffffcp+24, ~-.0xf.fffffp+124,
+       [~-.0xf.fffffp+124]);
+      ("314", 0x7.ffffffffffffcp-1024, 0x7.ffffffffffffcp+52,
+       0xf.ffffffffffff8p+1020, [0xf.ffffffffffff8p+1020]);
+      ("315", 0x7.ffffffffffffcp-1024, ~-.0x7.ffffffffffffcp+52,
+       0xf.ffffffffffff8p+1020, [0xf.ffffffffffff8p+1020]);
+      ("316", 0x7.ffffffffffffcp-1024, 0x7.ffffffffffffcp+52,
+       ~-.0xf.ffffffffffff8p+1020, [~-.0xf.ffffffffffff8p+1020]);
+      ("317", 0x7.ffffffffffffcp-1024, ~-.0x7.ffffffffffffcp+52,
+       ~-.0xf.ffffffffffff8p+1020, [~-.0xf.ffffffffffff8p+1020])
+    ] in
+  let rec do_cases c =
+    match c with
+      (l, x, y, z, r)::t -> fma_test l x y z r;
+                            do_cases t
+    | [] -> ()
+  in
+  do_cases cases
diff --git a/testsuite/tests/fma/fma.reference b/testsuite/tests/fma/fma.reference
new file mode 100644
index 00000000..44d04b38
--- /dev/null
+++ b/testsuite/tests/fma/fma.reference
@@ -0,0 +1,317 @@
+001 OK!
+002 OK!
+003 OK!
+004 OK!
+005 OK!
+006 OK!
+007 OK!
+008 OK!
+009 OK!
+010 OK!
+011 OK!
+012 OK!
+013 OK!
+014 OK!
+015 OK!
+016 OK!
+017 OK!
+018 OK!
+019 OK!
+020 OK!
+021 OK!
+022 OK!
+023 OK!
+024 OK!
+025 OK!
+026 OK!
+027 OK!
+028 OK!
+029 OK!
+030 OK!
+031 OK!
+032 OK!
+033 OK!
+034 OK!
+035 OK!
+036 OK!
+037 OK!
+038 OK!
+039 OK!
+040 OK!
+041 OK!
+042 OK!
+043 OK!
+044 OK!
+045 OK!
+046 OK!
+047 OK!
+048 OK!
+049 OK!
+050 OK!
+051 OK!
+052 OK!
+053 OK!
+054 OK!
+055 OK!
+056 OK!
+057 OK!
+058 OK!
+059 OK!
+060 OK!
+061 OK!
+062 OK!
+063 OK!
+064 OK!
+065 OK!
+066 OK!
+067 OK!
+068 OK!
+069 OK!
+070 OK!
+071 OK!
+072 OK!
+073 OK!
+074 OK!
+075 OK!
+076 OK!
+077 OK!
+078 OK!
+079 OK!
+080 OK!
+081 OK!
+082 OK!
+083 OK!
+084 OK!
+085 OK!
+086 OK!
+087 OK!
+088 OK!
+089 OK!
+090 OK!
+091 OK!
+092 OK!
+093 OK!
+094 OK!
+095 OK!
+096 OK!
+097 OK!
+098 OK!
+099 OK!
+100 OK!
+101 OK!
+102 OK!
+103 OK!
+104 OK!
+105 OK!
+106 OK!
+107 OK!
+108 OK!
+109 OK!
+110 OK!
+111 OK!
+112 OK!
+113 OK!
+114 OK!
+115 OK!
+116 OK!
+117 OK!
+118 OK!
+119 OK!
+120 OK!
+121 OK!
+122 OK!
+123 OK!
+124 OK!
+125 OK!
+126 OK!
+127 OK!
+128 OK!
+129 OK!
+130 OK!
+131 OK!
+132 OK!
+133 OK!
+134 OK!
+135 OK!
+136 OK!
+137 OK!
+138 OK!
+139 OK!
+140 OK!
+141 OK!
+142 OK!
+143 OK!
+144 OK!
+145 OK!
+146 OK!
+147 OK!
+148 OK!
+149 OK!
+150 OK!
+151 OK!
+152 OK!
+153 OK!
+154 OK!
+155 OK!
+156 OK!
+157 OK!
+158 OK!
+159 OK!
+160 OK!
+161 OK!
+162 OK!
+163 OK!
+164 OK!
+165 OK!
+166 OK!
+167 OK!
+168 OK!
+169 OK!
+170 OK!
+171 OK!
+172 OK!
+173 OK!
+174 OK!
+175 OK!
+176 OK!
+177 OK!
+178 OK!
+179 OK!
+180 OK!
+181 OK!
+182 OK!
+183 OK!
+184 OK!
+185 OK!
+186 OK!
+187 OK!
+188 OK!
+189 OK!
+190 OK!
+191 OK!
+192 OK!
+193 OK!
+194 OK!
+195 OK!
+196 OK!
+197 OK!
+198 OK!
+199 OK!
+200 OK!
+201 OK!
+202 OK!
+203 OK!
+204 OK!
+205 OK!
+206 OK!
+207 OK!
+208 OK!
+209 OK!
+210 OK!
+211 OK!
+212 OK!
+213 OK!
+214 OK!
+215 OK!
+216 OK!
+217 OK!
+218 OK!
+219 OK!
+220 OK!
+221 OK!
+222 OK!
+223 OK!
+224 OK!
+225 OK!
+226 OK!
+227 OK!
+228 OK!
+229 OK!
+230 OK!
+231 OK!
+232 OK!
+233 OK!
+234 OK!
+235 OK!
+236 OK!
+237 OK!
+238 OK!
+239 OK!
+240 OK!
+241 OK!
+242 OK!
+243 OK!
+244 OK!
+245 OK!
+246 OK!
+247 OK!
+248 OK!
+249 OK!
+250 OK!
+251 OK!
+252 OK!
+253 OK!
+254 OK!
+255 OK!
+256 OK!
+257 OK!
+258 OK!
+259 OK!
+260 OK!
+261 OK!
+262 OK!
+263 OK!
+264 OK!
+265 OK!
+266 OK!
+267 OK!
+268 OK!
+269 OK!
+270 OK!
+271 OK!
+272 OK!
+273 OK!
+274 OK!
+275 OK!
+276 OK!
+277 OK!
+278 OK!
+279 OK!
+280 OK!
+281 OK!
+282 OK!
+283 OK!
+284 OK!
+285 OK!
+286 OK!
+287 OK!
+288 OK!
+289 OK!
+290 OK!
+291 OK!
+292 OK!
+293 OK!
+294 OK!
+295 OK!
+296 OK!
+297 OK!
+298 OK!
+299 OK!
+300 OK!
+301 OK!
+302 OK!
+303 OK!
+304 OK!
+305 OK!
+306 OK!
+307 OK!
+308 OK!
+309 OK!
+310 OK!
+311 OK!
+312 OK!
+313 OK!
+314 OK!
+315 OK!
+316 OK!
+317 OK!
diff --git a/testsuite/tests/formats-transition/deprecated_unsigned_printers.ml b/testsuite/tests/formats-transition/deprecated_unsigned_printers.ml
new file mode 100644
index 00000000..21f4bf42
--- /dev/null
+++ b/testsuite/tests/formats-transition/deprecated_unsigned_printers.ml
@@ -0,0 +1,26 @@
+(* TEST
+   * toplevel
+*)
+
+(* %n, %l, %N and %L have a scanf-specific semantics, but are supposed
+   to be interpreted by Printf and Format as %u, despite this
+   interpretation being mildly deprecated *)
+
+let test format = (Printf.sprintf format (-3) : string)
+;;
+
+let () = Printf.printf "%%n: %B\n"
+  (test "%n" = test "%u")
+;;
+
+let () = Printf.printf "%%l: %B\n"
+  (test "%l" = test "%u")
+;;
+
+let () = Printf.printf "%%N: %B\n"
+  (test "%N" = test "%u")
+;;
+
+let () = Printf.printf "%%L: %B\n"
+  (test "%L" = test "%u")
+;;
diff --git a/testsuite/tests/formats-transition/deprecated_unsigned_printers.ocaml.reference b/testsuite/tests/formats-transition/deprecated_unsigned_printers.ocaml.reference
new file mode 100644
index 00000000..b5dbed86
--- /dev/null
+++ b/testsuite/tests/formats-transition/deprecated_unsigned_printers.ocaml.reference
@@ -0,0 +1,6 @@
+val test : (int -> string, unit, string) format -> string = <fun>
+%n: true
+%l: true
+%N: true
+%L: true
+
diff --git a/testsuite/tests/formats-transition/ignored_scan_counters.ml b/testsuite/tests/formats-transition/ignored_scan_counters.ml
new file mode 100644
index 00000000..bc625511
--- /dev/null
+++ b/testsuite/tests/formats-transition/ignored_scan_counters.ml
@@ -0,0 +1,37 @@
+(* TEST
+   * toplevel
+*)
+
+(* Benoit's patch did not support %_[nlNL]; test their behavior *)
+
+(* Ignore OCAMLRUNPARAM=b to be reproducible *)
+Printexc.record_backtrace false;;
+
+(* not supported by Printf or Format: fails at runtime *)
+let () = Printf.printf "%_n"
+;;
+let () = Printf.printf "%_N"
+;;
+let () = Printf.printf "%_l"
+;;
+let () = Printf.printf "%_L"
+;;
+
+let () = Format.printf "%_n"
+;;
+let () = Format.printf "%_N"
+;;
+let () = Format.printf "%_l"
+;;
+let () = Format.printf "%_L"
+;;
+
+(* identity for Scanf *)
+let () = print_endline (Scanf.sscanf "" "%_n" "Hello World!")
+;;
+let () = print_endline (Scanf.sscanf "" "%_N" "Hello World!")
+;;
+let () = print_endline (Scanf.sscanf "" "%_l" "Hello World!")
+;;
+let () = print_endline (Scanf.sscanf "" "%_L" "Hello World!")
+;;
diff --git a/testsuite/tests/formats-transition/ignored_scan_counters.ocaml.reference b/testsuite/tests/formats-transition/ignored_scan_counters.ocaml.reference
new file mode 100644
index 00000000..ed4c7550
--- /dev/null
+++ b/testsuite/tests/formats-transition/ignored_scan_counters.ocaml.reference
@@ -0,0 +1,14 @@
+- : unit = ()
+Exception: Invalid_argument "Printf: bad conversion %_".
+Exception: Invalid_argument "Printf: bad conversion %_".
+Exception: Invalid_argument "Printf: bad conversion %_".
+Exception: Invalid_argument "Printf: bad conversion %_".
+Exception: Invalid_argument "Printf: bad conversion %_".
+Exception: Invalid_argument "Printf: bad conversion %_".
+Exception: Invalid_argument "Printf: bad conversion %_".
+Exception: Invalid_argument "Printf: bad conversion %_".
+Hello World!
+Hello World!
+Hello World!
+Hello World!
+
diff --git a/testsuite/tests/formats-transition/legacy_incompatible_flags.ml b/testsuite/tests/formats-transition/legacy_incompatible_flags.ml
new file mode 100644
index 00000000..51397447
--- /dev/null
+++ b/testsuite/tests/formats-transition/legacy_incompatible_flags.ml
@@ -0,0 +1,24 @@
+(* TEST
+   * toplevel
+*)
+
+(* the legacy parser ignores flags on formatters on which they make no
+   sense *)
+
+let () = Printf.printf "%+s\n" "toto"
+;;
+let () = Printf.printf "%#s\n" "toto"
+;;
+let () = Printf.printf "% s\n" "toto"
+;;
+let () = Printf.printf "%03s\n" "toto"
+;;
+let () = Printf.printf "%03S\n" "toto"
+;;
+let () = Printf.printf "%.3s\n" "toto"
+;;
+
+(* it still fails on flags used with ignored formats (%_d, etc.),
+   but it's unclear how to test that in a backward-compatible way,
+   if we accept that the error message may have changed
+*)
diff --git a/testsuite/tests/formats-transition/legacy_incompatible_flags.ocaml.reference b/testsuite/tests/formats-transition/legacy_incompatible_flags.ocaml.reference
new file mode 100644
index 00000000..efc53ffe
--- /dev/null
+++ b/testsuite/tests/formats-transition/legacy_incompatible_flags.ocaml.reference
@@ -0,0 +1,7 @@
+toto
+toto
+toto
+toto
+"toto"
+toto
+
diff --git a/testsuite/tests/formats-transition/legacy_unfinished_modifiers.ml b/testsuite/tests/formats-transition/legacy_unfinished_modifiers.ml
new file mode 100644
index 00000000..73b433ea
--- /dev/null
+++ b/testsuite/tests/formats-transition/legacy_unfinished_modifiers.ml
@@ -0,0 +1,22 @@
+(* TEST
+   * toplevel
+*)
+
+(* test whether padding modifiers are accepted without any padding
+   size
+
+   the precision modifier is accepted without precision setting, but it
+   defaults to 0, which is not the same thing as not having precision:
+     %.0f 3.5 => 3
+     %.f 3.5 => 3
+     %f  3.5 => 3.5
+*)
+
+let () = Printf.printf "%0d\n" 3
+;;
+let () = Printf.printf "%-d\n" 3
+;;
+let () = Printf.printf "%.d\n" 3
+;;
+let () = Printf.printf "%.f\n" 3.
+;;
diff --git a/testsuite/tests/formats-transition/legacy_unfinished_modifiers.ocaml.reference b/testsuite/tests/formats-transition/legacy_unfinished_modifiers.ocaml.reference
new file mode 100644
index 00000000..37080a7e
--- /dev/null
+++ b/testsuite/tests/formats-transition/legacy_unfinished_modifiers.ocaml.reference
@@ -0,0 +1,5 @@
+3
+3
+3
+3
+
diff --git a/testsuite/tests/formatting/errors_batch.ml b/testsuite/tests/formatting/errors_batch.ml
new file mode 100644
index 00000000..abf4513d
--- /dev/null
+++ b/testsuite/tests/formatting/errors_batch.ml
@@ -0,0 +1,43 @@
+(* TEST
+   include ocamlcommon
+*)
+
+let () =
+  let open Location in
+  (* Some dummy locations for demo purposes *)
+  let pos = Lexing.{
+    pos_fname = "hello.ml";
+    pos_lnum = 18;
+    pos_bol = 15;
+    pos_cnum = 35;
+  } in
+  let loc1 = {
+    loc_start = pos; loc_end = { pos with pos_cnum = 42 };
+    loc_ghost = false
+  } in
+  let loc2 = {
+    loc_start = { pos with pos_lnum = 20; pos_bol = 0; pos_cnum = 4 };
+    loc_end = { pos with pos_lnum = 20; pos_bol = 0; pos_cnum = 8 };
+    loc_ghost = false
+  } in
+  let loc3 = {
+    loc_start = { pos with pos_lnum = 20; pos_bol = 0; pos_cnum = 6 };
+    loc_end = { pos with pos_lnum = 20; pos_bol = 0; pos_cnum = 8 };
+    loc_ghost = false
+  } in
+  let report = {
+    kind = Report_error;
+    main = msg ~loc:loc1 "%a" Format.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
+        "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.@]";
+    ]
+  } in
+  print_report Format.std_formatter report
diff --git a/testsuite/tests/formatting/errors_batch.reference b/testsuite/tests/formatting/errors_batch.reference
new file mode 100644
index 00000000..450693d8
--- /dev/null
+++ b/testsuite/tests/formatting/errors_batch.reference
@@ -0,0 +1,10 @@
+File "hello.ml", line 18, characters 20-27:
+Error: These are the contents of the main error message. It is very long and
+       should wrap across several lines.
+File "hello.ml", line 20, characters 4-8:
+  A located first sub-message.
+File "hello.ml", line 20, characters 6-8:
+  Longer sub-messages that do not fit on the same line as the location get
+  indented.
+  This second sub-message does not have a location;
+  ghost locations of submessages are not printed.
diff --git a/testsuite/tests/formatting/margins.ml b/testsuite/tests/formatting/margins.ml
new file mode 100644
index 00000000..03628889
--- /dev/null
+++ b/testsuite/tests/formatting/margins.ml
@@ -0,0 +1,12 @@
+(* TEST
+   * toplevel
+*)
+
+let () = Format.pp_set_margin Format.std_formatter 20;;
+
+1 + "foo";;
+
+let () = Format.pp_set_margin Format.std_formatter 80;;
+let () = Format.pp_set_max_indent Format.std_formatter 70;;
+
+1 + "foo";;
diff --git a/testsuite/tests/formatting/margins.ocaml.reference b/testsuite/tests/formatting/margins.ocaml.reference
new file mode 100644
index 00000000..0650bbcb
--- /dev/null
+++ b/testsuite/tests/formatting/margins.ocaml.reference
@@ -0,0 +1,13 @@
+Line 2, characters 4-9:
+2 | 1 + "foo";;
+        ^^^^^
+Error: This expression 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
+
diff --git a/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference b/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference
new file mode 100644
index 00000000..d5b96eb9
--- /dev/null
+++ b/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference
@@ -0,0 +1,176 @@
+[
+  structure_item (test_locations.ml[42,1260+0]..[44,1298+34])
+    Pstr_value Rec
+    [
+      <def>
+        pattern (test_locations.ml[42,1260+8]..[42,1260+11])
+          Ppat_var "fib" (test_locations.ml[42,1260+8]..[42,1260+11])
+        expression (test_locations.ml[42,1260+14]..[44,1298+34])
+          Pexp_function
+          [
+            <case>
+              pattern (test_locations.ml[43,1283+4]..[43,1283+9])
+                Ppat_or
+                pattern (test_locations.ml[43,1283+4]..[43,1283+5])
+                  Ppat_constant PConst_int (0,None)
+                pattern (test_locations.ml[43,1283+8]..[43,1283+9])
+                  Ppat_constant PConst_int (1,None)
+              expression (test_locations.ml[43,1283+13]..[43,1283+14])
+                Pexp_constant PConst_int (1,None)
+            <case>
+              pattern (test_locations.ml[44,1298+4]..[44,1298+5])
+                Ppat_var "n" (test_locations.ml[44,1298+4]..[44,1298+5])
+              expression (test_locations.ml[44,1298+9]..[44,1298+34])
+                Pexp_apply
+                expression (test_locations.ml[44,1298+21]..[44,1298+22])
+                  Pexp_ident "+" (test_locations.ml[44,1298+21]..[44,1298+22])
+                [
+                  <arg>
+                  Nolabel
+                    expression (test_locations.ml[44,1298+9]..[44,1298+20])
+                      Pexp_apply
+                      expression (test_locations.ml[44,1298+9]..[44,1298+12])
+                        Pexp_ident "fib" (test_locations.ml[44,1298+9]..[44,1298+12])
+                      [
+                        <arg>
+                        Nolabel
+                          expression (test_locations.ml[44,1298+13]..[44,1298+20])
+                            Pexp_apply
+                            expression (test_locations.ml[44,1298+16]..[44,1298+17])
+                              Pexp_ident "-" (test_locations.ml[44,1298+16]..[44,1298+17])
+                            [
+                              <arg>
+                              Nolabel
+                                expression (test_locations.ml[44,1298+14]..[44,1298+15])
+                                  Pexp_ident "n" (test_locations.ml[44,1298+14]..[44,1298+15])
+                              <arg>
+                              Nolabel
+                                expression (test_locations.ml[44,1298+18]..[44,1298+19])
+                                  Pexp_constant PConst_int (1,None)
+                            ]
+                      ]
+                  <arg>
+                  Nolabel
+                    expression (test_locations.ml[44,1298+23]..[44,1298+34])
+                      Pexp_apply
+                      expression (test_locations.ml[44,1298+23]..[44,1298+26])
+                        Pexp_ident "fib" (test_locations.ml[44,1298+23]..[44,1298+26])
+                      [
+                        <arg>
+                        Nolabel
+                          expression (test_locations.ml[44,1298+27]..[44,1298+34])
+                            Pexp_apply
+                            expression (test_locations.ml[44,1298+30]..[44,1298+31])
+                              Pexp_ident "-" (test_locations.ml[44,1298+30]..[44,1298+31])
+                            [
+                              <arg>
+                              Nolabel
+                                expression (test_locations.ml[44,1298+28]..[44,1298+29])
+                                  Pexp_ident "n" (test_locations.ml[44,1298+28]..[44,1298+29])
+                              <arg>
+                              Nolabel
+                                expression (test_locations.ml[44,1298+32]..[44,1298+33])
+                                  Pexp_constant PConst_int (2,None)
+                            ]
+                      ]
+                ]
+          ]
+    ]
+]
+
+let rec fib = function | 0|1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
+[
+  structure_item (test_locations.ml[42,1260+0]..test_locations.ml[44,1298+34])
+    Tstr_value Rec
+    [
+      <def>
+        pattern (test_locations.ml[42,1260+8]..test_locations.ml[42,1260+11])
+          Tpat_var "fib/80"
+        expression (test_locations.ml[42,1260+14]..test_locations.ml[44,1298+34])
+          Texp_function
+          Nolabel
+          [
+            <case>
+              pattern (test_locations.ml[43,1283+4]..test_locations.ml[43,1283+9])
+                Tpat_or
+                pattern (test_locations.ml[43,1283+4]..test_locations.ml[43,1283+5])
+                  Tpat_constant Const_int 0
+                pattern (test_locations.ml[43,1283+8]..test_locations.ml[43,1283+9])
+                  Tpat_constant Const_int 1
+              expression (test_locations.ml[43,1283+13]..test_locations.ml[43,1283+14])
+                Texp_constant Const_int 1
+            <case>
+              pattern (test_locations.ml[44,1298+4]..test_locations.ml[44,1298+5])
+                Tpat_var "n/81"
+              expression (test_locations.ml[44,1298+9]..test_locations.ml[44,1298+34])
+                Texp_apply
+                expression (test_locations.ml[44,1298+21]..test_locations.ml[44,1298+22])
+                  Texp_ident "Stdlib!.+"
+                [
+                  <arg>
+                    Nolabel
+                    expression (test_locations.ml[44,1298+9]..test_locations.ml[44,1298+20])
+                      Texp_apply
+                      expression (test_locations.ml[44,1298+9]..test_locations.ml[44,1298+12])
+                        Texp_ident "fib/80"
+                      [
+                        <arg>
+                          Nolabel
+                          expression (test_locations.ml[44,1298+13]..test_locations.ml[44,1298+20])
+                            Texp_apply
+                            expression (test_locations.ml[44,1298+16]..test_locations.ml[44,1298+17])
+                              Texp_ident "Stdlib!.-"
+                            [
+                              <arg>
+                                Nolabel
+                                expression (test_locations.ml[44,1298+14]..test_locations.ml[44,1298+15])
+                                  Texp_ident "n/81"
+                              <arg>
+                                Nolabel
+                                expression (test_locations.ml[44,1298+18]..test_locations.ml[44,1298+19])
+                                  Texp_constant Const_int 1
+                            ]
+                      ]
+                  <arg>
+                    Nolabel
+                    expression (test_locations.ml[44,1298+23]..test_locations.ml[44,1298+34])
+                      Texp_apply
+                      expression (test_locations.ml[44,1298+23]..test_locations.ml[44,1298+26])
+                        Texp_ident "fib/80"
+                      [
+                        <arg>
+                          Nolabel
+                          expression (test_locations.ml[44,1298+27]..test_locations.ml[44,1298+34])
+                            Texp_apply
+                            expression (test_locations.ml[44,1298+30]..test_locations.ml[44,1298+31])
+                              Texp_ident "Stdlib!.-"
+                            [
+                              <arg>
+                                Nolabel
+                                expression (test_locations.ml[44,1298+28]..test_locations.ml[44,1298+29])
+                                  Texp_ident "n/81"
+                              <arg>
+                                Nolabel
+                                expression (test_locations.ml[44,1298+32]..test_locations.ml[44,1298+33])
+                                  Texp_constant Const_int 2
+                            ]
+                      ]
+                ]
+          ]
+    ]
+]
+
+(setglobal Test_locations!
+  (letrec
+    (fib/80
+       (function n/81[int] : int
+         (funct-body Test_locations.fib test_locations.ml(42):1274-1332
+           (if (isout 1 n/81)
+             (before Test_locations.fib test_locations.ml(44):1307-1332
+               (+
+                 (after Test_locations.fib test_locations.ml(44):1307-1318
+                   (apply fib/80 (- n/81 1)))
+                 (after Test_locations.fib test_locations.ml(44):1321-1332
+                   (apply fib/80 (- n/81 2)))))
+             (before Test_locations.fib test_locations.ml(43):1296-1297 1)))))
+    (pseudo <unknown location> (makeblock 0 fib/80))))
diff --git a/testsuite/tests/formatting/test_locations.dlocations.ocamlopt.clambda.reference b/testsuite/tests/formatting/test_locations.dlocations.ocamlopt.clambda.reference
new file mode 100644
index 00000000..04e12174
--- /dev/null
+++ b/testsuite/tests/formatting/test_locations.dlocations.ocamlopt.clambda.reference
@@ -0,0 +1,31 @@
+
+cmm:
+(data)
+(data
+ int 3063
+ "camlTest_locations__1":
+ addr "camlTest_locations__fib_80"
+ int 3)
+(data int 1792 global "camlTest_locations" "camlTest_locations": int 1)
+(data
+ global "camlTest_locations__gc_roots"
+ "camlTest_locations__gc_roots":
+ addr "camlTest_locations"
+ int 0)
+(function{test_locations.ml:42,14-72} camlTest_locations__fib_80 (n/81: val)
+ (if (<a 3 n/81)
+   (+
+     (+
+       (app{test_locations.ml:44,9-20} "camlTest_locations__fib_80"
+         (+ n/81 -2) val)
+       (app{test_locations.ml:44,23-34} "camlTest_locations__fib_80"
+         (+ n/81 -4) val))
+     -1)
+   3))
+
+(function camlTest_locations__entry ()
+ (let clos/84 "camlTest_locations__1"
+   (store val(root-init) "camlTest_locations" clos/84))
+ 1a)
+
+(data)
diff --git a/testsuite/tests/formatting/test_locations.dlocations.ocamlopt.flambda.reference b/testsuite/tests/formatting/test_locations.dlocations.ocamlopt.flambda.reference
new file mode 100644
index 00000000..99aa1891
--- /dev/null
+++ b/testsuite/tests/formatting/test_locations.dlocations.ocamlopt.flambda.reference
@@ -0,0 +1,38 @@
+
+cmm:
+(data)
+(data
+ int 3063
+ global "camlTest_locations__set_of_closures_29"
+ "camlTest_locations__set_of_closures_29":
+ global "camlTest_locations__fib_5_closure"
+ "camlTest_locations__fib_5_closure":
+ addr "camlTest_locations__fib_5"
+ int 3)
+(data
+ global "camlTest_locations__gc_roots"
+ "camlTest_locations__gc_roots":
+ int 0)
+(function{test_locations.ml:42,14-72} camlTest_locations__fib_5 (n/84: val)
+ (if (<a 3 n/84)
+   (let
+     Paddint_arg/91
+       (app{test_locations.ml:44,23-34} "camlTest_locations__fib_5"
+         (+ n/84 -4) val)
+     (+
+       (+
+         (app{test_locations.ml:44,9-20} "camlTest_locations__fib_5"
+           (+ n/84 -2) val)
+         Paddint_arg/91)
+       -1))
+   3))
+
+(data
+ int 1792
+ global "camlTest_locations"
+ "camlTest_locations":
+ addr "camlTest_locations__fib_5_closure")
+(data)
+(function camlTest_locations__entry () 1a)
+
+(data)
diff --git a/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference b/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference
new file mode 100644
index 00000000..8def6a35
--- /dev/null
+++ b/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference
@@ -0,0 +1,169 @@
+[
+  structure_item 
+    Pstr_value Rec
+    [
+      <def>
+        pattern 
+          Ppat_var "fib" 
+        expression 
+          Pexp_function
+          [
+            <case>
+              pattern 
+                Ppat_or
+                pattern 
+                  Ppat_constant PConst_int (0,None)
+                pattern 
+                  Ppat_constant PConst_int (1,None)
+              expression 
+                Pexp_constant PConst_int (1,None)
+            <case>
+              pattern 
+                Ppat_var "n" 
+              expression 
+                Pexp_apply
+                expression 
+                  Pexp_ident "+" 
+                [
+                  <arg>
+                  Nolabel
+                    expression 
+                      Pexp_apply
+                      expression 
+                        Pexp_ident "fib" 
+                      [
+                        <arg>
+                        Nolabel
+                          expression 
+                            Pexp_apply
+                            expression 
+                              Pexp_ident "-" 
+                            [
+                              <arg>
+                              Nolabel
+                                expression 
+                                  Pexp_ident "n" 
+                              <arg>
+                              Nolabel
+                                expression 
+                                  Pexp_constant PConst_int (1,None)
+                            ]
+                      ]
+                  <arg>
+                  Nolabel
+                    expression 
+                      Pexp_apply
+                      expression 
+                        Pexp_ident "fib" 
+                      [
+                        <arg>
+                        Nolabel
+                          expression 
+                            Pexp_apply
+                            expression 
+                              Pexp_ident "-" 
+                            [
+                              <arg>
+                              Nolabel
+                                expression 
+                                  Pexp_ident "n" 
+                              <arg>
+                              Nolabel
+                                expression 
+                                  Pexp_constant PConst_int (2,None)
+                            ]
+                      ]
+                ]
+          ]
+    ]
+]
+
+let rec fib = function | 0|1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
+[
+  structure_item 
+    Tstr_value Rec
+    [
+      <def>
+        pattern 
+          Tpat_var "fib/80"
+        expression 
+          Texp_function
+          Nolabel
+          [
+            <case>
+              pattern 
+                Tpat_or
+                pattern 
+                  Tpat_constant Const_int 0
+                pattern 
+                  Tpat_constant Const_int 1
+              expression 
+                Texp_constant Const_int 1
+            <case>
+              pattern 
+                Tpat_var "n/81"
+              expression 
+                Texp_apply
+                expression 
+                  Texp_ident "Stdlib!.+"
+                [
+                  <arg>
+                    Nolabel
+                    expression 
+                      Texp_apply
+                      expression 
+                        Texp_ident "fib/80"
+                      [
+                        <arg>
+                          Nolabel
+                          expression 
+                            Texp_apply
+                            expression 
+                              Texp_ident "Stdlib!.-"
+                            [
+                              <arg>
+                                Nolabel
+                                expression 
+                                  Texp_ident "n/81"
+                              <arg>
+                                Nolabel
+                                expression 
+                                  Texp_constant Const_int 1
+                            ]
+                      ]
+                  <arg>
+                    Nolabel
+                    expression 
+                      Texp_apply
+                      expression 
+                        Texp_ident "fib/80"
+                      [
+                        <arg>
+                          Nolabel
+                          expression 
+                            Texp_apply
+                            expression 
+                              Texp_ident "Stdlib!.-"
+                            [
+                              <arg>
+                                Nolabel
+                                expression 
+                                  Texp_ident "n/81"
+                              <arg>
+                                Nolabel
+                                expression 
+                                  Texp_constant Const_int 2
+                            ]
+                      ]
+                ]
+          ]
+    ]
+]
+
+(setglobal Test_locations!
+  (letrec
+    (fib/80
+       (function n/81[int] : int
+         (if (isout 1 n/81)
+           (+ (apply fib/80 (- n/81 1)) (apply fib/80 (- n/81 2))) 1)))
+    (makeblock 0 fib/80)))
diff --git a/testsuite/tests/formatting/test_locations.dno-locations.ocamlopt.clambda.reference b/testsuite/tests/formatting/test_locations.dno-locations.ocamlopt.clambda.reference
new file mode 100644
index 00000000..983555b6
--- /dev/null
+++ b/testsuite/tests/formatting/test_locations.dno-locations.ocamlopt.clambda.reference
@@ -0,0 +1,28 @@
+
+cmm:
+(data)
+(data
+ int 3063
+ "camlTest_locations__1":
+ addr "camlTest_locations__fib_80"
+ int 3)
+(data int 1792 global "camlTest_locations" "camlTest_locations": int 1)
+(data
+ global "camlTest_locations__gc_roots"
+ "camlTest_locations__gc_roots":
+ addr "camlTest_locations"
+ int 0)
+(function camlTest_locations__fib_80 (n/81: val)
+ (if (<a 3 n/81)
+   (+
+     (+ (app "camlTest_locations__fib_80" (+ n/81 -2) val)
+       (app "camlTest_locations__fib_80" (+ n/81 -4) val))
+     -1)
+   3))
+
+(function camlTest_locations__entry ()
+ (let clos/84 "camlTest_locations__1"
+   (store val(root-init) "camlTest_locations" clos/84))
+ 1a)
+
+(data)
diff --git a/testsuite/tests/formatting/test_locations.dno-locations.ocamlopt.flambda.reference b/testsuite/tests/formatting/test_locations.dno-locations.ocamlopt.flambda.reference
new file mode 100644
index 00000000..c9c578ff
--- /dev/null
+++ b/testsuite/tests/formatting/test_locations.dno-locations.ocamlopt.flambda.reference
@@ -0,0 +1,31 @@
+
+cmm:
+(data)
+(data
+ int 3063
+ global "camlTest_locations__set_of_closures_29"
+ "camlTest_locations__set_of_closures_29":
+ global "camlTest_locations__fib_5_closure"
+ "camlTest_locations__fib_5_closure":
+ addr "camlTest_locations__fib_5"
+ int 3)
+(data
+ global "camlTest_locations__gc_roots"
+ "camlTest_locations__gc_roots":
+ int 0)
+(function camlTest_locations__fib_5 (n/84: val)
+ (if (<a 3 n/84)
+   (let Paddint_arg/91 (app "camlTest_locations__fib_5" (+ n/84 -4) val)
+     (+ (+ (app "camlTest_locations__fib_5" (+ n/84 -2) val) Paddint_arg/91)
+       -1))
+   3))
+
+(data
+ int 1792
+ global "camlTest_locations"
+ "camlTest_locations":
+ addr "camlTest_locations__fib_5_closure")
+(data)
+(function camlTest_locations__entry () 1a)
+
+(data)
diff --git a/testsuite/tests/formatting/test_locations.ml b/testsuite/tests/formatting/test_locations.ml
new file mode 100644
index 00000000..6accde32
--- /dev/null
+++ b/testsuite/tests/formatting/test_locations.ml
@@ -0,0 +1,45 @@
+(* TEST
+compile_only="true"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+flags="-g -dno-locations -dsource -dparsetree -dtypedtree -dlambda"
+*** check-ocamlc.byte-output
+compiler_reference =
+  "${test_source_directory}/test_locations.dno-locations.ocamlc.reference"
+
+* setup-ocamlopt.byte-build-env
+** ocamlopt.byte
+flags="-g -dno-locations -dcmm"
+*** no-flambda
+**** check-ocamlopt.byte-output
+compiler_reference =
+  "${test_source_directory}/test_locations.dno-locations.ocamlopt.clambda.reference"
+*** flambda
+**** check-ocamlc.byte-output
+compiler_reference =
+  "${test_source_directory}/test_locations.dno-locations.ocamlopt.flambda.reference"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+flags="-g -dlocations -dsource -dparsetree -dtypedtree -dlambda"
+*** check-ocamlc.byte-output
+compiler_reference =
+  "${test_source_directory}/test_locations.dlocations.ocamlc.reference"
+
+* setup-ocamlopt.byte-build-env
+** ocamlopt.byte
+flags="-g -dlocations -dcmm"
+*** no-flambda
+**** check-ocamlopt.byte-output
+compiler_reference =
+  "${test_source_directory}/test_locations.dlocations.ocamlopt.clambda.reference"
+*** flambda
+**** check-ocamlc.byte-output
+compiler_reference =
+  "${test_source_directory}/test_locations.dlocations.ocamlopt.flambda.reference"
+*)
+let rec fib = function
+  | 0 | 1 -> 1
+  | n -> fib (n - 1) + fib (n - 2)
+;;
diff --git a/testsuite/tests/functors/functors.compilers.reference b/testsuite/tests/functors/functors.compilers.reference
new file mode 100644
index 00000000..a3ae39de
--- /dev/null
+++ b/testsuite/tests/functors/functors.compilers.reference
@@ -0,0 +1,56 @@
+(setglobal Functors!
+  (let
+    (O =
+       (module-defn(O) Functors functors.ml(12):184-279
+         (function X is_a_functor always_inline
+           (let
+             (cow = (function x[int] : int (apply (field 0 X) x))
+              sheep = (function x[int] : int (+ 1 (apply cow x))))
+             (makeblock 0 cow sheep))))
+     F =
+       (module-defn(F) Functors functors.ml(17):281-392
+         (function X Y is_a_functor always_inline
+           (let
+             (cow =
+                (function x[int] : int
+                  (apply (field 0 Y) (apply (field 0 X) x)))
+              sheep = (function x[int] : int (+ 1 (apply cow x))))
+             (makeblock 0 cow sheep))))
+     F1 =
+       (module-defn(F1) Functors functors.ml(31):516-632
+         (function X Y is_a_functor always_inline
+           (let
+             (sheep =
+                (function x[int] : int
+                  (+ 1 (apply (field 0 Y) (apply (field 0 X) x)))))
+             (makeblock 0 sheep))))
+     F2 =
+       (module-defn(F2) Functors functors.ml(36):634-784
+         (function X Y is_a_functor always_inline
+           (let
+             (X =a (makeblock 0 (field 1 X))
+              Y =a (makeblock 0 (field 1 Y))
+              sheep =
+                (function x[int] : int
+                  (+ 1 (apply (field 0 Y) (apply (field 0 X) x)))))
+             (makeblock 0 sheep))))
+     M =
+       (module-defn(M) Functors functors.ml(41):786-970
+         (let
+           (F =
+              (module-defn(F) Functors.M functors.ml(44):849-966
+                (function X Y is_a_functor always_inline
+                  (let
+                    (cow =
+                       (function x[int] : int
+                         (apply (field 0 Y) (apply (field 0 X) x)))
+                     sheep = (function x[int] : int (+ 1 (apply cow x))))
+                    (makeblock 0 cow sheep)))))
+           (makeblock 0
+             (function funarg funarg is_a_functor stub
+               (let
+                 (let =
+                    (apply F (makeblock 0 (field 1 funarg))
+                      (makeblock 0 (field 1 funarg))))
+                 (makeblock 0 (field 1 let))))))))
+    (makeblock 0 O F F1 F2 M)))
diff --git a/testsuite/tests/functors/functors.ml b/testsuite/tests/functors/functors.ml
new file mode 100644
index 00000000..3e40fc61
--- /dev/null
+++ b/testsuite/tests/functors/functors.ml
@@ -0,0 +1,48 @@
+(* TEST
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+      flags = "-dlambda -dno-unique-ids"
+   *** check-ocamlc.byte-output
+*)
+
+module type S = sig
+  val foo : int -> int
+end
+
+module O (X : S) = struct
+  let cow x = X.foo x
+  let sheep x = 1 + cow x
+end [@@inline always]
+
+module F (X : S) (Y : S) = struct
+  let cow x = Y.foo (X.foo x)
+  let sheep x = 1 + cow x
+end [@@inline always]
+
+module type S1 = sig
+  val bar : int -> int
+  val foo : int -> int
+end
+
+module type T = sig
+  val sheep : int -> int
+end
+
+module F1 (X : S) (Y : S) : T = struct
+  let cow x = Y.foo (X.foo x)
+  let sheep x = 1 + cow x
+end [@@inline always]
+
+module F2 : S1 -> S1 -> T = functor (X : S) -> functor (Y : S) -> struct
+  let cow x = Y.foo (X.foo x)
+  let sheep x = 1 + cow x
+end [@@inline always]
+
+module M : sig
+  module F (X : S1) (Y : S1) : T
+end = struct
+  module F (X : S) (Y : S) = struct
+    let cow x = Y.foo (X.foo x)
+    let sheep x = 1 + cow x
+  end [@@inline always]
+end
diff --git a/testsuite/tests/gc-roots/globroots.ml b/testsuite/tests/gc-roots/globroots.ml
new file mode 100644
index 00000000..43d93e3f
--- /dev/null
+++ b/testsuite/tests/gc-roots/globroots.ml
@@ -0,0 +1,92 @@
+(* TEST
+   flags += " -w a "
+   modules = "globrootsprim.c"
+*)
+
+module type GLOBREF = sig
+  type t
+  val register: string -> t
+  val get: t -> string
+  val set: t -> string -> unit
+  val remove: t -> unit
+end
+
+module Classic : GLOBREF = struct
+  type t
+  external register: string -> t = "gb_classic_register"
+  external get: t -> string = "gb_get"
+  external set: t -> string -> unit = "gb_classic_set"
+  external remove: t -> unit = "gb_classic_remove"
+end
+
+module Generational : GLOBREF = struct
+  type t
+  external register: string -> t = "gb_generational_register"
+  external get: t -> string = "gb_get"
+  external set: t -> string -> unit = "gb_generational_set"
+  external remove: t -> unit = "gb_generational_remove"
+end
+
+module Test(G: GLOBREF) = struct
+
+  let size = 1024
+
+  let vals = Array.init size Int.to_string
+
+  let a = Array.init size (fun i -> G.register (Int.to_string i))
+
+  let check () =
+    for i = 0 to size - 1 do
+      if G.get a.(i) <> vals.(i) then begin
+        print_string "Error on "; print_int i; print_string ": ";
+        print_string (String.escaped (G.get a.(i))); print_newline()
+      end
+    done
+
+  let change () =
+    match Random.int 37 with
+    | 0 ->
+        Gc.full_major()
+    | 1|2|3|4 ->
+        Gc.minor()
+    | 5|6|7|8|9|10|11|12 ->             (* update with young value *)
+        let i = Random.int size in
+        G.set a.(i) (Int.to_string i)
+    | 13|14|15|16|17|18|19|20 ->        (* update with old value *)
+        let i = Random.int size in
+        G.set a.(i) vals.(i)
+    | 21|22|23|24|25|26|27|28 ->        (* re-register young value *)
+        let i = Random.int size in
+        G.remove a.(i);
+        a.(i) <- G.register (Int.to_string i)
+    | (*29|30|31|32|33|34|35|36*) _ ->  (* re-register old value *)
+        let i = Random.int size in
+        G.remove a.(i);
+        a.(i) <- G.register vals.(i)
+
+  let test n =
+    for i = 1 to n do
+      change();
+      print_string "."; flush stdout
+    done
+end
+
+module TestClassic = Test(Classic)
+module TestGenerational = Test(Generational)
+
+external young2old : unit -> unit = "gb_young2old"
+let _ = young2old (); Gc.full_major ()
+
+external static2young : int * int -> (unit -> unit) -> int = "gb_static2young"
+let _ =
+  assert (static2young (1, 1) Gc.full_major == 0x42)
+
+let _ =
+  let n =
+    if Array.length Sys.argv < 2 then 10000 else int_of_string Sys.argv.(1) in
+  print_string "Non-generational API\n";
+  TestClassic.test n;
+  print_newline();
+  print_string "Generational API\n";
+  TestGenerational.test n;
+  print_newline()
diff --git a/testsuite/tests/gc-roots/globroots.reference b/testsuite/tests/gc-roots/globroots.reference
new file mode 100644
index 00000000..aae90b22
--- /dev/null
+++ b/testsuite/tests/gc-roots/globroots.reference
@@ -0,0 +1,4 @@
+Non-generational API
+................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................
+Generational API
+................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................
diff --git a/testsuite/tests/gc-roots/globrootsprim.c b/testsuite/tests/gc-roots/globrootsprim.c
new file mode 100644
index 00000000..0eb777b0
--- /dev/null
+++ b/testsuite/tests/gc-roots/globrootsprim.c
@@ -0,0 +1,113 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 2001 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License, with    */
+/*  the special exception on linking described in file ../LICENSE.     */
+/*                                                                     */
+/***********************************************************************/
+
+/* For testing global root registration */
+
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+#include "caml/alloc.h"
+#include "caml/gc.h"
+#include "caml/callback.h"
+
+struct block { value header; value v; };
+
+#define Block_val(v) ((struct block*) &((value*) v)[-1])
+#define Val_block(b) ((value) &((b)->v))
+
+value gb_get(value vblock)
+{
+  return Block_val(vblock)->v;
+}
+
+value gb_classic_register(value v)
+{
+  struct block * b = caml_stat_alloc(sizeof(struct block));
+  b->header = Make_header(1, 0, Caml_black);
+  b->v = v;
+  caml_register_global_root(&(b->v));
+  return Val_block(b);
+}
+
+value gb_classic_set(value vblock, value newval)
+{
+  Block_val(vblock)->v = newval;
+  return Val_unit;
+}
+
+value gb_classic_remove(value vblock)
+{
+  caml_remove_global_root(&(Block_val(vblock)->v));
+  return Val_unit;
+}
+
+value gb_generational_register(value v)
+{
+  struct block * b = caml_stat_alloc(sizeof(struct block));
+  b->header = Make_header(1, 0, Caml_black);
+  b->v = v;
+  caml_register_generational_global_root(&(b->v));
+  return Val_block(b);
+}
+
+value gb_generational_set(value vblock, value newval)
+{
+  caml_modify_generational_global_root(&(Block_val(vblock)->v), newval);
+  return Val_unit;
+}
+
+value gb_generational_remove(value vblock)
+{
+  caml_remove_generational_global_root(&(Block_val(vblock)->v));
+  return Val_unit;
+}
+
+value root;
+
+value gb_young2old(value _dummy) {
+  root = caml_alloc_small(1, 0);
+  caml_register_generational_global_root(&root);
+  caml_modify_generational_global_root(&root, caml_alloc_shr(10, String_tag));
+  Field(root, 0) = 0xFFFFFFFF;
+  caml_remove_generational_global_root(&root);
+  root += sizeof(value);
+  return Val_unit;
+}
+
+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);
+
+  /* Write a static value in the root. */
+  caml_modify_generational_global_root(&root, static_value);
+
+  /* Overwrite it with a young value. */
+  v = caml_alloc_small(1, 0);
+  Field(v, 0) = Val_long(0x42);
+  caml_modify_generational_global_root(&root, v);
+
+  /* Promote the young value */
+  caml_callback(full_major, Val_unit);
+
+  /* Fill the minor heap to make sure the old block is overwritten */
+  for(i = 0; i < 1000000; i++)
+    caml_alloc_small(1, 0);
+
+  v = Field(root, 0);
+  caml_remove_generational_global_root(&root);
+
+  CAMLreturn(v);
+}
diff --git a/testsuite/tests/generalized-open/accepted_batch.ml b/testsuite/tests/generalized-open/accepted_batch.ml
new file mode 100644
index 00000000..7c82a76c
--- /dev/null
+++ b/testsuite/tests/generalized-open/accepted_batch.ml
@@ -0,0 +1,34 @@
+(* TEST *)
+
+open Set.Make(String)
+
+let e = empty
+
+open struct
+  let x = singleton "hidden"
+end
+
+let () = iter print_endline (union x (of_list ["a"; "b"]))
+
+let f =
+  let open Set.Make(Int32) in
+  let e2 = empty in
+  let open struct
+    let y = 3
+  end in
+  (e, e2, y)
+
+module type S = sig
+  open Set.Make(Bool)
+
+  type nonrec t = t
+end
+
+let hd _ = ()
+
+open (List : sig val map : ('a -> 'b) -> 'a list -> 'b list end)
+
+let l =
+  hd (map succ [0; 1; 2; 3])
+
+let y = map succ []
diff --git a/testsuite/tests/generalized-open/accepted_batch.reference b/testsuite/tests/generalized-open/accepted_batch.reference
new file mode 100644
index 00000000..9c224025
--- /dev/null
+++ b/testsuite/tests/generalized-open/accepted_batch.reference
@@ -0,0 +1,3 @@
+a
+b
+hidden
diff --git a/testsuite/tests/generalized-open/accepted_expect.ml b/testsuite/tests/generalized-open/accepted_expect.ml
new file mode 100644
index 00000000..d4b5ddcb
--- /dev/null
+++ b/testsuite/tests/generalized-open/accepted_expect.ml
@@ -0,0 +1,108 @@
+(* TEST
+   * expect
+*)
+
+open Set.Make(String);;
+[%%expect{|
+type elt = String.t
+type t = Set.Make(String).t
+val empty : t = <abstr>
+val is_empty : t -> bool = <fun>
+val mem : elt -> t -> bool = <fun>
+val add : elt -> t -> t = <fun>
+val singleton : elt -> t = <fun>
+val remove : elt -> t -> t = <fun>
+val union : t -> t -> t = <fun>
+val inter : t -> t -> t = <fun>
+val disjoint : t -> t -> bool = <fun>
+val diff : t -> t -> t = <fun>
+val compare : t -> t -> int = <fun>
+val equal : t -> t -> bool = <fun>
+val subset : t -> t -> bool = <fun>
+val iter : (elt -> unit) -> t -> unit = <fun>
+val map : (elt -> elt) -> t -> t = <fun>
+val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a = <fun>
+val for_all : (elt -> bool) -> t -> bool = <fun>
+val exists : (elt -> bool) -> t -> bool = <fun>
+val filter : (elt -> bool) -> t -> t = <fun>
+val filter_map : (elt -> elt option) -> t -> t = <fun>
+val partition : (elt -> bool) -> t -> t * t = <fun>
+val cardinal : t -> int = <fun>
+val elements : t -> elt list = <fun>
+val min_elt : t -> elt = <fun>
+val min_elt_opt : t -> elt option = <fun>
+val max_elt : t -> elt = <fun>
+val max_elt_opt : t -> elt option = <fun>
+val choose : t -> elt = <fun>
+val choose_opt : t -> elt option = <fun>
+val split : elt -> t -> t * bool * t = <fun>
+val find : elt -> t -> elt = <fun>
+val find_opt : elt -> t -> elt option = <fun>
+val find_first : (elt -> bool) -> t -> elt = <fun>
+val find_first_opt : (elt -> bool) -> t -> elt option = <fun>
+val find_last : (elt -> bool) -> t -> elt = <fun>
+val find_last_opt : (elt -> bool) -> t -> elt option = <fun>
+val of_list : elt list -> t = <fun>
+val to_seq_from : elt -> t -> elt Seq.t = <fun>
+val to_seq : t -> elt Seq.t = <fun>
+val add_seq : elt Seq.t -> t -> t = <fun>
+val of_seq : elt Seq.t -> t = <fun>
+|}]
+
+let e = empty;;
+[%%expect{|
+val e : t = <abstr>
+|}]
+
+open struct
+  let x = singleton "hidden"
+end;;
+[%%expect{|
+val x : t = <abstr>
+|}];;
+
+elements (union x (of_list ["a"; "b"]));;
+[%%expect{|
+- : elt list = ["a"; "b"; "hidden"]
+|}]
+
+let f =
+  let open Set.Make(Int32) in
+  let e2 = empty in
+  let open struct
+    let y = 3
+  end in
+  (e, e2, y);;
+[%%expect{|
+val f : t * Set.Make(Int32).t * int = (<abstr>, <abstr>, 3)
+|}]
+
+module type S = sig
+  open Set.Make(Bool)
+
+  type nonrec t = t
+end;;
+[%%expect{|
+module type S = sig type nonrec t = Set.Make(Bool).t end
+|}]
+
+let hd _ = ();;
+[%%expect{|
+val hd : 'a -> unit = <fun>
+|}]
+
+open (List : sig val map : ('a -> 'b) -> 'a list -> 'b list end);;
+[%%expect{|
+val map : ('a -> 'b) -> 'a list -> 'b list = <fun>
+|}]
+
+let l = map succ [0;1;2;3]
+let () = hd l;;
+[%%expect{|
+val l : int list = [1; 2; 3; 4]
+|}]
+
+let y = map succ [];;
+[%%expect{|
+val y : int list = []
+|}]
diff --git a/testsuite/tests/generalized-open/clambda_optim.ml b/testsuite/tests/generalized-open/clambda_optim.ml
new file mode 100644
index 00000000..d7ca317e
--- /dev/null
+++ b/testsuite/tests/generalized-open/clambda_optim.ml
@@ -0,0 +1,15 @@
+(* TEST
+
+compile_only = "true"
+
+* no-flambda
+** setup-ocamlopt.byte-build-env
+*** ocamlopt.byte
+**** check-ocamlopt.byte-output
+
+*)
+
+module Stable = struct
+  open struct module V0 = struct module U = struct end end end
+  module V0 = V0.U
+end
diff --git a/testsuite/tests/generalized-open/expansiveness.ml b/testsuite/tests/generalized-open/expansiveness.ml
new file mode 100644
index 00000000..b2a55012
--- /dev/null
+++ b/testsuite/tests/generalized-open/expansiveness.ml
@@ -0,0 +1,93 @@
+(* TEST
+   * expect
+*)
+
+module Fn = struct
+  let id x = x
+end
+;;
+[%%expect{|
+module Fn : sig val id : 'a -> 'a end
+|}]
+
+let f = fun x -> Fn.id x
+;;
+[%%expect{|
+val f : 'a -> 'a = <fun>
+|}]
+
+let g = Fn.(fun x -> id x)
+let h = let open Fn in fun x -> id x
+;;
+[%%expect{|
+val g : 'a -> 'a = <fun>
+val h : 'a -> 'a = <fun>
+|}]
+
+let i =
+  let open struct
+    let id x = x
+  end in
+  fun x -> id x
+
+let iM =
+  let module M = struct
+    let id x = x
+  end in
+  fun x -> M.id x
+;;
+[%%expect{|
+val i : 'a -> 'a = <fun>
+val iM : 'a -> 'a = <fun>
+|}]
+
+let j =
+  let open struct
+    exception E
+    let id x = x
+  end in
+  fun x -> id x
+
+let jM =
+  let module M = struct
+    exception E
+    let id x = x
+  end in
+  fun x -> M.id x
+;;
+[%%expect{|
+val j : '_weak1 -> '_weak1 = <fun>
+val jM : '_weak2 -> '_weak2 = <fun>
+|}]
+
+module Square(X : sig val x : int end) = struct
+  let result = X.x * X.x
+end
+;;
+[%%expect{|
+module Square : functor (X : sig val x : int end) -> sig val result : int end
+|}]
+
+let k =
+  let open Square(struct let x = 3 end) in
+  fun x -> x
+
+let kM =
+  let module M = Square(struct let x = 3 end) in
+  fun x -> x
+;;
+[%%expect{|
+val k : '_weak3 -> '_weak3 = <fun>
+val kM : '_weak4 -> '_weak4 = <fun>
+|}]
+
+let op =
+  let module M = struct
+      open struct let r = ref [] end
+      let s = r
+  end in
+  M.s
+;;
+[%%expect{|
+val op : '_weak5 list ref = {contents = []}
+|}]
diff --git a/testsuite/tests/generalized-open/funct_body.compilers.reference b/testsuite/tests/generalized-open/funct_body.compilers.reference
new file mode 100644
index 00000000..316b98a6
--- /dev/null
+++ b/testsuite/tests/generalized-open/funct_body.compilers.reference
@@ -0,0 +1,5 @@
+File "funct_body.ml", line 30, characters 12-20:
+30 |     include (val !r)
+                 ^^^^^^^^
+Error: This expression creates fresh types.
+       It is not allowed inside applicative functors.
diff --git a/testsuite/tests/generalized-open/funct_body.ml b/testsuite/tests/generalized-open/funct_body.ml
new file mode 100644
index 00000000..4490f773
--- /dev/null
+++ b/testsuite/tests/generalized-open/funct_body.ml
@@ -0,0 +1,47 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+** check-ocamlc.byte-output
+*)
+
+module type T = sig
+  type t
+  val x : t
+  val f : t -> unit
+end
+
+module Int = struct
+  type t = int
+  let x = 42
+  let f = print_int
+end
+
+module String = struct
+  type t = string
+  let x = "Forty Two"
+  let f = print_endline
+end
+
+let r = ref (module Int : T)
+
+module F (X : sig end) = struct
+  open struct
+    include (val !r)
+  end
+  type s = t
+  let x : s = x
+  let f : s -> unit = f
+end
+
+module M = struct end
+
+module N = F(M)
+
+let () =
+  r := (module String : T)
+
+module O = F(M)
+
+let () =
+  O.f N.x
diff --git a/testsuite/tests/generalized-open/gpr1506.ml b/testsuite/tests/generalized-open/gpr1506.ml
new file mode 100644
index 00000000..3cbd819f
--- /dev/null
+++ b/testsuite/tests/generalized-open/gpr1506.ml
@@ -0,0 +1,392 @@
+(* TEST
+   * expect
+*)
+
+type t = A
+[%%expect{|
+type t = A
+|}]
+
+module M = struct
+    open struct type t' = t end
+    type t = B of t * t' | C
+end
+[%%expect{|
+module M : sig type t = B of t/1 * t/2 | C end
+|}]
+
+(* test *)
+include struct
+  open M
+  let test = B (B (C, A), A)
+end
+[%%expect{|
+val test : M.t = M.B (M.B (M.C, A), A)
+|}]
+
+include struct
+  open struct let aux x y = x / y end
+  let f x = aux x 2
+  let g y = aux 3 y
+end
+[%%expect{|
+val f : int -> int = <fun>
+val g : int -> int = <fun>
+|}];;
+
+include struct
+  open struct exception Interrupt end
+  let run () =
+    raise Interrupt
+  let () =
+    match run() with exception Interrupt -> () | _ -> assert false
+end
+[%%expect{|
+val run : unit -> 'a = <fun>
+|}];;
+
+(* It was decided to not allow this anymore. *)
+(*
+module type S = sig
+  open struct
+    open struct
+      type t' = char
+    end
+  type t = t' -> int
+  end
+  val x : t
+end
+[%%expect{|
+module type S = sig val x : char -> int end
+|}];;
+
+module M : S = struct
+  let x = Char.code
+end
+[%%expect{|
+module M : S
+|}];;
+*)
+
+module M = struct
+  module M (F: sig end) (X: sig end) = struct end
+  open M(struct end)
+end
+[%%expect{|
+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
+|}]
+
+open struct
+  open struct let counter = ref 0 end
+  let inc () = incr counter
+  let dec () = decr counter
+  let current () = !counter
+end
+[%%expect{|
+val inc : unit -> unit = <fun>
+val dec : unit -> unit = <fun>
+val current : unit -> int = <fun>
+|}]
+
+let () =
+  inc(); inc(); dec ();
+  assert (current () = 1)
+[%%expect{|
+|}];;
+
+include struct open struct type t = T end let x = T end
+[%%expect{|
+Line 1, characters 15-41:
+1 | include struct open struct type t = T end let x = T end
+                   ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type t/149 introduced by this open appears in the signature
+       Line 1, characters 46-47:
+         The value x has no valid type if t/149 is hidden
+|}];;
+
+module A = struct
+  open struct
+    open struct
+      type t = T
+      let x = T
+    end
+    let y = x
+  end
+end
+[%%expect{|
+Lines 3-6, characters 4-7:
+3 | ....open struct
+4 |       type t = T
+5 |       let x = T
+6 |     end
+Error: The type t/154 introduced by this open appears in the signature
+       Line 7, characters 8-9:
+         The value y has no valid type if t/154 is hidden
+|}];;
+
+module A = struct
+  open struct
+    open struct
+      type t = T
+    end
+    let y = T
+  end
+  let g = y
+end
+[%%expect{|
+Lines 3-5, characters 4-7:
+3 | ....open struct
+4 |       type t = T
+5 |     end
+Error: The type t/159 introduced by this open appears in the signature
+       Line 6, characters 8-9:
+         The value y has no valid type if t/159 is hidden
+|}]
+
+(* It was decided to not allow this anymore. *)
+(*
+module type S = sig open struct type t = T end val x : t end
+[%%expect{|
+Line _, characters 20-46:
+  module type S = sig open struct type t = T end val x : t end
+                      ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The module identifier M#13 cannot be eliminated from val x : M#13.t
+|}];;
+*)
+
+
+(* It was decided to not allow this anymore. *)
+(*
+module type S = sig
+  open struct
+    type t = int
+    open struct
+      type s = T | A of t
+    end
+    val x : char
+  end
+  val y : t
+end
+[%%expect{|
+module type S = sig val y : int end
+|}]
+*)
+
+(* It was decided to not allow this anymore. *)
+(*
+module type S = sig open struct assert false end end;;
+[%%expect{|
+module type S = sig  end
+|}];;
+*)
+
+(* It was decided to not allow this anymore. *)
+(*
+module type S = sig open struct type t = int end val x : t end;;
+[%%expect{|
+module type S = sig val x : int end
+|}];;
+*)
+
+module type S = sig
+  (* It was decided to not allow this anymore. *)
+  (*
+  open struct type t = int end
+  type s = t
+  *)
+  type s = int
+end
+[%%expect{|
+module type S = sig type s = int end
+|}]
+
+module type T = sig type s = int end
+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 Counter : sig val inc : unit -> unit val current : unit -> int val z : int val zz : int end = struct
+  open struct let counter = ref 0 end
+  let x = 1
+  let y = 2
+  let dec () = decr counter
+
+  open struct
+    module A : sig val z : int end = struct
+      open struct
+        let n = 3
+        module A = struct
+          open struct
+            let x = 1
+          end
+          let y = x
+        end
+        let h = A.y
+        let g = A.y + n
+      end
+      let z = h + g
+    end
+
+    let z = 12
+
+    module B : sig val z : int end = struct
+      open struct
+        module A = struct
+          open struct let x = 1 end
+          let y = x
+          open struct let x = 1 end
+          let z = y + x
+        end
+        let h = A.y
+        let g = A.z + 1
+      end
+      let z = h + g
+    end
+
+    let h = A.z + B.z
+  end
+
+  let z = z + h
+  let g = 1
+  let ggg = 2
+  let inc () = incr counter
+  let zz = 5
+  let current () = !counter
+end
+[%%expect{|
+module Counter :
+  sig
+    val inc : unit -> unit
+    val current : unit -> int
+    val z : int
+    val zz : int
+  end
+|}]
+
+let () = begin
+  assert (Counter.z = 21)
+end
+[%%expect{|
+|}]
+
+(* It was decided to not allow parts of this example anymore, see below for a
+   slightly simpler version. *)
+(*
+module N = struct
+  open (functor
+    (N: sig open struct type t = int end val x : t end) ->
+    (struct let y = N.x end))(struct let x = 1 end)
+
+  let () =
+    assert(y = 1)
+end
+[%%expect{|
+module N : sig  end
+|}]
+*)
+module N = struct
+  open (functor
+    (N: sig val x : int end) ->
+    (struct let y = N.x end))(struct let x = 1 end)
+
+  let () =
+    assert(y = 1)
+end
+[%%expect{|
+module N : sig end
+|}]
+
+module M = struct
+  open struct
+    open struct
+      module type S = sig
+        (* It was decided to not allow this anymore *)
+        (* open struct type t = int end val x : t *)
+        val x : int
+      end
+      module M : S = struct let x = 1 end
+    end
+  end
+end
+[%%expect{|
+module M : sig end
+|}]
+
+(* It was decided to not allow this anymore *)
+(*
+module N = struct
+  open struct
+    module type S = sig open struct type t = T end val x : t end
+  end
+end
+[%%expect{|
+Line _, characters 24-50:
+      module type S = sig open struct type t = T end val x : t end
+                          ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The module identifier M#32 cannot be eliminated from val x : M#32.t
+|}]
+*)
+
+let x = let open struct open struct let y = 1 end let x = y + 1 end in x
+[%%expect{|
+val x : int = 2
+|}]
+
+let y =
+  let
+    open ((functor (X: sig val x : int end) -> struct X.x end)(struct let x = 1 end))
+  in x
+
+[%%expect{|
+val y : int = 2
+|}]
+
+let x = let open struct type t = T end in T
+
+[%%expect{|
+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
+       The type constructor t would escape its scope
+|}]
+
+module type Print = sig
+  type t
+  val print: t -> unit
+end
+
+module Print_int: Print with type t = int = struct
+  type t = int let print = print_int
+end
+module Print_list(P: Print): Print with type t = P.t list = struct
+  type t = P.t list
+  let print = List.iter P.print
+end
+let print_list_of_int = let open Print_list(Print_int) in print
+
+[%%expect{|
+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
+val print_list_of_int : Print_int.t list -> unit = <fun>
+|}]
+
+let f () = let open functor(X: sig end) -> struct end in ();;
+
+[%%expect{|
+Line 1, characters 20-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
+|}]
diff --git a/testsuite/tests/generalized-open/shadowing.ml b/testsuite/tests/generalized-open/shadowing.ml
new file mode 100644
index 00000000..589807d3
--- /dev/null
+++ b/testsuite/tests/generalized-open/shadowing.ml
@@ -0,0 +1,59 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "0"
+** check-ocamlc.byte-output
+*)
+
+module Make_sure_val : sig
+  val x : int
+end = struct
+  let x = 3
+
+  open struct
+    let x = 'c'
+  end
+end
+
+type t = A
+
+open struct
+  type t = B
+end
+
+type ext = ..
+
+module Make_sure_ec : sig
+  type ext += C of int
+end = struct
+  type ext += C of int
+
+  open struct
+    type ext += D of char
+  end
+end
+
+
+module M = struct type t = int end
+
+open struct
+  module M = struct type u = char end
+end
+
+module type S = sig type t = int end
+
+open struct
+  module type S = sig type u = char end
+end
+
+class c = object method x = 3 end
+
+open struct
+  class c = object method y = 'c' end
+end
+
+class type ct = object method x : int end
+
+open struct
+  class type ct = object method y : int end
+end
diff --git a/testsuite/tests/instrumented-runtime/main.ml b/testsuite/tests/instrumented-runtime/main.ml
new file mode 100644
index 00000000..ebee4a6e
--- /dev/null
+++ b/testsuite/tests/instrumented-runtime/main.ml
@@ -0,0 +1,11 @@
+(* TEST
+  * hasinstrumentedruntime
+  ** native
+    flags = "-runtime-variant=i"
+*)
+
+(* Test if the instrumented runtime is in working condition *)
+
+let _ =
+  Gc.eventlog_pause ();
+  Gc.eventlog_resume()
diff --git a/testsuite/tests/instrumented-runtime/main.run b/testsuite/tests/instrumented-runtime/main.run
new file mode 100644
index 00000000..430dd231
--- /dev/null
+++ b/testsuite/tests/instrumented-runtime/main.run
@@ -0,0 +1,35 @@
+#!/bin/sh
+
+export OCAML_EVENTLOG_ENABLED=1
+export OCAML_EVENTLOG_PREFIX=${program}
+
+if [ "${os_type}" = "Win32" ] ; then
+  program=$(cygpath "$program")
+fi
+
+rm -f "${program}"*.eventlog*
+${program} > ${output} &
+
+pid=$!
+wait $pid
+
+ls "${program}".*.eventlog | grep '\.[0-9][0-9]*\.eventlog$' | \
+while IFS= read -r file; do
+  touch ${program}.eventlogs
+  if [ ! -e "${program}.eventlog" ] ; then
+    touch ${program}.eventlog
+  else
+    rm -f ${program}.eventlog
+    break
+  fi
+done
+
+if [ -f "${program}.eventlog" ]; then
+  exit ${TEST_PASS}
+elif [ -f "${program}.eventlogs" ]; then
+  echo 'too many runtime traces found!' > ${ocamltest_response}
+  exit ${TEST_FAIL}
+else
+  echo 'instrumented runtime trace not found!' > ${ocamltest_response}
+  exit ${TEST_FAIL}
+fi
diff --git a/testsuite/tests/int64-unboxing/stubs.c b/testsuite/tests/int64-unboxing/stubs.c
new file mode 100644
index 00000000..25004759
--- /dev/null
+++ b/testsuite/tests/int64-unboxing/stubs.c
@@ -0,0 +1,25 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*                  Jeremie Dimino, Jane Street Europe                    */
+/*                                                                        */
+/*   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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+
+int64_t test_int64_add(int64_t x, int64_t y) { return (x + y); }
+int64_t test_int64_sub(int64_t x, int64_t y) { return (x - y); }
+int64_t test_int64_mul(int64_t x, int64_t y) { return (x * y); }
+
+value test_ignore_int64(int64_t x)
+{
+  return Val_unit;
+}
diff --git a/testsuite/tests/int64-unboxing/test.ml b/testsuite/tests/int64-unboxing/test.ml
new file mode 100644
index 00000000..d35e5214
--- /dev/null
+++ b/testsuite/tests/int64-unboxing/test.ml
@@ -0,0 +1,30 @@
+(* TEST
+   modules = "stubs.c"
+   * native
+*)
+
+external ( + ) : int64 -> int64 -> int64
+  = "" "test_int64_add" [@@noalloc] [@@unboxed]
+external ( - ) : int64 -> int64 -> int64
+  = "" "test_int64_sub" [@@noalloc] [@@unboxed]
+external ( * ) : int64 -> int64 -> int64
+  = "" "test_int64_mul" [@@noalloc] [@@unboxed]
+
+external ignore_int64 : (int64 [@unboxed]) -> unit
+  = "" "test_ignore_int64" [@@noalloc]
+
+let f () =
+  let r = ref 1L in
+  for i = 0 to 100000 do
+    let n = !r + !r in
+    r := n * n
+  done;
+  ignore_int64 !r
+
+let () =
+  let a0 = Gc.allocated_bytes () in
+  let a1 = Gc.allocated_bytes () in
+  let _x = f () in
+  let a2 = Gc.allocated_bytes () in
+  let alloc = (a2 -. 2. *. a1 +. a0) in
+  assert(alloc = 0.)
diff --git a/testsuite/tests/int64-unboxing/test.reference b/testsuite/tests/int64-unboxing/test.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/lazy/lazy1.ml b/testsuite/tests/lazy/lazy1.ml
new file mode 100644
index 00000000..f88e93da
--- /dev/null
+++ b/testsuite/tests/lazy/lazy1.ml
@@ -0,0 +1,18 @@
+(* TEST
+   ocamlopt_flags += " -O3 "
+*)
+
+(* Mantis 7301, due to A. Frisch *)
+
+let foo () =
+  (fun xs0 () -> Lazy.force (List.hd xs0) ())
+    (List.map (fun g -> lazy g)
+       [Lazy.force (  lazy ( let _ = () in fun () -> ()  ) )]
+    )
+
+let () =
+  let gen = foo () in
+  gen ();
+  Gc.compact ();
+  print_char 'A'; flush stdout;
+  gen ()
diff --git a/testsuite/tests/lazy/lazy1.reference b/testsuite/tests/lazy/lazy1.reference
new file mode 100644
index 00000000..8c7e5a66
--- /dev/null
+++ b/testsuite/tests/lazy/lazy1.reference
@@ -0,0 +1 @@
+A
\ No newline at end of file
diff --git a/testsuite/tests/let-syntax/let_syntax.ml b/testsuite/tests/let-syntax/let_syntax.ml
new file mode 100644
index 00000000..9f19e0e4
--- /dev/null
+++ b/testsuite/tests/let-syntax/let_syntax.ml
@@ -0,0 +1,724 @@
+(* TEST
+   * expect
+*)
+
+let id x = x
+
+let apply x f = f x
+
+let pair x y = x, y
+
+module Id = struct
+
+  let (let+) = apply
+
+  let (and+) = pair
+
+end;;
+[%%expect{|
+val id : 'a -> 'a = <fun>
+val apply : 'a -> ('a -> 'b) -> 'b = <fun>
+val pair : 'a -> 'b -> 'a * 'b = <fun>
+module Id :
+  sig
+    val ( let+ ) : 'a -> ('a -> 'b) -> 'b
+    val ( and+ ) : 'a -> 'b -> 'a * 'b
+  end
+|}];;
+
+let res =
+  Id.(
+    let+ x = 1
+    and+ y = 2
+    and+ z = 3 in
+    [x; y; z]
+  );;
+[%%expect{|
+val res : int list = [1; 2; 3]
+|}];;
+
+let res2 =
+  Id.(
+    let+ x = 1 in
+    x + 2
+  );;
+[%%expect{|
+val res2 : int = 3
+|}];;
+
+
+module List = struct
+
+  let map l f = List.map f l
+
+  let concat_map l f =
+    let l = List.map f l in
+    List.concat l
+
+  let product xs ys =
+    List.fold_right
+      (fun x acc -> (List.map (fun y -> (x, y)) ys) @ acc)
+      xs []
+
+  let (let+) = map
+
+  let (and+) = product
+
+  let ( let* ) = concat_map
+
+  let ( and* ) = product
+
+end;;
+[%%expect{|
+module List :
+  sig
+    val map : 'a list -> ('a -> 'b) -> 'b list
+    val concat_map : 'a list -> ('a -> 'b list) -> 'b list
+    val product : 'a list -> 'b list -> ('a * 'b) list
+    val ( let+ ) : 'a list -> ('a -> 'b) -> 'b list
+    val ( and+ ) : 'a list -> 'b list -> ('a * 'b) list
+    val ( let* ) : 'a list -> ('a -> 'b list) -> 'b list
+    val ( and* ) : 'a list -> 'b list -> ('a * 'b) list
+  end
+|}];;
+
+let map =
+  List.(
+    let+ x = [1; 2; 3] in
+    x + 1
+  );;
+[%%expect{|
+val map : int list = [2; 3; 4]
+|}];;
+
+let map_and =
+  List.(
+    let+ x = [1; 2; 3]
+    and+ y = [7; 8; 9] in
+    x + y
+  );;
+[%%expect{|
+val map_and : int list = [8; 9; 10; 9; 10; 11; 10; 11; 12]
+|}];;
+
+let bind =
+  List.(
+    let* x = [1; 2; 3] in
+    let* y = [7; 8; 9] in
+    [x + y]
+  );;
+[%%expect{|
+val bind : int list = [8; 9; 10; 9; 10; 11; 10; 11; 12]
+|}];;
+
+let bind_and =
+  List.(
+    let* x = [1; 2; 3]
+    and* y = [7; 8; 9] in
+    [x + y]
+  );;
+[%%expect{|
+val bind_and : int list = [8; 9; 10; 9; 10; 11; 10; 11; 12]
+|}];;
+
+let bind_map =
+  List.(
+    let* x = [1; 2; 3] in
+    let+ y = [7; 8; 9] in
+    x + y
+  );;
+[%%expect{|
+val bind_map : int list = [8; 9; 10; 9; 10; 11; 10; 11; 12]
+|}];;
+
+module Let_unbound = struct
+end;;
+[%%expect{|
+module Let_unbound : sig end
+|}];;
+
+let let_unbound =
+  Let_unbound.(
+    let+ x = 1 in
+    x + y
+  );;
+[%%expect{|
+Line 3, characters 4-8:
+3 |     let+ x = 1 in
+        ^^^^
+Error: Unbound value let+
+|}];;
+
+module And_unbound = struct
+  let (let+) = Id.(let+)
+end;;
+[%%expect{|
+module And_unbound : sig val ( let+ ) : 'a -> ('a -> 'b) -> 'b end
+|}];;
+
+let and_unbound =
+  And_unbound.(
+    let+ x = 1
+    and+ y = 2 in
+    x + y
+  );;
+[%%expect{|
+Line 4, characters 4-8:
+4 |     and+ y = 2 in
+        ^^^^
+Error: Unbound value and+
+|}];;
+
+module Ill_typed_1 = struct
+
+  let (let+) = fun x f -> f (not x)
+
+end;;
+[%%expect{|
+module Ill_typed_1 : sig val ( let+ ) : bool -> (bool -> 'a) -> 'a end
+|}];;
+
+let ill_typed_1 =
+  Ill_typed_1.(
+    let+ x = 1 in
+    x + y
+  );;
+[%%expect{|
+Line 3, characters 13-14:
+3 |     let+ x = 1 in
+                 ^
+Error: This expression has type int but an expression was expected of type
+         bool
+|}];;
+
+module Ill_typed_2 = struct
+
+  let (let+) = apply
+  let (and+) = fun x y -> x +. y, x -. y
+
+end;;
+[%%expect{|
+module Ill_typed_2 :
+  sig
+    val ( let+ ) : 'a -> ('a -> 'b) -> 'b
+    val ( and+ ) : float -> float -> float * float
+  end
+|}];;
+
+let ill_typed_2 =
+  Ill_typed_2.(
+    let+ x = 1
+    and+ y = 2 in
+    x + y
+  );;
+[%%expect{|
+Line 3, characters 13-14:
+3 |     let+ x = 1
+                 ^
+Error: This expression has type int but an expression was expected of type
+         float
+  Hint: Did you mean `1.'?
+|}];;
+
+module Ill_typed_3 = struct
+
+  let (let+) = 7
+
+end;;
+[%%expect{|
+module Ill_typed_3 : sig val ( let+ ) : int end
+|}];;
+
+let ill_typed_3 =
+  Ill_typed_3.(
+    let+ x = 1 in
+    x + y
+  );;
+[%%expect{|
+Line 3, characters 4-8:
+3 |     let+ x = 1 in
+        ^^^^
+Error: The operator let+ has type int but it was expected to have type
+         'a -> ('b -> 'c) -> 'd
+|}];;
+
+module Ill_typed_4 = struct
+
+  let (let+) = apply
+  let (and+) = not
+
+end;;
+[%%expect{|
+module Ill_typed_4 :
+  sig val ( let+ ) : 'a -> ('a -> 'b) -> 'b val ( and+ ) : bool -> bool end
+|}];;
+
+let ill_typed_4 =
+  Ill_typed_4.(
+    let+ x = 1
+    and+ y = 2 in
+    x + y
+  );;
+[%%expect{|
+Line 4, characters 4-8:
+4 |     and+ y = 2 in
+        ^^^^
+Error: The operator and+ has type bool -> bool
+       but it was expected to have type bool -> 'a -> 'b
+       Type bool is not compatible with type 'a -> 'b
+|}];;
+
+module Ill_typed_5 = struct
+
+  let (let+) = (fun x f -> not x)
+  let (and+) = pair
+
+end;;
+[%%expect{|
+module Ill_typed_5 :
+  sig
+    val ( let+ ) : bool -> 'a -> bool
+    val ( and+ ) : 'a -> 'b -> 'a * 'b
+  end
+|}];;
+
+let ill_typed_5 =
+  Ill_typed_5.(
+    let+ x = 1
+    and+ y = 2
+    and+ z = 3 in
+    x + y + z
+  );;
+[%%expect{|
+Lines 3-5, characters 9-14:
+3 | .........x = 1
+4 |     and+ y = 2
+5 |     and+ z = 3...
+Error: These bindings have type (int * int) * int
+       but bindings were expected of type bool
+|}];;
+
+module Ill_typed_6 = struct
+
+  let (let+) = apply
+  let (and+) = fun x y -> x + 1, y
+
+end;;
+[%%expect{|
+module Ill_typed_6 :
+  sig
+    val ( let+ ) : 'a -> ('a -> 'b) -> 'b
+    val ( and+ ) : int -> 'a -> int * 'a
+  end
+|}];;
+
+let ill_typed_6 =
+  Ill_typed_6.(
+    let+ x = 1
+    and+ y = 2
+    and+ z = 3 in
+    x + y + z
+  );;
+[%%expect{|
+Lines 3-4, characters 9-14:
+3 | .........x = 1
+4 |     and+ y = 2
+Error: These bindings have type int * int but bindings were expected of type
+         int
+|}];;
+
+
+module Ill_typed_7 = struct
+
+  let (let+) f x = f (x + 1)
+  let (and+) = pair
+
+end;;
+[%%expect{|
+module Ill_typed_7 :
+  sig
+    val ( let+ ) : (int -> 'a) -> int -> 'a
+    val ( and+ ) : 'a -> 'b -> 'a * 'b
+  end
+|}];;
+
+let ill_typed_7 =
+  Ill_typed_7.(
+    let+ x = 1
+    and+ y = 2 in
+    x + y
+  );;
+[%%expect{|
+Line 3, characters 4-8:
+3 |     let+ x = 1
+        ^^^^
+Error: The operator let+ has type (int -> 'a) -> int -> 'a
+       but it was expected to have type (int -> 'a) -> ('b * 'c -> 'd) -> 'e
+       Type int is not compatible with type 'b * 'c -> 'd
+|}];;
+
+module Indexed_monad = struct
+
+  type opened = private Opened
+  type closed = private Closed
+
+  type (_, _, _) t =
+    | Return : 'a -> ('s, 's, 'a) t
+    | Map : ('s1, 's2, 'a) t * ('a -> 'b) -> ('s1, 's2, 'b) t
+    | Both : ('s1, 's2, 'a) t * ('s2, 's3, 'b) t -> ('s1, 's3, 'a * 'b) t
+    | Bind : ('s1, 's2, 'a) t * ('a -> ('s2, 's3, 'b) t) -> ('s1, 's3, 'b) t
+    | Open : string -> (closed, opened, unit) t
+    | Read : (opened, opened, string) t
+    | Close : (opened, closed, unit) t
+
+  let return x = Return x
+  let map m f = Map(m, f)
+  let both m1 m2 = Both(m1, m2)
+  let bind m f = Bind(m, f)
+  let open_ s = Open s
+  let read = Read
+  let close = Close
+
+  type 'a state =
+    | Opened : in_channel -> opened state
+    | Closed : closed state
+
+  let run (type a) (m : (closed, closed, a) t) : a =
+    let rec loop : type a s1 s2. s1 state -> (s1, s2, a) t -> s2 state * a =
+      fun state m ->
+        match m, state with
+        | Return x, _ -> state, x
+        | Map(m, f), _ ->
+            let state2, x = loop state m in
+            state2, f x
+        | Both(m1, m2), _ ->
+            let state2, x = loop state m1 in
+            let state3, y = loop state2 m2 in
+            state3, (x, y)
+        | Bind(m, f), _ ->
+            let state2, x = loop state m in
+            loop state2 (f x)
+        | Open filename, Closed ->
+            let ic = open_in filename in
+            Opened ic, ()
+        | Read, Opened ic ->
+            let c = input_line ic in
+            state, c
+        | Close, Opened ic ->
+            close_in ic;
+            Closed, ()
+    in
+    let Closed, result = loop Closed m in
+    result
+
+  let ( let+ ) = map
+  let ( and+ ) = both
+  let ( let* ) = bind
+  let ( and* ) = both
+
+end;;
+[%%expect {|
+module Indexed_monad :
+  sig
+    type opened = private Opened
+    type closed = private Closed
+    type (_, _, _) t =
+        Return : 'a -> ('s, 's, 'a) t
+      | Map : ('s1, 's2, 'a) t * ('a -> 'b) -> ('s1, 's2, 'b) t
+      | Both : ('s1, 's2, 'a) t * ('s2, 's3, 'b) t -> ('s1, 's3, 'a * 'b) t
+      | Bind : ('s1, 's2, 'a) t *
+          ('a -> ('s2, 's3, 'b) t) -> ('s1, 's3, 'b) t
+      | Open : string -> (closed, opened, unit) t
+      | Read : (opened, opened, string) t
+      | Close : (opened, closed, unit) t
+    val return : 'a -> ('b, 'b, 'a) t
+    val map : ('a, 'b, 'c) t -> ('c -> 'd) -> ('a, 'b, 'd) t
+    val both : ('a, 'b, 'c) t -> ('b, 'd, 'e) t -> ('a, 'd, 'c * 'e) t
+    val bind : ('a, 'b, 'c) t -> ('c -> ('b, 'd, 'e) t) -> ('a, 'd, 'e) t
+    val open_ : string -> (closed, opened, unit) t
+    val read : (opened, opened, string) t
+    val close : (opened, closed, unit) t
+    type 'a state =
+        Opened : in_channel -> opened state
+      | Closed : closed state
+    val run : (closed, closed, 'a) t -> 'a
+    val ( let+ ) : ('a, 'b, 'c) t -> ('c -> 'd) -> ('a, 'b, 'd) t
+    val ( and+ ) : ('a, 'b, 'c) t -> ('b, 'd, 'e) t -> ('a, 'd, 'c * 'e) t
+    val ( let* ) : ('a, 'b, 'c) t -> ('c -> ('b, 'd, 'e) t) -> ('a, 'd, 'e) t
+    val ( and* ) : ('a, 'b, 'c) t -> ('b, 'd, 'e) t -> ('a, 'd, 'c * 'e) t
+  end
+|}];;
+
+let indexed_monad1 =
+  Indexed_monad.(
+    let+ () = open_ "foo"
+    and+ first = read
+    and+ second = read
+    and+ () = close in
+    first ^ second
+  );;
+[%%expect{|
+val indexed_monad1 :
+  (Indexed_monad.closed, Indexed_monad.closed, string) Indexed_monad.t =
+  Indexed_monad.Map
+   (Indexed_monad.Both
+     (Indexed_monad.Both
+       (Indexed_monad.Both (Indexed_monad.Open "foo", Indexed_monad.Read),
+       Indexed_monad.Read),
+     Indexed_monad.Close),
+   <fun>)
+|}];;
+
+let indexed_monad2 =
+  Indexed_monad.(
+    let* () = open_ "foo" in
+    let* first = read in
+    let* second = read in
+    let* () = close in
+      return (first ^ second)
+  );;
+[%%expect{|
+val indexed_monad2 :
+  (Indexed_monad.closed, Indexed_monad.closed, string) Indexed_monad.t =
+  Indexed_monad.Bind (Indexed_monad.Open "foo", <fun>)
+|}];;
+
+let indexed_monad3 =
+  Indexed_monad.(
+    let+ first = read
+    and+ () = open_ "foo"
+    and+ second = read
+    and+ () = close in
+    first ^ second
+  );;
+[%%expect{|
+Line 4, characters 14-25:
+4 |     and+ () = open_ "foo"
+                  ^^^^^^^^^^^
+Error: This expression has type
+         (Indexed_monad.closed, Indexed_monad.opened, unit) Indexed_monad.t
+       but an expression was expected of type
+         (Indexed_monad.opened, 'a, 'b) Indexed_monad.t
+       Type Indexed_monad.closed is not compatible with type
+         Indexed_monad.opened
+|}];;
+
+let indexed_monad4 =
+  Indexed_monad.(
+    let* () = open_ "foo" in
+    let* first = read in
+    let* () = close in
+    let* second = read in
+      return (first ^ second)
+  );;
+[%%expect{|
+Lines 6-7, characters 4-29:
+6 | ....let* second = read in
+7 |       return (first ^ second)
+Error: This expression has type
+         (Indexed_monad.opened, Indexed_monad.opened, string) Indexed_monad.t
+       but an expression was expected of type
+         (Indexed_monad.closed, 'a, 'b) Indexed_monad.t
+       Type Indexed_monad.opened is not compatible with type
+         Indexed_monad.closed
+|}];;
+
+(* Test principality using constructor disambiguation *)
+
+module A = struct
+  type t = A
+end
+
+module Let_principal = struct
+  let ( let+ ) (x : A.t) f = f x
+end;;
+[%%expect{|
+module A : sig type t = A end
+module Let_principal : sig val ( let+ ) : A.t -> (A.t -> 'a) -> 'a end
+|}];;
+
+let let_principal =
+  Let_principal.(
+    let+ A = A in
+    ()
+  );;
+[%%expect{|
+val let_principal : unit = ()
+|}];;
+
+
+module And_principal = struct
+  let ( let+ ) = apply
+  let ( and+ ) (x : A.t) y = x, y
+end;;
+[%%expect{|
+module And_principal :
+  sig
+    val ( let+ ) : 'a -> ('a -> 'b) -> 'b
+    val ( and+ ) : A.t -> 'a -> A.t * 'a
+  end
+|}];;
+
+let and_principal =
+  And_principal.(
+    let+ _ = A
+    and+ () = () in
+    ()
+  );;
+[%%expect{|
+val and_principal : unit = ()
+|}];;
+
+module Let_not_principal = struct
+  let ( let+ ) = apply
+end;;
+[%%expect{|
+module Let_not_principal : sig val ( let+ ) : 'a -> ('a -> 'b) -> 'b end
+|}];;
+
+let let_not_principal =
+  Let_not_principal.(
+    let+ A = A.A in
+    ()
+  );;
+[%%expect{|
+val let_not_principal : unit = ()
+|}, Principal{|
+Line 3, characters 9-10:
+3 |     let+ A = A.A in
+             ^
+Error: Unbound constructor A
+|}];;
+
+module And_not_principal = struct
+  let ( let+ ) = apply
+  let ( and+ ) x y = if true then x,y else y,x
+end;;
+[%%expect{|
+module And_not_principal :
+  sig
+    val ( let+ ) : 'a -> ('a -> 'b) -> 'b
+    val ( and+ ) : 'a -> 'a -> 'a * 'a
+  end
+|}];;
+
+let and_not_principal =
+  And_not_principal.(
+    fun x y ->
+      let+ A.A = x
+      and+ A = y in
+      ()
+  );;
+[%%expect{|
+val and_not_principal : A.t -> A.t -> unit = <fun>
+|}, Principal{|
+Line 5, characters 11-12:
+5 |       and+ A = y in
+               ^
+Error: Unbound constructor A
+|}];;
+
+module Let_not_propagated = struct
+  let ( let+ ) = apply
+end;;
+[%%expect{|
+module Let_not_propagated : sig val ( let+ ) : 'a -> ('a -> 'b) -> 'b end
+|}];;
+
+let let_not_propagated : A.t =
+  Let_not_propagated.(
+    let+ x = 3 in
+    A
+  );;
+[%%expect{|
+Line 4, characters 4-5:
+4 |     A
+        ^
+Error: Unbound constructor A
+|}];;
+
+module Side_effects_ordering = struct
+  let r = ref []
+  let msg s =
+    r := !r @ [s]
+  let output () = !r
+  let ( let+ ) x f = msg "Let operator"; f x
+  let ( and+ ) a b = msg "First and operator"; a, b
+  let ( and++ ) a b = msg "Second and operator"; a, b
+end;;
+[%%expect{|
+module Side_effects_ordering :
+  sig
+    val r : string list ref
+    val msg : string -> unit
+    val output : unit -> string list
+    val ( let+ ) : 'a -> ('a -> 'b) -> 'b
+    val ( and+ ) : 'a -> 'b -> 'a * 'b
+    val ( and++ ) : 'a -> 'b -> 'a * 'b
+  end
+|}];;
+
+let side_effects_ordering =
+  Side_effects_ordering.(
+    let+ () = msg "First argument"
+    and+ () = msg "Second argument"
+    and++ () = msg "Third argument" in
+    output ()
+  );;
+[%%expect{|
+val side_effects_ordering : string list =
+  ["First argument"; "Second argument"; "First and operator";
+   "Third argument"; "Second and operator"; "Let operator"]
+|}];;
+
+module GADT_ordering = struct
+  type point = { x : int; y : int }
+  type _ is_point =
+    | Is_point : point is_point
+  let (let+) = apply
+  let (and+) = pair
+end;;
+[%%expect{|
+module GADT_ordering :
+  sig
+    type point = { x : int; y : int; }
+    type _ is_point = Is_point : point is_point
+    val ( let+ ) : 'a -> ('a -> 'b) -> 'b
+    val ( and+ ) : 'a -> 'b -> 'a * 'b
+  end
+|}];;
+
+let gadt_ordering =
+  GADT_ordering.(
+    fun (type a) (is_point : a is_point) (a : a) ->
+      let+ Is_point : a is_point = is_point
+      and+ { x; y } : a = a in
+        x + y
+  );;
+[%%expect{|
+val gadt_ordering : 'a GADT_ordering.is_point -> 'a -> int = <fun>
+|}];;
+
+(* This example doesn't produce a good error location.  To fix this we need to handle the
+   patterns directly rather than elaborating them to tuples. We'd like to do this in
+   future but it is quite a bit of work, so for now we leave the location as it is. It
+   should only appear in principal mode when using GADTs anyway. *)
+let bad_location =
+  GADT_ordering.(
+    fun (type a) (is_point : a is_point) (a : a) ->
+      let+ Is_point = is_point
+      and+ { x; y } = a in
+        x + y
+  );;
+[%%expect{|
+val bad_location : 'a GADT_ordering.is_point -> 'a -> int = <fun>
+|}, Principal{|
+Line 4, characters 6-10:
+4 |       let+ Is_point = is_point
+          ^^^^
+Error: This pattern matches values of type
+         GADT_ordering.point GADT_ordering.is_point * GADT_ordering.point
+       but a pattern was expected which matches values of type
+         a GADT_ordering.is_point * a
+       Type GADT_ordering.point is not compatible with type a
+|}];;
diff --git a/testsuite/tests/letrec-check/basic.ml b/testsuite/tests/letrec-check/basic.ml
new file mode 100644
index 00000000..59521280
--- /dev/null
+++ b/testsuite/tests/letrec-check/basic.ml
@@ -0,0 +1,366 @@
+(* TEST
+   * expect
+*)
+
+let rec x = (x; ());;
+[%%expect{|
+val x : unit = ()
+|}];;
+
+let rec x = "x";;
+[%%expect{|
+val x : string = "x"
+|}];;
+
+let rec x = let x = () in x;;
+[%%expect{|
+val x : unit = ()
+|}];;
+
+let rec x = let y = (x; ()) in y;;
+[%%expect{|
+val x : unit = ()
+|}];;
+
+let rec x = let y = () in x;;
+[%%expect{|
+Line 1, characters 12-27:
+1 | let rec x = let y = () in x;;
+                ^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x = [y]
+and y = let x = () in x;;
+[%%expect{|
+val x : unit list = [()]
+val y : unit = ()
+|}];;
+
+let rec x = [y]
+and y = let rec x = () in x;;
+[%%expect{|
+val x : unit list = [()]
+val y : unit = ()
+|}];;
+
+let rec x =
+  let a = x in
+  fun () -> a ()
+and y =
+  [x];;
+[%%expect{|
+val x : unit -> 'a = <fun>
+val y : (unit -> 'a) list = [<fun>]
+|}];;
+
+let rec x = [|y|] and y = 0;;
+[%%expect{|
+val x : int array = [|0|]
+val y : int = 0
+|}];;
+
+
+let rec x = (y, y)
+and y = fun () -> ignore x;;
+[%%expect{|
+val x : (unit -> unit) * (unit -> unit) = (<fun>, <fun>)
+val y : unit -> unit = <fun>
+|}];;
+
+let rec x = Some y
+and y = fun () -> ignore x
+;;
+[%%expect{|
+val x : (unit -> unit) option = Some <fun>
+val y : unit -> unit = <fun>
+|}];;
+
+let rec x = ignore x;;
+[%%expect{|
+Line 1, characters 12-20:
+1 | let rec x = ignore x;;
+                ^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x = y 0 and y _ = ();;
+[%%expect{|
+Line 1, characters 12-15:
+1 | let rec x = y 0 and y _ = ();;
+                ^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec b = if b then true else false;;
+[%%expect{|
+Line 1, characters 12-37:
+1 | let rec b = if b then true else false;;
+                ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x = function
+    Some _ -> ignore (y [])
+  | None -> ignore (y [])
+and y = function
+    [] -> ignore (x None)
+  | _ :: _ -> ignore (x None)
+    ;;
+[%%expect{|
+val x : 'a option -> unit = <fun>
+val y : 'a list -> unit = <fun>
+|}];;
+
+(* used to be accepted, see PR#7696 *)
+let rec x = { x with contents = 3 }  [@ocaml.warning "-23"];;
+[%%expect{|
+Line 1, characters 12-35:
+1 | let rec x = { x with contents = 3 }  [@ocaml.warning "-23"];;
+                ^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+(* this is rejected as `c` will be dereferenced during the copy,
+   and is not yet fully defined *)
+let rec c = { c with Complex.re = 1.0 };;
+[%%expect{|
+Line 1, characters 12-39:
+1 | let rec c = { c with Complex.re = 1.0 };;
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x = `A y
+and y = fun () -> ignore x
+;;
+[%%expect{|
+val x : [> `A of unit -> unit ] = `A <fun>
+val y : unit -> unit = <fun>
+|}];;
+
+let rec x = { contents = y }
+and y = fun () -> ignore x;;
+[%%expect{|
+val x : (unit -> unit) ref = {contents = <fun>}
+val y : unit -> unit = <fun>
+|}];;
+
+let r = ref (fun () -> ())
+let rec x = fun () -> r := x;;
+[%%expect{|
+val r : (unit -> unit) ref = {contents = <fun>}
+val x : unit -> unit = <fun>
+|}];;
+
+let rec x = fun () -> y.contents and y = { contents = 3 };;
+[%%expect{|
+val x : unit -> int = <fun>
+val y : int ref = {contents = 3}
+|}];;
+
+let r = ref ()
+let rec x = r := x;;
+[%%expect{|
+val r : unit ref = {contents = ()}
+Line 2, characters 12-18:
+2 | let rec x = r := x;;
+                ^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x =
+  for i = 0 to 1 do
+    let z = y in ignore z
+  done
+and y = x; ();;
+[%%expect{|
+Lines 2-4, characters 2-6:
+2 | ..for i = 0 to 1 do
+3 |     let z = y in ignore z
+4 |   done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x =
+  for i = 0 to y do
+    ()
+  done
+and y = 10;;
+[%%expect{|
+Lines 2-4, characters 2-6:
+2 | ..for i = 0 to y do
+3 |     ()
+4 |   done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x =
+  for i = y to 10 do
+    ()
+  done
+and y = 0;;
+[%%expect{|
+Lines 2-4, characters 2-6:
+2 | ..for i = y to 10 do
+3 |     ()
+4 |   done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x =
+  while false do
+    let y = x in ignore y
+  done
+and y = x; ();;
+[%%expect{|
+Lines 2-4, characters 2-6:
+2 | ..while false do
+3 |     let y = x in ignore y
+4 |   done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x =
+  while y do
+    ()
+  done
+and y = false;;
+[%%expect{|
+Lines 2-4, characters 2-6:
+2 | ..while y do
+3 |     ()
+4 |   done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x =
+  while y do
+    let y = x in ignore y
+  done
+and y = false;;
+[%%expect{|
+Lines 2-4, characters 2-6:
+2 | ..while y do
+3 |     let y = x in ignore y
+4 |   done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+
+
+let rec x = y.contents and y = { contents = 3 };;
+[%%expect{|
+Line 1, characters 12-22:
+1 | let rec x = y.contents and y = { contents = 3 };;
+                ^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x = assert y and y = true;;
+[%%expect{|
+Line 1, characters 12-20:
+1 | let rec x = assert y and y = true;;
+                ^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+(* Recursively constructing arrays of known non-float type is permitted *)
+let rec deep_cycle : [`Tuple of [`Shared of 'a] array] as 'a
+  = `Tuple [| `Shared deep_cycle |];;
+[%%expect{|
+val deep_cycle : [ `Tuple of [ `Shared of 'a ] array ] as 'a =
+  `Tuple [|`Shared <cycle>|]
+|}];;
+
+(* Constructing float arrays was disallowed altogether at one point
+   by an overzealous check.  Constructing float arrays in recursive
+   bindings is fine when they don't partake in the recursion. *)
+let rec _x = let _ = [| 1.0 |] in 1. in ();;
+[%%expect{|
+- : unit = ()
+|}];;
+
+(* The builtin Stdlib.ref is currently treated as a constructor.
+   Other functions of the same name should not be so treated. *)
+let _ =
+  let module Stdlib =
+  struct
+    let ref _ = assert false
+  end in
+  let rec x = Stdlib.ref y
+  and y = fun () -> ignore x
+  in (x, y)
+;;
+[%%expect{|
+Line 6, characters 14-26:
+6 |   let rec x = Stdlib.ref y
+                  ^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+(* An example, from Leo White, of let rec bindings that allocate
+   values of unknown size *)
+let foo p x =
+  let rec f =
+    if p then (fun y -> x + g y) else (fun y -> g y)
+  and g =
+    if not p then (fun y -> x - f y) else (fun y -> f y)
+  in
+  (f, g)
+;;
+[%%expect{|
+Line 3, characters 4-52:
+3 |     if p then (fun y -> x + g y) else (fun y -> g y)
+        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x =
+  match let _ = y in raise Not_found with
+    _ -> "x"
+  | exception Not_found -> "z"
+and y = match x with
+  z -> ("y", z);;
+[%%expect{|
+Lines 2-4, characters 2-30:
+2 | ..match let _ = y in raise Not_found with
+3 |     _ -> "x"
+4 |   | exception Not_found -> "z"
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+
+(* To compute the dependencies of mutually-recursive bindings,
+   transitive dependencies must be taken into account.
+
+   The example below was causing a segfault in 4.08+dev.
+*)
+let rec wrong =
+  (* x depends on y,
+     and y depends on wrong,
+     so it is important to notice that x transitively depends on wrong;
+
+     an earlier version of our letrec analysis would only report that
+     y depends on wrong, which seems safe as y is not used in the
+     body.
+  *)
+  let rec x = ref y
+  and y = ref wrong
+  in ref ("foo" ^ ! ! !x);;
+[%%expect{|
+Lines 10-12, characters 2-25:
+10 | ..let rec x = ref y
+11 |   and y = ref wrong
+12 |   in ref ("foo" ^ ! ! !x)..
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}]
+
+(* in this case, x does not depend on y, so everything is fine *)
+let rec okay =
+  let rec x = ref "bar"
+  and _y = ref okay in
+  ref ("foo" ^ ! x);;
+[%%expect{|
+val okay : string ref = {contents = "foobar"}
+|}]
diff --git a/testsuite/tests/letrec-check/extension_constructor.ml b/testsuite/tests/letrec-check/extension_constructor.ml
new file mode 100644
index 00000000..93171ae1
--- /dev/null
+++ b/testsuite/tests/letrec-check/extension_constructor.ml
@@ -0,0 +1,25 @@
+(* TEST
+   * expect
+*)
+
+(* Example from Stephen Dolan.
+   Accessing an extension constructor involves accessing the module
+   in which it's defined.
+ *)
+module type T =
+  sig exception A of int end;;
+[%%expect{|
+module type T = sig exception A of int end
+|}];;
+
+let rec x =
+  let module M = (val m) in
+  M.A 42
+and (m : (module T)) =
+  (module (struct exception A of int end) : T);;
+[%%expect{|
+Lines 2-3, characters 2-8:
+2 | ..let module M = (val m) in
+3 |   M.A 42
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
diff --git a/testsuite/tests/letrec-check/flat_float_array.ml b/testsuite/tests/letrec-check/flat_float_array.ml
new file mode 100644
index 00000000..e49064cc
--- /dev/null
+++ b/testsuite/tests/letrec-check/flat_float_array.ml
@@ -0,0 +1,52 @@
+(* TEST
+   * flat-float-array
+   ** expect
+*)
+
+(* When the -flat-float-array optimization is active (standard in
+   OCaml versions up to at least 4.07), creating an array may perform
+   a dynamic check, inspecing its first element to decide whether it
+   is a float or not. The check is elided when the type-checker can
+   determine statically that the type of the elements is float, or
+   that it will never be float.
+
+   In the dynamic check case, it is unsound to define in
+   a mutually-recursive way a value and an array containing that
+   value.
+
+   In the case where an array is statically known to be an array of float,
+   this dynamic check does not happen, but the elements are unboxed to
+   be put in the flat float array, so they are dereferenced anyway.
+*)
+
+(* In these tests, `z` is known to be a non-float,
+   so no unboxing or dynamic check happens, the definition is valid. *)
+let f (z: int) = let rec x = [| y; z |] and y = z in x;;
+let f (z: bytes) = let rec x = [| y; z |] and y = z in x;;
+[%%expect {|
+val f : int -> int array = <fun>
+val f : bytes -> bytes array = <fun>
+|}];;
+
+(* In this test, `z` has a generic/polymorphic type,
+   so it could be instantiated with either float or non-float.
+   A dynamic check will occur, so the definition must be rejected. *)
+let f z = let rec x = [| y; z |] and y = z in x;;
+[%%expect {|
+Line 1, characters 22-32:
+1 | let f z = let rec x = [| y; z |] and y = z in x;;
+                          ^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}]
+
+(* In this test, `z` is known to be a float, so a float array will be
+   created. When the flat-float-array optimization is active, the
+   array elements will be unboxed, thus evaluated. This definition
+   must be rejected. *)
+let f (z: float) = let rec x = [| y; z |] and y = z in x;;
+[%%expect {|
+Line 1, characters 31-41:
+1 | let f (z: float) = let rec x = [| y; z |] and y = z in x;;
+                                   ^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}]
diff --git a/testsuite/tests/letrec-check/float_unboxing.ml b/testsuite/tests/letrec-check/float_unboxing.ml
new file mode 100644
index 00000000..6ef268f8
--- /dev/null
+++ b/testsuite/tests/letrec-check/float_unboxing.ml
@@ -0,0 +1,37 @@
+(* TEST
+   * expect
+*)
+
+(* This program is a minimal example which segfault if
+   (e1.x <- e2) considers that (e2) is in Return mode,
+   rather than Dereference -- here a write to a
+   field in a statically-known all-float record is
+   unboxed on the flight, so accepting this example
+   would dereference (when running `g.f <- y` with y
+   uninitialized) an arbitrary address. *)
+type t = { mutable f: float }
+let g = { f = 0.0 }
+let rec x = (g.f <- y; ()) and y = 2.0;;
+[%%expect{|
+type t = { mutable f : float; }
+val g : t = {f = 0.}
+Line 3, characters 12-26:
+3 | let rec x = (g.f <- y; ()) and y = 2.0;;
+                ^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+(* same example, with object instance variables
+   instead of record fields *)
+class c = object
+  val mutable f = 0.0
+  method m =
+    let rec x = (f <- y; ()) and y = 2.0 in f
+end;;
+let _ = print_float (new c)#m;;
+[%%expect{|
+Line 4, characters 16-28:
+4 |     let rec x = (f <- y; ()) and y = 2.0 in f
+                    ^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
diff --git a/testsuite/tests/letrec-check/labels.ml b/testsuite/tests/letrec-check/labels.ml
new file mode 100644
index 00000000..e8b28342
--- /dev/null
+++ b/testsuite/tests/letrec-check/labels.ml
@@ -0,0 +1,33 @@
+(* TEST
+   * expect
+*)
+
+let f ~x () = x ();;
+[%%expect{|
+val f : x:(unit -> 'a) -> unit -> 'a = <fun>
+|}];;
+
+let rec x = f ~x;;
+[%%expect{|
+Line 1, characters 12-16:
+1 | let rec x = f ~x;;
+                ^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let f x ~y = x + y
+(* this function creates "abstracted arguments" in the sense of
+   Rec_check.is_abstracted_arg. Those should be treated as
+   returned/unguarded, and not delayed, otherwise the code below
+   segfaults. *)
+let rec g = f ~y:(print_endline !y; 0)
+and y =
+  let _ = g in (* ignore g to have a real dependency *)
+  ref "foo";;
+[%%expect {|
+val f : int -> y:int -> int = <fun>
+Line 6, characters 12-38:
+6 | let rec g = f ~y:(print_endline !y; 0)
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}]
diff --git a/testsuite/tests/letrec-check/lazy_.ml b/testsuite/tests/letrec-check/lazy_.ml
new file mode 100644
index 00000000..3bec9ec7
--- /dev/null
+++ b/testsuite/tests/letrec-check/lazy_.ml
@@ -0,0 +1,23 @@
+(* TEST
+   * expect
+*)
+
+let rec a = lazy b and b = 3;;
+[%%expect{|
+Line 1, characters 12-18:
+1 | let rec a = lazy b and b = 3;;
+                ^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec e = lazy (fun _ -> f) and f = ();;
+[%%expect{|
+val e : ('a -> unit) lazy_t = lazy <fun>
+val f : unit = ()
+|}];;
+
+let rec x = lazy (Lazy.force x + Lazy.force x)
+  ;;
+[%%expect{|
+val x : int Lazy.t = <lazy>
+|}];;
diff --git a/testsuite/tests/letrec-check/modules.ml b/testsuite/tests/letrec-check/modules.ml
new file mode 100644
index 00000000..fc55f76b
--- /dev/null
+++ b/testsuite/tests/letrec-check/modules.ml
@@ -0,0 +1,105 @@
+(* TEST
+   * expect
+*)
+
+let rec x = let module M = struct let f = x end in ();;
+[%%expect{|
+val x : unit = ()
+|}];;
+
+let rec x = let module M = struct let f = x let g = x () end in fun () -> ();;
+[%%expect{|
+Line 1, characters 12-76:
+1 | let rec x = let module M = struct let f = x let g = x () end in fun () -> ();;
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x = let module _ = struct let _ = x () end in fun () -> ();;
+[%%expect{|
+Line 1, characters 12-66:
+1 | let rec x = let module _ = struct let _ = x () end in fun () -> ();;
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x = let module M = struct let f = x () let g = x end in fun () -> ();;
+[%%expect{|
+Line 1, characters 12-76:
+1 | let rec x = let module M = struct let f = x () let g = x end in fun () -> ();;
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x = (let module M = struct let f = y 0 let g = () end in fun () -> ())
+    and y = succ;;
+[%%expect{|
+Line 1, characters 12-78:
+1 | let rec x = (let module M = struct let f = y 0 let g = () end in fun () -> ())
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x =
+  let module M = struct
+    module N = struct let y = x end
+  end in M.N.y;;
+[%%expect{|
+Lines 2-4, characters 2-14:
+2 | ..let module M = struct
+3 |     module N = struct let y = x end
+4 |   end in M.N.y..
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+module type T = sig val y: int end
+
+let rec x = let module M =
+            struct
+              module N =
+              struct
+                let y = x
+              end
+            end
+  in fun () -> ignore (M.N.y ());;
+[%%expect{|
+module type T = sig val y : int end
+val x : unit -> unit = <fun>
+|}];;
+
+let rec x = let module M = struct let f = x () and g = x end in fun () -> ();;
+[%%expect{|
+Line 1, characters 12-76:
+1 | let rec x = let module M = struct let f = x () and g = x end in fun () -> ();;
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+module type T = sig end
+let rec x = (module (val y : T) : T)
+and y = let module M = struct let x = x end in (module M : T)
+;;
+[%%expect{|
+module type T = sig end
+Line 2, characters 12-36:
+2 | let rec x = (module (val y : T) : T)
+                ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+(* module constraints *)
+module type S = sig               val y : float end;;
+module type T = sig val x : float val y : float end;;
+type t = T : (module S) -> t;;
+
+let rec x = let module M = (val m) in T (module M)
+and (m : (module T)) = (module (struct let x = 10.0 and y = 20.0 end) : T);;
+[%%expect{|
+module type S = sig val y : float end
+module type T = sig val x : float val y : float end
+type t = T : (module S) -> t
+Line 5, characters 12-50:
+5 | let rec x = let module M = (val m) in T (module M)
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
diff --git a/testsuite/tests/letrec-check/no_flat_float_array.ml b/testsuite/tests/letrec-check/no_flat_float_array.ml
new file mode 100644
index 00000000..394669bf
--- /dev/null
+++ b/testsuite/tests/letrec-check/no_flat_float_array.ml
@@ -0,0 +1,32 @@
+(* TEST
+   * no-flat-float-array
+   ** expect
+*)
+
+(* See float_block_disallowed.ml for explanations.
+
+   When the -flat-float-array optimization is *not* set, float arrays
+   are not unboxed, and no dynamic check is performed on generc array
+   creation, so array literals behave just like other constructors
+   and can be defined mutually recursively with their elements.
+*)
+
+(* Case of elements known not to be float. *)
+let f (z: int) = let rec x = [| y; z |] and y = z in x;;
+let f (z: bytes) = let rec x = [| y; z |] and y = z in x;;
+[%%expect {|
+val f : int -> int array = <fun>
+val f : bytes -> bytes array = <fun>
+|}];;
+
+(* Generic case (element may or may not be float), no dynamic test. *)
+let f z = let rec x = [| y; z |] and y = z in x;;
+[%%expect {|
+val f : 'a -> 'a array = <fun>
+|}]
+
+(* Float case, no unboxing. *)
+let f (z: float) = let rec x = [| y; z |] and y = z in x;;
+[%%expect {|
+val f : float -> float array = <fun>
+|}]
diff --git a/testsuite/tests/letrec-check/objects.ml b/testsuite/tests/letrec-check/objects.ml
new file mode 100644
index 00000000..a223450e
--- /dev/null
+++ b/testsuite/tests/letrec-check/objects.ml
@@ -0,0 +1,60 @@
+(* TEST
+   * expect
+*)
+
+class c = object end
+let rec x = fun () -> new c;;
+[%%expect{|
+class c : object  end
+val x : unit -> c = <fun>
+|}];;
+
+class c _ = object end
+let rec x = new c x;;
+[%%expect{|
+class c : 'a -> object  end
+Line 2, characters 12-19:
+2 | let rec x = new c x;;
+                ^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x = y#m and y = object method m = () end;;
+[%%expect{|
+Line 1, characters 12-15:
+1 | let rec x = y#m and y = object method m = () end;;
+                ^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x = (object method m _ = () end)#m x;;
+[%%expect{|
+Line 1, characters 12-44:
+1 | let rec x = (object method m _ = () end)#m x;;
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x = object val mutable v = 0 method m = v <- y end and y = 1;;
+[%%expect{|
+Line 1, characters 12-58:
+1 | let rec x = object val mutable v = 0 method m = v <- y end and y = 1;;
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x = object method m = x end;;
+[%%expect{|
+Line 1, characters 12-35:
+1 | let rec x = object method m = x end;;
+                ^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x = object method m = ignore x end;;
+[%%expect{|
+Line 1, characters 12-42:
+1 | let rec x = object method m = ignore x end;;
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
diff --git a/testsuite/tests/letrec-check/pr7215.ml b/testsuite/tests/letrec-check/pr7215.ml
new file mode 100644
index 00000000..0a13bd6e
--- /dev/null
+++ b/testsuite/tests/letrec-check/pr7215.ml
@@ -0,0 +1,13 @@
+(* TEST
+   * toplevel
+*)
+
+(* From Stephen Dolan *)
+type (_,_) eq = Refl : ('a, 'a) eq;;
+let cast (type a) (type b) (Refl : (a, b) eq) (x : a) = (x : b);;
+
+let is_int (type a) =
+  let rec (p : (int, a) eq) = match p with Refl -> Refl in
+  p
+
+let bang = print_string (cast (is_int : (int, string) eq) 42);;
diff --git a/testsuite/tests/letrec-check/pr7215.ocaml.reference b/testsuite/tests/letrec-check/pr7215.ocaml.reference
new file mode 100644
index 00000000..197a1009
--- /dev/null
+++ b/testsuite/tests/letrec-check/pr7215.ocaml.reference
@@ -0,0 +1,7 @@
+type (_, _) eq = Refl : ('a, 'a) eq
+val cast : ('a, 'b) eq -> 'a -> 'b = <fun>
+Line 3, characters 30-55:
+3 |   let rec (p : (int, a) eq) = match p with Refl -> Refl in
+                                  ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+
diff --git a/testsuite/tests/letrec-check/pr7231.ml b/testsuite/tests/letrec-check/pr7231.ml
new file mode 100644
index 00000000..b2ddf3c2
--- /dev/null
+++ b/testsuite/tests/letrec-check/pr7231.ml
@@ -0,0 +1,5 @@
+(* TEST
+   * toplevel
+*)
+
+let rec r = let rec x () = r and y () = x () in y () in r "oops";;
diff --git a/testsuite/tests/letrec-check/pr7231.ocaml.reference b/testsuite/tests/letrec-check/pr7231.ocaml.reference
new file mode 100644
index 00000000..9b1a5a13
--- /dev/null
+++ b/testsuite/tests/letrec-check/pr7231.ocaml.reference
@@ -0,0 +1,9 @@
+Line 5, characters 58-64:
+5 | let rec r = let rec x () = r and y () = x () in y () in r "oops";;
+                                                              ^^^^^^
+Warning 20: this argument will not be used by the function.
+Line 5, characters 12-52:
+5 | let rec r = let rec x () = r and y () = x () in y () in r "oops";;
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+
diff --git a/testsuite/tests/letrec-check/pr7706.ml b/testsuite/tests/letrec-check/pr7706.ml
new file mode 100644
index 00000000..87403cd5
--- /dev/null
+++ b/testsuite/tests/letrec-check/pr7706.ml
@@ -0,0 +1,8 @@
+(* TEST
+   * toplevel
+*)
+let rec x =
+  let y = if false then (fun z -> 1) else (fun z -> x 4 + 1) in
+  y;;
+
+let () = ignore (x 42);;
diff --git a/testsuite/tests/letrec-check/pr7706.ocaml.reference b/testsuite/tests/letrec-check/pr7706.ocaml.reference
new file mode 100644
index 00000000..71544e4a
--- /dev/null
+++ b/testsuite/tests/letrec-check/pr7706.ocaml.reference
@@ -0,0 +1,9 @@
+Lines 5-6, characters 2-3:
+5 | ..let y = if false then (fun z -> 1) else (fun z -> x 4 + 1) in
+6 |   y..
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+Line 2, characters 17-18:
+2 | let () = ignore (x 42);;
+                     ^
+Error: Unbound value x
+
diff --git a/testsuite/tests/letrec-check/records.ml b/testsuite/tests/letrec-check/records.ml
new file mode 100644
index 00000000..db11d41e
--- /dev/null
+++ b/testsuite/tests/letrec-check/records.ml
@@ -0,0 +1,31 @@
+(* TEST
+   * expect
+*)
+type t = { x : int; self : t };;
+[%%expect {|
+type t = { x : int; self : t; }
+|}];;
+
+let rec x = 1
+and u = Some { t with x = 2 }
+and t = { x; self = t }
+(* We have carefully placed `u` before `t` here,
+   so that the copy { t with .. }, if accepted,
+   is evaluated before 't' is initialized -- making
+   the assertion below fail, typically aborting
+   with a segmentation fault.
+
+   If you exchange the declaration orders of `u` and `t`,
+   and the static check accepts this example, then `t`
+   is initialized first and the assertion succeeds. *)
+
+
+let () = match u with
+  | None -> assert false
+  | Some {x = _; self} -> assert (self.x = t.x)
+[%%expect {|
+Line 2, characters 8-29:
+2 | and u = Some { t with x = 2 }
+            ^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
diff --git a/testsuite/tests/letrec-check/unboxed.ml b/testsuite/tests/letrec-check/unboxed.ml
new file mode 100644
index 00000000..7c04199e
--- /dev/null
+++ b/testsuite/tests/letrec-check/unboxed.ml
@@ -0,0 +1,109 @@
+(* TEST
+   * expect
+*)
+
+type r = R of r list [@@unboxed]
+let rec a = R [a];;
+[%%expect{|
+type r = R of r list [@@unboxed]
+val a : r = R [<cycle>]
+|}];;
+
+
+type t = {x: int64} [@@unboxed]
+let rec x = {x = y} and y = 3L;;
+[%%expect{|
+type t = { x : int64; } [@@unboxed]
+Line 2, characters 12-19:
+2 | let rec x = {x = y} and y = 3L;;
+                ^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+type r = A of r [@@unboxed]
+let rec y = A y;;
+[%%expect{|
+type r = A of r [@@unboxed]
+Line 2, characters 12-15:
+2 | let rec y = A y;;
+                ^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+(* This test is not allowed if 'a' is unboxed, but should be accepted
+   as written *)
+type a = {a: b}
+and b = X of a | Y
+
+let rec a =
+  {a=
+    (if Sys.opaque_identity true then
+       X a
+     else
+       Y)};;
+[%%expect{|
+type a = { a : b; }
+and b = X of a | Y
+val a : a = {a = X <cycle>}
+|}];;
+
+type a = {a: b }[@@unboxed]
+and b = X of a | Y
+
+let rec a =
+  {a=
+    (if Sys.opaque_identity true then
+       X a
+     else
+       Y)};;
+[%%expect{|
+type a = { a : b; } [@@unboxed]
+and b = X of a | Y
+Lines 5-9, characters 2-10:
+5 | ..{a=
+6 |     (if Sys.opaque_identity true then
+7 |        X a
+8 |      else
+9 |        Y)}..
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+(* This test is not allowed if 'c' is unboxed, but should be accepted
+   as written *)
+type d = D of e
+and e = V of d | W;;
+[%%expect{|
+type d = D of e
+and e = V of d | W
+|}];;
+
+let rec d =
+  D
+    (if Sys.opaque_identity true then
+       V d
+     else
+       W);;
+[%%expect{|
+val d : d = D (V <cycle>)
+|}];;
+
+type d = D of e [@@unboxed]
+and e = V of d | W;;
+
+let rec d =
+  D
+    (if Sys.opaque_identity true then
+       V d
+     else
+       W);;
+[%%expect{|
+type d = D of e [@@unboxed]
+and e = V of d | W
+Lines 5-9, characters 2-9:
+5 | ..D
+6 |     (if Sys.opaque_identity true then
+7 |        V d
+8 |      else
+9 |        W)..
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
diff --git a/testsuite/tests/letrec-compilation/backreferences.ml b/testsuite/tests/letrec-compilation/backreferences.ml
new file mode 100644
index 00000000..abde8c2d
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/backreferences.ml
@@ -0,0 +1,20 @@
+(* TEST *)
+
+(* testing backreferences; some compilation scheme may handle
+   differently recursive references to a mutually-recursive RHS
+   depending on whether it is before or after in the bindings list *)
+type t = { x : t; y : t; z : t }
+
+let test =
+  let rec x = { x; y; z }
+      and y = { x; y; z }
+      and z = { x; y; z }
+  in
+  List.iter (fun (f, t_ref) ->
+    List.iter (fun t -> assert (f t == t_ref)) [x; y; z]
+  )
+    [
+      (fun t -> t.x), x;
+      (fun t -> t.y), y;
+      (fun t -> t.z), z;
+    ]
diff --git a/testsuite/tests/letrec-compilation/backreferences.reference b/testsuite/tests/letrec-compilation/backreferences.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/letrec-compilation/class_1.ml b/testsuite/tests/letrec-compilation/class_1.ml
new file mode 100644
index 00000000..4a1fdc9b
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/class_1.ml
@@ -0,0 +1,7 @@
+(* TEST *)
+
+(* class expression are compiled to recursive bindings *)
+class test =
+object
+  method x = 1
+end
diff --git a/testsuite/tests/letrec-compilation/class_1.reference b/testsuite/tests/letrec-compilation/class_1.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/letrec-compilation/class_2.ml b/testsuite/tests/letrec-compilation/class_2.ml
new file mode 100644
index 00000000..a76835d1
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/class_2.ml
@@ -0,0 +1,10 @@
+(* TEST *)
+
+(* class expressions may also contain local recursive bindings *)
+class test =
+  let rec f = print_endline "f"; fun x -> g x
+      and g = print_endline "g"; fun x -> f x in
+object
+  method f : 'a 'b. 'a -> 'b = f
+  method g : 'a 'b. 'a -> 'b = g
+end
diff --git a/testsuite/tests/letrec-compilation/class_2.reference b/testsuite/tests/letrec-compilation/class_2.reference
new file mode 100644
index 00000000..ab713757
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/class_2.reference
@@ -0,0 +1,2 @@
+f
+g
diff --git a/testsuite/tests/letrec-compilation/evaluation_order_1.ml b/testsuite/tests/letrec-compilation/evaluation_order_1.ml
new file mode 100644
index 00000000..466c20d7
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/evaluation_order_1.ml
@@ -0,0 +1,22 @@
+(* TEST *)
+
+(* test evaluation order
+
+   'y' is translated into a constant, and is therefore considered
+   non-recursive. With the current letrec compilation method,
+   it should be evaluated before x and z.
+*)
+type tree = Tree of tree list
+
+let test =
+  let rec x = (print_endline "effect"; Tree [y; z])
+  and y = (print_endline "effect"; Tree [])
+  and z = (print_endline "effect"; Tree [x])
+  in
+  match (x, y, z) with
+    | (Tree [y1; z1], Tree[], Tree[x1]) ->
+      assert (y1 == y);
+      assert (z1 == z);
+      assert (x1 == x)
+    | _ ->
+      assert false
diff --git a/testsuite/tests/letrec-compilation/evaluation_order_1.reference b/testsuite/tests/letrec-compilation/evaluation_order_1.reference
new file mode 100644
index 00000000..bf36c925
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/evaluation_order_1.reference
@@ -0,0 +1,3 @@
+effect
+effect
+effect
diff --git a/testsuite/tests/letrec-compilation/evaluation_order_2.ml b/testsuite/tests/letrec-compilation/evaluation_order_2.ml
new file mode 100644
index 00000000..7d34a099
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/evaluation_order_2.ml
@@ -0,0 +1,21 @@
+(* TEST *)
+
+(* A variant of evaluation_order_1.ml where the side-effects
+   are inside the blocks.
+   Effect are not named to allow different evaluation orders (flambda
+   and clambda differ on this point).
+*)
+type tree = Tree of tree list
+
+let test =
+  let rec x = (Tree [(print_endline "effect"; y); z])
+  and y = Tree (print_endline "effect"; [])
+  and z = Tree (print_endline "effect"; [x])
+  in
+  match (x, y, z) with
+    | (Tree [y1; z1], Tree[], Tree[x1]) ->
+      assert (y1 == y);
+      assert (z1 == z);
+      assert (x1 == x)
+    | _ ->
+      assert false
diff --git a/testsuite/tests/letrec-compilation/evaluation_order_2.reference b/testsuite/tests/letrec-compilation/evaluation_order_2.reference
new file mode 100644
index 00000000..bf36c925
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/evaluation_order_2.reference
@@ -0,0 +1,3 @@
+effect
+effect
+effect
diff --git a/testsuite/tests/letrec-compilation/evaluation_order_3.ml b/testsuite/tests/letrec-compilation/evaluation_order_3.ml
new file mode 100644
index 00000000..f330009b
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/evaluation_order_3.ml
@@ -0,0 +1,13 @@
+(* TEST *)
+
+type t = { x : t; y : t }
+
+let p = print_endline
+
+let test =
+  let rec x = p "x"; { x = (p "x_x"; x); y = (p "x_y"; y) }
+      and y = p "y"; { x = (p "y_x"; x); y = (p "y_y"; y) }
+   in
+   assert (x.x == x); assert (x.y == y);
+   assert (y.x == x); assert (y.y == y);
+   ()
diff --git a/testsuite/tests/letrec-compilation/evaluation_order_3.reference b/testsuite/tests/letrec-compilation/evaluation_order_3.reference
new file mode 100644
index 00000000..5b8c549e
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/evaluation_order_3.reference
@@ -0,0 +1,6 @@
+x
+x_y
+x_x
+y
+y_y
+y_x
diff --git a/testsuite/tests/letrec-compilation/float_block_1.ml b/testsuite/tests/letrec-compilation/float_block_1.ml
new file mode 100644
index 00000000..a3ff37ad
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/float_block_1.ml
@@ -0,0 +1,12 @@
+(* TEST *)
+
+(* Effect are not named to allow different evaluation orders (flambda
+   and clambda differ on this point).
+ *)
+let test =
+  let rec x = print_endline "effect"; [| 1; 2; 3 |]
+      and y = print_endline "effect"; [| 1.; 2.; 3. |]
+  in
+  assert (x = [| 1; 2; 3 |]);
+  assert (y = [| 1.; 2.; 3. |]);
+  ()
diff --git a/testsuite/tests/letrec-compilation/float_block_1.reference b/testsuite/tests/letrec-compilation/float_block_1.reference
new file mode 100644
index 00000000..fa0efbd2
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/float_block_1.reference
@@ -0,0 +1,2 @@
+effect
+effect
diff --git a/testsuite/tests/letrec-compilation/generic_array.ml b/testsuite/tests/letrec-compilation/generic_array.ml
new file mode 100644
index 00000000..3a8c6ff1
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/generic_array.ml
@@ -0,0 +1,5 @@
+(* TEST *)
+
+let rec x = let _y = [| |] in ();;
+
+let rec x = let y = [| |] in y :: x;;
diff --git a/testsuite/tests/letrec-compilation/generic_array.reference b/testsuite/tests/letrec-compilation/generic_array.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/letrec-compilation/labels.ml b/testsuite/tests/letrec-compilation/labels.ml
new file mode 100644
index 00000000..7a1d29d4
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/labels.ml
@@ -0,0 +1,4 @@
+(* TEST *)
+
+let f () ~x = x ()
+let rec x = f ~x
diff --git a/testsuite/tests/letrec-compilation/labels.reference b/testsuite/tests/letrec-compilation/labels.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/letrec-compilation/lazy_.ml b/testsuite/tests/letrec-compilation/lazy_.ml
new file mode 100644
index 00000000..6929d81e
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/lazy_.ml
@@ -0,0 +1,5 @@
+(* TEST *)
+
+let rec c = lazy (0 + d) and d = 3;;
+
+let () = Printf.printf "%d\n" (Lazy.force c)
diff --git a/testsuite/tests/letrec-compilation/lazy_.reference b/testsuite/tests/letrec-compilation/lazy_.reference
new file mode 100644
index 00000000..00750edc
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/lazy_.reference
@@ -0,0 +1 @@
+3
diff --git a/testsuite/tests/letrec-compilation/lists.ml b/testsuite/tests/letrec-compilation/lists.ml
new file mode 100644
index 00000000..c0581beb
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/lists.ml
@@ -0,0 +1,10 @@
+(* TEST *)
+
+(* a test with lists, because cyclic lists are fun *)
+let test =
+  let rec li = 0::1::2::3::4::5::6::7::8::9::li in
+  match li with
+    | 0::1::2::3::4::5::6::7::8::9::
+        0::1::2::3::4::5::6::7::8::9::li' ->
+      assert (li == li')
+    | _ -> assert false
diff --git a/testsuite/tests/letrec-compilation/lists.reference b/testsuite/tests/letrec-compilation/lists.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/letrec-compilation/mixing_value_closures_1.ml b/testsuite/tests/letrec-compilation/mixing_value_closures_1.ml
new file mode 100644
index 00000000..c493da9a
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/mixing_value_closures_1.ml
@@ -0,0 +1,10 @@
+(* TEST *)
+
+(* mixing values and closures may exercise interesting code paths *)
+type t = A of (int -> int)
+let test =
+  let rec x = A f
+  and f = function
+    | 0 -> 2
+    | n -> match x with A g -> g 0
+  in assert (f 1 = 2)
diff --git a/testsuite/tests/letrec-compilation/mixing_value_closures_1.reference b/testsuite/tests/letrec-compilation/mixing_value_closures_1.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/letrec-compilation/mixing_value_closures_2.ml b/testsuite/tests/letrec-compilation/mixing_value_closures_2.ml
new file mode 100644
index 00000000..27f5f956
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/mixing_value_closures_2.ml
@@ -0,0 +1,10 @@
+(* TEST *)
+
+(* a polymorphic variant of test3.ml; found a real bug once *)
+let test =
+  let rec x = `A f
+  and f = function
+    | 0 -> 2
+    | n -> match x with `A g -> g 0
+  in
+  assert (f 1 = 2)
diff --git a/testsuite/tests/letrec-compilation/mixing_value_closures_2.reference b/testsuite/tests/letrec-compilation/mixing_value_closures_2.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/letrec-compilation/mutual_functions.ml b/testsuite/tests/letrec-compilation/mutual_functions.ml
new file mode 100644
index 00000000..34b62fe1
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/mutual_functions.ml
@@ -0,0 +1,13 @@
+(* TEST *)
+
+(* a simple test with mutually recursive functions *)
+let test =
+  let rec even = function
+    | 0 -> true
+    | n -> odd (n - 1)
+  and odd = function
+    | 0 -> false
+    | n -> even (n - 1)
+  in
+  List.iter (fun i -> assert (even i <> odd i && even i = (i mod 2 = 0)))
+    [0;1;2;3;4;5;6]
diff --git a/testsuite/tests/letrec-compilation/mutual_functions.reference b/testsuite/tests/letrec-compilation/mutual_functions.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/letrec-compilation/nested.ml b/testsuite/tests/letrec-compilation/nested.ml
new file mode 100644
index 00000000..4d461d0a
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/nested.ml
@@ -0,0 +1,9 @@
+(* TEST *)
+
+(* Mantis PR7447 *)
+
+let rec r = (let rec x = `A r and y = fun () -> x in y)
+
+let (`A x) = r ()
+
+let _ = x ()
diff --git a/testsuite/tests/letrec-compilation/nested.reference b/testsuite/tests/letrec-compilation/nested.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/letrec-compilation/pr4989.ml b/testsuite/tests/letrec-compilation/pr4989.ml
new file mode 100644
index 00000000..b3ddb2d9
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/pr4989.ml
@@ -0,0 +1,3 @@
+(* TEST *)
+
+let rec f = let g = f in fun x -> g x;;
diff --git a/testsuite/tests/letrec-compilation/pr4989.reference b/testsuite/tests/letrec-compilation/pr4989.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/letrec-compilation/pr8681.ml b/testsuite/tests/letrec-compilation/pr8681.ml
new file mode 100644
index 00000000..7e9ab0e8
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/pr8681.ml
@@ -0,0 +1,63 @@
+(* TEST *)
+let rec h =
+  let rec f n = if n >= 0 then g (n - 1)
+  and g n = h n; f n in
+  f
+
+let () = Gc.minor ()
+let () = ignore (h 10)
+
+let mooo x =
+  let rec h =
+    ignore (Sys.opaque_identity x);
+    let rec g n = h n; f n
+    and f n = if n >= 0 then g (n - 1) in
+    f
+  in
+  h
+
+let h = mooo 3
+let () = Gc.minor ()
+let () = ignore (h 10)
+
+
+let rec foo =
+  let rec f = function
+    | 0 -> 100
+    | n -> foo (n-1)
+  and g = function
+    | 0 -> 200
+    | n -> f (n-1) in
+  g
+
+let () = print_int (foo 2); print_newline ()
+let () = print_int (foo 7); print_newline ()
+
+
+let with_free_vars a b c =
+  let rec foo =
+    let rec f = function
+      | 0 -> 100 + a + b + c
+      | n -> foo (n-1)
+    and g = function
+      | 0 -> 200 + a + b + c
+      | n -> f (n-1) in
+    g in
+  foo
+
+let () = print_int (with_free_vars 1 2 3 2); print_newline ()
+let () = print_int (with_free_vars 1 2 3 7); print_newline ()
+
+let bar =
+  let rec f = function
+    | 0 -> 3
+    | n -> g (n - 1)
+  and g = function
+    | 0 -> 10 + f 10
+    | n -> f (n - 1)
+  in
+  let rec foof = f
+  and goof = g
+  in (foof, goof)
+
+let () = print_int (snd bar 42); print_newline ()
diff --git a/testsuite/tests/letrec-compilation/pr8681.reference b/testsuite/tests/letrec-compilation/pr8681.reference
new file mode 100644
index 00000000..8e0fba10
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/pr8681.reference
@@ -0,0 +1,5 @@
+200
+100
+206
+106
+13
diff --git a/testsuite/tests/letrec-compilation/record_with.ml b/testsuite/tests/letrec-compilation/record_with.ml
new file mode 100644
index 00000000..3a1a5e68
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/record_with.ml
@@ -0,0 +1,26 @@
+(* TEST *)
+
+(* A regression test for both PR#4141 and PR#5819: when a recursive
+   variable is defined by a { record with ... } expression.
+*)
+
+type t = {
+  self : t;
+  t0 : int;
+  t1 : int;
+  t2 : int;
+  t3 : int;
+  t4 : int;
+};;
+let rec t = {
+  self = t;
+  t0 = 42;
+  t1 = 42;
+  t2 = 42;
+  t3 = 42;
+  t4 = 42;
+};;
+
+let rec self = { t with self=self } in
+Printf.printf "%d\n" self.self.t0
+;;
diff --git a/testsuite/tests/letrec-compilation/record_with.reference b/testsuite/tests/letrec-compilation/record_with.reference
new file mode 100644
index 00000000..d81cc071
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/record_with.reference
@@ -0,0 +1 @@
+42
diff --git a/testsuite/tests/letrec-compilation/ref.ml b/testsuite/tests/letrec-compilation/ref.ml
new file mode 100644
index 00000000..990191c4
--- /dev/null
+++ b/testsuite/tests/letrec-compilation/ref.ml
@@ -0,0 +1,15 @@
+(* TEST *)
+
+(* Test construction of cyclic values where the cycles pass through
+   references *)
+
+type t = { mutable next : t; mutable inst : n ref }
+and n = T of t
+
+let rec d = { next = d; inst = ref (T d) }
+
+let f t1 t2 =
+  let rec self = ref init
+  and init () = t1 (function () -> self := t2; t2 ())
+  in fun () -> !self ()
+;;
diff --git a/testsuite/tests/letrec-compilation/ref.reference b/testsuite/tests/letrec-compilation/ref.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/lexing/comments.ml b/testsuite/tests/lexing/comments.ml
new file mode 100644
index 00000000..a7c9f275
--- /dev/null
+++ b/testsuite/tests/lexing/comments.ml
@@ -0,0 +1,11 @@
+(* TEST
+   * toplevel
+*)
+
+(* "*)" *)
+
+(* {|*)|} *)
+
+(* '"' *)
+
+(* f' '"' *)
diff --git a/testsuite/tests/lexing/comments.ocaml.reference b/testsuite/tests/lexing/comments.ocaml.reference
new file mode 100644
index 00000000..8b137891
--- /dev/null
+++ b/testsuite/tests/lexing/comments.ocaml.reference
@@ -0,0 +1 @@
+
diff --git a/testsuite/tests/lexing/escape.ml b/testsuite/tests/lexing/escape.ml
new file mode 100644
index 00000000..bcb75313
--- /dev/null
+++ b/testsuite/tests/lexing/escape.ml
@@ -0,0 +1,11 @@
+(* TEST
+   * toplevel
+*)
+
+(* Errors *)
+
+let invalid = "\99" ;;
+let invalid = "\999" ;;
+let invalid = "\o777" ;;
+let invalid = "\o77" ;;
+let invalid = "\o99" ;;
diff --git a/testsuite/tests/lexing/escape.ocaml.reference b/testsuite/tests/lexing/escape.ocaml.reference
new file mode 100644
index 00000000..2e9d9fd5
--- /dev/null
+++ b/testsuite/tests/lexing/escape.ocaml.reference
@@ -0,0 +1,24 @@
+Line 7, characters 15-17:
+7 | let invalid = "\99" ;;
+                   ^^
+Warning 14: illegal backslash escape in string.
+val invalid : string = "\\99"
+Line 1, characters 15-19:
+1 | let invalid = "\999" ;;
+                   ^^^^
+Error: Illegal backslash escape in string or character (\999): 999 is outside the range of legal characters (0-255).
+Line 1, characters 15-20:
+1 | let invalid = "\o777" ;;
+                   ^^^^^
+Error: Illegal backslash escape in string or character (\o777): o777 (=511) is outside the range of legal characters (0-255).
+Line 1, characters 15-17:
+1 | let invalid = "\o77" ;;
+                   ^^
+Warning 14: illegal backslash escape in string.
+val invalid : string = "\\o77"
+Line 1, characters 15-17:
+1 | let invalid = "\o99" ;;
+                   ^^
+Warning 14: illegal backslash escape in string.
+val invalid : string = "\\o99"
+
diff --git a/testsuite/tests/lexing/uchar_esc.ml b/testsuite/tests/lexing/uchar_esc.ml
new file mode 100644
index 00000000..3e7b5379
--- /dev/null
+++ b/testsuite/tests/lexing/uchar_esc.ml
@@ -0,0 +1,37 @@
+(* TEST
+   * toplevel
+*)
+
+(* Correct escapes and their encoding *)
+
+let () =
+  assert ("\xF0\x9F\x90\xAB" = "\u{1F42B}");
+  assert ("\xF0\x9F\x90\xAB" = "\u{01F42B}");
+  assert ("\x00" = "\u{0}");
+  assert ("\x00" = "\u{00}");
+  assert ("\x00" = "\u{000}");
+  assert ("\x00" = "\u{0000}");
+  assert ("\x00" = "\u{00000}");
+  assert ("\x00" = "\u{000000}");
+  assert ("\xC3\xA9" = "\u{E9}");
+  assert ("\xC3\xA9" = "\u{0E9}");
+  assert ("\xC3\xA9" = "\u{00E9}");
+  assert ("\xC3\xA9" = "\u{000E9}");
+  assert ("\xC3\xA9" = "\u{0000E9}");
+  assert ("\xC3\xA9" = "\u{0000E9}");
+  assert ("\xF4\x8F\xBF\xBF" = "\u{10FFFF}");
+  ()
+;;
+
+
+(* Errors *)
+
+let invalid_sv = "\u{0D800}" ;;
+let invalid_sv = "\u{D800}" ;;
+let invalid_sv = "\u{D900}" ;;
+let invalid_sv = "\u{DFFF}" ;;
+let invalid_sv = "\u{110000} ;;
+
+let too_many_digits = "\u{01234567}" ;;
+let no_hex_digits = "\u{}" ;;
+let illegal_hex_digit = "\u{u}" ;;
diff --git a/testsuite/tests/lexing/uchar_esc.ocaml.reference b/testsuite/tests/lexing/uchar_esc.ocaml.reference
new file mode 100644
index 00000000..953104ae
--- /dev/null
+++ b/testsuite/tests/lexing/uchar_esc.ocaml.reference
@@ -0,0 +1,35 @@
+Line 5, characters 18-27:
+5 | let invalid_sv = "\u{0D800}" ;;
+                      ^^^^^^^^^
+Error: Illegal backslash escape in string or character (\u{0D800}): D800 is not a Unicode scalar value
+Line 1, characters 18-26:
+1 | let invalid_sv = "\u{D800}" ;;
+                      ^^^^^^^^
+Error: Illegal backslash escape in string or character (\u{D800}): D800 is not a Unicode scalar value
+Line 1, characters 18-26:
+1 | let invalid_sv = "\u{D900}" ;;
+                      ^^^^^^^^
+Error: Illegal backslash escape in string or character (\u{D900}): D900 is not a Unicode scalar value
+Line 1, characters 18-26:
+1 | let invalid_sv = "\u{DFFF}" ;;
+                      ^^^^^^^^
+Error: Illegal backslash escape in string or character (\u{DFFF}): DFFF is not a Unicode scalar value
+Line 1, characters 18-28:
+1 | let invalid_sv = "\u{110000} ;;
+                      ^^^^^^^^^^
+Error: Illegal backslash escape in string or character (\u{110000}): 110000 is not a Unicode scalar value
+Line 2, characters 23-35:
+2 | let too_many_digits = "\u{01234567}" ;;
+                           ^^^^^^^^^^^^
+Error: Illegal backslash escape in string or character (\u{01234567}): too many digits, expected 1 to 6 hexadecimal digits
+Line 1, characters 21-23:
+1 | let no_hex_digits = "\u{}" ;;
+                         ^^
+Warning 14: illegal backslash escape in string.
+val no_hex_digits : string = "\\u{}"
+Line 1, characters 25-27:
+1 | let illegal_hex_digit = "\u{u}" ;;
+                             ^^
+Warning 14: illegal backslash escape in string.
+val illegal_hex_digit : string = "\\u{u}"
+
diff --git a/testsuite/tests/lib-arg/testarg.ml b/testsuite/tests/lib-arg/testarg.ml
new file mode 100644
index 00000000..5fb9f5b8
--- /dev/null
+++ b/testsuite/tests/lib-arg/testarg.ml
@@ -0,0 +1,209 @@
+(* TEST
+   compare_programs = "false" (* See https://github.com/ocaml/ocaml/pull/8853 *)
+*)
+
+let current = ref 0;;
+
+let accum = ref [];;
+
+let record fmt (* args *) =
+  Printf.kprintf (fun s -> accum := s :: !accum) fmt
+;;
+
+let f_unit () = record "unit()";;
+let f_bool b = record "bool(%B)" b;;
+let r_set = ref false;;
+let r_clear = ref true;;
+let f_string s = record "string(%s)" s;;
+let r_string = ref "";;
+let f_int i = record "int(%d)" i;;
+let r_int = ref 0;;
+let f_float f = record "float(%g)" f;;
+let r_float = ref 0.0;;
+let f_symbol s = record "symbol(%s)" s;;
+let f_rest s = record "rest(%s)" s;;
+let f_anon s = record "anon(%s)" s;;
+
+let spec = Arg.[
+  "-u", Unit f_unit, "Unit (0)";
+  "-b", Bool f_bool, "Bool (1)";
+  "-s", Set r_set, "Set (0)";
+  "-c", Clear r_clear, "Clear (0)";
+  "-str", String f_string, "String (1)";
+  "-sstr", Set_string r_string, "Set_string (1)";
+  "-i", Int f_int, "Int (1)";
+  "-si", Set_int r_int, "Set_int (1)";
+  "-f", Float f_float, "Float (1)";
+  "-sf", Set_float r_float, "Set_float (1)";
+  "-t", Tuple [Bool f_bool; String f_string; Int f_int], "Tuple (3)";
+  "-sym", Symbol (["a"; "b"; "c"], f_symbol), "Symbol (1)";
+  "-rest", Rest f_rest, "Rest (*)";
+];;
+
+let args1 = [|
+  "prog";
+  "anon1";
+  "-u";
+  "-b"; "true";
+  "-s";
+  "anon2";
+  "-c";
+  "-str"; "foo";
+  "-sstr"; "bar";
+  "-i"; "19";
+  "-si"; "42";
+  "-f"; "3.14";
+  "-sf"; "2.72";
+  "anon3";
+  "-t"; "false"; "gee"; "1436";
+  "-sym"; "c";
+  "anon4";
+  "-rest"; "r1"; "r2";
+|];;
+
+let args2 = [|
+  "prog";
+  "anon1";
+  "-u";
+  "-b=true";
+  "-s";
+  "anon2";
+  "-c";
+  "-str=foo";
+  "-sstr=bar";
+  "-i=19";
+  "-si=42";
+  "-f=3.14";
+  "-sf=2.72";
+  "anon3";
+  "-t"; "false"; "gee"; "1436";
+  "-sym=c";
+  "anon4";
+  "-rest"; "r1"; "r2";
+|];;
+
+let error s = Printf.printf "error (%s)\n" s;;
+let check r v msg = if !r <> v then error msg;;
+
+let test spec argv =
+  current := 0;
+  r_set := false;
+  r_clear := true;
+  r_string := "";
+  r_int := 0;
+  r_float := 0.0;
+  accum := [];
+  Arg.parse_and_expand_argv_dynamic current argv (ref spec) f_anon "usage";
+  let result = List.rev !accum in
+  let reference = [
+      "anon(anon1)";
+      "unit()";
+      "bool(true)";
+      "anon(anon2)";
+      "string(foo)";
+      "int(19)";
+      "float(3.14)";
+      "anon(anon3)";
+      "bool(false)"; "string(gee)"; "int(1436)";
+      "symbol(c)";
+      "anon(anon4)";
+      "rest(r1)"; "rest(r2)";
+    ]
+  in
+  if result <> reference then begin
+    let f x y =
+      Printf.printf "%20s %c %-20s\n%!" x (if x = y then '=' else '#') y
+    in
+    List.iter2 f result reference;
+  end;
+  check r_set true "Set";
+  check r_clear false "Clear";
+  check r_string "bar" "Set_string";
+  check r_int 42 "Set_int";
+  check r_float 2.72 "Set_float";
+;;
+
+let test_arg args = test spec (ref args);;
+
+test_arg args1;;
+test_arg args2;;
+
+
+let safe_rm file =
+  try
+    Sys.remove file
+  with _ -> ()
+
+let test_rw argv =
+  safe_rm "test_rw";
+  safe_rm "test_rw0";
+  Arg.write_arg "test_rw" argv;
+  Arg.write_arg0 "test_rw0" argv;
+  let argv' = Arg.read_arg "test_rw" in
+  let argv0 = Arg.read_arg0 "test_rw0" in
+  let f x y =
+    if x <> y then
+      Printf.printf "%20s %c %-20s\n%!" x (if x = y then '=' else '#') y
+  in
+  Array.iter2 f argv argv';
+  Array.iter2 f argv argv0;
+  safe_rm "test_rw";
+  safe_rm "test_rw0";
+;;
+
+test_rw args1;;
+test_rw args2;;
+test_rw (Array.make 0 "");;
+test_rw [|"";""|];;
+
+let f_expand r msg arg s =
+  if s <> r then error msg;
+  arg;
+;;
+
+let expand1,args1,expected1 =
+  let l = Array.length args1  - 1 in
+  let args = Array.sub args1 1 l in
+  let args1 =  [|"prog";"-expand";"expand_arg1"|] in
+  Arg.["-expand", Expand (f_expand "expand_arg1" "Expand" args), "Expand (1)";],
+  args1,
+  Array.append  args1 args
+;;
+
+let expand2,args2,expected2 =
+  let l = Array.length args2  - 1 in
+  let args = Array.sub args2 1 l in
+  let args2 = [|"prog";"-expand";"expand_arg2"|] in
+  Arg.["-expand", Expand (f_expand "expand_arg2" "Expand" args), "Expand (1)";],
+  args2,
+  Array.append args2 args
+;;
+
+let test_expand spec argv reference =
+  let result = ref argv in
+  test spec result;
+  let f x y =
+    if x <> y then
+      Printf.printf "%20s %c %-20s\n%!" x (if x = y then '=' else '#') y
+  in
+  Array.iter2 f !result reference;
+;;
+
+test_expand (expand1@spec) args1 expected1;;
+test_expand (expand2@spec) args2 expected2;;
+
+let test_align () =
+  let spec =
+    [
+      "-foo", Arg.String ignore, "FOO Do foo with FOO";
+      "-bar", Arg.Tuple [Arg.String ignore; Arg.String ignore],
+              "FOO BAR\tDo bar with FOO and BAR";
+      "-cha", Arg.Unit ignore, " Another option";
+      "-sym", Arg.Symbol (["a"; "b"], ignore), "\ty\tfoo";
+      "-sym2", Arg.Symbol (["a"; "b"], ignore), "x bar";
+    ]
+  in
+  print_endline (Arg.usage_string (Arg.align spec) "")
+;;
+
+test_align ();;
diff --git a/testsuite/tests/lib-arg/testarg.reference b/testsuite/tests/lib-arg/testarg.reference
new file mode 100644
index 00000000..60492762
--- /dev/null
+++ b/testsuite/tests/lib-arg/testarg.reference
@@ -0,0 +1,11 @@
+
+  -foo FOO     Do foo with FOO
+  -bar FOO BAR Do bar with FOO and BAR
+  -cha         Another option
+  -sym {a|b}
+               y	foo
+  -sym2 {a|b}
+             x bar
+  -help        Display this list of options
+  --help       Display this list of options
+
diff --git a/testsuite/tests/lib-arg/testerror.ml b/testsuite/tests/lib-arg/testerror.ml
new file mode 100644
index 00000000..6ae29205
--- /dev/null
+++ b/testsuite/tests/lib-arg/testerror.ml
@@ -0,0 +1,53 @@
+(* TEST
+   * native
+     compare_programs = "false"
+*)
+
+(** Test that the right message errors are emitted by Arg *)
+
+
+let usage= "Arg module testing"
+
+let test total i (spec,anon,argv) =
+  let argv = Array.of_list ("testerror" :: argv) in
+  try Arg.parse_argv ~current:(ref 0) argv spec anon usage with
+  | Arg.Bad s-> Printf.printf "(%d/%d) Bad:\n%s\n" (i+1) total s
+  | Arg.Help s -> Printf.printf "(%d/%d) Help:\n%s\n" (i+1) total s
+
+
+let tests = [
+(** missing argument error *)
+  ["-s",  Arg.String ignore, "missing arg"], ignore, ["-s"]
+
+(** No argument expected *)
+; ["-set",  Arg.Set (ref false), "no argument expected"], ignore, ["-set=true"]
+
+(** help message *)
+; [], ignore, ["-help" ]
+
+(** wrong argument type *)
+; ["-int", Arg.Int ignore, "wrong argument type" ], ignore,
+  ["-int"; "not_an_int" ]
+
+(** unknown option *)
+; [], ignore, [ "-an-unknown-option" ]
+
+(** user-error in anon fun *)
+; [], (fun _ -> raise @@ Arg.Bad("User-raised error")), [ "argument" ]
+
+(** user-error in anon fun *)
+; ["-error",
+   Arg.Unit (fun () -> raise @@ Arg.Bad("User-raised error bis")),
+   "user raised error"]
+, ignore, [ "-error" ]
+
+(* bad keyword in various places*)
+; [ "-rest", Arg.Rest ignore, "help"], ignore, [ "-rest=1" ]
+; [ "-tuple", Arg.Tuple [Arg.Int print_int; Arg.Int print_int ], "help" ]
+  , ignore, [ "-tuple=1" ]
+; [ "-unit", Arg.Unit ignore, "" ], ignore, [ "-unit=1" ]
+]
+
+let () =
+  let n = List.length tests in
+  List.iteri (test n) tests
diff --git a/testsuite/tests/lib-arg/testerror.reference b/testsuite/tests/lib-arg/testerror.reference
new file mode 100644
index 00000000..c061b32f
--- /dev/null
+++ b/testsuite/tests/lib-arg/testerror.reference
@@ -0,0 +1,65 @@
+(1/10) Bad:
+testerror: option '-s' needs an argument.
+Arg module testing
+  -s missing arg
+  -help  Display this list of options
+  --help  Display this list of options
+
+(2/10) Bad:
+testerror: wrong argument 'true'; option '-set=true' expects no argument.
+Arg module testing
+  -set no argument expected
+  -help  Display this list of options
+  --help  Display this list of options
+
+(3/10) Help:
+Arg module testing
+  -help  Display this list of options
+  --help  Display this list of options
+
+(4/10) Bad:
+testerror: wrong argument 'not_an_int'; option '-int' expects an integer.
+Arg module testing
+  -int wrong argument type
+  -help  Display this list of options
+  --help  Display this list of options
+
+(5/10) Bad:
+testerror: unknown option '-an-unknown-option'.
+Arg module testing
+  -help  Display this list of options
+  --help  Display this list of options
+
+(6/10) Bad:
+testerror: User-raised error.
+Arg module testing
+  -help  Display this list of options
+  --help  Display this list of options
+
+(7/10) Bad:
+testerror: User-raised error bis.
+Arg module testing
+  -error user raised error
+  -help  Display this list of options
+  --help  Display this list of options
+
+(8/10) Bad:
+testerror: wrong argument '1'; option '-rest=1' expects no argument.
+Arg module testing
+  -rest help
+  -help  Display this list of options
+  --help  Display this list of options
+
+(9/10) Bad:
+testerror: wrong argument '1'; option '-tuple=1' expects no argument.
+Arg module testing
+  -tuple help
+  -help  Display this list of options
+  --help  Display this list of options
+
+(10/10) Bad:
+testerror: wrong argument '1'; option '-unit=1' expects no argument.
+Arg module testing
+  -help  Display this list of options
+  --help  Display this list of options
+
diff --git a/testsuite/tests/lib-array/test_array.ml b/testsuite/tests/lib-array/test_array.ml
new file mode 100644
index 00000000..5cd9c719
--- /dev/null
+++ b/testsuite/tests/lib-array/test_array.ml
@@ -0,0 +1,57 @@
+(* TEST
+   * expect
+*)
+
+let a = Array.make 8 None;;
+let _ = Array.fill a 2 3 (Some 42);;
+a;;
+[%%expect{|
+val a : '_weak1 option array =
+  [|None; None; None; None; None; None; None; None|]
+- : unit = ()
+- : int option array =
+[|None; None; Some 42; Some 42; Some 42; None; None; None|]
+|}]
+let _ = Array.fill a 3 1 (Some 0);;
+a;;
+[%%expect{|
+- : unit = ()
+- : int option array =
+[|None; None; Some 42; Some 0; Some 42; None; None; None|]
+|}]
+let _ = Array.fill a 3 6 None;;
+a;;
+[%%expect{|
+Exception: Invalid_argument "Array.fill".
+|}]
+let _ = Array.fill a (-1) 2 None;;
+a;;
+[%%expect{|
+Exception: Invalid_argument "Array.fill".
+|}]
+let _ = Gc.compact ();;
+let _ = Array.fill a 5 1 (Some (if Random.int 2 < 0 then 1 else 2));;
+a;;
+[%%expect{|
+- : unit = ()
+- : unit = ()
+- : int option array =
+[|None; None; Some 42; Some 0; Some 42; Some 2; None; None|]
+|}]
+let _ = Array.fill a 5 1 None;;
+a;;
+[%%expect{|
+- : unit = ()
+- : int option array =
+[|None; None; Some 42; Some 0; Some 42; None; None; None|]
+|}]
+
+
+let a = Array.make 8 0.;;
+let _ = Array.fill a 2 3 42.;;
+a;;
+[%%expect{|
+val a : float array = [|0.; 0.; 0.; 0.; 0.; 0.; 0.; 0.|]
+- : unit = ()
+- : float array = [|0.; 0.; 42.; 42.; 42.; 0.; 0.; 0.|]
+|}]
diff --git a/testsuite/tests/lib-bigarray-2/bigarrf.f b/testsuite/tests/lib-bigarray-2/bigarrf.f
new file mode 100644
index 00000000..ff52de1d
--- /dev/null
+++ b/testsuite/tests/lib-bigarray-2/bigarrf.f
@@ -0,0 +1,26 @@
+	subroutine filltab()
+
+	integer dimx, dimy
+	parameter (dimx = 8, dimy = 6)
+	real ftab(dimx, dimy)
+	common /ftab/ ftab
+	integer x, y
+
+	do 100 x = 1, dimx
+	   do 110 y = 1, dimy
+	      ftab(x, y) = x * 100 + y
+ 110	   continue
+ 100	continue
+	end
+
+	subroutine printtab(tab, dimx, dimy)
+
+	integer dimx, dimy
+	real tab(dimx, dimy)
+	integer x, y
+
+	do 200 x = 1, dimx
+	   print 300, x, (tab(x, y), y = 1, dimy)
+ 300	   format(/1X, I3, 2X, 10F6.1/)
+ 200	continue
+	end
diff --git a/testsuite/tests/lib-bigarray-2/bigarrfml.ml b/testsuite/tests/lib-bigarray-2/bigarrfml.ml
new file mode 100644
index 00000000..40020b23
--- /dev/null
+++ b/testsuite/tests/lib-bigarray-2/bigarrfml.ml
@@ -0,0 +1,96 @@
+(* TEST
+
+files = "bigarrf.f bigarrfstub.c"
+last_flags = "-cclib -lgfortran"
+
+* script
+script = "sh ${test_source_directory}/has-gfortran.sh"
+
+** setup-ocamlc.byte-build-env
+*** script
+script = "gfortran -c bigarrf.f"
+**** ocamlc.byte
+all_modules = "bigarrf.o bigarrfstub.c bigarrfml.ml"
+***** run
+output = "${test_build_directory}/program-output"
+stdout = "${output}"
+****** check-program-output
+
+** setup-ocamlopt.byte-build-env
+*** script
+script = "gfortran -c bigarrf.f"
+**** ocamlopt.byte
+all_modules = "bigarrf.o bigarrfstub.c bigarrfml.ml"
+***** run
+output = "${test_build_directory}/program-output"
+stdout = "${output}"
+****** check-program-output
+
+*)
+
+open Bigarray
+open Printf
+
+(* Test harness *)
+
+let error_occurred = ref false
+
+let function_tested = ref ""
+
+let testing_function s =
+    function_tested := s;
+    print_newline();
+    print_string s;
+    print_newline()
+
+let test test_number answer correct_answer =
+ flush stdout;
+ flush stderr;
+ if answer <> correct_answer then begin
+   eprintf "*** Bad result (%s, test %d)\n" !function_tested test_number;
+   flush stderr;
+   error_occurred := true
+ end else begin
+   printf " %d..." test_number
+ end
+
+(* External C and Fortran functions *)
+
+external c_filltab :
+  unit -> (float, float64_elt, c_layout) Array2.t = "c_filltab"
+external c_printtab :
+  (float, float64_elt, c_layout) Array2.t -> unit = "c_printtab"
+external fortran_filltab :
+  unit -> (float, float32_elt, fortran_layout) Array2.t = "fortran_filltab"
+external fortran_printtab :
+  (float, float32_elt, fortran_layout) Array2.t -> unit = "fortran_printtab"
+
+let _ =
+
+  let make_array2 kind layout ind0 dim1 dim2 fromint =
+    let a = Array2.create kind layout dim1 dim2 in
+    for i = ind0 to dim1 - 1 + ind0 do
+      for j = ind0 to dim2 - 1 + ind0 do
+        a.{i,j} <- (fromint (i * 1000 + j))
+      done
+    done;
+    a in
+
+  print_newline();
+  testing_function "------ Foreign function interface --------";
+  testing_function "Passing an array to C";
+  c_printtab (make_array2 float64 c_layout 0 6 8 float);
+  testing_function "Accessing a C array";
+  let a = c_filltab () in
+  test 1 a.{0,0} 0.0;
+  test 2 a.{1,0} 100.0;
+  test 3 a.{0,1} 1.0;
+  test 4 a.{5,4} 504.0;
+  testing_function "Passing an array to Fortran";
+  fortran_printtab (make_array2 float32 fortran_layout 1 5 4 float);
+  testing_function "Accessing a Fortran array";
+  let a = fortran_filltab () in
+  test 1 a.{1,1} 101.0;
+  test 2 a.{2,1} 201.0;
+  test 3 a.{1,2} 102.0;
+  test 4 a.{5,4} 504.0;
diff --git a/testsuite/tests/lib-bigarray-2/bigarrfml.reference b/testsuite/tests/lib-bigarray-2/bigarrfml.reference
new file mode 100644
index 00000000..8368d5ab
--- /dev/null
+++ b/testsuite/tests/lib-bigarray-2/bigarrfml.reference
@@ -0,0 +1,27 @@
+
+
+------ Foreign function interface --------
+
+Passing an array to C
+
+Accessing a C array
+ 1... 2... 3... 4...
+Passing an array to Fortran
+  0     0.0     1.0     2.0     3.0     4.0     5.0     6.0     7.0
+  1  1000.0  1001.0  1002.0  1003.0  1004.0  1005.0  1006.0  1007.0
+  2  2000.0  2001.0  2002.0  2003.0  2004.0  2005.0  2006.0  2007.0
+  3  3000.0  3001.0  3002.0  3003.0  3004.0  3005.0  3006.0  3007.0
+  4  4000.0  4001.0  4002.0  4003.0  4004.0  4005.0  4006.0  4007.0
+  5  5000.0  5001.0  5002.0  5003.0  5004.0  5005.0  5006.0  5007.0
+
+Accessing a Fortran array
+ 1... 2... 3... 4...
+   1  1001.01002.01003.01004.0
+
+   2  2001.02002.02003.02004.0
+
+   3  3001.03002.03003.03004.0
+
+   4  4001.04002.04003.04004.0
+
+   5  5001.05002.05003.05004.0
diff --git a/testsuite/tests/lib-bigarray-2/bigarrfstub.c b/testsuite/tests/lib-bigarray-2/bigarrfstub.c
new file mode 100644
index 00000000..1f9a2dce
--- /dev/null
+++ b/testsuite/tests/lib-bigarray-2/bigarrfstub.c
@@ -0,0 +1,74 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2000 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <stdio.h>
+#include <caml/mlvalues.h>
+#include <caml/bigarray.h>
+
+extern void filltab_(void);
+extern void printtab_(float * data, int * dimx, int * dimy);
+extern float ftab_[];
+
+#define DIMX 6
+#define DIMY 8
+
+double ctab[DIMX][DIMY];
+
+void filltab(void)
+{
+  int x, y;
+  for (x = 0; x < DIMX; x++)
+    for (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++) {
+    printf("%3d", x);
+    for (y = 0; y < DIMY; y++)
+      printf("  %6.1f", tab[x][y]);
+    printf("\n");
+  }
+}
+
+value c_filltab(value unit)
+{
+  filltab();
+  return alloc_bigarray_dims(BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT,
+                             2, ctab, DIMX, DIMY);
+}
+
+value c_printtab(value ba)
+{
+  printtab(Data_bigarray_val(ba));
+  return Val_unit;
+}
+
+value fortran_filltab(value unit)
+{
+  filltab_();
+  return alloc_bigarray_dims(BIGARRAY_FLOAT32 | BIGARRAY_FORTRAN_LAYOUT,
+                             2, ftab_, 8, 6);
+}
+
+value fortran_printtab(value ba)
+{
+  int dimx = Bigarray_val(ba)->dim[0];
+  int dimy = Bigarray_val(ba)->dim[1];
+  printtab_(Data_bigarray_val(ba), &dimx, &dimy);
+  return Val_unit;
+}
diff --git a/testsuite/tests/lib-bigarray-2/has-gfortran.sh b/testsuite/tests/lib-bigarray-2/has-gfortran.sh
new file mode 100644
index 00000000..82f7ae8a
--- /dev/null
+++ b/testsuite/tests/lib-bigarray-2/has-gfortran.sh
@@ -0,0 +1,12 @@
+#!/bin/sh
+if ! which gfortran > /dev/null 2>&1; then
+  echo "gfortran not available" > ${ocamltest_response}
+  test_result=${TEST_SKIP}
+elif ! grep -q '^CC=gcc' ${ocamlsrcdir}/Makefile.config; then
+  echo "OCaml was not compiled with gcc" > ${ocamltest_response}
+  test_result=${TEST_SKIP}
+else
+  test_result=${TEST_PASS}
+fi
+
+exit ${test_result}
diff --git a/testsuite/tests/lib-bigarray-file/mapfile.ml b/testsuite/tests/lib-bigarray-file/mapfile.ml
new file mode 100644
index 00000000..a359cd1b
--- /dev/null
+++ b/testsuite/tests/lib-bigarray-file/mapfile.ml
@@ -0,0 +1,139 @@
+(* TEST
+   * hasunix
+   include unix
+   ** native
+*)
+
+open Bigarray
+
+(* Test harness *)
+
+let error_occurred = ref false
+
+let function_tested = ref ""
+
+let testing_function s =
+    function_tested := s;
+    print_newline();
+    print_string s;
+    print_newline()
+
+let test test_number answer correct_answer =
+ flush stdout;
+ flush stderr;
+ if answer <> correct_answer then begin
+   Printf.eprintf "*** Bad result (%s, test %d)\n" !function_tested test_number;
+   flush stderr;
+   error_occurred := true
+ end else begin
+   Printf.printf " %d..." test_number
+ end
+
+(* Tests *)
+
+let tests () =
+  let mapped_file = Filename.temp_file "bigarray" ".data" in
+  begin
+    testing_function "map_file";
+    let fd =
+     Unix.openfile mapped_file
+                   [Unix.O_RDWR; Unix.O_TRUNC; Unix.O_CREAT] 0o666 in
+    let a =
+      array1_of_genarray (Unix.map_file fd float64 c_layout true [|10000|])
+    in
+    Unix.close fd;
+    for i = 0 to 9999 do a.{i} <- float i done;
+    let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
+    let b =
+      array2_of_genarray
+        (Unix.map_file fd float64 fortran_layout false [|100; -1|])
+    in
+    Unix.close fd;
+    let ok = ref true in
+    for i = 0 to 99 do
+      for j = 0 to 99 do
+        if b.{j+1,i+1} <> float (100 * i + j) then ok := false
+      done
+    done;
+    test 1 !ok true;
+    b.{50,50} <- (-1.0);
+    let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
+    let c =
+      array2_of_genarray (Unix.map_file fd float64 c_layout false [|-1; 100|])
+    in
+    Unix.close fd;
+    let ok = ref true in
+    for i = 0 to 99 do
+      for j = 0 to 99 do
+        if c.{i,j} <> float (100 * i + j) then ok := false
+      done
+    done;
+    test 2 !ok true;
+    let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
+    let c =
+      array2_of_genarray
+        (Unix.map_file fd ~pos:800L float64 c_layout false [|-1; 100|])
+    in
+    Unix.close fd;
+    let ok = ref true in
+    for i = 1 to 99 do
+      for j = 0 to 99 do
+        if c.{i-1,j} <> float (100 * i + j) then ok := false
+      done
+    done;
+    test 3 !ok true;
+    let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
+    let c =
+      array2_of_genarray
+        (Unix.map_file fd ~pos:79200L float64 c_layout false [|-1; 100|])
+    in
+    Unix.close fd;
+    let ok = ref true in
+    for j = 0 to 99 do
+      if c.{0,j} <> float (100 * 99 + j) then ok := false
+    done;
+    test 4 !ok true;
+
+    testing_function "map_file errors";
+    (* Insufficient permissions *)
+    let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
+    test 1 true
+      begin try
+        ignore (Unix.map_file fd float64 c_layout true [|-1; 100|]); false
+      with
+      | Unix.Unix_error((Unix.EACCES | Unix.EPERM), _, _) -> true
+      | Unix.Unix_error(err, _, _) ->
+          Printf.eprintf "Unexpected error %s\n%!" (Unix.error_message err);
+          false
+      end;
+    Unix.close fd;
+    (* Invalid handle *)
+    test 2 true
+      begin try
+        ignore (Unix.map_file fd float64 c_layout true [|-1; 100|]); false
+      with
+      | Unix.Unix_error((Unix.EBADF|Unix.EINVAL), _, _) -> true
+      | Unix.Unix_error(err, _, _) ->
+          Printf.eprintf "Unexpected error %s\n%!" (Unix.error_message err);
+          false
+      end
+
+  end;
+  (* Force garbage collection of the mapped bigarrays above, otherwise
+     Win32 doesn't let us erase the file.  Notice the begin...end above
+     so that the VM doesn't keep stack references to the mapped bigarrays. *)
+  Gc.full_major();
+  Sys.remove mapped_file;
+
+  ()
+  [@@inline never]
+
+(********* End of test *********)
+
+let _ =
+  tests ();
+  print_newline();
+  if !error_occurred then begin
+    prerr_endline "************* TEST FAILED ****************"; exit 2
+  end else
+    exit 0
diff --git a/testsuite/tests/lib-bigarray-file/mapfile.reference b/testsuite/tests/lib-bigarray-file/mapfile.reference
new file mode 100644
index 00000000..1f9cef4b
--- /dev/null
+++ b/testsuite/tests/lib-bigarray-file/mapfile.reference
@@ -0,0 +1,5 @@
+
+map_file
+ 1... 2... 3... 4...
+map_file errors
+ 1... 2...
diff --git a/testsuite/tests/lib-bigarray/bigarrays.ml b/testsuite/tests/lib-bigarray/bigarrays.ml
new file mode 100644
index 00000000..57536d67
--- /dev/null
+++ b/testsuite/tests/lib-bigarray/bigarrays.ml
@@ -0,0 +1,993 @@
+(* TEST
+*)
+
+open Bigarray
+open Printf
+open Complex
+
+(* Test harness *)
+
+let error_occurred = ref false
+
+let function_tested = ref ""
+
+let testing_function s =
+    function_tested := s;
+    print_newline();
+    print_string s;
+    print_newline()
+
+let test test_number answer correct_answer =
+ flush stdout;
+ flush stderr;
+ if answer <> correct_answer then begin
+   eprintf "*** Bad result (%s, test %d)\n" !function_tested test_number;
+   flush stderr;
+   error_occurred := true
+ end else begin
+   printf " %d..." test_number
+ end
+
+(* One-dimensional arrays *)
+
+(* flambda can cause some of these values not to be reclaimed by the Gc, which
+ * can undermine the use of Gc.full_major for the Windows ports. All the tests
+ * are wrapped in a non-inlineable function to prevent this behaviour.
+ *)
+let tests () =
+  testing_function "------ Array1 --------";
+  testing_function "create/set/get";
+  let test_setget kind vals =
+    let rec set a i = function
+        [] -> ()
+      | (v1, v2) :: tl -> a.{i} <- v1; set a (i+1) tl in
+    let rec test a i = function
+        [] -> true
+      | (v1, v2) :: tl -> a.{i} = v2 && test a (i+1) tl in
+    let ca = Array1.create kind c_layout (List.length vals) in
+    let fa = Array1.create kind fortran_layout (List.length vals) in
+    set ca 0 vals;
+    set fa 1 vals;
+    test ca 0 vals && test fa 1 vals in
+  test 1 true
+    (test_setget int8_signed
+                 [0, 0;
+                  123, 123;
+                  -123, -123;
+                  456, -56;
+                  0x101, 1]);
+  test 2 true
+    (test_setget int8_unsigned
+                 [0, 0;
+                  123, 123;
+                  -123, 133;
+                  456, 0xc8;
+                  0x101, 1]);
+  test 3 true
+    (test_setget int16_signed
+                 [0, 0;
+                  123, 123;
+                  -123, -123;
+                  31456, 31456;
+                  -31456, -31456;
+                  65432, -104;
+                  0x10001, 1]);
+  test 4 true
+    (test_setget int16_unsigned
+                 [0, 0;
+                  123, 123;
+                  -123, 65413;
+                  31456, 31456;
+                  -31456, 34080;
+                  65432, 65432;
+                  0x10001, 1]);
+  test 5 true
+    (test_setget int
+                 [0, 0;
+                  123, 123;
+                  -456, -456;
+                  max_int, max_int;
+                  min_int, min_int;
+                  0x12345678, 0x12345678;
+                  -0x12345678, -0x12345678]);
+  test 6 true
+    (test_setget int32
+                 [Int32.zero, Int32.zero;
+                  Int32.of_int 123, Int32.of_int 123;
+                  Int32.of_int (-456), Int32.of_int (-456);
+                  Int32.max_int, Int32.max_int;
+                  Int32.min_int, Int32.min_int;
+                  Int32.of_string "0x12345678", Int32.of_string "0x12345678"]);
+  test 7 true
+    (test_setget int64
+                 [Int64.zero, Int64.zero;
+                  Int64.of_int 123, Int64.of_int 123;
+                  Int64.of_int (-456), Int64.of_int (-456);
+                  Int64.max_int, Int64.max_int;
+                  Int64.min_int, Int64.min_int;
+                  Int64.of_string "0x123456789ABCDEF0",
+                     Int64.of_string "0x123456789ABCDEF0"]);
+  test 8 true
+    (test_setget nativeint
+                 [Nativeint.zero, Nativeint.zero;
+                  Nativeint.of_int 123, Nativeint.of_int 123;
+                  Nativeint.of_int (-456), Nativeint.of_int (-456);
+                  Nativeint.max_int, Nativeint.max_int;
+                  Nativeint.min_int, Nativeint.min_int;
+                  Nativeint.of_string "0x12345678",
+                    Nativeint.of_string "0x12345678"]);
+  test 9 true
+    (test_setget float32
+                 [0.0, 0.0;
+                  4.0, 4.0;
+                  -0.5, -0.5;
+                  655360.0, 655360.0]);
+  test 10 true
+    (test_setget float64
+                 [0.0, 0.0;
+                  4.0, 4.0;
+                  -0.5, -0.5;
+                  1.2345678, 1.2345678;
+                  3.1415e10, 3.1415e10]);
+  test 11 true
+    (test_setget complex32
+                 [Complex.zero, Complex.zero;
+                  Complex.one, Complex.one;
+                  Complex.i, Complex.i;
+                  {im = 0.5; re = -2.0}, {im = 0.5; re = -2.0}]);
+  test 12 true
+    (test_setget complex64
+                 [Complex.zero, Complex.zero;
+                  Complex.one, Complex.one;
+                  Complex.i, Complex.i;
+                  {im=0.5;re= -2.0}, {im=0.5;re= -2.0};
+                  {im=3.1415;re=1.2345678}, {im=3.1415;re=1.2345678}]);
+
+  let from_list kind vals =
+    let a = Array1.create kind c_layout (List.length vals) in
+    let rec set i = function
+        [] -> ()
+      | hd :: tl -> a.{i} <- hd; set (i+1) tl in
+    set 0 vals;
+    a in
+  let from_list_fortran kind vals =
+    let a = Array1.create kind fortran_layout (List.length vals) in
+    let rec set i = function
+        [] -> ()
+      | hd :: tl -> a.{i} <- hd; set (i+1) tl in
+    set 1 vals;
+    a in
+
+  (* Test indexing arrays.  This test has to be copy-pasted, otherwise
+     indexing may not use the optimizations in
+     Cmmgen.bigarray_indexing. *)
+  begin
+    let v = 123 in
+    let cb = Array1.create int8_signed c_layout 1000 in
+    let fb = Array1.create int8_signed fortran_layout 1000 in
+    Array1.fill cb v;
+    Array1.fill fb v;
+    let return = ref true in
+    for i = 1 to 99 do
+      let i = i * 10 in
+      return := !return
+        && Array1.unsafe_get cb (i - 10) = v
+        && Array1.unsafe_get cb (i     ) = v
+        && Array1.unsafe_get cb (i +  9) = v
+        && Array1.unsafe_get fb (i -  9) = v
+        && Array1.unsafe_get fb (i     ) = v
+        && Array1.unsafe_get fb (i + 10) = v
+    done;
+    test 13 true !return
+  end;
+  begin
+    let v = 123 in
+    let cb = Array1.create int16_unsigned c_layout 1000 in
+    let fb = Array1.create int16_unsigned fortran_layout 1000 in
+    Array1.fill cb v;
+    Array1.fill fb v;
+    let return = ref true in
+    for i = 1 to 99 do
+      let i = i * 10 in
+      return := !return
+        && Array1.unsafe_get cb (i - 10) = v
+        && Array1.unsafe_get cb (i     ) = v
+        && Array1.unsafe_get cb (i +  9) = v
+        && Array1.unsafe_get fb (i -  9) = v
+        && Array1.unsafe_get fb (i     ) = v
+        && Array1.unsafe_get fb (i + 10) = v
+    done;
+    test 14 true !return
+  end;
+  begin
+    let v = 123. in
+    let cb = Array1.create float32 c_layout 1000 in
+    let fb = Array1.create float32 fortran_layout 1000 in
+    Array1.fill cb v;
+    Array1.fill fb v;
+    let return = ref true in
+    for i = 1 to 99 do
+      let i = i * 10 in
+      return := !return
+        && Array1.unsafe_get cb (i - 10) = v
+        && Array1.unsafe_get cb (i     ) = v
+        && Array1.unsafe_get cb (i +  9) = v
+        && Array1.unsafe_get fb (i -  9) = v
+        && Array1.unsafe_get fb (i     ) = v
+        && Array1.unsafe_get fb (i + 10) = v
+    done;
+    test 15 true !return
+  end;
+
+  begin
+    let v = 123. in
+    let cb = Array1.create float64 c_layout 1000 in
+    let fb = Array1.create float64 fortran_layout 1000 in
+    Array1.fill cb v;
+    Array1.fill fb v;
+    let return = ref true in
+    for i = 1 to 99 do
+      let i = i * 10 in
+      return := !return
+        && Array1.unsafe_get cb (i - 10) = v
+        && Array1.unsafe_get cb (i     ) = v
+        && Array1.unsafe_get cb (i +  9) = v
+        && Array1.unsafe_get fb (i -  9) = v
+        && Array1.unsafe_get fb (i     ) = v
+        && Array1.unsafe_get fb (i + 10) = v
+    done;
+    test 16 true !return
+  end;
+
+  testing_function "set/get (specialized)";
+  let a = Array1.create int c_layout 3 in
+  for i = 0 to 2 do a.{i} <- i done;
+  for i = 0 to 2 do test (i+1) a.{i} i done;
+  test 4 true (try ignore a.{3}; false with Invalid_argument _ -> true);
+  test 5 true (try ignore a.{-1}; false with Invalid_argument _ -> true);
+
+  let b = Array1.create float64 fortran_layout 3 in
+  for i = 1 to 3 do b.{i} <- float i done;
+  for i = 1 to 3 do test (5 + i) b.{i} (float i) done;
+  test 8 true (try ignore b.{4}; false with Invalid_argument _ -> true);
+  test 9 true (try ignore b.{0}; false with Invalid_argument _ -> true);
+
+  let c = Array1.create complex64 c_layout 3 in
+  for i = 0 to 2 do c.{i} <- {re=float i; im=0.0} done;
+  for i = 0 to 2 do test (10 + i) c.{i} {re=float i; im=0.0} done;
+  test 13 true (try ignore c.{3}; false with Invalid_argument _ -> true);
+  test 14 true (try ignore c.{-1}; false with Invalid_argument _ -> true);
+
+  let d = Array1.create complex32 fortran_layout 3 in
+  for i = 1 to 3 do d.{i} <- {re=float i; im=0.0} done;
+  for i = 1 to 3 do test (14 + i) d.{i} {re=float i; im=0.0} done;
+  test 18 true (try ignore d.{4}; false with Invalid_argument _ -> true);
+  test 19 true (try ignore d.{0}; false with Invalid_argument _ -> true);
+
+  testing_function "set/get (unsafe, specialized)";
+  let a = Array1.create int c_layout 3 in
+  for i = 0 to 2 do Array1.unsafe_set a i i done;
+  for i = 0 to 2 do test (i+1) (Array1.unsafe_get a i) i done;
+
+  let b = Array1.create float64 fortran_layout 3 in
+  for i = 1 to 3 do Array1.unsafe_set b i (float i) done;
+  for i = 1 to 3 do test (5 + i) (Array1.unsafe_get b i) (float i) done;
+
+  testing_function "comparisons";
+  let normalize_comparison n =
+    if n = 0 then 0 else if n < 0 then -1 else 1 in
+  test 1 0 (normalize_comparison (compare
+     (from_list int8_signed [1;2;3;-4;127;-128])
+     (from_list int8_signed [1;2;3;-4;127;-128])));
+  test 2 (-1) (normalize_comparison (compare
+     (from_list int8_signed [1;2;3;-4;127;-128])
+     (from_list int8_signed [1;2;3;4;127;-128])));
+  test 3 1 (normalize_comparison (compare
+     (from_list int8_signed [1;2;3;-4;127;-128])
+     (from_list int8_signed [1;2;3;-4;42;-128])));
+  test 4 (-1) (normalize_comparison (compare
+     (from_list int8_signed [1;2;3;-4])
+     (from_list int8_signed [1;2;3;4;127;-128])));
+  test 5 1 (normalize_comparison (compare
+     (from_list int8_signed [1;2;3;4;127;-128])
+     (from_list int8_signed [1;2;3;-4])));
+
+  test 6 0 (normalize_comparison (compare
+     (from_list int8_unsigned [1;2;3;-4;127;-128])
+     (from_list int8_unsigned [1;2;3;-4;127;-128])));
+  test 7 1 (normalize_comparison (compare
+     (from_list int8_unsigned [1;2;3;-4;127;-128])
+     (from_list int8_unsigned [1;2;3;4;127;-128])));
+  test 8 1 (normalize_comparison (compare
+     (from_list int8_unsigned [1;2;3;-4;127;-128])
+     (from_list int8_unsigned [1;2;3;-4;42;-128])));
+
+  test 9 0 (normalize_comparison (compare
+     (from_list int16_signed [1;2;3;-4;127;-128])
+     (from_list int16_signed [1;2;3;-4;127;-128])));
+  test 10 (-1) (normalize_comparison (compare
+     (from_list int16_signed [1;2;3;-4;127;-128])
+     (from_list int16_signed [1;2;3;4;127;-128])));
+  test 11 1 (normalize_comparison (compare
+     (from_list int16_signed [1;2;3;-4;127;-128])
+     (from_list int16_signed [1;2;3;-4;42;-128])));
+
+  test 12 0 (normalize_comparison (compare
+     (from_list int16_unsigned [1;2;3;-4;127;-128])
+     (from_list int16_unsigned [1;2;3;-4;127;-128])));
+  test 13 (-1) (normalize_comparison (compare
+     (from_list int16_unsigned [1;2;3;4;127;-128])
+     (from_list int16_unsigned [1;2;3;0xFFFF;127;-128])));
+  test 14 1 (normalize_comparison (compare
+     (from_list int16_unsigned [1;2;3;-4;127;-128])
+     (from_list int16_unsigned [1;2;3;-4;42;-128])));
+
+  test 15 0 (normalize_comparison (compare
+     (from_list int [1;2;3;-4;127;-128])
+     (from_list int [1;2;3;-4;127;-128])));
+  test 16 (-1) (normalize_comparison (compare
+     (from_list int [1;2;3;-4;127;-128])
+     (from_list int [1;2;3;4;127;-128])));
+  test 17 1 (normalize_comparison (compare
+     (from_list int [1;2;3;-4;127;-128])
+     (from_list int [1;2;3;-4;42;-128])));
+
+  test 18 0 (normalize_comparison (compare
+     (from_list int32 (List.map Int32.of_int [1;2;3;-4;127;-128]))
+     (from_list int32 (List.map Int32.of_int [1;2;3;-4;127;-128]))));
+  test 19 (-1) (normalize_comparison (compare
+     (from_list int32 (List.map Int32.of_int [1;2;3;-4;127;-128]))
+     (from_list int32 (List.map Int32.of_int [1;2;3;4;127;-128]))));
+  test 20 1 (normalize_comparison (compare
+     (from_list int32 (List.map Int32.of_int [1;2;3;-4;127;-128]))
+     (from_list int32 (List.map Int32.of_int [1;2;3;-4;42;-128]))));
+
+  test 21 0 (normalize_comparison (compare
+     (from_list int64 (List.map Int64.of_int [1;2;3;-4;127;-128]))
+     (from_list int64 (List.map Int64.of_int [1;2;3;-4;127;-128]))));
+  test 22 (-1) (normalize_comparison (compare
+     (from_list int64 (List.map Int64.of_int [1;2;3;-4;127;-128]))
+     (from_list int64 (List.map Int64.of_int [1;2;3;4;127;-128]))));
+  test 23 1 (normalize_comparison (compare
+     (from_list int64 (List.map Int64.of_int [1;2;3;-4;127;-128]))
+     (from_list int64 (List.map Int64.of_int [1;2;3;-4;42;-128]))));
+
+  test 24 0 (normalize_comparison (compare
+     (from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;127;-128]))
+     (from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;127;-128]))));
+  test 25 (-1) (normalize_comparison (compare
+     (from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;127;-128]))
+     (from_list nativeint (List.map Nativeint.of_int [1;2;3;4;127;-128]))));
+  test 26 1 (normalize_comparison (compare
+     (from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;127;-128]))
+     (from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;42;-128]))));
+
+  test 27 0 (normalize_comparison (compare
+     (from_list float32 [0.0; 0.25; -4.0; 3.141592654])
+     (from_list float32 [0.0; 0.25; -4.0; 3.141592654])));
+  test 28 (-1) (normalize_comparison (compare
+     (from_list float32 [0.0; 0.25; -4.0])
+     (from_list float32 [0.0; 0.25; 3.14159])));
+  test 29 1 (normalize_comparison (compare
+     (from_list float32 [0.0; 2.718; -4.0])
+     (from_list float32 [0.0; 0.25; 3.14159])));
+
+  test 30 0 (normalize_comparison (compare
+     (from_list float64 [0.0; 0.25; -4.0; 3.141592654])
+     (from_list float64 [0.0; 0.25; -4.0; 3.141592654])));
+  test 31 (-1) (normalize_comparison (compare
+     (from_list float64 [0.0; 0.25; -4.0])
+     (from_list float64 [0.0; 0.25; 3.14159])));
+  test 32 1 (normalize_comparison (compare
+     (from_list float64 [0.0; 2.718; -4.0])
+     (from_list float64 [0.0; 0.25; 3.14159])));
+
+  test 44 0 (normalize_comparison (compare
+     (from_list complex32 [Complex.zero; Complex.one; Complex.i])
+     (from_list complex32 [Complex.zero; Complex.one; Complex.i])));
+  test 45 (-1) (normalize_comparison (compare
+     (from_list complex32 [Complex.zero; Complex.one; Complex.i])
+     (from_list complex32 [Complex.zero; Complex.one; Complex.one])));
+  test 46 1 (normalize_comparison (compare
+     (from_list complex32 [Complex.zero; Complex.one; Complex.one])
+     (from_list complex32 [Complex.zero; Complex.one; Complex.i])));
+
+  test 47 0 (normalize_comparison (compare
+     (from_list complex64 [Complex.zero; Complex.one; Complex.i])
+     (from_list complex64 [Complex.zero; Complex.one; Complex.i])));
+  test 48 (-1) (normalize_comparison (compare
+     (from_list complex64 [Complex.zero; Complex.one; Complex.i])
+     (from_list complex64 [Complex.zero; Complex.one; Complex.one])));
+  test 49 1 (normalize_comparison (compare
+     (from_list complex64 [Complex.zero; Complex.one; Complex.one])
+     (from_list complex64 [Complex.zero; Complex.one; Complex.i])));
+
+  testing_function "dim";
+  test 1 (Array1.dim (from_list int [1;2;3;4;5])) 5;
+  test 2 (Array1.dim (from_list_fortran int [1;2;3])) 3;
+
+  testing_function "size_in_bytes_one";
+  test 1 (Array1.size_in_bytes (from_list int [1;2;3;4;5]))
+    (5 * (kind_size_in_bytes int));
+  test 2 (Array1.size_in_bytes (from_list int [])) 0;
+  let int64list = (from_list int64 (List.map Int64.of_int [1;2;3;4;5])) in
+  test 3 (Array1.size_in_bytes int64list) (5 * (kind_size_in_bytes int64));
+  test 4 (Array1.size_in_bytes (from_list int64 (List.map Int64.of_int []))) 0;
+
+  testing_function "kind & layout";
+  let a = from_list int [1;2;3] in
+  test 1 (Array1.kind a) int;
+  test 2 (Array1.layout a) c_layout;
+  let a = from_list_fortran float32 [1.0;2.0;3.0] in
+  test 1 (Array1.kind a) float32;
+  test 2 (Array1.layout a) fortran_layout;
+
+  testing_function "sub";
+  let a = from_list int [1;2;3;4;5;6;7;8] in
+  test 1 (Array1.sub a 2 5)
+         (from_list int [3;4;5;6;7]);
+  test 2 (Array1.sub a 0 2)
+         (from_list int [1;2]);
+  test 3 (Array1.sub a 0 8)
+         (from_list int [1;2;3;4;5;6;7;8]);
+  let a = from_list float64 [1.0;2.0;3.0;4.0;5.0;6.0;7.0;8.0] in
+  test 4 (Array1.sub a 2 5)
+         (from_list float64 [3.0;4.0;5.0;6.0;7.0]);
+  test 5 (Array1.sub a 0 2)
+         (from_list float64 [1.0;2.0]);
+  test 6 (Array1.sub a 0 8)
+         (from_list float64 [1.0;2.0;3.0;4.0;5.0;6.0;7.0;8.0]);
+  let a = from_list_fortran float64 [1.0;2.0;3.0;4.0;5.0;6.0;7.0;8.0] in
+  test 7 (Array1.sub a 2 5)
+         (from_list_fortran float64 [2.0;3.0;4.0;5.0;6.0]);
+  test 8 (Array1.sub a 1 2)
+         (from_list_fortran float64 [1.0;2.0]);
+  test 9 (Array1.sub a 1 8)
+         (from_list_fortran float64 [1.0;2.0;3.0;4.0;5.0;6.0;7.0;8.0]);
+  Gc.full_major();  (* test GC of proxies *)
+
+  testing_function "blit, fill";
+  let test_blit_fill kind data initval ofs len =
+    let a = from_list kind data in
+    let b = Array1.create kind c_layout (List.length data) in
+    Array1.blit a b;
+    (a = b) &&
+    (Array1.fill (Array1.sub b ofs len) initval;
+     let rec check i = function
+         [] -> true
+       | hd :: tl -> b.{i} = (if i >= ofs && i < ofs + len
+                                       then initval else hd)
+                     && check (i+1) tl
+     in check 0 data) in
+  test 1 true (test_blit_fill int8_signed [1;2;5;8;-100;127] 7 3 2);
+  test 2 true (test_blit_fill int8_unsigned [1;2;5;8;-100;212] 7 3 2);
+  test 3 true (test_blit_fill int16_signed [1;2;5;8;-100;212] 7 3 2);
+  test 4 true (test_blit_fill int16_unsigned [1;2;5;8;-100;212] 7 3 2);
+  test 5 true (test_blit_fill int [1;2;5;8;-100;212] 7 3 2);
+  test 6 true (test_blit_fill int32 (List.map Int32.of_int [1;2;5;8;-100;212])
+                                    (Int32.of_int 7) 3 2);
+  test 7 true (test_blit_fill int64 (List.map Int64.of_int [1;2;5;8;-100;212])
+                                    (Int64.of_int 7) 3 2);
+  test 8 true (test_blit_fill nativeint
+                             (List.map Nativeint.of_int [1;2;5;8;-100;212])
+                             (Nativeint.of_int 7) 3 2);
+  test 9 true (test_blit_fill float32 [1.0;2.0;0.5;0.125;256.0;512.0]
+                             0.25 3 2);
+  test 10 true (test_blit_fill float64 [1.0;2.0;5.0;8.123;-100.456;212e19]
+                             3.1415 3 2);
+  test 11 true (test_blit_fill complex32 [Complex.zero; Complex.one; Complex.i]
+                             Complex.i 1 1);
+  test 12 true (test_blit_fill complex64 [Complex.zero; Complex.one; Complex.i]
+                             Complex.i 1 1);
+  testing_function "slice";
+  let a = Array1.of_array int c_layout [| 5; 4; 3 |] in
+  test 1 (Array1.slice a 0) (Array0.of_value int c_layout 5);
+  test 2 (Array1.slice a 1) (Array0.of_value int c_layout 4);
+  test 3 (Array1.slice a 2) (Array0.of_value int c_layout 3);
+  let a = Array1.of_array int fortran_layout [| 5; 4; 3 |] in
+  test 6 (Array1.slice a 1) (Array0.of_value int fortran_layout 5);
+  test 7 (Array1.slice a 2) (Array0.of_value int fortran_layout 4);
+  test 8 (Array1.slice a 3) (Array0.of_value int fortran_layout 3);
+
+
+(* Bi-dimensional arrays *)
+
+  print_newline();
+  testing_function "------ Array2 --------";
+  testing_function "create/set/get";
+  let make_array2 kind layout ind0 dim1 dim2 fromint =
+    let a = Array2.create kind layout dim1 dim2 in
+    for i = ind0 to dim1 - 1 + ind0 do
+      for j = ind0 to dim2 - 1 + ind0 do
+        a.{i,j} <- (fromint (i * 1000 + j))
+      done
+    done;
+    a in
+  let check_array2 a ind0 dim1 dim2 fromint =
+    try
+      for i = ind0 to dim1 - 1 + ind0 do
+        for j = ind0 to dim2 - 1 + ind0 do
+          if a.{i,j} <> (fromint (i * 1000 + j)) then raise Exit
+        done
+      done;
+      true
+    with Exit -> false in
+  let id x = x in
+  test 1 true
+    (check_array2 (make_array2 int16_signed c_layout 0 10 20 id) 0 10 20 id);
+  test 2 true
+    (check_array2 (make_array2 int c_layout 0 10 20 id) 0 10 20 id);
+  test 3 true
+    (check_array2 (make_array2 int32 c_layout 0 10 20 Int32.of_int)
+                  0 10 20 Int32.of_int);
+  test 4 true
+    (check_array2 (make_array2 float32 c_layout 0 10 20 float)
+                  0 10 20 float);
+  test 5 true
+    (check_array2 (make_array2 float64 c_layout 0 10 20 float)
+                  0 10 20 float);
+  test 6 true
+    (check_array2 (make_array2 int16_signed fortran_layout 1 10 20 id)
+                  1 10 20 id);
+  test 7 true
+    (check_array2 (make_array2 int fortran_layout 1 10 20 id) 1 10 20 id);
+  test 8 true
+    (check_array2 (make_array2 int32 fortran_layout 1 10 20 Int32.of_int)
+                  1 10 20 Int32.of_int);
+  test 9 true
+    (check_array2 (make_array2 float32 fortran_layout 1 10 20 float)
+                  1 10 20 float);
+  test 10 true
+    (check_array2 (make_array2 float64 fortran_layout 1 10 20 float)
+                  1 10 20 float);
+  let makecomplex i = {re = float i; im = float (-i)} in
+  test 11 true
+    (check_array2 (make_array2 complex32 c_layout 0 10 20 makecomplex)
+                  0 10 20 makecomplex);
+  test 12 true
+    (check_array2 (make_array2 complex64 c_layout 0 10 20 makecomplex)
+                  0 10 20 makecomplex);
+  test 13 true
+    (check_array2 (make_array2 complex32 fortran_layout 1 10 20 makecomplex)
+                  1 10 20 makecomplex);
+  test 14 true
+    (check_array2 (make_array2 complex64 fortran_layout 1 10 20 makecomplex)
+                  1 10 20 makecomplex);
+
+  testing_function "set/get (specialized)";
+  let a = Array2.create int16_signed c_layout 3 3 in
+  for i = 0 to 2 do for j = 0 to 2 do a.{i,j} <- i-j done done;
+  let ok = ref true in
+  for i = 0 to 2 do
+    for j = 0 to 2 do if a.{i,j} <> i-j then ok := false done
+  done;
+  test 1 true !ok;
+  test 2 true (try ignore a.{3,0}; false with Invalid_argument _ -> true);
+  test 3 true (try ignore a.{-1,0}; false with Invalid_argument _ -> true);
+  test 4 true (try ignore a.{0,3}; false with Invalid_argument _ -> true);
+  test 5 true (try ignore a.{0,-1}; false with Invalid_argument _ -> true);
+
+  let b = Array2.create float32 fortran_layout 3 3 in
+  for i = 1 to 3 do for j = 1 to 3 do b.{i,j} <- float(i-j) done done;
+  let ok = ref true in
+  for i = 1 to 3 do
+    for j = 1 to 3 do if b.{i,j} <> float(i-j) then ok := false done
+  done;
+  test 6 true !ok;
+  test 7 true (try ignore b.{4,1}; false with Invalid_argument _ -> true);
+  test 8 true (try ignore b.{0,1}; false with Invalid_argument _ -> true);
+  test 9 true (try ignore b.{1,4}; false with Invalid_argument _ -> true);
+  test 10 true (try ignore b.{1,0}; false with Invalid_argument _ -> true);
+
+  testing_function "set/get (unsafe, specialized)";
+  let a = Array2.create int16_signed c_layout 3 3 in
+  for i = 0 to 2 do for j = 0 to 2 do Array2.unsafe_set a i j (i-j) done done;
+  let ok = ref true in
+  for i = 0 to 2 do
+    for j = 0 to 2 do if Array2.unsafe_get a i j <> i-j then ok := false done
+  done;
+  test 1 true !ok;
+
+  let b = Array2.create float32 fortran_layout 3 3 in
+  for i = 1 to 3 do
+    for j = 1 to 3 do Array2.unsafe_set b i j (float(i-j)) done
+  done;
+  let ok = ref true in
+  for i = 1 to 3 do
+    for j = 1 to 3 do
+      if Array2.unsafe_get b i j <> float(i-j) then ok := false
+    done
+  done;
+  test 2 true !ok;
+
+  testing_function "dim";
+  let a = (make_array2 int c_layout 0 4 6 id) in
+  test 1 (Array2.dim1 a) 4;
+  test 2 (Array2.dim2 a) 6;
+  let b =  (make_array2 int fortran_layout 1 4 6 id) in
+  test 3 (Array2.dim1 b) 4;
+  test 4 (Array2.dim2 b) 6;
+
+  testing_function "size_in_bytes_two";
+  let a = Array2.create int c_layout 4 6 in
+  test 1 (Array2.size_in_bytes a) (24 * (kind_size_in_bytes int));
+
+  testing_function "sub";
+  let a = make_array2 int c_layout 0 5 3 id in
+  let b = Array2.sub_left a 2 2 in
+  test 1 true
+         (b.{0,0} = 2000 &&
+          b.{0,1} = 2001 &&
+          b.{0,2} = 2002 &&
+          b.{1,0} = 3000 &&
+          b.{1,1} = 3001 &&
+          b.{1,2} = 3002);
+  let a = make_array2 int fortran_layout 1 5 3 id in
+  let b = Array2.sub_right a 2 2 in
+  test 2 true
+         (b.{1,1} = 1002 &&
+          b.{1,2} = 1003 &&
+          b.{2,1} = 2002 &&
+          b.{2,2} = 2003 &&
+          b.{3,1} = 3002 &&
+          b.{3,2} = 3003 &&
+          b.{4,1} = 4002 &&
+          b.{4,2} = 4003 &&
+          b.{5,1} = 5002 &&
+          b.{5,2} = 5003);
+
+  testing_function "slice";
+  let a = make_array2 int c_layout 0 5 3 id in
+  test 1 (Array2.slice_left a 0) (from_list int [0;1;2]);
+  test 2 (Array2.slice_left a 1) (from_list int [1000;1001;1002]);
+  test 3 (Array2.slice_left a 2) (from_list int [2000;2001;2002]);
+  test 4 (Array2.slice_left a 3) (from_list int [3000;3001;3002]);
+  test 5 (Array2.slice_left a 4) (from_list int [4000;4001;4002]);
+  let a = make_array2 int fortran_layout 1 5 3 id in
+  test 6 (Array2.slice_right a 1)
+       (from_list_fortran int [1001;2001;3001;4001;5001]);
+  test 7 (Array2.slice_right a 2)
+       (from_list_fortran int [1002;2002;3002;4002;5002]);
+  test 8 (Array2.slice_right a 3)
+       (from_list_fortran int [1003;2003;3003;4003;5003]);
+
+(* Tri-dimensional arrays *)
+
+  print_newline();
+  testing_function "------ Array3 --------";
+  testing_function "create/set/get";
+  let make_array3 kind layout ind0 dim1 dim2 dim3 fromint =
+    let a = Array3.create kind layout dim1 dim2 dim3 in
+    for i = ind0 to dim1 - 1 + ind0 do
+      for j = ind0 to dim2 - 1 + ind0 do
+        for k = ind0 to dim3 - 1 + ind0 do
+          a.{i, j, k} <- (fromint (i * 100 + j * 10 + k))
+        done
+      done
+    done;
+    a in
+  let check_array3 a ind0 dim1 dim2 dim3 fromint =
+    try
+      for i = ind0 to dim1 - 1 + ind0 do
+        for j = ind0 to dim2 - 1 + ind0 do
+          for k = ind0 to dim3 - 1 + ind0 do
+            if a.{i, j, k} <> (fromint (i * 100 + j * 10 + k))
+            then raise Exit
+          done
+        done
+      done;
+      true
+    with Exit -> false in
+  let id x = x in
+  test 1 true
+    (check_array3 (make_array3 int16_signed c_layout 0 4 5 6 id) 0 4 5 6 id);
+  test 2 true
+    (check_array3 (make_array3 int c_layout 0 4 5 6 id) 0 4 5 6 id);
+  test 3 true
+    (check_array3 (make_array3 int32 c_layout 0 4 5 6 Int32.of_int)
+                  0 4 5 6 Int32.of_int);
+  test 4 true
+    (check_array3 (make_array3 float32 c_layout 0 4 5 6 float)
+                  0 4 5 6 float);
+  test 5 true
+    (check_array3 (make_array3 float64 c_layout 0 4 5 6 float)
+                  0 4 5 6 float);
+  test 6 true
+    (check_array3 (make_array3 int16_signed fortran_layout 1 4 5 6 id)
+                  1 4 5 6 id);
+  test 7 true
+    (check_array3 (make_array3 int fortran_layout 1 4 5 6 id) 1 4 5 6 id);
+  test 8 true
+    (check_array3 (make_array3 int32 fortran_layout 1 4 5 6 Int32.of_int)
+                  1 4 5 6 Int32.of_int);
+  test 9 true
+    (check_array3 (make_array3 float32 fortran_layout 1 4 5 6 float)
+                  1 4 5 6 float);
+  test 10 true
+    (check_array3 (make_array3 float64 fortran_layout 1 4 5 6 float)
+                  1 4 5 6 float);
+  test 11 true
+    (check_array3 (make_array3 complex32 c_layout 0 4 5 6 makecomplex)
+                  0 4 5 6 makecomplex);
+  test 12 true
+    (check_array3 (make_array3 complex64 c_layout 0 4 5 6 makecomplex)
+                  0 4 5 6 makecomplex);
+  test 13 true
+    (check_array3 (make_array3 complex32 fortran_layout 1 4 5 6 makecomplex)
+                  1 4 5 6 makecomplex);
+  test 14 true
+    (check_array3 (make_array3 complex64 fortran_layout 1 4 5 6 makecomplex)
+                  1 4 5 6 makecomplex);
+
+
+  testing_function "set/get (specialized)";
+  let a = Array3.create int32 c_layout 2 3 4 in
+  for i = 0 to 1 do for j = 0 to 2 do for k = 0 to 3 do
+     a.{i,j,k} <- Int32.of_int((i lsl 4) + (j lsl 2) + k)
+  done done done;
+  let ok = ref true in
+  for i = 0 to 1 do for j = 0 to 2 do for k = 0 to 3 do
+     if Int32.to_int a.{i,j,k} <> (i lsl 4) + (j lsl 2) + k then ok := false
+  done done done;
+  test 1 true !ok;
+
+  let b = Array3.create int64 fortran_layout 2 3 4 in
+  for i = 1 to 2 do for j = 1 to 3 do for k = 1 to 4 do
+     b.{i,j,k} <- Int64.of_int((i lsl 4) + (j lsl 2) + k)
+  done done done;
+  let ok = ref true in
+  for i = 1 to 2 do for j = 1 to 3 do for k = 1 to 4 do
+     if Int64.to_int b.{i,j,k} <> (i lsl 4) + (j lsl 2) + k then ok := false
+  done done done;
+  test 2 true !ok;
+
+  testing_function "set/get (unsafe, specialized)";
+  let a = Array3.create int32 c_layout 2 3 4 in
+  for i = 0 to 1 do for j = 0 to 2 do for k = 0 to 3 do
+     Array3.unsafe_set a i j k (Int32.of_int((i lsl 4) + (j lsl 2) + k))
+  done done done;
+  let ok = ref true in
+  for i = 0 to 1 do for j = 0 to 2 do for k = 0 to 3 do
+     if Int32.to_int (Array3.unsafe_get a i j k) <> (i lsl 4) + (j lsl 2) + k
+     then ok := false
+  done done done;
+  test 1 true !ok;
+
+  testing_function "dim";
+  let a = (make_array3 int c_layout 0 4 5 6 id) in
+  test 1 (Array3.dim1 a) 4;
+  test 2 (Array3.dim2 a) 5;
+  test 3 (Array3.dim3 a) 6;
+  let b =  (make_array3 int fortran_layout 1 4 5 6 id) in
+  test 4 (Array3.dim1 b) 4;
+  test 5 (Array3.dim2 b) 5;
+  test 6 (Array3.dim3 b) 6;
+
+  testing_function "size_in_bytes_three";
+  let a = Array3.create int c_layout 4 5 6 in
+  test 1 (Array3.size_in_bytes a) (120 * (kind_size_in_bytes int));
+
+  testing_function "slice1";
+  let a = make_array3 int c_layout 0 3 3 3 id in
+  test 1 (Array3.slice_left_1 a 0 0) (from_list int [0;1;2]);
+  test 2 (Array3.slice_left_1 a 0 1) (from_list int [10;11;12]);
+  test 3 (Array3.slice_left_1 a 0 2) (from_list int [20;21;22]);
+  test 4 (Array3.slice_left_1 a 1 1) (from_list int [110;111;112]);
+  test 5 (Array3.slice_left_1 a 2 1) (from_list int [210;211;212]);
+  let a = make_array3 int fortran_layout 1 3 3 3 id in
+  test 6 (Array3.slice_right_1 a 1 2) (from_list_fortran int [112;212;312]);
+  test 7 (Array3.slice_right_1 a 3 1) (from_list_fortran int [131;231;331]);
+
+  testing_function "size_in_bytes_general";
+  let a = Genarray.create int c_layout [|2;2;2;2;2|] in
+  test 1 (Genarray.size_in_bytes a) (32 * (kind_size_in_bytes int));
+
+(* Zero-dimensional arrays *)
+  testing_function "------ Array0 --------";
+  testing_function "create/set/get";
+  let test_setget kind vals =
+    List.for_all (fun (v1, v2) ->
+      let ca = Array0.create kind c_layout in
+      let fa = Array0.create kind fortran_layout in
+      Array0.set ca v1;
+      Array0.set fa v1;
+      Array0.get ca = v2 && Array0.get fa = v2) vals in
+  test 1 true
+    (test_setget int8_signed
+                 [0, 0;
+                  123, 123;
+                  -123, -123;
+                  456, -56;
+                  0x101, 1]);
+  test 2 true
+    (test_setget int8_unsigned
+                 [0, 0;
+                  123, 123;
+                  -123, 133;
+                  456, 0xc8;
+                  0x101, 1]);
+  test 3 true
+    (test_setget int16_signed
+                 [0, 0;
+                  123, 123;
+                  -123, -123;
+                  31456, 31456;
+                  -31456, -31456;
+                  65432, -104;
+                  0x10001, 1]);
+  test 4 true
+    (test_setget int16_unsigned
+                 [0, 0;
+                  123, 123;
+                  -123, 65413;
+                  31456, 31456;
+                  -31456, 34080;
+                  65432, 65432;
+                  0x10001, 1]);
+  test 5 true
+    (test_setget int
+                 [0, 0;
+                  123, 123;
+                  -456, -456;
+                  max_int, max_int;
+                  min_int, min_int;
+                  0x12345678, 0x12345678;
+                  -0x12345678, -0x12345678]);
+  test 6 true
+    (test_setget int32
+                 [Int32.zero, Int32.zero;
+                  Int32.of_int 123, Int32.of_int 123;
+                  Int32.of_int (-456), Int32.of_int (-456);
+                  Int32.max_int, Int32.max_int;
+                  Int32.min_int, Int32.min_int;
+                  Int32.of_string "0x12345678", Int32.of_string "0x12345678"]);
+  test 7 true
+    (test_setget int64
+                 [Int64.zero, Int64.zero;
+                  Int64.of_int 123, Int64.of_int 123;
+                  Int64.of_int (-456), Int64.of_int (-456);
+                  Int64.max_int, Int64.max_int;
+                  Int64.min_int, Int64.min_int;
+                  Int64.of_string "0x123456789ABCDEF0",
+                     Int64.of_string "0x123456789ABCDEF0"]);
+  test 8 true
+    (test_setget nativeint
+                 [Nativeint.zero, Nativeint.zero;
+                  Nativeint.of_int 123, Nativeint.of_int 123;
+                  Nativeint.of_int (-456), Nativeint.of_int (-456);
+                  Nativeint.max_int, Nativeint.max_int;
+                  Nativeint.min_int, Nativeint.min_int;
+                  Nativeint.of_string "0x12345678",
+                    Nativeint.of_string "0x12345678"]);
+  test 9 true
+    (test_setget float32
+                 [0.0, 0.0;
+                  4.0, 4.0;
+                  -0.5, -0.5;
+                  655360.0, 655360.0]);
+  test 10 true
+    (test_setget float64
+                 [0.0, 0.0;
+                  4.0, 4.0;
+                  -0.5, -0.5;
+                  1.2345678, 1.2345678;
+                  3.1415e10, 3.1415e10]);
+  test 11 true
+    (test_setget complex32
+                 [Complex.zero, Complex.zero;
+                  Complex.one, Complex.one;
+                  Complex.i, Complex.i;
+                  {im = 0.5; re = -2.0}, {im = 0.5; re = -2.0}]);
+  test 12 true
+    (test_setget complex64
+                 [Complex.zero, Complex.zero;
+                  Complex.one, Complex.one;
+                  Complex.i, Complex.i;
+                  {im=0.5;re= -2.0}, {im=0.5;re= -2.0};
+                  {im=3.1415;re=1.2345678}, {im=3.1415;re=1.2345678}]);
+
+
+(* Kind size *)
+  testing_function "kind_size_in_bytes";
+  let arr1 = Array1.create Float32 c_layout 1 in
+  test 1 (kind_size_in_bytes Float32) (Array1.size_in_bytes arr1);
+  let arr1 = Array1.create Float64 c_layout 1 in
+  test 2 (kind_size_in_bytes Float64) (Array1.size_in_bytes arr1);
+  let arr1 = Array1.create Int8_signed c_layout 1 in
+  test 3 (kind_size_in_bytes Int8_signed) (Array1.size_in_bytes arr1);
+  let arr1 = Array1.create Int8_unsigned c_layout 1 in
+  test 4 (kind_size_in_bytes Int8_unsigned) (Array1.size_in_bytes arr1);
+  let arr1 = Array1.create Int16_signed c_layout 1 in
+  test 5 (kind_size_in_bytes Int16_signed) (Array1.size_in_bytes arr1);
+  let arr1 = Array1.create Int16_unsigned c_layout 1 in
+  test 6 (kind_size_in_bytes Int16_unsigned) (Array1.size_in_bytes arr1);
+  let arr1 = Array1.create Int32 c_layout 1 in
+  test 7 (kind_size_in_bytes Int32) (Array1.size_in_bytes arr1);
+  let arr1 = Array1.create Int64 c_layout 1 in
+  test 8 (kind_size_in_bytes Int64) (Array1.size_in_bytes arr1);
+  let arr1 = Array1.create Int c_layout 1 in
+  test 9 (kind_size_in_bytes Int) (Array1.size_in_bytes arr1);
+  let arr1 = Array1.create Nativeint c_layout 1 in
+  test 10 (kind_size_in_bytes Nativeint) (Array1.size_in_bytes arr1);
+  let arr1 = Array1.create Complex32 c_layout 1 in
+  test 11 (kind_size_in_bytes Complex32) (Array1.size_in_bytes arr1);
+  let arr1 = Array1.create Complex64 c_layout 1 in
+  test 12 (kind_size_in_bytes Complex64) (Array1.size_in_bytes arr1);
+  let arr1 = Array1.create Char c_layout 1 in
+  test 13 (kind_size_in_bytes Char) (Array1.size_in_bytes arr1);
+
+(* Reshaping *)
+  print_newline();
+  testing_function "------ Reshaping --------";
+  testing_function "reshape_1";
+  let a = make_array2 int c_layout 0 3 4 id in
+  let b = make_array2 int fortran_layout 1 3 4 id in
+  let c = reshape_1 (genarray_of_array2 a) 12 in
+  test 1 c (from_list int [0;1;2;3;1000;1001;1002;1003;2000;2001;2002;2003]);
+  let d = reshape_1 (genarray_of_array2 b) 12 in
+  test 2 d (from_list_fortran int
+              [1001;2001;3001;1002;2002;3002;1003;2003;3003;1004;2004;3004]);
+  testing_function "reshape_2";
+  let c = reshape_2 (genarray_of_array2 a) 4 3 in
+  test 1 (Array2.slice_left c 0) (from_list int [0;1;2]);
+  test 2 (Array2.slice_left c 1) (from_list int [3;1000;1001]);
+  test 3 (Array2.slice_left c 2) (from_list int [1002;1003;2000]);
+  test 4 (Array2.slice_left c 3) (from_list int [2001;2002;2003]);
+  let d = reshape_2 (genarray_of_array2 b) 4 3 in
+  test 5 (Array2.slice_right d 1) (from_list_fortran int [1001;2001;3001;1002]);
+  test 6 (Array2.slice_right d 2) (from_list_fortran int [2002;3002;1003;2003]);
+  test 7 (Array2.slice_right d 3) (from_list_fortran int [3003;1004;2004;3004]);
+  testing_function "reshape";
+  let a = make_array2 int c_layout 0 1 1 (fun i -> i + 3) in
+  let b = reshape_0 (genarray_of_array2 a) in
+  let c = reshape (genarray_of_array0 b) [|1|] in
+  test 8 (Array0.get b) 3;
+  test 9 (Genarray.get c [|0|]) 3;
+  test 10 (Genarray.get (Genarray.slice_left c [|0|]) [||]) 3;
+
+(* I/O *)
+
+  print_newline();
+  testing_function "------ I/O --------";
+  testing_function "output_value/input_value";
+  let test_structured_io testno value =
+    let tmp = Filename.temp_file "bigarray" ".data" in
+    let oc = open_out_bin tmp in
+    output_value oc value;
+    close_out oc;
+    let ic = open_in_bin tmp in
+    let value' = input_value ic in
+    close_in ic;
+    Sys.remove tmp;
+    test testno value value' in
+  test_structured_io 1 (from_list int8_signed [1;2;3;-4;127;-128]);
+  test_structured_io 2 (from_list int16_signed [1;2;3;-4;127;-128]);
+  test_structured_io 3 (from_list int [1;2;3;-4;127;-128]);
+  test_structured_io 4
+    (from_list int32 (List.map Int32.of_int [1;2;3;-4;127;-128]));
+  test_structured_io 5
+    (from_list int64 (List.map Int64.of_int [1;2;3;-4;127;-128]));
+  test_structured_io 6
+    (from_list nativeint (List.map Nativeint.of_int [1;2;3;-4;127;-128]));
+  test_structured_io 7 (from_list float32 [0.0; 0.25; -4.0; 3.141592654]);
+  test_structured_io 8 (from_list float64 [0.0; 0.25; -4.0; 3.141592654]);
+  test_structured_io 9 (make_array2 int c_layout 0 100 100 id);
+  test_structured_io 10 (make_array2 float64 fortran_layout 1 200 200 float);
+  test_structured_io 11 (make_array3 int32 c_layout 0 20 30 40 Int32.of_int);
+  test_structured_io 12 (make_array3 float32 fortran_layout 1 10 50 100 float);
+  test_structured_io 13 (make_array2 complex32 c_layout 0 100 100 makecomplex);
+  test_structured_io 14 (make_array3 complex64 fortran_layout 1 10 20 30
+                                     makecomplex);
+
+  ()
+  [@@inline never]
+
+(********* End of test *********)
+
+let _ =
+  tests ();
+  print_newline();
+  if !error_occurred then begin
+    prerr_endline "************* TEST FAILED ****************"; exit 2
+  end else
+    exit 0
diff --git a/testsuite/tests/lib-bigarray/bigarrays.reference b/testsuite/tests/lib-bigarray/bigarrays.reference
new file mode 100644
index 00000000..1c80e50e
--- /dev/null
+++ b/testsuite/tests/lib-bigarray/bigarrays.reference
@@ -0,0 +1,77 @@
+
+------ Array1 --------
+
+create/set/get
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... 14... 15... 16...
+set/get (specialized)
+ 1... 2... 3... 4... 5... 6... 7... 8... 8... 9... 10... 11... 12... 13... 14... 15... 16... 17... 18... 19...
+set/get (unsafe, specialized)
+ 1... 2... 3... 6... 7... 8...
+comparisons
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... 14... 15... 16... 17... 18... 19... 20... 21... 22... 23... 24... 25... 26... 27... 28... 29... 30... 31... 32... 44... 45... 46... 47... 48... 49...
+dim
+ 1... 2...
+size_in_bytes_one
+ 1... 2... 3... 4...
+kind & layout
+ 1... 2... 1... 2...
+sub
+ 1... 2... 3... 4... 5... 6... 7... 8... 9...
+blit, fill
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+slice
+ 1... 2... 3... 6... 7... 8...
+
+------ Array2 --------
+
+create/set/get
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... 14...
+set/get (specialized)
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10...
+set/get (unsafe, specialized)
+ 1... 2...
+dim
+ 1... 2... 3... 4...
+size_in_bytes_two
+ 1...
+sub
+ 1... 2...
+slice
+ 1... 2... 3... 4... 5... 6... 7... 8...
+
+------ Array3 --------
+
+create/set/get
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... 14...
+set/get (specialized)
+ 1... 2...
+set/get (unsafe, specialized)
+ 1...
+dim
+ 1... 2... 3... 4... 5... 6...
+size_in_bytes_three
+ 1...
+slice1
+ 1... 2... 3... 4... 5... 6... 7...
+size_in_bytes_general
+ 1...
+------ Array0 --------
+
+create/set/get
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+kind_size_in_bytes
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13...
+
+------ Reshaping --------
+
+reshape_1
+ 1... 2...
+reshape_2
+ 1... 2... 3... 4... 5... 6... 7...
+reshape
+ 8... 9... 10...
+
+------ I/O --------
+
+output_value/input_value
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... 14...
diff --git a/testsuite/tests/lib-bigarray/change_layout.ml b/testsuite/tests/lib-bigarray/change_layout.ml
new file mode 100644
index 00000000..2456cdc5
--- /dev/null
+++ b/testsuite/tests/lib-bigarray/change_layout.ml
@@ -0,0 +1,147 @@
+(* TEST
+   compare_programs = "false" (* See https://github.com/ocaml/ocaml/pull/8853 *)
+*)
+
+(** Test the various change_layout for Genarray and the various Array[n] *)
+
+open Bigarray
+
+let pp_sep ppf () = Format.fprintf ppf ";@ "
+ let print_array pp ppf a =
+ Format.fprintf ppf "@[<hov>[|%a|]@]"
+    Format.(pp_print_list ~pp_sep pp) (Array.to_list a)
+
+let print_index = print_array Format.pp_print_int
+
+let do_test n test =
+  let rec aux l n =
+    if n = 0 then l
+    else
+      aux
+        begin match test (n-1) with
+        | Some error -> error :: l
+        | None -> l
+        end
+        (n-1) in
+  aux [] n
+
+let kind = float64
+
+let c = c_layout
+let fortran = fortran_layout
+
+let rank = 5
+let dims = Array.init rank (fun n -> n+2)
+let size = Array.fold_left ( * ) 1 dims
+
+let report s test =
+  let errors = do_test size test in
+  if errors = [] then
+    Format.printf"@[%s: Ok@]@." s
+  else
+    Format.printf "@[%s:@;Failed at indices @[<hov>%a@]@]@." s
+      (Format.pp_print_list ~pp_sep print_index)
+      errors
+
+let array =
+  let a = Array1.create kind c size in
+  for i = 0 to size - 1 do a.{i} <- float i done;
+  a
+
+(** Test for generic biggarray *)
+let gen = reshape (genarray_of_array1 array) dims
+
+let sizes =
+  let a = Array.make rank 1 in
+  let _ = Array.fold_left (fun (i,s) x -> a.(i)<- s; (i+1, s * x)) (0,1) dims in
+  a
+
+let multi_index n =
+  Array.init rank ( fun i ->  (n / sizes.(i)) mod dims.(i)  )
+
+let testG n =
+  let pos = multi_index n in
+  let initial = Genarray.get gen pos in
+  Genarray.set gen pos (-1.);
+  let different = Genarray.get gen pos <> initial in
+  let gen' = Genarray.change_layout gen fortran in
+  Genarray.set gen' ( Array.init rank @@ fun n -> 1 + pos.( rank - 1 - n ) )
+    initial;
+  if not (different && initial = Genarray.get gen pos) then Some pos
+  else None
+
+;;
+report "Generic rank test" testG
+;;
+
+(* Scalar *)
+let scalar =
+  let a = Array0.create kind c in
+  Array0.set a 0.; a
+;;
+let test  =
+  let a' = Array0.change_layout scalar fortran in
+  Array0.set a' 1.;
+  Array0.get scalar = 1.
+
+;;
+Format.printf "Scalar test: %s@." (if test then "Ok" else "Failed")
+;;
+
+(* Vector *)
+let vec = array1_of_genarray @@ reshape gen [|size|]
+let test1 i =
+  let initial = vec.{i}  in
+  vec.{i} <- -1.;
+  let different = vec.{i} <> initial in
+  let vec' = Array1.change_layout vec fortran in
+  vec'.{ i + 1 } <- initial;
+  if different && initial = vec.{i} then None
+    else Some [|i|]
+
+;;
+report "Rank-1 array test" test1
+;;
+
+(* Matrix *)
+let mat = array2_of_genarray @@ reshape gen [|dims.(0); size / dims.(0) |]
+let bi_index n = n mod dims.(0), n / dims.(0)
+
+let test2 n =
+  let i, j = bi_index n in
+  let initial = mat.{i,j}  in
+  mat.{i,j} <- -1.;
+  let different = mat.{i,j} <> initial in
+  let mat' = Array2.change_layout mat fortran in
+  mat'.{ j + 1, i + 1 } <- initial;
+  if different && initial = mat.{i, j} then None
+    else Some [|i; j|]
+
+
+;;
+report "Rank-2 array test" test2
+;;
+
+(* Rank 3 *)
+let t3 = array3_of_genarray @@
+  reshape gen [|dims.(0); dims.(1); size / (dims.(0) * dims.(1)) |]
+
+let tri_index n =
+  n mod dims.(0),
+  (n/ dims.(0)) mod  dims.(1),
+  n / (dims.(0) * dims.(1))
+
+let test3 n =
+  let i, j, k = tri_index n in
+  let initial = t3.{i,j,k}  in
+  t3.{i,j,k} <- -1.;
+  let different = t3.{i,j,k} <> initial in
+  let t3' = Array3.change_layout t3 fortran in
+  t3'.{ k + 1, j + 1, i + 1 } <- initial;
+  if different && initial = t3.{i, j, k} then None
+    else Some [|i;j;k|]
+
+
+;;
+report "Rank-3 array test" test3
+;;
diff --git a/testsuite/tests/lib-bigarray/change_layout.reference b/testsuite/tests/lib-bigarray/change_layout.reference
new file mode 100644
index 00000000..bab576ec
--- /dev/null
+++ b/testsuite/tests/lib-bigarray/change_layout.reference
@@ -0,0 +1,5 @@
+Generic rank test: Ok
+Scalar test: Ok
+Rank-1 array test: Ok
+Rank-2 array test: Ok
+Rank-3 array test: Ok
diff --git a/testsuite/tests/lib-bigarray/fftba.ml b/testsuite/tests/lib-bigarray/fftba.ml
new file mode 100644
index 00000000..a06ad1bc
--- /dev/null
+++ b/testsuite/tests/lib-bigarray/fftba.ml
@@ -0,0 +1,185 @@
+(* TEST
+*)
+
+open Bigarray
+
+let pi = 3.14159265358979323846
+
+let tpi = 2.0 *. pi
+
+let fft (px : (float, float64_elt, c_layout) Array1.t)
+        (py : (float, float64_elt, c_layout) Array1.t) np =
+  let i = ref 2 in
+  let m = ref 1 in
+
+  while (!i < np) do
+    i := !i + !i;
+    m := !m + 1
+  done;
+
+  let n = !i in
+
+  if n <> np then begin
+    for i = np+1 to n do
+      px.{i} <- 0.0;
+      py.{i} <- 0.0
+    done;
+    print_string "Use "; print_int n;
+    print_string " point fft"; print_newline()
+  end;
+
+  let n2 = ref(n+n) in
+  for k = 1 to !m-1 do
+    n2 := !n2 / 2;
+    let n4 = !n2 / 4 in
+    let e  = tpi /. float !n2 in
+
+    for j = 1 to n4 do
+      let a = e *. float(j - 1) in
+      let a3 = 3.0 *. a in
+      let cc1 = cos(a) in
+      let ss1 = sin(a) in
+      let cc3 = cos(a3) in
+      let ss3 = sin(a3) in
+      let is = ref j in
+      let id = ref(2 * !n2) in
+
+        while !is < n do
+          let i0r = ref !is in
+          while !i0r < n do
+             let i0 = !i0r in
+             let i1 = i0 + n4 in
+             let i2 = i1 + n4 in
+             let i3 = i2 + n4 in
+             let r1 = px.{i0} -. px.{i2} in
+             px.{i0} <- px.{i0} +. px.{i2};
+             let r2 = px.{i1} -. px.{i3} in
+             px.{i1} <- px.{i1} +. px.{i3};
+             let s1 = py.{i0} -. py.{i2} in
+             py.{i0} <- py.{i0} +. py.{i2};
+             let s2 = py.{i1} -. py.{i3} in
+             py.{i1} <- py.{i1} +. py.{i3};
+             let s3 = r1 -. s2 in
+             let r1 = r1 +. s2 in
+             let s2 = r2 -. s1 in
+             let r2 = r2 +. s1 in
+             px.{i2} <- r1*.cc1 -. s2*.ss1;
+             py.{i2} <- -.s2*.cc1 -. r1*.ss1;
+             px.{i3} <- s3*.cc3 +. r2*.ss3;
+             py.{i3} <- r2*.cc3 -. s3*.ss3;
+             i0r := i0 + !id
+          done;
+          is := 2 * !id - !n2 + j;
+          id := 4 * !id
+        done
+    done
+  done;
+
+(************************************)
+(*  Last stage, length=2 butterfly  *)
+(************************************)
+
+  let is = ref 1 in
+  let id = ref 4 in
+
+  while !is < n do
+    let i0r = ref !is in
+    while !i0r <= n do
+      let i0 = !i0r in
+      let i1 = i0 + 1 in
+      let r1 = px.{i0} in
+      px.{i0} <- r1 +. px.{i1};
+      px.{i1} <- r1 -. px.{i1};
+      let r1 = py.{i0} in
+      py.{i0} <- r1 +. py.{i1};
+      py.{i1} <- r1 -. py.{i1};
+      i0r := i0 + !id
+    done;
+    is := 2 * !id - 1;
+    id := 4 * !id
+  done;
+
+(*************************)
+(*  Bit reverse counter  *)
+(*************************)
+
+  let j = ref 1 in
+
+  for i = 1 to n - 1 do
+    if i < !j then begin
+      let xt = px.{!j} in
+      px.{!j} <- px.{i};
+      px.{i} <- xt;
+      let xt = py.{!j} in
+      py.{!j} <- py.{i};
+      py.{i} <- xt
+    end;
+    let k = ref(n / 2) in
+    while !k < !j do
+      j := !j - !k;
+      k := !k / 2
+    done;
+    j := !j + !k
+  done;
+
+  n
+
+
+let test np =
+  print_int np; print_string "... "; flush stdout;
+  let enp = float np in
+  let npm = np / 2 - 1 in
+  let pxr = Array1.create float64 c_layout (np+2)
+  and pxi = Array1.create float64 c_layout (np+2) in
+  let t = pi /. enp in
+  pxr.{1} <- (enp -. 1.0) *. 0.5;
+  pxi.{1} <- 0.0;
+  let n2 = np / 2 in
+  pxr.{n2+1} <- -0.5;
+  pxi.{n2+1} <-  0.0;
+
+  for i = 1 to npm do
+      let j = np - i in
+      pxr.{i+1} <- -0.5;
+      pxr.{j+1} <- -0.5;
+      let z = t *. float i in
+      let y = -0.5 *. (cos(z)/.sin(z)) in
+      pxi.{i+1} <- y;
+      pxi.{j+1} <- -.y
+  done;
+(**
+  print_newline();
+  for i=0 to 15 do Printf.printf "%d  %f  %f\n" i pxr.{i+1} pxi.{i+1} done;
+**)
+  let _ = fft pxr pxi np in
+(**
+  for i=0 to 15 do Printf.printf "%d  %f  %f\n" i pxr.{i+1} pxi.{i+1} done;
+**)
+  let zr = ref 0.0 in
+  let zi = ref 0.0 in
+  let kr = ref 0 in
+  let ki = ref 0 in
+  for i = 0 to np-1 do
+      let a = abs_float(pxr.{i+1} -. float i) in
+      if !zr < a then begin
+         zr := a;
+         kr := i
+      end;
+      let a = abs_float(pxi.{i+1}) in
+      if !zi < a then begin
+         zi := a;
+         ki := i
+      end
+  done;
+(*
+  let zm = if abs_float !zr < abs_float !zi then !zi else !zr in
+  print_float zm; print_newline()
+*)
+  if abs_float !zr <= 1e-9 && abs_float !zi <= 1e-9
+  then print_string "ok"
+  else print_string "ERROR";
+  print_newline()
+
+
+let _ =
+  let np = ref 16 in for i = 1 to 13 do test !np; np := !np*2 done
diff --git a/testsuite/tests/lib-bigarray/fftba.reference b/testsuite/tests/lib-bigarray/fftba.reference
new file mode 100644
index 00000000..71017f70
--- /dev/null
+++ b/testsuite/tests/lib-bigarray/fftba.reference
@@ -0,0 +1,13 @@
+16... ok
+32... ok
+64... ok
+128... ok
+256... ok
+512... ok
+1024... ok
+2048... ok
+4096... ok
+8192... ok
+16384... ok
+32768... ok
+65536... ok
diff --git a/testsuite/tests/lib-bigarray/pr5115.ml b/testsuite/tests/lib-bigarray/pr5115.ml
new file mode 100644
index 00000000..74cbe514
--- /dev/null
+++ b/testsuite/tests/lib-bigarray/pr5115.ml
@@ -0,0 +1,15 @@
+(* TEST
+*)
+
+(* PR#5115 - multiple evaluation of bigarray expr *)
+
+open Bigarray
+
+let f y0 =
+  Printf.printf "***EXEC***\n%!";
+  y0
+
+let _ =
+  let y = Array1.of_array float64 fortran_layout [| 1. |] in
+  ignore ((f y).{1});
+  (f y).{1} <- 3.14
diff --git a/testsuite/tests/lib-bigarray/pr5115.reference b/testsuite/tests/lib-bigarray/pr5115.reference
new file mode 100644
index 00000000..63f719ac
--- /dev/null
+++ b/testsuite/tests/lib-bigarray/pr5115.reference
@@ -0,0 +1,2 @@
+***EXEC***
+***EXEC***
diff --git a/testsuite/tests/lib-bigarray/weak_bigarray.ml b/testsuite/tests/lib-bigarray/weak_bigarray.ml
new file mode 100644
index 00000000..a0758120
--- /dev/null
+++ b/testsuite/tests/lib-bigarray/weak_bigarray.ml
@@ -0,0 +1,29 @@
+(* TEST
+*)
+
+(** check that custom block are not copied by Weak.get_copy *)
+
+open Bigarray
+open Bigarray.Array1
+
+let () =
+  let a = ref (create float64 c_layout 10) in
+  Gc.compact ();
+  set !a 0 42.;
+
+  let w = Weak.create 1 in
+  Weak.set w 0 (Some !a);
+
+  let b =
+    match Weak.get_copy w 0 with
+    | None -> assert false
+    | Some b -> b
+  in
+  Printf.printf "a.(0) = %f\n" (get !a 0);
+  Printf.printf "b.(0) = %f\n" (get b 0);
+  a := create float64 c_layout 10;
+  Gc.compact ();
+
+  let c = create float64 c_layout 10 in
+  set c 0 33.;
+  Printf.printf "b.(0) = %f\n" (get b 0);
diff --git a/testsuite/tests/lib-bigarray/weak_bigarray.reference b/testsuite/tests/lib-bigarray/weak_bigarray.reference
new file mode 100644
index 00000000..38901efc
--- /dev/null
+++ b/testsuite/tests/lib-bigarray/weak_bigarray.reference
@@ -0,0 +1,3 @@
+a.(0) = 42.000000
+b.(0) = 42.000000
+b.(0) = 42.000000
diff --git a/testsuite/tests/lib-bool/test.ml b/testsuite/tests/lib-bool/test.ml
new file mode 100644
index 00000000..a59fd7c5
--- /dev/null
+++ b/testsuite/tests/lib-bool/test.ml
@@ -0,0 +1,86 @@
+(* TEST
+*)
+
+let test_not () =
+  assert (Bool.not false = true);
+  assert (Bool.not true = false);
+  ()
+
+let test_and () =
+  let wit = ref 0 in
+  assert (Bool.( && ) (incr wit; false) (incr wit; false) = false);
+  assert (!wit = 1); wit := 0;
+  assert (Bool.( && ) (incr wit; false) (incr wit; true) = false);
+  assert (!wit = 1); wit := 0;
+  assert (Bool.( && ) (incr wit; true) (incr wit; false) = false);
+  assert (!wit = 2); wit := 0;
+  assert (Bool.( && ) (incr wit; true) (incr wit; true) = true);
+  assert (!wit = 2); wit := 0;
+  ()
+
+let test_or () =
+  let wit = ref 0 in
+  assert (Bool.( || ) (incr wit; false) (incr wit; false) = false);
+  assert (!wit = 2); wit := 0;
+  assert (Bool.( || ) (incr wit; false) (incr wit; true) = true);
+  assert (!wit = 2); wit := 0;
+  assert (Bool.( || ) (incr wit; true) (incr wit; false) = true);
+  assert (!wit = 1); wit := 0;
+  assert (Bool.( || ) (incr wit; true) (incr wit; true) = true);
+  assert (!wit = 1); wit := 0;
+  ()
+
+let test_equal () =
+  assert (Bool.equal false false = true);
+  assert (Bool.equal false true = false);
+  assert (Bool.equal true false = false);
+  assert (Bool.equal true true = true);
+  ()
+
+let test_compare () =
+  assert (Bool.compare false false = 0);
+  assert (Bool.compare false true = -1);
+  assert (Bool.compare true false = 1);
+  assert (Bool.compare true true = 0);
+  ()
+
+let test_to_int () =
+  assert (Bool.to_int false = 0);
+  assert (Bool.to_int true = 1);
+  ()
+
+let test_to_float () =
+  assert (Bool.to_float false = 0.);
+  assert (Bool.to_float true = 1.);
+  ()
+
+let test_of_string () =
+  (*
+  assert (Bool.of_string "false" = Some false);
+  assert (Bool.of_string "true" = Some true);
+  assert (Bool.of_string "heyho" = None);
+  assert (Bool.of_string "1" = None);
+  assert (Bool.of_string "0" = None);
+*)
+  ()
+
+let test_to_string () =
+  assert (Bool.to_string false = "false");
+  assert (Bool.to_string true = "true");
+  ()
+
+let tests () =
+  test_not ();
+  test_and ();
+  test_or ();
+  test_equal ();
+  test_compare ();
+  test_to_int ();
+  test_to_float ();
+  test_of_string ();
+  test_to_string ();
+  ()
+
+let () =
+  tests ();
+  print_endline "OK"
diff --git a/testsuite/tests/lib-bool/test.reference b/testsuite/tests/lib-bool/test.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-bool/test.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-buffer/test.ml b/testsuite/tests/lib-buffer/test.ml
new file mode 100644
index 00000000..7b1ab9a4
--- /dev/null
+++ b/testsuite/tests/lib-buffer/test.ml
@@ -0,0 +1,258 @@
+(* TEST
+*)
+
+open Printf
+;;
+
+(* Set up*)
+let n = 10
+;;
+
+let buf = Buffer.create n
+;;
+
+let () =
+  for i = 1 to 10 do
+    Buffer.add_char buf 'a'
+  done
+;;
+
+assert (Buffer.length buf = n)
+;;
+
+(* Helpers *)
+
+let output result str =
+  print_string ("Buffer " ^ str ^ " " ^ result ^ "\n")
+;;
+
+let passed = output "passed"
+;;
+
+let failed = output "failed"
+;;
+
+let buffer_truncate = "Buffer.truncate"
+
+let unexpected str =
+  Printf.sprintf "The Invalid_argument exception has been raised with an \
+    invalid value as argument \"%s\". Expecting \"%s\"."
+    str buffer_truncate
+
+let validate f str msg =
+  if str=buffer_truncate then f msg
+  else failed (unexpected str)
+
+(* Tests *)
+let () = print_string "Standard Library: Module Buffer\n"
+;;
+
+let truncate_neg : unit =
+  let msg =  "truncate: negative" in
+  try
+    Buffer.truncate buf (-1);
+    failed msg
+  with
+    Invalid_argument str -> validate passed str msg
+;;
+
+let truncate_large : unit =
+  let msg = "truncate: large" in
+  try
+    Buffer.truncate buf (n+1);
+    failed msg
+  with
+    Invalid_argument str -> validate passed str msg
+;;
+
+let truncate_correct : unit =
+  let n' = n - 1
+  and msg =  "truncate: in-range" in
+  try
+    Buffer.truncate buf n';
+    if Buffer.length buf = n' then
+      passed msg
+    else
+      failed msg
+  with
+    Invalid_argument str -> validate failed str msg
+;;
+
+let reset_non_zero : unit =
+  let msg = "reset: non-zero" in
+  Buffer.reset buf;
+  if Buffer.length buf = 0 then
+    passed msg
+  else
+    failed msg
+;;
+
+let reset_zero : unit =
+  let msg = "reset: zero" in
+  Buffer.reset buf;
+  if Buffer.length buf = 0 then
+    passed msg
+  else
+    failed msg
+;;
+
+let utf_8_spec =
+  (* UTF-8 byte sequences, cf. table 3.7 Unicode 9. *)
+  [(0x0000,0x007F),     [|(0x00,0x7F)|];
+   (0x0080,0x07FF),     [|(0xC2,0xDF); (0x80,0xBF)|];
+   (0x0800,0x0FFF),     [|(0xE0,0xE0); (0xA0,0xBF); (0x80,0xBF)|];
+   (0x1000,0xCFFF),     [|(0xE1,0xEC); (0x80,0xBF); (0x80,0xBF)|];
+   (0xD000,0xD7FF),     [|(0xED,0xED); (0x80,0x9F); (0x80,0xBF)|];
+   (0xE000,0xFFFF),     [|(0xEE,0xEF); (0x80,0xBF); (0x80,0xBF)|];
+   (0x10000,0x3FFFF),   [|(0xF0,0xF0); (0x90,0xBF); (0x80,0xBF); (0x80,0xBF)|];
+   (0x40000,0xFFFFF),   [|(0xF1,0xF3); (0x80,0xBF); (0x80,0xBF); (0x80,0xBF)|];
+   (0x100000,0x10FFFF), [|(0xF4,0xF4); (0x80,0x8F); (0x80,0xBF); (0x80,0xBF)|]]
+;;
+
+let utf_16be_spec =
+  (* UTF-16BE byte sequences, derived from table 3.5 Unicode 9. *)
+  [(0x0000,0xD7FF), [|(0x00,0xD7); (0x00,0xFF)|];
+   (0xE000,0xFFFF), [|(0xE0,0xFF); (0x00,0xFF)|];
+   (0x10000,0x10FFFF), [|(0xD8,0xDB); (0x00,0xFF); (0xDC,0xDF); (0x00,0xFF)|]]
+;;
+
+let uchar_map_of_spec spec =
+  (* array mapping Uchar.t as ints to byte sequences according to [spec]. *)
+  let map = Array.make ((Uchar.to_int Uchar.max) + 1) "" in
+  let add_range ((umin, umax), bytes) =
+    let len = Array.length bytes in
+    let bmin i = if i < len then fst bytes.(i) else max_int in
+    let bmax i = if i < len then snd bytes.(i) else min_int in
+    let uchar = ref umin in
+    let buf = Bytes.create len in
+    let add len' =
+      if len <> len' then () else
+      begin
+        let bytes = Bytes.to_string buf in
+        map.(!uchar) <- bytes;
+        incr uchar;
+      end
+    in
+    for b0 = bmin 0 to bmax 0 do
+      Bytes.unsafe_set buf 0 (Char.chr b0);
+      for b1 = bmin 1 to bmax 1 do
+        Bytes.unsafe_set buf 1 (Char.chr b1);
+        for b2 = bmin 2 to bmax 2 do
+          Bytes.unsafe_set buf 2 (Char.chr b2);
+          for b3 = bmin 3 to bmax 3 do
+            Bytes.unsafe_set buf 3 (Char.chr b3);
+            add 4;
+          done;
+          add 3;
+        done;
+        add 2;
+      done;
+      add 1;
+    done;
+    assert (!uchar - 1 = umax)
+  in
+  List.iter add_range spec;
+  map
+;;
+
+let test_spec_map msg utf_x_map buffer_add_utf_x_uchar =
+  let b = Buffer.create 4 in
+  let rec loop u =
+    Buffer.clear b; buffer_add_utf_x_uchar b u;
+    match Buffer.contents b = utf_x_map.(Uchar.to_int u) with
+    | false -> failed (sprintf "%s of U+%04X" msg (Uchar.to_int u))
+    | true ->
+        if Uchar.equal u Uchar.max then passed msg else loop (Uchar.succ u)
+  in
+  loop Uchar.min
+;;
+
+let add_utf_8_uchar : unit =
+  let map = uchar_map_of_spec utf_8_spec in
+  test_spec_map
+    "add_utf_8_uchar: test against spec" map Buffer.add_utf_8_uchar
+;;
+
+let add_utf_16be_uchar : unit =
+  let map = uchar_map_of_spec utf_16be_spec in
+  test_spec_map
+    "add_utf_16be_uchar: test against spec" map Buffer.add_utf_16be_uchar
+;;
+
+let add_utf_16le_uchar : unit =
+  (* The uchar_map_of_spec generation function doesn't work on a LE spec since
+     uchars and byte seqs have to increase and map together; simply swap
+     the map obtained with utf_16be_spec. *)
+  let map =
+    let swap bytes =
+      let swap i = match i with
+      | 0 -> 1 | 1 -> 0 | 2 -> 3 | 3 -> 2 | _ -> assert false
+      in
+      String.init (String.length bytes) (fun i -> bytes.[swap i])
+    in
+    Array.map swap (uchar_map_of_spec utf_16be_spec)
+  in
+  test_spec_map
+    "add_utf_16le_uchar: test against spec" map Buffer.add_utf_16le_uchar
+;;
+
+
+
+
+let () =
+  let b = Buffer.create 64 in
+  Buffer.add_int8 b 0xff;
+  Buffer.add_int8 b 0x01;
+  Buffer.add_int16_be b 0x0123;
+  Buffer.add_int16_le b 0x0123;
+  Buffer.add_int32_be b 0x01234567l;
+  Buffer.add_int32_le b 0x01234567l;
+  Buffer.add_int64_be b 0x0123456789abcdefL;
+  Buffer.add_int64_le b 0x0123456789abcdefL;
+  assert (Buffer.contents b =
+          "\xff\x01" ^
+          "\x01\x23\x23\x01" ^
+          "\x01\x23\x45\x67" ^
+          "\x67\x45\x23\x01" ^
+          "\x01\x23\x45\x67\x89\xab\xcd\xef" ^
+          "\xef\xcd\xab\x89\x67\x45\x23\x01"
+         );
+  Buffer.clear b;
+  Buffer.add_int16_ne b 0x0123;
+  Buffer.add_int32_ne b 0x01234567l;
+  Buffer.add_int64_ne b 0x0123456789abcdefL;
+  let s = Buffer.contents b in
+  if Sys.big_endian then
+    assert (s = "\x01\x23\x01\x23\x45\x67\x01\x23\x45\x67\x89\xab\xcd\xef")
+  else
+    assert (s = "\x23\x01\x67\x45\x23\x01\xef\xcd\xab\x89\x67\x45\x23\x01");
+
+  for i = 1 to 20 do
+    let b = Buffer.create i in
+    for j = 1 to 100 do
+      Buffer.add_int8 b 1
+    done;
+    assert(Buffer.length b = 100);
+  done;
+  for i = 1 to 20 do
+    let b = Buffer.create i in
+    for j = 1 to 100 do
+      Buffer.add_int16_ne b 1
+    done;
+    assert(Buffer.length b = 200);
+  done;
+  for i = 1 to 20 do
+    let b = Buffer.create i in
+    for j = 1 to 100 do
+      Buffer.add_int32_ne b 1l
+    done;
+    assert(Buffer.length b = 400);
+  done;
+  for i = 1 to 20 do
+    let b = Buffer.create i in
+    for j = 1 to 100 do
+      Buffer.add_int64_ne b 1L
+    done;
+    assert(Buffer.length b = 800);
+  done
+;;
diff --git a/testsuite/tests/lib-buffer/test.reference b/testsuite/tests/lib-buffer/test.reference
new file mode 100644
index 00000000..bc990bf2
--- /dev/null
+++ b/testsuite/tests/lib-buffer/test.reference
@@ -0,0 +1,9 @@
+Standard Library: Module Buffer
+Buffer truncate: negative passed
+Buffer truncate: large passed
+Buffer truncate: in-range passed
+Buffer reset: non-zero passed
+Buffer reset: zero passed
+Buffer add_utf_8_uchar: test against spec passed
+Buffer add_utf_16be_uchar: test against spec passed
+Buffer add_utf_16le_uchar: test against spec passed
diff --git a/testsuite/tests/lib-bytes/binary.ml b/testsuite/tests/lib-bytes/binary.ml
new file mode 100644
index 00000000..899cdfe0
--- /dev/null
+++ b/testsuite/tests/lib-bytes/binary.ml
@@ -0,0 +1,172 @@
+(* TEST
+*)
+
+let err x =
+  match Lazy.force x with
+  | exception Invalid_argument _ -> ()
+  | _ -> assert false
+
+let () =
+  let b = Bytes.make 5 (Char.chr 0) in
+  Bytes.set_int8 b 3 260;
+  Bytes.set_int8 b 2 1;
+  Bytes.set_int8 b 1 2;
+  Bytes.set_int8 b 0 3;
+  Bytes.set_int8 b 4 (-1);
+  assert (Bytes.to_string b = "\003\002\001\004\255");
+  lazy (Bytes.set_int8 b 5 0) |> err;
+  lazy (Bytes.get_int8 b 5) |> err;
+  lazy (Bytes.set_uint8 b 5 0) |> err;
+  lazy (Bytes.get_uint8 b 5) |> err;
+  assert(Bytes.get_int8 b 0 = 3);
+  assert(Bytes.get_int8 b 1 = 2);
+  assert(Bytes.get_int8 b 2 = 1);
+  assert(Bytes.get_int8 b 3 = 4);
+  assert(Bytes.get_int8 b 4 = -1);
+  assert(Bytes.get_uint8 b 0 = 3);
+  assert(Bytes.get_uint8 b 1 = 2);
+  assert(Bytes.get_uint8 b 2 = 1);
+  assert(Bytes.get_uint8 b 3 = 4);
+  assert(Bytes.get_uint8 b 4 = 255);
+  for i = 0 to 255 do
+    Bytes.set_uint8 b 0 i;
+    assert (Bytes.get_uint8 b 0 = i);
+  done;
+  for i = -128 to 127 do
+    Bytes.set_int8 b 0 i;
+    assert (Bytes.get_int8 b 0 = i);
+  done
+
+let () =
+  let b = Bytes.make 3 (Char.chr 0) in
+  Bytes.set_int16_le b 1 0x1234;
+  Bytes.set_int16_le b 0 0xabcd;
+  assert (Bytes.to_string b = "\xcd\xab\x12");
+  assert(Bytes.get_uint16_le b 0 = 0xabcd);
+  assert(Bytes.get_uint16_le b 1 = 0x12ab);
+  assert(Bytes.get_int16_le b 0 = 0xabcd - 0x10000);
+  assert(Bytes.get_int16_le b 1 = 0x12ab);
+  assert(Bytes.get_uint16_be b 1 = 0xab12);
+  assert(Bytes.get_int16_be b 1 = 0xab12 - 0x10000);
+  for i = 0 to Bytes.length b - 2 do
+    let x = Bytes.get_int16_ne b i in
+    let f = if Sys.big_endian then Bytes.get_int16_be else Bytes.get_int16_le in
+    assert (x = f b i);
+
+    let x = Bytes.get_uint16_ne b i in
+    let f = if Sys.big_endian then Bytes.get_uint16_be else Bytes.get_uint16_le in
+    assert (x = f b i)
+  done;
+  lazy (Bytes.set_int16_le b 2 0) |> err;
+  lazy (Bytes.set_int16_ne b 2 0) |> err;
+  lazy (Bytes.set_int16_be b 2 0) |> err;
+  lazy (Bytes.get_int16_le b 2) |> err;
+  lazy (Bytes.get_int16_ne b 2) |> err;
+  lazy (Bytes.get_int16_be b 2) |> err;
+  lazy (Bytes.set_uint16_le b 2 0) |> err;
+  lazy (Bytes.set_uint16_ne b 2 0) |> err;
+  lazy (Bytes.set_uint16_be b 2 0) |> err;
+  lazy (Bytes.get_uint16_le b 2) |> err;
+  lazy (Bytes.get_uint16_ne b 2) |> err;
+  lazy (Bytes.get_uint16_be b 2) |> err;
+  for i = 0 to 0xffff do
+    Bytes.set_uint16_le b 0 i;
+    assert (Bytes.get_uint16_le b 0 = i);
+    Bytes.set_uint16_be b 0 i;
+    assert (Bytes.get_uint16_be b 0 = i);
+    Bytes.set_uint16_ne b 0 i;
+    assert (Bytes.get_uint16_ne b 0 = i);
+    assert (
+      (if Sys.big_endian then Bytes.get_uint16_be else Bytes.get_uint16_le)
+        b 0 = i);
+  done;
+  for i = -0x8000 to 0x7fff do
+    Bytes.set_int16_le b 0 i;
+    assert (Bytes.get_int16_le b 0 = i);
+    Bytes.set_int16_be b 0 i;
+    assert (Bytes.get_int16_be b 0 = i);
+    Bytes.set_int16_ne b 0 i;
+    assert (Bytes.get_int16_ne b 0 = i);
+    assert (
+      (if Sys.big_endian then Bytes.get_int16_be else Bytes.get_int16_le)
+        b 0 = i);
+  done
+
+let () =
+  let b = Bytes.make 6 (Char.chr 0) in
+  Bytes.set_int32_le b 1 0x01234567l;
+  Bytes.set_int32_le b 0 0x89abcdefl;
+  assert (Bytes.to_string b = "\xef\xcd\xab\x89\x01\x00");
+  assert (Bytes.get_int32_le b 0 = 0x89abcdefl);
+  assert (Bytes.get_int32_be b 0 = 0xefcdab89l);
+  assert (Bytes.get_int32_le b 1 = 0x0189abcdl);
+  assert (Bytes.get_int32_be b 1 = 0xcdab8901l);
+
+  Bytes.set_int32_be b 1 0x01234567l;
+  Bytes.set_int32_be b 0 0x89abcdefl;
+  assert (Bytes.to_string b = "\x89\xab\xcd\xef\x67\x00");
+
+  Bytes.set_int32_ne b 0 0x01234567l;
+  assert(Bytes.get_int32_ne b 0 = 0x01234567l);
+  if Sys.big_endian then
+    assert (Bytes.to_string b = "\x01\x23\x45\x67\x67\x00")
+  else
+    assert (Bytes.to_string b = "\x67\x45\x23\x01\x67\x00");
+  Bytes.set_int32_ne b 0 0xffffffffl;
+  assert(Bytes.get_int32_ne b 0 = 0xffffffffl);
+
+
+  for i = 0 to Bytes.length b - 4 do
+    let x = Bytes.get_int32_ne b i in
+    let f =
+      if Sys.big_endian then Bytes.get_int32_be else Bytes.get_int32_le
+    in
+    assert (x = f b i);
+  done;
+  lazy (Bytes.set_int32_le b 3 0l) |> err;
+  lazy (Bytes.set_int32_ne b 3 0l) |> err;
+  lazy (Bytes.set_int32_be b 3 0l) |> err;
+  lazy (Bytes.get_int32_le b 3) |> err;
+  lazy (Bytes.get_int32_ne b 3) |> err;
+  lazy (Bytes.get_int32_be b 3) |> err;
+  ()
+
+
+let () =
+  let b = Bytes.make 10 (Char.chr 0) in
+  Bytes.set_int64_le b 1 0x0123456789abcdefL;
+  Bytes.set_int64_le b 0 0x1032547698badcfeL;
+  assert (Bytes.to_string b = "\xfe\xdc\xba\x98\x76\x54\x32\x10\x01\x00");
+  assert (Bytes.get_int64_le b 0 = 0x1032547698badcfeL);
+  assert (Bytes.get_int64_be b 0 = 0xfedcba9876543210L);
+  assert (Bytes.get_int64_le b 1 = 0x011032547698badcL);
+  assert (Bytes.get_int64_be b 1 = 0xdcba987654321001L);
+
+  Bytes.set_int64_be b 1 0x0123456789abcdefL;
+  Bytes.set_int64_be b 0 0x1032547698badcfeL;
+  assert (Bytes.to_string b = "\x10\x32\x54\x76\x98\xba\xdc\xfe\xef\x00");
+
+  Bytes.set_int64_ne b 0 0x0123456789abcdefL;
+  assert(Bytes.get_int64_ne b 0 = 0x0123456789abcdefL);
+  if Sys.big_endian then
+    assert (Bytes.to_string b = "\x01\x23\x45\x67\x89\xab\xcd\xef\xef\x00")
+  else
+    assert (Bytes.to_string b = "\xef\xcd\xab\x89\x67\x45\x23\x01\xef\x00");
+  Bytes.set_int64_ne b 0 0xffffffffffffffffL;
+  assert(Bytes.get_int64_ne b 0 = 0xffffffffffffffffL);
+
+  for i = 0 to Bytes.length b - 8 do
+    let x = Bytes.get_int64_ne b i in
+    let f =
+      if Sys.big_endian then Bytes.get_int64_be else Bytes.get_int64_le
+    in
+    assert (x = f b i);
+  done;
+
+  lazy (Bytes.set_int64_le b 3 0L) |> err;
+  lazy (Bytes.set_int64_ne b 3 0L) |> err;
+  lazy (Bytes.set_int64_be b 3 0L) |> err;
+  lazy (Bytes.get_int64_le b 3) |> err;
+  lazy (Bytes.get_int64_ne b 3) |> err;
+  lazy (Bytes.get_int64_be b 3) |> err;
+  ()
diff --git a/testsuite/tests/lib-bytes/test_bytes.ml b/testsuite/tests/lib-bytes/test_bytes.ml
new file mode 100644
index 00000000..33a285d8
--- /dev/null
+++ b/testsuite/tests/lib-bytes/test_bytes.ml
@@ -0,0 +1,126 @@
+(* TEST
+   include testing
+*)
+
+let test_raises_invalid_argument f x =
+  ignore
+    (Testing.test_raises_exc_p
+      (function Invalid_argument _ -> true | _ -> false) f x)
+
+let check b offset s =
+  let rec loop i =
+    i = String.length s ||
+    Bytes.get b (i + offset) = String.get s i && loop (i+1)
+  in
+  loop 0
+
+let () =
+  let abcde = Bytes.of_string "abcde" in
+  let open Bytes in
+  begin
+    (*
+           abcde
+    ?????
+    *)
+    Testing.test
+      (length (extend abcde 7 (-7)) = 5);
+
+    (*
+    abcde
+           ?????
+    *)
+    Testing.test
+      (length (extend abcde (-7) 7) = 5);
+
+    (*
+      abcde
+      abcde
+    *)
+    Testing.test
+      (let r = extend abcde 0 0 in
+       length r = 5 && check r 0 "abcde"
+       && r != abcde);
+
+    (*
+      abcde
+    ??abc
+    *)
+    Testing.test
+      (let r = extend abcde 2 (-2) in
+       length r = 5 && check r 2 "abc");
+
+    (*
+      abcde
+       bcd
+    *)
+    Testing.test
+      (let r = extend abcde (-1) (-1) in
+       length r = 3 && check r 0 "bcd");
+
+    (*
+      abcde
+         de??
+    *)
+    Testing.test
+      (let r = extend abcde (-3) 2 in
+       length r = 4 && check r 0 "de");
+
+    (*
+      abcde
+      abc
+    *)
+    Testing.test
+      (let r = extend abcde 0 (-2) in
+       length r = 3 && check r 0 "abc");
+
+    (*
+      abcde
+        cde
+    *)
+    Testing.test
+      (let r = extend abcde (-2) 0 in
+       length r = 3 && check r 0 "cde");
+
+    (*
+      abcde
+      abcde??
+    *)
+    Testing.test
+      (let r = extend abcde 0 2 in
+       length r = 7
+       && check r 0 "abcde");
+
+    (*
+        abcde
+      ??abcde
+    *)
+    Testing.test
+      (let r = extend abcde 2 0 in
+       length r = 7
+       && check r 2 "abcde");
+
+    (*
+       abcde
+      ?abcde?
+    *)
+    Testing.test
+      (let r = extend abcde 1 1 in
+       length r = 7
+       && check r 1 "abcde");
+
+    (* length + left + right < 0 *)
+    test_raises_invalid_argument
+      (fun () -> extend abcde (-3) (-3)) ();
+
+    (* length + left > max_int *)
+    test_raises_invalid_argument
+      (fun () -> extend abcde max_int 0) ();
+
+    (* length + right > max_int *)
+    test_raises_invalid_argument
+      (fun () -> extend abcde 0 max_int) ();
+
+    (* length + left + right > max_int *)
+    test_raises_invalid_argument
+      (fun () -> extend abcde max_int max_int) ();
+  end
diff --git a/testsuite/tests/lib-bytes/test_bytes.reference b/testsuite/tests/lib-bytes/test_bytes.reference
new file mode 100644
index 00000000..d2a3171e
--- /dev/null
+++ b/testsuite/tests/lib-bytes/test_bytes.reference
@@ -0,0 +1,2 @@
+ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+All tests succeeded.
diff --git a/testsuite/tests/lib-digest/md5.ml b/testsuite/tests/lib-digest/md5.ml
new file mode 100644
index 00000000..4c686df6
--- /dev/null
+++ b/testsuite/tests/lib-digest/md5.ml
@@ -0,0 +1,240 @@
+(* TEST
+   flags += " -w a "
+*)
+
+(* Test int32 arithmetic and optimizations using the MD5 algorithm *)
+
+open Printf
+
+type context =
+  { buf: bytes;
+    mutable pos: int;
+    mutable a: int32;
+    mutable b: int32;
+    mutable c: int32;
+    mutable d: int32;
+    mutable bits: int64 }
+
+let step1 w x y z data s =
+  let w =
+    Int32.add (Int32.add w data)
+              (Int32.logxor z (Int32.logand x (Int32.logxor y z))) in
+  Int32.add x
+    (Int32.logor (Int32.shift_left w s) (Int32.shift_right_logical w (32-s)))
+
+let step2 w x y z data s =
+  let w =
+    Int32.add (Int32.add w data)
+              (Int32.logxor y (Int32.logand z (Int32.logxor x y))) in
+  Int32.add x
+    (Int32.logor (Int32.shift_left w s) (Int32.shift_right_logical w (32-s)))
+
+let step3 w x y z data s =
+  let w =
+    Int32.add (Int32.add w data)
+              (Int32.logxor x (Int32.logxor y z)) in
+  Int32.add x
+    (Int32.logor (Int32.shift_left w s) (Int32.shift_right_logical w (32-s)))
+
+let step4 w x y z data s =
+  let w =
+    Int32.add (Int32.add w data)
+              (Int32.logxor y (Int32.logor x (Int32.logxor z (-1l)))) in
+  Int32.add x
+    (Int32.logor (Int32.shift_left w s) (Int32.shift_right_logical w (32-s)))
+
+let transform ctx data =
+    let a = ctx.a and b = ctx.b and c = ctx.c and d = ctx.d in
+
+    let a = step1 a b c d (Int32.add data.(0) 0xd76aa478l) 7 in
+    let d = step1 d a b c (Int32.add data.(1) 0xe8c7b756l) 12 in
+    let c = step1 c d a b (Int32.add data.(2) 0x242070dbl) 17 in
+    let b = step1 b c d a (Int32.add data.(3) 0xc1bdceeel) 22 in
+    let a = step1 a b c d (Int32.add data.(4) 0xf57c0fafl) 7 in
+    let d = step1 d a b c (Int32.add data.(5) 0x4787c62al) 12 in
+    let c = step1 c d a b (Int32.add data.(6) 0xa8304613l) 17 in
+    let b = step1 b c d a (Int32.add data.(7) 0xfd469501l) 22 in
+    let a = step1 a b c d (Int32.add data.(8) 0x698098d8l) 7 in
+    let d = step1 d a b c (Int32.add data.(9) 0x8b44f7afl) 12 in
+    let c = step1 c d a b (Int32.add data.(10) 0xffff5bb1l) 17 in
+    let b = step1 b c d a (Int32.add data.(11) 0x895cd7bel) 22 in
+    let a = step1 a b c d (Int32.add data.(12) 0x6b901122l) 7 in
+    let d = step1 d a b c (Int32.add data.(13) 0xfd987193l) 12 in
+    let c = step1 c d a b (Int32.add data.(14) 0xa679438el) 17 in
+    let b = step1 b c d a (Int32.add data.(15) 0x49b40821l) 22 in
+
+    let a = step2 a b c d (Int32.add data.(1) 0xf61e2562l) 5 in
+    let d = step2 d a b c (Int32.add data.(6) 0xc040b340l) 9 in
+    let c = step2 c d a b (Int32.add data.(11) 0x265e5a51l) 14 in
+    let b = step2 b c d a (Int32.add data.(0) 0xe9b6c7aal) 20 in
+    let a = step2 a b c d (Int32.add data.(5) 0xd62f105dl) 5 in
+    let d = step2 d a b c (Int32.add data.(10) 0x02441453l) 9 in
+    let c = step2 c d a b (Int32.add data.(15) 0xd8a1e681l) 14 in
+    let b = step2 b c d a (Int32.add data.(4) 0xe7d3fbc8l) 20 in
+    let a = step2 a b c d (Int32.add data.(9) 0x21e1cde6l) 5 in
+    let d = step2 d a b c (Int32.add data.(14) 0xc33707d6l) 9 in
+    let c = step2 c d a b (Int32.add data.(3) 0xf4d50d87l) 14 in
+    let b = step2 b c d a (Int32.add data.(8) 0x455a14edl) 20 in
+    let a = step2 a b c d (Int32.add data.(13) 0xa9e3e905l) 5 in
+    let d = step2 d a b c (Int32.add data.(2) 0xfcefa3f8l) 9 in
+    let c = step2 c d a b (Int32.add data.(7) 0x676f02d9l) 14 in
+    let b = step2 b c d a (Int32.add data.(12) 0x8d2a4c8al) 20 in
+
+    let a = step3 a b c d (Int32.add data.(5) 0xfffa3942l) 4 in
+    let d = step3 d a b c (Int32.add data.(8) 0x8771f681l) 11 in
+    let c = step3 c d a b (Int32.add data.(11) 0x6d9d6122l) 16 in
+    let b = step3 b c d a (Int32.add data.(14) 0xfde5380cl) 23 in
+    let a = step3 a b c d (Int32.add data.(1) 0xa4beea44l) 4 in
+    let d = step3 d a b c (Int32.add data.(4) 0x4bdecfa9l) 11 in
+    let c = step3 c d a b (Int32.add data.(7) 0xf6bb4b60l) 16 in
+    let b = step3 b c d a (Int32.add data.(10) 0xbebfbc70l) 23 in
+    let a = step3 a b c d (Int32.add data.(13) 0x289b7ec6l) 4 in
+    let d = step3 d a b c (Int32.add data.(0) 0xeaa127fal) 11 in
+    let c = step3 c d a b (Int32.add data.(3) 0xd4ef3085l) 16 in
+    let b = step3 b c d a (Int32.add data.(6) 0x04881d05l) 23 in
+    let a = step3 a b c d (Int32.add data.(9) 0xd9d4d039l) 4 in
+    let d = step3 d a b c (Int32.add data.(12) 0xe6db99e5l) 11 in
+    let c = step3 c d a b (Int32.add data.(15) 0x1fa27cf8l) 16 in
+    let b = step3 b c d a (Int32.add data.(2) 0xc4ac5665l) 23 in
+
+    let a = step4 a b c d (Int32.add data.(0) 0xf4292244l) 6 in
+    let d = step4 d a b c (Int32.add data.(7) 0x432aff97l) 10 in
+    let c = step4 c d a b (Int32.add data.(14) 0xab9423a7l) 15 in
+    let b = step4 b c d a (Int32.add data.(5) 0xfc93a039l) 21 in
+    let a = step4 a b c d (Int32.add data.(12) 0x655b59c3l) 6 in
+    let d = step4 d a b c (Int32.add data.(3) 0x8f0ccc92l) 10 in
+    let c = step4 c d a b (Int32.add data.(10) 0xffeff47dl) 15 in
+    let b = step4 b c d a (Int32.add data.(1) 0x85845dd1l) 21 in
+    let a = step4 a b c d (Int32.add data.(8) 0x6fa87e4fl) 6 in
+    let d = step4 d a b c (Int32.add data.(15) 0xfe2ce6e0l) 10 in
+    let c = step4 c d a b (Int32.add data.(6) 0xa3014314l) 15 in
+    let b = step4 b c d a (Int32.add data.(13) 0x4e0811a1l) 21 in
+    let a = step4 a b c d (Int32.add data.(4) 0xf7537e82l) 6 in
+    let d = step4 d a b c (Int32.add data.(11) 0xbd3af235l) 10 in
+    let c = step4 c d a b (Int32.add data.(2) 0x2ad7d2bbl) 15 in
+    let b = step4 b c d a (Int32.add data.(9) 0xeb86d391l) 21 in
+
+    ctx.a <- Int32.add ctx.a a;
+    ctx.b <- Int32.add ctx.b b;
+    ctx.c <- Int32.add ctx.c c;
+    ctx.d <- Int32.add ctx.d d
+
+let string_to_data s =
+  let data = Array.make 16 0l in
+  for i = 0 to 15 do
+    let j = i lsl 2 in
+    data.(i) <-
+      let byte n = Bytes.get s (j+n) |> Char.code |> Int32.of_int in
+      let open Int32 in
+      byte 0
+      |> logor (shift_left (byte 1) 8)
+      |> logor (shift_left (byte 2) 16)
+      |> logor (shift_left (byte 3) 24)
+  done;
+  data
+
+let int32_to_string n s i =
+  Bytes.set s (i+3)
+    (Char.chr (Int32.to_int (Int32.shift_right n 24) land 0xFF));
+  Bytes.set s (i+2)
+    (Char.chr (Int32.to_int (Int32.shift_right n 16) land 0xFF));
+  Bytes.set s (i+1)
+    (Char.chr (Int32.to_int (Int32.shift_right n 8) land 0xFF));
+  Bytes.set s i
+    (Char.chr (Int32.to_int n land 0xFF))
+
+let init () =
+  { buf = Bytes.create 64;
+    pos = 0;
+    a = 0x67452301l;
+    b = 0xefcdab89l;
+    c = 0x98badcfel;
+    d = 0x10325476l;
+    bits = 0L }
+
+let update ctx input ofs len =
+  let rec upd ofs len =
+    if len <= 0 then () else
+    if ctx.pos + len < 64 then begin
+      (* Just buffer the data *)
+      Bytes.blit_string input ofs ctx.buf ctx.pos len;
+      ctx.pos <- ctx.pos + len
+    end else begin
+      (* Fill the buffer *)
+      let len' = 64 - ctx.pos in
+      if len' > 0 then Bytes.blit_string input ofs ctx.buf ctx.pos len';
+      (* Transform 64 bytes *)
+      transform ctx (string_to_data ctx.buf);
+      ctx.pos <- 0;
+      upd (ofs + len') (len - len')
+    end in
+  upd ofs len;
+  ctx.bits <- Int64.add ctx.bits (Int64.of_int (len lsl 3))
+
+
+let finish ctx =
+  let padding = String.init 64 (function 0 -> '\x80' | _ -> '\000') in
+  let numbits = ctx.bits in
+  if ctx.pos < 56 then begin
+    update ctx padding 0 (56 - ctx.pos)
+  end else begin
+    update ctx padding 0 (64 + 56 - ctx.pos)
+  end;
+  assert (ctx.pos = 56);
+  let data = string_to_data ctx.buf in
+  data.(14) <- (Int64.to_int32 numbits);
+  data.(15) <- (Int64.to_int32 (Int64.shift_right_logical numbits 32));
+  transform ctx data;
+  let res = Bytes.create 16 in
+  int32_to_string ctx.a res 0;
+  int32_to_string ctx.b res 4;
+  int32_to_string ctx.c res 8;
+  int32_to_string ctx.d res 12;
+  Bytes.unsafe_to_string res
+
+let test hex s =
+  let ctx = init() in
+  update ctx s 0 (String.length s);
+  let res = finish ctx in
+  let exp = Digest.string s in
+  let ok = res = exp && Digest.to_hex exp = hex in
+  if not ok then
+    Printf.printf "Failure for %S : %S %S %S %S\n" s res exp
+                  (Digest.to_hex exp) hex;
+  ok
+
+let time msg iter fn =
+  let start = Sys.time() in
+  for i = 1 to iter do fn () done;
+  let stop = Sys.time() in
+  printf "%s: %.2f s\n" msg (stop -. start)
+
+let _ =
+  (* Test *)
+  if test "d41d8cd98f00b204e9800998ecf8427e" ""
+  && test "0cc175b9c0f1b6a831c399e269772661" "a"
+  && test "900150983cd24fb0d6963f7d28e17f72" "abc"
+  && test "8215ef0796a20bcaaae116d3876c664a"
+          "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
+  && test "7707d6ae4e027c70eea2a935c2296f21" (String.make 1_000_000 'a')
+  && test "f96b697d7cb7938d525a2f31aaf161d0" "message digest"
+  && test "d174ab98d277d9f5a5611c2c9f419d9f"
+          "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
+  && test "9e107d9d372bb6826bd81d3542a419d6"
+          "The quick brown fox jumps over the lazy dog"
+  && test "e4d909c290d0fb1ca068ffaddf22cbd0"
+          "The quick brown fox jumps over the lazy dog."
+  then printf "Test vectors passed.\n";
+  flush stdout;
+  (* Benchmark *)
+  if (Array.length Sys.argv) > 1 && (Sys.argv.(1) = "-benchmark") then begin
+    let s = String.make 50000 'a' in
+    let num_iter = 1000 in
+    time "OCaml implementation" num_iter
+      (fun () ->
+        let ctx = init() in
+        update ctx s 0 (String.length s);
+        ignore (finish ctx));
+    time "C implementation" num_iter
+      (fun () -> ignore (Digest.string s))
+  end
diff --git a/testsuite/tests/lib-digest/md5.reference b/testsuite/tests/lib-digest/md5.reference
new file mode 100644
index 00000000..956ac654
--- /dev/null
+++ b/testsuite/tests/lib-digest/md5.reference
@@ -0,0 +1 @@
+Test vectors passed.
diff --git a/testsuite/tests/lib-dynlink-bytecode/custom.reference b/testsuite/tests/lib-dynlink-bytecode/custom.reference
new file mode 100644
index 00000000..c9d2b575
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-bytecode/custom.reference
@@ -0,0 +1,5 @@
+This is stub2, calling stub1:
+This is stub1!
+Ok!
+This is stub1!
+ABCDEF
diff --git a/testsuite/tests/lib-dynlink-bytecode/main.ml b/testsuite/tests/lib-dynlink-bytecode/main.ml
new file mode 100644
index 00000000..558dc69a
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-bytecode/main.ml
@@ -0,0 +1,93 @@
+(* TEST
+
+include dynlink
+
+ld_library_path += "${test_build_directory}"
+
+files = "plug1.ml plug2.ml registry.ml stub1.c stub2.c"
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+compile_only = "true"
+all_modules = "registry.ml stub1.c stub2.c plug1.ml plug2.ml main.ml"
+**** ocamlmklib
+program = "plug1"
+modules = "stub1.${objext}"
+***** ocamlmklib
+program = "plug2"
+modules = "stub2.${objext}"
+****** ocamlmklib
+program = "plug1"
+modules = "plug1.cmo"
+******* ocamlmklib
+program = "plug2"
+modules = "plug2.cmo"
+
+compile_only = "false"
+
+******** ocamlc.byte
+program = "${test_build_directory}/main.exe"
+all_modules = "registry.cmo main.cmo"
+********* run
+arguments = "plug1.cma plug2.cma"
+output = "main.output"
+********** check-program-output
+
+******** ocamlc.byte
+program = "${test_build_directory}/static.exe"
+flags = "-linkall"
+all_modules = "registry.cmo plug1.cma plug2.cma"
+********* run
+output = "static.output"
+********** check-program-output
+reference = "${test_source_directory}/static.reference"
+
+******** ocamlc.byte
+program = "${test_build_directory}/custom.exe"
+flags = "-custom -linkall -I ."
+all_modules = "registry.cmo plug2.cma plug1.cma"
+use_runtime = "false"
+********* run
+output = "custom.output"
+********** check-program-output
+reference = "${test_source_directory}/custom.reference"
+
+*)
+
+let f x = print_string "This is Main.f\n"; x
+
+let () = Registry.register f
+
+let _ =
+  Dynlink.allow_unsafe_modules true;
+  for i = 1 to Array.length Sys.argv - 1 do
+    let name = Sys.argv.(i) in
+    Printf.printf "Loading %s\n" name; flush stdout;
+    try
+      if name.[0] = '-'
+      then Dynlink.loadfile_private
+        (String.sub name 1 (String.length name - 1))
+      else Dynlink.loadfile name
+    with
+      | Dynlink.Error err ->
+          Printf.printf "Dynlink error: %s\n"
+            (Dynlink.error_message err)
+      | exn ->
+          Printf.printf "Error: %s\n" (Printexc.to_string exn)
+  done;
+  flush stdout;
+  try
+    let oc = open_out_bin "marshal.data" in
+    Marshal.to_channel oc (Registry.get_functions()) [Marshal.Closures];
+    close_out oc;
+    let ic = open_in_bin "marshal.data" in
+    let l = (Marshal.from_channel ic : (int -> int) list) in
+    close_in ic;
+    List.iter
+      (fun f ->
+        let res = f 0 in
+        Printf.printf "Result is: %d\n" res)
+      l
+  with Failure s ->
+    Printf.printf "Failure: %s\n" s
diff --git a/testsuite/tests/lib-dynlink-bytecode/main.reference b/testsuite/tests/lib-dynlink-bytecode/main.reference
new file mode 100644
index 00000000..577292f9
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-bytecode/main.reference
@@ -0,0 +1,13 @@
+Loading plug1.cma
+This is stub1!
+ABCDEF
+Loading plug2.cma
+This is stub2, calling stub1:
+This is stub1!
+Ok!
+This is Plug2.f
+Result is: 2
+This is Plug1.f
+Result is: 1
+This is Main.f
+Result is: 0
diff --git a/testsuite/tests/lib-dynlink-bytecode/plug1.ml b/testsuite/tests/lib-dynlink-bytecode/plug1.ml
new file mode 100644
index 00000000..d0490689
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-bytecode/plug1.ml
@@ -0,0 +1,7 @@
+external stub1: unit -> string = "stub1"
+
+let f x = print_string "This is Plug1.f\n"; x + 1
+
+let () = Registry.register f
+
+let () = print_endline (stub1 ())
diff --git a/testsuite/tests/lib-dynlink-bytecode/plug2.ml b/testsuite/tests/lib-dynlink-bytecode/plug2.ml
new file mode 100644
index 00000000..350374e5
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-bytecode/plug2.ml
@@ -0,0 +1,7 @@
+external stub2: unit -> unit = "stub2"
+
+let f x = print_string "This is Plug2.f\n"; x + 2
+
+let () = Registry.register f
+
+let () = stub2 ()
diff --git a/testsuite/tests/lib-dynlink-bytecode/registry.ml b/testsuite/tests/lib-dynlink-bytecode/registry.ml
new file mode 100644
index 00000000..e0f76423
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-bytecode/registry.ml
@@ -0,0 +1,7 @@
+let functions = ref ([]: (int -> int) list)
+
+let register f =
+  functions := f :: !functions
+
+let get_functions () =
+  !functions
diff --git a/testsuite/tests/lib-dynlink-bytecode/static.reference b/testsuite/tests/lib-dynlink-bytecode/static.reference
new file mode 100644
index 00000000..4faa129c
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-bytecode/static.reference
@@ -0,0 +1,5 @@
+This is stub1!
+ABCDEF
+This is stub2, calling stub1:
+This is stub1!
+Ok!
diff --git a/testsuite/tests/lib-dynlink-bytecode/stub1.c b/testsuite/tests/lib-dynlink-bytecode/stub1.c
new file mode 100644
index 00000000..2c66b28e
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-bytecode/stub1.c
@@ -0,0 +1,27 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*                         Alain Frisch, LexiFi                           */
+/*                                                                        */
+/*   Copyright 2007 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+#include "caml/alloc.h"
+#include <stdio.h>
+
+value stub1(void) {
+  CAMLparam0();
+  CAMLlocal1(x);
+  printf("This is stub1!\n"); fflush(stdout);
+  x = caml_copy_string("ABCDEF");
+  CAMLreturn(x);
+}
diff --git a/testsuite/tests/lib-dynlink-bytecode/stub2.c b/testsuite/tests/lib-dynlink-bytecode/stub2.c
new file mode 100644
index 00000000..f4cd3a7e
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-bytecode/stub2.c
@@ -0,0 +1,28 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*                         Alain Frisch, LexiFi                           */
+/*                                                                        */
+/*   Copyright 2007 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+#include "caml/alloc.h"
+#include <stdio.h>
+
+extern value stub1(void);
+
+value stub2(void) {
+  printf("This is stub2, calling stub1:\n"); fflush(stdout);
+  stub1();
+  printf("Ok!\n"); fflush(stdout);
+  return Val_unit;
+}
diff --git a/testsuite/tests/lib-dynlink-csharp/entry.c b/testsuite/tests/lib-dynlink-csharp/entry.c
new file mode 100644
index 00000000..12e39a5b
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-csharp/entry.c
@@ -0,0 +1,44 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*                         Alain Frisch, LexiFi                           */
+/*                                                                        */
+/*   Copyright 2007 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/mlvalues.h>
+#include <caml/callback.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+
+#if !defined(OPENSTEP) && (defined(_WIN32) && !defined(__CYGWIN__))
+#  if defined(_MSC_VER) || defined(__MINGW32__)
+#    define _DLLAPI __declspec(dllexport)
+#  else
+#    define _DLLAPI extern
+#  endif
+#  if defined(__MINGW32__) || defined(UNDER_CE)
+#    define _CALLPROC
+#  else
+#    define _CALLPROC __stdcall
+#  endif
+#elif defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__) >= 303
+#  define _DLLAPI __attribute__((visibility("default")))
+#  define _CALLPROC
+#endif /* WIN32 && !CYGWIN */
+
+_DLLAPI void _CALLPROC start_caml_engine() {
+  wchar_t * argv[2];
+  argv[0] = L"--";
+  argv[1] = NULL;
+  caml_startup(argv);
+}
diff --git a/testsuite/tests/lib-dynlink-csharp/main.bytecode.reference b/testsuite/tests/lib-dynlink-csharp/main.bytecode.reference
new file mode 100644
index 00000000..c162cac0
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-csharp/main.bytecode.reference
@@ -0,0 +1,5 @@
+Now starting the OCaml engine.
+Main is running.
+Loading plugin.cmo
+I'm the plugin.
+OK.
diff --git a/testsuite/tests/lib-dynlink-csharp/main.cs b/testsuite/tests/lib-dynlink-csharp/main.cs
new file mode 100644
index 00000000..5cbb8e86
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-csharp/main.cs
@@ -0,0 +1,11 @@
+using System.Runtime.InteropServices;
+
+public class M {
+  [DllImport("main.dll")]
+  public static extern void start_caml_engine();
+
+  public static void Main() {
+    System.Console.WriteLine("Now starting the OCaml engine.");
+    start_caml_engine();
+  }
+}
diff --git a/testsuite/tests/lib-dynlink-csharp/main.ml b/testsuite/tests/lib-dynlink-csharp/main.ml
new file mode 100644
index 00000000..35f0ca4c
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-csharp/main.ml
@@ -0,0 +1,100 @@
+(* TEST
+
+include dynlink
+
+files = "entry.c main.cs plugin.ml"
+
+* csharp-compiler
+** shared-libraries
+set csharp_cmd = "${csc} ${csc_flags} /out:main.exe main.cs"
+
+*** setup-ocamlc.byte-build-env
+**** ocamlc.byte
+module = "plugin.ml"
+***** ocamlc.byte
+module = ""
+flags = "-output-obj"
+program = "main.dll"
+all_modules = "dynlink.cma main.ml entry.c"
+****** script
+script = "${csharp_cmd}"
+******* run
+program = "./main.exe"
+******** check-program-output
+reference = "${test_source_directory}/main.bytecode.reference"
+
+*** setup-ocamlc.byte-build-env
+compiler_directory_suffix = "-dll"
+**** ocamlc.byte
+module = "plugin.ml"
+***** ocamlc.byte
+module = ""
+flags = "-output-obj"
+program = "main_obj.${objext}"
+all_modules = "dynlink.cma entry.c main.ml"
+****** script
+script = "${mkdll} -maindll -o main.dll main_obj.${objext} entry.${objext} \
+                   ${ocamlsrcdir}/runtime/libcamlrun.lib ${bytecc_libs}"
+******* script
+script = "${csharp_cmd}"
+******** run
+program = "./main.exe"
+********* check-program-output
+reference = "${test_source_directory}/main.bytecode.reference"
+
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+program = "plugin.cmxs"
+flags = "-shared"
+all_modules = "plugin.ml"
+***** ocamlopt.byte
+flags = "-output-obj"
+program= "main.dll"
+all_modules = "dynlink.cmxa entry.c main.ml"
+****** script
+script = "${csharp_cmd}"
+******* run
+program = "./main.exe"
+******** check-program-output
+reference = "${test_source_directory}/main.native.reference"
+
+*** setup-ocamlopt.byte-build-env
+compiler_directory_suffix = "-dll"
+**** ocamlopt.byte
+program = "plugin.cmxs"
+flags = "-shared"
+all_modules = "plugin.ml"
+***** ocamlopt.byte
+flags = "-output-obj"
+program = "main_obj.${objext}"
+all_modules = "dynlink.cmxa entry.c main.ml"
+****** script
+script = "${mkdll} -maindll -o main.dll main_obj.${objext} entry.${objext} \
+                   ${ocamlsrcdir}/runtime/libasmrun.lib ${nativecc_libs}"
+******* script
+script = "${csharp_cmd}"
+******** run
+program = "./main.exe"
+********* check-program-output
+reference = "${test_source_directory}/main.native.reference"
+
+*)
+
+let load s =
+  Printf.printf "Loading %s\n%!" s;
+  try
+    Dynlink.loadfile s
+  with Dynlink.Error e ->
+    print_endline (Dynlink.error_message e)
+
+(* Callback must be linked to load Unix dynamically *)
+let _ = Callback.register
+let _ = Stdlib.Bigarray.float32
+
+let () =
+  ignore (Hashtbl.hash 42.0);
+  print_endline "Main is running.";
+  Dynlink.allow_unsafe_modules true;
+  let plugin_name = Dynlink.adapt_filename "plugin.cmo" in
+  load plugin_name;
+  print_endline "OK."
diff --git a/testsuite/tests/lib-dynlink-csharp/main.native.reference b/testsuite/tests/lib-dynlink-csharp/main.native.reference
new file mode 100644
index 00000000..a26525ee
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-csharp/main.native.reference
@@ -0,0 +1,5 @@
+Now starting the OCaml engine.
+Main is running.
+Loading plugin.cmxs
+I'm the plugin.
+OK.
diff --git a/testsuite/tests/lib-dynlink-csharp/plugin.ml b/testsuite/tests/lib-dynlink-csharp/plugin.ml
new file mode 100644
index 00000000..aacf9f21
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-csharp/plugin.ml
@@ -0,0 +1,4 @@
+let f x = x.{2}
+
+let () =
+  print_endline "I'm the plugin."
diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference b/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference
new file mode 100755
index 00000000..97ec42cd
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference
@@ -0,0 +1,12 @@
+Error: Failure("Plugin error")
+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 "otherlibs/dynlink/dynlink.ml", line 137, characters 16-25
+Re-raised at Dynlink.Bytecode.run in file "otherlibs/dynlink/dynlink.ml", line 139, characters 6-137
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 344, characters 13-44
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 342, characters 8-240
+Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 352, characters 8-17
+Called from Test10_main in file "test10_main.ml", line 51, characters 13-69
diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.ml b/testsuite/tests/lib-dynlink-initializers/test10_main.ml
new file mode 100644
index 00000000..8dd92a70
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test10_main.ml
@@ -0,0 +1,57 @@
+(* TEST
+
+include dynlink
+
+files = "test10_plugin.ml"
+flags += "-g"
+
+libraries = ""
+
+* no-flambda
+** shared-libraries
+*** setup-ocamlc.byte-build-env
+**** ocamlc.byte
+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"
+***** run
+****** check-program-output
+reference = "${test_source_directory}/test10_main.byte.reference"
+
+*** native-dynlink
+**** setup-ocamlopt.byte-build-env
+***** ocamlopt.byte
+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"
+****** run
+******* check-program-output
+reference = "${test_source_directory}/test10_main.native.reference"
+*)
+
+(* Check that a module in the main program whose initializer has not
+   executed completely cannot be depended upon by a shared library being
+   loaded. *)
+
+let () =
+  Printexc.record_backtrace true;
+  try
+    if Dynlink.is_native then begin
+      Dynlink.loadfile "test10_plugin.cmxs"
+    end else begin
+      Dynlink.loadfile "test10_plugin.cmo"
+    end
+  with
+  | Dynlink.Error (Dynlink.Library's_module_initializers_failed exn) ->
+      Printf.eprintf "Error: %s\n%!" (Printexc.to_string exn);
+      Printexc.print_backtrace stderr
diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference b/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference
new file mode 100755
index 00000000..364eb760
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference
@@ -0,0 +1,14 @@
+Error: Failure("Plugin error")
+Raised at Stdlib.failwith in file "stdlib.ml", line 29, characters 17-33
+Called from Test10_plugin.g in file "test10_plugin.ml", line 2, characters 15-38
+Called from Test10_plugin in file "test10_plugin.ml", line 10, characters 2-6
+Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29
+Called from 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", line 87, characters 10-149
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 344, characters 13-44
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 342, characters 8-240
+Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 352, characters 8-17
+Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 354, characters 26-45
+Called from Test10_main in file "test10_main.ml", line 49, characters 30-87
diff --git a/testsuite/tests/lib-dynlink-initializers/test10_plugin.ml b/testsuite/tests/lib-dynlink-initializers/test10_plugin.ml
new file mode 100644
index 00000000..6e7a3093
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test10_plugin.ml
@@ -0,0 +1,11 @@
+let g () =
+  if true then failwith "Plugin error";
+  print_endline "xxx"
+
+let f () =
+  g ();
+  print_endline "xxx"
+
+let () =
+  f ();
+  print_endline "xxx"
diff --git a/testsuite/tests/lib-dynlink-initializers/test1_inited_second.ml b/testsuite/tests/lib-dynlink-initializers/test1_inited_second.ml
new file mode 100644
index 00000000..bbee32a7
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test1_inited_second.ml
@@ -0,0 +1 @@
+let g x = Test1_main.f x
diff --git a/testsuite/tests/lib-dynlink-initializers/test1_main.ml b/testsuite/tests/lib-dynlink-initializers/test1_main.ml
new file mode 100644
index 00000000..69725e91
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test1_main.ml
@@ -0,0 +1,57 @@
+(* TEST
+
+include dynlink
+
+files = "test1_inited_second.ml test1_plugin.ml"
+
+libraries = ""
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+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"
+**** run
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+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"
+***** run
+*)
+
+(* Check that a module in the main program whose initializer has not
+   executed completely cannot be depended upon by a shared library being
+   loaded. *)
+
+let f x = x + 1 [@@inline never]
+
+let () =
+  try
+    if Dynlink.is_native then begin
+      Dynlink.loadfile "test1_plugin.cmxs"
+    end else begin
+      Dynlink.loadfile "test1_plugin.cmo"
+    end;
+    assert false
+  with
+  | Dynlink.Error (
+      Dynlink.Linking_error (_,
+        Dynlink.Uninitialized_global "Test1_inited_second")) -> ()
diff --git a/testsuite/tests/lib-dynlink-initializers/test1_plugin.ml b/testsuite/tests/lib-dynlink-initializers/test1_plugin.ml
new file mode 100644
index 00000000..6df90f17
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test1_plugin.ml
@@ -0,0 +1,2 @@
+let () =
+  print_int ((Test1_inited_second.g [@inlined never]) 42)
diff --git a/testsuite/tests/lib-dynlink-initializers/test2_inited_first.ml b/testsuite/tests/lib-dynlink-initializers/test2_inited_first.ml
new file mode 100644
index 00000000..1c235048
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test2_inited_first.ml
@@ -0,0 +1 @@
+let f x = x + 1 [@@inline never]
diff --git a/testsuite/tests/lib-dynlink-initializers/test2_main.ml b/testsuite/tests/lib-dynlink-initializers/test2_main.ml
new file mode 100644
index 00000000..06bf8d91
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test2_main.ml
@@ -0,0 +1,50 @@
+(* TEST
+
+include dynlink
+
+files = "test2_inited_first.ml test2_plugin.ml"
+
+libraries = ""
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+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"
+**** run
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+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"
+***** run
+*)
+
+(* Check that a shared library can refer to a module in the main program
+   as long as that module has already been loaded. *)
+
+let g x = Test2_inited_first.f x
+
+let () =
+  if Dynlink.is_native then begin
+    Dynlink.loadfile "test2_plugin.cmxs"
+  end else begin
+    Dynlink.loadfile "test2_plugin.cmo"
+  end
diff --git a/testsuite/tests/lib-dynlink-initializers/test2_plugin.ml b/testsuite/tests/lib-dynlink-initializers/test2_plugin.ml
new file mode 100644
index 00000000..696cc168
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test2_plugin.ml
@@ -0,0 +1,2 @@
+let () =
+  print_int (Test2_inited_first.f 42)
diff --git a/testsuite/tests/lib-dynlink-initializers/test3_main.ml b/testsuite/tests/lib-dynlink-initializers/test3_main.ml
new file mode 100644
index 00000000..2de898cc
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test3_main.ml
@@ -0,0 +1,55 @@
+(* TEST
+
+include dynlink
+
+files = "test3_plugin_a.ml test3_plugin_b.ml"
+
+libraries = ""
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+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"
+**** run
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+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"
+***** run
+*)
+
+(* Check that one module in a shared library can refer to another module
+   in the same shared library as long as the second module has already
+   been loaded. *)
+
+let () =
+  if Dynlink.is_native then begin
+    Dynlink.loadfile "test3_plugin.cmxs"
+  end else begin
+    Dynlink.loadfile "test3_plugin.cma"
+  end
diff --git a/testsuite/tests/lib-dynlink-initializers/test3_plugin_a.ml b/testsuite/tests/lib-dynlink-initializers/test3_plugin_a.ml
new file mode 100644
index 00000000..2f1eb893
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test3_plugin_a.ml
@@ -0,0 +1 @@
+let f x = x + 3 [@@inline never]
diff --git a/testsuite/tests/lib-dynlink-initializers/test3_plugin_b.ml b/testsuite/tests/lib-dynlink-initializers/test3_plugin_b.ml
new file mode 100644
index 00000000..07d83fb9
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test3_plugin_b.ml
@@ -0,0 +1,2 @@
+let () =
+  print_int (Test3_plugin_a.f 42)
diff --git a/testsuite/tests/lib-dynlink-initializers/test4_main.ml b/testsuite/tests/lib-dynlink-initializers/test4_main.ml
new file mode 100644
index 00000000..e3b369b7
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test4_main.ml
@@ -0,0 +1,60 @@
+(* TEST
+
+include dynlink
+
+files = "test4_plugin_a.ml test4_plugin_b.ml"
+
+libraries = ""
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+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"
+**** run
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+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"
+***** 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
new file mode 100644
index 00000000..0341c3bb
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test4_plugin_a.ml
@@ -0,0 +1,2 @@
+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
new file mode 100644
index 00000000..2f1eb893
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test4_plugin_b.ml
@@ -0,0 +1 @@
+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
new file mode 100644
index 00000000..545729ed
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test5_main.ml
@@ -0,0 +1,60 @@
+(* TEST
+
+include dynlink
+
+files = "test5_plugin_a.ml test5_plugin_b.ml test5_second_plugin.ml"
+
+libraries = ""
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+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"
+**** run
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+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"
+***** run
+*)
+
+(* Check that when one shared library loads another shared library then
+   modules of the second shared library can refer to modules of the
+   first shared library, as long as they have already been loaded. *)
+
+let () =
+  if Dynlink.is_native then
+    Dynlink.loadfile "test5_plugin.cmxs"
+  else
+    Dynlink.loadfile "test5_plugin.cma"
diff --git a/testsuite/tests/lib-dynlink-initializers/test5_plugin_a.ml b/testsuite/tests/lib-dynlink-initializers/test5_plugin_a.ml
new file mode 100644
index 00000000..5f65b9e4
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test5_plugin_a.ml
@@ -0,0 +1,4 @@
+let x = ref 0
+
+let () =
+  x := 1
diff --git a/testsuite/tests/lib-dynlink-initializers/test5_plugin_b.ml b/testsuite/tests/lib-dynlink-initializers/test5_plugin_b.ml
new file mode 100644
index 00000000..0813c559
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test5_plugin_b.ml
@@ -0,0 +1,6 @@
+let () =
+  if Dynlink.is_native then begin
+    Dynlink.loadfile "test5_second_plugin.cmxs"
+  end else begin
+    Dynlink.loadfile "test5_second_plugin.cmo"
+  end
diff --git a/testsuite/tests/lib-dynlink-initializers/test5_second_plugin.ml b/testsuite/tests/lib-dynlink-initializers/test5_second_plugin.ml
new file mode 100644
index 00000000..9f1f53f6
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test5_second_plugin.ml
@@ -0,0 +1,2 @@
+let () =
+  assert (!Test5_plugin_a.x = 1)
diff --git a/testsuite/tests/lib-dynlink-initializers/test6_main.ml b/testsuite/tests/lib-dynlink-initializers/test6_main.ml
new file mode 100644
index 00000000..b3c764db
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test6_main.ml
@@ -0,0 +1,50 @@
+(* TEST
+
+include dynlink
+
+files = "test6_plugin.ml test6_second_plugin.ml"
+
+libraries = ""
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+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"
+**** run
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+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"
+***** run
+*)
+
+(* Check that a module in a loaded shared library whose initializer has not
+   executed completely cannot be depended upon by another shared library being
+   loaded. *)
+
+let () =
+  if Dynlink.is_native then
+    Dynlink.loadfile "test6_plugin.cmxs"
+  else
+    Dynlink.loadfile "test6_plugin.cmo"
diff --git a/testsuite/tests/lib-dynlink-initializers/test6_plugin.ml b/testsuite/tests/lib-dynlink-initializers/test6_plugin.ml
new file mode 100644
index 00000000..da785fce
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test6_plugin.ml
@@ -0,0 +1,17 @@
+let x = ref 0
+
+let () =
+  try
+    if Dynlink.is_native then begin
+      Dynlink.loadfile "test6_second_plugin.cmxs"
+    end else begin
+      Dynlink.loadfile "test6_second_plugin.cmo"
+    end;
+    assert false
+  with
+  | Dynlink.Error (
+      Dynlink.Linking_error (_,
+        Dynlink.Uninitialized_global "Test6_plugin")) -> ()
+
+let () =
+  x := 1
diff --git a/testsuite/tests/lib-dynlink-initializers/test6_second_plugin.ml b/testsuite/tests/lib-dynlink-initializers/test6_second_plugin.ml
new file mode 100644
index 00000000..d0104a80
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test6_second_plugin.ml
@@ -0,0 +1,2 @@
+let () =
+  assert (!Test6_plugin.x = 1)
diff --git a/testsuite/tests/lib-dynlink-initializers/test7_interface_only.mli b/testsuite/tests/lib-dynlink-initializers/test7_interface_only.mli
new file mode 100644
index 00000000..23267003
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test7_interface_only.mli
@@ -0,0 +1,2 @@
+
+type t = int
diff --git a/testsuite/tests/lib-dynlink-initializers/test7_main.ml b/testsuite/tests/lib-dynlink-initializers/test7_main.ml
new file mode 100644
index 00000000..d64f8de7
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test7_main.ml
@@ -0,0 +1,49 @@
+(* TEST
+
+include dynlink
+
+files = "test7_interface_only.mli test7_plugin.ml"
+
+libraries = ""
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+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"
+**** run
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+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"
+***** run
+*)
+
+(* Check that a shared library can depend on an interface-only module
+   that is also depended on by modules in the main program *)
+
+let f (x : Test7_interface_only.t) = x + 1 [@@inline never]
+
+let () =
+  if Dynlink.is_native then
+    Dynlink.loadfile "test7_plugin.cmxs"
+  else
+    Dynlink.loadfile "test7_plugin.cmo"
diff --git a/testsuite/tests/lib-dynlink-initializers/test7_plugin.ml b/testsuite/tests/lib-dynlink-initializers/test7_plugin.ml
new file mode 100644
index 00000000..8b95a7e4
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test7_plugin.ml
@@ -0,0 +1,2 @@
+let () =
+  print_int (42 : Test7_interface_only.t)
diff --git a/testsuite/tests/lib-dynlink-initializers/test8_main.ml b/testsuite/tests/lib-dynlink-initializers/test8_main.ml
new file mode 100644
index 00000000..7c556867
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test8_main.ml
@@ -0,0 +1,58 @@
+(* TEST
+
+include dynlink
+
+files = "test8_plugin_a.ml test8_plugin_b.ml test8_plugin_b.mli"
+
+libraries = ""
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+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"
+**** run
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+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"
+***** run
+*)
+
+(* Check that modules of a shared library can have interface-only
+   dependencies to later modules in the same shared library. *)
+
+let () =
+  if Dynlink.is_native then begin
+    Dynlink.loadfile "test8_plugin.cmxs"
+  end else begin
+    Dynlink.loadfile "test8_plugin.cma"
+  end
diff --git a/testsuite/tests/lib-dynlink-initializers/test8_plugin_a.ml b/testsuite/tests/lib-dynlink-initializers/test8_plugin_a.ml
new file mode 100644
index 00000000..e11f804d
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test8_plugin_a.ml
@@ -0,0 +1,4 @@
+let () =
+  print_int (42 : Test8_plugin_b.t)
+
+let f x = x + 3
diff --git a/testsuite/tests/lib-dynlink-initializers/test8_plugin_b.ml b/testsuite/tests/lib-dynlink-initializers/test8_plugin_b.ml
new file mode 100644
index 00000000..2df7d3d1
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test8_plugin_b.ml
@@ -0,0 +1,4 @@
+type t = int
+
+let () =
+  print_int (Test8_plugin_a.f 42)
diff --git a/testsuite/tests/lib-dynlink-initializers/test8_plugin_b.mli b/testsuite/tests/lib-dynlink-initializers/test8_plugin_b.mli
new file mode 100644
index 00000000..23267003
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test8_plugin_b.mli
@@ -0,0 +1,2 @@
+
+type t = int
diff --git a/testsuite/tests/lib-dynlink-initializers/test9_main.ml b/testsuite/tests/lib-dynlink-initializers/test9_main.ml
new file mode 100644
index 00000000..110e2fc4
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test9_main.ml
@@ -0,0 +1,57 @@
+(* TEST
+
+include dynlink
+
+files = "test9_plugin.ml test9_second_plugin.ml test9_second_plugin.mli"
+
+libraries = ""
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+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"
+**** run
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+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"
+***** run
+*)
+
+(* Check that a shared library can depend on an interface-only module
+   that is implemented by another shared library that is loaded
+   later. *)
+
+let () =
+  if Dynlink.is_native then begin
+    Dynlink.loadfile "test9_plugin.cmxs";
+    Dynlink.loadfile "test9_second_plugin.cmxs"
+  end else begin
+    Dynlink.loadfile "test9_plugin.cmo";
+    Dynlink.loadfile "test9_second_plugin.cmo"
+  end
diff --git a/testsuite/tests/lib-dynlink-initializers/test9_plugin.ml b/testsuite/tests/lib-dynlink-initializers/test9_plugin.ml
new file mode 100644
index 00000000..08d86cb2
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test9_plugin.ml
@@ -0,0 +1,2 @@
+let () =
+  print_int (42 : Test9_second_plugin.t)
diff --git a/testsuite/tests/lib-dynlink-initializers/test9_second_plugin.ml b/testsuite/tests/lib-dynlink-initializers/test9_second_plugin.ml
new file mode 100644
index 00000000..c3fee3c8
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test9_second_plugin.ml
@@ -0,0 +1,4 @@
+
+type t = int
+
+let () = print_endline "Second"
diff --git a/testsuite/tests/lib-dynlink-initializers/test9_second_plugin.mli b/testsuite/tests/lib-dynlink-initializers/test9_second_plugin.mli
new file mode 100644
index 00000000..23267003
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-initializers/test9_second_plugin.mli
@@ -0,0 +1,2 @@
+
+type t = int
diff --git a/testsuite/tests/lib-dynlink-native/a.ml b/testsuite/tests/lib-dynlink-native/a.ml
new file mode 100644
index 00000000..b7915822
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/a.ml
@@ -0,0 +1,5 @@
+let x = ref 0
+let u = Random.int 1000
+
+let () =
+  Printf.printf "A is running (%i)\n%!" u
diff --git a/testsuite/tests/lib-dynlink-native/api.ml b/testsuite/tests/lib-dynlink-native/api.ml
new file mode 100644
index 00000000..cd735abe
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/api.ml
@@ -0,0 +1,20 @@
+let mods = ref []
+
+let reg_mod name =
+  if List.mem name !mods then
+    Printf.printf "Reloading module %s\n" name
+  else (
+    mods := name :: !mods;
+    Printf.printf "Registering module %s\n" name
+  )
+
+
+let cbs = ref []
+
+let add_cb f = cbs := f :: !cbs
+let runall () = List.iter (fun f -> f ()) !cbs
+
+(*
+let () =
+  at_exit runall
+*)
diff --git a/testsuite/tests/lib-dynlink-native/b.ml b/testsuite/tests/lib-dynlink-native/b.ml
new file mode 100644
index 00000000..afa1bef0
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/b.ml
@@ -0,0 +1,4 @@
+let () =
+  print_endline "B is running";
+  incr A.x;
+  Printf.printf "A.x = %i\n" !A.x
diff --git a/testsuite/tests/lib-dynlink-native/bug.ml b/testsuite/tests/lib-dynlink-native/bug.ml
new file mode 100644
index 00000000..31c0f025
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/bug.ml
@@ -0,0 +1,2 @@
+let () = try raise (Invalid_argument "X") with Invalid_argument s ->
+  raise (Invalid_argument (s ^ s))
diff --git a/testsuite/tests/lib-dynlink-native/c.ml b/testsuite/tests/lib-dynlink-native/c.ml
new file mode 100644
index 00000000..d4de70f4
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/c.ml
@@ -0,0 +1,4 @@
+let () =
+  print_endline "C is running";
+  incr A.x;
+  Printf.printf "A.x = %i\n" !A.x
diff --git a/testsuite/tests/lib-dynlink-native/factorial.c b/testsuite/tests/lib-dynlink-native/factorial.c
new file mode 100644
index 00000000..8efc4aa5
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/factorial.c
@@ -0,0 +1,33 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*                         Alain Frisch, LexiFi                           */
+/*                                                                        */
+/*   Copyright 2007 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+#include "caml/alloc.h"
+#include <stdio.h>
+
+value factorial(value n){
+  CAMLparam1(n);
+  CAMLlocal1(s);
+
+  static char buf[256];
+  int x = 1;
+  int i;
+  int m = Int_val(n);
+  for (i = 1; i <= m; i++) x *= i;
+  sprintf(buf,"%i",x);
+  s = copy_string(buf);
+  CAMLreturn (s);
+}
diff --git a/testsuite/tests/lib-dynlink-native/main.ml b/testsuite/tests/lib-dynlink-native/main.ml
new file mode 100644
index 00000000..bba07704
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/main.ml
@@ -0,0 +1,245 @@
+(* TEST
+
+files = "a.ml api.ml b.ml bug.ml c.ml factorial.c pack_client.ml \
+         packed1_client.ml packed1.ml plugin2.ml plugin4.ml plugin_ext.ml \
+         plugin_high_arity.ml plugin.ml plugin.mli plugin_ref.ml \
+         plugin_simple.ml plugin_thread.ml"
+
+* hassysthreads
+include systhreads
+include dynlink
+
+set subdir = "${test_source_directory}/sub"
+
+** native-dynlink
+libraries = "" (* We will add them manually where appropriated *)
+*** setup-ocamlopt.byte-build-env
+ocamlopt_default_flags = "" (* Removes the -ccopt -no-pie on ised on OpenBSD *)
+**** script
+script = "mkdir sub"
+***** script
+script = "cp ${subdir}/api.mli ${subdir}/api.ml ${subdir}/plugin3.ml \
+             ${subdir}/plugin.ml sub"
+****** ocamlopt.byte
+module = "api.ml"
+******* ocamlopt.byte
+flags = "-opaque"
+module = "plugin.mli"
+******** ocamlopt.byte
+flags = ""
+module = "plugin.ml"
+********* ocamlopt.byte
+module= ""
+flags = "-shared"
+program = "plugin.so"
+all_modules = "plugin.cmx"
+********** script
+script = "mv plugin.cmx plugin.cmx.bak"
+*********** ocamlopt.byte
+flags = ""
+module = "plugin2.ml"
+************ script
+script = "mv plugin.cmx.bak plugin.cmx"
+************* ocamlopt.byte
+module= ""
+flags = "-shared"
+program = "plugin2.so"
+all_modules = "plugin2.cmx"
+************** ocamlopt.byte
+flags = ""
+module = "sub/plugin.ml"
+*************** ocamlopt.byte
+module = ""
+flags = "-shared"
+program = "sub/plugin.so"
+all_modules = "sub/plugin.cmx"
+**************** cd
+cwd = "sub"
+***************** ocamlopt.byte
+module = "api.mli"
+flags = "-opaque"
+****************** ocamlopt.byte
+flags = ""
+module = "api.ml"
+******************* script
+script = "mv api.cmx api.cmx.bak"
+******************** ocamlopt.byte
+module = "plugin3.ml"
+********************* script
+script = "mv api.cmx.bak api.cmx"
+********************** cd
+cwd = ".."
+*********************** ocamlopt.byte
+module = ""
+flags = "-shared"
+program = "sub/plugin3.so"
+all_modules = "sub/plugin3.cmx"
+************************ ocamlopt.byte
+flags = ""
+module = "plugin4.ml"
+************************* ocamlopt.byte
+module = ""
+flags = "-shared"
+program = "plugin4.so"
+all_modules = "plugin4.cmx"
+************************** ocamlopt.byte
+module = "packed1.ml"
+flags = "-for-pack Mypack"
+*************************** ocamlopt.byte
+flags = "-S -pack"
+module = ""
+program = "mypack.cmx"
+all_modules = "packed1.cmx"
+**************************** ocamlopt.byte
+program = "mypack.so"
+flags = "-shared"
+all_modules = "mypack.cmx"
+***************************** ocamlopt.byte
+program = "packed1.so"
+flags = "-shared"
+all_modules = "packed1.cmx"
+****************************** ocamlopt.byte
+flags = ""
+module = "packed1_client.ml"
+******************************* ocamlopt.byte
+module = ""
+program = "packed1_client.so"
+flags = "-shared"
+all_modules = "packed1_client.cmx"
+******************************** ocamlopt.byte
+flags = ""
+module = "pack_client.ml"
+********************************* ocamlopt.byte
+module = ""
+program = "pack_client.so"
+flags = "-shared"
+all_modules = "pack_client.cmx"
+********************************** ocamlopt.byte
+flags = ""
+module = "plugin_ref.ml"
+*********************************** ocamlopt.byte
+module = ""
+program = "plugin_ref.so"
+flags = "-shared"
+all_modules = "plugin_ref.cmx"
+************************************ ocamlopt.byte
+flags = ""
+module = "plugin_high_arity.ml"
+************************************* ocamlopt.byte
+module = ""
+program = "plugin_high_arity.so"
+flags = "-shared"
+all_modules = "plugin_high_arity.cmx"
+************************************** ocamlopt.byte
+flags = "-ccopt ${shared_library_cflags}"
+module = "factorial.c"
+*************************************** ocamlopt.byte
+flags = ""
+module = "plugin_ext.ml"
+**************************************** ocamlopt.byte
+module = ""
+program = "plugin_ext.so"
+flags = "-shared"
+all_modules = "factorial.${objext} plugin_ext.cmx"
+***************************************** ocamlopt.byte
+module = "plugin_simple.ml"
+flags = ""
+****************************************** ocamlopt.byte
+module = ""
+program = "plugin_simple.so"
+flags = "-shared"
+all_modules = "plugin_simple.cmx"
+****************************************** ocamlopt.byte
+module = "bug.ml"
+flags = ""
+******************************************* ocamlopt.byte
+module = ""
+program = "bug.so"
+flags = "-shared"
+all_modules = "bug.cmx"
+******************************************* ocamlopt.byte
+module = "plugin_thread.ml"
+flags = ""
+******************************************** ocamlopt.byte
+module = ""
+program = "plugin_thread.so"
+flags = "-shared"
+all_modules = "plugin_thread.cmx"
+********************************************* ocamlopt.byte
+program = "plugin4_unix.so"
+all_modules = "unix.cmxa plugin4.cmx"
+********************************************** ocamlopt.byte
+flags = ""
+compile_only = "true"
+all_modules = "a.ml b.ml c.ml main.ml"
+*********************************************** ocamlopt.byte
+module = ""
+compile_only = "false"
+flags = "-shared"
+program = "a.so"
+all_modules = "a.cmx"
+************************************************ ocamlopt.byte
+program = "b.so"
+all_modules = "b.cmx"
+************************************************* ocamlopt.byte
+program = "c.so"
+all_modules = "c.cmx"
+************************************************** ocamlopt.byte
+program = "mylib.cmxa"
+flags = "-a"
+all_modules = "plugin.cmx plugin2.cmx"
+*************************************************** ocamlopt.byte
+program = "mylib.so"
+flags = "-shared -linkall"
+all_modules = "mylib.cmxa"
+**************************************************** ocamlopt.byte
+program = "${test_build_directory}/main.exe"
+libraries = "unix threads dynlink"
+flags = "-linkall"
+all_modules = "api.cmx main.cmx"
+(*
+On OpenBSD, the compiler produces warnings like
+/usr/bin/ld: warning: creating a DT_TEXTREL in a shared object.
+So the compiler output is not empty on OpenBSD so an emptiness check
+would fail on this platform.
+
+We thus do not check compiler output. This was not done either before the
+test was ported to ocamltest.
+*)
+
+***************************************************** run
+arguments = "plugin.so plugin2.so plugin_thread.so"
+****************************************************** check-program-output
+*)
+
+let () =
+  Api.add_cb (fun () -> print_endline "Callback from main")
+
+let ()  =
+  Dynlink.allow_unsafe_modules true;
+  for i = 1 to Array.length Sys.argv - 1 do
+    let name = Sys.argv.(i) in
+    Printf.printf "Loading %s\n" name; flush stdout;
+    try
+      if name.[0] = '-'
+      then Dynlink.loadfile_private
+        (String.sub name 1 (String.length name - 1))
+      else Dynlink.loadfile name
+    with
+      | Dynlink.Error err ->
+          Printf.printf "Dynlink error: %s\n"
+            (Dynlink.error_message err)
+      | exn ->
+          Printf.printf "Error: %s\n" (Printexc.to_string exn)
+  done;
+  flush stdout;
+  try
+    let oc = open_out_bin "marshal.data" in
+    Marshal.to_channel oc !Api.cbs [Marshal.Closures];
+    close_out oc;
+    let ic = open_in_bin "marshal.data" in
+    let l = (Marshal.from_channel ic : (unit -> unit) list) in
+    close_in ic;
+    List.iter (fun f -> f()) l
+  with Failure s ->
+    Printf.printf "Failure: %s\n" s
diff --git a/testsuite/tests/lib-dynlink-native/main.reference b/testsuite/tests/lib-dynlink-native/main.reference
new file mode 100644
index 00000000..e9e4ee45
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/main.reference
@@ -0,0 +1,30 @@
+Loading plugin.so
+Registering module Plugin
+COUCOU
+Loading plugin2.so
+Registering module Plugin2
+1
+2
+6
+1
+XXX
+Loading plugin_thread.so
+Registering module Plugin_thread
+Thread
+Thread
+Thread
+Thread
+Thread
+Thread
+Thread
+Thread
+Thread
+Thread
+Thread
+Thread
+Thread
+Thread
+Thread
+Callback from plugin2
+Callback from plugin
+Callback from main
diff --git a/testsuite/tests/lib-dynlink-native/pack_client.ml b/testsuite/tests/lib-dynlink-native/pack_client.ml
new file mode 100644
index 00000000..90229885
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/pack_client.ml
@@ -0,0 +1,2 @@
+let () =
+  print_endline Mypack.Packed1.mykey
diff --git a/testsuite/tests/lib-dynlink-native/packed1.ml b/testsuite/tests/lib-dynlink-native/packed1.ml
new file mode 100644
index 00000000..2ee83633
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/packed1.ml
@@ -0,0 +1,5 @@
+let () =
+  Api.reg_mod "Packed1"
+
+let bla = Sys.argv.(0) ^ "XXX"
+let mykey = Sys.argv.(0)
diff --git a/testsuite/tests/lib-dynlink-native/packed1_client.ml b/testsuite/tests/lib-dynlink-native/packed1_client.ml
new file mode 100644
index 00000000..c62534fd
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/packed1_client.ml
@@ -0,0 +1,3 @@
+let () =
+  Api.reg_mod "Packed1_client";
+  print_endline Packed1.mykey
diff --git a/testsuite/tests/lib-dynlink-native/plugin.ml b/testsuite/tests/lib-dynlink-native/plugin.ml
new file mode 100644
index 00000000..d9b0574f
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/plugin.ml
@@ -0,0 +1,11 @@
+let rec f x = ignore ([x]); f x
+
+let rec fact n = if n = 0 then 1 else n * fact (n - 1)
+
+let facts = [ fact 1; fact 2; fact 3; fact (Random.int 4) ]
+
+let () =
+  Api.reg_mod "Plugin";
+  Api.add_cb (fun () -> print_endline "Callback from plugin");
+  print_endline "COUCOU";
+  ()
diff --git a/testsuite/tests/lib-dynlink-native/plugin.mli b/testsuite/tests/lib-dynlink-native/plugin.mli
new file mode 100644
index 00000000..3e659d97
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/plugin.mli
@@ -0,0 +1 @@
+val facts: int list
diff --git a/testsuite/tests/lib-dynlink-native/plugin2.ml b/testsuite/tests/lib-dynlink-native/plugin2.ml
new file mode 100644
index 00000000..109c129d
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/plugin2.ml
@@ -0,0 +1,8 @@
+(*external ex: int -> int = "caml_ex"*)
+
+let () =
+  Api.reg_mod "Plugin2";
+  Api.add_cb (fun () -> print_endline "Callback from plugin2");
+(*  let i = ex 3 in*)
+  List.iter (fun i -> Printf.printf "%i\n" i) Plugin.facts;
+  Printf.printf "XXX\n"
diff --git a/testsuite/tests/lib-dynlink-native/plugin4.ml b/testsuite/tests/lib-dynlink-native/plugin4.ml
new file mode 100644
index 00000000..a9f86e60
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/plugin4.ml
@@ -0,0 +1,3 @@
+let () =
+  Printf.printf "time = %f\n" (Unix.time ());
+  Api.reg_mod "Plugin"
diff --git a/testsuite/tests/lib-dynlink-native/plugin_ext.ml b/testsuite/tests/lib-dynlink-native/plugin_ext.ml
new file mode 100644
index 00000000..9906769f
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/plugin_ext.ml
@@ -0,0 +1,5 @@
+external fact: int -> string = "factorial"
+
+let () =
+  Api.reg_mod "plugin_ext";
+  Printf.printf "fact 10 = %s\n" (fact 10)
diff --git a/testsuite/tests/lib-dynlink-native/plugin_high_arity.ml b/testsuite/tests/lib-dynlink-native/plugin_high_arity.ml
new file mode 100644
index 00000000..8c58aa15
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/plugin_high_arity.ml
@@ -0,0 +1,6 @@
+let f x x x x x x x x x x x x x = ()
+
+let g x = f x x x x x x x x
+
+let () =
+  Api.reg_mod "HA"
diff --git a/testsuite/tests/lib-dynlink-native/plugin_ref.ml b/testsuite/tests/lib-dynlink-native/plugin_ref.ml
new file mode 100644
index 00000000..60f12735
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/plugin_ref.ml
@@ -0,0 +1,10 @@
+let x = ref 0
+
+let () =
+  Api.reg_mod "Plugin_ref";
+
+  Api.add_cb
+    (fun () ->
+       Printf.printf "current value for ref = %i\n" !x;
+       incr x
+    )
diff --git a/testsuite/tests/lib-dynlink-native/plugin_simple.ml b/testsuite/tests/lib-dynlink-native/plugin_simple.ml
new file mode 100644
index 00000000..dd7d0226
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/plugin_simple.ml
@@ -0,0 +1,3 @@
+let facts = [ (Random.int 4) ]
+
+let () = print_endline "COUCOU"; print_char '\n'
diff --git a/testsuite/tests/lib-dynlink-native/plugin_thread.ml b/testsuite/tests/lib-dynlink-native/plugin_thread.ml
new file mode 100644
index 00000000..6e3d9d48
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/plugin_thread.ml
@@ -0,0 +1,15 @@
+let () =
+  Api.reg_mod "Plugin_thread";
+  let _t =
+    Thread.create
+      (fun () ->
+         for i = 1 to 5 do
+           print_endline "Thread"; flush stdout;
+           Thread.delay 1.;
+         done
+      ) ()
+  in
+  for i = 1 to 10 do
+    print_endline "Thread"; flush stdout;
+    Thread.delay 0.50;
+  done
diff --git a/testsuite/tests/lib-dynlink-native/sub/api.ml b/testsuite/tests/lib-dynlink-native/sub/api.ml
new file mode 100644
index 00000000..4a60586f
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/sub/api.ml
@@ -0,0 +1,3 @@
+let f i =
+  Printf.printf "Sub/api: f called with %i\n" i;
+  i + 1
diff --git a/testsuite/tests/lib-dynlink-native/sub/api.mli b/testsuite/tests/lib-dynlink-native/sub/api.mli
new file mode 100644
index 00000000..da5e52f2
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/sub/api.mli
@@ -0,0 +1 @@
+val f : int -> int
diff --git a/testsuite/tests/lib-dynlink-native/sub/plugin.ml b/testsuite/tests/lib-dynlink-native/sub/plugin.ml
new file mode 100644
index 00000000..d7faf9c8
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/sub/plugin.ml
@@ -0,0 +1,6 @@
+let rec fact n = if n = 0 then 1 else n * fact (n - 1)
+
+let facts = [ fact 1; fact 2; fact 3; fact 4; fact 5 ]
+
+let () =
+  Api.reg_mod "Plugin'"
diff --git a/testsuite/tests/lib-dynlink-native/sub/plugin3.ml b/testsuite/tests/lib-dynlink-native/sub/plugin3.ml
new file mode 100644
index 00000000..82c9e486
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-native/sub/plugin3.ml
@@ -0,0 +1,2 @@
+let () =
+  ignore (Api.f 10)
diff --git a/testsuite/tests/lib-dynlink-packed/a.ml b/testsuite/tests/lib-dynlink-packed/a.ml
new file mode 100644
index 00000000..c8572c99
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-packed/a.ml
@@ -0,0 +1 @@
+let nums = Sys.opaque_identity [1; 2; 3; 4; 5]
diff --git a/testsuite/tests/lib-dynlink-packed/b.ml b/testsuite/tests/lib-dynlink-packed/b.ml
new file mode 100644
index 00000000..5044f57b
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-packed/b.ml
@@ -0,0 +1 @@
+let () = List.iter (fun i -> print_endline (string_of_int i)) A.nums
diff --git a/testsuite/tests/lib-dynlink-packed/byte.reference b/testsuite/tests/lib-dynlink-packed/byte.reference
new file mode 100644
index 00000000..8a1218a1
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-packed/byte.reference
@@ -0,0 +1,5 @@
+1
+2
+3
+4
+5
diff --git a/testsuite/tests/lib-dynlink-packed/loader.ml b/testsuite/tests/lib-dynlink-packed/loader.ml
new file mode 100644
index 00000000..25b078de
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-packed/loader.ml
@@ -0,0 +1,64 @@
+(* TEST
+
+include dynlink
+libraries = ""
+files = "a.ml b.ml loader.ml"
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+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"
+**** run
+arguments = "packed.cmo"
+exit_status = "0"
+***** check-program-output
+reference = "${test_source_directory}/byte.reference"
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+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"
+***** run
+arguments = "plugin.cmxs"
+exit_status = "0"
+****** check-program-output
+reference = "${test_source_directory}/native.reference"
+*)
+let () =
+  try
+    Dynlink.loadfile Sys.argv.(1)
+  with
+  | Dynlink.Error error ->
+    prerr_endline (Dynlink.error_message error)
diff --git a/testsuite/tests/lib-dynlink-packed/native.reference b/testsuite/tests/lib-dynlink-packed/native.reference
new file mode 100644
index 00000000..8a1218a1
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-packed/native.reference
@@ -0,0 +1,5 @@
+1
+2
+3
+4
+5
diff --git a/testsuite/tests/lib-dynlink-pr4229/abstract.ml b/testsuite/tests/lib-dynlink-pr4229/abstract.ml
new file mode 100644
index 00000000..167565c8
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4229/abstract.ml
@@ -0,0 +1,3 @@
+type t = int
+let print i = Printf.printf "Abstract %i\n" i
+let x = 10
diff --git a/testsuite/tests/lib-dynlink-pr4229/abstract.mli b/testsuite/tests/lib-dynlink-pr4229/abstract.mli
new file mode 100644
index 00000000..d31df8a5
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4229/abstract.mli
@@ -0,0 +1,3 @@
+type t
+val print: t -> unit
+val x: t
diff --git a/testsuite/tests/lib-dynlink-pr4229/client.ml b/testsuite/tests/lib-dynlink-pr4229/client.ml
new file mode 100644
index 00000000..cc0ac86f
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4229/client.ml
@@ -0,0 +1 @@
+let () = Static.f Abstract.x
diff --git a/testsuite/tests/lib-dynlink-pr4229/main.ml b/testsuite/tests/lib-dynlink-pr4229/main.ml
new file mode 100644
index 00000000..8b3bbb5b
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4229/main.ml
@@ -0,0 +1,100 @@
+(* TEST
+
+include dynlink
+
+files = "abstract.mli abstract.ml static.ml client.ml main.ml"
+
+set src_sub = "${test_source_directory}/sub"
+
+libraries = ""
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** script
+script = "mkdir sub"
+**** script
+script = "cp ${src_sub}/abstract.mli ${src_sub}/abstract.ml sub"
+***** cd
+cwd = "sub"
+****** ocamlc.byte
+module = "abstract.mli"
+******* ocamlc.byte
+module = "abstract.ml"
+******** cd
+cwd = ".."
+********* ocamlc.byte
+module = "abstract.mli"
+********** ocamlc.byte
+module = "abstract.ml"
+*********** ocamlc.byte
+module = "static.ml"
+************ ocamlc.byte
+module = "client.ml"
+************* ocamlc.byte
+module = "main.ml"
+************** ocamlc.byte
+program = "${test_build_directory}/main"
+libraries = "dynlink"
+module = ""
+all_modules = "abstract.cmo static.cmo main.cmo"
+*************** run
+exit_status = "2"
+**************** check-program-output
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+**** script
+script = "mkdir sub"
+***** script
+script = "cp ${src_sub}/abstract.mli ${src_sub}/abstract.ml sub"
+****** cd
+cwd = "sub"
+******* ocamlopt.byte
+module = "abstract.mli"
+******** ocamlopt.byte
+program = "abstract.cmxs"
+flags = "-shared"
+module = ""
+all_modules = "abstract.ml"
+********* cd
+cwd = ".."
+********** ocamlopt.byte
+flags = ""
+module = "abstract.mli"
+*********** ocamlopt.byte
+module = "abstract.ml"
+************ 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"
+*************** run
+exit_status = "2"
+**************** check-program-output
+*)
+
+(* PR#4229 *)
+
+let () =
+  let suffix =
+    match Sys.backend_type with
+    | Native -> "cmxs"
+    | Bytecode -> "cmo"
+    | Other _ -> assert false
+  in
+  try
+    (* Dynlink.init (); *)  (* this function has been removed from the API *)
+    Dynlink.loadfile ("client."^suffix); (* utilise abstract.suffix *)
+    Dynlink.loadfile ("sub/abstract."^suffix);
+    Dynlink.loadfile ("client."^suffix) (* utilise sub/abstract.suffix *)
+  with
+  | Dynlink.Error (Dynlink.Module_already_loaded "Abstract") -> exit 2
diff --git a/testsuite/tests/lib-dynlink-pr4229/main.reference b/testsuite/tests/lib-dynlink-pr4229/main.reference
new file mode 100644
index 00000000..81c00b92
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4229/main.reference
@@ -0,0 +1 @@
+Abstract 10
diff --git a/testsuite/tests/lib-dynlink-pr4229/static.ml b/testsuite/tests/lib-dynlink-pr4229/static.ml
new file mode 100644
index 00000000..a30eb133
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4229/static.ml
@@ -0,0 +1 @@
+let f = Abstract.print
diff --git a/testsuite/tests/lib-dynlink-pr4229/sub/abstract.ml b/testsuite/tests/lib-dynlink-pr4229/sub/abstract.ml
new file mode 100644
index 00000000..60e8cbb2
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4229/sub/abstract.ml
@@ -0,0 +1,3 @@
+type t = string
+let print i = Printf.printf "Abstract %s\n" i
+let x = "foo"
diff --git a/testsuite/tests/lib-dynlink-pr4229/sub/abstract.mli b/testsuite/tests/lib-dynlink-pr4229/sub/abstract.mli
new file mode 100644
index 00000000..d31df8a5
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4229/sub/abstract.mli
@@ -0,0 +1,3 @@
+type t
+val print: t -> unit
+val x: t
diff --git a/testsuite/tests/lib-dynlink-pr4839/byte.plugin1.reference b/testsuite/tests/lib-dynlink-pr4839/byte.plugin1.reference
new file mode 100644
index 00000000..2a9b87db
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/byte.plugin1.reference
@@ -0,0 +1,3 @@
+API
+zero=0
+fact (zero+5) = 120
diff --git a/testsuite/tests/lib-dynlink-pr4839/byte.plugin2.reference b/testsuite/tests/lib-dynlink-pr4839/byte.plugin2.reference
new file mode 100644
index 00000000..bd488fc2
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/byte.plugin2.reference
@@ -0,0 +1,2 @@
+API
+ERROR: interface mismatch on Packed
diff --git a/testsuite/tests/lib-dynlink-pr4839/byte.plugin3.reference b/testsuite/tests/lib-dynlink-pr4839/byte.plugin3.reference
new file mode 100644
index 00000000..c79c0cf2
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/byte.plugin3.reference
@@ -0,0 +1,2 @@
+API
+ERROR: The module `Packed' is already loaded (either by the main program or a previously-dynlinked library)
diff --git a/testsuite/tests/lib-dynlink-pr4839/byte.plugin4.reference b/testsuite/tests/lib-dynlink-pr4839/byte.plugin4.reference
new file mode 100644
index 00000000..c79c0cf2
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/byte.plugin4.reference
@@ -0,0 +1,2 @@
+API
+ERROR: The module `Packed' is already loaded (either by the main program or a previously-dynlinked library)
diff --git a/testsuite/tests/lib-dynlink-pr4839/host/api.ml b/testsuite/tests/lib-dynlink-pr4839/host/api.ml
new file mode 100644
index 00000000..cc6ddaa6
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/host/api.ml
@@ -0,0 +1,3 @@
+let fact = ref (fun _ -> assert false)
+let zero = ref (-1)
+let _ = prerr_endline "API"
diff --git a/testsuite/tests/lib-dynlink-pr4839/host/api.mli b/testsuite/tests/lib-dynlink-pr4839/host/api.mli
new file mode 100644
index 00000000..0f9e19b3
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/host/api.mli
@@ -0,0 +1,2 @@
+val fact : (int -> int) ref
+val zero : int ref
diff --git a/testsuite/tests/lib-dynlink-pr4839/host/host.ml b/testsuite/tests/lib-dynlink-pr4839/host/host.ml
new file mode 100644
index 00000000..2dbfb34b
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/host/host.ml
@@ -0,0 +1,8 @@
+let _ =
+  try
+    Dynlink.loadfile Sys.argv.(1);
+    Format.eprintf "zero=%d@." !Packed.Api.zero;
+    Format.eprintf "fact (zero+5) = %d@." (!Packed.Api.fact (!Packed.Api.zero + 5))
+  with
+  | Dynlink.Error e ->
+      Format.eprintf "ERROR: %s@." (Dynlink.error_message e)
diff --git a/testsuite/tests/lib-dynlink-pr4839/native.plugin1.reference b/testsuite/tests/lib-dynlink-pr4839/native.plugin1.reference
new file mode 100644
index 00000000..2a9b87db
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/native.plugin1.reference
@@ -0,0 +1,3 @@
+API
+zero=0
+fact (zero+5) = 120
diff --git a/testsuite/tests/lib-dynlink-pr4839/native.plugin2.reference b/testsuite/tests/lib-dynlink-pr4839/native.plugin2.reference
new file mode 100644
index 00000000..bd488fc2
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/native.plugin2.reference
@@ -0,0 +1,2 @@
+API
+ERROR: interface mismatch on Packed
diff --git a/testsuite/tests/lib-dynlink-pr4839/native.plugin3.reference b/testsuite/tests/lib-dynlink-pr4839/native.plugin3.reference
new file mode 100644
index 00000000..c79c0cf2
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/native.plugin3.reference
@@ -0,0 +1,2 @@
+API
+ERROR: The module `Packed' is already loaded (either by the main program or a previously-dynlinked library)
diff --git a/testsuite/tests/lib-dynlink-pr4839/native.plugin4.reference b/testsuite/tests/lib-dynlink-pr4839/native.plugin4.reference
new file mode 100644
index 00000000..c79c0cf2
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/native.plugin4.reference
@@ -0,0 +1,2 @@
+API
+ERROR: The module `Packed' is already loaded (either by the main program or a previously-dynlinked library)
diff --git a/testsuite/tests/lib-dynlink-pr4839/plugin1/api.ml b/testsuite/tests/lib-dynlink-pr4839/plugin1/api.ml
new file mode 100644
index 00000000..cc6ddaa6
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/plugin1/api.ml
@@ -0,0 +1,3 @@
+let fact = ref (fun _ -> assert false)
+let zero = ref (-1)
+let _ = prerr_endline "API"
diff --git a/testsuite/tests/lib-dynlink-pr4839/plugin1/api.mli b/testsuite/tests/lib-dynlink-pr4839/plugin1/api.mli
new file mode 100644
index 00000000..0f9e19b3
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/plugin1/api.mli
@@ -0,0 +1,2 @@
+val fact : (int -> int) ref
+val zero : int ref
diff --git a/testsuite/tests/lib-dynlink-pr4839/plugin1/plugin.ml b/testsuite/tests/lib-dynlink-pr4839/plugin1/plugin.ml
new file mode 100644
index 00000000..30eedc2e
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/plugin1/plugin.ml
@@ -0,0 +1,7 @@
+let rec fact = function
+  | 0 -> 1
+  | n -> n * fact (n - 1)
+
+let _ =
+  Packed.Api.zero := 0;
+  Packed.Api.fact := fact
diff --git a/testsuite/tests/lib-dynlink-pr4839/plugin2/api.ml b/testsuite/tests/lib-dynlink-pr4839/plugin2/api.ml
new file mode 100644
index 00000000..576ed895
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/plugin2/api.ml
@@ -0,0 +1,3 @@
+let fact = ref None
+let zero = ref (-1)
+let _ = prerr_endline "API"
diff --git a/testsuite/tests/lib-dynlink-pr4839/plugin2/api.mli b/testsuite/tests/lib-dynlink-pr4839/plugin2/api.mli
new file mode 100644
index 00000000..fe30c8e9
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/plugin2/api.mli
@@ -0,0 +1,2 @@
+val fact : (int -> int) option ref
+val zero : int ref
diff --git a/testsuite/tests/lib-dynlink-pr4839/plugin2/plugin.ml b/testsuite/tests/lib-dynlink-pr4839/plugin2/plugin.ml
new file mode 100644
index 00000000..53771da3
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/plugin2/plugin.ml
@@ -0,0 +1,7 @@
+let rec fact = function
+  | 0 -> 1
+  | n -> n * fact (n - 1)
+
+let _ =
+  Packed.Api.zero := 0;
+  Packed.Api.fact := Some fact
diff --git a/testsuite/tests/lib-dynlink-pr4839/plugin3/api.ml b/testsuite/tests/lib-dynlink-pr4839/plugin3/api.ml
new file mode 100644
index 00000000..576ed895
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/plugin3/api.ml
@@ -0,0 +1,3 @@
+let fact = ref None
+let zero = ref (-1)
+let _ = prerr_endline "API"
diff --git a/testsuite/tests/lib-dynlink-pr4839/plugin3/api.mli b/testsuite/tests/lib-dynlink-pr4839/plugin3/api.mli
new file mode 100644
index 00000000..fe30c8e9
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/plugin3/api.mli
@@ -0,0 +1,2 @@
+val fact : (int -> int) option ref
+val zero : int ref
diff --git a/testsuite/tests/lib-dynlink-pr4839/plugin3/plugin.ml b/testsuite/tests/lib-dynlink-pr4839/plugin3/plugin.ml
new file mode 100644
index 00000000..53771da3
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/plugin3/plugin.ml
@@ -0,0 +1,7 @@
+let rec fact = function
+  | 0 -> 1
+  | n -> n * fact (n - 1)
+
+let _ =
+  Packed.Api.zero := 0;
+  Packed.Api.fact := Some fact
diff --git a/testsuite/tests/lib-dynlink-pr4839/plugin4/api.ml b/testsuite/tests/lib-dynlink-pr4839/plugin4/api.ml
new file mode 100644
index 00000000..0138901e
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/plugin4/api.ml
@@ -0,0 +1,3 @@
+let fact = ref (fun _ -> assert false)
+let zero = ref 42
+let _ = prerr_endline "API"
diff --git a/testsuite/tests/lib-dynlink-pr4839/plugin4/api.mli b/testsuite/tests/lib-dynlink-pr4839/plugin4/api.mli
new file mode 100644
index 00000000..0f9e19b3
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/plugin4/api.mli
@@ -0,0 +1,2 @@
+val fact : (int -> int) ref
+val zero : int ref
diff --git a/testsuite/tests/lib-dynlink-pr4839/plugin4/plugin.ml b/testsuite/tests/lib-dynlink-pr4839/plugin4/plugin.ml
new file mode 100644
index 00000000..93682b7a
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/plugin4/plugin.ml
@@ -0,0 +1,7 @@
+let rec fact = function
+  | 0 -> 1
+  | n -> n * fact (n - 1)
+
+let _ =
+  (* Packed.Api.zero := 0; *)
+  Packed.Api.fact := fact
diff --git a/testsuite/tests/lib-dynlink-pr4839/test.ml b/testsuite/tests/lib-dynlink-pr4839/test.ml
new file mode 100644
index 00000000..44522534
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr4839/test.ml
@@ -0,0 +1,261 @@
+(* TEST
+
+include dynlink
+libraries = ""
+set host = "${test_source_directory}/host"
+set plugin1 = "${test_source_directory}/plugin1"
+set plugin2 = "${test_source_directory}/plugin2"
+set plugin3 = "${test_source_directory}/plugin3"
+set plugin4 = "${test_source_directory}/plugin4"
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** script
+script = "mkdir host plugin1 plugin2 plugin3 plugin4"
+*** script
+script = "cp ${host}/host.ml ${host}/api.mli ${host}/api.ml host"
+*** script
+script = "cp ${plugin1}/plugin.ml ${plugin1}/api.mli ${plugin1}/api.ml plugin1"
+*** script
+script = "cp ${plugin2}/plugin.ml ${plugin2}/api.mli ${plugin2}/api.ml plugin2"
+*** script
+script = "cp ${plugin3}/plugin.ml ${plugin3}/api.mli ${plugin3}/api.ml plugin3"
+*** script
+script = "cp ${plugin4}/plugin.ml ${plugin4}/api.mli ${plugin4}/api.ml plugin4"
+
+*** cd
+cwd = "plugin1"
+*** ocamlc.byte
+module = "api.mli"
+*** ocamlc.byte
+flags = "-for-pack Packed"
+module = "api.ml"
+*** ocamlc.byte
+program = "packed.cmo"
+flags = "-pack"
+all_modules = "api.cmo"
+*** ocamlc.byte
+program = "plugin.cma"
+flags = "-a"
+all_modules = "plugin.ml"
+*** cd
+cwd = ".."
+
+*** cd
+cwd = "plugin2"
+*** ocamlc.byte
+module = "api.mli"
+*** ocamlc.byte
+flags = "-for-pack Packed"
+module = "api.ml"
+*** ocamlc.byte
+program = "packed.cmo"
+flags = "-pack"
+all_modules = "api.cmo"
+*** ocamlc.byte
+program = "plugin.cma"
+flags = "-a"
+all_modules = "plugin.ml"
+*** cd
+cwd = ".."
+
+*** cd
+cwd = "plugin3"
+*** ocamlc.byte
+module = "api.mli"
+*** ocamlc.byte
+flags = "-for-pack Packed"
+module = "api.ml"
+*** ocamlc.byte
+program = "packed.cmo"
+flags = "-pack"
+all_modules = "api.cmo"
+*** ocamlc.byte
+program = "plugin.cma"
+flags = "-a"
+all_modules = "packed.cmo plugin.ml"
+*** cd
+cwd = ".."
+
+*** cd
+cwd = "plugin4"
+*** ocamlc.byte
+module = "api.mli"
+*** ocamlc.byte
+flags = "-for-pack Packed"
+module = "api.ml"
+*** ocamlc.byte
+program = "packed.cmo"
+flags = "-pack"
+all_modules = "api.cmo"
+*** ocamlc.byte
+program = "plugin.cma"
+flags = "-a"
+all_modules = "packed.cmo plugin.ml"
+*** cd
+cwd = ".."
+
+*** cd
+cwd = "host"
+*** ocamlc.byte
+module = "api.mli"
+*** ocamlc.byte
+flags = "-for-pack Packed"
+module = "api.ml"
+*** ocamlc.byte
+program = "packed.cmo"
+flags = "-pack"
+all_modules = "api.cmo"
+*** ocamlc.byte
+program = "./host.byt"
+libraries = "dynlink"
+all_modules = "packed.cmo host.ml"
+**** run
+arguments = "../plugin1/plugin.cma"
+output = "byte.plugin1.result"
+***** check-program-output
+reference = "${test_source_directory}/byte.plugin1.reference"
+**** run
+arguments = "../plugin2/plugin.cma"
+output = "byte.plugin2.result"
+***** check-program-output
+reference = "${test_source_directory}/byte.plugin2.reference"
+**** run
+arguments = "../plugin3/plugin.cma"
+output = "byte.plugin3.result"
+***** check-program-output
+reference = "${test_source_directory}/byte.plugin3.reference"
+**** run
+arguments = "../plugin4/plugin.cma"
+output = "byte.plugin4.result"
+***** check-program-output
+reference = "${test_source_directory}/byte.plugin4.reference"
+*** cd
+cwd = ".."
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+
+**** script
+script = "mkdir host plugin1 plugin2 plugin3 plugin4"
+**** script
+script = "cp ${host}/host.ml ${host}/api.mli ${host}/api.ml host"
+**** script
+script = "cp ${plugin1}/plugin.ml ${plugin1}/api.mli ${plugin1}/api.ml plugin1"
+**** script
+script = "cp ${plugin2}/plugin.ml ${plugin2}/api.mli ${plugin2}/api.ml plugin2"
+**** script
+script = "cp ${plugin3}/plugin.ml ${plugin3}/api.mli ${plugin3}/api.ml plugin3"
+**** script
+script = "cp ${plugin4}/plugin.ml ${plugin4}/api.mli ${plugin4}/api.ml plugin4"
+
+**** cd
+cwd = "plugin1"
+**** ocamlopt.byte
+module = "api.mli"
+**** ocamlopt.byte
+flags = "-for-pack Packed"
+module = "api.ml"
+**** ocamlopt.byte
+program = "packed.cmx"
+flags = "-pack"
+all_modules = "api.cmx"
+**** ocamlopt.byte
+program = "plugin.cmxs"
+flags = "-shared"
+all_modules = "plugin.ml"
+**** cd
+cwd = ".."
+
+**** cd
+cwd = "plugin2"
+**** ocamlopt.byte
+module = "api.mli"
+**** ocamlopt.byte
+flags = "-for-pack Packed"
+module = "api.ml"
+**** ocamlopt.byte
+program = "packed.cmx"
+flags = "-pack"
+all_modules = "api.cmx"
+**** ocamlopt.byte
+program = "plugin.cmxs"
+flags = "-shared"
+all_modules = "plugin.ml"
+*** cd
+cwd = ".."
+
+**** cd
+cwd = "plugin3"
+**** ocamlopt.byte
+module = "api.mli"
+**** ocamlopt.byte
+flags = "-for-pack Packed"
+module = "api.ml"
+**** ocamlopt.byte
+program = "packed.cmx"
+flags = "-pack"
+all_modules = "api.cmx"
+**** ocamlopt.byte
+program = "plugin.cmxs"
+flags = "-shared"
+all_modules = "packed.cmx plugin.ml"
+**** cd
+cwd = ".."
+
+**** cd
+cwd = "plugin4"
+**** ocamlopt.byte
+module = "api.mli"
+**** ocamlopt.byte
+flags = "-for-pack Packed"
+module = "api.ml"
+**** ocamlopt.byte
+program = "packed.cmx"
+flags = "-pack"
+all_modules = "api.cmx"
+**** ocamlopt.byte
+program = "plugin.cmxs"
+flags = "-shared"
+all_modules = "packed.cmx plugin.ml"
+**** cd
+cwd = ".."
+
+**** cd
+cwd = "host"
+**** ocamlopt.byte
+module = "api.mli"
+**** ocamlopt.byte
+flags = "-for-pack Packed"
+module = "api.ml"
+**** ocamlopt.byte
+program = "packed.cmx"
+flags = "-pack"
+all_modules = "api.cmx"
+**** ocamlopt.byte
+program = "./host.exe"
+libraries = "dynlink"
+all_modules = "packed.cmx host.ml"
+***** run
+arguments = "../plugin1/plugin.cmxs"
+output = "native.plugin1.result"
+****** check-program-output
+reference = "${test_source_directory}/native.plugin1.reference"
+***** run
+arguments = "../plugin2/plugin.cmxs"
+output = "native.plugin2.result"
+****** check-program-output
+reference = "${test_source_directory}/native.plugin2.reference"
+***** run
+arguments = "../plugin3/plugin.cmxs"
+output = "native.plugin3.result"
+****** check-program-output
+reference = "${test_source_directory}/native.plugin3.reference"
+***** run
+arguments = "../plugin4/plugin.cmxs"
+output = "native.plugin4.result"
+****** check-program-output
+reference = "${test_source_directory}/native.plugin4.reference"
+**** cd
+cwd = ".."
+*)
diff --git a/testsuite/tests/lib-dynlink-pr6950/b.ml b/testsuite/tests/lib-dynlink-pr6950/b.ml
new file mode 100644
index 00000000..86b4fbf6
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr6950/b.ml
@@ -0,0 +1 @@
+let () = Printf.printf "%s\n%s\n" Config.foo Config.bar
diff --git a/testsuite/tests/lib-dynlink-pr6950/byte.reference b/testsuite/tests/lib-dynlink-pr6950/byte.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/lib-dynlink-pr6950/config.ml b/testsuite/tests/lib-dynlink-pr6950/config.ml
new file mode 100644
index 00000000..251a3b43
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr6950/config.ml
@@ -0,0 +1,2 @@
+let foo = "foo"
+let bar = "bar"
diff --git a/testsuite/tests/lib-dynlink-pr6950/loader.ml b/testsuite/tests/lib-dynlink-pr6950/loader.ml
new file mode 100644
index 00000000..ed5c0c25
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr6950/loader.ml
@@ -0,0 +1,48 @@
+(* TEST
+
+include dynlink
+libraries = ""
+files = "config.ml b.ml"
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+program = "plugin.cma"
+flags = "-a"
+all_modules = "config.ml b.ml"
+*** ocamlc.byte
+program = "${test_build_directory}/loader.byte"
+flags = "-linkall"
+include ocamlcommon
+libraries += "dynlink"
+all_modules = "loader.ml"
+**** run
+arguments = "plugin.cma"
+exit_status = "2"
+***** check-program-output
+reference = "${test_source_directory}/byte.reference"
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+program = "plugin.cmxs"
+flags = "-shared"
+all_modules = "config.ml b.ml"
+**** ocamlopt.byte
+program = "${test_build_directory}/loader.exe"
+flags = "-linkall"
+include ocamlcommon
+libraries += "dynlink"
+all_modules = "loader.ml"
+***** run
+arguments = "plugin.cmxs"
+exit_status = "2"
+****** check-program-output
+reference = "${test_source_directory}/native.reference"
+*)
+let () =
+  try
+    Dynlink.loadfile Sys.argv.(1)
+  with
+  | Dynlink.Error (Dynlink.Module_already_loaded "Config") -> exit 2
+  | _ -> exit 1
diff --git a/testsuite/tests/lib-dynlink-pr6950/native.reference b/testsuite/tests/lib-dynlink-pr6950/native.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/lib-dynlink-pr9209/dyn.ml b/testsuite/tests/lib-dynlink-pr9209/dyn.ml
new file mode 100644
index 00000000..6477b719
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr9209/dyn.ml
@@ -0,0 +1,63 @@
+(* TEST
+
+include dynlink
+files = "lib.ml lib2.ml test.c"
+ld_library_path += "${test_build_directory}"
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+compile_only = "true"
+all_modules = "lib.ml lib2.ml test.c dyn.ml"
+**** ocamlmklib
+program = "lib"
+modules = "lib.cmo test.${objext}"
+compile_only = "false"
+***** ocamlc.byte
+program = "lib2.cma"
+libraries = ""
+all_modules = "lib2.cmo"
+compile_only = "false"
+flags = "-a"
+****** ocamlc.byte
+libraries += "dynlink"
+program = "${test_build_directory}/main.exe"
+all_modules = "dyn.cmo"
+flags = ""
+******* run
+output = "main.output"
+******** check-program-output
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+compile_only = "true"
+all_modules = "lib.ml lib2.ml test.c dyn.ml"
+***** ocamlmklib
+program = "test"
+modules = "test.${objext}"
+compile_only = "false"
+****** ocamlopt.byte
+program = "lib.cmxs"
+libraries = ""
+flags = "-shared -cclib -L. -cclib -ltest"
+all_modules = "lib.cmx"
+compile_only = "false"
+******* ocamlopt.byte
+program = "lib2.cmxs"
+all_modules = "lib2.cmx"
+compile_only = "false"
+flags = "-shared"
+******** ocamlopt.byte
+libraries += "dynlink"
+program = "${test_build_directory}/main.exe"
+all_modules = "dyn.cmx"
+flags = ""
+********* run
+output = "main.output"
+********** check-program-output
+*)
+let () =
+  Dynlink.allow_unsafe_modules true;
+  Dynlink.adapt_filename "lib.cma" |> Dynlink.loadfile;
+  Dynlink.adapt_filename "lib2.cma" |> Dynlink.loadfile
diff --git a/testsuite/tests/lib-dynlink-pr9209/lib.ml b/testsuite/tests/lib-dynlink-pr9209/lib.ml
new file mode 100644
index 00000000..ba103759
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr9209/lib.ml
@@ -0,0 +1 @@
+external test : unit -> unit = "testdynfail"
diff --git a/testsuite/tests/lib-dynlink-pr9209/lib2.ml b/testsuite/tests/lib-dynlink-pr9209/lib2.ml
new file mode 100644
index 00000000..fbb23b1f
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr9209/lib2.ml
@@ -0,0 +1 @@
+let test = Lib.test
diff --git a/testsuite/tests/lib-dynlink-pr9209/main.reference b/testsuite/tests/lib-dynlink-pr9209/main.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/lib-dynlink-pr9209/ocamltests b/testsuite/tests/lib-dynlink-pr9209/ocamltests
new file mode 100644
index 00000000..f9f0d72f
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr9209/ocamltests
@@ -0,0 +1 @@
+dyn.ml
diff --git a/testsuite/tests/lib-dynlink-pr9209/test.c b/testsuite/tests/lib-dynlink-pr9209/test.c
new file mode 100644
index 00000000..8603be37
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-pr9209/test.c
@@ -0,0 +1,3 @@
+int testdynfail() {
+  return 0;
+}
diff --git a/testsuite/tests/lib-dynlink-private/pig.mli b/testsuite/tests/lib-dynlink-private/pig.mli
new file mode 100644
index 00000000..795aef97
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/pig.mli
@@ -0,0 +1,4 @@
+type t
+
+val p : t
+val oink : t -> unit
diff --git a/testsuite/tests/lib-dynlink-private/plugin1/sheep.ml b/testsuite/tests/lib-dynlink-private/plugin1/sheep.ml
new file mode 100644
index 00000000..85296894
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin1/sheep.ml
@@ -0,0 +1,4 @@
+type t = int
+
+let s = 42
+let baa _t = () [@@inline never]
diff --git a/testsuite/tests/lib-dynlink-private/plugin1/sheep.mli b/testsuite/tests/lib-dynlink-private/plugin1/sheep.mli
new file mode 100644
index 00000000..faf8d641
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin1/sheep.mli
@@ -0,0 +1,4 @@
+type t
+
+val s : t
+val baa : t -> unit
diff --git a/testsuite/tests/lib-dynlink-private/plugin2/cow.ml b/testsuite/tests/lib-dynlink-private/plugin2/cow.ml
new file mode 100644
index 00000000..a738a303
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin2/cow.ml
@@ -0,0 +1,4 @@
+type t = int
+
+let c = 42
+let moo _t = () [@@inline never]
diff --git a/testsuite/tests/lib-dynlink-private/plugin2/cow.mli b/testsuite/tests/lib-dynlink-private/plugin2/cow.mli
new file mode 100644
index 00000000..11faf4c3
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin2/cow.mli
@@ -0,0 +1,4 @@
+type t
+
+val c : t
+val moo : t -> unit
diff --git a/testsuite/tests/lib-dynlink-private/plugin2b/cow.ml b/testsuite/tests/lib-dynlink-private/plugin2b/cow.ml
new file mode 100644
index 00000000..185ed568
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin2b/cow.ml
@@ -0,0 +1,4 @@
+type t = int
+
+let c = 1
+let moo _t = () [@@inline never]
diff --git a/testsuite/tests/lib-dynlink-private/plugin2b/cow.mli b/testsuite/tests/lib-dynlink-private/plugin2b/cow.mli
new file mode 100644
index 00000000..11faf4c3
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin2b/cow.mli
@@ -0,0 +1,4 @@
+type t
+
+val c : t
+val moo : t -> unit
diff --git a/testsuite/tests/lib-dynlink-private/plugin2c/cow.ml b/testsuite/tests/lib-dynlink-private/plugin2c/cow.ml
new file mode 100644
index 00000000..f6c10d10
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin2c/cow.ml
@@ -0,0 +1,4 @@
+type t = int
+
+let d = 4
+let moo _t = () [@@inline never]
diff --git a/testsuite/tests/lib-dynlink-private/plugin2c/cow.mli b/testsuite/tests/lib-dynlink-private/plugin2c/cow.mli
new file mode 100644
index 00000000..4afb5adc
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin2c/cow.mli
@@ -0,0 +1,4 @@
+type t
+
+val d : t
+val moo : t -> unit
diff --git a/testsuite/tests/lib-dynlink-private/plugin3/pig.ml b/testsuite/tests/lib-dynlink-private/plugin3/pig.ml
new file mode 100644
index 00000000..899a04c6
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin3/pig.ml
@@ -0,0 +1,4 @@
+type t = string
+
+let p = "oink"
+let oink _t = () [@@inline never]
diff --git a/testsuite/tests/lib-dynlink-private/plugin3/pig.mli b/testsuite/tests/lib-dynlink-private/plugin3/pig.mli
new file mode 100644
index 00000000..795aef97
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin3/pig.mli
@@ -0,0 +1,4 @@
+type t
+
+val p : t
+val oink : t -> unit
diff --git a/testsuite/tests/lib-dynlink-private/plugin4/chicken.ml b/testsuite/tests/lib-dynlink-private/plugin4/chicken.ml
new file mode 100644
index 00000000..9b06bdad
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin4/chicken.ml
@@ -0,0 +1,11 @@
+
+(* Test that a privately loaded module can recursively load a module of
+   the same name *)
+let test_chicken () =
+  if Dynlink.is_native then
+    Dynlink.loadfile_private "plugin5/chicken.cmxs"
+  else
+    Dynlink.loadfile_private "plugin5/chicken.cmo"
+
+let () =
+  test_chicken ()
diff --git a/testsuite/tests/lib-dynlink-private/plugin4/chicken.mli b/testsuite/tests/lib-dynlink-private/plugin4/chicken.mli
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/lib-dynlink-private/plugin5/chicken.ml b/testsuite/tests/lib-dynlink-private/plugin5/chicken.ml
new file mode 100644
index 00000000..766e2eb1
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin5/chicken.ml
@@ -0,0 +1,2 @@
+
+let x = 5
diff --git a/testsuite/tests/lib-dynlink-private/plugin5/chicken.mli b/testsuite/tests/lib-dynlink-private/plugin5/chicken.mli
new file mode 100644
index 00000000..b356381d
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin5/chicken.mli
@@ -0,0 +1,2 @@
+
+val x : int
diff --git a/testsuite/tests/lib-dynlink-private/plugin6/partridge.ml b/testsuite/tests/lib-dynlink-private/plugin6/partridge.ml
new file mode 100644
index 00000000..0469149d
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin6/partridge.ml
@@ -0,0 +1 @@
+let wings = 2
diff --git a/testsuite/tests/lib-dynlink-private/plugin6/partridge.mli b/testsuite/tests/lib-dynlink-private/plugin6/partridge.mli
new file mode 100644
index 00000000..62407164
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin6/partridge.mli
@@ -0,0 +1 @@
+val wings : int
diff --git a/testsuite/tests/lib-dynlink-private/plugin6/pheasant.ml b/testsuite/tests/lib-dynlink-private/plugin6/pheasant.ml
new file mode 100644
index 00000000..2adb24dd
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/plugin6/pheasant.ml
@@ -0,0 +1,10 @@
+(* See comment in the main "test.ml" file. *)
+
+let test_pheasant () =
+  if Dynlink.is_native then
+    Dynlink.loadfile "plugin6/partridge.cmxs"
+  else
+    Dynlink.loadfile "plugin6/partridge.cmo"
+
+let () =
+  test_pheasant ()
diff --git a/testsuite/tests/lib-dynlink-private/plugin6/pheasant.mli b/testsuite/tests/lib-dynlink-private/plugin6/pheasant.mli
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/lib-dynlink-private/sheep.ml b/testsuite/tests/lib-dynlink-private/sheep.ml
new file mode 100644
index 00000000..98d0b7ba
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/sheep.ml
@@ -0,0 +1,4 @@
+type t = string
+
+let s = "baa"
+let baa _t = () [@@inline never]
diff --git a/testsuite/tests/lib-dynlink-private/sheep.mli b/testsuite/tests/lib-dynlink-private/sheep.mli
new file mode 100644
index 00000000..faf8d641
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/sheep.mli
@@ -0,0 +1,4 @@
+type t
+
+val s : t
+val baa : t -> unit
diff --git a/testsuite/tests/lib-dynlink-private/test.ml b/testsuite/tests/lib-dynlink-private/test.ml
new file mode 100644
index 00000000..7181c5d1
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-private/test.ml
@@ -0,0 +1,272 @@
+(* TEST
+
+include dynlink
+libraries = ""
+files = "sheep.mli sheep.ml pig.mli"
+set plugin1 = "${test_source_directory}/plugin1"
+set plugin2 = "${test_source_directory}/plugin2"
+set plugin2b = "${test_source_directory}/plugin2b"
+set plugin2c = "${test_source_directory}/plugin2c"
+set plugin3 = "${test_source_directory}/plugin3"
+set plugin4 = "${test_source_directory}/plugin4"
+set plugin5 = "${test_source_directory}/plugin5"
+set plugin6 = "${test_source_directory}/plugin6"
+
+* shared-libraries
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+module = "sheep.mli"
+**** ocamlc.byte
+module = "sheep.ml"
+***** ocamlc.byte
+module = "pig.mli"
+****** ocamlc.byte
+module = "test.ml"
+*** script
+script = "mkdir plugin1 plugin2 plugin2b plugin2c plugin3 plugin4 plugin5 plugin6"
+**** script
+script = "cp ${plugin1}/sheep.mli ${plugin1}/sheep.ml plugin1"
+**** script
+script = "cp ${plugin2}/cow.mli ${plugin2}/cow.ml plugin2"
+**** script
+script = "cp ${plugin2b}/cow.mli ${plugin2b}/cow.ml plugin2b"
+**** script
+script = "cp ${plugin2c}/cow.mli ${plugin2c}/cow.ml plugin2c"
+**** script
+script = "cp ${plugin3}/pig.mli ${plugin3}/pig.ml plugin3"
+**** script
+script = "cp ${plugin4}/chicken.mli ${plugin4}/chicken.ml plugin4"
+**** script
+script = "cp ${plugin5}/chicken.mli ${plugin5}/chicken.ml plugin5"
+**** script
+script = "cp ${plugin6}/pheasant.mli ${plugin6}/pheasant.ml ${plugin6}/partridge.mli ${plugin6}/partridge.ml plugin6"
+***** ocamlc.byte
+module = "plugin1/sheep.mli"
+***** ocamlc.byte
+flags = "-I plugin1"
+module = "plugin1/sheep.ml"
+***** ocamlc.byte
+module = "plugin2/cow.mli"
+***** ocamlc.byte
+flags = "-I plugin2"
+module = "plugin2/cow.ml"
+***** ocamlc.byte
+module = "plugin2b/cow.mli"
+***** ocamlc.byte
+flags = "-I plugin2b"
+module = "plugin2b/cow.ml"
+***** ocamlc.byte
+module = "plugin2c/cow.mli"
+***** ocamlc.byte
+flags = "-I plugin2c"
+module = "plugin2c/cow.ml"
+***** ocamlc.byte
+module = "plugin3/pig.mli"
+***** ocamlc.byte
+flags = "-I plugin3"
+module = "plugin3/pig.ml"
+***** ocamlc.byte
+module = "plugin4/chicken.mli"
+***** ocamlc.byte
+flags = "-I plugin4"
+module = "plugin4/chicken.ml"
+***** ocamlc.byte
+module = "plugin5/chicken.mli"
+***** ocamlc.byte
+flags = "-I plugin5"
+module = "plugin5/chicken.ml"
+***** ocamlc.byte
+module = "plugin6/pheasant.mli"
+***** ocamlc.byte
+flags = "-I plugin6"
+module = "plugin6/pheasant.ml"
+***** ocamlc.byte
+module = "plugin6/partridge.mli"
+***** ocamlc.byte
+flags = "-I plugin6"
+module = "plugin6/partridge.ml"
+***** ocamlc.byte
+program = "${test_build_directory}/test.byte"
+libraries = "dynlink"
+all_modules = "sheep.cmo test.cmo"
+****** run
+
+** native-dynlink
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+module = "sheep.mli"
+***** ocamlopt.byte
+module = "sheep.ml"
+****** ocamlopt.byte
+module = "pig.mli"
+******* ocamlopt.byte
+module = "test.ml"
+**** script
+script = "mkdir plugin1 plugin2 plugin2b plugin2c plugin3 plugin4 plugin5 plugin6"
+***** script
+script = "cp ${plugin1}/sheep.mli ${plugin1}/sheep.ml plugin1"
+***** script
+script = "cp ${plugin2}/cow.mli ${plugin2}/cow.ml plugin2"
+***** script
+script = "cp ${plugin2b}/cow.mli ${plugin2b}/cow.ml plugin2b"
+***** script
+script = "cp ${plugin2c}/cow.mli ${plugin2c}/cow.ml plugin2c"
+***** script
+script = "cp ${plugin3}/pig.mli ${plugin3}/pig.ml plugin3"
+***** script
+script = "cp ${plugin4}/chicken.mli ${plugin4}/chicken.ml plugin4"
+***** script
+script = "cp ${plugin5}/chicken.mli ${plugin5}/chicken.ml plugin5"
+***** script
+script = "cp ${plugin6}/pheasant.mli ${plugin6}/pheasant.ml ${plugin6}/partridge.mli ${plugin6}/partridge.ml plugin6"
+****** ocamlopt.byte
+module = "plugin1/sheep.mli"
+****** ocamlopt.byte
+program = "plugin1/sheep.cmxs"
+flags = "-I plugin1 -shared"
+all_modules = "plugin1/sheep.ml"
+****** ocamlopt.byte
+module = "plugin2/cow.mli"
+****** ocamlopt.byte
+program = "plugin2/cow.cmxs"
+flags = "-I plugin2 -shared"
+all_modules = "plugin2/cow.ml"
+****** ocamlopt.byte
+module = "plugin2b/cow.mli"
+****** ocamlopt.byte
+program = "plugin2b/cow.cmxs"
+flags = "-I plugin2b -shared"
+all_modules = "plugin2b/cow.ml"
+****** ocamlopt.byte
+module = "plugin2c/cow.mli"
+****** ocamlopt.byte
+program = "plugin2c/cow.cmxs"
+flags = "-I plugin2c -shared"
+all_modules = "plugin2c/cow.ml"
+****** ocamlopt.byte
+module = "plugin3/pig.mli"
+****** ocamlopt.byte
+program = "plugin3/pig.cmxs"
+flags = "-I plugin3 -shared"
+all_modules = "plugin3/pig.ml"
+****** ocamlopt.byte
+module = "plugin4/chicken.mli"
+****** ocamlopt.byte
+program = "plugin4/chicken.cmxs"
+flags = "-I plugin4 -shared"
+all_modules = "plugin4/chicken.ml"
+****** ocamlopt.byte
+module = "plugin5/chicken.mli"
+****** ocamlopt.byte
+program = "plugin5/chicken.cmxs"
+flags = "-I plugin5 -shared"
+all_modules = "plugin5/chicken.ml"
+****** ocamlopt.byte
+module = "plugin6/pheasant.mli"
+****** ocamlopt.byte
+program = "plugin6/pheasant.cmxs"
+flags = "-I plugin6 -shared"
+all_modules = "plugin6/pheasant.ml"
+****** ocamlopt.byte
+module = "plugin6/partridge.mli"
+****** ocamlopt.byte
+program = "plugin6/partridge.cmxs"
+flags = "-I plugin6 -shared"
+all_modules = "plugin6/partridge.ml"
+****** ocamlopt.byte
+program = "${test_build_directory}/test.exe"
+libraries = "dynlink"
+all_modules = "sheep.cmx test.cmx"
+******* run
+*)
+
+let () = Sheep.baa Sheep.s (* Use Sheep module *)
+let _ = fun (x : Pig.t) -> x (* Reference Pig module *)
+
+(* Test that a privately loaded module cannot have the same name as a
+   module in the program. *)
+let test_sheep () =
+  match
+    if Dynlink.is_native then
+      Dynlink.loadfile_private "plugin1/sheep.cmxs"
+    else
+      Dynlink.loadfile_private "plugin1/sheep.cmo"
+  with
+  | () -> assert false
+  | exception Dynlink.Error (
+      Dynlink.Module_already_loaded "Sheep") -> ()
+
+(* Test repeated loading of a privately-loaded module. *)
+let test_cow_repeated () =
+  if Dynlink.is_native then
+    Dynlink.loadfile_private "plugin2/cow.cmxs"
+  else
+    Dynlink.loadfile_private "plugin2/cow.cmo"
+
+(* Test that a privately loaded module can have the same name as a
+   previous privately loaded module, in the case where the interfaces are
+   the same, but the implementations differ. *)
+let test_cow_same_name_same_mli () =
+  if Dynlink.is_native then
+    Dynlink.loadfile_private "plugin2b/cow.cmxs"
+  else
+    Dynlink.loadfile_private "plugin2b/cow.cmo"
+
+(* Test that a privately loaded module can have the same name as a
+   previous privately loaded module, in the case where neither the interfaces
+   nor the implementations are the same. *)
+let test_cow_same_name_different_mli () =
+  if Dynlink.is_native then
+    Dynlink.loadfile_private "plugin2c/cow.cmxs"
+  else
+    Dynlink.loadfile_private "plugin2c/cow.cmo"
+
+(* Test that a privately loaded module cannot have the same name as an
+   interface depended on by modules the program. *)
+let test_pig () =
+  match
+    if Dynlink.is_native then
+      Dynlink.loadfile_private "plugin3/pig.cmxs"
+    else
+      Dynlink.loadfile_private "plugin3/pig.cmo"
+  with
+  | () -> assert false
+  | exception Dynlink.Error (
+      Dynlink.Private_library_cannot_implement_interface "Pig") -> ()
+
+(* Test that a privately loaded module can recursively load a module of
+   the same name. *)
+let test_chicken () =
+  if Dynlink.is_native then
+    Dynlink.loadfile_private "plugin4/chicken.cmxs"
+  else
+    Dynlink.loadfile_private "plugin4/chicken.cmo"
+
+(* Test that a public load of a module M inside a privately-loaded module,
+   followed by a public load of M, causes an error. *)
+let test_pheasant () =
+  begin
+    if Dynlink.is_native then
+      Dynlink.loadfile_private "plugin6/pheasant.cmxs"
+    else
+      Dynlink.loadfile_private "plugin6/pheasant.cmo"
+  end;
+  match
+    if Dynlink.is_native then
+      Dynlink.loadfile "plugin6/partridge.cmxs"
+    else
+      Dynlink.loadfile "plugin6/partridge.cmo"
+  with
+  | () -> assert false
+  | exception Dynlink.Error (
+      Dynlink.Module_already_loaded "Partridge") -> ()
+
+let () =
+  test_sheep ();
+  test_cow_repeated ();
+  test_cow_repeated ();
+  test_cow_same_name_same_mli ();
+  test_cow_same_name_different_mli ();
+  test_pig ();
+  test_chicken ();
+  test_pheasant ()
diff --git a/testsuite/tests/lib-filename/extension.ml b/testsuite/tests/lib-filename/extension.ml
new file mode 100644
index 00000000..ae7c8b61
--- /dev/null
+++ b/testsuite/tests/lib-filename/extension.ml
@@ -0,0 +1,17 @@
+(* TEST
+*)
+
+let () =
+  let test f e =
+    assert(Filename.extension f = e);
+    assert(Filename.extension ("foo/" ^ f) = e);
+    assert(f = Filename.remove_extension f ^ Filename.extension f)
+  in
+  test "" "";
+  test "foo" "";
+  test "foo.txt" ".txt";
+  test "foo.txt.gz" ".gz";
+  test ".foo" "";
+  test "." "";
+  test ".." "";
+  test "foo..txt" ".txt"
diff --git a/testsuite/tests/lib-filename/extension.reference b/testsuite/tests/lib-filename/extension.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/lib-filename/myecho.ml b/testsuite/tests/lib-filename/myecho.ml
new file mode 100644
index 00000000..977803f6
--- /dev/null
+++ b/testsuite/tests/lib-filename/myecho.ml
@@ -0,0 +1,20 @@
+open Printf
+
+let () =
+  let argc = Array.length Sys.argv in
+  let out = ref stdout in
+  if argc > 1 then begin
+    for i = 1 to argc - 1 do
+      match Sys.argv.(i) with
+      | "-err" -> flush !out; out := stderr
+      | "-out" -> flush !out; out := stdout
+      | arg    -> fprintf !out "argv[%d] = {|%s|}\n" i arg
+    done
+  end else begin
+    try
+      while true do
+        let l = input_line stdin in
+        printf "%s\n" l
+      done
+    with End_of_file -> ()
+  end
diff --git a/testsuite/tests/lib-filename/null.ml b/testsuite/tests/lib-filename/null.ml
new file mode 100644
index 00000000..048e3662
--- /dev/null
+++ b/testsuite/tests/lib-filename/null.ml
@@ -0,0 +1,8 @@
+(* TEST
+*)
+
+let () =
+  let ic = open_in Filename.null in
+  match input_char ic with
+  | exception End_of_file -> close_in ic
+  | _ -> assert false
diff --git a/testsuite/tests/lib-filename/quotecommand.ml b/testsuite/tests/lib-filename/quotecommand.ml
new file mode 100644
index 00000000..45f53216
--- /dev/null
+++ b/testsuite/tests/lib-filename/quotecommand.ml
@@ -0,0 +1,104 @@
+(* TEST
+
+files = "myecho.ml"
+
+* setup-ocamlc.byte-build-env
+program = "${test_build_directory}/quotecommand.byte"
+** ocamlc.byte
+program = "${test_build_directory}/myecho.exe"
+all_modules = "myecho.ml"
+*** ocamlc.byte
+program = "${test_build_directory}/quotecommand.byte"
+all_modules= "quotecommand.ml"
+**** check-ocamlc.byte-output
+***** run
+****** check-program-output
+
+* setup-ocamlopt.byte-build-env
+program = "${test_build_directory}/quotecommand.opt"
+** ocamlopt.byte
+program = "${test_build_directory}/myecho.exe"
+all_modules = "myecho.ml"
+*** ocamlopt.byte
+include unix
+program = "${test_build_directory}/quotecommand.opt"
+all_modules= "quotecommand.ml"
+**** check-ocamlopt.byte-output
+***** run
+****** check-program-output
+
+*)
+
+open Printf
+
+let copy_channels ic oc =
+  let sz = 1024 in
+  let buf = Bytes.create sz in
+  let rec copy () =
+    let n = input ic buf 0 sz in
+    if n > 0 then (output oc buf 0 n; copy()) in
+  copy()
+
+let copy_file src dst =
+  let ic = open_in_bin src in
+  let oc = open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary]
+                        0o777 dst in
+  copy_channels ic oc;
+  close_in ic;
+  close_out oc
+
+let cat_file f =
+  let ic = open_in f in
+  copy_channels ic stdout;
+  close_in ic
+
+let myecho =
+  Filename.concat Filename.current_dir_name "my echo.exe"
+
+let run ?stdin ?stdout ?stderr args =
+  flush Stdlib.stdout;
+  let rc =
+   Sys.command (Filename.quote_command myecho ?stdin ?stdout ?stderr args) in
+  if rc > 0 then begin
+    printf "!!! my echo failed\n";
+    exit 2
+  end
+
+let _ =
+  copy_file "myecho.exe" "my echo.exe";
+  printf "-------- Spaces\n";
+  run ["Lorem ipsum dolor"; "sit amet,"; "consectetur adipiscing elit,"];
+  printf "-------- All ASCII characters\n";
+  run ["!\"#$%&'()*+,-./";
+       "0123456789";
+       ":;<=>?@";
+       "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+       "[\\]^_`";
+       "abcdefghijklmnopqrstuvwxyz";
+       "{~|~}"
+  ];
+  printf "-------- Output redirection\n";
+  run ~stdout:"my 'file'.tmp" ["sed do eiusmod tempor incididunt";
+                               "ut labore et dolore magna aliqua."];
+  printf "-------- Input redirection\n";
+  run ~stdin:"my 'file'.tmp" [];
+  Sys.remove "my 'file'.tmp";
+  printf "-------- Error redirection\n";
+  run ~stderr:"my 'file'.tmp"
+              ["Exceptur sint"; "-err"; "occaecat"; "cupidatat";
+               "-out"; "non proident"; "-err"; "sunt in culpa"];
+  printf "-- stderr:\n";
+  cat_file "my 'file'.tmp";
+  Sys.remove "my 'file'.tmp";
+  printf "-------- Output and error redirections (different files)\n";
+  run ~stdout:"my stdout.tmp" ~stderr:"my stderr.tmp"
+              ["qui officia"; "-err"; "deserunt"; "mollit";
+               "-out"; "anim id est"; "-err"; "laborum."];
+  printf "-- stdout:\n"; cat_file "my stdout.tmp"; Sys.remove "my stdout.tmp";
+  printf "-- stderr:\n"; cat_file "my stderr.tmp"; Sys.remove "my stderr.tmp";
+  printf "-------- Output and error redirections (same file)\n";
+  run ~stdout:"my file.tmp" ~stderr:"my file.tmp"
+              ["Duis aute"; "irure dolor"; "-err"; "in reprehenderit";
+               "in voluptate"; "-out"; "velit esse cillum"; "-err"; "dolore"];
+  cat_file "my file.tmp"; Sys.remove "my file.tmp";
+  Sys.remove "my echo.exe"
diff --git a/testsuite/tests/lib-filename/quotecommand.reference b/testsuite/tests/lib-filename/quotecommand.reference
new file mode 100644
index 00000000..937c9fe6
--- /dev/null
+++ b/testsuite/tests/lib-filename/quotecommand.reference
@@ -0,0 +1,38 @@
+-------- Spaces
+argv[1] = {|Lorem ipsum dolor|}
+argv[2] = {|sit amet,|}
+argv[3] = {|consectetur adipiscing elit,|}
+-------- All ASCII characters
+argv[1] = {|!"#$%&'()*+,-./|}
+argv[2] = {|0123456789|}
+argv[3] = {|:;<=>?@|}
+argv[4] = {|ABCDEFGHIJKLMNOPQRSTUVWXYZ|}
+argv[5] = {|[\]^_`|}
+argv[6] = {|abcdefghijklmnopqrstuvwxyz|}
+argv[7] = {|{~|~}|}
+-------- Output redirection
+-------- Input redirection
+argv[1] = {|sed do eiusmod tempor incididunt|}
+argv[2] = {|ut labore et dolore magna aliqua.|}
+-------- Error redirection
+argv[1] = {|Exceptur sint|}
+argv[6] = {|non proident|}
+-- stderr:
+argv[3] = {|occaecat|}
+argv[4] = {|cupidatat|}
+argv[8] = {|sunt in culpa|}
+-------- Output and error redirections (different files)
+-- stdout:
+argv[1] = {|qui officia|}
+argv[6] = {|anim id est|}
+-- stderr:
+argv[3] = {|deserunt|}
+argv[4] = {|mollit|}
+argv[8] = {|laborum.|}
+-------- Output and error redirections (same file)
+argv[1] = {|Duis aute|}
+argv[2] = {|irure dolor|}
+argv[4] = {|in reprehenderit|}
+argv[5] = {|in voluptate|}
+argv[7] = {|velit esse cillum|}
+argv[9] = {|dolore|}
diff --git a/testsuite/tests/lib-filename/suffix.ml b/testsuite/tests/lib-filename/suffix.ml
new file mode 100644
index 00000000..3faa5c94
--- /dev/null
+++ b/testsuite/tests/lib-filename/suffix.ml
@@ -0,0 +1,27 @@
+(* TEST
+*)
+
+let () =
+  let test ~suffix name exp =
+    let r1 = Filename.chop_suffix_opt ~suffix name <> None in
+    let r2 = Filename.check_suffix name suffix in
+    assert (r1 = r2);
+    assert (r1 = exp)
+  in
+  let full_test ~suffix name =
+    test ~suffix name true;
+    match Filename.chop_suffix_opt ~suffix name with
+    | None -> assert false
+    | Some base -> assert (base ^ suffix = name)
+  in
+  let win32 = Sys.os_type = "Win32" || Sys.os_type = "Cygwin" in
+  full_test ~suffix:".txt" "foo.txt";
+  full_test ~suffix:"txt" "foo.txt";
+  full_test ~suffix:"" "foo.txt";
+  full_test ~suffix:"" "";
+  test ~suffix:".txt" "f" false;
+  test ~suffix:".txt" "" false;
+  test ~suffix:".txt" "foo.txt.bak" false;
+  test ~suffix:".txt" "foo.TXT" win32;
+  if win32 then
+    assert (Filename.chop_suffix_opt ~suffix:".txt" "foo.TXT" = Some "foo")
diff --git a/testsuite/tests/lib-filename/suffix.reference b/testsuite/tests/lib-filename/suffix.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/lib-float/test.ml b/testsuite/tests/lib-float/test.ml
new file mode 100644
index 00000000..10734a49
--- /dev/null
+++ b/testsuite/tests/lib-float/test.ml
@@ -0,0 +1,119 @@
+(* TEST
+*)
+
+let () =
+  assert(Float.is_finite 1.);
+  assert(Float.is_finite Float.pi);
+  assert(not(Float.is_finite Float.infinity));
+  assert(not(Float.is_finite Float.nan));
+  assert(Float.is_infinite Float.infinity);
+  assert(not(Float.is_infinite 1.));
+  assert(not(Float.is_infinite Float.nan));
+  assert(Float.is_nan Float.nan);
+  assert(not(Float.is_nan 1.));
+  assert(not(Float.is_nan neg_infinity));
+  assert(Float.is_integer 1.);
+  assert(Float.is_integer (-1e10));
+  assert(not(Float.is_integer 1.5));
+  assert(not(Float.is_integer Float.infinity));
+  assert(not(Float.is_integer Float.nan));
+
+  assert(Float.trunc 1.5 = 1.);
+  assert(Float.trunc (-1.5) = -1.);
+  assert(Float.(trunc infinity = infinity));
+  assert(Float.(trunc neg_infinity = neg_infinity));
+  assert(Float.(is_nan(trunc nan)));
+
+  assert(Float.round 0.5 = 1.);
+  assert(Float.round (-0.5) = -1.);
+  assert(Float.round 1.5 = 2.);
+  assert(Float.round (-1.5) = -2.);
+  assert(let x = 0x1.0000000000001p52 in (* x + 0.5 rounds to x +. 1. *)
+         Float.round x = x);
+  assert(Float.round (Float.next_after 0.5 0.) = 0.);
+
+  assert(Float.(round infinity = infinity));
+  assert(Float.(round neg_infinity = neg_infinity));
+  assert(Float.(is_nan(round nan)));
+
+  assert(Float.next_after 0x1.FFFFFFFFFFFFFp-2 1. = 0.5);
+  assert(Float.next_after 0x1.FFFFFFFFFFFFFp-2 0. = 0x1.FFFFFFFFFFFFEp-2);
+  assert(Float.(next_after 0x1.FFFFFFFFFFFFFp-2 infinity = 0.5));
+  assert(Float.(next_after 0x1.FFFFFFFFFFFFFp-2 neg_infinity
+                = 0x1.FFFFFFFFFFFFEp-2));
+  assert(Float.next_after 1. 1. = 1.);
+  assert(Float.(is_nan(next_after nan 1.)));
+  assert(Float.(is_nan(next_after 3. nan)));
+
+  assert(Float.(succ 0x1.FFFFFFFFFFFFFp-2 = 0.5));
+  assert(Float.(pred 0.5 = 0x1.FFFFFFFFFFFFFp-2));
+  assert(Float.(succ 0. > 0.));
+  assert(Float.(pred 0. < 0.));
+  assert(Float.(succ max_float = infinity));
+  assert(Float.(pred (-. max_float) = neg_infinity));
+  assert(Float.(succ 0. < min_float));
+  assert(Float.(succ infinity = infinity));
+  assert(Float.(pred neg_infinity = neg_infinity));
+  assert(Float.(is_nan(succ nan)));
+  assert(Float.(is_nan(pred nan)));
+
+  assert(not(Float.sign_bit 1.));
+  assert(Float.sign_bit (-1.));
+  assert(not(Float.sign_bit 0.));
+  assert(Float.sign_bit (-0.));
+  assert(not(Float.sign_bit infinity));
+  assert(Float.sign_bit neg_infinity);
+
+  assert(Float.min 1. 2. = 1.);
+  assert(Float.min 2. 1. = 1.);
+  assert(Float.(is_nan(min 1. nan)));
+  assert(Float.(is_nan(min nan 2.)));
+  assert(Float.(is_nan(min nan nan)));
+  assert(1. /. Float.min (-0.) (+0.) = neg_infinity);
+  assert(1. /. Float.min (+0.) (-0.) = neg_infinity);
+
+  assert(Float.max 1. 2. = 2.);
+  assert(Float.max 2. 1. = 2.);
+  assert(Float.(is_nan(max 1. nan)));
+  assert(Float.(is_nan(max nan 2.)));
+  assert(Float.(is_nan(max nan nan)));
+  assert(1. /. Float.max (-0.) (+0.) = infinity);
+  assert(1. /. Float.max (+0.) (-0.) = infinity);
+
+  assert(Float.min_max 1. 2. = (1., 2.));
+  assert(Float.min_max 2. 1. = (1., 2.));
+  let is_nan2 (x, y) = Float.is_nan x && Float.is_nan y in
+  assert(Float.(is_nan2(min_max 1. nan)));
+  assert(Float.(is_nan2(min_max nan 2.)));
+  assert(Float.(is_nan2(min_max nan nan)));
+  assert(let x, y = Float.min_max (-0.) (+0.) in
+         1. /. x = neg_infinity && 1. /. y = infinity);
+  assert(let x, y = Float.min_max (+0.) (-0.) in
+         1. /. x = neg_infinity && 1. /. y = infinity);
+
+  assert(Float.min_num 1. 2. = 1.);
+  assert(Float.(min_num 1. nan = 1.));
+  assert(Float.(min_num nan 2. = 2.));
+  assert(Float.(is_nan(min_num nan nan)));
+  assert(1. /. Float.min_num (-0.) (+0.) = neg_infinity);
+  assert(1. /. Float.min_num (+0.) (-0.) = neg_infinity);
+
+  assert(Float.max_num 1. 2. = 2.);
+  assert(Float.(max_num 1. nan = 1.));
+  assert(Float.(max_num nan 2. = 2.));
+  assert(Float.(is_nan(max_num nan nan)));
+  assert(1. /. Float.max_num (-0.) (+0.) = infinity);
+  assert(1. /. Float.max_num (+0.) (-0.) = infinity);
+
+  assert(Float.min_max_num 1. 2. = (1., 2.));
+  assert(Float.min_max_num 2. 1. = (1., 2.));
+  assert(Float.min_max_num 1. nan = (1., 1.));
+  assert(Float.min_max_num nan 1. = (1., 1.));
+  assert(Float.(is_nan2(min_max_num nan nan)));
+  assert(let x, y = Float.min_max_num (-0.) (+0.) in
+         1. /. x = neg_infinity && 1. /. y = infinity);
+  assert(let x, y = Float.min_max_num (+0.) (-0.) in
+         1. /. x = neg_infinity && 1. /. y = infinity);
+;;
+
+let () = print_endline "OK"
diff --git a/testsuite/tests/lib-float/test.reference b/testsuite/tests/lib-float/test.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-float/test.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-floatarray/floatarray.ml b/testsuite/tests/lib-floatarray/floatarray.ml
new file mode 100644
index 00000000..7c0434f7
--- /dev/null
+++ b/testsuite/tests/lib-floatarray/floatarray.ml
@@ -0,0 +1,528 @@
+(* TEST
+*)
+
+open Printf
+
+(* This is the module type of [Float.Array] except type [t] is abstract. *)
+module type S = sig
+  type t
+  val length : t -> int
+  val get : t -> int -> float
+  val set : t -> int -> float -> unit
+  val make : int -> float -> t
+  val create : int -> t
+  val init : int -> (int -> float) -> t
+  val append : t -> t -> t
+  val concat : t list -> t
+  val sub : t -> int -> int -> t
+  val copy : t -> t
+  val fill : t -> int -> int -> float -> unit
+  val blit : t -> int -> t -> int -> int -> unit
+  val to_list : t -> float list
+  val of_list : float list -> t
+  val iter : (float -> unit) -> t -> unit
+  val iteri : (int -> float -> unit) -> t -> unit
+  val map : (float -> float) -> t -> t
+  val mapi : (int -> float -> float) -> t -> t
+  val fold_left : ('a -> float -> 'a) -> 'a -> t -> 'a
+  val fold_right : (float -> 'a -> 'a) -> t -> 'a -> 'a
+  val iter2 : (float -> float -> unit) -> t -> t -> unit
+  val map2 : (float -> float -> float) -> t -> t -> t
+  val for_all : (float -> bool) -> t -> bool
+  val exists : (float -> bool) -> t -> bool
+  val mem : float -> t -> bool
+  val mem_ieee : float -> t -> bool
+  val sort : (float -> float -> int) -> t -> unit
+  val stable_sort : (float -> float -> int) -> t -> unit
+  val fast_sort : (float -> float -> int) -> t -> unit
+  val to_seq : t -> float Seq.t
+  val to_seqi : t -> (int * float) Seq.t
+  val of_seq : float Seq.t -> t
+  val map_to_array : (float -> 'a) -> t -> 'a array
+  val map_from_array : ('a -> float) -> 'a array -> t
+  val unsafe_get : t -> int -> float
+  val unsafe_set : t -> int -> float -> unit
+end
+
+(* module [Array] specialized to [float] and with a few changes,
+   satisfies signature S *)
+module Float_array : S = struct
+  include Stdlib.Array
+  let create = create_float
+  let map_to_array f a = map f a
+  let map_from_array f a = map f a
+  let mem_ieee x a = exists ((=) x) a
+  type t = float array
+end
+
+module Test (A : S) : sig end = struct
+
+  (* auxiliary functions *)
+
+  let neg_zero = 1.0 /. neg_infinity in
+
+  let rec check_i_upto a i =
+    if i >= 0 then begin
+      assert (A.get a i = Float.of_int i);
+      check_i_upto a (i - 1);
+    end
+  in
+
+  let check_i a = check_i_upto a (A.length a - 1) in
+
+  let check_inval f arg =
+    match f arg with
+    | _ -> assert false
+    | exception (Invalid_argument _) -> ()
+    | exception _ -> assert false
+  in
+
+  (* [make] [set] [get] *)
+  let a = A.make 1000 1.0 in
+  for i = 0 to 499 do A.set a i (Float.of_int i) done;
+  let rec loop i =
+    if i >= 0 then begin
+      assert (A.get a i = (if i < 500 then Float.of_int i else 1.0));
+      loop (i - 1);
+    end
+  in loop 999;
+  check_inval (A.get a) (-1);
+  check_inval (A.get a) (1000);
+  check_inval (fun i -> A.set a i 1.0) (-1);
+  check_inval (fun i -> A.set a i 1.0) 1000;
+  check_inval A.create (-1);
+  check_inval A.create (Sys.max_floatarray_length + 1);
+  check_inval (fun i -> A.make i 1.0) (-1);
+  check_inval (fun i -> A.make i 1.0) (Sys.max_floatarray_length + 1);
+
+  (* [length] *)
+  let test_length l = assert (l = (A.length (A.create l))) in
+  test_length 0;
+  test_length 10;
+  test_length 25;
+  test_length 255;
+  test_length 256;
+  test_length 1000;
+  test_length 123456;
+
+  (* [init] *)
+  let a = A.init 1000 Float.of_int in
+  check_i a;
+  check_inval (fun i -> A.init i Float.of_int) (-1);
+  check_inval (fun i -> A.init i Float.of_int) (Sys.max_floatarray_length + 1);
+
+  (* [append] *)
+  let check m n =
+    let a = A.init m Float.of_int in
+    let b = A.init n (fun x -> Float.of_int (x + m)) in
+    let c = A.append a b in
+    assert (A.length c = (m + n));
+    check_i c;
+  in
+  check 0 0;
+  check 0 100;
+  check 1 100;
+  check 100 0;
+  check 100 1;
+  check 100 100;
+  check 1000 1000;
+  (* check_inval omitted *)
+
+  (* [concat] *)
+  let check l =
+    let f (len, acc) n =
+      (len + n, A.init n (fun i -> Float.of_int (len + i)) :: acc)
+    in
+    let (total, ll) = List.fold_left f (0, []) l in
+    let b = A.concat (List.rev ll) in
+    assert (A.length b = total);
+    check_i b;
+  in
+  check [0; 0; 0];
+  check [1; 10; 100];
+  check [10; 0];
+  check [0];
+  check [1000; 1000; 1000];
+  check [];
+  (* check_inval omitted *)
+
+  (* [sub] *)
+  let a = A.init 1000 (fun i -> Float.of_int (i - 100)) in
+  let b = A.sub a 100 200 in
+  check_i b;
+  assert (A.length b = 200);
+  let b = A.sub a 1000 0 in
+  check_i (A.sub a 1000 0);
+  assert  (A.length b = 0);
+  check_inval (A.sub a (-1)) 0;
+  check_inval (A.sub a 0) (-1);
+  check_inval (A.sub a 0) 1001;
+  check_inval (A.sub a 1000) 1;
+
+  (* [copy] *)
+  let check len =
+    let a = A.init len Float.of_int in
+    let b = A.copy a in
+    check_i b;
+    assert (A.length b = len);
+  in
+  check 0;
+  check 1;
+  check 128;
+  check 1023;
+
+  (* [blit] [fill] *)
+  let test_blit_fill data initval ofs len =
+    let a = A.of_list data in
+    let b = A.create (List.length data) in
+    A.blit a 0 b 0 (A.length b);
+    assert (a = b);
+    A.fill b ofs len initval;
+    let rec check i = function
+      | [] -> ()
+      | hd :: tl ->
+          assert (A.get b i = (if i >= ofs && i < ofs + len
+                               then initval else hd));
+          check (i + 1) tl;
+    in
+    check 0 data
+  in
+  test_blit_fill [1.0;2.0;5.0;8.123;-100.456;212e19] 3.1415 3 2;
+  let a = A.create 100 in
+  check_inval (A.fill a (-1) 0) 1.0;
+  check_inval (A.fill a 0 (-1)) 1.0;
+  check_inval (A.fill a 0 101) 1.0;
+  check_inval (A.fill a 100 1) 1.0;
+  check_inval (A.fill a 101 0) 1.0;
+  check_inval (A.blit a (-1) a 0) 0;
+  check_inval (A.blit a 0 a 0) (-1);
+  check_inval (A.blit a 0 a 0) 101;
+  check_inval (A.blit a 100 a 0) 1;
+  check_inval (A.blit a 101 a 0) 0;
+  check_inval (A.blit a 0 a (-1)) 0;
+  check_inval (A.blit a 0 a 100) 1;
+  check_inval (A.blit a 0 a 101) 0;
+
+  (* [to_list] [of_list] *)
+  let a = A.init 1000 Float.of_int in
+  assert (compare a (A.of_list (A.to_list a)) = 0);
+  let a = A.init 0 Float.of_int in
+  assert (compare a (A.of_list (A.to_list a)) = 0);
+  (* check_inval omitted *)
+
+  (* [iter] *)
+  let a = A.init 300 (Float.of_int) in
+  let r = ref 0.0 in
+  A.iter (fun x -> assert (x = !r); r := x +. 1.0) a;
+  A.iter (fun _ -> assert false) (A.create 0);
+  assert (!r = 300.0);
+
+  (* [iteri] *)
+  let a = A.init 300 Float.of_int in
+  let r = ref 0 in
+  let f i x =
+    assert (i = !r);
+    assert (x = Float.of_int i);
+    r := i + 1
+  in
+  A.iteri f a;
+  A.iteri (fun _ _ -> assert false) (A.create 0);
+  assert (!r = 300);
+
+  (* [map], test result and order of evaluation *)
+  let a = A.init 500 Float.of_int in
+  let r = ref 0.0 in
+  let f x =
+    assert (x = !r);
+    r := !r +. 1.0;
+    x -. 1.0
+  in
+  let b = A.map f a in
+  check_i (A.sub b 1 499);
+
+  (* [mapi], test result and order of evaluation *)
+  let a = A.init 500 Float.of_int in
+  let r = ref 0.0 in
+  let f i x =
+    assert (x = Float.of_int i);
+    assert (x = !r);
+    r := !r +. 1.0;
+    x -. 1.0
+  in
+  let b = A.mapi f a in
+  check_i (A.sub b 1 499);
+
+  (* [fold_left], test result and order of evaluation *)
+  let a = A.init 500 Float.of_int in
+  let f acc x =
+    assert (acc = x);
+    x +. 1.0
+  in
+  let acc = A.fold_left f 0.0 a in
+  assert (acc = 500.0);
+
+  (* [fold_right], test result and order of evaluation *)
+  let a = A.init 500 Float.of_int in
+  let f x acc =
+    assert (x = acc -. 1.0);
+    x
+  in
+  let acc = A.fold_right f a 500.0 in
+  assert (acc = 0.0);
+
+  (* [iter2], test result and order of evaluation *)
+  let a = A.init 123 Float.of_int in
+  let b = A.init 123 Float.of_int in
+  let r = ref 0.0 in
+  let f x y =
+    assert (x = !r);
+    assert (y = !r);
+    r := !r +. 1.0;
+  in
+  A.iter2 f a b;
+  let c = A.create 456 in
+  check_inval (A.iter2 (fun _ _ -> assert false) a) c;
+  check_inval (A.iter2 (fun _ _ -> assert false) c) a;
+
+  (* [map2], test result and order of evaluation *)
+  let a = A.init 456 Float.of_int in
+  let b = A.init 456 (fun i -> Float.of_int i /. 2.0) in
+  let r = ref 0.0 in
+  let f x y =
+    assert (x = !r);
+    assert (y = !r /. 2.0);
+    r := !r +. 1.0;
+    2.0 *. (x -. y)
+  in
+  let c = A.map2 f a b in
+  check_i c;
+  let d = A.create 455 in
+  check_inval (A.map2 (fun _ _ -> assert false) a) d;
+  check_inval (A.map2 (fun _ _ -> assert false) d) a;
+
+  (* [for_all], test result and order of evaluation *)
+  let a = A.init 777 Float.of_int in
+  let r = ref 0.0 in
+  let f x =
+    assert (x = !r);
+    r := x +. 1.0;
+    true
+  in
+  assert (A.for_all f a);
+  let f x = assert (x = 0.0); false in
+  assert (not (A.for_all f a));
+
+  (* [exists], test result and order of evaluation *)
+  let a = A.init 777 Float.of_int in
+  let r = ref 0.0 in
+  let f x =
+    assert (x = !r);
+    r := x +. 1.0;
+    false
+  in
+  assert (not (A.exists f a));
+  let f x = assert (x = 0.0); true in
+  assert (A.exists f a);
+
+  (* [mem] *)
+  let a = A.init 7777 Float.of_int in
+  assert (A.mem 0.0 a);
+  assert (A.mem 7776.0 a);
+  assert (not (A.mem (-1.0) a));
+  assert (not (A.mem 7777.0 a));
+  let check v =
+    A.set a 1000 v;
+    assert (A.mem v a);
+  in
+  List.iter check [infinity; neg_infinity; neg_zero; nan];
+
+  (* [mem_ieee] *)
+  let a = A.init 7777 Float.of_int in
+  assert (A.mem_ieee 0.0 a);
+  assert (A.mem_ieee 7776.0 a);
+  assert (not (A.mem_ieee (-1.0) a));
+  assert (not (A.mem_ieee 7777.0 a));
+  let check v =
+    A.set a 1000 v;
+    assert (A.mem_ieee v a);
+  in
+  List.iter check [infinity; neg_infinity; neg_zero];
+  A.set a 0 nan;
+  assert (not (A.mem_ieee nan a));
+
+  (* [sort] [fast_sort] [stable_sort] *)
+  let check_sort sort cmp a =
+    let rec check_sorted a i =
+      if i + 1 < A.length a then begin
+        assert (cmp (A.get a i) (A.get a (i + 1)) <= 0);
+        check_sorted a (i + 1);
+      end
+    in
+    let rec check_permutation a b i =
+      let p = Array.make (A.length a) true in
+      let rec find lo hi x =
+        assert (lo < hi);
+        if hi = lo + 1 then begin
+          assert (cmp (A.get a lo) x = 0);
+          assert (p.(lo));
+          p.(lo) <- false;
+        end else begin
+          let mid = (lo + hi) / 2 in
+          assert (lo < mid && mid < hi);
+          match cmp (A.get a (mid - 1)) x with
+          | 0 when p.(mid - 1) -> find lo mid x
+          | 0 -> find mid hi x
+          | c when c < 0 -> find mid hi x
+          | c when c > 0 -> find lo mid x
+          | _ -> assert false
+        end
+      in
+      A.iter (find 0 (A.length a)) b
+    in
+    let b = A.copy a in
+    sort cmp a;
+    check_sorted a 0;
+    check_permutation a b 0;
+  in
+  Random.init 123;
+  let rand_float _ =
+    match Random.int 1004 with
+    | 1000 -> nan
+    | 1001 -> infinity
+    | 1002 -> neg_infinity
+    | 1003 -> neg_zero
+    | n when n < 500 -> Random.float 1.0
+    | _ -> -. Random.float 1.0
+  in
+  let check s =
+    let a = A.init 5 Float.of_int in
+    check_sort s Stdlib.compare a; (* already sorted *)
+    check_sort s (fun x y -> Stdlib.compare y x) a; (* reverse-sorted *)
+
+    let a = A.of_list [nan; neg_infinity; neg_zero; 0.; infinity] in
+    check_sort s Stdlib.compare a; (* already sorted *)
+    check_sort s (fun x y -> Stdlib.compare y x) a; (* reverse-sorted *)
+
+    let a = A.init 50000 rand_float in
+    check_sort s Stdlib.compare a;
+    let a = A.make 1000 1.0 in
+    check_sort s Stdlib.compare a;
+    let a = A.append (A.make 1000 1.0) (A.make 1000 2.0) in
+    check_sort s Stdlib.compare a;
+  in
+  check A.sort;
+  check A.stable_sort;
+  check A.fast_sort;
+
+  (* [to_seq] *)
+  let check_seq a =
+    let r = ref 0 in
+    let f x =
+      assert (A.get a !r = x);
+      r := !r + 1;
+    in
+    let s = A.to_seq a in
+    Seq.iter f s;
+  in
+  check_seq (A.init 999 Float.of_int);
+  check_seq (A.create 0);
+
+  (* [to_seqi] *)
+  let check_seqi a =
+    let r = ref 0 in
+    let f (i, x) =
+      assert (i = !r);
+      assert (A.get a !r = x);
+      r := !r + 1;
+    in
+    let s = A.to_seqi a in
+    Seq.iter f s;
+  in
+  check_seqi (A.init 999 Float.of_int);
+  check_seqi (A.create 0);
+
+  (* [of_seq] *)
+  let r = ref 0 in
+  let rec f () =
+    if !r = 100 then Seq.Nil else begin
+      let res = Seq.Cons (Float.of_int !r, f) in
+      r := !r + 1;
+      res
+    end
+  in
+  let a = A.of_seq f in
+  assert (a = A.init 100 Float.of_int);
+  assert (A.of_seq Seq.empty = A.create 0);
+
+  (* [map_to_array] *)
+  let r = ref 0 in
+  let f x =
+    assert (x = Float.of_int !r);
+    r := !r + 1;
+    x *. 2.0
+  in
+  let a = A.init 876 Float.of_int in
+  let ar1 = A.map_to_array f a in
+  let ar2 = Array.init 876 (fun x -> Float.of_int (2 * x)) in
+  assert (ar1 = ar2);
+  let ar = A.map_to_array (fun _ -> assert false) (A.create 0) in
+  assert (ar = [| |]);
+
+  (* [map_from_array] *)
+  let r = ref 0 in
+  let f x =
+    assert (x = Float.of_int !r);
+    r := !r + 1;
+    x *. 2.0
+  in
+  let ar = Array.init 876 Float.of_int in
+  let a1 = A.map_from_array f ar in
+  let a2 = A.init 876 (fun x -> Float.of_int (2 * x)) in
+  assert (a1 = a2);
+  let a = A.map_from_array (fun _ -> assert false) [| |] in
+  assert (a = A.create 0);
+
+  (* comparisons *)
+  let normalize_comparison n =
+    if n = 0 then 0 else if n < 0 then -1 else 1
+  in
+  let check c l1 l2 =
+    assert (c = (normalize_comparison (compare (A.of_list l1) (A.of_list l2))))
+  in
+  check 0    [0.0; 0.25; -4.0; 3.141592654; nan]
+             [0.0; 0.25; -4.0; 3.141592654; nan];
+  check (-1) [0.0; 0.25; nan]
+             [0.0; 0.25; 3.14];
+  check (-1) [0.0; 0.25; -4.0]
+             [0.0; 0.25; 3.14159];
+  check 1    [0.0; 2.718; -4.0]
+             [0.0; 0.25; 3.14159];
+  check 1    [0.0; 2.718; -4.0]
+             [nan; 0.25; 3.14159];
+
+  (* [unsafe_get] [unsafe_set] *)
+  let a = A.create 3 in
+  for i = 0 to 2 do A.unsafe_set a i (float i) done;
+  for i = 0 to 2 do assert (A.unsafe_get a i = float i) done;
+
+  (* I/O *)
+  let test_structured_io value =
+    let (tmp, oc) =
+      Filename.open_temp_file ~mode:[Open_binary] "floatarray" ".data"
+    in
+    Marshal.to_channel oc value [];
+    close_out oc;
+    let ic = open_in_bin tmp in
+    let value' = Marshal.from_channel ic in
+    close_in ic;
+    Sys.remove tmp;
+    assert (compare value value' = 0)
+  in
+  let l = [0.; 0.25; -4.; 3.14159265; nan; infinity; neg_infinity; neg_zero] in
+  test_structured_io (A.of_list l);
+
+end
+
+(* We run the same tests on [Float.Array] and [Array]. *)
+module T1 = Test (Stdlib.Float.Array)
+module T2 = Test (Float_array)
diff --git a/testsuite/tests/lib-format/pp_print_custom_break.ml b/testsuite/tests/lib-format/pp_print_custom_break.ml
new file mode 100644
index 00000000..82065a5a
--- /dev/null
+++ b/testsuite/tests/lib-format/pp_print_custom_break.ml
@@ -0,0 +1,64 @@
+(* TEST *)
+
+(*
+
+A test file for Format.pp_print_custom_break.
+
+*)
+let fprintf, printf, list = Format.(fprintf, printf, pp_print_list)
+let string, custom_break = Format.(pp_print_string, pp_print_custom_break)
+
+let () = Format.set_margin 30
+
+let example = [
+  "Foo"; "Baz"; "Bar"; "Qux"; "Quux"; "Quuz"; "Corge"; "Grault"; "Garply";
+]
+
+let boxes = ["v"; "b"; "h"; "hv"; "hov"]
+
+let test format data =
+  boxes |> List.iter (fun box ->
+    printf "## The %S box@\n```@\n@[<%s 0>%a@]@\n```@\n@\n" box box
+      (format box) data);
+
+module Format_list = struct
+  let pp_sep ppf () = fprintf ppf ";@ "
+
+  let format box_type ppf items =
+    fprintf ppf "[@;<0 2>@[<%s>%a@]%t]" box_type
+      (list ~pp_sep string) items
+      (custom_break ~fits:("", 0, "") ~breaks:(";", 0, ""))
+
+  let () =
+    printf "# Printing arrays: last trailing semicolon is optional@\n@\n";
+    test format example
+end
+
+
+module Format_statements = struct
+  let pp_sep ppf () =
+    custom_break ppf ~fits:(";", 1, "") ~breaks:("", 0, "")
+
+  let rec format box_type ppf items =
+    fprintf ppf "{@;<0 2>@[<%s>%a@]@,}" box_type
+      (list ~pp_sep string) items
+
+  let () =
+    printf "# Printing statements: terminator is optional after newline@\n@\n";
+    test format example
+end
+
+
+module Format_function = struct
+  let pp_sep ppf () = fprintf ppf "@ | "
+  let format_case ppf = fprintf ppf "%s -> ()"
+
+  let rec format box_type ppf items =
+    fprintf ppf "@[<%s>function%t%a@]" box_type
+      (custom_break ~fits:("", 1, "") ~breaks:("", 0, "| "))
+      (list ~pp_sep format_case) items
+
+  let () =
+    printf "# Printing function: first pipe character is optional@\n@\n";
+    test format example
+end
diff --git a/testsuite/tests/lib-format/pp_print_custom_break.reference b/testsuite/tests/lib-format/pp_print_custom_break.reference
new file mode 100644
index 00000000..f90f7673
--- /dev/null
+++ b/testsuite/tests/lib-format/pp_print_custom_break.reference
@@ -0,0 +1,159 @@
+# Printing arrays: last trailing semicolon is optional
+
+## The "v" box
+```
+[
+  Foo;
+  Baz;
+  Bar;
+  Qux;
+  Quux;
+  Quuz;
+  Corge;
+  Grault;
+  Garply;
+]
+```
+
+## The "b" box
+```
+[
+  Foo; Baz; Bar; Qux; Quux;
+  Quuz; Corge; Grault; Garply;
+]
+```
+
+## The "h" box
+```
+[Foo; Baz; Bar; Qux; Quux; Quuz; Corge; Grault; Garply]
+```
+
+## The "hv" box
+```
+[
+  Foo;
+  Baz;
+  Bar;
+  Qux;
+  Quux;
+  Quuz;
+  Corge;
+  Grault;
+  Garply;
+]
+```
+
+## The "hov" box
+```
+[
+  Foo; Baz; Bar; Qux; Quux;
+  Quuz; Corge; Grault; Garply;
+]
+```
+
+# Printing statements: terminator is optional after newline
+
+## The "v" box
+```
+{
+  Foo
+  Baz
+  Bar
+  Qux
+  Quux
+  Quuz
+  Corge
+  Grault
+  Garply
+}
+```
+
+## The "b" box
+```
+{
+  Foo; Baz; Bar; Qux; Quux
+  Quuz; Corge; Grault; Garply
+}
+```
+
+## The "h" box
+```
+{Foo; Baz; Bar; Qux; Quux; Quuz; Corge; Grault; Garply}
+```
+
+## The "hv" box
+```
+{
+  Foo
+  Baz
+  Bar
+  Qux
+  Quux
+  Quuz
+  Corge
+  Grault
+  Garply
+}
+```
+
+## The "hov" box
+```
+{
+  Foo; Baz; Bar; Qux; Quux
+  Quuz; Corge; Grault; Garply
+}
+```
+
+# Printing function: first pipe character is optional
+
+## The "v" box
+```
+function
+| Foo -> ()
+| Baz -> ()
+| Bar -> ()
+| Qux -> ()
+| Quux -> ()
+| Quuz -> ()
+| Corge -> ()
+| Grault -> ()
+| Garply -> ()
+```
+
+## The "b" box
+```
+function Foo -> ()
+| Baz -> () | Bar -> ()
+| Qux -> () | Quux -> ()
+| Quuz -> () | Corge -> ()
+| Grault -> () | Garply -> ()
+```
+
+## The "h" box
+```
+function Foo -> () | Baz -> () | Bar -> () | Qux -> () | Quux -> () | Quuz -> () | Corge -> () | Grault -> () | Garply -> ()
+```
+
+## The "hv" box
+```
+function
+| Foo -> ()
+| Baz -> ()
+| Bar -> ()
+| Qux -> ()
+| Quux -> ()
+| Quuz -> ()
+| Corge -> ()
+| Grault -> ()
+| Garply -> ()
+```
+
+## The "hov" box
+```
+function Foo -> ()
+| Baz -> () | Bar -> ()
+| Qux -> () | Quux -> ()
+| Quuz -> () | Corge -> ()
+| Grault -> () | Garply -> ()
+```
+
diff --git a/testsuite/tests/lib-format/pr6824.ml b/testsuite/tests/lib-format/pr6824.ml
new file mode 100644
index 00000000..7dc92083
--- /dev/null
+++ b/testsuite/tests/lib-format/pr6824.ml
@@ -0,0 +1,11 @@
+(* TEST
+   include testing
+*)
+
+let f = Format.sprintf "[%i]";;
+print_endline (f 1);;
+print_endline (f 2);;
+
+let f = Format.asprintf "[%i]";;
+print_endline (f 1);;
+print_endline (f 2);;
diff --git a/testsuite/tests/lib-format/pr6824.reference b/testsuite/tests/lib-format/pr6824.reference
new file mode 100644
index 00000000..69035c76
--- /dev/null
+++ b/testsuite/tests/lib-format/pr6824.reference
@@ -0,0 +1,6 @@
+[1]
+[2]
+[1]
+[2]
+
+All tests succeeded.
diff --git a/testsuite/tests/lib-format/print_if_newline.ml b/testsuite/tests/lib-format/print_if_newline.ml
new file mode 100644
index 00000000..31c42b02
--- /dev/null
+++ b/testsuite/tests/lib-format/print_if_newline.ml
@@ -0,0 +1,26 @@
+(* TEST *)
+
+(*
+
+A test file for Format.print_if_newline.
+
+*)
+
+open Format;;
+
+printf "\ntest print_if_newline\n%!";
+printf "  newline here\n%!";
+print_if_newline ();
+printf "  this gets printed";
+print_if_newline ();
+printf "  this doesn't get printed";
+
+printf "\nprint_if_newline doesn't crash when last statement\n%!";
+printf "  newline here\n";
+(* Important that the following is the last statement in the file.
+
+   [print_if_newline] sets up the Format module to skip printing
+   the next printing command. However, it should not crash if there
+   is no next printing statement. *)
+print_if_newline ();
+;;
diff --git a/testsuite/tests/lib-format/print_if_newline.reference b/testsuite/tests/lib-format/print_if_newline.reference
new file mode 100644
index 00000000..df810718
--- /dev/null
+++ b/testsuite/tests/lib-format/print_if_newline.reference
@@ -0,0 +1,6 @@
+
+test print_if_newline
+  newline here
+  this gets printed
+print_if_newline doesn't crash when last statement
+  newline here
diff --git a/testsuite/tests/lib-format/tformat.ml b/testsuite/tests/lib-format/tformat.ml
new file mode 100644
index 00000000..83250aa5
--- /dev/null
+++ b/testsuite/tests/lib-format/tformat.ml
@@ -0,0 +1,541 @@
+(* TEST
+   include testing
+*)
+
+(*
+
+A test file for the Format module.
+
+*)
+
+open Testing;;
+open Format;;
+
+let say s = Printf.printf s;;
+
+try
+
+  say "d/i positive\n%!";
+  test (sprintf "%d/%i" 42 43 = "42/43");
+  test (sprintf "%-4d/%-5i" 42 43 = "42  /43   ");
+  test (sprintf "%04d/%05i" 42 43 = "0042/00043");
+  test (sprintf "%+d/%+i" 42 43 = "+42/+43");
+  test (sprintf "% d/% i" 42 43 = " 42/ 43");
+  test (sprintf "%#d/%#i" 42 43 = "42/43");
+  test (sprintf "%4d/%5i" 42 43 = "  42/   43");
+  test (sprintf "%*d" (-4) 42 = "42  ");
+  test (sprintf "%*d/%*i" 4 42 5 43 = "  42/   43");
+  test (sprintf "%-0+#4d/%-0 #5i" 42 43 = "+42 / 43  ");
+
+  say "\nd/i negative\n%!";
+  test (sprintf "%d/%i" (-42) (-43) = "-42/-43");
+  test (sprintf "%-4d/%-5i" (-42) (-43) = "-42 /-43  ");
+  test (sprintf "%04d/%05i" (-42) (-43) = "-042/-0043");
+  test (sprintf "%+d/%+i" (-42) (-43) = "-42/-43");
+  test (sprintf "% d/% i" (-42) (-43) = "-42/-43");
+  test (sprintf "%#d/%#i" (-42) (-43) = "-42/-43");
+  test (sprintf "%4d/%5i" (-42) (-43) = " -42/  -43");
+  test (sprintf "%*d" (-4) (-42) = "-42 ");
+  test (sprintf "%*d/%*i" 4 (-42) 5 (-43) = " -42/  -43");
+  test (sprintf "%-0+ #4d/%-0+ #5i" (-42) (-43) = "-42 /-43  ");
+
+  say "\nu positive\n%!";
+  test (sprintf "%u" 42 = "42");
+  test (sprintf "%-4u" 42 = "42  ");
+  test (sprintf "%04u" 42 = "0042");
+  test (sprintf "%+u" 42 = "42");
+  test (sprintf "% u" 42 = "42");
+  test (sprintf "%#u" 42 = "42");
+  test (sprintf "%4u" 42 = "  42");
+  test (sprintf "%*u" 4 42 = "  42");
+  test (sprintf "%*u" (-4) 42 = "42  ");
+
+  say "\nu negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%u" (-1) = "2147483647");
+  | 64 ->
+     test (sprintf "%u" (-1) = "9223372036854775807");
+  | _ -> test false
+  end;
+
+  say "\nx positive\n%!";
+  test (sprintf "%x" 42 = "2a");
+  test (sprintf "%-4x" 42 = "2a  ");
+  test (sprintf "%04x" 42 = "002a");
+  test (sprintf "%+x" 42 = "2a");
+  test (sprintf "% x" 42 = "2a");
+  test (sprintf "%#x" 42 = "0x2a");
+  test (sprintf "%4x" 42 = "  2a");
+  test (sprintf "%*x" 5 42 = "   2a");
+  test (sprintf "%*x" (-5) 42 = "2a   ");
+  test (sprintf "%#*x" 5 42 = " 0x2a");
+  test (sprintf "%#*x" (-5) 42 = "0x2a ");
+  test (sprintf "%#-*x" 5 42 = "0x2a ");
+  test (sprintf "%-0+ #*x" 5 42 = "0x2a ");
+
+  say "\nx negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%x" (-42) = "7fffffd6");
+  | 64 ->
+     test (sprintf "%x" (-42) = "7fffffffffffffd6");
+  | _ -> test false
+  end;
+
+  say "\nX positive\n%!";
+  test (sprintf "%X" 42 = "2A");
+  test (sprintf "%-4X" 42 = "2A  ");
+  test (sprintf "%04X" 42 = "002A");
+  test (sprintf "%+X" 42 = "2A");
+  test (sprintf "% X" 42 = "2A");
+  test (sprintf "%#X" 42 = "0X2A");
+  test (sprintf "%4X" 42 = "  2A");
+  test (sprintf "%*X" 5 42 = "   2A");
+  test (sprintf "%-0+ #*X" 5 42 = "0X2A ");
+
+  say "\nx negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%X" (-42) = "7FFFFFD6");
+  | 64 ->
+     test (sprintf "%X" (-42) = "7FFFFFFFFFFFFFD6");
+  | _ -> test false
+  end;
+
+  say "\no positive\n%!";
+  test (sprintf "%o" 42 = "52");
+  test (sprintf "%-4o" 42 = "52  ");
+  test (sprintf "%04o" 42 = "0052");
+  test (sprintf "%+o" 42 = "52");
+  test (sprintf "% o" 42 = "52");
+  test (sprintf "%#o" 42 = "052");
+  test (sprintf "%4o" 42 = "  52");
+  test (sprintf "%*o" 5 42 = "   52");
+  test (sprintf "%-0+ #*o" 5 42 = "052  ");
+
+  say "\no negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%o" (-42) = "17777777726");
+  | 64 ->
+     test (sprintf "%o" (-42) = "777777777777777777726");
+  | _ -> test false
+  end;
+
+  say "\ns\n%!";
+  test (sprintf "%s" "foo" = "foo");
+  test (sprintf "%-5s" "foo" = "foo  ");
+  test (sprintf "%05s" "foo" = "  foo");
+  test (sprintf "%+s" "foo" = "foo");
+  test (sprintf "% s" "foo" = "foo");
+  test (sprintf "%#s" "foo" = "foo");
+  test (sprintf "%5s" "foo" = "  foo");
+  test (sprintf "%1s" "foo" = "foo");
+  test (sprintf "%*s" 6 "foo" = "   foo");
+  test (sprintf "%*s" (-6) "foo" = "foo   ");
+  test (sprintf "%*s" 2 "foo" = "foo");
+  test (sprintf "%-0+ #5s" "foo" = "foo  ");
+  test (sprintf "%s@@" "foo" = "foo@");
+  test (sprintf "%s@@inria.fr" "foo" = "foo@inria.fr");
+  test (sprintf "%s@@%s" "foo" "inria.fr" = "foo@inria.fr");
+
+  say "\nS\n%!";
+  test (sprintf "%S" "fo\"o" = "\"fo\\\"o\"");
+  test (sprintf "%-7S" "foo" = "\"foo\"  ");
+(*  test (sprintf "%07S" "foo" = "  \"foo\""); *)
+  (* %S is incompatible with '0' *)
+  test (sprintf "%+S" "foo" = "\"foo\"");
+  test (sprintf "% S" "foo" = "\"foo\"");
+  test (sprintf "%#S" "foo" = "\"foo\"");
+  test (sprintf "%7S" "foo" = "  \"foo\"");
+  test (sprintf "%1S" "foo" = "\"foo\"");
+  test (sprintf "%*S" 8 "foo" = "   \"foo\"");
+  test (sprintf "%*S" (-8) "foo" = "\"foo\"   ");
+  test (sprintf "%*S" 2 "foo" = "\"foo\"");
+(*  test (sprintf "%-0+ #5S" "foo" = "\"foo\"  ");  padding not done *)
+  (* %S is incompatible with '0','+' and ' ' *)
+  test (sprintf "%S@@" "foo" = "\"foo\"@");
+  test (sprintf "%S@@inria.fr" "foo" = "\"foo\"@inria.fr");
+  test (sprintf "%S@@%S" "foo" "inria.fr" = "\"foo\"@\"inria.fr\"");
+
+  say "\nc\n%!";
+  test (sprintf "%c" 'c' = "c");
+(*  test (sprintf "%-4c" 'c' = "c   ");    padding not done *)
+(*  test (sprintf "%04c" 'c' = "   c");    padding not done *)
+  test (sprintf "%+c" 'c' = "c");
+  test (sprintf "% c" 'c' = "c");
+  test (sprintf "%#c" 'c' = "c");
+(*  test (sprintf "%4c" 'c' = "   c");     padding not done *)
+(*  test (sprintf "%*c" 2 'c' = " c");     padding not done *)
+(*  test (sprintf "%-0+ #4c" 'c' = "c   ");  padding not done *)
+
+  say "\nC\n%!";
+  test (sprintf "%C" 'c' = "'c'");
+  test (sprintf "%C" '\'' = "'\\''");
+(*  test (sprintf "%-4C" 'c' = "c   ");    padding not done *)
+(*  test (sprintf "%04C" 'c' = "   c");    padding not done *)
+  test (sprintf "%+C" 'c' = "'c'");
+  test (sprintf "% C" 'c' = "'c'");
+  test (sprintf "%#C" 'c' = "'c'");
+(*  test (sprintf "%4C" 'c' = "   c");     padding not done *)
+(*  test (sprintf "%*C" 2 'c' = " c");     padding not done *)
+(*  test (sprintf "%-0+ #4C" 'c' = "c   ");  padding not done *)
+
+  say "\nf\n%!";
+  test (sprintf "%f" (-42.42) = "-42.420000");
+  test (sprintf "%-13f" (-42.42) = "-42.420000   ");
+  test (sprintf "%013f" (-42.42) = "-00042.420000");
+  test (sprintf "%+f" 42.42 = "+42.420000");
+  test (sprintf "% f" 42.42 = " 42.420000");
+  test (sprintf "%#f" 42.42 = "42.420000");
+  test (sprintf "%13f" 42.42 = "    42.420000");
+  test (sprintf "%*f" 12 42.42 = "   42.420000");
+  test (sprintf "%-0+ #12f" 42.42 = "+42.420000  ");
+  test (sprintf "%.3f" (-42.42) = "-42.420");
+  test (sprintf "%-13.3f" (-42.42) = "-42.420      ");
+  test (sprintf "%013.3f" (-42.42) = "-00000042.420");
+  test (sprintf "%+.3f" 42.42 = "+42.420");
+  test (sprintf "% .3f" 42.42 = " 42.420");
+  test (sprintf "%#.3f" 42.42 = "42.420");
+  test (sprintf "%13.3f" 42.42 = "       42.420");
+  test (sprintf "%*.*f" 12 3 42.42 = "      42.420");
+  test (sprintf "%-0+ #12.3f" 42.42 = "+42.420     ");
+
+  (* Under Windows (mingw and maybe also MSVC), the stdlib uses three
+     digits for the exponent instead of the two used by Linux and BSD.
+     Check that the two strings are equal, except that there may be an
+     extra zero, and if there is one, there may be a missing space or
+     zero. All in the first string relative to the second. *)
+  let ( =* ) s1 s2 =
+    let ss1 = s1 ^ "$" in
+    let ss2 = s2 ^ "$" in
+    let rec loop i1 i2 extra missing =
+      if i1 = String.length ss1 && i2 = String.length ss2 then begin
+        if extra then true else not missing
+      end else if i1 = String.length ss1 || i2 = String.length ss2 then
+        false
+      else begin
+        match ss1.[i1], ss2.[i2] with
+        | x, y when x = y -> loop (i1+1) (i2+1) extra missing
+        | '0', _ when not extra -> loop (i1+1) i2 true missing
+        | _, (' '|'0') when not missing -> loop i1 (i2+1) extra true
+        | _, _ -> false
+      end
+    in
+    loop 0 0 false false
+  in
+
+  say "\nF\n%!";
+  test (sprintf "%F" 42.42 = "42.42");
+  test (sprintf "%F" 42.42e42 =* "4.242e+43");
+  test (sprintf "%F" 42.00 = "42.");
+  test (sprintf "%F" 0.042 = "0.042");
+  test (sprintf "%4F" 3. = "  3.");
+  test (sprintf "%-4F" 3. = "3.  ");
+  test (sprintf "%04F" 3. = "003.");
+(* plus-padding unsupported
+  test (sprintf "%+4F" 3. = " +3.");
+*)
+(* no precision
+  test (sprintf "%.3F" 42.42 = "42.420");
+  test (sprintf "%12.3F" 42.42e42 = "   4.242e+43");
+  test (sprintf "%.3F" 42.00 = "42.000");
+  test (sprintf "%.3F" 0.0042 = "0.004");
+*)
+
+  say "\nh\n%!";
+  test (sprintf "%+h" (+0.) = "+0x0p+0");
+  test (sprintf "%+h" (-0.) = "-0x0p+0");
+  test (sprintf "%+h" (+1.) = "+0x1p+0");
+  test (sprintf "%+h" (-1.) = "-0x1p+0");
+  test (sprintf "%+h" (+1024.) = "+0x1p+10");
+  test (sprintf "%+h" (-1024.) = "-0x1p+10");
+  test (sprintf "%h" 0x123.456 = "0x1.23456p+8");
+  test (sprintf "%h" 0x123456789ABCDE. = "0x1.23456789abcdep+52");
+  test (sprintf "%h" epsilon_float = "0x1p-52");
+  test (sprintf "%h" nan = "nan");
+  test (sprintf "%h" infinity = "infinity");
+  test (sprintf "%h" neg_infinity = "-infinity");
+  test (sprintf "%h" (4. *. atan 1.) = "0x1.921fb54442d18p+1");
+
+  say "\nH\n%!";
+  test (sprintf "%+H" (+0.) = "+0X0P+0");
+  test (sprintf "%+H" (-0.) = "-0X0P+0");
+  test (sprintf "%+H" (+1.) = "+0X1P+0");
+  test (sprintf "%+H" (-1.) = "-0X1P+0");
+  test (sprintf "%+H" (+1024.) = "+0X1P+10");
+  test (sprintf "%+H" (-1024.) = "-0X1P+10");
+  test (sprintf "%H" 0X123.456 = "0X1.23456P+8");
+  test (sprintf "%H" 0X123456789ABCDE. = "0X1.23456789ABCDEP+52");
+  test (sprintf "%H" epsilon_float = "0X1P-52");
+  test (sprintf "%H" nan = "NAN");
+  test (sprintf "%H" infinity = "INFINITY");
+  test (sprintf "%H" neg_infinity = "-INFINITY");
+  test (sprintf "%H" (4. *. atan 1.) = "0X1.921FB54442D18P+1");
+
+  say "\ne\n%!";
+  test (sprintf "%e" (-42.42) =* "-4.242000e+01");
+  test (sprintf "%-15e" (-42.42) =* "-4.242000e+01  ");
+  test (sprintf "%015e" (-42.42) =* "-004.242000e+01");
+  test (sprintf "%+e" 42.42 =* "+4.242000e+01");
+  test (sprintf "% e" 42.42 =* " 4.242000e+01");
+  test (sprintf "%#e" 42.42 =* "4.242000e+01");
+  test (sprintf "%15e" 42.42 =* "   4.242000e+01");
+  test (sprintf "%*e" 14 42.42 =* "  4.242000e+01");
+  test (sprintf "%-0+ #14e" 42.42 =* "+4.242000e+01 ");
+  test (sprintf "%.3e" (-42.42) =* "-4.242e+01");
+  test (sprintf "%-15.3e" (-42.42) =* "-4.242e+01     ");
+  test (sprintf "%015.3e" (-42.42) =* "-000004.242e+01");
+  test (sprintf "%+.3e" 42.42 =* "+4.242e+01");
+  test (sprintf "% .3e" 42.42 =* " 4.242e+01");
+  test (sprintf "%#.3e" 42.42 =* "4.242e+01");
+  test (sprintf "%15.3e" 42.42 =* "      4.242e+01");
+  test (sprintf "%*.*e" 11 3 42.42 =* "  4.242e+01");
+  test (sprintf "%-0+ #14.3e" 42.42 =* "+4.242e+01    ");
+
+  say "\nE\n%!";
+  test (sprintf "%E" (-42.42) =* "-4.242000E+01");
+  test (sprintf "%-15E" (-42.42) =* "-4.242000E+01  ");
+  test (sprintf "%015E" (-42.42) =* "-004.242000E+01");
+  test (sprintf "%+E" 42.42 =* "+4.242000E+01");
+  test (sprintf "% E" 42.42 =* " 4.242000E+01");
+  test (sprintf "%#E" 42.42 =* "4.242000E+01");
+  test (sprintf "%15E" 42.42 =* "   4.242000E+01");
+  test (sprintf "%*E" 14 42.42 =* "  4.242000E+01");
+  test (sprintf "%-0+ #14E" 42.42 =* "+4.242000E+01 ");
+  test (sprintf "%.3E" (-42.42) =* "-4.242E+01");
+  test (sprintf "%-15.3E" (-42.42) =* "-4.242E+01     ");
+  test (sprintf "%015.3E" (-42.42) =* "-000004.242E+01");
+  test (sprintf "%+.3E" 42.42 =* "+4.242E+01");
+  test (sprintf "% .3E" 42.42 =* " 4.242E+01");
+  test (sprintf "%#.3E" 42.42 =* "4.242E+01");
+  test (sprintf "%15.3E" 42.42 =* "      4.242E+01");
+  test (sprintf "%*.*E" 11 3 42.42 =* "  4.242E+01");
+  test (sprintf "%-0+ #14.3E" 42.42 =* "+4.242E+01    ");
+
+(* %g gives strange results that correspond to neither %f nor %e
+  say "\ng\n%!";
+  test (sprintf "%g" (-42.42) = "-42.42000");
+  test (sprintf "%-15g" (-42.42) = "-42.42000      ");
+  test (sprintf "%015g" (-42.42) = "-00000042.42000");
+  test (sprintf "%+g" 42.42 = "+42.42000");
+  test (sprintf "% g" 42.42 = " 42.42000");
+  test (sprintf "%#g" 42.42 = "42.42000");
+  test (sprintf "%15g" 42.42 = "       42.42000");
+  test (sprintf "%*g" 14 42.42 = "      42.42000");
+  test (sprintf "%-0+ #14g" 42.42 = "+42.42000     ");
+  test (sprintf "%.3g" (-42.42) = "-42.420");
+*)
+
+(* Same for %G
+  say "\nG\n%!";
+*)
+
+  say "\nB\n%!";
+  test (sprintf "%B" true = "true");
+  test (sprintf "%B" false = "false");
+ (* test (sprintf "%8B" false = "   false"); *)
+  (* padding not done *)
+
+  say "\nld/li positive\n%!";
+  test (sprintf "%ld/%li" 42l 43l = "42/43");
+  test (sprintf "%-4ld/%-5li" 42l 43l = "42  /43   ");
+  test (sprintf "%04ld/%05li" 42l 43l = "0042/00043");
+  test (sprintf "%+ld/%+li" 42l 43l = "+42/+43");
+  test (sprintf "% ld/% li" 42l 43l = " 42/ 43");
+  test (sprintf "%#ld/%#li" 42l 43l = "42/43");
+  test (sprintf "%4ld/%5li" 42l 43l = "  42/   43");
+  test (sprintf "%*ld/%*li" 4 42l 5 43l = "  42/   43");
+  test (sprintf "%-0+#4ld/%-0 #5li" 42l 43l = "+42 / 43  ");
+
+  say "\nld/li negative\n%!";
+  test (sprintf "%ld/%li" (-42l) (-43l) = "-42/-43");
+  test (sprintf "%-4ld/%-5li" (-42l) (-43l) = "-42 /-43  ");
+  test (sprintf "%04ld/%05li" (-42l) (-43l) = "-042/-0043");
+  test (sprintf "%+ld/%+li" (-42l) (-43l) = "-42/-43");
+  test (sprintf "% ld/% li" (-42l) (-43l) = "-42/-43");
+  test (sprintf "%#ld/%#li" (-42l) (-43l) = "-42/-43");
+  test (sprintf "%4ld/%5li" (-42l) (-43l) = " -42/  -43");
+  test (sprintf "%*ld/%*li" 4 (-42l) 5 (-43l) = " -42/  -43");
+  test (sprintf "%-0+ #4ld/%-0+ #5li" (-42l) (-43l) = "-42 /-43  ");
+
+  say "\nlu positive\n%!";
+  test (sprintf "%lu" 42l = "42");
+  test (sprintf "%-4lu" 42l = "42  ");
+  test (sprintf "%04lu" 42l = "0042");
+  test (sprintf "%+lu" 42l = "42");
+  test (sprintf "% lu" 42l = "42");
+  test (sprintf "%#lu" 42l = "42");
+  test (sprintf "%4lu" 42l = "  42");
+  test (sprintf "%*lu" 4 42l = "  42");
+  test (sprintf "%-0+ #6ld" 42l = "+42   ");
+
+  say "\nlu negative\n%!";
+  test (sprintf "%lu" (-1l) = "4294967295");
+
+  say "\nlx positive\n%!";
+  test (sprintf "%lx" 42l = "2a");
+  test (sprintf "%-4lx" 42l = "2a  ");
+  test (sprintf "%04lx" 42l = "002a");
+  test (sprintf "%+lx" 42l = "2a");
+  test (sprintf "% lx" 42l = "2a");
+  test (sprintf "%#lx" 42l = "0x2a");
+  test (sprintf "%4lx" 42l = "  2a");
+  test (sprintf "%*lx" 5 42l = "   2a");
+  test (sprintf "%-0+ #*lx" 5 42l = "0x2a ");
+
+  say "\nlx negative\n%!";
+  test (sprintf "%lx" (-42l) = "ffffffd6");
+
+  say "\nlX positive\n%!";
+  test (sprintf "%lX" 42l = "2A");
+  test (sprintf "%-4lX" 42l = "2A  ");
+  test (sprintf "%04lX" 42l = "002A");
+  test (sprintf "%+lX" 42l = "2A");
+  test (sprintf "% lX" 42l = "2A");
+  test (sprintf "%#lX" 42l = "0X2A");
+  test (sprintf "%4lX" 42l = "  2A");
+  test (sprintf "%*lX" 5 42l = "   2A");
+  test (sprintf "%-0+ #*lX" 5 42l = "0X2A ");
+
+  say "\nlx negative\n%!";
+  test (sprintf "%lX" (-42l) = "FFFFFFD6");
+
+  say "\nlo positive\n%!";
+  test (sprintf "%lo" 42l = "52");
+  test (sprintf "%-4lo" 42l = "52  ");
+  test (sprintf "%04lo" 42l = "0052");
+  test (sprintf "%+lo" 42l = "52");
+  test (sprintf "% lo" 42l = "52");
+  test (sprintf "%#lo" 42l = "052");
+  test (sprintf "%4lo" 42l = "  52");
+  test (sprintf "%*lo" 5 42l = "   52");
+  test (sprintf "%-0+ #*lo" 5 42l = "052  ");
+
+  say "\nlo negative\n%!";
+  test (sprintf "%lo" (-42l) = "37777777726");
+
+  (* Nativeint not tested: looks like too much work, and anyway it should
+     work like Int32 or Int64. *)
+
+  say "\nLd/Li positive\n%!";
+  test (sprintf "%Ld/%Li" 42L 43L = "42/43");
+  test (sprintf "%-4Ld/%-5Li" 42L 43L = "42  /43   ");
+  test (sprintf "%04Ld/%05Li" 42L 43L = "0042/00043");
+  test (sprintf "%+Ld/%+Li" 42L 43L = "+42/+43");
+  test (sprintf "% Ld/% Li" 42L 43L = " 42/ 43");
+  test (sprintf "%#Ld/%#Li" 42L 43L = "42/43");
+  test (sprintf "%4Ld/%5Li" 42L 43L = "  42/   43");
+  test (sprintf "%*Ld/%*Li" 4 42L 5 43L = "  42/   43");
+  test (sprintf "%-0+#4Ld/%-0 #5Li" 42L 43L = "+42 / 43  ");
+
+  say "\nLd/Li negative\n%!";
+  test (sprintf "%Ld/%Li" (-42L) (-43L) = "-42/-43");
+  test (sprintf "%-4Ld/%-5Li" (-42L) (-43L) = "-42 /-43  ");
+  test (sprintf "%04Ld/%05Li" (-42L) (-43L) = "-042/-0043");
+  test (sprintf "%+Ld/%+Li" (-42L) (-43L) = "-42/-43");
+  test (sprintf "% Ld/% Li" (-42L) (-43L) = "-42/-43");
+  test (sprintf "%#Ld/%#Li" (-42L) (-43L) = "-42/-43");
+  test (sprintf "%4Ld/%5Li" (-42L) (-43L) = " -42/  -43");
+  test (sprintf "%*Ld/%*Li" 4 (-42L) 5 (-43L) = " -42/  -43");
+  test (sprintf "%-0+ #4Ld/%-0+ #5Li" (-42L) (-43L) = "-42 /-43  ");
+
+  say "\nLu positive\n%!";
+  test (sprintf "%Lu" 42L = "42");
+  test (sprintf "%-4Lu" 42L = "42  ");
+  test (sprintf "%04Lu" 42L = "0042");
+  test (sprintf "%+Lu" 42L = "42");
+  test (sprintf "% Lu" 42L = "42");
+  test (sprintf "%#Lu" 42L = "42");
+  test (sprintf "%4Lu" 42L = "  42");
+  test (sprintf "%*Lu" 4 42L = "  42");
+  test (sprintf "%-0+ #6Ld" 42L = "+42   ");
+
+  say "\nLu negative\n%!";
+  test (sprintf "%Lu" (-1L) = "18446744073709551615");
+
+  say "\nLx positive\n%!";
+  test (sprintf "%Lx" 42L = "2a");
+  test (sprintf "%-4Lx" 42L = "2a  ");
+  test (sprintf "%04Lx" 42L = "002a");
+  test (sprintf "%+Lx" 42L = "2a");
+  test (sprintf "% Lx" 42L = "2a");
+  test (sprintf "%#Lx" 42L = "0x2a");
+  test (sprintf "%4Lx" 42L = "  2a");
+  test (sprintf "%*Lx" 5 42L = "   2a");
+  test (sprintf "%-0+ #*Lx" 5 42L = "0x2a ");
+
+  say "\nLx negative\n%!";
+  test (sprintf "%Lx" (-42L) = "ffffffffffffffd6");
+
+  say "\nLX positive\n%!";
+  test (sprintf "%LX" 42L = "2A");
+  test (sprintf "%-4LX" 42L = "2A  ");
+  test (sprintf "%04LX" 42L = "002A");
+  test (sprintf "%+LX" 42L = "2A");
+  test (sprintf "% LX" 42L = "2A");
+  test (sprintf "%#LX" 42L = "0X2A");
+  test (sprintf "%4LX" 42L = "  2A");
+  test (sprintf "%*LX" 5 42L = "   2A");
+  test (sprintf "%-0+ #*LX" 5 42L = "0X2A ");
+
+  say "\nLx negative\n%!";
+  test (sprintf "%LX" (-42L) = "FFFFFFFFFFFFFFD6");
+
+  say "\nLo positive\n%!";
+  test (sprintf "%Lo" 42L = "52");
+  test (sprintf "%-4Lo" 42L = "52  ");
+  test (sprintf "%04Lo" 42L = "0052");
+  test (sprintf "%+Lo" 42L = "52");
+  test (sprintf "% Lo" 42L = "52");
+  test (sprintf "%#Lo" 42L = "052");
+  test (sprintf "%4Lo" 42L = "  52");
+  test (sprintf "%*Lo" 5 42L = "   52");
+  test (sprintf "%-0+ #*Lo" 5 42L = "052  ");
+
+  say "\nLo negative\n%!";
+  test (sprintf "%Lo" (-42L) = "1777777777777777777726");
+
+  say "\na\n%!";
+  let x = ref () in
+  let f () y = if y == x then "ok" else "wrong" in
+  test (sprintf "%a" f x = "ok");
+
+  say "\nt\n%!";
+  let f () = "ok" in
+  test (sprintf "%t" f = "ok");
+
+(* %{ fmt %} prints the signature of [fmt], i.e. a canonical representation
+   of the conversions present in [fmt].
+*)
+  say "\n{...%%}\n%!";
+  let f = format_of_string "%f/%s" in
+  test (sprintf "%{%f%s%}" f = "%f%s");
+
+  say "\n(...%%)\n%!";
+  let f = format_of_string "%d/foo/%s" in
+  test (sprintf "%(%d%s%)" f 42 "bar" = "42/foo/bar");
+
+  say "\n! %% @ , and constants\n%!";
+  test (sprintf "%!" = "");
+  test (sprintf "%%" = "%");
+  test (sprintf "%@" = "@");
+  test (sprintf "%," = "");
+  test (sprintf "@@" = "@");
+  test (sprintf "@@@@" = "@@");
+  test (sprintf "@@%%" = "@%");
+
+  say "\nDelayed printf\n%!";
+  let t1 = dprintf "%i - %s" 1 "bar" in
+  test (asprintf "foo %t" t1 = "foo 1 - bar");
+  let t2 = dprintf "%a@]" (pp_print_list pp_print_int) [1 ; 2 ; 3] in
+  test (asprintf "foo @[<v>%t@,%s" t2 "bar" = "foo 1\n    2\n    3\nbar");
+  test (asprintf "%t @[<h>%t" t1 t2 = "1 - bar 123");
+
+  say "\nend of tests\n%!";
+
+with e ->
+  say "unexpected exception: %s\n%!" (Printexc.to_string e);
+  test false;
+;;
diff --git a/testsuite/tests/lib-format/tformat.reference b/testsuite/tests/lib-format/tformat.reference
new file mode 100644
index 00000000..4496e98c
--- /dev/null
+++ b/testsuite/tests/lib-format/tformat.reference
@@ -0,0 +1,97 @@
+d/i positive
+ 0 1 2 3 4 5 6 7 8 9
+d/i negative
+ 10 11 12 13 14 15 16 17 18 19
+u positive
+ 20 21 22 23 24 25 26 27 28
+u negative
+ 29
+x positive
+ 30 31 32 33 34 35 36 37 38 39 40 41 42
+x negative
+ 43
+X positive
+ 44 45 46 47 48 49 50 51 52
+x negative
+ 53
+o positive
+ 54 55 56 57 58 59 60 61 62
+o negative
+ 63
+s
+ 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
+S
+ 79 80 81 82 83 84 85 86 87 88 89 90 91
+c
+ 92 93 94 95
+C
+ 96 97 98 99 100
+f
+ 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118
+F
+ 119 120 121 122 123 124 125
+h
+ 126 127 128 129 130 131 132 133 134 135 136 137 138
+H
+ 139 140 141 142 143 144 145 146 147 148 149 150 151
+e
+ 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169
+E
+ 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187
+B
+ 188 189
+ld/li positive
+ 190 191 192 193 194 195 196 197 198
+ld/li negative
+ 199 200 201 202 203 204 205 206 207
+lu positive
+ 208 209 210 211 212 213 214 215 216
+lu negative
+ 217
+lx positive
+ 218 219 220 221 222 223 224 225 226
+lx negative
+ 227
+lX positive
+ 228 229 230 231 232 233 234 235 236
+lx negative
+ 237
+lo positive
+ 238 239 240 241 242 243 244 245 246
+lo negative
+ 247
+Ld/Li positive
+ 248 249 250 251 252 253 254 255 256
+Ld/Li negative
+ 257 258 259 260 261 262 263 264 265
+Lu positive
+ 266 267 268 269 270 271 272 273 274
+Lu negative
+ 275
+Lx positive
+ 276 277 278 279 280 281 282 283 284
+Lx negative
+ 285
+LX positive
+ 286 287 288 289 290 291 292 293 294
+Lx negative
+ 295
+Lo positive
+ 296 297 298 299 300 301 302 303 304
+Lo negative
+ 305
+a
+ 306
+t
+ 307
+{...%}
+ 308
+(...%)
+ 309
+! % @ , and constants
+ 310 311 312 313 314 315 316
+Delayed printf
+ 317 318 319
+end of tests
+
+All tests succeeded.
diff --git a/testsuite/tests/lib-fun/test.ml b/testsuite/tests/lib-fun/test.ml
new file mode 100644
index 00000000..ba534db2
--- /dev/null
+++ b/testsuite/tests/lib-fun/test.ml
@@ -0,0 +1,52 @@
+(* TEST
+*)
+
+let test_id () =
+  assert (Fun.id true = true);
+  assert (Fun.id 1 = 1);
+  assert (not (Fun.id nan = nan));
+  ()
+
+let test_const () =
+  assert (Fun.const true false = true);
+  assert (Fun.const 0 false = 0);
+  assert (Fun.const 0 4 = 0);
+  ()
+
+let test_flip () =
+  assert (Fun.flip ( ^ ) "of order" "out " = "out of order");
+  assert (Fun.flip List.append [2] [1] = [1;2]);
+  assert (Fun.flip List.cons [2] 1 = [1;2]);
+  ()
+
+let test_negate () =
+  assert (Fun.negate (Bool.equal true) true = false);
+  assert (Fun.negate (Bool.equal true) false = true);
+  ()
+
+let test_protect () =
+  let does_raise f x =
+    try f x ; false
+    with _ -> true
+  in
+  let double_raise () =
+    let f () = raise Exit in
+    try
+      Fun.protect ~finally:f f ()
+    with
+    | Exit -> ()
+  in
+  assert (does_raise double_raise ())
+
+let tests () =
+  test_id ();
+  test_const ();
+  test_flip ();
+  test_negate ();
+  test_protect ();
+  ()
+
+let () =
+  tests ();
+  print_endline "OK";
+  ()
diff --git a/testsuite/tests/lib-fun/test.reference b/testsuite/tests/lib-fun/test.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-fun/test.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-hashtbl/hfun.ml b/testsuite/tests/lib-hashtbl/hfun.ml
new file mode 100644
index 00000000..3e15596e
--- /dev/null
+++ b/testsuite/tests/lib-hashtbl/hfun.ml
@@ -0,0 +1,45 @@
+(* TEST
+*)
+
+(* Testing the hash function Hashtbl.hash *)
+(* What is tested:
+     - reproducibility on various platforms, esp. 32/64 bit issues
+     - equal values hash equally, esp NaNs. *)
+
+open Printf
+
+let _ =
+  printf "-- Strings:\n";
+  printf "\"\"\t\t%08x\n" (Hashtbl.hash "");
+  printf "\"Hello world\"\t%08x\n" (Hashtbl.hash "Hello world");
+
+  printf "-- Integers:\n";
+  printf "0\t\t%08x\n" (Hashtbl.hash 0);
+  printf "-1\t\t%08x\n" (Hashtbl.hash (-1));
+  printf "42\t\t%08x\n" (Hashtbl.hash 42);
+  printf "2^30-1\t\t%08x\n" (Hashtbl.hash 0x3FFF_FFFF);
+  printf "-2^30\t\t%08x\n" (Hashtbl.hash (-0x4000_0000));
+
+  printf "-- Floats:\n";
+  printf "+0.0\t\t%08x\n" (Hashtbl.hash 0.0);
+  printf "-0.0\t\t%08x\n" (Hashtbl.hash (-. 0.0));
+  printf "+infty\t\t%08x\n" (Hashtbl.hash infinity);
+  printf "-infty\t\t%08x\n" (Hashtbl.hash neg_infinity);
+  printf "NaN\t\t%08x\n" (Hashtbl.hash nan);
+  printf "NaN#2\t\t%08x\n"
+         (Hashtbl.hash (Int64.float_of_bits 0xFF_F0_00_12_34_56_78_9AL));
+  printf "NaN#3\t\t%08x\n" (Hashtbl.hash (0.0 /. 0.0));
+
+  printf "-- Native integers:\n";
+  printf "0\t\t%08x\n" (Hashtbl.hash 0n);
+  printf "-1\t\t%08x\n" (Hashtbl.hash (-1n));
+  printf "42\t\t%08x\n" (Hashtbl.hash 42n);
+  printf "2^30-1\t\t%08x\n" (Hashtbl.hash 0x3FFF_FFFFn);
+  printf "-2^30\t\t%08x\n" (Hashtbl.hash (-0x4000_0000n));
+
+  printf "-- Lists:\n";
+  printf "[0..10]\t\t%08x\n" (Hashtbl.hash [0;1;2;3;4;5;6;7;8;9;10]);
+  printf "[0..12]\t\t%08x\n" (Hashtbl.hash [0;1;2;3;4;5;6;7;8;9;10;11;12]);
+  printf "[10..0]\t\t%08x\n" (Hashtbl.hash [10;9;8;7;6;5;4;3;2;1;0]);
+
+  ()
diff --git a/testsuite/tests/lib-hashtbl/hfun.reference b/testsuite/tests/lib-hashtbl/hfun.reference
new file mode 100644
index 00000000..2e92cf43
--- /dev/null
+++ b/testsuite/tests/lib-hashtbl/hfun.reference
@@ -0,0 +1,27 @@
+-- Strings:
+""		00000000
+"Hello world"	364b8272
+-- Integers:
+0		07be548a
+-1		3653e015
+42		1792870b
+2^30-1		23c392d0
+-2^30		0c66fde3
+-- Floats:
++0.0		0f478b8c
+-0.0		0f478b8c
++infty		23ea56fb
+-infty		059f7872
+NaN		3228858d
+NaN#2		3228858d
+NaN#3		3228858d
+-- Native integers:
+0		3f19274a
+-1		3653e015
+42		3e33aef8
+2^30-1		3711bf46
+-2^30		2e71f39c
+-- Lists:
+[0..10]		0ade0fc9
+[0..12]		0ade0fc9
+[10..0]		0cd6259d
diff --git a/testsuite/tests/lib-hashtbl/htbl.ml b/testsuite/tests/lib-hashtbl/htbl.ml
new file mode 100644
index 00000000..7dd6f287
--- /dev/null
+++ b/testsuite/tests/lib-hashtbl/htbl.ml
@@ -0,0 +1,283 @@
+(* TEST
+*)
+
+(* Hashtable operations, using maps as a reference *)
+
+open Printf
+
+module Test(H: Hashtbl.S) (M: Map.S with type key = H.key) = struct
+
+  let incl_mh m h =
+    try
+      M.iter
+        (fun k d ->
+          let d' = H.find h k in if d <> d' then raise Exit)
+        m;
+      true
+    with Exit | Not_found -> false
+
+  let domain_hm h m =
+    try
+      H.iter
+        (fun k d -> if not (M.mem k m) then raise Exit)
+        h;
+      true
+    with Exit -> false
+
+  let incl_hm h m =
+    try
+      H.iter
+        (fun k d ->
+           let d' = M.find k m in if d <> d' then raise Exit)
+        h;
+      true
+    with Exit | Not_found -> false
+
+  let to_list_ h : _ list =
+    H.fold (fun k v acc -> (k,v) :: acc) h []
+    |> List.sort Stdlib.compare
+
+  let check_to_seq h =
+    let l = to_list_ h in
+    let l2 = List.of_seq (H.to_seq h) in
+    assert (l = List.sort Stdlib.compare l2)
+
+  let check_to_seq_of_seq h =
+    let h' = H.create (H.length h) in
+    H.add_seq h' (H.to_seq h);
+    (*printf "h.len=%d, h'.len=%d\n" (List.length @@ to_list_ h)
+                                     (List.length @@ to_list_ h');*)
+    assert (to_list_ h = to_list_ h')
+
+  let test data =
+    let n = Array.length data in
+    let h = H.create 51 and m = ref M.empty in
+    (* Insert all data with H.add *)
+    Array.iter
+      (fun (k, d) -> H.add h k d; m := M.add k d !m)
+      data;
+    printf "Insertion: %s\n"
+           (if incl_mh !m h && domain_hm h !m then "passed" else "FAILED");
+    check_to_seq_of_seq h;
+    check_to_seq h;
+    (* Insert all data with H.replace *)
+    H.clear h; m := M.empty;
+    Array.iter
+      (fun (k, d) -> H.replace h k d; m := M.add k d !m)
+      data;
+    printf "Insertion: %s\n"
+           (if incl_mh !m h && incl_hm h !m then "passed" else "FAILED");
+    check_to_seq_of_seq h;
+    check_to_seq h;
+    (* Remove some of the data *)
+    for i = 0 to n/3 - 1 do
+      let (k, _) = data.(i) in H.remove h k; m := M.remove k !m
+    done;
+    printf "Removal: %s\n"
+      (if incl_mh !m h && incl_hm h !m then "passed" else "FAILED");
+    check_to_seq_of_seq h;
+    check_to_seq h;
+    ()
+
+end
+
+module SS = struct
+  type t = string
+  let compare (x:t) (y:t) = Stdlib.compare x y
+  let equal (x:t) (y:t) = x=y
+  let hash = Hashtbl.hash
+end
+module SI = struct
+  type t = int
+  let compare (x:t) (y:t) = Stdlib.compare x y
+  let equal (x:t) (y:t) = x=y
+  let hash = Hashtbl.hash
+end
+module SSP = struct
+  type t = string*string
+  let compare (x:t) (y:t) = Stdlib.compare x y
+  let equal (x:t) (y:t) = x=y
+  let hash = Hashtbl.hash
+end
+module SSL = struct
+  type t = string list
+  let compare (x:t) (y:t) = Stdlib.compare x y
+  let equal (x:t) (y:t) = x=y
+  let hash = Hashtbl.hash
+end
+module SSA = struct
+  type t = string array
+  let compare (x:t) (y:t) = Stdlib.compare x y
+  let equal (x:t) (y:t) = x=y
+  let hash = Hashtbl.hash
+end
+
+module MS = Map.Make(SS)
+module MI = Map.Make(SI)
+module MSP = Map.Make(SSP)
+module MSL = Map.Make(SSL)
+module MSA = Map.Make(SSA)
+
+
+(* Generic hash wrapped as a functorial hash *)
+
+module HofM (M: Map.S) : Hashtbl.S with type key = M.key =
+  struct
+    type key = M.key
+    type 'a t = (key, 'a) Hashtbl.t
+    let create s = Hashtbl.create s
+    let clear = Hashtbl.clear
+    let reset = Hashtbl.reset
+    let copy = Hashtbl.copy
+    let add = Hashtbl.add
+    let remove = Hashtbl.remove
+    let find = Hashtbl.find
+    let find_opt = Hashtbl.find_opt
+    let find_all = Hashtbl.find_all
+    let replace = Hashtbl.replace
+    let mem = Hashtbl.mem
+    let iter = Hashtbl.iter
+    let fold = Hashtbl.fold
+    let length = Hashtbl.length
+    let stats = Hashtbl.stats
+    let filter_map_inplace = Hashtbl.filter_map_inplace
+    let to_seq = Hashtbl.to_seq
+    let to_seq_keys = Hashtbl.to_seq_keys
+    let to_seq_values = Hashtbl.to_seq_values
+    let of_seq = Hashtbl.of_seq
+    let add_seq = Hashtbl.add_seq
+    let replace_seq = Hashtbl.replace_seq
+  end
+
+module HS1 = HofM(MS)
+module HI1 = HofM(MI)
+module HSP = HofM(MSP)
+module HSL = HofM(MSL)
+
+(* Specific functorial hashes *)
+
+module HS2 = Hashtbl.Make(SS)
+module HI2 = Hashtbl.Make(SI)
+
+(* Specific weak functorial hashes *)
+module WS = Ephemeron.K1.Make(SS)
+module WSP1 = Ephemeron.K1.Make(SSP)
+module WSP2 = Ephemeron.K2.Make(SS)(SS)
+module WSL = Ephemeron.K1.Make(SSL)
+module WSA = Ephemeron.Kn.Make(SS)
+
+(* Instantiating the test *)
+
+module TS1 = Test(HS1)(MS)
+module TS2 = Test(HS2)(MS)
+module TI1 = Test(HI1)(MI)
+module TI2 = Test(HI2)(MI)
+module TSP = Test(HSP)(MSP)
+module TSL = Test(HSL)(MSL)
+module TWS  = Test(WS)(MS)
+module TWSP1 = Test(WSP1)(MSP)
+module TWSP2 = Test(WSP2)(MSP)
+module TWSL = Test(WSL)(MSL)
+module TWSA = Test(WSA)(MSA)
+
+(* Data set: strings from a file, associated with their line number *)
+
+let file_data filename =
+  let ic = open_in filename in
+  let lineno = ref 0 in
+  let data = ref [] in
+  begin try
+    while true do
+      let l = input_line ic in
+      incr lineno;
+      data := (l, !lineno) :: !data
+    done
+  with End_of_file -> ()
+  end;
+  close_in ic;
+  Array.of_list !data
+
+(* Data set: fixed strings *)
+
+let string_data = [|
+  "Si", 0; "non", 1; "e", 2; "vero", 3; "e", 4; "ben", 5; "trovato", 6;
+  "An", 10; "apple", 11; "a", 12; "day", 13; "keeps", 14; "the", 15;
+  "doctor", 16; "away", 17;
+  "Pierre", 20; "qui", 21; "roule", 22; "n'amasse", 23; "pas", 24; "mousse", 25;
+  "Asinus", 30; "asinum", 31; "fricat", 32
+|]
+
+(* Data set: random integers *)
+
+let random_integers num range =
+  let data = Array.make num (0,0) in
+  for i = 0 to num - 1 do
+    data.(i) <- (Random.int range, i)
+  done;
+  data
+
+(* Data set: pairs *)
+
+let pair_data data =
+  Array.map (fun (k, d) -> ((k, k), d)) data
+
+(* Data set: lists *)
+
+let list_data data =
+  let d = Array.make (Array.length data / 10) ([], "0") in
+  let j = ref 0 in
+  let rec mklist n =
+    if n <= 0 || !j >= Array.length data then [] else begin
+      let hd = fst data.(!j) in
+      incr j;
+      let tl = mklist (n-1) in
+      hd :: tl
+    end in
+  for i = 0 to Array.length d - 1 do
+    d.(i) <- (mklist (Random.int 16), Int.to_string i)
+  done;
+  d
+
+(* The test *)
+
+let _ =
+  printf "-- Random integers, large range\n%!";
+  TI1.test (random_integers 20_000 1_000_000);
+  printf "-- Random integers, narrow range\n%!";
+  TI2.test (random_integers 20_000 1_000);
+  let d =
+    try file_data "../../LICENSE" with Sys_error _ -> string_data in
+  printf "-- Strings, generic interface\n%!";
+  TS1.test d;
+  printf "-- Strings, functorial interface\n%!";
+  TS2.test d;
+  printf "-- Pairs of strings\n%!";
+  TSP.test (pair_data d);
+  printf "-- Lists of strings\n%!";
+  TSL.test (list_data d);
+  (* weak *)
+  let d =
+    try file_data "../../LICENSE" with Sys_error _ -> string_data in
+  printf "-- Weak K1 -- Strings, functorial interface\n%!";
+  TWS.test d;
+  printf "-- Weak K1 -- Pairs of strings\n%!";
+  TWSP1.test (pair_data d);
+  printf "-- Weak K2 -- Pairs of strings\n%!";
+  TWSP2.test (pair_data d);
+  printf "-- Weak K1 -- Lists of strings\n%!";
+  TWSL.test (list_data d);
+  printf "-- Weak Kn -- Arrays of strings\n%!";
+  TWSA.test (Array.map (fun (l,i) -> (Array.of_list l,i)) (list_data d))
+
+
+let () =
+  let h = Hashtbl.create 16 in
+  for i = 1 to 1000 do Hashtbl.add h i (i * 2) done;
+  Printf.printf "%i elements\n" (Hashtbl.length h);
+  Hashtbl.filter_map_inplace (fun k v ->
+      if k mod 100 = 0 then ((*Hashtbl.add h v v;*) Some (v / 100)) else None)
+    h;
+  let l = Hashtbl.fold (fun k v acc -> (k, v) :: acc) h [] in
+  let l = List.sort compare l in
+  List.iter (fun (k, v) -> Printf.printf "%i,%i\n" k v) l;
+  Printf.printf "%i elements\n" (Hashtbl.length h)
diff --git a/testsuite/tests/lib-hashtbl/htbl.reference b/testsuite/tests/lib-hashtbl/htbl.reference
new file mode 100644
index 00000000..653fbc56
--- /dev/null
+++ b/testsuite/tests/lib-hashtbl/htbl.reference
@@ -0,0 +1,56 @@
+-- Random integers, large range
+Insertion: passed
+Insertion: passed
+Removal: passed
+-- Random integers, narrow range
+Insertion: passed
+Insertion: passed
+Removal: passed
+-- Strings, generic interface
+Insertion: passed
+Insertion: passed
+Removal: passed
+-- Strings, functorial interface
+Insertion: passed
+Insertion: passed
+Removal: passed
+-- Pairs of strings
+Insertion: passed
+Insertion: passed
+Removal: passed
+-- Lists of strings
+Insertion: passed
+Insertion: passed
+Removal: passed
+-- Weak K1 -- Strings, functorial interface
+Insertion: passed
+Insertion: passed
+Removal: passed
+-- Weak K1 -- Pairs of strings
+Insertion: passed
+Insertion: passed
+Removal: passed
+-- Weak K2 -- Pairs of strings
+Insertion: passed
+Insertion: passed
+Removal: passed
+-- Weak K1 -- Lists of strings
+Insertion: passed
+Insertion: passed
+Removal: passed
+-- Weak Kn -- Arrays of strings
+Insertion: passed
+Insertion: passed
+Removal: passed
+1000 elements
+100,2
+200,4
+300,6
+400,8
+500,10
+600,12
+700,14
+800,16
+900,18
+1000,20
+10 elements
diff --git a/testsuite/tests/lib-int/test.ml b/testsuite/tests/lib-int/test.ml
new file mode 100644
index 00000000..592dbb33
--- /dev/null
+++ b/testsuite/tests/lib-int/test.ml
@@ -0,0 +1,72 @@
+(* TEST
+*)
+
+let test_consts () =
+  assert (Int.zero = 0);
+  assert (Int.one = 1);
+  assert (Int.minus_one = -1);
+  ()
+
+let test_arith () =
+  assert (Int.add 2 4 = 6);
+  assert (Int.sub 6 2 = 4);
+  assert (Int.mul 6 2 = 12);
+  assert (Int.div 12 2 = 6);
+  assert (Int.rem 5 2 = 1);
+  assert (Int.succ 5 = 6);
+  assert (Int.pred 5 = 4);
+  assert (Int.abs (-5) = 5);
+  assert (Int.abs 5 = 5);
+  ()
+
+let test_logops () =
+  assert (Int.logand 0xF0F0 0xFFFF = 0xF0F0);
+  assert (Int.logor 0xF0FF 0x0F0F = 0xFFFF);
+  assert (Int.logxor 0xF0FF 0x0F0F = 0xFFF0);
+  assert (Int.lognot Int.max_int = Int.min_int);
+  assert (Int.shift_left 1 4 = 16);
+  assert (Int.shift_left (Int.compare 0 0) 63 = 0); (* Issue #8864 *)
+  assert (Int.shift_right 16 4 = 1);
+  assert (Int.shift_right (-16) 4 = (-1));
+  assert (Int.shift_right (-16) 4 = (-1));
+  assert (Int.shift_right_logical Int.min_int (Sys.int_size - 1) = 1);
+  ()
+
+let test_equal () =
+  assert (Int.equal 1 1 = true);
+  assert (Int.equal 1 0 = false);
+  ()
+
+let test_compare () =
+  assert (Int.compare 3 3 = 0);
+  assert (Int.compare 3 4 = (-1));
+  assert (Int.compare 4 3 = 1);
+  assert (Int.compare (-4) 3 = -1);
+  assert (Int.compare 3 (-4) = 1);
+  ()
+
+let test_float_conv () =
+  assert (Int.to_float 5 = 5.0);
+  assert (Int.of_float 5. = 5);
+  assert (Int.of_float 5.9 = 5);
+  ()
+
+let test_string_conv () =
+  assert (Int.to_string 50 = "50");
+(*  assert (Int.of_string "50" = Some 50);
+  assert (Int.of_string "" = None); *)
+  ()
+
+let tests () =
+  test_consts ();
+  test_arith ();
+  test_logops ();
+  test_equal ();
+  test_compare ();
+  test_float_conv ();
+  test_string_conv ();
+  ()
+
+let () =
+  tests ();
+  print_endline "OK"
diff --git a/testsuite/tests/lib-int/test.reference b/testsuite/tests/lib-int/test.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-int/test.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-int64/issue9460.ml b/testsuite/tests/lib-int64/issue9460.ml
new file mode 100644
index 00000000..aacbe618
--- /dev/null
+++ b/testsuite/tests/lib-int64/issue9460.ml
@@ -0,0 +1,37 @@
+(* TEST
+*)
+
+(* See https://github.com/ocaml/ocaml/issues/9460
+   This test comes from Richard Jones
+   at
+     https://github.com/libguestfs/libnbd/blob/0475bfe04a527051c0a37af59a733c4c8554e427/ocaml/tests/test_400_pread.ml#L21-L36
+*)
+let test_result =
+  let b = Bytes.create 16 in
+  for i = 0 to 16/8-1 do
+    let i64 = ref (Int64.of_int (i*8)) in
+    for j = 0 to 7 do
+      let c = Int64.shift_right_logical !i64 56 in
+      let c = Int64.to_int c in
+      let c = Char.chr c in
+      Bytes.unsafe_set b (i*8+j) c;
+      i64 := Int64.shift_left !i64 8
+    done
+  done;
+  (Bytes.to_string b) ;;
+
+let expected =
+  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008"
+
+let () =
+  assert (test_result = expected)
+
+(* Reproduction case by Jeremy Yallop in
+   https://github.com/ocaml/ocaml/pull/9463#issuecomment-615831765
+*)
+let () =
+  let x = ref Int64.max_int in
+  assert (!x = Int64.max_int)
+
+let () =
+  print_endline "OK"
diff --git a/testsuite/tests/lib-int64/issue9460.reference b/testsuite/tests/lib-int64/issue9460.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-int64/issue9460.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-int64/test.ml b/testsuite/tests/lib-int64/test.ml
new file mode 100644
index 00000000..82e2b4f8
--- /dev/null
+++ b/testsuite/tests/lib-int64/test.ml
@@ -0,0 +1,71 @@
+(* TEST
+*)
+
+let test_consts () =
+  assert (Int64.zero = 0L);
+  assert (Int64.one = 1L);
+  assert (Int64.minus_one = -1L);
+  ()
+
+let test_arith () =
+  assert (Int64.add 2L 4L = 6L);
+  assert (Int64.sub 6L 2L = 4L);
+  assert (Int64.mul 6L 2L = 12L);
+  assert (Int64.div 12L 2L = 6L);
+  assert (Int64.rem 5L 2L = 1L);
+  assert (Int64.succ 5L = 6L);
+  assert (Int64.pred 5L = 4L);
+  assert (Int64.abs (-5L) = 5L);
+  assert (Int64.abs 5L = 5L);
+  ()
+
+let test_logops () =
+  assert (Int64.logand 0xF0F0L 0xFFFFL = 0xF0F0L);
+  assert (Int64.logor 0xF0FFL 0x0F0FL = 0xFFFFL);
+  assert (Int64.logxor 0xF0FFL 0x0F0FL = 0xFFF0L);
+  assert (Int64.lognot Int64.max_int = Int64.min_int);
+  assert (Int64.shift_left 1L 4 = 16L);
+  assert (Int64.shift_right 16L 4 = 1L);
+  assert (Int64.shift_right (-16L) 4 = (-1L));
+  assert (Int64.shift_right (-16L) 4 = (-1L));
+  assert (Int64.shift_right_logical Int64.min_int 63 = 1L);
+  ()
+
+let test_equal () =
+  assert (Int64.equal 1L 1L = true);
+  assert (Int64.equal 1L 0L = false);
+  ()
+
+let test_compare () =
+  assert (Int64.compare 3L 3L = 0);
+  assert (Int64.compare 3L 4L = (-1));
+  assert (Int64.compare 4L 3L = 1);
+  assert (Int64.compare (-4L) 3L = -1);
+  assert (Int64.compare 3L (-4L) = 1);
+  ()
+
+let test_float_conv () =
+  assert (Int64.to_float 5L = 5.0);
+  assert (Int64.of_float 5. = 5L);
+  assert (Int64.of_float 5.9 = 5L);
+  ()
+
+let test_string_conv () =
+  assert (Int64.to_string 50L = "50");
+(*  assert (Int64.of_string "50" = Some 50);
+  assert (Int64.of_string "" = None); *)
+  ()
+
+let tests () =
+  test_consts ();
+  test_arith ();
+  test_logops ();
+  test_equal ();
+  test_compare ();
+  test_float_conv ();
+  test_string_conv ();
+  ()
+
+let () =
+  tests ();
+  print_endline "OK"
diff --git a/testsuite/tests/lib-int64/test.reference b/testsuite/tests/lib-int64/test.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-int64/test.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-internalformat/test.ml b/testsuite/tests/lib-internalformat/test.ml
new file mode 100644
index 00000000..9f813353
--- /dev/null
+++ b/testsuite/tests/lib-internalformat/test.ml
@@ -0,0 +1,30 @@
+(* TEST
+   * expect
+*)
+
+let inspect (format : _ format6) =
+  let (CamlinternalFormatBasics.Format (fmt, str)) = format in
+  (CamlinternalFormat.string_of_fmt fmt, str);;
+[%%expect{|
+val inspect : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string * string = <fun>
+|}];;
+
+inspect "@[foo@]";;
+[%%expect{|
+- : string * string = ("@[foo@]", "@[foo@]")
+|}];;
+
+inspect "@%%";;
+[%%expect{|
+- : string * string = ("@%%", "@%%")
+|}];;
+
+inspect "@<";;
+[%%expect{|
+- : string * string = ("@<", "@<")
+|}];;
+
+inspect "@[<%s>@]";;
+[%%expect{|
+- : string * string = ("@[<%s>@]", "@[<%s>@]")
+|}];;
diff --git a/testsuite/tests/lib-list/test.ml b/testsuite/tests/lib-list/test.ml
new file mode 100644
index 00000000..d0b75e6a
--- /dev/null
+++ b/testsuite/tests/lib-list/test.ml
@@ -0,0 +1,94 @@
+(* TEST
+*)
+
+let string_of_even_opt x =
+  if x mod 2 = 0 then
+    Some (string_of_int x)
+  else
+    None
+
+(* Standard test case *)
+let () =
+  let l = List.init 10 (fun x -> x) in
+  let sl = List.init 10 string_of_int in
+  assert (List.exists (fun a -> a < 10) l);
+  assert (List.exists (fun a -> a > 0) l);
+  assert (List.exists (fun a -> a = 0) l);
+  assert (List.exists (fun a -> a = 1) l);
+  assert (List.exists (fun a -> a = 2) l);
+  assert (List.exists (fun a -> a = 3) l);
+  assert (List.exists (fun a -> a = 4) l);
+  assert (List.exists (fun a -> a = 5) l);
+  assert (List.exists (fun a -> a = 6) l);
+  assert (List.exists (fun a -> a = 7) l);
+  assert (List.exists (fun a -> a = 8) l);
+  assert (List.exists (fun a -> a = 9) l);
+  assert (not (List.exists (fun a -> a < 0) l));
+  assert (not (List.exists (fun a -> a > 9) l));
+  assert (List.exists (fun _ -> true) l);
+
+  begin
+    let f ~limit a = if a >= limit then Some (a, limit) else None in
+    assert (List.find_map (f ~limit:3) [] = None);
+    assert (List.find_map (f ~limit:3) l = Some (3, 3));
+    assert (List.find_map (f ~limit:30) l = None);
+  end;
+
+  assert (List.filteri (fun i _ -> i < 2) (List.rev l) = [9; 8]);
+
+  assert (List.compare_lengths [] [] = 0);
+  assert (List.compare_lengths [1;2] ['a';'b'] = 0);
+  assert (List.compare_lengths [] [1;2] < 0);
+  assert (List.compare_lengths ['a'] [1;2] < 0);
+  assert (List.compare_lengths [1;2] [] > 0);
+  assert (List.compare_lengths [1;2] ['a'] > 0);
+
+  assert (List.compare_length_with [] 0 = 0);
+  assert (List.compare_length_with [] 1 < 0);
+  assert (List.compare_length_with [] (-1) > 0);
+  assert (List.compare_length_with [] max_int < 0);
+  assert (List.compare_length_with [] min_int > 0);
+  assert (List.compare_length_with [1] 0 > 0);
+  assert (List.compare_length_with ['1'] 1 = 0);
+  assert (List.compare_length_with ['1'] 2 < 0);
+  assert (List.filter_map string_of_even_opt l = ["0";"2";"4";"6";"8"]);
+  assert (List.concat_map (fun i -> [i; i+1]) [1; 5] = [1; 2; 5; 6]);
+  assert (
+    let count = ref 0 in
+    List.concat_map (fun i -> incr count; [i; !count]) [1; 5] = [1; 1; 5; 2]);
+  assert (List.fold_left_map (fun a b -> a + b, b) 0 l = (45, l));
+  assert (List.fold_left_map (fun a b -> assert false) 0 [] = (0, []));
+  assert (
+    let f a b = a + b, string_of_int b in
+    List.fold_left_map f 0 l = (45, sl));
+  ()
+;;
+
+(* Empty test case *)
+let () =
+  assert ((List.init 0 (fun x -> x)) = []);
+;;
+
+(* Erroneous test case *)
+
+let () =
+  let result = try
+      let _ = List.init (-1) (fun x -> x) in false
+  with Invalid_argument e -> true (* Exception caught *)
+  in assert result;
+;;
+
+(* Evaluation order *)
+let () =
+  let test n =
+    let result = ref false in
+    let _ = List.init n (fun x -> result := (x = n - 1)) in
+    assert !result
+  in
+  (* Threshold must equal the value in stdlib/list.ml *)
+  let threshold = 10_000 in
+  test threshold; (* Non tail-recursive case *)
+  test (threshold + 1) (* Tail-recursive case *)
+;;
+
+let () = print_endline "OK";;
diff --git a/testsuite/tests/lib-list/test.reference b/testsuite/tests/lib-list/test.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-list/test.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-marshal/intern_final.ml b/testsuite/tests/lib-marshal/intern_final.ml
new file mode 100644
index 00000000..d50fb978
--- /dev/null
+++ b/testsuite/tests/lib-marshal/intern_final.ml
@@ -0,0 +1,30 @@
+(* TEST *)
+
+let t : int array = Array.make 200 42
+let c = open_out_bin "data42"
+let () = Marshal.to_channel c t []
+let () = close_out c
+
+let t : int array = Array.make 200 0
+let c = open_out_bin "data0"
+let () = Marshal.to_channel c t []
+let () = close_out c
+
+let rec fill_minor accu = function
+  | 0 -> accu
+  | n -> fill_minor (n::accu) (n-1)
+
+let () =
+  let c0 = open_in_bin "data0" in
+  let c42 = open_in_bin "data42" in
+
+  ignore (Gc.create_alarm (fun () ->
+              seek_in c0 0;
+              ignore (Marshal.from_channel c0)));
+
+  for i = 0 to 100000 do
+    seek_in c42 0;
+    let res : int array = Marshal.from_channel c42 in
+    Array.iter (fun n -> assert (n = 42)) res
+  done;
+  Printf.printf "OK!\n"
diff --git a/testsuite/tests/lib-marshal/intern_final.reference b/testsuite/tests/lib-marshal/intern_final.reference
new file mode 100644
index 00000000..d6406617
--- /dev/null
+++ b/testsuite/tests/lib-marshal/intern_final.reference
@@ -0,0 +1 @@
+OK!
diff --git a/testsuite/tests/lib-marshal/intext.ml b/testsuite/tests/lib-marshal/intext.ml
new file mode 100644
index 00000000..5ed2bbc5
--- /dev/null
+++ b/testsuite/tests/lib-marshal/intext.ml
@@ -0,0 +1,632 @@
+(* TEST
+   modules = "intextaux.c"
+*)
+
+(* Test for output_value / input_value *)
+
+let max_data_depth = 500000
+
+type t = A | B of int | C of float | D of string | E of char
+       | F of t | G of t * t | H of int * t | I of t * float | J
+
+let longstring =
+"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
+let verylongstring =
+"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
+ 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
+ 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
+ 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
+ 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
+ 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
+ 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
+ 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
+
+let bigint = Int64.to_int 0x123456789ABCDEF0L
+
+let rec fib n =
+  if n < 2 then 1 else fib(n-1) + fib(n-2)
+
+let test_out filename =
+  let oc = open_out_bin filename in
+  output_value oc 1;
+  output_value oc (-1);
+  output_value oc 258;
+  output_value oc 20000;
+  output_value oc 0x12345678;
+  output_value oc bigint;
+  output_value oc "foobargeebuz";
+  output_value oc longstring;
+  output_value oc verylongstring;
+  output_value oc 3.141592654;
+  output_value oc ();
+  output_value oc A;
+  output_value oc (B 1);
+  output_value oc (C 2.718);
+  output_value oc (D "hello, world!");
+  output_value oc (E 'l');
+  output_value oc (F(B 1));
+  output_value oc (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e')))));
+  output_value oc (H(1, A));
+  output_value oc (I(B 2, 1e-6));
+  let x = D "sharing" in
+  let y = G(x, x) in
+  let z = G(y, G(x, y)) in
+  output_value oc z;
+  output_value oc [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|];
+  let rec big n = if n <= 0 then A else H(n, big(n-1)) in
+  output_value oc (big 1000);
+  Marshal.to_channel oc y [Marshal.No_sharing];
+  Marshal.to_channel oc fib [Marshal.Closures];
+  output_value oc (Int32.of_string "0");
+  output_value oc (Int32.of_string "123456");
+  output_value oc (Int32.of_string "-123456");
+  output_value oc (Int64.of_string "0");
+  output_value oc (Int64.of_string "123456789123456");
+  output_value oc (Int64.of_string "-123456789123456");
+  output_value oc (Nativeint.of_string "0");
+  output_value oc (Nativeint.of_string "123456");
+  output_value oc (Nativeint.of_string "-123456");
+  output_value oc (Nativeint.shift_left (Nativeint.of_string "123456789") 32);
+  output_value oc (Nativeint.shift_left (Nativeint.of_string "-123456789") 32);
+  let i = Int64.of_string "123456789123456" in output_value oc (i,i);
+  close_out oc
+
+
+let test n b =
+  print_string "Test "; print_int n;
+  if b then print_string " passed.\n" else print_string " FAILED.\n";
+  flush stderr
+
+let test_in filename =
+  let ic = open_in_bin filename in
+  test 1 (input_value ic = 1);
+  test 2 (input_value ic = (-1));
+  test 3 (input_value ic = 258);
+  test 4 (input_value ic = 20000);
+  test 5 (input_value ic = 0x12345678);
+  test 6 (input_value ic = bigint);
+  test 7 (input_value ic = "foobargeebuz");
+  test 8 (input_value ic = longstring);
+  test 9 (input_value ic = verylongstring);
+  test 10 (input_value ic = 3.141592654);
+  test 11 (input_value ic = ());
+  test 12 (match input_value ic with
+    A -> true
+  | _ -> false);
+  test 13 (match input_value ic with
+    (B 1) -> true
+  | _ -> false);
+  test 14 (match input_value ic with
+    (C f) -> f = 2.718
+  | _ -> false);
+  test 15 (match input_value ic with
+    (D "hello, world!") -> true
+  | _ -> false);
+  test 16 (match input_value ic with
+    (E 'l') -> true
+  | _ -> false);
+  test 17 (match input_value ic with
+    (F(B 1)) -> true
+  | _ -> false);
+  test 18 (match input_value ic with
+    (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) -> true
+  | _ -> false);
+  test 19 (match input_value ic with
+    (H(1, A)) -> true
+  | _ -> false);
+  test 20 (match input_value ic with
+    (I(B 2, 1e-6)) -> true
+  | _ -> false);
+  test 21 (match input_value ic with
+    G((G((D "sharing" as t1), t2) as t3), G(t4, t5)) ->
+      t1 == t2 && t3 == t5 && t4 == t1
+  | _ -> false);
+  test 22 (input_value ic = [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]);
+  let rec check_big n t =
+    if n <= 0 then
+      test 23 (match t with A -> true | _ -> false)
+    else
+      match t with H(m, s) -> if m = n then check_big (n-1) s
+                                       else test 23 false
+                 | _ -> test 23 false
+  in
+    check_big 1000 (input_value ic);
+  test 24 (match input_value ic with
+    G((D "sharing" as t1), (D "sharing" as t2)) -> t1 != t2
+  | _ -> false);
+  test 25 (let fib = (input_value ic : int -> int) in fib 5 = 8 && fib 10 = 89);
+  test 26 (input_value ic = Int32.of_string "0");
+  test 27 (input_value ic = Int32.of_string "123456");
+  test 28 (input_value ic = Int32.of_string "-123456");
+  test 29 (input_value ic = Int64.of_string "0");
+  test 30 (input_value ic = Int64.of_string "123456789123456");
+  test 31 (input_value ic = Int64.of_string "-123456789123456");
+  test 32 (input_value ic = Nativeint.of_string "0");
+  test 33 (input_value ic = Nativeint.of_string "123456");
+  test 34 (input_value ic = Nativeint.of_string "-123456");
+  test 35 (input_value ic =
+             Nativeint.shift_left (Nativeint.of_string "123456789") 32);
+  test 36 (input_value ic =
+             Nativeint.shift_left (Nativeint.of_string "-123456789") 32);
+  let ((i, j) : int64 * int64) = input_value ic in
+  test 37 (i = Int64.of_string "123456789123456");
+  test 38 (j = Int64.of_string "123456789123456");
+  test 39 (i == j);
+  close_in ic
+
+let test_string () =
+  let s = Marshal.to_string 1 [] in
+  test 101 (Marshal.from_string s 0 = 1);
+  let s = Marshal.to_string (-1) [] in
+  test 102 (Marshal.from_string s 0 = (-1));
+  let s = Marshal.to_string 258 [] in
+  test 103 (Marshal.from_string s 0 = 258);
+  let s = Marshal.to_string 20000 [] in
+  test 104 (Marshal.from_string s 0 = 20000);
+  let s = Marshal.to_string 0x12345678 [] in
+  test 105 (Marshal.from_string s 0 = 0x12345678);
+  let s = Marshal.to_string bigint [] in
+  test 106 (Marshal.from_string s 0 = bigint);
+  let s = Marshal.to_string "foobargeebuz" [] in
+  test 107 (Marshal.from_string s 0 = "foobargeebuz");
+  let s = Marshal.to_string longstring [] in
+  test 108 (Marshal.from_string s 0 = longstring);
+  let s = Marshal.to_string verylongstring [] in
+  test 109 (Marshal.from_string s 0 = verylongstring);
+  let s = Marshal.to_string 3.141592654 [] in
+  test 110 (Marshal.from_string s 0 = 3.141592654);
+  let s = Marshal.to_string () [] in
+  test 111 (Marshal.from_string s 0 = ());
+  let s = Marshal.to_string A [] in
+  test 112 (match Marshal.from_string s 0 with
+    A -> true
+  | _ -> false);
+  let s = Marshal.to_string (B 1) [] in
+  test 113 (match Marshal.from_string s 0 with
+    (B 1) -> true
+  | _ -> false);
+  let s = Marshal.to_string (C 2.718) [] in
+  test 114 (match Marshal.from_string s 0 with
+    (C f) -> f = 2.718
+  | _ -> false);
+  let s = Marshal.to_string (D "hello, world!") [] in
+  test 115 (match Marshal.from_string s 0 with
+    (D "hello, world!") -> true
+  | _ -> false);
+  let s = Marshal.to_string (E 'l') [] in
+  test 116 (match Marshal.from_string s 0 with
+    (E 'l') -> true
+  | _ -> false);
+  let s = Marshal.to_string (F(B 1)) [] in
+  test 117 (match Marshal.from_string s 0 with
+    (F(B 1)) -> true
+  | _ -> false);
+  let s = Marshal.to_string (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) [] in
+  test 118 (match Marshal.from_string s 0 with
+    (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) -> true
+  | _ -> false);
+  let s = Marshal.to_string (H(1, A)) [] in
+  test 119 (match Marshal.from_string s 0 with
+    (H(1, A)) -> true
+  | _ -> false);
+  let s = Marshal.to_string (I(B 2, 1e-6)) [] in
+  test 120 (match Marshal.from_string s 0 with
+    (I(B 2, 1e-6)) -> true
+  | _ -> false);
+  let x = D "sharing" in
+  let y = G(x, x) in
+  let z = G(y, G(x, y)) in
+  let s = Marshal.to_string z [] in
+  test 121 (match Marshal.from_string s 0 with
+    G((G((D "sharing" as t1), t2) as t3), G(t4, t5)) ->
+      t1 == t2 && t3 == t5 && t4 == t1
+  | _ -> false);
+  let s = Marshal.to_string [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|] [] in
+  test 122
+       (Marshal.from_string s 0 = [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]);
+  let rec big n = if n <= 0 then A else H(n, big(n-1)) in
+  let s = Marshal.to_string (big 1000) [] in
+  let rec check_big n t =
+    if n <= 0 then
+      test 123 (match t with A -> true | _ -> false)
+    else
+      match t with H(m, s) -> if m = n then check_big (n-1) s
+                                       else test 123 false
+                 | _ -> test 123 false
+  in
+    check_big 1000 (Marshal.from_string s 0)
+
+let marshal_to_buffer s start len v flags =
+  ignore (Marshal.to_buffer s start len v flags)
+;;
+
+let test_buffer () =
+  let s = Bytes.create 512 in
+  marshal_to_buffer s 0 512 1 [];
+  test 201 (Marshal.from_bytes s 0 = 1);
+  marshal_to_buffer s 0 512 (-1) [];
+  test 202 (Marshal.from_bytes s 0 = (-1));
+  marshal_to_buffer s 0 512 258 [];
+  test 203 (Marshal.from_bytes s 0 = 258);
+  marshal_to_buffer s 0 512 20000 [];
+  test 204 (Marshal.from_bytes s 0 = 20000);
+  marshal_to_buffer s 0 512 0x12345678 [];
+  test 205 (Marshal.from_bytes s 0 = 0x12345678);
+  marshal_to_buffer s 0 512 bigint [];
+  test 206 (Marshal.from_bytes s 0 = bigint);
+  marshal_to_buffer s 0 512 "foobargeebuz" [];
+  test 207 (Marshal.from_bytes s 0 = "foobargeebuz");
+  marshal_to_buffer s 0 512 longstring [];
+  test 208 (Marshal.from_bytes s 0 = longstring);
+  test 209
+    (try marshal_to_buffer s 0 512 verylongstring []; false
+     with Failure s when s = "Marshal.to_buffer: buffer overflow" -> true);
+  marshal_to_buffer s 0 512 3.141592654 [];
+  test 210 (Marshal.from_bytes s 0 = 3.141592654);
+  marshal_to_buffer s 0 512 () [];
+  test 211 (Marshal.from_bytes s 0 = ());
+  marshal_to_buffer s 0 512 A [];
+  test 212 (match Marshal.from_bytes s 0 with
+    A -> true
+  | _ -> false);
+  marshal_to_buffer s 0 512 (B 1) [];
+  test 213 (match Marshal.from_bytes s 0 with
+    (B 1) -> true
+  | _ -> false);
+  marshal_to_buffer s 0 512 (C 2.718) [];
+  test 214 (match Marshal.from_bytes s 0 with
+    (C f) -> f = 2.718
+  | _ -> false);
+  marshal_to_buffer s 0 512 (D "hello, world!") [];
+  test 215 (match Marshal.from_bytes s 0 with
+    (D "hello, world!") -> true
+  | _ -> false);
+  marshal_to_buffer s 0 512 (E 'l') [];
+  test 216 (match Marshal.from_bytes s 0 with
+    (E 'l') -> true
+  | _ -> false);
+  marshal_to_buffer s 0 512 (F(B 1)) [];
+  test 217 (match Marshal.from_bytes s 0 with
+    (F(B 1)) -> true
+  | _ -> false);
+  marshal_to_buffer s 0 512 (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) [];
+  test 218 (match Marshal.from_bytes s 0 with
+    (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) -> true
+  | _ -> false);
+  marshal_to_buffer s 0 512 (H(1, A)) [];
+  test 219 (match Marshal.from_bytes s 0 with
+    (H(1, A)) -> true
+  | _ -> false);
+  marshal_to_buffer s 0 512 (I(B 2, 1e-6)) [];
+  test 220 (match Marshal.from_bytes s 0 with
+    (I(B 2, 1e-6)) -> true
+  | _ -> false);
+  let x = D "sharing" in
+  let y = G(x, x) in
+  let z = G(y, G(x, y)) in
+  marshal_to_buffer s 0 512 z [];
+  test 221 (match Marshal.from_bytes s 0 with
+    G((G((D "sharing" as t1), t2) as t3), G(t4, t5)) ->
+      t1 == t2 && t3 == t5 && t4 == t1
+  | _ -> false);
+  marshal_to_buffer s 0 512 [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|] [];
+  test 222
+       (Marshal.from_bytes s 0 = [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]);
+  let rec big n = if n <= 0 then A else H(n, big(n-1)) in
+  test 223
+    (try marshal_to_buffer s 0 512 (big 1000) []; false
+     with Failure s when s = "Marshal.to_buffer: buffer overflow" -> true)
+
+let test_size() =
+  let s = Marshal.to_bytes (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) [] in
+  test 300 (Marshal.header_size + Marshal.data_size s 0 = Bytes.length s)
+
+external marshal_to_block
+   : string -> int -> 'a -> Marshal.extern_flags list -> unit
+   = "marshal_to_block"
+external marshal_from_block : string -> int -> 'a = "marshal_from_block"
+external static_alloc : int -> string = "caml_static_alloc"
+
+let test_block () =
+  let s = static_alloc 512 in
+  marshal_to_block s 512 1 [];
+  test 401 (marshal_from_block s 512 = 1);
+  marshal_to_block s 512 (-1) [];
+  test 402 (marshal_from_block s 512 = (-1));
+  marshal_to_block s 512 258 [];
+  test 403 (marshal_from_block s 512 = 258);
+  marshal_to_block s 512 20000 [];
+  test 404 (marshal_from_block s 512 = 20000);
+  marshal_to_block s 512 0x12345678 [];
+  test 405 (marshal_from_block s 512 = 0x12345678);
+  marshal_to_block s 512 bigint [];
+  test 406 (marshal_from_block s 512 = bigint);
+  marshal_to_block s 512 "foobargeebuz" [];
+  test 407 (marshal_from_block s 512 = "foobargeebuz");
+  marshal_to_block s 512 longstring [];
+  test 408 (marshal_from_block s 512 = longstring);
+  test 409
+    (try marshal_to_block s 512 verylongstring []; false
+     with Failure s when s = "Marshal.to_buffer: buffer overflow" -> true);
+  marshal_to_block s 512 3.141592654 [];
+  test 410 (marshal_from_block s 512 = 3.141592654);
+  marshal_to_block s 512 () [];
+  test 411 (marshal_from_block s 512 = ());
+  marshal_to_block s 512 A [];
+  test 412 (match marshal_from_block s 512 with
+    A -> true
+  | _ -> false);
+  marshal_to_block s 512 (B 1) [];
+  test 413 (match marshal_from_block s 512 with
+    (B 1) -> true
+  | _ -> false);
+  marshal_to_block s 512 (C 2.718) [];
+  test 414 (match marshal_from_block s 512 with
+    (C f) -> f = 2.718
+  | _ -> false);
+  marshal_to_block s 512 (D "hello, world!") [];
+  test 415 (match marshal_from_block s 512 with
+    (D "hello, world!") -> true
+  | _ -> false);
+  marshal_to_block s 512 (E 'l') [];
+  test 416 (match marshal_from_block s 512 with
+    (E 'l') -> true
+  | _ -> false);
+  marshal_to_block s 512 (F(B 1)) [];
+  test 417 (match marshal_from_block s 512 with
+    (F(B 1)) -> true
+  | _ -> false);
+  marshal_to_block s 512 (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) [];
+  test 418 (match marshal_from_block s 512 with
+    (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) -> true
+  | _ -> false);
+  marshal_to_block s 512 (H(1, A)) [];
+  test 419 (match marshal_from_block s 512 with
+    (H(1, A)) -> true
+  | _ -> false);
+  marshal_to_block s 512 (I(B 2, 1e-6)) [];
+  test 420 (match marshal_from_block s 512 with
+    (I(B 2, 1e-6)) -> true
+  | _ -> false);
+  let x = D "sharing" in
+  let y = G(x, x) in
+  let z = G(y, G(x, y)) in
+  marshal_to_block s 512 z [];
+  test 421 (match marshal_from_block s 512 with
+    G((G((D "sharing" as t1), t2) as t3), G(t4, t5)) ->
+      t1 == t2 && t3 == t5 && t4 == t1
+  | _ -> false);
+  marshal_to_block s 512 [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|] [];
+  test 422 (marshal_from_block s 512 =
+            [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]);
+  let rec big n = if n <= 0 then A else H(n, big(n-1)) in
+  test 423
+    (try marshal_to_block s 512 (big 1000) []; false
+     with Failure _ -> true);
+  test 424
+    (try marshal_to_block s 512 "Hello, world!" [];
+         ignore (marshal_from_block s 8);
+         false
+     with Failure _ -> true)
+
+(* Test for really big objects *)
+
+let counter = ref 0
+
+let rec make_big n =
+  if n <= 0 then begin
+    incr counter; B !counter
+  end else begin
+    let l = make_big (n-1) in
+    let r = make_big (n-1) in
+    G(l, r)
+  end
+
+let rec check_big n x =
+  if n <= 0 then begin
+    match x with
+      B k -> incr counter; k = !counter
+    | _   -> false
+  end else begin
+    match x with
+      G(l, r) -> check_big (n-1) l && check_big (n-1) r
+    | _       -> false
+  end
+
+(* Test for really deep data structures *)
+let test_deep () =
+  (* Right-leaning *)
+  let rec loop acc i =
+    if i < max_data_depth
+    then loop (i :: acc) (i+1)
+    else acc in
+  let x = loop [] 0 in
+  let s = Marshal.to_string x [] in
+  test 425 (Marshal.from_string s 0 = x);
+  (* Left-leaning *)
+  let rec loop acc i =
+    if i < max_data_depth
+    then loop (G(acc, B i)) (i+1)
+    else acc in
+  let x = loop A 0 in
+  let s = Marshal.to_string x [] in
+  test 426 (Marshal.from_string s 0 = x)
+
+(* Test for objects *)
+class foo = object (self : 'self)
+  val data1 = "foo"
+  val data2 = "bar"
+  val data3 = 42L
+  method test1 = data1 ^ data2
+  method test2 = false
+  method test3 = self#test1
+  method test4 = data3
+end
+
+class bar = object (self : 'self)
+  inherit foo as super
+  val! data2 = "test5"
+  val data4 = "test3"
+  val data5 = "test4"
+  method test1 =
+    data1
+  ^ data2
+  ^ data4
+  ^ data5
+  ^ Int64.to_string self#test4
+end
+
+class foobar = object (self : 'self)
+  inherit foo as super
+  inherit! bar
+end
+
+(* Test for objects *)
+let test_objects () =
+  let x = new foo in
+  let s = Marshal.to_string x [Marshal.Closures] in
+  let x = Marshal.from_string s 0 in
+  test 500 (x#test1 = "foobar");
+  test 501 (x#test2 = false);
+  test 502 (x#test3 = "foobar");
+  test 503 (x#test4 = 42L);
+  let x = new bar in
+  let s = Marshal.to_string x [Marshal.Closures] in
+  let x = Marshal.from_string s 0 in
+  test 504 (x#test1 = "footest5test3test442");
+  test 505 (x#test2 = false);
+  test 506 (x#test3 = "footest5test3test442");
+  test 507 (x#test4 = 42L);
+  let x0 = new foobar in
+  let s = Marshal.to_string x0 [Marshal.Closures] in
+  let x = Marshal.from_string s 0 in
+  test 508 (x#test1 = "footest5test3test442");
+  test 509 (x#test2 = false);
+  test 510 (x#test3 = "footest5test3test442");
+  test 511 (x#test4 = 42L);
+  test 512 (Oo.id x = Oo.id x0 + 1)     (* PR#5610 *)
+
+(* Test for infix pointers *)
+let test_infix () =
+  let t = true and
+      f = false in
+  let rec odd n =
+    if n = 0
+    then f
+    else even (n-1)
+  and even n =
+    if n = 0
+    then t
+    else odd (n-1)
+  in
+  let s = Marshal.to_string (odd, even) [Marshal.Closures] in
+  let (odd', even': (int -> bool) * (int -> bool)) = Marshal.from_string s 0 in
+  test 600 (odd' 41 = true);
+  test 601 (odd' 41 = odd 41);
+  test 602 (odd' 142 = false);
+  test 603 (odd' 142 = odd 142);
+  test 604 (even' 41 = false);
+  test 605 (even' 41 = even 41);
+  test 606 (even' 142 = true);
+  test 607 (even' 142 = even 142)
+
+
+let test_mutual_rec_regression () =
+  (* this regression was reported by Cedric Pasteur in PR#5772 *)
+  let rec test_one q x = x > 3
+  and test_list q = List.for_all (test_one q) q in
+  let g () = () in
+  let f q = if test_list q then g () in
+
+  test 700 (try ignore (Marshal.to_string f [Marshal.Closures]); true
+            with _ -> false)
+
+let test_end_of_file_regression () =
+  (* See PR#7142 *)
+  let write oc n =
+    for k = 0 to n - 1 do
+      Marshal.to_channel oc k []
+    done
+  in
+  let read ic n =
+    let k = ref 0 in
+    try
+      while true do
+        if Marshal.from_channel ic != !k then
+          failwith "unexpected integer";
+        incr k
+      done
+    with
+      | End_of_file when !k != n -> failwith "missing integer"
+      | End_of_file -> ()
+  in
+  test 800 (
+    try
+      let n = 100 in
+      let oc = open_out_bin "intext.data" in
+      write oc n;
+      close_out oc;
+
+      let ic = open_in_bin "intext.data" in
+      try
+        read ic n;
+        close_in ic;
+        true
+      with _ ->
+        close_in ic;
+        false
+    with _ -> false
+  )
+
+external init_buggy_custom_ops : unit -> unit =
+  "init_buggy_custom_ops"
+let () = init_buggy_custom_ops ()
+type buggy
+external value_with_buggy_serialiser : unit -> buggy =
+  "value_with_buggy_serialiser"
+let test_buggy_serialisers () =
+  let x = value_with_buggy_serialiser () in
+  let s = Marshal.to_string x [] in
+  match Marshal.from_string s 0 with
+  | exception (Failure _) -> ()
+  | _ ->
+     failwith "Marshalling should not have succeeded with a bad serialiser!"
+
+let main() =
+  if Array.length Sys.argv <= 2 then begin
+    test_out "intext.data"; test_in "intext.data";
+    test_out "intext.data"; test_in "intext.data";
+    test_string();
+    test_buffer();
+    test_size();
+    test_block();
+    test_deep();
+    test_objects();
+    test_infix ();
+    test_mutual_rec_regression ();
+    test_end_of_file_regression ();
+    test_buggy_serialisers ();
+    Sys.remove "intext.data";
+  end else
+  if Sys.argv.(1) = "make" then begin
+    let n = int_of_string Sys.argv.(2) in
+    let oc = open_out_bin "intext.data" in
+    counter := 0;
+    output_value oc (make_big n);
+    close_out oc
+  end else
+  if Sys.argv.(1) = "test" then begin
+    let n = int_of_string Sys.argv.(2) in
+    let ic = open_in_bin "intext.data" in
+    let b = (input_value ic : t) in
+    Gc.full_major();
+    close_in ic;
+    counter := 0;
+    if check_big n b then
+      Printf.printf "Test big %d passed" n
+    else
+      Printf.printf "Test big %d FAILED" n;
+    print_newline()
+  end
+
+let _ = Printexc.catch main (); exit 0
diff --git a/testsuite/tests/lib-marshal/intext.reference b/testsuite/tests/lib-marshal/intext.reference
new file mode 100644
index 00000000..412cea0c
--- /dev/null
+++ b/testsuite/tests/lib-marshal/intext.reference
@@ -0,0 +1,174 @@
+Test 1 passed.
+Test 2 passed.
+Test 3 passed.
+Test 4 passed.
+Test 5 passed.
+Test 6 passed.
+Test 7 passed.
+Test 8 passed.
+Test 9 passed.
+Test 10 passed.
+Test 11 passed.
+Test 12 passed.
+Test 13 passed.
+Test 14 passed.
+Test 15 passed.
+Test 16 passed.
+Test 17 passed.
+Test 18 passed.
+Test 19 passed.
+Test 20 passed.
+Test 21 passed.
+Test 22 passed.
+Test 23 passed.
+Test 24 passed.
+Test 25 passed.
+Test 26 passed.
+Test 27 passed.
+Test 28 passed.
+Test 29 passed.
+Test 30 passed.
+Test 31 passed.
+Test 32 passed.
+Test 33 passed.
+Test 34 passed.
+Test 35 passed.
+Test 36 passed.
+Test 37 passed.
+Test 38 passed.
+Test 39 passed.
+Test 1 passed.
+Test 2 passed.
+Test 3 passed.
+Test 4 passed.
+Test 5 passed.
+Test 6 passed.
+Test 7 passed.
+Test 8 passed.
+Test 9 passed.
+Test 10 passed.
+Test 11 passed.
+Test 12 passed.
+Test 13 passed.
+Test 14 passed.
+Test 15 passed.
+Test 16 passed.
+Test 17 passed.
+Test 18 passed.
+Test 19 passed.
+Test 20 passed.
+Test 21 passed.
+Test 22 passed.
+Test 23 passed.
+Test 24 passed.
+Test 25 passed.
+Test 26 passed.
+Test 27 passed.
+Test 28 passed.
+Test 29 passed.
+Test 30 passed.
+Test 31 passed.
+Test 32 passed.
+Test 33 passed.
+Test 34 passed.
+Test 35 passed.
+Test 36 passed.
+Test 37 passed.
+Test 38 passed.
+Test 39 passed.
+Test 101 passed.
+Test 102 passed.
+Test 103 passed.
+Test 104 passed.
+Test 105 passed.
+Test 106 passed.
+Test 107 passed.
+Test 108 passed.
+Test 109 passed.
+Test 110 passed.
+Test 111 passed.
+Test 112 passed.
+Test 113 passed.
+Test 114 passed.
+Test 115 passed.
+Test 116 passed.
+Test 117 passed.
+Test 118 passed.
+Test 119 passed.
+Test 120 passed.
+Test 121 passed.
+Test 122 passed.
+Test 123 passed.
+Test 201 passed.
+Test 202 passed.
+Test 203 passed.
+Test 204 passed.
+Test 205 passed.
+Test 206 passed.
+Test 207 passed.
+Test 208 passed.
+Test 209 passed.
+Test 210 passed.
+Test 211 passed.
+Test 212 passed.
+Test 213 passed.
+Test 214 passed.
+Test 215 passed.
+Test 216 passed.
+Test 217 passed.
+Test 218 passed.
+Test 219 passed.
+Test 220 passed.
+Test 221 passed.
+Test 222 passed.
+Test 223 passed.
+Test 300 passed.
+Test 401 passed.
+Test 402 passed.
+Test 403 passed.
+Test 404 passed.
+Test 405 passed.
+Test 406 passed.
+Test 407 passed.
+Test 408 passed.
+Test 409 passed.
+Test 410 passed.
+Test 411 passed.
+Test 412 passed.
+Test 413 passed.
+Test 414 passed.
+Test 415 passed.
+Test 416 passed.
+Test 417 passed.
+Test 418 passed.
+Test 419 passed.
+Test 420 passed.
+Test 421 passed.
+Test 422 passed.
+Test 423 passed.
+Test 424 passed.
+Test 425 passed.
+Test 426 passed.
+Test 500 passed.
+Test 501 passed.
+Test 502 passed.
+Test 503 passed.
+Test 504 passed.
+Test 505 passed.
+Test 506 passed.
+Test 507 passed.
+Test 508 passed.
+Test 509 passed.
+Test 510 passed.
+Test 511 passed.
+Test 512 passed.
+Test 600 passed.
+Test 601 passed.
+Test 602 passed.
+Test 603 passed.
+Test 604 passed.
+Test 605 passed.
+Test 606 passed.
+Test 607 passed.
+Test 700 passed.
+Test 800 passed.
diff --git a/testsuite/tests/lib-marshal/intextaux.c b/testsuite/tests/lib-marshal/intextaux.c
new file mode 100644
index 00000000..d8ea180a
--- /dev/null
+++ b/testsuite/tests/lib-marshal/intextaux.c
@@ -0,0 +1,64 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2001 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/intext.h>
+#include <caml/custom.h>
+
+#define CAML_INTERNALS
+
+value marshal_to_block(value vbuf, value vlen, value v, value vflags)
+{
+  return Val_long(caml_output_value_to_block(v, vflags,
+                                        (char *) vbuf, Long_val(vlen)));
+}
+
+value marshal_from_block(value vbuf, value vlen)
+{
+  return caml_input_value_from_block((char *) vbuf, Long_val(vlen));
+}
+
+static void bad_serialize(value v, uintnat* sz_32, uintnat* sz_64)
+{
+  caml_serialize_int_4(42);
+  *sz_32 = *sz_64 = 100;
+}
+
+static uintnat bad_deserialize(void* dst)
+{
+  return 10;
+}
+
+static struct custom_operations buggy_ops = {
+  "foo",
+  custom_finalize_default,
+  custom_compare_default,
+  custom_hash_default,
+  bad_serialize,
+  bad_deserialize,
+  custom_compare_ext_default,
+  custom_fixed_length_default
+};
+
+value init_buggy_custom_ops()
+{
+  caml_register_custom_operations(&buggy_ops);
+  return Val_unit;
+}
+
+value value_with_buggy_serialiser()
+{
+  return caml_alloc_custom(&buggy_ops, 20, 0, 1);
+}
diff --git a/testsuite/tests/lib-marshal/marshal_bigarray.ml b/testsuite/tests/lib-marshal/marshal_bigarray.ml
new file mode 100644
index 00000000..71d8310d
--- /dev/null
+++ b/testsuite/tests/lib-marshal/marshal_bigarray.ml
@@ -0,0 +1,14 @@
+(* TEST *)
+
+let () =
+  let small = 0xfffe and large = 0xffff in
+  let marshalled dim =
+    let ba = Bigarray.(Array1.create int8_unsigned c_layout dim) in
+    Marshal.to_string ba []
+  in
+  (* Bigarray dimension marshalling scheme: use an extra 8 bytes
+     to marshal dimensions >=0xffff to avoid overflow *)
+  assert
+    (((String.length (marshalled large) - String.length (marshalled small))
+      - (large - small))
+     = 8)
diff --git a/testsuite/tests/lib-marshal/marshal_bigarray.reference b/testsuite/tests/lib-marshal/marshal_bigarray.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/lib-obj/reachable_words.ml b/testsuite/tests/lib-obj/reachable_words.ml
new file mode 100644
index 00000000..1c1709ad
--- /dev/null
+++ b/testsuite/tests/lib-obj/reachable_words.ml
@@ -0,0 +1,40 @@
+(* TEST
+*)
+
+let native =
+  match Sys.backend_type with
+  | Sys.Native -> true
+  | Sys.Bytecode -> false
+  | Sys.Other s -> print_endline s; assert false
+
+
+let size x = Obj.reachable_words (Obj.repr x)
+
+let expect_size s x =
+  let i = size x in
+  if i <> s then
+    Printf.printf "size = %i; expected = %i\n%!" i s
+
+type t =
+  | A of int
+  | B of t * t
+
+let f () =
+  let x = Random.int 10 in
+  expect_size 0 42;
+  expect_size (if native then 0 else 3) (1, 2);
+  expect_size 2 [| x |];
+  expect_size 3 [| x; 0 |];
+
+  let a = A x in
+  expect_size 2 a;
+  expect_size 5 (B (a, a)); (* sharing *)
+  expect_size 7 (B (a, A (x + 1)));
+
+  let rec b = B (a, b) in (* cycle *)
+  expect_size 5 b;
+
+  print_endline "OK"
+
+let () =
+  f ()
diff --git a/testsuite/tests/lib-obj/reachable_words.reference b/testsuite/tests/lib-obj/reachable_words.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-obj/reachable_words.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-obj/with_tag.ml b/testsuite/tests/lib-obj/with_tag.ml
new file mode 100644
index 00000000..a4b69ea1
--- /dev/null
+++ b/testsuite/tests/lib-obj/with_tag.ml
@@ -0,0 +1,31 @@
+(* TEST
+*)
+
+type t =
+| A of string * float
+| B of string * float
+
+let () =
+  assert (Obj.dup (Obj.repr (A ("hello", 10.))) = Obj.repr (A ("hello", 10.)));
+  assert (Obj.with_tag 1 (Obj.repr (A ("hello", 10.))) = Obj.repr (B ("hello", 10.)))
+
+let () =
+  assert (Obj.tag (Obj.with_tag 42 (Obj.repr [| |])) = 42)
+
+(* check optimisations *)
+let raw_allocs f =
+  let before = Gc.minor_words () in
+  f ();
+  let after = Gc.minor_words () in
+  int_of_float (after -. before)
+
+let allocs =
+  let overhead = raw_allocs (fun () -> ()) in
+  fun f -> raw_allocs f - overhead
+
+let () =
+  assert (allocs (fun () -> Obj.with_tag 1 (Obj.repr (A ("hello", 10.)))) = 0);
+  assert (allocs (fun () -> Obj.with_tag 1 (Obj.repr (ref 10))) = 2)
+
+let () =
+  print_endline "ok"
diff --git a/testsuite/tests/lib-obj/with_tag.reference b/testsuite/tests/lib-obj/with_tag.reference
new file mode 100644
index 00000000..9766475a
--- /dev/null
+++ b/testsuite/tests/lib-obj/with_tag.reference
@@ -0,0 +1 @@
+ok
diff --git a/testsuite/tests/lib-option/test.ml b/testsuite/tests/lib-option/test.ml
new file mode 100644
index 00000000..316e3eae
--- /dev/null
+++ b/testsuite/tests/lib-option/test.ml
@@ -0,0 +1,117 @@
+(* TEST
+*)
+
+let strf = Printf.sprintf
+let assert_raise_invalid_argument f v =
+  assert (try ignore (f v); false with Invalid_argument _ -> true);
+  ()
+
+let test_none_some () =
+  assert (Option.none = None);
+  assert (Option.some 2 = Some 2);
+  ()
+
+let test_value () =
+  assert (Option.value None ~default:5 = 5);
+  assert (Option.value (Some 3) ~default:5 = 3);
+  ()
+
+let test_get () =
+  assert_raise_invalid_argument Option.get None;
+  assert (Option.get (Some 2) = 2);
+  ()
+
+let test_bind () =
+  assert (Option.bind (Some 3) (fun x -> Some (succ x)) = Some 4);
+  assert (Option.bind (Some 3) (fun _ -> None) = None);
+  assert (Option.bind None (fun x -> Some (succ x)) = None);
+  assert (Option.bind None (fun _ -> None) = None);
+  ()
+
+let test_join () =
+  assert (Option.join (Some (Some 3)) = Some 3);
+  assert (Option.join (Some None) = None);
+  assert (Option.join None = None);
+  ()
+
+let test_map () =
+  assert (Option.map succ (Some 3) = Some 4);
+  assert (Option.map succ None = None);
+  ()
+
+let test_fold () =
+  assert (Option.fold ~none:3 ~some:succ (Some 1) = 2);
+  assert (Option.fold ~none:3 ~some:succ None = 3);
+  assert (Option.(fold ~none ~some) (Some 1) = (Some 1));
+  assert (Option.(fold ~none ~some) None = None);
+  ()
+
+let test_iter () =
+  let count = ref 0 in
+  let set_count x = count := x in
+  assert (!count = 0);
+  Option.iter set_count (Some 2); assert (!count = 2);
+  Option.iter set_count None; assert (!count = 2);
+  ()
+
+let test_is_none_some () =
+  assert (Option.is_none None = true);
+  assert (Option.is_some None = false);
+  assert (Option.is_none (Some 2) = false);
+  assert (Option.is_some (Some 2) = true);
+  ()
+
+let test_equal () =
+  let eq v0 v1 = (v0 mod 2) = (v1 mod 2) in
+  let equal = Option.equal eq in
+  assert (not @@ equal (Some 2) (Some 3));
+  assert (       equal (Some 2) (Some 4));
+  assert (not @@ equal (Some 2) None);
+  assert (not @@ equal None (Some 3));
+  assert (not @@ equal None (Some 4));
+  assert (       equal None None);
+  ()
+
+let test_compare () =
+  let compare v0 v1 = - (compare v0 v1) in
+  let compare = Option.compare compare in
+  assert (compare (Some 2) (Some 1) = -1);
+  assert (compare (Some 2) (Some 2) = 0);
+  assert (compare (Some 2) (Some 3) = 1);
+  assert (compare (Some 2) None = 1);
+  assert (compare None (Some 1) = -1);
+  assert (compare None (Some 2) = -1);
+  assert (compare None (Some 3) = -1);
+  assert (compare None None = 0);
+  ()
+
+let test_to_option_list_seq () =
+  assert (Option.to_result ~none:6 (Some 3) = Ok 3);
+  assert (Option.to_result ~none:6 None = Error 6);
+  assert (Option.to_list (Some 3) = [3]);
+  assert (Option.to_list None = []);
+  begin match (Option.to_seq (Some 3)) () with
+  | Seq.Cons (3, f) -> assert (f () = Seq.Nil)
+  | _ -> assert false
+  end;
+  assert ((Option.to_seq None) () = Seq.Nil);
+  ()
+
+let tests () =
+  test_none_some ();
+  test_value ();
+  test_get ();
+  test_bind ();
+  test_join ();
+  test_map ();
+  test_fold ();
+  test_iter ();
+  test_is_none_some ();
+  test_equal ();
+  test_compare ();
+  test_to_option_list_seq ();
+  ()
+
+let () =
+  tests ();
+  print_endline "OK"
diff --git a/testsuite/tests/lib-option/test.reference b/testsuite/tests/lib-option/test.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-option/test.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-printf/pr6534.ml b/testsuite/tests/lib-printf/pr6534.ml
new file mode 100644
index 00000000..f2329460
--- /dev/null
+++ b/testsuite/tests/lib-printf/pr6534.ml
@@ -0,0 +1,23 @@
+(* TEST
+   include testing
+*)
+
+(* these are not valid under -strict-formats, but we test them here
+   for backward-compatibility *)
+open Printf
+
+let () =
+  printf "1 [%.5s]\n" "foo";
+  printf "2 [%.*s]\n" 5 "foo";
+  printf "3 [%.-5s]\n" "foo";
+  printf "4 [%-.5s]\n" "foo";
+  printf "5 [%-.*s]\n" 5 "foo";
+  printf "6 [%.*s]\n" (-5) "foo";
+
+  printf "1 [%.7S]\n" "foo";
+  printf "2 [%.*S]\n" 7 "foo";
+  printf "3 [%.-7S]\n" "foo";
+  printf "4 [%-.7S]\n" "foo";
+  printf "5 [%-.*S]\n" 7 "foo";
+  printf "6 [%.*S]\n" (-7) "foo";
+  ()
diff --git a/testsuite/tests/lib-printf/pr6534.reference b/testsuite/tests/lib-printf/pr6534.reference
new file mode 100644
index 00000000..c3e2a7ff
--- /dev/null
+++ b/testsuite/tests/lib-printf/pr6534.reference
@@ -0,0 +1,14 @@
+1 [  foo]
+2 [  foo]
+3 [foo  ]
+4 [foo  ]
+5 [foo  ]
+6 [foo  ]
+1 [  "foo"]
+2 [  "foo"]
+3 ["foo"  ]
+4 ["foo"  ]
+5 ["foo"  ]
+6 ["foo"  ]
+
+All tests succeeded.
diff --git a/testsuite/tests/lib-printf/pr6938.ml b/testsuite/tests/lib-printf/pr6938.ml
new file mode 100644
index 00000000..b4ab3fc1
--- /dev/null
+++ b/testsuite/tests/lib-printf/pr6938.ml
@@ -0,0 +1,46 @@
+(* TEST
+   include testing
+*)
+
+(* these are not valid under -strict-formats, but we test them here
+   for backward-compatibility *)
+
+Printf.printf "%047.27d\n" 1036201459;;
+Printf.printf "%047.27ld\n" 1036201459l;;
+Printf.printf "%047.27Ld\n" 1036201459L;;
+Printf.printf "%047.27nd\n" 1036201459n;;
+
+print_newline ();;
+
+Printf.printf "%047.27i\n" 1036201459;;
+Printf.printf "%047.27li\n" 1036201459l;;
+Printf.printf "%047.27Li\n" 1036201459L;;
+Printf.printf "%047.27ni\n" 1036201459n;;
+
+print_newline ();;
+
+Printf.printf "%047.27u\n" 1036201459;;
+Printf.printf "%047.27lu\n" 1036201459l;;
+Printf.printf "%047.27Lu\n" 1036201459L;;
+Printf.printf "%047.27nu\n" 1036201459n;;
+
+print_newline ();;
+
+Printf.printf "%047.27x\n" 1036201459;;
+Printf.printf "%047.27lx\n" 1036201459l;;
+Printf.printf "%047.27Lx\n" 1036201459L;;
+Printf.printf "%047.27nx\n" 1036201459n;;
+
+print_newline ();;
+
+Printf.printf "%047.27X\n" 1036201459;;
+Printf.printf "%047.27lX\n" 1036201459l;;
+Printf.printf "%047.27LX\n" 1036201459L;;
+Printf.printf "%047.27nX\n" 1036201459n;;
+
+print_newline ();;
+
+Printf.printf "%047.27o\n" 1036201459;;
+Printf.printf "%047.27lo\n" 1036201459l;;
+Printf.printf "%047.27Lo\n" 1036201459L;;
+Printf.printf "%047.27no\n" 1036201459n;;
diff --git a/testsuite/tests/lib-printf/pr6938.reference b/testsuite/tests/lib-printf/pr6938.reference
new file mode 100644
index 00000000..3e5e220d
--- /dev/null
+++ b/testsuite/tests/lib-printf/pr6938.reference
@@ -0,0 +1,31 @@
+                    000000000000000001036201459
+                    000000000000000001036201459
+                    000000000000000001036201459
+                    000000000000000001036201459
+
+                    000000000000000001036201459
+                    000000000000000001036201459
+                    000000000000000001036201459
+                    000000000000000001036201459
+
+                    000000000000000001036201459
+                    000000000000000001036201459
+                    000000000000000001036201459
+                    000000000000000001036201459
+
+                    00000000000000000003dc32df3
+                    00000000000000000003dc32df3
+                    00000000000000000003dc32df3
+                    00000000000000000003dc32df3
+
+                    00000000000000000003DC32DF3
+                    00000000000000000003DC32DF3
+                    00000000000000000003DC32DF3
+                    00000000000000000003DC32DF3
+
+                    000000000000000007560626763
+                    000000000000000007560626763
+                    000000000000000007560626763
+                    000000000000000007560626763
+
+All tests succeeded.
diff --git a/testsuite/tests/lib-printf/tprintf.ml b/testsuite/tests/lib-printf/tprintf.ml
new file mode 100644
index 00000000..542c93f4
--- /dev/null
+++ b/testsuite/tests/lib-printf/tprintf.ml
@@ -0,0 +1,652 @@
+(* TEST
+   include testing
+*)
+
+(*
+
+A test file for the Printf module.
+
+*)
+
+open Testing;;
+open Printf;;
+
+try
+
+  printf "d/i positive\n%!";
+  test (sprintf "%d/%i" 42 43 = "42/43");
+  test (sprintf "%-4d/%-5i" 42 43 = "42  /43   ");
+  test (sprintf "%04d/%05i" 42 43 = "0042/00043");
+  test (sprintf "%+d/%+i" 42 43 = "+42/+43");
+  test (sprintf "% d/% i" 42 43 = " 42/ 43");
+  test (sprintf "%#d/%#i" 42 43 = "42/43");
+  test (sprintf "%#d/%#i" 123 123 = "123/123");
+  test (sprintf "%#d/%#i" 1234 1234 = "1_234/1_234");
+  test (sprintf "%#d/%#i" 12345 12345 = "12_345/12_345");
+  test (sprintf "%#d/%#i" 123456 123456 = "123_456/123_456");
+  test (sprintf "%#4d/%#5i" 1234 1234 = "1_234/1_234");
+  test (sprintf "%#-6d/%#-7i" 1234 1234 = "1_234 /1_234  ");
+  test (sprintf "%4d/%5i" 42 43 = "  42/   43");
+  test (sprintf "%*d" (-4) 42 = "42  ");
+  test (sprintf "%*d/%*i" 4 42 5 43 = "  42/   43");
+  (*test (sprintf "%-0+#4d/%-0 #5i" 42 43 = "+42 / 43  ");*)
+    (* >> '#' is incompatible with 'd' *)
+
+  printf "\nd/i negative\n%!";
+  test (sprintf "%d/%i" (-42) (-43) = "-42/-43");
+  test (sprintf "%-4d/%-5i" (-42) (-43) = "-42 /-43  ");
+  test (sprintf "%04d/%05i" (-42) (-43) = "-042/-0043");
+  test (sprintf "%+d/%+i" (-42) (-43) = "-42/-43");
+  test (sprintf "% d/% i" (-42) (-43) = "-42/-43");
+  test (sprintf "%#d/%#i" (-42) (-43) = "-42/-43");
+  test (sprintf "%#d/%#i" (-123) (-123) = "-123/-123");
+  test (sprintf "%#d/%#i" (-1234) (-1234) = "-1_234/-1_234");
+  test (sprintf "%#d/%#i" (-12345) (-12345) = "-12_345/-12_345");
+  test (sprintf "%#d/%#i" (-123456) (-123456) = "-123_456/-123_456");
+  test (sprintf "%#4d/%#5i" (-1234) (-1234) = "-1_234/-1_234");
+  test (sprintf "%#-6d/%#-7i" (-1234) (-1234) = "-1_234/-1_234 ");
+  test (sprintf "%4d/%5i" (-42) (-43) = " -42/  -43");
+  test (sprintf "%*d" (-4) (-42) = "-42 ");
+  test (sprintf "%*d/%*i" 4 (-42) 5 (-43) = " -42/  -43");
+  (*test (sprintf "%-0+ #4d/%-0+ #5i" (-42) (-43) = "-42 /-43  ");*)
+    (* >> '0' is incompatible with '-', '#' is incompatible with 'd' *)
+
+  printf "\nu positive\n%!";
+  test (sprintf "%u" 42 = "42");
+  test (sprintf "%-4u" 42 = "42  ");
+  test (sprintf "%04u" 42 = "0042");
+  (*test (sprintf "%+u" 42 = "42");*)
+    (* >> '+' is incompatible with 'u' *)
+  (*test (sprintf "% u" 42 = "42");*)
+    (* >> ' ' is incompatible with 'u' *)
+  test (sprintf "%#u" 42 = "42");
+  test (sprintf "%#u" 123 = "123");
+  test (sprintf "%#u" 1234 = "1_234");
+  test (sprintf "%#u" 12345 = "12_345");
+  test (sprintf "%#u" 123456 = "123_456");
+  test (sprintf "%#4u" 1234 = "1_234");
+  test (sprintf "%#6u" 1234 = " 1_234");
+  test (sprintf "%4u" 42 = "  42");
+  test (sprintf "%*u" 4 42 = "  42");
+  test (sprintf "%*u" (-4) 42 = "42  ");
+
+  printf "\nu negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%u" (-1) = "2147483647");
+     test (sprintf "%#u" (-1) = "2_147_483_647");
+  | 64 ->
+     test (sprintf "%u" (-1) = "9223372036854775807");
+     test (sprintf "%#u" (-1) = "9_223_372_036_854_775_807");
+  | _ -> test false
+  end;
+
+  printf "\nx positive\n%!";
+  test (sprintf "%x" 42 = "2a");
+  test (sprintf "%-4x" 42 = "2a  ");
+  test (sprintf "%04x" 42 = "002a");
+  (*test (sprintf "%+x" 42 = "2a");*)
+    (* >> '+' is incompatible with 'x' *)
+  (*test (sprintf "% x" 42 = "2a");*)
+    (* >> ' ' is incompatible with 'x' *)
+  test (sprintf "%#x" 42 = "0x2a");
+  test (sprintf "%4x" 42 = "  2a");
+  test (sprintf "%*x" 5 42 = "   2a");
+  test (sprintf "%*x" (-5) 42 = "2a   ");
+  test (sprintf "%#*x" 5 42 = " 0x2a");
+  test (sprintf "%#*x" (-5) 42 = "0x2a ");
+  test (sprintf "%#-*x" 5 42 = "0x2a ");
+  test (sprintf "%-0+ #*x" 5 42 = "0x2a ");
+
+  printf "\nx negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%x" (-42) = "7fffffd6");
+  | 64 ->
+     test (sprintf "%x" (-42) = "7fffffffffffffd6");
+  | _ -> test false
+  end;
+
+  printf "\nX positive\n%!";
+  test (sprintf "%X" 42 = "2A");
+  test (sprintf "%-4X" 42 = "2A  ");
+  test (sprintf "%04X" 42 = "002A");
+  (*test (sprintf "%+X" 42 = "2A");*)
+    (* >> '+' is incompatible with 'X' *)
+  (*test (sprintf "% X" 42 = "2A");*)
+    (* >> ' ' is incompatible with 'X' *)
+  test (sprintf "%#X" 42 = "0X2A");
+  test (sprintf "%4X" 42 = "  2A");
+  test (sprintf "%*X" 5 42 = "   2A");
+  (*test (sprintf "%-0+ #*X" 5 42 = "0X2A ");*)
+    (* >> '-' is incompatible with '0' *)
+
+  printf "\nx negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%X" (-42) = "7FFFFFD6");
+  | 64 ->
+     test (sprintf "%X" (-42) = "7FFFFFFFFFFFFFD6");
+  | _ -> test false
+  end;
+
+  printf "\no positive\n%!";
+  test (sprintf "%o" 42 = "52");
+  test (sprintf "%-4o" 42 = "52  ");
+  test (sprintf "%04o" 42 = "0052");
+  (*test (sprintf "%+o" 42 = "52");*)
+    (* >> '+' is incompatible with 'o' *)
+  (*test (sprintf "% o" 42 = "52");*)
+    (* >> '+' is incompatible with 'o' *)
+  test (sprintf "%#o" 42 = "052");
+  test (sprintf "%4o" 42 = "  52");
+  test (sprintf "%*o" 5 42 = "   52");
+  (*test (sprintf "%-0+ #*o" 5 42 = "052  ");*)
+    (* >> '-' is incompatible with 'o' *)
+
+  printf "\no negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%o" (-42) = "17777777726");
+  | 64 ->
+     test (sprintf "%o" (-42) = "777777777777777777726");
+  | _ -> test false
+  end;
+
+  printf "\ns\n%!";
+  test (sprintf "%s" "foo" = "foo");
+  test (sprintf "%-5s" "foo" = "foo  ");
+  (*test (sprintf "%05s" "foo" = "  foo");*)
+    (* >> '0' is incompatible with 's' *)
+  (*test (sprintf "%+s" "foo" = "foo");*)
+    (* >> '+' is incompatible with 's' *)
+  (*test (sprintf "% s" "foo" = "foo");*)
+    (* >> ' ' is incompatible with 's' *)
+  (*test (sprintf "%#s" "foo" = "foo");*)
+    (* >> '#' is incompatible with 's' *)
+  test (sprintf "%5s" "foo" = "  foo");
+  test (sprintf "%1s" "foo" = "foo");
+  test (sprintf "%*s" 6 "foo" = "   foo");
+  test (sprintf "%*s" (-6) "foo" = "foo   ");
+  test (sprintf "%*s" 2 "foo" = "foo");
+  (*test (sprintf "%-0+ #5s" "foo" = "foo  ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 's' *)
+  test (sprintf "%s@" "foo" = "foo@");
+  test (sprintf "%s@inria.fr" "foo" = "foo@inria.fr");
+  test (sprintf "%s@%s" "foo" "inria.fr" = "foo@inria.fr");
+
+  printf "\nS\n%!";
+  test (sprintf "%S" "fo\"o" = "\"fo\\\"o\"");
+(*  test (sprintf "%-5S" "foo" = "\"foo\"  ");   padding not done *)
+(*  test (sprintf "%05S" "foo" = "  \"foo\"");   padding not done *)
+  (*test (sprintf "%+S" "foo" = "\"foo\"");*)
+    (* >> '#' is incompatible with 'S' *)
+  (*test (sprintf "% S" "foo" = "\"foo\"");*)
+    (* >> '#' is incompatible with 'S' *)
+  (*test (sprintf "%#S" "foo" = "\"foo\"");*)
+    (* >> '#' is incompatible with 'S' *)
+(*  test (sprintf "%5S" "foo" = "  \"foo\"");    padding not done *)
+  test (sprintf "%1S" "foo" = "\"foo\"");
+  test (sprintf "%*S" 8 "foo" = "   \"foo\"");
+  test (sprintf "%*S" (-8) "foo" = "\"foo\"   ");
+  test (sprintf "%*S" 2 "foo" = "\"foo\"");
+(*  test (sprintf "%-0+ #5S" "foo" = "\"foo\"  ");  padding not done *)
+  test (sprintf "%S@" "foo" = "\"foo\"@");
+  test (sprintf "%S@inria.fr" "foo" = "\"foo\"@inria.fr");
+  test (sprintf "%S@%S" "foo" "inria.fr" = "\"foo\"@\"inria.fr\"");
+
+  printf "\nc\n%!";
+  test (sprintf "%c" 'c' = "c");
+(*  test (sprintf "%-4c" 'c' = "c   ");    padding not done *)
+(*  test (sprintf "%04c" 'c' = "   c");    padding not done *)
+  (*test (sprintf "%+c" 'c' = "c");*)
+    (* >> '#' is incompatible with 'c' *)
+  (*test (sprintf "% c" 'c' = "c");*)
+    (* >> '#' is incompatible with 'c' *)
+  (*test (sprintf "%#c" 'c' = "c");*)
+    (* >> '#' is incompatible with 'c' *)
+(*  test (sprintf "%4c" 'c' = "   c");     padding not done *)
+(*  test (sprintf "%*c" 2 'c' = " c");     padding not done *)
+(*  test (sprintf "%-0+ #4c" 'c' = "c   ");  padding not done *)
+
+  printf "\nC\n%!";
+  test (sprintf "%C" 'c' = "'c'");
+  test (sprintf "%C" '\'' = "'\\''");
+(*  test (sprintf "%-4C" 'c' = "c   ");    padding not done *)
+(*  test (sprintf "%04C" 'c' = "   c");    padding not done *)
+  (*test (sprintf "%+C" 'c' = "'c'");*)
+    (* >> '+' is incompatible with 'C' *)
+  (*test (sprintf "% C" 'c' = "'c'");*)
+    (* >> ' ' is incompatible with 'C' *)
+  (*test (sprintf "%#C" 'c' = "'c'");*)
+    (* >> '#' is incompatible with 'C' *)
+(*  test (sprintf "%4C" 'c' = "   c");     padding not done *)
+(*  test (sprintf "%*C" 2 'c' = " c");     padding not done *)
+(*  test (sprintf "%-0+ #4C" 'c' = "c   ");  padding not done *)
+
+  printf "\nf\n%!";
+  test (sprintf "%f" (-42.42) = "-42.420000");
+  test (sprintf "%-13f" (-42.42) = "-42.420000   ");
+  test (sprintf "%013f" (-42.42) = "-00042.420000");
+  test (sprintf "%+f" 42.42 = "+42.420000");
+  test (sprintf "% f" 42.42 = " 42.420000");
+  (*test (sprintf "%#f" 42.42 = "42.420000");*)
+    (* >> '#' is incompatible with 'f' *)
+  test (sprintf "%13f" 42.42 = "    42.420000");
+  test (sprintf "%*f" 12 42.42 = "   42.420000");
+  (*test (sprintf "%-0+ #12f" 42.42 = "+42.420000  ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'f' *)
+  test (sprintf "%.3f" (-42.42) = "-42.420");
+  test (sprintf "%.*f" (-3) 42.42 = "42.420");
+    (* dynamically-provided negative precisions are currently silently
+       turned into their absolute value; we could error on this
+       in the future (the behavior is unspecified), but the previous
+       buggy output "%.0-3f-" is not desirable. *)
+  test (sprintf "%-13.3f" (-42.42) = "-42.420      ");
+  test (sprintf "%013.3f" (-42.42) = "-00000042.420");
+  test (sprintf "%+.3f" 42.42 = "+42.420");
+  test (sprintf "% .3f" 42.42 = " 42.420");
+  (*test (sprintf "%#.3f" 42.42 = "42.420");*)
+    (* >> '#' is incompatible with 'f' *)
+  test (sprintf "%13.3f" 42.42 = "       42.420");
+  test (sprintf "%*.*f" 12 3 42.42 = "      42.420");
+  (*test (sprintf "%-0+ #12.3f" 42.42 = "+42.420     ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'f' *)
+
+  (* Under Windows (mingw and maybe also MSVC), the stdlib uses three
+     digits for the exponent instead of the two used by Linux and BSD.
+     Check that the two strings are equal, except that there may be an
+     extra zero, and if there is one, there may be a missing space or
+     zero. All in the first string relative to the second. *)
+  let ( =* ) s1 s2 =
+    let ss1 = s1 ^ "$" in
+    let ss2 = s2 ^ "$" in
+    let rec loop i1 i2 extra missing =
+      if i1 = String.length ss1 && i2 = String.length ss2 then begin
+        if extra then true else not missing
+      end else if i1 = String.length ss1 || i2 = String.length ss2 then
+        false
+      else begin
+        match ss1.[i1], ss2.[i2] with
+        | x, y when x = y -> loop (i1+1) (i2+1) extra missing
+        | '0', _ when not extra -> loop (i1+1) i2 true missing
+        | _, (' '|'0') when not missing -> loop i1 (i2+1) extra true
+        | _, _ -> false
+      end
+    in
+    loop 0 0 false false
+  in
+
+  printf "\nF\n%!";
+  test (sprintf "%F" 42.42 = "42.42");
+  test (sprintf "%F" 42.42e42 =* "4.242e+43");
+  test (sprintf "%F" 42.00 = "42.");
+  test (sprintf "%F" 0.042 = "0.042");
+  test (sprintf "%4F" 3. = "  3.");
+  test (sprintf "%-4F" 3. = "3.  ");
+  test (sprintf "%04F" 3. = "003.");
+  test (sprintf "%+4F" 3. = " +3.");
+  test (sprintf "%.3F" 42.42 = "42.4");
+  test (sprintf "%12.3F" 42.42e42 =* "    4.24e+43");
+  test (sprintf "%.3F" 42.00 = "42.");
+  test (sprintf "%.3F" 0.0042 = "0.0042");
+  test (sprintf "%F" nan = "nan");
+  test (sprintf "%F" (-. nan) = "nan");
+  test (sprintf "%F" infinity = "infinity");
+  test (sprintf "%F" neg_infinity = "neg_infinity");
+
+  printf "\n#F\n%!";
+  test (sprintf "%+#F" (+0.) = "+0x0p+0");
+  test (sprintf "%+#F" (-0.) = "-0x0p+0");
+  test (sprintf "%+#F" (+1.) = "+0x1p+0");
+  test (sprintf "%+#F" (-1.) = "-0x1p+0");
+  test (sprintf "%+#F" (+1024.) = "+0x1p+10");
+  test (sprintf "% #F" (+1024.) = " 0x1p+10");
+  test (sprintf "%+#F" (-1024.) = "-0x1p+10");
+  test (sprintf "%#F" 0x123.456 = "0x1.23456p+8");
+  test (sprintf "%#F" 0x123456789ABCDE. = "0x1.23456789abcdep+52");
+  test (sprintf "%#F" epsilon_float = "0x1p-52");
+  test (sprintf "%#F" nan = "nan");
+  test (sprintf "%#F" (-. nan) = "nan");
+  test (sprintf "%#F" infinity = "infinity");
+  test (sprintf "%#F" neg_infinity = "neg_infinity");
+
+  printf "\nh\n%!";
+  test (sprintf "%+h" (+0.) = "+0x0p+0");
+  test (sprintf "%+h" (-0.) = "-0x0p+0");
+  test (sprintf "%+h" (+1.) = "+0x1p+0");
+  test (sprintf "%+h" (-1.) = "-0x1p+0");
+  test (sprintf "%+h" (+1024.) = "+0x1p+10");
+  test (sprintf "%+h" (-1024.) = "-0x1p+10");
+  test (sprintf "%h" 0x123.456 = "0x1.23456p+8");
+  test (sprintf "%h" 0x123456789ABCDE. = "0x1.23456789abcdep+52");
+  test (sprintf "%h" epsilon_float = "0x1p-52");
+  test (sprintf "%h" nan = "nan");
+  test (sprintf "%h" infinity = "infinity");
+  test (sprintf "%h" neg_infinity = "-infinity");
+  test (sprintf "%h" (4. *. atan 1.) = "0x1.921fb54442d18p+1");
+
+  printf "\nH\n%!";
+  test (sprintf "%+H" (+0.) = "+0X0P+0");
+  test (sprintf "%+H" (-0.) = "-0X0P+0");
+  test (sprintf "%+H" (+1.) = "+0X1P+0");
+  test (sprintf "%+H" (-1.) = "-0X1P+0");
+  test (sprintf "%+H" (+1024.) = "+0X1P+10");
+  test (sprintf "%+H" (-1024.) = "-0X1P+10");
+  test (sprintf "%H" 0X123.456 = "0X1.23456P+8");
+  test (sprintf "%H" 0X123456789ABCDE. = "0X1.23456789ABCDEP+52");
+  test (sprintf "%H" epsilon_float = "0X1P-52");
+  test (sprintf "%H" nan = "NAN");
+  test (sprintf "%H" infinity = "INFINITY");
+  test (sprintf "%H" neg_infinity = "-INFINITY");
+  test (sprintf "%H" (4. *. atan 1.) = "0X1.921FB54442D18P+1");
+
+  printf "\ne\n%!";
+  test (sprintf "%e" (-42.42) =* "-4.242000e+01");
+  test (sprintf "%-15e" (-42.42) =* "-4.242000e+01  ");
+  test (sprintf "%015e" (-42.42) =* "-004.242000e+01");
+  test (sprintf "%+e" 42.42 =* "+4.242000e+01");
+  test (sprintf "% e" 42.42 =* " 4.242000e+01");
+  (*test (sprintf "%#e" 42.42 =* "4.242000e+01");*)
+    (* >> '#' is incompatible with 'e' *)
+  test (sprintf "%15e" 42.42 =* "   4.242000e+01");
+  test (sprintf "%*e" 14 42.42 =* "  4.242000e+01");
+  (*test (sprintf "%-0+ #14e" 42.42 =* "+4.242000e+01 ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'e' *)
+  test (sprintf "%.3e" (-42.42) =* "-4.242e+01");
+  test (sprintf "%-15.3e" (-42.42) =* "-4.242e+01     ");
+  test (sprintf "%015.3e" (-42.42) =* "-000004.242e+01");
+  test (sprintf "%+.3e" 42.42 =* "+4.242e+01");
+  test (sprintf "% .3e" 42.42 =* " 4.242e+01");
+  (*test (sprintf "%#.3e" 42.42 =* "4.242e+01");*)
+    (* >> '#' is incompatible with 'e' *)
+  test (sprintf "%15.3e" 42.42 =* "      4.242e+01");
+  test (sprintf "%*.*e" 11 3 42.42 =* "  4.242e+01");
+  (*test (sprintf "%-0+ #14.3e" 42.42 =* "+4.242e+01    ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'e' *)
+
+  printf "\nE\n%!";
+  test (sprintf "%E" (-42.42) =* "-4.242000E+01");
+  test (sprintf "%-15E" (-42.42) =* "-4.242000E+01  ");
+  test (sprintf "%015E" (-42.42) =* "-004.242000E+01");
+  test (sprintf "%+E" 42.42 =* "+4.242000E+01");
+  test (sprintf "% E" 42.42 =* " 4.242000E+01");
+  (*test (sprintf "%#E" 42.42 =* "4.242000E+01");*)
+    (* >> '#' is incompatible with 'E' *)
+  test (sprintf "%15E" 42.42 =* "   4.242000E+01");
+  test (sprintf "%*E" 14 42.42 =* "  4.242000E+01");
+  (*test (sprintf "%-0+ #14E" 42.42 =* "+4.242000E+01 ");*)
+    (* >> '#' is incompatible with 'E' *)
+  test (sprintf "%.3E" (-42.42) =* "-4.242E+01");
+  test (sprintf "%-15.3E" (-42.42) =* "-4.242E+01     ");
+  test (sprintf "%015.3E" (-42.42) =* "-000004.242E+01");
+  test (sprintf "%+.3E" 42.42 =* "+4.242E+01");
+  test (sprintf "% .3E" 42.42 =* " 4.242E+01");
+  (*test (sprintf "%#.3E" 42.42 =* "4.242E+01");*)
+    (* >> '#' is incompatible with 'E' *)
+  test (sprintf "%15.3E" 42.42 =* "      4.242E+01");
+  test (sprintf "%*.*E" 11 3 42.42 =* "  4.242E+01");
+  (*test (sprintf "%-0+ #14.3E" 42.42 =* "+4.242E+01    ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'E' *)
+
+  printf "\ng\n%!";
+  test (sprintf "%g" (-42.42) = "-42.42");
+  test (sprintf "%.3g" (-4242.) =* "-4.24e+03");
+  test (sprintf "%-15g" (-42.42) = "-42.42         ");
+  test (sprintf "%015g" (-42.42) = "-00000000042.42");
+  test (sprintf "%+g" 42.42 = "+42.42");
+  test (sprintf "% g" 42.42 = " 42.42");
+  test (sprintf "%15g" 42.42 = "          42.42");
+  test (sprintf "%*g" 14 42.42 = "         42.42");
+  test (sprintf "%.3g" (-42.42) = "-42.4");
+
+  printf "\nG\n%!";
+  test (sprintf "%G" (-42.42) = "-42.42");
+  test (sprintf "%.3G" (-4242.) =* "-4.24E+03");
+  test (sprintf "%-15G" (-42.42) = "-42.42         ");
+  test (sprintf "%015G" (-42.42) = "-00000000042.42");
+  test (sprintf "%+G" 42.42 = "+42.42");
+  test (sprintf "% G" 42.42 = " 42.42");
+  test (sprintf "%15G" 42.42 = "          42.42");
+  test (sprintf "%*G" 14 42.42 = "         42.42");
+  test (sprintf "%.3G" (-42.42) = "-42.4");
+
+  printf "\nB\n%!";
+  test (sprintf "%B" true = "true");
+  test (sprintf "%8B" true = "    true");
+  test (sprintf "%B" false = "false");
+  test (sprintf "%-8B" false = "false   ");
+
+  printf "\nld/li positive\n%!";
+  test (sprintf "%ld/%li" 42l 43l = "42/43");
+  test (sprintf "%-4ld/%-5li" 42l 43l = "42  /43   ");
+  test (sprintf "%04ld/%05li" 42l 43l = "0042/00043");
+  test (sprintf "%+ld/%+li" 42l 43l = "+42/+43");
+  test (sprintf "% ld/% li" 42l 43l = " 42/ 43");
+  (*test (sprintf "%#ld/%#li" 42l 43l = "42/43");*)
+    (* >> '#' is incompatible with 'ld' *)
+  test (sprintf "%4ld/%5li" 42l 43l = "  42/   43");
+  test (sprintf "%*ld/%*li" 4 42l 5 43l = "  42/   43");
+  (*test (sprintf "%-0+#4ld/%-0 #5li" 42l 43l = "+42 / 43  ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'ld' *)
+
+  printf "\nld/li negative\n%!";
+  test (sprintf "%ld/%li" (-42l) (-43l) = "-42/-43");
+  test (sprintf "%-4ld/%-5li" (-42l) (-43l) = "-42 /-43  ");
+  test (sprintf "%04ld/%05li" (-42l) (-43l) = "-042/-0043");
+  test (sprintf "%+ld/%+li" (-42l) (-43l) = "-42/-43");
+  test (sprintf "% ld/% li" (-42l) (-43l) = "-42/-43");
+  (*test (sprintf "%#ld/%#li" (-42l) (-43l) = "-42/-43");*)
+    (* >> '#' is incompatible with 'ld' *)
+  test (sprintf "%4ld/%5li" (-42l) (-43l) = " -42/  -43");
+  test (sprintf "%*ld/%*li" 4 (-42l) 5 (-43l) = " -42/  -43");
+  (*test (sprintf "%-0+ #4ld/%-0+ #5li" (-42l) (-43l) = "-42 /-43  ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'ld' *)
+
+  printf "\nlu positive\n%!";
+  test (sprintf "%lu" 42l = "42");
+  test (sprintf "%-4lu" 42l = "42  ");
+  test (sprintf "%04lu" 42l = "0042");
+  (*test (sprintf "%+lu" 42l = "42");*)
+    (* >> '+' is incompatible with 'lu' *)
+  (*test (sprintf "% lu" 42l = "42");*)
+    (* >> ' ' is incompatible with 'lu' *)
+  (*test (sprintf "%#lu" 42l = "42");*)
+    (* >> '#' is incompatible with 'lu' *)
+  test (sprintf "%4lu" 42l = "  42");
+  test (sprintf "%*lu" 4 42l = "  42");
+  (*test (sprintf "%-0+ #6ld" 42l = "+42   ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'ld' *)
+
+  printf "\nlu negative\n%!";
+  test (sprintf "%lu" (-1l) = "4294967295");
+
+  printf "\nlx positive\n%!";
+  test (sprintf "%lx" 42l = "2a");
+  test (sprintf "%-4lx" 42l = "2a  ");
+  test (sprintf "%04lx" 42l = "002a");
+  (*test (sprintf "%+lx" 42l = "2a");*)
+    (* >> '+' is incompatible with 'lx' *)
+  (*test (sprintf "% lx" 42l = "2a");*)
+    (* >> ' ' is incompatible with 'lx' *)
+  test (sprintf "%#lx" 42l = "0x2a");
+  test (sprintf "%4lx" 42l = "  2a");
+  test (sprintf "%*lx" 5 42l = "   2a");
+  (*test (sprintf "%-0+ #*lx" 5 42l = "0x2a ");*)
+    (* >> '-' is incompatible with '0' *)
+
+  printf "\nlx negative\n%!";
+  test (sprintf "%lx" (-42l) = "ffffffd6");
+
+  printf "\nlX positive\n%!";
+  test (sprintf "%lX" 42l = "2A");
+  test (sprintf "%-4lX" 42l = "2A  ");
+  test (sprintf "%04lX" 42l = "002A");
+  (*test (sprintf "%+lX" 42l = "2A");*)
+    (* >> '+' is incompatible with 'lX' *)
+  (*test (sprintf "% lX" 42l = "2A");*)
+    (* >> ' ' is incompatible with 'lX' *)
+  test (sprintf "%#lX" 42l = "0X2A");
+  test (sprintf "%4lX" 42l = "  2A");
+  test (sprintf "%*lX" 5 42l = "   2A");
+  (*test (sprintf "%-0+ #*lX" 5 42l = "0X2A ");*)
+    (* >> '-' is incompatible with '0' *)
+
+  printf "\nlx negative\n%!";
+  test (sprintf "%lX" (-42l) = "FFFFFFD6");
+
+  printf "\nlo positive\n%!";
+  test (sprintf "%lo" 42l = "52");
+  test (sprintf "%-4lo" 42l = "52  ");
+  test (sprintf "%04lo" 42l = "0052");
+  (*test (sprintf "%+lo" 42l = "52");*)
+    (* >> '+' is incompatible with 'lo' *)
+  (*test (sprintf "% lo" 42l = "52");*)
+    (* >> ' ' is incompatible with 'lo' *)
+  test (sprintf "%#lo" 42l = "052");
+  test (sprintf "%4lo" 42l = "  52");
+  test (sprintf "%*lo" 5 42l = "   52");
+  (*test (sprintf "%-0+ #*lo" 5 42l = "052  ");*)
+    (* >> '-' is incompatible with '0' *)
+
+  printf "\nlo negative\n%!";
+  test (sprintf "%lo" (-42l) = "37777777726");
+
+  (* Nativeint not tested: looks like too much work, and anyway it should
+     work like Int32 or Int64. *)
+
+  printf "\nLd/Li positive\n%!";
+  test (sprintf "%Ld/%Li" 42L 43L = "42/43");
+  test (sprintf "%-4Ld/%-5Li" 42L 43L = "42  /43   ");
+  test (sprintf "%04Ld/%05Li" 42L 43L = "0042/00043");
+  (*test (sprintf "%+Ld/%+Li" 42L 43L = "+42/+43");*)
+    (* >> '+' is incompatible with 'Ld' *)
+  (*test (sprintf "% Ld/% Li" 42L 43L = " 42/ 43");*)
+    (* >> ' ' is incompatible with 'Ld' *)
+  (*test (sprintf "%#Ld/%#Li" 42L 43L = "42/43");*)
+    (* >> '#' is incompatible with 'Ld' *)
+  test (sprintf "%4Ld/%5Li" 42L 43L = "  42/   43");
+  test (sprintf "%*Ld/%*Li" 4 42L 5 43L = "  42/   43");
+  (*test (sprintf "%-0+#4Ld/%-0 #5Li" 42L 43L = "+42 / 43  ");*)
+    (* >> '-' is incompatible with '0' *)
+
+  printf "\nLd/Li negative\n%!";
+  test (sprintf "%Ld/%Li" (-42L) (-43L) = "-42/-43");
+  test (sprintf "%-4Ld/%-5Li" (-42L) (-43L) = "-42 /-43  ");
+  test (sprintf "%04Ld/%05Li" (-42L) (-43L) = "-042/-0043");
+  (*test (sprintf "%+Ld/%+Li" (-42L) (-43L) = "-42/-43");*)
+    (* >> '+' is incompatible with 'Ld' *)
+  (*test (sprintf "% Ld/% Li" (-42L) (-43L) = "-42/-43");*)
+    (* >> ' ' is incompatible with 'Ld' *)
+  (*test (sprintf "%#Ld/%#Li" (-42L) (-43L) = "-42/-43");*)
+    (* >> '#' is incompatible with 'Ld' *)
+  test (sprintf "%4Ld/%5Li" (-42L) (-43L) = " -42/  -43");
+  test (sprintf "%*Ld/%*Li" 4 (-42L) 5 (-43L) = " -42/  -43");
+  (*test (sprintf "%-0+ #4Ld/%-0+ #5Li" (-42L) (-43L) = "-42 /-43  ");*)
+    (* >> '-' is incompatible with '0' *)
+
+  printf "\nLu positive\n%!";
+  test (sprintf "%Lu" 42L = "42");
+  test (sprintf "%-4Lu" 42L = "42  ");
+  test (sprintf "%04Lu" 42L = "0042");
+  (*test (sprintf "%+Lu" 42L = "42");*)
+    (* >> '+' is incompatible with 'Lu' *)
+  (*test (sprintf "% Lu" 42L = "42");*)
+    (* >> ' ' is incompatible with 'Lu' *)
+  (*test (sprintf "%#Lu" 42L = "42");*)
+    (* >> '#' is incompatible with 'Lu' *)
+  test (sprintf "%4Lu" 42L = "  42");
+  test (sprintf "%*Lu" 4 42L = "  42");
+  (*test (sprintf "%-0+ #6Ld" 42L = "+42   ");*)
+    (* >> '-' is incompatible with '0' *)
+
+  printf "\nLu negative\n%!";
+  test (sprintf "%Lu" (-1L) = "18446744073709551615");
+
+  printf "\nLx positive\n%!";
+  test (sprintf "%Lx" 42L = "2a");
+  test (sprintf "%-4Lx" 42L = "2a  ");
+  test (sprintf "%04Lx" 42L = "002a");
+  (*test (sprintf "%+Lx" 42L = "2a");*)
+    (* >> '+' is incompatible with 'Lx' *)
+  (*test (sprintf "% Lx" 42L = "2a");*)
+    (* >> ' ' is incompatible with 'Lx' *)
+  test (sprintf "%#Lx" 42L = "0x2a");
+  test (sprintf "%4Lx" 42L = "  2a");
+  test (sprintf "%*Lx" 5 42L = "   2a");
+  (*test (sprintf "%-0+ #*Lx" 5 42L = "0x2a ");*)
+    (* >> '-' is incompatible with '0' *)
+
+  printf "\nLx negative\n%!";
+  test (sprintf "%Lx" (-42L) = "ffffffffffffffd6");
+
+  printf "\nLX positive\n%!";
+  test (sprintf "%LX" 42L = "2A");
+  test (sprintf "%-4LX" 42L = "2A  ");
+  test (sprintf "%04LX" 42L = "002A");
+  (*test (sprintf "%+LX" 42L = "2A");*)
+    (* >> '+' is incompatible with 'LX' *)
+  (*test (sprintf "% LX" 42L = "2A");*)
+    (* >> ' ' is incompatible with 'LX' *)
+  test (sprintf "%#LX" 42L = "0X2A");
+  test (sprintf "%4LX" 42L = "  2A");
+  test (sprintf "%*LX" 5 42L = "   2A");
+  (*test (sprintf "%-0+ #*LX" 5 42L = "0X2A ");*)
+    (* >> '-' is incompatible with '0' *)
+
+  printf "\nLx negative\n%!";
+  test (sprintf "%LX" (-42L) = "FFFFFFFFFFFFFFD6");
+
+  printf "\nLo positive\n%!";
+  test (sprintf "%Lo" 42L = "52");
+  test (sprintf "%-4Lo" 42L = "52  ");
+  test (sprintf "%04Lo" 42L = "0052");
+  (*test (sprintf "%+Lo" 42L = "52");*)
+    (* >> '+' is incompatible with 'Lo' *)
+  (*test (sprintf "% Lo" 42L = "52");*)
+    (* >> ' ' is incompatible with 'Lo' *)
+  test (sprintf "%#Lo" 42L = "052");
+  test (sprintf "%4Lo" 42L = "  52");
+  test (sprintf "%*Lo" 5 42L = "   52");
+  (*test (sprintf "%-0+ #*Lo" 5 42L = "052  ");*)
+    (* >> '-' is incompatible with '0' *)
+
+  printf "\nLo negative\n%!";
+  test (sprintf "%Lo" (-42L) = "1777777777777777777726");
+
+  printf "\na\n%!";
+  let x = ref () in
+  let f () y = if y == x then "ok" else "wrong" in
+  test (sprintf "%a" f x = "ok");
+
+  printf "\nt\n%!";
+  let f () = "ok" in
+  test (sprintf "%t" f = "ok");
+
+  (* Work as expected. Prints the format string type digest.
+     If you want to print the contents of the format string,
+     do not use a meta format; simply convert the format string
+     to a string and print it using %s. *)
+
+  printf "\n{...%%}\n%!";
+  let f = format_of_string "%4g/%s" in
+  test (sprintf "%{%.4F%5S%}" f = "%f%s");
+
+  printf "\n(...%%)\n%!";
+  let f = format_of_string "%d/foo/%s" in
+  test (sprintf "%(%d%s%)" f 42 "bar" = "42/foo/bar");
+
+  printf "\n! %% @ , and constants\n%!";
+  test (sprintf "%!" = "");
+  test (sprintf "%%" = "%");
+  test (sprintf "%@" = "@");
+  test (sprintf "%," = "");
+  test (sprintf "@" = "@");
+  test (sprintf "@@" = "@@");
+  test (sprintf "@%%" = "@%");
+
+  printf "\nend of tests\n%!";
+with e ->
+  printf "unexpected exception: %s\n%!" (Printexc.to_string e);
+  test false;
+;;
diff --git a/testsuite/tests/lib-printf/tprintf.reference b/testsuite/tests/lib-printf/tprintf.reference
new file mode 100644
index 00000000..e728007e
--- /dev/null
+++ b/testsuite/tests/lib-printf/tprintf.reference
@@ -0,0 +1,101 @@
+d/i positive
+ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+d/i negative
+ 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
+u positive
+ 30 31 32 33 34 35 36 37 38 39 40 41 42
+u negative
+ 43 44
+x positive
+ 45 46 47 48 49 50 51 52 53 54 55
+x negative
+ 56
+X positive
+ 57 58 59 60 61 62
+x negative
+ 63
+o positive
+ 64 65 66 67 68 69
+o negative
+ 70
+s
+ 71 72 73 74 75 76 77 78 79 80
+S
+ 81 82 83 84 85 86 87 88
+c
+ 89
+C
+ 90 91
+f
+ 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106
+F
+ 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
+#F
+ 123 124 125 126 127 128 129 130 131 132 133 134 135 136
+h
+ 137 138 139 140 141 142 143 144 145 146 147 148 149
+H
+ 150 151 152 153 154 155 156 157 158 159 160 161 162
+e
+ 163 164 165 166 167 168 169 170 171 172 173 174 175 176
+E
+ 177 178 179 180 181 182 183 184 185 186 187 188 189 190
+g
+ 191 192 193 194 195 196 197 198 199
+G
+ 200 201 202 203 204 205 206 207 208
+B
+ 209 210 211 212
+ld/li positive
+ 213 214 215 216 217 218 219
+ld/li negative
+ 220 221 222 223 224 225 226
+lu positive
+ 227 228 229 230 231
+lu negative
+ 232
+lx positive
+ 233 234 235 236 237 238
+lx negative
+ 239
+lX positive
+ 240 241 242 243 244 245
+lx negative
+ 246
+lo positive
+ 247 248 249 250 251 252
+lo negative
+ 253
+Ld/Li positive
+ 254 255 256 257 258
+Ld/Li negative
+ 259 260 261 262 263
+Lu positive
+ 264 265 266 267 268
+Lu negative
+ 269
+Lx positive
+ 270 271 272 273 274 275
+Lx negative
+ 276
+LX positive
+ 277 278 279 280 281 282
+Lx negative
+ 283
+Lo positive
+ 284 285 286 287 288 289
+Lo negative
+ 290
+a
+ 291
+t
+ 292
+{...%}
+ 293
+(...%)
+ 294
+! % @ , and constants
+ 295 296 297 298 299 300 301
+end of tests
+
+All tests succeeded.
diff --git a/testsuite/tests/lib-queue/test.ml b/testsuite/tests/lib-queue/test.ml
new file mode 100644
index 00000000..ac05f4e3
--- /dev/null
+++ b/testsuite/tests/lib-queue/test.ml
@@ -0,0 +1,141 @@
+(* TEST
+*)
+
+module Q = struct
+  include Queue
+
+  let to_list q = fold (fun l x -> x :: l) [] q |> List.rev
+end
+
+let does_raise f q =
+  try
+    ignore (f q : int);
+    false
+  with Q.Empty ->
+    true
+
+let () =
+  let q = Q.create () in
+  ();                    assert (Q.to_list q = [          ] && Q.length q = 0);
+  Q.add 1 q;             assert (Q.to_list q = [1         ] && Q.length q = 1);
+  Q.add 2 q;             assert (Q.to_list q = [1; 2      ] && Q.length q = 2);
+  Q.add 3 q;             assert (Q.to_list q = [1; 2; 3   ] && Q.length q = 3);
+  Q.add 4 q;             assert (Q.to_list q = [1; 2; 3; 4] && Q.length q = 4);
+  assert (Q.take q = 1); assert (Q.to_list q = [   2; 3; 4] && Q.length q = 3);
+  assert (Q.take q = 2); assert (Q.to_list q = [      3; 4] && Q.length q = 2);
+  assert (Q.take q = 3); assert (Q.to_list q = [         4] && Q.length q = 1);
+  assert (Q.take q = 4); assert (Q.to_list q = [          ] && Q.length q = 0);
+  assert (does_raise Q.take q);
+;;
+
+let () =
+  let q = Q.create () in
+  Q.add 1 q; assert (Q.take q = 1); assert (does_raise Q.take q);
+  Q.add 2 q; assert (Q.take q = 2); assert (does_raise Q.take q);
+  assert (Q.length q = 0);
+;;
+
+let () =
+  let q = Q.create () in
+  Q.add 1 q; assert (Q.peek q = 1);
+  Q.add 2 q; assert (Q.peek q = 1);
+  Q.add 3 q; assert (Q.peek q = 1);
+  assert (Q.peek q = 1); assert (Q.take q = 1);
+  assert (Q.peek q = 2); assert (Q.take q = 2);
+  assert (Q.peek q = 3); assert (Q.take q = 3);
+  assert (does_raise Q.peek q);
+  assert (does_raise Q.peek q);
+;;
+
+let () =
+  let q = Q.create () in
+  for i = 1 to 10 do Q.add i q done;
+  Q.clear q;
+  assert (Q.length q = 0);
+  assert (does_raise Q.take q);
+  assert (q = Q.create ());
+  Q.add 42 q;
+  assert (Q.take q = 42);
+;;
+
+let () =
+  let q1 = Q.create () in
+  for i = 1 to 10 do Q.add i q1 done;
+  let q2 = Q.copy q1 in
+  assert (Q.to_list q1 = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]);
+  assert (Q.to_list q2 = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]);
+  assert (Q.length q1 = 10);
+  assert (Q.length q2 = 10);
+  for i = 1 to 10 do
+    assert (Q.take q1 = i);
+  done;
+  for i = 1 to 10 do
+    assert (Q.take q2 = i);
+  done;
+;;
+
+let () =
+  let q = Q.create () in
+  assert (Q.is_empty q);
+  for i = 1 to 10 do
+    Q.add i q;
+    assert (Q.length q = i);
+    assert (not (Q.is_empty q));
+  done;
+  for i = 10 downto 1 do
+    assert (Q.length q = i);
+    assert (not (Q.is_empty q));
+    ignore (Q.take q : int);
+  done;
+  assert (Q.length q = 0);
+  assert (Q.is_empty q);
+;;
+
+let () =
+  let q = Q.create () in
+  for i = 1 to 10 do Q.add i q done;
+  let i = ref 1 in
+  Q.iter (fun j -> assert (!i = j); incr i) q;
+;;
+
+let () =
+  let q1 = Q.create () and q2 = Q.create () in
+  assert (Q.length q1 = 0); assert (Q.to_list q1 = []);
+  assert (Q.length q2 = 0); assert (Q.to_list q2 = []);
+  Q.transfer q1 q2;
+  assert (Q.length q1 = 0); assert (Q.to_list q1 = []);
+  assert (Q.length q2 = 0); assert (Q.to_list q2 = []);
+;;
+
+let () =
+  let q1 = Q.create () and q2 = Q.create () in
+  for i = 1 to 4 do Q.add i q1 done;
+  assert (Q.length q1 = 4); assert (Q.to_list q1 = [1; 2; 3; 4]);
+  assert (Q.length q2 = 0); assert (Q.to_list q2 = [          ]);
+  Q.transfer q1 q2;
+  assert (Q.length q1 = 0); assert (Q.to_list q1 = [          ]);
+  assert (Q.length q2 = 4); assert (Q.to_list q2 = [1; 2; 3; 4]);
+;;
+
+let () =
+  let q1 = Q.create () and q2 = Q.create () in
+  for i = 5 to 8 do Q.add i q2 done;
+  assert (Q.length q1 = 0); assert (Q.to_list q1 = [          ]);
+  assert (Q.length q2 = 4); assert (Q.to_list q2 = [5; 6; 7; 8]);
+  Q.transfer q1 q2;
+  assert (Q.length q1 = 0); assert (Q.to_list q1 = [          ]);
+  assert (Q.length q2 = 4); assert (Q.to_list q2 = [5; 6; 7; 8]);
+;;
+
+let () =
+  let q1 = Q.create () and q2 = Q.create () in
+  for i = 1 to 4 do Q.add i q1 done;
+  for i = 5 to 8 do Q.add i q2 done;
+  assert (Q.length q1 = 4); assert (Q.to_list q1 = [1; 2; 3; 4]);
+  assert (Q.length q2 = 4); assert (Q.to_list q2 = [5; 6; 7; 8]);
+  Q.transfer q1 q2;
+  assert (Q.length q1 = 0); assert (Q.to_list q1 = [                      ]);
+  assert (Q.length q2 = 8); assert (Q.to_list q2 = [5; 6; 7; 8; 1; 2; 3; 4]);
+;;
+
+let () = print_endline "OK"
diff --git a/testsuite/tests/lib-queue/test.reference b/testsuite/tests/lib-queue/test.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-queue/test.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-random/rand.ml b/testsuite/tests/lib-random/rand.ml
new file mode 100644
index 00000000..50e74d13
--- /dev/null
+++ b/testsuite/tests/lib-random/rand.ml
@@ -0,0 +1,15 @@
+(* TEST
+*)
+
+(* Test that two Random.self_init() in close succession will not result
+   in the same PRNG state.
+   Note that even when the code is correct this test is expected to fail
+   once in 10000 runs.
+*)
+
+let () =
+  Random.self_init ();
+  let x = Random.int 10000 in
+  Random.self_init ();
+  let y = Random.int 10000 in
+  if x = y then print_endline "FAILED" else print_endline "PASSED"
diff --git a/testsuite/tests/lib-random/rand.reference b/testsuite/tests/lib-random/rand.reference
new file mode 100644
index 00000000..53cdf1e9
--- /dev/null
+++ b/testsuite/tests/lib-random/rand.reference
@@ -0,0 +1 @@
+PASSED
diff --git a/testsuite/tests/lib-result/test.ml b/testsuite/tests/lib-result/test.ml
new file mode 100644
index 00000000..6e7a5cc8
--- /dev/null
+++ b/testsuite/tests/lib-result/test.ml
@@ -0,0 +1,131 @@
+(* TEST
+*)
+
+let strf = Printf.sprintf
+let assert_raise_invalid_argument f v =
+  assert (try ignore (f v); false with Invalid_argument _ -> true);
+  ()
+
+let test_ok_error () =
+  assert (Result.ok 3 = Ok 3);
+  assert (Result.error "ha!" = Error "ha!");
+  ()
+
+let test_value () =
+  assert (Result.value (Ok 3) ~default:5 = 3);
+  assert (Result.value (Error "ha!") ~default:5 = 5);
+  ()
+
+let test_get_ok_error () =
+  assert (Result.get_ok (Ok 3) = 3);
+  assert_raise_invalid_argument Result.get_ok (Error "ha!");
+  assert (Result.get_error (Error "ha!") = "ha!");
+  assert_raise_invalid_argument Result.get_error (Ok 2);
+  ()
+
+let test_bind () =
+  assert (Result.bind (Ok 3) (fun x -> Ok (succ x)) = Ok 4);
+  assert (Result.bind (Ok 3) (fun x -> Error (strf "hu%d!" x)) = Error "hu3!");
+  assert (Result.bind (Error "ha!") (fun x -> Ok (succ x)) = Error "ha!");
+  assert (Result.bind (Error "ha!") (fun _ -> Error "hu!") = Error "ha!");
+  ()
+
+let test_join () =
+  assert (Result.join (Ok (Ok 3)) = Ok 3);
+  assert (Result.join (Ok (Error "ha!")) = Error "ha!");
+  assert (Result.join (Error "ha!") = Error "ha!");
+  ()
+
+let test_maps () =
+  assert (Result.map succ (Ok 3) = Ok 4);
+  assert (Result.map succ (Error "ha!") = Error "ha!");
+  assert (Result.map_error succ (Error 3) = Error 4);
+  assert (Result.map_error succ (Ok 2) = Ok 2);
+  ()
+
+let test_fold () =
+  assert (Result.fold ~ok:succ ~error:succ (Ok 1) = 2);
+  assert (Result.fold ~ok:succ ~error:succ (Error 1) = 2);
+  assert (Result.(fold ~ok ~error) (Ok 1) = (Ok 1));
+  assert (Result.(fold ~ok ~error) (Error "ha!") = (Error "ha!"));
+  ()
+
+let test_iters () =
+  let count = ref 0 in
+  let set_count x = count := x in
+  assert (!count = 0);
+  Result.iter set_count (Ok 2); assert (!count = 2);
+  Result.iter set_count (Error "ha!"); assert (!count = 2);
+  Result.iter_error set_count (Error 3); assert (!count = 3);
+  Result.iter_error set_count (Ok "ha!"); assert (!count = 3);
+  ()
+
+let test_is_ok_error () =
+  assert (Result.is_ok (Ok 2) = true);
+  assert (Result.is_error (Ok 2) = false);
+  assert (Result.is_ok (Error "ha!") = false);
+  assert (Result.is_error (Error "ha!") = true);
+  ()
+
+let test_equal () =
+  let ok v0 v1 = (v0 mod 2) = (v1 mod 2) in
+  let error = ok in
+  let equal = Result.equal ~ok ~error in
+  assert (not @@ equal (Ok 2) (Ok 3));
+  assert (       equal (Ok 2) (Ok 4));
+  assert (not @@ equal (Ok 2) (Error 3));
+  assert (not @@ equal (Ok 2) (Error 4));
+  assert (not @@ equal (Error 2) (Ok 3));
+  assert (not @@ equal (Error 2) (Ok 4));
+  assert (not @@ equal (Error 2) (Error 3));
+  assert (       equal (Error 2) (Error 4));
+  ()
+
+let test_compare () =
+  let ok v0 v1 = - (compare v0 v1) in
+  let error = ok in
+  let compare = Result.compare ~ok ~error in
+  assert (compare (Ok 2) (Ok 1) = -1);
+  assert (compare (Ok 2) (Ok 2) = 0);
+  assert (compare (Ok 2) (Ok 3) = 1);
+  assert (compare (Ok 2) (Error 1) = -1);
+  assert (compare (Ok 2) (Error 2) = -1);
+  assert (compare (Ok 2) (Error 3) = -1);
+  assert (compare (Error 2) (Ok 1) = 1);
+  assert (compare (Error 2) (Ok 2) = 1);
+  assert (compare (Error 2) (Ok 3) = 1);
+  assert (compare (Error 2) (Error 1) = -1);
+  assert (compare (Error 2) (Error 2) = 0);
+  assert (compare (Error 2) (Error 3) = 1);
+  ()
+
+let test_to_option_list_seq () =
+  assert (Result.to_option (Ok 3) = Some 3);
+  assert (Result.to_option (Error "ha!") = None);
+  assert (Result.to_list (Ok 3) = [3]);
+  assert (Result.to_list (Error "ha!") = []);
+  begin match (Result.to_seq (Ok 3)) () with
+  | Seq.Cons (3, f) -> assert (f () = Seq.Nil)
+  | _ -> assert false
+  end;
+  assert ((Result.to_seq (Error "ha!")) () = Seq.Nil);
+  ()
+
+let tests () =
+  test_ok_error ();
+  test_value ();
+  test_get_ok_error ();
+  test_bind ();
+  test_join ();
+  test_maps ();
+  test_fold ();
+  test_iters ();
+  test_is_ok_error ();
+  test_equal ();
+  test_compare ();
+  test_to_option_list_seq ();
+  ()
+
+let () =
+  tests ();
+  print_endline "OK"
diff --git a/testsuite/tests/lib-result/test.reference b/testsuite/tests/lib-result/test.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-result/test.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-scanf-2/tscanf2.reference b/testsuite/tests/lib-scanf-2/tscanf2.reference
new file mode 100644
index 00000000..4b8d53fc
--- /dev/null
+++ b/testsuite/tests/lib-scanf-2/tscanf2.reference
@@ -0,0 +1,2 @@
+ Ping-pong Ping-pong Ping-pong Ping-pong Ping-pong Ping-pong Ping-pong Ping-pong!
+Test OK.
diff --git a/testsuite/tests/lib-scanf-2/tscanf2_io.ml b/testsuite/tests/lib-scanf-2/tscanf2_io.ml
new file mode 100644
index 00000000..03997897
--- /dev/null
+++ b/testsuite/tests/lib-scanf-2/tscanf2_io.ml
@@ -0,0 +1,19 @@
+(* A very simple communication module using buffers. It should help detecting
+   advanced character reading by Scanf when using stdin. *)
+
+let send_flush send ob oc t =
+  send ob t;
+  Buffer.output_buffer oc ob;
+  Buffer.clear ob;
+  flush oc
+;;
+
+(* The correct sending format for the test should be "%S\n",
+   but to avoid problems when Scanf ask too early for the next character,
+   "%S\n\n" is fine. *)
+let send_string = send_flush (fun ob -> Printf.bprintf ob "%S\n");;
+
+(* The correct reading format for the test should be "%S\n",
+   but to avoid problems when Scanf ask too early for the next character,
+   " %S\n" is fine. *)
+let receive_string ib = Scanf.bscanf ib "%S\n" (fun s -> s);;
diff --git a/testsuite/tests/lib-scanf-2/tscanf2_master.ml b/testsuite/tests/lib-scanf-2/tscanf2_master.ml
new file mode 100644
index 00000000..a596b3ae
--- /dev/null
+++ b/testsuite/tests/lib-scanf-2/tscanf2_master.ml
@@ -0,0 +1,109 @@
+(* TEST
+
+modules = "tscanf2_io.ml"
+* hasunix
+include unix
+files = "tscanf2_worker.ml"
+reference = "${test_source_directory}/tscanf2.reference"
+
+(* The bytcode test *)
+
+** setup-ocamlc.byte-build-env
+
+program = "${test_build_directory}/master.byte"
+
+*** ocamlc.byte (* Compiles the master *)
+
+**** ocamlc.byte (* Compiles the worker *)
+
+all_modules = "tscanf2_io.cmo tscanf2_worker.ml"
+
+program = "${test_build_directory}/worker.byte"
+
+***** check-ocamlc.byte-output
+
+****** run
+
+program = "${test_build_directory}/master.byte"
+
+arguments = "${test_build_directory}/worker.byte"
+
+******* check-program-output
+
+(* The native test *)
+
+** setup-ocamlopt.byte-build-env
+
+program = "${test_build_directory}/master.opt"
+
+*** ocamlopt.byte (* Compiles the master *)
+
+**** ocamlopt.byte (* Compiles the worker *)
+
+all_modules = "tscanf2_io.cmx tscanf2_worker.ml"
+
+program = "${test_build_directory}/worker.opt"
+
+***** check-ocamlopt.byte-output
+
+****** run
+
+program = "${test_build_directory}/master.opt"
+
+arguments = "${test_build_directory}/worker.opt"
+
+******* check-program-output
+
+*)
+
+(* A very simple master:
+   - first launch a worker process,
+   - then repeat a random number of times:
+     + print the string " Ping" on stderr,
+     + send it to the worker,
+     + and wait for its answer "-pong",
+   - finally send the string "stop" to the worker
+     and wait for its answer "OK, bye!"
+     and die.
+
+   Use the communication module Tscanf2_io.
+
+   Usage: test_master <worker_name> *)
+
+open Tscanf2_io;;
+
+let worker = Sys.argv.(1);;
+let ic, oc = Unix.open_process worker;;
+let ib = Scanf.Scanning.from_channel ic;;
+let ob = Buffer.create 1024;;
+
+let send_string_ping ob = send_string ob oc " Ping";;
+let send_string_stop ob = send_string ob oc "stop";;
+
+let interact i =
+  Printf.eprintf " Ping"; flush stderr;
+  send_string_ping ob;
+  let s = receive_string ib in
+  if s <> "-pong" then failwith ("Master: unbound string " ^ s)
+;;
+
+begin
+(*
+  Random.self_init ();
+  let n = max (Random.int 8) 1 in
+*)
+  let n = 8 in
+  let rec loop i =
+    if i > 0 then (interact i; loop (i - 1)) in
+  loop n
+end
+;;
+
+begin
+  send_string_stop ob;
+  let ack = receive_string ib in
+  if ack = "OK, bye!"
+  then (print_endline "Test OK."; exit 0)
+  else (print_endline "Test Failed!"; exit 2)
+end
+;;
diff --git a/testsuite/tests/lib-scanf-2/tscanf2_worker.ml b/testsuite/tests/lib-scanf-2/tscanf2_worker.ml
new file mode 100644
index 00000000..87345edc
--- /dev/null
+++ b/testsuite/tests/lib-scanf-2/tscanf2_worker.ml
@@ -0,0 +1,28 @@
+(* A very simple worker:
+   - read the string " Ping" on stdin,
+   - then print the string "-pong" on stderr,
+   - and send it back on stdout
+   - until reading the string "stop" on stdin,
+   - then print the string "!\n" on stderr,
+   - send back the string "OK, bye!" on stdout,
+   - and die.
+
+   Use the communication module Test_scanf2_io. *)
+
+open Tscanf2_io;;
+
+let ib = Scanf.Scanning.from_channel stdin;;
+let ob = Buffer.create 1024
+and oc = stdout;;
+
+let send_string_pong ob = send_string ob oc "-pong";;
+let send_string_okbye ob = send_string ob oc "OK, bye!";;
+
+while true do
+  let s = receive_string ib in
+  match s with
+  | " Ping" -> Printf.eprintf "-pong"; flush stderr; send_string_pong ob
+  | "stop" -> Printf.eprintf "!\n"; flush stderr; send_string_okbye ob; exit 0
+  | s -> failwith ("Slave: unbound string " ^ s)
+done
+;;
diff --git a/testsuite/tests/lib-scanf/tscanf.ml b/testsuite/tests/lib-scanf/tscanf.ml
new file mode 100644
index 00000000..cebc76d4
--- /dev/null
+++ b/testsuite/tests/lib-scanf/tscanf.ml
@@ -0,0 +1,1558 @@
+(* TEST
+   include testing
+   compare_programs = "false" (* See https://github.com/ocaml/ocaml/pull/8853 *)
+*)
+
+(*
+
+A testbed file for the module Scanf.
+
+*)
+
+open Testing;;
+
+open Scanf;;
+
+(* The ``continuation'' that returns the scanned value. *)
+let id x = x;;
+
+(* Testing space scanning. *)
+let test0 () =
+  (sscanf "" "" id) 1 +
+  (sscanf "" " " id) 2 +
+  (sscanf " " " " id) 3 +
+  (sscanf "\t" " " id) 4 +
+  (sscanf "\n" " " id) 5 +
+  (sscanf "\n\t 6" " %d" id)
+;;
+
+test (test0 () = 21)
+;;
+
+(* Testing integer scanning %i and %d. *)
+let test1 () =
+  sscanf "1" "%d" id +
+  sscanf " 2" " %d" id +
+  sscanf " -2" " %d" id +
+  sscanf " +2" " %d" id +
+  sscanf " 2a " " %da" id
+;;
+
+test (test1 () = 5)
+;;
+
+let test2 () =
+  sscanf "123" "%2i" id +
+  sscanf "245" "%d" id +
+  sscanf " 2a " " %1da" id
+;;
+
+test (test2 () = 259)
+;;
+
+let test3 () =
+  sscanf "0xff" "%3i" id +
+  sscanf "0XEF" "%3i" id +
+  sscanf "x=-245" " x = %d" id +
+  sscanf " 2a " " %1da" id
+;;
+
+test (test3 () = -214)
+;;
+
+(* Testing float scanning. *)
+(* f style. *)
+let test4 () =
+  bscanf (Scanning.from_string "1")
+    "%f" (fun b0 -> b0 = 1.0) &&
+  bscanf (Scanning.from_string "-1")
+    "%f" (fun b0 -> b0 = -1.0) &&
+  bscanf (Scanning.from_string "+1")
+    "%f" (fun b0 -> b0 = 1.0) &&
+  bscanf (Scanning.from_string "1.")
+    "%f" (fun b0 -> b0 = 1.0) &&
+  bscanf (Scanning.from_string ".1")
+    "%f" (fun b0 -> b0 = 0.1) &&
+  bscanf (Scanning.from_string "-.1")
+    "%f" (fun b0 -> b0 = -0.1) &&
+  bscanf (Scanning.from_string "+.1")
+    "%f" (fun b0 -> b0 = 0.1) &&
+  bscanf (Scanning.from_string "+1.")
+    "%f" (fun b0 -> b0 = 1.0) &&
+  bscanf (Scanning.from_string "-1.")
+    "%f" (fun b0 -> b0 = -1.0) &&
+  bscanf (Scanning.from_string "0 1. 1.3")
+    "%f %f %f" (fun b0 b1 b2 -> b0 = 0.0 && b1 = 1.0 && b2 = 1.3) &&
+  bscanf (Scanning.from_string "0.113")
+    "%4f" (fun b0 -> b0 = 0.11) &&
+  bscanf (Scanning.from_string "0.113")
+    "%5f" (fun b0 -> b0 = 0.113) &&
+  bscanf (Scanning.from_string "000.113")
+    "%15f" (fun b0 -> b0 = 0.113) &&
+  bscanf (Scanning.from_string "+000.113")
+    "%15f" (fun b0 -> b0 = 0.113) &&
+  bscanf (Scanning.from_string "-000.113")
+    "%15f" (fun b0 -> b0 = -0.113)
+;;
+test (test4 ())
+;;
+
+let same_float x y =
+  let is_nan z = (z <> z) in
+  if is_nan x then is_nan y
+  else Int64.bits_of_float y = Int64.bits_of_float x
+;;
+
+(* e style. *)
+let test5 () =
+  bscanf (Scanning.from_string "1e1")
+    "%e" (fun b -> b = 10.0) &&
+  bscanf (Scanning.from_string "1e+1")
+    "%e" (fun b -> b = 10.0) &&
+  bscanf (Scanning.from_string "10e-1")
+    "%e" (fun b -> b = 1.0) &&
+  bscanf (Scanning.from_string "10.e-1")
+    "%e" (fun b -> b = 1.0) &&
+  bscanf (Scanning.from_string "1e1 1.e+1 1.3e-1")
+    "%e %e %e" (fun b1 b2 b3 -> b1 = 10.0 && b2 = b1 && b3 = 0.13) &&
+
+(* g style. *)
+  bscanf (Scanning.from_string "1 1.1 0e+1 1.3e-1")
+    "%g %g %g %g"
+    (fun b1 b2 b3 b4 ->
+     b1 = 1.0 && b2 = 1.1 && b3 = 0.0 && b4 = 0.13)
+  &&
+(* F style *)
+  bscanf (Scanning.from_string "1.5 1.5e0 15e-1 0x1.8 0X1.8")
+    "%F %F %f %F %F"
+    (fun b1 b2 b3 b4 b5 -> b1 = b2 && b2 = b3 && b3 = b4 && b4 = b5)
+  &&
+(* h style *)
+  begin
+    let roundtrip x =
+      bscanf (Printf.ksprintf Scanning.from_string "%h" x) "%h" (same_float x)
+    in
+    roundtrip (+0.) &&
+    roundtrip (-0.) &&
+    roundtrip (+1.) &&
+    roundtrip (-1.) &&
+    roundtrip (+1024.) &&
+    roundtrip (-1024.) &&
+    roundtrip 0X123.456 &&
+    roundtrip 0X123456789ABCDE. &&
+    roundtrip epsilon_float &&
+    roundtrip (4. *. atan 1.) &&
+    (Sys.win32 ||
+     (* nan/infinity parsing fails on Windows? *)
+     (roundtrip nan &&
+      roundtrip infinity &&
+      roundtrip neg_infinity)) &&
+    true
+  end
+  &&
+
+  (* H style *)
+  begin
+    let roundtrip x =
+      bscanf (Printf.ksprintf Scanning.from_string "%H" x) "%H" (same_float x)
+    in
+    roundtrip (+0.) &&
+    roundtrip (-0.) &&
+    roundtrip (+1.) &&
+    roundtrip (-1.) &&
+    roundtrip (+1024.) &&
+    roundtrip (-1024.) &&
+    roundtrip 0X123.456 &&
+    roundtrip 0X123456789ABCDE. &&
+    roundtrip epsilon_float &&
+    roundtrip (4. *. atan 1.) &&
+    (Sys.win32 ||
+     (* nan/infinity parsing fails on Windows? *)
+     (roundtrip nan &&
+      roundtrip infinity &&
+      roundtrip neg_infinity)) &&
+    true
+  end
+;;
+
+test (test5 ())
+;;
+
+(* Testing boolean scanning. *)
+let test6 () =
+  bscanf (Scanning.from_string "truetrue") "%B%B"
+         (fun b1 b2 -> (b1, b2) = (true, true))  &&
+  bscanf (Scanning.from_string "truefalse") "%B%B"
+         (fun b1 b2 -> (b1, b2) = (true, false)) &&
+  bscanf (Scanning.from_string "falsetrue") "%B%B"
+         (fun b1 b2 -> (b1, b2) = (false, true)) &&
+  bscanf (Scanning.from_string "falsefalse") "%B%B"
+         (fun b1 b2 -> (b1, b2) = (false, false)) &&
+  bscanf (Scanning.from_string "true false") "%B %B"
+         (fun b1 b2 -> (b1, b2) = (true, false))
+;;
+
+test (test6 ())
+;;
+
+(* Testing char scanning. *)
+
+let test7 () =
+  bscanf (Scanning.from_string "'a' '\n' '\t' '\000' '\032'")
+         "%C %C %C %C %C"
+    (fun c1 c2 c3 c4 c5 ->
+       c1 = 'a' && c2 = '\n' && c3 = '\t' && c4 = '\000' && c5 = '\032') &&
+
+(* Here \n, \t, and \032 are skipped due to the space semantics of scanf. *)
+  bscanf (Scanning.from_string "a \n \t \000 \032b")
+         "%c %c %c "
+    (fun c1 c2 c3 ->
+       c1 = 'a' && c2 = '\000' && c3 = 'b')
+;;
+
+test (test7 ())
+;;
+
+let verify_read c =
+  let s = Printf.sprintf "%C" c in
+  let ib = Scanning.from_string s in
+  assert (bscanf ib "%C" id = c)
+;;
+
+let verify_scan_Chars () =
+  for i = 0 to 255 do verify_read (char_of_int i) done
+;;
+
+let test8 () = verify_scan_Chars () = ();;
+
+test (test8 ())
+;;
+
+(* Testing string scanning. *)
+
+(* %S and %s styles. *)
+let unit fmt s =
+  let ib = Scanning.from_string (Printf.sprintf "%S" s) in
+  Scanf.bscanf ib fmt id
+;;
+
+let test_fmt fmt s = unit fmt s = s;;
+
+let test9_string = "\239\187\191";;
+
+let test_S = test_fmt "%S";;
+let test9 () =
+  test_S "poi" &&
+  test_S "a\"b" &&
+  test_S "a\nb" &&
+  test_S "a\010b" &&
+  test_S "a\\\n\
+          b \\\n\
+          c\010\\\n\
+          b" &&
+  test_S "a\\\n\
+          \\\n\
+          \\\n\
+          b \\\n\
+          c\010\\\n\
+          b" &&
+  test_S "\xef" &&
+  test_S "\\xef" &&
+  Scanf.sscanf "\"\\xef\"" "%S" (fun s -> s) =
+                  "\xef" &&
+  Scanf.sscanf "\"\\xef\\xbb\\xbf\"" "%S" (fun s -> s) =
+                  test9_string &&
+  Scanf.sscanf "\"\\xef\\xbb\\xbf\"" "%S" (fun s -> s) =
+                  "\239\187\191" &&
+  Scanf.sscanf "\"\xef\xbb\xbf\"" "%S" (fun s -> s) =
+                  test9_string &&
+  Scanf.sscanf "\"\\\\xef\\\\xbb\\\\xbf\"" "%S" (fun s -> s) =
+                  "\\xef\\xbb\\xbf" &&
+  Scanf.sscanf "\"\ \"" "%S" (fun s -> s) =
+                  "\ "
+;;
+
+test (test9 ())
+;;
+
+let test10 () =
+  let unit s =
+    let ib = Scanning.from_string s in
+  Scanf.bscanf ib "%S" id in
+
+  let res =
+    sscanf "Une chaine: \"celle-ci\" et \"celle-la\"!"
+           "%s %s %S %s %S %s"
+           (fun s1 s2 s3 s4 s5 s6 -> s1 ^ s2 ^ s3 ^ s4 ^ s5 ^ s6) in
+  res = "Unechaine:celle-cietcelle-la!" &&
+  (* Testing the result of reading a %S string. *)
+  unit "\"a\\\n  b\"" = "ab" &&
+  unit "\"\\\n  ab\"" = "ab" &&
+  unit "\"\n\\\n  ab\"" = "\nab" &&
+  unit "\"\n\\\n  a\nb\"" = "\na\nb" &&
+  unit "\"\n\\\n  \\\n  a\nb\"" = "\na\nb" &&
+  unit "\"\n\\\n  a\n\\\nb\\\n\"" = "\na\nb" &&
+  unit "\"a\\\n  \"" = "a" &&
+  true
+;;
+
+test (test10 ())
+;;
+
+(* %[] style *)
+let test11 () =
+  sscanf "Pierre\tWeis\t70" "%s %s %s"
+    (fun prenom nom poids ->
+     prenom = "Pierre" && nom = "Weis" && int_of_string poids = 70)
+  &&
+  sscanf "Jean-Luc\tde Leage\t68" "%[^\t] %[^\t] %d"
+    (fun prenom nom poids ->
+     prenom = "Jean-Luc" && nom = "de Leage" && poids = 68)
+  &&
+  sscanf "Daniel\tde Rauglaudre\t66" "%s@\t %s@\t %d"
+    (fun prenom nom poids ->
+     prenom = "Daniel" && nom = "de Rauglaudre" && poids = 66)
+;;
+
+(* Empty string (end of input) testing. *)
+let test110 () =
+  sscanf "" " " (fun x -> x) "" = "" &&
+  sscanf "" "%s" (fun x -> x = "") &&
+  sscanf "" "%s%s" (fun x y -> x = "" && y = "") &&
+  sscanf "" "%s " (fun x -> x = "") &&
+  sscanf "" " %s" (fun x -> x = "") &&
+  sscanf "" " %s " (fun x -> x = "") &&
+  sscanf "" "%[^\n]" (fun x -> x = "") &&
+  sscanf "" "%[^\n] " (fun x -> x = "") &&
+  sscanf " " "%s" (fun x -> x = "") &&
+  sscanf " " "%s%s" (fun x y -> x = "" && y = "") &&
+  sscanf " " " %s " (fun x -> x = "") &&
+  sscanf " " " %s %s" (fun x y -> x = "" && x = y) &&
+  sscanf " " " %s@ %s" (fun x y -> x = "" && x = y) &&
+  sscanf " poi !" " %s@ %s@." (fun x y -> x = "poi" && y = "!") &&
+  sscanf " poi !" "%s@ %s@." (fun x y -> x = "" && y = "poi !")
+;;
+
+let test111 () = sscanf "" "%[^\n]@\n" (fun x -> x = "");;
+
+test (test11 () && test110 () && test111 ())
+;;
+
+(* Scanning lists. *)
+let ib () = Scanning.from_string "[1;2;3;4; ]";;
+
+(* Statically known lists can be scanned directly. *)
+let f ib =
+  bscanf ib " [" ();
+  bscanf ib " %i;" (fun i ->
+  bscanf ib " %i;" (fun j ->
+  bscanf ib " %i;" (fun k ->
+  bscanf ib " %i;" (fun l ->
+  bscanf ib " ]" ();
+  [i; j; k; l]))));;
+
+let test12 () = f (ib ()) = [1; 2; 3; 4];;
+
+test (test12 ())
+;;
+
+(* A general list scanner that always fails to succeed. *)
+let rec scan_elems ib accu =
+  try bscanf ib " %i;" (fun i -> scan_elems ib (i :: accu)) with
+  | _ -> accu
+;;
+
+let g ib = bscanf ib "[ " (); List.rev (scan_elems ib []);;
+
+let test13 () = g (ib ()) = [1; 2; 3; 4];;
+
+test (test13 ())
+;;
+
+(* A general int list scanner. *)
+let rec scan_int_list ib =
+  bscanf ib "[ " ();
+  let accu = scan_elems ib [] in
+  bscanf ib " ]" ();
+  List.rev accu
+;;
+
+let test14 () = scan_int_list (ib ()) = [1; 2; 3; 4];;
+
+test (test14 ())
+;;
+
+(* A general list scanner that always succeeds. *)
+let rec scan_elems ib accu =
+  bscanf ib " %i %c"
+    (fun i -> function
+     | ';' -> scan_elems ib (i :: accu)
+     | ']' -> List.rev (i :: accu)
+     | c -> failwith "scan_elems")
+;;
+
+let rec scan_int_list ib =
+  bscanf ib "[ " ();
+  scan_elems ib []
+;;
+
+let test15 () =
+  scan_int_list (Scanning.from_string "[1;2;3;4]") = [1; 2; 3; 4];;
+
+test (test15 ())
+;;
+
+let rec scan_elems ib accu =
+  try
+  bscanf ib "%c %i"
+    (fun c i ->
+     match c with
+     | ';' -> scan_elems ib (i :: accu)
+     | ']' -> List.rev (i :: accu)
+     | '[' when accu = [] -> scan_elems ib (i :: accu)
+     | c -> print_endline (String.make 1 c); failwith "scan_elems")
+  with
+  | Scan_failure _ -> bscanf ib "]" (); accu
+  | End_of_file -> accu
+;;
+
+let scan_int_list ib = scan_elems ib [];;
+
+let test16 () =
+  scan_int_list (Scanning.from_string "[]") = List.rev [] &&
+  scan_int_list (Scanning.from_string "[1;2;3;4]") = List.rev [1;2;3;4] &&
+  scan_int_list (Scanning.from_string "[1;2;3;4; ]") = List.rev [1;2;3;4] &&
+  (* Should fail but succeeds! *)
+  scan_int_list (Scanning.from_string "[1;2;3;4") = List.rev [1;2;3;4];;
+
+test (test16 ())
+;;
+
+let rec scan_elems ib accu =
+  bscanf ib " %i%[]; \t\n\r]"
+    (fun i s ->
+     match s with
+     | ";" -> scan_elems ib (i :: accu)
+     | "]" -> List.rev (i :: accu)
+     | s -> List.rev (i :: accu))
+;;
+
+let scan_int_list ib =
+  bscanf ib " [" ();
+  scan_elems ib []
+;;
+
+let test17 () =
+  scan_int_list (Scanning.from_string "[1;2;3;4]") = [1;2;3;4] &&
+  scan_int_list (Scanning.from_string "[1;2;3;4; ]") = [1;2;3;4] &&
+  (* Should fail but succeeds! *)
+  scan_int_list (Scanning.from_string "[1;2;3;4 5]") = [1;2;3;4];;
+
+test (test17 ())
+;;
+
+let rec scan_elems ib accu =
+  bscanf ib " %c " (fun c ->
+    match c with
+    | '[' when accu = [] ->
+        (* beginning of list: could find either
+           - an int, if the list is not empty,
+           - the char ], if the list is empty. *)
+        bscanf ib "%[]]"
+          (function
+           | "]" -> accu
+           | _ ->
+             bscanf ib " %i " (fun i ->
+               scan_rest ib (i :: accu)))
+    | _ -> failwith "scan_elems")
+
+and scan_rest ib accu =
+  bscanf ib " %c " (fun c ->
+    match c with
+    | ';' ->
+        bscanf ib "%[]]"
+          (function
+           | "]" -> accu
+           | _ ->
+             bscanf ib " %i " (fun i ->
+             scan_rest ib (i :: accu)))
+    | ']' -> accu
+    | _ -> failwith "scan_rest")
+;;
+
+let scan_int_list ib = List.rev (scan_elems ib []);;
+
+let test18 () =
+  scan_int_list (Scanning.from_string "[]") = [] &&
+  scan_int_list (Scanning.from_string "[ ]") = [] &&
+  scan_int_list (Scanning.from_string "[1;2;3;4]") = [1;2;3;4] &&
+  scan_int_list (Scanning.from_string "[1;2;3;4; ]") = [1;2;3;4];;
+
+test (test18 ())
+;;
+
+(* Those properly fail *)
+
+let test19 () =
+  failure_test
+    scan_int_list (Scanning.from_string "[1;2;3;4 5]")
+    "scan_rest"
+;;
+
+(test19 ())
+;;
+
+let test20 () =
+  scan_failure_test
+    scan_int_list (Scanning.from_string "[1;2;3;4;; 5]");;
+
+(test20 ())
+;;
+
+let test21 () =
+  scan_failure_test
+    scan_int_list (Scanning.from_string "[1;2;3;4;;");;
+
+(test21 ())
+;;
+
+let rec scan_elems ib accu =
+  bscanf ib "%1[];]" (function
+  | "]" -> accu
+  | ";" -> scan_rest ib accu
+  | _ ->
+    failwith
+      (Printf.sprintf "scan_int_list" (*
+        "scan_int_list: char %i waiting for ']' or ';' but found %c"
+        (Scanning.char_count ib) (Scanning.peek_char ib)*)))
+
+and scan_rest ib accu =
+  bscanf ib "%[]]" (function
+  | "]" -> accu
+  | _ -> scan_elem ib accu)
+
+and scan_elem ib accu =
+  bscanf ib " %i " (fun i -> scan_elems ib (i :: accu))
+;;
+
+let scan_int_list ib =
+  bscanf ib " [ " ();
+  List.rev (scan_rest ib [])
+;;
+
+let test22 () =
+  scan_int_list (Scanning.from_string "[]") = [] &&
+  scan_int_list (Scanning.from_string "[ ]") = [] &&
+  scan_int_list (Scanning.from_string "[1]") = [1] &&
+  scan_int_list (Scanning.from_string "[1;2;3;4]") = [1;2;3;4] &&
+  scan_int_list (Scanning.from_string "[1;2;3;4;]") = [1;2;3;4];;
+
+test (test22 ())
+;;
+
+(* Should work but does not with this version of scan_int_list!
+scan_int_list (Scanning.from_string "[1;2;3;4; ]");;
+(* Should lead to a bad input error. *)
+scan_int_list (Scanning.from_string "[1;2;3;4 5]");;
+scan_int_list (Scanning.from_string "[1;2;3;4;;");;
+scan_int_list (Scanning.from_string "[1;2;3;4;; 5]");;
+scan_int_list (Scanning.from_string "[1;2;3;4;; 23]");;
+*)
+
+let rec scan_elems ib accu =
+  try bscanf ib " %i %1[;]" (fun i s ->
+   if s = "" then i :: accu else scan_elems ib (i :: accu)) with
+  | Scan_failure _ -> accu
+;;
+
+(* The general int list scanner. *)
+let rec scan_int_list ib =
+  bscanf ib "[ " ();
+  let accu = scan_elems ib [] in
+  bscanf ib " ]" ();
+  List.rev accu
+;;
+
+(* The general HO list scanner.
+   This version does not fix the separator, nor the spacing before and after
+   the separator (it uses the functional argument [scan_elem] to parse the
+   separator, its spacing, and the item).
+ *)
+let rec scan_elems ib scan_elem accu =
+  try scan_elem ib (fun i s ->
+    let accu = i :: accu in
+    if s = "" then accu else scan_elems ib scan_elem accu) with
+  | Scan_failure _ -> accu
+;;
+
+let scan_list scan_elem ib =
+  bscanf ib "[ " ();
+  let accu = scan_elems ib scan_elem [] in
+  bscanf ib " ]" ();
+  List.rev accu
+;;
+
+(* Deriving particular list scanners from the HO list scanner. *)
+let scan_int_elem ib = bscanf ib " %i %1[;]";;
+let scan_int_list = scan_list scan_int_elem;;
+
+let test23 () =
+  scan_int_list (Scanning.from_string "[]") = [] &&
+  scan_int_list (Scanning.from_string "[ ]") = [] &&
+  scan_int_list (Scanning.from_string "[1]") = [1] &&
+  scan_int_list (Scanning.from_string "[1;2;3;4]") = [1;2;3;4] &&
+  scan_int_list (Scanning.from_string "[1;2;3;4;]") = [1;2;3;4];;
+
+test (test23 ())
+;;
+
+let test24 () =
+  scan_failure_test scan_int_list (Scanning.from_string "[1;2;3;4 5]")
+and test25 () =
+  scan_failure_test scan_int_list (Scanning.from_string "[1;2;3;4;;")
+and test26 () =
+  scan_failure_test scan_int_list (Scanning.from_string "[1;2;3;4;; 5]")
+and test27 () =
+  scan_failure_test scan_int_list (Scanning.from_string "[1;2;3;4;; 23]");;
+
+ (test24 ()) &&
+ (test25 ()) &&
+ (test26 ()) &&
+ (test27 ())
+;;
+
+(* To scan an OCaml string:
+   the format is "\"%s@\"".
+   A better way would be to add a %S (String.escaped), a %C (Char.escaped).
+   This is now available. *)
+let scan_string_elem ib = bscanf ib " \"%s@\" %1[;]";;
+let scan_string_list = scan_list scan_string_elem;;
+
+let scan_String_elem ib = bscanf ib " %S %1[;]";;
+let scan_String_list = scan_list scan_String_elem;;
+
+let test28 () =
+  scan_string_list (Scanning.from_string "[]") = [] &&
+  scan_string_list (Scanning.from_string "[\"Le\"]") = ["Le"] &&
+  scan_string_list
+    (Scanning.from_string "[\"Le\";\"langage\";\"Objective\";\"Caml\"]") =
+    ["Le"; "langage"; "Objective"; "Caml"] &&
+  scan_string_list
+    (Scanning.from_string "[\"Le\";\"langage\";\"Objective\";\"Caml\"; ]") =
+    ["Le"; "langage"; "Objective"; "Caml"] &&
+
+  scan_String_list (Scanning.from_string "[]") = [] &&
+  scan_String_list (Scanning.from_string "[\"Le\"]") = ["Le"] &&
+  scan_String_list
+    (Scanning.from_string "[\"Le\";\"langage\";\"Objective\";\"Caml\"]") =
+    ["Le"; "langage"; "Objective"; "Caml"] &&
+  scan_String_list
+    (Scanning.from_string "[\"Le\";\"langage\";\"Objective\";\"Caml\"; ]") =
+    ["Le"; "langage"; "Objective"; "Caml"];;
+
+test (test28 ())
+;;
+
+(* The general HO list scanner with continuations. *)
+let rec scan_elems ib scan_elem accu =
+  scan_elem ib
+    (fun i s ->
+     let accu = i :: accu in
+     if s = "" then accu else scan_elems ib scan_elem accu)
+    (fun ib exc -> accu)
+;;
+
+let scan_list scan_elem ib =
+  bscanf ib "[ " ();
+  let accu = scan_elems ib scan_elem [] in
+  bscanf ib " ]" ();
+  List.rev accu
+;;
+
+(* Deriving particular list scanners from the HO list scanner. *)
+let scan_int_elem ib f ek = kscanf ib ek " %i %1[;]" f;;
+let scan_int_list = scan_list scan_int_elem;;
+
+let test29 () =
+  scan_int_list (Scanning.from_string "[]") = [] &&
+  scan_int_list (Scanning.from_string "[ ]") = [] &&
+  scan_int_list (Scanning.from_string "[1]") = [1] &&
+  scan_int_list (Scanning.from_string "[1;2;3;4]") = [1;2;3;4] &&
+  scan_int_list (Scanning.from_string "[1;2;3;4;]") = [1;2;3;4];;
+
+test (test29 ())
+;;
+
+let scan_string_elem ib f ek = kscanf ib ek " %S %1[;]" f;;
+let scan_string_list = scan_list scan_string_elem;;
+
+let test30 () =
+  scan_string_list (Scanning.from_string "[]") = [] &&
+  scan_string_list (Scanning.from_string "[ ]") = [] &&
+  scan_string_list (Scanning.from_string "[ \"1\" ]") = ["1"] &&
+  scan_string_list
+    (Scanning.from_string "[\"1\"; \"2\"; \"3\"; \"4\"]") =
+    ["1"; "2"; "3"; "4"] &&
+  scan_string_list
+    (Scanning.from_string "[\"1\"; \"2\"; \"3\"; \"4\";]") =
+    ["1"; "2"; "3"; "4"];;
+
+test (test30 ())
+;;
+
+(* A generic polymorphic item scanner, *)
+let scan_elem fmt ib f ek = kscanf ib ek fmt f;;
+
+(* Derivation of list scanners from the generic polymorphic item scanner
+   applications. *)
+let scan_int_list = scan_list (scan_elem " %i %1[;]");;
+let scan_string_list = scan_list (scan_elem " %S %1[;]");;
+let scan_bool_list = scan_list (scan_elem " %B %1[;]");;
+let scan_char_list = scan_list (scan_elem " %C %1[;]");;
+let scan_float_list = scan_list (scan_elem " %f %1[;]");;
+
+(* In this version the [scan_elem] function should be a [kscanf] like
+   scanning function: we give it an error continuation.
+
+   The [scan_elem] argument, probably use some partial application of the
+   following generic [scan_elem]:
+
+   let scan_elem fmt ib f ek = kscanf ib ek fmt f;;
+
+   For instance, a suitable [scan_elem] for integers could be:
+
+   let scan_integer_elem = scan_elem " %i";;
+
+*)
+let rec scan_elems ib scan_elem accu =
+  scan_elem ib
+    (fun i ->
+     let accu = i :: accu in
+     kscanf ib
+      (fun ib exc -> accu)
+      " %1[;]"
+      (fun s -> if s = "" then accu else scan_elems ib scan_elem accu))
+  (fun ib exc -> accu)
+;;
+
+let scan_list scan_elem ib =
+  bscanf ib "[ " ();
+  let accu = scan_elems ib scan_elem [] in
+  bscanf ib " ]" ();
+  List.rev accu
+;;
+
+let scan_int_list = scan_list (scan_elem " %i");;
+let scan_string_list = scan_list (scan_elem " %S");;
+let scan_bool_list = scan_list (scan_elem " %B");;
+let scan_char_list = scan_list (scan_elem " %C");;
+let scan_float_list = scan_list (scan_elem " %f");;
+
+let test31 () =
+  scan_int_list (Scanning.from_string "[]") = [] &&
+  scan_int_list (Scanning.from_string "[ ]") = [] &&
+  scan_int_list (Scanning.from_string "[1]") = [1] &&
+  scan_int_list (Scanning.from_string "[1;2;3;4]") = [1;2;3;4] &&
+  scan_int_list (Scanning.from_string "[1;2;3;4;]") = [1;2;3;4];;
+
+test (test31 ())
+;;
+
+let test32 () =
+  scan_string_list (Scanning.from_string "[]") = [] &&
+  scan_string_list (Scanning.from_string "[ ]") = [] &&
+  scan_string_list (Scanning.from_string "[ \"1\" ]") = ["1"] &&
+  scan_string_list
+    (Scanning.from_string "[\"1\"; \"2\"; \"3\"; \"4\"]") =
+    ["1"; "2"; "3"; "4"] &&
+  scan_string_list
+    (Scanning.from_string "[\"1\"; \"2\"; \"3\"; \"4\";]") =
+    ["1"; "2"; "3"; "4"];;
+
+test (test32 ())
+;;
+
+(* Using [kscanf] only.
+
+   We use format values to stand for ``functional'' specifications to scan
+   the elements of lists.
+
+   The list item separator and the separator spacing are builtin into the
+   [scan_elems] iterator and thus are conveniently omitted from the
+   definitional format for item scanning.
+*)
+let rec scan_elems ib scan_elem_fmt accu =
+  kscanf ib (fun ib exc -> accu)
+    scan_elem_fmt
+    (fun i ->
+     let accu = i :: accu in
+     bscanf ib
+       " %1[;] "
+       (function
+        | "" -> accu
+        | _ -> scan_elems ib scan_elem_fmt accu)
+    )
+;;
+
+let scan_list scan_elem_fmt ib =
+  bscanf ib "[ " ();
+  let accu = scan_elems ib scan_elem_fmt [] in
+  bscanf ib " ]" ();
+  List.rev accu
+;;
+
+let scan_int_list = scan_list "%i";;
+let scan_string_list = scan_list "%S";;
+let scan_bool_list = scan_list "%B";;
+let scan_char_list = scan_list "%C";;
+let scan_float_list = scan_list "%f";;
+
+let test33 () =
+  scan_int_list (Scanning.from_string "[]") = [] &&
+  scan_int_list (Scanning.from_string "[ ]") = [] &&
+  scan_int_list (Scanning.from_string "[ 1 ]") = [1] &&
+  scan_int_list (Scanning.from_string "[ 1; 2; 3; 4 ]") = [1; 2; 3; 4] &&
+  scan_int_list (Scanning.from_string "[1;2;3;4;]") = [1; 2; 3; 4];;
+
+test (test33 ())
+;;
+
+let test34 () =
+  scan_string_list (Scanning.from_string "[]") = [] &&
+  scan_string_list (Scanning.from_string "[ ]") = [] &&
+  scan_string_list (Scanning.from_string "[ \"1\" ]") = ["1"] &&
+  scan_string_list
+    (Scanning.from_string "[\"1\"; \"2\"; \"3\"; \"4\"]") =
+    ["1"; "2"; "3"; "4"] &&
+  scan_string_list
+    (Scanning.from_string "[\"1\"; \"2\"; \"3\"; \"4\";]") =
+    ["1"; "2"; "3"; "4"];;
+
+test (test34 ())
+;;
+
+(* Using kscanf only.
+
+   Same as the preceding functional, except that we no more use format values
+   to scan items: we use scanners that scan elements of the list on the
+   fly.
+*)
+(* This version cannot handle empty lists!
+let rec scan_elems ib scan_elem accu =
+  scan_elem ib
+    (fun elem ->
+     let accu = elem :: accu in
+     kscanf ib (fun ib exc -> accu)
+       " %1[;] "
+       (function
+        | "" -> accu
+        | _ -> scan_elems ib scan_elem accu))
+;;
+*)
+
+(* We use [kscanf] with a [%r] format ! *)
+let rec scan_elems scan_elem accu ib =
+  kscanf ib (fun ib exc -> accu)
+    "%r"
+    (function ib ->
+     scan_elem ib
+       (function elem ->
+        let accu = elem :: accu in
+        bscanf ib
+          " %1[;] "
+          (function
+           | "" -> accu
+           | _ -> scan_elems scan_elem accu ib)))
+    (function l -> l)
+;;
+
+let scan_list scan_elem ib =
+  bscanf ib "[ " ();
+  let accu = scan_elems scan_elem [] ib in
+  bscanf ib " ]" ();
+  List.rev accu
+;;
+
+(* We may also try a version with only one format:
+   We also changed the type of [scan_elem] to partially apply it to its
+   ``natural'' continuation.
+let rec scan_elems scan_elem accu ib =
+  (* We use [kscanf], so that:
+     if the element reader fails, we can return the list of elements read so
+     far. *)
+  kscanf ib (fun ib exc -> accu)
+    (* The format string for [kscanf]: we read an element using [scan_elem],
+       then find a semi-colon if any, in order to decide if we stop reading
+       or go on with other elements. *)
+    "%r %1[;] "
+    (* The reader: once an element has been read it returns the new accu. *)
+    (scan_elem (function elem -> elem :: accu))
+    (fun accu s ->
+     (* Cannot find a semi-colon: no more elements to read. *)
+     if s = "" then accu
+     (* We found a semi-colon: go on with the new accu. *)
+     else scan_elems scan_elem accu ib)
+;;
+
+let scan_list scan_elem ib =
+  bscanf ib "[ %r ]" (scan_elems scan_elem []) List.rev
+;;
+
+(* For instance:
+let scan_float f ib = Scanf.bscanf ib "%f" f;;
+# scan_list scan_float;;
+- : Scanf.Scanning.scanbuf -> float list = <fun>
+*)
+
+(* The element scanner builder. *)
+let make_scan_elem fmt f ib = Scanf.bscanf ib fmt f;;
+
+(* Promote an element reader format to an element list reader. *)
+let list_scanner fmt = scan_list (make_scan_elem fmt);;
+
+let scan_float = make_scan_elem "%f";;
+
+scan_list scan_float;;
+
+list_scanner "%f";;
+- : Scanf.Scanning.scanbuf -> float list = <fun>
+*)
+
+(* The prototype of a [scan_elem] function for the generic [scan_list]
+   functional.
+   This [scan_elem] scans a floating point number. *)
+let scan_float ib = Scanf.bscanf ib "%f";;
+let scan_float_list = scan_list scan_float;;
+
+(* In the following list scanners, we directly give the [scan_elem] function
+   as an immediate function value argument to the polymorphic
+   [scan_list]. *)
+let scan_int_list = scan_list (fun ib -> Scanf.bscanf ib "%i");;
+let scan_string_list = scan_list (fun ib -> Scanf.bscanf ib "%S");;
+let scan_bool_list = scan_list (fun ib -> Scanf.bscanf ib "%B");;
+let scan_char_list = scan_list (fun ib -> Scanf.bscanf ib "%C");;
+
+(* [scan_list] is truly polymorphic: scanning a list of lists of items
+   is a one liner!
+
+   Here we scan list of lists of floats. *)
+let scan_float_list_list =
+  scan_list
+    (fun ib k -> k (scan_list (fun ib -> Scanf.bscanf ib "%f") ib))
+;;
+
+let scan_float_list_list =
+  scan_list
+    (fun ib k -> k (scan_list scan_float ib))
+;;
+
+let scan_float_list_list =
+  scan_list
+    (fun ib k -> k (scan_float_list ib))
+;;
+
+(* The killer way to define [scan_float_list_list]. *)
+(* let scan_float_list_list = scan_list scan_float_list;; *)
+
+let test340 () =
+  scan_float_list_list
+   (Scanning.from_string "[[1.0] ; []; [2.0; 3; 5.0; 6.];]") =
+  [[1.]; []; [2.; 3.; 5.; 6.]]
+;;
+
+(* A general scan_list_list functional. *)
+let scan_list_list scan_elems ib =
+  scan_list
+    (fun ib k -> k (scan_elems ib)) ib
+;;
+
+let scan_float_list_list = scan_list_list scan_float_list;;
+
+(* Programming with continuations :) *)
+let scan_float_item ib k = k (scan_float ib (fun x -> x));;
+let scan_float_list ib k = k (scan_list scan_float_item ib);;
+let scan_float_list_list ib k = k (scan_list scan_float_list ib);;
+
+(* Testing the %N format. *)
+let test35 () =
+  sscanf "" "%N" (fun x -> x) = 0 &&
+  sscanf "456" "%N" (fun x -> x) = 0 &&
+  sscanf "456" "%d%N" (fun x y -> x, y) = (456, 1) &&
+  sscanf " " "%N%s%N" (fun x s y -> x, s, y) = (0, "", 1)
+;;
+
+test (test340 () && test35 ())
+;;
+
+(* The preferred reader functionnals. *)
+
+(* To read a list as in OCaml (elements are ``blank + semicolon + blank''
+   separated, and the list is enclosed in brackets). *)
+let rec read_elems read_elem accu ib =
+  kscanf ib (fun ib exc -> accu)
+    "%r %1[;] "
+    (read_elem (function elem -> elem :: accu))
+    (fun accu s -> if s = "" then accu else read_elems read_elem accu ib)
+;;
+
+let read_list read_elem ib =
+  bscanf ib "[ %r ]" (read_elems read_elem []) List.rev
+;;
+
+(* The element reader builder. *)
+let make_read_elem fmt f ib = Scanf.bscanf ib fmt f;;
+
+(* Promote an element reader format to an element list reader. *)
+let scan_List fmt = read_list (make_read_elem fmt);;
+
+(* Example for list of floatting point numbers. *)
+(*
+scan_List "%f";;
+- : Scanf.Scanning.scanbuf -> float list = <fun>
+
+(* To read a list as a succession of elements separated by a blank. *)
+let rec read_elems read_elem accu ib =
+  kscanf ib (fun ib exc -> accu)
+    "%r "
+    (read_elem (function elem -> elem :: accu))
+    (fun accu -> read_elems read_elem accu ib)
+;;
+
+let read_list read_elem ib =
+   List.rev (read_elems read_elem [] ib)
+;;
+
+(* Promote an element reader format to an element list reader. *)
+let scan_list fmt = read_list (make_read_elem fmt);;
+
+scan_list "%f";;
+*)
+
+(* Testing the %n format. *)
+let test36 () =
+  sscanf "" "%n" (fun x -> x) = 0 &&
+  sscanf "456" "%n" (fun x -> x) = 0 &&
+  sscanf "456" "%d%n" (fun x y -> x, y) = (456, 3) &&
+  sscanf " " "%n%s%n" (fun x s y -> x, s, y) = (0, "", 0)
+;;
+
+test (test36 ())
+;;
+
+(* Weird tests to empty strings or formats. *)
+let test37 () =
+  sscanf "" "" true &&
+  sscanf "" "" (fun x -> x) 1 = 1 &&
+  sscanf "123" "" (fun x -> x) 1 = 1
+;;
+
+test (test37 ())
+;;
+
+(* Testing end of input condition. *)
+let test38 () =
+  sscanf "a" "a%!" true &&
+  sscanf "a" "a%!%!" true &&
+  sscanf " a" " a%!" true &&
+  sscanf "a " "a %!" true &&
+  sscanf "" "%!" true &&
+  sscanf " " " %!" true &&
+  sscanf "" " %!" true &&
+  sscanf "" " %!%!" true
+;;
+
+test (test38 ())
+;;
+
+(* Weird tests on empty buffers. *)
+let test39 () =
+  let is_empty_buff ib =
+    Scanning.beginning_of_input ib &&
+    Scanning.end_of_input ib in
+
+  let ib = Scanning.from_string "" in
+  is_empty_buff ib &&
+  (* Do it twice since testing empty buff could incorrectly
+     thraw an exception or wrongly change the beginning_of_input condition. *)
+  is_empty_buff ib
+;;
+
+test (test39 ())
+;;
+
+(* Testing ranges. *)
+let test40 () =
+ let s = "cba" in
+ let ib = Scanning.from_string s in
+ bscanf ib "%[^ab]%s%!" (fun s1 s2 -> s1 = "c" && s2 = "ba")
+;;
+
+test (test40 ())
+;;
+
+let test41 () =
+ let s = "cba" in
+ let ib = Scanning.from_string s in
+ bscanf ib "%[^abc]%[cba]%!" (fun s1 s2 -> s1 = "" && s2 = "cba")
+;;
+
+test (test41 ())
+;;
+
+let test42 () =
+ let s = "defcbaaghi" in
+ let ib = Scanning.from_string s in
+ bscanf ib "%[^abc]%[abc]%s%!" (fun s1 s2 s3 ->
+   s1 = "def" && s2 = "cbaa" && s3 = "ghi") &&
+ let ib = Scanning.from_string s in
+ bscanf ib "%s@\t" (fun s -> s = "defcbaaghi")
+;;
+
+test (test42 ())
+;;
+
+(* Testing end of file condition (bug found). *)
+let test43, test44 =
+ let s = "" in
+ let ib = Scanning.from_string s in
+ (fun () -> bscanf ib "%i%!" (fun i -> i)),
+ (fun () -> bscanf ib "%!%i" (fun i -> i))
+;;
+
+test_raises_this_exc End_of_file test43 () &&
+test_raises_this_exc End_of_file test44 ()
+;;
+
+(* Testing small range scanning (bug found once). *)
+let test45 () =
+ let s = "12.2" in
+ let ib = Scanning.from_string s in
+ bscanf ib "%[0-9].%[0-9]%s%!" (fun s1 s2 s3 ->
+   s1 = "12" && s2 = "2" && s3 = "")
+;;
+
+test (test45 ())
+;;
+
+(* Testing printing of meta formats. *)
+
+let test46, test47 =
+  (fun () ->
+     Printf.sprintf "%i %(%s%)."
+       1 "spells one, %s" "in english"),
+  (fun () ->
+     Printf.sprintf "%i %{%s%}, %s."
+       1 "spells one %s" "in english")
+;;
+
+test (test46 () = "1 spells one, in english.")
+;;
+test (test47 () = "1 %s, in english.")
+;;
+
+(* Testing scanning of meta formats. *)
+let test48 () =
+  (* Testing format_from_string. *)
+  let test_meta_read s fmt efmt = format_from_string s fmt = efmt in
+  (* Test if format %i is indeed read as %i. *)
+  let s, fmt = "%i", format_of_string "%i" in
+  test_meta_read s fmt fmt &&
+  (* Test if format %i is compatible with %d and indeed read as %i. *)
+  let s, fmt = "%i", format_of_string "%d" in
+  test_meta_read s fmt "%i" &&
+  (* Complex test of scanning a meta format specified in the scanner input
+     format string and extraction of its specification from a string. *)
+  sscanf "12 \"%i\"89 " "%i %{%d%}%s %!"
+    (fun i f s -> i = 12 && f = "%i" && s = "89") &&
+  (* Testing scanf format string replacement *)
+  let k s =
+    Scanf.sscanf s
+      "%(%f%)" (fun _fmt i -> i) in
+  k "\" : %1f\": 987654321" = 9.0  &&
+  k "\" : %2f\": 987654321" = 98.0 &&
+  k "\" : %3f\": 9.87654321" = 9.8 &&
+  k "\" : %4f\": 9.87654321" = 9.87 &&
+
+  let h s =
+    Scanf.sscanf s
+      "Read integers with %(%i%)" (fun _fmt i -> i) in
+  h "Read integers with \"%1d\"987654321" = 9  &&
+  h "Read integers with \"%2d\"987654321" = 98 &&
+  h "Read integers with \"%3u\"987654321" = 987 &&
+  h "Read integers with \"%4x\"987654321" = 39030 &&
+
+  let i s =
+    Scanf.sscanf s
+      "with %(%i %s%)" (fun _fmt amount currency -> amount, currency) in
+  i "with \" : %d %s\" :        21 euros" = (21, "euros")  &&
+  i "with \" : %d %s\" : 987654321 dollars" = (987654321, "dollars") &&
+  i "with \" : %u %s\" :     54321 pounds" = (54321, "pounds") &&
+  i "with \" : %x %s\" :       321 yens" = (801, "yens") &&
+
+  let j s =
+    Scanf.sscanf s
+      "with %(%i %_s %s%)" (fun _fmt amount currency -> amount, currency) in
+  j "with \" : %1d %_s %s\" : 987654321 euros" = (9, "euros")  &&
+  j "with \" : %2d %_s %s\" : 987654321 dollars" = (98, "dollars") &&
+  j "with \" : %3u %_s %s\" : 987654321 pounds" = (987, "pounds") &&
+  j "with \" : %4x %_s %s\" : 987654321 yens" = (39030, "yens")
+;;
+
+test (test48 ())
+;;
+
+(* Testing stoppers after ranges. *)
+let test49 () =
+  sscanf "as" "%[\\]" (fun s -> s = "") &&
+  sscanf "as" "%[\\]%s" (fun s t -> s = "" && t = "as") &&
+  sscanf "as" "%[\\]%s%!" (fun s t -> s = "" && t = "as") &&
+  sscanf "as" "%[a..z]" (fun s -> s = "a") &&
+  sscanf "as" "%[a-z]" (fun s -> s = "as") &&
+  sscanf "as" "%[a..z]%s" (fun s t -> s = "a" && t = "s") &&
+  sscanf "as" "%[a-z]%s" (fun s t -> s = "as" && t = "") &&
+  sscanf "-as" "%[-a-z]" (fun s -> s = "-as") &&
+  sscanf "-as" "%[-a-z]@s" (fun s -> s = "-a") &&
+  sscanf "-as" "-%[a]@s" (fun s -> s = "a") &&
+  sscanf "-asb" "-%[a]@sb%!" (fun s -> s = "a") &&
+  sscanf "-asb" "-%[a]@s%s" (fun s t -> s = "a" && t = "b")
+;;
+
+test (test49 ())
+;;
+
+(* Testing buffers defined via functions
+   + co-routines that read and write from the same buffers
+   + range chars and proper handling of \n
+   + the end of file condition. *)
+let next_char ob () =
+  let s = Buffer.contents ob in
+  let len = String.length s in
+  if len = 0 then raise End_of_file else
+  let c = s.[0] in
+  Buffer.clear ob;
+  Buffer.add_string ob (String.sub s 1 (len - 1));
+  c
+;;
+
+let send_string ob s =
+  Buffer.add_string ob s; Buffer.add_char ob '\n';;
+let send_int ob i = send_string ob (Int.to_string i);;
+
+let rec reader =
+  let count = ref 0 in
+  (fun ib ob ->
+    if Scanf.Scanning.beginning_of_input ib then begin
+      count := 0; send_string ob "start"; writer ib ob end else
+    Scanf.bscanf ib "%[^\n]\n" (function
+    | "stop" -> send_string ob "stop"; writer ib ob
+    | s ->
+      let l = String.length s in
+      count := l + !count;
+      if !count >= 100 then begin
+        send_string ob "stop";
+        send_int ob !count
+        end else
+      send_int ob l;
+      writer ib ob))
+
+and writer ib ob =
+  Scanf.bscanf ib "%s\n" (function
+    | "start" -> send_string ob "Hello World!"; reader ib ob
+    | "stop" -> Scanf.bscanf ib "%i" (function i -> i)
+    | s -> send_int ob (int_of_string s); reader ib ob);;
+
+let go () =
+  let ob = Buffer.create 17 in
+  let ib = Scanf.Scanning.from_function (next_char ob) in
+  reader ib ob
+;;
+
+let test50 () = go () = 100;;
+
+test (test50 ())
+;;
+
+(* Simple tests may also fail!
+   Ensure this is not the case with the current version for module [Scanf]. *)
+let test51 () =
+ sscanf "Hello" "%s" id = "Hello" &&
+ sscanf "Hello\n" "%s\n" id = "Hello" &&
+ sscanf "Hello\n" "%s%s\n" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "") &&
+ sscanf "Hello\nWorld" "%s\n%s%!" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "World") &&
+ sscanf "Hello\nWorld!" "%s\n%s" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "World!") &&
+ sscanf "Hello\n" "%s@\n%s" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "") &&
+ sscanf "Hello \n" "%s@\n%s" (fun s1 s2 ->
+   s1 = "Hello " && s2 = "")
+;;
+
+test (test51 ())
+;;
+
+(* Tests that indeed the [%s@c] format works properly.
+   Also tests the difference between [\n] and [@\n] is correctly handled.
+   In particular, tests that if no [c] character can be found in the
+   input, then the token obtained for [%s@c] spreads to the end of
+   input. *)
+let test52 () =
+ sscanf "Hello\n" "%s@\n" id = "Hello" &&
+ sscanf "Hello" "%s@\n" id = "Hello" &&
+ sscanf "Hello" "%s%s@\n" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "") &&
+ sscanf "Hello\nWorld" "%s@\n%s%!" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "World") &&
+ sscanf "Hello\nWorld!" "%s@\n%s@\n" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "World!") &&
+ sscanf "Hello\n" "%s@\n%s" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "") &&
+ sscanf "Hello \n" "%s%s@\n" (fun s1 s2 ->
+   s1 = "Hello" && s2 = " ") &&
+sscanf "Hello \n" "%s%s%_1[ ]\n" (fun s1 s2 ->
+         s1 = "Hello" && s2 = "") &&
+ sscanf "Hello \n" "%s%_1[ ]%s\n" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "") &&
+ sscanf "Hello\nWorld" "%s\n%s%!" (fun s1 s2 ->
+      s1 = "Hello" && s2 = "World") &&
+ sscanf "Hello\nWorld!" "%s\n%s%!" (fun s1 s2 ->
+      s1 = "Hello" && s2 = "World!") &&
+ sscanf "Hello\nWorld!" "%s\n%s@!%!" (fun s1 s2 ->
+      s1 = "Hello" && s2 = "World") &&
+ (* PR#6791 *)
+ sscanf "Hello{foo}" "%s@{%s" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "foo}") &&
+ sscanf "Hello[foo]" "%s@[%s" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "foo]")
+;;
+
+test (test52 ())
+;;
+
+(* Reading native, int32 and int64 numbers. *)
+let test53 () =
+ sscanf "123" "%nd" id = 123n &&
+ sscanf "124" "%nd" (fun i -> Nativeint.pred i = 123n) &&
+
+ sscanf "123" "%ld" id = 123l &&
+ sscanf "124" "%ld" (fun i -> Int32.succ i = 125l) &&
+
+ sscanf "123" "%Ld" id = 123L &&
+ sscanf "124" "%Ld" (fun i -> Int64.pred i = 123L)
+;;
+
+test (test53 ())
+;;
+
+(* Routines to create the file that tscanf uses as a testbed case. *)
+let create_tscanf_data ob lines =
+  let add_line (p, e) =
+    Buffer.add_string ob (Printf.sprintf "%S" p);
+    Buffer.add_string ob " -> ";
+    Buffer.add_string ob (Printf.sprintf "%S" e);
+    Buffer.add_string ob ";\n" in
+  List.iter add_line lines
+;;
+
+let write_tscanf_data_file fname lines =
+  let oc = open_out fname in
+  let ob = Buffer.create 42 in
+  create_tscanf_data ob lines;
+  Buffer.output_buffer oc ob;
+  close_out oc
+;;
+
+(* The tscanf testbed case file name. *)
+let tscanf_data_file = "tscanf_data";;
+(* The contents of the tscanf testbed case file. *)
+let tscanf_data_file_lines = [
+    "Objective", "Caml";
+]
+;;
+(* We write the tscanf testbed case file. *)
+write_tscanf_data_file tscanf_data_file tscanf_data_file_lines
+;;
+
+(* Then we verify that its contents is indeed correct:
+   the lines written into the [tscanf_data] file should be the same as the
+   lines read from it. *)
+
+(* Reading back tscanf_data_file_lines (hence, testing data file reading as
+   well). *)
+let get_lines fname =
+  let ib = Scanf.Scanning.from_file fname in
+  let l = ref [] in
+  try
+    while not (Scanf.Scanning.end_of_input ib) do
+      Scanf.bscanf ib " %S -> %S; " (fun x y ->
+        l := (x, y) :: !l)
+    done;
+    List.rev !l
+  with
+  | Scanf.Scan_failure s ->
+    failwith (Printf.sprintf "in file %s, %s" fname s)
+  | End_of_file ->
+    failwith (Printf.sprintf "in file %s, unexpected end of file" fname)
+;;
+
+(* Simply test that the list of lines read from the file is the list of lines
+   written to it!. *)
+let test54 () =
+  get_lines tscanf_data_file = tscanf_data_file_lines
+;;
+
+test (test54 ())
+;;
+
+(* Creating digests for files. *)
+let add_digest_ib ob ib =
+  let digest s = String.uppercase_ascii (Digest.to_hex (Digest.string s)) in
+  let scan_line ib f = Scanf.bscanf ib "%[^\n\r]\n" f in
+  let output_line_digest s =
+    Buffer.add_string ob s;
+    Buffer.add_char ob '#'; Buffer.add_string ob (digest s);
+    Buffer.add_char ob '\n' in
+  try while true do scan_line ib output_line_digest done; with
+  | End_of_file -> ()
+;;
+
+let digest_file fname =
+  let ib = Scanf.Scanning.from_file fname in
+  let ob = Buffer.create 42 in
+  add_digest_ib ob ib;
+  Buffer.contents ob
+;;
+
+let test55 () =
+  let ob = Buffer.create 42 in
+  let ib =
+    create_tscanf_data ob tscanf_data_file_lines;
+    let s = Buffer.contents ob in
+    Buffer.clear ob;
+    Scanning.from_string s in
+  let tscanf_data_file_lines_digest = add_digest_ib ob ib; Buffer.contents ob in
+  digest_file tscanf_data_file = tscanf_data_file_lines_digest
+;;
+
+test (test55 ())
+;;
+
+(* Testing the number of characters read. *)
+let test56 () =
+   let g s = Scanf.sscanf s "%d%n" (fun i n -> (i, n)) in
+   g "99" = (99, 2) &&
+   g "99 syntaxes all in a row" = (99, 2) &&
+   g "-20 degrees Celsius" = (-20, 3)
+;;
+
+test (test56 ())
+;;
+
+(* Testing the scanning of formats. *)
+let test57 () =
+  (* Testing format_from_string. *)
+  let test_format_scan s fmt efmt =
+    format_from_string s fmt = efmt in
+  (* Test if format %i is indeed read as %i. *)
+  let s, fmt = " %i ", format_of_string "%i" in
+  test_format_scan s fmt " %i " &&
+  (* Test if format %i is compatible with %d and indeed read as %i. *)
+  let s, fmt = "%i", format_of_string "%d" in
+  test_format_scan s fmt "%i" &&
+
+  let s, fmt =
+    "Read an int %i then a string %s.",
+    format_of_string "Spec%difi%scation" in
+  test_format_scan s fmt "Read an int %i then a string %s." &&
+
+  let s, fmt =
+    "Read an int %i then a string \"%s\".",
+    format_of_string "Spec%difi%Scation" in
+  test_format_scan s fmt "Read an int %i then a string \"%s\"." &&
+
+  let s, fmt =
+    "Read an int %i then a string \"%s\".",
+    format_of_string "Spec%difi%scation" in
+  test_format_scan s fmt "Read an int %i then a string \"%s\"." &&
+
+  (* Complex test of scanning a meta format specified in the scanner input
+     format string and extraction of its specification from a string. *)
+  sscanf "12 \"%i\"89 " "%i %{%d%}%s %!"
+    (fun i f s -> i = 12 && f = "%i" && s = "89")
+;;
+
+test (test57 ())
+;;
+
+let test58 () =
+     sscanf "string1%string2" "%s@%%s" id = "string1"
+  && sscanf "string1%string2" "%s@%%%s" (^) = "string1string2"
+  && sscanf "string1@string2" "%[a-z0-9]@%s" (^) = "string1string2"
+  && sscanf "string1@%string2" "%[a-z0-9]%@%%%s" (^) = "string1string2"
+;;
+
+test (test58 ())
+;;
+
+(* skip test number "59" which is commented below *)
+let () = test (true);;
+(*
+let test59 () =
+;;
+
+test (test59 ())
+;;
+*)
+
+(* To be continued ...
+(* Trying to scan records. *)
+let rec scan_fields ib scan_field accu =
+  kscanf ib (fun ib exc -> accu)
+   scan_field
+   (fun i ->
+      let accu = i :: accu in
+      kscanf ib (fun ib exc -> accu)
+       " %1[;] "
+       (fun s ->
+          if s = "" then accu else scan_fields ib scan_field accu))
+;;
+
+let scan_record scan_field ib =
+  bscanf ib "{ " ();
+  let accu = scan_fields ib scan_field [] in
+  bscanf ib " }" ();
+  List.rev accu
+;;
+
+let scan_field ib =
+  bscanf ib "%s = %[^;]" (fun finame ficont -> finame, ficont);;
+*)
+
+(* testing formats that do not consume their input *)
+let test60 () =
+  sscanf "abc" "%0c%0c%c%n" (fun c1 c2 c3 n ->
+    c1 = 'a' && c2 = 'a' && c3 = 'a' && n = 1)
+  &&
+  sscanf "abc" "%0s%s" (fun s1 s2 -> s1 = "" && s2 = "abc")
+  &&
+  sscanf "abc" "%1s%s" (fun s1 s2 -> s1 = "a" && s2 = "bc")
+;;
+
+test (test60 ())
+;;
+
+let test61 () =
+  let test fmt =
+    format_from_string (string_of_format fmt) fmt = fmt
+  in
+  test "%s/%a" &&
+  test "\\ " &&
+  test "\\x" &&
+  test "\\x25s" &&
+  test "\\\"%s" &&
+  test "\\"
+;;
+
+test (test61 ())
+;;
diff --git a/testsuite/tests/lib-scanf/tscanf.reference b/testsuite/tests/lib-scanf/tscanf.reference
new file mode 100644
index 00000000..a06a17ed
--- /dev/null
+++ b/testsuite/tests/lib-scanf/tscanf.reference
@@ -0,0 +1,2 @@
+ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
+All tests succeeded.
diff --git a/testsuite/tests/lib-seq/test.ml b/testsuite/tests/lib-seq/test.ml
new file mode 100644
index 00000000..96c9d3d6
--- /dev/null
+++ b/testsuite/tests/lib-seq/test.ml
@@ -0,0 +1,38 @@
+(* TEST
+*)
+
+let filter1 x = x mod 2 = 0 ;;
+
+(* Standard test case *)
+let () =
+  assert
+    ([2;4] =
+      (List.to_seq [1;2;3;4;5]
+      |> Seq.filter (fun x -> x mod 2 = 0)
+     |> List.of_seq));
+  ()
+;;
+
+(* unfold *)
+let () =
+  let range first last =
+    let step i = if i > last then None
+                 else Some (i, succ i) in
+    Seq.unfold step first
+  in
+  begin
+    assert ([1;2;3] = List.of_seq (range 1 3));
+    assert ([] = List.of_seq (range 1 0));
+  end
+;;
+
+(* MPR 7820 *)
+let () =
+  assert
+    ([| 1;2;3 |] =
+      (Array.to_seq [| 1;2;3 |]
+      |> Array.of_seq));
+  ()
+;;
+
+let () = print_endline "OK";;
diff --git a/testsuite/tests/lib-seq/test.reference b/testsuite/tests/lib-seq/test.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-seq/test.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-set/testmap.ml b/testsuite/tests/lib-set/testmap.ml
new file mode 100644
index 00000000..500f00b0
--- /dev/null
+++ b/testsuite/tests/lib-set/testmap.ml
@@ -0,0 +1,253 @@
+(* TEST
+*)
+
+module M = Map.Make(struct type t = int let compare (x:t) y = compare x y end)
+
+let img x m = try Some(M.find x m) with Not_found -> None
+
+let testvals = [0;1;2;3;4;5;6;7;8;9]
+
+let check msg cond =
+  if not (List.for_all cond testvals) then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let checkbool msg b =
+  if not b then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let uncurry (f: 'a -> 'b -> 'c) (x, y: 'a * 'b) : 'c = f x y
+
+let test x v s1 s2 =
+
+  checkbool "is_empty"
+    (M.is_empty s1 = List.for_all (fun i -> img i s1 = None) testvals);
+
+  check "mem"
+    (fun i -> M.mem i s1 = (img i s1 <> None));
+
+  check "add"
+    (let s = M.add x v s1 in
+     fun i -> img i s = (if i = x then Some v else img i s1));
+
+  check "singleton"
+    (let s = M.singleton x v in
+     fun i -> img i s = (if i = x then Some v else None));
+
+  check "remove"
+    (let s = M.remove x s1 in
+     fun i -> img i s = (if i = x then None else img i s1));
+
+  check "merge-union"
+    (let f _ o1 o2 =
+       match o1, o2 with
+       | Some v1, Some v2 -> Some (v1 +. v2)
+       | None, _ -> o2
+       | _, None -> o1 in
+     let s = M.merge f s1 s2 in
+     fun i -> img i s = f i (img i s1) (img i s2));
+
+  check "merge-inter"
+    (let f _ o1 o2 =
+       match o1, o2 with
+       | Some v1, Some v2 -> Some (v1 -. v2)
+       | _, _ -> None in
+     let s = M.merge f s1 s2 in
+     fun i -> img i s = f i (img i s1) (img i s2));
+
+  checkbool "bindings"
+    (let rec extract = function
+       | [] -> []
+       | hd :: tl ->
+           match img hd s1 with
+           | None -> extract tl
+           | Some v ->(hd,  v) :: extract tl in
+     M.bindings s1 = extract testvals);
+
+  checkbool "for_all"
+    (let p x y = x mod 2 = 0 in
+     M.for_all p s1 = List.for_all (uncurry p) (M.bindings s1));
+
+  checkbool "exists"
+    (let p x y = x mod 3 = 0 in
+     M.exists p s1 = List.exists (uncurry p) (M.bindings s1));
+
+  checkbool "filter"
+    (let p x y = x >= 3 && x <= 6 in
+     M.bindings(M.filter p s1) = List.filter (uncurry p) (M.bindings s1));
+
+  checkbool "filter_map"
+    (let f x y = if x >= 3 && x <= 6 then Some (2 * x) else None in
+     let f_on_pair (x, y) = Option.map (fun v -> (x, v)) (f x y) in
+     M.bindings(M.filter_map f s1) = List.filter_map f_on_pair (M.bindings s1));
+
+  checkbool "partition"
+    (let p x y = x >= 3 && x <= 6 in
+     let (st,sf) = M.partition p s1
+     and (lt,lf) = List.partition (uncurry p) (M.bindings s1) in
+     M.bindings st = lt && M.bindings sf = lf);
+
+  checkbool "cardinal"
+    (M.cardinal s1 = List.length (M.bindings s1));
+
+  checkbool "min_binding"
+    (try
+       let (k,v) = M.min_binding s1 in
+       img k s1 = Some v && M.for_all (fun i _ -> k <= i) s1
+     with Not_found ->
+       M.is_empty s1);
+
+  checkbool "max_binding"
+    (try
+       let (k,v) = M.max_binding s1 in
+       img k s1 = Some v && M.for_all (fun i _ -> k >= i) s1
+     with Not_found ->
+       M.is_empty s1);
+
+  checkbool "choose"
+    (try
+       let (x,v) = M.choose s1 in img x s1 = Some v
+     with Not_found ->
+       M.is_empty s1);
+
+  checkbool "find_first"
+    (let (l, p, r) = M.split x s1 in
+    if p = None && M.is_empty r then
+      try
+        let _ = M.find_first (fun k -> k >= x) s1 in
+        false
+      with Not_found ->
+        true
+    else
+      let (k, v) = M.find_first (fun k -> k >= x) s1 in
+      match p with
+        None -> (k, v) = M.min_binding r
+      | Some v1 -> (k, v) = (x, v1));
+
+  checkbool "find_first_opt"
+    (let (l, p, r) = M.split x s1 in
+    let find_first_opt_result = M.find_first_opt (fun k -> k >= x) s1 in
+    if p = None && M.is_empty r then
+      match find_first_opt_result with
+        None -> true
+      | _ -> false
+    else
+      match find_first_opt_result with
+        | None -> false
+        | Some (k, v) ->
+          (match p with
+          | None -> (k, v) = M.min_binding r
+          | Some v1 -> (k, v) = (x, v1)));
+
+  checkbool "find_last"
+    (let (l, p, r) = M.split x s1 in
+    if p = None && M.is_empty l then
+      try
+        let _ = M.find_last (fun k -> k <= x) s1 in
+        false
+      with Not_found ->
+        true
+    else
+      let (k, v) = M.find_last (fun k -> k <= x) s1 in
+      match p with
+        None -> (k, v) = M.max_binding l
+      | Some v1 -> (k, v) = (x, v1));
+
+  checkbool "find_last_opt"
+    (let (l, p, r) = M.split x s1 in
+    let find_last_opt_result = M.find_last_opt (fun k -> k <= x) s1 in
+    if p = None && M.is_empty l then
+      match find_last_opt_result with
+        None -> true
+      | _ -> false
+    else
+      (match find_last_opt_result with
+      | None -> false
+      | Some (k, v) ->
+        (match p with
+        | None -> (k, v) = M.max_binding l
+        | Some v1 -> (k, v) = (x, v1))));
+
+  check "split"
+    (let (l, p, r) = M.split x s1 in
+     fun i ->
+       if i < x then img i l = img i s1
+       else if i > x then img i r = img i s1
+       else p = img i s1);
+
+  checkbool "to_seq_of_seq"
+    (M.equal (=) s1 (M.of_seq @@ M.to_seq s1));
+
+  checkbool "to_seq_from"
+    (let seq = M.to_seq_from x s1 in
+     let ok1 = List.of_seq seq |> List.for_all (fun (y,_) -> y >= x) in
+     let ok2 =
+       (M.to_seq s1 |> List.of_seq |> List.filter (fun (y,_) -> y >= x))
+       =
+       (List.of_seq seq)
+     in
+     ok1 && ok2);
+
+  ()
+
+let rkey() = Random.int 10
+
+let rdata() = Random.float 1.0
+
+let rmap() =
+  let s = ref M.empty in
+  for i = 1 to Random.int 10 do s := M.add (rkey()) (rdata()) !s done;
+  !s
+
+let _ =
+  Random.init 42;
+  for i = 1 to 10000 do test (rkey()) (rdata()) (rmap()) (rmap()) done
+
+let () =
+  (* check that removing a binding from a map that is not present in this map
+     (1) doesn't allocate and (2) return the original map *)
+  let m1 = ref M.empty in
+  for i = 1 to 10 do m1 := M.add i (float i) !m1 done;
+  let m2 = ref !m1 in
+
+  let a0 = Gc.allocated_bytes () in
+  let a1 = Gc.allocated_bytes () in
+  for i = 11 to 30 do m2 := M.remove i !m2 done;
+  let a2 = Gc.allocated_bytes () in
+
+  assert (!m2 == !m1);
+  assert(a2 -. a1 = a1 -. a0)
+
+let () =
+  (* check that filtering a map where all bindings are satisfied by
+     the given predicate returns the original map *)
+  let m1 = ref M.empty in
+  for i = 1 to 10 do m1 := M.add i (float i) !m1 done;
+  let m2 = M.filter (fun e _ -> e >= 0) !m1 in
+  assert (m2 == !m1)
+
+let () =
+  (* check that adding a binding "x -> y" to a map that already
+     contains it doesn't allocate and return the original map. *)
+  let m1 = ref M.empty in
+  let tmp = ref None in
+  for i = 1 to 10 do
+    tmp := Some (float i);
+    m1 := M.add i !tmp !m1
+  done;
+  let m2 = ref !m1 in
+
+  let a0 = Gc.allocated_bytes () in
+  let a1 = Gc.allocated_bytes () in
+
+  (* 10 |-> !tmp is already present in !m2 *)
+  m2 := M.add 10 !tmp !m2;
+
+  let a2 = Gc.allocated_bytes () in
+
+  assert (!m2 == !m1);
+  assert(a2 -. a1 = a1 -. a0);
+
+  (* 4 |-> Some 84. is not present in !m2 *)
+  m2 := M.add 4 (Some 84.) !m2;
+
+  assert (not (!m2 == !m1));
diff --git a/testsuite/tests/lib-set/testmap.reference b/testsuite/tests/lib-set/testmap.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/lib-set/testset.ml b/testsuite/tests/lib-set/testset.ml
new file mode 100644
index 00000000..36d450eb
--- /dev/null
+++ b/testsuite/tests/lib-set/testset.ml
@@ -0,0 +1,270 @@
+(* TEST
+*)
+
+module S = Set.Make(struct type t = int let compare (x:t) y = compare x y end)
+
+let testvals = [0;1;2;3;4;5;6;7;8;9]
+
+let check msg cond =
+  if not (List.for_all cond testvals) then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let checkbool msg b =
+  if not b then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let normalize_cmp c =
+  if c = 0 then 0 else if c > 0 then 1 else -1
+
+let test x s1 s2 =
+
+  checkbool "is_empty"
+    (S.is_empty s1 = List.for_all (fun i -> not (S.mem i s1)) testvals);
+
+  check "add"
+    (let s = S.add x s1 in
+     fun i -> S.mem i s = (S.mem i s1 || i = x));
+
+  check "singleton"
+    (let s = S.singleton x in
+     fun i -> S.mem i s = (i = x));
+
+  check "remove"
+    (let s = S.remove x s1 in
+     fun i -> S.mem i s = (S.mem i s1 && i <> x));
+
+  check "union"
+    (let s = S.union s1 s2 in
+     fun i -> S.mem i s = (S.mem i s1 || S.mem i s2));
+
+  check "inter"
+    (let s = S.inter s1 s2 in
+     fun i -> S.mem i s = (S.mem i s1 && S.mem i s2));
+
+  checkbool "disjoint"
+    (S.is_empty (S.inter s1 s2) = S.disjoint s1 s2);
+
+  check "diff"
+    (let s = S.diff s1 s2 in
+     fun i -> S.mem i s = (S.mem i s1 && not (S.mem i s2)));
+
+  checkbool "elements"
+    (S.elements s1 = List.filter (fun i -> S.mem i s1) testvals);
+
+  checkbool "compare"
+    (normalize_cmp (S.compare s1 s2)
+     = normalize_cmp (compare (S.elements s1) (S.elements s2)));
+
+  checkbool "equal"
+    (S.equal s1 s2 = (S.elements s1 = S.elements s2));
+
+  check "subset"
+    (let b = S.subset s1 s2 in
+     fun i -> if b && S.mem i s1 then S.mem i s2 else true);
+
+  checkbool "subset2"
+    (let b = S.subset s1 s2 in
+     b || not (S.is_empty (S.diff s1 s2)));
+
+  checkbool "map"
+    (S.elements (S.map succ s1) = List.map succ (S.elements s1));
+
+  checkbool "map2"
+    (S.map (fun x -> x) s1 == s1);
+
+  checkbool "map3"
+    ((* check that the traversal is made in increasing element order *)
+     let last = ref min_int in
+     S.map (fun x -> assert (!last <= x); last := x; x) s1 == s1);
+
+  checkbool "for_all"
+    (let p x = x mod 2 = 0 in
+     S.for_all p s1 = List.for_all p (S.elements s1));
+
+  checkbool "exists"
+    (let p x = x mod 3 = 0 in
+     S.exists p s1 = List.exists p (S.elements s1));
+
+  checkbool "filter"
+    (let p x = x >= 3 && x <= 6 in
+     S.elements(S.filter p s1) = List.filter p (S.elements s1));
+
+  checkbool "filter_map"
+    (let f x = if x >= 3 && x <= 6 then Some (2 * x) else None in
+     S.elements(S.filter_map f s1) = List.filter_map f (S.elements s1));
+
+  checkbool "filter_map(==)"
+    (let f x = Some x in
+     S.filter_map f s1 == s1);
+
+  checkbool "partition"
+    (let p x = x >= 3 && x <= 6 in
+     let (st,sf) = S.partition p s1
+     and (lt,lf) = List.partition p (S.elements s1) in
+     S.elements st = lt && S.elements sf = lf);
+
+  checkbool "cardinal"
+    (S.cardinal s1 = List.length (S.elements s1));
+
+  checkbool "min_elt"
+    (try
+       let m = S.min_elt s1 in
+       S.mem m s1 && S.for_all (fun i -> m <= i) s1
+     with Not_found ->
+       S.is_empty s1);
+
+  checkbool "max_elt"
+    (try
+       let m = S.max_elt s1 in
+       S.mem m s1 && S.for_all (fun i -> m >= i) s1
+     with Not_found ->
+       S.is_empty s1);
+
+  checkbool "choose"
+    (try
+       let x = S.choose s1 in S.mem x s1
+     with Not_found ->
+       S.is_empty s1);
+
+  checkbool "find_first"
+    (let (l, p, r) = S.split x s1 in
+    if not p && S.is_empty r then
+      try
+        let _ = S.find_first (fun k -> k >= x) s1 in
+        false
+      with Not_found ->
+        true
+    else
+      let e = S.find_first (fun k -> k >= x) s1 in
+      if p then
+        e = x
+      else
+        e = S.min_elt r);
+
+  checkbool "find_first_opt"
+    (let (l, p, r) = S.split x s1 in
+    let find_first_opt_result = S.find_first_opt (fun k -> k >= x) s1 in
+    if not p && S.is_empty r then
+      match find_first_opt_result with
+        None -> true
+      | _ -> false
+    else
+      (match find_first_opt_result with
+      | None -> false
+      | Some e -> if p then e = x else e = S.min_elt r));
+
+  checkbool "find_last"
+    (let (l, p, r) = S.split x s1 in
+    if not p && S.is_empty l then
+      try
+        let _ = S.find_last (fun k -> k <= x) s1 in
+        false
+      with Not_found ->
+        true
+    else
+      let e = S.find_last (fun k -> k <= x) s1 in
+      if p then
+        e = x
+      else
+        e = S.max_elt l);
+
+  checkbool "find_last_opt"
+    (let (l, p, r) = S.split x s1 in
+    let find_last_opt_result = S.find_last_opt (fun k -> k <= x) s1 in
+    if not p && S.is_empty l then
+      match find_last_opt_result with
+        None -> true
+      | _ -> false
+    else
+      (match find_last_opt_result with
+      | None -> false
+      | Some e -> if p then e = x else e = S.max_elt l));
+
+  check "split"
+    (let (l, p, r) = S.split x s1 in
+     fun i ->
+       if i < x then S.mem i l = S.mem i s1
+       else if i > x then S.mem i r = S.mem i s1
+       else p = S.mem i s1);
+
+  checkbool "to_seq_of_seq"
+    (S.equal s1 (S.of_seq @@ S.to_seq s1));
+
+  checkbool "to_seq_from"
+    (let seq = S.to_seq_from x s1 in
+     let ok1 = List.of_seq seq |> List.for_all (fun y -> y >= x) in
+     let ok2 =
+       (S.elements s1 |> List.filter (fun y -> y >= x))
+       =
+       (List.of_seq seq)
+     in
+     ok1 && ok2);
+
+  ()
+
+let relt() = Random.int 10
+
+let rset() =
+  let s = ref S.empty in
+  for i = 1 to Random.int 10 do s := S.add (relt()) !s done;
+  !s
+
+let _ =
+  Random.init 42;
+  for i = 1 to 10000 do test (relt()) (rset()) (rset()) done
+
+let () =
+  (* #6645: check that adding an element to set that already contains
+     it doesn't allocate and return the original set. *)
+  let s1 = ref S.empty in
+  for i = 1 to 10 do s1 := S.add i !s1 done;
+  let s2 = ref !s1 in
+
+  let a0 = Gc.allocated_bytes () in
+  let a1 = Gc.allocated_bytes () in
+  for i = 1 to 10 do s2 := S.add i !s2 done;
+  let a2 = Gc.allocated_bytes () in
+
+  assert (!s2 == !s1);
+  assert(a2 -. a1 = a1 -. a0)
+
+let () =
+  (* check that removing an element from a set that is not present in this set
+     (1) doesn't allocate and (2) return the original set *)
+  let s1 = ref S.empty in
+  for i = 1 to 10 do s1 := S.add i !s1 done;
+  let s2 = ref !s1 in
+
+  let a0 = Gc.allocated_bytes () in
+  let a1 = Gc.allocated_bytes () in
+  for i = 11 to 30 do s2 := S.remove i !s2 done;
+  let a2 = Gc.allocated_bytes () in
+
+  assert (!s2 == !s1);
+  assert(a2 -. a1 = a1 -. a0)
+
+let () =
+  (* check that filtering a set where all elements are satisfied by
+     the given predicate return the original set *)
+  let s1 = ref S.empty in
+  for i = 1 to 10 do s1 := S.add i !s1 done;
+  let s2 = S.filter (fun e -> e >= 0) !s1 in
+  assert (s2 == !s1)
+
+let valid_structure s =
+  (* this test should return 'true' for all set,
+     but it can detect sets that are ill-structured,
+     for example incorrectly ordered, as the S.mem
+     function will make assumptions about the set ordering.
+
+     (This trick was used to exhibit the bug in PR#7403)
+  *)
+  List.for_all (fun n -> S.mem n s) (S.elements s)
+
+let () =
+  (* PR#7403: map buggily orders elements according to the input
+     set order, not the output set order. Mapping functions that
+     change the value ordering thus break the set structure. *)
+  let test = S.of_list [1; 3; 5] in
+  let f = function 3 -> 8 | n -> n in
+  assert (valid_structure (S.map f test))
diff --git a/testsuite/tests/lib-set/testset.reference b/testsuite/tests/lib-set/testset.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/lib-stack/test.ml b/testsuite/tests/lib-stack/test.ml
new file mode 100644
index 00000000..5023b12b
--- /dev/null
+++ b/testsuite/tests/lib-stack/test.ml
@@ -0,0 +1,121 @@
+(* TEST
+*)
+
+module S = struct
+  include Stack
+
+  let to_list s =    (* from bottom to top *)
+    let l = ref [] in
+    iter (fun x -> l := x :: !l) s;
+    !l
+end
+
+let does_raise f s =
+  try
+    ignore (f s : int);
+    false
+  with S.Empty ->
+    true
+
+let () =
+  let s = S.create () in
+  ();                   assert (S.to_list s = [          ] && S.length s = 0);
+  S.push 1 s;           assert (S.to_list s = [1         ] && S.length s = 1);
+  S.push 2 s;           assert (S.to_list s = [1; 2      ] && S.length s = 2);
+  S.push 3 s;           assert (S.to_list s = [1; 2; 3   ] && S.length s = 3);
+  S.push 4 s;           assert (S.to_list s = [1; 2; 3; 4] && S.length s = 4);
+  assert (S.pop s = 4); assert (S.to_list s = [1; 2; 3;  ] && S.length s = 3);
+  assert (S.pop s = 3); assert (S.to_list s = [1; 2;     ] && S.length s = 2);
+  assert (S.pop s = 2); assert (S.to_list s = [1;        ] && S.length s = 1);
+  assert (S.pop s = 1); assert (S.to_list s = [          ] && S.length s = 0);
+  assert (does_raise S.pop s);
+;;
+
+let () =
+  let s = S.create () in
+  S.push 1 s; assert (S.pop s = 1); assert (does_raise S.pop s);
+  S.push 2 s; assert (S.pop s = 2); assert (does_raise S.pop s);
+  assert (S.length s = 0);
+;;
+
+let () =
+  let s = S.create () in
+  S.push 1 s; assert (S.top s = 1);
+  S.push 2 s; assert (S.top s = 2);
+  S.push 3 s; assert (S.top s = 3);
+  assert (S.top s = 3); assert (S.pop s = 3);
+  assert (S.top s = 2); assert (S.pop s = 2);
+  assert (S.top s = 1); assert (S.pop s = 1);
+  assert (does_raise S.top s);
+  assert (does_raise S.top s);
+;;
+
+let () =
+  let s = S.create () in
+  for i = 1 to 10 do S.push i s done;
+  S.clear s;
+  assert (S.length s = 0);
+  assert (does_raise S.pop s);
+  assert (s = S.create ());
+  S.push 42 s;
+  assert (S.pop s = 42);
+;;
+
+let () =
+  let s1 = S.create () in
+  for i = 1 to 10 do S.push i s1 done;
+  let s2 = S.copy s1 in
+  assert (S.to_list s1 = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]);
+  assert (S.to_list s2 = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]);
+  assert (S.length s1 = 10);
+  assert (S.length s2 = 10);
+  for i = 10 downto 1 do
+    assert (S.pop s1 = i);
+  done;
+  for i = 10 downto 1 do
+    assert (S.pop s2 = i);
+  done;
+;;
+
+let () =
+  let s = S.create () in
+  assert (S.is_empty s);
+  for i = 1 to 10 do
+    S.push i s;
+    assert (S.length s = i);
+    assert (not (S.is_empty s));
+  done;
+  for i = 10 downto 1 do
+    assert (S.length s = i);
+    assert (not (S.is_empty s));
+    ignore (S.pop s : int);
+  done;
+  assert (S.length s = 0);
+  assert (S.is_empty s);
+;;
+
+let () =
+  let s = S.create () in
+  for i = 10 downto 1 do S.push i s done;
+  let i = ref 1 in
+  S.iter (fun j -> assert (!i = j); incr i) s;
+;;
+
+let () =
+  let s1 = S.create () in
+  assert (S.length s1 = 0); assert (S.to_list s1 = []);
+  let s2 = S.copy s1 in
+  assert (S.length s1 = 0); assert (S.to_list s1 = []);
+  assert (S.length s2 = 0); assert (S.to_list s2 = []);
+;;
+
+let () =
+  let s1 = S.create () in
+  for i = 1 to 4 do S.push i s1 done;
+  assert (S.length s1 = 4); assert (S.to_list s1 = [1; 2; 3; 4]);
+  let s2 = S.copy s1 in
+  assert (S.length s1 = 4); assert (S.to_list s1 = [1; 2; 3; 4]);
+  assert (S.length s2 = 4); assert (S.to_list s2 = [1; 2; 3; 4]);
+;;
+
+let () = print_endline "OK"
diff --git a/testsuite/tests/lib-stack/test.reference b/testsuite/tests/lib-stack/test.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-stack/test.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-stdlabels/test_stdlabels.ml b/testsuite/tests/lib-stdlabels/test_stdlabels.ml
new file mode 100644
index 00000000..fe7ae4f6
--- /dev/null
+++ b/testsuite/tests/lib-stdlabels/test_stdlabels.ml
@@ -0,0 +1,47 @@
+(* TEST
+   flags += " -nolabels "
+*)
+
+module A : module type of Array = ArrayLabels
+module B : module type of Bytes = BytesLabels
+module L : module type of List = ListLabels
+module S : module type of String = StringLabels
+
+module M : module type of struct include Map end [@remove_aliases] =
+  MoreLabels.Map
+
+module Se : module type of struct include Set end [@remove_aliases] =
+  MoreLabels.Set
+
+
+(* For  *)
+(* module H : module type of Hashtbl = MoreLabels.Hashtbl *)
+(* we will have following error: *)
+(* Error: Signature mismatch: *)
+(*        ... *)
+(*        Type declarations do not match: *)
+(*          type statistics = Hashtbl.statistics *)
+(*        is not included in *)
+(*          type statistics = { *)
+(*            num_bindings : int; *)
+(*            num_buckets : int; *)
+(*            max_bucket_length : int; *)
+(*            bucket_histogram : int array; *)
+(*          } *)
+(*        Their kinds differ. *)
+(* This is workaround:*)
+module Indirection = struct
+  type t = Hashtbl.statistics = {  num_bindings: int;
+                                   num_buckets: int;
+                                   max_bucket_length: int;
+                                   bucket_histogram: int array}
+end
+module type HS = sig
+  type statistics = Indirection.t
+  include module type of struct include Hashtbl end [@remove_aliases]
+                         with type statistics := Indirection.t
+end
+module H : HS = MoreLabels.Hashtbl
+
+let ()  =
+  ()
diff --git a/testsuite/tests/lib-stdlabels/test_stdlabels.reference b/testsuite/tests/lib-stdlabels/test_stdlabels.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/lib-stdlib/pervasives_deprecated.ml b/testsuite/tests/lib-stdlib/pervasives_deprecated.ml
new file mode 100644
index 00000000..86df5542
--- /dev/null
+++ b/testsuite/tests/lib-stdlib/pervasives_deprecated.ml
@@ -0,0 +1,41 @@
+(* TEST
+   * expect
+*)
+
+[@@@warning "@A"];;
+
+Pervasives.(+) 1 1;;
+[%%expect{|
+Line 3, characters 0-14:
+3 | Pervasives.(+) 1 1;;
+    ^^^^^^^^^^^^^^
+Error (alert deprecated): module Stdlib.Pervasives
+Use Stdlib instead.
+
+If you need to stay compatible with OCaml < 4.07, you can use the
+stdlib-shims library: https://github.com/ocaml/stdlib-shims
+|}]
+
+module X = Pervasives;;
+[%%expect{|
+Line 1, characters 11-21:
+1 | module X = Pervasives;;
+               ^^^^^^^^^^
+Error (alert deprecated): module Stdlib.Pervasives
+Use Stdlib instead.
+
+If you need to stay compatible with OCaml < 4.07, you can use the
+stdlib-shims library: https://github.com/ocaml/stdlib-shims
+|}]
+
+open Pervasives;;
+[%%expect{|
+Line 1, characters 5-15:
+1 | open Pervasives;;
+         ^^^^^^^^^^
+Error (alert deprecated): module Stdlib.Pervasives
+Use Stdlib instead.
+
+If you need to stay compatible with OCaml < 4.07, you can use the
+stdlib-shims library: https://github.com/ocaml/stdlib-shims
+|}]
diff --git a/testsuite/tests/lib-str/t01.ml b/testsuite/tests/lib-str/t01.ml
new file mode 100644
index 00000000..076172bd
--- /dev/null
+++ b/testsuite/tests/lib-str/t01.ml
@@ -0,0 +1,1085 @@
+(* TEST
+* hasstr
+include str
+** bytecode
+** native
+*)
+
+open Printf
+
+let build_result ngroups input =
+  let res = Array.make (ngroups + 1) "~" in
+  for i = 0 to ngroups do
+    try
+      res.(i) <- Str.matched_group i input
+    with Not_found -> ()
+  done;
+  res
+
+let search_forward re ng input start =
+  try
+    ignore(Str.search_forward re input start);
+    build_result ng input
+  with Not_found ->
+    [||]
+
+let search_backward re ng input start =
+  try
+    ignore(Str.search_backward re input start);
+    build_result ng input
+  with Not_found ->
+    [||]
+
+let partial_match re ng input start =
+  if Str.string_partial_match re input start
+  then build_result ng input
+  else [||]
+
+let start_test msg =
+  print_newline(); printf "%s\n  " msg
+
+let num_failures = ref 0
+
+let test res1 res2 =
+  if res1 = res2
+  then print_char '.'
+  else begin print_string " FAIL "; incr num_failures end
+
+let test_search_forward r ng s exp =
+  test (search_forward r ng s 0) exp
+
+let test_search_backward r ng s exp =
+  test (search_backward r ng s (String.length s)) exp
+
+let test_partial_match r ng s exp =
+  test (partial_match r ng s 0) exp
+
+let end_test () =
+  print_newline();
+  if !num_failures = 0 then
+    printf "All tests passed\n"
+  else begin
+    printf "TEST FAILED: %d failure(s)\n" !num_failures;
+    exit 2
+  end
+
+let automated_test() =
+
+  (** Forward searches *)
+  start_test "Search for /the quick brown fox/";
+  let r = Str.regexp "the quick brown fox" in
+  let n = 0 in
+  test_search_forward r n "the quick brown fox"
+    [|"the quick brown fox"|];
+  test_search_forward r n "What do you know about the quick brown fox?"
+    [|"the quick brown fox"|];
+  test_search_forward r n "The quick brown FOX"
+    [||];
+  test_search_forward r n "What do you know about THE QUICK BROWN FOX?"
+    [||];
+
+  start_test "Search for /the quick brown fox/ (case-insensitive)";
+  let r = Str.regexp_case_fold "the quick brown fox" in
+  let n = 0 in
+  test_search_forward r n "the quick brown fox"
+    [|"the quick brown fox"|];
+  test_search_forward r n "What do you know about the quick brown fox?"
+    [|"the quick brown fox"|];
+  test_search_forward r n "The quick brown FOX"
+    [|"The quick brown FOX"|];
+  test_search_forward r n "What do you know about THE QUICK BROWN FOX?"
+    [|"THE QUICK BROWN FOX"|];
+  test_search_forward r n "The slow white snail"
+    [||];
+
+  start_test "Search for /a*abc?xyz+pqrrrabbb*xyyyyy?pq?q?q?q?q?q?AB*zz/";
+  let r = Str.regexp "a*abc?xyz+pqrrrabbb*xyyyyy?pq?q?q?q?q?q?AB*zz" in
+  let n = 0 in
+  test_search_forward r n "abxyzpqrrrabbxyyyypqAzz"
+    [|"abxyzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "abxyzpqrrrabbxyyyypqAzz"
+    [|"abxyzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "aabxyzpqrrrabbxyyyypqAzz"
+    [|"aabxyzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "aaabxyzpqrrrabbxyyyypqAzz"
+    [|"aaabxyzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "aaaabxyzpqrrrabbxyyyypqAzz"
+    [|"aaaabxyzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "abcxyzpqrrrabbxyyyypqAzz"
+    [|"abcxyzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "aabcxyzpqrrrabbxyyyypqAzz"
+    [|"aabcxyzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "aaabcxyzpqrrrabbxyyyypAzz"
+    [|"aaabcxyzpqrrrabbxyyyypAzz"|];
+  test_search_forward r n "aaabcxyzpqrrrabbxyyyypqAzz"
+    [|"aaabcxyzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "aaabcxyzpqrrrabbxyyyypqqAzz"
+    [|"aaabcxyzpqrrrabbxyyyypqqAzz"|];
+  test_search_forward r n "aaabcxyzpqrrrabbxyyyypqqqAzz"
+    [|"aaabcxyzpqrrrabbxyyyypqqqAzz"|];
+  test_search_forward r n "aaabcxyzpqrrrabbxyyyypqqqqAzz"
+    [|"aaabcxyzpqrrrabbxyyyypqqqqAzz"|];
+  test_search_forward r n "aaabcxyzpqrrrabbxyyyypqqqqqAzz"
+    [|"aaabcxyzpqrrrabbxyyyypqqqqqAzz"|];
+  test_search_forward r n "aaabcxyzpqrrrabbxyyyypqqqqqqAzz"
+    [|"aaabcxyzpqrrrabbxyyyypqqqqqqAzz"|];
+  test_search_forward r n "aaaabcxyzpqrrrabbxyyyypqAzz"
+    [|"aaaabcxyzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "abxyzzpqrrrabbxyyyypqAzz"
+    [|"abxyzzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "aabxyzzzpqrrrabbxyyyypqAzz"
+    [|"aabxyzzzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "aaabxyzzzzpqrrrabbxyyyypqAzz"
+    [|"aaabxyzzzzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "aaaabxyzzzzpqrrrabbxyyyypqAzz"
+    [|"aaaabxyzzzzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "abcxyzzpqrrrabbxyyyypqAzz"
+    [|"abcxyzzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "aabcxyzzzpqrrrabbxyyyypqAzz"
+    [|"aabcxyzzzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "aaabcxyzzzzpqrrrabbxyyyypqAzz"
+    [|"aaabcxyzzzzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "aaaabcxyzzzzpqrrrabbxyyyypqAzz"
+    [|"aaaabcxyzzzzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "aaaabcxyzzzzpqrrrabbbxyyyypqAzz"
+    [|"aaaabcxyzzzzpqrrrabbbxyyyypqAzz"|];
+  test_search_forward r n "aaaabcxyzzzzpqrrrabbbxyyyyypqAzz"
+    [|"aaaabcxyzzzzpqrrrabbbxyyyyypqAzz"|];
+  test_search_forward r n "aaabcxyzpqrrrabbxyyyypABzz"
+    [|"aaabcxyzpqrrrabbxyyyypABzz"|];
+  test_search_forward r n "aaabcxyzpqrrrabbxyyyypABBzz"
+    [|"aaabcxyzpqrrrabbxyyyypABBzz"|];
+  test_search_forward r n ">>>aaabxyzpqrrrabbxyyyypqAzz"
+    [|"aaabxyzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n ">aaaabxyzpqrrrabbxyyyypqAzz"
+    [|"aaaabxyzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n ">>>>abcxyzpqrrrabbxyyyypqAzz"
+    [|"abcxyzpqrrrabbxyyyypqAzz"|];
+  test_search_forward r n "abxyzpqrrabbxyyyypqAzz"
+    [||];
+  test_search_forward r n "abxyzpqrrrrabbxyyyypqAzz"
+    [||];
+  test_search_forward r n "abxyzpqrrrabxyyyypqAzz"
+    [||];
+  test_search_forward r n "aaaabcxyzzzzpqrrrabbbxyyyyyypqAzz"
+    [||];
+  test_search_forward r n "aaaabcxyzzzzpqrrrabbbxyyypqAzz"
+    [||];
+  test_search_forward r n "aaabcxyzpqrrrabbxyyyypqqqqqqqAzz"
+    [||];
+
+  start_test "Search for /^abc\\(abc\\)?zz/";
+  let r = Str.regexp "^abc\\(abc\\)?zz" in
+  let n = 1 in
+  test_search_forward r n "abczz"
+    [|"abczz"; "~"|];
+  test_search_forward r n "abcabczz"
+    [|"abcabczz"; "abc"|];
+  test_search_forward r n "zz"
+    [||];
+  test_search_forward r n "abcabcabczz"
+    [||];
+  test_search_forward r n ">>abczz"
+    [||];
+
+  start_test "Search for /^\\(b+\\|a\\)\\(b+\\|a\\)?c/";
+  let r = Str.regexp "^\\(b+\\|a\\)\\(b+\\|a\\)?c" in
+  let n = 2 in
+  test_search_forward r n "bc"
+    [|"bc"; "b"; "~"|];
+  test_search_forward r n "bbc"
+    [|"bbc"; "bb"; "~"|];
+  test_search_forward r n "bbbc"
+    [|"bbbc"; "bbb"; "~"|];
+  test_search_forward r n "bac"
+    [|"bac"; "b"; "a"|];
+  test_search_forward r n "bbac"
+    [|"bbac"; "bb"; "a"|];
+  test_search_forward r n "aac"
+    [|"aac"; "a"; "a"|];
+  test_search_forward r n "abbbbbbbbbbbc"
+    [|"abbbbbbbbbbbc"; "a"; "bbbbbbbbbbb"|];
+  test_search_forward r n "bbbbbbbbbbbac"
+    [|"bbbbbbbbbbbac"; "bbbbbbbbbbb"; "a"|];
+  test_search_forward r n "aaac"
+    [||];
+  test_search_forward r n "abbbbbbbbbbbac"
+    [||];
+
+  start_test "Search for /r\\(\\(g*\\|k\\)y?\\)*A/";
+  let r = Str.regexp "r\\(\\(g*\\|k\\)y?\\)*A" in
+  let n = 2 in
+  test_search_forward r n "ArA"
+    [|"rA"; "~"; "~"|];
+  test_search_forward r n "ArkA"
+    [|"rkA"; "k"; "k"|];
+  test_search_forward r n "AryA"
+    [|"ryA"; "y"; ""|];
+  test_search_forward r n "ArgggkyggkA"
+    [|"rgggkyggkA"; "k"; "k"|];
+
+  start_test "Search for /A\\(\\(t\\|v\\)\\(q?\\|n\\)\\)*A/";
+  let r = Str.regexp "A\\(\\(t\\|v\\)\\(q?\\|n\\)\\)*A" in
+  let n = 3 in
+  test_search_forward r n "AvA"
+    [|"AvA"; "v"; "v"; ""|];
+
+  start_test "Search for /A\\(\\(b\\(\\(d\\|l*\\)?\\|w\\)\\)*a\\)A/";
+  let r = Str.regexp "A\\(\\(b\\(\\(d\\|l*\\)?\\|w\\)\\)*a\\)A" in
+  let n = 4 in
+  test_search_forward r n "AbbaA"
+    [|"AbbaA"; "bba"; "b"; ""; ""|];
+
+  start_test "Search for /\\(\\|f\\)*x/";
+  let r = Str.regexp "\\(\\|f\\)*x" in
+  let n = 1 in
+  test_search_forward r n "abcd"
+    [||];
+  test_search_forward r n "fffff"
+    [||];
+  test_search_forward r n "fffxab"
+    [|"fffx"; "f"|];
+  test_search_forward r n "zzzxab"
+    [|"x"; "~"|];
+
+  start_test "Search for /\\(\\|f\\)+x/";
+  let r = Str.regexp "\\(\\|f\\)+x" in
+  let n = 1 in
+  test_search_forward r n "abcd"
+    [||];
+  test_search_forward r n "fffff"
+    [||];
+  test_search_forward r n "fffxab"
+    [|"fffx"; "f"|];
+  test_search_forward r n "zzzxab"
+    [|"x"; ""|];
+
+  start_test "Search for /A\\(.?\\)*A/";
+  let r = Str.regexp "A\\(.?\\)*A" in
+  let n = 1 in
+  test_search_forward r n "AA"
+    [|"AA"; "~"|];
+  test_search_forward r n "AAA"
+    [|"AAA"; "A"|];
+  test_search_forward r n "AbA"
+    [|"AbA"; "b"|];
+  test_search_forward r n "A"
+    [||];
+
+  start_test "Search for /\\([ab]*\\)\\1+c/";
+  let r = Str.regexp "\\([ab]*\\)\\1+c" in
+  let n = 1 in
+  test_search_forward r n "abababc"
+    [| "abababc"; "ab" |];
+  test_search_forward r n "abbc"
+    [| "bbc"; "b" |];
+  test_search_forward r n "abc"
+    [| "c"; "" |];
+
+  start_test "Search for /^\\(\\(b+\\|a\\)\\(b+\\|a\\)?\\)?bc/";
+  let r = Str.regexp "^\\(\\(b+\\|a\\)\\(b+\\|a\\)?\\)?bc" in
+  let n = 3 in
+  test_search_forward r n "bbc"
+    [|"bbc"; "b"; "b"; "~"|];
+
+  start_test "Search for /^\\(\\(b*\\|ba\\)\\(b*\\|ba\\)?\\)?bc/";
+  let r = Str.regexp "^\\(\\(b*\\|ba\\)\\(b*\\|ba\\)?\\)?bc" in
+  let n = 3 in
+  test_search_forward r n "babc"
+    [|"babc"; "ba"; ""; "ba"|];
+  test_search_forward r n "bbabc"
+    [|"bbabc"; "bba"; "b"; "ba"|];
+  test_search_forward r n "bababc"
+    [|"bababc"; "baba"; "ba"; "ba"|];
+  test_search_forward r n "bababbc"
+    [||];
+  test_search_forward r n "babababc"
+    [||];
+
+  start_test "Search for /[^a]/";
+  let r = Str.regexp "[^a]" in
+  let n = 0 in
+  test_search_forward r n "athing" [|"t"|];
+  test_search_forward r n "Athing" [|"A"|];
+
+  start_test "Search for /[^a]/ (case-insensitive)";
+  let r = Str.regexp_case_fold "[^a]" in
+  let n = 0 in
+  test_search_forward r n "athing" [|"t"|];
+  test_search_forward r n "Athing" [|"t"|];
+
+  start_test "Search for /^[]abcde]/";
+  let r = Str.regexp "^[]abcde]" in
+  let n = 0 in
+  test_search_forward r n "athing"
+    [|"a"|];
+  test_search_forward r n "bthing"
+    [|"b"|];
+  test_search_forward r n "]thing"
+    [|"]"|];
+  test_search_forward r n "cthing"
+    [|"c"|];
+  test_search_forward r n "dthing"
+    [|"d"|];
+  test_search_forward r n "ething"
+    [|"e"|];
+  test_search_forward r n "fthing"
+    [||];
+  test_search_forward r n "[thing"
+    [||];
+  test_search_forward r n "\\\\thing"
+    [||];
+
+  start_test "Search for /^[]cde]/";
+  let r = Str.regexp "^[]cde]" in
+  let n = 0 in
+  test_search_forward r n "]thing"
+    [|"]"|];
+  test_search_forward r n "cthing"
+    [|"c"|];
+  test_search_forward r n "dthing"
+    [|"d"|];
+  test_search_forward r n "ething"
+    [|"e"|];
+  test_search_forward r n "athing"
+    [||];
+  test_search_forward r n "fthing"
+    [||];
+
+  start_test "Search for /^[^]abcde]/";
+  let r = Str.regexp "^[^]abcde]" in
+  let n = 0 in
+  test_search_forward r n "fthing"
+    [|"f"|];
+  test_search_forward r n "[thing"
+    [|"["|];
+  test_search_forward r n "\\\\thing"
+    [|"\\"|];
+  test_search_forward r n "athing"
+    [||];
+  test_search_forward r n "bthing"
+    [||];
+  test_search_forward r n "]thing"
+    [||];
+  test_search_forward r n "cthing"
+    [||];
+  test_search_forward r n "dthing"
+    [||];
+  test_search_forward r n "ething"
+    [||];
+
+  start_test "Search for /^[^]cde]/";
+  let r = Str.regexp "^[^]cde]" in
+  let n = 0 in
+  test_search_forward r n "athing"
+    [|"a"|];
+  test_search_forward r n "fthing"
+    [|"f"|];
+  test_search_forward r n "]thing"
+    [||];
+  test_search_forward r n "cthing"
+    [||];
+  test_search_forward r n "dthing"
+    [||];
+  test_search_forward r n "ething"
+    [||];
+
+  start_test "Search for /^\255/";
+  let r = Str.regexp "^\255" in
+  let n = 0 in
+  test_search_forward r n "\255"
+    [|"\255"|];
+
+  start_test "Search for /^[0-9]+$/";
+  let r = Str.regexp "^[0-9]+$" in
+  let n = 0 in
+  test_search_forward r n "0"
+    [|"0"|];
+  test_search_forward r n "1"
+    [|"1"|];
+  test_search_forward r n "2"
+    [|"2"|];
+  test_search_forward r n "3"
+    [|"3"|];
+  test_search_forward r n "4"
+    [|"4"|];
+  test_search_forward r n "5"
+    [|"5"|];
+  test_search_forward r n "6"
+    [|"6"|];
+  test_search_forward r n "7"
+    [|"7"|];
+  test_search_forward r n "8"
+    [|"8"|];
+  test_search_forward r n "9"
+    [|"9"|];
+  test_search_forward r n "10"
+    [|"10"|];
+  test_search_forward r n "100"
+    [|"100"|];
+  test_search_forward r n "abc"
+    [||];
+
+  start_test "Search for /^.*nter/";
+  let r = Str.regexp "^.*nter" in
+  let n = 0 in
+  test_search_forward r n "enter"
+    [|"enter"|];
+  test_search_forward r n "inter"
+    [|"inter"|];
+  test_search_forward r n "uponter"
+    [|"uponter"|];
+
+  start_test "Search for /^xxx[0-9]+$/";
+  let r = Str.regexp "^xxx[0-9]+$" in
+  let n = 0 in
+  test_search_forward r n "xxx0"
+    [|"xxx0"|];
+  test_search_forward r n "xxx1234"
+    [|"xxx1234"|];
+  test_search_forward r n "xxx"
+    [||];
+
+  start_test "Search for /^.+[0-9][0-9][0-9]$/";
+  let r = Str.regexp "^.+[0-9][0-9][0-9]$" in
+  let n = 0 in
+  test_search_forward r n "x123"
+    [|"x123"|];
+  test_search_forward r n "xx123"
+    [|"xx123"|];
+  test_search_forward r n "123456"
+    [|"123456"|];
+  test_search_forward r n "123"
+    [||];
+  test_search_forward r n "x123x"
+    [||];
+
+  start_test "Search for /^\\([^!]+\\)!\\(.+\\)=apquxz\\.ixr\\.zzz\\.ac\\.uk$/";
+  let r = Str.regexp "^\\([^!]+\\)!\\(.+\\)=apquxz\\.ixr\\.zzz\\.ac\\.uk$" in
+  let n = 2 in
+  test_search_forward r n "abc!pqr=apquxz.ixr.zzz.ac.uk"
+    [|"abc!pqr=apquxz.ixr.zzz.ac.uk"; "abc"; "pqr"|];
+  test_search_forward r n "!pqr=apquxz.ixr.zzz.ac.uk"
+    [||];
+  test_search_forward r n "abc!=apquxz.ixr.zzz.ac.uk"
+    [||];
+  test_search_forward r n "abc!pqr=apquxz:ixr.zzz.ac.uk"
+    [||];
+  test_search_forward r n "abc!pqr=apquxz.ixr.zzz.ac.ukk"
+    [||];
+
+  start_test "Search for /\\([0-9a-f:]+\\)$/";
+  let r = Str.regexp_case_fold "\\([0-9a-f:]+\\)$" in
+  let n = 1 in
+  test_search_forward r n "0abc"
+    [|"0abc"; "0abc"|];
+  test_search_forward r n "abc"
+    [|"abc"; "abc"|];
+  test_search_forward r n "fed"
+    [|"fed"; "fed"|];
+  test_search_forward r n "E"
+    [|"E"; "E"|];
+  test_search_forward r n "::"
+    [|"::"; "::"|];
+  test_search_forward r n "5f03:12C0::932e"
+    [|"5f03:12C0::932e"; "5f03:12C0::932e"|];
+  test_search_forward r n "fed def"
+    [|"def"; "def"|];
+  test_search_forward r n "Any old stuff"
+    [|"ff"; "ff"|];
+  test_search_forward r n "0zzz"
+    [||];
+  test_search_forward r n "gzzz"
+    [||];
+  test_search_forward r n "fed "
+    [||];
+  test_search_forward r n "Any old rubbish"
+    [||];
+
+  start_test "Search for /^[a-z0-9][a-z0-9-]*\\(\\.[a-z0-9][A-Z0-9-]*\\)*\\.$/";
+  let r =
+    Str.regexp_case_fold "^[a-z0-9][a-z0-9-]*\\(\\.[a-z0-9][A-Z0-9-]*\\)*\\.$"
+  in
+  let n = 1 in
+  test_search_forward r n "a."
+    [|"a."; "~"|];
+  test_search_forward r n "Z."
+    [|"Z."; "~"|];
+  test_search_forward r n "2."
+    [|"2."; "~"|];
+  test_search_forward r n "ab-c."
+    [|"ab-c."; "~"|];
+  test_search_forward r n "ab-c.pq-r."
+    [|"ab-c.pq-r."; ".pq-r"|];
+  test_search_forward r n "sxk.zzz.ac.uk."
+    [|"sxk.zzz.ac.uk."; ".uk"|];
+  test_search_forward r n "sxk.ZZZ.ac.UK."
+    [|"sxk.ZZZ.ac.UK."; ".UK"|];
+  test_search_forward r n "x-.y-."
+    [|"x-.y-."; ".y-"|];
+  test_search_forward r n "-abc.peq."
+    [||];
+
+  start_test "Search for /^\\*\\.[a-z]\\([a-z0-9-]*[a-z0-9]+\\)?\
+                         \\(\\.[a-z]\\([a-z0-9-]*[a-z0-9]+\\)?\\)*$/";
+  let r =
+    Str.regexp "^\\*\\.[a-z]\\([a-z0-9-]*[a-z0-9]+\\)?\
+                \\(\\.[a-z]\\([a-z0-9-]*[a-z0-9]+\\)?\\)*$"
+  in
+  let n = 3 in
+  test_search_forward r n "*.a"
+    [|"*.a"; "~"; "~"; "~"|];
+  test_search_forward r n "*.b0-a"
+    [|"*.b0-a"; "0-a"; "~"; "~"|];
+  test_search_forward r n "*.c3-b.c"
+    [|"*.c3-b.c"; "3-b"; ".c"; "~"|];
+  test_search_forward r n "*.c-a.b-c"
+    [|"*.c-a.b-c"; "-a"; ".b-c"; "-c"|];
+  test_search_forward r n "*.0"
+    [||];
+  test_search_forward r n "*.a-"
+    [||];
+  test_search_forward r n "*.a-b.c-"
+    [||];
+  test_search_forward r n "*.c-a.0-c"
+    [||];
+
+  start_test "Search for /^[0-9a-fA-F]\\(\\.[0-9a-fA-F]\\)*$/";
+  let r = Str.regexp "^[0-9a-fA-F]\\(\\.[0-9a-fA-F]\\)*$" in
+  let n = 1 in
+  test_search_forward r n "a.b.c.d"
+    [|"a.b.c.d"; ".d"|];
+  test_search_forward r n "A.B.C.D"
+    [|"A.B.C.D"; ".D"|];
+  test_search_forward r n "a.b.c.1.2.3.C"
+    [|"a.b.c.1.2.3.C"; ".C"|];
+  test_search_forward r n "a.b.c.dz"
+    [||];
+  test_search_forward r n "za"
+    [||];
+
+  start_test "Search for /^\\\".*\\\" *\\(;.*\\)?$/";
+  let r = Str.regexp "^\\\".*\\\" *\\(;.*\\)?$" in
+  let n = 1 in
+  test_search_forward r n "\"1234\""
+    [|"\"1234\""; "~"|];
+  test_search_forward r n "\"abcd\" ;"
+    [|"\"abcd\" ;"; ";"|];
+  test_search_forward r n "\"\" ; rhubarb"
+    [|"\"\" ; rhubarb"; "; rhubarb"|];
+  test_search_forward r n "\"1234\" : things"
+    [||];
+
+  start_test "Search for /^\\(a\\(b\\(c\\)\\)\\)\\(d\\(e\\(f\\)\\)\\)\
+                         \\(h\\(i\\(j\\)\\)\\)$/";
+  let r =
+    Str.regexp "^\\(a\\(b\\(c\\)\\)\\)\\(d\\(e\\(f\\)\\)\\)\
+                \\(h\\(i\\(j\\)\\)\\)$"
+  in
+  let n = 9 in
+  test_search_forward r n "abcdefhij"
+    [|"abcdefhij"; "abc"; "bc"; "c"; "def"; "ef"; "f"; "hij"; "ij"; "j"|];
+
+  start_test "Search for /^[.^$|()*+?{,}]+/";
+  let r = Str.regexp "^[.^$|()*+?{,}]+" in
+  let n = 0 in
+  test_search_forward r n ".^$*(+)|{?,?}"
+    [|".^$*(+)|{?,?}"|];
+
+  start_test "Search for /\\(cat\\(a\\(ract\\|tonic\\)\\|erpillar\\)\\) \
+                         \\1\\(\\)2\\(3\\)/";
+  let r =
+    Str.regexp "\\(cat\\(a\\(ract\\|tonic\\)\\|erpillar\\)\\) \\1\\(\\)2\\(3\\)"
+  in
+  let n = 5 in
+  test_search_forward r n "cataract cataract23"
+    [|"cataract cataract23"; "cataract"; "aract"; "ract"; ""; "3"|];
+  test_search_forward r n "catatonic catatonic23"
+    [|"catatonic catatonic23"; "catatonic"; "atonic"; "tonic"; ""; "3"|];
+  test_search_forward r n "caterpillar caterpillar23"
+    [|"caterpillar caterpillar23"; "caterpillar"; "erpillar"; "~"; ""; "3"|];
+
+  start_test "Search for /^From +\\([^ ]+\\) +[a-zA-Z][a-zA-Z][a-zA-Z] \
+              +[a-zA-Z][a-zA-Z][a-zA-Z] +[0-9]?[0-9] +[0-9][0-9]:[0-9][0-9]/";
+  let r =
+    Str.regexp "^From +\\([^ ]+\\) +[a-zA-Z][a-zA-Z][a-zA-Z] \
+                +[a-zA-Z][a-zA-Z][a-zA-Z] +[0-9]?[0-9] +[0-9][0-9]:[0-9][0-9]"
+  in
+  let n = 1 in
+  test_search_forward r n "From abcd  Mon Sep 01 12:33:02 1997"
+    [|"From abcd  Mon Sep 01 12:33"; "abcd"|];
+
+  start_test "Search for /\\ba/";
+  let r = Str.regexp "\\ba" in
+  let n = 0 in
+  test_search_forward r n "a2cd"
+    [|"a"|];
+  test_search_forward r n "the a"
+    [|"a"|];
+  test_search_forward r n ".ab"
+    [|"a"|];
+  test_search_forward r n "bad"
+    [||];
+  test_search_forward r n "the ba"
+    [||];
+  test_search_forward r n "ba."
+    [||];
+
+  start_test "Search for /a\\b/";
+  let r = Str.regexp "a\\b" in
+  let n = 0 in
+  test_search_forward r n "a"
+    [|"a"|];
+  test_search_forward r n "bc_a"
+    [|"a"|];
+  test_search_forward r n "a foo"
+    [|"a"|];
+  test_search_forward r n "a."
+    [|"a"|];
+  test_search_forward r n "bad"
+    [||];
+  test_search_forward r n "ab"
+    [||];
+
+  start_test "Search for /\\([a-z]*\\)b/";
+  let r = Str.regexp "\\([a-z]*\\)b" in
+  let n = 1 in
+  test_search_forward r n "abbb"
+    [|"abbb"; "abb"|];
+
+  start_test "Search for /\\([a-z]+\\)b/";
+  let r = Str.regexp "\\([a-z]+\\)b" in
+  let n = 1 in
+  test_search_forward r n "abbb"
+    [|"abbb"; "abb"|];
+
+  start_test "Search for /\\([a-z]?\\)b/";
+  let r = Str.regexp "\\([a-z]?\\)b" in
+  let n = 1 in
+  test_search_forward r n "bbbb"
+    [|"bb"; "b"|];
+
+  start_test "Search for /^a/";
+  let r = Str.regexp "^a" in
+  let n = 0 in
+  test_search_forward r n "abcdef"
+    [|"a"|];
+  test_search_forward r n "zzzz\nabcdef"
+    [|"a"|];
+
+  start_test "Search for /a$/";
+  let r = Str.regexp "a$" in
+  let n = 0 in
+  test_search_forward r n "xyza"
+    [|"a"|];
+  test_search_forward r n "xyza\nbcdef"
+    [|"a"|];
+
+  start_test "Null characters in regexps";
+  let r = Str.regexp "ab\000cd" in
+  let n = 0 in
+  test_search_forward r n "qerpoiuab\000cdwerltkh"
+    [| "ab\000cd" |];
+  let r = Str.regexp "\000cd" in
+  let n = 0 in
+  test_search_forward r n "qerpoiuab\000cdwerltkh"
+    [| "\000cd" |];
+
+  (* PR#6989 *)
+  start_test "Many groups";
+  test_search_forward
+    (Str.regexp
+      "\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\
+       \\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\
+       \\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\\(\\)\
+       \\(\\)\\(x\\)\\(y\\)")
+    33 "xy"
+    [| "xy";
+       ""; ""; ""; ""; ""; ""; ""; ""; ""; "";
+       ""; ""; ""; ""; ""; ""; ""; ""; ""; "";
+       ""; ""; ""; ""; ""; ""; ""; ""; ""; "";
+       ""; "x"; "y" |];
+
+  (** Backward searches *)
+  start_test "Backward search for /the quick/";
+  let r = Str.regexp "the quick" in
+  let n = 0 in
+  test_search_backward r n "the quick brown fox"
+    [|"the quick"|];
+  test_search_backward r n "What do you know about the quick brown fox?"
+    [|"the quick"|];
+  test_search_backward r n "The quick brown FOX"
+    [||];
+  test_search_backward r n "What do you know about THE QUICK BROWN FOX?"
+    [||];
+
+  start_test "Backward search for /a\\([0-9]+\\)/";
+  let r = Str.regexp "a\\([0-9]+\\)" in
+  let n = 1 in
+  test_search_backward r n "a123 a456zzzz"
+    [|"a456"; "456"|];
+  test_search_backward r n "ab123"
+    [||];
+
+  (** Partial match searches *)
+
+  start_test "Partial match for /partial match/";
+  let r = Str.regexp "partial match" in
+  let n = 0 in
+  test_partial_match r n ""
+    [|""|];
+  test_partial_match r n "partial matching"
+    [|"partial match"|];
+  test_partial_match r n "partial m"
+    [|"partial m"|];
+
+  start_test "Partial match for /\\(partial\\)\\|\\(match\\)/";
+  let r = Str.regexp "\\(partial\\)\\|\\(match\\)" in
+  let n = 2 in
+  test_partial_match r n ""
+    [|""; "~"; "~"|];
+  test_partial_match r n "part"
+    [|"part"; "~"; "~"|];
+  test_partial_match r n "partial"
+    [|"partial"; "partial"; "~"|];
+  test_partial_match r n "matching"
+    [|"match"; "~"; "match"|];
+  test_partial_match r n "mat"
+    [|"mat"; "~"; "~"|];
+  test_partial_match r n "zorglub"
+    [||];
+
+  (** Replacement *)
+  start_test "Global replacement";
+  test (Str.global_replace (Str.regexp "[aeiou]") ".."
+          "abcdefghijklmnopqrstuvwxyz")
+       "..bcd..fgh..jklmn..pqrst..vwxyz";
+  test (Str.global_replace (Str.regexp "[0-9]\\([0-9]*\\)") "-\\0-\\1-"
+          "abc012def3ghi45")
+       "abc-012-12-def-3--ghi-45-5-";
+  test (Str.global_replace (Str.regexp "[0-9]?") "."
+          "abc012def3ghi45")
+       ".a.b.c....d.e.f..g.h.i...";
+
+  start_test "First replacement";
+  test (Str.replace_first (Str.regexp "[eiou]") ".."
+          "abcdefghijklmnopqrstuvwxyz")
+       "abcd..fghijklmnopqrstuvwxyz";
+  test (Str.replace_first (Str.regexp "[0-9]\\([0-9]*\\)") "-\\0-\\1-"
+          "abc012def3ghi45")
+       "abc-012-12-def3ghi45";
+
+  (** Splitting *)
+  start_test "Splitting";
+  test (Str.split (Str.regexp "[ \t]+") "si non e vero")
+       ["si"; "non"; "e"; "vero"];
+  test (Str.split (Str.regexp "[ \t]+") " si non\te vero\t")
+       ["si"; "non"; "e"; "vero"];
+  test (Str.bounded_split (Str.regexp "[ \t]+") " si non e vero " 3)
+       ["si"; "non"; "e vero "];
+  test (Str.split (Str.regexp "[ \t]*") "si non e vero")
+       ["s"; "i"; "n"; "o"; "n"; "e"; "v"; "e"; "r"; "o"];
+  test (Str.split_delim (Str.regexp "[ \t]+") " si non e vero\t")
+       [""; "si"; "non"; "e"; "vero"; ""];
+  test (Str.full_split (Str.regexp "[ \t]+") " si non\te vero\t")
+       [Str.Delim " "; Str.Text "si";
+        Str.Delim " "; Str.Text "non";
+        Str.Delim "\t"; Str.Text "e";
+        Str.Delim " "; Str.Text "vero"; Str.Delim "\t"];
+
+  (** XML tokenization *)
+  (* See "REX: XML Shallow Parsing with Regular Expressions",
+     Robert D. Cameron, Simon Fraser University, CMPT TR 1998-17. *)
+  start_test "XML tokenization";
+  begin
+    let _TextSE = "[^<]+" in
+    let _UntilHyphen = "[^-]*-" in
+    let _Until2Hyphens = _UntilHyphen ^ "\\([^-]" ^ _UntilHyphen ^ "\\)*-" in
+    let _CommentCE = _Until2Hyphens ^ ">?" in
+    let _UntilRSBs = "[^]]*]\\([^]]+]\\)*]+" in
+    let _CDATA_CE = _UntilRSBs ^ "\\([^]>]" ^ _UntilRSBs ^ "\\)*>" in
+    let _S = "[ \n\t\r]+" in
+    let _NameStrt = "[A-Za-z_:]\\|[^\x00-\x7F]" in
+    let _NameChar = "[A-Za-z0-9_:.-]\\|[^\x00-\x7F]" in
+    let _Name = "\\(" ^ _NameStrt ^ "\\)\\(" ^ _NameChar ^ "\\)*" in
+    let _QuoteSE = "\"[^\"]*\"\\|'[^']*'" in
+    let _DT_IdentSE =
+      _S ^ _Name ^ "\\(" ^ _S ^ "\\(" ^ _Name ^ "\\|" ^ _QuoteSE ^ "\\)\\)*"
+    in
+    let _MarkupDeclCE = "\\([^]\"'><]\\|" ^ _QuoteSE ^ "\\)*>" in
+    let _S1 = "[\n\r\t ]" in
+    let _UntilQMs = "[^?]*\\?+" in
+    let _PI_Tail =
+      "\\?>\\|" ^ _S1 ^ _UntilQMs ^ "\\([^>?]" ^ _UntilQMs ^ "\\)*>"
+    in
+    let _DT_ItemSE =
+      "<\\(!\\(--" ^ _Until2Hyphens ^ ">\\|[^-]" ^ _MarkupDeclCE ^ "\\)\\|\\?"
+      ^ _Name ^ "\\(" ^ _PI_Tail ^ "\\)\\)\\|%" ^ _Name ^ ";\\|" ^ _S1
+    in
+    let _DocTypeCE =
+      _DT_IdentSE ^ "\\(" ^ _S ^ "\\)?\\(\\[\\(" ^ _DT_ItemSE ^ "\\)*]\\("
+      ^ _S ^ "\\)?\\)?>?"
+    in
+    let _DeclCE =
+      "--\\(" ^ _CommentCE ^ "\\)?\\|\\[_CDATA\\[\\(" ^ _CDATA_CE
+      ^ "\\)?\\|_DOCTYPE\\(" ^ _DocTypeCE ^ "\\)?"
+    in
+    let _PI_CE = _Name ^ "\\(" ^ _PI_Tail ^ "\\)?" in
+    let _EndTagCE = _Name ^ "\\(" ^ _S ^ "\\)?>?" in
+    let _AttValSE = "\"[^<\"]*\"\\|'[^<']*'" in
+    let _ElemTagCE =
+      _Name ^ "\\(" ^ _S ^ _Name ^ "\\(" ^ _S ^ "\\)?=\\(" ^ _S ^ "\\)?\\("
+      ^ _AttValSE ^ "\\)\\)*\\(" ^ _S ^ "\\)?/?>?"
+    in
+    let _MarkupSPE =
+      "<\\(!\\(" ^ _DeclCE ^ "\\)?\\|\\?\\(" ^ _PI_CE ^ "\\)?\\|/\\("
+      ^ _EndTagCE ^ "\\)?\\|\\(" ^ _ElemTagCE ^ "\\)?\\)"
+    in
+    let _XML_SPE = _TextSE ^ "\\|" ^ _MarkupSPE in
+    let input = "\
+<?xml version=\"1.0\"?>\n\
+<?xml-stylesheet type=\"text/css\" href=\"nutrition.css\"?>\n\
+<!DOCTYPE root [\n\
+\   <!ELEMENT root (stem)>\n\
+\   <!ELEMENT stem EMPTY>\n\
+]>\n\
+<!ELEMENT name (#PCDATA)>\n\
+<![CDATA[my\n\
+escaped text]]> \n\
+<nutrition>\n\
+<daily-values>\n\
+\t<total-fat units=\"g\">65</total-fat>\n\
+\t<saturated-fat units=\"g\">20</saturated-fat>\n\
+\t<cholesterol units=\"mg\">300</cholesterol>\n\
+\t<sodium units=\"mg\">2400</sodium>\n\
+\t<carb units=\"g\">300</carb>\n\
+\t<fiber units=\"g\">25</fiber>\n\
+\t<protein units=\"g\">50</protein>\n\
+</daily-values>\n\
+<food>\n\
+\t<name>Avocado Dip</name>\n\
+\t<mfr>Sunnydale</mfr>\n\
+\t<serving units=\"g\">29</serving>\n\
+\t<calories total=\"110\" fat=\"100\"/>\n\
+\t<total-fat>11</total-fat>\n\
+\t<saturated-fat>3</saturated-fat>\n\
+\t<cholesterol>5</cholesterol>\n\
+\t<sodium>210</sodium>\n\
+\t<carb>2</carb>\n\
+\t<fiber>0</fiber>\n\
+\t<protein>1</protein>\n\
+\t<vitamins>\n\
+\t\t<a>0</a>\n\
+\t\t<c>0</c>\n\
+\t</vitamins>\n\
+\t<minerals>\n\
+\t\t<ca>0</ca>\n\
+\t\t<fe>0</fe>\n\
+\t</minerals>\n\
+</food>\n\
+<!--\n\
+<food>\n\
+\t<name></name>\n\
+\t<mfr></mfr>\n\
+\t<serving units=\"g\"></serving>\n\
+\t<calories total=\"\" fat=\"\"/>\n\
+\t<total-fat></total-fat>\n\
+\t<saturated-fat></saturated-fat>\n\
+\t<cholesterol></cholesterol>\n\
+\t<sodium></sodium>\n\
+\t<carb></carb>\n\
+\t<fiber></fiber>\n\
+\t<protein></protein>\n\
+\t<vitamins>\n\
+\t\t<a></a>\n\
+\t\t<c></c>\n\
+\t</vitamins>\n\
+\t<minerals>\n\
+\t\t<ca></ca>\n\
+\t\t<fe></fe>\n\
+\t</minerals>\n\
+</food>\n\
+-->\n\
+" in
+    let result = [
+  "<?xml version=\"1.0\"?>";
+  "\n";
+  "<?xml-stylesheet type=\"text/css\" href=\"nutrition.css\"?>";
+  "\n";
+  "<!";
+  "DOCTYPE root [\n   ";
+  "<!";
+  "ELEMENT root (stem)>\n   ";
+  "<!";
+  "ELEMENT stem EMPTY>\n]>\n";
+  "<!";
+  "ELEMENT name (#PCDATA)>\n";
+  "<!";
+  "[CDATA[my\nescaped text]]> \n";
+  "<nutrition>";
+  "\n";
+  "<daily-values>";
+  "\n\t";
+  "<total-fat units=\"g\">";
+  "65";
+  "</total-fat>";
+  "\n\t";
+  "<saturated-fat units=\"g\">";
+  "20";
+  "</saturated-fat>";
+  "\n\t";
+  "<cholesterol units=\"mg\">";
+  "300";
+  "</cholesterol>";
+  "\n\t";
+  "<sodium units=\"mg\">";
+  "2400";
+  "</sodium>";
+  "\n\t";
+  "<carb units=\"g\">";
+  "300";
+  "</carb>";
+  "\n\t";
+  "<fiber units=\"g\">";
+  "25";
+  "</fiber>";
+  "\n\t";
+  "<protein units=\"g\">";
+  "50";
+  "</protein>";
+  "\n";
+  "</daily-values>";
+  "\n";
+  "<food>";
+  "\n\t";
+  "<name>";
+  "Avocado Dip";
+  "</name>";
+  "\n\t";
+  "<mfr>";
+  "Sunnydale";
+  "</mfr>";
+  "\n\t";
+  "<serving units=\"g\">";
+  "29";
+  "</serving>";
+  "\n\t";
+  "<calories total=\"110\" fat=\"100\"/>";
+  "\n\t";
+  "<total-fat>";
+  "11";
+  "</total-fat>";
+  "\n\t";
+  "<saturated-fat>";
+  "3";
+  "</saturated-fat>";
+  "\n\t";
+  "<cholesterol>";
+  "5";
+  "</cholesterol>";
+  "\n\t";
+  "<sodium>";
+  "210";
+  "</sodium>";
+  "\n\t";
+  "<carb>";
+  "2";
+  "</carb>";
+  "\n\t";
+  "<fiber>";
+  "0";
+  "</fiber>";
+  "\n\t";
+  "<protein>";
+  "1";
+  "</protein>";
+  "\n\t";
+  "<vitamins>";
+  "\n\t\t";
+  "<a>";
+  "0";
+  "</a>";
+  "\n\t\t";
+  "<c>";
+  "0";
+  "</c>";
+  "\n\t";
+  "</vitamins>";
+  "\n\t";
+  "<minerals>";
+  "\n\t\t";
+  "<ca>";
+  "0";
+  "</ca>";
+  "\n\t\t";
+  "<fe>";
+  "0";
+  "</fe>";
+  "\n\t";
+  "</minerals>";
+  "\n";
+  "</food>";
+  "\n";
+  "<!--\n\
+   <food>\n\
+   \t<name></name>\n\
+   \t<mfr></mfr>\n\
+   \t<serving units=\"g\"></serving>\n\
+   \t<calories total=\"\" fat=\"\"/>\n\
+   \t<total-fat></total-fat>\n\
+   \t<saturated-fat></saturated-fat>\n\
+   \t<cholesterol></cholesterol>\n\
+   \t<sodium></sodium>\n\
+   \t<carb></carb>\n\
+   \t<fiber></fiber>\n\
+   \t<protein></protein>\n\
+   \t<vitamins>\n\
+   \t\t<a></a>\n\
+   \t\t<c></c>\n\
+   \t</vitamins>\n\
+   \t<minerals>\n\
+   \t\t<ca></ca>\n\
+   \t\t<fe></fe>\n\
+   \t</minerals>\n\
+   </food>\n\
+   -->";
+  "\n"] in
+    let re = Str.regexp _XML_SPE in
+    let rec process i l =
+      let j = try Str.search_forward re input i with Not_found -> (-1) in
+      if j < 0 then begin
+        test l []
+      end else begin
+        match l with
+          [] -> test 0 1 (* failure *)
+        | hd :: tl ->
+            test (Str.matched_string input) hd; process (Str.match_end()) tl
+      end in
+    process 0 result
+  end;
+
+  end_test()
+
+let manual_test regexp text =
+  try
+    ignore (Str.search_forward (Str.regexp regexp) text 0);
+    printf "Matched,";
+    begin try
+      for i = 0 to 31 do
+        try
+          let s = Str.matched_group i text in
+          printf " \\%d=%s" i s
+        with Not_found ->
+          ()
+      done
+    with Invalid_argument str as exn ->
+      if str="Str.matched_group" then () else raise exn
+    end;
+    print_newline()
+  with Not_found ->
+    printf "Not matched\n"
+
+let _ =
+  if Array.length Sys.argv >= 3
+  then manual_test Sys.argv.(1) Sys.argv.(2)
+  else automated_test()
diff --git a/testsuite/tests/lib-str/t01.reference b/testsuite/tests/lib-str/t01.reference
new file mode 100644
index 00000000..0a719240
--- /dev/null
+++ b/testsuite/tests/lib-str/t01.reference
@@ -0,0 +1,106 @@
+
+Search for /the quick brown fox/
+  ....
+Search for /the quick brown fox/ (case-insensitive)
+  .....
+Search for /a*abc?xyz+pqrrrabbb*xyyyyy?pq?q?q?q?q?q?AB*zz/
+  ....................................
+Search for /^abc\(abc\)?zz/
+  .....
+Search for /^\(b+\|a\)\(b+\|a\)?c/
+  ..........
+Search for /r\(\(g*\|k\)y?\)*A/
+  ....
+Search for /A\(\(t\|v\)\(q?\|n\)\)*A/
+  .
+Search for /A\(\(b\(\(d\|l*\)?\|w\)\)*a\)A/
+  .
+Search for /\(\|f\)*x/
+  ....
+Search for /\(\|f\)+x/
+  ....
+Search for /A\(.?\)*A/
+  ....
+Search for /\([ab]*\)\1+c/
+  ...
+Search for /^\(\(b+\|a\)\(b+\|a\)?\)?bc/
+  .
+Search for /^\(\(b*\|ba\)\(b*\|ba\)?\)?bc/
+  .....
+Search for /[^a]/
+  ..
+Search for /[^a]/ (case-insensitive)
+  ..
+Search for /^[]abcde]/
+  .........
+Search for /^[]cde]/
+  ......
+Search for /^[^]abcde]/
+  .........
+Search for /^[^]cde]/
+  ......
+Search for /^ÿ/
+  .
+Search for /^[0-9]+$/
+  .............
+Search for /^.*nter/
+  ...
+Search for /^xxx[0-9]+$/
+  ...
+Search for /^.+[0-9][0-9][0-9]$/
+  .....
+Search for /^\([^!]+\)!\(.+\)=apquxz\.ixr\.zzz\.ac\.uk$/
+  .....
+Search for /\([0-9a-f:]+\)$/
+  ............
+Search for /^[a-z0-9][a-z0-9-]*\(\.[a-z0-9][A-Z0-9-]*\)*\.$/
+  .........
+Search for /^\*\.[a-z]\([a-z0-9-]*[a-z0-9]+\)?\(\.[a-z]\([a-z0-9-]*[a-z0-9]+\)?\)*$/
+  ........
+Search for /^[0-9a-fA-F]\(\.[0-9a-fA-F]\)*$/
+  .....
+Search for /^\".*\" *\(;.*\)?$/
+  ....
+Search for /^\(a\(b\(c\)\)\)\(d\(e\(f\)\)\)\(h\(i\(j\)\)\)$/
+  .
+Search for /^[.^$|()*+?{,}]+/
+  .
+Search for /\(cat\(a\(ract\|tonic\)\|erpillar\)\) \1\(\)2\(3\)/
+  ...
+Search for /^From +\([^ ]+\) +[a-zA-Z][a-zA-Z][a-zA-Z] +[a-zA-Z][a-zA-Z][a-zA-Z] +[0-9]?[0-9] +[0-9][0-9]:[0-9][0-9]/
+  .
+Search for /\ba/
+  ......
+Search for /a\b/
+  ......
+Search for /\([a-z]*\)b/
+  .
+Search for /\([a-z]+\)b/
+  .
+Search for /\([a-z]?\)b/
+  .
+Search for /^a/
+  ..
+Search for /a$/
+  ..
+Null characters in regexps
+  ..
+Many groups
+  .
+Backward search for /the quick/
+  ....
+Backward search for /a\([0-9]+\)/
+  ..
+Partial match for /partial match/
+  ...
+Partial match for /\(partial\)\|\(match\)/
+  ......
+Global replacement
+  ...
+First replacement
+  ..
+Splitting
+  ......
+XML tokenization
+  .........................................................................................................................
+All tests passed
diff --git a/testsuite/tests/lib-stream/count_concat_bug.ml b/testsuite/tests/lib-stream/count_concat_bug.ml
new file mode 100644
index 00000000..fc31c76a
--- /dev/null
+++ b/testsuite/tests/lib-stream/count_concat_bug.ml
@@ -0,0 +1,61 @@
+(* TEST
+   include testing
+*)
+
+let is_empty s =
+  try Stream.empty s; true with Stream.Failure -> false
+
+let test_icons =
+  let s = Stream.of_string "ab" in
+  let s = Stream.icons 'c' s in
+  Testing.test (Stream.next s = 'c');
+  Testing.test (Stream.next s = 'a');
+  Testing.test (Stream.next s = 'b');
+  Testing.test (is_empty s);
+  ()
+
+let test_lcons =
+  let s = Stream.of_string "ab" in
+  let s = Stream.lcons (fun () -> 'c') s in
+  Testing.test (Stream.next s = 'c');
+  Testing.test (Stream.next s = 'a');
+  Testing.test (Stream.next s = 'b');
+  Testing.test (is_empty s);
+  ()
+
+let test_iapp =
+  let s = Stream.of_string "ab" in
+  let s = Stream.iapp (Stream.of_list ['c']) s in
+  Testing.test (Stream.next s = 'c');
+  Testing.test (Stream.next s = 'a');
+  Testing.test (Stream.next s = 'b');
+  Testing.test (is_empty s);
+  ()
+
+let test_lapp_right =
+  let s1 = Stream.of_list ['c'] in
+  let s2 = Stream.of_string "ab" in
+  let s = Stream.lapp (fun () -> s1) s2 in
+  Testing.test (Stream.next s = 'c');
+  Testing.test (Stream.next s = 'a');
+  Testing.test (Stream.next s = 'b');
+  Testing.test (is_empty s);
+  ()
+
+let test_lapp_left =
+  let s1 = Stream.of_string "bc" in
+  let s2 = Stream.of_list ['a'] in
+  Testing.test (Stream.next s1 = 'b');
+  let s = Stream.lapp (fun () -> s1) s2 in
+  Testing.test (Stream.next s = 'c');
+  Testing.test (Stream.next s = 'a');
+  Testing.test (is_empty s);
+  ()
+
+let test_slazy =
+  let s = Stream.of_string "ab" in
+  Testing.test (Stream.next s = 'a');
+  let s = Stream.slazy (fun () -> s) in
+  Testing.test (Stream.next s = 'b');
+  Testing.test (is_empty s);
+  ()
diff --git a/testsuite/tests/lib-stream/count_concat_bug.reference b/testsuite/tests/lib-stream/count_concat_bug.reference
new file mode 100644
index 00000000..52e367ea
--- /dev/null
+++ b/testsuite/tests/lib-stream/count_concat_bug.reference
@@ -0,0 +1,2 @@
+ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
+All tests succeeded.
diff --git a/testsuite/tests/lib-stream/mpr7769.ml b/testsuite/tests/lib-stream/mpr7769.ml
new file mode 100644
index 00000000..da40a473
--- /dev/null
+++ b/testsuite/tests/lib-stream/mpr7769.ml
@@ -0,0 +1,9 @@
+(* TEST
+   files = "mpr7769.txt"
+*)
+
+let () =
+  let s = Stream.of_channel (open_in "mpr7769.txt") in
+  Stream.junk s;
+  print_char (Stream.next s);
+  print_newline ()
diff --git a/testsuite/tests/lib-stream/mpr7769.reference b/testsuite/tests/lib-stream/mpr7769.reference
new file mode 100644
index 00000000..61780798
--- /dev/null
+++ b/testsuite/tests/lib-stream/mpr7769.reference
@@ -0,0 +1 @@
+b
diff --git a/testsuite/tests/lib-stream/mpr7769.txt b/testsuite/tests/lib-stream/mpr7769.txt
new file mode 100644
index 00000000..81bf3969
--- /dev/null
+++ b/testsuite/tests/lib-stream/mpr7769.txt
@@ -0,0 +1 @@
+ab
diff --git a/testsuite/tests/lib-string/test_string.ml b/testsuite/tests/lib-string/test_string.ml
new file mode 100644
index 00000000..cd45af62
--- /dev/null
+++ b/testsuite/tests/lib-string/test_string.ml
@@ -0,0 +1,55 @@
+(* TEST
+*)
+
+let rec build_string f n accu =
+  if n <= 0
+    then String.concat "" accu
+    else build_string f (n-1) (f (n-1) :: accu)
+;;
+
+let char n = String.make 1 (Char.chr n);;
+
+let reference n =
+  if n = 8 then "\\b"
+  else if n = 9 then "\\t"
+  else if n = 10 then "\\n"
+  else if n = 13 then "\\r"
+  else if n = Char.code '\"' then "\\\""
+  else if n = Char.code '\\' then "\\\\"
+  else if n < 32 || n > 126 then Printf.sprintf "\\%03d" n
+  else char n
+;;
+
+let raw_string = build_string char 256 [];;
+let ref_string = build_string reference 256 [];;
+
+if String.escaped raw_string <> ref_string then failwith "test:String.escaped";;
+
+
+let check_split sep s =
+  let l = String.split_on_char sep s in
+  assert(List.length l > 0);
+  assert(String.concat (String.make 1 sep) l = s);
+  List.iter (String.iter (fun c -> assert (c <> sep))) l
+;;
+
+let () =
+  let s = " abc def " in
+  for i = 0 to String.length s do
+    check_split ' ' (String.sub s 0 i)
+  done
+;;
+
+(* GPR#805/815/833 *)
+
+let ()  =
+  if Sys.word_size = 32 then begin
+    let big = String.make Sys.max_string_length 'x' in
+    let push x l = l := x :: !l in
+    let (+=) a b = a := !a + b in
+    let sz, l = ref 0, ref [] in
+    while !sz >= 0 do push big l; sz += Sys.max_string_length done;
+    while !sz <= 0 do push big l; sz += Sys.max_string_length done;
+    try ignore (String.concat "" !l); assert false
+    with Invalid_argument _ -> ()
+  end
diff --git a/testsuite/tests/lib-string/test_string.reference b/testsuite/tests/lib-string/test_string.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/lib-sys/immediate64.ml b/testsuite/tests/lib-sys/immediate64.ml
new file mode 100644
index 00000000..0f7dea7c
--- /dev/null
+++ b/testsuite/tests/lib-sys/immediate64.ml
@@ -0,0 +1,32 @@
+(* TEST
+*)
+
+module M : sig
+  type t [@@immediate64]
+  val zero : t
+  val one : t
+  val add : t -> t -> t
+end = struct
+
+  include Sys.Immediate64.Make(Int)(Int64)
+
+  module type S = sig
+    val zero : t
+    val one : t
+    val add : t -> t -> t
+  end
+
+  let impl : (module S) =
+    match repr with
+    | Immediate ->
+        (module Int : S)
+    | Non_immediate ->
+        (module Int64 : S)
+
+  include (val impl : S)
+end
+
+let () =
+  match Sys.word_size with
+  | 64 -> assert (Obj.is_int (Obj.repr M.zero))
+  | _  -> assert (Obj.is_block (Obj.repr M.zero))
diff --git a/testsuite/tests/lib-sys/rename.ml b/testsuite/tests/lib-sys/rename.ml
new file mode 100644
index 00000000..2091c50b
--- /dev/null
+++ b/testsuite/tests/lib-sys/rename.ml
@@ -0,0 +1,55 @@
+(* TEST
+*)
+
+(* Test the Sys.rename function *)
+
+let writefile filename contents =
+  let oc = open_out_bin filename in
+  output_string oc contents;
+  close_out oc
+
+let readfile filename =
+  let ic = open_in_bin filename in
+  let sz = in_channel_length ic in
+  let contents = really_input_string ic sz in
+  close_in ic;
+  contents
+
+let safe_remove filename =
+  try Sys.remove filename with Sys_error _ -> ()
+
+let testrename f1 f2 contents =
+  try
+    Sys.rename f1 f2;
+    if readfile f2 <> contents then print_string "wrong contents!"
+    else if Sys.file_exists f1 then print_string "initial file still exists!"
+    else print_string "passed"
+  with Sys_error msg ->
+    print_string "Sys_error exception: "; print_string msg
+
+let testfailure f1 f2 =
+  try
+    Sys.rename f1 f2; print_string "should fail but doesn't!"
+  with Sys_error _ ->
+    print_string "fails as expected"
+
+let _ =
+  let f1 = "file1.dat" and f2 = "file2.dat" in
+  safe_remove f1; safe_remove f2;
+  print_string "Rename to nonexisting file: ";
+  writefile f1 "abc";
+  testrename f1 f2 "abc";
+  print_newline();
+  print_string "Rename to existing file: ";
+  writefile f1 "def";
+  writefile f2 "xyz";
+  testrename f1 f2 "def";
+  print_newline();
+  print_string "Renaming a nonexisting file: ";
+  testfailure f1 f2;
+  print_newline();
+  print_string "Renaming to a nonexisting directory: ";
+  writefile f1 "abc";
+  testfailure f1 (Filename.concat "nosuchdir" f2);
+  print_newline();
+  safe_remove f1; safe_remove f2
diff --git a/testsuite/tests/lib-sys/rename.reference b/testsuite/tests/lib-sys/rename.reference
new file mode 100644
index 00000000..d5ec88df
--- /dev/null
+++ b/testsuite/tests/lib-sys/rename.reference
@@ -0,0 +1,4 @@
+Rename to nonexisting file: passed
+Rename to existing file: passed
+Renaming a nonexisting file: fails as expected
+Renaming to a nonexisting directory: fails as expected
diff --git a/testsuite/tests/lib-systhreads/testfork.ml b/testsuite/tests/lib-systhreads/testfork.ml
new file mode 100644
index 00000000..3fdf3860
--- /dev/null
+++ b/testsuite/tests/lib-systhreads/testfork.ml
@@ -0,0 +1,40 @@
+(* TEST
+   * hassysthreads
+   include systhreads
+   ** not-bsd
+   *** libunix
+   **** bytecode
+   **** native
+*)
+
+(* POSIX threads and fork() *)
+
+let compute_thread c = ignore c
+(*
+  while true do
+    print_char c; flush stdout;
+    for i = 1 to 100000 do ignore(ref []) done
+  done
+*)
+
+let main () =
+  ignore(Thread.create compute_thread '1');
+  Thread.delay 1.0;
+  print_string "Forking..."; print_newline();
+  match Unix.fork() with
+  | 0 ->
+      Thread.delay 0.5;
+      print_string "In child..."; print_newline();
+      Gc.minor();
+      print_string "Child did minor GC."; print_newline();
+      ignore(Thread.create compute_thread '2');
+      Thread.delay 1.0;
+      print_string "Child is exiting."; print_newline();
+      exit 0
+  | pid ->
+      print_string "In parent..."; print_newline();
+      Thread.delay 4.0;
+      print_string "Parent is exiting."; print_newline();
+      exit 0
+
+let _ = main()
diff --git a/testsuite/tests/lib-systhreads/testfork.reference b/testsuite/tests/lib-systhreads/testfork.reference
new file mode 100644
index 00000000..fb7a3c29
--- /dev/null
+++ b/testsuite/tests/lib-systhreads/testfork.reference
@@ -0,0 +1,6 @@
+Forking...
+In parent...
+In child...
+Child did minor GC.
+Child is exiting.
+Parent is exiting.
diff --git a/testsuite/tests/lib-systhreads/testpreempt.ml b/testsuite/tests/lib-systhreads/testpreempt.ml
new file mode 100644
index 00000000..11d69152
--- /dev/null
+++ b/testsuite/tests/lib-systhreads/testpreempt.ml
@@ -0,0 +1,36 @@
+(* TEST
+   * hassysthreads
+   (*
+     On Windows, we use Sleep(0) for triggering preemption of threads.
+     However, this does not seem very reliable, so that this test fails
+     on some Windows configurations. See GPR #1533.
+   *)
+   include systhreads
+   ** not-windows
+   *** bytecode
+   *** native
+*)
+
+let rec generate_list n =
+  let rec aux acc = function
+    | 0 -> acc
+    | n -> aux (float n :: acc) (n-1)
+  in
+  aux [] n
+
+let rec long_computation time0 =
+  let long_list = generate_list 100000 in
+  let res = List.length (List.rev_map sin long_list) in
+  if Sys.time () -. time0 > 2. then
+    Printf.printf "Long computation result: %d\n%!" res
+  else long_computation time0
+
+let interaction () =
+  Thread.delay 0.1;
+  Printf.printf "Interaction 1\n";
+  Thread.delay 0.1;
+  Printf.printf "Interaction 2\n"
+
+let () =
+  ignore (Thread.create interaction ());
+  long_computation (Sys.time ())
diff --git a/testsuite/tests/lib-systhreads/testpreempt.reference b/testsuite/tests/lib-systhreads/testpreempt.reference
new file mode 100644
index 00000000..95995275
--- /dev/null
+++ b/testsuite/tests/lib-systhreads/testpreempt.reference
@@ -0,0 +1,3 @@
+Interaction 1
+Interaction 2
+Long computation result: 100000
diff --git a/testsuite/tests/lib-systhreads/testyield.ml b/testsuite/tests/lib-systhreads/testyield.ml
new file mode 100644
index 00000000..646dfe3e
--- /dev/null
+++ b/testsuite/tests/lib-systhreads/testyield.ml
@@ -0,0 +1,52 @@
+(* TEST
+   (* Test that yielding between busy threads reliably triggers a thread
+      switch. *)
+   * hassysthreads
+   include systhreads
+   ** not-windows
+   *** bytecode
+   *** native
+*)
+
+let threads = 4
+
+let are_ready = ref 0
+
+let yields = ref 0
+
+let iters = 50000
+
+let last = ref (-1)
+
+let report thread run_length =
+  (* The below loop tests how many times in a row a loop that calls yield runs
+     without changing threads. Ideally the answer would *always* be one, but
+     it's not clear we can reliably guarantee that unless nothing else ever
+     drops the Ocaml lock, so instead just rely on it being small. *)
+  if run_length > 3
+  then Printf.printf "Thread %d ran %d consecutive iters\n" thread run_length
+
+
+let threads =
+  List.init threads (Thread.create (fun i ->
+    incr are_ready;
+    (* Don't make any progress until all threads are spawned and properly
+       contending for the Ocaml lock. *)
+    while !are_ready < threads do
+      Thread.yield ()
+    done;
+    let consecutive = ref 0 in
+    while !yields < iters do
+      incr yields;
+      last := i;
+      Thread.yield ();
+      incr consecutive;
+      if not (!last = i)
+      then (
+        report i !consecutive;
+        consecutive := 0)
+    done;
+    if !consecutive > 0 then report i !consecutive;
+  ));;
+
+List.iter Thread.join threads
diff --git a/testsuite/tests/lib-systhreads/threadsigmask.ml b/testsuite/tests/lib-systhreads/threadsigmask.ml
new file mode 100644
index 00000000..acfaaf93
--- /dev/null
+++ b/testsuite/tests/lib-systhreads/threadsigmask.ml
@@ -0,0 +1,80 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** not-windows
+*** bytecode
+*** native
+*)
+
+let stopped = ref false
+
+(* This function is purposed to do some computations which allocate,
+   so that the corresponding thread is likely to handle signals if it
+   is allowed to. *)
+let rec loop () =
+  let rec generate_list n =
+    let rec aux acc = function
+      | 0 -> acc
+      | n -> aux (float n :: acc) (n-1)
+    in
+    aux [] n
+  in
+  let long_list = generate_list 100000 in
+  let res = List.length (List.rev_map sin long_list) in
+  ignore (Sys.opaque_identity res)
+
+let thread s =
+  ignore (Thread.sigmask Unix.SIG_UNBLOCK [s]);
+  while not !stopped do loop () done
+
+let handler tid_exp cnt signal =
+  incr cnt;
+  if Thread.id (Thread.self ()) != !tid_exp then
+    Printf.printf "Signal received in an unexpected thread !\n"
+
+let _ =
+  ignore (Thread.sigmask Unix.SIG_BLOCK [Sys.sigusr1; Sys.sigusr2]);
+
+  (* Install the signal handlers *)
+  let (tid1, tid2) = (ref 0, ref 0) in
+  let (cnt1, cnt2) = (ref 0, ref 0) in
+  Sys.set_signal Sys.sigusr1 (Sys.Signal_handle (handler tid1 cnt1));
+  Sys.set_signal Sys.sigusr2 (Sys.Signal_handle (handler tid2 cnt2));
+
+  (* Spawn the other thread and unblock sigusr2 in the main thread *)
+  let t1 = Thread.create thread Sys.sigusr1 in
+  let t2 = Thread.self () in
+  ignore (Thread.sigmask Unix.SIG_UNBLOCK [Sys.sigusr2]);
+  tid1 := Thread.id t1;
+  tid2 := Thread.id t2;
+
+  (* Send signals to the current process. They should be received by the
+     correct respective threads. *)
+  let pid = Unix.getpid () in
+  let cntsent = ref 0 in
+  (* We loop until each thread has received at least 5 signals and we
+    have sent more than 100 signals in total. We do not check that all
+    signals get handled, because they could be missed because of the
+    lack of fairness of the scheduler. *)
+  while !cntsent < 100 || !cnt1 < 5 || !cnt2 < 5 do
+    Unix.kill pid Sys.sigusr1;
+    Unix.kill pid Sys.sigusr2;
+    incr cntsent;
+    Thread.delay 0.07;
+
+    (* Still, if too many signals have been sent, we interrupt the
+       test to avoid a timeout. *)
+    if !cntsent > 2000 then begin
+        stopped := true;
+        Thread.join t1;
+        Printf.printf "A thread does not receive signals. %d %d %d\n" !cnt1 !cnt2 !cntsent;
+        exit 0
+    end
+  done;
+
+  (* Join worker thread *)
+  stopped := true;
+  Thread.join t1;
+
+  Printf.printf "OK\n"
diff --git a/testsuite/tests/lib-systhreads/threadsigmask.reference b/testsuite/tests/lib-systhreads/threadsigmask.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-systhreads/threadsigmask.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-threads/backtrace_threads.ml b/testsuite/tests/lib-threads/backtrace_threads.ml
new file mode 100644
index 00000000..3c112d61
--- /dev/null
+++ b/testsuite/tests/lib-threads/backtrace_threads.ml
@@ -0,0 +1,27 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+let () = Printexc.record_backtrace true
+
+let () =
+   let bt =
+     try
+       let h = (Hashtbl.create 1 : (int, unit) Hashtbl.t) in
+       Hashtbl.find h 1;
+       assert false
+     with Not_found ->
+       Printexc.get_raw_backtrace ()
+   in
+   let t = Thread.create (fun () ->
+       try
+         Printexc.raise_with_backtrace Not_found bt
+       with Not_found -> ()
+     ) () in
+   Thread.join t;
+   flush stdout
diff --git a/testsuite/tests/lib-threads/bank.ml b/testsuite/tests/lib-threads/bank.ml
new file mode 100644
index 00000000..c06736ea
--- /dev/null
+++ b/testsuite/tests/lib-threads/bank.ml
@@ -0,0 +1,36 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+(* The bank account example, using events and channels *)
+
+open Printf
+open Event
+
+type account = int channel * int channel
+
+let account (put_ch, get_ch) =
+  let rec acc balance =
+    select [
+      wrap (send get_ch balance) (fun () -> acc balance);
+      wrap (receive put_ch) (fun amount ->
+        if balance + amount < 0 then failwith "negative balance";
+        acc (balance + amount))
+    ]
+  in acc 0
+
+let get ((put_ch, get_ch): account) = sync (receive get_ch)
+let put ((put_ch, get_ch): account) amount = sync (send put_ch amount)
+
+let _ =
+  let a : account = (new_channel(), new_channel()) in
+  ignore (Thread.create account a);
+  put a 100;
+  printf "Current balance: %d\n" (get a);
+  for i = 1 to 99 do put a (-2); put a 1 done;
+  printf "Final balance: %d\n" (get a)
diff --git a/testsuite/tests/lib-threads/bank.reference b/testsuite/tests/lib-threads/bank.reference
new file mode 100644
index 00000000..80ad5cd5
--- /dev/null
+++ b/testsuite/tests/lib-threads/bank.reference
@@ -0,0 +1,2 @@
+Current balance: 100
+Final balance: 1
diff --git a/testsuite/tests/lib-threads/beat.ml b/testsuite/tests/lib-threads/beat.ml
new file mode 100644
index 00000000..1bf88332
--- /dev/null
+++ b/testsuite/tests/lib-threads/beat.ml
@@ -0,0 +1,28 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+(* Test Thread.delay and its scheduling *)
+
+open Printf
+
+let tick (delay, count) =
+  while true do
+    Thread.delay delay;
+    incr count
+  done
+
+let _ =
+  let c1 = ref 0 and c2 = ref 0 in
+  ignore (Thread.create tick (0.333333333, c1));
+  ignore (Thread.create tick (0.5, c2));
+  Thread.delay 3.0;
+  let n1 = !c1 and n2 = !c2 in
+  if n1 >= 8 && n1 <= 10 && n2 >= 5 && n2 <= 7
+  then printf "passed\n"
+  else printf "FAILED (n1 = %d, n2 = %d)\n" n1 n2
diff --git a/testsuite/tests/lib-threads/beat.reference b/testsuite/tests/lib-threads/beat.reference
new file mode 100644
index 00000000..b0aad4de
--- /dev/null
+++ b/testsuite/tests/lib-threads/beat.reference
@@ -0,0 +1 @@
+passed
diff --git a/testsuite/tests/lib-threads/bufchan.ml b/testsuite/tests/lib-threads/bufchan.ml
new file mode 100644
index 00000000..a1929f32
--- /dev/null
+++ b/testsuite/tests/lib-threads/bufchan.ml
@@ -0,0 +1,60 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+open Event
+
+type 'a buffer_channel = {
+  input: 'a channel;
+  output: 'a channel;
+  thread: Thread.t;
+}
+
+let new_buffer_channel() =
+  let ic = new_channel() in
+  let oc = new_channel() in
+  let rec buffer_process front rear =
+    match (front, rear) with
+    | (["EOF"], []) -> Thread.exit ()
+    | ([], []) -> buffer_process [sync(receive ic)] []
+    | (hd::tl, _) ->
+        select [
+          wrap (receive ic) (fun x -> buffer_process front (x::rear));
+          wrap (send oc hd) (fun () -> buffer_process tl rear)
+        ]
+    | ([], _) -> buffer_process (List.rev rear) [] in
+  let t = Thread.create (buffer_process []) [] in
+  { input = ic; output = oc; thread = t }
+
+let buffer_send bc data =
+  sync(send bc.input data)
+
+let buffer_receive bc =
+  receive bc.output
+
+(* Test *)
+
+let box = new_buffer_channel()
+let ch = new_channel()
+
+let f () =
+  buffer_send box "un";
+  buffer_send box "deux";
+  sync (send ch 3)
+
+let g () =
+  print_int (sync(receive ch)); print_newline();
+  print_string (sync(buffer_receive box)); print_newline();
+  print_string (sync(buffer_receive box)); print_newline()
+
+let _ =
+  let t = Thread.create f () in
+  g();
+  buffer_send box "EOF";
+  Thread.join box.thread;
+  Thread.join t
diff --git a/testsuite/tests/lib-threads/bufchan.reference b/testsuite/tests/lib-threads/bufchan.reference
new file mode 100644
index 00000000..35c80454
--- /dev/null
+++ b/testsuite/tests/lib-threads/bufchan.reference
@@ -0,0 +1,3 @@
+3
+un
+deux
diff --git a/testsuite/tests/lib-threads/close.ml b/testsuite/tests/lib-threads/close.ml
new file mode 100644
index 00000000..10f553a6
--- /dev/null
+++ b/testsuite/tests/lib-threads/close.ml
@@ -0,0 +1,27 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+let main () =
+  let (rd, wr) = Unix.pipe() in
+  let t = Thread.create
+    (fun () ->
+      Thread.delay 1.0;
+      print_endline "closing fd...";
+      Unix.close wr;
+    )
+    () in
+  let buf = Bytes.create 10 in
+  print_endline "reading...";
+  begin try ignore (Unix.read rd buf 0 10) with Unix.Unix_error _ -> () end;
+  print_endline "read returned";
+  t
+
+let t = Unix.handle_unix_error main ()
+
+let _ = Thread.join t
diff --git a/testsuite/tests/lib-threads/close.reference b/testsuite/tests/lib-threads/close.reference
new file mode 100644
index 00000000..bb5061c8
--- /dev/null
+++ b/testsuite/tests/lib-threads/close.reference
@@ -0,0 +1,3 @@
+reading...
+closing fd...
+read returned
diff --git a/testsuite/tests/lib-threads/delayintr.ml b/testsuite/tests/lib-threads/delayintr.ml
new file mode 100644
index 00000000..03f63a10
--- /dev/null
+++ b/testsuite/tests/lib-threads/delayintr.ml
@@ -0,0 +1,61 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+
+files = "sigint.c"
+
+** libunix (* excludes mingw32/64 and msvc32/64 *)
+
+*** setup-ocamlc.byte-build-env
+
+program = "${test_build_directory}/delayintr.byte"
+
+**** ocamlc.byte
+
+program = "sigint"
+all_modules = "sigint.c"
+
+***** ocamlc.byte
+
+program = "${test_build_directory}/delayintr.byte"
+all_modules = "delayintr.ml"
+
+****** check-ocamlc.byte-output
+******* run
+******** check-program-output
+
+*** setup-ocamlopt.byte-build-env
+
+program = "${test_build_directory}/delayintr.opt"
+
+**** ocamlopt.byte
+
+program = "sigint"
+all_modules = "sigint.c"
+
+***** ocamlopt.byte
+
+program = "${test_build_directory}/delayintr.opt"
+all_modules = "delayintr.ml"
+
+****** check-ocamlopt.byte-output
+******* run
+******** check-program-output
+
+*)
+
+(* Regression test for MPR#7903 *)
+
+let () =
+  let start = Unix.gettimeofday() in
+  let sighandler _ =
+    let now = Unix.gettimeofday() in
+    if now -. start <= 20. then begin
+      print_string "Received signal early\n"; exit 0
+    end else begin
+      print_string "Received signal late\n"; exit 2
+    end in
+  Sys.set_signal Sys.sigint (Sys.Signal_handle sighandler);
+  Thread.delay 30.;
+  print_string "No signal received\n"; exit 4
diff --git a/testsuite/tests/lib-threads/delayintr.reference b/testsuite/tests/lib-threads/delayintr.reference
new file mode 100644
index 00000000..32476d36
--- /dev/null
+++ b/testsuite/tests/lib-threads/delayintr.reference
@@ -0,0 +1 @@
+Received signal early
diff --git a/testsuite/tests/lib-threads/delayintr.run b/testsuite/tests/lib-threads/delayintr.run
new file mode 100644
index 00000000..1611435d
--- /dev/null
+++ b/testsuite/tests/lib-threads/delayintr.run
@@ -0,0 +1,5 @@
+${program} > ${output} &
+pid=$!
+sleep 2
+./sigint $pid
+wait
diff --git a/testsuite/tests/lib-threads/fileio.ml b/testsuite/tests/lib-threads/fileio.ml
new file mode 100644
index 00000000..596721c4
--- /dev/null
+++ b/testsuite/tests/lib-threads/fileio.ml
@@ -0,0 +1,126 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+(* Test a file copy function *)
+
+let test msg producer consumer src dst =
+  print_string msg; print_newline();
+  let ic = open_in_bin src in
+  let oc = open_out_bin dst in
+  let (in_fd, out_fd) = Unix.pipe() in
+  let ipipe = Unix.in_channel_of_descr in_fd in
+  let opipe = Unix.out_channel_of_descr out_fd in
+  let prod = Thread.create producer (ic, opipe) in
+  let cons = Thread.create consumer (ipipe, oc) in
+  Thread.join prod;
+  Thread.join cons;
+  if Unix.system ("cmp " ^ src ^ " " ^ dst) = Unix.WEXITED 0
+  then print_string "passed"
+  else print_string "FAILED";
+  print_newline()
+
+(* File copy with constant-sized chunks *)
+
+let copy_file sz (ic, oc) =
+  let buffer = Bytes.create sz in
+  let rec copy () =
+    let n = input ic buffer 0 sz in
+    if n = 0 then () else begin
+      output oc buffer 0 n;
+      copy ()
+    end in
+  copy();
+  close_in ic;
+  close_out oc
+
+(* File copy with random-sized chunks *)
+
+let copy_random sz (ic, oc) =
+  let buffer = Bytes.create sz in
+  let rec copy () =
+    let s = 1 + Random.int sz in
+    let n = input ic buffer 0 s in
+    if n = 0 then () else begin
+      output oc buffer 0 n;
+      copy ()
+    end in
+  copy();
+  close_in ic;
+  close_out oc
+
+(* File copy line per line *)
+
+let copy_line (ic, oc) =
+  try
+    while true do
+      output_string oc (input_line ic); output_char oc '\n'
+    done
+  with End_of_file ->
+    close_in ic;
+    close_out oc
+
+(* Create long lines of text *)
+
+let make_lines ofile =
+  let oc = open_out ofile in
+  for i = 1 to 256 do
+    output_string oc (String.make (i*16) '.'); output_char oc '\n'
+  done;
+  close_out oc
+
+(* Test input_line on truncated lines *)
+
+let test_trunc_line ofile =
+  print_string "truncated line"; print_newline();
+  let oc = open_out ofile in
+  output_string oc "A line without newline!";
+  close_out oc;
+  try
+    let ic = open_in ofile in
+    let s = input_line ic in
+    close_in ic;
+    if s = "A line without newline!"
+    then print_string "passed"
+    else print_string "FAILED";
+    print_newline()
+  with End_of_file ->
+    print_string "FAILED"; print_newline()
+
+(* The test *)
+
+let main() =
+  let ifile = if Array.length Sys.argv > 1 then Sys.argv.(1) else "fileio.ml" in
+  let ofile = Filename.temp_file "testio" "" in
+  test "256-byte chunks, 256-byte chunks"
+       (copy_file 256) (copy_file 256) ifile ofile;
+  test "4096-byte chunks, 4096-byte chunks"
+       (copy_file 4096) (copy_file 4096) ifile ofile;
+  test "65536-byte chunks, 65536-byte chunks"
+       (copy_file 65536) (copy_file 65536) ifile ofile;
+  test "256-byte chunks, 4096-byte chunks"
+       (copy_file 256) (copy_file 4096) ifile ofile;
+  test "4096-byte chunks, 256-byte chunks"
+       (copy_file 4096) (copy_file 256) ifile ofile;
+  test "4096-byte chunks, 65536-byte chunks"
+       (copy_file 4096) (copy_file 65536) ifile ofile;
+  test "263-byte chunks, 4011-byte chunks"
+       (copy_file 263) (copy_file 4011) ifile ofile;
+  test "613-byte chunks, 1027-byte chunks"
+       (copy_file 613) (copy_file 1027) ifile ofile;
+  test "0...8192 byte chunks"
+       (copy_random 8192) (copy_random 8192) ifile ofile;
+  let linesfile = Filename.temp_file "lines" "" in
+  make_lines linesfile;
+  test "line per line"
+       copy_line copy_line linesfile ofile;
+  test_trunc_line ofile;
+  Sys.remove linesfile;
+  Sys.remove ofile
+
+let _ = Unix.handle_unix_error main (); exit 0
diff --git a/testsuite/tests/lib-threads/fileio.reference b/testsuite/tests/lib-threads/fileio.reference
new file mode 100644
index 00000000..24f04b9b
--- /dev/null
+++ b/testsuite/tests/lib-threads/fileio.reference
@@ -0,0 +1,22 @@
+256-byte chunks, 256-byte chunks
+passed
+4096-byte chunks, 4096-byte chunks
+passed
+65536-byte chunks, 65536-byte chunks
+passed
+256-byte chunks, 4096-byte chunks
+passed
+4096-byte chunks, 256-byte chunks
+passed
+4096-byte chunks, 65536-byte chunks
+passed
+263-byte chunks, 4011-byte chunks
+passed
+613-byte chunks, 1027-byte chunks
+passed
+0...8192 byte chunks
+passed
+line per line
+passed
+truncated line
+passed
diff --git a/testsuite/tests/lib-threads/pr4466.ml b/testsuite/tests/lib-threads/pr4466.ml
new file mode 100644
index 00000000..0cda04a7
--- /dev/null
+++ b/testsuite/tests/lib-threads/pr4466.ml
@@ -0,0 +1,77 @@
+(* TEST
+
+* hassysthreads
+  include systhreads
+** native
+   compare_programs = "false"
+
+*)
+
+open Printf
+
+(* Regression test for PR#4466: select timeout with simultaneous read
+   and write on socket in Windows. *)
+
+(* Scenario:
+     - thread [server] implements a simple 'echo' server on a socket
+     - thread [reader] selects then reads from a socket connected to
+       the echo server and copies to standard output
+     - main program executes [writer], which writes to the same socket
+       (the one connected to the echo server)
+*)
+
+let server sock =
+  let (s, _) = Unix.accept sock in
+  let buf = Bytes.make 1024 '>' in
+  for i = 1 to 3 do
+    let n = Unix.recv s buf 2 (Bytes.length buf - 2) [] in
+    if n = 0 then begin
+      Unix.close s; Thread.exit ()
+    end else begin
+      ignore (Unix.send s buf 0 (n + 2) [])
+    end
+  done
+
+let reader s =
+  let buf = Bytes.make 16 ' ' in
+  match Unix.select [s] [] [] 10.0 with
+  | (_::_, _, _) ->
+      printf "Selected\n%!";
+      let n = Unix.recv s buf 0 (Bytes.length buf) [] in
+      printf "Data read: %s\n%!" (Bytes.sub_string buf 0 n)
+  | ([], _, _) ->
+      printf "TIMEOUT\n%!"
+
+let writer s msg =
+  ignore (Unix.send_substring s msg 0 (String.length msg) [])
+
+let _ =
+  let addr = Unix.ADDR_INET(Unix.inet_addr_loopback, 0) in
+  let serv =
+    Unix.socket (Unix.domain_of_sockaddr addr) Unix.SOCK_STREAM 0 in
+  Unix.setsockopt serv Unix.SO_REUSEADDR true;
+  Unix.bind serv addr;
+  let addr = Unix.getsockname serv in
+  Unix.listen serv 5;
+  let tserv = Thread.create server serv in
+  Thread.delay 0.2;
+  let client =
+    Unix.socket (Unix.domain_of_sockaddr addr) Unix.SOCK_STREAM 0 in
+  Unix.connect client addr;
+  (* Send before select & read *)
+  writer client "1111";
+  let a = Thread.create reader client in
+  Thread.delay 0.1;
+  Thread.join a;
+  (* Select then send *)
+  let a = Thread.create reader client in
+  Thread.delay 0.1;
+  writer client "2222";
+  Thread.join a;
+  (* Select then send again *)
+  let a = Thread.create reader client in
+  Thread.delay 0.1;
+  writer client "3333";
+  Thread.join a;
+  (* Cleanup before exiting *)
+  Thread.join tserv
diff --git a/testsuite/tests/lib-threads/pr4466.reference b/testsuite/tests/lib-threads/pr4466.reference
new file mode 100644
index 00000000..ecfdf536
--- /dev/null
+++ b/testsuite/tests/lib-threads/pr4466.reference
@@ -0,0 +1,6 @@
+Selected
+Data read: >>1111
+Selected
+Data read: >>2222
+Selected
+Data read: >>3333
diff --git a/testsuite/tests/lib-threads/pr5325.ml b/testsuite/tests/lib-threads/pr5325.ml
new file mode 100644
index 00000000..9f27f038
--- /dev/null
+++ b/testsuite/tests/lib-threads/pr5325.ml
@@ -0,0 +1,56 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+open Printf
+
+(* Regression test for PR#5325: simultaneous read and write on socket
+   in Windows. *)
+
+(* Scenario:
+     - thread [server] implements a simple 'echo' server on a socket
+     - thread [reader] reads from a socket connected to the echo server
+       and copies to standard output
+     - main program executes [writer], which writes to the same socket
+       (the one connected to the echo server)
+*)
+
+let server sock =
+  let (s, _) = Unix.accept sock in
+  let buf = Bytes.make 1024 '>' in
+  let n = Unix.read s buf 2 (Bytes.length buf - 2) in
+  ignore (Unix.write s buf 0 (n + 2));
+  Unix.close s
+
+let reader s =
+  let buf = Bytes.make 1024 ' ' in
+  let n = Unix.read s buf 0 (Bytes.length buf) in
+  print_bytes (Bytes.sub buf 0 n); flush stdout
+
+let writer s msg =
+  ignore (Unix.write_substring s msg 0 (String.length msg));
+  Unix.shutdown s Unix.SHUTDOWN_SEND
+
+let _ =
+  let addr = Unix.ADDR_INET(Unix.inet_addr_loopback, 0) in
+  let serv =
+    Unix.socket (Unix.domain_of_sockaddr addr) Unix.SOCK_STREAM 0 in
+  Unix.setsockopt serv Unix.SO_REUSEADDR true;
+  Unix.bind serv addr;
+  let addr = Unix.getsockname serv in
+  Unix.listen serv 5;
+  let tserv = Thread.create server serv in
+  Thread.delay 0.5;
+  let client =
+    Unix.socket (Unix.domain_of_sockaddr addr) Unix.SOCK_STREAM 0 in
+  Unix.connect client addr;
+  let rd = Thread.create reader client in
+  Thread.delay 0.5;
+  writer client "Client data\n";
+  Thread.join rd;
+  Thread.join tserv
diff --git a/testsuite/tests/lib-threads/pr5325.reference b/testsuite/tests/lib-threads/pr5325.reference
new file mode 100644
index 00000000..dd045794
--- /dev/null
+++ b/testsuite/tests/lib-threads/pr5325.reference
@@ -0,0 +1 @@
+>>Client data
diff --git a/testsuite/tests/lib-threads/pr7638.ml b/testsuite/tests/lib-threads/pr7638.ml
new file mode 100644
index 00000000..3bb379f4
--- /dev/null
+++ b/testsuite/tests/lib-threads/pr7638.ml
@@ -0,0 +1,19 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+(* MPR#7638 repro case *)
+
+let crashme v =
+  match Sys.getenv v with
+  | exception Not_found -> print_string "OK\n"
+  | s -> print_string "Surprising but OK\n"
+
+let _ =
+  let th = Thread.create crashme "no such variable" in
+  Thread.join th
diff --git a/testsuite/tests/lib-threads/pr7638.reference b/testsuite/tests/lib-threads/pr7638.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-threads/pr7638.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-threads/prodcons.ml b/testsuite/tests/lib-threads/prodcons.ml
new file mode 100644
index 00000000..4867ed38
--- /dev/null
+++ b/testsuite/tests/lib-threads/prodcons.ml
@@ -0,0 +1,71 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+(* Classic producer-consumer *)
+
+type 'a prodcons =
+  { buffer: 'a array;
+    lock: Mutex.t;
+    mutable readpos: int;
+    mutable writepos: int;
+    notempty: Condition.t;
+    notfull: Condition.t }
+
+let create size init =
+  { buffer = Array.make size init;
+    lock = Mutex.create();
+    readpos = 0;
+    writepos = 0;
+    notempty = Condition.create();
+    notfull = Condition.create() }
+
+let put p data =
+  Mutex.lock p.lock;
+  while (p.writepos + 1) mod Array.length p.buffer = p.readpos do
+    Condition.wait p.notfull p.lock
+  done;
+  p.buffer.(p.writepos) <- data;
+  p.writepos <- (p.writepos + 1) mod Array.length p.buffer;
+  Condition.signal p.notempty;
+  Mutex.unlock p.lock
+
+let get p =
+  Mutex.lock p.lock;
+  while p.writepos = p.readpos do
+    Condition.wait p.notempty p.lock
+  done;
+  let data = p.buffer.(p.readpos) in
+  p.readpos <- (p.readpos + 1) mod Array.length p.buffer;
+  Condition.signal p.notfull;
+  Mutex.unlock p.lock;
+  data
+
+(* Test *)
+
+let rec produce buff n max =
+  put buff n;
+  if n < max then produce buff (n+1) max
+
+let rec consume buff cur max =
+  let n = get buff in
+  if n <> cur then false
+  else if n = max then true
+  else consume buff (cur + 1) max
+
+let _ =
+  let buff1 = create 20 0 and buff2 = create 30 0 in
+  let ok1 = ref false and ok2 = ref false in
+  let _p1 = Thread.create (fun () -> produce buff1 0 10000) ()
+  and _p2 = Thread.create (fun () -> produce buff2 0 8000) ()
+  and c1 = Thread.create (fun () -> ok1 := consume buff1 0 10000) () in
+  ok2 := consume buff2 0 8000;
+  Thread.join c1;
+  if !ok1 && !ok2
+  then print_string "passed\n"
+  else print_string "FAILED\n"
diff --git a/testsuite/tests/lib-threads/prodcons.reference b/testsuite/tests/lib-threads/prodcons.reference
new file mode 100644
index 00000000..b0aad4de
--- /dev/null
+++ b/testsuite/tests/lib-threads/prodcons.reference
@@ -0,0 +1 @@
+passed
diff --git a/testsuite/tests/lib-threads/prodcons2.ml b/testsuite/tests/lib-threads/prodcons2.ml
new file mode 100644
index 00000000..308fcd51
--- /dev/null
+++ b/testsuite/tests/lib-threads/prodcons2.ml
@@ -0,0 +1,42 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+(* Producer-consumer with events and multiple producers *)
+
+open Event
+
+let rec produce chan n max =
+  sync (send chan n);
+  if n < max then produce chan (n + 1) max else sync (send chan (-1))
+
+let rec consume chans sum =
+  let rec mkreceive prev = function
+    | [] -> []
+    | chan :: rem as chans ->
+        wrap (receive chan) (fun n ->
+          if n < 0
+          then consume (List.rev_append rem prev) sum
+          else consume (List.rev_append chans prev) (sum + n))
+        :: mkreceive (chan :: prev) rem
+  in
+    if chans = [] then sum else select (mkreceive [] chans)
+
+let sum_0_n n = n * (n + 1) / 2
+
+let _ =
+  let chan1 = new_channel()
+  and chan2 = new_channel()
+  and chan3 = new_channel() in
+  ignore (Thread.create (fun () -> produce chan1 0 5000) ());
+  ignore (Thread.create (fun () -> produce chan2 0 2000) ());
+  ignore (Thread.create (fun () -> produce chan3 0 1000) ());
+  let n = consume [chan1; chan2; chan3] 0 in
+  if n = sum_0_n 5000 + sum_0_n 2000 + sum_0_n 1000
+  then print_string "passed\n"
+  else print_string "FAILED\n"
diff --git a/testsuite/tests/lib-threads/prodcons2.reference b/testsuite/tests/lib-threads/prodcons2.reference
new file mode 100644
index 00000000..b0aad4de
--- /dev/null
+++ b/testsuite/tests/lib-threads/prodcons2.reference
@@ -0,0 +1 @@
+passed
diff --git a/testsuite/tests/lib-threads/sieve.ml b/testsuite/tests/lib-threads/sieve.ml
new file mode 100644
index 00000000..71d7f62e
--- /dev/null
+++ b/testsuite/tests/lib-threads/sieve.ml
@@ -0,0 +1,37 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+let sieve primes =
+  Event.sync (Event.send primes 2);
+  let integers = Event.new_channel () in
+  let rec enumerate n =
+    Event.sync (Event.send integers n);
+    enumerate (n + 2)
+  and filter input =
+    let n = Event.sync (Event.receive input)
+    and output = Event.new_channel () in
+    Event.sync (Event.send primes n);
+    ignore(Thread.create filter output);
+    (* We remove from the output the multiples of n *)
+    while true do
+        let m = Event.sync (Event.receive input) in
+        (* print_int n; print_string ": "; print_int m; print_newline(); *)
+        if m mod n <> 0 then Event.sync (Event.send output m)
+      done in
+  ignore(Thread.create filter integers);
+  ignore(Thread.create enumerate 3)
+
+let primes = Event.new_channel ()
+
+let _ =
+  ignore(Thread.create sieve primes);
+  for i = 1 to 50 do
+    let n = Event.sync (Event.receive primes) in
+    print_int n; print_newline()
+  done
diff --git a/testsuite/tests/lib-threads/sieve.reference b/testsuite/tests/lib-threads/sieve.reference
new file mode 100644
index 00000000..ad2c8fd7
--- /dev/null
+++ b/testsuite/tests/lib-threads/sieve.reference
@@ -0,0 +1,50 @@
+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
diff --git a/testsuite/tests/lib-threads/sigint.c b/testsuite/tests/lib-threads/sigint.c
new file mode 100644
index 00000000..aa6df5e6
--- /dev/null
+++ b/testsuite/tests/lib-threads/sigint.c
@@ -0,0 +1,55 @@
+#include <stdio.h>
+
+#ifdef _WIN32
+  #include <windows.h>
+#else
+  #include <stdlib.h>
+  #include <sys/types.h>
+  #include <signal.h>
+#endif
+
+int main(int argc, char** argv)
+{
+#ifdef _WIN32
+  DWORD pid;
+  HANDLE hProcess;
+#else
+  pid_t pid;
+#endif
+
+  if (argc != 2) {
+    printf("Usage: %s pid\n", argv[0]);
+    return 1;
+  }
+
+  pid = atoi(argv[1]);
+#ifdef _WIN32
+  hProcess = OpenProcess(SYNCHRONIZE, FALSE, pid);
+
+  if (!hProcess) {
+    printf("Process %lu not found!\n", pid);
+    return 1;
+  }
+
+  FreeConsole();
+
+  if (!AttachConsole(pid)) {
+    printf("Failed to attach to console of Process %lu\n", pid);
+    CloseHandle(hProcess);
+    return 1;
+  }
+
+  SetConsoleCtrlHandler(NULL, TRUE);
+  GenerateConsoleCtrlEvent(0, 0);
+  WaitForSingleObject(hProcess, INFINITE);
+  CloseHandle(hProcess);
+  FreeConsole();
+#else
+  if (kill(pid,SIGINT)) {
+    perror("kill");
+    return 1;
+  }
+#endif
+
+  return 0;
+}
diff --git a/testsuite/tests/lib-threads/signal.check-program-output b/testsuite/tests/lib-threads/signal.check-program-output
new file mode 100644
index 00000000..48c0d0e3
--- /dev/null
+++ b/testsuite/tests/lib-threads/signal.check-program-output
@@ -0,0 +1,6 @@
+if sed -e 1q ${output} | grep -q '^[ab]*Got ctrl-C, exiting$';
+then
+  exit ${TEST_PASS}
+else
+  exit ${TEST_FAIL};
+fi
diff --git a/testsuite/tests/lib-threads/signal.ml b/testsuite/tests/lib-threads/signal.ml
new file mode 100644
index 00000000..868427c5
--- /dev/null
+++ b/testsuite/tests/lib-threads/signal.ml
@@ -0,0 +1,72 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+
+files = "sigint.c"
+
+** libunix (* excludes mingw32/64 and msvc32/64 *)
+
+*** setup-ocamlc.byte-build-env
+
+program = "${test_build_directory}/signal.byte"
+
+**** ocamlc.byte
+
+program = "sigint"
+all_modules = "sigint.c"
+
+***** ocamlc.byte
+
+program = "${test_build_directory}/signal.byte"
+all_modules = "signal.ml"
+
+****** check-ocamlc.byte-output
+******* run
+******** check-program-output
+
+*** setup-ocamlopt.byte-build-env
+
+program = "${test_build_directory}/signal.opt"
+
+**** ocamlopt.byte
+
+program = "sigint"
+all_modules = "sigint.c"
+
+***** ocamlopt.byte
+
+program = "${test_build_directory}/signal.opt"
+all_modules = "signal.ml"
+
+****** check-ocamlopt.byte-output
+******* run
+******** check-program-output
+
+*)
+
+let signaled = ref false
+
+let counter = ref 0
+
+let sighandler _ =
+  signaled := true
+
+let print_message delay c =
+  while (not !signaled) && (!counter <= 20) do
+    incr counter;
+    print_char c; flush stdout; Thread.delay delay
+  done
+
+let _ =
+  ignore (Sys.signal Sys.sigint (Sys.Signal_handle sighandler));
+  let th1 = Thread.create (print_message 0.6666666666) 'a' in
+  print_message 1.0 'b';
+  Thread.join th1;
+  if !signaled then begin
+    print_string "Got ctrl-C, exiting"; print_newline();
+    exit 0
+  end else begin
+    print_string "not signaled???"; print_newline();
+    exit 2
+  end
diff --git a/testsuite/tests/lib-threads/signal.run b/testsuite/tests/lib-threads/signal.run
new file mode 100644
index 00000000..1611435d
--- /dev/null
+++ b/testsuite/tests/lib-threads/signal.run
@@ -0,0 +1,5 @@
+${program} > ${output} &
+pid=$!
+sleep 2
+./sigint $pid
+wait
diff --git a/testsuite/tests/lib-threads/sockets.ml b/testsuite/tests/lib-threads/sockets.ml
new file mode 100644
index 00000000..c7299c42
--- /dev/null
+++ b/testsuite/tests/lib-threads/sockets.ml
@@ -0,0 +1,49 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+
+** libunix (* Broken on Windows (missing join?), needs to be fixed *)
+*** bytecode
+*** native
+
+*)
+
+open Printf
+
+(* Threads and sockets *)
+
+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
+
+let server sock =
+  while true do
+    let (s, _) = Unix.accept sock in
+    ignore(Thread.create serve_connection s)
+  done
+
+let client (addr, msg) =
+  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));
+  let n = Unix.read sock buf 0 (Bytes.length buf) in
+  print_bytes (Bytes.sub buf 0 n); flush stdout
+
+let _ =
+  let addr = Unix.ADDR_INET(Unix.inet_addr_loopback, 0) in
+  let sock =
+    Unix.socket (Unix.domain_of_sockaddr addr) Unix.SOCK_STREAM 0 in
+  Unix.setsockopt sock Unix.SO_REUSEADDR true;
+  Unix.bind sock addr;
+  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")
diff --git a/testsuite/tests/lib-threads/sockets.reference b/testsuite/tests/lib-threads/sockets.reference
new file mode 100644
index 00000000..a3f7067d
--- /dev/null
+++ b/testsuite/tests/lib-threads/sockets.reference
@@ -0,0 +1,2 @@
+>>Client #1
+>>Client #2
diff --git a/testsuite/tests/lib-threads/swapchan.ml b/testsuite/tests/lib-threads/swapchan.ml
new file mode 100644
index 00000000..3536b82e
--- /dev/null
+++ b/testsuite/tests/lib-threads/swapchan.ml
@@ -0,0 +1,35 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+open Event
+
+type 'a swap_chan = ('a * 'a channel) channel
+
+let swap msg_out ch =
+  guard (fun () ->
+    let ic = new_channel() in
+    choose [
+      wrap (receive ch) (fun (msg_in, oc) -> sync (send oc msg_out); msg_in);
+      wrap (send ch (msg_out, ic)) (fun () -> sync (receive ic))
+    ])
+
+let ch = new_channel()
+
+let f () =
+  let res = sync (swap "F" ch) in
+  print_string "f "; print_string res; print_newline()
+
+let g () =
+  let res = sync (swap "G" ch) in
+  print_string "g "; print_string res; print_newline()
+
+let _ =
+  let id = Thread.create f () in
+  g ();
+  Thread.join id
diff --git a/testsuite/tests/lib-threads/swapchan.reference b/testsuite/tests/lib-threads/swapchan.reference
new file mode 100644
index 00000000..58dc8b58
--- /dev/null
+++ b/testsuite/tests/lib-threads/swapchan.reference
@@ -0,0 +1,2 @@
+f G
+g F
diff --git a/testsuite/tests/lib-threads/swapchan.run b/testsuite/tests/lib-threads/swapchan.run
new file mode 100644
index 00000000..1e3ecbb3
--- /dev/null
+++ b/testsuite/tests/lib-threads/swapchan.run
@@ -0,0 +1 @@
+${program} | ${SORT} > ${output} 2>&1
diff --git a/testsuite/tests/lib-threads/tls.ml b/testsuite/tests/lib-threads/tls.ml
new file mode 100644
index 00000000..2741f7ef
--- /dev/null
+++ b/testsuite/tests/lib-threads/tls.ml
@@ -0,0 +1,35 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+let private_data = (Hashtbl.create 17 : (Thread.t, string) Hashtbl.t)
+let private_data_lock = Mutex.create()
+let output_lock = Mutex.create()
+
+let set_private_data data =
+  Mutex.lock private_data_lock;
+  Hashtbl.add private_data (Thread.self()) data;
+  Mutex.unlock private_data_lock
+
+let get_private_data () =
+  Hashtbl.find private_data (Thread.self())
+
+let process id data =
+  set_private_data data;
+  Mutex.lock output_lock;
+  print_int id; print_string " --> "; print_string(get_private_data());
+  print_newline();
+  Mutex.unlock output_lock
+
+let _ =
+  let t1 = Thread.create (process 1) "un" in
+  let t2 = Thread.create (process 2) "deux" in
+  let t3 = Thread.create (process 3) "trois" in
+  let t4 = Thread.create (process 4) "quatre" in
+  let t5 = Thread.create (process 5) "cinq" in
+  List.iter Thread.join [t1;t2;t3;t4;t5]
diff --git a/testsuite/tests/lib-threads/tls.reference b/testsuite/tests/lib-threads/tls.reference
new file mode 100644
index 00000000..5ff9295d
--- /dev/null
+++ b/testsuite/tests/lib-threads/tls.reference
@@ -0,0 +1,5 @@
+1 --> un
+2 --> deux
+3 --> trois
+4 --> quatre
+5 --> cinq
diff --git a/testsuite/tests/lib-threads/tls.run b/testsuite/tests/lib-threads/tls.run
new file mode 100644
index 00000000..4b586e8f
--- /dev/null
+++ b/testsuite/tests/lib-threads/tls.run
@@ -0,0 +1 @@
+${program} | LC_ALL=C ${SORT} > ${output} 2>&1
diff --git a/testsuite/tests/lib-threads/torture.ml b/testsuite/tests/lib-threads/torture.ml
new file mode 100644
index 00000000..7131b9ca
--- /dev/null
+++ b/testsuite/tests/lib-threads/torture.ml
@@ -0,0 +1,54 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+(* Torture test - I/O interspersed with lots of GC *)
+
+let finished = ref false
+
+let gc_thread () =
+  while not !finished do
+(*    print_string "gc"; print_newline(); *)
+    Gc.minor();
+    Thread.yield()
+  done
+
+let writer_thread (oc, size) =
+  while not !finished do
+(*    print_string "writer "; print_int size; print_newline(); *)
+    let buff = Bytes.make size 'a' in
+    ignore(Unix.write oc buff 0 size)
+  done;
+  let buff = Bytes.make size 'b' in
+  ignore (Unix.write oc buff 0 size)
+
+let reader_thread (ic, size) =
+  while true do
+(*    print_string "reader "; print_int size; print_newline(); *)
+    let buff = Bytes.make size ' ' in
+    let n = Unix.read ic buff 0 size in
+(*    print_string "reader "; print_int n; print_newline(); *)
+    for i = 0 to n-1 do
+      if Bytes.get buff i = 'b' then Thread.exit()
+      else if Bytes.get buff i <> 'a' then
+        print_string "error in reader_thread\n"
+    done
+  done
+
+let _ =
+  let t1 = Thread.create gc_thread () in
+  let (out1, in1) = Unix.pipe() in
+  let t2 = Thread.create writer_thread (in1, 4096) in
+  let t3 = Thread.create reader_thread (out1, 4096) in
+  let (out2, in2) = Unix.pipe() in
+  let t4 = Thread.create writer_thread (in2, 16) in
+  let t5 = Thread.create reader_thread (out2, 16) in
+  Thread.delay 3.0;
+  finished := true;
+  List.iter Thread.join [t1; t2; t3; t4; t5];
+  print_string "passed\n"
diff --git a/testsuite/tests/lib-threads/torture.reference b/testsuite/tests/lib-threads/torture.reference
new file mode 100644
index 00000000..b0aad4de
--- /dev/null
+++ b/testsuite/tests/lib-threads/torture.reference
@@ -0,0 +1 @@
+passed
diff --git a/testsuite/tests/lib-uchar/test.ml b/testsuite/tests/lib-uchar/test.ml
new file mode 100644
index 00000000..872a506b
--- /dev/null
+++ b/testsuite/tests/lib-uchar/test.ml
@@ -0,0 +1,89 @@
+(* TEST
+*)
+
+let assert_raise_invalid_argument f v =
+  assert (try ignore (f v); false with Invalid_argument _ -> true)
+
+let test_constants () =
+  assert (Uchar.(to_int min) = 0x0000);
+  assert (Uchar.(to_int max) = 0x10FFFF);
+  assert (Uchar.(to_int bom) = 0xFEFF);
+  assert (Uchar.(to_int rep) = 0xFFFD);
+  ()
+
+let test_succ () =
+  assert (Uchar.(to_int (succ min)) = 0x0001);
+  assert (Uchar.(to_int (succ (of_int 0xD7FF))) = 0xE000);
+  assert (Uchar.(to_int (succ (of_int 0xE000))) = 0xE001);
+  assert_raise_invalid_argument Uchar.succ Uchar.max;
+  ()
+
+let test_pred () =
+  assert_raise_invalid_argument Uchar.pred Uchar.min;
+  assert (Uchar.(to_int (pred (of_int 0xD7FF))) = 0xD7FE);
+  assert (Uchar.(to_int (pred (of_int 0xE000))) = 0xD7FF);
+  assert (Uchar.(to_int (pred max)) = 0x10FFFE);
+  ()
+
+let test_is_valid () =
+  assert (not (Uchar.is_valid (-1)));
+  assert (Uchar.is_valid 0x0000);
+  assert (Uchar.is_valid 0xD7FF);
+  assert (not (Uchar.is_valid 0xD800));
+  assert (not (Uchar.is_valid 0xDFFF));
+  assert (Uchar.is_valid 0xE000);
+  assert (Uchar.is_valid 0x10FFFF);
+  assert (not (Uchar.is_valid 0x110000));
+  assert (not (Uchar.is_valid min_int));
+  assert (not (Uchar.is_valid max_int));
+  ()
+
+let char_max = Uchar.of_int 0x00FF
+
+let test_is_char () =
+  assert (Uchar.(is_char Uchar.min));
+  assert (Uchar.(is_char char_max));
+  assert (Uchar.(not (is_char (of_int 0x0100))));
+  assert (not (Uchar.is_char Uchar.max));
+  ()
+
+let test_of_char () =
+  assert (Uchar.(equal (of_char '\xFF') char_max));
+  assert (Uchar.(equal (of_char '\x00') min));
+  ()
+
+let test_to_char () =
+  assert (Uchar.(to_char min) = '\x00');
+  assert (Uchar.(to_char char_max) = '\xFF');
+  assert_raise_invalid_argument Uchar.to_char (Uchar.succ char_max);
+  assert_raise_invalid_argument Uchar.to_char Uchar.max;
+  ()
+
+let test_equal () =
+  assert (Uchar.(equal min min));
+  assert (Uchar.(equal max max));
+  assert (not Uchar.(equal min max));
+  ()
+
+let test_compare () =
+  assert (Uchar.(compare min min) = 0);
+  assert (Uchar.(compare max max) = 0);
+  assert (Uchar.(compare min max) = (-1));
+  assert (Uchar.(compare max min) = 1);
+  ()
+
+let tests () =
+  test_constants ();
+  test_succ ();
+  test_pred ();
+  test_is_valid ();
+  test_is_char ();
+  test_of_char ();
+  test_to_char ();
+  test_equal ();
+  test_compare ();
+  ()
+
+let () =
+  tests ();
+  print_endline "OK"
diff --git a/testsuite/tests/lib-uchar/test.reference b/testsuite/tests/lib-uchar/test.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-uchar/test.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-unix/common/channel_of.ml b/testsuite/tests/lib-unix/common/channel_of.ml
new file mode 100644
index 00000000..f61dd949
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/channel_of.ml
@@ -0,0 +1,66 @@
+(* TEST
+* hasunix
+include unix
+** bytecode
+** native
+*)
+
+open Printf
+
+let shouldpass msg fn arg =
+  try
+    ignore (fn arg); printf "%s: passed (no error)\n" msg
+  with Unix.Unix_error(err, _, _) ->
+    printf "%s: FAILED (error %s)\n" msg (Unix.error_message err)
+
+let shouldfail msg fn arg =
+  try
+    ignore (fn arg); printf "%s: FAILED (no error raised)\n" msg
+  with Unix.Unix_error(err, _, _) ->
+    printf "%s: passed (error raised)\n" msg
+
+let _ =
+  (* Files *)
+  begin
+    let fd = Unix.(openfile "file.tmp" [O_WRONLY;O_CREAT;O_TRUNC] 0o666) in
+    shouldpass "File 1" Unix.in_channel_of_descr fd;
+    shouldpass "File 2" Unix.out_channel_of_descr fd;
+    Unix.close fd
+  end;
+  (* Pipes *)
+  begin
+    let out, inp = Unix.pipe () in
+    shouldpass "Pipe 1" Unix.in_channel_of_descr out;
+    shouldpass "Pipe 2" Unix.out_channel_of_descr inp;
+    Unix.close out; Unix.close inp
+  end;
+  (* Sockets *)
+  let addr = Unix.ADDR_INET(Unix.inet_addr_loopback, 0) in
+  begin
+    let sock =
+      Unix.socket (Unix.domain_of_sockaddr addr) Unix.SOCK_STREAM 0 in
+    shouldpass "Stream socket 1" Unix.in_channel_of_descr sock;
+    shouldpass "Stream socket 2" Unix.out_channel_of_descr sock;
+    Unix.close sock
+  end;
+  begin
+    let sock =
+      Unix.socket (Unix.domain_of_sockaddr addr) Unix.SOCK_DGRAM 0 in
+    shouldfail "Stream socket 1" Unix.in_channel_of_descr sock;
+   shouldfail "Stream socket 2" Unix.out_channel_of_descr sock;
+    Unix.close sock
+  end;
+  (* Whatever is connected to standard descriptors; hopefully a terminal *)
+  begin
+    shouldpass "stdin" Unix.in_channel_of_descr Unix.stdin;
+    shouldpass "stderr" Unix.out_channel_of_descr Unix.stderr
+  end;
+  (* A closed file descriptor should now fail *)
+  begin
+    let fd = Unix.(openfile "file.tmp" [O_WRONLY;O_CREAT;O_TRUNC] 0o666) in
+    Unix.close fd;
+    shouldfail "Closed file 1" Unix.in_channel_of_descr fd;
+    shouldfail "Closed file 2" Unix.out_channel_of_descr fd
+  end;
+  (* End of test *)
+  Sys.remove "file.tmp"
diff --git a/testsuite/tests/lib-unix/common/channel_of.reference b/testsuite/tests/lib-unix/common/channel_of.reference
new file mode 100644
index 00000000..c9cf71da
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/channel_of.reference
@@ -0,0 +1,12 @@
+File 1: passed (no error)
+File 2: passed (no error)
+Pipe 1: passed (no error)
+Pipe 2: passed (no error)
+Stream socket 1: passed (no error)
+Stream socket 2: passed (no error)
+Stream socket 1: passed (error raised)
+Stream socket 2: passed (error raised)
+stdin: passed (no error)
+stderr: passed (no error)
+Closed file 1: passed (error raised)
+Closed file 2: passed (error raised)
diff --git a/testsuite/tests/lib-unix/common/cloexec.ml b/testsuite/tests/lib-unix/common/cloexec.ml
new file mode 100644
index 00000000..a62eda6f
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/cloexec.ml
@@ -0,0 +1,113 @@
+(* TEST
+
+(*
+  This test is temporarily disabled on the MinGW and MSVC ports,
+  because since fdstatus has been wrapped in an OCaml program,
+  it does not work as well as before.
+  Presumably this is because the OCaml runtime opens files, so that handles
+  that have actually been closed at execution look open and make the
+  test fail.
+
+  One possible fix for this would be to make it possible for ocamltest to
+  compile C-only programs, which will be a bit of work to handle the
+  output of msvc and will also duplicate what the OCaml compiler itself
+  already does.
+*)
+
+* hasunix
+include unix
+files = "fdstatus_aux.c fdstatus_main.ml"
+
+** libunix
+*** setup-ocamlc.byte-build-env
+program = "${test_build_directory}/cloexec.byte"
+**** ocamlc.byte
+program = "${test_build_directory}/fdstatus.exe"
+all_modules = "fdstatus_aux.c fdstatus_main.ml"
+***** ocamlc.byte
+program = "${test_build_directory}/cloexec.byte"
+all_modules= "cloexec.ml"
+****** check-ocamlc.byte-output
+******* run
+******** check-program-output
+
+*** setup-ocamlopt.byte-build-env
+program = "${test_build_directory}/cloexec.opt"
+**** ocamlopt.byte
+program = "${test_build_directory}/fdstatus.exe"
+all_modules = "fdstatus_aux.c fdstatus_main.ml"
+***** ocamlopt.byte
+program = "${test_build_directory}/cloexec.opt"
+all_modules= "cloexec.ml"
+****** check-ocamlopt.byte-output
+******* run
+******** check-program-output
+
+*)
+
+(* This is a terrible hack that plays on the internal representation
+   of file descriptors.  The result is a number (as a string)
+   that the fdstatus.exe auxiliary program can use to check whether
+   the fd is open. Moreover, since fdstatus.exe is an OCaml program,
+   we must take into account that the Windows OCaml runtime opens a few handles
+   for its own use, hence we do likewise to try to get handle numbers
+   Windows will not allocate to the OCaml runtime of fdstatus.exe *)
+
+let string_of_fd (fd: Unix.file_descr) : string =
+  match Sys.os_type with
+  | "Unix" | "Cygwin" ->  Int.to_string (Obj.magic fd : int)
+  | "Win32" ->
+      if Sys.word_size = 32 then
+        Int32.to_string (Obj.magic fd : int32)
+      else
+        Int64.to_string (Obj.magic fd : int64)
+  | _ -> assert false
+
+let status_checker = "fdstatus.exe"
+
+let _ =
+  let f0 = Unix.(openfile "tmp.txt" [O_WRONLY; O_CREAT; O_TRUNC] 0o600) in
+  let untested1 = Unix.(openfile "tmp.txt" [O_RDONLY; O_CLOEXEC] 0) in
+  let untested2 = Unix.(openfile "tmp.txt" [O_RDONLY; O_CLOEXEC] 0) in
+  let untested3 = Unix.(openfile "tmp.txt" [O_RDONLY; O_CLOEXEC] 0) in
+  let untested4 = Unix.(openfile "tmp.txt" [O_RDONLY; O_CLOEXEC] 0) in
+  let untested5 = Unix.(openfile "tmp.txt" [O_RDONLY; O_CLOEXEC] 0) in
+  let f1 = Unix.(openfile "tmp.txt" [O_RDONLY; O_KEEPEXEC] 0) in
+  let f2 = Unix.(openfile "tmp.txt" [O_RDONLY; O_CLOEXEC] 0) in
+  let d0 = Unix.dup f0 in
+  let d1 = Unix.dup ~cloexec:false f1 in
+  let d2 = Unix.dup ~cloexec:true f2 in
+  let (p0, p0') = Unix.pipe () in
+  let (p1, p1') = Unix.pipe ~cloexec:false () in
+  let (p2, p2') = Unix.pipe ~cloexec:true () in
+  let s0 = Unix.(socket PF_INET SOCK_STREAM 0) in
+  let s1 = Unix.(socket ~cloexec:false PF_INET SOCK_STREAM 0) in
+  let s2 = Unix.(socket ~cloexec:true PF_INET SOCK_STREAM 0) in
+  let (x0, x0') =
+    try Unix.(socketpair PF_UNIX SOCK_STREAM 0)
+    with Invalid_argument _ -> (p0, p0') in
+    (* socketpair not available under Win32; keep the same output *)
+  let (x1, x1') =
+    try Unix.(socketpair ~cloexec:false PF_UNIX SOCK_STREAM 0)
+    with Invalid_argument _ -> (p1, p1') in
+  let (x2, x2') =
+    try Unix.(socketpair ~cloexec:true PF_UNIX SOCK_STREAM 0)
+    with Invalid_argument _ -> (p2, p2') in
+
+  let fds = [| f0;f1;f2; d0;d1;d2;
+               p0;p0';p1;p1';p2;p2';
+               s0;s1;s2;
+               x0;x0';x1;x1';x2;x2' |] in
+  let untested =
+    [untested1; untested2; untested3; untested4; untested5]
+  in
+  let pid =
+    Unix.create_process
+      (Filename.concat Filename.current_dir_name status_checker)
+      (Array.append [| status_checker |] (Array.map string_of_fd fds))
+      Unix.stdin Unix.stdout Unix.stderr in
+  ignore (Unix.waitpid [] pid);
+  let close fd = try Unix.close fd with Unix.Unix_error _ -> () in
+  Array.iter close fds;
+  List.iter close untested;
+  Sys.remove "tmp.txt"
diff --git a/testsuite/tests/lib-unix/common/cloexec.reference b/testsuite/tests/lib-unix/common/cloexec.reference
new file mode 100644
index 00000000..c6270172
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/cloexec.reference
@@ -0,0 +1,21 @@
+#1: open
+#2: open
+#3: closed
+#4: open
+#5: open
+#6: closed
+#7: open
+#8: open
+#9: open
+#10: open
+#11: closed
+#12: closed
+#13: open
+#14: open
+#15: closed
+#16: open
+#17: open
+#18: open
+#19: open
+#20: closed
+#21: closed
diff --git a/testsuite/tests/lib-unix/common/cmdline_prog.ml b/testsuite/tests/lib-unix/common/cmdline_prog.ml
new file mode 100644
index 00000000..69239cb3
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/cmdline_prog.ml
@@ -0,0 +1,4 @@
+let () =
+  for i = 1 to (Array.length Sys.argv) - 1 do
+    Printf.printf "%s\n" Sys.argv.(i)
+  done
diff --git a/testsuite/tests/lib-unix/common/dup.ml b/testsuite/tests/lib-unix/common/dup.ml
new file mode 100644
index 00000000..b689137c
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/dup.ml
@@ -0,0 +1,12 @@
+(* TEST
+* hasunix
+include unix
+** bytecode
+** native
+*)
+
+let _ =
+  let f = Unix.dup ~cloexec:true Unix.stdout in
+  let txt = "Some output\n" in
+  ignore (Unix.write_substring f txt 0 (String.length txt));
+  Unix.close f
diff --git a/testsuite/tests/lib-unix/common/dup.reference b/testsuite/tests/lib-unix/common/dup.reference
new file mode 100644
index 00000000..85cc16f5
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/dup.reference
@@ -0,0 +1 @@
+Some output
diff --git a/testsuite/tests/lib-unix/common/dup2.ml b/testsuite/tests/lib-unix/common/dup2.ml
new file mode 100644
index 00000000..c3a7facc
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/dup2.ml
@@ -0,0 +1,30 @@
+(* TEST
+* hasunix
+include unix
+stderr = "/dev/null"
+** bytecode
+** native
+*)
+
+let cat file =
+  let fd = Unix.openfile file [Unix.O_RDONLY] 0 in
+  let buf = Bytes.create 1024 in
+  let rec cat () =
+    let n = Unix.read fd buf 0 (Bytes.length buf) in
+    if n > 0 then (ignore(Unix.write Unix.stdout buf 0 n); cat ())
+  in cat (); Unix.close fd
+
+let out fd txt =
+  ignore (Unix.write_substring fd txt 0 (String.length txt))
+
+let _ =
+  let fd =
+    Unix.(openfile "./tmp.txt"
+                   [O_WRONLY;O_TRUNC;O_CREAT;O_SHARE_DELETE]
+                   0o600) in
+  out fd "---\n";
+  Unix.dup2 ~cloexec:true fd Unix.stderr;
+  Unix.close fd;
+  out Unix.stderr "Some output\n";
+  cat "./tmp.txt";
+  Sys.remove "./tmp.txt"
diff --git a/testsuite/tests/lib-unix/common/dup2.reference b/testsuite/tests/lib-unix/common/dup2.reference
new file mode 100644
index 00000000..2f5a485d
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/dup2.reference
@@ -0,0 +1,2 @@
+---
+Some output
diff --git a/testsuite/tests/lib-unix/common/fdstatus_aux.c b/testsuite/tests/lib-unix/common/fdstatus_aux.c
new file mode 100644
index 00000000..127bacd2
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/fdstatus_aux.c
@@ -0,0 +1,74 @@
+/* Check if file descriptors are open or not */
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#ifdef _WIN32
+
+#define WIN32_LEAN_AND_MEAN
+#include <wtypes.h>
+#include <winbase.h>
+#include <winerror.h>
+
+void process_fd(const char * s)
+{
+  int fd;
+  HANDLE h;
+  DWORD flags;
+
+#ifdef _WIN64
+  h = (HANDLE) _atoi64(s);
+#else
+  h = (HANDLE) atoi(s);
+#endif
+  if (GetHandleInformation(h, &flags)) {
+    printf("open\n");
+  } else if (GetLastError() == ERROR_INVALID_HANDLE) {
+    printf("closed\n");
+  } else {
+    printf("error %lu\n", (unsigned long)(GetLastError()));
+  }
+}
+
+#else
+
+#include <limits.h>
+#include <string.h>
+#include <errno.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+
+void process_fd(const char * s)
+{
+  long n;
+  int fd;
+  char * endp;
+  struct stat st;
+  n = strtol(s, &endp, 0);
+  if (*endp != 0 || n < 0 || n > (long) INT_MAX) {
+    printf("parsing error\n");
+    return;
+  }
+  fd = (int) n;
+  if (fstat(fd, &st) != -1) {
+    printf("open\n");
+  } else if (errno == EBADF) {
+    printf("closed\n");
+  } else {
+    printf("error %s\n", strerror(errno));
+  }
+}
+
+#endif
+
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+
+CAMLprim value caml_process_fd(value CAMLnum, value CAMLfd)
+{
+  CAMLparam2(CAMLnum, CAMLfd);
+  printf("#%d: ", Int_val(CAMLnum));
+  process_fd(String_val(CAMLfd));
+  CAMLreturn(Val_unit);
+}
diff --git a/testsuite/tests/lib-unix/common/fdstatus_main.ml b/testsuite/tests/lib-unix/common/fdstatus_main.ml
new file mode 100644
index 00000000..93f3922b
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/fdstatus_main.ml
@@ -0,0 +1,7 @@
+external process_fd : int -> string -> unit = "caml_process_fd"
+
+let () =
+  for i = 1 to (Array.length Sys.argv) -1
+  do
+    process_fd i Sys.argv.(i);
+  done
diff --git a/testsuite/tests/lib-unix/common/getaddrinfo.ml b/testsuite/tests/lib-unix/common/getaddrinfo.ml
new file mode 100644
index 00000000..b140ef91
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/getaddrinfo.ml
@@ -0,0 +1,16 @@
+(* TEST
+* hasunix
+include unix
+** bytecode
+** native
+*)
+
+let () =
+  let x = Unix.getaddrinfo "\000" "" [] in
+  Gc.full_major ();
+  assert (x = []);;
+
+let () =
+  let x = Unix.getaddrinfo "" "\000" [] in
+  Gc.full_major ();
+  assert (x = []);;
diff --git a/testsuite/tests/lib-unix/common/pipe_eof.ml b/testsuite/tests/lib-unix/common/pipe_eof.ml
new file mode 100644
index 00000000..3bd6ae5f
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/pipe_eof.ml
@@ -0,0 +1,41 @@
+(* TEST
+* hasunix
+include unix
+** bytecode
+** native
+*)
+
+let drain pipe =
+  let max = 2048 in
+  let buf = Buffer.create 2048 in
+  let tmp = Bytes.create max in
+  while begin
+    try
+      let len = Unix.read pipe tmp 0 max in
+      Buffer.add_subbytes buf tmp 0 len;
+      len > 0
+    with Unix.Unix_error (Unix.EPIPE, _, _) when false ->
+      false
+  end do () done;
+  Buffer.contents buf
+;;
+
+let run exe args =
+  let out_in, out_out = Unix.pipe () in
+  let err_in, err_out = Unix.pipe () in
+  let args = Array.append [| exe |] args in
+  let pid = Unix.create_process exe args Unix.stdin out_out err_out in
+  Unix.close out_out;
+  Unix.close err_out;
+  let output = drain out_in in
+  let error = drain err_in in
+  Unix.close out_in;
+  Unix.close err_in;
+  let _pid, status = Unix.waitpid [ ] pid in
+  status, output, error
+;;
+
+let _ =
+  ignore (run "cp" [||]);
+  print_endline "success"
+;;
diff --git a/testsuite/tests/lib-unix/common/pipe_eof.reference b/testsuite/tests/lib-unix/common/pipe_eof.reference
new file mode 100644
index 00000000..2e9ba477
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/pipe_eof.reference
@@ -0,0 +1 @@
+success
diff --git a/testsuite/tests/lib-unix/common/process_pid.ml b/testsuite/tests/lib-unix/common/process_pid.ml
new file mode 100644
index 00000000..8d8852f6
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/process_pid.ml
@@ -0,0 +1,18 @@
+(* TEST
+* hasunix
+include unix
+** bytecode
+** native
+*)
+
+let () =
+  let ic, _ as process =
+    (* Redirect to null to avoid
+       "The process tried to write to a nonexistent pipe." on Windows *)
+    Printf.ksprintf Unix.open_process "echo toto > %s" Filename.null
+  in
+  assert
+    (Unix.process_pid process = Unix.process_pid process);
+
+  ignore (Unix.close_process process);
+  print_endline "OK"
diff --git a/testsuite/tests/lib-unix/common/process_pid.reference b/testsuite/tests/lib-unix/common/process_pid.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/process_pid.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-unix/common/redirections.ml b/testsuite/tests/lib-unix/common/redirections.ml
new file mode 100644
index 00000000..65fbd60c
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/redirections.ml
@@ -0,0 +1,147 @@
+(* TEST
+
+files = "reflector.ml"
+
+* hasunix
+** setup-ocamlc.byte-build-env
+program = "${test_build_directory}/redirections.byte"
+*** ocamlc.byte
+program = "${test_build_directory}/reflector.exe"
+all_modules = "reflector.ml"
+**** ocamlc.byte
+include unix
+program = "${test_build_directory}/redirections.byte"
+all_modules= "redirections.ml"
+***** check-ocamlc.byte-output
+****** run
+******* check-program-output
+
+** setup-ocamlopt.byte-build-env
+program = "${test_build_directory}/redirections.opt"
+*** ocamlopt.byte
+program = "${test_build_directory}/reflector.exe"
+all_modules = "reflector.ml"
+**** ocamlopt.byte
+include unix
+program = "${test_build_directory}/redirections.opt"
+all_modules= "redirections.ml"
+***** check-ocamlopt.byte-output
+****** run
+******* check-program-output
+
+*)
+
+
+let cat file =
+  let fd = Unix.openfile file [Unix.O_RDONLY] 0 in
+  let buf = Bytes.create 1024 in
+  let rec cat () =
+    let n = Unix.read fd buf 0 (Bytes.length buf) in
+    if n > 0 then (ignore(Unix.write Unix.stdout buf 0 n); cat ())
+  in cat (); Unix.close fd
+
+let out fd txt =
+  ignore (Unix.write_substring fd txt 0 (String.length txt))
+
+let refl =
+  Filename.concat Filename.current_dir_name "reflector.exe"
+
+let test_createprocess systemenv =
+  let f_out =
+    Unix.(openfile "./tmpout.txt" [O_WRONLY;O_TRUNC;O_CREAT;O_CLOEXEC] 0o600) in
+  let f_err =
+    Unix.(openfile "./tmperr.txt" [O_WRONLY;O_TRUNC;O_CREAT;O_CLOEXEC] 0o600) in
+  let (p_exit, p_entrance) =
+    Unix.pipe ~cloexec:true () in
+  let pid =
+    Unix.create_process_env
+       refl
+       [| refl; "-i2o"; "-i2e"; "-o"; "123"; "-e"; "456"; "-i2o"; "-v"; "XVAR"
+       |]
+       (Array.append [| "XVAR=xvar" |] systemenv)
+       p_exit f_out f_err in
+  out p_entrance "aaaa\n";
+  out p_entrance "bbbb\n";
+  Unix.close p_entrance;
+  let (_, status) = Unix.waitpid [] pid in
+  Unix.close p_exit; Unix.close f_out; Unix.close f_err;
+  if status <> Unix.WEXITED 0 then
+    out Unix.stdout "!!! reflector exited with an error\n";
+  out Unix.stdout "---- File tmpout.txt\n";
+  cat "./tmpout.txt";
+  out Unix.stdout "---- File tmperr.txt\n";
+  cat "./tmperr.txt";
+  Sys.remove "./tmpout.txt";
+  Sys.remove "./tmperr.txt"
+
+let test_2ampsup1 () =    (* 2>&1 redirection, cf. GPR#1105 *)
+  let pid =
+    Unix.create_process
+      refl
+      [| refl; "-o"; "123"; "-e"; "456"; "-o"; "789" |]
+      Unix.stdin Unix.stdout Unix.stdout in
+  let (_, status) = Unix.waitpid [] pid in
+  if status <> Unix.WEXITED 0 then
+    out Unix.stdout "!!! reflector exited with an error\n"
+
+let test_swap12 () =    (* swapping stdout and stderr *)
+  (* The test harness doesn't let us check contents of stderr,
+     so just output on stdout (after redirection) *)
+  let pid =
+    Unix.create_process
+      refl
+      [| refl; "-e"; "123" |]
+      Unix.stdin Unix.stderr Unix.stdout in
+  let (_, status) = Unix.waitpid [] pid in
+  if status <> Unix.WEXITED 0 then
+    out Unix.stdout "!!! reflector exited with an error\n"
+
+let test_open_process_in () =
+  let ic = Unix.open_process_in (refl ^ " -o 123 -o 456") in
+  out Unix.stdout (input_line ic ^ "\n");
+  out Unix.stdout (input_line ic ^ "\n");
+  let status = Unix.close_process_in ic in
+  if status <> Unix.WEXITED 0 then
+    out Unix.stdout "!!! reflector exited with an error\n"
+
+let test_open_process_out () =
+  let oc = Unix.open_process_out (refl ^ " -i2o -i2o -i2o") in
+  output_string oc "aa\nbbbb\n"; close_out oc;
+  let status = Unix.close_process_out oc in
+  if status <> Unix.WEXITED 0 then
+    out Unix.stdout "!!! reflector exited with an error\n"
+
+let test_open_process_full systemenv =
+  let ((o, i, e) as res) =
+    Unix.open_process_full
+      (refl ^ " -o 123 -i2o -e 456 -i2e -v XVAR")
+      (Array.append [|"XVAR=xvar"|] systemenv) in
+  output_string i "aa\nbbbb\n"; close_out i;
+  for _i = 1 to 3 do
+    out Unix.stdout (input_line o ^ "\n")
+  done;
+  for _i = 1 to 2 do
+    out Unix.stdout (input_line e ^ "\n")
+  done;
+  let status = Unix.close_process_full res in
+  if status <> Unix.WEXITED 0 then
+    out Unix.stdout "!!! reflector exited with an error\n"
+
+let _ =
+  let env = Unix.environment() in
+  (* The following 'close' makes things more difficult.
+     Under Unix it works fine, but under Win32 create_process
+     gives an error if one of the standard handles is closed. *)
+  (* Unix.close Unix.stdin; *)
+  out Unix.stdout "** create_process\n";
+  test_createprocess env;
+  out Unix.stdout "** create_process 2>&1 redirection\n";
+  test_2ampsup1();
+  out Unix.stdout "** create_process swap 1-2\n";
+  test_swap12();
+  out Unix.stdout "** open_process_in\n";
+  test_open_process_in();
+  out Unix.stdout "** open_process_out\n";
+  test_open_process_out();
+  out Unix.stdout "** open_process_full\n";
+  test_open_process_full env
diff --git a/testsuite/tests/lib-unix/common/redirections.reference b/testsuite/tests/lib-unix/common/redirections.reference
new file mode 100644
index 00000000..c0da174c
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/redirections.reference
@@ -0,0 +1,28 @@
+** create_process
+---- File tmpout.txt
+aaaa
+123
+<end of file>
+xvar
+---- File tmperr.txt
+bbbb
+456
+** create_process 2>&1 redirection
+123
+456
+789
+** create_process swap 1-2
+123
+** open_process_in
+123
+456
+** open_process_out
+aa
+bbbb
+<end of file>
+** open_process_full
+123
+aa
+xvar
+456
+bbbb
diff --git a/testsuite/tests/lib-unix/common/reflector.ml b/testsuite/tests/lib-unix/common/reflector.ml
new file mode 100644
index 00000000..be242c80
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/reflector.ml
@@ -0,0 +1,50 @@
+let copyline input output =
+  let rec copy() = match input_char input with
+    | exception End_of_file ->
+      output_string output "<end of file>\n"
+    | char ->
+      output_char output char;
+      if char='\n' then () else copy()
+  in
+  copy();
+  flush output
+
+let output_endline output str =
+  output_string output str;
+  output_char output '\n';
+  flush output
+
+let output_env_var output env_var =
+  let value = match Sys.getenv_opt env_var with
+    | None -> "<no such variable>"
+    | Some v -> v
+  in
+  output_endline stdout value
+
+let options =
+[
+  ("-i2o",
+    Arg.Unit (fun () -> (copyline stdin stdout)),
+    "copy one line from stdin to stdout");
+  ("-i2e",
+    Arg.Unit (fun () -> (copyline stdin stderr)),
+    "copy one line from stdin to stderr");
+  ("-o",
+    Arg.String (output_endline stdout),
+    "-o <txt> write <txt> plus newline to stdout");
+  ("-e",
+    Arg.String (output_endline stderr),
+    "-e <txt> write <txt> plus newline to stderr");
+  ("-v",
+    Arg.String (output_env_var stdout),
+    "-v <var>   write value of environment variable <env> to stdout");
+]
+
+let report_bad_argument _arg =
+  output_endline stderr "<bad argument>"
+
+let () =
+  set_binary_mode_in stdin true;
+  set_binary_mode_out stdout true;
+  set_binary_mode_out stderr true;
+  Arg.parse options report_bad_argument  ""
diff --git a/testsuite/tests/lib-unix/common/rename.ml b/testsuite/tests/lib-unix/common/rename.ml
new file mode 100644
index 00000000..402ddf0b
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/rename.ml
@@ -0,0 +1,59 @@
+(* TEST
+* hasunix
+include unix
+** bytecode
+** native
+*)
+
+(* Test the Unix.rename function *)
+
+let writefile filename contents =
+  let oc = open_out_bin filename in
+  output_string oc contents;
+  close_out oc
+
+let readfile filename =
+  let ic = open_in_bin filename in
+  let sz = in_channel_length ic in
+  let contents = really_input_string ic sz in
+  close_in ic;
+  contents
+
+let safe_remove filename =
+  try Sys.remove filename with Sys_error _ -> ()
+
+let testrename f1 f2 contents =
+  try
+    Unix.rename f1 f2;
+    if readfile f2 <> contents then print_string "wrong contents!"
+    else if Sys.file_exists f1 then print_string "initial file still exists!"
+    else print_string "passed"
+  with Unix.Unix_error(err, _, _) ->
+    print_string "Unix_error exception: "; print_string (Unix.error_message err)
+
+let testfailure f1 f2 =
+  try
+    Unix.rename f1 f2; print_string "should fail but doesn't!"
+  with Unix.Unix_error _ ->
+    print_string "fails as expected"
+
+let _ =
+  let f1 = "file1.dat" and f2 = "file2.dat" in
+  safe_remove f1; safe_remove f2;
+  print_string "Rename to nonexisting file: ";
+  writefile f1 "abc";
+  testrename f1 f2 "abc";
+  print_newline();
+  print_string "Rename to existing file: ";
+  writefile f1 "def";
+  writefile f2 "xyz";
+  testrename f1 f2 "def";
+  print_newline();
+  print_string "Renaming a nonexisting file: ";
+  testfailure f1 f2;
+  print_newline();
+  print_string "Renaming to a nonexisting directory: ";
+  writefile f1 "abc";
+  testfailure f1 (Filename.concat "nosuchdir" f2);
+  print_newline();
+  safe_remove f1; safe_remove f2
diff --git a/testsuite/tests/lib-unix/common/rename.reference b/testsuite/tests/lib-unix/common/rename.reference
new file mode 100644
index 00000000..d5ec88df
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/rename.reference
@@ -0,0 +1,4 @@
+Rename to nonexisting file: passed
+Rename to existing file: passed
+Renaming a nonexisting file: fails as expected
+Renaming to a nonexisting directory: fails as expected
diff --git a/testsuite/tests/lib-unix/common/test_unix_cmdline.ml b/testsuite/tests/lib-unix/common/test_unix_cmdline.ml
new file mode 100644
index 00000000..a51c118a
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/test_unix_cmdline.ml
@@ -0,0 +1,76 @@
+(* TEST
+
+files = "cmdline_prog.ml"
+
+* hasunix
+** setup-ocamlc.byte-build-env
+program = "${test_build_directory}/test_unix_cmdline.byte"
+*** ocamlc.byte
+program = "${test_build_directory}/cmdline_prog.exe"
+all_modules = "cmdline_prog.ml"
+**** ocamlc.byte
+include unix
+program = "${test_build_directory}/test_unix_cmdline.byte"
+all_modules= "test_unix_cmdline.ml"
+***** check-ocamlc.byte-output
+****** run
+******* check-program-output
+
+** setup-ocamlopt.byte-build-env
+program = "${test_build_directory}/test_unix_cmdline.opt"
+*** ocamlc.byte
+program = "${test_build_directory}/cmdline_prog.exe"
+all_modules = "cmdline_prog.ml"
+**** ocamlopt.byte
+include unix
+program = "${test_build_directory}/test_unix_cmdline.opt"
+all_modules= "test_unix_cmdline.ml"
+***** check-ocamlopt.byte-output
+****** run
+******* check-program-output
+
+*)
+
+open Unix
+
+let prog_name = "cmdline_prog.exe"
+
+let run args =
+  let out, inp = pipe () in
+  let in_chan = in_channel_of_descr out in
+  set_binary_mode_in in_chan false;
+  let pid =
+    create_process ("./" ^ prog_name) (Array.of_list (prog_name :: args))
+      Unix.stdin inp Unix.stderr in
+  List.iter (fun arg ->
+      let s = input_line in_chan in
+      Printf.printf "%S -> %S [%s]\n" arg s (if s = arg then "OK" else "FAIL")
+    ) args;
+  close_in in_chan;
+  let _, exit = waitpid [] pid in
+  assert (exit = WEXITED 0)
+
+let exec args =
+  execv ("./" ^ prog_name) (Array.of_list (prog_name :: args))
+
+let () =
+  List.iter run
+    [
+      [""; ""; "\t \011"];
+      ["a"; "b"; "c.txt@!"];
+      ["\""];
+      [" "; " a "; "  \" \\\" "];
+      [" \\ \\ \\\\\\"];
+      [" \"hola \""];
+      ["a\tb"];
+    ];
+  Printf.printf "-- execv\n%!";
+  exec [
+     "";
+     "a"; "b"; "c.txt@!";
+     "\"";
+     " "; " a "; "  \" \\\" ";
+     " \\ \\ \\\\\\";
+     " \"hola \"";
+     "a\tb"
+  ]
diff --git a/testsuite/tests/lib-unix/common/test_unix_cmdline.reference b/testsuite/tests/lib-unix/common/test_unix_cmdline.reference
new file mode 100644
index 00000000..b494a297
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/test_unix_cmdline.reference
@@ -0,0 +1,25 @@
+"" -> "" [OK]
+"" -> "" [OK]
+"\t \011" -> "\t \011" [OK]
+"a" -> "a" [OK]
+"b" -> "b" [OK]
+"c.txt@!" -> "c.txt@!" [OK]
+"\"" -> "\"" [OK]
+" " -> " " [OK]
+" a " -> " a " [OK]
+"  \" \\\" " -> "  \" \\\" " [OK]
+" \\ \\ \\\\\\" -> " \\ \\ \\\\\\" [OK]
+" \"hola \"" -> " \"hola \"" [OK]
+"a\tb" -> "a\tb" [OK]
+-- execv
+
+a
+b
+c.txt@!
+"
+ 
+ a 
+  " \" 
+ \ \ \\\
+ "hola "
+a	b
diff --git a/testsuite/tests/lib-unix/common/truncate.ml b/testsuite/tests/lib-unix/common/truncate.ml
new file mode 100644
index 00000000..a91cabcb
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/truncate.ml
@@ -0,0 +1,33 @@
+(* TEST
+include unix
+* hasunix
+** bytecode
+** native
+*)
+
+let str = "Hello, OCaml!"
+let txt = "truncate.txt"
+
+let test file openfile stat truncate delta close =
+  let () =
+    let c = open_out_bin file in
+    output_string c str;
+    close_out c
+  in
+  let size file =
+    (stat file).Unix.st_size
+  in
+  let file = openfile file in
+  Printf.printf "initial size: %d\n%!" (size file);
+  truncate file (size file - delta);
+  Printf.printf "new size: %d\n%!" (size file);
+  truncate file 0;
+  Printf.printf "final size: %d\n%!" (size file);
+  close file
+
+let () =
+  test "truncate.txt" (fun x -> x) Unix.stat Unix.truncate 2 ignore
+
+let () =
+  let open_it file = Unix.openfile file [O_RDWR] 0 in
+  test "ftruncate.txt" open_it Unix.fstat Unix.ftruncate 3 Unix.close
diff --git a/testsuite/tests/lib-unix/common/truncate.reference b/testsuite/tests/lib-unix/common/truncate.reference
new file mode 100644
index 00000000..07c37386
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/truncate.reference
@@ -0,0 +1,6 @@
+initial size: 13
+new size: 11
+final size: 0
+initial size: 13
+new size: 10
+final size: 0
diff --git a/testsuite/tests/lib-unix/common/utimes.ml b/testsuite/tests/lib-unix/common/utimes.ml
new file mode 100644
index 00000000..0bc32570
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/utimes.ml
@@ -0,0 +1,35 @@
+(* TEST
+* hasunix
+include unix
+files = "utimes.txt"
+** bytecode
+** native
+*)
+
+(* We do not check setting the "last access time" because it is hard to do so on
+   some file systems. FAT, for example, only has a 1d resolution for this
+   timestamp, and even NTFS can potentially delay the update of this timestamp
+   by up to an hour.
+*)
+
+let txt = "utimes.txt"
+
+(* To account for filesystems with large timestamp resolution (e.g. FAT - 2
+   seconds for mtime)
+*)
+let close s t =
+  abs_float (s -. t) < 10.
+
+let check tm =
+  let tm' = (Unix.stat txt).Unix.st_mtime in
+  Printf.printf "tm ~ tm' (%B)\n" (close tm tm')
+
+let () =
+  let oc = open_out_bin txt in
+  close_out oc;
+  let tm = 1508391026.124 in
+  Unix.utimes txt tm tm;
+  check tm;
+  let tn = Unix.time () in
+  Unix.utimes txt 0. 0.;
+  check tn
diff --git a/testsuite/tests/lib-unix/common/utimes.reference b/testsuite/tests/lib-unix/common/utimes.reference
new file mode 100644
index 00000000..8c474fc4
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/utimes.reference
@@ -0,0 +1,2 @@
+tm ~ tm' (true)
+tm ~ tm' (true)
diff --git a/testsuite/tests/lib-unix/common/utimes.txt b/testsuite/tests/lib-unix/common/utimes.txt
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/lib-unix/common/wait_nohang.ml b/testsuite/tests/lib-unix/common/wait_nohang.ml
new file mode 100644
index 00000000..5d6e73e5
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/wait_nohang.ml
@@ -0,0 +1,52 @@
+(* TEST
+
+files = "reflector.ml"
+
+* hasunix
+** setup-ocamlc.byte-build-env
+program = "${test_build_directory}/wait_nohang.byte"
+*** ocamlc.byte
+program = "${test_build_directory}/reflector.exe"
+all_modules = "reflector.ml"
+**** ocamlc.byte
+include unix
+program = "${test_build_directory}/wait_nohang.byte"
+all_modules= "wait_nohang.ml"
+***** check-ocamlc.byte-output
+****** run
+******* check-program-output
+
+** setup-ocamlopt.byte-build-env
+program = "${test_build_directory}/wait_nohang.opt"
+*** ocamlopt.byte
+program = "${test_build_directory}/reflector.exe"
+all_modules = "reflector.ml"
+**** ocamlopt.byte
+include unix
+program = "${test_build_directory}/wait_nohang.opt"
+all_modules= "wait_nohang.ml"
+***** check-ocamlopt.byte-output
+****** run
+******* check-program-output
+
+*)
+
+let refl =
+  Filename.concat Filename.current_dir_name "reflector.exe"
+
+let () =
+  let oc = Unix.open_process_out (refl ^ " -i2o") in
+  let pid = Unix.process_out_pid oc in
+  let (pid1, status1) = Unix.waitpid [WNOHANG] pid in
+  assert (pid1 = 0);
+  assert (status1 = WEXITED 0);
+  output_string oc "aa\n"; close_out oc;
+  let rec busywait () =
+    let (pid2, status2) = Unix.waitpid [WNOHANG] pid in
+    if pid2 = 0 then begin
+      Unix.sleepf 0.001; busywait()
+    end else begin
+      assert (pid2 = pid);
+      assert (status2 = WEXITED 0)
+    end
+  in busywait()
diff --git a/testsuite/tests/lib-unix/common/wait_nohang.reference b/testsuite/tests/lib-unix/common/wait_nohang.reference
new file mode 100644
index 00000000..e61ef7b9
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/wait_nohang.reference
@@ -0,0 +1 @@
+aa
diff --git a/testsuite/tests/lib-unix/isatty/isatty_std.ml b/testsuite/tests/lib-unix/isatty/isatty_std.ml
new file mode 100644
index 00000000..1dcff453
--- /dev/null
+++ b/testsuite/tests/lib-unix/isatty/isatty_std.ml
@@ -0,0 +1,16 @@
+(* TEST
+* hasunix
+include unix
+stdin = "/dev/null"
+stderr = "/dev/null"
+** bytecode
+** native
+*)
+
+Printf.printf
+  "Unix.isatty Unix.stdin = %b\n\
+   Unix.isatty Unix.stdout = %b\n\
+   Unix.isatty Unix.stderr = %b\n"
+  (Unix.isatty Unix.stdin)
+  (Unix.isatty Unix.stdout)
+  (Unix.isatty Unix.stderr)
diff --git a/testsuite/tests/lib-unix/isatty/isatty_std.reference b/testsuite/tests/lib-unix/isatty/isatty_std.reference
new file mode 100644
index 00000000..9a32009d
--- /dev/null
+++ b/testsuite/tests/lib-unix/isatty/isatty_std.reference
@@ -0,0 +1,3 @@
+Unix.isatty Unix.stdin = false
+Unix.isatty Unix.stdout = false
+Unix.isatty Unix.stderr = false
diff --git a/testsuite/tests/lib-unix/isatty/isatty_tty.ml b/testsuite/tests/lib-unix/isatty/isatty_tty.ml
new file mode 100644
index 00000000..df57e7a3
--- /dev/null
+++ b/testsuite/tests/lib-unix/isatty/isatty_tty.ml
@@ -0,0 +1,16 @@
+(* TEST
+
+* libwin32unix
+include unix
+** bytecode
+** native
+
+*)
+
+let console =
+  try
+    Unix.(openfile "/dev/tty" [O_RDWR] 0)
+  with _ ->
+    Unix.(openfile "CONIN$" [O_RDWR] 0)
+in
+Printf.printf "/dev/tty = %b\n" (Unix.isatty console)
diff --git a/testsuite/tests/lib-unix/isatty/isatty_tty.reference b/testsuite/tests/lib-unix/isatty/isatty_tty.reference
new file mode 100644
index 00000000..6ac4059f
--- /dev/null
+++ b/testsuite/tests/lib-unix/isatty/isatty_tty.reference
@@ -0,0 +1 @@
+/dev/tty = true
diff --git a/testsuite/tests/lib-unix/unix-execvpe/exec.ml b/testsuite/tests/lib-unix/unix-execvpe/exec.ml
new file mode 100644
index 00000000..f4826a99
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/exec.ml
@@ -0,0 +1,24 @@
+(* TEST
+   * hasunix
+   include unix
+   script = "sh ${test_source_directory}/has-execvpe.sh"
+   ** script
+   *** bytecode
+   *** native
+*)
+
+open Printf
+
+let _ =
+  let arg = Array.sub Sys.argv 1 (Array.length Sys.argv - 1) in
+  let env = Array.append [|"FOO=foo"|] (Unix.environment()) in
+  try
+    Unix.execvpe arg.(0) arg env
+  with
+  | Unix.Unix_error(Unix.ENOENT, _, arg) ->
+      eprintf "No such file %s\n" arg; exit 2
+  | Unix.Unix_error(Unix.EACCES, _, arg) ->
+      eprintf "Permission denied %s\n" arg; exit 2
+  | Unix.Unix_error(err, fn, arg) ->
+      eprintf "Other error %s - %s - %s\n" (Unix.error_message err) fn arg;
+      exit 4
diff --git a/testsuite/tests/lib-unix/unix-execvpe/exec.reference b/testsuite/tests/lib-unix/unix-execvpe/exec.reference
new file mode 100644
index 00000000..b8c8bb4b
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/exec.reference
@@ -0,0 +1,19 @@
+## Test 1: a binary program in the path
+## Test 2: a #! script in the path
+--- subdir/script1
+FOO is foo, BAR is bar, BUZ is 
+3 arguments:  2 3 4
+## Test 3: a script without #! in the path
+--- subdir/script2
+FOO is foo, BAR is bar, BUZ is 
+3 arguments:  5 6 7
+## Test 4: a script in the current directory
+--- ./script3
+FOO is foo, BAR is bar, BUZ is 
+2 arguments:  8 9
+## Test 5: a non-existent program
+No such file nosuchprogram
+## Test 6: a non-executable program
+Permission denied nonexec
+## Test 7: a script in the current directory
+No such file script3
diff --git a/testsuite/tests/lib-unix/unix-execvpe/exec.run b/testsuite/tests/lib-unix/unix-execvpe/exec.run
new file mode 100755
index 00000000..55028c27
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/exec.run
@@ -0,0 +1,33 @@
+#!/bin/sh
+
+if test -z "$program"; then echo "Define the program env var" 1&>2; exit 2; fi
+
+output=$program.output
+exec > ${output} 2>&1
+
+subdir=${test_source_directory}/subdir
+
+# Let ocamltest know where we write our output
+echo output=\"${output}\" > ${ocamltest_response}
+
+export PATH="/bin:/usr/bin:${subdir}:"
+export BAR=bar
+
+echo "## Test 1: a binary program in the path"
+$program ls / > /dev/null || echo "ls failed"
+echo "## Test 2: a #! script in the path"
+$program script1 2 3 4 || echo "script1 failed"
+echo "## Test 3: a script without #! in the path"
+$program script2 5 6 7 || echo "script2 failed"
+echo "## Test 4: a script in the current directory"
+cd ${test_source_directory}
+$program script3 8 9 || echo "script3 failed"
+echo "## Test 5: a non-existent program"
+$program nosuchprogram
+echo "## Test 6: a non-executable program"
+$program nonexec
+
+export PATH="/bin:/usr/bin:${subdir}"
+echo "## Test 7: a script in the current directory"
+$program script3 9 && echo "script3 should have failed"
+exit 0
diff --git a/testsuite/tests/lib-unix/unix-execvpe/has-execvpe.sh b/testsuite/tests/lib-unix/unix-execvpe/has-execvpe.sh
new file mode 100755
index 00000000..51707f10
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/has-execvpe.sh
@@ -0,0 +1,11 @@
+#!/bin/sh
+
+# This script is related to the 'exec.ml' test.
+# It tests whether the OS implements execvpe or not.
+# It makes sense to run the tests only if execvpe is nt implemented.
+# If it is implemented, the test is skipped.
+
+if grep -q "#define HAS_EXECVPE" ${ocamlsrcdir}/runtime/caml/s.h; then
+  exit ${TEST_SKIP};
+fi
+exit ${TEST_PASS}
diff --git a/testsuite/tests/lib-unix/unix-execvpe/script3 b/testsuite/tests/lib-unix/unix-execvpe/script3
new file mode 100755
index 00000000..93b66113
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/script3
@@ -0,0 +1,4 @@
+#!/bin/sh
+echo "--- ./script3"
+echo "FOO is $FOO, BAR is $BAR, BUZ is $BUZ"
+echo "$# arguments:  $*"
diff --git a/testsuite/tests/lib-unix/unix-execvpe/subdir/nonexec b/testsuite/tests/lib-unix/unix-execvpe/subdir/nonexec
new file mode 100644
index 00000000..d8534975
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/subdir/nonexec
@@ -0,0 +1 @@
+echo "This script lacks the x bit and should not run!"
diff --git a/testsuite/tests/lib-unix/unix-execvpe/subdir/script1 b/testsuite/tests/lib-unix/unix-execvpe/subdir/script1
new file mode 100755
index 00000000..e59ab0ae
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/subdir/script1
@@ -0,0 +1,4 @@
+#!/bin/sh
+echo "--- subdir/script1"
+echo "FOO is $FOO, BAR is $BAR, BUZ is $BUZ"
+echo "$# arguments:  $*"
diff --git a/testsuite/tests/lib-unix/unix-execvpe/subdir/script2 b/testsuite/tests/lib-unix/unix-execvpe/subdir/script2
new file mode 100755
index 00000000..83457449
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/subdir/script2
@@ -0,0 +1,3 @@
+echo "--- subdir/script2"
+echo "FOO is $FOO, BAR is $BAR, BUZ is $BUZ"
+echo "$# arguments:  $*"
diff --git a/testsuite/tests/lib-unix/unix-socket/is-linux.sh b/testsuite/tests/lib-unix/unix-socket/is-linux.sh
new file mode 100755
index 00000000..80815e84
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-socket/is-linux.sh
@@ -0,0 +1,21 @@
+#!/bin/sh
+
+# This script is related to the 'recvfrom_linux.ml' test.
+
+uname="$(uname -s)"
+if [ "$uname" = "Linux" ]; then
+
+# Workaround: the tests that come after this script
+# (bytecode and native) depend on stdout redirection, but
+# running a script sets both of those to the empty string.
+# See https://caml.inria.fr/mantis/view.php?id=7910
+  cat > "$ocamltest_response" <<EOF
+-stdout
+-stderr
+EOF
+
+  exit ${TEST_PASS}
+else
+  echo "$uname" > "$ocamltest_response"
+  exit ${TEST_SKIP}
+fi
diff --git a/testsuite/tests/lib-unix/unix-socket/recvfrom.ml b/testsuite/tests/lib-unix/unix-socket/recvfrom.ml
new file mode 100644
index 00000000..f18e0846
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-socket/recvfrom.ml
@@ -0,0 +1,33 @@
+open Unix
+
+let path_of_addr = function
+  | ADDR_UNIX path -> path
+  | _ -> assert false
+;;
+
+let test_sender ~client_socket ~server_socket ~server_addr ~client_addr =
+  Printf.printf "%S" (path_of_addr client_addr);
+  let byte = Bytes.make 1 't' in
+  let sent_len = sendto client_socket byte 0 1 [] server_addr in
+  assert (sent_len = 1);
+  let buf = Bytes.make 1024 '\x00' in
+  let (recv_len, sender) = recvfrom server_socket buf 0 1024 [] in
+
+  Printf.printf " as %S: " (path_of_addr sender);
+  assert (sender = client_addr);
+  assert (Bytes.sub_string buf 0 recv_len = "t");
+  print_endline "OK";;
+
+let ensure_no_file path =
+  try unlink path with Unix_error (ENOENT, _, _) -> ();;
+
+let with_socket fn =
+  let s = socket PF_UNIX SOCK_DGRAM 0 in
+  Fun.protect ~finally:(fun () -> close s) (fun () -> fn s)
+
+let with_bound_socket path fn =
+  with_socket (fun s ->
+    let addr = ADDR_UNIX path in
+    bind s addr;
+    fn addr s
+  )
diff --git a/testsuite/tests/lib-unix/unix-socket/recvfrom_linux.ml b/testsuite/tests/lib-unix/unix-socket/recvfrom_linux.ml
new file mode 100644
index 00000000..73fa3fb2
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-socket/recvfrom_linux.ml
@@ -0,0 +1,21 @@
+(* TEST
+include unix
+modules = "recvfrom.ml"
+script = "sh ${test_source_directory}/is-linux.sh"
+* hasunix
+** script
+*** bytecode
+*** native
+*)
+open Recvfrom
+
+let () =
+  let server_path = "ocaml-test-socket-linux" in
+  ensure_no_file server_path;
+  at_exit (fun () -> ensure_no_file server_path);
+  with_bound_socket server_path (fun server_addr server_socket ->
+    (* abstract socket *)
+    with_bound_socket "\x00ocaml-abstract-socket" (fun client_addr client_socket ->
+      test_sender ~client_socket ~server_socket ~server_addr ~client_addr
+    );
+  )
diff --git a/testsuite/tests/lib-unix/unix-socket/recvfrom_linux.reference b/testsuite/tests/lib-unix/unix-socket/recvfrom_linux.reference
new file mode 100644
index 00000000..df4d7cb0
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-socket/recvfrom_linux.reference
@@ -0,0 +1 @@
+"\000ocaml-abstract-socket" as "\000ocaml-abstract-socket": OK
diff --git a/testsuite/tests/lib-unix/unix-socket/recvfrom_unix.ml b/testsuite/tests/lib-unix/unix-socket/recvfrom_unix.ml
new file mode 100644
index 00000000..e584ff17
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-socket/recvfrom_unix.ml
@@ -0,0 +1,24 @@
+(* TEST
+include unix
+modules = "recvfrom.ml"
+* hasunix
+** not-windows
+*** bytecode
+*** native
+*)
+open Recvfrom
+
+let () =
+  let server_path = "ocaml-test-socket-unix" in
+  ensure_no_file server_path;
+  at_exit (fun () -> ensure_no_file server_path);
+  with_bound_socket server_path (fun server_addr server_socket ->
+    (* path socket, just reuse server addr *)
+    test_sender ~client_socket:server_socket ~server_socket ~server_addr ~client_addr:server_addr;
+
+    (* unnamed socket *)
+    with_socket (fun client_socket ->
+      (* unbound socket should be treated as empty path *)
+      test_sender ~client_socket ~server_socket ~server_addr ~client_addr:(ADDR_UNIX "")
+    )
+  )
diff --git a/testsuite/tests/lib-unix/unix-socket/recvfrom_unix.reference b/testsuite/tests/lib-unix/unix-socket/recvfrom_unix.reference
new file mode 100644
index 00000000..26bbaa40
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-socket/recvfrom_unix.reference
@@ -0,0 +1,2 @@
+"ocaml-test-socket-unix" as "ocaml-test-socket-unix": OK
+"" as "": OK
diff --git a/testsuite/tests/lib-unix/win-env/stubs.c b/testsuite/tests/lib-unix/win-env/stubs.c
new file mode 100644
index 00000000..61a7b2d5
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-env/stubs.c
@@ -0,0 +1,20 @@
+#define CAML_INTERNALS
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/osdeps.h>
+
+#include <windows.h>
+
+CAMLprim value stub_SetEnvironmentVariable(value s1, value s2)
+{
+  WCHAR *w1, *w2;
+  w1 = caml_stat_strdup_to_utf16(String_val(s1));
+  w2 = caml_stat_strdup_to_utf16(String_val(s2));
+  SetEnvironmentVariableW(w1, w2);
+  caml_stat_free(w1);
+  caml_stat_free(w2);
+  return Val_unit;
+}
diff --git a/testsuite/tests/lib-unix/win-env/test_env.ml b/testsuite/tests/lib-unix/win-env/test_env.ml
new file mode 100644
index 00000000..45a96b82
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-env/test_env.ml
@@ -0,0 +1,40 @@
+(* TEST
+include unix
+flags += "-strict-sequence -safe-string -w A -warn-error A"
+modules = "stubs.c"
+* libwin32unix
+** bytecode
+** native
+*)
+
+external set_environment_variable: string -> string -> unit
+  = "stub_SetEnvironmentVariable"
+
+let find_env s =
+  let env = Unix.environment () in
+  let rec loop i =
+    if i >= Array.length env then
+      None
+    else begin
+      let e = env.(i) in
+      let pos = String.index e '=' in
+      if String.sub e 0 pos = s then
+        Some (String.sub e (pos+1) (String.length e - pos - 1))
+      else
+        loop (i+1)
+    end
+  in
+  loop 0
+
+let print title = function
+  | None ->
+      Printf.printf "%s -> None\n%!" title
+  | Some s ->
+      Printf.printf "%s -> Some %S\n%!" title s
+
+let () =
+  set_environment_variable "FOO" "BAR";
+  Unix.putenv "FOO2" "BAR2";
+  print "Sys.getenv FOO" (Sys.getenv_opt "FOO");
+  print "Unix.environment FOO" (find_env "FOO");
+  print "Sys.getenv FOO2" (Sys.getenv_opt "FOO2")
diff --git a/testsuite/tests/lib-unix/win-env/test_env.reference b/testsuite/tests/lib-unix/win-env/test_env.reference
new file mode 100644
index 00000000..a64be064
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-env/test_env.reference
@@ -0,0 +1,3 @@
+Sys.getenv FOO -> Some "BAR"
+Unix.environment FOO -> Some "BAR"
+Sys.getenv FOO2 -> Some "BAR2"
diff --git a/testsuite/tests/lib-unix/win-stat/fakeclock.c b/testsuite/tests/lib-unix/win-stat/fakeclock.c
new file mode 100644
index 00000000..be30e6f5
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-stat/fakeclock.c
@@ -0,0 +1,179 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                 David Allsopp, OCaml Labs, Cambridge.                  */
+/*                                                                        */
+/*   Copyright 2017 MetaStack Solutions Ltd.                              */
+/*                                                                        */
+/*   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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <windows.h>
+
+typedef union ufiletime_int64
+{
+  unsigned __int64 scalar;
+  FILETIME ft;
+} filetime_int64;
+
+static filetime_int64 clk;
+static DWORD wall = 0;
+static unsigned __int64 bias = 0LL;
+
+BOOL WINAPI FakeConvert(const FILETIME* lpFileTime, LPFILETIME lpLocalFileTime)
+{
+  filetime_int64 result;
+  memcpy(&result.ft, lpFileTime, sizeof(FILETIME));
+  result.scalar += bias;
+  memcpy(lpLocalFileTime, &result.ft, sizeof(FILETIME));
+  return TRUE;
+}
+
+void WINAPI FakeClock(LPFILETIME result)
+{
+  DWORD now = GetTickCount();
+  /* Take a risk on this: GetTickCount64 is not available in Windows XP... */
+  /* GetTickCount is in ms, clk.scalar is in 100ns intervals */
+  clk.scalar += ((now - wall) * 10000);
+  wall = now;
+
+  memcpy(result, &clk.ft, sizeof(FILETIME));
+
+  return;
+}
+
+/* Assuming that nowhere transitions DST in February... */
+static short mon_days[13] = {0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31};
+
+void SetBias(void)
+{
+  TIME_ZONE_INFORMATION tzInfo;
+  filetime_int64 dst;
+  SYSTEMTIME dst_start;
+
+  switch (GetTimeZoneInformation(&tzInfo)) {
+    case TIME_ZONE_ID_INVALID:
+    case TIME_ZONE_ID_UNKNOWN:
+      /* Default to GMT */
+      tzInfo.DaylightDate.wYear = 0;
+      tzInfo.DaylightDate.wMonth = 3;
+      tzInfo.DaylightDate.wDay = 5;
+      tzInfo.DaylightDate.wDayOfWeek = 0;
+      tzInfo.DaylightDate.wHour = 1;
+      tzInfo.StandardBias = 0;
+      tzInfo.DaylightBias = -60;
+  }
+
+  /* If wYear is given, then DaylightDate is a date, otherwise the transition
+   * is the wDay'th wDayOfWeek of wMonth (where the 5th wDayOfWeek means last
+   * when there are only 4 wDayOfWeek's in wMonth)
+   */
+  if (!tzInfo.DaylightDate.wYear) {
+    int wday;
+    /* Get the clock date in order to determine wYear */
+    FileTimeToSystemTime(&clk.ft, &dst_start);
+    /* Back-up DST transition details */
+    dst_start.wDay = tzInfo.DaylightDate.wDay;
+    dst_start.wDayOfWeek = tzInfo.DaylightDate.wDayOfWeek;
+    /* Set tzInfo to be first day of month on DST change */
+    tzInfo.DaylightDate.wYear = dst_start.wYear;
+    tzInfo.DaylightDate.wDay = 1;
+    /* Normalise tzInfo.DaylightDate (need wDayOfWeek) */
+    SystemTimeToFileTime(&tzInfo.DaylightDate, &dst.ft);
+    FileTimeToSystemTime(&dst.ft, &tzInfo.DaylightDate);
+    /* First to first weekday of DST transition */
+    if ((wday = dst_start.wDayOfWeek - tzInfo.DaylightDate.wDayOfWeek) < 0)
+      tzInfo.DaylightDate.wDay += wday + 7;
+    else
+      tzInfo.DaylightDate.wDay += wday;
+    tzInfo.DaylightDate.wDayOfWeek =
+      (mon_days[tzInfo.DaylightDate.wMonth] - tzInfo.DaylightDate.wDay) / 7;
+    if (dst_start.wDay > tzInfo.DaylightDate.wDayOfWeek)
+      dst_start.wDay = tzInfo.DaylightDate.wDayOfWeek;
+    tzInfo.DaylightDate.wDay += 7 * dst_start.wDay;
+  }
+  SystemTimeToFileTime(&tzInfo.DaylightDate, &dst.ft);
+  bias = -(clk.scalar >= dst.scalar ? tzInfo.DaylightBias
+                                    : tzInfo.StandardBias) * 600000000LL;
+  return;
+}
+
+void ReplaceFunction(char* fn, char* module, void* pNew)
+{
+  HMODULE hModule = LoadLibrary(module);
+  void* pCode;
+  DWORD dwOldProtect = 0;
+#ifdef _M_X64
+  SIZE_T jmpSize = 13;
+  BYTE jump[13];
+#else
+  SIZE_T jmpSize = 5;
+  BYTE jump[5];
+#endif
+  SIZE_T bytesWritten;
+
+  /* Patching is permitted to fail (missing API, etc.) */
+  if (!hModule) return;
+  pCode = GetProcAddress(hModule, fn);
+  if (!pCode) return;
+
+  /* Overwrite the code with a jump to our function */
+  if (VirtualProtect(pCode, jmpSize, PAGE_EXECUTE_READWRITE, &dwOldProtect)) {
+#ifdef _M_X64
+    jump[0] = 0x49;             /* REX.WB prefix */
+    jump[1] = 0xBB;             /* MOV r11, ... */
+    memcpy(jump + 2, &pNew, 8); /* imm64 */
+    jump[10] = 0x41;            /* REX.B prefix */
+    jump[11] = 0xFF;            /* JMP */
+    jump[12] = 0xE3;            /* r11 */
+#else
+    /* JMP rel32 to FakeClock */
+    DWORD dwRelativeAddr = (DWORD)pNew - ((DWORD)pCode + 5);
+    jump[0] = 0xE9;
+    memcpy(jump + 1, &dwRelativeAddr, 4);
+#endif
+
+    if (WriteProcessMemory(GetCurrentProcess(), pCode, jump, jmpSize, NULL)) {
+      VirtualProtect(pCode, jmpSize, dwOldProtect, &dwOldProtect);
+    }
+  }
+
+  return;
+}
+
+#define CAML_NAME_SPACE
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+
+static int patched = 0;
+
+CAMLprim value set_fake_clock(value time)
+{
+  CAMLparam1(time);
+
+  clk.scalar = Int64_val(time);
+  wall = GetTickCount();
+  SetBias();
+
+  if (!patched) {
+    patched = 1;
+    /* Patch Windows 8 and later (UCRT) */
+    ReplaceFunction("GetSystemTimePreciseAsFileTime",
+                    "api-ms-win-core-sysinfo-l1-2-1.dll", &FakeClock);
+    ReplaceFunction("GetSystemTimeAsFileTime",
+                    "api-ms-win-core-sysinfo-l1-2-1.dll", &FakeClock);
+    /* Patch Windows 7 API Set */
+    ReplaceFunction("GetSystemTimeAsFileTime",
+                    "api-ms-win-core-sysinfo-l1-1-0.dll", &FakeClock);
+    /* Patch Windows 7 and previous (standard CRT) */
+    ReplaceFunction("GetSystemTimeAsFileTime",
+                    "kernel32.dll", &FakeClock);
+    ReplaceFunction("FileTimeToLocalFileTime", "kernel32.dll", &FakeConvert);
+  }
+
+  CAMLreturn(Val_unit);
+}
diff --git a/testsuite/tests/lib-unix/win-stat/test.ml b/testsuite/tests/lib-unix/win-stat/test.ml
new file mode 100644
index 00000000..63ea178a
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-stat/test.ml
@@ -0,0 +1,39 @@
+(* TEST
+modules = "fakeclock.c"
+* libwin32unix
+include unix
+** bytecode
+** native
+*)
+
+open Unix
+
+external set_fake_clock : int64 -> unit = "set_fake_clock"
+
+let real_time tm = {tm with tm_year = tm.tm_year + 1900; tm_mon = tm.tm_mon + 1}
+
+let print_time () =
+  let time = Unix.time () |> Unix.gmtime |> real_time in
+  Printf.printf "System clock: %04d/%02d/%02d %02d:%02d\n" time.tm_year
+                                                           time.tm_mon
+                                                           time.tm_mday
+                                                           time.tm_hour
+                                                           time.tm_min
+
+let test_mtime file =
+  let time = (Unix.stat file).st_mtime |> Unix.gmtime |> real_time in
+  Printf.printf "Read mtime for %s = %04d/%02d/%02d %02d:%02d:%02d\n"
+    file
+    time.tm_year time.tm_mon time.tm_mday time.tm_hour time.tm_min time.tm_sec
+
+let _ =
+  (* 1-Jun-2017 20:33:10.42+0000 *)
+  set_fake_clock 0x1D2DB1648916FA0L;
+  print_time ();
+  test_mtime "dst-file";
+  test_mtime "non-dst-file";
+  (* 1-Feb-2017 20:33:10.42+0000 *)
+  set_fake_clock 0x1D27CCA66FF6FA0L;
+  print_time ();
+  test_mtime "dst-file";
+  test_mtime "non-dst-file"
diff --git a/testsuite/tests/lib-unix/win-stat/test.reference b/testsuite/tests/lib-unix/win-stat/test.reference
new file mode 100644
index 00000000..308e4894
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-stat/test.reference
@@ -0,0 +1,6 @@
+System clock: 2017/06/01 20:33
+Read mtime for dst-file = 2017/07/01 12:00:00
+Read mtime for non-dst-file = 2017/02/01 12:00:00
+System clock: 2017/02/01 20:33
+Read mtime for dst-file = 2017/07/01 12:00:00
+Read mtime for non-dst-file = 2017/02/01 12:00:00
diff --git a/testsuite/tests/lib-unix/win-stat/test.run b/testsuite/tests/lib-unix/win-stat/test.run
new file mode 100644
index 00000000..f39310fc
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-stat/test.run
@@ -0,0 +1,4 @@
+#!/bin/sh
+TZ=utc touch -m -t 201707011200 dst-file
+TZ=utc touch -m -t 201702011200 non-dst-file
+`cygpath -m "${program}"` > `cygpath -m "${output}"` 2>&1
diff --git a/testsuite/tests/lib-unix/win-symlink/test.ml b/testsuite/tests/lib-unix/win-symlink/test.ml
new file mode 100644
index 00000000..64b8ae91
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-symlink/test.ml
@@ -0,0 +1,29 @@
+(* TEST
+
+* libwin32unix
+   include unix
+** has_symlink
+*** bytecode
+*** native
+
+*)
+
+let link1 = "link1"
+let link2 = "link2"
+
+let link_exists s =
+  try (Unix.lstat s).Unix.st_kind = Unix.S_LNK with _ -> false
+
+let main () =
+  close_out (open_out "test.txt");
+  if link_exists link1 then Sys.remove link1;
+  if link_exists link2 then Sys.remove link2;
+  Unix.symlink ~to_dir:false ".\\test.txt" link1;
+  assert ((Unix.stat link1).Unix.st_kind = Unix.S_REG);
+  print_endline "Unix.symlink works with backwards slashes";
+  Unix.symlink ~to_dir:false "./test.txt" link2;
+  assert ((Unix.stat link2).Unix.st_kind = Unix.S_REG);
+  print_endline "Unix.symlink works with forward slashes"
+
+let () =
+  Unix.handle_unix_error main ()
diff --git a/testsuite/tests/lib-unix/win-symlink/test.reference b/testsuite/tests/lib-unix/win-symlink/test.reference
new file mode 100644
index 00000000..871a3e01
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-symlink/test.reference
@@ -0,0 +1,2 @@
+Unix.symlink works with backwards slashes
+Unix.symlink works with forward slashes
diff --git a/testsuite/tests/link-test/aliases.ml b/testsuite/tests/link-test/aliases.ml
new file mode 100644
index 00000000..65fbc19f
--- /dev/null
+++ b/testsuite/tests/link-test/aliases.ml
@@ -0,0 +1 @@
+module Submodule = Submodule
diff --git a/testsuite/tests/link-test/external.ml b/testsuite/tests/link-test/external.ml
new file mode 100644
index 00000000..e2eb5b7f
--- /dev/null
+++ b/testsuite/tests/link-test/external.ml
@@ -0,0 +1,2 @@
+let () = print_endline "linked external"; flush stdout
+external frexp : float -> float * int = "caml_frexp_float"
diff --git a/testsuite/tests/link-test/external.mli b/testsuite/tests/link-test/external.mli
new file mode 100644
index 00000000..4b2548e8
--- /dev/null
+++ b/testsuite/tests/link-test/external.mli
@@ -0,0 +1 @@
+external frexp : float -> float * int = "caml_frexp_float"
diff --git a/testsuite/tests/link-test/external_for_pack.ml b/testsuite/tests/link-test/external_for_pack.ml
new file mode 100644
index 00000000..2d5be97c
--- /dev/null
+++ b/testsuite/tests/link-test/external_for_pack.ml
@@ -0,0 +1,2 @@
+let () = print_endline "linked external from pack"; flush stdout
+external frexp : float -> float * int = "caml_frexp_float"
diff --git a/testsuite/tests/link-test/external_for_pack.mli b/testsuite/tests/link-test/external_for_pack.mli
new file mode 100644
index 00000000..4b2548e8
--- /dev/null
+++ b/testsuite/tests/link-test/external_for_pack.mli
@@ -0,0 +1 @@
+external frexp : float -> float * int = "caml_frexp_float"
diff --git a/testsuite/tests/link-test/submodule.ml b/testsuite/tests/link-test/submodule.ml
new file mode 100644
index 00000000..b315f202
--- /dev/null
+++ b/testsuite/tests/link-test/submodule.ml
@@ -0,0 +1,2 @@
+let () = print_endline "linked"; flush stdout
+module M = struct end
diff --git a/testsuite/tests/link-test/test.ml b/testsuite/tests/link-test/test.ml
new file mode 100644
index 00000000..7b618baa
--- /dev/null
+++ b/testsuite/tests/link-test/test.ml
@@ -0,0 +1,85 @@
+(* TEST
+
+modules = "aliases.ml external_for_pack.ml external.ml submodule.ml test.ml \
+           use_in_pack.ml"
+
+* setup-ocamlc.byte-build-env
+program = "${test_build_directory}/test.byte"
+** ocamlc.byte
+module = "submodule.ml"
+flags = "-no-alias-deps"
+*** ocamlc.byte
+module = "aliases.ml"
+**** ocamlc.byte
+module = "external.mli"
+***** ocamlc.byte
+module = "external.ml"
+****** ocamlc.byte
+module = "external_for_pack.mli"
+******* ocamlc.byte
+module = "external_for_pack.ml"
+******** ocamlc.byte
+module = "test.ml"
+********* ocamlc.byte
+module = ""
+flags = "-a -no-alias-deps"
+all_modules = "submodule.cmo aliases.cmo external.cmo external_for_pack.cmo"
+program = "mylib.cma"
+********** ocamlc.byte
+flags = "-no-alias-deps -for-pack P"
+module = "use_in_pack.ml"
+*********** ocamlc.byte
+module = ""
+program = "p.cmo"
+flags = "-no-alias-deps -pack"
+all_modules = "use_in_pack.cmo"
+************ ocamlc.byte
+program = "${test_build_directory}/test.byte"
+all_modules = "mylib.cma p.cmo test.cmo"
+flags= "-no-alias-deps"
+************* check-ocamlc.byte-output
+************** run
+*************** check-program-output
+
+* setup-ocamlopt.byte-build-env
+program = "${test_build_directory}/test.opt"
+** ocamlopt.byte
+module = "submodule.ml"
+flags = "-no-alias-deps"
+*** ocamlopt.byte
+module = "aliases.ml"
+**** ocamlopt.byte
+module = "external.mli"
+***** ocamlopt.byte
+module = "external.ml"
+****** ocamlopt.byte
+module = "external_for_pack.mli"
+******* ocamlopt.byte
+module = "external_for_pack.ml"
+******** ocamlopt.byte
+module = "test.ml"
+********* ocamlopt.byte
+module = ""
+flags = "-no-alias-deps -a"
+all_modules = "submodule.cmx aliases.cmx external.cmx external_for_pack.cmx"
+program = "mylib.cmxa"
+********** ocamlopt.byte
+flags = "-no-alias-deps -for-pack P"
+module = "use_in_pack.ml"
+*********** ocamlopt.byte
+module = ""
+program = "p.cmx"
+flags = "-no-alias-deps -pack"
+all_modules = "use_in_pack.cmx"
+************ ocamlopt.byte
+program = "${test_build_directory}/test.opt"
+all_modules = "mylib.cmxa p.cmx test.cmx"
+flags = "-no-alias-deps"
+************* check-ocamlopt.byte-output
+************** run
+*************** check-program-output
+
+*)
+
+include Aliases.Submodule.M
+let _, _ = External.frexp 3.
diff --git a/testsuite/tests/link-test/test.reference b/testsuite/tests/link-test/test.reference
new file mode 100644
index 00000000..b188f6c0
--- /dev/null
+++ b/testsuite/tests/link-test/test.reference
@@ -0,0 +1,3 @@
+linked
+linked external
+linked external from pack
diff --git a/testsuite/tests/link-test/use_in_pack.ml b/testsuite/tests/link-test/use_in_pack.ml
new file mode 100644
index 00000000..9d55b593
--- /dev/null
+++ b/testsuite/tests/link-test/use_in_pack.ml
@@ -0,0 +1 @@
+let _, _ = External_for_pack.frexp 12.
diff --git a/testsuite/tests/local-functions/tupled.ml b/testsuite/tests/local-functions/tupled.ml
new file mode 100644
index 00000000..aef5aacb
--- /dev/null
+++ b/testsuite/tests/local-functions/tupled.ml
@@ -0,0 +1,11 @@
+(* TEST
+*)
+
+(* PR#8705 *)
+let () =
+  let tupled (x, y) =
+    print_string "";
+    fun z -> x, y, z
+  in
+  let a, b, c = tupled (0, 1) 2 in
+  assert (a = 0 && b = 1 && c = 2)
diff --git a/testsuite/tests/local-functions/tupled2.ml b/testsuite/tests/local-functions/tupled2.ml
new file mode 100644
index 00000000..e1564980
--- /dev/null
+++ b/testsuite/tests/local-functions/tupled2.ml
@@ -0,0 +1,16 @@
+(* TEST
+*)
+
+(* PR#8705 *)
+
+let test x =
+  let tupled (x, y) = (); fun () -> [|x; y|] in
+  match x with
+  | None -> [| |]
+  | Some (x, y) -> tupled (x, y) ()
+
+let expected = "Hello "
+
+let result = (test (Some (expected, "World!"))).(0)
+
+let () = assert (String.equal expected result)
diff --git a/testsuite/tests/locale/stubs.c b/testsuite/tests/locale/stubs.c
new file mode 100644
index 00000000..1eec8ab1
--- /dev/null
+++ b/testsuite/tests/locale/stubs.c
@@ -0,0 +1,8 @@
+#include <caml/mlvalues.h>
+#include <locale.h>
+
+value ml_setlocale(value v_locale)
+{
+  setlocale(LC_ALL,String_val(v_locale));
+  return Val_unit;
+}
diff --git a/testsuite/tests/locale/test.ml b/testsuite/tests/locale/test.ml
new file mode 100644
index 00000000..dbd4f449
--- /dev/null
+++ b/testsuite/tests/locale/test.ml
@@ -0,0 +1,31 @@
+(* TEST
+modules = "stubs.c"
+*)
+
+external setlocale : string -> unit = "ml_setlocale"
+
+let show f =
+  try
+    string_of_float @@ f ()
+  with exn -> Printf.sprintf "exn %s" (Printexc.to_string exn)
+let pr fmt = Printf.ksprintf print_endline fmt
+
+let () =
+  let s = "12345.6789" in
+  let f = 1.23 in
+  let test () =
+    pr "  print 1.23 : %s" (show @@ fun () -> f);
+    pr "  parse %S : %s" s (show @@ fun () -> float_of_string s);
+    pr "  roundtrip 1.23 : %s"
+      (show @@ fun () -> float_of_string @@ string_of_float f);
+  in
+  pr "locale from environment";
+  setlocale "";
+  test ();
+  pr "locale nl_NL";
+  setlocale "nl_NL";
+  test ();
+  pr "locale POSIX";
+  setlocale "C";
+  test ();
+  ()
diff --git a/testsuite/tests/locale/test.reference b/testsuite/tests/locale/test.reference
new file mode 100644
index 00000000..9aceecc7
--- /dev/null
+++ b/testsuite/tests/locale/test.reference
@@ -0,0 +1,12 @@
+locale from environment
+  print 1.23 : 1.23
+  parse "12345.6789" : 12345.6789
+  roundtrip 1.23 : 1.23
+locale nl_NL
+  print 1.23 : 1.23
+  parse "12345.6789" : 12345.6789
+  roundtrip 1.23 : 1.23
+locale POSIX
+  print 1.23 : 1.23
+  parse "12345.6789" : 12345.6789
+  roundtrip 1.23 : 1.23
diff --git a/testsuite/tests/manual-intf-c/curses.ml b/testsuite/tests/manual-intf-c/curses.ml
new file mode 100644
index 00000000..1447f6bf
--- /dev/null
+++ b/testsuite/tests/manual-intf-c/curses.ml
@@ -0,0 +1,13 @@
+(* File curses.ml -- declaration of primitives and data types *)
+type window                   (* The type "window" remains abstract *)
+external initscr: unit -> window = "caml_curses_initscr"
+external endwin: unit -> unit = "caml_curses_endwin"
+external refresh: unit -> unit = "caml_curses_refresh"
+external wrefresh : window -> unit = "caml_curses_wrefresh"
+external newwin: int -> int -> int -> int -> window = "caml_curses_newwin"
+external addch: char -> unit = "caml_curses_addch"
+external mvwaddch: window -> int -> int -> char -> unit = "caml_curses_mvwaddch"
+external addstr: string -> unit = "caml_curses_addstr"
+external mvwaddstr: window -> int -> int -> string -> unit
+         = "caml_curses_mvwaddstr"
+(* lots more omitted *)
diff --git a/testsuite/tests/manual-intf-c/curses_stubs.c b/testsuite/tests/manual-intf-c/curses_stubs.c
new file mode 100644
index 00000000..dd390e89
--- /dev/null
+++ b/testsuite/tests/manual-intf-c/curses_stubs.c
@@ -0,0 +1,95 @@
+/* File curses_stubs.c -- stub code for curses */
+#include <curses.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+
+/* Encapsulation of opaque window handles (of type WINDOW *)
+   as OCaml custom blocks. */
+
+static struct custom_operations curses_window_ops = {
+  "fr.inria.caml.curses_windows",
+  custom_finalize_default,
+  custom_compare_default,
+  custom_hash_default,
+  custom_serialize_default,
+  custom_deserialize_default,
+  custom_compare_ext_default,
+  custom_fixed_length_default
+};
+
+/* Accessing the WINDOW * part of an OCaml custom block */
+#define Window_val(v) (*((WINDOW **) Data_custom_val(v)))
+
+/* Allocating an OCaml custom block to hold the given WINDOW * */
+static value alloc_window(WINDOW * w)
+{
+  value v = alloc_custom(&curses_window_ops, sizeof(WINDOW *), 0, 1);
+  Window_val(v) = w;
+  return v;
+}
+
+value caml_curses_initscr(value unit)
+{
+  CAMLparam1 (unit);
+  CAMLreturn (alloc_window(initscr()));
+}
+
+value caml_curses_endwin(value unit)
+{
+  CAMLparam1 (unit);
+  endwin();
+  CAMLreturn (Val_unit);
+}
+
+value caml_curses_refresh(value unit)
+{
+  CAMLparam1 (unit);
+  refresh();
+  CAMLreturn (Val_unit);
+}
+
+value caml_curses_wrefresh(value win)
+{
+  CAMLparam1 (win);
+  wrefresh(Window_val(win));
+  CAMLreturn (Val_unit);
+}
+
+value caml_curses_newwin(value nlines, value ncols, value x0, value y0)
+{
+  CAMLparam4 (nlines, ncols, x0, y0);
+  CAMLreturn (alloc_window(newwin(Int_val(nlines), Int_val(ncols),
+                                  Int_val(x0), Int_val(y0))));
+}
+
+value caml_curses_addch(value c)
+{
+  CAMLparam1 (c);
+  addch(Int_val(c));            /* Characters are encoded like integers */
+  CAMLreturn (Val_unit);
+}
+
+value caml_curses_mvwaddch(value win, value x, value y, value c)
+{
+  CAMLparam4 (win, x, y, c);
+  mvwaddch(Window_val(win), Int_val(x), Int_val(y), Int_val(c));
+  CAMLreturn (Val_unit);
+}
+
+value caml_curses_addstr(value s)
+{
+  CAMLparam1 (s);
+  addstr(String_val(s));
+  CAMLreturn (Val_unit);
+}
+
+value caml_curses_mvwaddstr(value win, value x, value y, value s)
+{
+  CAMLparam4 (win, x, y, s);
+  mvwaddstr(Window_val(win), Int_val(x), Int_val(y), String_val(s));
+  CAMLreturn (Val_unit);
+}
+
+/* This goes on for pages. */
diff --git a/testsuite/tests/manual-intf-c/prog.ml b/testsuite/tests/manual-intf-c/prog.ml
new file mode 100644
index 00000000..9a9e6845
--- /dev/null
+++ b/testsuite/tests/manual-intf-c/prog.ml
@@ -0,0 +1,21 @@
+(* TEST
+(* Tests from manual, section intf-c *)
+(*
+  This test is currently skipped because there is no proper way to
+  figure out whether Curses is available or not. If it becomes possible
+  to figure that out, it would be nice to be able to check that the test
+  compiles. Executing seems lessrelevant.
+*)
+* skip
+reason = "curses can not be properly detected at the moment"
+*)
+
+(* File prog.ml -- main program using curses *)
+open Curses;;
+let main_window = initscr () in
+let small_window = newwin 10 5 20 10 in
+  mvwaddstr main_window 10 2 "Hello";
+  mvwaddstr small_window 4 3 "world";
+  refresh();
+  Unix.sleep 5;
+  endwin()
diff --git a/testsuite/tests/manual-intf-c/prog2.reference b/testsuite/tests/manual-intf-c/prog2.reference
new file mode 100644
index 00000000..06f5553f
--- /dev/null
+++ b/testsuite/tests/manual-intf-c/prog2.reference
@@ -0,0 +1,2 @@
+File "curses_stubs.c", line 1:
+Error: Required module `Curses' is unavailable
diff --git a/testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml b/testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml
new file mode 100644
index 00000000..4a16ada8
--- /dev/null
+++ b/testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml
@@ -0,0 +1,93 @@
+(* TEST
+   * expect
+*)
+
+(** Test exhaustiveness.
+
+    match clauses should continue to give warnings about inexhaustive
+    value-matching clauses when there is an exception-matching clause
+ *)
+
+let test_match_exhaustiveness () =
+    match None with
+    | exception e -> ()
+    | Some false -> ()
+    | None -> ()
+;;
+
+[%%expect{|
+Lines 8-11, characters 4-16:
+ 8 | ....match None with
+ 9 |     | exception e -> ()
+10 |     | Some false -> ()
+11 |     | None -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Some true
+val test_match_exhaustiveness : unit -> unit = <fun>
+|}]
+;;
+
+let test_match_exhaustiveness_nest1 () =
+    match None with
+    | Some false -> ()
+    | None | exception _ -> ()
+;;
+
+[%%expect{|
+Lines 2-4, characters 4-30:
+2 | ....match None with
+3 |     | Some false -> ()
+4 |     | None | exception _ -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Some true
+val test_match_exhaustiveness_nest1 : unit -> unit = <fun>
+|}]
+;;
+
+let test_match_exhaustiveness_nest2 () =
+    match None with
+    | Some false | exception _ -> ()
+    | None -> ()
+;;
+
+[%%expect{|
+Lines 2-4, characters 4-16:
+2 | ....match None with
+3 |     | Some false | exception _ -> ()
+4 |     | None -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Some true
+val test_match_exhaustiveness_nest2 : unit -> unit = <fun>
+|}]
+;;
+
+let test_match_exhaustiveness_full () =
+    match None with
+    | exception e -> ()
+    | Some false | exception _ -> ()
+    | None | exception _ -> ()
+;;
+
+[%%expect{|
+Lines 2-5, characters 4-30:
+2 | ....match None with
+3 |     | exception e -> ()
+4 |     | Some false | exception _ -> ()
+5 |     | None | exception _ -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Some true
+Line 4, characters 29-30:
+4 |     | Some false | exception _ -> ()
+                                 ^
+Warning 11: this match case is unused.
+Line 5, characters 23-24:
+5 |     | None | exception _ -> ()
+                           ^
+Warning 11: this match case is unused.
+val test_match_exhaustiveness_full : unit -> unit = <fun>
+|}]
+;;
diff --git a/testsuite/tests/match-exception-warnings/no_mixing_under_guard.ml b/testsuite/tests/match-exception-warnings/no_mixing_under_guard.ml
new file mode 100644
index 00000000..225d5305
--- /dev/null
+++ b/testsuite/tests/match-exception-warnings/no_mixing_under_guard.ml
@@ -0,0 +1,21 @@
+(* TEST
+   * expect
+*)
+exception Exit
+
+let r = ref ""
+
+let guarded f =
+  match f () with
+  | true | exception Exit when r := "hello"; true -> !r
+  | _ -> "other"
+;;
+
+[%%expect{|
+exception Exit
+val r : string ref = {contents = ""}
+Line 7, characters 4-25:
+7 |   | true | exception Exit when r := "hello"; true -> !r
+        ^^^^^^^^^^^^^^^^^^^^^
+Error: Mixing value and exception patterns under when-guards is not supported.
+|}]
diff --git a/testsuite/tests/match-exception-warnings/no_value_clauses.ml b/testsuite/tests/match-exception-warnings/no_value_clauses.ml
new file mode 100644
index 00000000..77996e5b
--- /dev/null
+++ b/testsuite/tests/match-exception-warnings/no_value_clauses.ml
@@ -0,0 +1,15 @@
+(* TEST
+   * expect
+*)
+
+let test f =
+  match f () with exception Not_found -> ()
+;;
+
+[%%expect{|
+Line 2, characters 2-43:
+2 |   match f () with exception Not_found -> ()
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: None of the patterns in this 'match' expression match values.
+|}]
+;;
diff --git a/testsuite/tests/match-exception-warnings/placement.ml b/testsuite/tests/match-exception-warnings/placement.ml
new file mode 100644
index 00000000..c93247e3
--- /dev/null
+++ b/testsuite/tests/match-exception-warnings/placement.ml
@@ -0,0 +1,172 @@
+(* TEST
+   * expect
+*)
+
+(*****************************************************)
+(* Restrict where "exception P" patterns can appear. *)
+(*****************************************************)
+
+(* should be accepted *)
+
+let f x =
+  match x () with
+  | _ -> ()
+  | exception _ -> ()
+;;
+
+[%%expect{|
+val f : (unit -> 'a) -> unit = <fun>
+|}]
+;;
+
+let f x =
+  match x () with
+  | _ | exception _ -> ()
+;;
+
+[%%expect{|
+val f : (unit -> 'a) -> unit = <fun>
+|}]
+;;
+
+let f x =
+  match x () with
+  | Arg.(Set _ | exception Bad _) -> ()
+  | _ -> ()
+;;
+
+[%%expect{|
+val f : (unit -> Arg.spec) -> unit = <fun>
+|}]
+;;
+
+let f x =
+  match x () with
+  | _ -> ()
+  | (exception (_ : exn) : int) -> ()
+;;
+
+[%%expect{|
+val f : (unit -> int) -> unit = <fun>
+|}]
+;;
+
+(* should be rejected *)
+
+let f x =
+  try x (); ()
+  with exception _ -> ()
+;;
+
+[%%expect{|
+Line 3, characters 7-18:
+3 |   with exception _ -> ()
+           ^^^^^^^^^^^
+Error: Exception patterns are not allowed in this position.
+|}]
+;;
+
+let f x =
+  match x () with
+  | (exception _) as _pat -> ()
+  | _ -> ()
+;;
+
+[%%expect{|
+Line 3, characters 4-17:
+3 |   | (exception _) as _pat -> ()
+        ^^^^^^^^^^^^^
+Error: Exception patterns are not allowed in this position.
+|}]
+;;
+
+let f x =
+  match x () with
+  | (_, exception _, _) -> ()
+;;
+
+[%%expect{|
+Line 3, characters 8-19:
+3 |   | (_, exception _, _) -> ()
+            ^^^^^^^^^^^
+Error: Exception patterns are not allowed in this position.
+|}]
+;;
+
+let f x =
+  match x () with
+  | lazy (exception _) -> ()
+  | _ -> ()
+;;
+
+[%%expect{|
+Line 3, characters 9-22:
+3 |   | lazy (exception _) -> ()
+             ^^^^^^^^^^^^^
+Error: Exception patterns are not allowed in this position.
+|}]
+;;
+
+let f x =
+  match x () with
+  | { contents = exception _ } -> ()
+;;
+
+[%%expect{|
+Line 3, characters 17-28:
+3 |   | { contents = exception _ } -> ()
+                     ^^^^^^^^^^^
+Error: Exception patterns are not allowed in this position.
+|}]
+;;
+
+let f x =
+  match x () with
+  | [| exception _ |] -> ()
+;;
+
+[%%expect{|
+Line 3, characters 7-18:
+3 |   | [| exception _ |] -> ()
+           ^^^^^^^^^^^
+Error: Exception patterns are not allowed in this position.
+|}]
+;;
+
+let f x =
+  match x () with
+  | Some (exception _) -> ()
+;;
+
+[%%expect{|
+Line 3, characters 9-22:
+3 |   | Some (exception _) -> ()
+             ^^^^^^^^^^^^^
+Error: Exception patterns are not allowed in this position.
+|}]
+;;
+
+let f x =
+  match x () with
+  | `A (exception _) -> ()
+;;
+
+[%%expect{|
+Line 3, characters 7-20:
+3 |   | `A (exception _) -> ()
+           ^^^^^^^^^^^^^
+Error: Exception patterns are not allowed in this position.
+|}]
+;;
+
+let f = function
+  | exception _ -> ()
+  | _ -> ()
+;;
+
+[%%expect{|
+Line 2, characters 4-15:
+2 |   | exception _ -> ()
+        ^^^^^^^^^^^
+Error: Exception patterns are not allowed in this position.
+|}]
diff --git a/testsuite/tests/match-exception-warnings/pr7083.ml b/testsuite/tests/match-exception-warnings/pr7083.ml
new file mode 100644
index 00000000..cf8ddd64
--- /dev/null
+++ b/testsuite/tests/match-exception-warnings/pr7083.ml
@@ -0,0 +1,13 @@
+(* TEST
+   * expect
+*)
+
+let f x =
+  match x with
+  | `A -> ()
+  | exception Not_found -> ()
+;;
+
+[%%expect{|
+val f : [< `A ] -> unit = <fun>
+|}]
diff --git a/testsuite/tests/match-exception-warnings/reachability.ml b/testsuite/tests/match-exception-warnings/reachability.ml
new file mode 100644
index 00000000..7c56ca2f
--- /dev/null
+++ b/testsuite/tests/match-exception-warnings/reachability.ml
@@ -0,0 +1,61 @@
+(* TEST
+   * expect
+*)
+
+let f x =
+  match x with
+  | _ -> ()
+  | exception _ -> .
+;;
+
+[%%expect{|
+Line 4, characters 14-15:
+4 |   | exception _ -> .
+                  ^
+Error: This match case could not be refuted.
+       Here is an example of a value that would reach it: _
+|}]
+;;
+
+let f x =
+  match x with
+  | _ -> ()
+  | None | exception _ -> .
+;;
+
+[%%expect{|
+Line 4, characters 21-22:
+4 |   | None | exception _ -> .
+                         ^
+Error: This match case could not be refuted.
+       Here is an example of a value that would reach it: _
+|}]
+;;
+
+
+let f x =
+  match x with
+  | _ -> ()
+  | exception Not_found | None -> .
+;;
+
+
+[%%expect{|
+Line 4, characters 14-23:
+4 |   | exception Not_found | None -> .
+                  ^^^^^^^^^
+Error: This match case could not be refuted.
+       Here is an example of a value that would reach it: Not_found
+|}]
+;;
+
+let f x =
+  match x with
+  | _ | exception _ -> ()
+  | exception Not_found -> .
+;;
+
+[%%expect{|
+val f : 'a -> unit = <fun>
+|}]
+;;
diff --git a/testsuite/tests/match-exception/allocation.ml b/testsuite/tests/match-exception/allocation.ml
new file mode 100644
index 00000000..a99dc83e
--- /dev/null
+++ b/testsuite/tests/match-exception/allocation.ml
@@ -0,0 +1,28 @@
+(* TEST
+*)
+
+(** Test that matching multiple values doesn't allocate a block. *)
+
+let f x y =
+  match x, y with
+  | Some x, None
+  | None, Some x -> x + 1
+  | None, None -> 0
+  | Some x, Some y -> x + y
+  | exception _ -> -1
+
+let test_multiple_match_does_not_allocate =
+  let allocated_bytes = Gc.allocated_bytes () in
+  let allocated_bytes' = Gc.allocated_bytes () in
+  let a = Some 3 and b = None in
+  let allocated_bytes'' = Gc.allocated_bytes () in
+  let _ = f a b in
+  let allocated_bytes''' = Gc.allocated_bytes () in
+  if allocated_bytes' -. allocated_bytes
+     = allocated_bytes''' -. allocated_bytes''
+  then
+    Printf.printf "no allocations for multiple-value match\n"
+  else
+    Printf.printf "multiple-value match allocated %f bytes\n"
+      ((allocated_bytes''' -. allocated_bytes'') -.
+       (allocated_bytes' -. allocated_bytes))
diff --git a/testsuite/tests/match-exception/allocation.reference b/testsuite/tests/match-exception/allocation.reference
new file mode 100644
index 00000000..98056ce6
--- /dev/null
+++ b/testsuite/tests/match-exception/allocation.reference
@@ -0,0 +1 @@
+no allocations for multiple-value match
diff --git a/testsuite/tests/match-exception/exception_propagation.ml b/testsuite/tests/match-exception/exception_propagation.ml
new file mode 100644
index 00000000..759ec386
--- /dev/null
+++ b/testsuite/tests/match-exception/exception_propagation.ml
@@ -0,0 +1,20 @@
+(* TEST
+*)
+
+(**
+   Test that match allows exceptions to propagate.
+*)
+let () =
+  try
+    match
+      (let _ = raise Not_found in
+       assert false)
+    with
+    | _ -> assert false
+    | exception Invalid_argument _ -> assert false
+  with
+    Not_found ->
+      print_endline "caught expected exception (Not_found)"
+  | _ ->
+    assert false
+;;
diff --git a/testsuite/tests/match-exception/exception_propagation.reference b/testsuite/tests/match-exception/exception_propagation.reference
new file mode 100644
index 00000000..a119b681
--- /dev/null
+++ b/testsuite/tests/match-exception/exception_propagation.reference
@@ -0,0 +1 @@
+caught expected exception (Not_found)
diff --git a/testsuite/tests/match-exception/identifier_sharing.ml b/testsuite/tests/match-exception/identifier_sharing.ml
new file mode 100644
index 00000000..e0bb3890
--- /dev/null
+++ b/testsuite/tests/match-exception/identifier_sharing.ml
@@ -0,0 +1,9 @@
+(* TEST
+*)
+
+exception String of string
+
+let _ =
+  match "foo" with
+  | str | exception (String str) -> print_endline str
+  | exception _ -> print_endline "unexpected exception!"
diff --git a/testsuite/tests/match-exception/identifier_sharing.reference b/testsuite/tests/match-exception/identifier_sharing.reference
new file mode 100644
index 00000000..257cc564
--- /dev/null
+++ b/testsuite/tests/match-exception/identifier_sharing.reference
@@ -0,0 +1 @@
+foo
diff --git a/testsuite/tests/match-exception/match_failure.ml b/testsuite/tests/match-exception/match_failure.ml
new file mode 100644
index 00000000..a6c3d812
--- /dev/null
+++ b/testsuite/tests/match-exception/match_failure.ml
@@ -0,0 +1,22 @@
+(* TEST
+*)
+
+(**
+   Test that value match failure in a match block raises Match_failure.
+*)
+let return_some_3 () = Some (1 + 2)
+;;
+
+let test_match_partial_match =
+  try
+    let _ = (match return_some_3 () with
+    | Some x when x < 3 -> "Some x"
+    | exception Failure _ -> "failure"
+    | exception Invalid_argument _ -> "invalid argument"
+    | None -> "None"
+    ) [@ocaml.warning "-8"] in
+    assert false
+  with
+    Match_failure _ ->
+      print_endline "match failure, as expected"
+;;
diff --git a/testsuite/tests/match-exception/match_failure.reference b/testsuite/tests/match-exception/match_failure.reference
new file mode 100644
index 00000000..6e17840f
--- /dev/null
+++ b/testsuite/tests/match-exception/match_failure.reference
@@ -0,0 +1 @@
+match failure, as expected
diff --git a/testsuite/tests/match-exception/nested_handlers.ml b/testsuite/tests/match-exception/nested_handlers.ml
new file mode 100644
index 00000000..6f019d4b
--- /dev/null
+++ b/testsuite/tests/match-exception/nested_handlers.ml
@@ -0,0 +1,48 @@
+(* TEST
+*)
+
+(*
+  Test that multiple handlers coexist happily.
+*)
+
+let test_multiple_handlers =
+  let trace = ref [] in
+  let collect v = trace := v :: !trace in
+  let _ =
+    match
+      begin
+        match
+          begin
+            collect "one";
+            failwith "two"
+          end
+        with
+          () -> collect "failure one"
+        | exception (Failure x) ->
+          collect x;
+          failwith "three"
+      end
+    with
+      () ->
+        collect "failure two";
+    | exception (Failure x) ->
+      collect x;
+      match
+        begin
+          collect "four";
+          failwith "five"
+        end
+      with
+        () -> collect "failure three"
+      | exception (Failure x) ->
+        collect x
+  in
+  print_endline (String.concat " " !trace);
+  assert (!trace = [
+    "five";
+    "four";
+    "three";
+    "two";
+    "one";
+  ])
+;;
diff --git a/testsuite/tests/match-exception/nested_handlers.reference b/testsuite/tests/match-exception/nested_handlers.reference
new file mode 100644
index 00000000..e3052866
--- /dev/null
+++ b/testsuite/tests/match-exception/nested_handlers.reference
@@ -0,0 +1 @@
+five four three two one
diff --git a/testsuite/tests/match-exception/raise_from_success_continuation.ml b/testsuite/tests/match-exception/raise_from_success_continuation.ml
new file mode 100644
index 00000000..69a82371
--- /dev/null
+++ b/testsuite/tests/match-exception/raise_from_success_continuation.ml
@@ -0,0 +1,18 @@
+(* TEST
+*)
+
+(**
+  Test raising exceptions from a value-matching branch.
+*)
+let test_raise_from_val_handler =
+  let () = print_endline "test raise from val handler" in
+  let g () = List.find ((=)2) [1;2;4] in
+  let h () =
+    match
+      g ()
+    with exception _ -> 10
+    | _ -> raise Not_found
+  in
+  assert ((try h () with Not_found -> 20) = 20);
+  print_endline "raise from val handler succeeded"
+;;
diff --git a/testsuite/tests/match-exception/raise_from_success_continuation.reference b/testsuite/tests/match-exception/raise_from_success_continuation.reference
new file mode 100644
index 00000000..4cfe2160
--- /dev/null
+++ b/testsuite/tests/match-exception/raise_from_success_continuation.reference
@@ -0,0 +1,2 @@
+test raise from val handler
+raise from val handler succeeded
diff --git a/testsuite/tests/match-exception/streams.ml b/testsuite/tests/match-exception/streams.ml
new file mode 100644
index 00000000..b4382271
--- /dev/null
+++ b/testsuite/tests/match-exception/streams.ml
@@ -0,0 +1,40 @@
+(* TEST
+*)
+
+(**
+   Test the stream example .
+*)
+type stream = Stream of (int * stream Lazy.t)
+;;
+
+exception End_of_stream
+;;
+
+let make_stream_up_to n =
+  let rec loop i =
+    if i = n then Stream (i, lazy (raise End_of_stream))
+    else Stream (i, lazy (loop (i + 1)))
+  in loop 0
+;;
+
+let stream_get (Stream (x, s)) = (x, Lazy.force s)
+;;
+
+let rec iter_stream_match f s =
+  match stream_get s
+  with exception End_of_stream -> ()
+  | (x, s') ->
+    begin
+      f x;
+      iter_stream_match f s'
+    end
+;;
+
+let test_iter_stream =
+  let limit = 10000000 in
+  try
+    iter_stream_match ignore (make_stream_up_to limit);
+    print_endline "iter_stream with handler case (match) is tail recursive"
+  with Stack_overflow ->
+    assert false
+;;
diff --git a/testsuite/tests/match-exception/streams.reference b/testsuite/tests/match-exception/streams.reference
new file mode 100644
index 00000000..13df4640
--- /dev/null
+++ b/testsuite/tests/match-exception/streams.reference
@@ -0,0 +1 @@
+iter_stream with handler case (match) is tail recursive
diff --git a/testsuite/tests/match-exception/tail_calls.ml b/testsuite/tests/match-exception/tail_calls.ml
new file mode 100644
index 00000000..ae72fc93
--- /dev/null
+++ b/testsuite/tests/match-exception/tail_calls.ml
@@ -0,0 +1,24 @@
+(* TEST
+*)
+
+(**
+    The success continuation expression is in tail position.
+*)
+
+let count_to_tr_match n =
+  let rec loop i =
+    match
+      i < n
+    with exception Not_found -> ()
+    | false -> ()
+    | true -> loop (i + 1)
+  in loop 0
+;;
+
+let test_tail_recursion =
+  try
+    count_to_tr_match 10000000;
+    print_endline "handler-case (match) is tail recursive"
+  with _ ->
+    assert false
+;;
diff --git a/testsuite/tests/match-exception/tail_calls.reference b/testsuite/tests/match-exception/tail_calls.reference
new file mode 100644
index 00000000..342bf24a
--- /dev/null
+++ b/testsuite/tests/match-exception/tail_calls.reference
@@ -0,0 +1 @@
+handler-case (match) is tail recursive
diff --git a/testsuite/tests/messages/precise_locations.ml b/testsuite/tests/messages/precise_locations.ml
new file mode 100644
index 00000000..efbc15a4
--- /dev/null
+++ b/testsuite/tests/messages/precise_locations.ml
@@ -0,0 +1,111 @@
+(* TEST
+  * expect
+*)
+
+type t = (unit, unit, unit, unit) bar
+;;
+(* PR#7315: we expect the error location on "bar" instead of "(...) bar" *)
+[%%expect{|
+Line 1, characters 34-37:
+1 | type t = (unit, unit, unit, unit) bar
+                                      ^^^
+Error: Unbound type constructor bar
+|}];;
+
+function (x :
+#bar) -> ();;
+(* we expect the location on "bar" instead of "#bar" *)
+[%%expect{|
+Line 2, characters 1-4:
+2 | #bar) -> ();;
+     ^^^
+Error: Unbound class type bar
+|}];;
+
+function
+#bar -> ()
+;;
+(* we expect the location on "bar" instead of "#bar" *)
+[%%expect{|
+Line 2, characters 1-4:
+2 | #bar -> ()
+     ^^^
+Error: Unbound type constructor bar
+|}];;
+
+new bar;;
+(* we expect the location on "bar" instead of "new bar" *)
+[%%expect{|
+Line 1, characters 4-7:
+1 | new bar;;
+        ^^^
+Error: Unbound class bar
+|}];;
+
+type t =
+  | Foo of unit [@deprecated]
+  | Bar;;
+#warnings "@3";;
+let x =
+Foo ();;
+
+[%%expect{|
+type t = Foo of unit | Bar
+Line 6, characters 0-3:
+6 | Foo ();;
+    ^^^
+Error (alert deprecated): Foo
+|}];;
+function
+Foo _ -> () | Bar -> ();;
+
+[%%expect{|
+Line 2, characters 0-3:
+2 | Foo _ -> () | Bar -> ();;
+    ^^^
+Error (alert deprecated): Foo
+|}];;
+
+
+open Foo;;
+(* the error location should be on "Foo" *)
+[%%expect{|
+Line 1, characters 5-8:
+1 | open Foo;;
+         ^^^
+Error: Unbound module Foo
+|}];;
+
+#warnings "@33";; (* unused open statement *)
+include (struct
+open List
+end);;
+(* here we expect the error location to be
+   on "open List" as whole rather than "List" *)
+[%%expect{|
+Line 2, characters 0-9:
+2 | open List
+    ^^^^^^^^^
+Error (warning 33): unused open Stdlib.List.
+|}];;
+
+type unknown += Foo;;
+(* unknown, not the whole line *)
+[%%expect{|
+Line 1, characters 5-12:
+1 | type unknown += Foo;;
+         ^^^^^^^
+Error: Unbound type constructor unknown
+|}];;
+
+type t = ..;;
+type t +=
+Foo = Foobar;;
+(* Foobar, not the whole line *)
+[%%expect{|
+type t = ..
+Line 3, characters 6-12:
+3 | Foo = Foobar;;
+          ^^^^^^
+Error: Unbound constructor Foobar
+|}];;
diff --git a/testsuite/tests/misc-kb/equations.ml b/testsuite/tests/misc-kb/equations.ml
new file mode 100644
index 00000000..c8dbff05
--- /dev/null
+++ b/testsuite/tests/misc-kb/equations.ml
@@ -0,0 +1,100 @@
+(****************** Equation manipulations *************)
+
+open Terms
+
+type rule =
+  { number: int;
+    numvars: int;
+    lhs: term;
+    rhs: term }
+
+(* standardizes an equation so its variables are 1,2,... *)
+
+let mk_rule num m n =
+  let all_vars = union (vars m) (vars n) in
+  let counter = ref 0 in
+  let subst =
+    List.map (fun v -> incr counter; (v, Var !counter)) (List.rev all_vars) in
+  { number = num;
+    numvars = !counter;
+    lhs = substitute subst m;
+    rhs = substitute subst n }
+
+
+(* checks that rules are numbered in sequence and returns their number *)
+
+let check_rules rules =
+  let counter = ref 0 in
+  List.iter (fun r -> incr counter;
+                 if r.number <> !counter
+                 then failwith "Rule numbers not in sequence")
+       rules;
+  !counter
+
+
+let pretty_rule rule =
+  print_int rule.number; print_string " : ";
+  pretty_term rule.lhs; print_string " = "; pretty_term rule.rhs;
+  print_newline()
+
+
+let pretty_rules rules = List.iter pretty_rule rules
+
+(****************** Rewriting **************************)
+
+(* Top-level rewriting. Let eq:L=R be an equation, M be a term such that L<=M.
+   With sigma = matching L M, we define the image of M by eq as sigma(R) *)
+let reduce l m r =
+  substitute (matching l m) r
+
+(* Test whether m can be reduced by l, i.e. m contains an instance of l. *)
+
+let can_match l m =
+  try let _ = matching l m in true
+  with Failure _ -> false
+
+let rec reducible l m =
+  can_match l m ||
+   (match m with
+    | Term(_,sons) -> List.exists (reducible l) sons
+    |         _     -> false)
+
+(* Top-level rewriting with multiple rules. *)
+
+let rec mreduce rules m =
+  match rules with
+    [] -> failwith "mreduce"
+  | rule::rest ->
+      try
+        reduce rule.lhs m rule.rhs
+      with Failure _ ->
+        mreduce rest m
+
+
+(* One step of rewriting in leftmost-outermost strategy,
+   with multiple rules. Fails if no redex is found *)
+
+let rec mrewrite1 rules m =
+  try
+    mreduce rules m
+  with Failure _ ->
+    match m with
+      Var n -> failwith "mrewrite1"
+    | Term(f, sons) -> Term(f, mrewrite1_sons rules sons)
+
+and mrewrite1_sons rules = function
+    [] -> failwith "mrewrite1"
+  | son::rest ->
+      try
+        mrewrite1 rules son :: rest
+      with Failure _ ->
+        son :: mrewrite1_sons rules rest
+
+
+(* Iterating rewrite1. Returns a normal form. May loop forever *)
+
+let rec mrewrite_all rules m =
+  try
+    mrewrite_all rules (mrewrite1 rules m)
+  with Failure _ ->
+    m
diff --git a/testsuite/tests/misc-kb/equations.mli b/testsuite/tests/misc-kb/equations.mli
new file mode 100644
index 00000000..99055ce2
--- /dev/null
+++ b/testsuite/tests/misc-kb/equations.mli
@@ -0,0 +1,18 @@
+open Terms
+
+type rule =
+  { number: int;
+    numvars: int;
+    lhs: term;
+    rhs: term }
+
+val mk_rule: int -> term -> term -> rule
+val check_rules: rule list -> int
+val pretty_rule: rule -> unit
+val pretty_rules: rule list -> unit
+val reduce: term -> term -> term -> term
+val reducible: term -> term -> bool
+val mreduce: rule list -> term -> term
+val mrewrite1: rule list -> term -> term
+val mrewrite1_sons: rule list -> term list -> term list
+val mrewrite_all: rule list -> term -> term
diff --git a/testsuite/tests/misc-kb/kb.ml b/testsuite/tests/misc-kb/kb.ml
new file mode 100644
index 00000000..1e5fd2c7
--- /dev/null
+++ b/testsuite/tests/misc-kb/kb.ml
@@ -0,0 +1,173 @@
+open Terms
+open Equations
+
+(****************** Critical pairs *********************)
+
+(* All (u,subst) such that N/u (&var) unifies with M,
+   with principal unifier subst *)
+
+let rec super m = function
+    Term(_,sons) as n ->
+      let rec collate n = function
+        [] -> []
+      | son::rest ->
+          List.map (fun (u, subst) -> (n::u, subst)) (super m son)
+          @ collate (n+1) rest in
+      let insides = collate 1 sons in
+        begin try
+          ([], unify m n) :: insides
+        with Failure _ ->
+          insides
+        end
+  | _ -> []
+
+
+(* Ex :
+let (m,_) = <<F(A,B)>>
+and (n,_) = <<H(F(A,x),F(x,y))>> in super m n
+==> [[1],[2,Term ("B",[])];                      x <- B
+     [2],[2,Term ("A",[]); 1,Term ("B",[])]]     x <- A  y <- B
+*)
+
+(* All (u,subst), u&[], such that n/u unifies with m *)
+
+let super_strict m = function
+    Term(_,sons) ->
+      let rec collate n = function
+        [] -> []
+      | son::rest ->
+          List.map (fun (u, subst) -> (n::u, subst)) (super m son)
+          @ collate (n+1) rest in
+      collate 1 sons
+    | _ -> []
+
+
+(* Critical pairs of l1=r1 with l2=r2 *)
+(* critical_pairs : term_pair -> term_pair -> term_pair list *)
+let critical_pairs (l1,r1) (l2,r2) =
+  let mk_pair (u,subst) =
+     substitute subst (replace l2 u r1), substitute subst r2 in
+  List.map mk_pair (super l1 l2)
+
+(* Strict critical pairs of l1=r1 with l2=r2 *)
+(* strict_critical_pairs : term_pair -> term_pair -> term_pair list *)
+let strict_critical_pairs (l1,r1) (l2,r2) =
+  let mk_pair (u,subst) =
+    substitute subst (replace l2 u r1), substitute subst r2 in
+  List.map mk_pair (super_strict l1 l2)
+
+
+(* All critical pairs of eq1 with eq2 *)
+let mutual_critical_pairs eq1 eq2 =
+  (strict_critical_pairs eq1 eq2) @ (critical_pairs eq2 eq1)
+
+(* Renaming of variables *)
+
+let rename n (t1,t2) =
+  let rec ren_rec = function
+    Var k -> Var(k+n)
+  | Term(op,sons) -> Term(op, List.map ren_rec sons) in
+  (ren_rec t1, ren_rec t2)
+
+
+(************************ Completion ******************************)
+
+let deletion_message rule =
+  print_string "Rule ";print_int rule.number; print_string " deleted";
+  print_newline()
+
+
+(* Generate failure message *)
+let non_orientable (m,n) =
+    pretty_term m; print_string " = "; pretty_term n; print_newline()
+
+
+let rec partition p = function
+    [] -> ([], [])
+  | x::l -> let (l1, l2) = partition p l in
+            if p x then (x::l1, l2) else (l1, x::l2)
+
+
+let rec get_rule n = function
+    [] -> raise Not_found
+  | r::l -> if n = r.number then r else get_rule n l
+
+
+(* Improved Knuth-Bendix completion procedure *)
+
+let kb_completion greater =
+  let rec kbrec j rules =
+  let rec process failures (k,l) eqs =
+(****
+     print_string "***kb_completion "; print_int j; print_newline();
+     pretty_rules rules;
+     List.iter non_orientable failures;
+     print_int k; print_string " "; print_int l; print_newline();
+     List.iter non_orientable eqs;
+***)
+    match eqs with
+      [] ->
+        if k<l then next_criticals failures (k+1,l) else
+        if l<j then next_criticals failures (1,l+1) else
+        begin match failures with
+            [] -> rules (* successful completion *)
+          | _  -> print_string "Non-orientable equations :"; print_newline();
+                  List.iter non_orientable failures;
+                  failwith "kb_completion"
+        end
+    | (m,n)::eqs ->
+        let m' = mrewrite_all rules m
+        and n' = mrewrite_all rules n
+        and enter_rule(left,right) =
+          let new_rule = mk_rule (j+1) left right in
+          pretty_rule new_rule;
+          let left_reducible rule = reducible left rule.lhs in
+          let (redl,irredl) = partition left_reducible rules in
+          List.iter deletion_message redl;
+          let right_reduce rule =
+            mk_rule rule.number rule.lhs
+                    (mrewrite_all (new_rule::rules) rule.rhs) in
+          let irreds = List.map right_reduce irredl in
+          let eqs' = List.map (fun rule -> (rule.lhs, rule.rhs)) redl in
+          kbrec (j+1) (new_rule::irreds) [] (k,l) (eqs @ eqs' @ failures) in
+(***
+        print_string "--- Considering "; non_orientable (m', n');
+***)
+        if m' = n' then process failures (k,l) eqs else
+        if greater(m',n') then enter_rule(m',n') else
+        if greater(n',m') then enter_rule(n',m') else
+        process ((m',n')::failures) (k,l) eqs
+
+  and next_criticals failures (k,l) =
+(****
+    print_string "***next_criticals ";
+    print_int k; print_string " "; print_int l ; print_newline();
+****)
+    try
+      let rl = get_rule l rules in
+      let el = (rl.lhs, rl.rhs) in
+        if k=l then
+          process failures (k,l)
+                  (strict_critical_pairs el (rename rl.numvars el))
+        else
+          try
+            let rk = get_rule k rules in
+            let ek = (rk.lhs, rk.rhs) in
+              process failures (k,l)
+                      (mutual_critical_pairs el (rename rl.numvars ek))
+          with Not_found -> next_criticals failures (k+1,l)
+    with Not_found -> next_criticals failures (1,l+1)
+  in process
+  in kbrec
+
+
+(* complete_rules is assumed locally confluent, and checked Noetherian with
+  ordering greater, rules is any list of rules *)
+
+let kb_complete greater complete_rules rules =
+    let n = check_rules complete_rules
+    and eqs = List.map (fun rule -> (rule.lhs, rule.rhs)) rules in
+    let completed_rules =
+      kb_completion greater n complete_rules [] (n,n) eqs in
+    print_string "Canonical set found :"; print_newline();
+    pretty_rules (List.rev completed_rules)
diff --git a/testsuite/tests/misc-kb/kb.mli b/testsuite/tests/misc-kb/kb.mli
new file mode 100644
index 00000000..32768716
--- /dev/null
+++ b/testsuite/tests/misc-kb/kb.mli
@@ -0,0 +1,17 @@
+open Terms
+open Equations
+
+val super: term -> term -> (int list * (int * term) list) list
+val super_strict: term -> term -> (int list * (int * term) list) list
+val critical_pairs: term * term -> term * term -> (term * term) list
+val strict_critical_pairs: term * term -> term * term -> (term * term) list
+val mutual_critical_pairs: term * term -> term * term -> (term * term) list
+val rename: int -> term * term -> term * term
+val deletion_message: rule -> unit
+val non_orientable: term * term -> unit
+val partition: ('a -> bool) -> 'a list -> 'a list * 'a list
+val get_rule: int -> rule list -> rule
+val kb_completion:
+    (term * term -> bool) -> int -> rule list -> (term * term) list
+    -> int * int -> (term * term) list -> rule list
+val kb_complete: (term * term -> bool) -> rule list -> rule list -> unit
diff --git a/testsuite/tests/misc-kb/kbmain.ml b/testsuite/tests/misc-kb/kbmain.ml
new file mode 100644
index 00000000..6e94ecd0
--- /dev/null
+++ b/testsuite/tests/misc-kb/kbmain.ml
@@ -0,0 +1,71 @@
+(* TEST
+   modules = "terms.ml equations.ml orderings.ml kb.ml"
+*)
+
+open Terms
+open Equations
+open Orderings
+open Kb
+
+(****
+let group_rules = [
+  { number = 1; numvars = 1;
+    lhs = Term("*", [Term("U",[]); Var 1]); rhs = Var 1 };
+  { number = 2; numvars = 1;
+    lhs = Term("*", [Term("I",[Var 1]); Var 1]); rhs = Term("U",[]) };
+  { number = 3; numvars = 3;
+    lhs = Term("*", [Term("*", [Var 1; Var 2]); Var 3]);
+    rhs = Term("*", [Var 1; Term("*", [Var 2; Var 3])]) }
+]
+****)
+
+let geom_rules = [
+  { number = 1; numvars = 1;
+    lhs = Term ("*",[(Term ("U",[])); (Var 1)]);
+    rhs = Var 1 };
+  { number = 2; numvars = 1;
+    lhs = Term ("*",[(Term ("I",[(Var 1)])); (Var 1)]);
+    rhs = Term ("U",[]) };
+  { number = 3; numvars = 3;
+    lhs = Term ("*",[(Term ("*",[(Var 1); (Var 2)])); (Var 3)]);
+    rhs = Term ("*",[(Var 1); (Term ("*",[(Var 2); (Var 3)]))]) };
+  { number = 4; numvars = 0;
+    lhs = Term ("*",[(Term ("A",[])); (Term ("B",[]))]);
+    rhs = Term ("*",[(Term ("B",[])); (Term ("A",[]))]) };
+  { number = 5; numvars = 0;
+    lhs = Term ("*",[(Term ("C",[])); (Term ("C",[]))]);
+    rhs = Term ("U",[]) };
+  { number = 6; numvars = 0;
+    lhs = Term("*",
+            [(Term ("C",[]));
+             (Term ("*",[(Term ("A",[])); (Term ("I",[(Term ("C",[]))]))]))]);
+    rhs = Term ("I",[(Term ("A",[]))]) };
+  { number = 7; numvars = 0;
+    lhs = Term("*",
+            [(Term ("C",[]));
+             (Term ("*",[(Term ("B",[])); (Term ("I",[(Term ("C",[]))]))]))]);
+    rhs = Term ("B",[]) }
+]
+
+let group_rank = function
+    "U" -> 0
+  | "*" -> 1
+  | "I" -> 2
+  | "B" -> 3
+  | "C" -> 4
+  | "A" -> 5
+  | _ -> assert false
+
+let group_precedence op1 op2 =
+  let r1 = group_rank op1
+  and r2 = group_rank op2 in
+    if r1 = r2 then Equal else
+    if r1 > r2 then Greater else NotGE
+
+let group_order = rpo group_precedence lex_ext
+
+let greater pair =
+  match group_order pair with Greater -> true | _ -> false
+
+let _ =
+  kb_complete greater [] geom_rules
diff --git a/testsuite/tests/misc-kb/kbmain.reference b/testsuite/tests/misc-kb/kbmain.reference
new file mode 100644
index 00000000..758a0b4d
--- /dev/null
+++ b/testsuite/tests/misc-kb/kbmain.reference
@@ -0,0 +1,273 @@
+1 : U*v1 = v1
+2 : I(v1)*v1 = U
+3 : (v3*v2)*v1 = v3*(v2*v1)
+4 : A*B = B*A
+5 : C*C = U
+6 : I(A) = C*(A*I(C))
+7 : C*(B*I(C)) = B
+8 : I(v2)*(v2*v1) = v1
+9 : A*(B*v1) = B*(A*v1)
+10 : C*(C*v1) = v1
+11 : C*(A*(I(C)*A)) = U
+12 : C*(B*(I(C)*v1)) = B*v1
+13 : I(U)*v1 = v1
+14 : I(I(v1))*U = v1
+15 : I(v3*v2)*(v3*(v2*v1)) = v1
+16 : C*(A*(I(C)*(B*A))) = B
+17 : I(C)*U = C
+18 : C*(A*(I(C)*(A*v1))) = v1
+19 : I(C)*B = B*I(C)
+20 : I(I(v2))*v1 = v2*v1
+Rule 14 deleted
+21 : v1*U = v1
+Rule 17 deleted
+22 : I(C) = C
+Rule 19 deleted
+Rule 18 deleted
+Rule 16 deleted
+Rule 12 deleted
+Rule 11 deleted
+Rule 7 deleted
+23 : C*B = B*C
+24 : C*(A*(C*(A*v1))) = v1
+25 : C*(A*(C*(B*A))) = B
+26 : C*(B*(C*v1)) = B*v1
+27 : C*(A*(C*A)) = U
+28 : C*(B*C) = B
+29 : C*(A*(C*(B*(A*v1)))) = B*v1
+30 : I(I(v2*v1)*v2) = v1
+31 : I(v2*I(v1))*v2 = v1
+32 : I(v4*(v3*v2))*(v4*(v3*(v2*v1))) = v1
+33 : I(v1*A)*(v1*(B*A)) = B
+34 : I(v1*C)*v1 = C
+35 : I(v3*I(v2))*(v3*v1) = v2*v1
+36 : I(v2*A)*(v2*(B*(A*v1))) = B*v1
+37 : I(v2*C)*(v2*v1) = C*v1
+38 : v1*I(v1) = U
+39 : I(C*(A*C))*v1 = A*v1
+40 : v2*(I(v2)*v1) = v1
+41 : I(U) = U
+Rule 13 deleted
+42 : I(I(v1)) = v1
+Rule 20 deleted
+43 : C*(B*v1) = B*(C*v1)
+Rule 29 deleted
+Rule 28 deleted
+Rule 26 deleted
+Rule 25 deleted
+44 : A*(C*(A*v1)) = C*v1
+Rule 24 deleted
+45 : A*(C*A) = C
+Rule 27 deleted
+46 : v2*(I(v1*v2)*v1) = U
+47 : I(I(v3*(v2*v1))*(v3*v2)) = v1
+48 : I(I(B*A)*A) = B
+49 : v3*(I(v2*v3)*(v2*v1)) = v1
+50 : I(I(v1)*I(v2)) = v2*v1
+51 : I(I(B*(A*v1))*A) = B*v1
+52 : I(I(v1)*C) = C*v1
+53 : I(v2*I(v1*v2)) = v1
+54 : I(v3*(v2*I(v1)))*(v3*v2) = v1
+55 : I(v1*(C*(A*C)))*v1 = A
+56 : v2*I(I(v1)*v2) = v1
+57 : I(v2*(I(v3*v1)*v3))*v2 = v1
+58 : I(v5*(v4*(v3*v2)))*(v5*(v4*(v3*(v2*v1)))) = v1
+59 : I(v2*(v1*A))*(v2*(v1*(B*A))) = B
+60 : I(v2*(v1*C))*(v2*v1) = C
+61 : I(v4*(v3*I(v2)))*(v4*(v3*v1)) = v2*v1
+62 : I(v3*(v2*A))*(v3*(v2*(B*(A*v1)))) = B*v1
+63 : I(v3*(v2*C))*(v3*(v2*v1)) = C*v1
+64 : I(v3*(I(v4*v2)*v4))*(v3*v1) = v2*v1
+65 : v4*(I(v3*(v2*v4))*(v3*(v2*v1))) = v1
+66 : I(I(B)*A)*A = B
+67 : I(A*A)*(B*(A*A)) = B
+68 : v1*(I(A*v1)*(B*A)) = B
+69 : I(I(v1*A)*(v1*B))*B = A
+70 : v1*I(C*v1) = C
+71 : I(A*I(v1))*(B*A) = v1*B
+72 : I(C*I(v1)) = v1*C
+73 : I(v2*(C*(A*C)))*(v2*v1) = A*v1
+74 : I(A*I(v2))*(B*(A*v1)) = v2*(B*v1)
+75 : v3*(I(I(v2)*v3)*v1) = v2*v1
+76 : I(I(B*I(v1))*A)*(v1*A) = B
+77 : I(v1*A)*(v1*(B*(B*A))) = B*B
+78 : I(I(B)*A)*(A*v1) = B*v1
+79 : I(A*A)*(B*(A*(A*v1))) = B*v1
+80 : I(v2*A)*(v2*(B*(B*(A*v1)))) = B*(B*v1)
+81 : v2*(I(A*v2)*(B*(A*v1))) = B*v1
+82 : I(I(v2*A)*(v2*B))*(B*v1) = A*v1
+83 : I(I(B*I(v2))*A)*(v2*(A*v1)) = B*v1
+84 : I(A*C)*(B*A) = B*C
+85 : I(A*C)*(B*(A*v1)) = B*(C*v1)
+86 : v2*(I(C*v2)*v1) = C*v1
+87 : I(I(B*C)*A)*(C*A) = B
+88 : I(I(B*C)*A)*(C*(A*v1)) = B*v1
+89 : v2*(v1*I(v2*v1)) = U
+90 : B*(A*I(B)) = A
+91 : I(v2*v1)*v2 = I(v1)
+Rule 64 deleted
+Rule 57 deleted
+Rule 55 deleted
+Rule 46 deleted
+Rule 34 deleted
+Rule 31 deleted
+Rule 30 deleted
+92 : I(C*(A*C)) = A
+Rule 39 deleted
+93 : I(v3*(v2*v1))*(v3*v2) = I(v1)
+Rule 60 deleted
+Rule 54 deleted
+Rule 47 deleted
+94 : I(v1*I(v2)) = v2*I(v1)
+Rule 83 deleted
+Rule 76 deleted
+Rule 74 deleted
+Rule 72 deleted
+Rule 71 deleted
+Rule 53 deleted
+Rule 50 deleted
+Rule 35 deleted
+95 : I(v2*(I(B)*A))*(v2*(A*v1)) = B*v1
+96 : I(v1*(I(B)*A))*(v1*A) = B
+97 : I(v1*A)*(v1*B) = B*(C*(A*C))
+Rule 82 deleted
+Rule 69 deleted
+98 : I(v1*C) = C*I(v1)
+Rule 88 deleted
+Rule 87 deleted
+Rule 85 deleted
+Rule 84 deleted
+Rule 52 deleted
+Rule 37 deleted
+99 : v3*(v2*(I(v3*v2)*v1)) = v1
+100 : B*(A*(I(B)*v1)) = A*v1
+101 : I(v3*v2)*(v3*v1) = I(v2)*v1
+Rule 97 deleted
+Rule 96 deleted
+Rule 95 deleted
+Rule 93 deleted
+Rule 80 deleted
+Rule 77 deleted
+Rule 73 deleted
+Rule 65 deleted
+Rule 63 deleted
+Rule 62 deleted
+Rule 61 deleted
+Rule 59 deleted
+Rule 58 deleted
+Rule 49 deleted
+Rule 36 deleted
+Rule 33 deleted
+Rule 32 deleted
+Rule 15 deleted
+102 : B*(C*I(B)) = C
+103 : B*(C*(I(B)*v1)) = C*v1
+104 : B*(I(B*A)*A) = U
+105 : B*(I(B*A)*(A*v1)) = v1
+106 : I(B*A)*A = I(B)
+Rule 104 deleted
+Rule 48 deleted
+107 : B*(v1*(I(B*(A*v1))*A)) = U
+108 : I(I(B*(B*A))*A) = B*B
+109 : B*(v2*(I(B*(A*v2))*(A*v1))) = v1
+110 : I(I(B*(B*(A*v1)))*A) = B*(B*v1)
+111 : I(I(B)*A) = B*(C*(A*C))
+Rule 78 deleted
+Rule 66 deleted
+112 : I(I(B*v1)*A) = B*(C*(A*(C*v1)))
+Rule 110 deleted
+Rule 108 deleted
+Rule 51 deleted
+113 : v3*(v2*I(I(v1)*(v3*v2))) = v1
+114 : v1*I(C*(A*(C*v1))) = A
+115 : I(I(v1)*v2) = I(v2)*v1
+Rule 113 deleted
+Rule 112 deleted
+Rule 111 deleted
+Rule 75 deleted
+Rule 56 deleted
+116 : v2*(v1*(I(A*(v2*v1))*(B*A))) = B
+117 : I(A*v1)*(B*A) = I(v1)*B
+Rule 116 deleted
+Rule 68 deleted
+118 : v2*(v1*I(C*(v2*v1))) = C
+119 : I(C*v1) = I(v1)*C
+Rule 118 deleted
+Rule 114 deleted
+Rule 92 deleted
+Rule 86 deleted
+Rule 70 deleted
+120 : v1*(I(A*(C*v1))*C) = A
+121 : I(A*A)*(B*(B*(A*A))) = B*B
+122 : I(A*A)*(B*(B*(A*(A*v1)))) = B*(B*v1)
+123 : I(A*A)*(B*(A*v1)) = B*(C*(A*(C*v1)))
+Rule 79 deleted
+Rule 67 deleted
+124 : v3*(v2*(I(A*(v3*v2))*(B*(A*v1)))) = B*v1
+125 : v1*(I(A*v1)*(B*(B*A))) = B*B
+126 : I(A*v2)*(B*(A*v1)) = I(v2)*(B*v1)
+Rule 124 deleted
+Rule 123 deleted
+Rule 81 deleted
+127 : v3*(v2*(v1*I(v3*(v2*v1)))) = U
+128 : v2*I(v1*v2) = I(v1)
+Rule 89 deleted
+129 : A*I(B) = I(B)*A
+Rule 90 deleted
+130 : I(v1*v2) = I(v2)*I(v1)
+Rule 128 deleted
+Rule 127 deleted
+Rule 126 deleted
+Rule 125 deleted
+Rule 122 deleted
+Rule 121 deleted
+Rule 120 deleted
+Rule 119 deleted
+Rule 117 deleted
+Rule 115 deleted
+Rule 109 deleted
+Rule 107 deleted
+Rule 106 deleted
+Rule 105 deleted
+Rule 101 deleted
+Rule 99 deleted
+Rule 98 deleted
+Rule 94 deleted
+Rule 91 deleted
+131 : B*(C*(A*(C*(I(B)*(A*v1))))) = v1
+132 : B*(C*(A*(C*(I(B)*A)))) = U
+133 : C*(A*(C*(I(B)*A))) = I(B)
+Rule 132 deleted
+134 : A*(I(B)*v1) = I(B)*(A*v1)
+Rule 100 deleted
+135 : C*I(B) = I(B)*C
+Rule 102 deleted
+136 : C*(I(B)*v1) = I(B)*(C*v1)
+Rule 133 deleted
+Rule 131 deleted
+Rule 103 deleted
+Canonical set found :
+1 : U*v1 = v1
+2 : I(v1)*v1 = U
+3 : (v3*v2)*v1 = v3*(v2*v1)
+4 : A*B = B*A
+5 : C*C = U
+6 : I(A) = C*(A*C)
+8 : I(v2)*(v2*v1) = v1
+9 : A*(B*v1) = B*(A*v1)
+10 : C*(C*v1) = v1
+21 : v1*U = v1
+22 : I(C) = C
+23 : C*B = B*C
+38 : v1*I(v1) = U
+40 : v2*(I(v2)*v1) = v1
+41 : I(U) = U
+42 : I(I(v1)) = v1
+43 : C*(B*v1) = B*(C*v1)
+44 : A*(C*(A*v1)) = C*v1
+45 : A*(C*A) = C
+129 : A*I(B) = I(B)*A
+130 : I(v1*v2) = I(v2)*I(v1)
+134 : A*(I(B)*v1) = I(B)*(A*v1)
+135 : C*I(B) = I(B)*C
+136 : C*(I(B)*v1) = I(B)*(C*v1)
diff --git a/testsuite/tests/misc-kb/orderings.ml b/testsuite/tests/misc-kb/orderings.ml
new file mode 100644
index 00000000..b6ef8abf
--- /dev/null
+++ b/testsuite/tests/misc-kb/orderings.ml
@@ -0,0 +1,84 @@
+(*********************** Recursive Path Ordering ****************************)
+
+open Terms
+
+type ordering =
+    Greater
+  | Equal
+  | NotGE
+
+let ge_ord order pair = match order pair with NotGE -> false | _ -> true
+and gt_ord order pair = match order pair with Greater -> true | _ -> false
+and eq_ord order pair = match order pair with Equal -> true | _ -> false
+
+
+let rec rem_eq equiv x = function
+     []  -> failwith "rem_eq"
+  | y::l -> if equiv (x,y) then l else y :: rem_eq equiv x l
+
+
+let diff_eq equiv (x,y) =
+  let rec diffrec = function
+      ([],_) as p -> p
+    | (h::t, y)   -> try
+                       diffrec (t, rem_eq equiv h y)
+                     with Failure _ ->
+                       let (x',y') = diffrec (t,y) in (h::x',y') in
+  if List.length x > List.length y then diffrec(y,x) else diffrec(x,y)
+
+
+(* Multiset extension of order *)
+
+let mult_ext order = function
+    Term(_,sons1), Term(_,sons2) ->
+      begin match diff_eq (eq_ord order) (sons1,sons2) with
+        ([],[]) -> Equal
+      | (l1,l2) ->
+           if List.for_all
+                (fun n -> List.exists (fun m -> gt_ord order (m,n)) l1) l2
+           then Greater else NotGE
+      end
+  | _ -> failwith "mult_ext"
+
+
+(* Lexicographic extension of order *)
+
+let lex_ext order = function
+    (Term(_,sons1) as m), (Term(_,sons2) as n) ->
+      let rec lexrec = function
+        ([] , []) -> Equal
+      | ([] , _ ) -> NotGE
+      | ( _ , []) -> Greater
+      | (x1::l1, x2::l2) ->
+          match order (x1,x2) with
+            Greater -> if List.for_all (fun n' -> gt_ord order (m,n')) l2
+                       then Greater else NotGE
+          | Equal -> lexrec (l1,l2)
+          | NotGE -> if List.exists (fun m' -> ge_ord order (m',n)) l1
+                     then Greater else NotGE in
+      lexrec (sons1, sons2)
+  | _ -> failwith "lex_ext"
+
+
+(* Recursive path ordering *)
+
+let rpo op_order ext =
+  let rec rporec (m,n) =
+    if m = n then Equal else
+      match m with
+          Var vm -> NotGE
+        | Term(op1,sons1) ->
+            match n with
+                Var vn ->
+                  if occurs vn m then Greater else NotGE
+              | Term(op2,sons2) ->
+                  match (op_order op1 op2) with
+                      Greater ->
+                        if List.for_all (fun n' -> gt_ord rporec (m,n')) sons2
+                        then Greater else NotGE
+                    | Equal ->
+                        ext rporec (m,n)
+                    | NotGE ->
+                        if List.exists (fun m' -> ge_ord rporec (m',n)) sons1
+                        then Greater else NotGE
+  in rporec
diff --git a/testsuite/tests/misc-kb/orderings.mli b/testsuite/tests/misc-kb/orderings.mli
new file mode 100644
index 00000000..d0493c52
--- /dev/null
+++ b/testsuite/tests/misc-kb/orderings.mli
@@ -0,0 +1,17 @@
+open Terms
+
+type ordering =
+    Greater
+  | Equal
+  | NotGE
+
+val ge_ord: ('a -> ordering) -> 'a -> bool
+val gt_ord: ('a -> ordering) -> 'a -> bool
+val eq_ord: ('a -> ordering) -> 'a -> bool
+val rem_eq: ('a * 'b -> bool) -> 'a -> 'b list -> 'b list
+val diff_eq: ('a * 'a -> bool) -> 'a list * 'a list -> 'a list * 'a list
+val mult_ext: (term * term -> ordering) -> term * term -> ordering
+val lex_ext: (term * term -> ordering) -> term * term -> ordering
+val rpo: (string -> string -> ordering) ->
+         ((term * term -> ordering) -> term * term -> ordering) ->
+         term * term -> ordering
diff --git a/testsuite/tests/misc-kb/terms.ml b/testsuite/tests/misc-kb/terms.ml
new file mode 100644
index 00000000..f66c86fa
--- /dev/null
+++ b/testsuite/tests/misc-kb/terms.ml
@@ -0,0 +1,121 @@
+(****************** Term manipulations *****************)
+
+type term =
+    Var of int
+  | Term of string * term list
+
+let rec union l1 l2 =
+  match l1 with
+    []   -> l2
+  | a::r -> if List.mem a l2 then union r l2 else a :: union r l2
+
+
+let rec vars = function
+    Var n -> [n]
+  | Term(_,l) -> vars_of_list l
+and vars_of_list = function
+    [] -> []
+  | t::r -> union (vars t) (vars_of_list r)
+
+
+let rec substitute subst = function
+    Term(oper,sons) -> Term(oper, List.map (substitute subst) sons)
+  | Var(n) as t     -> try List.assoc n subst with Not_found -> t
+
+
+(* Term replacement: replace M u N is M[u<-N]. *)
+
+let rec replace m u n =
+  match (u, m) with
+    [], _ -> n
+  | i::u, Term(oper, sons) -> Term(oper, replace_nth i sons u n)
+  | _ -> failwith "replace"
+
+and replace_nth i sons u n =
+  match sons with
+    s::r -> if i = 1
+            then replace s u n :: r
+            else s :: replace_nth (i-1) r u n
+  | []   -> failwith "replace_nth"
+
+
+(* Term matching. *)
+
+let matching term1 term2 =
+  let rec match_rec subst t1 t2 =
+    match (t1, t2) with
+      Var v, _ ->
+        if List.mem_assoc v subst then
+          if t2 = List.assoc v subst then subst else failwith "matching"
+        else
+          (v, t2) :: subst
+    | Term(op1,sons1), Term(op2,sons2) ->
+        if op1 = op2
+        then List.fold_left2 match_rec subst sons1 sons2
+        else failwith "matching"
+    | _ -> failwith "matching" in
+  match_rec [] term1 term2
+
+
+(* A naive unification algorithm. *)
+
+let compsubst subst1 subst2 =
+  (List.map (fun (v,t) -> (v, substitute subst1 t)) subst2) @ subst1
+
+
+let rec occurs n = function
+    Var m -> m = n
+  | Term(_,sons) -> List.exists (occurs n) sons
+
+
+let rec unify term1 term2 =
+  match (term1, term2) with
+    Var n1, _ ->
+      if term1 = term2 then []
+      else if occurs n1 term2 then failwith "unify"
+      else [n1, term2]
+  | term1, Var n2 ->
+      if occurs n2 term1 then failwith "unify"
+      else [n2, term1]
+  | Term(op1,sons1), Term(op2,sons2) ->
+      if op1 = op2 then
+        List.fold_left2 (fun s t1 t2 -> compsubst (unify (substitute s t1)
+                                                         (substitute s t2)) s)
+                   [] sons1 sons2
+      else failwith "unify"
+
+
+(* We need to print terms with variables independently from input terms
+  obtained by parsing. We give arbitrary names v1,v2,... to their variables.
+*)
+
+let infixes = ["+";"*"]
+
+let rec pretty_term = function
+    Var n ->
+      print_string "v"; print_int n
+  | Term (oper,sons) ->
+      if List.mem oper infixes then begin
+        match sons with
+            [s1;s2] ->
+              pretty_close s1; print_string oper; pretty_close s2
+          | _ ->
+              failwith "pretty_term : infix arity <> 2"
+      end else begin
+        print_string oper;
+        match sons with
+             []   -> ()
+          | t::lt -> print_string "(";
+                     pretty_term t;
+                     List.iter (fun t -> print_string ","; pretty_term t) lt;
+                     print_string ")"
+      end
+
+and pretty_close = function
+    Term(oper, _) as m ->
+      if List.mem oper infixes then begin
+        print_string "("; pretty_term m; print_string ")"
+      end else
+        pretty_term m
+  | m ->
+      pretty_term m
diff --git a/testsuite/tests/misc-kb/terms.mli b/testsuite/tests/misc-kb/terms.mli
new file mode 100644
index 00000000..81ec58e7
--- /dev/null
+++ b/testsuite/tests/misc-kb/terms.mli
@@ -0,0 +1,17 @@
+type term =
+    Var of int
+  | Term of string * term list
+
+val union: 'a list -> 'a list -> 'a list
+val vars: term -> int list
+val vars_of_list: term list -> int list
+val substitute: (int * term) list -> term -> term
+val replace: term -> int list -> term -> term
+val replace_nth: int -> term list -> int list -> term -> term list
+val matching: term -> term -> (int * term) list
+val compsubst: (int * term) list -> (int * term) list -> (int * term) list
+val occurs: int -> term -> bool
+val unify: term -> term -> (int * term) list
+val infixes: string list
+val pretty_term: term -> unit
+val pretty_close: term -> unit
diff --git a/testsuite/tests/misc-unsafe/almabench.ml b/testsuite/tests/misc-unsafe/almabench.ml
new file mode 100644
index 00000000..253db390
--- /dev/null
+++ b/testsuite/tests/misc-unsafe/almabench.ml
@@ -0,0 +1,331 @@
+(* TEST
+   flags += " -unsafe "
+*)
+
+(*
+ * ALMABENCH 1.0.1
+ *      OCaml     version
+ *
+ *     A number-crunching benchmark designed for cross-language and vendor
+ *     comparisons.
+ *
+ *     Written by Shawn Wagner, from Scott Robert Ladd's versions for
+ *      C++ and java.
+ *
+ *     No rights reserved. This is public domain software, for use by anyone.
+ *
+ *     This program calculates the daily ephemeris (at noon) for the years
+ *     2000-2099 using an algorithm developed by J.L. Simon, P. Bretagnon, J.
+ *     Chapront, M. Chapront-Touze, G. Francou and J. Laskar of the Bureau des
+ *     Longitudes, Paris, France), as detailed in Astronomy & Astrophysics
+ *     282, 663 (1994)
+ *
+ *    Note that the code herein is design for the purpose of testing
+ *     computational performance; error handling and other such "niceties"
+ *    is virtually non-existent.
+ *
+ *    Actual (and oft-updated) benchmark results can be found at:
+ *            http://www.coyotegulch.com
+ *
+ *    Please do not use this information or algorithm in any way that might
+ *    upset the balance of the universe or otherwise cause planets to impact
+ *    upon one another.
+ *)
+
+let pic = 3.14159265358979323846
+and j2000     = 2451545.0
+and jcentury  = 36525.0
+and jmillenia = 365250.0
+
+let twopi     = 2.0 *. pic
+and a2r       = pic /. 648000.0
+and r2h       = 12.0 /. pic
+and r2d       = 180.0 /. pic
+and gaussk    = 0.01720209895
+
+(* number of days to include in test *)
+let test_loops  = 5  (* was: 20 *)
+and test_length = 36525
+
+(* sin and cos of j2000 mean obliquity (iau 1976) *)
+and sineps = 0.3977771559319137
+and coseps = 0.9174820620691818
+
+and amas = [|  6023600.0; 408523.5; 328900.5; 3098710.0;
+               1047.355; 3498.5; 22869.0; 19314.0 |]
+
+(*
+ * tables giving the mean keplerian elements, limited to t**2 terms:
+ *        a       semi-major axis (au)
+ *        dlm     mean longitude (degree and arcsecond)
+ *        e       eccentricity
+ *        pi      longitude of the perihelion (degree and arcsecond)
+ *        dinc    inclination (degree and arcsecond)
+ *        omega   longitude of the ascending node (degree and arcsecond)
+ *)
+and a = [|
+  [|   0.3870983098;             0.0;        0.0 |];
+  [|   0.7233298200;             0.0;        0.0 |];
+  [|   1.0000010178;             0.0;        0.0 |];
+  [|   1.5236793419;         3e-10;        0.0 |];
+  [|   5.2026032092;     19132e-10;  -39e-10 |];
+  [|   9.5549091915; -0.0000213896;  444e-10 |];
+  [|  19.2184460618;     -3716e-10;  979e-10 |];
+  [|  30.1103868694;    -16635e-10;  686e-10 |] |]
+
+and dlm =
+  [| [| 252.25090552; 5381016286.88982;  -1.92789 |];
+     [| 181.97980085; 2106641364.33548;   0.59381 |];
+     [| 100.46645683; 1295977422.83429;  -2.04411 |];
+     [| 355.43299958;  689050774.93988;   0.94264 |];
+     [|  34.35151874;  109256603.77991; -30.60378 |];
+     [|  50.07744430;   43996098.55732;  75.61614 |];
+     [| 314.05500511;   15424811.93933;  -1.75083 |];
+     [| 304.34866548;    7865503.20744;   0.21103 |] |]
+
+and e =
+  [| [|   0.2056317526;  0.0002040653;    -28349e-10 |];
+     [|   0.0067719164; -0.0004776521;     98127e-10 |];
+     [|   0.0167086342; -0.0004203654; -0.0000126734 |];
+     [|   0.0934006477;  0.0009048438;    -80641e-10 |];
+     [|   0.0484979255;  0.0016322542; -0.0000471366 |];
+     [|   0.0555481426; -0.0034664062; -0.0000643639 |];
+     [|   0.0463812221; -0.0002729293;  0.0000078913 |];
+     [|   0.0094557470;  0.0000603263;           0.0 |] |]
+
+and pi =
+  [| [|  77.45611904;  5719.11590;   -4.83016 |];
+     [| 131.56370300;   175.48640; -498.48184 |];
+     [| 102.93734808; 11612.35290;   53.27577 |];
+     [| 336.06023395; 15980.45908;  -62.32800 |];
+     [|  14.33120687;  7758.75163;  259.95938 |];
+     [|  93.05723748; 20395.49439;  190.25952 |];
+     [| 173.00529106;  3215.56238;  -34.09288 |];
+     [|  48.12027554;  1050.71912;   27.39717 |] |]
+and dinc =
+  [| [|   7.00498625; -214.25629;   0.28977 |];
+     [|   3.39466189;  -30.84437; -11.67836 |];
+     [|          0.0;  469.97289;  -3.35053 |];
+     [|   1.84972648; -293.31722;  -8.11830 |];
+     [|   1.30326698;  -71.55890;  11.95297 |];
+     [|   2.48887878;   91.85195; -17.66225 |];
+     [|   0.77319689;  -60.72723;   1.25759 |];
+     [|   1.76995259;    8.12333;   0.08135 |] |]
+
+and omega =
+  [| [|  48.33089304;  -4515.21727;  -31.79892 |];
+     [|  76.67992019; -10008.48154;  -51.32614 |];
+     [| 174.87317577;  -8679.27034;   15.34191 |];
+     [|  49.55809321; -10620.90088; -230.57416 |];
+     [| 100.46440702;   6362.03561;  326.52178 |];
+     [| 113.66550252;  -9240.19942;  -66.23743 |];
+     [|  74.00595701;   2669.15033;  145.93964 |];
+     [| 131.78405702;   -221.94322;   -0.78728 |] |]
+
+(* tables for trigonometric terms to be added to the mean elements
+   of the semi-major axes. *)
+and kp =
+  [| [| 69613.0;  75645.0; 88306.0; 59899.0; 15746.0; 71087.0; 142173.0;  3086.0;    0.0 |];
+     [| 21863.0;  32794.0; 26934.0; 10931.0; 26250.0; 43725.0;  53867.0; 28939.0;    0.0 |];
+     [| 16002.0;  21863.0; 32004.0; 10931.0; 14529.0; 16368.0;  15318.0; 32794.0;    0.0 |];
+     [|  6345.0;   7818.0; 15636.0;  7077.0;  8184.0; 14163.0;   1107.0;  4872.0;    0.0 |];
+     [|  1760.0;   1454.0;  1167.0;   880.0;   287.0;  2640.0;     19.0;  2047.0; 1454.0 |];
+     [|   574.0;      0.0;   880.0;   287.0;    19.0;  1760.0;   1167.0;   306.0;  574.0 |];
+     [|   204.0;      0.0;   177.0;  1265.0;     4.0;   385.0;    200.0;   208.0;  204.0 |];
+     [|     0.0;    102.0;   106.0;     4.0;    98.0;  1367.0;    487.0;   204.0;    0.0 |] |]
+
+and ca =
+  [| [|       4.0;    -13.0;    11.0;    -9.0;    -9.0;    -3.0;    -1.0;     4.0;    0.0 |];
+     [|    -156.0;     59.0;   -42.0;     6.0;    19.0;   -20.0;   -10.0;   -12.0;    0.0 |];
+     [|      64.0;   -152.0;    62.0;    -8.0;    32.0;   -41.0;    19.0;   -11.0;    0.0 |];
+     [|     124.0;    621.0;  -145.0;   208.0;    54.0;   -57.0;    30.0;    15.0;    0.0 |];
+     [|  -23437.0;  -2634.0;  6601.0;  6259.0; -1507.0; -1821.0;  2620.0; -2115.0;-1489.0 |];
+     [|   62911.0;-119919.0; 79336.0; 17814.0;-24241.0; 12068.0;  8306.0; -4893.0; 8902.0 |];
+     [|  389061.0;-262125.0;-44088.0;  8387.0;-22976.0; -2093.0;  -615.0; -9720.0; 6633.0 |];
+     [| -412235.0;-157046.0;-31430.0; 37817.0; -9740.0;   -13.0; -7449.0;  9644.0;    0.0 |] |]
+
+and sa =
+  [| [|     -29.0;    -1.0;     9.0;     6.0;    -6.0;     5.0;     4.0;     0.0;    0.0 |];
+     [|     -48.0;  -125.0;   -26.0;   -37.0;    18.0;   -13.0;   -20.0;    -2.0;    0.0 |];
+     [|    -150.0;   -46.0;    68.0;    54.0;    14.0;    24.0;   -28.0;    22.0;    0.0 |];
+     [|    -621.0;   532.0;  -694.0;   -20.0;   192.0;   -94.0;    71.0;   -73.0;    0.0 |];
+     [|  -14614.0;-19828.0; -5869.0;  1881.0; -4372.0; -2255.0;   782.0;   930.0;  913.0 |];
+     [|  139737.0;     0.0; 24667.0; 51123.0; -5102.0;  7429.0; -4095.0; -1976.0;-9566.0 |];
+     [| -138081.0;     0.0; 37205.0;-49039.0;-41901.0;-33872.0;-27037.0;-12474.0;18797.0 |];
+     [|       0.0; 28492.0;133236.0; 69654.0; 52322.0;-49577.0;-26430.0; -3593.0;    0.0 |] |]
+
+(* tables giving the trigonometric terms to be added to the mean elements of
+   the mean longitudes . *)
+and kq =
+  [| [|  3086.0; 15746.0; 69613.0; 59899.0; 75645.0; 88306.0; 12661.0; 2658.0;  0.0;   0.0 |];
+     [| 21863.0; 32794.0; 10931.0;    73.0;  4387.0; 26934.0;  1473.0; 2157.0;  0.0;   0.0 |];
+     [|    10.0; 16002.0; 21863.0; 10931.0;  1473.0; 32004.0;  4387.0;   73.0;  0.0;   0.0 |];
+     [|    10.0;  6345.0;  7818.0;  1107.0; 15636.0;  7077.0;  8184.0;  532.0; 10.0;   0.0 |];
+     [|    19.0;  1760.0;  1454.0;   287.0;  1167.0;   880.0;   574.0; 2640.0; 19.0;1454.0 |];
+     [|    19.0;   574.0;   287.0;   306.0;  1760.0;    12.0;    31.0;   38.0; 19.0; 574.0 |];
+     [|     4.0;   204.0;   177.0;     8.0;    31.0;   200.0;  1265.0;  102.0;  4.0; 204.0 |];
+     [|     4.0;   102.0;   106.0;     8.0;    98.0;  1367.0;   487.0;  204.0;  4.0; 102.0 |] |]
+
+and cl =
+  [| [|      21.0;   -95.0; -157.0;   41.0;   -5.0;   42.0;   23.0;   30.0;     0.0;    0.0 |];
+     [|    -160.0;  -313.0; -235.0;   60.0;  -74.0;  -76.0;  -27.0;   34.0;     0.0;    0.0 |];
+     [|    -325.0;  -322.0;  -79.0;  232.0;  -52.0;   97.0;   55.0;  -41.0;     0.0;    0.0 |];
+     [|    2268.0;  -979.0;  802.0;  602.0; -668.0;  -33.0;  345.0;  201.0;   -55.0;    0.0 |];
+     [|    7610.0; -4997.0;-7689.0;-5841.0;-2617.0; 1115.0; -748.0; -607.0;  6074.0;  354.0 |];
+     [|  -18549.0; 30125.0;20012.0; -730.0;  824.0;   23.0; 1289.0; -352.0;-14767.0;-2062.0 |];
+     [| -135245.0;-14594.0; 4197.0;-4030.0;-5630.0;-2898.0; 2540.0; -306.0;  2939.0; 1986.0 |];
+     [|   89948.0;  2103.0; 8963.0; 2695.0; 3682.0; 1648.0;  866.0; -154.0; -1963.0; -283.0 |] |]
+
+and sl =
+  [| [|   -342.0;   136.0;  -23.0;   62.0;   66.0;  -52.0;  -33.0;   17.0;     0.0;    0.0 |];
+     [|    524.0;  -149.0;  -35.0;  117.0;  151.0;  122.0;  -71.0;  -62.0;     0.0;    0.0 |];
+     [|   -105.0;  -137.0;  258.0;   35.0; -116.0;  -88.0; -112.0;  -80.0;     0.0;    0.0 |];
+     [|    854.0;  -205.0; -936.0; -240.0;  140.0; -341.0;  -97.0; -232.0;   536.0;    0.0 |];
+     [| -56980.0;  8016.0; 1012.0; 1448.0;-3024.0;-3710.0;  318.0;  503.0;  3767.0;  577.0 |];
+     [| 138606.0;-13478.0;-4964.0; 1441.0;-1319.0;-1482.0;  427.0; 1236.0; -9167.0;-1918.0 |];
+     [|  71234.0;-41116.0; 5334.0;-4935.0;-1848.0;   66.0;  434.0;-1748.0;  3780.0; -701.0 |];
+     [| -47645.0; 11647.0; 2166.0; 3194.0;  679.0;    0.0; -244.0; -419.0; -2531.0;   48.0 |] |]
+
+
+(* Normalize angle into the range -pi <= A < +pi. *)
+let anpm a =
+  let w = mod_float a twopi in
+    if abs_float w >= pic then begin
+      if a < 0.0 then
+        w +. twopi
+      else
+        w -. twopi
+    end else
+      w
+
+(* The reference frame is equatorial and is with respect to the
+ *    mean equator and equinox of epoch j2000. *)
+let planetpv epoch np pv =
+  (* time: julian millennia since j2000. *)
+  let t = ((epoch.(0) -. j2000) +. epoch.(1)) /. jmillenia in
+    (*  compute the mean elements. *)
+  let da  = ref (a.(np).(0) +. (a.(np).(1) +. a.(np).(2) *. t ) *. t)
+  and dl  = ref ((3600.0 *. dlm.(np).(0) +. (dlm.(np).(1) +. dlm.(np).(2) *. t ) *. t) *. a2r)
+  and de  = e.(np).(0) +. (e.(np).(1) +. e.(np).(2) *. t ) *. t
+  and dp  = anpm ((3600.0 *. pi.(np).(0) +. (pi.(np).(1) +. pi.(np).(2) *. t ) *. t ) *. a2r )
+  and  di  = (3600.0 *. dinc.(np).(0) +. (dinc.(np).(1) +. dinc.(np).(2) *. t ) *. t ) *. a2r
+  and doh = anpm ((3600.0 *. omega.(np).(0) +. (omega.(np).(1) +. omega.(np).(2) *. t ) *. t ) *. a2r )
+              (* apply the trigonometric terms. *)
+  and dmu = 0.35953620 *. t in
+
+  (* loop invariant *)
+  let kp = kp.(np) and kq = kq.(np) and ca = ca.(np) and sa = sa.(np)
+  and cl = cl.(np) and sl = sl.(np) in
+    for k = 0 to 7 do
+      let arga = kp.(k) *. dmu
+      and  argl = kq.(k) *. dmu in
+        da := !da +. (ca.(k) *. cos arga +. sa.(k) *. sin arga) *. 0.0000001;
+        dl := !dl +. (cl.(k) *. cos argl +. sl.(k) *. sin argl) *. 0.0000001
+    done;
+    begin let arga = kp.(8) *. dmu in
+      da := !da +. t *. (ca.(8) *. cos arga  +. sa.(8) *. sin arga ) *. 0.0000001;
+      for k = 8 to 9 do
+        let argl = kq.(k) *. dmu in
+          dl := !dl +. t *. ( cl.(k) *. cos argl +. sl.(k) *. sin argl ) *. 0.0000001
+      done;
+    end;
+
+
+    dl := mod_float !dl twopi;
+
+    (* iterative solution of kepler's equation to get eccentric anomaly. *)
+    let am = !dl -. dp in
+    let ae = ref (am +. de *. sin am)
+    and k = ref 0 in
+    let dae = ref ((am -. !ae +. de *. sin !ae) /. (1.0 -. de *. cos !ae)) in
+      ae := !ae +. !dae;
+      incr k;
+      while !k < 10 || abs_float !dae >= 1e-12 do
+        dae := (am -. !ae +. de *. sin !ae) /. (1.0 -. de *. cos !ae);
+        ae := !ae +. !dae;
+        incr k
+      done;
+
+      (* true anomaly. *)
+      let ae2 = !ae /. 2.0 in
+      let at  = 2.0 *. atan2 (sqrt ((1.0 +. de) /. (1.0 -. de)) *. sin ae2)  (cos ae2)
+                  (* distance (au) and speed (radians per day). *)
+      and r = !da *. (1.0 -. de *. cos !ae)
+      and v = gaussk *. sqrt ((1.0 +. 1.0 /. amas.(np) ) /. (!da *. !da *. !da))
+      and si2   = sin (di /. 2.0) in
+      let xq = si2 *. cos doh
+      and xp = si2 *. sin doh
+      and tl = at +. dp in
+      let xsw = sin tl
+      and xcw = cos tl in
+      let xm2  = 2.0 *. (xp *. xcw -. xq *. xsw )
+      and xf = !da /. sqrt (1.0 -. de *. de)
+      and ci2 = cos (di /. 2.0) in
+      let xms = (de *. sin dp +. xsw) *. xf
+      and xmc = (de *. cos dp  +. xcw) *. xf
+      and xpxq2 = 2.0 *. xp *. xq in
+
+      (* position (j2000 ecliptic x,y,z in au). *)
+      let x = r *. (xcw -. xm2 *. xp)
+      and y = r *. (xsw +. xm2 *. xq)
+      and z = r *. (-.xm2 *. ci2) in
+
+        (* rotate to equatorial. *)
+        pv.(0).(0) <- x;
+        pv.(0).(1) <- y *. coseps -. z *. sineps;
+        pv.(0).(2) <- y *. sineps +. z *. coseps;
+
+        (* velocity (j2000 ecliptic xdot,ydot,zdot in au/d). *)
+        let x = v *. ((-1.0 +. 2.0 *. xp *. xp) *. xms +. xpxq2 *. xmc)
+        and y = v *. (( 1.0 -. 2.0 *. xq *. xq ) *. xmc -. xpxq2 *. xms)
+        and z = v *. (2.0 *. ci2 *. (xp *. xms +. xq *. xmc)) in
+
+          (* rotate to equatorial *)
+          pv.(1).(0) <- x;
+          pv.(1).(1) <- y *. coseps -. z *. sineps;
+          pv.(1).(2) <- y *. sineps +. z *. coseps
+
+
+(* Computes RA, Declination, and distance from a state vector returned by
+ * planetpv. *)
+let radecdist state rdd =
+  (* Distance *)
+  rdd.(2) <- sqrt (state.(0).(0) *. state.(0).(0)
+                 +. state.(0).(1) *. state.(0).(1)
+                 +. state.(0).(2) *. state.(0).(2));
+  (* RA *)
+  rdd.(0) <- atan2 state.(0).(1) state.(0).(0) *. r2h;
+  if rdd.(0) < 0.0 then rdd.(0) <- rdd.(0) +. 24.0;
+
+  (* Declination *)
+  rdd.(1) <- asin (state.(0).(2) /. rdd.(2)) *. r2d
+
+
+
+(* Entry point. Calculate RA and Dec for noon on every day in 1900-2100 *)
+let _ =
+  let jd = [| 0.0; 0.0 |]
+  and pv = [| [| 0.0; 0.0; 0.0 |]; [| 0.0; 0.0; 0.0 |] |]
+  and position = [| 0.0; 0.0; 0.0 |] in
+  (* Test *)
+  jd.(0) <- j2000;
+  jd.(1) <- 1.0;
+  for p = 0 to 7 do
+    planetpv jd p pv;
+    radecdist pv position;
+    Printf.printf "%d %.2f %.2f\n%!" p position.(0) position.(1)
+  done;
+  (* Benchmark *)
+(**
+  for i = 0 to test_loops - 1 do
+    jd.(0) <- j2000;
+    jd.(1) <- 0.0;
+    for n = 0 to test_length - 1 do
+      jd.(0) <- jd.(0) +. 1.0;
+      for p = 0 to 7 do
+        planetpv jd p pv;
+        radecdist pv position;
+      done
+    done
+  done
+**)
diff --git a/testsuite/tests/misc-unsafe/almabench.reference b/testsuite/tests/misc-unsafe/almabench.reference
new file mode 100644
index 00000000..5c1d8b89
--- /dev/null
+++ b/testsuite/tests/misc-unsafe/almabench.reference
@@ -0,0 +1,8 @@
+0 17.00 -26.06
+1 12.34 1.29
+2 6.83 22.95
+3 0.04 -1.26
+4 2.30 12.54
+5 2.93 14.35
+6 21.27 -16.57
+7 20.41 -19.04
diff --git a/testsuite/tests/misc-unsafe/fft.ml b/testsuite/tests/misc-unsafe/fft.ml
new file mode 100644
index 00000000..463e5c9d
--- /dev/null
+++ b/testsuite/tests/misc-unsafe/fft.ml
@@ -0,0 +1,178 @@
+(* TEST
+   flags += " -unsafe "
+*)
+
+let pi = 3.14159265358979323846
+
+let tpi = 2.0 *. pi
+
+let fft px py np =
+  let i = ref 2 in
+  let m = ref 1 in
+
+  while (!i < np) do
+    i := !i + !i;
+    m := !m + 1
+  done;
+
+  let n = !i in
+
+  if n <> np then begin
+    for i = np+1 to n do
+      px.(i) <- 0.0;
+      py.(i) <- 0.0
+    done;
+    print_string "Use "; print_int n;
+    print_string " point fft"; print_newline()
+  end;
+
+  let n2 = ref(n+n) in
+  for k = 1 to !m-1 do
+    n2 := !n2 / 2;
+    let n4 = !n2 / 4 in
+    let e  = tpi /. float !n2 in
+
+    for j = 1 to n4 do
+      let a = e *. float(j - 1) in
+      let a3 = 3.0 *. a in
+      let cc1 = cos(a) in
+      let ss1 = sin(a) in
+      let cc3 = cos(a3) in
+      let ss3 = sin(a3) in
+      let is = ref j in
+      let id = ref(2 * !n2) in
+
+        while !is < n do
+          let i0r = ref !is in
+          while !i0r < n do
+             let i0 = !i0r in
+             let i1 = i0 + n4 in
+             let i2 = i1 + n4 in
+             let i3 = i2 + n4 in
+             let r1 = px.(i0) -. px.(i2) in
+             px.(i0) <- px.(i0) +. px.(i2);
+             let r2 = px.(i1) -. px.(i3) in
+             px.(i1) <- px.(i1) +. px.(i3);
+             let s1 = py.(i0) -. py.(i2) in
+             py.(i0) <- py.(i0) +. py.(i2);
+             let s2 = py.(i1) -. py.(i3) in
+             py.(i1) <- py.(i1) +. py.(i3);
+             let s3 = r1 -. s2 in
+             let r1 = r1 +. s2 in
+             let s2 = r2 -. s1 in
+             let r2 = r2 +. s1 in
+             px.(i2) <- r1*.cc1 -. s2*.ss1;
+             py.(i2) <- -.s2*.cc1 -. r1*.ss1;
+             px.(i3) <- s3*.cc3 +. r2*.ss3;
+             py.(i3) <- r2*.cc3 -. s3*.ss3;
+             i0r := i0 + !id
+          done;
+          is := 2 * !id - !n2 + j;
+          id := 4 * !id
+        done
+    done
+  done;
+
+(************************************)
+(*  Last stage, length=2 butterfly  *)
+(************************************)
+
+  let is = ref 1 in
+  let id = ref 4 in
+
+  while !is < n do
+    let i0r = ref !is in
+    while !i0r <= n do
+      let i0 = !i0r in
+      let i1 = i0 + 1 in
+      let r1 = px.(i0) in
+      px.(i0) <- r1 +. px.(i1);
+      px.(i1) <- r1 -. px.(i1);
+      let r1 = py.(i0) in
+      py.(i0) <- r1 +. py.(i1);
+      py.(i1) <- r1 -. py.(i1);
+      i0r := i0 + !id
+    done;
+    is := 2 * !id - 1;
+    id := 4 * !id
+  done;
+
+(*************************)
+(*  Bit reverse counter  *)
+(*************************)
+
+  let j = ref 1 in
+
+  for i = 1 to n - 1 do
+    if i < !j then begin
+      let xt = px.(!j) in
+      px.(!j) <- px.(i);
+      px.(i) <- xt;
+      let xt = py.(!j) in
+      py.(!j) <- py.(i);
+      py.(i) <- xt
+    end;
+    let k = ref(n / 2) in
+    while !k < !j do
+      j := !j - !k;
+      k := !k / 2
+    done;
+    j := !j + !k
+  done;
+
+  n
+
+
+let test np =
+  print_int np; print_string "... "; flush stdout;
+  let enp = float np in
+  let npm = np / 2 - 1 in
+  let pxr = Array.make (np+2) 0.0
+  and pxi = Array.make (np+2) 0.0 in
+  let t = pi /. enp in
+  pxr.(1) <- (enp -. 1.0) *. 0.5;
+  pxi.(1) <- 0.0;
+  let n2 = np / 2 in
+  pxr.(n2+1) <- -0.5;
+  pxi.(n2+1) <-  0.0;
+
+  for i = 1 to npm do
+      let j = np - i in
+      pxr.(i+1) <- -0.5;
+      pxr.(j+1) <- -0.5;
+      let z = t *. float i in
+      let y = -0.5*.(cos(z)/.sin(z)) in
+      pxi.(i+1) <- y;
+      pxi.(j+1) <- -.y
+  done;
+(**
+  print_newline();
+  for i=0 to 15 do Printf.printf "%d  %f  %f\n" i pxr.(i+1) pxi.(i+1) done;
+**)
+  let _ = fft pxr pxi np in
+(**
+  for i=0 to 15 do Printf.printf "%d  %f  %f\n" i pxr.(i+1) pxi.(i+1) done;
+**)
+  let zr = ref 0.0 in
+  let zi = ref 0.0 in
+  let kr = ref 0 in
+  let ki = ref 0 in
+  for i = 0 to np-1 do
+      let a = abs_float(pxr.(i+1) -. float i) in
+      if !zr < a then begin
+         zr := a;
+         kr := i
+      end;
+      let a = abs_float(pxi.(i+1)) in
+      if !zi < a then begin
+         zi := a;
+         ki := i
+      end
+  done;
+  if abs_float !zr <= 1e-9 && abs_float !zi <= 1e-9
+  then print_string "ok"
+  else print_string "ERROR";
+  print_newline()
+
+let _ =
+  let np = ref 16 in for i = 1 to 15 do test !np; np := !np*2 done
diff --git a/testsuite/tests/misc-unsafe/fft.reference b/testsuite/tests/misc-unsafe/fft.reference
new file mode 100644
index 00000000..ce6544e9
--- /dev/null
+++ b/testsuite/tests/misc-unsafe/fft.reference
@@ -0,0 +1,15 @@
+16... ok
+32... ok
+64... ok
+128... ok
+256... ok
+512... ok
+1024... ok
+2048... ok
+4096... ok
+8192... ok
+16384... ok
+32768... ok
+65536... ok
+131072... ok
+262144... ok
diff --git a/testsuite/tests/misc-unsafe/quicksort.ml b/testsuite/tests/misc-unsafe/quicksort.ml
new file mode 100644
index 00000000..208e2052
--- /dev/null
+++ b/testsuite/tests/misc-unsafe/quicksort.ml
@@ -0,0 +1,82 @@
+(* TEST
+   flags += " -unsafe "
+*)
+
+(* Good test for loops. Best compiled with -unsafe. *)
+
+let rec qsort lo hi (a : int array) =
+  if lo < hi then begin
+    let i = ref lo in
+    let j = ref hi in
+    let pivot = a.(hi) in
+    while !i < !j do
+      while !i < hi && a.(!i) <= pivot do incr i done;
+      while !j > lo && a.(!j) >= pivot do decr j done;
+      if !i < !j then begin
+        let temp = a.(!i) in a.(!i) <- a.(!j); a.(!j) <- temp
+      end
+    done;
+    let temp = a.(!i) in a.(!i) <- a.(hi); a.(hi) <- temp;
+    qsort lo (!i-1) a;
+    qsort (!i+1) hi a
+  end
+
+
+(* Same but abstract over the comparison to force spilling *)
+
+let cmp i j = i - j
+
+let rec qsort2 lo hi (a : int array) =
+  if lo < hi then begin
+    let i = ref lo in
+    let j = ref hi in
+    let pivot = a.(hi) in
+    while !i < !j do
+      while !i < hi && cmp a.(!i) pivot <= 0 do incr i done;
+      while !j > lo && cmp a.(!j) pivot >= 0 do decr j done;
+      if !i < !j then begin
+        let temp = a.(!i) in a.(!i) <- a.(!j); a.(!j) <- temp
+      end
+    done;
+    let temp = a.(!i) in a.(!i) <- a.(hi); a.(hi) <- temp;
+    qsort2 lo (!i-1) a;
+    qsort2 (!i+1) hi a
+  end
+
+
+(* Test *)
+
+let seed = ref 0
+
+let random() =
+  seed := !seed * 25173 + 17431; !seed land 0xFFF
+
+
+exception Failed
+
+let test_sort sort_fun size =
+  let a = Array.make size 0 in
+  let check = Array.make 4096 0 in
+  for i = 0 to size-1 do
+    let n = random() in a.(i) <- n; check.(n) <- check.(n)+1
+  done;
+  sort_fun 0 (size-1) a;
+  try
+    check.(a.(0)) <- check.(a.(0)) - 1;
+    for i = 1 to size-1 do
+      if a.(i-1) > a.(i) then raise Failed;
+      check.(a.(i)) <- check.(a.(i)) - 1
+    done;
+    for i = 0 to 4095 do
+      if check.(i) <> 0 then raise Failed
+    done;
+    print_string "OK";  print_newline()
+  with Failed ->
+    print_string "failed"; print_newline()
+
+
+let main () =
+  test_sort qsort 50000;
+  test_sort qsort2 50000
+
+let _ = main(); exit 0
diff --git a/testsuite/tests/misc-unsafe/quicksort.reference b/testsuite/tests/misc-unsafe/quicksort.reference
new file mode 100644
index 00000000..2c94e483
--- /dev/null
+++ b/testsuite/tests/misc-unsafe/quicksort.reference
@@ -0,0 +1,2 @@
+OK
+OK
diff --git a/testsuite/tests/misc-unsafe/soli.ml b/testsuite/tests/misc-unsafe/soli.ml
new file mode 100644
index 00000000..127cd699
--- /dev/null
+++ b/testsuite/tests/misc-unsafe/soli.ml
@@ -0,0 +1,100 @@
+(* TEST
+   flags += " -unsafe "
+*)
+
+type peg = Out | Empty | Peg
+
+let board = [|
+ [| Out; Out; Out; Out; Out; Out; Out; Out; Out|];
+ [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
+ [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
+ [| Out; Peg; Peg; Peg; Peg; Peg; Peg; Peg; Out|];
+ [| Out; Peg; Peg; Peg; Empty; Peg; Peg; Peg; Out|];
+ [| Out; Peg; Peg; Peg; Peg; Peg; Peg; Peg; Out|];
+ [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
+ [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
+ [| Out; Out; Out; Out; Out; Out; Out; Out; Out|]
+|]
+
+
+let print_peg = function
+    Out -> print_string "."
+  | Empty -> print_string " "
+  | Peg -> print_string "$"
+
+
+let print_board board =
+ for i=0 to 8 do
+   for j=0 to 8 do
+    print_peg board.(i).(j)
+   done;
+   print_newline()
+ done
+
+
+type direction = { dx: int; dy: int }
+
+let dir = [| {dx = 0; dy = 1}; {dx = 1; dy = 0};
+             {dx = 0; dy = -1}; {dx = -1; dy = 0} |]
+
+type move = { x1: int; y1: int; x2: int; y2: int }
+
+let moves = Array.make 31 {x1=0;y1=0;x2=0;y2=0}
+
+let counter = ref 0
+
+exception Found
+
+let rec solve m =
+  counter := !counter + 1;
+  if m = 31 then
+    begin match board.(4).(4) with Peg -> true | _ -> false end
+  else
+    try
+      if !counter mod 500 = 0 then begin
+        print_int !counter; print_newline()
+      end;
+      for i=1 to 7 do
+      for j=1 to 7 do
+        match board.(i).(j) with
+          Peg ->
+            for k=0 to 3 do
+              let d1 = dir.(k).dx in
+              let d2 = dir.(k).dy in
+              let i1 = i+d1 in
+              let i2 = i1+d1 in
+              let j1 = j+d2 in
+              let j2 = j1+d2 in
+              match board.(i1).(j1) with
+                Peg ->
+                  begin match board.(i2).(j2) with
+                    Empty ->
+(*
+                      print_int i; print_string ", ";
+                      print_int j; print_string ") dir ";
+                      print_int k; print_string "\n";
+*)
+                      board.(i).(j) <- Empty;
+                      board.(i1).(j1) <- Empty;
+                      board.(i2).(j2) <- Peg;
+                      if solve(m+1) then begin
+                        moves.(m) <- { x1=i; y1=j; x2=i2; y2=j2 };
+                        raise Found
+                      end;
+                      board.(i).(j) <- Peg;
+                      board.(i1).(j1) <- Peg;
+                      board.(i2).(j2) <- Empty
+                    | _ -> ()
+                  end
+              | _ -> ()
+            done
+        | _ ->
+            ()
+      done
+      done;
+      false
+    with Found ->
+      true
+
+
+let _ = if solve 0 then (print_string "\n"; print_board board)
diff --git a/testsuite/tests/misc-unsafe/soli.reference b/testsuite/tests/misc-unsafe/soli.reference
new file mode 100644
index 00000000..b94045c3
--- /dev/null
+++ b/testsuite/tests/misc-unsafe/soli.reference
@@ -0,0 +1,50 @@
+500
+1000
+1500
+2000
+2500
+3000
+3500
+4000
+4500
+5000
+5500
+6000
+6500
+7000
+7500
+8000
+8500
+9000
+9500
+10000
+10500
+11000
+11500
+12000
+12500
+13000
+13500
+14000
+14500
+15000
+15500
+16000
+16500
+17000
+17500
+18000
+18500
+19000
+19500
+20000
+
+.........
+...   ...
+...   ...
+.       .
+.   $   .
+.       .
+...   ...
+...   ...
+.........
diff --git a/testsuite/tests/misc/bdd.ml b/testsuite/tests/misc/bdd.ml
new file mode 100644
index 00000000..30de85e0
--- /dev/null
+++ b/testsuite/tests/misc/bdd.ml
@@ -0,0 +1,220 @@
+(* TEST
+*)
+
+(* Translated to OCaml by Xavier Leroy *)
+(* Original code written in SML by ... *)
+
+type bdd = One | Zero | Node of bdd * int * int * bdd
+
+let rec eval bdd vars =
+  match bdd with
+    Zero -> false
+  | One -> true
+  | Node(l, v, _, h) ->
+      if vars.(v) then eval h vars else eval l vars
+
+let getId bdd =
+  match bdd with
+    Node(_,_,id,_) -> id
+  | Zero           -> 0
+  | One            -> 1
+
+let initSize_1 = 8*1024 - 1
+let nodeC      = ref 1
+let sz_1       = ref initSize_1
+let htab       = ref(Array.make (!sz_1+1) [])
+let n_items    = ref 0
+let hashVal x y v = x lsl 1 + y + v lsl 2
+
+let resize newSize =
+      let arr     = !htab in
+      let newSz_1 = newSize-1 in
+      let newArr  = Array.make newSize [] in
+      let rec copyBucket bucket =
+                match bucket with
+                  []     -> ()
+                | n :: ns ->
+                    match n with
+                    | Node(l,v,_,h) ->
+                       let ind = hashVal (getId l) (getId h) v land newSz_1
+                       in
+                       newArr.(ind) <- (n :: newArr.(ind));
+                       copyBucket ns
+                    | _ -> assert false
+                    in
+      for n = 0 to !sz_1 do
+        copyBucket(arr.(n))
+      done;
+      htab := newArr;
+      sz_1 := newSz_1
+
+
+let rec insert idl idh v ind bucket newNode =
+        if !n_items <= !sz_1
+        then ( (!htab).(ind) <- (newNode :: bucket);
+               incr n_items )
+        else ( resize(!sz_1 + !sz_1 + 2);
+               let ind = hashVal idl idh v land (!sz_1)
+               in
+                  (!htab).(ind) <- newNode :: (!htab).(ind)
+             )
+
+
+let resetUnique () = (
+      sz_1    := initSize_1;
+      htab    := Array.make (!sz_1+1) [];
+      n_items := 0;
+      nodeC   := 1
+      )
+
+let mkNode low v high =
+   let idl = getId low in
+   let idh = getId high
+   in
+     if idl = idh
+     then low
+     else let ind      = hashVal idl idh v land  (!sz_1) in
+          let bucket   = (!htab).(ind) in
+          let rec lookup b =
+                    match b with
+                      [] -> let n = Node(low, v, (incr nodeC; !nodeC), high)
+                            in
+                             insert (getId low) (getId high) v ind bucket n; n
+                    | n :: ns ->
+                        match n with
+                        | Node(l,v',id,h) ->
+                           if v = v' && idl = getId l && idh = getId h
+                           then n else lookup ns
+                        | _ -> assert false
+           in
+             lookup bucket
+
+
+type ordering = LESS | EQUAL | GREATER
+
+let cmpVar (x : int) (y : int) =
+  if x<y then LESS else if x>y then GREATER else EQUAL
+
+let zero = Zero
+let one  = One
+
+let mkVar x   = mkNode zero x one
+
+
+let cacheSize = 1999
+let andslot1  = Array.make cacheSize 0
+let andslot2  = Array.make cacheSize 0
+let andslot3  = Array.make cacheSize zero
+let xorslot1  = Array.make cacheSize 0
+let xorslot2  = Array.make cacheSize 0
+let xorslot3  = Array.make cacheSize zero
+let notslot1  = Array.make cacheSize 0
+let notslot2  = Array.make cacheSize one
+let hash x y  = ((x lsl 1)+y) mod cacheSize
+
+let rec not n =
+match n with
+  Zero -> One
+| One  -> Zero
+| Node(l, v, id, r) -> let h = id mod cacheSize
+                       in
+                          if id=notslot1.(h) then notslot2.(h)
+                          else let f = mkNode (not l) v (not r)
+                               in
+                                 notslot1.(h) <- id; notslot2.(h) <- f; f
+
+let rec and2 n1 n2 =
+match n1 with
+  Node(l1, v1, i1, r1)
+  -> (match n2 with
+        Node(l2, v2, i2, r2)
+        -> let h = hash i1 i2
+           in
+             if i1=andslot1.(h) && i2=andslot2.(h) then andslot3.(h)
+             else let f = match cmpVar v1 v2 with
+                            EQUAL   -> mkNode (and2 l1 l2) v1 (and2 r1 r2)
+                          | LESS    -> mkNode (and2 l1 n2) v1 (and2 r1 n2)
+                          | GREATER -> mkNode (and2 n1 l2) v2 (and2 n1 r2)
+                  in
+                   andslot1.(h) <- i1;
+                   andslot2.(h) <- i2;
+                   andslot3.(h) <- f;
+                   f
+     | Zero -> Zero
+     | One  -> n1)
+|  Zero -> Zero
+|  One  -> n2
+
+
+let rec xor n1 n2 =
+match n1 with
+  Node(l1, v1, i1, r1)
+  -> (match n2 with
+        Node(l2, v2, i2, r2)
+        -> let h = hash i1 i2
+           in
+             if i1=andslot1.(h) && i2=andslot2.(h) then andslot3.(h)
+             else let f = match cmpVar v1 v2 with
+                            EQUAL   -> mkNode (xor l1 l2) v1 (xor r1 r2)
+                          | LESS    -> mkNode (xor l1 n2) v1 (xor r1 n2)
+                          | GREATER -> mkNode (xor n1 l2) v2 (xor n1 r2)
+                  in
+                   andslot1.(h) <- i1;
+                   andslot2.(h) <- i2;
+                   andslot3.(h) <- f;
+                   f
+     | Zero -> n1
+     | One  -> not n1)
+|  Zero -> n2
+|  One  -> not n2
+
+let hwb n =
+  let rec h i j = if i=j
+                  then mkVar i
+                  else  xor (and2 (not(mkVar j)) (h i (j-1)))
+                            (and2 (mkVar j)      (g i (j-1)))
+      and g i j = if i=j
+                  then mkVar i
+                  else xor (and2 (not(mkVar i)) (h (i+1) j))
+                           (and2 (mkVar i)      (g (i+1) j))
+  in
+     h 0 (n-1)
+
+(* Testing *)
+let seed = ref 0
+
+let random() =
+  seed := !seed * 25173 + 17431; !seed land 1 > 0
+
+let random_vars n =
+  let vars = Array.make n false in
+  for i = 0 to n - 1 do vars.(i) <- random() done;
+  vars
+
+let test_hwb bdd vars =
+  (* We should have
+        eval bdd vars = vars.(n-1) if n > 0
+        eval bdd vars = false if n = 0
+     where n is the number of "true" elements in vars. *)
+  let ntrue = ref 0 in
+  for i = 0 to Array.length vars - 1 do
+    if vars.(i) then incr ntrue
+  done;
+  eval bdd vars = (if !ntrue > 0 then vars.(!ntrue-1) else false)
+
+let main () =
+  let n =
+    if Array.length Sys.argv >= 2 then int_of_string Sys.argv.(1) else 20 in
+  let ntests =
+    if Array.length Sys.argv >= 3 then int_of_string Sys.argv.(2) else 10 in
+  let bdd = hwb n in
+  let succeeded = ref true in
+  for i = 1 to ntests do
+    succeeded := !succeeded && test_hwb bdd (random_vars n)
+  done;
+  if !succeeded
+  then print_string "OK\n"
+  else print_string "FAILED\n";
+  exit 0
+
+let _ = main()
diff --git a/testsuite/tests/misc/bdd.reference b/testsuite/tests/misc/bdd.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/misc/bdd.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/misc/boyer.ml b/testsuite/tests/misc/boyer.ml
new file mode 100644
index 00000000..53e18813
--- /dev/null
+++ b/testsuite/tests/misc/boyer.ml
@@ -0,0 +1,881 @@
+(* TEST
+*)
+
+(* Manipulations over terms *)
+
+type term =
+    Var of int
+  | Prop of head * term list
+and head =
+    { name: string;
+      mutable props: (term * term) list }
+
+let rec print_term = function
+    Var v ->
+      print_string "v"; print_int v
+  | Prop (head,argl) ->
+      print_string "(";
+      print_string head.name;
+      List.iter (fun t -> print_string " "; print_term t) argl;
+      print_string ")"
+
+let lemmas = ref ([] : head list)
+
+(* Replacement for property lists *)
+
+let get name =
+  let rec get_rec = function
+    hd1::hdl ->
+      if hd1.name = name then hd1 else get_rec hdl
+  | [] ->
+      let entry = {name = name; props = []} in
+        lemmas := entry :: !lemmas;
+        entry
+  in get_rec !lemmas
+
+let add_lemma = function
+ | Prop(_, [(Prop(headl,_) as left); right]) ->
+     headl.props <- (left, right) :: headl.props
+ | _ -> assert false
+
+(* Substitutions *)
+
+type subst = Bind of int * term
+
+let get_binding v list =
+  let rec get_rec = function
+    [] -> failwith "unbound"
+  | Bind(w,t)::rest -> if v = w  then t else get_rec rest
+  in get_rec list
+
+let apply_subst alist term =
+  let rec as_rec = function
+     Var v -> begin try get_binding v alist with Failure _ -> term end
+   | Prop (head,argl) -> Prop (head, List.map as_rec argl)
+  in as_rec term
+
+exception Unify
+
+let rec unify term1 term2 =
+  unify1 term1 term2 []
+
+and unify1 term1 term2 unify_subst =
+ match term2 with
+    Var v ->
+      begin try
+        if get_binding v unify_subst = term1
+        then unify_subst
+        else raise Unify
+      with Failure _ ->
+        Bind(v,term1) :: unify_subst
+      end
+  | Prop (head2, argl2) ->
+      match term1 with
+         Var _ -> raise Unify
+       | Prop (head1,argl1) ->
+           if head1 == head2
+           then unify1_lst argl1 argl2 unify_subst
+           else raise Unify
+
+and unify1_lst l1 l2 unify_subst =
+  match (l1, l2) with
+    ([], []) -> unify_subst
+  | (h1::r1, h2::r2) -> unify1_lst r1 r2 (unify1 h1 h2 unify_subst)
+  | _ -> raise Unify
+
+
+let rec rewrite = function
+    Var _ as term -> term
+  | Prop (head, argl) ->
+      rewrite_with_lemmas (Prop (head, List.map rewrite argl)) head.props
+and rewrite_with_lemmas term lemmas =
+  match lemmas with
+    [] ->
+      term
+  | (t1,t2)::rest ->
+      try
+        rewrite (apply_subst (unify term t1) t2)
+      with Unify ->
+        rewrite_with_lemmas term rest
+
+type cterm = CVar of int | CProp of string * cterm list
+
+let rec cterm_to_term = function
+    CVar v -> Var v
+  | CProp(p, l) -> Prop(get p, List.map cterm_to_term l)
+
+let add t = add_lemma (cterm_to_term t)
+
+let _ =
+add (CProp
+("equal",
+ [CProp ("compile",[CVar 5]);
+  CProp
+  ("reverse",
+   [CProp ("codegen",[CProp ("optimize",[CVar 5]); CProp ("nil",[])])])]));
+add (CProp
+("equal",
+ [CProp ("eqp",[CVar 23; CVar 24]);
+  CProp ("equal",[CProp ("fix",[CVar 23]); CProp ("fix",[CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("gt",[CVar 23; CVar 24]); CProp ("lt",[CVar 24; CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("le",[CVar 23; CVar 24]); CProp ("ge",[CVar 24; CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("ge",[CVar 23; CVar 24]); CProp ("le",[CVar 24; CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("boolean",[CVar 23]);
+  CProp
+  ("or",
+   [CProp ("equal",[CVar 23; CProp ("true",[])]);
+    CProp ("equal",[CVar 23; CProp ("false",[])])])]));
+add (CProp
+("equal",
+ [CProp ("iff",[CVar 23; CVar 24]);
+  CProp
+  ("and",
+   [CProp ("implies",[CVar 23; CVar 24]);
+    CProp ("implies",[CVar 24; CVar 23])])]));
+add (CProp
+("equal",
+ [CProp ("even1",[CVar 23]);
+  CProp
+  ("if",
+   [CProp ("zerop",[CVar 23]); CProp ("true",[]);
+    CProp ("odd",[CProp ("sub1",[CVar 23])])])]));
+add (CProp
+("equal",
+ [CProp ("countps_",[CVar 11; CVar 15]);
+  CProp ("countps_loop",[CVar 11; CVar 15; CProp ("zero",[])])]));
+add (CProp
+("equal",
+ [CProp ("fact_",[CVar 8]);
+  CProp ("fact_loop",[CVar 8; CProp ("one",[])])]));
+add (CProp
+("equal",
+ [CProp ("reverse_",[CVar 23]);
+  CProp ("reverse_loop",[CVar 23; CProp ("nil",[])])]));
+add (CProp
+("equal",
+ [CProp ("divides",[CVar 23; CVar 24]);
+  CProp ("zerop",[CProp ("remainder",[CVar 24; CVar 23])])]));
+add (CProp
+("equal",
+ [CProp ("assume_true",[CVar 21; CVar 0]);
+  CProp ("cons",[CProp ("cons",[CVar 21; CProp ("true",[])]); CVar 0])]));
+add (CProp
+("equal",
+ [CProp ("assume_false",[CVar 21; CVar 0]);
+  CProp ("cons",[CProp ("cons",[CVar 21; CProp ("false",[])]); CVar 0])]));
+add (CProp
+("equal",
+ [CProp ("tautology_checker",[CVar 23]);
+  CProp ("tautologyp",[CProp ("normalize",[CVar 23]); CProp ("nil",[])])]));
+add (CProp
+("equal",
+ [CProp ("falsify",[CVar 23]);
+  CProp ("falsify1",[CProp ("normalize",[CVar 23]); CProp ("nil",[])])]));
+add (CProp
+("equal",
+ [CProp ("prime",[CVar 23]);
+  CProp
+  ("and",
+   [CProp ("not",[CProp ("zerop",[CVar 23])]);
+    CProp
+    ("not",
+     [CProp ("equal",[CVar 23; CProp ("add1",[CProp ("zero",[])])])]);
+    CProp ("prime1",[CVar 23; CProp ("sub1",[CVar 23])])])]));
+add (CProp
+("equal",
+ [CProp ("and",[CVar 15; CVar 16]);
+  CProp
+  ("if",
+   [CVar 15;
+    CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
+    CProp ("false",[])])]));
+add (CProp
+("equal",
+ [CProp ("or",[CVar 15; CVar 16]);
+  CProp
+  ("if",
+   [CVar 15; CProp ("true",[]);
+    CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
+    CProp ("false",[])])]));
+add (CProp
+("equal",
+ [CProp ("not",[CVar 15]);
+  CProp ("if",[CVar 15; CProp ("false",[]); CProp ("true",[])])]));
+add (CProp
+("equal",
+ [CProp ("implies",[CVar 15; CVar 16]);
+  CProp
+  ("if",
+   [CVar 15;
+    CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
+    CProp ("true",[])])]));
+add (CProp
+("equal",
+ [CProp ("fix",[CVar 23]);
+  CProp ("if",[CProp ("numberp",[CVar 23]); CVar 23; CProp ("zero",[])])]));
+add (CProp
+("equal",
+ [CProp ("if",[CProp ("if",[CVar 0; CVar 1; CVar 2]); CVar 3; CVar 4]);
+  CProp
+  ("if",
+   [CVar 0; CProp ("if",[CVar 1; CVar 3; CVar 4]);
+    CProp ("if",[CVar 2; CVar 3; CVar 4])])]));
+add (CProp
+("equal",
+ [CProp ("zerop",[CVar 23]);
+  CProp
+  ("or",
+   [CProp ("equal",[CVar 23; CProp ("zero",[])]);
+    CProp ("not",[CProp ("numberp",[CVar 23])])])]));
+add (CProp
+("equal",
+ [CProp ("plus",[CProp ("plus",[CVar 23; CVar 24]); CVar 25]);
+  CProp ("plus",[CVar 23; CProp ("plus",[CVar 24; CVar 25])])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CProp ("plus",[CVar 0; CVar 1]); CProp ("zero",[])]);
+  CProp ("and",[CProp ("zerop",[CVar 0]); CProp ("zerop",[CVar 1])])]));
+add (CProp
+("equal",[CProp ("difference",[CVar 23; CVar 23]); CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp
+  ("equal",
+   [CProp ("plus",[CVar 0; CVar 1]); CProp ("plus",[CVar 0; CVar 2])]);
+  CProp ("equal",[CProp ("fix",[CVar 1]); CProp ("fix",[CVar 2])])]));
+add (CProp
+("equal",
+ [CProp
+  ("equal",[CProp ("zero",[]); CProp ("difference",[CVar 23; CVar 24])]);
+  CProp ("not",[CProp ("gt",[CVar 24; CVar 23])])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CVar 23; CProp ("difference",[CVar 23; CVar 24])]);
+  CProp
+  ("and",
+   [CProp ("numberp",[CVar 23]);
+    CProp
+    ("or",
+     [CProp ("equal",[CVar 23; CProp ("zero",[])]);
+      CProp ("zerop",[CVar 24])])])]));
+add (CProp
+("equal",
+ [CProp
+  ("meaning",
+   [CProp ("plus_tree",[CProp ("append",[CVar 23; CVar 24])]); CVar 0]);
+  CProp
+  ("plus",
+   [CProp ("meaning",[CProp ("plus_tree",[CVar 23]); CVar 0]);
+    CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0])])]));
+add (CProp
+("equal",
+ [CProp
+  ("meaning",
+   [CProp ("plus_tree",[CProp ("plus_fringe",[CVar 23])]); CVar 0]);
+  CProp ("fix",[CProp ("meaning",[CVar 23; CVar 0])])]));
+add (CProp
+("equal",
+ [CProp ("append",[CProp ("append",[CVar 23; CVar 24]); CVar 25]);
+  CProp ("append",[CVar 23; CProp ("append",[CVar 24; CVar 25])])]));
+add (CProp
+("equal",
+ [CProp ("reverse",[CProp ("append",[CVar 0; CVar 1])]);
+  CProp
+  ("append",[CProp ("reverse",[CVar 1]); CProp ("reverse",[CVar 0])])]));
+add (CProp
+("equal",
+ [CProp ("times",[CVar 23; CProp ("plus",[CVar 24; CVar 25])]);
+  CProp
+  ("plus",
+   [CProp ("times",[CVar 23; CVar 24]);
+    CProp ("times",[CVar 23; CVar 25])])]));
+add (CProp
+("equal",
+ [CProp ("times",[CProp ("times",[CVar 23; CVar 24]); CVar 25]);
+  CProp ("times",[CVar 23; CProp ("times",[CVar 24; CVar 25])])]));
+add (CProp
+("equal",
+ [CProp
+  ("equal",[CProp ("times",[CVar 23; CVar 24]); CProp ("zero",[])]);
+  CProp ("or",[CProp ("zerop",[CVar 23]); CProp ("zerop",[CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("exec",[CProp ("append",[CVar 23; CVar 24]); CVar 15; CVar 4]);
+  CProp
+  ("exec",[CVar 24; CProp ("exec",[CVar 23; CVar 15; CVar 4]); CVar 4])]));
+add (CProp
+("equal",
+ [CProp ("mc_flatten",[CVar 23; CVar 24]);
+  CProp ("append",[CProp ("flatten",[CVar 23]); CVar 24])]));
+add (CProp
+("equal",
+ [CProp ("member",[CVar 23; CProp ("append",[CVar 0; CVar 1])]);
+  CProp
+  ("or",
+   [CProp ("member",[CVar 23; CVar 0]);
+    CProp ("member",[CVar 23; CVar 1])])]));
+add (CProp
+("equal",
+ [CProp ("member",[CVar 23; CProp ("reverse",[CVar 24])]);
+  CProp ("member",[CVar 23; CVar 24])]));
+add (CProp
+("equal",
+ [CProp ("length",[CProp ("reverse",[CVar 23])]);
+  CProp ("length",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("member",[CVar 0; CProp ("intersect",[CVar 1; CVar 2])]);
+  CProp
+  ("and",
+   [CProp ("member",[CVar 0; CVar 1]); CProp ("member",[CVar 0; CVar 2])])]));
+add (CProp
+("equal",[CProp ("nth",[CProp ("zero",[]); CVar 8]); CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp ("exp",[CVar 8; CProp ("plus",[CVar 9; CVar 10])]);
+  CProp
+  ("times",
+   [CProp ("exp",[CVar 8; CVar 9]); CProp ("exp",[CVar 8; CVar 10])])]));
+add (CProp
+("equal",
+ [CProp ("exp",[CVar 8; CProp ("times",[CVar 9; CVar 10])]);
+  CProp ("exp",[CProp ("exp",[CVar 8; CVar 9]); CVar 10])]));
+add (CProp
+("equal",
+ [CProp ("reverse_loop",[CVar 23; CVar 24]);
+  CProp ("append",[CProp ("reverse",[CVar 23]); CVar 24])]));
+add (CProp
+("equal",
+ [CProp ("reverse_loop",[CVar 23; CProp ("nil",[])]);
+  CProp ("reverse",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("count_list",[CVar 25; CProp ("sort_lp",[CVar 23; CVar 24])]);
+  CProp
+  ("plus",
+   [CProp ("count_list",[CVar 25; CVar 23]);
+    CProp ("count_list",[CVar 25; CVar 24])])]));
+add (CProp
+("equal",
+ [CProp
+  ("equal",
+   [CProp ("append",[CVar 0; CVar 1]); CProp ("append",[CVar 0; CVar 2])]);
+  CProp ("equal",[CVar 1; CVar 2])]));
+add (CProp
+("equal",
+ [CProp
+  ("plus",
+   [CProp ("remainder",[CVar 23; CVar 24]);
+    CProp ("times",[CVar 24; CProp ("quotient",[CVar 23; CVar 24])])]);
+  CProp ("fix",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp
+  ("power_eval",[CProp ("big_plus",[CVar 11; CVar 8; CVar 1]); CVar 1]);
+  CProp ("plus",[CProp ("power_eval",[CVar 11; CVar 1]); CVar 8])]));
+add (CProp
+("equal",
+ [CProp
+  ("power_eval",
+   [CProp ("big_plus",[CVar 23; CVar 24; CVar 8; CVar 1]); CVar 1]);
+  CProp
+  ("plus",
+   [CVar 8;
+    CProp
+    ("plus",
+     [CProp ("power_eval",[CVar 23; CVar 1]);
+      CProp ("power_eval",[CVar 24; CVar 1])])])]));
+add (CProp
+("equal",
+ [CProp ("remainder",[CVar 24; CProp ("one",[])]); CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp ("lt",[CProp ("remainder",[CVar 23; CVar 24]); CVar 24]);
+  CProp ("not",[CProp ("zerop",[CVar 24])])]));
+add (CProp
+("equal",[CProp ("remainder",[CVar 23; CVar 23]); CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp ("lt",[CProp ("quotient",[CVar 8; CVar 9]); CVar 8]);
+  CProp
+  ("and",
+   [CProp ("not",[CProp ("zerop",[CVar 8])]);
+    CProp
+    ("or",
+     [CProp ("zerop",[CVar 9]);
+      CProp ("not",[CProp ("equal",[CVar 9; CProp ("one",[])])])])])]));
+add (CProp
+("equal",
+ [CProp ("lt",[CProp ("remainder",[CVar 23; CVar 24]); CVar 23]);
+  CProp
+  ("and",
+   [CProp ("not",[CProp ("zerop",[CVar 24])]);
+    CProp ("not",[CProp ("zerop",[CVar 23])]);
+    CProp ("not",[CProp ("lt",[CVar 23; CVar 24])])])]));
+add (CProp
+("equal",
+ [CProp ("power_eval",[CProp ("power_rep",[CVar 8; CVar 1]); CVar 1]);
+  CProp ("fix",[CVar 8])]));
+add (CProp
+("equal",
+ [CProp
+  ("power_eval",
+   [CProp
+    ("big_plus",
+     [CProp ("power_rep",[CVar 8; CVar 1]);
+      CProp ("power_rep",[CVar 9; CVar 1]); CProp ("zero",[]);
+      CVar 1]);
+    CVar 1]);
+  CProp ("plus",[CVar 8; CVar 9])]));
+add (CProp
+("equal",
+ [CProp ("gcd",[CVar 23; CVar 24]); CProp ("gcd",[CVar 24; CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("nth",[CProp ("append",[CVar 0; CVar 1]); CVar 8]);
+  CProp
+  ("append",
+   [CProp ("nth",[CVar 0; CVar 8]);
+    CProp
+    ("nth",
+     [CVar 1; CProp ("difference",[CVar 8; CProp ("length",[CVar 0])])])])]));
+add (CProp
+("equal",
+ [CProp ("difference",[CProp ("plus",[CVar 23; CVar 24]); CVar 23]);
+  CProp ("fix",[CVar 24])]));
+add (CProp
+("equal",
+ [CProp ("difference",[CProp ("plus",[CVar 24; CVar 23]); CVar 23]);
+  CProp ("fix",[CVar 24])]));
+add (CProp
+("equal",
+ [CProp
+  ("difference",
+   [CProp ("plus",[CVar 23; CVar 24]); CProp ("plus",[CVar 23; CVar 25])]);
+  CProp ("difference",[CVar 24; CVar 25])]));
+add (CProp
+("equal",
+ [CProp ("times",[CVar 23; CProp ("difference",[CVar 2; CVar 22])]);
+  CProp
+  ("difference",
+   [CProp ("times",[CVar 2; CVar 23]);
+    CProp ("times",[CVar 22; CVar 23])])]));
+add (CProp
+("equal",
+ [CProp ("remainder",[CProp ("times",[CVar 23; CVar 25]); CVar 25]);
+  CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp
+  ("difference",
+   [CProp ("plus",[CVar 1; CProp ("plus",[CVar 0; CVar 2])]); CVar 0]);
+  CProp ("plus",[CVar 1; CVar 2])]));
+add (CProp
+("equal",
+ [CProp
+  ("difference",
+   [CProp ("add1",[CProp ("plus",[CVar 24; CVar 25])]); CVar 25]);
+  CProp ("add1",[CVar 24])]));
+add (CProp
+("equal",
+ [CProp
+  ("lt",
+   [CProp ("plus",[CVar 23; CVar 24]); CProp ("plus",[CVar 23; CVar 25])]);
+  CProp ("lt",[CVar 24; CVar 25])]));
+add (CProp
+("equal",
+ [CProp
+  ("lt",
+   [CProp ("times",[CVar 23; CVar 25]);
+    CProp ("times",[CVar 24; CVar 25])]);
+  CProp
+  ("and",
+   [CProp ("not",[CProp ("zerop",[CVar 25])]);
+    CProp ("lt",[CVar 23; CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("lt",[CVar 24; CProp ("plus",[CVar 23; CVar 24])]);
+  CProp ("not",[CProp ("zerop",[CVar 23])])]));
+add (CProp
+("equal",
+ [CProp
+  ("gcd",
+   [CProp ("times",[CVar 23; CVar 25]);
+    CProp ("times",[CVar 24; CVar 25])]);
+  CProp ("times",[CVar 25; CProp ("gcd",[CVar 23; CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("value",[CProp ("normalize",[CVar 23]); CVar 0]);
+  CProp ("value",[CVar 23; CVar 0])]));
+add (CProp
+("equal",
+ [CProp
+  ("equal",
+   [CProp ("flatten",[CVar 23]);
+    CProp ("cons",[CVar 24; CProp ("nil",[])])]);
+  CProp
+  ("and",
+   [CProp ("nlistp",[CVar 23]); CProp ("equal",[CVar 23; CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("listp",[CProp ("gother",[CVar 23])]);
+  CProp ("listp",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("samefringe",[CVar 23; CVar 24]);
+  CProp
+  ("equal",[CProp ("flatten",[CVar 23]); CProp ("flatten",[CVar 24])])]));
+add (CProp
+("equal",
+ [CProp
+  ("equal",
+   [CProp ("greatest_factor",[CVar 23; CVar 24]); CProp ("zero",[])]);
+  CProp
+  ("and",
+   [CProp
+    ("or",
+     [CProp ("zerop",[CVar 24]);
+      CProp ("equal",[CVar 24; CProp ("one",[])])]);
+    CProp ("equal",[CVar 23; CProp ("zero",[])])])]));
+add (CProp
+("equal",
+ [CProp
+  ("equal",
+   [CProp ("greatest_factor",[CVar 23; CVar 24]); CProp ("one",[])]);
+  CProp ("equal",[CVar 23; CProp ("one",[])])]));
+add (CProp
+("equal",
+ [CProp ("numberp",[CProp ("greatest_factor",[CVar 23; CVar 24])]);
+  CProp
+  ("not",
+   [CProp
+    ("and",
+     [CProp
+      ("or",
+       [CProp ("zerop",[CVar 24]);
+        CProp ("equal",[CVar 24; CProp ("one",[])])]);
+      CProp ("not",[CProp ("numberp",[CVar 23])])])])]));
+add (CProp
+("equal",
+ [CProp ("times_list",[CProp ("append",[CVar 23; CVar 24])]);
+  CProp
+  ("times",
+   [CProp ("times_list",[CVar 23]); CProp ("times_list",[CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("prime_list",[CProp ("append",[CVar 23; CVar 24])]);
+  CProp
+  ("and",
+   [CProp ("prime_list",[CVar 23]); CProp ("prime_list",[CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CVar 25; CProp ("times",[CVar 22; CVar 25])]);
+  CProp
+  ("and",
+   [CProp ("numberp",[CVar 25]);
+    CProp
+    ("or",
+     [CProp ("equal",[CVar 25; CProp ("zero",[])]);
+      CProp ("equal",[CVar 22; CProp ("one",[])])])])]));
+add (CProp
+("equal",
+ [CProp ("ge",[CVar 23; CVar 24]);
+  CProp ("not",[CProp ("lt",[CVar 23; CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CVar 23; CProp ("times",[CVar 23; CVar 24])]);
+  CProp
+  ("or",
+   [CProp ("equal",[CVar 23; CProp ("zero",[])]);
+    CProp
+    ("and",
+     [CProp ("numberp",[CVar 23]);
+      CProp ("equal",[CVar 24; CProp ("one",[])])])])]));
+add (CProp
+("equal",
+ [CProp ("remainder",[CProp ("times",[CVar 24; CVar 23]); CVar 24]);
+  CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CProp ("times",[CVar 0; CVar 1]); CProp ("one",[])]);
+  CProp
+  ("and",
+   [CProp ("not",[CProp ("equal",[CVar 0; CProp ("zero",[])])]);
+    CProp ("not",[CProp ("equal",[CVar 1; CProp ("zero",[])])]);
+    CProp ("numberp",[CVar 0]); CProp ("numberp",[CVar 1]);
+    CProp ("equal",[CProp ("sub1",[CVar 0]); CProp ("zero",[])]);
+    CProp ("equal",[CProp ("sub1",[CVar 1]); CProp ("zero",[])])])]));
+add (CProp
+("equal",
+ [CProp
+  ("lt",
+   [CProp ("length",[CProp ("delete",[CVar 23; CVar 11])]);
+    CProp ("length",[CVar 11])]);
+  CProp ("member",[CVar 23; CVar 11])]));
+add (CProp
+("equal",
+ [CProp ("sort2",[CProp ("delete",[CVar 23; CVar 11])]);
+  CProp ("delete",[CVar 23; CProp ("sort2",[CVar 11])])]));
+add (CProp ("equal",[CProp ("dsort",[CVar 23]); CProp ("sort2",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp
+  ("length",
+   [CProp
+    ("cons",
+     [CVar 0;
+      CProp
+      ("cons",
+       [CVar 1;
+        CProp
+        ("cons",
+         [CVar 2;
+          CProp
+          ("cons",
+           [CVar 3;
+            CProp ("cons",[CVar 4; CProp ("cons",[CVar 5; CVar 6])])])])])])])
+  ; CProp ("plus",[CProp ("six",[]); CProp ("length",[CVar 6])])]));
+add (CProp
+("equal",
+ [CProp
+  ("difference",
+   [CProp ("add1",[CProp ("add1",[CVar 23])]); CProp ("two",[])]);
+  CProp ("fix",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp
+  ("quotient",
+   [CProp ("plus",[CVar 23; CProp ("plus",[CVar 23; CVar 24])]);
+    CProp ("two",[])]);
+  CProp
+  ("plus",[CVar 23; CProp ("quotient",[CVar 24; CProp ("two",[])])])]));
+add (CProp
+("equal",
+ [CProp ("sigma",[CProp ("zero",[]); CVar 8]);
+  CProp
+  ("quotient",
+   [CProp ("times",[CVar 8; CProp ("add1",[CVar 8])]); CProp ("two",[])])]));
+add (CProp
+("equal",
+ [CProp ("plus",[CVar 23; CProp ("add1",[CVar 24])]);
+  CProp
+  ("if",
+   [CProp ("numberp",[CVar 24]);
+    CProp ("add1",[CProp ("plus",[CVar 23; CVar 24])]);
+    CProp ("add1",[CVar 23])])]));
+add (CProp
+("equal",
+ [CProp
+  ("equal",
+   [CProp ("difference",[CVar 23; CVar 24]);
+    CProp ("difference",[CVar 25; CVar 24])]);
+  CProp
+  ("if",
+   [CProp ("lt",[CVar 23; CVar 24]);
+    CProp ("not",[CProp ("lt",[CVar 24; CVar 25])]);
+    CProp
+    ("if",
+     [CProp ("lt",[CVar 25; CVar 24]);
+      CProp ("not",[CProp ("lt",[CVar 24; CVar 23])]);
+      CProp ("equal",[CProp ("fix",[CVar 23]); CProp ("fix",[CVar 25])])])])])
+);
+add (CProp
+("equal",
+ [CProp
+  ("meaning",
+   [CProp ("plus_tree",[CProp ("delete",[CVar 23; CVar 24])]); CVar 0]);
+  CProp
+  ("if",
+   [CProp ("member",[CVar 23; CVar 24]);
+    CProp
+    ("difference",
+     [CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0]);
+      CProp ("meaning",[CVar 23; CVar 0])]);
+    CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0])])]));
+add (CProp
+("equal",
+ [CProp ("times",[CVar 23; CProp ("add1",[CVar 24])]);
+  CProp
+  ("if",
+   [CProp ("numberp",[CVar 24]);
+    CProp
+    ("plus",
+     [CVar 23; CProp ("times",[CVar 23; CVar 24]);
+      CProp ("fix",[CVar 23])])])]));
+add (CProp
+("equal",
+ [CProp ("nth",[CProp ("nil",[]); CVar 8]);
+  CProp
+  ("if",[CProp ("zerop",[CVar 8]); CProp ("nil",[]); CProp ("zero",[])])]));
+add (CProp
+("equal",
+ [CProp ("last",[CProp ("append",[CVar 0; CVar 1])]);
+  CProp
+  ("if",
+   [CProp ("listp",[CVar 1]); CProp ("last",[CVar 1]);
+    CProp
+    ("if",
+     [CProp ("listp",[CVar 0]);
+      CProp ("cons",[CProp ("car",[CProp ("last",[CVar 0])]); CVar 1]);
+      CVar 1])])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CProp ("lt",[CVar 23; CVar 24]); CVar 25]);
+  CProp
+  ("if",
+   [CProp ("lt",[CVar 23; CVar 24]);
+    CProp ("equal",[CProp ("true",[]); CVar 25]);
+    CProp ("equal",[CProp ("false",[]); CVar 25])])]));
+add (CProp
+("equal",
+ [CProp ("assignment",[CVar 23; CProp ("append",[CVar 0; CVar 1])]);
+  CProp
+  ("if",
+   [CProp ("assignedp",[CVar 23; CVar 0]);
+    CProp ("assignment",[CVar 23; CVar 0]);
+    CProp ("assignment",[CVar 23; CVar 1])])]));
+add (CProp
+("equal",
+ [CProp ("car",[CProp ("gother",[CVar 23])]);
+  CProp
+  ("if",
+   [CProp ("listp",[CVar 23]);
+    CProp ("car",[CProp ("flatten",[CVar 23])]); CProp ("zero",[])])]));
+add (CProp
+("equal",
+ [CProp ("flatten",[CProp ("cdr",[CProp ("gother",[CVar 23])])]);
+  CProp
+  ("if",
+   [CProp ("listp",[CVar 23]);
+    CProp ("cdr",[CProp ("flatten",[CVar 23])]);
+    CProp ("cons",[CProp ("zero",[]); CProp ("nil",[])])])]));
+add (CProp
+("equal",
+ [CProp ("quotient",[CProp ("times",[CVar 24; CVar 23]); CVar 24]);
+  CProp
+  ("if",
+   [CProp ("zerop",[CVar 24]); CProp ("zero",[]);
+    CProp ("fix",[CVar 23])])]));
+add (CProp
+("equal",
+ [CProp ("get",[CVar 9; CProp ("set",[CVar 8; CVar 21; CVar 12])]);
+  CProp
+  ("if",
+   [CProp ("eqp",[CVar 9; CVar 8]); CVar 21;
+    CProp ("get",[CVar 9; CVar 12])])]))
+
+(* Tautology checker *)
+
+let truep x lst =
+  match x with
+    Prop(head, _) ->
+      head.name = "true" || List.mem x lst
+  | _ ->
+      List.mem x lst
+
+and falsep x lst =
+  match x with
+    Prop(head, _) ->
+      head.name = "false" || List.mem x lst
+  | _ ->
+      List.mem x lst
+
+
+let rec tautologyp x true_lst false_lst =
+ if truep x true_lst then true else
+ if falsep x false_lst then false else begin
+(*
+ print_term x; print_newline();
+*)
+ match x with
+     Var _ -> false
+   | Prop (head,[test; yes; no]) ->
+        if head.name = "if" then
+          if truep test true_lst then
+            tautologyp yes true_lst false_lst
+          else if falsep test false_lst then
+            tautologyp no true_lst false_lst
+          else tautologyp yes (test::true_lst) false_lst &&
+               tautologyp no true_lst (test::false_lst)
+        else
+          false
+   | _ -> assert false
+  end
+
+
+let tautp x =
+(*  print_term x; print_string"\n"; *)
+  let y = rewrite x in
+(*    print_term y; print_string "\n"; *)
+    tautologyp y [] []
+
+(* the benchmark *)
+
+let subst =
+[Bind(23, cterm_to_term(
+             CProp
+              ("f",
+               [CProp
+                ("plus",
+                 [CProp ("plus",[CVar 0; CVar 1]);
+                  CProp ("plus",[CVar 2; CProp ("zero",[])])])])));
+ Bind(24, cterm_to_term(
+             CProp
+              ("f",
+               [CProp
+                ("times",
+                 [CProp ("times",[CVar 0; CVar 1]);
+                  CProp ("plus",[CVar 2; CVar 3])])])));
+ Bind(25, cterm_to_term(
+             CProp
+              ("f",
+               [CProp
+                ("reverse",
+                 [CProp
+                  ("append",
+                   [CProp ("append",[CVar 0; CVar 1]);
+                    CProp ("nil",[])])])])));
+ Bind(20, cterm_to_term(
+             CProp
+              ("equal",
+               [CProp ("plus",[CVar 0; CVar 1]);
+                CProp ("difference",[CVar 23; CVar 24])])));
+ Bind(22, cterm_to_term(
+             CProp
+              ("lt",
+               [CProp ("remainder",[CVar 0; CVar 1]);
+                CProp ("member",[CVar 0; CProp ("length",[CVar 1])])])))]
+
+let term = cterm_to_term(
+           CProp
+            ("implies",
+             [CProp
+              ("and",
+               [CProp ("implies",[CVar 23; CVar 24]);
+                CProp
+                ("and",
+                 [CProp ("implies",[CVar 24; CVar 25]);
+                  CProp
+                  ("and",
+                   [CProp ("implies",[CVar 25; CVar 20]);
+                    CProp ("implies",[CVar 20; CVar 22])])])]);
+              CProp ("implies",[CVar 23; CVar 22])]))
+
+let _ =
+  let ok = ref true in
+  for i = 1 to 10 do
+    if not (tautp (apply_subst subst term)) then ok := false
+  done;
+  if !ok then
+    print_string "Proved!\n"
+  else
+    print_string "Cannot prove!\n";
+  exit 0
diff --git a/testsuite/tests/misc/boyer.reference b/testsuite/tests/misc/boyer.reference
new file mode 100644
index 00000000..f38e3263
--- /dev/null
+++ b/testsuite/tests/misc/boyer.reference
@@ -0,0 +1 @@
+Proved!
diff --git a/testsuite/tests/misc/ephetest.ml b/testsuite/tests/misc/ephetest.ml
new file mode 100644
index 00000000..5db285ae
--- /dev/null
+++ b/testsuite/tests/misc/ephetest.ml
@@ -0,0 +1,171 @@
+(* TEST
+*)
+
+let debug = false
+
+open Printf
+open Ephemeron
+
+let is_true test s b = printf "%s %s: %s\n" test s (if b then "OK" else "FAIL")
+let is_false test s b = is_true test s (not b)
+
+let is_data_value test eph (v:int) =
+  match K1.get_data_copy eph with
+  | Some x ->
+      if !x = v
+      then printf "%s data set: OK\n" test
+      else printf "%s data set: FAIL(bad value %i)\n" test (!x)
+  | None -> printf "%s data set: FAIL\n" test
+
+let is_key_value test eph (v:int) =
+  match K1.get_key_copy eph with
+  | Some x ->
+      if !x = v
+      then printf "%s key set: OK\n" test
+      else printf "%s key set: FAIL(bad value %i)\n" test (!x)
+  | None -> printf "%s key unset: FAIL\n" test
+
+let is_key_unset test eph =
+  is_false test "key unset" (K1.check_key eph)
+
+let is_data_unset test eph =
+  is_false test "data unset" (K1.check_data eph)
+
+let make_ra () = ref (ref 1) [@@inline never]
+let make_rb () = ref (ref (ref 2)) [@@inline never]
+let ra = make_ra ()
+let rb = make_rb ()
+
+(** test: key alive data dangling *)
+let test1 () =
+  let test = "test1" in
+  Gc.minor ();
+  Gc.full_major ();
+  let eph : (int ref, int ref) K1.t = K1.create () in
+  K1.set_key eph (!ra);
+  K1.set_data eph (ref 42);
+  is_key_value test eph 1;
+  is_data_value test eph 42;
+  Gc.minor ();
+  is_key_value test eph 1;
+  is_data_value test eph 42;
+  Gc.full_major ();
+  is_key_value test eph 1;
+  is_data_value test eph 42;
+  ra := ref 12;
+  Gc.full_major ();
+  is_key_unset test eph;
+  is_data_unset test eph
+let () = (test1 [@inlined never]) ()
+
+(** test: key dangling data dangling *)
+let test2 () =
+  let test = "test2" in
+  Gc.minor ();
+  Gc.full_major ();
+  let eph : (int ref, int ref) K1.t = K1.create () in
+  K1.set_key eph (ref 125);
+  K1.set_data eph (ref 42);
+  is_key_value test eph 125;
+  is_data_value test eph 42;
+  ra := ref 13;
+  Gc.minor ();
+  is_key_unset test eph;
+  is_data_unset test eph
+let () = (test2 [@inlined never]) ()
+
+(** test: key dangling data alive *)
+let test3 () =
+  let test = "test3" in
+  Gc.minor ();
+  Gc.full_major ();
+  let eph : (int ref, int ref) K1.t = K1.create () in
+  K1.set_key eph (ref 125);
+  K1.set_data eph (!ra);
+  is_key_value test eph 125;
+  is_data_value test eph 13;
+  ra := ref 14;
+  Gc.minor ();
+  is_key_unset test eph;
+  is_data_unset test eph
+let () = (test3 [@inlined never]) ()
+
+(** test: key alive but one away, data dangling *)
+let test4 () =
+  let test = "test4" in
+  Gc.minor ();
+  Gc.full_major ();
+  let eph : (int ref, int ref) K1.t = K1.create () in
+  rb := ref (ref 3);
+  K1.set_key eph (!(!rb));
+  K1.set_data eph (ref 43);
+  is_key_value test eph 3;
+  is_data_value test eph 43;
+  Gc.minor ();
+  Gc.minor ();
+  is_key_value test eph 3;
+  is_data_value test eph 43
+let () = (test4 [@inlined never]) ()
+
+(** test: key dangling but one away, data dangling *)
+let test5 () =
+  let test = "test5" in
+  Gc.minor ();
+  Gc.full_major ();
+  let eph : (int ref, int ref) K1.t = K1.create () in
+  rb := ref (ref 3);
+  K1.set_key eph (!(!rb));
+  K1.set_data eph (ref 43);
+  is_key_value test eph 3;
+  is_data_value test eph 43;
+  !rb := ref 4;
+  Gc.minor ();
+  Gc.minor ();
+  is_key_unset test eph;
+  is_data_unset test eph
+let () = (test5 [@inlined never]) ()
+
+(** test: key accessible from data but all dangling *)
+let test6 () =
+  let test = "test6" in
+  Gc.minor ();
+  Gc.full_major ();
+  let eph : (int ref, int ref ref) K1.t = K1.create () in
+  rb := ref (ref 3);
+  K1.set_key eph (!(!rb));
+  K1.set_data eph (ref (!(!rb)));
+  Gc.minor ();
+  is_key_value test eph 3;
+  !rb := ref 4;
+  Gc.full_major ();
+  is_key_unset test eph;
+  is_data_unset test eph
+let () = (test6 [@inlined never]) ()
+
+(** test: ephemeron accessible from data but they are dangling *)
+type t =
+  | No
+  | Ephe of (int ref, t) K1.t
+
+let rc = ref No
+
+let test7 () =
+  let test = "test7" in
+  Gc.minor ();
+  Gc.full_major ();
+  ra := ref 42;
+  let weak : t Weak.t = Weak.create 1 in
+  let eph : (int ref, t) K1.t ref = ref (K1.create ()) in
+  rc := Ephe !eph;
+  Weak.set weak 0 (Some !rc);
+  K1.set_key !eph !ra;
+  K1.set_data !eph !rc;
+  Gc.minor ();
+  is_true test "before" (Weak.check weak 0);
+  eph := K1.create ();
+  rc := No;
+  Gc.full_major ();
+  Gc.full_major ();
+  Gc.full_major ();
+  is_false test "after" (Weak.check weak 0)
+let () = (test7 [@inlined never]) ()
diff --git a/testsuite/tests/misc/ephetest.reference b/testsuite/tests/misc/ephetest.reference
new file mode 100644
index 00000000..2699fdf7
--- /dev/null
+++ b/testsuite/tests/misc/ephetest.reference
@@ -0,0 +1,29 @@
+test1 key set: OK
+test1 data set: OK
+test1 key set: OK
+test1 data set: OK
+test1 key set: OK
+test1 data set: OK
+test1 key unset: OK
+test1 data unset: OK
+test2 key set: OK
+test2 data set: OK
+test2 key unset: OK
+test2 data unset: OK
+test3 key set: OK
+test3 data set: OK
+test3 key unset: OK
+test3 data unset: OK
+test4 key set: OK
+test4 data set: OK
+test4 key set: OK
+test4 data set: OK
+test5 key set: OK
+test5 data set: OK
+test5 key unset: OK
+test5 data unset: OK
+test6 key set: OK
+test6 key unset: OK
+test6 data unset: OK
+test7 before: OK
+test7 after: OK
diff --git a/testsuite/tests/misc/ephetest2.ml b/testsuite/tests/misc/ephetest2.ml
new file mode 100644
index 00000000..1b92172b
--- /dev/null
+++ b/testsuite/tests/misc/ephetest2.ml
@@ -0,0 +1,153 @@
+(* TEST
+*)
+
+(***
+   This test evaluate boolean formula composed by conjunction and
+     disjunction using ephemeron:
+   - true == alive, false == garbage collected
+   - and == an n-ephemeron, or == many 1-ephemeron
+
+*)
+
+let nb_test = 4
+let max_level = 10
+ (** probability that a branch is not linked to a previous one *)
+let proba_no_shared = 0.2
+let arity_max = 4
+
+let proba_new = proba_no_shared ** (1./.(float_of_int max_level))
+
+open Format
+open Ephemeron
+
+let is_true test s b = printf "%s %s: %s\n" test s (if b then "OK" else "FAIL")
+let is_false test s b = is_true test s (not b)
+
+type varephe = int ref
+type ephe = (varephe,varephe) Kn.t
+
+type formula =
+  | Constant of bool
+  | And of var array
+  | Or of var array
+
+and var = {
+  form: formula;
+  value: bool;
+  ephe: varephe Weak.t;
+}
+
+let print_short_bool fmt b =
+  if b
+  then pp_print_string fmt "t"
+  else pp_print_string fmt "f"
+
+let rec pp_form fmt = function
+  | Constant b ->
+      fprintf fmt "%B" b
+  | And a      ->
+      fprintf fmt "And[@[%a@]]" (fun fmt -> Array.iter (pp_var fmt)) a
+  | Or a       ->
+      fprintf fmt  "Or[@[%a@]]" (fun fmt -> Array.iter (pp_var fmt)) a
+
+and pp_var fmt v =
+  fprintf fmt "%a%a:%a;@ "
+    print_short_bool v.value
+    print_short_bool (Weak.check v.ephe 0)
+    pp_form v.form
+
+type env = {
+  (** resizable array for cheap *)
+  vars : (int,var) Hashtbl.t;
+  (** the ephemerons must be alive *)
+  ephes : ephe Stack.t;
+  (** keep alive the true constant *)
+  varephe_true : varephe Stack.t;
+(** keep temporarily alive the false constant *)
+  varephe_false : varephe Stack.t;
+}
+
+let new_env () = {
+  vars = Hashtbl.create 100;
+  ephes = Stack.create ();
+  varephe_true = Stack.create ();
+  varephe_false = Stack.create ();
+}
+
+let evaluate = function
+  | Constant b -> b
+  | And a -> Array.fold_left (fun acc e -> acc && e.value) true  a
+  | Or a  -> Array.fold_left (fun acc e -> acc || e.value) false a
+
+let get_ephe v =
+  match Weak.get v.ephe 0 with
+  | None ->
+      invalid_arg "Error: weak dead but nothing have been released"
+  | Some r -> r
+
+(** create a variable and its definition in the boolean world and
+    ephemerons world *)
+let rec create env rem_level (** remaining level *) =
+  let varephe = ref 1 in
+  let form =
+    if rem_level = 0 then (** Constant *)
+      if Random.bool ()
+      then (Stack.push varephe env.varephe_true ; Constant true )
+      else (Stack.push varephe env.varephe_false; Constant false)
+    else
+      let size = (Random.int (arity_max - 1)) + 2 in
+      let new_link _ =
+        if (Hashtbl.length env.vars) = 0 || Random.float 1. < proba_new
+        then create env (rem_level -1)
+        else Hashtbl.find env.vars (Random.int (Hashtbl.length env.vars))
+      in
+      let args = Array.init size new_link in
+      if Random.bool ()
+      then begin (** Or *)
+        Array.iter (fun v ->
+            let r = get_ephe v in
+            let e = Kn.create 1 in
+            Kn.set_key e 0 r;
+            Kn.set_data e varephe;
+            Stack.push e env.ephes
+          ) args; Or args
+      end
+      else begin (** And *)
+        let e = Kn.create (Array.length args) in
+        for i=0 to Array.length args - 1 do
+          Kn.set_key e i (get_ephe args.(i));
+        done;
+        Kn.set_data e varephe;
+        Stack.push e env.ephes;
+        And args
+      end
+  in
+  let create_weak e =
+    let w = Weak.create 1 in
+    Weak.set w 0 (Some e);
+    w
+  in
+  let v = {form; value = evaluate form;
+           ephe = create_weak varephe;
+          } in
+  Hashtbl.add env.vars (Hashtbl.length env.vars) v;
+  v
+
+
+let check_var v = v.value = Weak.check v.ephe 0
+
+let run test init =
+  Random.init init;
+  let env = new_env () in
+  let _top = create env max_level in
+  (** release false ref *)
+  Stack.clear env.varephe_false;
+  Gc.full_major ();
+  let res = Hashtbl.fold (fun _ v acc -> acc && check_var v) env.vars true in
+  is_true test "check" res;
+  env (* Keep env.varephe_true alive. *)
+
+let () =
+  for i = 0 to nb_test do
+    ignore (run ("test"^(Int.to_string i)) i);
+  done
diff --git a/testsuite/tests/misc/ephetest2.reference b/testsuite/tests/misc/ephetest2.reference
new file mode 100644
index 00000000..db17cd7a
--- /dev/null
+++ b/testsuite/tests/misc/ephetest2.reference
@@ -0,0 +1,5 @@
+test0 check: OK
+test1 check: OK
+test2 check: OK
+test3 check: OK
+test4 check: OK
diff --git a/testsuite/tests/misc/ephetest3.ml b/testsuite/tests/misc/ephetest3.ml
new file mode 100644
index 00000000..e9c2b0f1
--- /dev/null
+++ b/testsuite/tests/misc/ephetest3.ml
@@ -0,0 +1,124 @@
+(* TEST
+*)
+
+(** This test weak table by application to the memoization of collatz
+    (also known as syracuse) algorithm suite computation *)
+
+(** We use Int64 because they are boxed *)
+
+(** number of element of the suite to compute (more are computed) *)
+let n = 1000
+
+let two = Int64.of_int 2
+let three = Int64.of_int 3
+
+let collatz x =
+  if Int64.equal (Int64.rem x two) Int64.zero
+  then Int64.div x two
+  else Int64.succ (Int64.mul x three)
+
+module S = struct
+  include Int64
+  let hash (x:t) = Hashtbl.hash x
+end
+
+let pp = Int64.to_string
+
+module HW = Ephemeron.K1.Make(S)
+module SW = Weak.Make(S)
+
+
+let sw = SW.create n
+let hashcons x = SW.merge sw x
+
+let hw = HW.create n
+
+let rec fill_hw x =
+  if not (HW.mem hw x) then begin
+    let y = hashcons (collatz x) in
+    HW.add hw x y;
+    fill_hw y
+  end
+
+exception InvariantBroken of string
+let test b = Printf.ksprintf (fun s -> if not b then raise (InvariantBroken s))
+
+let rec check_hw_aux cache x =
+  (** We use int so that the cache doesn't make x alive *)
+  if not (Hashtbl.mem cache (Int64.to_int x)) then begin
+    test (HW.mem hw x) "missing %s%!" (pp x);
+    let y =
+      try HW.find hw x
+      with Not_found ->
+        test (not (HW.mem hw x)) "key in the table but data missing %s!%!"
+          (pp x);
+        test false "missing %s%!" (pp x);
+        assert false
+    in
+    let y' = collatz x in
+    test (Int64.equal y y') "bad result for %s: %s instead of %s%!"
+      (pp x) (pp y) (pp y');
+    let y'' = hashcons y' in
+    test (y == y'') "bad result for %s: not physically equal%!" (pp x);
+    Hashtbl.add cache (Int64.to_int x) ();
+    check_hw_aux cache y
+  end
+
+let check_hw iter =
+  let cache = Hashtbl.create n in
+  iter (fun x -> check_hw_aux cache x)
+
+(** tests *)
+
+let run ~next ~check =
+  HW.reset hw;
+  SW.clear sw;
+  (* Gc.full_major (); *)
+  for x=0 to n do
+    let x' = next x in
+    fill_hw x';
+    check x;
+  done;
+  Gc.full_major ();
+  HW.clean hw;
+  Printf.printf "length: %i\n%!" (HW.length hw)
+
+let print_stats () =
+  let print_stats name stats =
+    Printf.printf "%s (%3i,%3i,%3i): %!"
+      name
+      stats.Hashtbl.num_bindings
+      stats.Hashtbl.num_buckets
+      stats.Hashtbl.max_bucket_length;
+    Array.iteri (fun i n -> Printf.printf "%i: %i, %!" i n)
+      stats.Hashtbl.bucket_histogram;
+    Printf.printf "\n%!";
+  in
+  print_stats "stats      : " (HW.stats hw);
+  print_stats "stats_alive: " (HW.stats_alive hw)
+
+let test_keep_last d d' =
+  Printf.printf "## Keep last %i alive, check each %i ##\n%!" (n/d) (n/d');
+  let keep_alive = Array.make (n/d) Int64.zero in
+  let next x =
+    let x' = hashcons (Int64.of_int x) in
+    Array.set keep_alive (x mod (n/d)) x';
+    x'
+  in
+  let check x =
+    if x mod (n/d') = 0 || x = n then begin
+      check_hw (fun f -> Array.iter f keep_alive)
+    end
+  in
+  run ~next ~check;
+  (** keep the array alive until the end *)
+  let s =
+    Array.fold_left (fun acc x -> Int64.add x acc) Int64.zero keep_alive in
+  Printf.printf "sum of kept alive %s\n%!" (pp s);
+  print_stats ();
+  Printf.printf "\n%!"
+
+let () =
+  test_keep_last 1 10;
+  test_keep_last 50 10;
+  test_keep_last 100 2
diff --git a/testsuite/tests/misc/ephetest3.reference b/testsuite/tests/misc/ephetest3.reference
new file mode 100644
index 00000000..4fd03fb9
--- /dev/null
+++ b/testsuite/tests/misc/ephetest3.reference
@@ -0,0 +1,18 @@
+## Keep last 1000 alive, check each 100 ##
+length: 2228
+sum of kept alive 500500
+stats      :  (2228,2048,  6): 0: 658, 1: 791, 2: 413, 3: 143, 4: 34, 5: 8, 6: 1, 
+stats_alive:  (2228,2048,  6): 0: 658, 1: 791, 2: 413, 3: 143, 4: 34, 5: 8, 6: 1, 
+
+## Keep last 20 alive, check each 100 ##
+length: 458
+sum of kept alive 19810
+stats      :  (458,2048,  3): 0: 1636, 1: 370, 2: 38, 3: 4, 
+stats_alive:  (458,2048,  3): 0: 1636, 1: 370, 2: 38, 3: 4, 
+
+## Keep last 10 alive, check each 500 ##
+length: 339
+sum of kept alive 9955
+stats      :  (339,2048,  3): 0: 1740, 1: 279, 2: 27, 3: 2, 
+stats_alive:  (339,2048,  3): 0: 1740, 1: 279, 2: 27, 3: 2, 
+
diff --git a/testsuite/tests/misc/exotic.ml b/testsuite/tests/misc/exotic.ml
new file mode 100644
index 00000000..33674cb4
--- /dev/null
+++ b/testsuite/tests/misc/exotic.ml
@@ -0,0 +1,59 @@
+(* TEST
+   flags = "-I ${ocamlsrcdir}/utils"
+   * expect
+*)
+
+(* Strict-sequence can change the behavior of programs *)
+
+(* The two examples below were proposed by Jeremy Yallop in
+   https://github.com/ocaml/ocaml/pull/1971 .
+   Note that those tests are here to record this behavior and not to enshrine it.
+*)
+
+[@@@warning "-10-18-8-5"];;
+type t = A | () and b = B : _ -> b;;
+[%%expect{|
+type t = A | ()
+and b = B : 'a -> b
+|}];;
+
+Clflags.strict_sequence := false ;;
+let f (g : 'a) = g; Format.printf "%b@." (B (() : 'a) = B A) in f ();;
+[%%expect {|
+- : unit = ()
+false
+- : unit = ()
+|}]
+;;
+
+Clflags.strict_sequence := true ;;
+let f (g : 'a) = g; Format.printf "%b@." (B (() : 'a) = B A) in f ();;
+[%%expect {|
+- : unit = ()
+true
+- : unit = ()
+|}]
+;;
+
+Clflags.strict_sequence := false;;
+let f () = let g ~y = (raise Not_found : 'a) in
+           if false then ((assert false : 'a); g ()) else g ()
+let _ = Format.printf "%b@." (try f (); false with Not_found -> true)
+[%%expect {|
+- : unit = ()
+val f : t -> y:'a -> 'b = <fun>
+false
+- : unit = ()
+|}]
+;;
+
+Clflags.strict_sequence := true ;;
+let f () = let g ~y = (raise Not_found : 'a) in
+           if false then ((assert false : 'a); g ()) else g ()
+let _ = Format.printf "%b@." (try f (); false with Not_found -> true)
+[%%expect {|
+- : unit = ()
+val f : t -> unit = <fun>
+true
+- : unit = ()
+|}]
diff --git a/testsuite/tests/misc/fib.ml b/testsuite/tests/misc/fib.ml
new file mode 100644
index 00000000..46c34193
--- /dev/null
+++ b/testsuite/tests/misc/fib.ml
@@ -0,0 +1,12 @@
+(* TEST
+*)
+
+let rec fib n =
+  if n < 2 then 1 else fib(n-1) + fib(n-2)
+
+let _ =
+  let n =
+    if Array.length Sys.argv >= 2
+    then int_of_string Sys.argv.(1)
+    else 30 in
+  print_int(fib n); print_newline(); exit 0
diff --git a/testsuite/tests/misc/fib.reference b/testsuite/tests/misc/fib.reference
new file mode 100644
index 00000000..08c2ab3e
--- /dev/null
+++ b/testsuite/tests/misc/fib.reference
@@ -0,0 +1 @@
+1346269
diff --git a/testsuite/tests/misc/finaliser.ml b/testsuite/tests/misc/finaliser.ml
new file mode 100644
index 00000000..68cb7b26
--- /dev/null
+++ b/testsuite/tests/misc/finaliser.ml
@@ -0,0 +1,69 @@
+(* TEST
+*)
+
+let m = 1000
+let m' = 100
+let k = m*10
+
+(** the printing are not stable between ocamlc and ocamlopt *)
+let debug = false
+
+let gc_print where _ =
+  if debug then
+    let stat = Gc.quick_stat () in
+    Printf.printf "minor: %i major: %i %s\n%!"
+      stat.Gc.minor_collections
+      stat.Gc.major_collections
+      where
+
+let r = Array.init m (fun _ -> Array.make m 1)
+
+
+let () =
+  gc_print "[Before]" ();
+  let rec aux n =
+    if n < k then begin
+      r.(n mod m) <- (Array.make m' n);
+      begin match n mod m with
+      | 0 ->
+          (** finalise first major *)
+          gc_print (Printf.sprintf "[Create %i first]" n) ();
+          Gc.finalise (gc_print (Printf.sprintf "[Finalise %i first]" n)) r.(0)
+      | 1 ->
+          (** finalise last major *)
+          gc_print (Printf.sprintf "[Create %i last]" n) ();
+          Gc.finalise_last
+            (gc_print (Printf.sprintf "[Finalise %i last]" n)) r.(1)
+      | 2 ->
+          (** finalise first minor *)
+          let m = ref 1 in
+          gc_print (Printf.sprintf "[Create %i first minor]" n) ();
+          Gc.finalise
+            (gc_print (Printf.sprintf "[Finalise %i first minor]" n)) m
+      | 3 ->
+          (** finalise last minor *)
+          let m = ref 1 in
+          gc_print (Printf.sprintf "[Create %i last minor]" n) ();
+          Gc.finalise_last
+            (gc_print (Printf.sprintf "[Finalise %i last minor]" n)) m
+      | 4 ->
+          (** finalise first-last major *)
+          gc_print (Printf.sprintf "[Create %i first]" n) ();
+          Gc.finalise (gc_print (Printf.sprintf "[Finalise %i first]" n)) r.(4);
+          Gc.finalise_last
+            (gc_print (Printf.sprintf "[Finalise %i first]" n)) r.(4)
+      | _ -> ()
+      end;
+      aux (n + 1)
+    end
+  in
+  aux 0;
+  gc_print "[Full major]" ();
+  Gc.full_major ();
+  gc_print "[Second full major]" ();
+  Gc.full_major ();
+  gc_print "[Third full major]" ();
+  Gc.full_major ();
+  ()
+
+let () = flush stdout
diff --git a/testsuite/tests/misc/finaliser.reference b/testsuite/tests/misc/finaliser.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/misc/gcwords.ml b/testsuite/tests/misc/gcwords.ml
new file mode 100644
index 00000000..45125adc
--- /dev/null
+++ b/testsuite/tests/misc/gcwords.ml
@@ -0,0 +1,29 @@
+(* TEST
+*)
+
+type t = Leaf of int | Branch of t * t
+
+type floatref = { mutable f : float }
+
+let a = { f = 0.0 }
+
+let rec allocate_lots m = function
+  | 0 -> Leaf m
+  | n -> Branch (allocate_lots m (n-1), allocate_lots (m+1) (n-1))
+
+let measure f =
+  let a = Gc.minor_words () in
+  f ();
+  let c = Gc.minor_words () in
+  c -. a
+
+let () =
+  let n = measure (fun () -> a.f <- Gc.minor_words ()) in
+  (* Gc.minor_words should not allocate, although bytecode
+     generally boxes the floats *)
+  assert (n < 10.);
+  if Sys.backend_type = Sys.Native then assert (n = 0.);
+  let n = measure (fun () -> Sys.opaque_identity (allocate_lots 42 10)) in
+  (* This should allocate > 3k words (varying slightly by unboxing) *)
+  assert (n > 3000.);
+  print_endline "ok"
diff --git a/testsuite/tests/misc/gcwords.reference b/testsuite/tests/misc/gcwords.reference
new file mode 100644
index 00000000..9766475a
--- /dev/null
+++ b/testsuite/tests/misc/gcwords.reference
@@ -0,0 +1 @@
+ok
diff --git a/testsuite/tests/misc/gpr1370.ml b/testsuite/tests/misc/gpr1370.ml
new file mode 100644
index 00000000..9cd0fedf
--- /dev/null
+++ b/testsuite/tests/misc/gpr1370.ml
@@ -0,0 +1,22 @@
+(* TEST
+*)
+
+type t = A|B|C|D
+type s =
+  | G of t
+  | E of t
+  | H of t
+  | F of (unit list * t)
+  | I of t
+
+let r = ref 0
+
+let set x = r := x
+
+let f x =
+  match x with
+  | E B | F ([()], B) -> set 0
+  | E x | F ([()], x) when Sys.opaque_identity true -> set 1
+  | E _ -> set 2
+  | F _ -> set 3
+  | G _ | H _ | I _ -> set 4
diff --git a/testsuite/tests/misc/gpr1370.reference b/testsuite/tests/misc/gpr1370.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/misc/hamming.ml b/testsuite/tests/misc/hamming.ml
new file mode 100644
index 00000000..f4010ac4
--- /dev/null
+++ b/testsuite/tests/misc/hamming.ml
@@ -0,0 +1,94 @@
+(* TEST
+*)
+
+(* We cannot use bignums because we don't do custom runtimes, but
+   int64 is a bit short, so we roll our own 37-digit numbers...
+*)
+
+let n0 = Int64.of_int 0;;
+let n1 = Int64.of_int 1;;
+let n2 = Int64.of_int 2;;
+let n3 = Int64.of_int 3;;
+let n5 = Int64.of_int 5;;
+
+let ( % ) = Int64.rem;;
+let ( * ) = Int64.mul;;
+let ( / ) = Int64.div;;
+let ( + ) = Int64.add;;
+let digit = Int64.of_string "1000000000000000000";;
+
+let mul n (pl, ph) = ((n * pl) % digit, n * ph + (n * pl) / digit);;
+let cmp (nl, nh) (pl, ph) =
+  if nh < ph then -1
+  else if nh > ph then 1
+  else if nl < pl then -1
+  else if nl > pl then 1
+  else 0
+;;
+
+let x2 = fun p -> mul n2 p;;
+let x3 = fun p -> mul n3 p;;
+let x5 = fun p -> mul n5 p;;
+
+let nn1 = (n1, n0);;
+
+let pr (nl, nh) =
+  if compare nh n0 = 0
+  then Printf.printf "%Ld\n" nl
+  else Printf.printf "%Ld%018Ld\n" nh nl
+;;
+
+(*
+  (* bignum version *)
+open Num;;
+let nn1 = num_of_int 1;;
+let x2 = fun p -> (num_of_int 2) */ p;;
+let x3 = fun p -> (num_of_int 3) */ p;;
+let x5 = fun p -> (num_of_int 5) */ p;;
+let cmp n p = sign_num (n -/ p);;
+let pr n = Printf.printf "%s\n" (string_of_num n);;
+*)
+
+
+(* This is where the interesting stuff begins. *)
+
+open Lazy;;
+
+type 'a lcons = Cons of 'a * 'a lcons Lazy.t;;
+type 'a llist = 'a lcons Lazy.t;;
+
+let rec map f l =
+  lazy (
+    match force l with
+    | Cons (x, ll) -> Cons (f x, map f ll)
+  )
+;;
+
+let rec merge cmp l1 l2 =
+  lazy (
+    match force l1, force l2 with
+    | Cons (x1, ll1), Cons (x2, ll2)
+       -> let c = cmp x1 x2 in
+          if c = 0
+          then Cons (x1, merge cmp ll1 ll2)
+          else if c < 0
+          then Cons (x1, merge cmp ll1 l2)
+          else Cons (x2, merge cmp l1 ll2)
+  )
+;;
+
+let rec iter_interval f l (start, stop) =
+  if stop = 0 then ()
+  else match force l with
+       | Cons (x, ll)
+          -> if start <= 0 then f x;
+             iter_interval f ll (start-1, stop-1)
+;;
+
+let rec hamming = lazy (Cons (nn1, merge cmp ham2 (merge cmp ham3 ham5)))
+    and ham2 = lazy (force (map x2 hamming))
+    and ham3 = lazy (force (map x3 hamming))
+    and ham5 = lazy (force (map x5 hamming))
+;;
+
+iter_interval pr hamming (88000, 88100);;
diff --git a/testsuite/tests/misc/hamming.reference b/testsuite/tests/misc/hamming.reference
new file mode 100644
index 00000000..af1339ef
--- /dev/null
+++ b/testsuite/tests/misc/hamming.reference
@@ -0,0 +1,100 @@
+6726050156250000000000000000000000000
+6729216728661136606575523242669244416
+6730293634611118019721084375000000000
+6731430439413948088320000000000000000
+6733644878411293029785156250000000000
+6736815026358904613608094481682268160
+6739031236724077363200000000000000000
+6743282904874568941599068856042651648
+6744421903677486140423997176256921600
+6746640616477458432000000000000000000
+6750000000000000000000000000000000000
+6750897085400702945836103937453588480
+6752037370304563380023474956271616000
+6754258588364960445000000000000000000
+6755399441055744000000000000000000000
+6757621765136718750000000000000000000
+6758519863481752323552044362431792300
+6759661435938757375539248533340160000
+6761885162088395001166534423828125000
+6763027302973440000000000000000000000
+6765252136392518877983093261718750000
+6767294110289640371843415775641600000
+6768437164792816653010961694720000000
+6770663777894400000000000000000000000
+6774935403077748181101173538816000000
+6776079748261363229431903027200000000
+6778308875544000000000000000000000000
+6782585324034592562287109312160000000
+6783730961356018699387011072000000000
+6785962605658597412109375000000000000
+6789341568946838378906250000000000000
+6791390813820928754681118720000000000
+6794772480000000000000000000000000000
+6799059315411241693033267200000000000
+6800207735332289107722240000000000000
+6802444800000000000000000000000000000
+6806736475893120841673472000000000000
+6807886192552970708582400000000000000
+6810125783203125000000000000000000000
+6814422305043756994967597929687500000
+6815573319906622439424000000000000000
+6817815439391434192657470703125000000
+6821025214188390921278195662703296512
+6821210263296961784362792968750000000
+6823269127183128330240000000000000000
+6828727177473454717179297140960133120
+6830973624183426662400000000000000000
+6834375000000000000000000000000000000
+6835283298968211732659055236671758336
+6836437837433370422273768393225011200
+6838686820719522450562500000000000000
+6839841934068940800000000000000000000
+6842092037200927734375000000000000000
+6844157203887991842733489140006912000
+6845313241232438768082197309030400000
+6847565144260608000000000000000000000
+6849817788097425363957881927490234375
+6851885286668260876491458472837120000
+6853042629352726861173598715904000000
+6855297075118080000000000000000000000
+6859622095616220033364938208051200000
+6860780745114630269799801815040000000
+6863037736488300000000000000000000000
+6866455078125000000000000000000000000
+6867367640585024969315698178562000000
+6868527598372968933129348710400000000
+6870787138229329879760742187500000000
+6871947673600000000000000000000000000
+6874208338558673858642578125000000000
+6876283198993690364114632704000000000
+6879707136000000000000000000000000000
+6884047556853882214196183040000000000
+6885210332023942721568768000000000000
+6887475360000000000000000000000000000
+6891820681841784852194390400000000000
+6892984769959882842439680000000000000
+6895252355493164062500000000000000000
+6899602583856803957404692903808593750
+6900767986405455219916800000000000000
+6903038132383827120065689086914062500
+6906475391588173806667327880859375000
+6908559991272917434368000000000000000
+6912000000000000000000000000000000000
+6914086267191872901144038355222134784
+6916360794485719495680000000000000000
+6917529027641081856000000000000000000
+6919804687500000000000000000000000000
+6921893310401287552552190498140323840
+6924170405978516481194531250000000000
+6925339958244802560000000000000000000
+6927618187665939331054687500000000000
+6929709168936591740767657754256998400
+6930879656747844252683224775393280000
+6933159708563865600000000000000000000
+6937533852751614137447601703747584000
+6938705662219635946938268699852800000
+6940988288557056000000000000000000000
+6945367371811422783781999935651840000
+6946540504428563148172299337728000000
+6948825708194403750000000000000000000
diff --git a/testsuite/tests/misc/nucleic.ml b/testsuite/tests/misc/nucleic.ml
new file mode 100644
index 00000000..f83bc046
--- /dev/null
+++ b/testsuite/tests/misc/nucleic.ml
@@ -0,0 +1,3226 @@
+(* TEST
+*)
+
+(* Use floating-point arithmetic *)
+
+external (+) : float -> float -> float = "%addfloat"
+external (-) : float -> float -> float = "%subfloat"
+external ( * ) : float -> float -> float = "%mulfloat"
+external (/) : float -> float -> float = "%divfloat"
+
+(* -- MATH UTILITIES --------------------------------------------------------*)
+
+let constant_pi        =  3.14159265358979323846
+let constant_minus_pi  = -3.14159265358979323846
+let constant_pi2       =  1.57079632679489661923
+let constant_minus_pi2 = -1.57079632679489661923
+
+(* -- POINTS ----------------------------------------------------------------*)
+
+type pt = { x : float; y : float; z : float }
+
+let
+pt_sub p1 p2
+  = { x = p1.x - p2.x; y = p1.y - p2.y; z = p1.z - p2.z }
+
+let
+pt_dist p1 p2
+  = let dx = p1.x - p2.x
+    and dy = p1.y - p2.y
+    and dz = p1.z - p2.z
+    in
+      sqrt ((dx * dx) + (dy * dy) + (dz * dz))
+
+let
+pt_phi p
+  = let b = atan2 p.x p.z
+    in
+      atan2 ((cos b) * p.z + (sin b) * p.x) p.y
+
+let
+pt_theta p
+  =  atan2 p.x p.z
+
+(* -- COORDINATE TRANSFORMATIONS --------------------------------------------*)
+
+(*
+   The notation for the transformations follows "Paul, R.P. (1981) Robot
+   Manipulators.  MIT Press." with the exception that our transformation
+   matrices don't have the perspective terms and are the transpose of
+   Paul's one.  See also "M\"antyl\"a, M. (1985) An Introduction to
+   Solid Modeling, Computer Science Press" Appendix A.
+
+   The components of a transformation matrix are named like this:
+
+    a  b  c
+    d  e  f
+    g  h  i
+   tx ty tz
+
+   The components tx, ty, and tz are the translation vector.
+*)
+
+type tfo =
+  {a: float;   b: float;   c: float;
+   d: float;   e: float;   f: float;
+   g: float;   h: float;   i: float;
+   tx: float;  ty: float;  tz: float}
+
+let tfo_id =
+  {a=1.0; b=0.0; c=0.0;
+   d=0.0; e=1.0; f=0.0;
+   g=0.0; h=0.0; i=1.0;
+   tx=0.0; ty=0.0; tz=0.0}
+
+(*
+   The function "tfo-apply" multiplies a transformation matrix, tfo, by a
+   point vector, p.  The result is a new point.
+*)
+
+let
+tfo_apply t p
+  = { x = ((p.x * t.a) + (p.y * t.d) + (p.z * t.g) + t.tx);
+      y = ((p.x * t.b) + (p.y * t.e) + (p.z * t.h) + t.ty);
+      z = ((p.x * t.c) + (p.y * t.f) + (p.z * t.i) + t.tz) }
+
+(*
+   The function "tfo-combine" multiplies two transformation matrices A and B.
+   The result is a new matrix which cumulates the transformations described
+   by A and B.
+*)
+
+let
+tfo_combine a b =
+(* <HAND_CSE> *)
+  (* Hand elimination of common subexpressions.
+     Assumes lots of float registers (32 is perfect, 16 still OK).
+     Loses on the I386, of course. *)
+  let a_a = a.a  and a_b = a.b  and a_c = a.c  and a_d = a.d
+  and a_e = a.e  and a_f = a.f  and a_g = a.g  and a_h = a.h
+  and a_i = a.i  and a_tx = a.tx  and a_ty = a.ty  and a_tz = a.tz
+  and b_a = b.a  and b_b = b.b  and b_c = b.c  and b_d = b.d
+  and b_e = b.e  and b_f = b.f  and b_g = b.g  and b_h = b.h
+  and b_i = b.i  and b_tx = b.tx  and b_ty = b.ty  and b_tz = b.tz in
+    { a = ((a_a * b_a) + (a_b * b_d) + (a_c * b_g));
+      b = ((a_a * b_b) + (a_b * b_e) + (a_c * b_h));
+      c = ((a_a * b_c) + (a_b * b_f) + (a_c * b_i));
+      d = ((a_d * b_a) + (a_e * b_d) + (a_f * b_g));
+      e = ((a_d * b_b) + (a_e * b_e) + (a_f * b_h));
+      f = ((a_d * b_c) + (a_e * b_f) + (a_f * b_i));
+      g = ((a_g * b_a) + (a_h * b_d) + (a_i * b_g));
+      h = ((a_g * b_b) + (a_h * b_e) + (a_i * b_h));
+      i = ((a_g * b_c) + (a_h * b_f) + (a_i * b_i));
+      tx = ((a_tx * b_a) + (a_ty * b_d) + (a_tz * b_g) + b_tx);
+      ty = ((a_tx * b_b) + (a_ty * b_e) + (a_tz * b_h) + b_ty);
+      tz = ((a_tx * b_c) + (a_ty * b_f) + (a_tz * b_i) + b_tz)
+    }
+(* </HAND_CSE> *)
+ (* Original without CSE *)
+(* <NO_CSE> *) (***
+    { a = ((a.a * b.a) + (a.b * b.d) + (a.c * b.g));
+      b = ((a.a * b.b) + (a.b * b.e) + (a.c * b.h));
+      c = ((a.a * b.c) + (a.b * b.f) + (a.c * b.i));
+      d = ((a.d * b.a) + (a.e * b.d) + (a.f * b.g));
+      e = ((a.d * b.b) + (a.e * b.e) + (a.f * b.h));
+      f = ((a.d * b.c) + (a.e * b.f) + (a.f * b.i));
+      g = ((a.g * b.a) + (a.h * b.d) + (a.i * b.g));
+      h = ((a.g * b.b) + (a.h * b.e) + (a.i * b.h));
+      i = ((a.g * b.c) + (a.h * b.f) + (a.i * b.i));
+      tx = ((a.tx * b.a) + (a.ty * b.d) + (a.tz * b.g) + b.tx);
+      ty = ((a.tx * b.b) + (a.ty * b.e) + (a.tz * b.h) + b.ty);
+      tz = ((a.tx * b.c) + (a.ty * b.f) + (a.tz * b.i) + b.tz)
+    }
+  ***) (* </NO_CSE> *)
+
+(*
+   The function "tfo-inv-ortho" computes the inverse of a homogeneous
+   transformation matrix.
+*)
+
+let
+tfo_inv_ortho t =
+  { a = t.a; b = t.d; c = t.g;
+    d = t.b; e = t.e; f = t.h;
+    g = t.c; h = t.f; i = t.i;
+    tx = (-.((t.a * t.tx) + (t.b * t.ty) + (t.c * t.tz)));
+    ty = (-.((t.d * t.tx) + (t.e * t.ty) + (t.f * t.tz)));
+    tz = (-.((t.g * t.tx) + (t.h * t.ty) + (t.i * t.tz)))
+  }
+
+(*
+   Given three points p1, p2, and p3, the function "tfo-align" computes
+   a transformation matrix such that point p1 gets mapped to (0,0,0), p2 gets
+   mapped to the Y axis and p3 gets mapped to the YZ plane.
+*)
+
+let
+tfo_align p1 p2 p3
+  = let x31 = p3.x - p1.x in
+    let y31 = p3.y - p1.y in
+    let z31 = p3.z - p1.z in
+    let rotpy = pt_sub p2 p1 in
+    let phi = pt_phi rotpy in
+    let theta = pt_theta rotpy in
+    let sinp = sin phi in
+    let sint = sin theta in
+    let cosp = cos phi in
+    let cost = cos theta in
+    let sinpsint = sinp * sint in
+    let sinpcost = sinp * cost in
+    let cospsint = cosp * sint in
+    let cospcost = cosp * cost in
+    let rotpz =
+      { x = ((cost * x31) - (sint * z31));
+        y = ((sinpsint * x31) + (cosp * y31) + (sinpcost * z31));
+        z = ((cospsint * x31) + (-.(sinp * y31)) + (cospcost * z31)) } in
+    let rho = pt_theta rotpz in
+    let cosr = cos rho in
+    let sinr = sin rho in
+    let x = (-.(p1.x * cost)) + (p1.z * sint) in
+    let y = ((-.(p1.x * sinpsint)) - (p1.y * cosp)) - (p1.z * sinpcost) in
+    let z = ((-.(p1.x * cospsint) + (p1.y * sinp))) - (p1.z * cospcost) in
+      { a = ((cost * cosr) - (cospsint * sinr));
+        b = sinpsint;
+        c = ((cost * sinr) + (cospsint * cosr));
+        d = (sinp * sinr);
+        e = cosp;
+        f = (-.(sinp * cosr));
+        g = ((-.(sint * cosr)) - (cospcost * sinr));
+        h = sinpcost;
+        i = ((-.(sint * sinr) + (cospcost * cosr)));
+        tx = ((x * cosr) - (z * sinr));
+        ty = y;
+        tz = ((x * sinr + (z * cosr)))
+      }
+
+(* -- NUCLEIC ACID CONFORMATIONS DATA BASE ----------------------------------*)
+
+(*
+   Numbering of atoms follows the paper:
+
+   IUPAC-IUB Joint Commission on Biochemical Nomenclature (JCBN)
+   (1983) Abbreviations and Symbols for the Description of
+   Conformations of Polynucleotide Chains.  Eur. J. Biochem 131,
+   9-15.
+*)
+
+(* Define remaining atoms for each nucleotide type. *)
+
+type nuc_specific =
+  A of pt*pt*pt*pt*pt*pt*pt*pt
+| C of pt*pt*pt*pt*pt*pt
+| G of pt*pt*pt*pt*pt*pt*pt*pt*pt
+| U of pt*pt*pt*pt*pt
+
+(*
+   A n6 n7 n9 c8 h2 h61 h62 h8
+   C n4 o2 h41 h42 h5 h6
+   G n2 n7 n9 c8 o6 h1 h21 h22 h8
+   U o2 o4 h3 h5 h6
+*)
+
+(* Define part common to all 4 nucleotide types. *)
+
+type nuc =
+  N of tfo*tfo*tfo*tfo*
+       pt*pt*pt*pt*pt*pt*pt*pt*pt*pt*pt*pt*
+       pt*pt*pt*pt*pt*pt*pt*pt*pt*pt*pt*pt*
+       pt*nuc_specific
+
+(*
+    dgf_base_tfo  ; defines the standard position for wc and wc_dumas
+    p_o3'_275_tfo ; defines the standard position for the connect function
+    p_o3'_180_tfo
+    p_o3'_60_tfo
+    p o1p o2p o5' c5' h5' h5'' c4' h4' o4' c1' h1' c2' h2'' o2' h2' c3'
+    h3' o3' n1 n3 c2 c4 c5 c6
+*)
+
+let is_A = function
+     N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+      p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+      c3',h3',o3',n1,n3,c2,c4,c5,c6,A(_,_,_,_,_,_,_,_)) -> true
+   | _ -> false
+
+let is_C = function
+     N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+      p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+      c3',h3',o3',n1,n3,c2,c4,c5,c6,C(_,_,_,_,_,_)) -> true
+  | _ -> false
+
+let is_G = function
+     N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+      p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+      c3',h3',o3',n1,n3,c2,c4,c5,c6,G(_,_,_,_,_,_,_,_,_)) -> true
+  | _ -> false
+
+let
+nuc_C1'
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+  = c1'
+
+let
+nuc_C2
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+  = c2
+
+let
+nuc_C3'
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+  = c3'
+
+let
+nuc_C4
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+  = c4
+
+let
+nuc_C4'
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+  = c4'
+
+let
+nuc_N1
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+  = n1
+
+let
+nuc_O3'
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+  = o3'
+
+let
+nuc_P
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+  = p
+
+let
+nuc_dgf_base_tfo
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+  = dgf_base_tfo
+
+let
+nuc_p_o3'_180_tfo
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+  = p_o3'_180_tfo
+
+let
+nuc_p_o3'_275_tfo
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+  = p_o3'_275_tfo
+
+let
+nuc_p_o3'_60_tfo
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+  = p_o3'_60_tfo
+
+let
+rA_N9 = function
+| (N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+     p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+     c3',h3',o3',n1,n3,c2,c4,c5,c6,A (n6,n7,n9,c8,h2,h61,h62,h8))) -> n9
+| _ -> assert false
+
+
+let
+rG_N9   = function
+| (N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+     p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+     c3',h3',o3',n1,n3,c2,c4,c5,c6,G (n2,n7,n9,c8,o6,h1,h21,h22,h8))) -> n9
+| _ -> assert false
+
+(* Database of nucleotide conformations: *)
+
+let rA
+  = N(
+      {    a= -0.0018; b= -0.8207; c=0.5714; (* dgf_base_tfo *)
+           d=0.2679; e= -0.5509; f= -0.7904;
+           g=0.9634; h=0.1517; i=0.2209;
+           tx=0.0073; ty=8.4030; tz=0.6232 },
+      {    a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+           d= -0.0433; e= -0.4257; f=0.9038;
+           g= -0.5788; h=0.7480; i=0.3246;
+           tx=1.5227; ty=6.9114; tz= -7.0765 },
+      {    a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+           d=0.4552; e=0.6637; f=0.5935;
+           g= -0.8042; h=0.0203; i=0.5941;
+           tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+      {    a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+           d= -0.8247; e=0.5587; f= -0.0878;
+           g=0.0426; h=0.2162; i=0.9754;
+           tx=6.2694; ty= -7.0540; tz=3.3316 },
+      { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P    *)
+      { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P  *)
+      { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P  *)
+      { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5'  *)
+      { x = 5.4550; y = 8.2120; z = -2.8810 }, (* C5'  *)
+      { x = 5.4546; y = 8.8508; z = -1.9978 }, (* H5'  *)
+      { x = 5.7588; y = 8.6625; z = -3.8259 }, (* H5'' *)
+      { x = 6.4970; y = 7.1480; z = -2.5980 }, (* C4'  *)
+      { x = 7.4896; y = 7.5919; z = -2.5214 }, (* H4'  *)
+      { x = 6.1630; y = 6.4860; z = -1.3440 }, (* O4'  *)
+      { x = 6.5400; y = 5.1200; z = -1.4190 }, (* C1'  *)
+      { x = 7.2763; y = 4.9681; z = -0.6297 }, (* H1'  *)
+      { x = 7.1940; y = 4.8830; z = -2.7770 }, (* C2'  *)
+      { x = 6.8667; y = 3.9183; z = -3.1647 }, (* H2'' *)
+      { x = 8.5860; y = 5.0910; z = -2.6140 }, (* O2'  *)
+      { x = 8.9510; y = 4.7626; z = -1.7890 }, (* H2'  *)
+      { x = 6.5720; y = 6.0040; z = -3.6090 }, (* C3'  *)
+      { x = 5.5636; y = 5.7066; z = -3.8966 }, (* H3'  *)
+      { x = 7.3801; y = 6.3562; z = -4.7350 }, (* O3'  *)
+      { x = 4.7150; y = 0.4910; z = -0.1360 }, (* N1   *)
+      { x = 6.3490; y = 2.1730; z = -0.6020 }, (* N3   *)
+      { x = 5.9530; y = 0.9650; z = -0.2670 }, (* C2   *)
+      { x = 5.2900; y = 2.9790; z = -0.8260 }, (* C4   *)
+      { x = 3.9720; y = 2.6390; z = -0.7330 }, (* C5   *)
+      { x = 3.6770; y = 1.3160; z = -0.3660 }, (* C6 *)
+      (A (
+      { x = 2.4280; y = 0.8450; z = -0.2360 }, (* N6   *)
+      { x = 3.1660; y = 3.7290; z = -1.0360 }, (* N7   *)
+      { x = 5.3170; y = 4.2990; z = -1.1930 }, (* N9   *)
+      { x = 4.0100; y = 4.6780; z = -1.2990 }, (* C8   *)
+      { x = 6.6890; y = 0.1903; z = -0.0518 }, (* H2   *)
+      { x = 1.6470; y = 1.4460; z = -0.4040 }, (* H61  *)
+      { x = 2.2780; y = -0.1080; z = -0.0280 }, (* H62  *)
+      { x = 3.4421; y = 5.5744; z = -1.5482 }) (* H8   *)
+      )
+    )
+
+let rA01
+  = N(
+      {    a= -0.0043; b= -0.8175; c=0.5759; (* dgf_base_tfo *)
+           d=0.2617; e= -0.5567; f= -0.7884;
+           g=0.9651; h=0.1473; i=0.2164;
+           tx=0.0359; ty=8.3929; tz=0.5532 },
+      {    a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+           d= -0.0433; e= -0.4257; f=0.9038;
+           g= -0.5788; h=0.7480; i=0.3246;
+           tx=1.5227; ty=6.9114; tz= -7.0765 },
+      {    a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+           d=0.4552; e=0.6637; f=0.5935;
+           g= -0.8042; h=0.0203; i=0.5941;
+           tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+      {    a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+           d= -0.8247; e=0.5587; f= -0.0878;
+           g=0.0426; h=0.2162; i=0.9754;
+           tx=6.2694; ty= -7.0540; tz=3.3316 },
+      { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P    *)
+      { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P  *)
+      { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P  *)
+      { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5'  *)
+      { x = 5.4352; y = 8.2183; z = -2.7757 }, (* C5'  *)
+      { x = 5.3830; y = 8.7883; z = -1.8481 }, (* H5'  *)
+      { x = 5.7729; y = 8.7436; z = -3.6691 }, (* H5'' *)
+      { x = 6.4830; y = 7.1518; z = -2.5252 }, (* C4'  *)
+      { x = 7.4749; y = 7.5972; z = -2.4482 }, (* H4'  *)
+      { x = 6.1626; y = 6.4620; z = -1.2827 }, (* O4'  *)
+      { x = 6.5431; y = 5.0992; z = -1.3905 }, (* C1'  *)
+      { x = 7.2871; y = 4.9328; z = -0.6114 }, (* H1'  *)
+      { x = 7.1852; y = 4.8935; z = -2.7592 }, (* C2'  *)
+      { x = 6.8573; y = 3.9363; z = -3.1645 }, (* H2'' *)
+      { x = 8.5780; y = 5.1025; z = -2.6046 }, (* O2'  *)
+      { x = 8.9516; y = 4.7577; z = -1.7902 }, (* H2'  *)
+      { x = 6.5522; y = 6.0300; z = -3.5612 }, (* C3'  *)
+      { x = 5.5420; y = 5.7356; z = -3.8459 }, (* H3'  *)
+      { x = 7.3487; y = 6.4089; z = -4.6867 }, (* O3'  *)
+      { x = 4.7442; y = 0.4514; z = -0.1390 }, (* N1   *)
+      { x = 6.3687; y = 2.1459; z = -0.5926 }, (* N3   *)
+      { x = 5.9795; y = 0.9335; z = -0.2657 }, (* C2   *)
+      { x = 5.3052; y = 2.9471; z = -0.8125 }, (* C4   *)
+      { x = 3.9891; y = 2.5987; z = -0.7230 }, (* C5   *)
+      { x = 3.7016; y = 1.2717; z = -0.3647 }, (* C6 *)
+      (A (
+      { x = 2.4553; y = 0.7925; z = -0.2390 }, (* N6   *)
+      { x = 3.1770; y = 3.6859; z = -1.0198 }, (* N7   *)
+      { x = 5.3247; y = 4.2695; z = -1.1710 }, (* N9   *)
+      { x = 4.0156; y = 4.6415; z = -1.2759 }, (* C8   *)
+      { x = 6.7198; y = 0.1618; z = -0.0547 }, (* H2   *)
+      { x = 1.6709; y = 1.3900; z = -0.4039 }, (* H61  *)
+      { x = 2.3107; y = -0.1627; z = -0.0373 }, (* H62  *)
+      { x = 3.4426; y = 5.5361; z = -1.5199 }) (* H8   *)
+      )
+    )
+
+let rA02
+  = N(
+      {    a=0.5566; b=0.0449; c=0.8296; (* dgf_base_tfo *)
+           d=0.5125; e=0.7673; f= -0.3854;
+           g= -0.6538; h=0.6397; i=0.4041;
+           tx= -9.1161; ty= -3.7679; tz= -2.9968 },
+      {    a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+           d= -0.0433; e= -0.4257; f=0.9038;
+           g= -0.5788; h=0.7480; i=0.3246;
+           tx=1.5227; ty=6.9114; tz= -7.0765 },
+      {    a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+           d=0.4552; e=0.6637; f=0.5935;
+           g= -0.8042; h=0.0203; i=0.5941;
+           tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+      {    a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+           d= -0.8247; e=0.5587; f= -0.0878;
+           g=0.0426; h=0.2162; i=0.9754;
+           tx=6.2694; ty= -7.0540; tz=3.3316 },
+      { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P    *)
+      { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P  *)
+      { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P  *)
+      { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5'  *)
+      { x = 4.5778; y = 6.6594; z = -4.0364 }, (* C5'  *)
+      { x = 4.9220; y = 7.1963; z = -4.9204 }, (* H5'  *)
+      { x = 3.7996; y = 5.9091; z = -4.1764 }, (* H5'' *)
+      { x = 5.7873; y = 5.8869; z = -3.5482 }, (* C4'  *)
+      { x = 6.0405; y = 5.0875; z = -4.2446 }, (* H4'  *)
+      { x = 6.9135; y = 6.8036; z = -3.4310 }, (* O4'  *)
+      { x = 7.7293; y = 6.4084; z = -2.3392 }, (* C1'  *)
+      { x = 8.7078; y = 6.1815; z = -2.7624 }, (* H1'  *)
+      { x = 7.1305; y = 5.1418; z = -1.7347 }, (* C2'  *)
+      { x = 7.2040; y = 5.1982; z = -0.6486 }, (* H2'' *)
+      { x = 7.7417; y = 4.0392; z = -2.3813 }, (* O2'  *)
+      { x = 8.6785; y = 4.1443; z = -2.5630 }, (* H2'  *)
+      { x = 5.6666; y = 5.2728; z = -2.1536 }, (* C3'  *)
+      { x = 5.1747; y = 5.9805; z = -1.4863 }, (* H3'  *)
+      { x = 4.9997; y = 4.0086; z = -2.1973 }, (* O3'  *)
+      { x = 10.3245; y = 8.5459; z = 1.5467 }, (* N1   *)
+      { x = 9.8051; y = 6.9432; z = -0.1497 }, (* N3   *)
+      { x = 10.5175; y = 7.4328; z = 0.8408 }, (* C2   *)
+      { x = 8.7523; y = 7.7422; z = -0.4228 }, (* C4   *)
+      { x = 8.4257; y = 8.9060; z = 0.2099 }, (* C5   *)
+      { x = 9.2665; y = 9.3242; z = 1.2540 }, (* C6 *)
+      (A (
+      { x = 9.0664; y = 10.4462; z = 1.9610 }, (* N6   *)
+      { x = 7.2750; y = 9.4537; z = -0.3428 }, (* N7   *)
+      { x = 7.7962; y = 7.5519; z = -1.3859 }, (* N9   *)
+      { x = 6.9479; y = 8.6157; z = -1.2771 }, (* C8   *)
+      { x = 11.4063; y = 6.9047; z = 1.1859 }, (* H2   *)
+      { x = 8.2845; y = 11.0341; z = 1.7552 }, (* H61  *)
+      { x = 9.6584; y = 10.6647; z = 2.7198 }, (* H62  *)
+      { x = 6.0430; y = 8.9853; z = -1.7594 }) (* H8   *)
+      )
+    )
+let rA03
+  = N(
+      {    a= -0.5021; b=0.0731; c=0.8617; (* dgf_base_tfo *)
+           d= -0.8112; e=0.3054; f= -0.4986;
+           g= -0.2996; h= -0.9494; i= -0.0940;
+           tx=6.4273; ty= -5.1944; tz= -3.7807 },
+      {    a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+           d= -0.0433; e= -0.4257; f=0.9038;
+           g= -0.5788; h=0.7480; i=0.3246;
+           tx=1.5227; ty=6.9114; tz= -7.0765 },
+      {    a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+           d=0.4552; e=0.6637; f=0.5935;
+           g= -0.8042; h=0.0203; i=0.5941;
+           tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+      {    a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+           d= -0.8247; e=0.5587; f= -0.0878;
+           g=0.0426; h=0.2162; i=0.9754;
+           tx=6.2694; ty= -7.0540; tz=3.3316 },
+      { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P    *)
+      { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P  *)
+      { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P  *)
+      { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5'  *)
+      { x = 4.1214; y = 6.7116; z = -1.9049 }, (* C5'  *)
+      { x = 3.3465; y = 5.9610; z = -2.0607 }, (* H5'  *)
+      { x = 4.0789; y = 7.2928; z = -0.9837 }, (* H5'' *)
+      { x = 5.4170; y = 5.9293; z = -1.8186 }, (* C4'  *)
+      { x = 5.4506; y = 5.3400; z = -0.9023 }, (* H4'  *)
+      { x = 5.5067; y = 5.0417; z = -2.9703 }, (* O4'  *)
+      { x = 6.8650; y = 4.9152; z = -3.3612 }, (* C1'  *)
+      { x = 7.1090; y = 3.8577; z = -3.2603 }, (* H1'  *)
+      { x = 7.7152; y = 5.7282; z = -2.3894 }, (* C2'  *)
+      { x = 8.5029; y = 6.2356; z = -2.9463 }, (* H2'' *)
+      { x = 8.1036; y = 4.8568; z = -1.3419 }, (* O2'  *)
+      { x = 8.3270; y = 3.9651; z = -1.6184 }, (* H2'  *)
+      { x = 6.7003; y = 6.7565; z = -1.8911 }, (* C3'  *)
+      { x = 6.5898; y = 7.5329; z = -2.6482 }, (* H3'  *)
+      { x = 7.0505; y = 7.2878; z = -0.6105 }, (* O3'  *)
+      { x = 9.6740; y = 4.7656; z = -7.6614 }, (* N1   *)
+      { x = 9.0739; y = 4.3013; z = -5.3941 }, (* N3   *)
+      { x = 9.8416; y = 4.2192; z = -6.4581 }, (* C2   *)
+      { x = 7.9885; y = 5.0632; z = -5.6446 }, (* C4   *)
+      { x = 7.6822; y = 5.6856; z = -6.8194 }, (* C5   *)
+      { x = 8.5831; y = 5.5215; z = -7.8840 }, (* C6 *)
+      (A (
+      { x = 8.4084; y = 6.0747; z = -9.0933 }, (* N6   *)
+      { x = 6.4857; y = 6.3816; z = -6.7035 }, (* N7   *)
+      { x = 6.9740; y = 5.3703; z = -4.7760 }, (* N9   *)
+      { x = 6.1133; y = 6.1613; z = -5.4808 }, (* C8   *)
+      { x = 10.7627; y = 3.6375; z = -6.4220 }, (* H2   *)
+      { x = 7.6031; y = 6.6390; z = -9.2733 }, (* H61  *)
+      { x = 9.1004; y = 5.9708; z = -9.7893 }, (* H62  *)
+      { x = 5.1705; y = 6.6830; z = -5.3167 }) (* H8   *)
+      )
+    )
+
+let rA04
+  = N(
+      {    a= -0.5426; b= -0.8175; c=0.1929; (* dgf_base_tfo *)
+           d=0.8304; e= -0.5567; f= -0.0237;
+           g=0.1267; h=0.1473; i=0.9809;
+           tx= -0.5075; ty=8.3929; tz=0.2229 },
+      {    a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+           d= -0.0433; e= -0.4257; f=0.9038;
+           g= -0.5788; h=0.7480; i=0.3246;
+           tx=1.5227; ty=6.9114; tz= -7.0765 },
+      {    a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+           d=0.4552; e=0.6637; f=0.5935;
+           g= -0.8042; h=0.0203; i=0.5941;
+           tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+      {    a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+           d= -0.8247; e=0.5587; f= -0.0878;
+           g=0.0426; h=0.2162; i=0.9754;
+           tx=6.2694; ty= -7.0540; tz=3.3316 },
+      { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P    *)
+      { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P  *)
+      { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P  *)
+      { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5'  *)
+      { x = 5.4352; y = 8.2183; z = -2.7757 }, (* C5'  *)
+      { x = 5.3830; y = 8.7883; z = -1.8481 }, (* H5'  *)
+      { x = 5.7729; y = 8.7436; z = -3.6691 }, (* H5'' *)
+      { x = 6.4830; y = 7.1518; z = -2.5252 }, (* C4'  *)
+      { x = 7.4749; y = 7.5972; z = -2.4482 }, (* H4'  *)
+      { x = 6.1626; y = 6.4620; z = -1.2827 }, (* O4'  *)
+      { x = 6.5431; y = 5.0992; z = -1.3905 }, (* C1'  *)
+      { x = 7.2871; y = 4.9328; z = -0.6114 }, (* H1'  *)
+      { x = 7.1852; y = 4.8935; z = -2.7592 }, (* C2'  *)
+      { x = 6.8573; y = 3.9363; z = -3.1645 }, (* H2'' *)
+      { x = 8.5780; y = 5.1025; z = -2.6046 }, (* O2'  *)
+      { x = 8.9516; y = 4.7577; z = -1.7902 }, (* H2'  *)
+      { x = 6.5522; y = 6.0300; z = -3.5612 }, (* C3'  *)
+      { x = 5.5420; y = 5.7356; z = -3.8459 }, (* H3'  *)
+      { x = 7.3487; y = 6.4089; z = -4.6867 }, (* O3'  *)
+      { x = 3.6343; y = 2.6680; z = 2.0783 }, (* N1   *)
+      { x = 5.4505; y = 3.9805; z = 1.2446 }, (* N3   *)
+      { x = 4.7540; y = 3.3816; z = 2.1851 }, (* C2   *)
+      { x = 4.8805; y = 3.7951; z = 0.0354 }, (* C4   *)
+      { x = 3.7416; y = 3.0925; z = -0.2305 }, (* C5   *)
+      { x = 3.0873; y = 2.4980; z = 0.8606 }, (* C6 *)
+      (A (
+      { x = 1.9600; y = 1.7805; z = 0.7462 }, (* N6   *)
+      { x = 3.4605; y = 3.1184; z = -1.5906 }, (* N7   *)
+      { x = 5.3247; y = 4.2695; z = -1.1710 }, (* N9   *)
+      { x = 4.4244; y = 3.8244; z = -2.0953 }, (* C8   *)
+      { x = 5.0814; y = 3.4352; z = 3.2234 }, (* H2   *)
+      { x = 1.5423; y = 1.6454; z = -0.1520 }, (* H61  *)
+      { x = 1.5716; y = 1.3398; z = 1.5392 }, (* H62  *)
+      { x = 4.2675; y = 3.8876; z = -3.1721 }) (* H8   *)
+      )
+    )
+
+let rA05
+  = N(
+      {    a= -0.5891; b=0.0449; c=0.8068; (* dgf_base_tfo *)
+           d=0.5375; e=0.7673; f=0.3498;
+           g= -0.6034; h=0.6397; i= -0.4762;
+           tx= -0.3019; ty= -3.7679; tz= -9.5913 },
+      {    a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+           d= -0.0433; e= -0.4257; f=0.9038;
+           g= -0.5788; h=0.7480; i=0.3246;
+           tx=1.5227; ty=6.9114; tz= -7.0765 },
+      {    a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+           d=0.4552; e=0.6637; f=0.5935;
+           g= -0.8042; h=0.0203; i=0.5941;
+           tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+      {    a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+           d= -0.8247; e=0.5587; f= -0.0878;
+           g=0.0426; h=0.2162; i=0.9754;
+           tx=6.2694; ty= -7.0540; tz=3.3316 },
+      { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P    *)
+      { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P  *)
+      { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P  *)
+      { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5'  *)
+      { x = 4.5778; y = 6.6594; z = -4.0364 }, (* C5'  *)
+      { x = 4.9220; y = 7.1963; z = -4.9204 }, (* H5'  *)
+      { x = 3.7996; y = 5.9091; z = -4.1764 }, (* H5'' *)
+      { x = 5.7873; y = 5.8869; z = -3.5482 }, (* C4'  *)
+      { x = 6.0405; y = 5.0875; z = -4.2446 }, (* H4'  *)
+      { x = 6.9135; y = 6.8036; z = -3.4310 }, (* O4'  *)
+      { x = 7.7293; y = 6.4084; z = -2.3392 }, (* C1'  *)
+      { x = 8.7078; y = 6.1815; z = -2.7624 }, (* H1'  *)
+      { x = 7.1305; y = 5.1418; z = -1.7347 }, (* C2'  *)
+      { x = 7.2040; y = 5.1982; z = -0.6486 }, (* H2'' *)
+      { x = 7.7417; y = 4.0392; z = -2.3813 }, (* O2'  *)
+      { x = 8.6785; y = 4.1443; z = -2.5630 }, (* H2'  *)
+      { x = 5.6666; y = 5.2728; z = -2.1536 }, (* C3'  *)
+      { x = 5.1747; y = 5.9805; z = -1.4863 }, (* H3'  *)
+      { x = 4.9997; y = 4.0086; z = -2.1973 }, (* O3'  *)
+      { x = 10.2594; y = 10.6774; z = -1.0056 }, (* N1   *)
+      { x = 9.7528; y = 8.7080; z = -2.2631 }, (* N3   *)
+      { x = 10.4471; y = 9.7876; z = -1.9791 }, (* C2   *)
+      { x = 8.7271; y = 8.5575; z = -1.3991 }, (* C4   *)
+      { x = 8.4100; y = 9.3803; z = -0.3580 }, (* C5   *)
+      { x = 9.2294; y = 10.5030; z = -0.1574 }, (* C6 *)
+      (A (
+      { x = 9.0349; y = 11.3951; z = 0.8250 }, (* N6   *)
+      { x = 7.2891; y = 8.9068; z = 0.3121 }, (* N7   *)
+      { x = 7.7962; y = 7.5519; z = -1.3859 }, (* N9   *)
+      { x = 6.9702; y = 7.8292; z = -0.3353 }, (* C8   *)
+      { x = 11.3132; y = 10.0537; z = -2.5851 }, (* H2   *)
+      { x = 8.2741; y = 11.2784; z = 1.4629 }, (* H61  *)
+      { x = 9.6733; y = 12.1368; z = 0.9529 }, (* H62  *)
+      { x = 6.0888; y = 7.3990; z = 0.1403 }) (* H8   *)
+      )
+    )
+
+let rA06
+  = N(
+      {    a= -0.9815; b=0.0731; c= -0.1772; (* dgf_base_tfo *)
+           d=0.1912; e=0.3054; f= -0.9328;
+           g= -0.0141; h= -0.9494; i= -0.3137;
+           tx=5.7506; ty= -5.1944; tz=4.7470 },
+      {    a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+           d= -0.0433; e= -0.4257; f=0.9038;
+           g= -0.5788; h=0.7480; i=0.3246;
+           tx=1.5227; ty=6.9114; tz= -7.0765 },
+      {    a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+           d=0.4552; e=0.6637; f=0.5935;
+           g= -0.8042; h=0.0203; i=0.5941;
+           tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+      {    a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+           d= -0.8247; e=0.5587; f= -0.0878;
+           g=0.0426; h=0.2162; i=0.9754;
+           tx=6.2694; ty= -7.0540; tz=3.3316 },
+      { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P    *)
+      { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P  *)
+      { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P  *)
+      { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5'  *)
+      { x = 4.1214; y = 6.7116; z = -1.9049 }, (* C5'  *)
+      { x = 3.3465; y = 5.9610; z = -2.0607 }, (* H5'  *)
+      { x = 4.0789; y = 7.2928; z = -0.9837 }, (* H5'' *)
+      { x = 5.4170; y = 5.9293; z = -1.8186 }, (* C4'  *)
+      { x = 5.4506; y = 5.3400; z = -0.9023 }, (* H4'  *)
+      { x = 5.5067; y = 5.0417; z = -2.9703 }, (* O4'  *)
+      { x = 6.8650; y = 4.9152; z = -3.3612 }, (* C1'  *)
+      { x = 7.1090; y = 3.8577; z = -3.2603 }, (* H1'  *)
+      { x = 7.7152; y = 5.7282; z = -2.3894 }, (* C2'  *)
+      { x = 8.5029; y = 6.2356; z = -2.9463 }, (* H2'' *)
+      { x = 8.1036; y = 4.8568; z = -1.3419 }, (* O2'  *)
+      { x = 8.3270; y = 3.9651; z = -1.6184 }, (* H2'  *)
+      { x = 6.7003; y = 6.7565; z = -1.8911 }, (* C3'  *)
+      { x = 6.5898; y = 7.5329; z = -2.6482 }, (* H3'  *)
+      { x = 7.0505; y = 7.2878; z = -0.6105 }, (* O3'  *)
+      { x = 6.6624; y = 3.5061; z = -8.2986 }, (* N1   *)
+      { x = 6.5810; y = 3.2570; z = -5.9221 }, (* N3   *)
+      { x = 6.5151; y = 2.8263; z = -7.1625 }, (* C2   *)
+      { x = 6.8364; y = 4.5817; z = -5.8882 }, (* C4   *)
+      { x = 7.0116; y = 5.4064; z = -6.9609 }, (* C5   *)
+      { x = 6.9173; y = 4.8260; z = -8.2361 }, (* C6 *)
+      (A (
+      { x = 7.0668; y = 5.5163; z = -9.3763 }, (* N6   *)
+      { x = 7.2573; y = 6.7070; z = -6.5394 }, (* N7   *)
+      { x = 6.9740; y = 5.3703; z = -4.7760 }, (* N9   *)
+      { x = 7.2238; y = 6.6275; z = -5.2453 }, (* C8   *)
+      { x = 6.3146; y = 1.7741; z = -7.3641 }, (* H2   *)
+      { x = 7.2568; y = 6.4972; z = -9.3456 }, (* H61  *)
+      { x = 7.0437; y = 5.0478; z = -10.2446 }, (* H62  *)
+      { x = 7.4108; y = 7.6227; z = -4.8418 }) (* H8   *)
+      )
+    )
+
+let rA07
+  = N(
+      {    a=0.2379; b=0.1310; c= -0.9624; (* dgf_base_tfo *)
+           d= -0.5876; e= -0.7696; f= -0.2499;
+           g= -0.7734; h=0.6249; i= -0.1061;
+           tx=30.9870; ty= -26.9344; tz=42.6416 },
+      {    a=0.7529; b=0.1548; c=0.6397; (* P_O3'_275_tfo *)
+           d=0.2952; e= -0.9481; f= -0.1180;
+           g=0.5882; h=0.2777; i= -0.7595;
+           tx= -58.8919; ty= -11.3095; tz=6.0866 },
+      {    a= -0.0239; b=0.9667; c= -0.2546; (* P_O3'_180_tfo *)
+           d=0.9731; e= -0.0359; f= -0.2275;
+           g= -0.2290; h= -0.2532; i= -0.9399;
+           tx=3.5401; ty= -29.7913; tz=52.2796 },
+      {    a= -0.8912; b= -0.4531; c=0.0242; (* P_O3'_60_tfo *)
+           d= -0.1183; e=0.1805; f= -0.9764;
+           g=0.4380; h= -0.8730; i= -0.2145;
+           tx=19.9023; ty=54.8054; tz=15.2799 },
+      { x = 41.8210; y = 8.3880; z = 43.5890 }, (* P    *)
+      { x = 42.5400; y = 8.0450; z = 44.8330 }, (* O1P  *)
+      { x = 42.2470; y = 9.6920; z = 42.9910 }, (* O2P  *)
+      { x = 40.2550; y = 8.2030; z = 43.7340 }, (* O5'  *)
+      { x = 39.3505; y = 8.4697; z = 42.6565 }, (* C5'  *)
+      { x = 39.1377; y = 7.5433; z = 42.1230 }, (* H5'  *)
+      { x = 39.7203; y = 9.3119; z = 42.0717 }, (* H5'' *)
+      { x = 38.0405; y = 8.9195; z = 43.2869 }, (* C4'  *)
+      { x = 37.3687; y = 9.3036; z = 42.5193 }, (* H4'  *)
+      { x = 37.4319; y = 7.8146; z = 43.9387 }, (* O4'  *)
+      { x = 37.1959; y = 8.1354; z = 45.3237 }, (* C1'  *)
+      { x = 36.1788; y = 8.5202; z = 45.3970 }, (* H1'  *)
+      { x = 38.1721; y = 9.2328; z = 45.6504 }, (* C2'  *)
+      { x = 39.1555; y = 8.7939; z = 45.8188 }, (* H2'' *)
+      { x = 37.7862; y = 10.0617; z = 46.7013 }, (* O2'  *)
+      { x = 37.3087; y = 9.6229; z = 47.4092 }, (* H2'  *)
+      { x = 38.1844; y = 10.0268; z = 44.3367 }, (* C3'  *)
+      { x = 39.1578; y = 10.5054; z = 44.2289 }, (* H3'  *)
+      { x = 37.0547; y = 10.9127; z = 44.3441 }, (* O3'  *)
+      { x = 34.8811; y = 4.2072; z = 47.5784 }, (* N1   *)
+      { x = 35.1084; y = 6.1336; z = 46.1818 }, (* N3   *)
+      { x = 34.4108; y = 5.1360; z = 46.7207 }, (* C2   *)
+      { x = 36.3908; y = 6.1224; z = 46.6053 }, (* C4   *)
+      { x = 36.9819; y = 5.2334; z = 47.4697 }, (* C5   *)
+      { x = 36.1786; y = 4.1985; z = 48.0035 }, (* C6 *)
+      (A (
+      { x = 36.6103; y = 3.2749; z = 48.8452 }, (* N6   *)
+      { x = 38.3236; y = 5.5522; z = 47.6595 }, (* N7   *)
+      { x = 37.3887; y = 7.0024; z = 46.2437 }, (* N9   *)
+      { x = 38.5055; y = 6.6096; z = 46.9057 }, (* C8   *)
+      { x = 33.3553; y = 5.0152; z = 46.4771 }, (* H2   *)
+      { x = 37.5730; y = 3.2804; z = 49.1507 }, (* H61  *)
+      { x = 35.9775; y = 2.5638; z = 49.1828 }, (* H62  *)
+      { x = 39.5461; y = 6.9184; z = 47.0041 }) (* H8   *)
+      )
+    )
+
+let rA08
+  = N(
+      {    a=0.1084; b= -0.0895; c= -0.9901; (* dgf_base_tfo *)
+           d=0.9789; e= -0.1638; f=0.1220;
+           g= -0.1731; h= -0.9824; i=0.0698;
+           tx= -2.9039; ty=47.2655; tz=33.0094 },
+      {    a=0.7529; b=0.1548; c=0.6397; (* P_O3'_275_tfo *)
+           d=0.2952; e= -0.9481; f= -0.1180;
+           g=0.5882; h=0.2777; i= -0.7595;
+           tx= -58.8919; ty= -11.3095; tz=6.0866 },
+      {    a= -0.0239; b=0.9667; c= -0.2546; (* P_O3'_180_tfo *)
+           d=0.9731; e= -0.0359; f= -0.2275;
+           g= -0.2290; h= -0.2532; i= -0.9399;
+           tx=3.5401; ty= -29.7913; tz=52.2796 },
+      {    a= -0.8912; b= -0.4531; c=0.0242; (* P_O3'_60_tfo *)
+           d= -0.1183; e=0.1805; f= -0.9764;
+           g=0.4380; h= -0.8730; i= -0.2145;
+           tx=19.9023; ty=54.8054; tz=15.2799 },
+      { x = 41.8210; y = 8.3880; z = 43.5890 }, (* P    *)
+      { x = 42.5400; y = 8.0450; z = 44.8330 }, (* O1P  *)
+      { x = 42.2470; y = 9.6920; z = 42.9910 }, (* O2P  *)
+      { x = 40.2550; y = 8.2030; z = 43.7340 }, (* O5'  *)
+      { x = 39.4850; y = 8.9301; z = 44.6977 }, (* C5'  *)
+      { x = 39.0638; y = 9.8199; z = 44.2296 }, (* H5'  *)
+      { x = 40.0757; y = 9.0713; z = 45.6029 }, (* H5'' *)
+      { x = 38.3102; y = 8.0414; z = 45.0789 }, (* C4'  *)
+      { x = 37.7842; y = 8.4637; z = 45.9351 }, (* H4'  *)
+      { x = 37.4200; y = 7.9453; z = 43.9769 }, (* O4'  *)
+      { x = 37.2249; y = 6.5609; z = 43.6273 }, (* C1'  *)
+      { x = 36.3360; y = 6.2168; z = 44.1561 }, (* H1'  *)
+      { x = 38.4347; y = 5.8414; z = 44.1590 }, (* C2'  *)
+      { x = 39.2688; y = 5.9974; z = 43.4749 }, (* H2'' *)
+      { x = 38.2344; y = 4.4907; z = 44.4348 }, (* O2'  *)
+      { x = 37.6374; y = 4.0386; z = 43.8341 }, (* H2'  *)
+      { x = 38.6926; y = 6.6079; z = 45.4637 }, (* C3'  *)
+      { x = 39.7585; y = 6.5640; z = 45.6877 }, (* H3'  *)
+      { x = 37.8238; y = 6.0705; z = 46.4723 }, (* O3'  *)
+      { x = 33.9162; y = 6.2598; z = 39.7758 }, (* N1   *)
+      { x = 34.6709; y = 6.5759; z = 42.0215 }, (* N3   *)
+      { x = 33.7257; y = 6.5186; z = 41.0858 }, (* C2   *)
+      { x = 35.8935; y = 6.3324; z = 41.5018 }, (* C4   *)
+      { x = 36.2105; y = 6.0601; z = 40.1932 }, (* C5   *)
+      { x = 35.1538; y = 6.0151; z = 39.2537 }, (* C6 *)
+      (A (
+      { x = 35.3088; y = 5.7642; z = 37.9649 }, (* N6   *)
+      { x = 37.5818; y = 5.8677; z = 40.0507 }, (* N7   *)
+      { x = 37.0932; y = 6.3197; z = 42.1810 }, (* N9   *)
+      { x = 38.0509; y = 6.0354; z = 41.2635 }, (* C8   *)
+      { x = 32.6830; y = 6.6898; z = 41.3532 }, (* H2   *)
+      { x = 36.2305; y = 5.5855; z = 37.5925 }, (* H61  *)
+      { x = 34.5056; y = 5.7512; z = 37.3528 }, (* H62  *)
+      { x = 39.1318; y = 5.8993; z = 41.2285 }) (* H8   *)
+      )
+    )
+
+let rA09
+  = N(
+      {    a=0.8467; b=0.4166; c= -0.3311; (* dgf_base_tfo *)
+           d= -0.3962; e=0.9089; f=0.1303;
+           g=0.3552; h=0.0209; i=0.9346;
+           tx= -42.7319; ty= -26.6223; tz= -29.8163 },
+      {    a=0.7529; b=0.1548; c=0.6397; (* P_O3'_275_tfo *)
+           d=0.2952; e= -0.9481; f= -0.1180;
+           g=0.5882; h=0.2777; i= -0.7595;
+           tx= -58.8919; ty= -11.3095; tz=6.0866 },
+      {    a= -0.0239; b=0.9667; c= -0.2546; (* P_O3'_180_tfo *)
+           d=0.9731; e= -0.0359; f= -0.2275;
+           g= -0.2290; h= -0.2532; i= -0.9399;
+           tx=3.5401; ty= -29.7913; tz=52.2796 },
+      {    a= -0.8912; b= -0.4531; c=0.0242; (* P_O3'_60_tfo *)
+           d= -0.1183; e=0.1805; f= -0.9764;
+           g=0.4380; h= -0.8730; i= -0.2145;
+           tx=19.9023; ty=54.8054; tz=15.2799 },
+      { x = 41.8210; y = 8.3880; z = 43.5890 }, (* P    *)
+      { x = 42.5400; y = 8.0450; z = 44.8330 }, (* O1P  *)
+      { x = 42.2470; y = 9.6920; z = 42.9910 }, (* O2P  *)
+      { x = 40.2550; y = 8.2030; z = 43.7340 }, (* O5'  *)
+      { x = 39.3505; y = 8.4697; z = 42.6565 }, (* C5'  *)
+      { x = 39.1377; y = 7.5433; z = 42.1230 }, (* H5'  *)
+      { x = 39.7203; y = 9.3119; z = 42.0717 }, (* H5'' *)
+      { x = 38.0405; y = 8.9195; z = 43.2869 }, (* C4'  *)
+      { x = 37.6479; y = 8.1347; z = 43.9335 }, (* H4'  *)
+      { x = 38.2691; y = 10.0933; z = 44.0524 }, (* O4'  *)
+      { x = 37.3999; y = 11.1488; z = 43.5973 }, (* C1'  *)
+      { x = 36.5061; y = 11.1221; z = 44.2206 }, (* H1'  *)
+      { x = 37.0364; y = 10.7838; z = 42.1836 }, (* C2'  *)
+      { x = 37.8636; y = 11.0489; z = 41.5252 }, (* H2'' *)
+      { x = 35.8275; y = 11.3133; z = 41.7379 }, (* O2'  *)
+      { x = 35.6214; y = 12.1896; z = 42.0714 }, (* H2'  *)
+      { x = 36.9316; y = 9.2556; z = 42.2837 }, (* C3'  *)
+      { x = 37.1778; y = 8.8260; z = 41.3127 }, (* H3'  *)
+      { x = 35.6285; y = 8.9334; z = 42.7926 }, (* O3'  *)
+      { x = 38.1482; y = 15.2833; z = 46.4641 }, (* N1   *)
+      { x = 37.3641; y = 13.0968; z = 45.9007 }, (* N3   *)
+      { x = 37.5032; y = 14.1288; z = 46.7300 }, (* C2   *)
+      { x = 37.9570; y = 13.3377; z = 44.7113 }, (* C4   *)
+      { x = 38.6397; y = 14.4660; z = 44.3267 }, (* C5   *)
+      { x = 38.7473; y = 15.5229; z = 45.2609 }, (* C6 *)
+      (A (
+      { x = 39.3720; y = 16.6649; z = 45.0297 }, (* N6   *)
+      { x = 39.1079; y = 14.3351; z = 43.0223 }, (* N7   *)
+      { x = 38.0132; y = 12.4868; z = 43.6280 }, (* N9   *)
+      { x = 38.7058; y = 13.1402; z = 42.6620 }, (* C8   *)
+      { x = 37.0731; y = 14.0857; z = 47.7306 }, (* H2   *)
+      { x = 39.8113; y = 16.8281; z = 44.1350 }, (* H61  *)
+      { x = 39.4100; y = 17.3741; z = 45.7478 }, (* H62  *)
+      { x = 39.0412; y = 12.9660; z = 41.6397 }) (* H8   *)
+      )
+    )
+
+let rA10
+  = N(
+      {    a=0.7063; b=0.6317; c= -0.3196; (* dgf_base_tfo *)
+           d= -0.0403; e= -0.4149; f= -0.9090;
+           g= -0.7068; h=0.6549; i= -0.2676;
+           tx=6.4402; ty= -52.1496; tz=30.8246 },
+      {    a=0.7529; b=0.1548; c=0.6397; (* P_O3'_275_tfo *)
+           d=0.2952; e= -0.9481; f= -0.1180;
+           g=0.5882; h=0.2777; i= -0.7595;
+           tx= -58.8919; ty= -11.3095; tz=6.0866 },
+      {    a= -0.0239; b=0.9667; c= -0.2546; (* P_O3'_180_tfo *)
+           d=0.9731; e= -0.0359; f= -0.2275;
+           g= -0.2290; h= -0.2532; i= -0.9399;
+           tx=3.5401; ty= -29.7913; tz=52.2796 },
+      {    a= -0.8912; b= -0.4531; c=0.0242; (* P_O3'_60_tfo *)
+           d= -0.1183; e=0.1805; f= -0.9764;
+           g=0.4380; h= -0.8730; i= -0.2145;
+           tx=19.9023; ty=54.8054; tz=15.2799 },
+      { x = 41.8210; y = 8.3880; z = 43.5890 }, (* P    *)
+      { x = 42.5400; y = 8.0450; z = 44.8330 }, (* O1P  *)
+      { x = 42.2470; y = 9.6920; z = 42.9910 }, (* O2P  *)
+      { x = 40.2550; y = 8.2030; z = 43.7340 }, (* O5'  *)
+      { x = 39.4850; y = 8.9301; z = 44.6977 }, (* C5'  *)
+      { x = 39.0638; y = 9.8199; z = 44.2296 }, (* H5'  *)
+      { x = 40.0757; y = 9.0713; z = 45.6029 }, (* H5'' *)
+      { x = 38.3102; y = 8.0414; z = 45.0789 }, (* C4'  *)
+      { x = 37.7099; y = 7.8166; z = 44.1973 }, (* H4'  *)
+      { x = 38.8012; y = 6.8321; z = 45.6380 }, (* O4'  *)
+      { x = 38.2431; y = 6.6413; z = 46.9529 }, (* C1'  *)
+      { x = 37.3505; y = 6.0262; z = 46.8385 }, (* H1'  *)
+      { x = 37.8484; y = 8.0156; z = 47.4214 }, (* C2'  *)
+      { x = 38.7381; y = 8.5406; z = 47.7690 }, (* H2'' *)
+      { x = 36.8286; y = 8.0368; z = 48.3701 }, (* O2'  *)
+      { x = 36.8392; y = 7.3063; z = 48.9929 }, (* H2'  *)
+      { x = 37.3576; y = 8.6512; z = 46.1132 }, (* C3'  *)
+      { x = 37.5207; y = 9.7275; z = 46.1671 }, (* H3'  *)
+      { x = 35.9985; y = 8.2392; z = 45.9032 }, (* O3'  *)
+      { x = 39.9117; y = 2.2278; z = 48.8527 }, (* N1   *)
+      { x = 38.6207; y = 3.6941; z = 47.4757 }, (* N3   *)
+      { x = 38.9872; y = 2.4888; z = 47.9057 }, (* C2   *)
+      { x = 39.2961; y = 4.6720; z = 48.1174 }, (* C4   *)
+      { x = 40.2546; y = 4.5307; z = 49.0912 }, (* C5   *)
+      { x = 40.5932; y = 3.2189; z = 49.4985 }, (* C6 *)
+      (A (
+      { x = 41.4938; y = 2.9317; z = 50.4229 }, (* N6   *)
+      { x = 40.7195; y = 5.7755; z = 49.5060 }, (* N7   *)
+      { x = 39.1730; y = 6.0305; z = 47.9170 }, (* N9   *)
+      { x = 40.0413; y = 6.6250; z = 48.7728 }, (* C8   *)
+      { x = 38.5257; y = 1.5960; z = 47.4838 }, (* H2   *)
+      { x = 41.9907; y = 3.6753; z = 50.8921 }, (* H61  *)
+      { x = 41.6848; y = 1.9687; z = 50.6599 }, (* H62  *)
+      { x = 40.3571; y = 7.6321; z = 49.0452 }) (* H8   *)
+      )
+    )
+
+let rAs = [rA01;rA02;rA03;rA04;rA05;rA06;rA07;rA08;rA09;rA10]
+
+let rC
+  = N(
+      {    a= -0.0359; b= -0.8071; c=0.5894; (* dgf_base_tfo *)
+           d= -0.2669; e=0.5761; f=0.7726;
+           g= -0.9631; h= -0.1296; i= -0.2361;
+           tx=0.1584; ty=8.3434; tz=0.5434 },
+      {    a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+           d=0.0649; e=0.4366; f= -0.8973;
+           g=0.5521; h= -0.7648; i= -0.3322;
+           tx=1.6833; ty=6.8060; tz= -7.0011 },
+      {    a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+           d= -0.4628; e= -0.6450; f= -0.6082;
+           g=0.8168; h= -0.0436; i= -0.5753;
+           tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+      {    a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+           d=0.8103; e= -0.5790; f=0.0906;
+           g= -0.0255; h= -0.1894; i= -0.9816;
+           tx=6.1203; ty= -7.1051; tz=3.1984 },
+      { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P    *)
+      { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P  *)
+      { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P  *)
+      { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5'  *)
+      { x = 5.2430; y = -8.2420; z = 2.8260 }, (* C5'  *)
+      { x = 5.1974; y = -8.8497; z = 1.9223 }, (* H5'  *)
+      { x = 5.5548; y = -8.7348; z = 3.7469 }, (* H5'' *)
+      { x = 6.3140; y = -7.2060; z = 2.5510 }, (* C4'  *)
+      { x = 7.2954; y = -7.6762; z = 2.4898 }, (* H4'  *)
+      { x = 6.0140; y = -6.5420; z = 1.2890 }, (* O4'  *)
+      { x = 6.4190; y = -5.1840; z = 1.3620 }, (* C1'  *)
+      { x = 7.1608; y = -5.0495; z = 0.5747 }, (* H1'  *)
+      { x = 7.0760; y = -4.9560; z = 2.7270 }, (* C2'  *)
+      { x = 6.7770; y = -3.9803; z = 3.1099 }, (* H2'' *)
+      { x = 8.4500; y = -5.1930; z = 2.5810 }, (* O2'  *)
+      { x = 8.8309; y = -4.8755; z = 1.7590 }, (* H2'  *)
+      { x = 6.4060; y = -6.0590; z = 3.5580 }, (* C3'  *)
+      { x = 5.4021; y = -5.7313; z = 3.8281 }, (* H3'  *)
+      { x = 7.1570; y = -6.4240; z = 4.7070 }, (* O3'  *)
+      { x = 5.2170; y = -4.3260; z = 1.1690 }, (* N1   *)
+      { x = 4.2960; y = -2.2560; z = 0.6290 }, (* N3   *)
+      { x = 5.4330; y = -3.0200; z = 0.7990 }, (* C2   *)
+      { x = 2.9930; y = -2.6780; z = 0.7940 }, (* C4   *)
+      { x = 2.8670; y = -4.0630; z = 1.1830 }, (* C5   *)
+      { x = 3.9570; y = -4.8300; z = 1.3550 }, (* C6 *)
+      (C (
+      { x = 2.0187; y = -1.8047; z = 0.5874 }, (* N4   *)
+      { x = 6.5470; y = -2.5560; z = 0.6290 }, (* O2   *)
+      { x = 1.0684; y = -2.1236; z = 0.7109 }, (* H41  *)
+      { x = 2.2344; y = -0.8560; z = 0.3162 }, (* H42  *)
+      { x = 1.8797; y = -4.4972; z = 1.3404 }, (* H5   *)
+      { x = 3.8479; y = -5.8742; z = 1.6480 }) (* H6   *)
+      )
+    )
+
+let rC01
+  = N(
+      {    a= -0.0137; b= -0.8012; c=0.5983; (* dgf_base_tfo *)
+           d= -0.2523; e=0.5817; f=0.7733;
+           g= -0.9675; h= -0.1404; i= -0.2101;
+           tx=0.2031; ty=8.3874; tz=0.4228 },
+      {    a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+           d=0.0649; e=0.4366; f= -0.8973;
+           g=0.5521; h= -0.7648; i= -0.3322;
+           tx=1.6833; ty=6.8060; tz= -7.0011 },
+      {    a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+           d= -0.4628; e= -0.6450; f= -0.6082;
+           g=0.8168; h= -0.0436; i= -0.5753;
+           tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+      {    a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+           d=0.8103; e= -0.5790; f=0.0906;
+           g= -0.0255; h= -0.1894; i= -0.9816;
+           tx=6.1203; ty= -7.1051; tz=3.1984 },
+      { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P    *)
+      { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P  *)
+      { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P  *)
+      { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5'  *)
+      { x = 5.2416; y = -8.2422; z = 2.8181 }, (* C5'  *)
+      { x = 5.2050; y = -8.8128; z = 1.8901 }, (* H5'  *)
+      { x = 5.5368; y = -8.7738; z = 3.7227 }, (* H5'' *)
+      { x = 6.3232; y = -7.2037; z = 2.6002 }, (* C4'  *)
+      { x = 7.3048; y = -7.6757; z = 2.5577 }, (* H4'  *)
+      { x = 6.0635; y = -6.5092; z = 1.3456 }, (* O4'  *)
+      { x = 6.4697; y = -5.1547; z = 1.4629 }, (* C1'  *)
+      { x = 7.2354; y = -5.0043; z = 0.7018 }, (* H1'  *)
+      { x = 7.0856; y = -4.9610; z = 2.8521 }, (* C2'  *)
+      { x = 6.7777; y = -3.9935; z = 3.2487 }, (* H2'' *)
+      { x = 8.4627; y = -5.1992; z = 2.7423 }, (* O2'  *)
+      { x = 8.8693; y = -4.8638; z = 1.9399 }, (* H2'  *)
+      { x = 6.3877; y = -6.0809; z = 3.6362 }, (* C3'  *)
+      { x = 5.3770; y = -5.7562; z = 3.8834 }, (* H3'  *)
+      { x = 7.1024; y = -6.4754; z = 4.7985 }, (* O3'  *)
+      { x = 5.2764; y = -4.2883; z = 1.2538 }, (* N1   *)
+      { x = 4.3777; y = -2.2062; z = 0.7229 }, (* N3   *)
+      { x = 5.5069; y = -2.9779; z = 0.9088 }, (* C2   *)
+      { x = 3.0693; y = -2.6246; z = 0.8500 }, (* C4   *)
+      { x = 2.9279; y = -4.0146; z = 1.2149 }, (* C5   *)
+      { x = 4.0101; y = -4.7892; z = 1.4017 }, (* C6 *)
+      (C (
+      { x = 2.1040; y = -1.7437; z = 0.6331 }, (* N4   *)
+      { x = 6.6267; y = -2.5166; z = 0.7728 }, (* O2   *)
+      { x = 1.1496; y = -2.0600; z = 0.7287 }, (* H41  *)
+      { x = 2.3303; y = -0.7921; z = 0.3815 }, (* H42  *)
+      { x = 1.9353; y = -4.4465; z = 1.3419 }, (* H5   *)
+      { x = 3.8895; y = -5.8371; z = 1.6762 }) (* H6   *)
+      )
+    )
+
+let rC02
+  = N(
+      {    a=0.5141; b=0.0246; c=0.8574; (* dgf_base_tfo *)
+           d= -0.5547; e= -0.7529; f=0.3542;
+           g=0.6542; h= -0.6577; i= -0.3734;
+           tx= -9.1111; ty= -3.4598; tz= -3.2939 },
+      {    a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+           d=0.0649; e=0.4366; f= -0.8973;
+           g=0.5521; h= -0.7648; i= -0.3322;
+           tx=1.6833; ty=6.8060; tz= -7.0011 },
+      {    a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+           d= -0.4628; e= -0.6450; f= -0.6082;
+           g=0.8168; h= -0.0436; i= -0.5753;
+           tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+      {    a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+           d=0.8103; e= -0.5790; f=0.0906;
+           g= -0.0255; h= -0.1894; i= -0.9816;
+           tx=6.1203; ty= -7.1051; tz=3.1984 },
+      { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P    *)
+      { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P  *)
+      { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P  *)
+      { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5'  *)
+      { x = 4.3825; y = -6.6585; z = 4.0489 }, (* C5'  *)
+      { x = 4.6841; y = -7.2019; z = 4.9443 }, (* H5'  *)
+      { x = 3.6189; y = -5.8889; z = 4.1625 }, (* H5'' *)
+      { x = 5.6255; y = -5.9175; z = 3.5998 }, (* C4'  *)
+      { x = 5.8732; y = -5.1228; z = 4.3034 }, (* H4'  *)
+      { x = 6.7337; y = -6.8605; z = 3.5222 }, (* O4'  *)
+      { x = 7.5932; y = -6.4923; z = 2.4548 }, (* C1'  *)
+      { x = 8.5661; y = -6.2983; z = 2.9064 }, (* H1'  *)
+      { x = 7.0527; y = -5.2012; z = 1.8322 }, (* C2'  *)
+      { x = 7.1627; y = -5.2525; z = 0.7490 }, (* H2'' *)
+      { x = 7.6666; y = -4.1249; z = 2.4880 }, (* O2'  *)
+      { x = 8.5944; y = -4.2543; z = 2.6981 }, (* H2'  *)
+      { x = 5.5661; y = -5.3029; z = 2.2009 }, (* C3'  *)
+      { x = 5.0841; y = -6.0018; z = 1.5172 }, (* H3'  *)
+      { x = 4.9062; y = -4.0452; z = 2.2042 }, (* O3'  *)
+      { x = 7.6298; y = -7.6136; z = 1.4752 }, (* N1   *)
+      { x = 8.6945; y = -8.7046; z = -0.2857 }, (* N3   *)
+      { x = 8.6943; y = -7.6514; z = 0.6066 }, (* C2   *)
+      { x = 7.7426; y = -9.6987; z = -0.3801 }, (* C4   *)
+      { x = 6.6642; y = -9.5742; z = 0.5722 }, (* C5   *)
+      { x = 6.6391; y = -8.5592; z = 1.4526 }, (* C6 *)
+      (C (
+      { x = 7.9033; y = -10.6371; z = -1.3010 }, (* N4   *)
+      { x = 9.5840; y = -6.8186; z = 0.6136 }, (* O2   *)
+      { x = 7.2009; y = -11.3604; z = -1.3619 }, (* H41  *)
+      { x = 8.7058; y = -10.6168; z = -1.9140 }, (* H42  *)
+      { x = 5.8585; y = -10.3083; z = 0.5822 }, (* H5   *)
+      { x = 5.8197; y = -8.4773; z = 2.1667 }) (* H6   *)
+      )
+    )
+
+let rC03
+  = N(
+      {    a= -0.4993; b=0.0476; c=0.8651; (* dgf_base_tfo *)
+           d=0.8078; e= -0.3353; f=0.4847;
+           g=0.3132; h=0.9409; i=0.1290;
+           tx=6.2989; ty= -5.2303; tz= -3.8577 },
+      {    a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+           d=0.0649; e=0.4366; f= -0.8973;
+           g=0.5521; h= -0.7648; i= -0.3322;
+           tx=1.6833; ty=6.8060; tz= -7.0011 },
+      {    a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+           d= -0.4628; e= -0.6450; f= -0.6082;
+           g=0.8168; h= -0.0436; i= -0.5753;
+           tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+      {    a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+           d=0.8103; e= -0.5790; f=0.0906;
+           g= -0.0255; h= -0.1894; i= -0.9816;
+           tx=6.1203; ty= -7.1051; tz=3.1984 },
+      { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P    *)
+      { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P  *)
+      { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P  *)
+      { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5'  *)
+      { x = 3.9938; y = -6.7042; z = 1.9023 }, (* C5'  *)
+      { x = 3.2332; y = -5.9343; z = 2.0319 }, (* H5'  *)
+      { x = 3.9666; y = -7.2863; z = 0.9812 }, (* H5'' *)
+      { x = 5.3098; y = -5.9546; z = 1.8564 }, (* C4'  *)
+      { x = 5.3863; y = -5.3702; z = 0.9395 }, (* H4'  *)
+      { x = 5.3851; y = -5.0642; z = 3.0076 }, (* O4'  *)
+      { x = 6.7315; y = -4.9724; z = 3.4462 }, (* C1'  *)
+      { x = 7.0033; y = -3.9202; z = 3.3619 }, (* H1'  *)
+      { x = 7.5997; y = -5.8018; z = 2.4948 }, (* C2'  *)
+      { x = 8.3627; y = -6.3254; z = 3.0707 }, (* H2'' *)
+      { x = 8.0410; y = -4.9501; z = 1.4724 }, (* O2'  *)
+      { x = 8.2781; y = -4.0644; z = 1.7570 }, (* H2'  *)
+      { x = 6.5701; y = -6.8129; z = 1.9714 }, (* C3'  *)
+      { x = 6.4186; y = -7.5809; z = 2.7299 }, (* H3'  *)
+      { x = 6.9357; y = -7.3841; z = 0.7235 }, (* O3'  *)
+      { x = 6.8024; y = -5.4718; z = 4.8475 }, (* N1   *)
+      { x = 7.9218; y = -5.5700; z = 6.8877 }, (* N3   *)
+      { x = 7.8908; y = -5.0886; z = 5.5944 }, (* C2   *)
+      { x = 6.9789; y = -6.3827; z = 7.4823 }, (* C4   *)
+      { x = 5.8742; y = -6.7319; z = 6.6202 }, (* C5   *)
+      { x = 5.8182; y = -6.2769; z = 5.3570 }, (* C6 *)
+      (C (
+      { x = 7.1702; y = -6.7511; z = 8.7402 }, (* N4   *)
+      { x = 8.7747; y = -4.3728; z = 5.1568 }, (* O2   *)
+      { x = 6.4741; y = -7.3461; z = 9.1662 }, (* H41  *)
+      { x = 7.9889; y = -6.4396; z = 9.2429 }, (* H42  *)
+      { x = 5.0736; y = -7.3713; z = 6.9922 }, (* H5   *)
+      { x = 4.9784; y = -6.5473; z = 4.7170 }) (* H6   *)
+      )
+    )
+
+let rC04
+  = N(
+      {    a= -0.5669; b= -0.8012; c=0.1918; (* dgf_base_tfo *)
+           d= -0.8129; e=0.5817; f=0.0273;
+           g= -0.1334; h= -0.1404; i= -0.9811;
+           tx= -0.3279; ty=8.3874; tz=0.3355 },
+      {    a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+           d=0.0649; e=0.4366; f= -0.8973;
+           g=0.5521; h= -0.7648; i= -0.3322;
+           tx=1.6833; ty=6.8060; tz= -7.0011 },
+      {    a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+           d= -0.4628; e= -0.6450; f= -0.6082;
+           g=0.8168; h= -0.0436; i= -0.5753;
+           tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+      {    a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+           d=0.8103; e= -0.5790; f=0.0906;
+           g= -0.0255; h= -0.1894; i= -0.9816;
+           tx=6.1203; ty= -7.1051; tz=3.1984 },
+      { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P    *)
+      { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P  *)
+      { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P  *)
+      { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5'  *)
+      { x = 5.2416; y = -8.2422; z = 2.8181 }, (* C5'  *)
+      { x = 5.2050; y = -8.8128; z = 1.8901 }, (* H5'  *)
+      { x = 5.5368; y = -8.7738; z = 3.7227 }, (* H5'' *)
+      { x = 6.3232; y = -7.2037; z = 2.6002 }, (* C4'  *)
+      { x = 7.3048; y = -7.6757; z = 2.5577 }, (* H4'  *)
+      { x = 6.0635; y = -6.5092; z = 1.3456 }, (* O4'  *)
+      { x = 6.4697; y = -5.1547; z = 1.4629 }, (* C1'  *)
+      { x = 7.2354; y = -5.0043; z = 0.7018 }, (* H1'  *)
+      { x = 7.0856; y = -4.9610; z = 2.8521 }, (* C2'  *)
+      { x = 6.7777; y = -3.9935; z = 3.2487 }, (* H2'' *)
+      { x = 8.4627; y = -5.1992; z = 2.7423 }, (* O2'  *)
+      { x = 8.8693; y = -4.8638; z = 1.9399 }, (* H2'  *)
+      { x = 6.3877; y = -6.0809; z = 3.6362 }, (* C3'  *)
+      { x = 5.3770; y = -5.7562; z = 3.8834 }, (* H3'  *)
+      { x = 7.1024; y = -6.4754; z = 4.7985 }, (* O3'  *)
+      { x = 5.2764; y = -4.2883; z = 1.2538 }, (* N1   *)
+      { x = 3.8961; y = -3.0896; z = -0.1893 }, (* N3   *)
+      { x = 5.0095; y = -3.8907; z = -0.0346 }, (* C2   *)
+      { x = 3.0480; y = -2.6632; z = 0.8116 }, (* C4   *)
+      { x = 3.4093; y = -3.1310; z = 2.1292 }, (* C5   *)
+      { x = 4.4878; y = -3.9124; z = 2.3088 }, (* C6 *)
+      (C (
+      { x = 2.0216; y = -1.8941; z = 0.4804 }, (* N4   *)
+      { x = 5.7005; y = -4.2164; z = -0.9842 }, (* O2   *)
+      { x = 1.4067; y = -1.5873; z = 1.2205 }, (* H41  *)
+      { x = 1.8721; y = -1.6319; z = -0.4835 }, (* H42  *)
+      { x = 2.8048; y = -2.8507; z = 2.9918 }, (* H5   *)
+      { x = 4.7491; y = -4.2593; z = 3.3085 }) (* H6   *)
+      )
+    )
+
+let rC05
+  = N(
+      {    a= -0.6298; b=0.0246; c=0.7763; (* dgf_base_tfo *)
+           d= -0.5226; e= -0.7529; f= -0.4001;
+           g=0.5746; h= -0.6577; i=0.4870;
+           tx= -0.0208; ty= -3.4598; tz= -9.6882 },
+      {    a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+           d=0.0649; e=0.4366; f= -0.8973;
+           g=0.5521; h= -0.7648; i= -0.3322;
+           tx=1.6833; ty=6.8060; tz= -7.0011 },
+      {    a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+           d= -0.4628; e= -0.6450; f= -0.6082;
+           g=0.8168; h= -0.0436; i= -0.5753;
+           tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+      {    a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+           d=0.8103; e= -0.5790; f=0.0906;
+           g= -0.0255; h= -0.1894; i= -0.9816;
+           tx=6.1203; ty= -7.1051; tz=3.1984 },
+      { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P    *)
+      { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P  *)
+      { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P  *)
+      { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5'  *)
+      { x = 4.3825; y = -6.6585; z = 4.0489 }, (* C5'  *)
+      { x = 4.6841; y = -7.2019; z = 4.9443 }, (* H5'  *)
+      { x = 3.6189; y = -5.8889; z = 4.1625 }, (* H5'' *)
+      { x = 5.6255; y = -5.9175; z = 3.5998 }, (* C4'  *)
+      { x = 5.8732; y = -5.1228; z = 4.3034 }, (* H4'  *)
+      { x = 6.7337; y = -6.8605; z = 3.5222 }, (* O4'  *)
+      { x = 7.5932; y = -6.4923; z = 2.4548 }, (* C1'  *)
+      { x = 8.5661; y = -6.2983; z = 2.9064 }, (* H1'  *)
+      { x = 7.0527; y = -5.2012; z = 1.8322 }, (* C2'  *)
+      { x = 7.1627; y = -5.2525; z = 0.7490 }, (* H2'' *)
+      { x = 7.6666; y = -4.1249; z = 2.4880 }, (* O2'  *)
+      { x = 8.5944; y = -4.2543; z = 2.6981 }, (* H2'  *)
+      { x = 5.5661; y = -5.3029; z = 2.2009 }, (* C3'  *)
+      { x = 5.0841; y = -6.0018; z = 1.5172 }, (* H3'  *)
+      { x = 4.9062; y = -4.0452; z = 2.2042 }, (* O3'  *)
+      { x = 7.6298; y = -7.6136; z = 1.4752 }, (* N1   *)
+      { x = 8.5977; y = -9.5977; z = 0.7329 }, (* N3   *)
+      { x = 8.5951; y = -8.5745; z = 1.6594 }, (* C2   *)
+      { x = 7.7372; y = -9.7371; z = -0.3364 }, (* C4   *)
+      { x = 6.7596; y = -8.6801; z = -0.4476 }, (* C5   *)
+      { x = 6.7338; y = -7.6721; z = 0.4408 }, (* C6 *)
+      (C (
+      { x = 7.8849; y = -10.7881; z = -1.1289 }, (* N4   *)
+      { x = 9.3993; y = -8.5377; z = 2.5743 }, (* O2   *)
+      { x = 7.2499; y = -10.8809; z = -1.9088 }, (* H41  *)
+      { x = 8.6122; y = -11.4649; z = -0.9468 }, (* H42  *)
+      { x = 6.0317; y = -8.6941; z = -1.2588 }, (* H5   *)
+      { x = 5.9901; y = -6.8809; z = 0.3459 }) (* H6   *)
+      )
+    )
+
+let rC06
+  = N(
+      {    a= -0.9837; b=0.0476; c= -0.1733; (* dgf_base_tfo *)
+           d= -0.1792; e= -0.3353; f=0.9249;
+           g= -0.0141; h=0.9409; i=0.3384;
+           tx=5.7793; ty= -5.2303; tz=4.5997 },
+      {    a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+           d=0.0649; e=0.4366; f= -0.8973;
+           g=0.5521; h= -0.7648; i= -0.3322;
+           tx=1.6833; ty=6.8060; tz= -7.0011 },
+      {    a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+           d= -0.4628; e= -0.6450; f= -0.6082;
+           g=0.8168; h= -0.0436; i= -0.5753;
+           tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+      {    a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+           d=0.8103; e= -0.5790; f=0.0906;
+           g= -0.0255; h= -0.1894; i= -0.9816;
+           tx=6.1203; ty= -7.1051; tz=3.1984 },
+      { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P    *)
+      { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P  *)
+      { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P  *)
+      { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5'  *)
+      { x = 3.9938; y = -6.7042; z = 1.9023 }, (* C5'  *)
+      { x = 3.2332; y = -5.9343; z = 2.0319 }, (* H5'  *)
+      { x = 3.9666; y = -7.2863; z = 0.9812 }, (* H5'' *)
+      { x = 5.3098; y = -5.9546; z = 1.8564 }, (* C4'  *)
+      { x = 5.3863; y = -5.3702; z = 0.9395 }, (* H4'  *)
+      { x = 5.3851; y = -5.0642; z = 3.0076 }, (* O4'  *)
+      { x = 6.7315; y = -4.9724; z = 3.4462 }, (* C1'  *)
+      { x = 7.0033; y = -3.9202; z = 3.3619 }, (* H1'  *)
+      { x = 7.5997; y = -5.8018; z = 2.4948 }, (* C2'  *)
+      { x = 8.3627; y = -6.3254; z = 3.0707 }, (* H2'' *)
+      { x = 8.0410; y = -4.9501; z = 1.4724 }, (* O2'  *)
+      { x = 8.2781; y = -4.0644; z = 1.7570 }, (* H2'  *)
+      { x = 6.5701; y = -6.8129; z = 1.9714 }, (* C3'  *)
+      { x = 6.4186; y = -7.5809; z = 2.7299 }, (* H3'  *)
+      { x = 6.9357; y = -7.3841; z = 0.7235 }, (* O3'  *)
+      { x = 6.8024; y = -5.4718; z = 4.8475 }, (* N1   *)
+      { x = 6.6920; y = -5.0495; z = 7.1354 }, (* N3   *)
+      { x = 6.6201; y = -4.5500; z = 5.8506 }, (* C2   *)
+      { x = 6.9254; y = -6.3614; z = 7.4926 }, (* C4   *)
+      { x = 7.1046; y = -7.2543; z = 6.3718 }, (* C5   *)
+      { x = 7.0391; y = -6.7951; z = 5.1106 }, (* C6 *)
+      (C (
+      { x = 6.9614; y = -6.6648; z = 8.7815 }, (* N4   *)
+      { x = 6.4083; y = -3.3696; z = 5.6340 }, (* O2   *)
+      { x = 7.1329; y = -7.6280; z = 9.0324 }, (* H41  *)
+      { x = 6.8204; y = -5.9469; z = 9.4777 }, (* H42  *)
+      { x = 7.2954; y = -8.3135; z = 6.5440 }, (* H5   *)
+      { x = 7.1753; y = -7.4798; z = 4.2735 }) (* H6   *)
+      )
+    )
+
+let rC07
+  = N(
+      {    a=0.0033; b=0.2720; c= -0.9623; (* dgf_base_tfo *)
+           d=0.3013; e= -0.9179; f= -0.2584;
+           g= -0.9535; h= -0.2891; i= -0.0850;
+           tx=43.0403; ty=13.7233; tz=34.5710 },
+      {    a=0.9187; b=0.2887; c=0.2694; (* P_O3'_275_tfo *)
+           d=0.0302; e= -0.7316; f=0.6811;
+           g=0.3938; h= -0.6176; i= -0.6808;
+           tx= -48.4330; ty=26.3254; tz=13.6383 },
+      {    a= -0.1504; b=0.7744; c= -0.6145; (* P_O3'_180_tfo *)
+           d=0.7581; e=0.4893; f=0.4311;
+           g=0.6345; h= -0.4010; i= -0.6607;
+           tx= -31.9784; ty= -13.4285; tz=44.9650 },
+      {    a= -0.6236; b= -0.7810; c= -0.0337; (* P_O3'_60_tfo *)
+           d= -0.6890; e=0.5694; f= -0.4484;
+           g=0.3694; h= -0.2564; i= -0.8932;
+           tx=12.1105; ty=30.8774; tz=46.0946 },
+      { x = 33.3400; y = 11.0980; z = 46.1750 }, (* P    *)
+      { x = 34.5130; y = 10.2320; z = 46.4660 }, (* O1P  *)
+      { x = 33.4130; y = 12.3960; z = 46.9340 }, (* O2P  *)
+      { x = 31.9810; y = 10.3390; z = 46.4820 }, (* O5'  *)
+      { x = 30.8152; y = 11.1619; z = 46.2003 }, (* C5'  *)
+      { x = 30.4519; y = 10.9454; z = 45.1957 }, (* H5'  *)
+      { x = 31.0379; y = 12.2016; z = 46.4400 }, (* H5'' *)
+      { x = 29.7081; y = 10.7448; z = 47.1428 }, (* C4'  *)
+      { x = 28.8710; y = 11.4416; z = 47.0982 }, (* H4'  *)
+      { x = 29.2550; y = 9.4394; z = 46.8162 }, (* O4'  *)
+      { x = 29.3907; y = 8.5625; z = 47.9460 }, (* C1'  *)
+      { x = 28.4416; y = 8.5669; z = 48.4819 }, (* H1'  *)
+      { x = 30.4468; y = 9.2031; z = 48.7952 }, (* C2'  *)
+      { x = 31.4222; y = 8.9651; z = 48.3709 }, (* H2'' *)
+      { x = 30.3701; y = 8.9157; z = 50.1624 }, (* O2'  *)
+      { x = 30.0652; y = 8.0304; z = 50.3740 }, (* H2'  *)
+      { x = 30.1622; y = 10.6879; z = 48.6120 }, (* C3'  *)
+      { x = 31.0952; y = 11.2399; z = 48.7254 }, (* H3'  *)
+      { x = 29.1076; y = 11.1535; z = 49.4702 }, (* O3'  *)
+      { x = 29.7883; y = 7.2209; z = 47.5235 }, (* N1   *)
+      { x = 29.1825; y = 5.0438; z = 46.8275 }, (* N3   *)
+      { x = 28.8008; y = 6.2912; z = 47.2263 }, (* C2   *)
+      { x = 30.4888; y = 4.6890; z = 46.7186 }, (* C4   *)
+      { x = 31.5034; y = 5.6405; z = 47.0249 }, (* C5   *)
+      { x = 31.1091; y = 6.8691; z = 47.4156 }, (* C6 *)
+      (C (
+      { x = 30.8109; y = 3.4584; z = 46.3336 }, (* N4   *)
+      { x = 27.6171; y = 6.5989; z = 47.3189 }, (* O2   *)
+      { x = 31.7923; y = 3.2301; z = 46.2638 }, (* H41  *)
+      { x = 30.0880; y = 2.7857; z = 46.1215 }, (* H42  *)
+      { x = 32.5542; y = 5.3634; z = 46.9395 }, (* H5   *)
+      { x = 31.8523; y = 7.6279; z = 47.6603 }) (* H6   *)
+      )
+    )
+
+let rC08
+  = N(
+      {    a=0.0797; b= -0.6026; c= -0.7941; (* dgf_base_tfo *)
+           d=0.7939; e=0.5201; f= -0.3150;
+           g=0.6028; h= -0.6054; i=0.5198;
+           tx= -36.8341; ty=41.5293; tz=1.6628 },
+      {    a=0.9187; b=0.2887; c=0.2694; (* P_O3'_275_tfo *)
+           d=0.0302; e= -0.7316; f=0.6811;
+           g=0.3938; h= -0.6176; i= -0.6808;
+           tx= -48.4330; ty=26.3254; tz=13.6383 },
+      {    a= -0.1504; b=0.7744; c= -0.6145; (* P_O3'_180_tfo *)
+           d=0.7581; e=0.4893; f=0.4311;
+           g=0.6345; h= -0.4010; i= -0.6607;
+           tx= -31.9784; ty= -13.4285; tz=44.9650 },
+      {    a= -0.6236; b= -0.7810; c= -0.0337; (* P_O3'_60_tfo *)
+           d= -0.6890; e=0.5694; f= -0.4484;
+           g=0.3694; h= -0.2564; i= -0.8932;
+           tx=12.1105; ty=30.8774; tz=46.0946 },
+      { x = 33.3400; y = 11.0980; z = 46.1750 }, (* P    *)
+      { x = 34.5130; y = 10.2320; z = 46.4660 }, (* O1P  *)
+      { x = 33.4130; y = 12.3960; z = 46.9340 }, (* O2P  *)
+      { x = 31.9810; y = 10.3390; z = 46.4820 }, (* O5'  *)
+      { x = 31.8779; y = 9.9369; z = 47.8760 }, (* C5'  *)
+      { x = 31.3239; y = 10.6931; z = 48.4322 }, (* H5'  *)
+      { x = 32.8647; y = 9.6624; z = 48.2489 }, (* H5'' *)
+      { x = 31.0429; y = 8.6773; z = 47.9401 }, (* C4'  *)
+      { x = 31.0779; y = 8.2331; z = 48.9349 }, (* H4'  *)
+      { x = 29.6956; y = 8.9669; z = 47.5983 }, (* O4'  *)
+      { x = 29.2784; y = 8.1700; z = 46.4782 }, (* C1'  *)
+      { x = 28.8006; y = 7.2731; z = 46.8722 }, (* H1'  *)
+      { x = 30.5544; y = 7.7940; z = 45.7875 }, (* C2'  *)
+      { x = 30.8837; y = 8.6410; z = 45.1856 }, (* H2'' *)
+      { x = 30.5100; y = 6.6007; z = 45.0582 }, (* O2'  *)
+      { x = 29.6694; y = 6.4168; z = 44.6326 }, (* H2'  *)
+      { x = 31.5146; y = 7.5954; z = 46.9527 }, (* C3'  *)
+      { x = 32.5255; y = 7.8261; z = 46.6166 }, (* H3'  *)
+      { x = 31.3876; y = 6.2951; z = 47.5516 }, (* O3'  *)
+      { x = 28.3976; y = 8.9302; z = 45.5933 }, (* N1   *)
+      { x = 26.2155; y = 9.6135; z = 44.9910 }, (* N3   *)
+      { x = 27.0281; y = 8.8961; z = 45.8192 }, (* C2   *)
+      { x = 26.7044; y = 10.3489; z = 43.9595 }, (* C4   *)
+      { x = 28.1088; y = 10.3837; z = 43.7247 }, (* C5   *)
+      { x = 28.8978; y = 9.6708; z = 44.5535 }, (* C6 *)
+      (C (
+      { x = 25.8715; y = 11.0249; z = 43.1749 }, (* N4   *)
+      { x = 26.5733; y = 8.2371; z = 46.7484 }, (* O2   *)
+      { x = 26.2707; y = 11.5609; z = 42.4177 }, (* H41  *)
+      { x = 24.8760; y = 10.9939; z = 43.3427 }, (* H42  *)
+      { x = 28.5089; y = 10.9722; z = 42.8990 }, (* H5   *)
+      { x = 29.9782; y = 9.6687; z = 44.4097 }) (* H6   *)
+      )
+    )
+
+let rC09
+  = N(
+      {    a=0.8727; b=0.4760; c= -0.1091; (* dgf_base_tfo *)
+           d= -0.4188; e=0.6148; f= -0.6682;
+           g= -0.2510; h=0.6289; i=0.7359;
+           tx= -8.1687; ty= -52.0761; tz= -25.0726 },
+      {    a=0.9187; b=0.2887; c=0.2694; (* P_O3'_275_tfo *)
+           d=0.0302; e= -0.7316; f=0.6811;
+           g=0.3938; h= -0.6176; i= -0.6808;
+           tx= -48.4330; ty=26.3254; tz=13.6383 },
+      {    a= -0.1504; b=0.7744; c= -0.6145; (* P_O3'_180_tfo *)
+           d=0.7581; e=0.4893; f=0.4311;
+           g=0.6345; h= -0.4010; i= -0.6607;
+           tx= -31.9784; ty= -13.4285; tz=44.9650 },
+      {    a= -0.6236; b= -0.7810; c= -0.0337; (* P_O3'_60_tfo *)
+           d= -0.6890; e=0.5694; f= -0.4484;
+           g=0.3694; h= -0.2564; i= -0.8932;
+           tx=12.1105; ty=30.8774; tz=46.0946 },
+      { x = 33.3400; y = 11.0980; z = 46.1750 }, (* P    *)
+      { x = 34.5130; y = 10.2320; z = 46.4660 }, (* O1P  *)
+      { x = 33.4130; y = 12.3960; z = 46.9340 }, (* O2P  *)
+      { x = 31.9810; y = 10.3390; z = 46.4820 }, (* O5'  *)
+      { x = 30.8152; y = 11.1619; z = 46.2003 }, (* C5'  *)
+      { x = 30.4519; y = 10.9454; z = 45.1957 }, (* H5'  *)
+      { x = 31.0379; y = 12.2016; z = 46.4400 }, (* H5'' *)
+      { x = 29.7081; y = 10.7448; z = 47.1428 }, (* C4'  *)
+      { x = 29.4506; y = 9.6945; z = 47.0059 }, (* H4'  *)
+      { x = 30.1045; y = 10.9634; z = 48.4885 }, (* O4'  *)
+      { x = 29.1794; y = 11.8418; z = 49.1490 }, (* C1'  *)
+      { x = 28.4388; y = 11.2210; z = 49.6533 }, (* H1'  *)
+      { x = 28.5211; y = 12.6008; z = 48.0367 }, (* C2'  *)
+      { x = 29.1947; y = 13.3949; z = 47.7147 }, (* H2'' *)
+      { x = 27.2316; y = 13.0683; z = 48.3134 }, (* O2'  *)
+      { x = 27.0851; y = 13.3391; z = 49.2227 }, (* H2'  *)
+      { x = 28.4131; y = 11.5507; z = 46.9391 }, (* C3'  *)
+      { x = 28.4451; y = 12.0512; z = 45.9713 }, (* H3'  *)
+      { x = 27.2707; y = 10.6955; z = 47.1097 }, (* O3'  *)
+      { x = 29.8751; y = 12.7405; z = 50.0682 }, (* N1   *)
+      { x = 30.7172; y = 13.1841; z = 52.2328 }, (* N3   *)
+      { x = 30.0617; y = 12.3404; z = 51.3847 }, (* C2   *)
+      { x = 31.1834; y = 14.3941; z = 51.8297 }, (* C4   *)
+      { x = 30.9913; y = 14.8074; z = 50.4803 }, (* C5   *)
+      { x = 30.3434; y = 13.9610; z = 49.6548 }, (* C6 *)
+      (C (
+      { x = 31.8090; y = 15.1847; z = 52.6957 }, (* N4   *)
+      { x = 29.6470; y = 11.2494; z = 51.7616 }, (* O2   *)
+      { x = 32.1422; y = 16.0774; z = 52.3606 }, (* H41  *)
+      { x = 31.9392; y = 14.8893; z = 53.6527 }, (* H42  *)
+      { x = 31.3632; y = 15.7771; z = 50.1491 }, (* H5   *)
+      { x = 30.1742; y = 14.2374; z = 48.6141 }) (* H6   *)
+      )
+    )
+
+let rC10
+  = N(
+      {    a=0.1549; b=0.8710; c= -0.4663; (* dgf_base_tfo *)
+           d=0.6768; e= -0.4374; f= -0.5921;
+           g= -0.7197; h= -0.2239; i= -0.6572;
+           tx=25.2447; ty= -14.1920; tz=50.3201 },
+      {    a=0.9187; b=0.2887; c=0.2694; (* P_O3'_275_tfo *)
+           d=0.0302; e= -0.7316; f=0.6811;
+           g=0.3938; h= -0.6176; i= -0.6808;
+           tx= -48.4330; ty=26.3254; tz=13.6383 },
+      {    a= -0.1504; b=0.7744; c= -0.6145; (* P_O3'_180_tfo *)
+           d=0.7581; e=0.4893; f=0.4311;
+           g=0.6345; h= -0.4010; i= -0.6607;
+           tx= -31.9784; ty= -13.4285; tz=44.9650 },
+      {    a= -0.6236; b= -0.7810; c= -0.0337; (* P_O3'_60_tfo *)
+           d= -0.6890; e=0.5694; f= -0.4484;
+           g=0.3694; h= -0.2564; i= -0.8932;
+           tx=12.1105; ty=30.8774; tz=46.0946 },
+      { x = 33.3400; y = 11.0980; z = 46.1750 }, (* P    *)
+      { x = 34.5130; y = 10.2320; z = 46.4660 }, (* O1P  *)
+      { x = 33.4130; y = 12.3960; z = 46.9340 }, (* O2P  *)
+      { x = 31.9810; y = 10.3390; z = 46.4820 }, (* O5'  *)
+      { x = 31.8779; y = 9.9369; z = 47.8760 }, (* C5'  *)
+      { x = 31.3239; y = 10.6931; z = 48.4322 }, (* H5'  *)
+      { x = 32.8647; y = 9.6624; z = 48.2489 }, (* H5'' *)
+      { x = 31.0429; y = 8.6773; z = 47.9401 }, (* C4'  *)
+      { x = 30.0440; y = 8.8473; z = 47.5383 }, (* H4'  *)
+      { x = 31.6749; y = 7.6351; z = 47.2119 }, (* O4'  *)
+      { x = 31.9159; y = 6.5022; z = 48.0616 }, (* C1'  *)
+      { x = 31.0691; y = 5.8243; z = 47.9544 }, (* H1'  *)
+      { x = 31.9300; y = 7.0685; z = 49.4493 }, (* C2'  *)
+      { x = 32.9024; y = 7.5288; z = 49.6245 }, (* H2'' *)
+      { x = 31.5672; y = 6.1750; z = 50.4632 }, (* O2'  *)
+      { x = 31.8416; y = 5.2663; z = 50.3200 }, (* H2'  *)
+      { x = 30.8618; y = 8.1514; z = 49.3749 }, (* C3'  *)
+      { x = 31.1122; y = 8.9396; z = 50.0850 }, (* H3'  *)
+      { x = 29.5351; y = 7.6245; z = 49.5409 }, (* O3'  *)
+      { x = 33.1890; y = 5.8629; z = 47.7343 }, (* N1   *)
+      { x = 34.4004; y = 4.2636; z = 46.4828 }, (* N3   *)
+      { x = 33.2062; y = 4.8497; z = 46.7851 }, (* C2   *)
+      { x = 35.5600; y = 4.6374; z = 47.0822 }, (* C4   *)
+      { x = 35.5444; y = 5.6751; z = 48.0577 }, (* C5   *)
+      { x = 34.3565; y = 6.2450; z = 48.3432 }, (* C6 *)
+      (C (
+      { x = 36.6977; y = 4.0305; z = 46.7598 }, (* N4   *)
+      { x = 32.1661; y = 4.5034; z = 46.2348 }, (* O2   *)
+      { x = 37.5405; y = 4.3347; z = 47.2259 }, (* H41  *)
+      { x = 36.7033; y = 3.2923; z = 46.0706 }, (* H42  *)
+      { x = 36.4713; y = 5.9811; z = 48.5428 }, (* H5   *)
+      { x = 34.2986; y = 7.0426; z = 49.0839 }) (* H6   *)
+      )
+    )
+
+let rCs = [rC01;rC02;rC03;rC04;rC05;rC06;rC07;rC08;rC09;rC10]
+
+let rG
+  = N(
+      {    a= -0.0018; b= -0.8207; c=0.5714; (* dgf_base_tfo *)
+           d=0.2679; e= -0.5509; f= -0.7904;
+           g=0.9634; h=0.1517; i=0.2209;
+           tx=0.0073; ty=8.4030; tz=0.6232 },
+      {    a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+           d= -0.0433; e= -0.4257; f=0.9038;
+           g= -0.5788; h=0.7480; i=0.3246;
+           tx=1.5227; ty=6.9114; tz= -7.0765 },
+      {    a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+           d=0.4552; e=0.6637; f=0.5935;
+           g= -0.8042; h=0.0203; i=0.5941;
+           tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+      {    a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+           d= -0.8247; e=0.5587; f= -0.0878;
+           g=0.0426; h=0.2162; i=0.9754;
+           tx=6.2694; ty= -7.0540; tz=3.3316 },
+      { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P    *)
+      { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P  *)
+      { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P  *)
+      { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5'  *)
+      { x = 5.4550; y = 8.2120; z = -2.8810 }, (* C5'  *)
+      { x = 5.4546; y = 8.8508; z = -1.9978 }, (* H5'  *)
+      { x = 5.7588; y = 8.6625; z = -3.8259 }, (* H5'' *)
+      { x = 6.4970; y = 7.1480; z = -2.5980 }, (* C4'  *)
+      { x = 7.4896; y = 7.5919; z = -2.5214 }, (* H4'  *)
+      { x = 6.1630; y = 6.4860; z = -1.3440 }, (* O4'  *)
+      { x = 6.5400; y = 5.1200; z = -1.4190 }, (* C1'  *)
+      { x = 7.2763; y = 4.9681; z = -0.6297 }, (* H1'  *)
+      { x = 7.1940; y = 4.8830; z = -2.7770 }, (* C2'  *)
+      { x = 6.8667; y = 3.9183; z = -3.1647 }, (* H2'' *)
+      { x = 8.5860; y = 5.0910; z = -2.6140 }, (* O2'  *)
+      { x = 8.9510; y = 4.7626; z = -1.7890 }, (* H2'  *)
+      { x = 6.5720; y = 6.0040; z = -3.6090 }, (* C3'  *)
+      { x = 5.5636; y = 5.7066; z = -3.8966 }, (* H3'  *)
+      { x = 7.3801; y = 6.3562; z = -4.7350 }, (* O3'  *)
+      { x = 4.7150; y = 0.4910; z = -0.1360 }, (* N1   *)
+      { x = 6.3490; y = 2.1730; z = -0.6020 }, (* N3   *)
+      { x = 5.9530; y = 0.9650; z = -0.2670 }, (* C2   *)
+      { x = 5.2900; y = 2.9790; z = -0.8260 }, (* C4   *)
+      { x = 3.9720; y = 2.6390; z = -0.7330 }, (* C5   *)
+      { x = 3.6770; y = 1.3160; z = -0.3660 }, (* C6 *)
+      (G (
+      { x = 6.8426; y = 0.0056; z = -0.0019 }, (* N2   *)
+      { x = 3.1660; y = 3.7290; z = -1.0360 }, (* N7   *)
+      { x = 5.3170; y = 4.2990; z = -1.1930 }, (* N9   *)
+      { x = 4.0100; y = 4.6780; z = -1.2990 }, (* C8   *)
+      { x = 2.4280; y = 0.8450; z = -0.2360 }, (* O6   *)
+      { x = 4.6151; y = -0.4677; z = 0.1305 }, (* H1   *)
+      { x = 6.6463; y = -0.9463; z = 0.2729 }, (* H21  *)
+      { x = 7.8170; y = 0.2642; z = -0.0640 }, (* H22  *)
+      { x = 3.4421; y = 5.5744; z = -1.5482 }) (* H8   *)
+      )
+    )
+
+let rG01
+  = N(
+      {    a= -0.0043; b= -0.8175; c=0.5759; (* dgf_base_tfo *)
+           d=0.2617; e= -0.5567; f= -0.7884;
+           g=0.9651; h=0.1473; i=0.2164;
+           tx=0.0359; ty=8.3929; tz=0.5532 },
+      {    a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+           d= -0.0433; e= -0.4257; f=0.9038;
+           g= -0.5788; h=0.7480; i=0.3246;
+           tx=1.5227; ty=6.9114; tz= -7.0765 },
+      {    a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+           d=0.4552; e=0.6637; f=0.5935;
+           g= -0.8042; h=0.0203; i=0.5941;
+           tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+      {    a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+           d= -0.8247; e=0.5587; f= -0.0878;
+           g=0.0426; h=0.2162; i=0.9754;
+           tx=6.2694; ty= -7.0540; tz=3.3316 },
+      { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P    *)
+      { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P  *)
+      { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P  *)
+      { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5'  *)
+      { x = 5.4352; y = 8.2183; z = -2.7757 }, (* C5'  *)
+      { x = 5.3830; y = 8.7883; z = -1.8481 }, (* H5'  *)
+      { x = 5.7729; y = 8.7436; z = -3.6691 }, (* H5'' *)
+      { x = 6.4830; y = 7.1518; z = -2.5252 }, (* C4'  *)
+      { x = 7.4749; y = 7.5972; z = -2.4482 }, (* H4'  *)
+      { x = 6.1626; y = 6.4620; z = -1.2827 }, (* O4'  *)
+      { x = 6.5431; y = 5.0992; z = -1.3905 }, (* C1'  *)
+      { x = 7.2871; y = 4.9328; z = -0.6114 }, (* H1'  *)
+      { x = 7.1852; y = 4.8935; z = -2.7592 }, (* C2'  *)
+      { x = 6.8573; y = 3.9363; z = -3.1645 }, (* H2'' *)
+      { x = 8.5780; y = 5.1025; z = -2.6046 }, (* O2'  *)
+      { x = 8.9516; y = 4.7577; z = -1.7902 }, (* H2'  *)
+      { x = 6.5522; y = 6.0300; z = -3.5612 }, (* C3'  *)
+      { x = 5.5420; y = 5.7356; z = -3.8459 }, (* H3'  *)
+      { x = 7.3487; y = 6.4089; z = -4.6867 }, (* O3'  *)
+      { x = 4.7442; y = 0.4514; z = -0.1390 }, (* N1   *)
+      { x = 6.3687; y = 2.1459; z = -0.5926 }, (* N3   *)
+      { x = 5.9795; y = 0.9335; z = -0.2657 }, (* C2   *)
+      { x = 5.3052; y = 2.9471; z = -0.8125 }, (* C4   *)
+      { x = 3.9891; y = 2.5987; z = -0.7230 }, (* C5   *)
+      { x = 3.7016; y = 1.2717; z = -0.3647 }, (* C6 *)
+      (G (
+      { x = 6.8745; y = -0.0224; z = -0.0058 }, (* N2   *)
+      { x = 3.1770; y = 3.6859; z = -1.0198 }, (* N7   *)
+      { x = 5.3247; y = 4.2695; z = -1.1710 }, (* N9   *)
+      { x = 4.0156; y = 4.6415; z = -1.2759 }, (* C8   *)
+      { x = 2.4553; y = 0.7925; z = -0.2390 }, (* O6   *)
+      { x = 4.6497; y = -0.5095; z = 0.1212 }, (* H1   *)
+      { x = 6.6836; y = -0.9771; z = 0.2627 }, (* H21  *)
+      { x = 7.8474; y = 0.2424; z = -0.0653 }, (* H22  *)
+      { x = 3.4426; y = 5.5361; z = -1.5199 }) (* H8   *)
+      )
+    )
+
+let rG02
+  = N(
+      {    a=0.5566; b=0.0449; c=0.8296; (* dgf_base_tfo *)
+           d=0.5125; e=0.7673; f= -0.3854;
+           g= -0.6538; h=0.6397; i=0.4041;
+           tx= -9.1161; ty= -3.7679; tz= -2.9968 },
+      {    a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+           d= -0.0433; e= -0.4257; f=0.9038;
+           g= -0.5788; h=0.7480; i=0.3246;
+           tx=1.5227; ty=6.9114; tz= -7.0765 },
+      {    a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+           d=0.4552; e=0.6637; f=0.5935;
+           g= -0.8042; h=0.0203; i=0.5941;
+           tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+      {    a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+           d= -0.8247; e=0.5587; f= -0.0878;
+           g=0.0426; h=0.2162; i=0.9754;
+           tx=6.2694; ty= -7.0540; tz=3.3316 },
+      { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P    *)
+      { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P  *)
+      { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P  *)
+      { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5'  *)
+      { x = 4.5778; y = 6.6594; z = -4.0364 }, (* C5'  *)
+      { x = 4.9220; y = 7.1963; z = -4.9204 }, (* H5'  *)
+      { x = 3.7996; y = 5.9091; z = -4.1764 }, (* H5'' *)
+      { x = 5.7873; y = 5.8869; z = -3.5482 }, (* C4'  *)
+      { x = 6.0405; y = 5.0875; z = -4.2446 }, (* H4'  *)
+      { x = 6.9135; y = 6.8036; z = -3.4310 }, (* O4'  *)
+      { x = 7.7293; y = 6.4084; z = -2.3392 }, (* C1'  *)
+      { x = 8.7078; y = 6.1815; z = -2.7624 }, (* H1'  *)
+      { x = 7.1305; y = 5.1418; z = -1.7347 }, (* C2'  *)
+      { x = 7.2040; y = 5.1982; z = -0.6486 }, (* H2'' *)
+      { x = 7.7417; y = 4.0392; z = -2.3813 }, (* O2'  *)
+      { x = 8.6785; y = 4.1443; z = -2.5630 }, (* H2'  *)
+      { x = 5.6666; y = 5.2728; z = -2.1536 }, (* C3'  *)
+      { x = 5.1747; y = 5.9805; z = -1.4863 }, (* H3'  *)
+      { x = 4.9997; y = 4.0086; z = -2.1973 }, (* O3'  *)
+      { x = 10.3245; y = 8.5459; z = 1.5467 }, (* N1   *)
+      { x = 9.8051; y = 6.9432; z = -0.1497 }, (* N3   *)
+      { x = 10.5175; y = 7.4328; z = 0.8408 }, (* C2   *)
+      { x = 8.7523; y = 7.7422; z = -0.4228 }, (* C4   *)
+      { x = 8.4257; y = 8.9060; z = 0.2099 }, (* C5   *)
+      { x = 9.2665; y = 9.3242; z = 1.2540 }, (* C6 *)
+      (G (
+      { x = 11.6077; y = 6.7966; z = 1.2752 }, (* N2   *)
+      { x = 7.2750; y = 9.4537; z = -0.3428 }, (* N7   *)
+      { x = 7.7962; y = 7.5519; z = -1.3859 }, (* N9   *)
+      { x = 6.9479; y = 8.6157; z = -1.2771 }, (* C8   *)
+      { x = 9.0664; y = 10.4462; z = 1.9610 }, (* O6   *)
+      { x = 10.9838; y = 8.7524; z = 2.2697 }, (* H1   *)
+      { x = 12.2274; y = 7.0896; z = 2.0170 }, (* H21  *)
+      { x = 11.8502; y = 5.9398; z = 0.7984 }, (* H22  *)
+      { x = 6.0430; y = 8.9853; z = -1.7594 }) (* H8   *)
+      )
+    )
+
+let rG03
+  = N(
+      {    a= -0.5021; b=0.0731; c=0.8617; (* dgf_base_tfo *)
+           d= -0.8112; e=0.3054; f= -0.4986;
+           g= -0.2996; h= -0.9494; i= -0.0940;
+           tx=6.4273; ty= -5.1944; tz= -3.7807 },
+      {    a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+           d= -0.0433; e= -0.4257; f=0.9038;
+           g= -0.5788; h=0.7480; i=0.3246;
+           tx=1.5227; ty=6.9114; tz= -7.0765 },
+      {    a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+           d=0.4552; e=0.6637; f=0.5935;
+           g= -0.8042; h=0.0203; i=0.5941;
+           tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+      {    a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+           d= -0.8247; e=0.5587; f= -0.0878;
+           g=0.0426; h=0.2162; i=0.9754;
+           tx=6.2694; ty= -7.0540; tz=3.3316 },
+      { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P    *)
+      { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P  *)
+      { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P  *)
+      { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5'  *)
+      { x = 4.1214; y = 6.7116; z = -1.9049 }, (* C5'  *)
+      { x = 3.3465; y = 5.9610; z = -2.0607 }, (* H5'  *)
+      { x = 4.0789; y = 7.2928; z = -0.9837 }, (* H5'' *)
+      { x = 5.4170; y = 5.9293; z = -1.8186 }, (* C4'  *)
+      { x = 5.4506; y = 5.3400; z = -0.9023 }, (* H4'  *)
+      { x = 5.5067; y = 5.0417; z = -2.9703 }, (* O4'  *)
+      { x = 6.8650; y = 4.9152; z = -3.3612 }, (* C1'  *)
+      { x = 7.1090; y = 3.8577; z = -3.2603 }, (* H1'  *)
+      { x = 7.7152; y = 5.7282; z = -2.3894 }, (* C2'  *)
+      { x = 8.5029; y = 6.2356; z = -2.9463 }, (* H2'' *)
+      { x = 8.1036; y = 4.8568; z = -1.3419 }, (* O2'  *)
+      { x = 8.3270; y = 3.9651; z = -1.6184 }, (* H2'  *)
+      { x = 6.7003; y = 6.7565; z = -1.8911 }, (* C3'  *)
+      { x = 6.5898; y = 7.5329; z = -2.6482 }, (* H3'  *)
+      { x = 7.0505; y = 7.2878; z = -0.6105 }, (* O3'  *)
+      { x = 9.6740; y = 4.7656; z = -7.6614 }, (* N1   *)
+      { x = 9.0739; y = 4.3013; z = -5.3941 }, (* N3   *)
+      { x = 9.8416; y = 4.2192; z = -6.4581 }, (* C2   *)
+      { x = 7.9885; y = 5.0632; z = -5.6446 }, (* C4   *)
+      { x = 7.6822; y = 5.6856; z = -6.8194 }, (* C5   *)
+      { x = 8.5831; y = 5.5215; z = -7.8840 }, (* C6 *)
+      (G (
+      { x = 10.9733; y = 3.5117; z = -6.4286 }, (* N2   *)
+      { x = 6.4857; y = 6.3816; z = -6.7035 }, (* N7   *)
+      { x = 6.9740; y = 5.3703; z = -4.7760 }, (* N9   *)
+      { x = 6.1133; y = 6.1613; z = -5.4808 }, (* C8   *)
+      { x = 8.4084; y = 6.0747; z = -9.0933 }, (* O6   *)
+      { x = 10.3759; y = 4.5855; z = -8.3504 }, (* H1   *)
+      { x = 11.6254; y = 3.3761; z = -7.1879 }, (* H21  *)
+      { x = 11.1917; y = 3.0460; z = -5.5593 }, (* H22  *)
+      { x = 5.1705; y = 6.6830; z = -5.3167 }) (* H8   *)
+      )
+    )
+
+let rG04
+  = N(
+      {    a= -0.5426; b= -0.8175; c=0.1929; (* dgf_base_tfo *)
+           d=0.8304; e= -0.5567; f= -0.0237;
+           g=0.1267; h=0.1473; i=0.9809;
+           tx= -0.5075; ty=8.3929; tz=0.2229 },
+      {    a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+           d= -0.0433; e= -0.4257; f=0.9038;
+           g= -0.5788; h=0.7480; i=0.3246;
+           tx=1.5227; ty=6.9114; tz= -7.0765 },
+      {    a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+           d=0.4552; e=0.6637; f=0.5935;
+           g= -0.8042; h=0.0203; i=0.5941;
+           tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+      {    a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+           d= -0.8247; e=0.5587; f= -0.0878;
+           g=0.0426; h=0.2162; i=0.9754;
+           tx=6.2694; ty= -7.0540; tz=3.3316 },
+      { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P    *)
+      { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P  *)
+      { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P  *)
+      { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5'  *)
+      { x = 5.4352; y = 8.2183; z = -2.7757 }, (* C5'  *)
+      { x = 5.3830; y = 8.7883; z = -1.8481 }, (* H5'  *)
+      { x = 5.7729; y = 8.7436; z = -3.6691 }, (* H5'' *)
+      { x = 6.4830; y = 7.1518; z = -2.5252 }, (* C4'  *)
+      { x = 7.4749; y = 7.5972; z = -2.4482 }, (* H4'  *)
+      { x = 6.1626; y = 6.4620; z = -1.2827 }, (* O4'  *)
+      { x = 6.5431; y = 5.0992; z = -1.3905 }, (* C1'  *)
+      { x = 7.2871; y = 4.9328; z = -0.6114 }, (* H1'  *)
+      { x = 7.1852; y = 4.8935; z = -2.7592 }, (* C2'  *)
+      { x = 6.8573; y = 3.9363; z = -3.1645 }, (* H2'' *)
+      { x = 8.5780; y = 5.1025; z = -2.6046 }, (* O2'  *)
+      { x = 8.9516; y = 4.7577; z = -1.7902 }, (* H2'  *)
+      { x = 6.5522; y = 6.0300; z = -3.5612 }, (* C3'  *)
+      { x = 5.5420; y = 5.7356; z = -3.8459 }, (* H3'  *)
+      { x = 7.3487; y = 6.4089; z = -4.6867 }, (* O3'  *)
+      { x = 3.6343; y = 2.6680; z = 2.0783 }, (* N1   *)
+      { x = 5.4505; y = 3.9805; z = 1.2446 }, (* N3   *)
+      { x = 4.7540; y = 3.3816; z = 2.1851 }, (* C2   *)
+      { x = 4.8805; y = 3.7951; z = 0.0354 }, (* C4   *)
+      { x = 3.7416; y = 3.0925; z = -0.2305 }, (* C5   *)
+      { x = 3.0873; y = 2.4980; z = 0.8606 }, (* C6 *)
+      (G (
+      { x = 5.1433; y = 3.4373; z = 3.4609 }, (* N2   *)
+      { x = 3.4605; y = 3.1184; z = -1.5906 }, (* N7   *)
+      { x = 5.3247; y = 4.2695; z = -1.1710 }, (* N9   *)
+      { x = 4.4244; y = 3.8244; z = -2.0953 }, (* C8   *)
+      { x = 1.9600; y = 1.7805; z = 0.7462 }, (* O6   *)
+      { x = 3.2489; y = 2.2879; z = 2.9191 }, (* H1   *)
+      { x = 4.6785; y = 3.0243; z = 4.2568 }, (* H21  *)
+      { x = 5.9823; y = 3.9654; z = 3.6539 }, (* H22  *)
+      { x = 4.2675; y = 3.8876; z = -3.1721 }) (* H8   *)
+      )
+    )
+
+let rG05
+  = N(
+      {    a= -0.5891; b=0.0449; c=0.8068; (* dgf_base_tfo *)
+           d=0.5375; e=0.7673; f=0.3498;
+           g= -0.6034; h=0.6397; i= -0.4762;
+           tx= -0.3019; ty= -3.7679; tz= -9.5913 },
+      {    a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+           d= -0.0433; e= -0.4257; f=0.9038;
+           g= -0.5788; h=0.7480; i=0.3246;
+           tx=1.5227; ty=6.9114; tz= -7.0765 },
+      {    a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+           d=0.4552; e=0.6637; f=0.5935;
+           g= -0.8042; h=0.0203; i=0.5941;
+           tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+      {    a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+           d= -0.8247; e=0.5587; f= -0.0878;
+           g=0.0426; h=0.2162; i=0.9754;
+           tx=6.2694; ty= -7.0540; tz=3.3316 },
+      { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P    *)
+      { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P  *)
+      { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P  *)
+      { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5'  *)
+      { x = 4.5778; y = 6.6594; z = -4.0364 }, (* C5'  *)
+      { x = 4.9220; y = 7.1963; z = -4.9204 }, (* H5'  *)
+      { x = 3.7996; y = 5.9091; z = -4.1764 }, (* H5'' *)
+      { x = 5.7873; y = 5.8869; z = -3.5482 }, (* C4'  *)
+      { x = 6.0405; y = 5.0875; z = -4.2446 }, (* H4'  *)
+      { x = 6.9135; y = 6.8036; z = -3.4310 }, (* O4'  *)
+      { x = 7.7293; y = 6.4084; z = -2.3392 }, (* C1'  *)
+      { x = 8.7078; y = 6.1815; z = -2.7624 }, (* H1'  *)
+      { x = 7.1305; y = 5.1418; z = -1.7347 }, (* C2'  *)
+      { x = 7.2040; y = 5.1982; z = -0.6486 }, (* H2'' *)
+      { x = 7.7417; y = 4.0392; z = -2.3813 }, (* O2'  *)
+      { x = 8.6785; y = 4.1443; z = -2.5630 }, (* H2'  *)
+      { x = 5.6666; y = 5.2728; z = -2.1536 }, (* C3'  *)
+      { x = 5.1747; y = 5.9805; z = -1.4863 }, (* H3'  *)
+      { x = 4.9997; y = 4.0086; z = -2.1973 }, (* O3'  *)
+      { x = 10.2594; y = 10.6774; z = -1.0056 }, (* N1   *)
+      { x = 9.7528; y = 8.7080; z = -2.2631 }, (* N3   *)
+      { x = 10.4471; y = 9.7876; z = -1.9791 }, (* C2   *)
+      { x = 8.7271; y = 8.5575; z = -1.3991 }, (* C4   *)
+      { x = 8.4100; y = 9.3803; z = -0.3580 }, (* C5   *)
+      { x = 9.2294; y = 10.5030; z = -0.1574 }, (* C6 *)
+      (G (
+      { x = 11.5110; y = 10.1256; z = -2.7114 }, (* N2   *)
+      { x = 7.2891; y = 8.9068; z = 0.3121 }, (* N7   *)
+      { x = 7.7962; y = 7.5519; z = -1.3859 }, (* N9   *)
+      { x = 6.9702; y = 7.8292; z = -0.3353 }, (* C8   *)
+      { x = 9.0349; y = 11.3951; z = 0.8250 }, (* O6   *)
+      { x = 10.9013; y = 11.4422; z = -0.9512 }, (* H1   *)
+      { x = 12.1031; y = 10.9341; z = -2.5861 }, (* H21  *)
+      { x = 11.7369; y = 9.5180; z = -3.4859 }, (* H22  *)
+      { x = 6.0888; y = 7.3990; z = 0.1403 }) (* H8   *)
+      )
+    )
+
+let rG06
+  = N(
+      {    a= -0.9815; b=0.0731; c= -0.1772; (* dgf_base_tfo *)
+           d=0.1912; e=0.3054; f= -0.9328;
+           g= -0.0141; h= -0.9494; i= -0.3137;
+           tx=5.7506; ty= -5.1944; tz=4.7470 },
+      {    a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+           d= -0.0433; e= -0.4257; f=0.9038;
+           g= -0.5788; h=0.7480; i=0.3246;
+           tx=1.5227; ty=6.9114; tz= -7.0765 },
+      {    a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+           d=0.4552; e=0.6637; f=0.5935;
+           g= -0.8042; h=0.0203; i=0.5941;
+           tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+      {    a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+           d= -0.8247; e=0.5587; f= -0.0878;
+           g=0.0426; h=0.2162; i=0.9754;
+           tx=6.2694; ty= -7.0540; tz=3.3316 },
+      { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P    *)
+      { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P  *)
+      { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P  *)
+      { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5'  *)
+      { x = 4.1214; y = 6.7116; z = -1.9049 }, (* C5'  *)
+      { x = 3.3465; y = 5.9610; z = -2.0607 }, (* H5'  *)
+      { x = 4.0789; y = 7.2928; z = -0.9837 }, (* H5'' *)
+      { x = 5.4170; y = 5.9293; z = -1.8186 }, (* C4'  *)
+      { x = 5.4506; y = 5.3400; z = -0.9023 }, (* H4'  *)
+      { x = 5.5067; y = 5.0417; z = -2.9703 }, (* O4'  *)
+      { x = 6.8650; y = 4.9152; z = -3.3612 }, (* C1'  *)
+      { x = 7.1090; y = 3.8577; z = -3.2603 }, (* H1'  *)
+      { x = 7.7152; y = 5.7282; z = -2.3894 }, (* C2'  *)
+      { x = 8.5029; y = 6.2356; z = -2.9463 }, (* H2'' *)
+      { x = 8.1036; y = 4.8568; z = -1.3419 }, (* O2'  *)
+      { x = 8.3270; y = 3.9651; z = -1.6184 }, (* H2'  *)
+      { x = 6.7003; y = 6.7565; z = -1.8911 }, (* C3'  *)
+      { x = 6.5898; y = 7.5329; z = -2.6482 }, (* H3'  *)
+      { x = 7.0505; y = 7.2878; z = -0.6105 }, (* O3'  *)
+      { x = 6.6624; y = 3.5061; z = -8.2986 }, (* N1   *)
+      { x = 6.5810; y = 3.2570; z = -5.9221 }, (* N3   *)
+      { x = 6.5151; y = 2.8263; z = -7.1625 }, (* C2   *)
+      { x = 6.8364; y = 4.5817; z = -5.8882 }, (* C4   *)
+      { x = 7.0116; y = 5.4064; z = -6.9609 }, (* C5   *)
+      { x = 6.9173; y = 4.8260; z = -8.2361 }, (* C6 *)
+      (G (
+      { x = 6.2717; y = 1.5402; z = -7.4250 }, (* N2   *)
+      { x = 7.2573; y = 6.7070; z = -6.5394 }, (* N7   *)
+      { x = 6.9740; y = 5.3703; z = -4.7760 }, (* N9   *)
+      { x = 7.2238; y = 6.6275; z = -5.2453 }, (* C8   *)
+      { x = 7.0668; y = 5.5163; z = -9.3763 }, (* O6   *)
+      { x = 6.5754; y = 2.9964; z = -9.1545 }, (* H1   *)
+      { x = 6.1908; y = 1.1105; z = -8.3354 }, (* H21  *)
+      { x = 6.1346; y = 0.9352; z = -6.6280 }, (* H22  *)
+      { x = 7.4108; y = 7.6227; z = -4.8418 }) (* H8   *)
+      )
+    )
+
+let rG07
+  = N(
+      {    a=0.0894; b= -0.6059; c=0.7905; (* dgf_base_tfo *)
+           d= -0.6810; e=0.5420; f=0.4924;
+           g= -0.7268; h= -0.5824; i= -0.3642;
+           tx=34.1424; ty=45.9610; tz= -11.8600 },
+      {    a= -0.8644; b= -0.4956; c= -0.0851; (* P_O3'_275_tfo *)
+           d= -0.0427; e=0.2409; f= -0.9696;
+           g=0.5010; h= -0.8345; i= -0.2294;
+           tx=4.0167; ty=54.5377; tz=12.4779 },
+      {    a=0.3706; b= -0.6167; c=0.6945; (* P_O3'_180_tfo *)
+           d= -0.2867; e= -0.7872; f= -0.5460;
+           g=0.8834; h=0.0032; i= -0.4686;
+           tx= -52.9020; ty=18.6313; tz= -0.6709 },
+      {    a=0.4155; b=0.9025; c= -0.1137; (* P_O3'_60_tfo *)
+           d=0.9040; e= -0.4236; f= -0.0582;
+           g= -0.1007; h= -0.0786; i= -0.9918;
+           tx= -7.6624; ty= -25.2080; tz=49.5181 },
+      { x = 31.3810; y = 0.1400; z = 47.5810 }, (* P    *)
+      { x = 29.9860; y = 0.6630; z = 47.6290 }, (* O1P  *)
+      { x = 31.7210; y = -0.6460; z = 48.8090 }, (* O2P  *)
+      { x = 32.4940; y = 1.2540; z = 47.2740 }, (* O5'  *)
+      { x = 33.8709; y = 0.7918; z = 47.2113 }, (* C5'  *)
+      { x = 34.1386; y = 0.5870; z = 46.1747 }, (* H5'  *)
+      { x = 34.0186; y = -0.0095; z = 47.9353 }, (* H5'' *)
+      { x = 34.7297; y = 1.9687; z = 47.6685 }, (* C4'  *)
+      { x = 35.7723; y = 1.6845; z = 47.8113 }, (* H4'  *)
+      { x = 34.6455; y = 2.9768; z = 46.6660 }, (* O4'  *)
+      { x = 34.1690; y = 4.1829; z = 47.2627 }, (* C1'  *)
+      { x = 35.0437; y = 4.7633; z = 47.5560 }, (* H1'  *)
+      { x = 33.4145; y = 3.7532; z = 48.4954 }, (* C2'  *)
+      { x = 32.4340; y = 3.3797; z = 48.2001 }, (* H2'' *)
+      { x = 33.3209; y = 4.6953; z = 49.5217 }, (* O2'  *)
+      { x = 33.2374; y = 5.6059; z = 49.2295 }, (* H2'  *)
+      { x = 34.2724; y = 2.5970; z = 48.9773 }, (* C3'  *)
+      { x = 33.6373; y = 1.8935; z = 49.5157 }, (* H3'  *)
+      { x = 35.3453; y = 3.1884; z = 49.7285 }, (* O3'  *)
+      { x = 34.0511; y = 7.8930; z = 43.7791 }, (* N1   *)
+      { x = 34.9937; y = 6.3369; z = 45.3199 }, (* N3   *)
+      { x = 35.0882; y = 7.3126; z = 44.4200 }, (* C2   *)
+      { x = 33.7190; y = 5.9650; z = 45.5374 }, (* C4   *)
+      { x = 32.5845; y = 6.4770; z = 44.9458 }, (* C5   *)
+      { x = 32.7430; y = 7.5179; z = 43.9914 }, (* C6 *)
+      (G (
+      { x = 36.3030; y = 7.7827; z = 44.1036 }, (* N2   *)
+      { x = 31.4499; y = 5.8335; z = 45.4368 }, (* N7   *)
+      { x = 33.2760; y = 4.9817; z = 46.4043 }, (* N9   *)
+      { x = 31.9235; y = 4.9639; z = 46.2934 }, (* C8   *)
+      { x = 31.8602; y = 8.1000; z = 43.3695 }, (* O6   *)
+      { x = 34.2623; y = 8.6223; z = 43.1283 }, (* H1   *)
+      { x = 36.5188; y = 8.5081; z = 43.4347 }, (* H21  *)
+      { x = 37.0888; y = 7.3524; z = 44.5699 }, (* H22  *)
+      { x = 31.0815; y = 4.4201; z = 46.7218 }) (* H8   *)
+      )
+    )
+
+let rG08
+  = N(
+      {    a=0.2224; b=0.6335; c=0.7411; (* dgf_base_tfo *)
+           d= -0.3644; e= -0.6510; f=0.6659;
+           g=0.9043; h= -0.4181; i=0.0861;
+           tx= -47.6824; ty= -0.5823; tz= -31.7554 },
+      {    a= -0.8644; b= -0.4956; c= -0.0851; (* P_O3'_275_tfo *)
+           d= -0.0427; e=0.2409; f= -0.9696;
+           g=0.5010; h= -0.8345; i= -0.2294;
+           tx=4.0167; ty=54.5377; tz=12.4779 },
+      {    a=0.3706; b= -0.6167; c=0.6945; (* P_O3'_180_tfo *)
+           d= -0.2867; e= -0.7872; f= -0.5460;
+           g=0.8834; h=0.0032; i= -0.4686;
+           tx= -52.9020; ty=18.6313; tz= -0.6709 },
+      {    a=0.4155; b=0.9025; c= -0.1137; (* P_O3'_60_tfo *)
+           d=0.9040; e= -0.4236; f= -0.0582;
+           g= -0.1007; h= -0.0786; i= -0.9918;
+           tx= -7.6624; ty= -25.2080; tz=49.5181 },
+      { x = 31.3810; y = 0.1400; z = 47.5810 }, (* P    *)
+      { x = 29.9860; y = 0.6630; z = 47.6290 }, (* O1P  *)
+      { x = 31.7210; y = -0.6460; z = 48.8090 }, (* O2P  *)
+      { x = 32.4940; y = 1.2540; z = 47.2740 }, (* O5'  *)
+      { x = 32.5924; y = 2.3488; z = 48.2255 }, (* C5'  *)
+      { x = 33.3674; y = 2.1246; z = 48.9584 }, (* H5'  *)
+      { x = 31.5994; y = 2.5917; z = 48.6037 }, (* H5'' *)
+      { x = 33.0722; y = 3.5577; z = 47.4258 }, (* C4'  *)
+      { x = 33.0310; y = 4.4778; z = 48.0089 }, (* H4'  *)
+      { x = 34.4173; y = 3.3055; z = 47.0316 }, (* O4'  *)
+      { x = 34.5056; y = 3.3910; z = 45.6094 }, (* C1'  *)
+      { x = 34.7881; y = 4.4152; z = 45.3663 }, (* H1'  *)
+      { x = 33.1122; y = 3.1198; z = 45.1010 }, (* C2'  *)
+      { x = 32.9230; y = 2.0469; z = 45.1369 }, (* H2'' *)
+      { x = 32.7946; y = 3.6590; z = 43.8529 }, (* O2'  *)
+      { x = 33.5170; y = 3.6707; z = 43.2207 }, (* H2'  *)
+      { x = 32.2730; y = 3.8173; z = 46.1566 }, (* C3'  *)
+      { x = 31.3094; y = 3.3123; z = 46.2244 }, (* H3'  *)
+      { x = 32.2391; y = 5.2039; z = 45.7807 }, (* O3'  *)
+      { x = 39.3337; y = 2.7157; z = 44.1441 }, (* N1   *)
+      { x = 37.4430; y = 3.8242; z = 45.0824 }, (* N3   *)
+      { x = 38.7276; y = 3.7646; z = 44.7403 }, (* C2   *)
+      { x = 36.7791; y = 2.6963; z = 44.7704 }, (* C4   *)
+      { x = 37.2860; y = 1.5653; z = 44.1678 }, (* C5   *)
+      { x = 38.6647; y = 1.5552; z = 43.8235 }, (* C6 *)
+      (G (
+      { x = 39.5123; y = 4.8216; z = 44.9936 }, (* N2   *)
+      { x = 36.2829; y = 0.6110; z = 44.0078 }, (* N7   *)
+      { x = 35.4394; y = 2.4314; z = 44.9931 }, (* N9   *)
+      { x = 35.2180; y = 1.1815; z = 44.5128 }, (* C8   *)
+      { x = 39.2907; y = 0.6514; z = 43.2796 }, (* O6   *)
+      { x = 40.3076; y = 2.8048; z = 43.9352 }, (* H1   *)
+      { x = 40.4994; y = 4.9066; z = 44.7977 }, (* H21  *)
+      { x = 39.0738; y = 5.6108; z = 45.4464 }, (* H22  *)
+      { x = 34.3856; y = 0.4842; z = 44.4185 }) (* H8   *)
+      )
+    )
+
+let rG09
+  = N(
+      {    a= -0.9699; b= -0.1688; c= -0.1753; (* dgf_base_tfo *)
+           d= -0.1050; e= -0.3598; f=0.9271;
+           g= -0.2196; h=0.9176; i=0.3312;
+           tx=45.6217; ty= -38.9484; tz= -12.3208 },
+      {    a= -0.8644; b= -0.4956; c= -0.0851; (* P_O3'_275_tfo *)
+           d= -0.0427; e=0.2409; f= -0.9696;
+           g=0.5010; h= -0.8345; i= -0.2294;
+           tx=4.0167; ty=54.5377; tz=12.4779 },
+      {    a=0.3706; b= -0.6167; c=0.6945; (* P_O3'_180_tfo *)
+           d= -0.2867; e= -0.7872; f= -0.5460;
+           g=0.8834; h=0.0032; i= -0.4686;
+           tx= -52.9020; ty=18.6313; tz= -0.6709 },
+      {    a=0.4155; b=0.9025; c= -0.1137; (* P_O3'_60_tfo *)
+           d=0.9040; e= -0.4236; f= -0.0582;
+           g= -0.1007; h= -0.0786; i= -0.9918;
+           tx= -7.6624; ty= -25.2080; tz=49.5181 },
+      { x = 31.3810; y = 0.1400; z = 47.5810 }, (* P    *)
+      { x = 29.9860; y = 0.6630; z = 47.6290 }, (* O1P  *)
+      { x = 31.7210; y = -0.6460; z = 48.8090 }, (* O2P  *)
+      { x = 32.4940; y = 1.2540; z = 47.2740 }, (* O5'  *)
+      { x = 33.8709; y = 0.7918; z = 47.2113 }, (* C5'  *)
+      { x = 34.1386; y = 0.5870; z = 46.1747 }, (* H5'  *)
+      { x = 34.0186; y = -0.0095; z = 47.9353 }, (* H5'' *)
+      { x = 34.7297; y = 1.9687; z = 47.6685 }, (* C4'  *)
+      { x = 34.5880; y = 2.8482; z = 47.0404 }, (* H4'  *)
+      { x = 34.3575; y = 2.2770; z = 49.0081 }, (* O4'  *)
+      { x = 35.5157; y = 2.1993; z = 49.8389 }, (* C1'  *)
+      { x = 35.9424; y = 3.2010; z = 49.8893 }, (* H1'  *)
+      { x = 36.4701; y = 1.2820; z = 49.1169 }, (* C2'  *)
+      { x = 36.1545; y = 0.2498; z = 49.2683 }, (* H2'' *)
+      { x = 37.8262; y = 1.4547; z = 49.4008 }, (* O2'  *)
+      { x = 38.0227; y = 1.6945; z = 50.3094 }, (* H2'  *)
+      { x = 36.2242; y = 1.6797; z = 47.6725 }, (* C3'  *)
+      { x = 36.4297; y = 0.8197; z = 47.0351 }, (* H3'  *)
+      { x = 37.0289; y = 2.8480; z = 47.4426 }, (* O3'  *)
+      { x = 34.3005; y = 3.5042; z = 54.6070 }, (* N1   *)
+      { x = 34.7693; y = 3.7936; z = 52.2874 }, (* N3   *)
+      { x = 34.4484; y = 4.2541; z = 53.4939 }, (* C2   *)
+      { x = 34.9354; y = 2.4584; z = 52.2785 }, (* C4   *)
+      { x = 34.8092; y = 1.5915; z = 53.3422 }, (* C5   *)
+      { x = 34.4646; y = 2.1367; z = 54.6085 }, (* C6 *)
+      (G (
+      { x = 34.2514; y = 5.5708; z = 53.6503 }, (* N2   *)
+      { x = 35.0641; y = 0.2835; z = 52.9337 }, (* N7   *)
+      { x = 35.2669; y = 1.6690; z = 51.1915 }, (* N9   *)
+      { x = 35.3288; y = 0.3954; z = 51.6563 }, (* C8   *)
+      { x = 34.3151; y = 1.5317; z = 55.6650 }, (* O6   *)
+      { x = 34.0623; y = 3.9797; z = 55.4539 }, (* H1   *)
+      { x = 33.9950; y = 6.0502; z = 54.5016 }, (* H21  *)
+      { x = 34.3512; y = 6.1432; z = 52.8242 }, (* H22  *)
+      { x = 35.5414; y = -0.6006; z = 51.2679 }) (* H8   *)
+      )
+    )
+
+let rG10
+  = N(
+      {    a= -0.0980; b= -0.9723; c=0.2122; (* dgf_base_tfo *)
+           d= -0.9731; e=0.1383; f=0.1841;
+           g= -0.2083; h= -0.1885; i= -0.9597;
+           tx=17.8469; ty=38.8265; tz=37.0475 },
+      {    a= -0.8644; b= -0.4956; c= -0.0851; (* P_O3'_275_tfo *)
+           d= -0.0427; e=0.2409; f= -0.9696;
+           g=0.5010; h= -0.8345; i= -0.2294;
+           tx=4.0167; ty=54.5377; tz=12.4779 },
+      {    a=0.3706; b= -0.6167; c=0.6945; (* P_O3'_180_tfo *)
+           d= -0.2867; e= -0.7872; f= -0.5460;
+           g=0.8834; h=0.0032; i= -0.4686;
+           tx= -52.9020; ty=18.6313; tz= -0.6709 },
+      {    a=0.4155; b=0.9025; c= -0.1137; (* P_O3'_60_tfo *)
+           d=0.9040; e= -0.4236; f= -0.0582;
+           g= -0.1007; h= -0.0786; i= -0.9918;
+           tx= -7.6624; ty= -25.2080; tz=49.5181 },
+      { x = 31.3810; y = 0.1400; z = 47.5810 }, (* P    *)
+      { x = 29.9860; y = 0.6630; z = 47.6290 }, (* O1P  *)
+      { x = 31.7210; y = -0.6460; z = 48.8090 }, (* O2P  *)
+      { x = 32.4940; y = 1.2540; z = 47.2740 }, (* O5'  *)
+      { x = 32.5924; y = 2.3488; z = 48.2255 }, (* C5'  *)
+      { x = 33.3674; y = 2.1246; z = 48.9584 }, (* H5'  *)
+      { x = 31.5994; y = 2.5917; z = 48.6037 }, (* H5'' *)
+      { x = 33.0722; y = 3.5577; z = 47.4258 }, (* C4'  *)
+      { x = 34.0333; y = 3.3761; z = 46.9447 }, (* H4'  *)
+      { x = 32.0890; y = 3.8338; z = 46.4332 }, (* O4'  *)
+      { x = 31.6377; y = 5.1787; z = 46.5914 }, (* C1'  *)
+      { x = 32.2499; y = 5.8016; z = 45.9392 }, (* H1'  *)
+      { x = 31.9167; y = 5.5319; z = 48.0305 }, (* C2'  *)
+      { x = 31.1507; y = 5.0820; z = 48.6621 }, (* H2'' *)
+      { x = 32.0865; y = 6.8890; z = 48.3114 }, (* O2'  *)
+      { x = 31.5363; y = 7.4819; z = 47.7942 }, (* H2'  *)
+      { x = 33.2398; y = 4.8224; z = 48.2563 }, (* C3'  *)
+      { x = 33.3166; y = 4.5570; z = 49.3108 }, (* H3'  *)
+      { x = 34.2528; y = 5.7056; z = 47.7476 }, (* O3'  *)
+      { x = 28.2782; y = 6.3049; z = 42.9364 }, (* N1   *)
+      { x = 30.4001; y = 5.8547; z = 43.9258 }, (* N3   *)
+      { x = 29.6195; y = 6.1568; z = 42.8913 }, (* C2   *)
+      { x = 29.7005; y = 5.7006; z = 45.0649 }, (* C4   *)
+      { x = 28.3383; y = 5.8221; z = 45.2343 }, (* C5   *)
+      { x = 27.5519; y = 6.1461; z = 44.0958 }, (* C6 *)
+      (G (
+      { x = 30.1838; y = 6.3385; z = 41.6890 }, (* N2   *)
+      { x = 27.9936; y = 5.5926; z = 46.5651 }, (* N7   *)
+      { x = 30.2046; y = 5.3825; z = 46.3136 }, (* N9   *)
+      { x = 29.1371; y = 5.3398; z = 47.1506 }, (* C8   *)
+      { x = 26.3361; y = 6.3024; z = 44.0495 }, (* O6   *)
+      { x = 27.8122; y = 6.5394; z = 42.0833 }, (* H1   *)
+      { x = 29.7125; y = 6.5595; z = 40.8235 }, (* H21  *)
+      { x = 31.1859; y = 6.2231; z = 41.6389 }, (* H22  *)
+      { x = 28.9406; y = 5.1504; z = 48.2059 }) (* H8   *)
+      )
+    )
+
+let rGs = [rG01;rG02;rG03;rG04;rG05;rG06;rG07;rG08;rG09;rG10]
+
+let rU
+  = N(
+      {    a= -0.0359; b= -0.8071; c=0.5894; (* dgf_base_tfo *)
+           d= -0.2669; e=0.5761; f=0.7726;
+           g= -0.9631; h= -0.1296; i= -0.2361;
+           tx=0.1584; ty=8.3434; tz=0.5434 },
+      {    a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+           d=0.0649; e=0.4366; f= -0.8973;
+           g=0.5521; h= -0.7648; i= -0.3322;
+           tx=1.6833; ty=6.8060; tz= -7.0011 },
+      {    a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+           d= -0.4628; e= -0.6450; f= -0.6082;
+           g=0.8168; h= -0.0436; i= -0.5753;
+           tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+      {    a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+           d=0.8103; e= -0.5790; f=0.0906;
+           g= -0.0255; h= -0.1894; i= -0.9816;
+           tx=6.1203; ty= -7.1051; tz=3.1984 },
+      { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P    *)
+      { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P  *)
+      { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P  *)
+      { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5'  *)
+      { x = 5.2430; y = -8.2420; z = 2.8260 }, (* C5'  *)
+      { x = 5.1974; y = -8.8497; z = 1.9223 }, (* H5'  *)
+      { x = 5.5548; y = -8.7348; z = 3.7469 }, (* H5'' *)
+      { x = 6.3140; y = -7.2060; z = 2.5510 }, (* C4'  *)
+      { x = 7.2954; y = -7.6762; z = 2.4898 }, (* H4'  *)
+      { x = 6.0140; y = -6.5420; z = 1.2890 }, (* O4'  *)
+      { x = 6.4190; y = -5.1840; z = 1.3620 }, (* C1'  *)
+      { x = 7.1608; y = -5.0495; z = 0.5747 }, (* H1'  *)
+      { x = 7.0760; y = -4.9560; z = 2.7270 }, (* C2'  *)
+      { x = 6.7770; y = -3.9803; z = 3.1099 }, (* H2'' *)
+      { x = 8.4500; y = -5.1930; z = 2.5810 }, (* O2'  *)
+      { x = 8.8309; y = -4.8755; z = 1.7590 }, (* H2'  *)
+      { x = 6.4060; y = -6.0590; z = 3.5580 }, (* C3'  *)
+      { x = 5.4021; y = -5.7313; z = 3.8281 }, (* H3'  *)
+      { x = 7.1570; y = -6.4240; z = 4.7070 }, (* O3'  *)
+      { x = 5.2170; y = -4.3260; z = 1.1690 }, (* N1   *)
+      { x = 4.2960; y = -2.2560; z = 0.6290 }, (* N3   *)
+      { x = 5.4330; y = -3.0200; z = 0.7990 }, (* C2   *)
+      { x = 2.9930; y = -2.6780; z = 0.7940 }, (* C4   *)
+      { x = 2.8670; y = -4.0630; z = 1.1830 }, (* C5   *)
+      { x = 3.9570; y = -4.8300; z = 1.3550 }, (* C6 *)
+      (U (
+      { x = 6.5470; y = -2.5560; z = 0.6290 }, (* O2   *)
+      { x = 2.0540; y = -1.9000; z = 0.6130 }, (* O4   *)
+      { x = 4.4300; y = -1.3020; z = 0.3600 }, (* H3   *)
+      { x = 1.9590; y = -4.4570; z = 1.3250 }, (* H5   *)
+      { x = 3.8460; y = -5.7860; z = 1.6240 }) (* H6   *)
+      )
+    )
+
+let rU01
+  = N(
+      {    a= -0.0137; b= -0.8012; c=0.5983; (* dgf_base_tfo *)
+           d= -0.2523; e=0.5817; f=0.7733;
+           g= -0.9675; h= -0.1404; i= -0.2101;
+           tx=0.2031; ty=8.3874; tz=0.4228 },
+      {    a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+           d=0.0649; e=0.4366; f= -0.8973;
+           g=0.5521; h= -0.7648; i= -0.3322;
+           tx=1.6833; ty=6.8060; tz= -7.0011 },
+      {    a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+           d= -0.4628; e= -0.6450; f= -0.6082;
+           g=0.8168; h= -0.0436; i= -0.5753;
+           tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+      {    a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+           d=0.8103; e= -0.5790; f=0.0906;
+           g= -0.0255; h= -0.1894; i= -0.9816;
+           tx=6.1203; ty= -7.1051; tz=3.1984 },
+      { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P    *)
+      { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P  *)
+      { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P  *)
+      { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5'  *)
+      { x = 5.2416; y = -8.2422; z = 2.8181 }, (* C5'  *)
+      { x = 5.2050; y = -8.8128; z = 1.8901 }, (* H5'  *)
+      { x = 5.5368; y = -8.7738; z = 3.7227 }, (* H5'' *)
+      { x = 6.3232; y = -7.2037; z = 2.6002 }, (* C4'  *)
+      { x = 7.3048; y = -7.6757; z = 2.5577 }, (* H4'  *)
+      { x = 6.0635; y = -6.5092; z = 1.3456 }, (* O4'  *)
+      { x = 6.4697; y = -5.1547; z = 1.4629 }, (* C1'  *)
+      { x = 7.2354; y = -5.0043; z = 0.7018 }, (* H1'  *)
+      { x = 7.0856; y = -4.9610; z = 2.8521 }, (* C2'  *)
+      { x = 6.7777; y = -3.9935; z = 3.2487 }, (* H2'' *)
+      { x = 8.4627; y = -5.1992; z = 2.7423 }, (* O2'  *)
+      { x = 8.8693; y = -4.8638; z = 1.9399 }, (* H2'  *)
+      { x = 6.3877; y = -6.0809; z = 3.6362 }, (* C3'  *)
+      { x = 5.3770; y = -5.7562; z = 3.8834 }, (* H3'  *)
+      { x = 7.1024; y = -6.4754; z = 4.7985 }, (* O3'  *)
+      { x = 5.2764; y = -4.2883; z = 1.2538 }, (* N1   *)
+      { x = 4.3777; y = -2.2062; z = 0.7229 }, (* N3   *)
+      { x = 5.5069; y = -2.9779; z = 0.9088 }, (* C2   *)
+      { x = 3.0693; y = -2.6246; z = 0.8500 }, (* C4   *)
+      { x = 2.9279; y = -4.0146; z = 1.2149 }, (* C5   *)
+      { x = 4.0101; y = -4.7892; z = 1.4017 }, (* C6 *)
+      (U (
+      { x = 6.6267; y = -2.5166; z = 0.7728 }, (* O2   *)
+      { x = 2.1383; y = -1.8396; z = 0.6581 }, (* O4   *)
+      { x = 4.5223; y = -1.2489; z = 0.4716 }, (* H3   *)
+      { x = 2.0151; y = -4.4065; z = 1.3290 }, (* H5   *)
+      { x = 3.8886; y = -5.7486; z = 1.6535 }) (* H6   *)
+      )
+    )
+
+let rU02
+  = N(
+      {    a=0.5141; b=0.0246; c=0.8574; (* dgf_base_tfo *)
+           d= -0.5547; e= -0.7529; f=0.3542;
+           g=0.6542; h= -0.6577; i= -0.3734;
+           tx= -9.1111; ty= -3.4598; tz= -3.2939 },
+      {    a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+           d=0.0649; e=0.4366; f= -0.8973;
+           g=0.5521; h= -0.7648; i= -0.3322;
+           tx=1.6833; ty=6.8060; tz= -7.0011 },
+      {    a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+           d= -0.4628; e= -0.6450; f= -0.6082;
+           g=0.8168; h= -0.0436; i= -0.5753;
+           tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+      {    a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+           d=0.8103; e= -0.5790; f=0.0906;
+           g= -0.0255; h= -0.1894; i= -0.9816;
+           tx=6.1203; ty= -7.1051; tz=3.1984 },
+      { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P    *)
+      { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P  *)
+      { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P  *)
+      { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5'  *)
+      { x = 4.3825; y = -6.6585; z = 4.0489 }, (* C5'  *)
+      { x = 4.6841; y = -7.2019; z = 4.9443 }, (* H5'  *)
+      { x = 3.6189; y = -5.8889; z = 4.1625 }, (* H5'' *)
+      { x = 5.6255; y = -5.9175; z = 3.5998 }, (* C4'  *)
+      { x = 5.8732; y = -5.1228; z = 4.3034 }, (* H4'  *)
+      { x = 6.7337; y = -6.8605; z = 3.5222 }, (* O4'  *)
+      { x = 7.5932; y = -6.4923; z = 2.4548 }, (* C1'  *)
+      { x = 8.5661; y = -6.2983; z = 2.9064 }, (* H1'  *)
+      { x = 7.0527; y = -5.2012; z = 1.8322 }, (* C2'  *)
+      { x = 7.1627; y = -5.2525; z = 0.7490 }, (* H2'' *)
+      { x = 7.6666; y = -4.1249; z = 2.4880 }, (* O2'  *)
+      { x = 8.5944; y = -4.2543; z = 2.6981 }, (* H2'  *)
+      { x = 5.5661; y = -5.3029; z = 2.2009 }, (* C3'  *)
+      { x = 5.0841; y = -6.0018; z = 1.5172 }, (* H3'  *)
+      { x = 4.9062; y = -4.0452; z = 2.2042 }, (* O3'  *)
+      { x = 7.6298; y = -7.6136; z = 1.4752 }, (* N1   *)
+      { x = 8.6945; y = -8.7046; z = -0.2857 }, (* N3   *)
+      { x = 8.6943; y = -7.6514; z = 0.6066 }, (* C2   *)
+      { x = 7.7426; y = -9.6987; z = -0.3801 }, (* C4   *)
+      { x = 6.6642; y = -9.5742; z = 0.5722 }, (* C5   *)
+      { x = 6.6391; y = -8.5592; z = 1.4526 }, (* C6 *)
+      (U (
+      { x = 9.5840; y = -6.8186; z = 0.6136 }, (* O2   *)
+      { x = 7.8505; y = -10.5925; z = -1.2223 }, (* O4   *)
+      { x = 9.4601; y = -8.7514; z = -0.9277 }, (* H3   *)
+      { x = 5.9281; y = -10.2509; z = 0.5782 }, (* H5   *)
+      { x = 5.8831; y = -8.4931; z = 2.1028 }) (* H6   *)
+      )
+    )
+
+let rU03
+  = N(
+      {    a= -0.4993; b=0.0476; c=0.8651; (* dgf_base_tfo *)
+           d=0.8078; e= -0.3353; f=0.4847;
+           g=0.3132; h=0.9409; i=0.1290;
+           tx=6.2989; ty= -5.2303; tz= -3.8577 },
+      {    a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+           d=0.0649; e=0.4366; f= -0.8973;
+           g=0.5521; h= -0.7648; i= -0.3322;
+           tx=1.6833; ty=6.8060; tz= -7.0011 },
+      {    a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+           d= -0.4628; e= -0.6450; f= -0.6082;
+           g=0.8168; h= -0.0436; i= -0.5753;
+           tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+      {    a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+           d=0.8103; e= -0.5790; f=0.0906;
+           g= -0.0255; h= -0.1894; i= -0.9816;
+           tx=6.1203; ty= -7.1051; tz=3.1984 },
+      { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P    *)
+      { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P  *)
+      { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P  *)
+      { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5'  *)
+      { x = 3.9938; y = -6.7042; z = 1.9023 }, (* C5'  *)
+      { x = 3.2332; y = -5.9343; z = 2.0319 }, (* H5'  *)
+      { x = 3.9666; y = -7.2863; z = 0.9812 }, (* H5'' *)
+      { x = 5.3098; y = -5.9546; z = 1.8564 }, (* C4'  *)
+      { x = 5.3863; y = -5.3702; z = 0.9395 }, (* H4'  *)
+      { x = 5.3851; y = -5.0642; z = 3.0076 }, (* O4'  *)
+      { x = 6.7315; y = -4.9724; z = 3.4462 }, (* C1'  *)
+      { x = 7.0033; y = -3.9202; z = 3.3619 }, (* H1'  *)
+      { x = 7.5997; y = -5.8018; z = 2.4948 }, (* C2'  *)
+      { x = 8.3627; y = -6.3254; z = 3.0707 }, (* H2'' *)
+      { x = 8.0410; y = -4.9501; z = 1.4724 }, (* O2'  *)
+      { x = 8.2781; y = -4.0644; z = 1.7570 }, (* H2'  *)
+      { x = 6.5701; y = -6.8129; z = 1.9714 }, (* C3'  *)
+      { x = 6.4186; y = -7.5809; z = 2.7299 }, (* H3'  *)
+      { x = 6.9357; y = -7.3841; z = 0.7235 }, (* O3'  *)
+      { x = 6.8024; y = -5.4718; z = 4.8475 }, (* N1   *)
+      { x = 7.9218; y = -5.5700; z = 6.8877 }, (* N3   *)
+      { x = 7.8908; y = -5.0886; z = 5.5944 }, (* C2   *)
+      { x = 6.9789; y = -6.3827; z = 7.4823 }, (* C4   *)
+      { x = 5.8742; y = -6.7319; z = 6.6202 }, (* C5   *)
+      { x = 5.8182; y = -6.2769; z = 5.3570 }, (* C6 *)
+      (U (
+      { x = 8.7747; y = -4.3728; z = 5.1568 }, (* O2   *)
+      { x = 7.1154; y = -6.7509; z = 8.6509 }, (* O4   *)
+      { x = 8.7055; y = -5.3037; z = 7.4491 }, (* H3   *)
+      { x = 5.1416; y = -7.3178; z = 6.9665 }, (* H5   *)
+      { x = 5.0441; y = -6.5310; z = 4.7784 }) (* H6   *)
+      )
+    )
+
+let rU04
+  = N(
+      {    a= -0.5669; b= -0.8012; c=0.1918; (* dgf_base_tfo *)
+           d= -0.8129; e=0.5817; f=0.0273;
+           g= -0.1334; h= -0.1404; i= -0.9811;
+           tx= -0.3279; ty=8.3874; tz=0.3355 },
+      {    a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+           d=0.0649; e=0.4366; f= -0.8973;
+           g=0.5521; h= -0.7648; i= -0.3322;
+           tx=1.6833; ty=6.8060; tz= -7.0011 },
+      {    a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+           d= -0.4628; e= -0.6450; f= -0.6082;
+           g=0.8168; h= -0.0436; i= -0.5753;
+           tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+      {    a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+           d=0.8103; e= -0.5790; f=0.0906;
+           g= -0.0255; h= -0.1894; i= -0.9816;
+           tx=6.1203; ty= -7.1051; tz=3.1984 },
+      { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P    *)
+      { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P  *)
+      { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P  *)
+      { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5'  *)
+      { x = 5.2416; y = -8.2422; z = 2.8181 }, (* C5'  *)
+      { x = 5.2050; y = -8.8128; z = 1.8901 }, (* H5'  *)
+      { x = 5.5368; y = -8.7738; z = 3.7227 }, (* H5'' *)
+      { x = 6.3232; y = -7.2037; z = 2.6002 }, (* C4'  *)
+      { x = 7.3048; y = -7.6757; z = 2.5577 }, (* H4'  *)
+      { x = 6.0635; y = -6.5092; z = 1.3456 }, (* O4'  *)
+      { x = 6.4697; y = -5.1547; z = 1.4629 }, (* C1'  *)
+      { x = 7.2354; y = -5.0043; z = 0.7018 }, (* H1'  *)
+      { x = 7.0856; y = -4.9610; z = 2.8521 }, (* C2'  *)
+      { x = 6.7777; y = -3.9935; z = 3.2487 }, (* H2'' *)
+      { x = 8.4627; y = -5.1992; z = 2.7423 }, (* O2'  *)
+      { x = 8.8693; y = -4.8638; z = 1.9399 }, (* H2'  *)
+      { x = 6.3877; y = -6.0809; z = 3.6362 }, (* C3'  *)
+      { x = 5.3770; y = -5.7562; z = 3.8834 }, (* H3'  *)
+      { x = 7.1024; y = -6.4754; z = 4.7985 }, (* O3'  *)
+      { x = 5.2764; y = -4.2883; z = 1.2538 }, (* N1   *)
+      { x = 3.8961; y = -3.0896; z = -0.1893 }, (* N3   *)
+      { x = 5.0095; y = -3.8907; z = -0.0346 }, (* C2   *)
+      { x = 3.0480; y = -2.6632; z = 0.8116 }, (* C4   *)
+      { x = 3.4093; y = -3.1310; z = 2.1292 }, (* C5   *)
+      { x = 4.4878; y = -3.9124; z = 2.3088 }, (* C6 *)
+      (U (
+      { x = 5.7005; y = -4.2164; z = -0.9842 }, (* O2   *)
+      { x = 2.0800; y = -1.9458; z = 0.5503 }, (* O4   *)
+      { x = 3.6834; y = -2.7882; z = -1.1190 }, (* H3   *)
+      { x = 2.8508; y = -2.8721; z = 2.9172 }, (* H5   *)
+      { x = 4.7188; y = -4.2247; z = 3.2295 }) (* H6   *)
+      )
+    )
+
+let rU05
+  = N(
+      {    a= -0.6298; b=0.0246; c=0.7763; (* dgf_base_tfo *)
+           d= -0.5226; e= -0.7529; f= -0.4001;
+           g=0.5746; h= -0.6577; i=0.4870;
+           tx= -0.0208; ty= -3.4598; tz= -9.6882 },
+      {    a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+           d=0.0649; e=0.4366; f= -0.8973;
+           g=0.5521; h= -0.7648; i= -0.3322;
+           tx=1.6833; ty=6.8060; tz= -7.0011 },
+      {    a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+           d= -0.4628; e= -0.6450; f= -0.6082;
+           g=0.8168; h= -0.0436; i= -0.5753;
+           tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+      {    a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+           d=0.8103; e= -0.5790; f=0.0906;
+           g= -0.0255; h= -0.1894; i= -0.9816;
+           tx=6.1203; ty= -7.1051; tz=3.1984 },
+      { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P    *)
+      { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P  *)
+      { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P  *)
+      { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5'  *)
+      { x = 4.3825; y = -6.6585; z = 4.0489 }, (* C5'  *)
+      { x = 4.6841; y = -7.2019; z = 4.9443 }, (* H5'  *)
+      { x = 3.6189; y = -5.8889; z = 4.1625 }, (* H5'' *)
+      { x = 5.6255; y = -5.9175; z = 3.5998 }, (* C4'  *)
+      { x = 5.8732; y = -5.1228; z = 4.3034 }, (* H4'  *)
+      { x = 6.7337; y = -6.8605; z = 3.5222 }, (* O4'  *)
+      { x = 7.5932; y = -6.4923; z = 2.4548 }, (* C1'  *)
+      { x = 8.5661; y = -6.2983; z = 2.9064 }, (* H1'  *)
+      { x = 7.0527; y = -5.2012; z = 1.8322 }, (* C2'  *)
+      { x = 7.1627; y = -5.2525; z = 0.7490 }, (* H2'' *)
+      { x = 7.6666; y = -4.1249; z = 2.4880 }, (* O2'  *)
+      { x = 8.5944; y = -4.2543; z = 2.6981 }, (* H2'  *)
+      { x = 5.5661; y = -5.3029; z = 2.2009 }, (* C3'  *)
+      { x = 5.0841; y = -6.0018; z = 1.5172 }, (* H3'  *)
+      { x = 4.9062; y = -4.0452; z = 2.2042 }, (* O3'  *)
+      { x = 7.6298; y = -7.6136; z = 1.4752 }, (* N1   *)
+      { x = 8.5977; y = -9.5977; z = 0.7329 }, (* N3   *)
+      { x = 8.5951; y = -8.5745; z = 1.6594 }, (* C2   *)
+      { x = 7.7372; y = -9.7371; z = -0.3364 }, (* C4   *)
+      { x = 6.7596; y = -8.6801; z = -0.4476 }, (* C5   *)
+      { x = 6.7338; y = -7.6721; z = 0.4408 }, (* C6 *)
+      (U (
+      { x = 9.3993; y = -8.5377; z = 2.5743 }, (* O2   *)
+      { x = 7.8374; y = -10.6990; z = -1.1008 }, (* O4   *)
+      { x = 9.2924; y = -10.3081; z = 0.8477 }, (* H3   *)
+      { x = 6.0932; y = -8.6982; z = -1.1929 }, (* H5   *)
+      { x = 6.0481; y = -6.9515; z = 0.3446 }) (* H6   *)
+      )
+    )
+
+let rU06
+  = N(
+      {    a= -0.9837; b=0.0476; c= -0.1733; (* dgf_base_tfo *)
+           d= -0.1792; e= -0.3353; f=0.9249;
+           g= -0.0141; h=0.9409; i=0.3384;
+           tx=5.7793; ty= -5.2303; tz=4.5997 },
+      {    a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+           d=0.0649; e=0.4366; f= -0.8973;
+           g=0.5521; h= -0.7648; i= -0.3322;
+           tx=1.6833; ty=6.8060; tz= -7.0011 },
+      {    a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+           d= -0.4628; e= -0.6450; f= -0.6082;
+           g=0.8168; h= -0.0436; i= -0.5753;
+           tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+      {    a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+           d=0.8103; e= -0.5790; f=0.0906;
+           g= -0.0255; h= -0.1894; i= -0.9816;
+           tx=6.1203; ty= -7.1051; tz=3.1984 },
+      { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P    *)
+      { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P  *)
+      { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P  *)
+      { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5'  *)
+      { x = 3.9938; y = -6.7042; z = 1.9023 }, (* C5'  *)
+      { x = 3.2332; y = -5.9343; z = 2.0319 }, (* H5'  *)
+      { x = 3.9666; y = -7.2863; z = 0.9812 }, (* H5'' *)
+      { x = 5.3098; y = -5.9546; z = 1.8564 }, (* C4'  *)
+      { x = 5.3863; y = -5.3702; z = 0.9395 }, (* H4'  *)
+      { x = 5.3851; y = -5.0642; z = 3.0076 }, (* O4'  *)
+      { x = 6.7315; y = -4.9724; z = 3.4462 }, (* C1'  *)
+      { x = 7.0033; y = -3.9202; z = 3.3619 }, (* H1'  *)
+      { x = 7.5997; y = -5.8018; z = 2.4948 }, (* C2'  *)
+      { x = 8.3627; y = -6.3254; z = 3.0707 }, (* H2'' *)
+      { x = 8.0410; y = -4.9501; z = 1.4724 }, (* O2'  *)
+      { x = 8.2781; y = -4.0644; z = 1.7570 }, (* H2'  *)
+      { x = 6.5701; y = -6.8129; z = 1.9714 }, (* C3'  *)
+      { x = 6.4186; y = -7.5809; z = 2.7299 }, (* H3'  *)
+      { x = 6.9357; y = -7.3841; z = 0.7235 }, (* O3'  *)
+      { x = 6.8024; y = -5.4718; z = 4.8475 }, (* N1   *)
+      { x = 6.6920; y = -5.0495; z = 7.1354 }, (* N3   *)
+      { x = 6.6201; y = -4.5500; z = 5.8506 }, (* C2   *)
+      { x = 6.9254; y = -6.3614; z = 7.4926 }, (* C4   *)
+      { x = 7.1046; y = -7.2543; z = 6.3718 }, (* C5   *)
+      { x = 7.0391; y = -6.7951; z = 5.1106 }, (* C6 *)
+      (U (
+      { x = 6.4083; y = -3.3696; z = 5.6340 }, (* O2   *)
+      { x = 6.9679; y = -6.6901; z = 8.6800 }, (* O4   *)
+      { x = 6.5626; y = -4.3957; z = 7.8812 }, (* H3   *)
+      { x = 7.2781; y = -8.2254; z = 6.5350 }, (* H5   *)
+      { x = 7.1657; y = -7.4312; z = 4.3503 }) (* H6   *)
+      )
+    )
+
+let rU07
+  = N(
+      {    a= -0.9434; b=0.3172; c=0.0971; (* dgf_base_tfo *)
+           d=0.2294; e=0.4125; f=0.8816;
+           g=0.2396; h=0.8539; i= -0.4619;
+           tx=8.3625; ty= -52.7147; tz=1.3745 },
+      {    a=0.2765; b= -0.1121; c= -0.9545; (* P_O3'_275_tfo *)
+           d= -0.8297; e=0.4733; f= -0.2959;
+           g=0.4850; h=0.8737; i=0.0379;
+           tx= -14.7774; ty= -45.2464; tz=21.9088 },
+      {    a=0.1063; b= -0.6334; c= -0.7665; (* P_O3'_180_tfo *)
+           d= -0.5932; e= -0.6591; f=0.4624;
+           g= -0.7980; h=0.4055; i= -0.4458;
+           tx=43.7634; ty=4.3296; tz=28.4890 },
+      {    a=0.7136; b= -0.5032; c= -0.4873; (* P_O3'_60_tfo *)
+           d=0.6803; e=0.3317; f=0.6536;
+           g= -0.1673; h= -0.7979; i=0.5791;
+           tx= -17.1858; ty=41.4390; tz= -27.0751 },
+      { x = 21.3880; y = 15.0780; z = 45.5770 }, (* P    *)
+      { x = 21.9980; y = 14.5500; z = 46.8210 }, (* O1P  *)
+      { x = 21.1450; y = 14.0270; z = 44.5420 }, (* O2P  *)
+      { x = 22.1250; y = 16.3600; z = 44.9460 }, (* O5'  *)
+      { x = 21.5037; y = 16.8594; z = 43.7323 }, (* C5'  *)
+      { x = 20.8147; y = 17.6663; z = 43.9823 }, (* H5'  *)
+      { x = 21.1086; y = 16.0230; z = 43.1557 }, (* H5'' *)
+      { x = 22.5654; y = 17.4874; z = 42.8616 }, (* C4'  *)
+      { x = 22.1584; y = 17.7243; z = 41.8785 }, (* H4'  *)
+      { x = 23.0557; y = 18.6826; z = 43.4751 }, (* O4'  *)
+      { x = 24.4788; y = 18.6151; z = 43.6455 }, (* C1'  *)
+      { x = 24.9355; y = 19.0840; z = 42.7739 }, (* H1'  *)
+      { x = 24.7958; y = 17.1427; z = 43.6474 }, (* C2'  *)
+      { x = 24.5652; y = 16.7400; z = 44.6336 }, (* H2'' *)
+      { x = 26.1041; y = 16.8773; z = 43.2455 }, (* O2'  *)
+      { x = 26.7516; y = 17.5328; z = 43.5149 }, (* H2'  *)
+      { x = 23.8109; y = 16.5979; z = 42.6377 }, (* C3'  *)
+      { x = 23.5756; y = 15.5686; z = 42.9084 }, (* H3'  *)
+      { x = 24.2890; y = 16.7447; z = 41.2729 }, (* O3'  *)
+      { x = 24.9420; y = 19.2174; z = 44.8923 }, (* N1   *)
+      { x = 25.2655; y = 20.5636; z = 44.8883 }, (* N3   *)
+      { x = 25.1663; y = 21.2219; z = 43.8561 }, (* C2   *)
+      { x = 25.6911; y = 21.1219; z = 46.0494 }, (* C4   *)
+      { x = 25.8051; y = 20.4068; z = 47.2048 }, (* C5   *)
+      { x = 26.2093; y = 20.9962; z = 48.2534 }, (* C6 *)
+      (U (
+      { x = 25.4692; y = 19.0221; z = 47.2053 }, (* O2   *)
+      { x = 25.0502; y = 18.4827; z = 46.0370 }, (* O4   *)
+      { x = 25.9599; y = 22.1772; z = 46.0966 }, (* H3   *)
+      { x = 25.5545; y = 18.4409; z = 48.1234 }, (* H5   *)
+      { x = 24.7854; y = 17.4265; z = 45.9883 }) (* H6   *)
+      )
+    )
+
+let rU08
+  = N(
+      {    a= -0.0080; b= -0.7928; c=0.6094; (* dgf_base_tfo *)
+           d= -0.7512; e=0.4071; f=0.5197;
+           g= -0.6601; h= -0.4536; i= -0.5988;
+           tx=44.1482; ty=30.7036; tz=2.1088 },
+      {    a=0.2765; b= -0.1121; c= -0.9545; (* P_O3'_275_tfo *)
+           d= -0.8297; e=0.4733; f= -0.2959;
+           g=0.4850; h=0.8737; i=0.0379;
+           tx= -14.7774; ty= -45.2464; tz=21.9088 },
+      {    a=0.1063; b= -0.6334; c= -0.7665; (* P_O3'_180_tfo *)
+           d= -0.5932; e= -0.6591; f=0.4624;
+           g= -0.7980; h=0.4055; i= -0.4458;
+           tx=43.7634; ty=4.3296; tz=28.4890 },
+      {    a=0.7136; b= -0.5032; c= -0.4873; (* P_O3'_60_tfo *)
+           d=0.6803; e=0.3317; f=0.6536;
+           g= -0.1673; h= -0.7979; i=0.5791;
+           tx= -17.1858; ty=41.4390; tz= -27.0751 },
+      { x = 21.3880; y = 15.0780; z = 45.5770 }, (* P    *)
+      { x = 21.9980; y = 14.5500; z = 46.8210 }, (* O1P  *)
+      { x = 21.1450; y = 14.0270; z = 44.5420 }, (* O2P  *)
+      { x = 22.1250; y = 16.3600; z = 44.9460 }, (* O5'  *)
+      { x = 23.5096; y = 16.1227; z = 44.5783 }, (* C5'  *)
+      { x = 23.5649; y = 15.8588; z = 43.5222 }, (* H5'  *)
+      { x = 23.9621; y = 15.4341; z = 45.2919 }, (* H5'' *)
+      { x = 24.2805; y = 17.4138; z = 44.7151 }, (* C4'  *)
+      { x = 25.3492; y = 17.2309; z = 44.6030 }, (* H4'  *)
+      { x = 23.8497; y = 18.3471; z = 43.7208 }, (* O4'  *)
+      { x = 23.4090; y = 19.5681; z = 44.3321 }, (* C1'  *)
+      { x = 24.2595; y = 20.2496; z = 44.3524 }, (* H1'  *)
+      { x = 23.0418; y = 19.1813; z = 45.7407 }, (* C2'  *)
+      { x = 22.0532; y = 18.7224; z = 45.7273 }, (* H2'' *)
+      { x = 23.1307; y = 20.2521; z = 46.6291 }, (* O2'  *)
+      { x = 22.8888; y = 21.1051; z = 46.2611 }, (* H2'  *)
+      { x = 24.0799; y = 18.1326; z = 46.0700 }, (* C3'  *)
+      { x = 23.6490; y = 17.4370; z = 46.7900 }, (* H3'  *)
+      { x = 25.3329; y = 18.7227; z = 46.5109 }, (* O3'  *)
+      { x = 22.2515; y = 20.1624; z = 43.6698 }, (* N1   *)
+      { x = 22.4760; y = 21.0609; z = 42.6406 }, (* N3   *)
+      { x = 23.6229; y = 21.3462; z = 42.3061 }, (* C2   *)
+      { x = 21.3986; y = 21.6081; z = 42.0236 }, (* C4   *)
+      { x = 20.1189; y = 21.3012; z = 42.3804 }, (* C5   *)
+      { x = 19.1599; y = 21.8516; z = 41.7578 }, (* C6 *)
+      (U (
+      { x = 19.8919; y = 20.3745; z = 43.4387 }, (* O2   *)
+      { x = 20.9790; y = 19.8423; z = 44.0440 }, (* O4   *)
+      { x = 21.5235; y = 22.3222; z = 41.2097 }, (* H3   *)
+      { x = 18.8732; y = 20.1200; z = 43.7312 }, (* H5   *)
+      { x = 20.8545; y = 19.1313; z = 44.8608 }) (* H6   *)
+      )
+    )
+
+let rU09
+  = N(
+      {    a= -0.0317; b=0.1374; c=0.9900; (* dgf_base_tfo *)
+           d= -0.3422; e= -0.9321; f=0.1184;
+           g=0.9391; h= -0.3351; i=0.0765;
+           tx= -32.1929; ty=25.8198; tz= -28.5088 },
+      {    a=0.2765; b= -0.1121; c= -0.9545; (* P_O3'_275_tfo *)
+           d= -0.8297; e=0.4733; f= -0.2959;
+           g=0.4850; h=0.8737; i=0.0379;
+           tx= -14.7774; ty= -45.2464; tz=21.9088 },
+      {    a=0.1063; b= -0.6334; c= -0.7665; (* P_O3'_180_tfo *)
+           d= -0.5932; e= -0.6591; f=0.4624;
+           g= -0.7980; h=0.4055; i= -0.4458;
+           tx=43.7634; ty=4.3296; tz=28.4890 },
+      {    a=0.7136; b= -0.5032; c= -0.4873; (* P_O3'_60_tfo *)
+           d=0.6803; e=0.3317; f=0.6536;
+           g= -0.1673; h= -0.7979; i=0.5791;
+           tx= -17.1858; ty=41.4390; tz= -27.0751 },
+      { x = 21.3880; y = 15.0780; z = 45.5770 }, (* P    *)
+      { x = 21.9980; y = 14.5500; z = 46.8210 }, (* O1P  *)
+      { x = 21.1450; y = 14.0270; z = 44.5420 }, (* O2P  *)
+      { x = 22.1250; y = 16.3600; z = 44.9460 }, (* O5'  *)
+      { x = 21.5037; y = 16.8594; z = 43.7323 }, (* C5'  *)
+      { x = 20.8147; y = 17.6663; z = 43.9823 }, (* H5'  *)
+      { x = 21.1086; y = 16.0230; z = 43.1557 }, (* H5'' *)
+      { x = 22.5654; y = 17.4874; z = 42.8616 }, (* C4'  *)
+      { x = 23.0565; y = 18.3036; z = 43.3915 }, (* H4'  *)
+      { x = 23.5375; y = 16.5054; z = 42.4925 }, (* O4'  *)
+      { x = 23.6574; y = 16.4257; z = 41.0649 }, (* C1'  *)
+      { x = 24.4701; y = 17.0882; z = 40.7671 }, (* H1'  *)
+      { x = 22.3525; y = 16.9643; z = 40.5396 }, (* C2'  *)
+      { x = 21.5993; y = 16.1799; z = 40.6133 }, (* H2'' *)
+      { x = 22.4693; y = 17.4849; z = 39.2515 }, (* O2'  *)
+      { x = 23.0899; y = 17.0235; z = 38.6827 }, (* H2'  *)
+      { x = 22.0341; y = 18.0633; z = 41.5279 }, (* C3'  *)
+      { x = 20.9509; y = 18.1709; z = 41.5846 }, (* H3'  *)
+      { x = 22.7249; y = 19.3020; z = 41.2100 }, (* O3'  *)
+      { x = 23.8580; y = 15.0648; z = 40.5757 }, (* N1   *)
+      { x = 25.1556; y = 14.5982; z = 40.4523 }, (* N3   *)
+      { x = 26.1047; y = 15.3210; z = 40.7448 }, (* C2   *)
+      { x = 25.3391; y = 13.3315; z = 40.0020 }, (* C4   *)
+      { x = 24.2974; y = 12.5148; z = 39.6749 }, (* C5   *)
+      { x = 24.5450; y = 11.3410; z = 39.2610 }, (* C6 *)
+      (U (
+      { x = 22.9633; y = 12.9979; z = 39.8053 }, (* O2   *)
+      { x = 22.8009; y = 14.2648; z = 40.2524 }, (* O4   *)
+      { x = 26.3414; y = 12.9194; z = 39.8855 }, (* H3   *)
+      { x = 22.1227; y = 12.3533; z = 39.5486 }, (* H5   *)
+      { x = 21.7989; y = 14.6788; z = 40.3650 }) (* H6   *)
+      )
+    )
+
+let rU10
+  = N(
+      {    a= -0.9674; b=0.1021; c= -0.2318; (* dgf_base_tfo *)
+           d= -0.2514; e= -0.2766; f=0.9275;
+           g=0.0306; h=0.9555; i=0.2933;
+           tx=27.8571; ty= -42.1305; tz= -24.4563 },
+      {    a=0.2765; b= -0.1121; c= -0.9545; (* P_O3'_275_tfo *)
+           d= -0.8297; e=0.4733; f= -0.2959;
+           g=0.4850; h=0.8737; i=0.0379;
+           tx= -14.7774; ty= -45.2464; tz=21.9088 },
+      {    a=0.1063; b= -0.6334; c= -0.7665; (* P_O3'_180_tfo *)
+           d= -0.5932; e= -0.6591; f=0.4624;
+           g= -0.7980; h=0.4055; i= -0.4458;
+           tx=43.7634; ty=4.3296; tz=28.4890 },
+      {    a=0.7136; b= -0.5032; c= -0.4873; (* P_O3'_60_tfo *)
+           d=0.6803; e=0.3317; f=0.6536;
+           g= -0.1673; h= -0.7979; i=0.5791;
+           tx= -17.1858; ty=41.4390; tz= -27.0751 },
+      { x = 21.3880; y = 15.0780; z = 45.5770 }, (* P    *)
+      { x = 21.9980; y = 14.5500; z = 46.8210 }, (* O1P  *)
+      { x = 21.1450; y = 14.0270; z = 44.5420 }, (* O2P  *)
+      { x = 22.1250; y = 16.3600; z = 44.9460 }, (* O5'  *)
+      { x = 23.5096; y = 16.1227; z = 44.5783 }, (* C5'  *)
+      { x = 23.5649; y = 15.8588; z = 43.5222 }, (* H5'  *)
+      { x = 23.9621; y = 15.4341; z = 45.2919 }, (* H5'' *)
+      { x = 24.2805; y = 17.4138; z = 44.7151 }, (* C4'  *)
+      { x = 23.8509; y = 18.1819; z = 44.0720 }, (* H4'  *)
+      { x = 24.2506; y = 17.8583; z = 46.0741 }, (* O4'  *)
+      { x = 25.5830; y = 18.0320; z = 46.5775 }, (* C1'  *)
+      { x = 25.8569; y = 19.0761; z = 46.4256 }, (* H1'  *)
+      { x = 26.4410; y = 17.1555; z = 45.7033 }, (* C2'  *)
+      { x = 26.3459; y = 16.1253; z = 46.0462 }, (* H2'' *)
+      { x = 27.7649; y = 17.5888; z = 45.6478 }, (* O2'  *)
+      { x = 28.1004; y = 17.9719; z = 46.4616 }, (* H2'  *)
+      { x = 25.7796; y = 17.2997; z = 44.3513 }, (* C3'  *)
+      { x = 25.9478; y = 16.3824; z = 43.7871 }, (* H3'  *)
+      { x = 26.2154; y = 18.4984; z = 43.6541 }, (* O3'  *)
+      { x = 25.7321; y = 17.6281; z = 47.9726 }, (* N1   *)
+      { x = 25.5136; y = 18.5779; z = 48.9560 }, (* N3   *)
+      { x = 25.2079; y = 19.7276; z = 48.6503 }, (* C2   *)
+      { x = 25.6482; y = 18.1987; z = 50.2518 }, (* C4   *)
+      { x = 25.9847; y = 16.9266; z = 50.6092 }, (* C5   *)
+      { x = 26.0918; y = 16.6439; z = 51.8416 }, (* C6 *)
+      (U (
+      { x = 26.2067; y = 15.9515; z = 49.5943 }, (* O2   *)
+      { x = 26.0713; y = 16.3497; z = 48.3080 }, (* O4   *)
+      { x = 25.4890; y = 18.9105; z = 51.0618 }, (* H3   *)
+      { x = 26.4742; y = 14.9310; z = 49.8682 }, (* H5   *)
+      { x = 26.2346; y = 15.6394; z = 47.4975 }) (* H6   *)
+      )
+    )
+
+let rUs = [rU01;rU02;rU03;rU04;rU05;rU06;rU07;rU08;rU09;rU10]
+
+let rG'
+  = N(
+      {    a= -0.2067; b= -0.0264; c=0.9780; (* dgf_base_tfo *)
+           d=0.9770; e= -0.0586; f=0.2049;
+           g=0.0519; h=0.9979; i=0.0379;
+           tx=1.0331; ty= -46.8078; tz= -36.4742 },
+      {    a= -0.8644; b= -0.4956; c= -0.0851; (* P_O3'_275_tfo *)
+           d= -0.0427; e=0.2409; f= -0.9696;
+           g=0.5010; h= -0.8345; i= -0.2294;
+           tx=4.0167; ty=54.5377; tz=12.4779 },
+      {    a=0.3706; b= -0.6167; c=0.6945; (* P_O3'_180_tfo *)
+           d= -0.2867; e= -0.7872; f= -0.5460;
+           g=0.8834; h=0.0032; i= -0.4686;
+           tx= -52.9020; ty=18.6313; tz= -0.6709 },
+      {    a=0.4155; b=0.9025; c= -0.1137; (* P_O3'_60_tfo *)
+           d=0.9040; e= -0.4236; f= -0.0582;
+           g= -0.1007; h= -0.0786; i= -0.9918;
+           tx= -7.6624; ty= -25.2080; tz=49.5181 },
+      { x = 31.3810; y = 0.1400; z = 47.5810 }, (* P    *)
+      { x = 29.9860; y = 0.6630; z = 47.6290 }, (* O1P  *)
+      { x = 31.7210; y = -0.6460; z = 48.8090 }, (* O2P  *)
+      { x = 32.4940; y = 1.2540; z = 47.2740 }, (* O5'  *)
+      { x = 32.1610; y = 2.2370; z = 46.2560 }, (* C5'  *)
+      { x = 31.2986; y = 2.8190; z = 46.5812 }, (* H5'  *)
+      { x = 32.0980; y = 1.7468; z = 45.2845 }, (* H5'' *)
+      { x = 33.3476; y = 3.1959; z = 46.1947 }, (* C4'  *)
+      { x = 33.2668; y = 3.8958; z = 45.3630 }, (* H4'  *)
+      { x = 33.3799; y = 3.9183; z = 47.4216 }, (* O4'  *)
+      { x = 34.6515; y = 3.7222; z = 48.0398 }, (* C1'  *)
+      { x = 35.2947; y = 4.5412; z = 47.7180 }, (* H1'  *)
+      { x = 35.1756; y = 2.4228; z = 47.4827 }, (* C2'  *)
+      { x = 34.6778; y = 1.5937; z = 47.9856 }, (* H2'' *)
+      { x = 36.5631; y = 2.2672; z = 47.4798 }, (* O2'  *)
+      { x = 37.0163; y = 2.6579; z = 48.2305 }, (* H2'  *)
+      { x = 34.6953; y = 2.5043; z = 46.0448 }, (* C3'  *)
+      { x = 34.5444; y = 1.4917; z = 45.6706 }, (* H3'  *)
+      { x = 35.6679; y = 3.3009; z = 45.3487 }, (* O3'  *)
+      { x = 37.4804; y = 4.0914; z = 52.2559 }, (* N1   *)
+      { x = 36.9670; y = 4.1312; z = 49.9281 }, (* N3   *)
+      { x = 37.8045; y = 4.2519; z = 50.9550 }, (* C2   *)
+      { x = 35.7171; y = 3.8264; z = 50.3222 }, (* C4   *)
+      { x = 35.2668; y = 3.6420; z = 51.6115 }, (* C5   *)
+      { x = 36.2037; y = 3.7829; z = 52.6706 }, (* C6 *)
+      (G (
+      { x = 39.0869; y = 4.5552; z = 50.7092 }, (* N2   *)
+      { x = 33.9075; y = 3.3338; z = 51.6102 }, (* N7   *)
+      { x = 34.6126; y = 3.6358; z = 49.5108 }, (* N9   *)
+      { x = 33.5805; y = 3.3442; z = 50.3425 }, (* C8   *)
+      { x = 35.9958; y = 3.6512; z = 53.8724 }, (* O6   *)
+      { x = 38.2106; y = 4.2053; z = 52.9295 }, (* H1   *)
+      { x = 39.8218; y = 4.6863; z = 51.3896 }, (* H21  *)
+      { x = 39.3420; y = 4.6857; z = 49.7407 }, (* H22  *)
+      { x = 32.5194; y = 3.1070; z = 50.2664 }) (* H8   *)
+      )
+    )
+
+let rU'
+  = N(
+      {    a= -0.0109; b=0.5907; c=0.8068; (* dgf_base_tfo *)
+           d=0.2217; e= -0.7853; f=0.5780;
+           g=0.9751; h=0.1852; i= -0.1224;
+           tx= -1.4225; ty= -11.0956; tz= -2.5217 },
+      {    a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+           d=0.0649; e=0.4366; f= -0.8973;
+           g=0.5521; h= -0.7648; i= -0.3322;
+           tx=1.6833; ty=6.8060; tz= -7.0011 },
+      {    a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+           d= -0.4628; e= -0.6450; f= -0.6082;
+           g=0.8168; h= -0.0436; i= -0.5753;
+           tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+      {    a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+           d=0.8103; e= -0.5790; f=0.0906;
+           g= -0.0255; h= -0.1894; i= -0.9816;
+           tx=6.1203; ty= -7.1051; tz=3.1984 },
+      { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P    *)
+      { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P  *)
+      { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P  *)
+      { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5'  *)
+      { x = 5.2430; y = -8.2420; z = 2.8260 }, (* C5'  *)
+      { x = 5.1974; y = -8.8497; z = 1.9223 }, (* H5'  *)
+      { x = 5.5548; y = -8.7348; z = 3.7469 }, (* H5'' *)
+      { x = 6.3140; y = -7.2060; z = 2.5510 }, (* C4'  *)
+      { x = 5.8744; y = -6.2116; z = 2.4731 }, (* H4'  *)
+      { x = 7.2798; y = -7.2260; z = 3.6420 }, (* O4'  *)
+      { x = 8.5733; y = -6.9410; z = 3.1329 }, (* C1'  *)
+      { x = 8.9047; y = -6.0374; z = 3.6446 }, (* H1'  *)
+      { x = 8.4429; y = -6.6596; z = 1.6327 }, (* C2'  *)
+      { x = 9.2880; y = -7.1071; z = 1.1096 }, (* H2'' *)
+      { x = 8.2502; y = -5.2799; z = 1.4754 }, (* O2'  *)
+      { x = 8.7676; y = -4.7284; z = 2.0667 }, (* H2'  *)
+      { x = 7.1642; y = -7.4416; z = 1.3021 }, (* C3'  *)
+      { x = 7.4125; y = -8.5002; z = 1.2260 }, (* H3'  *)
+      { x = 6.5160; y = -6.9772; z = 0.1267 }, (* O3'  *)
+      { x = 9.4531; y = -8.1107; z = 3.4087 }, (* N1   *)
+      { x = 11.5931; y = -9.0015; z = 3.6357 }, (* N3   *)
+      { x = 10.8101; y = -7.8950; z = 3.3748 }, (* C2   *)
+      { x = 11.1439; y = -10.2744; z = 3.9206 }, (* C4   *)
+      { x = 9.7056; y = -10.4026; z = 3.9332 }, (* C5   *)
+      { x = 8.9192; y = -9.3419; z = 3.6833 }, (* C6 *)
+      (U (
+      { x = 11.3013; y = -6.8063; z = 3.1326 }, (* O2   *)
+      { x = 11.9431; y = -11.1876; z = 4.1375 }, (* O4   *)
+      { x = 12.5840; y = -8.8673; z = 3.6158 }, (* H3   *)
+      { x = 9.2891; y = -11.2898; z = 4.1313 }, (* H5   *)
+      { x = 7.9263; y = -9.4537; z = 3.6977 }) (* H6   *)
+      )
+    )
+
+(* -- PARTIAL INSTANTIATIONS ------------------------------------------------*)
+
+type variable =
+  { id : int;
+    t : tfo;
+    n : nuc }
+
+let mk_var i t n = { id = i; t = t; n = n }
+
+let absolute_pos v p = tfo_apply v.t p
+
+let atom_pos atom v = absolute_pos v (atom v.n)
+
+let rec get_var id = function
+ | (v::lst) -> if id = v.id then v else get_var id lst
+ | _ -> assert false
+
+(* -- SEARCH ----------------------------------------------------------------*)
+
+(* Sequential backtracking algorithm *)
+
+let rec search (partial_inst : variable list) l constr =
+  match l with
+    [] -> [partial_inst]
+  | (h::t) ->
+      let rec try_assignments = function
+        [] -> []
+      | v::vs ->
+          if constr v partial_inst then
+            (search (v::partial_inst) t constr) @ (try_assignments vs)
+          else
+            try_assignments vs
+      in
+        try_assignments (h partial_inst)
+
+
+(* -- DOMAINS ---------------------------------------------------------------*)
+
+(* Primary structure:   strand A CUGCCACGUCUG, strand B CAGACGUGGCAG
+
+   Secondary structure: strand A CUGCCACGUCUG
+                                 ||||||||||||
+                                 GACGGUGCAGAC strand B
+
+   Tertiary structure:
+
+      5' end of strand A C1----G12 3' end of strand B
+                       U2-------A11
+                      G3-------C10
+                      C4-----G9
+                       C5---G8
+                          A6
+                        G6-C7
+                       C5----G8
+                      A4-------U9
+                      G3--------C10
+                       A2-------U11
+     5' end of strand B C1----G12 3' end of strand A
+
+   "helix", "stacked" and "connected" describe the spatial relationship
+   between two consecutive nucleotides. E.g. the nucleotides C1 and U2
+   from the strand A.
+
+   "wc" (stands for Watson-Crick and is a type of base-pairing),
+   and "wc-dumas" describe the spatial relationship between
+   nucleotides from two chains that are growing in opposite directions.
+   E.g. the nucleotides C1 from strand A and G12 from strand B.
+*)
+
+(* Dynamic Domains *)
+
+(* Given,
+     "refnuc" a nucleotide which is already positioned,
+     "nucl" the nucleotide to be placed,
+     and "tfo" a transformation matrix which expresses the desired
+     relationship between "refnuc" and "nucl",
+   the function "dgf-base" computes the transformation matrix that
+   places the nucleotide "nucl" in the given relationship to "refnuc".
+*)
+
+let
+dgf_base tfo v nucl
+  = let x = if is_A v.n then
+                tfo_align (atom_pos nuc_C1' v)
+                          (atom_pos rA_N9   v)
+                          (atom_pos nuc_C4  v)
+              else if is_C v.n then
+                tfo_align (atom_pos nuc_C1' v)
+                          (atom_pos nuc_N1  v)
+                          (atom_pos nuc_C2  v)
+              else if is_G v.n then
+                tfo_align (atom_pos nuc_C1' v)
+                          (atom_pos rG_N9   v)
+                          (atom_pos nuc_C4  v)
+              else
+                tfo_align (atom_pos nuc_C1' v)
+                          (atom_pos nuc_N1  v)
+                          (atom_pos nuc_C2  v)
+    in
+      tfo_combine (nuc_dgf_base_tfo nucl)
+                  (tfo_combine tfo (tfo_inv_ortho x))
+
+(* Placement of first nucleotide. *)
+
+let
+reference n i partial_inst = [ mk_var i tfo_id n ]
+
+(* The transformation matrix for wc is from:
+
+   Chandrasekaran R. et al (1989) A Re-Examination of the Crystal
+   Structure of A-DNA Using Fiber Diffraction Data. J. Biomol.
+   Struct. & Dynamics 6(6):1189-1202.
+*)
+
+let wc_tfo
+  = (
+      {    a= -1.0000; b=0.0028; c= -0.0019;
+           d=0.0028; e=0.3468; f= -0.9379;
+           g= -0.0019; h= -0.9379; i= -0.3468;
+           tx= -0.0080; ty=6.0730; tz=8.7208 }
+    )
+
+let
+wc nucl i j partial_inst
+  = [ mk_var i (dgf_base wc_tfo (get_var j partial_inst) nucl) nucl ]
+
+let wc_dumas_tfo
+  = (
+      {    a= -0.9737; b= -0.1834; c=0.1352;
+           d= -0.1779; e=0.2417; f= -0.9539;
+           g=0.1422; h= -0.9529; i= -0.2679;
+           tx=0.4837; ty=6.2649; tz=8.0285 }
+    )
+
+let
+wc_dumas nucl i j partial_inst
+  = [ mk_var i (dgf_base wc_dumas_tfo (get_var j partial_inst) nucl) nucl ]
+
+let helix5'_tfo
+  = (
+      {    a=0.9886; b= -0.0961; c=0.1156;
+           d=0.1424; e=0.8452; f= -0.5152;
+           g= -0.0482; h=0.5258; i=0.8492;
+           tx= -3.8737; ty=0.5480; tz=3.8024 }
+    )
+
+let
+helix5' nucl i j partial_inst
+  = [ mk_var i (dgf_base helix5'_tfo (get_var j partial_inst) nucl) nucl ]
+
+let helix3'_tfo
+  = (
+      {    a=0.9886; b=0.1424; c= -0.0482;
+           d= -0.0961; e=0.8452; f=0.5258;
+           g=0.1156; h= -0.5152; i=0.8492;
+           tx=3.4426; ty=2.0474; tz= -3.7042 }
+    )
+
+let
+helix3' nucl i j partial_inst
+  = [ mk_var i (dgf_base helix3'_tfo (get_var j partial_inst) nucl) nucl ]
+
+let g37_a38_tfo
+  = (
+      {    a=0.9991; b=0.0164; c= -0.0387;
+           d= -0.0375; e=0.7616; f= -0.6470;
+           g=0.0189; h=0.6478; i=0.7615;
+           tx= -3.3018; ty=0.9975; tz=2.5585 }
+    )
+
+let
+g37_a38 nucl i j partial_inst
+  = mk_var i (dgf_base g37_a38_tfo (get_var j partial_inst) nucl) nucl
+
+let
+stacked5' nucl i j partial_inst
+  = (g37_a38 nucl i j partial_inst) :: (helix5' nucl i j partial_inst)
+
+let a38_g37_tfo
+  = (
+      {    a=0.9991; b= -0.0375; c=0.0189;
+           d=0.0164; e=0.7616; f=0.6478;
+           g= -0.0387; h= -0.6470; i=0.7615;
+           tx=3.3819; ty=0.7718; tz= -2.5321 }
+    )
+
+let
+a38_g37 nucl i j partial_inst
+  = mk_var i (dgf_base a38_g37_tfo (get_var j partial_inst) nucl) nucl
+
+let
+stacked3' nucl i j partial_inst
+  = (a38_g37 nucl i j partial_inst) :: (helix3' nucl i j partial_inst)
+
+let
+p_o3' nucls i j partial_inst
+  = let refnuc = get_var j partial_inst in
+    let align = tfo_inv_ortho
+                    (tfo_align (atom_pos nuc_O3' refnuc)
+                               (atom_pos nuc_C3' refnuc)
+                               (atom_pos nuc_C4' refnuc)) in
+    let rec generate domains = function
+      [] -> domains
+    | n::ns ->
+         generate
+           ((mk_var i (tfo_combine (nuc_p_o3'_60_tfo n) align) n)::
+            (mk_var i (tfo_combine (nuc_p_o3'_180_tfo n) align) n)::
+            (mk_var i (tfo_combine (nuc_p_o3'_275_tfo n) align) n)::domains)
+           ns
+    in
+      generate [] nucls
+
+(* -- PROBLEM STATEMENT -----------------------------------------------------*)
+
+(* Define anticodon problem -- Science 253:1255 Figure 3a, 3b and 3c *)
+
+let
+anticodon_domains
+  = [
+     reference rC  27;
+     helix5'   rC  28 27;
+     helix5'   rA  29 28;
+     helix5'   rG  30 29;
+     helix5'   rA  31 30;
+     wc        rU  39 31;
+     helix5'   rC  40 39;
+     helix5'   rU  41 40;
+     helix5'   rG  42 41;
+     helix5'   rG  43 42;
+     stacked3' rA  38 39;
+     stacked3' rG  37 38;
+     stacked3' rA  36 37;
+     stacked3' rA  35 36;
+     stacked3' rG  34 35; (* <-. Distance      *)
+     p_o3'     rCs 32 31; (*   | Constraint    *)
+     p_o3'     rUs 33 32  (* <-' 3.0 Angstroms *)
+    ]
+
+(* Anticodon constraint *)
+
+let
+anticodon_constraint v partial_inst =
+  let rec dist j = let p = atom_pos nuc_P (get_var j partial_inst) in
+                   let o3' = atom_pos nuc_O3' v in
+                     pt_dist p o3'
+  in
+      if v.id = 33 then
+        (dist 34) <= 3.0
+      else
+        true
+
+let
+anticodon () = search [] anticodon_domains anticodon_constraint
+
+(* Define pseudoknot problem -- Science 253:1255 Figure 4a and 4b *)
+
+let
+pseudoknot_domains
+  = [
+     reference rA  23;
+     wc_dumas  rU   8 23;
+     helix3'   rG  22 23;
+     wc_dumas  rC   9 22;
+     helix3'   rG  21 22;
+     wc_dumas  rC  10 21;
+     helix3'   rC  20 21;
+     wc_dumas  rG  11 20;
+     helix3'   rU' 19 20; (* <-.               *)
+     wc_dumas  rA  12 19; (*   | Distance      *)
+(*                             | Constraint    *)
+(*  Helix 1                    | 4.0 Angstroms *)
+     helix3'   rC   3 19; (*   |               *)
+     wc_dumas  rG  13  3; (*   |               *)
+     helix3'   rC   2  3; (*   |               *)
+     wc_dumas  rG  14  2; (*   |               *)
+     helix3'   rC   1  2; (*   |               *)
+     wc_dumas  rG' 15  1; (*   |               *)
+(*                             |               *)
+(*  L2 LOOP                    |               *)
+     p_o3'     rUs 16 15; (*   |               *)
+     p_o3'     rCs 17 16; (*   |               *)
+     p_o3'     rAs 18 17; (* <-'               *)
+(*                                             *)
+(*  L1 LOOP                                    *)
+     helix3'   rU   7  8; (* <-.               *)
+     p_o3'     rCs  4  3; (*   | Constraint    *)
+     stacked5' rU   5  4; (*   | 4.5 Angstroms *)
+     stacked5' rC   6  5  (* <-'               *)
+    ]
+
+(* Pseudoknot constraint *)
+
+let
+pseudoknot_constraint v partial_inst =
+    let rec dist j =
+        let p = atom_pos nuc_P (get_var j partial_inst) in
+        let o3' = atom_pos nuc_O3' v in
+        pt_dist p o3'
+    in
+      if v.id = 18 then
+        (dist 19) <= 4.0
+      else if v.id = 6 then
+        (dist 7) <= 4.5
+      else
+        true
+
+let
+pseudoknot () = search [] pseudoknot_domains pseudoknot_constraint
+
+(* -- TESTING ---------------------------------------------------------------*)
+
+let list_of_atoms = function
+  (N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,
+   A (n6,n7,n9,c8,h2,h61,h62,h8)))
+  -> [|p;o1p;o2p;o5';c5';h5';h5'';c4';h4';o4';c1';h1';c2';h2'';o2';h2';c3';
+     h3';o3';n1;n3;c2;c4;c5;c6;n6;n7;n9;c8;h2;h61;h62;h8|]
+
+| (N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,
+   C (n4,o2,h41,h42,h5,h6)))
+  -> [|p;o1p;o2p;o5';c5';h5';h5'';c4';h4';o4';c1';h1';c2';h2'';o2';h2';c3';
+     h3';o3';n1;n3;c2;c4;c5;c6;n4;o2;h41;h42;h5;h6|]
+
+| (N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,
+   G (n2,n7,n9,c8,o6,h1,h21,h22,h8)))
+  -> [|p;o1p;o2p;o5';c5';h5';h5'';c4';h4';o4';c1';h1';c2';h2'';o2';h2';c3';
+     h3';o3';n1;n3;c2;c4;c5;c6;n2;n7;n9;c8;o6;h1;h21;h22;h8|]
+
+| (N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+   p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+   c3',h3',o3',n1,n3,c2,c4,c5,c6,
+   U (o2,o4,h3,h5,h6)))
+  -> [|p;o1p;o2p;o5';c5';h5';h5'';c4';h4';o4';c1';h1';c2';h2'';o2';h2';c3';
+     h3';o3';n1;n3;c2;c4;c5;c6;o2;o4;h3;h5;h6|]
+
+let maximum = function
+  | x::xs ->
+     let rec iter m = function
+       [] -> m
+     | (a::b) -> iter (if a > m then a else m) b
+     in
+       iter x xs
+  | _ -> assert false
+
+let
+var_most_distant_atom v =
+  let atoms = list_of_atoms v.n in
+  let max_dist = ref 0.0 in
+  for i = 0 to pred (Array.length atoms) do
+    let p = atoms.(i) in
+    let distance =
+      let pos = absolute_pos v p
+      in sqrt ((pos.x * pos.x) + (pos.y * pos.y) + (pos.z * pos.z)) in
+    if distance > !max_dist then max_dist := distance
+  done;
+  !max_dist
+
+let
+sol_most_distant_atom s = maximum (List.map var_most_distant_atom s)
+
+let
+most_distant_atom sols = maximum (List.map sol_most_distant_atom sols)
+
+let
+check () = List.length (pseudoknot ())
+
+let
+run () = most_distant_atom (pseudoknot ())
+
+let main () =
+  Printf.printf "%.4f" (run ()); print_newline()
+
+let _ = main ()
diff --git a/testsuite/tests/misc/nucleic.reference b/testsuite/tests/misc/nucleic.reference
new file mode 100644
index 00000000..14689cdb
--- /dev/null
+++ b/testsuite/tests/misc/nucleic.reference
@@ -0,0 +1 @@
+33.7976
diff --git a/testsuite/tests/misc/pr7168.ml b/testsuite/tests/misc/pr7168.ml
new file mode 100644
index 00000000..0d41593c
--- /dev/null
+++ b/testsuite/tests/misc/pr7168.ml
@@ -0,0 +1,80 @@
+(* TEST
+*)
+
+let rec f x =
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in  let x = x+x in  let x = x+x in  let x = x+x in
+  let x = x+x in
+  let _ = f x in
+  ()
+
+let _ =
+  if (Gc.get ()).Gc.stack_limit = 0 then begin
+    (* We are in native code. Skip the test because some platforms cannot
+       reliably detect stack overflow. *)
+    Printf.printf "OK\n"
+  end else begin
+    try f 1
+    with Stack_overflow -> Printf.printf "OK\n"
+  end
diff --git a/testsuite/tests/misc/pr7168.reference b/testsuite/tests/misc/pr7168.reference
new file mode 100644
index 00000000..d86bac9d
--- /dev/null
+++ b/testsuite/tests/misc/pr7168.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/misc/sieve.ml b/testsuite/tests/misc/sieve.ml
new file mode 100644
index 00000000..1dd83a0e
--- /dev/null
+++ b/testsuite/tests/misc/sieve.ml
@@ -0,0 +1,45 @@
+(* TEST
+*)
+
+(* Eratosthene's sieve *)
+
+(* interval min max = [min; min+1; ...; max-1; max] *)
+
+let rec interval min max =
+  if min > max then [] else min :: interval (min + 1) max
+
+
+(* filter p L returns the list of the elements in list L
+   that satisfy predicate p *)
+
+let rec filter p = function
+     []  -> []
+  | a::r -> if p a then a :: filter p r else filter p r
+
+
+(* Application: removing all numbers multiple of n from a list of integers *)
+
+let remove_multiples_of n =
+  filter (fun m -> m mod n <> 0)
+
+
+(* The sieve itself *)
+
+let sieve max =
+  let rec filter_again = function
+     [] -> []
+  | n::r as l ->
+      if n*n > max then l else n :: filter_again (remove_multiples_of n r)
+  in
+    filter_again (interval 2 max)
+
+
+let rec do_list f = function
+    [] -> ()
+  | a::l -> f a; do_list f l
+
+
+let _ =
+  do_list (fun n -> print_string " "; print_int n) (sieve 50000);
+  print_newline();
+  exit 0
diff --git a/testsuite/tests/misc/sieve.reference b/testsuite/tests/misc/sieve.reference
new file mode 100644
index 00000000..24f5cc54
--- /dev/null
+++ b/testsuite/tests/misc/sieve.reference
@@ -0,0 +1 @@
+ 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 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627 1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753 1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999 2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089 2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411 2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543 2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663 2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741 2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851 2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969 2971 2999 3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089 3109 3119 3121 3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221 3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323 3329 3331 3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461 3463 3467 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557 3559 3571 3581 3583 3593 3607 3613 3617 3623 3631 3637 3643 3659 3671 3673 3677 3691 3697 3701 3709 3719 3727 3733 3739 3761 3767 3769 3779 3793 3797 3803 3821 3823 3833 3847 3851 3853 3863 3877 3881 3889 3907 3911 3917 3919 3923 3929 3931 3943 3947 3967 3989 4001 4003 4007 4013 4019 4021 4027 4049 4051 4057 4073 4079 4091 4093 4099 4111 4127 4129 4133 4139 4153 4157 4159 4177 4201 4211 4217 4219 4229 4231 4241 4243 4253 4259 4261 4271 4273 4283 4289 4297 4327 4337 4339 4349 4357 4363 4373 4391 4397 4409 4421 4423 4441 4447 4451 4457 4463 4481 4483 4493 4507 4513 4517 4519 4523 4547 4549 4561 4567 4583 4591 4597 4603 4621 4637 4639 4643 4649 4651 4657 4663 4673 4679 4691 4703 4721 4723 4729 4733 4751 4759 4783 4787 4789 4793 4799 4801 4813 4817 4831 4861 4871 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973 4987 4993 4999 5003 5009 5011 5021 5023 5039 5051 5059 5077 5081 5087 5099 5101 5107 5113 5119 5147 5153 5167 5171 5179 5189 5197 5209 5227 5231 5233 5237 5261 5273 5279 5281 5297 5303 5309 5323 5333 5347 5351 5381 5387 5393 5399 5407 5413 5417 5419 5431 5437 5441 5443 5449 5471 5477 5479 5483 5501 5503 5507 5519 5521 5527 5531 5557 5563 5569 5573 5581 5591 5623 5639 5641 5647 5651 5653 5657 5659 5669 5683 5689 5693 5701 5711 5717 5737 5741 5743 5749 5779 5783 5791 5801 5807 5813 5821 5827 5839 5843 5849 5851 5857 5861 5867 5869 5879 5881 5897 5903 5923 5927 5939 5953 5981 5987 6007 6011 6029 6037 6043 6047 6053 6067 6073 6079 6089 6091 6101 6113 6121 6131 6133 6143 6151 6163 6173 6197 6199 6203 6211 6217 6221 6229 6247 6257 6263 6269 6271 6277 6287 6299 6301 6311 6317 6323 6329 6337 6343 6353 6359 6361 6367 6373 6379 6389 6397 6421 6427 6449 6451 6469 6473 6481 6491 6521 6529 6547 6551 6553 6563 6569 6571 6577 6581 6599 6607 6619 6637 6653 6659 6661 6673 6679 6689 6691 6701 6703 6709 6719 6733 6737 6761 6763 6779 6781 6791 6793 6803 6823 6827 6829 6833 6841 6857 6863 6869 6871 6883 6899 6907 6911 6917 6947 6949 6959 6961 6967 6971 6977 6983 6991 6997 7001 7013 7019 7027 7039 7043 7057 7069 7079 7103 7109 7121 7127 7129 7151 7159 7177 7187 7193 7207 7211 7213 7219 7229 7237 7243 7247 7253 7283 7297 7307 7309 7321 7331 7333 7349 7351 7369 7393 7411 7417 7433 7451 7457 7459 7477 7481 7487 7489 7499 7507 7517 7523 7529 7537 7541 7547 7549 7559 7561 7573 7577 7583 7589 7591 7603 7607 7621 7639 7643 7649 7669 7673 7681 7687 7691 7699 7703 7717 7723 7727 7741 7753 7757 7759 7789 7793 7817 7823 7829 7841 7853 7867 7873 7877 7879 7883 7901 7907 7919 7927 7933 7937 7949 7951 7963 7993 8009 8011 8017 8039 8053 8059 8069 8081 8087 8089 8093 8101 8111 8117 8123 8147 8161 8167 8171 8179 8191 8209 8219 8221 8231 8233 8237 8243 8263 8269 8273 8287 8291 8293 8297 8311 8317 8329 8353 8363 8369 8377 8387 8389 8419 8423 8429 8431 8443 8447 8461 8467 8501 8513 8521 8527 8537 8539 8543 8563 8573 8581 8597 8599 8609 8623 8627 8629 8641 8647 8663 8669 8677 8681 8689 8693 8699 8707 8713 8719 8731 8737 8741 8747 8753 8761 8779 8783 8803 8807 8819 8821 8831 8837 8839 8849 8861 8863 8867 8887 8893 8923 8929 8933 8941 8951 8963 8969 8971 8999 9001 9007 9011 9013 9029 9041 9043 9049 9059 9067 9091 9103 9109 9127 9133 9137 9151 9157 9161 9173 9181 9187 9199 9203 9209 9221 9227 9239 9241 9257 9277 9281 9283 9293 9311 9319 9323 9337 9341 9343 9349 9371 9377 9391 9397 9403 9413 9419 9421 9431 9433 9437 9439 9461 9463 9467 9473 9479 9491 9497 9511 9521 9533 9539 9547 9551 9587 9601 9613 9619 9623 9629 9631 9643 9649 9661 9677 9679 9689 9697 9719 9721 9733 9739 9743 9749 9767 9769 9781 9787 9791 9803 9811 9817 9829 9833 9839 9851 9857 9859 9871 9883 9887 9901 9907 9923 9929 9931 9941 9949 9967 9973 10007 10009 10037 10039 10061 10067 10069 10079 10091 10093 10099 10103 10111 10133 10139 10141 10151 10159 10163 10169 10177 10181 10193 10211 10223 10243 10247 10253 10259 10267 10271 10273 10289 10301 10303 10313 10321 10331 10333 10337 10343 10357 10369 10391 10399 10427 10429 10433 10453 10457 10459 10463 10477 10487 10499 10501 10513 10529 10531 10559 10567 10589 10597 10601 10607 10613 10627 10631 10639 10651 10657 10663 10667 10687 10691 10709 10711 10723 10729 10733 10739 10753 10771 10781 10789 10799 10831 10837 10847 10853 10859 10861 10867 10883 10889 10891 10903 10909 10937 10939 10949 10957 10973 10979 10987 10993 11003 11027 11047 11057 11059 11069 11071 11083 11087 11093 11113 11117 11119 11131 11149 11159 11161 11171 11173 11177 11197 11213 11239 11243 11251 11257 11261 11273 11279 11287 11299 11311 11317 11321 11329 11351 11353 11369 11383 11393 11399 11411 11423 11437 11443 11447 11467 11471 11483 11489 11491 11497 11503 11519 11527 11549 11551 11579 11587 11593 11597 11617 11621 11633 11657 11677 11681 11689 11699 11701 11717 11719 11731 11743 11777 11779 11783 11789 11801 11807 11813 11821 11827 11831 11833 11839 11863 11867 11887 11897 11903 11909 11923 11927 11933 11939 11941 11953 11959 11969 11971 11981 11987 12007 12011 12037 12041 12043 12049 12071 12073 12097 12101 12107 12109 12113 12119 12143 12149 12157 12161 12163 12197 12203 12211 12227 12239 12241 12251 12253 12263 12269 12277 12281 12289 12301 12323 12329 12343 12347 12373 12377 12379 12391 12401 12409 12413 12421 12433 12437 12451 12457 12473 12479 12487 12491 12497 12503 12511 12517 12527 12539 12541 12547 12553 12569 12577 12583 12589 12601 12611 12613 12619 12637 12641 12647 12653 12659 12671 12689 12697 12703 12713 12721 12739 12743 12757 12763 12781 12791 12799 12809 12821 12823 12829 12841 12853 12889 12893 12899 12907 12911 12917 12919 12923 12941 12953 12959 12967 12973 12979 12983 13001 13003 13007 13009 13033 13037 13043 13049 13063 13093 13099 13103 13109 13121 13127 13147 13151 13159 13163 13171 13177 13183 13187 13217 13219 13229 13241 13249 13259 13267 13291 13297 13309 13313 13327 13331 13337 13339 13367 13381 13397 13399 13411 13417 13421 13441 13451 13457 13463 13469 13477 13487 13499 13513 13523 13537 13553 13567 13577 13591 13597 13613 13619 13627 13633 13649 13669 13679 13681 13687 13691 13693 13697 13709 13711 13721 13723 13729 13751 13757 13759 13763 13781 13789 13799 13807 13829 13831 13841 13859 13873 13877 13879 13883 13901 13903 13907 13913 13921 13931 13933 13963 13967 13997 13999 14009 14011 14029 14033 14051 14057 14071 14081 14083 14087 14107 14143 14149 14153 14159 14173 14177 14197 14207 14221 14243 14249 14251 14281 14293 14303 14321 14323 14327 14341 14347 14369 14387 14389 14401 14407 14411 14419 14423 14431 14437 14447 14449 14461 14479 14489 14503 14519 14533 14537 14543 14549 14551 14557 14561 14563 14591 14593 14621 14627 14629 14633 14639 14653 14657 14669 14683 14699 14713 14717 14723 14731 14737 14741 14747 14753 14759 14767 14771 14779 14783 14797 14813 14821 14827 14831 14843 14851 14867 14869 14879 14887 14891 14897 14923 14929 14939 14947 14951 14957 14969 14983 15013 15017 15031 15053 15061 15073 15077 15083 15091 15101 15107 15121 15131 15137 15139 15149 15161 15173 15187 15193 15199 15217 15227 15233 15241 15259 15263 15269 15271 15277 15287 15289 15299 15307 15313 15319 15329 15331 15349 15359 15361 15373 15377 15383 15391 15401 15413 15427 15439 15443 15451 15461 15467 15473 15493 15497 15511 15527 15541 15551 15559 15569 15581 15583 15601 15607 15619 15629 15641 15643 15647 15649 15661 15667 15671 15679 15683 15727 15731 15733 15737 15739 15749 15761 15767 15773 15787 15791 15797 15803 15809 15817 15823 15859 15877 15881 15887 15889 15901 15907 15913 15919 15923 15937 15959 15971 15973 15991 16001 16007 16033 16057 16061 16063 16067 16069 16073 16087 16091 16097 16103 16111 16127 16139 16141 16183 16187 16189 16193 16217 16223 16229 16231 16249 16253 16267 16273 16301 16319 16333 16339 16349 16361 16363 16369 16381 16411 16417 16421 16427 16433 16447 16451 16453 16477 16481 16487 16493 16519 16529 16547 16553 16561 16567 16573 16603 16607 16619 16631 16633 16649 16651 16657 16661 16673 16691 16693 16699 16703 16729 16741 16747 16759 16763 16787 16811 16823 16829 16831 16843 16871 16879 16883 16889 16901 16903 16921 16927 16931 16937 16943 16963 16979 16981 16987 16993 17011 17021 17027 17029 17033 17041 17047 17053 17077 17093 17099 17107 17117 17123 17137 17159 17167 17183 17189 17191 17203 17207 17209 17231 17239 17257 17291 17293 17299 17317 17321 17327 17333 17341 17351 17359 17377 17383 17387 17389 17393 17401 17417 17419 17431 17443 17449 17467 17471 17477 17483 17489 17491 17497 17509 17519 17539 17551 17569 17573 17579 17581 17597 17599 17609 17623 17627 17657 17659 17669 17681 17683 17707 17713 17729 17737 17747 17749 17761 17783 17789 17791 17807 17827 17837 17839 17851 17863 17881 17891 17903 17909 17911 17921 17923 17929 17939 17957 17959 17971 17977 17981 17987 17989 18013 18041 18043 18047 18049 18059 18061 18077 18089 18097 18119 18121 18127 18131 18133 18143 18149 18169 18181 18191 18199 18211 18217 18223 18229 18233 18251 18253 18257 18269 18287 18289 18301 18307 18311 18313 18329 18341 18353 18367 18371 18379 18397 18401 18413 18427 18433 18439 18443 18451 18457 18461 18481 18493 18503 18517 18521 18523 18539 18541 18553 18583 18587 18593 18617 18637 18661 18671 18679 18691 18701 18713 18719 18731 18743 18749 18757 18773 18787 18793 18797 18803 18839 18859 18869 18899 18911 18913 18917 18919 18947 18959 18973 18979 19001 19009 19013 19031 19037 19051 19069 19073 19079 19081 19087 19121 19139 19141 19157 19163 19181 19183 19207 19211 19213 19219 19231 19237 19249 19259 19267 19273 19289 19301 19309 19319 19333 19373 19379 19381 19387 19391 19403 19417 19421 19423 19427 19429 19433 19441 19447 19457 19463 19469 19471 19477 19483 19489 19501 19507 19531 19541 19543 19553 19559 19571 19577 19583 19597 19603 19609 19661 19681 19687 19697 19699 19709 19717 19727 19739 19751 19753 19759 19763 19777 19793 19801 19813 19819 19841 19843 19853 19861 19867 19889 19891 19913 19919 19927 19937 19949 19961 19963 19973 19979 19991 19993 19997 20011 20021 20023 20029 20047 20051 20063 20071 20089 20101 20107 20113 20117 20123 20129 20143 20147 20149 20161 20173 20177 20183 20201 20219 20231 20233 20249 20261 20269 20287 20297 20323 20327 20333 20341 20347 20353 20357 20359 20369 20389 20393 20399 20407 20411 20431 20441 20443 20477 20479 20483 20507 20509 20521 20533 20543 20549 20551 20563 20593 20599 20611 20627 20639 20641 20663 20681 20693 20707 20717 20719 20731 20743 20747 20749 20753 20759 20771 20773 20789 20807 20809 20849 20857 20873 20879 20887 20897 20899 20903 20921 20929 20939 20947 20959 20963 20981 20983 21001 21011 21013 21017 21019 21023 21031 21059 21061 21067 21089 21101 21107 21121 21139 21143 21149 21157 21163 21169 21179 21187 21191 21193 21211 21221 21227 21247 21269 21277 21283 21313 21317 21319 21323 21341 21347 21377 21379 21383 21391 21397 21401 21407 21419 21433 21467 21481 21487 21491 21493 21499 21503 21517 21521 21523 21529 21557 21559 21563 21569 21577 21587 21589 21599 21601 21611 21613 21617 21647 21649 21661 21673 21683 21701 21713 21727 21737 21739 21751 21757 21767 21773 21787 21799 21803 21817 21821 21839 21841 21851 21859 21863 21871 21881 21893 21911 21929 21937 21943 21961 21977 21991 21997 22003 22013 22027 22031 22037 22039 22051 22063 22067 22073 22079 22091 22093 22109 22111 22123 22129 22133 22147 22153 22157 22159 22171 22189 22193 22229 22247 22259 22271 22273 22277 22279 22283 22291 22303 22307 22343 22349 22367 22369 22381 22391 22397 22409 22433 22441 22447 22453 22469 22481 22483 22501 22511 22531 22541 22543 22549 22567 22571 22573 22613 22619 22621 22637 22639 22643 22651 22669 22679 22691 22697 22699 22709 22717 22721 22727 22739 22741 22751 22769 22777 22783 22787 22807 22811 22817 22853 22859 22861 22871 22877 22901 22907 22921 22937 22943 22961 22963 22973 22993 23003 23011 23017 23021 23027 23029 23039 23041 23053 23057 23059 23063 23071 23081 23087 23099 23117 23131 23143 23159 23167 23173 23189 23197 23201 23203 23209 23227 23251 23269 23279 23291 23293 23297 23311 23321 23327 23333 23339 23357 23369 23371 23399 23417 23431 23447 23459 23473 23497 23509 23531 23537 23539 23549 23557 23561 23563 23567 23581 23593 23599 23603 23609 23623 23627 23629 23633 23663 23669 23671 23677 23687 23689 23719 23741 23743 23747 23753 23761 23767 23773 23789 23801 23813 23819 23827 23831 23833 23857 23869 23873 23879 23887 23893 23899 23909 23911 23917 23929 23957 23971 23977 23981 23993 24001 24007 24019 24023 24029 24043 24049 24061 24071 24077 24083 24091 24097 24103 24107 24109 24113 24121 24133 24137 24151 24169 24179 24181 24197 24203 24223 24229 24239 24247 24251 24281 24317 24329 24337 24359 24371 24373 24379 24391 24407 24413 24419 24421 24439 24443 24469 24473 24481 24499 24509 24517 24527 24533 24547 24551 24571 24593 24611 24623 24631 24659 24671 24677 24683 24691 24697 24709 24733 24749 24763 24767 24781 24793 24799 24809 24821 24841 24847 24851 24859 24877 24889 24907 24917 24919 24923 24943 24953 24967 24971 24977 24979 24989 25013 25031 25033 25037 25057 25073 25087 25097 25111 25117 25121 25127 25147 25153 25163 25169 25171 25183 25189 25219 25229 25237 25243 25247 25253 25261 25301 25303 25307 25309 25321 25339 25343 25349 25357 25367 25373 25391 25409 25411 25423 25439 25447 25453 25457 25463 25469 25471 25523 25537 25541 25561 25577 25579 25583 25589 25601 25603 25609 25621 25633 25639 25643 25657 25667 25673 25679 25693 25703 25717 25733 25741 25747 25759 25763 25771 25793 25799 25801 25819 25841 25847 25849 25867 25873 25889 25903 25913 25919 25931 25933 25939 25943 25951 25969 25981 25997 25999 26003 26017 26021 26029 26041 26053 26083 26099 26107 26111 26113 26119 26141 26153 26161 26171 26177 26183 26189 26203 26209 26227 26237 26249 26251 26261 26263 26267 26293 26297 26309 26317 26321 26339 26347 26357 26371 26387 26393 26399 26407 26417 26423 26431 26437 26449 26459 26479 26489 26497 26501 26513 26539 26557 26561 26573 26591 26597 26627 26633 26641 26647 26669 26681 26683 26687 26693 26699 26701 26711 26713 26717 26723 26729 26731 26737 26759 26777 26783 26801 26813 26821 26833 26839 26849 26861 26863 26879 26881 26891 26893 26903 26921 26927 26947 26951 26953 26959 26981 26987 26993 27011 27017 27031 27043 27059 27061 27067 27073 27077 27091 27103 27107 27109 27127 27143 27179 27191 27197 27211 27239 27241 27253 27259 27271 27277 27281 27283 27299 27329 27337 27361 27367 27397 27407 27409 27427 27431 27437 27449 27457 27479 27481 27487 27509 27527 27529 27539 27541 27551 27581 27583 27611 27617 27631 27647 27653 27673 27689 27691 27697 27701 27733 27737 27739 27743 27749 27751 27763 27767 27773 27779 27791 27793 27799 27803 27809 27817 27823 27827 27847 27851 27883 27893 27901 27917 27919 27941 27943 27947 27953 27961 27967 27983 27997 28001 28019 28027 28031 28051 28057 28069 28081 28087 28097 28099 28109 28111 28123 28151 28163 28181 28183 28201 28211 28219 28229 28277 28279 28283 28289 28297 28307 28309 28319 28349 28351 28387 28393 28403 28409 28411 28429 28433 28439 28447 28463 28477 28493 28499 28513 28517 28537 28541 28547 28549 28559 28571 28573 28579 28591 28597 28603 28607 28619 28621 28627 28631 28643 28649 28657 28661 28663 28669 28687 28697 28703 28711 28723 28729 28751 28753 28759 28771 28789 28793 28807 28813 28817 28837 28843 28859 28867 28871 28879 28901 28909 28921 28927 28933 28949 28961 28979 29009 29017 29021 29023 29027 29033 29059 29063 29077 29101 29123 29129 29131 29137 29147 29153 29167 29173 29179 29191 29201 29207 29209 29221 29231 29243 29251 29269 29287 29297 29303 29311 29327 29333 29339 29347 29363 29383 29387 29389 29399 29401 29411 29423 29429 29437 29443 29453 29473 29483 29501 29527 29531 29537 29567 29569 29573 29581 29587 29599 29611 29629 29633 29641 29663 29669 29671 29683 29717 29723 29741 29753 29759 29761 29789 29803 29819 29833 29837 29851 29863 29867 29873 29879 29881 29917 29921 29927 29947 29959 29983 29989 30011 30013 30029 30047 30059 30071 30089 30091 30097 30103 30109 30113 30119 30133 30137 30139 30161 30169 30181 30187 30197 30203 30211 30223 30241 30253 30259 30269 30271 30293 30307 30313 30319 30323 30341 30347 30367 30389 30391 30403 30427 30431 30449 30467 30469 30491 30493 30497 30509 30517 30529 30539 30553 30557 30559 30577 30593 30631 30637 30643 30649 30661 30671 30677 30689 30697 30703 30707 30713 30727 30757 30763 30773 30781 30803 30809 30817 30829 30839 30841 30851 30853 30859 30869 30871 30881 30893 30911 30931 30937 30941 30949 30971 30977 30983 31013 31019 31033 31039 31051 31063 31069 31079 31081 31091 31121 31123 31139 31147 31151 31153 31159 31177 31181 31183 31189 31193 31219 31223 31231 31237 31247 31249 31253 31259 31267 31271 31277 31307 31319 31321 31327 31333 31337 31357 31379 31387 31391 31393 31397 31469 31477 31481 31489 31511 31513 31517 31531 31541 31543 31547 31567 31573 31583 31601 31607 31627 31643 31649 31657 31663 31667 31687 31699 31721 31723 31727 31729 31741 31751 31769 31771 31793 31799 31817 31847 31849 31859 31873 31883 31891 31907 31957 31963 31973 31981 31991 32003 32009 32027 32029 32051 32057 32059 32063 32069 32077 32083 32089 32099 32117 32119 32141 32143 32159 32173 32183 32189 32191 32203 32213 32233 32237 32251 32257 32261 32297 32299 32303 32309 32321 32323 32327 32341 32353 32359 32363 32369 32371 32377 32381 32401 32411 32413 32423 32429 32441 32443 32467 32479 32491 32497 32503 32507 32531 32533 32537 32561 32563 32569 32573 32579 32587 32603 32609 32611 32621 32633 32647 32653 32687 32693 32707 32713 32717 32719 32749 32771 32779 32783 32789 32797 32801 32803 32831 32833 32839 32843 32869 32887 32909 32911 32917 32933 32939 32941 32957 32969 32971 32983 32987 32993 32999 33013 33023 33029 33037 33049 33053 33071 33073 33083 33091 33107 33113 33119 33149 33151 33161 33179 33181 33191 33199 33203 33211 33223 33247 33287 33289 33301 33311 33317 33329 33331 33343 33347 33349 33353 33359 33377 33391 33403 33409 33413 33427 33457 33461 33469 33479 33487 33493 33503 33521 33529 33533 33547 33563 33569 33577 33581 33587 33589 33599 33601 33613 33617 33619 33623 33629 33637 33641 33647 33679 33703 33713 33721 33739 33749 33751 33757 33767 33769 33773 33791 33797 33809 33811 33827 33829 33851 33857 33863 33871 33889 33893 33911 33923 33931 33937 33941 33961 33967 33997 34019 34031 34033 34039 34057 34061 34123 34127 34129 34141 34147 34157 34159 34171 34183 34211 34213 34217 34231 34253 34259 34261 34267 34273 34283 34297 34301 34303 34313 34319 34327 34337 34351 34361 34367 34369 34381 34403 34421 34429 34439 34457 34469 34471 34483 34487 34499 34501 34511 34513 34519 34537 34543 34549 34583 34589 34591 34603 34607 34613 34631 34649 34651 34667 34673 34679 34687 34693 34703 34721 34729 34739 34747 34757 34759 34763 34781 34807 34819 34841 34843 34847 34849 34871 34877 34883 34897 34913 34919 34939 34949 34961 34963 34981 35023 35027 35051 35053 35059 35069 35081 35083 35089 35099 35107 35111 35117 35129 35141 35149 35153 35159 35171 35201 35221 35227 35251 35257 35267 35279 35281 35291 35311 35317 35323 35327 35339 35353 35363 35381 35393 35401 35407 35419 35423 35437 35447 35449 35461 35491 35507 35509 35521 35527 35531 35533 35537 35543 35569 35573 35591 35593 35597 35603 35617 35671 35677 35729 35731 35747 35753 35759 35771 35797 35801 35803 35809 35831 35837 35839 35851 35863 35869 35879 35897 35899 35911 35923 35933 35951 35963 35969 35977 35983 35993 35999 36007 36011 36013 36017 36037 36061 36067 36073 36083 36097 36107 36109 36131 36137 36151 36161 36187 36191 36209 36217 36229 36241 36251 36263 36269 36277 36293 36299 36307 36313 36319 36341 36343 36353 36373 36383 36389 36433 36451 36457 36467 36469 36473 36479 36493 36497 36523 36527 36529 36541 36551 36559 36563 36571 36583 36587 36599 36607 36629 36637 36643 36653 36671 36677 36683 36691 36697 36709 36713 36721 36739 36749 36761 36767 36779 36781 36787 36791 36793 36809 36821 36833 36847 36857 36871 36877 36887 36899 36901 36913 36919 36923 36929 36931 36943 36947 36973 36979 36997 37003 37013 37019 37021 37039 37049 37057 37061 37087 37097 37117 37123 37139 37159 37171 37181 37189 37199 37201 37217 37223 37243 37253 37273 37277 37307 37309 37313 37321 37337 37339 37357 37361 37363 37369 37379 37397 37409 37423 37441 37447 37463 37483 37489 37493 37501 37507 37511 37517 37529 37537 37547 37549 37561 37567 37571 37573 37579 37589 37591 37607 37619 37633 37643 37649 37657 37663 37691 37693 37699 37717 37747 37781 37783 37799 37811 37813 37831 37847 37853 37861 37871 37879 37889 37897 37907 37951 37957 37963 37967 37987 37991 37993 37997 38011 38039 38047 38053 38069 38083 38113 38119 38149 38153 38167 38177 38183 38189 38197 38201 38219 38231 38237 38239 38261 38273 38281 38287 38299 38303 38317 38321 38327 38329 38333 38351 38371 38377 38393 38431 38447 38449 38453 38459 38461 38501 38543 38557 38561 38567 38569 38593 38603 38609 38611 38629 38639 38651 38653 38669 38671 38677 38693 38699 38707 38711 38713 38723 38729 38737 38747 38749 38767 38783 38791 38803 38821 38833 38839 38851 38861 38867 38873 38891 38903 38917 38921 38923 38933 38953 38959 38971 38977 38993 39019 39023 39041 39043 39047 39079 39089 39097 39103 39107 39113 39119 39133 39139 39157 39161 39163 39181 39191 39199 39209 39217 39227 39229 39233 39239 39241 39251 39293 39301 39313 39317 39323 39341 39343 39359 39367 39371 39373 39383 39397 39409 39419 39439 39443 39451 39461 39499 39503 39509 39511 39521 39541 39551 39563 39569 39581 39607 39619 39623 39631 39659 39667 39671 39679 39703 39709 39719 39727 39733 39749 39761 39769 39779 39791 39799 39821 39827 39829 39839 39841 39847 39857 39863 39869 39877 39883 39887 39901 39929 39937 39953 39971 39979 39983 39989 40009 40013 40031 40037 40039 40063 40087 40093 40099 40111 40123 40127 40129 40151 40153 40163 40169 40177 40189 40193 40213 40231 40237 40241 40253 40277 40283 40289 40343 40351 40357 40361 40387 40423 40427 40429 40433 40459 40471 40483 40487 40493 40499 40507 40519 40529 40531 40543 40559 40577 40583 40591 40597 40609 40627 40637 40639 40693 40697 40699 40709 40739 40751 40759 40763 40771 40787 40801 40813 40819 40823 40829 40841 40847 40849 40853 40867 40879 40883 40897 40903 40927 40933 40939 40949 40961 40973 40993 41011 41017 41023 41039 41047 41051 41057 41077 41081 41113 41117 41131 41141 41143 41149 41161 41177 41179 41183 41189 41201 41203 41213 41221 41227 41231 41233 41243 41257 41263 41269 41281 41299 41333 41341 41351 41357 41381 41387 41389 41399 41411 41413 41443 41453 41467 41479 41491 41507 41513 41519 41521 41539 41543 41549 41579 41593 41597 41603 41609 41611 41617 41621 41627 41641 41647 41651 41659 41669 41681 41687 41719 41729 41737 41759 41761 41771 41777 41801 41809 41813 41843 41849 41851 41863 41879 41887 41893 41897 41903 41911 41927 41941 41947 41953 41957 41959 41969 41981 41983 41999 42013 42017 42019 42023 42043 42061 42071 42073 42083 42089 42101 42131 42139 42157 42169 42179 42181 42187 42193 42197 42209 42221 42223 42227 42239 42257 42281 42283 42293 42299 42307 42323 42331 42337 42349 42359 42373 42379 42391 42397 42403 42407 42409 42433 42437 42443 42451 42457 42461 42463 42467 42473 42487 42491 42499 42509 42533 42557 42569 42571 42577 42589 42611 42641 42643 42649 42667 42677 42683 42689 42697 42701 42703 42709 42719 42727 42737 42743 42751 42767 42773 42787 42793 42797 42821 42829 42839 42841 42853 42859 42863 42899 42901 42923 42929 42937 42943 42953 42961 42967 42979 42989 43003 43013 43019 43037 43049 43051 43063 43067 43093 43103 43117 43133 43151 43159 43177 43189 43201 43207 43223 43237 43261 43271 43283 43291 43313 43319 43321 43331 43391 43397 43399 43403 43411 43427 43441 43451 43457 43481 43487 43499 43517 43541 43543 43573 43577 43579 43591 43597 43607 43609 43613 43627 43633 43649 43651 43661 43669 43691 43711 43717 43721 43753 43759 43777 43781 43783 43787 43789 43793 43801 43853 43867 43889 43891 43913 43933 43943 43951 43961 43963 43969 43973 43987 43991 43997 44017 44021 44027 44029 44041 44053 44059 44071 44087 44089 44101 44111 44119 44123 44129 44131 44159 44171 44179 44189 44201 44203 44207 44221 44249 44257 44263 44267 44269 44273 44279 44281 44293 44351 44357 44371 44381 44383 44389 44417 44449 44453 44483 44491 44497 44501 44507 44519 44531 44533 44537 44543 44549 44563 44579 44587 44617 44621 44623 44633 44641 44647 44651 44657 44683 44687 44699 44701 44711 44729 44741 44753 44771 44773 44777 44789 44797 44809 44819 44839 44843 44851 44867 44879 44887 44893 44909 44917 44927 44939 44953 44959 44963 44971 44983 44987 45007 45013 45053 45061 45077 45083 45119 45121 45127 45131 45137 45139 45161 45179 45181 45191 45197 45233 45247 45259 45263 45281 45289 45293 45307 45317 45319 45329 45337 45341 45343 45361 45377 45389 45403 45413 45427 45433 45439 45481 45491 45497 45503 45523 45533 45541 45553 45557 45569 45587 45589 45599 45613 45631 45641 45659 45667 45673 45677 45691 45697 45707 45737 45751 45757 45763 45767 45779 45817 45821 45823 45827 45833 45841 45853 45863 45869 45887 45893 45943 45949 45953 45959 45971 45979 45989 46021 46027 46049 46051 46061 46073 46091 46093 46099 46103 46133 46141 46147 46153 46171 46181 46183 46187 46199 46219 46229 46237 46261 46271 46273 46279 46301 46307 46309 46327 46337 46349 46351 46381 46399 46411 46439 46441 46447 46451 46457 46471 46477 46489 46499 46507 46511 46523 46549 46559 46567 46573 46589 46591 46601 46619 46633 46639 46643 46649 46663 46679 46681 46687 46691 46703 46723 46727 46747 46751 46757 46769 46771 46807 46811 46817 46819 46829 46831 46853 46861 46867 46877 46889 46901 46919 46933 46957 46993 46997 47017 47041 47051 47057 47059 47087 47093 47111 47119 47123 47129 47137 47143 47147 47149 47161 47189 47207 47221 47237 47251 47269 47279 47287 47293 47297 47303 47309 47317 47339 47351 47353 47363 47381 47387 47389 47407 47417 47419 47431 47441 47459 47491 47497 47501 47507 47513 47521 47527 47533 47543 47563 47569 47581 47591 47599 47609 47623 47629 47639 47653 47657 47659 47681 47699 47701 47711 47713 47717 47737 47741 47743 47777 47779 47791 47797 47807 47809 47819 47837 47843 47857 47869 47881 47903 47911 47917 47933 47939 47947 47951 47963 47969 47977 47981 48017 48023 48029 48049 48073 48079 48091 48109 48119 48121 48131 48157 48163 48179 48187 48193 48197 48221 48239 48247 48259 48271 48281 48299 48311 48313 48337 48341 48353 48371 48383 48397 48407 48409 48413 48437 48449 48463 48473 48479 48481 48487 48491 48497 48523 48527 48533 48539 48541 48563 48571 48589 48593 48611 48619 48623 48647 48649 48661 48673 48677 48679 48731 48733 48751 48757 48761 48767 48779 48781 48787 48799 48809 48817 48821 48823 48847 48857 48859 48869 48871 48883 48889 48907 48947 48953 48973 48989 48991 49003 49009 49019 49031 49033 49037 49043 49057 49069 49081 49103 49109 49117 49121 49123 49139 49157 49169 49171 49177 49193 49199 49201 49207 49211 49223 49253 49261 49277 49279 49297 49307 49331 49333 49339 49363 49367 49369 49391 49393 49409 49411 49417 49429 49433 49451 49459 49463 49477 49481 49499 49523 49529 49531 49537 49547 49549 49559 49597 49603 49613 49627 49633 49639 49663 49667 49669 49681 49697 49711 49727 49739 49741 49747 49757 49783 49787 49789 49801 49807 49811 49823 49831 49843 49853 49871 49877 49891 49919 49921 49927 49937 49939 49943 49957 49991 49993 49999
diff --git a/testsuite/tests/misc/sorts.ml b/testsuite/tests/misc/sorts.ml
new file mode 100644
index 00000000..f336181a
--- /dev/null
+++ b/testsuite/tests/misc/sorts.ml
@@ -0,0 +1,4455 @@
+(* TEST
+*)
+
+(* Test bench for sorting algorithms. *)
+
+
+(*
+  ocamlopt -noassert sorts.ml -cclib -lunix
+*)
+
+open Printf;;
+
+(*
+  Criteria:
+  0. stack overhead: at most log n.
+  1. stable or not.
+  2. space overhead.
+  3. speed.
+*)
+
+(************************************************************************)
+(* auxiliary functions *)
+
+let rec exp2 n = if n <= 0 then 1 else 2 * exp2 (n-1);;
+let id x = x;;
+let postl x y = Array.of_list y;;
+let posta x y = x;;
+
+let mkconst n = Array.make n 0;;
+let chkconst _ n a = (a = mkconst n);;
+
+let mksorted n =
+  let a = Array.make n 0 in
+  for i = 0 to n - 1 do
+    a.(i) <- i;
+  done;
+  a
+;;
+let chksorted _ n a = (a = mksorted n);;
+
+let mkrev n =
+  let a = Array.make n 0 in
+  for i = 0 to n - 1 do
+    a.(i) <- n - 1 - i;
+  done;
+  a
+;;
+let chkrev _ n a = (a = mksorted n);;
+
+let seed = ref 0;;
+let random_reinit () = Random.init !seed;;
+
+let random_get_state () =
+  let a = Array.make 55 0 in
+  for i = 0 to 54 do a.(i) <- Random.bits (); done;
+  Random.full_init a;
+  a
+;;
+let random_set_state a = Random.full_init a;;
+
+let chkgen mke cmp rstate n a =
+  let marks = Array.make n (-1) in
+  let skipmarks l =
+    if marks.(l) = -1 then l else begin
+      let m = ref marks.(l) in
+      while marks.(!m) <> -1 do incr m; done;
+      marks.(l) <- !m;
+      !m
+    end
+  in
+  let linear e l =
+    let l = skipmarks l in
+    let rec loop l =
+      if cmp a.(l) e > 0 then raise Exit
+      else if e = a.(l) then marks.(l) <- l+1
+      else loop (l+1)
+    in loop l
+  in
+  let rec dicho e l r =
+    if l = r then linear e l
+    else begin
+      assert (l < r);
+      let m = (l + r) / 2 in
+      if cmp a.(m) e >= 0 then dicho e l m else dicho e (m + 1) r
+    end
+  in
+  try
+    for i = 0 to n-2 do if cmp a.(i) a.(i+1) > 0 then raise Exit; done;
+    random_set_state rstate;
+    for i = 0 to n-1 do dicho (mke i) 0 (Array.length a - 1); done;
+    true
+  with Exit | Invalid_argument _ -> false;
+;;
+
+let mkrand_dup n =
+  let a = Array.make n 0 in
+  for i = 0 to (n-1) do a.(i) <- Random.int n; done;
+  a
+;;
+
+let chkrand_dup rstate n a =
+  chkgen (fun i -> Random.int n) compare rstate n a
+;;
+
+let mkrand_nodup n =
+  let a = Array.make n 0 in
+  for i = 0 to (n-1) do a.(i) <- Random.bits (); done;
+  a
+;;
+
+let chkrand_nodup rstate n a =
+  chkgen (fun i -> Random.bits ()) compare rstate n a
+;;
+
+let mkfloats n =
+  let a = Array.make n 0.0 in
+  for i = 0 to (n-1) do a.(i) <- Random.float 1.0; done;
+  a
+;;
+
+let chkfloats rstate n a =
+  chkgen (fun i -> Random.float 1.0) compare rstate n a
+;;
+
+type record = {
+  s1 : bytes;
+  s2 : bytes;
+  i1 : int;
+  i2 : int;
+};;
+
+let rand_string () =
+  let len = Random.int 10 in
+  let s = Bytes.create len in
+  for i = 0 to len-1 do
+    Bytes.set s i (Char.chr (Random.int 256));
+  done;
+  s
+;;
+
+let mkrec1 b i = {
+  s1 = rand_string ();
+  s2 = rand_string ();
+  i1 = Random.int b;
+  i2 = i;
+};;
+
+let mkrecs b n = Array.init n (mkrec1 b);;
+
+let mkrec1_rev b i = {
+  s1 = rand_string ();
+  s2 = rand_string ();
+  i1 = - i;
+  i2 = i;
+};;
+
+let mkrecs_rev n = Array.init n (mkrec1_rev 0);;
+
+let cmpstr r1 r2 =
+  let c1 = compare r1.s1 r2.s1 in
+  if c1 = 0 then compare r1.s2 r2.s2 else c1
+;;
+let lestr r1 r2 =
+  let c1 = compare r1.s1 r2.s1 in
+  if c1 = 0 then r1.s2 <= r2.s2 else (c1 < 0)
+;;
+let chkstr b rstate n a = chkgen (mkrec1 b) cmpstr rstate n a;;
+
+let cmpint r1 r2 = compare r1.i1 r2.i1;;
+let leint r1 r2 = r1.i1 <= r2.i1;;
+let chkint b rstate n a = chkgen (mkrec1 b) cmpint rstate n a;;
+
+let cmplex r1 r2 =
+  let c1 = compare r1.i1 r2.i1 in
+  if c1 = 0 then compare r1.i2 r2.i2 else c1
+;;
+let lelex r1 r2 =
+  let c1 = compare r1.i1 r2.i1 in
+  if c1 = 0 then r1.i2 <= r2.i2 else (c1 < 0)
+;;
+let chklex b rstate n a = chkgen (mkrec1 b) cmplex rstate n a;;
+
+(************************************************************************)
+
+let lens = [
+  0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 28;
+  100; 127; 128; 129; 193; 506;
+  1000; 1025; 1535; 2323;
+];;
+
+type ('a, 'b, 'c, 'd) aux = {
+  prepf : ('a -> 'a -> int) -> ('a -> 'a -> bool) -> 'b;
+  prepd : 'a array -> 'c;
+  postd : 'a array -> 'd -> 'a array;
+};;
+
+let ll = { prepf = (fun x y -> y); prepd = Array.to_list; postd = postl };;
+let lc = { prepf = (fun x y -> x); prepd = Array.to_list; postd = postl };;
+let al = { prepf = (fun x y -> y); prepd = id; postd = posta };;
+let ac = { prepf = (fun x y -> x); prepd = id; postd = posta };;
+
+type 'a outcome = Value of 'a | Exception of exn;;
+
+let numfailed = ref 0;;
+
+let test1 name f prepdata postdata cmp desc mk chk =
+  random_reinit ();
+  printf "  %s with %s" name desc;
+  let i = ref 0 in
+  List.iter (fun n ->
+      if !i = 0 then printf "\n    "; incr i; if !i > 11 then i := 0;
+      printf "%5d" n; flush stdout;
+      let rstate = random_get_state () in
+      let a = mk n in
+      let input = prepdata a in
+      let output = try Value (f cmp input) with e -> Exception e in
+      printf "."; flush stdout;
+      begin match output with
+      | Value v ->
+         if not (chk rstate n (postdata a v))
+         then (incr numfailed; printf "\n*** FAIL\n")
+      | Exception e ->
+         incr numfailed; printf "\n*** %s\n" (Printexc.to_string e)
+      end;
+      flush stdout;
+    ) lens;
+  printf "\n";
+;;
+
+let test name stable f1 f2 aux1 aux2 =
+  printf "Testing %s...\n" name;
+  let t a b c d = test1 name f1 aux1.prepd aux1.postd a b c d in
+  let cmp = aux1.prepf compare (<=) in
+  t cmp "constant ints" mkconst chkconst;
+  t cmp "sorted ints" mksorted chksorted;
+  t cmp "reverse-sorted ints" mkrev chkrev;
+  t cmp "random ints (many dups)" mkrand_dup chkrand_dup;
+  t cmp "random ints (few dups)" mkrand_nodup chkrand_nodup;
+(*
+  let t a b c d = test1 name f3 aux3.prepd aux3.postd a b c d in
+  t cmp "random floats" mkfloats chkfloats;
+*)
+  let t a b c d = test1 name f2 aux2.prepd aux2.postd a b c d in
+  let cmp = aux2.prepf cmpstr lestr in
+  t cmp "records (str)" (mkrecs 1) (chkstr 1);
+  let cmp = aux2.prepf cmpint leint in
+  List.iter (fun m -> t cmp (sprintf "records (int[%d])" m) (mkrecs m)
+                        (chkint m)
+            ) [1; 10; 100; 1000];
+  if stable then
+    List.iter (fun m -> t cmp (sprintf "records (int[%d]) [stable]" m)
+                          (mkrecs m) (chklex m)
+              ) [1; 10; 100; 1000];
+;;
+
+(************************************************************************)
+
+(* Warning: rpt_timer cannot be used for the array sorts because
+   the sorting functions have effects.
+*)
+
+let rpt_timer1 repeat f x =
+  Gc.compact ();
+  ignore (f x);
+  let st = Sys.time () in
+  for i = 1 to repeat do ignore (f x); done;
+  let en = Sys.time () in
+  en -. st
+;;
+
+let rpt_timer f x =
+  let repeat = ref 1 in
+  let t = ref (rpt_timer1 !repeat f x) in
+  while !t < 0.2 do
+    repeat := 10 * !repeat;
+    t := rpt_timer1 !repeat f x;
+  done;
+  if !t < 2.0 then begin
+    repeat := (int_of_float (10. *. (float !repeat) /. !t) + 1);
+    t := rpt_timer1 !repeat f x;
+  end;
+  !t /. (float !repeat)
+;;
+
+let timer f x =
+  let st = Sys.time () in
+  ignore (f x);
+  let en = Sys.time () in
+  (en -. st)
+;;
+
+let table1 limit f mkarg =
+  printf "  %10s  %9s  %9s  %9s  %9s  %9s\n" "n" "t1" "t2" "t3" "t4" "t5";
+  let sz = ref 49151 in
+  while !sz < int_of_float (2. ** float limit) do
+    begin try
+      printf "  %10d  " !sz; flush stdout;
+      for i = 0 to 4 do
+        let arg = mkarg !sz in
+        let t = timer f arg in
+        printf " %.2e   " t; flush stdout;
+      done;
+      printf "\n";
+    with e -> printf "*** %s\n" (Printexc.to_string e);
+    end;
+    flush stdout;
+    sz := 2 * !sz + 1;
+  done;
+;;
+
+let table2 limit f mkarg =
+  printf "  %10s  %9s  %9s  %9s  %9s  %9s\n"
+         " n" "t" "t/n" "t/nlogn" "t/nlog^2n" "t/n^2";
+  let sz = ref 49151 in
+  while float !sz < 2. ** float limit do
+    begin try
+      printf "  %10d   " !sz; flush stdout;
+      Gc.compact ();
+      let arg = mkarg !sz in
+      let t = timer f arg in
+      let n = float !sz in
+      let logn = log (float !sz) /. log 2. in
+      printf "%.2e   %.2e   %.2e   %.2e   %.2e\n"
+             t (t/.n) (t/.n/.logn) (t/.n/.logn/.logn) (t/.n/.n);
+    with e -> printf "*** %s\n" (Printexc.to_string e);
+    end;
+    flush stdout;
+    sz := 2 * !sz + 1;
+  done;
+;;
+
+let table3 limit f mkarg =
+  printf "  %10s  %9s  %9s  %9s  %9s  %9s\n" "n" "t1" "t2" "t3" "t4" "t5";
+  let sz = ref 2 in
+  while float !sz < 2. ** float limit do
+    begin try
+      printf "  %10d  " !sz; flush stdout;
+      for i = 0 to 4 do
+        let arg = mkarg !sz in
+        let t = rpt_timer f arg in
+        printf " %.2e   " t; flush stdout;
+      done;
+      printf "\n";
+    with e -> printf "*** %s\n" (Printexc.to_string e);
+    end;
+    flush stdout;
+    sz := 2 * !sz + 1;
+  done;
+;;
+
+(************************************************************************)
+
+(* benchmarks:
+   1a. random records, sorted with two keys
+   1b. random integers
+   1c. random floats
+
+   2a. integers, constant
+   2b. integers, already sorted
+   2c. integers, reverse sorted
+
+   only for short lists:
+   3a. random records, sorted with two keys
+   3b. random integers
+   3c. random floats
+*)
+let bench1a limit name f aux =
+
+  (* Don't do benchmarks with assertions enabled. *)
+  assert (not true);
+
+  random_reinit ();
+
+  printf "\n%s with random records [10]:\n" name;
+  let cmp = aux.prepf cmplex lelex in
+  table1 limit (f cmp) (fun n -> aux.prepd (mkrecs 10 n));
+;;
+
+let bench1b limit name f aux =
+
+  (* Don't do benchmarks with assertions enabled. *)
+  assert (not true);
+
+  random_reinit ();
+
+  printf "\n%s with random integers:\n" name;
+  let cmp = aux.prepf (-) (<=) in
+  table1 limit (f cmp) (fun n -> aux.prepd (mkrand_nodup n));
+;;
+
+let bench1c limit name f aux =
+
+  (* Don't do benchmarks with assertions enabled. *)
+  assert (not true);
+
+  random_reinit ();
+
+  printf "\n%s with random floats:\n" name;
+  let cmp = aux.prepf compare (<=) in
+  table1 limit (f cmp) (fun n -> aux.prepd (mkfloats n));
+;;
+
+let bench2 limit name f aux =
+
+  (* Don't do benchmarks with assertions enabled. *)
+  assert (not true);
+
+  printf "\n%s with constant integers:\n" name;
+  let cmp = aux.prepf compare (<=) in
+  table2 limit (f cmp) (fun n -> aux.prepd (mkconst n));
+
+  printf "\n%s with sorted integers:\n" name;
+  let cmp = aux.prepf compare (<=) in
+  table2 limit (f cmp) (fun n -> aux.prepd (mksorted n));
+
+  printf "\n%s with reverse-sorted integers:\n" name;
+  let cmp = aux.prepf compare (<=) in
+  table2 limit (f cmp) (fun n -> aux.prepd (mkrev n));
+;;
+
+let bench3a limit name f aux =
+
+  (* Don't do benchmarks with assertions enabled. *)
+  assert (not true);
+
+  random_reinit ();
+
+  printf "\n%s with random records [10]:\n" name;
+  let cmp = aux.prepf cmplex lelex in
+  table3 limit (f cmp) (fun n -> aux.prepd (mkrecs 10 n));
+;;
+
+let bench3b limit name f aux =
+
+  (* Don't do benchmarks with assertions enabled. *)
+  assert (not true);
+
+  random_reinit ();
+
+  printf "\n%s with random integers:\n" name;
+  let cmp = aux.prepf (-) (<=) in
+  table3 limit (f cmp) (fun n -> aux.prepd (mkrand_nodup n));
+;;
+
+let bench3c limit name f aux =
+
+  (* Don't do benchmarks with assertions enabled. *)
+  assert (not true);
+
+  random_reinit ();
+
+  printf "\n%s with random floats:\n" name;
+  let cmp = aux.prepf compare (<=) in
+  table3 limit (f cmp) (fun n -> aux.prepd (mkfloats n));
+;;
+
+(************************************************************************)
+(* merge sort on lists *)
+
+(* FIXME to do: cutoff
+         to do: cascade pattern-matchings (delete pairs)
+         to do: intermediary closure for merge
+*)
+let (@@) = List.rev_append;;
+
+let lmerge_1a cmp l =
+  let rec init accu = function
+    | [] -> accu
+    | e::rest -> init ([e] :: accu) rest
+  in
+  let rec merge rest accu2 accu l1 l2 = (* l1,l2,rest are forward;
+                                           accu,accu2 are rev *)
+    match l1, l2 with
+    | []    , _      -> mergepairs ((l2 @@ accu)::accu2) rest
+    | _     , []     -> mergepairs ((l1 @@ accu)::accu2) rest
+    | h1::t1, h2::t2 -> if cmp h1 h2 <= 0
+                        then merge rest accu2 (h1::accu) t1 l2
+                        else merge rest accu2 (h2::accu) l1 t2
+  and merge_rev rest accu2 accu l1 l2 = (* accu, accu2 are forward;
+                                           l1,l2,rest are rev *)
+    match l1, l2 with
+    | []    , _      -> mergepairs_rev ((l2 @@ accu)::accu2) rest
+    | _     , []     -> mergepairs_rev ((l1 @@ accu)::accu2) rest
+    | h1::t1, h2::t2 -> if cmp h2 h1 <= 0
+                        then merge_rev rest accu2 (h1::accu) t1 l2
+                        else merge_rev rest accu2 (h2::accu) l1 t2
+  and mergepairs accu = function       (* accu is rev, arg is forward *)
+    | [] -> mergeall_rev accu
+    | [l] -> mergeall_rev ((List.rev l)::accu)
+    | l1::l2::rest -> merge rest accu [] l1 l2
+  and mergepairs_rev accu = function   (* accu is forward, arg is rev *)
+    | [] -> mergeall accu
+    | [l] -> mergeall ((List.rev l)::accu)
+    | l1::l2::rest -> merge_rev rest accu [] l1 l2
+  and mergeall = function              (* arg is forward *)
+    | [] -> []
+    | [l] -> l
+    | llist -> mergepairs [] llist
+  and mergeall_rev = function          (* arg is rev *)
+    | [] -> []
+    | [l] -> List.rev l
+    | llist -> mergepairs_rev [] llist
+  in
+  mergeall_rev (init [] l)
+;;
+
+let lmerge_1b cmp l =
+  let rec init accu = function
+    | [] -> accu
+    | [e] -> [e] :: accu
+    | e1::e2::rest ->
+        init ((if cmp e1 e2 <= 0 then [e2;e1] else [e1;e2])::accu) rest
+  in
+  let rec merge rest accu2 accu l1 l2 = (* l1,l2,rest are forward;
+                                           accu,accu2 are rev *)
+    match l1, l2 with
+    | []    , _      -> mergepairs ((l2 @@ accu)::accu2) rest
+    | _     , []     -> mergepairs ((l1 @@ accu)::accu2) rest
+    | h1::t1, h2::t2 -> if cmp h1 h2 <= 0
+                        then merge rest accu2 (h1::accu) t1 l2
+                        else merge rest accu2 (h2::accu) l1 t2
+  and merge_rev rest accu2 accu l1 l2 = (* accu, accu2 are forward;
+                                           l1,l2,rest are rev *)
+    match l1, l2 with
+    | []    , _      -> mergepairs_rev ((l2 @@ accu)::accu2) rest
+    | _     , []     -> mergepairs_rev ((l1 @@ accu)::accu2) rest
+    | h1::t1, h2::t2 -> if cmp h2 h1 <= 0
+                        then merge_rev rest accu2 (h1::accu) t1 l2
+                        else merge_rev rest accu2 (h2::accu) l1 t2
+  and mergepairs accu = function       (* accu is rev, arg is forward *)
+    | [] -> mergeall_rev accu
+    | [l] -> mergeall_rev ((List.rev l)::accu)
+    | l1::l2::rest -> merge rest accu [] l1 l2
+  and mergepairs_rev accu = function   (* accu is forward, arg is rev *)
+    | [] -> mergeall accu
+    | [l] -> mergeall ((List.rev l)::accu)
+    | l1::l2::rest -> merge_rev rest accu [] l1 l2
+  and mergeall = function              (* arg is forward *)
+    | [] -> []
+    | [l] -> l
+    | llist -> mergepairs [] llist
+  and mergeall_rev = function          (* arg is rev *)
+    | [] -> []
+    | [l] -> List.rev l
+    | llist -> mergepairs_rev [] llist
+  in
+  mergeall_rev (init [] l)
+;;
+
+let lmerge_1c cmp l =
+  let rec init accu = function
+    | [] -> accu
+    | [e] -> [e] :: accu
+    | e1::e2::rest ->
+        init ((if cmp e1 e2 <= 0 then [e2;e1] else [e1;e2])::accu) rest
+  in
+  let rec merge rest accu2 accu l1 l2 = (* l1,l2,rest are forward;
+                                           accu,accu2 are rev *)
+    match l1 with
+    | [] -> mergepairs ((l2 @@ accu)::accu2) rest
+    | h1::t1 ->
+       match l2 with
+       | []     -> mergepairs ((l1 @@ accu)::accu2) rest
+       | h2::t2 -> if cmp h1 h2 <= 0
+                   then merge rest accu2 (h1::accu) t1 l2
+                   else merge rest accu2 (h2::accu) l1 t2
+  and merge_rev rest accu2 accu l1 l2 = (* accu, accu2 are forward;
+                                           l1,l2,rest are rev *)
+    match l1 with
+    | [] -> mergepairs_rev ((l2 @@ accu)::accu2) rest
+    | h1::t1 ->
+       match l2 with
+       | []     -> mergepairs_rev ((l1 @@ accu)::accu2) rest
+       | h2::t2 -> if cmp h2 h1 <= 0
+                   then merge_rev rest accu2 (h1::accu) t1 l2
+                   else merge_rev rest accu2 (h2::accu) l1 t2
+  and mergepairs accu = function       (* accu is rev, arg is forward *)
+    | [] -> mergeall_rev accu
+    | [l] -> mergeall_rev ((List.rev l)::accu)
+    | l1::l2::rest -> merge rest accu [] l1 l2
+  and mergepairs_rev accu = function   (* accu is forward, arg is rev *)
+    | [] -> mergeall accu
+    | [l] -> mergeall ((List.rev l)::accu)
+    | l1::l2::rest -> merge_rev rest accu [] l1 l2
+  and mergeall = function              (* arg is forward *)
+    | [] -> []
+    | [l] -> l
+    | llist -> mergepairs [] llist
+  and mergeall_rev = function          (* arg is rev *)
+    | [] -> []
+    | [l] -> List.rev l
+    | llist -> mergepairs_rev [] llist
+  in
+  mergeall_rev (init [] l)
+;;
+
+let lmerge_1d cmp l =
+  let rec init accu = function
+    | [] -> accu
+    | [e] -> [e] :: accu
+    | e1::e2::rest ->
+        init ((if cmp e1 e2 <= 0 then [e2;e1] else [e1;e2])::accu) rest
+  in
+  let rec merge rest accu2 accu l1 l2 = (* l1,l2,rest are forward;
+                                           accu,accu2 are rev *)
+    let merge_rest_accu2 accu l1 l2 =
+      match l1 with
+      | [] -> mergepairs ((l2 @@ accu)::accu2) rest
+      | h1::t1 ->
+         match l2 with
+         | []     -> mergepairs ((l1 @@ accu)::accu2) rest
+         | h2::t2 -> if cmp h1 h2 <= 0
+                     then merge rest accu2 (h1::accu) t1 l2
+                     else merge rest accu2 (h2::accu) l1 t2
+    in merge_rest_accu2 accu l1 l2
+  and merge_rev rest accu2 accu l1 l2 = (* accu, accu2 are forward;
+                                           l1,l2,rest are rev *)
+    let merge_rev_rest_accu2 accu l1 l2 =
+      match l1 with
+      | [] -> mergepairs_rev ((l2 @@ accu)::accu2) rest
+      | h1::t1 ->
+         match l2 with
+         | []     -> mergepairs_rev ((l1 @@ accu)::accu2) rest
+         | h2::t2 -> if cmp h2 h1 <= 0
+                     then merge_rev rest accu2 (h1::accu) t1 l2
+                     else merge_rev rest accu2 (h2::accu) l1 t2
+    in merge_rev_rest_accu2 accu l1 l2
+  and mergepairs accu = function       (* accu is rev, arg is forward *)
+    | [] -> mergeall_rev accu
+    | [l] -> mergeall_rev ((List.rev l)::accu)
+    | l1::l2::rest -> merge rest accu [] l1 l2
+  and mergepairs_rev accu = function   (* accu is forward, arg is rev *)
+    | [] -> mergeall accu
+    | [l] -> mergeall ((List.rev l)::accu)
+    | l1::l2::rest -> merge_rev rest accu [] l1 l2
+  and mergeall = function              (* arg is forward *)
+    | [] -> []
+    | [l] -> l
+    | llist -> mergepairs [] llist
+  and mergeall_rev = function          (* arg is rev *)
+    | [] -> []
+    | [l] -> List.rev l
+    | llist -> mergepairs_rev [] llist
+  in
+  mergeall_rev (init [] l)
+;;
+
+(************************************************************************)
+(* merge sort on lists, user-contributed (NOT STABLE) *)
+
+(* BEGIN code contributed by Yann Coscoy *)
+
+  let rec rev_merge_append order l1 l2 acc =
+    match l1 with
+      [] ->  List.rev_append l2 acc
+    | h1 :: t1 ->
+        match l2 with
+          [] -> List.rev_append l1 acc
+        | h2 :: t2 ->
+            if order h1 h2
+            then  rev_merge_append order t1 l2 (h1::acc)
+            else  rev_merge_append order l1 t2 (h2::acc)
+
+  let rev_merge order l1 l2 = rev_merge_append order l1 l2 []
+
+  let rec rev_merge_append' order l1 l2 acc =
+    match l1 with
+    | [] ->  List.rev_append l2 acc
+    | h1 :: t1 ->
+        match l2 with
+          | [] -> List.rev_append l1 acc
+          | h2 :: t2 ->
+              if order h2 h1
+              then  rev_merge_append' order t1 l2 (h1::acc)
+              else  rev_merge_append' order l1 t2 (h2::acc)
+
+  let rev_merge' order l1 l2 = rev_merge_append' order l1 l2 []
+
+  let lmerge_3 order l =
+    let rec initlist l acc = match l with
+      | e1::e2::rest ->
+          initlist rest
+           ((if order e1 e2 then [e1;e2] else [e2;e1])::acc)
+      | [e] -> [e]::acc
+      | [] -> acc
+    in
+    let rec merge2 ll acc  = match ll with
+      | [] -> acc
+      | [l] -> [List.rev l]@acc
+      | l1::l2::rest ->
+          merge2 rest (rev_merge order l1 l2::acc)
+    in
+    let rec merge2' ll acc  = match ll with
+      | [] -> acc
+      | [l] -> [List.rev l]@acc
+      | l1::l2::rest ->
+          merge2' rest (rev_merge' order l1 l2::acc)
+    in
+    let rec mergeall rev = function
+      | [] -> []
+      | [l] -> if rev then List.rev l else l
+      | llist ->
+          mergeall
+          (not rev) ((if rev then merge2' else merge2) llist [])
+    in
+    mergeall false (initlist l [])
+
+(* END code contributed by Yann Coscoy *)
+
+(************************************************************************)
+(* merge sort on short lists, Francois Pottier *)
+
+(* BEGIN code contributed by Francois Pottier *)
+
+  (* [chop k l] returns the list [l] deprived of its [k] first
+     elements. The length of the list [l] must be [k] at least. *)
+
+  let rec chop k l =
+    match k, l with
+    | 0, _ -> l
+    | _, x :: l -> chop (k-1) l
+    | _, _ -> assert false
+  ;;
+
+  let rec merge order l1 l2 =
+    match l1 with
+      [] -> l2
+    | h1 :: t1 ->
+        match l2 with
+          [] -> l1
+        | h2 :: t2 ->
+            if order h1 h2
+            then h1 :: merge order t1 l2
+            else h2 :: merge order l1 t2
+  ;;
+
+  let rec lmerge_4a order l =
+    match l with
+    | []
+    | [ _ ] -> l
+    | _ ->
+        let rec sort k l = (* k > 1 *)
+          match k, l with
+          | 2, x1 :: x2 :: _ ->
+              if order x1 x2 then [ x1; x2 ] else [ x2; x1 ]
+          | 3, x1 :: x2 :: x3 :: _ ->
+              if order x1 x2 then
+                if order x2 x3 then
+                  [ x1 ; x2 ; x3 ]
+                else
+                  if order x1 x3 then [ x1 ; x3 ; x2 ] else [ x3; x1; x2 ]
+              else
+                if order x1 x3 then
+                  [ x2; x1; x3 ]
+                else
+                  if order x2 x3 then [ x2; x3; x1 ] else [ x3; x2; x1 ]
+          | _, _ ->
+              let k1 = k / 2 in
+              let k2 = k - k1 in
+              merge order (sort k1 l) (sort k2 (chop k1 l))
+        in
+        sort (List.length l) l
+  ;;
+(* END code contributed by Francois Pottier *)
+
+(************************************************************************)
+(* merge sort on short lists, Francois Pottier,
+   adapted to new-style interface *)
+
+(* BEGIN code contributed by Francois Pottier *)
+
+  (* [chop k l] returns the list [l] deprived of its [k] first
+     elements. The length of the list [l] must be [k] at least. *)
+
+  let rec chop k l =
+    match k, l with
+    | 0, _ -> l
+    | _, x :: l -> chop (k-1) l
+    | _, _ -> assert false
+  ;;
+
+  let rec merge order l1 l2 =
+    match l1 with
+      [] -> l2
+    | h1 :: t1 ->
+        match l2 with
+          [] -> l1
+        | h2 :: t2 ->
+            if order h1 h2 <= 0
+            then h1 :: merge order t1 l2
+            else h2 :: merge order l1 t2
+  ;;
+
+  let rec lmerge_4b order l =
+    match l with
+    | []
+    | [ _ ] -> l
+    | _ ->
+        let rec sort k l = (* k > 1 *)
+          match k, l with
+          | 2, x1 :: x2 :: _ ->
+              if order x1 x2 <= 0 then [ x1; x2 ] else [ x2; x1 ]
+          | 3, x1 :: x2 :: x3 :: _ ->
+              if order x1 x2 <= 0 then
+                if order x2 x3 <= 0 then
+                  [ x1 ; x2 ; x3 ]
+                else
+                  if order x1 x3 <= 0 then [ x1 ; x3 ; x2 ] else [ x3; x1; x2 ]
+              else
+                if order x1 x3 <= 0 then
+                  [ x2; x1; x3 ]
+                else
+                  if order x2 x3 <= 0 then [ x2; x3; x1 ] else [ x3; x2; x1 ]
+          | _, _ ->
+              let k1 = k / 2 in
+              let k2 = k - k1 in
+              merge order (sort k1 l) (sort k2 (chop k1 l))
+        in
+        sort (List.length l) l
+  ;;
+(* END code contributed by Francois Pottier *)
+
+(************************************************************************)
+(* merge sort on short lists a la Pottier, modified merge *)
+
+let rec chop k l =
+  if k = 0 then l else begin
+    match l with
+    | x::t -> chop (k-1) t
+    | _ -> assert false
+  end
+;;
+
+let lmerge_4c cmp l =
+  let rec merge1 h1 t1 l2 =
+    match l2 with
+    | [] -> h1 :: t1
+    | h2 :: t2 ->
+        if cmp h1 h2 <= 0
+        then h1 :: (merge2 t1 h2 t2)
+        else h2 :: (merge1 h1 t1 t2)
+  and merge2 l1 h2 t2 =
+    match l1 with
+    | [] -> h2 :: t2
+    | h1 :: t1 ->
+        if cmp h1 h2 <= 0
+        then h1 :: (merge2 t1 h2 t2)
+        else h2 :: (merge1 h1 t1 t2)
+  in
+  let merge l1 = function
+    | [] -> l1
+    | h2 :: t2 -> merge2 l1 h2 t2
+  in
+  let rec sort n l =
+    match n, l with
+    | 2, x1 :: x2 :: _ ->
+       if cmp x1 x2 <= 0 then [x1; x2] else [x2; x1]
+    | 3, x1 :: x2 :: x3 :: _ ->
+       if cmp x1 x2 <= 0 then begin
+         if cmp x2 x3 <= 0 then [x1; x2; x3]
+         else if cmp x1 x3 <= 0 then [x1; x3; x2]
+         else [x3; x1; x2]
+       end else begin
+         if cmp x1 x3 <= 0 then [x2; x1; x3]
+         else if cmp x2 x3 <= 0 then [x2; x3; x1]
+         else [x3; x2; x1]
+       end
+    | n, l ->
+       let n1 = n asr 1 in
+       let n2 = n - n1 in
+       merge (sort n1 l) (sort n2 (chop n1 l))
+  in
+  let len = List.length l in
+  if len < 2 then l else sort len l
+;;
+
+(************************************************************************)
+(* merge sort on short lists a la Pottier, logarithmic stack space *)
+
+let rec chop k l =
+  if k = 0 then l else begin
+    match l with
+    | x::t -> chop (k-1) t
+    | _ -> assert false
+  end
+;;
+
+let lmerge_4d cmp l =
+  let rec rev_merge l1 l2 accu =
+    match l1, l2 with
+    | [], l2 -> l2 @@ accu
+    | l1, [] -> l1 @@ accu
+    | h1::t1, h2::t2 ->
+        if cmp h1 h2 <= 0
+        then rev_merge t1 l2 (h1::accu)
+        else rev_merge l1 t2 (h2::accu)
+  in
+  let rec rev_merge_rev l1 l2 accu =
+    match l1, l2 with
+    | [], l2 -> l2 @@ accu
+    | l1, [] -> l1 @@ accu
+    | h1::t1, h2::t2 ->
+        if cmp h1 h2 > 0
+        then rev_merge_rev t1 l2 (h1::accu)
+        else rev_merge_rev l1 t2 (h2::accu)
+  in
+  let rec sort n l =
+    match n, l with
+    | 2, x1 :: x2 :: _ ->
+       if cmp x1 x2 <= 0 then [x1; x2] else [x2; x1]
+    | 3, x1 :: x2 :: x3 :: _ ->
+       if cmp x1 x2 <= 0 then begin
+         if cmp x2 x3 <= 0 then [x1; x2; x3]
+         else if cmp x1 x3 <= 0 then [x1; x3; x2]
+         else [x3; x1; x2]
+       end else begin
+         if cmp x1 x3 <= 0 then [x2; x1; x3]
+         else if cmp x2 x3 <= 0 then [x2; x3; x1]
+         else [x3; x2; x1]
+       end
+    | n, l ->
+       let n1 = n asr 1 in
+       let n2 = n - n1 in
+       rev_merge_rev (rev_sort n1 l) (rev_sort n2 (chop n1 l)) []
+  and rev_sort n l =
+    match n, l with
+    | 2, x1 :: x2 :: _ ->
+       if cmp x1 x2 > 0 then [x1; x2] else [x2; x1]
+    | 3, x1 :: x2 :: x3 :: _ ->
+       if cmp x1 x2 > 0 then begin
+         if cmp x2 x3 > 0 then [x1; x2; x3]
+         else if cmp x1 x3 > 0 then [x1; x3; x2]
+         else [x3; x1; x2]
+       end else begin
+         if cmp x1 x3 > 0 then [x2; x1; x3]
+         else if cmp x2 x3 > 0 then [x2; x3; x1]
+         else [x3; x2; x1]
+       end
+    | n, l ->
+       let n1 = n asr 1 in
+       let n2 = n - n1 in
+       rev_merge (sort n1 l) (sort n2 (chop n1 l)) []
+  in
+  let len = List.length l in
+  if len < 2 then l else sort len l
+;;
+
+
+(************************************************************************)
+(* merge sort on short lists a la Pottier, logarithmic stack space,
+   in place: input list is freed as the output is being computed. *)
+
+let rec chop k l =
+  if k = 0 then l else begin
+    match l with
+    | x::t -> chop (k-1) t
+    | _ -> assert false
+  end
+;;
+
+let lmerge_4e cmp l =
+  let rec rev_merge l1 l2 accu =
+    match l1, l2 with
+    | [], l2 -> l2 @@ accu
+    | l1, [] -> l1 @@ accu
+    | h1::t1, h2::t2 ->
+        if cmp h1 h2 <= 0
+        then rev_merge t1 l2 (h1::accu)
+        else rev_merge l1 t2 (h2::accu)
+  in
+  let rec rev_merge_rev l1 l2 accu =
+    match l1, l2 with
+    | [], l2 -> l2 @@ accu
+    | l1, [] -> l1 @@ accu
+    | h1::t1, h2::t2 ->
+        if cmp h1 h2 > 0
+        then rev_merge_rev t1 l2 (h1::accu)
+        else rev_merge_rev l1 t2 (h2::accu)
+  in
+  let rec sort n l =
+    match n, l with
+    | 2, x1 :: x2 :: _ ->
+       if cmp x1 x2 <= 0 then [x1; x2] else [x2; x1]
+    | 3, x1 :: x2 :: x3 :: _ ->
+       if cmp x1 x2 <= 0 then begin
+         if cmp x2 x3 <= 0 then [x1; x2; x3]
+         else if cmp x1 x3 <= 0 then [x1; x3; x2]
+         else [x3; x1; x2]
+       end else begin
+         if cmp x1 x3 <= 0 then [x2; x1; x3]
+         else if cmp x2 x3 <= 0 then [x2; x3; x1]
+         else [x3; x2; x1]
+       end
+    | n, l ->
+       let n1 = n asr 1 in
+       let n2 = n - n1 in
+       let l2 = chop n1 l in
+       let s1 = rev_sort n1 l in
+       let s2 = rev_sort n2 l2 in
+       rev_merge_rev s1 s2 []
+  and rev_sort n l =
+    match n, l with
+    | 2, x1 :: x2 :: _ ->
+       if cmp x1 x2 > 0 then [x1; x2] else [x2; x1]
+    | 3, x1 :: x2 :: x3 :: _ ->
+       if cmp x1 x2 > 0 then begin
+         if cmp x2 x3 > 0 then [x1; x2; x3]
+         else if cmp x1 x3 > 0 then [x1; x3; x2]
+         else [x3; x1; x2]
+       end else begin
+         if cmp x1 x3 > 0 then [x2; x1; x3]
+         else if cmp x2 x3 > 0 then [x2; x3; x1]
+         else [x3; x2; x1]
+       end
+    | n, l ->
+       let n1 = n asr 1 in
+       let n2 = n - n1 in
+       let l2 = chop n1 l in
+       let s1 = sort n1 l in
+       let s2 = sort n2 l2 in
+       rev_merge s1 s2 []
+  in
+  let len = List.length l in
+  if len < 2 then l else sort len l
+;;
+
+(************************************************************************)
+(* chop-free version of Pottier's code, binary version *)
+
+let rec merge cmp l1 l2 =
+  match l1, l2 with
+  | [], l2 -> l2
+  | l1, [] -> l1
+  | h1 :: t1, h2 :: t2 ->
+      if cmp h1 h2 <= 0
+      then h1 :: merge cmp t1 l2
+      else h2 :: merge cmp l1 t2
+;;
+
+let lmerge_5a cmp l =
+  let rem = ref l in
+  let rec sort_prefix n =
+    if n <= 1 then begin
+      match !rem with
+      | [] -> []
+      | [x] as l -> rem := []; l
+      | x::y::t -> rem := t; if cmp x y <= 0 then [x;y] else [y;x]
+    end else if !rem = [] then []
+    else begin
+      let l1 = sort_prefix (n-1) in
+      let l2 = sort_prefix (n-1) in
+      merge cmp l1 l2
+    end
+  in
+  let len = ref (List.length l) in
+  let i = ref 0 in
+  while !len > 0 do incr i; len := !len lsr 1; done;
+  sort_prefix !i
+;;
+
+(************************************************************************)
+(* chop-free version of Pottier's code, dichotomic version,
+   ground cases 1 & 2 *)
+
+let rec merge cmp l1 l2 =
+  match l1, l2 with
+  | [], l2 -> l2
+  | l1, [] -> l1
+  | h1 :: t1, h2 :: t2 ->
+      if cmp h1 h2 <= 0
+      then h1 :: merge cmp t1 l2
+      else h2 :: merge cmp l1 t2
+;;
+
+let lmerge_5b cmp l =
+  let rem = ref l in
+  let rec sort_prefix n =
+    match n, !rem with
+    | 1, x::t -> rem := t; [x]
+    | 2, x::y::t -> rem := t; if cmp x y <= 0 then [x;y] else [y;x]
+    | n, _ ->
+       let n1 = n/2 in
+       let n2 = n - n1 in
+       let l1 = sort_prefix n1 in
+       let l2 = sort_prefix n2 in
+       merge cmp l1 l2
+  in
+  let len = List.length l in
+  if len <= 1 then l else sort_prefix len
+;;
+
+(************************************************************************)
+(* chop-free version of Pottier's code, dichotomic version,
+   ground cases 2 & 3 *)
+
+let rec merge cmp l1 l2 =
+  match l1, l2 with
+  | [], l2 -> l2
+  | l1, [] -> l1
+  | h1 :: t1, h2 :: t2 ->
+      if cmp h1 h2 <= 0
+      then h1 :: merge cmp t1 l2
+      else h2 :: merge cmp l1 t2
+;;
+
+let lmerge_5c cmp l =
+  let rem = ref l in
+  let rec sort_prefix n =
+    match n, !rem with
+    | 2, x::y::t -> rem := t; if cmp x y <= 0 then [x;y] else [y;x]
+    | 3, x::y::z::t ->
+       rem := t;
+       if cmp x y <= 0 then
+         if cmp y z <= 0 then [x; y; z]
+         else if cmp x z <= 0 then [x; z; y]
+         else [z; x; y]
+       else
+         if cmp x z <= 0 then [y; x; z]
+         else if cmp y z <= 0 then [y; z; x]
+         else [z; y; x]
+    | n, _ ->
+       let n1 = n/2 in
+       let n2 = n - n1 in
+       let l1 = sort_prefix n1 in
+       let l2 = sort_prefix n2 in
+       merge cmp l1 l2
+  in
+  let len = List.length l in
+  if len <= 1 then l else sort_prefix len
+;;
+
+(************************************************************************)
+(* chop-free, ref-free version of Pottier's code, dichotomic version,
+   ground cases 2 & 3, modified merge *)
+
+let lmerge_5d cmp l =
+  let rec merge1 h1 t1 l2 =
+    match l2 with
+    | [] -> h1::t1
+    | h2 :: t2 ->
+        if cmp h1 h2 <= 0
+        then h1 :: merge2 t1 h2 t2
+        else h2 :: merge1 h1 t1 t2
+  and merge2 l1 h2 t2 =
+    match l1 with
+    | [] -> h2::t2
+    | h1 :: t1 ->
+        if cmp h1 h2 <= 0
+        then h1 :: merge2 t1 h2 t2
+        else h2 :: merge1 h1 t1 t2
+  in
+  let rec sort_prefix n l =
+    match n, l with
+    | 2, x::y::t -> ((if cmp x y <= 0 then [x;y] else [y;x]), t)
+    | 3, x::y::z::t ->
+       ((if cmp x y <= 0 then
+           if cmp y z <= 0 then [x; y; z]
+           else if cmp x z <= 0 then [x; z; y]
+           else [z; x; y]
+         else
+           if cmp x z <= 0 then [y; x; z]
+           else if cmp y z <= 0 then [y; z; x]
+           else [z; y; x]),
+        t)
+    | n, _ ->
+       let n1 = n/2 in
+       let n2 = n - n1 in
+       let (l1, rest1) = sort_prefix n1 l in
+       match sort_prefix n2 rest1 with
+       | (h2::t2, rest2) -> ((merge2 l1 h2 t2), rest2)
+       | _ -> assert false
+  in
+  let len = List.length l in
+  if len <= 1 then l else fst (sort_prefix len l)
+;;
+
+(************************************************************************)
+(* merge sort on arrays, merge with tail-rec function *)
+
+let amerge_1a cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
+    let rec loop i1 s1 i2 s2 d =
+      if cmp s1 s2 <= 0 then begin
+        dst.(d) <- s1;
+        let i1 = i1 + 1 in
+        if i1 < src1r then
+          loop i1 a.(i1) i2 s2 (d + 1)
+        else
+          Array.blit src2 i2 dst (d + 1) (src2r - i2)
+      end else begin
+        dst.(d) <- s2;
+        let i2 = i2 + 1 in
+        if i2 < src2r then
+          loop i1 s1 i2 src2.(i2) (d + 1)
+        else
+          Array.blit a i1 dst (d + 1) (src1r - i1)
+      end
+    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
+  in
+  let rec sortto srcofs dst dstofs len =
+    assert (len > 0);
+    if len = 1 then dst.(dstofs) <- a.(srcofs)
+    else begin
+      let l1 = len / 2 in
+      let l2 = len - l1 in
+      sortto (srcofs + l1) dst (dstofs + l1) l2;
+      sortto srcofs a (srcofs + l2) l1;
+      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
+    end;
+  in
+  let l = Array.length a in
+  if l <= 1 then ()
+  else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let amerge_1b cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
+    let rec loop i1 s1 i2 s2 d =
+      if cmp s1 s2 <= 0 then begin
+        dst.(d) <- s1;
+        let i1 = i1 + 1 in
+        if i1 < src1r then
+          loop i1 a.(i1) i2 s2 (d + 1)
+        else
+          Array.blit src2 i2 dst (d + 1) (src2r - i2)
+      end else begin
+        dst.(d) <- s2;
+        let i2 = i2 + 1 in
+        if i2 < src2r then
+          loop i1 s1 i2 src2.(i2) (d + 1)
+        else
+          Array.blit a i1 dst (d + 1) (src1r - i1)
+      end
+    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
+  in
+  let rec sortto srcofs dst dstofs len =
+    assert (len > 0);
+    if len = 1 then dst.(dstofs) <- a.(srcofs)
+    else if len = 2 then begin
+      if cmp a.(srcofs) a.(srcofs+1) <= 0 then begin
+        dst.(dstofs) <- a.(srcofs);
+        dst.(dstofs+1) <- a.(srcofs+1);
+      end else begin
+        dst.(dstofs) <- a.(srcofs+1);
+        dst.(dstofs+1) <- a.(srcofs);
+      end;
+    end else begin
+      let l1 = len / 2 in
+      let l2 = len - l1 in
+      sortto (srcofs + l1) dst (dstofs + l1) l2;
+      sortto srcofs a (srcofs + l2) l1;
+      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
+    end;
+  in
+  let l = Array.length a in
+  if l <= 1 then ()
+  else if l = 2 then begin
+    if cmp a.(0) a.(1) > 0 then begin
+      let e = a.(0) in
+      a.(0) <- a.(1);
+      a.(1) <- e;
+    end;
+  end else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 3;;
+let amerge_1c cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
+    let rec loop i1 s1 i2 s2 d =
+      if cmp s1 s2 <= 0 then begin
+        dst.(d) <- s1;
+        let i1 = i1 + 1 in
+        if i1 < src1r then
+          loop i1 a.(i1) i2 s2 (d + 1)
+        else
+          Array.blit src2 i2 dst (d + 1) (src2r - i2)
+      end else begin
+        dst.(d) <- s2;
+        let i2 = i2 + 1 in
+        if i2 < src2r then
+          loop i1 s1 i2 src2.(i2) (d + 1)
+        else
+          Array.blit a i1 dst (d + 1) (src1r - i1)
+      end
+    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len - 1 do
+      let e = a.(srcofs + i) in
+      let j = ref (dstofs + i - 1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else begin
+      let l1 = len / 2 in
+      let l2 = len - l1 in
+      sortto (srcofs + l1) dst (dstofs + l1) l2;
+      sortto srcofs a (srcofs + l2) l1;
+      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
+    end;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 4;;
+let amerge_1d cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
+    let rec loop i1 s1 i2 s2 d =
+      if cmp s1 s2 <= 0 then begin
+        dst.(d) <- s1;
+        let i1 = i1 + 1 in
+        if i1 < src1r then
+          loop i1 a.(i1) i2 s2 (d + 1)
+        else
+          Array.blit src2 i2 dst (d + 1) (src2r - i2)
+      end else begin
+        dst.(d) <- s2;
+        let i2 = i2 + 1 in
+        if i2 < src2r then
+          loop i1 s1 i2 src2.(i2) (d + 1)
+        else
+          Array.blit a i1 dst (d + 1) (src1r - i1)
+      end
+    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len - 1 do
+      let e = a.(srcofs + i) in
+      let j = ref (dstofs + i - 1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else begin
+      let l1 = len / 2 in
+      let l2 = len - l1 in
+      sortto (srcofs + l1) dst (dstofs + l1) l2;
+      sortto srcofs a (srcofs + l2) l1;
+      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
+    end;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 5;;
+let amerge_1e cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
+    let rec loop i1 s1 i2 s2 d =
+      if cmp s1 s2 <= 0 then begin
+        dst.(d) <- s1;
+        let i1 = i1 + 1 in
+        if i1 < src1r then
+          loop i1 a.(i1) i2 s2 (d + 1)
+        else
+          Array.blit src2 i2 dst (d + 1) (src2r - i2)
+      end else begin
+        dst.(d) <- s2;
+        let i2 = i2 + 1 in
+        if i2 < src2r then
+          loop i1 s1 i2 src2.(i2) (d + 1)
+        else
+          Array.blit a i1 dst (d + 1) (src1r - i1)
+      end
+    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len - 1 do
+      let e = a.(srcofs + i) in
+      let j = ref (dstofs + i - 1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else begin
+      let l1 = len / 2 in
+      let l2 = len - l1 in
+      sortto (srcofs + l1) dst (dstofs + l1) l2;
+      sortto srcofs a (srcofs + l2) l1;
+      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
+    end;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 6;;
+let amerge_1f cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
+    let rec loop i1 s1 i2 s2 d =
+      if cmp s1 s2 <= 0 then begin
+        dst.(d) <- s1;
+        let i1 = i1 + 1 in
+        if i1 < src1r then
+          loop i1 a.(i1) i2 s2 (d + 1)
+        else
+          Array.blit src2 i2 dst (d + 1) (src2r - i2)
+      end else begin
+        dst.(d) <- s2;
+        let i2 = i2 + 1 in
+        if i2 < src2r then
+          loop i1 s1 i2 src2.(i2) (d + 1)
+        else
+          Array.blit a i1 dst (d + 1) (src1r - i1)
+      end
+    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len - 1 do
+      let e = a.(srcofs + i) in
+      let j = ref (dstofs + i - 1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else begin
+      let l1 = len / 2 in
+      let l2 = len - l1 in
+      sortto (srcofs + l1) dst (dstofs + l1) l2;
+      sortto srcofs a (srcofs + l2) l1;
+      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
+    end;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 7;;
+let amerge_1g cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
+    let rec loop i1 s1 i2 s2 d =
+      if cmp s1 s2 <= 0 then begin
+        dst.(d) <- s1;
+        let i1 = i1 + 1 in
+        if i1 < src1r then
+          loop i1 a.(i1) i2 s2 (d + 1)
+        else
+          Array.blit src2 i2 dst (d + 1) (src2r - i2)
+      end else begin
+        dst.(d) <- s2;
+        let i2 = i2 + 1 in
+        if i2 < src2r then
+          loop i1 s1 i2 src2.(i2) (d + 1)
+        else
+          Array.blit a i1 dst (d + 1) (src1r - i1)
+      end
+    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len - 1 do
+      let e = a.(srcofs + i) in
+      let j = ref (dstofs + i - 1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else begin
+      let l1 = len / 2 in
+      let l2 = len - l1 in
+      sortto (srcofs + l1) dst (dstofs + l1) l2;
+      sortto srcofs a (srcofs + l2) l1;
+      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
+    end;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 8;;
+let amerge_1h cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
+    let rec loop i1 s1 i2 s2 d =
+      if cmp s1 s2 <= 0 then begin
+        dst.(d) <- s1;
+        let i1 = i1 + 1 in
+        if i1 < src1r then
+          loop i1 a.(i1) i2 s2 (d + 1)
+        else
+          Array.blit src2 i2 dst (d + 1) (src2r - i2)
+      end else begin
+        dst.(d) <- s2;
+        let i2 = i2 + 1 in
+        if i2 < src2r then
+          loop i1 s1 i2 src2.(i2) (d + 1)
+        else
+          Array.blit a i1 dst (d + 1) (src1r - i1)
+      end
+    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len - 1 do
+      let e = a.(srcofs + i) in
+      let j = ref (dstofs + i - 1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else begin
+      let l1 = len / 2 in
+      let l2 = len - l1 in
+      sortto (srcofs + l1) dst (dstofs + l1) l2;
+      sortto srcofs a (srcofs + l2) l1;
+      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
+    end;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 9;;
+let amerge_1i cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
+    let rec loop i1 s1 i2 s2 d =
+      if cmp s1 s2 <= 0 then begin
+        dst.(d) <- s1;
+        let i1 = i1 + 1 in
+        if i1 < src1r then
+          loop i1 a.(i1) i2 s2 (d + 1)
+        else
+          Array.blit src2 i2 dst (d + 1) (src2r - i2)
+      end else begin
+        dst.(d) <- s2;
+        let i2 = i2 + 1 in
+        if i2 < src2r then
+          loop i1 s1 i2 src2.(i2) (d + 1)
+        else
+          Array.blit a i1 dst (d + 1) (src1r - i1)
+      end
+    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len - 1 do
+      let e = a.(srcofs + i) in
+      let j = ref (dstofs + i - 1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else begin
+      let l1 = len / 2 in
+      let l2 = len - l1 in
+      sortto (srcofs + l1) dst (dstofs + l1) l2;
+      sortto srcofs a (srcofs + l2) l1;
+      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
+    end;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 10;;
+let amerge_1j cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
+    let rec loop i1 s1 i2 s2 d =
+      if cmp s1 s2 <= 0 then begin
+        dst.(d) <- s1;
+        let i1 = i1 + 1 in
+        if i1 < src1r then
+          loop i1 a.(i1) i2 s2 (d + 1)
+        else
+          Array.blit src2 i2 dst (d + 1) (src2r - i2)
+      end else begin
+        dst.(d) <- s2;
+        let i2 = i2 + 1 in
+        if i2 < src2r then
+          loop i1 s1 i2 src2.(i2) (d + 1)
+        else
+          Array.blit a i1 dst (d + 1) (src1r - i1)
+      end
+    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len - 1 do
+      let e = a.(srcofs + i) in
+      let j = ref (dstofs + i - 1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else begin
+      let l1 = len / 2 in
+      let l2 = len - l1 in
+      sortto (srcofs + l1) dst (dstofs + l1) l2;
+      sortto srcofs a (srcofs + l2) l1;
+      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
+    end;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+(* FIXME try: *)
+(* list->array->list direct and array->list->array direct *)
+(* overhead = 1/3, 1/4, etc. *)
+(* overhead = sqrt (n) *)
+(* overhead = n/3 up to 30k, 30k up to 900M, sqrt (n) beyond *)
+
+(************************************************************************)
+(* merge sort on arrays, merge with loop *)
+
+(* cutoff = 1 *)
+let amerge_3a cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let i1 = ref src1ofs
+    and i2 = ref src2ofs
+    and d = ref dstofs
+    and src1r = src1ofs + src1len
+    and src2r = src2ofs + src2len
+    in
+    while !i1 < src1r && !i2 < src2r do
+      let s1 = a.(!i1) and s2 = src2.(!i2) in
+      if cmp s1 s2 <= 0 then begin
+        dst.(!d) <- s1;
+        incr i1;
+      end else begin
+        dst.(!d) <- s2;
+        incr i2;
+      end;
+      incr d;
+    done;
+    if !i1 < src1r then
+      Array.blit a !i1 dst !d (src1r - !i1)
+    else
+      Array.blit src2 !i2 dst !d (src2r - !i2)
+  in
+  let rec sortto srcofs dst dstofs len =
+    assert (len > 0);
+    if len = 1 then dst.(dstofs) <- a.(srcofs) else
+    let l1 = len / 2 in
+    let l2 = len - l1 in
+    sortto (srcofs+l1) dst (dstofs+l1) l2;
+    sortto srcofs a (srcofs+l2) l1;
+    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
+  in
+  let l = Array.length a in
+  if l <= 1 then () else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let amerge_3b cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let i1 = ref src1ofs
+    and i2 = ref src2ofs
+    and d = ref dstofs
+    and src1r = src1ofs + src1len
+    and src2r = src2ofs + src2len
+    in
+    while !i1 < src1r && !i2 < src2r do
+      let s1 = a.(!i1) and s2 = src2.(!i2) in
+      if cmp s1 s2 <= 0 then begin
+        dst.(!d) <- s1;
+        incr i1;
+      end else begin
+        dst.(!d) <- s2;
+        incr i2;
+      end;
+      incr d;
+    done;
+    if !i1 < src1r then
+      Array.blit a !i1 dst !d (src1r - !i1)
+    else
+      Array.blit src2 !i2 dst !d (src2r - !i2)
+  in
+  let rec sortto srcofs dst dstofs len =
+    assert (len > 0);
+    if len = 1 then dst.(dstofs) <- a.(srcofs)
+    else if len = 2 then begin
+      if cmp a.(srcofs) a.(srcofs+1) <= 0 then begin
+        dst.(dstofs) <- a.(srcofs);
+        dst.(dstofs+1) <- a.(srcofs+1);
+      end else begin
+        dst.(dstofs) <- a.(srcofs+1);
+        dst.(dstofs+1) <- a.(srcofs);
+      end
+    end else begin
+      let l1 = len / 2 in
+      let l2 = len - l1 in
+      sortto (srcofs+l1) dst (dstofs+l1) l2;
+      sortto srcofs a (srcofs+l2) l1;
+      merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
+    end
+  in
+  let l = Array.length a in
+  if l <= 1 then ()
+  else if l = 2 then begin
+    if cmp a.(0) a.(1) > 0 then begin
+      let e = a.(0) in
+      a.(0) <- a.(1);
+      a.(1) <- e;
+    end;
+  end else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 3;;
+let amerge_3c cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let i1 = ref src1ofs
+    and i2 = ref src2ofs
+    and d = ref dstofs
+    and src1r = src1ofs + src1len
+    and src2r = src2ofs + src2len
+    in
+    while !i1 < src1r && !i2 < src2r do
+      let s1 = a.(!i1) and s2 = src2.(!i2) in
+      if cmp s1 s2 <= 0 then begin
+        dst.(!d) <- s1;
+        incr i1;
+      end else begin
+        dst.(!d) <- s2;
+        incr i2;
+      end;
+      incr d;
+    done;
+    if !i1 < src1r then
+      Array.blit a !i1 dst !d (src1r - !i1)
+    else
+      Array.blit src2 !i2 dst !d (src2r - !i2)
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len-1 do
+      let e = a.(srcofs+i) in
+      let j = ref (dstofs+i-1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else
+    let l1 = len / 2 in
+    let l2 = len - l1 in
+    sortto (srcofs+l1) dst (dstofs+l1) l2;
+    sortto srcofs a (srcofs+l2) l1;
+    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 4;;
+let amerge_3d cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let i1 = ref src1ofs
+    and i2 = ref src2ofs
+    and d = ref dstofs
+    and src1r = src1ofs + src1len
+    and src2r = src2ofs + src2len
+    in
+    while !i1 < src1r && !i2 < src2r do
+      let s1 = a.(!i1) and s2 = src2.(!i2) in
+      if cmp s1 s2 <= 0 then begin
+        dst.(!d) <- s1;
+        incr i1;
+      end else begin
+        dst.(!d) <- s2;
+        incr i2;
+      end;
+      incr d;
+    done;
+    if !i1 < src1r then
+      Array.blit a !i1 dst !d (src1r - !i1)
+    else
+      Array.blit src2 !i2 dst !d (src2r - !i2)
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len-1 do
+      let e = a.(srcofs+i) in
+      let j = ref (dstofs+i-1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else
+    let l1 = len / 2 in
+    let l2 = len - l1 in
+    sortto (srcofs+l1) dst (dstofs+l1) l2;
+    sortto srcofs a (srcofs+l2) l1;
+    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 5;;
+let amerge_3e cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let i1 = ref src1ofs
+    and i2 = ref src2ofs
+    and d = ref dstofs
+    and src1r = src1ofs + src1len
+    and src2r = src2ofs + src2len
+    in
+    while !i1 < src1r && !i2 < src2r do
+      let s1 = a.(!i1) and s2 = src2.(!i2) in
+      if cmp s1 s2 <= 0 then begin
+        dst.(!d) <- s1;
+        incr i1;
+      end else begin
+        dst.(!d) <- s2;
+        incr i2;
+      end;
+      incr d;
+    done;
+    if !i1 < src1r then
+      Array.blit a !i1 dst !d (src1r - !i1)
+    else
+      Array.blit src2 !i2 dst !d (src2r - !i2)
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len-1 do
+      let e = a.(srcofs+i) in
+      let j = ref (dstofs+i-1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else
+    let l1 = len / 2 in
+    let l2 = len - l1 in
+    sortto (srcofs+l1) dst (dstofs+l1) l2;
+    sortto srcofs a (srcofs+l2) l1;
+    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 6;;
+let amerge_3f cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let i1 = ref src1ofs
+    and i2 = ref src2ofs
+    and d = ref dstofs
+    and src1r = src1ofs + src1len
+    and src2r = src2ofs + src2len
+    in
+    while !i1 < src1r && !i2 < src2r do
+      let s1 = a.(!i1) and s2 = src2.(!i2) in
+      if cmp s1 s2 <= 0 then begin
+        dst.(!d) <- s1;
+        incr i1;
+      end else begin
+        dst.(!d) <- s2;
+        incr i2;
+      end;
+      incr d;
+    done;
+    if !i1 < src1r then
+      Array.blit a !i1 dst !d (src1r - !i1)
+    else
+      Array.blit src2 !i2 dst !d (src2r - !i2)
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len-1 do
+      let e = a.(srcofs+i) in
+      let j = ref (dstofs+i-1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else
+    let l1 = len / 2 in
+    let l2 = len - l1 in
+    sortto (srcofs+l1) dst (dstofs+l1) l2;
+    sortto srcofs a (srcofs+l2) l1;
+    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 7;;
+let amerge_3g cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let i1 = ref src1ofs
+    and i2 = ref src2ofs
+    and d = ref dstofs
+    and src1r = src1ofs + src1len
+    and src2r = src2ofs + src2len
+    in
+    while !i1 < src1r && !i2 < src2r do
+      let s1 = a.(!i1) and s2 = src2.(!i2) in
+      if cmp s1 s2 <= 0 then begin
+        dst.(!d) <- s1;
+        incr i1;
+      end else begin
+        dst.(!d) <- s2;
+        incr i2;
+      end;
+      incr d;
+    done;
+    if !i1 < src1r then
+      Array.blit a !i1 dst !d (src1r - !i1)
+    else
+      Array.blit src2 !i2 dst !d (src2r - !i2)
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len-1 do
+      let e = a.(srcofs+i) in
+      let j = ref (dstofs+i-1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else
+    let l1 = len / 2 in
+    let l2 = len - l1 in
+    sortto (srcofs+l1) dst (dstofs+l1) l2;
+    sortto srcofs a (srcofs+l2) l1;
+    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 8;;
+let amerge_3h cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let i1 = ref src1ofs
+    and i2 = ref src2ofs
+    and d = ref dstofs
+    and src1r = src1ofs + src1len
+    and src2r = src2ofs + src2len
+    in
+    while !i1 < src1r && !i2 < src2r do
+      let s1 = a.(!i1) and s2 = src2.(!i2) in
+      if cmp s1 s2 <= 0 then begin
+        dst.(!d) <- s1;
+        incr i1;
+      end else begin
+        dst.(!d) <- s2;
+        incr i2;
+      end;
+      incr d;
+    done;
+    if !i1 < src1r then
+      Array.blit a !i1 dst !d (src1r - !i1)
+    else
+      Array.blit src2 !i2 dst !d (src2r - !i2)
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len-1 do
+      let e = a.(srcofs+i) in
+      let j = ref (dstofs+i-1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else
+    let l1 = len / 2 in
+    let l2 = len - l1 in
+    sortto (srcofs+l1) dst (dstofs+l1) l2;
+    sortto srcofs a (srcofs+l2) l1;
+    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 9;;
+let amerge_3i cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let i1 = ref src1ofs
+    and i2 = ref src2ofs
+    and d = ref dstofs
+    and src1r = src1ofs + src1len
+    and src2r = src2ofs + src2len
+    in
+    while !i1 < src1r && !i2 < src2r do
+      let s1 = a.(!i1) and s2 = src2.(!i2) in
+      if cmp s1 s2 <= 0 then begin
+        dst.(!d) <- s1;
+        incr i1;
+      end else begin
+        dst.(!d) <- s2;
+        incr i2;
+      end;
+      incr d;
+    done;
+    if !i1 < src1r then
+      Array.blit a !i1 dst !d (src1r - !i1)
+    else
+      Array.blit src2 !i2 dst !d (src2r - !i2)
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len-1 do
+      let e = a.(srcofs+i) in
+      let j = ref (dstofs+i-1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else
+    let l1 = len / 2 in
+    let l2 = len - l1 in
+    sortto (srcofs+l1) dst (dstofs+l1) l2;
+    sortto srcofs a (srcofs+l2) l1;
+    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+let cutoff = 10;;
+let amerge_3j cmp a =
+  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
+    let i1 = ref src1ofs
+    and i2 = ref src2ofs
+    and d = ref dstofs
+    and src1r = src1ofs + src1len
+    and src2r = src2ofs + src2len
+    in
+    while !i1 < src1r && !i2 < src2r do
+      let s1 = a.(!i1) and s2 = src2.(!i2) in
+      if cmp s1 s2 <= 0 then begin
+        dst.(!d) <- s1;
+        incr i1;
+      end else begin
+        dst.(!d) <- s2;
+        incr i2;
+      end;
+      incr d;
+    done;
+    if !i1 < src1r then
+      Array.blit a !i1 dst !d (src1r - !i1)
+    else
+      Array.blit src2 !i2 dst !d (src2r - !i2)
+  in
+  let isortto srcofs dst dstofs len =
+    for i = 0 to len-1 do
+      let e = a.(srcofs+i) in
+      let j = ref (dstofs+i-1) in
+      while (!j >= dstofs && cmp dst.(!j) e > 0) do
+        dst.(!j + 1) <- dst.(!j);
+        decr j;
+      done;
+      dst.(!j + 1) <- e;
+    done;
+  in
+  let rec sortto srcofs dst dstofs len =
+    if len <= cutoff then isortto srcofs dst dstofs len else
+    let l1 = len / 2 in
+    let l2 = len - l1 in
+    sortto (srcofs+l1) dst (dstofs+l1) l2;
+    sortto srcofs a (srcofs+l2) l1;
+    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
+  in
+  let l = Array.length a in
+  if l <= cutoff then isortto 0 a 0 l else begin
+    let l1 = l / 2 in
+    let l2 = l - l1 in
+    let t = Array.make l2 a.(0) in
+    sortto l1 t 0 l2;
+    sortto 0 a l2 l1;
+    merge l2 l1 t 0 l2 a 0;
+  end;
+;;
+
+(* FIXME try bottom-up merge on arrays? *)
+
+(************************************************************************)
+(* Shell sort on arrays *)
+
+let ashell_1 cmp a =
+  let l = Array.length a in
+  let step = ref 1 in
+  while !step < l do step := !step * 3 + 1; done;
+  step := !step / 3;
+  while !step > 0 do
+    for j = !step to l-1 do
+      let e = a.(j) in
+      let k = ref (j - !step) in
+      let k1 = ref j in
+      while !k >= 0 && cmp a.(!k) e > 0 do
+        a.(!k1) <- a.(!k);
+        k1 := !k;
+        k := !k - !step;
+      done;
+      a.(!k1) <- e;
+    done;
+    step := !step / 3;
+  done;
+;;
+
+let ashell_2 cmp a =
+  let l = Array.length a in
+  let step = ref 1 in
+  while !step < l do step := !step * 3 + 1; done;
+  step := !step / 3;
+  while !step > 0 do
+    for j = !step to l-1 do
+      let e = a.(j) in
+      let k = ref (j - !step) in
+      while !k >= 0 && cmp a.(!k) e > 0 do
+        a.(!k + !step) <- a.(!k);
+        k := !k - !step;
+      done;
+      a.(!k + !step) <- e;
+    done;
+    step := !step / 3;
+  done;
+;;
+
+let ashell_3 cmp a =
+  let l = Array.length a in
+  let step = ref 1 in
+  while !step < l do step := !step * 3 + 1; done;
+  step := !step / 3;
+  while !step > 0 do
+    for i = 0 to !step - 1 do
+      let j = ref (i + !step) in
+      while !j < l do
+        let e = ref a.(!j) in
+        let k = ref (!j - !step) in
+        if cmp !e a.(i) < 0 then begin
+          let x = !e in e := a.(i); a.(i) <- x;
+        end;
+        while cmp a.(!k) !e > 0 do
+          a.(!k + !step) <- a.(!k);
+          k := !k - !step;
+        done;
+        a.(!k + !step) <- !e;
+        j := !j + !step;
+      done;
+    done;
+    step := !step / 3;
+  done;
+;;
+
+let force = Lazy.force;;
+
+type iilist = Cons of int * iilist Lazy.t;;
+
+let rec mult n (Cons (x,l)) = Cons (n*x, lazy (mult n (force l)))
+
+let rec merge (Cons (x1, t1) as l1) (Cons (x2, t2) as l2) =
+  if x1 = x2 then Cons (x1, lazy (merge (force t1) (force t2)))
+  else if x1 < x2 then Cons (x1, lazy (merge (force t1) l2))
+  else Cons (x2, lazy (merge l1 (force t2)))
+;;
+
+let rec scale = Cons (1, lazy (merge (mult 2 scale) (mult 3 scale)));;
+
+let ashell_4 cmp a =
+  let l = Array.length a in
+  let rec loop1 accu (Cons (x, t)) =
+    if x > l then accu else loop1 (x::accu) (force t)
+  in
+  let sc = loop1 [] scale in
+  let rec loop2 = function
+    | [] -> ()
+    | step::t ->
+      for i = 0 to step - 1 do
+        let j = ref (i + step) in
+        while !j < l do
+          let e = a.(!j) in
+          let k = ref (!j - step) in
+          while !k >= 0 && cmp a.(!k) e > 0 do
+            a.(!k + step) <- a.(!k);
+            k := !k - step;
+          done;
+          a.(!k + step) <- e;
+          j := !j + step;
+        done;
+      done;
+      loop2 t;
+  in
+  loop2 sc;
+;;
+
+(************************************************************************)
+(* Quicksort on arrays *)
+let cutoff = 1;;
+let aquick_1a cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref (r - 1) in
+    while !p2 <= !p3 do
+      let e = a.(!p3) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+      end else if c < 0 then begin
+        a.(!p3) <- a.(!p2);
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end else begin
+        a.(!p3) <- a.(!p2);
+        a.(!p2) <- e;
+        incr p2;
+      end;
+    done;
+    incr p3;
+    let len1 = !p1 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p1; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p1)
+      end else qsort l !p1
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 1 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 2;;
+let aquick_1b cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref (r - 1) in
+    while !p2 <= !p3 do
+      let e = a.(!p3) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+      end else if c < 0 then begin
+        a.(!p3) <- a.(!p2);
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end else begin
+        a.(!p3) <- a.(!p2);
+        a.(!p2) <- e;
+        incr p2;
+      end;
+    done;
+    incr p3;
+    let len1 = !p1 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p1; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p1)
+      end else qsort l !p1
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 1 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 3;;
+let aquick_1c cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref (r - 1) in
+    while !p2 <= !p3 do
+      let e = a.(!p3) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+      end else if c < 0 then begin
+        a.(!p3) <- a.(!p2);
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end else begin
+        a.(!p3) <- a.(!p2);
+        a.(!p2) <- e;
+        incr p2;
+      end;
+    done;
+    incr p3;
+    let len1 = !p1 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p1; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p1)
+      end else qsort l !p1
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 1 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 4;;
+let aquick_1d cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref (r - 1) in
+    while !p2 <= !p3 do
+      let e = a.(!p3) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+      end else if c < 0 then begin
+        a.(!p3) <- a.(!p2);
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end else begin
+        a.(!p3) <- a.(!p2);
+        a.(!p2) <- e;
+        incr p2;
+      end;
+    done;
+    incr p3;
+    let len1 = !p1 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p1; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p1)
+      end else qsort l !p1
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 1 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 5;;
+let aquick_1e cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref (r - 1) in
+    while !p2 <= !p3 do
+      let e = a.(!p3) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+      end else if c < 0 then begin
+        a.(!p3) <- a.(!p2);
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end else begin
+        a.(!p3) <- a.(!p2);
+        a.(!p2) <- e;
+        incr p2;
+      end;
+    done;
+    incr p3;
+    let len1 = !p1 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p1; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p1)
+      end else qsort l !p1
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 1 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 6;;
+let aquick_1f cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref (r - 1) in
+    while !p2 <= !p3 do
+      let e = a.(!p3) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+      end else if c < 0 then begin
+        a.(!p3) <- a.(!p2);
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end else begin
+        a.(!p3) <- a.(!p2);
+        a.(!p2) <- e;
+        incr p2;
+      end;
+    done;
+    incr p3;
+    let len1 = !p1 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p1; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p1)
+      end else qsort l !p1
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 1 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 7;;
+let aquick_1g cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref (r - 1) in
+    while !p2 <= !p3 do
+      let e = a.(!p3) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+      end else if c < 0 then begin
+        a.(!p3) <- a.(!p2);
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end else begin
+        a.(!p3) <- a.(!p2);
+        a.(!p2) <- e;
+        incr p2;
+      end;
+    done;
+    incr p3;
+    let len1 = !p1 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p1; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p1)
+      end else qsort l !p1
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 1 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 1;;
+let aquick_2a cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end else begin
+        incr p2;
+      end;
+    done;
+    let len1 = !p1 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p1; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p1)
+      end else qsort l !p1
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 2;;
+let aquick_2b cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end else begin
+        incr p2;
+      end;
+    done;
+    let len1 = !p1 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p1; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p1)
+      end else qsort l !p1
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 3;;
+let aquick_2c cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end else begin
+        incr p2;
+      end;
+    done;
+    let len1 = !p1 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p1; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p1)
+      end else qsort l !p1
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 4;;
+let aquick_2d cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end else begin
+        incr p2;
+      end;
+    done;
+    let len1 = !p1 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p1; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p1)
+      end else qsort l !p1
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 5;;
+let aquick_2e cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end else begin
+        incr p2;
+      end;
+    done;
+    let len1 = !p1 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p1; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p1)
+      end else qsort l !p1
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 6;;
+let aquick_2f cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end else begin
+        incr p2;
+      end;
+    done;
+    let len1 = !p1 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p1; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p1)
+      end else qsort l !p1
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 7;;
+let aquick_2g cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end else begin
+        incr p2;
+      end;
+    done;
+    let len1 = !p1 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p1; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p1)
+      end else qsort l !p1
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 1;;
+let aquick_3a cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        incr p2;
+      end else begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end
+    done;
+    while !p1 > l do
+      decr p1;
+      decr p2;
+      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
+    done;
+    let len1 = !p2 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p2; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p2)
+      end else qsort l !p2
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 2;;
+let aquick_3b cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        incr p2;
+      end else begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end
+    done;
+    while !p1 > l do
+      decr p1;
+      decr p2;
+      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
+    done;
+    let len1 = !p2 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p2; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p2)
+      end else qsort l !p2
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 3;;
+let aquick_3c cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        incr p2;
+      end else begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end
+    done;
+    while !p1 > l do
+      decr p1;
+      decr p2;
+      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
+    done;
+    let len1 = !p2 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p2; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p2)
+      end else qsort l !p2
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 4;;
+let aquick_3d cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        incr p2;
+      end else begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end
+    done;
+    while !p1 > l do
+      decr p1;
+      decr p2;
+      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
+    done;
+    let len1 = !p2 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p2; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p2)
+      end else qsort l !p2
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 5;;
+let aquick_3e cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        incr p2;
+      end else begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end
+    done;
+    while !p1 > l do
+      decr p1;
+      decr p2;
+      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
+    done;
+    let len1 = !p2 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p2; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p2)
+      end else qsort l !p2
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 6;;
+let aquick_3f cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        incr p2;
+      end else begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end
+    done;
+    while !p1 > l do
+      decr p1;
+      decr p2;
+      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
+    done;
+    let len1 = !p2 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p2; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p2)
+      end else qsort l !p2
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 7;;
+let aquick_3g cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        incr p2;
+      end else begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end
+    done;
+    while !p1 > l do
+      decr p1;
+      decr p2;
+      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
+    done;
+    let len1 = !p2 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p2; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p2)
+      end else qsort l !p2
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 8;;
+let aquick_3h cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        incr p2;
+      end else begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end
+    done;
+    while !p1 > l do
+      decr p1;
+      decr p2;
+      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
+    done;
+    let len1 = !p2 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p2; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p2)
+      end else qsort l !p2
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 9;;
+let aquick_3i cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        incr p2;
+      end else begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end
+    done;
+    while !p1 > l do
+      decr p1;
+      decr p2;
+      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
+    done;
+    let len1 = !p2 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p2; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p2)
+      end else qsort l !p2
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+let cutoff = 10;;
+let aquick_3j cmp a =
+  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
+    let m = (l + r) / 2 in
+    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
+    let pivot = if cmp al am <= 0 then
+                  if cmp am ar <= 0 then am
+                  else if cmp al ar <= 0 then ar
+                  else al
+                else
+                  if cmp al ar <= 0 then al
+                  else if cmp am ar <= 0 then ar
+                  else am
+    in
+    let p1 = ref l and p2 = ref l and p3 = ref r in
+    while !p2 < !p3 do
+      let e = a.(!p2) in
+      let c = cmp e pivot in
+      if c > 0 then begin
+        decr p3;
+        a.(!p2) <- a.(!p3);
+        a.(!p3) <- e;
+      end else if c < 0 then begin
+        incr p2;
+      end else begin
+        a.(!p2) <- a.(!p1);
+        a.(!p1) <- e;
+        incr p1;
+        incr p2;
+      end
+    done;
+    while !p1 > l do
+      decr p1;
+      decr p2;
+      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
+    done;
+    let len1 = !p2 - l and len2 = r - !p3 in
+    if len1 > cutoff then
+      if len2 > cutoff then begin
+        if len1 < len2
+        then (qsort l !p2; qsort !p3 r)
+        else (qsort !p3 r; qsort l !p2)
+      end else qsort l !p2
+    else if len2 > cutoff then qsort !p3 r;
+  in
+  let l = Array.length a in
+  if l > 1 then begin
+    qsort 0 l;
+    let mini = ref 0 in
+    for i = 0 to (min l cutoff) - 1 do
+      if cmp a.(i) a.(!mini) < 0 then mini := i;
+    done;
+    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
+    for i = 1 to l - 1 do
+      let e = a.(i) in
+      let j = ref (i - 1) in
+      while cmp a.(!j) e > 0 do
+        a.(!j + 1) <- a.(!j);
+        decr j;
+      done;
+      a.(!j + 1) <- e;
+    done;
+  end;
+;;
+
+(************************************************************************)
+(* Heap sort on arrays (top-down, ternary) *)
+
+let aheap_1 cmp a =
+  let l = ref (Array.length a) in
+  let l3 = ref ((!l + 1) / 3) in   (* l3 is the first element without sons *)
+  let maxson i =                   (* ASSUMES i < !l3 *)
+    let i31 = i+i+i+1 in
+    let x = ref i31 in
+    if i31+2 < !l then begin
+      if cmp a.(i31) a.(i31+1) < 0 then x := i31+1;
+      if cmp a.(!x) a.(i31+2) < 0 then x := i31+2;
+      !x
+    end else begin
+      if i31+1 < !l && cmp a.(i31) a.(i31+1) < 0
+      then i31+1
+      else i31
+    end
+  in
+  let rec trickledown i e =    (* ASSUMES i < !l3 *)
+    let j = maxson i in
+    if cmp a.(j) e > 0 then begin
+      a.(i) <- a.(j);
+      if j < !l3 then trickledown j e else a.(j) <- e;
+    end else begin
+      a.(i) <- e;
+    end;
+  in
+  for i = !l3 - 1 downto 0 do trickledown i a.(i); done;
+  let m = ref (!l + 1 - 3 * !l3) in
+  while !l > 2 do
+    decr l;
+    if !m = 0 then (m := 2; decr l3) else decr m;
+    let e = a.(!l) in
+    a.(!l) <- a.(0);
+    trickledown 0 e;
+  done;
+  if !l > 1 then begin let e = a.(1) in a.(1) <- a.(0); a.(0) <- e; end;
+;;
+
+(************************************************************************)
+(* Heap sort on arrays (top-down, binary) *)
+
+(* FIXME try partial application of trickledown (merge with down) *)
+(* FIXME try to expand maxson in trickledown; delete the exception. *)
+
+let aheap_2 cmp a =
+  let maxson l i e =
+    let i21 = i + i + 1 in
+    if i21 + 1 < l && cmp a.(i21) a.(i21+1) < 0
+    then i21 + 1
+    else if i21 < l then i21 else (a.(i) <- e; raise Exit)
+  in
+  let rec trickledown l i e =
+    let j = maxson l i e in
+    if cmp a.(j) e > 0 then begin
+      a.(i) <- a.(j);
+      trickledown l j e;
+    end else begin
+      a.(i) <- e;
+    end;
+  in
+  let down l i e = try trickledown l i e with Exit -> () in
+  let l = Array.length a in
+  for i = l / 2 -1 downto 0 do down l i a.(i); done;
+  for i = l - 1 downto 1 do
+    let e = a.(i) in
+    a.(i) <- a.(0);
+    down i 0 e;
+  done;
+;;
+
+(************************************************************************)
+(* Heap sort on arrays (bottom-up, ternary) *)
+
+exception Bottom of int;;
+
+let aheap_3 cmp a =
+  let maxson l i =
+    let i31 = i+i+i+1 in
+    let x = ref i31 in
+    if i31+2 < l then begin
+      if cmp a.(i31) a.(i31+1) < 0 then x := i31+1;
+      if cmp a.(!x) a.(i31+2) < 0 then x := i31+2;
+      !x
+    end else
+      if i31+1 < l && cmp a.(i31) a.(i31+1) < 0
+      then i31+1
+      else if i31 < l then i31 else raise (Bottom i)
+  in
+  let rec trickledown l i e =
+    let j = maxson l i in
+    if cmp a.(j) e > 0 then begin
+      a.(i) <- a.(j);
+      trickledown l j e;
+    end else begin
+      a.(i) <- e;
+    end;
+  in
+  let rec trickle l i e = try trickledown l i e with Bottom i -> a.(i) <- e in
+  let rec bubbledown l i =
+    let j = maxson l i in
+    a.(i) <- a.(j);
+    bubbledown l j;
+  in
+  let bubble l i = try bubbledown l i with Bottom i -> i in
+  let rec trickleup i e =
+    let father = (i - 1) / 3 in
+    assert (i <> father);
+    if cmp a.(father) e < 0 then begin
+      a.(i) <- a.(father);
+      if father > 0 then trickleup father e else a.(0) <- e;
+    end else begin
+      a.(i) <- e;
+    end;
+  in
+  let l = Array.length a in
+  for i = (l + 1) / 3 - 1 downto 0 do trickle l i a.(i); done;
+  for i = l - 1 downto 2 do
+    let e = a.(i) in
+    a.(i) <- a.(0);
+    trickleup (bubble i 0) e;
+  done;
+  if l > 1 then (let e = a.(1) in a.(1) <- a.(0); a.(0) <- e);
+;;
+
+(************************************************************************)
+(* Heap sort on arrays (bottom-up, binary) *)
+
+let aheap_4 cmp a =
+  let maxson l i =
+    let i21 = i + i + 1 in
+    if i21 + 1 < l && cmp a.(i21) a.(i21 + 1) < 0
+    then i21 + 1
+    else if i21 < l then i21 else raise (Bottom i)
+  in
+  let rec trickledown l i e =
+    let j = maxson l i in
+    if cmp a.(j) e > 0 then begin
+      a.(i) <- a.(j);
+      trickledown l j e;
+    end else begin
+      a.(i) <- e;
+    end;
+  in
+  let trickle l i e = try trickledown l i e with Bottom i -> a.(i) <- e in
+  let rec bubbledown l i =
+    let j = maxson l i in
+    a.(i) <- a.(j);
+    bubbledown l j;
+  in
+  let bubble l i = try bubbledown l i with Bottom i -> i in
+  let rec trickleup i e =
+    let father = (i - 1) / 2 in
+    assert (i <> father);
+    if cmp a.(father) e < 0 then begin
+      a.(i) <- a.(father);
+      if father > 0 then trickleup father e else a.(0) <- e;
+    end else begin
+      a.(i) <- e;
+    end;
+  in
+  let l = Array.length a in
+  for i = l / 2 - 1 downto 0 do trickle l i a.(i); done;
+  for i = l - 1 downto 2 do
+    let e = a.(i) in
+    a.(i) <- a.(0);
+    trickleup (bubble i 0) e;
+  done;
+  if l > 1 then (let e = a.(1) in a.(1) <- a.(0); a.(0) <- e);
+;;
+
+(************************************************************************)
+(* heap sort, top-down, ternary, recursive final loop *)
+
+let aheap_5 cmp a =
+  let maxson l i =                 (* ASSUMES i < (l+1)/3 *)
+    let i31 = i+i+i+1 in
+    let x = ref i31 in
+    if i31+2 < l then begin
+      if cmp a.(i31) a.(i31+1) < 0 then x := i31+1;
+      if cmp a.(!x) a.(i31+2) < 0 then x := i31+2;
+      !x
+    end else begin
+      if i31+1 < l && cmp a.(i31) a.(i31+1) < 0
+      then i31+1
+      else i31
+    end
+  in
+  let rec trickledown l l3 i e =    (* ASSUMES i < l3 *)
+    let j = maxson l i in
+    if cmp a.(j) e > 0 then begin
+      a.(i) <- a.(j);
+      if j < l3 then trickledown l l3 j e else a.(j) <- e;
+    end else begin
+      a.(i) <- e;
+    end;
+  in
+  let l = Array.length a in
+  let l3 = (l + 1) / 3 in
+  for i = l3 - 1 downto 0 do trickledown l l3 i a.(i); done;
+  let rec loop0 l l3 =
+    let e = a.(l) in
+    a.(l) <- a.(0);
+    trickledown l l3 0 e;
+    loop2 (l-1) (l3-1);
+  and loop1 l l3 =
+    let e = a.(l) in
+    a.(l) <- a.(0);
+    trickledown l l3 0 e;
+    loop0 (l-1) l3;
+  and loop2 l l3 =
+    if l > 1 then begin
+      let e = a.(l) in
+      a.(l) <- a.(0);
+      trickledown l l3 0 e;
+      loop1 (l-1) l3;
+    end else begin
+      let e = a.(1) in a.(1) <- a.(0); a.(0) <- e;
+    end;
+  in
+  if l > 1 then
+    match l + 1 - 3 * l3 with
+    | 0 -> loop2 (l-1) (l3-1);
+    | 1 -> loop0 (l-1) l3;
+    | 2 -> loop1 (l-1) l3;
+    | _ -> assert false;
+;;
+
+(************************************************************************)
+(* heap sort, top-down, ternary, with exception *)
+
+let aheap_6 cmp a =
+  let maxson e l i =
+    let i31 = i + i + i + 1 in
+    let x = ref i31 in
+    if i31+2 < l then begin
+      if cmp a.(i31) a.(i31+1) < 0 then x := i31+1;
+      if cmp a.(!x) a.(i31+2) < 0 then x := i31+2;
+      !x
+    end else begin
+      if i31+1 < l && cmp a.(i31) a.(i31+1) < 0
+      then i31+1
+      else if i31 < l then i31 else (a.(i) <- e; raise Exit)
+    end
+  in
+  let rec trickledown e l i =
+    let j = maxson e l i in
+    if cmp a.(j) e > 0 then begin
+      a.(i) <- a.(j);
+      trickledown e l j;
+    end else begin
+      a.(i) <- e;
+    end;
+  in
+  let down e l i = try trickledown e l i with Exit -> (); in
+  let l = Array.length a in
+  for i = (l + 1) / 3 - 1 downto 0 do down a.(i) l i; done;
+  for i = l - 1 downto 2 do
+    let e = a.(i) in
+    a.(i) <- a.(0);
+    down e i 0;
+  done;
+  if l > 1 then (let e = a.(1) in a.(1) <- a.(0); a.(0) <- e);
+;;
+
+(* FIXME try cutoff for heapsort *)
+
+(************************************************************************)
+(* Insertion sort with dichotomic search *)
+
+let ainsertion_1 cmp a =
+  let rec dicho l r e =
+    if l = r then l else begin
+      let m = (l + r) / 2 in
+      if cmp a.(m) e <= 0
+      then dicho (m+1) r e
+      else dicho l m e
+    end
+  in
+  for i = 1 to Array.length a - 1 do
+    let e = a.(i) in
+    let j = dicho 0 i e in
+    Array.blit a j a (j + 1) (i - j);
+    a.(j) <- e;
+  done;
+;;
+
+let array_of_list l len =
+  match l with
+  | [] -> [| |]
+  | h::t ->
+      let a = Array.make len h in
+      let rec loop i l =
+        match l with
+        | [] -> ()
+        | h::t -> a.(i) <- h; loop (i+1) t
+      in
+      loop 1 t;
+      a
+;;
+
+let lmerge_0a cmp l =
+  let a = Array.of_list l in
+  amerge_1e cmp a;
+  Array.to_list a
+;;
+
+let lmerge_0b cmp l =
+  let len = List.length l in
+  if len > 256 then Gc.minor ();
+  let a = array_of_list l len in
+  amerge_1e cmp a;
+  Array.to_list a
+;;
+
+let lshell_0 cmp l =
+  let a = Array.of_list l in
+  ashell_2 cmp a;
+  Array.to_list a
+;;
+
+let lquick_0 cmp l =
+  let a = Array.of_list l in
+  aquick_3f cmp a;
+  Array.to_list a
+;;
+
+(************************************************************************)
+(* merge sort on arrays via lists *)
+
+let amerge_0 cmp a =    (* cutoff is not yet used *)
+  let l = lmerge_4e cmp (Array.to_list a) in
+  let rec loop i = function
+  | [] -> ()
+  | h::t -> a.(i) <- h; loop (i + 1) t
+  in
+  loop 0 l
+;;
+
+(************************************************************************)
+
+let lold = [
+  "lmerge_3", lmerge_3, false;
+  "lmerge_4a", lmerge_4a, true;
+];;
+
+let lnew = [
+  "List.stable_sort", List.stable_sort, true;
+
+  "lmerge_0a", lmerge_0a, true;
+  "lmerge_0b", lmerge_0b, true;
+  "lshell_0", lshell_0, false;
+  "lquick_0", lquick_0, false;
+
+  "lmerge_1a", lmerge_1a, true;
+  "lmerge_1b", lmerge_1b, true;
+  "lmerge_1c", lmerge_1c, true;
+  "lmerge_1d", lmerge_1d, true;
+
+  "lmerge_4b", lmerge_4b, true;
+  "lmerge_4c", lmerge_4c, true;
+  "lmerge_4d", lmerge_4d, true;
+  "lmerge_4e", lmerge_4e, true;
+
+  "lmerge_5a", lmerge_5a, true;
+  "lmerge_5b", lmerge_5b, true;
+  "lmerge_5c", lmerge_5c, true;
+  "lmerge_5d", lmerge_5d, true;
+];;
+let anew = [
+  "Array.stable_sort", Array.stable_sort, true;
+  "Array.sort", Array.sort, false;
+
+  "amerge_0", amerge_0, true;
+
+  "amerge_1a", amerge_1a, true;
+  "amerge_1b", amerge_1b, true;
+  "amerge_1c", amerge_1c, true;
+  "amerge_1d", amerge_1d, true;
+  "amerge_1e", amerge_1e, true;
+  "amerge_1f", amerge_1f, true;
+  "amerge_1g", amerge_1g, true;
+  "amerge_1h", amerge_1h, true;
+  "amerge_1i", amerge_1i, true;
+  "amerge_1j", amerge_1j, true;
+
+  "amerge_3a", amerge_3a, true;
+  "amerge_3b", amerge_3b, true;
+  "amerge_3c", amerge_3c, true;
+  "amerge_3d", amerge_3d, true;
+  "amerge_3e", amerge_3e, true;
+  "amerge_3f", amerge_3f, true;
+  "amerge_3g", amerge_3g, true;
+  "amerge_3h", amerge_3h, true;
+  "amerge_3i", amerge_3i, true;
+  "amerge_3j", amerge_3j, true;
+
+  "ashell_1", ashell_1, false;
+  "ashell_2", ashell_2, false;
+  "ashell_3", ashell_3, false;
+  "ashell_4", ashell_4, false;
+
+  "aquick_1a", aquick_1a, false;
+  "aquick_1b", aquick_1b, false;
+  "aquick_1c", aquick_1c, false;
+  "aquick_1d", aquick_1d, false;
+  "aquick_1e", aquick_1e, false;
+  "aquick_1f", aquick_1f, false;
+  "aquick_1g", aquick_1g, false;
+
+  "aquick_2a", aquick_2a, false;
+  "aquick_2b", aquick_2b, false;
+  "aquick_2c", aquick_2c, false;
+  "aquick_2d", aquick_2d, false;
+  "aquick_2e", aquick_2e, false;
+  "aquick_2f", aquick_2f, false;
+  "aquick_2g", aquick_2g, false;
+
+  "aquick_3a", aquick_3a, false;
+  "aquick_3b", aquick_3b, false;
+  "aquick_3c", aquick_3c, false;
+  "aquick_3d", aquick_3d, false;
+  "aquick_3e", aquick_3e, false;
+  "aquick_3f", aquick_3f, false;
+  "aquick_3g", aquick_3g, false;
+  "aquick_3h", aquick_3h, false;
+  "aquick_3i", aquick_3i, false;
+  "aquick_3j", aquick_3j, false;
+
+  "aheap_1", aheap_1, false;
+  "aheap_2", aheap_2, false;
+  "aheap_3", aheap_3, false;
+  "aheap_4", aheap_4, false;
+  "aheap_5", aheap_5, false;
+  "aheap_6", aheap_6, false;
+
+  "ainsertion_1", ainsertion_1, true;
+];;
+
+(************************************************************************)
+(* main program *)
+
+type mode = Test_std | Test | Bench1 | Bench2 | Bench3;;
+
+let size = ref 22
+and mem = ref 0
+and mode = ref Test_std
+and only = ref []
+;;
+
+let usage = "Usage: sorts [-size <table size>] [-mem <memory size>]\n\
+          \032            [-seed <random seed>] [-test|-bench]"
+;;
+
+let options = [
+  "-size", Arg.Int ((:=) size), "   Maximum size for benchmarks (default 22)";
+  "-meg",Arg.Int ((:=) mem),"    How many megabytes to preallocate (default 0)";
+  "-seed", Arg.Int ((:=) seed), "   PRNG seed (default 0)";
+  "-teststd", Arg.Unit (fun () -> mode := Test_std), "   Test stdlib (default)";
+  "-test", Arg.Unit (fun () -> mode := Test), "   Select test mode";
+  "-bench1", Arg.Unit (fun () -> mode := Bench1), "  Select bench mode 1";
+  "-bench2", Arg.Unit (fun () -> mode := Bench2), "  Select bench mode 2";
+  "-bench3", Arg.Unit (fun () -> mode := Bench3), "  Select bench mode 3";
+  "-fn", Arg.String (fun x -> only := x :: !only),
+                         " <function>  Test/Bench this function (default all)";
+];;
+let anonymous x = raise (Arg.Bad ("unrecognised option "^x));;
+
+let main () =
+  Arg.parse options anonymous usage;
+
+  Printf.printf "Command line arguments are:";
+  for i = 1 to Array.length Sys.argv - 1 do
+    Printf.printf " %s" Sys.argv.(i);
+  done;
+  Printf.printf "\n";
+
+  ignore (Bytes.create (1048576 * !mem));
+  Gc.full_major ();
+(*
+  let a2l = Array.to_list in
+  let l2ak x y = Array.of_list x in
+  let id = fun x -> x in
+  let fst x y = x in
+  let snd x y = y in
+*)
+  let benchonly f x y z t =
+    match !only with
+    | [] -> f x y z t
+    | l -> if List.mem y l then f x y z t
+  in
+  let testonly x1 x2 x3 x4 x5 x6 =
+    match !only with
+    | [] -> test x1 x2 x3 x4 x5 x6
+    | l -> if List.mem x1 l then test x1 x2 x3 x4 x5 x6
+  in
+
+  match !mode with
+  | Test_std -> begin
+      testonly "List.sort" false List.sort List.sort lc lc;
+      testonly "List.stable_sort" true List.stable_sort List.stable_sort lc lc;
+      testonly "Array.sort" false Array.sort Array.sort ac ac;
+      testonly "Array.stable_sort" true Array.stable_sort Array.stable_sort
+               ac ac;
+      printf "Number of tests failed: %d\n" !numfailed;
+    end;
+  | Test -> begin
+      for i = 0 to List.length lold - 1 do
+        let (name, f1, stable) = List.nth lold i in
+        let (_, f2, _) = List.nth lold i in
+        testonly name stable f1 f2 ll ll;
+      done;
+      for i = 0 to List.length lnew - 1 do
+        let (name, f1, stable) = List.nth lnew i in
+        let (_, f2, _) = List.nth lnew i in
+        testonly name stable f1 f2 lc lc;
+      done;
+      for i = 0 to List.length anew - 1 do
+        let (name, f1, stable) = List.nth anew i in
+        let (_, f2, _) = List.nth anew i in
+        testonly name stable f1 f2 ac ac;
+      done;
+      printf "Number of tests failed: %d\n" !numfailed;
+    end;
+  | Bench1 -> begin
+      let ba = fun x y z -> benchonly bench1a !size x y z
+      and bb = fun x y z -> benchonly bench1b !size x y z
+      and bc = fun x y z -> benchonly bench1c !size x y z
+      in
+      for i = 0 to List.length lold - 1 do
+        let (name, f, stable) = List.nth lold i in ba name f ll;
+        let (name, f, stable) = List.nth lold i in bb name f ll;
+        let (name, f, stable) = List.nth lold i in bc name f ll;
+      done;
+      for i = 0 to List.length lnew - 1 do
+        let (name, f, stable) = List.nth lnew i in ba name f lc;
+        let (name, f, stable) = List.nth lnew i in bb name f lc;
+        let (name, f, stable) = List.nth lnew i in bc name f lc;
+      done;
+      for i = 0 to List.length anew - 1 do
+        let (name, f, stable) = List.nth anew i in ba name f ac;
+        let (name, f, stable) = List.nth anew i in bb name f ac;
+        let (name, f, stable) = List.nth anew i in bc name f ac;
+      done;
+    end;
+  | Bench2 -> begin
+      let b = fun x y z -> benchonly bench2 !size x y z in
+      for i = 0 to List.length lold - 1 do
+        let (name, f, stable) = List.nth lold i in b name f ll;
+      done;
+      for i = 0 to List.length lnew - 1 do
+        let (name, f, stable) = List.nth lnew i in b name f lc;
+      done;
+      for i = 0 to List.length anew - 1 do
+        let (name, f, stable) = List.nth anew i in b name f ac;
+      done;
+    end;
+  | Bench3 -> begin
+      let ba = fun x y z -> benchonly bench3a !size x y z
+      and bb = fun x y z -> benchonly bench3b !size x y z
+      and bc = fun x y z -> benchonly bench3c !size x y z
+      in
+      for i = 0 to List.length lold - 1 do
+        let (name, f, stable) = List.nth lold i in ba name f ll;
+        let (name, f, stable) = List.nth lold i in bb name f ll;
+        let (name, f, stable) = List.nth lold i in bc name f ll;
+      done;
+      for i = 0 to List.length lnew - 1 do
+        let (name, f, stable) = List.nth lnew i in ba name f lc;
+        let (name, f, stable) = List.nth lnew i in bb name f lc;
+        let (name, f, stable) = List.nth lnew i in bc name f lc;
+      done;
+    end;
+;;
+
+if not !Sys.interactive then Printexc.catch main ();;
diff --git a/testsuite/tests/misc/sorts.reference b/testsuite/tests/misc/sorts.reference
new file mode 100644
index 00000000..d311fcdd
--- /dev/null
+++ b/testsuite/tests/misc/sorts.reference
@@ -0,0 +1,198 @@
+Command line arguments are:
+Testing List.sort...
+  List.sort with constant ints
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.sort with sorted ints
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.sort with reverse-sorted ints
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.sort with random ints (many dups)
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.sort with random ints (few dups)
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.sort with records (str)
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.sort with records (int[1])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.sort with records (int[10])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.sort with records (int[100])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.sort with records (int[1000])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+Testing List.stable_sort...
+  List.stable_sort with constant ints
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.stable_sort with sorted ints
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.stable_sort with reverse-sorted ints
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.stable_sort with random ints (many dups)
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.stable_sort with random ints (few dups)
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.stable_sort with records (str)
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.stable_sort with records (int[1])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.stable_sort with records (int[10])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.stable_sort with records (int[100])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.stable_sort with records (int[1000])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.stable_sort with records (int[1]) [stable]
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.stable_sort with records (int[10]) [stable]
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.stable_sort with records (int[100]) [stable]
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  List.stable_sort with records (int[1000]) [stable]
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+Testing Array.sort...
+  Array.sort with constant ints
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.sort with sorted ints
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.sort with reverse-sorted ints
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.sort with random ints (many dups)
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.sort with random ints (few dups)
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.sort with records (str)
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.sort with records (int[1])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.sort with records (int[10])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.sort with records (int[100])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.sort with records (int[1000])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+Testing Array.stable_sort...
+  Array.stable_sort with constant ints
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.stable_sort with sorted ints
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.stable_sort with reverse-sorted ints
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.stable_sort with random ints (many dups)
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.stable_sort with random ints (few dups)
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.stable_sort with records (str)
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.stable_sort with records (int[1])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.stable_sort with records (int[10])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.stable_sort with records (int[100])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.stable_sort with records (int[1000])
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.stable_sort with records (int[1]) [stable]
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.stable_sort with records (int[10]) [stable]
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.stable_sort with records (int[100]) [stable]
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+  Array.stable_sort with records (int[1000]) [stable]
+        0.    1.    2.    3.    4.    5.    6.    7.    8.    9.   10.   11.
+       12.   13.   28.  100.  127.  128.  129.  193.  506. 1000. 1025. 1535.
+     2323.
+Number of tests failed: 0
diff --git a/testsuite/tests/misc/takc.ml b/testsuite/tests/misc/takc.ml
new file mode 100644
index 00000000..bfdf11c4
--- /dev/null
+++ b/testsuite/tests/misc/takc.ml
@@ -0,0 +1,11 @@
+(* TEST
+*)
+
+let rec tak x y z =
+  if x > y then tak (tak (x-1) y z) (tak (y-1) z x) (tak (z-1) x y)
+           else z
+
+let rec repeat n =
+  if n <= 0 then 0 else tak 18 12 6 + repeat(n-1)
+
+let _ = print_int (repeat 200); print_newline(); exit 0
diff --git a/testsuite/tests/misc/takc.reference b/testsuite/tests/misc/takc.reference
new file mode 100644
index 00000000..50989ffe
--- /dev/null
+++ b/testsuite/tests/misc/takc.reference
@@ -0,0 +1 @@
+1400
diff --git a/testsuite/tests/misc/taku.ml b/testsuite/tests/misc/taku.ml
new file mode 100644
index 00000000..dac1a3f6
--- /dev/null
+++ b/testsuite/tests/misc/taku.ml
@@ -0,0 +1,11 @@
+(* TEST
+*)
+
+let rec tak (x, y, z) =
+  if x > y then tak(tak (x-1, y, z), tak (y-1, z, x), tak (z-1, x, y))
+           else z
+
+let rec repeat n =
+  if n <= 0 then 0 else tak(18,12,6) + repeat(n-1)
+
+let _ = print_int (repeat 200); print_newline(); exit 0
diff --git a/testsuite/tests/misc/taku.reference b/testsuite/tests/misc/taku.reference
new file mode 100644
index 00000000..50989ffe
--- /dev/null
+++ b/testsuite/tests/misc/taku.reference
@@ -0,0 +1 @@
+1400
diff --git a/testsuite/tests/misc/weaklifetime.ml b/testsuite/tests/misc/weaklifetime.ml
new file mode 100644
index 00000000..49c701a9
--- /dev/null
+++ b/testsuite/tests/misc/weaklifetime.ml
@@ -0,0 +1,65 @@
+(* TEST
+*)
+
+Random.init 12345;;
+
+let size = 1000;;
+
+type block = int array;;
+
+type objdata =
+  | Present of block
+  | Absent of int  (* GC count at time of erase *)
+;;
+
+type bunch = {
+  objs : objdata array;
+  wp : block Weak.t;
+};;
+
+let data =
+  Array.init size (fun i ->
+    let n = 1 + Random.int size in
+    {
+      objs = Array.make n (Absent 0);
+      wp = Weak.create n;
+    }
+  )
+;;
+
+let gccount () = (Gc.quick_stat ()).Gc.major_collections;;
+
+(* Check the correctness condition on the data at (i,j):
+   1. if the block is present, the weak pointer must be full
+   2. if the block was removed at GC n, and the weak pointer is still
+      full, then the current GC must be at most n+1.
+
+   Then modify the data in one of the following ways:
+   1. if the block and weak pointer are absent, fill them
+   2. if the block and weak pointer are present, randomly erase the block
+*)
+let check_and_change i j =
+  let gc1 = gccount () in
+  match data.(i).objs.(j), Weak.check data.(i).wp j with
+  | Present x, false -> assert false
+  | Absent n, true -> assert (gc1 <= n+1)
+  | Absent _, false ->
+    let x = Array.make (1 + Random.int 10) 42 in
+    data.(i).objs.(j) <- Present x;
+    Weak.set data.(i).wp j (Some x);
+  | Present _, true ->
+    if Random.int 10 = 0 then begin
+      data.(i).objs.(j) <- Absent gc1;
+      let gc2 = gccount () in
+      if gc1 <> gc2 then data.(i).objs.(j) <- Absent gc2;
+    end
+;;
+
+let dummy = ref [||];;
+
+while gccount () < 20 do
+  dummy := Array.make (Random.int 300) 0;
+  let i = Random.int size in
+  let j = Random.int (Array.length data.(i).objs) in
+  check_and_change i j;
+done
diff --git a/testsuite/tests/misc/weaklifetime.reference b/testsuite/tests/misc/weaklifetime.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/misc/weaklifetime2.ml b/testsuite/tests/misc/weaklifetime2.ml
new file mode 100644
index 00000000..2c75b00b
--- /dev/null
+++ b/testsuite/tests/misc/weaklifetime2.ml
@@ -0,0 +1,60 @@
+(* TEST
+*)
+
+let n = 500
+let loop = 2
+
+let alive = ref (Array.init n (fun _ -> Array.make 10 0))
+
+let create_weaks () =
+  Array.init n (fun i ->
+      let w = Weak.create 1 in
+      Weak.set w 0 (Some (!alive.(i)));
+      w
+    )
+
+(** We are trying to keep the weak pointer of weak2 set when the
+    weak pointer of weak1 and weak3 are wrongly unset.
+    [weak1], [weak2] and [weak3] are identical.
+ *)
+
+let weak1 = create_weaks ()
+let weak2 = create_weaks ()
+let weak3 = create_weaks ()
+
+(** put the weak pointers in the major heap *)
+let () =
+  let dummy = ref [||] in
+  for l=0 to 10 do
+    dummy := Array.make 300 0
+  done
+
+let gccount () = (Gc.quick_stat ()).Gc.major_collections;;
+
+let () =
+  for _l=1 to loop do
+    let bad = ref 0 in
+    for i=0 to n-1 do
+      (** make *this* weak key alive *)
+      for _j=0 to n*10 do
+        ignore (Weak.get weak2.(i) 0);
+      done;
+      (** Check that if it is alive in weak2 it is alive in weak1 *)
+      if Weak.check weak2.(i) 0 &&
+         not (Weak.check weak1.(i) 0) &&
+         Weak.check weak2.(i) 0
+      then incr bad;
+      (** Check that if it is alive in weak2 it is alive in weak3
+          This case was failing before the addition of the clean phase in the gc
+      *)
+      if Weak.check weak2.(i) 0 &&
+         not (Weak.check weak3.(i) 0) &&
+         Weak.check weak2.(i) 0
+      then incr bad;
+      !alive.(i) <- Array.make 10 0;
+    done;
+    (* Printf.printf "bad: %i\  gccount:%i\n%!" !bad (gccount ()); *)
+    if !bad > 0
+    then Printf.printf "failing\n%!"
+    else Printf.printf "success\n%!"
+  done
diff --git a/testsuite/tests/misc/weaklifetime2.reference b/testsuite/tests/misc/weaklifetime2.reference
new file mode 100644
index 00000000..cfb2161c
--- /dev/null
+++ b/testsuite/tests/misc/weaklifetime2.reference
@@ -0,0 +1,2 @@
+success
+success
diff --git a/testsuite/tests/misc/weaktest.ml b/testsuite/tests/misc/weaktest.ml
new file mode 100644
index 00000000..292e7662
--- /dev/null
+++ b/testsuite/tests/misc/weaktest.ml
@@ -0,0 +1,70 @@
+(* TEST
+*)
+
+let debug = false;;
+
+open Printf;;
+
+module Hashed = struct
+  type t = string list;;
+  let equal x y =
+    eprintf "equal: %s / %s\n" (List.hd x) (List.hd y);
+    x = y
+  ;;
+  let hash x = Hashtbl.hash (List.hd x);;
+end;;
+
+module HT = Weak.Make (Hashed);;
+
+let tbl = HT.create 7;;
+
+let r = ref [];;
+
+let bunch =
+  if Array.length Sys.argv < 2
+  then 10000
+  else int_of_string Sys.argv.(1)
+;;
+
+Random.init 314;;
+
+let random_string n =
+  String.init n (fun _ -> Char.chr (32 + Random.int 95))
+;;
+
+let added = ref 0;;
+let mistakes = ref 0;;
+
+let print_status () =
+  let (len, entries, sumbuck, buckmin, buckmed, buckmax) = HT.stats tbl in
+  if entries > bunch * (!added + 1) then begin
+    if debug then begin
+      printf "\n===================\n";
+      printf "len = %d\n" len;
+      printf "entries = %d\n" entries;
+      printf "sum of bucket sizes = %d\n" sumbuck;
+      printf "min bucket = %d\n" buckmin;
+      printf "med bucket = %d\n" buckmed;
+      printf "max bucket = %d\n" buckmax;
+      printf "GC count = %d\n" (Gc.quick_stat ()).Gc.major_collections;
+      flush stdout;
+    end;
+    incr mistakes;
+  end;
+  added := 0;
+;;
+
+Gc.create_alarm print_status;;
+
+for j = 0 to 99 do
+  r := [];
+  incr added;
+
+  for i = 1 to bunch do
+    let c = random_string 7 in
+    r := c :: !r;
+    HT.add tbl !r;
+  done;
+done;;
+
+if !mistakes < 5 then printf "pass\n" else printf "fail\n";;
diff --git a/testsuite/tests/misc/weaktest.reference b/testsuite/tests/misc/weaktest.reference
new file mode 100644
index 00000000..2ae28399
--- /dev/null
+++ b/testsuite/tests/misc/weaktest.reference
@@ -0,0 +1 @@
+pass
diff --git a/testsuite/tests/no-alias-deps/a2235.ml b/testsuite/tests/no-alias-deps/a2235.ml
new file mode 100644
index 00000000..7fecab12
--- /dev/null
+++ b/testsuite/tests/no-alias-deps/a2235.ml
@@ -0,0 +1 @@
+let x = 42
diff --git a/testsuite/tests/no-alias-deps/aliases.compilers.reference b/testsuite/tests/no-alias-deps/aliases.compilers.reference
new file mode 100644
index 00000000..16b8ef98
--- /dev/null
+++ b/testsuite/tests/no-alias-deps/aliases.compilers.reference
@@ -0,0 +1,9 @@
+File "aliases.ml", line 17, characters 12-13:
+17 | module A' = A (* missing a.cmi *)
+                 ^
+Warning 49: no cmi file was found in path for module A
+File "aliases.ml", line 18, characters 12-13:
+18 | module B' = B (* broken b.cmi *)
+                 ^
+Warning 49: no valid cmi file was found in path for module B. b.cmi
+is not a compiled interface
diff --git a/testsuite/tests/no-alias-deps/aliases.ml b/testsuite/tests/no-alias-deps/aliases.ml
new file mode 100644
index 00000000..3b7eca74
--- /dev/null
+++ b/testsuite/tests/no-alias-deps/aliases.ml
@@ -0,0 +1,21 @@
+(* TEST
+flags = "-no-alias-deps"
+compile_only = "true"
+files = "c.mli d.mli"
+* setup-ocamlc.byte-build-env
+** script
+script =
+  "cp ${test_source_directory}/b.cmi.invalid ${test_build_directory}/b.cmi"
+*** ocamlc.byte
+all_modules = "c.mli d.mli aliases.ml"
+**** check-ocamlc.byte-output
+***** ocamlobjinfo
+program = "aliases.cmo"
+****** check-program-output
+*)
+
+module A' = A (* missing a.cmi *)
+module B' = B (* broken b.cmi *)
+module C' = C (* valid c.cmi *)
+module D' = D (* valid d.cmi *)
+let () = print_int D'.something
diff --git a/testsuite/tests/no-alias-deps/aliases.reference b/testsuite/tests/no-alias-deps/aliases.reference
new file mode 100644
index 00000000..a49cb19b
--- /dev/null
+++ b/testsuite/tests/no-alias-deps/aliases.reference
@@ -0,0 +1,15 @@
+File aliases.cmo
+Unit name: Aliases
+Interfaces imported:
+	00000000000000000000000000000000	Stdlib
+	00000000000000000000000000000000	D
+	00000000000000000000000000000000	CamlinternalFormatBasics
+	--------------------------------	C
+	--------------------------------	B
+	00000000000000000000000000000000	Aliases
+	--------------------------------	A
+Required globals:
+	D
+	Stdlib
+Uses unsafe features: no
+Force link: no
diff --git a/testsuite/tests/no-alias-deps/b.cmi.invalid b/testsuite/tests/no-alias-deps/b.cmi.invalid
new file mode 100644
index 00000000..b0aedf1b
--- /dev/null
+++ b/testsuite/tests/no-alias-deps/b.cmi.invalid
@@ -0,0 +1 @@
+Not a valid cmi file
diff --git a/testsuite/tests/no-alias-deps/c.mli b/testsuite/tests/no-alias-deps/c.mli
new file mode 100644
index 00000000..5d27914b
--- /dev/null
+++ b/testsuite/tests/no-alias-deps/c.mli
@@ -0,0 +1 @@
+val something : int
diff --git a/testsuite/tests/no-alias-deps/d.mli b/testsuite/tests/no-alias-deps/d.mli
new file mode 100644
index 00000000..5d27914b
--- /dev/null
+++ b/testsuite/tests/no-alias-deps/d.mli
@@ -0,0 +1 @@
+val something : int
diff --git a/testsuite/tests/no-alias-deps/gpr2235.ml b/testsuite/tests/no-alias-deps/gpr2235.ml
new file mode 100644
index 00000000..d517770e
--- /dev/null
+++ b/testsuite/tests/no-alias-deps/gpr2235.ml
@@ -0,0 +1,21 @@
+(* TEST
+flags = "-no-alias-deps -w -49"
+compile_only = "true"
+files = "a2235.ml lib__2235.ml lib2235.ml user_of_lib2235.ml"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+module = "lib__2235.ml"
+*** check-ocamlc.byte-output
+**** ocamlc.byte
+flags = "-no-alias-deps -w -49 -open Lib__2235 -o lib__A2235.cmo"
+module = "a2235.ml"
+***** check-ocamlc.byte-output
+****** ocamlc.byte
+flags = "-no-alias-deps -w -49 -open Lib__2235"
+module = "lib2235.ml"
+******* check-ocamlc.byte-output
+******** ocamlc.byte
+flags = "-no-alias-deps -w -49"
+module = "user_of_lib2235.ml"
+********* check-ocamlc.byte-output
+*)
diff --git a/testsuite/tests/no-alias-deps/lib2235.ml b/testsuite/tests/no-alias-deps/lib2235.ml
new file mode 100644
index 00000000..33cb7330
--- /dev/null
+++ b/testsuite/tests/no-alias-deps/lib2235.ml
@@ -0,0 +1 @@
+module A2235 = A2235
diff --git a/testsuite/tests/no-alias-deps/lib__2235.ml b/testsuite/tests/no-alias-deps/lib__2235.ml
new file mode 100644
index 00000000..438d81d8
--- /dev/null
+++ b/testsuite/tests/no-alias-deps/lib__2235.ml
@@ -0,0 +1 @@
+module A2235 = Lib__A2235
diff --git a/testsuite/tests/no-alias-deps/user_of_lib2235.ml b/testsuite/tests/no-alias-deps/user_of_lib2235.ml
new file mode 100644
index 00000000..dfc04742
--- /dev/null
+++ b/testsuite/tests/no-alias-deps/user_of_lib2235.ml
@@ -0,0 +1,3 @@
+open Lib2235
+
+let x = A2235.x
diff --git a/testsuite/tests/opaque/fst/opaque_impl.ml b/testsuite/tests/opaque/fst/opaque_impl.ml
new file mode 100644
index 00000000..932c0d35
--- /dev/null
+++ b/testsuite/tests/opaque/fst/opaque_impl.ml
@@ -0,0 +1,2 @@
+
+let choose x y = x
diff --git a/testsuite/tests/opaque/fst/opaque_intf.ml b/testsuite/tests/opaque/fst/opaque_intf.ml
new file mode 100644
index 00000000..932c0d35
--- /dev/null
+++ b/testsuite/tests/opaque/fst/opaque_intf.ml
@@ -0,0 +1,2 @@
+
+let choose x y = x
diff --git a/testsuite/tests/opaque/fst/regular.ml b/testsuite/tests/opaque/fst/regular.ml
new file mode 100644
index 00000000..932c0d35
--- /dev/null
+++ b/testsuite/tests/opaque/fst/regular.ml
@@ -0,0 +1,2 @@
+
+let choose x y = x
diff --git a/testsuite/tests/opaque/intf/opaque_impl.mli b/testsuite/tests/opaque/intf/opaque_impl.mli
new file mode 100644
index 00000000..59d0a4c3
--- /dev/null
+++ b/testsuite/tests/opaque/intf/opaque_impl.mli
@@ -0,0 +1,2 @@
+
+val choose : 'a -> 'a -> 'a
diff --git a/testsuite/tests/opaque/intf/opaque_intf.mli b/testsuite/tests/opaque/intf/opaque_intf.mli
new file mode 100644
index 00000000..59d0a4c3
--- /dev/null
+++ b/testsuite/tests/opaque/intf/opaque_intf.mli
@@ -0,0 +1,2 @@
+
+val choose : 'a -> 'a -> 'a
diff --git a/testsuite/tests/opaque/intf/regular.mli b/testsuite/tests/opaque/intf/regular.mli
new file mode 100644
index 00000000..59d0a4c3
--- /dev/null
+++ b/testsuite/tests/opaque/intf/regular.mli
@@ -0,0 +1,2 @@
+
+val choose : 'a -> 'a -> 'a
diff --git a/testsuite/tests/opaque/snd/opaque_impl.ml b/testsuite/tests/opaque/snd/opaque_impl.ml
new file mode 100644
index 00000000..df8c0130
--- /dev/null
+++ b/testsuite/tests/opaque/snd/opaque_impl.ml
@@ -0,0 +1,2 @@
+
+let choose x y = y
diff --git a/testsuite/tests/opaque/snd/opaque_intf.ml b/testsuite/tests/opaque/snd/opaque_intf.ml
new file mode 100644
index 00000000..df8c0130
--- /dev/null
+++ b/testsuite/tests/opaque/snd/opaque_intf.ml
@@ -0,0 +1,2 @@
+
+let choose x y = y
diff --git a/testsuite/tests/opaque/snd/regular.ml b/testsuite/tests/opaque/snd/regular.ml
new file mode 100644
index 00000000..df8c0130
--- /dev/null
+++ b/testsuite/tests/opaque/snd/regular.ml
@@ -0,0 +1,2 @@
+
+let choose x y = y
diff --git a/testsuite/tests/opaque/test.ml b/testsuite/tests/opaque/test.ml
new file mode 100644
index 00000000..eae9bf20
--- /dev/null
+++ b/testsuite/tests/opaque/test.ml
@@ -0,0 +1,71 @@
+(* TEST
+
+compile_only = "true"
+
+* setup-ocamlopt.byte-build-env
+** script
+script = "cp -r ${test_source_directory}/fst ${test_source_directory}/intf \
+                ${test_source_directory}/snd ${test_build_directory}"
+*** ocamlopt.byte
+flags = "-I intf -opaque"
+all_modules = "intf/opaque_intf.mli"
+**** ocamlopt.byte
+flags = "-I intf"
+all_modules = "intf/opaque_impl.mli intf/regular.mli"
+***** script
+script = "cp intf/opaque_intf.cmi intf/opaque_impl.cmi intf/regular.cmi \
+             intf/opaque_intf.mli intf/opaque_impl.mli intf/regular.mli fst"
+****** script
+script = "cp intf/opaque_intf.cmi intf/opaque_impl.cmi intf/regular.cmi \
+             intf/opaque_intf.mli intf/opaque_impl.mli intf/regular.mli snd"
+******* ocamlopt.byte
+flags = "-I fst -opaque"
+all_modules = "fst/opaque_impl.ml"
+******** ocamlopt.byte
+flags = "-I snd -opaque"
+all_modules = "snd/opaque_impl.ml"
+********* ocamlopt.byte
+flags = "-I fst"
+all_modules = "fst/opaque_intf.ml fst/regular.ml"
+********** ocamlopt.byte
+flags = "-I snd"
+all_modules = "snd/opaque_intf.ml snd/regular.ml"
+*********** ocamlopt.byte
+flags = "-I fst"
+all_modules = "test.ml"
+
+(* ordinary compilation *)
+************ ocamlopt.byte
+compile_only = "false"
+all_modules = "fst/opaque_intf.cmx fst/opaque_impl.cmx fst/regular.cmx test.cmx"
+program = "${test_build_directory}/p1.exe"
+
+(* change to opaque interface *)
+************ ocamlopt.byte
+compile_only = "false"
+all_modules = "snd/opaque_intf.cmx fst/opaque_impl.cmx fst/regular.cmx test.cmx"
+program = "${test_build_directory}/p2.exe"
+
+(* change to opaque implementation *)
+************ ocamlopt.byte
+compile_only = "false"
+all_modules = "fst/opaque_intf.cmx snd/opaque_impl.cmx fst/regular.cmx test.cmx"
+program = "${test_build_directory}/p3.exe"
+
+(* change to non-opaque implementation *)
+************ ocamlopt.byte
+compile_only = "false"
+all_modules = "fst/opaque_intf.cmx fst/opaque_impl.cmx snd/regular.cmx test.cmx"
+program = "${test_build_directory}/p4.exe"
+ocamlopt_byte_exit_status = "2"
+
+*)
+
+let () =
+  print_endline (Opaque_intf.choose "Opaque_intf: First" "Opaque_intf: Second")
+
+let () =
+  print_endline (Opaque_impl.choose "Opaque_impl: First" "Opaque_impl: Second")
+
+let () =
+  print_endline (Regular.choose "Regular: First" "Regular: Second")
diff --git a/testsuite/tests/output-complete-obj/github9344.ml b/testsuite/tests/output-complete-obj/github9344.ml
new file mode 100644
index 00000000..430e5ec8
--- /dev/null
+++ b/testsuite/tests/output-complete-obj/github9344.ml
@@ -0,0 +1,14 @@
+(* TEST
+
+use_runtime = "false"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+flags = "-w a -output-complete-exe -ccopt -I${ocamlsrcdir}/runtime"
+program = "github9344"
+*** run
+program = "sh ${test_source_directory}/github9344.sh"
+**** check-program-output
+*)
+
+raise Not_found
diff --git a/testsuite/tests/output-complete-obj/github9344.reference b/testsuite/tests/output-complete-obj/github9344.reference
new file mode 100644
index 00000000..5626c6c6
--- /dev/null
+++ b/testsuite/tests/output-complete-obj/github9344.reference
@@ -0,0 +1 @@
+Fatal error: exception Not_found
diff --git a/testsuite/tests/output-complete-obj/github9344.sh b/testsuite/tests/output-complete-obj/github9344.sh
new file mode 100644
index 00000000..7e532312
--- /dev/null
+++ b/testsuite/tests/output-complete-obj/github9344.sh
@@ -0,0 +1,3 @@
+#!/bin/sh
+export OCAMLRUNPARAM=b=1
+./github9344 || true
diff --git a/testsuite/tests/output-complete-obj/puts.c b/testsuite/tests/output-complete-obj/puts.c
new file mode 100644
index 00000000..0fe82138
--- /dev/null
+++ b/testsuite/tests/output-complete-obj/puts.c
@@ -0,0 +1,9 @@
+#include <caml/mlvalues.h>
+#include <stdio.h>
+
+value caml_puts(value s)
+{
+  puts(String_val(s));
+  fflush(stdout);
+  return Val_unit;
+}
diff --git a/testsuite/tests/output-complete-obj/test.ml b/testsuite/tests/output-complete-obj/test.ml
new file mode 100644
index 00000000..4dd31355
--- /dev/null
+++ b/testsuite/tests/output-complete-obj/test.ml
@@ -0,0 +1,33 @@
+(* TEST
+
+files = "test.ml_stub.c"
+
+* libunix
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+flags = "-w a -output-complete-obj"
+program = "test.ml.bc.${objext}"
+**** script
+script = "${mkexe} -I${ocamlsrcdir}/runtime -o test.ml_bc_stub.exe \
+                   test.ml.bc.${objext} ${nativecc_libs} test.ml_stub.c"
+output = "${compiler_output}"
+***** run
+program = "./test.ml_bc_stub.exe"
+stdout = "program-output"
+stderr = "program-output"
+** setup-ocamlopt.byte-build-env
+*** ocamlopt.byte
+flags = "-w a -output-complete-obj"
+program = "test.ml.exe.${objext}"
+**** script
+script = "${mkexe} -I${ocamlsrcdir}/runtime -o test.ml_stub.exe \
+                   test.ml.exe.${objext} ${bytecc_libs} test.ml_stub.c"
+output = "${compiler_output}"
+***** run
+program = "./test.ml_stub.exe"
+stdout = "program-output"
+stderr = "program-output"
+
+*)
+
+let () = Printf.printf "Test!!\n%!"
diff --git a/testsuite/tests/output-complete-obj/test.ml_stub.c b/testsuite/tests/output-complete-obj/test.ml_stub.c
new file mode 100644
index 00000000..c3e8d3f3
--- /dev/null
+++ b/testsuite/tests/output-complete-obj/test.ml_stub.c
@@ -0,0 +1,10 @@
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/callback.h>
+#include <caml/memory.h>
+
+int main(int argc, char ** argv){
+
+  caml_startup(argv);
+  return 0;
+}
diff --git a/testsuite/tests/output-complete-obj/test2.ml b/testsuite/tests/output-complete-obj/test2.ml
new file mode 100644
index 00000000..bee3d382
--- /dev/null
+++ b/testsuite/tests/output-complete-obj/test2.ml
@@ -0,0 +1,23 @@
+(* TEST
+
+files = "puts.c"
+use_runtime = "false"
+
+* hasunix
+include unix
+** setup-ocamlc.byte-build-env
+*** ocamlc.byte
+flags = "-w a -output-complete-exe puts.c -ccopt -I${ocamlsrcdir}/runtime"
+program = "test2"
+**** run
+program = "./test2"
+***** check-program-output
+*)
+
+external puts: string -> unit = "caml_puts"
+
+let _ = at_exit (fun () -> print_endline "Program terminated")
+
+let () =
+  Unix.putenv "FOO" "Hello OCaml!";
+  puts (Unix.getenv "FOO")
diff --git a/testsuite/tests/output-complete-obj/test2.reference b/testsuite/tests/output-complete-obj/test2.reference
new file mode 100644
index 00000000..32151005
--- /dev/null
+++ b/testsuite/tests/output-complete-obj/test2.reference
@@ -0,0 +1,2 @@
+Hello OCaml!
+Program terminated
diff --git a/testsuite/tests/parse-errors/escape_error.compilers.reference b/testsuite/tests/parse-errors/escape_error.compilers.reference
new file mode 100644
index 00000000..5610c044
--- /dev/null
+++ b/testsuite/tests/parse-errors/escape_error.compilers.reference
@@ -0,0 +1,13 @@
+Line 8, characters 16-18:
+8 | try foo () with ;;
+                    ^^
+Error: Syntax error
+Line 2, characters 5-6:
+2 | (3 : );;
+         ^
+Error: Syntax error
+Line 2, characters 6-7:
+2 | (3 :> );;
+          ^
+Error: Syntax error
+
diff --git a/testsuite/tests/parse-errors/escape_error.ml b/testsuite/tests/parse-errors/escape_error.ml
new file mode 100644
index 00000000..2a8e99b6
--- /dev/null
+++ b/testsuite/tests/parse-errors/escape_error.ml
@@ -0,0 +1,12 @@
+(* TEST
+   * toplevel
+*)
+
+(* Nothing to see here, parse.ml dictates that these be printed as regular
+   "Syntax error". *)
+
+try foo () with ;;
+
+(3 : );;
+
+(3 :> );;
diff --git a/testsuite/tests/parse-errors/expecting.compilers.reference b/testsuite/tests/parse-errors/expecting.compilers.reference
new file mode 100644
index 00000000..55e7b7fa
--- /dev/null
+++ b/testsuite/tests/parse-errors/expecting.compilers.reference
@@ -0,0 +1,33 @@
+Line 6, characters 9-10:
+6 |   | 3 as 3 -> ()
+             ^
+Error: Syntax error: identifier expected.
+Line 3, characters 9-11:
+3 |   | 3 :: -> ()
+             ^^
+Error: Syntax error: pattern expected.
+Line 3, characters 8-10:
+3 |   | 3 | -> ()
+            ^^
+Error: Syntax error: pattern expected.
+Line 3, characters 11-13:
+3 |   | List.( -> ()
+               ^^
+Error: Syntax error: pattern expected.
+Line 3, characters 9-10:
+3 |   | (3 : 3) -> ()
+             ^
+Error: Syntax error: type expected.
+Line 3, characters 7-8:
+3 |   | (3,) -> ()
+           ^
+Error: Syntax error: pattern expected.
+Line 3, characters 6-8:
+3 |   | ( -> ()
+          ^^
+Error: Syntax error: operator expected.
+Line 3, characters 12-14:
+3 |   | (module -> ()
+                ^^
+Error: Syntax error: module-expr expected.
+
diff --git a/testsuite/tests/parse-errors/expecting.ml b/testsuite/tests/parse-errors/expecting.ml
new file mode 100644
index 00000000..4298b818
--- /dev/null
+++ b/testsuite/tests/parse-errors/expecting.ml
@@ -0,0 +1,35 @@
+(* TEST
+   * toplevel
+*)
+
+let f = function
+  | 3 as 3 -> ()
+;;
+
+let f = function
+  | 3 :: -> ()
+;;
+
+let f = function
+  | 3 | -> ()
+;;
+
+let f = function
+  | List.( -> ()
+;;
+
+let f = function
+  | (3 : 3) -> ()
+;;
+
+let f = function
+  | (3,) -> ()
+;;
+
+let f = function
+  | ( -> ()
+;;
+
+let f = function
+  | (module -> ()
+;;
diff --git a/testsuite/tests/parse-errors/pr7847.compilers.reference b/testsuite/tests/parse-errors/pr7847.compilers.reference
new file mode 100644
index 00000000..8a3c7cbe
--- /dev/null
+++ b/testsuite/tests/parse-errors/pr7847.compilers.reference
@@ -0,0 +1,4 @@
+File "pr7847.ml", line 10, characters 30-31:
+10 | external x : unit -> (int,int)`A.t = "x"
+                                   ^
+Error: Syntax error
diff --git a/testsuite/tests/parse-errors/pr7847.ml b/testsuite/tests/parse-errors/pr7847.ml
new file mode 100644
index 00000000..8018109b
--- /dev/null
+++ b/testsuite/tests/parse-errors/pr7847.ml
@@ -0,0 +1,10 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
+
+(* https://caml.inria.fr/mantis/view.php?id=7847
+   The backquote causes a syntax error; this file should be rejected. *)
+external x : unit -> (int,int)`A.t = "x"
diff --git a/testsuite/tests/parse-errors/unclosed_class_signature.compilers.reference b/testsuite/tests/parse-errors/unclosed_class_signature.compilers.reference
new file mode 100644
index 00000000..8c93b930
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_class_signature.compilers.reference
@@ -0,0 +1,6 @@
+File "unclosed_class_signature.mli", line 11, characters 0-0:
+Error: Syntax error: 'end' expected
+File "unclosed_class_signature.mli", line 10, characters 10-16:
+10 | class c : object
+               ^^^^^^
+  This 'object' might be unmatched
diff --git a/testsuite/tests/parse-errors/unclosed_class_signature.mli b/testsuite/tests/parse-errors/unclosed_class_signature.mli
new file mode 100644
index 00000000..0aa6bf49
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_class_signature.mli
@@ -0,0 +1,10 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
+
+(* It is apparently impossible to get the "unclosed object" message. *)
+
+class c : object
diff --git a/testsuite/tests/parse-errors/unclosed_class_simpl_expr1.compilers.reference b/testsuite/tests/parse-errors/unclosed_class_simpl_expr1.compilers.reference
new file mode 100644
index 00000000..7cedc39c
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_class_simpl_expr1.compilers.reference
@@ -0,0 +1,6 @@
+File "unclosed_class_simpl_expr1.ml", line 10, characters 0-0:
+Error: Syntax error: 'end' expected
+File "unclosed_class_simpl_expr1.ml", line 8, characters 10-16:
+8 | class c = object
+              ^^^^^^
+  This 'object' might be unmatched
diff --git a/testsuite/tests/parse-errors/unclosed_class_simpl_expr1.ml b/testsuite/tests/parse-errors/unclosed_class_simpl_expr1.ml
new file mode 100644
index 00000000..86466d81
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_class_simpl_expr1.ml
@@ -0,0 +1,9 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
+
+class c = object
+  method x = 1
diff --git a/testsuite/tests/parse-errors/unclosed_class_simpl_expr2.compilers.reference b/testsuite/tests/parse-errors/unclosed_class_simpl_expr2.compilers.reference
new file mode 100644
index 00000000..832b9419
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_class_simpl_expr2.compilers.reference
@@ -0,0 +1,6 @@
+File "unclosed_class_simpl_expr2.ml", line 9, characters 0-0:
+Error: Syntax error: ')' expected
+File "unclosed_class_simpl_expr2.ml", line 8, characters 10-11:
+8 | class c = (object end : object end
+              ^
+  This '(' might be unmatched
diff --git a/testsuite/tests/parse-errors/unclosed_class_simpl_expr2.ml b/testsuite/tests/parse-errors/unclosed_class_simpl_expr2.ml
new file mode 100644
index 00000000..dc762fd2
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_class_simpl_expr2.ml
@@ -0,0 +1,8 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
+
+class c = (object end : object end
diff --git a/testsuite/tests/parse-errors/unclosed_class_simpl_expr3.compilers.reference b/testsuite/tests/parse-errors/unclosed_class_simpl_expr3.compilers.reference
new file mode 100644
index 00000000..94e1743e
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_class_simpl_expr3.compilers.reference
@@ -0,0 +1,6 @@
+File "unclosed_class_simpl_expr3.ml", line 9, characters 0-0:
+Error: Syntax error: ')' expected
+File "unclosed_class_simpl_expr3.ml", line 8, characters 10-11:
+8 | class c = (object end
+              ^
+  This '(' might be unmatched
diff --git a/testsuite/tests/parse-errors/unclosed_class_simpl_expr3.ml b/testsuite/tests/parse-errors/unclosed_class_simpl_expr3.ml
new file mode 100644
index 00000000..142d3b09
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_class_simpl_expr3.ml
@@ -0,0 +1,8 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
+
+class c = (object end
diff --git a/testsuite/tests/parse-errors/unclosed_object.compilers.reference b/testsuite/tests/parse-errors/unclosed_object.compilers.reference
new file mode 100644
index 00000000..296e478d
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_object.compilers.reference
@@ -0,0 +1,6 @@
+File "unclosed_object.ml", line 11, characters 0-0:
+Error: Syntax error: 'end' expected
+File "unclosed_object.ml", line 10, characters 8-14:
+10 | let o = object
+             ^^^^^^
+  This 'object' might be unmatched
diff --git a/testsuite/tests/parse-errors/unclosed_object.ml b/testsuite/tests/parse-errors/unclosed_object.ml
new file mode 100644
index 00000000..c74a7135
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_object.ml
@@ -0,0 +1,10 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
+
+(* Failed to get the unclosed object error message. *)
+
+let o = object
diff --git a/testsuite/tests/parse-errors/unclosed_paren_module_expr1.compilers.reference b/testsuite/tests/parse-errors/unclosed_paren_module_expr1.compilers.reference
new file mode 100644
index 00000000..73f2b644
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_paren_module_expr1.compilers.reference
@@ -0,0 +1,6 @@
+File "unclosed_paren_module_expr1.ml", line 9, characters 0-0:
+Error: Syntax error: ')' expected
+File "unclosed_paren_module_expr1.ml", line 8, characters 11-12:
+8 | module M = (struct end : sig end
+               ^
+  This '(' might be unmatched
diff --git a/testsuite/tests/parse-errors/unclosed_paren_module_expr1.ml b/testsuite/tests/parse-errors/unclosed_paren_module_expr1.ml
new file mode 100644
index 00000000..b22a3fb4
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_paren_module_expr1.ml
@@ -0,0 +1,8 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
+
+module M = (struct end : sig end
diff --git a/testsuite/tests/parse-errors/unclosed_paren_module_expr2.compilers.reference b/testsuite/tests/parse-errors/unclosed_paren_module_expr2.compilers.reference
new file mode 100644
index 00000000..802d2a14
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_paren_module_expr2.compilers.reference
@@ -0,0 +1,6 @@
+File "unclosed_paren_module_expr2.ml", line 9, characters 0-0:
+Error: Syntax error: ')' expected
+File "unclosed_paren_module_expr2.ml", line 8, characters 11-12:
+8 | module M = (struct end
+               ^
+  This '(' might be unmatched
diff --git a/testsuite/tests/parse-errors/unclosed_paren_module_expr2.ml b/testsuite/tests/parse-errors/unclosed_paren_module_expr2.ml
new file mode 100644
index 00000000..a786f351
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_paren_module_expr2.ml
@@ -0,0 +1,8 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
+
+module M = (struct end
diff --git a/testsuite/tests/parse-errors/unclosed_paren_module_expr3.compilers.reference b/testsuite/tests/parse-errors/unclosed_paren_module_expr3.compilers.reference
new file mode 100644
index 00000000..12668431
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_paren_module_expr3.compilers.reference
@@ -0,0 +1,6 @@
+File "unclosed_paren_module_expr3.ml", line 9, characters 0-0:
+Error: Syntax error: ')' expected
+File "unclosed_paren_module_expr3.ml", line 8, characters 11-12:
+8 | module M = (val 3 :
+               ^
+  This '(' might be unmatched
diff --git a/testsuite/tests/parse-errors/unclosed_paren_module_expr3.ml b/testsuite/tests/parse-errors/unclosed_paren_module_expr3.ml
new file mode 100644
index 00000000..4c5c7858
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_paren_module_expr3.ml
@@ -0,0 +1,8 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
+
+module M = (val 3 :
diff --git a/testsuite/tests/parse-errors/unclosed_paren_module_expr4.compilers.reference b/testsuite/tests/parse-errors/unclosed_paren_module_expr4.compilers.reference
new file mode 100644
index 00000000..0af7a414
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_paren_module_expr4.compilers.reference
@@ -0,0 +1,6 @@
+File "unclosed_paren_module_expr4.ml", line 9, characters 0-0:
+Error: Syntax error: ')' expected
+File "unclosed_paren_module_expr4.ml", line 8, characters 11-12:
+8 | module M = (val 3 :>
+               ^
+  This '(' might be unmatched
diff --git a/testsuite/tests/parse-errors/unclosed_paren_module_expr4.ml b/testsuite/tests/parse-errors/unclosed_paren_module_expr4.ml
new file mode 100644
index 00000000..fc3daefc
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_paren_module_expr4.ml
@@ -0,0 +1,8 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
+
+module M = (val 3 :>
diff --git a/testsuite/tests/parse-errors/unclosed_paren_module_expr5.compilers.reference b/testsuite/tests/parse-errors/unclosed_paren_module_expr5.compilers.reference
new file mode 100644
index 00000000..e7e8dad1
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_paren_module_expr5.compilers.reference
@@ -0,0 +1,6 @@
+File "unclosed_paren_module_expr5.ml", line 9, characters 0-0:
+Error: Syntax error: ')' expected
+File "unclosed_paren_module_expr5.ml", line 8, characters 11-12:
+8 | module M = (val 3
+               ^
+  This '(' might be unmatched
diff --git a/testsuite/tests/parse-errors/unclosed_paren_module_expr5.ml b/testsuite/tests/parse-errors/unclosed_paren_module_expr5.ml
new file mode 100644
index 00000000..8ce6c0b2
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_paren_module_expr5.ml
@@ -0,0 +1,8 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
+
+module M = (val 3
diff --git a/testsuite/tests/parse-errors/unclosed_paren_module_type.compilers.reference b/testsuite/tests/parse-errors/unclosed_paren_module_type.compilers.reference
new file mode 100644
index 00000000..a1fc808a
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_paren_module_type.compilers.reference
@@ -0,0 +1,6 @@
+File "unclosed_paren_module_type.mli", line 9, characters 0-0:
+Error: Syntax error: ')' expected
+File "unclosed_paren_module_type.mli", line 8, characters 11-12:
+8 | module M : (sig end
+               ^
+  This '(' might be unmatched
diff --git a/testsuite/tests/parse-errors/unclosed_paren_module_type.mli b/testsuite/tests/parse-errors/unclosed_paren_module_type.mli
new file mode 100644
index 00000000..436ce5dc
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_paren_module_type.mli
@@ -0,0 +1,8 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
+
+module M : (sig end
diff --git a/testsuite/tests/parse-errors/unclosed_sig.compilers.reference b/testsuite/tests/parse-errors/unclosed_sig.compilers.reference
new file mode 100644
index 00000000..ad20205f
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_sig.compilers.reference
@@ -0,0 +1,6 @@
+File "unclosed_sig.mli", line 10, characters 0-0:
+Error: Syntax error: 'end' expected
+File "unclosed_sig.mli", line 8, characters 11-14:
+8 | module M : sig
+               ^^^
+  This 'sig' might be unmatched
diff --git a/testsuite/tests/parse-errors/unclosed_sig.mli b/testsuite/tests/parse-errors/unclosed_sig.mli
new file mode 100644
index 00000000..af49ea40
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_sig.mli
@@ -0,0 +1,9 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
+
+module M : sig
+  type t = T
diff --git a/testsuite/tests/parse-errors/unclosed_simple_expr.compilers.reference b/testsuite/tests/parse-errors/unclosed_simple_expr.compilers.reference
new file mode 100644
index 00000000..3aec8f72
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_simple_expr.compilers.reference
@@ -0,0 +1,186 @@
+Line 5, characters 5-7:
+5 | (3; 2;;
+         ^^
+Error: Syntax error: ')' expected
+Line 5, characters 0-1:
+5 | (3; 2;;
+    ^
+  This '(' might be unmatched
+Line 2, characters 10-12:
+2 | begin 3; 2;;
+              ^^
+Error: Syntax error: 'end' expected
+Line 2, characters 0-5:
+2 | begin 3; 2;;
+    ^^^^^
+  This 'begin' might be unmatched
+Line 2, characters 10-12:
+2 | List.(3; 2;;
+              ^^
+Error: Syntax error: ')' expected
+Line 2, characters 5-6:
+2 | List.(3; 2;;
+         ^
+  This '(' might be unmatched
+Line 2, characters 17-19:
+2 | simple_expr.(3; 2;;
+                     ^^
+Error: Syntax error: ')' expected
+Line 2, characters 12-13:
+2 | simple_expr.(3; 2;;
+                ^
+  This '(' might be unmatched
+Line 2, characters 17-19:
+2 | simple_expr.[3; 2;;
+                     ^^
+Error: Syntax error: ']' expected
+Line 2, characters 12-13:
+2 | simple_expr.[3; 2;;
+                ^
+  This '[' might be unmatched
+Line 2, characters 15-17:
+2 | simple_expr.%[3;;
+                   ^^
+Error: Syntax error: ']' expected
+Line 2, characters 13-14:
+2 | simple_expr.%[3;;
+                 ^
+  This '[' might be unmatched
+Line 2, characters 15-17:
+2 | simple_expr.%(3;;
+                   ^^
+Error: Syntax error: ')' expected
+Line 2, characters 13-14:
+2 | simple_expr.%(3;;
+                 ^
+  This '(' might be unmatched
+Line 2, characters 15-17:
+2 | simple_expr.%{3;;
+                   ^^
+Error: Syntax error: '}' expected
+Line 2, characters 13-14:
+2 | simple_expr.%{3;;
+                 ^
+  This '{' might be unmatched
+Line 2, characters 11-13:
+2 | foo.Bar.%[3;;
+               ^^
+Error: Syntax error: ']' expected
+Line 2, characters 9-10:
+2 | foo.Bar.%[3;;
+             ^
+  This '[' might be unmatched
+Line 2, characters 11-13:
+2 | foo.Bar.%(3;;
+               ^^
+Error: Syntax error: ')' expected
+Line 2, characters 9-10:
+2 | foo.Bar.%(3;;
+             ^
+  This '(' might be unmatched
+Line 2, characters 11-13:
+2 | foo.Bar.%{3;;
+               ^^
+Error: Syntax error: '}' expected
+Line 2, characters 9-10:
+2 | foo.Bar.%{3;;
+             ^
+  This '{' might be unmatched
+Line 2, characters 17-19:
+2 | simple_expr.{3, 2;;
+                     ^^
+Error: Syntax error: '}' expected
+Line 2, characters 12-13:
+2 | simple_expr.{3, 2;;
+                ^
+  This '{' might be unmatched
+Line 2, characters 10-12:
+2 | { x = 3; y;;
+              ^^
+Error: Syntax error: '}' expected
+Line 2, characters 0-1:
+2 | { x = 3; y;;
+    ^
+  This '{' might be unmatched
+Line 2, characters 16-18:
+2 | List.{ x = 3; y ;;
+                    ^^
+Error: Syntax error: '}' expected
+Line 2, characters 5-6:
+2 | List.{ x = 3; y ;;
+         ^
+  This '{' might be unmatched
+Line 2, characters 7-9:
+2 | [| 3; 2;;
+           ^^
+Error: Syntax error: '|]' expected
+Line 2, characters 0-2:
+2 | [| 3; 2;;
+    ^^
+  This '[|' might be unmatched
+Line 2, characters 11-13:
+2 | List.[|3; 2;;
+               ^^
+Error: Syntax error: '|]' expected
+Line 2, characters 5-7:
+2 | List.[|3; 2;;
+         ^^
+  This '[|' might be unmatched
+Line 2, characters 5-7:
+2 | [3; 2;;
+         ^^
+Error: Syntax error: ']' expected
+Line 2, characters 0-1:
+2 | [3; 2;;
+    ^
+  This '[' might be unmatched
+Line 2, characters 10-12:
+2 | List.[3; 2;;
+              ^^
+Error: Syntax error: ']' expected
+Line 2, characters 5-6:
+2 | List.[3; 2;;
+         ^
+  This '[' might be unmatched
+Line 2, characters 13-15:
+2 | {< x = 3; y; ;;
+                 ^^
+Error: Syntax error: '>}' expected
+Line 2, characters 0-2:
+2 | {< x = 3; y; ;;
+    ^^
+  This '{<' might be unmatched
+Line 2, characters 17-19:
+2 | List.{< x = 3; y ;;
+                     ^^
+Error: Syntax error: '>}' expected
+Line 2, characters 5-7:
+2 | List.{< x = 3; y ;;
+         ^^
+  This '{<' might be unmatched
+Line 2, characters 20-22:
+2 | (module struct end :;;
+                        ^^
+Error: Syntax error: ')' expected
+Line 2, characters 0-1:
+2 | (module struct end :;;
+    ^
+  This '(' might be unmatched
+Line 2, characters 25-27:
+2 | List.(module struct end :;;
+                             ^^
+Error: Syntax error: ')' expected
+Line 2, characters 5-6:
+2 | List.(module struct end :;;
+         ^
+  This '(' might be unmatched
+
+Line 2, characters 2-3:
+2 | (=;
+      ^
+Error: Syntax error: ')' expected
+Line 2, characters 0-1:
+2 | (=;
+    ^
+  This '(' might be unmatched
+
diff --git a/testsuite/tests/parse-errors/unclosed_simple_expr.ml b/testsuite/tests/parse-errors/unclosed_simple_expr.ml
new file mode 100644
index 00000000..ceeb77ff
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_simple_expr.ml
@@ -0,0 +1,49 @@
+(* TEST
+   * toplevel
+*)
+
+(3; 2;;
+
+begin 3; 2;;
+
+List.(3; 2;;
+
+simple_expr.(3; 2;;
+
+simple_expr.[3; 2;;
+
+simple_expr.%[3;;
+
+simple_expr.%(3;;
+
+simple_expr.%{3;;
+
+foo.Bar.%[3;;
+
+foo.Bar.%(3;;
+
+foo.Bar.%{3;;
+
+simple_expr.{3, 2;;
+
+{ x = 3; y;;
+
+List.{ x = 3; y ;;
+
+[| 3; 2;;
+
+List.[|3; 2;;
+
+[3; 2;;
+
+List.[3; 2;;
+
+{< x = 3; y; ;;
+
+List.{< x = 3; y ;;
+
+(module struct end :;;
+
+List.(module struct end :;;
+
+(=;
diff --git a/testsuite/tests/parse-errors/unclosed_simple_pattern.compilers.reference b/testsuite/tests/parse-errors/unclosed_simple_pattern.compilers.reference
new file mode 100644
index 00000000..825979ab
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_simple_pattern.compilers.reference
@@ -0,0 +1,53 @@
+Line 7, characters 0-2:
+7 | ;;
+    ^^
+Error: Syntax error: ')' expected
+Line 6, characters 9-10:
+6 |   | List.(_
+             ^
+  This '(' might be unmatched
+Line 4, characters 0-2:
+4 | ;;
+    ^^
+Error: Syntax error: ')' expected
+Line 3, characters 4-5:
+3 |   | (_
+        ^
+  This '(' might be unmatched
+Line 4, characters 0-2:
+4 | ;;
+    ^^
+Error: Syntax error: ')' expected
+Line 3, characters 4-5:
+3 |   | (_ : int
+        ^
+  This '(' might be unmatched
+Line 6, characters 18-25:
+6 |   | (module Foo : sig end
+                      ^^^^^^^
+Error: invalid package type: only module type identifier and 'with type' constraints are supported
+Line 7, characters 0-2:
+7 | ;;
+    ^^
+Error: Syntax error: '}' expected
+Line 6, characters 4-5:
+6 |   | { foo; bar;
+        ^
+  This '{' might be unmatched
+Line 4, characters 0-2:
+4 | ;;
+    ^^
+Error: Syntax error: ']' expected
+Line 3, characters 4-5:
+3 |   | [ 1; 2;
+        ^
+  This '[' might be unmatched
+Line 4, characters 0-2:
+4 | ;;
+    ^^
+Error: Syntax error: '|]' expected
+Line 3, characters 4-6:
+3 |   | [| 3; 4;
+        ^^
+  This '[|' might be unmatched
+
diff --git a/testsuite/tests/parse-errors/unclosed_simple_pattern.ml b/testsuite/tests/parse-errors/unclosed_simple_pattern.ml
new file mode 100644
index 00000000..f0878848
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_simple_pattern.ml
@@ -0,0 +1,37 @@
+(* TEST
+   * toplevel
+*)
+
+let f = function
+  | List.(_
+;;
+
+let f = function
+  | (_
+;;
+
+let f = function
+  | (_ : int
+;;
+
+(* Impossible to get the "unclosed (" message here. This case gets absorbed by
+   val_ident... *)
+
+let f = function
+  | (module Foo : sig end
+;;
+
+(* As with expressions, impossible to get the unclosed message for the following
+   cases. *)
+
+let f = function
+  | { foo; bar;
+;;
+
+let f = function
+  | [ 1; 2;
+;;
+
+let f = function
+  | [| 3; 4;
+;;
diff --git a/testsuite/tests/parse-errors/unclosed_struct.compilers.reference b/testsuite/tests/parse-errors/unclosed_struct.compilers.reference
new file mode 100644
index 00000000..59bc1c60
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_struct.compilers.reference
@@ -0,0 +1,6 @@
+File "unclosed_struct.ml", line 10, characters 0-0:
+Error: Syntax error: 'end' expected
+File "unclosed_struct.ml", line 8, characters 11-17:
+8 | module M = struct
+               ^^^^^^
+  This 'struct' might be unmatched
diff --git a/testsuite/tests/parse-errors/unclosed_struct.ml b/testsuite/tests/parse-errors/unclosed_struct.ml
new file mode 100644
index 00000000..6066f1e8
--- /dev/null
+++ b/testsuite/tests/parse-errors/unclosed_struct.ml
@@ -0,0 +1,9 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
+
+module M = struct
+  type t = T
diff --git a/testsuite/tests/parsetree/source.ml b/testsuite/tests/parsetree/source.ml
new file mode 100644
index 00000000..93a0d263
--- /dev/null
+++ b/testsuite/tests/parsetree/source.ml
@@ -0,0 +1,7374 @@
+[@@@foo]
+
+let (x[@foo]) : unit [@foo] = ()[@foo]
+  [@@foo]
+
+type t =
+  | Foo of (t[@foo]) [@foo]
+[@@foo]
+
+[@@@foo]
+
+
+module M = struct
+  type t = {
+    l : (t [@foo]) [@foo]
+  }
+    [@@foo]
+    [@@foo]
+
+  [@@@foo]
+end[@foo]
+[@@foo]
+
+module type S = sig
+
+  include (module type of (M[@foo]))[@foo] with type t := M.t[@foo]
+    [@@foo]
+
+  [@@@foo]
+
+end[@foo]
+[@@foo]
+
+[@@@foo]
+type 'a with_default
+  =  ?size:int       (** default [42] *)
+  -> ?resizable:bool (** default [true] *)
+  -> 'a
+
+type obj = <
+  meth1 : int -> int;
+  (** method 1 *)
+
+  meth2: unit -> float (** method 2 *);
+>
+
+type var = [
+  | `Foo (** foo *)
+  | `Bar of int * string (** bar *)
+]
+
+[%%foo let x = 1 in x]
+let [%foo 2+1] : [%foo bar.baz] = [%foo "foo"]
+
+[%%foo module M = [%bar] ]
+let [%foo let () = () ] : [%foo type t = t ] = [%foo class c = object end]
+
+[%%foo: 'a list]
+let [%foo: [`Foo] ] : [%foo: t -> t ] = [%foo: < foo : t > ]
+
+[%%foo? _ ]
+[%%foo? Some y when y > 0]
+let [%foo? (Bar x | Baz x) ] : [%foo? #bar ] = [%foo? { x }]
+
+[%%foo: module M : [%baz]]
+let [%foo: include S with type t = t ]
+  : [%foo: val x : t  val y : t]
+  = [%foo: type t = t ]
+let int_with_custom_modifier =
+  1234567890_1234567890_1234567890_1234567890_1234567890z
+let float_with_custom_modifier =
+  1234567890_1234567890_1234567890_1234567890_1234567890.z
+
+let int32     = 1234l
+let int64     = 1234L
+let nativeint = 1234n
+
+let hex_without_modifier = 0x32f
+let hex_with_modifier    = 0x32g
+
+let float_without_modifer = 1.2e3
+let float_with_modifer    = 1.2g
+let%foo x = 42
+let%foo _ = () and _ = ()
+let%foo _ = ()
+
+(* Expressions *)
+let () =
+  let%foo[@foo] x = 3
+  and[@foo] y = 4 in
+  (let module%foo[@foo] M = M in ()) ;
+  (let open%foo[@foo] M in ()) ;
+  (fun%foo[@foo] x -> ()) ;
+  (function%foo[@foo] x -> ()) ;
+  (try%foo[@foo] () with _ -> ()) ;
+  (if%foo[@foo] () then () else ()) ;
+  while%foo[@foo] () do () done ;
+  for%foo[@foo] x = () to () do () done ;
+  assert%foo[@foo] true ;
+  lazy%foo[@foo] x ;
+  object%foo[@foo] end ;
+  begin%foo[@foo] 3 end ;
+  new%foo[@foo] x ;
+
+  match%foo[@foo] () with
+  (* Pattern expressions *)
+  | lazy%foo[@foo] x -> ()
+  | exception%foo[@foo] x -> ()
+
+(* Class expressions *)
+class x =
+  fun[@foo] x ->
+  let[@foo] x = 3 in
+  object[@foo]
+    inherit[@foo] x
+    val[@foo] x = 3
+    val[@foo] virtual x : t
+    val![@foo] mutable x = 3
+    method[@foo] x = 3
+    method[@foo] virtual x : t
+    method![@foo] private x = 3
+    initializer[@foo] x
+  end
+
+(* Class type expressions *)
+class type t =
+  object[@foo]
+    inherit[@foo] t
+    val[@foo] x : t
+    val[@foo] mutable x : t
+    method[@foo] x : t
+    method[@foo] private x : t
+    constraint[@foo] t = t'
+    [@@@abc]
+    [%%id]
+    [@@@aaa]
+  end
+
+(* Type expressions *)
+type t =
+  (module%foo[@foo] M)
+
+(* Module expressions *)
+module M =
+  functor[@foo] (M : S) ->
+    (val[@foo] x)
+    (struct[@foo] end)
+
+(* Module type expression *)
+module type S =
+  functor[@foo] (M:S) ->
+    (module type of[@foo] M) ->
+    (sig[@foo] end)
+
+module type S = S -> S -> S
+module type S = (S -> S) -> S
+module type S = functor (M : S) -> S -> S
+module type S = (functor (M : S) -> S) -> S
+module type S = (S -> S)[@foo] -> S
+module type S = (functor[@foo] (M : S) -> S) -> S
+
+module type S = sig
+  module rec A : (S with type t = t)
+  and B : (S with type t = t)
+end
+
+(* Structure items *)
+let%foo[@foo] x = 4
+and[@foo] y = x
+
+type%foo[@foo] t = int
+and[@foo] t = int
+type%foo[@foo] t += T
+
+class%foo[@foo] x = x
+class type%foo[@foo] x = x
+external%foo[@foo] x : _  = ""
+exception%foo[@foo] X
+
+module%foo[@foo] M = M
+module%foo[@foo] rec M : S = M
+and[@foo] M : S = M
+module type%foo[@foo] S = S
+
+include%foo[@foo] M
+open%foo[@foo] M
+
+(* Signature items *)
+module type S = sig
+  val%foo[@foo] x : t
+  external%foo[@foo] x : t = ""
+
+  type%foo[@foo] t = int
+  and[@foo] t' = int
+  type%foo[@foo] t += T
+
+  exception%foo[@foo] X
+
+  module%foo[@foo] M : S
+  module%foo[@foo] rec M : S
+  and[@foo] M : S
+  module%foo[@foo] M = M
+
+  module type%foo[@foo] S = S
+
+  include%foo[@foo] M
+  open%foo[@foo] M
+
+  class%foo[@foo] x : t
+  class type%foo[@foo] x = x
+
+end
+
+type t = ..;;
+type t += A;;
+
+[%extension_constructor A];;
+([%extension_constructor A] : extension_constructor);;
+
+module M = struct
+  type extension_constructor = int
+end;;
+
+open M;;
+
+([%extension_constructor A] : extension_constructor);;
+
+(* By using two types we can have a recursive constraint *)
+type 'a class_name = .. constraint 'a = < cast: 'a. 'a name -> 'a; ..>
+and 'a name =
+  Class : 'a class_name -> (< cast: 'a. 'a name -> 'a; ..> as 'a) name
+;;
+
+exception Bad_cast
+;;
+
+class type castable =
+object
+  method cast: 'a.'a name -> 'a
+end
+;;
+
+(* Lets create a castable class with a name*)
+
+class type foo_t =
+object
+  inherit castable
+  method foo: string
+end
+;;
+
+type 'a class_name += Foo: foo_t class_name
+;;
+
+class foo: foo_t =
+object(self)
+  method cast: type a. a name -> a =
+    function
+        Class Foo -> (self :> foo_t)
+      | _ -> ((raise Bad_cast) : a)
+  method foo = "foo"
+end
+;;
+
+(* Now we can create a subclass of foo *)
+
+class type bar_t =
+object
+  inherit foo
+  method bar: string
+end
+;;
+
+type 'a class_name += Bar: bar_t class_name
+;;
+
+class bar: bar_t =
+object(self)
+  inherit foo as super
+  method cast: type a. a name -> a =
+    function
+        Class Bar -> (self :> bar_t)
+      | other -> super#cast other
+  method bar = "bar"
+  [@@@id]
+  [%%id]
+end
+;;
+
+(* Now lets create a mutable list of castable objects *)
+
+let clist :castable list ref = ref []
+;;
+
+let push_castable (c: #castable) =
+  clist := (c :> castable) :: !clist
+;;
+
+let pop_castable () =
+  match !clist with
+      c :: rest ->
+        clist := rest;
+        c
+    | [] -> raise Not_found
+;;
+
+(* We can add foos and bars to this list, and retrieve them *)
+
+push_castable (new foo);;
+push_castable (new bar);;
+push_castable (new foo);;
+
+let c1: castable = pop_castable ();;
+let c2: castable = pop_castable ();;
+let c3: castable = pop_castable ();;
+
+(* We can also downcast these values to foos and bars *)
+
+let f1: foo = c1#cast (Class Foo);; (* Ok *)
+let f2: foo = c2#cast (Class Foo);; (* Ok *)
+let f3: foo = c3#cast (Class Foo);; (* Ok *)
+
+let b1: bar = c1#cast (Class Bar);; (* Exception Bad_cast *)
+let b2: bar = c2#cast (Class Bar);; (* Ok *)
+let b3: bar = c3#cast (Class Bar);; (* Exception Bad_cast *)
+
+type foo = ..
+;;
+
+type foo +=
+    A
+  | B of int
+;;
+
+let is_a x =
+  match x with
+    A -> true
+  | _ -> false
+;;
+
+(* The type must be open to create extension *)
+
+type foo
+;;
+
+type foo += A of int (* Error type is not open *)
+;;
+
+(* The type parameters must match *)
+
+type 'a foo = ..
+;;
+
+type ('a, 'b) foo += A of int (* Error: type parameter mismatch *)
+;;
+
+(* In a signature the type does not have to be open *)
+
+module type S =
+sig
+  type foo
+  type foo += A of float
+end
+;;
+
+(* But it must still be extensible *)
+
+module type S =
+sig
+  type foo = A of int
+  type foo += B of float (* Error foo does not have an extensible type *)
+end
+;;
+
+(* Signatures can change the grouping of extensions *)
+
+type foo = ..
+;;
+
+module M = struct
+  type foo +=
+      A of int
+    | B of string
+
+  type foo +=
+      C of int
+    | D of float
+end
+;;
+
+module type S = sig
+  type foo +=
+      B of string
+    | C of int
+
+  type foo += D of float
+
+  type foo += A of int
+end
+;;
+
+module M_S = (M : S)
+;;
+
+(* Extensions can be GADTs *)
+
+type 'a foo = ..
+;;
+
+type _ foo +=
+    A : int -> int foo
+  | B : int foo
+;;
+
+let get_num : type a. a foo -> a -> a option = fun f i1 ->
+    match f with
+        A i2 -> Some (i1 + i2)
+     |  _ -> None
+;;
+
+(* Extensions must obey constraints *)
+
+type 'a foo = .. constraint 'a = [> `Var ]
+;;
+
+type 'a foo += A of 'a
+;;
+
+let a = A 9 (* ERROR: Constraints not met *)
+;;
+
+type 'a foo += B : int foo (* ERROR: Constraints not met *)
+;;
+
+(* Signatures can make an extension private *)
+
+type foo = ..
+;;
+
+module M = struct type foo += A of int end
+;;
+
+let a1 = M.A 10
+;;
+
+module type S = sig type foo += private A of int end
+;;
+
+module M_S = (M : S)
+;;
+
+let is_s x =
+  match x with
+    M_S.A _ -> true
+  | _ -> false
+;;
+
+let a2 = M_S.A 20 (* ERROR: Cannot create a value using a private constructor *)
+;;
+
+(* Extensions can be rebound *)
+
+type foo = ..
+;;
+
+module M = struct type foo += A1 of int end
+;;
+
+type foo += A2 = M.A1
+;;
+
+type bar = ..
+;;
+
+type bar += A3 = M.A1    (* Error: rebind wrong type *)
+;;
+
+module M = struct type foo += private B1 of int end
+;;
+
+type foo += private B2 = M.B1
+;;
+
+type foo += B3 = M.B1  (* Error: rebind private extension *)
+;;
+
+type foo += C = Unknown  (* Error: unbound extension *)
+;;
+
+(* Extensions can be rebound even if type is closed *)
+
+module M : sig type foo type foo += A1 of int end
+  = struct type foo = .. type foo += A1 of int end
+
+type M.foo += A2 = M.A1
+
+(* Rebinding handles abbreviations *)
+
+type 'a foo = ..
+;;
+
+type 'a foo1 = 'a foo = ..
+;;
+
+type 'a foo2 = 'a foo = ..
+;;
+
+type 'a foo1 +=
+    A of int
+  | B of 'a
+  | C : int foo1
+;;
+
+type 'a foo2 +=
+    D = A
+  | E = B
+  | F = C
+;;
+
+(* Extensions must obey variances *)
+
+type +'a foo = ..
+;;
+
+type 'a foo += A of (int -> 'a)
+;;
+
+type 'a foo += B of ('a -> int)
+    (* ERROR: Parameter variances are not satisfied *)
+;;
+
+type _ foo += C : ('a -> int) -> 'a foo
+    (* ERROR: Parameter variances are not satisfied *)
+;;
+
+type 'a bar = ..
+;;
+
+type +'a bar += D of (int -> 'a) (* ERROR: type variances do not match *)
+;;
+
+(* Exceptions are compatible with extensions *)
+
+module M : sig
+  type exn +=
+      Foo of int * float
+    | Bar : 'a list -> exn
+end = struct
+  exception Bar : 'a list -> exn
+  exception Foo of int * float
+end
+;;
+
+module M : sig
+  exception Bar : 'a list -> exn
+  exception Foo of int * float
+end = struct
+  type exn +=
+      Foo of int * float
+    | Bar : 'a list -> exn
+end
+;;
+
+exception Foo of int * float
+;;
+
+exception Bar : 'a list -> exn
+;;
+
+module M : sig
+  type exn +=
+      Foo of int * float
+    | Bar : 'a list -> exn
+end = struct
+  exception Bar = Bar
+  exception Foo = Foo
+end
+;;
+
+(* Test toplevel printing *)
+
+type foo = ..
+;;
+
+type foo +=
+    Foo of int * int option
+  | Bar of int option
+;;
+
+let x = Foo(3, Some 4), Bar(Some 5) (* Prints Foo and Bar successfully *)
+;;
+
+type foo += Foo of string
+;;
+
+let y = x (* Prints Bar but not Foo (which has been shadowed) *)
+;;
+
+exception Foo of int * int option
+;;
+
+exception Bar of int option
+;;
+
+let x = Foo(3, Some 4), Bar(Some 5) (* Prints Foo and Bar successfully *)
+;;
+
+type foo += Foo of string
+;;
+
+let y = x (* Prints Bar and part of Foo (which has been shadowed) *)
+;;
+
+(* Test Obj functions *)
+
+type foo = ..
+;;
+
+type foo +=
+    Foo
+  | Bar of int
+;;
+
+let extension_name e = Obj.extension_name (Obj.extension_constructor e);;
+let extension_id e = Obj.extension_id (Obj.extension_constructor e);;
+
+let n1 = extension_name Foo
+;;
+
+let n2 = extension_name (Bar 1)
+;;
+
+let t = (extension_id (Bar 2)) = (extension_id (Bar 3)) (* true *)
+;;
+
+let f = (extension_id (Bar 2)) = (extension_id Foo) (* false *)
+;;
+
+let is_foo x = (extension_id Foo) = (extension_id x)
+
+type foo += Foo
+;;
+
+let f = is_foo Foo
+;;
+
+let _ = Obj.extension_constructor 7 (* Invald_arg *)
+;;
+
+let _ = Obj.extension_constructor (object method m = 3 end) (* Invald_arg *)
+;;
+(* Typed names *)
+
+module Msg : sig
+
+  type 'a tag
+
+  type result = Result : 'a tag * 'a -> result
+
+  val write : 'a tag -> 'a -> unit
+
+  val read : unit -> result
+
+  type 'a tag += Int : int tag
+
+  module type Desc = sig
+    type t
+    val label : string
+    val write : t -> string
+    val read : string -> t
+  end
+
+  module Define (D : Desc) : sig
+    type 'a tag += C : D.t tag
+  end
+
+end = struct
+
+  type 'a tag = ..
+
+  type ktag = T : 'a tag -> ktag
+
+  type 'a kind =
+  { tag : 'a tag;
+    label : string;
+    write : 'a -> string;
+    read : string -> 'a; }
+
+  type rkind = K : 'a kind -> rkind
+
+  type wkind = { f : 'a . 'a tag -> 'a kind }
+
+  let readTbl : (string, rkind) Hashtbl.t = Hashtbl.create 13
+
+  let writeTbl : (ktag, wkind) Hashtbl.t = Hashtbl.create 13
+
+  let read_raw () : string * string = raise (Failure "Not implemented")
+
+  type result = Result : 'a tag * 'a -> result
+
+  let read () =
+    let label, content = read_raw () in
+      let K k = Hashtbl.find readTbl label in
+        let body = k.read content in
+          Result(k.tag, body)
+
+  let write_raw (label : string) (content : string) =
+    raise (Failure "Not implemented")
+
+  let write (tag : 'a tag) (body : 'a) =
+    let {f} = Hashtbl.find writeTbl (T tag) in
+    let k = f tag in
+    let content = k.write body in
+      write_raw k.label content
+
+  (* Add int kind *)
+
+  type 'a tag += Int : int tag
+
+  let ik =
+    { tag = Int;
+      label = "int";
+      write = Int.to_string;
+      read = int_of_string }
+
+  let () = Hashtbl.add readTbl "int" (K ik)
+
+  let () =
+    let f (type t) (i : t tag) : t kind =
+      match i with
+        Int -> ik
+      | _ -> assert false
+    in
+      Hashtbl.add writeTbl (T Int) {f}
+
+  (* Support user defined kinds *)
+
+  module type Desc = sig
+    type t
+    val label : string
+    val write : t -> string
+    val read : string -> t
+  end
+
+  module Define (D : Desc) = struct
+    type 'a tag += C : D.t tag
+    let k =
+      { tag = C;
+        label = D.label;
+        write = D.write;
+        read = D.read }
+    let () = Hashtbl.add readTbl D.label (K k)
+    let () =
+      let f (type t) (c : t tag) : t kind =
+        match c with
+          C -> k
+        | _ -> assert false
+      in
+        Hashtbl.add writeTbl (T C) {f}
+  end
+
+end;;
+
+let write_int i = Msg.write Msg.Int i;;
+
+module StrM = Msg.Define(struct
+  type t = string
+  let label = "string"
+  let read s = s
+  let write s = s
+end);;
+
+type 'a Msg.tag += String = StrM.C;;
+
+let write_string s = Msg.write String s;;
+
+let read_one () =
+  let Msg.Result(tag, body) = Msg.read () in
+  match tag with
+    Msg.Int -> print_int body
+  | String -> print_string body
+  | _ -> print_string "Unknown";;
+(* Example of algorithm parametrized with modules *)
+
+let sort (type s) set l =
+  let module Set = (val set : Set.S with type elt = s) in
+  Set.elements (List.fold_right Set.add l Set.empty)
+
+let make_set (type s) cmp =
+  let module S = Set.Make(struct
+    type t = s
+    let compare = cmp
+  end) in
+  (module S : Set.S with type elt = s)
+
+let both l =
+  List.map
+    (fun set -> sort set l)
+    [ make_set compare; make_set (fun x y -> compare y x) ]
+
+let () =
+  print_endline (String.concat "  " (List.map (String.concat "/")
+                                              (both ["abc";"xyz";"def"])))
+
+
+(* Hiding the internal representation *)
+
+module type S = sig
+  type t
+  val to_string: t -> string
+  val apply: t -> t
+  val x: t
+end
+
+let create (type s) to_string apply x =
+  let module M = struct
+    type t = s
+    let to_string = to_string
+    let apply = apply
+    let x = x
+  end in
+  (module M : S with type t = s)
+
+let forget (type s) x =
+  let module M = (val x : S with type t = s) in
+  (module M : S)
+
+let print x =
+  let module M = (val x : S) in
+  print_endline (M.to_string M.x)
+
+let apply x =
+  let module M = (val x : S) in
+  let module N = struct
+    include M
+    let x = apply x
+  end in
+  (module N : S)
+
+let () =
+  let int = forget (create Int.to_string succ 0) in
+  let str = forget (create (fun s -> s) (fun s -> s ^ s) "X") in
+  List.iter print (List.map apply [int; apply int; apply (apply str)])
+
+
+(* Existential types + type equality witnesses -> pseudo GADT *)
+
+module TypEq : sig
+  type ('a, 'b) t
+  val apply: ('a, 'b) t -> 'a -> 'b
+  val refl: ('a, 'a) t
+  val sym: ('a, 'b) t -> ('b, 'a) t
+end = struct
+  type ('a, 'b) t = unit
+  let apply _ = Obj.magic
+  let refl = ()
+  let sym () = ()
+end
+
+
+module rec Typ : sig
+  module type PAIR = sig
+    type t
+    type t1
+    type t2
+    val eq: (t, t1 * t2) TypEq.t
+    val t1: t1 Typ.typ
+    val t2: t2 Typ.typ
+  end
+
+  type 'a typ =
+    | Int of ('a, int) TypEq.t
+    | String of ('a, string) TypEq.t
+    | Pair of (module PAIR with type t = 'a)
+end = struct
+  module type PAIR = sig
+    type t
+    type t1
+    type t2
+    val eq: (t, t1 * t2) TypEq.t
+    val t1: t1 Typ.typ
+    val t2: t2 Typ.typ
+  end
+
+  type 'a typ =
+    | Int of ('a, int) TypEq.t
+    | String of ('a, string) TypEq.t
+    | Pair of (module PAIR with type t = 'a)
+end
+
+open Typ
+
+let int = Int TypEq.refl
+
+let str = String TypEq.refl
+
+let pair (type s1) (type s2) t1 t2 =
+  let module P = struct
+    type t = s1 * s2
+    type t1 = s1
+    type t2 = s2
+    let eq = TypEq.refl
+    let t1 = t1
+    let t2 = t2
+  end in
+  let pair = (module P : PAIR with type t = s1 * s2) in
+  Pair pair
+
+module rec Print : sig
+  val to_string: 'a Typ.typ -> 'a -> string
+end = struct
+  let to_string (type s) t x =
+    match t with
+    | Int eq -> Int.to_string (TypEq.apply eq x)
+    | String eq -> Printf.sprintf "%S" (TypEq.apply eq x)
+    | Pair p ->
+        let module P = (val p : PAIR with type t = s) in
+        let (x1, x2) = TypEq.apply P.eq x in
+        Printf.sprintf "(%s,%s)" (Print.to_string P.t1 x1)
+                       (Print.to_string P.t2 x2)
+end
+
+let () =
+  print_endline (Print.to_string int 10);
+  print_endline (Print.to_string (pair int (pair str int)) (123, ("A", 456)))
+
+
+(* #6262: first-class modules and module type aliases *)
+
+module type S1 = sig end
+module type S2 = S1
+
+let _f (x : (module S1)) : (module S2) = x
+
+module X = struct
+  module type S
+end
+module Y = struct include X end
+
+let _f (x : (module X.S)) : (module Y.S) = x
+
+(* PR#6194, main example *)
+module type S3 = sig val x : bool end;;
+let f = function
+  | Some (module M : S3) when M.x ->1
+  | Some _ [@foooo]-> 2
+  | None -> 3
+;;
+print_endline (Int.to_string (f (Some (module struct let x = false end))));;
+type 'a ty =
+  | Int : int ty
+  | Bool : bool ty
+
+let fbool (type t) (x : t) (tag : t ty) =
+  match tag with
+  | Bool -> x
+;;
+(* val fbool : 'a -> 'a ty -> 'a = <fun> *)
+(** OK: the return value is x of type t **)
+
+let fint (type t) (x : t) (tag : t ty) =
+  match tag with
+  | Int -> x > 0
+;;
+(* val fint : 'a -> 'a ty -> bool = <fun> *)
+(** OK: the return value is x > 0 of type bool;
+This has used the equation t = bool, not visible in the return type **)
+
+let f (type t) (x : t) (tag : t ty) =
+  match tag with
+  | Int -> x > 0
+  | Bool -> x
+(* val f : 'a -> 'a ty -> bool = <fun> *)
+
+
+let g (type t) (x : t) (tag : t ty) =
+  match tag with
+  | Bool -> x
+  | Int -> x > 0
+(* Error: This expression has type bool but an expression was expected of type
+t = int *)
+
+let id x = x;;
+let idb1 = (fun id -> let _ = id true in id) id;;
+let idb2 : bool -> bool = id;;
+let idb3 ( _ : bool ) = false;;
+
+let g (type t) (x : t) (tag : t ty) =
+  match tag with
+  | Bool -> idb3 x
+  | Int -> x > 0
+
+let g (type t) (x : t) (tag : t ty) =
+  match tag with
+  | Bool -> idb2 x
+  | Int -> x > 0
+(* Encoding generics using GADTs *)
+(* (c) Alain Frisch / Lexifi *)
+(* cf. http://www.lexifi.com/blog/dynamic-types *)
+
+(* Basic tag *)
+
+type 'a ty =
+  | Int: int ty
+  | String: string ty
+  | List: 'a ty -> 'a list ty
+  | Pair: ('a ty * 'b ty) -> ('a * 'b) ty
+;;
+
+(* Tagging data *)
+
+type variant =
+  | VInt of int
+  | VString of string
+  | VList of variant list
+  | VPair of variant * variant
+
+let rec variantize: type t. t ty -> t -> variant =
+  fun ty x ->
+    (* type t is abstract here *)
+    match ty with
+    | Int -> VInt x  (* in this branch: t = int *)
+    | String -> VString x (* t = string *)
+    | List ty1 ->
+        VList (List.map (variantize ty1) x)
+        (* t = 'a list for some 'a *)
+    | Pair (ty1, ty2) ->
+        VPair (variantize ty1 (fst x), variantize ty2 (snd x))
+        (* t = ('a, 'b) for some 'a and 'b *)
+
+exception VariantMismatch
+
+let rec devariantize: type t. t ty -> variant -> t =
+  fun ty v ->
+    match ty, v with
+    | Int, VInt x -> x
+    | String, VString x -> x
+    | List ty1, VList vl ->
+        List.map (devariantize ty1) vl
+    | Pair (ty1, ty2), VPair (x1, x2) ->
+        (devariantize ty1 x1, devariantize ty2 x2)
+    | _ -> raise VariantMismatch
+;;
+
+(* Handling records *)
+
+type 'a ty =
+  | Int: int ty
+  | String: string ty
+  | List: 'a ty -> 'a list ty
+  | Pair: ('a ty * 'b ty) -> ('a * 'b) ty
+  | Record: 'a record -> 'a ty
+
+and 'a record =
+    {
+     path: string;
+     fields: 'a field_ list;
+    }
+
+and 'a field_ =
+  | Field: ('a, 'b) field -> 'a field_
+
+and ('a, 'b) field =
+    {
+     label: string;
+     field_type: 'b ty;
+     get: ('a -> 'b);
+    }
+;;
+
+(* Again *)
+
+type variant =
+  | VInt of int
+  | VString of string
+  | VList of variant list
+  | VPair of variant * variant
+  | VRecord of (string * variant) list
+
+let rec variantize: type t. t ty -> t -> variant =
+  fun ty x ->
+    (* type t is abstract here *)
+    match ty with
+    | Int -> VInt x  (* in this branch: t = int *)
+    | String -> VString x (* t = string *)
+    | List ty1 ->
+        VList (List.map (variantize ty1) x)
+        (* t = 'a list for some 'a *)
+    | Pair (ty1, ty2) ->
+        VPair (variantize ty1 (fst x), variantize ty2 (snd x))
+        (* t = ('a, 'b) for some 'a and 'b *)
+    | Record {fields} ->
+        VRecord
+          (List.map (fun (Field{field_type; label; get}) ->
+                       (label, variantize field_type (get x))) fields)
+;;
+
+(* Extraction *)
+
+type 'a ty =
+  | Int: int ty
+  | String: string ty
+  | List: 'a ty -> 'a list ty
+  | Pair: ('a ty * 'b ty) -> ('a * 'b) ty
+  | Record: ('a, 'builder) record -> 'a ty
+
+and ('a, 'builder) record =
+    {
+     path: string;
+     fields: ('a, 'builder) field list;
+     create_builder: (unit -> 'builder);
+     of_builder: ('builder -> 'a);
+    }
+
+and ('a, 'builder) field =
+  | Field: ('a, 'builder, 'b) field_ -> ('a, 'builder) field
+
+and ('a, 'builder, 'b) field_ =
+  {
+   label: string;
+   field_type: 'b ty;
+   get: ('a -> 'b);
+   set: ('builder -> 'b -> unit);
+  }
+
+let rec devariantize: type t. t ty -> variant -> t =
+  fun ty v ->
+    match ty, v with
+    | Int, VInt x -> x
+    | String, VString x -> x
+    | List ty1, VList vl ->
+        List.map (devariantize ty1) vl
+    | Pair (ty1, ty2), VPair (x1, x2) ->
+        (devariantize ty1 x1, devariantize ty2 x2)
+    | Record {fields; create_builder; of_builder}, VRecord fl ->
+        if List.length fields <> List.length fl then raise VariantMismatch;
+        let builder = create_builder () in
+        List.iter2
+          (fun (Field {label; field_type; set}) (lab, v) ->
+            if label <> lab then raise VariantMismatch;
+            set builder (devariantize field_type v)
+          )
+          fields fl;
+        of_builder builder
+    | _ -> raise VariantMismatch
+;;
+
+type my_record  =
+    {
+     a: int;
+     b: string list;
+    }
+
+let my_record =
+  let fields =
+    [
+     Field {label = "a"; field_type = Int;
+            get = (fun {a} -> a);
+            set = (fun (r, _) x -> r := Some x)};
+     Field {label = "b"; field_type = List String;
+            get = (fun {b} -> b);
+            set = (fun (_, r) x -> r := Some x)};
+    ]
+  in
+  let create_builder () = (ref None, ref None) in
+  let of_builder (a, b) =
+    match !a, !b with
+    | Some a, Some b -> {a; b}
+    | _ -> failwith "Some fields are missing in record of type my_record"
+  in
+  Record {path = "My_module.my_record"; fields; create_builder; of_builder}
+;;
+
+(* Extension to recursive types and polymorphic variants *)
+(* by Jacques Garrigue *)
+
+type noarg = Noarg
+
+type (_,_) ty =
+  | Int: (int,_) ty
+  | String: (string,_) ty
+  | List: ('a,'e) ty -> ('a list, 'e) ty
+  | Option: ('a,'e) ty -> ('a option, 'e) ty
+  | Pair: (('a,'e) ty * ('b,'e) ty) -> ('a * 'b,'e) ty
+  (* Support for type variables and recursive types *)
+  | Var: ('a, 'a -> 'e) ty
+  | Rec: ('a, 'a -> 'e) ty -> ('a,'e) ty
+  | Pop: ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  (* Change the representation of a type *)
+  | Conv: string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  (* Sum types (both normal sums and polymorphic variants) *)
+  | Sum: ('a, 'e, 'b) ty_sum -> ('a, 'e) ty
+
+and ('a, 'e, 'b) ty_sum =
+    { sum_proj: 'a -> string * 'e ty_dyn option;
+      sum_cases: (string * ('e,'b) ty_case) list;
+      sum_inj: 'c. ('b,'c) ty_sel * 'c -> 'a; }
+
+and 'e ty_dyn =              (* dynamic type *)
+  | Tdyn : ('a,'e) ty * 'a -> 'e ty_dyn
+
+and (_,_) ty_sel =           (* selector from a list of types *)
+  | Thd : ('a -> 'b, 'a) ty_sel
+  | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
+
+and (_,_) ty_case =          (* type a sum case *)
+  | TCarg : ('b,'a) ty_sel * ('a,'e) ty -> ('e,'b) ty_case
+  | TCnoarg : ('b,noarg) ty_sel -> ('e,'b) ty_case
+;;
+
+type _ ty_env =              (* type variable substitution *)
+  | Enil : unit ty_env
+  | Econs : ('a,'e) ty * 'e ty_env -> ('a -> 'e) ty_env
+;;
+
+(* Comparing selectors *)
+type (_,_) eq = Eq: ('a,'a) eq
+
+let rec eq_sel : type a b c. (a,b) ty_sel -> (a,c) ty_sel -> (b,c) eq option =
+  fun s1 s2 ->
+    match s1, s2 with
+    | Thd, Thd -> Some Eq
+    | Ttl s1, Ttl s2 ->
+        (match eq_sel s1 s2 with None -> None | Some Eq -> Some Eq)
+    | _ -> None
+
+(* Auxiliary function to get the type of a case from its selector *)
+let rec get_case : type a b e.
+  (b, a) ty_sel -> (string * (e,b) ty_case) list -> string * (a, e) ty option =
+  fun sel cases ->
+  match cases with
+  | (name, TCnoarg sel') :: rem ->
+      begin match eq_sel sel sel' with
+      | None -> get_case sel rem
+      | Some Eq -> name, None
+      end
+  | (name, TCarg (sel', ty)) :: rem ->
+      begin match eq_sel sel sel' with
+      | None -> get_case sel rem
+      | Some Eq -> name, Some ty
+      end
+  | [] -> raise Not_found
+;;
+
+(* Untyped representation of values *)
+type variant =
+  | VInt of int
+  | VString of string
+  | VList of variant list
+  | VOption of variant option
+  | VPair of variant * variant
+  | VConv of string * variant
+  | VSum of string * variant option
+
+let may_map f = function Some x -> Some (f x) | None -> None
+
+let rec variantize : type a e. e ty_env -> (a,e) ty -> a -> variant =
+  fun e ty v ->
+  match ty with
+  | Int -> VInt v
+  | String -> VString v
+  | List t -> VList (List.map (variantize e t) v)
+  | Option t -> VOption (may_map (variantize e t) v)
+  | Pair (t1, t2) -> VPair (variantize e t1 (fst v), variantize e t2 (snd v))
+  | Rec t -> variantize (Econs (ty, e)) t v
+  | Pop t -> (match e with Econs (_, e') -> variantize e' t v)
+  | Var -> (match e with Econs (t, e') -> variantize e' t v)
+  | Conv (s, proj, inj, t) -> VConv (s, variantize e t (proj v))
+  | Sum ops ->
+      let tag, arg = ops.sum_proj v in
+      VSum (tag, may_map (function Tdyn (ty,arg) -> variantize e ty arg) arg)
+;;
+
+let rec devariantize : type t e. e ty_env -> (t, e) ty -> variant -> t =
+  fun e ty v ->
+  match ty, v with
+  | Int, VInt x -> x
+  | String, VString x -> x
+  | List ty1, VList vl ->
+      List.map (devariantize e ty1) vl
+  | Pair (ty1, ty2), VPair (x1, x2) ->
+      (devariantize e ty1 x1, devariantize e ty2 x2)
+  | Rec t, _ -> devariantize (Econs (ty, e)) t v
+  | Pop t, _ -> (match e with Econs (_, e') -> devariantize e' t v)
+  | Var, _ -> (match e with Econs (t, e') -> devariantize e' t v)
+  | Conv (s, proj, inj, t), VConv (s', v) when s = s' ->
+      inj (devariantize e t v)
+  | Sum ops, VSum (tag, a) ->
+      begin try match List.assoc tag ops.sum_cases, a with
+      | TCarg (sel, t), Some a -> ops.sum_inj (sel, devariantize e t a)
+      | TCnoarg sel, None -> ops.sum_inj (sel, Noarg)
+      | _ -> raise VariantMismatch
+      with Not_found -> raise VariantMismatch
+      end
+  | _ -> raise VariantMismatch
+;;
+
+(* First attempt: represent 1-constructor variants using Conv *)
+let wrap_A t = Conv ("`A", (fun (`A x) -> x), (fun x -> `A x), t);;
+
+let ty a = Rec (wrap_A (Option (Pair (a, Var)))) ;;
+let v = variantize Enil (ty Int);;
+let x = v (`A (Some (1, `A (Some (2, `A None))))) ;;
+
+(* Can also use it to decompose a tuple *)
+
+let triple t1 t2 t3 =
+  Conv ("Triple", (fun (a,b,c) -> (a,(b,c))),
+        (fun (a,(b,c)) -> (a,b,c)), Pair (t1, Pair (t2, t3)))
+
+let v = variantize Enil (triple String Int Int) ("A", 2, 3) ;;
+
+(* Second attempt: introduce a real sum construct *)
+let ty_abc =
+  (* Could also use [get_case] for proj, but direct definition is shorter *)
+  let proj = function
+      `A n -> "A", Some (Tdyn (Int, n))
+    | `B s -> "B", Some (Tdyn (String, s))
+    | `C   -> "C", None
+  (* Define inj in advance to be able to write the type annotation easily *)
+  and inj : type c. (int -> string -> noarg -> unit, c) ty_sel * c ->
+    [`A of int | `B of string | `C] = function
+        Thd, v -> `A v
+      | Ttl Thd, v -> `B v
+      | Ttl (Ttl Thd), Noarg -> `C
+  in
+  (* Coherence of sum_inj and sum_cases is checked by the typing *)
+  Sum { sum_proj = proj; sum_inj = inj; sum_cases =
+        [ "A", TCarg (Thd, Int); "B", TCarg (Ttl Thd, String);
+          "C", TCnoarg (Ttl (Ttl Thd)) ] }
+;;
+
+let v = variantize Enil ty_abc (`A 3)
+let a = devariantize Enil ty_abc v
+
+(* And an example with recursion... *)
+type 'a vlist = [`Nil | `Cons of 'a * 'a vlist]
+
+let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = fun t ->
+  let tcons = Pair (Pop t, Var) in
+  Rec (Sum {
+       sum_proj = (function
+           `Nil -> "Nil", None
+         | `Cons p -> "Cons", Some (Tdyn (tcons, p)));
+       sum_cases = ["Nil", TCnoarg Thd; "Cons", TCarg (Ttl Thd, tcons)];
+       sum_inj = fun (type c) ->
+         (function
+         | Thd, Noarg -> `Nil
+         | Ttl Thd, v -> `Cons v
+         : (noarg -> a * a vlist -> unit, c) ty_sel * c -> a vlist)
+         (* One can also write the type annotation directly *)
+     })
+
+let v = variantize Enil (ty_list Int) (`Cons (1, `Cons (2, `Nil))) ;;
+
+
+(* Simpler but weaker approach *)
+
+type (_,_) ty =
+  | Int: (int,_) ty
+  | String: (string,_) ty
+  | List: ('a,'e) ty -> ('a list, 'e) ty
+  | Option: ('a,'e) ty -> ('a option, 'e) ty
+  | Pair: (('a,'e) ty * ('b,'e) ty) -> ('a * 'b,'e) ty
+  | Var: ('a, 'a -> 'e) ty
+  | Rec: ('a, 'a -> 'e) ty -> ('a,'e) ty
+  | Pop: ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  | Conv: string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  | Sum: ('a -> string * 'e ty_dyn option) * (string * 'e ty_dyn option -> 'a)
+             -> ('a, 'e) ty
+and 'e ty_dyn =
+  | Tdyn : ('a,'e) ty * 'a -> 'e ty_dyn
+
+let ty_abc : ([`A of int | `B of string | `C],'e) ty =
+  (* Could also use [get_case] for proj, but direct definition is shorter *)
+  Sum (
+  (function
+      `A n -> "A", Some (Tdyn (Int, n))
+    | `B s -> "B", Some (Tdyn (String, s))
+    | `C   -> "C", None),
+  (function
+      "A", Some (Tdyn (Int, n)) -> `A n
+    | "B", Some (Tdyn (String, s)) -> `B s
+    | "C", None -> `C
+    | _ -> invalid_arg "ty_abc"))
+;;
+
+(* Breaks: no way to pattern-match on a full recursive type *)
+let ty_list : type a e. (a,e) ty -> (a vlist,e) ty = fun t ->
+  let targ = Pair (Pop t, Var) in
+  Rec (Sum (
+  (function `Nil -> "Nil", None
+    | `Cons p -> "Cons", Some (Tdyn (targ, p))),
+  (function "Nil", None -> `Nil
+    | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p)))
+;;
+
+(* Define Sum using object instead of record for first-class polymorphism *)
+
+type (_,_) ty =
+  | Int: (int,_) ty
+  | String: (string,_) ty
+  | List: ('a,'e) ty -> ('a list, 'e) ty
+  | Option: ('a,'e) ty -> ('a option, 'e) ty
+  | Pair: (('a,'e) ty * ('b,'e) ty) -> ('a * 'b,'e) ty
+  | Var: ('a, 'a -> 'e) ty
+  | Rec: ('a, 'a -> 'e) ty -> ('a,'e) ty
+  | Pop: ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  | Conv: string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  | Sum: < proj: 'a -> string * 'e ty_dyn option;
+           cases: (string * ('e,'b) ty_case) list;
+           inj: 'c. ('b,'c) ty_sel * 'c -> 'a >
+          -> ('a, 'e) ty
+
+and 'e ty_dyn =
+  | Tdyn : ('a,'e) ty * 'a -> 'e ty_dyn
+
+and (_,_) ty_sel =
+  | Thd : ('a -> 'b, 'a) ty_sel
+  | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
+
+and (_,_) ty_case =
+  | TCarg : ('b,'a) ty_sel * ('a,'e) ty -> ('e,'b) ty_case
+  | TCnoarg : ('b,noarg) ty_sel -> ('e,'b) ty_case
+;;
+
+let ty_abc : ([`A of int | `B of string | `C] as 'a, 'e) ty =
+  Sum (object
+    method proj = function
+        `A n -> "A", Some (Tdyn (Int, n))
+      | `B s -> "B", Some (Tdyn (String, s))
+      | `C -> "C", None
+    method cases =
+      [ "A", TCarg (Thd, Int); "B", TCarg (Ttl Thd, String);
+        "C", TCnoarg (Ttl (Ttl Thd)) ];
+    method inj : type c.
+        (int -> string -> noarg -> unit, c) ty_sel * c ->
+          [`A of int | `B of string | `C] =
+      function
+        Thd, v -> `A v
+      | Ttl Thd, v -> `B v
+      | Ttl (Ttl Thd), Noarg -> `C
+  end)
+
+type 'a vlist = [`Nil | `Cons of 'a * 'a vlist]
+
+let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = fun t ->
+  let tcons = Pair (Pop t, Var) in
+  Rec (Sum (object
+    method proj = function
+        `Nil -> "Nil", None
+      | `Cons p -> "Cons", Some (Tdyn (tcons, p))
+    method cases = ["Nil", TCnoarg Thd; "Cons", TCarg (Ttl Thd, tcons)]
+    method inj : type c.(noarg -> a * a vlist -> unit, c) ty_sel * c -> a vlist
+    = function
+      | Thd, Noarg -> `Nil
+      | Ttl Thd, v -> `Cons v
+  end))
+;;
+
+(*
+type (_,_) ty_assoc =
+  | Anil : (unit,'e) ty_assoc
+  | Acons : string * ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc
+
+and (_,_) ty_pvar =
+  | Pnil : ('a,'e) ty_pvar
+  | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar
+  | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar
+*)
+(*
+   An attempt at encoding omega examples from the 2nd Central European
+   Functional Programming School:
+     Generic Programming in Omega, by Tim Sheard and Nathan Linger
+          http://web.cecs.pdx.edu/~sheard/
+*)
+
+(* Basic types *)
+
+type ('a,'b) sum = Inl of 'a | Inr of 'b
+
+type zero = Zero
+type 'a succ = Succ of 'a
+type _ nat =
+  | NZ : zero nat
+  | NS : 'a nat -> 'a succ nat
+;;
+
+(* 2: A simple example *)
+
+type (_,_) seq =
+  | Snil  : ('a,zero) seq
+  | Scons : 'a * ('a,'n) seq -> ('a, 'n succ) seq
+;;
+
+let l1 = Scons (3, Scons (5, Snil)) ;;
+
+(* We do not have type level functions, so we need to use witnesses. *)
+(* We copy here the definitions from section 3.9 *)
+(* Note the addition of the ['a nat] argument to PlusZ, since we do not
+   have kinds *)
+type (_,_,_) plus =
+  | PlusZ : 'a nat -> (zero, 'a, 'a) plus
+  | PlusS : ('a,'b,'c) plus -> ('a succ, 'b, 'c succ) plus
+;;
+
+let rec length : type a n. (a,n) seq -> n nat = function
+  | Snil -> NZ
+  | Scons (_, s) -> NS (length s)
+;;
+
+(* app returns the catenated lists with a witness proving that
+   the size is the sum of its two inputs *)
+type (_,_,_) app = App : ('a,'p) seq * ('n,'m,'p) plus -> ('a,'n,'m) app
+
+let rec app : type a n m. (a,n) seq -> (a,m) seq -> (a,n,m) app =
+  fun xs ys ->
+  match xs with
+  | Snil -> App (ys, PlusZ (length ys))
+  | Scons (x, xs') ->
+      let App (xs'', pl) = app xs' ys in
+      App (Scons (x, xs''), PlusS pl)
+;;
+
+(* 3.1 Feature: kinds *)
+
+(* We do not have kinds, but we can encode them as predicates *)
+
+type tp = TP
+type nd = ND
+type ('a,'b) fk = FK
+type _ shape =
+  | Tp : tp shape
+  | Nd : nd shape
+  | Fk : 'a shape * 'b shape -> ('a,'b) fk shape
+;;
+type tt = TT
+type ff = FF
+type _ boolean =
+  | BT : tt boolean
+  | BF : ff boolean
+;;
+
+(* 3.3 Feature : GADTs *)
+
+type (_,_) path =
+  | Pnone : 'a -> (tp,'a) path
+  | Phere : (nd,'a) path
+  | Pleft : ('x,'a) path -> (('x,'y) fk, 'a) path
+  | Pright : ('y,'a) path -> (('x,'y) fk, 'a) path
+;;
+type (_,_) tree =
+  | Ttip  : (tp,'a) tree
+  | Tnode : 'a -> (nd,'a) tree
+  | Tfork : ('x,'a) tree * ('y,'a) tree -> (('x,'y)fk, 'a) tree
+;;
+let tree1 = Tfork (Tfork (Ttip, Tnode 4), Tfork (Tnode 4, Tnode 3))
+;;
+let rec find : type sh.
+    ('a -> 'a -> bool) -> 'a -> (sh,'a) tree -> (sh,'a) path list
+  = fun eq n t ->
+    match t with
+    | Ttip -> []
+    | Tnode m ->
+        if eq n m then [Phere] else []
+    | Tfork (x, y) ->
+        List.map (fun x -> Pleft x) (find eq n x) @
+        List.map (fun x -> Pright x) (find eq n y)
+;;
+let rec extract : type sh. (sh,'a) path -> (sh,'a) tree -> 'a = fun p t ->
+  match (p, t) with
+  | Pnone x, Ttip -> x
+  | Phere, Tnode y -> y
+  | Pleft p, Tfork(l,_) -> extract p l
+  | Pright p, Tfork(_,r) -> extract p r
+;;
+
+(* 3.4 Pattern : Witness *)
+
+type (_,_) le =
+  | LeZ : 'a nat -> (zero, 'a) le
+  | LeS : ('n, 'm) le -> ('n succ, 'm succ) le
+;;
+type _ even =
+  | EvenZ : zero even
+  | EvenSS : 'n even -> 'n succ succ even
+;;
+type one = zero succ
+type two = one succ
+type three = two succ
+type four = three succ
+;;
+let even0 : zero even = EvenZ
+let even2 : two even = EvenSS EvenZ
+let even4 : four even = EvenSS (EvenSS EvenZ)
+;;
+let p1 : (two, one, three) plus = PlusS (PlusS (PlusZ (NS NZ)))
+;;
+let rec summandLessThanSum : type a b c. (a,b,c) plus -> (a,c) le = fun p ->
+  match p with
+  | PlusZ n -> LeZ n
+  | PlusS p' -> LeS (summandLessThanSum p')
+;;
+
+(* 3.8 Pattern: Leibniz Equality *)
+
+type (_,_) equal = Eq : ('a,'a) equal
+
+let convert : type a b. (a,b) equal -> a -> b = fun Eq x -> x
+
+let rec sameNat : type a b. a nat -> b nat -> (a,b) equal option = fun a b ->
+  match a, b with
+  | NZ, NZ -> Some Eq
+  | NS a', NS b' ->
+      begin match sameNat a' b' with
+      | Some Eq -> Some Eq
+      | None -> None
+      end
+  | _ -> None
+;;
+
+(* Extra: associativity of addition *)
+
+let rec plus_func : type a b m n.
+  (a,b,m) plus -> (a,b,n) plus -> (m,n) equal =
+  fun p1 p2 ->
+  match p1, p2 with
+  | PlusZ _, PlusZ _ -> Eq
+  | PlusS p1', PlusS p2' ->
+      let Eq = plus_func p1' p2' in Eq
+
+let rec plus_assoc : type a b c ab bc m n.
+  (a,b,ab) plus -> (ab,c,m) plus ->
+  (b,c,bc) plus -> (a,bc,n) plus -> (m,n) equal = fun p1 p2 p3 p4 ->
+  match p1, p4 with
+  | PlusZ b, PlusZ bc ->
+      let Eq = plus_func p2 p3 in Eq
+  | PlusS p1', PlusS p4' ->
+      let PlusS p2' = p2 in
+      let Eq = plus_assoc p1' p2' p3 p4' in Eq
+;;
+
+(* 3.9 Computing Programs and Properties Simultaneously *)
+
+(* Plus and app1 are moved to section 2 *)
+
+let smaller : type a b. (a succ, b succ) le -> (a,b) le =
+  function LeS x -> x ;;
+
+type (_,_) diff = Diff : 'c nat * ('a,'c,'b) plus -> ('a,'b) diff ;;
+
+(*
+let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff =
+  fun le a b ->
+  match a, b, le with
+  | NZ, m, _ -> Diff (m, PlusZ m)
+  | NS x, NZ, _ -> assert false
+  | NS x, NS y, q ->
+      match diff (smaller q) x y with Diff (m, p) -> Diff (m, PlusS p)
+;;
+*)
+
+let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff =
+  fun le a b ->
+  match le, a, b with
+  | LeZ _, _, m -> Diff (m, PlusZ m)
+  | LeS q, NS x, NS y ->
+      match diff q x y with Diff (m, p) -> Diff (m, PlusS p)
+;;
+
+let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff =
+  fun le a b ->
+  match a, b,le with (* warning *)
+  | NZ, m, LeZ _ -> Diff (m, PlusZ m)
+  | NS x, NS y, LeS q ->
+      (match diff q x y with Diff (m, p) -> Diff (m, PlusS p))
+  | _ -> .
+;;
+
+let rec diff : type a b. (a,b) le -> b nat -> (a,b) diff =
+  fun le b ->
+  match b,le with
+  | m, LeZ _ -> Diff (m, PlusZ m)
+  | NS y, LeS q ->
+      match diff q y with Diff (m, p) -> Diff (m, PlusS p)
+;;
+
+type (_,_) filter = Filter : ('m,'n) le * ('a,'m) seq -> ('a,'n) filter
+
+let rec leS' : type m n. (m,n) le -> (m,n succ) le = function
+  | LeZ n -> LeZ (NS n)
+  | LeS le -> LeS (leS' le)
+;;
+
+let rec filter : type a n. (a -> bool) -> (a,n) seq -> (a,n) filter =
+  fun f s ->
+  match s with
+  | Snil -> Filter (LeZ NZ, Snil)
+  | Scons (a,l) ->
+      match filter f l with Filter (le, l') ->
+        if f a then Filter (LeS le, Scons (a, l'))
+        else Filter (leS' le, l')
+;;
+
+(* 4.1 AVL trees *)
+
+type (_,_,_) balance =
+  | Less : ('h, 'h succ, 'h succ) balance
+  | Same : ('h, 'h, 'h) balance
+  | More : ('h succ, 'h, 'h succ) balance
+
+type _ avl =
+  | Leaf : zero avl
+  | Node :
+      ('hL, 'hR, 'hMax) balance * 'hL avl * int * 'hR avl -> 'hMax succ avl
+
+type avl' = Avl : 'h avl -> avl'
+;;
+
+let empty = Avl Leaf
+
+let rec elem : type h. int -> h avl -> bool = fun x t ->
+  match t with
+  | Leaf -> false
+  | Node (_, l, y, r) ->
+      x = y || if x < y then elem x l else elem x r
+;;
+
+let rec rotr : type n. (n succ succ) avl -> int -> n avl ->
+  ((n succ succ) avl, (n succ succ succ) avl) sum =
+  fun tL y tR ->
+  match tL with
+  | Node (Same, a, x, b) -> Inr (Node (Less, a, x, Node (More, b, y, tR)))
+  | Node (More, a, x, b) -> Inl (Node (Same, a, x, Node (Same, b, y, tR)))
+  | Node (Less, a, x, Node (Same, b, z, c)) ->
+      Inl (Node (Same, Node (Same, a, x, b), z, Node (Same, c, y, tR)))
+  | Node (Less, a, x, Node (Less, b, z, c)) ->
+      Inl (Node (Same, Node (More, a, x, b), z, Node (Same, c, y, tR)))
+  | Node (Less, a, x, Node (More, b, z, c)) ->
+      Inl (Node (Same, Node (Same, a, x, b), z, Node (Less, c, y, tR)))
+;;
+let rec rotl : type n. n avl -> int -> (n succ succ) avl ->
+  ((n succ succ) avl, (n succ succ succ) avl) sum =
+  fun tL u tR ->
+  match tR with
+  | Node (Same, a, x, b) -> Inr (Node (More, Node (Less, tL, u, a), x, b))
+  | Node (Less, a, x, b) -> Inl (Node (Same, Node (Same, tL, u, a), x, b))
+  | Node (More, Node (Same, a, x, b), y, c) ->
+      Inl (Node (Same, Node (Same, tL, u, a), x, Node (Same, b, y, c)))
+  | Node (More, Node (Less, a, x, b), y, c) ->
+      Inl (Node (Same, Node (More, tL, u, a), x, Node (Same, b, y, c)))
+  | Node (More, Node (More, a, x, b), y, c) ->
+      Inl (Node (Same, Node (Same, tL, u, a), x, Node (Less, b, y, c)))
+;;
+let rec ins : type n. int -> n avl -> (n avl, (n succ) avl) sum =
+  fun x t ->
+  match t with
+  | Leaf -> Inr (Node (Same, Leaf, x, Leaf))
+  | Node (bal, a, y, b) ->
+      if x = y then Inl t else
+      if x < y then begin
+        match ins x a with
+        | Inl a -> Inl (Node (bal, a, y, b))
+        | Inr a ->
+            match bal with
+            | Less -> Inl (Node (Same, a, y, b))
+            | Same -> Inr (Node (More, a, y, b))
+            | More -> rotr a y b
+      end else begin
+        match ins x b with
+        | Inl b -> Inl (Node (bal, a, y, b) : n avl)
+        | Inr b ->
+            match bal with
+            | More -> Inl (Node (Same, a, y, b) : n avl)
+            | Same -> Inr (Node (Less, a, y, b) : n succ avl)
+            | Less -> rotl a y b
+      end
+;;
+
+let insert x (Avl t) =
+  match ins x t with
+  | Inl t -> Avl t
+  | Inr t -> Avl t
+;;
+
+let rec del_min : type n. (n succ) avl -> int * (n avl, (n succ) avl) sum =
+  function
+  | Node (Less, Leaf, x, r) -> (x, Inl r)
+  | Node (Same, Leaf, x, r) -> (x, Inl r)
+  | Node (bal, (Node _ as l) , x, r) ->
+      match del_min l with
+      | y, Inr l -> (y, Inr (Node (bal, l, x, r)))
+      | y, Inl l ->
+          (y, match bal with
+          | Same -> Inr (Node (Less, l, x, r))
+          | More -> Inl (Node (Same, l, x, r))
+          | Less -> rotl l x r)
+
+type _ avl_del =
+  | Dsame : 'n avl -> 'n avl_del
+  | Ddecr : ('m succ, 'n) equal * 'm avl -> 'n avl_del
+
+let rec del : type n. int -> n avl -> n avl_del = fun y t ->
+  match t with
+  | Leaf -> Dsame Leaf
+  | Node (bal, l, x, r) ->
+      if x = y then begin
+        match r with
+        | Leaf ->
+            begin match bal with
+            | Same -> Ddecr (Eq, l)
+            | More -> Ddecr (Eq, l)
+            end
+        | Node _ ->
+            begin match bal, del_min r with
+            | _, (z, Inr r) -> Dsame (Node (bal, l, z, r))
+            | Same, (z, Inl r) -> Dsame (Node (More, l, z, r))
+            | Less, (z, Inl r) -> Ddecr (Eq, Node (Same, l, z, r))
+            | More, (z, Inl r) ->
+                match rotr l z r with
+                | Inl t -> Ddecr (Eq, t)
+                | Inr t -> Dsame t
+            end
+      end else if y < x then begin
+        match del y l with
+        | Dsame l -> Dsame (Node (bal, l, x, r))
+        | Ddecr(Eq,l) ->
+            begin match bal with
+            | Same -> Dsame (Node (Less, l, x, r))
+            | More -> Ddecr (Eq, Node (Same, l, x, r))
+            | Less ->
+                match rotl l x r with
+                | Inl t -> Ddecr (Eq, t)
+                | Inr t -> Dsame t
+            end
+      end else begin
+        match del y r with
+        | Dsame r -> Dsame (Node (bal, l, x, r))
+        | Ddecr(Eq,r) ->
+            begin match bal with
+            | Same -> Dsame (Node (More, l, x, r))
+            | Less -> Ddecr (Eq, Node (Same, l, x, r))
+            | More ->
+                match rotr l x r with
+                | Inl t -> Ddecr (Eq, t)
+                | Inr t -> Dsame t
+            end
+      end
+;;
+
+let delete x (Avl t) =
+  match del x t with
+  | Dsame t -> Avl t
+  | Ddecr (_, t) -> Avl t
+;;
+
+
+(* Exercise 22: Red-black trees *)
+
+type red = RED
+type black = BLACK
+type (_,_) sub_tree =
+  | Bleaf : (black, zero) sub_tree
+  | Rnode :
+      (black, 'n) sub_tree * int * (black, 'n) sub_tree -> (red, 'n) sub_tree
+  | Bnode :
+      ('cL, 'n) sub_tree * int * ('cR, 'n) sub_tree -> (black, 'n succ) sub_tree
+
+type rb_tree = Root : (black, 'n) sub_tree -> rb_tree
+;;
+
+type dir = LeftD | RightD
+
+type (_,_) ctxt =
+  | CNil : (black,'n) ctxt
+  | CRed : int * dir * (black,'n) sub_tree * (red,'n) ctxt -> (black,'n) ctxt
+  | CBlk : int * dir * ('c1,'n) sub_tree * (black, 'n succ) ctxt -> ('c,'n) ctxt
+;;
+
+let blacken = function
+    Rnode (l, e, r) -> Bnode (l, e, r)
+
+type _ crep =
+  | Red : red crep
+  | Black : black crep
+
+let color : type c n. (c,n) sub_tree -> c crep = function
+  | Bleaf -> Black
+  | Rnode _ -> Red
+  | Bnode _ -> Black
+;;
+
+let rec fill : type c n. (c,n) ctxt -> (c,n) sub_tree -> rb_tree =
+  fun ct t ->
+  match ct with
+  | CNil -> Root t
+  | CRed (e, LeftD, uncle, c) -> fill c (Rnode (uncle, e, t))
+  | CRed (e, RightD, uncle, c) -> fill c (Rnode (t, e, uncle))
+  | CBlk (e, LeftD, uncle, c) -> fill c (Bnode (uncle, e, t))
+  | CBlk (e, RightD, uncle, c) -> fill c (Bnode (t, e, uncle))
+;;
+let recolor d1 pE sib d2 gE uncle t =
+  match d1, d2 with
+  | LeftD, RightD -> Rnode (Bnode (sib, pE, t), gE, uncle)
+  | RightD, RightD -> Rnode (Bnode (t, pE, sib), gE, uncle)
+  | LeftD, LeftD -> Rnode (uncle, gE, Bnode (sib, pE, t))
+  | RightD, LeftD -> Rnode (uncle, gE, Bnode (t, pE, sib))
+;;
+let rotate d1 pE sib d2 gE uncle (Rnode (x, e, y)) =
+  match d1, d2 with
+  | RightD, RightD -> Bnode (Rnode (x,e,y), pE, Rnode (sib, gE, uncle))
+  | LeftD,  RightD -> Bnode (Rnode (sib, pE, x), e, Rnode (y, gE, uncle))
+  | LeftD,  LeftD  -> Bnode (Rnode (uncle, gE, sib), pE, Rnode (x,e,y))
+  | RightD, LeftD  -> Bnode (Rnode (uncle, gE, x), e, Rnode (y, pE, sib))
+;;
+let rec repair : type c n. (red,n) sub_tree -> (c,n) ctxt -> rb_tree =
+  fun t ct ->
+  match ct with
+  | CNil -> Root (blacken t)
+  | CBlk (e, LeftD, sib, c) -> fill c (Bnode (sib, e, t))
+  | CBlk (e, RightD, sib, c) -> fill c (Bnode (t, e, sib))
+  | CRed (e, dir, sib, CBlk (e', dir', uncle, ct)) ->
+      match color uncle with
+      | Red -> repair (recolor dir e sib dir' e' (blacken uncle) t) ct
+      | Black -> fill ct (rotate dir e sib dir' e' uncle t)
+;;
+let rec ins : type c n. int -> (c,n) sub_tree -> (c,n) ctxt -> rb_tree =
+  fun e t ct ->
+  match t with
+  | Rnode (l, e', r) ->
+      if e < e' then ins e l (CRed (e', RightD, r, ct))
+                else ins e r (CRed (e', LeftD, l, ct))
+  | Bnode (l, e', r) ->
+      if e < e' then ins e l (CBlk (e', RightD, r, ct))
+                else ins e r (CBlk (e', LeftD, l, ct))
+  | Bleaf -> repair (Rnode (Bleaf, e, Bleaf)) ct
+;;
+let insert e (Root t) = ins e t CNil
+;;
+
+(* 5.7 typed object languages using GADTs *)
+
+type _ term =
+  | Const : int -> int term
+  | Add   : (int * int -> int) term
+  | LT    : (int * int -> bool) term
+  | Ap    : ('a -> 'b) term * 'a term -> 'b term
+  | Pair  : 'a term * 'b term -> ('a * 'b) term
+
+let ex1 = Ap (Add, Pair (Const 3, Const 5))
+let ex2 = Pair (ex1, Const 1)
+
+let rec eval_term : type a. a term -> a = function
+  | Const x -> x
+  | Add -> fun (x,y) -> x+y
+  | LT  -> fun (x,y) -> x<y
+  | Ap(f,x) -> eval_term f (eval_term x)
+  | Pair(x,y) -> (eval_term x, eval_term y)
+
+type _ rep =
+  | Rint  : int rep
+  | Rbool : bool rep
+  | Rpair : 'a rep * 'b rep -> ('a * 'b) rep
+  | Rfun  : 'a rep * 'b rep -> ('a -> 'b) rep
+
+type (_,_) equal = Eq : ('a,'a) equal
+
+let rec rep_equal : type a b. a rep -> b rep -> (a, b) equal option =
+  fun ra rb ->
+  match ra, rb with
+  | Rint, Rint -> Some Eq
+  | Rbool, Rbool -> Some Eq
+  | Rpair (a1, a2), Rpair (b1, b2) ->
+      begin match rep_equal a1 b1 with
+      | None -> None
+      | Some Eq -> match rep_equal a2 b2 with
+        | None -> None
+        | Some Eq -> Some Eq
+      end
+  | Rfun (a1, a2), Rfun (b1, b2) ->
+      begin match rep_equal a1 b1 with
+      | None -> None
+      | Some Eq -> match rep_equal a2 b2 with
+        | None -> None
+        | Some Eq -> Some Eq
+      end
+  | _ -> None
+;;
+
+type assoc = Assoc : string * 'a rep * 'a -> assoc
+
+let rec assoc : type a. string -> a rep -> assoc list -> a =
+  fun x r -> function
+  | [] -> raise Not_found
+  | Assoc (x', r', v) :: env ->
+      if x = x' then
+        match rep_equal r r' with
+        | None -> failwith ("Wrong type for " ^ x)
+        | Some Eq -> v
+      else assoc x r env
+
+type _ term =
+  | Var   : string * 'a rep -> 'a term
+  | Abs   : string * 'a rep * 'b term -> ('a -> 'b) term
+  | Const : int -> int term
+  | Add   : (int * int -> int) term
+  | LT    : (int * int -> bool) term
+  | Ap    : ('a -> 'b) term * 'a term -> 'b term
+  | Pair  : 'a term * 'b term -> ('a * 'b) term
+
+let rec eval_term : type a. assoc list -> a term -> a =
+  fun env -> function
+  | Var (x, r) -> assoc x r env
+  | Abs (x, r, e) -> fun v -> eval_term (Assoc (x, r, v) :: env) e
+  | Const x -> x
+  | Add -> fun (x,y) -> x+y
+  | LT  -> fun (x,y) -> x<y
+  | Ap(f,x) -> eval_term env f (eval_term env x)
+  | Pair(x,y) -> (eval_term env x, eval_term env y)
+;;
+
+let ex3 = Abs ("x", Rint, Ap (Add, Pair (Var("x",Rint), Var("x",Rint))))
+let ex4 = Ap (ex3, Const 3)
+
+let v4 = eval_term [] ex4
+;;
+
+(* 5.9/5.10 Language with binding *)
+
+type rnil = RNIL
+type ('a,'b,'c) rcons = RCons of 'a * 'b * 'c
+
+type _ is_row =
+  | Rnil  : rnil is_row
+  | Rcons : 'c is_row -> ('a,'b,'c) rcons is_row
+
+type (_,_) lam =
+  | Const : int -> ('e, int) lam
+  | Var : 'a -> (('a,'t,'e) rcons, 't) lam
+  | Shift : ('e,'t) lam -> (('a,'q,'e) rcons, 't) lam
+  | Abs : 'a * (('a,'s,'e) rcons, 't) lam -> ('e, 's -> 't) lam
+  | App : ('e, 's -> 't) lam * ('e, 's) lam -> ('e, 't) lam
+
+type x = X
+type y = Y
+
+let ex1 = App (Var X, Shift (Var Y))
+let ex2 = Abs (X, Abs (Y, App (Shift (Var X), Var Y)))
+;;
+
+type _ env =
+  | Enil : rnil env
+  | Econs : 'a * 't * 'e env -> ('a, 't, 'e) rcons env
+
+let rec eval_lam : type e t. e env -> (e, t) lam -> t =
+  fun env m ->
+  match env, m with
+  | _, Const n -> n
+  | Econs (_, v, r), Var _ -> v
+  | Econs (_, _, r), Shift e -> eval_lam r e
+  | _, Abs (n, body) -> fun x -> eval_lam (Econs (n, x, env)) body
+  | _, App (f, x)    -> eval_lam env f (eval_lam env x)
+;;
+
+type add = Add
+type suc = Suc
+
+let env0 = Econs (Zero, 0, Econs (Suc, succ, Econs (Add, (+), Enil)))
+
+let _0 : (_, int) lam = Var Zero
+let suc x = App (Shift (Var Suc : (_, int -> int) lam), x)
+let _1 = suc _0
+let _2 = suc _1
+let _3 = suc _2
+let add = Shift (Shift (Var Add : (_, int -> int -> int) lam))
+
+let double = Abs (X, App (App (Shift add, Var X), Var X))
+let ex3 = App (double, _3)
+;;
+
+let v3 = eval_lam env0 ex3
+;;
+
+(* 5.13: Constructing typing derivations at runtime *)
+
+(* Modified slightly to use the language of 5.10, since this is more fun.
+   Of course this works also with the language of 5.12. *)
+
+type _ rep =
+  | I : int rep
+  | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
+
+let rec compare : type a b. a rep -> b rep -> (string, (a,b) equal) sum =
+  fun a b ->
+  match a, b with
+  | I, I -> Inr Eq
+  | Ar(x,y), Ar(s,t) ->
+      begin match compare x s with
+      | Inl _ as e -> e
+      | Inr Eq -> match compare y t with
+        | Inl _ as e -> e
+        | Inr Eq as e -> e
+      end
+  | I, Ar _ -> Inl "I <> Ar _"
+  | Ar _, I -> Inl "Ar _ <> I"
+;;
+
+type term =
+  | C of int
+  | Ab : string * 'a rep * term -> term
+  | Ap of term * term
+  | V of string
+
+type _ ctx =
+  | Cnil : rnil ctx
+  | Ccons : 't * string * 'x rep * 'e ctx -> ('t,'x,'e) rcons ctx
+;;
+
+type _ checked =
+  | Cerror of string
+  | Cok : ('e,'t) lam * 't rep -> 'e checked
+
+let rec lookup : type e. string -> e ctx -> e checked =
+  fun name ctx ->
+  match ctx with
+  | Cnil -> Cerror ("Name not found: " ^ name)
+  | Ccons (l,s,t,rs) ->
+      if s = name then Cok (Var l,t) else
+      match lookup name rs with
+      | Cerror m -> Cerror m
+      | Cok (v, t) -> Cok (Shift v, t)
+;;
+
+let rec tc : type n e. n nat -> e ctx -> term -> e checked =
+  fun n ctx t ->
+  match t with
+  | V s -> lookup s ctx
+  | Ap(f,x) ->
+      begin match tc n ctx f with
+      | Cerror _ as e -> e
+      | Cok (f', ft) -> match tc n ctx x with
+        | Cerror _ as e -> e
+        | Cok (x', xt) ->
+            match ft with
+            | Ar (a, b) ->
+                begin match compare a xt with
+                | Inl s -> Cerror s
+                | Inr Eq -> Cok (App (f',x'), b)
+                end
+            | _ -> Cerror "Non fun in Ap"
+      end
+  | Ab(s,t,body) ->
+      begin match tc (NS n) (Ccons (n, s, t, ctx)) body with
+      | Cerror _ as e -> e
+      | Cok (body', et) -> Cok (Abs (n, body'), Ar (t, et))
+      end
+  | C m -> Cok (Const m, I)
+;;
+
+let ctx0 =
+  Ccons (Zero, "0", I,
+         Ccons (Suc, "S", Ar(I,I),
+                Ccons (Add, "+", Ar(I,Ar(I,I)), Cnil)))
+
+let ex1 = Ab ("x", I, Ap(Ap(V"+",V"x"),V"x"));;
+let c1 = tc NZ ctx0 ex1;;
+let ex2 = Ap (ex1, C 3);;
+let c2 = tc NZ ctx0 ex2;;
+
+let eval_checked env = function
+  | Cerror s -> failwith s
+  | Cok (e, I) -> (eval_lam env e : int)
+  | Cok _ -> failwith "Can only evaluate expressions of type I"
+;;
+
+let v2 = eval_checked env0 c2 ;;
+
+(* 5.12 Soundness *)
+
+type pexp = PEXP
+type pval = PVAL
+type _ mode =
+  | Pexp : pexp mode
+  | Pval : pval mode
+
+type ('a,'b) tarr = TARR
+type tint = TINT
+
+type (_,_) rel =
+  | IntR : (tint, int) rel
+  | IntTo : ('b, 's) rel -> ((tint, 'b) tarr, int -> 's) rel
+
+type (_,_,_) lam =
+  | Const : ('a,'b) rel * 'b -> (pval, 'env, 'a) lam
+  | Var : 'a -> (pval, ('a,'t,'e) rcons, 't) lam
+  | Shift : ('m,'e,'t) lam -> ('m, ('a,'q,'e) rcons, 't) lam
+  | Lam : 'a * ('m, ('a,'s,'e) rcons, 't) lam -> (pval, 'e, ('s,'t) tarr) lam
+  | App : ('m1, 'e, ('s,'t) tarr) lam * ('m2, 'e, 's) lam -> (pexp, 'e, 't) lam
+;;
+
+let ex1 = App (Lam (X, Var X), Const (IntR, 3))
+
+let rec mode : type m e t. (m,e,t) lam -> m mode = function
+  | Lam (v, body) -> Pval
+  | Var v -> Pval
+  | Const (r, v) -> Pval
+  | Shift e -> mode e
+  | App _ -> Pexp
+;;
+
+type (_,_) sub =
+  | Id : ('r,'r) sub
+  | Bind : 't * ('m,'r2,'x) lam * ('r,'r2) sub -> (('t,'x,'r) rcons, 'r2) sub
+  | Push : ('r1,'r2) sub -> (('a,'b,'r1) rcons, ('a,'b,'r2) rcons) sub
+
+type (_,_) lam' = Ex : ('m, 's, 't) lam -> ('s,'t) lam'
+;;
+
+let rec subst : type m1 r t s. (m1,r,t) lam -> (r,s) sub -> (s,t) lam' =
+  fun t s ->
+  match t, s with
+  | _, Id -> Ex t
+  | Const(r,c), sub -> Ex (Const (r,c))
+  | Var v, Bind (x, e, r) -> Ex e
+  | Var v, Push sub -> Ex (Var v)
+  | Shift e, Bind (_, _, r) -> subst e r
+  | Shift e, Push sub ->
+      (match subst e sub with Ex a -> Ex (Shift a))
+  | App(f,x), sub ->
+      (match subst f sub, subst x sub with Ex g, Ex y -> Ex (App (g,y)))
+  | Lam(v,x), sub ->
+      (match subst x (Push sub) with Ex body -> Ex (Lam (v, body)))
+;;
+
+type closed = rnil
+
+type 'a rlam = ((pexp,closed,'a) lam, (pval,closed,'a) lam) sum ;;
+
+let rec rule : type a b.
+  (pval, closed, (a,b) tarr) lam -> (pval, closed, a) lam -> b rlam =
+  fun v1 v2 ->
+  match v1, v2 with
+  | Lam(x,body), v ->
+      begin
+        match subst body (Bind (x, v, Id)) with Ex term ->
+        match mode term with
+        | Pexp -> Inl term
+        | Pval -> Inr term
+      end
+  | Const (IntTo b, f), Const (IntR, x) ->
+      Inr (Const (b, f x))
+;;
+let rec onestep : type m t. (m,closed,t) lam -> t rlam = function
+  | Lam (v, body) -> Inr (Lam (v, body))
+  | Const (r, v)  -> Inr (Const (r, v))
+  | App (e1, e2) ->
+      match mode e1, mode e2 with
+      | Pexp, _->
+          begin match onestep e1 with
+          | Inl e -> Inl(App(e,e2))
+          | Inr v -> Inl(App(v,e2))
+          end
+      | Pval, Pexp ->
+          begin match onestep e2 with
+          | Inl e -> Inl(App(e1,e))
+          | Inr v -> Inl(App(e1,v))
+          end
+      | Pval, Pval -> rule e1 e2
+;;
+type ('env, 'a) var =
+ | Zero : ('a * 'env, 'a) var
+ | Succ : ('env, 'a) var -> ('b * 'env, 'a) var
+;;
+type ('env, 'a) typ =
+ | Tint : ('env, int) typ
+ | Tbool : ('env, bool) typ
+ | Tvar : ('env, 'a) var -> ('env, 'a) typ
+;;
+let f : type env a. (env, a) typ -> (env, a) typ -> int = fun ta tb ->
+ match ta, tb with
+   | Tint, Tint -> 0
+   | Tbool, Tbool -> 1
+   | Tvar var, tb -> 2
+   | _ -> .   (* error *)
+;;
+(* let x = f Tint (Tvar Zero) ;; *)
+type inkind = [ `Link | `Nonlink ]
+
+type _ inline_t =
+   | Text: string -> [< inkind > `Nonlink ] inline_t
+   | Bold: 'a inline_t list -> 'a inline_t
+   | Link: string -> [< inkind > `Link ] inline_t
+   | Mref: string * [ `Nonlink ] inline_t list -> [< inkind > `Link ] inline_t
+;;
+
+let uppercase seq =
+   let rec process: type a. a inline_t -> a inline_t = function
+       | Text txt       -> Text (String.uppercase_ascii txt)
+       | Bold xs        -> Bold (List.map process xs)
+       | Link lnk       -> Link lnk
+       | Mref (lnk, xs) -> Mref (lnk, List.map process xs)
+   in List.map process seq
+;;
+
+type ast_t =
+   | Ast_Text of string
+   | Ast_Bold of ast_t list
+   | Ast_Link of string
+   | Ast_Mref of string * ast_t list
+;;
+
+let inlineseq_from_astseq seq =
+   let rec process_nonlink = function
+       | Ast_Text txt  -> Text txt
+       | Ast_Bold xs   -> Bold (List.map process_nonlink xs)
+       | _             -> assert false in
+   let rec process_any = function
+       | Ast_Text txt       -> Text txt
+       | Ast_Bold xs        -> Bold (List.map process_any xs)
+       | Ast_Link lnk       -> Link lnk
+       | Ast_Mref (lnk, xs) -> Mref (lnk, List.map process_nonlink xs)
+   in List.map process_any seq
+;;
+
+(* OK *)
+type _ linkp =
+ | Nonlink : [ `Nonlink ] linkp
+ | Maylink : inkind linkp
+;;
+let inlineseq_from_astseq seq =
+ let rec process : type a. a linkp -> ast_t -> a inline_t =
+   fun allow_link ast ->
+     match (allow_link, ast) with
+     | (Maylink, Ast_Text txt)    -> Text txt
+     | (Nonlink, Ast_Text txt)    -> Text txt
+     | (x, Ast_Bold xs)           -> Bold (List.map (process x) xs)
+     | (Maylink, Ast_Link lnk)    -> Link lnk
+     | (Nonlink, Ast_Link _)      -> assert false
+     | (Maylink, Ast_Mref (lnk, xs)) ->
+         Mref (lnk, List.map (process Nonlink) xs)
+     | (Nonlink, Ast_Mref _)      -> assert false
+   in List.map (process Maylink) seq
+;;
+
+(* Bad *)
+type _ linkp2 = Kind : 'a linkp -> ([< inkind ] as 'a) linkp2
+;;
+let inlineseq_from_astseq seq =
+let rec process : type a. a linkp2 -> ast_t -> a inline_t =
+  fun allow_link ast ->
+    match (allow_link, ast) with
+    | (Kind _, Ast_Text txt)    -> Text txt
+    | (x, Ast_Bold xs)           -> Bold (List.map (process x) xs)
+    | (Kind Maylink, Ast_Link lnk)    -> Link lnk
+    | (Kind Nonlink, Ast_Link _)      -> assert false
+    | (Kind Maylink, Ast_Mref (lnk, xs)) ->
+        Mref (lnk, List.map (process (Kind Nonlink)) xs)
+    | (Kind Nonlink, Ast_Mref _)      -> assert false
+  in List.map (process (Kind Maylink)) seq
+;;
+module Add (T : sig type two end) =
+struct
+  type _ t =
+  | One : [`One] t
+  | Two : T.two t
+
+  let add (type a) : a t * a t -> string = function
+    | One, One -> "two"
+    | Two, Two -> "four"
+end;;
+module B : sig
+ type (_, _) t = Eq: ('a, 'a) t
+ val f: 'a -> 'b -> ('a, 'b) t
+end
+=
+struct
+ type (_, _) t = Eq: ('a, 'a) t
+ let f t1 t2 = Obj.magic Eq
+end;;
+
+let of_type: type a. a -> a = fun x ->
+  match B.f x 4 with
+  | Eq -> 5
+;;
+type _ constant =
+  | Int: int -> int constant
+  | Bool: bool -> bool constant
+
+type (_, _, _) binop =
+  | Eq: ('a, 'a, bool) binop
+  | Leq: ('a, 'a, bool) binop
+  | Add: (int, int, int) binop
+
+let eval (type a) (type b) (type c) (bop:(a,b,c) binop) (x:a constant)
+         (y:b constant) : c constant =
+  match bop, x, y with
+  | Eq, Bool x, Bool y -> Bool (if x then y else not y)
+  | Leq, Int x, Int y -> Bool (x <= y)
+  | Leq, Bool x, Bool y -> Bool (x <= y)
+  | Add, Int x, Int y -> Int (x + y)
+
+let _ = eval Eq (Int 2) (Int 3)
+type tag = [`TagA | `TagB | `TagC];;
+
+type 'a poly =
+    AandBTags : [< `TagA of int | `TagB ] poly
+  | ATag : [< `TagA of int] poly
+(* constraint 'a = [< `TagA of int | `TagB] *)
+;;
+
+let intA = function `TagA i -> i
+let intB = function `TagB -> 4
+;;
+
+let intAorB = function
+    `TagA i -> i
+  | `TagB -> 4
+;;
+
+type _ wrapPoly =
+    WrapPoly : 'a poly -> ([< `TagA of int | `TagB] as 'a) wrapPoly
+;;
+
+let example6 : type a. a wrapPoly -> (a -> int) =
+  fun w  ->
+    match w with
+    | WrapPoly ATag -> intA
+    | WrapPoly _ -> intA (* This should not be allowed *)
+;;
+
+let _ =  example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *)
+;;
+module F(S : sig type 'a t end) = struct
+  type _ ab =
+      A : int S.t ab
+    | B : float S.t ab
+
+  let f : int S.t ab -> float S.t ab -> string =
+    fun (l : int S.t ab) (r : float S.t ab) -> match l, r with
+    | A, B -> "f A B"
+end;;
+
+module F(S : sig type 'a t end) = struct
+  type a = int * int
+  type b = int -> int
+
+  type _ ab =
+      A : a S.t ab
+    | B : b S.t ab
+
+  let f : a S.t ab -> b S.t ab -> string =
+    fun l r -> match l, r with
+    | A, B -> "f A B"
+end;;
+type (_, _) t =
+    Any : ('a, 'b) t
+  | Eq : ('a, 'a) t
+;;
+
+module M :
+sig
+  type s = private [> `A]
+  val eq : (s, [`A | `B]) t
+end =
+struct
+  type s = [`A | `B]
+  let eq = Eq
+end;;
+
+let f : (M.s, [`A | `B]) t -> string = function
+  | Any -> "Any"
+;;
+
+let () = print_endline (f M.eq) ;;
+
+module N :
+sig
+  type s = private < a : int; .. >
+  val eq : (s, <a : int; b : bool>) t
+end =
+struct
+  type s = <a : int; b : bool>
+  let eq = Eq
+end
+;;
+
+let f : (N.s, <a : int; b : bool>) t -> string = function
+  | Any -> "Any"
+;;
+type (_, _) comp =
+  | Eq : ('a, 'a) comp
+  | Diff : ('a, 'b) comp
+;;
+
+module U = struct type t = T end;;
+
+module M : sig
+  type t = T
+  val comp : (U.t, t) comp
+end = struct
+  include U
+  let comp = Eq
+end;;
+
+match M.comp with | Diff -> false;;
+
+module U = struct type t = {x : int} end;;
+
+module M : sig
+  type t = {x : int}
+  val comp : (U.t, t) comp
+end = struct
+  include U
+  let comp = Eq
+end;;
+
+match M.comp with | Diff -> false;;
+type 'a t = T of 'a
+type 'a s = S of 'a
+
+type (_, _) eq = Refl : ('a, 'a) eq;;
+
+let f : (int s, int t) eq -> unit = function Refl -> ();;
+
+module M (S : sig type 'a t = T of 'a type 'a s = T of 'a end) =
+struct let f : ('a S.s, 'a S.t) eq -> unit = function Refl -> () end;;
+type _ nat =
+    Zero : [`Zero] nat
+  | Succ : 'a nat -> [`Succ of 'a] nat;;
+type 'a pre_nat = [`Zero | `Succ of 'a];;
+type aux =
+  | Aux : [`Succ of [<[<[<[`Zero] pre_nat] pre_nat] pre_nat]] nat -> aux;;
+
+let f (Aux x) =
+  match x with
+  | Succ Zero -> "1"
+  | Succ (Succ Zero) -> "2"
+  | Succ (Succ (Succ Zero)) -> "3"
+  | Succ (Succ (Succ (Succ Zero))) -> "4"
+  | _ -> .  (* error *)
+;;
+type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t
+let f : type a o. ((a -> o) -> o) t -> (a -> o) -> o =
+ fun C k -> k (fun x -> x);;
+type (_, _) t =
+ A : ('a, 'a) t
+| B : string -> ('a, 'b) t
+;;
+
+module M (A : sig module type T end) (B : sig module type T end) =
+struct
+ let f : ((module A.T), (module B.T)) t -> string = function
+   | B s -> s
+end;;
+
+module A = struct module type T = sig end end;;
+
+module N = M(A)(A);;
+
+let x = N.f A;;
+type 'a visit_action
+
+type insert
+
+type 'a local_visit_action
+
+type ('a, 'result, 'visit_action) context =
+  | Local : ('a, ('a * insert) as 'result, 'a local_visit_action) context
+  | Global : ('a, 'a, 'a visit_action) context
+;;
+
+let vexpr (type visit_action)
+    : (_, _, visit_action) context -> _ -> visit_action =
+  function
+  | Local -> fun _ -> raise Exit
+  | Global -> fun _ -> raise Exit
+;;
+
+let vexpr (type visit_action)
+    : ('a, 'result, visit_action) context -> 'a -> visit_action =
+  function
+  | Local -> fun _ -> raise Exit
+  | Global -> fun _ -> raise Exit
+;;
+
+let vexpr (type result) (type visit_action)
+    : (unit, result, visit_action) context -> unit -> visit_action =
+  function
+  | Local -> fun _ -> raise Exit
+  | Global -> fun _ -> raise Exit
+;;
+module A = struct
+    type nil = Cstr
+  end
+open A
+;;
+
+type _ s =
+  | Nil : nil s
+  | Cons : 't s -> ('h -> 't) s
+
+type ('stack, 'typ) var =
+  | Head : (('typ -> _) s, 'typ) var
+  | Tail : ('tail s, 'typ) var -> ((_ -> 'tail) s, 'typ) var
+
+type _ lst =
+  | CNil : nil lst
+  | CCons : 'h * ('t lst) -> ('h -> 't) lst
+;;
+
+let rec get_var : type stk ret. (stk s, ret) var -> stk lst -> ret = fun n s ->
+  match n, s with
+  | Head, CCons (h, _) -> h
+  | Tail n', CCons (_, t) -> get_var n' t
+;;
+type 'a t = [< `Foo | `Bar] as 'a;;
+type 'a s = [< `Foo | `Bar | `Baz > `Bar] as 'a;;
+
+type 'a first = First : 'a second -> ('b t as 'a) first
+and 'a second = Second : ('b s as 'a) second;;
+
+type aux = Aux : 'a t second * ('a -> int) -> aux;;
+
+let it : 'a. [< `Bar | `Foo > `Bar ] as 'a = `Bar;;
+
+let g (Aux(Second, f)) = f it;;
+type (_, _) eqp = Y : ('a, 'a) eqp | N : string -> ('a, 'b) eqp
+let f : ('a list, 'a) eqp -> unit = function N s -> print_string s;;
+
+module rec A :  sig type t = B.t list end =
+  struct type t = B.t list end
+and B : sig  type t val eq : (B.t list, t) eqp end =
+  struct
+    type t = A.t
+    let eq = Y
+  end;;
+
+f B.eq;;
+type (_, _) t =
+  | Nil : ('tl, 'tl) t
+  | Cons : 'a * ('b, 'tl) t -> ('a * 'b, 'tl) t;;
+
+let get1 (Cons (x, _) : (_ * 'a, 'a) t) = x ;; (* warn, cf PR#6993 *)
+
+let get1' = function
+  | (Cons (x, _) : (_ * 'a, 'a) t) -> x
+  | Nil -> assert false ;; (* ok *)
+type _ t =
+  Int : int -> int t | String : string -> string t | Same : 'l t -> 'l t;;
+let rec f = function Int x -> x | Same s -> f s;;
+type 'a tt = 'a t =
+  Int : int -> int tt | String : string -> string tt | Same : 'l1 t -> 'l2 tt;;
+type _ t = I : int t;;
+
+let f (type a) (x : a t) =
+  let module M = struct
+    let (I : a t) = x     (* fail because of toplevel let *)
+    let x = (I : a t)
+  end in
+  () ;;
+
+(* extra example by Stephen Dolan, using recursive modules *)
+(* Should not be allowed! *)
+type (_,_) eq = Refl : ('a, 'a) eq;;
+
+let bad (type a) =
+ let module N = struct
+   module rec M : sig
+     val e : (int, a) eq
+   end = struct
+     let (Refl : (int, a) eq) = M.e  (* must fail for soundness *)
+     let e : (int, a) eq = Refl
+   end
+ end in N.M.e
+;;
+type +'a n = private int
+type nil = private Nil_type
+type (_,_) elt =
+  | Elt_fine: 'nat n -> ('l,'nat * 'l) elt
+  | Elt: 'nat n -> ('l,'nat -> 'l) elt
+type _ t = Nil : nil t | Cons : ('x, 'fx) elt * 'x t -> 'fx t;;
+
+let undetected: ('a -> 'b -> nil) t -> 'a n -> 'b n -> unit = fun sh i j ->
+  let Cons(Elt dim, _) = sh in ()
+;;
+type _ t = T : int t;;
+
+(* Should raise Not_found *)
+let _ = match (raise Not_found : float t) with _ -> .;;
+type (_, _) eq = Eq : ('a, 'a) eq | Neq : int -> ('a, 'b) eq;;
+type 'a t;;
+let f (type a) (Neq n : (a, a t) eq) = n;;   (* warn! *)
+
+module F (T : sig type _ t end) = struct
+ let f (type a) (Neq n : (a, a T.t) eq) = n  (* warn! *)
+end;;
+(* First-Order Unification by Structural Recursion *)
+(* Conor McBride, JFP 13(6) *)
+(* http://strictlypositive.org/publications.html *)
+
+(* This is a translation of the code part to ocaml *)
+(* Of course, we do not prove other properties, not even termination *)
+
+(* 2.2 Inductive Families *)
+
+type zero = Zero
+type _ succ = Succ
+type _ nat =
+  | NZ : zero nat
+  | NS : 'a nat -> 'a succ nat
+
+type _ fin =
+  | FZ : 'a succ fin
+  | FS : 'a fin -> 'a succ fin
+
+(* We cannot define
+     val empty : zero fin -> 'a
+   because we cannot write an empty pattern matching.
+   This might be useful to have *)
+
+(* In place, prove that the parameter is 'a succ *)
+type _ is_succ = IS : 'a succ is_succ
+
+let fin_succ : type n. n fin -> n is_succ = function
+  | FZ -> IS
+  | FS _ -> IS
+;;
+
+(* 3 First-Order Terms, Renaming and Substitution *)
+
+type 'a term =
+  | Var of 'a fin
+  | Leaf
+  | Fork of 'a term * 'a term
+
+let var x = Var x
+
+let lift r : 'm fin -> 'n term = fun x -> Var (r x)
+
+let rec pre_subst f = function
+  | Var x -> f x
+  | Leaf -> Leaf
+  | Fork (t1, t2) -> Fork (pre_subst f t1, pre_subst f t2)
+
+let comp_subst f g (x : 'a fin) = pre_subst f (g x)
+(*  val comp_subst :
+    ('b fin -> 'c term) -> ('a fin -> 'b term) -> 'a fin -> 'c term *)
+;;
+
+(* 4 The Occur-Check, through thick and thin *)
+
+let rec thin : type n. n succ fin -> n fin -> n succ fin =
+  fun x y -> match x, y with
+  | FZ, y    -> FS y
+  | FS x, FZ -> FZ
+  | FS x, FS y -> FS (thin x y)
+
+let bind t f =
+  match t with
+  | None   -> None
+  | Some x -> f x
+(* val bind : 'a option -> ('a -> 'b option) -> 'b option *)
+
+let rec thick : type n. n succ fin -> n succ fin -> n fin option =
+  fun x y -> match x, y with
+  | FZ, FZ   -> None
+  | FZ, FS y -> Some y
+  | FS x, FZ -> let IS = fin_succ x in Some FZ
+  | FS x, FS y ->
+      let IS = fin_succ x in bind (thick x y) (fun x -> Some (FS x))
+
+let rec check : type n. n succ fin -> n succ term -> n term option =
+  fun x t -> match t with
+  | Var y -> bind (thick x y) (fun x -> Some (Var x))
+  | Leaf  -> Some Leaf
+  | Fork (t1, t2) ->
+      bind (check x t1) (fun t1 ->
+        bind (check x t2) (fun t2 -> Some (Fork (t1, t2))))
+
+let subst_var x t' y =
+  match thick x y with
+  | None -> t'
+  | Some y' -> Var y'
+(* val subst_var : 'a succ fin -> 'a term -> 'a succ fin -> 'a term *)
+
+let subst x t' = pre_subst (subst_var x t')
+(* val subst : 'a succ fin -> 'a term -> 'a succ term -> 'a term *)
+;;
+
+(* 5 A Refinement of Substitution *)
+
+type (_,_) alist =
+  | Anil  : ('n,'n) alist
+  | Asnoc : ('m,'n) alist * 'm term * 'm succ fin -> ('m succ, 'n) alist
+
+let rec sub : type m n. (m,n) alist -> m fin -> n term = function
+  | Anil -> var
+  | Asnoc (s, t, x) -> comp_subst (sub s) (subst_var x t)
+
+let rec append : type m n l. (m,n) alist -> (l,m) alist -> (l,n) alist =
+  fun r s -> match s with
+  | Anil -> r
+  | Asnoc (s, t, x) -> Asnoc (append r s, t, x)
+
+type _ ealist = EAlist : ('a,'b) alist -> 'a ealist
+
+let asnoc a t' x = EAlist (Asnoc (a, t', x))
+
+(* Extra work: we need sub to work on ealist too, for examples *)
+let rec weaken_fin : type n. n fin -> n succ fin = function
+  | FZ -> FZ
+  | FS x -> FS (weaken_fin x)
+
+let weaken_term t = pre_subst (fun x -> Var (weaken_fin x)) t
+
+let rec weaken_alist : type m n. (m, n) alist -> (m succ, n succ) alist =
+  function
+    | Anil -> Anil
+    | Asnoc (s, t, x) -> Asnoc (weaken_alist s, weaken_term t, weaken_fin x)
+
+let rec sub' : type m. m ealist -> m fin -> m term = function
+  | EAlist Anil -> var
+  | EAlist (Asnoc (s, t, x)) ->
+      comp_subst (sub' (EAlist (weaken_alist s)))
+        (fun t' -> weaken_term (subst_var x t t'))
+
+let subst' d = pre_subst (sub' d)
+(*  val subst' : 'a ealist -> 'a term -> 'a term *)
+;;
+
+(* 6 First-Order Unification *)
+
+let flex_flex x y =
+  match thick x y with
+  | Some y' -> asnoc Anil (Var y') x
+  | None -> EAlist Anil
+(* val flex_flex : 'a succ fin -> 'a succ fin -> 'a succ ealist *)
+
+let flex_rigid x t =
+  bind (check x t) (fun t' -> Some (asnoc Anil t' x))
+(* val flex_rigid : 'a succ fin -> 'a succ term -> 'a succ ealist option *)
+
+let rec amgu : type m. m term -> m term -> m ealist -> m ealist option =
+  fun s t acc -> match s, t, acc with
+  | Leaf, Leaf, _   -> Some acc
+  | Leaf, Fork _, _ -> None
+  | Fork _, Leaf, _ -> None
+  | Fork (s1, s2), Fork (t1, t2), _ ->
+      bind (amgu s1 t1 acc) (amgu s2 t2)
+  | Var x, Var y, EAlist Anil -> let IS = fin_succ x in Some (flex_flex x y)
+  | Var x, t,     EAlist Anil -> let IS = fin_succ x in flex_rigid x t
+  | t, Var x,     EAlist Anil -> let IS = fin_succ x in flex_rigid x t
+  | s, t, EAlist(Asnoc(d,r,z)) ->
+      bind (amgu (subst z r s) (subst z r t) (EAlist d))
+           (fun (EAlist d) -> Some (asnoc d r z))
+
+let mgu s t = amgu s t (EAlist Anil)
+(* val mgu : 'a term -> 'a term -> 'a ealist option *)
+;;
+
+let s = Fork (Var FZ, Fork (Var (FS (FS FZ)), Leaf))
+let t = Fork (Var (FS FZ), Var (FS FZ))
+let d = match mgu s t with Some x -> x | None -> failwith "mgu"
+let s' = subst' d s
+let t' = subst' d t
+;;
+(* Injectivity *)
+
+type (_, _) eq = Refl : ('a, 'a) eq
+
+let magic : 'a 'b. 'a -> 'b =
+  fun (type a b) (x : a) ->
+    let module M =
+      (functor (T : sig type 'a t end) ->
+       struct
+         let f (Refl : (a T.t, b T.t) eq) = (x :> b)
+       end)
+        (struct type 'a t = unit end)
+    in M.f Refl
+;;
+
+(* Variance and subtyping *)
+
+type (_, +_) eq = Refl : ('a, 'a) eq
+
+let magic : 'a 'b. 'a -> 'b =
+  fun (type a) (type b) (x : a) ->
+    let bad_proof (type a) =
+      (Refl : (< m : a>, <m : a>) eq :> (<m : a>, < >) eq) in
+    let downcast : type a. (a, < >) eq -> < > -> a =
+      fun (type a) (Refl : (a, < >) eq) (s : < >) -> (s :> a) in
+    (downcast bad_proof ((object method m = x end) :> < >)) # m
+;;
+
+(* Record patterns *)
+
+type _ t =
+  | IntLit : int t
+  | BoolLit : bool t
+
+let check : type s . s t * s -> bool = function
+  | BoolLit, false -> false
+  | IntLit , 6 -> false
+;;
+
+type ('a, 'b) pair = { fst : 'a; snd : 'b }
+
+let check : type s . (s t, s) pair -> bool = function
+  | {fst = BoolLit; snd = false} -> false
+  | {fst = IntLit ; snd =  6} -> false
+;;
+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
+|}];;
+
+(* VALID DECLARATIONS *)
+
+module A = struct
+  (* Abstract types can be immediate *)
+  type t [@@immediate]
+
+  (* [@@immediate] tag here is unnecessary but valid since t has it *)
+  type s = t [@@immediate]
+
+  (* Again, valid alias even without tag *)
+  type r = s
+
+  (* Mutually recursive declarations work as well *)
+  type p = q [@@immediate]
+  and q = int
+end;;
+[%%expect{|
+module A :
+  sig
+    type t [@@immediate]
+    type s = t [@@immediate]
+    type r = s
+    type p = q [@@immediate]
+    and q = int
+  end
+|}];;
+
+(* Valid using with constraints *)
+module type X = sig type t end;;
+module Y = struct type t = int end;;
+module Z = ((Y : X with type t = int) : sig type t [@@immediate] end);;
+[%%expect{|
+module type X = sig type t end
+module Y : sig type t = int end
+module Z : sig type t [@@immediate] end
+|}];;
+
+(* Valid using an explicit signature *)
+module M_valid : S = struct type t = int end;;
+module FM_valid = F (struct type t = int end);;
+[%%expect{|
+module M_valid : S
+module FM_valid : S
+|}];;
+
+(* Practical usage over modules *)
+module Foo : sig type t val x : t ref end = struct
+  type t = int
+  let x = ref 0
+end;;
+[%%expect{|
+module Foo : sig type t val x : t ref end
+|}];;
+
+module Bar : sig type t [@@immediate] val x : t ref end = struct
+  type t = int
+  let x = ref 0
+end;;
+[%%expect{|
+module Bar : sig type t [@@immediate] val x : t ref end
+|}];;
+
+let test f =
+  let start = Sys.time() in f ();
+  (Sys.time() -. start);;
+[%%expect{|
+val test : (unit -> 'a) -> float = <fun>
+|}];;
+
+let test_foo () =
+  for i = 0 to 100_000_000 do
+    Foo.x := !Foo.x
+  done;;
+[%%expect{|
+val test_foo : unit -> unit = <fun>
+|}];;
+
+let test_bar () =
+  for i = 0 to 100_000_000 do
+    Bar.x := !Bar.x
+  done;;
+[%%expect{|
+val test_bar : unit -> unit = <fun>
+|}];;
+
+(* Uncomment these to test. Should see substantial speedup!
+let () = Printf.printf "No @@immediate: %fs\n" (test test_foo)
+let () = Printf.printf "With @@immediate: %fs\n" (test test_bar) *)
+
+
+(* INVALID DECLARATIONS *)
+
+(* Cannot directly declare a non-immediate type as immediate *)
+module B = struct
+  type t = string [@@immediate]
+end;;
+[%%expect{|
+Line _, characters 2-31:
+Error: Types marked with the immediate attribute must be
+       non-pointer types like int or bool
+|}];;
+
+(* Not guaranteed that t is immediate, so this is an invalid declaration *)
+module C = struct
+  type t
+  type s = t [@@immediate]
+end;;
+[%%expect{|
+Line _, characters 2-26:
+Error: Types marked with the immediate attribute must be
+       non-pointer types like int or bool
+|}];;
+
+(* Can't ascribe to an immediate type signature with a non-immediate type *)
+module D : sig type t [@@immediate] end = struct
+  type t = string
+end;;
+[%%expect{|
+Line _, characters 42-70:
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = string end
+       is not included in
+         sig type t [@@immediate] end
+       Type declarations do not match:
+         type t = string
+       is not included in
+         type t [@@immediate]
+       the first is not an immediate type.
+|}];;
+
+(* Same as above but with explicit signature *)
+module M_invalid : S = struct type t = string end;;
+module FM_invalid = F (struct type t = string end);;
+[%%expect{|
+Line _, characters 23-49:
+Error: Signature mismatch:
+       Modules do not match: sig type t = string end is not included in S
+       Type declarations do not match:
+         type t = string
+       is not included in
+         type t [@@immediate]
+       the first is not an immediate type.
+|}];;
+
+(* Can't use a non-immediate type even if mutually recursive *)
+module E = struct
+  type t = s [@@immediate]
+  and s = string
+end;;
+[%%expect{|
+Line _, characters 2-26:
+Error: Types marked with the immediate attribute must be
+       non-pointer types like int or bool
+|}];;
+(*
+   Implicit unpack allows the signature in (val ...) expressions to be omitted.
+
+   It also adds (module M : S) and (module M) patterns, relying on
+   implicit (val ...) for the implementation. Such patterns can only
+   be used in function definition, match clauses, and let ... in.
+
+   New: implicit pack is also supported, and you only need to be able
+   to infer the the module type path from the context.
+ *)
+(* ocaml -principal *)
+
+(* Use a module pattern *)
+let sort (type s) (module Set : Set.S with type elt = s) l =
+  Set.elements (List.fold_right Set.add l Set.empty)
+
+(* No real improvement here? *)
+let make_set (type s) cmp : (module Set.S with type elt = s) =
+  (module Set.Make (struct type t = s let compare = cmp end))
+
+(* No type annotation here *)
+let sort_cmp (type s) cmp =
+  sort (module Set.Make (struct type t = s let compare = cmp end))
+
+module type S = sig type t val x : t end;;
+let f (module M : S with type t = int) = M.x;;
+let f (module M : S with type t = 'a) = M.x;; (* Error *)
+let f (type a) (module M : S with type t = a) = M.x;;
+f (module struct type t = int let x = 1 end);;
+
+type 'a s = {s: (module S with type t = 'a)};;
+{s=(module struct type t = int let x = 1 end)};;
+let f {s=(module M)} = M.x;; (* Error *)
+let f (type a) ({s=(module M)} : a s) = M.x;;
+
+type s = {s: (module S with type t = int)};;
+let f {s=(module M)} = M.x;;
+let f {s=(module M)} {s=(module N)} = M.x + N.x;;
+
+module type S = sig val x : int end;;
+let f (module M : S) y (module N : S) = M.x + y + N.x;;
+let m = (module struct let x = 3 end);; (* Error *)
+let m = (module struct let x = 3 end : S);;
+f m 1 m;;
+f m 1 (module struct let x = 2 end);;
+
+let (module M) = m in M.x;;
+let (module M) = m;; (* Error: only allowed in [let .. in] *)
+class c = let (module M) = m in object end;; (* Error again *)
+module M = (val m);;
+
+module type S' = sig val f : int -> int end;;
+(* Even works with recursion, but must be fully explicit *)
+let rec (module M : S') =
+  (module struct let f n = if n <= 0 then 1 else n * M.f (n-1) end : S')
+in M.f 3;;
+
+(* Subtyping *)
+
+module type S = sig type t type u val x : t * u end
+let f (l : (module S with type t = int and type u = bool) list) =
+  (l :> (module S with type u = bool) list)
+
+(* GADTs from the manual *)
+(* the only modification is in to_string *)
+
+module TypEq : sig
+  type ('a, 'b) t
+  val apply: ('a, 'b) t -> 'a -> 'b
+  val refl: ('a, 'a) t
+  val sym: ('a, 'b) t -> ('b, 'a) t
+end = struct
+  type ('a, 'b) t = ('a -> 'b) * ('b -> 'a)
+  let refl = (fun x -> x), (fun x -> x)
+  let apply (f, _) x = f x
+  let sym (f, g) = (g, f)
+end
+
+module rec Typ : sig
+  module type PAIR = sig
+    type t and t1 and t2
+    val eq: (t, t1 * t2) TypEq.t
+    val t1: t1 Typ.typ
+    val t2: t2 Typ.typ
+  end
+
+  type 'a typ =
+    | Int of ('a, int) TypEq.t
+    | String of ('a, string) TypEq.t
+    | Pair of (module PAIR with type t = 'a)
+end = Typ
+
+let int = Typ.Int TypEq.refl
+
+let str = Typ.String TypEq.refl
+
+let pair (type s1) (type s2) t1 t2 =
+  let module P = struct
+    type t = s1 * s2
+    type t1 = s1
+    type t2 = s2
+    let eq = TypEq.refl
+    let t1 = t1
+    let t2 = t2
+  end in
+  Typ.Pair (module P)
+
+open Typ
+let rec to_string: 'a. 'a Typ.typ -> 'a -> string =
+  fun (type s) t x ->
+    match (t : s typ) with
+    | Int eq -> Int.to_string (TypEq.apply eq x)
+    | String eq -> Printf.sprintf "%S" (TypEq.apply eq x)
+    | Pair (module P) ->
+        let (x1, x2) = TypEq.apply P.eq x in
+        Printf.sprintf "(%s,%s)" (to_string P.t1 x1) (to_string P.t2 x2)
+
+(* Wrapping maps *)
+module type MapT = sig
+  include Map.S
+  type data
+  type map
+  val of_t : data t -> map
+  val to_t : map -> data t
+end
+
+type ('k,'d,'m) map =
+    (module MapT with type key = 'k and type data = 'd and type map = 'm)
+
+let add (type k) (type d) (type m) (m:(k,d,m) map) x y s =
+   let module M =
+     (val m:MapT with type key = k and type data = d and type map = m) in
+   M.of_t (M.add x y (M.to_t s))
+
+module SSMap = struct
+  include Map.Make(String)
+  type data = string
+  type map = data t
+  let of_t x = x
+  let to_t x = x
+end
+
+let ssmap =
+  (module SSMap:
+   MapT with type key = string and type data = string and type map = SSMap.map)
+;;
+
+let ssmap =
+  (module struct include SSMap end :
+   MapT with type key = string and type data = string and type map = SSMap.map)
+;;
+
+let ssmap =
+  (let module S = struct include SSMap end in (module S) :
+  (module
+   MapT with type key = string and type data = string and type map = SSMap.map))
+;;
+
+let ssmap =
+  (module SSMap: MapT with type key = _ and type data = _ and type map = _)
+;;
+
+let ssmap : (_,_,_) map = (module SSMap);;
+
+add ssmap;;
+open StdLabels
+open MoreLabels
+
+(* Use maps for substitutions and sets for free variables *)
+
+module Subst = Map.Make(struct type t = string let compare = compare end)
+module Names = Set.Make(struct type t = string let compare = compare end)
+
+
+(* Variables are common to lambda and expr *)
+
+type var = [`Var of string]
+
+let subst_var ~subst : var -> _ =
+  function `Var s as x ->
+    try Subst.find s subst
+    with Not_found -> x
+
+let free_var : var -> _ = function `Var s -> Names.singleton s
+
+
+(* The lambda language: free variables, substitutions, and evaluation *)
+
+type 'a lambda = [`Var of string | `Abs of string * 'a | `App of 'a * 'a]
+
+let free_lambda ~free_rec : _ lambda -> _ = function
+    #var as x -> free_var x
+  | `Abs (s, t) -> Names.remove s (free_rec t)
+  | `App (t1, t2) -> Names.union (free_rec t1) (free_rec t2)
+
+let map_lambda ~map_rec : _ lambda -> _ = function
+    #var as x -> x
+  | `Abs (s, t) as l ->
+      let t' = map_rec t in
+      if t == t' then l else `Abs(s, t')
+  | `App (t1, t2) as l ->
+      let t'1 = map_rec t1 and t'2 = map_rec t2 in
+      if t'1 == t1 && t'2 == t2 then l else `App (t'1, t'2)
+
+let next_id =
+  let current = ref 3 in
+  fun () -> incr current; !current
+
+let subst_lambda ~subst_rec ~free ~subst : _ lambda -> _ = function
+    #var as x -> subst_var ~subst x
+  | `Abs(s, t) as l ->
+      let used = free t in
+      let used_expr =
+        Subst.fold subst ~init:[]
+          ~f:(fun ~key ~data acc ->
+                if Names.mem s used then data::acc else acc) in
+      if List.exists used_expr ~f:(fun t -> Names.mem s (free t)) then
+        let name = s ^ Int.to_string (next_id ()) in
+        `Abs(name,
+             subst_rec ~subst:(Subst.add ~key:s ~data:(`Var name) subst) t)
+      else
+        map_lambda ~map_rec:(subst_rec ~subst:(Subst.remove s subst)) l
+  | `App _ as l ->
+      map_lambda ~map_rec:(subst_rec ~subst) l
+
+let eval_lambda ~eval_rec ~subst l =
+  match map_lambda ~map_rec:eval_rec l with
+    `App(`Abs(s,t1), t2) ->
+      eval_rec (subst ~subst:(Subst.add ~key:s ~data:t2 Subst.empty) t1)
+  | t -> t
+
+(* Specialized versions to use on lambda *)
+
+let rec free1 x = free_lambda ~free_rec:free1 x
+let rec subst1 ~subst = subst_lambda ~subst_rec:subst1 ~free:free1 ~subst
+let rec eval1 x = eval_lambda ~eval_rec:eval1 ~subst:subst1 x
+
+
+(* The expr language of arithmetic expressions *)
+
+type 'a expr =
+    [`Var of string | `Num of int | `Add of 'a * 'a
+    | `Neg of 'a | `Mult of 'a * 'a]
+
+let free_expr ~free_rec : _ expr -> _ = function
+    #var as x -> free_var x
+  | `Num _ -> Names.empty
+  | `Add(x, y) -> Names.union (free_rec x) (free_rec y)
+  | `Neg x -> free_rec x
+  | `Mult(x, y) -> Names.union (free_rec x) (free_rec y)
+
+(* Here map_expr helps a lot *)
+let map_expr ~map_rec : _ expr -> _ = function
+    #var as x -> x
+  | `Num _ as x -> x
+  | `Add(x, y) as e ->
+      let x' = map_rec x and y' = map_rec y in
+      if x == x' && y == y' then e
+      else `Add(x', y')
+  | `Neg x as e ->
+      let x' = map_rec x in
+      if x == x' then e else `Neg x'
+  | `Mult(x, y) as e ->
+      let x' = map_rec x and y' = map_rec y in
+      if x == x' && y == y' then e
+      else `Mult(x', y')
+
+let subst_expr ~subst_rec ~subst : _ expr -> _ = function
+    #var as x -> subst_var ~subst x
+  | #expr as e -> map_expr ~map_rec:(subst_rec ~subst) e
+
+let eval_expr ~eval_rec e =
+  match map_expr ~map_rec:eval_rec e with
+    `Add(`Num m, `Num n) -> `Num (m+n)
+  | `Neg(`Num n) -> `Num (-n)
+  | `Mult(`Num m, `Num n) -> `Num (m*n)
+  | #expr as e -> e
+
+(* Specialized versions *)
+
+let rec free2 x = free_expr ~free_rec:free2 x
+let rec subst2 ~subst = subst_expr ~subst_rec:subst2 ~subst
+let rec eval2 x = eval_expr ~eval_rec:eval2 x
+
+
+(* The lexpr language, reunion of lambda and expr *)
+
+type lexpr =
+  [ `Var of string | `Abs of string * lexpr | `App of lexpr * lexpr
+  | `Num of int | `Add of lexpr * lexpr | `Neg of lexpr
+  | `Mult of lexpr * lexpr ]
+
+let rec free : lexpr -> _ = function
+    #lambda as x -> free_lambda ~free_rec:free x
+  | #expr as x -> free_expr ~free_rec:free x
+
+let rec subst ~subst:s : lexpr -> _ = function
+    #lambda as x -> subst_lambda ~subst_rec:subst ~subst:s ~free x
+  | #expr as x -> subst_expr ~subst_rec:subst ~subst:s x
+
+let rec eval : lexpr -> _ = function
+    #lambda as x -> eval_lambda ~eval_rec:eval ~subst x
+  | #expr as x -> eval_expr ~eval_rec:eval x
+
+let rec print = function
+  | `Var id -> print_string id
+  | `Abs (id, l) -> print_string ("\ " ^ id ^ " . "); print l
+  | `App (l1, l2) -> print l1; print_string " "; print l2
+  | `Num x -> print_int x
+  | `Add (e1, e2) -> print e1; print_string " + "; print e2
+  | `Neg e -> print_string "-"; print e
+  | `Mult (e1, e2) -> print e1; print_string " * "; print e2
+
+let () =
+  let e1 = eval1 (`App(`Abs("x",`Var"x"), `Var"y")) in
+  let e2 = eval2 (`Add(`Mult(`Num 3,`Neg(`Num 2)), `Var"x")) in
+  let e3 = eval (`Add(`App(`Abs("x",`Mult(`Var"x",`Var"x")),`Num 2), `Num 5)) in
+  print e1; print_newline ();
+  print e2; print_newline ();
+  print e3; print_newline ()
+(* Full fledge version, using objects to structure code *)
+
+open StdLabels
+open MoreLabels
+
+(* Use maps for substitutions and sets for free variables *)
+
+module Subst = Map.Make(struct type t = string let compare = compare end)
+module Names = Set.Make(struct type t = string let compare = compare end)
+
+(* To build recursive objects *)
+
+let lazy_fix make =
+  let rec obj () = make (lazy (obj ()) : _ Lazy.t) in
+  obj ()
+
+let (!!) = Lazy.force
+
+(* The basic operations *)
+
+class type ['a, 'b] ops =
+  object
+    method free : x:'b -> ?y:'c -> Names.t
+    method subst : sub:'a Subst.t -> 'b -> 'a
+    method eval : 'b -> 'a
+  end
+
+(* Variables are common to lambda and expr *)
+
+type var = [`Var of string]
+
+class ['a] var_ops = object (self : ('a, var) #ops)
+  constraint 'a = [> var]
+  method subst ~sub (`Var s as x) =
+    try Subst.find s sub with Not_found -> x
+  method free (`Var s) =
+    Names.singleton s
+  method eval (#var as v) = v
+end
+
+(* The lambda language: free variables, substitutions, and evaluation *)
+
+type 'a lambda = [`Var of string | `Abs of string * 'a | `App of 'a * 'a]
+
+let next_id =
+  let current = ref 3 in
+  fun () -> incr current; !current
+
+class ['a] lambda_ops (ops : ('a,'a) #ops Lazy.t) =
+  let var : 'a var_ops = new var_ops
+  and free = lazy !!ops#free
+  and subst = lazy !!ops#subst
+  and eval = lazy !!ops#eval in
+  object (self : ('a, 'a lambda) #ops)
+    constraint 'a = [> 'a lambda]
+    method free = function
+        #var as x -> var#free x
+      | `Abs (s, t) -> Names.remove s (!!free t)
+      | `App (t1, t2) -> Names.union (!!free t1) (!!free t2)
+
+    method map ~f = function
+        #var as x -> x
+      | `Abs (s, t) as l ->
+          let t' = f t in
+          if t == t' then l else `Abs(s, t')
+      | `App (t1, t2) as l ->
+          let t'1 = f t1 and t'2 = f t2 in
+          if t'1 == t1 && t'2 == t2 then l else `App (t'1, t'2)
+
+    method subst ~sub = function
+        #var as x -> var#subst ~sub x
+      | `Abs(s, t) as l ->
+          let used = !!free t in
+          let used_expr =
+            Subst.fold sub ~init:[]
+              ~f:(fun ~key ~data acc ->
+                if Names.mem s used then data::acc else acc) in
+          if List.exists used_expr ~f:(fun t -> Names.mem s (!!free t)) then
+            let name = s ^ Int.to_string (next_id ()) in
+            `Abs(name,
+                 !!subst ~sub:(Subst.add ~key:s ~data:(`Var name) sub) t)
+          else
+            self#map ~f:(!!subst ~sub:(Subst.remove s sub)) l
+      | `App _ as l ->
+          self#map ~f:(!!subst ~sub) l
+
+    method eval l =
+      match self#map ~f:!!eval l with
+        `App(`Abs(s,t1), t2) ->
+          !!eval (!!subst ~sub:(Subst.add ~key:s ~data:t2 Subst.empty) t1)
+      | t -> t
+end
+
+(* Operations specialized to lambda *)
+
+let lambda = lazy_fix (new lambda_ops)
+
+(* The expr language of arithmetic expressions *)
+
+type 'a expr =
+    [ `Var of string | `Num of int | `Add of 'a * 'a
+    | `Neg of 'a | `Mult of 'a * 'a]
+
+class ['a] expr_ops (ops : ('a,'a) #ops Lazy.t) =
+  let var : 'a var_ops = new var_ops
+  and free = lazy !!ops#free
+  and subst = lazy !!ops#subst
+  and eval = lazy !!ops#eval in
+  object (self : ('a, 'a expr) #ops)
+    constraint 'a = [> 'a expr]
+    method free = function
+        #var as x -> var#free x
+      | `Num _ -> Names.empty
+      | `Add(x, y) -> Names.union (!!free x) (!!free y)
+      | `Neg x -> !!free x
+      | `Mult(x, y) -> Names.union (!!free x) (!!free y)
+
+    method map ~f = function
+        #var as x -> x
+      | `Num _ as x -> x
+      | `Add(x, y) as e ->
+          let x' = f x and y' = f y in
+          if x == x' && y == y' then e
+          else `Add(x', y')
+      | `Neg x as e ->
+          let x' = f x in
+          if x == x' then e else `Neg x'
+      | `Mult(x, y) as e ->
+          let x' = f x and y' = f y in
+          if x == x' && y == y' then e
+          else `Mult(x', y')
+
+    method subst ~sub = function
+        #var as x -> var#subst ~sub x
+      | #expr as e -> self#map ~f:(!!subst ~sub) e
+
+    method eval (#expr as e) =
+      match self#map ~f:!!eval e with
+        `Add(`Num m, `Num n) -> `Num (m+n)
+      | `Neg(`Num n) -> `Num (-n)
+      | `Mult(`Num m, `Num n) -> `Num (m*n)
+      | e -> e
+  end
+
+(* Specialized versions *)
+
+let expr = lazy_fix (new expr_ops)
+
+(* The lexpr language, reunion of lambda and expr *)
+
+type 'a lexpr = [ 'a lambda | 'a expr ]
+
+class ['a] lexpr_ops (ops : ('a,'a) #ops Lazy.t) =
+  let lambda = new lambda_ops ops in
+  let expr = new expr_ops ops in
+  object (self : ('a, 'a lexpr) #ops)
+    constraint 'a = [> 'a lexpr]
+    method free = function
+        #lambda as x -> lambda#free x
+      | #expr as x -> expr#free x
+
+    method subst ~sub = function
+        #lambda as x -> lambda#subst ~sub x
+      | #expr as x -> expr#subst ~sub x
+
+    method eval = function
+        #lambda as x -> lambda#eval x
+      | #expr as x -> expr#eval x
+end
+
+let lexpr = lazy_fix (new lexpr_ops)
+
+let rec print = function
+  | `Var id -> print_string id
+  | `Abs (id, l) -> print_string ("\ " ^ id ^ " . "); print l
+  | `App (l1, l2) -> print l1; print_string " "; print l2
+  | `Num x -> print_int x
+  | `Add (e1, e2) -> print e1; print_string " + "; print e2
+  | `Neg e -> print_string "-"; print e
+  | `Mult (e1, e2) -> print e1; print_string " * "; print e2
+
+let () =
+  let e1 = lambda#eval (`App(`Abs("x",`Var"x"), `Var"y")) in
+  let e2 = expr#eval (`Add(`Mult(`Num 3,`Neg(`Num 2)), `Var"x")) in
+  let e3 =
+    lexpr#eval (`Add(`App(`Abs("x",`Mult(`Var"x",`Var"x")),`Num 2), `Num 5))
+  in
+  print e1; print_newline ();
+  print e2; print_newline ();
+  print e3; print_newline ()
+(* Full fledge version, using objects to structure code *)
+
+open StdLabels
+open MoreLabels
+
+(* Use maps for substitutions and sets for free variables *)
+
+module Subst = Map.Make(struct type t = string let compare = compare end)
+module Names = Set.Make(struct type t = string let compare = compare end)
+
+(* To build recursive objects *)
+
+let lazy_fix make =
+  let rec obj () = make (lazy (obj ()) : _ Lazy.t) in
+  obj ()
+
+let (!!) = Lazy.force
+
+(* The basic operations *)
+
+class type ['a, 'b] ops =
+  object
+    method free : 'b -> Names.t
+    method subst : sub:'a Subst.t -> 'b -> 'a
+    method eval : 'b -> 'a
+  end
+
+(* Variables are common to lambda and expr *)
+
+type var = [`Var of string]
+
+let var = object (self : ([>var], var) #ops)
+  method subst ~sub (`Var s as x) =
+    try Subst.find s sub with Not_found -> x
+  method free (`Var s) =
+    Names.singleton s
+  method eval (#var as v) = v
+end
+
+(* The lambda language: free variables, substitutions, and evaluation *)
+
+type 'a lambda = [`Var of string | `Abs of string * 'a | `App of 'a * 'a]
+
+let next_id =
+  let current = ref 3 in
+  fun () -> incr current; !current
+
+let lambda_ops (ops : ('a,'a) #ops Lazy.t) =
+  let free = lazy !!ops#free
+  and subst = lazy !!ops#subst
+  and eval = lazy !!ops#eval in
+  object (self : ([> 'a lambda], 'a lambda) #ops)
+    method free = function
+        #var as x -> var#free x
+      | `Abs (s, t) -> Names.remove s (!!free t)
+      | `App (t1, t2) -> Names.union (!!free t1) (!!free t2)
+
+    method private map ~f = function
+        #var as x -> x
+      | `Abs (s, t) as l ->
+          let t' = f t in
+          if t == t' then l else `Abs(s, t')
+      | `App (t1, t2) as l ->
+          let t'1 = f t1 and t'2 = f t2 in
+          if t'1 == t1 && t'2 == t2 then l else `App (t'1, t'2)
+
+    method subst ~sub = function
+        #var as x -> var#subst ~sub x
+      | `Abs(s, t) as l ->
+          let used = !!free t in
+          let used_expr =
+            Subst.fold sub ~init:[]
+              ~f:(fun ~key ~data acc ->
+                if Names.mem s used then data::acc else acc) in
+          if List.exists used_expr ~f:(fun t -> Names.mem s (!!free t)) then
+            let name = s ^ Int.to_string (next_id ()) in
+            `Abs(name,
+                 !!subst ~sub:(Subst.add ~key:s ~data:(`Var name) sub) t)
+          else
+            self#map ~f:(!!subst ~sub:(Subst.remove s sub)) l
+      | `App _ as l ->
+          self#map ~f:(!!subst ~sub) l
+
+    method eval l =
+      match self#map ~f:!!eval l with
+        `App(`Abs(s,t1), t2) ->
+          !!eval (!!subst ~sub:(Subst.add ~key:s ~data:t2 Subst.empty) t1)
+      | t -> t
+end
+
+(* Operations specialized to lambda *)
+
+let lambda = lazy_fix lambda_ops
+
+(* The expr language of arithmetic expressions *)
+
+type 'a expr =
+    [ `Var of string | `Num of int | `Add of 'a * 'a
+    | `Neg of 'a | `Mult of 'a * 'a]
+
+let expr_ops (ops : ('a,'a) #ops Lazy.t) =
+  let free = lazy !!ops#free
+  and subst = lazy !!ops#subst
+  and eval = lazy !!ops#eval in
+  object (self : ([> 'a expr], 'a expr) #ops)
+    method free = function
+        #var as x -> var#free x
+      | `Num _ -> Names.empty
+      | `Add(x, y) -> Names.union (!!free x) (!!free y)
+      | `Neg x -> !!free x
+      | `Mult(x, y) -> Names.union (!!free x) (!!free y)
+
+    method private map ~f = function
+        #var as x -> x
+      | `Num _ as x -> x
+      | `Add(x, y) as e ->
+          let x' = f x and y' = f y in
+          if x == x' && y == y' then e
+          else `Add(x', y')
+      | `Neg x as e ->
+          let x' = f x in
+          if x == x' then e else `Neg x'
+      | `Mult(x, y) as e ->
+          let x' = f x and y' = f y in
+          if x == x' && y == y' then e
+          else `Mult(x', y')
+
+    method subst ~sub = function
+        #var as x -> var#subst ~sub x
+      | #expr as e -> self#map ~f:(!!subst ~sub) e
+
+    method eval (#expr as e) =
+      match self#map ~f:!!eval e with
+        `Add(`Num m, `Num n) -> `Num (m+n)
+      | `Neg(`Num n) -> `Num (-n)
+      | `Mult(`Num m, `Num n) -> `Num (m*n)
+      | e -> e
+  end
+
+(* Specialized versions *)
+
+let expr = lazy_fix expr_ops
+
+(* The lexpr language, reunion of lambda and expr *)
+
+type 'a lexpr = [ 'a lambda | 'a expr ]
+
+let lexpr_ops (ops : ('a,'a) #ops Lazy.t) =
+  let lambda = lambda_ops ops in
+  let expr = expr_ops ops in
+  object (self : ([> 'a lexpr], 'a lexpr) #ops)
+    method free = function
+        #lambda as x -> lambda#free x
+      | #expr as x -> expr#free x
+
+    method subst ~sub = function
+        #lambda as x -> lambda#subst ~sub x
+      | #expr as x -> expr#subst ~sub x
+
+    method eval = function
+        #lambda as x -> lambda#eval x
+      | #expr as x -> expr#eval x
+end
+
+let lexpr = lazy_fix lexpr_ops
+
+let rec print = function
+  | `Var id -> print_string id
+  | `Abs (id, l) -> print_string ("\ " ^ id ^ " . "); print l
+  | `App (l1, l2) -> print l1; print_string " "; print l2
+  | `Num x -> print_int x
+  | `Add (e1, e2) -> print e1; print_string " + "; print e2
+  | `Neg e -> print_string "-"; print e
+  | `Mult (e1, e2) -> print e1; print_string " * "; print e2
+
+let () =
+  let e1 = lambda#eval (`App(`Abs("x",`Var"x"), `Var"y")) in
+  let e2 = expr#eval (`Add(`Mult(`Num 3,`Neg(`Num 2)), `Var"x")) in
+  let e3 =
+    lexpr#eval (`Add(`App(`Abs("x",`Mult(`Var"x",`Var"x")),`Num 2), `Num 5))
+  in
+  print e1; print_newline ();
+  print e2; print_newline ();
+  print e3; print_newline ()
+type sexp = A of string | L of sexp list
+type 'a t = 'a array
+let _ = fun (_ : 'a t)  -> ()
+
+let array_of_sexp _ _ = [| |]
+let sexp_of_array _ _ = A "foo"
+let sexp_of_int _ = A "42"
+let int_of_sexp _ = 42
+
+let t_of_sexp : 'a . (sexp -> 'a) -> sexp -> 'a t=
+  let _tp_loc = "core_array.ml.t" in
+  fun _of_a  -> fun t  -> (array_of_sexp _of_a) t
+let _ = t_of_sexp
+let sexp_of_t : 'a . ('a -> sexp) -> 'a t -> sexp=
+  fun _of_a  -> fun v  -> (sexp_of_array _of_a) v
+let _ = sexp_of_t
+module T =
+  struct
+    module Int =
+      struct
+        type t_ = int array
+        let _ = fun (_ : t_)  -> ()
+
+        let t__of_sexp: sexp -> t_ =
+          let _tp_loc = "core_array.ml.T.Int.t_" in
+          fun t  -> (array_of_sexp int_of_sexp) t
+        let _ = t__of_sexp
+        let sexp_of_t_: t_ -> sexp =
+          fun v  -> (sexp_of_array sexp_of_int) v
+        let _ = sexp_of_t_
+      end
+  end
+module type Permissioned  =
+  sig
+    type ('a,-'perms) t
+  end
+module Permissioned :
+  sig
+    type ('a,-'perms) t
+    include
+      sig
+        val t_of_sexp :
+          (sexp -> 'a) ->
+            (sexp -> 'perms) -> sexp -> ('a,'perms) t
+        val sexp_of_t :
+          ('a -> sexp) ->
+            ('perms -> sexp) -> ('a,'perms) t -> sexp
+      end
+    module Int :
+    sig
+      type nonrec -'perms t = (int,'perms) t
+      include
+        sig
+          val t_of_sexp :
+            (sexp -> 'perms) -> sexp -> 'perms t
+          val sexp_of_t :
+            ('perms -> sexp) -> 'perms t -> sexp
+        end
+    end
+  end =
+  struct
+    type ('a,-'perms) t = 'a array
+    let _ = fun (_ : ('a,'perms) t)  -> ()
+
+    let t_of_sexp :
+      'a 'perms .
+        (sexp -> 'a) ->
+          (sexp -> 'perms) -> sexp -> ('a,'perms) t=
+      let _tp_loc = "core_array.ml.Permissioned.t" in
+      fun _of_a  -> fun _of_perms  -> fun t  -> (array_of_sexp _of_a) t
+    let _ = t_of_sexp
+    let sexp_of_t :
+      'a 'perms .
+        ('a -> sexp) ->
+          ('perms -> sexp) -> ('a,'perms) t -> sexp=
+      fun _of_a  -> fun _of_perms  -> fun v  -> (sexp_of_array _of_a) v
+    let _ = sexp_of_t
+    module Int =
+      struct
+        include T.Int
+        type -'perms t = t_
+        let _ = fun (_ : 'perms t)  -> ()
+
+        let t_of_sexp :
+          'perms . (sexp -> 'perms) -> sexp -> 'perms t=
+          let _tp_loc = "core_array.ml.Permissioned.Int.t" in
+          fun _of_perms  -> fun t  -> t__of_sexp t
+        let _ = t_of_sexp
+        let sexp_of_t :
+          'perms . ('perms -> sexp) -> 'perms t -> sexp=
+          fun _of_perms  -> fun v  -> sexp_of_t_ v
+        let _ = sexp_of_t
+      end
+  end
+type 'a  foo = {x: 'a; y: int}
+let r = {{x = 0; y = 0} with x = 0}
+let r' : string foo = r
+external foo : int = "%ignore";;
+let _ = foo ();;
+type 'a t = [`A of 'a t t] as 'a;; (* fails *)
+
+type 'a t = [`A of 'a t t];; (* fails *)
+
+type 'a t = [`A of 'a t t] constraint 'a = 'a t;;
+
+type 'a t = [`A of 'a t] constraint 'a = 'a t;;
+
+type 'a t = [`A of 'a] as 'a;;
+
+type 'a v = [`A of u v] constraint 'a = t and t = u and u = t;; (* fails *)
+
+type 'a t = 'a;;
+let f (x : 'a t as 'a) = ();; (* fails *)
+
+let f (x : 'a t) (y : 'a) = x = y;;
+
+(* PR#6505 *)
+module type PR6505 = sig
+  type 'o is_an_object = < .. > as 'o
+  and 'o abs constraint 'o = 'o is_an_object
+  val abs : 'o is_an_object -> 'o abs
+  val unabs : 'o abs -> 'o
+end;; (* fails *)
+(* PR#5835 *)
+let f ~x = x + 1;;
+f ?x:0;;
+
+(* PR#6352 *)
+let foo (f : unit -> unit) = ();;
+let g ?x () = ();;
+foo ((); g);;
+
+(* PR#5748 *)
+foo (fun ?opt () -> ()) ;; (* fails *)
+(* PR#5907 *)
+
+type 'a t = 'a;;
+let f (g : 'a list -> 'a t -> 'a) s = g s s;;
+let f (g : 'a * 'b -> 'a t -> 'a) s = g s s;;
+type ab = [ `A | `B ];;
+let f (x : [`A]) = match x with #ab -> 1;;
+let f x = ignore (match x with #ab -> 1); ignore (x : [`A]);;
+let f x = ignore (match x with `A|`B -> 1); ignore (x : [`A]);;
+
+let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *)
+let f (x : [`A | `B]) = match x with `A | `B | `C -> 0;; (* fail *)
+
+(* PR#6787 *)
+let revapply x f = f x;;
+
+let f x (g : [< `Foo]) =
+  let y = `Bar x, g in
+  revapply y (fun ((`Bar i), _) -> i);;
+(* f : 'a -> [< `Foo ] -> 'a *)
+
+let rec x = [| x |]; 1.;;
+
+let rec x = let u = [|y|] in 10. and y = 1.;;
+type 'a t
+type a
+
+let f : < .. > t -> unit = fun _ -> ();;
+
+let g : [< `b] t -> unit = fun _ -> ();;
+
+let h : [> `b] t -> unit = fun _ -> ();;
+
+let _ = fun (x : a t) -> f x;;
+
+let _ = fun (x : a t) -> g x;;
+
+let _ = fun (x : a t) -> h x;;
+(* PR#7012 *)
+
+type t = [ 'A_name | `Hi ];;
+
+let f (x:'id_arg) = x;;
+
+let f (x:'Id_arg) = x;;
+(* undefined labels *)
+type t = {x:int;y:int};;
+{x=3;z=2};;
+fun {x=3;z=2} -> ();;
+
+(* mixed labels *)
+{x=3; contents=2};;
+
+(* private types *)
+type u = private {mutable u:int};;
+{u=3};;
+fun x -> x.u <- 3;;
+
+(* Punning and abbreviations *)
+module M = struct
+  type t = {x: int; y: int}
+end;;
+
+let f {M.x; y} = x+y;;
+let r = {M.x=1; y=2};;
+let z = f r;;
+
+(* messages *)
+type foo = { mutable y:int };;
+let f (r: int) = r.y <- 3;;
+
+(* bugs *)
+type foo = { y: int; z: int };;
+type bar = { x: int };;
+let f (r: bar) = ({ r with z = 3 } : foo)
+
+type foo = { x: int };;
+let r : foo = { ZZZ.x = 2 };;
+
+(ZZZ.X : int option);;
+
+(* PR#5865 *)
+let f (x : Complex.t) = x.Complex.z;;
+(* PR#6394 *)
+
+module rec X : sig
+ type t = int * bool
+end = struct
+ type t = A | B
+ let f = function A | B -> 0
+end;;
+(* PR#6768 *)
+
+type _ prod = Prod : ('a * 'y) prod;;
+
+let f : type t. t prod -> _ = function Prod ->
+  let module M =
+    struct
+      type d = d * d
+    end
+  in ()
+;;
+let (a : M.a) = 2
+let (b : M.b) = 2
+let _ = A.a = B.b
+module Std = struct module Hash = Hashtbl end;;
+
+open Std;;
+module Hash1 : module type of Hash = Hash;;
+module Hash2 : sig include (module type of Hash) end = Hash;;
+let f1 (x : (_,_) Hash1.t) = (x : (_,_) Hashtbl.t);;
+let f2 (x : (_,_) Hash2.t) = (x : (_,_) Hashtbl.t);;
+
+(* Another case, not using include *)
+
+module Std2 = struct module M = struct type t end end;;
+module Std' = Std2;;
+module M' : module type of Std'.M = Std2.M;;
+let f3 (x : M'.t) = (x : Std2.M.t);;
+
+(* original report required Core_kernel:
+module type S = sig
+open Core_kernel.Std
+
+module Hashtbl1 : module type of Hashtbl
+module Hashtbl2 : sig
+  include (module type of Hashtbl)
+end
+
+module Coverage : Core_kernel.Std.Hashable
+
+type types = unit constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl1.t
+type doesnt_type = unit
+  constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl2.t
+end
+*)
+module type INCLUDING = sig
+  include module type of List
+  include module type of ListLabels
+end
+
+module Including_typed: INCLUDING = struct
+  include List
+  include ListLabels
+end
+module X=struct
+  module type SIG=sig type t=int val x:t end
+  module F(Y:SIG) : SIG = struct type t=Y.t let x=Y.x end
+end;;
+module DUMMY=struct type t=int let x=2 end;;
+let x = (3 : X.F(DUMMY).t);;
+
+module X2=struct
+  module type SIG=sig type t=int val x:t end
+  module F(Y:SIG)(Z:SIG) = struct
+    type t=Y.t
+    let x=Y.x
+    type t'=Z.t
+    let x'=Z.x
+  end
+end;;
+let x = (3 : X2.F(DUMMY)(DUMMY).t);;
+let x = (3 : X2.F(DUMMY)(DUMMY).t');;
+module F (M : sig
+    type 'a t
+    type 'a u = string
+    val f : unit -> _ u t
+  end) = struct
+    let t = M.f ()
+  end
+type 't a = [ `A ]
+type 't wrap = 't constraint 't = [> 't wrap a ]
+type t = t a wrap
+
+module T = struct
+  let foo : 't wrap -> 't wrap -> unit = fun _ _ -> ()
+  let bar : ('a a wrap as 'a) = `A
+end
+
+module Good : sig
+  val bar: t
+  val foo: t -> t -> unit
+end = T
+
+module Bad : sig
+  val foo: t -> t -> unit
+  val bar: t
+end = T
+module M : sig
+  module type T
+  module F (X : T) : sig end
+end = struct
+  module type T = sig end
+  module F (X : T) = struct end
+end
+
+module type T = M.T
+
+module F : functor (X : T) -> sig end = M.F
+module type S = sig type t = { a : int; b : int; } end;;
+let f (module M : S with type t = int) = { M.a = 0 };;
+let flag = ref false
+module F(S : sig module type T end) (A : S.T) (B : S.T) =
+struct
+  module X = (val if !flag then (module A) else (module B) : S.T)
+end
+
+(* If the above were accepted, one could break soundness *)
+module type S = sig type t val x : t end
+module Float = struct type t = float let x = 0.0 end
+module Int = struct type t = int let x = 0 end
+
+module M = F(struct module type T = S end)
+
+let () = flag := false
+module M1 = M(Float)(Int)
+
+let () = flag := true
+module M2 = M(Float)(Int)
+
+let _ = [| M2.X.x; M1.X.x |]
+module type PR6513 = sig
+module type S = sig type u end
+
+module type T = sig
+  type 'a wrap
+  type uri
+end
+
+module Make: functor (Html5 : T with type 'a wrap = 'a) ->
+  S with type u = < foo : Html5.uri >
+end
+
+(* Requires -package tyxml
+module type PR6513_orig = sig
+module type S =
+sig
+        type t
+        type u
+end
+
+module Make: functor (Html5: Html5_sigs.T
+                             with type 'a Xml.wrap = 'a and
+                             type 'a wrap = 'a and
+                             type 'a list_wrap = 'a list)
+                     -> S with type t = Html5_types.div Html5.elt and
+                               type u = < foo: Html5.uri >
+end
+*)
+module type S = sig
+  include Set.S
+  module E : sig val x : int end
+end
+
+module Make(O : Set.OrderedType) : S with type elt = O.t =
+  struct
+    include Set.Make(O)
+    module E = struct let x = 1 end
+  end
+
+module rec A : Set.OrderedType = struct
+ type t = int
+  let compare = Stdlib.compare
+end
+and B : S = struct
+ module C = Make(A)
+ include C
+end
+module type S = sig
+  module type T
+  module X : T
+end
+
+module F (X : S) = X.X
+
+module M = struct
+  module type T = sig type t end
+  module X = struct type t = int end
+end
+
+type t = F(M).t
+module Common0 =
+ struct
+   type msg = Msg
+
+   let handle_msg = ref (function _ -> failwith "Unable to handle message")
+   let extend_handle f =
+   let old = !handle_msg in
+   handle_msg := f old
+
+   let q : _ Queue.t = Queue.create ()
+   let add msg = Queue.add msg q
+   let handle_queue_messages () = Queue.iter !handle_msg q
+ end
+
+let q' : Common0.msg Queue.t = Common0.q
+
+module Common =
+ struct
+   type msg = ..
+
+   let handle_msg = ref (function _ -> failwith "Unable to handle message")
+   let extend_handle f =
+   let old = !handle_msg in
+   handle_msg := f old
+
+   let q : _ Queue.t = Queue.create ()
+   let add msg = Queue.add msg q
+   let handle_queue_messages () = Queue.iter !handle_msg q
+ end
+
+module M1 =
+ struct
+   type Common.msg += Reload of string | Alert of string
+
+   let handle fallback = function
+     Reload s -> print_endline ("Reload "^s)
+   | Alert s -> print_endline ("Alert "^s)
+   | x -> fallback x
+
+   let () = Common.extend_handle handle
+   let () = Common.add (Reload "config.file")
+   let () = Common.add (Alert "Initialisation done")
+ end
+let should_reject =
+  let table = Hashtbl.create 1 in
+  fun x y -> Hashtbl.add table x y
+type 'a t = 'a option
+let is_some = function
+  | None -> false
+  | Some _ -> true
+
+let should_accept ?x () = is_some x
+include struct
+  let foo `Test = ()
+  let wrap f `Test = f
+  let bar = wrap ()
+end
+let f () =
+   let module S = String in
+   let module N = Map.Make(S) in
+   N.add "sum" 41 N.empty;;
+module X = struct module Y = struct module type S = sig type t end end end
+
+(* open X  (* works! *) *)
+module Y = X.Y
+
+type 'a arg_t = 'at constraint 'a = (module Y.S with type t = 'at)
+type t = (module X.Y.S with type t = unit)
+
+let f (x : t arg_t) = ()
+
+let () = f ()
+module type S =
+sig
+  type a
+  type b
+end
+module Foo
+    (Bar : S with type a = private [> `A])
+    (Baz : S with type b = private < b : Bar.b ; .. >) =
+struct
+end
+module A = struct
+ module type A_S = sig
+ end
+
+ type t = (module A_S)
+end
+
+module type S = sig type t end
+
+let f (type a) (module X : S with type t = a) = ()
+
+let _ = f (module A) (* ok *)
+
+module A_annotated_alias : S with type t = (module A.A_S) = A
+
+let _ = f (module A_annotated_alias) (* ok *)
+let _ = f (module A_annotated_alias : S with type t = (module A.A_S)) (* ok *)
+
+module A_alias = A
+module A_alias_expanded = struct include A_alias end
+
+let _ = f (module A_alias_expanded : S with type t = (module A.A_S)) (* ok *)
+let _ = f (module A_alias_expanded) (* ok *)
+
+let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type *)
+let _ = f (module A_alias) (* doesn't type either *)
+module Foo
+ (Bar : sig type a = private [> `A ] end)
+ (Baz : module type of struct include Bar end) =
+struct
+end
+module Bazoinks = struct type a = [ `A ] end
+module Bug = Foo(Bazoinks)(Bazoinks)
+(* PR#6992, reported by Stephen Dolan *)
+
+type (_, _) eq = Eq : ('a, 'a) eq
+let cast : type a b . (a, b) eq -> a -> b = fun Eq x -> x
+
+module Fix (F : sig type 'a f end) = struct
+  type 'a fix = ('a, 'a F.f) eq
+  let uniq (type a) (type b) (Eq : a fix) (Eq : b fix) : (a, b) eq = Eq
+end
+
+(* This would allow:
+module FixId = Fix (struct type 'a f = 'a end)
+ let bad : (int, string) eq = FixId.uniq Eq Eq
+ let _ = Printf.printf "Oh dear: %s" (cast bad 42)
+*)
+module M = struct
+ module type S = sig type a val v : a end
+ type 'a s = (module S with type a = 'a)
+end
+
+module B = struct
+ class type a = object method a : 'a. 'a M.s -> 'a end
+end
+
+module M' = M
+module B' = B
+
+class b : B.a = object
+ method a : 'a. 'a M.s -> 'a = fun (type a) ((module X) : (module M.S with type
+a = a)) -> X.v
+end
+
+class b' : B.a = object
+ method a : 'a. 'a M'.s -> 'a = fun (type a) ((module X) : (module M'.S with
+type a = a)) -> X.v
+end
+module type FOO = sig type t end
+module type BAR =
+sig
+  (* Works: module rec A : (sig include FOO with type t = < b:B.t > end) *)
+  module rec A : (FOO with type t = < b:B.t >)
+         and B : FOO
+end
+module A = struct module type S module S = struct end end
+module F (_ : sig end) = struct module type S module S = A.S end
+module M = struct end
+module N = M
+module G (X : F(N).S) : A.S = X
+module F (_ : sig end) = struct module type S end
+module M = struct end
+module N = M
+module G (X : F(N).S) : F(M).S = X
+module M :  sig
+  type make_dec
+  val add_dec: make_dec -> unit
+end = struct
+  type u
+
+  module Fast: sig
+    type 'd t
+    val create: unit -> 'd t
+    module type S = sig
+      module Data: sig type t end
+      val key: Data.t t
+    end
+    module Register (D:S): sig end
+    val attach: 'd t -> 'd -> unit
+  end = struct
+    type 'd t = unit
+    let create () = ()
+    module type S = sig
+      module Data: sig type t end
+      val key: Data.t t
+    end
+    module Register (D:S) = struct end
+    let attach _ _ = ()
+  end
+
+  type make_dec
+
+  module Dem = struct
+    module Data = struct
+      type t = make_dec
+    end
+    let key = Fast.create ()
+  end
+
+  module EDem = Fast.Register(Dem)
+
+  let add_dec dec =
+    Fast.attach Dem.key dec
+end
+
+(* simpler version *)
+
+module Simple = struct
+  type 'a t
+  module type S = sig
+    module Data: sig type t end
+    val key: Data.t t
+  end
+  module Register (D:S) = struct let key = D.key end
+  module M = struct
+    module Data = struct type t = int end
+    let key : _ t = Obj.magic ()
+  end
+end;;
+module EM = Simple.Register(Simple.M);;
+Simple.M.key;;
+
+module Simple2 = struct
+  type 'a t
+  module type S = sig
+    module Data: sig type t end
+    val key: Data.t t
+  end
+  module M = struct
+    module Data = struct type t = int end
+    let key : _ t = Obj.magic ()
+  end
+  module Register (D:S) = struct let key = D.key end
+  module EM = Simple.Register(Simple.M)
+  let k : M.Data.t t = M.key
+end;;
+module rec M
+    : sig external f : int -> int = "%identity" end
+    = struct external f : int -> int = "%identity" end
+(* with module *)
+
+module type S = sig type t and s = t end;;
+module type S' = S with type t := int;;
+
+module type S = sig module rec M : sig end and N : sig end end;;
+module type S' = S with module M := String;;
+
+(* with module type *)
+(*
+module type S = sig module type T module F(X:T) : T end;;
+module type T0 = sig type t end;;
+module type S1 = S with module type T = T0;;
+module type S2 = S with module type T := T0;;
+module type S3 = S with module type T := sig type t = int end;;
+module H = struct
+  include (Hashtbl : module type of Hashtbl with
+           type statistics := Hashtbl.statistics
+           and module type S := Hashtbl.S
+           and module Make := Hashtbl.Make
+           and module MakeSeeded := Hashtbl.MakeSeeded
+           and module type SeededS := Hashtbl.SeededS
+           and module type HashedType := Hashtbl.HashedType
+           and module type SeededHashedType := Hashtbl.SeededHashedType)
+end;;
+*)
+
+(* A subtle problem appearing with -principal *)
+type -'a t
+class type c = object method m : [ `A ] t end;;
+module M : sig val v : (#c as 'a) -> 'a end =
+  struct let v x = ignore (x :> c); x end;;
+
+(* PR#4838 *)
+
+let id = let module M = struct end in fun x -> x;;
+
+(* PR#4511 *)
+
+let ko = let module M = struct end in fun _ -> ();;
+
+(* PR#5993 *)
+
+module M : sig type -'a t = private int end =
+  struct type +'a t = private int end
+;;
+
+(* PR#6005 *)
+
+module type A = sig type t = X of int end;;
+type u = X of bool;;
+module type B = A with type t = u;; (* fail *)
+
+(* PR#5815 *)
+(* ---> duplicated exception name is now an error *)
+
+module type S = sig exception Foo of int  exception Foo of bool end;;
+
+(* PR#6410 *)
+
+module F(X : sig end) = struct let x = 3 end;;
+F.x;; (* fail *)
+module C = Char;;
+C.chr 66;;
+
+module C' : module type of Char = C;;
+C'.chr 66;;
+
+module C3 = struct include Char end;;
+C3.chr 66;;
+
+let f x = let module M = struct module L = List end in M.L.length x;;
+let g x = let module L = List in L.length (L.map succ x);;
+
+module F(X:sig end) = Char;;
+module C4 = F(struct end);;
+C4.chr 66;;
+
+module G(X:sig end) = struct module M = X end;; (* does not alias X *)
+module M = G(struct end);;
+
+module M' = struct
+  module N = struct let x = 1 end
+  module N' = N
+end;;
+M'.N'.x;;
+
+module M'' : sig module N' : sig val x : int end end = M';;
+M''.N'.x;;
+module M2 = struct include M' end;;
+module M3 : sig module N' : sig val x : int end end = struct include M' end;;
+M3.N'.x;;
+module M3' : sig module N' : sig val x : int end end = M2;;
+M3'.N'.x;;
+
+module M4 : sig module N' : sig val x : int end end = struct
+  module N = struct let x = 1 end
+  module N' = N
+end;;
+M4.N'.x;;
+
+module F(X:sig end) = struct
+  module N = struct let x = 1 end
+  module N' = N
+end;;
+module G : functor(X:sig end) -> sig module N' : sig val x : int end end = F;;
+module M5 = G(struct end);;
+M5.N'.x;;
+
+module M = struct
+  module D = struct let y = 3 end
+  module N = struct let x = 1 end
+  module N' = N
+end;;
+
+module M1 : sig module N : sig val x : int end module N' = N end = M;;
+M1.N'.x;;
+module M2 : sig module N' : sig val x : int end end =
+  (M : sig module N : sig val x : int end module N' = N end);;
+M2.N'.x;;
+
+open M;;
+N'.x;;
+
+module M = struct
+  module C = Char
+  module C' = C
+end;;
+module M1
+  : sig module C : sig val escaped : char -> string end module C' = C end
+  = M;; (* sound, but should probably fail *)
+M1.C'.escaped 'A';;
+module M2 : sig module C' : sig val chr : int -> char end end =
+  (M : sig module C : sig val chr : int -> char end module C' = C end);;
+M2.C'.chr 66;;
+
+StdLabels.List.map;;
+
+module Q = Queue;;
+exception QE = Q.Empty;;
+try Q.pop (Q.create ()) with QE -> "Ok";;
+
+module type Complex = module type of Complex with type t = Complex.t;;
+module M : sig module C : Complex end = struct module C = Complex end;;
+
+module C = Complex;;
+C.one.Complex.re;;
+include C;;
+
+module F(X:sig module C = Char end) = struct module C = X.C end;;
+
+(* Applicative functors *)
+module S = String
+module StringSet = Set.Make(String)
+module SSet = Set.Make(S);;
+let f (x : StringSet.t) = (x : SSet.t);;
+
+(* Also using include (cf. Leo's mail 2013-11-16) *)
+module F (M : sig end) : sig type t end = struct type t = int end
+module T = struct
+  module M = struct end
+  include F(M)
+end;;
+include T;;
+let f (x : t) : T.t = x ;;
+
+(* PR#4049 *)
+(* This works thanks to abbreviations *)
+module A = struct
+  module B = struct type t let compare x y = 0 end
+  module S = Set.Make(B)
+  let empty = S.empty
+end
+module A1 = A;;
+A1.empty = A.empty;;
+
+(* PR#3476 *)
+(* Does not work yet *)
+module FF(X : sig end) = struct type t end
+module M = struct
+  module X = struct end
+  module Y = FF (X) (* XXX *)
+  type t = Y.t
+end
+module F (Y : sig type t end) (M : sig type t = Y.t end) = struct end;;
+
+module G = F (M.Y);;
+(*module N = G (M);;
+module N = F (M.Y) (M);;*)
+
+(* PR#6307 *)
+
+module A1 = struct end
+module A2 = struct end
+module L1 = struct module X = A1 end
+module L2 = struct module X = A2 end;;
+
+module F (L : (module type of L1)) = struct end;;
+
+module F1 = F(L1);; (* ok *)
+module F2 = F(L2);; (* should succeed too *)
+
+(* Counter example: why we need to be careful with PR#6307 *)
+module Int = struct type t = int let compare = compare end
+module SInt = Set.Make(Int)
+type (_,_) eq = Eq : ('a,'a) eq
+type wrap = W of (SInt.t, SInt.t) eq
+
+module M = struct
+  module I = Int
+  type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(I).t) eq
+end;;
+module type S = module type of M;; (* keep alias *)
+
+module Int2 = struct type t = int let compare x y = compare y x end;;
+module type S' = sig
+  module I = Int2
+  include S with module I := I
+end;; (* fail *)
+
+(* (* if the above succeeded, one could break invariants *)
+module rec M2 : S' = M2;; (* should succeed! (but this is bad) *)
+
+let M2.W eq = W Eq;;
+
+let s = List.fold_right SInt.add [1;2;3] SInt.empty;;
+module SInt2 = Set.Make(Int2);;
+let conv : type a b. (a,b) eq -> a -> b = fun Eq x -> x;;
+let s' : SInt2.t = conv eq s;;
+SInt2.elements s';;
+SInt2.mem 2 s';; (* invariants are broken *)
+*)
+
+(* Check behavior with submodules *)
+module M = struct
+  module N = struct module I = Int end
+  module P = struct module I = N.I end
+  module Q = struct
+    type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(P.I).t) eq
+  end
+end;;
+module type S = module type of M ;;
+
+module M = struct
+  module N = struct module I = Int end
+  module P = struct module I = N.I end
+  module Q = struct
+    type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(N.I).t) eq
+  end
+end;;
+module type S = module type of M ;;
+
+(* PR#6365 *)
+module type S = sig module M : sig type t val x : t end end;;
+module H = struct type t = A let x = A end;;
+module H' = H;;
+module type S' = S with module M = H';; (* shouldn't introduce an alias *)
+
+(* PR#6376 *)
+module type Alias = sig module N : sig end module M = N end;;
+module F (X : sig end) = struct type t end;;
+module type A = Alias with module N := F(List);;
+module rec Bad : A = Bad;;
+
+(* Shinwell 2014-04-23 *)
+module B = struct
+ module R = struct
+   type t = string
+ end
+
+ module O = R
+end
+
+module K = struct
+ module E = B
+ module N = E.O
+end;;
+
+let x : K.N.t = "foo";;
+
+(* PR#6465 *)
+
+module M = struct type t = A module B = struct type u = B end end;;
+module P : sig type t = M.t = A module B = M.B end = M;; (* should be ok *)
+module P : sig type t = M.t = A module B = M.B end = struct include M end;;
+
+module type S = sig
+  module M : sig module P : sig end end
+  module Q = M
+end;;
+module type S = sig
+  module M : sig module N : sig end module P : sig end end
+  module Q : sig module N = M.N module P = M.P end
+end;;
+module R = struct
+  module M = struct module N = struct end module P = struct end end
+  module Q = M
+end;;
+module R' : S = R;; (* should be ok *)
+
+(* PR#6578 *)
+
+module M = struct let f x = x end
+module rec R : sig module M : sig val f : 'a -> 'a end end =
+  struct module M = M end;;
+R.M.f 3;;
+module rec R : sig module M = M end = struct module M = M end;;
+R.M.f 3;;
+open A
+let f =
+  L.map S.capitalize
+
+let () =
+  L.iter print_endline (f ["jacques"; "garrigue"])
+
+module C : sig module L : module type of List end = struct include A end
+
+(* The following introduces a (useless) dependency on A:
+module C : sig module L : module type of List end = A
+*)
+
+include D'
+(*
+let () =
+  print_endline (Int.to_string D'.M.y)
+*)
+open A
+let f =
+  L.map S.capitalize
+
+let () =
+  L.iter print_endline (f ["jacques"; "garrigue"])
+
+module C : sig module L : module type of List end = struct include A end
+
+(* The following introduces a (useless) dependency on A:
+module C : sig module L : module type of List end = A
+*)
+
+(* No dependency on D *)
+let x = 3
+module M = struct let y = 5 end
+module type S = sig type u type t end;;
+module type S' = sig type t = int type u = bool end;;
+
+(* ok to convert between structurally equal signatures, and parameters
+   are inferred *)
+let f (x : (module S with type t = 'a and type u = 'b)) = (x : (module S'));;
+let g x = (x : (module S with type t = 'a and type u = 'b) :> (module S'));;
+
+(* with subtyping it is also ok to forget some types *)
+module type S2 = sig type u type t type w end;;
+let g2 x = (x : (module S2 with type t = 'a and type u = 'b) :> (module S'));;
+let h x = (x : (module S2 with type t = 'a) :> (module S with type t = 'a));;
+let f2 (x : (module S2 with type t = 'a and type u = 'b)) =
+  (x : (module S'));; (* fail *)
+let k (x : (module S2 with type t = 'a)) =
+  (x : (module S with type t = 'a));; (* fail *)
+
+(* but you cannot forget values (no physical coercions) *)
+module type S3 = sig type u type t val x : int end;;
+let g3 x =
+  (x : (module S3 with type t = 'a and type u = 'b) :> (module S'));; (* fail *)
+(* Using generative functors *)
+
+(* Without type *)
+module type S = sig val x : int end;;
+let v = (module struct let x = 3 end : S);;
+module F() = (val v);; (* ok *)
+module G (X : sig end) : S = F ();; (* ok *)
+module H (X : sig end) = (val v);; (* ok *)
+
+(* With type *)
+module type S = sig type t val x : t end;;
+let v = (module struct type t = int let x = 3 end : S);;
+module F() = (val v);; (* ok *)
+module G (X : sig end) : S = F ();; (* fail *)
+module H() = F();; (* ok *)
+
+(* Alias *)
+module U = struct end;;
+module M = F(struct end);; (* ok *)
+module M = F(U);; (* fail *)
+
+(* Cannot coerce between applicative and generative *)
+module F1 (X : sig end) = struct end;;
+module F2 : functor () -> sig end = F1;; (* fail *)
+module F3 () = struct end;;
+module F4 : functor (X : sig end) -> sig end = F3;; (* fail *)
+
+(* tests for shortened functor notation () *)
+module X (X: sig end) (Y: sig end) = functor (Z: sig end) -> struct end;;
+module Y = functor (X: sig end) (Y:sig end) -> functor (Z: sig end) ->
+  struct end;;
+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;;
+module F (X : sig end) = struct type t = int end;;
+module F (_ : sig end) = struct type t = int end;;
+type t = F(Does_not_exist).t;;
+type expr =
+  [ `Abs of string * expr
+  | `App of expr * expr
+  ]
+
+class type exp =
+object
+  method eval : (string, exp) Hashtbl.t -> expr
+end;;
+
+class app e1 e2 : exp =
+object
+  val l = e1
+  val r = e2
+  method eval env =
+      match l with
+    | `Abs(var,body) ->
+        Hashtbl.add env var r;
+        body
+    | _ -> `App(l,r);
+end
+
+class virtual ['subject, 'event] observer =
+   object
+     method virtual notify : 'subject ->  'event -> unit
+   end
+
+class ['event] subject =
+   object (self : 'subject)
+     val mutable observers = ([]: (('subject, 'event) observer) list)
+     method add_observer obs = observers <- (obs :: observers)
+     method notify_observers (e : 'event) =
+         List.iter (fun x -> x#notify self e) observers
+   end
+
+type id = int
+
+class entity (id : id) =
+  object
+    val ent_destroy_subject = new subject
+    method destroy_subject : (id) subject = ent_destroy_subject
+
+    method entity_id = id
+  end
+
+class ['entity] entity_container =
+  object (self)
+    inherit ['entity, id] observer as observer
+
+    method add_entity (e : 'entity) =
+      e#destroy_subject#add_observer (self)
+
+    method notify _ id = ()
+  end
+
+let f (x : entity entity_container) = ()
+
+(*
+class world =
+  object
+    val entity_container : entity entity_container = new entity_container
+
+    method add_entity (s : entity) =
+      entity_container#add_entity (s :> entity)
+
+  end
+*)
+(* Two v's in the same class *)
+class c v = object initializer  print_endline v val v = 42 end;;
+new c "42";;
+
+(* Two hidden v's in the same class! *)
+class c (v : int) =
+  object
+    method v0 = v
+    inherit ((fun v -> object method v : string = v end) "42")
+  end;;
+(new c 42)#v0;;
+class virtual ['a] c =
+object (s : 'a)
+  method virtual m : 'b
+end
+
+let o =
+    object (s :'a)
+      inherit ['a] c
+      method m = 42
+    end
+module M :
+   sig
+     class x : int -> object method m : int end
+  end
+=
+struct
+  class x _ = object
+    method m = 42
+  end
+end;;
+module M : sig class c : 'a -> object val x : 'b end end =
+  struct class c x = object val x = x end end
+
+class c (x : int) = object inherit M.c x method x : bool = x end
+
+let r = (new c 2)#x;;
+(* test.ml *)
+class alfa = object(_:'self)
+  method x: 'a. ('a, out_channel, unit) format -> 'a = Printf.printf
+end
+
+class bravo a = object
+  val y = (a :> alfa)
+  initializer y#x "bravo initialized"
+end
+
+class charlie a = object
+  inherit bravo a
+  initializer y#x "charlie initialized"
+end
+(* The module begins *)
+exception Out_of_range
+
+class type ['a] cursor =
+  object
+    method get : 'a
+    method incr : unit -> unit
+    method is_last : bool
+  end
+
+class type ['a] storage =
+  object ('self)
+    method first : 'a cursor
+    method len : int
+    method nth : int -> 'a cursor
+    method copy : 'self
+    method sub : int -> int -> 'self
+    method concat : 'a storage -> 'self
+    method fold : 'b. ('a -> int -> 'b -> 'b) -> 'b -> 'b
+    method iter : ('a -> unit) -> unit
+  end
+
+class virtual ['a, 'cursor] storage_base =
+  object (self : 'self)
+    constraint 'cursor = 'a #cursor
+    method virtual first : 'cursor
+    method virtual len : int
+    method virtual copy : 'self
+    method virtual sub : int -> int -> 'self
+    method virtual concat : 'a storage -> 'self
+    method fold : 'b. ('a -> int -> 'b -> 'b) -> 'b -> 'b = fun f a0 ->
+      let cur = self#first in
+      let rec loop count a =
+        if count >= self#len then a else
+        let a' = f cur#get count a in
+        cur#incr (); loop (count + 1) a'
+      in
+      loop 0 a0
+    method iter proc =
+      let p = self#first in
+      for i = 0 to self#len - 2 do proc p#get; p#incr () done;
+      if self#len > 0 then proc p#get else ()
+  end
+
+class type ['a] obj_input_channel =
+  object
+    method get : unit -> 'a
+    method close : unit -> unit
+  end
+
+class type ['a] obj_output_channel =
+  object
+    method put : 'a -> unit
+    method flush : unit -> unit
+    method close : unit -> unit
+  end
+
+module UChar =
+struct
+
+  type t = int
+
+  let highest_bit = 1 lsl 30
+  let lower_bits = highest_bit - 1
+
+  let char_of c =
+    try Char.chr c with Invalid_argument _ ->  raise Out_of_range
+
+  let of_char = Char.code
+
+  let code c =
+    if c lsr 30 = 0
+    then c
+    else raise Out_of_range
+
+  let chr n =
+    if n >= 0 && (n lsr 31 = 0) then n else raise Out_of_range
+
+  let uint_code c = c
+  let chr_of_uint n = n
+
+end
+
+type uchar = UChar.t
+
+let int_of_uchar u = UChar.uint_code u
+let uchar_of_int n = UChar.chr_of_uint n
+
+class type ucursor = [uchar] cursor
+
+class type ustorage = [uchar] storage
+
+class virtual ['ucursor] ustorage_base = [uchar, 'ucursor] storage_base
+
+module UText =
+struct
+
+(* the internal representation is UCS4 with big endian*)
+(* The most significant digit appears first. *)
+let get_buf s i =
+  let n = Char.code s.[i] in
+  let n = (n lsl 8) lor (Char.code s.[i + 1]) in
+  let n = (n lsl 8) lor (Char.code s.[i + 2]) in
+  let n = (n lsl 8) lor (Char.code s.[i + 3]) in
+  UChar.chr_of_uint n
+
+let set_buf s i u =
+  let n = UChar.uint_code u in
+  begin
+    s.[i] <- Char.chr (n lsr 24);
+    s.[i + 1] <- Char.chr (n lsr 16 lor 0xff);
+    s.[i + 2] <- Char.chr (n lsr 8 lor 0xff);
+    s.[i + 3] <- Char.chr (n lor 0xff);
+  end
+
+let init_buf buf pos init =
+  if init#len = 0 then () else
+  let cur = init#first in
+  for i = 0 to init#len - 2 do
+    set_buf buf (pos + i lsl 2) (cur#get); cur#incr ()
+  done;
+  set_buf buf (pos + (init#len - 1) lsl 2) (cur#get)
+
+let make_buf init =
+  let s = String.create (init#len lsl 2) in
+  init_buf s 0 init; s
+
+class text_raw buf =
+  object (self : 'self)
+    inherit [cursor] ustorage_base
+    val contents = buf
+    method first = new cursor (self :> text_raw) 0
+    method len = (String.length contents) / 4
+    method get i = get_buf contents (4 * i)
+    method nth i = new cursor (self :> text_raw) i
+    method copy = {< contents = String.copy contents >}
+    method sub pos len =
+      {< contents = String.sub contents (pos * 4) (len * 4) >}
+    method concat (text : ustorage) =
+      let buf = String.create (String.length contents + 4 * text#len) in
+      String.blit contents 0 buf 0 (String.length contents);
+      init_buf buf (String.length contents) text;
+      {< contents = buf >}
+  end
+and cursor text i =
+  object
+    val contents = text
+    val mutable pos = i
+    method get = contents#get pos
+    method incr () = pos <- pos + 1
+    method is_last = (pos + 1 >= contents#len)
+  end
+
+class string_raw buf =
+  object
+    inherit text_raw buf
+    method set i u = set_buf contents (4 * i) u
+  end
+
+class text init = text_raw (make_buf init)
+class string init = string_raw (make_buf init)
+
+let of_string s =
+  let buf = String.make (4 * String.length s) '\000' in
+  for i = 0 to String.length s - 1 do
+    buf.[4 * i] <- s.[i]
+  done;
+  new text_raw buf
+
+let make len u =
+  let s = String.create (4 * len) in
+  for i = 0 to len - 1 do set_buf s (4 * i) u done;
+  new string_raw s
+
+let create len = make len (UChar.chr 0)
+
+let copy s = s#copy
+
+let sub s start len = s#sub start len
+
+let fill s start len u =
+  for i = start to start + len - 1 do s#set i u done
+
+let blit src srcoff dst dstoff len =
+  for i = 0 to len - 1 do
+    let u = src#get (srcoff + i) in
+    dst#set (dstoff + i) u
+  done
+
+let concat s1 s2 = s1#concat (s2 (* : #ustorage *) :> uchar storage)
+
+let iter proc s = s#iter proc
+end
+class type foo_t =
+  object
+    method foo: string
+  end
+
+type 'a name =
+    Foo: foo_t name
+  | Int: int name
+;;
+
+class foo =
+  object(self)
+    method foo = "foo"
+    method cast =
+      function
+          Foo -> (self :> <foo : string>)
+  end
+;;
+
+class foo: foo_t =
+  object(self)
+    method foo = "foo"
+    method cast: type a. a name -> a =
+      function
+          Foo -> (self :> foo_t)
+        | _ -> raise Exit
+  end
+;;
+class type c = object end;;
+module type S = sig class c: c end;;
+class virtual name =
+object
+end
+
+and func (args_ty, ret_ty) =
+object(self)
+  inherit name
+
+  val mutable memo_args = None
+
+  method arguments =
+    match memo_args with
+    | Some xs -> xs
+    | None ->
+      let args = List.map (fun ty -> new argument(self, ty)) args_ty in
+        memo_args <- Some args; args
+end
+
+and argument (func, ty) =
+object
+  inherit name
+end
+;;
+let f (x: #M.foo) = 0;;
+class type ['e] t = object('s)
+  method update : 'e -> 's
+end;;
+
+module type S = sig
+  class base : 'e -> ['e] t
+end;;
+type 'par t = 'par
+module M : sig val x : <m : 'a. 'a> end =
+  struct let x : <m : 'a. 'a t> = Obj.magic () end
+
+let ident v = v
+class alias = object method alias : 'a . 'a t -> 'a = ident end
+module Classdef = struct
+  class virtual ['a, 'b, 'c] cl0 =
+    object
+      constraint 'c = < m : 'a -> 'b -> int; .. >
+    end
+
+  class virtual ['a, 'b] cl1 =
+    object
+      method virtual raise_trouble : int -> 'a
+      method virtual m : 'a -> 'b -> int
+    end
+
+  class virtual ['a, 'b] cl2 =
+    object
+      method virtual as_cl0 : ('a, 'b, ('a, 'b) cl1) cl0
+    end
+end
+
+type refer1 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) >
+type refer2 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) >
+
+(* Actually this should succeed ... *)
+let f (x : refer1) = (x : refer2)
+module Classdef = struct
+  class virtual ['a, 'b, 'c] cl0 =
+    object
+      constraint 'c = < m : 'a -> 'b -> int; .. >
+    end
+
+  class virtual ['a, 'b] cl1 =
+    object
+      method virtual raise_trouble : int -> 'a
+      method virtual m : 'a -> 'b -> int
+    end
+
+  class virtual ['a, 'b] cl2 =
+    object
+      method virtual as_cl0 : ('a, 'b, ('a, 'b) cl1) cl0
+    end
+end
+
+module M : sig
+  type refer = { poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) }
+end = struct
+  type refer = { poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) }
+end
+(*
+  ocamlc -c pr3918a.mli pr3918b.mli
+  rm -f pr3918a.cmi
+  ocamlc -c pr3918c.ml
+*)
+
+open Pr3918b
+
+let f x = (x : 'a vlist :> 'b vlist)
+let f (x : 'a vlist) = (x : 'b vlist)
+module type Poly = sig
+  type 'a t = 'a constraint 'a = [> ]
+end
+
+module Combine (A : Poly) (B : Poly) = struct
+  type ('a, 'b) t = 'a A.t constraint 'a = 'b B.t
+end
+
+module C = Combine
+  (struct type 'a t = 'a constraint 'a = [> ] end)
+  (struct type 'a t = 'a constraint 'a = [> ] end)
+module type Priv = sig
+  type t = private int
+end
+
+module Make (Unit:sig end): Priv = struct type t = int end
+
+module A = Make (struct end)
+
+module type Priv' = sig
+  type t = private [> `A]
+end
+
+module Make' (Unit:sig end): Priv' = struct type t = [`A] end
+
+module A' = Make' (struct end)
+(* PR5057 *)
+
+module TT = struct
+  module IntSet = Set.Make(struct type t = int let compare = compare end)
+end
+
+let () =
+  let f flag =
+    let module T = TT in
+    let _ = match flag with `A -> 0 | `B r -> r in
+    let _ = match flag with `A -> T.IntSet.mem | `B r -> r in
+    ()
+  in
+  f `A
+(* This one should fail *)
+
+let f flag =
+  let module T = Set.Make(struct type t = int let compare = compare end) in
+  let _ = match flag with `A -> 0 | `B r -> r in
+  let _ = match flag with `A -> T.mem | `B r -> r in
+  ()
+module type S = sig
+ type +'a t
+
+ val foo : [`A] t -> unit
+ val bar : [< `A | `B] t -> unit
+end
+
+module Make(T : S) = struct
+ let f x =
+   T.foo x;
+   T.bar x;
+   (x :> [`A | `C] T.t)
+end
+type 'a termpc =
+    [`And of 'a * 'a
+    |`Or of 'a * 'a
+    |`Not of 'a
+    |`Atom of string
+    ]
+
+type 'a termk =
+    [`Dia of 'a
+    |`Box of 'a
+    |'a termpc
+    ]
+
+module type T = sig
+  type term
+  val map : (term -> term) -> term -> term
+  val nnf : term -> term
+  val nnf_not : term -> term
+end
+
+module Fpc(X : T with type term = private [> 'a termpc] as 'a) =
+  struct
+    type term = X.term termpc
+    let nnf = function
+      |`Not(`Atom _) as x -> x
+      |`Not x     -> X.nnf_not x
+      | x         -> X.map X.nnf x
+    let map f : term -> X.term = function
+      |`Not x    -> `Not (f x)
+      |`And(x,y) -> `And (f x, f y)
+      |`Or (x,y) -> `Or  (f x, f y)
+      |`Atom _ as x -> x
+    let nnf_not : term -> _ = function
+      |`Not x    -> X.nnf x
+      |`And(x,y) -> `Or  (X.nnf_not x, X.nnf_not y)
+      |`Or (x,y) -> `And (X.nnf_not x, X.nnf_not y)
+      |`Atom _ as x -> `Not x
+  end
+
+module Fk(X : T with type term = private [> 'a termk] as 'a) =
+  struct
+    type term = X.term termk
+    module Pc = Fpc(X)
+    let map f : term -> _ = function
+      |`Dia x -> `Dia (f x)
+      |`Box x -> `Box (f x)
+      |#termpc as x -> Pc.map f x
+    let nnf = Pc.nnf
+    let nnf_not : term -> _ = function
+      |`Dia x -> `Box (X.nnf_not x)
+      |`Box x -> `Dia (X.nnf_not x)
+      |#termpc as x -> Pc.nnf_not x
+  end
+type untyped;;
+type -'a typed = private untyped;;
+type -'typing wrapped = private sexp
+and +'a t = 'a typed wrapped
+and sexp = private untyped wrapped;;
+class type ['a] s3 = object
+  val underlying : 'a t
+end;;
+class ['a] s3object r : ['a] s3 = object
+  val underlying = r
+end;;
+module M (T:sig type t end)
+ = struct type t = private { t : T.t } end
+module P
+ = struct
+       module T = struct type t end
+       module R = M(T)
+ end
+module Foobar : sig
+  type t = private int
+end = struct
+  type t = int
+end;;
+
+module F0 : sig type t = private int end = Foobar;;
+
+let f (x : F0.t) = (x : Foobar.t);; (* fails *)
+
+module F = Foobar;;
+
+let f (x : F.t) = (x : Foobar.t);;
+
+module M = struct type t = <m:int> end;;
+module M1 : sig type t = private <m:int; ..> end = M;;
+module M2 :  sig type t = private <m:int; ..> end = M1;;
+fun (x : M1.t) -> (x : M2.t);; (* fails *)
+
+module M3 : sig type t = private M1.t end = M1;;
+fun x -> (x : M3.t :> M1.t);;
+fun x -> (x : M3.t :> M.t);;
+module M4 : sig type t = private M3.t end = M2;; (* fails *)
+module M4 : sig type t = private M3.t end = M;; (* fails *)
+module M4 : sig type t = private M3.t end = M1;; (* might be ok *)
+module M5 : sig type t = private M1.t end = M3;;
+module M6 : sig type t = private < n:int; .. > end = M1;; (* fails *)
+
+module Bar : sig type t = private Foobar.t val f : int -> t end =
+  struct type t = int let f (x : int) = (x : t) end;; (* must fail *)
+
+module M : sig
+  type t = private T of int
+  val mk : int -> t
+end = struct
+  type t = T of int
+  let mk x = T(x)
+end;;
+
+module M1 : sig
+  type t = M.t
+  val mk : int -> t
+end = struct
+  type t = M.t
+  let mk = M.mk
+end;;
+
+module M2 : sig
+  type t = M.t
+  val mk : int -> t
+end = struct
+  include M
+end;;
+
+module M3 : sig
+  type t = M.t
+  val mk : int -> t
+end = M;;
+
+module M4 : sig
+    type t = M.t = T of int
+    val mk : int -> t
+  end = M;;
+(* Error: The variant or record definition does not match that of type M.t *)
+
+module M5 : sig
+  type t = M.t = private T of int
+  val mk : int -> t
+end = M;;
+
+module M6 : sig
+  type t = private T of int
+  val mk : int -> t
+end = M;;
+
+module M' : sig
+  type t_priv = private T of int
+  type t = t_priv
+  val mk : int -> t
+end = struct
+  type t_priv = T of int
+  type t = t_priv
+  let mk x = T(x)
+end;;
+
+module M3' : sig
+  type t = M'.t
+  val mk : int -> t
+end = M';;
+
+module M : sig type 'a t = private T of 'a end =
+  struct type 'a t = T of 'a end;;
+
+module M1 : sig type 'a t = 'a M.t = private T of 'a end =
+  struct type 'a t = 'a M.t = private T of 'a end;;
+
+(* PR#6090 *)
+module Test = struct type t = private A end
+module Test2 : module type of Test with type t = Test.t = Test;;
+let f (x : Test.t) = (x : Test2.t);;
+let f Test2.A = ();;
+let a = Test2.A;; (* fail *)
+(* The following should fail from a semantical point of view,
+   but allow it for backward compatibility *)
+module Test2 : module type of Test with type t = private Test.t = Test;;
+
+(* PR#6331 *)
+type t = private < x : int; .. > as 'a;;
+type t = private (< x : int; .. > as 'a) as 'a;;
+type t = private < x : int > as 'a;;
+type t = private (< x : int > as 'a) as 'b;;
+type 'a t = private < x : int; .. > as 'a;;
+type 'a t = private 'a constraint 'a = < x : int; .. >;;
+(* Bad (t = t) *)
+module rec A : sig type t = A.t end = struct type t = A.t end;;
+(* Bad (t = t) *)
+module rec A : sig type t = B.t end = struct type t = B.t end
+       and B : sig type t = A.t end = struct type t = A.t end;;
+(* OK (t = int) *)
+module rec A : sig type t = B.t end = struct type t = B.t end
+       and B : sig type t = int end = struct type t = int end;;
+(* Bad (t = int * t) *)
+module rec A : sig type t = int * A.t end = struct type t = int * A.t end;;
+(* Bad (t = t -> int) *)
+module rec A : sig type t = B.t -> int end = struct type t = B.t -> int end
+       and B : sig type t = A.t end = struct type t = A.t end;;
+(* OK (t = <m:t>) *)
+module rec A : sig type t = <m:B.t> end = struct type t = <m:B.t> end
+       and B : sig type t = A.t end = struct type t = A.t end;;
+(* Bad (not regular) *)
+module rec A : sig type 'a t = <m: 'a list A.t> end
+             = struct type 'a t = <m: 'a list A.t> end;;
+(* Bad (not regular) *)
+module rec A : sig type 'a t = <m: 'a list B.t; n: 'a array B.t> end
+             = struct type 'a t = <m: 'a list B.t; n: 'a array B.t> end
+       and B : sig type 'a t = 'a A.t end = struct type 'a t = 'a A.t end;;
+(* Bad (not regular) *)
+module rec A : sig type 'a t = 'a B.t end
+             = struct type 'a t = 'a B.t end
+       and B : sig type 'a t = <m: 'a list A.t; n: 'a array A.t> end
+             = struct type 'a t = <m: 'a list A.t; n: 'a array A.t> end;;
+(* OK *)
+module rec A : sig type 'a t = 'a array B.t * 'a list B.t end
+             = struct type 'a t = 'a array B.t * 'a list B.t end
+       and B : sig type 'a t = <m: 'a B.t> end
+             = struct type 'a t = <m: 'a B.t> end;;
+(* Bad (not regular) *)
+module rec A : sig type 'a t = 'a list B.t end
+             = struct type 'a t = 'a list B.t end
+       and B : sig type 'a t = <m: 'a array B.t> end
+             = struct type 'a t = <m: 'a array B.t> end;;
+(* Bad (not regular) *)
+module rec M :
+    sig
+      class ['a] c : 'a -> object
+        method map : ('a -> 'b) -> 'b M.c
+      end
+    end
+  = struct
+      class ['a] c (x : 'a) = object
+        method map : 'b. ('a -> 'b) -> 'b M.c
+          = fun f -> new M.c (f x)
+      end
+    end;;
+(* OK *)
+class type [ 'node ] extension = object method node : 'node end
+and [ 'ext ] node = object constraint 'ext = 'ext node #extension [@id] end
+class x = object method node : x node = assert false end
+type t = x node;;
+(* Bad - PR 4261 *)
+
+module PR_4261 = struct
+  module type S =
+  sig
+    type t
+  end
+
+  module type T =
+  sig
+    module D : S
+    type t = D.t
+  end
+
+  module rec U : T with module D = U' = U
+  and U' : S with type t = U'.t = U
+end;;
+(* Bad - PR 4512 *)
+module type S' = sig type t = int end
+module rec M : S' with type t = M.t = struct type t = M.t end;;
+(* PR#4450 *)
+
+module PR_4450_1 = struct
+  module type MyT = sig type 'a t = Succ of 'a t end
+  module MyMap(X : MyT) = X
+  module rec MyList : MyT = MyMap(MyList)
+end;;
+
+module PR_4450_2 = struct
+  module type MyT = sig
+    type 'a wrap = My of 'a t
+    and 'a t = private < map : 'b. ('a -> 'b) ->'b wrap; .. >
+    val create : 'a list -> 'a t
+  end
+  module MyMap(X : MyT) = struct
+    include X
+    class ['a] c l = object (self)
+      method map : 'b. ('a -> 'b) -> 'b wrap =
+        fun f -> My (create (List.map f l))
+    end
+  end
+  module rec MyList : sig
+    type 'a wrap = My of 'a t
+    and 'a t = < map : 'b. ('a -> 'b) ->'b wrap >
+    val create : 'a list -> 'a t
+  end = struct
+    include MyMap(MyList)
+    let create l = new c l
+  end
+end;;
+(* A synthetic example of bootstrapped data structure
+   (suggested by J-C Filliatre) *)
+
+module type ORD = sig
+  type t
+  val compare : t -> t -> int
+end
+
+module type SET = sig
+  type elt
+  type t
+  val iter : (elt -> unit) -> t -> unit
+end
+
+type 'a tree = E | N of 'a tree * 'a * 'a tree
+
+module Bootstrap2
+  (MakeDiet : functor (X: ORD) -> SET with type t = X.t tree and type elt = X.t)
+  : SET with type elt = int =
+struct
+
+  type elt = int
+
+  module rec Elt : sig
+    type t = I of int * int | D of int * Diet.t * int
+    val compare : t -> t -> int
+    val iter : (int -> unit) -> t -> unit
+  end =
+  struct
+    type t = I of int * int | D of int * Diet.t * int
+    let compare x1 x2 = 0
+    let rec iter f = function
+      | I (l, r) -> for i = l to r do f i done
+      | D (_, d, _) -> Diet.iter (iter f) d
+  end
+
+  and Diet : SET with type t = Elt.t tree and type elt = Elt.t = MakeDiet(Elt)
+
+  type t = Diet.t
+  let iter f = Diet.iter (Elt.iter f)
+end
+(* PR 4470: simplified from OMake's sources *)
+
+module rec DirElt
+  : sig
+      type t = DirRoot | DirSub of DirHash.t
+    end
+  = struct
+      type t = DirRoot | DirSub of DirHash.t
+    end
+
+and DirCompare
+  : sig
+      type t = DirElt.t
+    end
+  = struct
+      type t = DirElt.t
+    end
+
+and DirHash
+  : sig
+      type t = DirElt.t list
+    end
+  = struct
+      type t = DirCompare.t list
+    end
+(* PR 4758, PR 4266 *)
+
+module PR_4758 = struct
+  module type S = sig end
+  module type Mod = sig
+    module Other : S
+  end
+  module rec A : S = struct end
+  and C : sig include Mod with module Other = A end = struct
+    module Other = A
+  end
+  module C' = C  (* check that we can take an alias *)
+  module F(X:sig end) = struct type t end
+  let f (x : F(C).t) = (x : F(C').t)
+end
+(* PR 4557 *)
+module PR_4557 = struct
+  module F ( X : Set.OrderedType ) = struct
+    module rec Mod : sig
+      module XSet :
+        sig
+          type elt = X.t
+          type t = Set.Make( X ).t
+        end
+      module XMap :
+        sig
+          type key = X.t
+          type 'a t = 'a Map.Make(X).t
+        end
+      type elt = X.t
+      type t = XSet.t XMap.t
+      val compare: t -> t -> int
+    end
+       =
+    struct
+      module XSet = Set.Make( X )
+      module XMap = Map.Make( X )
+
+      type elt = X.t
+      type t = XSet.t XMap.t
+      let compare = (fun x y -> 0)
+    end
+    and ModSet : Set.S with type elt = Mod.t = Set.Make( Mod )
+  end
+end
+module F ( X : Set.OrderedType ) = struct
+  module rec Mod : sig
+    module XSet :
+      sig
+        type elt = X.t
+        type t = Set.Make( X ).t
+      end
+    module XMap :
+      sig
+        type key = X.t
+        type 'a t = 'a Map.Make(X).t
+      end
+    type elt = X.t
+    type t = XSet.t XMap.t
+    val compare: t -> t -> int
+  end
+     =
+  struct
+    module XSet = Set.Make( X )
+    module XMap = Map.Make( X )
+
+    type elt = X.t
+    type t = XSet.t XMap.t
+    let compare = (fun x y -> 0)
+  end
+  and ModSet : Set.S with type elt = Mod.t = Set.Make( Mod )
+end
+(* Tests for recursive modules *)
+
+let test number result expected =
+  if result = expected
+  then Printf.printf "Test %d passed.\n" number
+  else Printf.printf "Test %d FAILED.\n" number;
+  flush stdout
+
+(* Tree of sets *)
+
+module rec A
+ : sig
+     type t = Leaf of int | Node of ASet.t
+     val compare: t -> t -> int
+   end
+ = struct
+     type t = Leaf of int | Node of ASet.t
+     let compare x y =
+       match (x,y) with
+         (Leaf i, Leaf j) -> Stdlib.compare i j
+       | (Leaf i, Node t) -> -1
+       | (Node s, Leaf j) -> 1
+       | (Node s, Node t) -> ASet.compare s t
+   end
+
+and ASet : Set.S with type elt = A.t = Set.Make(A)
+;;
+
+let _ =
+  let x = A.Node (ASet.add (A.Leaf 3) (ASet.singleton (A.Leaf 2))) in
+  let y = A.Node (ASet.add (A.Leaf 1) (ASet.singleton x)) in
+  test 10 (A.compare x x) 0;
+  test 11 (A.compare x (A.Leaf 3)) 1;
+  test 12 (A.compare (A.Leaf 0) x) (-1);
+  test 13 (A.compare y y) 0;
+  test 14 (A.compare x y) 1
+;;
+
+(* Simple value recursion *)
+
+module rec Fib
+  : sig val f : int -> int end
+  = struct let f x = if x < 2 then 1 else Fib.f(x-1) + Fib.f(x-2) end
+;;
+
+let _ =
+  test 20 (Fib.f 10) 89
+;;
+
+(* Update function by infix *)
+
+module rec Fib2
+  : sig val f : int -> int end
+  = struct let rec g x = Fib2.f(x-1) + Fib2.f(x-2)
+               and f x = if x < 2 then 1 else g x
+    end
+;;
+
+let _ =
+  test 21 (Fib2.f 10) 89
+;;
+
+(* Early application *)
+
+let _ =
+  let res =
+    try
+      let module A =
+        struct
+          module rec Bad
+            : sig val f : int -> int end
+            = struct let f = let y = Bad.f 5 in fun x -> x+y end
+          end in
+      false
+    with Undefined_recursive_module _ ->
+      true in
+  test 30 res true
+;;
+
+(* Early strict evaluation *)
+
+(*
+module rec Cyclic
+  : sig val x : int end
+  = struct let x = Cyclic.x + 1 end
+;;
+*)
+
+(* Reordering of evaluation based on dependencies *)
+
+module rec After
+  : sig val x : int end
+  = struct let x = Before.x + 1 end
+and Before
+  : sig val x : int end
+  = struct let x = 3 end
+;;
+
+let _ =
+  test 40 After.x 4
+;;
+
+(* Type identity between A.t and t within A's definition *)
+
+module rec Strengthen
+  : sig type t val f : t -> t end
+  = struct
+      type t = A | B
+      let _ = (A : Strengthen.t)
+      let f x = if true then A else Strengthen.f B
+    end
+;;
+
+module rec Strengthen2
+  : sig type t
+        val f : t -> t
+        module M : sig type u end
+        module R : sig type v end
+    end
+  = struct
+      type t = A | B
+      let _ = (A : Strengthen2.t)
+      let f x = if true then A else Strengthen2.f B
+      module M =
+        struct
+          type u = C
+          let _ = (C: Strengthen2.M.u)
+        end
+      module rec R : sig type v  = Strengthen2.R.v end =
+        struct
+          type v = D
+          let _ = (D : R.v)
+          let _ = (D : Strengthen2.R.v)
+        end
+    end
+;;
+
+(* Polymorphic recursion *)
+
+module rec PolyRec
+  : sig
+      type 'a t = Leaf of 'a | Node of 'a list t * 'a list t
+      val depth: 'a t -> int
+    end
+  = struct
+      type 'a t = Leaf of 'a | Node of 'a list t * 'a list t
+      let x = (PolyRec.Leaf 1 : int t)
+      let depth = function
+        Leaf x -> 0
+      | Node(l,r) -> 1 + max (PolyRec.depth l) (PolyRec.depth r)
+    end
+;;
+
+(* Wrong LHS signatures (PR#4336) *)
+
+(*
+module type ASig = sig type a val a:a val print:a -> unit end
+module type BSig = sig type b val b:b val print:b -> unit end
+
+module A = struct type a = int let a = 0 let print = print_int end
+module B = struct type b = float let b = 0.0 let print = print_float end
+
+module MakeA (Empty:sig end) : ASig = A
+module MakeB (Empty:sig end) : BSig = B
+
+module
+   rec NewA : ASig = MakeA (struct end)
+   and NewB : BSig with type b = NewA.a = MakeB (struct end);;
+
+*)
+
+(* Expressions and bindings *)
+
+module StringSet = Set.Make(String);;
+
+module rec Expr
+  : sig
+      type t =
+        Var of string
+      | Const of int
+      | Add of t * t
+      | Binding of Binding.t * t
+      val make_let: string -> t -> t -> t
+      val fv: t -> StringSet.t
+      val simpl: t -> t
+    end
+  = struct
+      type t =
+        Var of string
+      | Const of int
+      | Add of t * t
+      | Binding of Binding.t * t
+      let make_let id e1 e2 = Binding([id, e1], e2)
+      let rec fv = function
+        Var s -> StringSet.singleton s
+      | Const n -> StringSet.empty
+      | Add(t1,t2) -> StringSet.union (fv t1) (fv t2)
+      | Binding(b,t) ->
+          StringSet.union (Binding.fv b)
+            (StringSet.diff (fv t) (Binding.bv b))
+      let rec simpl = function
+        Var s -> Var s
+      | Const n -> Const n
+      | Add(Const i, Const j) -> Const (i+j)
+      | Add(Const 0, t) -> simpl t
+      | Add(t, Const 0) -> simpl t
+      | Add(t1,t2) -> Add(simpl t1, simpl t2)
+      | Binding(b, t) -> Binding(Binding.simpl b, simpl t)
+    end
+
+and Binding
+  : sig
+      type t = (string * Expr.t) list
+      val fv: t -> StringSet.t
+      val bv: t -> StringSet.t
+      val simpl: t -> t
+    end
+  = struct
+      type t = (string * Expr.t) list
+      let fv b =
+        List.fold_left (fun v (id,e) -> StringSet.union v (Expr.fv e))
+                       StringSet.empty b
+      let bv b =
+        List.fold_left (fun v (id,e) -> StringSet.add id v)
+                       StringSet.empty b
+      let simpl b =
+        List.map (fun (id,e) -> (id, Expr.simpl e)) b
+    end
+;;
+
+let _ =
+  let e = Expr.make_let "x" (Expr.Add (Expr.Var "y", Expr.Const 0))
+                            (Expr.Var "x") in
+  let e' = Expr.make_let "x" (Expr.Var "y") (Expr.Var "x") in
+  test 50 (StringSet.elements (Expr.fv e)) ["y"];
+  test 51 (Expr.simpl e) e'
+;;
+
+(* Okasaki's bootstrapping *)
+
+module type ORDERED =
+  sig
+    type t
+    val eq: t -> t -> bool
+    val lt: t -> t -> bool
+    val leq: t -> t -> bool
+  end
+
+module type HEAP =
+  sig
+    module Elem: ORDERED
+    type heap
+    val empty: heap
+    val isEmpty: heap -> bool
+    val insert: Elem.t -> heap -> heap
+    val merge: heap -> heap -> heap
+    val findMin: heap -> Elem.t
+    val deleteMin: heap -> heap
+  end
+
+module Bootstrap (MakeH: functor (Element:ORDERED) ->
+                                    HEAP with module Elem = Element)
+                 (Element: ORDERED) : HEAP with module Elem = Element =
+  struct
+    module Elem = Element
+    module rec BE
+    : sig type t = E | H of Elem.t * PrimH.heap
+          val eq: t -> t -> bool
+          val lt: t -> t -> bool
+          val leq: t -> t -> bool
+      end
+    = struct
+        type t = E | H of Elem.t * PrimH.heap
+        let leq t1 t2 =
+          match t1, t2 with
+          | (H(x, _)), (H(y, _)) -> Elem.leq x y
+          | H _, E -> false
+          | E, H _ -> true
+          | E, E -> true
+        let eq t1 t2 =
+          match t1, t2 with
+          | (H(x, _)), (H(y, _)) -> Elem.eq x y
+          | H _, E -> false
+          | E, H _ -> false
+          | E, E -> true
+        let lt t1 t2 =
+          match t1, t2 with
+          | (H(x, _)), (H(y, _)) -> Elem.lt x y
+          | H _, E -> false
+          | E, H _ -> true
+          | E, E -> false
+      end
+    and PrimH
+    : HEAP with type Elem.t = BE.t
+    = MakeH(BE)
+    type heap = BE.t
+    let empty = BE.E
+    let isEmpty = function BE.E -> true | _ -> false
+    let rec merge x y =
+      match (x,y) with
+        (BE.E, _) -> y
+      | (_, BE.E) -> x
+      | (BE.H(e1,p1) as h1), (BE.H(e2,p2) as h2) ->
+          if Elem.leq e1 e2
+          then BE.H(e1, PrimH.insert h2 p1)
+          else BE.H(e2, PrimH.insert h1 p2)
+    let insert x h =
+      merge (BE.H(x, PrimH.empty)) h
+    let findMin = function
+        BE.E -> raise Not_found
+      | BE.H(x, _) -> x
+    let deleteMin = function
+        BE.E -> raise Not_found
+      | BE.H(x, p) ->
+          if PrimH.isEmpty p then BE.E else begin
+            match PrimH.findMin p with
+            | (BE.H(y, p1)) ->
+              let p2 = PrimH.deleteMin p in
+              BE.H(y, PrimH.merge p1 p2)
+            | BE.E -> assert false
+          end
+  end
+;;
+
+module LeftistHeap(Element: ORDERED): HEAP with module Elem = Element =
+  struct
+    module Elem = Element
+    type heap = E | T of int * Elem.t * heap * heap
+    let rank = function E -> 0 | T(r,_,_,_) -> r
+    let make x a b =
+      if rank a >= rank b
+      then T(rank b + 1, x, a, b)
+      else T(rank a + 1, x, b, a)
+    let empty = E
+    let isEmpty = function E -> true | _ -> false
+    let rec merge h1 h2 =
+      match (h1, h2) with
+        (_, E) -> h1
+      | (E, _) -> h2
+      | (T(_, x1, a1, b1), T(_, x2, a2, b2)) ->
+          if Elem.leq x1 x2
+          then make x1 a1 (merge b1 h2)
+          else make x2 a2 (merge h1 b2)
+    let insert x h = merge (T(1, x, E, E)) h
+    let findMin = function
+      E -> raise Not_found
+    | T(_, x, _, _) -> x
+    let deleteMin = function
+      E -> raise Not_found
+    | T(_, x, a, b) -> merge a b
+  end
+;;
+
+module Ints =
+  struct
+    type t = int
+    let eq = (=)
+    let lt = (<)
+    let leq = (<=)
+  end
+;;
+
+module C = Bootstrap(LeftistHeap)(Ints);;
+
+let _ =
+  let h = List.fold_right C.insert [6;4;8;7;3;1] C.empty in
+  test 60 (C.findMin h) 1;
+  test 61 (C.findMin (C.deleteMin h)) 3;
+  test 62 (C.findMin (C.deleteMin (C.deleteMin h))) 4
+;;
+
+(* Classes *)
+
+module rec Class1
+  : sig
+      class c : object method m : int -> int end
+    end
+  = struct
+      class c =
+        object
+          method m x = if x <= 0 then x else (new Class2.d)#m x
+        end
+    end
+and Class2
+  : sig
+      class d : object method m : int -> int end
+    end
+  = struct
+      class d =
+        object(self)
+          inherit Class1.c as super
+          method m (x:int) = super#m 0
+        end
+    end
+;;
+
+let _ =
+  test 70 ((new Class1.c)#m 7) 0
+;;
+
+let _ =
+  try
+    let module A = struct
+       module rec BadClass1
+         : sig
+             class c : object method m : int end
+           end
+         = struct
+             class c = object method m = 123 end
+           end
+       and BadClass2
+         : sig
+             val x: int
+           end
+         = struct
+             let x = (new BadClass1.c)#m
+           end
+    end in
+      test 71 true false
+  with Undefined_recursive_module _ ->
+    test 71 true true
+;;
+
+(* Coercions *)
+
+module rec Coerce1
+  : sig
+      val g: int -> int
+      val f: int -> int
+    end
+  = struct
+      module A = (Coerce1: sig val f: int -> int end)
+      let g x = x
+      let f x = if x <= 0 then 1 else A.f (x-1) * x
+    end
+;;
+
+let _ =
+  test 80 (Coerce1.f 10) 3628800
+;;
+
+module CoerceF(S: sig end) = struct
+  let f1 () = 1
+  let f2 () = 2
+  let f3 () = 3
+  let f4 () = 4
+  let f5 () = 5
+end
+
+module rec Coerce2: sig val f1: unit -> int end = CoerceF(Coerce3)
+       and Coerce3: sig end = struct end
+;;
+
+let _ =
+  test 81 (Coerce2.f1 ()) 1
+;;
+
+module Coerce4(A : sig val f : int -> int end) = struct
+  let x = 0
+  let at a = A.f a
+end
+
+module rec Coerce5
+  : sig val blabla: int -> int val f: int -> int end
+  = struct let blabla x = 0 let f x = 5 end
+and Coerce6
+  : sig val at: int -> int end
+  = Coerce4(Coerce5)
+
+let _ =
+  test 82 (Coerce6.at 100) 5
+;;
+
+(* Miscellaneous bug reports *)
+
+module rec F
+  : sig type t = X of int | Y of int
+        val f: t -> bool
+    end
+  = struct
+      type t = X of int | Y of int
+      let f = function
+        | X _ -> false
+        | _ -> true
+    end;;
+
+let _ =
+  test 100 (F.f (F.X 1)) false;
+  test 101 (F.f (F.Y 2)) true
+
+(* PR#4316 *)
+module G(S : sig val x : int Lazy.t end) = struct include S end
+
+module M1 = struct let x = lazy 3 end
+
+let _ = Lazy.force M1.x
+
+module rec M2 : sig val x : int Lazy.t end = G(M1)
+
+let _ =
+  test 102 (Lazy.force M2.x) 3
+
+let _ = Gc.full_major()   (* will shortcut forwarding in M1.x *)
+
+module rec M3 : sig val x : int Lazy.t end = G(M1)
+
+let _ =
+  test 103 (Lazy.force M3.x) 3
+
+
+(** Pure type-checking tests: see recmod/*.ml  *)
+type t = A of {x:int; mutable y:int};;
+let f (A r) = r;;  (* -> escape *)
+let f (A r) = r.x;; (* ok *)
+let f x = A {x; y = x};; (* ok *)
+let f (A r) = A {r with y = r.x + 1};; (* ok *)
+let f () = A {a = 1};; (* customized error message *)
+let f () = A {x = 1; y = 3};; (* ok *)
+
+type _ t = A: {x : 'a; y : 'b} -> 'a t;;
+let f (A {x; y}) = A {x; y = ()};;  (* ok *)
+let f (A ({x; y} as r)) = A {x = r.x; y = r.y};; (* ok *)
+
+module M = struct
+  type 'a t =
+    | A of {x : 'a}
+    | B: {u : 'b} -> unit t;;
+
+  exception Foo of {x : int};;
+end;;
+
+module N : sig
+  type 'b t = 'b M.t =
+    | A of {x : 'b}
+    | B: {u : 'bla} -> unit t
+
+  exception Foo of {x : int}
+end = struct
+  type 'b t = 'b M.t =
+    | A of {x : 'b}
+    | B: {u : 'z} -> unit t
+
+  exception Foo = M.Foo
+end;;
+
+
+module type S = sig exception A of {x:int}  end;;
+
+module F (X : sig val x : (module S) end) = struct
+  module A = (val X.x)
+end;;  (* -> this expression creates fresh types (not really!) *)
+
+
+module type S = sig
+  exception A of {x : int}
+  exception A of {x : string}
+end;;
+
+module M = struct
+  exception A of {x : int}
+  exception A of {x : string}
+end;;
+
+
+module M1 = struct
+  exception A of {x : int}
+end;;
+
+module M = struct
+  include M1
+  include M1
+end;;
+
+
+module type S1 = sig
+  exception A of {x : int}
+end;;
+
+module type S = sig
+  include S1
+  include S1
+end;;
+
+module M = struct
+  exception A = M1.A
+end;;
+
+module X1 = struct
+  type t = ..
+end;;
+module X2 = struct
+  type t = ..
+end;;
+module Z = struct
+  type X1.t += A of {x: int}
+  type X2.t += A of {x: int}
+end;;
+
+(* PR#6716 *)
+
+type _ c = C : [`A] c
+type t = T : {x:[<`A] c} -> t;;
+let f (T { x = C }) = ();;
+module M : sig
+  type 'a t
+  type u = u t and v = v t
+  val f : int -> u
+  val g : v -> bool
+end = struct
+  type 'a t = 'a
+  type u = int and v = bool
+  let f x = x
+  let g x = x
+end;;
+
+let h (x : int) : bool = M.g (M.f x);;
+type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t
+let f : type a o. ((a -> o) -> o) t -> (a -> o) -> o =
+ fun C k -> k (fun x -> x);;
+module type T = sig type 'a t end
+module Fix (T : T) = struct type r = ('r T.t as 'r) end
+ type _ t =
+     X of string
+   | Y : bytes t
+
+let y : string t = Y
+let f : string A.t -> unit = function
+    A.X s -> print_endline s
+
+let () = f A.y
+module rec A : sig
+ type t
+end = struct
+ type t = { a : unit; b : unit }
+ let _ = { a = () }
+end
+;;
+type t = [`A | `B];;
+type 'a u = t;;
+let a : [< int u] = `A;;
+
+type 'a s = 'a;;
+let b : [< t s] = `B;;
+module Core = struct
+  module Int = struct
+    module T = struct
+      type t = int
+      let compare = compare
+      let (+) x y = x + y
+    end
+    include T
+    module Map = Map.Make(T)
+  end
+
+  module Std = struct
+    module Int = Int
+  end
+end
+;;
+
+open Core.Std
+;;
+
+let x = Int.Map.empty ;;
+let y = x + x ;;
+
+(* Avoid ambiguity *)
+
+module M = struct type t = A type u = C end
+module N = struct type t = B end
+open M open N;;
+A;;
+B;;
+C;;
+
+include M open M;;
+C;;
+
+module L = struct type v = V end
+open L;;
+V;;
+module L = struct type v = V end
+open L;;
+V;;
+
+
+type t1 = A;;
+module M1 = struct type u = v and v = t1 end;;
+module N1 = struct type u = v and v = M1.v end;;
+type t1 = B;;
+module N2 = struct type u = v and v = M1.v end;;
+
+
+(* PR#6566 *)
+module type PR6566 = sig type t = string end;;
+module PR6566 = struct type t = int end;;
+module PR6566' : PR6566 = PR6566;;
+
+module A = struct module B = struct type t = T end end;;
+module M2 = struct type u = A.B.t type foo = int type v = A.B.t end;;
+(* Adapted from: An Expressive Language of Signatures
+   by Norman Ramsey, Kathleen Fisher and Paul Govereau *)
+
+module type VALUE = sig
+  type value (* a Lua value *)
+  type state (* the state of a Lua interpreter *)
+  type usert (* a user-defined value *)
+end;;
+
+module type CORE0 = sig
+  module V : VALUE
+  val setglobal : V.state -> string -> V.value -> unit
+  (* five more functions common to core and evaluator *)
+end;;
+
+module type CORE = sig
+  include CORE0
+  val apply : V.value -> V.state -> V.value list -> V.value
+  (* apply function f in state s to list of args *)
+end;;
+
+module type AST = sig
+  module Value : VALUE
+  type chunk
+  type program
+  val get_value : chunk -> Value.value
+end;;
+
+module type EVALUATOR = sig
+  module Value : VALUE
+  module Ast : (AST with module Value := Value)
+  type state = Value.state
+  type value = Value.value
+  exception Error of string
+  val compile : Ast.program -> string
+  include CORE0 with module V := Value
+end;;
+
+module type PARSER = sig
+  type chunk
+  val parse : string -> chunk
+end;;
+
+module type INTERP = sig
+  include EVALUATOR
+  module Parser : PARSER with type chunk = Ast.chunk
+  val dostring : state -> string -> value list
+  val mk : unit -> state
+end;;
+
+module type USERTYPE = sig
+  type t
+  val eq : t -> t -> bool
+  val to_string : t -> string
+end;;
+
+module type TYPEVIEW = sig
+  type combined
+  type t
+  val map : (combined -> t) * (t -> combined)
+end;;
+
+module type COMBINED_COMMON = sig
+  module T : sig type t end
+  module TV1 : TYPEVIEW with type combined := T.t
+  module TV2 : TYPEVIEW with type combined := T.t
+end;;
+
+module type COMBINED_TYPE = sig
+  module T : USERTYPE
+  include COMBINED_COMMON with module T := T
+end;;
+
+module type BARECODE = sig
+  type state
+  val init : state -> unit
+end;;
+
+module USERCODE(X : TYPEVIEW) = struct
+  module type F =
+      functor (C : CORE with type V.usert = X.combined) ->
+        BARECODE with type state := C.V.state
+end;;
+
+module Weapon = struct type t end;;
+
+module type WEAPON_LIB = sig
+  type t = Weapon.t
+  module T : USERTYPE with type t = t
+  module Make :
+    functor (TV : TYPEVIEW with type t = t) -> USERCODE(TV).F
+end;;
+
+module type X = functor (X: CORE) -> BARECODE;;
+module type X = functor (_: CORE) -> BARECODE;;
+module M = struct
+  type t = int * (< m : 'a > as 'a)
+end;;
+
+module type S =
+    sig module M : sig type t end end with module M = M
+;;
+module type Printable = sig
+  type t
+  val print : Format.formatter -> t -> unit
+end;;
+module type Comparable = sig
+  type t
+  val compare : t -> t -> int
+end;;
+module type PrintableComparable = sig
+  include Printable
+  include Comparable with type t = t
+end;; (* Fails *)
+module type PrintableComparable = sig
+  type t
+  include Printable with type t := t
+  include Comparable with type t := t
+end;;
+module type PrintableComparable = sig
+  include Printable
+  include Comparable with type t := t
+end;;
+module type ComparableInt = Comparable with type t := int;;
+module type S = sig type t val f : t -> t end;;
+module type S' = S with type t := int;;
+
+module type S = sig type 'a t val map : ('a -> 'b) -> 'a t -> 'b t end;;
+module type S1 = S with type 'a t := 'a list;;
+module type S2 = sig
+  type 'a dict = (string * 'a) list
+  include S with type 'a t := 'a dict
+end;;
+
+
+module type S =
+  sig module T : sig type exp type arg end val f : T.exp -> T.arg end;;
+module M = struct type exp = string type arg = int end;;
+module type S' = S with module T := M;;
+
+
+module type S = sig type 'a t end with type 'a t := unit;; (* Fails *)
+let property (type t) () =
+  let module M = struct exception E of t end in
+  (fun x -> M.E x), (function M.E x -> Some x | _ -> None)
+;;
+
+let () =
+  let (int_inj, int_proj) = property () in
+  let (string_inj, string_proj) = property () in
+
+  let i = int_inj 3 in
+  let s = string_inj "abc" in
+
+  Printf.printf "%B\n%!" (int_proj i = None);
+  Printf.printf "%B\n%!" (int_proj s = None);
+  Printf.printf "%B\n%!" (string_proj i = None);
+  Printf.printf "%B\n%!" (string_proj s = None)
+;;
+
+let sort_uniq (type s) cmp l =
+  let module S = Set.Make(struct type t = s let compare = cmp end) in
+  S.elements (List.fold_right S.add l S.empty)
+;;
+
+let () =
+  print_endline (String.concat "," (sort_uniq compare [ "abc"; "xyz"; "abc" ]))
+;;
+
+let f x (type a) (y : a) = (x = y);; (* Fails *)
+class ['a] c = object (self)
+  method m : 'a -> 'a = fun x -> x
+  method n : 'a -> 'a = fun (type g) (x:g) -> self#m x
+end;; (* Fails *)
+
+external a : (int [@untagged]) -> unit = "a" "a_nat"
+external b : (int32 [@unboxed]) -> unit = "b" "b_nat"
+external c : (int64 [@unboxed]) -> unit = "c" "c_nat"
+external d : (nativeint [@unboxed]) -> unit = "d" "d_nat"
+external e : (float [@unboxed]) -> unit = "e" "e_nat"
+
+type t = private int
+
+external f : (t [@untagged]) -> unit = "f" "f_nat"
+
+module M : sig
+  external a : int -> (int [@untagged]) = "a" "a_nat"
+  external b : (int [@untagged]) -> int = "b" "b_nat"
+end = struct
+  external a : int -> (int [@untagged]) = "a" "a_nat"
+  external b : (int [@untagged]) -> int = "b" "b_nat"
+end;;
+
+module Global_attributes = struct
+  [@@@ocaml.warning "-3"]
+
+  external a : float -> float = "a" "noalloc" "a_nat" "float"
+  external b : float -> float = "b" "noalloc" "b_nat"
+  external c : float -> float = "c" "c_nat" "float"
+  external d : float -> float = "d" "noalloc"
+  external e : float -> float = "e"
+
+  (* Should output a warning: no native implementation provided *)
+  external f : (int32 [@unboxed]) -> (int32 [@unboxed]) = "f" "noalloc"
+  external g : int32 -> int32 = "g" "g_nat" [@@unboxed] [@@noalloc]
+
+  external h : (int [@untagged]) -> (int [@untagged]) = "h" "h_nat" "noalloc"
+  external i : int -> int = "i" "i_nat" [@@untagged] [@@noalloc]
+end;;
+
+module Old_style_warning = struct
+  [@@@ocaml.warning "+3"]
+  external a : float -> float = "a" "noalloc" "a_nat" "float"
+  external b : float -> float = "b" "noalloc" "b_nat"
+  external c : float -> float = "c" "c_nat" "float"
+  external d : float -> float = "d" "noalloc"
+  external e : float -> float = "c" "float"
+end
+
+(* Bad: attributes not reported in the interface *)
+
+module Bad1 : sig
+  external f : int -> int = "f" "f_nat"
+end = struct
+  external f : int -> (int [@untagged]) = "f" "f_nat"
+end;;
+
+module Bad2 : sig
+  external f : int -> int = "a" "a_nat"
+end = struct
+  external f : (int [@untagged]) -> int = "f" "f_nat"
+end;;
+
+module Bad3 : sig
+  external f : float -> float = "f" "f_nat"
+end = struct
+  external f : float -> (float [@unboxed]) = "f" "f_nat"
+end;;
+
+module Bad4 : sig
+  external f : float -> float = "a" "a_nat"
+end = struct
+  external f : (float [@unboxed]) -> float = "f" "f_nat"
+end;;
+
+(* Bad: attributes in the interface but not in the implementation *)
+
+module Bad5 : sig
+  external f : int -> (int [@untagged]) = "f" "f_nat"
+end = struct
+  external f : int -> int = "f" "f_nat"
+end;;
+
+module Bad6 : sig
+  external f : (int [@untagged]) -> int = "f" "f_nat"
+end = struct
+  external f : int -> int = "a" "a_nat"
+end;;
+
+module Bad7 : sig
+  external f : float -> (float [@unboxed]) = "f" "f_nat"
+end = struct
+  external f : float -> float = "f" "f_nat"
+end;;
+
+module Bad8 : sig
+  external f : (float [@unboxed]) -> float = "f" "f_nat"
+end = struct
+  external f : float -> float = "a" "a_nat"
+end;;
+
+(* Bad: unboxed or untagged with the wrong type *)
+
+external g : (float [@untagged]) -> float = "g" "g_nat";;
+external h : (int [@unboxed]) -> float = "h" "h_nat";;
+
+(* Bad: unboxing the function type *)
+external i : int -> float [@unboxed] = "i" "i_nat";;
+
+(* Bad: unboxing a "deep" sub-type. *)
+external j : int -> (float [@unboxed]) * float = "j" "j_nat";;
+
+(* This should be rejected, but it is quite complicated to do
+   in the current state of things *)
+
+external k : int -> (float [@unboxd]) = "k" "k_nat";;
+
+(* Bad: old style annotations + new style attributes *)
+
+external l : float -> float = "l" "l_nat" "float" [@@unboxed];;
+external m : (float [@unboxed]) -> float = "m" "m_nat" "float";;
+external n : float -> float = "n" "noalloc" [@@noalloc];;
+
+(* Warnings: unboxed / untagged without any native implementation *)
+external o : (float[@unboxed]) -> float = "o";;
+external p : float -> (float[@unboxed]) = "p";;
+external q : (int[@untagged]) -> float = "q";;
+external r : int -> (int[@untagged]) = "r";;
+external s : int -> int = "s" [@@untagged];;
+external t : float -> float = "t" [@@unboxed];;
+let _ = ignore (+);;
+let _ = raise Exit 3;;
+(* comment 9644 of PR#6000 *)
+
+fun b -> if b then format_of_string "x" else "y";;
+fun b -> if b then "x" else format_of_string "y";;
+fun b : (_,_,_) format -> if b then "x" else "y";;
+
+(* PR#7135 *)
+
+module PR7135 = struct
+  module M : sig type t = private int end =  struct type t = int end
+  include M
+
+  let lift2 (f : int -> int -> int) (x : t) (y : t) =
+    f (x :> int) (y :> int)
+end;;
+
+(* example of non-ground coercion *)
+
+module Test1 = struct
+  type t = private int
+  let f x = let y = if true then x else (x:t) in (y :> int)
+end;;
+(* Warn about all relevant cases when possible *)
+let f = function
+    None, None -> 1
+  | Some _, Some _ -> 2;;
+
+(* Exhaustiveness check is very slow *)
+type _ t =
+  A : int t | B : bool t | C : char t | D : float t
+type (_,_,_,_) u = U : (int, int, int, int) u
+type v = E | F | G
+;;
+
+let f : type a b c d e f g.
+      a t * b t * c t * d t * e t * f t * g t * v
+       * (a,b,c,d) u * (e,f,g,g) u -> int =
+ function A, A, A, A, A, A, A, _, U, U -> 1
+   | _, _, _, _, _, _, _, G, _, _ -> 1
+   (*| _ -> _ *)
+;;
+
+(* Unused cases *)
+let f (x : int t) = match x with A -> 1 | _ -> 2;; (* warn *)
+let f (x : unit t option) = match x with None -> 1 | _ -> 2 ;; (* warn? *)
+let f (x : unit t option) = match x with None -> 1 | Some _ -> 2 ;; (* warn *)
+let f (x : int t option) = match x with None -> 1 | _ -> 2;;
+let f (x : int t option) = match x with None -> 1;; (* warn *)
+
+(* Example with record, type, single case *)
+
+type 'a box = Box of 'a
+type 'a pair = {left: 'a; right: 'a};;
+
+let f : (int t box pair * bool) option -> unit = function None -> ();;
+let f : (string t box pair * bool) option -> unit = function None -> ();;
+
+
+(* Examples from ML2015 paper *)
+
+type _ t =
+  | Int : int t
+  | Bool : bool t
+;;
+
+let f : type a. a t -> a = function
+  | Int -> 1
+  | Bool -> true
+;;
+let g : int t -> int = function
+  | Int -> 1
+;;
+let h : type a. a t -> a t -> bool =
+  fun x y -> match x, y with
+  | Int, Int -> true
+  | Bool, Bool -> true
+;;
+type (_, _) cmp =
+ | Eq : ('a, 'a) cmp
+ | Any: ('a, 'b) cmp
+module A : sig type a type b val eq : (a, b) cmp end
+  = struct type a type b = a let eq = Eq end
+;;
+let f : (A.a, A.b) cmp -> unit = function Any -> ()
+;;
+let deep : char t option -> char =
+  function None -> 'c'
+;;
+type zero = Zero
+type _ succ = Succ
+;;
+type (_,_,_) plus =
+  | Plus0 : (zero, 'a, 'a) plus
+  | PlusS : ('a, 'b, 'c) plus ->
+       ('a succ, 'b, 'c succ) plus
+;;
+let trivial : (zero succ, zero, zero) plus option -> bool =
+  function None -> false
+;;
+let easy : (zero, zero succ, zero) plus option -> bool =
+  function None -> false
+;;
+let harder : (zero succ, zero succ, zero succ) plus option -> bool =
+  function None -> false
+;;
+let harder : (zero succ, zero succ, zero succ) plus option  -> bool =
+  function None -> false | Some (PlusS _) -> .
+;;
+let inv_zero : type a b c d. (a,b,c) plus -> (c,d,zero) plus -> bool =
+  fun p1 p2 ->
+    match p1, p2 with
+    | Plus0, Plus0 -> true
+;;
+
+
+(* Empty match *)
+
+type _ t = Int : int t;;
+let f (x : bool t) = match x with _ -> . ;; (* ok *)
+
+
+(* trefis in PR#6437 *)
+
+let f () = match None with _ -> .;; (* error *)
+let g () = match None with _ -> () | exception _ -> .;; (* error *)
+let h () = match None with _ -> .  | exception _ -> .;; (* error *)
+let f x = match x with _ -> () | None -> .;; (* do not warn *)
+
+(* #7059, all clauses guarded *)
+
+let f x y = match 1 with 1 when x = y -> 1;;
+open CamlinternalOO;;
+type _ choice = Left : label choice | Right : tag choice;;
+let f : label choice -> bool = function Left -> true;; (* warn *)
+exception A;;
+type a = A;;
+
+A;;
+raise A;;
+fun (A : a) -> ();;
+function Not_found -> 1 | A -> 2 | _ -> 3;;
+try raise A with A -> 2;;
+module TypEq = struct
+ type (_, _) t = Eq : ('a, 'a) t
+end
+
+module type T = sig
+ type _ is_t = Is : ('a, 'b) TypEq.t -> 'a is_t
+ val is_t : unit -> unit is_t option
+end
+
+module Make (M : T) =
+ struct
+   let _ =
+     match M.is_t () with
+     | None -> 0
+     | Some _ -> 0
+   let f () =
+     match M.is_t () with None -> 0
+end;;
+
+module Make2 (M : T) = struct
+  type t = T of unit M.is_t
+  let g : t -> int = function _ -> .
+end;;
+type t = A : t;;
+
+module X1 : sig end = struct
+  let _f ~x (* x unused argument *) = function
+    | A -> let x = () in x
+end;;
+
+module X2 : sig end = struct
+  let x = 42 (* unused value *)
+  let _f = function
+    | A -> let x = () in x
+end;;
+
+module X3 : sig end = struct
+  module O = struct let x = 42 (* unused *) end
+  open O (* unused open *)
+
+  let _f = function
+    | A -> let x = () in x
+end;;
+(* Use type information *)
+module M1 = struct
+  type t = {x: int; y: int}
+  type u = {x: bool; y: bool}
+end;;
+
+module OK = struct
+  open M1
+  let f1 (r:t) = r.x (* ok *)
+  let f2 r = ignore (r:t); r.x (* non principal *)
+
+  let f3 (r: t) =
+    match r with {x; y} -> y + y (* ok *)
+end;;
+
+module F1 = struct
+  open M1
+  let f r = match r with {x; y} -> y + y
+end;; (* fails *)
+
+module F2 = struct
+  open M1
+  let f r =
+    ignore (r: t);
+    match r with
+       {x; y} -> y + y
+end;; (* fails for -principal *)
+
+(* Use type information with modules*)
+module M = struct
+  type t = {x:int}
+  type u = {x:bool}
+end;;
+let f (r:M.t) = r.M.x;; (* ok *)
+let f (r:M.t) = r.x;; (* warning *)
+let f ({x}:M.t) = x;; (* warning *)
+
+module M = struct
+  type t = {x: int; y: int}
+end;;
+module N = struct
+  type u = {x: bool; y: bool}
+end;;
+module OK = struct
+  open M
+  open N
+  let f (r:M.t) = r.x
+end;;
+
+module M = struct
+  type t = {x:int}
+  module N = struct type s = t = {x:int} end
+  type u = {x:bool}
+end;;
+module OK = struct
+  open M.N
+  let f (r:M.t) = r.x
+end;;
+
+(* Use field information *)
+module M = struct
+  type u = {x:bool;y:int;z:char}
+  type t = {x:int;y:bool}
+end;;
+module OK = struct
+  open M
+  let f {x;z} = x,z
+end;; (* ok *)
+module F3 = struct
+  open M
+  let r = {x=true;z='z'}
+end;; (* fail for missing label *)
+
+module OK = struct
+  type u = {x:int;y:bool}
+  type t = {x:bool;y:int;z:char}
+  let r = {x=3; y=true}
+end;; (* ok *)
+
+(* Corner cases *)
+
+module F4 = struct
+  type foo = {x:int; y:int}
+  type bar = {x:int}
+  let b : bar = {x=3; y=4}
+end;; (* fail but don't warn *)
+
+module M = struct type foo = {x:int;y:int} end;;
+module N = struct type bar = {x:int;y:int} end;;
+let r = { M.x = 3; N.y = 4; };; (* error: different definitions *)
+
+module MN = struct include M include N end
+module NM = struct include N include M end;;
+let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
+
+(* Lpw25 *)
+
+module M = struct
+  type foo = { x: int; y: int }
+  type bar = { x:int; y: int; z: int}
+end;;
+module F5 = struct
+  open M
+  let f r = ignore (r: foo); {r with x = 2; z = 3}
+end;;
+module M = struct
+  include M
+  type other = { a: int; b: int }
+end;;
+module F6 = struct
+  open M
+  let f r = ignore (r: foo); { r with x = 3; a = 4 }
+end;;
+module F7 = struct
+  open M
+  let r = {x=1; y=2}
+  let r: other = {x=1; y=2}
+end;;
+
+module A = struct type t = {x: int} end
+module B = struct type t = {x: int} end;;
+let f (r : B.t) = r.A.x;; (* fail *)
+
+(* Spellchecking *)
+
+module F8 = struct
+  type t = {x:int; yyy:int}
+  let a : t = {x=1;yyz=2}
+end;;
+
+(* PR#6004 *)
+
+type t = A
+type s = A
+
+class f (_ : t) = object end;;
+class g = f A;; (* ok *)
+
+class f (_ : 'a) (_ : 'a) = object end;;
+class g = f (A : t) A;; (* warn with -principal *)
+
+
+(* PR#5980 *)
+
+module Shadow1 = struct
+  type t = {x: int}
+  module M = struct
+    type s = {x: string}
+  end
+  open M  (* this open is unused, it isn't reported as shadowing 'x' *)
+  let y : t = {x = 0}
+end;;
+module Shadow2 = struct
+  type t = {x: int}
+  module M = struct
+    type s = {x: string}
+  end
+  open M  (* this open shadows label 'x' *)
+  let y = {x = ""}
+end;;
+
+(* PR#6235 *)
+
+module P6235 = struct
+  type t = { loc : string; }
+  type v = { loc : string; x : int; }
+  type u = [ `Key of t ]
+  let f (u : u) = match u with `Key {loc} -> loc
+end;;
+
+(* Remove interaction between branches *)
+
+module P6235' = struct
+  type t = { loc : string; }
+  type v = { loc : string; x : int; }
+  type u = [ `Key of t ]
+  let f = function
+    | (_ : u) when false -> ""
+    |`Key {loc} -> loc
+end;;
+module Unused : sig
+end = struct
+  type unused = int
+end
+;;
+
+module Unused_nonrec : sig
+end = struct
+  type nonrec used = int
+  type nonrec unused = used
+end
+;;
+
+module Unused_rec : sig
+end = struct
+  type unused = A of unused
+end
+;;
+
+module Unused_exception : sig
+end = struct
+  exception Nobody_uses_me
+end
+;;
+
+module Unused_extension_constructor : sig
+  type t = ..
+end = struct
+  type t = ..
+  type t += Nobody_uses_me
+end
+;;
+
+module Unused_exception_outside_patterns : sig
+  val falsity : exn -> bool
+end = struct
+  exception Nobody_constructs_me
+  let falsity = function
+    | Nobody_constructs_me -> true
+    | _ -> false
+end
+;;
+
+module Unused_extension_outside_patterns : sig
+  type t = ..
+  val falsity : t -> bool
+end = struct
+  type t = ..
+  type t += Nobody_constructs_me
+  let falsity = function
+    | Nobody_constructs_me -> true
+    | _ -> false
+end
+;;
+
+module Unused_private_exception : sig
+  type exn += private Private_exn
+end = struct
+  exception Private_exn
+end
+;;
+
+module Unused_private_extension : sig
+  type t = ..
+  type t += private Private_ext
+end = struct
+  type t = ..
+  type t += Private_ext
+end
+;;
+
+for i = 10 downto 0 do () done
+
+type t = < foo: int [@foo] >
+
+let _ = [%foo: < foo : t > ]
+
+type foo += private A of int
+
+let f : 'a 'b 'c. < .. > = assert false
+
+let () =
+  let module M = (functor (T : sig end) -> struct end)(struct end) in ()
+
+class c = object inherit ((fun () -> object end [@wee]: object end) ()) end
+
+
+let f = function x[@wee] -> ()
+let f = function
+  | '1'..'9' | '1' .. '8'-> ()
+  | 'a'..'z' -> ()
+
+let f = function
+  | [| x1; x2 |] -> ()
+  | [| |] -> ()
+  | [|x|][@foo] -> ()
+  | _ -> ()
+
+let g = function
+  | {l=x} -> ()
+  | {l1=x; l2=y}[@foo] -> ()
+  | {l1=x; l2=y; _} -> ()
+
+let h = fun ?l:(p=1) ?y:u ?x:(x=3) -> 2
+
+let _ = function
+  | a, s, ba1, ba2, ba3, bg -> begin
+      ignore (Array.get x 1 + Array.get [| |] 0 +
+              Array.get [| 1 |] 1 + Array.get [|1; 2|] 2);
+      ignore ([String.get s 1; String.get "" 2; String.get "123" 3]);
+      ignore (ba1.{0} + ba2.{1, 2} + ba3.{3, 4, 5})
+      ignore (bg.{1, 2, 3, 4})
+    end
+  | b, s, ba1, ba2, ba3, bg -> begin
+      y.(0) <- 1; s.[1] <- 'c';
+      ba1.{1} <- 2; ba2.{1, 2} <- 3; ba3.{1, 2, 3} <- 4;
+      bg.{1, 2, 3, 4, 5} <- 0
+    end
+
+let f (type t) () =
+  let exception F of t in ();
+  let exception G of t in ();
+  let exception E of t in
+  (fun x -> E x), (function E _ -> print_endline "OK" | _ -> print_endline "KO")
+
+let inj1, proj1 = f ()
+let inj2, proj2 = f ()
+
+let () = proj1 (inj1 42)
+let () = proj1 (inj2 42)
+
+let _ = ~-1
+
+class id = [%exp]
+(* checkpoint *)
+
+(* Subtyping is "syntactic" *)
+let _ = fun (x : < x : int >) y z -> (y :> 'a), (x :> 'a), (z :> 'a);;
+(* - : (< x : int > as 'a) -> 'a -> 'a * 'a = <fun> *)
+
+class ['a] c () = object
+  method f = (new c (): int c)
+end and ['a] d () = object
+  inherit ['a] c ()
+end;;
+
+(* PR#7329 Pattern open *)
+let _ =
+  let module M = struct type t = { x : int } end in
+  let f M.(x) = () in
+  let g M.{x} = () in
+  let h = function M.[] | M.[a] | M.(a::q) -> () in
+  let i = function M.[||] | M.[|x|]  -> true | _ -> false in
+  ()
+
+class ['a] c () = object
+  constraint 'a = < .. > -> unit
+  method m  = (fun x -> () : 'a)
+end
+
+let f: type a'.a' = assert false
+let foo : type a' b'. a' -> b' = fun a -> assert false
+let foo : type t' . t' = fun (type t') -> (assert false : t')
+let foo : 't . 't = fun (type t) -> (assert false : t)
+let foo : type a' b' c' t. a' -> b' -> c' -> t = fun a b c -> assert false
+
+let f x =
+  x.contents <- (print_string "coucou" ; x.contents)
+
+let ( ~$ ) x = Some x
+let g x =
+  ~$ (x.contents)
+
+let ( ~$ ) x y = (x, y)
+let g x y =
+  ~$ (x.contents) (y.contents)
+
+
+
+(* PR#7506: attributes on list tail *)
+
+let tail1 = ([1; 2])[@hello]
+let tail2 = 0::(([1; 2])[@hello])
+let tail3 = 0::(([])[@hello])
+
+let f ~l:(l[@foo]) = l;;
+let test x y = ((+)[@foo]) x y;;
+let test x = ((~-)[@foo]) x;;
+let test contents = { contents = contents[@foo] };;
+class type t = object(_[@foo]) end;;
+let test f x = f ~x:(x[@foo]);;
+let f = function ((`A|`B)[@bar]) | `C -> ();;
+let f = function _::(_::_ [@foo]) -> () | _ -> ();;
+function {contents=contents[@foo]} -> ();;
+fun contents -> {contents=contents[@foo]};;
+((); (((); ())[@foo]));;
+
+(* https://github.com/LexiFi/gen_js_api/issues/61 *)
+
+let () = foo##.bar := ();;
+
+(* "let open" in classes and class types *)
+
+class c =
+  let open M in
+  object
+    method f : t = x
+  end
+;;
+class type ct =
+  let open M in
+  object
+    method f : t
+  end
+;;
+
+(* M.(::) notation *)
+module Exotic_list = struct
+  module Inner = struct
+    type ('a,'b) t = [] | (::) of 'a * 'b *  ('a,'b) t
+  end
+
+  let Inner.(::)(x,y, Inner.[]) = Inner.(::)(1,"one",Inner.[])
+end
+
+(** Extended index operators *)
+module Indexop = struct
+  module Def = struct
+    let ( .%[] ) = Hashtbl.find
+    let ( .%[] <- ) = Hashtbl.add
+    let ( .%() ) = Hashtbl.find
+    let ( .%() <- ) = Hashtbl.add
+    let ( .%{} ) = Hashtbl.find
+    let ( .%{} <- ) = Hashtbl.add
+  end
+  ;;
+  let h = Hashtbl.create 17 in
+  h.Def.%["one"] <- 1;
+  h.Def.%("two") <- 2;
+  h.Def.%{"three"} <- 3
+  let x,y,z = Def.(h.%["one"], h.%("two"), h.%{"three"})
+end
+
+type t = |
+
+
+(* GPR#2034 *)
+
+let x = `  Foo
+let x = ` (* wait for it *) Bar
+type (+' a, -' a', ' a'b', 'ab', ' abcd', ' (* ! *) x) t =
+  ' a * ' a' * ' a'b' * 'ab' * ' abcd' * ' (* !! *) x
+  as ' a'
+
+(* #2190 *)
+
+let f = function
+  | lazy (A foo) -> foo
+
+let () =
+  f (fun (type t) -> x)
diff --git a/testsuite/tests/parsetree/test.ml b/testsuite/tests/parsetree/test.ml
new file mode 100644
index 00000000..ed635483
--- /dev/null
+++ b/testsuite/tests/parsetree/test.ml
@@ -0,0 +1,106 @@
+(* TEST
+   include ocamlcommon
+   files = "source.ml"
+*)
+
+(* (c) Alain Frisch / Lexifi *)
+(* cf. PR#7200 *)
+
+let diff =
+  match Array.to_list Sys.argv with
+  | [_; diff] -> diff
+  | _ -> "diff -u"
+
+let report_err exn =
+  Location.report_exception Format.std_formatter exn
+
+let remove_locs =
+  let open Ast_mapper in
+  { default_mapper with
+    location = (fun _mapper _loc -> Location.none);
+    attributes =
+      (fun mapper attrs ->
+         let attrs = default_mapper.attributes mapper attrs in
+         List.filter (fun a ->
+           a.Parsetree.attr_name.Location.txt <> "#punning#")
+           attrs (* this is to accommodate a LexiFi custom extension *)
+      )
+  }
+
+let from_file parse_fun filename =
+  Location.input_name := filename;
+  let ic = open_in filename in
+  let lexbuf = Lexing.from_channel ic in
+  Location.init lexbuf filename;
+  let ast = parse_fun lexbuf in
+  close_in ic;
+  ast
+
+let from_string parse_fun str =
+  Location.input_name := "<str>";
+  let lexbuf = Lexing.from_string str in
+  Location.init lexbuf "<str>";
+  parse_fun lexbuf
+
+let to_string print_fun ast =
+  Format.fprintf Format.str_formatter "%a@." print_fun ast;
+  Format.flush_str_formatter ()
+
+let to_tmp_file print_fun ast =
+  let fn, oc = Filename.open_temp_file "ocamlparse" ".txt" in
+  output_string oc (to_string print_fun ast);
+  close_out oc;
+  fn
+
+let test parse_fun pprint print map filename =
+  match from_file parse_fun filename with
+  | exception exn ->
+      Printf.printf "%s: FAIL, CANNOT PARSE\n" filename;
+      report_err exn;
+      print_endline "====================================================="
+  | ast ->
+      let str = to_string pprint ast in
+      match from_string parse_fun str with
+      | exception exn ->
+          Printf.printf "%s: FAIL, CANNOT REPARSE\n" filename;
+          report_err exn;
+          print_endline str;
+          print_endline "====================================================="
+      | ast2 ->
+          let ast = map remove_locs remove_locs ast in
+          let ast2 = map remove_locs remove_locs ast2 in
+          if ast <> ast2 then begin
+            Printf.printf "%s:  FAIL, REPARSED AST IS DIFFERENT\n%!" filename;
+            let f1 = to_tmp_file print ast in
+            let f2 = to_tmp_file print ast2 in
+            let cmd = Printf.sprintf "%s %s %s" diff
+                (Filename.quote f1) (Filename.quote f2) in
+            let _ret = Sys.command cmd in
+            print_endline"====================================================="
+          end
+
+let test parse_fun pprint print map filename =
+  try test parse_fun pprint print map filename
+  with exn -> report_err exn
+
+let rec process path =
+  if Sys.is_directory path then
+    let files = Sys.readdir path in
+    Array.iter (fun s -> process (Filename.concat path s)) files
+  else if Filename.check_suffix path ".ml" then
+    test
+      Parse.implementation
+      Pprintast.structure
+      Printast.implementation
+      (fun mapper -> mapper.Ast_mapper.structure)
+      path
+  else if Filename.check_suffix path ".mli" then
+    test
+      Parse.interface
+      Pprintast.signature
+      Printast.interface
+      (fun mapper -> mapper.Ast_mapper.signature)
+      path
+
+let () =
+  process "source.ml"
diff --git a/testsuite/tests/parsetree/test.reference b/testsuite/tests/parsetree/test.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/parsing/anonymous_class_parameter.compilers.reference b/testsuite/tests/parsing/anonymous_class_parameter.compilers.reference
new file mode 100644
index 00000000..bc335501
--- /dev/null
+++ b/testsuite/tests/parsing/anonymous_class_parameter.compilers.reference
@@ -0,0 +1 @@
+class ['a, _] foo : object method bar : 'a -> 'a end
diff --git a/testsuite/tests/parsing/anonymous_class_parameter.ml b/testsuite/tests/parsing/anonymous_class_parameter.ml
new file mode 100644
index 00000000..bbecc127
--- /dev/null
+++ b/testsuite/tests/parsing/anonymous_class_parameter.ml
@@ -0,0 +1,15 @@
+(* TEST
+   flags = "-i"
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+   *** check-ocamlc.byte-output
+*)
+
+(* This test is valid OCaml code.
+   It uses an anonymous type variable as a formal parameter in a class
+   declaration. This used to be rejected by the parser, even though the
+   printer (ocamlc -i) could in fact produce it. *)
+
+class ['a, _] foo = object
+  method bar: 'a -> 'a = fun x -> x
+end
diff --git a/testsuite/tests/parsing/arrow_ambiguity.compilers.reference b/testsuite/tests/parsing/arrow_ambiguity.compilers.reference
new file mode 100644
index 00000000..3f7b120c
--- /dev/null
+++ b/testsuite/tests/parsing/arrow_ambiguity.compilers.reference
@@ -0,0 +1,2 @@
+File "arrow_ambiguity.ml", line 29, characters 0-0:
+Error: Syntax error
diff --git a/testsuite/tests/parsing/arrow_ambiguity.ml b/testsuite/tests/parsing/arrow_ambiguity.ml
new file mode 100644
index 00000000..5af88afe
--- /dev/null
+++ b/testsuite/tests/parsing/arrow_ambiguity.ml
@@ -0,0 +1,28 @@
+(* TEST
+   ocamlc_byte_exit_status = "2"
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+   *** check-ocamlc.byte-output
+*)
+
+(* A potential ambiguity arises because the arrow -> is used
+   both in the syntax of core types and module types, and
+   (furthermore) the construction "T with type t = ..." means
+   that a module type can end with a core type. *)
+
+module type T = sig type t end
+
+(* This is OK *)
+module type Foo =
+  (T with type t = int) -> T
+
+(* This is OK *)
+module type Bar =
+  T with type t = int -> int
+
+(* This is not OK.
+   Therefore the shift/reduce conflict on MINUSGREATER
+   must be solved in favor of shifting. This is why
+   MINUSGREATER is declared right-associative. *)
+module type Bar =
+  T with type t = int -> T
diff --git a/testsuite/tests/parsing/attributes.compilers.reference b/testsuite/tests/parsing/attributes.compilers.reference
new file mode 100644
index 00000000..30f1620e
--- /dev/null
+++ b/testsuite/tests/parsing/attributes.compilers.reference
@@ -0,0 +1,207 @@
+[
+  structure_item (attributes.ml[8,120+0]..[8,120+28])
+    Pstr_exception
+    type_exception
+      attribute "foo"
+        []
+      ptyext_constructor =
+        extension_constructor (attributes.ml[8,120+0]..[8,120+28])
+          attribute "foo"
+            []
+          pext_name = "Foo"
+          pext_kind =
+            Pext_decl
+              []
+              None
+  structure_item (attributes.ml[10,150+0]..[10,150+44])
+    Pstr_exception
+    type_exception
+      attribute "foo"
+        []
+      ptyext_constructor =
+        extension_constructor (attributes.ml[10,150+0]..[10,150+44])
+          attribute "foo"
+            []
+          pext_name = "Bar"
+          pext_kind =
+            Pext_decl
+              [
+                core_type (attributes.ml[10,150+18]..[10,150+21])
+                  attribute "foo"
+                    []
+                  Ptyp_constr "int" (attributes.ml[10,150+18]..[10,150+21])
+                  []
+              ]
+              None
+  structure_item (attributes.ml[12,196+0]..[12,196+8])
+    Pstr_attribute "foo"
+    []
+  structure_item (attributes.ml[14,206+0]..[15,245+9])
+    Pstr_value Nonrec
+    [
+      <def>
+          attribute "foo"
+            []
+        pattern (attributes.ml[14,206+4]..[14,206+27]) ghost
+          Ppat_constraint
+          pattern (attributes.ml[14,206+4]..[14,206+13])
+            attribute "foo"
+              []
+            Ppat_var "x" (attributes.ml[14,206+5]..[14,206+6])
+          core_type (attributes.ml[14,206+16]..[14,206+20])
+            attribute "foo"
+              []
+            Ptyp_constr "unit" (attributes.ml[14,206+16]..[14,206+20])
+            []
+        expression (attributes.ml[14,206+30]..[14,206+32])
+          attribute "foo"
+            []
+          Pexp_construct "()" (attributes.ml[14,206+30]..[14,206+32])
+          None
+    ]
+  structure_item (attributes.ml[17,256+0]..[19,293+7])
+    Pstr_type Rec
+    [
+      type_declaration "t" (attributes.ml[17,256+5]..[17,256+6]) (attributes.ml[17,256+0]..[19,293+7])
+        attribute "foo"
+          []
+        ptype_params =
+          []
+        ptype_cstrs =
+          []
+        ptype_kind =
+          Ptype_variant
+            [
+              (attributes.ml[18,265+2]..[18,265+27])
+                "Foo" (attributes.ml[18,265+4]..[18,265+7])
+                attribute "foo"
+                  []
+                [
+                  core_type (attributes.ml[18,265+12]..[18,265+13])
+                    attribute "foo"
+                      []
+                    Ptyp_constr "t" (attributes.ml[18,265+12]..[18,265+13])
+                    []
+                ]
+                None
+            ]
+        ptype_private = Public
+        ptype_manifest =
+          None
+    ]
+  structure_item (attributes.ml[21,302+0]..[21,302+8])
+    Pstr_attribute "foo"
+    []
+  structure_item (attributes.ml[24,313+0]..[33,420+7])
+    Pstr_module
+    "M" (attributes.ml[24,313+7]..[24,313+8])
+      attribute "foo"
+        []
+      module_expr (attributes.ml[24,313+11]..[32,410+3])
+        attribute "foo"
+          []
+        Pmod_structure
+        [
+          structure_item (attributes.ml[25,331+2]..[29,386+11])
+            Pstr_type Rec
+            [
+              type_declaration "t" (attributes.ml[25,331+7]..[25,331+8]) (attributes.ml[25,331+2]..[29,386+11])
+                attribute "foo"
+                  []
+                attribute "foo"
+                  []
+                ptype_params =
+                  []
+                ptype_cstrs =
+                  []
+                ptype_kind =
+                  Ptype_record
+                    [
+                      (attributes.ml[26,344+4]..[26,344+25])
+                        attribute "foo"
+                          []
+                        Immutable
+                        "l" (attributes.ml[26,344+4]..[26,344+5])                        core_type (attributes.ml[26,344+9]..[26,344+10])
+                          attribute "foo"
+                            []
+                          Ptyp_constr "t" (attributes.ml[26,344+9]..[26,344+10])
+                          []
+                    ]
+                ptype_private = Public
+                ptype_manifest =
+                  None
+            ]
+          structure_item (attributes.ml[31,399+2]..[31,399+10])
+            Pstr_attribute "foo"
+            []
+        ]
+  structure_item (attributes.ml[35,429+0]..[45,601+7])
+    Pstr_modtype "S" (attributes.ml[35,429+12]..[35,429+13])
+      attribute "foo"
+        []
+      module_type (attributes.ml[35,429+16]..[44,591+3])
+        attribute "foo"
+          []
+        Pmty_signature
+        [
+          signature_item (attributes.ml[37,450+2]..[37,450+46])
+            Psig_exception
+            type_exception
+              attribute "foo"
+                []
+              ptyext_constructor =
+                extension_constructor (attributes.ml[37,450+2]..[37,450+46])
+                  attribute "foo"
+                    []
+                  pext_name = "Bar"
+                  pext_kind =
+                    Pext_decl
+                      [
+                        core_type (attributes.ml[37,450+20]..[37,450+23])
+                          attribute "foo"
+                            []
+                          Ptyp_constr "int" (attributes.ml[37,450+20]..[37,450+23])
+                          []
+                      ]
+                      None
+          signature_item (attributes.ml[39,498+2]..[40,566+11])
+            Psig_include
+            module_type (attributes.ml[39,498+10]..[39,498+61])
+              attribute "foo"
+                []
+              Pmty_with
+              module_type (attributes.ml[39,498+11]..[39,498+35])
+                attribute "foo"
+                  []
+                Pmty_typeof
+                module_expr (attributes.ml[39,498+27]..[39,498+28])
+                  attribute "foo"
+                    []
+                  Pmod_ident "M" (attributes.ml[39,498+27]..[39,498+28])
+              [
+                Pwith_typesubst "t" (attributes.ml[39,498+53]..[39,498+54])
+                  type_declaration "t" (attributes.ml[39,498+53]..[39,498+54]) (attributes.ml[39,498+48]..[39,498+61])
+                    ptype_params =
+                      []
+                    ptype_cstrs =
+                      []
+                    ptype_kind =
+                      Ptype_abstract
+                    ptype_private = Public
+                    ptype_manifest =
+                      Some
+                        core_type (attributes.ml[39,498+58]..[39,498+61])
+                          Ptyp_constr "M.t" (attributes.ml[39,498+58]..[39,498+61])
+                          []
+              ]
+              attribute "foo"
+                []
+          signature_item (attributes.ml[42,579+2]..[42,579+10])
+            Psig_attribute "foo"
+            []
+        ]
+  structure_item (attributes.ml[47,610+0]..[47,610+8])
+    Pstr_attribute "foo"
+    []
+]
+
diff --git a/testsuite/tests/parsing/attributes.ml b/testsuite/tests/parsing/attributes.ml
new file mode 100644
index 00000000..b89df9ca
--- /dev/null
+++ b/testsuite/tests/parsing/attributes.ml
@@ -0,0 +1,47 @@
+(* TEST
+   flags = "-dparsetree"
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+   *** check-ocamlc.byte-output
+*)
+
+exception Foo [@foo] [@@foo]
+
+exception Bar of (int [@foo]) [@foo] [@@foo]
+
+[@@@foo]
+
+let (x[@foo]) : unit [@foo] = ()[@foo]
+  [@@foo]
+
+type t =
+  | Foo of (t[@foo]) [@foo]
+[@@foo]
+
+[@@@foo]
+
+
+module M = struct
+  type t = {
+    l : (t [@foo]) [@foo]
+  }
+    [@@foo]
+    [@@foo]
+
+  [@@@foo]
+end[@foo]
+[@@foo]
+
+module type S = sig
+
+  exception Bar of (int [@foo]) [@foo] [@@foo]
+
+  include (module type of (M[@foo]))[@foo] with type t := M.t[@foo]
+    [@@foo]
+
+  [@@@foo]
+
+end[@foo]
+[@@foo]
+
+[@@@foo]
diff --git a/testsuite/tests/parsing/broken_invariants.compilers.reference b/testsuite/tests/parsing/broken_invariants.compilers.reference
new file mode 100644
index 00000000..36926ef9
--- /dev/null
+++ b/testsuite/tests/parsing/broken_invariants.compilers.reference
@@ -0,0 +1,25 @@
+Line 12, characters 20-25:
+12 | let empty_tuple = [%tuple];;
+                         ^^^^^
+Error: broken invariant in parsetree: Tuples must have at least 2 components.
+Line 1, characters 21-27:
+1 | let empty_record = [%record];;
+                         ^^^^^^
+Error: broken invariant in parsetree: Records cannot be empty.
+Line 1, characters 20-27:
+1 | let empty_apply = [%no_args f];;
+                        ^^^^^^^
+Error: broken invariant in parsetree: Function application with no argument.
+Line 1, characters 19-45:
+1 | let f = function [%record_with_functor_fields] -> ();;
+                       ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: broken invariant in parsetree: Functor application not allowed here.
+Line 1, characters 3-12:
+1 | [%%empty_let];;
+       ^^^^^^^^^
+Error: broken invariant in parsetree: Let with no bindings.
+Line 1, characters 3-13:
+1 | [%%empty_type];;
+       ^^^^^^^^^^
+Error: broken invariant in parsetree: Type declarations cannot be empty.
+
diff --git a/testsuite/tests/parsing/broken_invariants.ml b/testsuite/tests/parsing/broken_invariants.ml
new file mode 100644
index 00000000..4ab9ff99
--- /dev/null
+++ b/testsuite/tests/parsing/broken_invariants.ml
@@ -0,0 +1,17 @@
+(* TEST
+   files="illegal_ppx.ml"
+  * setup-ocamlc.byte-build-env
+  ** ocamlc.byte with ocamlcommon
+  all_modules="illegal_ppx.ml"
+  program="ppx.exe"
+  *** toplevel
+  all_modules="broken_invariants.ml"
+  flags="-ppx '${ocamlrun} ${test_build_directory_prefix}/ocamlc.byte/ppx.exe'"
+*)
+
+let empty_tuple = [%tuple];;
+let empty_record = [%record];;
+let empty_apply = [%no_args f];;
+let f = function [%record_with_functor_fields] -> ();;
+[%%empty_let];;
+[%%empty_type];;
diff --git a/testsuite/tests/parsing/change_start_loc.ml b/testsuite/tests/parsing/change_start_loc.ml
new file mode 100644
index 00000000..2e5604ce
--- /dev/null
+++ b/testsuite/tests/parsing/change_start_loc.ml
@@ -0,0 +1,32 @@
+(* TEST
+flags = "-I ${ocamlsrcdir}/parsing -I ${ocamlsrcdir}/toplevel"
+include ocamlcommon
+*)
+let position = Lexing.{ (* This corresponds to File "file.ml", line 100, character 10 *)
+    pos_fname = "------should not appear------";
+    pos_lnum = 100;
+    pos_bol = 1000;
+    pos_cnum = 1010;
+}
+
+(* We need to show, that just changing lex_curr_p is not enough.
+   See wrong columns in output for 'Incomplete version'. *)
+let set_position_incomplete lexbuf position =
+  let open Lexing in
+  lexbuf.lex_curr_p  <- {position with pos_fname = lexbuf.lex_curr_p.pos_fname}
+
+(* "Testing framework" *)
+let print_error_in_parse set_position_variant =
+    try
+        let _ =
+            let lexbuf = Lexing.from_string ")f x" in (* contains error in chars 0-1, line 0 *)
+            set_position_variant lexbuf position;
+            Lexing.set_filename lexbuf "file.ml"; (* also testing set_filename *)
+            Parse.expression lexbuf in ()
+    with e -> Location.report_exception Format.std_formatter e
+
+let _ =
+    print_string "Incomplete version:\n";
+    print_error_in_parse set_position_incomplete;
+    print_string "Good version:\n";
+    print_error_in_parse Lexing.set_position
diff --git a/testsuite/tests/parsing/change_start_loc.reference b/testsuite/tests/parsing/change_start_loc.reference
new file mode 100644
index 00000000..43506af6
--- /dev/null
+++ b/testsuite/tests/parsing/change_start_loc.reference
@@ -0,0 +1,6 @@
+Incomplete version:
+File "file.ml", line 100, characters 10--999:
+Error: Syntax error
+Good version:
+File "file.ml", line 100, characters 10-11:
+Error: Syntax error
diff --git a/testsuite/tests/parsing/constructor_declarations.compilers.reference b/testsuite/tests/parsing/constructor_declarations.compilers.reference
new file mode 100644
index 00000000..eb21ae03
--- /dev/null
+++ b/testsuite/tests/parsing/constructor_declarations.compilers.reference
@@ -0,0 +1,4 @@
+File "constructor_declarations.ml", line 24, characters 2-3:
+24 |   | A of int
+       ^
+Error: Syntax error
diff --git a/testsuite/tests/parsing/constructor_declarations.ml b/testsuite/tests/parsing/constructor_declarations.ml
new file mode 100644
index 00000000..cac1f1b0
--- /dev/null
+++ b/testsuite/tests/parsing/constructor_declarations.ml
@@ -0,0 +1,25 @@
+(* TEST
+   ocamlc_byte_exit_status = "2"
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+   *** check-ocamlc.byte-output
+*)
+
+(* Allowed. *)
+type t =
+    A of int
+  | B of bool
+
+(* Allowed. *)
+type u =
+  | A of int
+  | B of bool
+
+(* Allowed. *)
+type v = |
+
+(* Disallowed, but was allowed in 4.07. *)
+type w =
+  |
+  | A of int
+  | B of bool
diff --git a/testsuite/tests/parsing/docstrings.ml b/testsuite/tests/parsing/docstrings.ml
new file mode 100644
index 00000000..401fbd35
--- /dev/null
+++ b/testsuite/tests/parsing/docstrings.ml
@@ -0,0 +1,670 @@
+(* TEST
+   * expect
+   flags += " -dsource "
+*)
+
+(***********************************************************************)
+(* Test based on the example in the ocamldoc manual
+   Obviously some parts are different due to the simplified
+   rules used by the compiler *)
+
+module Manual : sig
+
+  (** Special comments can be placed between elements and are kept
+      by the OCamldoc tool, but are not associated to any element.
+      @-tags in these comments are ignored.*)
+
+  (*******************************************************************)
+  (** Comments like the one above, with more than two asterisks,
+      are ignored. *)
+
+  (** The comment for function f. *)
+  val f : int -> int -> int
+  (** The continuation of the comment for function f. *)
+
+  (** Comment for exception My_exception, even with a simple comment
+      between the special comment and the exception.*)
+  (* Hello, I'm a simple comment :-) *)
+  exception My_exception of (int -> int) * int
+
+  (** Comment for type weather  *)
+  type weather =
+    | Rain of int (** The comment for constructor Rain *)
+    | Sun (** The comment for constructor Sun *)
+
+  (** Comment for type weather2  *)
+  type weather2 =
+    | Rain of int (** The comment for constructor Rain *)
+    | Sun (** The comment for constructor Sun *)
+  (** I can continue the comment for type weather2 here
+      because there is already a comment associated to the last constructor.*)
+
+  (** The comment for type my_record *)
+  type my_record = {
+    foo : int ;    (** Comment for field foo *)
+    bar : string ; (** Comment for field bar *)
+  }
+  (** Continuation of comment for type my_record *)
+
+  (** Comment for foo *)
+  val foo : string
+  (** This comment is ambiguous and associated to both foo and bar. *)
+  val bar : string
+  (** This comment is associated to bar. *)
+
+  (** The comment for class my_class *)
+  class my_class : object
+    (** A comment to describe inheritance from cl *)
+    inherit cl
+
+    (** The comment for attribute tutu *)
+    val mutable tutu : string
+
+    (** The comment for attribute toto. *)
+    val toto : int
+
+    (** This comment is not attached to titi since
+        there is a blank line before titi, but is kept
+        as a comment in the class. *)
+
+    val titi : string
+
+    (** Comment for method toto *)
+    method toto : string
+
+    (** Comment for method m *)
+    method m : float -> int
+  end
+
+  (** The comment for the class type my_class_type *)
+  class type my_class_type = object
+    (** This is a docstring that OCaml <= 4.07.1 drops.
+        For some reason, when a class type begins with two docstrings,
+        it keeps only the second one.
+        This is fixed by GPR#2151. *)
+
+    (** The comment for variable x. *)
+    val mutable x : int
+
+    (** The comment for method m. *)
+    method m : int -> int
+
+    (** This is a docstring that OCaml <= 4.07.1 misplaces.
+        For some reason, when a class type ends with two docstrings,
+        it keeps both of them, but exchanges their order.
+        This is again fixed by GPR#2151. *)
+
+    (** Another docstring that OCaml <= 4.07.1 misplaces. *)
+
+  end
+
+  (** The comment for module Foo *)
+  module Foo : sig
+    (** The comment for x *)
+    val x : int
+
+    (** A special comment that is kept but not associated to any element *)
+  end
+
+  (** The comment for module type my_module_type. *)
+  module type my_module_type = sig
+    (** The comment for value x. *)
+    val x : int
+
+    (** The comment for module M. *)
+    module M : sig
+      (** The comment for value y. *)
+      val y : int
+
+      (* ... *)
+    end
+
+  end
+
+end = struct
+
+  (** The comment for function f *)
+  let f x y = x + y
+
+  (** This comment is not attached to any element since there is another
+      special comment just before the next element. *)
+
+  (** Comment for exception My_exception, even with a simple comment
+      between the special comment and the exception.*)
+  (* A simple comment. *)
+  exception My_exception of (int -> int) * int
+
+  (** Comment for type weather  *)
+  type weather =
+    | Rain of int (** The comment for constructor Rain *)
+    | Sun (** The comment for constructor Sun *)
+
+  (** The comment for type my_record *)
+  type my_record = {
+    foo : int ;    (** Comment for field foo *)
+    bar : string ; (** Comment for field bar *)
+  }
+
+  (** The comment for class my_class *)
+  class my_class = object
+    (** A comment to describe inheritance from cl *)
+    inherit cl
+
+    (** The comment for the instance variable tutu *)
+    val mutable tutu = "tutu"
+
+    (** The comment for toto *)
+    val toto = 1
+    val titi = "titi"
+    (** Ambiguous comment on both titi and toto *)
+    method toto = tutu ^ "!"
+
+    (** floating 1 *)
+
+    (** floating 2 *)
+
+    (** The comment for method m *)
+    method m (f : float) = 1
+  end
+
+  (** The comment for class type my_class_type *)
+  class type my_class_type = object
+    (** The comment for the instance variable x. *)
+    val mutable x : int
+
+    (** floating 1 *)
+
+    (** floating 2 *)
+
+    (** The comment for method m. *)
+    method m : int -> int
+  end
+
+  (** The comment for module Foo *)
+  module Foo = struct
+    (** The comment for x *)
+    val x : int
+    (** Another comment for x *)
+  end
+
+  (** The comment for module type my_module_type. *)
+  module type my_module_type = sig
+    (* Comment for value x. *)
+    val x : int
+    (* ... *)
+  end
+
+end;;
+[%%expect {|
+
+module Manual :
+  sig
+    [@@@ocaml.text
+      " Special comments can be placed between elements and are kept\n      by the OCamldoc tool, but are not associated to any element.\n      @-tags in these comments are ignored."]
+    [@@@ocaml.text
+      " Comments like the one above, with more than two asterisks,\n      are ignored. "]
+    val f : int -> int -> int[@@ocaml.doc " The comment for function f. "]
+    [@@ocaml.doc " The continuation of the comment for function f. "]
+    exception My_exception of (int -> int) * int
+      [@ocaml.doc
+        " Comment for exception My_exception, even with a simple comment\n      between the special comment and the exception."]
+    type weather =
+      | Rain of int [@ocaml.doc " The comment for constructor Rain "]
+      | Sun [@ocaml.doc " The comment for constructor Sun "][@@ocaml.doc
+                                                              " Comment for type weather  "]
+    type weather2 =
+      | Rain of int [@ocaml.doc " The comment for constructor Rain "]
+      | Sun [@ocaml.doc " The comment for constructor Sun "][@@ocaml.doc
+                                                              " Comment for type weather2  "]
+    [@@ocaml.doc
+      " I can continue the comment for type weather2 here\n      because there is already a comment associated to the last constructor."]
+    type my_record =
+      {
+      foo: int [@ocaml.doc " Comment for field foo "];
+      bar: string [@ocaml.doc " Comment for field bar "]}[@@ocaml.doc
+                                                           " The comment for type my_record "]
+    [@@ocaml.doc " Continuation of comment for type my_record "]
+    val foo : string[@@ocaml.doc " Comment for foo "][@@ocaml.doc
+                                                       " This comment is ambiguous and associated to both foo and bar. "]
+    val bar : string[@@ocaml.doc
+                      " This comment is ambiguous and associated to both foo and bar. "]
+    [@@ocaml.doc " This comment is associated to bar. "]
+    class my_class :
+      object
+        inherit cl[@@ocaml.doc " A comment to describe inheritance from cl "]
+        val  mutable tutu : string[@@ocaml.doc
+                                    " The comment for attribute tutu "]
+        val  toto : int[@@ocaml.doc " The comment for attribute toto. "]
+        [@@@ocaml.text
+          " This comment is not attached to titi since\n        there is a blank line before titi, but is kept\n        as a comment in the class. "]
+        val  titi : string
+        method  toto : string[@@ocaml.doc " Comment for method toto "]
+        method  m : float -> int[@@ocaml.doc " Comment for method m "]
+      end[@@ocaml.doc " The comment for class my_class "]
+    class type my_class_type =
+      object
+        [@@@ocaml.text
+          " This is a docstring that OCaml <= 4.07.1 drops.\n        For some reason, when a class type begins with two docstrings,\n        it keeps only the second one.\n        This is fixed by GPR#2151. "]
+        val  mutable x : int[@@ocaml.doc " The comment for variable x. "]
+        method  m : int -> int[@@ocaml.doc " The comment for method m. "]
+        [@@@ocaml.text
+          " This is a docstring that OCaml <= 4.07.1 misplaces.\n        For some reason, when a class type ends with two docstrings,\n        it keeps both of them, but exchanges their order.\n        This is again fixed by GPR#2151. "]
+        [@@@ocaml.text " Another docstring that OCaml <= 4.07.1 misplaces. "]
+      end[@@ocaml.doc " The comment for the class type my_class_type "]
+    module Foo :
+    sig
+      val x : int[@@ocaml.doc " The comment for x "]
+      [@@@ocaml.text
+        " A special comment that is kept but not associated to any element "]
+    end[@@ocaml.doc " The comment for module Foo "]
+    module type my_module_type  =
+      sig
+        val x : int[@@ocaml.doc " The comment for value x. "]
+        module M :
+        sig val y : int[@@ocaml.doc " The comment for value y. "] end
+        [@@ocaml.doc " The comment for module M. "]
+      end[@@ocaml.doc " The comment for module type my_module_type. "]
+  end =
+  struct
+    let f x y = x + y[@@ocaml.doc " The comment for function f "]
+    [@@@ocaml.text
+      " This comment is not attached to any element since there is another\n      special comment just before the next element. "]
+    exception My_exception of (int -> int) * int
+      [@ocaml.doc
+        " Comment for exception My_exception, even with a simple comment\n      between the special comment and the exception."]
+    type weather =
+      | Rain of int [@ocaml.doc " The comment for constructor Rain "]
+      | Sun [@ocaml.doc " The comment for constructor Sun "][@@ocaml.doc
+                                                              " Comment for type weather  "]
+    type my_record =
+      {
+      foo: int [@ocaml.doc " Comment for field foo "];
+      bar: string [@ocaml.doc " Comment for field bar "]}[@@ocaml.doc
+                                                           " The comment for type my_record "]
+    class my_class =
+      object
+        inherit  cl[@@ocaml.doc
+                     " A comment to describe inheritance from cl "]
+        val mutable tutu = "tutu"[@@ocaml.doc
+                                   " The comment for the instance variable tutu "]
+        val toto = 1[@@ocaml.doc " The comment for toto "]
+        val titi = "titi"[@@ocaml.doc
+                           " Ambiguous comment on both titi and toto "]
+        method toto = tutu ^ "!"[@@ocaml.doc
+                                  " Ambiguous comment on both titi and toto "]
+        [@@@ocaml.text " floating 1 "]
+        [@@@ocaml.text " floating 2 "]
+        method m (f : float) = 1[@@ocaml.doc " The comment for method m "]
+      end[@@ocaml.doc " The comment for class my_class "]
+    class type my_class_type =
+      object
+        val  mutable x : int[@@ocaml.doc
+                              " The comment for the instance variable x. "]
+        [@@@ocaml.text " floating 1 "]
+        [@@@ocaml.text " floating 2 "]
+        method  m : int -> int[@@ocaml.doc " The comment for method m. "]
+      end[@@ocaml.doc " The comment for class type my_class_type "]
+    module Foo =
+      struct
+        external x : int[@@ocaml.doc " The comment for x "][@@ocaml.doc
+                                                             " Another comment for x "]
+      end[@@ocaml.doc " The comment for module Foo "]
+    module type my_module_type  = sig val x : int end[@@ocaml.doc
+                                                       " The comment for module type my_module_type. "]
+  end ;;
+Line 141, characters 12-14:
+141 |     inherit cl
+                  ^^
+Error: Unbound class cl
+|}]
+
+(***********************************************************************)
+(* Empty doc comments (GPR#548) *)
+
+module M = struct
+  type t = Label (**)
+  (** attached to t *)
+
+  (**)
+
+  (** Empty docstring comments should not generate attributes *)
+
+  type w (**)
+end;;
+[%%expect {|
+
+module M =
+  struct
+    type t =
+      | Label [@@ocaml.doc " attached to t "]
+    [@@@ocaml.text
+      " Empty docstring comments should not generate attributes "]
+    type w
+  end;;
+module M : sig type t = Label type w end
+|}]
+
+(***********************************************************************)
+(* Comments at the beginning and end of structures (MPR#7701) *)
+
+module M = struct
+  (** foo *)
+  type t
+
+  type s
+  (** bar *)
+end;;
+[%%expect {|
+
+module M = struct type t[@@ocaml.doc " foo "]
+                  type s[@@ocaml.doc " bar "] end;;
+module M : sig type t type s end
+|}]
+
+module M = struct
+
+  (** foo *)
+  type t
+
+  type s
+  (** bar *)
+
+end;;
+[%%expect {|
+
+module M = struct type t[@@ocaml.doc " foo "]
+                  type s[@@ocaml.doc " bar "] end;;
+module M : sig type t type s end
+|}]
+
+module M = struct
+  (** foo *)
+
+  type t
+
+  type s
+
+  (** bar *)
+end;;
+[%%expect {|
+
+module M =
+  struct [@@@ocaml.text " foo "]
+         type t
+         type s
+         [@@@ocaml.text " bar "] end;;
+module M : sig type t type s end
+|}]
+
+module M = struct
+
+  (** foo *)
+
+  type t
+
+  type s
+
+  (** bar *)
+
+end;;
+[%%expect {|
+
+module M =
+  struct [@@@ocaml.text " foo "]
+         type t
+         type s
+         [@@@ocaml.text " bar "] end;;
+module M : sig type t type s end
+|}]
+
+module M = struct
+
+  (** foo1: this comment is unattached *)
+  (** foo2 *)
+  type t
+
+  type s
+  (** bar1 *)
+  (** bar2: this comment is unattached *)
+
+end;;
+[%%expect {|
+
+module M =
+  struct type t[@@ocaml.doc " foo2 "]
+         type s[@@ocaml.doc " bar1 "] end;;
+module M : sig type t type s end
+|}]
+
+module M = struct
+  (** foo1 *)
+
+  (** foo2 *)
+
+  type t
+
+  type s
+
+  (** bar1 *)
+
+  (** bar2 *)
+end;;
+[%%expect {|
+
+module M =
+  struct
+    [@@@ocaml.text " foo1 "]
+    [@@@ocaml.text " foo2 "]
+    type t
+    type s
+    [@@@ocaml.text " bar1 "]
+    [@@@ocaml.text " bar2 "]
+  end;;
+module M : sig type t type s end
+|}]
+
+module M = struct
+
+  (** foo1 *)
+
+  (** foo2 *)
+
+  type t
+
+  type s
+
+  (** bar1 *)
+
+  (** bar2 *)
+
+end;;
+[%%expect {|
+
+module M =
+  struct
+    [@@@ocaml.text " foo1 "]
+    [@@@ocaml.text " foo2 "]
+    type t
+    type s
+    [@@@ocaml.text " bar1 "]
+    [@@@ocaml.text " bar2 "]
+  end;;
+module M : sig type t type s end
+|}]
+
+module M = struct (** foo *) type t (** bar *) end;;
+[%%expect {|
+
+module M = struct type t[@@ocaml.doc " foo "][@@ocaml.doc " bar "] end;;
+module M : sig type t end
+|}]
+
+module M = struct (** foo *)
+
+type t
+
+(** bar *) end;;
+[%%expect {|
+
+module M = struct [@@@ocaml.text " foo "]
+                  type t
+                  [@@@ocaml.text " bar "] end;;
+module M : sig type t end
+|}]
+
+module M = struct (** foo *) end;;
+[%%expect {|
+
+module M = struct [@@@ocaml.text " foo "] end;;
+module M : sig end
+|}]
+
+module M = struct (** foo *)
+
+end;;
+[%%expect {|
+
+module M = struct [@@@ocaml.text " foo "] end;;
+module M : sig end
+|}]
+
+module M = struct
+
+(** foo *) end;;
+[%%expect {|
+
+module M = struct [@@@ocaml.text " foo "] end;;
+module M : sig end
+|}]
+
+module M = struct
+(** foo *)
+end;;
+[%%expect {|
+
+module M = struct [@@@ocaml.text " foo "] end;;
+module M : sig end
+|}]
+
+module M = struct
+
+(** foo *)
+end;;
+[%%expect {|
+
+module M = struct [@@@ocaml.text " foo "] end;;
+module M : sig end
+|}]
+
+module M = struct
+(** foo *)
+
+end;;
+[%%expect {|
+
+module M = struct [@@@ocaml.text " foo "] end;;
+module M : sig end
+|}]
+
+module M = struct
+
+(** foo *)
+
+end;;
+[%%expect {|
+
+module M = struct [@@@ocaml.text " foo "] end;;
+module M : sig end
+|}]
+
+module M = struct
+
+(** foo *)
+
+(** bar *)
+
+end;;
+[%%expect {|
+
+module M = struct [@@@ocaml.text " foo "]
+                  [@@@ocaml.text " bar "] end;;
+module M : sig end
+|}]
+
+module M = struct
+(** foo *)
+
+(** bar *)
+end;;
+[%%expect {|
+
+module M = struct [@@@ocaml.text " foo "]
+                  [@@@ocaml.text " bar "] end;;
+module M : sig end
+|}]
+
+
+(*****************************************************************************)
+(* Comments on parameters, variant constructors and object methods (GPR#477) *)
+
+type 'a with_default
+  =  ?size:int       (** default [42] *)
+  -> ?resizable:bool (** default [true] *)
+  -> 'a;;
+[%%expect {|
+
+type 'a with_default =
+  ?size:((int)[@ocaml.doc " default [42] "]) ->
+    ?resizable:((bool)[@ocaml.doc " default [true] "]) -> 'a;;
+type 'a with_default = ?size:int -> ?resizable:bool -> 'a
+|}]
+
+type obj = <
+  meth1 : int -> int;
+  (** method 1 *)
+
+  meth2: unit -> float (** method 2 *);
+>;;
+[%%expect {|
+
+type obj =
+  <
+    meth1: int -> int [@ocaml.doc " method 1 "] ;meth2: unit -> float
+                                                   [@ocaml.doc " method 2 "]
+    > ;;
+type obj = < meth1 : int -> int; meth2 : unit -> float >
+|}]
+
+type var = [
+  | `Foo (** foo *)
+  | `Bar of int * string (** bar *)
+];;
+[%%expect {|
+
+type var =
+  [ `Foo [@ocaml.doc " foo "] | `Bar of (int * string) [@ocaml.doc " bar "]];;
+type var = [ `Bar of int * string | `Foo ]
+|}]
+
+module type S = sig
+
+  val before : unit -> unit
+  (** docstring before *)
+  [@@@foo]
+
+  [@@@foo]
+  (** docstring after *)
+  val after : unit -> unit
+
+end;;
+[%%expect {|
+
+module type S  =
+  sig
+    val before : unit -> unit[@@ocaml.doc " docstring before "]
+    [@@@foo ]
+    [@@@foo ]
+    val after : unit -> unit[@@ocaml.doc " docstring after "]
+  end;;
+module type S = sig val before : unit -> unit val after : unit -> unit end
+|}]
diff --git a/testsuite/tests/parsing/extended_indexoperators.ml b/testsuite/tests/parsing/extended_indexoperators.ml
new file mode 100644
index 00000000..bb5fec23
--- /dev/null
+++ b/testsuite/tests/parsing/extended_indexoperators.ml
@@ -0,0 +1,94 @@
+(* TEST
+   * expect
+   flags = "-dsource"
+*)
+
+let (.?[]) = Hashtbl.find_opt
+let (.@[]) = Hashtbl.find
+let ( .@[]<- ) = Hashtbl.add
+let (.@{}) = Hashtbl.find
+let ( .@{}<- ) = Hashtbl.add
+let (.@()) = Hashtbl.find
+let ( .@()<- ) = Hashtbl.add ;;
+[%%expect {|
+
+let (.?[]) = Hashtbl.find_opt;;
+val ( .?[] ) : ('a, 'b) Hashtbl.t -> 'a -> 'b option = <fun>
+
+let (.@[]) = Hashtbl.find;;
+val ( .@[] ) : ('a, 'b) Hashtbl.t -> 'a -> 'b = <fun>
+
+let (.@[]<-) = Hashtbl.add;;
+val ( .@[]<- ) : ('a, 'b) Hashtbl.t -> 'a -> 'b -> unit = <fun>
+
+let (.@{}) = Hashtbl.find;;
+val ( .@{} ) : ('a, 'b) Hashtbl.t -> 'a -> 'b = <fun>
+
+let (.@{}<-) = Hashtbl.add;;
+val ( .@{}<- ) : ('a, 'b) Hashtbl.t -> 'a -> 'b -> unit = <fun>
+
+let (.@()) = Hashtbl.find;;
+val ( .@() ) : ('a, 'b) Hashtbl.t -> 'a -> 'b = <fun>
+
+let (.@()<-) = Hashtbl.add;;
+val ( .@()<- ) : ('a, 'b) Hashtbl.t -> 'a -> 'b -> unit = <fun>
+|}]
+
+let h: (string,int) Hashtbl.t = Hashtbl.create 17;;
+[%%expect {|
+
+let h : (string, int) Hashtbl.t = Hashtbl.create 17;;
+val h : (string, int) Hashtbl.t = <abstr>
+|}]
+
+let () =
+  h .@ ("One") <- 1
+; assert (h.@{"One"} = 1)
+; Format.printf "%d" h.@{"One"}
+; assert (h.?["Two"] = None)
+[%%expect {|
+
+let () =
+  h.@("One") <- 1;
+  assert ((h.@{"One"}) = 1);
+  Format.printf "%d" (h.@{"One"});
+  assert ((h.?["Two"]) = None);;
+|}]
+
+
+(* from GPR#1392 *)
+let ( #? ) x y = (x, y)
+let ( .%() ) x y = x.(y)
+let x = [| 0 |]
+let _ = 1 #? x.(0)
+let _ = 1 #? x.%(0);;
+[%%expect {|
+
+let (#?) x y = (x, y);;
+val ( #? ) : 'a -> 'b -> 'a * 'b = <fun>
+
+let (.%()) x y = x.(y);;
+val ( .%() ) : 'a array -> int -> 'a = <fun>
+
+let x = [|0|];;
+val x : int array = [|0|]
+
+let _ = 1 #? (x.(0));;
+- : int * int = (1, 0)
+
+let _ = 1 #? (x.%(0));;
+- : int * int = (1, 0)
+|}]
+
+
+(* from GPR#1467 *)
+let _ = x.%(((); (); 0))
+let _ = x.%((Format.printf "hello"; 0))
+[%%expect {|
+
+let _ = x.%(((); (); 0));;
+- : int = 0
+
+let _ = x.%((Format.printf "hello"; 0));;
+- : int = 0
+|}]
diff --git a/testsuite/tests/parsing/extensions.compilers.reference b/testsuite/tests/parsing/extensions.compilers.reference
new file mode 100644
index 00000000..31850eb2
--- /dev/null
+++ b/testsuite/tests/parsing/extensions.compilers.reference
@@ -0,0 +1,328 @@
+[
+  structure_item (extensions.ml[9,153+0]..[9,153+22])
+    Pstr_extension "foo"
+    [
+      structure_item (extensions.ml[9,153+7]..[9,153+21])
+        Pstr_eval
+        expression (extensions.ml[9,153+7]..[9,153+21])
+          Pexp_let Nonrec
+          [
+            <def>
+              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)
+          ]
+          expression (extensions.ml[9,153+20]..[9,153+21])
+            Pexp_ident "x" (extensions.ml[9,153+20]..[9,153+21])
+    ]
+  structure_item (extensions.ml[10,176+0]..[10,176+46])
+    Pstr_value Nonrec
+    [
+      <def>
+        pattern (extensions.ml[10,176+4]..[10,176+31]) ghost
+          Ppat_constraint
+          pattern (extensions.ml[10,176+4]..[10,176+14])
+            Ppat_extension "foo"
+            [
+              structure_item (extensions.ml[10,176+10]..[10,176+13])
+                Pstr_eval
+                expression (extensions.ml[10,176+10]..[10,176+13])
+                  Pexp_apply
+                  expression (extensions.ml[10,176+11]..[10,176+12])
+                    Pexp_ident "+" (extensions.ml[10,176+11]..[10,176+12])
+                  [
+                    <arg>
+                    Nolabel
+                      expression (extensions.ml[10,176+10]..[10,176+11])
+                        Pexp_constant PConst_int (2,None)
+                    <arg>
+                    Nolabel
+                      expression (extensions.ml[10,176+12]..[10,176+13])
+                        Pexp_constant PConst_int (1,None)
+                  ]
+            ]
+          core_type (extensions.ml[10,176+17]..[10,176+31])
+            Ptyp_extension "foo"
+            [
+              structure_item (extensions.ml[10,176+23]..[10,176+30])
+                Pstr_eval
+                expression (extensions.ml[10,176+23]..[10,176+30])
+                  Pexp_field
+                  expression (extensions.ml[10,176+23]..[10,176+26])
+                    Pexp_ident "bar" (extensions.ml[10,176+23]..[10,176+26])
+                  "baz" (extensions.ml[10,176+27]..[10,176+30])
+            ]
+        expression (extensions.ml[10,176+34]..[10,176+46])
+          Pexp_extension "foo"
+          [
+            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)
+          ]
+    ]
+  structure_item (extensions.ml[12,224+0]..[12,224+26])
+    Pstr_extension "foo"
+    [
+      structure_item (extensions.ml[12,224+7]..[12,224+24])
+        Pstr_module
+        "M" (extensions.ml[12,224+14]..[12,224+15])
+          module_expr (extensions.ml[12,224+18]..[12,224+24])
+            Pmod_extension "bar"
+            []
+    ]
+  structure_item (extensions.ml[13,251+0]..[13,251+74])
+    Pstr_value Nonrec
+    [
+      <def>
+        pattern (extensions.ml[13,251+4]..[13,251+44]) ghost
+          Ppat_constraint
+          pattern (extensions.ml[13,251+4]..[13,251+23])
+            Ppat_extension "foo"
+            [
+              structure_item (extensions.ml[13,251+10]..[13,251+21])
+                Pstr_value Nonrec
+                [
+                  <def>
+                    pattern (extensions.ml[13,251+14]..[13,251+16])
+                      Ppat_construct "()" (extensions.ml[13,251+14]..[13,251+16])
+                      None
+                    expression (extensions.ml[13,251+19]..[13,251+21])
+                      Pexp_construct "()" (extensions.ml[13,251+19]..[13,251+21])
+                      None
+                ]
+            ]
+          core_type (extensions.ml[13,251+26]..[13,251+44])
+            Ptyp_extension "foo"
+            [
+              structure_item (extensions.ml[13,251+32]..[13,251+42])
+                Pstr_type Rec
+                [
+                  type_declaration "t" (extensions.ml[13,251+37]..[13,251+38]) (extensions.ml[13,251+32]..[13,251+42])
+                    ptype_params =
+                      []
+                    ptype_cstrs =
+                      []
+                    ptype_kind =
+                      Ptype_abstract
+                    ptype_private = Public
+                    ptype_manifest =
+                      Some
+                        core_type (extensions.ml[13,251+41]..[13,251+42])
+                          Ptyp_constr "t" (extensions.ml[13,251+41]..[13,251+42])
+                          []
+                ]
+            ]
+        expression (extensions.ml[13,251+47]..[13,251+74])
+          Pexp_extension "foo"
+          [
+            structure_item (extensions.ml[13,251+53]..[13,251+73])
+              Pstr_class
+              [
+                class_declaration (extensions.ml[13,251+53]..[13,251+73])
+                  pci_virt = Concrete
+                  pci_params =
+                    []
+                  pci_name = "c" (extensions.ml[13,251+59]..[13,251+60])
+                  pci_expr =
+                    class_expr (extensions.ml[13,251+63]..[13,251+73])
+                      Pcl_structure
+                      class_structure
+                        pattern (extensions.ml[13,251+69]..[13,251+69]) ghost
+                          Ppat_any
+                        []
+              ]
+          ]
+    ]
+  structure_item (extensions.ml[15,327+0]..[15,327+16])
+    Pstr_extension "foo"
+    core_type (extensions.ml[15,327+8]..[15,327+15])
+      Ptyp_constr "list" (extensions.ml[15,327+11]..[15,327+15])
+      [
+        core_type (extensions.ml[15,327+8]..[15,327+10])
+          Ptyp_var a
+      ]
+  structure_item (extensions.ml[16,344+0]..[16,344+60])
+    Pstr_value Nonrec
+    [
+      <def>
+        pattern (extensions.ml[16,344+4]..[16,344+37]) ghost
+          Ppat_constraint
+          pattern (extensions.ml[16,344+4]..[16,344+19])
+            Ppat_extension "foo"
+            core_type (extensions.ml[16,344+11]..[16,344+17])
+              Ptyp_variant closed=Closed
+              [
+                Rtag "Foo" true
+                  []
+              ]
+              None
+          core_type (extensions.ml[16,344+22]..[16,344+37])
+            Ptyp_extension "foo"
+            core_type (extensions.ml[16,344+29]..[16,344+35])
+              Ptyp_arrow
+              Nolabel
+              core_type (extensions.ml[16,344+29]..[16,344+30])
+                Ptyp_constr "t" (extensions.ml[16,344+29]..[16,344+30])
+                []
+              core_type (extensions.ml[16,344+34]..[16,344+35])
+                Ptyp_constr "t" (extensions.ml[16,344+34]..[16,344+35])
+                []
+        expression (extensions.ml[16,344+40]..[16,344+60])
+          Pexp_extension "foo"
+          core_type (extensions.ml[16,344+47]..[16,344+58])
+            Ptyp_object Closed
+              method foo
+                core_type (extensions.ml[16,344+55]..[16,344+56])
+                  Ptyp_constr "t" (extensions.ml[16,344+55]..[16,344+56])
+                  []
+    ]
+  structure_item (extensions.ml[18,406+0]..[18,406+11])
+    Pstr_extension "foo"
+    pattern (extensions.ml[18,406+8]..[18,406+9])
+      Ppat_any
+  structure_item (extensions.ml[19,418+0]..[19,418+26])
+    Pstr_extension "foo"
+    pattern (extensions.ml[19,418+8]..[19,418+14])
+      Ppat_construct "Some" (extensions.ml[19,418+8]..[19,418+12])
+      Some
+        pattern (extensions.ml[19,418+13]..[19,418+14])
+          Ppat_var "y" (extensions.ml[19,418+13]..[19,418+14])
+    <when>
+      expression (extensions.ml[19,418+20]..[19,418+25])
+        Pexp_apply
+        expression (extensions.ml[19,418+22]..[19,418+23])
+          Pexp_ident ">" (extensions.ml[19,418+22]..[19,418+23])
+        [
+          <arg>
+          Nolabel
+            expression (extensions.ml[19,418+20]..[19,418+21])
+              Pexp_ident "y" (extensions.ml[19,418+20]..[19,418+21])
+          <arg>
+          Nolabel
+            expression (extensions.ml[19,418+24]..[19,418+25])
+              Pexp_constant PConst_int (0,None)
+        ]
+  structure_item (extensions.ml[20,445+0]..[20,445+60])
+    Pstr_value Nonrec
+    [
+      <def>
+        pattern (extensions.ml[20,445+4]..[20,445+44]) ghost
+          Ppat_constraint
+          pattern (extensions.ml[20,445+4]..[20,445+28])
+            Ppat_extension "foo"
+            pattern (extensions.ml[20,445+11]..[20,445+26])
+              Ppat_or
+              pattern (extensions.ml[20,445+12]..[20,445+17])
+                Ppat_construct "Bar" (extensions.ml[20,445+12]..[20,445+15])
+                Some
+                  pattern (extensions.ml[20,445+16]..[20,445+17])
+                    Ppat_var "x" (extensions.ml[20,445+16]..[20,445+17])
+              pattern (extensions.ml[20,445+20]..[20,445+25])
+                Ppat_construct "Baz" (extensions.ml[20,445+20]..[20,445+23])
+                Some
+                  pattern (extensions.ml[20,445+24]..[20,445+25])
+                    Ppat_var "x" (extensions.ml[20,445+24]..[20,445+25])
+          core_type (extensions.ml[20,445+31]..[20,445+44])
+            Ptyp_extension "foo"
+            pattern (extensions.ml[20,445+38]..[20,445+42])
+              Ppat_type
+              "bar" (extensions.ml[20,445+39]..[20,445+42])
+        expression (extensions.ml[20,445+47]..[20,445+60])
+          Pexp_extension "foo"
+          pattern (extensions.ml[20,445+54]..[20,445+59])
+            Ppat_record Closed
+            [
+              "x" (extensions.ml[20,445+56]..[20,445+57])
+                pattern (extensions.ml[20,445+56]..[20,445+57])
+                  Ppat_var "x" (extensions.ml[20,445+56]..[20,445+57])
+            ]
+    ]
+  structure_item (extensions.ml[22,507+0]..[22,507+26])
+    Pstr_extension "foo"
+    [
+      signature_item (extensions.ml[22,507+8]..[22,507+25])
+        Psig_module "M" (extensions.ml[22,507+15]..[22,507+16])
+        module_type (extensions.ml[22,507+19]..[22,507+25])
+          Pmod_extension "baz"
+          []
+    ]
+  structure_item (extensions.ml[23,534+0]..[25,606+23])
+    Pstr_value Nonrec
+    [
+      <def>
+        pattern (extensions.ml[23,534+4]..[24,573+32]) ghost
+          Ppat_constraint
+          pattern (extensions.ml[23,534+4]..[23,534+38])
+            Ppat_extension "foo"
+            [
+              signature_item (extensions.ml[23,534+11]..[23,534+36])
+                Psig_include
+                module_type (extensions.ml[23,534+19]..[23,534+36])
+                  Pmty_with
+                  module_type (extensions.ml[23,534+19]..[23,534+20])
+                    Pmty_ident "S" (extensions.ml[23,534+19]..[23,534+20])
+                  [
+                    Pwith_type "t" (extensions.ml[23,534+31]..[23,534+32])
+                      type_declaration "t" (extensions.ml[23,534+31]..[23,534+32]) (extensions.ml[23,534+26]..[23,534+36])
+                        ptype_params =
+                          []
+                        ptype_cstrs =
+                          []
+                        ptype_kind =
+                          Ptype_abstract
+                        ptype_private = Public
+                        ptype_manifest =
+                          Some
+                            core_type (extensions.ml[23,534+35]..[23,534+36])
+                              Ptyp_constr "t" (extensions.ml[23,534+35]..[23,534+36])
+                              []
+                  ]
+            ]
+          core_type (extensions.ml[24,573+4]..[24,573+32])
+            Ptyp_extension "foo"
+            [
+              signature_item (extensions.ml[24,573+11]..[24,573+20])
+                Psig_value
+                value_description "x" (extensions.ml[24,573+15]..[24,573+16]) (extensions.ml[24,573+11]..[24,573+20])
+                  core_type (extensions.ml[24,573+19]..[24,573+20])
+                    Ptyp_constr "t" (extensions.ml[24,573+19]..[24,573+20])
+                    []
+                  []
+              signature_item (extensions.ml[24,573+22]..[24,573+31])
+                Psig_value
+                value_description "y" (extensions.ml[24,573+26]..[24,573+27]) (extensions.ml[24,573+22]..[24,573+31])
+                  core_type (extensions.ml[24,573+30]..[24,573+31])
+                    Ptyp_constr "t" (extensions.ml[24,573+30]..[24,573+31])
+                    []
+                  []
+            ]
+        expression (extensions.ml[25,606+4]..[25,606+23])
+          Pexp_extension "foo"
+          [
+            signature_item (extensions.ml[25,606+11]..[25,606+21])
+              Psig_type Rec
+              [
+                type_declaration "t" (extensions.ml[25,606+16]..[25,606+17]) (extensions.ml[25,606+11]..[25,606+21])
+                  ptype_params =
+                    []
+                  ptype_cstrs =
+                    []
+                  ptype_kind =
+                    Ptype_abstract
+                  ptype_private = Public
+                  ptype_manifest =
+                    Some
+                      core_type (extensions.ml[25,606+20]..[25,606+21])
+                        Ptyp_constr "t" (extensions.ml[25,606+20]..[25,606+21])
+                        []
+              ]
+          ]
+    ]
+]
+
+File "extensions.ml", line 9, characters 3-6:
+9 | [%%foo let x = 1 in x]
+       ^^^
+Error: Uninterpreted extension 'foo'.
diff --git a/testsuite/tests/parsing/extensions.ml b/testsuite/tests/parsing/extensions.ml
new file mode 100644
index 00000000..326d2a47
--- /dev/null
+++ b/testsuite/tests/parsing/extensions.ml
@@ -0,0 +1,25 @@
+(* TEST
+   flags = "-dparsetree"
+   ocamlc_byte_exit_status = "2"
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+   *** check-ocamlc.byte-output
+*)
+
+[%%foo let x = 1 in x]
+let [%foo 2+1] : [%foo bar.baz] = [%foo "foo"]
+
+[%%foo module M = [%bar] ]
+let [%foo let () = () ] : [%foo type t = t ] = [%foo class c = object end]
+
+[%%foo: 'a list]
+let [%foo: [`Foo] ] : [%foo: t -> t ] = [%foo: < foo : t > ]
+
+[%%foo? _ ]
+[%%foo? Some y when y > 0]
+let [%foo? (Bar x | Baz x) ] : [%foo? #bar ] = [%foo? { x }]
+
+[%%foo: module M : [%baz]]
+let [%foo: include S with type t = t ]
+  : [%foo: val x : t  val y : t]
+  = [%foo: type t = t ]
diff --git a/testsuite/tests/parsing/hash_ambiguity.compilers.reference b/testsuite/tests/parsing/hash_ambiguity.compilers.reference
new file mode 100644
index 00000000..6caf2013
--- /dev/null
+++ b/testsuite/tests/parsing/hash_ambiguity.compilers.reference
@@ -0,0 +1,113 @@
+[
+  structure_item (hash_ambiguity.ml[8,140+0]..[8,140+28])
+    Pstr_class
+    [
+      class_declaration (hash_ambiguity.ml[8,140+0]..[8,140+28])
+        pci_virt = Concrete
+        pci_params =
+          [
+            core_type (hash_ambiguity.ml[8,140+7]..[8,140+9])
+              Ptyp_var a
+          ]
+        pci_name = "list" (hash_ambiguity.ml[8,140+11]..[8,140+15])
+        pci_expr =
+          class_expr (hash_ambiguity.ml[8,140+18]..[8,140+28])
+            Pcl_structure
+            class_structure
+              pattern (hash_ambiguity.ml[8,140+24]..[8,140+24]) ghost
+                Ppat_any
+              []
+    ]
+  structure_item (hash_ambiguity.ml[9,169+0]..[9,169+27])
+    Pstr_type Rec
+    [
+      type_declaration "t" (hash_ambiguity.ml[9,169+8]..[9,169+9]) (hash_ambiguity.ml[9,169+0]..[9,169+27])
+        ptype_params =
+          [
+            core_type (hash_ambiguity.ml[9,169+5]..[9,169+7])
+              Ptyp_var a
+          ]
+        ptype_cstrs =
+          []
+        ptype_kind =
+          Ptype_abstract
+        ptype_private = Public
+        ptype_manifest =
+          Some
+            core_type (hash_ambiguity.ml[9,169+12]..[9,169+27])
+              Ptyp_alias "a"
+              core_type (hash_ambiguity.ml[9,169+12]..[9,169+21])
+                Ptyp_class "list" (hash_ambiguity.ml[9,169+17]..[9,169+21])
+                [
+                  core_type (hash_ambiguity.ml[9,169+12]..[9,169+15])
+                    Ptyp_constr "int" (hash_ambiguity.ml[9,169+12]..[9,169+15])
+                    []
+                ]
+    ]
+  structure_item (hash_ambiguity.ml[15,425+0]..[15,425+26])
+    Pstr_type Rec
+    [
+      type_declaration "u" (hash_ambiguity.ml[15,425+8]..[15,425+9]) (hash_ambiguity.ml[15,425+0]..[15,425+26])
+        ptype_params =
+          [
+            core_type (hash_ambiguity.ml[15,425+5]..[15,425+7])
+              Ptyp_var a
+          ]
+        ptype_cstrs =
+          []
+        ptype_kind =
+          Ptype_variant
+            [
+              (hash_ambiguity.ml[15,425+12]..[15,425+26])
+                "A" (hash_ambiguity.ml[15,425+12]..[15,425+13])
+                [
+                  core_type (hash_ambiguity.ml[15,425+17]..[15,425+26])
+                    Ptyp_class "list" (hash_ambiguity.ml[15,425+22]..[15,425+26])
+                    [
+                      core_type (hash_ambiguity.ml[15,425+17]..[15,425+20])
+                        Ptyp_constr "int" (hash_ambiguity.ml[15,425+17]..[15,425+20])
+                        []
+                    ]
+                ]
+                None
+            ]
+        ptype_private = Public
+        ptype_manifest =
+          None
+    ]
+  structure_item (hash_ambiguity.ml[17,453+0]..[17,453+32])
+    Pstr_type Rec
+    [
+      type_declaration "v" (hash_ambiguity.ml[17,453+8]..[17,453+9]) (hash_ambiguity.ml[17,453+0]..[17,453+32])
+        ptype_params =
+          [
+            core_type (hash_ambiguity.ml[17,453+5]..[17,453+7])
+              Ptyp_var a
+          ]
+        ptype_cstrs =
+          []
+        ptype_kind =
+          Ptype_variant
+            [
+              (hash_ambiguity.ml[17,453+12]..[17,453+32])
+                "A" (hash_ambiguity.ml[17,453+12]..[17,453+13])
+                [
+                  core_type (hash_ambiguity.ml[17,453+17]..[17,453+20])
+                    Ptyp_constr "int" (hash_ambiguity.ml[17,453+17]..[17,453+20])
+                    []
+                  core_type (hash_ambiguity.ml[17,453+23]..[17,453+32])
+                    Ptyp_class "list" (hash_ambiguity.ml[17,453+28]..[17,453+32])
+                    [
+                      core_type (hash_ambiguity.ml[17,453+23]..[17,453+26])
+                        Ptyp_constr "int" (hash_ambiguity.ml[17,453+23]..[17,453+26])
+                        []
+                    ]
+                ]
+                None
+            ]
+        ptype_private = Public
+        ptype_manifest =
+          None
+    ]
+]
+
diff --git a/testsuite/tests/parsing/hash_ambiguity.ml b/testsuite/tests/parsing/hash_ambiguity.ml
new file mode 100644
index 00000000..32f8297f
--- /dev/null
+++ b/testsuite/tests/parsing/hash_ambiguity.ml
@@ -0,0 +1,17 @@
+(* TEST
+   flags = "-stop-after parsing -dparsetree"
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+   *** check-ocamlc.byte-output
+*)
+
+class ['a] list = object end
+type 'a t = int #list as 'a
+  (* Here, "int #list" must be understood as a type.
+     Another interpretation would be to understand just "int"
+     as a type and view "#list" as a toplevel directive.
+     A syntax error would then be reported at "as". *)
+
+type 'a u = A of int #list
+
+type 'a v = A of int * int #list
diff --git a/testsuite/tests/parsing/illegal_ppx.ml b/testsuite/tests/parsing/illegal_ppx.ml
new file mode 100644
index 00000000..b8280904
--- /dev/null
+++ b/testsuite/tests/parsing/illegal_ppx.ml
@@ -0,0 +1,38 @@
+module H = Ast_helper
+module M = Ast_mapper
+open Parsetree
+let empty_tuple loc = H.Exp.tuple ~loc []
+let empty_record loc = H.Exp.record ~loc [] None
+let empty_apply loc f =
+  H.Exp.apply ~loc f []
+
+let empty_let loc = H.Str.value ~loc Asttypes.Nonrecursive []
+let empty_type loc = H.Str.type_ ~loc Asttypes.Nonrecursive []
+let functor_id loc = Location.mkloc
+    (Longident.( Lapply (Lident "F", Lident "X"))) loc
+let complex_record loc =
+  H.Pat.record ~loc [functor_id loc, H.Pat.any ~loc () ] Asttypes.Closed
+
+let super = M.default_mapper
+let expr mapper e =
+  match e.pexp_desc with
+  | Pexp_extension ({txt="tuple";loc},_) -> empty_tuple loc
+  | Pexp_extension({txt="record";loc},_) -> empty_record loc
+  | Pexp_extension({txt="no_args";loc},PStr[{pstr_desc= Pstr_eval (e,_);_}])
+    -> empty_apply loc e
+  | _ -> super.M.expr mapper e
+
+let pat mapper p =
+  match p.ppat_desc with
+  | Ppat_extension ({txt="record_with_functor_fields";loc},_) ->
+      complex_record loc
+  | _ -> super.M.pat mapper p
+
+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
+  | _ -> super.structure_item mapper stri
+
+let () = M.register "illegal ppx" (fun _ ->
+    { super with expr; pat; structure_item }
+  )
diff --git a/testsuite/tests/parsing/int_and_float_with_modifier.compilers.reference b/testsuite/tests/parsing/int_and_float_with_modifier.compilers.reference
new file mode 100644
index 00000000..3b3ed7e1
--- /dev/null
+++ b/testsuite/tests/parsing/int_and_float_with_modifier.compilers.reference
@@ -0,0 +1,88 @@
+[
+  structure_item (int_and_float_with_modifier.ml[9,153+0]..[10,184+57])
+    Pstr_value Nonrec
+    [
+      <def>
+        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)
+    ]
+  structure_item (int_and_float_with_modifier.ml[11,242+0]..[12,275+58])
+    Pstr_value Nonrec
+    [
+      <def>
+        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)
+    ]
+  structure_item (int_and_float_with_modifier.ml[14,335+0]..[14,335+21])
+    Pstr_value Nonrec
+    [
+      <def>
+        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)
+    ]
+  structure_item (int_and_float_with_modifier.ml[15,357+0]..[15,357+21])
+    Pstr_value Nonrec
+    [
+      <def>
+        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)
+    ]
+  structure_item (int_and_float_with_modifier.ml[16,379+0]..[16,379+21])
+    Pstr_value Nonrec
+    [
+      <def>
+        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)
+    ]
+  structure_item (int_and_float_with_modifier.ml[18,402+0]..[18,402+32])
+    Pstr_value Nonrec
+    [
+      <def>
+        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)
+    ]
+  structure_item (int_and_float_with_modifier.ml[19,435+0]..[19,435+32])
+    Pstr_value Nonrec
+    [
+      <def>
+        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)
+    ]
+  structure_item (int_and_float_with_modifier.ml[21,469+0]..[21,469+33])
+    Pstr_value Nonrec
+    [
+      <def>
+        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)
+    ]
+  structure_item (int_and_float_with_modifier.ml[22,503+0]..[22,503+32])
+    Pstr_value Nonrec
+    [
+      <def>
+        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)
+    ]
+]
+
+File "int_and_float_with_modifier.ml", line 10, characters 2-57:
+10 |   1234567890_1234567890_1234567890_1234567890_1234567890z
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Unknown modifier 'z' for literal 1234567890_1234567890_1234567890_1234567890_1234567890z
diff --git a/testsuite/tests/parsing/int_and_float_with_modifier.ml b/testsuite/tests/parsing/int_and_float_with_modifier.ml
new file mode 100644
index 00000000..444964be
--- /dev/null
+++ b/testsuite/tests/parsing/int_and_float_with_modifier.ml
@@ -0,0 +1,22 @@
+(* TEST
+   flags = "-dparsetree"
+   ocamlc_byte_exit_status = "2"
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+   *** check-ocamlc.byte-output
+*)
+
+let int_with_custom_modifier =
+  1234567890_1234567890_1234567890_1234567890_1234567890z
+let float_with_custom_modifier =
+  1234567890_1234567890_1234567890_1234567890_1234567890.z
+
+let int32     = 1234l
+let int64     = 1234L
+let nativeint = 1234n
+
+let hex_without_modifier = 0x32f
+let hex_with_modifier    = 0x32g
+
+let float_without_modifer = 1.2e3
+let float_with_modifer    = 1.2g
diff --git a/testsuite/tests/parsing/multi_indices.ml b/testsuite/tests/parsing/multi_indices.ml
new file mode 100644
index 00000000..8b67bd91
--- /dev/null
+++ b/testsuite/tests/parsing/multi_indices.ml
@@ -0,0 +1,170 @@
+(* TEST
+    flags = "-dsource"
+    * expect
+*)
+
+module A = Bigarray.Genarray
+[%%expect {|
+
+module A = Bigarray.Genarray;;
+module A = Bigarray.Genarray
+|}]
+
+let (.%{;..}<-) = A.set
+let (.%{;..}) = A.get
+[%%expect {|
+
+let (.%{;..}<-) = A.set;;
+val ( .%{;..}<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit = <fun>
+
+let (.%{;..}) = A.get;;
+val ( .%{;..} ) : ('a, 'b, 'c) A.t -> int array -> 'a = <fun>
+|}]
+
+let (.![;..]<-) = A.set
+let (.![;..]) a n =
+  (* Check the ordering of indices *)
+  Format.printf "indices: @[[|%a|]@]@."
+    (Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ";@ ")
+       Format.pp_print_int) (Array.to_list n);
+  A.get a n
+[%%expect {|
+
+let (.![;..]<-) = A.set;;
+val ( .![;..]<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit = <fun>
+
+let (.![;..]) a n =
+  Format.printf "indices: @[[|%a|]@]@."
+    (Format.pp_print_list
+       ~pp_sep:(fun ppf -> fun () -> Format.fprintf ppf ";@ ")
+       Format.pp_print_int) (Array.to_list n);
+  A.get a n;;
+val ( .![;..] ) : ('a, 'b, 'c) A.t -> int array -> 'a = <fun>
+|}]
+
+let (.?(;..)<-) = A.set
+let (.?(;..)) = A.get
+[%%expect {|
+
+let (.?(;..)<-) = A.set;;
+val ( .?(;..)<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit = <fun>
+
+let (.?(;..)) = A.get;;
+val ( .?(;..) ) : ('a, 'b, 'c) A.t -> int array -> 'a = <fun>
+|}]
+
+let a = A.create Bigarray.float64 Bigarray.c_layout [|3;3;3|]
+[%%expect {|
+
+let a = A.create Bigarray.float64 Bigarray.c_layout [|3;3;3|];;
+val a : (float, Bigarray.float64_elt, Bigarray.c_layout) A.t = <abstr>
+|}]
+
+;; a.![1;0;0] <- 2.
+[%%expect {|
+
+;;a.![1;0;0] <- 2.;;
+- : unit = ()
+|}]
+;; a.?(0;1;0) <- 3.
+[%%expect {|
+
+;;a.?(0;1;0) <- 3.;;
+- : unit = ()
+|}]
+;; a.%{0;0;1} <- 5.
+[%%expect {|
+
+;;a.%{0;0;1} <- 5.;;
+- : unit = ()
+|}]
+
+;; a.![0;1;2] <- 7.;
+   a.![0;1;2]
+[%%expect {|
+
+;;a.![0;1;2] <- 7.; a.![0;1;2];;
+indices: [|0; 1; 2|]
+- : float = 7.
+|}]
+
+
+let (#+) = ( +. )
+[%%expect {|
+
+let (#+) = (+.);;
+val ( #+ ) : float -> float -> float = <fun>
+|}]
+
+;; a.?(1;0;0) #+ a.%{0;1;0} #+ a.![0;0;1]
+[%%expect {|
+
+;;((a.?(1;0;0)) #+ (a.%{0;1;0})) #+ (a.![0;0;1]);;
+indices: [|0; 0; 1|]
+- : float = 10.
+|}]
+
+let (.??[]) () () = ()
+;; ().??[(();())]
+  [%%expect {|
+
+let (.??[]) () () = ();;
+val ( .??[] ) : unit -> unit -> unit = <fun>
+
+;;().??[((); ())];;
+- : unit = ()
+|}]
+
+module M = struct
+  let (.%?(;..)) = A.get
+  let (.%?(;..)<-) = A.set
+  let (.%![;..]) = A.get
+  let (.%![;..]<-) = A.set
+  let (.%%{;..}) = A.get
+  let (.%%{;..}<-) = A.set
+end
+
+;; a.M.%![1;0;0] <- 7.
+[%%expect {|
+
+module M =
+  struct
+    let (.%?(;..)) = A.get
+    let (.%?(;..)<-) = A.set
+    let (.%![;..]) = A.get
+    let (.%![;..]<-) = A.set
+    let (.%%{;..}) = A.get
+    let (.%%{;..}<-) = A.set
+  end;;
+module M :
+  sig
+    val ( .%?(;..) ) : ('a, 'b, 'c) A.t -> int array -> 'a
+    val ( .%?(;..)<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit
+    val ( .%![;..] ) : ('a, 'b, 'c) A.t -> int array -> 'a
+    val ( .%![;..]<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit
+    val ( .%%{;..} ) : ('a, 'b, 'c) A.t -> int array -> 'a
+    val ( .%%{;..}<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit
+  end
+
+;;a.M.%![1;0;0] <- 7.;;
+- : unit = ()
+|}]
+;; a.M.%?(0;1;0) <- 11.
+[%%expect {|
+
+;;a.M.%?(0;1;0) <- 11.;;
+- : unit = ()
+|}]
+;; a.M.%%{0;0;1} <- 13.
+[%%expect {|
+
+;;a.M.%%{0;0;1} <- 13.;;
+- : unit = ()
+|}]
+
+;; a.M.%?(1;0;0) #+ a.M.%%{0;1;0} #+ a.M.%![0;0;1]
+[%%expect {|
+
+;;((a.M.%?(1;0;0)) #+ (a.M.%%{0;1;0})) #+ (a.M.%![0;0;1]);;
+- : float = 31.
+|}]
diff --git a/testsuite/tests/parsing/pr6604.compilers.reference b/testsuite/tests/parsing/pr6604.compilers.reference
new file mode 100644
index 00000000..1be03a31
--- /dev/null
+++ b/testsuite/tests/parsing/pr6604.compilers.reference
@@ -0,0 +1,4 @@
+File "pr6604.ml", line 9, characters 0-1:
+9 | #1
+    ^
+Error: Syntax error
diff --git a/testsuite/tests/parsing/pr6604.ml b/testsuite/tests/parsing/pr6604.ml
new file mode 100644
index 00000000..806f9c37
--- /dev/null
+++ b/testsuite/tests/parsing/pr6604.ml
@@ -0,0 +1,9 @@
+(* TEST
+   flags = "-dparsetree"
+   ocamlc_byte_exit_status = "2"
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+   *** check-ocamlc.byte-output
+*)
+
+#1
diff --git a/testsuite/tests/parsing/pr6604_2.compilers.reference b/testsuite/tests/parsing/pr6604_2.compilers.reference
new file mode 100644
index 00000000..2de5677c
--- /dev/null
+++ b/testsuite/tests/parsing/pr6604_2.compilers.reference
@@ -0,0 +1,4 @@
+File "pr6604_2.ml", line 9, characters 1-2:
+9 |  #1 "pr6604.ml"
+     ^
+Error: Syntax error
diff --git a/testsuite/tests/parsing/pr6604_2.ml b/testsuite/tests/parsing/pr6604_2.ml
new file mode 100644
index 00000000..995e242d
--- /dev/null
+++ b/testsuite/tests/parsing/pr6604_2.ml
@@ -0,0 +1,9 @@
+(* TEST
+   flags = "-dparsetree"
+   ocamlc_byte_exit_status = "2"
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+   *** check-ocamlc.byte-output
+*)
+
+ #1 "pr6604.ml"
diff --git a/testsuite/tests/parsing/pr6604_3.compilers.reference b/testsuite/tests/parsing/pr6604_3.compilers.reference
new file mode 100644
index 00000000..7dd43875
--- /dev/null
+++ b/testsuite/tests/parsing/pr6604_3.compilers.reference
@@ -0,0 +1,2 @@
+[]
+
diff --git a/testsuite/tests/parsing/pr6604_3.ml b/testsuite/tests/parsing/pr6604_3.ml
new file mode 100644
index 00000000..ef15c5c0
--- /dev/null
+++ b/testsuite/tests/parsing/pr6604_3.ml
@@ -0,0 +1,11 @@
+(* TEST
+   flags = "-dparsetree"
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+   *** check-ocamlc.byte-output
+*)
+
+# 1 "pr6604.ml"
+
+# 3 "pr6604.ml"
+# 4 "pr6604.ml"
diff --git a/testsuite/tests/parsing/pr6865.compilers.reference b/testsuite/tests/parsing/pr6865.compilers.reference
new file mode 100644
index 00000000..97017f96
--- /dev/null
+++ b/testsuite/tests/parsing/pr6865.compilers.reference
@@ -0,0 +1,54 @@
+[
+  structure_item (pr6865.ml[9,153+0]..[9,153+14]) ghost
+    Pstr_extension "foo"
+    [
+      structure_item (pr6865.ml[9,153+0]..[9,153+14])
+        Pstr_value Nonrec
+        [
+          <def>
+            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)
+        ]
+    ]
+  structure_item (pr6865.ml[10,168+0]..[10,168+25]) ghost
+    Pstr_extension "foo"
+    [
+      structure_item (pr6865.ml[10,168+0]..[10,168+25])
+        Pstr_value Nonrec
+        [
+          <def>
+            pattern (pr6865.ml[10,168+8]..[10,168+9])
+              Ppat_any
+            expression (pr6865.ml[10,168+12]..[10,168+14])
+              Pexp_construct "()" (pr6865.ml[10,168+12]..[10,168+14])
+              None
+          <def>
+            pattern (pr6865.ml[10,168+19]..[10,168+20])
+              Ppat_any
+            expression (pr6865.ml[10,168+23]..[10,168+25])
+              Pexp_construct "()" (pr6865.ml[10,168+23]..[10,168+25])
+              None
+        ]
+    ]
+  structure_item (pr6865.ml[11,194+0]..[11,194+14]) ghost
+    Pstr_extension "foo"
+    [
+      structure_item (pr6865.ml[11,194+0]..[11,194+14])
+        Pstr_value Nonrec
+        [
+          <def>
+            pattern (pr6865.ml[11,194+8]..[11,194+9])
+              Ppat_any
+            expression (pr6865.ml[11,194+12]..[11,194+14])
+              Pexp_construct "()" (pr6865.ml[11,194+12]..[11,194+14])
+              None
+        ]
+    ]
+]
+
+File "pr6865.ml", line 9, characters 4-7:
+9 | let%foo x = 42
+        ^^^
+Error: Uninterpreted extension 'foo'.
diff --git a/testsuite/tests/parsing/pr6865.ml b/testsuite/tests/parsing/pr6865.ml
new file mode 100644
index 00000000..c673e2a6
--- /dev/null
+++ b/testsuite/tests/parsing/pr6865.ml
@@ -0,0 +1,11 @@
+(* TEST
+   flags = "-dparsetree"
+   ocamlc_byte_exit_status = "2"
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+   *** check-ocamlc.byte-output
+*)
+
+let%foo x = 42
+let%foo _ = () and _ = ()
+let%foo _ = ()
diff --git a/testsuite/tests/parsing/pr7165.compilers.reference b/testsuite/tests/parsing/pr7165.compilers.reference
new file mode 100644
index 00000000..de62d810
--- /dev/null
+++ b/testsuite/tests/parsing/pr7165.compilers.reference
@@ -0,0 +1,4 @@
+File "pr7165.ml", line 12, characters 1-23:
+12 | #9342101923012312312 ""
+      ^^^^^^^^^^^^^^^^^^^^^^
+Error: Invalid lexer directive "#9342101923012312312 \"\"": line number out of range
diff --git a/testsuite/tests/parsing/pr7165.ml b/testsuite/tests/parsing/pr7165.ml
new file mode 100644
index 00000000..e25708c1
--- /dev/null
+++ b/testsuite/tests/parsing/pr7165.ml
@@ -0,0 +1,12 @@
+(* TEST
+   flags = "-dparsetree"
+   ocamlc_byte_exit_status = "2"
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+   *** check-ocamlc.byte-output
+*)
+
+(* this is a lexer directive with an out-of-bound integer;
+   it should result in a lexing error instead of an
+   uncaught exception as in PR#7165 *)
+#9342101923012312312 ""
diff --git a/testsuite/tests/parsing/quotedextensions.compilers.reference b/testsuite/tests/parsing/quotedextensions.compilers.reference
new file mode 100644
index 00000000..4f84877f
--- /dev/null
+++ b/testsuite/tests/parsing/quotedextensions.compilers.reference
@@ -0,0 +1,115 @@
+[
+  structure_item (quotedextensions.ml[10,170+0]..[10,170+23])
+    Pstr_extension "M.foo"
+    [
+      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 "")
+    ]
+  structure_item (quotedextensions.ml[11,194+0]..[11,194+32])
+    Pstr_extension "M.foo"
+    [
+      structure_item (quotedextensions.ml[11,194+0]..[11,194+32]) 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")
+    ]
+  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])
+        Pmty_signature
+        [
+          signature_item (quotedextensions.ml[15,265+2]..[15,265+25])
+            Psig_extension "M.foo"
+            [
+              structure_item (quotedextensions.ml[15,265+2]..[15,265+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 "")
+            ]
+          signature_item (quotedextensions.ml[16,291+2]..[16,291+34])
+            Psig_extension "M.foo"
+            [
+              structure_item (quotedextensions.ml[16,291+2]..[16,291+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")
+            ]
+        ]
+  structure_item (quotedextensions.ml[20,363+0]..[22,417+26])
+    Pstr_value Nonrec
+    [
+      <def>
+        pattern (quotedextensions.ml[20,363+4]..[21,390+26]) ghost
+          Ppat_constraint
+          pattern (quotedextensions.ml[20,363+4]..[20,363+26])
+            Ppat_extension "M.foo"
+            [
+              structure_item (quotedextensions.ml[20,363+4]..[20,363+26]) 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 "")
+            ]
+          core_type (quotedextensions.ml[21,390+4]..[21,390+26])
+            Ptyp_extension "M.foo"
+            [
+              structure_item (quotedextensions.ml[21,390+4]..[21,390+26]) 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[22,417+4]..[22,417+26])
+          Pexp_extension "M.foo"
+          [
+            structure_item (quotedextensions.ml[22,417+4]..[22,417+26]) 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 "")
+          ]
+    ]
+  structure_item (quotedextensions.ml[23,444+0]..[25,516+35])
+    Pstr_value Nonrec
+    [
+      <def>
+        pattern (quotedextensions.ml[23,444+4]..[24,480+35]) ghost
+          Ppat_constraint
+          pattern (quotedextensions.ml[23,444+4]..[23,444+35])
+            Ppat_extension "M.foo"
+            [
+              structure_item (quotedextensions.ml[23,444+4]..[23,444+35]) 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")
+            ]
+          core_type (quotedextensions.ml[24,480+4]..[24,480+35])
+            Ptyp_extension "M.foo"
+            [
+              structure_item (quotedextensions.ml[24,480+4]..[24,480+35]) 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[25,516+4]..[25,516+35])
+          Pexp_extension "M.foo"
+          [
+            structure_item (quotedextensions.ml[25,516+4]..[25,516+35]) 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")
+          ]
+    ]
+  structure_item (quotedextensions.ml[28,569+0]..[32,605+2])
+    Pstr_extension "M.foo"
+    [
+      structure_item (quotedextensions.ml[28,569+0]..[32,605+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 "")
+    ]
+]
+
+File "quotedextensions.ml", line 10, characters 3-8:
+10 | {%%M.foo| <hello>{x} |}
+        ^^^^^
+Error: Uninterpreted extension 'M.foo'.
diff --git a/testsuite/tests/parsing/quotedextensions.ml b/testsuite/tests/parsing/quotedextensions.ml
new file mode 100644
index 00000000..f725f5a1
--- /dev/null
+++ b/testsuite/tests/parsing/quotedextensions.ml
@@ -0,0 +1,42 @@
+(* TEST
+   flags = "-dparsetree"
+   ocamlc_byte_exit_status = "2"
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+   *** check-ocamlc.byte-output
+*)
+
+(* Structures *)
+{%%M.foo| <hello>{x} |}
+{%%M.foo bar| <hello>{|x|} |bar}
+
+(* Signatures *)
+module type S = sig
+  {%%M.foo| <hello>{x} |}
+  {%%M.foo bar| <hello>{|x|} |bar}
+end
+
+(* Expressions/Pattern/Types *)
+let {%M.foo| <hello>{x} |}
+  : {%M.foo| <hello>{x} |}
+  = {%M.foo| <hello>{x} |}
+let {%M.foo bar| <hello>{|x|} |bar}
+  : {%M.foo bar| <hello>{|x|} |bar}
+  = {%M.foo bar| <hello>{|x|} |bar}
+
+(* Multiline *)
+{%%M.foo|
+ <hello>
+   {x}
+ </hello>
+|}
+
+(* Double quotes inside quoted strings inside comments *)
+(* {|"|}, and *)
+(* [%foo {|"|}], and *)
+(* {%foo|"|} should be valid inside comments *)
+
+(* Comment delimiters inside quoted strings inside comments: *)
+(* {|*)|}, and *)
+(* [%foo {bar|*)|bar}], and *)
+(* {%foo bar|*)|bar} should be valid inside comments *)
diff --git a/testsuite/tests/parsing/reloc.ml b/testsuite/tests/parsing/reloc.ml
new file mode 100644
index 00000000..0948d171
--- /dev/null
+++ b/testsuite/tests/parsing/reloc.ml
@@ -0,0 +1,25 @@
+(* TEST
+   flags = "-I ${ocamlsrcdir}/parsing -I ${ocamlsrcdir}/toplevel"
+   include ocamlcommon
+   * expect
+*)
+
+(* Check that [e.pexp_loc :: e.pexp_loc_stack] includes all
+   intermediate locations of an expression. *)
+
+let blocks =
+  let s = {| ( (* comment *) (( "contant" [@attr] )  (* comment *))) |} in
+  let e = Parse.expression (Lexing.from_string s) in
+  let extract (loc : Location.t) =
+    let a = loc.loc_start.pos_cnum in
+    let b = loc.loc_end.pos_cnum in
+    String.sub s a (b - a)
+  in
+  List.map extract (e.pexp_loc :: e.pexp_loc_stack)
+;;
+[%%expect {|
+val blocks : string list =
+  ["( (* comment *) (( \"contant\" [@attr] )  (* comment *)))";
+   "(( \"contant\" [@attr] )  (* comment *))"; "( \"contant\" [@attr] )";
+   "\"contant\""]
+|}];;
diff --git a/testsuite/tests/parsing/shortcut_ext_attr.compilers.reference b/testsuite/tests/parsing/shortcut_ext_attr.compilers.reference
new file mode 100644
index 00000000..414aa824
--- /dev/null
+++ b/testsuite/tests/parsing/shortcut_ext_attr.compilers.reference
@@ -0,0 +1,988 @@
+[
+  structure_item (shortcut_ext_attr.ml[9,170+0]..[30,721+31])
+    Pstr_value Nonrec
+    [
+      <def>
+        pattern (shortcut_ext_attr.ml[9,170+4]..[9,170+6])
+          Ppat_construct "()" (shortcut_ext_attr.ml[9,170+4]..[9,170+6])
+          None
+        expression (shortcut_ext_attr.ml[10,179+2]..[30,721+31]) ghost
+          Pexp_extension "foo"
+          [
+            structure_item (shortcut_ext_attr.ml[10,179+2]..[30,721+31])
+              Pstr_eval
+              expression (shortcut_ext_attr.ml[10,179+2]..[30,721+31])
+                Pexp_let Nonrec
+                [
+                  <def>
+                      attribute "foo"
+                        []
+                    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)
+                  <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)
+                ]
+                expression (shortcut_ext_attr.ml[12,222+2]..[30,721+31])
+                  Pexp_sequence
+                  expression (shortcut_ext_attr.ml[12,222+2]..[12,222+36])
+                    Pexp_extension "foo"
+                    [
+                      structure_item (shortcut_ext_attr.ml[12,222+3]..[12,222+35])
+                        Pstr_eval
+                        expression (shortcut_ext_attr.ml[12,222+3]..[12,222+35])
+                          attribute "foo"
+                            []
+                          Pexp_letmodule "M" (shortcut_ext_attr.ml[12,222+24]..[12,222+25])
+                          module_expr (shortcut_ext_attr.ml[12,222+28]..[12,222+29])
+                            Pmod_ident "M" (shortcut_ext_attr.ml[12,222+28]..[12,222+29])
+                          expression (shortcut_ext_attr.ml[12,222+33]..[12,222+35])
+                            Pexp_construct "()" (shortcut_ext_attr.ml[12,222+33]..[12,222+35])
+                            None
+                    ]
+                  expression (shortcut_ext_attr.ml[13,261+2]..[30,721+31])
+                    Pexp_sequence
+                    expression (shortcut_ext_attr.ml[13,261+2]..[13,261+30])
+                      Pexp_extension "foo"
+                      [
+                        structure_item (shortcut_ext_attr.ml[13,261+3]..[13,261+29])
+                          Pstr_eval
+                          expression (shortcut_ext_attr.ml[13,261+3]..[13,261+29])
+                            attribute "foo"
+                              []
+                            Pexp_open Fresh
+                            module_expr (shortcut_ext_attr.ml[13,261+22]..[13,261+23])
+                              Pmod_ident "M" (shortcut_ext_attr.ml[13,261+22]..[13,261+23])
+                            expression (shortcut_ext_attr.ml[13,261+27]..[13,261+29])
+                              Pexp_construct "()" (shortcut_ext_attr.ml[13,261+27]..[13,261+29])
+                              None
+                      ]
+                    expression (shortcut_ext_attr.ml[14,294+2]..[30,721+31])
+                      Pexp_sequence
+                      expression (shortcut_ext_attr.ml[14,294+2]..[14,294+25])
+                        Pexp_extension "foo"
+                        [
+                          structure_item (shortcut_ext_attr.ml[14,294+3]..[14,294+24])
+                            Pstr_eval
+                            expression (shortcut_ext_attr.ml[14,294+3]..[14,294+24])
+                              attribute "foo"
+                                []
+                              Pexp_fun
+                              Nolabel
+                              None
+                              pattern (shortcut_ext_attr.ml[14,294+17]..[14,294+18])
+                                Ppat_var "x" (shortcut_ext_attr.ml[14,294+17]..[14,294+18])
+                              expression (shortcut_ext_attr.ml[14,294+22]..[14,294+24])
+                                Pexp_construct "()" (shortcut_ext_attr.ml[14,294+22]..[14,294+24])
+                                None
+                        ]
+                      expression (shortcut_ext_attr.ml[15,322+2]..[30,721+31])
+                        Pexp_sequence
+                        expression (shortcut_ext_attr.ml[15,322+2]..[15,322+30])
+                          Pexp_extension "foo"
+                          [
+                            structure_item (shortcut_ext_attr.ml[15,322+3]..[15,322+29])
+                              Pstr_eval
+                              expression (shortcut_ext_attr.ml[15,322+3]..[15,322+29])
+                                attribute "foo"
+                                  []
+                                Pexp_function
+                                [
+                                  <case>
+                                    pattern (shortcut_ext_attr.ml[15,322+22]..[15,322+23])
+                                      Ppat_var "x" (shortcut_ext_attr.ml[15,322+22]..[15,322+23])
+                                    expression (shortcut_ext_attr.ml[15,322+27]..[15,322+29])
+                                      Pexp_construct "()" (shortcut_ext_attr.ml[15,322+27]..[15,322+29])
+                                      None
+                                ]
+                          ]
+                        expression (shortcut_ext_attr.ml[16,355+2]..[30,721+31])
+                          Pexp_sequence
+                          expression (shortcut_ext_attr.ml[16,355+2]..[16,355+33])
+                            Pexp_extension "foo"
+                            [
+                              structure_item (shortcut_ext_attr.ml[16,355+3]..[16,355+32])
+                                Pstr_eval
+                                expression (shortcut_ext_attr.ml[16,355+3]..[16,355+32])
+                                  attribute "foo"
+                                    []
+                                  Pexp_try
+                                  expression (shortcut_ext_attr.ml[16,355+17]..[16,355+19])
+                                    Pexp_construct "()" (shortcut_ext_attr.ml[16,355+17]..[16,355+19])
+                                    None
+                                  [
+                                    <case>
+                                      pattern (shortcut_ext_attr.ml[16,355+25]..[16,355+26])
+                                        Ppat_any
+                                      expression (shortcut_ext_attr.ml[16,355+30]..[16,355+32])
+                                        Pexp_construct "()" (shortcut_ext_attr.ml[16,355+30]..[16,355+32])
+                                        None
+                                  ]
+                            ]
+                          expression (shortcut_ext_attr.ml[17,391+2]..[30,721+31])
+                            Pexp_sequence
+                            expression (shortcut_ext_attr.ml[17,391+2]..[17,391+35])
+                              Pexp_extension "foo"
+                              [
+                                structure_item (shortcut_ext_attr.ml[17,391+3]..[17,391+34])
+                                  Pstr_eval
+                                  expression (shortcut_ext_attr.ml[17,391+3]..[17,391+34])
+                                    attribute "foo"
+                                      []
+                                    Pexp_ifthenelse
+                                    expression (shortcut_ext_attr.ml[17,391+16]..[17,391+18])
+                                      Pexp_construct "()" (shortcut_ext_attr.ml[17,391+16]..[17,391+18])
+                                      None
+                                    expression (shortcut_ext_attr.ml[17,391+24]..[17,391+26])
+                                      Pexp_construct "()" (shortcut_ext_attr.ml[17,391+24]..[17,391+26])
+                                      None
+                                    Some
+                                      expression (shortcut_ext_attr.ml[17,391+32]..[17,391+34])
+                                        Pexp_construct "()" (shortcut_ext_attr.ml[17,391+32]..[17,391+34])
+                                        None
+                              ]
+                            expression (shortcut_ext_attr.ml[18,429+2]..[30,721+31])
+                              Pexp_sequence
+                              expression (shortcut_ext_attr.ml[18,429+2]..[18,429+31]) ghost
+                                Pexp_extension "foo"
+                                [
+                                  structure_item (shortcut_ext_attr.ml[18,429+2]..[18,429+31])
+                                    Pstr_eval
+                                    expression (shortcut_ext_attr.ml[18,429+2]..[18,429+31])
+                                      attribute "foo"
+                                        []
+                                      Pexp_while
+                                      expression (shortcut_ext_attr.ml[18,429+18]..[18,429+20])
+                                        Pexp_construct "()" (shortcut_ext_attr.ml[18,429+18]..[18,429+20])
+                                        None
+                                      expression (shortcut_ext_attr.ml[18,429+24]..[18,429+26])
+                                        Pexp_construct "()" (shortcut_ext_attr.ml[18,429+24]..[18,429+26])
+                                        None
+                                ]
+                              expression (shortcut_ext_attr.ml[19,463+2]..[30,721+31])
+                                Pexp_sequence
+                                expression (shortcut_ext_attr.ml[19,463+2]..[19,463+39]) ghost
+                                  Pexp_extension "foo"
+                                  [
+                                    structure_item (shortcut_ext_attr.ml[19,463+2]..[19,463+39])
+                                      Pstr_eval
+                                      expression (shortcut_ext_attr.ml[19,463+2]..[19,463+39])
+                                        attribute "foo"
+                                          []
+                                        Pexp_for Up
+                                        pattern (shortcut_ext_attr.ml[19,463+16]..[19,463+17])
+                                          Ppat_var "x" (shortcut_ext_attr.ml[19,463+16]..[19,463+17])
+                                        expression (shortcut_ext_attr.ml[19,463+20]..[19,463+22])
+                                          Pexp_construct "()" (shortcut_ext_attr.ml[19,463+20]..[19,463+22])
+                                          None
+                                        expression (shortcut_ext_attr.ml[19,463+26]..[19,463+28])
+                                          Pexp_construct "()" (shortcut_ext_attr.ml[19,463+26]..[19,463+28])
+                                          None
+                                        expression (shortcut_ext_attr.ml[19,463+32]..[19,463+34])
+                                          Pexp_construct "()" (shortcut_ext_attr.ml[19,463+32]..[19,463+34])
+                                          None
+                                  ]
+                                expression (shortcut_ext_attr.ml[20,505+2]..[30,721+31])
+                                  Pexp_extension "foo"
+                                  [
+                                    structure_item (shortcut_ext_attr.ml[20,505+2]..[30,721+31])
+                                      Pstr_eval
+                                      expression (shortcut_ext_attr.ml[20,505+2]..[30,721+31])
+                                        Pexp_sequence
+                                        expression (shortcut_ext_attr.ml[20,505+2]..[20,505+4])
+                                          Pexp_construct "()" (shortcut_ext_attr.ml[20,505+2]..[20,505+4])
+                                          None
+                                        expression (shortcut_ext_attr.ml[20,505+11]..[30,721+31])
+                                          Pexp_sequence
+                                          expression (shortcut_ext_attr.ml[20,505+11]..[20,505+13])
+                                            Pexp_construct "()" (shortcut_ext_attr.ml[20,505+11]..[20,505+13])
+                                            None
+                                          expression (shortcut_ext_attr.ml[21,521+2]..[30,721+31])
+                                            Pexp_sequence
+                                            expression (shortcut_ext_attr.ml[21,521+2]..[21,521+23]) ghost
+                                              Pexp_extension "foo"
+                                              [
+                                                structure_item (shortcut_ext_attr.ml[21,521+2]..[21,521+23])
+                                                  Pstr_eval
+                                                  expression (shortcut_ext_attr.ml[21,521+2]..[21,521+23])
+                                                    attribute "foo"
+                                                      []
+                                                    Pexp_assert
+                                                    expression (shortcut_ext_attr.ml[21,521+19]..[21,521+23])
+                                                      Pexp_construct "true" (shortcut_ext_attr.ml[21,521+19]..[21,521+23])
+                                                      None
+                                              ]
+                                            expression (shortcut_ext_attr.ml[22,547+2]..[30,721+31])
+                                              Pexp_sequence
+                                              expression (shortcut_ext_attr.ml[22,547+2]..[22,547+18]) ghost
+                                                Pexp_extension "foo"
+                                                [
+                                                  structure_item (shortcut_ext_attr.ml[22,547+2]..[22,547+18])
+                                                    Pstr_eval
+                                                    expression (shortcut_ext_attr.ml[22,547+2]..[22,547+18])
+                                                      attribute "foo"
+                                                        []
+                                                      Pexp_lazy
+                                                      expression (shortcut_ext_attr.ml[22,547+17]..[22,547+18])
+                                                        Pexp_ident "x" (shortcut_ext_attr.ml[22,547+17]..[22,547+18])
+                                                ]
+                                              expression (shortcut_ext_attr.ml[23,568+2]..[30,721+31])
+                                                Pexp_sequence
+                                                expression (shortcut_ext_attr.ml[23,568+2]..[23,568+22]) ghost
+                                                  Pexp_extension "foo"
+                                                  [
+                                                    structure_item (shortcut_ext_attr.ml[23,568+2]..[23,568+22])
+                                                      Pstr_eval
+                                                      expression (shortcut_ext_attr.ml[23,568+2]..[23,568+22])
+                                                        attribute "foo"
+                                                          []
+                                                        Pexp_object
+                                                        class_structure
+                                                          pattern (shortcut_ext_attr.ml[23,568+18]..[23,568+18]) ghost
+                                                            Ppat_any
+                                                          []
+                                                  ]
+                                                expression (shortcut_ext_attr.ml[24,593+2]..[30,721+31])
+                                                  Pexp_sequence
+                                                  expression (shortcut_ext_attr.ml[24,593+2]..[24,593+23]) ghost
+                                                    Pexp_extension "foo"
+                                                    [
+                                                      structure_item (shortcut_ext_attr.ml[24,593+2]..[24,593+23])
+                                                        Pstr_eval
+                                                        expression (shortcut_ext_attr.ml[24,593+2]..[24,593+23])
+                                                          attribute "foo"
+                                                            []
+                                                          Pexp_constant PConst_int (3,None)
+                                                    ]
+                                                  expression (shortcut_ext_attr.ml[25,619+2]..[30,721+31])
+                                                    Pexp_sequence
+                                                    expression (shortcut_ext_attr.ml[25,619+2]..[25,619+17]) ghost
+                                                      Pexp_extension "foo"
+                                                      [
+                                                        structure_item (shortcut_ext_attr.ml[25,619+2]..[25,619+17])
+                                                          Pstr_eval
+                                                          expression (shortcut_ext_attr.ml[25,619+2]..[25,619+17])
+                                                            attribute "foo"
+                                                              []
+                                                            Pexp_new "x" (shortcut_ext_attr.ml[25,619+16]..[25,619+17])
+                                                      ]
+                                                    expression (shortcut_ext_attr.ml[27,640+2]..[30,721+31]) ghost
+                                                      Pexp_extension "foo"
+                                                      [
+                                                        structure_item (shortcut_ext_attr.ml[27,640+2]..[30,721+31])
+                                                          Pstr_eval
+                                                          expression (shortcut_ext_attr.ml[27,640+2]..[30,721+31])
+                                                            attribute "foo"
+                                                              []
+                                                            Pexp_match
+                                                            expression (shortcut_ext_attr.ml[27,640+18]..[27,640+20])
+                                                              Pexp_construct "()" (shortcut_ext_attr.ml[27,640+18]..[27,640+20])
+                                                              None
+                                                            [
+                                                              <case>
+                                                                pattern (shortcut_ext_attr.ml[29,694+4]..[29,694+20]) ghost
+                                                                  Ppat_extension "foo"
+                                                                  pattern (shortcut_ext_attr.ml[29,694+4]..[29,694+20])
+                                                                    attribute "foo"
+                                                                      []
+                                                                    Ppat_lazy
+                                                                    pattern (shortcut_ext_attr.ml[29,694+19]..[29,694+20])
+                                                                      Ppat_var "x" (shortcut_ext_attr.ml[29,694+19]..[29,694+20])
+                                                                expression (shortcut_ext_attr.ml[29,694+24]..[29,694+26])
+                                                                  Pexp_construct "()" (shortcut_ext_attr.ml[29,694+24]..[29,694+26])
+                                                                  None
+                                                              <case>
+                                                                pattern (shortcut_ext_attr.ml[30,721+4]..[30,721+25]) ghost
+                                                                  Ppat_extension "foo"
+                                                                  pattern (shortcut_ext_attr.ml[30,721+4]..[30,721+25])
+                                                                    attribute "foo"
+                                                                      []
+                                                                    Ppat_exception
+                                                                    pattern (shortcut_ext_attr.ml[30,721+24]..[30,721+25])
+                                                                      Ppat_var "x" (shortcut_ext_attr.ml[30,721+24]..[30,721+25])
+                                                                expression (shortcut_ext_attr.ml[30,721+29]..[30,721+31])
+                                                                  Pexp_construct "()" (shortcut_ext_attr.ml[30,721+29]..[30,721+31])
+                                                                  None
+                                                            ]
+                                                      ]
+                                  ]
+          ]
+    ]
+  structure_item (shortcut_ext_attr.ml[34,779+0]..[46,1049+5])
+    Pstr_class
+    [
+      class_declaration (shortcut_ext_attr.ml[34,779+0]..[46,1049+5])
+        pci_virt = Concrete
+        pci_params =
+          []
+        pci_name = "x" (shortcut_ext_attr.ml[34,779+6]..[34,779+7])
+        pci_expr =
+          class_expr (shortcut_ext_attr.ml[35,789+12]..[46,1049+5])
+            attribute "foo"
+              []
+            Pcl_fun
+            Nolabel
+            None
+            pattern (shortcut_ext_attr.ml[35,789+12]..[35,789+13])
+              Ppat_var "x" (shortcut_ext_attr.ml[35,789+12]..[35,789+13])
+            class_expr (shortcut_ext_attr.ml[36,806+2]..[46,1049+5])
+              Pcl_let Nonrec
+              [
+                <def>
+                    attribute "foo"
+                      []
+                  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)
+              ]
+              class_expr (shortcut_ext_attr.ml[37,827+2]..[46,1049+5])
+                attribute "foo"
+                  []
+                Pcl_structure
+                class_structure
+                  pattern (shortcut_ext_attr.ml[37,827+14]..[37,827+14]) ghost
+                    Ppat_any
+                  [
+                    class_field (shortcut_ext_attr.ml[38,842+4]..[38,842+19])
+                        attribute "foo"
+                          []
+                      Pcf_inherit Fresh
+                        class_expr (shortcut_ext_attr.ml[38,842+18]..[38,842+19])
+                          Pcl_constr "x" (shortcut_ext_attr.ml[38,842+18]..[38,842+19])
+                          []
+                        None
+                    class_field (shortcut_ext_attr.ml[39,862+4]..[39,862+19])
+                        attribute "foo"
+                          []
+                      Pcf_val Immutable
+                        "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)
+                    class_field (shortcut_ext_attr.ml[40,882+4]..[40,882+27])
+                        attribute "foo"
+                          []
+                      Pcf_val Immutable
+                        "x" (shortcut_ext_attr.ml[40,882+22]..[40,882+23])
+                        Virtual
+                        core_type (shortcut_ext_attr.ml[40,882+26]..[40,882+27])
+                          Ptyp_constr "t" (shortcut_ext_attr.ml[40,882+26]..[40,882+27])
+                          []
+                    class_field (shortcut_ext_attr.ml[41,910+4]..[41,910+28])
+                        attribute "foo"
+                          []
+                      Pcf_val Mutable
+                        "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)
+                    class_field (shortcut_ext_attr.ml[42,939+4]..[42,939+22])
+                        attribute "foo"
+                          []
+                      Pcf_method Public
+                        "x" (shortcut_ext_attr.ml[42,939+17]..[42,939+18])
+                        Concrete Fresh
+                        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)
+                          None
+                    class_field (shortcut_ext_attr.ml[43,962+4]..[43,962+30])
+                        attribute "foo"
+                          []
+                      Pcf_method Public
+                        "x" (shortcut_ext_attr.ml[43,962+25]..[43,962+26])
+                        Virtual
+                        core_type (shortcut_ext_attr.ml[43,962+29]..[43,962+30])
+                          Ptyp_constr "t" (shortcut_ext_attr.ml[43,962+29]..[43,962+30])
+                          []
+                    class_field (shortcut_ext_attr.ml[44,993+4]..[44,993+31])
+                        attribute "foo"
+                          []
+                      Pcf_method Private
+                        "x" (shortcut_ext_attr.ml[44,993+26]..[44,993+27])
+                        Concrete Override
+                        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)
+                          None
+                    class_field (shortcut_ext_attr.ml[45,1025+4]..[45,1025+23])
+                        attribute "foo"
+                          []
+                      Pcf_initializer
+                        expression (shortcut_ext_attr.ml[45,1025+22]..[45,1025+23])
+                          Pexp_ident "x" (shortcut_ext_attr.ml[45,1025+22]..[45,1025+23])
+                  ]
+    ]
+  structure_item (shortcut_ext_attr.ml[49,1085+0]..[57,1265+5])
+    Pstr_class_type
+    [
+      class_type_declaration (shortcut_ext_attr.ml[49,1085+0]..[57,1265+5])
+        pci_virt = Concrete
+        pci_params =
+          []
+        pci_name = "t" (shortcut_ext_attr.ml[49,1085+11]..[49,1085+12])
+        pci_expr =
+          class_type (shortcut_ext_attr.ml[50,1100+2]..[57,1265+5])
+            attribute "foo"
+              []
+            Pcty_signature
+            class_signature
+              core_type (shortcut_ext_attr.ml[50,1100+14]..[50,1100+14])
+                Ptyp_any
+              [
+                class_type_field (shortcut_ext_attr.ml[51,1115+4]..[51,1115+19])
+                    attribute "foo"
+                      []
+                  Pctf_inherit
+                  class_type (shortcut_ext_attr.ml[51,1115+18]..[51,1115+19])
+                    Pcty_constr "t" (shortcut_ext_attr.ml[51,1115+18]..[51,1115+19])
+                    []
+                class_type_field (shortcut_ext_attr.ml[52,1135+4]..[52,1135+19])
+                    attribute "foo"
+                      []
+                  Pctf_val "x" Immutable Concrete
+                    core_type (shortcut_ext_attr.ml[52,1135+18]..[52,1135+19])
+                      Ptyp_constr "t" (shortcut_ext_attr.ml[52,1135+18]..[52,1135+19])
+                      []
+                class_type_field (shortcut_ext_attr.ml[53,1155+4]..[53,1155+27])
+                    attribute "foo"
+                      []
+                  Pctf_val "x" Mutable Concrete
+                    core_type (shortcut_ext_attr.ml[53,1155+26]..[53,1155+27])
+                      Ptyp_constr "t" (shortcut_ext_attr.ml[53,1155+26]..[53,1155+27])
+                      []
+                class_type_field (shortcut_ext_attr.ml[54,1183+4]..[54,1183+22])
+                    attribute "foo"
+                      []
+                  Pctf_method "x" Public Concrete
+                    core_type (shortcut_ext_attr.ml[54,1183+21]..[54,1183+22])
+                      Ptyp_constr "t" (shortcut_ext_attr.ml[54,1183+21]..[54,1183+22])
+                      []
+                class_type_field (shortcut_ext_attr.ml[55,1206+4]..[55,1206+30])
+                    attribute "foo"
+                      []
+                  Pctf_method "x" Private Concrete
+                    core_type (shortcut_ext_attr.ml[55,1206+29]..[55,1206+30])
+                      Ptyp_constr "t" (shortcut_ext_attr.ml[55,1206+29]..[55,1206+30])
+                      []
+                class_type_field (shortcut_ext_attr.ml[56,1237+4]..[56,1237+27])
+                    attribute "foo"
+                      []
+                  Pctf_constraint
+                    core_type (shortcut_ext_attr.ml[56,1237+21]..[56,1237+22])
+                      Ptyp_constr "t" (shortcut_ext_attr.ml[56,1237+21]..[56,1237+22])
+                      []
+                    core_type (shortcut_ext_attr.ml[56,1237+25]..[56,1237+27])
+                      Ptyp_constr "t'" (shortcut_ext_attr.ml[56,1237+25]..[56,1237+27])
+                      []
+              ]
+    ]
+  structure_item (shortcut_ext_attr.ml[60,1295+0]..[61,1304+22])
+    Pstr_type Rec
+    [
+      type_declaration "t" (shortcut_ext_attr.ml[60,1295+5]..[60,1295+6]) (shortcut_ext_attr.ml[60,1295+0]..[61,1304+22])
+        ptype_params =
+          []
+        ptype_cstrs =
+          []
+        ptype_kind =
+          Ptype_abstract
+        ptype_private = Public
+        ptype_manifest =
+          Some
+            core_type (shortcut_ext_attr.ml[61,1304+2]..[61,1304+22]) ghost
+              Ptyp_extension "foo"
+              core_type (shortcut_ext_attr.ml[61,1304+2]..[61,1304+22])
+                attribute "foo"
+                  []
+                Ptyp_package "M" (shortcut_ext_attr.ml[61,1304+20]..[61,1304+21])
+                []
+    ]
+  structure_item (shortcut_ext_attr.ml[64,1353+0]..[67,1409+22])
+    Pstr_module
+    "M" (shortcut_ext_attr.ml[64,1353+7]..[64,1353+8])
+      module_expr (shortcut_ext_attr.ml[65,1364+2]..[67,1409+22])
+        attribute "foo"
+          []
+        Pmod_functor "M" (shortcut_ext_attr.ml[65,1364+17]..[65,1364+18])
+        module_type (shortcut_ext_attr.ml[65,1364+21]..[65,1364+22])
+          Pmty_ident "S" (shortcut_ext_attr.ml[65,1364+21]..[65,1364+22])
+        module_expr (shortcut_ext_attr.ml[66,1391+4]..[67,1409+22])
+          Pmod_apply
+          module_expr (shortcut_ext_attr.ml[66,1391+4]..[66,1391+17])
+            attribute "foo"
+              []
+            Pmod_unpack
+            expression (shortcut_ext_attr.ml[66,1391+15]..[66,1391+16])
+              Pexp_ident "x" (shortcut_ext_attr.ml[66,1391+15]..[66,1391+16])
+          module_expr (shortcut_ext_attr.ml[67,1409+5]..[67,1409+21])
+            attribute "foo"
+              []
+            Pmod_structure
+            []
+  structure_item (shortcut_ext_attr.ml[70,1462+0]..[73,1535+19])
+    Pstr_modtype "S" (shortcut_ext_attr.ml[70,1462+12]..[70,1462+13])
+      module_type (shortcut_ext_attr.ml[71,1478+2]..[73,1535+19])
+        attribute "foo"
+          []
+        Pmty_functor "M" (shortcut_ext_attr.ml[71,1478+17]..[71,1478+18])
+        module_type (shortcut_ext_attr.ml[71,1478+19]..[71,1478+20])
+          Pmty_ident "S" (shortcut_ext_attr.ml[71,1478+19]..[71,1478+20])
+        module_type (shortcut_ext_attr.ml[72,1503+4]..[73,1535+19])
+          Pmty_functor "_" (_none_[0,0+-1]..[0,0+-1]) ghost
+          module_type (shortcut_ext_attr.ml[72,1503+5]..[72,1503+27])
+            attribute "foo"
+              []
+            Pmty_typeof
+            module_expr (shortcut_ext_attr.ml[72,1503+26]..[72,1503+27])
+              Pmod_ident "M" (shortcut_ext_attr.ml[72,1503+26]..[72,1503+27])
+          module_type (shortcut_ext_attr.ml[73,1535+5]..[73,1535+18])
+            attribute "foo"
+              []
+            Pmty_signature
+            []
+  structure_item (shortcut_ext_attr.ml[76,1578+0]..[77,1598+15]) ghost
+    Pstr_extension "foo"
+    [
+      structure_item (shortcut_ext_attr.ml[76,1578+0]..[77,1598+15])
+        Pstr_value Nonrec
+        [
+          <def>
+              attribute "foo"
+                []
+            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)
+          <def>
+              attribute "foo"
+                []
+            pattern (shortcut_ext_attr.ml[77,1598+10]..[77,1598+11])
+              Ppat_var "y" (shortcut_ext_attr.ml[77,1598+10]..[77,1598+11])
+            expression (shortcut_ext_attr.ml[77,1598+14]..[77,1598+15])
+              Pexp_ident "x" (shortcut_ext_attr.ml[77,1598+14]..[77,1598+15])
+        ]
+    ]
+  structure_item (shortcut_ext_attr.ml[79,1615+0]..[80,1638+17]) ghost
+    Pstr_extension "foo"
+    [
+      structure_item (shortcut_ext_attr.ml[79,1615+0]..[80,1638+17])
+        Pstr_type Rec
+        [
+          type_declaration "t" (shortcut_ext_attr.ml[79,1615+15]..[79,1615+16]) (shortcut_ext_attr.ml[79,1615+0]..[79,1615+22])
+            attribute "foo"
+              []
+            ptype_params =
+              []
+            ptype_cstrs =
+              []
+            ptype_kind =
+              Ptype_abstract
+            ptype_private = Public
+            ptype_manifest =
+              Some
+                core_type (shortcut_ext_attr.ml[79,1615+19]..[79,1615+22])
+                  Ptyp_constr "int" (shortcut_ext_attr.ml[79,1615+19]..[79,1615+22])
+                  []
+          type_declaration "t" (shortcut_ext_attr.ml[80,1638+10]..[80,1638+11]) (shortcut_ext_attr.ml[80,1638+0]..[80,1638+17])
+            attribute "foo"
+              []
+            ptype_params =
+              []
+            ptype_cstrs =
+              []
+            ptype_kind =
+              Ptype_abstract
+            ptype_private = Public
+            ptype_manifest =
+              Some
+                core_type (shortcut_ext_attr.ml[80,1638+14]..[80,1638+17])
+                  Ptyp_constr "int" (shortcut_ext_attr.ml[80,1638+14]..[80,1638+17])
+                  []
+        ]
+    ]
+  structure_item (shortcut_ext_attr.ml[81,1656+0]..[81,1656+21]) ghost
+    Pstr_extension "foo"
+    [
+      structure_item (shortcut_ext_attr.ml[81,1656+0]..[81,1656+21])
+        Pstr_typext
+        type_extension
+          attribute "foo"
+            []
+          ptyext_path = "t" (shortcut_ext_attr.ml[81,1656+15]..[81,1656+16])
+          ptyext_params =
+            []
+          ptyext_constructors =
+            [
+              extension_constructor (shortcut_ext_attr.ml[81,1656+20]..[81,1656+21])
+                pext_name = "T"
+                pext_kind =
+                  Pext_decl
+                    []
+                    None
+            ]
+          ptyext_private = Public
+    ]
+  structure_item (shortcut_ext_attr.ml[83,1679+0]..[83,1679+21]) ghost
+    Pstr_extension "foo"
+    [
+      structure_item (shortcut_ext_attr.ml[83,1679+0]..[83,1679+21])
+        Pstr_class
+        [
+          class_declaration (shortcut_ext_attr.ml[83,1679+0]..[83,1679+21])
+            attribute "foo"
+              []
+            pci_virt = Concrete
+            pci_params =
+              []
+            pci_name = "x" (shortcut_ext_attr.ml[83,1679+16]..[83,1679+17])
+            pci_expr =
+              class_expr (shortcut_ext_attr.ml[83,1679+20]..[83,1679+21])
+                Pcl_constr "x" (shortcut_ext_attr.ml[83,1679+20]..[83,1679+21])
+                []
+        ]
+    ]
+  structure_item (shortcut_ext_attr.ml[84,1701+0]..[84,1701+26]) ghost
+    Pstr_extension "foo"
+    [
+      structure_item (shortcut_ext_attr.ml[84,1701+0]..[84,1701+26])
+        Pstr_class_type
+        [
+          class_type_declaration (shortcut_ext_attr.ml[84,1701+0]..[84,1701+26])
+            attribute "foo"
+              []
+            pci_virt = Concrete
+            pci_params =
+              []
+            pci_name = "x" (shortcut_ext_attr.ml[84,1701+21]..[84,1701+22])
+            pci_expr =
+              class_type (shortcut_ext_attr.ml[84,1701+25]..[84,1701+26])
+                Pcty_constr "x" (shortcut_ext_attr.ml[84,1701+25]..[84,1701+26])
+                []
+        ]
+    ]
+  structure_item (shortcut_ext_attr.ml[85,1728+0]..[85,1728+30]) ghost
+    Pstr_extension "foo"
+    [
+      structure_item (shortcut_ext_attr.ml[85,1728+0]..[85,1728+30])
+        Pstr_primitive
+        value_description "x" (shortcut_ext_attr.ml[85,1728+19]..[85,1728+20]) (shortcut_ext_attr.ml[85,1728+0]..[85,1728+30])
+          attribute "foo"
+            []
+          core_type (shortcut_ext_attr.ml[85,1728+23]..[85,1728+24])
+            Ptyp_any
+          [
+            ""
+          ]
+    ]
+  structure_item (shortcut_ext_attr.ml[86,1759+0]..[86,1759+21]) ghost
+    Pstr_extension "foo"
+    [
+      structure_item (shortcut_ext_attr.ml[86,1759+0]..[86,1759+21])
+        Pstr_exception
+        type_exception
+          ptyext_constructor =
+            extension_constructor (shortcut_ext_attr.ml[86,1759+0]..[86,1759+21])
+              attribute "foo"
+                []
+              pext_name = "X"
+              pext_kind =
+                Pext_decl
+                  []
+                  None
+    ]
+  structure_item (shortcut_ext_attr.ml[88,1782+0]..[88,1782+22]) ghost
+    Pstr_extension "foo"
+    [
+      structure_item (shortcut_ext_attr.ml[88,1782+0]..[88,1782+22])
+        Pstr_module
+        "M" (shortcut_ext_attr.ml[88,1782+17]..[88,1782+18])
+          attribute "foo"
+            []
+          module_expr (shortcut_ext_attr.ml[88,1782+21]..[88,1782+22])
+            Pmod_ident "M" (shortcut_ext_attr.ml[88,1782+21]..[88,1782+22])
+    ]
+  structure_item (shortcut_ext_attr.ml[89,1805+0]..[90,1836+19]) ghost
+    Pstr_extension "foo"
+    [
+      structure_item (shortcut_ext_attr.ml[89,1805+0]..[90,1836+19])
+        Pstr_recmodule
+        [
+          "M" (shortcut_ext_attr.ml[89,1805+21]..[89,1805+22])
+            attribute "foo"
+              []
+            module_expr (shortcut_ext_attr.ml[89,1805+23]..[89,1805+30])
+              Pmod_constraint
+              module_expr (shortcut_ext_attr.ml[89,1805+29]..[89,1805+30])
+                Pmod_ident "M" (shortcut_ext_attr.ml[89,1805+29]..[89,1805+30])
+              module_type (shortcut_ext_attr.ml[89,1805+25]..[89,1805+26])
+                Pmty_ident "S" (shortcut_ext_attr.ml[89,1805+25]..[89,1805+26])
+          "M" (shortcut_ext_attr.ml[90,1836+10]..[90,1836+11])
+            attribute "foo"
+              []
+            module_expr (shortcut_ext_attr.ml[90,1836+12]..[90,1836+19])
+              Pmod_constraint
+              module_expr (shortcut_ext_attr.ml[90,1836+18]..[90,1836+19])
+                Pmod_ident "M" (shortcut_ext_attr.ml[90,1836+18]..[90,1836+19])
+              module_type (shortcut_ext_attr.ml[90,1836+14]..[90,1836+15])
+                Pmty_ident "S" (shortcut_ext_attr.ml[90,1836+14]..[90,1836+15])
+        ]
+    ]
+  structure_item (shortcut_ext_attr.ml[91,1856+0]..[91,1856+27]) ghost
+    Pstr_extension "foo"
+    [
+      structure_item (shortcut_ext_attr.ml[91,1856+0]..[91,1856+27])
+        Pstr_modtype "S" (shortcut_ext_attr.ml[91,1856+22]..[91,1856+23])
+          attribute "foo"
+            []
+          module_type (shortcut_ext_attr.ml[91,1856+26]..[91,1856+27])
+            Pmty_ident "S" (shortcut_ext_attr.ml[91,1856+26]..[91,1856+27])
+    ]
+  structure_item (shortcut_ext_attr.ml[93,1885+0]..[93,1885+19]) ghost
+    Pstr_extension "foo"
+    [
+      structure_item (shortcut_ext_attr.ml[93,1885+0]..[93,1885+19])
+        Pstr_include          attribute "foo"
+            []
+        module_expr (shortcut_ext_attr.ml[93,1885+18]..[93,1885+19])
+          Pmod_ident "M" (shortcut_ext_attr.ml[93,1885+18]..[93,1885+19])
+    ]
+  structure_item (shortcut_ext_attr.ml[94,1905+0]..[94,1905+16]) ghost
+    Pstr_extension "foo"
+    [
+      structure_item (shortcut_ext_attr.ml[94,1905+0]..[94,1905+16])
+        Pstr_open Fresh
+        module_expr (shortcut_ext_attr.ml[94,1905+15]..[94,1905+16])
+          Pmod_ident "M" (shortcut_ext_attr.ml[94,1905+15]..[94,1905+16])
+          attribute "foo"
+            []
+    ]
+  structure_item (shortcut_ext_attr.ml[97,1945+0]..[120,2341+3])
+    Pstr_modtype "S" (shortcut_ext_attr.ml[97,1945+12]..[97,1945+13])
+      module_type (shortcut_ext_attr.ml[97,1945+16]..[120,2341+3])
+        Pmty_signature
+        [
+          signature_item (shortcut_ext_attr.ml[98,1965+2]..[98,1965+21]) ghost
+            Psig_extension "foo"
+            [
+              signature_item (shortcut_ext_attr.ml[98,1965+2]..[98,1965+21])
+                Psig_value
+                value_description "x" (shortcut_ext_attr.ml[98,1965+16]..[98,1965+17]) (shortcut_ext_attr.ml[98,1965+2]..[98,1965+21])
+                  attribute "foo"
+                    []
+                  core_type (shortcut_ext_attr.ml[98,1965+20]..[98,1965+21])
+                    Ptyp_constr "t" (shortcut_ext_attr.ml[98,1965+20]..[98,1965+21])
+                    []
+                  []
+            ]
+          signature_item (shortcut_ext_attr.ml[99,1987+2]..[99,1987+31]) ghost
+            Psig_extension "foo"
+            [
+              signature_item (shortcut_ext_attr.ml[99,1987+2]..[99,1987+31])
+                Psig_value
+                value_description "x" (shortcut_ext_attr.ml[99,1987+21]..[99,1987+22]) (shortcut_ext_attr.ml[99,1987+2]..[99,1987+31])
+                  attribute "foo"
+                    []
+                  core_type (shortcut_ext_attr.ml[99,1987+25]..[99,1987+26])
+                    Ptyp_constr "t" (shortcut_ext_attr.ml[99,1987+25]..[99,1987+26])
+                    []
+                  [
+                    ""
+                  ]
+            ]
+          signature_item (shortcut_ext_attr.ml[101,2020+2]..[102,2045+20]) ghost
+            Psig_extension "foo"
+            [
+              signature_item (shortcut_ext_attr.ml[101,2020+2]..[102,2045+20])
+                Psig_type Rec
+                [
+                  type_declaration "t" (shortcut_ext_attr.ml[101,2020+17]..[101,2020+18]) (shortcut_ext_attr.ml[101,2020+2]..[101,2020+24])
+                    attribute "foo"
+                      []
+                    ptype_params =
+                      []
+                    ptype_cstrs =
+                      []
+                    ptype_kind =
+                      Ptype_abstract
+                    ptype_private = Public
+                    ptype_manifest =
+                      Some
+                        core_type (shortcut_ext_attr.ml[101,2020+21]..[101,2020+24])
+                          Ptyp_constr "int" (shortcut_ext_attr.ml[101,2020+21]..[101,2020+24])
+                          []
+                  type_declaration "t'" (shortcut_ext_attr.ml[102,2045+12]..[102,2045+14]) (shortcut_ext_attr.ml[102,2045+2]..[102,2045+20])
+                    attribute "foo"
+                      []
+                    ptype_params =
+                      []
+                    ptype_cstrs =
+                      []
+                    ptype_kind =
+                      Ptype_abstract
+                    ptype_private = Public
+                    ptype_manifest =
+                      Some
+                        core_type (shortcut_ext_attr.ml[102,2045+17]..[102,2045+20])
+                          Ptyp_constr "int" (shortcut_ext_attr.ml[102,2045+17]..[102,2045+20])
+                          []
+                ]
+            ]
+          signature_item (shortcut_ext_attr.ml[103,2066+2]..[103,2066+23]) ghost
+            Psig_extension "foo"
+            [
+              signature_item (shortcut_ext_attr.ml[103,2066+2]..[103,2066+23])
+                Psig_typext
+                type_extension
+                  attribute "foo"
+                    []
+                  ptyext_path = "t" (shortcut_ext_attr.ml[103,2066+17]..[103,2066+18])
+                  ptyext_params =
+                    []
+                  ptyext_constructors =
+                    [
+                      extension_constructor (shortcut_ext_attr.ml[103,2066+22]..[103,2066+23])
+                        pext_name = "T"
+                        pext_kind =
+                          Pext_decl
+                            []
+                            None
+                    ]
+                  ptyext_private = Public
+            ]
+          signature_item (shortcut_ext_attr.ml[105,2091+2]..[105,2091+23]) ghost
+            Psig_extension "foo"
+            [
+              signature_item (shortcut_ext_attr.ml[105,2091+2]..[105,2091+23])
+                Psig_exception
+                type_exception
+                  ptyext_constructor =
+                    extension_constructor (shortcut_ext_attr.ml[105,2091+2]..[105,2091+23])
+                      attribute "foo"
+                        []
+                      pext_name = "X"
+                      pext_kind =
+                        Pext_decl
+                          []
+                          None
+            ]
+          signature_item (shortcut_ext_attr.ml[107,2116+2]..[107,2116+24]) ghost
+            Psig_extension "foo"
+            [
+              signature_item (shortcut_ext_attr.ml[107,2116+2]..[107,2116+24])
+                Psig_module "M" (shortcut_ext_attr.ml[107,2116+19]..[107,2116+20])
+                  attribute "foo"
+                    []
+                module_type (shortcut_ext_attr.ml[107,2116+23]..[107,2116+24])
+                  Pmty_ident "S" (shortcut_ext_attr.ml[107,2116+23]..[107,2116+24])
+            ]
+          signature_item (shortcut_ext_attr.ml[108,2141+2]..[109,2170+17]) ghost
+            Psig_extension "foo"
+            [
+              signature_item (shortcut_ext_attr.ml[108,2141+2]..[109,2170+17])
+                Psig_recmodule
+                [
+                  "M" (shortcut_ext_attr.ml[108,2141+23]..[108,2141+24])
+                    attribute "foo"
+                      []
+                    module_type (shortcut_ext_attr.ml[108,2141+27]..[108,2141+28])
+                      Pmty_ident "S" (shortcut_ext_attr.ml[108,2141+27]..[108,2141+28])
+                  "M" (shortcut_ext_attr.ml[109,2170+12]..[109,2170+13])
+                    attribute "foo"
+                      []
+                    module_type (shortcut_ext_attr.ml[109,2170+16]..[109,2170+17])
+                      Pmty_ident "S" (shortcut_ext_attr.ml[109,2170+16]..[109,2170+17])
+                ]
+            ]
+          signature_item (shortcut_ext_attr.ml[110,2188+2]..[110,2188+24]) ghost
+            Psig_extension "foo"
+            [
+              signature_item (shortcut_ext_attr.ml[110,2188+2]..[110,2188+24])
+                Psig_module "M" (shortcut_ext_attr.ml[110,2188+19]..[110,2188+20])
+                  attribute "foo"
+                    []
+                module_type (shortcut_ext_attr.ml[110,2188+23]..[110,2188+24])
+                  Pmty_alias "M" (shortcut_ext_attr.ml[110,2188+23]..[110,2188+24])
+            ]
+          signature_item (shortcut_ext_attr.ml[112,2214+2]..[112,2214+29]) ghost
+            Psig_extension "foo"
+            [
+              signature_item (shortcut_ext_attr.ml[112,2214+2]..[112,2214+29])
+                Psig_modtype "S" (shortcut_ext_attr.ml[112,2214+24]..[112,2214+25])
+                  attribute "foo"
+                    []
+                  module_type (shortcut_ext_attr.ml[112,2214+28]..[112,2214+29])
+                    Pmty_ident "S" (shortcut_ext_attr.ml[112,2214+28]..[112,2214+29])
+            ]
+          signature_item (shortcut_ext_attr.ml[114,2245+2]..[114,2245+21]) ghost
+            Psig_extension "foo"
+            [
+              signature_item (shortcut_ext_attr.ml[114,2245+2]..[114,2245+21])
+                Psig_include
+                module_type (shortcut_ext_attr.ml[114,2245+20]..[114,2245+21])
+                  Pmty_ident "M" (shortcut_ext_attr.ml[114,2245+20]..[114,2245+21])
+                  attribute "foo"
+                    []
+            ]
+          signature_item (shortcut_ext_attr.ml[115,2267+2]..[115,2267+18]) ghost
+            Psig_extension "foo"
+            [
+              signature_item (shortcut_ext_attr.ml[115,2267+2]..[115,2267+18])
+                Psig_open Fresh "M" (shortcut_ext_attr.ml[115,2267+17]..[115,2267+18])
+                  attribute "foo"
+                    []
+            ]
+          signature_item (shortcut_ext_attr.ml[117,2287+2]..[117,2287+23]) ghost
+            Psig_extension "foo"
+            [
+              signature_item (shortcut_ext_attr.ml[117,2287+2]..[117,2287+23])
+                Psig_class
+                [
+                  class_description (shortcut_ext_attr.ml[117,2287+2]..[117,2287+23])
+                    attribute "foo"
+                      []
+                    pci_virt = Concrete
+                    pci_params =
+                      []
+                    pci_name = "x" (shortcut_ext_attr.ml[117,2287+18]..[117,2287+19])
+                    pci_expr =
+                      class_type (shortcut_ext_attr.ml[117,2287+22]..[117,2287+23])
+                        Pcty_constr "t" (shortcut_ext_attr.ml[117,2287+22]..[117,2287+23])
+                        []
+                ]
+            ]
+          signature_item (shortcut_ext_attr.ml[118,2311+2]..[118,2311+28]) ghost
+            Psig_extension "foo"
+            [
+              signature_item (shortcut_ext_attr.ml[118,2311+2]..[118,2311+28])
+                Psig_class_type
+                [
+                  class_type_declaration (shortcut_ext_attr.ml[118,2311+2]..[118,2311+28])
+                    attribute "foo"
+                      []
+                    pci_virt = Concrete
+                    pci_params =
+                      []
+                    pci_name = "x" (shortcut_ext_attr.ml[118,2311+23]..[118,2311+24])
+                    pci_expr =
+                      class_type (shortcut_ext_attr.ml[118,2311+27]..[118,2311+28])
+                        Pcty_constr "x" (shortcut_ext_attr.ml[118,2311+27]..[118,2311+28])
+                        []
+                ]
+            ]
+        ]
+]
+
+File "shortcut_ext_attr.ml", line 10, characters 6-9:
+10 |   let%foo[@foo] x = 3
+           ^^^
+Error: Uninterpreted extension 'foo'.
diff --git a/testsuite/tests/parsing/shortcut_ext_attr.ml b/testsuite/tests/parsing/shortcut_ext_attr.ml
new file mode 100644
index 00000000..222e7a0c
--- /dev/null
+++ b/testsuite/tests/parsing/shortcut_ext_attr.ml
@@ -0,0 +1,120 @@
+(* TEST
+   flags = "-dparsetree"
+   ocamlc_byte_exit_status = "2"
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+   *** check-ocamlc.byte-output
+*)
+(* Expressions *)
+let () =
+  let%foo[@foo] x = 3
+  and[@foo] y = 4 in
+  (let module%foo[@foo] M = M in ()) ;
+  (let open%foo[@foo] M in ()) ;
+  (fun%foo[@foo] x -> ()) ;
+  (function%foo[@foo] x -> ()) ;
+  (try%foo[@foo] () with _ -> ()) ;
+  (if%foo[@foo] () then () else ()) ;
+  while%foo[@foo] () do () done ;
+  for%foo[@foo] x = () to () do () done ;
+  () ;%foo () ;
+  assert%foo[@foo] true ;
+  lazy%foo[@foo] x ;
+  object%foo[@foo] end ;
+  begin%foo[@foo] 3 end ;
+  new%foo[@foo] x ;
+
+  match%foo[@foo] () with
+  (* Pattern expressions *)
+  | lazy%foo[@foo] x -> ()
+  | exception%foo[@foo] x -> ()
+
+
+(* Class expressions *)
+class x =
+  fun[@foo] x ->
+  let[@foo] x = 3 in
+  object[@foo]
+    inherit[@foo] x
+    val[@foo] x = 3
+    val[@foo] virtual x : t
+    val![@foo] mutable x = 3
+    method[@foo] x = 3
+    method[@foo] virtual x : t
+    method![@foo] private x = 3
+    initializer[@foo] x
+  end
+
+(* Class type expressions *)
+class type t =
+  object[@foo]
+    inherit[@foo] t
+    val[@foo] x : t
+    val[@foo] mutable x : t
+    method[@foo] x : t
+    method[@foo] private x : t
+    constraint[@foo] t = t'
+  end
+
+(* Type expressions *)
+type t =
+  (module%foo[@foo] M)
+
+(* Module expressions *)
+module M =
+  functor[@foo] (M : S) ->
+    (val[@foo] x)
+    (struct[@foo] end)
+
+(* Module type expression *)
+module type S =
+  functor[@foo] (M:S) ->
+    (module type of[@foo] M) ->
+    (sig[@foo] end)
+
+(* Structure items *)
+let%foo[@foo] x = 4
+and[@foo] y = x
+
+type%foo[@foo] t = int
+and[@foo] t = int
+type%foo[@foo] t += T
+
+class%foo[@foo] x = x
+class type%foo[@foo] x = x
+external%foo[@foo] x : _  = ""
+exception%foo[@foo] X
+
+module%foo[@foo] M = M
+module%foo[@foo] rec M : S = M
+and[@foo] M : S = M
+module type%foo[@foo] S = S
+
+include%foo[@foo] M
+open%foo[@foo] M
+
+(* Signature items *)
+module type S = sig
+  val%foo[@foo] x : t
+  external%foo[@foo] x : t = ""
+
+  type%foo[@foo] t = int
+  and[@foo] t' = int
+  type%foo[@foo] t += T
+
+  exception%foo[@foo] X
+
+  module%foo[@foo] M : S
+  module%foo[@foo] rec M : S
+  and[@foo] M : S
+  module%foo[@foo] M = M
+
+  module type%foo[@foo] S = S
+
+  include%foo[@foo] M
+  open%foo[@foo] M
+
+  class%foo[@foo] x : t
+  class type%foo[@foo] x = x
+
+end
diff --git a/testsuite/tests/ppx-attributes/warning.ml b/testsuite/tests/ppx-attributes/warning.ml
new file mode 100644
index 00000000..0ae66674
--- /dev/null
+++ b/testsuite/tests/ppx-attributes/warning.ml
@@ -0,0 +1,51 @@
+(* TEST
+*)
+
+[@@@ocaml.warning "@A"]
+[@@@ocaml.alert "++all"]
+
+(* Fixture *)
+
+module type DEPRECATED = sig end
+[@@ocaml.deprecated]
+
+module T = struct
+  type deprecated
+  [@@ocaml.deprecated]
+end
+
+(* Structure items *)
+
+let _ = let x = 1 in ()
+[@@ocaml.warning "-26"]
+
+include (struct let _ = let x = 1 in () end)
+[@@ocaml.warning "-26"]
+
+module A = struct let _ = let x = 1 in () end
+[@@ocaml.warning "-26"]
+
+module rec B : sig type t end = struct type t = T.deprecated end
+[@@ocaml.alert "-deprecated"]
+
+module type T = sig type t = T.deprecated end
+[@@ocaml.alert "-deprecated"]
+
+(* Signature items *)
+
+module type S = sig
+  val x : T.deprecated
+  [@@ocaml.alert "-deprecated"]
+
+  module AA : sig type t = T.deprecated end
+  [@@ocaml.alert "-deprecated"]
+
+  module rec BB : sig type t = T.deprecated end
+  [@@ocaml.alert "-deprecated"]
+
+  module type T = sig type t = T.deprecated end
+  [@@ocaml.alert "-deprecated"]
+
+  include DEPRECATED
+  [@@ocaml.alert "-deprecated"]
+end
diff --git a/testsuite/tests/ppx-attributes/warning.reference b/testsuite/tests/ppx-attributes/warning.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/ppx-contexts/myppx.ml b/testsuite/tests/ppx-contexts/myppx.ml
new file mode 100644
index 00000000..c1945d20
--- /dev/null
+++ b/testsuite/tests/ppx-contexts/myppx.ml
@@ -0,0 +1,41 @@
+(* A simple PPX *)
+
+open Ast_mapper
+
+let () =
+  let quote_strings li =
+    List.map (Printf.sprintf "%S") li |> String.concat " " in
+  let quote_option = function
+    | None -> "None"
+    | Some s -> Printf.sprintf "Some(%S)" s in
+  register "test" (fun _ ->
+      Printf.eprintf "<ppx-context>\n";
+      Printf.eprintf "tool_name: %S\n"
+        (tool_name ());
+      (*
+         (* Note: we do not test include_dirs, load_path
+            as they produce non-portable paths *)
+      Printf.eprintf "include_dirs: [%s]\n"
+        (quote_strings !Clflags.include_dirs);
+      Printf.eprintf "load_path: [%s]\n"
+        (quote_strings !Config.load_path);
+      *)
+      Printf.eprintf "open_modules: [%s]\n"
+        (quote_strings !Clflags.open_modules);
+      Printf.eprintf "for_package: %S\n"
+        (quote_option !Clflags.for_package);
+      Printf.eprintf "use_debug: %B\n"
+        !Clflags.debug;
+      Printf.eprintf "use_threads: %B\n"
+        !Clflags.use_threads;
+      Printf.eprintf "recursive_types: %B\n"
+        !Clflags.recursive_types;
+      Printf.eprintf "principal: %B\n"
+        !Clflags.principal;
+      Printf.eprintf "transparent_modules: %B\n"
+        !Clflags.transparent_modules;
+      Printf.eprintf "unboxed_types: %B\n"
+        !Clflags.unboxed_types;
+      Printf.eprintf "</ppx-context>\n";
+      flush stderr;
+      default_mapper);
diff --git a/testsuite/tests/ppx-contexts/test.compilers.reference b/testsuite/tests/ppx-contexts/test.compilers.reference
new file mode 100644
index 00000000..e28c8597
--- /dev/null
+++ b/testsuite/tests/ppx-contexts/test.compilers.reference
@@ -0,0 +1,22 @@
+<ppx-context>
+tool_name: "ocamlc"
+open_modules: ["List"]
+for_package: "None"
+use_debug: false
+use_threads: true
+recursive_types: true
+principal: true
+transparent_modules: false
+unboxed_types: true
+</ppx-context>
+<ppx-context>
+tool_name: "ocamlc"
+open_modules: []
+for_package: "None"
+use_debug: true
+use_threads: false
+recursive_types: false
+principal: false
+transparent_modules: true
+unboxed_types: false
+</ppx-context>
diff --git a/testsuite/tests/ppx-contexts/test.ml b/testsuite/tests/ppx-contexts/test.ml
new file mode 100644
index 00000000..f348e460
--- /dev/null
+++ b/testsuite/tests/ppx-contexts/test.ml
@@ -0,0 +1,27 @@
+(* TEST
+files = "myppx.ml"
+include ocamlcommon
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+program = "${test_build_directory}/myppx.exe"
+all_modules = "myppx.ml"
+*** ocamlc.byte
+module = "test.ml"
+flags = "-thread \
+         -I ${test_build_directory} \
+         -open List \
+         -rectypes \
+         -principal \
+         -alias-deps \
+         -unboxed-types \
+         -ppx ${program}"
+**** ocamlc.byte
+module = "test.ml"
+flags = "-g \
+         -no-alias-deps \
+         -no-unboxed-types \
+         -ppx ${program}"
+***** check-ocamlc.byte-output
+*)
+
+(* empty *)
diff --git a/testsuite/tests/prim-bigstring/bigstring_access.ml b/testsuite/tests/prim-bigstring/bigstring_access.ml
new file mode 100644
index 00000000..0014de3d
--- /dev/null
+++ b/testsuite/tests/prim-bigstring/bigstring_access.ml
@@ -0,0 +1,121 @@
+(* TEST
+*)
+
+open Bigarray
+type bigstring = (char, int8_unsigned_elt, c_layout) Array1.t
+
+external caml_bigstring_get_16 :
+      bigstring -> int -> int = "%caml_bigstring_get16"
+external caml_bigstring_get_32 :
+      bigstring -> int -> int32 = "%caml_bigstring_get32"
+external caml_bigstring_get_64 :
+      bigstring -> int -> int64 = "%caml_bigstring_get64"
+
+external caml_bigstring_set_16 :
+      bigstring -> int -> int -> unit = "%caml_bigstring_set16"
+external caml_bigstring_set_32 :
+      bigstring -> int -> int32 -> unit = "%caml_bigstring_set32"
+external caml_bigstring_set_64 :
+      bigstring -> int -> int64 -> unit = "%caml_bigstring_set64"
+
+let bigstring_of_string s =
+  let a = Array1.create char c_layout (String.length s) in
+  for i = 0 to String.length s - 1 do
+    a.{i} <- s.[i]
+  done;
+  a
+
+let s = bigstring_of_string (String.make 10 '\x00')
+let empty_s = bigstring_of_string ""
+
+let assert_bound_check2 f v1 v2 =
+  try
+    ignore(f v1 v2);
+    assert false
+  with
+     | Invalid_argument _ -> ()
+
+let assert_bound_check3 f v1 v2 v3 =
+  try
+    ignore(f v1 v2 v3);
+    assert false
+  with
+     | Invalid_argument _ -> ()
+
+let () =
+  assert_bound_check2 caml_bigstring_get_16 s (-1);
+  assert_bound_check2 caml_bigstring_get_16 s 9;
+  assert_bound_check2 caml_bigstring_get_32 s (-1);
+  assert_bound_check2 caml_bigstring_get_32 s 7;
+  assert_bound_check2 caml_bigstring_get_64 s (-1);
+  assert_bound_check2 caml_bigstring_get_64 s 3;
+
+  assert_bound_check3 caml_bigstring_set_16 s (-1) 0;
+  assert_bound_check3 caml_bigstring_set_16 s 9 0;
+  assert_bound_check3 caml_bigstring_set_32 s (-1) 0l;
+  assert_bound_check3 caml_bigstring_set_32 s 7 0l;
+  assert_bound_check3 caml_bigstring_set_64 s (-1) 0L;
+  assert_bound_check3 caml_bigstring_set_64 s 3 0L;
+
+  assert_bound_check2 caml_bigstring_get_16 empty_s 0;
+  assert_bound_check2 caml_bigstring_get_32 empty_s 0;
+  assert_bound_check2 caml_bigstring_get_64 empty_s 0;
+
+  assert_bound_check3 caml_bigstring_set_16 empty_s 0 0;
+  assert_bound_check3 caml_bigstring_set_32 empty_s 0 0l;
+  assert_bound_check3 caml_bigstring_set_64 empty_s 0 0L
+
+external bswap16: int -> int = "%bswap16"
+external bswap32: int32 -> int32 = "%bswap_int32"
+external bswap64: int64 -> int64 = "%bswap_int64"
+
+let swap16 x =
+  if Sys.big_endian
+  then bswap16 x
+  else x
+
+let swap32 x =
+  if Sys.big_endian
+  then bswap32 x
+  else x
+
+let swap64 x =
+  if Sys.big_endian
+  then bswap64 x
+  else x
+
+let () =
+  caml_bigstring_set_16 s 0 (swap16 0x1234);
+  Printf.printf "%x %x %x\n%!"
+                (swap16 (caml_bigstring_get_16 s 0))
+                (swap16 (caml_bigstring_get_16 s 1))
+                (swap16 (caml_bigstring_get_16 s 2));
+  caml_bigstring_set_16 s 0 (swap16 0xFEDC);
+  Printf.printf "%x %x %x\n%!"
+                (swap16 (caml_bigstring_get_16 s 0))
+                (swap16 (caml_bigstring_get_16 s 1))
+                (swap16 (caml_bigstring_get_16 s 2))
+
+let () =
+  caml_bigstring_set_32 s 0 (swap32 0x12345678l);
+  Printf.printf "%lx %lx %lx\n%!"
+                (swap32 (caml_bigstring_get_32 s 0))
+                (swap32 (caml_bigstring_get_32 s 1))
+                (swap32 (caml_bigstring_get_32 s 2));
+  caml_bigstring_set_32 s 0 (swap32 0xFEDCBA09l);
+  Printf.printf "%lx %lx %lx\n%!"
+                (swap32 (caml_bigstring_get_32 s 0))
+                (swap32 (caml_bigstring_get_32 s 1))
+                (swap32 (caml_bigstring_get_32 s 2))
+
+let () =
+  caml_bigstring_set_64 s 0 (swap64 0x1234567890ABCDEFL);
+  Printf.printf "%Lx %Lx %Lx\n%!"
+                (swap64 (caml_bigstring_get_64 s 0))
+                (swap64 (caml_bigstring_get_64 s 1))
+                (swap64 (caml_bigstring_get_64 s 2));
+  caml_bigstring_set_64 s 0 (swap64 0xFEDCBA0987654321L);
+  Printf.printf "%Lx %Lx %Lx\n%!"
+                (swap64 (caml_bigstring_get_64 s 0))
+                (swap64 (caml_bigstring_get_64 s 1))
+                (swap64 (caml_bigstring_get_64 s 2))
diff --git a/testsuite/tests/prim-bigstring/bigstring_access.reference b/testsuite/tests/prim-bigstring/bigstring_access.reference
new file mode 100644
index 00000000..22b25add
--- /dev/null
+++ b/testsuite/tests/prim-bigstring/bigstring_access.reference
@@ -0,0 +1,6 @@
+1234 12 0
+fedc fe 0
+12345678 123456 1234
+fedcba09 fedcba fedc
+1234567890abcdef 1234567890abcd 1234567890ab
+fedcba0987654321 fedcba09876543 fedcba098765
diff --git a/testsuite/tests/prim-bigstring/string_access.ml b/testsuite/tests/prim-bigstring/string_access.ml
new file mode 100644
index 00000000..82c32f2f
--- /dev/null
+++ b/testsuite/tests/prim-bigstring/string_access.ml
@@ -0,0 +1,108 @@
+(* TEST
+*)
+
+external caml_bytes_get_16 : bytes -> int -> int = "%caml_bytes_get16"
+external caml_bytes_get_32 : bytes -> int -> int32 = "%caml_bytes_get32"
+external caml_bytes_get_64 : bytes -> int -> int64 = "%caml_bytes_get64"
+
+external caml_bytes_set_16 : bytes -> int -> int -> unit =
+  "%caml_bytes_set16"
+external caml_bytes_set_32 : bytes -> int -> int32 -> unit =
+  "%caml_bytes_set32"
+external caml_bytes_set_64 : bytes -> int -> int64 -> unit =
+  "%caml_bytes_set64"
+
+let s = Bytes.make 10 '\x00'
+let empty_s = Bytes.create 0
+
+let assert_bound_check2 f v1 v2 =
+  try
+    ignore(f v1 v2);
+    assert false
+  with
+     | Invalid_argument _ -> ()
+
+let assert_bound_check3 f v1 v2 v3 =
+  try
+    ignore(f v1 v2 v3);
+    assert false
+  with
+     | Invalid_argument _ -> ()
+
+let () =
+  assert_bound_check2 caml_bytes_get_16 s (-1);
+  assert_bound_check2 caml_bytes_get_16 s 9;
+  assert_bound_check2 caml_bytes_get_32 s (-1);
+  assert_bound_check2 caml_bytes_get_32 s 7;
+  assert_bound_check2 caml_bytes_get_64 s (-1);
+  assert_bound_check2 caml_bytes_get_64 s 3;
+
+  assert_bound_check3 caml_bytes_set_16 s (-1) 0;
+  assert_bound_check3 caml_bytes_set_16 s 9 0;
+  assert_bound_check3 caml_bytes_set_32 s (-1) 0l;
+  assert_bound_check3 caml_bytes_set_32 s 7 0l;
+  assert_bound_check3 caml_bytes_set_64 s (-1) 0L;
+  assert_bound_check3 caml_bytes_set_64 s 3 0L;
+
+  assert_bound_check2 caml_bytes_get_16 empty_s 0;
+  assert_bound_check2 caml_bytes_get_32 empty_s 0;
+  assert_bound_check2 caml_bytes_get_64 empty_s 0;
+
+  assert_bound_check3 caml_bytes_set_16 empty_s 0 0;
+  assert_bound_check3 caml_bytes_set_32 empty_s 0 0l;
+  assert_bound_check3 caml_bytes_set_64 empty_s 0 0L
+
+external bswap16: int -> int = "%bswap16"
+external bswap32: int32 -> int32 = "%bswap_int32"
+external bswap64: int64 -> int64 = "%bswap_int64"
+
+let swap16 x =
+  if Sys.big_endian
+  then bswap16 x
+  else x
+
+let swap32 x =
+  if Sys.big_endian
+  then bswap32 x
+  else x
+
+let swap64 x =
+  if Sys.big_endian
+  then bswap64 x
+  else x
+
+let () =
+  caml_bytes_set_16 s 0 (swap16 0x1234);
+  Printf.printf "%x %x %x\n%!"
+                (swap16 (caml_bytes_get_16 s 0))
+                (swap16 (caml_bytes_get_16 s 1))
+                (swap16 (caml_bytes_get_16 s 2));
+  caml_bytes_set_16 s 0 (swap16 0xFEDC);
+  Printf.printf "%x %x %x\n%!"
+                (swap16 (caml_bytes_get_16 s 0))
+                (swap16 (caml_bytes_get_16 s 1))
+                (swap16 (caml_bytes_get_16 s 2))
+
+let () =
+  caml_bytes_set_32 s 0 (swap32 0x12345678l);
+  Printf.printf "%lx %lx %lx\n%!"
+                (swap32 (caml_bytes_get_32 s 0))
+                (swap32 (caml_bytes_get_32 s 1))
+                (swap32 (caml_bytes_get_32 s 2));
+  caml_bytes_set_32 s 0 (swap32 0xFEDCBA09l);
+  Printf.printf "%lx %lx %lx\n%!"
+                (swap32 (caml_bytes_get_32 s 0))
+                (swap32 (caml_bytes_get_32 s 1))
+                (swap32 (caml_bytes_get_32 s 2))
+
+let () =
+  caml_bytes_set_64 s 0 (swap64 0x1234567890ABCDEFL);
+  Printf.printf "%Lx %Lx %Lx\n%!"
+                (swap64 (caml_bytes_get_64 s 0))
+                (swap64 (caml_bytes_get_64 s 1))
+                (swap64 (caml_bytes_get_64 s 2));
+  caml_bytes_set_64 s 0 (swap64 0xFEDCBA0987654321L);
+  Printf.printf "%Lx %Lx %Lx\n%!"
+                (swap64 (caml_bytes_get_64 s 0))
+                (swap64 (caml_bytes_get_64 s 1))
+                (swap64 (caml_bytes_get_64 s 2))
diff --git a/testsuite/tests/prim-bigstring/string_access.reference b/testsuite/tests/prim-bigstring/string_access.reference
new file mode 100644
index 00000000..22b25add
--- /dev/null
+++ b/testsuite/tests/prim-bigstring/string_access.reference
@@ -0,0 +1,6 @@
+1234 12 0
+fedc fe 0
+12345678 123456 1234
+fedcba09 fedcba fedc
+1234567890abcdef 1234567890abcd 1234567890ab
+fedcba0987654321 fedcba09876543 fedcba098765
diff --git a/testsuite/tests/prim-bswap/bswap.ml b/testsuite/tests/prim-bswap/bswap.ml
new file mode 100644
index 00000000..7ab822c7
--- /dev/null
+++ b/testsuite/tests/prim-bswap/bswap.ml
@@ -0,0 +1,20 @@
+(* TEST
+*)
+
+open Printf
+
+external bswap16: int -> int = "%bswap16"
+external bswap32: int32 -> int32 = "%bswap_int32"
+external bswap64: int64 -> int64 = "%bswap_int64"
+
+let d16 = [0x11223344;
+           0x0000f0f0]
+let d32 = [0x11223344l;
+           0xf0f0f0f0l]
+let d64 = [0x1122334455667788L;
+           0xf0f0f0f0f0f0f0f0L]
+
+let _ =
+  List.iter (fun x -> printf "%x\n" (bswap16 x)) d16;
+  List.iter (fun x -> printf "%lx\n" (bswap32 x)) d32;
+  List.iter (fun x -> printf "%Lx\n" (bswap64 x)) d64
diff --git a/testsuite/tests/prim-bswap/bswap.reference b/testsuite/tests/prim-bswap/bswap.reference
new file mode 100644
index 00000000..c08abb7f
--- /dev/null
+++ b/testsuite/tests/prim-bswap/bswap.reference
@@ -0,0 +1,6 @@
+4433
+f0f0
+44332211
+f0f0f0f0
+8877665544332211
+f0f0f0f0f0f0f0f0
diff --git a/testsuite/tests/prim-revapply/apply.ml b/testsuite/tests/prim-revapply/apply.ml
new file mode 100644
index 00000000..4f947d97
--- /dev/null
+++ b/testsuite/tests/prim-revapply/apply.ml
@@ -0,0 +1,39 @@
+(* TEST
+*)
+
+external ( @@ ) :  ('a -> 'b) -> 'a -> 'b = "%apply"
+
+let f x = x + x
+let g x = x * x
+let h x = x + 1
+let add x y = x + y
+
+let _ =
+  List.iter (fun x ->
+    print_int x; print_newline ()
+  )
+    [
+      f @@ 3; (* 6 *)
+      g @@ f @@ 3; (* 36 *)
+      f @@ g @@ 3; (* 18 *)
+      h @@ g @@ f @@ 3; (* 37 *)
+      add 4 @@ g @@ f @@ add 3 @@ add 2 @@ 3; (* 260 *)
+    ]
+external ( @@ ) :  ('a -> 'b) -> 'a -> 'b = "%apply"
+
+let f x = x + x
+let g x = x * x
+let h x = x + 1
+let add x y = x + y
+
+let _ =
+  List.iter (fun x ->
+    print_int x; print_newline ()
+  )
+    [
+      f @@ 3; (* 6 *)
+      g @@ f @@ 3; (* 36 *)
+      f @@ g @@ 3; (* 18 *)
+      h @@ g @@ f @@ 3; (* 37 *)
+      add 4 @@ g @@ f @@ add 3 @@ add 2 @@ 3; (* 260 *)
+    ]
diff --git a/testsuite/tests/prim-revapply/apply.reference b/testsuite/tests/prim-revapply/apply.reference
new file mode 100644
index 00000000..07fc0dc4
--- /dev/null
+++ b/testsuite/tests/prim-revapply/apply.reference
@@ -0,0 +1,10 @@
+6
+36
+18
+37
+260
+6
+36
+18
+37
+260
diff --git a/testsuite/tests/prim-revapply/revapply.ml b/testsuite/tests/prim-revapply/revapply.ml
new file mode 100644
index 00000000..32435562
--- /dev/null
+++ b/testsuite/tests/prim-revapply/revapply.ml
@@ -0,0 +1,21 @@
+(* TEST
+*)
+
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+
+let f x = x + x
+let g x = x * x
+let h x = x + 1
+let add x y = x + y
+
+let _ =
+  List.iter (fun x ->
+    print_int x; print_newline ()
+  )
+    [
+      3 |> f; (* 6 *)
+      3 |> f |> g; (* 36 *)
+      3 |> g |> f; (* 18 *)
+      3 |> f |> g |> h; (* 37 *)
+      3 |> add 2 |> add 3 |> f |> g |> add 4; (* 260 *)
+    ]
diff --git a/testsuite/tests/prim-revapply/revapply.reference b/testsuite/tests/prim-revapply/revapply.reference
new file mode 100644
index 00000000..fbca4428
--- /dev/null
+++ b/testsuite/tests/prim-revapply/revapply.reference
@@ -0,0 +1,5 @@
+6
+36
+18
+37
+260
diff --git a/testsuite/tests/printing-types/disambiguation.ml b/testsuite/tests/printing-types/disambiguation.ml
new file mode 100644
index 00000000..24c431a1
--- /dev/null
+++ b/testsuite/tests/printing-types/disambiguation.ml
@@ -0,0 +1,42 @@
+(* TEST
+   * expect
+*)
+
+type 'a x = private [> `x] as 'a;;
+[%%expect {|
+Line 1:
+Error: Type declarations do not match:
+         type 'a x = private [> `x ] constraint 'a = 'a x
+       is not included in
+         type 'a x
+       Their constraints differ.
+|}, Principal{|
+Line 1:
+Error: Type declarations do not match:
+         type 'a x = private 'a constraint 'a = [> `x ]
+       is not included in
+         type 'a x
+       Their constraints differ.
+|}];;
+
+
+type int;;
+[%%expect {|
+type int
+|}];;
+
+let x = 0;;
+[%%expect {|
+val x : int/2 = 0
+|}];;
+
+
+type float;;
+[%%expect {|
+type float
+|}];;
+
+0.;;
+[%%expect {|
+- : float/2 = 0.
+|}];;
diff --git a/testsuite/tests/printing-types/pr248.ml b/testsuite/tests/printing-types/pr248.ml
new file mode 100644
index 00000000..25d39726
--- /dev/null
+++ b/testsuite/tests/printing-types/pr248.ml
@@ -0,0 +1,17 @@
+(* TEST
+   * toplevel
+*)
+
+(** Test that weak variables keep their names long enough *)
+
+let f y = fun x -> x
+let blah = f 0
+let splash () = blah (failwith "coucou")
+let blurp = f 0;;
+
+blah 1;;
+
+let g = f ();;
+
+g (fun x -> x);;
+let h = g (f ());;
diff --git a/testsuite/tests/printing-types/pr248.ocaml.reference b/testsuite/tests/printing-types/pr248.ocaml.reference
new file mode 100644
index 00000000..acae2728
--- /dev/null
+++ b/testsuite/tests/printing-types/pr248.ocaml.reference
@@ -0,0 +1,9 @@
+val f : 'a -> 'b -> 'b = <fun>
+val blah : '_weak1 -> '_weak1 = <fun>
+val splash : unit -> '_weak1 = <fun>
+val blurp : '_weak2 -> '_weak2 = <fun>
+- : int = 1
+val g : '_weak3 -> '_weak3 = <fun>
+- : '_weak4 -> '_weak4 = <fun>
+val h : '_weak4 -> '_weak4 = <fun>
+
diff --git a/testsuite/tests/raise-counts/a.ml b/testsuite/tests/raise-counts/a.ml
new file mode 100644
index 00000000..323fe2af
--- /dev/null
+++ b/testsuite/tests/raise-counts/a.ml
@@ -0,0 +1,12 @@
+let _unused _ = try () with _ -> ()
+
+let trigger_bug x =
+  let ok =
+    match x with
+    | None
+    | Some "" -> true
+    | Some _ -> false
+  in
+  if x = Some "" && not ok then
+    failwith "impossible"
+[@@inline always]
diff --git a/testsuite/tests/raise-counts/b.ml b/testsuite/tests/raise-counts/b.ml
new file mode 100644
index 00000000..e346c8b2
--- /dev/null
+++ b/testsuite/tests/raise-counts/b.ml
@@ -0,0 +1 @@
+let bug x = A.trigger_bug x
diff --git a/testsuite/tests/raise-counts/main.ml b/testsuite/tests/raise-counts/main.ml
new file mode 100644
index 00000000..b881b832
--- /dev/null
+++ b/testsuite/tests/raise-counts/main.ml
@@ -0,0 +1,9 @@
+(* TEST
+  modules = "a.ml b.ml"
+*)
+
+(* PR#7702 *)
+
+let () =
+  B.bug (Some "");
+  print_endline "OK."
diff --git a/testsuite/tests/raise-counts/main.reference b/testsuite/tests/raise-counts/main.reference
new file mode 100644
index 00000000..d5c32f4a
--- /dev/null
+++ b/testsuite/tests/raise-counts/main.reference
@@ -0,0 +1 @@
+OK.
diff --git a/testsuite/tests/regression/gpr1623/gpr1623.ml b/testsuite/tests/regression/gpr1623/gpr1623.ml
new file mode 100644
index 00000000..80f84452
--- /dev/null
+++ b/testsuite/tests/regression/gpr1623/gpr1623.ml
@@ -0,0 +1,15 @@
+(* TEST
+  arguments = "???"
+  *)
+
+(* On Windows the runtime expand windows wildcards (asterisks and
+ * question marks).
+ *
+ * This file is a non-regression test for github's PR#1623.
+ *
+ * On Windows 64bits, a segfault was triggered when one argument consists
+ * only of wildcards.
+ *
+ * The source code of this test is empty: we just check the arguments
+ * expansion.
+ * *)
diff --git a/testsuite/tests/regression/gpr1623/gpr1623.reference b/testsuite/tests/regression/gpr1623/gpr1623.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/regression/missing_set_of_closures/a.ml b/testsuite/tests/regression/missing_set_of_closures/a.ml
new file mode 100644
index 00000000..c675669d
--- /dev/null
+++ b/testsuite/tests/regression/missing_set_of_closures/a.ml
@@ -0,0 +1,9 @@
+module type Ret = sig
+  val g : int -> int -> int
+end
+
+module F() : Ret = struct
+  let n = Sys.opaque_identity 42
+  let rec f = ((fun x -> x + n) [@inline never])
+  and g = ((fun x -> f) [@inline])
+end [@@inline never]
diff --git a/testsuite/tests/regression/missing_set_of_closures/b.ml b/testsuite/tests/regression/missing_set_of_closures/b.ml
new file mode 100644
index 00000000..e510a50c
--- /dev/null
+++ b/testsuite/tests/regression/missing_set_of_closures/b.ml
@@ -0,0 +1,4 @@
+
+let g =
+  let module X = A.F() in
+  X.g
diff --git a/testsuite/tests/regression/missing_set_of_closures/b2.ml b/testsuite/tests/regression/missing_set_of_closures/b2.ml
new file mode 100644
index 00000000..5436467a
--- /dev/null
+++ b/testsuite/tests/regression/missing_set_of_closures/b2.ml
@@ -0,0 +1,2 @@
+
+let f = B.g 3
diff --git a/testsuite/tests/regression/missing_set_of_closures/dir/c.ml b/testsuite/tests/regression/missing_set_of_closures/dir/c.ml
new file mode 100644
index 00000000..e2ce54fe
--- /dev/null
+++ b/testsuite/tests/regression/missing_set_of_closures/dir/c.ml
@@ -0,0 +1,2 @@
+
+let f = B2.f
diff --git a/testsuite/tests/regression/missing_set_of_closures/missing_set_of_closures.ml b/testsuite/tests/regression/missing_set_of_closures/missing_set_of_closures.ml
new file mode 100644
index 00000000..3d3f9916
--- /dev/null
+++ b/testsuite/tests/regression/missing_set_of_closures/missing_set_of_closures.ml
@@ -0,0 +1,22 @@
+(* TEST
+files = "a.ml b.ml b2.ml"
+* setup-ocamlopt.byte-build-env
+** script
+script = "mkdir -p dir"
+*** script
+script = "cp ${test_source_directory}/dir/c.ml dir/"
+**** ocamlopt.byte
+module = "a.ml"
+***** ocamlopt.byte
+module = "b.ml"
+****** ocamlopt.byte
+module = "b2.ml"
+******* script
+script = "cp b.cmx b.cmi b2.cmx b2.cmi dir/"
+******** cd
+cwd = "dir"
+********* ocamlopt.byte
+module = "c.ml"
+flags = "-w -58"
+********** check-ocamlopt.byte-output
+*)
diff --git a/testsuite/tests/regression/pr1580/pr1580.ml b/testsuite/tests/regression/pr1580/pr1580.ml
new file mode 100644
index 00000000..bbe76848
--- /dev/null
+++ b/testsuite/tests/regression/pr1580/pr1580.ml
@@ -0,0 +1,56 @@
+(* TEST *)
+
+(* This function uses a ref initially holding an immediate (None),
+   which is later mutated to hold a pointer (Some ...). Despite
+   initially holding an immediate, the register used must be marked
+   in the frametable.
+
+   This was previously done by distinguishing Const_pointer (values
+   like None from a type that also contains pointers) from Const_int
+   (values like 0 from a type that contains no pointers), but is
+   now done by preserving typing information about the ref. *)
+
+let no_magic b =
+  let r = ref None in
+  for i = 1 to 10 do
+    let z = if b then !r else None in
+    Gc.minor ();
+    r := Some (String.make i '.');
+    (match z with None -> () | Some s -> print_endline s)
+  done
+
+
+(* This version is the same, except uses Obj.magic 0 instead of None.
+   This segfaulted when the Const_pointer / Const_int distinction
+   was used for register typing, as Obj.magic 0 is a Const_int *)
+
+let light_magic b =
+  let none = (Obj.magic 0 : string option) in
+  let r = ref none in
+  for i = 1 to 10 do
+    let z = if b then !r else none in
+    Gc.minor ();
+    r := Some (String.make i '.');
+    (match z with None -> () | Some s -> print_endline s)
+  done
+
+
+(* This version stores references to heap values inside an `int ref`,
+   which is eliminated and the resulting register is not marked in
+   the frametable. This is not expected to work, segfaults on all
+   versions, and is included here only to document what not to do. *)
+
+let dark_magic b =
+  let none = 0 in
+  let r = ref 0 in
+  for i = 1 to 10 do
+    let z : string option = Obj.magic (if b then !r else none) in
+    Gc.minor ();
+    r := Obj.magic (Some (String.make i '.'));
+    (match z with None -> () | Some s -> print_endline s)
+  done
+
+
+let () =
+  Sys.opaque_identity no_magic true;
+  Sys.opaque_identity light_magic true
diff --git a/testsuite/tests/regression/pr1580/pr1580.reference b/testsuite/tests/regression/pr1580/pr1580.reference
new file mode 100644
index 00000000..51e38e53
--- /dev/null
+++ b/testsuite/tests/regression/pr1580/pr1580.reference
@@ -0,0 +1,18 @@
+.
+..
+...
+....
+.....
+......
+.......
+........
+.........
+.
+..
+...
+....
+.....
+......
+.......
+........
+.........
diff --git a/testsuite/tests/regression/pr3612/custom_finalize.c b/testsuite/tests/regression/pr3612/custom_finalize.c
new file mode 100644
index 00000000..5b9dc3d8
--- /dev/null
+++ b/testsuite/tests/regression/pr3612/custom_finalize.c
@@ -0,0 +1,66 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*                        Pierre Chambart, OCamlPro                       */
+/*                                                                        */
+/*   Copyright 2014 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/custom.h>
+
+static int free_counter = 0;
+static int alloc_counter = 0;
+
+static void caml_test_finalize(value v)
+{
+  free_counter++;
+}
+
+static void caml_test_serialize(value v,
+                                uintnat * wsize_32,
+                                uintnat * wsize_64)
+{
+  *wsize_32 = 0;
+  *wsize_64 = 0;
+}
+
+uintnat caml_test_deserialize(void * dst)
+{
+  alloc_counter++;
+  return 0;
+}
+
+static struct custom_operations caml_test_ops = {
+  "_test",
+  caml_test_finalize,
+  custom_compare_default,
+  custom_hash_default,
+  caml_test_serialize,
+  caml_test_deserialize,
+  custom_compare_ext_default,
+  custom_fixed_length_default
+};
+
+value caml_test_pr3612_alloc(value unit)
+{
+  return caml_alloc_custom(&caml_test_ops, 0, 0, 1);
+}
+
+value caml_test_pr3612_counter(value unit)
+{
+  return Val_int(alloc_counter-free_counter);
+}
+
+CAMLprim value caml_test_pr3612_init(value unit)
+{
+  caml_register_custom_operations(&caml_test_ops);
+  return Val_unit;
+}
diff --git a/testsuite/tests/regression/pr3612/pr3612.ml b/testsuite/tests/regression/pr3612/pr3612.ml
new file mode 100644
index 00000000..c2ca8dbb
--- /dev/null
+++ b/testsuite/tests/regression/pr3612/pr3612.ml
@@ -0,0 +1,25 @@
+(* TEST
+   modules = "custom_finalize.c"
+*)
+
+type t
+
+external test_alloc : unit -> t = "caml_test_pr3612_alloc"
+external get_counter : unit -> int = "caml_test_pr3612_counter"
+(* The number of deserialized blocks minus the number of freed blocks *)
+
+external init : unit -> unit = "caml_test_pr3612_init"
+
+let test s =
+  for i = 0 to 1_000_000 do
+    ignore (Marshal.from_string s 0)
+  done
+
+let f () =
+  init ();
+  let s = Marshal.to_string (test_alloc ()) [] in
+  test s;
+  Gc.full_major ();
+  print_int (get_counter ());
+  print_newline ()
+let () = (f [@inlined never]) ()
diff --git a/testsuite/tests/regression/pr3612/pr3612.reference b/testsuite/tests/regression/pr3612/pr3612.reference
new file mode 100644
index 00000000..3a2e3f49
--- /dev/null
+++ b/testsuite/tests/regression/pr3612/pr3612.reference
@@ -0,0 +1 @@
+-1
diff --git a/testsuite/tests/regression/pr5233/pr5233.ml b/testsuite/tests/regression/pr5233/pr5233.ml
new file mode 100644
index 00000000..05fe6872
--- /dev/null
+++ b/testsuite/tests/regression/pr5233/pr5233.ml
@@ -0,0 +1,55 @@
+(* TEST *)
+
+open Printf;;
+
+(* PR#5233: Create a dangling pointer and use it to access random parts
+   of the heap. *)
+
+(* The buggy weak array will end up in smuggle. *)
+let smuggle = ref (Weak.create 1);;
+
+(* This will be the weak array (W). *)
+let t = ref (Weak.create 1);;
+
+(* Set a finalisation function on W. *)
+Gc.finalise (fun w -> smuggle := w) !t;;
+
+(* Free W and run its finalisation function. *)
+t := Weak.create 1;;
+Gc.full_major ();;
+
+(* smuggle now contains W, whose pointers are not erased, even
+   when the contents is deallocated. *)
+
+let size = 1_000_000;;
+
+let check o =
+  printf "checking...";
+  match o with
+  | None -> printf " no value\n";
+  | Some s ->
+     printf " value found  /  testing...";
+     for i = 0 to size - 1 do
+       if s.[i] != ' ' then failwith "bad";
+     done;
+     printf " ok\n";
+;;
+
+let f () =
+  Weak.set !smuggle 0 (Some (String.make size ' '));
+
+  (* Check the data just to make sure. *)
+  check (Weak.get !smuggle 0);
+
+  (* Get a dangling pointer in W. *)
+  Gc.full_major ();
+
+  (* Fill the heap with other stuff. *)
+  let rec fill n accu = if n = 0 then accu else fill (n-1) (123 :: accu) in
+  let _r : int list = fill ((Gc.stat ()).Gc.heap_words / 3) [] in
+  Gc.minor ();
+
+  (* Now follow the dangling pointer and exhibit the problem. *)
+  check (Weak.get !smuggle 0)
+
+let () = (f [@inlined never]) ()
diff --git a/testsuite/tests/regression/pr5233/pr5233.reference b/testsuite/tests/regression/pr5233/pr5233.reference
new file mode 100644
index 00000000..ef728f63
--- /dev/null
+++ b/testsuite/tests/regression/pr5233/pr5233.reference
@@ -0,0 +1,2 @@
+checking... value found  /  testing... ok
+checking... no value
diff --git a/testsuite/tests/regression/pr5757/pr5757.ml b/testsuite/tests/regression/pr5757/pr5757.ml
new file mode 100644
index 00000000..18cc6db1
--- /dev/null
+++ b/testsuite/tests/regression/pr5757/pr5757.ml
@@ -0,0 +1,7 @@
+(* TEST *)
+
+Random.init 3;;
+for i = 0 to 100_000 do
+  ignore (Bytes.create (Random.int 1_000_000))
+done;;
+Printf.printf "hello world\n";;
diff --git a/testsuite/tests/regression/pr5757/pr5757.reference b/testsuite/tests/regression/pr5757/pr5757.reference
new file mode 100644
index 00000000..3b18e512
--- /dev/null
+++ b/testsuite/tests/regression/pr5757/pr5757.reference
@@ -0,0 +1 @@
+hello world
diff --git a/testsuite/tests/regression/pr6024/pr6024.ml b/testsuite/tests/regression/pr6024/pr6024.ml
new file mode 100644
index 00000000..2811c84b
--- /dev/null
+++ b/testsuite/tests/regression/pr6024/pr6024.ml
@@ -0,0 +1,3 @@
+(* TEST *)
+
+Format.printf "@[%@-@@-@]@.";;
diff --git a/testsuite/tests/regression/pr6024/pr6024.reference b/testsuite/tests/regression/pr6024/pr6024.reference
new file mode 100644
index 00000000..67182723
--- /dev/null
+++ b/testsuite/tests/regression/pr6024/pr6024.reference
@@ -0,0 +1 @@
+@-@-
diff --git a/testsuite/tests/regression/pr7042/pr7042.ml b/testsuite/tests/regression/pr7042/pr7042.ml
new file mode 100644
index 00000000..ab908e7e
--- /dev/null
+++ b/testsuite/tests/regression/pr7042/pr7042.ml
@@ -0,0 +1,6 @@
+(* TEST *)
+
+let _ =
+  let a = [| 0.0; -. 0.0 |] in
+  Printf.printf "%Lx %Lx\n"
+                (Int64.bits_of_float a.(0)) (Int64.bits_of_float a.(1))
diff --git a/testsuite/tests/regression/pr7042/pr7042.reference b/testsuite/tests/regression/pr7042/pr7042.reference
new file mode 100644
index 00000000..c6a412a4
--- /dev/null
+++ b/testsuite/tests/regression/pr7042/pr7042.reference
@@ -0,0 +1 @@
+0 8000000000000000
diff --git a/testsuite/tests/regression/pr7426/pr7426.ml b/testsuite/tests/regression/pr7426/pr7426.ml
new file mode 100644
index 00000000..4f0ee318
--- /dev/null
+++ b/testsuite/tests/regression/pr7426/pr7426.ml
@@ -0,0 +1,3 @@
+(* TEST *)
+
+class some_class = object val some_val = 0.0 end
diff --git a/testsuite/tests/regression/pr7426/pr7426.reference b/testsuite/tests/regression/pr7426/pr7426.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/regression/pr7718/pr7718.ml b/testsuite/tests/regression/pr7718/pr7718.ml
new file mode 100644
index 00000000..ac4397da
--- /dev/null
+++ b/testsuite/tests/regression/pr7718/pr7718.ml
@@ -0,0 +1,37 @@
+(* TEST *)
+
+let go () =
+  Gc.full_major ();
+  for i = 1 to 10_000 do
+  let rec b =
+    let x = (b, b) in
+    (* Force the above allocation to be live across a GC,
+       by allocating a large enough object that the allocations
+       cannot be combined. *)
+    let x = [| x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x; x; x; x; x; x; x; x; x; x; x; x; x; x; x; x;
+               x |] in
+    let _y = ref x in
+    42 in
+    ignore (Sys.opaque_identity b);
+    ()
+  done;
+  ()
+
+let _ =
+  let _ = go () in
+  print_endline "ok"
diff --git a/testsuite/tests/regression/pr7718/pr7718.reference b/testsuite/tests/regression/pr7718/pr7718.reference
new file mode 100644
index 00000000..9766475a
--- /dev/null
+++ b/testsuite/tests/regression/pr7718/pr7718.reference
@@ -0,0 +1 @@
+ok
diff --git a/testsuite/tests/regression/pr7798/pr7798.ml b/testsuite/tests/regression/pr7798/pr7798.ml
new file mode 100644
index 00000000..a91b4dc2
--- /dev/null
+++ b/testsuite/tests/regression/pr7798/pr7798.ml
@@ -0,0 +1,57 @@
+(* TEST
+   * bytecode
+   * native
+   * native
+     ocamlopt_flags = "-compact"
+*)
+
+type mut2 = { mutable p: int; mutable q:int }
+type mut3 = { mutable s: int; mutable t:int; mutable u:int }
+
+type mut_record =
+  { mutable a : int;
+    mutable b : int;
+    mutable c : int;
+    mutable d : int;
+    mutable e : int;
+    mutable f : int; }
+
+let go () =
+  let pre_before = Gc.minor_words () in
+  let before = Gc.minor_words () in
+  let alloc_per_minor_words = int_of_float (before -. pre_before) in
+  if Sys.backend_type = Sys.Native then assert (alloc_per_minor_words = 0);
+  let allocs = ref alloc_per_minor_words in
+  let n = 1_000_000 in
+  for i = 1 to n do
+    Sys.opaque_identity (ref i)
+    |> ignore;
+    allocs := !allocs + 2;
+  done;
+  for i = 1 to n do
+    Sys.opaque_identity { p = i; q = i }
+    |> ignore;
+    allocs := !allocs + 3;
+  done;
+  for i = 1 to n do
+    Sys.opaque_identity { s = i; t = i; u = i }
+    |> ignore;
+    allocs := !allocs + 4;
+  done;
+  for i = 1 to n do
+    Sys.opaque_identity { a = i; b = i; c = i; d = i; e = i; f = i }
+    |> ignore;
+    allocs := !allocs + 7;
+    if i mod (n/3) == 0 then Gc.full_major ();
+  done;
+  for i = 1 to n do
+    Sys.opaque_identity (Array.make 8 i)
+    |> ignore;
+    allocs := !allocs + 9;
+    if i mod (n/3) == 0 then Gc.compact ();
+  done;
+  let after = Gc.minor_words () in
+  let measured_allocs = int_of_float (after -. before) - alloc_per_minor_words in
+  Printf.printf "%d\n" (measured_allocs - !allocs)
+
+let () = go ()
diff --git a/testsuite/tests/regression/pr7798/pr7798.reference b/testsuite/tests/regression/pr7798/pr7798.reference
new file mode 100644
index 00000000..573541ac
--- /dev/null
+++ b/testsuite/tests/regression/pr7798/pr7798.reference
@@ -0,0 +1 @@
+0
diff --git a/testsuite/tests/regression/pr7920/pr7920.ml b/testsuite/tests/regression/pr7920/pr7920.ml
new file mode 100644
index 00000000..4644b9fa
--- /dev/null
+++ b/testsuite/tests/regression/pr7920/pr7920.ml
@@ -0,0 +1,11 @@
+(* TEST *)
+
+module Z = struct end
+
+module type QSig = sig
+  module Z : sig end
+end
+
+module Q : QSig with module Z = Z = struct
+  module Z = Z
+end
diff --git a/testsuite/tests/regression/pr7920/pr7920.reference b/testsuite/tests/regression/pr7920/pr7920.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/regression/pr8769/fortuna.ml b/testsuite/tests/regression/pr8769/fortuna.ml
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/regression/pr8769/nocrypto.mli b/testsuite/tests/regression/pr8769/nocrypto.mli
new file mode 100644
index 00000000..94301b5a
--- /dev/null
+++ b/testsuite/tests/regression/pr8769/nocrypto.mli
@@ -0,0 +1,3 @@
+module Rng : sig
+  module F : sig end
+end
diff --git a/testsuite/tests/regression/pr8769/pr8769.ml b/testsuite/tests/regression/pr8769/pr8769.ml
new file mode 100644
index 00000000..fa0c73f7
--- /dev/null
+++ b/testsuite/tests/regression/pr8769/pr8769.ml
@@ -0,0 +1,32 @@
+(* TEST
+modules = "nocrypto.mli fortuna.ml rng.ml"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+module = "nocrypto.mli"
+** ocamlc.byte
+flags = "-for-pack Nocrypto"
+module = "fortuna.ml"
+** ocamlc.byte
+flags = "-for-pack Nocrypto"
+module = "rng.ml"
+** ocamlc.byte
+program = "nocrypto.cmo"
+flags = "-pack"
+all_modules = "fortuna.cmo rng.cmo"
+
+* setup-ocamlopt.byte-build-env
+** ocamlopt.byte
+module = "nocrypto.mli"
+** ocamlopt.byte
+flags = "-for-pack Nocrypto"
+module = "fortuna.ml"
+** ocamlopt.byte
+flags = "-for-pack Nocrypto"
+module = "rng.ml"
+** ocamlopt.byte
+program = "nocrypto.cmx"
+flags = "-pack"
+all_modules = "fortuna.cmx rng.cmx"
+
+*)
diff --git a/testsuite/tests/regression/pr8769/rng.ml b/testsuite/tests/regression/pr8769/rng.ml
new file mode 100644
index 00000000..37a77602
--- /dev/null
+++ b/testsuite/tests/regression/pr8769/rng.ml
@@ -0,0 +1 @@
+module F = Fortuna
diff --git a/testsuite/tests/regression/pr9028/pr9028.ml b/testsuite/tests/regression/pr9028/pr9028.ml
new file mode 100644
index 00000000..df28383f
--- /dev/null
+++ b/testsuite/tests/regression/pr9028/pr9028.ml
@@ -0,0 +1,10 @@
+(* TEST *)
+
+let f n = ((n lsl 1) + 1) / 2
+let g n = (n lsl 1) / 2
+let h n = Int64.of_int (n * 2 + 1)
+let i n = Int64.of_int (Int64.to_int n)
+
+let r = Sys.opaque_identity max_int
+let s = Sys.opaque_identity Int64.max_int
+let () = Printf.printf "%d\n%d\n%Ld\n%Ld\n" (f r) (g r) (h r) (i s)
diff --git a/testsuite/tests/regression/pr9028/pr9028.reference b/testsuite/tests/regression/pr9028/pr9028.reference
new file mode 100644
index 00000000..78ea705a
--- /dev/null
+++ b/testsuite/tests/regression/pr9028/pr9028.reference
@@ -0,0 +1,4 @@
+0
+-1
+-1
+-1
diff --git a/testsuite/tests/regression/pr9292/pr9292.ml b/testsuite/tests/regression/pr9292/pr9292.ml
new file mode 100644
index 00000000..cf6a3df9
--- /dev/null
+++ b/testsuite/tests/regression/pr9292/pr9292.ml
@@ -0,0 +1,6 @@
+(* TEST *)
+
+let () =
+  Gc.set { (Gc.get ()) with allocation_policy = 2 };
+  ignore (Array.init 5_000 (fun _ -> Array.make 10_000 0));
+  Gc.full_major ()
diff --git a/testsuite/tests/regression/pr9443/pr9443.ml b/testsuite/tests/regression/pr9443/pr9443.ml
new file mode 100644
index 00000000..8a72cd08
--- /dev/null
+++ b/testsuite/tests/regression/pr9443/pr9443.ml
@@ -0,0 +1,11 @@
+(* TEST *)
+
+(* Test tail call optimisation with an elided mutable cell *)
+let rec loop n =
+  if n = 0 then () else begin
+    let last = ref 0 in
+    last := 0;
+    loop (n-1)
+  end
+
+let () = loop 1_000_000
diff --git a/testsuite/tests/reproducibility/cmis_on_file_system.ml b/testsuite/tests/reproducibility/cmis_on_file_system.ml
new file mode 100644
index 00000000..188fed77
--- /dev/null
+++ b/testsuite/tests/reproducibility/cmis_on_file_system.ml
@@ -0,0 +1,26 @@
+(* TEST
+  files = "cmis_on_file_system.ml cmis_on_file_system_companion.mli"
+  * setup-ocamlc.byte-build-env
+  ** ocamlc.byte
+  compile_only = "true"
+  module = "cmis_on_file_system.ml"
+  flags="-bin-annot"
+  *** script
+  script= "mv cmis_on_file_system.cmt lone.cmt"
+  **** ocamlc.byte
+  module = "cmis_on_file_system_companion.mli"
+  compile_only="true"
+  ***** ocamlc.byte
+  compile_only = "true"
+  flags="-bin-annot"
+  module="cmis_on_file_system.ml"
+  ****** compare-native-programs
+  program="cmis_on_file_system.cmt"
+  program2="lone.cmt"
+*)
+
+
+(** Test that we are not recording the cmis present on the file system
+    at a given point in time *)
+type t = int
+let () = ()
diff --git a/testsuite/tests/reproducibility/cmis_on_file_system_companion.mli b/testsuite/tests/reproducibility/cmis_on_file_system_companion.mli
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/required-external/file.ml b/testsuite/tests/required-external/file.ml
new file mode 100644
index 00000000..f90910a8
--- /dev/null
+++ b/testsuite/tests/required-external/file.ml
@@ -0,0 +1,7 @@
+external getcwd : unit -> string = "caml_sys_getcwd"
+
+let f () = ()
+
+let () =
+  print_endline "Module `File' is linked";
+  flush stdout
diff --git a/testsuite/tests/required-external/main.ml b/testsuite/tests/required-external/main.ml
new file mode 100644
index 00000000..7764b822
--- /dev/null
+++ b/testsuite/tests/required-external/main.ml
@@ -0,0 +1,41 @@
+(* TEST
+modules = "file.ml"
+
+* setup-ocamlc.byte-build-env
+program = "${test_build_directory}/main.exe"
+** ocamlc.byte
+module = "file.ml"
+*** ocamlc.byte
+module = ""
+program = "lib.cma"
+flags = "-a"
+all_modules = "file.cmo"
+**** ocamlc.byte
+program = "${test_build_directory}/main.exe"
+all_modules = "lib.cma main.ml"
+flags = ""
+***** check-ocamlc.byte-output
+****** run
+******* check-program-output
+
+* setup-ocamlopt.byte-build-env
+program = "${test_build_directory}/main.exe"
+** ocamlopt.byte
+module = "file.ml"
+*** ocamlopt.byte
+module = ""
+program = "lib.cmxa"
+flags = "-a"
+all_modules = "file.cmx"
+**** ocamlopt.byte
+program = "${test_build_directory}/main.exe"
+all_modules = "lib.cmxa main.ml"
+flags = ""
+***** check-ocamlopt.byte-output
+****** run
+******* check-program-output
+
+*)
+
+let () =
+  ignore (File.getcwd ())
diff --git a/testsuite/tests/required-external/main.reference b/testsuite/tests/required-external/main.reference
new file mode 100644
index 00000000..12971896
--- /dev/null
+++ b/testsuite/tests/required-external/main.reference
@@ -0,0 +1 @@
+Module `File' is linked
diff --git a/testsuite/tests/runtime-C-exceptions/stub_test.c b/testsuite/tests/runtime-C-exceptions/stub_test.c
new file mode 100644
index 00000000..b7ffd242
--- /dev/null
+++ b/testsuite/tests/runtime-C-exceptions/stub_test.c
@@ -0,0 +1,20 @@
+#include <string.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()
+{
+    return strdup("bar");
+}
+
+CAMLexport value dynamic_invalid_argument(value unit)
+{
+    CAMLparam1(unit);
+    char *dynamic_msg = some_dynamic_string_that_should_be_freed();
+    value msg = caml_copy_string(dynamic_msg);
+    free(dynamic_msg);
+    caml_invalid_argument_value(msg);
+    CAMLnoreturn;
+}
diff --git a/testsuite/tests/runtime-C-exceptions/test.ml b/testsuite/tests/runtime-C-exceptions/test.ml
new file mode 100644
index 00000000..17bf4252
--- /dev/null
+++ b/testsuite/tests/runtime-C-exceptions/test.ml
@@ -0,0 +1,15 @@
+(* TEST
+   modules = "stub_test.c"
+*)
+
+external failwith_from_ocaml : string -> 'a = "caml_failwith_value"
+
+external dynamic_invalid_argument : unit -> 'a = "dynamic_invalid_argument"
+
+let () =
+  try failwith_from_ocaml ("fo" ^ "o")
+  with Failure foo -> print_endline foo
+
+let () =
+  try dynamic_invalid_argument ()
+  with Invalid_argument bar -> print_endline bar
diff --git a/testsuite/tests/runtime-C-exceptions/test.reference b/testsuite/tests/runtime-C-exceptions/test.reference
new file mode 100644
index 00000000..3bd1f0e2
--- /dev/null
+++ b/testsuite/tests/runtime-C-exceptions/test.reference
@@ -0,0 +1,2 @@
+foo
+bar
diff --git a/testsuite/tests/runtime-errors/has-stackoverflow-detection.sh b/testsuite/tests/runtime-errors/has-stackoverflow-detection.sh
new file mode 100644
index 00000000..a71c9762
--- /dev/null
+++ b/testsuite/tests/runtime-errors/has-stackoverflow-detection.sh
@@ -0,0 +1,8 @@
+#!/bin/sh
+if grep -q "#define HAS_STACK_OVERFLOW_DETECTION" ${ocamlsrcdir}/runtime/caml/s.h; then
+  test_result=${TEST_PASS};
+else
+  test_result=${TEST_SKIP};
+fi
+
+exit ${test_result}
diff --git a/testsuite/tests/runtime-errors/stackoverflow.ml b/testsuite/tests/runtime-errors/stackoverflow.ml
new file mode 100644
index 00000000..82c1c25a
--- /dev/null
+++ b/testsuite/tests/runtime-errors/stackoverflow.ml
@@ -0,0 +1,50 @@
+(* TEST
+
+flags = "-w a"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** run
+**** check-program-output
+
+* libwin32unix
+** setup-ocamlopt.byte-build-env
+*** ocamlopt.byte
+**** run
+***** check-program-output
+
+* libunix
+** script
+script = "sh ${test_source_directory}/has-stackoverflow-detection.sh"
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+***** run
+****** check-program-output
+
+*)
+
+let rec f x =
+  if not (x = 0 || x = 10000 || x = 20000)
+  then 1 + f (x + 1)
+  else
+    try
+      1 + f (x + 1)
+    with Stack_overflow ->
+      print_string "x = "; print_int x; print_newline();
+      raise Stack_overflow
+
+let _ =
+ begin
+  try
+    ignore(f 0)
+  with Stack_overflow ->
+    print_string "Stack overflow caught"; print_newline()
+ end ;
+ (* GPR#1289 *)
+ Printexc.record_backtrace true;
+ begin
+  try
+    ignore(f 0)
+  with Stack_overflow ->
+    print_string "second Stack overflow caught"; print_newline()
+ end
diff --git a/testsuite/tests/runtime-errors/stackoverflow.native.reference b/testsuite/tests/runtime-errors/stackoverflow.native.reference
new file mode 100644
index 00000000..a62a27b5
--- /dev/null
+++ b/testsuite/tests/runtime-errors/stackoverflow.native.reference
@@ -0,0 +1,8 @@
+x = 20000
+x = 10000
+x = 0
+Stack overflow caught
+x = 20000
+x = 10000
+x = 0
+second Stack overflow caught
diff --git a/testsuite/tests/runtime-errors/stackoverflow.reference b/testsuite/tests/runtime-errors/stackoverflow.reference
new file mode 100644
index 00000000..a62a27b5
--- /dev/null
+++ b/testsuite/tests/runtime-errors/stackoverflow.reference
@@ -0,0 +1,8 @@
+x = 20000
+x = 10000
+x = 0
+Stack overflow caught
+x = 20000
+x = 10000
+x = 0
+second Stack overflow caught
diff --git a/testsuite/tests/runtime-errors/stackoverflow.run b/testsuite/tests/runtime-errors/stackoverflow.run
new file mode 100644
index 00000000..acd7368b
--- /dev/null
+++ b/testsuite/tests/runtime-errors/stackoverflow.run
@@ -0,0 +1,16 @@
+#!/bin/sh
+ul=`ulimit -s`
+if ( [ "$ul" = "unlimited" ] || [ $ul -gt 4096 ] ) ; then
+  ulimit -s 1024 && ul=true || ul=false ;
+else
+  ul=true;
+fi
+
+if $ul; then
+  ${program} > ${output} 2>&1;
+else
+  # The test is not actually run
+  # We thus tell ocamltest the test output is equal to the reference file
+  # so that the comparison between reference and output will still succeed
+  echo output="${reference}" > ${ocamltest_response}
+fi
diff --git a/testsuite/tests/runtime-errors/syserror.ml b/testsuite/tests/runtime-errors/syserror.ml
new file mode 100644
index 00000000..39818a21
--- /dev/null
+++ b/testsuite/tests/runtime-errors/syserror.ml
@@ -0,0 +1,31 @@
+(* TEST
+
+flags = "-w a"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** run
+exit_status = "2"
+**** libunix
+***** check-program-output
+reference = "${test_source_directory}/syserror.unix.reference"
+**** libwin32unix
+***** check-program-output
+reference = "${test_source_directory}/syserror.win32.reference"
+
+* setup-ocamlopt.byte-build-env
+** ocamlopt.byte
+*** run
+exit_status = "2"
+**** libunix
+***** check-program-output
+reference = "${test_source_directory}/syserror.unix.reference"
+**** libwin32unix
+***** check-program-output
+reference = "${test_source_directory}/syserror.win32.reference"
+
+*)
+
+let _ = Printexc.record_backtrace false
+
+let channel = open_out "titi:/toto"
diff --git a/testsuite/tests/runtime-errors/syserror.unix.reference b/testsuite/tests/runtime-errors/syserror.unix.reference
new file mode 100644
index 00000000..3f6219a2
--- /dev/null
+++ b/testsuite/tests/runtime-errors/syserror.unix.reference
@@ -0,0 +1 @@
+Fatal error: exception Sys_error("titi:/toto: No such file or directory")
diff --git a/testsuite/tests/runtime-errors/syserror.win32.reference b/testsuite/tests/runtime-errors/syserror.win32.reference
new file mode 100644
index 00000000..4030c3ad
--- /dev/null
+++ b/testsuite/tests/runtime-errors/syserror.win32.reference
@@ -0,0 +1 @@
+Fatal error: exception Sys_error("titi:/toto: Invalid argument")
diff --git a/testsuite/tests/runtime-objects/Tests.ml b/testsuite/tests/runtime-objects/Tests.ml
new file mode 100644
index 00000000..70478f5d
--- /dev/null
+++ b/testsuite/tests/runtime-objects/Tests.ml
@@ -0,0 +1,37 @@
+(* TEST *)
+
+(* Marshaling (cf. PR#5436) *)
+
+(* Note: this test must *not* be made a toplevel or expect-style test,
+   because then the Obj.id counter of the compiler implementation
+   (called by the bytecode read-eval-print loop) would be the same as
+   the Obj.id counter of the test code below. In particular, any
+   change to the compiler implementation to use more objects or
+   exceptions would change the numbers below, making the test very
+   fragile. *)
+
+let r = ref 0;;
+let id o = Oo.id o - !r;;
+r := Oo.id (object end);;
+
+assert (id (object end) = 1);;
+assert (id (object end) = 2);;
+let o = object end in
+  let s = Marshal.to_string o [] in
+  let o' : < > = Marshal.from_string s 0 in
+  let o'' : < > = Marshal.from_string s 0 in
+  assert ((id o, id o', id o'') = (3, 4, 5));
+
+let o = object val x = 33 method m = x end in
+  let s = Marshal.to_string o [Marshal.Closures] in
+  let o' : <m:int> = Marshal.from_string s 0 in
+  let o'' : <m:int> = Marshal.from_string s 0 in
+  assert ((id o, id o', id o'', o#m, o'#m)
+          = (6, 7, 8, 33, 33));;
+
+let o = object val x = 33 val y = 44 method m = x end in
+  let s = Marshal.to_string (o,o) [Marshal.Closures] in
+  let (o1, o2) : (<m:int> * <m:int>) = Marshal.from_string s 0 in
+  let (o3, o4) : (<m:int> * <m:int>) = Marshal.from_string s 0 in
+  assert ((id o, id o1, id o2, id o3, id o4, o#m, o1#m)
+          = (9, 10, 10, 11, 11, 33, 33));;
diff --git a/testsuite/tests/self-contained-toplevel/foo.ml b/testsuite/tests/self-contained-toplevel/foo.ml
new file mode 100644
index 00000000..2747ada0
--- /dev/null
+++ b/testsuite/tests/self-contained-toplevel/foo.ml
@@ -0,0 +1 @@
+let value = "Hello, world!"
diff --git a/testsuite/tests/self-contained-toplevel/gen_cached_cmi.ml b/testsuite/tests/self-contained-toplevel/gen_cached_cmi.ml
new file mode 100644
index 00000000..e406423f
--- /dev/null
+++ b/testsuite/tests/self-contained-toplevel/gen_cached_cmi.ml
@@ -0,0 +1,7 @@
+let () =
+  let cmi = Cmi_format.read_cmi "foo.cmi" in
+  let data = Marshal.to_string cmi [] in
+  let filename = Sys.argv.(1) in
+  let oc = open_out filename in
+  Printf.fprintf oc "let foo = %S\n" data;
+  close_out oc
diff --git a/testsuite/tests/self-contained-toplevel/input.ml b/testsuite/tests/self-contained-toplevel/input.ml
new file mode 100644
index 00000000..46072371
--- /dev/null
+++ b/testsuite/tests/self-contained-toplevel/input.ml
@@ -0,0 +1 @@
+print_endline Foo.value;;
diff --git a/testsuite/tests/self-contained-toplevel/main.ml b/testsuite/tests/self-contained-toplevel/main.ml
new file mode 100644
index 00000000..4be67c87
--- /dev/null
+++ b/testsuite/tests/self-contained-toplevel/main.ml
@@ -0,0 +1,40 @@
+(* TEST
+files = "foo.ml gen_cached_cmi.ml input.ml"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+module = "foo.ml"
+*** ocaml with ocamlcommon
+ocaml_script_as_argument = "true"
+test_file = "gen_cached_cmi.ml"
+arguments = "cached_cmi.ml"
+**** ocamlc.byte
+module = ""
+program = "${test_build_directory}/main.exe"
+libraries += "ocamlbytecomp ocamltoplevel"
+all_modules = "foo.cmo cached_cmi.ml main.ml"
+***** run
+set OCAMLLIB="${ocamlsrcdir}/stdlib"
+arguments = "input.ml"
+****** check-program-output
+*)
+
+let () =
+  (* Make sure it's no longer available on disk *)
+  if Sys.file_exists "foo.cmi" then Sys.remove "foo.cmi";
+  let module Persistent_signature = Persistent_env.Persistent_signature in
+  let old_loader = !Persistent_signature.load in
+  Persistent_signature.load := (fun ~unit_name ->
+    match unit_name with
+    | "Foo" ->
+      Some { Persistent_signature.
+             filename = Sys.executable_name
+           ; cmi      = Marshal.from_string Cached_cmi.foo 0
+           }
+    | _ -> old_loader unit_name);
+  Toploop.add_hook (function
+      | Toploop.After_setup ->
+          Toploop.toplevel_env :=
+            Env.add_persistent_structure (Ident.create_persistent "Foo")
+              !Toploop.toplevel_env
+      | _ -> ());
+  Topmain.main ()
diff --git a/testsuite/tests/self-contained-toplevel/main.reference b/testsuite/tests/self-contained-toplevel/main.reference
new file mode 100644
index 00000000..af5626b4
--- /dev/null
+++ b/testsuite/tests/self-contained-toplevel/main.reference
@@ -0,0 +1 @@
+Hello, world!
diff --git a/testsuite/tests/shadow_include/artificial.ml b/testsuite/tests/shadow_include/artificial.ml
new file mode 100644
index 00000000..f881c999
--- /dev/null
+++ b/testsuite/tests/shadow_include/artificial.ml
@@ -0,0 +1,70 @@
+(* TEST
+   * expect
+   flags = "-nostdlib -nopervasives"
+*)
+
+module Foo : sig
+  type t
+
+  module Bar : sig
+    type t
+  end
+
+  val to_ : t -> Bar.t
+  val from: Bar.t -> t
+end = struct
+  type t
+
+  module Bar = struct
+    type nonrec t = t
+  end
+
+  let to_ x = x
+  let from x = x
+end
+;;
+[%%expect{|
+module Foo :
+  sig
+    type t
+    module Bar : sig type t end
+    val to_ : t -> Bar.t
+    val from : Bar.t -> t
+  end
+|}]
+
+module Extended = struct
+  include Foo
+  module Bar = struct
+    include Bar
+    let int = 42
+  end
+end
+;;
+[%%expect{|
+module Extended :
+  sig
+    type t = Foo.t
+    val to_ : t -> Foo.Bar.t
+    val from : Foo.Bar.t -> t
+    module Bar : sig type t = Foo.Bar.t val int : int end
+  end
+|}]
+
+module type Extended = sig
+  include module type of struct include Foo end
+  module Bar : sig
+    include module type of struct include Bar end
+    val int : int
+  end
+end
+;;
+[%%expect{|
+module type Extended =
+  sig
+    type t = Foo.t
+    val to_ : t -> Foo.Bar.t
+    val from : Foo.Bar.t -> t
+    module Bar : sig type t = Foo.Bar.t val int : int end
+  end
+|}]
diff --git a/testsuite/tests/shadow_include/cannot_shadow_error.compilers.reference b/testsuite/tests/shadow_include/cannot_shadow_error.compilers.reference
new file mode 100644
index 00000000..7d1b19e6
--- /dev/null
+++ b/testsuite/tests/shadow_include/cannot_shadow_error.compilers.reference
@@ -0,0 +1,8 @@
+File "cannot_shadow_error.ml", line 24, characters 2-36:
+24 |   include Comparable with type t = t
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Illegal shadowing of included type t/9 by t/13
+       File "cannot_shadow_error.ml", line 23, characters 2-19:
+         Type t/9 came from this include
+       File "cannot_shadow_error.ml", line 14, characters 2-23:
+         The value print has no valid type if t/9 is shadowed
diff --git a/testsuite/tests/shadow_include/cannot_shadow_error.ml b/testsuite/tests/shadow_include/cannot_shadow_error.ml
new file mode 100644
index 00000000..11619ca8
--- /dev/null
+++ b/testsuite/tests/shadow_include/cannot_shadow_error.ml
@@ -0,0 +1,25 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+flags = "-nostdlib -nopervasives"
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
+
+(* Same example as in tests/typing-sigsubst/sigsubst.ml, but not as an
+   expect_test so we get the full error.  *)
+
+module type Printable = sig
+  type t
+  val print : t -> unit
+end
+
+module type Comparable = sig
+  type t
+  val compare : t -> t -> int
+end
+
+module type PrintableComparable = sig
+  include Printable
+  include Comparable with type t = t
+end
diff --git a/testsuite/tests/shadow_include/shadow_all.ml b/testsuite/tests/shadow_include/shadow_all.ml
new file mode 100644
index 00000000..443541c1
--- /dev/null
+++ b/testsuite/tests/shadow_include/shadow_all.ml
@@ -0,0 +1,477 @@
+(* TEST
+   * expect
+   flags = "-nopervasives" (* can't pass -nostdlib because of objects. *)
+*)
+
+(* Signatures *)
+
+(* Tests that everything can be shadowed. *)
+
+module type S = sig
+  type t
+
+  val unit : unit
+
+  external e : unit -> unit = "%identity"
+
+  module M : sig type t end
+
+  module type T
+
+  exception E
+
+  type ext = ..
+  type ext += C
+
+  class c : object end
+
+  class type ct = object end
+end
+;;
+[%%expect{|
+module type S =
+  sig
+    type t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M : sig type t end
+    module type T
+    exception E
+    type ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
+
+module type SS = sig
+  include S
+  include S
+end
+;;
+[%%expect{|
+module type SS =
+  sig
+    type t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M : sig type t end
+    module type T
+    exception E
+    type ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
+
+(* Test that the call to nondep works properly. *)
+
+module type Type = sig
+  include S
+  type u = t
+  include S
+end
+;;
+[%%expect{|
+module type Type =
+  sig
+    type u
+    type t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M : sig type t end
+    module type T
+    exception E
+    type ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
+
+module type Type_fail = sig
+  include S
+  val ignore : t -> unit
+  include S
+end
+;;
+[%%expect{|
+Line 4, characters 2-11:
+4 |   include S
+      ^^^^^^^^^
+Error: Illegal shadowing of included type t/144 by t/161
+       Line 2, characters 2-11:
+         Type t/144 came from this include
+       Line 3, characters 2-24:
+         The value ignore has no valid type if t/144 is shadowed
+|}]
+
+module type Module = sig
+  include S
+  module N = M
+  include S
+end
+;;
+[%%expect{|
+module type Module =
+  sig
+    module N : sig type t end
+    type t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M : sig type t end
+    module type T
+    exception E
+    type ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
+
+module type Module_fail = sig
+  include S
+  val ignore : M.t -> unit
+  include S
+end
+;;
+[%%expect{|
+Line 4, characters 2-11:
+4 |   include S
+      ^^^^^^^^^
+Error: Illegal shadowing of included module M/232 by M/249
+       Line 2, characters 2-11:
+         Module M/232 came from this include
+       Line 3, characters 2-26:
+         The value ignore has no valid type if M/232 is shadowed
+|}]
+
+
+module type Module_type = sig
+  include S
+  module type U = T
+  include S
+end
+;;
+[%%expect{|
+module type Module_type =
+  sig
+    module type U
+    type t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M : sig type t end
+    module type T
+    exception E
+    type ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
+
+module type Module_type_fail = sig
+  include S
+  module F : functor (_ : T) -> sig end
+  include S
+end
+;;
+[%%expect{|
+Line 4, characters 2-11:
+4 |   include S
+      ^^^^^^^^^
+Error: Illegal shadowing of included module type T/317 by T/334
+       Line 2, characters 2-11:
+         Module type T/317 came from this include
+       Line 3, characters 2-39:
+         The module F has no valid type if T/317 is shadowed
+|}]
+
+module type Extension = sig
+  include S
+  type ext += C2
+  include S
+end
+;;
+[%%expect{|
+Line 4, characters 2-11:
+4 |   include S
+      ^^^^^^^^^
+Error: Illegal shadowing of included type ext/352 by ext/369
+       Line 2, characters 2-11:
+         Type ext/352 came from this include
+       Line 3, characters 14-16:
+         The extension constructor C2 has no valid type if ext/352 is shadowed
+|}]
+
+module type Class = sig
+  include S
+  class parametrized : int -> c
+  include S
+end
+;;
+[%%expect{|
+module type Class =
+  sig
+    class parametrized : int -> object  end
+    type t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M : sig type t end
+    module type T
+    exception E
+    type ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
+
+module type Class_type = sig
+  include S
+  class type parametrized = ct
+  include S
+end
+;;
+[%%expect{|
+module type Class_type =
+  sig
+    class type parametrized = object  end
+    type t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M : sig type t end
+    module type T
+    exception E
+    type ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
+
+(* Structures *)
+
+(* Tests that everything can be shadowed. *)
+
+module N = struct
+  type t
+
+  let unit = ()
+
+  external e : unit -> unit = "%identity"
+
+  module M = struct end
+
+  module type T = sig end
+
+  exception E
+
+  type ext = ..
+  type ext += C
+
+  class c = object end
+
+  class type ct = object end
+end
+;;
+[%%expect{|
+module N :
+  sig
+    type t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M : sig end
+    module type T = sig end
+    exception E
+    type ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
+
+module NN = struct
+  include N
+  include N
+end
+;;
+[%%expect{|
+module NN :
+  sig
+    type t = N.t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M = N.M
+    module type T = sig end
+    exception E
+    type ext = N.ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
+
+(* Test that the call to nondep works properly *)
+
+module Type = struct
+  include N
+  type u = t
+  include N
+end
+;;
+[%%expect{|
+module Type :
+  sig
+    type u = N.t
+    type t = N.t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M = N.M
+    module type T = sig end
+    exception E
+    type ext = N.ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
+
+module Module = struct
+  include N
+  module O = M
+  include N
+end
+;;
+[%%expect{|
+module Module :
+  sig
+    module O = N.M
+    type t = N.t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M = N.M
+    module type T = sig end
+    exception E
+    type ext = N.ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
+
+module Module_type = struct
+  include N
+  module type U = T
+  include N
+end
+;;
+[%%expect{|
+module Module_type :
+  sig
+    module type U = sig end
+    type t = N.t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M = N.M
+    module type T = sig end
+    exception E
+    type ext = N.ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
+
+module Exception = struct
+  include N
+  exception Exn = E
+  include N
+end
+;;
+[%%expect{|
+module Exception :
+  sig
+    exception Exn
+    type t = N.t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M = N.M
+    module type T = sig end
+    exception E
+    type ext = N.ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
+
+module Extension = struct
+  include N
+  type ext += C2
+  include N
+end
+;;
+[%%expect{|
+module Extension :
+  sig
+    type N.ext += C2
+    type t = N.t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M = N.M
+    module type T = sig end
+    exception E
+    type ext = N.ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
+
+module Class = struct
+  include N
+  class parametrized _ = c
+  include N
+end
+;;
+[%%expect{|
+module Class :
+  sig
+    class parametrized : 'a -> object  end
+    type t = N.t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M = N.M
+    module type T = sig end
+    exception E
+    type ext = N.ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
+
+module Class_type = struct
+  include N
+  class type parametrized = ct
+  include N
+end
+;;
+[%%expect{|
+module Class_type :
+  sig
+    class type parametrized = object  end
+    type t = N.t
+    val unit : unit
+    external e : unit -> unit = "%identity"
+    module M = N.M
+    module type T = sig end
+    exception E
+    type ext = N.ext = ..
+    type ext += C
+    class c : object  end
+    class type ct = object  end
+  end
+|}]
diff --git a/testsuite/tests/statmemprof/arrays_in_major.ml b/testsuite/tests/statmemprof/arrays_in_major.ml
new file mode 100644
index 00000000..f3c5b8a6
--- /dev/null
+++ b/testsuite/tests/statmemprof/arrays_in_major.ml
@@ -0,0 +1,148 @@
+(* TEST
+   flags = "-g"
+   compare_programs = "false"
+*)
+
+open Gc.Memprof
+
+let root = ref []
+let[@inline never] allocate_arrays lo hi cnt keep =
+  assert (lo >= 300);  (* Will be allocated in major heap. *)
+  for j = 0 to cnt-1 do
+    for i = lo to hi do
+      root := Array.make i 0 :: !root
+    done;
+    if not keep then root := []
+  done
+
+let check_nosample () =
+  Printf.printf "check_nosample\n%!";
+  let alloc _ =
+    Printf.printf "Callback called with sampling_rate = 0\n";
+    assert(false)
+  in
+  start ~callstack_size:10 ~sampling_rate:0.
+    { null_tracker with alloc_minor = alloc; alloc_major = alloc; };
+  allocate_arrays 300 3000 1 false;
+  stop ()
+
+let () = check_nosample ()
+
+let check_counts_full_major force_promote =
+  Printf.printf "check_counts_full_major\n%!";
+  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
+    {
+      alloc_minor = (fun _ ->
+        if not !enable then None
+        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
+      );
+    };
+  allocate_arrays 300 3000 1 true;
+  enable := false;
+  assert (!ndealloc_minor = 0 && !ndealloc_major = 0);
+  if force_promote then begin
+    Gc.full_major ();
+    assert (!ndealloc_minor = 0 && !ndealloc_major = 0 &&
+            !npromote = !nalloc_minor);
+    root := [];
+    Gc.full_major ();
+    assert (!ndealloc_minor = 0 &&
+            !ndealloc_major = !nalloc_minor + !nalloc_major);
+  end else begin
+    root := [];
+    Gc.minor ();
+    Gc.full_major ();
+    Gc.full_major ();
+    assert (!nalloc_minor = !ndealloc_minor + !npromote &&
+            !ndealloc_major = !npromote + !nalloc_major)
+  end;
+  stop ()
+
+let () =
+  check_counts_full_major false;
+  check_counts_full_major true
+
+let check_no_nested () =
+  Printf.printf "check_no_nested\n%!";
+  let in_callback = ref false in
+  let cb _ =
+    assert (not !in_callback);
+    in_callback := true;
+    allocate_arrays 300 300 100 false;
+    in_callback := false;
+    ()
+  in
+  let cb' _ = cb (); Some () in
+  start ~callstack_size:10 ~sampling_rate:1.
+    {
+      alloc_minor = cb';
+      alloc_major = cb';
+      promote = cb';
+      dealloc_minor = cb;
+      dealloc_major = cb;
+    };
+  allocate_arrays 300 300 100 false;
+  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
+      alloc_major = (fun info ->
+        assert (info.size >= lo && info.size <= hi);
+        assert (info.n_samples > 0);
+        assert (not info.unmarshalled);
+        smp := !smp + info.n_samples;
+        None
+      );
+    };
+  allocate_arrays lo hi cnt false;
+  stop ();
+
+  (* The probability distribution of the number of samples follows a
+     binomial distribution of parameters tot_alloc and rate. Given
+     that tot_alloc*rate and tot_alloc*(1-rate) are large (i.e., >
+     100), this distribution is approximately equal to a normal
+     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*(lo+hi+2)*(hi-lo+1)/2 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 () =
+  check_distrib 300 3000 3 0.00001;
+  check_distrib 300 3000 1 0.0001;
+  check_distrib 300 3000 1 0.01;
+  check_distrib 300 3000 1 0.9;
+  check_distrib 300 300 100000 0.1;
+  check_distrib 300000 300000 30 0.1
+
+let () =
+  Printf.printf "OK !\n"
diff --git a/testsuite/tests/statmemprof/arrays_in_major.reference b/testsuite/tests/statmemprof/arrays_in_major.reference
new file mode 100644
index 00000000..1f34ad8e
--- /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
new file mode 100644
index 00000000..ec6131f1
--- /dev/null
+++ b/testsuite/tests/statmemprof/arrays_in_minor.ml
@@ -0,0 +1,162 @@
+(* TEST
+   flags = "-g"
+   compare_programs = "false"
+*)
+
+open Gc.Memprof
+
+let roots = Array.make 1000000 [||]
+let roots_pos = ref 0
+let add_root r =
+  roots.(!roots_pos) <- r;
+  incr roots_pos
+let clear_roots () =
+  Array.fill roots 0 !roots_pos [||];
+  roots_pos := 0
+
+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
+    for i = lo to hi do
+      add_root (Array.make i 0)
+    done;
+    if not keep then clear_roots ()
+  done
+
+let check_nosample () =
+  Printf.printf "check_nosample\n%!";
+  let alloc _ =
+    Printf.printf "Callback called with sampling_rate = 0\n";
+    assert(false)
+  in
+  start ~callstack_size:10 ~sampling_rate:0.
+    { null_tracker with alloc_minor = alloc; alloc_major = alloc };
+  allocate_arrays 1 250 100 false;
+  stop ()
+
+let () = check_nosample ()
+
+let check_counts_full_major force_promote =
+  Printf.printf "check_counts_full_major\n%!";
+  let nalloc_minor = ref 0 in
+  let enable = ref true in
+  let promotes_allowed = 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
+    {
+      alloc_minor = (fun info ->
+        if !enable then begin
+          incr nalloc_minor; if !nalloc_minor mod 100 = 0 then Gc.minor ();
+          Some (ref 42)
+        end else begin
+          allocate_arrays 1 250 1 true;
+          None
+        end);
+      alloc_major = (fun _ -> assert false);
+      promote = (fun k ->
+        assert (!k = 42 && !promotes_allowed);
+        incr npromote; if !npromote mod 1097 = 0 then Gc.minor ();
+        Some (ref 17));
+      dealloc_minor = (fun k ->
+        assert (!k = 42);
+        incr ndealloc_minor);
+      dealloc_major = (fun r ->
+        assert (!r = 17);
+        incr ndealloc_major);
+    };
+  allocate_arrays 1 250 100 true;
+  enable := false;
+  assert (!ndealloc_minor = 0 && !ndealloc_major = 0);
+  if force_promote then begin
+    Gc.full_major ();
+    promotes_allowed := false;
+    allocate_arrays 1 250 10 true;
+    Gc.full_major ();
+    assert (!ndealloc_minor = 0 && !ndealloc_major = 0 &&
+            !npromote = !nalloc_minor);
+    clear_roots ();
+    Gc.full_major ();
+    assert (!ndealloc_minor = 0 && !ndealloc_major = !nalloc_minor);
+  end else begin
+    clear_roots ();
+    Gc.minor ();
+    Gc.full_major ();
+    Gc.full_major ();
+    assert (!nalloc_minor = !ndealloc_minor + !npromote &&
+            !ndealloc_major = !npromote)
+  end;
+  stop ()
+
+let () =
+  check_counts_full_major false;
+  check_counts_full_major true
+
+let check_no_nested () =
+  Printf.printf "check_no_nested\n%!";
+  let in_callback = ref false in
+  let cb _ =
+    assert (not !in_callback);
+    in_callback := true;
+    allocate_arrays 1 100 10 false;
+    ignore (Array.to_list (Array.make 1000 0));
+    in_callback := false;
+    ()
+  in
+  let cb' _ = cb (); Some () in
+  start ~callstack_size:10 ~sampling_rate:1.
+    {
+      alloc_minor = cb';
+      alloc_major = cb';
+      promote = cb';
+      dealloc_minor = cb;
+      dealloc_major = cb;
+    };
+  allocate_arrays 1 250 5 false;
+  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
+      alloc_major = (fun _ -> assert false);
+      alloc_minor = (fun info ->
+        assert (info.size >= lo && info.size <= hi);
+        assert (info.n_samples > 0);
+        assert (not info.unmarshalled);
+        smp := !smp + info.n_samples;
+        None
+      );
+    };
+  allocate_arrays lo hi cnt false;
+  stop ();
+
+  (* The probability distribution of the number of samples follows a
+     binomial distribution of parameters tot_alloc and rate. Given
+     that tot_alloc*rate and tot_alloc*(1-rate) are large (i.e., >
+     100), this distribution is approximately equal to a normal
+     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*(lo+hi+2)*(hi-lo+1)/2 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 () =
+  check_distrib 1 250 1000 0.00001;
+  check_distrib 1 250 1000 0.0001;
+  check_distrib 1 250 1000 0.01;
+  check_distrib 1 250 1000 0.9;
+  check_distrib 1 1   10000000 0.01;
+  check_distrib 250 250 100000 0.1
+
+let () =
+  Printf.printf "OK !\n"
diff --git a/testsuite/tests/statmemprof/arrays_in_minor.reference b/testsuite/tests/statmemprof/arrays_in_minor.reference
new file mode 100644
index 00000000..1dad9193
--- /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
new file mode 100644
index 00000000..d5e8d2ce
--- /dev/null
+++ b/testsuite/tests/statmemprof/blocking_in_callback.ml
@@ -0,0 +1,69 @@
+(* TEST
+* hassysthreads
+include systhreads
+** bytecode
+** native
+*)
+
+let cnt = ref 0
+let alloc_num = ref 0
+let alloc_tot = 100000
+
+let (rd1, wr1) = Unix.pipe ()
+let (rd2, wr2) = Unix.pipe ()
+
+let main_thread = Thread.self ()
+let cb_main = ref 0 and cb_other = ref 0
+let stopped = ref false
+let minor_alloc_callback _ =
+  if !stopped then
+    None
+  else begin
+    let do_stop = !cb_main + !cb_other >= alloc_tot in
+    if do_stop then stopped := true;
+    let t = Thread.self () in
+    if t == main_thread then begin
+      incr cb_main;
+      assert (Unix.write wr2 (Bytes.make 1 'a') 0 1 = 1);
+      if not do_stop then
+        assert (Unix.read rd1 (Bytes.make 1 'a') 0 1 = 1)
+    end else begin
+      incr cb_other;
+      assert (Unix.write wr1 (Bytes.make 1 'a') 0 1 = 1);
+      if not do_stop then
+        assert (Unix.read rd2 (Bytes.make 1 'a') 0 1 = 1)
+    end;
+    Some ()
+  end
+
+let mut = Mutex.create ()
+let () = Mutex.lock mut
+
+let rec go () =
+  Mutex.lock mut;
+  Mutex.unlock mut;
+  if !alloc_num < alloc_tot then begin
+    alloc_num := !alloc_num + 1;
+    Sys.opaque_identity (Bytes.make (Random.int 300) 'a') |> ignore;
+    go ()
+  end else begin
+    cnt := !cnt + 1;
+    if !cnt < 2 then begin
+      Gc.minor ();    (* check for callbacks *)
+      Thread.yield ();
+      go ()
+    end else begin
+      Gc.minor ()    (* check for callbacks *)
+    end
+  end
+
+let () =
+  let t = Thread.create go () in
+  Gc.Memprof.(start ~callstack_size:10 ~sampling_rate:1.
+    { null_tracker with alloc_minor = minor_alloc_callback; });
+  Mutex.unlock mut;
+  go ();
+  Thread.join t;
+  Gc.Memprof.stop ();
+  assert (abs (!cb_main - !cb_other) <= 1);
+  assert (!cb_main + !cb_other >= alloc_tot)
diff --git a/testsuite/tests/statmemprof/callstacks.flat-float-array.reference b/testsuite/tests/statmemprof/callstacks.flat-float-array.reference
new file mode 100644
index 00000000..7efb00ae
--- /dev/null
+++ b/testsuite/tests/statmemprof/callstacks.flat-float-array.reference
@@ -0,0 +1,74 @@
+-----------
+Raised by primitive operation at Callstacks.alloc_list_literal in file "callstacks.ml", line 19, characters 30-53
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_pair in file "callstacks.ml", line 22, characters 30-76
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_record in file "callstacks.ml", line 27, characters 12-66
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_some in file "callstacks.ml", line 30, characters 30-60
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_array_literal in file "callstacks.ml", line 33, characters 30-55
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_float_array_literal in file "callstacks.ml", line 37, characters 12-62
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.do_alloc_unknown_array_literal in file "callstacks.ml", line 40, characters 22-27
+Called from Callstacks.alloc_unknown_array_literal in file "callstacks.ml", line 42, characters 30-65
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_small_array in file "callstacks.ml", line 45, characters 30-69
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_large_array in file "callstacks.ml", line 48, characters 30-73
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_closure.(fun) in file "callstacks.ml", line 52, characters 30-43
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.get0 in file "callstacks.ml", line 55, characters 28-33
+Called from Callstacks.getfloatfield in file "callstacks.ml", line 57, characters 30-47
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Stdlib__marshal.from_bytes in file "marshal.ml", line 61, characters 9-35
+Called from Callstacks.alloc_unmarshal in file "callstacks.ml", line 63, characters 12-87
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_ref in file "callstacks.ml", line 66, characters 30-59
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.prod_floats in file "callstacks.ml", line 69, characters 37-43
+Called from Callstacks.alloc_boxedfloat in file "callstacks.ml", line 71, characters 30-49
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
diff --git a/testsuite/tests/statmemprof/callstacks.ml b/testsuite/tests/statmemprof/callstacks.ml
new file mode 100644
index 00000000..758d01dc
--- /dev/null
+++ b/testsuite/tests/statmemprof/callstacks.ml
@@ -0,0 +1,100 @@
+(* TEST
+   flags = "-g -w -5"
+   compare_programs = "false"
+
+   * flat-float-array
+     reference = "${test_source_directory}/callstacks.flat-float-array.reference"
+   ** native
+   ** bytecode
+
+   * no-flat-float-array
+     reference = "${test_source_directory}/callstacks.no-flat-float-array.reference"
+   ** native
+   ** bytecode
+*)
+
+open Gc.Memprof
+
+let alloc_list_literal () =
+  ignore (Sys.opaque_identity [Sys.opaque_identity 1])
+
+let alloc_pair () =
+  ignore (Sys.opaque_identity (Sys.opaque_identity 1, Sys.opaque_identity 2))
+
+type record = { a : int; b : int }
+let alloc_record () =
+  ignore (Sys.opaque_identity
+            {a = Sys.opaque_identity 1; b = Sys.opaque_identity 2})
+
+let alloc_some () =
+  ignore (Sys.opaque_identity (Some (Sys.opaque_identity 2)))
+
+let alloc_array_literal () =
+  ignore (Sys.opaque_identity [|Sys.opaque_identity 1|])
+
+let alloc_float_array_literal () =
+  ignore (Sys.opaque_identity
+            [|Sys.opaque_identity 1.; Sys.opaque_identity 2.|])
+
+let[@inline never] do_alloc_unknown_array_literal x =
+  Sys.opaque_identity [|x|]
+let alloc_unknown_array_literal () =
+  ignore (Sys.opaque_identity (do_alloc_unknown_array_literal 1.))
+
+let alloc_small_array () =
+  ignore (Sys.opaque_identity (Array.make 10 (Sys.opaque_identity 1)))
+
+let alloc_large_array () =
+  ignore (Sys.opaque_identity (Array.make 100000 (Sys.opaque_identity 1)))
+
+let alloc_closure () =
+  let x = Sys.opaque_identity 1 in
+  ignore (Sys.opaque_identity (fun () -> x))
+
+let floatarray = [| 1.; 2. |]
+let[@inline never] get0 a = a.(0)
+let getfloatfield () =
+  ignore (Sys.opaque_identity (get0 floatarray))
+
+let marshalled =
+  Marshal.to_string [Sys.opaque_identity 1] []
+let alloc_unmarshal () =
+  ignore (Sys.opaque_identity
+            ((Marshal.from_string [@inlined never]) (Sys.opaque_identity marshalled) 0))
+
+let alloc_ref () =
+  ignore (Sys.opaque_identity (ref (Sys.opaque_identity 1)))
+
+let fl = 1.
+let[@inline never] prod_floats a b = a *. b
+let alloc_boxedfloat () =
+  ignore (Sys.opaque_identity (prod_floats fl fl))
+
+let allocators =
+  [alloc_list_literal; alloc_pair; alloc_record; alloc_some;
+   alloc_array_literal; alloc_float_array_literal; alloc_unknown_array_literal;
+   alloc_small_array; alloc_large_array; alloc_closure;
+   getfloatfield; alloc_unmarshal; alloc_ref; alloc_boxedfloat]
+
+let test alloc =
+  Printf.printf "-----------\n%!";
+  let callstack = ref None in
+  start ~callstack_size:10 ~sampling_rate:1.
+    { null_tracker with
+      alloc_minor = (fun info ->
+         callstack := Some info.callstack;
+         None
+      );
+      alloc_major = (fun info ->
+         callstack := Some info.callstack;
+         None
+      );
+    };
+  alloc ();
+  stop ();
+  match !callstack with
+  | None -> Printf.printf "No callstack\n%!";
+  | Some cs -> Printexc.print_raw_backtrace stdout cs
+
+let () =
+  List.iter test allocators
diff --git a/testsuite/tests/statmemprof/callstacks.no-flat-float-array.reference b/testsuite/tests/statmemprof/callstacks.no-flat-float-array.reference
new file mode 100644
index 00000000..789f5341
--- /dev/null
+++ b/testsuite/tests/statmemprof/callstacks.no-flat-float-array.reference
@@ -0,0 +1,70 @@
+-----------
+Raised by primitive operation at Callstacks.alloc_list_literal in file "callstacks.ml", line 19, characters 30-53
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_pair in file "callstacks.ml", line 22, characters 30-76
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_record in file "callstacks.ml", line 27, characters 12-66
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_some in file "callstacks.ml", line 30, characters 30-60
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_array_literal in file "callstacks.ml", line 33, characters 30-55
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_float_array_literal in file "callstacks.ml", line 37, characters 12-62
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.do_alloc_unknown_array_literal in file "callstacks.ml", line 40, characters 22-27
+Called from Callstacks.alloc_unknown_array_literal in file "callstacks.ml", line 42, characters 30-65
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_small_array in file "callstacks.ml", line 45, characters 30-69
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_large_array in file "callstacks.ml", line 48, characters 30-73
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_closure.(fun) in file "callstacks.ml", line 52, characters 30-43
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+No callstack
+-----------
+Raised by primitive operation at Stdlib__marshal.from_bytes in file "marshal.ml", line 61, characters 9-35
+Called from Callstacks.alloc_unmarshal in file "callstacks.ml", line 63, characters 12-87
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.alloc_ref in file "callstacks.ml", line 66, characters 30-59
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
+-----------
+Raised by primitive operation at Callstacks.prod_floats in file "callstacks.ml", line 69, characters 37-43
+Called from Callstacks.alloc_boxedfloat in file "callstacks.ml", line 71, characters 30-49
+Called from Callstacks.test in file "callstacks.ml", line 93, characters 2-10
+Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Callstacks in file "callstacks.ml", line 100, characters 2-27
diff --git a/testsuite/tests/statmemprof/comballoc.byte.reference b/testsuite/tests/statmemprof/comballoc.byte.reference
new file mode 100644
index 00000000..31dce2d0
--- /dev/null
+++ b/testsuite/tests/statmemprof/comballoc.byte.reference
@@ -0,0 +1,49 @@
+2: 0.42 false
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 15, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+3: 0.42 false
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 15, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+4: 0.42 true
+Raised by primitive operation at Comballoc.f4 in file "comballoc.ml", line 12, characters 11-20
+Called from Comballoc.f in file "comballoc.ml", line 15, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+2: 0.01 false
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 15, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+3: 0.01 false
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 15, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+4: 0.01 true
+Raised by primitive operation at Comballoc.f4 in file "comballoc.ml", line 12, characters 11-20
+Called from Comballoc.f in file "comballoc.ml", line 15, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+2: 0.83 false
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 15, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+3: 0.83 false
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 15, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+4: 0.83 true
+Raised by primitive operation at Comballoc.f4 in file "comballoc.ml", line 12, characters 11-20
+Called from Comballoc.f in file "comballoc.ml", line 15, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+OK
diff --git a/testsuite/tests/statmemprof/comballoc.ml b/testsuite/tests/statmemprof/comballoc.ml
new file mode 100644
index 00000000..716883d8
--- /dev/null
+++ b/testsuite/tests/statmemprof/comballoc.ml
@@ -0,0 +1,92 @@
+(* TEST
+   flags = "-g"
+   * bytecode
+     reference = "${test_source_directory}/comballoc.byte.reference"
+   * native
+     reference = "${test_source_directory}/comballoc.opt.reference"
+     compare_programs = "false"
+*)
+
+open Gc.Memprof
+
+let f4 n = (n,n,n,n)
+
+let[@inline never] f n =
+  (n, (n, n, f4 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
+      alloc_minor = (fun info ->
+        allocs.(info.size) <- allocs.(info.size) + info.n_samples;
+        begin match callstacks.(info.size) with
+        | None -> callstacks.(info.size) <- Some info.callstack
+        | Some s -> assert (s = info.callstack)
+        end;
+        Some (info.size, info.n_samples));
+      dealloc_minor = (fun (sz,n) ->
+        deallocs.(sz) <- deallocs.(sz) + n);
+      promote = (fun (sz,n) ->
+        promotes.(sz) <- promotes.(sz) + n;
+        None);
+    };
+  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
+    arr.(i) <- x;
+  done;
+  Gc.minor ();
+  stop ();
+  ignore (Sys.opaque_identity arr);
+  for i = 0 to 256 do
+    assert (deallocs.(i) + promotes.(i) = allocs.(i));
+    if allocs.(i) > 0 then begin
+      let total = (i + 1) * iter in
+      (* allocs.(i) / total is
+           Binomial(total, rate) / total
+         which is approx.
+           Normal(total * rate, total * rate*(1-rate)) / total
+         which is
+           Normal(1, rate*(1-rate) / total)
+         which has stddev sqrt(rate*(1-rate)/total)
+         which is less than 10^-3 for the values here.
+         So, an error of 0.005 (enough to make %.2f print differently)
+         is a 5-sigma event, with probability less than 3*10^-7 *)
+      Printf.printf "%d: %.2f %b\n" i
+        (float_of_int allocs.(i) /. float_of_int total)
+        (promotes.(i) > 1000);
+      (match callstacks.(i) with
+       | Some s -> Printexc.print_raw_backtrace stdout s
+       | None -> assert false)
+    end
+  done
+
+let () =
+  List.iter test [0.42; 0.01; 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
+      alloc_minor = (fun info ->
+        assert(not !stopped);
+        incr cnt;
+        if !cnt > trigger then begin
+          stop ();
+          stopped := true
+        end;
+        None);
+    };
+  for i = 0 to 1000 do ignore (Sys.opaque_identity f i) done;
+  assert !stopped
+
+let () =
+  for i = 0 to 1000 do no_callback_after_stop i done;
+  Printf.printf "OK\n"
diff --git a/testsuite/tests/statmemprof/comballoc.opt.reference b/testsuite/tests/statmemprof/comballoc.opt.reference
new file mode 100644
index 00000000..9fbeb6a7
--- /dev/null
+++ b/testsuite/tests/statmemprof/comballoc.opt.reference
@@ -0,0 +1,49 @@
+2: 0.42 false
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 15, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+3: 0.42 false
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 15, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+4: 0.42 true
+Raised by primitive operation at Comballoc.f4 in file "comballoc.ml" (inlined), line 12, characters 11-20
+Called from Comballoc.f in file "comballoc.ml", line 15, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+2: 0.01 false
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 15, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+3: 0.01 false
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 15, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+4: 0.01 true
+Raised by primitive operation at Comballoc.f4 in file "comballoc.ml" (inlined), line 12, characters 11-20
+Called from Comballoc.f in file "comballoc.ml", line 15, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+2: 0.83 false
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 15, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+3: 0.83 false
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 15, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+4: 0.83 true
+Raised by primitive operation at Comballoc.f4 in file "comballoc.ml" (inlined), line 12, characters 11-20
+Called from Comballoc.f in file "comballoc.ml", line 15, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 40, 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 70, characters 2-35
+OK
diff --git a/testsuite/tests/statmemprof/exception_callback.ml b/testsuite/tests/statmemprof/exception_callback.ml
new file mode 100644
index 00000000..55dd5e55
--- /dev/null
+++ b/testsuite/tests/statmemprof/exception_callback.ml
@@ -0,0 +1,23 @@
+(* TEST
+   exit_status = "2"
+*)
+
+open Gc.Memprof
+
+let alloc_tracker on_alloc =
+  { null_tracker with
+    alloc_minor = (fun info -> on_alloc info; None);
+    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
+
+let _ =
+  start ~callstack_size:10 ~sampling_rate:1.
+    (alloc_tracker (fun _ -> failwith "callback failed"));
+  ignore (Sys.opaque_identity (Array.make 200 0));
+  stop ()
diff --git a/testsuite/tests/statmemprof/exception_callback.reference b/testsuite/tests/statmemprof/exception_callback.reference
new file mode 100644
index 00000000..6371f824
--- /dev/null
+++ b/testsuite/tests/statmemprof/exception_callback.reference
@@ -0,0 +1 @@
+Fatal error: exception Failure("callback failed")
diff --git a/testsuite/tests/statmemprof/exception_callback_minor.ml b/testsuite/tests/statmemprof/exception_callback_minor.ml
new file mode 100644
index 00000000..f5141232
--- /dev/null
+++ b/testsuite/tests/statmemprof/exception_callback_minor.ml
@@ -0,0 +1,20 @@
+(* TEST
+   exit_status = "2"
+*)
+
+open Gc.Memprof
+
+(* 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
+
+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 ()
diff --git a/testsuite/tests/statmemprof/exception_callback_minor.reference b/testsuite/tests/statmemprof/exception_callback_minor.reference
new file mode 100644
index 00000000..af75fbbe
--- /dev/null
+++ b/testsuite/tests/statmemprof/exception_callback_minor.reference
@@ -0,0 +1 @@
+Fatal error: exception File "exception_callback_minor.ml", line 16, characters 30-36: Assertion failed
diff --git a/testsuite/tests/statmemprof/intern.ml b/testsuite/tests/statmemprof/intern.ml
new file mode 100644
index 00000000..5a5ff558
--- /dev/null
+++ b/testsuite/tests/statmemprof/intern.ml
@@ -0,0 +1,173 @@
+(* TEST
+   flags = "-g"
+   * bytecode
+   * native
+     compare_programs = "false"
+*)
+
+open Gc.Memprof
+
+let alloc_tracker on_alloc =
+  { 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))
+
+let marshalled_data = Hashtbl.create 17
+let[@inline never] get_marshalled_data len : t =
+  Marshal.from_string (Hashtbl.find marshalled_data len) 0
+let precompute_marshalled_data lo hi =
+  for len = lo to hi do
+    if not (Hashtbl.mem marshalled_data len) then
+      Hashtbl.add marshalled_data len (Marshal.to_string (t_of_len len) [])
+  done
+
+let root = ref []
+let[@inline never] do_intern lo hi cnt keep =
+  for j = 0 to cnt-1 do
+    for i = lo to hi do
+      root := get_marshalled_data i :: !root
+    done;
+    if not keep then root := []
+  done
+
+let check_nosample () =
+  Printf.printf "check_nosample\n%!";
+  precompute_marshalled_data 2 3000;
+  let fail_on_alloc _ =
+    Printf.printf "Callback called with sampling_rate = 0\n";
+    assert(false)
+  in
+  start ~callstack_size:10 ~sampling_rate:0. (alloc_tracker fail_on_alloc);
+  do_intern 2 3000 1 false;
+  stop ()
+
+let () = check_nosample ()
+
+let check_counts_full_major force_promote =
+  Printf.printf "check_counts_full_major\n%!";
+  precompute_marshalled_data 2 3000;
+  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
+    {
+      alloc_minor = (fun _ ->
+        if not !enable then None
+        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
+      );
+    };
+  do_intern 2 3000 1 true;
+  enable := false;
+  assert (!ndealloc_minor = 0 && !ndealloc_major = 0);
+  if force_promote then begin
+    Gc.full_major ();
+    assert (!ndealloc_minor = 0 && !ndealloc_major = 0 &&
+            !npromote = !nalloc_minor);
+    root := [];
+    Gc.full_major ();
+    assert (!ndealloc_minor = 0 &&
+            !ndealloc_major = !nalloc_minor + !nalloc_major);
+  end else begin
+    root := [];
+    Gc.minor ();
+    Gc.full_major ();
+    Gc.full_major ();
+    assert (!nalloc_minor = !ndealloc_minor + !npromote &&
+            !ndealloc_major = !npromote + !nalloc_major)
+  end;
+  stop ()
+
+let () =
+  check_counts_full_major false;
+  check_counts_full_major true
+
+let check_no_nested () =
+  Printf.printf "check_no_nested\n%!";
+  precompute_marshalled_data 2 300;
+  let in_callback = ref false in
+  let cb _ =
+    assert (not !in_callback);
+    in_callback := true;
+    do_intern 100 200 1 false;
+    in_callback := false;
+    ()
+  in
+  let cb' _ = cb (); Some () in
+  start ~callstack_size:10 ~sampling_rate:1.
+    {
+      alloc_minor = cb';
+      alloc_major = cb';
+      promote = cb';
+      dealloc_minor = cb;
+      dealloc_major = cb;
+    };
+  do_intern 100 200 1 false;
+  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;
+  precompute_marshalled_data lo hi;
+  let smp = ref 0 in
+  let alloc info =
+    (* We also allocate the list constructor in the minor heap,
+       so we filter that out. *)
+    if info.unmarshalled then begin
+      assert (info.size = 1 || info.size = 2);
+      assert (info.n_samples > 0);
+      smp := !smp + info.n_samples
+    end;
+  in
+  start ~callstack_size:10 ~sampling_rate:rate (alloc_tracker alloc);
+  do_intern lo hi cnt false;
+  stop ();
+
+  (* The probability distribution of the number of samples follows a
+     binomial distribution of parameters tot_alloc and rate. Given
+     that tot_alloc*rate and tot_alloc*(1-rate) are large (i.e., >
+     100), this distribution is approximately equal to a normal
+     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*(lo+hi)*(hi-lo+1)/2 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 () =
+  check_distrib 2 3000 3 0.00001;
+  check_distrib 2 3000 1 0.0001;
+  check_distrib 2 2000 1 0.01;
+  check_distrib 2 2000 1 0.9;
+  check_distrib 300000 300000 20 0.1
+
+let () =
+  Printf.printf "OK !\n"
diff --git a/testsuite/tests/statmemprof/intern.reference b/testsuite/tests/statmemprof/intern.reference
new file mode 100644
index 00000000..d83e8d6d
--- /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
new file mode 100644
index 00000000..7a3736a2
--- /dev/null
+++ b/testsuite/tests/statmemprof/lists_in_minor.ml
@@ -0,0 +1,60 @@
+(* TEST
+   flags = "-g"
+   * bytecode
+   * native
+     compare_programs = "false"
+*)
+
+open Gc.Memprof
+
+let rec allocate_list accu = function
+  | 0 -> accu
+  | n -> allocate_list (n::accu) (n-1)
+
+let[@inline never] allocate_lists len cnt =
+  for j = 0 to cnt-1 do
+    ignore (allocate_list [] len)
+  done
+
+let check_distrib len cnt rate =
+  Printf.printf "check_distrib %d %d %f\n%!" len cnt rate;
+  let smp = ref 0 in
+  start ~callstack_size:10 ~sampling_rate:rate
+    { null_tracker with
+      alloc_major = (fun _ -> assert false);
+      alloc_minor = (fun info ->
+        assert (info.size = 2);
+        assert (info.n_samples > 0);
+        assert (not info.unmarshalled);
+        smp := !smp + info.n_samples;
+        None);
+    };
+  allocate_lists len cnt;
+  stop ();
+
+  (* The probability distribution of the number of samples follows a
+     binomial distribution of parameters tot_alloc and rate. Given
+     that tot_alloc*rate and tot_alloc*(1-rate) are large (i.e., >
+     100), this distribution is approximately equal to a normal
+     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 () =
+  check_distrib 10 1000000 0.01;
+  check_distrib 1000000 10 0.00001;
+  check_distrib 1000000 10 0.0001;
+  check_distrib 1000000 10 0.001;
+  check_distrib 1000000 10 0.01;
+  check_distrib 100000 10 0.1;
+  check_distrib 100000 10 0.9
+
+let () =
+  Printf.printf "OK !\n"
diff --git a/testsuite/tests/statmemprof/lists_in_minor.reference b/testsuite/tests/statmemprof/lists_in_minor.reference
new file mode 100644
index 00000000..11cfe0ca
--- /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_no_postpone.ml b/testsuite/tests/statmemprof/minor_no_postpone.ml
new file mode 100644
index 00000000..9d9ecd79
--- /dev/null
+++ b/testsuite/tests/statmemprof/minor_no_postpone.ml
@@ -0,0 +1,36 @@
+(* TEST
+   modules = "minor_no_postpone_stub.c"
+*)
+
+open Gc.Memprof
+
+let notify_minor ref_ok ref_done =
+  { 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);
+  ignore (Sys.opaque_identity (ref 0));
+  assert(!callback_done);
+  callback_ok := false;
+  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);
+  ignore (Sys.opaque_identity (alloc_stub ()));
+  assert(not !callback_done);
+  callback_ok := true;
+  stop ();
+  assert(!callback_done)
diff --git a/testsuite/tests/statmemprof/minor_no_postpone_stub.c b/testsuite/tests/statmemprof/minor_no_postpone_stub.c
new file mode 100644
index 00000000..5df6cc51
--- /dev/null
+++ b/testsuite/tests/statmemprof/minor_no_postpone_stub.c
@@ -0,0 +1,5 @@
+#include "caml/alloc.h"
+
+value alloc_stub(value v) {
+  return caml_alloc(1, 0);
+}
diff --git a/testsuite/tests/statmemprof/thread_exit_in_callback.ml b/testsuite/tests/statmemprof/thread_exit_in_callback.ml
new file mode 100644
index 00000000..97c1a3ae
--- /dev/null
+++ b/testsuite/tests/statmemprof/thread_exit_in_callback.ml
@@ -0,0 +1,18 @@
+(* TEST
+modules = "thread_exit_in_callback_stub.c"
+exit_status = "42"
+* hassysthreads
+include systhreads
+** bytecode
+** native
+*)
+
+(* We cannot tell Ocamltest that this program is supposed to stop with
+   a fatal error. Instead, we install a fatal error hook and call exit(42) *)
+external install_fatal_error_hook : unit -> unit = "install_fatal_error_hook"
+
+let _ =
+  install_fatal_error_hook ();
+  Gc.Memprof.(start ~callstack_size:10 ~sampling_rate:1.
+    { null_tracker with alloc_minor = fun _ -> Thread.exit (); None });
+  ignore (Sys.opaque_identity (ref 1))
diff --git a/testsuite/tests/statmemprof/thread_exit_in_callback.reference b/testsuite/tests/statmemprof/thread_exit_in_callback.reference
new file mode 100644
index 00000000..4d745f0c
--- /dev/null
+++ b/testsuite/tests/statmemprof/thread_exit_in_callback.reference
@@ -0,0 +1 @@
+Fatal error hook: Thread.exit called from a memprof callback.
diff --git a/testsuite/tests/statmemprof/thread_exit_in_callback_stub.c b/testsuite/tests/statmemprof/thread_exit_in_callback_stub.c
new file mode 100644
index 00000000..91ed43cc
--- /dev/null
+++ b/testsuite/tests/statmemprof/thread_exit_in_callback_stub.c
@@ -0,0 +1,16 @@
+#include <stdio.h>
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+
+void fatal_error_hook_exit_3 (char *msg, va_list args) {
+  fprintf(stderr, "Fatal error hook: ");
+  vfprintf(stderr, msg, args);
+  fprintf(stderr, "\n");
+  exit(42);
+}
+
+
+value install_fatal_error_hook (value unit) {
+  caml_fatal_error_hook = fatal_error_hook_exit_3;
+  return Val_unit;
+}
diff --git a/testsuite/tests/tool-caml-tex/ellipses.input b/testsuite/tests/tool-caml-tex/ellipses.input
new file mode 100644
index 00000000..c230fd2e
--- /dev/null
+++ b/testsuite/tests/tool-caml-tex/ellipses.input
@@ -0,0 +1,48 @@
+\begin{caml_example*}{verbatim}
+let start = 0
+[@@@ellipsis.start]
+let hidden = succ start
+[@@@ellipsis.stop]
+let mid = succ hidden
+let[@ellipsis] statement = succ mid
+
+module E = struct end
+include E[@@ellipsis]
+
+let expr = succ statement[@ellipsis]
+
+let pat = match start with
+  | 0[@ellipsis] | 1 -> succ expr
+  | _ -> succ expr
+
+let case = match start with
+  | 0 -> succ pat
+  | _[@ellipsis.start] -> succ pat[@ellipsis.stop]
+
+
+let annot: int[@ellipsis] = succ case
+
+let subexpr = succ annot + (2[@ellipsis.stop] - 1[@ellipsis.start] * 2) - 2
+
+class[@ellipsis] c = object val x = succ subexpr end
+
+class c2 = object
+  val[@ellipsis] x = 0
+  val y = 1
+  method[@ellipsis] m = 2
+  method n = 3
+  [@@@ellipsis.start]
+  method l = 4
+  [@@@ellipsis.stop]
+end
+
+type t = A[@ellipsis] | B |C[@ellipsis.start] | D | E [@ellipsis.stop] | F
+type arrow = int -> (int -> int[@ellipsis])
+type record = { a:int; b:int[@ellipsis]; c:int;
+                d:int[@ellipsis.start]; e:int; f:int[@ellipsis.stop];
+                g:int }
+type polyvar = [`A|`B[@ellipsis] |`C
+               |`D[@ellipsis.start] | `E | `F [@ellipsis.stop]
+               | `G ]
+type exn += A[@ellipsis] | B |C[@ellipsis.start] | D | E [@ellipsis.stop] | F
+\end{caml_example*}
diff --git a/testsuite/tests/tool-caml-tex/ellipses.ml b/testsuite/tests/tool-caml-tex/ellipses.ml
new file mode 100644
index 00000000..b360bfa6
--- /dev/null
+++ b/testsuite/tests/tool-caml-tex/ellipses.ml
@@ -0,0 +1,12 @@
+(* TEST
+   reference="${test_source_directory}/ellipses.reference"
+   output="ellipses.output"
+   files="${test_source_directory}/ellipses.input"
+   script = "${ocamlrun} ${ocamlsrcdir}/tools/caml-tex \
+   -repo-root ${ocamlsrcdir} ${files} -o ${output}"
+  * hasstr
+  ** native-compiler
+  *** shared-libraries
+  **** script with unix,str
+  ***** check-program-output
+*)
diff --git a/testsuite/tests/tool-caml-tex/ellipses.reference b/testsuite/tests/tool-caml-tex/ellipses.reference
new file mode 100644
index 00000000..35c6b849
--- /dev/null
+++ b/testsuite/tests/tool-caml-tex/ellipses.reference
@@ -0,0 +1,48 @@
+\begin{camlexample}{verbatim}
+\begin{caml}
+\begin{camlinput}
+$\?$let start = 0
+$\?$$\ldots$
+$\?$let mid = succ hidden
+$\?$$\ldots$
+
+$\?$module E = struct end
+$\?$$\ldots$
+
+$\?$let expr = $\ldots$
+
+$\?$let pat = match start with
+$\?$  | $\ldots$ | 1 -> succ expr
+$\?$  | _ -> succ expr
+
+$\?$let case = match start with
+$\?$  | 0 -> succ pat
+$\?$  | $\ldots$
+
+
+$\?$let annot: $\ldots$ = succ case
+
+$\?$let subexpr = succ annot + ($\ldots$ * 2) - 2
+
+$\?$$\ldots$
+
+$\?$class c2 = object
+$\?$  $\ldots$
+$\?$  val y = 1
+$\?$  $\ldots$
+$\?$  method n = 3
+$\?$  $\ldots$
+$\?$end
+
+$\?$type t = $\ldots$ | B $\ldots$ | F
+$\?$type arrow = int -> ($\ldots$)
+$\?$type record = { a:int; $\ldots$ c:int;
+$\?$                $\ldots$
+$\?$                g:int }
+$\?$type polyvar = [`A|$\ldots$ |`C
+$\?$               |$\ldots$
+$\?$               | `G ]
+$\?$type exn += $\ldots$ | B $\ldots$ | F
+\end{camlinput}
+\end{caml}
+\end{camlexample}
diff --git a/testsuite/tests/tool-caml-tex/redirections.input b/testsuite/tests/tool-caml-tex/redirections.input
new file mode 100644
index 00000000..77ad0ab1
--- /dev/null
+++ b/testsuite/tests/tool-caml-tex/redirections.input
@@ -0,0 +1,10 @@
+\begin{caml_example}{toplevel}
+[@@@warning "+A"];;
+1 + 2. [@@expect error];;
+let f x = () [@@expect warning 27];;
+\end{caml_example}
+
+\begin{caml_example}{toplevel}
+Format.printf "Hello@.";
+print_endline "world";;
+\end{caml_example}
diff --git a/testsuite/tests/tool-caml-tex/redirections.ml b/testsuite/tests/tool-caml-tex/redirections.ml
new file mode 100644
index 00000000..9980e451
--- /dev/null
+++ b/testsuite/tests/tool-caml-tex/redirections.ml
@@ -0,0 +1,17 @@
+(* TEST
+   reference="${test_source_directory}/redirections.reference"
+   output="redirections.output"
+   files="${test_source_directory}/redirections.input"
+   script = "${ocamlrun} ${ocamlsrcdir}/tools/caml-tex \
+   -repo-root ${ocamlsrcdir} ${files} -o ${output}"
+  * hasstr
+  ** native-compiler
+  *** shared-libraries
+  **** script with unix,str
+  ***** check-program-output
+  *** no-shared-libraries
+  **** script with unix,str
+   script = "${ocamlsrcdir}/tools/caml-tex \
+   -repo-root ${ocamlsrcdir} ${files} -o ${output}"
+  ***** check-program-output
+*)
diff --git a/testsuite/tests/tool-caml-tex/redirections.reference b/testsuite/tests/tool-caml-tex/redirections.reference
new file mode 100644
index 00000000..538b45f9
--- /dev/null
+++ b/testsuite/tests/tool-caml-tex/redirections.reference
@@ -0,0 +1,39 @@
+\begin{camlexample}{toplevel}
+\begin{caml}
+\begin{camlinput}
+$\?$[@@@warning "+A"];;
+\end{camlinput}
+\end{caml}
+\begin{caml}
+\begin{camlinput}
+$\?$1 + <<2.>> ;;
+\end{camlinput}
+\begin{camlerror}
+$\:$Error: This expression has type float but an expression was expected of type
+$\:$         int
+\end{camlerror}
+\end{caml}
+\begin{caml}
+\begin{camlinput}
+$\?$let f <<x>> = () ;;
+\end{camlinput}
+\begin{camlwarn}
+$\:$Warning 27: unused variable x.
+$\:$val f : 'a -> unit = <fun>
+\end{camlwarn}
+\end{caml}
+\end{camlexample}
+
+\begin{camlexample}{toplevel}
+\begin{caml}
+\begin{camlinput}
+$\?$Format.printf "Hello@.";
+$\?$print_endline "world";;
+\end{camlinput}
+\begin{camloutput}
+$\:$Hello
+$\:$world
+$\:$- : unit = ()
+\end{camloutput}
+\end{caml}
+\end{camlexample}
diff --git a/testsuite/tests/tool-command-line/test.compilers.reference b/testsuite/tests/tool-command-line/test.compilers.reference
new file mode 100644
index 00000000..9182c8a7
--- /dev/null
+++ b/testsuite/tests/tool-command-line/test.compilers.reference
@@ -0,0 +1 @@
+don't know what to do with unknown-file
diff --git a/testsuite/tests/tool-command-line/test.ml b/testsuite/tests/tool-command-line/test.ml
new file mode 100644
index 00000000..61dc8b0e
--- /dev/null
+++ b/testsuite/tests/tool-command-line/test.ml
@@ -0,0 +1,31 @@
+(* TEST
+
+files = "unknown-file"
+
+* setup-ocamlc.byte-build-env
+compiler_output = "compiler-output.raw"
+** ocamlc.byte
+all_modules = ""
+flags = "unknown-file"
+ocamlc_byte_exit_status = "2"
+*** script
+script = "grep 'know what to do with unknown-file' compiler-output.raw"
+output = "compiler-output"
+**** check-ocamlc.byte-output
+compiler_output = "compiler-output"
+
+* setup-ocamlopt.byte-build-env
+compiler_output = "compiler-output.raw"
+** ocamlopt.byte
+all_modules = ""
+flags = "unknown-file"
+ocamlopt_byte_exit_status = "2"
+*** script
+script = "grep 'know what to do with unknown-file' compiler-output.raw"
+output = "compiler-output"
+**** check-ocamlopt.byte-output
+compiler_output = "compiler-output"
+
+*)
+
+(* this file is just a test driver, the test does not contain real OCamlcode *)
diff --git a/testsuite/tests/tool-command-line/unknown-file b/testsuite/tests/tool-command-line/unknown-file
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/tool-debugger/basic/debuggee.ml b/testsuite/tests/tool-debugger/basic/debuggee.ml
new file mode 100644
index 00000000..91ad3c21
--- /dev/null
+++ b/testsuite/tests/tool-debugger/basic/debuggee.ml
@@ -0,0 +1,15 @@
+(* TEST
+set foo = "bar"
+flags += " -g "
+ocamldebug_script = "${test_source_directory}/input_script"
+* debugger
+** shared-libraries
+*** setup-ocamlc.byte-build-env
+**** ocamlc.byte
+***** check-ocamlc.byte-output
+****** ocamldebug
+******* check-program-output
+*)
+
+print_endline Sys.argv.(1);;
+print_endline (Sys.getenv "foo");;
diff --git a/testsuite/tests/tool-debugger/basic/debuggee.reference b/testsuite/tests/tool-debugger/basic/debuggee.reference
new file mode 100644
index 00000000..fa9830a6
--- /dev/null
+++ b/testsuite/tests/tool-debugger/basic/debuggee.reference
@@ -0,0 +1,4 @@
+Loading program... done.
+arg1
+notbar
+Program exit.
diff --git a/testsuite/tests/tool-debugger/basic/input_script b/testsuite/tests/tool-debugger/basic/input_script
new file mode 100644
index 00000000..2caf06dd
--- /dev/null
+++ b/testsuite/tests/tool-debugger/basic/input_script
@@ -0,0 +1,5 @@
+set arguments arg1 arg2
+environment foo=bar
+environment foo=notbar
+run
+quit
diff --git a/testsuite/tests/tool-debugger/dynlink/host.debug.reference b/testsuite/tests/tool-debugger/dynlink/host.debug.reference
new file mode 100644
index 00000000..2c3438ce
--- /dev/null
+++ b/testsuite/tests/tool-debugger/dynlink/host.debug.reference
@@ -0,0 +1,11 @@
+Loading program... done.
+hello host
+
+Module(s) Plugin loaded.
+Breakpoint: 1
+2   <|b|>print_endline "hello plugin"
+Backtrace:
+#0 Plugin plugin.ml:2:3
+#1 Plugin plugin.ml:4:10
+hello plugin
+Program exit.
diff --git a/testsuite/tests/tool-debugger/dynlink/host.ml b/testsuite/tests/tool-debugger/dynlink/host.ml
new file mode 100644
index 00000000..3f9a9d0e
--- /dev/null
+++ b/testsuite/tests/tool-debugger/dynlink/host.ml
@@ -0,0 +1,35 @@
+(* TEST
+
+include dynlink
+files = "host.ml plugin.ml"
+libraries = ""
+
+flags += " -g "
+ocamldebug_script = "${test_source_directory}/input_script"
+
+* debugger
+** shared-libraries
+*** setup-ocamlc.byte-build-env
+**** ocamlc.byte
+module = "host.ml"
+***** ocamlc.byte
+module = "plugin.ml"
+****** ocamlc.byte
+module = ""
+all_modules = "host.cmo"
+program = "${test_build_directory}/host.byte"
+libraries = "dynlink"
+
+******* run
+output = "host.output"
+******** check-program-output
+reference = "${test_source_directory}/host.reference"
+
+******** ocamldebug
+output = "host.debug.output"
+********* check-program-output
+reference = "${test_source_directory}/host.debug.reference"
+
+*)
+
+let () = print_endline "hello host"; Dynlink.loadfile "plugin.cmo"
diff --git a/testsuite/tests/tool-debugger/dynlink/host.reference b/testsuite/tests/tool-debugger/dynlink/host.reference
new file mode 100644
index 00000000..87d1fa92
--- /dev/null
+++ b/testsuite/tests/tool-debugger/dynlink/host.reference
@@ -0,0 +1,2 @@
+hello host
+hello plugin
diff --git a/testsuite/tests/tool-debugger/dynlink/input_script b/testsuite/tests/tool-debugger/dynlink/input_script
new file mode 100644
index 00000000..7f317811
--- /dev/null
+++ b/testsuite/tests/tool-debugger/dynlink/input_script
@@ -0,0 +1,5 @@
+r
+br @ Plugin 2
+r
+bt
+r
diff --git a/testsuite/tests/tool-debugger/dynlink/plugin.ml b/testsuite/tests/tool-debugger/dynlink/plugin.ml
new file mode 100644
index 00000000..44160161
--- /dev/null
+++ b/testsuite/tests/tool-debugger/dynlink/plugin.ml
@@ -0,0 +1,4 @@
+let do_plugin () =
+  print_endline "hello plugin"
+
+let () = do_plugin ()
diff --git a/testsuite/tests/tool-debugger/find-artifacts/debuggee.ml b/testsuite/tests/tool-debugger/find-artifacts/debuggee.ml
new file mode 100644
index 00000000..70aee3ff
--- /dev/null
+++ b/testsuite/tests/tool-debugger/find-artifacts/debuggee.ml
@@ -0,0 +1,25 @@
+(* TEST
+ocamldebug_script = "${test_source_directory}/input_script"
+* debugger
+** shared-libraries
+*** setup-ocamlc.byte-build-env
+**** script
+script = "mkdir out"
+***** ocamlc.byte
+flags = "-g -c"
+all_modules = "${test_source_directory}/in/blah.ml"
+program = "out/blah.cmo"
+****** ocamlc.byte
+program = "out/foo.cmo"
+flags = "-I out -g -c"
+all_modules = "${test_source_directory}/in/foo.ml"
+******* ocamlc.byte
+all_modules = "out/blah.cmo out/foo.cmo"
+flags = " -g "
+program = "debuggee.exe"
+******** check-ocamlc.byte-output
+********* ocamldebug
+********** check-program-output
+*)
+
+(* This file only contains the specification of how to run the test *)
diff --git a/testsuite/tests/tool-debugger/find-artifacts/debuggee.reference b/testsuite/tests/tool-debugger/find-artifacts/debuggee.reference
new file mode 100644
index 00000000..127d6672
--- /dev/null
+++ b/testsuite/tests/tool-debugger/find-artifacts/debuggee.reference
@@ -0,0 +1,5 @@
+Loading program... done.
+Breakpoint: 1
+10   <|b|>print x;
+x: Blah.blah = Foo
+y: Blah.blah = Bar "hi"
diff --git a/testsuite/tests/tool-debugger/find-artifacts/in/blah.ml b/testsuite/tests/tool-debugger/find-artifacts/in/blah.ml
new file mode 100644
index 00000000..462c07b2
--- /dev/null
+++ b/testsuite/tests/tool-debugger/find-artifacts/in/blah.ml
@@ -0,0 +1,3 @@
+type blah =
+  | Foo
+  | Bar of string
diff --git a/testsuite/tests/tool-debugger/find-artifacts/in/foo.ml b/testsuite/tests/tool-debugger/find-artifacts/in/foo.ml
new file mode 100644
index 00000000..8d992673
--- /dev/null
+++ b/testsuite/tests/tool-debugger/find-artifacts/in/foo.ml
@@ -0,0 +1,13 @@
+open Blah
+
+let print = function
+  | Foo -> print_endline "Foo";
+  | Bar s -> print_endline ("Bar(" ^ s ^ ")")
+
+let main () =
+  let x = Foo in
+  let y = Bar "hi" in
+  print x;
+  print y
+
+let _ = main ()
diff --git a/testsuite/tests/tool-debugger/find-artifacts/input_script b/testsuite/tests/tool-debugger/find-artifacts/input_script
new file mode 100644
index 00000000..4b907c5a
--- /dev/null
+++ b/testsuite/tests/tool-debugger/find-artifacts/input_script
@@ -0,0 +1,5 @@
+break @ Foo 10
+run
+print x
+print y
+quit
diff --git a/testsuite/tests/tool-debugger/no_debug_event/a.ml b/testsuite/tests/tool-debugger/no_debug_event/a.ml
new file mode 100644
index 00000000..0547b3d0
--- /dev/null
+++ b/testsuite/tests/tool-debugger/no_debug_event/a.ml
@@ -0,0 +1 @@
+let x = 1
diff --git a/testsuite/tests/tool-debugger/no_debug_event/b.ml b/testsuite/tests/tool-debugger/no_debug_event/b.ml
new file mode 100644
index 00000000..83502097
--- /dev/null
+++ b/testsuite/tests/tool-debugger/no_debug_event/b.ml
@@ -0,0 +1,3 @@
+let () =
+  print_int Foo.A.x;
+  print_newline ()
diff --git a/testsuite/tests/tool-debugger/no_debug_event/input_script b/testsuite/tests/tool-debugger/no_debug_event/input_script
new file mode 100644
index 00000000..58afc787
--- /dev/null
+++ b/testsuite/tests/tool-debugger/no_debug_event/input_script
@@ -0,0 +1,2 @@
+run
+quit
diff --git a/testsuite/tests/tool-debugger/no_debug_event/noev.ml b/testsuite/tests/tool-debugger/no_debug_event/noev.ml
new file mode 100644
index 00000000..2cf9866b
--- /dev/null
+++ b/testsuite/tests/tool-debugger/no_debug_event/noev.ml
@@ -0,0 +1,28 @@
+(* TEST
+files = "a.ml b.ml"
+ocamldebug_script = "${test_source_directory}/input_script"
+* debugger
+** shared-libraries
+*** setup-ocamlc.byte-build-env
+**** ocamlc.byte
+module = "a.ml"
+flags = "-g -for-pack foo"
+***** ocamlc.byte
+module = ""
+all_modules = "a.cmo"
+program = "foo.cmo"
+flags = "-g -pack"
+****** ocamlc.byte
+module = "b.ml"
+flags = " -g "
+******* ocamlc.byte
+module = ""
+flags = " -g "
+all_modules = "foo.cmo b.cmo"
+program = "${test_build_directory}/noev.exe"
+******** check-ocamlc.byte-output
+********* ocamldebug
+********** check-program-output
+*)
+
+(* This file only contains the specification of how to run the test *)
diff --git a/testsuite/tests/tool-debugger/no_debug_event/noev.reference b/testsuite/tests/tool-debugger/no_debug_event/noev.reference
new file mode 100644
index 00000000..25598a7e
--- /dev/null
+++ b/testsuite/tests/tool-debugger/no_debug_event/noev.reference
@@ -0,0 +1,3 @@
+Loading program... done.
+1
+Program exit.
diff --git a/testsuite/tests/tool-debugger/printer/debuggee.ml b/testsuite/tests/tool-debugger/printer/debuggee.ml
new file mode 100644
index 00000000..3289f518
--- /dev/null
+++ b/testsuite/tests/tool-debugger/printer/debuggee.ml
@@ -0,0 +1,22 @@
+(* TEST
+flags += " -g "
+ocamldebug_script = "${test_source_directory}/input_script"
+files = "printer.ml"
+include debugger
+* debugger
+** shared-libraries
+*** setup-ocamlc.byte-build-env
+**** ocamlc.byte
+module = "printer.ml"
+**** ocamlc.byte
+***** check-ocamlc.byte-output
+****** ocamldebug
+******* check-program-output
+*)
+
+let f x =
+  for _i = 0 to x do
+    print_endline "..."
+  done
+
+let () = f 3
diff --git a/testsuite/tests/tool-debugger/printer/debuggee.reference b/testsuite/tests/tool-debugger/printer/debuggee.reference
new file mode 100644
index 00000000..2d06dde6
--- /dev/null
+++ b/testsuite/tests/tool-debugger/printer/debuggee.reference
@@ -0,0 +1,5 @@
+File printer.cmo loaded
+Loading program... done.
+Breakpoint: 1
+18   <|b|>for _i = 0 to x do
+x: int = S S O
diff --git a/testsuite/tests/tool-debugger/printer/input_script b/testsuite/tests/tool-debugger/printer/input_script
new file mode 100644
index 00000000..b1279f60
--- /dev/null
+++ b/testsuite/tests/tool-debugger/printer/input_script
@@ -0,0 +1,7 @@
+load_printer printer.cmo
+install_printer Printer.p
+set print_depth 2
+break @ Debuggee 18
+run
+print x
+quit
diff --git a/testsuite/tests/tool-debugger/printer/printer.ml b/testsuite/tests/tool-debugger/printer/printer.ml
new file mode 100644
index 00000000..6ad8f615
--- /dev/null
+++ b/testsuite/tests/tool-debugger/printer/printer.ml
@@ -0,0 +1,8 @@
+let p : Format.formatter -> int -> unit = fun fmt n ->
+  (* We use `max_printer_depth` to tweak the output so that
+     this test shows that the printer not only compiles
+     against the debugger's code, but also uses its state. *)
+  for _i = 1 to min n !Printval.max_printer_depth do
+    Format.pp_print_string fmt "S ";
+  done;
+  Format.pp_print_string fmt "O"
diff --git a/testsuite/tests/tool-expect-test/clean_typer.ml b/testsuite/tests/tool-expect-test/clean_typer.ml
new file mode 100644
index 00000000..535ce8d8
--- /dev/null
+++ b/testsuite/tests/tool-expect-test/clean_typer.ml
@@ -0,0 +1,82 @@
+(* TEST
+    * expect
+*)
+
+module Variants = struct
+  type bar = [ `Bar ]
+  type foo = private [< `Foo | `Bar ]
+end
+
+open Variants
+
+module M : sig
+  type +'a t
+
+  val foo : unit -> foo t
+  val bar : unit -> bar t
+end = struct
+  type 'a t = 'a list
+
+  let foo () = []
+  let bar () = []
+end
+
+module type Foo = sig
+  val x : foo M.t -> unit
+end
+
+let ffoo t (module F : Foo) =
+  F.x t
+
+module type Bar = sig
+  val x : bar M.t -> unit
+end
+
+let fbar t (module B : Bar) =
+  B.x t
+
+let (foo : foo M.t) = M.foo ()
+let (bar : bar M.t) = M.bar ()
+[%%expect {|
+module Variants :
+  sig type bar = [ `Bar ] type foo = private [< `Bar | `Foo ] end
+module M :
+  sig
+    type +'a t
+    val foo : unit -> Variants.foo t
+    val bar : unit -> Variants.bar t
+  end
+module type Foo = sig val x : Variants.foo M.t -> unit end
+val ffoo : Variants.foo M.t -> (module Foo) -> unit = <fun>
+module type Bar = sig val x : Variants.bar M.t -> unit end
+val fbar : Variants.bar M.t -> (module Bar) -> unit = <fun>
+val foo : Variants.foo M.t = <abstr>
+val bar : Variants.bar M.t = <abstr>
+|}]
+
+let f1 = ffoo foo;;
+[%%expect {|
+val f1 : (module Foo) -> unit = <fun>
+|}]
+
+let f2 = ffoo bar;;
+[%%expect {|
+Line 1, characters 14-17:
+1 | let f2 = ffoo bar;;
+                  ^^^
+Error: This expression 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
+|}]
+
+let f3 = fbar foo;;
+[%%expect {|
+Line 1, characters 14-17:
+1 | let f3 = fbar foo;;
+                  ^^^
+Error: This expression 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/chars.mll b/testsuite/tests/tool-lexyacc/chars.mll
new file mode 100644
index 00000000..b91f2618
--- /dev/null
+++ b/testsuite/tests/tool-lexyacc/chars.mll
@@ -0,0 +1,17 @@
+(* TEST
+  ocamllex_flags = " -q "
+*)
+
+{
+let f' _ = ()
+let f1 _ = ()
+let f2 _ _ = ()
+}
+
+rule token = parse
+  | 'a' { f' '"' }
+  | 'b' { f2 '\o170' '"' }
+  | 'c' { f1 "\u{1F42B}" }
+  | 'd' { f1 {|}|} }
+  | 'e' { (* " *) } (* " *) }
+  | 'f' { (* {%foo bar| *) } (* |bar} *) }
diff --git a/testsuite/tests/tool-lexyacc/gram_aux.ml b/testsuite/tests/tool-lexyacc/gram_aux.ml
new file mode 100644
index 00000000..019565f8
--- /dev/null
+++ b/testsuite/tests/tool-lexyacc/gram_aux.ml
@@ -0,0 +1,32 @@
+(* Auxiliaries for the parser. *)
+
+open Syntax
+
+let regexp_for_string s =
+  let l = String.length s in
+  if l = 0 then
+    Epsilon
+  else begin
+    let re = ref(Characters [String.get s (l - 1)]) in
+    for i = l - 2 downto 0 do
+      re := Sequence(Characters [String.get s i], !re)
+    done;
+    !re
+  end
+
+
+let char_class c1 c2 =
+  let cl = ref [] in
+  for i = Char.code c2 downto Char.code c1 do
+    cl := Char.chr i :: !cl
+  done;
+  !cl
+
+
+let all_chars = char_class '\001' '\255'
+
+
+let rec subtract l1 l2 =
+  match l1 with
+    [] -> []
+  | a::l -> if List.mem a l2 then subtract l l2 else a :: subtract l l2
diff --git a/testsuite/tests/tool-lexyacc/grammar.mly b/testsuite/tests/tool-lexyacc/grammar.mly
new file mode 100644
index 00000000..7247eca5
--- /dev/null
+++ b/testsuite/tests/tool-lexyacc/grammar.mly
@@ -0,0 +1,110 @@
+/* The grammar for lexer definitions */
+
+%{
+open Syntax
+open Gram_aux
+
+(* test f' '"' *)
+let () =
+  let f' = ignore in
+  f' '"'
+
+(* test {|*)|}, {%foo|*)|} and {%%f.oo bar|*)|bar} *)
+(* test {%foo {%| *)
+
+let () = ignore {foo||foo}
+%}
+
+%token <string> Tident
+%token <char> Tchar
+%token <string> Tstring
+%token <Syntax.location> Taction
+%token Trule Tparse Tand Tequal Tend Tor Tunderscore Teof Tlbracket Trbracket
+%token Tstar Tmaybe Tplus Tlparen Trparen Tcaret Tdash
+
+%left Tor
+%left CONCAT
+%nonassoc Tmaybe
+%left Tstar
+%left Tplus
+
+%start lexer_definition
+%type <Syntax.lexer_definition> lexer_definition
+
+%%
+
+lexer_definition:
+    header Trule definition other_definitions Tend
+        { Lexdef($1, $3::(List.rev $4)) }
+;
+header:
+    Taction
+        { $1 (* '"' test that ocamlyacc can
+                    handle comments correctly"*)" "(*" *) }
+  |
+        { Location(0,0) }
+;
+other_definitions:
+    other_definitions Tand definition
+        { $3::$1 }
+  |
+        { [] }
+;
+definition:
+    Tident Tequal entry
+        { ($1,$3) }
+;
+entry:
+    Tparse case rest_of_entry
+        { $2 :: List.rev $3 }
+;
+rest_of_entry:
+    rest_of_entry Tor case
+        { $3::$1 }
+  |
+        { [] }
+;
+case:
+    regexp Taction
+        { ($1,$2) }
+;
+regexp:
+    Tunderscore
+        { Characters all_chars }
+  | Teof
+        { Characters ['\000'] }
+  | Tchar
+        { Characters [$1] }
+  | Tstring
+        { regexp_for_string $1 }
+  | Tlbracket char_class Trbracket
+        { Characters $2 }
+  | regexp Tstar
+        { Repetition $1 }
+  | regexp Tmaybe
+        { Alternative($1, Epsilon) }
+  | regexp Tplus
+        { Sequence($1, Repetition $1) }
+  | regexp Tor regexp
+        { Alternative($1,$3) }
+  | regexp regexp %prec CONCAT
+        { Sequence($1,$2) }
+  | Tlparen regexp Trparen
+        { $2 }
+;
+char_class:
+    Tcaret char_class1
+        { subtract all_chars $2 }
+  | char_class1
+        { $1 }
+;
+char_class1:
+    Tchar Tdash Tchar
+        { char_class $1 $3 }
+  | Tchar
+        { [$1] }
+  | char_class char_class %prec CONCAT
+        { $1 @ $2 }
+;
+
+%%
diff --git a/testsuite/tests/tool-lexyacc/input b/testsuite/tests/tool-lexyacc/input
new file mode 100644
index 00000000..6739bc30
--- /dev/null
+++ b/testsuite/tests/tool-lexyacc/input
@@ -0,0 +1,134 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The lexical analyzer for lexer definitions. *)
+
+{
+open Syntax
+open Grammar
+open Scan_aux
+}
+
+rule main = parse
+    [' ' '\010' '\013' '\009' ] +
+    { main lexbuf }
+  | "(*"
+    { comment_depth := 1;
+      comment lexbuf;
+      main lexbuf }
+  | (['A'-'Z' 'a'-'z'] | '_' ['A'-'Z' 'a'-'z' '\'' '0'-'9'])
+    ( '_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9'] ) *
+    { match Lexing.lexeme lexbuf with
+        "rule" -> Trule
+      | "parse" -> Tparse
+      | "and" -> Tand
+      | "eof" -> Teof
+      | s -> Tident s }
+  | '"'
+    { reset_string_buffer();
+      string lexbuf;
+      Tstring(get_stored_string()) }
+  | "'"
+    { Tchar(char lexbuf) }
+  | '{'
+    { let n1 = Lexing.lexeme_end lexbuf in
+        brace_depth := 1;
+        let n2 = action lexbuf in
+          Taction(Location(n1, n2)) }
+  | '='  { Tequal }
+  | ";;"  { Tend }
+  | '|'  { Tor }
+  | '_'  { Tunderscore }
+  | "eof"  { Teof }
+  | '['  { Tlbracket }
+  | ']'  { Trbracket }
+  | '*'  { Tstar }
+  | '?'  { Tmaybe }
+  | '+'  { Tplus }
+  | '('  { Tlparen }
+  | ')'  { Trparen }
+  | '^'  { Tcaret }
+  | '-'  { Tdash }
+  | eof
+    { raise(Lexical_error "unterminated lexer definition") }
+  | _
+    { raise(Lexical_error("illegal character " ^ Lexing.lexeme lexbuf)) }
+
+and action = parse
+    '{'
+    { incr brace_depth;
+      action lexbuf }
+  | '}'
+    { decr brace_depth;
+      if !brace_depth = 0 then Lexing.lexeme_start lexbuf else action lexbuf }
+  | '"'
+    { reset_string_buffer();
+      string lexbuf;
+      reset_string_buffer();
+      action lexbuf }
+  | '\''
+    { let _ = char lexbuf in action lexbuf }
+  | "(*"
+    { comment_depth := 1;
+      comment lexbuf;
+      action lexbuf }
+  | eof
+    { raise (Lexical_error "unterminated action") }
+  | _
+    { action lexbuf }
+
+and string = parse
+    '"'
+    { () }
+  | '\\' [' ' '\010' '\013' '\009' '\026' '\012'] +
+    { string lexbuf }
+  | '\\' ['\\' '"' 'n' 't' 'b' 'r']
+    { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
+      string lexbuf }
+  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
+    { store_string_char(char_for_decimal_code lexbuf 1);
+      string lexbuf }
+  | eof
+    { raise(Lexical_error "unterminated string") }
+  | _
+    { store_string_char(Lexing.lexeme_char lexbuf 0);
+      string lexbuf }
+
+and char = parse
+    [^ '\\'] "'"
+    { Lexing.lexeme_char lexbuf 0 }
+  | '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'"
+    { char_for_backslash (Lexing.lexeme_char lexbuf 1) }
+  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
+    { char_for_decimal_code lexbuf 1 }
+  | _
+    { raise(Lexical_error "bad character constant") }
+
+and comment = parse
+    "(*"
+    { incr comment_depth; comment lexbuf }
+  | "*)"
+    { decr comment_depth;
+      if !comment_depth = 0 then () else comment lexbuf }
+  | '"'
+    { reset_string_buffer();
+      string lexbuf;
+      reset_string_buffer();
+      comment lexbuf }
+  | eof
+    { raise(Lexical_error "unterminated comment") }
+  | _
+    { comment lexbuf }
+;;
diff --git a/testsuite/tests/tool-lexyacc/lexgen.ml b/testsuite/tests/tool-lexyacc/lexgen.ml
new file mode 100644
index 00000000..ff34fe01
--- /dev/null
+++ b/testsuite/tests/tool-lexyacc/lexgen.ml
@@ -0,0 +1,256 @@
+(* Compiling a lexer definition *)
+
+open Syntax
+
+(* Deep abstract syntax for regular expressions *)
+
+type regexp =
+    Empty
+  | Chars of int
+  | Action of int
+  | Seq of regexp * regexp
+  | Alt of regexp * regexp
+  | Star of regexp
+
+(* From shallow to deep syntax *)
+
+(***
+
+let print_char_class c =
+  let print_interval low high =
+    prerr_int low;
+    if high - 1 > low then begin
+      prerr_char '-';
+      prerr_int (high-1)
+    end;
+    prerr_char ' ' in
+  let rec print_class first next = function
+    [] -> print_interval first next
+  | c::l ->
+      if char.code c = next
+      then print_class first (next+1) l
+      else begin
+        print_interval first next;
+        print_class (char.code c) (char.code c + 1) l
+      end in
+  match c with
+    [] -> prerr_newline()
+  | c::l -> print_class (char.code c) (char.code c + 1) l; prerr_newline()
+
+
+let rec print_regexp = function
+    Empty -> prerr_string "Empty"
+  | Chars n -> prerr_string "Chars "; prerr_int n
+  | Action n -> prerr_string "Action "; prerr_int n
+  | Seq(r1,r2) -> print_regexp r1; prerr_string "; "; print_regexp r2
+  | Alt(r1,r2) ->
+      prerr_string "("; print_regexp r1; prerr_string " | "; print_regexp r2;
+      prerr_string ")"
+  | Star r -> prerr_string "("; print_regexp r; prerr_string ")*"
+
+***)
+
+let chars = ref ([] : char list list)
+let chars_count = ref 0
+let actions = ref ([] : (int * location) list)
+let actions_count = ref 0
+
+let rec encode_regexp = function
+    Epsilon -> Empty
+  | Characters cl ->
+      let n = !chars_count in
+(***      prerr_int n; prerr_char ' '; print_char_class cl; ***)
+      chars := cl :: !chars;
+      chars_count := !chars_count + 1;
+      Chars(n)
+  | Sequence(r1,r2) ->
+      Seq(encode_regexp r1, encode_regexp r2)
+  | Alternative(r1,r2) ->
+      Alt(encode_regexp r1, encode_regexp r2)
+  | Repetition r ->
+      Star (encode_regexp r)
+
+
+let encode_casedef =
+  List.fold_left
+   (fun reg (expr,act) ->
+     let act_num = !actions_count in
+     actions_count := !actions_count + 1;
+     actions := (act_num, act) :: !actions;
+     Alt(reg, Seq(encode_regexp expr, Action act_num)))
+  Empty
+
+
+let encode_lexdef (Lexdef(_, ld)) =
+  chars := [];
+  chars_count := 0;
+  actions := [];
+  actions_count := 0;
+  let name_regexp_list =
+    List.map (fun (name, casedef) -> (name, encode_casedef casedef)) ld in
+(*  List.iter print_char_class chars; *)
+  let chr = Array.of_list (List.rev !chars)
+  and act = !actions in
+  chars := [];
+  actions := [];
+  (chr, name_regexp_list, act)
+
+
+(* To generate directly a NFA from a regular expression.
+   Confer Aho-Sethi-Ullman, dragon book, chap. 3 *)
+
+type transition =
+    OnChars of int
+  | ToAction of int
+
+
+let rec merge_trans l1 l2 =
+  match (l1, l2) with
+    ([], s2) -> s2
+  | (s1, []) -> s1
+  | ((OnChars n1 as t1) :: r1 as s1), ((OnChars n2 as t2) :: r2 as s2) ->
+      if n1 = n2 then t1 :: merge_trans r1 r2 else
+      if n1 < n2 then t1 :: merge_trans r1 s2 else
+                      t2 :: merge_trans s1 r2
+  | ((ToAction n1 as t1) :: r1 as s1), ((ToAction n2 as t2) :: r2 as s2) ->
+      if n1 = n2 then t1 :: merge_trans r1 r2 else
+      if n1 < n2 then t1 :: merge_trans r1 s2 else
+                      t2 :: merge_trans s1 r2
+  | ((OnChars n1 as t1) :: r1), ((ToAction n2) :: r2 as s2) ->
+      t1 :: merge_trans r1 s2
+  | ((ToAction n1) :: r1 as s1), ((OnChars n2 as t2) :: r2) ->
+      t2 :: merge_trans s1 r2
+
+
+let rec nullable = function
+    Empty      -> true
+  | Chars _    -> false
+  | Action _   -> false
+  | Seq(r1,r2) -> nullable r1 && nullable r2
+  | Alt(r1,r2) -> nullable r1 || nullable r2
+  | Star r     -> true
+
+
+let rec firstpos = function
+    Empty      -> []
+  | Chars pos  -> [OnChars pos]
+  | Action act -> [ToAction act]
+  | Seq(r1,r2) -> if nullable r1
+                  then merge_trans (firstpos r1) (firstpos r2)
+                  else firstpos r1
+  | Alt(r1,r2) -> merge_trans (firstpos r1) (firstpos r2)
+  | Star r     -> firstpos r
+
+
+let rec lastpos = function
+    Empty      -> []
+  | Chars pos  -> [OnChars pos]
+  | Action act -> [ToAction act]
+  | Seq(r1,r2) -> if nullable r2
+                  then merge_trans (lastpos r1) (lastpos r2)
+                  else lastpos r2
+  | Alt(r1,r2) -> merge_trans (lastpos r1) (lastpos r2)
+  | Star r     -> lastpos r
+
+
+let followpos size name_regexp_list =
+  let v = Array.make size [] in
+    let fill_pos first = function
+        OnChars pos -> v.(pos) <- merge_trans first v.(pos); ()
+      | ToAction _  -> () in
+    let rec fill = function
+        Seq(r1,r2) ->
+          fill r1; fill r2;
+          List.iter (fill_pos (firstpos r2)) (lastpos r1)
+      | Alt(r1,r2) ->
+          fill r1; fill r2
+      | Star r ->
+          fill r;
+          List.iter (fill_pos (firstpos r)) (lastpos r)
+      | _ -> () in
+    List.iter (fun (name, regexp) -> fill regexp) name_regexp_list;
+    v
+
+
+let no_action = 0x3FFFFFFF
+
+let split_trans_set =
+  List.fold_left
+    (fun (act, pos_set as act_pos_set) trans ->
+       match trans with
+         OnChars pos   -> (act, pos :: pos_set)
+       | ToAction act1 -> if act1 < act then (act1, pos_set)
+                                             else act_pos_set)
+    (no_action, [])
+
+
+let memory = (Hashtbl.create 131 : (transition list, int) Hashtbl.t)
+let todo = ref ([] : (transition list * int) list)
+let next = ref 0
+
+let get_state st =
+  try
+    Hashtbl.find memory st
+  with Not_found ->
+    let nbr = !next in
+    next := !next + 1;
+    Hashtbl.add memory st nbr;
+    todo := (st, nbr) :: !todo;
+    nbr
+
+let rec map_on_states f =
+  match !todo with
+    []  -> []
+  | (st,i)::r -> todo := r; let res = f st in (res,i) :: map_on_states f
+
+let number_of_states () = !next
+
+let goto_state = function
+    [] -> Backtrack
+  | ps -> Goto (get_state ps)
+
+
+let transition_from chars follow pos_set =
+  let tr = Array.make 256 []
+  and shift = Array.make 256 Backtrack in
+    List.iter
+      (fun pos ->
+        List.iter
+          (fun c ->
+             tr.(Char.code c) <-
+               merge_trans tr.(Char.code c) follow.(pos))
+          chars.(pos))
+      pos_set;
+    for i = 0 to 255 do
+      shift.(i) <- goto_state tr.(i)
+    done;
+    shift
+
+
+let translate_state chars follow state =
+  match split_trans_set state with
+    n, [] -> Perform n
+  | n, ps -> Shift( (if n = no_action then No_remember else Remember n),
+                    transition_from chars follow ps)
+
+
+let make_dfa lexdef =
+  let (chars, name_regexp_list, actions) =
+    encode_lexdef lexdef in
+(**
+  List.iter (fun (name, regexp) ->
+               prerr_string name; prerr_string " = "; print_regexp regexp;
+               prerr_newline())
+            name_regexp_list;
+**)
+  let follow =
+    followpos (Array.length chars) name_regexp_list in
+  let initial_states =
+    List.map (fun (name, regexp) -> (name, get_state(firstpos regexp)))
+             name_regexp_list in
+  let states =
+    map_on_states (translate_state chars follow) in
+  let v =
+    Array.make (number_of_states()) (Perform 0) in
+  List.iter (fun (auto, i) -> v.(i) <- auto) states;
+  (initial_states, v, actions)
diff --git a/testsuite/tests/tool-lexyacc/main.compilers.reference b/testsuite/tests/tool-lexyacc/main.compilers.reference
new file mode 100644
index 00000000..a19b8c29
--- /dev/null
+++ b/testsuite/tests/tool-lexyacc/main.compilers.reference
@@ -0,0 +1 @@
+14 shift/reduce conflicts, 2 reduce/reduce conflicts.
diff --git a/testsuite/tests/tool-lexyacc/main.ml b/testsuite/tests/tool-lexyacc/main.ml
new file mode 100644
index 00000000..511a7769
--- /dev/null
+++ b/testsuite/tests/tool-lexyacc/main.ml
@@ -0,0 +1,115 @@
+(* TEST
+   modules = "syntax.ml gram_aux.ml grammar.mly scan_aux.ml scanner.mll \
+              lexgen.ml output.ml"
+   files = "input"
+   arguments = "input"
+   ocamllex_flags = " -q "
+   ocamlyacc_flags = " -q "
+   flags = " -w a "
+*)
+
+(* The lexer generator. Command-line parsing. *)
+
+open Syntax
+open Scanner
+open Grammar
+open Lexgen
+open Output
+
+let main () =
+  if Array.length Sys.argv <> 2 then begin
+    prerr_string "Usage: camllex <input file>\n";
+    exit 2
+  end;
+  let source_name = Sys.argv.(1) in
+  let dest_name =
+    if Filename.check_suffix source_name ".mll" then
+      Filename.chop_suffix source_name ".mll" ^ ".ml"
+    else
+      source_name ^ ".ml" in
+  ic := open_in source_name;
+(*  oc := open_out dest_name; *) ignore dest_name;
+  oc := stdout;
+  let lexbuf = Lexing.from_channel !ic in
+  let (Lexdef(header,_) as def) =
+    try
+      Grammar.lexer_definition Scanner.main lexbuf
+    with
+      Parsing.Parse_error ->
+        prerr_string "Syntax error around char ";
+        prerr_int (Lexing.lexeme_start lexbuf);
+        prerr_endline ".";
+        exit 2
+    | Scan_aux.Lexical_error s ->
+        prerr_string "Lexical error around char ";
+        prerr_int (Lexing.lexeme_start lexbuf);
+        prerr_string ": ";
+        prerr_string s;
+        prerr_endline ".";
+        exit 2 in
+  let ((init, states, acts) as dfa) = make_dfa def in
+  output_lexdef header dfa;
+  close_in !ic;
+  close_out !oc
+
+let _ = main(); exit 0
+
+
+(*****
+let main () =
+  ic := stdin;
+  oc := stdout;
+  let lexbuf = lexing.from_channel ic in
+  let (Lexdef(header,_) as def) =
+    try
+      grammar.lexer_definition scanner.main lexbuf
+    with
+      parsing.Parse_error x ->
+        prerr_string "Syntax error around char ";
+        prerr_int (lexing.lexeme_start lexbuf);
+        prerr_endline ".";
+        sys.exit 2
+    | scan_aux.Lexical_error s ->
+        prerr_string "Lexical error around char ";
+        prerr_int (lexing.lexeme_start lexbuf);
+        prerr_string ": ";
+        prerr_string s;
+        prerr_endline ".";
+        sys.exit 2 in
+  let ((init, states, acts) as dfa) = make_dfa def in
+  output_lexdef header dfa
+
+****)
+
+(****
+let debug_scanner lexbuf =
+  let tok = scanner.main lexbuf in
+  begin match tok with
+    Tident s -> prerr_string "Tident "; prerr_string s
+  | Tchar c -> prerr_string "Tchar "; prerr_char c
+  | Tstring s -> prerr_string "Tstring "; prerr_string s
+  | Taction(Location(i1,i2)) ->
+      prerr_string "Taction "; prerr_int i1; prerr_string "-";
+      prerr_int i2
+  | Trule -> prerr_string "Trule"
+  | Tparse -> prerr_string "Tparse"
+  | Tand -> prerr_string "Tand"
+  | Tequal -> prerr_string "Tequal"
+  | Tend -> prerr_string "Tend"
+  | Tor -> prerr_string "Tor"
+  | Tunderscore -> prerr_string "Tunderscore"
+  | Teof -> prerr_string "Teof"
+  | Tlbracket -> prerr_string "Tlbracket"
+  | Trbracket -> prerr_string "Trbracket"
+  | Tstar -> prerr_string "Tstar"
+  | Tmaybe -> prerr_string "Tmaybe"
+  | Tplus -> prerr_string "Tplus"
+  | Tlparen -> prerr_string "Tlparen"
+  | Trparen -> prerr_string "Trparen"
+  | Tcaret -> prerr_string "Tcaret"
+  | Tdash -> prerr_string "Tdash"
+  end;
+  prerr_newline();
+  tok
+
+****)
diff --git a/testsuite/tests/tool-lexyacc/main.reference b/testsuite/tests/tool-lexyacc/main.reference
new file mode 100644
index 00000000..f3dac422
--- /dev/null
+++ b/testsuite/tests/tool-lexyacc/main.reference
@@ -0,0 +1,312 @@
+66 states, 44 actions.
+
+open Syntax
+open Grammar
+open Scan_aux
+
+let rec action_43 lexbuf = (
+ comment lexbuf )
+and action_42 lexbuf = (
+ raise(Lexical_error "unterminated comment") )
+and action_41 lexbuf = (
+ reset_string_buffer();
+      string lexbuf;
+      reset_string_buffer();
+      comment lexbuf )
+and action_40 lexbuf = (
+ decr comment_depth;
+      if !comment_depth = 0 then () else comment lexbuf )
+and action_39 lexbuf = (
+ incr comment_depth; comment lexbuf )
+and action_38 lexbuf = (
+ raise(Lexical_error "bad character constant") )
+and action_37 lexbuf = (
+ char_for_decimal_code lexbuf 1 )
+and action_36 lexbuf = (
+ char_for_backslash (Lexing.lexeme_char lexbuf 1) )
+and action_35 lexbuf = (
+ Lexing.lexeme_char lexbuf 0 )
+and action_34 lexbuf = (
+ store_string_char(Lexing.lexeme_char lexbuf 0);
+      string lexbuf )
+and action_33 lexbuf = (
+ raise(Lexical_error "unterminated string") )
+and action_32 lexbuf = (
+ store_string_char(char_for_decimal_code lexbuf 1);
+      string lexbuf )
+and action_31 lexbuf = (
+ store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
+      string lexbuf )
+and action_30 lexbuf = (
+ string lexbuf )
+and action_29 lexbuf = (
+ () )
+and action_28 lexbuf = (
+ action lexbuf )
+and action_27 lexbuf = (
+ raise (Lexical_error "unterminated action") )
+and action_26 lexbuf = (
+ comment_depth := 1;
+      comment lexbuf;
+      action lexbuf )
+and action_25 lexbuf = (
+ let _ = char lexbuf in action lexbuf )
+and action_24 lexbuf = (
+ reset_string_buffer();
+      string lexbuf;
+      reset_string_buffer();
+      action lexbuf )
+and action_23 lexbuf = (
+ decr brace_depth;
+      if !brace_depth = 0 then Lexing.lexeme_start lexbuf else action lexbuf )
+and action_22 lexbuf = (
+ incr brace_depth;
+      action lexbuf )
+and action_21 lexbuf = (
+ raise(Lexical_error("illegal character " ^ Lexing.lexeme lexbuf)) )
+and action_20 lexbuf = (
+ raise(Lexical_error "unterminated lexer definition") )
+and action_19 lexbuf = (
+ Tdash )
+and action_18 lexbuf = (
+ Tcaret )
+and action_17 lexbuf = (
+ Trparen )
+and action_16 lexbuf = (
+ Tlparen )
+and action_15 lexbuf = (
+ Tplus )
+and action_14 lexbuf = (
+ Tmaybe )
+and action_13 lexbuf = (
+ Tstar )
+and action_12 lexbuf = (
+ Trbracket )
+and action_11 lexbuf = (
+ Tlbracket )
+and action_10 lexbuf = (
+ Teof )
+and action_9 lexbuf = (
+ Tunderscore )
+and action_8 lexbuf = (
+ Tor )
+and action_7 lexbuf = (
+ Tend )
+and action_6 lexbuf = (
+ Tequal )
+and action_5 lexbuf = (
+ let n1 = Lexing.lexeme_end lexbuf in
+        brace_depth := 1;
+        let n2 = action lexbuf in
+          Taction(Location(n1, n2)) )
+and action_4 lexbuf = (
+ Tchar(char lexbuf) )
+and action_3 lexbuf = (
+ reset_string_buffer();
+      string lexbuf;
+      Tstring(get_stored_string()) )
+and action_2 lexbuf = (
+ match Lexing.lexeme lexbuf with
+        "rule" -> Trule
+      | "parse" -> Tparse
+      | "and" -> Tand
+      | "eof" -> Teof
+      | s -> Tident s )
+and action_1 lexbuf = (
+ comment_depth := 1;
+      comment lexbuf;
+      main lexbuf )
+and action_0 lexbuf = (
+ main lexbuf )
+and state_0 lexbuf =
+  match lexing.next_char lexbuf with
+    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A' -> state_51 lexbuf
+ |  ' '|'\013'|'\n'|'\t' -> state_40 lexbuf
+ |  '|' -> action_8 lexbuf
+ |  '{' -> action_5 lexbuf
+ |  'e' -> state_56 lexbuf
+ |  '_' -> state_55 lexbuf
+ |  '^' -> action_18 lexbuf
+ |  ']' -> action_12 lexbuf
+ |  '[' -> action_11 lexbuf
+ |  '?' -> action_14 lexbuf
+ |  '=' -> action_6 lexbuf
+ |  ';' -> state_48 lexbuf
+ |  '-' -> action_19 lexbuf
+ |  '+' -> action_15 lexbuf
+ |  '*' -> action_13 lexbuf
+ |  ')' -> action_17 lexbuf
+ |  '(' -> state_43 lexbuf
+ |  '\'' -> action_4 lexbuf
+ |  '"' -> action_3 lexbuf
+ |  '\000' -> action_20 lexbuf
+ |  _ -> action_21 lexbuf
+and state_1 lexbuf =
+  match lexing.next_char lexbuf with
+    '}' -> action_23 lexbuf
+ |  '{' -> action_22 lexbuf
+ |  '(' -> state_34 lexbuf
+ |  '\'' -> action_25 lexbuf
+ |  '"' -> action_24 lexbuf
+ |  '\000' -> action_27 lexbuf
+ |  _ -> action_28 lexbuf
+and state_2 lexbuf =
+  match lexing.next_char lexbuf with
+    '\\' -> state_24 lexbuf
+ |  '"' -> action_29 lexbuf
+ |  '\000' -> action_33 lexbuf
+ |  _ -> action_34 lexbuf
+and state_3 lexbuf =
+  match lexing.next_char lexbuf with
+    '\\' -> state_13 lexbuf
+ |  '\000' -> lexing.backtrack lexbuf
+ |  _ -> state_12 lexbuf
+and state_4 lexbuf =
+  match lexing.next_char lexbuf with
+    '*' -> state_9 lexbuf
+ |  '(' -> state_8 lexbuf
+ |  '"' -> action_41 lexbuf
+ |  '\000' -> action_42 lexbuf
+ |  _ -> action_43 lexbuf
+and state_8 lexbuf =
+  Lexing.set_backtrack lexbuf action_43;
+  match lexing.next_char lexbuf with
+    '*' -> action_39 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_9 lexbuf =
+  Lexing.set_backtrack lexbuf action_43;
+  match lexing.next_char lexbuf with
+    ')' -> action_40 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_12 lexbuf =
+  Lexing.set_backtrack lexbuf action_38;
+  match lexing.next_char lexbuf with
+    '\'' -> action_35 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_13 lexbuf =
+  Lexing.set_backtrack lexbuf action_38;
+  match lexing.next_char lexbuf with
+    '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> state_15 lexbuf
+ |  't'|'r'|'n'|'b'|'\\'|'\'' -> state_14 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_14 lexbuf =
+  match lexing.next_char lexbuf with
+    '\'' -> action_36 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_15 lexbuf =
+  match lexing.next_char lexbuf with
+    '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> state_16 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_16 lexbuf =
+  match lexing.next_char lexbuf with
+    '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> state_17 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_17 lexbuf =
+  match lexing.next_char lexbuf with
+    '\'' -> action_37 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_24 lexbuf =
+  Lexing.set_backtrack lexbuf action_34;
+  match lexing.next_char lexbuf with
+    '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> state_27 lexbuf
+ |  't'|'r'|'n'|'b'|'\\'|'"' -> action_31 lexbuf
+ |  ' '|'\026'|'\013'|'\012'|'\n'|'\t' -> state_25 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_25 lexbuf =
+  Lexing.set_backtrack lexbuf action_30;
+  match lexing.next_char lexbuf with
+    ' '|'\026'|'\013'|'\012'|'\n'|'\t' -> state_25 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_27 lexbuf =
+  match lexing.next_char lexbuf with
+    '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> state_28 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_28 lexbuf =
+  match lexing.next_char lexbuf with
+    '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> action_32 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_34 lexbuf =
+  Lexing.set_backtrack lexbuf action_28;
+  match lexing.next_char lexbuf with
+    '*' -> action_26 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_40 lexbuf =
+  Lexing.set_backtrack lexbuf action_0;
+  match lexing.next_char lexbuf with
+    ' '|'\013'|'\n'|'\t' -> state_65 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_43 lexbuf =
+  Lexing.set_backtrack lexbuf action_16;
+  match lexing.next_char lexbuf with
+    '*' -> action_1 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_48 lexbuf =
+  Lexing.set_backtrack lexbuf action_21;
+  match lexing.next_char lexbuf with
+    ';' -> action_7 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_51 lexbuf =
+  Lexing.set_backtrack lexbuf action_2;
+  match lexing.next_char lexbuf with
+    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
+ |  '_' -> state_60 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_55 lexbuf =
+  Lexing.set_backtrack lexbuf action_9;
+  match lexing.next_char lexbuf with
+    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_56 lexbuf =
+  Lexing.set_backtrack lexbuf action_2;
+  match lexing.next_char lexbuf with
+    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
+ |  'o' -> state_61 lexbuf
+ |  '_' -> state_60 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_59 lexbuf =
+  Lexing.set_backtrack lexbuf action_2;
+  match lexing.next_char lexbuf with
+    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
+ |  '_' -> state_60 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_60 lexbuf =
+  match lexing.next_char lexbuf with
+    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_61 lexbuf =
+  Lexing.set_backtrack lexbuf action_2;
+  match lexing.next_char lexbuf with
+    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
+ |  'f' -> state_62 lexbuf
+ |  '_' -> state_60 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_62 lexbuf =
+  Lexing.set_backtrack lexbuf action_2;
+  match lexing.next_char lexbuf with
+    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
+ |  '_' -> state_60 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and state_65 lexbuf =
+  Lexing.set_backtrack lexbuf action_0;
+  match lexing.next_char lexbuf with
+    ' '|'\013'|'\n'|'\t' -> state_65 lexbuf
+ |  _ -> lexing.backtrack lexbuf
+and main lexbuf =
+  Lexing.init lexbuf;
+  state_0 lexbuf
+
+and action lexbuf =
+  Lexing.init lexbuf;
+  state_1 lexbuf
+
+and string lexbuf =
+  Lexing.init lexbuf;
+  state_2 lexbuf
+
+and char lexbuf =
+  Lexing.init lexbuf;
+  state_3 lexbuf
+
+and comment lexbuf =
+  Lexing.init lexbuf;
+  state_4 lexbuf
diff --git a/testsuite/tests/tool-lexyacc/mpr7760.mll b/testsuite/tests/tool-lexyacc/mpr7760.mll
new file mode 100644
index 00000000..bffca2d5
--- /dev/null
+++ b/testsuite/tests/tool-lexyacc/mpr7760.mll
@@ -0,0 +1,13 @@
+(* TEST
+  ocamllex_flags = " -q "
+*)
+
+rule read = shortest
+      | ("aa" | "bbb") (_ as x) _? { x }
+      | _ as y { y }
+
+{
+ let r = read (Lexing.from_string "aasdf") in
+ Printf.printf "<%c>\n" r ;
+ ()
+}
diff --git a/testsuite/tests/tool-lexyacc/mpr7760.reference b/testsuite/tests/tool-lexyacc/mpr7760.reference
new file mode 100644
index 00000000..ece61086
--- /dev/null
+++ b/testsuite/tests/tool-lexyacc/mpr7760.reference
@@ -0,0 +1 @@
+<a>
diff --git a/testsuite/tests/tool-lexyacc/output.ml b/testsuite/tests/tool-lexyacc/output.ml
new file mode 100644
index 00000000..957c82a7
--- /dev/null
+++ b/testsuite/tests/tool-lexyacc/output.ml
@@ -0,0 +1,152 @@
+(* Generating a DFA as a set of mutually recursive functions *)
+
+open Syntax
+
+let ic = ref stdin
+let oc = ref stdout
+
+(* 1- Generating the actions *)
+
+let copy_buffer = Bytes.create 1024
+
+let copy_chunk (Location(start,stop)) =
+  seek_in !ic start;
+  let tocopy = ref(stop - start) in
+  while !tocopy > 0 do
+    let m =
+      input !ic copy_buffer 0 (min !tocopy (Bytes.length copy_buffer)) in
+    output !oc copy_buffer 0 m;
+    tocopy := !tocopy - m
+  done
+
+
+let output_action (i,act) =
+  output_string !oc ("action_" ^ Int.to_string i ^ " lexbuf = (\n");
+  copy_chunk act;
+  output_string !oc ")\nand "
+
+
+(* 2- Generating the states *)
+
+let states = ref ([||] : automata array)
+
+type occurrence =
+  { mutable pos: int list;
+    mutable freq: int }
+
+let enumerate_vect v =
+  let env = ref [] in
+  for pos = 0 to Array.length v - 1 do
+    try
+      let occ = List.assoc v.(pos) !env in
+      occ.pos <- pos :: occ.pos;
+      occ.freq <- occ.freq + 1
+    with Not_found ->
+      env := (v.(pos), {pos = [pos]; freq = 1 }) :: !env
+  done;
+  List.sort (fun (e1, occ1) (e2, occ2) -> compare occ2.freq occ1.freq) !env
+
+
+let output_move = function
+    Backtrack ->
+      output_string !oc "lexing.backtrack lexbuf"
+  | Goto dest ->
+      match !states.(dest) with
+        Perform act_num ->
+          output_string !oc ("action_" ^ Int.to_string act_num ^ " lexbuf")
+      | _ ->
+          output_string !oc ("state_" ^ Int.to_string dest ^ " lexbuf")
+
+
+(* Cannot use standard char_for_read because the characters to escape
+   are not the same in CL6 and CL1999. *)
+
+let output_char_lit oc = function
+    '\'' -> output_string oc "\\'"
+  | '\\' -> output_string oc "\\\\"
+  | '\n' -> output_string oc "\\n"
+  | '\t' -> output_string oc "\\t"
+  | c ->  if Char.code c >= 32 && Char.code c < 128 then
+            output_char oc c
+          else begin
+            let n = Char.code c in
+            output_char oc '\\';
+            output_char oc (Char.chr (48 + n / 100));
+            output_char oc (Char.chr (48 + (n / 10) mod 10));
+            output_char oc (Char.chr (48 + n mod 10))
+          end
+
+let rec output_chars = function
+    [] ->
+      failwith "output_chars"
+  | [c] ->
+      output_string !oc "'";
+      output_char_lit !oc (Char.chr c);
+      output_string !oc "'"
+  | c::cl ->
+      output_string !oc "'";
+      output_char_lit !oc (Char.chr c);
+      output_string !oc "'|";
+      output_chars cl
+
+let output_one_trans (dest, occ) =
+  output_chars occ.pos;
+  output_string !oc " -> ";
+  output_move dest;
+  output_string !oc "\n |  "
+
+let output_all_trans trans =
+  output_string !oc "  match lexing.next_char lexbuf with\n    ";
+  match enumerate_vect trans with
+    [] ->
+      failwith "output_all_trans"
+  | (default, _) :: rest ->
+      List.iter output_one_trans rest;
+      output_string !oc "_ -> ";
+      output_move default;
+      output_string !oc "\nand "
+
+let output_state state_num = function
+    Perform i ->
+      ()
+  | Shift(what_to_do, moves) ->
+      output_string !oc
+        ("state_"  ^ Int.to_string state_num ^ " lexbuf =\n");
+      begin match what_to_do with
+        No_remember -> ()
+      | Remember i ->
+          output_string !oc
+            ("  Lexing.set_backtrack lexbuf action_" ^
+             Int.to_string i ^ ";\n")
+      end;
+      output_all_trans moves
+
+
+(* 3- Generating the entry points *)
+
+let rec output_entries = function
+    [] -> failwith "output_entries"
+  | (name,state_num) :: rest ->
+      output_string !oc (name ^ " lexbuf =\n");
+      output_string !oc "  Lexing.init lexbuf;\n";
+      output_string !oc ("  state_" ^ Int.to_string state_num ^
+                        " lexbuf\n");
+      match rest with
+        [] -> ()
+      | _  -> output_string !oc "\nand "; output_entries rest
+
+
+(* All together *)
+
+let output_lexdef header (initial_st, st, actions) =
+  print_int (Array.length st); print_string " states, ";
+  print_int (List.length actions); print_string " actions.";
+  print_newline();
+  copy_chunk header;
+  output_string !oc "\nlet rec ";
+  states := st;
+  List.iter output_action actions;
+  for i = 0 to Array.length st - 1 do
+    output_state i st.(i)
+  done;
+  output_entries initial_st
diff --git a/testsuite/tests/tool-lexyacc/scan_aux.ml b/testsuite/tests/tool-lexyacc/scan_aux.ml
new file mode 100644
index 00000000..96362fce
--- /dev/null
+++ b/testsuite/tests/tool-lexyacc/scan_aux.ml
@@ -0,0 +1,45 @@
+(* Auxiliaries for the lexical analyzer *)
+
+let brace_depth = ref 0
+let comment_depth = ref 0
+
+exception Lexical_error of string
+
+let initial_string_buffer = Bytes.create 256
+let string_buff = ref initial_string_buffer
+let string_index = ref 0
+
+let reset_string_buffer () =
+  string_buff := initial_string_buffer;
+  string_index := 0
+
+
+let store_string_char c =
+  begin
+    if !string_index >= Bytes.length !string_buff then begin
+      let new_buff = Bytes.create (Bytes.length !string_buff * 2) in
+      Bytes.blit new_buff 0 !string_buff 0 (Bytes.length !string_buff);
+      string_buff := new_buff
+    end
+  end;
+  Bytes.unsafe_set !string_buff !string_index c;
+  incr string_index
+
+let get_stored_string () =
+  let s = Bytes.sub_string !string_buff 0 !string_index in
+  string_buff := initial_string_buffer;
+  s
+
+
+let char_for_backslash = function
+    'n' -> '\010' (* '\n' when bootstrapped *)
+  | 't' -> '\009' (* '\t' *)
+  | 'b' -> '\008' (* '\b' *)
+  | 'r' -> '\013' (* '\r' *)
+  | c   -> c
+
+
+let char_for_decimal_code lexbuf i =
+  Char.chr(100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) +
+            10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) +
+                 (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48))
diff --git a/testsuite/tests/tool-lexyacc/scanner.mll b/testsuite/tests/tool-lexyacc/scanner.mll
new file mode 100644
index 00000000..f21fd7cd
--- /dev/null
+++ b/testsuite/tests/tool-lexyacc/scanner.mll
@@ -0,0 +1,118 @@
+(* The lexical analyzer for lexer definitions. *)
+
+{
+open Syntax
+open Grammar
+open Scan_aux
+}
+
+rule main = parse
+    [' ' '\010' '\013' '\009' ] +
+    { main lexbuf }
+  | "(*"
+    { comment_depth := 1;
+      comment lexbuf;
+      main lexbuf }
+  | (['A'-'Z' 'a'-'z'] | '_' ['A'-'Z' 'a'-'z' '\'' '0'-'9'])
+    ( '_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9'] ) *
+    { match Lexing.lexeme lexbuf with
+        "rule" -> Trule
+      | "parse" -> Tparse
+      | "and" -> Tand
+      | "eof" -> Teof
+      | s -> Tident s }
+  | '"'
+    { reset_string_buffer();
+      string lexbuf;
+      Tstring(get_stored_string()) }
+  | "'"
+    { Tchar(char lexbuf) }
+  | '{'
+    { let n1 = Lexing.lexeme_end lexbuf in
+        brace_depth := 1;
+        let n2 = action lexbuf in
+          Taction(Location(n1, n2)) }
+  | '='  { Tequal }
+  | ";;"  { Tend }
+  | '|'  { Tor }
+  | '_'  { Tunderscore }
+  | "eof"  { Teof }
+  | '['  { Tlbracket }
+  | ']'  { Trbracket }
+  | '*'  { Tstar }
+  | '?'  { Tmaybe }
+  | '+'  { Tplus }
+  | '('  { Tlparen }
+  | ')'  { Trparen }
+  | '^'  { Tcaret }
+  | '-'  { Tdash }
+  | eof
+    { raise(Lexical_error "unterminated lexer definition") }
+  | _
+    { raise(Lexical_error("illegal character " ^ Lexing.lexeme lexbuf)) }
+
+and action = parse
+    '{'
+    { incr brace_depth;
+      action lexbuf }
+  | '}'
+    { decr brace_depth;
+      if !brace_depth = 0 then Lexing.lexeme_start lexbuf else action lexbuf }
+  | '"'
+    { reset_string_buffer();
+      string lexbuf;
+      reset_string_buffer();
+      action lexbuf }
+  | '\''
+    { let _ = char lexbuf in action lexbuf }
+  | "(*"
+    { comment_depth := 1;
+      comment lexbuf;
+      action lexbuf }
+  | eof
+    { raise (Lexical_error "unterminated action") }
+  | _
+    { action lexbuf }
+
+and string = parse
+    '"'
+    { () }
+  | '\\' [' ' '\010' '\013' '\009' '\026' '\012'] +
+    { string lexbuf }
+  | '\\' ['\\' '"' 'n' 't' 'b' 'r']
+    { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
+      string lexbuf }
+  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
+    { store_string_char(char_for_decimal_code lexbuf 1);
+      string lexbuf }
+  | eof
+    { raise(Lexical_error "unterminated string") }
+  | _
+    { store_string_char(Lexing.lexeme_char lexbuf 0);
+      string lexbuf }
+
+and char = parse
+    [^ '\\'] "'"
+    { Lexing.lexeme_char lexbuf 0 }
+  | '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'"
+    { char_for_backslash (Lexing.lexeme_char lexbuf 1) }
+  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
+    { char_for_decimal_code lexbuf 1 }
+  | _
+    { raise(Lexical_error "bad character constant") }
+
+and comment = parse
+    "(*"
+    { incr comment_depth; comment lexbuf }
+  | "*)"
+    { decr comment_depth;
+      if !comment_depth = 0 then () else comment lexbuf }
+  | '"'
+    { reset_string_buffer();
+      string lexbuf;
+      reset_string_buffer();
+      comment lexbuf }
+  | eof
+    { raise(Lexical_error "unterminated comment") }
+  | _
+    { comment lexbuf }
diff --git a/testsuite/tests/tool-lexyacc/syntax.ml b/testsuite/tests/tool-lexyacc/syntax.ml
new file mode 100644
index 00000000..f692e6f6
--- /dev/null
+++ b/testsuite/tests/tool-lexyacc/syntax.ml
@@ -0,0 +1,26 @@
+(* The shallow abstract syntax *)
+
+type location =
+    Location of int * int
+
+type regular_expression =
+    Epsilon
+  | Characters of char list
+  | Sequence of regular_expression * regular_expression
+  | Alternative of regular_expression * regular_expression
+  | Repetition of regular_expression
+
+type lexer_definition =
+    Lexdef of location * (string * (regular_expression * location) list) list
+
+(* Representation of automata *)
+
+type automata =
+    Perform of int
+  | Shift of automata_trans * automata_move array
+and automata_trans =
+    No_remember
+  | Remember of int
+and automata_move =
+    Backtrack
+  | Goto of int
diff --git a/testsuite/tests/tool-ocaml-annot/check-annot.sh b/testsuite/tests/tool-ocaml-annot/check-annot.sh
new file mode 100755
index 00000000..f8b0e635
--- /dev/null
+++ b/testsuite/tests/tool-ocaml-annot/check-annot.sh
@@ -0,0 +1,7 @@
+#!/bin/sh
+MODULENAME=$1
+if [ -f ${test_build_directory}/${MODULENAME}.annot ]; then
+exit ${TEST_PASS}
+else
+exit ${TEST_FAIL}
+fi
diff --git a/testsuite/tests/tool-ocaml-annot/failure.ml b/testsuite/tests/tool-ocaml-annot/failure.ml
new file mode 100644
index 00000000..fd9ad0fb
--- /dev/null
+++ b/testsuite/tests/tool-ocaml-annot/failure.ml
@@ -0,0 +1,19 @@
+(* TEST
+
+flags = "-annot"
+script = "sh ${test_source_directory}/check-annot.sh failure"
+ocamlc_byte_exit_status = "2"
+ocamlopt_byte_exit_status = "2"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** script
+
+* setup-ocamlopt.byte-build-env
+** ocamlopt.byte
+*** script
+*)
+
+(* Check that .annot files are emitted in case of failed compilation. *)
+let a = 3
+let b = a +. 1
diff --git a/testsuite/tests/tool-ocaml-annot/success.ml b/testsuite/tests/tool-ocaml-annot/success.ml
new file mode 100644
index 00000000..126799c9
--- /dev/null
+++ b/testsuite/tests/tool-ocaml-annot/success.ml
@@ -0,0 +1,18 @@
+(* TEST
+
+flags = "-annot"
+script = "sh ${test_source_directory}/check-annot.sh success"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** script
+
+* setup-ocamlopt.byte-build-env
+** ocamlopt.byte
+*** script
+*)
+
+(* Check that .annot files are emitted in case of regular successful
+   compilation. *)
+let a = 3
+let b = float a
diff --git a/testsuite/tests/tool-ocaml-annot/typeonly.ml b/testsuite/tests/tool-ocaml-annot/typeonly.ml
new file mode 100644
index 00000000..db8d1eae
--- /dev/null
+++ b/testsuite/tests/tool-ocaml-annot/typeonly.ml
@@ -0,0 +1,18 @@
+(* TEST
+
+flags = "-i -annot"
+compile_only = "true"
+script = "sh ${test_source_directory}/check-annot.sh typeonly"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** script
+
+* setup-ocamlopt.byte-build-env
+** ocamlopt.byte
+*** script
+*)
+
+(* Check that .annot files are emitted in case of type-only compilation. *)
+let a = 3
+let b = float a
diff --git a/testsuite/tests/tool-ocaml/t000.ml b/testsuite/tests/tool-ocaml/t000.ml
new file mode 100644
index 00000000..87deb62f
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t000.ml
@@ -0,0 +1,15 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+(* empty file *)
+
+(**
+       0 ATOM0
+       1 SETGLOBAL T000
+       3 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t010-const0.ml b/testsuite/tests/tool-ocaml/t010-const0.ml
new file mode 100644
index 00000000..b1592185
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t010-const0.ml
@@ -0,0 +1,16 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+0;;
+
+(**
+       0 CONST0
+       1 ATOM0
+       2 SETGLOBAL T010-const0
+       4 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t010-const1.ml b/testsuite/tests/tool-ocaml/t010-const1.ml
new file mode 100644
index 00000000..83629d71
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t010-const1.ml
@@ -0,0 +1,16 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+1;;
+
+(**
+       0 CONST1
+       1 ATOM0
+       2 SETGLOBAL T010-const1
+       4 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t010-const2.ml b/testsuite/tests/tool-ocaml/t010-const2.ml
new file mode 100644
index 00000000..8b467ddd
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t010-const2.ml
@@ -0,0 +1,16 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+2;;
+
+(**
+       0 CONST2
+       1 ATOM0
+       2 SETGLOBAL T010-const2
+       4 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t010-const3.ml b/testsuite/tests/tool-ocaml/t010-const3.ml
new file mode 100644
index 00000000..68340da7
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t010-const3.ml
@@ -0,0 +1,16 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+3;;
+
+(**
+       0 CONST3
+       1 ATOM0
+       2 SETGLOBAL T010-const3
+       4 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t011-constint.ml b/testsuite/tests/tool-ocaml/t011-constint.ml
new file mode 100644
index 00000000..08dc0802
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t011-constint.ml
@@ -0,0 +1,16 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+4;;
+
+(**
+       0 CONSTINT 4
+       2 ATOM0
+       3 SETGLOBAL T011-constint
+       5 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t020.ml b/testsuite/tests/tool-ocaml/t020.ml
new file mode 100644
index 00000000..3eb1a723
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t020.ml
@@ -0,0 +1,18 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+let _ = () in ();;
+
+(**
+       0 CONST0
+       1 PUSHCONST0
+       2 POP 1
+       4 ATOM0
+       5 SETGLOBAL T020
+       7 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t021-pushconst1.ml b/testsuite/tests/tool-ocaml/t021-pushconst1.ml
new file mode 100644
index 00000000..576e9ddd
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t021-pushconst1.ml
@@ -0,0 +1,18 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+let _ = () in 1;;
+
+(**
+       0 CONST0
+       1 PUSHCONST1
+       2 POP 1
+       4 ATOM0
+       5 SETGLOBAL T021-pushconst1
+       7 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t021-pushconst2.ml b/testsuite/tests/tool-ocaml/t021-pushconst2.ml
new file mode 100644
index 00000000..e876901b
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t021-pushconst2.ml
@@ -0,0 +1,18 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+let _ = () in 2;;
+
+(**
+       0 CONST0
+       1 PUSHCONST2
+       2 POP 1
+       4 ATOM0
+       5 SETGLOBAL T021-pushconst2
+       7 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t021-pushconst3.ml b/testsuite/tests/tool-ocaml/t021-pushconst3.ml
new file mode 100644
index 00000000..eda9799a
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t021-pushconst3.ml
@@ -0,0 +1,18 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+let _ = () in 3;;
+
+(**
+       0 CONST0
+       1 PUSHCONST3
+       2 POP 1
+       4 ATOM0
+       5 SETGLOBAL T021-pushconst3
+       7 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t022-pushconstint.ml b/testsuite/tests/tool-ocaml/t022-pushconstint.ml
new file mode 100644
index 00000000..fc7ac9e1
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t022-pushconstint.ml
@@ -0,0 +1,18 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+let _ = () in -1;;
+
+(**
+       0 CONST0
+       1 PUSHCONSTINT -1
+       3 POP 1
+       5 ATOM0
+       6 SETGLOBAL T022-pushconstint
+       8 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t040-makeblock1.ml b/testsuite/tests/tool-ocaml/t040-makeblock1.ml
new file mode 100644
index 00000000..1fd56689
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t040-makeblock1.ml
@@ -0,0 +1,21 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+type t = {
+  mutable a : int;
+};;
+
+{ a = 0 };;
+
+(**
+       0 CONST0
+       1 MAKEBLOCK1 0
+       3 ATOM0
+       4 SETGLOBAL T040-makeblock1
+       6 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t040-makeblock2.ml b/testsuite/tests/tool-ocaml/t040-makeblock2.ml
new file mode 100644
index 00000000..e33bd036
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t040-makeblock2.ml
@@ -0,0 +1,23 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+type t = {
+  mutable a : int;
+  mutable b : int;
+};;
+
+{ a = 0; b = 0 };;
+
+(**
+       0 CONST0
+       1 PUSHCONST0
+       2 MAKEBLOCK2 0
+       4 ATOM0
+       5 SETGLOBAL T040-makeblock2
+       7 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t040-makeblock3.ml b/testsuite/tests/tool-ocaml/t040-makeblock3.ml
new file mode 100644
index 00000000..1af62b8e
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t040-makeblock3.ml
@@ -0,0 +1,25 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+type t = {
+  mutable a : int;
+  mutable b : int;
+  mutable c : int;
+};;
+
+{ a = 0; b = 0; c = 0 };;
+
+(**
+       0 CONST0
+       1 PUSHCONST0
+       2 PUSHCONST0
+       3 MAKEBLOCK3 0
+       5 ATOM0
+       6 SETGLOBAL T040-makeblock3
+       8 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t041-makeblock.ml b/testsuite/tests/tool-ocaml/t041-makeblock.ml
new file mode 100644
index 00000000..db9004fb
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t041-makeblock.ml
@@ -0,0 +1,27 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+type t = {
+  mutable a : int;
+  mutable b : int;
+  mutable c : int;
+  mutable d : int;
+};;
+
+{ a = 0; b = 0; c = 0; d = 0 };;
+
+(**
+       0 CONST0
+       1 PUSHCONST0
+       2 PUSHCONST0
+       3 PUSHCONST0
+       4 MAKEBLOCK 4, 0
+       7 ATOM0
+       8 SETGLOBAL T041-makeblock
+      10 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t050-getglobal.ml b/testsuite/tests/tool-ocaml/t050-getglobal.ml
new file mode 100644
index 00000000..1dc0f6b3
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t050-getglobal.ml
@@ -0,0 +1,16 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+[1];;
+
+(**
+       0 GETGLOBAL <0>(1, 0)
+       2 ATOM0
+       3 SETGLOBAL T050-getglobal
+       5 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t050-pushgetglobal.ml b/testsuite/tests/tool-ocaml/t050-pushgetglobal.ml
new file mode 100644
index 00000000..ddb5858a
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t050-pushgetglobal.ml
@@ -0,0 +1,18 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+let _ = () in 0.01;;
+
+(**
+       0 CONST0
+       1 PUSHGETGLOBAL 0.01
+       3 POP 1
+       5 ATOM0
+       6 SETGLOBAL T050-pushgetglobal
+       8 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t051-getglobalfield.ml b/testsuite/tests/tool-ocaml/t051-getglobalfield.ml
new file mode 100644
index 00000000..afbb1a31
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t051-getglobalfield.ml
@@ -0,0 +1,21 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+Lib.x;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBALFIELD Lib, 0
+      12 ATOM0
+      13 SETGLOBAL T051-getglobalfield
+      15 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t051-pushgetglobalfield.ml b/testsuite/tests/tool-ocaml/t051-pushgetglobalfield.ml
new file mode 100644
index 00000000..42681186
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t051-pushgetglobalfield.ml
@@ -0,0 +1,23 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+let _ = () in Lib.x;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHGETGLOBALFIELD Lib, 0
+      13 POP 1
+      15 ATOM0
+      16 SETGLOBAL T051-pushgetglobalfield
+      18 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t060-raise.ml b/testsuite/tests/tool-ocaml/t060-raise.ml
new file mode 100644
index 00000000..b212348e
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t060-raise.ml
@@ -0,0 +1,24 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+ocaml_exit_status = "2"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+raise End_of_file;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL End_of_file
+      11 MAKEBLOCK1 0
+      13 RAISE
+      14 SETGLOBAL T060-raise
+      16 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t070-branch.ml b/testsuite/tests/tool-ocaml/t070-branch.ml
new file mode 100644
index 00000000..e2de0da3
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t070-branch.ml
@@ -0,0 +1,28 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if true then 0 else raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 BRANCHIFNOT 15
+      12 CONST0
+      13 BRANCH 20
+      15 GETGLOBAL Not_found
+      17 MAKEBLOCK1 0
+      19 RAISE
+      20 ATOM0
+      21 SETGLOBAL T070-branch
+      23 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t070-branchif.ml b/testsuite/tests/tool-ocaml/t070-branchif.ml
new file mode 100644
index 00000000..6e96a036
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t070-branchif.ml
@@ -0,0 +1,28 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if not false then 0 else raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 BRANCHIF 15
+      12 CONST0
+      13 BRANCH 20
+      15 GETGLOBAL Not_found
+      17 MAKEBLOCK1 0
+      19 RAISE
+      20 ATOM0
+      21 SETGLOBAL T070-branchif
+      23 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t070-branchifnot.ml b/testsuite/tests/tool-ocaml/t070-branchifnot.ml
new file mode 100644
index 00000000..90949503
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t070-branchifnot.ml
@@ -0,0 +1,26 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if false then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 BRANCHIFNOT 17
+      12 GETGLOBAL Not_found
+      14 MAKEBLOCK1 0
+      16 RAISE
+      17 ATOM0
+      18 SETGLOBAL T070-branchifnot
+      20 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t071-boolnot.ml b/testsuite/tests/tool-ocaml/t071-boolnot.ml
new file mode 100644
index 00000000..50e1c737
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t071-boolnot.ml
@@ -0,0 +1,27 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if not true then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 BOOLNOT
+      11 BRANCHIFNOT 18
+      13 GETGLOBAL Not_found
+      15 MAKEBLOCK1 0
+      17 RAISE
+      18 ATOM0
+      19 SETGLOBAL T071-boolnot
+      21 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t080-eq.ml b/testsuite/tests/tool-ocaml/t080-eq.ml
new file mode 100644
index 00000000..d9c335db
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t080-eq.ml
@@ -0,0 +1,29 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if not (0 = 0) then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST0
+      11 EQ
+      12 BOOLNOT
+      13 BRANCHIFNOT 20
+      15 GETGLOBAL Not_found
+      17 MAKEBLOCK1 0
+      19 RAISE
+      20 ATOM0
+      21 SETGLOBAL T080-eq
+      23 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t080-geint.ml b/testsuite/tests/tool-ocaml/t080-geint.ml
new file mode 100644
index 00000000..3eb3d257
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t080-geint.ml
@@ -0,0 +1,29 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if not (0 >= 0) then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST0
+      11 GEINT
+      12 BOOLNOT
+      13 BRANCHIFNOT 20
+      15 GETGLOBAL Not_found
+      17 MAKEBLOCK1 0
+      19 RAISE
+      20 ATOM0
+      21 SETGLOBAL T080-geint
+      23 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t080-gtint.ml b/testsuite/tests/tool-ocaml/t080-gtint.ml
new file mode 100644
index 00000000..5099b21d
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t080-gtint.ml
@@ -0,0 +1,28 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if 0 > 0 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST0
+      11 GTINT
+      12 BRANCHIFNOT 19
+      14 GETGLOBAL Not_found
+      16 MAKEBLOCK1 0
+      18 RAISE
+      19 ATOM0
+      20 SETGLOBAL T080-gtint
+      22 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t080-leint.ml b/testsuite/tests/tool-ocaml/t080-leint.ml
new file mode 100644
index 00000000..b6a88919
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t080-leint.ml
@@ -0,0 +1,29 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if not (0 <= 0) then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST0
+      11 LEINT
+      12 BOOLNOT
+      13 BRANCHIFNOT 20
+      15 GETGLOBAL Not_found
+      17 MAKEBLOCK1 0
+      19 RAISE
+      20 ATOM0
+      21 SETGLOBAL T080-leint
+      23 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t080-ltint.ml b/testsuite/tests/tool-ocaml/t080-ltint.ml
new file mode 100644
index 00000000..b7f376e6
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t080-ltint.ml
@@ -0,0 +1,28 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if 0 < 0 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST0
+      11 LTINT
+      12 BRANCHIFNOT 19
+      14 GETGLOBAL Not_found
+      16 MAKEBLOCK1 0
+      18 RAISE
+      19 ATOM0
+      20 SETGLOBAL T080-ltint
+      22 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t080-neq.ml b/testsuite/tests/tool-ocaml/t080-neq.ml
new file mode 100644
index 00000000..ed219d65
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t080-neq.ml
@@ -0,0 +1,28 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if 0 <> 0 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST0
+      11 NEQ
+      12 BRANCHIFNOT 19
+      14 GETGLOBAL Not_found
+      16 MAKEBLOCK1 0
+      18 RAISE
+      19 ATOM0
+      20 SETGLOBAL T080-neq
+      22 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t090-acc0.ml b/testsuite/tests/tool-ocaml/t090-acc0.ml
new file mode 100644
index 00000000..5bbebdd7
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t090-acc0.ml
@@ -0,0 +1,33 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = true in
+();
+if not x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONST0
+      11 ACC0
+      12 BOOLNOT
+      13 BRANCHIFNOT 20
+      15 GETGLOBAL Not_found
+      17 MAKEBLOCK1 0
+      19 RAISE
+      20 POP 1
+      22 ATOM0
+      23 SETGLOBAL T090-acc0
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t090-acc1.ml b/testsuite/tests/tool-ocaml/t090-acc1.ml
new file mode 100644
index 00000000..da9b8772
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t090-acc1.ml
@@ -0,0 +1,35 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = true in
+let y = false in
+();
+if not x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONST0
+      11 PUSHCONST0
+      12 ACC1
+      13 BOOLNOT
+      14 BRANCHIFNOT 21
+      16 GETGLOBAL Not_found
+      18 MAKEBLOCK1 0
+      20 RAISE
+      21 POP 2
+      23 ATOM0
+      24 SETGLOBAL T090-acc1
+      26 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t090-acc2.ml b/testsuite/tests/tool-ocaml/t090-acc2.ml
new file mode 100644
index 00000000..48ba4d4e
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t090-acc2.ml
@@ -0,0 +1,37 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = true in
+let y = false in
+let z = false in
+();
+if not x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONST0
+      11 PUSHCONST0
+      12 PUSHCONST0
+      13 ACC2
+      14 BOOLNOT
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 POP 3
+      24 ATOM0
+      25 SETGLOBAL T090-acc2
+      27 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t090-acc3.ml b/testsuite/tests/tool-ocaml/t090-acc3.ml
new file mode 100644
index 00000000..6d40d557
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t090-acc3.ml
@@ -0,0 +1,39 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = true in
+let y = false in
+let z = false in
+let a = false in
+();
+if not x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONST0
+      11 PUSHCONST0
+      12 PUSHCONST0
+      13 PUSHCONST0
+      14 ACC3
+      15 BOOLNOT
+      16 BRANCHIFNOT 23
+      18 GETGLOBAL Not_found
+      20 MAKEBLOCK1 0
+      22 RAISE
+      23 POP 4
+      25 ATOM0
+      26 SETGLOBAL T090-acc3
+      28 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t090-acc4.ml b/testsuite/tests/tool-ocaml/t090-acc4.ml
new file mode 100644
index 00000000..32fd2a1c
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t090-acc4.ml
@@ -0,0 +1,41 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = true in
+let y = false in
+let z = false in
+let a = false in
+let b = false in
+();
+if not x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONST0
+      11 PUSHCONST0
+      12 PUSHCONST0
+      13 PUSHCONST0
+      14 PUSHCONST0
+      15 ACC4
+      16 BOOLNOT
+      17 BRANCHIFNOT 24
+      19 GETGLOBAL Not_found
+      21 MAKEBLOCK1 0
+      23 RAISE
+      24 POP 5
+      26 ATOM0
+      27 SETGLOBAL T090-acc4
+      29 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t090-acc5.ml b/testsuite/tests/tool-ocaml/t090-acc5.ml
new file mode 100644
index 00000000..657d8701
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t090-acc5.ml
@@ -0,0 +1,43 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = true in
+let y = false in
+let z = false in
+let a = false in
+let b = false in
+let c = false in
+();
+if not x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONST0
+      11 PUSHCONST0
+      12 PUSHCONST0
+      13 PUSHCONST0
+      14 PUSHCONST0
+      15 PUSHCONST0
+      16 ACC5
+      17 BOOLNOT
+      18 BRANCHIFNOT 25
+      20 GETGLOBAL Not_found
+      22 MAKEBLOCK1 0
+      24 RAISE
+      25 POP 6
+      27 ATOM0
+      28 SETGLOBAL T090-acc5
+      30 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t090-acc6.ml b/testsuite/tests/tool-ocaml/t090-acc6.ml
new file mode 100644
index 00000000..a6cfd26f
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t090-acc6.ml
@@ -0,0 +1,45 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = true in
+let y = false in
+let z = false in
+let a = false in
+let b = false in
+let c = false in
+let d = false in
+();
+if not x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONST0
+      11 PUSHCONST0
+      12 PUSHCONST0
+      13 PUSHCONST0
+      14 PUSHCONST0
+      15 PUSHCONST0
+      16 PUSHCONST0
+      17 ACC6
+      18 BOOLNOT
+      19 BRANCHIFNOT 26
+      21 GETGLOBAL Not_found
+      23 MAKEBLOCK1 0
+      25 RAISE
+      26 POP 7
+      28 ATOM0
+      29 SETGLOBAL T090-acc6
+      31 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t090-acc7.ml b/testsuite/tests/tool-ocaml/t090-acc7.ml
new file mode 100644
index 00000000..03b67ecc
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t090-acc7.ml
@@ -0,0 +1,47 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = true in
+let y = false in
+let z = false in
+let a = false in
+let b = false in
+let c = false in
+let d = false in
+let e = false in
+();
+if not x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONST0
+      11 PUSHCONST0
+      12 PUSHCONST0
+      13 PUSHCONST0
+      14 PUSHCONST0
+      15 PUSHCONST0
+      16 PUSHCONST0
+      17 PUSHCONST0
+      18 ACC7
+      19 BOOLNOT
+      20 BRANCHIFNOT 27
+      22 GETGLOBAL Not_found
+      24 MAKEBLOCK1 0
+      26 RAISE
+      27 POP 8
+      29 ATOM0
+      30 SETGLOBAL T090-acc7
+      32 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t091-acc.ml b/testsuite/tests/tool-ocaml/t091-acc.ml
new file mode 100644
index 00000000..57c17dfc
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t091-acc.ml
@@ -0,0 +1,49 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = true in
+let y = false in
+let z = false in
+let a = false in
+let b = false in
+let c = false in
+let d = false in
+let e = false in
+let f = false in
+();
+if not x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONST0
+      11 PUSHCONST0
+      12 PUSHCONST0
+      13 PUSHCONST0
+      14 PUSHCONST0
+      15 PUSHCONST0
+      16 PUSHCONST0
+      17 PUSHCONST0
+      18 PUSHCONST0
+      19 ACC 8
+      21 BOOLNOT
+      22 BRANCHIFNOT 29
+      24 GETGLOBAL Not_found
+      26 MAKEBLOCK1 0
+      28 RAISE
+      29 POP 9
+      31 ATOM0
+      32 SETGLOBAL T091-acc
+      34 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t092-pushacc.ml b/testsuite/tests/tool-ocaml/t092-pushacc.ml
new file mode 100644
index 00000000..4cff5cfb
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t092-pushacc.ml
@@ -0,0 +1,46 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = false in
+let y = true in
+let z = true in
+let a = true in
+let b = true in
+let c = true in
+let d = true in
+let e = true in
+let f = true in
+if x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST1
+      11 PUSHCONST1
+      12 PUSHCONST1
+      13 PUSHCONST1
+      14 PUSHCONST1
+      15 PUSHCONST1
+      16 PUSHCONST1
+      17 PUSHCONST1
+      18 PUSHACC 8
+      20 BRANCHIFNOT 27
+      22 GETGLOBAL Not_found
+      24 MAKEBLOCK1 0
+      26 RAISE
+      27 POP 9
+      29 ATOM0
+      30 SETGLOBAL T092-pushacc
+      32 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t092-pushacc0.ml b/testsuite/tests/tool-ocaml/t092-pushacc0.ml
new file mode 100644
index 00000000..3108757a
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t092-pushacc0.ml
@@ -0,0 +1,30 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = false in
+if x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHACC0
+      11 BRANCHIFNOT 18
+      13 GETGLOBAL Not_found
+      15 MAKEBLOCK1 0
+      17 RAISE
+      18 POP 1
+      20 ATOM0
+      21 SETGLOBAL T092-pushacc0
+      23 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t092-pushacc1.ml b/testsuite/tests/tool-ocaml/t092-pushacc1.ml
new file mode 100644
index 00000000..5cd5f760
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t092-pushacc1.ml
@@ -0,0 +1,32 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = false in
+let y = true in
+if x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST1
+      11 PUSHACC1
+      12 BRANCHIFNOT 19
+      14 GETGLOBAL Not_found
+      16 MAKEBLOCK1 0
+      18 RAISE
+      19 POP 2
+      21 ATOM0
+      22 SETGLOBAL T092-pushacc1
+      24 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t092-pushacc2.ml b/testsuite/tests/tool-ocaml/t092-pushacc2.ml
new file mode 100644
index 00000000..290c8cd6
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t092-pushacc2.ml
@@ -0,0 +1,34 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = false in
+let y = true in
+let z = true in
+if x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST1
+      11 PUSHCONST1
+      12 PUSHACC2
+      13 BRANCHIFNOT 20
+      15 GETGLOBAL Not_found
+      17 MAKEBLOCK1 0
+      19 RAISE
+      20 POP 3
+      22 ATOM0
+      23 SETGLOBAL T092-pushacc2
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t092-pushacc3.ml b/testsuite/tests/tool-ocaml/t092-pushacc3.ml
new file mode 100644
index 00000000..28309d71
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t092-pushacc3.ml
@@ -0,0 +1,36 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = false in
+let y = true in
+let z = true in
+let a = true in
+if x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST1
+      11 PUSHCONST1
+      12 PUSHCONST1
+      13 PUSHACC3
+      14 BRANCHIFNOT 21
+      16 GETGLOBAL Not_found
+      18 MAKEBLOCK1 0
+      20 RAISE
+      21 POP 4
+      23 ATOM0
+      24 SETGLOBAL T092-pushacc3
+      26 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t092-pushacc4.ml b/testsuite/tests/tool-ocaml/t092-pushacc4.ml
new file mode 100644
index 00000000..4ea3d847
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t092-pushacc4.ml
@@ -0,0 +1,38 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = false in
+let y = true in
+let z = true in
+let a = true in
+let b = true in
+if x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST1
+      11 PUSHCONST1
+      12 PUSHCONST1
+      13 PUSHCONST1
+      14 PUSHACC4
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 POP 5
+      24 ATOM0
+      25 SETGLOBAL T092-pushacc4
+      27 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t092-pushacc5.ml b/testsuite/tests/tool-ocaml/t092-pushacc5.ml
new file mode 100644
index 00000000..f6b063f4
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t092-pushacc5.ml
@@ -0,0 +1,40 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = false in
+let y = true in
+let z = true in
+let a = true in
+let b = true in
+let c = true in
+if x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST1
+      11 PUSHCONST1
+      12 PUSHCONST1
+      13 PUSHCONST1
+      14 PUSHCONST1
+      15 PUSHACC5
+      16 BRANCHIFNOT 23
+      18 GETGLOBAL Not_found
+      20 MAKEBLOCK1 0
+      22 RAISE
+      23 POP 6
+      25 ATOM0
+      26 SETGLOBAL T092-pushacc5
+      28 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t092-pushacc6.ml b/testsuite/tests/tool-ocaml/t092-pushacc6.ml
new file mode 100644
index 00000000..0e1e6368
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t092-pushacc6.ml
@@ -0,0 +1,42 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = false in
+let y = true in
+let z = true in
+let a = true in
+let b = true in
+let c = true in
+let d = true in
+if x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST1
+      11 PUSHCONST1
+      12 PUSHCONST1
+      13 PUSHCONST1
+      14 PUSHCONST1
+      15 PUSHCONST1
+      16 PUSHACC6
+      17 BRANCHIFNOT 24
+      19 GETGLOBAL Not_found
+      21 MAKEBLOCK1 0
+      23 RAISE
+      24 POP 7
+      26 ATOM0
+      27 SETGLOBAL T092-pushacc6
+      29 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t092-pushacc7.ml b/testsuite/tests/tool-ocaml/t092-pushacc7.ml
new file mode 100644
index 00000000..4c057cc5
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t092-pushacc7.ml
@@ -0,0 +1,44 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = false in
+let y = true in
+let z = true in
+let a = true in
+let b = true in
+let c = true in
+let d = true in
+let e = true in
+if x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST1
+      11 PUSHCONST1
+      12 PUSHCONST1
+      13 PUSHCONST1
+      14 PUSHCONST1
+      15 PUSHCONST1
+      16 PUSHCONST1
+      17 PUSHACC7
+      18 BRANCHIFNOT 25
+      20 GETGLOBAL Not_found
+      22 MAKEBLOCK1 0
+      24 RAISE
+      25 POP 8
+      27 ATOM0
+      28 SETGLOBAL T092-pushacc7
+      30 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t093-pushacc.ml b/testsuite/tests/tool-ocaml/t093-pushacc.ml
new file mode 100644
index 00000000..c072dc07
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t093-pushacc.ml
@@ -0,0 +1,46 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = false in
+let y = true in
+let z = true in
+let a = true in
+let b = true in
+let c = true in
+let d = true in
+let e = true in
+let f = true in
+if x then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST1
+      11 PUSHCONST1
+      12 PUSHCONST1
+      13 PUSHCONST1
+      14 PUSHCONST1
+      15 PUSHCONST1
+      16 PUSHCONST1
+      17 PUSHCONST1
+      18 PUSHACC 8
+      20 BRANCHIFNOT 27
+      22 GETGLOBAL Not_found
+      24 MAKEBLOCK1 0
+      26 RAISE
+      27 POP 9
+      29 ATOM0
+      30 SETGLOBAL T093-pushacc
+      32 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t100-pushtrap.ml b/testsuite/tests/tool-ocaml/t100-pushtrap.ml
new file mode 100644
index 00000000..d5f06b6f
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t100-pushtrap.ml
@@ -0,0 +1,29 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+try raise Not_found
+with _ -> ()
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 PUSHTRAP 16
+      11 GETGLOBAL Not_found
+      13 MAKEBLOCK1 0
+      15 RAISE
+      16 PUSHCONST0
+      17 POP 1
+      19 ATOM0
+      20 SETGLOBAL T100-pushtrap
+      22 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t101-poptrap.ml b/testsuite/tests/tool-ocaml/t101-poptrap.ml
new file mode 100644
index 00000000..42b84c60
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t101-poptrap.ml
@@ -0,0 +1,29 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+try ()
+with _ -> ()
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 PUSHTRAP 15
+      11 CONST0
+      12 POPTRAP
+      13 BRANCH 18
+      15 PUSHCONST0
+      16 POP 1
+      18 ATOM0
+      19 SETGLOBAL T101-poptrap
+      21 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-addint.ml b/testsuite/tests/tool-ocaml/t110-addint.ml
new file mode 100644
index 00000000..c3733cb8
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-addint.ml
@@ -0,0 +1,34 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 1 in
+if 1 + x <> 2 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONST2
+      11 PUSHACC1
+      12 PUSHCONST1
+      13 ADDINT
+      14 NEQ
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 POP 1
+      24 ATOM0
+      25 SETGLOBAL T110-addint
+      27 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-andint.ml b/testsuite/tests/tool-ocaml/t110-andint.ml
new file mode 100644
index 00000000..5f92f9a2
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-andint.ml
@@ -0,0 +1,30 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if (3 land 6) <> 2 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST2
+      10 PUSHCONSTINT 6
+      12 PUSHCONST3
+      13 ANDINT
+      14 NEQ
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 ATOM0
+      23 SETGLOBAL T110-andint
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-asrint-1.ml b/testsuite/tests/tool-ocaml/t110-asrint-1.ml
new file mode 100644
index 00000000..a86d85c4
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-asrint-1.ml
@@ -0,0 +1,30 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if (-2 asr 1) <> -1 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT -1
+      11 PUSHCONST1
+      12 PUSHCONSTINT -2
+      14 ASRINT
+      15 NEQ
+      16 BRANCHIFNOT 23
+      18 GETGLOBAL Not_found
+      20 MAKEBLOCK1 0
+      22 RAISE
+      23 ATOM0
+      24 SETGLOBAL T110-asrint-1
+      26 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-asrint-2.ml b/testsuite/tests/tool-ocaml/t110-asrint-2.ml
new file mode 100644
index 00000000..a028d36c
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-asrint-2.ml
@@ -0,0 +1,30 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if (3 asr 1) <> 1 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONST1
+      11 PUSHCONST3
+      12 ASRINT
+      13 NEQ
+      14 BRANCHIFNOT 21
+      16 GETGLOBAL Not_found
+      18 MAKEBLOCK1 0
+      20 RAISE
+      21 ATOM0
+      22 SETGLOBAL T110-asrint-2
+      24 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-divint-1.ml b/testsuite/tests/tool-ocaml/t110-divint-1.ml
new file mode 100644
index 00000000..3c5cfb64
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-divint-1.ml
@@ -0,0 +1,30 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if 2 / 2 <> 1 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONST2
+      11 PUSHCONST2
+      12 DIVINT
+      13 NEQ
+      14 BRANCHIFNOT 21
+      16 GETGLOBAL Not_found
+      18 MAKEBLOCK1 0
+      20 RAISE
+      21 ATOM0
+      22 SETGLOBAL T110-divint-1
+      24 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-divint-2.ml b/testsuite/tests/tool-ocaml/t110-divint-2.ml
new file mode 100644
index 00000000..b2cc2994
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-divint-2.ml
@@ -0,0 +1,30 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if 3 / 2 <> 1 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONST2
+      11 PUSHCONST3
+      12 DIVINT
+      13 NEQ
+      14 BRANCHIFNOT 21
+      16 GETGLOBAL Not_found
+      18 MAKEBLOCK1 0
+      20 RAISE
+      21 ATOM0
+      22 SETGLOBAL T110-divint-2
+      24 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-divint-3.ml b/testsuite/tests/tool-ocaml/t110-divint-3.ml
new file mode 100644
index 00000000..e6a6913c
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-divint-3.ml
@@ -0,0 +1,41 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+try
+  ignore (3 / 0);
+  raise Not_found;
+with Division_by_zero -> ()
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 PUSHTRAP 19
+      11 CONST0
+      12 PUSHCONST3
+      13 DIVINT
+      14 GETGLOBAL Not_found
+      16 MAKEBLOCK1 0
+      18 RAISE
+      19 PUSHGETGLOBAL Division_by_zero
+      21 PUSHACC1
+      22 GETFIELD0
+      23 EQ
+      24 BRANCHIFNOT 29
+      26 CONST0
+      27 BRANCH 31
+      29 ACC0
+      30 RAISE
+      31 POP 1
+      33 ATOM0
+      34 SETGLOBAL T110-divint-3
+      36 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-lslint.ml b/testsuite/tests/tool-ocaml/t110-lslint.ml
new file mode 100644
index 00000000..b39a2c92
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-lslint.ml
@@ -0,0 +1,30 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if (3 lsl 2) <> 12 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 12
+      11 PUSHCONST2
+      12 PUSHCONST3
+      13 LSLINT
+      14 NEQ
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 ATOM0
+      23 SETGLOBAL T110-lslint
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-lsrint.ml b/testsuite/tests/tool-ocaml/t110-lsrint.ml
new file mode 100644
index 00000000..619aedda
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-lsrint.ml
@@ -0,0 +1,30 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if (14 lsr 2) <> 3 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST3
+      10 PUSHCONST2
+      11 PUSHCONSTINT 14
+      13 LSRINT
+      14 NEQ
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 ATOM0
+      23 SETGLOBAL T110-lsrint
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-modint-1.ml b/testsuite/tests/tool-ocaml/t110-modint-1.ml
new file mode 100644
index 00000000..528ffa54
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-modint-1.ml
@@ -0,0 +1,30 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if 20 mod 3 <> 2 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST2
+      10 PUSHCONST3
+      11 PUSHCONSTINT 20
+      13 MODINT
+      14 NEQ
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 ATOM0
+      23 SETGLOBAL T110-modint-1
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-modint-2.ml b/testsuite/tests/tool-ocaml/t110-modint-2.ml
new file mode 100644
index 00000000..26141750
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-modint-2.ml
@@ -0,0 +1,42 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+try
+  ignore (2 mod 0);
+  raise Not_found;
+with Division_by_zero -> ()
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 PUSHTRAP 19
+      11 CONST0
+      12 PUSHCONST2
+      13 MODINT
+      14 GETGLOBAL Not_found
+      16 MAKEBLOCK1 0
+      18 RAISE
+      19 PUSHGETGLOBAL Division_by_zero
+      21 PUSHACC1
+      22 GETFIELD0
+      23 EQ
+      24 BRANCHIFNOT 29
+      26 CONST0
+      27 BRANCH 31
+      29 ACC0
+      30 RAISE
+      31 POP 1
+      33 ATOM0
+      34 SETGLOBAL T110-modint-2
+      36 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-mulint.ml b/testsuite/tests/tool-ocaml/t110-mulint.ml
new file mode 100644
index 00000000..d8544c83
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-mulint.ml
@@ -0,0 +1,30 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if 2 * 2 <> 4 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 4
+      11 PUSHCONST2
+      12 PUSHCONST2
+      13 MULINT
+      14 NEQ
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 ATOM0
+      23 SETGLOBAL T110-mulint
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-negint.ml b/testsuite/tests/tool-ocaml/t110-negint.ml
new file mode 100644
index 00000000..7bff31d4
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-negint.ml
@@ -0,0 +1,33 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 1 in
+if -x <> -1 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONSTINT -1
+      12 PUSHACC1
+      13 NEGINT
+      14 NEQ
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 POP 1
+      24 ATOM0
+      25 SETGLOBAL T110-negint
+      27 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-offsetint.ml b/testsuite/tests/tool-ocaml/t110-offsetint.ml
new file mode 100644
index 00000000..a7ed3970
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-offsetint.ml
@@ -0,0 +1,29 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if 2 + 2 <> 4 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 4
+      11 PUSHCONST2
+      12 OFFSETINT 2
+      14 NEQ
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 ATOM0
+      23 SETGLOBAL T110-offsetint
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-orint.ml b/testsuite/tests/tool-ocaml/t110-orint.ml
new file mode 100644
index 00000000..3b77520b
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-orint.ml
@@ -0,0 +1,30 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if (3 lor 6) <> 7 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 7
+      11 PUSHCONSTINT 6
+      13 PUSHCONST3
+      14 ORINT
+      15 NEQ
+      16 BRANCHIFNOT 23
+      18 GETGLOBAL Not_found
+      20 MAKEBLOCK1 0
+      22 RAISE
+      23 ATOM0
+      24 SETGLOBAL T110-orint
+      26 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-subint.ml b/testsuite/tests/tool-ocaml/t110-subint.ml
new file mode 100644
index 00000000..72ee30f6
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-subint.ml
@@ -0,0 +1,34 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 1 in
+if 1 - x <> 0 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONST0
+      11 PUSHACC1
+      12 PUSHCONST1
+      13 SUBINT
+      14 NEQ
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 POP 1
+      24 ATOM0
+      25 SETGLOBAL T110-subint
+      27 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t110-xorint.ml b/testsuite/tests/tool-ocaml/t110-xorint.ml
new file mode 100644
index 00000000..d5d3cb5b
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t110-xorint.ml
@@ -0,0 +1,30 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if (3 lxor 6) <> 5 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 5
+      11 PUSHCONSTINT 6
+      13 PUSHCONST3
+      14 XORINT
+      15 NEQ
+      16 BRANCHIFNOT 23
+      18 GETGLOBAL Not_found
+      20 MAKEBLOCK1 0
+      22 RAISE
+      23 ATOM0
+      24 SETGLOBAL T110-xorint
+      26 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t120-getstringchar.ml b/testsuite/tests/tool-ocaml/t120-getstringchar.ml
new file mode 100644
index 00000000..4988752d
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t120-getstringchar.ml
@@ -0,0 +1,30 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if "foo".[2] <> 'o' then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 111
+      11 PUSHCONST2
+      12 PUSHGETGLOBAL "foo"
+      14 GETSTRINGCHAR
+      15 NEQ
+      16 BRANCHIFNOT 23
+      18 GETGLOBAL Not_found
+      20 MAKEBLOCK1 0
+      22 RAISE
+      23 ATOM0
+      24 SETGLOBAL T120-getstringchar
+      26 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t121-setstringchar.ml b/testsuite/tests/tool-ocaml/t121-setstringchar.ml
new file mode 100644
index 00000000..f306c755
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t121-setstringchar.ml
@@ -0,0 +1,39 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = Bytes.of_string "foo" in
+x.[2] <- 'x';
+if Bytes.get x 2 <> 'x' then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL "foo"
+      11 PUSHCONSTINT 120
+      13 PUSHCONST2
+      14 PUSHACC2
+      15 SETSTRINGCHAR
+      16 CONSTINT 120
+      18 PUSHCONST2
+      19 PUSHACC2
+      20 GETSTRINGCHAR
+      21 NEQ
+      22 BRANCHIFNOT 29
+      24 GETGLOBAL Not_found
+      26 MAKEBLOCK1 0
+      28 RAISE
+      29 POP 1
+      31 ATOM0
+      32 SETGLOBAL T121-setstringchar
+      34 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t130-getvectitem.ml b/testsuite/tests/tool-ocaml/t130-getvectitem.ml
new file mode 100644
index 00000000..6cd28413
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t130-getvectitem.ml
@@ -0,0 +1,32 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if [| 1; 2 |].(1) <> 2 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST2
+      10 PUSHCONST1
+      11 PUSHCONST2
+      12 PUSHCONST1
+      13 MAKEBLOCK2 0
+      15 GETVECTITEM
+      16 NEQ
+      17 BRANCHIFNOT 24
+      19 GETGLOBAL Not_found
+      21 MAKEBLOCK1 0
+      23 RAISE
+      24 ATOM0
+      25 SETGLOBAL T130-getvectitem
+      27 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t130-vectlength.ml b/testsuite/tests/tool-ocaml/t130-vectlength.ml
new file mode 100644
index 00000000..7e14f3d5
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t130-vectlength.ml
@@ -0,0 +1,31 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if Array.length [| 1; 2 |] <> 2 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST2
+      10 PUSHCONST2
+      11 PUSHCONST1
+      12 MAKEBLOCK2 0
+      14 VECTLENGTH
+      15 NEQ
+      16 BRANCHIFNOT 23
+      18 GETGLOBAL Not_found
+      20 MAKEBLOCK1 0
+      22 RAISE
+      23 ATOM0
+      24 SETGLOBAL T130-vectlength
+      26 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t131-setvectitem.ml b/testsuite/tests/tool-ocaml/t131-setvectitem.ml
new file mode 100644
index 00000000..b78f51d2
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t131-setvectitem.ml
@@ -0,0 +1,41 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = [| 1; 2 |] in
+x.(0) <- 3;
+if x.(0) <> 3 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST2
+      10 PUSHCONST1
+      11 MAKEBLOCK2 0
+      13 PUSHCONST3
+      14 PUSHCONST0
+      15 PUSHACC2
+      16 SETVECTITEM
+      17 CONST3
+      18 PUSHCONST0
+      19 PUSHACC2
+      20 GETVECTITEM
+      21 NEQ
+      22 BRANCHIFNOT 29
+      24 GETGLOBAL Not_found
+      26 MAKEBLOCK1 0
+      28 RAISE
+      29 POP 1
+      31 ATOM0
+      32 SETGLOBAL T131-setvectitem
+      34 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t140-switch-1.ml b/testsuite/tests/tool-ocaml/t140-switch-1.ml
new file mode 100644
index 00000000..54b3dd7f
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t140-switch-1.ml
@@ -0,0 +1,40 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+match 0 with
+| 0 -> ()
+| 1 -> raise Not_found
+| _ -> raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHACC0
+      11 SWITCH
+        int 0 -> 17
+        int 1 -> 20
+      15 BRANCH 25
+      17 CONST0
+      18 BRANCH 30
+      20 GETGLOBAL Not_found
+      22 MAKEBLOCK1 0
+      24 RAISE
+      25 GETGLOBAL Not_found
+      27 MAKEBLOCK1 0
+      29 RAISE
+      30 POP 1
+      32 ATOM0
+      33 SETGLOBAL T140-switch-1
+      35 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t140-switch-2.ml b/testsuite/tests/tool-ocaml/t140-switch-2.ml
new file mode 100644
index 00000000..88026c12
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t140-switch-2.ml
@@ -0,0 +1,40 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+match 1 with
+| 0 -> raise Not_found
+| 1 -> ()
+| _ -> raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHACC0
+      11 SWITCH
+        int 0 -> 17
+        int 1 -> 22
+      15 BRANCH 25
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 CONST0
+      23 BRANCH 30
+      25 GETGLOBAL Not_found
+      27 MAKEBLOCK1 0
+      29 RAISE
+      30 POP 1
+      32 ATOM0
+      33 SETGLOBAL T140-switch-2
+      35 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t140-switch-3.ml b/testsuite/tests/tool-ocaml/t140-switch-3.ml
new file mode 100644
index 00000000..f9b9cd70
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t140-switch-3.ml
@@ -0,0 +1,39 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+match 2 with
+| 0 -> raise Not_found
+| 1 -> raise Not_found
+| _ -> ()
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST2
+      10 PUSHACC0
+      11 SWITCH
+        int 0 -> 17
+        int 1 -> 22
+      15 BRANCH 27
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 GETGLOBAL Not_found
+      24 MAKEBLOCK1 0
+      26 RAISE
+      27 CONST0
+      28 POP 1
+      30 ATOM0
+      31 SETGLOBAL T140-switch-3
+      33 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t140-switch-4.ml b/testsuite/tests/tool-ocaml/t140-switch-4.ml
new file mode 100644
index 00000000..874a2442
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t140-switch-4.ml
@@ -0,0 +1,39 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+match -1 with
+| 0 -> raise Not_found
+| 1 -> raise Not_found
+| _ -> ()
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT -1
+      11 PUSHACC0
+      12 SWITCH
+        int 0 -> 18
+        int 1 -> 23
+      16 BRANCH 28
+      18 GETGLOBAL Not_found
+      20 MAKEBLOCK1 0
+      22 RAISE
+      23 GETGLOBAL Not_found
+      25 MAKEBLOCK1 0
+      27 RAISE
+      28 CONST0
+      29 POP 1
+      31 ATOM0
+      32 SETGLOBAL T140-switch-4
+      34 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t141-switch-5.ml b/testsuite/tests/tool-ocaml/t141-switch-5.ml
new file mode 100644
index 00000000..454e2b2e
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t141-switch-5.ml
@@ -0,0 +1,46 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t =
+ | A of int
+ | B of int
+ | C of int
+;;
+
+match A 0 with
+| A _ -> ()
+| B _ -> raise Not_found
+| _ -> raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL <0>(0)
+      11 PUSHACC0
+      12 SWITCH
+        tag 0 -> 17
+        tag 1 -> 20
+        tag 2 -> 25
+      17 CONST0
+      18 BRANCH 30
+      20 GETGLOBAL Not_found
+      22 MAKEBLOCK1 0
+      24 RAISE
+      25 GETGLOBAL Not_found
+      27 MAKEBLOCK1 0
+      29 RAISE
+      30 POP 1
+      32 ATOM0
+      33 SETGLOBAL T141-switch-5
+      35 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t141-switch-6.ml b/testsuite/tests/tool-ocaml/t141-switch-6.ml
new file mode 100644
index 00000000..6bbd6af6
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t141-switch-6.ml
@@ -0,0 +1,46 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t =
+ | A of int
+ | B of int
+ | C of int
+;;
+
+match B 0 with
+| A _ -> raise Not_found
+| B _ -> ()
+| _ -> raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL <1>(0)
+      11 PUSHACC0
+      12 SWITCH
+        tag 0 -> 17
+        tag 1 -> 22
+        tag 2 -> 25
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 CONST0
+      23 BRANCH 30
+      25 GETGLOBAL Not_found
+      27 MAKEBLOCK1 0
+      29 RAISE
+      30 POP 1
+      32 ATOM0
+      33 SETGLOBAL T141-switch-6
+      35 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t141-switch-7.ml b/testsuite/tests/tool-ocaml/t141-switch-7.ml
new file mode 100644
index 00000000..19425f97
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t141-switch-7.ml
@@ -0,0 +1,45 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t =
+ | A of int
+ | B of int
+ | C of int
+;;
+
+match C 0 with
+| A _ -> raise Not_found
+| B _ -> raise Not_found
+| _ -> ()
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL <2>(0)
+      11 PUSHACC0
+      12 SWITCH
+        tag 0 -> 17
+        tag 1 -> 22
+        tag 2 -> 27
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 GETGLOBAL Not_found
+      24 MAKEBLOCK1 0
+      26 RAISE
+      27 CONST0
+      28 POP 1
+      30 ATOM0
+      31 SETGLOBAL T141-switch-7
+      33 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t142-switch-8.ml b/testsuite/tests/tool-ocaml/t142-switch-8.ml
new file mode 100644
index 00000000..0de6b8eb
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t142-switch-8.ml
@@ -0,0 +1,42 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t =
+ | A
+ | B of int
+ | C of int
+;;
+
+match A with
+| A -> ()
+| _ -> raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHACC0
+      11 SWITCH
+        int 0 -> 16
+        tag 0 -> 19
+        tag 1 -> 19
+      16 CONST0
+      17 BRANCH 24
+      19 GETGLOBAL Not_found
+      21 MAKEBLOCK1 0
+      23 RAISE
+      24 POP 1
+      26 ATOM0
+      27 SETGLOBAL T142-switch-8
+      29 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t142-switch-9.ml b/testsuite/tests/tool-ocaml/t142-switch-9.ml
new file mode 100644
index 00000000..4cdfc1f8
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t142-switch-9.ml
@@ -0,0 +1,42 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t =
+ | A
+ | B of int
+ | C of int
+;;
+
+match B 0 with
+| B _ -> ()
+| _ -> raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL <0>(0)
+      11 PUSHACC0
+      12 SWITCH
+        int 0 -> 20
+        tag 0 -> 17
+        tag 1 -> 20
+      17 CONST0
+      18 BRANCH 25
+      20 GETGLOBAL Not_found
+      22 MAKEBLOCK1 0
+      24 RAISE
+      25 POP 1
+      27 ATOM0
+      28 SETGLOBAL T142-switch-9
+      30 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t142-switch-A.ml b/testsuite/tests/tool-ocaml/t142-switch-A.ml
new file mode 100644
index 00000000..0d48e3b5
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t142-switch-A.ml
@@ -0,0 +1,42 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t =
+ | A
+ | B of int
+ | C of int
+;;
+
+match C 0 with
+| C _ -> ()
+| _ -> raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL <1>(0)
+      11 PUSHACC0
+      12 SWITCH
+        int 0 -> 20
+        tag 0 -> 20
+        tag 1 -> 17
+      17 CONST0
+      18 BRANCH 25
+      20 GETGLOBAL Not_found
+      22 MAKEBLOCK1 0
+      24 RAISE
+      25 POP 1
+      27 ATOM0
+      28 SETGLOBAL T142-switch-A
+      30 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t150-push-1.ml b/testsuite/tests/tool-ocaml/t150-push-1.ml
new file mode 100644
index 00000000..8131d4eb
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t150-push-1.ml
@@ -0,0 +1,32 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let _ = 0 in
+try 0 with _ -> 0
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSH
+      11 PUSHTRAP 17
+      13 CONST0
+      14 POPTRAP
+      15 BRANCH 20
+      17 PUSHCONST0
+      18 POP 1
+      20 POP 1
+      22 ATOM0
+      23 SETGLOBAL T150-push-1
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t150-push-2.ml b/testsuite/tests/tool-ocaml/t150-push-2.ml
new file mode 100644
index 00000000..49081e6f
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t150-push-2.ml
@@ -0,0 +1,47 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 1 in
+try if x <> 1 then raise Not_found
+with End_of_file -> ()
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSH
+      11 PUSHTRAP 26
+      13 CONST1
+      14 PUSHACC5
+      15 NEQ
+      16 BRANCHIFNOT 23
+      18 GETGLOBAL Not_found
+      20 MAKEBLOCK1 0
+      22 RAISE
+      23 POPTRAP
+      24 BRANCH 40
+      26 PUSHGETGLOBAL End_of_file
+      28 PUSHACC1
+      29 GETFIELD0
+      30 EQ
+      31 BRANCHIFNOT 36
+      33 CONST0
+      34 BRANCH 38
+      36 ACC0
+      37 RAISE
+      38 POP 1
+      40 POP 1
+      42 ATOM0
+      43 SETGLOBAL T150-push-2
+      45 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t160-closure.ml b/testsuite/tests/tool-ocaml/t160-closure.ml
new file mode 100644
index 00000000..ea1599b3
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t160-closure.ml
@@ -0,0 +1,27 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let f () = ();;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 14
+      11 CONST0
+      12 RETURN 1
+      14 CLOSURE 0, 11
+      17 PUSHACC0
+      18 MAKEBLOCK1 0
+      20 POP 1
+      22 SETGLOBAL T160-closure
+      24 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t161-apply1.ml b/testsuite/tests/tool-ocaml/t161-apply1.ml
new file mode 100644
index 00000000..e11cba67
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t161-apply1.ml
@@ -0,0 +1,50 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let f _ = raise End_of_file in
+try
+  f 0;
+  raise Not_found;
+with End_of_file -> 0
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 16
+      11 GETGLOBAL End_of_file
+      13 MAKEBLOCK1 0
+      15 RAISE
+      16 CLOSURE 0, 11
+      19 PUSH
+      20 PUSHTRAP 30
+      22 CONST0
+      23 PUSHACC5
+      24 APPLY1
+      25 GETGLOBAL Not_found
+      27 MAKEBLOCK1 0
+      29 RAISE
+      30 PUSHGETGLOBAL End_of_file
+      32 PUSHACC1
+      33 GETFIELD0
+      34 EQ
+      35 BRANCHIFNOT 40
+      37 CONST0
+      38 BRANCH 42
+      40 ACC0
+      41 RAISE
+      42 POP 1
+      44 POP 1
+      46 ATOM0
+      47 SETGLOBAL T161-apply1
+      49 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t162-return.ml b/testsuite/tests/tool-ocaml/t162-return.ml
new file mode 100644
index 00000000..63c49697
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t162-return.ml
@@ -0,0 +1,29 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let f _ = 0 in f 0;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 14
+      11 CONST0
+      12 RETURN 1
+      14 CLOSURE 0, 11
+      17 PUSHCONST0
+      18 PUSHACC1
+      19 APPLY1
+      20 POP 1
+      22 ATOM0
+      23 SETGLOBAL T162-return
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t163.ml b/testsuite/tests/tool-ocaml/t163.ml
new file mode 100644
index 00000000..266823a3
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t163.ml
@@ -0,0 +1,31 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let f _ _ = 0 in f 0;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 17
+      11 RESTART
+      12 GRAB 1
+      14 CONST0
+      15 RETURN 2
+      17 CLOSURE 0, 12
+      20 PUSHCONST0
+      21 PUSHACC1
+      22 APPLY1
+      23 POP 1
+      25 ATOM0
+      26 SETGLOBAL T163
+      28 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t164-apply2.ml b/testsuite/tests/tool-ocaml/t164-apply2.ml
new file mode 100644
index 00000000..79ef4136
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t164-apply2.ml
@@ -0,0 +1,32 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let f _ _ = 0 in f 0 0;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 17
+      11 RESTART
+      12 GRAB 1
+      14 CONST0
+      15 RETURN 2
+      17 CLOSURE 0, 12
+      20 PUSHCONST0
+      21 PUSHCONST0
+      22 PUSHACC2
+      23 APPLY2
+      24 POP 1
+      26 ATOM0
+      27 SETGLOBAL T164-apply2
+      29 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t164-apply3.ml b/testsuite/tests/tool-ocaml/t164-apply3.ml
new file mode 100644
index 00000000..1c4f236b
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t164-apply3.ml
@@ -0,0 +1,33 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let f _ _ _ = 0 in f 0 0 0;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 17
+      11 RESTART
+      12 GRAB 2
+      14 CONST0
+      15 RETURN 3
+      17 CLOSURE 0, 12
+      20 PUSHCONST0
+      21 PUSHCONST0
+      22 PUSHCONST0
+      23 PUSHACC3
+      24 APPLY3
+      25 POP 1
+      27 ATOM0
+      28 SETGLOBAL T164-apply3
+      30 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t165-apply.ml b/testsuite/tests/tool-ocaml/t165-apply.ml
new file mode 100644
index 00000000..f71e769c
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t165-apply.ml
@@ -0,0 +1,36 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let f _ _ _ _ = 0 in f 0 0 0 0;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 17
+      11 RESTART
+      12 GRAB 3
+      14 CONST0
+      15 RETURN 4
+      17 CLOSURE 0, 12
+      20 PUSH
+      21 PUSH_RETADDR 30
+      23 CONST0
+      24 PUSHCONST0
+      25 PUSHCONST0
+      26 PUSHCONST0
+      27 PUSHACC7
+      28 APPLY 4
+      30 POP 1
+      32 ATOM0
+      33 SETGLOBAL T165-apply
+      35 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t170-envacc2.ml b/testsuite/tests/tool-ocaml/t170-envacc2.ml
new file mode 100644
index 00000000..c09a08ce
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t170-envacc2.ml
@@ -0,0 +1,45 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 5 in
+let y = 2 in
+let f _ = ignore x; y in
+if f 0 <> 2 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 16
+      11 ENVACC1
+      12 CONST0
+      13 ENVACC2
+      14 RETURN 1
+      16 CONSTINT 5
+      18 PUSHCONST2
+      19 PUSHACC0
+      20 PUSHACC2
+      21 CLOSURE 2, 11
+      24 PUSHCONST2
+      25 PUSHCONST0
+      26 PUSHACC2
+      27 APPLY1
+      28 NEQ
+      29 BRANCHIFNOT 36
+      31 GETGLOBAL Not_found
+      33 MAKEBLOCK1 0
+      35 RAISE
+      36 POP 3
+      38 ATOM0
+      39 SETGLOBAL T170-envacc2
+      41 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t170-envacc3.ml b/testsuite/tests/tool-ocaml/t170-envacc3.ml
new file mode 100644
index 00000000..d70a9124
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t170-envacc3.ml
@@ -0,0 +1,50 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 5 in
+let y = 2 in
+let z = 1 in
+let f _ = ignore x; ignore y; z in
+if f 0 <> 1 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 18
+      11 ENVACC1
+      12 CONST0
+      13 ENVACC2
+      14 CONST0
+      15 ENVACC3
+      16 RETURN 1
+      18 CONSTINT 5
+      20 PUSHCONST2
+      21 PUSHCONST1
+      22 PUSHACC0
+      23 PUSHACC2
+      24 PUSHACC4
+      25 CLOSURE 3, 11
+      28 PUSHCONST1
+      29 PUSHCONST0
+      30 PUSHACC2
+      31 APPLY1
+      32 NEQ
+      33 BRANCHIFNOT 40
+      35 GETGLOBAL Not_found
+      37 MAKEBLOCK1 0
+      39 RAISE
+      40 POP 4
+      42 ATOM0
+      43 SETGLOBAL T170-envacc3
+      45 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t170-envacc4.ml b/testsuite/tests/tool-ocaml/t170-envacc4.ml
new file mode 100644
index 00000000..73a95a52
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t170-envacc4.ml
@@ -0,0 +1,55 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 5 in
+let y = 2 in
+let z = 1 in
+let a = 4 in
+let f _ = ignore x; ignore y; ignore z; a in
+if f 0 <> 4 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 20
+      11 ENVACC1
+      12 CONST0
+      13 ENVACC2
+      14 CONST0
+      15 ENVACC3
+      16 CONST0
+      17 ENVACC4
+      18 RETURN 1
+      20 CONSTINT 5
+      22 PUSHCONST2
+      23 PUSHCONST1
+      24 PUSHCONSTINT 4
+      26 PUSHACC0
+      27 PUSHACC2
+      28 PUSHACC4
+      29 PUSHACC6
+      30 CLOSURE 4, 11
+      33 PUSHCONSTINT 4
+      35 PUSHCONST0
+      36 PUSHACC2
+      37 APPLY1
+      38 NEQ
+      39 BRANCHIFNOT 46
+      41 GETGLOBAL Not_found
+      43 MAKEBLOCK1 0
+      45 RAISE
+      46 POP 5
+      48 ATOM0
+      49 SETGLOBAL T170-envacc4
+      51 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t171-envacc.ml b/testsuite/tests/tool-ocaml/t171-envacc.ml
new file mode 100644
index 00000000..f39b5b85
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t171-envacc.ml
@@ -0,0 +1,60 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 5 in
+let y = 2 in
+let z = 1 in
+let a = 4 in
+let b = 3 in
+let f _ = ignore x; ignore y; ignore z; ignore a; b in
+if f 0 <> 3 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 23
+      11 ENVACC1
+      12 CONST0
+      13 ENVACC2
+      14 CONST0
+      15 ENVACC3
+      16 CONST0
+      17 ENVACC4
+      18 CONST0
+      19 ENVACC 5
+      21 RETURN 1
+      23 CONSTINT 5
+      25 PUSHCONST2
+      26 PUSHCONST1
+      27 PUSHCONSTINT 4
+      29 PUSHCONST3
+      30 PUSHACC0
+      31 PUSHACC2
+      32 PUSHACC4
+      33 PUSHACC6
+      34 PUSHACC 8
+      36 CLOSURE 5, 11
+      39 PUSHCONST3
+      40 PUSHCONST0
+      41 PUSHACC2
+      42 APPLY1
+      43 NEQ
+      44 BRANCHIFNOT 51
+      46 GETGLOBAL Not_found
+      48 MAKEBLOCK1 0
+      50 RAISE
+      51 POP 6
+      53 ATOM0
+      54 SETGLOBAL T171-envacc
+      56 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t172-pushenvacc1.ml b/testsuite/tests/tool-ocaml/t172-pushenvacc1.ml
new file mode 100644
index 00000000..1465bdb3
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t172-pushenvacc1.ml
@@ -0,0 +1,42 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 5 in
+let f _ = x + x in
+if f 0 <> 10 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 16
+      11 ENVACC1
+      12 PUSHENVACC1
+      13 ADDINT
+      14 RETURN 1
+      16 CONSTINT 5
+      18 PUSHACC0
+      19 CLOSURE 1, 11
+      22 PUSHCONSTINT 10
+      24 PUSHCONST0
+      25 PUSHACC2
+      26 APPLY1
+      27 NEQ
+      28 BRANCHIFNOT 35
+      30 GETGLOBAL Not_found
+      32 MAKEBLOCK1 0
+      34 RAISE
+      35 POP 2
+      37 ATOM0
+      38 SETGLOBAL T172-pushenvacc1
+      40 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t172-pushenvacc2.ml b/testsuite/tests/tool-ocaml/t172-pushenvacc2.ml
new file mode 100644
index 00000000..72e86be7
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t172-pushenvacc2.ml
@@ -0,0 +1,45 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 5 in
+let y = 4 in
+let f _ = y + x in
+if f 0 <> 9 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 16
+      11 ENVACC1
+      12 PUSHENVACC2
+      13 ADDINT
+      14 RETURN 1
+      16 CONSTINT 5
+      18 PUSHCONSTINT 4
+      20 PUSHACC0
+      21 PUSHACC2
+      22 CLOSURE 2, 11
+      25 PUSHCONSTINT 9
+      27 PUSHCONST0
+      28 PUSHACC2
+      29 APPLY1
+      30 NEQ
+      31 BRANCHIFNOT 38
+      33 GETGLOBAL Not_found
+      35 MAKEBLOCK1 0
+      37 RAISE
+      38 POP 3
+      40 ATOM0
+      41 SETGLOBAL T172-pushenvacc2
+      43 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t172-pushenvacc3.ml b/testsuite/tests/tool-ocaml/t172-pushenvacc3.ml
new file mode 100644
index 00000000..013b03d8
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t172-pushenvacc3.ml
@@ -0,0 +1,50 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 5 in
+let y = 4 in
+let z = 3 in
+let f _ = z + y + x in
+if f 0 <> 12 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 18
+      11 ENVACC1
+      12 PUSHENVACC2
+      13 PUSHENVACC3
+      14 ADDINT
+      15 ADDINT
+      16 RETURN 1
+      18 CONSTINT 5
+      20 PUSHCONSTINT 4
+      22 PUSHCONST3
+      23 PUSHACC0
+      24 PUSHACC2
+      25 PUSHACC4
+      26 CLOSURE 3, 11
+      29 PUSHCONSTINT 12
+      31 PUSHCONST0
+      32 PUSHACC2
+      33 APPLY1
+      34 NEQ
+      35 BRANCHIFNOT 42
+      37 GETGLOBAL Not_found
+      39 MAKEBLOCK1 0
+      41 RAISE
+      42 POP 4
+      44 ATOM0
+      45 SETGLOBAL T172-pushenvacc3
+      47 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t172-pushenvacc4.ml b/testsuite/tests/tool-ocaml/t172-pushenvacc4.ml
new file mode 100644
index 00000000..45ab2925
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t172-pushenvacc4.ml
@@ -0,0 +1,55 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 5 in
+let y = 4 in
+let z = 3 in
+let a = 2 in
+let f _ = a + z + y + x in
+if f 0 <> 14 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 21
+      11 ENVACC1
+      12 PUSHENVACC2
+      13 PUSHENVACC3
+      14 PUSHENVACC 4
+      16 ADDINT
+      17 ADDINT
+      18 ADDINT
+      19 RETURN 1
+      21 CONSTINT 5
+      23 PUSHCONSTINT 4
+      25 PUSHCONST3
+      26 PUSHCONST2
+      27 PUSHACC0
+      28 PUSHACC2
+      29 PUSHACC4
+      30 PUSHACC6
+      31 CLOSURE 4, 11
+      34 PUSHCONSTINT 14
+      36 PUSHCONST0
+      37 PUSHACC2
+      38 APPLY1
+      39 NEQ
+      40 BRANCHIFNOT 47
+      42 GETGLOBAL Not_found
+      44 MAKEBLOCK1 0
+      46 RAISE
+      47 POP 5
+      49 ATOM0
+      50 SETGLOBAL T172-pushenvacc4
+      52 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t173-pushenvacc.ml b/testsuite/tests/tool-ocaml/t173-pushenvacc.ml
new file mode 100644
index 00000000..4c869587
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t173-pushenvacc.ml
@@ -0,0 +1,60 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 5 in
+let y = 4 in
+let z = 3 in
+let a = 2 in
+let b = 1 in
+let f _ = b + a + z + y + x in
+if f 0 <> 15 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 24
+      11 ENVACC1
+      12 PUSHENVACC2
+      13 PUSHENVACC3
+      14 PUSHENVACC 4
+      16 PUSHENVACC 5
+      18 ADDINT
+      19 ADDINT
+      20 ADDINT
+      21 ADDINT
+      22 RETURN 1
+      24 CONSTINT 5
+      26 PUSHCONSTINT 4
+      28 PUSHCONST3
+      29 PUSHCONST2
+      30 PUSHCONST1
+      31 PUSHACC0
+      32 PUSHACC2
+      33 PUSHACC4
+      34 PUSHACC6
+      35 PUSHACC 8
+      37 CLOSURE 5, 11
+      40 PUSHCONSTINT 15
+      42 PUSHCONST0
+      43 PUSHACC2
+      44 APPLY1
+      45 NEQ
+      46 BRANCHIFNOT 53
+      48 GETGLOBAL Not_found
+      50 MAKEBLOCK1 0
+      52 RAISE
+      53 POP 6
+      55 ATOM0
+      56 SETGLOBAL T173-pushenvacc
+      58 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t180-appterm1.ml b/testsuite/tests/tool-ocaml/t180-appterm1.ml
new file mode 100644
index 00000000..70cac0d9
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t180-appterm1.ml
@@ -0,0 +1,43 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let f _ = 12 in
+let g _ = f 0 in
+if g 0 <> 12 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 19
+      11 CONST0
+      12 PUSHENVACC1
+      13 APPTERM1 2
+      15 CONSTINT 12
+      17 RETURN 1
+      19 CLOSURE 0, 15
+      22 PUSHACC0
+      23 CLOSURE 1, 11
+      26 PUSHCONSTINT 12
+      28 PUSHCONST0
+      29 PUSHACC2
+      30 APPLY1
+      31 NEQ
+      32 BRANCHIFNOT 39
+      34 GETGLOBAL Not_found
+      36 MAKEBLOCK1 0
+      38 RAISE
+      39 POP 2
+      41 ATOM0
+      42 SETGLOBAL T180-appterm1
+      44 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t180-appterm2.ml b/testsuite/tests/tool-ocaml/t180-appterm2.ml
new file mode 100644
index 00000000..e3b9d62a
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t180-appterm2.ml
@@ -0,0 +1,46 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let f _ _ = 12 in
+let g _ = f 0 0 in
+if g 0 <> 12 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 23
+      11 CONST0
+      12 PUSHCONST0
+      13 PUSHENVACC1
+      14 APPTERM2 3
+      16 RESTART
+      17 GRAB 1
+      19 CONSTINT 12
+      21 RETURN 2
+      23 CLOSURE 0, 17
+      26 PUSHACC0
+      27 CLOSURE 1, 11
+      30 PUSHCONSTINT 12
+      32 PUSHCONST0
+      33 PUSHACC2
+      34 APPLY1
+      35 NEQ
+      36 BRANCHIFNOT 43
+      38 GETGLOBAL Not_found
+      40 MAKEBLOCK1 0
+      42 RAISE
+      43 POP 2
+      45 ATOM0
+      46 SETGLOBAL T180-appterm2
+      48 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t180-appterm3.ml b/testsuite/tests/tool-ocaml/t180-appterm3.ml
new file mode 100644
index 00000000..2e4949bb
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t180-appterm3.ml
@@ -0,0 +1,47 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let f _ _ _ = 13 in
+let g _ = f 0 0 0 in
+if g 0 <> 13 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 24
+      11 CONST0
+      12 PUSHCONST0
+      13 PUSHCONST0
+      14 PUSHENVACC1
+      15 APPTERM3 4
+      17 RESTART
+      18 GRAB 2
+      20 CONSTINT 13
+      22 RETURN 3
+      24 CLOSURE 0, 18
+      27 PUSHACC0
+      28 CLOSURE 1, 11
+      31 PUSHCONSTINT 13
+      33 PUSHCONST0
+      34 PUSHACC2
+      35 APPLY1
+      36 NEQ
+      37 BRANCHIFNOT 44
+      39 GETGLOBAL Not_found
+      41 MAKEBLOCK1 0
+      43 RAISE
+      44 POP 2
+      46 ATOM0
+      47 SETGLOBAL T180-appterm3
+      49 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t181-appterm.ml b/testsuite/tests/tool-ocaml/t181-appterm.ml
new file mode 100644
index 00000000..d6d179ca
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t181-appterm.ml
@@ -0,0 +1,48 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let f _ _ _ _ = -10 in
+let g _ = f 0 0 0 0 in
+if g 0 <> -10 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 26
+      11 CONST0
+      12 PUSHCONST0
+      13 PUSHCONST0
+      14 PUSHCONST0
+      15 PUSHENVACC1
+      16 APPTERM 4, 5
+      19 RESTART
+      20 GRAB 3
+      22 CONSTINT -10
+      24 RETURN 4
+      26 CLOSURE 0, 20
+      29 PUSHACC0
+      30 CLOSURE 1, 11
+      33 PUSHCONSTINT -10
+      35 PUSHCONST0
+      36 PUSHACC2
+      37 APPLY1
+      38 NEQ
+      39 BRANCHIFNOT 46
+      41 GETGLOBAL Not_found
+      43 MAKEBLOCK1 0
+      45 RAISE
+      46 POP 2
+      48 ATOM0
+      49 SETGLOBAL T181-appterm
+      51 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t190-makefloatblock-1.ml b/testsuite/tests/tool-ocaml/t190-makefloatblock-1.ml
new file mode 100644
index 00000000..6263bf3d
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t190-makefloatblock-1.ml
@@ -0,0 +1,25 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 0.0 in [| x |];;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL 0
+      11 PUSHACC0
+      12 MAKEFLOATBLOCK 1
+      14 POP 1
+      16 ATOM0
+      17 SETGLOBAL T190-makefloatblock-1
+      19 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t190-makefloatblock-2.ml b/testsuite/tests/tool-ocaml/t190-makefloatblock-2.ml
new file mode 100644
index 00000000..1a650c54
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t190-makefloatblock-2.ml
@@ -0,0 +1,26 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 0.0 in [| x; x |];;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL 0
+      11 PUSHACC0
+      12 PUSHACC1
+      13 MAKEFLOATBLOCK 2
+      15 POP 1
+      17 ATOM0
+      18 SETGLOBAL T190-makefloatblock-2
+      20 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t190-makefloatblock-3.ml b/testsuite/tests/tool-ocaml/t190-makefloatblock-3.ml
new file mode 100644
index 00000000..fb53a4c9
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t190-makefloatblock-3.ml
@@ -0,0 +1,27 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 0.0 in [| x; x; x |];;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL 0
+      11 PUSHACC0
+      12 PUSHACC1
+      13 PUSHACC2
+      14 MAKEFLOATBLOCK 3
+      16 POP 1
+      18 ATOM0
+      19 SETGLOBAL T190-makefloatblock-3
+      21 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t191-vectlength.ml b/testsuite/tests/tool-ocaml/t191-vectlength.ml
new file mode 100644
index 00000000..b2f5a66b
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t191-vectlength.ml
@@ -0,0 +1,34 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = 0.0 in
+if Array.length [| x |] <> 1 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL 0
+      11 PUSHCONST1
+      12 PUSHACC1
+      13 MAKEFLOATBLOCK 1
+      15 VECTLENGTH
+      16 NEQ
+      17 BRANCHIFNOT 24
+      19 GETGLOBAL Not_found
+      21 MAKEBLOCK1 0
+      23 RAISE
+      24 POP 1
+      26 ATOM0
+      27 SETGLOBAL T191-vectlength
+      29 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t192-getfloatfield-1.ml b/testsuite/tests/tool-ocaml/t192-getfloatfield-1.ml
new file mode 100644
index 00000000..30f29106
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t192-getfloatfield-1.ml
@@ -0,0 +1,31 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t = { a : float; b : float };;
+
+if { a = 0.1; b = 0.2 }.a <> 0.1 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL 0.1
+      11 PUSHGETGLOBAL [|0.1, 0.2|]
+      13 GETFLOATFIELD 0
+      15 C_CALL2 neq_float
+      17 BRANCHIFNOT 24
+      19 GETGLOBAL Not_found
+      21 MAKEBLOCK1 0
+      23 RAISE
+      24 ATOM0
+      25 SETGLOBAL T192-getfloatfield-1
+      27 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t192-getfloatfield-2.ml b/testsuite/tests/tool-ocaml/t192-getfloatfield-2.ml
new file mode 100644
index 00000000..c32b858b
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t192-getfloatfield-2.ml
@@ -0,0 +1,31 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t = { a : float; b : float };;
+
+if { a = 0.1; b = 0.2 }.b <> 0.2 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL 0.2
+      11 PUSHGETGLOBAL [|0.1, 0.2|]
+      13 GETFLOATFIELD 1
+      15 C_CALL2 neq_float
+      17 BRANCHIFNOT 24
+      19 GETGLOBAL Not_found
+      21 MAKEBLOCK1 0
+      23 RAISE
+      24 ATOM0
+      25 SETGLOBAL T192-getfloatfield-2
+      27 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t193-setfloatfield-1.ml b/testsuite/tests/tool-ocaml/t193-setfloatfield-1.ml
new file mode 100644
index 00000000..6ce6578e
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t193-setfloatfield-1.ml
@@ -0,0 +1,44 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t = {
+  mutable a : float;
+  mutable b : float;
+};;
+
+let x = { a = 0.1; b = 0.2 } in
+x.a <- 0.3;
+if x.a <> 0.3 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL 0.2
+      11 PUSHGETGLOBAL 0.1
+      13 MAKEFLOATBLOCK 2
+      15 PUSHGETGLOBAL 0.3
+      17 PUSHACC1
+      18 SETFLOATFIELD 0
+      20 GETGLOBAL 0.3
+      22 PUSHACC1
+      23 GETFLOATFIELD 0
+      25 C_CALL2 neq_float
+      27 BRANCHIFNOT 34
+      29 GETGLOBAL Not_found
+      31 MAKEBLOCK1 0
+      33 RAISE
+      34 POP 1
+      36 ATOM0
+      37 SETGLOBAL T193-setfloatfield-1
+      39 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t193-setfloatfield-2.ml b/testsuite/tests/tool-ocaml/t193-setfloatfield-2.ml
new file mode 100644
index 00000000..49390a31
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t193-setfloatfield-2.ml
@@ -0,0 +1,44 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t = {
+  mutable a : float;
+  mutable b : float;
+};;
+
+let x = { a = 0.1; b = 0.2 } in
+x.b <- 0.3;
+if x.b <> 0.3 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL 0.2
+      11 PUSHGETGLOBAL 0.1
+      13 MAKEFLOATBLOCK 2
+      15 PUSHGETGLOBAL 0.3
+      17 PUSHACC1
+      18 SETFLOATFIELD 1
+      20 GETGLOBAL 0.3
+      22 PUSHACC1
+      23 GETFLOATFIELD 1
+      25 C_CALL2 neq_float
+      27 BRANCHIFNOT 34
+      29 GETGLOBAL Not_found
+      31 MAKEBLOCK1 0
+      33 RAISE
+      34 POP 1
+      36 ATOM0
+      37 SETGLOBAL T193-setfloatfield-2
+      39 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t200-getfield0.ml b/testsuite/tests/tool-ocaml/t200-getfield0.ml
new file mode 100644
index 00000000..5681ab7d
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t200-getfield0.ml
@@ -0,0 +1,33 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t = {
+  a : int;
+};;
+
+if { a = 7 }.a <> 7 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 7
+      11 PUSHGETGLOBAL <0>(7)
+      13 GETFIELD0
+      14 NEQ
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 ATOM0
+      23 SETGLOBAL T200-getfield0
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t200-getfield1.ml b/testsuite/tests/tool-ocaml/t200-getfield1.ml
new file mode 100644
index 00000000..8e2f1dfe
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t200-getfield1.ml
@@ -0,0 +1,34 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t = {
+  a : int;
+  b : int;
+};;
+
+if { a = 7; b = 6 }.b <> 6 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 6
+      11 PUSHGETGLOBAL <0>(7, 6)
+      13 GETFIELD1
+      14 NEQ
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 ATOM0
+      23 SETGLOBAL T200-getfield1
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t200-getfield2.ml b/testsuite/tests/tool-ocaml/t200-getfield2.ml
new file mode 100644
index 00000000..ebddd527
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t200-getfield2.ml
@@ -0,0 +1,35 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t = {
+  a : int;
+  b : int;
+  c : int;
+};;
+
+if { a = 7; b = 6; c = 5 }.c <> 5 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 5
+      11 PUSHGETGLOBAL <0>(7, 6, 5)
+      13 GETFIELD2
+      14 NEQ
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 ATOM0
+      23 SETGLOBAL T200-getfield2
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t200-getfield3.ml b/testsuite/tests/tool-ocaml/t200-getfield3.ml
new file mode 100644
index 00000000..487d8f2f
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t200-getfield3.ml
@@ -0,0 +1,36 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t = {
+  a : int;
+  b : int;
+  c : int;
+  d : int;
+};;
+
+if { a = 7; b = 6; c = 5; d = 4 }.d <> 4 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 4
+      11 PUSHGETGLOBAL <0>(7, 6, 5, 4)
+      13 GETFIELD3
+      14 NEQ
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 ATOM0
+      23 SETGLOBAL T200-getfield3
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t201-getfield.ml b/testsuite/tests/tool-ocaml/t201-getfield.ml
new file mode 100644
index 00000000..a0d81c89
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t201-getfield.ml
@@ -0,0 +1,37 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t = {
+  a : int;
+  b : int;
+  c : int;
+  d : int;
+  e : int;
+};;
+
+if { a = 7; b = 6; c = 5; d = 4; e = 3 }.e <> 3 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST3
+      10 PUSHGETGLOBAL <0>(7, 6, 5, 4, 3)
+      12 GETFIELD 4
+      14 NEQ
+      15 BRANCHIFNOT 22
+      17 GETGLOBAL Not_found
+      19 MAKEBLOCK1 0
+      21 RAISE
+      22 ATOM0
+      23 SETGLOBAL T201-getfield
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t210-setfield0.ml b/testsuite/tests/tool-ocaml/t210-setfield0.ml
new file mode 100644
index 00000000..4376f1df
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t210-setfield0.ml
@@ -0,0 +1,44 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t = {
+  mutable a : int;
+};;
+
+let x = {a = 7} in
+x.a <- 11;
+if x.a <> 11 then raise Not_found;
+x
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 7
+      11 MAKEBLOCK1 0
+      13 PUSHCONSTINT 11
+      15 PUSHACC1
+      16 SETFIELD0
+      17 CONSTINT 11
+      19 PUSHACC1
+      20 GETFIELD0
+      21 NEQ
+      22 BRANCHIFNOT 29
+      24 GETGLOBAL Not_found
+      26 MAKEBLOCK1 0
+      28 RAISE
+      29 ACC0
+      30 POP 1
+      32 ATOM0
+      33 SETGLOBAL T210-setfield0
+      35 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t210-setfield1.ml b/testsuite/tests/tool-ocaml/t210-setfield1.ml
new file mode 100644
index 00000000..c5de35c9
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t210-setfield1.ml
@@ -0,0 +1,46 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t = {
+  mutable a : int;
+  mutable b : int;
+};;
+
+let x = {a = 7; b = 6} in
+x.b <- 11;
+if x.b <> 11 then raise Not_found;
+x
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 6
+      11 PUSHCONSTINT 7
+      13 MAKEBLOCK2 0
+      15 PUSHCONSTINT 11
+      17 PUSHACC1
+      18 SETFIELD1
+      19 CONSTINT 11
+      21 PUSHACC1
+      22 GETFIELD1
+      23 NEQ
+      24 BRANCHIFNOT 31
+      26 GETGLOBAL Not_found
+      28 MAKEBLOCK1 0
+      30 RAISE
+      31 ACC0
+      32 POP 1
+      34 ATOM0
+      35 SETGLOBAL T210-setfield1
+      37 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t210-setfield2.ml b/testsuite/tests/tool-ocaml/t210-setfield2.ml
new file mode 100644
index 00000000..ef8218f9
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t210-setfield2.ml
@@ -0,0 +1,48 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t = {
+  mutable a : int;
+  mutable b : int;
+  mutable c : int;
+};;
+
+let x = {a = 7; b = 6; c = 5} in
+x.c <- 11;
+if x.c <> 11 then raise Not_found;
+x
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 5
+      11 PUSHCONSTINT 6
+      13 PUSHCONSTINT 7
+      15 MAKEBLOCK3 0
+      17 PUSHCONSTINT 11
+      19 PUSHACC1
+      20 SETFIELD2
+      21 CONSTINT 11
+      23 PUSHACC1
+      24 GETFIELD2
+      25 NEQ
+      26 BRANCHIFNOT 33
+      28 GETGLOBAL Not_found
+      30 MAKEBLOCK1 0
+      32 RAISE
+      33 ACC0
+      34 POP 1
+      36 ATOM0
+      37 SETGLOBAL T210-setfield2
+      39 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t210-setfield3.ml b/testsuite/tests/tool-ocaml/t210-setfield3.ml
new file mode 100644
index 00000000..531d4e8e
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t210-setfield3.ml
@@ -0,0 +1,50 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t = {
+  mutable a : int;
+  mutable b : int;
+  mutable c : int;
+  mutable d : int;
+};;
+
+let x = {a = 7; b = 6; c = 5; d = 4} in
+x.d <- 11;
+if x.d <> 11 then raise Not_found;
+x
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 4
+      11 PUSHCONSTINT 5
+      13 PUSHCONSTINT 6
+      15 PUSHCONSTINT 7
+      17 MAKEBLOCK 4, 0
+      20 PUSHCONSTINT 11
+      22 PUSHACC1
+      23 SETFIELD3
+      24 CONSTINT 11
+      26 PUSHACC1
+      27 GETFIELD3
+      28 NEQ
+      29 BRANCHIFNOT 36
+      31 GETGLOBAL Not_found
+      33 MAKEBLOCK1 0
+      35 RAISE
+      36 ACC0
+      37 POP 1
+      39 ATOM0
+      40 SETGLOBAL T210-setfield3
+      42 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t211-setfield.ml b/testsuite/tests/tool-ocaml/t211-setfield.ml
new file mode 100644
index 00000000..4183cd69
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t211-setfield.ml
@@ -0,0 +1,52 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+type t = {
+  mutable a : int;
+  mutable b : int;
+  mutable c : int;
+  mutable d : int;
+  mutable e : int;
+};;
+
+let x = {a = 7; b = 6; c = 5; d = 4; e = 5} in
+x.e <- 11;
+if x.e <> 11 then raise Not_found;
+x
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 5
+      11 PUSHCONSTINT 4
+      13 PUSHCONSTINT 5
+      15 PUSHCONSTINT 6
+      17 PUSHCONSTINT 7
+      19 MAKEBLOCK 5, 0
+      22 PUSHCONSTINT 11
+      24 PUSHACC1
+      25 SETFIELD 4
+      27 CONSTINT 11
+      29 PUSHACC1
+      30 GETFIELD 4
+      32 NEQ
+      33 BRANCHIFNOT 40
+      35 GETGLOBAL Not_found
+      37 MAKEBLOCK1 0
+      39 RAISE
+      40 ACC0
+      41 POP 1
+      43 ATOM0
+      44 SETGLOBAL T211-setfield
+      46 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t220-assign.ml b/testsuite/tests/tool-ocaml/t220-assign.ml
new file mode 100644
index 00000000..ef8e5725
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t220-assign.ml
@@ -0,0 +1,35 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = ref 1 in
+x := 3;
+if !x <> 3 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST1
+      10 PUSHCONST3
+      11 ASSIGN 0
+      13 CONST3
+      14 PUSHACC1
+      15 NEQ
+      16 BRANCHIFNOT 23
+      18 GETGLOBAL Not_found
+      20 MAKEBLOCK1 0
+      22 RAISE
+      23 POP 1
+      25 ATOM0
+      26 SETGLOBAL T220-assign
+      28 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t230-check_signals.ml b/testsuite/tests/tool-ocaml/t230-check_signals.ml
new file mode 100644
index 00000000..924a649b
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t230-check_signals.ml
@@ -0,0 +1,36 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+for i = 0 to 0 do () done;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 PUSHCONST0
+      11 PUSH
+      12 BRANCH 21
+      14 CHECK_SIGNALS
+      15 CONST0
+      16 ACC1
+      17 OFFSETINT 1
+      19 ASSIGN 1
+      21 ACC0
+      22 PUSHACC2
+      23 LEINT
+      24 BRANCHIF 14
+      26 CONST0
+      27 POP 2
+      29 ATOM0
+      30 SETGLOBAL T230-check_signals
+      32 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t240-c_call1.ml b/testsuite/tests/tool-ocaml/t240-c_call1.ml
new file mode 100644
index 00000000..b1be841f
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t240-c_call1.ml
@@ -0,0 +1,35 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if Stdlib.int_of_string "123" <> 123 then raise Not_found;;
+(** test for fix of bug 6649: http://caml.inria.fr/mantis/view.php?id=6649 *)
+if Stdlib.int_of_string "+123" <> 123 then raise Not_found;;
+
+if Int32.of_string "+123" <> Int32.of_int 123 then raise Not_found;;
+if Int64.of_string "+123" <> Int64.of_int 123 then raise Not_found;;
+if Nativeint.of_string "+123" <> Nativeint.of_int 123 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 123
+      11 PUSHGETGLOBAL "123"
+      13 C_CALL1 int_of_string
+      15 NEQ
+      16 BRANCHIFNOT 23
+      18 GETGLOBAL Not_found
+      20 MAKEBLOCK1 0
+      22 RAISE
+      23 ATOM0
+      24 SETGLOBAL T240-c_call1
+      26 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t240-c_call2.ml b/testsuite/tests/tool-ocaml/t240-c_call2.ml
new file mode 100644
index 00000000..d4a10a70
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t240-c_call2.ml
@@ -0,0 +1,30 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if Pervasives.compare 1 2 <> -1 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT -1
+      11 PUSHCONST2
+      12 PUSHCONST1
+      13 C_CALL2 compare
+      15 NEQ
+      16 BRANCHIFNOT 23
+      18 GETGLOBAL Not_found
+      20 MAKEBLOCK1 0
+      22 RAISE
+      23 ATOM0
+      24 SETGLOBAL T240-c_call2
+      26 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t240-c_call3.ml b/testsuite/tests/tool-ocaml/t240-c_call3.ml
new file mode 100644
index 00000000..5306aa22
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t240-c_call3.ml
@@ -0,0 +1,31 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+if Hashtbl.hash_param 5 6 [1;2;3] <> 697606130 then raise Not_found;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 196799
+      11 PUSHGETGLOBAL <0>(1, <0>(2, <0>(3, 0)))
+      13 PUSHCONSTINT 6
+      15 PUSHCONSTINT 5
+      17 C_CALL3 hash_univ_param
+      19 NEQ
+      20 BRANCHIFNOT 27
+      22 GETGLOBAL Not_found
+      24 MAKEBLOCK1 0
+      26 RAISE
+      27 ATOM0
+      28 SETGLOBAL T240-c_call3
+      30 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t240-c_call4.ml b/testsuite/tests/tool-ocaml/t240-c_call4.ml
new file mode 100644
index 00000000..ba3a2ce7
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t240-c_call4.ml
@@ -0,0 +1,40 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let s = Bytes.of_string "abcdefgh" in
+Bytes.unsafe_fill s 0 6 'x';
+if Bytes.get s 5 <> 'x' then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL "abcdefgh"
+      11 PUSHCONSTINT 120
+      13 PUSHCONSTINT 6
+      15 PUSHCONST0
+      16 PUSHACC3
+      17 C_CALL4 fill_string
+      19 CONSTINT 120
+      21 PUSHCONSTINT 5
+      23 PUSHACC2
+      24 GETSTRINGCHAR
+      25 NEQ
+      26 BRANCHIFNOT 33
+      28 GETGLOBAL Not_found
+      30 MAKEBLOCK1 0
+      32 RAISE
+      33 POP 1
+      35 ATOM0
+      36 SETGLOBAL T240-c_call4
+      38 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t240-c_call5.ml b/testsuite/tests/tool-ocaml/t240-c_call5.ml
new file mode 100644
index 00000000..8be199c7
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t240-c_call5.ml
@@ -0,0 +1,41 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let s = Bytes.of_string "abcdefgh" in
+Bytes.unsafe_blit s 3 s 0 3;
+if Bytes.get s 0 <> 'd' then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 GETGLOBAL "abcdefgh"
+      11 PUSHCONST3
+      12 PUSHCONST0
+      13 PUSHACC2
+      14 PUSHCONST3
+      15 PUSHACC4
+      16 C_CALL5 blit_string
+      18 CONSTINT 100
+      20 PUSHCONST0
+      21 PUSHACC2
+      22 GETSTRINGCHAR
+      23 NEQ
+      24 BRANCHIFNOT 31
+      26 GETGLOBAL Not_found
+      28 MAKEBLOCK1 0
+      30 RAISE
+      31 POP 1
+      33 ATOM0
+      34 SETGLOBAL T240-c_call5
+      36 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t250-closurerec-1.ml b/testsuite/tests/tool-ocaml/t250-closurerec-1.ml
new file mode 100644
index 00000000..a8f02b34
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t250-closurerec-1.ml
@@ -0,0 +1,27 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f _ = 0;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 14
+      11 CONST0
+      12 RETURN 1
+      14 CLOSUREREC 0, 11
+      18 ACC0
+      19 MAKEBLOCK1 0
+      21 POP 1
+      23 SETGLOBAL T250-closurerec-1
+      25 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t250-closurerec-2.ml b/testsuite/tests/tool-ocaml/t250-closurerec-2.ml
new file mode 100644
index 00000000..4d973b36
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t250-closurerec-2.ml
@@ -0,0 +1,37 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f _ = 23 in
+if f 0 <> 23 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 15
+      11 CONSTINT 23
+      13 RETURN 1
+      15 CLOSUREREC 0, 11
+      19 CONSTINT 23
+      21 PUSHCONST0
+      22 PUSHACC2
+      23 APPLY1
+      24 NEQ
+      25 BRANCHIFNOT 32
+      27 GETGLOBAL Not_found
+      29 MAKEBLOCK1 0
+      31 RAISE
+      32 POP 1
+      34 ATOM0
+      35 SETGLOBAL T250-closurerec-2
+      37 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t251-pushoffsetclosure0.ml b/testsuite/tests/tool-ocaml/t251-pushoffsetclosure0.ml
new file mode 100644
index 00000000..6a2fe2c2
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t251-pushoffsetclosure0.ml
@@ -0,0 +1,47 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f = function
+  | 0 -> 13
+  | n -> f 0
+in
+if f 5 <> 13 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 24
+      11 CONST0
+      12 PUSHACC1
+      13 EQ
+      14 BRANCHIFNOT 20
+      16 CONSTINT 13
+      18 RETURN 1
+      20 CONST0
+      21 PUSHOFFSETCLOSURE0
+      22 APPTERM1 2
+      24 CLOSUREREC 0, 11
+      28 CONSTINT 13
+      30 PUSHCONSTINT 5
+      32 PUSHACC2
+      33 APPLY1
+      34 NEQ
+      35 BRANCHIFNOT 42
+      37 GETGLOBAL Not_found
+      39 MAKEBLOCK1 0
+      41 RAISE
+      42 POP 1
+      44 ATOM0
+      45 SETGLOBAL T251-pushoffsetclosure0
+      47 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t251-pushoffsetclosure2.ml b/testsuite/tests/tool-ocaml/t251-pushoffsetclosure2.ml
new file mode 100644
index 00000000..10a16d71
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t251-pushoffsetclosure2.ml
@@ -0,0 +1,42 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f _ = g 0
+    and g _ = 4
+in
+if f 5 <> 4 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 19
+      11 CONST0
+      12 PUSHOFFSETCLOSURE2
+      13 APPTERM1 2
+      15 CONSTINT 4
+      17 RETURN 1
+      19 CLOSUREREC 0, 11, 15
+      24 CONSTINT 4
+      26 PUSHCONSTINT 5
+      28 PUSHACC3
+      29 APPLY1
+      30 NEQ
+      31 BRANCHIFNOT 38
+      33 GETGLOBAL Not_found
+      35 MAKEBLOCK1 0
+      37 RAISE
+      38 POP 2
+      40 ATOM0
+      41 SETGLOBAL T251-pushoffsetclosure2
+      43 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t251-pushoffsetclosurem2.ml b/testsuite/tests/tool-ocaml/t251-pushoffsetclosurem2.ml
new file mode 100644
index 00000000..b0cd3227
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t251-pushoffsetclosurem2.ml
@@ -0,0 +1,42 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f _ = 4
+    and g _ = f 2
+in
+if g 5 <> 4 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 19
+      11 CONSTINT 4
+      13 RETURN 1
+      15 CONST2
+      16 PUSHOFFSETCLOSUREM2
+      17 APPTERM1 2
+      19 CLOSUREREC 0, 11, 15
+      24 CONSTINT 4
+      26 PUSHCONSTINT 5
+      28 PUSHACC2
+      29 APPLY1
+      30 NEQ
+      31 BRANCHIFNOT 38
+      33 GETGLOBAL Not_found
+      35 MAKEBLOCK1 0
+      37 RAISE
+      38 POP 2
+      40 ATOM0
+      41 SETGLOBAL T251-pushoffsetclosurem2
+      43 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t252-pushoffsetclosure.ml b/testsuite/tests/tool-ocaml/t252-pushoffsetclosure.ml
new file mode 100644
index 00000000..d4d01bdc
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t252-pushoffsetclosure.ml
@@ -0,0 +1,46 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f x = x
+    and g _ = f 4
+    and h _ = f 6
+in
+if h 1 <> 6 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 25
+      11 ACC0
+      12 RETURN 1
+      14 CONSTINT 4
+      16 PUSHOFFSETCLOSUREM2
+      17 APPTERM1 2
+      19 CONSTINT 6
+      21 PUSHOFFSETCLOSURE -4
+      23 APPTERM1 2
+      25 CLOSUREREC 0, 11, 14, 19
+      31 CONSTINT 6
+      33 PUSHCONST1
+      34 PUSHACC2
+      35 APPLY1
+      36 NEQ
+      37 BRANCHIFNOT 44
+      39 GETGLOBAL Not_found
+      41 MAKEBLOCK1 0
+      43 RAISE
+      44 POP 3
+      46 ATOM0
+      47 SETGLOBAL T252-pushoffsetclosure
+      49 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t253-offsetclosure0.ml b/testsuite/tests/tool-ocaml/t253-offsetclosure0.ml
new file mode 100644
index 00000000..0f56a0a2
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t253-offsetclosure0.ml
@@ -0,0 +1,42 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f _ = g f
+    and g _ = 10
+in
+if f 3 <> 10 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 19
+      11 OFFSETCLOSURE0
+      12 PUSHOFFSETCLOSURE2
+      13 APPTERM1 2
+      15 CONSTINT 10
+      17 RETURN 1
+      19 CLOSUREREC 0, 11, 15
+      24 CONSTINT 10
+      26 PUSHCONST3
+      27 PUSHACC3
+      28 APPLY1
+      29 NEQ
+      30 BRANCHIFNOT 37
+      32 GETGLOBAL Not_found
+      34 MAKEBLOCK1 0
+      36 RAISE
+      37 POP 2
+      39 ATOM0
+      40 SETGLOBAL T253-offsetclosure0
+      42 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t253-offsetclosure2.ml b/testsuite/tests/tool-ocaml/t253-offsetclosure2.ml
new file mode 100644
index 00000000..e383b8cc
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t253-offsetclosure2.ml
@@ -0,0 +1,42 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f _ = g
+    and g _ = 10
+in
+if f 3 4 <> 10 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 18
+      11 OFFSETCLOSURE2
+      12 RETURN 1
+      14 CONSTINT 10
+      16 RETURN 1
+      18 CLOSUREREC 0, 11, 14
+      23 CONSTINT 10
+      25 PUSHCONSTINT 4
+      27 PUSHCONST3
+      28 PUSHACC4
+      29 APPLY2
+      30 NEQ
+      31 BRANCHIFNOT 38
+      33 GETGLOBAL Not_found
+      35 MAKEBLOCK1 0
+      37 RAISE
+      38 POP 2
+      40 ATOM0
+      41 SETGLOBAL T253-offsetclosure2
+      43 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t253-offsetclosurem2.ml b/testsuite/tests/tool-ocaml/t253-offsetclosurem2.ml
new file mode 100644
index 00000000..d131d892
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t253-offsetclosurem2.ml
@@ -0,0 +1,42 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f _ = 11
+    and g _ = f
+in
+if g 3 4 <> 11 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 18
+      11 CONSTINT 11
+      13 RETURN 1
+      15 OFFSETCLOSUREM2
+      16 RETURN 1
+      18 CLOSUREREC 0, 11, 15
+      23 CONSTINT 11
+      25 PUSHCONSTINT 4
+      27 PUSHCONST3
+      28 PUSHACC3
+      29 APPLY2
+      30 NEQ
+      31 BRANCHIFNOT 38
+      33 GETGLOBAL Not_found
+      35 MAKEBLOCK1 0
+      37 RAISE
+      38 POP 2
+      40 ATOM0
+      41 SETGLOBAL T253-offsetclosurem2
+      43 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t254-offsetclosure.ml b/testsuite/tests/tool-ocaml/t254-offsetclosure.ml
new file mode 100644
index 00000000..de58828c
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t254-offsetclosure.ml
@@ -0,0 +1,45 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f _ = 11
+    and g _ = 0
+    and h _ = f
+in
+if h 3 4 <> 11 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 22
+      11 CONSTINT 11
+      13 RETURN 1
+      15 CONST0
+      16 RETURN 1
+      18 OFFSETCLOSURE -4
+      20 RETURN 1
+      22 CLOSUREREC 0, 11, 15, 18
+      28 CONSTINT 11
+      30 PUSHCONSTINT 4
+      32 PUSHCONST3
+      33 PUSHACC3
+      34 APPLY2
+      35 NEQ
+      36 BRANCHIFNOT 43
+      38 GETGLOBAL Not_found
+      40 MAKEBLOCK1 0
+      42 RAISE
+      43 POP 3
+      45 ATOM0
+      46 SETGLOBAL T254-offsetclosure
+      48 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t260-offsetref.ml b/testsuite/tests/tool-ocaml/t260-offsetref.ml
new file mode 100644
index 00000000..9803cbe9
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t260-offsetref.ml
@@ -0,0 +1,39 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = ref 32 in
+incr x;
+if !x <> 33 then raise Not_found;
+x
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONSTINT 32
+      11 MAKEBLOCK1 0
+      13 PUSHACC0
+      14 OFFSETREF 1
+      16 CONSTINT 33
+      18 PUSHACC1
+      19 GETFIELD0
+      20 NEQ
+      21 BRANCHIFNOT 28
+      23 GETGLOBAL Not_found
+      25 MAKEBLOCK1 0
+      27 RAISE
+      28 ACC0
+      29 POP 1
+      31 ATOM0
+      32 SETGLOBAL T260-offsetref
+      34 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t270-push_retaddr.ml b/testsuite/tests/tool-ocaml/t270-push_retaddr.ml
new file mode 100644
index 00000000..1bfffbc5
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t270-push_retaddr.ml
@@ -0,0 +1,44 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let f a b c d = 123 in
+if f 0 1 2 3 <> 123 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 18
+      11 RESTART
+      12 GRAB 3
+      14 CONSTINT 123
+      16 RETURN 4
+      18 CLOSURE 0, 12
+      21 PUSHCONSTINT 123
+      23 PUSH
+      24 PUSH_RETADDR 34
+      26 CONST3
+      27 PUSHCONST2
+      28 PUSHCONST1
+      29 PUSHCONST0
+      30 PUSHACC 8
+      32 APPLY 4
+      34 NEQ
+      35 BRANCHIFNOT 42
+      37 GETGLOBAL Not_found
+      39 MAKEBLOCK1 0
+      41 RAISE
+      42 POP 1
+      44 ATOM0
+      45 SETGLOBAL T270-push_retaddr
+      47 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t300-getmethod.ml b/testsuite/tests/tool-ocaml/t300-getmethod.ml
new file mode 100644
index 00000000..13dae267
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t300-getmethod.ml
@@ -0,0 +1,5893 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+
+class c = object
+  method m = 23
+end;;
+
+let o = new c in
+if o#m <> 23 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 746
+      11 RESTART
+      12 GRAB 1
+      14 ACC0
+      15 BRANCHIFNOT 28
+      17 ACC1
+      18 PUSHACC1
+      19 GETFIELD1
+      20 PUSHOFFSETCLOSURE0
+      21 APPLY2
+      22 PUSHACC1
+      23 GETFIELD0
+      24 MAKEBLOCK2 0
+      26 RETURN 2
+      28 ACC1
+      29 RETURN 2
+      31 RESTART
+      32 GRAB 3
+      34 CONST0
+      35 PUSHACC4
+      36 LEINT
+      37 BRANCHIFNOT 42
+      39 CONST0
+      40 RETURN 4
+      42 ACC3
+      43 PUSHACC3
+      44 PUSHACC3
+      45 PUSHACC3
+      46 C_CALL4 caml_input
+      48 PUSHCONST0
+      49 PUSHACC1
+      50 EQ
+      51 BRANCHIFNOT 58
+      53 GETGLOBAL End_of_file
+      55 MAKEBLOCK1 0
+      57 RAISE
+      58 ACC0
+      59 PUSHACC5
+      60 SUBINT
+      61 PUSHACC1
+      62 PUSHACC5
+      63 ADDINT
+      64 PUSHACC4
+      65 PUSHACC4
+      66 PUSHOFFSETCLOSURE0
+      67 APPTERM 4, 9
+      70 ACC0
+      71 C_CALL1 caml_input_scan_line
+      73 PUSHCONST0
+      74 PUSHACC1
+      75 EQ
+      76 BRANCHIFNOT 83
+      78 GETGLOBAL End_of_file
+      80 MAKEBLOCK1 0
+      82 RAISE
+      83 CONST0
+      84 PUSHACC1
+      85 GTINT
+      86 BRANCHIFNOT 107
+      88 ACC0
+      89 OFFSETINT -1
+      91 C_CALL1 create_string
+      93 PUSHACC1
+      94 OFFSETINT -1
+      96 PUSHCONST0
+      97 PUSHACC2
+      98 PUSHACC5
+      99 C_CALL4 caml_input
+     101 ACC2
+     102 C_CALL1 caml_input_char
+     104 ACC0
+     105 RETURN 3
+     107 ACC0
+     108 NEGINT
+     109 C_CALL1 create_string
+     111 PUSHACC1
+     112 NEGINT
+     113 PUSHCONST0
+     114 PUSHACC2
+     115 PUSHACC5
+     116 C_CALL4 caml_input
+     118 CONST0
+     119 PUSHTRAP 130
+     121 ACC6
+     122 PUSHOFFSETCLOSURE0
+     123 APPLY1
+     124 PUSHACC5
+     125 PUSHENVACC1
+     126 APPLY2
+     127 POPTRAP
+     128 RETURN 3
+     130 PUSHGETGLOBAL End_of_file
+     132 PUSHACC1
+     133 GETFIELD0
+     134 EQ
+     135 BRANCHIFNOT 140
+     137 ACC1
+     138 RETURN 4
+     140 ACC0
+     141 RAISE
+     142 ACC0
+     143 C_CALL1 caml_flush
+     145 RETURN 1
+     147 RESTART
+     148 GRAB 1
+     150 ACC1
+     151 PUSHACC1
+     152 C_CALL2 caml_output_char
+     154 RETURN 2
+     156 RESTART
+     157 GRAB 1
+     159 ACC1
+     160 PUSHACC1
+     161 C_CALL2 caml_output_char
+     163 RETURN 2
+     165 RESTART
+     166 GRAB 1
+     168 ACC1
+     169 PUSHACC1
+     170 C_CALL2 caml_output_int
+     172 RETURN 2
+     174 RESTART
+     175 GRAB 1
+     177 ACC1
+     178 PUSHACC1
+     179 C_CALL2 caml_seek_out
+     181 RETURN 2
+     183 ACC0
+     184 C_CALL1 caml_pos_out
+     186 RETURN 1
+     188 ACC0
+     189 C_CALL1 caml_channel_size
+     191 RETURN 1
+     193 RESTART
+     194 GRAB 1
+     196 ACC1
+     197 PUSHACC1
+     198 C_CALL2 caml_set_binary_mode
+     200 RETURN 2
+     202 ACC0
+     203 C_CALL1 caml_input_char
+     205 RETURN 1
+     207 ACC0
+     208 C_CALL1 caml_input_char
+     210 RETURN 1
+     212 ACC0
+     213 C_CALL1 caml_input_int
+     215 RETURN 1
+     217 ACC0
+     218 C_CALL1 input_value
+     220 RETURN 1
+     222 RESTART
+     223 GRAB 1
+     225 ACC1
+     226 PUSHACC1
+     227 C_CALL2 caml_seek_in
+     229 RETURN 2
+     231 ACC0
+     232 C_CALL1 caml_pos_in
+     234 RETURN 1
+     236 ACC0
+     237 C_CALL1 caml_channel_size
+     239 RETURN 1
+     241 ACC0
+     242 C_CALL1 caml_close_channel
+     244 RETURN 1
+     246 RESTART
+     247 GRAB 1
+     249 ACC1
+     250 PUSHACC1
+     251 C_CALL2 caml_set_binary_mode
+     253 RETURN 2
+     255 CONST0
+     256 PUSHENVACC1
+     257 APPLY1
+     258 ACC0
+     259 C_CALL1 sys_exit
+     261 RETURN 1
+     263 CONST0
+     264 PUSHENVACC1
+     265 GETFIELD0
+     266 APPTERM1 2
+     268 CONST0
+     269 PUSHENVACC1
+     270 APPLY1
+     271 CONST0
+     272 PUSHENVACC2
+     273 APPTERM1 2
+     275 ENVACC1
+     276 GETFIELD0
+     277 PUSHACC0
+     278 PUSHACC2
+     279 CLOSURE 2, 268
+     282 PUSHENVACC1
+     283 SETFIELD0
+     284 RETURN 2
+     286 ENVACC1
+     287 C_CALL1 caml_flush
+     289 ENVACC2
+     290 C_CALL1 caml_flush
+     292 RETURN 1
+     294 CONST0
+     295 PUSHENVACC1
+     296 APPLY1
+     297 C_CALL1 float_of_string
+     299 RETURN 1
+     301 CONST0
+     302 PUSHENVACC1
+     303 APPLY1
+     304 C_CALL1 int_of_string
+     306 RETURN 1
+     308 ENVACC2
+     309 C_CALL1 caml_flush
+     311 ENVACC1
+     312 PUSHENVACC3
+     313 APPTERM1 2
+     315 CONSTINT 13
+     317 PUSHENVACC1
+     318 C_CALL2 caml_output_char
+     320 ENVACC1
+     321 C_CALL1 caml_flush
+     323 RETURN 1
+     325 ACC0
+     326 PUSHENVACC1
+     327 PUSHENVACC2
+     328 APPLY2
+     329 CONSTINT 13
+     331 PUSHENVACC1
+     332 C_CALL2 caml_output_char
+     334 ENVACC1
+     335 C_CALL1 caml_flush
+     337 RETURN 1
+     339 ACC0
+     340 PUSHENVACC1
+     341 APPLY1
+     342 PUSHENVACC2
+     343 PUSHENVACC3
+     344 APPTERM2 3
+     346 ACC0
+     347 PUSHENVACC1
+     348 APPLY1
+     349 PUSHENVACC2
+     350 PUSHENVACC3
+     351 APPTERM2 3
+     353 ACC0
+     354 PUSHENVACC1
+     355 PUSHENVACC2
+     356 APPTERM2 3
+     358 ACC0
+     359 PUSHENVACC1
+     360 C_CALL2 caml_output_char
+     362 RETURN 1
+     364 CONSTINT 13
+     366 PUSHENVACC1
+     367 C_CALL2 caml_output_char
+     369 ENVACC1
+     370 C_CALL1 caml_flush
+     372 RETURN 1
+     374 ACC0
+     375 PUSHENVACC1
+     376 PUSHENVACC2
+     377 APPLY2
+     378 CONSTINT 13
+     380 PUSHENVACC1
+     381 C_CALL2 caml_output_char
+     383 RETURN 1
+     385 ACC0
+     386 PUSHENVACC1
+     387 APPLY1
+     388 PUSHENVACC2
+     389 PUSHENVACC3
+     390 APPTERM2 3
+     392 ACC0
+     393 PUSHENVACC1
+     394 APPLY1
+     395 PUSHENVACC2
+     396 PUSHENVACC3
+     397 APPTERM2 3
+     399 ACC0
+     400 PUSHENVACC1
+     401 PUSHENVACC2
+     402 APPTERM2 3
+     404 ACC0
+     405 PUSHENVACC1
+     406 C_CALL2 caml_output_char
+     408 RETURN 1
+     410 RESTART
+     411 GRAB 3
+     413 CONST0
+     414 PUSHACC3
+     415 LTINT
+     416 BRANCHIF 427
+     418 ACC1
+     419 C_CALL1 ml_string_length
+     421 PUSHACC4
+     422 PUSHACC4
+     423 ADDINT
+     424 GTINT
+     425 BRANCHIFNOT 432
+     427 GETGLOBAL "really_input"
+     429 PUSHENVACC1
+     430 APPTERM1 5
+     432 ACC3
+     433 PUSHACC3
+     434 PUSHACC3
+     435 PUSHACC3
+     436 PUSHENVACC2
+     437 APPTERM 4, 8
+     440 RESTART
+     441 GRAB 3
+     443 CONST0
+     444 PUSHACC3
+     445 LTINT
+     446 BRANCHIF 457
+     448 ACC1
+     449 C_CALL1 ml_string_length
+     451 PUSHACC4
+     452 PUSHACC4
+     453 ADDINT
+     454 GTINT
+     455 BRANCHIFNOT 462
+     457 GETGLOBAL "input"
+     459 PUSHENVACC1
+     460 APPTERM1 5
+     462 ACC3
+     463 PUSHACC3
+     464 PUSHACC3
+     465 PUSHACC3
+     466 C_CALL4 caml_input
+     468 RETURN 4
+     470 ACC0
+     471 PUSHCONST0
+     472 PUSHGETGLOBAL <0>(0, <0>(6, 0))
+     474 PUSHENVACC1
+     475 APPTERM3 4
+     477 ACC0
+     478 PUSHCONST0
+     479 PUSHGETGLOBAL <0>(0, <0>(7, 0))
+     481 PUSHENVACC1
+     482 APPTERM3 4
+     484 RESTART
+     485 GRAB 2
+     487 ACC1
+     488 PUSHACC1
+     489 PUSHACC4
+     490 C_CALL3 sys_open
+     492 C_CALL1 caml_open_descriptor
+     494 RETURN 3
+     496 ACC0
+     497 C_CALL1 caml_flush
+     499 ACC0
+     500 C_CALL1 caml_close_channel
+     502 RETURN 1
+     504 RESTART
+     505 GRAB 1
+     507 CONST0
+     508 PUSHACC2
+     509 PUSHACC2
+     510 C_CALL3 output_value
+     512 RETURN 2
+     514 RESTART
+     515 GRAB 3
+     517 CONST0
+     518 PUSHACC3
+     519 LTINT
+     520 BRANCHIF 531
+     522 ACC1
+     523 C_CALL1 ml_string_length
+     525 PUSHACC4
+     526 PUSHACC4
+     527 ADDINT
+     528 GTINT
+     529 BRANCHIFNOT 536
+     531 GETGLOBAL "output"
+     533 PUSHENVACC1
+     534 APPTERM1 5
+     536 ACC3
+     537 PUSHACC3
+     538 PUSHACC3
+     539 PUSHACC3
+     540 C_CALL4 caml_output
+     542 RETURN 4
+     544 RESTART
+     545 GRAB 1
+     547 ACC1
+     548 C_CALL1 ml_string_length
+     550 PUSHCONST0
+     551 PUSHACC3
+     552 PUSHACC3
+     553 C_CALL4 caml_output
+     555 RETURN 2
+     557 ACC0
+     558 PUSHCONSTINT 438
+     560 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(6, 0))))
+     562 PUSHENVACC1
+     563 APPTERM3 4
+     565 ACC0
+     566 PUSHCONSTINT 438
+     568 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(7, 0))))
+     570 PUSHENVACC1
+     571 APPTERM3 4
+     573 RESTART
+     574 GRAB 2
+     576 ACC1
+     577 PUSHACC1
+     578 PUSHACC4
+     579 C_CALL3 sys_open
+     581 C_CALL1 caml_open_descriptor
+     583 RETURN 3
+     585 ACC0
+     586 PUSHGETGLOBAL "%.12g"
+     588 C_CALL2 format_float
+     590 RETURN 1
+     592 ACC0
+     593 PUSHGETGLOBAL "%d"
+     595 C_CALL2 format_int
+     597 RETURN 1
+     599 GETGLOBAL "false"
+     601 PUSHACC1
+     602 C_CALL2 string_equal
+     604 BRANCHIFNOT 609
+     606 CONST0
+     607 RETURN 1
+     609 GETGLOBAL "true"
+     611 PUSHACC1
+     612 C_CALL2 string_equal
+     614 BRANCHIFNOT 619
+     616 CONST1
+     617 RETURN 1
+     619 GETGLOBAL "bool_of_string"
+     621 PUSHENVACC1
+     622 APPTERM1 2
+     624 ACC0
+     625 BRANCHIFNOT 631
+     627 GETGLOBAL "true"
+     629 RETURN 1
+     631 GETGLOBAL "false"
+     633 RETURN 1
+     635 CONST0
+     636 PUSHACC1
+     637 LTINT
+     638 BRANCHIF 646
+     640 CONSTINT 255
+     642 PUSHACC1
+     643 GTINT
+     644 BRANCHIFNOT 651
+     646 GETGLOBAL "char_of_int"
+     648 PUSHENVACC1
+     649 APPTERM1 2
+     651 ACC0
+     652 RETURN 1
+     654 RESTART
+     655 GRAB 1
+     657 ACC0
+     658 C_CALL1 ml_string_length
+     660 PUSHACC2
+     661 C_CALL1 ml_string_length
+     663 PUSHACC0
+     664 PUSHACC2
+     665 ADDINT
+     666 C_CALL1 create_string
+     668 PUSHACC2
+     669 PUSHCONST0
+     670 PUSHACC2
+     671 PUSHCONST0
+     672 PUSHACC7
+     673 C_CALL5 blit_string
+     675 ACC1
+     676 PUSHACC3
+     677 PUSHACC2
+     678 PUSHCONST0
+     679 PUSHACC 8
+     681 C_CALL5 blit_string
+     683 ACC0
+     684 RETURN 5
+     686 CONSTINT -1
+     688 PUSHACC1
+     689 XORINT
+     690 RETURN 1
+     692 CONST0
+     693 PUSHACC1
+     694 GEINT
+     695 BRANCHIFNOT 700
+     697 ACC0
+     698 RETURN 1
+     700 ACC0
+     701 NEGINT
+     702 RETURN 1
+     704 RESTART
+     705 GRAB 1
+     707 ACC1
+     708 PUSHACC1
+     709 C_CALL2 greaterequal
+     711 BRANCHIFNOT 716
+     713 ACC0
+     714 RETURN 2
+     716 ACC1
+     717 RETURN 2
+     719 RESTART
+     720 GRAB 1
+     722 ACC1
+     723 PUSHACC1
+     724 C_CALL2 lessequal
+     726 BRANCHIFNOT 731
+     728 ACC0
+     729 RETURN 2
+     731 ACC1
+     732 RETURN 2
+     734 ACC0
+     735 PUSHGETGLOBAL Invalid_argument
+     737 MAKEBLOCK2 0
+     739 RAISE
+     740 ACC0
+     741 PUSHGETGLOBAL Failure
+     743 MAKEBLOCK2 0
+     745 RAISE
+     746 CLOSURE 0, 740
+     749 PUSH
+     750 CLOSURE 0, 734
+     753 PUSHGETGLOBAL "Pervasives.Exit"
+     755 MAKEBLOCK1 0
+     757 PUSHGETGLOBAL "Pervasives.Assert_failure"
+     759 MAKEBLOCK1 0
+     761 PUSH
+     762 CLOSURE 0, 720
+     765 PUSH
+     766 CLOSURE 0, 705
+     769 PUSH
+     770 CLOSURE 0, 692
+     773 PUSH
+     774 CLOSURE 0, 686
+     777 PUSHCONST0
+     778 PUSHCONSTINT 31
+     780 PUSHCONST1
+     781 LSLINT
+     782 EQ
+     783 BRANCHIFNOT 789
+     785 CONSTINT 30
+     787 BRANCH 791
+     789 CONSTINT 62
+     791 PUSHCONST1
+     792 LSLINT
+     793 PUSHACC0
+     794 OFFSETINT -1
+     796 PUSH
+     797 CLOSURE 0, 655
+     800 PUSHACC 9
+     802 CLOSURE 1, 635
+     805 PUSH
+     806 CLOSURE 0, 624
+     809 PUSHACC 11
+     811 CLOSURE 1, 599
+     814 PUSH
+     815 CLOSURE 0, 592
+     818 PUSH
+     819 CLOSURE 0, 585
+     822 PUSH
+     823 CLOSUREREC 0, 12
+     827 CONST0
+     828 C_CALL1 caml_open_descriptor
+     830 PUSHCONST1
+     831 C_CALL1 caml_open_descriptor
+     833 PUSHCONST2
+     834 C_CALL1 caml_open_descriptor
+     836 PUSH
+     837 CLOSURE 0, 574
+     840 PUSHACC0
+     841 CLOSURE 1, 565
+     844 PUSHACC1
+     845 CLOSURE 1, 557
+     848 PUSH
+     849 CLOSURE 0, 545
+     852 PUSHACC 22
+     854 CLOSURE 1, 515
+     857 PUSH
+     858 CLOSURE 0, 505
+     861 PUSH
+     862 CLOSURE 0, 496
+     865 PUSH
+     866 CLOSURE 0, 485
+     869 PUSHACC0
+     870 CLOSURE 1, 477
+     873 PUSHACC1
+     874 CLOSURE 1, 470
+     877 PUSHACC 28
+     879 CLOSURE 1, 441
+     882 PUSH
+     883 CLOSUREREC 0, 32
+     887 ACC0
+     888 PUSHACC 31
+     890 CLOSURE 2, 411
+     893 PUSHACC 22
+     895 CLOSUREREC 1, 70
+     899 ACC 15
+     901 CLOSURE 1, 404
+     904 PUSHACC 11
+     906 PUSHACC 17
+     908 CLOSURE 2, 399
+     911 PUSHACC 12
+     913 PUSHACC 18
+     915 PUSHACC 23
+     917 CLOSURE 3, 392
+     920 PUSHACC 13
+     922 PUSHACC 19
+     924 PUSHACC 23
+     926 CLOSURE 3, 385
+     929 PUSHACC 14
+     931 PUSHACC 20
+     933 CLOSURE 2, 374
+     936 PUSHACC 20
+     938 CLOSURE 1, 364
+     941 PUSHACC 20
+     943 CLOSURE 1, 358
+     946 PUSHACC 17
+     948 PUSHACC 22
+     950 CLOSURE 2, 353
+     953 PUSHACC 18
+     955 PUSHACC 23
+     957 PUSHACC 29
+     959 CLOSURE 3, 346
+     962 PUSHACC 19
+     964 PUSHACC 24
+     966 PUSHACC 29
+     968 CLOSURE 3, 339
+     971 PUSHACC 20
+     973 PUSHACC 25
+     975 CLOSURE 2, 325
+     978 PUSHACC 25
+     980 CLOSURE 1, 315
+     983 PUSHACC 12
+     985 PUSHACC 28
+     987 PUSHACC 30
+     989 CLOSURE 3, 308
+     992 PUSHACC0
+     993 CLOSURE 1, 301
+     996 PUSHACC1
+     997 CLOSURE 1, 294
+    1000 PUSHACC 29
+    1002 PUSHACC 31
+    1004 CLOSURE 2, 286
+    1007 MAKEBLOCK1 0
+    1009 PUSHACC0
+    1010 CLOSURE 1, 275
+    1013 PUSHACC1
+    1014 CLOSURE 1, 263
+    1017 PUSHACC0
+    1018 CLOSURE 1, 255
+    1021 PUSHACC1
+    1022 PUSHACC 22
+    1024 PUSHACC4
+    1025 PUSHACC3
+    1026 PUSH
+    1027 CLOSURE 0, 247
+    1030 PUSH
+    1031 CLOSURE 0, 241
+    1034 PUSH
+    1035 CLOSURE 0, 236
+    1038 PUSH
+    1039 CLOSURE 0, 231
+    1042 PUSH
+    1043 CLOSURE 0, 223
+    1046 PUSH
+    1047 CLOSURE 0, 217
+    1050 PUSH
+    1051 CLOSURE 0, 212
+    1054 PUSH
+    1055 CLOSURE 0, 207
+    1058 PUSHACC 32
+    1060 PUSHACC 35
+    1062 PUSHACC 33
+    1064 PUSH
+    1065 CLOSURE 0, 202
+    1068 PUSHACC 41
+    1070 PUSHACC 40
+    1072 PUSHACC 42
+    1074 PUSH
+    1075 CLOSURE 0, 194
+    1078 PUSHACC 46
+    1080 PUSH
+    1081 CLOSURE 0, 188
+    1084 PUSH
+    1085 CLOSURE 0, 183
+    1088 PUSH
+    1089 CLOSURE 0, 175
+    1092 PUSHACC 51
+    1094 PUSH
+    1095 CLOSURE 0, 166
+    1098 PUSH
+    1099 CLOSURE 0, 157
+    1102 PUSHACC 55
+    1104 PUSHACC 57
+    1106 PUSH
+    1107 CLOSURE 0, 148
+    1110 PUSH
+    1111 CLOSURE 0, 142
+    1114 PUSHACC 63
+    1116 PUSHACC 62
+    1118 PUSHACC 64
+    1120 PUSHACC 38
+    1122 PUSHACC 40
+    1124 PUSHACC 42
+    1126 PUSHACC 44
+    1128 PUSHACC 46
+    1130 PUSHACC 48
+    1132 PUSHACC 50
+    1134 PUSHACC 52
+    1136 PUSHACC 54
+    1138 PUSHACC 56
+    1140 PUSHACC 58
+    1142 PUSHACC 60
+    1144 PUSHACC 62
+    1146 PUSHACC 64
+    1148 PUSHACC 66
+    1150 PUSHACC 82
+    1152 PUSHACC 84
+    1154 PUSHACC 86
+    1156 PUSHACC 88
+    1158 PUSHACC 90
+    1160 PUSHACC 92
+    1162 PUSHACC 94
+    1164 PUSHACC 96
+    1166 PUSHACC 98
+    1168 PUSHACC 100
+    1170 PUSHACC 104
+    1172 PUSHACC 104
+    1174 PUSHACC 104
+    1176 PUSHACC 108
+    1178 PUSHACC 110
+    1180 PUSHACC 112
+    1182 PUSHACC 117
+    1184 PUSHACC 117
+    1186 PUSHACC 117
+    1188 PUSHACC 117
+    1190 MAKEBLOCK 69, 0
+    1193 POP 53
+    1195 SETGLOBAL Pervasives
+    1197 BRANCH 2177
+    1199 RESTART
+    1200 GRAB 1
+    1202 ACC1
+    1203 BRANCHIFNOT 1213
+    1205 ACC1
+    1206 GETFIELD1
+    1207 PUSHACC1
+    1208 OFFSETINT 1
+    1210 PUSHOFFSETCLOSURE0
+    1211 APPTERM2 4
+    1213 ACC0
+    1214 RETURN 2
+    1216 RESTART
+    1217 GRAB 1
+    1219 ACC0
+    1220 BRANCHIFNOT 1251
+    1222 CONST0
+    1223 PUSHACC2
+    1224 EQ
+    1225 BRANCHIFNOT 1231
+    1227 ACC0
+    1228 GETFIELD0
+    1229 RETURN 2
+    1231 CONST0
+    1232 PUSHACC2
+    1233 GTINT
+    1234 BRANCHIFNOT 1244
+    1236 ACC1
+    1237 OFFSETINT -1
+    1239 PUSHACC1
+    1240 GETFIELD1
+    1241 PUSHOFFSETCLOSURE0
+    1242 APPTERM2 4
+    1244 GETGLOBAL "List.nth"
+    1246 PUSHGETGLOBALFIELD Pervasives, 2
+    1249 APPTERM1 3
+    1251 GETGLOBAL "nth"
+    1253 PUSHGETGLOBALFIELD Pervasives, 3
+    1256 APPTERM1 3
+    1258 RESTART
+    1259 GRAB 1
+    1261 ACC0
+    1262 BRANCHIFNOT 1274
+    1264 ACC1
+    1265 PUSHACC1
+    1266 GETFIELD0
+    1267 MAKEBLOCK2 0
+    1269 PUSHACC1
+    1270 GETFIELD1
+    1271 PUSHOFFSETCLOSURE0
+    1272 APPTERM2 4
+    1274 ACC1
+    1275 RETURN 2
+    1277 ACC0
+    1278 BRANCHIFNOT 1291
+    1280 ACC0
+    1281 GETFIELD1
+    1282 PUSHOFFSETCLOSURE0
+    1283 APPLY1
+    1284 PUSHACC1
+    1285 GETFIELD0
+    1286 PUSHGETGLOBALFIELD Pervasives, 16
+    1289 APPTERM2 3
+    1291 RETURN 1
+    1293 RESTART
+    1294 GRAB 1
+    1296 ACC1
+    1297 BRANCHIFNOT 1313
+    1299 ACC1
+    1300 GETFIELD0
+    1301 PUSHACC1
+    1302 APPLY1
+    1303 PUSHACC2
+    1304 GETFIELD1
+    1305 PUSHACC2
+    1306 PUSHOFFSETCLOSURE0
+    1307 APPLY2
+    1308 PUSHACC1
+    1309 MAKEBLOCK2 0
+    1311 POP 1
+    1313 RETURN 2
+    1315 RESTART
+    1316 GRAB 1
+    1318 ACC1
+    1319 BRANCHIFNOT 1331
+    1321 ACC1
+    1322 GETFIELD0
+    1323 PUSHACC1
+    1324 APPLY1
+    1325 ACC1
+    1326 GETFIELD1
+    1327 PUSHACC1
+    1328 PUSHOFFSETCLOSURE0
+    1329 APPTERM2 4
+    1331 RETURN 2
+    1333 RESTART
+    1334 GRAB 2
+    1336 ACC2
+    1337 BRANCHIFNOT 1350
+    1339 ACC2
+    1340 GETFIELD1
+    1341 PUSHACC3
+    1342 GETFIELD0
+    1343 PUSHACC3
+    1344 PUSHACC3
+    1345 APPLY2
+    1346 PUSHACC2
+    1347 PUSHOFFSETCLOSURE0
+    1348 APPTERM3 6
+    1350 ACC1
+    1351 RETURN 3
+    1353 RESTART
+    1354 GRAB 2
+    1356 ACC1
+    1357 BRANCHIFNOT 1370
+    1359 ACC2
+    1360 PUSHACC2
+    1361 GETFIELD1
+    1362 PUSHACC2
+    1363 PUSHOFFSETCLOSURE0
+    1364 APPLY3
+    1365 PUSHACC2
+    1366 GETFIELD0
+    1367 PUSHACC2
+    1368 APPTERM2 5
+    1370 ACC2
+    1371 RETURN 3
+    1373 RESTART
+    1374 GRAB 2
+    1376 ACC1
+    1377 BRANCHIFNOT 1400
+    1379 ACC2
+    1380 BRANCHIFNOT 1407
+    1382 ACC2
+    1383 GETFIELD0
+    1384 PUSHACC2
+    1385 GETFIELD0
+    1386 PUSHACC2
+    1387 APPLY2
+    1388 PUSHACC3
+    1389 GETFIELD1
+    1390 PUSHACC3
+    1391 GETFIELD1
+    1392 PUSHACC3
+    1393 PUSHOFFSETCLOSURE0
+    1394 APPLY3
+    1395 PUSHACC1
+    1396 MAKEBLOCK2 0
+    1398 RETURN 4
+    1400 ACC2
+    1401 BRANCHIFNOT 1405
+    1403 BRANCH 1407
+    1405 RETURN 3
+    1407 GETGLOBAL "List.map2"
+    1409 PUSHGETGLOBALFIELD Pervasives, 2
+    1412 APPTERM1 4
+    1414 RESTART
+    1415 GRAB 2
+    1417 ACC1
+    1418 BRANCHIFNOT 1437
+    1420 ACC2
+    1421 BRANCHIFNOT 1444
+    1423 ACC2
+    1424 GETFIELD0
+    1425 PUSHACC2
+    1426 GETFIELD0
+    1427 PUSHACC2
+    1428 APPLY2
+    1429 ACC2
+    1430 GETFIELD1
+    1431 PUSHACC2
+    1432 GETFIELD1
+    1433 PUSHACC2
+    1434 PUSHOFFSETCLOSURE0
+    1435 APPTERM3 6
+    1437 ACC2
+    1438 BRANCHIFNOT 1442
+    1440 BRANCH 1444
+    1442 RETURN 3
+    1444 GETGLOBAL "List.iter2"
+    1446 PUSHGETGLOBALFIELD Pervasives, 2
+    1449 APPTERM1 4
+    1451 RESTART
+    1452 GRAB 3
+    1454 ACC2
+    1455 BRANCHIFNOT 1476
+    1457 ACC3
+    1458 BRANCHIFNOT 1482
+    1460 ACC3
+    1461 GETFIELD1
+    1462 PUSHACC3
+    1463 GETFIELD1
+    1464 PUSHACC5
+    1465 GETFIELD0
+    1466 PUSHACC5
+    1467 GETFIELD0
+    1468 PUSHACC5
+    1469 PUSHACC5
+    1470 APPLY3
+    1471 PUSHACC3
+    1472 PUSHOFFSETCLOSURE0
+    1473 APPTERM 4, 8
+    1476 ACC3
+    1477 BRANCHIF 1482
+    1479 ACC1
+    1480 RETURN 4
+    1482 GETGLOBAL "List.fold_left2"
+    1484 PUSHGETGLOBALFIELD Pervasives, 2
+    1487 APPTERM1 5
+    1489 RESTART
+    1490 GRAB 3
+    1492 ACC1
+    1493 BRANCHIFNOT 1516
+    1495 ACC2
+    1496 BRANCHIFNOT 1522
+    1498 PUSH_RETADDR 1509
+    1500 ACC6
+    1501 PUSHACC6
+    1502 GETFIELD1
+    1503 PUSHACC6
+    1504 GETFIELD1
+    1505 PUSHACC6
+    1506 PUSHOFFSETCLOSURE0
+    1507 APPLY 4
+    1509 PUSHACC3
+    1510 GETFIELD0
+    1511 PUSHACC3
+    1512 GETFIELD0
+    1513 PUSHACC3
+    1514 APPTERM3 7
+    1516 ACC2
+    1517 BRANCHIF 1522
+    1519 ACC3
+    1520 RETURN 4
+    1522 GETGLOBAL "List.fold_right2"
+    1524 PUSHGETGLOBALFIELD Pervasives, 2
+    1527 APPTERM1 5
+    1529 RESTART
+    1530 GRAB 1
+    1532 ACC1
+    1533 BRANCHIFNOT 1549
+    1535 ACC1
+    1536 GETFIELD0
+    1537 PUSHACC1
+    1538 APPLY1
+    1539 BRANCHIFNOT 1547
+    1541 ACC1
+    1542 GETFIELD1
+    1543 PUSHACC1
+    1544 PUSHOFFSETCLOSURE0
+    1545 APPTERM2 4
+    1547 RETURN 2
+    1549 CONST1
+    1550 RETURN 2
+    1552 RESTART
+    1553 GRAB 1
+    1555 ACC1
+    1556 BRANCHIFNOT 1570
+    1558 ACC1
+    1559 GETFIELD0
+    1560 PUSHACC1
+    1561 APPLY1
+    1562 BRANCHIF 1570
+    1564 ACC1
+    1565 GETFIELD1
+    1566 PUSHACC1
+    1567 PUSHOFFSETCLOSURE0
+    1568 APPTERM2 4
+    1570 RETURN 2
+    1572 RESTART
+    1573 GRAB 2
+    1575 ACC1
+    1576 BRANCHIFNOT 1599
+    1578 ACC2
+    1579 BRANCHIFNOT 1605
+    1581 ACC2
+    1582 GETFIELD0
+    1583 PUSHACC2
+    1584 GETFIELD0
+    1585 PUSHACC2
+    1586 APPLY2
+    1587 BRANCHIFNOT 1597
+    1589 ACC2
+    1590 GETFIELD1
+    1591 PUSHACC2
+    1592 GETFIELD1
+    1593 PUSHACC2
+    1594 PUSHOFFSETCLOSURE0
+    1595 APPTERM3 6
+    1597 RETURN 3
+    1599 ACC2
+    1600 BRANCHIF 1605
+    1602 CONST1
+    1603 RETURN 3
+    1605 GETGLOBAL "List.for_all2"
+    1607 PUSHGETGLOBALFIELD Pervasives, 2
+    1610 APPTERM1 4
+    1612 RESTART
+    1613 GRAB 2
+    1615 ACC1
+    1616 BRANCHIFNOT 1639
+    1618 ACC2
+    1619 BRANCHIFNOT 1646
+    1621 ACC2
+    1622 GETFIELD0
+    1623 PUSHACC2
+    1624 GETFIELD0
+    1625 PUSHACC2
+    1626 APPLY2
+    1627 BRANCHIF 1637
+    1629 ACC2
+    1630 GETFIELD1
+    1631 PUSHACC2
+    1632 GETFIELD1
+    1633 PUSHACC2
+    1634 PUSHOFFSETCLOSURE0
+    1635 APPTERM3 6
+    1637 RETURN 3
+    1639 ACC2
+    1640 BRANCHIFNOT 1644
+    1642 BRANCH 1646
+    1644 RETURN 3
+    1646 GETGLOBAL "List.exists2"
+    1648 PUSHGETGLOBALFIELD Pervasives, 2
+    1651 APPTERM1 4
+    1653 RESTART
+    1654 GRAB 1
+    1656 ACC1
+    1657 BRANCHIFNOT 1672
+    1659 ACC0
+    1660 PUSHACC2
+    1661 GETFIELD0
+    1662 C_CALL2 equal
+    1664 BRANCHIF 1672
+    1666 ACC1
+    1667 GETFIELD1
+    1668 PUSHACC1
+    1669 PUSHOFFSETCLOSURE0
+    1670 APPTERM2 4
+    1672 RETURN 2
+    1674 RESTART
+    1675 GRAB 1
+    1677 ACC1
+    1678 BRANCHIFNOT 1692
+    1680 ACC0
+    1681 PUSHACC2
+    1682 GETFIELD0
+    1683 EQ
+    1684 BRANCHIF 1692
+    1686 ACC1
+    1687 GETFIELD1
+    1688 PUSHACC1
+    1689 PUSHOFFSETCLOSURE0
+    1690 APPTERM2 4
+    1692 RETURN 2
+    1694 RESTART
+    1695 GRAB 1
+    1697 ACC1
+    1698 BRANCHIFNOT 1719
+    1700 ACC1
+    1701 GETFIELD0
+    1702 PUSHACC1
+    1703 PUSHACC1
+    1704 GETFIELD0
+    1705 C_CALL2 equal
+    1707 BRANCHIFNOT 1713
+    1709 ACC0
+    1710 GETFIELD1
+    1711 RETURN 3
+    1713 ACC2
+    1714 GETFIELD1
+    1715 PUSHACC2
+    1716 PUSHOFFSETCLOSURE0
+    1717 APPTERM2 5
+    1719 GETGLOBAL Not_found
+    1721 MAKEBLOCK1 0
+    1723 RAISE
+    1724 RESTART
+    1725 GRAB 1
+    1727 ACC1
+    1728 BRANCHIFNOT 1748
+    1730 ACC1
+    1731 GETFIELD0
+    1732 PUSHACC1
+    1733 PUSHACC1
+    1734 GETFIELD0
+    1735 EQ
+    1736 BRANCHIFNOT 1742
+    1738 ACC0
+    1739 GETFIELD1
+    1740 RETURN 3
+    1742 ACC2
+    1743 GETFIELD1
+    1744 PUSHACC2
+    1745 PUSHOFFSETCLOSURE0
+    1746 APPTERM2 5
+    1748 GETGLOBAL Not_found
+    1750 MAKEBLOCK1 0
+    1752 RAISE
+    1753 RESTART
+    1754 GRAB 1
+    1756 ACC1
+    1757 BRANCHIFNOT 1773
+    1759 ACC0
+    1760 PUSHACC2
+    1761 GETFIELD0
+    1762 GETFIELD0
+    1763 C_CALL2 equal
+    1765 BRANCHIF 1773
+    1767 ACC1
+    1768 GETFIELD1
+    1769 PUSHACC1
+    1770 PUSHOFFSETCLOSURE0
+    1771 APPTERM2 4
+    1773 RETURN 2
+    1775 RESTART
+    1776 GRAB 1
+    1778 ACC1
+    1779 BRANCHIFNOT 1794
+    1781 ACC0
+    1782 PUSHACC2
+    1783 GETFIELD0
+    1784 GETFIELD0
+    1785 EQ
+    1786 BRANCHIF 1794
+    1788 ACC1
+    1789 GETFIELD1
+    1790 PUSHACC1
+    1791 PUSHOFFSETCLOSURE0
+    1792 APPTERM2 4
+    1794 RETURN 2
+    1796 RESTART
+    1797 GRAB 1
+    1799 ACC1
+    1800 BRANCHIFNOT 1825
+    1802 ACC1
+    1803 GETFIELD0
+    1804 PUSHACC2
+    1805 GETFIELD1
+    1806 PUSHACC2
+    1807 PUSHACC2
+    1808 GETFIELD0
+    1809 C_CALL2 equal
+    1811 BRANCHIFNOT 1816
+    1813 ACC0
+    1814 RETURN 4
+    1816 ACC0
+    1817 PUSHACC3
+    1818 PUSHOFFSETCLOSURE0
+    1819 APPLY2
+    1820 PUSHACC2
+    1821 MAKEBLOCK2 0
+    1823 POP 2
+    1825 RETURN 2
+    1827 RESTART
+    1828 GRAB 1
+    1830 ACC1
+    1831 BRANCHIFNOT 1855
+    1833 ACC1
+    1834 GETFIELD0
+    1835 PUSHACC2
+    1836 GETFIELD1
+    1837 PUSHACC2
+    1838 PUSHACC2
+    1839 GETFIELD0
+    1840 EQ
+    1841 BRANCHIFNOT 1846
+    1843 ACC0
+    1844 RETURN 4
+    1846 ACC0
+    1847 PUSHACC3
+    1848 PUSHOFFSETCLOSURE0
+    1849 APPLY2
+    1850 PUSHACC2
+    1851 MAKEBLOCK2 0
+    1853 POP 2
+    1855 RETURN 2
+    1857 RESTART
+    1858 GRAB 1
+    1860 ACC1
+    1861 BRANCHIFNOT 1879
+    1863 ACC1
+    1864 GETFIELD0
+    1865 PUSHACC0
+    1866 PUSHACC2
+    1867 APPLY1
+    1868 BRANCHIFNOT 1873
+    1870 ACC0
+    1871 RETURN 3
+    1873 ACC2
+    1874 GETFIELD1
+    1875 PUSHACC2
+    1876 PUSHOFFSETCLOSURE0
+    1877 APPTERM2 5
+    1879 GETGLOBAL Not_found
+    1881 MAKEBLOCK1 0
+    1883 RAISE
+    1884 RESTART
+    1885 GRAB 2
+    1887 ACC2
+    1888 BRANCHIFNOT 1917
+    1890 ACC2
+    1891 GETFIELD0
+    1892 PUSHACC3
+    1893 GETFIELD1
+    1894 PUSHACC1
+    1895 PUSHENVACC2
+    1896 APPLY1
+    1897 BRANCHIFNOT 1908
+    1899 ACC0
+    1900 PUSHACC4
+    1901 PUSHACC4
+    1902 PUSHACC4
+    1903 MAKEBLOCK2 0
+    1905 PUSHOFFSETCLOSURE0
+    1906 APPTERM3 8
+    1908 ACC0
+    1909 PUSHACC4
+    1910 PUSHACC3
+    1911 MAKEBLOCK2 0
+    1913 PUSHACC4
+    1914 PUSHOFFSETCLOSURE0
+    1915 APPTERM3 8
+    1917 ACC1
+    1918 PUSHENVACC1
+    1919 APPLY1
+    1920 PUSHACC1
+    1921 PUSHENVACC1
+    1922 APPLY1
+    1923 MAKEBLOCK2 0
+    1925 RETURN 3
+    1927 RESTART
+    1928 GRAB 1
+    1930 ACC0
+    1931 PUSHENVACC1
+    1932 CLOSUREREC 2, 1885
+    1936 ACC2
+    1937 PUSHCONST0
+    1938 PUSHCONST0
+    1939 PUSHACC3
+    1940 APPTERM3 6
+    1942 ACC0
+    1943 BRANCHIFNOT 1967
+    1945 ACC0
+    1946 GETFIELD0
+    1947 PUSHACC1
+    1948 GETFIELD1
+    1949 PUSHOFFSETCLOSURE0
+    1950 APPLY1
+    1951 PUSHACC0
+    1952 GETFIELD1
+    1953 PUSHACC2
+    1954 GETFIELD1
+    1955 MAKEBLOCK2 0
+    1957 PUSHACC1
+    1958 GETFIELD0
+    1959 PUSHACC3
+    1960 GETFIELD0
+    1961 MAKEBLOCK2 0
+    1963 MAKEBLOCK2 0
+    1965 RETURN 3
+    1967 GETGLOBAL <0>(0, 0)
+    1969 RETURN 1
+    1971 RESTART
+    1972 GRAB 1
+    1974 ACC0
+    1975 BRANCHIFNOT 1996
+    1977 ACC1
+    1978 BRANCHIFNOT 2003
+    1980 ACC1
+    1981 GETFIELD1
+    1982 PUSHACC1
+    1983 GETFIELD1
+    1984 PUSHOFFSETCLOSURE0
+    1985 APPLY2
+    1986 PUSHACC2
+    1987 GETFIELD0
+    1988 PUSHACC2
+    1989 GETFIELD0
+    1990 MAKEBLOCK2 0
+    1992 MAKEBLOCK2 0
+    1994 RETURN 2
+    1996 ACC1
+    1997 BRANCHIFNOT 2001
+    1999 BRANCH 2003
+    2001 RETURN 2
+    2003 GETGLOBAL "List.combine"
+    2005 PUSHGETGLOBALFIELD Pervasives, 2
+    2008 APPTERM1 3
+    2010 RESTART
+    2011 GRAB 1
+    2013 ACC1
+    2014 BRANCHIFNOT 2038
+    2016 ACC1
+    2017 GETFIELD0
+    2018 PUSHACC2
+    2019 GETFIELD1
+    2020 PUSHACC1
+    2021 PUSHENVACC2
+    2022 APPLY1
+    2023 BRANCHIFNOT 2033
+    2025 ACC0
+    2026 PUSHACC3
+    2027 PUSHACC3
+    2028 MAKEBLOCK2 0
+    2030 PUSHOFFSETCLOSURE0
+    2031 APPTERM2 6
+    2033 ACC0
+    2034 PUSHACC3
+    2035 PUSHOFFSETCLOSURE0
+    2036 APPTERM2 6
+    2038 ACC0
+    2039 PUSHENVACC1
+    2040 APPTERM1 3
+    2042 ACC0
+    2043 PUSHENVACC1
+    2044 CLOSUREREC 2, 2011
+    2048 CONST0
+    2049 PUSHACC1
+    2050 APPTERM1 3
+    2052 RESTART
+    2053 GRAB 2
+    2055 ACC1
+    2056 BRANCHIFNOT 2077
+    2058 ACC2
+    2059 BRANCHIFNOT 2084
+    2061 ACC2
+    2062 GETFIELD1
+    2063 PUSHACC2
+    2064 GETFIELD1
+    2065 PUSHACC2
+    2066 PUSHACC5
+    2067 GETFIELD0
+    2068 PUSHACC5
+    2069 GETFIELD0
+    2070 PUSHENVACC1
+    2071 APPLY2
+    2072 MAKEBLOCK2 0
+    2074 PUSHOFFSETCLOSURE0
+    2075 APPTERM3 6
+    2077 ACC2
+    2078 BRANCHIFNOT 2082
+    2080 BRANCH 2084
+    2082 RETURN 3
+    2084 GETGLOBAL "List.rev_map2"
+    2086 PUSHGETGLOBALFIELD Pervasives, 2
+    2089 APPTERM1 4
+    2091 RESTART
+    2092 GRAB 2
+    2094 ACC0
+    2095 CLOSUREREC 1, 2053
+    2099 ACC3
+    2100 PUSHACC3
+    2101 PUSHCONST0
+    2102 PUSHACC3
+    2103 APPTERM3 7
+    2105 RESTART
+    2106 GRAB 1
+    2108 ACC1
+    2109 BRANCHIFNOT 2123
+    2111 ACC1
+    2112 GETFIELD1
+    2113 PUSHACC1
+    2114 PUSHACC3
+    2115 GETFIELD0
+    2116 PUSHENVACC1
+    2117 APPLY1
+    2118 MAKEBLOCK2 0
+    2120 PUSHOFFSETCLOSURE0
+    2121 APPTERM2 4
+    2123 ACC0
+    2124 RETURN 2
+    2126 RESTART
+    2127 GRAB 1
+    2129 ACC0
+    2130 CLOSUREREC 1, 2106
+    2134 ACC2
+    2135 PUSHCONST0
+    2136 PUSHACC2
+    2137 APPTERM2 5
+    2139 CONST0
+    2140 PUSHACC1
+    2141 PUSHENVACC1
+    2142 APPTERM2 3
+    2144 ACC0
+    2145 BRANCHIFNOT 2151
+    2147 ACC0
+    2148 GETFIELD1
+    2149 RETURN 1
+    2151 GETGLOBAL "tl"
+    2153 PUSHGETGLOBALFIELD Pervasives, 3
+    2156 APPTERM1 2
+    2158 ACC0
+    2159 BRANCHIFNOT 2165
+    2161 ACC0
+    2162 GETFIELD0
+    2163 RETURN 1
+    2165 GETGLOBAL "hd"
+    2167 PUSHGETGLOBALFIELD Pervasives, 3
+    2170 APPTERM1 2
+    2172 ACC0
+    2173 PUSHCONST0
+    2174 PUSHENVACC1
+    2175 APPTERM2 3
+    2177 CLOSUREREC 0, 1200
+    2181 ACC0
+    2182 CLOSURE 1, 2172
+    2185 PUSH
+    2186 CLOSURE 0, 2158
+    2189 PUSH
+    2190 CLOSURE 0, 2144
+    2193 PUSH
+    2194 CLOSUREREC 0, 1217
+    2198 GETGLOBALFIELD Pervasives, 16
+    2201 PUSH
+    2202 CLOSUREREC 0, 1259
+    2206 ACC0
+    2207 CLOSURE 1, 2139
+    2210 PUSH
+    2211 CLOSUREREC 0, 1277
+    2215 CLOSUREREC 0, 1294
+    2219 CLOSURE 0, 2127
+    2222 PUSH
+    2223 CLOSUREREC 0, 1316
+    2227 CLOSUREREC 0, 1334
+    2231 CLOSUREREC 0, 1354
+    2235 CLOSUREREC 0, 1374
+    2239 CLOSURE 0, 2092
+    2242 PUSH
+    2243 CLOSUREREC 0, 1415
+    2247 CLOSUREREC 0, 1452
+    2251 CLOSUREREC 0, 1490
+    2255 CLOSUREREC 0, 1530
+    2259 CLOSUREREC 0, 1553
+    2263 CLOSUREREC 0, 1573
+    2267 CLOSUREREC 0, 1613
+    2271 CLOSUREREC 0, 1654
+    2275 CLOSUREREC 0, 1675
+    2279 CLOSUREREC 0, 1695
+    2283 CLOSUREREC 0, 1725
+    2287 CLOSUREREC 0, 1754
+    2291 CLOSUREREC 0, 1776
+    2295 CLOSUREREC 0, 1797
+    2299 CLOSUREREC 0, 1828
+    2303 CLOSUREREC 0, 1858
+    2307 ACC 24
+    2309 CLOSURE 1, 2042
+    2312 PUSHACC 25
+    2314 CLOSUREREC 1, 1928
+    2318 CLOSUREREC 0, 1942
+    2322 CLOSUREREC 0, 1972
+    2326 ACC0
+    2327 PUSHACC2
+    2328 PUSHACC7
+    2329 PUSHACC 9
+    2331 PUSHACC 11
+    2333 PUSHACC 13
+    2335 PUSHACC 15
+    2337 PUSHACC 17
+    2339 PUSHACC 10
+    2341 PUSHACC 12
+    2343 PUSHACC 13
+    2345 PUSHACC 15
+    2347 PUSHACC 23
+    2349 PUSHACC 25
+    2351 PUSHACC 27
+    2353 PUSHACC 29
+    2355 PUSHACC 31
+    2357 PUSHACC 33
+    2359 PUSHACC 35
+    2361 PUSHACC 37
+    2363 PUSHACC 40
+    2365 PUSHACC 42
+    2367 PUSHACC 41
+    2369 PUSHACC 45
+    2371 PUSHACC 47
+    2373 PUSHACC 50
+    2375 PUSHACC 52
+    2377 PUSHACC 51
+    2379 PUSHACC 55
+    2381 PUSHACC 56
+    2383 PUSHACC 59
+    2385 PUSHACC 61
+    2387 PUSHACC 60
+    2389 PUSHACC 64
+    2391 PUSHACC 66
+    2393 PUSHACC 68
+    2395 PUSHACC 70
+    2397 MAKEBLOCK 37, 0
+    2400 POP 36
+    2402 SETGLOBAL List
+    2404 BRANCH 3341
+    2406 RESTART
+    2407 GRAB 2
+    2409 ACC2
+    2410 PUSHACC2
+    2411 VECTLENGTH
+    2412 OFFSETINT -1
+    2414 PUSHCONST0
+    2415 PUSH
+    2416 BRANCH 2433
+    2418 CHECK_SIGNALS
+    2419 ACC2
+    2420 PUSHACC2
+    2421 PUSHACC6
+    2422 C_CALL2 array_unsafe_get
+    2424 PUSHACC5
+    2425 APPLY2
+    2426 ASSIGN 2
+    2428 ACC1
+    2429 OFFSETINT -1
+    2431 ASSIGN 1
+    2433 ACC0
+    2434 PUSHACC2
+    2435 GEINT
+    2436 BRANCHIF 2418
+    2438 CONST0
+    2439 POP 2
+    2441 ACC0
+    2442 RETURN 4
+    2444 RESTART
+    2445 GRAB 2
+    2447 ACC1
+    2448 PUSHCONST0
+    2449 PUSHACC4
+    2450 VECTLENGTH
+    2451 OFFSETINT -1
+    2453 PUSH
+    2454 BRANCH 2471
+    2456 CHECK_SIGNALS
+    2457 ACC1
+    2458 PUSHACC6
+    2459 C_CALL2 array_unsafe_get
+    2461 PUSHACC3
+    2462 PUSHACC5
+    2463 APPLY2
+    2464 ASSIGN 2
+    2466 ACC1
+    2467 OFFSETINT 1
+    2469 ASSIGN 1
+    2471 ACC0
+    2472 PUSHACC2
+    2473 LEINT
+    2474 BRANCHIF 2456
+    2476 CONST0
+    2477 POP 2
+    2479 ACC0
+    2480 RETURN 4
+    2482 RESTART
+    2483 GRAB 1
+    2485 ACC1
+    2486 BRANCHIFNOT 2502
+    2488 ACC1
+    2489 GETFIELD0
+    2490 PUSHACC1
+    2491 PUSHENVACC1
+    2492 C_CALL3 array_unsafe_set
+    2494 ACC1
+    2495 GETFIELD1
+    2496 PUSHACC1
+    2497 OFFSETINT 1
+    2499 PUSHOFFSETCLOSURE0
+    2500 APPTERM2 4
+    2502 ENVACC1
+    2503 RETURN 2
+    2505 ACC0
+    2506 BRANCHIFNOT 2531
+    2508 ACC0
+    2509 GETFIELD1
+    2510 PUSHACC1
+    2511 GETFIELD0
+    2512 PUSHACC1
+    2513 PUSHGETGLOBALFIELD List, 0
+    2516 APPLY1
+    2517 OFFSETINT 1
+    2519 C_CALL2 make_vect
+    2521 PUSHACC0
+    2522 CLOSUREREC 1, 2483
+    2526 ACC2
+    2527 PUSHCONST1
+    2528 PUSHACC2
+    2529 APPTERM2 6
+    2531 ATOM0
+    2532 RETURN 1
+    2534 RESTART
+    2535 GRAB 1
+    2537 CONST0
+    2538 PUSHACC1
+    2539 LTINT
+    2540 BRANCHIFNOT 2545
+    2542 ACC1
+    2543 RETURN 2
+    2545 ACC1
+    2546 PUSHACC1
+    2547 PUSHENVACC1
+    2548 C_CALL2 array_unsafe_get
+    2550 MAKEBLOCK2 0
+    2552 PUSHACC1
+    2553 OFFSETINT -1
+    2555 PUSHOFFSETCLOSURE0
+    2556 APPTERM2 4
+    2558 ACC0
+    2559 CLOSUREREC 1, 2535
+    2563 CONST0
+    2564 PUSHACC2
+    2565 VECTLENGTH
+    2566 OFFSETINT -1
+    2568 PUSHACC2
+    2569 APPTERM2 4
+    2571 RESTART
+    2572 GRAB 1
+    2574 ACC1
+    2575 VECTLENGTH
+    2576 PUSHCONST0
+    2577 PUSHACC1
+    2578 EQ
+    2579 BRANCHIFNOT 2584
+    2581 ATOM0
+    2582 RETURN 3
+    2584 CONST0
+    2585 PUSHACC3
+    2586 C_CALL2 array_unsafe_get
+    2588 PUSHCONST0
+    2589 PUSHACC3
+    2590 APPLY2
+    2591 PUSHACC1
+    2592 C_CALL2 make_vect
+    2594 PUSHCONST1
+    2595 PUSHACC2
+    2596 OFFSETINT -1
+    2598 PUSH
+    2599 BRANCH 2618
+    2601 CHECK_SIGNALS
+    2602 ACC1
+    2603 PUSHACC6
+    2604 C_CALL2 array_unsafe_get
+    2606 PUSHACC2
+    2607 PUSHACC6
+    2608 APPLY2
+    2609 PUSHACC2
+    2610 PUSHACC4
+    2611 C_CALL3 array_unsafe_set
+    2613 ACC1
+    2614 OFFSETINT 1
+    2616 ASSIGN 1
+    2618 ACC0
+    2619 PUSHACC2
+    2620 LEINT
+    2621 BRANCHIF 2601
+    2623 CONST0
+    2624 POP 2
+    2626 ACC0
+    2627 RETURN 4
+    2629 RESTART
+    2630 GRAB 1
+    2632 CONST0
+    2633 PUSHACC2
+    2634 VECTLENGTH
+    2635 OFFSETINT -1
+    2637 PUSH
+    2638 BRANCH 2653
+    2640 CHECK_SIGNALS
+    2641 ACC1
+    2642 PUSHACC4
+    2643 C_CALL2 array_unsafe_get
+    2645 PUSHACC2
+    2646 PUSHACC4
+    2647 APPLY2
+    2648 ACC1
+    2649 OFFSETINT 1
+    2651 ASSIGN 1
+    2653 ACC0
+    2654 PUSHACC2
+    2655 LEINT
+    2656 BRANCHIF 2640
+    2658 CONST0
+    2659 RETURN 4
+    2661 RESTART
+    2662 GRAB 1
+    2664 ACC1
+    2665 VECTLENGTH
+    2666 PUSHCONST0
+    2667 PUSHACC1
+    2668 EQ
+    2669 BRANCHIFNOT 2674
+    2671 ATOM0
+    2672 RETURN 3
+    2674 CONST0
+    2675 PUSHACC3
+    2676 C_CALL2 array_unsafe_get
+    2678 PUSHACC2
+    2679 APPLY1
+    2680 PUSHACC1
+    2681 C_CALL2 make_vect
+    2683 PUSHCONST1
+    2684 PUSHACC2
+    2685 OFFSETINT -1
+    2687 PUSH
+    2688 BRANCH 2706
+    2690 CHECK_SIGNALS
+    2691 ACC1
+    2692 PUSHACC6
+    2693 C_CALL2 array_unsafe_get
+    2695 PUSHACC5
+    2696 APPLY1
+    2697 PUSHACC2
+    2698 PUSHACC4
+    2699 C_CALL3 array_unsafe_set
+    2701 ACC1
+    2702 OFFSETINT 1
+    2704 ASSIGN 1
+    2706 ACC0
+    2707 PUSHACC2
+    2708 LEINT
+    2709 BRANCHIF 2690
+    2711 CONST0
+    2712 POP 2
+    2714 ACC0
+    2715 RETURN 4
+    2717 RESTART
+    2718 GRAB 1
+    2720 CONST0
+    2721 PUSHACC2
+    2722 VECTLENGTH
+    2723 OFFSETINT -1
+    2725 PUSH
+    2726 BRANCH 2740
+    2728 CHECK_SIGNALS
+    2729 ACC1
+    2730 PUSHACC4
+    2731 C_CALL2 array_unsafe_get
+    2733 PUSHACC3
+    2734 APPLY1
+    2735 ACC1
+    2736 OFFSETINT 1
+    2738 ASSIGN 1
+    2740 ACC0
+    2741 PUSHACC2
+    2742 LEINT
+    2743 BRANCHIF 2728
+    2745 CONST0
+    2746 RETURN 4
+    2748 RESTART
+    2749 GRAB 4
+    2751 CONST0
+    2752 PUSHACC5
+    2753 LTINT
+    2754 BRANCHIF 2782
+    2756 CONST0
+    2757 PUSHACC2
+    2758 LTINT
+    2759 BRANCHIF 2782
+    2761 ACC0
+    2762 VECTLENGTH
+    2763 PUSHACC5
+    2764 PUSHACC3
+    2765 ADDINT
+    2766 GTINT
+    2767 BRANCHIF 2782
+    2769 CONST0
+    2770 PUSHACC4
+    2771 LTINT
+    2772 BRANCHIF 2782
+    2774 ACC2
+    2775 VECTLENGTH
+    2776 PUSHACC5
+    2777 PUSHACC5
+    2778 ADDINT
+    2779 GTINT
+    2780 BRANCHIFNOT 2789
+    2782 GETGLOBAL "Array.blit"
+    2784 PUSHGETGLOBALFIELD Pervasives, 2
+    2787 APPTERM1 6
+    2789 ACC3
+    2790 PUSHACC2
+    2791 LTINT
+    2792 BRANCHIFNOT 2827
+    2794 ACC4
+    2795 OFFSETINT -1
+    2797 PUSHCONST0
+    2798 PUSH
+    2799 BRANCH 2819
+    2801 CHECK_SIGNALS
+    2802 ACC1
+    2803 PUSHACC4
+    2804 ADDINT
+    2805 PUSHACC3
+    2806 C_CALL2 array_unsafe_get
+    2808 PUSHACC2
+    2809 PUSHACC7
+    2810 ADDINT
+    2811 PUSHACC6
+    2812 C_CALL3 array_unsafe_set
+    2814 ACC1
+    2815 OFFSETINT -1
+    2817 ASSIGN 1
+    2819 ACC0
+    2820 PUSHACC2
+    2821 GEINT
+    2822 BRANCHIF 2801
+    2824 CONST0
+    2825 RETURN 7
+    2827 CONST0
+    2828 PUSHACC5
+    2829 OFFSETINT -1
+    2831 PUSH
+    2832 BRANCH 2852
+    2834 CHECK_SIGNALS
+    2835 ACC1
+    2836 PUSHACC4
+    2837 ADDINT
+    2838 PUSHACC3
+    2839 C_CALL2 array_unsafe_get
+    2841 PUSHACC2
+    2842 PUSHACC7
+    2843 ADDINT
+    2844 PUSHACC6
+    2845 C_CALL3 array_unsafe_set
+    2847 ACC1
+    2848 OFFSETINT 1
+    2850 ASSIGN 1
+    2852 ACC0
+    2853 PUSHACC2
+    2854 LEINT
+    2855 BRANCHIF 2834
+    2857 CONST0
+    2858 RETURN 7
+    2860 RESTART
+    2861 GRAB 3
+    2863 CONST0
+    2864 PUSHACC2
+    2865 LTINT
+    2866 BRANCHIF 2881
+    2868 CONST0
+    2869 PUSHACC3
+    2870 LTINT
+    2871 BRANCHIF 2881
+    2873 ACC0
+    2874 VECTLENGTH
+    2875 PUSHACC3
+    2876 PUSHACC3
+    2877 ADDINT
+    2878 GTINT
+    2879 BRANCHIFNOT 2888
+    2881 GETGLOBAL "Array.fill"
+    2883 PUSHGETGLOBALFIELD Pervasives, 2
+    2886 APPTERM1 5
+    2888 ACC1
+    2889 PUSHACC3
+    2890 PUSHACC3
+    2891 ADDINT
+    2892 OFFSETINT -1
+    2894 PUSH
+    2895 BRANCH 2908
+    2897 CHECK_SIGNALS
+    2898 ACC5
+    2899 PUSHACC2
+    2900 PUSHACC4
+    2901 C_CALL3 array_unsafe_set
+    2903 ACC1
+    2904 OFFSETINT 1
+    2906 ASSIGN 1
+    2908 ACC0
+    2909 PUSHACC2
+    2910 LEINT
+    2911 BRANCHIF 2897
+    2913 CONST0
+    2914 RETURN 6
+    2916 RESTART
+    2917 GRAB 2
+    2919 CONST0
+    2920 PUSHACC2
+    2921 LTINT
+    2922 BRANCHIF 2937
+    2924 CONST0
+    2925 PUSHACC3
+    2926 LTINT
+    2927 BRANCHIF 2937
+    2929 ACC0
+    2930 VECTLENGTH
+    2931 PUSHACC3
+    2932 PUSHACC3
+    2933 ADDINT
+    2934 GTINT
+    2935 BRANCHIFNOT 2944
+    2937 GETGLOBAL "Array.sub"
+    2939 PUSHGETGLOBALFIELD Pervasives, 2
+    2942 APPTERM1 4
+    2944 CONST0
+    2945 PUSHACC3
+    2946 EQ
+    2947 BRANCHIFNOT 2952
+    2949 ATOM0
+    2950 RETURN 3
+    2952 ACC1
+    2953 PUSHACC1
+    2954 C_CALL2 array_unsafe_get
+    2956 PUSHACC3
+    2957 C_CALL2 make_vect
+    2959 PUSHCONST1
+    2960 PUSHACC4
+    2961 OFFSETINT -1
+    2963 PUSH
+    2964 BRANCH 2982
+    2966 CHECK_SIGNALS
+    2967 ACC1
+    2968 PUSHACC5
+    2969 ADDINT
+    2970 PUSHACC4
+    2971 C_CALL2 array_unsafe_get
+    2973 PUSHACC2
+    2974 PUSHACC4
+    2975 C_CALL3 array_unsafe_set
+    2977 ACC1
+    2978 OFFSETINT 1
+    2980 ASSIGN 1
+    2982 ACC0
+    2983 PUSHACC2
+    2984 LEINT
+    2985 BRANCHIF 2966
+    2987 CONST0
+    2988 POP 2
+    2990 ACC0
+    2991 RETURN 4
+    2993 ACC0
+    2994 BRANCHIFNOT 3017
+    2996 ACC0
+    2997 GETFIELD0
+    2998 PUSHCONST0
+    2999 PUSHACC1
+    3000 VECTLENGTH
+    3001 GTINT
+    3002 BRANCHIFNOT 3012
+    3004 ENVACC2
+    3005 PUSHCONST0
+    3006 PUSHACC2
+    3007 C_CALL2 array_unsafe_get
+    3009 PUSHENVACC1
+    3010 APPTERM2 4
+    3012 ACC1
+    3013 GETFIELD1
+    3014 PUSHOFFSETCLOSURE0
+    3015 APPTERM1 3
+    3017 ATOM0
+    3018 RETURN 1
+    3020 ACC0
+    3021 PUSHENVACC1
+    3022 CLOSUREREC 2, 2993
+    3026 ACC1
+    3027 PUSHACC1
+    3028 APPTERM1 3
+    3030 CONST0
+    3031 PUSHACC1
+    3032 VECTLENGTH
+    3033 OFFSETINT -1
+    3035 PUSH
+    3036 BRANCH 3056
+    3038 CHECK_SIGNALS
+    3039 ACC1
+    3040 PUSHACC3
+    3041 C_CALL2 array_unsafe_get
+    3043 PUSHENVACC2
+    3044 GETFIELD0
+    3045 PUSHENVACC1
+    3046 C_CALL3 array_unsafe_set
+    3048 ENVACC2
+    3049 OFFSETREF 1
+    3051 ACC1
+    3052 OFFSETINT 1
+    3054 ASSIGN 1
+    3056 ACC0
+    3057 PUSHACC2
+    3058 LEINT
+    3059 BRANCHIF 3038
+    3061 CONST0
+    3062 RETURN 3
+    3064 RESTART
+    3065 GRAB 1
+    3067 ACC1
+    3068 VECTLENGTH
+    3069 PUSHACC1
+    3070 ADDINT
+    3071 RETURN 2
+    3073 RESTART
+    3074 GRAB 1
+    3076 ACC1
+    3077 PUSHCONST0
+    3078 PUSH
+    3079 CLOSURE 0, 3065
+    3082 PUSHGETGLOBALFIELD List, 12
+    3085 APPLY3
+    3086 PUSHACC1
+    3087 PUSHACC1
+    3088 C_CALL2 make_vect
+    3090 PUSHCONST0
+    3091 MAKEBLOCK1 0
+    3093 PUSHACC4
+    3094 PUSHACC1
+    3095 PUSHACC3
+    3096 CLOSURE 2, 3030
+    3099 PUSHGETGLOBALFIELD List, 9
+    3102 APPLY2
+    3103 ACC1
+    3104 RETURN 5
+    3106 RESTART
+    3107 GRAB 1
+    3109 ACC0
+    3110 VECTLENGTH
+    3111 PUSHACC2
+    3112 VECTLENGTH
+    3113 PUSHCONST0
+    3114 PUSHACC2
+    3115 EQ
+    3116 BRANCHIFNOT 3126
+    3118 CONST0
+    3119 PUSHACC1
+    3120 EQ
+    3121 BRANCHIFNOT 3126
+    3123 ATOM0
+    3124 RETURN 4
+    3126 CONST0
+    3127 PUSHCONST0
+    3128 PUSHACC3
+    3129 GTINT
+    3130 BRANCHIFNOT 3135
+    3132 ACC3
+    3133 BRANCH 3136
+    3135 ACC4
+    3136 C_CALL2 array_unsafe_get
+    3138 PUSHACC1
+    3139 PUSHACC3
+    3140 ADDINT
+    3141 C_CALL2 make_vect
+    3143 PUSHCONST0
+    3144 PUSHACC3
+    3145 OFFSETINT -1
+    3147 PUSH
+    3148 BRANCH 3164
+    3150 CHECK_SIGNALS
+    3151 ACC1
+    3152 PUSHACC6
+    3153 C_CALL2 array_unsafe_get
+    3155 PUSHACC2
+    3156 PUSHACC4
+    3157 C_CALL3 array_unsafe_set
+    3159 ACC1
+    3160 OFFSETINT 1
+    3162 ASSIGN 1
+    3164 ACC0
+    3165 PUSHACC2
+    3166 LEINT
+    3167 BRANCHIF 3150
+    3169 CONST0
+    3170 POP 2
+    3172 CONST0
+    3173 PUSHACC2
+    3174 OFFSETINT -1
+    3176 PUSH
+    3177 BRANCH 3195
+    3179 CHECK_SIGNALS
+    3180 ACC1
+    3181 PUSHACC7
+    3182 C_CALL2 array_unsafe_get
+    3184 PUSHACC5
+    3185 PUSHACC3
+    3186 ADDINT
+    3187 PUSHACC4
+    3188 C_CALL3 array_unsafe_set
+    3190 ACC1
+    3191 OFFSETINT 1
+    3193 ASSIGN 1
+    3195 ACC0
+    3196 PUSHACC2
+    3197 LEINT
+    3198 BRANCHIF 3179
+    3200 CONST0
+    3201 POP 2
+    3203 ACC0
+    3204 RETURN 5
+    3206 ACC0
+    3207 VECTLENGTH
+    3208 PUSHCONST0
+    3209 PUSHACC1
+    3210 EQ
+    3211 BRANCHIFNOT 3216
+    3213 ATOM0
+    3214 RETURN 2
+    3216 CONST0
+    3217 PUSHACC2
+    3218 C_CALL2 array_unsafe_get
+    3220 PUSHACC1
+    3221 C_CALL2 make_vect
+    3223 PUSHCONST1
+    3224 PUSHACC2
+    3225 OFFSETINT -1
+    3227 PUSH
+    3228 BRANCH 3244
+    3230 CHECK_SIGNALS
+    3231 ACC1
+    3232 PUSHACC5
+    3233 C_CALL2 array_unsafe_get
+    3235 PUSHACC2
+    3236 PUSHACC4
+    3237 C_CALL3 array_unsafe_set
+    3239 ACC1
+    3240 OFFSETINT 1
+    3242 ASSIGN 1
+    3244 ACC0
+    3245 PUSHACC2
+    3246 LEINT
+    3247 BRANCHIF 3230
+    3249 CONST0
+    3250 POP 2
+    3252 ACC0
+    3253 RETURN 3
+    3255 RESTART
+    3256 GRAB 2
+    3258 ATOM0
+    3259 PUSHACC1
+    3260 C_CALL2 make_vect
+    3262 PUSHCONST0
+    3263 PUSHACC2
+    3264 OFFSETINT -1
+    3266 PUSH
+    3267 BRANCH 3282
+    3269 CHECK_SIGNALS
+    3270 ACC5
+    3271 PUSHACC5
+    3272 C_CALL2 make_vect
+    3274 PUSHACC2
+    3275 PUSHACC4
+    3276 SETVECTITEM
+    3277 ACC1
+    3278 OFFSETINT 1
+    3280 ASSIGN 1
+    3282 ACC0
+    3283 PUSHACC2
+    3284 LEINT
+    3285 BRANCHIF 3269
+    3287 CONST0
+    3288 POP 2
+    3290 ACC0
+    3291 RETURN 4
+    3293 RESTART
+    3294 GRAB 1
+    3296 CONST0
+    3297 PUSHACC1
+    3298 EQ
+    3299 BRANCHIFNOT 3304
+    3301 ATOM0
+    3302 RETURN 2
+    3304 CONST0
+    3305 PUSHACC2
+    3306 APPLY1
+    3307 PUSHACC1
+    3308 C_CALL2 make_vect
+    3310 PUSHCONST1
+    3311 PUSHACC2
+    3312 OFFSETINT -1
+    3314 PUSH
+    3315 BRANCH 3330
+    3317 CHECK_SIGNALS
+    3318 ACC1
+    3319 PUSHACC5
+    3320 APPLY1
+    3321 PUSHACC2
+    3322 PUSHACC4
+    3323 C_CALL3 array_unsafe_set
+    3325 ACC1
+    3326 OFFSETINT 1
+    3328 ASSIGN 1
+    3330 ACC0
+    3331 PUSHACC2
+    3332 LEINT
+    3333 BRANCHIF 3317
+    3335 CONST0
+    3336 POP 2
+    3338 ACC0
+    3339 RETURN 3
+    3341 CLOSURE 0, 3294
+    3344 PUSH
+    3345 CLOSURE 0, 3256
+    3348 PUSH
+    3349 CLOSURE 0, 3206
+    3352 PUSH
+    3353 CLOSURE 0, 3107
+    3356 PUSH
+    3357 CLOSURE 0, 3074
+    3360 PUSHACC0
+    3361 CLOSURE 1, 3020
+    3364 PUSH
+    3365 CLOSURE 0, 2917
+    3368 PUSH
+    3369 CLOSURE 0, 2861
+    3372 PUSH
+    3373 CLOSURE 0, 2749
+    3376 PUSH
+    3377 CLOSURE 0, 2718
+    3380 PUSH
+    3381 CLOSURE 0, 2662
+    3384 PUSH
+    3385 CLOSURE 0, 2630
+    3388 PUSH
+    3389 CLOSURE 0, 2572
+    3392 PUSH
+    3393 CLOSURE 0, 2558
+    3396 PUSH
+    3397 CLOSURE 0, 2505
+    3400 PUSH
+    3401 CLOSURE 0, 2445
+    3404 PUSH
+    3405 CLOSURE 0, 2407
+    3408 PUSHACC0
+    3409 PUSHACC2
+    3410 PUSHACC6
+    3411 PUSHACC 8
+    3413 PUSHACC 10
+    3415 PUSHACC 12
+    3417 PUSHACC 8
+    3419 PUSHACC 10
+    3421 PUSHACC 16
+    3423 PUSHACC 18
+    3425 PUSHACC 24
+    3427 PUSHACC 21
+    3429 PUSHACC 23
+    3431 PUSHACC 26
+    3433 PUSHACC 29
+    3435 PUSHACC 30
+    3437 PUSHACC 32
+    3439 MAKEBLOCK 17, 0
+    3442 POP 17
+    3444 SETGLOBAL Array
+    3446 BRANCH 3480
+    3448 ENVACC1
+    3449 MAKEBLOCK1 0
+    3451 RAISE
+    3452 ACC0
+    3453 BRANCHIFNOT 3465
+    3455 ENVACC3
+    3456 CLOSURE 1, 3448
+    3459 MAKEBLOCK1 0
+    3461 PUSHENVACC2
+    3462 PUSHENVACC1
+    3463 APPTERM2 3
+    3465 CONST0
+    3466 PUSHENVACC2
+    3467 PUSHENVACC1
+    3468 APPTERM2 3
+    3470 RESTART
+    3471 GRAB 1
+    3473 ACC1
+    3474 PUSHACC1
+    3475 C_CALL2 install_signal_handler
+    3477 CONST0
+    3478 RETURN 2
+    3480 CONST0
+    3481 C_CALL1 sys_get_argv
+    3483 PUSHCONST0
+    3484 C_CALL1 sys_get_config
+    3486 PUSHACC0
+    3487 GETFIELD1
+    3488 PUSHACC0
+    3489 OFFSETINT -10
+    3491 PUSHCONST1
+    3492 LSLINT
+    3493 OFFSETINT -1
+    3495 PUSHACC0
+    3496 PUSHCONSTINT 8
+    3498 PUSHACC3
+    3499 DIVINT
+    3500 MULINT
+    3501 OFFSETINT -1
+    3503 PUSHCONST0
+    3504 MAKEBLOCK1 0
+    3506 PUSH
+    3507 CLOSURE 0, 3471
+    3510 PUSHCONSTINT -1
+    3512 PUSHCONSTINT -2
+    3514 PUSHCONSTINT -3
+    3516 PUSHCONSTINT -4
+    3518 PUSHCONSTINT -5
+    3520 PUSHCONSTINT -6
+    3522 PUSHCONSTINT -7
+    3524 PUSHCONSTINT -8
+    3526 PUSHCONSTINT -9
+    3528 PUSHCONSTINT -10
+    3530 PUSHCONSTINT -11
+    3532 PUSHCONSTINT -12
+    3534 PUSHCONSTINT -13
+    3536 PUSHCONSTINT -14
+    3538 PUSHCONSTINT -15
+    3540 PUSHCONSTINT -16
+    3542 PUSHCONSTINT -17
+    3544 PUSHCONSTINT -18
+    3546 PUSHCONSTINT -19
+    3548 PUSHCONSTINT -20
+    3550 PUSHCONSTINT -21
+    3552 PUSHGETGLOBAL "Sys.Break"
+    3554 MAKEBLOCK1 0
+    3556 PUSHACC0
+    3557 PUSHACC 17
+    3559 PUSHACC 24
+    3561 CLOSURE 3, 3452
+    3564 PUSHACC0
+    3565 PUSHACC2
+    3566 PUSHACC4
+    3567 PUSHACC6
+    3568 PUSHACC 8
+    3570 PUSHACC 10
+    3572 PUSHACC 12
+    3574 PUSHACC 14
+    3576 PUSHACC 16
+    3578 PUSHACC 18
+    3580 PUSHACC 20
+    3582 PUSHACC 22
+    3584 PUSHACC 24
+    3586 PUSHACC 26
+    3588 PUSHACC 28
+    3590 PUSHACC 30
+    3592 PUSHACC 32
+    3594 PUSHACC 34
+    3596 PUSHACC 36
+    3598 PUSHACC 38
+    3600 PUSHACC 40
+    3602 PUSHACC 42
+    3604 PUSHACC 44
+    3606 PUSHACC 46
+    3608 PUSHACC 50
+    3610 PUSHACC 50
+    3612 PUSHACC 53
+    3614 PUSHACC 55
+    3616 GETFIELD0
+    3617 PUSHACC 52
+    3619 PUSHACC 58
+    3621 MAKEBLOCK 30, 0
+    3624 POP 30
+    3626 SETGLOBAL Sys
+    3628 BRANCH 4510
+    3630 RESTART
+    3631 GRAB 1
+    3633 CONST0
+    3634 PUSHACC1
+    3635 LTINT
+    3636 BRANCHIFNOT 3641
+    3638 CONST1
+    3639 RETURN 2
+    3641 ACC1
+    3642 BRANCHIFNOT 3652
+    3644 ACC1
+    3645 GETFIELD2
+    3646 PUSHACC1
+    3647 OFFSETINT -1
+    3649 PUSHOFFSETCLOSURE0
+    3650 APPTERM2 4
+    3652 RETURN 2
+    3654 ACC0
+    3655 BRANCHIFNOT 3670
+    3657 ENVACC2
+    3658 PUSHACC1
+    3659 GETFIELD0
+    3660 PUSHENVACC1
+    3661 GETFIELD0
+    3662 APPLY2
+    3663 BRANCHIF 3670
+    3665 ACC0
+    3666 GETFIELD2
+    3667 PUSHOFFSETCLOSURE0
+    3668 APPTERM1 2
+    3670 RETURN 1
+    3672 RESTART
+    3673 GRAB 1
+    3675 ACC1
+    3676 PUSHENVACC1
+    3677 CLOSUREREC 2, 3654
+    3681 ACC1
+    3682 GETFIELD1
+    3683 VECTLENGTH
+    3684 PUSHACC3
+    3685 PUSHENVACC1
+    3686 GETFIELD1
+    3687 APPLY1
+    3688 MODINT
+    3689 PUSHACC2
+    3690 GETFIELD1
+    3691 C_CALL2 array_get_addr
+    3693 PUSHACC1
+    3694 APPTERM1 4
+    3696 ACC0
+    3697 BRANCHIFNOT 3722
+    3699 ACC0
+    3700 GETFIELD2
+    3701 PUSHENVACC2
+    3702 PUSHACC2
+    3703 GETFIELD0
+    3704 PUSHENVACC1
+    3705 GETFIELD0
+    3706 APPLY2
+    3707 BRANCHIFNOT 3718
+    3709 ACC0
+    3710 PUSHOFFSETCLOSURE0
+    3711 APPLY1
+    3712 PUSHACC2
+    3713 GETFIELD1
+    3714 MAKEBLOCK2 0
+    3716 RETURN 2
+    3718 ACC0
+    3719 PUSHOFFSETCLOSURE0
+    3720 APPTERM1 3
+    3722 RETURN 1
+    3724 RESTART
+    3725 GRAB 1
+    3727 ACC1
+    3728 PUSHENVACC1
+    3729 CLOSUREREC 2, 3696
+    3733 ACC1
+    3734 GETFIELD1
+    3735 VECTLENGTH
+    3736 PUSHACC3
+    3737 PUSHENVACC1
+    3738 GETFIELD1
+    3739 APPLY1
+    3740 MODINT
+    3741 PUSHACC2
+    3742 GETFIELD1
+    3743 C_CALL2 array_get_addr
+    3745 PUSHACC1
+    3746 APPTERM1 4
+    3748 ACC0
+    3749 BRANCHIFNOT 3768
+    3751 ACC0
+    3752 GETFIELD0
+    3753 PUSHENVACC2
+    3754 PUSHENVACC1
+    3755 GETFIELD0
+    3756 APPLY2
+    3757 BRANCHIFNOT 3763
+    3759 ACC0
+    3760 GETFIELD1
+    3761 RETURN 1
+    3763 ACC0
+    3764 GETFIELD2
+    3765 PUSHOFFSETCLOSURE0
+    3766 APPTERM1 2
+    3768 GETGLOBAL Not_found
+    3770 MAKEBLOCK1 0
+    3772 RAISE
+    3773 RESTART
+    3774 GRAB 1
+    3776 ACC0
+    3777 GETFIELD1
+    3778 VECTLENGTH
+    3779 PUSHACC2
+    3780 PUSHENVACC1
+    3781 GETFIELD1
+    3782 APPLY1
+    3783 MODINT
+    3784 PUSHACC1
+    3785 GETFIELD1
+    3786 C_CALL2 array_get_addr
+    3788 PUSHACC0
+    3789 BRANCHIFNOT 3858
+    3791 ACC0
+    3792 GETFIELD2
+    3793 PUSHACC1
+    3794 GETFIELD0
+    3795 PUSHACC4
+    3796 PUSHENVACC1
+    3797 GETFIELD0
+    3798 APPLY2
+    3799 BRANCHIFNOT 3805
+    3801 ACC1
+    3802 GETFIELD1
+    3803 RETURN 4
+    3805 ACC0
+    3806 BRANCHIFNOT 3853
+    3808 ACC0
+    3809 GETFIELD2
+    3810 PUSHACC1
+    3811 GETFIELD0
+    3812 PUSHACC5
+    3813 PUSHENVACC1
+    3814 GETFIELD0
+    3815 APPLY2
+    3816 BRANCHIFNOT 3822
+    3818 ACC1
+    3819 GETFIELD1
+    3820 RETURN 5
+    3822 ACC0
+    3823 BRANCHIFNOT 3848
+    3825 ACC0
+    3826 GETFIELD0
+    3827 PUSHACC5
+    3828 PUSHENVACC1
+    3829 GETFIELD0
+    3830 APPLY2
+    3831 BRANCHIFNOT 3837
+    3833 ACC0
+    3834 GETFIELD1
+    3835 RETURN 5
+    3837 ACC4
+    3838 PUSHENVACC1
+    3839 CLOSUREREC 2, 3748
+    3843 ACC1
+    3844 GETFIELD2
+    3845 PUSHACC1
+    3846 APPTERM1 7
+    3848 GETGLOBAL Not_found
+    3850 MAKEBLOCK1 0
+    3852 RAISE
+    3853 GETGLOBAL Not_found
+    3855 MAKEBLOCK1 0
+    3857 RAISE
+    3858 GETGLOBAL Not_found
+    3860 MAKEBLOCK1 0
+    3862 RAISE
+    3863 ACC0
+    3864 BRANCHIFNOT 3890
+    3866 ACC0
+    3867 GETFIELD0
+    3868 PUSHACC1
+    3869 GETFIELD2
+    3870 PUSHENVACC2
+    3871 PUSHACC2
+    3872 PUSHENVACC1
+    3873 GETFIELD0
+    3874 APPLY2
+    3875 BRANCHIFNOT 3880
+    3877 ACC0
+    3878 RETURN 3
+    3880 ACC0
+    3881 PUSHOFFSETCLOSURE0
+    3882 APPLY1
+    3883 PUSHACC3
+    3884 GETFIELD1
+    3885 PUSHACC3
+    3886 MAKEBLOCK3 0
+    3888 POP 2
+    3890 RETURN 1
+    3892 RESTART
+    3893 GRAB 1
+    3895 ACC1
+    3896 PUSHENVACC1
+    3897 CLOSUREREC 2, 3863
+    3901 ACC1
+    3902 GETFIELD1
+    3903 VECTLENGTH
+    3904 PUSHACC3
+    3905 PUSHENVACC1
+    3906 GETFIELD1
+    3907 APPLY1
+    3908 MODINT
+    3909 PUSHACC0
+    3910 PUSHACC3
+    3911 GETFIELD1
+    3912 C_CALL2 array_get_addr
+    3914 PUSHACC2
+    3915 APPLY1
+    3916 PUSHACC1
+    3917 PUSHACC4
+    3918 GETFIELD1
+    3919 C_CALL3 array_set_addr
+    3921 RETURN 4
+    3923 RESTART
+    3924 GRAB 2
+    3926 ACC0
+    3927 GETFIELD1
+    3928 VECTLENGTH
+    3929 PUSHACC2
+    3930 PUSHENVACC3
+    3931 GETFIELD1
+    3932 APPLY1
+    3933 MODINT
+    3934 PUSHACC0
+    3935 PUSHACC2
+    3936 GETFIELD1
+    3937 C_CALL2 array_get_addr
+    3939 PUSHACC4
+    3940 PUSHACC4
+    3941 MAKEBLOCK3 0
+    3943 PUSHACC0
+    3944 PUSHACC2
+    3945 PUSHACC4
+    3946 GETFIELD1
+    3947 C_CALL3 array_set_addr
+    3949 ACC0
+    3950 PUSHACC3
+    3951 GETFIELD0
+    3952 PUSHENVACC2
+    3953 APPLY2
+    3954 BRANCHIFNOT 3962
+    3956 ACC2
+    3957 PUSHENVACC3
+    3958 GETFIELD1
+    3959 PUSHENVACC1
+    3960 APPTERM2 7
+    3962 RETURN 5
+    3964 ACC0
+    3965 PUSHENVACC 4
+    3967 PUSHENVACC3
+    3968 CLOSURE 3, 3924
+    3971 PUSHACC1
+    3972 CLOSURE 1, 3893
+    3975 PUSHACC2
+    3976 CLOSURE 1, 3774
+    3979 PUSHACC3
+    3980 CLOSURE 1, 3725
+    3983 PUSHACC4
+    3984 CLOSURE 1, 3673
+    3987 PUSHENVACC 5
+    3989 PUSHACC1
+    3990 PUSHACC3
+    3991 PUSHACC5
+    3992 PUSHACC7
+    3993 PUSHACC 9
+    3995 PUSHENVACC2
+    3996 PUSHENVACC1
+    3997 MAKEBLOCK 8, 0
+    4000 RETURN 6
+    4002 ACC0
+    4003 BRANCHIFNOT 4016
+    4005 ACC0
+    4006 GETFIELD1
+    4007 PUSHACC1
+    4008 GETFIELD0
+    4009 PUSHENVACC1
+    4010 APPLY2
+    4011 ACC0
+    4012 GETFIELD2
+    4013 PUSHOFFSETCLOSURE0
+    4014 APPTERM1 2
+    4016 RETURN 1
+    4018 RESTART
+    4019 GRAB 1
+    4021 ACC0
+    4022 CLOSUREREC 1, 4002
+    4026 ACC2
+    4027 GETFIELD1
+    4028 PUSHCONST0
+    4029 PUSHACC1
+    4030 VECTLENGTH
+    4031 OFFSETINT -1
+    4033 PUSH
+    4034 BRANCH 4048
+    4036 CHECK_SIGNALS
+    4037 ACC1
+    4038 PUSHACC3
+    4039 C_CALL2 array_get_addr
+    4041 PUSHACC4
+    4042 APPLY1
+    4043 ACC1
+    4044 OFFSETINT 1
+    4046 ASSIGN 1
+    4048 ACC0
+    4049 PUSHACC2
+    4050 LEINT
+    4051 BRANCHIF 4036
+    4053 CONST0
+    4054 RETURN 6
+    4056 ACC0
+    4057 BRANCHIFNOT 4071
+    4059 ENVACC1
+    4060 PUSHACC1
+    4061 GETFIELD0
+    4062 C_CALL2 equal
+    4064 BRANCHIF 4071
+    4066 ACC0
+    4067 GETFIELD2
+    4068 PUSHOFFSETCLOSURE0
+    4069 APPTERM1 2
+    4071 RETURN 1
+    4073 RESTART
+    4074 GRAB 1
+    4076 ACC1
+    4077 CLOSUREREC 1, 4056
+    4081 ACC1
+    4082 GETFIELD1
+    4083 VECTLENGTH
+    4084 PUSHACC3
+    4085 PUSHENVACC1
+    4086 APPLY1
+    4087 MODINT
+    4088 PUSHACC2
+    4089 GETFIELD1
+    4090 C_CALL2 array_get_addr
+    4092 PUSHACC1
+    4093 APPTERM1 4
+    4095 ACC0
+    4096 BRANCHIFNOT 4120
+    4098 ACC0
+    4099 GETFIELD2
+    4100 PUSHENVACC1
+    4101 PUSHACC2
+    4102 GETFIELD0
+    4103 C_CALL2 equal
+    4105 BRANCHIFNOT 4116
+    4107 ACC0
+    4108 PUSHOFFSETCLOSURE0
+    4109 APPLY1
+    4110 PUSHACC2
+    4111 GETFIELD1
+    4112 MAKEBLOCK2 0
+    4114 RETURN 2
+    4116 ACC0
+    4117 PUSHOFFSETCLOSURE0
+    4118 APPTERM1 3
+    4120 RETURN 1
+    4122 RESTART
+    4123 GRAB 1
+    4125 ACC1
+    4126 CLOSUREREC 1, 4095
+    4130 ACC1
+    4131 GETFIELD1
+    4132 VECTLENGTH
+    4133 PUSHACC3
+    4134 PUSHENVACC1
+    4135 APPLY1
+    4136 MODINT
+    4137 PUSHACC2
+    4138 GETFIELD1
+    4139 C_CALL2 array_get_addr
+    4141 PUSHACC1
+    4142 APPTERM1 4
+    4144 ACC0
+    4145 BRANCHIFNOT 4163
+    4147 ACC0
+    4148 GETFIELD0
+    4149 PUSHENVACC1
+    4150 C_CALL2 equal
+    4152 BRANCHIFNOT 4158
+    4154 ACC0
+    4155 GETFIELD1
+    4156 RETURN 1
+    4158 ACC0
+    4159 GETFIELD2
+    4160 PUSHOFFSETCLOSURE0
+    4161 APPTERM1 2
+    4163 GETGLOBAL Not_found
+    4165 MAKEBLOCK1 0
+    4167 RAISE
+    4168 RESTART
+    4169 GRAB 1
+    4171 ACC0
+    4172 GETFIELD1
+    4173 VECTLENGTH
+    4174 PUSHACC2
+    4175 PUSHENVACC1
+    4176 APPLY1
+    4177 MODINT
+    4178 PUSHACC1
+    4179 GETFIELD1
+    4180 C_CALL2 array_get_addr
+    4182 PUSHACC0
+    4183 BRANCHIFNOT 4248
+    4185 ACC0
+    4186 GETFIELD2
+    4187 PUSHACC1
+    4188 GETFIELD0
+    4189 PUSHACC4
+    4190 C_CALL2 equal
+    4192 BRANCHIFNOT 4198
+    4194 ACC1
+    4195 GETFIELD1
+    4196 RETURN 4
+    4198 ACC0
+    4199 BRANCHIFNOT 4243
+    4201 ACC0
+    4202 GETFIELD2
+    4203 PUSHACC1
+    4204 GETFIELD0
+    4205 PUSHACC5
+    4206 C_CALL2 equal
+    4208 BRANCHIFNOT 4214
+    4210 ACC1
+    4211 GETFIELD1
+    4212 RETURN 5
+    4214 ACC0
+    4215 BRANCHIFNOT 4238
+    4217 ACC0
+    4218 GETFIELD0
+    4219 PUSHACC5
+    4220 C_CALL2 equal
+    4222 BRANCHIFNOT 4228
+    4224 ACC0
+    4225 GETFIELD1
+    4226 RETURN 5
+    4228 ACC4
+    4229 CLOSUREREC 1, 4144
+    4233 ACC1
+    4234 GETFIELD2
+    4235 PUSHACC1
+    4236 APPTERM1 7
+    4238 GETGLOBAL Not_found
+    4240 MAKEBLOCK1 0
+    4242 RAISE
+    4243 GETGLOBAL Not_found
+    4245 MAKEBLOCK1 0
+    4247 RAISE
+    4248 GETGLOBAL Not_found
+    4250 MAKEBLOCK1 0
+    4252 RAISE
+    4253 ACC0
+    4254 BRANCHIFNOT 4279
+    4256 ACC0
+    4257 GETFIELD0
+    4258 PUSHACC1
+    4259 GETFIELD2
+    4260 PUSHENVACC1
+    4261 PUSHACC2
+    4262 C_CALL2 equal
+    4264 BRANCHIFNOT 4269
+    4266 ACC0
+    4267 RETURN 3
+    4269 ACC0
+    4270 PUSHOFFSETCLOSURE0
+    4271 APPLY1
+    4272 PUSHACC3
+    4273 GETFIELD1
+    4274 PUSHACC3
+    4275 MAKEBLOCK3 0
+    4277 POP 2
+    4279 RETURN 1
+    4281 RESTART
+    4282 GRAB 1
+    4284 ACC1
+    4285 CLOSUREREC 1, 4253
+    4289 ACC1
+    4290 GETFIELD1
+    4291 VECTLENGTH
+    4292 PUSHACC3
+    4293 PUSHENVACC1
+    4294 APPLY1
+    4295 MODINT
+    4296 PUSHACC0
+    4297 PUSHACC3
+    4298 GETFIELD1
+    4299 C_CALL2 array_get_addr
+    4301 PUSHACC2
+    4302 APPLY1
+    4303 PUSHACC1
+    4304 PUSHACC4
+    4305 GETFIELD1
+    4306 C_CALL3 array_set_addr
+    4308 RETURN 4
+    4310 RESTART
+    4311 GRAB 2
+    4313 ACC0
+    4314 GETFIELD1
+    4315 VECTLENGTH
+    4316 PUSHACC2
+    4317 PUSHENVACC1
+    4318 APPLY1
+    4319 MODINT
+    4320 PUSHACC0
+    4321 PUSHACC2
+    4322 GETFIELD1
+    4323 C_CALL2 array_get_addr
+    4325 PUSHACC4
+    4326 PUSHACC4
+    4327 MAKEBLOCK3 0
+    4329 PUSHACC0
+    4330 PUSHACC2
+    4331 PUSHACC4
+    4332 GETFIELD1
+    4333 C_CALL3 array_set_addr
+    4335 ACC0
+    4336 PUSHACC3
+    4337 GETFIELD0
+    4338 PUSHENVACC3
+    4339 APPLY2
+    4340 BRANCHIFNOT 4347
+    4342 ACC2
+    4343 PUSHENVACC1
+    4344 PUSHENVACC2
+    4345 APPTERM2 7
+    4347 RETURN 5
+    4349 ACC0
+    4350 BRANCHIFNOT 4378
+    4352 ACC0
+    4353 GETFIELD0
+    4354 PUSHACC1
+    4355 GETFIELD2
+    4356 PUSHOFFSETCLOSURE0
+    4357 APPLY1
+    4358 ENVACC2
+    4359 PUSHACC1
+    4360 PUSHENVACC1
+    4361 APPLY1
+    4362 MODINT
+    4363 PUSHACC0
+    4364 PUSHENVACC3
+    4365 C_CALL2 array_get_addr
+    4367 PUSHACC3
+    4368 GETFIELD1
+    4369 PUSHACC3
+    4370 MAKEBLOCK3 0
+    4372 PUSHACC1
+    4373 PUSHENVACC3
+    4374 C_CALL3 array_set_addr
+    4376 POP 2
+    4378 RETURN 1
+    4380 RESTART
+    4381 GRAB 1
+    4383 ACC1
+    4384 GETFIELD1
+    4385 PUSHACC0
+    4386 VECTLENGTH
+    4387 PUSHACC0
+    4388 PUSHCONST2
+    4389 MULINT
+    4390 OFFSETINT 1
+    4392 PUSHCONST0
+    4393 PUSHACC1
+    4394 C_CALL2 make_vect
+    4396 PUSHACC0
+    4397 PUSHACC2
+    4398 PUSHACC6
+    4399 CLOSUREREC 3, 4349
+    4403 CONST0
+    4404 PUSHACC4
+    4405 OFFSETINT -1
+    4407 PUSH
+    4408 BRANCH 4422
+    4410 CHECK_SIGNALS
+    4411 ACC1
+    4412 PUSHACC7
+    4413 C_CALL2 array_get_addr
+    4415 PUSHACC3
+    4416 APPLY1
+    4417 ACC1
+    4418 OFFSETINT 1
+    4420 ASSIGN 1
+    4422 ACC0
+    4423 PUSHACC2
+    4424 LEINT
+    4425 BRANCHIF 4410
+    4427 CONST0
+    4428 POP 2
+    4430 ACC1
+    4431 PUSHACC7
+    4432 SETFIELD1
+    4433 ACC6
+    4434 GETFIELD0
+    4435 PUSHCONST2
+    4436 MULINT
+    4437 PUSHACC7
+    4438 SETFIELD0
+    4439 RETURN 7
+    4441 CONST0
+    4442 PUSHACC1
+    4443 GETFIELD1
+    4444 VECTLENGTH
+    4445 OFFSETINT -1
+    4447 PUSH
+    4448 BRANCH 4462
+    4450 CHECK_SIGNALS
+    4451 CONST0
+    4452 PUSHACC2
+    4453 PUSHACC4
+    4454 GETFIELD1
+    4455 C_CALL3 array_set_addr
+    4457 ACC1
+    4458 OFFSETINT 1
+    4460 ASSIGN 1
+    4462 ACC0
+    4463 PUSHACC2
+    4464 LEINT
+    4465 BRANCHIF 4450
+    4467 CONST0
+    4468 RETURN 3
+    4470 CONST1
+    4471 PUSHACC1
+    4472 LTINT
+    4473 BRANCHIFNOT 4478
+    4475 CONST1
+    4476 BRANCH 4479
+    4478 ACC0
+    4479 PUSHGETGLOBALFIELD Sys, 5
+    4482 PUSHACC1
+    4483 GTINT
+    4484 BRANCHIFNOT 4491
+    4486 GETGLOBALFIELD Sys, 5
+    4489 BRANCH 4492
+    4491 ACC0
+    4492 PUSHCONST0
+    4493 PUSHACC1
+    4494 C_CALL2 make_vect
+    4496 PUSHCONST3
+    4497 MAKEBLOCK2 0
+    4499 RETURN 3
+    4501 ACC0
+    4502 PUSHCONSTINT 100
+    4504 PUSHCONSTINT 10
+    4506 C_CALL3 hash_univ_param
+    4508 RETURN 1
+    4510 CLOSURE 0, 4501
+    4513 PUSH
+    4514 CLOSURE 0, 4470
+    4517 PUSH
+    4518 CLOSURE 0, 4441
+    4521 PUSH
+    4522 CLOSURE 0, 4381
+    4525 PUSH
+    4526 CLOSUREREC 0, 3631
+    4530 ACC0
+    4531 PUSHACC2
+    4532 PUSHACC6
+    4533 CLOSURE 3, 4311
+    4536 PUSHACC5
+    4537 CLOSURE 1, 4282
+    4540 PUSHACC6
+    4541 CLOSURE 1, 4169
+    4544 PUSHACC7
+    4545 CLOSURE 1, 4123
+    4548 PUSHACC 8
+    4550 CLOSURE 1, 4074
+    4553 PUSH
+    4554 CLOSURE 0, 4019
+    4557 PUSHACC0
+    4558 PUSHACC7
+    4559 PUSHACC 9
+    4561 PUSHACC 11
+    4563 PUSHACC 13
+    4565 CLOSURE 5, 3964
+    4568 PUSHACC 11
+    4570 PUSHACC1
+    4571 PUSHACC3
+    4572 PUSHACC 8
+    4574 PUSHACC6
+    4575 PUSHACC 8
+    4577 PUSHACC 10
+    4579 PUSHACC 13
+    4581 PUSHACC 17
+    4583 PUSHACC 19
+    4585 MAKEBLOCK 10, 0
+    4588 POP 12
+    4590 SETGLOBAL Hashtbl
+    4592 BRANCH 5073
+    4594 RESTART
+    4595 GRAB 2
+    4597 ACC1
+    4598 BRANCHIFNOT 4638
+    4600 ACC1
+    4601 GETFIELD0
+    4602 PUSHACC3
+    4603 BRANCHIFNOT 4635
+    4605 ACC3
+    4606 GETFIELD0
+    4607 PUSHACC0
+    4608 PUSHACC2
+    4609 PUSHACC4
+    4610 APPLY2
+    4611 BRANCHIFNOT 4624
+    4613 ACC4
+    4614 PUSHACC4
+    4615 GETFIELD1
+    4616 PUSHACC4
+    4617 PUSHOFFSETCLOSURE0
+    4618 APPLY3
+    4619 PUSHACC2
+    4620 MAKEBLOCK2 0
+    4622 RETURN 5
+    4624 ACC4
+    4625 GETFIELD1
+    4626 PUSHACC4
+    4627 PUSHACC4
+    4628 PUSHOFFSETCLOSURE0
+    4629 APPLY3
+    4630 PUSHACC1
+    4631 MAKEBLOCK2 0
+    4633 RETURN 5
+    4635 ACC2
+    4636 RETURN 4
+    4638 ACC2
+    4639 RETURN 3
+    4641 RESTART
+    4642 GRAB 1
+    4644 CONSTINT 6
+    4646 PUSHACC1
+    4647 PUSHACC3
+    4648 SUBINT
+    4649 GEINT
+    4650 BRANCHIFNOT 4809
+    4652 CONST1
+    4653 PUSHACC2
+    4654 PUSHACC2
+    4655 ADDINT
+    4656 LSRINT
+    4657 PUSHACC1
+    4658 PUSHENVACC3
+    4659 C_CALL2 array_unsafe_get
+    4661 PUSHACC1
+    4662 PUSHENVACC3
+    4663 C_CALL2 array_unsafe_get
+    4665 PUSHENVACC2
+    4666 APPLY2
+    4667 BRANCHIFNOT 4674
+    4669 ACC1
+    4670 PUSHACC1
+    4671 PUSHENVACC3
+    4672 PUSHENVACC1
+    4673 APPLY3
+    4674 ACC0
+    4675 PUSHENVACC3
+    4676 C_CALL2 array_unsafe_get
+    4678 PUSHACC3
+    4679 PUSHENVACC3
+    4680 C_CALL2 array_unsafe_get
+    4682 PUSHENVACC2
+    4683 APPLY2
+    4684 BRANCHIFNOT 4708
+    4686 ACC2
+    4687 PUSHACC1
+    4688 PUSHENVACC3
+    4689 PUSHENVACC1
+    4690 APPLY3
+    4691 ACC1
+    4692 PUSHENVACC3
+    4693 C_CALL2 array_unsafe_get
+    4695 PUSHACC1
+    4696 PUSHENVACC3
+    4697 C_CALL2 array_unsafe_get
+    4699 PUSHENVACC2
+    4700 APPLY2
+    4701 BRANCHIFNOT 4708
+    4703 ACC1
+    4704 PUSHACC1
+    4705 PUSHENVACC3
+    4706 PUSHENVACC1
+    4707 APPLY3
+    4708 ACC0
+    4709 PUSHENVACC3
+    4710 C_CALL2 array_unsafe_get
+    4712 PUSHACC2
+    4713 OFFSETINT 1
+    4715 PUSHACC4
+    4716 OFFSETINT -1
+    4718 PUSH
+    4719 BRANCH 4777
+    4721 CHECK_SIGNALS
+    4722 BRANCH 4730
+    4724 CHECK_SIGNALS
+    4725 ACC1
+    4726 OFFSETINT 1
+    4728 ASSIGN 1
+    4730 ACC1
+    4731 PUSHENVACC3
+    4732 C_CALL2 array_unsafe_get
+    4734 PUSHACC3
+    4735 PUSHENVACC2
+    4736 APPLY2
+    4737 BRANCHIFNOT 4724
+    4739 CONST0
+    4740 BRANCH 4748
+    4742 CHECK_SIGNALS
+    4743 ACC0
+    4744 OFFSETINT -1
+    4746 ASSIGN 0
+    4748 ACC2
+    4749 PUSHACC1
+    4750 PUSHENVACC3
+    4751 C_CALL2 array_unsafe_get
+    4753 PUSHENVACC2
+    4754 APPLY2
+    4755 BRANCHIFNOT 4742
+    4757 ACC0
+    4758 PUSHACC2
+    4759 LTINT
+    4760 BRANCHIFNOT 4767
+    4762 ACC0
+    4763 PUSHACC2
+    4764 PUSHENVACC3
+    4765 PUSHENVACC1
+    4766 APPLY3
+    4767 ACC1
+    4768 OFFSETINT 1
+    4770 ASSIGN 1
+    4772 ACC0
+    4773 OFFSETINT -1
+    4775 ASSIGN 0
+    4777 ACC0
+    4778 PUSHACC2
+    4779 LTINT
+    4780 BRANCHIF 4721
+    4782 ACC1
+    4783 PUSHACC6
+    4784 SUBINT
+    4785 PUSHACC5
+    4786 PUSHACC2
+    4787 SUBINT
+    4788 LEINT
+    4789 BRANCHIFNOT 4800
+    4791 ACC0
+    4792 PUSHACC5
+    4793 PUSHOFFSETCLOSURE0
+    4794 APPLY2
+    4795 ACC5
+    4796 PUSHACC2
+    4797 PUSHOFFSETCLOSURE0
+    4798 APPTERM2 8
+    4800 ACC5
+    4801 PUSHACC2
+    4802 PUSHOFFSETCLOSURE0
+    4803 APPLY2
+    4804 ACC0
+    4805 PUSHACC5
+    4806 PUSHOFFSETCLOSURE0
+    4807 APPTERM2 8
+    4809 RETURN 2
+    4811 RESTART
+    4812 GRAB 1
+    4814 ACC1
+    4815 PUSHACC1
+    4816 PUSHENVACC1
+    4817 CLOSUREREC 3, 4642
+    4821 ACC2
+    4822 VECTLENGTH
+    4823 OFFSETINT -1
+    4825 PUSHCONST0
+    4826 PUSHACC2
+    4827 APPLY2
+    4828 CONST1
+    4829 PUSHACC3
+    4830 VECTLENGTH
+    4831 OFFSETINT -1
+    4833 PUSH
+    4834 BRANCH 4918
+    4836 CHECK_SIGNALS
+    4837 ACC1
+    4838 PUSHACC5
+    4839 C_CALL2 array_unsafe_get
+    4841 PUSHACC0
+    4842 PUSHACC3
+    4843 OFFSETINT -1
+    4845 PUSHACC7
+    4846 C_CALL2 array_unsafe_get
+    4848 PUSHACC6
+    4849 APPLY2
+    4850 BOOLNOT
+    4851 BRANCHIFNOT 4911
+    4853 ACC2
+    4854 OFFSETINT -1
+    4856 PUSHACC6
+    4857 C_CALL2 array_unsafe_get
+    4859 PUSHACC3
+    4860 PUSHACC7
+    4861 C_CALL3 array_unsafe_set
+    4863 ACC2
+    4864 OFFSETINT -1
+    4866 PUSH
+    4867 BRANCH 4886
+    4869 CHECK_SIGNALS
+    4870 ACC0
+    4871 OFFSETINT -1
+    4873 PUSHACC7
+    4874 C_CALL2 array_unsafe_get
+    4876 PUSHACC1
+    4877 PUSHACC 8
+    4879 C_CALL3 array_unsafe_set
+    4881 ACC0
+    4882 OFFSETINT -1
+    4884 ASSIGN 0
+    4886 CONST1
+    4887 PUSHACC1
+    4888 GEINT
+    4889 BRANCHIFNOT 4903
+    4891 ACC1
+    4892 PUSHACC1
+    4893 OFFSETINT -1
+    4895 PUSHACC 8
+    4897 C_CALL2 array_unsafe_get
+    4899 PUSHACC7
+    4900 APPLY2
+    4901 BRANCHIFNOT 4869
+    4903 ACC1
+    4904 PUSHACC1
+    4905 PUSHACC 8
+    4907 C_CALL3 array_unsafe_set
+    4909 POP 1
+    4911 POP 1
+    4913 ACC1
+    4914 OFFSETINT 1
+    4916 ASSIGN 1
+    4918 ACC0
+    4919 PUSHACC2
+    4920 LEINT
+    4921 BRANCHIF 4836
+    4923 CONST0
+    4924 RETURN 5
+    4926 RESTART
+    4927 GRAB 2
+    4929 ACC1
+    4930 PUSHACC1
+    4931 C_CALL2 array_unsafe_get
+    4933 PUSHACC3
+    4934 PUSHACC2
+    4935 C_CALL2 array_unsafe_get
+    4937 PUSHACC3
+    4938 PUSHACC3
+    4939 C_CALL3 array_unsafe_set
+    4941 ACC0
+    4942 PUSHACC4
+    4943 PUSHACC3
+    4944 C_CALL3 array_unsafe_set
+    4946 RETURN 4
+    4948 ACC0
+    4949 BRANCHIFNOT 4999
+    4951 ACC0
+    4952 GETFIELD0
+    4953 PUSHACC1
+    4954 GETFIELD1
+    4955 PUSHACC0
+    4956 BRANCHIFNOT 4990
+    4958 ACC0
+    4959 GETFIELD0
+    4960 PUSHACC1
+    4961 GETFIELD1
+    4962 PUSHOFFSETCLOSURE0
+    4963 APPLY1
+    4964 PUSHACC1
+    4965 PUSHACC4
+    4966 PUSHENVACC1
+    4967 APPLY2
+    4968 BRANCHIFNOT 4979
+    4970 CONST0
+    4971 PUSHACC2
+    4972 MAKEBLOCK2 0
+    4974 PUSHACC4
+    4975 MAKEBLOCK2 0
+    4977 BRANCH 4986
+    4979 CONST0
+    4980 PUSHACC4
+    4981 MAKEBLOCK2 0
+    4983 PUSHACC2
+    4984 MAKEBLOCK2 0
+    4986 MAKEBLOCK2 0
+    4988 RETURN 4
+    4990 CONST0
+    4991 PUSHCONST0
+    4992 PUSHACC3
+    4993 MAKEBLOCK2 0
+    4995 MAKEBLOCK2 0
+    4997 POP 2
+    4999 RETURN 1
+    5001 ACC0
+    5002 BRANCHIFNOT 5028
+    5004 ACC0
+    5005 GETFIELD1
+    5006 PUSHACC0
+    5007 BRANCHIFNOT 5024
+    5009 ACC0
+    5010 GETFIELD1
+    5011 PUSHOFFSETCLOSURE0
+    5012 APPLY1
+    5013 PUSHACC1
+    5014 GETFIELD0
+    5015 PUSHACC3
+    5016 GETFIELD0
+    5017 PUSHENVACC2
+    5018 PUSHENVACC1
+    5019 APPLY3
+    5020 MAKEBLOCK2 0
+    5022 RETURN 2
+    5024 POP 1
+    5026 BRANCH 5028
+    5028 ACC0
+    5029 RETURN 1
+    5031 ACC0
+    5032 BRANCHIFNOT 5040
+    5034 ACC0
+    5035 GETFIELD1
+    5036 BRANCHIF 5042
+    5038 ACC0
+    5039 GETFIELD0
+    5040 RETURN 1
+    5042 ACC0
+    5043 PUSHENVACC1
+    5044 APPLY1
+    5045 PUSHOFFSETCLOSURE0
+    5046 APPTERM1 2
+    5048 RESTART
+    5049 GRAB 1
+    5051 ACC0
+    5052 CLOSUREREC 1, 4948
+    5056 ACC1
+    5057 PUSHENVACC1
+    5058 CLOSUREREC 2, 5001
+    5062 ACC0
+    5063 CLOSUREREC 1, 5031
+    5067 ACC4
+    5068 PUSHACC3
+    5069 APPLY1
+    5070 PUSHACC1
+    5071 APPTERM1 6
+    5073 CLOSUREREC 0, 4595
+    5077 ACC0
+    5078 CLOSURE 1, 5049
+    5081 PUSH
+    5082 CLOSURE 0, 4927
+    5085 PUSHACC0
+    5086 CLOSURE 1, 4812
+    5089 PUSHACC3
+    5090 PUSHACC1
+    5091 PUSHACC4
+    5092 MAKEBLOCK3 0
+    5094 POP 4
+    5096 SETGLOBAL Sort
+    5098 BRANCH 5847
+    5100 ACC0
+    5101 PUSHENVACC1
+    5102 APPLY1
+    5103 PUSHACC0
+    5104 GETFIELD 11
+    5106 PUSHACC1
+    5107 GETFIELD 10
+    5109 PUSHACC2
+    5110 GETFIELD 9
+    5112 PUSHACC3
+    5113 GETFIELD 6
+    5115 PUSHACC4
+    5116 GETFIELD 8
+    5118 PUSHACC5
+    5119 GETFIELD 5
+    5121 PUSHACC6
+    5122 GETFIELD 4
+    5124 PUSHACC7
+    5125 GETFIELD0
+    5126 MAKEBLOCK 8, 0
+    5129 RETURN 2
+    5131 RESTART
+    5132 GRAB 2
+    5134 ACC2
+    5135 BRANCHIFNOT 5201
+    5137 ACC2
+    5138 GETFIELD0
+    5139 PUSHACC3
+    5140 GETFIELD1
+    5141 PUSHACC4
+    5142 GETFIELD2
+    5143 PUSHACC5
+    5144 GETFIELD3
+    5145 PUSHACC2
+    5146 PUSHACC5
+    5147 PUSHENVACC1
+    5148 GETFIELD0
+    5149 APPLY2
+    5150 PUSHCONST0
+    5151 PUSHACC1
+    5152 EQ
+    5153 BRANCHIFNOT 5170
+    5155 ACC7
+    5156 GETFIELD 4
+    5158 PUSHACC2
+    5159 PUSHACC 8
+    5161 PUSHACC 8
+    5163 PUSHACC 8
+    5165 MAKEBLOCK 5, 0
+    5168 RETURN 8
+    5170 CONST0
+    5171 PUSHACC1
+    5172 LTINT
+    5173 BRANCHIFNOT 5189
+    5175 ACC1
+    5176 PUSHACC3
+    5177 PUSHACC5
+    5178 PUSHACC7
+    5179 PUSHACC 10
+    5181 PUSHACC 10
+    5183 PUSHOFFSETCLOSURE0
+    5184 APPLY3
+    5185 PUSHENVACC2
+    5186 APPTERM 4, 12
+    5189 ACC1
+    5190 PUSHACC7
+    5191 PUSHACC7
+    5192 PUSHOFFSETCLOSURE0
+    5193 APPLY3
+    5194 PUSHACC3
+    5195 PUSHACC5
+    5196 PUSHACC7
+    5197 PUSHENVACC2
+    5198 APPTERM 4, 12
+    5201 CONST1
+    5202 PUSHCONST0
+    5203 PUSHACC3
+    5204 PUSHACC3
+    5205 PUSHCONST0
+    5206 MAKEBLOCK 5, 0
+    5209 RETURN 3
+    5211 RESTART
+    5212 GRAB 1
+    5214 ACC1
+    5215 BRANCHIFNOT 5247
+    5217 ACC1
+    5218 GETFIELD1
+    5219 PUSHACC1
+    5220 PUSHENVACC1
+    5221 GETFIELD0
+    5222 APPLY2
+    5223 PUSHCONST0
+    5224 PUSHACC1
+    5225 EQ
+    5226 BRANCHIFNOT 5232
+    5228 ACC2
+    5229 GETFIELD2
+    5230 RETURN 3
+    5232 CONST0
+    5233 PUSHACC1
+    5234 LTINT
+    5235 BRANCHIFNOT 5241
+    5237 ACC2
+    5238 GETFIELD0
+    5239 BRANCH 5243
+    5241 ACC2
+    5242 GETFIELD3
+    5243 PUSHACC2
+    5244 PUSHOFFSETCLOSURE0
+    5245 APPTERM2 5
+    5247 GETGLOBAL Not_found
+    5249 MAKEBLOCK1 0
+    5251 RAISE
+    5252 RESTART
+    5253 GRAB 1
+    5255 ACC1
+    5256 BRANCHIFNOT 5286
+    5258 ACC1
+    5259 GETFIELD1
+    5260 PUSHACC1
+    5261 PUSHENVACC1
+    5262 GETFIELD0
+    5263 APPLY2
+    5264 PUSHCONST0
+    5265 PUSHACC1
+    5266 EQ
+    5267 BRANCHIF 5284
+    5269 CONST0
+    5270 PUSHACC1
+    5271 LTINT
+    5272 BRANCHIFNOT 5278
+    5274 ACC2
+    5275 GETFIELD0
+    5276 BRANCH 5280
+    5278 ACC2
+    5279 GETFIELD3
+    5280 PUSHACC2
+    5281 PUSHOFFSETCLOSURE0
+    5282 APPTERM2 5
+    5284 POP 1
+    5286 RETURN 2
+    5288 RESTART
+    5289 GRAB 1
+    5291 ACC0
+    5292 BRANCHIF 5297
+    5294 ACC1
+    5295 RETURN 2
+    5297 ACC1
+    5298 BRANCHIF 5303
+    5300 ACC0
+    5301 RETURN 2
+    5303 ACC0
+    5304 BRANCHIFNOT 5336
+    5306 ACC1
+    5307 BRANCHIFNOT 5336
+    5309 PUSH_RETADDR 5326
+    5311 ACC4
+    5312 GETFIELD3
+    5313 PUSHACC5
+    5314 GETFIELD2
+    5315 PUSHACC6
+    5316 GETFIELD1
+    5317 PUSHACC7
+    5318 GETFIELD0
+    5319 PUSHACC7
+    5320 GETFIELD3
+    5321 PUSHOFFSETCLOSURE0
+    5322 APPLY2
+    5323 PUSHENVACC1
+    5324 APPLY 4
+    5326 PUSHACC1
+    5327 GETFIELD2
+    5328 PUSHACC2
+    5329 GETFIELD1
+    5330 PUSHACC3
+    5331 GETFIELD0
+    5332 PUSHENVACC1
+    5333 APPTERM 4, 6
+    5336 GETGLOBAL <0>("map.ml", 3614, 3797)
+    5338 PUSHGETGLOBAL Match_failure
+    5340 MAKEBLOCK2 0
+    5342 RAISE
+    5343 RESTART
+    5344 GRAB 1
+    5346 ACC1
+    5347 BRANCHIFNOT 5400
+    5349 ACC1
+    5350 GETFIELD0
+    5351 PUSHACC2
+    5352 GETFIELD1
+    5353 PUSHACC3
+    5354 GETFIELD2
+    5355 PUSHACC4
+    5356 GETFIELD3
+    5357 PUSHACC2
+    5358 PUSHACC5
+    5359 PUSHENVACC1
+    5360 GETFIELD0
+    5361 APPLY2
+    5362 PUSHCONST0
+    5363 PUSHACC1
+    5364 EQ
+    5365 BRANCHIFNOT 5372
+    5367 ACC1
+    5368 PUSHACC5
+    5369 PUSHENVACC3
+    5370 APPTERM2 9
+    5372 CONST0
+    5373 PUSHACC1
+    5374 LTINT
+    5375 BRANCHIFNOT 5389
+    5377 ACC1
+    5378 PUSHACC3
+    5379 PUSHACC5
+    5380 PUSHACC7
+    5381 PUSHACC 9
+    5383 PUSHOFFSETCLOSURE0
+    5384 APPLY2
+    5385 PUSHENVACC2
+    5386 APPTERM 4, 11
+    5389 ACC1
+    5390 PUSHACC6
+    5391 PUSHOFFSETCLOSURE0
+    5392 APPLY2
+    5393 PUSHACC3
+    5394 PUSHACC5
+    5395 PUSHACC7
+    5396 PUSHENVACC2
+    5397 APPTERM 4, 11
+    5400 RETURN 2
+    5402 RESTART
+    5403 GRAB 1
+    5405 ACC1
+    5406 BRANCHIFNOT 5425
+    5408 ACC1
+    5409 GETFIELD0
+    5410 PUSHACC1
+    5411 PUSHOFFSETCLOSURE0
+    5412 APPLY2
+    5413 ACC1
+    5414 GETFIELD2
+    5415 PUSHACC2
+    5416 GETFIELD1
+    5417 PUSHACC2
+    5418 APPLY2
+    5419 ACC1
+    5420 GETFIELD3
+    5421 PUSHACC1
+    5422 PUSHOFFSETCLOSURE0
+    5423 APPTERM2 4
+    5425 RETURN 2
+    5427 RESTART
+    5428 GRAB 1
+    5430 ACC1
+    5431 BRANCHIFNOT 5455
+    5433 ACC1
+    5434 GETFIELD 4
+    5436 PUSHACC2
+    5437 GETFIELD3
+    5438 PUSHACC2
+    5439 PUSHOFFSETCLOSURE0
+    5440 APPLY2
+    5441 PUSHACC3
+    5442 GETFIELD2
+    5443 PUSHACC3
+    5444 APPLY1
+    5445 PUSHACC4
+    5446 GETFIELD1
+    5447 PUSHACC5
+    5448 GETFIELD0
+    5449 PUSHACC5
+    5450 PUSHOFFSETCLOSURE0
+    5451 APPLY2
+    5452 MAKEBLOCK 5, 0
+    5455 RETURN 2
+    5457 RESTART
+    5458 GRAB 2
+    5460 ACC1
+    5461 BRANCHIFNOT 5481
+    5463 ACC2
+    5464 PUSHACC2
+    5465 GETFIELD3
+    5466 PUSHACC2
+    5467 PUSHOFFSETCLOSURE0
+    5468 APPLY3
+    5469 PUSHACC2
+    5470 GETFIELD2
+    5471 PUSHACC3
+    5472 GETFIELD1
+    5473 PUSHACC3
+    5474 APPLY3
+    5475 PUSHACC2
+    5476 GETFIELD0
+    5477 PUSHACC2
+    5478 PUSHOFFSETCLOSURE0
+    5479 APPTERM3 6
+    5481 ACC2
+    5482 RETURN 3
+    5484 RESTART
+    5485 GRAB 3
+    5487 ACC0
+    5488 BRANCHIFNOT 5495
+    5490 ACC0
+    5491 GETFIELD 4
+    5493 BRANCH 5496
+    5495 CONST0
+    5496 PUSHACC4
+    5497 BRANCHIFNOT 5504
+    5499 ACC4
+    5500 GETFIELD 4
+    5502 BRANCH 5505
+    5504 CONST0
+    5505 PUSHACC0
+    5506 OFFSETINT 2
+    5508 PUSHACC2
+    5509 GTINT
+    5510 BRANCHIFNOT 5603
+    5512 ACC2
+    5513 BRANCHIFNOT 5596
+    5515 ACC2
+    5516 GETFIELD0
+    5517 PUSHACC3
+    5518 GETFIELD1
+    5519 PUSHACC4
+    5520 GETFIELD2
+    5521 PUSHACC5
+    5522 GETFIELD3
+    5523 PUSHACC0
+    5524 PUSHENVACC1
+    5525 APPLY1
+    5526 PUSHACC4
+    5527 PUSHENVACC1
+    5528 APPLY1
+    5529 GEINT
+    5530 BRANCHIFNOT 5551
+    5532 PUSH_RETADDR 5544
+    5534 ACC 12
+    5536 PUSHACC 12
+    5538 PUSHACC 12
+    5540 PUSHACC6
+    5541 PUSHENVACC2
+    5542 APPLY 4
+    5544 PUSHACC2
+    5545 PUSHACC4
+    5546 PUSHACC6
+    5547 PUSHENVACC2
+    5548 APPTERM 4, 14
+    5551 ACC0
+    5552 BRANCHIFNOT 5589
+    5554 PUSH_RETADDR 5567
+    5556 ACC 12
+    5558 PUSHACC 12
+    5560 PUSHACC 12
+    5562 PUSHACC6
+    5563 GETFIELD3
+    5564 PUSHENVACC2
+    5565 APPLY 4
+    5567 PUSHACC1
+    5568 GETFIELD2
+    5569 PUSHACC2
+    5570 GETFIELD1
+    5571 PUSH
+    5572 PUSH_RETADDR 5585
+    5574 ACC6
+    5575 GETFIELD0
+    5576 PUSHACC 8
+    5578 PUSHACC 10
+    5580 PUSHACC 12
+    5582 PUSHENVACC2
+    5583 APPLY 4
+    5585 PUSHENVACC2
+    5586 APPTERM 4, 14
+    5589 GETGLOBAL "Map.bal"
+    5591 PUSHGETGLOBALFIELD Pervasives, 2
+    5594 APPTERM1 11
+    5596 GETGLOBAL "Map.bal"
+    5598 PUSHGETGLOBALFIELD Pervasives, 2
+    5601 APPTERM1 7
+    5603 ACC1
+    5604 OFFSETINT 2
+    5606 PUSHACC1
+    5607 GTINT
+    5608 BRANCHIFNOT 5703
+    5610 ACC5
+    5611 BRANCHIFNOT 5696
+    5613 ACC5
+    5614 GETFIELD0
+    5615 PUSHACC6
+    5616 GETFIELD1
+    5617 PUSHACC7
+    5618 GETFIELD2
+    5619 PUSHACC 8
+    5621 GETFIELD3
+    5622 PUSHACC3
+    5623 PUSHENVACC1
+    5624 APPLY1
+    5625 PUSHACC1
+    5626 PUSHENVACC1
+    5627 APPLY1
+    5628 GEINT
+    5629 BRANCHIFNOT 5652
+    5631 ACC0
+    5632 PUSHACC2
+    5633 PUSHACC4
+    5634 PUSH
+    5635 PUSH_RETADDR 5648
+    5637 ACC 9
+    5639 PUSHACC 15
+    5641 PUSHACC 15
+    5643 PUSHACC 15
+    5645 PUSHENVACC2
+    5646 APPLY 4
+    5648 PUSHENVACC2
+    5649 APPTERM 4, 14
+    5652 ACC3
+    5653 BRANCHIFNOT 5689
+    5655 PUSH_RETADDR 5666
+    5657 ACC3
+    5658 PUSHACC5
+    5659 PUSHACC7
+    5660 PUSHACC 9
+    5662 GETFIELD3
+    5663 PUSHENVACC2
+    5664 APPLY 4
+    5666 PUSHACC4
+    5667 GETFIELD2
+    5668 PUSHACC5
+    5669 GETFIELD1
+    5670 PUSH
+    5671 PUSH_RETADDR 5685
+    5673 ACC 9
+    5675 GETFIELD0
+    5676 PUSHACC 15
+    5678 PUSHACC 15
+    5680 PUSHACC 15
+    5682 PUSHENVACC2
+    5683 APPLY 4
+    5685 PUSHENVACC2
+    5686 APPTERM 4, 14
+    5689 GETGLOBAL "Map.bal"
+    5691 PUSHGETGLOBALFIELD Pervasives, 2
+    5694 APPTERM1 11
+    5696 GETGLOBAL "Map.bal"
+    5698 PUSHGETGLOBALFIELD Pervasives, 2
+    5701 APPTERM1 7
+    5703 ACC0
+    5704 PUSHACC2
+    5705 GEINT
+    5706 BRANCHIFNOT 5713
+    5708 ACC1
+    5709 OFFSETINT 1
+    5711 BRANCH 5716
+    5713 ACC0
+    5714 OFFSETINT 1
+    5716 PUSHACC6
+    5717 PUSHACC6
+    5718 PUSHACC6
+    5719 PUSHACC6
+    5720 MAKEBLOCK 5, 0
+    5723 RETURN 6
+    5725 RESTART
+    5726 GRAB 3
+    5728 ACC0
+    5729 PUSHENVACC1
+    5730 APPLY1
+    5731 PUSHACC4
+    5732 PUSHENVACC1
+    5733 APPLY1
+    5734 PUSHACC0
+    5735 PUSHACC2
+    5736 GEINT
+    5737 BRANCHIFNOT 5744
+    5739 ACC1
+    5740 OFFSETINT 1
+    5742 BRANCH 5747
+    5744 ACC0
+    5745 OFFSETINT 1
+    5747 PUSHACC6
+    5748 PUSHACC6
+    5749 PUSHACC6
+    5750 PUSHACC6
+    5751 MAKEBLOCK 5, 0
+    5754 RETURN 6
+    5756 ACC0
+    5757 BRANCHIFNOT 5764
+    5759 ACC0
+    5760 GETFIELD 4
+    5762 RETURN 1
+    5764 CONST0
+    5765 RETURN 1
+    5767 CONST0
+    5768 PUSH
+    5769 CLOSURE 0, 5756
+    5772 PUSHACC0
+    5773 CLOSURE 1, 5726
+    5776 PUSHACC0
+    5777 PUSHACC2
+    5778 CLOSURE 2, 5485
+    5781 PUSHACC0
+    5782 PUSHACC5
+    5783 CLOSUREREC 2, 5132
+    5787 ACC5
+    5788 CLOSUREREC 1, 5212
+    5792 ACC6
+    5793 CLOSUREREC 1, 5253
+    5797 ACC3
+    5798 CLOSUREREC 1, 5289
+    5802 ACC0
+    5803 PUSHACC5
+    5804 PUSHACC 10
+    5806 CLOSUREREC 3, 5344
+    5810 CLOSUREREC 0, 5403
+    5814 CLOSUREREC 0, 5428
+    5818 CLOSUREREC 0, 5458
+    5822 ACC0
+    5823 PUSHACC2
+    5824 PUSHACC4
+    5825 PUSHACC6
+    5826 PUSHACC 8
+    5828 PUSHACC 10
+    5830 PUSHACC 12
+    5832 PUSHACC 14
+    5834 PUSHACC 16
+    5836 PUSHACC 18
+    5838 PUSHACC 20
+    5840 PUSHACC 22
+    5842 MAKEBLOCK 12, 0
+    5845 RETURN 13
+    5847 CLOSURE 0, 5767
+    5850 PUSHACC0
+    5851 CLOSURE 1, 5100
+    5854 MAKEBLOCK1 0
+    5856 POP 1
+    5858 SETGLOBAL Map
+    5860 BRANCH 5957
+    5862 CONSTINT 16
+    5864 C_CALL1 create_string
+    5866 PUSH
+    5867 PUSH_RETADDR 5879
+    5869 CONSTINT 16
+    5871 PUSHCONST0
+    5872 PUSHACC5
+    5873 PUSHACC7
+    5874 PUSHGETGLOBALFIELD Pervasives, 56
+    5877 APPLY 4
+    5879 ACC0
+    5880 RETURN 2
+    5882 RESTART
+    5883 GRAB 1
+    5885 CONSTINT 16
+    5887 PUSHCONST0
+    5888 PUSHACC3
+    5889 PUSHACC3
+    5890 PUSHGETGLOBALFIELD Pervasives, 41
+    5893 APPTERM 4, 6
+    5896 ACC0
+    5897 PUSHGETGLOBALFIELD Pervasives, 51
+    5900 APPLY1
+    5901 PUSHACC0
+    5902 PUSHGETGLOBALFIELD Pervasives, 62
+    5905 APPLY1
+    5906 PUSHACC1
+    5907 C_CALL2 md5_chan
+    5909 PUSHACC1
+    5910 PUSHGETGLOBALFIELD Pervasives, 63
+    5913 APPLY1
+    5914 ACC0
+    5915 RETURN 3
+    5917 RESTART
+    5918 GRAB 2
+    5920 CONST0
+    5921 PUSHACC2
+    5922 LTINT
+    5923 BRANCHIF 5934
+    5925 ACC0
+    5926 C_CALL1 ml_string_length
+    5928 PUSHACC3
+    5929 PUSHACC3
+    5930 ADDINT
+    5931 GTINT
+    5932 BRANCHIFNOT 5941
+    5934 GETGLOBAL "Digest.substring"
+    5936 PUSHGETGLOBALFIELD Pervasives, 2
+    5939 APPTERM1 4
+    5941 ACC2
+    5942 PUSHACC2
+    5943 PUSHACC2
+    5944 C_CALL3 md5_string
+    5946 RETURN 3
+    5948 ACC0
+    5949 C_CALL1 ml_string_length
+    5951 PUSHCONST0
+    5952 PUSHACC2
+    5953 C_CALL3 md5_string
+    5955 RETURN 1
+    5957 CLOSURE 0, 5948
+    5960 PUSH
+    5961 CLOSURE 0, 5918
+    5964 PUSH
+    5965 CLOSURE 0, 5896
+    5968 PUSH
+    5969 CLOSURE 0, 5883
+    5972 PUSH
+    5973 CLOSURE 0, 5862
+    5976 PUSHACC0
+    5977 PUSHACC2
+    5978 PUSHACC4
+    5979 PUSHACC6
+    5980 PUSHACC 8
+    5982 MAKEBLOCK 5, 0
+    5985 POP 5
+    5987 SETGLOBAL Digest
+    5989 BRANCH 6245
+    5991 CONST0
+    5992 PUSHENVACC1
+    5993 APPLY1
+    5994 PUSHACC1
+    5995 PUSHACC1
+    5996 GEINT
+    5997 BRANCHIFNOT 6003
+    5999 ACC1
+    6000 PUSHOFFSETCLOSURE0
+    6001 APPTERM1 3
+    6003 ACC0
+    6004 RETURN 2
+    6006 CONST0
+    6007 C_CALL1 sys_random_seed
+    6009 PUSHENVACC1
+    6010 APPTERM1 2
+    6012 CONSTINT 27182818
+    6014 PUSHENVACC2
+    6015 APPLY1
+    6016 CONST0
+    6017 PUSHACC1
+    6018 VECTLENGTH
+    6019 OFFSETINT -1
+    6021 PUSH
+    6022 BRANCH 6046
+    6024 CHECK_SIGNALS
+    6025 CONSTINT 55
+    6027 PUSHACC2
+    6028 MODINT
+    6029 PUSHACC2
+    6030 PUSHACC4
+    6031 GETVECTITEM
+    6032 PUSHACC1
+    6033 PUSHENVACC1
+    6034 GETVECTITEM
+    6035 ADDINT
+    6036 PUSHACC1
+    6037 PUSHENVACC1
+    6038 SETVECTITEM
+    6039 POP 1
+    6041 ACC1
+    6042 OFFSETINT 1
+    6044 ASSIGN 1
+    6046 ACC0
+    6047 PUSHACC2
+    6048 LEINT
+    6049 BRANCHIF 6024
+    6051 CONST0
+    6052 RETURN 3
+    6054 ENVACC1
+    6055 GETFIELD0
+    6056 OFFSETINT 1
+    6058 PUSHENVACC1
+    6059 SETFIELD0
+    6060 ENVACC1
+    6061 GETFIELD0
+    6062 PUSHGETGLOBALFIELD Pervasives, 14
+    6065 APPLY1
+    6066 PUSHGETGLOBALFIELD Digest, 0
+    6069 APPLY1
+    6070 PUSHCONSTINT 22
+    6072 PUSHCONST3
+    6073 PUSHACC2
+    6074 C_CALL2 string_get
+    6076 LSLINT
+    6077 PUSHCONSTINT 16
+    6079 PUSHCONST2
+    6080 PUSHACC3
+    6081 C_CALL2 string_get
+    6083 LSLINT
+    6084 PUSHCONSTINT 8
+    6086 PUSHCONST1
+    6087 PUSHACC4
+    6088 C_CALL2 string_get
+    6090 LSLINT
+    6091 PUSHCONST0
+    6092 PUSHACC4
+    6093 C_CALL2 string_get
+    6095 ADDINT
+    6096 ADDINT
+    6097 XORINT
+    6098 RETURN 2
+    6100 ACC0
+    6101 MAKEBLOCK1 0
+    6103 PUSHACC0
+    6104 CLOSURE 1, 6054
+    6107 PUSHCONST0
+    6108 PUSHCONSTINT 54
+    6110 PUSH
+    6111 BRANCH 6125
+    6113 CHECK_SIGNALS
+    6114 CONST0
+    6115 PUSHACC3
+    6116 APPLY1
+    6117 PUSHACC2
+    6118 PUSHENVACC1
+    6119 SETVECTITEM
+    6120 ACC1
+    6121 OFFSETINT 1
+    6123 ASSIGN 1
+    6125 ACC0
+    6126 PUSHACC2
+    6127 LEINT
+    6128 BRANCHIF 6113
+    6130 CONST0
+    6131 POP 2
+    6133 CONST0
+    6134 PUSHENVACC2
+    6135 SETFIELD0
+    6136 RETURN 3
+    6138 ACC0
+    6139 PUSHCONST0
+    6140 PUSHENVACC1
+    6141 APPLY1
+    6142 C_CALL2 mul_float
+    6144 RETURN 1
+    6146 CONSTINT 1073741823
+    6148 PUSHACC1
+    6149 GTINT
+    6150 BRANCHIF 6157
+    6152 CONST0
+    6153 PUSHACC1
+    6154 LEINT
+    6155 BRANCHIFNOT 6164
+    6157 GETGLOBAL "Random.int"
+    6159 PUSHGETGLOBALFIELD Pervasives, 2
+    6162 APPTERM1 2
+    6164 ACC0
+    6165 PUSHACC1
+    6166 PUSHACC2
+    6167 PUSHCONSTINT 1073741823
+    6169 DIVINT
+    6170 MULINT
+    6171 PUSHENVACC1
+    6172 APPLY1
+    6173 MODINT
+    6174 RETURN 1
+    6176 GETGLOBAL 1073741824
+    6178 PUSHCONST0
+    6179 PUSHENVACC1
+    6180 APPLY1
+    6181 C_CALL1 float_of_int
+    6183 PUSHCONST0
+    6184 PUSHENVACC1
+    6185 APPLY1
+    6186 C_CALL1 float_of_int
+    6188 PUSHCONST0
+    6189 PUSHENVACC1
+    6190 APPLY1
+    6191 C_CALL1 float_of_int
+    6193 PUSHACC3
+    6194 PUSHACC1
+    6195 PUSHACC5
+    6196 PUSHACC4
+    6197 PUSHACC7
+    6198 PUSHACC7
+    6199 C_CALL2 div_float
+    6201 C_CALL2 add_float
+    6203 C_CALL2 div_float
+    6205 C_CALL2 add_float
+    6207 C_CALL2 div_float
+    6209 RETURN 5
+    6211 CONSTINT 55
+    6213 PUSHENVACC2
+    6214 GETFIELD0
+    6215 OFFSETINT 1
+    6217 MODINT
+    6218 PUSHENVACC2
+    6219 SETFIELD0
+    6220 ENVACC2
+    6221 GETFIELD0
+    6222 PUSHENVACC1
+    6223 GETVECTITEM
+    6224 PUSHCONSTINT 55
+    6226 PUSHENVACC2
+    6227 GETFIELD0
+    6228 OFFSETINT 24
+    6230 MODINT
+    6231 PUSHENVACC1
+    6232 GETVECTITEM
+    6233 ADDINT
+    6234 PUSHACC0
+    6235 PUSHENVACC2
+    6236 GETFIELD0
+    6237 PUSHENVACC1
+    6238 SETVECTITEM
+    6239 CONSTINT 1073741823
+    6241 PUSHACC1
+    6242 ANDINT
+    6243 RETURN 2
+    6245 CONSTINT 440266690
+    6247 PUSHCONSTINT 124177607
+    6249 PUSHCONSTINT 414576093
+    6251 PUSHCONSTINT 180326017
+    6253 PUSHCONSTINT 33747835
+    6255 PUSHCONSTINT 896816596
+    6257 PUSHCONSTINT 21528564
+    6259 PUSHCONSTINT 414383108
+    6261 PUSHCONSTINT 514922558
+    6263 PUSHCONSTINT 979459837
+    6265 PUSHCONSTINT 146577263
+    6267 PUSHCONSTINT 714526560
+    6269 PUSHCONSTINT 187230644
+    6271 PUSHCONSTINT 22990936
+    6273 PUSHCONSTINT 310632349
+    6275 PUSHCONSTINT 781847598
+    6277 PUSHCONSTINT 854580894
+    6279 PUSHCONSTINT 804670393
+    6281 PUSHCONSTINT 268309077
+    6283 PUSHCONSTINT 4136554
+    6285 PUSHCONSTINT 567327260
+    6287 PUSHCONSTINT 768795410
+    6289 PUSHCONSTINT 868098973
+    6291 PUSHCONSTINT 462134267
+    6293 PUSHCONSTINT 32881167
+    6295 PUSHCONSTINT 708896334
+    6297 PUSHCONSTINT 572927557
+    6299 PUSHCONSTINT 933858406
+    6301 PUSHCONSTINT 965168955
+    6303 PUSHCONSTINT 233350272
+    6305 PUSHCONSTINT 878960411
+    6307 PUSHCONSTINT 971004788
+    6309 PUSHCONSTINT 762624501
+    6311 PUSHCONSTINT 796925167
+    6313 PUSHCONSTINT 206134737
+    6315 PUSHCONSTINT 281896889
+    6317 PUSHCONSTINT 814302728
+    6319 PUSHCONSTINT 477485839
+    6321 PUSHCONSTINT 998499212
+    6323 PUSHCONSTINT 473370118
+    6325 PUSHCONSTINT 66770770
+    6327 PUSHCONSTINT 337696531
+    6329 PUSHCONSTINT 848741663
+    6331 PUSHCONSTINT 71648846
+    6333 PUSHCONSTINT 869261341
+    6335 PUSHCONSTINT 951240904
+    6337 PUSHCONSTINT 147054819
+    6339 PUSHCONSTINT 486882977
+    6341 PUSHCONSTINT 552627506
+    6343 PUSHCONSTINT 615350359
+    6345 PUSHCONSTINT 1023641486
+    6347 PUSHCONSTINT 9858203
+    6349 PUSHCONSTINT 764306064
+    6351 PUSHCONSTINT 1051173471
+    6353 PUSHCONSTINT 561073064
+    6355 MAKEBLOCK 55, 0
+    6358 PUSHCONST0
+    6359 MAKEBLOCK1 0
+    6361 PUSHACC0
+    6362 PUSHACC2
+    6363 CLOSURE 2, 6211
+    6366 PUSHACC0
+    6367 CLOSURE 1, 6176
+    6370 PUSHACC1
+    6371 CLOSUREREC 1, 5991
+    6375 ACC0
+    6376 CLOSURE 1, 6146
+    6379 PUSHACC2
+    6380 CLOSURE 1, 6138
+    6383 PUSHACC5
+    6384 PUSHACC7
+    6385 CLOSURE 2, 6100
+    6388 PUSHACC0
+    6389 PUSHACC 8
+    6391 CLOSURE 2, 6012
+    6394 PUSHACC1
+    6395 CLOSURE 1, 6006
+    6398 PUSHACC3
+    6399 PUSHACC5
+    6400 PUSHACC 9
+    6402 PUSHACC3
+    6403 PUSHACC5
+    6404 PUSHACC7
+    6405 MAKEBLOCK 6, 0
+    6408 POP 10
+    6410 SETGLOBAL Random
+    6412 BRANCH 8038
+    6414 RESTART
+    6415 GRAB 1
+    6417 ACC1
+    6418 BRANCHIFNOT 6441
+    6420 ACC1
+    6421 GETFIELD0
+    6422 PUSHACC2
+    6423 GETFIELD1
+    6424 PUSHACC1
+    6425 PUSHACC3
+    6426 EQ
+    6427 BRANCHIFNOT 6432
+    6429 ACC0
+    6430 RETURN 4
+    6432 ACC0
+    6433 PUSHACC3
+    6434 PUSHOFFSETCLOSURE0
+    6435 APPLY2
+    6436 PUSHACC2
+    6437 MAKEBLOCK2 0
+    6439 POP 2
+    6441 RETURN 2
+    6443 RESTART
+    6444 GRAB 1
+    6446 CONST0
+    6447 PUSHACC2
+    6448 GTINT
+    6449 BRANCHIFNOT 6512
+    6451 CONST0
+    6452 PUSHENVACC2
+    6453 GETFIELD0
+    6454 GTINT
+    6455 BRANCHIFNOT 6512
+    6457 ENVACC2
+    6458 GETFIELD0
+    6459 PUSHGETGLOBALFIELD Random, 4
+    6462 APPLY1
+    6463 PUSHACC0
+    6464 PUSHENVACC1
+    6465 GETFIELD0
+    6466 C_CALL2 array_get_addr
+    6468 PUSHENVACC 5
+    6470 APPLY1
+    6471 BRANCHIF 6482
+    6473 ACC0
+    6474 PUSHENVACC 4
+    6476 APPLY1
+    6477 ACC2
+    6478 PUSHACC2
+    6479 PUSHOFFSETCLOSURE0
+    6480 APPTERM2 5
+    6482 PUSHTRAP 6496
+    6484 ACC5
+    6485 PUSHACC5
+    6486 PUSHENVACC1
+    6487 GETFIELD0
+    6488 C_CALL2 array_get_addr
+    6490 PUSHENVACC 7
+    6492 APPLY2
+    6493 POPTRAP
+    6494 RETURN 3
+    6496 PUSHENVACC 6
+    6498 PUSHACC1
+    6499 GETFIELD0
+    6500 EQ
+    6501 BRANCHIFNOT 6510
+    6503 ACC3
+    6504 OFFSETINT -1
+    6506 PUSHACC3
+    6507 PUSHOFFSETCLOSURE0
+    6508 APPTERM2 6
+    6510 ACC0
+    6511 RAISE
+    6512 ACC0
+    6513 PUSHENVACC3
+    6514 APPLY1
+    6515 ACC0
+    6516 RETURN 2
+    6518 RESTART
+    6519 GRAB 1
+    6521 ACC1
+    6522 BRANCHIFNOT 6534
+    6524 ACC0
+    6525 PUSHACC2
+    6526 GETFIELD0
+    6527 APPLY1
+    6528 ACC1
+    6529 GETFIELD1
+    6530 PUSHACC1
+    6531 PUSHOFFSETCLOSURE0
+    6532 APPTERM2 4
+    6534 RETURN 2
+    6536 CONST0
+    6537 PUSHENVACC1
+    6538 OFFSETINT -1
+    6540 PUSH
+    6541 BRANCH 6567
+    6543 CHECK_SIGNALS
+    6544 ENVACC2
+    6545 PUSHACC2
+    6546 PUSHACC4
+    6547 C_CALL2 array_get
+    6549 EQ
+    6550 BRANCHIFNOT 6556
+    6552 CONSTINT 46
+    6554 BRANCH 6558
+    6556 CONSTINT 42
+    6558 PUSHGETGLOBALFIELD Pervasives, 20
+    6561 APPLY1
+    6562 ACC1
+    6563 OFFSETINT 1
+    6565 ASSIGN 1
+    6567 ACC0
+    6568 PUSHACC2
+    6569 LEINT
+    6570 BRANCHIF 6543
+    6572 CONST0
+    6573 POP 2
+    6575 CONST0
+    6576 PUSHGETGLOBALFIELD Pervasives, 25
+    6579 APPTERM1 2
+    6581 ENVACC3
+    6582 GETFIELD0
+    6583 PUSHENVACC 4
+    6585 APPLY1
+    6586 PUSHENVACC2
+    6587 PUSHENVACC1
+    6588 CLOSURE 2, 6536
+    6591 PUSHGETGLOBALFIELD List, 9
+    6594 APPTERM2 3
+    6596 ACC0
+    6597 GETFIELD1
+    6598 RETURN 1
+    6600 RESTART
+    6601 GRAB 1
+    6603 ACC1
+    6604 GETFIELD0
+    6605 PUSHACC1
+    6606 GETFIELD0
+    6607 LEINT
+    6608 RETURN 2
+    6610 ACC0
+    6611 PUSHACC1
+    6612 PUSHENVACC1
+    6613 APPLY1
+    6614 MAKEBLOCK2 0
+    6616 RETURN 1
+    6618 ACC0
+    6619 PUSHENVACC1
+    6620 CLOSURE 1, 6610
+    6623 PUSHGETGLOBALFIELD List, 10
+    6626 APPLY2
+    6627 PUSH
+    6628 CLOSURE 0, 6601
+    6631 PUSHGETGLOBALFIELD Sort, 0
+    6634 APPLY2
+    6635 PUSH
+    6636 CLOSURE 0, 6596
+    6639 PUSHGETGLOBALFIELD List, 10
+    6642 APPTERM2 3
+    6644 ENVACC3
+    6645 GETFIELD0
+    6646 VECTLENGTH
+    6647 PUSHENVACC 4
+    6649 GETFIELD0
+    6650 PUSHCONST0
+    6651 PUSHENVACC 8
+    6653 APPLY1
+    6654 PUSHENVACC2
+    6655 GETFIELD0
+    6656 PUSHGETGLOBALFIELD List, 0
+    6659 APPLY1
+    6660 PUSHENVACC 7
+    6662 GETFIELD0
+    6663 PUSHENVACC 6
+    6665 GETFIELD0
+    6666 PUSHENVACC1
+    6667 GETFIELD0
+    6668 PUSHENVACC 5
+    6670 GETFIELD0
+    6671 MAKEBLOCK 8, 0
+    6674 RETURN 1
+    6676 ACC0
+    6677 PUSHENVACC1
+    6678 APPLY1
+    6679 PUSHACC0
+    6680 OFFSETINT -1
+    6682 PUSHENVACC2
+    6683 C_CALL2 array_get_addr
+    6685 OFFSETINT 1
+    6687 PUSHACC1
+    6688 OFFSETINT -1
+    6690 PUSHENVACC2
+    6691 C_CALL3 array_set_addr
+    6693 RETURN 2
+    6695 CONST0
+    6696 PUSHCONSTINT 32
+    6698 C_CALL2 make_vect
+    6700 PUSHENVACC1
+    6701 GETFIELD0
+    6702 PUSHACC1
+    6703 PUSHENVACC2
+    6704 CLOSURE 2, 6676
+    6707 PUSHGETGLOBALFIELD List, 9
+    6710 APPLY2
+    6711 ACC0
+    6712 RETURN 2
+    6714 RESTART
+    6715 GRAB 1
+    6717 ACC1
+    6718 PUSHENVACC1
+    6719 APPLY1
+    6720 PUSHACC1
+    6721 PUSHACC1
+    6722 GETFIELD1
+    6723 PUSHACC2
+    6724 GETFIELD0
+    6725 PUSHCONST0
+    6726 PUSHACC5
+    6727 C_CALL2 array_get_addr
+    6729 C_CALL2 array_get_addr
+    6731 C_CALL2 array_get_addr
+    6733 APPTERM1 4
+    6735 ACC0
+    6736 GETFIELD0
+    6737 C_CALL1 obj_dup
+    6739 PUSHENVACC1
+    6740 PUSHACC1
+    6741 PUSHENVACC2
+    6742 APPLY2
+    6743 ACC1
+    6744 GETFIELD2
+    6745 PUSHACC1
+    6746 PUSHENVACC3
+    6747 APPLY2
+    6748 ACC0
+    6749 RETURN 2
+    6751 RESTART
+    6752 GRAB 1
+    6754 ACC1
+    6755 GETFIELD 7
+    6757 PUSHCONST0
+    6758 PUSHACC1
+    6759 NEQ
+    6760 BRANCHIFNOT 6767
+    6762 ACC0
+    6763 PUSHACC2
+    6764 PUSHENVACC1
+    6765 APPTERM2 5
+    6767 RETURN 3
+    6769 ACC0
+    6770 GETFIELD0
+    6771 PUSHENVACC1
+    6772 C_CALL2 obj_block
+    6774 PUSHACC1
+    6775 GETFIELD1
+    6776 PUSHCONST0
+    6777 PUSHACC2
+    6778 C_CALL3 array_unsafe_set
+    6780 ENVACC2
+    6781 PUSHACC1
+    6782 PUSHENVACC3
+    6783 APPLY2
+    6784 ACC0
+    6785 RETURN 2
+    6787 ACC0
+    6788 GETFIELD0
+    6789 PUSHENVACC3
+    6790 GETFIELD0
+    6791 ADDINT
+    6792 OFFSETINT -1
+    6794 PUSHENVACC3
+    6795 SETFIELD0
+    6796 ENVACC1
+    6797 GETFIELD0
+    6798 BRANCHIFNOT 6804
+    6800 ACC0
+    6801 GETFIELD1
+    6802 PUSHENVACC2
+    6803 APPLY1
+    6804 ACC0
+    6805 GETFIELD 7
+    6807 PUSHGETGLOBALFIELD List, 4
+    6810 APPLY1
+    6811 PUSHACC1
+    6812 SETFIELD 7
+    6814 RETURN 1
+    6816 ACC0
+    6817 PUSHENVACC1
+    6818 APPLY1
+    6819 PUSHENVACC 4
+    6821 GETFIELD2
+    6822 PUSHACC1
+    6823 PUSHACC3
+    6824 PUSHENVACC2
+    6825 GETFIELD1
+    6826 APPLY3
+    6827 PUSHENVACC 4
+    6829 SETFIELD2
+    6830 ENVACC4
+    6831 GETFIELD3
+    6832 PUSHCONST1
+    6833 PUSHACC2
+    6834 PUSHENVACC3
+    6835 GETFIELD1
+    6836 APPLY3
+    6837 PUSHENVACC 4
+    6839 SETFIELD3
+    6840 RETURN 2
+    6842 CONST0
+    6843 PUSHENVACC 4
+    6845 APPLY1
+    6846 PUSHACC1
+    6847 PUSHACC1
+    6848 PUSHENVACC3
+    6849 PUSHENVACC2
+    6850 PUSHENVACC1
+    6851 CLOSURE 4, 6816
+    6854 PUSHGETGLOBALFIELD List, 9
+    6857 APPLY2
+    6858 ACC0
+    6859 RETURN 2
+    6861 RESTART
+    6862 GRAB 1
+    6864 ACC0
+    6865 GETFIELD 7
+    6867 PUSHACC2
+    6868 MAKEBLOCK2 0
+    6870 PUSHACC1
+    6871 SETFIELD 7
+    6873 RETURN 2
+    6875 ENVACC1
+    6876 PUSHENVACC3
+    6877 PUSH
+    6878 BRANCH 6895
+    6880 CHECK_SIGNALS
+    6881 ACC1
+    6882 PUSHENVACC2
+    6883 GETVECTITEM
+    6884 PUSHENVACC 4
+    6886 PUSHACC3
+    6887 ADDINT
+    6888 PUSHACC4
+    6889 SETVECTITEM
+    6890 ACC1
+    6891 OFFSETINT 1
+    6893 ASSIGN 1
+    6895 ACC0
+    6896 PUSHACC2
+    6897 LEINT
+    6898 BRANCHIF 6880
+    6900 CONST0
+    6901 RETURN 3
+    6903 ENVACC2
+    6904 GETFIELD0
+    6905 PUSHENVACC2
+    6906 GETFIELD2
+    6907 GETFIELD0
+    6908 OFFSETINT -1
+    6910 PUSHENVACC3
+    6911 GETFIELD0
+    6912 OFFSETINT -1
+    6914 PUSHACC1
+    6915 PUSHACC1
+    6916 SUBINT
+    6917 PUSHACC0
+    6918 PUSHACC3
+    6919 PUSHACC5
+    6920 PUSHENVACC1
+    6921 CLOSURE 4, 6875
+    6924 RETURN 5
+    6926 RESTART
+    6927 GRAB 1
+    6929 CONST0
+    6930 ACC1
+    6931 PUSHACC1
+    6932 PUSHENVACC1
+    6933 CLOSURE 3, 6903
+    6936 RETURN 2
+    6938 RESTART
+    6939 GRAB 1
+    6941 ACC0
+    6942 GETFIELD 6
+    6944 PUSHACC2
+    6945 PUSHENVACC1
+    6946 GETFIELD2
+    6947 APPTERM2 4
+    6949 RESTART
+    6950 GRAB 1
+    6952 ACC0
+    6953 PUSHENVACC2
+    6954 APPLY1
+    6955 PUSHACC1
+    6956 GETFIELD 6
+    6958 PUSHACC1
+    6959 PUSHACC4
+    6960 PUSHENVACC1
+    6961 GETFIELD1
+    6962 APPLY3
+    6963 PUSHACC2
+    6964 SETFIELD 6
+    6966 ACC0
+    6967 RETURN 3
+    6969 ACC0
+    6970 GETFIELD0
+    6971 PUSHACC0
+    6972 OFFSETINT 1
+    6974 PUSHACC2
+    6975 SETFIELD0
+    6976 ACC0
+    6977 RETURN 2
+    6979 RESTART
+    6980 GRAB 1
+    6982 CONST0
+    6983 PUSHACC1
+    6984 PUSHACC3
+    6985 GETFIELD1
+    6986 APPTERM2 4
+    6988 RESTART
+    6989 GRAB 1
+    6991 ENVACC1
+    6992 GETFIELD 4
+    6994 PUSHACC1
+    6995 GETFIELD0
+    6996 PUSHGETGLOBALFIELD List, 23
+    6999 APPLY2
+    7000 BRANCHIFNOT 7005
+    7002 ACC1
+    7003 RETURN 2
+    7005 ACC1
+    7006 PUSHACC1
+    7007 MAKEBLOCK2 0
+    7009 RETURN 2
+    7011 RESTART
+    7012 GRAB 1
+    7014 ACC0
+    7015 PUSHENVACC2
+    7016 GETFIELD 6
+    7018 PUSHACC3
+    7019 PUSHENVACC1
+    7020 GETFIELD2
+    7021 APPLY2
+    7022 PUSHACC3
+    7023 PUSHENVACC1
+    7024 GETFIELD1
+    7025 APPTERM3 5
+    7027 ACC0
+    7028 GETFIELD 4
+    7030 PUSHGETGLOBALFIELD List, 1
+    7033 APPLY1
+    7034 PUSHACC1
+    7035 GETFIELD 4
+    7037 PUSHGETGLOBALFIELD List, 2
+    7040 APPLY1
+    7041 PUSHACC2
+    7042 SETFIELD 4
+    7044 ACC0
+    7045 GETFIELD 5
+    7047 PUSHACC1
+    7048 GETFIELD3
+    7049 PUSHACC3
+    7050 PUSHENVACC1
+    7051 CLOSURE 2, 7012
+    7054 PUSHGETGLOBALFIELD List, 12
+    7057 APPLY3
+    7058 PUSHACC2
+    7059 SETFIELD 6
+    7061 ACC0
+    7062 GETFIELD0
+    7063 PUSHACC2
+    7064 SETFIELD2
+    7065 ACC0
+    7066 GETFIELD1
+    7067 PUSHACC2
+    7068 SETFIELD3
+    7069 ACC0
+    7070 GETFIELD2
+    7071 PUSHACC2
+    7072 GETFIELD 5
+    7074 PUSHACC2
+    7075 CLOSURE 1, 6989
+    7078 PUSHGETGLOBALFIELD List, 13
+    7081 APPLY3
+    7082 PUSHACC2
+    7083 SETFIELD 5
+    7085 RETURN 2
+    7087 RESTART
+    7088 GRAB 1
+    7090 ENVACC1
+    7091 PUSHACC1
+    7092 GETFIELD0
+    7093 PUSHGETGLOBALFIELD List, 23
+    7096 APPLY2
+    7097 BRANCHIFNOT 7102
+    7099 ACC1
+    7100 RETURN 2
+    7102 ACC1
+    7103 PUSHACC1
+    7104 MAKEBLOCK2 0
+    7106 RETURN 2
+    7108 RESTART
+    7109 GRAB 1
+    7111 ENVACC3
+    7112 GETFIELD0
+    7113 PUSHACC2
+    7114 PUSHACC2
+    7115 PUSHENVACC1
+    7116 GETFIELD1
+    7117 APPLY3
+    7118 PUSHENVACC3
+    7119 SETFIELD0
+    7120 ENVACC4
+    7121 GETFIELD0
+    7122 PUSHCONST0
+    7123 PUSHACC3
+    7124 PUSHENVACC2
+    7125 GETFIELD1
+    7126 APPLY3
+    7127 PUSHENVACC 4
+    7129 SETFIELD0
+    7130 RETURN 2
+    7132 ACC0
+    7133 PUSHENVACC 4
+    7135 PUSHENVACC3
+    7136 APPLY2
+    7137 PUSHENVACC 5
+    7139 GETFIELD0
+    7140 PUSHACC1
+    7141 PUSHACC3
+    7142 PUSHENVACC1
+    7143 GETFIELD1
+    7144 APPLY3
+    7145 PUSHENVACC 5
+    7147 SETFIELD0
+    7148 ENVACC 6
+    7150 GETFIELD0
+    7151 PUSH
+    7152 PUSHTRAP 7163
+    7154 ENVACC4
+    7155 GETFIELD3
+    7156 PUSHACC6
+    7157 PUSHENVACC2
+    7158 GETFIELD2
+    7159 APPLY2
+    7160 POPTRAP
+    7161 BRANCH 7177
+    7163 PUSHGETGLOBAL Not_found
+    7165 PUSHACC1
+    7166 GETFIELD0
+    7167 EQ
+    7168 BRANCHIFNOT 7173
+    7170 CONST1
+    7171 BRANCH 7175
+    7173 ACC0
+    7174 RAISE
+    7175 POP 1
+    7177 PUSHACC2
+    7178 PUSHENVACC2
+    7179 GETFIELD1
+    7180 APPLY3
+    7181 PUSHENVACC 6
+    7183 SETFIELD0
+    7184 RETURN 2
+    7186 RESTART
+    7187 GRAB 3
+    7189 ACC2
+    7190 PUSHACC1
+    7191 PUSHENVACC 4
+    7193 APPLY1
+    7194 PUSHGETGLOBALFIELD List, 10
+    7197 APPLY2
+    7198 PUSHACC1
+    7199 GETFIELD 4
+    7201 PUSHACC3
+    7202 PUSHACC2
+    7203 PUSHACC4
+    7204 GETFIELD 6
+    7206 PUSHACC5
+    7207 GETFIELD 5
+    7209 PUSHACC6
+    7210 GETFIELD3
+    7211 PUSHACC7
+    7212 GETFIELD2
+    7213 MAKEBLOCK 6, 0
+    7216 MAKEBLOCK2 0
+    7218 PUSHACC2
+    7219 SETFIELD 4
+    7221 ENVACC1
+    7222 GETFIELD0
+    7223 PUSHACC2
+    7224 SETFIELD 6
+    7226 ENVACC2
+    7227 GETFIELD0
+    7228 MAKEBLOCK1 0
+    7230 PUSHENVACC3
+    7231 GETFIELD0
+    7232 MAKEBLOCK1 0
+    7234 PUSHACC6
+    7235 PUSHACC1
+    7236 PUSHACC3
+    7237 PUSHACC6
+    7238 PUSHENVACC 4
+    7240 PUSHENVACC3
+    7241 PUSHENVACC2
+    7242 CLOSURE 6, 7132
+    7245 PUSHGETGLOBALFIELD List, 9
+    7248 APPLY2
+    7249 ACC2
+    7250 PUSHACC6
+    7251 PUSHACC2
+    7252 PUSHACC4
+    7253 PUSHENVACC3
+    7254 PUSHENVACC2
+    7255 CLOSURE 4, 7109
+    7258 PUSHGETGLOBALFIELD List, 14
+    7261 APPLY3
+    7262 ACC1
+    7263 GETFIELD0
+    7264 PUSHACC4
+    7265 SETFIELD2
+    7266 ACC0
+    7267 GETFIELD0
+    7268 PUSHACC4
+    7269 SETFIELD3
+    7270 CONST0
+    7271 PUSHACC4
+    7272 GETFIELD 5
+    7274 PUSHACC4
+    7275 CLOSURE 1, 7088
+    7278 PUSHGETGLOBALFIELD List, 13
+    7281 APPLY3
+    7282 PUSHACC4
+    7283 SETFIELD 5
+    7285 RETURN 7
+    7287 RESTART
+    7288 GRAB 1
+    7290 PUSHTRAP 7303
+    7292 ACC4
+    7293 GETFIELD 5
+    7295 PUSHACC6
+    7296 PUSHGETGLOBALFIELD List, 29
+    7299 APPLY2
+    7300 POPTRAP
+    7301 RETURN 2
+    7303 PUSHGETGLOBAL Not_found
+    7305 PUSHACC1
+    7306 GETFIELD0
+    7307 EQ
+    7308 BRANCHIFNOT 7325
+    7310 ACC2
+    7311 PUSHENVACC1
+    7312 APPLY1
+    7313 PUSHACC0
+    7314 GETFIELD1
+    7315 PUSHACC1
+    7316 GETFIELD0
+    7317 PUSHACC4
+    7318 GETFIELD1
+    7319 C_CALL2 array_get_addr
+    7321 C_CALL2 array_get
+    7323 RETURN 4
+    7325 ACC0
+    7326 RAISE
+    7327 RESTART
+    7328 GRAB 2
+    7330 ENVACC3
+    7331 OFFSETREF 1
+    7333 ACC0
+    7334 GETFIELD3
+    7335 PUSHACC2
+    7336 PUSHENVACC1
+    7337 GETFIELD2
+    7338 APPLY2
+    7339 BRANCHIFNOT 7347
+    7341 ACC2
+    7342 PUSHACC2
+    7343 PUSHACC2
+    7344 PUSHENVACC2
+    7345 APPTERM3 6
+    7347 ACC0
+    7348 GETFIELD 5
+    7350 PUSHACC3
+    7351 PUSHACC3
+    7352 MAKEBLOCK2 0
+    7354 MAKEBLOCK2 0
+    7356 PUSHACC1
+    7357 SETFIELD 5
+    7359 RETURN 3
+    7361 RESTART
+    7362 GRAB 1
+    7364 PUSHTRAP 7375
+    7366 ACC4
+    7367 GETFIELD2
+    7368 PUSHACC6
+    7369 PUSHENVACC2
+    7370 GETFIELD2
+    7371 APPLY2
+    7372 POPTRAP
+    7373 RETURN 2
+    7375 PUSHGETGLOBAL Not_found
+    7377 PUSHACC1
+    7378 GETFIELD0
+    7379 EQ
+    7380 BRANCHIFNOT 7406
+    7382 CONST0
+    7383 PUSHENVACC1
+    7384 APPLY1
+    7385 PUSHACC2
+    7386 GETFIELD2
+    7387 PUSHACC1
+    7388 PUSHACC5
+    7389 PUSHENVACC2
+    7390 GETFIELD1
+    7391 APPLY3
+    7392 PUSHACC3
+    7393 SETFIELD2
+    7394 ACC2
+    7395 GETFIELD3
+    7396 PUSHCONST1
+    7397 PUSHACC2
+    7398 PUSHENVACC3
+    7399 GETFIELD1
+    7400 APPLY3
+    7401 PUSHACC3
+    7402 SETFIELD3
+    7403 ACC0
+    7404 RETURN 4
+    7406 ACC0
+    7407 RAISE
+    7408 RESTART
+    7409 GRAB 2
+    7411 ACC1
+    7412 PUSHENVACC1
+    7413 APPLY1
+    7414 PUSHACC0
+    7415 GETFIELD0
+    7416 PUSHACC0
+    7417 OFFSETINT 1
+    7419 PUSHACC3
+    7420 PUSHENVACC 4
+    7422 APPLY2
+    7423 ACC0
+    7424 PUSHACC3
+    7425 GETFIELD1
+    7426 C_CALL2 array_get_addr
+    7428 PUSHENVACC2
+    7429 PUSHACC1
+    7430 EQ
+    7431 BRANCHIFNOT 7444
+    7433 CONST0
+    7434 PUSHENVACC3
+    7435 APPLY1
+    7436 ASSIGN 0
+    7438 ACC0
+    7439 PUSHACC2
+    7440 PUSHACC5
+    7441 GETFIELD1
+    7442 C_CALL3 array_set_addr
+    7444 ACC5
+    7445 PUSHACC3
+    7446 GETFIELD1
+    7447 PUSHACC2
+    7448 C_CALL3 array_set
+    7450 RETURN 6
+    7452 RESTART
+    7453 GRAB 1
+    7455 ACC0
+    7456 GETFIELD1
+    7457 VECTLENGTH
+    7458 PUSHACC0
+    7459 PUSHACC3
+    7460 GTINT
+    7461 BRANCHIFNOT 7487
+    7463 ENVACC1
+    7464 PUSHACC3
+    7465 C_CALL2 make_vect
+    7467 PUSH
+    7468 PUSH_RETADDR 7482
+    7470 ACC4
+    7471 PUSHCONST0
+    7472 PUSHACC5
+    7473 PUSHCONST0
+    7474 PUSHACC 9
+    7476 GETFIELD1
+    7477 PUSHGETGLOBALFIELD Array, 8
+    7480 APPLY 5
+    7482 ACC0
+    7483 PUSHACC3
+    7484 SETFIELD1
+    7485 POP 1
+    7487 RETURN 3
+    7489 ENVACC 5
+    7491 OFFSETREF 1
+    7493 CONST0
+    7494 PUSHENVACC2
+    7495 GETFIELD0
+    7496 PUSHCONST0
+    7497 PUSHCONST0
+    7498 PUSHENVACC 4
+    7500 GETFIELD0
+    7501 PUSHENVACC3
+    7502 GETFIELD0
+    7503 PUSH
+    7504 ATOM0
+    7505 PUSHENVACC1
+    7506 MAKEBLOCK 8, 0
+    7509 RETURN 1
+    7511 RESTART
+    7512 GRAB 1
+    7514 ACC1
+    7515 PUSHACC1
+    7516 C_CALL2 compare
+    7518 RETURN 2
+    7520 RESTART
+    7521 GRAB 1
+    7523 ACC1
+    7524 PUSHACC1
+    7525 C_CALL2 compare
+    7527 RETURN 2
+    7529 RESTART
+    7530 GRAB 1
+    7532 ACC1
+    7533 PUSHACC1
+    7534 C_CALL2 compare
+    7536 RETURN 2
+    7538 PUSHTRAP 7549
+    7540 ACC4
+    7541 PUSHENVACC1
+    7542 PUSHGETGLOBALFIELD Hashtbl, 3
+    7545 APPLY2
+    7546 POPTRAP
+    7547 RETURN 1
+    7549 PUSHGETGLOBAL Not_found
+    7551 PUSHACC1
+    7552 GETFIELD0
+    7553 EQ
+    7554 BRANCHIFNOT 7569
+    7556 CONST0
+    7557 PUSHENVACC2
+    7558 APPLY1
+    7559 PUSHACC0
+    7560 PUSHACC3
+    7561 PUSHENVACC1
+    7562 PUSHGETGLOBALFIELD Hashtbl, 2
+    7565 APPLY3
+    7566 ACC0
+    7567 RETURN 3
+    7569 ACC0
+    7570 RAISE
+    7571 ENVACC2
+    7572 GETFIELD0
+    7573 PUSHENVACC2
+    7574 GETFIELD0
+    7575 PUSHENVACC1
+    7576 APPLY1
+    7577 PUSHENVACC2
+    7578 SETFIELD0
+    7579 ACC0
+    7580 RETURN 2
+    7582 ENVACC1
+    7583 PUSHACC1
+    7584 VECTLENGTH
+    7585 OFFSETINT -1
+    7587 PUSH
+    7588 BRANCH 7606
+    7590 CHECK_SIGNALS
+    7591 ACC1
+    7592 PUSHACC3
+    7593 C_CALL2 array_get_addr
+    7595 PUSHENVACC2
+    7596 APPLY1
+    7597 PUSHACC2
+    7598 PUSHACC4
+    7599 C_CALL3 array_set_addr
+    7601 ACC1
+    7602 OFFSETINT 1
+    7604 ASSIGN 1
+    7606 ACC0
+    7607 PUSHACC2
+    7608 LEINT
+    7609 BRANCHIF 7590
+    7611 CONST0
+    7612 RETURN 3
+    7614 ENVACC4
+    7615 PUSHACC1
+    7616 NEQ
+    7617 BRANCHIFNOT 7640
+    7619 ENVACC2
+    7620 GETFIELD0
+    7621 PUSHACC1
+    7622 PUSHENVACC3
+    7623 APPLY1
+    7624 EQ
+    7625 BRANCHIFNOT 7640
+    7627 ACC0
+    7628 PUSHENVACC 5
+    7630 APPLY1
+    7631 BRANCHIFNOT 7640
+    7633 ENVACC1
+    7634 GETFIELD3
+    7635 PUSHACC1
+    7636 PUSHENVACC 6
+    7638 APPTERM2 3
+    7640 ACC0
+    7641 RETURN 1
+    7643 RESTART
+    7644 GRAB 1
+    7646 CONST0
+    7647 PUSHENVACC1
+    7648 OFFSETINT -1
+    7650 PUSH
+    7651 BRANCH 7690
+    7653 CHECK_SIGNALS
+    7654 ENVACC2
+    7655 PUSHACC2
+    7656 PUSHACC5
+    7657 C_CALL2 array_get
+    7659 NEQ
+    7660 BRANCHIFNOT 7679
+    7662 ENVACC2
+    7663 PUSHACC2
+    7664 PUSHACC4
+    7665 C_CALL2 array_get
+    7667 NEQ
+    7668 BRANCHIFNOT 7679
+    7670 ACC1
+    7671 PUSHACC3
+    7672 C_CALL2 array_get
+    7674 PUSHACC2
+    7675 PUSHACC5
+    7676 C_CALL2 array_get
+    7678 NEQ
+    7679 BRANCHIFNOT 7685
+    7681 ENVACC4
+    7682 MAKEBLOCK1 0
+    7684 RAISE
+    7685 ACC1
+    7686 OFFSETINT 1
+    7688 ASSIGN 1
+    7690 ACC0
+    7691 PUSHACC2
+    7692 LEINT
+    7693 BRANCHIF 7653
+    7695 CONST0
+    7696 POP 2
+    7698 CONST0
+    7699 PUSHENVACC1
+    7700 OFFSETINT -1
+    7702 PUSH
+    7703 BRANCH 7727
+    7705 CHECK_SIGNALS
+    7706 ENVACC2
+    7707 PUSHACC2
+    7708 PUSHACC5
+    7709 C_CALL2 array_get
+    7711 NEQ
+    7712 BRANCHIFNOT 7722
+    7714 ACC1
+    7715 PUSHACC4
+    7716 C_CALL2 array_get
+    7718 PUSHACC2
+    7719 PUSHACC4
+    7720 C_CALL3 array_set
+    7722 ACC1
+    7723 OFFSETINT 1
+    7725 ASSIGN 1
+    7727 ACC0
+    7728 PUSHACC2
+    7729 LEINT
+    7730 BRANCHIF 7705
+    7732 CONST0
+    7733 POP 2
+    7735 ENVACC3
+    7736 GETFIELD0
+    7737 PUSHACC2
+    7738 PUSHENVACC 5
+    7740 APPLY2
+    7741 PUSHENVACC3
+    7742 SETFIELD0
+    7743 ACC0
+    7744 RETURN 2
+    7746 ENVACC1
+    7747 GETFIELD 4
+    7749 PUSHACC1
+    7750 PUSHENVACC2
+    7751 APPLY1
+    7752 LEINT
+    7753 RETURN 1
+    7755 CONST0
+    7756 PUSHCONST0
+    7757 PUSHENVACC1
+    7758 OFFSETINT -1
+    7760 PUSH
+    7761 BRANCH 7782
+    7763 CHECK_SIGNALS
+    7764 ENVACC2
+    7765 PUSHACC2
+    7766 PUSHACC5
+    7767 C_CALL2 array_get
+    7769 NEQ
+    7770 BRANCHIFNOT 7777
+    7772 ACC2
+    7773 OFFSETINT 1
+    7775 ASSIGN 2
+    7777 ACC1
+    7778 OFFSETINT 1
+    7780 ASSIGN 1
+    7782 ACC0
+    7783 PUSHACC2
+    7784 LEINT
+    7785 BRANCHIF 7763
+    7787 CONST0
+    7788 POP 2
+    7790 ACC0
+    7791 RETURN 2
+    7793 ENVACC2
+    7794 GETFIELD0
+    7795 OFFSETINT -1
+    7797 PUSHENVACC1
+    7798 GETFIELD0
+    7799 C_CALL2 array_get_addr
+    7801 PUSHACC1
+    7802 PUSHENVACC1
+    7803 GETFIELD0
+    7804 C_CALL3 array_set_addr
+    7806 ENVACC2
+    7807 OFFSETREF -1
+    7809 RETURN 1
+    7811 ENVACC1
+    7812 GETFIELD0
+    7813 VECTLENGTH
+    7814 PUSHACC0
+    7815 PUSHENVACC2
+    7816 GETFIELD0
+    7817 GEINT
+    7818 BRANCHIFNOT 7845
+    7820 ATOM0
+    7821 PUSHACC1
+    7822 PUSHCONST2
+    7823 MULINT
+    7824 C_CALL2 make_vect
+    7826 PUSH
+    7827 PUSH_RETADDR 7840
+    7829 ACC4
+    7830 PUSHCONST0
+    7831 PUSHACC5
+    7832 PUSHCONST0
+    7833 PUSHENVACC1
+    7834 GETFIELD0
+    7835 PUSHGETGLOBALFIELD Array, 8
+    7838 APPLY 5
+    7840 ACC0
+    7841 PUSHENVACC1
+    7842 SETFIELD0
+    7843 POP 1
+    7845 ACC1
+    7846 PUSHENVACC2
+    7847 GETFIELD0
+    7848 PUSHENVACC1
+    7849 GETFIELD0
+    7850 C_CALL3 array_set_addr
+    7852 ENVACC2
+    7853 OFFSETREF 1
+    7855 RETURN 2
+    7857 ACC0
+    7858 GETFIELD0
+    7859 PUSHENVACC1
+    7860 APPLY1
+    7861 PUSHENVACC2
+    7862 PUSHACC1
+    7863 GETFIELD0
+    7864 EQ
+    7865 BRANCHIFNOT 7874
+    7867 ACC1
+    7868 GETFIELD1
+    7869 PUSHACC1
+    7870 GETFIELD1
+    7871 PUSHENVACC3
+    7872 C_CALL3 array_set
+    7874 RETURN 2
+    7876 RESTART
+    7877 GRAB 1
+    7879 CONST0
+    7880 PUSHENVACC2
+    7881 APPLY1
+    7882 PUSHACC2
+    7883 PUSHGETGLOBALFIELD List, 4
+    7886 APPLY1
+    7887 PUSHACC1
+    7888 PUSHACC3
+    7889 PUSHENVACC1
+    7890 CLOSURE 3, 7857
+    7893 PUSHGETGLOBALFIELD List, 9
+    7896 APPLY2
+    7897 ACC0
+    7898 RETURN 3
+    7900 ACC0
+    7901 PUSHGETGLOBALFIELD Array, 6
+    7904 APPLY1
+    7905 PUSHACC0
+    7906 PUSHENVACC3
+    7907 APPLY1
+    7908 ENVACC2
+    7909 GETFIELD0
+    7910 PUSHENVACC1
+    7911 PUSHACC2
+    7912 C_CALL3 array_set
+    7914 ENVACC4
+    7915 GETFIELD0
+    7916 PUSHACC1
+    7917 MAKEBLOCK2 0
+    7919 PUSHENVACC 4
+    7921 SETFIELD0
+    7922 ACC0
+    7923 RETURN 2
+    7925 ENVACC2
+    7926 PUSHENVACC1
+    7927 OFFSETINT 1
+    7929 C_CALL2 make_vect
+    7931 PUSHACC0
+    7932 PUSHENVACC3
+    7933 APPLY1
+    7934 ENVACC4
+    7935 GETFIELD0
+    7936 PUSHACC1
+    7937 MAKEBLOCK2 0
+    7939 PUSHENVACC 4
+    7941 SETFIELD0
+    7942 ACC0
+    7943 RETURN 2
+    7945 ENVACC1
+    7946 PUSHACC1
+    7947 C_CALL2 array_get
+    7949 RETURN 1
+    7951 ENVACC2
+    7952 GETFIELD0
+    7953 PUSHENVACC1
+    7954 PUSHACC2
+    7955 C_CALL3 array_set
+    7957 RETURN 1
+    7959 ENVACC1
+    7960 PUSHENVACC2
+    7961 PUSHENVACC1
+    7962 MULINT
+    7963 PUSHACC2
+    7964 MODINT
+    7965 DIVINT
+    7966 PUSHENVACC1
+    7967 PUSHCONSTINT 65536
+    7969 PUSHACC3
+    7970 DIVINT
+    7971 DIVINT
+    7972 MAKEBLOCK2 0
+    7974 RETURN 1
+    7976 ENVACC3
+    7977 OFFSETREF 1
+    7979 ENVACC1
+    7980 PUSHACC1
+    7981 ADDINT
+    7982 PUSHCONST0
+    7983 PUSHENVACC2
+    7984 PUSHENVACC1
+    7985 MULINT
+    7986 PUSHACC2
+    7987 MODINT
+    7988 EQ
+    7989 BRANCHIFNOT 8001
+    7991 ENVACC2
+    7992 PUSHCONSTINT 65536
+    7994 SUBINT
+    7995 PUSHENVACC1
+    7996 MULINT
+    7997 PUSHACC1
+    7998 ADDINT
+    7999 RETURN 2
+    8001 ACC0
+    8002 RETURN 2
+    8004 ACC0
+    8005 C_CALL1 obj_dup
+    8007 PUSHENVACC1
+    8008 PUSHACC1
+    8009 PUSHENVACC2
+    8010 APPLY2
+    8011 ACC0
+    8012 RETURN 2
+    8014 RESTART
+    8015 GRAB 1
+    8017 ACC1
+    8018 GETFIELD0
+    8019 PUSHACC0
+    8020 PUSHCONST1
+    8021 PUSHACC3
+    8022 SETVECTITEM
+    8023 ACC0
+    8024 OFFSETINT 1
+    8026 PUSHACC3
+    8027 SETFIELD0
+    8028 RETURN 3
+    8030 ENVACC1
+    8031 GETFIELD0
+    8032 PUSHENVACC1
+    8033 OFFSETREF 1
+    8035 ACC0
+    8036 RETURN 2
+    8038 CONSTINT 248
+    8040 PUSHCONST0
+    8041 MAKEBLOCK1 0
+    8043 PUSHACC0
+    8044 CLOSURE 1, 8030
+    8047 PUSH
+    8048 CLOSURE 0, 8015
+    8051 PUSHACC0
+    8052 PUSHACC3
+    8053 CLOSURE 2, 8004
+    8056 PUSHCONSTINT 16
+    8058 PUSHCONST3
+    8059 PUSHCONST1
+    8060 PUSHCONST1
+    8061 PUSHCONST1
+    8062 MAKEBLOCK 5, 0
+    8065 PUSHCONSTINT 16
+    8067 PUSHGETGLOBALFIELD Sys, 3
+    8070 DIVINT
+    8071 PUSHCONST0
+    8072 PUSHCONSTINT 32
+    8074 PUSHCONST2
+    8075 PUSHCONST0
+    8076 MAKEBLOCK1 0
+    8078 PUSHACC0
+    8079 PUSHACC3
+    8080 PUSHACC6
+    8081 CLOSURE 3, 7976
+    8084 PUSHACC3
+    8085 PUSHACC6
+    8086 CLOSURE 2, 7959
+    8089 PUSHCONST0
+    8090 PUSHCONST0
+    8091 MAKEBLOCK1 0
+    8093 PUSHACC0
+    8094 PUSHACC7
+    8095 CLOSURE 2, 7951
+    8098 PUSHACC7
+    8099 CLOSURE 1, 7945
+    8102 PUSHCONST0
+    8103 MAKEBLOCK1 0
+    8105 PUSH
+    8106 ATOM0
+    8107 PUSHACC1
+    8108 PUSHACC4
+    8109 PUSHACC7
+    8110 PUSHACC 13
+    8112 CLOSURE 4, 7925
+    8115 PUSHACC2
+    8116 PUSHACC5
+    8117 PUSHACC7
+    8118 PUSHACC 14
+    8120 CLOSURE 4, 7900
+    8123 PUSHACC1
+    8124 PUSHACC 9
+    8126 CLOSURE 2, 7877
+    8129 PUSH
+    8130 ATOM0
+    8131 PUSHCONSTINT 10
+    8133 C_CALL2 make_vect
+    8135 MAKEBLOCK1 0
+    8137 PUSHCONST0
+    8138 MAKEBLOCK1 0
+    8140 PUSHACC0
+    8141 PUSHACC2
+    8142 CLOSURE 2, 7811
+    8145 PUSHACC1
+    8146 PUSHACC3
+    8147 CLOSURE 2, 7793
+    8150 PUSHACC 12
+    8152 PUSHACC 18
+    8154 CLOSURE 2, 7755
+    8157 PUSHACC0
+    8158 PUSHACC 22
+    8160 CLOSURE 2, 7746
+    8163 PUSHGETGLOBAL "Oo.Failed"
+    8165 MAKEBLOCK1 0
+    8167 PUSH
+    8168 CLOSUREREC 0, 6415
+    8172 ACC0
+    8173 PUSHACC2
+    8174 PUSHACC 14
+    8176 PUSHACC 19
+    8178 PUSHACC 25
+    8180 CLOSURE 5, 7644
+    8183 PUSHACC0
+    8184 PUSHACC3
+    8185 PUSHACC5
+    8186 PUSHACC 8
+    8188 PUSHACC 10
+    8190 PUSHACC 12
+    8192 PUSHACC 14
+    8194 CLOSUREREC 7, 6444
+    8198 ACC0
+    8199 PUSHACC5
+    8200 PUSHACC 15
+    8202 PUSHACC 18
+    8204 PUSHACC 21
+    8206 PUSHACC 31
+    8208 CLOSURE 6, 7614
+    8211 PUSHACC0
+    8212 PUSHACC 26
+    8214 CLOSURE 2, 7582
+    8217 PUSHACC 27
+    8219 PUSHCONSTINT 65536
+    8221 PUSHACC 28
+    8223 MULINT
+    8224 MULINT
+    8225 PUSHACC0
+    8226 MAKEBLOCK1 0
+    8228 PUSHCONSTINT 101
+    8230 PUSHGETGLOBALFIELD Hashtbl, 0
+    8233 APPLY1
+    8234 PUSHACC1
+    8235 PUSHACC 26
+    8237 CLOSURE 2, 7571
+    8240 PUSHACC0
+    8241 PUSHACC2
+    8242 CLOSURE 2, 7538
+    8245 PUSH
+    8246 CLOSURE 0, 7530
+    8249 PUSHACC0
+    8250 MAKEBLOCK1 0
+    8252 POP 1
+    8254 PUSHGETGLOBALFIELD Map, 0
+    8257 APPLY1
+    8258 PUSH
+    8259 CLOSURE 0, 7521
+    8262 PUSHACC0
+    8263 MAKEBLOCK1 0
+    8265 POP 1
+    8267 PUSHGETGLOBALFIELD Map, 0
+    8270 APPLY1
+    8271 PUSH
+    8272 CLOSURE 0, 7512
+    8275 PUSHACC0
+    8276 MAKEBLOCK1 0
+    8278 POP 1
+    8280 PUSHGETGLOBALFIELD Map, 0
+    8283 APPLY1
+    8284 PUSHCONST0
+    8285 MAKEBLOCK1 0
+    8287 PUSHACC0
+    8288 PUSHACC2
+    8289 PUSHACC4
+    8290 PUSHACC6
+    8291 PUSHACC 37
+    8293 CLOSURE 5, 7489
+    8296 PUSHACC 25
+    8298 CLOSURE 1, 7453
+    8301 PUSHACC0
+    8302 PUSHACC 26
+    8304 PUSHACC 28
+    8306 PUSHACC 35
+    8308 CLOSURE 4, 7409
+    8311 PUSHCONST0
+    8312 MAKEBLOCK1 0
+    8314 PUSHCONST0
+    8315 MAKEBLOCK1 0
+    8317 PUSHACC6
+    8318 PUSHACC 8
+    8320 PUSHACC 12
+    8322 CLOSURE 3, 7362
+    8325 PUSHACC2
+    8326 PUSHACC4
+    8327 PUSHACC 9
+    8329 CLOSURE 3, 7328
+    8332 PUSHACC 37
+    8334 CLOSURE 1, 7288
+    8337 PUSHACC2
+    8338 PUSHACC 10
+    8340 PUSHACC 12
+    8342 PUSHACC 14
+    8344 CLOSURE 4, 7187
+    8347 PUSHACC 12
+    8349 CLOSURE 1, 7027
+    8352 PUSH
+    8353 CLOSURE 0, 6980
+    8356 PUSH
+    8357 CLOSURE 0, 6969
+    8360 PUSHACC0
+    8361 PUSHACC 16
+    8363 CLOSURE 2, 6950
+    8366 PUSHACC 16
+    8368 CLOSURE 1, 6939
+    8371 PUSHACC 47
+    8373 CLOSURE 1, 6927
+    8376 PUSH
+    8377 CLOSURE 0, 6862
+    8380 PUSHACC 15
+    8382 PUSHACC 18
+    8384 PUSHACC 20
+    8386 PUSHACC 23
+    8388 CLOSURE 4, 6842
+    8391 PUSHACC 12
+    8393 PUSHACC 27
+    8395 PUSHACC 56
+    8397 CLOSURE 3, 6787
+    8400 PUSHACC 57
+    8402 PUSHACC 60
+    8404 PUSHACC 62
+    8406 CLOSURE 3, 6769
+    8409 PUSH
+    8410 CLOSUREREC 0, 6519
+    8414 ACC0
+    8415 CLOSURE 1, 6752
+    8418 PUSHACC0
+    8419 PUSHACC 61
+    8421 PUSHACC 64
+    8423 CLOSURE 3, 6735
+    8426 PUSHACC 52
+    8428 CLOSURE 1, 6715
+    8431 PUSHACC 39
+    8433 PUSHACC 49
+    8435 CLOSURE 2, 6695
+    8438 PUSHACC0
+    8439 PUSHACC 20
+    8441 PUSHACC 22
+    8443 PUSHACC 27
+    8445 PUSHACC 47
+    8447 PUSHACC 49
+    8449 PUSHACC 55
+    8451 PUSHACC 63
+    8453 CLOSURE 8, 6644
+    8456 PUSHACC 41
+    8458 CLOSURE 1, 6618
+    8461 PUSHACC0
+    8462 PUSHACC 52
+    8464 PUSHACC 57
+    8466 PUSHACC 63
+    8468 CLOSURE 4, 6581
+    8471 PUSHACC0
+    8472 PUSHACC3
+    8473 PUSHACC 66
+    8475 PUSHACC7
+    8476 PUSHACC 9
+    8478 PUSHACC 11
+    8480 PUSHACC 14
+    8482 PUSHACC 16
+    8484 PUSHACC 18
+    8486 PUSHACC 20
+    8488 PUSHACC 27
+    8490 PUSHACC 29
+    8492 PUSHACC 32
+    8494 PUSHACC 32
+    8496 PUSHACC 35
+    8498 PUSHACC 27
+    8500 PUSHACC 29
+    8502 PUSHACC 31
+    8504 PUSHACC 34
+    8506 PUSHACC 50
+    8508 PUSHACC 85
+    8510 MAKEBLOCK 21, 0
+    8513 POP 70
+    8515 SETGLOBAL Oo
+    8517 BRANCH 8568
+    8519 ACC0
+    8520 BRANCHIFNOT 8525
+    8522 ACC0
+    8523 BRANCH 8530
+    8525 ENVACC1
+    8526 PUSHGETGLOBALFIELD Oo, 14
+    8529 APPLY1
+    8530 PUSHCONST0
+    8531 ACC1
+    8532 BRANCHIFNOT 8537
+    8534 CONST0
+    8535 BRANCH 8543
+    8537 ENVACC1
+    8538 PUSHACC1
+    8539 PUSHGETGLOBALFIELD Oo, 15
+    8542 APPLY2
+    8543 ACC0
+    8544 RETURN 2
+    8546 CONSTINT 23
+    8548 RETURN 1
+    8550 CLOSURE 0, 8546
+    8553 PUSHACC0
+    8554 POP 1
+    8556 PUSHENVACC1
+    8557 PUSHACC2
+    8558 PUSHGETGLOBALFIELD Oo, 8
+    8561 APPLY3
+    8562 ACC0
+    8563 CLOSURE 1, 8519
+    8566 RETURN 1
+    8568 GETGLOBALFIELD Oo, 1
+    8571 PUSHGETGLOBAL "m"
+    8573 PUSHACC1
+    8574 APPLY1
+    8575 PUSHCONST3
+    8576 C_CALL1 alloc_dummy
+    8578 PUSHGETGLOBAL <0>("m", 0)
+    8580 PUSHGETGLOBALFIELD Oo, 12
+    8583 APPLY1
+    8584 PUSHACC2
+    8585 CLOSURE 1, 8550
+    8588 PUSHACC1
+    8589 PUSHACC1
+    8590 APPLY1
+    8591 PUSHACC2
+    8592 PUSHGETGLOBALFIELD Oo, 13
+    8595 APPLY1
+    8596 ACC2
+    8597 PUSHACC2
+    8598 PUSHACC2
+    8599 MAKEBLOCK3 0
+    8601 POP 3
+    8603 PUSHACC1
+    8604 C_CALL2 update_dummy
+    8606 CONST0
+    8607 PUSHACC1
+    8608 GETFIELD0
+    8609 APPLY1
+    8610 PUSHCONSTINT 23
+    8612 PUSHACC1
+    8613 PUSHACC4
+    8614 GETMETHOD
+    8615 APPLY1
+    8616 NEQ
+    8617 BRANCHIFNOT 8624
+    8619 GETGLOBAL Not_found
+    8621 MAKEBLOCK1 0
+    8623 RAISE
+    8624 POP 1
+    8626 ACC0
+    8627 MAKEBLOCK1 0
+    8629 POP 3
+    8631 SETGLOBAL T300-getmethod
+    8633 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t301-object.ml b/testsuite/tests/tool-ocaml/t301-object.ml
new file mode 100644
index 00000000..8b822439
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t301-object.ml
@@ -0,0 +1,33 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+(**** file testinterp/t301-object.ml
+   suggested by Jacques Garrigue to Basile Starynkevitch
+
+   compilable with
+ocamlc -nostdlib -I ../../stdlib \
+  ../../stdlib/pervasives.cmo ../../stdlib/camlinternalOO.cmo \
+  t301-object.ml -o t301-object.byte
+
+***)
+
+class c = object (self)
+  method pubmet = 1
+  method privmet = self#pubmet + 1
+  val o = object method a = 3 method m = 4 end
+  method dynmet = o#m
+end;;
+
+let f () =
+  let c = new c in
+  (c#pubmet, c#privmet, c#dynmet);;
+
+let (x,y,z) = f () in
+  if x <> 1 then raise Not_found;
+  if y <> 2 then raise Not_found;
+  if z <> 4 then raise Not_found;;
diff --git a/testsuite/tests/tool-ocaml/t310-alloc-1.ml b/testsuite/tests/tool-ocaml/t310-alloc-1.ml
new file mode 100644
index 00000000..4a3b0092
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t310-alloc-1.ml
@@ -0,0 +1,1595 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f a n =
+  if n <= 0 then a
+  else f (1::a) (n-1)
+in
+let l = f [] 30000 in
+if List.fold_left (+) 0 l <> 30000 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 746
+      11 RESTART
+      12 GRAB 1
+      14 ACC0
+      15 BRANCHIFNOT 28
+      17 ACC1
+      18 PUSHACC1
+      19 GETFIELD1
+      20 PUSHOFFSETCLOSURE0
+      21 APPLY2
+      22 PUSHACC1
+      23 GETFIELD0
+      24 MAKEBLOCK2 0
+      26 RETURN 2
+      28 ACC1
+      29 RETURN 2
+      31 RESTART
+      32 GRAB 3
+      34 CONST0
+      35 PUSHACC4
+      36 LEINT
+      37 BRANCHIFNOT 42
+      39 CONST0
+      40 RETURN 4
+      42 ACC3
+      43 PUSHACC3
+      44 PUSHACC3
+      45 PUSHACC3
+      46 C_CALL4 caml_input
+      48 PUSHCONST0
+      49 PUSHACC1
+      50 EQ
+      51 BRANCHIFNOT 58
+      53 GETGLOBAL End_of_file
+      55 MAKEBLOCK1 0
+      57 RAISE
+      58 ACC0
+      59 PUSHACC5
+      60 SUBINT
+      61 PUSHACC1
+      62 PUSHACC5
+      63 ADDINT
+      64 PUSHACC4
+      65 PUSHACC4
+      66 PUSHOFFSETCLOSURE0
+      67 APPTERM 4, 9
+      70 ACC0
+      71 C_CALL1 caml_input_scan_line
+      73 PUSHCONST0
+      74 PUSHACC1
+      75 EQ
+      76 BRANCHIFNOT 83
+      78 GETGLOBAL End_of_file
+      80 MAKEBLOCK1 0
+      82 RAISE
+      83 CONST0
+      84 PUSHACC1
+      85 GTINT
+      86 BRANCHIFNOT 107
+      88 ACC0
+      89 OFFSETINT -1
+      91 C_CALL1 create_string
+      93 PUSHACC1
+      94 OFFSETINT -1
+      96 PUSHCONST0
+      97 PUSHACC2
+      98 PUSHACC5
+      99 C_CALL4 caml_input
+     101 ACC2
+     102 C_CALL1 caml_input_char
+     104 ACC0
+     105 RETURN 3
+     107 ACC0
+     108 NEGINT
+     109 C_CALL1 create_string
+     111 PUSHACC1
+     112 NEGINT
+     113 PUSHCONST0
+     114 PUSHACC2
+     115 PUSHACC5
+     116 C_CALL4 caml_input
+     118 CONST0
+     119 PUSHTRAP 130
+     121 ACC6
+     122 PUSHOFFSETCLOSURE0
+     123 APPLY1
+     124 PUSHACC5
+     125 PUSHENVACC1
+     126 APPLY2
+     127 POPTRAP
+     128 RETURN 3
+     130 PUSHGETGLOBAL End_of_file
+     132 PUSHACC1
+     133 GETFIELD0
+     134 EQ
+     135 BRANCHIFNOT 140
+     137 ACC1
+     138 RETURN 4
+     140 ACC0
+     141 RAISE
+     142 ACC0
+     143 C_CALL1 caml_flush
+     145 RETURN 1
+     147 RESTART
+     148 GRAB 1
+     150 ACC1
+     151 PUSHACC1
+     152 C_CALL2 caml_output_char
+     154 RETURN 2
+     156 RESTART
+     157 GRAB 1
+     159 ACC1
+     160 PUSHACC1
+     161 C_CALL2 caml_output_char
+     163 RETURN 2
+     165 RESTART
+     166 GRAB 1
+     168 ACC1
+     169 PUSHACC1
+     170 C_CALL2 caml_output_int
+     172 RETURN 2
+     174 RESTART
+     175 GRAB 1
+     177 ACC1
+     178 PUSHACC1
+     179 C_CALL2 caml_seek_out
+     181 RETURN 2
+     183 ACC0
+     184 C_CALL1 caml_pos_out
+     186 RETURN 1
+     188 ACC0
+     189 C_CALL1 caml_channel_size
+     191 RETURN 1
+     193 RESTART
+     194 GRAB 1
+     196 ACC1
+     197 PUSHACC1
+     198 C_CALL2 caml_set_binary_mode
+     200 RETURN 2
+     202 ACC0
+     203 C_CALL1 caml_input_char
+     205 RETURN 1
+     207 ACC0
+     208 C_CALL1 caml_input_char
+     210 RETURN 1
+     212 ACC0
+     213 C_CALL1 caml_input_int
+     215 RETURN 1
+     217 ACC0
+     218 C_CALL1 input_value
+     220 RETURN 1
+     222 RESTART
+     223 GRAB 1
+     225 ACC1
+     226 PUSHACC1
+     227 C_CALL2 caml_seek_in
+     229 RETURN 2
+     231 ACC0
+     232 C_CALL1 caml_pos_in
+     234 RETURN 1
+     236 ACC0
+     237 C_CALL1 caml_channel_size
+     239 RETURN 1
+     241 ACC0
+     242 C_CALL1 caml_close_channel
+     244 RETURN 1
+     246 RESTART
+     247 GRAB 1
+     249 ACC1
+     250 PUSHACC1
+     251 C_CALL2 caml_set_binary_mode
+     253 RETURN 2
+     255 CONST0
+     256 PUSHENVACC1
+     257 APPLY1
+     258 ACC0
+     259 C_CALL1 sys_exit
+     261 RETURN 1
+     263 CONST0
+     264 PUSHENVACC1
+     265 GETFIELD0
+     266 APPTERM1 2
+     268 CONST0
+     269 PUSHENVACC1
+     270 APPLY1
+     271 CONST0
+     272 PUSHENVACC2
+     273 APPTERM1 2
+     275 ENVACC1
+     276 GETFIELD0
+     277 PUSHACC0
+     278 PUSHACC2
+     279 CLOSURE 2, 268
+     282 PUSHENVACC1
+     283 SETFIELD0
+     284 RETURN 2
+     286 ENVACC1
+     287 C_CALL1 caml_flush
+     289 ENVACC2
+     290 C_CALL1 caml_flush
+     292 RETURN 1
+     294 CONST0
+     295 PUSHENVACC1
+     296 APPLY1
+     297 C_CALL1 float_of_string
+     299 RETURN 1
+     301 CONST0
+     302 PUSHENVACC1
+     303 APPLY1
+     304 C_CALL1 int_of_string
+     306 RETURN 1
+     308 ENVACC2
+     309 C_CALL1 caml_flush
+     311 ENVACC1
+     312 PUSHENVACC3
+     313 APPTERM1 2
+     315 CONSTINT 13
+     317 PUSHENVACC1
+     318 C_CALL2 caml_output_char
+     320 ENVACC1
+     321 C_CALL1 caml_flush
+     323 RETURN 1
+     325 ACC0
+     326 PUSHENVACC1
+     327 PUSHENVACC2
+     328 APPLY2
+     329 CONSTINT 13
+     331 PUSHENVACC1
+     332 C_CALL2 caml_output_char
+     334 ENVACC1
+     335 C_CALL1 caml_flush
+     337 RETURN 1
+     339 ACC0
+     340 PUSHENVACC1
+     341 APPLY1
+     342 PUSHENVACC2
+     343 PUSHENVACC3
+     344 APPTERM2 3
+     346 ACC0
+     347 PUSHENVACC1
+     348 APPLY1
+     349 PUSHENVACC2
+     350 PUSHENVACC3
+     351 APPTERM2 3
+     353 ACC0
+     354 PUSHENVACC1
+     355 PUSHENVACC2
+     356 APPTERM2 3
+     358 ACC0
+     359 PUSHENVACC1
+     360 C_CALL2 caml_output_char
+     362 RETURN 1
+     364 CONSTINT 13
+     366 PUSHENVACC1
+     367 C_CALL2 caml_output_char
+     369 ENVACC1
+     370 C_CALL1 caml_flush
+     372 RETURN 1
+     374 ACC0
+     375 PUSHENVACC1
+     376 PUSHENVACC2
+     377 APPLY2
+     378 CONSTINT 13
+     380 PUSHENVACC1
+     381 C_CALL2 caml_output_char
+     383 RETURN 1
+     385 ACC0
+     386 PUSHENVACC1
+     387 APPLY1
+     388 PUSHENVACC2
+     389 PUSHENVACC3
+     390 APPTERM2 3
+     392 ACC0
+     393 PUSHENVACC1
+     394 APPLY1
+     395 PUSHENVACC2
+     396 PUSHENVACC3
+     397 APPTERM2 3
+     399 ACC0
+     400 PUSHENVACC1
+     401 PUSHENVACC2
+     402 APPTERM2 3
+     404 ACC0
+     405 PUSHENVACC1
+     406 C_CALL2 caml_output_char
+     408 RETURN 1
+     410 RESTART
+     411 GRAB 3
+     413 CONST0
+     414 PUSHACC3
+     415 LTINT
+     416 BRANCHIF 427
+     418 ACC1
+     419 C_CALL1 ml_string_length
+     421 PUSHACC4
+     422 PUSHACC4
+     423 ADDINT
+     424 GTINT
+     425 BRANCHIFNOT 432
+     427 GETGLOBAL "really_input"
+     429 PUSHENVACC1
+     430 APPTERM1 5
+     432 ACC3
+     433 PUSHACC3
+     434 PUSHACC3
+     435 PUSHACC3
+     436 PUSHENVACC2
+     437 APPTERM 4, 8
+     440 RESTART
+     441 GRAB 3
+     443 CONST0
+     444 PUSHACC3
+     445 LTINT
+     446 BRANCHIF 457
+     448 ACC1
+     449 C_CALL1 ml_string_length
+     451 PUSHACC4
+     452 PUSHACC4
+     453 ADDINT
+     454 GTINT
+     455 BRANCHIFNOT 462
+     457 GETGLOBAL "input"
+     459 PUSHENVACC1
+     460 APPTERM1 5
+     462 ACC3
+     463 PUSHACC3
+     464 PUSHACC3
+     465 PUSHACC3
+     466 C_CALL4 caml_input
+     468 RETURN 4
+     470 ACC0
+     471 PUSHCONST0
+     472 PUSHGETGLOBAL <0>(0, <0>(6, 0))
+     474 PUSHENVACC1
+     475 APPTERM3 4
+     477 ACC0
+     478 PUSHCONST0
+     479 PUSHGETGLOBAL <0>(0, <0>(7, 0))
+     481 PUSHENVACC1
+     482 APPTERM3 4
+     484 RESTART
+     485 GRAB 2
+     487 ACC1
+     488 PUSHACC1
+     489 PUSHACC4
+     490 C_CALL3 sys_open
+     492 C_CALL1 caml_open_descriptor
+     494 RETURN 3
+     496 ACC0
+     497 C_CALL1 caml_flush
+     499 ACC0
+     500 C_CALL1 caml_close_channel
+     502 RETURN 1
+     504 RESTART
+     505 GRAB 1
+     507 CONST0
+     508 PUSHACC2
+     509 PUSHACC2
+     510 C_CALL3 output_value
+     512 RETURN 2
+     514 RESTART
+     515 GRAB 3
+     517 CONST0
+     518 PUSHACC3
+     519 LTINT
+     520 BRANCHIF 531
+     522 ACC1
+     523 C_CALL1 ml_string_length
+     525 PUSHACC4
+     526 PUSHACC4
+     527 ADDINT
+     528 GTINT
+     529 BRANCHIFNOT 536
+     531 GETGLOBAL "output"
+     533 PUSHENVACC1
+     534 APPTERM1 5
+     536 ACC3
+     537 PUSHACC3
+     538 PUSHACC3
+     539 PUSHACC3
+     540 C_CALL4 caml_output
+     542 RETURN 4
+     544 RESTART
+     545 GRAB 1
+     547 ACC1
+     548 C_CALL1 ml_string_length
+     550 PUSHCONST0
+     551 PUSHACC3
+     552 PUSHACC3
+     553 C_CALL4 caml_output
+     555 RETURN 2
+     557 ACC0
+     558 PUSHCONSTINT 438
+     560 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(6, 0))))
+     562 PUSHENVACC1
+     563 APPTERM3 4
+     565 ACC0
+     566 PUSHCONSTINT 438
+     568 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(7, 0))))
+     570 PUSHENVACC1
+     571 APPTERM3 4
+     573 RESTART
+     574 GRAB 2
+     576 ACC1
+     577 PUSHACC1
+     578 PUSHACC4
+     579 C_CALL3 sys_open
+     581 C_CALL1 caml_open_descriptor
+     583 RETURN 3
+     585 ACC0
+     586 PUSHGETGLOBAL "%.12g"
+     588 C_CALL2 format_float
+     590 RETURN 1
+     592 ACC0
+     593 PUSHGETGLOBAL "%d"
+     595 C_CALL2 format_int
+     597 RETURN 1
+     599 GETGLOBAL "false"
+     601 PUSHACC1
+     602 C_CALL2 string_equal
+     604 BRANCHIFNOT 609
+     606 CONST0
+     607 RETURN 1
+     609 GETGLOBAL "true"
+     611 PUSHACC1
+     612 C_CALL2 string_equal
+     614 BRANCHIFNOT 619
+     616 CONST1
+     617 RETURN 1
+     619 GETGLOBAL "bool_of_string"
+     621 PUSHENVACC1
+     622 APPTERM1 2
+     624 ACC0
+     625 BRANCHIFNOT 631
+     627 GETGLOBAL "true"
+     629 RETURN 1
+     631 GETGLOBAL "false"
+     633 RETURN 1
+     635 CONST0
+     636 PUSHACC1
+     637 LTINT
+     638 BRANCHIF 646
+     640 CONSTINT 255
+     642 PUSHACC1
+     643 GTINT
+     644 BRANCHIFNOT 651
+     646 GETGLOBAL "char_of_int"
+     648 PUSHENVACC1
+     649 APPTERM1 2
+     651 ACC0
+     652 RETURN 1
+     654 RESTART
+     655 GRAB 1
+     657 ACC0
+     658 C_CALL1 ml_string_length
+     660 PUSHACC2
+     661 C_CALL1 ml_string_length
+     663 PUSHACC0
+     664 PUSHACC2
+     665 ADDINT
+     666 C_CALL1 create_string
+     668 PUSHACC2
+     669 PUSHCONST0
+     670 PUSHACC2
+     671 PUSHCONST0
+     672 PUSHACC7
+     673 C_CALL5 blit_string
+     675 ACC1
+     676 PUSHACC3
+     677 PUSHACC2
+     678 PUSHCONST0
+     679 PUSHACC 8
+     681 C_CALL5 blit_string
+     683 ACC0
+     684 RETURN 5
+     686 CONSTINT -1
+     688 PUSHACC1
+     689 XORINT
+     690 RETURN 1
+     692 CONST0
+     693 PUSHACC1
+     694 GEINT
+     695 BRANCHIFNOT 700
+     697 ACC0
+     698 RETURN 1
+     700 ACC0
+     701 NEGINT
+     702 RETURN 1
+     704 RESTART
+     705 GRAB 1
+     707 ACC1
+     708 PUSHACC1
+     709 C_CALL2 greaterequal
+     711 BRANCHIFNOT 716
+     713 ACC0
+     714 RETURN 2
+     716 ACC1
+     717 RETURN 2
+     719 RESTART
+     720 GRAB 1
+     722 ACC1
+     723 PUSHACC1
+     724 C_CALL2 lessequal
+     726 BRANCHIFNOT 731
+     728 ACC0
+     729 RETURN 2
+     731 ACC1
+     732 RETURN 2
+     734 ACC0
+     735 PUSHGETGLOBAL Invalid_argument
+     737 MAKEBLOCK2 0
+     739 RAISE
+     740 ACC0
+     741 PUSHGETGLOBAL Failure
+     743 MAKEBLOCK2 0
+     745 RAISE
+     746 CLOSURE 0, 740
+     749 PUSH
+     750 CLOSURE 0, 734
+     753 PUSHGETGLOBAL "Pervasives.Exit"
+     755 MAKEBLOCK1 0
+     757 PUSHGETGLOBAL "Pervasives.Assert_failure"
+     759 MAKEBLOCK1 0
+     761 PUSH
+     762 CLOSURE 0, 720
+     765 PUSH
+     766 CLOSURE 0, 705
+     769 PUSH
+     770 CLOSURE 0, 692
+     773 PUSH
+     774 CLOSURE 0, 686
+     777 PUSHCONST0
+     778 PUSHCONSTINT 31
+     780 PUSHCONST1
+     781 LSLINT
+     782 EQ
+     783 BRANCHIFNOT 789
+     785 CONSTINT 30
+     787 BRANCH 791
+     789 CONSTINT 62
+     791 PUSHCONST1
+     792 LSLINT
+     793 PUSHACC0
+     794 OFFSETINT -1
+     796 PUSH
+     797 CLOSURE 0, 655
+     800 PUSHACC 9
+     802 CLOSURE 1, 635
+     805 PUSH
+     806 CLOSURE 0, 624
+     809 PUSHACC 11
+     811 CLOSURE 1, 599
+     814 PUSH
+     815 CLOSURE 0, 592
+     818 PUSH
+     819 CLOSURE 0, 585
+     822 PUSH
+     823 CLOSUREREC 0, 12
+     827 CONST0
+     828 C_CALL1 caml_open_descriptor
+     830 PUSHCONST1
+     831 C_CALL1 caml_open_descriptor
+     833 PUSHCONST2
+     834 C_CALL1 caml_open_descriptor
+     836 PUSH
+     837 CLOSURE 0, 574
+     840 PUSHACC0
+     841 CLOSURE 1, 565
+     844 PUSHACC1
+     845 CLOSURE 1, 557
+     848 PUSH
+     849 CLOSURE 0, 545
+     852 PUSHACC 22
+     854 CLOSURE 1, 515
+     857 PUSH
+     858 CLOSURE 0, 505
+     861 PUSH
+     862 CLOSURE 0, 496
+     865 PUSH
+     866 CLOSURE 0, 485
+     869 PUSHACC0
+     870 CLOSURE 1, 477
+     873 PUSHACC1
+     874 CLOSURE 1, 470
+     877 PUSHACC 28
+     879 CLOSURE 1, 441
+     882 PUSH
+     883 CLOSUREREC 0, 32
+     887 ACC0
+     888 PUSHACC 31
+     890 CLOSURE 2, 411
+     893 PUSHACC 22
+     895 CLOSUREREC 1, 70
+     899 ACC 15
+     901 CLOSURE 1, 404
+     904 PUSHACC 11
+     906 PUSHACC 17
+     908 CLOSURE 2, 399
+     911 PUSHACC 12
+     913 PUSHACC 18
+     915 PUSHACC 23
+     917 CLOSURE 3, 392
+     920 PUSHACC 13
+     922 PUSHACC 19
+     924 PUSHACC 23
+     926 CLOSURE 3, 385
+     929 PUSHACC 14
+     931 PUSHACC 20
+     933 CLOSURE 2, 374
+     936 PUSHACC 20
+     938 CLOSURE 1, 364
+     941 PUSHACC 20
+     943 CLOSURE 1, 358
+     946 PUSHACC 17
+     948 PUSHACC 22
+     950 CLOSURE 2, 353
+     953 PUSHACC 18
+     955 PUSHACC 23
+     957 PUSHACC 29
+     959 CLOSURE 3, 346
+     962 PUSHACC 19
+     964 PUSHACC 24
+     966 PUSHACC 29
+     968 CLOSURE 3, 339
+     971 PUSHACC 20
+     973 PUSHACC 25
+     975 CLOSURE 2, 325
+     978 PUSHACC 25
+     980 CLOSURE 1, 315
+     983 PUSHACC 12
+     985 PUSHACC 28
+     987 PUSHACC 30
+     989 CLOSURE 3, 308
+     992 PUSHACC0
+     993 CLOSURE 1, 301
+     996 PUSHACC1
+     997 CLOSURE 1, 294
+    1000 PUSHACC 29
+    1002 PUSHACC 31
+    1004 CLOSURE 2, 286
+    1007 MAKEBLOCK1 0
+    1009 PUSHACC0
+    1010 CLOSURE 1, 275
+    1013 PUSHACC1
+    1014 CLOSURE 1, 263
+    1017 PUSHACC0
+    1018 CLOSURE 1, 255
+    1021 PUSHACC1
+    1022 PUSHACC 22
+    1024 PUSHACC4
+    1025 PUSHACC3
+    1026 PUSH
+    1027 CLOSURE 0, 247
+    1030 PUSH
+    1031 CLOSURE 0, 241
+    1034 PUSH
+    1035 CLOSURE 0, 236
+    1038 PUSH
+    1039 CLOSURE 0, 231
+    1042 PUSH
+    1043 CLOSURE 0, 223
+    1046 PUSH
+    1047 CLOSURE 0, 217
+    1050 PUSH
+    1051 CLOSURE 0, 212
+    1054 PUSH
+    1055 CLOSURE 0, 207
+    1058 PUSHACC 32
+    1060 PUSHACC 35
+    1062 PUSHACC 33
+    1064 PUSH
+    1065 CLOSURE 0, 202
+    1068 PUSHACC 41
+    1070 PUSHACC 40
+    1072 PUSHACC 42
+    1074 PUSH
+    1075 CLOSURE 0, 194
+    1078 PUSHACC 46
+    1080 PUSH
+    1081 CLOSURE 0, 188
+    1084 PUSH
+    1085 CLOSURE 0, 183
+    1088 PUSH
+    1089 CLOSURE 0, 175
+    1092 PUSHACC 51
+    1094 PUSH
+    1095 CLOSURE 0, 166
+    1098 PUSH
+    1099 CLOSURE 0, 157
+    1102 PUSHACC 55
+    1104 PUSHACC 57
+    1106 PUSH
+    1107 CLOSURE 0, 148
+    1110 PUSH
+    1111 CLOSURE 0, 142
+    1114 PUSHACC 63
+    1116 PUSHACC 62
+    1118 PUSHACC 64
+    1120 PUSHACC 38
+    1122 PUSHACC 40
+    1124 PUSHACC 42
+    1126 PUSHACC 44
+    1128 PUSHACC 46
+    1130 PUSHACC 48
+    1132 PUSHACC 50
+    1134 PUSHACC 52
+    1136 PUSHACC 54
+    1138 PUSHACC 56
+    1140 PUSHACC 58
+    1142 PUSHACC 60
+    1144 PUSHACC 62
+    1146 PUSHACC 64
+    1148 PUSHACC 66
+    1150 PUSHACC 82
+    1152 PUSHACC 84
+    1154 PUSHACC 86
+    1156 PUSHACC 88
+    1158 PUSHACC 90
+    1160 PUSHACC 92
+    1162 PUSHACC 94
+    1164 PUSHACC 96
+    1166 PUSHACC 98
+    1168 PUSHACC 100
+    1170 PUSHACC 104
+    1172 PUSHACC 104
+    1174 PUSHACC 104
+    1176 PUSHACC 108
+    1178 PUSHACC 110
+    1180 PUSHACC 112
+    1182 PUSHACC 117
+    1184 PUSHACC 117
+    1186 PUSHACC 117
+    1188 PUSHACC 117
+    1190 MAKEBLOCK 69, 0
+    1193 POP 53
+    1195 SETGLOBAL Pervasives
+    1197 BRANCH 2177
+    1199 RESTART
+    1200 GRAB 1
+    1202 ACC1
+    1203 BRANCHIFNOT 1213
+    1205 ACC1
+    1206 GETFIELD1
+    1207 PUSHACC1
+    1208 OFFSETINT 1
+    1210 PUSHOFFSETCLOSURE0
+    1211 APPTERM2 4
+    1213 ACC0
+    1214 RETURN 2
+    1216 RESTART
+    1217 GRAB 1
+    1219 ACC0
+    1220 BRANCHIFNOT 1251
+    1222 CONST0
+    1223 PUSHACC2
+    1224 EQ
+    1225 BRANCHIFNOT 1231
+    1227 ACC0
+    1228 GETFIELD0
+    1229 RETURN 2
+    1231 CONST0
+    1232 PUSHACC2
+    1233 GTINT
+    1234 BRANCHIFNOT 1244
+    1236 ACC1
+    1237 OFFSETINT -1
+    1239 PUSHACC1
+    1240 GETFIELD1
+    1241 PUSHOFFSETCLOSURE0
+    1242 APPTERM2 4
+    1244 GETGLOBAL "List.nth"
+    1246 PUSHGETGLOBALFIELD Pervasives, 2
+    1249 APPTERM1 3
+    1251 GETGLOBAL "nth"
+    1253 PUSHGETGLOBALFIELD Pervasives, 3
+    1256 APPTERM1 3
+    1258 RESTART
+    1259 GRAB 1
+    1261 ACC0
+    1262 BRANCHIFNOT 1274
+    1264 ACC1
+    1265 PUSHACC1
+    1266 GETFIELD0
+    1267 MAKEBLOCK2 0
+    1269 PUSHACC1
+    1270 GETFIELD1
+    1271 PUSHOFFSETCLOSURE0
+    1272 APPTERM2 4
+    1274 ACC1
+    1275 RETURN 2
+    1277 ACC0
+    1278 BRANCHIFNOT 1291
+    1280 ACC0
+    1281 GETFIELD1
+    1282 PUSHOFFSETCLOSURE0
+    1283 APPLY1
+    1284 PUSHACC1
+    1285 GETFIELD0
+    1286 PUSHGETGLOBALFIELD Pervasives, 16
+    1289 APPTERM2 3
+    1291 RETURN 1
+    1293 RESTART
+    1294 GRAB 1
+    1296 ACC1
+    1297 BRANCHIFNOT 1313
+    1299 ACC1
+    1300 GETFIELD0
+    1301 PUSHACC1
+    1302 APPLY1
+    1303 PUSHACC2
+    1304 GETFIELD1
+    1305 PUSHACC2
+    1306 PUSHOFFSETCLOSURE0
+    1307 APPLY2
+    1308 PUSHACC1
+    1309 MAKEBLOCK2 0
+    1311 POP 1
+    1313 RETURN 2
+    1315 RESTART
+    1316 GRAB 1
+    1318 ACC1
+    1319 BRANCHIFNOT 1331
+    1321 ACC1
+    1322 GETFIELD0
+    1323 PUSHACC1
+    1324 APPLY1
+    1325 ACC1
+    1326 GETFIELD1
+    1327 PUSHACC1
+    1328 PUSHOFFSETCLOSURE0
+    1329 APPTERM2 4
+    1331 RETURN 2
+    1333 RESTART
+    1334 GRAB 2
+    1336 ACC2
+    1337 BRANCHIFNOT 1350
+    1339 ACC2
+    1340 GETFIELD1
+    1341 PUSHACC3
+    1342 GETFIELD0
+    1343 PUSHACC3
+    1344 PUSHACC3
+    1345 APPLY2
+    1346 PUSHACC2
+    1347 PUSHOFFSETCLOSURE0
+    1348 APPTERM3 6
+    1350 ACC1
+    1351 RETURN 3
+    1353 RESTART
+    1354 GRAB 2
+    1356 ACC1
+    1357 BRANCHIFNOT 1370
+    1359 ACC2
+    1360 PUSHACC2
+    1361 GETFIELD1
+    1362 PUSHACC2
+    1363 PUSHOFFSETCLOSURE0
+    1364 APPLY3
+    1365 PUSHACC2
+    1366 GETFIELD0
+    1367 PUSHACC2
+    1368 APPTERM2 5
+    1370 ACC2
+    1371 RETURN 3
+    1373 RESTART
+    1374 GRAB 2
+    1376 ACC1
+    1377 BRANCHIFNOT 1400
+    1379 ACC2
+    1380 BRANCHIFNOT 1407
+    1382 ACC2
+    1383 GETFIELD0
+    1384 PUSHACC2
+    1385 GETFIELD0
+    1386 PUSHACC2
+    1387 APPLY2
+    1388 PUSHACC3
+    1389 GETFIELD1
+    1390 PUSHACC3
+    1391 GETFIELD1
+    1392 PUSHACC3
+    1393 PUSHOFFSETCLOSURE0
+    1394 APPLY3
+    1395 PUSHACC1
+    1396 MAKEBLOCK2 0
+    1398 RETURN 4
+    1400 ACC2
+    1401 BRANCHIFNOT 1405
+    1403 BRANCH 1407
+    1405 RETURN 3
+    1407 GETGLOBAL "List.map2"
+    1409 PUSHGETGLOBALFIELD Pervasives, 2
+    1412 APPTERM1 4
+    1414 RESTART
+    1415 GRAB 2
+    1417 ACC1
+    1418 BRANCHIFNOT 1437
+    1420 ACC2
+    1421 BRANCHIFNOT 1444
+    1423 ACC2
+    1424 GETFIELD0
+    1425 PUSHACC2
+    1426 GETFIELD0
+    1427 PUSHACC2
+    1428 APPLY2
+    1429 ACC2
+    1430 GETFIELD1
+    1431 PUSHACC2
+    1432 GETFIELD1
+    1433 PUSHACC2
+    1434 PUSHOFFSETCLOSURE0
+    1435 APPTERM3 6
+    1437 ACC2
+    1438 BRANCHIFNOT 1442
+    1440 BRANCH 1444
+    1442 RETURN 3
+    1444 GETGLOBAL "List.iter2"
+    1446 PUSHGETGLOBALFIELD Pervasives, 2
+    1449 APPTERM1 4
+    1451 RESTART
+    1452 GRAB 3
+    1454 ACC2
+    1455 BRANCHIFNOT 1476
+    1457 ACC3
+    1458 BRANCHIFNOT 1482
+    1460 ACC3
+    1461 GETFIELD1
+    1462 PUSHACC3
+    1463 GETFIELD1
+    1464 PUSHACC5
+    1465 GETFIELD0
+    1466 PUSHACC5
+    1467 GETFIELD0
+    1468 PUSHACC5
+    1469 PUSHACC5
+    1470 APPLY3
+    1471 PUSHACC3
+    1472 PUSHOFFSETCLOSURE0
+    1473 APPTERM 4, 8
+    1476 ACC3
+    1477 BRANCHIF 1482
+    1479 ACC1
+    1480 RETURN 4
+    1482 GETGLOBAL "List.fold_left2"
+    1484 PUSHGETGLOBALFIELD Pervasives, 2
+    1487 APPTERM1 5
+    1489 RESTART
+    1490 GRAB 3
+    1492 ACC1
+    1493 BRANCHIFNOT 1516
+    1495 ACC2
+    1496 BRANCHIFNOT 1522
+    1498 PUSH_RETADDR 1509
+    1500 ACC6
+    1501 PUSHACC6
+    1502 GETFIELD1
+    1503 PUSHACC6
+    1504 GETFIELD1
+    1505 PUSHACC6
+    1506 PUSHOFFSETCLOSURE0
+    1507 APPLY 4
+    1509 PUSHACC3
+    1510 GETFIELD0
+    1511 PUSHACC3
+    1512 GETFIELD0
+    1513 PUSHACC3
+    1514 APPTERM3 7
+    1516 ACC2
+    1517 BRANCHIF 1522
+    1519 ACC3
+    1520 RETURN 4
+    1522 GETGLOBAL "List.fold_right2"
+    1524 PUSHGETGLOBALFIELD Pervasives, 2
+    1527 APPTERM1 5
+    1529 RESTART
+    1530 GRAB 1
+    1532 ACC1
+    1533 BRANCHIFNOT 1549
+    1535 ACC1
+    1536 GETFIELD0
+    1537 PUSHACC1
+    1538 APPLY1
+    1539 BRANCHIFNOT 1547
+    1541 ACC1
+    1542 GETFIELD1
+    1543 PUSHACC1
+    1544 PUSHOFFSETCLOSURE0
+    1545 APPTERM2 4
+    1547 RETURN 2
+    1549 CONST1
+    1550 RETURN 2
+    1552 RESTART
+    1553 GRAB 1
+    1555 ACC1
+    1556 BRANCHIFNOT 1570
+    1558 ACC1
+    1559 GETFIELD0
+    1560 PUSHACC1
+    1561 APPLY1
+    1562 BRANCHIF 1570
+    1564 ACC1
+    1565 GETFIELD1
+    1566 PUSHACC1
+    1567 PUSHOFFSETCLOSURE0
+    1568 APPTERM2 4
+    1570 RETURN 2
+    1572 RESTART
+    1573 GRAB 2
+    1575 ACC1
+    1576 BRANCHIFNOT 1599
+    1578 ACC2
+    1579 BRANCHIFNOT 1605
+    1581 ACC2
+    1582 GETFIELD0
+    1583 PUSHACC2
+    1584 GETFIELD0
+    1585 PUSHACC2
+    1586 APPLY2
+    1587 BRANCHIFNOT 1597
+    1589 ACC2
+    1590 GETFIELD1
+    1591 PUSHACC2
+    1592 GETFIELD1
+    1593 PUSHACC2
+    1594 PUSHOFFSETCLOSURE0
+    1595 APPTERM3 6
+    1597 RETURN 3
+    1599 ACC2
+    1600 BRANCHIF 1605
+    1602 CONST1
+    1603 RETURN 3
+    1605 GETGLOBAL "List.for_all2"
+    1607 PUSHGETGLOBALFIELD Pervasives, 2
+    1610 APPTERM1 4
+    1612 RESTART
+    1613 GRAB 2
+    1615 ACC1
+    1616 BRANCHIFNOT 1639
+    1618 ACC2
+    1619 BRANCHIFNOT 1646
+    1621 ACC2
+    1622 GETFIELD0
+    1623 PUSHACC2
+    1624 GETFIELD0
+    1625 PUSHACC2
+    1626 APPLY2
+    1627 BRANCHIF 1637
+    1629 ACC2
+    1630 GETFIELD1
+    1631 PUSHACC2
+    1632 GETFIELD1
+    1633 PUSHACC2
+    1634 PUSHOFFSETCLOSURE0
+    1635 APPTERM3 6
+    1637 RETURN 3
+    1639 ACC2
+    1640 BRANCHIFNOT 1644
+    1642 BRANCH 1646
+    1644 RETURN 3
+    1646 GETGLOBAL "List.exists2"
+    1648 PUSHGETGLOBALFIELD Pervasives, 2
+    1651 APPTERM1 4
+    1653 RESTART
+    1654 GRAB 1
+    1656 ACC1
+    1657 BRANCHIFNOT 1672
+    1659 ACC0
+    1660 PUSHACC2
+    1661 GETFIELD0
+    1662 C_CALL2 equal
+    1664 BRANCHIF 1672
+    1666 ACC1
+    1667 GETFIELD1
+    1668 PUSHACC1
+    1669 PUSHOFFSETCLOSURE0
+    1670 APPTERM2 4
+    1672 RETURN 2
+    1674 RESTART
+    1675 GRAB 1
+    1677 ACC1
+    1678 BRANCHIFNOT 1692
+    1680 ACC0
+    1681 PUSHACC2
+    1682 GETFIELD0
+    1683 EQ
+    1684 BRANCHIF 1692
+    1686 ACC1
+    1687 GETFIELD1
+    1688 PUSHACC1
+    1689 PUSHOFFSETCLOSURE0
+    1690 APPTERM2 4
+    1692 RETURN 2
+    1694 RESTART
+    1695 GRAB 1
+    1697 ACC1
+    1698 BRANCHIFNOT 1719
+    1700 ACC1
+    1701 GETFIELD0
+    1702 PUSHACC1
+    1703 PUSHACC1
+    1704 GETFIELD0
+    1705 C_CALL2 equal
+    1707 BRANCHIFNOT 1713
+    1709 ACC0
+    1710 GETFIELD1
+    1711 RETURN 3
+    1713 ACC2
+    1714 GETFIELD1
+    1715 PUSHACC2
+    1716 PUSHOFFSETCLOSURE0
+    1717 APPTERM2 5
+    1719 GETGLOBAL Not_found
+    1721 MAKEBLOCK1 0
+    1723 RAISE
+    1724 RESTART
+    1725 GRAB 1
+    1727 ACC1
+    1728 BRANCHIFNOT 1748
+    1730 ACC1
+    1731 GETFIELD0
+    1732 PUSHACC1
+    1733 PUSHACC1
+    1734 GETFIELD0
+    1735 EQ
+    1736 BRANCHIFNOT 1742
+    1738 ACC0
+    1739 GETFIELD1
+    1740 RETURN 3
+    1742 ACC2
+    1743 GETFIELD1
+    1744 PUSHACC2
+    1745 PUSHOFFSETCLOSURE0
+    1746 APPTERM2 5
+    1748 GETGLOBAL Not_found
+    1750 MAKEBLOCK1 0
+    1752 RAISE
+    1753 RESTART
+    1754 GRAB 1
+    1756 ACC1
+    1757 BRANCHIFNOT 1773
+    1759 ACC0
+    1760 PUSHACC2
+    1761 GETFIELD0
+    1762 GETFIELD0
+    1763 C_CALL2 equal
+    1765 BRANCHIF 1773
+    1767 ACC1
+    1768 GETFIELD1
+    1769 PUSHACC1
+    1770 PUSHOFFSETCLOSURE0
+    1771 APPTERM2 4
+    1773 RETURN 2
+    1775 RESTART
+    1776 GRAB 1
+    1778 ACC1
+    1779 BRANCHIFNOT 1794
+    1781 ACC0
+    1782 PUSHACC2
+    1783 GETFIELD0
+    1784 GETFIELD0
+    1785 EQ
+    1786 BRANCHIF 1794
+    1788 ACC1
+    1789 GETFIELD1
+    1790 PUSHACC1
+    1791 PUSHOFFSETCLOSURE0
+    1792 APPTERM2 4
+    1794 RETURN 2
+    1796 RESTART
+    1797 GRAB 1
+    1799 ACC1
+    1800 BRANCHIFNOT 1825
+    1802 ACC1
+    1803 GETFIELD0
+    1804 PUSHACC2
+    1805 GETFIELD1
+    1806 PUSHACC2
+    1807 PUSHACC2
+    1808 GETFIELD0
+    1809 C_CALL2 equal
+    1811 BRANCHIFNOT 1816
+    1813 ACC0
+    1814 RETURN 4
+    1816 ACC0
+    1817 PUSHACC3
+    1818 PUSHOFFSETCLOSURE0
+    1819 APPLY2
+    1820 PUSHACC2
+    1821 MAKEBLOCK2 0
+    1823 POP 2
+    1825 RETURN 2
+    1827 RESTART
+    1828 GRAB 1
+    1830 ACC1
+    1831 BRANCHIFNOT 1855
+    1833 ACC1
+    1834 GETFIELD0
+    1835 PUSHACC2
+    1836 GETFIELD1
+    1837 PUSHACC2
+    1838 PUSHACC2
+    1839 GETFIELD0
+    1840 EQ
+    1841 BRANCHIFNOT 1846
+    1843 ACC0
+    1844 RETURN 4
+    1846 ACC0
+    1847 PUSHACC3
+    1848 PUSHOFFSETCLOSURE0
+    1849 APPLY2
+    1850 PUSHACC2
+    1851 MAKEBLOCK2 0
+    1853 POP 2
+    1855 RETURN 2
+    1857 RESTART
+    1858 GRAB 1
+    1860 ACC1
+    1861 BRANCHIFNOT 1879
+    1863 ACC1
+    1864 GETFIELD0
+    1865 PUSHACC0
+    1866 PUSHACC2
+    1867 APPLY1
+    1868 BRANCHIFNOT 1873
+    1870 ACC0
+    1871 RETURN 3
+    1873 ACC2
+    1874 GETFIELD1
+    1875 PUSHACC2
+    1876 PUSHOFFSETCLOSURE0
+    1877 APPTERM2 5
+    1879 GETGLOBAL Not_found
+    1881 MAKEBLOCK1 0
+    1883 RAISE
+    1884 RESTART
+    1885 GRAB 2
+    1887 ACC2
+    1888 BRANCHIFNOT 1917
+    1890 ACC2
+    1891 GETFIELD0
+    1892 PUSHACC3
+    1893 GETFIELD1
+    1894 PUSHACC1
+    1895 PUSHENVACC2
+    1896 APPLY1
+    1897 BRANCHIFNOT 1908
+    1899 ACC0
+    1900 PUSHACC4
+    1901 PUSHACC4
+    1902 PUSHACC4
+    1903 MAKEBLOCK2 0
+    1905 PUSHOFFSETCLOSURE0
+    1906 APPTERM3 8
+    1908 ACC0
+    1909 PUSHACC4
+    1910 PUSHACC3
+    1911 MAKEBLOCK2 0
+    1913 PUSHACC4
+    1914 PUSHOFFSETCLOSURE0
+    1915 APPTERM3 8
+    1917 ACC1
+    1918 PUSHENVACC1
+    1919 APPLY1
+    1920 PUSHACC1
+    1921 PUSHENVACC1
+    1922 APPLY1
+    1923 MAKEBLOCK2 0
+    1925 RETURN 3
+    1927 RESTART
+    1928 GRAB 1
+    1930 ACC0
+    1931 PUSHENVACC1
+    1932 CLOSUREREC 2, 1885
+    1936 ACC2
+    1937 PUSHCONST0
+    1938 PUSHCONST0
+    1939 PUSHACC3
+    1940 APPTERM3 6
+    1942 ACC0
+    1943 BRANCHIFNOT 1967
+    1945 ACC0
+    1946 GETFIELD0
+    1947 PUSHACC1
+    1948 GETFIELD1
+    1949 PUSHOFFSETCLOSURE0
+    1950 APPLY1
+    1951 PUSHACC0
+    1952 GETFIELD1
+    1953 PUSHACC2
+    1954 GETFIELD1
+    1955 MAKEBLOCK2 0
+    1957 PUSHACC1
+    1958 GETFIELD0
+    1959 PUSHACC3
+    1960 GETFIELD0
+    1961 MAKEBLOCK2 0
+    1963 MAKEBLOCK2 0
+    1965 RETURN 3
+    1967 GETGLOBAL <0>(0, 0)
+    1969 RETURN 1
+    1971 RESTART
+    1972 GRAB 1
+    1974 ACC0
+    1975 BRANCHIFNOT 1996
+    1977 ACC1
+    1978 BRANCHIFNOT 2003
+    1980 ACC1
+    1981 GETFIELD1
+    1982 PUSHACC1
+    1983 GETFIELD1
+    1984 PUSHOFFSETCLOSURE0
+    1985 APPLY2
+    1986 PUSHACC2
+    1987 GETFIELD0
+    1988 PUSHACC2
+    1989 GETFIELD0
+    1990 MAKEBLOCK2 0
+    1992 MAKEBLOCK2 0
+    1994 RETURN 2
+    1996 ACC1
+    1997 BRANCHIFNOT 2001
+    1999 BRANCH 2003
+    2001 RETURN 2
+    2003 GETGLOBAL "List.combine"
+    2005 PUSHGETGLOBALFIELD Pervasives, 2
+    2008 APPTERM1 3
+    2010 RESTART
+    2011 GRAB 1
+    2013 ACC1
+    2014 BRANCHIFNOT 2038
+    2016 ACC1
+    2017 GETFIELD0
+    2018 PUSHACC2
+    2019 GETFIELD1
+    2020 PUSHACC1
+    2021 PUSHENVACC2
+    2022 APPLY1
+    2023 BRANCHIFNOT 2033
+    2025 ACC0
+    2026 PUSHACC3
+    2027 PUSHACC3
+    2028 MAKEBLOCK2 0
+    2030 PUSHOFFSETCLOSURE0
+    2031 APPTERM2 6
+    2033 ACC0
+    2034 PUSHACC3
+    2035 PUSHOFFSETCLOSURE0
+    2036 APPTERM2 6
+    2038 ACC0
+    2039 PUSHENVACC1
+    2040 APPTERM1 3
+    2042 ACC0
+    2043 PUSHENVACC1
+    2044 CLOSUREREC 2, 2011
+    2048 CONST0
+    2049 PUSHACC1
+    2050 APPTERM1 3
+    2052 RESTART
+    2053 GRAB 2
+    2055 ACC1
+    2056 BRANCHIFNOT 2077
+    2058 ACC2
+    2059 BRANCHIFNOT 2084
+    2061 ACC2
+    2062 GETFIELD1
+    2063 PUSHACC2
+    2064 GETFIELD1
+    2065 PUSHACC2
+    2066 PUSHACC5
+    2067 GETFIELD0
+    2068 PUSHACC5
+    2069 GETFIELD0
+    2070 PUSHENVACC1
+    2071 APPLY2
+    2072 MAKEBLOCK2 0
+    2074 PUSHOFFSETCLOSURE0
+    2075 APPTERM3 6
+    2077 ACC2
+    2078 BRANCHIFNOT 2082
+    2080 BRANCH 2084
+    2082 RETURN 3
+    2084 GETGLOBAL "List.rev_map2"
+    2086 PUSHGETGLOBALFIELD Pervasives, 2
+    2089 APPTERM1 4
+    2091 RESTART
+    2092 GRAB 2
+    2094 ACC0
+    2095 CLOSUREREC 1, 2053
+    2099 ACC3
+    2100 PUSHACC3
+    2101 PUSHCONST0
+    2102 PUSHACC3
+    2103 APPTERM3 7
+    2105 RESTART
+    2106 GRAB 1
+    2108 ACC1
+    2109 BRANCHIFNOT 2123
+    2111 ACC1
+    2112 GETFIELD1
+    2113 PUSHACC1
+    2114 PUSHACC3
+    2115 GETFIELD0
+    2116 PUSHENVACC1
+    2117 APPLY1
+    2118 MAKEBLOCK2 0
+    2120 PUSHOFFSETCLOSURE0
+    2121 APPTERM2 4
+    2123 ACC0
+    2124 RETURN 2
+    2126 RESTART
+    2127 GRAB 1
+    2129 ACC0
+    2130 CLOSUREREC 1, 2106
+    2134 ACC2
+    2135 PUSHCONST0
+    2136 PUSHACC2
+    2137 APPTERM2 5
+    2139 CONST0
+    2140 PUSHACC1
+    2141 PUSHENVACC1
+    2142 APPTERM2 3
+    2144 ACC0
+    2145 BRANCHIFNOT 2151
+    2147 ACC0
+    2148 GETFIELD1
+    2149 RETURN 1
+    2151 GETGLOBAL "tl"
+    2153 PUSHGETGLOBALFIELD Pervasives, 3
+    2156 APPTERM1 2
+    2158 ACC0
+    2159 BRANCHIFNOT 2165
+    2161 ACC0
+    2162 GETFIELD0
+    2163 RETURN 1
+    2165 GETGLOBAL "hd"
+    2167 PUSHGETGLOBALFIELD Pervasives, 3
+    2170 APPTERM1 2
+    2172 ACC0
+    2173 PUSHCONST0
+    2174 PUSHENVACC1
+    2175 APPTERM2 3
+    2177 CLOSUREREC 0, 1200
+    2181 ACC0
+    2182 CLOSURE 1, 2172
+    2185 PUSH
+    2186 CLOSURE 0, 2158
+    2189 PUSH
+    2190 CLOSURE 0, 2144
+    2193 PUSH
+    2194 CLOSUREREC 0, 1217
+    2198 GETGLOBALFIELD Pervasives, 16
+    2201 PUSH
+    2202 CLOSUREREC 0, 1259
+    2206 ACC0
+    2207 CLOSURE 1, 2139
+    2210 PUSH
+    2211 CLOSUREREC 0, 1277
+    2215 CLOSUREREC 0, 1294
+    2219 CLOSURE 0, 2127
+    2222 PUSH
+    2223 CLOSUREREC 0, 1316
+    2227 CLOSUREREC 0, 1334
+    2231 CLOSUREREC 0, 1354
+    2235 CLOSUREREC 0, 1374
+    2239 CLOSURE 0, 2092
+    2242 PUSH
+    2243 CLOSUREREC 0, 1415
+    2247 CLOSUREREC 0, 1452
+    2251 CLOSUREREC 0, 1490
+    2255 CLOSUREREC 0, 1530
+    2259 CLOSUREREC 0, 1553
+    2263 CLOSUREREC 0, 1573
+    2267 CLOSUREREC 0, 1613
+    2271 CLOSUREREC 0, 1654
+    2275 CLOSUREREC 0, 1675
+    2279 CLOSUREREC 0, 1695
+    2283 CLOSUREREC 0, 1725
+    2287 CLOSUREREC 0, 1754
+    2291 CLOSUREREC 0, 1776
+    2295 CLOSUREREC 0, 1797
+    2299 CLOSUREREC 0, 1828
+    2303 CLOSUREREC 0, 1858
+    2307 ACC 24
+    2309 CLOSURE 1, 2042
+    2312 PUSHACC 25
+    2314 CLOSUREREC 1, 1928
+    2318 CLOSUREREC 0, 1942
+    2322 CLOSUREREC 0, 1972
+    2326 ACC0
+    2327 PUSHACC2
+    2328 PUSHACC7
+    2329 PUSHACC 9
+    2331 PUSHACC 11
+    2333 PUSHACC 13
+    2335 PUSHACC 15
+    2337 PUSHACC 17
+    2339 PUSHACC 10
+    2341 PUSHACC 12
+    2343 PUSHACC 13
+    2345 PUSHACC 15
+    2347 PUSHACC 23
+    2349 PUSHACC 25
+    2351 PUSHACC 27
+    2353 PUSHACC 29
+    2355 PUSHACC 31
+    2357 PUSHACC 33
+    2359 PUSHACC 35
+    2361 PUSHACC 37
+    2363 PUSHACC 40
+    2365 PUSHACC 42
+    2367 PUSHACC 41
+    2369 PUSHACC 45
+    2371 PUSHACC 47
+    2373 PUSHACC 50
+    2375 PUSHACC 52
+    2377 PUSHACC 51
+    2379 PUSHACC 55
+    2381 PUSHACC 56
+    2383 PUSHACC 59
+    2385 PUSHACC 61
+    2387 PUSHACC 60
+    2389 PUSHACC 64
+    2391 PUSHACC 66
+    2393 PUSHACC 68
+    2395 PUSHACC 70
+    2397 MAKEBLOCK 37, 0
+    2400 POP 36
+    2402 SETGLOBAL List
+    2404 BRANCH 2435
+    2406 RESTART
+    2407 GRAB 1
+    2409 CONST0
+    2410 PUSHACC2
+    2411 LEINT
+    2412 BRANCHIFNOT 2417
+    2414 ACC0
+    2415 RETURN 2
+    2417 ACC1
+    2418 OFFSETINT -1
+    2420 PUSHACC1
+    2421 PUSHCONST1
+    2422 MAKEBLOCK2 0
+    2424 PUSHOFFSETCLOSURE0
+    2425 APPTERM2 4
+    2427 RESTART
+    2428 GRAB 1
+    2430 ACC1
+    2431 PUSHACC1
+    2432 ADDINT
+    2433 RETURN 2
+    2435 CLOSUREREC 0, 2407
+    2439 CONSTINT 30000
+    2441 PUSHCONST0
+    2442 PUSHACC2
+    2443 APPLY2
+    2444 PUSHCONSTINT 30000
+    2446 PUSHACC1
+    2447 PUSHCONST0
+    2448 PUSH
+    2449 CLOSURE 0, 2428
+    2452 PUSHGETGLOBALFIELD List, 12
+    2455 APPLY3
+    2456 NEQ
+    2457 BRANCHIFNOT 2464
+    2459 GETGLOBAL Not_found
+    2461 MAKEBLOCK1 0
+    2463 RAISE
+    2464 POP 2
+    2466 ATOM0
+    2467 SETGLOBAL T310-alloc-1
+    2469 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t310-alloc-2.ml b/testsuite/tests/tool-ocaml/t310-alloc-2.ml
new file mode 100644
index 00000000..10a8d753
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t310-alloc-2.ml
@@ -0,0 +1,2321 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let v = Array.make 200000 2 in
+let t = ref 0 in
+Array.iter (fun x -> t := !t + x) v;
+if !t <> 400000 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 746
+      11 RESTART
+      12 GRAB 1
+      14 ACC0
+      15 BRANCHIFNOT 28
+      17 ACC1
+      18 PUSHACC1
+      19 GETFIELD1
+      20 PUSHOFFSETCLOSURE0
+      21 APPLY2
+      22 PUSHACC1
+      23 GETFIELD0
+      24 MAKEBLOCK2 0
+      26 RETURN 2
+      28 ACC1
+      29 RETURN 2
+      31 RESTART
+      32 GRAB 3
+      34 CONST0
+      35 PUSHACC4
+      36 LEINT
+      37 BRANCHIFNOT 42
+      39 CONST0
+      40 RETURN 4
+      42 ACC3
+      43 PUSHACC3
+      44 PUSHACC3
+      45 PUSHACC3
+      46 C_CALL4 caml_input
+      48 PUSHCONST0
+      49 PUSHACC1
+      50 EQ
+      51 BRANCHIFNOT 58
+      53 GETGLOBAL End_of_file
+      55 MAKEBLOCK1 0
+      57 RAISE
+      58 ACC0
+      59 PUSHACC5
+      60 SUBINT
+      61 PUSHACC1
+      62 PUSHACC5
+      63 ADDINT
+      64 PUSHACC4
+      65 PUSHACC4
+      66 PUSHOFFSETCLOSURE0
+      67 APPTERM 4, 9
+      70 ACC0
+      71 C_CALL1 caml_input_scan_line
+      73 PUSHCONST0
+      74 PUSHACC1
+      75 EQ
+      76 BRANCHIFNOT 83
+      78 GETGLOBAL End_of_file
+      80 MAKEBLOCK1 0
+      82 RAISE
+      83 CONST0
+      84 PUSHACC1
+      85 GTINT
+      86 BRANCHIFNOT 107
+      88 ACC0
+      89 OFFSETINT -1
+      91 C_CALL1 create_string
+      93 PUSHACC1
+      94 OFFSETINT -1
+      96 PUSHCONST0
+      97 PUSHACC2
+      98 PUSHACC5
+      99 C_CALL4 caml_input
+     101 ACC2
+     102 C_CALL1 caml_input_char
+     104 ACC0
+     105 RETURN 3
+     107 ACC0
+     108 NEGINT
+     109 C_CALL1 create_string
+     111 PUSHACC1
+     112 NEGINT
+     113 PUSHCONST0
+     114 PUSHACC2
+     115 PUSHACC5
+     116 C_CALL4 caml_input
+     118 CONST0
+     119 PUSHTRAP 130
+     121 ACC6
+     122 PUSHOFFSETCLOSURE0
+     123 APPLY1
+     124 PUSHACC5
+     125 PUSHENVACC1
+     126 APPLY2
+     127 POPTRAP
+     128 RETURN 3
+     130 PUSHGETGLOBAL End_of_file
+     132 PUSHACC1
+     133 GETFIELD0
+     134 EQ
+     135 BRANCHIFNOT 140
+     137 ACC1
+     138 RETURN 4
+     140 ACC0
+     141 RAISE
+     142 ACC0
+     143 C_CALL1 caml_flush
+     145 RETURN 1
+     147 RESTART
+     148 GRAB 1
+     150 ACC1
+     151 PUSHACC1
+     152 C_CALL2 caml_output_char
+     154 RETURN 2
+     156 RESTART
+     157 GRAB 1
+     159 ACC1
+     160 PUSHACC1
+     161 C_CALL2 caml_output_char
+     163 RETURN 2
+     165 RESTART
+     166 GRAB 1
+     168 ACC1
+     169 PUSHACC1
+     170 C_CALL2 caml_output_int
+     172 RETURN 2
+     174 RESTART
+     175 GRAB 1
+     177 ACC1
+     178 PUSHACC1
+     179 C_CALL2 caml_seek_out
+     181 RETURN 2
+     183 ACC0
+     184 C_CALL1 caml_pos_out
+     186 RETURN 1
+     188 ACC0
+     189 C_CALL1 caml_channel_size
+     191 RETURN 1
+     193 RESTART
+     194 GRAB 1
+     196 ACC1
+     197 PUSHACC1
+     198 C_CALL2 caml_set_binary_mode
+     200 RETURN 2
+     202 ACC0
+     203 C_CALL1 caml_input_char
+     205 RETURN 1
+     207 ACC0
+     208 C_CALL1 caml_input_char
+     210 RETURN 1
+     212 ACC0
+     213 C_CALL1 caml_input_int
+     215 RETURN 1
+     217 ACC0
+     218 C_CALL1 input_value
+     220 RETURN 1
+     222 RESTART
+     223 GRAB 1
+     225 ACC1
+     226 PUSHACC1
+     227 C_CALL2 caml_seek_in
+     229 RETURN 2
+     231 ACC0
+     232 C_CALL1 caml_pos_in
+     234 RETURN 1
+     236 ACC0
+     237 C_CALL1 caml_channel_size
+     239 RETURN 1
+     241 ACC0
+     242 C_CALL1 caml_close_channel
+     244 RETURN 1
+     246 RESTART
+     247 GRAB 1
+     249 ACC1
+     250 PUSHACC1
+     251 C_CALL2 caml_set_binary_mode
+     253 RETURN 2
+     255 CONST0
+     256 PUSHENVACC1
+     257 APPLY1
+     258 ACC0
+     259 C_CALL1 sys_exit
+     261 RETURN 1
+     263 CONST0
+     264 PUSHENVACC1
+     265 GETFIELD0
+     266 APPTERM1 2
+     268 CONST0
+     269 PUSHENVACC1
+     270 APPLY1
+     271 CONST0
+     272 PUSHENVACC2
+     273 APPTERM1 2
+     275 ENVACC1
+     276 GETFIELD0
+     277 PUSHACC0
+     278 PUSHACC2
+     279 CLOSURE 2, 268
+     282 PUSHENVACC1
+     283 SETFIELD0
+     284 RETURN 2
+     286 ENVACC1
+     287 C_CALL1 caml_flush
+     289 ENVACC2
+     290 C_CALL1 caml_flush
+     292 RETURN 1
+     294 CONST0
+     295 PUSHENVACC1
+     296 APPLY1
+     297 C_CALL1 float_of_string
+     299 RETURN 1
+     301 CONST0
+     302 PUSHENVACC1
+     303 APPLY1
+     304 C_CALL1 int_of_string
+     306 RETURN 1
+     308 ENVACC2
+     309 C_CALL1 caml_flush
+     311 ENVACC1
+     312 PUSHENVACC3
+     313 APPTERM1 2
+     315 CONSTINT 13
+     317 PUSHENVACC1
+     318 C_CALL2 caml_output_char
+     320 ENVACC1
+     321 C_CALL1 caml_flush
+     323 RETURN 1
+     325 ACC0
+     326 PUSHENVACC1
+     327 PUSHENVACC2
+     328 APPLY2
+     329 CONSTINT 13
+     331 PUSHENVACC1
+     332 C_CALL2 caml_output_char
+     334 ENVACC1
+     335 C_CALL1 caml_flush
+     337 RETURN 1
+     339 ACC0
+     340 PUSHENVACC1
+     341 APPLY1
+     342 PUSHENVACC2
+     343 PUSHENVACC3
+     344 APPTERM2 3
+     346 ACC0
+     347 PUSHENVACC1
+     348 APPLY1
+     349 PUSHENVACC2
+     350 PUSHENVACC3
+     351 APPTERM2 3
+     353 ACC0
+     354 PUSHENVACC1
+     355 PUSHENVACC2
+     356 APPTERM2 3
+     358 ACC0
+     359 PUSHENVACC1
+     360 C_CALL2 caml_output_char
+     362 RETURN 1
+     364 CONSTINT 13
+     366 PUSHENVACC1
+     367 C_CALL2 caml_output_char
+     369 ENVACC1
+     370 C_CALL1 caml_flush
+     372 RETURN 1
+     374 ACC0
+     375 PUSHENVACC1
+     376 PUSHENVACC2
+     377 APPLY2
+     378 CONSTINT 13
+     380 PUSHENVACC1
+     381 C_CALL2 caml_output_char
+     383 RETURN 1
+     385 ACC0
+     386 PUSHENVACC1
+     387 APPLY1
+     388 PUSHENVACC2
+     389 PUSHENVACC3
+     390 APPTERM2 3
+     392 ACC0
+     393 PUSHENVACC1
+     394 APPLY1
+     395 PUSHENVACC2
+     396 PUSHENVACC3
+     397 APPTERM2 3
+     399 ACC0
+     400 PUSHENVACC1
+     401 PUSHENVACC2
+     402 APPTERM2 3
+     404 ACC0
+     405 PUSHENVACC1
+     406 C_CALL2 caml_output_char
+     408 RETURN 1
+     410 RESTART
+     411 GRAB 3
+     413 CONST0
+     414 PUSHACC3
+     415 LTINT
+     416 BRANCHIF 427
+     418 ACC1
+     419 C_CALL1 ml_string_length
+     421 PUSHACC4
+     422 PUSHACC4
+     423 ADDINT
+     424 GTINT
+     425 BRANCHIFNOT 432
+     427 GETGLOBAL "really_input"
+     429 PUSHENVACC1
+     430 APPTERM1 5
+     432 ACC3
+     433 PUSHACC3
+     434 PUSHACC3
+     435 PUSHACC3
+     436 PUSHENVACC2
+     437 APPTERM 4, 8
+     440 RESTART
+     441 GRAB 3
+     443 CONST0
+     444 PUSHACC3
+     445 LTINT
+     446 BRANCHIF 457
+     448 ACC1
+     449 C_CALL1 ml_string_length
+     451 PUSHACC4
+     452 PUSHACC4
+     453 ADDINT
+     454 GTINT
+     455 BRANCHIFNOT 462
+     457 GETGLOBAL "input"
+     459 PUSHENVACC1
+     460 APPTERM1 5
+     462 ACC3
+     463 PUSHACC3
+     464 PUSHACC3
+     465 PUSHACC3
+     466 C_CALL4 caml_input
+     468 RETURN 4
+     470 ACC0
+     471 PUSHCONST0
+     472 PUSHGETGLOBAL <0>(0, <0>(6, 0))
+     474 PUSHENVACC1
+     475 APPTERM3 4
+     477 ACC0
+     478 PUSHCONST0
+     479 PUSHGETGLOBAL <0>(0, <0>(7, 0))
+     481 PUSHENVACC1
+     482 APPTERM3 4
+     484 RESTART
+     485 GRAB 2
+     487 ACC1
+     488 PUSHACC1
+     489 PUSHACC4
+     490 C_CALL3 sys_open
+     492 C_CALL1 caml_open_descriptor
+     494 RETURN 3
+     496 ACC0
+     497 C_CALL1 caml_flush
+     499 ACC0
+     500 C_CALL1 caml_close_channel
+     502 RETURN 1
+     504 RESTART
+     505 GRAB 1
+     507 CONST0
+     508 PUSHACC2
+     509 PUSHACC2
+     510 C_CALL3 output_value
+     512 RETURN 2
+     514 RESTART
+     515 GRAB 3
+     517 CONST0
+     518 PUSHACC3
+     519 LTINT
+     520 BRANCHIF 531
+     522 ACC1
+     523 C_CALL1 ml_string_length
+     525 PUSHACC4
+     526 PUSHACC4
+     527 ADDINT
+     528 GTINT
+     529 BRANCHIFNOT 536
+     531 GETGLOBAL "output"
+     533 PUSHENVACC1
+     534 APPTERM1 5
+     536 ACC3
+     537 PUSHACC3
+     538 PUSHACC3
+     539 PUSHACC3
+     540 C_CALL4 caml_output
+     542 RETURN 4
+     544 RESTART
+     545 GRAB 1
+     547 ACC1
+     548 C_CALL1 ml_string_length
+     550 PUSHCONST0
+     551 PUSHACC3
+     552 PUSHACC3
+     553 C_CALL4 caml_output
+     555 RETURN 2
+     557 ACC0
+     558 PUSHCONSTINT 438
+     560 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(6, 0))))
+     562 PUSHENVACC1
+     563 APPTERM3 4
+     565 ACC0
+     566 PUSHCONSTINT 438
+     568 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(7, 0))))
+     570 PUSHENVACC1
+     571 APPTERM3 4
+     573 RESTART
+     574 GRAB 2
+     576 ACC1
+     577 PUSHACC1
+     578 PUSHACC4
+     579 C_CALL3 sys_open
+     581 C_CALL1 caml_open_descriptor
+     583 RETURN 3
+     585 ACC0
+     586 PUSHGETGLOBAL "%.12g"
+     588 C_CALL2 format_float
+     590 RETURN 1
+     592 ACC0
+     593 PUSHGETGLOBAL "%d"
+     595 C_CALL2 format_int
+     597 RETURN 1
+     599 GETGLOBAL "false"
+     601 PUSHACC1
+     602 C_CALL2 string_equal
+     604 BRANCHIFNOT 609
+     606 CONST0
+     607 RETURN 1
+     609 GETGLOBAL "true"
+     611 PUSHACC1
+     612 C_CALL2 string_equal
+     614 BRANCHIFNOT 619
+     616 CONST1
+     617 RETURN 1
+     619 GETGLOBAL "bool_of_string"
+     621 PUSHENVACC1
+     622 APPTERM1 2
+     624 ACC0
+     625 BRANCHIFNOT 631
+     627 GETGLOBAL "true"
+     629 RETURN 1
+     631 GETGLOBAL "false"
+     633 RETURN 1
+     635 CONST0
+     636 PUSHACC1
+     637 LTINT
+     638 BRANCHIF 646
+     640 CONSTINT 255
+     642 PUSHACC1
+     643 GTINT
+     644 BRANCHIFNOT 651
+     646 GETGLOBAL "char_of_int"
+     648 PUSHENVACC1
+     649 APPTERM1 2
+     651 ACC0
+     652 RETURN 1
+     654 RESTART
+     655 GRAB 1
+     657 ACC0
+     658 C_CALL1 ml_string_length
+     660 PUSHACC2
+     661 C_CALL1 ml_string_length
+     663 PUSHACC0
+     664 PUSHACC2
+     665 ADDINT
+     666 C_CALL1 create_string
+     668 PUSHACC2
+     669 PUSHCONST0
+     670 PUSHACC2
+     671 PUSHCONST0
+     672 PUSHACC7
+     673 C_CALL5 blit_string
+     675 ACC1
+     676 PUSHACC3
+     677 PUSHACC2
+     678 PUSHCONST0
+     679 PUSHACC 8
+     681 C_CALL5 blit_string
+     683 ACC0
+     684 RETURN 5
+     686 CONSTINT -1
+     688 PUSHACC1
+     689 XORINT
+     690 RETURN 1
+     692 CONST0
+     693 PUSHACC1
+     694 GEINT
+     695 BRANCHIFNOT 700
+     697 ACC0
+     698 RETURN 1
+     700 ACC0
+     701 NEGINT
+     702 RETURN 1
+     704 RESTART
+     705 GRAB 1
+     707 ACC1
+     708 PUSHACC1
+     709 C_CALL2 greaterequal
+     711 BRANCHIFNOT 716
+     713 ACC0
+     714 RETURN 2
+     716 ACC1
+     717 RETURN 2
+     719 RESTART
+     720 GRAB 1
+     722 ACC1
+     723 PUSHACC1
+     724 C_CALL2 lessequal
+     726 BRANCHIFNOT 731
+     728 ACC0
+     729 RETURN 2
+     731 ACC1
+     732 RETURN 2
+     734 ACC0
+     735 PUSHGETGLOBAL Invalid_argument
+     737 MAKEBLOCK2 0
+     739 RAISE
+     740 ACC0
+     741 PUSHGETGLOBAL Failure
+     743 MAKEBLOCK2 0
+     745 RAISE
+     746 CLOSURE 0, 740
+     749 PUSH
+     750 CLOSURE 0, 734
+     753 PUSHGETGLOBAL "Pervasives.Exit"
+     755 MAKEBLOCK1 0
+     757 PUSHGETGLOBAL "Pervasives.Assert_failure"
+     759 MAKEBLOCK1 0
+     761 PUSH
+     762 CLOSURE 0, 720
+     765 PUSH
+     766 CLOSURE 0, 705
+     769 PUSH
+     770 CLOSURE 0, 692
+     773 PUSH
+     774 CLOSURE 0, 686
+     777 PUSHCONST0
+     778 PUSHCONSTINT 31
+     780 PUSHCONST1
+     781 LSLINT
+     782 EQ
+     783 BRANCHIFNOT 789
+     785 CONSTINT 30
+     787 BRANCH 791
+     789 CONSTINT 62
+     791 PUSHCONST1
+     792 LSLINT
+     793 PUSHACC0
+     794 OFFSETINT -1
+     796 PUSH
+     797 CLOSURE 0, 655
+     800 PUSHACC 9
+     802 CLOSURE 1, 635
+     805 PUSH
+     806 CLOSURE 0, 624
+     809 PUSHACC 11
+     811 CLOSURE 1, 599
+     814 PUSH
+     815 CLOSURE 0, 592
+     818 PUSH
+     819 CLOSURE 0, 585
+     822 PUSH
+     823 CLOSUREREC 0, 12
+     827 CONST0
+     828 C_CALL1 caml_open_descriptor
+     830 PUSHCONST1
+     831 C_CALL1 caml_open_descriptor
+     833 PUSHCONST2
+     834 C_CALL1 caml_open_descriptor
+     836 PUSH
+     837 CLOSURE 0, 574
+     840 PUSHACC0
+     841 CLOSURE 1, 565
+     844 PUSHACC1
+     845 CLOSURE 1, 557
+     848 PUSH
+     849 CLOSURE 0, 545
+     852 PUSHACC 22
+     854 CLOSURE 1, 515
+     857 PUSH
+     858 CLOSURE 0, 505
+     861 PUSH
+     862 CLOSURE 0, 496
+     865 PUSH
+     866 CLOSURE 0, 485
+     869 PUSHACC0
+     870 CLOSURE 1, 477
+     873 PUSHACC1
+     874 CLOSURE 1, 470
+     877 PUSHACC 28
+     879 CLOSURE 1, 441
+     882 PUSH
+     883 CLOSUREREC 0, 32
+     887 ACC0
+     888 PUSHACC 31
+     890 CLOSURE 2, 411
+     893 PUSHACC 22
+     895 CLOSUREREC 1, 70
+     899 ACC 15
+     901 CLOSURE 1, 404
+     904 PUSHACC 11
+     906 PUSHACC 17
+     908 CLOSURE 2, 399
+     911 PUSHACC 12
+     913 PUSHACC 18
+     915 PUSHACC 23
+     917 CLOSURE 3, 392
+     920 PUSHACC 13
+     922 PUSHACC 19
+     924 PUSHACC 23
+     926 CLOSURE 3, 385
+     929 PUSHACC 14
+     931 PUSHACC 20
+     933 CLOSURE 2, 374
+     936 PUSHACC 20
+     938 CLOSURE 1, 364
+     941 PUSHACC 20
+     943 CLOSURE 1, 358
+     946 PUSHACC 17
+     948 PUSHACC 22
+     950 CLOSURE 2, 353
+     953 PUSHACC 18
+     955 PUSHACC 23
+     957 PUSHACC 29
+     959 CLOSURE 3, 346
+     962 PUSHACC 19
+     964 PUSHACC 24
+     966 PUSHACC 29
+     968 CLOSURE 3, 339
+     971 PUSHACC 20
+     973 PUSHACC 25
+     975 CLOSURE 2, 325
+     978 PUSHACC 25
+     980 CLOSURE 1, 315
+     983 PUSHACC 12
+     985 PUSHACC 28
+     987 PUSHACC 30
+     989 CLOSURE 3, 308
+     992 PUSHACC0
+     993 CLOSURE 1, 301
+     996 PUSHACC1
+     997 CLOSURE 1, 294
+    1000 PUSHACC 29
+    1002 PUSHACC 31
+    1004 CLOSURE 2, 286
+    1007 MAKEBLOCK1 0
+    1009 PUSHACC0
+    1010 CLOSURE 1, 275
+    1013 PUSHACC1
+    1014 CLOSURE 1, 263
+    1017 PUSHACC0
+    1018 CLOSURE 1, 255
+    1021 PUSHACC1
+    1022 PUSHACC 22
+    1024 PUSHACC4
+    1025 PUSHACC3
+    1026 PUSH
+    1027 CLOSURE 0, 247
+    1030 PUSH
+    1031 CLOSURE 0, 241
+    1034 PUSH
+    1035 CLOSURE 0, 236
+    1038 PUSH
+    1039 CLOSURE 0, 231
+    1042 PUSH
+    1043 CLOSURE 0, 223
+    1046 PUSH
+    1047 CLOSURE 0, 217
+    1050 PUSH
+    1051 CLOSURE 0, 212
+    1054 PUSH
+    1055 CLOSURE 0, 207
+    1058 PUSHACC 32
+    1060 PUSHACC 35
+    1062 PUSHACC 33
+    1064 PUSH
+    1065 CLOSURE 0, 202
+    1068 PUSHACC 41
+    1070 PUSHACC 40
+    1072 PUSHACC 42
+    1074 PUSH
+    1075 CLOSURE 0, 194
+    1078 PUSHACC 46
+    1080 PUSH
+    1081 CLOSURE 0, 188
+    1084 PUSH
+    1085 CLOSURE 0, 183
+    1088 PUSH
+    1089 CLOSURE 0, 175
+    1092 PUSHACC 51
+    1094 PUSH
+    1095 CLOSURE 0, 166
+    1098 PUSH
+    1099 CLOSURE 0, 157
+    1102 PUSHACC 55
+    1104 PUSHACC 57
+    1106 PUSH
+    1107 CLOSURE 0, 148
+    1110 PUSH
+    1111 CLOSURE 0, 142
+    1114 PUSHACC 63
+    1116 PUSHACC 62
+    1118 PUSHACC 64
+    1120 PUSHACC 38
+    1122 PUSHACC 40
+    1124 PUSHACC 42
+    1126 PUSHACC 44
+    1128 PUSHACC 46
+    1130 PUSHACC 48
+    1132 PUSHACC 50
+    1134 PUSHACC 52
+    1136 PUSHACC 54
+    1138 PUSHACC 56
+    1140 PUSHACC 58
+    1142 PUSHACC 60
+    1144 PUSHACC 62
+    1146 PUSHACC 64
+    1148 PUSHACC 66
+    1150 PUSHACC 82
+    1152 PUSHACC 84
+    1154 PUSHACC 86
+    1156 PUSHACC 88
+    1158 PUSHACC 90
+    1160 PUSHACC 92
+    1162 PUSHACC 94
+    1164 PUSHACC 96
+    1166 PUSHACC 98
+    1168 PUSHACC 100
+    1170 PUSHACC 104
+    1172 PUSHACC 104
+    1174 PUSHACC 104
+    1176 PUSHACC 108
+    1178 PUSHACC 110
+    1180 PUSHACC 112
+    1182 PUSHACC 117
+    1184 PUSHACC 117
+    1186 PUSHACC 117
+    1188 PUSHACC 117
+    1190 MAKEBLOCK 69, 0
+    1193 POP 53
+    1195 SETGLOBAL Pervasives
+    1197 BRANCH 2177
+    1199 RESTART
+    1200 GRAB 1
+    1202 ACC1
+    1203 BRANCHIFNOT 1213
+    1205 ACC1
+    1206 GETFIELD1
+    1207 PUSHACC1
+    1208 OFFSETINT 1
+    1210 PUSHOFFSETCLOSURE0
+    1211 APPTERM2 4
+    1213 ACC0
+    1214 RETURN 2
+    1216 RESTART
+    1217 GRAB 1
+    1219 ACC0
+    1220 BRANCHIFNOT 1251
+    1222 CONST0
+    1223 PUSHACC2
+    1224 EQ
+    1225 BRANCHIFNOT 1231
+    1227 ACC0
+    1228 GETFIELD0
+    1229 RETURN 2
+    1231 CONST0
+    1232 PUSHACC2
+    1233 GTINT
+    1234 BRANCHIFNOT 1244
+    1236 ACC1
+    1237 OFFSETINT -1
+    1239 PUSHACC1
+    1240 GETFIELD1
+    1241 PUSHOFFSETCLOSURE0
+    1242 APPTERM2 4
+    1244 GETGLOBAL "List.nth"
+    1246 PUSHGETGLOBALFIELD Pervasives, 2
+    1249 APPTERM1 3
+    1251 GETGLOBAL "nth"
+    1253 PUSHGETGLOBALFIELD Pervasives, 3
+    1256 APPTERM1 3
+    1258 RESTART
+    1259 GRAB 1
+    1261 ACC0
+    1262 BRANCHIFNOT 1274
+    1264 ACC1
+    1265 PUSHACC1
+    1266 GETFIELD0
+    1267 MAKEBLOCK2 0
+    1269 PUSHACC1
+    1270 GETFIELD1
+    1271 PUSHOFFSETCLOSURE0
+    1272 APPTERM2 4
+    1274 ACC1
+    1275 RETURN 2
+    1277 ACC0
+    1278 BRANCHIFNOT 1291
+    1280 ACC0
+    1281 GETFIELD1
+    1282 PUSHOFFSETCLOSURE0
+    1283 APPLY1
+    1284 PUSHACC1
+    1285 GETFIELD0
+    1286 PUSHGETGLOBALFIELD Pervasives, 16
+    1289 APPTERM2 3
+    1291 RETURN 1
+    1293 RESTART
+    1294 GRAB 1
+    1296 ACC1
+    1297 BRANCHIFNOT 1313
+    1299 ACC1
+    1300 GETFIELD0
+    1301 PUSHACC1
+    1302 APPLY1
+    1303 PUSHACC2
+    1304 GETFIELD1
+    1305 PUSHACC2
+    1306 PUSHOFFSETCLOSURE0
+    1307 APPLY2
+    1308 PUSHACC1
+    1309 MAKEBLOCK2 0
+    1311 POP 1
+    1313 RETURN 2
+    1315 RESTART
+    1316 GRAB 1
+    1318 ACC1
+    1319 BRANCHIFNOT 1331
+    1321 ACC1
+    1322 GETFIELD0
+    1323 PUSHACC1
+    1324 APPLY1
+    1325 ACC1
+    1326 GETFIELD1
+    1327 PUSHACC1
+    1328 PUSHOFFSETCLOSURE0
+    1329 APPTERM2 4
+    1331 RETURN 2
+    1333 RESTART
+    1334 GRAB 2
+    1336 ACC2
+    1337 BRANCHIFNOT 1350
+    1339 ACC2
+    1340 GETFIELD1
+    1341 PUSHACC3
+    1342 GETFIELD0
+    1343 PUSHACC3
+    1344 PUSHACC3
+    1345 APPLY2
+    1346 PUSHACC2
+    1347 PUSHOFFSETCLOSURE0
+    1348 APPTERM3 6
+    1350 ACC1
+    1351 RETURN 3
+    1353 RESTART
+    1354 GRAB 2
+    1356 ACC1
+    1357 BRANCHIFNOT 1370
+    1359 ACC2
+    1360 PUSHACC2
+    1361 GETFIELD1
+    1362 PUSHACC2
+    1363 PUSHOFFSETCLOSURE0
+    1364 APPLY3
+    1365 PUSHACC2
+    1366 GETFIELD0
+    1367 PUSHACC2
+    1368 APPTERM2 5
+    1370 ACC2
+    1371 RETURN 3
+    1373 RESTART
+    1374 GRAB 2
+    1376 ACC1
+    1377 BRANCHIFNOT 1400
+    1379 ACC2
+    1380 BRANCHIFNOT 1407
+    1382 ACC2
+    1383 GETFIELD0
+    1384 PUSHACC2
+    1385 GETFIELD0
+    1386 PUSHACC2
+    1387 APPLY2
+    1388 PUSHACC3
+    1389 GETFIELD1
+    1390 PUSHACC3
+    1391 GETFIELD1
+    1392 PUSHACC3
+    1393 PUSHOFFSETCLOSURE0
+    1394 APPLY3
+    1395 PUSHACC1
+    1396 MAKEBLOCK2 0
+    1398 RETURN 4
+    1400 ACC2
+    1401 BRANCHIFNOT 1405
+    1403 BRANCH 1407
+    1405 RETURN 3
+    1407 GETGLOBAL "List.map2"
+    1409 PUSHGETGLOBALFIELD Pervasives, 2
+    1412 APPTERM1 4
+    1414 RESTART
+    1415 GRAB 2
+    1417 ACC1
+    1418 BRANCHIFNOT 1437
+    1420 ACC2
+    1421 BRANCHIFNOT 1444
+    1423 ACC2
+    1424 GETFIELD0
+    1425 PUSHACC2
+    1426 GETFIELD0
+    1427 PUSHACC2
+    1428 APPLY2
+    1429 ACC2
+    1430 GETFIELD1
+    1431 PUSHACC2
+    1432 GETFIELD1
+    1433 PUSHACC2
+    1434 PUSHOFFSETCLOSURE0
+    1435 APPTERM3 6
+    1437 ACC2
+    1438 BRANCHIFNOT 1442
+    1440 BRANCH 1444
+    1442 RETURN 3
+    1444 GETGLOBAL "List.iter2"
+    1446 PUSHGETGLOBALFIELD Pervasives, 2
+    1449 APPTERM1 4
+    1451 RESTART
+    1452 GRAB 3
+    1454 ACC2
+    1455 BRANCHIFNOT 1476
+    1457 ACC3
+    1458 BRANCHIFNOT 1482
+    1460 ACC3
+    1461 GETFIELD1
+    1462 PUSHACC3
+    1463 GETFIELD1
+    1464 PUSHACC5
+    1465 GETFIELD0
+    1466 PUSHACC5
+    1467 GETFIELD0
+    1468 PUSHACC5
+    1469 PUSHACC5
+    1470 APPLY3
+    1471 PUSHACC3
+    1472 PUSHOFFSETCLOSURE0
+    1473 APPTERM 4, 8
+    1476 ACC3
+    1477 BRANCHIF 1482
+    1479 ACC1
+    1480 RETURN 4
+    1482 GETGLOBAL "List.fold_left2"
+    1484 PUSHGETGLOBALFIELD Pervasives, 2
+    1487 APPTERM1 5
+    1489 RESTART
+    1490 GRAB 3
+    1492 ACC1
+    1493 BRANCHIFNOT 1516
+    1495 ACC2
+    1496 BRANCHIFNOT 1522
+    1498 PUSH_RETADDR 1509
+    1500 ACC6
+    1501 PUSHACC6
+    1502 GETFIELD1
+    1503 PUSHACC6
+    1504 GETFIELD1
+    1505 PUSHACC6
+    1506 PUSHOFFSETCLOSURE0
+    1507 APPLY 4
+    1509 PUSHACC3
+    1510 GETFIELD0
+    1511 PUSHACC3
+    1512 GETFIELD0
+    1513 PUSHACC3
+    1514 APPTERM3 7
+    1516 ACC2
+    1517 BRANCHIF 1522
+    1519 ACC3
+    1520 RETURN 4
+    1522 GETGLOBAL "List.fold_right2"
+    1524 PUSHGETGLOBALFIELD Pervasives, 2
+    1527 APPTERM1 5
+    1529 RESTART
+    1530 GRAB 1
+    1532 ACC1
+    1533 BRANCHIFNOT 1549
+    1535 ACC1
+    1536 GETFIELD0
+    1537 PUSHACC1
+    1538 APPLY1
+    1539 BRANCHIFNOT 1547
+    1541 ACC1
+    1542 GETFIELD1
+    1543 PUSHACC1
+    1544 PUSHOFFSETCLOSURE0
+    1545 APPTERM2 4
+    1547 RETURN 2
+    1549 CONST1
+    1550 RETURN 2
+    1552 RESTART
+    1553 GRAB 1
+    1555 ACC1
+    1556 BRANCHIFNOT 1570
+    1558 ACC1
+    1559 GETFIELD0
+    1560 PUSHACC1
+    1561 APPLY1
+    1562 BRANCHIF 1570
+    1564 ACC1
+    1565 GETFIELD1
+    1566 PUSHACC1
+    1567 PUSHOFFSETCLOSURE0
+    1568 APPTERM2 4
+    1570 RETURN 2
+    1572 RESTART
+    1573 GRAB 2
+    1575 ACC1
+    1576 BRANCHIFNOT 1599
+    1578 ACC2
+    1579 BRANCHIFNOT 1605
+    1581 ACC2
+    1582 GETFIELD0
+    1583 PUSHACC2
+    1584 GETFIELD0
+    1585 PUSHACC2
+    1586 APPLY2
+    1587 BRANCHIFNOT 1597
+    1589 ACC2
+    1590 GETFIELD1
+    1591 PUSHACC2
+    1592 GETFIELD1
+    1593 PUSHACC2
+    1594 PUSHOFFSETCLOSURE0
+    1595 APPTERM3 6
+    1597 RETURN 3
+    1599 ACC2
+    1600 BRANCHIF 1605
+    1602 CONST1
+    1603 RETURN 3
+    1605 GETGLOBAL "List.for_all2"
+    1607 PUSHGETGLOBALFIELD Pervasives, 2
+    1610 APPTERM1 4
+    1612 RESTART
+    1613 GRAB 2
+    1615 ACC1
+    1616 BRANCHIFNOT 1639
+    1618 ACC2
+    1619 BRANCHIFNOT 1646
+    1621 ACC2
+    1622 GETFIELD0
+    1623 PUSHACC2
+    1624 GETFIELD0
+    1625 PUSHACC2
+    1626 APPLY2
+    1627 BRANCHIF 1637
+    1629 ACC2
+    1630 GETFIELD1
+    1631 PUSHACC2
+    1632 GETFIELD1
+    1633 PUSHACC2
+    1634 PUSHOFFSETCLOSURE0
+    1635 APPTERM3 6
+    1637 RETURN 3
+    1639 ACC2
+    1640 BRANCHIFNOT 1644
+    1642 BRANCH 1646
+    1644 RETURN 3
+    1646 GETGLOBAL "List.exists2"
+    1648 PUSHGETGLOBALFIELD Pervasives, 2
+    1651 APPTERM1 4
+    1653 RESTART
+    1654 GRAB 1
+    1656 ACC1
+    1657 BRANCHIFNOT 1672
+    1659 ACC0
+    1660 PUSHACC2
+    1661 GETFIELD0
+    1662 C_CALL2 equal
+    1664 BRANCHIF 1672
+    1666 ACC1
+    1667 GETFIELD1
+    1668 PUSHACC1
+    1669 PUSHOFFSETCLOSURE0
+    1670 APPTERM2 4
+    1672 RETURN 2
+    1674 RESTART
+    1675 GRAB 1
+    1677 ACC1
+    1678 BRANCHIFNOT 1692
+    1680 ACC0
+    1681 PUSHACC2
+    1682 GETFIELD0
+    1683 EQ
+    1684 BRANCHIF 1692
+    1686 ACC1
+    1687 GETFIELD1
+    1688 PUSHACC1
+    1689 PUSHOFFSETCLOSURE0
+    1690 APPTERM2 4
+    1692 RETURN 2
+    1694 RESTART
+    1695 GRAB 1
+    1697 ACC1
+    1698 BRANCHIFNOT 1719
+    1700 ACC1
+    1701 GETFIELD0
+    1702 PUSHACC1
+    1703 PUSHACC1
+    1704 GETFIELD0
+    1705 C_CALL2 equal
+    1707 BRANCHIFNOT 1713
+    1709 ACC0
+    1710 GETFIELD1
+    1711 RETURN 3
+    1713 ACC2
+    1714 GETFIELD1
+    1715 PUSHACC2
+    1716 PUSHOFFSETCLOSURE0
+    1717 APPTERM2 5
+    1719 GETGLOBAL Not_found
+    1721 MAKEBLOCK1 0
+    1723 RAISE
+    1724 RESTART
+    1725 GRAB 1
+    1727 ACC1
+    1728 BRANCHIFNOT 1748
+    1730 ACC1
+    1731 GETFIELD0
+    1732 PUSHACC1
+    1733 PUSHACC1
+    1734 GETFIELD0
+    1735 EQ
+    1736 BRANCHIFNOT 1742
+    1738 ACC0
+    1739 GETFIELD1
+    1740 RETURN 3
+    1742 ACC2
+    1743 GETFIELD1
+    1744 PUSHACC2
+    1745 PUSHOFFSETCLOSURE0
+    1746 APPTERM2 5
+    1748 GETGLOBAL Not_found
+    1750 MAKEBLOCK1 0
+    1752 RAISE
+    1753 RESTART
+    1754 GRAB 1
+    1756 ACC1
+    1757 BRANCHIFNOT 1773
+    1759 ACC0
+    1760 PUSHACC2
+    1761 GETFIELD0
+    1762 GETFIELD0
+    1763 C_CALL2 equal
+    1765 BRANCHIF 1773
+    1767 ACC1
+    1768 GETFIELD1
+    1769 PUSHACC1
+    1770 PUSHOFFSETCLOSURE0
+    1771 APPTERM2 4
+    1773 RETURN 2
+    1775 RESTART
+    1776 GRAB 1
+    1778 ACC1
+    1779 BRANCHIFNOT 1794
+    1781 ACC0
+    1782 PUSHACC2
+    1783 GETFIELD0
+    1784 GETFIELD0
+    1785 EQ
+    1786 BRANCHIF 1794
+    1788 ACC1
+    1789 GETFIELD1
+    1790 PUSHACC1
+    1791 PUSHOFFSETCLOSURE0
+    1792 APPTERM2 4
+    1794 RETURN 2
+    1796 RESTART
+    1797 GRAB 1
+    1799 ACC1
+    1800 BRANCHIFNOT 1825
+    1802 ACC1
+    1803 GETFIELD0
+    1804 PUSHACC2
+    1805 GETFIELD1
+    1806 PUSHACC2
+    1807 PUSHACC2
+    1808 GETFIELD0
+    1809 C_CALL2 equal
+    1811 BRANCHIFNOT 1816
+    1813 ACC0
+    1814 RETURN 4
+    1816 ACC0
+    1817 PUSHACC3
+    1818 PUSHOFFSETCLOSURE0
+    1819 APPLY2
+    1820 PUSHACC2
+    1821 MAKEBLOCK2 0
+    1823 POP 2
+    1825 RETURN 2
+    1827 RESTART
+    1828 GRAB 1
+    1830 ACC1
+    1831 BRANCHIFNOT 1855
+    1833 ACC1
+    1834 GETFIELD0
+    1835 PUSHACC2
+    1836 GETFIELD1
+    1837 PUSHACC2
+    1838 PUSHACC2
+    1839 GETFIELD0
+    1840 EQ
+    1841 BRANCHIFNOT 1846
+    1843 ACC0
+    1844 RETURN 4
+    1846 ACC0
+    1847 PUSHACC3
+    1848 PUSHOFFSETCLOSURE0
+    1849 APPLY2
+    1850 PUSHACC2
+    1851 MAKEBLOCK2 0
+    1853 POP 2
+    1855 RETURN 2
+    1857 RESTART
+    1858 GRAB 1
+    1860 ACC1
+    1861 BRANCHIFNOT 1879
+    1863 ACC1
+    1864 GETFIELD0
+    1865 PUSHACC0
+    1866 PUSHACC2
+    1867 APPLY1
+    1868 BRANCHIFNOT 1873
+    1870 ACC0
+    1871 RETURN 3
+    1873 ACC2
+    1874 GETFIELD1
+    1875 PUSHACC2
+    1876 PUSHOFFSETCLOSURE0
+    1877 APPTERM2 5
+    1879 GETGLOBAL Not_found
+    1881 MAKEBLOCK1 0
+    1883 RAISE
+    1884 RESTART
+    1885 GRAB 2
+    1887 ACC2
+    1888 BRANCHIFNOT 1917
+    1890 ACC2
+    1891 GETFIELD0
+    1892 PUSHACC3
+    1893 GETFIELD1
+    1894 PUSHACC1
+    1895 PUSHENVACC2
+    1896 APPLY1
+    1897 BRANCHIFNOT 1908
+    1899 ACC0
+    1900 PUSHACC4
+    1901 PUSHACC4
+    1902 PUSHACC4
+    1903 MAKEBLOCK2 0
+    1905 PUSHOFFSETCLOSURE0
+    1906 APPTERM3 8
+    1908 ACC0
+    1909 PUSHACC4
+    1910 PUSHACC3
+    1911 MAKEBLOCK2 0
+    1913 PUSHACC4
+    1914 PUSHOFFSETCLOSURE0
+    1915 APPTERM3 8
+    1917 ACC1
+    1918 PUSHENVACC1
+    1919 APPLY1
+    1920 PUSHACC1
+    1921 PUSHENVACC1
+    1922 APPLY1
+    1923 MAKEBLOCK2 0
+    1925 RETURN 3
+    1927 RESTART
+    1928 GRAB 1
+    1930 ACC0
+    1931 PUSHENVACC1
+    1932 CLOSUREREC 2, 1885
+    1936 ACC2
+    1937 PUSHCONST0
+    1938 PUSHCONST0
+    1939 PUSHACC3
+    1940 APPTERM3 6
+    1942 ACC0
+    1943 BRANCHIFNOT 1967
+    1945 ACC0
+    1946 GETFIELD0
+    1947 PUSHACC1
+    1948 GETFIELD1
+    1949 PUSHOFFSETCLOSURE0
+    1950 APPLY1
+    1951 PUSHACC0
+    1952 GETFIELD1
+    1953 PUSHACC2
+    1954 GETFIELD1
+    1955 MAKEBLOCK2 0
+    1957 PUSHACC1
+    1958 GETFIELD0
+    1959 PUSHACC3
+    1960 GETFIELD0
+    1961 MAKEBLOCK2 0
+    1963 MAKEBLOCK2 0
+    1965 RETURN 3
+    1967 GETGLOBAL <0>(0, 0)
+    1969 RETURN 1
+    1971 RESTART
+    1972 GRAB 1
+    1974 ACC0
+    1975 BRANCHIFNOT 1996
+    1977 ACC1
+    1978 BRANCHIFNOT 2003
+    1980 ACC1
+    1981 GETFIELD1
+    1982 PUSHACC1
+    1983 GETFIELD1
+    1984 PUSHOFFSETCLOSURE0
+    1985 APPLY2
+    1986 PUSHACC2
+    1987 GETFIELD0
+    1988 PUSHACC2
+    1989 GETFIELD0
+    1990 MAKEBLOCK2 0
+    1992 MAKEBLOCK2 0
+    1994 RETURN 2
+    1996 ACC1
+    1997 BRANCHIFNOT 2001
+    1999 BRANCH 2003
+    2001 RETURN 2
+    2003 GETGLOBAL "List.combine"
+    2005 PUSHGETGLOBALFIELD Pervasives, 2
+    2008 APPTERM1 3
+    2010 RESTART
+    2011 GRAB 1
+    2013 ACC1
+    2014 BRANCHIFNOT 2038
+    2016 ACC1
+    2017 GETFIELD0
+    2018 PUSHACC2
+    2019 GETFIELD1
+    2020 PUSHACC1
+    2021 PUSHENVACC2
+    2022 APPLY1
+    2023 BRANCHIFNOT 2033
+    2025 ACC0
+    2026 PUSHACC3
+    2027 PUSHACC3
+    2028 MAKEBLOCK2 0
+    2030 PUSHOFFSETCLOSURE0
+    2031 APPTERM2 6
+    2033 ACC0
+    2034 PUSHACC3
+    2035 PUSHOFFSETCLOSURE0
+    2036 APPTERM2 6
+    2038 ACC0
+    2039 PUSHENVACC1
+    2040 APPTERM1 3
+    2042 ACC0
+    2043 PUSHENVACC1
+    2044 CLOSUREREC 2, 2011
+    2048 CONST0
+    2049 PUSHACC1
+    2050 APPTERM1 3
+    2052 RESTART
+    2053 GRAB 2
+    2055 ACC1
+    2056 BRANCHIFNOT 2077
+    2058 ACC2
+    2059 BRANCHIFNOT 2084
+    2061 ACC2
+    2062 GETFIELD1
+    2063 PUSHACC2
+    2064 GETFIELD1
+    2065 PUSHACC2
+    2066 PUSHACC5
+    2067 GETFIELD0
+    2068 PUSHACC5
+    2069 GETFIELD0
+    2070 PUSHENVACC1
+    2071 APPLY2
+    2072 MAKEBLOCK2 0
+    2074 PUSHOFFSETCLOSURE0
+    2075 APPTERM3 6
+    2077 ACC2
+    2078 BRANCHIFNOT 2082
+    2080 BRANCH 2084
+    2082 RETURN 3
+    2084 GETGLOBAL "List.rev_map2"
+    2086 PUSHGETGLOBALFIELD Pervasives, 2
+    2089 APPTERM1 4
+    2091 RESTART
+    2092 GRAB 2
+    2094 ACC0
+    2095 CLOSUREREC 1, 2053
+    2099 ACC3
+    2100 PUSHACC3
+    2101 PUSHCONST0
+    2102 PUSHACC3
+    2103 APPTERM3 7
+    2105 RESTART
+    2106 GRAB 1
+    2108 ACC1
+    2109 BRANCHIFNOT 2123
+    2111 ACC1
+    2112 GETFIELD1
+    2113 PUSHACC1
+    2114 PUSHACC3
+    2115 GETFIELD0
+    2116 PUSHENVACC1
+    2117 APPLY1
+    2118 MAKEBLOCK2 0
+    2120 PUSHOFFSETCLOSURE0
+    2121 APPTERM2 4
+    2123 ACC0
+    2124 RETURN 2
+    2126 RESTART
+    2127 GRAB 1
+    2129 ACC0
+    2130 CLOSUREREC 1, 2106
+    2134 ACC2
+    2135 PUSHCONST0
+    2136 PUSHACC2
+    2137 APPTERM2 5
+    2139 CONST0
+    2140 PUSHACC1
+    2141 PUSHENVACC1
+    2142 APPTERM2 3
+    2144 ACC0
+    2145 BRANCHIFNOT 2151
+    2147 ACC0
+    2148 GETFIELD1
+    2149 RETURN 1
+    2151 GETGLOBAL "tl"
+    2153 PUSHGETGLOBALFIELD Pervasives, 3
+    2156 APPTERM1 2
+    2158 ACC0
+    2159 BRANCHIFNOT 2165
+    2161 ACC0
+    2162 GETFIELD0
+    2163 RETURN 1
+    2165 GETGLOBAL "hd"
+    2167 PUSHGETGLOBALFIELD Pervasives, 3
+    2170 APPTERM1 2
+    2172 ACC0
+    2173 PUSHCONST0
+    2174 PUSHENVACC1
+    2175 APPTERM2 3
+    2177 CLOSUREREC 0, 1200
+    2181 ACC0
+    2182 CLOSURE 1, 2172
+    2185 PUSH
+    2186 CLOSURE 0, 2158
+    2189 PUSH
+    2190 CLOSURE 0, 2144
+    2193 PUSH
+    2194 CLOSUREREC 0, 1217
+    2198 GETGLOBALFIELD Pervasives, 16
+    2201 PUSH
+    2202 CLOSUREREC 0, 1259
+    2206 ACC0
+    2207 CLOSURE 1, 2139
+    2210 PUSH
+    2211 CLOSUREREC 0, 1277
+    2215 CLOSUREREC 0, 1294
+    2219 CLOSURE 0, 2127
+    2222 PUSH
+    2223 CLOSUREREC 0, 1316
+    2227 CLOSUREREC 0, 1334
+    2231 CLOSUREREC 0, 1354
+    2235 CLOSUREREC 0, 1374
+    2239 CLOSURE 0, 2092
+    2242 PUSH
+    2243 CLOSUREREC 0, 1415
+    2247 CLOSUREREC 0, 1452
+    2251 CLOSUREREC 0, 1490
+    2255 CLOSUREREC 0, 1530
+    2259 CLOSUREREC 0, 1553
+    2263 CLOSUREREC 0, 1573
+    2267 CLOSUREREC 0, 1613
+    2271 CLOSUREREC 0, 1654
+    2275 CLOSUREREC 0, 1675
+    2279 CLOSUREREC 0, 1695
+    2283 CLOSUREREC 0, 1725
+    2287 CLOSUREREC 0, 1754
+    2291 CLOSUREREC 0, 1776
+    2295 CLOSUREREC 0, 1797
+    2299 CLOSUREREC 0, 1828
+    2303 CLOSUREREC 0, 1858
+    2307 ACC 24
+    2309 CLOSURE 1, 2042
+    2312 PUSHACC 25
+    2314 CLOSUREREC 1, 1928
+    2318 CLOSUREREC 0, 1942
+    2322 CLOSUREREC 0, 1972
+    2326 ACC0
+    2327 PUSHACC2
+    2328 PUSHACC7
+    2329 PUSHACC 9
+    2331 PUSHACC 11
+    2333 PUSHACC 13
+    2335 PUSHACC 15
+    2337 PUSHACC 17
+    2339 PUSHACC 10
+    2341 PUSHACC 12
+    2343 PUSHACC 13
+    2345 PUSHACC 15
+    2347 PUSHACC 23
+    2349 PUSHACC 25
+    2351 PUSHACC 27
+    2353 PUSHACC 29
+    2355 PUSHACC 31
+    2357 PUSHACC 33
+    2359 PUSHACC 35
+    2361 PUSHACC 37
+    2363 PUSHACC 40
+    2365 PUSHACC 42
+    2367 PUSHACC 41
+    2369 PUSHACC 45
+    2371 PUSHACC 47
+    2373 PUSHACC 50
+    2375 PUSHACC 52
+    2377 PUSHACC 51
+    2379 PUSHACC 55
+    2381 PUSHACC 56
+    2383 PUSHACC 59
+    2385 PUSHACC 61
+    2387 PUSHACC 60
+    2389 PUSHACC 64
+    2391 PUSHACC 66
+    2393 PUSHACC 68
+    2395 PUSHACC 70
+    2397 MAKEBLOCK 37, 0
+    2400 POP 36
+    2402 SETGLOBAL List
+    2404 BRANCH 3341
+    2406 RESTART
+    2407 GRAB 2
+    2409 ACC2
+    2410 PUSHACC2
+    2411 VECTLENGTH
+    2412 OFFSETINT -1
+    2414 PUSHCONST0
+    2415 PUSH
+    2416 BRANCH 2433
+    2418 CHECK_SIGNALS
+    2419 ACC2
+    2420 PUSHACC2
+    2421 PUSHACC6
+    2422 C_CALL2 array_unsafe_get
+    2424 PUSHACC5
+    2425 APPLY2
+    2426 ASSIGN 2
+    2428 ACC1
+    2429 OFFSETINT -1
+    2431 ASSIGN 1
+    2433 ACC0
+    2434 PUSHACC2
+    2435 GEINT
+    2436 BRANCHIF 2418
+    2438 CONST0
+    2439 POP 2
+    2441 ACC0
+    2442 RETURN 4
+    2444 RESTART
+    2445 GRAB 2
+    2447 ACC1
+    2448 PUSHCONST0
+    2449 PUSHACC4
+    2450 VECTLENGTH
+    2451 OFFSETINT -1
+    2453 PUSH
+    2454 BRANCH 2471
+    2456 CHECK_SIGNALS
+    2457 ACC1
+    2458 PUSHACC6
+    2459 C_CALL2 array_unsafe_get
+    2461 PUSHACC3
+    2462 PUSHACC5
+    2463 APPLY2
+    2464 ASSIGN 2
+    2466 ACC1
+    2467 OFFSETINT 1
+    2469 ASSIGN 1
+    2471 ACC0
+    2472 PUSHACC2
+    2473 LEINT
+    2474 BRANCHIF 2456
+    2476 CONST0
+    2477 POP 2
+    2479 ACC0
+    2480 RETURN 4
+    2482 RESTART
+    2483 GRAB 1
+    2485 ACC1
+    2486 BRANCHIFNOT 2502
+    2488 ACC1
+    2489 GETFIELD0
+    2490 PUSHACC1
+    2491 PUSHENVACC1
+    2492 C_CALL3 array_unsafe_set
+    2494 ACC1
+    2495 GETFIELD1
+    2496 PUSHACC1
+    2497 OFFSETINT 1
+    2499 PUSHOFFSETCLOSURE0
+    2500 APPTERM2 4
+    2502 ENVACC1
+    2503 RETURN 2
+    2505 ACC0
+    2506 BRANCHIFNOT 2531
+    2508 ACC0
+    2509 GETFIELD1
+    2510 PUSHACC1
+    2511 GETFIELD0
+    2512 PUSHACC1
+    2513 PUSHGETGLOBALFIELD List, 0
+    2516 APPLY1
+    2517 OFFSETINT 1
+    2519 C_CALL2 make_vect
+    2521 PUSHACC0
+    2522 CLOSUREREC 1, 2483
+    2526 ACC2
+    2527 PUSHCONST1
+    2528 PUSHACC2
+    2529 APPTERM2 6
+    2531 ATOM0
+    2532 RETURN 1
+    2534 RESTART
+    2535 GRAB 1
+    2537 CONST0
+    2538 PUSHACC1
+    2539 LTINT
+    2540 BRANCHIFNOT 2545
+    2542 ACC1
+    2543 RETURN 2
+    2545 ACC1
+    2546 PUSHACC1
+    2547 PUSHENVACC1
+    2548 C_CALL2 array_unsafe_get
+    2550 MAKEBLOCK2 0
+    2552 PUSHACC1
+    2553 OFFSETINT -1
+    2555 PUSHOFFSETCLOSURE0
+    2556 APPTERM2 4
+    2558 ACC0
+    2559 CLOSUREREC 1, 2535
+    2563 CONST0
+    2564 PUSHACC2
+    2565 VECTLENGTH
+    2566 OFFSETINT -1
+    2568 PUSHACC2
+    2569 APPTERM2 4
+    2571 RESTART
+    2572 GRAB 1
+    2574 ACC1
+    2575 VECTLENGTH
+    2576 PUSHCONST0
+    2577 PUSHACC1
+    2578 EQ
+    2579 BRANCHIFNOT 2584
+    2581 ATOM0
+    2582 RETURN 3
+    2584 CONST0
+    2585 PUSHACC3
+    2586 C_CALL2 array_unsafe_get
+    2588 PUSHCONST0
+    2589 PUSHACC3
+    2590 APPLY2
+    2591 PUSHACC1
+    2592 C_CALL2 make_vect
+    2594 PUSHCONST1
+    2595 PUSHACC2
+    2596 OFFSETINT -1
+    2598 PUSH
+    2599 BRANCH 2618
+    2601 CHECK_SIGNALS
+    2602 ACC1
+    2603 PUSHACC6
+    2604 C_CALL2 array_unsafe_get
+    2606 PUSHACC2
+    2607 PUSHACC6
+    2608 APPLY2
+    2609 PUSHACC2
+    2610 PUSHACC4
+    2611 C_CALL3 array_unsafe_set
+    2613 ACC1
+    2614 OFFSETINT 1
+    2616 ASSIGN 1
+    2618 ACC0
+    2619 PUSHACC2
+    2620 LEINT
+    2621 BRANCHIF 2601
+    2623 CONST0
+    2624 POP 2
+    2626 ACC0
+    2627 RETURN 4
+    2629 RESTART
+    2630 GRAB 1
+    2632 CONST0
+    2633 PUSHACC2
+    2634 VECTLENGTH
+    2635 OFFSETINT -1
+    2637 PUSH
+    2638 BRANCH 2653
+    2640 CHECK_SIGNALS
+    2641 ACC1
+    2642 PUSHACC4
+    2643 C_CALL2 array_unsafe_get
+    2645 PUSHACC2
+    2646 PUSHACC4
+    2647 APPLY2
+    2648 ACC1
+    2649 OFFSETINT 1
+    2651 ASSIGN 1
+    2653 ACC0
+    2654 PUSHACC2
+    2655 LEINT
+    2656 BRANCHIF 2640
+    2658 CONST0
+    2659 RETURN 4
+    2661 RESTART
+    2662 GRAB 1
+    2664 ACC1
+    2665 VECTLENGTH
+    2666 PUSHCONST0
+    2667 PUSHACC1
+    2668 EQ
+    2669 BRANCHIFNOT 2674
+    2671 ATOM0
+    2672 RETURN 3
+    2674 CONST0
+    2675 PUSHACC3
+    2676 C_CALL2 array_unsafe_get
+    2678 PUSHACC2
+    2679 APPLY1
+    2680 PUSHACC1
+    2681 C_CALL2 make_vect
+    2683 PUSHCONST1
+    2684 PUSHACC2
+    2685 OFFSETINT -1
+    2687 PUSH
+    2688 BRANCH 2706
+    2690 CHECK_SIGNALS
+    2691 ACC1
+    2692 PUSHACC6
+    2693 C_CALL2 array_unsafe_get
+    2695 PUSHACC5
+    2696 APPLY1
+    2697 PUSHACC2
+    2698 PUSHACC4
+    2699 C_CALL3 array_unsafe_set
+    2701 ACC1
+    2702 OFFSETINT 1
+    2704 ASSIGN 1
+    2706 ACC0
+    2707 PUSHACC2
+    2708 LEINT
+    2709 BRANCHIF 2690
+    2711 CONST0
+    2712 POP 2
+    2714 ACC0
+    2715 RETURN 4
+    2717 RESTART
+    2718 GRAB 1
+    2720 CONST0
+    2721 PUSHACC2
+    2722 VECTLENGTH
+    2723 OFFSETINT -1
+    2725 PUSH
+    2726 BRANCH 2740
+    2728 CHECK_SIGNALS
+    2729 ACC1
+    2730 PUSHACC4
+    2731 C_CALL2 array_unsafe_get
+    2733 PUSHACC3
+    2734 APPLY1
+    2735 ACC1
+    2736 OFFSETINT 1
+    2738 ASSIGN 1
+    2740 ACC0
+    2741 PUSHACC2
+    2742 LEINT
+    2743 BRANCHIF 2728
+    2745 CONST0
+    2746 RETURN 4
+    2748 RESTART
+    2749 GRAB 4
+    2751 CONST0
+    2752 PUSHACC5
+    2753 LTINT
+    2754 BRANCHIF 2782
+    2756 CONST0
+    2757 PUSHACC2
+    2758 LTINT
+    2759 BRANCHIF 2782
+    2761 ACC0
+    2762 VECTLENGTH
+    2763 PUSHACC5
+    2764 PUSHACC3
+    2765 ADDINT
+    2766 GTINT
+    2767 BRANCHIF 2782
+    2769 CONST0
+    2770 PUSHACC4
+    2771 LTINT
+    2772 BRANCHIF 2782
+    2774 ACC2
+    2775 VECTLENGTH
+    2776 PUSHACC5
+    2777 PUSHACC5
+    2778 ADDINT
+    2779 GTINT
+    2780 BRANCHIFNOT 2789
+    2782 GETGLOBAL "Array.blit"
+    2784 PUSHGETGLOBALFIELD Pervasives, 2
+    2787 APPTERM1 6
+    2789 ACC3
+    2790 PUSHACC2
+    2791 LTINT
+    2792 BRANCHIFNOT 2827
+    2794 ACC4
+    2795 OFFSETINT -1
+    2797 PUSHCONST0
+    2798 PUSH
+    2799 BRANCH 2819
+    2801 CHECK_SIGNALS
+    2802 ACC1
+    2803 PUSHACC4
+    2804 ADDINT
+    2805 PUSHACC3
+    2806 C_CALL2 array_unsafe_get
+    2808 PUSHACC2
+    2809 PUSHACC7
+    2810 ADDINT
+    2811 PUSHACC6
+    2812 C_CALL3 array_unsafe_set
+    2814 ACC1
+    2815 OFFSETINT -1
+    2817 ASSIGN 1
+    2819 ACC0
+    2820 PUSHACC2
+    2821 GEINT
+    2822 BRANCHIF 2801
+    2824 CONST0
+    2825 RETURN 7
+    2827 CONST0
+    2828 PUSHACC5
+    2829 OFFSETINT -1
+    2831 PUSH
+    2832 BRANCH 2852
+    2834 CHECK_SIGNALS
+    2835 ACC1
+    2836 PUSHACC4
+    2837 ADDINT
+    2838 PUSHACC3
+    2839 C_CALL2 array_unsafe_get
+    2841 PUSHACC2
+    2842 PUSHACC7
+    2843 ADDINT
+    2844 PUSHACC6
+    2845 C_CALL3 array_unsafe_set
+    2847 ACC1
+    2848 OFFSETINT 1
+    2850 ASSIGN 1
+    2852 ACC0
+    2853 PUSHACC2
+    2854 LEINT
+    2855 BRANCHIF 2834
+    2857 CONST0
+    2858 RETURN 7
+    2860 RESTART
+    2861 GRAB 3
+    2863 CONST0
+    2864 PUSHACC2
+    2865 LTINT
+    2866 BRANCHIF 2881
+    2868 CONST0
+    2869 PUSHACC3
+    2870 LTINT
+    2871 BRANCHIF 2881
+    2873 ACC0
+    2874 VECTLENGTH
+    2875 PUSHACC3
+    2876 PUSHACC3
+    2877 ADDINT
+    2878 GTINT
+    2879 BRANCHIFNOT 2888
+    2881 GETGLOBAL "Array.fill"
+    2883 PUSHGETGLOBALFIELD Pervasives, 2
+    2886 APPTERM1 5
+    2888 ACC1
+    2889 PUSHACC3
+    2890 PUSHACC3
+    2891 ADDINT
+    2892 OFFSETINT -1
+    2894 PUSH
+    2895 BRANCH 2908
+    2897 CHECK_SIGNALS
+    2898 ACC5
+    2899 PUSHACC2
+    2900 PUSHACC4
+    2901 C_CALL3 array_unsafe_set
+    2903 ACC1
+    2904 OFFSETINT 1
+    2906 ASSIGN 1
+    2908 ACC0
+    2909 PUSHACC2
+    2910 LEINT
+    2911 BRANCHIF 2897
+    2913 CONST0
+    2914 RETURN 6
+    2916 RESTART
+    2917 GRAB 2
+    2919 CONST0
+    2920 PUSHACC2
+    2921 LTINT
+    2922 BRANCHIF 2937
+    2924 CONST0
+    2925 PUSHACC3
+    2926 LTINT
+    2927 BRANCHIF 2937
+    2929 ACC0
+    2930 VECTLENGTH
+    2931 PUSHACC3
+    2932 PUSHACC3
+    2933 ADDINT
+    2934 GTINT
+    2935 BRANCHIFNOT 2944
+    2937 GETGLOBAL "Array.sub"
+    2939 PUSHGETGLOBALFIELD Pervasives, 2
+    2942 APPTERM1 4
+    2944 CONST0
+    2945 PUSHACC3
+    2946 EQ
+    2947 BRANCHIFNOT 2952
+    2949 ATOM0
+    2950 RETURN 3
+    2952 ACC1
+    2953 PUSHACC1
+    2954 C_CALL2 array_unsafe_get
+    2956 PUSHACC3
+    2957 C_CALL2 make_vect
+    2959 PUSHCONST1
+    2960 PUSHACC4
+    2961 OFFSETINT -1
+    2963 PUSH
+    2964 BRANCH 2982
+    2966 CHECK_SIGNALS
+    2967 ACC1
+    2968 PUSHACC5
+    2969 ADDINT
+    2970 PUSHACC4
+    2971 C_CALL2 array_unsafe_get
+    2973 PUSHACC2
+    2974 PUSHACC4
+    2975 C_CALL3 array_unsafe_set
+    2977 ACC1
+    2978 OFFSETINT 1
+    2980 ASSIGN 1
+    2982 ACC0
+    2983 PUSHACC2
+    2984 LEINT
+    2985 BRANCHIF 2966
+    2987 CONST0
+    2988 POP 2
+    2990 ACC0
+    2991 RETURN 4
+    2993 ACC0
+    2994 BRANCHIFNOT 3017
+    2996 ACC0
+    2997 GETFIELD0
+    2998 PUSHCONST0
+    2999 PUSHACC1
+    3000 VECTLENGTH
+    3001 GTINT
+    3002 BRANCHIFNOT 3012
+    3004 ENVACC2
+    3005 PUSHCONST0
+    3006 PUSHACC2
+    3007 C_CALL2 array_unsafe_get
+    3009 PUSHENVACC1
+    3010 APPTERM2 4
+    3012 ACC1
+    3013 GETFIELD1
+    3014 PUSHOFFSETCLOSURE0
+    3015 APPTERM1 3
+    3017 ATOM0
+    3018 RETURN 1
+    3020 ACC0
+    3021 PUSHENVACC1
+    3022 CLOSUREREC 2, 2993
+    3026 ACC1
+    3027 PUSHACC1
+    3028 APPTERM1 3
+    3030 CONST0
+    3031 PUSHACC1
+    3032 VECTLENGTH
+    3033 OFFSETINT -1
+    3035 PUSH
+    3036 BRANCH 3056
+    3038 CHECK_SIGNALS
+    3039 ACC1
+    3040 PUSHACC3
+    3041 C_CALL2 array_unsafe_get
+    3043 PUSHENVACC2
+    3044 GETFIELD0
+    3045 PUSHENVACC1
+    3046 C_CALL3 array_unsafe_set
+    3048 ENVACC2
+    3049 OFFSETREF 1
+    3051 ACC1
+    3052 OFFSETINT 1
+    3054 ASSIGN 1
+    3056 ACC0
+    3057 PUSHACC2
+    3058 LEINT
+    3059 BRANCHIF 3038
+    3061 CONST0
+    3062 RETURN 3
+    3064 RESTART
+    3065 GRAB 1
+    3067 ACC1
+    3068 VECTLENGTH
+    3069 PUSHACC1
+    3070 ADDINT
+    3071 RETURN 2
+    3073 RESTART
+    3074 GRAB 1
+    3076 ACC1
+    3077 PUSHCONST0
+    3078 PUSH
+    3079 CLOSURE 0, 3065
+    3082 PUSHGETGLOBALFIELD List, 12
+    3085 APPLY3
+    3086 PUSHACC1
+    3087 PUSHACC1
+    3088 C_CALL2 make_vect
+    3090 PUSHCONST0
+    3091 MAKEBLOCK1 0
+    3093 PUSHACC4
+    3094 PUSHACC1
+    3095 PUSHACC3
+    3096 CLOSURE 2, 3030
+    3099 PUSHGETGLOBALFIELD List, 9
+    3102 APPLY2
+    3103 ACC1
+    3104 RETURN 5
+    3106 RESTART
+    3107 GRAB 1
+    3109 ACC0
+    3110 VECTLENGTH
+    3111 PUSHACC2
+    3112 VECTLENGTH
+    3113 PUSHCONST0
+    3114 PUSHACC2
+    3115 EQ
+    3116 BRANCHIFNOT 3126
+    3118 CONST0
+    3119 PUSHACC1
+    3120 EQ
+    3121 BRANCHIFNOT 3126
+    3123 ATOM0
+    3124 RETURN 4
+    3126 CONST0
+    3127 PUSHCONST0
+    3128 PUSHACC3
+    3129 GTINT
+    3130 BRANCHIFNOT 3135
+    3132 ACC3
+    3133 BRANCH 3136
+    3135 ACC4
+    3136 C_CALL2 array_unsafe_get
+    3138 PUSHACC1
+    3139 PUSHACC3
+    3140 ADDINT
+    3141 C_CALL2 make_vect
+    3143 PUSHCONST0
+    3144 PUSHACC3
+    3145 OFFSETINT -1
+    3147 PUSH
+    3148 BRANCH 3164
+    3150 CHECK_SIGNALS
+    3151 ACC1
+    3152 PUSHACC6
+    3153 C_CALL2 array_unsafe_get
+    3155 PUSHACC2
+    3156 PUSHACC4
+    3157 C_CALL3 array_unsafe_set
+    3159 ACC1
+    3160 OFFSETINT 1
+    3162 ASSIGN 1
+    3164 ACC0
+    3165 PUSHACC2
+    3166 LEINT
+    3167 BRANCHIF 3150
+    3169 CONST0
+    3170 POP 2
+    3172 CONST0
+    3173 PUSHACC2
+    3174 OFFSETINT -1
+    3176 PUSH
+    3177 BRANCH 3195
+    3179 CHECK_SIGNALS
+    3180 ACC1
+    3181 PUSHACC7
+    3182 C_CALL2 array_unsafe_get
+    3184 PUSHACC5
+    3185 PUSHACC3
+    3186 ADDINT
+    3187 PUSHACC4
+    3188 C_CALL3 array_unsafe_set
+    3190 ACC1
+    3191 OFFSETINT 1
+    3193 ASSIGN 1
+    3195 ACC0
+    3196 PUSHACC2
+    3197 LEINT
+    3198 BRANCHIF 3179
+    3200 CONST0
+    3201 POP 2
+    3203 ACC0
+    3204 RETURN 5
+    3206 ACC0
+    3207 VECTLENGTH
+    3208 PUSHCONST0
+    3209 PUSHACC1
+    3210 EQ
+    3211 BRANCHIFNOT 3216
+    3213 ATOM0
+    3214 RETURN 2
+    3216 CONST0
+    3217 PUSHACC2
+    3218 C_CALL2 array_unsafe_get
+    3220 PUSHACC1
+    3221 C_CALL2 make_vect
+    3223 PUSHCONST1
+    3224 PUSHACC2
+    3225 OFFSETINT -1
+    3227 PUSH
+    3228 BRANCH 3244
+    3230 CHECK_SIGNALS
+    3231 ACC1
+    3232 PUSHACC5
+    3233 C_CALL2 array_unsafe_get
+    3235 PUSHACC2
+    3236 PUSHACC4
+    3237 C_CALL3 array_unsafe_set
+    3239 ACC1
+    3240 OFFSETINT 1
+    3242 ASSIGN 1
+    3244 ACC0
+    3245 PUSHACC2
+    3246 LEINT
+    3247 BRANCHIF 3230
+    3249 CONST0
+    3250 POP 2
+    3252 ACC0
+    3253 RETURN 3
+    3255 RESTART
+    3256 GRAB 2
+    3258 ATOM0
+    3259 PUSHACC1
+    3260 C_CALL2 make_vect
+    3262 PUSHCONST0
+    3263 PUSHACC2
+    3264 OFFSETINT -1
+    3266 PUSH
+    3267 BRANCH 3282
+    3269 CHECK_SIGNALS
+    3270 ACC5
+    3271 PUSHACC5
+    3272 C_CALL2 make_vect
+    3274 PUSHACC2
+    3275 PUSHACC4
+    3276 SETVECTITEM
+    3277 ACC1
+    3278 OFFSETINT 1
+    3280 ASSIGN 1
+    3282 ACC0
+    3283 PUSHACC2
+    3284 LEINT
+    3285 BRANCHIF 3269
+    3287 CONST0
+    3288 POP 2
+    3290 ACC0
+    3291 RETURN 4
+    3293 RESTART
+    3294 GRAB 1
+    3296 CONST0
+    3297 PUSHACC1
+    3298 EQ
+    3299 BRANCHIFNOT 3304
+    3301 ATOM0
+    3302 RETURN 2
+    3304 CONST0
+    3305 PUSHACC2
+    3306 APPLY1
+    3307 PUSHACC1
+    3308 C_CALL2 make_vect
+    3310 PUSHCONST1
+    3311 PUSHACC2
+    3312 OFFSETINT -1
+    3314 PUSH
+    3315 BRANCH 3330
+    3317 CHECK_SIGNALS
+    3318 ACC1
+    3319 PUSHACC5
+    3320 APPLY1
+    3321 PUSHACC2
+    3322 PUSHACC4
+    3323 C_CALL3 array_unsafe_set
+    3325 ACC1
+    3326 OFFSETINT 1
+    3328 ASSIGN 1
+    3330 ACC0
+    3331 PUSHACC2
+    3332 LEINT
+    3333 BRANCHIF 3317
+    3335 CONST0
+    3336 POP 2
+    3338 ACC0
+    3339 RETURN 3
+    3341 CLOSURE 0, 3294
+    3344 PUSH
+    3345 CLOSURE 0, 3256
+    3348 PUSH
+    3349 CLOSURE 0, 3206
+    3352 PUSH
+    3353 CLOSURE 0, 3107
+    3356 PUSH
+    3357 CLOSURE 0, 3074
+    3360 PUSHACC0
+    3361 CLOSURE 1, 3020
+    3364 PUSH
+    3365 CLOSURE 0, 2917
+    3368 PUSH
+    3369 CLOSURE 0, 2861
+    3372 PUSH
+    3373 CLOSURE 0, 2749
+    3376 PUSH
+    3377 CLOSURE 0, 2718
+    3380 PUSH
+    3381 CLOSURE 0, 2662
+    3384 PUSH
+    3385 CLOSURE 0, 2630
+    3388 PUSH
+    3389 CLOSURE 0, 2572
+    3392 PUSH
+    3393 CLOSURE 0, 2558
+    3396 PUSH
+    3397 CLOSURE 0, 2505
+    3400 PUSH
+    3401 CLOSURE 0, 2445
+    3404 PUSH
+    3405 CLOSURE 0, 2407
+    3408 PUSHACC0
+    3409 PUSHACC2
+    3410 PUSHACC6
+    3411 PUSHACC 8
+    3413 PUSHACC 10
+    3415 PUSHACC 12
+    3417 PUSHACC 8
+    3419 PUSHACC 10
+    3421 PUSHACC 16
+    3423 PUSHACC 18
+    3425 PUSHACC 24
+    3427 PUSHACC 21
+    3429 PUSHACC 23
+    3431 PUSHACC 26
+    3433 PUSHACC 29
+    3435 PUSHACC 30
+    3437 PUSHACC 32
+    3439 MAKEBLOCK 17, 0
+    3442 POP 17
+    3444 SETGLOBAL Array
+    3446 BRANCH 3456
+    3448 ACC0
+    3449 PUSHENVACC1
+    3450 GETFIELD0
+    3451 ADDINT
+    3452 PUSHENVACC1
+    3453 SETFIELD0
+    3454 RETURN 1
+    3456 CONST2
+    3457 PUSHCONSTINT 200000
+    3459 C_CALL2 make_vect
+    3461 PUSHCONST0
+    3462 MAKEBLOCK1 0
+    3464 PUSHACC1
+    3465 PUSHACC1
+    3466 CLOSURE 1, 3448
+    3469 PUSHGETGLOBALFIELD Array, 11
+    3472 APPLY2
+    3473 CONSTINT 400000
+    3475 PUSHACC1
+    3476 GETFIELD0
+    3477 NEQ
+    3478 BRANCHIFNOT 3485
+    3480 GETGLOBAL Not_found
+    3482 MAKEBLOCK1 0
+    3484 RAISE
+    3485 POP 2
+    3487 ATOM0
+    3488 SETGLOBAL T310-alloc-2
+    3490 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t320-gc-1.ml b/testsuite/tests/tool-ocaml/t320-gc-1.ml
new file mode 100644
index 00000000..98986b2f
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t320-gc-1.ml
@@ -0,0 +1,1597 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f n =
+  if n <= 0 then []
+  else n :: f (n-1)
+in
+let l = f 300 in
+Gc.minor ();
+if List.fold_left (+) 0 l <> 301 * 150 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 746
+      11 RESTART
+      12 GRAB 1
+      14 ACC0
+      15 BRANCHIFNOT 28
+      17 ACC1
+      18 PUSHACC1
+      19 GETFIELD1
+      20 PUSHOFFSETCLOSURE0
+      21 APPLY2
+      22 PUSHACC1
+      23 GETFIELD0
+      24 MAKEBLOCK2 0
+      26 RETURN 2
+      28 ACC1
+      29 RETURN 2
+      31 RESTART
+      32 GRAB 3
+      34 CONST0
+      35 PUSHACC4
+      36 LEINT
+      37 BRANCHIFNOT 42
+      39 CONST0
+      40 RETURN 4
+      42 ACC3
+      43 PUSHACC3
+      44 PUSHACC3
+      45 PUSHACC3
+      46 C_CALL4 caml_input
+      48 PUSHCONST0
+      49 PUSHACC1
+      50 EQ
+      51 BRANCHIFNOT 58
+      53 GETGLOBAL End_of_file
+      55 MAKEBLOCK1 0
+      57 RAISE
+      58 ACC0
+      59 PUSHACC5
+      60 SUBINT
+      61 PUSHACC1
+      62 PUSHACC5
+      63 ADDINT
+      64 PUSHACC4
+      65 PUSHACC4
+      66 PUSHOFFSETCLOSURE0
+      67 APPTERM 4, 9
+      70 ACC0
+      71 C_CALL1 caml_input_scan_line
+      73 PUSHCONST0
+      74 PUSHACC1
+      75 EQ
+      76 BRANCHIFNOT 83
+      78 GETGLOBAL End_of_file
+      80 MAKEBLOCK1 0
+      82 RAISE
+      83 CONST0
+      84 PUSHACC1
+      85 GTINT
+      86 BRANCHIFNOT 107
+      88 ACC0
+      89 OFFSETINT -1
+      91 C_CALL1 create_string
+      93 PUSHACC1
+      94 OFFSETINT -1
+      96 PUSHCONST0
+      97 PUSHACC2
+      98 PUSHACC5
+      99 C_CALL4 caml_input
+     101 ACC2
+     102 C_CALL1 caml_input_char
+     104 ACC0
+     105 RETURN 3
+     107 ACC0
+     108 NEGINT
+     109 C_CALL1 create_string
+     111 PUSHACC1
+     112 NEGINT
+     113 PUSHCONST0
+     114 PUSHACC2
+     115 PUSHACC5
+     116 C_CALL4 caml_input
+     118 CONST0
+     119 PUSHTRAP 130
+     121 ACC6
+     122 PUSHOFFSETCLOSURE0
+     123 APPLY1
+     124 PUSHACC5
+     125 PUSHENVACC1
+     126 APPLY2
+     127 POPTRAP
+     128 RETURN 3
+     130 PUSHGETGLOBAL End_of_file
+     132 PUSHACC1
+     133 GETFIELD0
+     134 EQ
+     135 BRANCHIFNOT 140
+     137 ACC1
+     138 RETURN 4
+     140 ACC0
+     141 RAISE
+     142 ACC0
+     143 C_CALL1 caml_flush
+     145 RETURN 1
+     147 RESTART
+     148 GRAB 1
+     150 ACC1
+     151 PUSHACC1
+     152 C_CALL2 caml_output_char
+     154 RETURN 2
+     156 RESTART
+     157 GRAB 1
+     159 ACC1
+     160 PUSHACC1
+     161 C_CALL2 caml_output_char
+     163 RETURN 2
+     165 RESTART
+     166 GRAB 1
+     168 ACC1
+     169 PUSHACC1
+     170 C_CALL2 caml_output_int
+     172 RETURN 2
+     174 RESTART
+     175 GRAB 1
+     177 ACC1
+     178 PUSHACC1
+     179 C_CALL2 caml_seek_out
+     181 RETURN 2
+     183 ACC0
+     184 C_CALL1 caml_pos_out
+     186 RETURN 1
+     188 ACC0
+     189 C_CALL1 caml_channel_size
+     191 RETURN 1
+     193 RESTART
+     194 GRAB 1
+     196 ACC1
+     197 PUSHACC1
+     198 C_CALL2 caml_set_binary_mode
+     200 RETURN 2
+     202 ACC0
+     203 C_CALL1 caml_input_char
+     205 RETURN 1
+     207 ACC0
+     208 C_CALL1 caml_input_char
+     210 RETURN 1
+     212 ACC0
+     213 C_CALL1 caml_input_int
+     215 RETURN 1
+     217 ACC0
+     218 C_CALL1 input_value
+     220 RETURN 1
+     222 RESTART
+     223 GRAB 1
+     225 ACC1
+     226 PUSHACC1
+     227 C_CALL2 caml_seek_in
+     229 RETURN 2
+     231 ACC0
+     232 C_CALL1 caml_pos_in
+     234 RETURN 1
+     236 ACC0
+     237 C_CALL1 caml_channel_size
+     239 RETURN 1
+     241 ACC0
+     242 C_CALL1 caml_close_channel
+     244 RETURN 1
+     246 RESTART
+     247 GRAB 1
+     249 ACC1
+     250 PUSHACC1
+     251 C_CALL2 caml_set_binary_mode
+     253 RETURN 2
+     255 CONST0
+     256 PUSHENVACC1
+     257 APPLY1
+     258 ACC0
+     259 C_CALL1 sys_exit
+     261 RETURN 1
+     263 CONST0
+     264 PUSHENVACC1
+     265 GETFIELD0
+     266 APPTERM1 2
+     268 CONST0
+     269 PUSHENVACC1
+     270 APPLY1
+     271 CONST0
+     272 PUSHENVACC2
+     273 APPTERM1 2
+     275 ENVACC1
+     276 GETFIELD0
+     277 PUSHACC0
+     278 PUSHACC2
+     279 CLOSURE 2, 268
+     282 PUSHENVACC1
+     283 SETFIELD0
+     284 RETURN 2
+     286 ENVACC1
+     287 C_CALL1 caml_flush
+     289 ENVACC2
+     290 C_CALL1 caml_flush
+     292 RETURN 1
+     294 CONST0
+     295 PUSHENVACC1
+     296 APPLY1
+     297 C_CALL1 float_of_string
+     299 RETURN 1
+     301 CONST0
+     302 PUSHENVACC1
+     303 APPLY1
+     304 C_CALL1 int_of_string
+     306 RETURN 1
+     308 ENVACC2
+     309 C_CALL1 caml_flush
+     311 ENVACC1
+     312 PUSHENVACC3
+     313 APPTERM1 2
+     315 CONSTINT 13
+     317 PUSHENVACC1
+     318 C_CALL2 caml_output_char
+     320 ENVACC1
+     321 C_CALL1 caml_flush
+     323 RETURN 1
+     325 ACC0
+     326 PUSHENVACC1
+     327 PUSHENVACC2
+     328 APPLY2
+     329 CONSTINT 13
+     331 PUSHENVACC1
+     332 C_CALL2 caml_output_char
+     334 ENVACC1
+     335 C_CALL1 caml_flush
+     337 RETURN 1
+     339 ACC0
+     340 PUSHENVACC1
+     341 APPLY1
+     342 PUSHENVACC2
+     343 PUSHENVACC3
+     344 APPTERM2 3
+     346 ACC0
+     347 PUSHENVACC1
+     348 APPLY1
+     349 PUSHENVACC2
+     350 PUSHENVACC3
+     351 APPTERM2 3
+     353 ACC0
+     354 PUSHENVACC1
+     355 PUSHENVACC2
+     356 APPTERM2 3
+     358 ACC0
+     359 PUSHENVACC1
+     360 C_CALL2 caml_output_char
+     362 RETURN 1
+     364 CONSTINT 13
+     366 PUSHENVACC1
+     367 C_CALL2 caml_output_char
+     369 ENVACC1
+     370 C_CALL1 caml_flush
+     372 RETURN 1
+     374 ACC0
+     375 PUSHENVACC1
+     376 PUSHENVACC2
+     377 APPLY2
+     378 CONSTINT 13
+     380 PUSHENVACC1
+     381 C_CALL2 caml_output_char
+     383 RETURN 1
+     385 ACC0
+     386 PUSHENVACC1
+     387 APPLY1
+     388 PUSHENVACC2
+     389 PUSHENVACC3
+     390 APPTERM2 3
+     392 ACC0
+     393 PUSHENVACC1
+     394 APPLY1
+     395 PUSHENVACC2
+     396 PUSHENVACC3
+     397 APPTERM2 3
+     399 ACC0
+     400 PUSHENVACC1
+     401 PUSHENVACC2
+     402 APPTERM2 3
+     404 ACC0
+     405 PUSHENVACC1
+     406 C_CALL2 caml_output_char
+     408 RETURN 1
+     410 RESTART
+     411 GRAB 3
+     413 CONST0
+     414 PUSHACC3
+     415 LTINT
+     416 BRANCHIF 427
+     418 ACC1
+     419 C_CALL1 ml_string_length
+     421 PUSHACC4
+     422 PUSHACC4
+     423 ADDINT
+     424 GTINT
+     425 BRANCHIFNOT 432
+     427 GETGLOBAL "really_input"
+     429 PUSHENVACC1
+     430 APPTERM1 5
+     432 ACC3
+     433 PUSHACC3
+     434 PUSHACC3
+     435 PUSHACC3
+     436 PUSHENVACC2
+     437 APPTERM 4, 8
+     440 RESTART
+     441 GRAB 3
+     443 CONST0
+     444 PUSHACC3
+     445 LTINT
+     446 BRANCHIF 457
+     448 ACC1
+     449 C_CALL1 ml_string_length
+     451 PUSHACC4
+     452 PUSHACC4
+     453 ADDINT
+     454 GTINT
+     455 BRANCHIFNOT 462
+     457 GETGLOBAL "input"
+     459 PUSHENVACC1
+     460 APPTERM1 5
+     462 ACC3
+     463 PUSHACC3
+     464 PUSHACC3
+     465 PUSHACC3
+     466 C_CALL4 caml_input
+     468 RETURN 4
+     470 ACC0
+     471 PUSHCONST0
+     472 PUSHGETGLOBAL <0>(0, <0>(6, 0))
+     474 PUSHENVACC1
+     475 APPTERM3 4
+     477 ACC0
+     478 PUSHCONST0
+     479 PUSHGETGLOBAL <0>(0, <0>(7, 0))
+     481 PUSHENVACC1
+     482 APPTERM3 4
+     484 RESTART
+     485 GRAB 2
+     487 ACC1
+     488 PUSHACC1
+     489 PUSHACC4
+     490 C_CALL3 sys_open
+     492 C_CALL1 caml_open_descriptor
+     494 RETURN 3
+     496 ACC0
+     497 C_CALL1 caml_flush
+     499 ACC0
+     500 C_CALL1 caml_close_channel
+     502 RETURN 1
+     504 RESTART
+     505 GRAB 1
+     507 CONST0
+     508 PUSHACC2
+     509 PUSHACC2
+     510 C_CALL3 output_value
+     512 RETURN 2
+     514 RESTART
+     515 GRAB 3
+     517 CONST0
+     518 PUSHACC3
+     519 LTINT
+     520 BRANCHIF 531
+     522 ACC1
+     523 C_CALL1 ml_string_length
+     525 PUSHACC4
+     526 PUSHACC4
+     527 ADDINT
+     528 GTINT
+     529 BRANCHIFNOT 536
+     531 GETGLOBAL "output"
+     533 PUSHENVACC1
+     534 APPTERM1 5
+     536 ACC3
+     537 PUSHACC3
+     538 PUSHACC3
+     539 PUSHACC3
+     540 C_CALL4 caml_output
+     542 RETURN 4
+     544 RESTART
+     545 GRAB 1
+     547 ACC1
+     548 C_CALL1 ml_string_length
+     550 PUSHCONST0
+     551 PUSHACC3
+     552 PUSHACC3
+     553 C_CALL4 caml_output
+     555 RETURN 2
+     557 ACC0
+     558 PUSHCONSTINT 438
+     560 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(6, 0))))
+     562 PUSHENVACC1
+     563 APPTERM3 4
+     565 ACC0
+     566 PUSHCONSTINT 438
+     568 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(7, 0))))
+     570 PUSHENVACC1
+     571 APPTERM3 4
+     573 RESTART
+     574 GRAB 2
+     576 ACC1
+     577 PUSHACC1
+     578 PUSHACC4
+     579 C_CALL3 sys_open
+     581 C_CALL1 caml_open_descriptor
+     583 RETURN 3
+     585 ACC0
+     586 PUSHGETGLOBAL "%.12g"
+     588 C_CALL2 format_float
+     590 RETURN 1
+     592 ACC0
+     593 PUSHGETGLOBAL "%d"
+     595 C_CALL2 format_int
+     597 RETURN 1
+     599 GETGLOBAL "false"
+     601 PUSHACC1
+     602 C_CALL2 string_equal
+     604 BRANCHIFNOT 609
+     606 CONST0
+     607 RETURN 1
+     609 GETGLOBAL "true"
+     611 PUSHACC1
+     612 C_CALL2 string_equal
+     614 BRANCHIFNOT 619
+     616 CONST1
+     617 RETURN 1
+     619 GETGLOBAL "bool_of_string"
+     621 PUSHENVACC1
+     622 APPTERM1 2
+     624 ACC0
+     625 BRANCHIFNOT 631
+     627 GETGLOBAL "true"
+     629 RETURN 1
+     631 GETGLOBAL "false"
+     633 RETURN 1
+     635 CONST0
+     636 PUSHACC1
+     637 LTINT
+     638 BRANCHIF 646
+     640 CONSTINT 255
+     642 PUSHACC1
+     643 GTINT
+     644 BRANCHIFNOT 651
+     646 GETGLOBAL "char_of_int"
+     648 PUSHENVACC1
+     649 APPTERM1 2
+     651 ACC0
+     652 RETURN 1
+     654 RESTART
+     655 GRAB 1
+     657 ACC0
+     658 C_CALL1 ml_string_length
+     660 PUSHACC2
+     661 C_CALL1 ml_string_length
+     663 PUSHACC0
+     664 PUSHACC2
+     665 ADDINT
+     666 C_CALL1 create_string
+     668 PUSHACC2
+     669 PUSHCONST0
+     670 PUSHACC2
+     671 PUSHCONST0
+     672 PUSHACC7
+     673 C_CALL5 blit_string
+     675 ACC1
+     676 PUSHACC3
+     677 PUSHACC2
+     678 PUSHCONST0
+     679 PUSHACC 8
+     681 C_CALL5 blit_string
+     683 ACC0
+     684 RETURN 5
+     686 CONSTINT -1
+     688 PUSHACC1
+     689 XORINT
+     690 RETURN 1
+     692 CONST0
+     693 PUSHACC1
+     694 GEINT
+     695 BRANCHIFNOT 700
+     697 ACC0
+     698 RETURN 1
+     700 ACC0
+     701 NEGINT
+     702 RETURN 1
+     704 RESTART
+     705 GRAB 1
+     707 ACC1
+     708 PUSHACC1
+     709 C_CALL2 greaterequal
+     711 BRANCHIFNOT 716
+     713 ACC0
+     714 RETURN 2
+     716 ACC1
+     717 RETURN 2
+     719 RESTART
+     720 GRAB 1
+     722 ACC1
+     723 PUSHACC1
+     724 C_CALL2 lessequal
+     726 BRANCHIFNOT 731
+     728 ACC0
+     729 RETURN 2
+     731 ACC1
+     732 RETURN 2
+     734 ACC0
+     735 PUSHGETGLOBAL Invalid_argument
+     737 MAKEBLOCK2 0
+     739 RAISE
+     740 ACC0
+     741 PUSHGETGLOBAL Failure
+     743 MAKEBLOCK2 0
+     745 RAISE
+     746 CLOSURE 0, 740
+     749 PUSH
+     750 CLOSURE 0, 734
+     753 PUSHGETGLOBAL "Pervasives.Exit"
+     755 MAKEBLOCK1 0
+     757 PUSHGETGLOBAL "Pervasives.Assert_failure"
+     759 MAKEBLOCK1 0
+     761 PUSH
+     762 CLOSURE 0, 720
+     765 PUSH
+     766 CLOSURE 0, 705
+     769 PUSH
+     770 CLOSURE 0, 692
+     773 PUSH
+     774 CLOSURE 0, 686
+     777 PUSHCONST0
+     778 PUSHCONSTINT 31
+     780 PUSHCONST1
+     781 LSLINT
+     782 EQ
+     783 BRANCHIFNOT 789
+     785 CONSTINT 30
+     787 BRANCH 791
+     789 CONSTINT 62
+     791 PUSHCONST1
+     792 LSLINT
+     793 PUSHACC0
+     794 OFFSETINT -1
+     796 PUSH
+     797 CLOSURE 0, 655
+     800 PUSHACC 9
+     802 CLOSURE 1, 635
+     805 PUSH
+     806 CLOSURE 0, 624
+     809 PUSHACC 11
+     811 CLOSURE 1, 599
+     814 PUSH
+     815 CLOSURE 0, 592
+     818 PUSH
+     819 CLOSURE 0, 585
+     822 PUSH
+     823 CLOSUREREC 0, 12
+     827 CONST0
+     828 C_CALL1 caml_open_descriptor
+     830 PUSHCONST1
+     831 C_CALL1 caml_open_descriptor
+     833 PUSHCONST2
+     834 C_CALL1 caml_open_descriptor
+     836 PUSH
+     837 CLOSURE 0, 574
+     840 PUSHACC0
+     841 CLOSURE 1, 565
+     844 PUSHACC1
+     845 CLOSURE 1, 557
+     848 PUSH
+     849 CLOSURE 0, 545
+     852 PUSHACC 22
+     854 CLOSURE 1, 515
+     857 PUSH
+     858 CLOSURE 0, 505
+     861 PUSH
+     862 CLOSURE 0, 496
+     865 PUSH
+     866 CLOSURE 0, 485
+     869 PUSHACC0
+     870 CLOSURE 1, 477
+     873 PUSHACC1
+     874 CLOSURE 1, 470
+     877 PUSHACC 28
+     879 CLOSURE 1, 441
+     882 PUSH
+     883 CLOSUREREC 0, 32
+     887 ACC0
+     888 PUSHACC 31
+     890 CLOSURE 2, 411
+     893 PUSHACC 22
+     895 CLOSUREREC 1, 70
+     899 ACC 15
+     901 CLOSURE 1, 404
+     904 PUSHACC 11
+     906 PUSHACC 17
+     908 CLOSURE 2, 399
+     911 PUSHACC 12
+     913 PUSHACC 18
+     915 PUSHACC 23
+     917 CLOSURE 3, 392
+     920 PUSHACC 13
+     922 PUSHACC 19
+     924 PUSHACC 23
+     926 CLOSURE 3, 385
+     929 PUSHACC 14
+     931 PUSHACC 20
+     933 CLOSURE 2, 374
+     936 PUSHACC 20
+     938 CLOSURE 1, 364
+     941 PUSHACC 20
+     943 CLOSURE 1, 358
+     946 PUSHACC 17
+     948 PUSHACC 22
+     950 CLOSURE 2, 353
+     953 PUSHACC 18
+     955 PUSHACC 23
+     957 PUSHACC 29
+     959 CLOSURE 3, 346
+     962 PUSHACC 19
+     964 PUSHACC 24
+     966 PUSHACC 29
+     968 CLOSURE 3, 339
+     971 PUSHACC 20
+     973 PUSHACC 25
+     975 CLOSURE 2, 325
+     978 PUSHACC 25
+     980 CLOSURE 1, 315
+     983 PUSHACC 12
+     985 PUSHACC 28
+     987 PUSHACC 30
+     989 CLOSURE 3, 308
+     992 PUSHACC0
+     993 CLOSURE 1, 301
+     996 PUSHACC1
+     997 CLOSURE 1, 294
+    1000 PUSHACC 29
+    1002 PUSHACC 31
+    1004 CLOSURE 2, 286
+    1007 MAKEBLOCK1 0
+    1009 PUSHACC0
+    1010 CLOSURE 1, 275
+    1013 PUSHACC1
+    1014 CLOSURE 1, 263
+    1017 PUSHACC0
+    1018 CLOSURE 1, 255
+    1021 PUSHACC1
+    1022 PUSHACC 22
+    1024 PUSHACC4
+    1025 PUSHACC3
+    1026 PUSH
+    1027 CLOSURE 0, 247
+    1030 PUSH
+    1031 CLOSURE 0, 241
+    1034 PUSH
+    1035 CLOSURE 0, 236
+    1038 PUSH
+    1039 CLOSURE 0, 231
+    1042 PUSH
+    1043 CLOSURE 0, 223
+    1046 PUSH
+    1047 CLOSURE 0, 217
+    1050 PUSH
+    1051 CLOSURE 0, 212
+    1054 PUSH
+    1055 CLOSURE 0, 207
+    1058 PUSHACC 32
+    1060 PUSHACC 35
+    1062 PUSHACC 33
+    1064 PUSH
+    1065 CLOSURE 0, 202
+    1068 PUSHACC 41
+    1070 PUSHACC 40
+    1072 PUSHACC 42
+    1074 PUSH
+    1075 CLOSURE 0, 194
+    1078 PUSHACC 46
+    1080 PUSH
+    1081 CLOSURE 0, 188
+    1084 PUSH
+    1085 CLOSURE 0, 183
+    1088 PUSH
+    1089 CLOSURE 0, 175
+    1092 PUSHACC 51
+    1094 PUSH
+    1095 CLOSURE 0, 166
+    1098 PUSH
+    1099 CLOSURE 0, 157
+    1102 PUSHACC 55
+    1104 PUSHACC 57
+    1106 PUSH
+    1107 CLOSURE 0, 148
+    1110 PUSH
+    1111 CLOSURE 0, 142
+    1114 PUSHACC 63
+    1116 PUSHACC 62
+    1118 PUSHACC 64
+    1120 PUSHACC 38
+    1122 PUSHACC 40
+    1124 PUSHACC 42
+    1126 PUSHACC 44
+    1128 PUSHACC 46
+    1130 PUSHACC 48
+    1132 PUSHACC 50
+    1134 PUSHACC 52
+    1136 PUSHACC 54
+    1138 PUSHACC 56
+    1140 PUSHACC 58
+    1142 PUSHACC 60
+    1144 PUSHACC 62
+    1146 PUSHACC 64
+    1148 PUSHACC 66
+    1150 PUSHACC 82
+    1152 PUSHACC 84
+    1154 PUSHACC 86
+    1156 PUSHACC 88
+    1158 PUSHACC 90
+    1160 PUSHACC 92
+    1162 PUSHACC 94
+    1164 PUSHACC 96
+    1166 PUSHACC 98
+    1168 PUSHACC 100
+    1170 PUSHACC 104
+    1172 PUSHACC 104
+    1174 PUSHACC 104
+    1176 PUSHACC 108
+    1178 PUSHACC 110
+    1180 PUSHACC 112
+    1182 PUSHACC 117
+    1184 PUSHACC 117
+    1186 PUSHACC 117
+    1188 PUSHACC 117
+    1190 MAKEBLOCK 69, 0
+    1193 POP 53
+    1195 SETGLOBAL Pervasives
+    1197 BRANCH 2177
+    1199 RESTART
+    1200 GRAB 1
+    1202 ACC1
+    1203 BRANCHIFNOT 1213
+    1205 ACC1
+    1206 GETFIELD1
+    1207 PUSHACC1
+    1208 OFFSETINT 1
+    1210 PUSHOFFSETCLOSURE0
+    1211 APPTERM2 4
+    1213 ACC0
+    1214 RETURN 2
+    1216 RESTART
+    1217 GRAB 1
+    1219 ACC0
+    1220 BRANCHIFNOT 1251
+    1222 CONST0
+    1223 PUSHACC2
+    1224 EQ
+    1225 BRANCHIFNOT 1231
+    1227 ACC0
+    1228 GETFIELD0
+    1229 RETURN 2
+    1231 CONST0
+    1232 PUSHACC2
+    1233 GTINT
+    1234 BRANCHIFNOT 1244
+    1236 ACC1
+    1237 OFFSETINT -1
+    1239 PUSHACC1
+    1240 GETFIELD1
+    1241 PUSHOFFSETCLOSURE0
+    1242 APPTERM2 4
+    1244 GETGLOBAL "List.nth"
+    1246 PUSHGETGLOBALFIELD Pervasives, 2
+    1249 APPTERM1 3
+    1251 GETGLOBAL "nth"
+    1253 PUSHGETGLOBALFIELD Pervasives, 3
+    1256 APPTERM1 3
+    1258 RESTART
+    1259 GRAB 1
+    1261 ACC0
+    1262 BRANCHIFNOT 1274
+    1264 ACC1
+    1265 PUSHACC1
+    1266 GETFIELD0
+    1267 MAKEBLOCK2 0
+    1269 PUSHACC1
+    1270 GETFIELD1
+    1271 PUSHOFFSETCLOSURE0
+    1272 APPTERM2 4
+    1274 ACC1
+    1275 RETURN 2
+    1277 ACC0
+    1278 BRANCHIFNOT 1291
+    1280 ACC0
+    1281 GETFIELD1
+    1282 PUSHOFFSETCLOSURE0
+    1283 APPLY1
+    1284 PUSHACC1
+    1285 GETFIELD0
+    1286 PUSHGETGLOBALFIELD Pervasives, 16
+    1289 APPTERM2 3
+    1291 RETURN 1
+    1293 RESTART
+    1294 GRAB 1
+    1296 ACC1
+    1297 BRANCHIFNOT 1313
+    1299 ACC1
+    1300 GETFIELD0
+    1301 PUSHACC1
+    1302 APPLY1
+    1303 PUSHACC2
+    1304 GETFIELD1
+    1305 PUSHACC2
+    1306 PUSHOFFSETCLOSURE0
+    1307 APPLY2
+    1308 PUSHACC1
+    1309 MAKEBLOCK2 0
+    1311 POP 1
+    1313 RETURN 2
+    1315 RESTART
+    1316 GRAB 1
+    1318 ACC1
+    1319 BRANCHIFNOT 1331
+    1321 ACC1
+    1322 GETFIELD0
+    1323 PUSHACC1
+    1324 APPLY1
+    1325 ACC1
+    1326 GETFIELD1
+    1327 PUSHACC1
+    1328 PUSHOFFSETCLOSURE0
+    1329 APPTERM2 4
+    1331 RETURN 2
+    1333 RESTART
+    1334 GRAB 2
+    1336 ACC2
+    1337 BRANCHIFNOT 1350
+    1339 ACC2
+    1340 GETFIELD1
+    1341 PUSHACC3
+    1342 GETFIELD0
+    1343 PUSHACC3
+    1344 PUSHACC3
+    1345 APPLY2
+    1346 PUSHACC2
+    1347 PUSHOFFSETCLOSURE0
+    1348 APPTERM3 6
+    1350 ACC1
+    1351 RETURN 3
+    1353 RESTART
+    1354 GRAB 2
+    1356 ACC1
+    1357 BRANCHIFNOT 1370
+    1359 ACC2
+    1360 PUSHACC2
+    1361 GETFIELD1
+    1362 PUSHACC2
+    1363 PUSHOFFSETCLOSURE0
+    1364 APPLY3
+    1365 PUSHACC2
+    1366 GETFIELD0
+    1367 PUSHACC2
+    1368 APPTERM2 5
+    1370 ACC2
+    1371 RETURN 3
+    1373 RESTART
+    1374 GRAB 2
+    1376 ACC1
+    1377 BRANCHIFNOT 1400
+    1379 ACC2
+    1380 BRANCHIFNOT 1407
+    1382 ACC2
+    1383 GETFIELD0
+    1384 PUSHACC2
+    1385 GETFIELD0
+    1386 PUSHACC2
+    1387 APPLY2
+    1388 PUSHACC3
+    1389 GETFIELD1
+    1390 PUSHACC3
+    1391 GETFIELD1
+    1392 PUSHACC3
+    1393 PUSHOFFSETCLOSURE0
+    1394 APPLY3
+    1395 PUSHACC1
+    1396 MAKEBLOCK2 0
+    1398 RETURN 4
+    1400 ACC2
+    1401 BRANCHIFNOT 1405
+    1403 BRANCH 1407
+    1405 RETURN 3
+    1407 GETGLOBAL "List.map2"
+    1409 PUSHGETGLOBALFIELD Pervasives, 2
+    1412 APPTERM1 4
+    1414 RESTART
+    1415 GRAB 2
+    1417 ACC1
+    1418 BRANCHIFNOT 1437
+    1420 ACC2
+    1421 BRANCHIFNOT 1444
+    1423 ACC2
+    1424 GETFIELD0
+    1425 PUSHACC2
+    1426 GETFIELD0
+    1427 PUSHACC2
+    1428 APPLY2
+    1429 ACC2
+    1430 GETFIELD1
+    1431 PUSHACC2
+    1432 GETFIELD1
+    1433 PUSHACC2
+    1434 PUSHOFFSETCLOSURE0
+    1435 APPTERM3 6
+    1437 ACC2
+    1438 BRANCHIFNOT 1442
+    1440 BRANCH 1444
+    1442 RETURN 3
+    1444 GETGLOBAL "List.iter2"
+    1446 PUSHGETGLOBALFIELD Pervasives, 2
+    1449 APPTERM1 4
+    1451 RESTART
+    1452 GRAB 3
+    1454 ACC2
+    1455 BRANCHIFNOT 1476
+    1457 ACC3
+    1458 BRANCHIFNOT 1482
+    1460 ACC3
+    1461 GETFIELD1
+    1462 PUSHACC3
+    1463 GETFIELD1
+    1464 PUSHACC5
+    1465 GETFIELD0
+    1466 PUSHACC5
+    1467 GETFIELD0
+    1468 PUSHACC5
+    1469 PUSHACC5
+    1470 APPLY3
+    1471 PUSHACC3
+    1472 PUSHOFFSETCLOSURE0
+    1473 APPTERM 4, 8
+    1476 ACC3
+    1477 BRANCHIF 1482
+    1479 ACC1
+    1480 RETURN 4
+    1482 GETGLOBAL "List.fold_left2"
+    1484 PUSHGETGLOBALFIELD Pervasives, 2
+    1487 APPTERM1 5
+    1489 RESTART
+    1490 GRAB 3
+    1492 ACC1
+    1493 BRANCHIFNOT 1516
+    1495 ACC2
+    1496 BRANCHIFNOT 1522
+    1498 PUSH_RETADDR 1509
+    1500 ACC6
+    1501 PUSHACC6
+    1502 GETFIELD1
+    1503 PUSHACC6
+    1504 GETFIELD1
+    1505 PUSHACC6
+    1506 PUSHOFFSETCLOSURE0
+    1507 APPLY 4
+    1509 PUSHACC3
+    1510 GETFIELD0
+    1511 PUSHACC3
+    1512 GETFIELD0
+    1513 PUSHACC3
+    1514 APPTERM3 7
+    1516 ACC2
+    1517 BRANCHIF 1522
+    1519 ACC3
+    1520 RETURN 4
+    1522 GETGLOBAL "List.fold_right2"
+    1524 PUSHGETGLOBALFIELD Pervasives, 2
+    1527 APPTERM1 5
+    1529 RESTART
+    1530 GRAB 1
+    1532 ACC1
+    1533 BRANCHIFNOT 1549
+    1535 ACC1
+    1536 GETFIELD0
+    1537 PUSHACC1
+    1538 APPLY1
+    1539 BRANCHIFNOT 1547
+    1541 ACC1
+    1542 GETFIELD1
+    1543 PUSHACC1
+    1544 PUSHOFFSETCLOSURE0
+    1545 APPTERM2 4
+    1547 RETURN 2
+    1549 CONST1
+    1550 RETURN 2
+    1552 RESTART
+    1553 GRAB 1
+    1555 ACC1
+    1556 BRANCHIFNOT 1570
+    1558 ACC1
+    1559 GETFIELD0
+    1560 PUSHACC1
+    1561 APPLY1
+    1562 BRANCHIF 1570
+    1564 ACC1
+    1565 GETFIELD1
+    1566 PUSHACC1
+    1567 PUSHOFFSETCLOSURE0
+    1568 APPTERM2 4
+    1570 RETURN 2
+    1572 RESTART
+    1573 GRAB 2
+    1575 ACC1
+    1576 BRANCHIFNOT 1599
+    1578 ACC2
+    1579 BRANCHIFNOT 1605
+    1581 ACC2
+    1582 GETFIELD0
+    1583 PUSHACC2
+    1584 GETFIELD0
+    1585 PUSHACC2
+    1586 APPLY2
+    1587 BRANCHIFNOT 1597
+    1589 ACC2
+    1590 GETFIELD1
+    1591 PUSHACC2
+    1592 GETFIELD1
+    1593 PUSHACC2
+    1594 PUSHOFFSETCLOSURE0
+    1595 APPTERM3 6
+    1597 RETURN 3
+    1599 ACC2
+    1600 BRANCHIF 1605
+    1602 CONST1
+    1603 RETURN 3
+    1605 GETGLOBAL "List.for_all2"
+    1607 PUSHGETGLOBALFIELD Pervasives, 2
+    1610 APPTERM1 4
+    1612 RESTART
+    1613 GRAB 2
+    1615 ACC1
+    1616 BRANCHIFNOT 1639
+    1618 ACC2
+    1619 BRANCHIFNOT 1646
+    1621 ACC2
+    1622 GETFIELD0
+    1623 PUSHACC2
+    1624 GETFIELD0
+    1625 PUSHACC2
+    1626 APPLY2
+    1627 BRANCHIF 1637
+    1629 ACC2
+    1630 GETFIELD1
+    1631 PUSHACC2
+    1632 GETFIELD1
+    1633 PUSHACC2
+    1634 PUSHOFFSETCLOSURE0
+    1635 APPTERM3 6
+    1637 RETURN 3
+    1639 ACC2
+    1640 BRANCHIFNOT 1644
+    1642 BRANCH 1646
+    1644 RETURN 3
+    1646 GETGLOBAL "List.exists2"
+    1648 PUSHGETGLOBALFIELD Pervasives, 2
+    1651 APPTERM1 4
+    1653 RESTART
+    1654 GRAB 1
+    1656 ACC1
+    1657 BRANCHIFNOT 1672
+    1659 ACC0
+    1660 PUSHACC2
+    1661 GETFIELD0
+    1662 C_CALL2 equal
+    1664 BRANCHIF 1672
+    1666 ACC1
+    1667 GETFIELD1
+    1668 PUSHACC1
+    1669 PUSHOFFSETCLOSURE0
+    1670 APPTERM2 4
+    1672 RETURN 2
+    1674 RESTART
+    1675 GRAB 1
+    1677 ACC1
+    1678 BRANCHIFNOT 1692
+    1680 ACC0
+    1681 PUSHACC2
+    1682 GETFIELD0
+    1683 EQ
+    1684 BRANCHIF 1692
+    1686 ACC1
+    1687 GETFIELD1
+    1688 PUSHACC1
+    1689 PUSHOFFSETCLOSURE0
+    1690 APPTERM2 4
+    1692 RETURN 2
+    1694 RESTART
+    1695 GRAB 1
+    1697 ACC1
+    1698 BRANCHIFNOT 1719
+    1700 ACC1
+    1701 GETFIELD0
+    1702 PUSHACC1
+    1703 PUSHACC1
+    1704 GETFIELD0
+    1705 C_CALL2 equal
+    1707 BRANCHIFNOT 1713
+    1709 ACC0
+    1710 GETFIELD1
+    1711 RETURN 3
+    1713 ACC2
+    1714 GETFIELD1
+    1715 PUSHACC2
+    1716 PUSHOFFSETCLOSURE0
+    1717 APPTERM2 5
+    1719 GETGLOBAL Not_found
+    1721 MAKEBLOCK1 0
+    1723 RAISE
+    1724 RESTART
+    1725 GRAB 1
+    1727 ACC1
+    1728 BRANCHIFNOT 1748
+    1730 ACC1
+    1731 GETFIELD0
+    1732 PUSHACC1
+    1733 PUSHACC1
+    1734 GETFIELD0
+    1735 EQ
+    1736 BRANCHIFNOT 1742
+    1738 ACC0
+    1739 GETFIELD1
+    1740 RETURN 3
+    1742 ACC2
+    1743 GETFIELD1
+    1744 PUSHACC2
+    1745 PUSHOFFSETCLOSURE0
+    1746 APPTERM2 5
+    1748 GETGLOBAL Not_found
+    1750 MAKEBLOCK1 0
+    1752 RAISE
+    1753 RESTART
+    1754 GRAB 1
+    1756 ACC1
+    1757 BRANCHIFNOT 1773
+    1759 ACC0
+    1760 PUSHACC2
+    1761 GETFIELD0
+    1762 GETFIELD0
+    1763 C_CALL2 equal
+    1765 BRANCHIF 1773
+    1767 ACC1
+    1768 GETFIELD1
+    1769 PUSHACC1
+    1770 PUSHOFFSETCLOSURE0
+    1771 APPTERM2 4
+    1773 RETURN 2
+    1775 RESTART
+    1776 GRAB 1
+    1778 ACC1
+    1779 BRANCHIFNOT 1794
+    1781 ACC0
+    1782 PUSHACC2
+    1783 GETFIELD0
+    1784 GETFIELD0
+    1785 EQ
+    1786 BRANCHIF 1794
+    1788 ACC1
+    1789 GETFIELD1
+    1790 PUSHACC1
+    1791 PUSHOFFSETCLOSURE0
+    1792 APPTERM2 4
+    1794 RETURN 2
+    1796 RESTART
+    1797 GRAB 1
+    1799 ACC1
+    1800 BRANCHIFNOT 1825
+    1802 ACC1
+    1803 GETFIELD0
+    1804 PUSHACC2
+    1805 GETFIELD1
+    1806 PUSHACC2
+    1807 PUSHACC2
+    1808 GETFIELD0
+    1809 C_CALL2 equal
+    1811 BRANCHIFNOT 1816
+    1813 ACC0
+    1814 RETURN 4
+    1816 ACC0
+    1817 PUSHACC3
+    1818 PUSHOFFSETCLOSURE0
+    1819 APPLY2
+    1820 PUSHACC2
+    1821 MAKEBLOCK2 0
+    1823 POP 2
+    1825 RETURN 2
+    1827 RESTART
+    1828 GRAB 1
+    1830 ACC1
+    1831 BRANCHIFNOT 1855
+    1833 ACC1
+    1834 GETFIELD0
+    1835 PUSHACC2
+    1836 GETFIELD1
+    1837 PUSHACC2
+    1838 PUSHACC2
+    1839 GETFIELD0
+    1840 EQ
+    1841 BRANCHIFNOT 1846
+    1843 ACC0
+    1844 RETURN 4
+    1846 ACC0
+    1847 PUSHACC3
+    1848 PUSHOFFSETCLOSURE0
+    1849 APPLY2
+    1850 PUSHACC2
+    1851 MAKEBLOCK2 0
+    1853 POP 2
+    1855 RETURN 2
+    1857 RESTART
+    1858 GRAB 1
+    1860 ACC1
+    1861 BRANCHIFNOT 1879
+    1863 ACC1
+    1864 GETFIELD0
+    1865 PUSHACC0
+    1866 PUSHACC2
+    1867 APPLY1
+    1868 BRANCHIFNOT 1873
+    1870 ACC0
+    1871 RETURN 3
+    1873 ACC2
+    1874 GETFIELD1
+    1875 PUSHACC2
+    1876 PUSHOFFSETCLOSURE0
+    1877 APPTERM2 5
+    1879 GETGLOBAL Not_found
+    1881 MAKEBLOCK1 0
+    1883 RAISE
+    1884 RESTART
+    1885 GRAB 2
+    1887 ACC2
+    1888 BRANCHIFNOT 1917
+    1890 ACC2
+    1891 GETFIELD0
+    1892 PUSHACC3
+    1893 GETFIELD1
+    1894 PUSHACC1
+    1895 PUSHENVACC2
+    1896 APPLY1
+    1897 BRANCHIFNOT 1908
+    1899 ACC0
+    1900 PUSHACC4
+    1901 PUSHACC4
+    1902 PUSHACC4
+    1903 MAKEBLOCK2 0
+    1905 PUSHOFFSETCLOSURE0
+    1906 APPTERM3 8
+    1908 ACC0
+    1909 PUSHACC4
+    1910 PUSHACC3
+    1911 MAKEBLOCK2 0
+    1913 PUSHACC4
+    1914 PUSHOFFSETCLOSURE0
+    1915 APPTERM3 8
+    1917 ACC1
+    1918 PUSHENVACC1
+    1919 APPLY1
+    1920 PUSHACC1
+    1921 PUSHENVACC1
+    1922 APPLY1
+    1923 MAKEBLOCK2 0
+    1925 RETURN 3
+    1927 RESTART
+    1928 GRAB 1
+    1930 ACC0
+    1931 PUSHENVACC1
+    1932 CLOSUREREC 2, 1885
+    1936 ACC2
+    1937 PUSHCONST0
+    1938 PUSHCONST0
+    1939 PUSHACC3
+    1940 APPTERM3 6
+    1942 ACC0
+    1943 BRANCHIFNOT 1967
+    1945 ACC0
+    1946 GETFIELD0
+    1947 PUSHACC1
+    1948 GETFIELD1
+    1949 PUSHOFFSETCLOSURE0
+    1950 APPLY1
+    1951 PUSHACC0
+    1952 GETFIELD1
+    1953 PUSHACC2
+    1954 GETFIELD1
+    1955 MAKEBLOCK2 0
+    1957 PUSHACC1
+    1958 GETFIELD0
+    1959 PUSHACC3
+    1960 GETFIELD0
+    1961 MAKEBLOCK2 0
+    1963 MAKEBLOCK2 0
+    1965 RETURN 3
+    1967 GETGLOBAL <0>(0, 0)
+    1969 RETURN 1
+    1971 RESTART
+    1972 GRAB 1
+    1974 ACC0
+    1975 BRANCHIFNOT 1996
+    1977 ACC1
+    1978 BRANCHIFNOT 2003
+    1980 ACC1
+    1981 GETFIELD1
+    1982 PUSHACC1
+    1983 GETFIELD1
+    1984 PUSHOFFSETCLOSURE0
+    1985 APPLY2
+    1986 PUSHACC2
+    1987 GETFIELD0
+    1988 PUSHACC2
+    1989 GETFIELD0
+    1990 MAKEBLOCK2 0
+    1992 MAKEBLOCK2 0
+    1994 RETURN 2
+    1996 ACC1
+    1997 BRANCHIFNOT 2001
+    1999 BRANCH 2003
+    2001 RETURN 2
+    2003 GETGLOBAL "List.combine"
+    2005 PUSHGETGLOBALFIELD Pervasives, 2
+    2008 APPTERM1 3
+    2010 RESTART
+    2011 GRAB 1
+    2013 ACC1
+    2014 BRANCHIFNOT 2038
+    2016 ACC1
+    2017 GETFIELD0
+    2018 PUSHACC2
+    2019 GETFIELD1
+    2020 PUSHACC1
+    2021 PUSHENVACC2
+    2022 APPLY1
+    2023 BRANCHIFNOT 2033
+    2025 ACC0
+    2026 PUSHACC3
+    2027 PUSHACC3
+    2028 MAKEBLOCK2 0
+    2030 PUSHOFFSETCLOSURE0
+    2031 APPTERM2 6
+    2033 ACC0
+    2034 PUSHACC3
+    2035 PUSHOFFSETCLOSURE0
+    2036 APPTERM2 6
+    2038 ACC0
+    2039 PUSHENVACC1
+    2040 APPTERM1 3
+    2042 ACC0
+    2043 PUSHENVACC1
+    2044 CLOSUREREC 2, 2011
+    2048 CONST0
+    2049 PUSHACC1
+    2050 APPTERM1 3
+    2052 RESTART
+    2053 GRAB 2
+    2055 ACC1
+    2056 BRANCHIFNOT 2077
+    2058 ACC2
+    2059 BRANCHIFNOT 2084
+    2061 ACC2
+    2062 GETFIELD1
+    2063 PUSHACC2
+    2064 GETFIELD1
+    2065 PUSHACC2
+    2066 PUSHACC5
+    2067 GETFIELD0
+    2068 PUSHACC5
+    2069 GETFIELD0
+    2070 PUSHENVACC1
+    2071 APPLY2
+    2072 MAKEBLOCK2 0
+    2074 PUSHOFFSETCLOSURE0
+    2075 APPTERM3 6
+    2077 ACC2
+    2078 BRANCHIFNOT 2082
+    2080 BRANCH 2084
+    2082 RETURN 3
+    2084 GETGLOBAL "List.rev_map2"
+    2086 PUSHGETGLOBALFIELD Pervasives, 2
+    2089 APPTERM1 4
+    2091 RESTART
+    2092 GRAB 2
+    2094 ACC0
+    2095 CLOSUREREC 1, 2053
+    2099 ACC3
+    2100 PUSHACC3
+    2101 PUSHCONST0
+    2102 PUSHACC3
+    2103 APPTERM3 7
+    2105 RESTART
+    2106 GRAB 1
+    2108 ACC1
+    2109 BRANCHIFNOT 2123
+    2111 ACC1
+    2112 GETFIELD1
+    2113 PUSHACC1
+    2114 PUSHACC3
+    2115 GETFIELD0
+    2116 PUSHENVACC1
+    2117 APPLY1
+    2118 MAKEBLOCK2 0
+    2120 PUSHOFFSETCLOSURE0
+    2121 APPTERM2 4
+    2123 ACC0
+    2124 RETURN 2
+    2126 RESTART
+    2127 GRAB 1
+    2129 ACC0
+    2130 CLOSUREREC 1, 2106
+    2134 ACC2
+    2135 PUSHCONST0
+    2136 PUSHACC2
+    2137 APPTERM2 5
+    2139 CONST0
+    2140 PUSHACC1
+    2141 PUSHENVACC1
+    2142 APPTERM2 3
+    2144 ACC0
+    2145 BRANCHIFNOT 2151
+    2147 ACC0
+    2148 GETFIELD1
+    2149 RETURN 1
+    2151 GETGLOBAL "tl"
+    2153 PUSHGETGLOBALFIELD Pervasives, 3
+    2156 APPTERM1 2
+    2158 ACC0
+    2159 BRANCHIFNOT 2165
+    2161 ACC0
+    2162 GETFIELD0
+    2163 RETURN 1
+    2165 GETGLOBAL "hd"
+    2167 PUSHGETGLOBALFIELD Pervasives, 3
+    2170 APPTERM1 2
+    2172 ACC0
+    2173 PUSHCONST0
+    2174 PUSHENVACC1
+    2175 APPTERM2 3
+    2177 CLOSUREREC 0, 1200
+    2181 ACC0
+    2182 CLOSURE 1, 2172
+    2185 PUSH
+    2186 CLOSURE 0, 2158
+    2189 PUSH
+    2190 CLOSURE 0, 2144
+    2193 PUSH
+    2194 CLOSUREREC 0, 1217
+    2198 GETGLOBALFIELD Pervasives, 16
+    2201 PUSH
+    2202 CLOSUREREC 0, 1259
+    2206 ACC0
+    2207 CLOSURE 1, 2139
+    2210 PUSH
+    2211 CLOSUREREC 0, 1277
+    2215 CLOSUREREC 0, 1294
+    2219 CLOSURE 0, 2127
+    2222 PUSH
+    2223 CLOSUREREC 0, 1316
+    2227 CLOSUREREC 0, 1334
+    2231 CLOSUREREC 0, 1354
+    2235 CLOSUREREC 0, 1374
+    2239 CLOSURE 0, 2092
+    2242 PUSH
+    2243 CLOSUREREC 0, 1415
+    2247 CLOSUREREC 0, 1452
+    2251 CLOSUREREC 0, 1490
+    2255 CLOSUREREC 0, 1530
+    2259 CLOSUREREC 0, 1553
+    2263 CLOSUREREC 0, 1573
+    2267 CLOSUREREC 0, 1613
+    2271 CLOSUREREC 0, 1654
+    2275 CLOSUREREC 0, 1675
+    2279 CLOSUREREC 0, 1695
+    2283 CLOSUREREC 0, 1725
+    2287 CLOSUREREC 0, 1754
+    2291 CLOSUREREC 0, 1776
+    2295 CLOSUREREC 0, 1797
+    2299 CLOSUREREC 0, 1828
+    2303 CLOSUREREC 0, 1858
+    2307 ACC 24
+    2309 CLOSURE 1, 2042
+    2312 PUSHACC 25
+    2314 CLOSUREREC 1, 1928
+    2318 CLOSUREREC 0, 1942
+    2322 CLOSUREREC 0, 1972
+    2326 ACC0
+    2327 PUSHACC2
+    2328 PUSHACC7
+    2329 PUSHACC 9
+    2331 PUSHACC 11
+    2333 PUSHACC 13
+    2335 PUSHACC 15
+    2337 PUSHACC 17
+    2339 PUSHACC 10
+    2341 PUSHACC 12
+    2343 PUSHACC 13
+    2345 PUSHACC 15
+    2347 PUSHACC 23
+    2349 PUSHACC 25
+    2351 PUSHACC 27
+    2353 PUSHACC 29
+    2355 PUSHACC 31
+    2357 PUSHACC 33
+    2359 PUSHACC 35
+    2361 PUSHACC 37
+    2363 PUSHACC 40
+    2365 PUSHACC 42
+    2367 PUSHACC 41
+    2369 PUSHACC 45
+    2371 PUSHACC 47
+    2373 PUSHACC 50
+    2375 PUSHACC 52
+    2377 PUSHACC 51
+    2379 PUSHACC 55
+    2381 PUSHACC 56
+    2383 PUSHACC 59
+    2385 PUSHACC 61
+    2387 PUSHACC 60
+    2389 PUSHACC 64
+    2391 PUSHACC 66
+    2393 PUSHACC 68
+    2395 PUSHACC 70
+    2397 MAKEBLOCK 37, 0
+    2400 POP 36
+    2402 SETGLOBAL List
+    2404 BRANCH 2432
+    2406 CONST0
+    2407 PUSHACC1
+    2408 LEINT
+    2409 BRANCHIFNOT 2414
+    2411 CONST0
+    2412 RETURN 1
+    2414 ACC0
+    2415 OFFSETINT -1
+    2417 PUSHOFFSETCLOSURE0
+    2418 APPLY1
+    2419 PUSHACC1
+    2420 MAKEBLOCK2 0
+    2422 RETURN 1
+    2424 RESTART
+    2425 GRAB 1
+    2427 ACC1
+    2428 PUSHACC1
+    2429 ADDINT
+    2430 RETURN 2
+    2432 CLOSUREREC 0, 2406
+    2436 CONSTINT 300
+    2438 PUSHACC1
+    2439 APPLY1
+    2440 PUSHCONST0
+    2441 C_CALL1 gc_minor
+    2443 CONSTINT 150
+    2445 PUSHCONSTINT 301
+    2447 MULINT
+    2448 PUSHACC1
+    2449 PUSHCONST0
+    2450 PUSH
+    2451 CLOSURE 0, 2425
+    2454 PUSHGETGLOBALFIELD List, 12
+    2457 APPLY3
+    2458 NEQ
+    2459 BRANCHIFNOT 2466
+    2461 GETGLOBAL Not_found
+    2463 MAKEBLOCK1 0
+    2465 RAISE
+    2466 POP 2
+    2468 ATOM0
+    2469 SETGLOBAL T320-gc-1
+    2471 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t320-gc-2.ml b/testsuite/tests/tool-ocaml/t320-gc-2.ml
new file mode 100644
index 00000000..cc04f0bb
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t320-gc-2.ml
@@ -0,0 +1,1597 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f n =
+  if n <= 0 then []
+  else n :: f (n-1)
+in
+let l = f 300 in
+Gc.major ();
+if List.fold_left (+) 0 l <> 301 * 150 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 746
+      11 RESTART
+      12 GRAB 1
+      14 ACC0
+      15 BRANCHIFNOT 28
+      17 ACC1
+      18 PUSHACC1
+      19 GETFIELD1
+      20 PUSHOFFSETCLOSURE0
+      21 APPLY2
+      22 PUSHACC1
+      23 GETFIELD0
+      24 MAKEBLOCK2 0
+      26 RETURN 2
+      28 ACC1
+      29 RETURN 2
+      31 RESTART
+      32 GRAB 3
+      34 CONST0
+      35 PUSHACC4
+      36 LEINT
+      37 BRANCHIFNOT 42
+      39 CONST0
+      40 RETURN 4
+      42 ACC3
+      43 PUSHACC3
+      44 PUSHACC3
+      45 PUSHACC3
+      46 C_CALL4 caml_input
+      48 PUSHCONST0
+      49 PUSHACC1
+      50 EQ
+      51 BRANCHIFNOT 58
+      53 GETGLOBAL End_of_file
+      55 MAKEBLOCK1 0
+      57 RAISE
+      58 ACC0
+      59 PUSHACC5
+      60 SUBINT
+      61 PUSHACC1
+      62 PUSHACC5
+      63 ADDINT
+      64 PUSHACC4
+      65 PUSHACC4
+      66 PUSHOFFSETCLOSURE0
+      67 APPTERM 4, 9
+      70 ACC0
+      71 C_CALL1 caml_input_scan_line
+      73 PUSHCONST0
+      74 PUSHACC1
+      75 EQ
+      76 BRANCHIFNOT 83
+      78 GETGLOBAL End_of_file
+      80 MAKEBLOCK1 0
+      82 RAISE
+      83 CONST0
+      84 PUSHACC1
+      85 GTINT
+      86 BRANCHIFNOT 107
+      88 ACC0
+      89 OFFSETINT -1
+      91 C_CALL1 create_string
+      93 PUSHACC1
+      94 OFFSETINT -1
+      96 PUSHCONST0
+      97 PUSHACC2
+      98 PUSHACC5
+      99 C_CALL4 caml_input
+     101 ACC2
+     102 C_CALL1 caml_input_char
+     104 ACC0
+     105 RETURN 3
+     107 ACC0
+     108 NEGINT
+     109 C_CALL1 create_string
+     111 PUSHACC1
+     112 NEGINT
+     113 PUSHCONST0
+     114 PUSHACC2
+     115 PUSHACC5
+     116 C_CALL4 caml_input
+     118 CONST0
+     119 PUSHTRAP 130
+     121 ACC6
+     122 PUSHOFFSETCLOSURE0
+     123 APPLY1
+     124 PUSHACC5
+     125 PUSHENVACC1
+     126 APPLY2
+     127 POPTRAP
+     128 RETURN 3
+     130 PUSHGETGLOBAL End_of_file
+     132 PUSHACC1
+     133 GETFIELD0
+     134 EQ
+     135 BRANCHIFNOT 140
+     137 ACC1
+     138 RETURN 4
+     140 ACC0
+     141 RAISE
+     142 ACC0
+     143 C_CALL1 caml_flush
+     145 RETURN 1
+     147 RESTART
+     148 GRAB 1
+     150 ACC1
+     151 PUSHACC1
+     152 C_CALL2 caml_output_char
+     154 RETURN 2
+     156 RESTART
+     157 GRAB 1
+     159 ACC1
+     160 PUSHACC1
+     161 C_CALL2 caml_output_char
+     163 RETURN 2
+     165 RESTART
+     166 GRAB 1
+     168 ACC1
+     169 PUSHACC1
+     170 C_CALL2 caml_output_int
+     172 RETURN 2
+     174 RESTART
+     175 GRAB 1
+     177 ACC1
+     178 PUSHACC1
+     179 C_CALL2 caml_seek_out
+     181 RETURN 2
+     183 ACC0
+     184 C_CALL1 caml_pos_out
+     186 RETURN 1
+     188 ACC0
+     189 C_CALL1 caml_channel_size
+     191 RETURN 1
+     193 RESTART
+     194 GRAB 1
+     196 ACC1
+     197 PUSHACC1
+     198 C_CALL2 caml_set_binary_mode
+     200 RETURN 2
+     202 ACC0
+     203 C_CALL1 caml_input_char
+     205 RETURN 1
+     207 ACC0
+     208 C_CALL1 caml_input_char
+     210 RETURN 1
+     212 ACC0
+     213 C_CALL1 caml_input_int
+     215 RETURN 1
+     217 ACC0
+     218 C_CALL1 input_value
+     220 RETURN 1
+     222 RESTART
+     223 GRAB 1
+     225 ACC1
+     226 PUSHACC1
+     227 C_CALL2 caml_seek_in
+     229 RETURN 2
+     231 ACC0
+     232 C_CALL1 caml_pos_in
+     234 RETURN 1
+     236 ACC0
+     237 C_CALL1 caml_channel_size
+     239 RETURN 1
+     241 ACC0
+     242 C_CALL1 caml_close_channel
+     244 RETURN 1
+     246 RESTART
+     247 GRAB 1
+     249 ACC1
+     250 PUSHACC1
+     251 C_CALL2 caml_set_binary_mode
+     253 RETURN 2
+     255 CONST0
+     256 PUSHENVACC1
+     257 APPLY1
+     258 ACC0
+     259 C_CALL1 sys_exit
+     261 RETURN 1
+     263 CONST0
+     264 PUSHENVACC1
+     265 GETFIELD0
+     266 APPTERM1 2
+     268 CONST0
+     269 PUSHENVACC1
+     270 APPLY1
+     271 CONST0
+     272 PUSHENVACC2
+     273 APPTERM1 2
+     275 ENVACC1
+     276 GETFIELD0
+     277 PUSHACC0
+     278 PUSHACC2
+     279 CLOSURE 2, 268
+     282 PUSHENVACC1
+     283 SETFIELD0
+     284 RETURN 2
+     286 ENVACC1
+     287 C_CALL1 caml_flush
+     289 ENVACC2
+     290 C_CALL1 caml_flush
+     292 RETURN 1
+     294 CONST0
+     295 PUSHENVACC1
+     296 APPLY1
+     297 C_CALL1 float_of_string
+     299 RETURN 1
+     301 CONST0
+     302 PUSHENVACC1
+     303 APPLY1
+     304 C_CALL1 int_of_string
+     306 RETURN 1
+     308 ENVACC2
+     309 C_CALL1 caml_flush
+     311 ENVACC1
+     312 PUSHENVACC3
+     313 APPTERM1 2
+     315 CONSTINT 13
+     317 PUSHENVACC1
+     318 C_CALL2 caml_output_char
+     320 ENVACC1
+     321 C_CALL1 caml_flush
+     323 RETURN 1
+     325 ACC0
+     326 PUSHENVACC1
+     327 PUSHENVACC2
+     328 APPLY2
+     329 CONSTINT 13
+     331 PUSHENVACC1
+     332 C_CALL2 caml_output_char
+     334 ENVACC1
+     335 C_CALL1 caml_flush
+     337 RETURN 1
+     339 ACC0
+     340 PUSHENVACC1
+     341 APPLY1
+     342 PUSHENVACC2
+     343 PUSHENVACC3
+     344 APPTERM2 3
+     346 ACC0
+     347 PUSHENVACC1
+     348 APPLY1
+     349 PUSHENVACC2
+     350 PUSHENVACC3
+     351 APPTERM2 3
+     353 ACC0
+     354 PUSHENVACC1
+     355 PUSHENVACC2
+     356 APPTERM2 3
+     358 ACC0
+     359 PUSHENVACC1
+     360 C_CALL2 caml_output_char
+     362 RETURN 1
+     364 CONSTINT 13
+     366 PUSHENVACC1
+     367 C_CALL2 caml_output_char
+     369 ENVACC1
+     370 C_CALL1 caml_flush
+     372 RETURN 1
+     374 ACC0
+     375 PUSHENVACC1
+     376 PUSHENVACC2
+     377 APPLY2
+     378 CONSTINT 13
+     380 PUSHENVACC1
+     381 C_CALL2 caml_output_char
+     383 RETURN 1
+     385 ACC0
+     386 PUSHENVACC1
+     387 APPLY1
+     388 PUSHENVACC2
+     389 PUSHENVACC3
+     390 APPTERM2 3
+     392 ACC0
+     393 PUSHENVACC1
+     394 APPLY1
+     395 PUSHENVACC2
+     396 PUSHENVACC3
+     397 APPTERM2 3
+     399 ACC0
+     400 PUSHENVACC1
+     401 PUSHENVACC2
+     402 APPTERM2 3
+     404 ACC0
+     405 PUSHENVACC1
+     406 C_CALL2 caml_output_char
+     408 RETURN 1
+     410 RESTART
+     411 GRAB 3
+     413 CONST0
+     414 PUSHACC3
+     415 LTINT
+     416 BRANCHIF 427
+     418 ACC1
+     419 C_CALL1 ml_string_length
+     421 PUSHACC4
+     422 PUSHACC4
+     423 ADDINT
+     424 GTINT
+     425 BRANCHIFNOT 432
+     427 GETGLOBAL "really_input"
+     429 PUSHENVACC1
+     430 APPTERM1 5
+     432 ACC3
+     433 PUSHACC3
+     434 PUSHACC3
+     435 PUSHACC3
+     436 PUSHENVACC2
+     437 APPTERM 4, 8
+     440 RESTART
+     441 GRAB 3
+     443 CONST0
+     444 PUSHACC3
+     445 LTINT
+     446 BRANCHIF 457
+     448 ACC1
+     449 C_CALL1 ml_string_length
+     451 PUSHACC4
+     452 PUSHACC4
+     453 ADDINT
+     454 GTINT
+     455 BRANCHIFNOT 462
+     457 GETGLOBAL "input"
+     459 PUSHENVACC1
+     460 APPTERM1 5
+     462 ACC3
+     463 PUSHACC3
+     464 PUSHACC3
+     465 PUSHACC3
+     466 C_CALL4 caml_input
+     468 RETURN 4
+     470 ACC0
+     471 PUSHCONST0
+     472 PUSHGETGLOBAL <0>(0, <0>(6, 0))
+     474 PUSHENVACC1
+     475 APPTERM3 4
+     477 ACC0
+     478 PUSHCONST0
+     479 PUSHGETGLOBAL <0>(0, <0>(7, 0))
+     481 PUSHENVACC1
+     482 APPTERM3 4
+     484 RESTART
+     485 GRAB 2
+     487 ACC1
+     488 PUSHACC1
+     489 PUSHACC4
+     490 C_CALL3 sys_open
+     492 C_CALL1 caml_open_descriptor
+     494 RETURN 3
+     496 ACC0
+     497 C_CALL1 caml_flush
+     499 ACC0
+     500 C_CALL1 caml_close_channel
+     502 RETURN 1
+     504 RESTART
+     505 GRAB 1
+     507 CONST0
+     508 PUSHACC2
+     509 PUSHACC2
+     510 C_CALL3 output_value
+     512 RETURN 2
+     514 RESTART
+     515 GRAB 3
+     517 CONST0
+     518 PUSHACC3
+     519 LTINT
+     520 BRANCHIF 531
+     522 ACC1
+     523 C_CALL1 ml_string_length
+     525 PUSHACC4
+     526 PUSHACC4
+     527 ADDINT
+     528 GTINT
+     529 BRANCHIFNOT 536
+     531 GETGLOBAL "output"
+     533 PUSHENVACC1
+     534 APPTERM1 5
+     536 ACC3
+     537 PUSHACC3
+     538 PUSHACC3
+     539 PUSHACC3
+     540 C_CALL4 caml_output
+     542 RETURN 4
+     544 RESTART
+     545 GRAB 1
+     547 ACC1
+     548 C_CALL1 ml_string_length
+     550 PUSHCONST0
+     551 PUSHACC3
+     552 PUSHACC3
+     553 C_CALL4 caml_output
+     555 RETURN 2
+     557 ACC0
+     558 PUSHCONSTINT 438
+     560 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(6, 0))))
+     562 PUSHENVACC1
+     563 APPTERM3 4
+     565 ACC0
+     566 PUSHCONSTINT 438
+     568 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(7, 0))))
+     570 PUSHENVACC1
+     571 APPTERM3 4
+     573 RESTART
+     574 GRAB 2
+     576 ACC1
+     577 PUSHACC1
+     578 PUSHACC4
+     579 C_CALL3 sys_open
+     581 C_CALL1 caml_open_descriptor
+     583 RETURN 3
+     585 ACC0
+     586 PUSHGETGLOBAL "%.12g"
+     588 C_CALL2 format_float
+     590 RETURN 1
+     592 ACC0
+     593 PUSHGETGLOBAL "%d"
+     595 C_CALL2 format_int
+     597 RETURN 1
+     599 GETGLOBAL "false"
+     601 PUSHACC1
+     602 C_CALL2 string_equal
+     604 BRANCHIFNOT 609
+     606 CONST0
+     607 RETURN 1
+     609 GETGLOBAL "true"
+     611 PUSHACC1
+     612 C_CALL2 string_equal
+     614 BRANCHIFNOT 619
+     616 CONST1
+     617 RETURN 1
+     619 GETGLOBAL "bool_of_string"
+     621 PUSHENVACC1
+     622 APPTERM1 2
+     624 ACC0
+     625 BRANCHIFNOT 631
+     627 GETGLOBAL "true"
+     629 RETURN 1
+     631 GETGLOBAL "false"
+     633 RETURN 1
+     635 CONST0
+     636 PUSHACC1
+     637 LTINT
+     638 BRANCHIF 646
+     640 CONSTINT 255
+     642 PUSHACC1
+     643 GTINT
+     644 BRANCHIFNOT 651
+     646 GETGLOBAL "char_of_int"
+     648 PUSHENVACC1
+     649 APPTERM1 2
+     651 ACC0
+     652 RETURN 1
+     654 RESTART
+     655 GRAB 1
+     657 ACC0
+     658 C_CALL1 ml_string_length
+     660 PUSHACC2
+     661 C_CALL1 ml_string_length
+     663 PUSHACC0
+     664 PUSHACC2
+     665 ADDINT
+     666 C_CALL1 create_string
+     668 PUSHACC2
+     669 PUSHCONST0
+     670 PUSHACC2
+     671 PUSHCONST0
+     672 PUSHACC7
+     673 C_CALL5 blit_string
+     675 ACC1
+     676 PUSHACC3
+     677 PUSHACC2
+     678 PUSHCONST0
+     679 PUSHACC 8
+     681 C_CALL5 blit_string
+     683 ACC0
+     684 RETURN 5
+     686 CONSTINT -1
+     688 PUSHACC1
+     689 XORINT
+     690 RETURN 1
+     692 CONST0
+     693 PUSHACC1
+     694 GEINT
+     695 BRANCHIFNOT 700
+     697 ACC0
+     698 RETURN 1
+     700 ACC0
+     701 NEGINT
+     702 RETURN 1
+     704 RESTART
+     705 GRAB 1
+     707 ACC1
+     708 PUSHACC1
+     709 C_CALL2 greaterequal
+     711 BRANCHIFNOT 716
+     713 ACC0
+     714 RETURN 2
+     716 ACC1
+     717 RETURN 2
+     719 RESTART
+     720 GRAB 1
+     722 ACC1
+     723 PUSHACC1
+     724 C_CALL2 lessequal
+     726 BRANCHIFNOT 731
+     728 ACC0
+     729 RETURN 2
+     731 ACC1
+     732 RETURN 2
+     734 ACC0
+     735 PUSHGETGLOBAL Invalid_argument
+     737 MAKEBLOCK2 0
+     739 RAISE
+     740 ACC0
+     741 PUSHGETGLOBAL Failure
+     743 MAKEBLOCK2 0
+     745 RAISE
+     746 CLOSURE 0, 740
+     749 PUSH
+     750 CLOSURE 0, 734
+     753 PUSHGETGLOBAL "Pervasives.Exit"
+     755 MAKEBLOCK1 0
+     757 PUSHGETGLOBAL "Pervasives.Assert_failure"
+     759 MAKEBLOCK1 0
+     761 PUSH
+     762 CLOSURE 0, 720
+     765 PUSH
+     766 CLOSURE 0, 705
+     769 PUSH
+     770 CLOSURE 0, 692
+     773 PUSH
+     774 CLOSURE 0, 686
+     777 PUSHCONST0
+     778 PUSHCONSTINT 31
+     780 PUSHCONST1
+     781 LSLINT
+     782 EQ
+     783 BRANCHIFNOT 789
+     785 CONSTINT 30
+     787 BRANCH 791
+     789 CONSTINT 62
+     791 PUSHCONST1
+     792 LSLINT
+     793 PUSHACC0
+     794 OFFSETINT -1
+     796 PUSH
+     797 CLOSURE 0, 655
+     800 PUSHACC 9
+     802 CLOSURE 1, 635
+     805 PUSH
+     806 CLOSURE 0, 624
+     809 PUSHACC 11
+     811 CLOSURE 1, 599
+     814 PUSH
+     815 CLOSURE 0, 592
+     818 PUSH
+     819 CLOSURE 0, 585
+     822 PUSH
+     823 CLOSUREREC 0, 12
+     827 CONST0
+     828 C_CALL1 caml_open_descriptor
+     830 PUSHCONST1
+     831 C_CALL1 caml_open_descriptor
+     833 PUSHCONST2
+     834 C_CALL1 caml_open_descriptor
+     836 PUSH
+     837 CLOSURE 0, 574
+     840 PUSHACC0
+     841 CLOSURE 1, 565
+     844 PUSHACC1
+     845 CLOSURE 1, 557
+     848 PUSH
+     849 CLOSURE 0, 545
+     852 PUSHACC 22
+     854 CLOSURE 1, 515
+     857 PUSH
+     858 CLOSURE 0, 505
+     861 PUSH
+     862 CLOSURE 0, 496
+     865 PUSH
+     866 CLOSURE 0, 485
+     869 PUSHACC0
+     870 CLOSURE 1, 477
+     873 PUSHACC1
+     874 CLOSURE 1, 470
+     877 PUSHACC 28
+     879 CLOSURE 1, 441
+     882 PUSH
+     883 CLOSUREREC 0, 32
+     887 ACC0
+     888 PUSHACC 31
+     890 CLOSURE 2, 411
+     893 PUSHACC 22
+     895 CLOSUREREC 1, 70
+     899 ACC 15
+     901 CLOSURE 1, 404
+     904 PUSHACC 11
+     906 PUSHACC 17
+     908 CLOSURE 2, 399
+     911 PUSHACC 12
+     913 PUSHACC 18
+     915 PUSHACC 23
+     917 CLOSURE 3, 392
+     920 PUSHACC 13
+     922 PUSHACC 19
+     924 PUSHACC 23
+     926 CLOSURE 3, 385
+     929 PUSHACC 14
+     931 PUSHACC 20
+     933 CLOSURE 2, 374
+     936 PUSHACC 20
+     938 CLOSURE 1, 364
+     941 PUSHACC 20
+     943 CLOSURE 1, 358
+     946 PUSHACC 17
+     948 PUSHACC 22
+     950 CLOSURE 2, 353
+     953 PUSHACC 18
+     955 PUSHACC 23
+     957 PUSHACC 29
+     959 CLOSURE 3, 346
+     962 PUSHACC 19
+     964 PUSHACC 24
+     966 PUSHACC 29
+     968 CLOSURE 3, 339
+     971 PUSHACC 20
+     973 PUSHACC 25
+     975 CLOSURE 2, 325
+     978 PUSHACC 25
+     980 CLOSURE 1, 315
+     983 PUSHACC 12
+     985 PUSHACC 28
+     987 PUSHACC 30
+     989 CLOSURE 3, 308
+     992 PUSHACC0
+     993 CLOSURE 1, 301
+     996 PUSHACC1
+     997 CLOSURE 1, 294
+    1000 PUSHACC 29
+    1002 PUSHACC 31
+    1004 CLOSURE 2, 286
+    1007 MAKEBLOCK1 0
+    1009 PUSHACC0
+    1010 CLOSURE 1, 275
+    1013 PUSHACC1
+    1014 CLOSURE 1, 263
+    1017 PUSHACC0
+    1018 CLOSURE 1, 255
+    1021 PUSHACC1
+    1022 PUSHACC 22
+    1024 PUSHACC4
+    1025 PUSHACC3
+    1026 PUSH
+    1027 CLOSURE 0, 247
+    1030 PUSH
+    1031 CLOSURE 0, 241
+    1034 PUSH
+    1035 CLOSURE 0, 236
+    1038 PUSH
+    1039 CLOSURE 0, 231
+    1042 PUSH
+    1043 CLOSURE 0, 223
+    1046 PUSH
+    1047 CLOSURE 0, 217
+    1050 PUSH
+    1051 CLOSURE 0, 212
+    1054 PUSH
+    1055 CLOSURE 0, 207
+    1058 PUSHACC 32
+    1060 PUSHACC 35
+    1062 PUSHACC 33
+    1064 PUSH
+    1065 CLOSURE 0, 202
+    1068 PUSHACC 41
+    1070 PUSHACC 40
+    1072 PUSHACC 42
+    1074 PUSH
+    1075 CLOSURE 0, 194
+    1078 PUSHACC 46
+    1080 PUSH
+    1081 CLOSURE 0, 188
+    1084 PUSH
+    1085 CLOSURE 0, 183
+    1088 PUSH
+    1089 CLOSURE 0, 175
+    1092 PUSHACC 51
+    1094 PUSH
+    1095 CLOSURE 0, 166
+    1098 PUSH
+    1099 CLOSURE 0, 157
+    1102 PUSHACC 55
+    1104 PUSHACC 57
+    1106 PUSH
+    1107 CLOSURE 0, 148
+    1110 PUSH
+    1111 CLOSURE 0, 142
+    1114 PUSHACC 63
+    1116 PUSHACC 62
+    1118 PUSHACC 64
+    1120 PUSHACC 38
+    1122 PUSHACC 40
+    1124 PUSHACC 42
+    1126 PUSHACC 44
+    1128 PUSHACC 46
+    1130 PUSHACC 48
+    1132 PUSHACC 50
+    1134 PUSHACC 52
+    1136 PUSHACC 54
+    1138 PUSHACC 56
+    1140 PUSHACC 58
+    1142 PUSHACC 60
+    1144 PUSHACC 62
+    1146 PUSHACC 64
+    1148 PUSHACC 66
+    1150 PUSHACC 82
+    1152 PUSHACC 84
+    1154 PUSHACC 86
+    1156 PUSHACC 88
+    1158 PUSHACC 90
+    1160 PUSHACC 92
+    1162 PUSHACC 94
+    1164 PUSHACC 96
+    1166 PUSHACC 98
+    1168 PUSHACC 100
+    1170 PUSHACC 104
+    1172 PUSHACC 104
+    1174 PUSHACC 104
+    1176 PUSHACC 108
+    1178 PUSHACC 110
+    1180 PUSHACC 112
+    1182 PUSHACC 117
+    1184 PUSHACC 117
+    1186 PUSHACC 117
+    1188 PUSHACC 117
+    1190 MAKEBLOCK 69, 0
+    1193 POP 53
+    1195 SETGLOBAL Pervasives
+    1197 BRANCH 2177
+    1199 RESTART
+    1200 GRAB 1
+    1202 ACC1
+    1203 BRANCHIFNOT 1213
+    1205 ACC1
+    1206 GETFIELD1
+    1207 PUSHACC1
+    1208 OFFSETINT 1
+    1210 PUSHOFFSETCLOSURE0
+    1211 APPTERM2 4
+    1213 ACC0
+    1214 RETURN 2
+    1216 RESTART
+    1217 GRAB 1
+    1219 ACC0
+    1220 BRANCHIFNOT 1251
+    1222 CONST0
+    1223 PUSHACC2
+    1224 EQ
+    1225 BRANCHIFNOT 1231
+    1227 ACC0
+    1228 GETFIELD0
+    1229 RETURN 2
+    1231 CONST0
+    1232 PUSHACC2
+    1233 GTINT
+    1234 BRANCHIFNOT 1244
+    1236 ACC1
+    1237 OFFSETINT -1
+    1239 PUSHACC1
+    1240 GETFIELD1
+    1241 PUSHOFFSETCLOSURE0
+    1242 APPTERM2 4
+    1244 GETGLOBAL "List.nth"
+    1246 PUSHGETGLOBALFIELD Pervasives, 2
+    1249 APPTERM1 3
+    1251 GETGLOBAL "nth"
+    1253 PUSHGETGLOBALFIELD Pervasives, 3
+    1256 APPTERM1 3
+    1258 RESTART
+    1259 GRAB 1
+    1261 ACC0
+    1262 BRANCHIFNOT 1274
+    1264 ACC1
+    1265 PUSHACC1
+    1266 GETFIELD0
+    1267 MAKEBLOCK2 0
+    1269 PUSHACC1
+    1270 GETFIELD1
+    1271 PUSHOFFSETCLOSURE0
+    1272 APPTERM2 4
+    1274 ACC1
+    1275 RETURN 2
+    1277 ACC0
+    1278 BRANCHIFNOT 1291
+    1280 ACC0
+    1281 GETFIELD1
+    1282 PUSHOFFSETCLOSURE0
+    1283 APPLY1
+    1284 PUSHACC1
+    1285 GETFIELD0
+    1286 PUSHGETGLOBALFIELD Pervasives, 16
+    1289 APPTERM2 3
+    1291 RETURN 1
+    1293 RESTART
+    1294 GRAB 1
+    1296 ACC1
+    1297 BRANCHIFNOT 1313
+    1299 ACC1
+    1300 GETFIELD0
+    1301 PUSHACC1
+    1302 APPLY1
+    1303 PUSHACC2
+    1304 GETFIELD1
+    1305 PUSHACC2
+    1306 PUSHOFFSETCLOSURE0
+    1307 APPLY2
+    1308 PUSHACC1
+    1309 MAKEBLOCK2 0
+    1311 POP 1
+    1313 RETURN 2
+    1315 RESTART
+    1316 GRAB 1
+    1318 ACC1
+    1319 BRANCHIFNOT 1331
+    1321 ACC1
+    1322 GETFIELD0
+    1323 PUSHACC1
+    1324 APPLY1
+    1325 ACC1
+    1326 GETFIELD1
+    1327 PUSHACC1
+    1328 PUSHOFFSETCLOSURE0
+    1329 APPTERM2 4
+    1331 RETURN 2
+    1333 RESTART
+    1334 GRAB 2
+    1336 ACC2
+    1337 BRANCHIFNOT 1350
+    1339 ACC2
+    1340 GETFIELD1
+    1341 PUSHACC3
+    1342 GETFIELD0
+    1343 PUSHACC3
+    1344 PUSHACC3
+    1345 APPLY2
+    1346 PUSHACC2
+    1347 PUSHOFFSETCLOSURE0
+    1348 APPTERM3 6
+    1350 ACC1
+    1351 RETURN 3
+    1353 RESTART
+    1354 GRAB 2
+    1356 ACC1
+    1357 BRANCHIFNOT 1370
+    1359 ACC2
+    1360 PUSHACC2
+    1361 GETFIELD1
+    1362 PUSHACC2
+    1363 PUSHOFFSETCLOSURE0
+    1364 APPLY3
+    1365 PUSHACC2
+    1366 GETFIELD0
+    1367 PUSHACC2
+    1368 APPTERM2 5
+    1370 ACC2
+    1371 RETURN 3
+    1373 RESTART
+    1374 GRAB 2
+    1376 ACC1
+    1377 BRANCHIFNOT 1400
+    1379 ACC2
+    1380 BRANCHIFNOT 1407
+    1382 ACC2
+    1383 GETFIELD0
+    1384 PUSHACC2
+    1385 GETFIELD0
+    1386 PUSHACC2
+    1387 APPLY2
+    1388 PUSHACC3
+    1389 GETFIELD1
+    1390 PUSHACC3
+    1391 GETFIELD1
+    1392 PUSHACC3
+    1393 PUSHOFFSETCLOSURE0
+    1394 APPLY3
+    1395 PUSHACC1
+    1396 MAKEBLOCK2 0
+    1398 RETURN 4
+    1400 ACC2
+    1401 BRANCHIFNOT 1405
+    1403 BRANCH 1407
+    1405 RETURN 3
+    1407 GETGLOBAL "List.map2"
+    1409 PUSHGETGLOBALFIELD Pervasives, 2
+    1412 APPTERM1 4
+    1414 RESTART
+    1415 GRAB 2
+    1417 ACC1
+    1418 BRANCHIFNOT 1437
+    1420 ACC2
+    1421 BRANCHIFNOT 1444
+    1423 ACC2
+    1424 GETFIELD0
+    1425 PUSHACC2
+    1426 GETFIELD0
+    1427 PUSHACC2
+    1428 APPLY2
+    1429 ACC2
+    1430 GETFIELD1
+    1431 PUSHACC2
+    1432 GETFIELD1
+    1433 PUSHACC2
+    1434 PUSHOFFSETCLOSURE0
+    1435 APPTERM3 6
+    1437 ACC2
+    1438 BRANCHIFNOT 1442
+    1440 BRANCH 1444
+    1442 RETURN 3
+    1444 GETGLOBAL "List.iter2"
+    1446 PUSHGETGLOBALFIELD Pervasives, 2
+    1449 APPTERM1 4
+    1451 RESTART
+    1452 GRAB 3
+    1454 ACC2
+    1455 BRANCHIFNOT 1476
+    1457 ACC3
+    1458 BRANCHIFNOT 1482
+    1460 ACC3
+    1461 GETFIELD1
+    1462 PUSHACC3
+    1463 GETFIELD1
+    1464 PUSHACC5
+    1465 GETFIELD0
+    1466 PUSHACC5
+    1467 GETFIELD0
+    1468 PUSHACC5
+    1469 PUSHACC5
+    1470 APPLY3
+    1471 PUSHACC3
+    1472 PUSHOFFSETCLOSURE0
+    1473 APPTERM 4, 8
+    1476 ACC3
+    1477 BRANCHIF 1482
+    1479 ACC1
+    1480 RETURN 4
+    1482 GETGLOBAL "List.fold_left2"
+    1484 PUSHGETGLOBALFIELD Pervasives, 2
+    1487 APPTERM1 5
+    1489 RESTART
+    1490 GRAB 3
+    1492 ACC1
+    1493 BRANCHIFNOT 1516
+    1495 ACC2
+    1496 BRANCHIFNOT 1522
+    1498 PUSH_RETADDR 1509
+    1500 ACC6
+    1501 PUSHACC6
+    1502 GETFIELD1
+    1503 PUSHACC6
+    1504 GETFIELD1
+    1505 PUSHACC6
+    1506 PUSHOFFSETCLOSURE0
+    1507 APPLY 4
+    1509 PUSHACC3
+    1510 GETFIELD0
+    1511 PUSHACC3
+    1512 GETFIELD0
+    1513 PUSHACC3
+    1514 APPTERM3 7
+    1516 ACC2
+    1517 BRANCHIF 1522
+    1519 ACC3
+    1520 RETURN 4
+    1522 GETGLOBAL "List.fold_right2"
+    1524 PUSHGETGLOBALFIELD Pervasives, 2
+    1527 APPTERM1 5
+    1529 RESTART
+    1530 GRAB 1
+    1532 ACC1
+    1533 BRANCHIFNOT 1549
+    1535 ACC1
+    1536 GETFIELD0
+    1537 PUSHACC1
+    1538 APPLY1
+    1539 BRANCHIFNOT 1547
+    1541 ACC1
+    1542 GETFIELD1
+    1543 PUSHACC1
+    1544 PUSHOFFSETCLOSURE0
+    1545 APPTERM2 4
+    1547 RETURN 2
+    1549 CONST1
+    1550 RETURN 2
+    1552 RESTART
+    1553 GRAB 1
+    1555 ACC1
+    1556 BRANCHIFNOT 1570
+    1558 ACC1
+    1559 GETFIELD0
+    1560 PUSHACC1
+    1561 APPLY1
+    1562 BRANCHIF 1570
+    1564 ACC1
+    1565 GETFIELD1
+    1566 PUSHACC1
+    1567 PUSHOFFSETCLOSURE0
+    1568 APPTERM2 4
+    1570 RETURN 2
+    1572 RESTART
+    1573 GRAB 2
+    1575 ACC1
+    1576 BRANCHIFNOT 1599
+    1578 ACC2
+    1579 BRANCHIFNOT 1605
+    1581 ACC2
+    1582 GETFIELD0
+    1583 PUSHACC2
+    1584 GETFIELD0
+    1585 PUSHACC2
+    1586 APPLY2
+    1587 BRANCHIFNOT 1597
+    1589 ACC2
+    1590 GETFIELD1
+    1591 PUSHACC2
+    1592 GETFIELD1
+    1593 PUSHACC2
+    1594 PUSHOFFSETCLOSURE0
+    1595 APPTERM3 6
+    1597 RETURN 3
+    1599 ACC2
+    1600 BRANCHIF 1605
+    1602 CONST1
+    1603 RETURN 3
+    1605 GETGLOBAL "List.for_all2"
+    1607 PUSHGETGLOBALFIELD Pervasives, 2
+    1610 APPTERM1 4
+    1612 RESTART
+    1613 GRAB 2
+    1615 ACC1
+    1616 BRANCHIFNOT 1639
+    1618 ACC2
+    1619 BRANCHIFNOT 1646
+    1621 ACC2
+    1622 GETFIELD0
+    1623 PUSHACC2
+    1624 GETFIELD0
+    1625 PUSHACC2
+    1626 APPLY2
+    1627 BRANCHIF 1637
+    1629 ACC2
+    1630 GETFIELD1
+    1631 PUSHACC2
+    1632 GETFIELD1
+    1633 PUSHACC2
+    1634 PUSHOFFSETCLOSURE0
+    1635 APPTERM3 6
+    1637 RETURN 3
+    1639 ACC2
+    1640 BRANCHIFNOT 1644
+    1642 BRANCH 1646
+    1644 RETURN 3
+    1646 GETGLOBAL "List.exists2"
+    1648 PUSHGETGLOBALFIELD Pervasives, 2
+    1651 APPTERM1 4
+    1653 RESTART
+    1654 GRAB 1
+    1656 ACC1
+    1657 BRANCHIFNOT 1672
+    1659 ACC0
+    1660 PUSHACC2
+    1661 GETFIELD0
+    1662 C_CALL2 equal
+    1664 BRANCHIF 1672
+    1666 ACC1
+    1667 GETFIELD1
+    1668 PUSHACC1
+    1669 PUSHOFFSETCLOSURE0
+    1670 APPTERM2 4
+    1672 RETURN 2
+    1674 RESTART
+    1675 GRAB 1
+    1677 ACC1
+    1678 BRANCHIFNOT 1692
+    1680 ACC0
+    1681 PUSHACC2
+    1682 GETFIELD0
+    1683 EQ
+    1684 BRANCHIF 1692
+    1686 ACC1
+    1687 GETFIELD1
+    1688 PUSHACC1
+    1689 PUSHOFFSETCLOSURE0
+    1690 APPTERM2 4
+    1692 RETURN 2
+    1694 RESTART
+    1695 GRAB 1
+    1697 ACC1
+    1698 BRANCHIFNOT 1719
+    1700 ACC1
+    1701 GETFIELD0
+    1702 PUSHACC1
+    1703 PUSHACC1
+    1704 GETFIELD0
+    1705 C_CALL2 equal
+    1707 BRANCHIFNOT 1713
+    1709 ACC0
+    1710 GETFIELD1
+    1711 RETURN 3
+    1713 ACC2
+    1714 GETFIELD1
+    1715 PUSHACC2
+    1716 PUSHOFFSETCLOSURE0
+    1717 APPTERM2 5
+    1719 GETGLOBAL Not_found
+    1721 MAKEBLOCK1 0
+    1723 RAISE
+    1724 RESTART
+    1725 GRAB 1
+    1727 ACC1
+    1728 BRANCHIFNOT 1748
+    1730 ACC1
+    1731 GETFIELD0
+    1732 PUSHACC1
+    1733 PUSHACC1
+    1734 GETFIELD0
+    1735 EQ
+    1736 BRANCHIFNOT 1742
+    1738 ACC0
+    1739 GETFIELD1
+    1740 RETURN 3
+    1742 ACC2
+    1743 GETFIELD1
+    1744 PUSHACC2
+    1745 PUSHOFFSETCLOSURE0
+    1746 APPTERM2 5
+    1748 GETGLOBAL Not_found
+    1750 MAKEBLOCK1 0
+    1752 RAISE
+    1753 RESTART
+    1754 GRAB 1
+    1756 ACC1
+    1757 BRANCHIFNOT 1773
+    1759 ACC0
+    1760 PUSHACC2
+    1761 GETFIELD0
+    1762 GETFIELD0
+    1763 C_CALL2 equal
+    1765 BRANCHIF 1773
+    1767 ACC1
+    1768 GETFIELD1
+    1769 PUSHACC1
+    1770 PUSHOFFSETCLOSURE0
+    1771 APPTERM2 4
+    1773 RETURN 2
+    1775 RESTART
+    1776 GRAB 1
+    1778 ACC1
+    1779 BRANCHIFNOT 1794
+    1781 ACC0
+    1782 PUSHACC2
+    1783 GETFIELD0
+    1784 GETFIELD0
+    1785 EQ
+    1786 BRANCHIF 1794
+    1788 ACC1
+    1789 GETFIELD1
+    1790 PUSHACC1
+    1791 PUSHOFFSETCLOSURE0
+    1792 APPTERM2 4
+    1794 RETURN 2
+    1796 RESTART
+    1797 GRAB 1
+    1799 ACC1
+    1800 BRANCHIFNOT 1825
+    1802 ACC1
+    1803 GETFIELD0
+    1804 PUSHACC2
+    1805 GETFIELD1
+    1806 PUSHACC2
+    1807 PUSHACC2
+    1808 GETFIELD0
+    1809 C_CALL2 equal
+    1811 BRANCHIFNOT 1816
+    1813 ACC0
+    1814 RETURN 4
+    1816 ACC0
+    1817 PUSHACC3
+    1818 PUSHOFFSETCLOSURE0
+    1819 APPLY2
+    1820 PUSHACC2
+    1821 MAKEBLOCK2 0
+    1823 POP 2
+    1825 RETURN 2
+    1827 RESTART
+    1828 GRAB 1
+    1830 ACC1
+    1831 BRANCHIFNOT 1855
+    1833 ACC1
+    1834 GETFIELD0
+    1835 PUSHACC2
+    1836 GETFIELD1
+    1837 PUSHACC2
+    1838 PUSHACC2
+    1839 GETFIELD0
+    1840 EQ
+    1841 BRANCHIFNOT 1846
+    1843 ACC0
+    1844 RETURN 4
+    1846 ACC0
+    1847 PUSHACC3
+    1848 PUSHOFFSETCLOSURE0
+    1849 APPLY2
+    1850 PUSHACC2
+    1851 MAKEBLOCK2 0
+    1853 POP 2
+    1855 RETURN 2
+    1857 RESTART
+    1858 GRAB 1
+    1860 ACC1
+    1861 BRANCHIFNOT 1879
+    1863 ACC1
+    1864 GETFIELD0
+    1865 PUSHACC0
+    1866 PUSHACC2
+    1867 APPLY1
+    1868 BRANCHIFNOT 1873
+    1870 ACC0
+    1871 RETURN 3
+    1873 ACC2
+    1874 GETFIELD1
+    1875 PUSHACC2
+    1876 PUSHOFFSETCLOSURE0
+    1877 APPTERM2 5
+    1879 GETGLOBAL Not_found
+    1881 MAKEBLOCK1 0
+    1883 RAISE
+    1884 RESTART
+    1885 GRAB 2
+    1887 ACC2
+    1888 BRANCHIFNOT 1917
+    1890 ACC2
+    1891 GETFIELD0
+    1892 PUSHACC3
+    1893 GETFIELD1
+    1894 PUSHACC1
+    1895 PUSHENVACC2
+    1896 APPLY1
+    1897 BRANCHIFNOT 1908
+    1899 ACC0
+    1900 PUSHACC4
+    1901 PUSHACC4
+    1902 PUSHACC4
+    1903 MAKEBLOCK2 0
+    1905 PUSHOFFSETCLOSURE0
+    1906 APPTERM3 8
+    1908 ACC0
+    1909 PUSHACC4
+    1910 PUSHACC3
+    1911 MAKEBLOCK2 0
+    1913 PUSHACC4
+    1914 PUSHOFFSETCLOSURE0
+    1915 APPTERM3 8
+    1917 ACC1
+    1918 PUSHENVACC1
+    1919 APPLY1
+    1920 PUSHACC1
+    1921 PUSHENVACC1
+    1922 APPLY1
+    1923 MAKEBLOCK2 0
+    1925 RETURN 3
+    1927 RESTART
+    1928 GRAB 1
+    1930 ACC0
+    1931 PUSHENVACC1
+    1932 CLOSUREREC 2, 1885
+    1936 ACC2
+    1937 PUSHCONST0
+    1938 PUSHCONST0
+    1939 PUSHACC3
+    1940 APPTERM3 6
+    1942 ACC0
+    1943 BRANCHIFNOT 1967
+    1945 ACC0
+    1946 GETFIELD0
+    1947 PUSHACC1
+    1948 GETFIELD1
+    1949 PUSHOFFSETCLOSURE0
+    1950 APPLY1
+    1951 PUSHACC0
+    1952 GETFIELD1
+    1953 PUSHACC2
+    1954 GETFIELD1
+    1955 MAKEBLOCK2 0
+    1957 PUSHACC1
+    1958 GETFIELD0
+    1959 PUSHACC3
+    1960 GETFIELD0
+    1961 MAKEBLOCK2 0
+    1963 MAKEBLOCK2 0
+    1965 RETURN 3
+    1967 GETGLOBAL <0>(0, 0)
+    1969 RETURN 1
+    1971 RESTART
+    1972 GRAB 1
+    1974 ACC0
+    1975 BRANCHIFNOT 1996
+    1977 ACC1
+    1978 BRANCHIFNOT 2003
+    1980 ACC1
+    1981 GETFIELD1
+    1982 PUSHACC1
+    1983 GETFIELD1
+    1984 PUSHOFFSETCLOSURE0
+    1985 APPLY2
+    1986 PUSHACC2
+    1987 GETFIELD0
+    1988 PUSHACC2
+    1989 GETFIELD0
+    1990 MAKEBLOCK2 0
+    1992 MAKEBLOCK2 0
+    1994 RETURN 2
+    1996 ACC1
+    1997 BRANCHIFNOT 2001
+    1999 BRANCH 2003
+    2001 RETURN 2
+    2003 GETGLOBAL "List.combine"
+    2005 PUSHGETGLOBALFIELD Pervasives, 2
+    2008 APPTERM1 3
+    2010 RESTART
+    2011 GRAB 1
+    2013 ACC1
+    2014 BRANCHIFNOT 2038
+    2016 ACC1
+    2017 GETFIELD0
+    2018 PUSHACC2
+    2019 GETFIELD1
+    2020 PUSHACC1
+    2021 PUSHENVACC2
+    2022 APPLY1
+    2023 BRANCHIFNOT 2033
+    2025 ACC0
+    2026 PUSHACC3
+    2027 PUSHACC3
+    2028 MAKEBLOCK2 0
+    2030 PUSHOFFSETCLOSURE0
+    2031 APPTERM2 6
+    2033 ACC0
+    2034 PUSHACC3
+    2035 PUSHOFFSETCLOSURE0
+    2036 APPTERM2 6
+    2038 ACC0
+    2039 PUSHENVACC1
+    2040 APPTERM1 3
+    2042 ACC0
+    2043 PUSHENVACC1
+    2044 CLOSUREREC 2, 2011
+    2048 CONST0
+    2049 PUSHACC1
+    2050 APPTERM1 3
+    2052 RESTART
+    2053 GRAB 2
+    2055 ACC1
+    2056 BRANCHIFNOT 2077
+    2058 ACC2
+    2059 BRANCHIFNOT 2084
+    2061 ACC2
+    2062 GETFIELD1
+    2063 PUSHACC2
+    2064 GETFIELD1
+    2065 PUSHACC2
+    2066 PUSHACC5
+    2067 GETFIELD0
+    2068 PUSHACC5
+    2069 GETFIELD0
+    2070 PUSHENVACC1
+    2071 APPLY2
+    2072 MAKEBLOCK2 0
+    2074 PUSHOFFSETCLOSURE0
+    2075 APPTERM3 6
+    2077 ACC2
+    2078 BRANCHIFNOT 2082
+    2080 BRANCH 2084
+    2082 RETURN 3
+    2084 GETGLOBAL "List.rev_map2"
+    2086 PUSHGETGLOBALFIELD Pervasives, 2
+    2089 APPTERM1 4
+    2091 RESTART
+    2092 GRAB 2
+    2094 ACC0
+    2095 CLOSUREREC 1, 2053
+    2099 ACC3
+    2100 PUSHACC3
+    2101 PUSHCONST0
+    2102 PUSHACC3
+    2103 APPTERM3 7
+    2105 RESTART
+    2106 GRAB 1
+    2108 ACC1
+    2109 BRANCHIFNOT 2123
+    2111 ACC1
+    2112 GETFIELD1
+    2113 PUSHACC1
+    2114 PUSHACC3
+    2115 GETFIELD0
+    2116 PUSHENVACC1
+    2117 APPLY1
+    2118 MAKEBLOCK2 0
+    2120 PUSHOFFSETCLOSURE0
+    2121 APPTERM2 4
+    2123 ACC0
+    2124 RETURN 2
+    2126 RESTART
+    2127 GRAB 1
+    2129 ACC0
+    2130 CLOSUREREC 1, 2106
+    2134 ACC2
+    2135 PUSHCONST0
+    2136 PUSHACC2
+    2137 APPTERM2 5
+    2139 CONST0
+    2140 PUSHACC1
+    2141 PUSHENVACC1
+    2142 APPTERM2 3
+    2144 ACC0
+    2145 BRANCHIFNOT 2151
+    2147 ACC0
+    2148 GETFIELD1
+    2149 RETURN 1
+    2151 GETGLOBAL "tl"
+    2153 PUSHGETGLOBALFIELD Pervasives, 3
+    2156 APPTERM1 2
+    2158 ACC0
+    2159 BRANCHIFNOT 2165
+    2161 ACC0
+    2162 GETFIELD0
+    2163 RETURN 1
+    2165 GETGLOBAL "hd"
+    2167 PUSHGETGLOBALFIELD Pervasives, 3
+    2170 APPTERM1 2
+    2172 ACC0
+    2173 PUSHCONST0
+    2174 PUSHENVACC1
+    2175 APPTERM2 3
+    2177 CLOSUREREC 0, 1200
+    2181 ACC0
+    2182 CLOSURE 1, 2172
+    2185 PUSH
+    2186 CLOSURE 0, 2158
+    2189 PUSH
+    2190 CLOSURE 0, 2144
+    2193 PUSH
+    2194 CLOSUREREC 0, 1217
+    2198 GETGLOBALFIELD Pervasives, 16
+    2201 PUSH
+    2202 CLOSUREREC 0, 1259
+    2206 ACC0
+    2207 CLOSURE 1, 2139
+    2210 PUSH
+    2211 CLOSUREREC 0, 1277
+    2215 CLOSUREREC 0, 1294
+    2219 CLOSURE 0, 2127
+    2222 PUSH
+    2223 CLOSUREREC 0, 1316
+    2227 CLOSUREREC 0, 1334
+    2231 CLOSUREREC 0, 1354
+    2235 CLOSUREREC 0, 1374
+    2239 CLOSURE 0, 2092
+    2242 PUSH
+    2243 CLOSUREREC 0, 1415
+    2247 CLOSUREREC 0, 1452
+    2251 CLOSUREREC 0, 1490
+    2255 CLOSUREREC 0, 1530
+    2259 CLOSUREREC 0, 1553
+    2263 CLOSUREREC 0, 1573
+    2267 CLOSUREREC 0, 1613
+    2271 CLOSUREREC 0, 1654
+    2275 CLOSUREREC 0, 1675
+    2279 CLOSUREREC 0, 1695
+    2283 CLOSUREREC 0, 1725
+    2287 CLOSUREREC 0, 1754
+    2291 CLOSUREREC 0, 1776
+    2295 CLOSUREREC 0, 1797
+    2299 CLOSUREREC 0, 1828
+    2303 CLOSUREREC 0, 1858
+    2307 ACC 24
+    2309 CLOSURE 1, 2042
+    2312 PUSHACC 25
+    2314 CLOSUREREC 1, 1928
+    2318 CLOSUREREC 0, 1942
+    2322 CLOSUREREC 0, 1972
+    2326 ACC0
+    2327 PUSHACC2
+    2328 PUSHACC7
+    2329 PUSHACC 9
+    2331 PUSHACC 11
+    2333 PUSHACC 13
+    2335 PUSHACC 15
+    2337 PUSHACC 17
+    2339 PUSHACC 10
+    2341 PUSHACC 12
+    2343 PUSHACC 13
+    2345 PUSHACC 15
+    2347 PUSHACC 23
+    2349 PUSHACC 25
+    2351 PUSHACC 27
+    2353 PUSHACC 29
+    2355 PUSHACC 31
+    2357 PUSHACC 33
+    2359 PUSHACC 35
+    2361 PUSHACC 37
+    2363 PUSHACC 40
+    2365 PUSHACC 42
+    2367 PUSHACC 41
+    2369 PUSHACC 45
+    2371 PUSHACC 47
+    2373 PUSHACC 50
+    2375 PUSHACC 52
+    2377 PUSHACC 51
+    2379 PUSHACC 55
+    2381 PUSHACC 56
+    2383 PUSHACC 59
+    2385 PUSHACC 61
+    2387 PUSHACC 60
+    2389 PUSHACC 64
+    2391 PUSHACC 66
+    2393 PUSHACC 68
+    2395 PUSHACC 70
+    2397 MAKEBLOCK 37, 0
+    2400 POP 36
+    2402 SETGLOBAL List
+    2404 BRANCH 2432
+    2406 CONST0
+    2407 PUSHACC1
+    2408 LEINT
+    2409 BRANCHIFNOT 2414
+    2411 CONST0
+    2412 RETURN 1
+    2414 ACC0
+    2415 OFFSETINT -1
+    2417 PUSHOFFSETCLOSURE0
+    2418 APPLY1
+    2419 PUSHACC1
+    2420 MAKEBLOCK2 0
+    2422 RETURN 1
+    2424 RESTART
+    2425 GRAB 1
+    2427 ACC1
+    2428 PUSHACC1
+    2429 ADDINT
+    2430 RETURN 2
+    2432 CLOSUREREC 0, 2406
+    2436 CONSTINT 300
+    2438 PUSHACC1
+    2439 APPLY1
+    2440 PUSHCONST0
+    2441 C_CALL1 gc_major
+    2443 CONSTINT 150
+    2445 PUSHCONSTINT 301
+    2447 MULINT
+    2448 PUSHACC1
+    2449 PUSHCONST0
+    2450 PUSH
+    2451 CLOSURE 0, 2425
+    2454 PUSHGETGLOBALFIELD List, 12
+    2457 APPLY3
+    2458 NEQ
+    2459 BRANCHIFNOT 2466
+    2461 GETGLOBAL Not_found
+    2463 MAKEBLOCK1 0
+    2465 RAISE
+    2466 POP 2
+    2468 ATOM0
+    2469 SETGLOBAL T320-gc-2
+    2471 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t320-gc-3.ml b/testsuite/tests/tool-ocaml/t320-gc-3.ml
new file mode 100644
index 00000000..bf59bf40
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t320-gc-3.ml
@@ -0,0 +1,1597 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f n =
+  if n <= 0 then []
+  else n :: f (n-1)
+in
+let l = f 300 in
+Gc.full_major ();
+if List.fold_left (+) 0 l <> 301 * 150 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 746
+      11 RESTART
+      12 GRAB 1
+      14 ACC0
+      15 BRANCHIFNOT 28
+      17 ACC1
+      18 PUSHACC1
+      19 GETFIELD1
+      20 PUSHOFFSETCLOSURE0
+      21 APPLY2
+      22 PUSHACC1
+      23 GETFIELD0
+      24 MAKEBLOCK2 0
+      26 RETURN 2
+      28 ACC1
+      29 RETURN 2
+      31 RESTART
+      32 GRAB 3
+      34 CONST0
+      35 PUSHACC4
+      36 LEINT
+      37 BRANCHIFNOT 42
+      39 CONST0
+      40 RETURN 4
+      42 ACC3
+      43 PUSHACC3
+      44 PUSHACC3
+      45 PUSHACC3
+      46 C_CALL4 caml_input
+      48 PUSHCONST0
+      49 PUSHACC1
+      50 EQ
+      51 BRANCHIFNOT 58
+      53 GETGLOBAL End_of_file
+      55 MAKEBLOCK1 0
+      57 RAISE
+      58 ACC0
+      59 PUSHACC5
+      60 SUBINT
+      61 PUSHACC1
+      62 PUSHACC5
+      63 ADDINT
+      64 PUSHACC4
+      65 PUSHACC4
+      66 PUSHOFFSETCLOSURE0
+      67 APPTERM 4, 9
+      70 ACC0
+      71 C_CALL1 caml_input_scan_line
+      73 PUSHCONST0
+      74 PUSHACC1
+      75 EQ
+      76 BRANCHIFNOT 83
+      78 GETGLOBAL End_of_file
+      80 MAKEBLOCK1 0
+      82 RAISE
+      83 CONST0
+      84 PUSHACC1
+      85 GTINT
+      86 BRANCHIFNOT 107
+      88 ACC0
+      89 OFFSETINT -1
+      91 C_CALL1 create_string
+      93 PUSHACC1
+      94 OFFSETINT -1
+      96 PUSHCONST0
+      97 PUSHACC2
+      98 PUSHACC5
+      99 C_CALL4 caml_input
+     101 ACC2
+     102 C_CALL1 caml_input_char
+     104 ACC0
+     105 RETURN 3
+     107 ACC0
+     108 NEGINT
+     109 C_CALL1 create_string
+     111 PUSHACC1
+     112 NEGINT
+     113 PUSHCONST0
+     114 PUSHACC2
+     115 PUSHACC5
+     116 C_CALL4 caml_input
+     118 CONST0
+     119 PUSHTRAP 130
+     121 ACC6
+     122 PUSHOFFSETCLOSURE0
+     123 APPLY1
+     124 PUSHACC5
+     125 PUSHENVACC1
+     126 APPLY2
+     127 POPTRAP
+     128 RETURN 3
+     130 PUSHGETGLOBAL End_of_file
+     132 PUSHACC1
+     133 GETFIELD0
+     134 EQ
+     135 BRANCHIFNOT 140
+     137 ACC1
+     138 RETURN 4
+     140 ACC0
+     141 RAISE
+     142 ACC0
+     143 C_CALL1 caml_flush
+     145 RETURN 1
+     147 RESTART
+     148 GRAB 1
+     150 ACC1
+     151 PUSHACC1
+     152 C_CALL2 caml_output_char
+     154 RETURN 2
+     156 RESTART
+     157 GRAB 1
+     159 ACC1
+     160 PUSHACC1
+     161 C_CALL2 caml_output_char
+     163 RETURN 2
+     165 RESTART
+     166 GRAB 1
+     168 ACC1
+     169 PUSHACC1
+     170 C_CALL2 caml_output_int
+     172 RETURN 2
+     174 RESTART
+     175 GRAB 1
+     177 ACC1
+     178 PUSHACC1
+     179 C_CALL2 caml_seek_out
+     181 RETURN 2
+     183 ACC0
+     184 C_CALL1 caml_pos_out
+     186 RETURN 1
+     188 ACC0
+     189 C_CALL1 caml_channel_size
+     191 RETURN 1
+     193 RESTART
+     194 GRAB 1
+     196 ACC1
+     197 PUSHACC1
+     198 C_CALL2 caml_set_binary_mode
+     200 RETURN 2
+     202 ACC0
+     203 C_CALL1 caml_input_char
+     205 RETURN 1
+     207 ACC0
+     208 C_CALL1 caml_input_char
+     210 RETURN 1
+     212 ACC0
+     213 C_CALL1 caml_input_int
+     215 RETURN 1
+     217 ACC0
+     218 C_CALL1 input_value
+     220 RETURN 1
+     222 RESTART
+     223 GRAB 1
+     225 ACC1
+     226 PUSHACC1
+     227 C_CALL2 caml_seek_in
+     229 RETURN 2
+     231 ACC0
+     232 C_CALL1 caml_pos_in
+     234 RETURN 1
+     236 ACC0
+     237 C_CALL1 caml_channel_size
+     239 RETURN 1
+     241 ACC0
+     242 C_CALL1 caml_close_channel
+     244 RETURN 1
+     246 RESTART
+     247 GRAB 1
+     249 ACC1
+     250 PUSHACC1
+     251 C_CALL2 caml_set_binary_mode
+     253 RETURN 2
+     255 CONST0
+     256 PUSHENVACC1
+     257 APPLY1
+     258 ACC0
+     259 C_CALL1 sys_exit
+     261 RETURN 1
+     263 CONST0
+     264 PUSHENVACC1
+     265 GETFIELD0
+     266 APPTERM1 2
+     268 CONST0
+     269 PUSHENVACC1
+     270 APPLY1
+     271 CONST0
+     272 PUSHENVACC2
+     273 APPTERM1 2
+     275 ENVACC1
+     276 GETFIELD0
+     277 PUSHACC0
+     278 PUSHACC2
+     279 CLOSURE 2, 268
+     282 PUSHENVACC1
+     283 SETFIELD0
+     284 RETURN 2
+     286 ENVACC1
+     287 C_CALL1 caml_flush
+     289 ENVACC2
+     290 C_CALL1 caml_flush
+     292 RETURN 1
+     294 CONST0
+     295 PUSHENVACC1
+     296 APPLY1
+     297 C_CALL1 float_of_string
+     299 RETURN 1
+     301 CONST0
+     302 PUSHENVACC1
+     303 APPLY1
+     304 C_CALL1 int_of_string
+     306 RETURN 1
+     308 ENVACC2
+     309 C_CALL1 caml_flush
+     311 ENVACC1
+     312 PUSHENVACC3
+     313 APPTERM1 2
+     315 CONSTINT 13
+     317 PUSHENVACC1
+     318 C_CALL2 caml_output_char
+     320 ENVACC1
+     321 C_CALL1 caml_flush
+     323 RETURN 1
+     325 ACC0
+     326 PUSHENVACC1
+     327 PUSHENVACC2
+     328 APPLY2
+     329 CONSTINT 13
+     331 PUSHENVACC1
+     332 C_CALL2 caml_output_char
+     334 ENVACC1
+     335 C_CALL1 caml_flush
+     337 RETURN 1
+     339 ACC0
+     340 PUSHENVACC1
+     341 APPLY1
+     342 PUSHENVACC2
+     343 PUSHENVACC3
+     344 APPTERM2 3
+     346 ACC0
+     347 PUSHENVACC1
+     348 APPLY1
+     349 PUSHENVACC2
+     350 PUSHENVACC3
+     351 APPTERM2 3
+     353 ACC0
+     354 PUSHENVACC1
+     355 PUSHENVACC2
+     356 APPTERM2 3
+     358 ACC0
+     359 PUSHENVACC1
+     360 C_CALL2 caml_output_char
+     362 RETURN 1
+     364 CONSTINT 13
+     366 PUSHENVACC1
+     367 C_CALL2 caml_output_char
+     369 ENVACC1
+     370 C_CALL1 caml_flush
+     372 RETURN 1
+     374 ACC0
+     375 PUSHENVACC1
+     376 PUSHENVACC2
+     377 APPLY2
+     378 CONSTINT 13
+     380 PUSHENVACC1
+     381 C_CALL2 caml_output_char
+     383 RETURN 1
+     385 ACC0
+     386 PUSHENVACC1
+     387 APPLY1
+     388 PUSHENVACC2
+     389 PUSHENVACC3
+     390 APPTERM2 3
+     392 ACC0
+     393 PUSHENVACC1
+     394 APPLY1
+     395 PUSHENVACC2
+     396 PUSHENVACC3
+     397 APPTERM2 3
+     399 ACC0
+     400 PUSHENVACC1
+     401 PUSHENVACC2
+     402 APPTERM2 3
+     404 ACC0
+     405 PUSHENVACC1
+     406 C_CALL2 caml_output_char
+     408 RETURN 1
+     410 RESTART
+     411 GRAB 3
+     413 CONST0
+     414 PUSHACC3
+     415 LTINT
+     416 BRANCHIF 427
+     418 ACC1
+     419 C_CALL1 ml_string_length
+     421 PUSHACC4
+     422 PUSHACC4
+     423 ADDINT
+     424 GTINT
+     425 BRANCHIFNOT 432
+     427 GETGLOBAL "really_input"
+     429 PUSHENVACC1
+     430 APPTERM1 5
+     432 ACC3
+     433 PUSHACC3
+     434 PUSHACC3
+     435 PUSHACC3
+     436 PUSHENVACC2
+     437 APPTERM 4, 8
+     440 RESTART
+     441 GRAB 3
+     443 CONST0
+     444 PUSHACC3
+     445 LTINT
+     446 BRANCHIF 457
+     448 ACC1
+     449 C_CALL1 ml_string_length
+     451 PUSHACC4
+     452 PUSHACC4
+     453 ADDINT
+     454 GTINT
+     455 BRANCHIFNOT 462
+     457 GETGLOBAL "input"
+     459 PUSHENVACC1
+     460 APPTERM1 5
+     462 ACC3
+     463 PUSHACC3
+     464 PUSHACC3
+     465 PUSHACC3
+     466 C_CALL4 caml_input
+     468 RETURN 4
+     470 ACC0
+     471 PUSHCONST0
+     472 PUSHGETGLOBAL <0>(0, <0>(6, 0))
+     474 PUSHENVACC1
+     475 APPTERM3 4
+     477 ACC0
+     478 PUSHCONST0
+     479 PUSHGETGLOBAL <0>(0, <0>(7, 0))
+     481 PUSHENVACC1
+     482 APPTERM3 4
+     484 RESTART
+     485 GRAB 2
+     487 ACC1
+     488 PUSHACC1
+     489 PUSHACC4
+     490 C_CALL3 sys_open
+     492 C_CALL1 caml_open_descriptor
+     494 RETURN 3
+     496 ACC0
+     497 C_CALL1 caml_flush
+     499 ACC0
+     500 C_CALL1 caml_close_channel
+     502 RETURN 1
+     504 RESTART
+     505 GRAB 1
+     507 CONST0
+     508 PUSHACC2
+     509 PUSHACC2
+     510 C_CALL3 output_value
+     512 RETURN 2
+     514 RESTART
+     515 GRAB 3
+     517 CONST0
+     518 PUSHACC3
+     519 LTINT
+     520 BRANCHIF 531
+     522 ACC1
+     523 C_CALL1 ml_string_length
+     525 PUSHACC4
+     526 PUSHACC4
+     527 ADDINT
+     528 GTINT
+     529 BRANCHIFNOT 536
+     531 GETGLOBAL "output"
+     533 PUSHENVACC1
+     534 APPTERM1 5
+     536 ACC3
+     537 PUSHACC3
+     538 PUSHACC3
+     539 PUSHACC3
+     540 C_CALL4 caml_output
+     542 RETURN 4
+     544 RESTART
+     545 GRAB 1
+     547 ACC1
+     548 C_CALL1 ml_string_length
+     550 PUSHCONST0
+     551 PUSHACC3
+     552 PUSHACC3
+     553 C_CALL4 caml_output
+     555 RETURN 2
+     557 ACC0
+     558 PUSHCONSTINT 438
+     560 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(6, 0))))
+     562 PUSHENVACC1
+     563 APPTERM3 4
+     565 ACC0
+     566 PUSHCONSTINT 438
+     568 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(7, 0))))
+     570 PUSHENVACC1
+     571 APPTERM3 4
+     573 RESTART
+     574 GRAB 2
+     576 ACC1
+     577 PUSHACC1
+     578 PUSHACC4
+     579 C_CALL3 sys_open
+     581 C_CALL1 caml_open_descriptor
+     583 RETURN 3
+     585 ACC0
+     586 PUSHGETGLOBAL "%.12g"
+     588 C_CALL2 format_float
+     590 RETURN 1
+     592 ACC0
+     593 PUSHGETGLOBAL "%d"
+     595 C_CALL2 format_int
+     597 RETURN 1
+     599 GETGLOBAL "false"
+     601 PUSHACC1
+     602 C_CALL2 string_equal
+     604 BRANCHIFNOT 609
+     606 CONST0
+     607 RETURN 1
+     609 GETGLOBAL "true"
+     611 PUSHACC1
+     612 C_CALL2 string_equal
+     614 BRANCHIFNOT 619
+     616 CONST1
+     617 RETURN 1
+     619 GETGLOBAL "bool_of_string"
+     621 PUSHENVACC1
+     622 APPTERM1 2
+     624 ACC0
+     625 BRANCHIFNOT 631
+     627 GETGLOBAL "true"
+     629 RETURN 1
+     631 GETGLOBAL "false"
+     633 RETURN 1
+     635 CONST0
+     636 PUSHACC1
+     637 LTINT
+     638 BRANCHIF 646
+     640 CONSTINT 255
+     642 PUSHACC1
+     643 GTINT
+     644 BRANCHIFNOT 651
+     646 GETGLOBAL "char_of_int"
+     648 PUSHENVACC1
+     649 APPTERM1 2
+     651 ACC0
+     652 RETURN 1
+     654 RESTART
+     655 GRAB 1
+     657 ACC0
+     658 C_CALL1 ml_string_length
+     660 PUSHACC2
+     661 C_CALL1 ml_string_length
+     663 PUSHACC0
+     664 PUSHACC2
+     665 ADDINT
+     666 C_CALL1 create_string
+     668 PUSHACC2
+     669 PUSHCONST0
+     670 PUSHACC2
+     671 PUSHCONST0
+     672 PUSHACC7
+     673 C_CALL5 blit_string
+     675 ACC1
+     676 PUSHACC3
+     677 PUSHACC2
+     678 PUSHCONST0
+     679 PUSHACC 8
+     681 C_CALL5 blit_string
+     683 ACC0
+     684 RETURN 5
+     686 CONSTINT -1
+     688 PUSHACC1
+     689 XORINT
+     690 RETURN 1
+     692 CONST0
+     693 PUSHACC1
+     694 GEINT
+     695 BRANCHIFNOT 700
+     697 ACC0
+     698 RETURN 1
+     700 ACC0
+     701 NEGINT
+     702 RETURN 1
+     704 RESTART
+     705 GRAB 1
+     707 ACC1
+     708 PUSHACC1
+     709 C_CALL2 greaterequal
+     711 BRANCHIFNOT 716
+     713 ACC0
+     714 RETURN 2
+     716 ACC1
+     717 RETURN 2
+     719 RESTART
+     720 GRAB 1
+     722 ACC1
+     723 PUSHACC1
+     724 C_CALL2 lessequal
+     726 BRANCHIFNOT 731
+     728 ACC0
+     729 RETURN 2
+     731 ACC1
+     732 RETURN 2
+     734 ACC0
+     735 PUSHGETGLOBAL Invalid_argument
+     737 MAKEBLOCK2 0
+     739 RAISE
+     740 ACC0
+     741 PUSHGETGLOBAL Failure
+     743 MAKEBLOCK2 0
+     745 RAISE
+     746 CLOSURE 0, 740
+     749 PUSH
+     750 CLOSURE 0, 734
+     753 PUSHGETGLOBAL "Pervasives.Exit"
+     755 MAKEBLOCK1 0
+     757 PUSHGETGLOBAL "Pervasives.Assert_failure"
+     759 MAKEBLOCK1 0
+     761 PUSH
+     762 CLOSURE 0, 720
+     765 PUSH
+     766 CLOSURE 0, 705
+     769 PUSH
+     770 CLOSURE 0, 692
+     773 PUSH
+     774 CLOSURE 0, 686
+     777 PUSHCONST0
+     778 PUSHCONSTINT 31
+     780 PUSHCONST1
+     781 LSLINT
+     782 EQ
+     783 BRANCHIFNOT 789
+     785 CONSTINT 30
+     787 BRANCH 791
+     789 CONSTINT 62
+     791 PUSHCONST1
+     792 LSLINT
+     793 PUSHACC0
+     794 OFFSETINT -1
+     796 PUSH
+     797 CLOSURE 0, 655
+     800 PUSHACC 9
+     802 CLOSURE 1, 635
+     805 PUSH
+     806 CLOSURE 0, 624
+     809 PUSHACC 11
+     811 CLOSURE 1, 599
+     814 PUSH
+     815 CLOSURE 0, 592
+     818 PUSH
+     819 CLOSURE 0, 585
+     822 PUSH
+     823 CLOSUREREC 0, 12
+     827 CONST0
+     828 C_CALL1 caml_open_descriptor
+     830 PUSHCONST1
+     831 C_CALL1 caml_open_descriptor
+     833 PUSHCONST2
+     834 C_CALL1 caml_open_descriptor
+     836 PUSH
+     837 CLOSURE 0, 574
+     840 PUSHACC0
+     841 CLOSURE 1, 565
+     844 PUSHACC1
+     845 CLOSURE 1, 557
+     848 PUSH
+     849 CLOSURE 0, 545
+     852 PUSHACC 22
+     854 CLOSURE 1, 515
+     857 PUSH
+     858 CLOSURE 0, 505
+     861 PUSH
+     862 CLOSURE 0, 496
+     865 PUSH
+     866 CLOSURE 0, 485
+     869 PUSHACC0
+     870 CLOSURE 1, 477
+     873 PUSHACC1
+     874 CLOSURE 1, 470
+     877 PUSHACC 28
+     879 CLOSURE 1, 441
+     882 PUSH
+     883 CLOSUREREC 0, 32
+     887 ACC0
+     888 PUSHACC 31
+     890 CLOSURE 2, 411
+     893 PUSHACC 22
+     895 CLOSUREREC 1, 70
+     899 ACC 15
+     901 CLOSURE 1, 404
+     904 PUSHACC 11
+     906 PUSHACC 17
+     908 CLOSURE 2, 399
+     911 PUSHACC 12
+     913 PUSHACC 18
+     915 PUSHACC 23
+     917 CLOSURE 3, 392
+     920 PUSHACC 13
+     922 PUSHACC 19
+     924 PUSHACC 23
+     926 CLOSURE 3, 385
+     929 PUSHACC 14
+     931 PUSHACC 20
+     933 CLOSURE 2, 374
+     936 PUSHACC 20
+     938 CLOSURE 1, 364
+     941 PUSHACC 20
+     943 CLOSURE 1, 358
+     946 PUSHACC 17
+     948 PUSHACC 22
+     950 CLOSURE 2, 353
+     953 PUSHACC 18
+     955 PUSHACC 23
+     957 PUSHACC 29
+     959 CLOSURE 3, 346
+     962 PUSHACC 19
+     964 PUSHACC 24
+     966 PUSHACC 29
+     968 CLOSURE 3, 339
+     971 PUSHACC 20
+     973 PUSHACC 25
+     975 CLOSURE 2, 325
+     978 PUSHACC 25
+     980 CLOSURE 1, 315
+     983 PUSHACC 12
+     985 PUSHACC 28
+     987 PUSHACC 30
+     989 CLOSURE 3, 308
+     992 PUSHACC0
+     993 CLOSURE 1, 301
+     996 PUSHACC1
+     997 CLOSURE 1, 294
+    1000 PUSHACC 29
+    1002 PUSHACC 31
+    1004 CLOSURE 2, 286
+    1007 MAKEBLOCK1 0
+    1009 PUSHACC0
+    1010 CLOSURE 1, 275
+    1013 PUSHACC1
+    1014 CLOSURE 1, 263
+    1017 PUSHACC0
+    1018 CLOSURE 1, 255
+    1021 PUSHACC1
+    1022 PUSHACC 22
+    1024 PUSHACC4
+    1025 PUSHACC3
+    1026 PUSH
+    1027 CLOSURE 0, 247
+    1030 PUSH
+    1031 CLOSURE 0, 241
+    1034 PUSH
+    1035 CLOSURE 0, 236
+    1038 PUSH
+    1039 CLOSURE 0, 231
+    1042 PUSH
+    1043 CLOSURE 0, 223
+    1046 PUSH
+    1047 CLOSURE 0, 217
+    1050 PUSH
+    1051 CLOSURE 0, 212
+    1054 PUSH
+    1055 CLOSURE 0, 207
+    1058 PUSHACC 32
+    1060 PUSHACC 35
+    1062 PUSHACC 33
+    1064 PUSH
+    1065 CLOSURE 0, 202
+    1068 PUSHACC 41
+    1070 PUSHACC 40
+    1072 PUSHACC 42
+    1074 PUSH
+    1075 CLOSURE 0, 194
+    1078 PUSHACC 46
+    1080 PUSH
+    1081 CLOSURE 0, 188
+    1084 PUSH
+    1085 CLOSURE 0, 183
+    1088 PUSH
+    1089 CLOSURE 0, 175
+    1092 PUSHACC 51
+    1094 PUSH
+    1095 CLOSURE 0, 166
+    1098 PUSH
+    1099 CLOSURE 0, 157
+    1102 PUSHACC 55
+    1104 PUSHACC 57
+    1106 PUSH
+    1107 CLOSURE 0, 148
+    1110 PUSH
+    1111 CLOSURE 0, 142
+    1114 PUSHACC 63
+    1116 PUSHACC 62
+    1118 PUSHACC 64
+    1120 PUSHACC 38
+    1122 PUSHACC 40
+    1124 PUSHACC 42
+    1126 PUSHACC 44
+    1128 PUSHACC 46
+    1130 PUSHACC 48
+    1132 PUSHACC 50
+    1134 PUSHACC 52
+    1136 PUSHACC 54
+    1138 PUSHACC 56
+    1140 PUSHACC 58
+    1142 PUSHACC 60
+    1144 PUSHACC 62
+    1146 PUSHACC 64
+    1148 PUSHACC 66
+    1150 PUSHACC 82
+    1152 PUSHACC 84
+    1154 PUSHACC 86
+    1156 PUSHACC 88
+    1158 PUSHACC 90
+    1160 PUSHACC 92
+    1162 PUSHACC 94
+    1164 PUSHACC 96
+    1166 PUSHACC 98
+    1168 PUSHACC 100
+    1170 PUSHACC 104
+    1172 PUSHACC 104
+    1174 PUSHACC 104
+    1176 PUSHACC 108
+    1178 PUSHACC 110
+    1180 PUSHACC 112
+    1182 PUSHACC 117
+    1184 PUSHACC 117
+    1186 PUSHACC 117
+    1188 PUSHACC 117
+    1190 MAKEBLOCK 69, 0
+    1193 POP 53
+    1195 SETGLOBAL Pervasives
+    1197 BRANCH 2177
+    1199 RESTART
+    1200 GRAB 1
+    1202 ACC1
+    1203 BRANCHIFNOT 1213
+    1205 ACC1
+    1206 GETFIELD1
+    1207 PUSHACC1
+    1208 OFFSETINT 1
+    1210 PUSHOFFSETCLOSURE0
+    1211 APPTERM2 4
+    1213 ACC0
+    1214 RETURN 2
+    1216 RESTART
+    1217 GRAB 1
+    1219 ACC0
+    1220 BRANCHIFNOT 1251
+    1222 CONST0
+    1223 PUSHACC2
+    1224 EQ
+    1225 BRANCHIFNOT 1231
+    1227 ACC0
+    1228 GETFIELD0
+    1229 RETURN 2
+    1231 CONST0
+    1232 PUSHACC2
+    1233 GTINT
+    1234 BRANCHIFNOT 1244
+    1236 ACC1
+    1237 OFFSETINT -1
+    1239 PUSHACC1
+    1240 GETFIELD1
+    1241 PUSHOFFSETCLOSURE0
+    1242 APPTERM2 4
+    1244 GETGLOBAL "List.nth"
+    1246 PUSHGETGLOBALFIELD Pervasives, 2
+    1249 APPTERM1 3
+    1251 GETGLOBAL "nth"
+    1253 PUSHGETGLOBALFIELD Pervasives, 3
+    1256 APPTERM1 3
+    1258 RESTART
+    1259 GRAB 1
+    1261 ACC0
+    1262 BRANCHIFNOT 1274
+    1264 ACC1
+    1265 PUSHACC1
+    1266 GETFIELD0
+    1267 MAKEBLOCK2 0
+    1269 PUSHACC1
+    1270 GETFIELD1
+    1271 PUSHOFFSETCLOSURE0
+    1272 APPTERM2 4
+    1274 ACC1
+    1275 RETURN 2
+    1277 ACC0
+    1278 BRANCHIFNOT 1291
+    1280 ACC0
+    1281 GETFIELD1
+    1282 PUSHOFFSETCLOSURE0
+    1283 APPLY1
+    1284 PUSHACC1
+    1285 GETFIELD0
+    1286 PUSHGETGLOBALFIELD Pervasives, 16
+    1289 APPTERM2 3
+    1291 RETURN 1
+    1293 RESTART
+    1294 GRAB 1
+    1296 ACC1
+    1297 BRANCHIFNOT 1313
+    1299 ACC1
+    1300 GETFIELD0
+    1301 PUSHACC1
+    1302 APPLY1
+    1303 PUSHACC2
+    1304 GETFIELD1
+    1305 PUSHACC2
+    1306 PUSHOFFSETCLOSURE0
+    1307 APPLY2
+    1308 PUSHACC1
+    1309 MAKEBLOCK2 0
+    1311 POP 1
+    1313 RETURN 2
+    1315 RESTART
+    1316 GRAB 1
+    1318 ACC1
+    1319 BRANCHIFNOT 1331
+    1321 ACC1
+    1322 GETFIELD0
+    1323 PUSHACC1
+    1324 APPLY1
+    1325 ACC1
+    1326 GETFIELD1
+    1327 PUSHACC1
+    1328 PUSHOFFSETCLOSURE0
+    1329 APPTERM2 4
+    1331 RETURN 2
+    1333 RESTART
+    1334 GRAB 2
+    1336 ACC2
+    1337 BRANCHIFNOT 1350
+    1339 ACC2
+    1340 GETFIELD1
+    1341 PUSHACC3
+    1342 GETFIELD0
+    1343 PUSHACC3
+    1344 PUSHACC3
+    1345 APPLY2
+    1346 PUSHACC2
+    1347 PUSHOFFSETCLOSURE0
+    1348 APPTERM3 6
+    1350 ACC1
+    1351 RETURN 3
+    1353 RESTART
+    1354 GRAB 2
+    1356 ACC1
+    1357 BRANCHIFNOT 1370
+    1359 ACC2
+    1360 PUSHACC2
+    1361 GETFIELD1
+    1362 PUSHACC2
+    1363 PUSHOFFSETCLOSURE0
+    1364 APPLY3
+    1365 PUSHACC2
+    1366 GETFIELD0
+    1367 PUSHACC2
+    1368 APPTERM2 5
+    1370 ACC2
+    1371 RETURN 3
+    1373 RESTART
+    1374 GRAB 2
+    1376 ACC1
+    1377 BRANCHIFNOT 1400
+    1379 ACC2
+    1380 BRANCHIFNOT 1407
+    1382 ACC2
+    1383 GETFIELD0
+    1384 PUSHACC2
+    1385 GETFIELD0
+    1386 PUSHACC2
+    1387 APPLY2
+    1388 PUSHACC3
+    1389 GETFIELD1
+    1390 PUSHACC3
+    1391 GETFIELD1
+    1392 PUSHACC3
+    1393 PUSHOFFSETCLOSURE0
+    1394 APPLY3
+    1395 PUSHACC1
+    1396 MAKEBLOCK2 0
+    1398 RETURN 4
+    1400 ACC2
+    1401 BRANCHIFNOT 1405
+    1403 BRANCH 1407
+    1405 RETURN 3
+    1407 GETGLOBAL "List.map2"
+    1409 PUSHGETGLOBALFIELD Pervasives, 2
+    1412 APPTERM1 4
+    1414 RESTART
+    1415 GRAB 2
+    1417 ACC1
+    1418 BRANCHIFNOT 1437
+    1420 ACC2
+    1421 BRANCHIFNOT 1444
+    1423 ACC2
+    1424 GETFIELD0
+    1425 PUSHACC2
+    1426 GETFIELD0
+    1427 PUSHACC2
+    1428 APPLY2
+    1429 ACC2
+    1430 GETFIELD1
+    1431 PUSHACC2
+    1432 GETFIELD1
+    1433 PUSHACC2
+    1434 PUSHOFFSETCLOSURE0
+    1435 APPTERM3 6
+    1437 ACC2
+    1438 BRANCHIFNOT 1442
+    1440 BRANCH 1444
+    1442 RETURN 3
+    1444 GETGLOBAL "List.iter2"
+    1446 PUSHGETGLOBALFIELD Pervasives, 2
+    1449 APPTERM1 4
+    1451 RESTART
+    1452 GRAB 3
+    1454 ACC2
+    1455 BRANCHIFNOT 1476
+    1457 ACC3
+    1458 BRANCHIFNOT 1482
+    1460 ACC3
+    1461 GETFIELD1
+    1462 PUSHACC3
+    1463 GETFIELD1
+    1464 PUSHACC5
+    1465 GETFIELD0
+    1466 PUSHACC5
+    1467 GETFIELD0
+    1468 PUSHACC5
+    1469 PUSHACC5
+    1470 APPLY3
+    1471 PUSHACC3
+    1472 PUSHOFFSETCLOSURE0
+    1473 APPTERM 4, 8
+    1476 ACC3
+    1477 BRANCHIF 1482
+    1479 ACC1
+    1480 RETURN 4
+    1482 GETGLOBAL "List.fold_left2"
+    1484 PUSHGETGLOBALFIELD Pervasives, 2
+    1487 APPTERM1 5
+    1489 RESTART
+    1490 GRAB 3
+    1492 ACC1
+    1493 BRANCHIFNOT 1516
+    1495 ACC2
+    1496 BRANCHIFNOT 1522
+    1498 PUSH_RETADDR 1509
+    1500 ACC6
+    1501 PUSHACC6
+    1502 GETFIELD1
+    1503 PUSHACC6
+    1504 GETFIELD1
+    1505 PUSHACC6
+    1506 PUSHOFFSETCLOSURE0
+    1507 APPLY 4
+    1509 PUSHACC3
+    1510 GETFIELD0
+    1511 PUSHACC3
+    1512 GETFIELD0
+    1513 PUSHACC3
+    1514 APPTERM3 7
+    1516 ACC2
+    1517 BRANCHIF 1522
+    1519 ACC3
+    1520 RETURN 4
+    1522 GETGLOBAL "List.fold_right2"
+    1524 PUSHGETGLOBALFIELD Pervasives, 2
+    1527 APPTERM1 5
+    1529 RESTART
+    1530 GRAB 1
+    1532 ACC1
+    1533 BRANCHIFNOT 1549
+    1535 ACC1
+    1536 GETFIELD0
+    1537 PUSHACC1
+    1538 APPLY1
+    1539 BRANCHIFNOT 1547
+    1541 ACC1
+    1542 GETFIELD1
+    1543 PUSHACC1
+    1544 PUSHOFFSETCLOSURE0
+    1545 APPTERM2 4
+    1547 RETURN 2
+    1549 CONST1
+    1550 RETURN 2
+    1552 RESTART
+    1553 GRAB 1
+    1555 ACC1
+    1556 BRANCHIFNOT 1570
+    1558 ACC1
+    1559 GETFIELD0
+    1560 PUSHACC1
+    1561 APPLY1
+    1562 BRANCHIF 1570
+    1564 ACC1
+    1565 GETFIELD1
+    1566 PUSHACC1
+    1567 PUSHOFFSETCLOSURE0
+    1568 APPTERM2 4
+    1570 RETURN 2
+    1572 RESTART
+    1573 GRAB 2
+    1575 ACC1
+    1576 BRANCHIFNOT 1599
+    1578 ACC2
+    1579 BRANCHIFNOT 1605
+    1581 ACC2
+    1582 GETFIELD0
+    1583 PUSHACC2
+    1584 GETFIELD0
+    1585 PUSHACC2
+    1586 APPLY2
+    1587 BRANCHIFNOT 1597
+    1589 ACC2
+    1590 GETFIELD1
+    1591 PUSHACC2
+    1592 GETFIELD1
+    1593 PUSHACC2
+    1594 PUSHOFFSETCLOSURE0
+    1595 APPTERM3 6
+    1597 RETURN 3
+    1599 ACC2
+    1600 BRANCHIF 1605
+    1602 CONST1
+    1603 RETURN 3
+    1605 GETGLOBAL "List.for_all2"
+    1607 PUSHGETGLOBALFIELD Pervasives, 2
+    1610 APPTERM1 4
+    1612 RESTART
+    1613 GRAB 2
+    1615 ACC1
+    1616 BRANCHIFNOT 1639
+    1618 ACC2
+    1619 BRANCHIFNOT 1646
+    1621 ACC2
+    1622 GETFIELD0
+    1623 PUSHACC2
+    1624 GETFIELD0
+    1625 PUSHACC2
+    1626 APPLY2
+    1627 BRANCHIF 1637
+    1629 ACC2
+    1630 GETFIELD1
+    1631 PUSHACC2
+    1632 GETFIELD1
+    1633 PUSHACC2
+    1634 PUSHOFFSETCLOSURE0
+    1635 APPTERM3 6
+    1637 RETURN 3
+    1639 ACC2
+    1640 BRANCHIFNOT 1644
+    1642 BRANCH 1646
+    1644 RETURN 3
+    1646 GETGLOBAL "List.exists2"
+    1648 PUSHGETGLOBALFIELD Pervasives, 2
+    1651 APPTERM1 4
+    1653 RESTART
+    1654 GRAB 1
+    1656 ACC1
+    1657 BRANCHIFNOT 1672
+    1659 ACC0
+    1660 PUSHACC2
+    1661 GETFIELD0
+    1662 C_CALL2 equal
+    1664 BRANCHIF 1672
+    1666 ACC1
+    1667 GETFIELD1
+    1668 PUSHACC1
+    1669 PUSHOFFSETCLOSURE0
+    1670 APPTERM2 4
+    1672 RETURN 2
+    1674 RESTART
+    1675 GRAB 1
+    1677 ACC1
+    1678 BRANCHIFNOT 1692
+    1680 ACC0
+    1681 PUSHACC2
+    1682 GETFIELD0
+    1683 EQ
+    1684 BRANCHIF 1692
+    1686 ACC1
+    1687 GETFIELD1
+    1688 PUSHACC1
+    1689 PUSHOFFSETCLOSURE0
+    1690 APPTERM2 4
+    1692 RETURN 2
+    1694 RESTART
+    1695 GRAB 1
+    1697 ACC1
+    1698 BRANCHIFNOT 1719
+    1700 ACC1
+    1701 GETFIELD0
+    1702 PUSHACC1
+    1703 PUSHACC1
+    1704 GETFIELD0
+    1705 C_CALL2 equal
+    1707 BRANCHIFNOT 1713
+    1709 ACC0
+    1710 GETFIELD1
+    1711 RETURN 3
+    1713 ACC2
+    1714 GETFIELD1
+    1715 PUSHACC2
+    1716 PUSHOFFSETCLOSURE0
+    1717 APPTERM2 5
+    1719 GETGLOBAL Not_found
+    1721 MAKEBLOCK1 0
+    1723 RAISE
+    1724 RESTART
+    1725 GRAB 1
+    1727 ACC1
+    1728 BRANCHIFNOT 1748
+    1730 ACC1
+    1731 GETFIELD0
+    1732 PUSHACC1
+    1733 PUSHACC1
+    1734 GETFIELD0
+    1735 EQ
+    1736 BRANCHIFNOT 1742
+    1738 ACC0
+    1739 GETFIELD1
+    1740 RETURN 3
+    1742 ACC2
+    1743 GETFIELD1
+    1744 PUSHACC2
+    1745 PUSHOFFSETCLOSURE0
+    1746 APPTERM2 5
+    1748 GETGLOBAL Not_found
+    1750 MAKEBLOCK1 0
+    1752 RAISE
+    1753 RESTART
+    1754 GRAB 1
+    1756 ACC1
+    1757 BRANCHIFNOT 1773
+    1759 ACC0
+    1760 PUSHACC2
+    1761 GETFIELD0
+    1762 GETFIELD0
+    1763 C_CALL2 equal
+    1765 BRANCHIF 1773
+    1767 ACC1
+    1768 GETFIELD1
+    1769 PUSHACC1
+    1770 PUSHOFFSETCLOSURE0
+    1771 APPTERM2 4
+    1773 RETURN 2
+    1775 RESTART
+    1776 GRAB 1
+    1778 ACC1
+    1779 BRANCHIFNOT 1794
+    1781 ACC0
+    1782 PUSHACC2
+    1783 GETFIELD0
+    1784 GETFIELD0
+    1785 EQ
+    1786 BRANCHIF 1794
+    1788 ACC1
+    1789 GETFIELD1
+    1790 PUSHACC1
+    1791 PUSHOFFSETCLOSURE0
+    1792 APPTERM2 4
+    1794 RETURN 2
+    1796 RESTART
+    1797 GRAB 1
+    1799 ACC1
+    1800 BRANCHIFNOT 1825
+    1802 ACC1
+    1803 GETFIELD0
+    1804 PUSHACC2
+    1805 GETFIELD1
+    1806 PUSHACC2
+    1807 PUSHACC2
+    1808 GETFIELD0
+    1809 C_CALL2 equal
+    1811 BRANCHIFNOT 1816
+    1813 ACC0
+    1814 RETURN 4
+    1816 ACC0
+    1817 PUSHACC3
+    1818 PUSHOFFSETCLOSURE0
+    1819 APPLY2
+    1820 PUSHACC2
+    1821 MAKEBLOCK2 0
+    1823 POP 2
+    1825 RETURN 2
+    1827 RESTART
+    1828 GRAB 1
+    1830 ACC1
+    1831 BRANCHIFNOT 1855
+    1833 ACC1
+    1834 GETFIELD0
+    1835 PUSHACC2
+    1836 GETFIELD1
+    1837 PUSHACC2
+    1838 PUSHACC2
+    1839 GETFIELD0
+    1840 EQ
+    1841 BRANCHIFNOT 1846
+    1843 ACC0
+    1844 RETURN 4
+    1846 ACC0
+    1847 PUSHACC3
+    1848 PUSHOFFSETCLOSURE0
+    1849 APPLY2
+    1850 PUSHACC2
+    1851 MAKEBLOCK2 0
+    1853 POP 2
+    1855 RETURN 2
+    1857 RESTART
+    1858 GRAB 1
+    1860 ACC1
+    1861 BRANCHIFNOT 1879
+    1863 ACC1
+    1864 GETFIELD0
+    1865 PUSHACC0
+    1866 PUSHACC2
+    1867 APPLY1
+    1868 BRANCHIFNOT 1873
+    1870 ACC0
+    1871 RETURN 3
+    1873 ACC2
+    1874 GETFIELD1
+    1875 PUSHACC2
+    1876 PUSHOFFSETCLOSURE0
+    1877 APPTERM2 5
+    1879 GETGLOBAL Not_found
+    1881 MAKEBLOCK1 0
+    1883 RAISE
+    1884 RESTART
+    1885 GRAB 2
+    1887 ACC2
+    1888 BRANCHIFNOT 1917
+    1890 ACC2
+    1891 GETFIELD0
+    1892 PUSHACC3
+    1893 GETFIELD1
+    1894 PUSHACC1
+    1895 PUSHENVACC2
+    1896 APPLY1
+    1897 BRANCHIFNOT 1908
+    1899 ACC0
+    1900 PUSHACC4
+    1901 PUSHACC4
+    1902 PUSHACC4
+    1903 MAKEBLOCK2 0
+    1905 PUSHOFFSETCLOSURE0
+    1906 APPTERM3 8
+    1908 ACC0
+    1909 PUSHACC4
+    1910 PUSHACC3
+    1911 MAKEBLOCK2 0
+    1913 PUSHACC4
+    1914 PUSHOFFSETCLOSURE0
+    1915 APPTERM3 8
+    1917 ACC1
+    1918 PUSHENVACC1
+    1919 APPLY1
+    1920 PUSHACC1
+    1921 PUSHENVACC1
+    1922 APPLY1
+    1923 MAKEBLOCK2 0
+    1925 RETURN 3
+    1927 RESTART
+    1928 GRAB 1
+    1930 ACC0
+    1931 PUSHENVACC1
+    1932 CLOSUREREC 2, 1885
+    1936 ACC2
+    1937 PUSHCONST0
+    1938 PUSHCONST0
+    1939 PUSHACC3
+    1940 APPTERM3 6
+    1942 ACC0
+    1943 BRANCHIFNOT 1967
+    1945 ACC0
+    1946 GETFIELD0
+    1947 PUSHACC1
+    1948 GETFIELD1
+    1949 PUSHOFFSETCLOSURE0
+    1950 APPLY1
+    1951 PUSHACC0
+    1952 GETFIELD1
+    1953 PUSHACC2
+    1954 GETFIELD1
+    1955 MAKEBLOCK2 0
+    1957 PUSHACC1
+    1958 GETFIELD0
+    1959 PUSHACC3
+    1960 GETFIELD0
+    1961 MAKEBLOCK2 0
+    1963 MAKEBLOCK2 0
+    1965 RETURN 3
+    1967 GETGLOBAL <0>(0, 0)
+    1969 RETURN 1
+    1971 RESTART
+    1972 GRAB 1
+    1974 ACC0
+    1975 BRANCHIFNOT 1996
+    1977 ACC1
+    1978 BRANCHIFNOT 2003
+    1980 ACC1
+    1981 GETFIELD1
+    1982 PUSHACC1
+    1983 GETFIELD1
+    1984 PUSHOFFSETCLOSURE0
+    1985 APPLY2
+    1986 PUSHACC2
+    1987 GETFIELD0
+    1988 PUSHACC2
+    1989 GETFIELD0
+    1990 MAKEBLOCK2 0
+    1992 MAKEBLOCK2 0
+    1994 RETURN 2
+    1996 ACC1
+    1997 BRANCHIFNOT 2001
+    1999 BRANCH 2003
+    2001 RETURN 2
+    2003 GETGLOBAL "List.combine"
+    2005 PUSHGETGLOBALFIELD Pervasives, 2
+    2008 APPTERM1 3
+    2010 RESTART
+    2011 GRAB 1
+    2013 ACC1
+    2014 BRANCHIFNOT 2038
+    2016 ACC1
+    2017 GETFIELD0
+    2018 PUSHACC2
+    2019 GETFIELD1
+    2020 PUSHACC1
+    2021 PUSHENVACC2
+    2022 APPLY1
+    2023 BRANCHIFNOT 2033
+    2025 ACC0
+    2026 PUSHACC3
+    2027 PUSHACC3
+    2028 MAKEBLOCK2 0
+    2030 PUSHOFFSETCLOSURE0
+    2031 APPTERM2 6
+    2033 ACC0
+    2034 PUSHACC3
+    2035 PUSHOFFSETCLOSURE0
+    2036 APPTERM2 6
+    2038 ACC0
+    2039 PUSHENVACC1
+    2040 APPTERM1 3
+    2042 ACC0
+    2043 PUSHENVACC1
+    2044 CLOSUREREC 2, 2011
+    2048 CONST0
+    2049 PUSHACC1
+    2050 APPTERM1 3
+    2052 RESTART
+    2053 GRAB 2
+    2055 ACC1
+    2056 BRANCHIFNOT 2077
+    2058 ACC2
+    2059 BRANCHIFNOT 2084
+    2061 ACC2
+    2062 GETFIELD1
+    2063 PUSHACC2
+    2064 GETFIELD1
+    2065 PUSHACC2
+    2066 PUSHACC5
+    2067 GETFIELD0
+    2068 PUSHACC5
+    2069 GETFIELD0
+    2070 PUSHENVACC1
+    2071 APPLY2
+    2072 MAKEBLOCK2 0
+    2074 PUSHOFFSETCLOSURE0
+    2075 APPTERM3 6
+    2077 ACC2
+    2078 BRANCHIFNOT 2082
+    2080 BRANCH 2084
+    2082 RETURN 3
+    2084 GETGLOBAL "List.rev_map2"
+    2086 PUSHGETGLOBALFIELD Pervasives, 2
+    2089 APPTERM1 4
+    2091 RESTART
+    2092 GRAB 2
+    2094 ACC0
+    2095 CLOSUREREC 1, 2053
+    2099 ACC3
+    2100 PUSHACC3
+    2101 PUSHCONST0
+    2102 PUSHACC3
+    2103 APPTERM3 7
+    2105 RESTART
+    2106 GRAB 1
+    2108 ACC1
+    2109 BRANCHIFNOT 2123
+    2111 ACC1
+    2112 GETFIELD1
+    2113 PUSHACC1
+    2114 PUSHACC3
+    2115 GETFIELD0
+    2116 PUSHENVACC1
+    2117 APPLY1
+    2118 MAKEBLOCK2 0
+    2120 PUSHOFFSETCLOSURE0
+    2121 APPTERM2 4
+    2123 ACC0
+    2124 RETURN 2
+    2126 RESTART
+    2127 GRAB 1
+    2129 ACC0
+    2130 CLOSUREREC 1, 2106
+    2134 ACC2
+    2135 PUSHCONST0
+    2136 PUSHACC2
+    2137 APPTERM2 5
+    2139 CONST0
+    2140 PUSHACC1
+    2141 PUSHENVACC1
+    2142 APPTERM2 3
+    2144 ACC0
+    2145 BRANCHIFNOT 2151
+    2147 ACC0
+    2148 GETFIELD1
+    2149 RETURN 1
+    2151 GETGLOBAL "tl"
+    2153 PUSHGETGLOBALFIELD Pervasives, 3
+    2156 APPTERM1 2
+    2158 ACC0
+    2159 BRANCHIFNOT 2165
+    2161 ACC0
+    2162 GETFIELD0
+    2163 RETURN 1
+    2165 GETGLOBAL "hd"
+    2167 PUSHGETGLOBALFIELD Pervasives, 3
+    2170 APPTERM1 2
+    2172 ACC0
+    2173 PUSHCONST0
+    2174 PUSHENVACC1
+    2175 APPTERM2 3
+    2177 CLOSUREREC 0, 1200
+    2181 ACC0
+    2182 CLOSURE 1, 2172
+    2185 PUSH
+    2186 CLOSURE 0, 2158
+    2189 PUSH
+    2190 CLOSURE 0, 2144
+    2193 PUSH
+    2194 CLOSUREREC 0, 1217
+    2198 GETGLOBALFIELD Pervasives, 16
+    2201 PUSH
+    2202 CLOSUREREC 0, 1259
+    2206 ACC0
+    2207 CLOSURE 1, 2139
+    2210 PUSH
+    2211 CLOSUREREC 0, 1277
+    2215 CLOSUREREC 0, 1294
+    2219 CLOSURE 0, 2127
+    2222 PUSH
+    2223 CLOSUREREC 0, 1316
+    2227 CLOSUREREC 0, 1334
+    2231 CLOSUREREC 0, 1354
+    2235 CLOSUREREC 0, 1374
+    2239 CLOSURE 0, 2092
+    2242 PUSH
+    2243 CLOSUREREC 0, 1415
+    2247 CLOSUREREC 0, 1452
+    2251 CLOSUREREC 0, 1490
+    2255 CLOSUREREC 0, 1530
+    2259 CLOSUREREC 0, 1553
+    2263 CLOSUREREC 0, 1573
+    2267 CLOSUREREC 0, 1613
+    2271 CLOSUREREC 0, 1654
+    2275 CLOSUREREC 0, 1675
+    2279 CLOSUREREC 0, 1695
+    2283 CLOSUREREC 0, 1725
+    2287 CLOSUREREC 0, 1754
+    2291 CLOSUREREC 0, 1776
+    2295 CLOSUREREC 0, 1797
+    2299 CLOSUREREC 0, 1828
+    2303 CLOSUREREC 0, 1858
+    2307 ACC 24
+    2309 CLOSURE 1, 2042
+    2312 PUSHACC 25
+    2314 CLOSUREREC 1, 1928
+    2318 CLOSUREREC 0, 1942
+    2322 CLOSUREREC 0, 1972
+    2326 ACC0
+    2327 PUSHACC2
+    2328 PUSHACC7
+    2329 PUSHACC 9
+    2331 PUSHACC 11
+    2333 PUSHACC 13
+    2335 PUSHACC 15
+    2337 PUSHACC 17
+    2339 PUSHACC 10
+    2341 PUSHACC 12
+    2343 PUSHACC 13
+    2345 PUSHACC 15
+    2347 PUSHACC 23
+    2349 PUSHACC 25
+    2351 PUSHACC 27
+    2353 PUSHACC 29
+    2355 PUSHACC 31
+    2357 PUSHACC 33
+    2359 PUSHACC 35
+    2361 PUSHACC 37
+    2363 PUSHACC 40
+    2365 PUSHACC 42
+    2367 PUSHACC 41
+    2369 PUSHACC 45
+    2371 PUSHACC 47
+    2373 PUSHACC 50
+    2375 PUSHACC 52
+    2377 PUSHACC 51
+    2379 PUSHACC 55
+    2381 PUSHACC 56
+    2383 PUSHACC 59
+    2385 PUSHACC 61
+    2387 PUSHACC 60
+    2389 PUSHACC 64
+    2391 PUSHACC 66
+    2393 PUSHACC 68
+    2395 PUSHACC 70
+    2397 MAKEBLOCK 37, 0
+    2400 POP 36
+    2402 SETGLOBAL List
+    2404 BRANCH 2432
+    2406 CONST0
+    2407 PUSHACC1
+    2408 LEINT
+    2409 BRANCHIFNOT 2414
+    2411 CONST0
+    2412 RETURN 1
+    2414 ACC0
+    2415 OFFSETINT -1
+    2417 PUSHOFFSETCLOSURE0
+    2418 APPLY1
+    2419 PUSHACC1
+    2420 MAKEBLOCK2 0
+    2422 RETURN 1
+    2424 RESTART
+    2425 GRAB 1
+    2427 ACC1
+    2428 PUSHACC1
+    2429 ADDINT
+    2430 RETURN 2
+    2432 CLOSUREREC 0, 2406
+    2436 CONSTINT 300
+    2438 PUSHACC1
+    2439 APPLY1
+    2440 PUSHCONST0
+    2441 C_CALL1 gc_full_major
+    2443 CONSTINT 150
+    2445 PUSHCONSTINT 301
+    2447 MULINT
+    2448 PUSHACC1
+    2449 PUSHCONST0
+    2450 PUSH
+    2451 CLOSURE 0, 2425
+    2454 PUSHGETGLOBALFIELD List, 12
+    2457 APPLY3
+    2458 NEQ
+    2459 BRANCHIFNOT 2466
+    2461 GETGLOBAL Not_found
+    2463 MAKEBLOCK1 0
+    2465 RAISE
+    2466 POP 2
+    2468 ATOM0
+    2469 SETGLOBAL T320-gc-3
+    2471 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t330-compact-1.ml b/testsuite/tests/tool-ocaml/t330-compact-1.ml
new file mode 100644
index 00000000..b19fd3a5
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t330-compact-1.ml
@@ -0,0 +1,23 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+Gc.compact ();;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 CONST0
+      10 C_CALL1 gc_compaction
+      12 ATOM0
+      13 SETGLOBAL T330-compact-1
+      15 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t330-compact-2.ml b/testsuite/tests/tool-ocaml/t330-compact-2.ml
new file mode 100644
index 00000000..3640d8ad
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t330-compact-2.ml
@@ -0,0 +1,763 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+Gc.compact ();;
+let _ = Pervasives.do_at_exit();;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 746
+      11 RESTART
+      12 GRAB 1
+      14 ACC0
+      15 BRANCHIFNOT 28
+      17 ACC1
+      18 PUSHACC1
+      19 GETFIELD1
+      20 PUSHOFFSETCLOSURE0
+      21 APPLY2
+      22 PUSHACC1
+      23 GETFIELD0
+      24 MAKEBLOCK2 0
+      26 RETURN 2
+      28 ACC1
+      29 RETURN 2
+      31 RESTART
+      32 GRAB 3
+      34 CONST0
+      35 PUSHACC4
+      36 LEINT
+      37 BRANCHIFNOT 42
+      39 CONST0
+      40 RETURN 4
+      42 ACC3
+      43 PUSHACC3
+      44 PUSHACC3
+      45 PUSHACC3
+      46 C_CALL4 caml_input
+      48 PUSHCONST0
+      49 PUSHACC1
+      50 EQ
+      51 BRANCHIFNOT 58
+      53 GETGLOBAL End_of_file
+      55 MAKEBLOCK1 0
+      57 RAISE
+      58 ACC0
+      59 PUSHACC5
+      60 SUBINT
+      61 PUSHACC1
+      62 PUSHACC5
+      63 ADDINT
+      64 PUSHACC4
+      65 PUSHACC4
+      66 PUSHOFFSETCLOSURE0
+      67 APPTERM 4, 9
+      70 ACC0
+      71 C_CALL1 caml_input_scan_line
+      73 PUSHCONST0
+      74 PUSHACC1
+      75 EQ
+      76 BRANCHIFNOT 83
+      78 GETGLOBAL End_of_file
+      80 MAKEBLOCK1 0
+      82 RAISE
+      83 CONST0
+      84 PUSHACC1
+      85 GTINT
+      86 BRANCHIFNOT 107
+      88 ACC0
+      89 OFFSETINT -1
+      91 C_CALL1 create_string
+      93 PUSHACC1
+      94 OFFSETINT -1
+      96 PUSHCONST0
+      97 PUSHACC2
+      98 PUSHACC5
+      99 C_CALL4 caml_input
+     101 ACC2
+     102 C_CALL1 caml_input_char
+     104 ACC0
+     105 RETURN 3
+     107 ACC0
+     108 NEGINT
+     109 C_CALL1 create_string
+     111 PUSHACC1
+     112 NEGINT
+     113 PUSHCONST0
+     114 PUSHACC2
+     115 PUSHACC5
+     116 C_CALL4 caml_input
+     118 CONST0
+     119 PUSHTRAP 130
+     121 ACC6
+     122 PUSHOFFSETCLOSURE0
+     123 APPLY1
+     124 PUSHACC5
+     125 PUSHENVACC1
+     126 APPLY2
+     127 POPTRAP
+     128 RETURN 3
+     130 PUSHGETGLOBAL End_of_file
+     132 PUSHACC1
+     133 GETFIELD0
+     134 EQ
+     135 BRANCHIFNOT 140
+     137 ACC1
+     138 RETURN 4
+     140 ACC0
+     141 RAISE
+     142 ACC0
+     143 C_CALL1 caml_flush
+     145 RETURN 1
+     147 RESTART
+     148 GRAB 1
+     150 ACC1
+     151 PUSHACC1
+     152 C_CALL2 caml_output_char
+     154 RETURN 2
+     156 RESTART
+     157 GRAB 1
+     159 ACC1
+     160 PUSHACC1
+     161 C_CALL2 caml_output_char
+     163 RETURN 2
+     165 RESTART
+     166 GRAB 1
+     168 ACC1
+     169 PUSHACC1
+     170 C_CALL2 caml_output_int
+     172 RETURN 2
+     174 RESTART
+     175 GRAB 1
+     177 ACC1
+     178 PUSHACC1
+     179 C_CALL2 caml_seek_out
+     181 RETURN 2
+     183 ACC0
+     184 C_CALL1 caml_pos_out
+     186 RETURN 1
+     188 ACC0
+     189 C_CALL1 caml_channel_size
+     191 RETURN 1
+     193 RESTART
+     194 GRAB 1
+     196 ACC1
+     197 PUSHACC1
+     198 C_CALL2 caml_set_binary_mode
+     200 RETURN 2
+     202 ACC0
+     203 C_CALL1 caml_input_char
+     205 RETURN 1
+     207 ACC0
+     208 C_CALL1 caml_input_char
+     210 RETURN 1
+     212 ACC0
+     213 C_CALL1 caml_input_int
+     215 RETURN 1
+     217 ACC0
+     218 C_CALL1 input_value
+     220 RETURN 1
+     222 RESTART
+     223 GRAB 1
+     225 ACC1
+     226 PUSHACC1
+     227 C_CALL2 caml_seek_in
+     229 RETURN 2
+     231 ACC0
+     232 C_CALL1 caml_pos_in
+     234 RETURN 1
+     236 ACC0
+     237 C_CALL1 caml_channel_size
+     239 RETURN 1
+     241 ACC0
+     242 C_CALL1 caml_close_channel
+     244 RETURN 1
+     246 RESTART
+     247 GRAB 1
+     249 ACC1
+     250 PUSHACC1
+     251 C_CALL2 caml_set_binary_mode
+     253 RETURN 2
+     255 CONST0
+     256 PUSHENVACC1
+     257 APPLY1
+     258 ACC0
+     259 C_CALL1 sys_exit
+     261 RETURN 1
+     263 CONST0
+     264 PUSHENVACC1
+     265 GETFIELD0
+     266 APPTERM1 2
+     268 CONST0
+     269 PUSHENVACC1
+     270 APPLY1
+     271 CONST0
+     272 PUSHENVACC2
+     273 APPTERM1 2
+     275 ENVACC1
+     276 GETFIELD0
+     277 PUSHACC0
+     278 PUSHACC2
+     279 CLOSURE 2, 268
+     282 PUSHENVACC1
+     283 SETFIELD0
+     284 RETURN 2
+     286 ENVACC1
+     287 C_CALL1 caml_flush
+     289 ENVACC2
+     290 C_CALL1 caml_flush
+     292 RETURN 1
+     294 CONST0
+     295 PUSHENVACC1
+     296 APPLY1
+     297 C_CALL1 float_of_string
+     299 RETURN 1
+     301 CONST0
+     302 PUSHENVACC1
+     303 APPLY1
+     304 C_CALL1 int_of_string
+     306 RETURN 1
+     308 ENVACC2
+     309 C_CALL1 caml_flush
+     311 ENVACC1
+     312 PUSHENVACC3
+     313 APPTERM1 2
+     315 CONSTINT 13
+     317 PUSHENVACC1
+     318 C_CALL2 caml_output_char
+     320 ENVACC1
+     321 C_CALL1 caml_flush
+     323 RETURN 1
+     325 ACC0
+     326 PUSHENVACC1
+     327 PUSHENVACC2
+     328 APPLY2
+     329 CONSTINT 13
+     331 PUSHENVACC1
+     332 C_CALL2 caml_output_char
+     334 ENVACC1
+     335 C_CALL1 caml_flush
+     337 RETURN 1
+     339 ACC0
+     340 PUSHENVACC1
+     341 APPLY1
+     342 PUSHENVACC2
+     343 PUSHENVACC3
+     344 APPTERM2 3
+     346 ACC0
+     347 PUSHENVACC1
+     348 APPLY1
+     349 PUSHENVACC2
+     350 PUSHENVACC3
+     351 APPTERM2 3
+     353 ACC0
+     354 PUSHENVACC1
+     355 PUSHENVACC2
+     356 APPTERM2 3
+     358 ACC0
+     359 PUSHENVACC1
+     360 C_CALL2 caml_output_char
+     362 RETURN 1
+     364 CONSTINT 13
+     366 PUSHENVACC1
+     367 C_CALL2 caml_output_char
+     369 ENVACC1
+     370 C_CALL1 caml_flush
+     372 RETURN 1
+     374 ACC0
+     375 PUSHENVACC1
+     376 PUSHENVACC2
+     377 APPLY2
+     378 CONSTINT 13
+     380 PUSHENVACC1
+     381 C_CALL2 caml_output_char
+     383 RETURN 1
+     385 ACC0
+     386 PUSHENVACC1
+     387 APPLY1
+     388 PUSHENVACC2
+     389 PUSHENVACC3
+     390 APPTERM2 3
+     392 ACC0
+     393 PUSHENVACC1
+     394 APPLY1
+     395 PUSHENVACC2
+     396 PUSHENVACC3
+     397 APPTERM2 3
+     399 ACC0
+     400 PUSHENVACC1
+     401 PUSHENVACC2
+     402 APPTERM2 3
+     404 ACC0
+     405 PUSHENVACC1
+     406 C_CALL2 caml_output_char
+     408 RETURN 1
+     410 RESTART
+     411 GRAB 3
+     413 CONST0
+     414 PUSHACC3
+     415 LTINT
+     416 BRANCHIF 427
+     418 ACC1
+     419 C_CALL1 ml_string_length
+     421 PUSHACC4
+     422 PUSHACC4
+     423 ADDINT
+     424 GTINT
+     425 BRANCHIFNOT 432
+     427 GETGLOBAL "really_input"
+     429 PUSHENVACC1
+     430 APPTERM1 5
+     432 ACC3
+     433 PUSHACC3
+     434 PUSHACC3
+     435 PUSHACC3
+     436 PUSHENVACC2
+     437 APPTERM 4, 8
+     440 RESTART
+     441 GRAB 3
+     443 CONST0
+     444 PUSHACC3
+     445 LTINT
+     446 BRANCHIF 457
+     448 ACC1
+     449 C_CALL1 ml_string_length
+     451 PUSHACC4
+     452 PUSHACC4
+     453 ADDINT
+     454 GTINT
+     455 BRANCHIFNOT 462
+     457 GETGLOBAL "input"
+     459 PUSHENVACC1
+     460 APPTERM1 5
+     462 ACC3
+     463 PUSHACC3
+     464 PUSHACC3
+     465 PUSHACC3
+     466 C_CALL4 caml_input
+     468 RETURN 4
+     470 ACC0
+     471 PUSHCONST0
+     472 PUSHGETGLOBAL <0>(0, <0>(6, 0))
+     474 PUSHENVACC1
+     475 APPTERM3 4
+     477 ACC0
+     478 PUSHCONST0
+     479 PUSHGETGLOBAL <0>(0, <0>(7, 0))
+     481 PUSHENVACC1
+     482 APPTERM3 4
+     484 RESTART
+     485 GRAB 2
+     487 ACC1
+     488 PUSHACC1
+     489 PUSHACC4
+     490 C_CALL3 sys_open
+     492 C_CALL1 caml_open_descriptor
+     494 RETURN 3
+     496 ACC0
+     497 C_CALL1 caml_flush
+     499 ACC0
+     500 C_CALL1 caml_close_channel
+     502 RETURN 1
+     504 RESTART
+     505 GRAB 1
+     507 CONST0
+     508 PUSHACC2
+     509 PUSHACC2
+     510 C_CALL3 output_value
+     512 RETURN 2
+     514 RESTART
+     515 GRAB 3
+     517 CONST0
+     518 PUSHACC3
+     519 LTINT
+     520 BRANCHIF 531
+     522 ACC1
+     523 C_CALL1 ml_string_length
+     525 PUSHACC4
+     526 PUSHACC4
+     527 ADDINT
+     528 GTINT
+     529 BRANCHIFNOT 536
+     531 GETGLOBAL "output"
+     533 PUSHENVACC1
+     534 APPTERM1 5
+     536 ACC3
+     537 PUSHACC3
+     538 PUSHACC3
+     539 PUSHACC3
+     540 C_CALL4 caml_output
+     542 RETURN 4
+     544 RESTART
+     545 GRAB 1
+     547 ACC1
+     548 C_CALL1 ml_string_length
+     550 PUSHCONST0
+     551 PUSHACC3
+     552 PUSHACC3
+     553 C_CALL4 caml_output
+     555 RETURN 2
+     557 ACC0
+     558 PUSHCONSTINT 438
+     560 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(6, 0))))
+     562 PUSHENVACC1
+     563 APPTERM3 4
+     565 ACC0
+     566 PUSHCONSTINT 438
+     568 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(7, 0))))
+     570 PUSHENVACC1
+     571 APPTERM3 4
+     573 RESTART
+     574 GRAB 2
+     576 ACC1
+     577 PUSHACC1
+     578 PUSHACC4
+     579 C_CALL3 sys_open
+     581 C_CALL1 caml_open_descriptor
+     583 RETURN 3
+     585 ACC0
+     586 PUSHGETGLOBAL "%.12g"
+     588 C_CALL2 format_float
+     590 RETURN 1
+     592 ACC0
+     593 PUSHGETGLOBAL "%d"
+     595 C_CALL2 format_int
+     597 RETURN 1
+     599 GETGLOBAL "false"
+     601 PUSHACC1
+     602 C_CALL2 string_equal
+     604 BRANCHIFNOT 609
+     606 CONST0
+     607 RETURN 1
+     609 GETGLOBAL "true"
+     611 PUSHACC1
+     612 C_CALL2 string_equal
+     614 BRANCHIFNOT 619
+     616 CONST1
+     617 RETURN 1
+     619 GETGLOBAL "bool_of_string"
+     621 PUSHENVACC1
+     622 APPTERM1 2
+     624 ACC0
+     625 BRANCHIFNOT 631
+     627 GETGLOBAL "true"
+     629 RETURN 1
+     631 GETGLOBAL "false"
+     633 RETURN 1
+     635 CONST0
+     636 PUSHACC1
+     637 LTINT
+     638 BRANCHIF 646
+     640 CONSTINT 255
+     642 PUSHACC1
+     643 GTINT
+     644 BRANCHIFNOT 651
+     646 GETGLOBAL "char_of_int"
+     648 PUSHENVACC1
+     649 APPTERM1 2
+     651 ACC0
+     652 RETURN 1
+     654 RESTART
+     655 GRAB 1
+     657 ACC0
+     658 C_CALL1 ml_string_length
+     660 PUSHACC2
+     661 C_CALL1 ml_string_length
+     663 PUSHACC0
+     664 PUSHACC2
+     665 ADDINT
+     666 C_CALL1 create_string
+     668 PUSHACC2
+     669 PUSHCONST0
+     670 PUSHACC2
+     671 PUSHCONST0
+     672 PUSHACC7
+     673 C_CALL5 blit_string
+     675 ACC1
+     676 PUSHACC3
+     677 PUSHACC2
+     678 PUSHCONST0
+     679 PUSHACC 8
+     681 C_CALL5 blit_string
+     683 ACC0
+     684 RETURN 5
+     686 CONSTINT -1
+     688 PUSHACC1
+     689 XORINT
+     690 RETURN 1
+     692 CONST0
+     693 PUSHACC1
+     694 GEINT
+     695 BRANCHIFNOT 700
+     697 ACC0
+     698 RETURN 1
+     700 ACC0
+     701 NEGINT
+     702 RETURN 1
+     704 RESTART
+     705 GRAB 1
+     707 ACC1
+     708 PUSHACC1
+     709 C_CALL2 greaterequal
+     711 BRANCHIFNOT 716
+     713 ACC0
+     714 RETURN 2
+     716 ACC1
+     717 RETURN 2
+     719 RESTART
+     720 GRAB 1
+     722 ACC1
+     723 PUSHACC1
+     724 C_CALL2 lessequal
+     726 BRANCHIFNOT 731
+     728 ACC0
+     729 RETURN 2
+     731 ACC1
+     732 RETURN 2
+     734 ACC0
+     735 PUSHGETGLOBAL Invalid_argument
+     737 MAKEBLOCK2 0
+     739 RAISE
+     740 ACC0
+     741 PUSHGETGLOBAL Failure
+     743 MAKEBLOCK2 0
+     745 RAISE
+     746 CLOSURE 0, 740
+     749 PUSH
+     750 CLOSURE 0, 734
+     753 PUSHGETGLOBAL "Pervasives.Exit"
+     755 MAKEBLOCK1 0
+     757 PUSHGETGLOBAL "Pervasives.Assert_failure"
+     759 MAKEBLOCK1 0
+     761 PUSH
+     762 CLOSURE 0, 720
+     765 PUSH
+     766 CLOSURE 0, 705
+     769 PUSH
+     770 CLOSURE 0, 692
+     773 PUSH
+     774 CLOSURE 0, 686
+     777 PUSHCONST0
+     778 PUSHCONSTINT 31
+     780 PUSHCONST1
+     781 LSLINT
+     782 EQ
+     783 BRANCHIFNOT 789
+     785 CONSTINT 30
+     787 BRANCH 791
+     789 CONSTINT 62
+     791 PUSHCONST1
+     792 LSLINT
+     793 PUSHACC0
+     794 OFFSETINT -1
+     796 PUSH
+     797 CLOSURE 0, 655
+     800 PUSHACC 9
+     802 CLOSURE 1, 635
+     805 PUSH
+     806 CLOSURE 0, 624
+     809 PUSHACC 11
+     811 CLOSURE 1, 599
+     814 PUSH
+     815 CLOSURE 0, 592
+     818 PUSH
+     819 CLOSURE 0, 585
+     822 PUSH
+     823 CLOSUREREC 0, 12
+     827 CONST0
+     828 C_CALL1 caml_open_descriptor
+     830 PUSHCONST1
+     831 C_CALL1 caml_open_descriptor
+     833 PUSHCONST2
+     834 C_CALL1 caml_open_descriptor
+     836 PUSH
+     837 CLOSURE 0, 574
+     840 PUSHACC0
+     841 CLOSURE 1, 565
+     844 PUSHACC1
+     845 CLOSURE 1, 557
+     848 PUSH
+     849 CLOSURE 0, 545
+     852 PUSHACC 22
+     854 CLOSURE 1, 515
+     857 PUSH
+     858 CLOSURE 0, 505
+     861 PUSH
+     862 CLOSURE 0, 496
+     865 PUSH
+     866 CLOSURE 0, 485
+     869 PUSHACC0
+     870 CLOSURE 1, 477
+     873 PUSHACC1
+     874 CLOSURE 1, 470
+     877 PUSHACC 28
+     879 CLOSURE 1, 441
+     882 PUSH
+     883 CLOSUREREC 0, 32
+     887 ACC0
+     888 PUSHACC 31
+     890 CLOSURE 2, 411
+     893 PUSHACC 22
+     895 CLOSUREREC 1, 70
+     899 ACC 15
+     901 CLOSURE 1, 404
+     904 PUSHACC 11
+     906 PUSHACC 17
+     908 CLOSURE 2, 399
+     911 PUSHACC 12
+     913 PUSHACC 18
+     915 PUSHACC 23
+     917 CLOSURE 3, 392
+     920 PUSHACC 13
+     922 PUSHACC 19
+     924 PUSHACC 23
+     926 CLOSURE 3, 385
+     929 PUSHACC 14
+     931 PUSHACC 20
+     933 CLOSURE 2, 374
+     936 PUSHACC 20
+     938 CLOSURE 1, 364
+     941 PUSHACC 20
+     943 CLOSURE 1, 358
+     946 PUSHACC 17
+     948 PUSHACC 22
+     950 CLOSURE 2, 353
+     953 PUSHACC 18
+     955 PUSHACC 23
+     957 PUSHACC 29
+     959 CLOSURE 3, 346
+     962 PUSHACC 19
+     964 PUSHACC 24
+     966 PUSHACC 29
+     968 CLOSURE 3, 339
+     971 PUSHACC 20
+     973 PUSHACC 25
+     975 CLOSURE 2, 325
+     978 PUSHACC 25
+     980 CLOSURE 1, 315
+     983 PUSHACC 12
+     985 PUSHACC 28
+     987 PUSHACC 30
+     989 CLOSURE 3, 308
+     992 PUSHACC0
+     993 CLOSURE 1, 301
+     996 PUSHACC1
+     997 CLOSURE 1, 294
+    1000 PUSHACC 29
+    1002 PUSHACC 31
+    1004 CLOSURE 2, 286
+    1007 MAKEBLOCK1 0
+    1009 PUSHACC0
+    1010 CLOSURE 1, 275
+    1013 PUSHACC1
+    1014 CLOSURE 1, 263
+    1017 PUSHACC0
+    1018 CLOSURE 1, 255
+    1021 PUSHACC1
+    1022 PUSHACC 22
+    1024 PUSHACC4
+    1025 PUSHACC3
+    1026 PUSH
+    1027 CLOSURE 0, 247
+    1030 PUSH
+    1031 CLOSURE 0, 241
+    1034 PUSH
+    1035 CLOSURE 0, 236
+    1038 PUSH
+    1039 CLOSURE 0, 231
+    1042 PUSH
+    1043 CLOSURE 0, 223
+    1046 PUSH
+    1047 CLOSURE 0, 217
+    1050 PUSH
+    1051 CLOSURE 0, 212
+    1054 PUSH
+    1055 CLOSURE 0, 207
+    1058 PUSHACC 32
+    1060 PUSHACC 35
+    1062 PUSHACC 33
+    1064 PUSH
+    1065 CLOSURE 0, 202
+    1068 PUSHACC 41
+    1070 PUSHACC 40
+    1072 PUSHACC 42
+    1074 PUSH
+    1075 CLOSURE 0, 194
+    1078 PUSHACC 46
+    1080 PUSH
+    1081 CLOSURE 0, 188
+    1084 PUSH
+    1085 CLOSURE 0, 183
+    1088 PUSH
+    1089 CLOSURE 0, 175
+    1092 PUSHACC 51
+    1094 PUSH
+    1095 CLOSURE 0, 166
+    1098 PUSH
+    1099 CLOSURE 0, 157
+    1102 PUSHACC 55
+    1104 PUSHACC 57
+    1106 PUSH
+    1107 CLOSURE 0, 148
+    1110 PUSH
+    1111 CLOSURE 0, 142
+    1114 PUSHACC 63
+    1116 PUSHACC 62
+    1118 PUSHACC 64
+    1120 PUSHACC 38
+    1122 PUSHACC 40
+    1124 PUSHACC 42
+    1126 PUSHACC 44
+    1128 PUSHACC 46
+    1130 PUSHACC 48
+    1132 PUSHACC 50
+    1134 PUSHACC 52
+    1136 PUSHACC 54
+    1138 PUSHACC 56
+    1140 PUSHACC 58
+    1142 PUSHACC 60
+    1144 PUSHACC 62
+    1146 PUSHACC 64
+    1148 PUSHACC 66
+    1150 PUSHACC 82
+    1152 PUSHACC 84
+    1154 PUSHACC 86
+    1156 PUSHACC 88
+    1158 PUSHACC 90
+    1160 PUSHACC 92
+    1162 PUSHACC 94
+    1164 PUSHACC 96
+    1166 PUSHACC 98
+    1168 PUSHACC 100
+    1170 PUSHACC 104
+    1172 PUSHACC 104
+    1174 PUSHACC 104
+    1176 PUSHACC 108
+    1178 PUSHACC 110
+    1180 PUSHACC 112
+    1182 PUSHACC 117
+    1184 PUSHACC 117
+    1186 PUSHACC 117
+    1188 PUSHACC 117
+    1190 MAKEBLOCK 69, 0
+    1193 POP 53
+    1195 SETGLOBAL Pervasives
+    1197 CONST0
+    1198 C_CALL1 gc_compaction
+    1200 CONST0
+    1201 PUSHGETGLOBALFIELD Pervasives, 68
+    1204 APPLY1
+    1205 ATOM0
+    1206 SETGLOBAL T330-compact-2
+    1208 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t330-compact-3.ml b/testsuite/tests/tool-ocaml/t330-compact-3.ml
new file mode 100644
index 00000000..17cf1fdc
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t330-compact-3.ml
@@ -0,0 +1,1597 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f n =
+  if n <= 0 then []
+  else n :: f (n-1)
+in
+let l = f 300 in
+Gc.compact ();
+if List.fold_left (+) 0 l <> 301 * 150 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 746
+      11 RESTART
+      12 GRAB 1
+      14 ACC0
+      15 BRANCHIFNOT 28
+      17 ACC1
+      18 PUSHACC1
+      19 GETFIELD1
+      20 PUSHOFFSETCLOSURE0
+      21 APPLY2
+      22 PUSHACC1
+      23 GETFIELD0
+      24 MAKEBLOCK2 0
+      26 RETURN 2
+      28 ACC1
+      29 RETURN 2
+      31 RESTART
+      32 GRAB 3
+      34 CONST0
+      35 PUSHACC4
+      36 LEINT
+      37 BRANCHIFNOT 42
+      39 CONST0
+      40 RETURN 4
+      42 ACC3
+      43 PUSHACC3
+      44 PUSHACC3
+      45 PUSHACC3
+      46 C_CALL4 caml_input
+      48 PUSHCONST0
+      49 PUSHACC1
+      50 EQ
+      51 BRANCHIFNOT 58
+      53 GETGLOBAL End_of_file
+      55 MAKEBLOCK1 0
+      57 RAISE
+      58 ACC0
+      59 PUSHACC5
+      60 SUBINT
+      61 PUSHACC1
+      62 PUSHACC5
+      63 ADDINT
+      64 PUSHACC4
+      65 PUSHACC4
+      66 PUSHOFFSETCLOSURE0
+      67 APPTERM 4, 9
+      70 ACC0
+      71 C_CALL1 caml_input_scan_line
+      73 PUSHCONST0
+      74 PUSHACC1
+      75 EQ
+      76 BRANCHIFNOT 83
+      78 GETGLOBAL End_of_file
+      80 MAKEBLOCK1 0
+      82 RAISE
+      83 CONST0
+      84 PUSHACC1
+      85 GTINT
+      86 BRANCHIFNOT 107
+      88 ACC0
+      89 OFFSETINT -1
+      91 C_CALL1 create_string
+      93 PUSHACC1
+      94 OFFSETINT -1
+      96 PUSHCONST0
+      97 PUSHACC2
+      98 PUSHACC5
+      99 C_CALL4 caml_input
+     101 ACC2
+     102 C_CALL1 caml_input_char
+     104 ACC0
+     105 RETURN 3
+     107 ACC0
+     108 NEGINT
+     109 C_CALL1 create_string
+     111 PUSHACC1
+     112 NEGINT
+     113 PUSHCONST0
+     114 PUSHACC2
+     115 PUSHACC5
+     116 C_CALL4 caml_input
+     118 CONST0
+     119 PUSHTRAP 130
+     121 ACC6
+     122 PUSHOFFSETCLOSURE0
+     123 APPLY1
+     124 PUSHACC5
+     125 PUSHENVACC1
+     126 APPLY2
+     127 POPTRAP
+     128 RETURN 3
+     130 PUSHGETGLOBAL End_of_file
+     132 PUSHACC1
+     133 GETFIELD0
+     134 EQ
+     135 BRANCHIFNOT 140
+     137 ACC1
+     138 RETURN 4
+     140 ACC0
+     141 RAISE
+     142 ACC0
+     143 C_CALL1 caml_flush
+     145 RETURN 1
+     147 RESTART
+     148 GRAB 1
+     150 ACC1
+     151 PUSHACC1
+     152 C_CALL2 caml_output_char
+     154 RETURN 2
+     156 RESTART
+     157 GRAB 1
+     159 ACC1
+     160 PUSHACC1
+     161 C_CALL2 caml_output_char
+     163 RETURN 2
+     165 RESTART
+     166 GRAB 1
+     168 ACC1
+     169 PUSHACC1
+     170 C_CALL2 caml_output_int
+     172 RETURN 2
+     174 RESTART
+     175 GRAB 1
+     177 ACC1
+     178 PUSHACC1
+     179 C_CALL2 caml_seek_out
+     181 RETURN 2
+     183 ACC0
+     184 C_CALL1 caml_pos_out
+     186 RETURN 1
+     188 ACC0
+     189 C_CALL1 caml_channel_size
+     191 RETURN 1
+     193 RESTART
+     194 GRAB 1
+     196 ACC1
+     197 PUSHACC1
+     198 C_CALL2 caml_set_binary_mode
+     200 RETURN 2
+     202 ACC0
+     203 C_CALL1 caml_input_char
+     205 RETURN 1
+     207 ACC0
+     208 C_CALL1 caml_input_char
+     210 RETURN 1
+     212 ACC0
+     213 C_CALL1 caml_input_int
+     215 RETURN 1
+     217 ACC0
+     218 C_CALL1 input_value
+     220 RETURN 1
+     222 RESTART
+     223 GRAB 1
+     225 ACC1
+     226 PUSHACC1
+     227 C_CALL2 caml_seek_in
+     229 RETURN 2
+     231 ACC0
+     232 C_CALL1 caml_pos_in
+     234 RETURN 1
+     236 ACC0
+     237 C_CALL1 caml_channel_size
+     239 RETURN 1
+     241 ACC0
+     242 C_CALL1 caml_close_channel
+     244 RETURN 1
+     246 RESTART
+     247 GRAB 1
+     249 ACC1
+     250 PUSHACC1
+     251 C_CALL2 caml_set_binary_mode
+     253 RETURN 2
+     255 CONST0
+     256 PUSHENVACC1
+     257 APPLY1
+     258 ACC0
+     259 C_CALL1 sys_exit
+     261 RETURN 1
+     263 CONST0
+     264 PUSHENVACC1
+     265 GETFIELD0
+     266 APPTERM1 2
+     268 CONST0
+     269 PUSHENVACC1
+     270 APPLY1
+     271 CONST0
+     272 PUSHENVACC2
+     273 APPTERM1 2
+     275 ENVACC1
+     276 GETFIELD0
+     277 PUSHACC0
+     278 PUSHACC2
+     279 CLOSURE 2, 268
+     282 PUSHENVACC1
+     283 SETFIELD0
+     284 RETURN 2
+     286 ENVACC1
+     287 C_CALL1 caml_flush
+     289 ENVACC2
+     290 C_CALL1 caml_flush
+     292 RETURN 1
+     294 CONST0
+     295 PUSHENVACC1
+     296 APPLY1
+     297 C_CALL1 float_of_string
+     299 RETURN 1
+     301 CONST0
+     302 PUSHENVACC1
+     303 APPLY1
+     304 C_CALL1 int_of_string
+     306 RETURN 1
+     308 ENVACC2
+     309 C_CALL1 caml_flush
+     311 ENVACC1
+     312 PUSHENVACC3
+     313 APPTERM1 2
+     315 CONSTINT 13
+     317 PUSHENVACC1
+     318 C_CALL2 caml_output_char
+     320 ENVACC1
+     321 C_CALL1 caml_flush
+     323 RETURN 1
+     325 ACC0
+     326 PUSHENVACC1
+     327 PUSHENVACC2
+     328 APPLY2
+     329 CONSTINT 13
+     331 PUSHENVACC1
+     332 C_CALL2 caml_output_char
+     334 ENVACC1
+     335 C_CALL1 caml_flush
+     337 RETURN 1
+     339 ACC0
+     340 PUSHENVACC1
+     341 APPLY1
+     342 PUSHENVACC2
+     343 PUSHENVACC3
+     344 APPTERM2 3
+     346 ACC0
+     347 PUSHENVACC1
+     348 APPLY1
+     349 PUSHENVACC2
+     350 PUSHENVACC3
+     351 APPTERM2 3
+     353 ACC0
+     354 PUSHENVACC1
+     355 PUSHENVACC2
+     356 APPTERM2 3
+     358 ACC0
+     359 PUSHENVACC1
+     360 C_CALL2 caml_output_char
+     362 RETURN 1
+     364 CONSTINT 13
+     366 PUSHENVACC1
+     367 C_CALL2 caml_output_char
+     369 ENVACC1
+     370 C_CALL1 caml_flush
+     372 RETURN 1
+     374 ACC0
+     375 PUSHENVACC1
+     376 PUSHENVACC2
+     377 APPLY2
+     378 CONSTINT 13
+     380 PUSHENVACC1
+     381 C_CALL2 caml_output_char
+     383 RETURN 1
+     385 ACC0
+     386 PUSHENVACC1
+     387 APPLY1
+     388 PUSHENVACC2
+     389 PUSHENVACC3
+     390 APPTERM2 3
+     392 ACC0
+     393 PUSHENVACC1
+     394 APPLY1
+     395 PUSHENVACC2
+     396 PUSHENVACC3
+     397 APPTERM2 3
+     399 ACC0
+     400 PUSHENVACC1
+     401 PUSHENVACC2
+     402 APPTERM2 3
+     404 ACC0
+     405 PUSHENVACC1
+     406 C_CALL2 caml_output_char
+     408 RETURN 1
+     410 RESTART
+     411 GRAB 3
+     413 CONST0
+     414 PUSHACC3
+     415 LTINT
+     416 BRANCHIF 427
+     418 ACC1
+     419 C_CALL1 ml_string_length
+     421 PUSHACC4
+     422 PUSHACC4
+     423 ADDINT
+     424 GTINT
+     425 BRANCHIFNOT 432
+     427 GETGLOBAL "really_input"
+     429 PUSHENVACC1
+     430 APPTERM1 5
+     432 ACC3
+     433 PUSHACC3
+     434 PUSHACC3
+     435 PUSHACC3
+     436 PUSHENVACC2
+     437 APPTERM 4, 8
+     440 RESTART
+     441 GRAB 3
+     443 CONST0
+     444 PUSHACC3
+     445 LTINT
+     446 BRANCHIF 457
+     448 ACC1
+     449 C_CALL1 ml_string_length
+     451 PUSHACC4
+     452 PUSHACC4
+     453 ADDINT
+     454 GTINT
+     455 BRANCHIFNOT 462
+     457 GETGLOBAL "input"
+     459 PUSHENVACC1
+     460 APPTERM1 5
+     462 ACC3
+     463 PUSHACC3
+     464 PUSHACC3
+     465 PUSHACC3
+     466 C_CALL4 caml_input
+     468 RETURN 4
+     470 ACC0
+     471 PUSHCONST0
+     472 PUSHGETGLOBAL <0>(0, <0>(6, 0))
+     474 PUSHENVACC1
+     475 APPTERM3 4
+     477 ACC0
+     478 PUSHCONST0
+     479 PUSHGETGLOBAL <0>(0, <0>(7, 0))
+     481 PUSHENVACC1
+     482 APPTERM3 4
+     484 RESTART
+     485 GRAB 2
+     487 ACC1
+     488 PUSHACC1
+     489 PUSHACC4
+     490 C_CALL3 sys_open
+     492 C_CALL1 caml_open_descriptor
+     494 RETURN 3
+     496 ACC0
+     497 C_CALL1 caml_flush
+     499 ACC0
+     500 C_CALL1 caml_close_channel
+     502 RETURN 1
+     504 RESTART
+     505 GRAB 1
+     507 CONST0
+     508 PUSHACC2
+     509 PUSHACC2
+     510 C_CALL3 output_value
+     512 RETURN 2
+     514 RESTART
+     515 GRAB 3
+     517 CONST0
+     518 PUSHACC3
+     519 LTINT
+     520 BRANCHIF 531
+     522 ACC1
+     523 C_CALL1 ml_string_length
+     525 PUSHACC4
+     526 PUSHACC4
+     527 ADDINT
+     528 GTINT
+     529 BRANCHIFNOT 536
+     531 GETGLOBAL "output"
+     533 PUSHENVACC1
+     534 APPTERM1 5
+     536 ACC3
+     537 PUSHACC3
+     538 PUSHACC3
+     539 PUSHACC3
+     540 C_CALL4 caml_output
+     542 RETURN 4
+     544 RESTART
+     545 GRAB 1
+     547 ACC1
+     548 C_CALL1 ml_string_length
+     550 PUSHCONST0
+     551 PUSHACC3
+     552 PUSHACC3
+     553 C_CALL4 caml_output
+     555 RETURN 2
+     557 ACC0
+     558 PUSHCONSTINT 438
+     560 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(6, 0))))
+     562 PUSHENVACC1
+     563 APPTERM3 4
+     565 ACC0
+     566 PUSHCONSTINT 438
+     568 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(7, 0))))
+     570 PUSHENVACC1
+     571 APPTERM3 4
+     573 RESTART
+     574 GRAB 2
+     576 ACC1
+     577 PUSHACC1
+     578 PUSHACC4
+     579 C_CALL3 sys_open
+     581 C_CALL1 caml_open_descriptor
+     583 RETURN 3
+     585 ACC0
+     586 PUSHGETGLOBAL "%.12g"
+     588 C_CALL2 format_float
+     590 RETURN 1
+     592 ACC0
+     593 PUSHGETGLOBAL "%d"
+     595 C_CALL2 format_int
+     597 RETURN 1
+     599 GETGLOBAL "false"
+     601 PUSHACC1
+     602 C_CALL2 string_equal
+     604 BRANCHIFNOT 609
+     606 CONST0
+     607 RETURN 1
+     609 GETGLOBAL "true"
+     611 PUSHACC1
+     612 C_CALL2 string_equal
+     614 BRANCHIFNOT 619
+     616 CONST1
+     617 RETURN 1
+     619 GETGLOBAL "bool_of_string"
+     621 PUSHENVACC1
+     622 APPTERM1 2
+     624 ACC0
+     625 BRANCHIFNOT 631
+     627 GETGLOBAL "true"
+     629 RETURN 1
+     631 GETGLOBAL "false"
+     633 RETURN 1
+     635 CONST0
+     636 PUSHACC1
+     637 LTINT
+     638 BRANCHIF 646
+     640 CONSTINT 255
+     642 PUSHACC1
+     643 GTINT
+     644 BRANCHIFNOT 651
+     646 GETGLOBAL "char_of_int"
+     648 PUSHENVACC1
+     649 APPTERM1 2
+     651 ACC0
+     652 RETURN 1
+     654 RESTART
+     655 GRAB 1
+     657 ACC0
+     658 C_CALL1 ml_string_length
+     660 PUSHACC2
+     661 C_CALL1 ml_string_length
+     663 PUSHACC0
+     664 PUSHACC2
+     665 ADDINT
+     666 C_CALL1 create_string
+     668 PUSHACC2
+     669 PUSHCONST0
+     670 PUSHACC2
+     671 PUSHCONST0
+     672 PUSHACC7
+     673 C_CALL5 blit_string
+     675 ACC1
+     676 PUSHACC3
+     677 PUSHACC2
+     678 PUSHCONST0
+     679 PUSHACC 8
+     681 C_CALL5 blit_string
+     683 ACC0
+     684 RETURN 5
+     686 CONSTINT -1
+     688 PUSHACC1
+     689 XORINT
+     690 RETURN 1
+     692 CONST0
+     693 PUSHACC1
+     694 GEINT
+     695 BRANCHIFNOT 700
+     697 ACC0
+     698 RETURN 1
+     700 ACC0
+     701 NEGINT
+     702 RETURN 1
+     704 RESTART
+     705 GRAB 1
+     707 ACC1
+     708 PUSHACC1
+     709 C_CALL2 greaterequal
+     711 BRANCHIFNOT 716
+     713 ACC0
+     714 RETURN 2
+     716 ACC1
+     717 RETURN 2
+     719 RESTART
+     720 GRAB 1
+     722 ACC1
+     723 PUSHACC1
+     724 C_CALL2 lessequal
+     726 BRANCHIFNOT 731
+     728 ACC0
+     729 RETURN 2
+     731 ACC1
+     732 RETURN 2
+     734 ACC0
+     735 PUSHGETGLOBAL Invalid_argument
+     737 MAKEBLOCK2 0
+     739 RAISE
+     740 ACC0
+     741 PUSHGETGLOBAL Failure
+     743 MAKEBLOCK2 0
+     745 RAISE
+     746 CLOSURE 0, 740
+     749 PUSH
+     750 CLOSURE 0, 734
+     753 PUSHGETGLOBAL "Pervasives.Exit"
+     755 MAKEBLOCK1 0
+     757 PUSHGETGLOBAL "Pervasives.Assert_failure"
+     759 MAKEBLOCK1 0
+     761 PUSH
+     762 CLOSURE 0, 720
+     765 PUSH
+     766 CLOSURE 0, 705
+     769 PUSH
+     770 CLOSURE 0, 692
+     773 PUSH
+     774 CLOSURE 0, 686
+     777 PUSHCONST0
+     778 PUSHCONSTINT 31
+     780 PUSHCONST1
+     781 LSLINT
+     782 EQ
+     783 BRANCHIFNOT 789
+     785 CONSTINT 30
+     787 BRANCH 791
+     789 CONSTINT 62
+     791 PUSHCONST1
+     792 LSLINT
+     793 PUSHACC0
+     794 OFFSETINT -1
+     796 PUSH
+     797 CLOSURE 0, 655
+     800 PUSHACC 9
+     802 CLOSURE 1, 635
+     805 PUSH
+     806 CLOSURE 0, 624
+     809 PUSHACC 11
+     811 CLOSURE 1, 599
+     814 PUSH
+     815 CLOSURE 0, 592
+     818 PUSH
+     819 CLOSURE 0, 585
+     822 PUSH
+     823 CLOSUREREC 0, 12
+     827 CONST0
+     828 C_CALL1 caml_open_descriptor
+     830 PUSHCONST1
+     831 C_CALL1 caml_open_descriptor
+     833 PUSHCONST2
+     834 C_CALL1 caml_open_descriptor
+     836 PUSH
+     837 CLOSURE 0, 574
+     840 PUSHACC0
+     841 CLOSURE 1, 565
+     844 PUSHACC1
+     845 CLOSURE 1, 557
+     848 PUSH
+     849 CLOSURE 0, 545
+     852 PUSHACC 22
+     854 CLOSURE 1, 515
+     857 PUSH
+     858 CLOSURE 0, 505
+     861 PUSH
+     862 CLOSURE 0, 496
+     865 PUSH
+     866 CLOSURE 0, 485
+     869 PUSHACC0
+     870 CLOSURE 1, 477
+     873 PUSHACC1
+     874 CLOSURE 1, 470
+     877 PUSHACC 28
+     879 CLOSURE 1, 441
+     882 PUSH
+     883 CLOSUREREC 0, 32
+     887 ACC0
+     888 PUSHACC 31
+     890 CLOSURE 2, 411
+     893 PUSHACC 22
+     895 CLOSUREREC 1, 70
+     899 ACC 15
+     901 CLOSURE 1, 404
+     904 PUSHACC 11
+     906 PUSHACC 17
+     908 CLOSURE 2, 399
+     911 PUSHACC 12
+     913 PUSHACC 18
+     915 PUSHACC 23
+     917 CLOSURE 3, 392
+     920 PUSHACC 13
+     922 PUSHACC 19
+     924 PUSHACC 23
+     926 CLOSURE 3, 385
+     929 PUSHACC 14
+     931 PUSHACC 20
+     933 CLOSURE 2, 374
+     936 PUSHACC 20
+     938 CLOSURE 1, 364
+     941 PUSHACC 20
+     943 CLOSURE 1, 358
+     946 PUSHACC 17
+     948 PUSHACC 22
+     950 CLOSURE 2, 353
+     953 PUSHACC 18
+     955 PUSHACC 23
+     957 PUSHACC 29
+     959 CLOSURE 3, 346
+     962 PUSHACC 19
+     964 PUSHACC 24
+     966 PUSHACC 29
+     968 CLOSURE 3, 339
+     971 PUSHACC 20
+     973 PUSHACC 25
+     975 CLOSURE 2, 325
+     978 PUSHACC 25
+     980 CLOSURE 1, 315
+     983 PUSHACC 12
+     985 PUSHACC 28
+     987 PUSHACC 30
+     989 CLOSURE 3, 308
+     992 PUSHACC0
+     993 CLOSURE 1, 301
+     996 PUSHACC1
+     997 CLOSURE 1, 294
+    1000 PUSHACC 29
+    1002 PUSHACC 31
+    1004 CLOSURE 2, 286
+    1007 MAKEBLOCK1 0
+    1009 PUSHACC0
+    1010 CLOSURE 1, 275
+    1013 PUSHACC1
+    1014 CLOSURE 1, 263
+    1017 PUSHACC0
+    1018 CLOSURE 1, 255
+    1021 PUSHACC1
+    1022 PUSHACC 22
+    1024 PUSHACC4
+    1025 PUSHACC3
+    1026 PUSH
+    1027 CLOSURE 0, 247
+    1030 PUSH
+    1031 CLOSURE 0, 241
+    1034 PUSH
+    1035 CLOSURE 0, 236
+    1038 PUSH
+    1039 CLOSURE 0, 231
+    1042 PUSH
+    1043 CLOSURE 0, 223
+    1046 PUSH
+    1047 CLOSURE 0, 217
+    1050 PUSH
+    1051 CLOSURE 0, 212
+    1054 PUSH
+    1055 CLOSURE 0, 207
+    1058 PUSHACC 32
+    1060 PUSHACC 35
+    1062 PUSHACC 33
+    1064 PUSH
+    1065 CLOSURE 0, 202
+    1068 PUSHACC 41
+    1070 PUSHACC 40
+    1072 PUSHACC 42
+    1074 PUSH
+    1075 CLOSURE 0, 194
+    1078 PUSHACC 46
+    1080 PUSH
+    1081 CLOSURE 0, 188
+    1084 PUSH
+    1085 CLOSURE 0, 183
+    1088 PUSH
+    1089 CLOSURE 0, 175
+    1092 PUSHACC 51
+    1094 PUSH
+    1095 CLOSURE 0, 166
+    1098 PUSH
+    1099 CLOSURE 0, 157
+    1102 PUSHACC 55
+    1104 PUSHACC 57
+    1106 PUSH
+    1107 CLOSURE 0, 148
+    1110 PUSH
+    1111 CLOSURE 0, 142
+    1114 PUSHACC 63
+    1116 PUSHACC 62
+    1118 PUSHACC 64
+    1120 PUSHACC 38
+    1122 PUSHACC 40
+    1124 PUSHACC 42
+    1126 PUSHACC 44
+    1128 PUSHACC 46
+    1130 PUSHACC 48
+    1132 PUSHACC 50
+    1134 PUSHACC 52
+    1136 PUSHACC 54
+    1138 PUSHACC 56
+    1140 PUSHACC 58
+    1142 PUSHACC 60
+    1144 PUSHACC 62
+    1146 PUSHACC 64
+    1148 PUSHACC 66
+    1150 PUSHACC 82
+    1152 PUSHACC 84
+    1154 PUSHACC 86
+    1156 PUSHACC 88
+    1158 PUSHACC 90
+    1160 PUSHACC 92
+    1162 PUSHACC 94
+    1164 PUSHACC 96
+    1166 PUSHACC 98
+    1168 PUSHACC 100
+    1170 PUSHACC 104
+    1172 PUSHACC 104
+    1174 PUSHACC 104
+    1176 PUSHACC 108
+    1178 PUSHACC 110
+    1180 PUSHACC 112
+    1182 PUSHACC 117
+    1184 PUSHACC 117
+    1186 PUSHACC 117
+    1188 PUSHACC 117
+    1190 MAKEBLOCK 69, 0
+    1193 POP 53
+    1195 SETGLOBAL Pervasives
+    1197 BRANCH 2177
+    1199 RESTART
+    1200 GRAB 1
+    1202 ACC1
+    1203 BRANCHIFNOT 1213
+    1205 ACC1
+    1206 GETFIELD1
+    1207 PUSHACC1
+    1208 OFFSETINT 1
+    1210 PUSHOFFSETCLOSURE0
+    1211 APPTERM2 4
+    1213 ACC0
+    1214 RETURN 2
+    1216 RESTART
+    1217 GRAB 1
+    1219 ACC0
+    1220 BRANCHIFNOT 1251
+    1222 CONST0
+    1223 PUSHACC2
+    1224 EQ
+    1225 BRANCHIFNOT 1231
+    1227 ACC0
+    1228 GETFIELD0
+    1229 RETURN 2
+    1231 CONST0
+    1232 PUSHACC2
+    1233 GTINT
+    1234 BRANCHIFNOT 1244
+    1236 ACC1
+    1237 OFFSETINT -1
+    1239 PUSHACC1
+    1240 GETFIELD1
+    1241 PUSHOFFSETCLOSURE0
+    1242 APPTERM2 4
+    1244 GETGLOBAL "List.nth"
+    1246 PUSHGETGLOBALFIELD Pervasives, 2
+    1249 APPTERM1 3
+    1251 GETGLOBAL "nth"
+    1253 PUSHGETGLOBALFIELD Pervasives, 3
+    1256 APPTERM1 3
+    1258 RESTART
+    1259 GRAB 1
+    1261 ACC0
+    1262 BRANCHIFNOT 1274
+    1264 ACC1
+    1265 PUSHACC1
+    1266 GETFIELD0
+    1267 MAKEBLOCK2 0
+    1269 PUSHACC1
+    1270 GETFIELD1
+    1271 PUSHOFFSETCLOSURE0
+    1272 APPTERM2 4
+    1274 ACC1
+    1275 RETURN 2
+    1277 ACC0
+    1278 BRANCHIFNOT 1291
+    1280 ACC0
+    1281 GETFIELD1
+    1282 PUSHOFFSETCLOSURE0
+    1283 APPLY1
+    1284 PUSHACC1
+    1285 GETFIELD0
+    1286 PUSHGETGLOBALFIELD Pervasives, 16
+    1289 APPTERM2 3
+    1291 RETURN 1
+    1293 RESTART
+    1294 GRAB 1
+    1296 ACC1
+    1297 BRANCHIFNOT 1313
+    1299 ACC1
+    1300 GETFIELD0
+    1301 PUSHACC1
+    1302 APPLY1
+    1303 PUSHACC2
+    1304 GETFIELD1
+    1305 PUSHACC2
+    1306 PUSHOFFSETCLOSURE0
+    1307 APPLY2
+    1308 PUSHACC1
+    1309 MAKEBLOCK2 0
+    1311 POP 1
+    1313 RETURN 2
+    1315 RESTART
+    1316 GRAB 1
+    1318 ACC1
+    1319 BRANCHIFNOT 1331
+    1321 ACC1
+    1322 GETFIELD0
+    1323 PUSHACC1
+    1324 APPLY1
+    1325 ACC1
+    1326 GETFIELD1
+    1327 PUSHACC1
+    1328 PUSHOFFSETCLOSURE0
+    1329 APPTERM2 4
+    1331 RETURN 2
+    1333 RESTART
+    1334 GRAB 2
+    1336 ACC2
+    1337 BRANCHIFNOT 1350
+    1339 ACC2
+    1340 GETFIELD1
+    1341 PUSHACC3
+    1342 GETFIELD0
+    1343 PUSHACC3
+    1344 PUSHACC3
+    1345 APPLY2
+    1346 PUSHACC2
+    1347 PUSHOFFSETCLOSURE0
+    1348 APPTERM3 6
+    1350 ACC1
+    1351 RETURN 3
+    1353 RESTART
+    1354 GRAB 2
+    1356 ACC1
+    1357 BRANCHIFNOT 1370
+    1359 ACC2
+    1360 PUSHACC2
+    1361 GETFIELD1
+    1362 PUSHACC2
+    1363 PUSHOFFSETCLOSURE0
+    1364 APPLY3
+    1365 PUSHACC2
+    1366 GETFIELD0
+    1367 PUSHACC2
+    1368 APPTERM2 5
+    1370 ACC2
+    1371 RETURN 3
+    1373 RESTART
+    1374 GRAB 2
+    1376 ACC1
+    1377 BRANCHIFNOT 1400
+    1379 ACC2
+    1380 BRANCHIFNOT 1407
+    1382 ACC2
+    1383 GETFIELD0
+    1384 PUSHACC2
+    1385 GETFIELD0
+    1386 PUSHACC2
+    1387 APPLY2
+    1388 PUSHACC3
+    1389 GETFIELD1
+    1390 PUSHACC3
+    1391 GETFIELD1
+    1392 PUSHACC3
+    1393 PUSHOFFSETCLOSURE0
+    1394 APPLY3
+    1395 PUSHACC1
+    1396 MAKEBLOCK2 0
+    1398 RETURN 4
+    1400 ACC2
+    1401 BRANCHIFNOT 1405
+    1403 BRANCH 1407
+    1405 RETURN 3
+    1407 GETGLOBAL "List.map2"
+    1409 PUSHGETGLOBALFIELD Pervasives, 2
+    1412 APPTERM1 4
+    1414 RESTART
+    1415 GRAB 2
+    1417 ACC1
+    1418 BRANCHIFNOT 1437
+    1420 ACC2
+    1421 BRANCHIFNOT 1444
+    1423 ACC2
+    1424 GETFIELD0
+    1425 PUSHACC2
+    1426 GETFIELD0
+    1427 PUSHACC2
+    1428 APPLY2
+    1429 ACC2
+    1430 GETFIELD1
+    1431 PUSHACC2
+    1432 GETFIELD1
+    1433 PUSHACC2
+    1434 PUSHOFFSETCLOSURE0
+    1435 APPTERM3 6
+    1437 ACC2
+    1438 BRANCHIFNOT 1442
+    1440 BRANCH 1444
+    1442 RETURN 3
+    1444 GETGLOBAL "List.iter2"
+    1446 PUSHGETGLOBALFIELD Pervasives, 2
+    1449 APPTERM1 4
+    1451 RESTART
+    1452 GRAB 3
+    1454 ACC2
+    1455 BRANCHIFNOT 1476
+    1457 ACC3
+    1458 BRANCHIFNOT 1482
+    1460 ACC3
+    1461 GETFIELD1
+    1462 PUSHACC3
+    1463 GETFIELD1
+    1464 PUSHACC5
+    1465 GETFIELD0
+    1466 PUSHACC5
+    1467 GETFIELD0
+    1468 PUSHACC5
+    1469 PUSHACC5
+    1470 APPLY3
+    1471 PUSHACC3
+    1472 PUSHOFFSETCLOSURE0
+    1473 APPTERM 4, 8
+    1476 ACC3
+    1477 BRANCHIF 1482
+    1479 ACC1
+    1480 RETURN 4
+    1482 GETGLOBAL "List.fold_left2"
+    1484 PUSHGETGLOBALFIELD Pervasives, 2
+    1487 APPTERM1 5
+    1489 RESTART
+    1490 GRAB 3
+    1492 ACC1
+    1493 BRANCHIFNOT 1516
+    1495 ACC2
+    1496 BRANCHIFNOT 1522
+    1498 PUSH_RETADDR 1509
+    1500 ACC6
+    1501 PUSHACC6
+    1502 GETFIELD1
+    1503 PUSHACC6
+    1504 GETFIELD1
+    1505 PUSHACC6
+    1506 PUSHOFFSETCLOSURE0
+    1507 APPLY 4
+    1509 PUSHACC3
+    1510 GETFIELD0
+    1511 PUSHACC3
+    1512 GETFIELD0
+    1513 PUSHACC3
+    1514 APPTERM3 7
+    1516 ACC2
+    1517 BRANCHIF 1522
+    1519 ACC3
+    1520 RETURN 4
+    1522 GETGLOBAL "List.fold_right2"
+    1524 PUSHGETGLOBALFIELD Pervasives, 2
+    1527 APPTERM1 5
+    1529 RESTART
+    1530 GRAB 1
+    1532 ACC1
+    1533 BRANCHIFNOT 1549
+    1535 ACC1
+    1536 GETFIELD0
+    1537 PUSHACC1
+    1538 APPLY1
+    1539 BRANCHIFNOT 1547
+    1541 ACC1
+    1542 GETFIELD1
+    1543 PUSHACC1
+    1544 PUSHOFFSETCLOSURE0
+    1545 APPTERM2 4
+    1547 RETURN 2
+    1549 CONST1
+    1550 RETURN 2
+    1552 RESTART
+    1553 GRAB 1
+    1555 ACC1
+    1556 BRANCHIFNOT 1570
+    1558 ACC1
+    1559 GETFIELD0
+    1560 PUSHACC1
+    1561 APPLY1
+    1562 BRANCHIF 1570
+    1564 ACC1
+    1565 GETFIELD1
+    1566 PUSHACC1
+    1567 PUSHOFFSETCLOSURE0
+    1568 APPTERM2 4
+    1570 RETURN 2
+    1572 RESTART
+    1573 GRAB 2
+    1575 ACC1
+    1576 BRANCHIFNOT 1599
+    1578 ACC2
+    1579 BRANCHIFNOT 1605
+    1581 ACC2
+    1582 GETFIELD0
+    1583 PUSHACC2
+    1584 GETFIELD0
+    1585 PUSHACC2
+    1586 APPLY2
+    1587 BRANCHIFNOT 1597
+    1589 ACC2
+    1590 GETFIELD1
+    1591 PUSHACC2
+    1592 GETFIELD1
+    1593 PUSHACC2
+    1594 PUSHOFFSETCLOSURE0
+    1595 APPTERM3 6
+    1597 RETURN 3
+    1599 ACC2
+    1600 BRANCHIF 1605
+    1602 CONST1
+    1603 RETURN 3
+    1605 GETGLOBAL "List.for_all2"
+    1607 PUSHGETGLOBALFIELD Pervasives, 2
+    1610 APPTERM1 4
+    1612 RESTART
+    1613 GRAB 2
+    1615 ACC1
+    1616 BRANCHIFNOT 1639
+    1618 ACC2
+    1619 BRANCHIFNOT 1646
+    1621 ACC2
+    1622 GETFIELD0
+    1623 PUSHACC2
+    1624 GETFIELD0
+    1625 PUSHACC2
+    1626 APPLY2
+    1627 BRANCHIF 1637
+    1629 ACC2
+    1630 GETFIELD1
+    1631 PUSHACC2
+    1632 GETFIELD1
+    1633 PUSHACC2
+    1634 PUSHOFFSETCLOSURE0
+    1635 APPTERM3 6
+    1637 RETURN 3
+    1639 ACC2
+    1640 BRANCHIFNOT 1644
+    1642 BRANCH 1646
+    1644 RETURN 3
+    1646 GETGLOBAL "List.exists2"
+    1648 PUSHGETGLOBALFIELD Pervasives, 2
+    1651 APPTERM1 4
+    1653 RESTART
+    1654 GRAB 1
+    1656 ACC1
+    1657 BRANCHIFNOT 1672
+    1659 ACC0
+    1660 PUSHACC2
+    1661 GETFIELD0
+    1662 C_CALL2 equal
+    1664 BRANCHIF 1672
+    1666 ACC1
+    1667 GETFIELD1
+    1668 PUSHACC1
+    1669 PUSHOFFSETCLOSURE0
+    1670 APPTERM2 4
+    1672 RETURN 2
+    1674 RESTART
+    1675 GRAB 1
+    1677 ACC1
+    1678 BRANCHIFNOT 1692
+    1680 ACC0
+    1681 PUSHACC2
+    1682 GETFIELD0
+    1683 EQ
+    1684 BRANCHIF 1692
+    1686 ACC1
+    1687 GETFIELD1
+    1688 PUSHACC1
+    1689 PUSHOFFSETCLOSURE0
+    1690 APPTERM2 4
+    1692 RETURN 2
+    1694 RESTART
+    1695 GRAB 1
+    1697 ACC1
+    1698 BRANCHIFNOT 1719
+    1700 ACC1
+    1701 GETFIELD0
+    1702 PUSHACC1
+    1703 PUSHACC1
+    1704 GETFIELD0
+    1705 C_CALL2 equal
+    1707 BRANCHIFNOT 1713
+    1709 ACC0
+    1710 GETFIELD1
+    1711 RETURN 3
+    1713 ACC2
+    1714 GETFIELD1
+    1715 PUSHACC2
+    1716 PUSHOFFSETCLOSURE0
+    1717 APPTERM2 5
+    1719 GETGLOBAL Not_found
+    1721 MAKEBLOCK1 0
+    1723 RAISE
+    1724 RESTART
+    1725 GRAB 1
+    1727 ACC1
+    1728 BRANCHIFNOT 1748
+    1730 ACC1
+    1731 GETFIELD0
+    1732 PUSHACC1
+    1733 PUSHACC1
+    1734 GETFIELD0
+    1735 EQ
+    1736 BRANCHIFNOT 1742
+    1738 ACC0
+    1739 GETFIELD1
+    1740 RETURN 3
+    1742 ACC2
+    1743 GETFIELD1
+    1744 PUSHACC2
+    1745 PUSHOFFSETCLOSURE0
+    1746 APPTERM2 5
+    1748 GETGLOBAL Not_found
+    1750 MAKEBLOCK1 0
+    1752 RAISE
+    1753 RESTART
+    1754 GRAB 1
+    1756 ACC1
+    1757 BRANCHIFNOT 1773
+    1759 ACC0
+    1760 PUSHACC2
+    1761 GETFIELD0
+    1762 GETFIELD0
+    1763 C_CALL2 equal
+    1765 BRANCHIF 1773
+    1767 ACC1
+    1768 GETFIELD1
+    1769 PUSHACC1
+    1770 PUSHOFFSETCLOSURE0
+    1771 APPTERM2 4
+    1773 RETURN 2
+    1775 RESTART
+    1776 GRAB 1
+    1778 ACC1
+    1779 BRANCHIFNOT 1794
+    1781 ACC0
+    1782 PUSHACC2
+    1783 GETFIELD0
+    1784 GETFIELD0
+    1785 EQ
+    1786 BRANCHIF 1794
+    1788 ACC1
+    1789 GETFIELD1
+    1790 PUSHACC1
+    1791 PUSHOFFSETCLOSURE0
+    1792 APPTERM2 4
+    1794 RETURN 2
+    1796 RESTART
+    1797 GRAB 1
+    1799 ACC1
+    1800 BRANCHIFNOT 1825
+    1802 ACC1
+    1803 GETFIELD0
+    1804 PUSHACC2
+    1805 GETFIELD1
+    1806 PUSHACC2
+    1807 PUSHACC2
+    1808 GETFIELD0
+    1809 C_CALL2 equal
+    1811 BRANCHIFNOT 1816
+    1813 ACC0
+    1814 RETURN 4
+    1816 ACC0
+    1817 PUSHACC3
+    1818 PUSHOFFSETCLOSURE0
+    1819 APPLY2
+    1820 PUSHACC2
+    1821 MAKEBLOCK2 0
+    1823 POP 2
+    1825 RETURN 2
+    1827 RESTART
+    1828 GRAB 1
+    1830 ACC1
+    1831 BRANCHIFNOT 1855
+    1833 ACC1
+    1834 GETFIELD0
+    1835 PUSHACC2
+    1836 GETFIELD1
+    1837 PUSHACC2
+    1838 PUSHACC2
+    1839 GETFIELD0
+    1840 EQ
+    1841 BRANCHIFNOT 1846
+    1843 ACC0
+    1844 RETURN 4
+    1846 ACC0
+    1847 PUSHACC3
+    1848 PUSHOFFSETCLOSURE0
+    1849 APPLY2
+    1850 PUSHACC2
+    1851 MAKEBLOCK2 0
+    1853 POP 2
+    1855 RETURN 2
+    1857 RESTART
+    1858 GRAB 1
+    1860 ACC1
+    1861 BRANCHIFNOT 1879
+    1863 ACC1
+    1864 GETFIELD0
+    1865 PUSHACC0
+    1866 PUSHACC2
+    1867 APPLY1
+    1868 BRANCHIFNOT 1873
+    1870 ACC0
+    1871 RETURN 3
+    1873 ACC2
+    1874 GETFIELD1
+    1875 PUSHACC2
+    1876 PUSHOFFSETCLOSURE0
+    1877 APPTERM2 5
+    1879 GETGLOBAL Not_found
+    1881 MAKEBLOCK1 0
+    1883 RAISE
+    1884 RESTART
+    1885 GRAB 2
+    1887 ACC2
+    1888 BRANCHIFNOT 1917
+    1890 ACC2
+    1891 GETFIELD0
+    1892 PUSHACC3
+    1893 GETFIELD1
+    1894 PUSHACC1
+    1895 PUSHENVACC2
+    1896 APPLY1
+    1897 BRANCHIFNOT 1908
+    1899 ACC0
+    1900 PUSHACC4
+    1901 PUSHACC4
+    1902 PUSHACC4
+    1903 MAKEBLOCK2 0
+    1905 PUSHOFFSETCLOSURE0
+    1906 APPTERM3 8
+    1908 ACC0
+    1909 PUSHACC4
+    1910 PUSHACC3
+    1911 MAKEBLOCK2 0
+    1913 PUSHACC4
+    1914 PUSHOFFSETCLOSURE0
+    1915 APPTERM3 8
+    1917 ACC1
+    1918 PUSHENVACC1
+    1919 APPLY1
+    1920 PUSHACC1
+    1921 PUSHENVACC1
+    1922 APPLY1
+    1923 MAKEBLOCK2 0
+    1925 RETURN 3
+    1927 RESTART
+    1928 GRAB 1
+    1930 ACC0
+    1931 PUSHENVACC1
+    1932 CLOSUREREC 2, 1885
+    1936 ACC2
+    1937 PUSHCONST0
+    1938 PUSHCONST0
+    1939 PUSHACC3
+    1940 APPTERM3 6
+    1942 ACC0
+    1943 BRANCHIFNOT 1967
+    1945 ACC0
+    1946 GETFIELD0
+    1947 PUSHACC1
+    1948 GETFIELD1
+    1949 PUSHOFFSETCLOSURE0
+    1950 APPLY1
+    1951 PUSHACC0
+    1952 GETFIELD1
+    1953 PUSHACC2
+    1954 GETFIELD1
+    1955 MAKEBLOCK2 0
+    1957 PUSHACC1
+    1958 GETFIELD0
+    1959 PUSHACC3
+    1960 GETFIELD0
+    1961 MAKEBLOCK2 0
+    1963 MAKEBLOCK2 0
+    1965 RETURN 3
+    1967 GETGLOBAL <0>(0, 0)
+    1969 RETURN 1
+    1971 RESTART
+    1972 GRAB 1
+    1974 ACC0
+    1975 BRANCHIFNOT 1996
+    1977 ACC1
+    1978 BRANCHIFNOT 2003
+    1980 ACC1
+    1981 GETFIELD1
+    1982 PUSHACC1
+    1983 GETFIELD1
+    1984 PUSHOFFSETCLOSURE0
+    1985 APPLY2
+    1986 PUSHACC2
+    1987 GETFIELD0
+    1988 PUSHACC2
+    1989 GETFIELD0
+    1990 MAKEBLOCK2 0
+    1992 MAKEBLOCK2 0
+    1994 RETURN 2
+    1996 ACC1
+    1997 BRANCHIFNOT 2001
+    1999 BRANCH 2003
+    2001 RETURN 2
+    2003 GETGLOBAL "List.combine"
+    2005 PUSHGETGLOBALFIELD Pervasives, 2
+    2008 APPTERM1 3
+    2010 RESTART
+    2011 GRAB 1
+    2013 ACC1
+    2014 BRANCHIFNOT 2038
+    2016 ACC1
+    2017 GETFIELD0
+    2018 PUSHACC2
+    2019 GETFIELD1
+    2020 PUSHACC1
+    2021 PUSHENVACC2
+    2022 APPLY1
+    2023 BRANCHIFNOT 2033
+    2025 ACC0
+    2026 PUSHACC3
+    2027 PUSHACC3
+    2028 MAKEBLOCK2 0
+    2030 PUSHOFFSETCLOSURE0
+    2031 APPTERM2 6
+    2033 ACC0
+    2034 PUSHACC3
+    2035 PUSHOFFSETCLOSURE0
+    2036 APPTERM2 6
+    2038 ACC0
+    2039 PUSHENVACC1
+    2040 APPTERM1 3
+    2042 ACC0
+    2043 PUSHENVACC1
+    2044 CLOSUREREC 2, 2011
+    2048 CONST0
+    2049 PUSHACC1
+    2050 APPTERM1 3
+    2052 RESTART
+    2053 GRAB 2
+    2055 ACC1
+    2056 BRANCHIFNOT 2077
+    2058 ACC2
+    2059 BRANCHIFNOT 2084
+    2061 ACC2
+    2062 GETFIELD1
+    2063 PUSHACC2
+    2064 GETFIELD1
+    2065 PUSHACC2
+    2066 PUSHACC5
+    2067 GETFIELD0
+    2068 PUSHACC5
+    2069 GETFIELD0
+    2070 PUSHENVACC1
+    2071 APPLY2
+    2072 MAKEBLOCK2 0
+    2074 PUSHOFFSETCLOSURE0
+    2075 APPTERM3 6
+    2077 ACC2
+    2078 BRANCHIFNOT 2082
+    2080 BRANCH 2084
+    2082 RETURN 3
+    2084 GETGLOBAL "List.rev_map2"
+    2086 PUSHGETGLOBALFIELD Pervasives, 2
+    2089 APPTERM1 4
+    2091 RESTART
+    2092 GRAB 2
+    2094 ACC0
+    2095 CLOSUREREC 1, 2053
+    2099 ACC3
+    2100 PUSHACC3
+    2101 PUSHCONST0
+    2102 PUSHACC3
+    2103 APPTERM3 7
+    2105 RESTART
+    2106 GRAB 1
+    2108 ACC1
+    2109 BRANCHIFNOT 2123
+    2111 ACC1
+    2112 GETFIELD1
+    2113 PUSHACC1
+    2114 PUSHACC3
+    2115 GETFIELD0
+    2116 PUSHENVACC1
+    2117 APPLY1
+    2118 MAKEBLOCK2 0
+    2120 PUSHOFFSETCLOSURE0
+    2121 APPTERM2 4
+    2123 ACC0
+    2124 RETURN 2
+    2126 RESTART
+    2127 GRAB 1
+    2129 ACC0
+    2130 CLOSUREREC 1, 2106
+    2134 ACC2
+    2135 PUSHCONST0
+    2136 PUSHACC2
+    2137 APPTERM2 5
+    2139 CONST0
+    2140 PUSHACC1
+    2141 PUSHENVACC1
+    2142 APPTERM2 3
+    2144 ACC0
+    2145 BRANCHIFNOT 2151
+    2147 ACC0
+    2148 GETFIELD1
+    2149 RETURN 1
+    2151 GETGLOBAL "tl"
+    2153 PUSHGETGLOBALFIELD Pervasives, 3
+    2156 APPTERM1 2
+    2158 ACC0
+    2159 BRANCHIFNOT 2165
+    2161 ACC0
+    2162 GETFIELD0
+    2163 RETURN 1
+    2165 GETGLOBAL "hd"
+    2167 PUSHGETGLOBALFIELD Pervasives, 3
+    2170 APPTERM1 2
+    2172 ACC0
+    2173 PUSHCONST0
+    2174 PUSHENVACC1
+    2175 APPTERM2 3
+    2177 CLOSUREREC 0, 1200
+    2181 ACC0
+    2182 CLOSURE 1, 2172
+    2185 PUSH
+    2186 CLOSURE 0, 2158
+    2189 PUSH
+    2190 CLOSURE 0, 2144
+    2193 PUSH
+    2194 CLOSUREREC 0, 1217
+    2198 GETGLOBALFIELD Pervasives, 16
+    2201 PUSH
+    2202 CLOSUREREC 0, 1259
+    2206 ACC0
+    2207 CLOSURE 1, 2139
+    2210 PUSH
+    2211 CLOSUREREC 0, 1277
+    2215 CLOSUREREC 0, 1294
+    2219 CLOSURE 0, 2127
+    2222 PUSH
+    2223 CLOSUREREC 0, 1316
+    2227 CLOSUREREC 0, 1334
+    2231 CLOSUREREC 0, 1354
+    2235 CLOSUREREC 0, 1374
+    2239 CLOSURE 0, 2092
+    2242 PUSH
+    2243 CLOSUREREC 0, 1415
+    2247 CLOSUREREC 0, 1452
+    2251 CLOSUREREC 0, 1490
+    2255 CLOSUREREC 0, 1530
+    2259 CLOSUREREC 0, 1553
+    2263 CLOSUREREC 0, 1573
+    2267 CLOSUREREC 0, 1613
+    2271 CLOSUREREC 0, 1654
+    2275 CLOSUREREC 0, 1675
+    2279 CLOSUREREC 0, 1695
+    2283 CLOSUREREC 0, 1725
+    2287 CLOSUREREC 0, 1754
+    2291 CLOSUREREC 0, 1776
+    2295 CLOSUREREC 0, 1797
+    2299 CLOSUREREC 0, 1828
+    2303 CLOSUREREC 0, 1858
+    2307 ACC 24
+    2309 CLOSURE 1, 2042
+    2312 PUSHACC 25
+    2314 CLOSUREREC 1, 1928
+    2318 CLOSUREREC 0, 1942
+    2322 CLOSUREREC 0, 1972
+    2326 ACC0
+    2327 PUSHACC2
+    2328 PUSHACC7
+    2329 PUSHACC 9
+    2331 PUSHACC 11
+    2333 PUSHACC 13
+    2335 PUSHACC 15
+    2337 PUSHACC 17
+    2339 PUSHACC 10
+    2341 PUSHACC 12
+    2343 PUSHACC 13
+    2345 PUSHACC 15
+    2347 PUSHACC 23
+    2349 PUSHACC 25
+    2351 PUSHACC 27
+    2353 PUSHACC 29
+    2355 PUSHACC 31
+    2357 PUSHACC 33
+    2359 PUSHACC 35
+    2361 PUSHACC 37
+    2363 PUSHACC 40
+    2365 PUSHACC 42
+    2367 PUSHACC 41
+    2369 PUSHACC 45
+    2371 PUSHACC 47
+    2373 PUSHACC 50
+    2375 PUSHACC 52
+    2377 PUSHACC 51
+    2379 PUSHACC 55
+    2381 PUSHACC 56
+    2383 PUSHACC 59
+    2385 PUSHACC 61
+    2387 PUSHACC 60
+    2389 PUSHACC 64
+    2391 PUSHACC 66
+    2393 PUSHACC 68
+    2395 PUSHACC 70
+    2397 MAKEBLOCK 37, 0
+    2400 POP 36
+    2402 SETGLOBAL List
+    2404 BRANCH 2432
+    2406 CONST0
+    2407 PUSHACC1
+    2408 LEINT
+    2409 BRANCHIFNOT 2414
+    2411 CONST0
+    2412 RETURN 1
+    2414 ACC0
+    2415 OFFSETINT -1
+    2417 PUSHOFFSETCLOSURE0
+    2418 APPLY1
+    2419 PUSHACC1
+    2420 MAKEBLOCK2 0
+    2422 RETURN 1
+    2424 RESTART
+    2425 GRAB 1
+    2427 ACC1
+    2428 PUSHACC1
+    2429 ADDINT
+    2430 RETURN 2
+    2432 CLOSUREREC 0, 2406
+    2436 CONSTINT 300
+    2438 PUSHACC1
+    2439 APPLY1
+    2440 PUSHCONST0
+    2441 C_CALL1 gc_compaction
+    2443 CONSTINT 150
+    2445 PUSHCONSTINT 301
+    2447 MULINT
+    2448 PUSHACC1
+    2449 PUSHCONST0
+    2450 PUSH
+    2451 CLOSURE 0, 2425
+    2454 PUSHGETGLOBALFIELD List, 12
+    2457 APPLY3
+    2458 NEQ
+    2459 BRANCHIFNOT 2466
+    2461 GETGLOBAL Not_found
+    2463 MAKEBLOCK1 0
+    2465 RAISE
+    2466 POP 2
+    2468 ATOM0
+    2469 SETGLOBAL T330-compact-3
+    2471 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t330-compact-4.ml b/testsuite/tests/tool-ocaml/t330-compact-4.ml
new file mode 100644
index 00000000..a3cc2080
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t330-compact-4.ml
@@ -0,0 +1,1597 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f n =
+  if n <= 0 then []
+  else n :: f (n-1)
+in
+Gc.compact ();
+let l = f 300 in
+if List.fold_left (+) 0 l <> 301 * 150 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 746
+      11 RESTART
+      12 GRAB 1
+      14 ACC0
+      15 BRANCHIFNOT 28
+      17 ACC1
+      18 PUSHACC1
+      19 GETFIELD1
+      20 PUSHOFFSETCLOSURE0
+      21 APPLY2
+      22 PUSHACC1
+      23 GETFIELD0
+      24 MAKEBLOCK2 0
+      26 RETURN 2
+      28 ACC1
+      29 RETURN 2
+      31 RESTART
+      32 GRAB 3
+      34 CONST0
+      35 PUSHACC4
+      36 LEINT
+      37 BRANCHIFNOT 42
+      39 CONST0
+      40 RETURN 4
+      42 ACC3
+      43 PUSHACC3
+      44 PUSHACC3
+      45 PUSHACC3
+      46 C_CALL4 caml_input
+      48 PUSHCONST0
+      49 PUSHACC1
+      50 EQ
+      51 BRANCHIFNOT 58
+      53 GETGLOBAL End_of_file
+      55 MAKEBLOCK1 0
+      57 RAISE
+      58 ACC0
+      59 PUSHACC5
+      60 SUBINT
+      61 PUSHACC1
+      62 PUSHACC5
+      63 ADDINT
+      64 PUSHACC4
+      65 PUSHACC4
+      66 PUSHOFFSETCLOSURE0
+      67 APPTERM 4, 9
+      70 ACC0
+      71 C_CALL1 caml_input_scan_line
+      73 PUSHCONST0
+      74 PUSHACC1
+      75 EQ
+      76 BRANCHIFNOT 83
+      78 GETGLOBAL End_of_file
+      80 MAKEBLOCK1 0
+      82 RAISE
+      83 CONST0
+      84 PUSHACC1
+      85 GTINT
+      86 BRANCHIFNOT 107
+      88 ACC0
+      89 OFFSETINT -1
+      91 C_CALL1 create_string
+      93 PUSHACC1
+      94 OFFSETINT -1
+      96 PUSHCONST0
+      97 PUSHACC2
+      98 PUSHACC5
+      99 C_CALL4 caml_input
+     101 ACC2
+     102 C_CALL1 caml_input_char
+     104 ACC0
+     105 RETURN 3
+     107 ACC0
+     108 NEGINT
+     109 C_CALL1 create_string
+     111 PUSHACC1
+     112 NEGINT
+     113 PUSHCONST0
+     114 PUSHACC2
+     115 PUSHACC5
+     116 C_CALL4 caml_input
+     118 CONST0
+     119 PUSHTRAP 130
+     121 ACC6
+     122 PUSHOFFSETCLOSURE0
+     123 APPLY1
+     124 PUSHACC5
+     125 PUSHENVACC1
+     126 APPLY2
+     127 POPTRAP
+     128 RETURN 3
+     130 PUSHGETGLOBAL End_of_file
+     132 PUSHACC1
+     133 GETFIELD0
+     134 EQ
+     135 BRANCHIFNOT 140
+     137 ACC1
+     138 RETURN 4
+     140 ACC0
+     141 RAISE
+     142 ACC0
+     143 C_CALL1 caml_flush
+     145 RETURN 1
+     147 RESTART
+     148 GRAB 1
+     150 ACC1
+     151 PUSHACC1
+     152 C_CALL2 caml_output_char
+     154 RETURN 2
+     156 RESTART
+     157 GRAB 1
+     159 ACC1
+     160 PUSHACC1
+     161 C_CALL2 caml_output_char
+     163 RETURN 2
+     165 RESTART
+     166 GRAB 1
+     168 ACC1
+     169 PUSHACC1
+     170 C_CALL2 caml_output_int
+     172 RETURN 2
+     174 RESTART
+     175 GRAB 1
+     177 ACC1
+     178 PUSHACC1
+     179 C_CALL2 caml_seek_out
+     181 RETURN 2
+     183 ACC0
+     184 C_CALL1 caml_pos_out
+     186 RETURN 1
+     188 ACC0
+     189 C_CALL1 caml_channel_size
+     191 RETURN 1
+     193 RESTART
+     194 GRAB 1
+     196 ACC1
+     197 PUSHACC1
+     198 C_CALL2 caml_set_binary_mode
+     200 RETURN 2
+     202 ACC0
+     203 C_CALL1 caml_input_char
+     205 RETURN 1
+     207 ACC0
+     208 C_CALL1 caml_input_char
+     210 RETURN 1
+     212 ACC0
+     213 C_CALL1 caml_input_int
+     215 RETURN 1
+     217 ACC0
+     218 C_CALL1 input_value
+     220 RETURN 1
+     222 RESTART
+     223 GRAB 1
+     225 ACC1
+     226 PUSHACC1
+     227 C_CALL2 caml_seek_in
+     229 RETURN 2
+     231 ACC0
+     232 C_CALL1 caml_pos_in
+     234 RETURN 1
+     236 ACC0
+     237 C_CALL1 caml_channel_size
+     239 RETURN 1
+     241 ACC0
+     242 C_CALL1 caml_close_channel
+     244 RETURN 1
+     246 RESTART
+     247 GRAB 1
+     249 ACC1
+     250 PUSHACC1
+     251 C_CALL2 caml_set_binary_mode
+     253 RETURN 2
+     255 CONST0
+     256 PUSHENVACC1
+     257 APPLY1
+     258 ACC0
+     259 C_CALL1 sys_exit
+     261 RETURN 1
+     263 CONST0
+     264 PUSHENVACC1
+     265 GETFIELD0
+     266 APPTERM1 2
+     268 CONST0
+     269 PUSHENVACC1
+     270 APPLY1
+     271 CONST0
+     272 PUSHENVACC2
+     273 APPTERM1 2
+     275 ENVACC1
+     276 GETFIELD0
+     277 PUSHACC0
+     278 PUSHACC2
+     279 CLOSURE 2, 268
+     282 PUSHENVACC1
+     283 SETFIELD0
+     284 RETURN 2
+     286 ENVACC1
+     287 C_CALL1 caml_flush
+     289 ENVACC2
+     290 C_CALL1 caml_flush
+     292 RETURN 1
+     294 CONST0
+     295 PUSHENVACC1
+     296 APPLY1
+     297 C_CALL1 float_of_string
+     299 RETURN 1
+     301 CONST0
+     302 PUSHENVACC1
+     303 APPLY1
+     304 C_CALL1 int_of_string
+     306 RETURN 1
+     308 ENVACC2
+     309 C_CALL1 caml_flush
+     311 ENVACC1
+     312 PUSHENVACC3
+     313 APPTERM1 2
+     315 CONSTINT 13
+     317 PUSHENVACC1
+     318 C_CALL2 caml_output_char
+     320 ENVACC1
+     321 C_CALL1 caml_flush
+     323 RETURN 1
+     325 ACC0
+     326 PUSHENVACC1
+     327 PUSHENVACC2
+     328 APPLY2
+     329 CONSTINT 13
+     331 PUSHENVACC1
+     332 C_CALL2 caml_output_char
+     334 ENVACC1
+     335 C_CALL1 caml_flush
+     337 RETURN 1
+     339 ACC0
+     340 PUSHENVACC1
+     341 APPLY1
+     342 PUSHENVACC2
+     343 PUSHENVACC3
+     344 APPTERM2 3
+     346 ACC0
+     347 PUSHENVACC1
+     348 APPLY1
+     349 PUSHENVACC2
+     350 PUSHENVACC3
+     351 APPTERM2 3
+     353 ACC0
+     354 PUSHENVACC1
+     355 PUSHENVACC2
+     356 APPTERM2 3
+     358 ACC0
+     359 PUSHENVACC1
+     360 C_CALL2 caml_output_char
+     362 RETURN 1
+     364 CONSTINT 13
+     366 PUSHENVACC1
+     367 C_CALL2 caml_output_char
+     369 ENVACC1
+     370 C_CALL1 caml_flush
+     372 RETURN 1
+     374 ACC0
+     375 PUSHENVACC1
+     376 PUSHENVACC2
+     377 APPLY2
+     378 CONSTINT 13
+     380 PUSHENVACC1
+     381 C_CALL2 caml_output_char
+     383 RETURN 1
+     385 ACC0
+     386 PUSHENVACC1
+     387 APPLY1
+     388 PUSHENVACC2
+     389 PUSHENVACC3
+     390 APPTERM2 3
+     392 ACC0
+     393 PUSHENVACC1
+     394 APPLY1
+     395 PUSHENVACC2
+     396 PUSHENVACC3
+     397 APPTERM2 3
+     399 ACC0
+     400 PUSHENVACC1
+     401 PUSHENVACC2
+     402 APPTERM2 3
+     404 ACC0
+     405 PUSHENVACC1
+     406 C_CALL2 caml_output_char
+     408 RETURN 1
+     410 RESTART
+     411 GRAB 3
+     413 CONST0
+     414 PUSHACC3
+     415 LTINT
+     416 BRANCHIF 427
+     418 ACC1
+     419 C_CALL1 ml_string_length
+     421 PUSHACC4
+     422 PUSHACC4
+     423 ADDINT
+     424 GTINT
+     425 BRANCHIFNOT 432
+     427 GETGLOBAL "really_input"
+     429 PUSHENVACC1
+     430 APPTERM1 5
+     432 ACC3
+     433 PUSHACC3
+     434 PUSHACC3
+     435 PUSHACC3
+     436 PUSHENVACC2
+     437 APPTERM 4, 8
+     440 RESTART
+     441 GRAB 3
+     443 CONST0
+     444 PUSHACC3
+     445 LTINT
+     446 BRANCHIF 457
+     448 ACC1
+     449 C_CALL1 ml_string_length
+     451 PUSHACC4
+     452 PUSHACC4
+     453 ADDINT
+     454 GTINT
+     455 BRANCHIFNOT 462
+     457 GETGLOBAL "input"
+     459 PUSHENVACC1
+     460 APPTERM1 5
+     462 ACC3
+     463 PUSHACC3
+     464 PUSHACC3
+     465 PUSHACC3
+     466 C_CALL4 caml_input
+     468 RETURN 4
+     470 ACC0
+     471 PUSHCONST0
+     472 PUSHGETGLOBAL <0>(0, <0>(6, 0))
+     474 PUSHENVACC1
+     475 APPTERM3 4
+     477 ACC0
+     478 PUSHCONST0
+     479 PUSHGETGLOBAL <0>(0, <0>(7, 0))
+     481 PUSHENVACC1
+     482 APPTERM3 4
+     484 RESTART
+     485 GRAB 2
+     487 ACC1
+     488 PUSHACC1
+     489 PUSHACC4
+     490 C_CALL3 sys_open
+     492 C_CALL1 caml_open_descriptor
+     494 RETURN 3
+     496 ACC0
+     497 C_CALL1 caml_flush
+     499 ACC0
+     500 C_CALL1 caml_close_channel
+     502 RETURN 1
+     504 RESTART
+     505 GRAB 1
+     507 CONST0
+     508 PUSHACC2
+     509 PUSHACC2
+     510 C_CALL3 output_value
+     512 RETURN 2
+     514 RESTART
+     515 GRAB 3
+     517 CONST0
+     518 PUSHACC3
+     519 LTINT
+     520 BRANCHIF 531
+     522 ACC1
+     523 C_CALL1 ml_string_length
+     525 PUSHACC4
+     526 PUSHACC4
+     527 ADDINT
+     528 GTINT
+     529 BRANCHIFNOT 536
+     531 GETGLOBAL "output"
+     533 PUSHENVACC1
+     534 APPTERM1 5
+     536 ACC3
+     537 PUSHACC3
+     538 PUSHACC3
+     539 PUSHACC3
+     540 C_CALL4 caml_output
+     542 RETURN 4
+     544 RESTART
+     545 GRAB 1
+     547 ACC1
+     548 C_CALL1 ml_string_length
+     550 PUSHCONST0
+     551 PUSHACC3
+     552 PUSHACC3
+     553 C_CALL4 caml_output
+     555 RETURN 2
+     557 ACC0
+     558 PUSHCONSTINT 438
+     560 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(6, 0))))
+     562 PUSHENVACC1
+     563 APPTERM3 4
+     565 ACC0
+     566 PUSHCONSTINT 438
+     568 PUSHGETGLOBAL <0>(1, <0>(3, <0>(4, <0>(7, 0))))
+     570 PUSHENVACC1
+     571 APPTERM3 4
+     573 RESTART
+     574 GRAB 2
+     576 ACC1
+     577 PUSHACC1
+     578 PUSHACC4
+     579 C_CALL3 sys_open
+     581 C_CALL1 caml_open_descriptor
+     583 RETURN 3
+     585 ACC0
+     586 PUSHGETGLOBAL "%.12g"
+     588 C_CALL2 format_float
+     590 RETURN 1
+     592 ACC0
+     593 PUSHGETGLOBAL "%d"
+     595 C_CALL2 format_int
+     597 RETURN 1
+     599 GETGLOBAL "false"
+     601 PUSHACC1
+     602 C_CALL2 string_equal
+     604 BRANCHIFNOT 609
+     606 CONST0
+     607 RETURN 1
+     609 GETGLOBAL "true"
+     611 PUSHACC1
+     612 C_CALL2 string_equal
+     614 BRANCHIFNOT 619
+     616 CONST1
+     617 RETURN 1
+     619 GETGLOBAL "bool_of_string"
+     621 PUSHENVACC1
+     622 APPTERM1 2
+     624 ACC0
+     625 BRANCHIFNOT 631
+     627 GETGLOBAL "true"
+     629 RETURN 1
+     631 GETGLOBAL "false"
+     633 RETURN 1
+     635 CONST0
+     636 PUSHACC1
+     637 LTINT
+     638 BRANCHIF 646
+     640 CONSTINT 255
+     642 PUSHACC1
+     643 GTINT
+     644 BRANCHIFNOT 651
+     646 GETGLOBAL "char_of_int"
+     648 PUSHENVACC1
+     649 APPTERM1 2
+     651 ACC0
+     652 RETURN 1
+     654 RESTART
+     655 GRAB 1
+     657 ACC0
+     658 C_CALL1 ml_string_length
+     660 PUSHACC2
+     661 C_CALL1 ml_string_length
+     663 PUSHACC0
+     664 PUSHACC2
+     665 ADDINT
+     666 C_CALL1 create_string
+     668 PUSHACC2
+     669 PUSHCONST0
+     670 PUSHACC2
+     671 PUSHCONST0
+     672 PUSHACC7
+     673 C_CALL5 blit_string
+     675 ACC1
+     676 PUSHACC3
+     677 PUSHACC2
+     678 PUSHCONST0
+     679 PUSHACC 8
+     681 C_CALL5 blit_string
+     683 ACC0
+     684 RETURN 5
+     686 CONSTINT -1
+     688 PUSHACC1
+     689 XORINT
+     690 RETURN 1
+     692 CONST0
+     693 PUSHACC1
+     694 GEINT
+     695 BRANCHIFNOT 700
+     697 ACC0
+     698 RETURN 1
+     700 ACC0
+     701 NEGINT
+     702 RETURN 1
+     704 RESTART
+     705 GRAB 1
+     707 ACC1
+     708 PUSHACC1
+     709 C_CALL2 greaterequal
+     711 BRANCHIFNOT 716
+     713 ACC0
+     714 RETURN 2
+     716 ACC1
+     717 RETURN 2
+     719 RESTART
+     720 GRAB 1
+     722 ACC1
+     723 PUSHACC1
+     724 C_CALL2 lessequal
+     726 BRANCHIFNOT 731
+     728 ACC0
+     729 RETURN 2
+     731 ACC1
+     732 RETURN 2
+     734 ACC0
+     735 PUSHGETGLOBAL Invalid_argument
+     737 MAKEBLOCK2 0
+     739 RAISE
+     740 ACC0
+     741 PUSHGETGLOBAL Failure
+     743 MAKEBLOCK2 0
+     745 RAISE
+     746 CLOSURE 0, 740
+     749 PUSH
+     750 CLOSURE 0, 734
+     753 PUSHGETGLOBAL "Pervasives.Exit"
+     755 MAKEBLOCK1 0
+     757 PUSHGETGLOBAL "Pervasives.Assert_failure"
+     759 MAKEBLOCK1 0
+     761 PUSH
+     762 CLOSURE 0, 720
+     765 PUSH
+     766 CLOSURE 0, 705
+     769 PUSH
+     770 CLOSURE 0, 692
+     773 PUSH
+     774 CLOSURE 0, 686
+     777 PUSHCONST0
+     778 PUSHCONSTINT 31
+     780 PUSHCONST1
+     781 LSLINT
+     782 EQ
+     783 BRANCHIFNOT 789
+     785 CONSTINT 30
+     787 BRANCH 791
+     789 CONSTINT 62
+     791 PUSHCONST1
+     792 LSLINT
+     793 PUSHACC0
+     794 OFFSETINT -1
+     796 PUSH
+     797 CLOSURE 0, 655
+     800 PUSHACC 9
+     802 CLOSURE 1, 635
+     805 PUSH
+     806 CLOSURE 0, 624
+     809 PUSHACC 11
+     811 CLOSURE 1, 599
+     814 PUSH
+     815 CLOSURE 0, 592
+     818 PUSH
+     819 CLOSURE 0, 585
+     822 PUSH
+     823 CLOSUREREC 0, 12
+     827 CONST0
+     828 C_CALL1 caml_open_descriptor
+     830 PUSHCONST1
+     831 C_CALL1 caml_open_descriptor
+     833 PUSHCONST2
+     834 C_CALL1 caml_open_descriptor
+     836 PUSH
+     837 CLOSURE 0, 574
+     840 PUSHACC0
+     841 CLOSURE 1, 565
+     844 PUSHACC1
+     845 CLOSURE 1, 557
+     848 PUSH
+     849 CLOSURE 0, 545
+     852 PUSHACC 22
+     854 CLOSURE 1, 515
+     857 PUSH
+     858 CLOSURE 0, 505
+     861 PUSH
+     862 CLOSURE 0, 496
+     865 PUSH
+     866 CLOSURE 0, 485
+     869 PUSHACC0
+     870 CLOSURE 1, 477
+     873 PUSHACC1
+     874 CLOSURE 1, 470
+     877 PUSHACC 28
+     879 CLOSURE 1, 441
+     882 PUSH
+     883 CLOSUREREC 0, 32
+     887 ACC0
+     888 PUSHACC 31
+     890 CLOSURE 2, 411
+     893 PUSHACC 22
+     895 CLOSUREREC 1, 70
+     899 ACC 15
+     901 CLOSURE 1, 404
+     904 PUSHACC 11
+     906 PUSHACC 17
+     908 CLOSURE 2, 399
+     911 PUSHACC 12
+     913 PUSHACC 18
+     915 PUSHACC 23
+     917 CLOSURE 3, 392
+     920 PUSHACC 13
+     922 PUSHACC 19
+     924 PUSHACC 23
+     926 CLOSURE 3, 385
+     929 PUSHACC 14
+     931 PUSHACC 20
+     933 CLOSURE 2, 374
+     936 PUSHACC 20
+     938 CLOSURE 1, 364
+     941 PUSHACC 20
+     943 CLOSURE 1, 358
+     946 PUSHACC 17
+     948 PUSHACC 22
+     950 CLOSURE 2, 353
+     953 PUSHACC 18
+     955 PUSHACC 23
+     957 PUSHACC 29
+     959 CLOSURE 3, 346
+     962 PUSHACC 19
+     964 PUSHACC 24
+     966 PUSHACC 29
+     968 CLOSURE 3, 339
+     971 PUSHACC 20
+     973 PUSHACC 25
+     975 CLOSURE 2, 325
+     978 PUSHACC 25
+     980 CLOSURE 1, 315
+     983 PUSHACC 12
+     985 PUSHACC 28
+     987 PUSHACC 30
+     989 CLOSURE 3, 308
+     992 PUSHACC0
+     993 CLOSURE 1, 301
+     996 PUSHACC1
+     997 CLOSURE 1, 294
+    1000 PUSHACC 29
+    1002 PUSHACC 31
+    1004 CLOSURE 2, 286
+    1007 MAKEBLOCK1 0
+    1009 PUSHACC0
+    1010 CLOSURE 1, 275
+    1013 PUSHACC1
+    1014 CLOSURE 1, 263
+    1017 PUSHACC0
+    1018 CLOSURE 1, 255
+    1021 PUSHACC1
+    1022 PUSHACC 22
+    1024 PUSHACC4
+    1025 PUSHACC3
+    1026 PUSH
+    1027 CLOSURE 0, 247
+    1030 PUSH
+    1031 CLOSURE 0, 241
+    1034 PUSH
+    1035 CLOSURE 0, 236
+    1038 PUSH
+    1039 CLOSURE 0, 231
+    1042 PUSH
+    1043 CLOSURE 0, 223
+    1046 PUSH
+    1047 CLOSURE 0, 217
+    1050 PUSH
+    1051 CLOSURE 0, 212
+    1054 PUSH
+    1055 CLOSURE 0, 207
+    1058 PUSHACC 32
+    1060 PUSHACC 35
+    1062 PUSHACC 33
+    1064 PUSH
+    1065 CLOSURE 0, 202
+    1068 PUSHACC 41
+    1070 PUSHACC 40
+    1072 PUSHACC 42
+    1074 PUSH
+    1075 CLOSURE 0, 194
+    1078 PUSHACC 46
+    1080 PUSH
+    1081 CLOSURE 0, 188
+    1084 PUSH
+    1085 CLOSURE 0, 183
+    1088 PUSH
+    1089 CLOSURE 0, 175
+    1092 PUSHACC 51
+    1094 PUSH
+    1095 CLOSURE 0, 166
+    1098 PUSH
+    1099 CLOSURE 0, 157
+    1102 PUSHACC 55
+    1104 PUSHACC 57
+    1106 PUSH
+    1107 CLOSURE 0, 148
+    1110 PUSH
+    1111 CLOSURE 0, 142
+    1114 PUSHACC 63
+    1116 PUSHACC 62
+    1118 PUSHACC 64
+    1120 PUSHACC 38
+    1122 PUSHACC 40
+    1124 PUSHACC 42
+    1126 PUSHACC 44
+    1128 PUSHACC 46
+    1130 PUSHACC 48
+    1132 PUSHACC 50
+    1134 PUSHACC 52
+    1136 PUSHACC 54
+    1138 PUSHACC 56
+    1140 PUSHACC 58
+    1142 PUSHACC 60
+    1144 PUSHACC 62
+    1146 PUSHACC 64
+    1148 PUSHACC 66
+    1150 PUSHACC 82
+    1152 PUSHACC 84
+    1154 PUSHACC 86
+    1156 PUSHACC 88
+    1158 PUSHACC 90
+    1160 PUSHACC 92
+    1162 PUSHACC 94
+    1164 PUSHACC 96
+    1166 PUSHACC 98
+    1168 PUSHACC 100
+    1170 PUSHACC 104
+    1172 PUSHACC 104
+    1174 PUSHACC 104
+    1176 PUSHACC 108
+    1178 PUSHACC 110
+    1180 PUSHACC 112
+    1182 PUSHACC 117
+    1184 PUSHACC 117
+    1186 PUSHACC 117
+    1188 PUSHACC 117
+    1190 MAKEBLOCK 69, 0
+    1193 POP 53
+    1195 SETGLOBAL Pervasives
+    1197 BRANCH 2177
+    1199 RESTART
+    1200 GRAB 1
+    1202 ACC1
+    1203 BRANCHIFNOT 1213
+    1205 ACC1
+    1206 GETFIELD1
+    1207 PUSHACC1
+    1208 OFFSETINT 1
+    1210 PUSHOFFSETCLOSURE0
+    1211 APPTERM2 4
+    1213 ACC0
+    1214 RETURN 2
+    1216 RESTART
+    1217 GRAB 1
+    1219 ACC0
+    1220 BRANCHIFNOT 1251
+    1222 CONST0
+    1223 PUSHACC2
+    1224 EQ
+    1225 BRANCHIFNOT 1231
+    1227 ACC0
+    1228 GETFIELD0
+    1229 RETURN 2
+    1231 CONST0
+    1232 PUSHACC2
+    1233 GTINT
+    1234 BRANCHIFNOT 1244
+    1236 ACC1
+    1237 OFFSETINT -1
+    1239 PUSHACC1
+    1240 GETFIELD1
+    1241 PUSHOFFSETCLOSURE0
+    1242 APPTERM2 4
+    1244 GETGLOBAL "List.nth"
+    1246 PUSHGETGLOBALFIELD Pervasives, 2
+    1249 APPTERM1 3
+    1251 GETGLOBAL "nth"
+    1253 PUSHGETGLOBALFIELD Pervasives, 3
+    1256 APPTERM1 3
+    1258 RESTART
+    1259 GRAB 1
+    1261 ACC0
+    1262 BRANCHIFNOT 1274
+    1264 ACC1
+    1265 PUSHACC1
+    1266 GETFIELD0
+    1267 MAKEBLOCK2 0
+    1269 PUSHACC1
+    1270 GETFIELD1
+    1271 PUSHOFFSETCLOSURE0
+    1272 APPTERM2 4
+    1274 ACC1
+    1275 RETURN 2
+    1277 ACC0
+    1278 BRANCHIFNOT 1291
+    1280 ACC0
+    1281 GETFIELD1
+    1282 PUSHOFFSETCLOSURE0
+    1283 APPLY1
+    1284 PUSHACC1
+    1285 GETFIELD0
+    1286 PUSHGETGLOBALFIELD Pervasives, 16
+    1289 APPTERM2 3
+    1291 RETURN 1
+    1293 RESTART
+    1294 GRAB 1
+    1296 ACC1
+    1297 BRANCHIFNOT 1313
+    1299 ACC1
+    1300 GETFIELD0
+    1301 PUSHACC1
+    1302 APPLY1
+    1303 PUSHACC2
+    1304 GETFIELD1
+    1305 PUSHACC2
+    1306 PUSHOFFSETCLOSURE0
+    1307 APPLY2
+    1308 PUSHACC1
+    1309 MAKEBLOCK2 0
+    1311 POP 1
+    1313 RETURN 2
+    1315 RESTART
+    1316 GRAB 1
+    1318 ACC1
+    1319 BRANCHIFNOT 1331
+    1321 ACC1
+    1322 GETFIELD0
+    1323 PUSHACC1
+    1324 APPLY1
+    1325 ACC1
+    1326 GETFIELD1
+    1327 PUSHACC1
+    1328 PUSHOFFSETCLOSURE0
+    1329 APPTERM2 4
+    1331 RETURN 2
+    1333 RESTART
+    1334 GRAB 2
+    1336 ACC2
+    1337 BRANCHIFNOT 1350
+    1339 ACC2
+    1340 GETFIELD1
+    1341 PUSHACC3
+    1342 GETFIELD0
+    1343 PUSHACC3
+    1344 PUSHACC3
+    1345 APPLY2
+    1346 PUSHACC2
+    1347 PUSHOFFSETCLOSURE0
+    1348 APPTERM3 6
+    1350 ACC1
+    1351 RETURN 3
+    1353 RESTART
+    1354 GRAB 2
+    1356 ACC1
+    1357 BRANCHIFNOT 1370
+    1359 ACC2
+    1360 PUSHACC2
+    1361 GETFIELD1
+    1362 PUSHACC2
+    1363 PUSHOFFSETCLOSURE0
+    1364 APPLY3
+    1365 PUSHACC2
+    1366 GETFIELD0
+    1367 PUSHACC2
+    1368 APPTERM2 5
+    1370 ACC2
+    1371 RETURN 3
+    1373 RESTART
+    1374 GRAB 2
+    1376 ACC1
+    1377 BRANCHIFNOT 1400
+    1379 ACC2
+    1380 BRANCHIFNOT 1407
+    1382 ACC2
+    1383 GETFIELD0
+    1384 PUSHACC2
+    1385 GETFIELD0
+    1386 PUSHACC2
+    1387 APPLY2
+    1388 PUSHACC3
+    1389 GETFIELD1
+    1390 PUSHACC3
+    1391 GETFIELD1
+    1392 PUSHACC3
+    1393 PUSHOFFSETCLOSURE0
+    1394 APPLY3
+    1395 PUSHACC1
+    1396 MAKEBLOCK2 0
+    1398 RETURN 4
+    1400 ACC2
+    1401 BRANCHIFNOT 1405
+    1403 BRANCH 1407
+    1405 RETURN 3
+    1407 GETGLOBAL "List.map2"
+    1409 PUSHGETGLOBALFIELD Pervasives, 2
+    1412 APPTERM1 4
+    1414 RESTART
+    1415 GRAB 2
+    1417 ACC1
+    1418 BRANCHIFNOT 1437
+    1420 ACC2
+    1421 BRANCHIFNOT 1444
+    1423 ACC2
+    1424 GETFIELD0
+    1425 PUSHACC2
+    1426 GETFIELD0
+    1427 PUSHACC2
+    1428 APPLY2
+    1429 ACC2
+    1430 GETFIELD1
+    1431 PUSHACC2
+    1432 GETFIELD1
+    1433 PUSHACC2
+    1434 PUSHOFFSETCLOSURE0
+    1435 APPTERM3 6
+    1437 ACC2
+    1438 BRANCHIFNOT 1442
+    1440 BRANCH 1444
+    1442 RETURN 3
+    1444 GETGLOBAL "List.iter2"
+    1446 PUSHGETGLOBALFIELD Pervasives, 2
+    1449 APPTERM1 4
+    1451 RESTART
+    1452 GRAB 3
+    1454 ACC2
+    1455 BRANCHIFNOT 1476
+    1457 ACC3
+    1458 BRANCHIFNOT 1482
+    1460 ACC3
+    1461 GETFIELD1
+    1462 PUSHACC3
+    1463 GETFIELD1
+    1464 PUSHACC5
+    1465 GETFIELD0
+    1466 PUSHACC5
+    1467 GETFIELD0
+    1468 PUSHACC5
+    1469 PUSHACC5
+    1470 APPLY3
+    1471 PUSHACC3
+    1472 PUSHOFFSETCLOSURE0
+    1473 APPTERM 4, 8
+    1476 ACC3
+    1477 BRANCHIF 1482
+    1479 ACC1
+    1480 RETURN 4
+    1482 GETGLOBAL "List.fold_left2"
+    1484 PUSHGETGLOBALFIELD Pervasives, 2
+    1487 APPTERM1 5
+    1489 RESTART
+    1490 GRAB 3
+    1492 ACC1
+    1493 BRANCHIFNOT 1516
+    1495 ACC2
+    1496 BRANCHIFNOT 1522
+    1498 PUSH_RETADDR 1509
+    1500 ACC6
+    1501 PUSHACC6
+    1502 GETFIELD1
+    1503 PUSHACC6
+    1504 GETFIELD1
+    1505 PUSHACC6
+    1506 PUSHOFFSETCLOSURE0
+    1507 APPLY 4
+    1509 PUSHACC3
+    1510 GETFIELD0
+    1511 PUSHACC3
+    1512 GETFIELD0
+    1513 PUSHACC3
+    1514 APPTERM3 7
+    1516 ACC2
+    1517 BRANCHIF 1522
+    1519 ACC3
+    1520 RETURN 4
+    1522 GETGLOBAL "List.fold_right2"
+    1524 PUSHGETGLOBALFIELD Pervasives, 2
+    1527 APPTERM1 5
+    1529 RESTART
+    1530 GRAB 1
+    1532 ACC1
+    1533 BRANCHIFNOT 1549
+    1535 ACC1
+    1536 GETFIELD0
+    1537 PUSHACC1
+    1538 APPLY1
+    1539 BRANCHIFNOT 1547
+    1541 ACC1
+    1542 GETFIELD1
+    1543 PUSHACC1
+    1544 PUSHOFFSETCLOSURE0
+    1545 APPTERM2 4
+    1547 RETURN 2
+    1549 CONST1
+    1550 RETURN 2
+    1552 RESTART
+    1553 GRAB 1
+    1555 ACC1
+    1556 BRANCHIFNOT 1570
+    1558 ACC1
+    1559 GETFIELD0
+    1560 PUSHACC1
+    1561 APPLY1
+    1562 BRANCHIF 1570
+    1564 ACC1
+    1565 GETFIELD1
+    1566 PUSHACC1
+    1567 PUSHOFFSETCLOSURE0
+    1568 APPTERM2 4
+    1570 RETURN 2
+    1572 RESTART
+    1573 GRAB 2
+    1575 ACC1
+    1576 BRANCHIFNOT 1599
+    1578 ACC2
+    1579 BRANCHIFNOT 1605
+    1581 ACC2
+    1582 GETFIELD0
+    1583 PUSHACC2
+    1584 GETFIELD0
+    1585 PUSHACC2
+    1586 APPLY2
+    1587 BRANCHIFNOT 1597
+    1589 ACC2
+    1590 GETFIELD1
+    1591 PUSHACC2
+    1592 GETFIELD1
+    1593 PUSHACC2
+    1594 PUSHOFFSETCLOSURE0
+    1595 APPTERM3 6
+    1597 RETURN 3
+    1599 ACC2
+    1600 BRANCHIF 1605
+    1602 CONST1
+    1603 RETURN 3
+    1605 GETGLOBAL "List.for_all2"
+    1607 PUSHGETGLOBALFIELD Pervasives, 2
+    1610 APPTERM1 4
+    1612 RESTART
+    1613 GRAB 2
+    1615 ACC1
+    1616 BRANCHIFNOT 1639
+    1618 ACC2
+    1619 BRANCHIFNOT 1646
+    1621 ACC2
+    1622 GETFIELD0
+    1623 PUSHACC2
+    1624 GETFIELD0
+    1625 PUSHACC2
+    1626 APPLY2
+    1627 BRANCHIF 1637
+    1629 ACC2
+    1630 GETFIELD1
+    1631 PUSHACC2
+    1632 GETFIELD1
+    1633 PUSHACC2
+    1634 PUSHOFFSETCLOSURE0
+    1635 APPTERM3 6
+    1637 RETURN 3
+    1639 ACC2
+    1640 BRANCHIFNOT 1644
+    1642 BRANCH 1646
+    1644 RETURN 3
+    1646 GETGLOBAL "List.exists2"
+    1648 PUSHGETGLOBALFIELD Pervasives, 2
+    1651 APPTERM1 4
+    1653 RESTART
+    1654 GRAB 1
+    1656 ACC1
+    1657 BRANCHIFNOT 1672
+    1659 ACC0
+    1660 PUSHACC2
+    1661 GETFIELD0
+    1662 C_CALL2 equal
+    1664 BRANCHIF 1672
+    1666 ACC1
+    1667 GETFIELD1
+    1668 PUSHACC1
+    1669 PUSHOFFSETCLOSURE0
+    1670 APPTERM2 4
+    1672 RETURN 2
+    1674 RESTART
+    1675 GRAB 1
+    1677 ACC1
+    1678 BRANCHIFNOT 1692
+    1680 ACC0
+    1681 PUSHACC2
+    1682 GETFIELD0
+    1683 EQ
+    1684 BRANCHIF 1692
+    1686 ACC1
+    1687 GETFIELD1
+    1688 PUSHACC1
+    1689 PUSHOFFSETCLOSURE0
+    1690 APPTERM2 4
+    1692 RETURN 2
+    1694 RESTART
+    1695 GRAB 1
+    1697 ACC1
+    1698 BRANCHIFNOT 1719
+    1700 ACC1
+    1701 GETFIELD0
+    1702 PUSHACC1
+    1703 PUSHACC1
+    1704 GETFIELD0
+    1705 C_CALL2 equal
+    1707 BRANCHIFNOT 1713
+    1709 ACC0
+    1710 GETFIELD1
+    1711 RETURN 3
+    1713 ACC2
+    1714 GETFIELD1
+    1715 PUSHACC2
+    1716 PUSHOFFSETCLOSURE0
+    1717 APPTERM2 5
+    1719 GETGLOBAL Not_found
+    1721 MAKEBLOCK1 0
+    1723 RAISE
+    1724 RESTART
+    1725 GRAB 1
+    1727 ACC1
+    1728 BRANCHIFNOT 1748
+    1730 ACC1
+    1731 GETFIELD0
+    1732 PUSHACC1
+    1733 PUSHACC1
+    1734 GETFIELD0
+    1735 EQ
+    1736 BRANCHIFNOT 1742
+    1738 ACC0
+    1739 GETFIELD1
+    1740 RETURN 3
+    1742 ACC2
+    1743 GETFIELD1
+    1744 PUSHACC2
+    1745 PUSHOFFSETCLOSURE0
+    1746 APPTERM2 5
+    1748 GETGLOBAL Not_found
+    1750 MAKEBLOCK1 0
+    1752 RAISE
+    1753 RESTART
+    1754 GRAB 1
+    1756 ACC1
+    1757 BRANCHIFNOT 1773
+    1759 ACC0
+    1760 PUSHACC2
+    1761 GETFIELD0
+    1762 GETFIELD0
+    1763 C_CALL2 equal
+    1765 BRANCHIF 1773
+    1767 ACC1
+    1768 GETFIELD1
+    1769 PUSHACC1
+    1770 PUSHOFFSETCLOSURE0
+    1771 APPTERM2 4
+    1773 RETURN 2
+    1775 RESTART
+    1776 GRAB 1
+    1778 ACC1
+    1779 BRANCHIFNOT 1794
+    1781 ACC0
+    1782 PUSHACC2
+    1783 GETFIELD0
+    1784 GETFIELD0
+    1785 EQ
+    1786 BRANCHIF 1794
+    1788 ACC1
+    1789 GETFIELD1
+    1790 PUSHACC1
+    1791 PUSHOFFSETCLOSURE0
+    1792 APPTERM2 4
+    1794 RETURN 2
+    1796 RESTART
+    1797 GRAB 1
+    1799 ACC1
+    1800 BRANCHIFNOT 1825
+    1802 ACC1
+    1803 GETFIELD0
+    1804 PUSHACC2
+    1805 GETFIELD1
+    1806 PUSHACC2
+    1807 PUSHACC2
+    1808 GETFIELD0
+    1809 C_CALL2 equal
+    1811 BRANCHIFNOT 1816
+    1813 ACC0
+    1814 RETURN 4
+    1816 ACC0
+    1817 PUSHACC3
+    1818 PUSHOFFSETCLOSURE0
+    1819 APPLY2
+    1820 PUSHACC2
+    1821 MAKEBLOCK2 0
+    1823 POP 2
+    1825 RETURN 2
+    1827 RESTART
+    1828 GRAB 1
+    1830 ACC1
+    1831 BRANCHIFNOT 1855
+    1833 ACC1
+    1834 GETFIELD0
+    1835 PUSHACC2
+    1836 GETFIELD1
+    1837 PUSHACC2
+    1838 PUSHACC2
+    1839 GETFIELD0
+    1840 EQ
+    1841 BRANCHIFNOT 1846
+    1843 ACC0
+    1844 RETURN 4
+    1846 ACC0
+    1847 PUSHACC3
+    1848 PUSHOFFSETCLOSURE0
+    1849 APPLY2
+    1850 PUSHACC2
+    1851 MAKEBLOCK2 0
+    1853 POP 2
+    1855 RETURN 2
+    1857 RESTART
+    1858 GRAB 1
+    1860 ACC1
+    1861 BRANCHIFNOT 1879
+    1863 ACC1
+    1864 GETFIELD0
+    1865 PUSHACC0
+    1866 PUSHACC2
+    1867 APPLY1
+    1868 BRANCHIFNOT 1873
+    1870 ACC0
+    1871 RETURN 3
+    1873 ACC2
+    1874 GETFIELD1
+    1875 PUSHACC2
+    1876 PUSHOFFSETCLOSURE0
+    1877 APPTERM2 5
+    1879 GETGLOBAL Not_found
+    1881 MAKEBLOCK1 0
+    1883 RAISE
+    1884 RESTART
+    1885 GRAB 2
+    1887 ACC2
+    1888 BRANCHIFNOT 1917
+    1890 ACC2
+    1891 GETFIELD0
+    1892 PUSHACC3
+    1893 GETFIELD1
+    1894 PUSHACC1
+    1895 PUSHENVACC2
+    1896 APPLY1
+    1897 BRANCHIFNOT 1908
+    1899 ACC0
+    1900 PUSHACC4
+    1901 PUSHACC4
+    1902 PUSHACC4
+    1903 MAKEBLOCK2 0
+    1905 PUSHOFFSETCLOSURE0
+    1906 APPTERM3 8
+    1908 ACC0
+    1909 PUSHACC4
+    1910 PUSHACC3
+    1911 MAKEBLOCK2 0
+    1913 PUSHACC4
+    1914 PUSHOFFSETCLOSURE0
+    1915 APPTERM3 8
+    1917 ACC1
+    1918 PUSHENVACC1
+    1919 APPLY1
+    1920 PUSHACC1
+    1921 PUSHENVACC1
+    1922 APPLY1
+    1923 MAKEBLOCK2 0
+    1925 RETURN 3
+    1927 RESTART
+    1928 GRAB 1
+    1930 ACC0
+    1931 PUSHENVACC1
+    1932 CLOSUREREC 2, 1885
+    1936 ACC2
+    1937 PUSHCONST0
+    1938 PUSHCONST0
+    1939 PUSHACC3
+    1940 APPTERM3 6
+    1942 ACC0
+    1943 BRANCHIFNOT 1967
+    1945 ACC0
+    1946 GETFIELD0
+    1947 PUSHACC1
+    1948 GETFIELD1
+    1949 PUSHOFFSETCLOSURE0
+    1950 APPLY1
+    1951 PUSHACC0
+    1952 GETFIELD1
+    1953 PUSHACC2
+    1954 GETFIELD1
+    1955 MAKEBLOCK2 0
+    1957 PUSHACC1
+    1958 GETFIELD0
+    1959 PUSHACC3
+    1960 GETFIELD0
+    1961 MAKEBLOCK2 0
+    1963 MAKEBLOCK2 0
+    1965 RETURN 3
+    1967 GETGLOBAL <0>(0, 0)
+    1969 RETURN 1
+    1971 RESTART
+    1972 GRAB 1
+    1974 ACC0
+    1975 BRANCHIFNOT 1996
+    1977 ACC1
+    1978 BRANCHIFNOT 2003
+    1980 ACC1
+    1981 GETFIELD1
+    1982 PUSHACC1
+    1983 GETFIELD1
+    1984 PUSHOFFSETCLOSURE0
+    1985 APPLY2
+    1986 PUSHACC2
+    1987 GETFIELD0
+    1988 PUSHACC2
+    1989 GETFIELD0
+    1990 MAKEBLOCK2 0
+    1992 MAKEBLOCK2 0
+    1994 RETURN 2
+    1996 ACC1
+    1997 BRANCHIFNOT 2001
+    1999 BRANCH 2003
+    2001 RETURN 2
+    2003 GETGLOBAL "List.combine"
+    2005 PUSHGETGLOBALFIELD Pervasives, 2
+    2008 APPTERM1 3
+    2010 RESTART
+    2011 GRAB 1
+    2013 ACC1
+    2014 BRANCHIFNOT 2038
+    2016 ACC1
+    2017 GETFIELD0
+    2018 PUSHACC2
+    2019 GETFIELD1
+    2020 PUSHACC1
+    2021 PUSHENVACC2
+    2022 APPLY1
+    2023 BRANCHIFNOT 2033
+    2025 ACC0
+    2026 PUSHACC3
+    2027 PUSHACC3
+    2028 MAKEBLOCK2 0
+    2030 PUSHOFFSETCLOSURE0
+    2031 APPTERM2 6
+    2033 ACC0
+    2034 PUSHACC3
+    2035 PUSHOFFSETCLOSURE0
+    2036 APPTERM2 6
+    2038 ACC0
+    2039 PUSHENVACC1
+    2040 APPTERM1 3
+    2042 ACC0
+    2043 PUSHENVACC1
+    2044 CLOSUREREC 2, 2011
+    2048 CONST0
+    2049 PUSHACC1
+    2050 APPTERM1 3
+    2052 RESTART
+    2053 GRAB 2
+    2055 ACC1
+    2056 BRANCHIFNOT 2077
+    2058 ACC2
+    2059 BRANCHIFNOT 2084
+    2061 ACC2
+    2062 GETFIELD1
+    2063 PUSHACC2
+    2064 GETFIELD1
+    2065 PUSHACC2
+    2066 PUSHACC5
+    2067 GETFIELD0
+    2068 PUSHACC5
+    2069 GETFIELD0
+    2070 PUSHENVACC1
+    2071 APPLY2
+    2072 MAKEBLOCK2 0
+    2074 PUSHOFFSETCLOSURE0
+    2075 APPTERM3 6
+    2077 ACC2
+    2078 BRANCHIFNOT 2082
+    2080 BRANCH 2084
+    2082 RETURN 3
+    2084 GETGLOBAL "List.rev_map2"
+    2086 PUSHGETGLOBALFIELD Pervasives, 2
+    2089 APPTERM1 4
+    2091 RESTART
+    2092 GRAB 2
+    2094 ACC0
+    2095 CLOSUREREC 1, 2053
+    2099 ACC3
+    2100 PUSHACC3
+    2101 PUSHCONST0
+    2102 PUSHACC3
+    2103 APPTERM3 7
+    2105 RESTART
+    2106 GRAB 1
+    2108 ACC1
+    2109 BRANCHIFNOT 2123
+    2111 ACC1
+    2112 GETFIELD1
+    2113 PUSHACC1
+    2114 PUSHACC3
+    2115 GETFIELD0
+    2116 PUSHENVACC1
+    2117 APPLY1
+    2118 MAKEBLOCK2 0
+    2120 PUSHOFFSETCLOSURE0
+    2121 APPTERM2 4
+    2123 ACC0
+    2124 RETURN 2
+    2126 RESTART
+    2127 GRAB 1
+    2129 ACC0
+    2130 CLOSUREREC 1, 2106
+    2134 ACC2
+    2135 PUSHCONST0
+    2136 PUSHACC2
+    2137 APPTERM2 5
+    2139 CONST0
+    2140 PUSHACC1
+    2141 PUSHENVACC1
+    2142 APPTERM2 3
+    2144 ACC0
+    2145 BRANCHIFNOT 2151
+    2147 ACC0
+    2148 GETFIELD1
+    2149 RETURN 1
+    2151 GETGLOBAL "tl"
+    2153 PUSHGETGLOBALFIELD Pervasives, 3
+    2156 APPTERM1 2
+    2158 ACC0
+    2159 BRANCHIFNOT 2165
+    2161 ACC0
+    2162 GETFIELD0
+    2163 RETURN 1
+    2165 GETGLOBAL "hd"
+    2167 PUSHGETGLOBALFIELD Pervasives, 3
+    2170 APPTERM1 2
+    2172 ACC0
+    2173 PUSHCONST0
+    2174 PUSHENVACC1
+    2175 APPTERM2 3
+    2177 CLOSUREREC 0, 1200
+    2181 ACC0
+    2182 CLOSURE 1, 2172
+    2185 PUSH
+    2186 CLOSURE 0, 2158
+    2189 PUSH
+    2190 CLOSURE 0, 2144
+    2193 PUSH
+    2194 CLOSUREREC 0, 1217
+    2198 GETGLOBALFIELD Pervasives, 16
+    2201 PUSH
+    2202 CLOSUREREC 0, 1259
+    2206 ACC0
+    2207 CLOSURE 1, 2139
+    2210 PUSH
+    2211 CLOSUREREC 0, 1277
+    2215 CLOSUREREC 0, 1294
+    2219 CLOSURE 0, 2127
+    2222 PUSH
+    2223 CLOSUREREC 0, 1316
+    2227 CLOSUREREC 0, 1334
+    2231 CLOSUREREC 0, 1354
+    2235 CLOSUREREC 0, 1374
+    2239 CLOSURE 0, 2092
+    2242 PUSH
+    2243 CLOSUREREC 0, 1415
+    2247 CLOSUREREC 0, 1452
+    2251 CLOSUREREC 0, 1490
+    2255 CLOSUREREC 0, 1530
+    2259 CLOSUREREC 0, 1553
+    2263 CLOSUREREC 0, 1573
+    2267 CLOSUREREC 0, 1613
+    2271 CLOSUREREC 0, 1654
+    2275 CLOSUREREC 0, 1675
+    2279 CLOSUREREC 0, 1695
+    2283 CLOSUREREC 0, 1725
+    2287 CLOSUREREC 0, 1754
+    2291 CLOSUREREC 0, 1776
+    2295 CLOSUREREC 0, 1797
+    2299 CLOSUREREC 0, 1828
+    2303 CLOSUREREC 0, 1858
+    2307 ACC 24
+    2309 CLOSURE 1, 2042
+    2312 PUSHACC 25
+    2314 CLOSUREREC 1, 1928
+    2318 CLOSUREREC 0, 1942
+    2322 CLOSUREREC 0, 1972
+    2326 ACC0
+    2327 PUSHACC2
+    2328 PUSHACC7
+    2329 PUSHACC 9
+    2331 PUSHACC 11
+    2333 PUSHACC 13
+    2335 PUSHACC 15
+    2337 PUSHACC 17
+    2339 PUSHACC 10
+    2341 PUSHACC 12
+    2343 PUSHACC 13
+    2345 PUSHACC 15
+    2347 PUSHACC 23
+    2349 PUSHACC 25
+    2351 PUSHACC 27
+    2353 PUSHACC 29
+    2355 PUSHACC 31
+    2357 PUSHACC 33
+    2359 PUSHACC 35
+    2361 PUSHACC 37
+    2363 PUSHACC 40
+    2365 PUSHACC 42
+    2367 PUSHACC 41
+    2369 PUSHACC 45
+    2371 PUSHACC 47
+    2373 PUSHACC 50
+    2375 PUSHACC 52
+    2377 PUSHACC 51
+    2379 PUSHACC 55
+    2381 PUSHACC 56
+    2383 PUSHACC 59
+    2385 PUSHACC 61
+    2387 PUSHACC 60
+    2389 PUSHACC 64
+    2391 PUSHACC 66
+    2393 PUSHACC 68
+    2395 PUSHACC 70
+    2397 MAKEBLOCK 37, 0
+    2400 POP 36
+    2402 SETGLOBAL List
+    2404 BRANCH 2432
+    2406 CONST0
+    2407 PUSHACC1
+    2408 LEINT
+    2409 BRANCHIFNOT 2414
+    2411 CONST0
+    2412 RETURN 1
+    2414 ACC0
+    2415 OFFSETINT -1
+    2417 PUSHOFFSETCLOSURE0
+    2418 APPLY1
+    2419 PUSHACC1
+    2420 MAKEBLOCK2 0
+    2422 RETURN 1
+    2424 RESTART
+    2425 GRAB 1
+    2427 ACC1
+    2428 PUSHACC1
+    2429 ADDINT
+    2430 RETURN 2
+    2432 CLOSUREREC 0, 2406
+    2436 CONST0
+    2437 C_CALL1 gc_compaction
+    2439 CONSTINT 300
+    2441 PUSHACC1
+    2442 APPLY1
+    2443 PUSHCONSTINT 150
+    2445 PUSHCONSTINT 301
+    2447 MULINT
+    2448 PUSHACC1
+    2449 PUSHCONST0
+    2450 PUSH
+    2451 CLOSURE 0, 2425
+    2454 PUSHGETGLOBALFIELD List, 12
+    2457 APPLY3
+    2458 NEQ
+    2459 BRANCHIFNOT 2466
+    2461 GETGLOBAL Not_found
+    2463 MAKEBLOCK1 0
+    2465 RAISE
+    2466 POP 2
+    2468 ATOM0
+    2469 SETGLOBAL T330-compact-4
+    2471 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t340-weak.ml b/testsuite/tests/tool-ocaml/t340-weak.ml
new file mode 100644
index 00000000..7478483f
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t340-weak.ml
@@ -0,0 +1,32 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let x = Array.make 20 "" in
+let w = weak_create 20 in
+for i = 0 to 19 do
+  x.(i) <- String.make 20 's';
+  weak_set w i (Some x.(i));
+done;
+Gc.full_major ();
+for i = 0 to 19 do
+  match weak_get w i with
+  | None -> raise Not_found
+  | _ -> ()
+done;
+for i = 0 to 19 do
+  if i mod 2 = 0 then x.(i) <- ""
+done;
+Gc.full_major ();
+for i = 0 to 19 do
+  match weak_get w i with
+  | None when i mod 2 = 0 -> ()
+  | Some s when i mod 2 = 1 -> if s.[5] <> 's' then raise Not_found
+  | _ -> raise Not_found
+done
+;;
diff --git a/testsuite/tests/tool-ocaml/t350-heapcheck.ml b/testsuite/tests/tool-ocaml/t350-heapcheck.ml
new file mode 100644
index 00000000..6eca59a5
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t350-heapcheck.ml
@@ -0,0 +1,33 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+ignore (Gc.stat ());
+let x = Array.make 20 "" in
+let w = weak_create 20 in
+for i = 0 to 19 do
+  x.(i) <- String.make 20 's';
+  weak_set w i (Some x.(i));
+done;
+Gc.full_major ();
+for i = 0 to 19 do
+  match weak_get w i with
+  | None -> raise Not_found
+  | _ -> ()
+done;
+for i = 0 to 19 do
+  if i mod 2 = 0 then x.(i) <- ""
+done;
+Gc.full_major ();
+for i = 0 to 19 do
+  match weak_get w i with
+  | None when i mod 2 = 0 -> ()
+  | Some s when i mod 2 = 1 -> if s.[5] <> 's' then raise Not_found
+  | _ -> raise Not_found
+done
+;;
diff --git a/testsuite/tests/tool-ocaml/t360-stacks-1.ml b/testsuite/tests/tool-ocaml/t360-stacks-1.ml
new file mode 100644
index 00000000..965f4992
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t360-stacks-1.ml
@@ -0,0 +1,51 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f n =
+  if n <= 0 then 12
+  else 1 + f (n-1)
+in
+if f 30000 <> 30012 then raise Not_found
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 29
+      11 CONST0
+      12 PUSHACC1
+      13 LEINT
+      14 BRANCHIFNOT 20
+      16 CONSTINT 12
+      18 RETURN 1
+      20 ACC0
+      21 OFFSETINT -1
+      23 PUSHOFFSETCLOSURE0
+      24 APPLY1
+      25 PUSHCONST1
+      26 ADDINT
+      27 RETURN 1
+      29 CLOSUREREC 0, 11
+      33 CONSTINT 30012
+      35 PUSHCONSTINT 30000
+      37 PUSHACC2
+      38 APPLY1
+      39 NEQ
+      40 BRANCHIFNOT 47
+      42 GETGLOBAL Not_found
+      44 MAKEBLOCK1 0
+      46 RAISE
+      47 POP 1
+      49 ATOM0
+      50 SETGLOBAL T360-stacks-1
+      52 STOP
+**)
diff --git a/testsuite/tests/tool-ocaml/t360-stacks-2.ml b/testsuite/tests/tool-ocaml/t360-stacks-2.ml
new file mode 100644
index 00000000..016cc0db
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/t360-stacks-2.ml
@@ -0,0 +1,62 @@
+(* TEST
+include tool-ocaml-lib
+flags = "-w a"
+ocaml_script_as_argument = "true"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+open Lib;;
+let rec f n =
+  if n <= 0 then 12
+  else 1 + f (n-1)
+in
+try
+  ignore (f 3000000);
+  raise Not_found
+with Stack_overflow -> ()
+;;
+
+(**
+       0 CONSTINT 42
+       2 PUSHACC0
+       3 MAKEBLOCK1 0
+       5 POP 1
+       7 SETGLOBAL Lib
+       9 BRANCH 29
+      11 CONST0
+      12 PUSHACC1
+      13 LEINT
+      14 BRANCHIFNOT 20
+      16 CONSTINT 12
+      18 RETURN 1
+      20 ACC0
+      21 OFFSETINT -1
+      23 PUSHOFFSETCLOSURE0
+      24 APPLY1
+      25 PUSHCONST1
+      26 ADDINT
+      27 RETURN 1
+      29 CLOSUREREC 0, 11
+      33 PUSHTRAP 44
+      35 CONSTINT 3000000
+      37 PUSHACC5
+      38 APPLY1
+      39 GETGLOBAL Not_found
+      41 MAKEBLOCK1 0
+      43 RAISE
+      44 PUSHGETGLOBAL Stack_overflow
+      46 PUSHACC1
+      47 GETFIELD0
+      48 EQ
+      49 BRANCHIFNOT 54
+      51 CONST0
+      52 BRANCH 56
+      54 ACC0
+      55 RAISE
+      56 POP 1
+      58 POP 1
+      60 ATOM0
+      61 SETGLOBAL T360-stacks-2
+      63 STOP
+**)
diff --git a/testsuite/tests/tool-ocamlc-compat32/compat32.compilers.reference b/testsuite/tests/tool-ocamlc-compat32/compat32.compilers.reference
new file mode 100644
index 00000000..0f74c728
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-compat32/compat32.compilers.reference
@@ -0,0 +1,6 @@
+File "compat32.ml", line 1:
+Error: Generated bytecode unit "compat32.cmo" cannot be used on a 32-bit platform
+File "_none_", line 1:
+Error: Generated bytecode library "compat32.cma" cannot be used on a 32-bit platform
+File "_none_", line 1:
+Error: Generated bytecode executable "compat32.byte" cannot be used on a 32-bit platform
diff --git a/testsuite/tests/tool-ocamlc-compat32/compat32.ml b/testsuite/tests/tool-ocamlc-compat32/compat32.ml
new file mode 100644
index 00000000..8b09d8ab
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-compat32/compat32.ml
@@ -0,0 +1,29 @@
+(* TEST
+   * arch64
+   ** setup-ocamlc.byte-build-env
+   *** ocamlc.byte
+       compile_only = "true"
+       flags = "-compat-32"
+       ocamlc_byte_exit_status = "2"
+   **** ocamlc.byte
+        ocamlc_byte_exit_status = "0"
+        flags = ""
+   ***** ocamlc.byte
+         compile_only = "false"
+         all_modules = "compat32.cmo"
+         flags = "-compat-32 -a"
+         program = "compat32.cma"
+         ocamlc_byte_exit_status = "2"
+   ****** ocamlc.byte
+          flags = "-a"
+          program = "compat32.cma"
+          ocamlc_byte_exit_status = "0"
+   ******* ocamlc.byte
+           all_modules = "compat32.cma"
+           flags = "-compat-32 -linkall"
+           program = "compat32.byte"
+           ocamlc_byte_exit_status = "2"
+   ******** check-ocamlc.byte-output
+*)
+
+let a = 0xffffffffffff
diff --git a/testsuite/tests/tool-ocamlc-error-cleanup/check-error-cleanup.sh b/testsuite/tests/tool-ocamlc-error-cleanup/check-error-cleanup.sh
new file mode 100644
index 00000000..c70bee7b
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-error-cleanup/check-error-cleanup.sh
@@ -0,0 +1,6 @@
+if [ -f test.cmo ]
+then
+    exit ${TEST_FAIL}
+else
+    exit ${TEST_PASS}
+fi
diff --git a/testsuite/tests/tool-ocamlc-error-cleanup/test.ml b/testsuite/tests/tool-ocamlc-error-cleanup/test.ml
new file mode 100644
index 00000000..b0013bd8
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-error-cleanup/test.ml
@@ -0,0 +1,16 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+compiler_output = "compiler-output.raw"
+** ocamlc.byte
+all_modules = "test.ml"
+flags = "-warn-error A"
+ocamlc_byte_exit_status = "2"
+*** script
+script = "sh ${test_source_directory}/check-error-cleanup.sh"
+*)
+
+(* Regression test for MPR#7918 *)
+let f () =
+  (* -warn-error A will error with unused x below *)
+  let x = 12 in
+  1
diff --git a/testsuite/tests/tool-ocamlc-open/a.ml b/testsuite/tests/tool-ocamlc-open/a.ml
new file mode 100644
index 00000000..4ae15f14
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-open/a.ml
@@ -0,0 +1,3 @@
+module M = struct
+  let f x = x +1
+end
diff --git a/testsuite/tests/tool-ocamlc-open/b.ml b/testsuite/tests/tool-ocamlc-open/b.ml
new file mode 100644
index 00000000..6c781576
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-open/b.ml
@@ -0,0 +1 @@
+let g = f
diff --git a/testsuite/tests/tool-ocamlc-open/tool-ocamlc-open-error.compilers.reference b/testsuite/tests/tool-ocamlc-open/tool-ocamlc-open-error.compilers.reference
new file mode 100644
index 00000000..4c75c9fe
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-open/tool-ocamlc-open-error.compilers.reference
@@ -0,0 +1,4 @@
+File "tool-ocamlc-open-error.ml", line 1:
+Warning 24: bad source file name: "Tool-ocamlc-open-error" is not a valid module name.
+File "command line argument: -open "F("", line 1, characters 1-2:
+Error: Syntax error
diff --git a/testsuite/tests/tool-ocamlc-open/tool-ocamlc-open-error.ml b/testsuite/tests/tool-ocamlc-open/tool-ocamlc-open-error.ml
new file mode 100644
index 00000000..e965ca43
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-open/tool-ocamlc-open-error.ml
@@ -0,0 +1,7 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+flags = "-open F("
+ocamlc_byte_exit_status = "2"
+*** check-ocamlc.byte-output
+*)
diff --git a/testsuite/tests/tool-ocamlc-open/tool-ocamlc-open.ml b/testsuite/tests/tool-ocamlc-open/tool-ocamlc-open.ml
new file mode 100644
index 00000000..56d818e0
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-open/tool-ocamlc-open.ml
@@ -0,0 +1,10 @@
+(* TEST
+files = "a.ml b.ml"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+module = "a.ml"
+*** ocamlc.byte
+module = "b.ml"
+flags = "-open A.M"
+**** check-ocamlc.byte-output
+*)
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
new file mode 100644
index 00000000..0e9c1703
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_impl.compilers.reference
@@ -0,0 +1,36 @@
+[
+  structure_item (stop_after_parsing_impl.ml[12,306+0]..[12,306+24])
+    Pstr_value Nonrec
+    [
+      <def>
+        pattern (stop_after_parsing_impl.ml[12,306+4]..[12,306+5])
+          Ppat_any
+        expression (stop_after_parsing_impl.ml[12,306+8]..[12,306+24])
+          Pexp_apply
+          expression (stop_after_parsing_impl.ml[12,306+21]..[12,306+22])
+            Pexp_ident "+" (stop_after_parsing_impl.ml[12,306+21]..[12,306+22])
+          [
+            <arg>
+            Nolabel
+              expression (stop_after_parsing_impl.ml[12,306+8]..[12,306+20])
+                Pexp_apply
+                expression (stop_after_parsing_impl.ml[12,306+11]..[12,306+12])
+                  Pexp_ident "+" (stop_after_parsing_impl.ml[12,306+11]..[12,306+12])
+                [
+                  <arg>
+                  Nolabel
+                    expression (stop_after_parsing_impl.ml[12,306+9]..[12,306+10])
+                      Pexp_constant 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)
+                ]
+            <arg>
+            Nolabel
+              expression (stop_after_parsing_impl.ml[12,306+23]..[12,306+24])
+                Pexp_ident "x" (stop_after_parsing_impl.ml[12,306+23]..[12,306+24])
+          ]
+    ]
+]
+
diff --git a/testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_impl.ml b/testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_impl.ml
new file mode 100644
index 00000000..3276733c
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_impl.ml
@@ -0,0 +1,12 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+    flags = "-stop-after parsing -dparsetree"
+    ocamlc_byte_exit_status = "0"
+*** check-ocamlc.byte-output
+*)
+
+(* we intentionally write ill-typed output;
+   if `-stop-after parsing` was not supported properly,
+   the test would fail with an error *)
+let _ = (1 + "true") + x
diff --git a/testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_intf.compilers.reference b/testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_intf.compilers.reference
new file mode 100644
index 00000000..f5cb47d1
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_intf.compilers.reference
@@ -0,0 +1,10 @@
+[
+  signature_item (stop_after_parsing_intf.mli[12,306+0]..[12,306+61])
+    Psig_value
+    value_description "x" (stop_after_parsing_intf.mli[12,306+4]..[12,306+5]) (stop_after_parsing_intf.mli[12,306+0]..[12,306+61])
+      core_type (stop_after_parsing_intf.mli[12,306+8]..[12,306+61])
+        Ptyp_constr "Module_that_does_not_exists.type_that_does_not_exists" (stop_after_parsing_intf.mli[12,306+8]..[12,306+61])
+        []
+      []
+]
+
diff --git a/testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_intf.mli b/testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_intf.mli
new file mode 100644
index 00000000..328a78d4
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_intf.mli
@@ -0,0 +1,12 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+    flags = "-stop-after parsing -dparsetree"
+    ocamlc_byte_exit_status = "0"
+*** check-ocamlc.byte-output
+*)
+
+(* we intentionally write ill-typed output;
+   if `-stop-after parsing` was not supported properly,
+   the test would fail with an error *)
+val x : Module_that_does_not_exists.type_that_does_not_exists
diff --git a/testsuite/tests/tool-ocamlc-stop-after/stop_after_scheduling.compilers.reference b/testsuite/tests/tool-ocamlc-stop-after/stop_after_scheduling.compilers.reference
new file mode 100644
index 00000000..b41ebd0a
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-stop-after/stop_after_scheduling.compilers.reference
@@ -0,0 +1 @@
+wrong argument 'scheduling'; option '-stop-after' expects one of: parsing typing.
diff --git a/testsuite/tests/tool-ocamlc-stop-after/stop_after_scheduling.ml b/testsuite/tests/tool-ocamlc-stop-after/stop_after_scheduling.ml
new file mode 100644
index 00000000..c5eae2bb
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-stop-after/stop_after_scheduling.ml
@@ -0,0 +1,14 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+compiler_output = "compiler-output.raw"
+** ocamlc.byte
+   flags = "-stop-after scheduling"
+   ocamlc_byte_exit_status = "2"
+*** script
+   script = "sh ${test_source_directory}/stop_after_scheduling.sh"
+   output = "compiler-output"
+**** check-ocamlc.byte-output
+compiler_output = "compiler-output"
+*)
+
+(* this file is just a test driver, the test does not contain real OCaml code *)
diff --git a/testsuite/tests/tool-ocamlc-stop-after/stop_after_scheduling.sh b/testsuite/tests/tool-ocamlc-stop-after/stop_after_scheduling.sh
new file mode 100755
index 00000000..bf711391
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-stop-after/stop_after_scheduling.sh
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+grep "wrong argument 'scheduling'" compiler-output.raw | grep "stop-after" | sed 's/^.*: wrong argument/wrong argument/'
diff --git a/testsuite/tests/tool-ocamlc-stop-after/stop_after_typing_impl.compilers.reference b/testsuite/tests/tool-ocamlc-stop-after/stop_after_typing_impl.compilers.reference
new file mode 100644
index 00000000..257eeb74
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-stop-after/stop_after_typing_impl.compilers.reference
@@ -0,0 +1,18 @@
+[
+  structure_item (stop_after_typing_impl.ml[13,349+0]..stop_after_typing_impl.ml[13,349+37])
+    Tstr_primitive
+    value_description apply/80 (stop_after_typing_impl.ml[13,349+0]..stop_after_typing_impl.ml[13,349+37])
+      core_type (stop_after_typing_impl.ml[13,349+16]..stop_after_typing_impl.ml[13,349+26])
+        Ttyp_arrow
+        Nolabel
+        core_type (stop_after_typing_impl.ml[13,349+16]..stop_after_typing_impl.ml[13,349+19])
+          Ttyp_constr "int/1!"
+          []
+        core_type (stop_after_typing_impl.ml[13,349+23]..stop_after_typing_impl.ml[13,349+26])
+          Ttyp_constr "int/1!"
+          []
+      [
+        "%apply"
+      ]
+]
+
diff --git a/testsuite/tests/tool-ocamlc-stop-after/stop_after_typing_impl.ml b/testsuite/tests/tool-ocamlc-stop-after/stop_after_typing_impl.ml
new file mode 100644
index 00000000..e7e9d089
--- /dev/null
+++ b/testsuite/tests/tool-ocamlc-stop-after/stop_after_typing_impl.ml
@@ -0,0 +1,13 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+    flags = "-stop-after typing -dtypedtree"
+    ocamlc_byte_exit_status = "0"
+*** check-ocamlc.byte-output
+*)
+
+(* we intentionally write an output that is type-correct
+   but will be rejected before bytecode compilation
+   due to the incorrect type given to the %apply
+   compiler primitive. *)
+external apply: int -> int = "%apply"
diff --git a/testsuite/tests/tool-ocamldep-modalias/A.ml b/testsuite/tests/tool-ocamldep-modalias/A.ml
new file mode 100644
index 00000000..9faa225a
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-modalias/A.ml
@@ -0,0 +1 @@
+let f x = x +1
diff --git a/testsuite/tests/tool-ocamldep-modalias/B.ml b/testsuite/tests/tool-ocamldep-modalias/B.ml
new file mode 100644
index 00000000..17d27a3e
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-modalias/B.ml
@@ -0,0 +1,2 @@
+open Packed
+let g = A.f
diff --git a/testsuite/tests/tool-ocamldep-modalias/C.ml b/testsuite/tests/tool-ocamldep-modalias/C.ml
new file mode 100644
index 00000000..87cb814d
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-modalias/C.ml
@@ -0,0 +1,2 @@
+open Lib
+let h x = A.f x + B.g x
diff --git a/testsuite/tests/tool-ocamldep-modalias/D.ml b/testsuite/tests/tool-ocamldep-modalias/D.ml
new file mode 100644
index 00000000..9f192def
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-modalias/D.ml
@@ -0,0 +1 @@
+let z x = imp (x*2)
diff --git a/testsuite/tests/tool-ocamldep-modalias/Makefile.build b/testsuite/tests/tool-ocamldep-modalias/Makefile.build
new file mode 100644
index 00000000..1020369f
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-modalias/Makefile.build
@@ -0,0 +1,77 @@
+# Makefile using -no-alias-deps only for lib.ml/mli
+
+# Note: not using pattern rules here is intended.
+# This is to be as portable as possible since this Makefile
+# will not necessarily be ran by GNU make
+# The same holds for $< and $@
+
+.NOTPARALLEL:
+
+SOURCES = A.ml B.ml C.ml D.ml
+OBJECTS = lib.cmo $(SOURCES:%.ml=Lib%.cmo)
+NOBJECTS = $(OBJECTS:%.cmo=%.cmx)
+
+byte: main.byt
+opt: clean main.opt
+
+main.byt: lib.cma main.cmo
+	$(OCAMLC) lib.cma main.cmo -o $@
+
+lib.ml: lib_impl.ml
+	cp lib_impl.ml lib.ml
+
+lib.cma: $(OBJECTS)
+	$(OCAMLC) -a -o $@ $(OBJECTS)
+
+lib.cmi: lib.mli
+	$(OCAMLC) -c -no-alias-deps -w -49 lib.mli
+
+lib.cmo: lib.ml
+	$(OCAMLC) -c -no-alias-deps -w -49 lib.ml
+
+LibA.cmo: A.ml
+	$(OCAMLC) -c -open Lib -o LibA.cmo A.ml
+
+LibB.cmo: B.ml
+	$(OCAMLC) -c -open Lib -o LibB.cmo B.ml
+
+LibC.cmo: C.ml
+	$(OCAMLC) -c -open Lib -o LibC.cmo C.ml
+
+LibD.cmo: D.ml
+	$(OCAMLC) -c -open Lib -o LibD.cmo D.ml
+
+main.opt: lib.cmxa main.cmx
+	$(OCAMLOPT) lib.cmxa main.cmx -o $@
+
+lib.cmxa: $(NOBJECTS)
+	$(OCAMLOPT) -a -o $@ $(NOBJECTS)
+
+lib.cmx: lib.ml
+	$(OCAMLOPT) -c -no-alias-deps -w -49 $<
+
+LibA.cmx: A.ml
+	$(OCAMLOPT) -c -open Lib -o LibA.cmx A.ml
+
+LibB.cmx: B.ml
+	$(OCAMLOPT) -c -open Lib -o LibB.cmx B.ml
+
+LibC.cmx: C.ml
+	$(OCAMLOPT) -c -open Lib -o LibC.cmx C.ml
+
+LibD.cmx: D.ml
+	$(OCAMLOPT) -c -open Lib -o LibD.cmx D.ml
+
+include depend.mk
+
+.PHONY: clean
+clean:
+	rm -f *.cm* lib.ml
+
+.SUFFIXES: .ml .cmo .cmx
+
+.ml.cmo:
+	$(OCAMLC) -c $<
+
+.ml.cmx:
+	$(OCAMLOPT) -c $<
diff --git a/testsuite/tests/tool-ocamldep-modalias/Makefile.build2 b/testsuite/tests/tool-ocamldep-modalias/Makefile.build2
new file mode 100644
index 00000000..087a1b20
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-modalias/Makefile.build2
@@ -0,0 +1,65 @@
+# Makefile using -no-alias-deps for all files, no need to link lib.cmo
+
+# Note: not using pattern rules here is intended.
+# This is to be as portable as possible since this Makefile
+# will not necessarily be ran by GNU make
+# The same holds for $< and $@
+
+.NOTPARALLEL:
+
+SOURCES = A.ml B.ml C.ml
+OBJECTS = $(SOURCES:%.ml=Lib%.cmo)
+NOBJECTS = $(OBJECTS:%.cmo=%.cmx)
+
+byte: main.byt2
+opt: clean main.opt2
+
+main.byt2: lib2.cma main.cmo
+	$(OCAMLC) -no-alias-deps lib2.cma main.cmo -o main.byt2
+
+lib2.cma: $(OBJECTS)
+	$(OCAMLC) -no-alias-deps -a -o lib2.cma $(OBJECTS)
+
+lib.cmi: lib.mli
+	$(OCAMLC) -no-alias-deps -c -w -49 lib.mli
+
+LibA.cmo: A.ml
+	$(OCAMLC) -no-alias-deps -c -open Lib -o LibA.cmo A.ml
+
+LibB.cmo: B.ml
+	$(OCAMLC) -no-alias-deps -c -open Lib -o LibB.cmo B.ml
+
+LibC.cmo: C.ml
+	$(OCAMLC) -no-alias-deps -c -open Lib -o LibC.cmo C.ml
+
+main.opt2: lib.cmxa main.cmx
+	$(OCAMLOPT) -no-alias-deps lib.cmxa main.cmx -o main.opt2
+
+lib.cmxa: $(NOBJECTS)
+	$(OCAMLOPT) -no-alias-deps -a -o lib.cmxa $(NOBJECTS)
+
+lib.cmx: lib.ml
+	$(OCAMLOPT) -no-alias-deps -c -w -49 lib.ml
+
+LibA.cmx: A.ml
+	$(OCAMLOPT) -no-alias-deps -c -open Lib -o LibA.cmx A.ml
+
+LibB.cmx: B.ml
+	$(OCAMLOPT) -no-alias-deps -c -open Lib -o LibB.cmx B.ml
+
+LibC.cmx: C.ml
+	$(OCAMLOPT) -no-alias-deps -c -open Lib -o LibC.cmx C.ml
+
+include depend.mk2
+
+.PHONY: clean
+clean:
+	rm -f *.cm* lib.ml
+
+.SUFFIXES: .ml .cmo .cmx
+
+.ml.cmo:
+	$(OCAMLC) -no-alias-deps -c $<
+
+.ml.cmx:
+	$(OCAMLOPT) -no-alias-deps -c $<
diff --git a/testsuite/tests/tool-ocamldep-modalias/depend.mk.reference b/testsuite/tests/tool-ocamldep-modalias/depend.mk.reference
new file mode 100644
index 00000000..cbec4e4c
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-modalias/depend.mk.reference
@@ -0,0 +1,27 @@
+lib.cmo : \
+    lib.cmi
+lib.cmx : \
+    lib.cmi
+lib.cmi :
+LibA.cmo : \
+    lib.cmi
+LibA.cmx : \
+    lib.cmx
+LibB.cmo : \
+    LibA.cmo \
+    lib.cmi
+LibB.cmx : \
+    LibA.cmx \
+    lib.cmx
+LibC.cmo : \
+    LibB.cmo \
+    LibA.cmo \
+    lib.cmi
+LibC.cmx : \
+    LibB.cmx \
+    LibA.cmx \
+    lib.cmx
+LibD.cmo : \
+    lib.cmi
+LibD.cmx : \
+    lib.cmx
diff --git a/testsuite/tests/tool-ocamldep-modalias/depend.mk2.reference b/testsuite/tests/tool-ocamldep-modalias/depend.mk2.reference
new file mode 100644
index 00000000..05d501f5
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-modalias/depend.mk2.reference
@@ -0,0 +1,22 @@
+LibA.cmo : \
+    lib.cmi
+LibA.cmx : \
+    lib.cmi
+LibB.cmo : \
+    LibA.cmo \
+    lib.cmi
+LibB.cmx : \
+    LibA.cmx \
+    lib.cmi
+LibC.cmo : \
+    LibB.cmo \
+    LibA.cmo \
+    lib.cmi
+LibC.cmx : \
+    LibB.cmx \
+    LibA.cmx \
+    lib.cmi
+LibD.cmo : \
+    lib.cmi
+LibD.cmx : \
+    lib.cmi
diff --git a/testsuite/tests/tool-ocamldep-modalias/depend.mod.reference b/testsuite/tests/tool-ocamldep-modalias/depend.mod.reference
new file mode 100644
index 00000000..37a3cea2
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-modalias/depend.mod.reference
@@ -0,0 +1,6 @@
+lib.ml:
+lib.mli:
+LibA.ml: Lib
+LibB.ml: Lib LibA
+LibC.ml: Lib LibA LibB
+LibD.ml: Lib
diff --git a/testsuite/tests/tool-ocamldep-modalias/depend.mod2.reference b/testsuite/tests/tool-ocamldep-modalias/depend.mod2.reference
new file mode 100644
index 00000000..7ec54741
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-modalias/depend.mod2.reference
@@ -0,0 +1,4 @@
+LibA.ml:
+LibB.ml: A Packed
+LibC.ml: Lib LibA LibB
+LibD.ml:
diff --git a/testsuite/tests/tool-ocamldep-modalias/depend.mod3.reference b/testsuite/tests/tool-ocamldep-modalias/depend.mod3.reference
new file mode 100644
index 00000000..8ab7ed95
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-modalias/depend.mod3.reference
@@ -0,0 +1,4 @@
+LibA.ml: Lib
+LibB.ml: Lib LibA
+LibC.ml: Lib LibA LibB
+LibD.ml: Lib
diff --git a/testsuite/tests/tool-ocamldep-modalias/lib.mli b/testsuite/tests/tool-ocamldep-modalias/lib.mli
new file mode 100644
index 00000000..2334c2b6
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-modalias/lib.mli
@@ -0,0 +1,8 @@
+module Packed : sig
+  module A = LibA
+  module B = LibB
+  module C = LibC
+end
+include (module type of struct include Packed end)
+
+val imp : int -> int
diff --git a/testsuite/tests/tool-ocamldep-modalias/lib_impl.ml b/testsuite/tests/tool-ocamldep-modalias/lib_impl.ml
new file mode 100644
index 00000000..fc8581ad
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-modalias/lib_impl.ml
@@ -0,0 +1,8 @@
+module Packed = struct
+  module A = LibA
+  module B = LibB
+  module C = LibC
+end
+include Packed
+
+let imp x = x+1
diff --git a/testsuite/tests/tool-ocamldep-modalias/main.ml b/testsuite/tests/tool-ocamldep-modalias/main.ml
new file mode 100644
index 00000000..18be061d
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-modalias/main.ml
@@ -0,0 +1,86 @@
+(* TEST
+
+files = "A.ml B.ml C.ml D.ml lib_impl.ml lib.mli"
+
+script = "sh ${test_source_directory}/setup-links.sh"
+set sources = "A.ml B.ml C.ml D.ml"
+set links = "LibA.ml LibB.ml LibC.ml LibD.ml"
+set stdlib = "-nostdlib -I ${ocamlsrcdir}/stdlib"
+set OCAMLC = "${ocamlrun} ${ocamlc_byte} ${stdlib}"
+set OCAMLOPT = "${ocamlrun} ${ocamlopt_byte} ${stdlib}"
+
+* setup-ocamlc.byte-build-env
+compiler_directory_suffix = ".depend.mk"
+compiler_output = "${test_build_directory}/depend.mk"
+** script
+*** script
+script = "cp lib_impl.ml lib.ml"
+**** ocamlc.byte
+commandline = "-depend -as-map lib.ml lib.mli"
+***** ocamlc.byte
+commandline = "-depend -map lib.ml -open Lib ${links}"
+****** check-ocamlc.byte-output
+compiler_reference = "${test_source_directory}/depend.mk.reference"
+******* hasunix
+******** script
+script = "cp ${test_source_directory}/Makefile.build Makefile"
+********* script
+script = "rm -f ${links}"
+********** script
+script = "${MAKE} byte"
+*********** native-compiler
+************ script
+script = "${MAKE} opt"
+
+* setup-ocamlc.byte-build-env
+compiler_directory_suffix = ".depend.mk2"
+compiler_output = "${test_build_directory}/depend.mk2"
+** script
+*** ocamlc.byte
+commandline = "-depend -map lib.mli -open Lib ${links}"
+**** check-ocamlc.byte-output
+compiler_reference = "${test_source_directory}/depend.mk2.reference"
+***** hasunix
+****** script
+script = "rm -f ${links}"
+******* script
+script = "cp ${test_source_directory}/Makefile.build2 Makefile"
+******** script
+script = "${MAKE} byte"
+********* native-compiler
+********** script
+script = "${MAKE} opt"
+
+* setup-ocamlc.byte-build-env
+compiler_directory_suffix = ".depend.mod"
+** script
+*** script
+script = "cp lib_impl.ml lib.ml"
+**** ocamlc.byte
+commandline = "-depend -as-map -modules lib.ml lib.mli"
+***** ocamlc.byte
+commandline = "-depend -modules -map lib.ml -open Lib ${links}"
+****** check-ocamlc.byte-output
+compiler_reference = "${test_source_directory}/depend.mod.reference"
+
+* setup-ocamlc.byte-build-env
+compiler_directory_suffix = ".depend.mod2"
+** script
+*** ocamlc.byte
+commandline = "-depend -modules -map lib.mli ${links}"
+**** check-ocamlc.byte-output
+compiler_reference = "${test_source_directory}/depend.mod2.reference"
+
+* setup-ocamlc.byte-build-env
+compiler_directory_suffix = ".depend.mod3"
+** script
+*** ocamlc.byte
+commandline = "-depend -modules -as-map -map lib.mli -open Lib ${links}"
+**** check-ocamlc.byte-output
+compiler_reference = "${test_source_directory}/depend.mod3.reference"
+
+*)
+
+open Lib
+
+let () = Printf.printf "B.g 3 = %d\n%!" (B.g 3)
diff --git a/testsuite/tests/tool-ocamldep-modalias/setup-links.sh b/testsuite/tests/tool-ocamldep-modalias/setup-links.sh
new file mode 100644
index 00000000..1197fff1
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-modalias/setup-links.sh
@@ -0,0 +1,2 @@
+#!/bin/sh
+for i in A B C D; do cp $i.ml Lib$i.ml; done
diff --git a/testsuite/tests/tool-ocamldep-shadowing/a.ml b/testsuite/tests/tool-ocamldep-shadowing/a.ml
new file mode 100644
index 00000000..31973b40
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-shadowing/a.ml
@@ -0,0 +1,13 @@
+(* TEST
+
+* setup-ocamlc.byte-build-env
+** script
+script = "cp -R ${test_source_directory}/dir1 ${test_source_directory}/dir2 ."
+*** ocamlc.byte
+commandline = "-depend -slash -I dir1 -I dir2 a.ml"
+**** check-ocamlc.byte-output
+compiler_reference = "${test_source_directory}/a.reference"
+*)
+
+include B
+include C
diff --git a/testsuite/tests/tool-ocamldep-shadowing/a.reference b/testsuite/tests/tool-ocamldep-shadowing/a.reference
new file mode 100644
index 00000000..c7458e19
--- /dev/null
+++ b/testsuite/tests/tool-ocamldep-shadowing/a.reference
@@ -0,0 +1,6 @@
+a.cmo : \
+    dir2/c.cmi \
+    dir1/b.cmo
+a.cmx : \
+    dir2/c.cmi \
+    dir1/b.cmx
diff --git a/testsuite/tests/tool-ocamldep-shadowing/dir1/b.ml b/testsuite/tests/tool-ocamldep-shadowing/dir1/b.ml
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/tool-ocamldep-shadowing/dir2/b.mli b/testsuite/tests/tool-ocamldep-shadowing/dir2/b.mli
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/tool-ocamldep-shadowing/dir2/c.mli b/testsuite/tests/tool-ocamldep-shadowing/dir2/c.mli
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/tool-ocamldoc-open/Readme b/testsuite/tests/tool-ocamldoc-open/Readme
new file mode 100644
index 00000000..e140d57c
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc-open/Readme
@@ -0,0 +1,12 @@
+This test focuses on ocamldoc "-open" command line option.
+It ensures that the modules passed as argument to this "-open" option
+are opened in the initial environment of ocamldoc.
+
+More precisely, it checks that
+
+* both cmi files and inner modules can be opened
+* modules are opened in the left-to-right order
+
+The test builds a latex documentation file for the three modules
+"Main", "Alias" and "Inner". Changes to ocamldoc latex output might
+trigger spurious errors in this test.
diff --git a/testsuite/tests/tool-ocamldoc-open/alias.ml b/testsuite/tests/tool-ocamldoc-open/alias.ml
new file mode 100644
index 00000000..e3e81842
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc-open/alias.ml
@@ -0,0 +1,3 @@
+module Container = struct
+  module Aliased_inner = Inner
+end
diff --git a/testsuite/tests/tool-ocamldoc-open/inner.ml b/testsuite/tests/tool-ocamldoc-open/inner.ml
new file mode 100644
index 00000000..87778638
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc-open/inner.ml
@@ -0,0 +1,2 @@
+
+type a = int
diff --git a/testsuite/tests/tool-ocamldoc-open/main.latex.reference b/testsuite/tests/tool-ocamldoc-open/main.latex.reference
new file mode 100644
index 00000000..29c5eaf0
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc-open/main.latex.reference
@@ -0,0 +1,70 @@
+\documentclass[11pt]{article} 
+\usepackage[latin1]{inputenc} 
+\usepackage[T1]{fontenc} 
+\usepackage{textcomp}
+\usepackage{fullpage} 
+\usepackage{url} 
+\usepackage{ocamldoc}
+\begin{document}
+\tableofcontents
+\section{Module {\tt{Alias}}}
+\label{module:Alias}\index{Alias@\verb`Alias`}
+
+
+\ocamldocvspace{0.5cm}
+
+
+
+\begin{ocamldoccode}
+{\tt{module }}{\tt{Container}}{\tt{ : }}\end{ocamldoccode}
+\label{module:Alias.Container}\index{Container@\verb`Container`}
+
+\begin{ocamldocsigend}
+
+
+\begin{ocamldoccode}
+{\tt{module }}{\tt{Aliased\_inner}}{\tt{ : }}\end{ocamldoccode}
+\label{module:Alias.Container.Aliased-underscoreinner}\index{Aliased-underscoreinner@\verb`Aliased_inner`}
+{\tt{Inner}}
+
+\end{ocamldocsigend}
+
+
+
+
+\section{Module {\tt{Inner}}}
+\label{module:Inner}\index{Inner@\verb`Inner`}
+
+
+\ocamldocvspace{0.5cm}
+
+
+
+\label{type:Inner.a}\begin{ocamldoccode}
+type a = int 
+\end{ocamldoccode}
+\index{a@\verb`a`}
+
+
+\section{Module {\tt{Main}} : Documentation test}
+\label{module:Main}\index{Main@\verb`Main`}
+
+
+
+
+\ocamldocvspace{0.5cm}
+
+
+
+\label{type:Main.t}\begin{ocamldoccode}
+type t = Alias.Container.Aliased_inner.a 
+\end{ocamldoccode}
+\index{t@\verb`t`}
+\begin{ocamldocdescription}
+Alias to type Inner.a
+
+
+\end{ocamldocdescription}
+
+
+\end{document}
diff --git a/testsuite/tests/tool-ocamldoc-open/main.ml b/testsuite/tests/tool-ocamldoc-open/main.ml
new file mode 100644
index 00000000..4dca4e54
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc-open/main.ml
@@ -0,0 +1,11 @@
+(* TEST
+   modules = "inner.ml alias.ml"
+   * ocamldoc
+     ocamldoc_backend="latex"
+     ocamldoc_flags=" -open Alias.Container -open Aliased_inner "
+*)
+
+(** Documentation test *)
+
+type t = a
+(** Alias to type Inner.a *)
diff --git a/testsuite/tests/tool-ocamldoc-open/main.ocamldoc.latex.reference b/testsuite/tests/tool-ocamldoc-open/main.ocamldoc.latex.reference
new file mode 100644
index 00000000..930579ee
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc-open/main.ocamldoc.latex.reference
@@ -0,0 +1,3 @@
+Warning: Module or module type Inner not found
+Warning: Module or module type Inner not found
+Warning: Module or module type Inner not found
diff --git a/testsuite/tests/tool-ocamldoc/Documentation_tags.html.reference b/testsuite/tests/tool-ocamldoc/Documentation_tags.html.reference
new file mode 100644
index 00000000..f646c4c1
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Documentation_tags.html.reference
@@ -0,0 +1,44 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<meta content="text/html; charset=iso-8859-1" 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 values" rel=Appendix href="index_values.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Documentation_tags" rel="Chapter" href="Documentation_tags.html"><title>Documentation_tags
+
+
+
     Up
+ 
    
+
    Module Documentation_tags
    
+
+
    module Documentation_tags: sig .. end
    
+
    
+
    Test the html rendering of ocamldoc documentation tags
    
+
    
+
    
+
    
+
+
    val heterological : unit
    
+
    
+Deprecated.since the start of time
    
+
      
+
    • Author(s): yes
      • 
+
    • Before Time  not implemented
      • 
+
    • Since Now
      • 
+
    • Returns ()
      • 
+
    • See also Documentation_tags.mli Self reference
      • 
+
    
+
    
+
+
    val noop : unit
    
+
      
+
    • Raises
      • Not_found Never
        • 
+
      • Invalid_argument Never
        • 
+
      • 
+
    
+
    
+
diff --git a/testsuite/tests/tool-ocamldoc/Documentation_tags.mli b/testsuite/tests/tool-ocamldoc/Documentation_tags.mli
new file mode 100644
index 00000000..0dadce66
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Documentation_tags.mli
@@ -0,0 +1,23 @@
+(* TEST
+   * ocamldoc with html
+*)
+
+(** Test the html rendering of ocamldoc documentation tags *)
+
+val heterological: unit
+(**
+ @author yes
+ @param no No description
+ @param neither see no description
+ @deprecated since the start of time
+ @return ()
+ @see "Documentation_tags.mli" Self reference
+ @since Now
+ @before Time not implemented
+*)
+
+val noop: unit
+(**
+ @raise Not_found Never
+ @raise Invalid_argument Never
+*)
diff --git a/testsuite/tests/tool-ocamldoc/Extensible_variant.latex.reference b/testsuite/tests/tool-ocamldoc/Extensible_variant.latex.reference
new file mode 100644
index 00000000..a4b01455
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Extensible_variant.latex.reference
@@ -0,0 +1,125 @@
+\documentclass[11pt]{article} 
+\usepackage[latin1]{inputenc} 
+\usepackage[T1]{fontenc} 
+\usepackage{textcomp}
+\usepackage{fullpage} 
+\usepackage{url} 
+\usepackage{ocamldoc}
+\begin{document}
+\tableofcontents
+\section{Module {\tt{Extensible\_variant}} : Testing display of extensible variant types and exceptions.}
+\label{Extensible-underscorevariant}\index{Extensible-underscorevariant@\verb`Extensible_variant`}
+
+
+
+
+\ocamldocvspace{0.5cm}
+
+
+
+Also check reference for {\tt{Extensible\_variant.M.A}}[\ref{extension:Extensible-underscorevariant.M.A}], {\tt{Extensible\_variant.M.B}}[\ref{extension:Extensible-underscorevariant.M.B}], {\tt{Extensible\_variant.M.C}}[\ref{extension:Extensible-underscorevariant.M.C}] and {\tt{Extensible\_variant.E}}[\ref{exception:Extensible-underscorevariant.E}]
+
+
+
+\label{TYPExtensible-underscorevariant.e}\begin{ocamldoccode}
+type e = ..
+\end{ocamldoccode}
+\index{e@\verb`e`}
+\begin{ocamldocdescription}
+Extensible type
+
+
+\end{ocamldocdescription}
+
+
+
+
+\begin{ocamldoccode}
+{\tt{module }}{\tt{M}}{\tt{ : }}\end{ocamldoccode}
+\label{Extensible-underscorevariant.M}\index{M@\verb`M`}
+
+\begin{ocamldocsigend}
+
+
+\begin{ocamldoccode}
+type e +=
+\end{ocamldoccode}
+\label{extension:Extensible-underscorevariant.M.A}\begin{ocamldoccode}
+  | A
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+A doc
+
+
+\end{ocamldoccomment}
+\label{extension:Extensible-underscorevariant.M.B}\begin{ocamldoccode}
+  | B
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+B doc
+
+
+\end{ocamldoccomment}
+\label{extension:Extensible-underscorevariant.M.C}\begin{ocamldoccode}
+  | C
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+C doc
+
+
+\end{ocamldoccomment}
+\end{ocamldocsigend}
+
+
+
+
+
+
+\begin{ocamldoccode}
+{\tt{module type }}{\tt{MT}}{\tt{ = }}\end{ocamldoccode}
+\label{Extensible-underscorevariant.MT}\index{MT@\verb`MT`}
+
+\begin{ocamldocsigend}
+
+
+\begin{ocamldoccode}
+type e +=
+\end{ocamldoccode}
+\label{extension:Extensible-underscorevariant.MT.A}\begin{ocamldoccode}
+  | A
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+A doc
+
+
+\end{ocamldoccomment}
+\label{extension:Extensible-underscorevariant.MT.B}\begin{ocamldoccode}
+  | B
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+B doc
+
+
+\end{ocamldoccomment}
+\label{extension:Extensible-underscorevariant.MT.C}\begin{ocamldoccode}
+  | C
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+C doc
+
+
+\end{ocamldoccomment}
+\end{ocamldocsigend}
+
+
+
+
+
+
+\label{exception:Extensible-underscorevariant.E}\begin{ocamldoccode}
+exception E
+\end{ocamldoccode}
+\index{E@\verb`E`}
+
+
+\end{document}
diff --git a/testsuite/tests/tool-ocamldoc/Extensible_variant.ml b/testsuite/tests/tool-ocamldoc/Extensible_variant.ml
new file mode 100644
index 00000000..f459fa27
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Extensible_variant.ml
@@ -0,0 +1,29 @@
+(* TEST
+   * ocamldoc with latex
+*)
+
+(** Testing display of extensible variant types and exceptions.
+
+   @test_types_display
+ *)
+
+(** Also check reference for {!M.A}, {!M.B}, {!M.C} and {!E} *)
+
+(** Extensible type *)
+type e = ..
+
+module M = struct
+  type e +=
+  | A (** A doc *)
+  | B (** B doc *)
+  | C (** C doc *)
+end
+
+module type MT = sig
+  type e +=
+  | A (** A doc *)
+  | B (** B doc *)
+  | C (** C doc *)
+end
+
+exception E
diff --git a/testsuite/tests/tool-ocamldoc/Extensible_variant.ocamldoc.latex.reference b/testsuite/tests/tool-ocamldoc/Extensible_variant.ocamldoc.latex.reference
new file mode 100644
index 00000000..c80cf142
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Extensible_variant.ocamldoc.latex.reference
@@ -0,0 +1 @@
+Warning: Tag @test_types_display not handled by this generator
diff --git a/testsuite/tests/tool-ocamldoc/Include_module_type_of.html.reference b/testsuite/tests/tool-ocamldoc/Include_module_type_of.html.reference
new file mode 100644
index 00000000..1619e218
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Include_module_type_of.html.reference
@@ -0,0 +1,29 @@
+
+
+
+
+
+
+
+
+
+
+Include_module_type_of
+
+
+
     Up
+ 
    
+
    Module Include_module_type_of
    
+
+
    module Include_module_type_of: sig .. end
    
+
    
+
    Test include module type of... variants
    
+
    
+
    
+
    
+
+
    module A: sig .. end
    
+
    module M: sig .. end
    
+
    module B: sig .. end
    
+
    include Include_module_type_of.M
    
+
diff --git a/testsuite/tests/tool-ocamldoc/Include_module_type_of.latex.reference b/testsuite/tests/tool-ocamldoc/Include_module_type_of.latex.reference
new file mode 100644
index 00000000..67edcaed
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Include_module_type_of.latex.reference
@@ -0,0 +1,96 @@
+\documentclass[11pt]{article} 
+\usepackage[latin1]{inputenc} 
+\usepackage[T1]{fontenc} 
+\usepackage{textcomp}
+\usepackage{fullpage} 
+\usepackage{url} 
+\usepackage{ocamldoc}
+\begin{document}
+\tableofcontents
+\section{Module {\tt{Include\_module\_type\_of}} : Test {\tt{include module type of...}} variants}
+\label{Include-underscoremodule-underscoretype-underscoreof}\index{Include-underscoremodule-underscoretype-underscoreof@\verb`Include_module_type_of`}
+
+
+
+
+\ocamldocvspace{0.5cm}
+
+
+
+\begin{ocamldoccode}
+{\tt{module }}{\tt{A}}{\tt{ : }}\end{ocamldoccode}
+\label{Include-underscoremodule-underscoretype-underscoreof.A}\index{A@\verb`A`}
+
+\begin{ocamldocsigend}
+
+
+\label{TYPInclude-underscoremodule-underscoretype-underscoreof.A.t}\begin{ocamldoccode}
+type t 
+\end{ocamldoccode}
+\index{t@\verb`t`}
+\end{ocamldocsigend}
+
+
+
+
+
+
+\begin{ocamldoccode}
+{\tt{module }}{\tt{M}}{\tt{ : }}\end{ocamldoccode}
+\label{Include-underscoremodule-underscoretype-underscoreof.M}\index{M@\verb`M`}
+
+\begin{ocamldocsigend}
+
+
+A module M
+
+\begin{ocamldoccode}
+{\tt{module }}{\tt{Inner}}{\tt{ : }}\end{ocamldoccode}
+\label{Include-underscoremodule-underscoretype-underscoreof.M.Inner}\index{Inner@\verb`Inner`}
+\begin{ocamldocsigend}
+
+
+\label{TYPInclude-underscoremodule-underscoretype-underscoreof.M.Inner.t}\begin{ocamldoccode}
+type t 
+\end{ocamldoccode}
+\index{t@\verb`t`}
+\end{ocamldocsigend}
+
+
+
+
+\begin{ocamldoccode}
+{\tt{module }}{\tt{Alias}}{\tt{ : }}\end{ocamldoccode}
+\label{Include-underscoremodule-underscoretype-underscoreof.M.Alias}\index{Alias@\verb`Alias`}
+{\tt{Include\_module\_type\_of.A}}
+
+
+
+\label{TYPInclude-underscoremodule-underscoretype-underscoreof.M.t}\begin{ocamldoccode}
+type t 
+\end{ocamldoccode}
+\index{t@\verb`t`}
+\end{ocamldocsigend}
+
+
+
+
+
+
+\begin{ocamldoccode}
+{\tt{module }}{\tt{B}}{\tt{ : }}\end{ocamldoccode}
+\label{Include-underscoremodule-underscoretype-underscoreof.B}\index{B@\verb`B`}
+
+\begin{ocamldocsigend}
+
+
+{\tt{include }}{\tt{Include\_module\_type\_of.M}}\end{ocamldocsigend}
+
+
+
+
+
+
+{\tt{include }}{\tt{Include\_module\_type\_of.M}}
+
+\end{document}
diff --git a/testsuite/tests/tool-ocamldoc/Include_module_type_of.mli b/testsuite/tests/tool-ocamldoc/Include_module_type_of.mli
new file mode 100644
index 00000000..c30432d4
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Include_module_type_of.mli
@@ -0,0 +1,21 @@
+(* TEST
+   * ocamldoc with html
+   * ocamldoc with latex
+*)
+
+(** Test [include module type of...] variants *)
+
+module A: sig type t end
+module M: sig
+  (** A module M *)
+
+  module Inner: sig type t end
+  module Alias = A
+  type t
+end
+
+module B: sig
+  include module type of M
+end
+
+include module type of struct include M end
diff --git a/testsuite/tests/tool-ocamldoc/Inline_records.html.reference b/testsuite/tests/tool-ocamldoc/Inline_records.html.reference
new file mode 100644
index 00000000..07f7ed18
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Inline_records.html.reference
@@ -0,0 +1,352 @@
+
+
+
+
+
+
+
+
+
+
+
+
+Inline_records
+
+
+
     Up
+ 
    
+
    Module Inline_records
    
+
+
    module Inline_records: sig .. end
    
+
    
+
    This test focuses on the printing of documentation for inline record
+  within the latex generator.
    
+
    
+
    
+
    
+
+
    exception Simple
    
+
    
+
    
+
    A nice exception
    
+
    
+
    
+
+
    exception Less of int
    
+
    
+
    
+
    A less simple exception
    
+
    
+
    
+
+
    type ext = ..
    
+
    
+
    
+
    An open sum type
    
+
    
+
    
+
+
+
    type r = {
    
+
+
+
+
+
+
+
+
+
+
    
+  
+lbl : int;(*
    
+
    
+
    Field documentation for non-inline, lbl : int
    
+
    
+
    
+    		*)
    
+  
+more : int list;(*
    
+
    
+
    More documentation for r, more : int list
    
+
    
+
    
+    		*)
    
+}
+
+
    
+
    
+
    A simple record type for reference
    
+
    
+
    
+
+
+
    type t = 
    
+
+
+
+
+
    
+|
+A of {
+
+
+
+
+
+
+
+
+
+
    
+  
+lbl : int;(*
    
+
    
+
    A field documentation
    
+
    
+
    
+    		*)
    
+  
+more : int list;(*
    
+
    
+
    More A field documentation
    
+
    
+
    
+    		*)
    
+}
+    		(*
    
+
    
+
    Constructor documentation
    
+
    
+
    
+    		*)
    
+
+
    
+
    
+
    A sum type with one inline record
    
+
    
+
    
+
+
+
    type s = 
    
+
+
+
+
+
+
+
+
+
+
    
+|
+B of {
+
+
+
+
+
+
+
+
+
+
    
+  
+a_label_for_B : int;(*
    
+
    
+
    B field documentation
    
+
    
+
    
+    		*)
    
+  
+more_label_for_B : int list;(*
    
+
    
+
    More B field documentation
    
+
    
+
    
+    		*)
    
+}
+    		(*
    
+
    
+
    Constructor B documentation
    
+
    
+
    
+    		*)
    
+|
+C of {
+
+
+
+
+
+
+
+
+
+
    
+  
+c_has_label_too : float;(*
    
+
    
+
    C field documentation
    
+
    
+
    
+    		*)
    
+  
+more_than_one : unit;(*
    
+
    
+
    ... documentations
    
+
    
+
    
+    		*)
    
+}
+    		(*
    
+
    
+
    Constructor C documentation
    
+
    
+
    
+    		*)
    
+
+
    
+
    
+
    A sum type with two inline records
    
+
    
+
    
+
+
+
    type any = 
    
+
+
+
+
+
    
+|
+D : {
+
+
+
+
+
    
+  
+any : 'a;(*
    
+
    
+
    A field any:'a for D in any.
    
+
    
+
    
+    		*)
    
+}
+ -> any    		(*
    
+
    
+
    Constructor D documentation
    
+
    
+
    
+    		*)
    
+
+
    
+
    
+
    A gadt constructor
    
+
    
+
    
+
+
+
    exception Error of {
+
+
+
+
+
    
+  
+name : string;(*
    
+
    
+
    Error field documentation name:string
    
+
    
+
    
+    		*)
    
+}
+
    
+
    type ext += 
    
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
    
+|
+E of {
+
+
+
+
+
    
+  
+yet_another_field : unit;(*
    
+
    
+
    Field documentation for E in ext
    
+
    
+
    
+    		*)
    
+}
+    		(*
    
+
    
+
    Constructor E documentation
    
+
    
+
    
+    		*)
    
+|
+F of {
+
+
+
+
+
    
+  
+even_more : int -> int;(*
    
+
    
+
    Some field documentations for F
    
+
    
+
    
+    		*)
    
+}
+    		(*
    
+
    
+
    Constructor F documentation
    
+
    
+
    
+    		*)
    
+|
+G of {
+
+
+
+
+
    
+  
+last : int -> int;(*
    
+
    
+
    The last and least field documentation
    
+
    
+
    
+    		*)
    
+}
+    		(*
    
+
    
+
    Constructor G documentation
    
+
    
+
    
+    		*)
    
+
+
    
+
    
+
    Two new constructors for ext
    
+
    
+
    
+
+
diff --git a/testsuite/tests/tool-ocamldoc/Inline_records.latex.reference b/testsuite/tests/tool-ocamldoc/Inline_records.latex.reference
new file mode 100644
index 00000000..506f253a
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Inline_records.latex.reference
@@ -0,0 +1,287 @@
+\documentclass[11pt]{article} 
+\usepackage[latin1]{inputenc} 
+\usepackage[T1]{fontenc} 
+\usepackage{textcomp}
+\usepackage{fullpage} 
+\usepackage{url} 
+\usepackage{ocamldoc}
+\begin{document}
+\tableofcontents
+\section{Module {\tt{Inline\_records}} : This test focuses on the printing of documentation for inline record
+  within the latex generator.}
+\label{Inline-underscorerecords}\index{Inline-underscorerecords@\verb`Inline_records`}
+
+
+
+
+\ocamldocvspace{0.5cm}
+
+
+
+\label{exception:Inline-underscorerecords.Simple}\begin{ocamldoccode}
+exception Simple
+\end{ocamldoccode}
+\index{Simple@\verb`Simple`}
+\begin{ocamldocdescription}
+A nice exception
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{exception:Inline-underscorerecords.Less}\begin{ocamldoccode}
+exception Less of int
+\end{ocamldoccode}
+\index{Less@\verb`Less`}
+\begin{ocamldocdescription}
+A less simple exception
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{TYPInline-underscorerecords.ext}\begin{ocamldoccode}
+type ext = ..
+\end{ocamldoccode}
+\index{ext@\verb`ext`}
+\begin{ocamldocdescription}
+An open sum type
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{TYPInline-underscorerecords.r}\begin{ocamldoccode}
+type r = 
+{\char123}  lbl : int ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Field documentation for non-inline, {\tt{lbl : int}}
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+  more : int list ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+More documentation for r, {\tt{more : int list}}
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\index{r@\verb`r`}
+\begin{ocamldocdescription}
+A simple record type for reference
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{TYPInline-underscorerecords.t}\begin{ocamldoccode}
+type t =
+  | A of {\char123}  lbl : int ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+{\tt{A}} field documentation
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+  more : int list ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+More {\tt{A}} field documentation
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Constructor documentation
+
+
+\end{ocamldoccomment}
+\index{t@\verb`t`}
+\begin{ocamldocdescription}
+A sum type with one inline record
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{TYPInline-underscorerecords.s}\begin{ocamldoccode}
+type s =
+  | B of {\char123}  a_label_for_B : int ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+{\tt{B}} field documentation
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+  more_label_for_B : int list ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+More {\tt{B}} field documentation
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Constructor B documentation
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+  | C of {\char123}  c_has_label_too : float ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+{\tt{C}} field documentation
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+  more_than_one : unit ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+$\ldots$ documentations
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Constructor C documentation
+
+
+\end{ocamldoccomment}
+\index{s@\verb`s`}
+\begin{ocamldocdescription}
+A sum type with two inline records
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{TYPInline-underscorerecords.any}\begin{ocamldoccode}
+type any =
+  | D : {\char123}  any : {\textquotesingle}a ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+{\tt{A}} field {\tt{any:{\textquotesingle}a}} for {\tt{D}} in {\tt{any}}.
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+ ->
+any
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Constructor D documentation
+
+
+\end{ocamldoccomment}
+\index{any@\verb`any`}
+\begin{ocamldocdescription}
+A gadt constructor
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{exception:Inline-underscorerecords.Error}\begin{ocamldoccode}
+exception Error of {\char123}  name : string ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Error field documentation {\tt{name:string}}
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\index{Error@\verb`Error`}
+
+
+
+
+\begin{ocamldoccode}
+type ext +=
+\end{ocamldoccode}
+\label{extension:Inline-underscorerecords.E}\begin{ocamldoccode}
+  | E of {\char123}  yet_another_field : unit ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Field documentation for {\tt{E}} in ext
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Constructor E documentation
+
+
+\end{ocamldoccomment}
+\label{extension:Inline-underscorerecords.F}\begin{ocamldoccode}
+  | F of {\char123}  even_more : int -> int ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Some field documentations for {\tt{F}}
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Constructor F documentation
+
+
+\end{ocamldoccomment}
+\label{extension:Inline-underscorerecords.G}\begin{ocamldoccode}
+  | G of {\char123}  last : int -> int ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+The last and least field documentation
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Constructor G documentation
+
+
+\end{ocamldoccomment}
+\begin{ocamldocdescription}
+Two new constructors for ext
+
+
+\end{ocamldocdescription}
+
+
+\end{document}
diff --git a/testsuite/tests/tool-ocamldoc/Inline_records.man.reference b/testsuite/tests/tool-ocamldoc/Inline_records.man.reference
new file mode 100644
index 00000000..e3a6b08f
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Inline_records.man.reference
@@ -0,0 +1,238 @@
+.SH NAME
+Inline_records \- This test focuses on the printing of documentation for inline record within the latex generator.
+.SH Module
+Module   Inline_records
+.SH Documentation
+.sp
+Module
+.BI "Inline_records"
+ : 
+.B sig end
+
+.sp
+This test focuses on the printing of documentation for inline record
+within the latex generator\&.
+
+.sp
+
+.sp
+.sp
+
+.I exception Simple 
+
+.sp
+A nice exception
+
+.sp
+
+.I exception Less 
+.B of 
+.B int
+
+.sp
+A less simple exception
+
+.sp
+.I type ext 
+= ..
+
+.sp
+An open sum type
+
+.sp
+.I type r 
+= {
+ lbl : 
+.B int
+;  (* Field documentation for non\-inline, 
+.ft B
+lbl : int
+.ft R
+
+ *) 
+ more : 
+.B int list
+;  (* More documentation for r, 
+.ft B
+more : int list
+.ft R
+
+ *) 
+ }
+
+.sp
+A simple record type for reference
+
+.sp
+.I type t 
+=
+ | A
+.B of {
+ lbl : 
+.B int
+;  (* 
+.ft B
+A
+.ft R
+field documentation
+ *) 
+ more : 
+.B int list
+;  (* More 
+.ft B
+A
+.ft R
+field documentation
+ *) 
+ }
+.I "  "
+  (* Constructor documentation
+ *)
+ 
+.sp
+A sum type with one inline record
+
+.sp
+.I type s 
+=
+ | B
+.B of {
+ a_label_for_B : 
+.B int
+;  (* 
+.ft B
+B
+.ft R
+field documentation
+ *) 
+ more_label_for_B : 
+.B int list
+;  (* More 
+.ft B
+B
+.ft R
+field documentation
+ *) 
+ }
+.I "  "
+  (* Constructor B documentation
+ *)
+ | C
+.B of {
+ c_has_label_too : 
+.B float
+;  (* 
+.ft B
+C
+.ft R
+field documentation
+ *) 
+ more_than_one : 
+.B unit
+;  (* \&.\&.\&. documentations
+ *) 
+ }
+.I "  "
+  (* Constructor C documentation
+ *)
+ 
+.sp
+A sum type with two inline records
+
+.sp
+.I type any 
+=
+ | D
+.B of {
+ any : 
+.B 'a
+;  (* 
+.ft B
+A
+.ft R
+field 
+.ft B
+any:\&'a
+.ft R
+for 
+.ft B
+D
+.ft R
+in 
+.ft B
+any
+.ft R
+\&.
+ *) 
+ }
+.B -> 
+.B any
+.I "  "
+  (* Constructor D documentation
+ *)
+ 
+.sp
+A gadt constructor
+
+.sp
+
+.I exception Error 
+.B of {
+ name : 
+.B string
+;  (* Error field documentation 
+.ft B
+name:string
+.ft R
+
+ *) 
+ }
+
+.sp
+
+.sp
+.I type ext 
++=
+ | E
+.B of {
+ yet_another_field : 
+.B unit
+;  (* Field documentation for 
+.ft B
+E
+.ft R
+in ext
+ *) 
+ }
+.I "  "
+(* Constructor E documentation
+ *)
+ | F
+.B of {
+ even_more : 
+.B int -> int
+;  (* Some field documentations for 
+.ft B
+F
+.ft R
+
+ *) 
+ }
+.I "  "
+(* Constructor F documentation
+ *)
+ | G
+.B of {
+ last : 
+.B int -> int
+;  (* The last and least field documentation
+ *) 
+ }
+.I "  "
+(* Constructor G documentation
+ *)
+ 
+.sp
+Two new constructors for ext
+
+.sp
diff --git a/testsuite/tests/tool-ocamldoc/Inline_records.mli b/testsuite/tests/tool-ocamldoc/Inline_records.mli
new file mode 100644
index 00000000..5b4646d9
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Inline_records.mli
@@ -0,0 +1,54 @@
+(* TEST
+   * ocamldoc with html
+   * ocamldoc with latex
+   * ocamldoc with man
+*)
+
+(**
+  This test focuses on the printing of documentation for inline record
+  within the latex generator.
+*)
+
+
+(** A nice exception *)
+exception Simple
+
+(** A less simple exception *)
+exception Less of int
+
+(** An open sum type *)
+type ext = ..
+
+(** A simple record type for reference *)
+type r = { lbl: int (** Field documentation for non-inline, [lbl : int] *);
+          more:int list (** More documentation for r, [more : int list] *) }
+
+
+(** A sum type with one inline record *)
+type t = A of {lbl: int (** [A] field documentation *)
+              ; more:int list (** More [A] field documentation *) }
+(** Constructor documentation *)
+
+(** A sum type with two inline records *)
+type s =
+  | B of { a_label_for_B : int (** [B] field documentation *);
+               more_label_for_B:int list (** More [B] field documentation *) }
+  (** Constructor B documentation *)
+  | C of { c_has_label_too: float (** [C] field documentation*);
+           more_than_one: unit (** ... documentations *)  }
+  (** Constructor C documentation *)
+
+(** A gadt constructor *)
+type any = D: { any:'a (** [A] field [any:'a] for [D] in [any]. *) } -> any
+(** Constructor D documentation *)
+
+exception Error of {name:string (** Error field documentation [name:string] *) }
+
+type ext +=
+  | E of { yet_another_field: unit (** Field documentation for [E] in ext *) }
+  (** Constructor E documentation *)
+  | F of { even_more: int -> int (** Some field documentations for [F] *) }
+  (** Constructor F documentation *)
+  | G of { last: int -> int (** The last and least field documentation *) }
+  (** Constructor G documentation *)
+(** Two new constructors for ext *)
diff --git a/testsuite/tests/tool-ocamldoc/Inline_records_bis.latex.reference b/testsuite/tests/tool-ocamldoc/Inline_records_bis.latex.reference
new file mode 100644
index 00000000..25986d09
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Inline_records_bis.latex.reference
@@ -0,0 +1,286 @@
+\documentclass[11pt]{article} 
+\usepackage[latin1]{inputenc} 
+\usepackage[T1]{fontenc} 
+\usepackage{textcomp}
+\usepackage{fullpage} 
+\usepackage{url} 
+\usepackage{ocamldoc}
+\begin{document}
+\tableofcontents
+\section{Module {\tt{Inline\_records\_bis}} : This test focuses on the printing of documentation for inline record
+  within the latex generator.}
+\label{Inline-underscorerecords-underscorebis}\index{Inline-underscorerecords-underscorebis@\verb`Inline_records_bis`}
+
+
+
+
+\ocamldocvspace{0.5cm}
+
+
+
+\label{exception:Inline-underscorerecords-underscorebis.Simple}\begin{ocamldoccode}
+exception Simple
+\end{ocamldoccode}
+\index{Simple@\verb`Simple`}
+\begin{ocamldocdescription}
+A nice exception
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{exception:Inline-underscorerecords-underscorebis.Less}\begin{ocamldoccode}
+exception Less of int
+\end{ocamldoccode}
+\index{Less@\verb`Less`}
+\begin{ocamldocdescription}
+A less simple exception
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{TYPInline-underscorerecords-underscorebis.ext}\begin{ocamldoccode}
+type ext = ..
+\end{ocamldoccode}
+\index{ext@\verb`ext`}
+\begin{ocamldocdescription}
+An open sum type
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{TYPInline-underscorerecords-underscorebis.r}\begin{ocamldoccode}
+type r = 
+{\char123}  lbl : int ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Field documentation for non-inline, {\tt{lbl : int}}
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+  more : int list ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+More documentation for r, {\tt{more : int list}}
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\index{r@\verb`r`}
+\begin{ocamldocdescription}
+A simple record type for reference
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{TYPInline-underscorerecords-underscorebis.t}\begin{ocamldoccode}
+type t =
+  | A of {\char123}  lbl : int ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+{\tt{A}} field documentation
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+  more : int list ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+More {\tt{A}} field documentation
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Constructor documentation
+
+
+\end{ocamldoccomment}
+\index{t@\verb`t`}
+\begin{ocamldocdescription}
+A sum type with one inline record
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{TYPInline-underscorerecords-underscorebis.s}\begin{ocamldoccode}
+type s =
+  | B of {\char123}  a_label_for_B : int ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+{\tt{B}} field documentation
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+  more_label_for_B : int list ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+More {\tt{B}} field documentation
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Constructor B documentation
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+  | C of {\char123}  c_has_label_too : float ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+{\tt{C}} field documentation
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+  more_than_one : unit ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+$\ldots$ documentations
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Constructor C documentation
+
+
+\end{ocamldoccomment}
+\index{s@\verb`s`}
+\begin{ocamldocdescription}
+A sum type with two inline records
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{TYPInline-underscorerecords-underscorebis.any}\begin{ocamldoccode}
+type any =
+  | D : {\char123}  any : {\textquotesingle}a ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+{\tt{A}} field {\tt{any:{\textquotesingle}a}} for {\tt{D}} in {\tt{any}}.
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+ ->
+any
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Constructor D documentation
+
+
+\end{ocamldoccomment}
+\index{any@\verb`any`}
+\begin{ocamldocdescription}
+A gadt constructor
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{exception:Inline-underscorerecords-underscorebis.Error}\begin{ocamldoccode}
+exception Error of {\char123}  name : string ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Error field documentation {\tt{name:string}}
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\index{Error@\verb`Error`}
+
+
+
+
+\begin{ocamldoccode}
+type ext +=
+\end{ocamldoccode}
+\label{extension:Inline-underscorerecords-underscorebis.E}\begin{ocamldoccode}
+  | E of {\char123}  yet_another_field : unit ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Field documentation for {\tt{E}} in ext
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Constructor E documentation
+
+
+\end{ocamldoccomment}
+\label{extension:Inline-underscorerecords-underscorebis.F}\begin{ocamldoccode}
+  | F of {\char123}  even_more : int -> int ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Some field documentations for {\tt{F}}
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Constructor F documentation
+
+
+\end{ocamldoccomment}
+\label{extension:Inline-underscorerecords-underscorebis.G}\begin{ocamldoccode}
+  | G of {\char123}  last : int -> int ;
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+The last and least field documentation
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+{\char125}
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+Constructor G documentation
+
+
+\end{ocamldoccomment}
+
+
+
+
+Two new constructors for ext
+
+\end{document}
diff --git a/testsuite/tests/tool-ocamldoc/Inline_records_bis.ml b/testsuite/tests/tool-ocamldoc/Inline_records_bis.ml
new file mode 100644
index 00000000..4844aaf2
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Inline_records_bis.ml
@@ -0,0 +1,52 @@
+(* TEST
+   * ocamldoc with latex
+*)
+
+(**
+  This test focuses on the printing of documentation for inline record
+  within the latex generator.
+*)
+
+
+(** A nice exception *)
+exception Simple
+
+(** A less simple exception *)
+exception Less of int
+
+(** An open sum type *)
+type ext = ..
+
+(** A simple record type for reference *)
+type r = { lbl: int (** Field documentation for non-inline, [lbl : int] *);
+          more:int list (** More documentation for r, [more : int list] *) }
+
+
+(** A sum type with one inline record *)
+type t = A of {lbl: int (** [A] field documentation *)
+              ; more:int list (** More [A] field documentation *) }
+(** Constructor documentation *)
+
+(** A sum type with two inline records *)
+type s =
+  | B of { a_label_for_B : int (** [B] field documentation *);
+               more_label_for_B:int list (** More [B] field documentation *) }
+  (** Constructor B documentation *)
+  | C of { c_has_label_too: float (** [C] field documentation*);
+           more_than_one: unit (** ... documentations *)  }
+  (** Constructor C documentation *)
+
+(** A gadt constructor *)
+type any = D: { any:'a (** [A] field [any:'a] for [D] in [any]. *) } -> any
+(** Constructor D documentation *)
+
+exception Error of {name:string (** Error field documentation [name:string] *) }
+
+type ext +=
+  | E of { yet_another_field: unit (** Field documentation for [E] in ext *) }
+  (** Constructor E documentation *)
+  | F of { even_more: int -> int (** Some field documentations for [F] *) }
+  (** Constructor F documentation *)
+  | G of { last: int -> int (** The last and least field documentation *) }
+  (** Constructor G documentation *)
+(** Two new constructors for ext *)
diff --git a/testsuite/tests/tool-ocamldoc/Item_ids.html.reference b/testsuite/tests/tool-ocamldoc/Item_ids.html.reference
new file mode 100644
index 00000000..c3b66f3e
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Item_ids.html.reference
@@ -0,0 +1,53 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Item_ids
+
+
+
     Up
+ 
    
+
    Module Item_ids
    
+
+
    module Item_ids: sig .. end
    
+
    
+
    Check that all toplevel items are given a unique id.
    
+
    
+
    
+
    
+
+
    exception Ex
    
+
+
    type t 
    
+
+
+
    val x : t
    
+
    type ext = ..
    
+
+
    type ext += 
    
+
+
+
+
+
    
+|
+A
    
+
+
+
+
    class c : object .. end
    
+
    class type ct = object .. end
    
+
    module M: sig .. end
    
+
    module type s = sig .. end
    
diff --git a/testsuite/tests/tool-ocamldoc/Item_ids.mli b/testsuite/tests/tool-ocamldoc/Item_ids.mli
new file mode 100644
index 00000000..878c6fef
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Item_ids.mli
@@ -0,0 +1,16 @@
+(* TEST
+   * ocamldoc with html
+*)
+
+(** Check that all toplevel items are given a unique id. *)
+
+exception Ex
+type t
+val x: t
+type ext = ..
+type ext += A
+class c: object end
+class type ct= object end
+[@@@attribute]
+module M: sig end
+module type s = sig end
diff --git a/testsuite/tests/tool-ocamldoc/Level_0.latex.reference b/testsuite/tests/tool-ocamldoc/Level_0.latex.reference
new file mode 100644
index 00000000..f6fdba54
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Level_0.latex.reference
@@ -0,0 +1,36 @@
+\documentclass[11pt]{article} 
+\usepackage[latin1]{inputenc} 
+\usepackage[T1]{fontenc} 
+\usepackage{textcomp}
+\usepackage{fullpage} 
+\usepackage{url} 
+\usepackage{ocamldoc}
+\begin{document}
+\tableofcontents
+\section{Module {\tt{Level\_0}} : Test for level 0 headings}
+\label{Level-underscore0}\index{Level-underscore0@\verb`Level_0`}
+
+
+
+  \subsection*{Level 1}
+
+
+
+   Standard heading levels start at 1.
+
+
+  \section{Level 0}
+
+  A level 0 heading is guaranteed to be at the same level that
+  the main heading of the module.
+
+
+  This setup allows users to start their standard heading at level 1 rather
+  than 2, without losing the ability to add global level heading,
+  when, if ever, such heading is warranted
+
+
+
+\ocamldocvspace{0.5cm}
+
+\end{document}
diff --git a/testsuite/tests/tool-ocamldoc/Level_0.mli b/testsuite/tests/tool-ocamldoc/Level_0.mli
new file mode 100644
index 00000000..f7ac2a88
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Level_0.mli
@@ -0,0 +1,19 @@
+(* TEST
+  * ocamldoc with latex
+*)
+
+(** Test for level 0 headings
+
+  {1 Level 1}
+
+   Standard heading levels start at 1.
+
+  {0 Level 0}
+  A level 0 heading is guaranteed to be at the same level that
+  the main heading of the module.
+
+  This setup allows users to start their standard heading at level 1 rather
+  than 2, without losing the ability to add global level heading,
+  when, if ever, such heading is warranted
+
+ *)
diff --git a/testsuite/tests/tool-ocamldoc/Linebreaks.html.reference b/testsuite/tests/tool-ocamldoc/Linebreaks.html.reference
new file mode 100644
index 00000000..58ad73e6
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Linebreaks.html.reference
@@ -0,0 +1,135 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Linebreaks
+
+
+
     Up
+ 
    
+
    Module Linebreaks
    
+
+
    module Linebreaks: sig .. end
    
+
    
+
    This file tests the encoding of linebreak inside OCaml code by the
+   ocamldoc html backend.
    
+
+
    Two slightly different aspects are tested in this very file.
    
+
+
      
+
    • First, inside a "pre" tags, blanks character should not be escaped.
+   For instance, the generated html code for this test fragment should not
+   contain any <br> tag:
+   
           let f x =
+       let g x =
+         let h x = x in
+         h x in
+       g x
+   
      
+   See  MPR#6341 for more
+   details or the file Linebreaks.html generated by ocamldoc from this file.
      • 
+
    • Second, outside of a "pre"  tags, blank characters in embedded code
+   should be escaped, in order to make them render in a "pre"-like fashion.
+   A good example should be the files type_Modulename.html generated by
+   ocamldoc that should contains the signature of the module Modulename in
+   a "code" tags.
+   For instance with the following type definitions,
      • 
+
    
+
    
+
    
+
    
+
+
    type a = 
    
+
+
+
+
+
    
+|
+A
    
+
+
+
+
    type 'a b = {
    
+
+
+
+
+
    
+  
+field : 'a;
    
+}
+
+
+
+
    type c = 
    
+
+
+
+
+
    
+|
+C : 'a -> c
    
+
+
+
+
    type s = ..
    
+
+
    type s += 
    
+
+
+
+
+
    
+|
+B
    
+
+
+
+
    val x : a
    
+
    module S: sig .. end
    
+
    module type s = sig .. end
    
+
    class type d = object .. end
    
+
    exception E of {
+
+
+
+
+
    
+  
+inline : int;
    
+}
+
    
+
    type_Linebreaks.html should contain
    
+
+
    sig
+  type a = A
+  type 'a b = { field : 'a; }
+  type c = C : 'a -> Linebreaks.c
+  type s = ..
+  type s += B
+  val x : Linebreaks.a
+  module S : sig module I : sig  end end
+  module type s = sig  end
+  class type d = object  end
+  exception E of { inline : int; }
+end
+
    
+
    with <br> tags used for linebreaks.
+Another example would be  let f x =
    
+x     which is rendered with a <br> linebreak inside Linebreaks.html.
    
+
+
    See MPR#7272 for more
+information.
    
+
diff --git a/testsuite/tests/tool-ocamldoc/Linebreaks.mli b/testsuite/tests/tool-ocamldoc/Linebreaks.mli
new file mode 100644
index 00000000..1dce3838
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Linebreaks.mli
@@ -0,0 +1,75 @@
+(* TEST
+   * ocamldoc with html
+   ** check-program-output
+      output="type_Linebreaks.html"
+      reference="${test_source_directory}/type_Linebreaks.reference"
+*)
+
+(**
+   This file tests the encoding of linebreak inside OCaml code by the
+   ocamldoc html backend.
+
+   Two slightly different aspects are tested in this very file.
+
+   - First, inside a "pre" tags, blanks character should not be escaped.
+   For instance, the generated html code for this test fragment should not
+   contain any 
     tag:
+   {[
+     let f x =
+       let g x =
+         let h x = x in
+         h x in
+       g x
+   ]}
+   See {{:http://caml.inria.fr/mantis/view.php?id=6341} MPR#6341} for more
+   details or the file Linebreaks.html generated by ocamldoc from this file.
+   - Second, outside of a "pre"  tags, blank characters in embedded code
+   should be escaped, in order to make them render in a "pre"-like fashion.
+   A good example should be the files type_{i Modulename}.html generated by
+   ocamldoc that should contains the signature of the module [Modulename] in
+   a "code" tags.
+   For instance with the following type definitions,
+*)
+
+type a = A
+type 'a b = {field:'a}
+type c = C: 'a -> c
+
+type s = ..
+type s += B
+
+val x : a
+
+module S: sig module I:sig end end
+module type s = sig end
+
+class type d = object end
+
+exception E of {inline:int}
+
+
+(** type_Linebreaks.html should contain
+
+{[
+sig
+  type a = A
+  type 'a b = { field : 'a; }
+  type c = C : 'a -> Linebreaks.c
+  type s = ..
+  type s += B
+  val x : Linebreaks.a
+  module S : sig module I : sig  end end
+  module type s = sig  end
+  class type d = object  end
+  exception E of { inline : int; }
+end
+]}
+
+with 
     tags used for linebreaks.
+Another example would be [ let f x =
+x] which is rendered with a 
     linebreak inside Linebreaks.html.
+
+See {{:http://caml.inria.fr/mantis/view.php?id=7272}MPR#7272} for more
+information.
+
+*)
diff --git a/testsuite/tests/tool-ocamldoc/Loop.html.reference b/testsuite/tests/tool-ocamldoc/Loop.html.reference
new file mode 100644
index 00000000..74ad9a7e
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Loop.html.reference
@@ -0,0 +1,20 @@
+
+
+
+
+
+
+
+
+
+Loop
+
+
+
     Up
+ 
    
+
    Module Loop
    
+
+
    module Loop: sig .. end
    
+
+
    module A: B
    
+
    module B: A
    
diff --git a/testsuite/tests/tool-ocamldoc/Loop.latex.reference b/testsuite/tests/tool-ocamldoc/Loop.latex.reference
new file mode 100644
index 00000000..8c386f30
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Loop.latex.reference
@@ -0,0 +1,36 @@
+\documentclass[11pt]{article} 
+\usepackage[latin1]{inputenc} 
+\usepackage[T1]{fontenc} 
+\usepackage{textcomp}
+\usepackage{fullpage} 
+\usepackage{url} 
+\usepackage{ocamldoc}
+\begin{document}
+\tableofcontents
+\section{Module {\tt{Loop}}}
+\label{Loop}\index{Loop@\verb`Loop`}
+
+
+\ocamldocvspace{0.5cm}
+
+
+
+\begin{ocamldoccode}
+{\tt{module }}{\tt{A}}{\tt{ : }}\end{ocamldoccode}
+\label{Loop.A}\index{A@\verb`A`}
+
+{\tt{B}}
+
+
+
+
+
+\begin{ocamldoccode}
+{\tt{module }}{\tt{B}}{\tt{ : }}\end{ocamldoccode}
+\label{Loop.B}\index{B@\verb`B`}
+
+{\tt{A}}
+
+
+
+\end{document}
diff --git a/testsuite/tests/tool-ocamldoc/Loop.ml b/testsuite/tests/tool-ocamldoc/Loop.ml
new file mode 100644
index 00000000..8428f9fc
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Loop.ml
@@ -0,0 +1,5 @@
+(* TEST
+   * ocamldoc with html
+   * ocamldoc with latex
+*)
+module rec A : sig type t end = B and B : sig type t = A.t end = A;;
diff --git a/testsuite/tests/tool-ocamldoc/Module_whitespace.html.reference b/testsuite/tests/tool-ocamldoc/Module_whitespace.html.reference
new file mode 100644
index 00000000..c31de5be
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Module_whitespace.html.reference
@@ -0,0 +1,24 @@
+
+
+
+
+
+
+
+
+
+Module_whitespace
+
+
+
     Up
+ 
    
+
    Module Module_whitespace
    
+
+
    module Module_whitespace: sig .. end
    
+
+
    module M: Stdlib.Set.Make(sig
    
+
    type t = int 
    
+
+
+
    val compare : 'a -> 'a -> int
    
+
    end)
    
diff --git a/testsuite/tests/tool-ocamldoc/Module_whitespace.ml b/testsuite/tests/tool-ocamldoc/Module_whitespace.ml
new file mode 100644
index 00000000..75c6c292
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Module_whitespace.ml
@@ -0,0 +1,8 @@
+(* TEST
+   * ocamldoc with html
+*)
+
+module M = Set.Make(struct
+        type t = int
+        let compare = compare
+end)
diff --git a/testsuite/tests/tool-ocamldoc/Module_whitespace.ocamldoc.html.reference b/testsuite/tests/tool-ocamldoc/Module_whitespace.ocamldoc.html.reference
new file mode 100644
index 00000000..515605c3
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Module_whitespace.ocamldoc.html.reference
@@ -0,0 +1,2 @@
+Warning: Module or module type Stdlib.Set.Make not found
+Warning: Module or module type Stdlib.Set.Make not found
diff --git a/testsuite/tests/tool-ocamldoc/No_preamble.html.reference b/testsuite/tests/tool-ocamldoc/No_preamble.html.reference
new file mode 100644
index 00000000..0f386701
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/No_preamble.html.reference
@@ -0,0 +1,25 @@
+
+
+
+
+
+
+
+
+
+
+No_preamble
+
+
+
     Up
+ 
    
+
    Module No_preamble
    
+
+
    module No_preamble: sig .. end
    
+
+
    val x : unit
    
+
    
+
    This is a documentation comment for x, not a module preamble.
    
+
    
+
    
+
diff --git a/testsuite/tests/tool-ocamldoc/No_preamble.mli b/testsuite/tests/tool-ocamldoc/No_preamble.mli
new file mode 100644
index 00000000..7d016dda
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/No_preamble.mli
@@ -0,0 +1,8 @@
+(* TEST
+   * ocamldoc with html
+*)
+
+open String
+
+(** This is a documentation comment for [x], not a module preamble. *)
+val x: unit
diff --git a/testsuite/tests/tool-ocamldoc/Paragraph.html.reference b/testsuite/tests/tool-ocamldoc/Paragraph.html.reference
new file mode 100644
index 00000000..7cc2bc1f
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Paragraph.html.reference
@@ -0,0 +1,75 @@
+
+
+
+
+
+
+
+
+
+
+Paragraph
+
+
+
     Up
+ 
    
+
    Module Paragraph
    
+
+
    module Paragraph: sig .. end
    
+
    
+
    This file tests the generation of paragraph within module comments.
    
+
+
    At least three points should be exercised in this tests
    
+
+
      
+
    • First, all text should be tagged
      • 
+
    • Second, no paragraph should contain only spaces characters
      • 
+
    • Third, the mixing of different text style should not create
+    invalid p tags
      • 
+
    
+
    See also  MPR:7352,
+     MPR:7353
    
+
+
    Testing non-text elements 
    
+
    code x  should  be inside a p.
    
+
+
    But not
    
+
          let complex_code = ()
+    
    here.
    
+
+
      
+
    1. An enumerated list first element
      2. 
+
    2. second element
      3. 
+
    
+
    Alignment test: left
    Right
    Center
    
+
    Other complex textin subscript and superscript
    
+
+
    There is also html specific  elements.
    
+
    
+
      
+
    • Author(s): : Florian Angeletti
      • 
+
    • Version: : 1
      • 
+
    
+
    
+
    
+
+
    type t 
    
+
    
+
    
+
    And cross-reference Paragraph.t.
+   
+
+
+
    Paragraph
    
+
    This file tests the generation of paragraph within module comments.
    
+
+
    
+
    
+
+
    
+
    
+
+
diff --git a/testsuite/tests/tool-ocamldoc/Paragraph.mli b/testsuite/tests/tool-ocamldoc/Paragraph.mli
new file mode 100644
index 00000000..8073c7cd
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Paragraph.mli
@@ -0,0 +1,54 @@
+(* TEST
+   * ocamldoc with html
+*)
+
+(** This file tests the generation of paragraph within module comments.
+
+
+    At least three points should be exercised in this tests
+
+    - First, all text should be tagged
+    - Second, no paragraph should contain only spaces characters
+    - Third, the mixing of different text style should not create
+    invalid p tags
+
+
+    See also {{: http://caml.inria.fr/mantis/view.php?id=7352} MPR:7352},
+    {{: http://caml.inria.fr/mantis/view.php?id=7353} MPR:7353}
+
+    {2:here Testing non-text elements }
+
+    [code x ] {i should } be inside a p.
+
+
+    {e But} {b not}
+    {[
+      let complex_code = ()
+    ]}
+    here.
+
+    + An enumerated list first element
+    + second element
+
+    {L Alignment test: left}
+    {R Right}
+    {C Center}
+
+
+    Other complex text{_ in subscript }{^ and superscript}
+    {V Verbatim V}
+
+    There is also {%html: html specific %} elements.
+
+    @author: Florian Angeletti
+    @version: 1
+*)
+
+(** *)
+
+type t
+(**
+    And cross-reference {! t}.
+   {!modules: Paragraph}
+   {!indexlist}
+*)
diff --git a/testsuite/tests/tool-ocamldoc/Short_description.latex.reference b/testsuite/tests/tool-ocamldoc/Short_description.latex.reference
new file mode 100644
index 00000000..4a938e41
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Short_description.latex.reference
@@ -0,0 +1,26 @@
+\documentclass[11pt]{article} 
+\usepackage[latin1]{inputenc} 
+\usepackage[T1]{fontenc} 
+\usepackage{textcomp}
+\usepackage{fullpage} 
+\usepackage{url} 
+\usepackage{ocamldoc}
+\begin{document}
+\tableofcontents
+\section{Short\_description : (* TEST
+   * ocamldoc with latex
+*)}
+\label{Short-underscoredescription}\index{Short-underscoredescription@\verb`Short_description`}
+
+
+
+Short global description in text mode
+
+
+This file tests that documentation in text mode are given
+a short description in the global description of modules.
+
+
+
+
+\end{document}
diff --git a/testsuite/tests/tool-ocamldoc/Short_description.txt b/testsuite/tests/tool-ocamldoc/Short_description.txt
new file mode 100644
index 00000000..e0021ea6
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Short_description.txt
@@ -0,0 +1,8 @@
+(* TEST
+   * ocamldoc with latex
+*)
+
+Short global description in text mode
+
+This file tests that documentation in text mode are given
+a short description in the global description of modules.
diff --git a/testsuite/tests/tool-ocamldoc/Test.latex.reference b/testsuite/tests/tool-ocamldoc/Test.latex.reference
new file mode 100644
index 00000000..a9861f7f
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Test.latex.reference
@@ -0,0 +1,74 @@
+\documentclass[11pt]{article} 
+\usepackage[latin1]{inputenc} 
+\usepackage[T1]{fontenc} 
+\usepackage{textcomp}
+\usepackage{fullpage} 
+\usepackage{url} 
+\usepackage{ocamldoc}
+\begin{document}
+\tableofcontents
+\section{Module {\tt{Test}} : Ten comments for tests}
+\label{Test}\index{Test@\verb`Test`}
+
+
+
+
+\ocamldocvspace{0.5cm}
+
+
+
+\subsection*{A first comments for title }
+
+
+
+
+\subsubsection*{A subsection for ocamldoc *}
+
+
+
+
+\subsubsection*{Bis }
+
+
+
+
+\subsubsection*{Ter }
+
+
+
+
+\subsection*{A new section }
+
+
+
+
+\subsubsection*{And its subsection }
+
+
+
+
+\subsubsection*{Encore }
+
+
+
+
+Encore! Encore!
+
+
+
+\subsubsection*{With strange aeons }
+
+
+
+
+\begin{ocamldoccode}
+{\tt{module }}{\tt{End}}{\tt{ : }}\end{ocamldoccode}
+\label{Test.End}\index{End@\verb`End`}
+
+\begin{ocamldocsigend}
+\end{ocamldocsigend}
+
+
+
+
+\end{document}
diff --git a/testsuite/tests/tool-ocamldoc/Test.mli b/testsuite/tests/tool-ocamldoc/Test.mli
new file mode 100644
index 00000000..b28c8e73
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Test.mli
@@ -0,0 +1,33 @@
+(* TEST
+   * ocamldoc with latex
+*)
+
+(** Ten comments for tests *)
+
+(** {6 A first comments for title } *)
+
+(** {7 A subsection for ocamldoc *} *)
+
+(** {7 Bis } *)
+
+(** {7 Ter } *)
+
+(** {6 A new section } *)
+
+(** {7 And its subsection } *)
+
+(** {7 Encore } *)
+
+(** Encore! Encore! *)
+
+
+(**/**)
+module Silence : sig
+  (** At last *)
+end
+
+(**/**)
+
+(** {7 With strange aeons } *)
+
+module End : sig end
diff --git a/testsuite/tests/tool-ocamldoc/Variants.html.reference b/testsuite/tests/tool-ocamldoc/Variants.html.reference
new file mode 100644
index 00000000..0858bde1
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Variants.html.reference
@@ -0,0 +1,282 @@
+
+
+
+
+
+
+
+
+
+
+Variants
+
+
+
     Up
+ 
    
+
    Module Variants
    
+
+
    module Variants: sig .. end
    
+
    
+
    This test is here to check the latex code generated for variants
    
+
    
+
    
+
    
+
+
    type s = 
    
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
    
+|
+A
    
+|
+B(*
    
+
    
+
    only B is documented here
    
+
    
+
    
+    		*)
    
+|
+C
    
+
+
+
+
    type t = 
    
+
+
+
+
+
+
+
+
+
+
    
+|
+A(*
    
+
    
+
    doc for A.
    
+
    0
    With three paragraphs.
    
+
    1
    To check styling
    
+
    
+
    
+    		*)
    
+|
+B(*
    
+
    
+
    doc for B
    
+
    
+
    
+    		*)
    
+
+
+
+
    type u = 
    
+
+
+
+
+
+
+
+
+
+
    
+|
+A(*
    
+
    
+
    doc for A
    
+
    
+
    
+    		*)
    
+|
+B of unit(*
    
+
    
+
    doc for B
    
+
    
+
    
+    		*)
    
+
+
    
+
    
+
    Some documentation for u
    
+
    
+
    
+
+
+
    type w = 
    
+
+
+
+
+
+
+
+
+
+
    
+|
+A of {
+
+
+
+
+
    
+  
+x : int;
    
+}
+    		(*
    
+
    
+
    doc for A
    
+
    
+
    
+    		*)
    
+|
+B of {
+
+
+
+
+
    
+  
+y : int;
    
+}
+    		(*
    
+
    
+
    doc for B
    
+
    
+
    
+    		*)
    
+
+
    
+
    
+
    With records
    
+
    
+
    
+
+
+
    type z = 
    
+
+
+
+
+
+
+
+
+
+
    
+|
+A of int(*
    
+
    
+
    doc for A
    
+
    
+
    
+    		*)
    
+|
+B of int(*
    
+
    
+
    doc for B
    
+
    
+
    
+    		*)
    
+
+
    
+
    
+
    With args
    
+
    
+
    
+
+
+
    type a = 
    
+
+
+
+
+
    
+|
+A : a(*
    
+
    
+
    doc for A
    
+
    
+
    
+    		*)
    
+
+
    
+
    
+
    Gadt notation
    
+
    
+
    
+
+
+
    type b = 
    
+
+
+
+
+
    
+|
+B(*
    
+
    
+
    doc for B
    
+
    
+
    
+    		*)
    
+
+
    
+
    
+
    Lonely constructor
    
+
    
+
    
+
+
+
    type no_documentation = 
    
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
    
+|
+A
    
+|
+B
    
+|
+C
    
+
+
+
+
    type e = 
    
+
+
+
    
+|
+
    
+
+
    
+
    
+
    Empty variant
    
+
    
+
    
+
+
diff --git a/testsuite/tests/tool-ocamldoc/Variants.latex.reference b/testsuite/tests/tool-ocamldoc/Variants.latex.reference
new file mode 100644
index 00000000..bc618391
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Variants.latex.reference
@@ -0,0 +1,214 @@
+\documentclass[11pt]{article} 
+\usepackage[latin1]{inputenc} 
+\usepackage[T1]{fontenc} 
+\usepackage{textcomp}
+\usepackage{fullpage} 
+\usepackage{url} 
+\usepackage{ocamldoc}
+\begin{document}
+\tableofcontents
+\section{Module {\tt{Variants}} : This test is here to check the latex code generated for variants}
+\label{Variants}\index{Variants@\verb`Variants`}
+
+
+
+
+\ocamldocvspace{0.5cm}
+
+
+
+\label{TYPVariants.s}\begin{ocamldoccode}
+type s =
+  | A
+  | B
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+only B is documented here
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+  | C
+\end{ocamldoccode}
+\index{s@\verb`s`}
+
+
+
+
+\label{TYPVariants.t}\begin{ocamldoccode}
+type t =
+  | A
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+doc for A.
+        \begin{ocamldoccode}
+0
+\end{ocamldoccode}
+
+        With three paragraphs.
+        \begin{ocamldoccode}
+1
+\end{ocamldoccode}
+
+        To check styling
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+  | B
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+doc for B
+
+
+\end{ocamldoccomment}
+\index{t@\verb`t`}
+
+
+
+
+\label{TYPVariants.u}\begin{ocamldoccode}
+type u =
+  | A
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+doc for A
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+  | B of unit
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+doc for B
+
+
+\end{ocamldoccomment}
+\index{u@\verb`u`}
+\begin{ocamldocdescription}
+Some documentation for u
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{TYPVariants.w}\begin{ocamldoccode}
+type w =
+  | A of {\char123}  x : int ;
+{\char125}
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+doc for A
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+  | B of {\char123}  y : int ;
+{\char125}
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+doc for B
+
+
+\end{ocamldoccomment}
+\index{w@\verb`w`}
+\begin{ocamldocdescription}
+With records
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{TYPVariants.z}\begin{ocamldoccode}
+type z =
+  | A of int
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+doc for A
+
+
+\end{ocamldoccomment}
+\begin{ocamldoccode}
+  | B of int
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+doc for B
+
+
+\end{ocamldoccomment}
+\index{z@\verb`z`}
+\begin{ocamldocdescription}
+With args
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{TYPVariants.a}\begin{ocamldoccode}
+type a =
+  | A : a
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+doc for A
+
+
+\end{ocamldoccomment}
+\index{a@\verb`a`}
+\begin{ocamldocdescription}
+Gadt notation
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{TYPVariants.b}\begin{ocamldoccode}
+type b =
+  | B
+\end{ocamldoccode}
+\begin{ocamldoccomment}
+doc for B
+
+
+\end{ocamldoccomment}
+\index{b@\verb`b`}
+\begin{ocamldocdescription}
+Lonely constructor
+
+
+\end{ocamldocdescription}
+
+
+
+
+\label{TYPVariants.no-underscoredocumentation}\begin{ocamldoccode}
+type no_documentation =
+  | A
+  | B
+  | C
+\end{ocamldoccode}
+\index{no-underscoredocumentation@\verb`no_documentation`}
+
+
+
+
+\label{TYPVariants.e}\begin{ocamldoccode}
+type e =
+  |
+\end{ocamldoccode}
+\index{e@\verb`e`}
+\begin{ocamldocdescription}
+Empty variant
+
+
+\end{ocamldocdescription}
+
+
+\end{document}
diff --git a/testsuite/tests/tool-ocamldoc/Variants.mli b/testsuite/tests/tool-ocamldoc/Variants.mli
new file mode 100644
index 00000000..137a42ce
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Variants.mli
@@ -0,0 +1,51 @@
+(* TEST
+   * ocamldoc with html
+   * ocamldoc with latex
+*)
+
+(** This test is here to check the latex code generated for variants *)
+
+type s = A | B (** only B is documented here *) | C
+
+type t =
+  | A
+    (** doc for A.
+        {[0]}
+        With three paragraphs.
+        {[1]}
+        To check styling
+    *)
+  | B
+  (** doc for B *)
+
+(** Some documentation for u*)
+type u =
+| A (** doc for A *) | B of unit (** doc for B *)
+
+
+(** With records *)
+type w =
+| A of { x: int }
+    (** doc for A *)
+| B of { y:int }
+    (** doc for B *)
+
+(** With args *)
+type z =
+| A of int
+    (** doc for A *)
+| B of int
+    (** doc for B *)
+
+(** Gadt notation *)
+type a =
+    A: a (** doc for A*)
+
+(** Lonely constructor *)
+type b =
+  B (** doc for B *)
+
+type no_documentation = A | B | C
+
+(** Empty variant *)
+type e = |
diff --git a/testsuite/tests/tool-ocamldoc/latex_ref.latex.reference b/testsuite/tests/tool-ocamldoc/latex_ref.latex.reference
new file mode 100644
index 00000000..5daabbc2
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/latex_ref.latex.reference
@@ -0,0 +1,27 @@
+\documentclass[11pt]{article} 
+\usepackage[latin1]{inputenc} 
+\usepackage[T1]{fontenc} 
+\usepackage{textcomp}
+\usepackage{fullpage} 
+\usepackage{url} 
+\usepackage{ocamldoc}
+\begin{document}
+\tableofcontents
+\section{Module {\tt{Latex\_ref}} : Latex-only test}
+\label{Latex-underscoreref}\index{Latex-underscoreref@\verb`Latex_ref`}
+
+
+
+
+\ocamldocvspace{0.5cm}
+
+
+
+\subsection*{Title }
+\label{lbl}
+
+
+    Check that this text[\ref{lbl}] is present in the generated latex
+    with a reference to [\ref{lbl}].
+
+\end{document}
diff --git a/testsuite/tests/tool-ocamldoc/latex_ref.mli b/testsuite/tests/tool-ocamldoc/latex_ref.mli
new file mode 100644
index 00000000..8424aa89
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/latex_ref.mli
@@ -0,0 +1,11 @@
+(* TEST
+   * ocamldoc with latex
+*)
+
+(** Latex-only test *)
+
+(** {1:lbl Title }
+
+    Check that {{!lbl}this text} is present in the generated latex
+    with a reference to {!lbl}.
+*)
diff --git a/testsuite/tests/tool-ocamldoc/odoc_test.ml b/testsuite/tests/tool-ocamldoc/odoc_test.ml
new file mode 100644
index 00000000..068f1e09
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/odoc_test.ml
@@ -0,0 +1,116 @@
+(** Custom generator to perform test on ocamldoc. *)
+
+open Odoc_info
+open Odoc_info.Module
+open Odoc_info.Type
+
+type test_kind =
+    Types_display
+
+let p = Format.fprintf
+
+class string_gen =
+  object(self)
+    inherit Odoc_info.Scan.scanner
+
+    val mutable test_kinds = []
+    val mutable fmt = Format.str_formatter
+
+    method must_display_types = List.mem Types_display test_kinds
+
+    method set_test_kinds_from_module m =
+      test_kinds <- List.fold_left
+          (fun acc (s, _) ->
+            match s with
+              "test_types_display" -> Types_display :: acc
+            | _ -> acc
+          )
+          []
+          (
+           match m.m_info with
+             None -> []
+           | Some i -> i.i_custom
+          )
+    method! scan_type t =
+      match test_kinds with
+        [] -> ()
+      | _ ->
+          p fmt "# type %s:\n" t.ty_name;
+          if self#must_display_types then
+            (
+             p fmt "# manifest (Odoc_info.string_of_type_expr):\n<[%s]>\n"
+               (match t.ty_manifest with
+                 None -> "None"
+               | Some (Other e) -> Odoc_info.string_of_type_expr e
+               | Some (Object_type fields) ->
+                 let b = Buffer.create 256 in
+                 Buffer.add_string b "<";
+                 List.iter
+                   (fun fd ->
+                     Printf.bprintf b " %s: %s ;"
+                       fd.of_name
+                       (Odoc_info.string_of_type_expr fd.of_type)
+                   )
+                   fields;
+                 Buffer.add_string b " >";
+                 Buffer.contents b
+               );
+            );
+
+
+    method! scan_module_pre m =
+      p fmt "#\n# module %s:\n" m.m_name ;
+      if self#must_display_types then
+        (
+         p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
+           (Odoc_info.string_of_module_type m.m_type);
+         p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
+           (Odoc_info.string_of_module_type ~complete: true m.m_type);
+        );
+      true
+
+    method! scan_module_type_pre m =
+      p fmt "#\n# module type %s:\n" m.mt_name ;
+      if self#must_display_types then
+        (
+         p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
+           (match m.mt_type with
+             None -> "None"
+           | Some t -> Odoc_info.string_of_module_type t
+           );
+         p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
+           (match m.mt_type with
+             None -> "None"
+           | Some t -> Odoc_info.string_of_module_type ~complete: true t
+           );
+        );
+      true
+
+    method generate (module_list: Odoc_info.Module.t_module list) =
+      let oc = open_out !Odoc_info.Global.out_file in
+      fmt <- Format.formatter_of_out_channel oc;
+      (
+       try
+         List.iter
+           (fun m ->
+             self#set_test_kinds_from_module m;
+             self#scan_module_list [m];
+           )
+           module_list
+       with
+         e ->
+           prerr_endline (Printexc.to_string e)
+      );
+      Format.pp_print_flush fmt ();
+      close_out oc
+  end
+
+let _ =
+  let module My_generator = struct
+    class generator =
+    let inst = new string_gen in
+    object
+      method generate = inst#generate
+    end
+  end in
+  Odoc_args.set_generator (Odoc_gen.Base (module My_generator : Odoc_gen.Base))
diff --git a/testsuite/tests/tool-ocamldoc/t01.ml b/testsuite/tests/tool-ocamldoc/t01.ml
new file mode 100644
index 00000000..1003b47f
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/t01.ml
@@ -0,0 +1,33 @@
+(* TEST
+   plugins="odoc_test.ml"
+   * ocamldoc
+    flags="-I ${ocamlsrcdir}/ocamldoc"
+*)
+
+(** Testing display of types.
+
+   @test_types_display
+ *)
+
+let x = 1
+
+
+module M = struct
+  let y = 2
+
+end
+
+module type MT = sig
+  type t = string -> int -> string -> (string * string * string) ->
+    (string * string * string) ->
+      (string * string * string) -> unit
+  val y : int
+
+  type ob = < f : int >
+
+  type obj_type =
+     < foo : int ; bar : float -> string ; ob ; gee : int -> (int * string) >
+
+  type g = [`A]
+  type h = [`B of int | g | `C of string]
+end
diff --git a/testsuite/tests/tool-ocamldoc/t01.reference b/testsuite/tests/tool-ocamldoc/t01.reference
new file mode 100644
index 00000000..1c2e0a77
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/t01.reference
@@ -0,0 +1,51 @@
+#
+# module T01:
+# Odoc_info.string_of_module_type:
+<[sig end]>
+# Odoc_info.string_of_module_type ~complete: true :
+<[sig end]>
+#
+# module T01.M:
+# Odoc_info.string_of_module_type:
+<[sig end]>
+# Odoc_info.string_of_module_type ~complete: true :
+<[sig val y : int end]>
+#
+# module type T01.MT:
+# Odoc_info.string_of_module_type:
+<[sig end]>
+# Odoc_info.string_of_module_type ~complete: true :
+<[sig
+  type t =
+      string ->
+      int ->
+      string ->
+      string * string * string ->
+      string * string * string -> string * string * string -> unit
+  val y : int
+  type ob = < f : int >
+  type obj_type =
+      < bar : float -> string; f : int; foo : int;
+        gee : int -> int * string >
+  type g = [ `A ]
+  type h = [ `A | `B of int | `C of string ]
+end]>
+# type T01.MT.t:
+# manifest (Odoc_info.string_of_type_expr):
+<[string ->
+  int ->
+  string ->
+  string * string * string ->
+  string * string * string -> string * string * string -> unit]>
+# type T01.MT.ob:
+# manifest (Odoc_info.string_of_type_expr):
+<[< f: int ; >]>
+# type T01.MT.obj_type:
+# manifest (Odoc_info.string_of_type_expr):
+<[< bar: float -> string ; f: int ; foo: int ; gee: int -> int * string ; >]>
+# type T01.MT.g:
+# manifest (Odoc_info.string_of_type_expr):
+<[[ `A ]]>
+# type T01.MT.h:
+# manifest (Odoc_info.string_of_type_expr):
+<[[ `A | `B of int | `C of string ]]>
diff --git a/testsuite/tests/tool-ocamldoc/t02.ml b/testsuite/tests/tool-ocamldoc/t02.ml
new file mode 100644
index 00000000..a2280cf8
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/t02.ml
@@ -0,0 +1,16 @@
+(* TEST
+   plugins="odoc_test.ml"
+   * ocamldoc
+    flags="-I ${ocamlsrcdir}/ocamldoc"
+*)
+
+module Foo = struct type u type t = int let x = 1 end;;
+module type TFoo = module type of Foo;;
+
+module type TBar = TFoo with type u := float;;
+
+module type Gee =
+  sig
+    module M : module type of Foo
+    include module type of Foo
+  end
diff --git a/testsuite/tests/tool-ocamldoc/t02.reference b/testsuite/tests/tool-ocamldoc/t02.reference
new file mode 100644
index 00000000..f1e7de43
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/t02.reference
@@ -0,0 +1,12 @@
+#
+# module T02:
+#
+# module T02.Foo:
+#
+# module type T02.TFoo:
+#
+# module type T02.TBar:
+#
+# module type T02.Gee:
+#
+# module T02.Gee.M:
diff --git a/testsuite/tests/tool-ocamldoc/t03.ml b/testsuite/tests/tool-ocamldoc/t03.ml
new file mode 100644
index 00000000..3ee319ba
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/t03.ml
@@ -0,0 +1,18 @@
+(* TEST
+   plugins="odoc_test.ml"
+   * ocamldoc
+    flags="-I ${ocamlsrcdir}/ocamldoc"
+*)
+
+module Foo = struct type t = int let x = 1 end;;
+module type MT = module type of Foo;;
+module Bar = struct type t = int let x = 2 end;;
+
+module type MT2 = sig type t val x : t end;;
+module type Gee = MT2 with type t = float ;;
+module T = (val
+    (if true
+     then (module Foo:MT2 with type t = int)
+     else (module Bar: MT2 with type t = int))
+    : MT2 with type t = int)
+;;
diff --git a/testsuite/tests/tool-ocamldoc/t03.ocamldoc.reference b/testsuite/tests/tool-ocamldoc/t03.ocamldoc.reference
new file mode 100644
index 00000000..cbf7ddcc
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/t03.ocamldoc.reference
@@ -0,0 +1 @@
+Warning: Module type  not found
diff --git a/testsuite/tests/tool-ocamldoc/t03.reference b/testsuite/tests/tool-ocamldoc/t03.reference
new file mode 100644
index 00000000..174e2199
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/t03.reference
@@ -0,0 +1,14 @@
+#
+# module T03:
+#
+# module T03.Foo:
+#
+# module type T03.MT:
+#
+# module T03.Bar:
+#
+# module type T03.MT2:
+#
+# module type T03.Gee:
+#
+# module T03.T:
diff --git a/testsuite/tests/tool-ocamldoc/t04.ml b/testsuite/tests/tool-ocamldoc/t04.ml
new file mode 100644
index 00000000..d815b4cc
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/t04.ml
@@ -0,0 +1,26 @@
+(* TEST
+   plugins="odoc_test.ml"
+   * ocamldoc
+    flags="-I ${ocamlsrcdir}/ocamldoc"
+*)
+
+(** Testing display of inline record.
+
+   @test_types_display
+ *)
+
+
+module A = struct
+  type a = A of {lbl:int}
+
+end
+
+module type E = sig
+  exception E of {lbl:int}
+
+end
+
+
+module E_bis= struct
+  exception E of {lbl:int}
+end
diff --git a/testsuite/tests/tool-ocamldoc/t04.reference b/testsuite/tests/tool-ocamldoc/t04.reference
new file mode 100644
index 00000000..fc3c5f65
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/t04.reference
@@ -0,0 +1,27 @@
+#
+# module T04:
+# Odoc_info.string_of_module_type:
+<[sig end]>
+# Odoc_info.string_of_module_type ~complete: true :
+<[sig end]>
+#
+# module T04.A:
+# Odoc_info.string_of_module_type:
+<[sig end]>
+# Odoc_info.string_of_module_type ~complete: true :
+<[sig type a = A of { lbl : int; } end]>
+# type T04.A.a:
+# manifest (Odoc_info.string_of_type_expr):
+<[None]>
+#
+# module type T04.E:
+# Odoc_info.string_of_module_type:
+<[sig end]>
+# Odoc_info.string_of_module_type ~complete: true :
+<[sig exception E of { lbl : int; } end]>
+#
+# module T04.E_bis:
+# Odoc_info.string_of_module_type:
+<[sig end]>
+# Odoc_info.string_of_module_type ~complete: true :
+<[sig exception E of { lbl : int; } end]>
diff --git a/testsuite/tests/tool-ocamldoc/t05.ml b/testsuite/tests/tool-ocamldoc/t05.ml
new file mode 100644
index 00000000..885dc90a
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/t05.ml
@@ -0,0 +1,7 @@
+(* TEST
+   plugins="odoc_test.ml"
+    * ocamldoc
+    flags="-I ${ocamlsrcdir}/ocamldoc"
+*)
+
+module rec A : sig type t end = B and B : sig type t = A.t end = A;;
diff --git a/testsuite/tests/tool-ocamldoc/t05.reference b/testsuite/tests/tool-ocamldoc/t05.reference
new file mode 100644
index 00000000..4a043e39
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/t05.reference
@@ -0,0 +1,6 @@
+#
+# module T05:
+#
+# module T05.A:
+#
+# module T05.B:
diff --git a/testsuite/tests/tool-ocamldoc/type_Linebreaks.reference b/testsuite/tests/tool-ocamldoc/type_Linebreaks.reference
new file mode 100644
index 00000000..86bd8646
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/type_Linebreaks.reference
@@ -0,0 +1,27 @@
+
+
+
+
+
+
+
+
+
+
+
+
+Linebreaks
+
+
+sig
    
+  type a = A
    
+  type 'a b = { field : 'a; }
    
+  type c = C : 'a -> Linebreaks.c
    
+  type s = ..
    
+  type s += B
    
+  val x : Linebreaks.a
    
+  module S : sig module I : sig end end
    
+  module type s = sig end
    
+  class type d = object  end
    
+  exception E of { inline : int; }
    
+end    
diff --git a/testsuite/tests/tool-ocamlobjinfo/has-lib-bfd.sh b/testsuite/tests/tool-ocamlobjinfo/has-lib-bfd.sh
new file mode 100644
index 00000000..1b268740
--- /dev/null
+++ b/testsuite/tests/tool-ocamlobjinfo/has-lib-bfd.sh
@@ -0,0 +1,7 @@
+#!/bin/sh
+
+if grep -q "#define HAS_LIBBFD" ${ocamlsrcdir}/runtime/caml/s.h; then
+  exit ${TEST_PASS};
+fi
+echo libbfd not available > ${ocamltest_response}
+exit ${TEST_SKIP}
diff --git a/testsuite/tests/tool-ocamlobjinfo/question.ml b/testsuite/tests/tool-ocamlobjinfo/question.ml
new file mode 100644
index 00000000..b8848e68
--- /dev/null
+++ b/testsuite/tests/tool-ocamlobjinfo/question.ml
@@ -0,0 +1,15 @@
+(* TEST
+script = "sh ${test_source_directory}/has-lib-bfd.sh"
+* shared-libraries
+** script
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+flags = "-shared"
+all_modules = "question.ml"
+program = "question.cmxs"
+***** check-ocamlopt.byte-output
+****** ocamlobjinfo
+******* check-program-output
+*)
+
+let answer = 42
diff --git a/testsuite/tests/tool-ocamlobjinfo/question.reference b/testsuite/tests/tool-ocamlobjinfo/question.reference
new file mode 100644
index 00000000..513bf9c1
--- /dev/null
+++ b/testsuite/tests/tool-ocamlobjinfo/question.reference
@@ -0,0 +1,10 @@
+File question.cmxs
+Name: Question
+CRC of implementation: 00000000000000000000000000000000
+Globals defined:
+	Question
+Interfaces imported:
+	00000000000000000000000000000000	Stdlib
+	00000000000000000000000000000000	Question
+	00000000000000000000000000000000	CamlinternalFormatBasics
+Implementations imported:
diff --git a/testsuite/tests/tool-ocamlopt-stop-after/stop_after_scheduling.ml b/testsuite/tests/tool-ocamlopt-stop-after/stop_after_scheduling.ml
new file mode 100644
index 00000000..dfa97ffd
--- /dev/null
+++ b/testsuite/tests/tool-ocamlopt-stop-after/stop_after_scheduling.ml
@@ -0,0 +1,12 @@
+(* TEST
+ * native-compiler
+ ** setup-ocamlopt.byte-build-env
+ *** ocamlopt.byte
+   flags = "-stop-after scheduling -S"
+   ocamlopt_byte_exit_status = "0"
+ **** check-ocamlopt.byte-output
+ ***** script
+   script = "sh ${test_source_directory}/stop_after_scheduling.sh"
+*)
+
+(* this file is just a test driver, the test does not contain real OCaml code *)
diff --git a/testsuite/tests/tool-ocamlopt-stop-after/stop_after_scheduling.sh b/testsuite/tests/tool-ocamlopt-stop-after/stop_after_scheduling.sh
new file mode 100755
index 00000000..ae04153b
--- /dev/null
+++ b/testsuite/tests/tool-ocamlopt-stop-after/stop_after_scheduling.sh
@@ -0,0 +1,24 @@
+#!/bin/sh
+
+set -e
+
+asm=stop_after_scheduling.${asmext}
+obj=stop_after_scheduling.${objext}
+cmx=stop_after_scheduling.cmx
+
+# Check that cmx is generated but asm and obj are not
+if [ -e "$asm" ] ; then
+    echo "unexpected $asm found" > ${ocamltest_response}
+    test_result=${TEST_FAIL}
+else if [ -e "$obj" ] ; then
+         echo "unexpected $obj found" > ${ocamltest_response}
+         test_result=${TEST_FAIL}
+     else if [ -e "$cmx" ] ; then
+              test_result=${TEST_PASS}
+          else
+              echo "not found expected $cmx" > ${ocamltest_response}
+              test_result=${TEST_FAIL}
+          fi
+     fi
+fi
+exit ${test_result}
diff --git a/testsuite/tests/tool-toplevel-invocation/first_arg_fail.txt b/testsuite/tests/tool-toplevel-invocation/first_arg_fail.txt
new file mode 100644
index 00000000..740a834a
--- /dev/null
+++ b/testsuite/tests/tool-toplevel-invocation/first_arg_fail.txt
@@ -0,0 +1,3 @@
+test.ml
+-I
+../
diff --git a/testsuite/tests/tool-toplevel-invocation/first_arg_fail.txt.reference b/testsuite/tests/tool-toplevel-invocation/first_arg_fail.txt.reference
new file mode 100644
index 00000000..b49ea22c
--- /dev/null
+++ b/testsuite/tests/tool-toplevel-invocation/first_arg_fail.txt.reference
@@ -0,0 +1 @@
+For implementation reasons, the toplevel does not support having script files (here "test.ml") inside expanded arguments passed through the -args{,0} command-line option.
diff --git a/testsuite/tests/tool-toplevel-invocation/indirect_first_arg_fail.txt b/testsuite/tests/tool-toplevel-invocation/indirect_first_arg_fail.txt
new file mode 100644
index 00000000..25ac50da
--- /dev/null
+++ b/testsuite/tests/tool-toplevel-invocation/indirect_first_arg_fail.txt
@@ -0,0 +1,2 @@
+-args
+first_arg_fail.txt
diff --git a/testsuite/tests/tool-toplevel-invocation/indirect_first_arg_fail.txt.reference b/testsuite/tests/tool-toplevel-invocation/indirect_first_arg_fail.txt.reference
new file mode 100644
index 00000000..b49ea22c
--- /dev/null
+++ b/testsuite/tests/tool-toplevel-invocation/indirect_first_arg_fail.txt.reference
@@ -0,0 +1 @@
+For implementation reasons, the toplevel does not support having script files (here "test.ml") inside expanded arguments passed through the -args{,0} command-line option.
diff --git a/testsuite/tests/tool-toplevel-invocation/indirect_last_arg_fail.txt b/testsuite/tests/tool-toplevel-invocation/indirect_last_arg_fail.txt
new file mode 100644
index 00000000..7847f963
--- /dev/null
+++ b/testsuite/tests/tool-toplevel-invocation/indirect_last_arg_fail.txt
@@ -0,0 +1,2 @@
+-args
+last_arg_fail.txt
diff --git a/testsuite/tests/tool-toplevel-invocation/indirect_last_arg_fail.txt.reference b/testsuite/tests/tool-toplevel-invocation/indirect_last_arg_fail.txt.reference
new file mode 100644
index 00000000..b49ea22c
--- /dev/null
+++ b/testsuite/tests/tool-toplevel-invocation/indirect_last_arg_fail.txt.reference
@@ -0,0 +1 @@
+For implementation reasons, the toplevel does not support having script files (here "test.ml") inside expanded arguments passed through the -args{,0} command-line option.
diff --git a/testsuite/tests/tool-toplevel-invocation/last_arg_fail.txt b/testsuite/tests/tool-toplevel-invocation/last_arg_fail.txt
new file mode 100644
index 00000000..764d630e
--- /dev/null
+++ b/testsuite/tests/tool-toplevel-invocation/last_arg_fail.txt
@@ -0,0 +1,3 @@
+-I
+../
+test.ml
diff --git a/testsuite/tests/tool-toplevel-invocation/last_arg_fail.txt.reference b/testsuite/tests/tool-toplevel-invocation/last_arg_fail.txt.reference
new file mode 100644
index 00000000..b49ea22c
--- /dev/null
+++ b/testsuite/tests/tool-toplevel-invocation/last_arg_fail.txt.reference
@@ -0,0 +1 @@
+For implementation reasons, the toplevel does not support having script files (here "test.ml") inside expanded arguments passed through the -args{,0} command-line option.
diff --git a/testsuite/tests/tool-toplevel-invocation/print_args.ml b/testsuite/tests/tool-toplevel-invocation/print_args.ml
new file mode 100644
index 00000000..d4b84485
--- /dev/null
+++ b/testsuite/tests/tool-toplevel-invocation/print_args.ml
@@ -0,0 +1 @@
+Array.iter (fun x -> print_endline (Filename.basename x)) Sys.argv;;
diff --git a/testsuite/tests/tool-toplevel-invocation/print_args.reference b/testsuite/tests/tool-toplevel-invocation/print_args.reference
new file mode 100644
index 00000000..186b46a3
--- /dev/null
+++ b/testsuite/tests/tool-toplevel-invocation/print_args.reference
@@ -0,0 +1,3 @@
+print_args.ml
+foo
+bar
diff --git a/testsuite/tests/tool-toplevel-invocation/test.ml b/testsuite/tests/tool-toplevel-invocation/test.ml
new file mode 100644
index 00000000..8beae14f
--- /dev/null
+++ b/testsuite/tests/tool-toplevel-invocation/test.ml
@@ -0,0 +1,51 @@
+(* TEST
+
+files = "first_arg_fail.txt last_arg_fail.txt"
+
+* setup-ocaml-build-env
+
+** ocaml
+flags = "-args ${test_source_directory}/first_arg_fail.txt"
+compiler_reference = "${test_source_directory}/first_arg_fail.txt.reference"
+compiler_output = "${test_build_directory}/first_arg_fail.output"
+ocaml_exit_status = "2"
+*** check-ocaml-output
+
+** ocaml
+flags = "-args ${test_source_directory}/indirect_first_arg_fail.txt"
+compiler_reference =
+  "${test_source_directory}/indirect_first_arg_fail.txt.reference"
+compiler_output = "${test_build_directory}/indirect_first_arg_fail.output"
+ocaml_exit_status = "2"
+*** check-ocaml-output
+
+** ocaml
+flags = "-args ${test_source_directory}/indirect_last_arg_fail.txt"
+compiler_reference =
+  "${test_source_directory}/indirect_last_arg_fail.txt.reference"
+compiler_output = "${test_build_directory}/indirect_last_arg_fail.output"
+ocaml_exit_status = "2"
+*** check-ocaml-output
+
+** ocaml
+flags = "-args ${test_source_directory}/last_arg_fail.txt"
+compiler_reference = "${test_source_directory}/last_arg_fail.txt.reference"
+compiler_output = "${test_build_directory}/last_arg_fail.output"
+ocaml_exit_status = "2"
+*** check-ocaml-output
+
+** ocaml
+flags = "-args ${test_source_directory}/working_arg.txt"
+compiler_reference = "${test_source_directory}/working_arg.txt.reference"
+compiler_output = "${test_build_directory}/working_arg.output"
+*** check-ocaml-output
+
+** ocaml
+flags = "${test_source_directory}/print_args.ml foo bar"
+compiler_reference = "${test_source_directory}/print_args.reference"
+compiler_output = "${test_build_directory}/print_args.output"
+*** check-ocaml-output
+
+*)
+
+printf "Test succeeds\n";;
diff --git a/testsuite/tests/tool-toplevel-invocation/working_arg.txt b/testsuite/tests/tool-toplevel-invocation/working_arg.txt
new file mode 100644
index 00000000..7c42c092
--- /dev/null
+++ b/testsuite/tests/tool-toplevel-invocation/working_arg.txt
@@ -0,0 +1,2 @@
+-open
+Printf
diff --git a/testsuite/tests/tool-toplevel-invocation/working_arg.txt.reference b/testsuite/tests/tool-toplevel-invocation/working_arg.txt.reference
new file mode 100644
index 00000000..1b6c345f
--- /dev/null
+++ b/testsuite/tests/tool-toplevel-invocation/working_arg.txt.reference
@@ -0,0 +1,3 @@
+Test succeeds
+- : unit = ()
+
diff --git a/testsuite/tests/tool-toplevel/error_highlighting.compilers.reference b/testsuite/tests/tool-toplevel/error_highlighting.compilers.reference
new file mode 100644
index 00000000..fe6ac39a
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/error_highlighting.compilers.reference
@@ -0,0 +1,74 @@
+Line 9, characters 8-15:
+9 | let x = (1 + 2) +. 3. in ();;
+            ^^^^^^^
+Error: This expression has type int but an expression was expected of type
+         float
+Line 2, characters 15-17:
+2 | let x = (1 + 2 in ();;
+                   ^^
+Error: Syntax error: ')' expected
+Line 2, characters 8-9:
+2 | let x = (1 + 2 in ();;
+            ^
+  This '(' might be unmatched
+Line 2, characters 14-16:
+2 | let x = (1 + 2;;
+                  ^^
+Error: Syntax error: ')' expected
+Line 2, characters 8-9:
+2 | let x = (1 + 2;;
+            ^
+  This '(' might be unmatched
+Line 3, characters 8-9:
+3 | let y = 1 +. 2. in
+            ^
+Error: This expression has type int but an expression was expected of type
+         float
+  Hint: Did you mean `1.'?
+Line 4, characters 2-4:
+4 | 2 in
+      ^^
+Error: Syntax error: ')' expected
+Line 2, characters 8-9:
+2 | let x = (1
+            ^
+  This '(' might be unmatched
+Lines 2-4, characters 8-2:
+2 | ........(1
+3 |   +
+4 | 2)...
+Error: This expression has type int but an expression was expected of type
+         float
+Line 2, characters 12-17:
+2 | let x = 1 + "abc" in
+                ^^^^^
+Error: This expression 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 ();;
+            ^^^^^^^
+Error: This expression has type int but an expression was expected of type
+         float
+File "error_highlighting_use2.ml", line 1, characters 15-17:
+1 | let x = (1 + 2 in ();;
+                   ^^
+Error: Syntax error: ')' expected
+File "error_highlighting_use2.ml", line 1, characters 8-9:
+1 | let x = (1 + 2 in ();;
+            ^
+  This '(' might be unmatched
+File "error_highlighting_use3.ml", line 3, characters 2-4:
+3 | 2 in
+      ^^
+Error: Syntax error: ')' expected
+File "error_highlighting_use3.ml", line 1, characters 8-9:
+1 | let x = (1
+            ^
+  This '(' might be unmatched
+File "error_highlighting_use4.ml", lines 1-3, characters 8-2:
+1 | ........(1
+2 |   +
+3 | 2)...
+Error: This expression has type int but an expression was expected of type
+         float
+
diff --git a/testsuite/tests/tool-toplevel/error_highlighting.ml b/testsuite/tests/tool-toplevel/error_highlighting.ml
new file mode 100644
index 00000000..5716a7ac
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/error_highlighting.ml
@@ -0,0 +1,111 @@
+(* TEST
+   files = "error_highlighting_use1.ml \
+            error_highlighting_use2.ml \
+            error_highlighting_use3.ml \
+            error_highlighting_use4.ml"
+   * toplevel
+*)
+
+let x = (1 + 2) +. 3. in ();;
+
+let x = (1 + 2 in ();;
+
+let x = (1 + 2;;
+
+let x = 1 in
+let y = 1 +. 2. in
+();;
+
+let x = (1
+  +
+2 in
+();;
+
+let x = (1
+  +
+2) +.
+3. in ();;
+
+let x = 1 + "abc" in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in
+let x = 1 in ();;
+
+#use "error_highlighting_use1.ml";;
+#use "error_highlighting_use2.ml";;
+#use "error_highlighting_use3.ml";;
+#use "error_highlighting_use4.ml";;
diff --git a/testsuite/tests/tool-toplevel/error_highlighting_use1.ml b/testsuite/tests/tool-toplevel/error_highlighting_use1.ml
new file mode 100644
index 00000000..87ac4416
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/error_highlighting_use1.ml
@@ -0,0 +1 @@
+let x = (1 + 2) +. 3. in ();;
diff --git a/testsuite/tests/tool-toplevel/error_highlighting_use2.ml b/testsuite/tests/tool-toplevel/error_highlighting_use2.ml
new file mode 100644
index 00000000..295584f6
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/error_highlighting_use2.ml
@@ -0,0 +1 @@
+let x = (1 + 2 in ();;
diff --git a/testsuite/tests/tool-toplevel/error_highlighting_use3.ml b/testsuite/tests/tool-toplevel/error_highlighting_use3.ml
new file mode 100644
index 00000000..04cb9a85
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/error_highlighting_use3.ml
@@ -0,0 +1,4 @@
+let x = (1
+  +
+2 in
+();;
diff --git a/testsuite/tests/tool-toplevel/error_highlighting_use4.ml b/testsuite/tests/tool-toplevel/error_highlighting_use4.ml
new file mode 100644
index 00000000..252dc7ee
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/error_highlighting_use4.ml
@@ -0,0 +1,4 @@
+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
new file mode 100644
index 00000000..957052ba
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/exotic_lists.compilers.reference
@@ -0,0 +1,14 @@
+module L : sig type ('a, 'b) t = [] | (::) of 'a * ('b, 'a) t end
+- : (int list, string) L.t =
+L.(::) ([1; 2],
+ L.(::) ("2", L.(::) ([3; 4], L.(::) ("4", L.(::) ([5], L.[])))))
+- : (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, [])))))
+
diff --git a/testsuite/tests/tool-toplevel/exotic_lists.ml b/testsuite/tests/tool-toplevel/exotic_lists.ml
new file mode 100644
index 00000000..bb09823b
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/exotic_lists.ml
@@ -0,0 +1,17 @@
+(* TEST
+   * toplevel
+*)
+
+module L = struct
+        type ('a,'b) t = [] | (::) of 'a * ('b,'a) t
+end;;
+L.[([1;2]:int list);"2";[3;4];"4";[5]];;
+open L;;
+[1;"2";3;"4";5];;
+
+module L = struct
+        type 'a t = 'a list = [] | (::) of 'a * 'a t
+end;;
+L.[[1];[2];[3];[4];[5]];;
+open L;;
+[1;2;3;4;5];;
diff --git a/testsuite/tests/tool-toplevel/known-bugs/broken_rec_in_show.ml b/testsuite/tests/tool-toplevel/known-bugs/broken_rec_in_show.ml
new file mode 100644
index 00000000..f4c3f497
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/known-bugs/broken_rec_in_show.ml
@@ -0,0 +1,47 @@
+(* TEST
+   * expect
+*)
+
+(* This is a known-bug file for use of 'rec' by the '#show' command,
+   to record known regressions from #7453 and #9094 *)
+
+type t = T of t;;
+[%%expect{|
+type t = T of t
+|}]
+#show t;;
+(* this output is INCORRECT, it should not use nonrec *)
+[%%expect{|
+type nonrec t = T of t
+|}];;
+
+type nonrec s = Foo of t;;
+[%%expect{|
+type nonrec s = Foo of t
+|}];;
+#show s;;
+(* this output is CORRECT, it uses nonrec *)
+[%%expect{|
+type nonrec s = Foo of t
+|}];;
+
+
+
+module M : sig type t val x : t end = struct type t = int let x = 0 end;;
+[%%expect{|
+module M : sig type t val x : t end
+|}];;
+(* this output is CORRECT, it does not use 'rec' *)
+[%%expect{|
+|}];;
+
+module rec M : sig type t val x : M.t end = struct type t = int let x = 0 end;;
+(* this output is strange, it is surprising to use M/2 here. *)
+[%%expect{|
+module rec M : sig type t val x : M/2.t end
+|}];;
+#show_module M;;
+(* this output is INCORRECT, it should use 'rec' *)
+[%%expect{|
+module M : sig type t val x : M.t end
+|}];;
diff --git a/testsuite/tests/tool-toplevel/mod.ml b/testsuite/tests/tool-toplevel/mod.ml
new file mode 100644
index 00000000..cd298427
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/mod.ml
@@ -0,0 +1 @@
+let answer = 42
diff --git a/testsuite/tests/tool-toplevel/mod_use.ml b/testsuite/tests/tool-toplevel/mod_use.ml
new file mode 100644
index 00000000..e068ffc3
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/mod_use.ml
@@ -0,0 +1,9 @@
+(* TEST
+   files = "mod.ml"
+   * expect
+*)
+
+#mod_use "mod.ml"
+[%%expect {|
+module Mod : sig val answer : int end
+|}];;
diff --git a/testsuite/tests/tool-toplevel/pr6468.compilers.reference b/testsuite/tests/tool-toplevel/pr6468.compilers.reference
new file mode 100644
index 00000000..2f942ec6
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/pr6468.compilers.reference
@@ -0,0 +1,12 @@
+- : unit = ()
+val f : unit -> 'a = 
+Line 1, characters 11-15:
+1 | let g () = f (); 1;;
+               ^^^^
+Warning 21: this statement never returns (or has an unsound type.)
+val g : unit -> int = 
+Exception: Not_found.
+Raised at f in file "//toplevel//", line 2, characters 11-26
+Called from g in file "//toplevel//", line 1, characters 11-15
+Called from Toploop.load_lambda in file "toplevel/toploop.ml", line 212, characters 17-27
+
diff --git a/testsuite/tests/tool-toplevel/pr6468.ml b/testsuite/tests/tool-toplevel/pr6468.ml
new file mode 100644
index 00000000..69680ccf
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/pr6468.ml
@@ -0,0 +1,10 @@
+(* TEST
+   * toplevel
+*)
+
+(* Make the test reproducible regardless of whether OCAMLRUNPARAM=b or not *)
+Printexc.record_backtrace true;;
+
+let f () = raise Not_found;;
+let g () = f (); 1;;
+g ();;
diff --git a/testsuite/tests/tool-toplevel/pr7060.compilers.reference b/testsuite/tests/tool-toplevel/pr7060.compilers.reference
new file mode 100644
index 00000000..3538e007
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/pr7060.compilers.reference
@@ -0,0 +1,15 @@
+type t = A | B
+type u = C of t
+Line 1, characters 18-54:
+1 | let print_t out = function A -> Format.fprintf out "A";;
+                      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+B
+val print_t : Format.formatter -> t -> unit = 
+- : t =
+
+- : u =
+C
+ 
+
diff --git a/testsuite/tests/tool-toplevel/pr7060.ml b/testsuite/tests/tool-toplevel/pr7060.ml
new file mode 100644
index 00000000..e6ad7408
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/pr7060.ml
@@ -0,0 +1,10 @@
+(* TEST
+   * toplevel
+*)
+
+type t = A | B;;
+type u = C of t;;
+let print_t out = function A -> Format.fprintf out "A";;
+#install_printer print_t;;
+B;;
+C B;;
diff --git a/testsuite/tests/tool-toplevel/pr7751.compilers.reference b/testsuite/tests/tool-toplevel/pr7751.compilers.reference
new file mode 100644
index 00000000..5cdf1246
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/pr7751.compilers.reference
@@ -0,0 +1,10 @@
+- : Parsetree.expression =
+{Parsetree.pexp_desc =
+  Parsetree.Pexp_constant (Parsetree.Pconst_integer ("1", None));
+ pexp_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_stack = []; pexp_attributes = []}
+
diff --git a/testsuite/tests/tool-toplevel/pr7751.ml b/testsuite/tests/tool-toplevel/pr7751.ml
new file mode 100644
index 00000000..40ce9ffd
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/pr7751.ml
@@ -0,0 +1,6 @@
+(* TEST
+   include ocamlcommon
+   * toplevel
+*)
+
+Parse.expression (Lexing.from_string "1");;
diff --git a/testsuite/tests/tool-toplevel/redefinition_hints.compilers.reference b/testsuite/tests/tool-toplevel/redefinition_hints.compilers.reference
new file mode 100644
index 00000000..4fc85aae
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/redefinition_hints.compilers.reference
@@ -0,0 +1,40 @@
+module Empty : sig end
+type u = A
+type v = B
+module type S = sig end
+val m : (module S) = 
+module M : sig type 'a t = X of 'a end
+val x : (u * v * (module S)) M.t = M.X (A, B, )
+module type S = sig end
+val m : (module S) = 
+type u = A
+type v = B
+module M : sig type 'a t = X of 'a end
+val y : (u * v * (module S)) M.t = M.X (A, B, )
+Line 2, characters 4-5:
+2 | x = y;;
+        ^
+Error: This expression has type (u/1 * v/1 * (module S/1)) M/1.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
+         toplevel session. Some toplevel values still refer to old versions
+         of those types. Did you try to redefine them?
+       Hint: The module M has been defined multiple times in this toplevel
+         session. Some toplevel values still refer to old versions of this
+         module. Did you try to redefine them?
+       Hint: The module type S has been defined multiple times in this
+         toplevel session. Some toplevel values still refer to old versions
+         of this module type. Did you try to redefine them?
+type a = A
+val a : a = A
+type a = A
+val b : a = A
+Line 2, characters 4-5:
+2 | a = b;;
+        ^
+Error: This expression has type a/1 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/redefinition_hints.ml b/testsuite/tests/tool-toplevel/redefinition_hints.ml
new file mode 100644
index 00000000..d5c4bdf3
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/redefinition_hints.ml
@@ -0,0 +1,40 @@
+(* TEST
+   * toplevel
+*)
+
+(* This is a toplevel test to trigger toplevel specific hints *)
+
+
+module Empty = struct end
+
+
+type u = A
+type v = B
+module type S = sig end
+let m = (module Empty:S)
+
+module M = struct
+  type 'a t = X of 'a
+end
+let x =M.X (A,B,m);;
+
+module type S = sig end
+let m = (module Empty:S)
+
+type u = A
+type v = B
+module M = struct
+  type 'a t = X of 'a
+end
+let y = M.X (A,B,m);;
+
+x = y;;
+
+type a = A
+let a = A;;
+
+type a = A
+let b = A;;
+
+a = b;;
+exit 0;;
diff --git a/testsuite/tests/tool-toplevel/show.ml b/testsuite/tests/tool-toplevel/show.ml
new file mode 100644
index 00000000..6c000120
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/show.ml
@@ -0,0 +1,106 @@
+(* TEST
+   * expect
+*)
+
+(* this is a set of tests to test the #show functionality
+ * of toplevel *)
+
+#show Foo;;
+[%%expect {|
+Unknown element.
+|}];;
+
+module type S = sig type t val x : t end;;
+module M : S = struct type t = int let x = 3 end;;
+
+[%%expect {|
+module type S = sig type t val x : t end
+module M : S
+|}];;
+
+#show M;;
+[%%expect {|
+module M : S
+|}];;
+
+#show S;;
+[%%expect {|
+module type S = sig type t val x : t end
+|}];;
+
+#show Invalid_argument;;
+[%%expect {|
+exception Invalid_argument of string
+|}];;
+
+#show Some;;
+[%%expect {|
+type 'a option = None | Some of 'a
+|}];;
+
+#show option;;
+[%%expect {|
+type nonrec 'a option = None | Some of 'a
+|}];;
+
+#show Open_binary;;
+[%%expect {|
+type Stdlib.open_flag =
+    Open_rdonly
+  | Open_wronly
+  | Open_append
+  | Open_creat
+  | Open_trunc
+  | Open_excl
+  | Open_binary
+  | Open_text
+  | Open_nonblock
+|}];;
+
+#show open_flag;;
+[%%expect {|
+type nonrec open_flag =
+    Open_rdonly
+  | Open_wronly
+  | Open_append
+  | Open_creat
+  | Open_trunc
+  | Open_excl
+  | Open_binary
+  | Open_text
+  | Open_nonblock
+|}];;
+
+type extensible = ..;;
+type extensible += A | B of int;;
+[%%expect {|
+type extensible = ..
+type extensible += A | B of int
+|}];;
+
+#show A;;
+[%%expect {|
+type extensible += A
+|}];;
+
+#show B;;
+[%%expect {|
+type extensible += B of int
+|}];;
+
+#show extensible;;
+[%%expect {|
+type nonrec extensible = ..
+|}];;
+
+type 'a t = ..;;
+type _ t += A : int t;;
+[%%expect{|
+type 'a t = ..
+type _ t += A : int t
+|}];;
+
+#show A;;
+[%%expect{|
+type 'a t += A : int t
+|}];;
diff --git a/testsuite/tests/tool-toplevel/show_short_paths.ml b/testsuite/tests/tool-toplevel/show_short_paths.ml
new file mode 100644
index 00000000..c0c50de2
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/show_short_paths.ml
@@ -0,0 +1,19 @@
+(* TEST
+   flags = " -short-paths "
+   * expect
+*)
+
+(* This is currently just a regression test for the bug
+   reported here: https://github.com/ocaml/ocaml/issues/9828 *)
+
+#show list;;
+[%%expect {|
+type nonrec 'a list = [] | (::) of 'a * 'a list
+|}];;
+
+type 'a t;;
+#show t;;
+[%%expect {|
+type 'a t
+type nonrec 'a t
+|}];;
diff --git a/testsuite/tests/tool-toplevel/strings.compilers.reference b/testsuite/tests/tool-toplevel/strings.compilers.reference
new file mode 100644
index 00000000..cbc727fd
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/strings.compilers.reference
@@ -0,0 +1,10 @@
+- : string = "\n\t\r\b"
+- : string = "\"\\'"
+- : string =
+" !#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_`abcdefghijklmnopqrstuvwxyz{|}~"
+- : string =
+"\000\001\002\003\004\005\006\007\011\012\014\015\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031\127"
+- : string =
+"\"Ἀχιλλεύς\r\n天照\tब्रह्मन्\t𒄑 𒂆 𒈦 𒄑 𒂆  𒈦\\"
+- : string = "ایدهآل"
+
diff --git a/testsuite/tests/tool-toplevel/strings.ml b/testsuite/tests/tool-toplevel/strings.ml
new file mode 100644
index 00000000..baf29871
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/strings.ml
@@ -0,0 +1,19 @@
+(* TEST
+   * toplevel
+*)
+
+(* Test the printing of strings in the terminal *)
+"\n\t\r\b";;
+
+{|"\'|};;
+
+" !#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_`\
+abcdefghijklmnopqrstuvwxyz{|}~";;
+
+"\x00\x01\x02\x03\x04\x05\x06\x07\x0B\x0C\x0E\x0F\
+ \x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1A\x1B\x1C\x1D\x1E\x1F\
+ \x7F";;
+
+"\"Ἀχιλλεύς\r\n天照\tब्रह्मन्\t𒄑 𒂆 𒈦 𒄑 𒂆  𒈦\\";;
+
+"ایدهآل";;
diff --git a/testsuite/tests/tool-toplevel/tracing.compilers.reference b/testsuite/tests/tool-toplevel/tracing.compilers.reference
new file mode 100644
index 00000000..3cdb4826
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/tracing.compilers.reference
@@ -0,0 +1,29 @@
+- : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a = 
+List.fold_left is now traced.
+- : int = 0
+List.fold_left <-- 
+List.fold_left --> 
+List.fold_left* <-- 
+List.fold_left* --> 
+List.fold_left** <-- [; ; ]
+List.fold_left <-- 
+List.fold_left --> 
+List.fold_left* <-- 
+List.fold_left* --> 
+List.fold_left** <-- [; ]
+List.fold_left <-- 
+List.fold_left --> 
+List.fold_left* <-- 
+List.fold_left* --> 
+List.fold_left** <-- []
+List.fold_left <-- 
+List.fold_left --> 
+List.fold_left* <-- 
+List.fold_left* --> 
+List.fold_left** <-- []
+List.fold_left** --> 
+List.fold_left** --> 
+List.fold_left** --> 
+List.fold_left** --> 
+- : int = 6
+
diff --git a/testsuite/tests/tool-toplevel/tracing.ml b/testsuite/tests/tool-toplevel/tracing.ml
new file mode 100644
index 00000000..8a1221f6
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/tracing.ml
@@ -0,0 +1,8 @@
+(* TEST
+   * toplevel
+*)
+
+List.fold_left;;
+#trace List.fold_left;;
+0;;
+List.fold_left (+) 0 [1;2;3];;
diff --git a/testsuite/tests/tool-toplevel/uncaught_exceptions.ml b/testsuite/tests/tool-toplevel/uncaught_exceptions.ml
new file mode 100644
index 00000000..3544e1dd
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/uncaught_exceptions.ml
@@ -0,0 +1,45 @@
+(* TEST
+   * expect
+*)
+
+(* PR#8594 *)
+Printexc.register_printer (fun e ->
+  match e with
+    | Division_by_zero -> Some "A division by zero is undefined"
+    | _ -> None);;
+[%%expect{|
+- : unit = ()
+|}];;
+
+Printexc.register_printer (fun e ->
+  match e with
+    | Exit -> Some "Catching an exit"
+    | _ -> None);;
+[%%expect{|
+- : unit = ()
+|}];;
+
+raise Not_found;;
+[%%expect{|
+Exception: Not_found.
+|}];;
+
+raise Exit;;
+[%%expect{|
+Exception: Catching an exit
+|}];;
+
+exception Foo of string;;
+[%%expect {|
+exception Foo of string
+|}];;
+
+raise (Foo "bar");;
+[%%expect {|
+Exception: Foo "bar".
+|}];;
+
+raise Division_by_zero;;
+[%%expect {|
+Exception: A division by zero is undefined
+|}];;
diff --git a/testsuite/tests/tool-toplevel/use_command.ml b/testsuite/tests/tool-toplevel/use_command.ml
new file mode 100644
index 00000000..7bb9d8fa
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/use_command.ml
@@ -0,0 +1,25 @@
+(* TEST
+   * expect
+*)
+
+(* Test a success case *)
+#use_output {|echo let x = 42|}
+[%%expect {|
+val x : int = 42
+|}];;
+
+(* When the command fails *)
+#use_output {|false|}
+[%%expect {|
+Command exited with code 1.
+|}];;
+
+(* When the code is invalid *)
+#use_output {|echo 1 :: x|}
+[%%expect {|
+File "(command-output)", line 1, characters 5-6:
+1 | 1 :: x
+         ^
+Error: This expression has type int but an expression was expected of type
+         int list
+|}];;
diff --git a/testsuite/tests/translprim/array_spec.compilers.flat.reference b/testsuite/tests/translprim/array_spec.compilers.flat.reference
new file mode 100644
index 00000000..5e5c558e
--- /dev/null
+++ b/testsuite/tests/translprim/array_spec.compilers.flat.reference
@@ -0,0 +1,65 @@
+(setglobal Array_spec!
+  (let
+    (int_a = (makearray[int] 1 2 3)
+     float_a = (makearray[float] 1. 2. 3.)
+     addr_a = (makearray[addr] "a" "b" "c"))
+    (seq (array.length[int] int_a) (array.length[float] float_a)
+      (array.length[addr] addr_a) (function a : int (array.length[gen] a))
+      (array.get[int] int_a 0) (array.get[float] float_a 0)
+      (array.get[addr] addr_a 0) (function a (array.get[gen] a 0))
+      (array.unsafe_get[int] int_a 0) (array.unsafe_get[float] float_a 0)
+      (array.unsafe_get[addr] addr_a 0)
+      (function a (array.unsafe_get[gen] a 0)) (array.set[int] int_a 0 1)
+      (array.set[float] float_a 0 1.) (array.set[addr] addr_a 0 "a")
+      (function a x (array.set[gen] a 0 x)) (array.unsafe_set[int] int_a 0 1)
+      (array.unsafe_set[float] float_a 0 1.)
+      (array.unsafe_set[addr] addr_a 0 "a")
+      (function a x (array.unsafe_set[gen] a 0 x))
+      (let
+        (eta_gen_len = (function prim stub (array.length[gen] prim))
+         eta_gen_safe_get =
+           (function prim prim stub (array.get[gen] prim prim))
+         eta_gen_unsafe_get =
+           (function prim prim stub (array.unsafe_get[gen] prim prim))
+         eta_gen_safe_set =
+           (function prim prim prim stub (array.set[gen] prim prim prim))
+         eta_gen_unsafe_set =
+           (function prim prim prim stub
+             (array.unsafe_set[gen] prim prim prim))
+         eta_int_len = (function prim stub (array.length[int] prim))
+         eta_int_safe_get =
+           (function prim prim stub (array.get[int] prim prim))
+         eta_int_unsafe_get =
+           (function prim prim stub (array.unsafe_get[int] prim prim))
+         eta_int_safe_set =
+           (function prim prim prim stub (array.set[int] prim prim prim))
+         eta_int_unsafe_set =
+           (function prim prim prim stub
+             (array.unsafe_set[int] prim prim prim))
+         eta_float_len = (function prim stub (array.length[float] prim))
+         eta_float_safe_get =
+           (function prim prim stub (array.get[float] prim prim))
+         eta_float_unsafe_get =
+           (function prim prim stub (array.unsafe_get[float] prim prim))
+         eta_float_safe_set =
+           (function prim prim prim stub (array.set[float] prim prim prim))
+         eta_float_unsafe_set =
+           (function prim prim prim stub
+             (array.unsafe_set[float] prim prim prim))
+         eta_addr_len = (function prim stub (array.length[addr] prim))
+         eta_addr_safe_get =
+           (function prim prim stub (array.get[addr] prim prim))
+         eta_addr_unsafe_get =
+           (function prim prim stub (array.unsafe_get[addr] prim prim))
+         eta_addr_safe_set =
+           (function prim prim prim stub (array.set[addr] prim prim prim))
+         eta_addr_unsafe_set =
+           (function prim prim prim stub
+             (array.unsafe_set[addr] prim prim prim)))
+        (makeblock 0 int_a float_a addr_a eta_gen_len eta_gen_safe_get
+          eta_gen_unsafe_get eta_gen_safe_set eta_gen_unsafe_set eta_int_len
+          eta_int_safe_get eta_int_unsafe_get eta_int_safe_set
+          eta_int_unsafe_set eta_float_len eta_float_safe_get
+          eta_float_unsafe_get eta_float_safe_set eta_float_unsafe_set
+          eta_addr_len eta_addr_safe_get eta_addr_unsafe_get
+          eta_addr_safe_set eta_addr_unsafe_set)))))
diff --git a/testsuite/tests/translprim/array_spec.compilers.no-flat.reference b/testsuite/tests/translprim/array_spec.compilers.no-flat.reference
new file mode 100644
index 00000000..e839bbdb
--- /dev/null
+++ b/testsuite/tests/translprim/array_spec.compilers.no-flat.reference
@@ -0,0 +1,65 @@
+(setglobal Array_spec!
+  (let
+    (int_a = (makearray[int] 1 2 3)
+     float_a = (makearray[addr] 1. 2. 3.)
+     addr_a = (makearray[addr] "a" "b" "c"))
+    (seq (array.length[int] int_a) (array.length[addr] float_a)
+      (array.length[addr] addr_a) (function a : int (array.length[addr] a))
+      (array.get[int] int_a 0) (array.get[addr] float_a 0)
+      (array.get[addr] addr_a 0) (function a (array.get[addr] a 0))
+      (array.unsafe_get[int] int_a 0) (array.unsafe_get[addr] float_a 0)
+      (array.unsafe_get[addr] addr_a 0)
+      (function a (array.unsafe_get[addr] a 0)) (array.set[int] int_a 0 1)
+      (array.set[addr] float_a 0 1.) (array.set[addr] addr_a 0 "a")
+      (function a x (array.set[addr] a 0 x))
+      (array.unsafe_set[int] int_a 0 1) (array.unsafe_set[addr] float_a 0 1.)
+      (array.unsafe_set[addr] addr_a 0 "a")
+      (function a x (array.unsafe_set[addr] a 0 x))
+      (let
+        (eta_gen_len = (function prim stub (array.length[addr] prim))
+         eta_gen_safe_get =
+           (function prim prim stub (array.get[addr] prim prim))
+         eta_gen_unsafe_get =
+           (function prim prim stub (array.unsafe_get[addr] prim prim))
+         eta_gen_safe_set =
+           (function prim prim prim stub (array.set[addr] prim prim prim))
+         eta_gen_unsafe_set =
+           (function prim prim prim stub
+             (array.unsafe_set[addr] prim prim prim))
+         eta_int_len = (function prim stub (array.length[int] prim))
+         eta_int_safe_get =
+           (function prim prim stub (array.get[int] prim prim))
+         eta_int_unsafe_get =
+           (function prim prim stub (array.unsafe_get[int] prim prim))
+         eta_int_safe_set =
+           (function prim prim prim stub (array.set[int] prim prim prim))
+         eta_int_unsafe_set =
+           (function prim prim prim stub
+             (array.unsafe_set[int] prim prim prim))
+         eta_float_len = (function prim stub (array.length[addr] prim))
+         eta_float_safe_get =
+           (function prim prim stub (array.get[addr] prim prim))
+         eta_float_unsafe_get =
+           (function prim prim stub (array.unsafe_get[addr] prim prim))
+         eta_float_safe_set =
+           (function prim prim prim stub (array.set[addr] prim prim prim))
+         eta_float_unsafe_set =
+           (function prim prim prim stub
+             (array.unsafe_set[addr] prim prim prim))
+         eta_addr_len = (function prim stub (array.length[addr] prim))
+         eta_addr_safe_get =
+           (function prim prim stub (array.get[addr] prim prim))
+         eta_addr_unsafe_get =
+           (function prim prim stub (array.unsafe_get[addr] prim prim))
+         eta_addr_safe_set =
+           (function prim prim prim stub (array.set[addr] prim prim prim))
+         eta_addr_unsafe_set =
+           (function prim prim prim stub
+             (array.unsafe_set[addr] prim prim prim)))
+        (makeblock 0 int_a float_a addr_a eta_gen_len eta_gen_safe_get
+          eta_gen_unsafe_get eta_gen_safe_set eta_gen_unsafe_set eta_int_len
+          eta_int_safe_get eta_int_unsafe_get eta_int_safe_set
+          eta_int_unsafe_set eta_float_len eta_float_safe_get
+          eta_float_unsafe_get eta_float_safe_set eta_float_unsafe_set
+          eta_addr_len eta_addr_safe_get eta_addr_unsafe_get
+          eta_addr_safe_set eta_addr_unsafe_set)))))
diff --git a/testsuite/tests/translprim/array_spec.ml b/testsuite/tests/translprim/array_spec.ml
new file mode 100644
index 00000000..6d0c1e49
--- /dev/null
+++ b/testsuite/tests/translprim/array_spec.ml
@@ -0,0 +1,76 @@
+(* TEST
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+      flags = "-dlambda -dno-unique-ids"
+   *** flat-float-array
+   **** check-ocamlc.byte-output
+        compiler_reference =
+          "${test_source_directory}/array_spec.compilers.flat.reference"
+   *** no-flat-float-array
+   **** check-ocamlc.byte-output
+       compiler_reference =
+         "${test_source_directory}/array_spec.compilers.no-flat.reference"
+*)
+
+external len : 'a array -> int = "%array_length"
+external safe_get : 'a array -> int -> 'a = "%array_safe_get"
+external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get"
+external safe_set : 'a array -> int -> 'a -> unit = "%array_safe_set"
+external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set"
+
+(* Specialization in application *)
+
+let int_a = [|1;2;3|];;
+let float_a = [|1.;2.;3.|];;
+let addr_a = [|"a";"b";"c"|];;
+
+len int_a;;
+len float_a;;
+len addr_a;;
+(fun a -> len a);;
+
+safe_get int_a 0;;
+safe_get float_a 0;;
+safe_get addr_a 0;;
+(fun a -> safe_get a 0);;
+
+unsafe_get int_a 0;;
+unsafe_get float_a 0;;
+unsafe_get addr_a 0;;
+(fun a -> unsafe_get a 0);;
+
+safe_set int_a 0 1;;
+safe_set float_a 0 1.;;
+safe_set addr_a 0 "a";;
+(fun a x -> safe_set a 0 x);;
+
+unsafe_set int_a 0 1;;
+unsafe_set float_a 0 1.;;
+unsafe_set addr_a 0 "a";;
+(fun a x -> unsafe_set a 0 x);;
+
+(* Specialization during eta-expansion *)
+
+let eta_gen_len : 'a array -> _ = len;;
+let eta_gen_safe_get : 'a array -> int -> 'a = safe_get;;
+let eta_gen_unsafe_get : 'a array -> int -> 'a = unsafe_get;;
+let eta_gen_safe_set : 'a array -> int -> 'a -> unit = safe_set;;
+let eta_gen_unsafe_set : 'a array -> int -> 'a -> unit = unsafe_set;;
+
+let eta_int_len : int array -> _ = len;;
+let eta_int_safe_get : int array -> int -> int = safe_get;;
+let eta_int_unsafe_get : int array -> int -> int = unsafe_get;;
+let eta_int_safe_set : int array -> int -> int -> unit = safe_set;;
+let eta_int_unsafe_set : int array -> int -> int -> unit = unsafe_set;;
+
+let eta_float_len : float array -> _ = len;;
+let eta_float_safe_get : float array -> int -> float = safe_get;;
+let eta_float_unsafe_get : float array -> int -> float = unsafe_get;;
+let eta_float_safe_set : float array -> int -> float -> unit = safe_set;;
+let eta_float_unsafe_set : float array -> int -> float -> unit = unsafe_set;;
+
+let eta_addr_len : string array -> _ = len;;
+let eta_addr_safe_get : string array -> int -> string = safe_get;;
+let eta_addr_unsafe_get : string array -> int -> string = unsafe_get;;
+let eta_addr_safe_set : string array -> int -> string -> unit = safe_set;;
+let eta_addr_unsafe_set : string array -> int -> string -> unit = unsafe_set;;
diff --git a/testsuite/tests/translprim/comparison_table.compilers.reference b/testsuite/tests/translprim/comparison_table.compilers.reference
new file mode 100644
index 00000000..a9a7cce9
--- /dev/null
+++ b/testsuite/tests/translprim/comparison_table.compilers.reference
@@ -0,0 +1,252 @@
+(setglobal Comparison_table!
+  (let
+    (gen_cmp = (function x y : int (caml_compare x y))
+     int_cmp = (function x[int] y[int] : int (compare_ints x y))
+     bool_cmp = (function x y : int (compare_ints x y))
+     intlike_cmp = (function x y : int (compare_ints x y))
+     float_cmp = (function x[float] y[float] : int (compare_floats x y))
+     string_cmp = (function x y : int (caml_string_compare x y))
+     int32_cmp = (function x[int32] y[int32] : int (compare_bints int32 x y))
+     int64_cmp = (function x[int64] y[int64] : int (compare_bints int64 x y))
+     nativeint_cmp =
+       (function x[nativeint] y[nativeint] : int
+         (compare_bints nativeint x y))
+     gen_eq = (function x y (caml_equal x y))
+     int_eq = (function x[int] y[int] (== x y))
+     bool_eq = (function x y (== x y))
+     intlike_eq = (function x y (== x y))
+     float_eq = (function x[float] y[float] (==. x y))
+     string_eq = (function x y (caml_string_equal x y))
+     int32_eq = (function x[int32] y[int32] (Int32.== x y))
+     int64_eq = (function x[int64] y[int64] (Int64.== x y))
+     nativeint_eq = (function x[nativeint] y[nativeint] (Nativeint.== x y))
+     gen_ne = (function x y (caml_notequal x y))
+     int_ne = (function x[int] y[int] (!= x y))
+     bool_ne = (function x y (!= x y))
+     intlike_ne = (function x y (!= x y))
+     float_ne = (function x[float] y[float] (!=. x y))
+     string_ne = (function x y (caml_string_notequal x y))
+     int32_ne = (function x[int32] y[int32] (Int32.!= x y))
+     int64_ne = (function x[int64] y[int64] (Int64.!= x y))
+     nativeint_ne = (function x[nativeint] y[nativeint] (Nativeint.!= x y))
+     gen_lt = (function x y (caml_lessthan x y))
+     int_lt = (function x[int] y[int] (< x y))
+     bool_lt = (function x y (< x y))
+     intlike_lt = (function x y (< x y))
+     float_lt = (function x[float] y[float] (<. x y))
+     string_lt = (function x y (caml_string_lessthan x y))
+     int32_lt = (function x[int32] y[int32] (Int32.< x y))
+     int64_lt = (function x[int64] y[int64] (Int64.< x y))
+     nativeint_lt = (function x[nativeint] y[nativeint] (Nativeint.< x y))
+     gen_gt = (function x y (caml_greaterthan x y))
+     int_gt = (function x[int] y[int] (> x y))
+     bool_gt = (function x y (> x y))
+     intlike_gt = (function x y (> x y))
+     float_gt = (function x[float] y[float] (>. x y))
+     string_gt = (function x y (caml_string_greaterthan x y))
+     int32_gt = (function x[int32] y[int32] (Int32.> x y))
+     int64_gt = (function x[int64] y[int64] (Int64.> x y))
+     nativeint_gt = (function x[nativeint] y[nativeint] (Nativeint.> x y))
+     gen_le = (function x y (caml_lessequal x y))
+     int_le = (function x[int] y[int] (<= x y))
+     bool_le = (function x y (<= x y))
+     intlike_le = (function x y (<= x y))
+     float_le = (function x[float] y[float] (<=. x y))
+     string_le = (function x y (caml_string_lessequal x y))
+     int32_le = (function x[int32] y[int32] (Int32.<= x y))
+     int64_le = (function x[int64] y[int64] (Int64.<= x y))
+     nativeint_le = (function x[nativeint] y[nativeint] (Nativeint.<= x y))
+     gen_ge = (function x y (caml_greaterequal x y))
+     int_ge = (function x[int] y[int] (>= x y))
+     bool_ge = (function x y (>= x y))
+     intlike_ge = (function x y (>= x y))
+     float_ge = (function x[float] y[float] (>=. x y))
+     string_ge = (function x y (caml_string_greaterequal x y))
+     int32_ge = (function x[int32] y[int32] (Int32.>= x y))
+     int64_ge = (function x[int64] y[int64] (Int64.>= x y))
+     nativeint_ge = (function x[nativeint] y[nativeint] (Nativeint.>= x y))
+     eta_gen_cmp = (function prim prim stub (caml_compare prim prim))
+     eta_int_cmp = (function prim prim stub (compare_ints prim prim))
+     eta_bool_cmp = (function prim prim stub (compare_ints prim prim))
+     eta_intlike_cmp = (function prim prim stub (compare_ints prim prim))
+     eta_float_cmp = (function prim prim stub (compare_floats prim prim))
+     eta_string_cmp =
+       (function prim prim stub (caml_string_compare prim prim))
+     eta_int32_cmp =
+       (function prim prim stub (compare_bints int32 prim prim))
+     eta_int64_cmp =
+       (function prim prim stub (compare_bints int64 prim prim))
+     eta_nativeint_cmp =
+       (function prim prim stub (compare_bints nativeint prim prim))
+     eta_gen_eq = (function prim prim stub (caml_equal prim prim))
+     eta_int_eq = (function prim prim stub (== prim prim))
+     eta_bool_eq = (function prim prim stub (== prim prim))
+     eta_intlike_eq = (function prim prim stub (== prim prim))
+     eta_float_eq = (function prim prim stub (==. prim prim))
+     eta_string_eq = (function prim prim stub (caml_string_equal prim prim))
+     eta_int32_eq = (function prim prim stub (Int32.== prim prim))
+     eta_int64_eq = (function prim prim stub (Int64.== prim prim))
+     eta_nativeint_eq = (function prim prim stub (Nativeint.== prim prim))
+     eta_gen_ne = (function prim prim stub (caml_notequal prim prim))
+     eta_int_ne = (function prim prim stub (!= prim prim))
+     eta_bool_ne = (function prim prim stub (!= prim prim))
+     eta_intlike_ne = (function prim prim stub (!= prim prim))
+     eta_float_ne = (function prim prim stub (!=. prim prim))
+     eta_string_ne =
+       (function prim prim stub (caml_string_notequal prim prim))
+     eta_int32_ne = (function prim prim stub (Int32.!= prim prim))
+     eta_int64_ne = (function prim prim stub (Int64.!= prim prim))
+     eta_nativeint_ne = (function prim prim stub (Nativeint.!= prim prim))
+     eta_gen_lt = (function prim prim stub (caml_lessthan prim prim))
+     eta_int_lt = (function prim prim stub (< prim prim))
+     eta_bool_lt = (function prim prim stub (< prim prim))
+     eta_intlike_lt = (function prim prim stub (< prim prim))
+     eta_float_lt = (function prim prim stub (<. prim prim))
+     eta_string_lt =
+       (function prim prim stub (caml_string_lessthan prim prim))
+     eta_int32_lt = (function prim prim stub (Int32.< prim prim))
+     eta_int64_lt = (function prim prim stub (Int64.< prim prim))
+     eta_nativeint_lt = (function prim prim stub (Nativeint.< prim prim))
+     eta_gen_gt = (function prim prim stub (caml_greaterthan prim prim))
+     eta_int_gt = (function prim prim stub (> prim prim))
+     eta_bool_gt = (function prim prim stub (> prim prim))
+     eta_intlike_gt = (function prim prim stub (> prim prim))
+     eta_float_gt = (function prim prim stub (>. prim prim))
+     eta_string_gt =
+       (function prim prim stub (caml_string_greaterthan prim prim))
+     eta_int32_gt = (function prim prim stub (Int32.> prim prim))
+     eta_int64_gt = (function prim prim stub (Int64.> prim prim))
+     eta_nativeint_gt = (function prim prim stub (Nativeint.> prim prim))
+     eta_gen_le = (function prim prim stub (caml_lessequal prim prim))
+     eta_int_le = (function prim prim stub (<= prim prim))
+     eta_bool_le = (function prim prim stub (<= prim prim))
+     eta_intlike_le = (function prim prim stub (<= prim prim))
+     eta_float_le = (function prim prim stub (<=. prim prim))
+     eta_string_le =
+       (function prim prim stub (caml_string_lessequal prim prim))
+     eta_int32_le = (function prim prim stub (Int32.<= prim prim))
+     eta_int64_le = (function prim prim stub (Int64.<= prim prim))
+     eta_nativeint_le = (function prim prim stub (Nativeint.<= prim prim))
+     eta_gen_ge = (function prim prim stub (caml_greaterequal prim prim))
+     eta_int_ge = (function prim prim stub (>= prim prim))
+     eta_bool_ge = (function prim prim stub (>= prim prim))
+     eta_intlike_ge = (function prim prim stub (>= prim prim))
+     eta_float_ge = (function prim prim stub (>=. prim prim))
+     eta_string_ge =
+       (function prim prim stub (caml_string_greaterequal prim prim))
+     eta_int32_ge = (function prim prim stub (Int32.>= prim prim))
+     eta_int64_ge = (function prim prim stub (Int64.>= prim prim))
+     eta_nativeint_ge = (function prim prim stub (Nativeint.>= prim prim))
+     int_vec = [0: [0: 1 1] [0: [0: 1 2] [0: [0: 2 1] 0a]]]
+     bool_vec = [0: [0: 0a 0a] [0: [0: 0a 1a] [0: [0: 1a 0a] 0a]]]
+     intlike_vec = [0: [0: 0a 0a] [0: [0: 0a 1a] [0: [0: 1a 0a] 0a]]]
+     float_vec = [0: [0: 1. 1.] [0: [0: 1. 2.] [0: [0: 2. 1.] 0a]]]
+     string_vec = [0: [0: "1" "1"] [0: [0: "1" "2"] [0: [0: "2" "1"] 0a]]]
+     int32_vec = [0: [0: 1l 1l] [0: [0: 1l 2l] [0: [0: 2l 1l] 0a]]]
+     int64_vec = [0: [0: 1L 1L] [0: [0: 1L 2L] [0: [0: 2L 1L] 0a]]]
+     nativeint_vec = [0: [0: 1n 1n] [0: [0: 1n 2n] [0: [0: 2n 1n] 0a]]]
+     test_vec =
+       (function cmp eq ne lt gt le ge vec
+         (let
+           (uncurry =
+              (function f param (apply f (field 0 param) (field 1 param)))
+            map =
+              (function f l
+                (apply (field 16 (global Stdlib__list!)) (apply uncurry f) l)))
+           (makeblock 0
+             (makeblock 0 (apply map gen_cmp vec) (apply map cmp vec))
+             (apply map
+               (function gen spec
+                 (makeblock 0 (apply map gen vec) (apply map spec vec)))
+               (makeblock 0 (makeblock 0 gen_eq eq)
+                 (makeblock 0 (makeblock 0 gen_ne ne)
+                   (makeblock 0 (makeblock 0 gen_lt lt)
+                     (makeblock 0 (makeblock 0 gen_gt gt)
+                       (makeblock 0 (makeblock 0 gen_le le)
+                         (makeblock 0 (makeblock 0 gen_ge ge) 0a)))))))))))
+    (seq
+      (apply test_vec int_cmp int_eq int_ne int_lt int_gt int_le int_ge
+        int_vec)
+      (apply test_vec bool_cmp bool_eq bool_ne bool_lt bool_gt bool_le
+        bool_ge bool_vec)
+      (apply test_vec intlike_cmp intlike_eq intlike_ne intlike_lt intlike_gt
+        intlike_le intlike_ge intlike_vec)
+      (apply test_vec float_cmp float_eq float_ne float_lt float_gt float_le
+        float_ge float_vec)
+      (apply test_vec string_cmp string_eq string_ne string_lt string_gt
+        string_le string_ge string_vec)
+      (apply test_vec int32_cmp int32_eq int32_ne int32_lt int32_gt int32_le
+        int32_ge int32_vec)
+      (apply test_vec int64_cmp int64_eq int64_ne int64_lt int64_gt int64_le
+        int64_ge int64_vec)
+      (apply test_vec nativeint_cmp nativeint_eq nativeint_ne nativeint_lt
+        nativeint_gt nativeint_le nativeint_ge nativeint_vec)
+      (let
+        (eta_test_vec =
+           (function cmp eq ne lt gt le ge vec
+             (let
+               (uncurry =
+                  (function f param
+                    (apply f (field 0 param) (field 1 param)))
+                map =
+                  (function f l
+                    (apply (field 16 (global Stdlib__list!))
+                      (apply uncurry f) l)))
+               (makeblock 0
+                 (makeblock 0 (apply map eta_gen_cmp vec)
+                   (apply map cmp vec))
+                 (apply map
+                   (function gen spec
+                     (makeblock 0 (apply map gen vec) (apply map spec vec)))
+                   (makeblock 0 (makeblock 0 eta_gen_eq eq)
+                     (makeblock 0 (makeblock 0 eta_gen_ne ne)
+                       (makeblock 0 (makeblock 0 eta_gen_lt lt)
+                         (makeblock 0 (makeblock 0 eta_gen_gt gt)
+                           (makeblock 0 (makeblock 0 eta_gen_le le)
+                             (makeblock 0 (makeblock 0 eta_gen_ge ge) 0a)))))))))))
+        (seq
+          (apply eta_test_vec eta_int_cmp eta_int_eq eta_int_ne eta_int_lt
+            eta_int_gt eta_int_le eta_int_ge int_vec)
+          (apply eta_test_vec eta_bool_cmp eta_bool_eq eta_bool_ne
+            eta_bool_lt eta_bool_gt eta_bool_le eta_bool_ge bool_vec)
+          (apply eta_test_vec eta_intlike_cmp eta_intlike_eq eta_intlike_ne
+            eta_intlike_lt eta_intlike_gt eta_intlike_le eta_intlike_ge
+            intlike_vec)
+          (apply eta_test_vec eta_float_cmp eta_float_eq eta_float_ne
+            eta_float_lt eta_float_gt eta_float_le eta_float_ge float_vec)
+          (apply eta_test_vec eta_string_cmp eta_string_eq eta_string_ne
+            eta_string_lt eta_string_gt eta_string_le eta_string_ge
+            string_vec)
+          (apply eta_test_vec eta_int32_cmp eta_int32_eq eta_int32_ne
+            eta_int32_lt eta_int32_gt eta_int32_le eta_int32_ge int32_vec)
+          (apply eta_test_vec eta_int64_cmp eta_int64_eq eta_int64_ne
+            eta_int64_lt eta_int64_gt eta_int64_le eta_int64_ge int64_vec)
+          (apply eta_test_vec eta_nativeint_cmp eta_nativeint_eq
+            eta_nativeint_ne eta_nativeint_lt eta_nativeint_gt
+            eta_nativeint_le eta_nativeint_ge nativeint_vec)
+          (makeblock 0 gen_cmp int_cmp bool_cmp intlike_cmp float_cmp
+            string_cmp int32_cmp int64_cmp nativeint_cmp gen_eq int_eq
+            bool_eq intlike_eq float_eq string_eq int32_eq int64_eq
+            nativeint_eq gen_ne int_ne bool_ne intlike_ne float_ne string_ne
+            int32_ne int64_ne nativeint_ne gen_lt int_lt bool_lt intlike_lt
+            float_lt string_lt int32_lt int64_lt nativeint_lt gen_gt int_gt
+            bool_gt intlike_gt float_gt string_gt int32_gt int64_gt
+            nativeint_gt gen_le int_le bool_le intlike_le float_le string_le
+            int32_le int64_le nativeint_le gen_ge int_ge bool_ge intlike_ge
+            float_ge string_ge int32_ge int64_ge nativeint_ge eta_gen_cmp
+            eta_int_cmp eta_bool_cmp eta_intlike_cmp eta_float_cmp
+            eta_string_cmp eta_int32_cmp eta_int64_cmp eta_nativeint_cmp
+            eta_gen_eq eta_int_eq eta_bool_eq eta_intlike_eq eta_float_eq
+            eta_string_eq eta_int32_eq eta_int64_eq eta_nativeint_eq
+            eta_gen_ne eta_int_ne eta_bool_ne eta_intlike_ne eta_float_ne
+            eta_string_ne eta_int32_ne eta_int64_ne eta_nativeint_ne
+            eta_gen_lt eta_int_lt eta_bool_lt eta_intlike_lt eta_float_lt
+            eta_string_lt eta_int32_lt eta_int64_lt eta_nativeint_lt
+            eta_gen_gt eta_int_gt eta_bool_gt eta_intlike_gt eta_float_gt
+            eta_string_gt eta_int32_gt eta_int64_gt eta_nativeint_gt
+            eta_gen_le eta_int_le eta_bool_le eta_intlike_le eta_float_le
+            eta_string_le eta_int32_le eta_int64_le eta_nativeint_le
+            eta_gen_ge eta_int_ge eta_bool_ge eta_intlike_ge eta_float_ge
+            eta_string_ge eta_int32_ge eta_int64_ge eta_nativeint_ge int_vec
+            bool_vec intlike_vec float_vec string_vec int32_vec int64_vec
+            nativeint_vec test_vec eta_test_vec))))))
diff --git a/testsuite/tests/translprim/comparison_table.ml b/testsuite/tests/translprim/comparison_table.ml
new file mode 100644
index 00000000..1a914306
--- /dev/null
+++ b/testsuite/tests/translprim/comparison_table.ml
@@ -0,0 +1,246 @@
+(* TEST
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+      flags = "-dlambda -dno-unique-ids"
+   *** check-ocamlc.byte-output
+*)
+
+external cmp : 'a -> 'a -> int = "%compare";;
+external eq : 'a -> 'a -> bool = "%equal";;
+external ne : 'a -> 'a -> bool = "%notequal";;
+external lt : 'a -> 'a -> bool = "%lessthan";;
+external gt : 'a -> 'a -> bool = "%greaterthan";;
+external le : 'a -> 'a -> bool = "%lessequal";;
+external ge : 'a -> 'a -> bool = "%greaterequal";;
+
+type intlike = A | B | C | D
+
+(* Check specialization in explicit application *)
+
+let gen_cmp x y = cmp x y;;
+let int_cmp (x : int) y = cmp x y;;
+let bool_cmp (x : bool) y = cmp x y;;
+let intlike_cmp (x : intlike) y = cmp x y;;
+let float_cmp (x : float) y = cmp x y;;
+let string_cmp (x : string) y = cmp x y;;
+let int32_cmp (x : int32) y = cmp x y;;
+let int64_cmp (x : int64) y = cmp x y;;
+let nativeint_cmp (x : nativeint) y = cmp x y;;
+
+let gen_eq x y = eq x y;;
+let int_eq (x : int) y = eq x y;;
+let bool_eq (x : bool) y = eq x y;;
+let intlike_eq (x : intlike) y = eq x y;;
+let float_eq (x : float) y = eq x y;;
+let string_eq (x : string) y = eq x y;;
+let int32_eq (x : int32) y = eq x y;;
+let int64_eq (x : int64) y = eq x y;;
+let nativeint_eq (x : nativeint) y = eq x y;;
+
+let gen_ne x y = ne x y;;
+let int_ne (x : int) y = ne x y;;
+let bool_ne (x : bool) y = ne x y;;
+let intlike_ne (x : intlike) y = ne x y;;
+let float_ne (x : float) y = ne x y;;
+let string_ne (x : string) y = ne x y;;
+let int32_ne (x : int32) y = ne x y;;
+let int64_ne (x : int64) y = ne x y;;
+let nativeint_ne (x : nativeint) y = ne x y;;
+
+let gen_lt x y = lt x y;;
+let int_lt (x : int) y = lt x y;;
+let bool_lt (x : bool) y = lt x y;;
+let intlike_lt (x : intlike) y = lt x y;;
+let float_lt (x : float) y = lt x y;;
+let string_lt (x : string) y = lt x y;;
+let int32_lt (x : int32) y = lt x y;;
+let int64_lt (x : int64) y = lt x y;;
+let nativeint_lt (x : nativeint) y = lt x y;;
+
+let gen_gt x y = gt x y;;
+let int_gt (x : int) y = gt x y;;
+let bool_gt (x : bool) y = gt x y;;
+let intlike_gt (x : intlike) y = gt x y;;
+let float_gt (x : float) y = gt x y;;
+let string_gt (x : string) y = gt x y;;
+let int32_gt (x : int32) y = gt x y;;
+let int64_gt (x : int64) y = gt x y;;
+let nativeint_gt (x : nativeint) y = gt x y;;
+
+let gen_le x y = le x y;;
+let int_le (x : int) y = le x y;;
+let bool_le (x : bool) y = le x y;;
+let intlike_le (x : intlike) y = le x y;;
+let float_le (x : float) y = le x y;;
+let string_le (x : string) y = le x y;;
+let int32_le (x : int32) y = le x y;;
+let int64_le (x : int64) y = le x y;;
+let nativeint_le (x : nativeint) y = le x y;;
+
+let gen_ge x y = ge x y;;
+let int_ge (x : int) y = ge x y;;
+let bool_ge (x : bool) y = ge x y;;
+let intlike_ge (x : intlike) y = ge x y;;
+let float_ge (x : float) y = ge x y;;
+let string_ge (x : string) y = ge x y;;
+let int32_ge (x : int32) y = ge x y;;
+let int64_ge (x : int64) y = ge x y;;
+let nativeint_ge (x : nativeint) y = ge x y;;
+
+(* Check specialization in eta-expansion *)
+
+let eta_gen_cmp : 'a -> _ = cmp;;
+let eta_int_cmp : int -> _ = cmp;;
+let eta_bool_cmp : bool -> _ = cmp;;
+let eta_intlike_cmp : intlike -> _ = cmp;;
+let eta_float_cmp : float -> _ = cmp;;
+let eta_string_cmp : string -> _ = cmp;;
+let eta_int32_cmp : int32 -> _ = cmp;;
+let eta_int64_cmp : int64 -> _ = cmp;;
+let eta_nativeint_cmp : nativeint -> _ = cmp;;
+
+let eta_gen_eq : 'a -> _ = eq;;
+let eta_int_eq : int -> _ = eq;;
+let eta_bool_eq : bool -> _ = eq;;
+let eta_intlike_eq : intlike -> _ = eq;;
+let eta_float_eq : float -> _ = eq;;
+let eta_string_eq : string -> _ = eq;;
+let eta_int32_eq : int32 -> _ = eq;;
+let eta_int64_eq : int64 -> _ = eq;;
+let eta_nativeint_eq : nativeint -> _ = eq;;
+
+let eta_gen_ne : 'a -> _ = ne;;
+let eta_int_ne : int -> _ = ne;;
+let eta_bool_ne : bool -> _ = ne;;
+let eta_intlike_ne : intlike -> _ = ne;;
+let eta_float_ne : float -> _ = ne;;
+let eta_string_ne : string -> _ = ne;;
+let eta_int32_ne : int32 -> _ = ne;;
+let eta_int64_ne : int64 -> _ = ne;;
+let eta_nativeint_ne : nativeint -> _ = ne;;
+
+let eta_gen_lt : 'a -> _ = lt;;
+let eta_int_lt : int -> _ = lt;;
+let eta_bool_lt : bool -> _ = lt;;
+let eta_intlike_lt : intlike -> _ = lt;;
+let eta_float_lt : float -> _ = lt;;
+let eta_string_lt : string -> _ = lt;;
+let eta_int32_lt : int32 -> _ = lt;;
+let eta_int64_lt : int64 -> _ = lt;;
+let eta_nativeint_lt : nativeint -> _ = lt;;
+
+let eta_gen_gt : 'a -> _ = gt;;
+let eta_int_gt : int -> _ = gt;;
+let eta_bool_gt : bool -> _ = gt;;
+let eta_intlike_gt : intlike -> _ = gt;;
+let eta_float_gt : float -> _ = gt;;
+let eta_string_gt : string -> _ = gt;;
+let eta_int32_gt : int32 -> _ = gt;;
+let eta_int64_gt : int64 -> _ = gt;;
+let eta_nativeint_gt : nativeint -> _ = gt;;
+
+let eta_gen_le : 'a -> _ = le;;
+let eta_int_le : int -> _ = le;;
+let eta_bool_le : bool -> _ = le;;
+let eta_intlike_le : intlike -> _ = le;;
+let eta_float_le : float -> _ = le;;
+let eta_string_le : string -> _ = le;;
+let eta_int32_le : int32 -> _ = le;;
+let eta_int64_le : int64 -> _ = le;;
+let eta_nativeint_le : nativeint -> _ = le;;
+
+let eta_gen_ge : 'a -> _ = ge;;
+let eta_int_ge : int -> _ = ge;;
+let eta_bool_ge : bool -> _ = ge;;
+let eta_intlike_ge : intlike -> _ = ge;;
+let eta_float_ge : float -> _ = ge;;
+let eta_string_ge : string -> _ = ge;;
+let eta_int32_ge : int32 -> _ = ge;;
+let eta_int64_ge : int64 -> _ = ge;;
+let eta_nativeint_ge : nativeint -> _ = ge;;
+
+(* Check results of computations *)
+
+let int_vec = [(1,1);(1,2);(2,1)];;
+let bool_vec = [(false,false);(false,true);(true,false)];;
+let intlike_vec = [(A,A);(A,B);(B,A)];;
+let float_vec = [(1.,1.);(1.,2.);(2.,1.)];;
+let string_vec = [("1","1");("1","2");("2","1")];;
+let int32_vec = [(1l,1l);(1l,2l);(2l,1l)];;
+let int64_vec = [(1L,1L);(1L,2L);(2L,1L)];;
+let nativeint_vec = [(1n,1n);(1n,2n);(2n,1n)];;
+
+let test_vec cmp eq ne lt gt le ge vec =
+  let uncurry f (x,y) = f x y in
+  let map f l = List.map (uncurry f) l in
+  (map gen_cmp vec, map cmp vec),
+  (map (fun gen spec -> map gen vec, map spec vec)
+     [gen_eq,eq; gen_ne,ne; gen_lt,lt; gen_gt,gt; gen_le,le; gen_ge,ge])
+;;
+
+test_vec
+  int_cmp int_eq int_ne int_lt int_gt int_le int_ge
+  int_vec;;
+test_vec
+  bool_cmp bool_eq bool_ne bool_lt bool_gt bool_le bool_ge
+  bool_vec;;
+test_vec
+  intlike_cmp intlike_eq intlike_ne intlike_lt intlike_gt intlike_le intlike_ge
+  intlike_vec;;
+test_vec
+  float_cmp float_eq float_ne float_lt float_gt float_le float_ge
+  float_vec;;
+test_vec
+  string_cmp string_eq string_ne string_lt string_gt string_le string_ge
+  string_vec;;
+test_vec
+  int32_cmp int32_eq int32_ne int32_lt int32_gt int32_le int32_ge
+  int32_vec;;
+test_vec
+  int64_cmp int64_eq int64_ne int64_lt int64_gt int64_le int64_ge
+  int64_vec;;
+test_vec
+  nativeint_cmp nativeint_eq nativeint_ne
+  nativeint_lt nativeint_gt nativeint_le nativeint_ge
+  nativeint_vec;;
+
+let eta_test_vec cmp eq ne lt gt le ge vec =
+  let uncurry f (x,y) = f x y in
+  let map f l = List.map (uncurry f) l in
+  (map eta_gen_cmp vec, map cmp vec),
+  (map (fun gen spec -> map gen vec, map spec vec)
+     [eta_gen_eq,eq; eta_gen_ne,ne; eta_gen_lt,lt;
+      eta_gen_gt,gt; eta_gen_le,le; eta_gen_ge,ge])
+;;
+
+eta_test_vec
+  eta_int_cmp eta_int_eq eta_int_ne eta_int_lt eta_int_gt eta_int_le eta_int_ge
+  int_vec;;
+eta_test_vec
+  eta_bool_cmp eta_bool_eq eta_bool_ne eta_bool_lt eta_bool_gt
+  eta_bool_le eta_bool_ge
+  bool_vec;;
+eta_test_vec
+  eta_intlike_cmp eta_intlike_eq eta_intlike_ne eta_intlike_lt eta_intlike_gt
+  eta_intlike_le eta_intlike_ge
+  intlike_vec;;
+eta_test_vec
+  eta_float_cmp eta_float_eq eta_float_ne eta_float_lt eta_float_gt
+  eta_float_le eta_float_ge
+  float_vec;;
+eta_test_vec
+  eta_string_cmp eta_string_eq eta_string_ne eta_string_lt eta_string_gt
+  eta_string_le eta_string_ge
+  string_vec;;
+eta_test_vec
+  eta_int32_cmp eta_int32_eq eta_int32_ne eta_int32_lt eta_int32_gt
+  eta_int32_le eta_int32_ge
+  int32_vec;;
+eta_test_vec
+  eta_int64_cmp eta_int64_eq eta_int64_ne eta_int64_lt eta_int64_gt
+  eta_int64_le eta_int64_ge
+  int64_vec;;
+eta_test_vec
+  eta_nativeint_cmp eta_nativeint_eq eta_nativeint_ne
+  eta_nativeint_lt eta_nativeint_gt eta_nativeint_le eta_nativeint_ge
+  nativeint_vec;;
diff --git a/testsuite/tests/translprim/locs.ml b/testsuite/tests/translprim/locs.ml
new file mode 100644
index 00000000..78343cda
--- /dev/null
+++ b/testsuite/tests/translprim/locs.ml
@@ -0,0 +1,44 @@
+(* TEST *)
+
+let print_loc loc =
+  print_endline loc
+
+let print_file file =
+  print_endline file
+
+let print_line line =
+  print_endline (Int.to_string line)
+
+let print_module md =
+  print_endline md
+
+let print_pos (file, line, col1, col2) =
+  Printf.printf "%s, %d, %d, %d\n" file line col1 col2
+
+let () = print_loc __LOC__
+
+let () = print_file __FILE__
+
+let () = print_line __LINE__
+
+let () = print_module __MODULE__
+
+let () = print_pos __POS__
+
+let loc, s1 = __LOC_OF__ "an expression"
+
+let () = print_loc loc
+
+let () = print_endline s1
+
+let line, s2 = __LINE_OF__ "another expression"
+
+let () = print_line line
+
+let () = print_endline s2
+
+let pos, s3 = __POS_OF__ "yet another expression"
+
+let () = print_pos pos
+
+let () = print_endline s3
diff --git a/testsuite/tests/translprim/locs.reference b/testsuite/tests/translprim/locs.reference
new file mode 100644
index 00000000..abb22875
--- /dev/null
+++ b/testsuite/tests/translprim/locs.reference
@@ -0,0 +1,11 @@
+File "locs.ml", line 18, characters 19-26
+locs.ml
+22
+Locs
+locs.ml, 26, 19, 26
+File "locs.ml", line 28, characters 14-40
+an expression
+34
+another expression
+locs.ml, 40, 14, 49
+yet another expression
diff --git a/testsuite/tests/translprim/module_coercion.compilers.flat.reference b/testsuite/tests/translprim/module_coercion.compilers.flat.reference
new file mode 100644
index 00000000..34715159
--- /dev/null
+++ b/testsuite/tests/translprim/module_coercion.compilers.flat.reference
@@ -0,0 +1,90 @@
+(setglobal Module_coercion!
+  (let
+    (M =
+       (module-defn(M) Module_coercion module_coercion.ml(15):436-1135
+         (makeblock 0)))
+    (makeblock 0 M
+      (module-defn(M_int) Module_coercion module_coercion.ml(46):1552-1591
+        (makeblock 0 (function prim stub (array.length[int] prim))
+          (function prim prim stub (array.get[int] prim prim))
+          (function prim prim stub (array.unsafe_get[int] prim prim))
+          (function prim prim prim stub (array.set[int] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[int] prim prim prim))
+          (function prim prim stub (compare_ints prim prim))
+          (function prim prim stub (== prim prim))
+          (function prim prim stub (!= prim prim))
+          (function prim prim stub (< prim prim))
+          (function prim prim stub (> prim prim))
+          (function prim prim stub (<= prim prim))
+          (function prim prim stub (>= prim prim))))
+      (module-defn(M_float) Module_coercion module_coercion.ml(47):1594-1637
+        (makeblock 0 (function prim stub (array.length[float] prim))
+          (function prim prim stub (array.get[float] prim prim))
+          (function prim prim stub (array.unsafe_get[float] prim prim))
+          (function prim prim prim stub (array.set[float] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[float] prim prim prim))
+          (function prim prim stub (compare_floats prim prim))
+          (function prim prim stub (==. prim prim))
+          (function prim prim stub (!=. prim prim))
+          (function prim prim stub (<. prim prim))
+          (function prim prim stub (>. prim prim))
+          (function prim prim stub (<=. prim prim))
+          (function prim prim stub (>=. prim prim))))
+      (module-defn(M_string) Module_coercion module_coercion.ml(48):1640-1685
+        (makeblock 0 (function prim stub (array.length[addr] prim))
+          (function prim prim stub (array.get[addr] prim prim))
+          (function prim prim stub (array.unsafe_get[addr] prim prim))
+          (function prim prim prim stub (array.set[addr] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[addr] prim prim prim))
+          (function prim prim stub (caml_string_compare prim prim))
+          (function prim prim stub (caml_string_equal prim prim))
+          (function prim prim stub (caml_string_notequal prim prim))
+          (function prim prim stub (caml_string_lessthan prim prim))
+          (function prim prim stub (caml_string_greaterthan prim prim))
+          (function prim prim stub (caml_string_lessequal prim prim))
+          (function prim prim stub (caml_string_greaterequal prim prim))))
+      (module-defn(M_int32) Module_coercion module_coercion.ml(49):1688-1731
+        (makeblock 0 (function prim stub (array.length[addr] prim))
+          (function prim prim stub (array.get[addr] prim prim))
+          (function prim prim stub (array.unsafe_get[addr] prim prim))
+          (function prim prim prim stub (array.set[addr] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[addr] prim prim prim))
+          (function prim prim stub (compare_bints int32 prim prim))
+          (function prim prim stub (Int32.== prim prim))
+          (function prim prim stub (Int32.!= prim prim))
+          (function prim prim stub (Int32.< prim prim))
+          (function prim prim stub (Int32.> prim prim))
+          (function prim prim stub (Int32.<= prim prim))
+          (function prim prim stub (Int32.>= prim prim))))
+      (module-defn(M_int64) Module_coercion module_coercion.ml(50):1734-1777
+        (makeblock 0 (function prim stub (array.length[addr] prim))
+          (function prim prim stub (array.get[addr] prim prim))
+          (function prim prim stub (array.unsafe_get[addr] prim prim))
+          (function prim prim prim stub (array.set[addr] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[addr] prim prim prim))
+          (function prim prim stub (compare_bints int64 prim prim))
+          (function prim prim stub (Int64.== prim prim))
+          (function prim prim stub (Int64.!= prim prim))
+          (function prim prim stub (Int64.< prim prim))
+          (function prim prim stub (Int64.> prim prim))
+          (function prim prim stub (Int64.<= prim prim))
+          (function prim prim stub (Int64.>= prim prim))))
+      (module-defn(M_nativeint) Module_coercion module_coercion.ml(51):1780-1831
+        (makeblock 0 (function prim stub (array.length[addr] prim))
+          (function prim prim stub (array.get[addr] prim prim))
+          (function prim prim stub (array.unsafe_get[addr] prim prim))
+          (function prim prim prim stub (array.set[addr] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[addr] prim prim prim))
+          (function prim prim stub (compare_bints nativeint prim prim))
+          (function prim prim stub (Nativeint.== prim prim))
+          (function prim prim stub (Nativeint.!= prim prim))
+          (function prim prim stub (Nativeint.< prim prim))
+          (function prim prim stub (Nativeint.> prim prim))
+          (function prim prim stub (Nativeint.<= prim prim))
+          (function prim prim stub (Nativeint.>= prim prim)))))))
diff --git a/testsuite/tests/translprim/module_coercion.compilers.no-flat.reference b/testsuite/tests/translprim/module_coercion.compilers.no-flat.reference
new file mode 100644
index 00000000..e435b275
--- /dev/null
+++ b/testsuite/tests/translprim/module_coercion.compilers.no-flat.reference
@@ -0,0 +1,90 @@
+(setglobal Module_coercion!
+  (let
+    (M =
+       (module-defn(M) Module_coercion module_coercion.ml(15):436-1135
+         (makeblock 0)))
+    (makeblock 0 M
+      (module-defn(M_int) Module_coercion module_coercion.ml(46):1552-1591
+        (makeblock 0 (function prim stub (array.length[int] prim))
+          (function prim prim stub (array.get[int] prim prim))
+          (function prim prim stub (array.unsafe_get[int] prim prim))
+          (function prim prim prim stub (array.set[int] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[int] prim prim prim))
+          (function prim prim stub (compare_ints prim prim))
+          (function prim prim stub (== prim prim))
+          (function prim prim stub (!= prim prim))
+          (function prim prim stub (< prim prim))
+          (function prim prim stub (> prim prim))
+          (function prim prim stub (<= prim prim))
+          (function prim prim stub (>= prim prim))))
+      (module-defn(M_float) Module_coercion module_coercion.ml(47):1594-1637
+        (makeblock 0 (function prim stub (array.length[addr] prim))
+          (function prim prim stub (array.get[addr] prim prim))
+          (function prim prim stub (array.unsafe_get[addr] prim prim))
+          (function prim prim prim stub (array.set[addr] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[addr] prim prim prim))
+          (function prim prim stub (compare_floats prim prim))
+          (function prim prim stub (==. prim prim))
+          (function prim prim stub (!=. prim prim))
+          (function prim prim stub (<. prim prim))
+          (function prim prim stub (>. prim prim))
+          (function prim prim stub (<=. prim prim))
+          (function prim prim stub (>=. prim prim))))
+      (module-defn(M_string) Module_coercion module_coercion.ml(48):1640-1685
+        (makeblock 0 (function prim stub (array.length[addr] prim))
+          (function prim prim stub (array.get[addr] prim prim))
+          (function prim prim stub (array.unsafe_get[addr] prim prim))
+          (function prim prim prim stub (array.set[addr] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[addr] prim prim prim))
+          (function prim prim stub (caml_string_compare prim prim))
+          (function prim prim stub (caml_string_equal prim prim))
+          (function prim prim stub (caml_string_notequal prim prim))
+          (function prim prim stub (caml_string_lessthan prim prim))
+          (function prim prim stub (caml_string_greaterthan prim prim))
+          (function prim prim stub (caml_string_lessequal prim prim))
+          (function prim prim stub (caml_string_greaterequal prim prim))))
+      (module-defn(M_int32) Module_coercion module_coercion.ml(49):1688-1731
+        (makeblock 0 (function prim stub (array.length[addr] prim))
+          (function prim prim stub (array.get[addr] prim prim))
+          (function prim prim stub (array.unsafe_get[addr] prim prim))
+          (function prim prim prim stub (array.set[addr] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[addr] prim prim prim))
+          (function prim prim stub (compare_bints int32 prim prim))
+          (function prim prim stub (Int32.== prim prim))
+          (function prim prim stub (Int32.!= prim prim))
+          (function prim prim stub (Int32.< prim prim))
+          (function prim prim stub (Int32.> prim prim))
+          (function prim prim stub (Int32.<= prim prim))
+          (function prim prim stub (Int32.>= prim prim))))
+      (module-defn(M_int64) Module_coercion module_coercion.ml(50):1734-1777
+        (makeblock 0 (function prim stub (array.length[addr] prim))
+          (function prim prim stub (array.get[addr] prim prim))
+          (function prim prim stub (array.unsafe_get[addr] prim prim))
+          (function prim prim prim stub (array.set[addr] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[addr] prim prim prim))
+          (function prim prim stub (compare_bints int64 prim prim))
+          (function prim prim stub (Int64.== prim prim))
+          (function prim prim stub (Int64.!= prim prim))
+          (function prim prim stub (Int64.< prim prim))
+          (function prim prim stub (Int64.> prim prim))
+          (function prim prim stub (Int64.<= prim prim))
+          (function prim prim stub (Int64.>= prim prim))))
+      (module-defn(M_nativeint) Module_coercion module_coercion.ml(51):1780-1831
+        (makeblock 0 (function prim stub (array.length[addr] prim))
+          (function prim prim stub (array.get[addr] prim prim))
+          (function prim prim stub (array.unsafe_get[addr] prim prim))
+          (function prim prim prim stub (array.set[addr] prim prim prim))
+          (function prim prim prim stub
+            (array.unsafe_set[addr] prim prim prim))
+          (function prim prim stub (compare_bints nativeint prim prim))
+          (function prim prim stub (Nativeint.== prim prim))
+          (function prim prim stub (Nativeint.!= prim prim))
+          (function prim prim stub (Nativeint.< prim prim))
+          (function prim prim stub (Nativeint.> prim prim))
+          (function prim prim stub (Nativeint.<= prim prim))
+          (function prim prim stub (Nativeint.>= prim prim)))))))
diff --git a/testsuite/tests/translprim/module_coercion.ml b/testsuite/tests/translprim/module_coercion.ml
new file mode 100644
index 00000000..a6d334c8
--- /dev/null
+++ b/testsuite/tests/translprim/module_coercion.ml
@@ -0,0 +1,51 @@
+(* TEST
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+      flags = "-dlambda -dno-unique-ids"
+   *** flat-float-array
+   **** check-ocamlc.byte-output
+        compiler_reference =
+          "${test_source_directory}/module_coercion.compilers.flat.reference"
+   *** no-flat-float-array
+   **** check-ocamlc.byte-output
+       compiler_reference =
+         "${test_source_directory}/module_coercion.compilers.no-flat.reference"
+*)
+
+module M = struct
+  external len : 'a array -> int = "%array_length"
+  external safe_get : 'a array -> int -> 'a = "%array_safe_get"
+  external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get"
+  external safe_set : 'a array -> int -> 'a -> unit = "%array_safe_set"
+  external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set"
+  external cmp : 'a -> 'a -> int = "%compare";;
+  external eq : 'a -> 'a -> bool = "%equal";;
+  external ne : 'a -> 'a -> bool = "%notequal";;
+  external lt : 'a -> 'a -> bool = "%lessthan";;
+  external gt : 'a -> 'a -> bool = "%greaterthan";;
+  external le : 'a -> 'a -> bool = "%lessequal";;
+  external ge : 'a -> 'a -> bool = "%greaterequal";;
+end;;
+
+module type T = sig
+  type t
+  val len : t array -> int
+  val safe_get : t array -> int -> t
+  val unsafe_get : t array -> int -> t
+  val safe_set : t array -> int -> t -> unit
+  val unsafe_set : t array -> int -> t -> unit
+  val cmp : t -> t -> int
+  val eq : t -> t -> bool
+  val ne : t -> t -> bool
+  val lt : t -> t -> bool
+  val gt : t -> t -> bool
+  val le : t -> t -> bool
+  val ge : t -> t -> bool
+end;;
+
+module M_int : T with type t := int = M;;
+module M_float : T with type t := float = M;;
+module M_string : T with type t := string = M;;
+module M_int32 : T with type t := int32 = M;;
+module M_int64 : T with type t := int64 = M;;
+module M_nativeint : T with type t := nativeint = M;;
diff --git a/testsuite/tests/translprim/ref_spec.compilers.reference b/testsuite/tests/translprim/ref_spec.compilers.reference
new file mode 100644
index 00000000..72b48d4f
--- /dev/null
+++ b/testsuite/tests/translprim/ref_spec.compilers.reference
@@ -0,0 +1,37 @@
+(setglobal Ref_spec!
+  (let
+    (int_ref = (makemutable 0 (int) 1)
+     var_ref = (makemutable 0 65a)
+     vargen_ref = (makemutable 0 65a)
+     cst_ref = (makemutable 0 0a)
+     gen_ref = (makemutable 0 0a)
+     flt_ref = (makemutable 0 (float) 0.))
+    (seq (setfield_imm 0 int_ref 2) (setfield_imm 0 var_ref 66a)
+      (setfield_ptr 0 vargen_ref [0: 66 0]) (setfield_ptr 0 vargen_ref 67a)
+      (setfield_imm 0 cst_ref 1a) (setfield_ptr 0 gen_ref [0: "foo"])
+      (setfield_ptr 0 gen_ref 0a) (setfield_ptr 0 flt_ref 1.)
+      (let
+        (int_rec = (makemutable 0 (*,int) 0a 1)
+         var_rec = (makemutable 0 0a 65a)
+         vargen_rec = (makemutable 0 0a 65a)
+         cst_rec = (makemutable 0 0a 0a)
+         gen_rec = (makemutable 0 0a 0a)
+         flt_rec = (makemutable 0 (*,float) 0a 0.)
+         flt_rec' = (makearray[float] 0. 0.))
+        (seq (setfield_imm 1 int_rec 2) (setfield_imm 1 var_rec 66a)
+          (setfield_ptr 1 vargen_rec [0: 66 0])
+          (setfield_ptr 1 vargen_rec 67a) (setfield_imm 1 cst_rec 1a)
+          (setfield_ptr 1 gen_rec [0: "foo"]) (setfield_ptr 1 gen_rec 0a)
+          (setfield_ptr 1 flt_rec 1.) (setfloatfield 1 flt_rec' 1.)
+          (let
+            (set_open_poly = (function r y (setfield_ptr 0 r y))
+             set_open_poly = (function r y (setfield_imm 0 r y))
+             set_open_poly = (function r y (setfield_imm 0 r y))
+             set_open_poly = (function r y (setfield_imm 0 r y))
+             set_open_poly = (function r y (setfield_ptr 0 r y))
+             set_open_poly = (function r y (setfield_ptr 0 r y))
+             set_open_poly = (function r y (setfield_ptr 0 r y))
+             set_open_poly = (function r y (setfield_ptr 0 r y)))
+            (makeblock 0 int_ref var_ref vargen_ref cst_ref gen_ref flt_ref
+              int_rec var_rec vargen_rec cst_rec gen_rec flt_rec flt_rec'
+              set_open_poly)))))))
diff --git a/testsuite/tests/translprim/ref_spec.ml b/testsuite/tests/translprim/ref_spec.ml
new file mode 100644
index 00000000..82cbd1ee
--- /dev/null
+++ b/testsuite/tests/translprim/ref_spec.ml
@@ -0,0 +1,61 @@
+(* TEST
+   * setup-ocamlc.byte-build-env
+   ** ocamlc.byte
+      flags = "-dlambda -dno-unique-ids"
+   *** check-ocamlc.byte-output
+*)
+
+type 'a custom_rec = { x : unit; mutable y : 'a }
+type float_rec = { w : float; mutable z : float }
+
+type cst = A | B
+type gen = C | D of string
+
+type var = [ `A | `B ]
+type vargen = [ `A | `B of int | `C ]
+
+let int_ref = ref 1;;
+let var_ref : var ref = ref `A;;
+let vargen_ref : vargen ref = ref `A;;
+let cst_ref = ref A;;
+let gen_ref = ref C;;
+let flt_ref = ref 0.;;
+
+int_ref := 2;;
+var_ref := `B;;
+vargen_ref := `B 0;;
+vargen_ref := `C;;
+cst_ref := B;;
+gen_ref := D "foo";;
+gen_ref := C;;
+flt_ref := 1.;;
+
+let int_rec = { x = (); y = 1 };;
+let var_rec : var custom_rec = { x = (); y = `A };;
+let vargen_rec : vargen custom_rec = { x = (); y = `A };;
+let cst_rec = { x = (); y = A };;
+let gen_rec = { x = (); y = C };;
+let flt_rec = { x = (); y = 0. };;
+let flt_rec' = { w = 0.; z = 0. };;
+
+int_rec.y <- 2;;
+var_rec.y <- `B;;
+vargen_rec.y <- `B 0;;
+vargen_rec.y <- `C;;
+cst_rec.y <- B;;
+gen_rec.y <- D "foo";;
+gen_rec.y <- C;;
+flt_rec.y <- 1.;;
+flt_rec'.z <- 1.;;
+
+(* must use a write barrier, type is open *)
+let set_open_poly (r:[>`Foo] ref) y = r := y ;;
+let set_open_poly (r:[<`Foo] ref) y = r := y ;;
+let set_open_poly (r:[`Foo] ref) y = r := y ;;
+let set_open_poly (r:[< `Bar | `Foo | `Baz > `Foo `Bar] ref) y = r := y ;;
+let set_open_poly (r:[>`Foo of int] ref) y = r := y ;;
+let set_open_poly (r:[<`Foo of int] ref) y = r := y ;;
+let set_open_poly (r:[`Foo of int] ref) y = r := y ;;
+let set_open_poly (r:[< `Bar | `Foo of float | `Baz > `Foo `Bar] ref) y =
+  r := y
+;;
diff --git a/testsuite/tests/typing-core-bugs/const_int_hint.ml b/testsuite/tests/typing-core-bugs/const_int_hint.ml
new file mode 100644
index 00000000..bc4b528b
--- /dev/null
+++ b/testsuite/tests/typing-core-bugs/const_int_hint.ml
@@ -0,0 +1,152 @@
+(* TEST
+   * expect
+*)
+
+let _ = Int32.(add 1 2l);;
+[%%expect{|
+Line 1, characters 19-20:
+1 | let _ = Int32.(add 1 2l);;
+                       ^
+Error: This expression has type int but an expression was expected of type
+         int32
+  Hint: Did you mean `1l'?
+|}]
+
+let _ : int32 * int32 = 42l, 43;;
+[%%expect{|
+Line 1, characters 29-31:
+1 | let _ : int32 * int32 = 42l, 43;;
+                                 ^^
+Error: This expression has type int but an expression was expected of type
+         int32
+  Hint: Did you mean `43l'?
+|}]
+
+let _ : int32 * nativeint = 42l, 43;;
+[%%expect{|
+Line 1, characters 33-35:
+1 | let _ : int32 * nativeint = 42l, 43;;
+                                     ^^
+Error: This expression has type int but an expression was expected of type
+         nativeint
+  Hint: Did you mean `43n'?
+|}]
+
+let _ = min 6L 7;;
+[%%expect{|
+Line 1, characters 15-16:
+1 | let _ = min 6L 7;;
+                   ^
+Error: This expression has type int but an expression was expected of type
+         int64
+  Hint: Did you mean `7L'?
+|}]
+
+let _ : float = 123;;
+[%%expect{|
+Line 1, characters 16-19:
+1 | let _ : float = 123;;
+                    ^^^
+Error: This expression has type int but an expression was expected of type
+         float
+  Hint: Did you mean `123.'?
+|}]
+
+(* no hint *)
+let x = 0
+let _ = Int32.(add x 2l);;
+[%%expect{|
+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
+|}]
+
+(* pattern *)
+let _ : int32 -> int32 = function
+  | 0 -> 0l
+  | x -> x
+[%%expect{|
+Line 2, characters 4-5:
+2 |   | 0 -> 0l
+        ^
+Error: This pattern matches values of type int
+       but a pattern was expected which matches values of type int32
+  Hint: Did you mean `0l'?
+|}, Principal{|
+Line 2, characters 4-5:
+2 |   | 0 -> 0l
+        ^
+Error: This pattern matches values of type int
+       but a pattern was expected which matches values of type int32
+|}]
+
+let _ : int64 -> int64 = function
+  | 1L | 2 -> 3L
+  | x -> x;;
+[%%expect{|
+Line 2, characters 9-10:
+2 |   | 1L | 2 -> 3L
+             ^
+Error: This pattern matches values of type int
+       but a pattern was expected which matches values of type int64
+  Hint: Did you mean `2L'?
+|}]
+
+(* symmetric *)
+let _ : int32 = 1L;;
+[%%expect{|
+Line 1, characters 16-18:
+1 | let _ : int32 = 1L;;
+                    ^^
+Error: This expression has type int64 but an expression was expected of type
+         int32
+  Hint: Did you mean `1l'?
+|}]
+let _ : float = 1L;;
+[%%expect{|
+Line 1, characters 16-18:
+1 | let _ : float = 1L;;
+                    ^^
+Error: This expression has type int64 but an expression was expected of type
+         float
+  Hint: Did you mean `1.'?
+|}]
+let _ : int64 = 1n;;
+[%%expect{|
+Line 1, characters 16-18:
+1 | let _ : int64 = 1n;;
+                    ^^
+Error: This expression has type nativeint
+       but an expression was expected of type int64
+  Hint: Did you mean `1L'?
+|}]
+let _ : nativeint = 1l;;
+[%%expect{|
+Line 1, characters 20-22:
+1 | let _ : nativeint = 1l;;
+                        ^^
+Error: This expression has type int32 but an expression was expected of type
+         nativeint
+  Hint: Did you mean `1n'?
+|}]
+
+(* not implemented *)
+let _ : int64 = 0.;;
+[%%expect{|
+Line 1, characters 16-18:
+1 | let _ : int64 = 0.;;
+                    ^^
+Error: This expression has type float but an expression was expected of type
+         int64
+|}]
+let _ : int = 1L;;
+[%%expect{|
+Line 1, characters 14-16:
+1 | let _ : int = 1L;;
+                  ^^
+Error: This expression has type int64 but an expression was expected of type
+         int
+|}]
diff --git a/testsuite/tests/typing-core-bugs/missing_rec_hint.ml b/testsuite/tests/typing-core-bugs/missing_rec_hint.ml
new file mode 100644
index 00000000..f3e62e2b
--- /dev/null
+++ b/testsuite/tests/typing-core-bugs/missing_rec_hint.ml
@@ -0,0 +1,67 @@
+(* TEST
+   * expect
+*)
+
+let facto n =   (* missing [rec] *)
+   if n = 0 then 1 else n * facto (n-1)
+
+[%%expect{|
+Line 2, characters 28-33:
+2 |    if n = 0 then 1 else n * facto (n-1)
+                                ^^^^^
+Error: Unbound value facto
+Hint: If this is a recursive definition,
+you should add the 'rec' keyword on line 1
+|}];;
+
+let x = 3 in
+let f x = f x in
+()
+
+[%%expect{|
+Line 2, characters 10-11:
+2 | let f x = f x in
+              ^
+Error: Unbound value f
+Hint: If this is a recursive definition,
+you should add the 'rec' keyword on line 2
+|}];;
+
+let f x = if x < 0 then x else h (x-1)
+and g x = if x < 0 then x else f (x-1)
+and h x = if x < 0 then x else g (x-1)
+
+[%%expect{|
+Line 1, characters 31-32:
+1 | let f x = if x < 0 then x else h (x-1)
+                                   ^
+Error: Unbound value h
+Hint: If this is a recursive definition,
+you should add the 'rec' keyword on line 1
+|}];;
+
+let value1 = 3 in
+let value2 = value2 (* typo: should be value1 *) + 1 in
+()
+
+[%%expect{|
+Line 2, characters 13-19:
+2 | let value2 = value2 (* typo: should be value1 *) + 1 in
+                 ^^^^^^
+Error: Unbound value value2
+Hint: Did you mean value1?
+|}];;
+
+let foobar1 () = () in
+let foobar2 () = foobar2 () (* typo? or missing "rec"? *) in
+()
+
+[%%expect{|
+Line 2, characters 17-24:
+2 | let foobar2 () = foobar2 () (* typo? or missing "rec"? *) in
+                     ^^^^^^^
+Error: Unbound value foobar2
+Hint: Did you mean foobar1?
+Hint: If this is a recursive definition,
+you should add the 'rec' keyword on line 2
+|}];;
diff --git a/testsuite/tests/typing-core-bugs/repeated_did_you_mean.ml b/testsuite/tests/typing-core-bugs/repeated_did_you_mean.ml
new file mode 100644
index 00000000..3c187fa4
--- /dev/null
+++ b/testsuite/tests/typing-core-bugs/repeated_did_you_mean.ml
@@ -0,0 +1,22 @@
+(* TEST
+   * expect
+*)
+
+(* MPR 7864 *)
+
+let foo = 12
+module M = struct
+  let foo = 13
+end
+open M
+
+let _ = fox;;
+[%%expect{|
+val foo : int = 12
+module M : sig val foo : int end
+Line 7, characters 8-11:
+7 | let _ = fox;;
+            ^^^
+Error: Unbound value fox
+Hint: Did you mean foo?
+|}]
diff --git a/testsuite/tests/typing-core-bugs/type_expected_explanation.ml b/testsuite/tests/typing-core-bugs/type_expected_explanation.ml
new file mode 100644
index 00000000..e01aa267
--- /dev/null
+++ b/testsuite/tests/typing-core-bugs/type_expected_explanation.ml
@@ -0,0 +1,189 @@
+(* TEST
+   flags = "-strict-sequence"
+   * expect
+*)
+
+if 3 then ();;
+
+[%%expect{|
+Line 1, characters 3-4:
+1 | if 3 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
+|}];;
+
+fun b -> if true then (print_int b) else (if b then ());;
+
+[%%expect{|
+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
+|}];;
+
+(* Left-to-right bias is still there: if we swap the branches, the new error
+   message does not show up because of propagation order. *)
+fun b -> if true then (if b then ()) else (print_int b);;
+
+[%%expect{|
+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
+|}];;
+
+if (let x = 3 in x) then ();;
+
+[%%expect{|
+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
+|}];;
+
+if (if true then 3 else 4) then ();;
+
+[%%expect{|
+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
+         bool
+       because it is in the condition of an if-statement
+|}];;
+
+if true then 3;;
+
+[%%expect{|
+Line 1, characters 13-14:
+1 | if true then 3;;
+                 ^
+Error: This expression has type int but an expression was expected of type
+         unit
+       because it is in the result of a conditional with no else branch
+|}];;
+
+if (fun x -> x) then ();;
+
+[%%expect{|
+Line 1, characters 3-15:
+1 | if (fun x -> x) then ();;
+       ^^^^^^^^^^^^
+Error: This expression should not be a function, the expected type is
+       bool because it is in the condition of an if-statement
+|}];;
+
+while 42 do () done;;
+
+[%%expect{|
+Line 1, characters 6-8:
+1 | while 42 do () done;;
+          ^^
+Error: This expression has type int but an expression was expected of type
+         bool
+       because it is in the condition of a while-loop
+|}];;
+
+(* -strict-sequence is required for this test to fail, otherwise only a warning
+   is produced *)
+while true do (if true then 3 else 4) done;;
+
+[%%expect{|
+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
+       because it is in the body of a while-loop
+|}];;
+
+for i = 3. to 4 do () done;;
+
+[%%expect{|
+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
+         int
+       because it is in a for-loop start index
+|}];;
+
+for i = 3 to 4. do () done;;
+
+[%%expect{|
+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
+         int
+       because it is in a for-loop stop index
+|}];;
+
+(* -strict-sequence is required for this test to fail, otherwise only a warning
+   is produced *)
+for i = 0 to 0 do (if true then 3 else 4) done;;
+
+[%%expect{|
+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
+       because it is in the body of a for-loop
+|}];;
+
+assert 12;;
+
+[%%expect{|
+Line 1, characters 7-9:
+1 | assert 12;;
+           ^^
+Error: This expression has type int but an expression was expected of type
+         bool
+       because it is in the condition of an assertion
+|}];;
+
+(* -strict-sequence is also required for this test to fail *)
+(let x = 3 in x+1); ();;
+
+[%%expect{|
+Line 1, characters 0-18:
+1 | (let x = 3 in x+1); ();;
+    ^^^^^^^^^^^^^^^^^^
+Error: This expression has type int but an expression was expected of type
+         unit
+       because it is in the left-hand side of a sequence
+|}];;
+
+let ordered_list_with x y =
+  if x <= y then [x;y]
+  else if x > y then [y;x]
+
+[%%expect{|
+Line 3, characters 22-26:
+3 |   else if x > y then [y;x]
+                          ^^^^
+Error: This variant expression is expected to have type unit
+         because it is in the result of a conditional with no else branch
+       The constructor :: does not belong to type unit
+|}];;
+
+(function
+  | y when y + 1 -> ()
+  | _ -> ());;
+
+[%%expect{|
+Line 2, characters 11-16:
+2 |   | y when y + 1 -> ()
+               ^^^^^
+Error: This expression has type int but an expression was expected of type
+         bool
+       because it is in a when-guard
+|}];;
diff --git a/testsuite/tests/typing-core-bugs/unit_fun_hints.ml b/testsuite/tests/typing-core-bugs/unit_fun_hints.ml
new file mode 100644
index 00000000..73b4ad22
--- /dev/null
+++ b/testsuite/tests/typing-core-bugs/unit_fun_hints.ml
@@ -0,0 +1,73 @@
+(* TEST
+   flags = "-strict-sequence"
+   * expect
+*)
+
+let g f = f ()
+let _ = g 3;;       (* missing `fun () ->' *)
+
+[%%expect{|
+val g : (unit -> 'a) -> 'a = 
+Line 2, characters 10-11:
+2 | let _ = g 3;;       (* missing `fun () ->' *)
+              ^
+Error: This expression has type int but an expression was expected of type
+         unit -> 'a
+       Hint: Did you forget to wrap the expression using `fun () ->'?
+|}];;
+
+
+let _ =
+   print_int 3;
+   print_newline;    (* missing unit argument *)
+   print_int 5;;
+
+(* We use -strict-sequence for this test: otherwise only a warning is produced
+   about print_newline not being of type unit *)
+[%%expect{|
+Line 3, characters 3-16:
+3 |    print_newline;    (* missing unit argument *)
+       ^^^^^^^^^^^^^
+Error: This expression 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?
+|}];;
+
+let x = read_int in   (* missing unit argument *)
+print_int x;;
+
+[%%expect{|
+Line 2, characters 10-11:
+2 | print_int x;;
+              ^
+Error: This expression has type unit -> int
+       but an expression was expected of type int
+       Hint: Did you forget to provide `()' as argument?
+|}];;
+
+let g f =
+  let _ = f () in
+  f = 3;;
+
+[%%expect{|
+Line 3, characters 6-7:
+3 |   f = 3;;
+          ^
+Error: This expression has type int but an expression was expected of type
+         unit -> 'a
+       Hint: Did you forget to wrap the expression using `fun () ->'?
+|}];;
+
+let g f =
+  let _ = f () in
+  3 = f;;
+
+[%%expect{|
+Line 3, characters 6-7:
+3 |   3 = f;;
+          ^
+Error: This expression 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-deprecated/alerts.ml b/testsuite/tests/typing-deprecated/alerts.ml
new file mode 100644
index 00000000..016ccf55
--- /dev/null
+++ b/testsuite/tests/typing-deprecated/alerts.ml
@@ -0,0 +1,273 @@
+(* TEST
+   * expect
+*)
+
+
+(* Enable all alerts as errors, except foo (soft) and bar (disabled) *)
+[@@@ocaml.alert "@all--foo-bar"];;
+
+module X : sig
+  val x: int [@@alert foo "Foo!"]
+  val y: int [@@alert bar "Bar!"]
+  val z: int [@@alert baz "Baz!"]
+  val t: int [@@alert foo "FOO"] [@@alert bar "BAR"] [@@alert baz "BAZ"]
+end = struct
+  let x, y, z, t = 0, 0, 0, 0
+end
+[%%expect{|
+module X : sig val x : int val y : int val z : int val t : int end
+|}]
+
+let _ = X.x;;
+[%%expect{|
+Line 1, characters 8-11:
+1 | let _ = X.x;;
+            ^^^
+Alert foo: X.x
+Foo!
+- : int = 0
+|}]
+
+let _ = X.y;;
+[%%expect{|
+- : int = 0
+|}]
+
+let _ = X.z;;
+[%%expect{|
+Line 1, characters 8-11:
+1 | let _ = X.z;;
+            ^^^
+Error (alert baz): X.z
+Baz!
+|}]
+
+let _ = X.t;;
+[%%expect{|
+Line 1, characters 8-11:
+1 | let _ = X.t;;
+            ^^^
+Error (alert baz): X.t
+BAZ
+Line 1, characters 8-11:
+1 | let _ = X.t;;
+            ^^^
+Alert foo: X.t
+FOO
+|}]
+
+
+module Z1 : sig
+  val x: int [@@alert foo "Foo!"] [@@alert foo2 "Foo2"]
+  val y: int [@@alert bar "Bar!"]
+  val z: int [@@alert baz "Baz!"]
+  val t: int [@@alert foo "FOO"] [@@alert bar "BAR"] [@@alert baz "BAZ"]
+end = X;;
+[%%expect{|
+module Z1 : sig val x : int val y : int val z : int val t : int end
+|}]
+
+module Z2 : sig
+  val x: int
+  val y: int
+  val z: int
+  val t: int
+end = X;;
+[%%expect{|
+Line 6, characters 6-7:
+6 | end = X;;
+          ^
+Alert foo: x
+Foo!
+Line 4, characters 2-33:
+4 |   val x: int [@@alert foo "Foo!"]
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+Line 2, characters 2-12:
+2 |   val x: int
+      ^^^^^^^^^^
+  Expected signature
+Line 6, characters 6-7:
+6 | end = X;;
+          ^
+Error (alert baz): z
+Baz!
+Line 6, characters 2-33:
+6 |   val z: int [@@alert baz "Baz!"]
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+Line 4, characters 2-12:
+4 |   val z: int
+      ^^^^^^^^^^
+  Expected signature
+Line 6, characters 6-7:
+6 | end = X;;
+          ^
+Error (alert baz): t
+BAZ
+Line 7, characters 2-72:
+7 |   val t: int [@@alert foo "FOO"] [@@alert bar "BAR"] [@@alert baz "BAZ"]
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+Line 5, characters 2-12:
+5 |   val t: int
+      ^^^^^^^^^^
+  Expected signature
+Line 6, characters 6-7:
+6 | end = X;;
+          ^
+Alert foo: t
+FOO
+Line 7, characters 2-72:
+7 |   val t: int [@@alert foo "FOO"] [@@alert bar "BAR"] [@@alert baz "BAZ"]
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+Line 5, characters 2-12:
+5 |   val t: int
+      ^^^^^^^^^^
+  Expected signature
+|}]
+
+(* Turn all alerts into soft mode *)
+[@@@ocaml.alert "--all"];;
+
+module Z3 : sig
+  val x: int
+  val y: int
+  val z: int
+  val t: int
+end = X;;
+[%%expect{|
+Line 8, characters 6-7:
+8 | end = X;;
+          ^
+Alert foo: x
+Foo!
+Line 4, characters 2-33:
+4 |   val x: int [@@alert foo "Foo!"]
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+Line 4, characters 2-12:
+4 |   val x: int
+      ^^^^^^^^^^
+  Expected signature
+Line 8, characters 6-7:
+8 | end = X;;
+          ^
+Alert baz: z
+Baz!
+Line 6, characters 2-33:
+6 |   val z: int [@@alert baz "Baz!"]
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+Line 6, characters 2-12:
+6 |   val z: int
+      ^^^^^^^^^^
+  Expected signature
+Line 8, characters 6-7:
+8 | end = X;;
+          ^
+Alert baz: t
+BAZ
+Line 7, characters 2-72:
+7 |   val t: int [@@alert foo "FOO"] [@@alert bar "BAR"] [@@alert baz "BAZ"]
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+Line 7, characters 2-12:
+7 |   val t: int
+      ^^^^^^^^^^
+  Expected signature
+Line 8, characters 6-7:
+8 | end = X;;
+          ^
+Alert foo: t
+FOO
+Line 7, characters 2-72:
+7 |   val t: int [@@alert foo "FOO"] [@@alert bar "BAR"] [@@alert baz "BAZ"]
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+Line 7, characters 2-12:
+7 |   val t: int
+      ^^^^^^^^^^
+  Expected signature
+module Z3 : sig val x : int val y : int val z : int val t : int end
+|}]
+
+
+(* Disable all alerts *)
+[@@@ocaml.alert "-all"];;
+
+module Z4 : sig
+  val x: int
+  val y: int
+  val z: int
+  val t: int
+end = X;;
+[%%expect{|
+module Z4 : sig val x : int val y : int val z : int val t : int end
+|}]
+
+
+(* Multiple alert messages of the same kind *)
+[@@@ocaml.alert "+all--all"]
+module X : sig
+  val x: int [@@alert bla "X1"] [@@alert bla "X2"] [@@alert bla "X3"]
+  val y: int [@@alert bla "X1"] [@@alert bla]  [@@alert bla "X3"]
+  val z: int [@@alert bla] [@@alert bla] [@@alert bla]
+end = struct
+  let x, y, z = 0, 0, 0
+end;;
+let _ = X.x
+let _ = X.y
+let _ = X.z
+[%%expect{|
+module X : sig val x : int val y : int val z : int end
+Line 9, characters 8-11:
+9 | let _ = X.x
+            ^^^
+Alert bla: X.x
+X1
+X2
+X3
+- : int = 0
+Line 10, characters 8-11:
+10 | let _ = X.y
+             ^^^
+Alert bla: X.y
+X1
+X3
+- : int = 0
+Line 11, characters 8-11:
+11 | let _ = X.z
+             ^^^
+Alert bla: X.z
+- : int = 0
+|}]
+
+
+(* Invalid paylods *)
+module X : sig
+  val x: int [@@alert 42]
+  val y: int [@@alert bla 42]
+  val z: int [@@alert "bla"]
+end = struct
+  let x, y, z = 0, 0, 0
+end
+[%%expect{|
+Line 2, characters 13-25:
+2 |   val x: int [@@alert 42]
+                 ^^^^^^^^^^^^
+Warning 47: illegal payload for attribute 'alert'.
+Invalid payload
+Line 3, characters 13-29:
+3 |   val y: int [@@alert bla 42]
+                 ^^^^^^^^^^^^^^^^
+Warning 47: illegal payload for attribute 'alert'.
+Invalid payload
+Line 4, characters 13-28:
+4 |   val z: int [@@alert "bla"]
+                 ^^^^^^^^^^^^^^^
+Warning 47: illegal payload for attribute 'alert'.
+Ill-formed list of alert settings
+module X : sig val x : int val y : int val z : int end
+|}]
diff --git a/testsuite/tests/typing-deprecated/deprecated.ml b/testsuite/tests/typing-deprecated/deprecated.ml
new file mode 100644
index 00000000..8429df43
--- /dev/null
+++ b/testsuite/tests/typing-deprecated/deprecated.ml
@@ -0,0 +1,627 @@
+(* TEST
+   * expect
+*)
+
+[@@@ocaml.warning "+3"];;
+
+module X: sig
+  type t [@@ocaml.deprecated]
+  type s [@@ocaml.deprecated]
+  type u [@@ocaml.deprecated]
+  val x: t [@@ocaml.deprecated]
+end = struct
+  type t = int
+  type s
+  type u
+  let x = 0
+end;;
+[%%expect{|
+Line 7, characters 9-10:
+7 |   val x: t [@@ocaml.deprecated]
+             ^
+Alert deprecated: t
+module X : sig type t type s type u val x : t end
+|}]
+
+type t = X.t
+;;
+[%%expect{|
+Line 1, characters 9-12:
+1 | type t = X.t
+             ^^^
+Alert deprecated: X.t
+type t = X.t
+|}]
+
+let x = X.x
+;;
+[%%expect{|
+Line 1, characters 8-11:
+1 | let x = X.x
+            ^^^
+Alert deprecated: X.x
+val x : X.t = 
+|}]
+
+(* Patterns *)
+
+let (_, foo [@deprecated], _) = 1, (), 3
+;;
+foo;;
+[%%expect{|
+val foo : unit = ()
+Line 3, characters 0-3:
+3 | foo;;
+    ^^^
+Alert deprecated: foo
+- : unit = ()
+|}]
+
+let (_, foo, bar) [@deprecated] = 1, (), 3
+;;
+foo;;
+[%%expect{|
+val foo : unit = ()
+val bar : int = 3
+- : unit = ()
+|}]
+
+let f = function
+  | bar, cho [@deprecated], _ -> cho + 1
+;;
+[%%expect{|
+Line 2, characters 33-36:
+2 |   | bar, cho [@deprecated], _ -> cho + 1
+                                     ^^^
+Alert deprecated: cho
+val f : 'a * int * 'b -> int = 
+|}]
+
+class c (_, (foo [@deprecated] : int)) =
+  object
+    val h = foo
+  end
+;;
+[%%expect{|
+Line 3, characters 12-15:
+3 |     val h = foo
+                ^^^
+Alert deprecated: foo
+class c : 'a * int -> object val h : int end
+|}]
+
+(* Type declarations *)
+
+type t = X.t * X.s
+;;
+[%%expect{|
+Line 1, characters 9-12:
+1 | type t = X.t * X.s
+             ^^^
+Alert deprecated: X.t
+Line 1, characters 15-18:
+1 | type t = X.t * X.s
+                   ^^^
+Alert deprecated: X.s
+type t = X.t * X.s
+|}]
+
+type t = X.t * X.s [@@ocaml.warning "-3"]
+;;
+[%%expect{|
+type t = X.t * X.s
+|}]
+
+type t1 = X.t [@@ocaml.warning "-3"]
+and t2 = X.s
+;;
+[%%expect{|
+Line 2, characters 9-12:
+2 | and t2 = X.s
+             ^^^
+Alert deprecated: X.s
+type t1 = X.t
+and t2 = X.s
+|}]
+
+type t = A of t [@@ocaml.deprecated]
+;;
+[%%expect{|
+Line 1, characters 14-15:
+1 | type t = A of t [@@ocaml.deprecated]
+                  ^
+Alert deprecated: t
+type t = A of t
+|}]
+
+type t = A of t
+  [@@ocaml.deprecated]
+  [@@ocaml.warning "-3"]
+;;
+[%%expect{|
+type t = A of t
+|}]
+
+(* Type expressions *)
+
+type t = (X.t * X.s) [@ocaml.warning "-3"]
+;;
+[%%expect{|
+type t = X.t * X.s
+|}]
+
+type t = (X.t [@ocaml.warning "-3"]) * X.s
+;;
+[%%expect{|
+Line 1, characters 39-42:
+1 | type t = (X.t [@ocaml.warning "-3"]) * X.s
+                                           ^^^
+Alert deprecated: X.s
+type t = X.t * X.s
+|}]
+
+
+type t = A of (t [@ocaml.warning "-3"])
+  [@@ocaml.deprecated]
+;;
+[%%expect{|
+type t = A of t
+|}]
+
+(* Pattern expressions *)
+
+let _ = function (_ : X.t) -> ()
+;;
+[%%expect{|
+Line 1, characters 22-25:
+1 | let _ = function (_ : X.t) -> ()
+                          ^^^
+Alert deprecated: X.t
+- : X.t -> unit = 
+|}]
+
+let _ = function (_ : X.t)[@ocaml.warning "-3"] -> ()
+;;
+[%%expect{|
+- : X.t -> unit = 
+|}]
+
+
+(* Module expressions and module declarations *)
+
+module M = struct let x = X.x end
+;;
+[%%expect{|
+Line 1, characters 26-29:
+1 | module M = struct let x = X.x end
+                              ^^^
+Alert deprecated: X.x
+module M : sig val x : X.t end
+|}]
+
+module M = (struct let x = X.x end)[@ocaml.warning "-3"]
+;;
+[%%expect{|
+module M : sig val x : X.t end
+|}]
+
+module M = struct let x = X.x end [@@ocaml.warning "-3"]
+;;
+[%%expect{|
+module M : sig val x : X.t end
+|}]
+
+
+module rec M : sig val x: X.t end = struct let x = X.x end
+[%%expect{|
+Line 1, characters 26-29:
+1 | module rec M : sig val x: X.t end = struct let x = X.x end
+                              ^^^
+Alert deprecated: X.t
+Line 1, characters 51-54:
+1 | module rec M : sig val x: X.t end = struct let x = X.x end
+                                                       ^^^
+Alert deprecated: X.x
+module rec M : sig val x : X.t end
+|}]
+
+module rec M : sig val x: X.t end =
+  struct
+    let x = X.x
+  end [@@ocaml.warning "-3"]
+[%%expect{|
+module rec M : sig val x : X.t end
+|}]
+
+module rec M :
+  (sig val x: X.t end)[@ocaml.warning "-3"] =
+  (struct let x = X.x end)[@ocaml.warning "-3"]
+[%%expect{|
+module rec M : sig val x : X.t end
+|}]
+
+module rec M :
+  (sig val x: X.t end)[@ocaml.warning "-3"] =
+  struct let x = X.x end
+[%%expect{|
+Line 3, characters 17-20:
+3 |   struct let x = X.x end
+                     ^^^
+Alert deprecated: X.x
+module rec M : sig val x : X.t end
+|}]
+
+(* Module type expressions and module type declarations *)
+
+module type S = sig type t = X.t end
+;;
+[%%expect{|
+Line 1, characters 29-32:
+1 | module type S = sig type t = X.t end
+                                 ^^^
+Alert deprecated: X.t
+module type S = sig type t = X.t end
+|}]
+
+module type S = (sig type t = X.t end)[@ocaml.warning "-3"]
+;;
+[%%expect{|
+module type S = sig type t = X.t end
+|}]
+
+module type S = sig type t = X.t end[@@ocaml.warning "-3"]
+;;
+[%%expect{|
+module type S = sig type t = X.t end
+|}]
+
+
+(* Class expressions, class declarations and class fields *)
+
+class c = object method x = X.x end
+;;
+[%%expect{|
+Line 1, characters 28-31:
+1 | class c = object method x = X.x end
+                                ^^^
+Alert deprecated: X.x
+class c : object method x : X.t end
+|}]
+
+class c = object method x = X.x end[@@ocaml.warning "-3"]
+;;
+[%%expect{|
+class c : object method x : X.t end
+|}]
+
+class c = (object method x = X.x end)[@ocaml.warning "-3"]
+;;
+[%%expect{|
+class c : object method x : X.t end
+|}]
+
+class c = object method x = X.x [@@ocaml.warning "-3"] end
+;;
+[%%expect{|
+class c : object method x : X.t end
+|}]
+
+(* Class type expressions, class type declarations
+   and class type fields *)
+
+class type c = object method x : X.t end
+;;
+[%%expect{|
+Line 1, characters 33-36:
+1 | class type c = object method x : X.t end
+                                     ^^^
+Alert deprecated: X.t
+class type c = object method x : X.t end
+|}]
+
+class type c = object method x : X.t end[@@ocaml.warning "-3"]
+;;
+[%%expect{|
+class type c = object method x : X.t end
+|}]
+
+class type c = object method x : X.t end[@ocaml.warning "-3"]
+;;
+[%%expect{|
+class type c = object method x : X.t end
+|}]
+
+class type c = object method x : X.t [@@ocaml.warning "-3"] end
+;;
+[%%expect{|
+class type c = object method x : X.t end
+|}]
+
+
+
+(* External declarations *)
+
+external foo: unit -> X.t = "foo"
+;;
+[%%expect{|
+Line 1, characters 22-25:
+1 | external foo: unit -> X.t = "foo"
+                          ^^^
+Alert deprecated: X.t
+external foo : unit -> X.t = "foo"
+|}]
+
+external foo: unit -> X.t = "foo"[@@ocaml.warning "-3"]
+;;
+[%%expect{|
+external foo : unit -> X.t = "foo"
+|}]
+
+
+(* Eval *)
+;;
+X.x
+;;
+[%%expect{|
+Line 1, characters 0-3:
+1 | X.x
+    ^^^
+Alert deprecated: X.x
+- : X.t = 
+|}]
+
+;;
+X.x [@@ocaml.warning "-3"]
+;;
+[%%expect{|
+- : X.t = 
+|}]
+
+(* Open / include *)
+
+module D = struct end[@@ocaml.deprecated]
+
+open D
+;;
+[%%expect{|
+module D : sig end
+Line 3, characters 5-6:
+3 | open D
+         ^
+Alert deprecated: module D
+|}]
+
+open D [@@ocaml.warning "-3"]
+;;
+[%%expect{|
+|}]
+
+include D
+;;
+[%%expect{|
+Line 1, characters 8-9:
+1 | include D
+            ^
+Alert deprecated: module D
+|}]
+
+include D [@@ocaml.warning "-3"]
+;;
+[%%expect{|
+|}]
+
+
+(* Type extensions *)
+
+type ext = ..
+;;
+[%%expect{|
+type ext = ..
+|}]
+
+type ext +=
+  | A of X.t
+  | B of (X.s [@ocaml.warning "-3"])
+  | C of X.u [@ocaml.warning "-3"]
+;;
+[%%expect{|
+Line 2, characters 9-12:
+2 |   | A of X.t
+             ^^^
+Alert deprecated: X.t
+type ext += A of X.t | B of X.s | C of X.u
+|}]
+
+type ext +=
+  | C of X.t
+  [@@ocaml.warning "-3"]
+;;
+[%%expect{|
+type ext += C of X.t
+|}]
+
+
+exception Foo of X.t
+;;
+[%%expect{|
+Line 1, characters 17-20:
+1 | exception Foo of X.t
+                     ^^^
+Alert deprecated: X.t
+exception Foo of X.t
+|}]
+
+exception Foo of X.t [@ocaml.warning "-3"]
+;;
+[%%expect{|
+exception Foo of X.t
+|}]
+
+
+(* Labels/constructors/fields *)
+
+type t =
+  | A of X.t
+  | B of X.s [@ocaml.warning "-3"]
+  | C of (X.u [@ocaml.warning "-3"])
+;;
+[%%expect{|
+Line 2, characters 9-12:
+2 |   | A of X.t
+             ^^^
+Alert deprecated: X.t
+type t = A of X.t | B of X.s | C of X.u
+|}]
+
+type t =
+  {
+    a: X.t;
+    b: X.s [@ocaml.warning "-3"];
+    c: (X.u [@ocaml.warning "-3"]);
+  }
+;;
+[%%expect{|
+Line 3, characters 7-10:
+3 |     a: X.t;
+           ^^^
+Alert deprecated: X.t
+type t = { a : X.t; b : X.s; c : X.u; }
+|}]
+
+
+type t =
+  <
+    a: X.t;
+    b: X.s [@ocaml.warning "-3"];
+    c: (X.u [@ocaml.warning "-3"]);
+  >
+;;
+[%%expect{|
+Line 3, characters 7-10:
+3 |     a: X.t;
+           ^^^
+Alert deprecated: X.t
+type t = < a : X.t; b : X.s; c : X.u >
+|}]
+
+
+type t =
+  [
+  | `A of X.t
+  | `B of X.s [@ocaml.warning "-3"]
+  | `C of (X.u [@ocaml.warning "-3"])
+  ]
+;;
+[%%expect{|
+Line 3, characters 10-13:
+3 |   | `A of X.t
+              ^^^
+Alert deprecated: X.t
+type t = [ `A of X.t | `B of X.s | `C of X.u ]
+|}]
+
+
+(* Test for ocaml.ppwarning, and its interactions with ocaml.warning *)
+
+
+[@@@ocaml.ppwarning "Pp warning!"]
+;;
+[%%expect{|
+Line 1, characters 20-33:
+1 | [@@@ocaml.ppwarning "Pp warning!"]
+                        ^^^^^^^^^^^^^
+Warning 22: Pp warning!
+|}]
+
+
+let x = () [@ocaml.ppwarning "Pp warning 1!"]
+    [@@ocaml.ppwarning  "Pp warning 2!"]
+;;
+[%%expect{|
+Line 2, characters 24-39:
+2 |     [@@ocaml.ppwarning  "Pp warning 2!"]
+                            ^^^^^^^^^^^^^^^
+Warning 22: Pp warning 2!
+Line 1, characters 29-44:
+1 | let x = () [@ocaml.ppwarning "Pp warning 1!"]
+                                 ^^^^^^^^^^^^^^^
+Warning 22: Pp warning 1!
+val x : unit = ()
+|}]
+
+type t = unit
+    [@ocaml.ppwarning "Pp warning!"]
+;;
+[%%expect{|
+Line 2, characters 22-35:
+2 |     [@ocaml.ppwarning "Pp warning!"]
+                          ^^^^^^^^^^^^^
+Warning 22: Pp warning!
+type t = unit
+|}]
+
+module X = struct
+  [@@@ocaml.warning "-22"]
+
+  [@@@ocaml.ppwarning "Pp warning1!"]
+
+  [@@@ocaml.warning "+22"]
+
+  [@@@ocaml.ppwarning "Pp warning2!"]
+end
+;;
+[%%expect{|
+Line 8, characters 22-36:
+8 |   [@@@ocaml.ppwarning "Pp warning2!"]
+                          ^^^^^^^^^^^^^^
+Warning 22: Pp warning2!
+module X : sig end
+|}]
+
+let x =
+  ((() [@ocaml.ppwarning "Pp warning 1!"]) [@ocaml.warning "-22"])
+    [@ocaml.ppwarning  "Pp warning 2!"]
+;;
+[%%expect{|
+Line 3, characters 23-38:
+3 |     [@ocaml.ppwarning  "Pp warning 2!"]
+                           ^^^^^^^^^^^^^^^
+Warning 22: Pp warning 2!
+val x : unit = ()
+|}]
+
+type t =
+  ((unit [@ocaml.ppwarning "Pp warning 1!"]) [@ocaml.warning "-22"])
+  [@ocaml.ppwarning  "Pp warning 2!"]
+  [@@ocaml.ppwarning "Pp warning 3!"]
+;;
+[%%expect{|
+Line 4, characters 21-36:
+4 |   [@@ocaml.ppwarning "Pp warning 3!"]
+                         ^^^^^^^^^^^^^^^
+Warning 22: Pp warning 3!
+Line 3, characters 21-36:
+3 |   [@ocaml.ppwarning  "Pp warning 2!"]
+                         ^^^^^^^^^^^^^^^
+Warning 22: Pp warning 2!
+type t = unit
+|}]
+
+let ([][@ocaml.ppwarning "XX"]) = []
+;;
+[%%expect{|
+Line 1, characters 25-29:
+1 | let ([][@ocaml.ppwarning "XX"]) = []
+                             ^^^^
+Warning 22: XX
+Line 1, characters 4-31:
+1 | let ([][@ocaml.ppwarning "XX"]) = []
+        ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+_::_
+|}]
+let[@ocaml.warning "-8-22"] ([][@ocaml.ppwarning "XX"]) = []
+;;
+[%%expect{|
+|}]
diff --git a/testsuite/tests/typing-extension-constructor/test.ml b/testsuite/tests/typing-extension-constructor/test.ml
new file mode 100644
index 00000000..d18777c7
--- /dev/null
+++ b/testsuite/tests/typing-extension-constructor/test.ml
@@ -0,0 +1,17 @@
+(* TEST
+   * toplevel
+*)
+
+type t = ..;;
+type t += A;;
+
+[%extension_constructor A];;
+([%extension_constructor A] : extension_constructor);;
+
+module M = struct
+  type extension_constructor = int
+end;;
+
+open M;;
+
+([%extension_constructor A] : extension_constructor);;
diff --git a/testsuite/tests/typing-extension-constructor/test.ocaml.reference b/testsuite/tests/typing-extension-constructor/test.ocaml.reference
new file mode 100644
index 00000000..0fa7595b
--- /dev/null
+++ b/testsuite/tests/typing-extension-constructor/test.ocaml.reference
@@ -0,0 +1,11 @@
+type t = ..
+type t += A
+- : extension_constructor = 
+- : extension_constructor = 
+module M : sig type extension_constructor = int end
+Line 2, characters 1-27:
+2 | ([%extension_constructor A] : extension_constructor);;
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This expression has type extension_constructor
+       but an expression was expected of type M.extension_constructor = int
+
diff --git a/testsuite/tests/typing-extensions/cast.ml b/testsuite/tests/typing-extensions/cast.ml
new file mode 100644
index 00000000..7e155f53
--- /dev/null
+++ b/testsuite/tests/typing-extensions/cast.ml
@@ -0,0 +1,103 @@
+(* TEST
+   * toplevel
+*)
+
+(* Ignore OCAMLRUNPARAM=b to be reproducible *)
+Printexc.record_backtrace false;;
+
+(* By using two types we can have a recursive constraint *)
+type 'a class_name = .. constraint 'a = < cast: 'a. 'a name -> 'a; ..>
+and 'a name =
+  Class : 'a class_name -> (< cast: 'a. 'a name -> 'a; ..> as 'a) name
+;;
+
+exception Bad_cast
+;;
+
+class type castable =
+object
+  method cast: 'a.'a name -> 'a
+end
+;;
+
+(* Lets create a castable class with a name*)
+
+class type foo_t =
+object
+  inherit castable
+  method foo: string
+end
+;;
+
+type 'a class_name += Foo: foo_t class_name
+;;
+
+class foo: foo_t =
+object(self)
+  method cast: type a. a name -> a =
+    function
+        Class Foo -> (self :> foo_t)
+      | _ -> ((raise Bad_cast) : a)
+  method foo = "foo"
+end
+;;
+
+(* Now we can create a subclass of foo *)
+
+class type bar_t =
+object
+  inherit foo
+  method bar: string
+end
+;;
+
+type 'a class_name += Bar: bar_t class_name
+;;
+
+class bar: bar_t =
+object(self)
+  inherit foo as super
+  method cast: type a. a name -> a =
+    function
+        Class Bar -> (self :> bar_t)
+      | other -> super#cast other
+  method bar = "bar"
+end
+;;
+
+(* Now lets create a mutable list of castable objects *)
+
+let clist :castable list ref = ref []
+;;
+
+let push_castable (c: #castable) =
+  clist := (c :> castable) :: !clist
+;;
+
+let pop_castable () =
+  match !clist with
+      c :: rest ->
+        clist := rest;
+        c
+    | [] -> raise Not_found
+;;
+
+(* We can add foos and bars to this list, and retrieve them *)
+
+push_castable (new foo);;
+push_castable (new bar);;
+push_castable (new foo);;
+
+let c1: castable = pop_castable ();;
+let c2: castable = pop_castable ();;
+let c3: castable = pop_castable ();;
+
+(* We can also downcast these values to foos and bars *)
+
+let f1: foo = c1#cast (Class Foo);; (* Ok *)
+let f2: foo = c2#cast (Class Foo);; (* Ok *)
+let f3: foo = c3#cast (Class Foo);; (* Ok *)
+
+let b1: bar = c1#cast (Class Bar);; (* Exception Bad_cast *)
+let b2: bar = c2#cast (Class Bar);; (* Ok *)
+let b3: bar = c3#cast (Class Bar);; (* Exception Bad_cast *)
diff --git a/testsuite/tests/typing-extensions/cast.ocaml.reference b/testsuite/tests/typing-extensions/cast.ocaml.reference
new file mode 100644
index 00000000..8ba5e321
--- /dev/null
+++ b/testsuite/tests/typing-extensions/cast.ocaml.reference
@@ -0,0 +1,33 @@
+- : unit = ()
+type 'b class_name = .. constraint 'b = < cast : 'a. 'a name -> 'a; .. >
+and 'a name =
+    Class : 'a class_name -> (< cast : 'a0. 'a0 name -> 'a0; .. > as 'a) name
+exception Bad_cast
+class type castable = object method cast : 'a name -> 'a end
+class type foo_t = object method cast : 'a name -> 'a method foo : string end
+type 'b class_name += Foo : foo_t class_name
+class foo : foo_t
+class type bar_t =
+  object
+    method bar : string
+    method cast : 'a name -> 'a
+    method foo : string
+  end
+type 'b class_name += Bar : bar_t class_name
+class bar : bar_t
+val clist : castable list ref = {contents = []}
+val push_castable : #castable -> unit = 
+val pop_castable : unit -> castable = 
+- : unit = ()
+- : unit = ()
+- : unit = ()
+val c1 : castable = 
+val c2 : castable = 
+val c3 : castable = 
+val f1 : foo = 
+val f2 : foo = 
+val f3 : foo = 
+Exception: Bad_cast.
+val b2 : bar = 
+Exception: Bad_cast.
+
diff --git a/testsuite/tests/typing-extensions/disambiguation.ml b/testsuite/tests/typing-extensions/disambiguation.ml
new file mode 100644
index 00000000..feae4c71
--- /dev/null
+++ b/testsuite/tests/typing-extensions/disambiguation.ml
@@ -0,0 +1,248 @@
+(* TEST
+   * expect
+*)
+(** Test type-directed disambiguation and spellchecker hints *)
+
+type t = ..
+type t += Alpha | Aleph
+
+module M = struct
+  type w = ..
+  type w += Alpha | Beta ;;
+  type t += Beth
+end;;
+
+module F(X:sig end) = struct type u = .. type t += Gamma type u += Gamme end;;
+module X = struct end;;
+[%%expect {|
+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
+module X : sig end
+|}]
+
+let x: t = Alph;;
+[%%expect {|
+Line 1, characters 11-15:
+1 | let x: t = Alph;;
+               ^^^^
+Error: This variant expression is expected to have type t
+       The constructor Alph does not belong to type t
+Hint: Did you mean Aleph or Alpha?
+|}]
+
+open M;;
+let y : w = Alha;;
+[%%expect {|
+Line 2, characters 12-16:
+2 | let y : w = Alha;;
+                ^^^^
+Error: This variant expression is expected to have type M.w
+       The constructor Alha does not belong to type M.w
+Hint: Did you mean Alpha?
+|}]
+
+let z: t = Bet;;
+[%%expect {|
+Line 1, characters 11-14:
+1 | let z: t = Bet;;
+               ^^^
+Error: This variant expression is expected to have type t
+       The constructor Bet does not belong to type t
+Hint: Did you mean Beth?
+|}]
+
+
+module N = F(X);;
+open N
+let g = (Gamm:t);;
+[%%expect {|
+module N : sig type u = F(X).u = .. type t += Gamma type u += Gamme end
+Line 3, characters 9-13:
+3 | let g = (Gamm:t);;
+             ^^^^
+Error: This variant expression is expected to have type t
+       The constructor Gamm does not belong to type t
+Hint: Did you mean Gamma?
+|}];;
+
+raise Not_Found;;
+[%%expect {|
+Line 1, characters 6-15:
+1 | raise Not_Found;;
+          ^^^^^^^^^
+Error: This variant expression is expected to have type exn
+       The constructor Not_Found does not belong to type exn
+Hint: Did you mean Not_found?
+|}]
+
+(** Aliasing *)
+type r = ..;;
+module M = struct
+  type t = r = ..
+  type s = t = ..
+  module N = struct
+    type u = s = ..
+    type u += Foo
+  end
+end
+open M.N;;
+
+type exn += Foo;;
+
+let x : r = Foo;;
+[%%expect {|
+type r = ..
+module M :
+  sig
+    type t = r = ..
+    type s = t = ..
+    module N : sig type u = s = .. type u += Foo end
+  end
+type exn += Foo
+val x : r = M.N.Foo
+|}]
+
+(** Closed open extensible type support *)
+
+module M : sig
+  type t = private ..
+  type t += Aleph
+end = struct
+  type t = ..
+  type t += Aleph
+end;;
+open M;;
+
+type exn += Aleph ;;
+[%%expect {|
+module M : sig type t = private .. type t += Aleph end
+type exn += Aleph
+|}]
+
+let x : t = Aleph;;
+[%%expect {|
+val x : M.t = M.Aleph
+|}]
+
+module F(X: sig type t = .. end ) = struct type X.t+= Beth end
+module X = struct type t = .. end
+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 X : sig type t = .. end
+module FX : sig type X.t += Beth end
+type exn += Beth
+val x : X.t = 
+|}]
+
+(** Aliasing *)
+
+type x = ..
+type x += Alpha
+module P = struct type p = x end
+
+let x: P.p = Alha;;
+[%%expect {|
+type x = ..
+type x += Alpha
+module P : sig type p = x end
+Line 7, characters 13-17:
+7 | let x: P.p = Alha;;
+                 ^^^^
+Error: This variant expression is expected to have type P.p
+       The constructor Alha does not belong to type x
+Hint: Did you mean Alpha?
+|}]
+
+module M = struct type t = .. type t += T end
+module N = struct type s = M.t end
+let y: N.s = T ;;
+[%%expect {|
+module M : sig type t = .. type t += T end
+module N : sig type s = M.t end
+Line 3, characters 13-14:
+3 | let y: N.s = T ;;
+                 ^
+Error: This variant expression is expected to have type N.s
+       The constructor T does not belong to type M.t
+|}]
+
+(** Pattern matching *)
+type x = ..
+type x += A | B
+type u = A | B
+module M = struct type y = .. type y+= A|B end
+open M
+let f: x -> int = function A -> 1 | B -> 2 | _ -> 0;;
+[%%expect {|
+type x = ..
+type x += A | B
+type u = A | B
+module M : sig type y = .. type y += A | B  end
+val f : x -> int = 
+|}]
+
+(** Local exception *)
+let x =
+  let exception Local in
+  raise Locl;;
+[%%expect {|
+Line 3, characters 8-12:
+3 |   raise Locl;;
+            ^^^^
+Error: This variant expression is expected to have type exn
+       The constructor Locl does not belong to type exn
+Hint: Did you mean Local?
+|}]
+
+let x =
+  let exception Local in
+  let module M = struct type t = .. type t+= Local end in
+  let open M in
+  (Local:exn);;
+[%%expect{|
+val x : exn = Local
+|}
+]
+
+(** Path capture *)
+module M = struct type t = .. type t += T end
+open M
+let f = (=) M.T
+module M = struct type t = .. type t += S end
+open M
+let y = f T ;;
+[%%expect {|
+module M : sig type t = .. type t += T end
+val f : M.t -> bool = 
+module M : sig type t = .. type t += S end
+val y : bool = true
+|}]
+
+(** Amniguity warning *)
+[@@@warning "+41"];;
+type a = Unique
+type t = ..
+type t += Unique
+module M = struct type s = .. type s+= Unique end open M
+type b = Unique
+let x = Unique;;
+[%%expect {|
+type a = Unique
+type t = ..
+type t += Unique
+module M : sig type s = .. type s += Unique end
+type b = Unique
+Line 7, characters 8-14:
+7 | let x = Unique;;
+            ^^^^^^
+Warning 41: Unique belongs to several types: b M.s t a
+The first one was selected. Please disambiguate if this is wrong.
+val x : b = Unique
+|}]
diff --git a/testsuite/tests/typing-extensions/extensions.ml b/testsuite/tests/typing-extensions/extensions.ml
new file mode 100644
index 00000000..0c5dbf55
--- /dev/null
+++ b/testsuite/tests/typing-extensions/extensions.ml
@@ -0,0 +1,766 @@
+(* TEST
+   * expect
+*)
+
+(* Ignore OCAMLRUNPARAM=b to be reproducible *)
+Printexc.record_backtrace false;;
+[%%expect {|
+- : unit = ()
+|}]
+
+type foo = ..
+;;
+[%%expect {|
+type foo = ..
+|}]
+
+type foo +=
+    A
+  | B of int
+;;
+[%%expect {|
+type foo += A | B of int
+|}]
+
+let is_a x =
+  match x with
+    A -> true
+  | _ -> false
+;;
+[%%expect {|
+val is_a : foo -> bool = 
+|}]
+
+(* The type must be open to create extension *)
+
+type foo
+;;
+[%%expect {|
+type foo
+|}]
+
+type foo += A of int
+;;
+[%%expect {|
+Line 1, characters 0-20:
+1 | type foo += A of int
+    ^^^^^^^^^^^^^^^^^^^^
+Error: Type definition foo is not extensible
+|}]
+
+(* The type must be public to create extension *)
+
+type foo = private ..
+;;
+[%%expect {|
+type foo = private ..
+|}]
+
+type foo += A of int
+;;
+[%%expect {|
+Line 1, characters 12-20:
+1 | type foo += A of int
+                ^^^^^^^^
+Error: Cannot extend private type definition foo
+|}]
+
+(* The type parameters must match *)
+
+type 'a foo = ..
+;;
+[%%expect {|
+type 'a foo = ..
+|}]
+
+type ('a, 'b) foo += A of int
+;;
+[%%expect {|
+Line 1, characters 0-29:
+1 | type ('a, 'b) foo += A of int
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This extension does not match the definition of type foo
+       They have different arities.
+|}]
+
+(* In a signature the type can be private *)
+
+module type S =
+sig
+  type foo = private ..
+  type foo += A of float
+end
+;;
+[%%expect {|
+module type S = sig type foo = private .. type foo += A of float end
+|}]
+
+(* But it must still be extensible *)
+
+module type S =
+sig
+  type foo
+  type foo += B of float
+end
+;;
+[%%expect {|
+Line 4, characters 2-24:
+4 |   type foo += B of float
+      ^^^^^^^^^^^^^^^^^^^^^^
+Error: Type definition foo is not extensible
+|}]
+
+(* Signatures can change the grouping of extensions *)
+
+type foo = ..
+;;
+[%%expect {|
+type foo = ..
+|}]
+
+module M = struct
+  type foo +=
+      A of int
+    | B of string
+
+  type foo +=
+      C of int
+    | D of float
+end
+;;
+[%%expect {|
+module M :
+  sig
+    type foo += A of int | B of string
+    type foo += C of int | D of float
+
+  end
+|}]
+
+module type S = sig
+  type foo +=
+      B of string
+    | C of int
+
+  type foo += D of float
+
+  type foo += A of int
+end
+;;
+[%%expect {|
+module type S =
+  sig
+    type foo += B of string | C of int
+    type foo += D of float
+    type foo += A of int
+  end
+|}]
+
+module M_S = (M : S)
+;;
+[%%expect {|
+module M_S : S
+|}]
+
+(* Extensions can be GADTs *)
+
+type 'a foo = ..
+;;
+[%%expect {|
+type 'a foo = ..
+|}]
+
+type _ foo +=
+    A : int -> int foo
+  | B : int foo
+;;
+[%%expect {|
+type _ foo += A : int -> int foo | B : int foo
+|}]
+
+let get_num : type a. a foo -> a -> a option = fun f i1 ->
+    match f with
+        A i2 -> Some (i1 + i2)
+     |  _ -> None
+;;
+[%%expect {|
+val get_num : 'a foo -> 'a -> 'a option = 
+|}]
+
+(* Extensions must obey constraints *)
+
+type 'a foo = .. constraint 'a = [> `Var ]
+;;
+[%%expect {|
+type 'a foo = .. constraint 'a = [> `Var ]
+|}]
+
+type 'a foo += A of 'a
+;;
+[%%expect {|
+type 'a foo += A of 'a
+|}]
+
+let a = A 9
+;;
+[%%expect {|
+Line 1, characters 10-11:
+1 | let a = A 9
+              ^
+Error: This expression has type int but an expression was expected of type
+         [> `Var ]
+|}]
+
+type 'a foo += B : int foo
+;;
+[%%expect {|
+Line 1, characters 19-22:
+1 | type 'a foo += B : int foo
+                       ^^^
+Error: This type int should be an instance of type [> `Var ]
+|}]
+
+(* Signatures can make an extension private *)
+
+type foo = ..
+;;
+[%%expect {|
+type foo = ..
+|}]
+
+module M = struct type foo += A of int end
+;;
+[%%expect {|
+module M : sig type foo += A of int end
+|}]
+
+let a1 = M.A 10
+;;
+[%%expect {|
+val a1 : foo = M.A 10
+|}]
+
+module type S = sig type foo += private A of int end
+;;
+[%%expect {|
+module type S = sig type foo += private A of int end
+|}]
+
+module M_S = (M : S)
+;;
+[%%expect {|
+module M_S : S
+|}]
+
+let is_s x =
+  match x with
+    M_S.A _ -> true
+  | _ -> false
+;;
+[%%expect {|
+val is_s : foo -> bool = 
+|}]
+
+let a2 = M_S.A 20
+;;
+[%%expect {|
+Line 1, characters 9-17:
+1 | let a2 = M_S.A 20
+             ^^^^^^^^
+Error: Cannot use private constructor A to create values of type foo
+|}]
+
+(* Signatures must respect the type of the constructor *)
+
+type ('a, 'b) bar = ..
+[%%expect {|
+type ('a, 'b) bar = ..
+|}]
+
+module M : sig
+  type ('a, 'b) bar += A of int
+end = struct
+  type ('a, 'b) bar += A of float
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type ('a, 'b) bar += A of float
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig type ('a, 'b) bar += A of float end
+       is not included in
+         sig type ('a, 'b) bar += A of int end
+       Extension declarations do not match:
+         type ('a, 'b) bar += A of float
+       is not included in
+         type ('a, 'b) bar += A of int
+       Constructors do not match:
+         A of float
+       is not compatible with:
+         A of int
+       The types are not equal.
+|}]
+
+module M : sig
+  type ('a, 'b) bar += A of 'a
+end = struct
+  type ('a, 'b) bar += A of 'b
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type ('a, 'b) bar += A of 'b
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig type ('a, 'b) bar += A of 'b end
+       is not included in
+         sig type ('a, 'b) bar += A of 'a end
+       Extension declarations do not match:
+         type ('a, 'b) bar += A of 'b
+       is not included in
+         type ('a, 'b) bar += A of 'a
+       Constructors do not match:
+         A of 'b
+       is not compatible with:
+         A of 'a
+       The types are not equal.
+|}]
+
+module M : sig
+  type ('a, 'b) bar = A of 'a
+end = struct
+  type ('b, 'a) bar = A of 'a
+end;;
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type ('b, 'a) bar = A of 'a
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type ('b, 'a) bar = A of 'a end
+       is not included in
+         sig type ('a, 'b) bar = A of 'a end
+       Type declarations do not match:
+         type ('b, 'a) bar = A of 'a
+       is not included in
+         type ('a, 'b) bar = A of 'a
+       Constructors do not match:
+         A of 'a
+       is not compatible with:
+         A of 'a
+       The types are not equal.
+|}];;
+
+
+module M : sig
+  type ('a, 'b) bar += A : 'c -> ('c, 'd) bar
+end = struct
+  type ('a, 'b) bar += A : 'd -> ('c, 'd) bar
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type ('a, 'b) bar += A : 'd -> ('c, 'd) bar
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig type ('a, 'b) bar += A : 'd -> ('c, 'd) bar end
+       is not included in
+         sig type ('a, 'b) bar += A : 'c -> ('c, 'd) bar end
+       Extension declarations do not match:
+         type ('a, 'b) bar += A : 'd -> ('c, 'd) bar
+       is not included in
+         type ('a, 'b) bar += A : 'c -> ('c, 'd) bar
+       Constructors do not match:
+         A : 'd -> ('c, 'd) bar
+       is not compatible with:
+         A : 'c -> ('c, 'd) bar
+       The types are not equal.
+|}]
+
+(* Extensions can be rebound *)
+
+type foo = ..
+;;
+[%%expect {|
+type foo = ..
+|}]
+
+module M = struct type foo += A1 of int end
+;;
+[%%expect {|
+module M : sig type foo += A1 of int end
+|}]
+
+type foo += A2 = M.A1
+;;
+[%%expect {|
+type foo += A2 of int
+|}]
+
+type bar = ..
+;;
+[%%expect {|
+type bar = ..
+|}]
+
+type bar += A3 = M.A1
+;;
+[%%expect {|
+Line 1, characters 17-21:
+1 | type bar += A3 = M.A1
+                     ^^^^
+Error: The constructor M.A1 has type foo but was expected to be of type bar
+|}]
+
+module M = struct type foo += private B1 of int end
+;;
+[%%expect {|
+module M : sig type foo += private B1 of int end
+|}]
+
+type foo += private B2 = M.B1
+;;
+[%%expect {|
+type foo += private B2 of int
+|}]
+
+type foo += B3 = M.B1
+;;
+[%%expect {|
+Line 1, characters 17-21:
+1 | type foo += B3 = M.B1
+                     ^^^^
+Error: The constructor M.B1 is private
+|}]
+
+type foo += C = Unknown
+;;
+[%%expect {|
+Line 1, characters 16-23:
+1 | type foo += C = Unknown
+                    ^^^^^^^
+Error: Unbound constructor Unknown
+|}]
+
+(* Extensions can be rebound even if type is private *)
+
+module M : sig type foo = private .. type foo += A1 of int end
+  = struct type foo = .. type foo += A1 of int end;;
+[%%expect {|
+module M : sig type foo = private .. type foo += A1 of int end
+|}]
+
+type M.foo += A2 = M.A1;;
+[%%expect {|
+type M.foo += A2 of int
+|}]
+
+(* Rebinding handles abbreviations *)
+
+type 'a foo = ..
+;;
+[%%expect {|
+type 'a foo = ..
+|}]
+
+type 'a foo1 = 'a foo = ..
+;;
+[%%expect {|
+type 'a foo1 = 'a foo = ..
+|}]
+
+type 'a foo2 = 'a foo = ..
+;;
+[%%expect {|
+type 'a foo2 = 'a foo = ..
+|}]
+
+type 'a foo1 +=
+    A of int
+  | B of 'a
+  | C : int foo1
+;;
+[%%expect {|
+type 'a foo1 += A of int | B of 'a | C : int foo1
+|}]
+
+type 'a foo2 +=
+    D = A
+  | E = B
+  | F = C
+;;
+[%%expect {|
+type 'a foo2 += D of int | E of 'a | F : int foo2
+|}]
+
+(* Extensions must obey variances *)
+
+type +'a foo = ..
+;;
+[%%expect {|
+type +'a foo = ..
+|}]
+
+type 'a foo += A of (int -> 'a)
+;;
+[%%expect {|
+type 'a foo += A of (int -> 'a)
+|}]
+
+type 'a foo += B of ('a -> int)
+;;
+[%%expect {|
+Line 1, characters 0-31:
+1 | type 'a foo += B of ('a -> int)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, expected parameter variances are not satisfied.
+       The 1st type parameter was expected to be covariant,
+       but it is injective contravariant.
+|}]
+
+type _ foo += C : ('a -> int) -> 'a foo
+;;
+[%%expect {|
+Line 1, characters 0-39:
+1 | type _ foo += C : ('a -> int) -> 'a foo
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, expected parameter variances are not satisfied.
+       The 1st type parameter was expected to be covariant,
+       but it is injective contravariant.
+|}]
+
+type 'a bar = ..
+;;
+[%%expect {|
+type 'a bar = ..
+|}]
+
+type +'a bar += D of (int -> 'a)
+;;
+[%%expect {|
+Line 1, characters 0-32:
+1 | type +'a bar += D of (int -> 'a)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This extension does not match the definition of type bar
+       Their variances do not agree.
+|}]
+
+(* Exceptions are compatible with extensions *)
+
+module M : sig
+  type exn +=
+      Foo of int * float
+    | Bar : 'a list -> exn
+end = struct
+  exception Bar : 'a list -> exn
+  exception Foo of int * float
+end
+;;
+[%%expect {|
+module M : sig type exn += Foo of int * float | Bar : 'a list -> exn  end
+|}]
+
+module M : sig
+  exception Bar : 'a list -> exn
+  exception Foo of int * float
+end = struct
+  type exn +=
+      Foo of int * float
+    | Bar : 'a list -> exn
+end
+;;
+[%%expect {|
+module M :
+  sig exception Bar : 'a list -> exn exception Foo of int * float end
+|}]
+
+exception Foo of int * float
+;;
+[%%expect {|
+exception Foo of int * float
+|}]
+
+exception Bar : 'a list -> exn
+;;
+[%%expect {|
+exception Bar : 'a list -> exn
+|}]
+
+module M : sig
+  type exn +=
+      Foo of int * float
+    | Bar : 'a list -> exn
+end = struct
+  exception Bar = Bar
+  exception Foo = Foo
+end
+;;
+[%%expect {|
+module M : sig type exn += Foo of int * float | Bar : 'a list -> exn  end
+|}]
+
+(* Test toplevel printing *)
+
+type foo = ..
+;;
+[%%expect {|
+type foo = ..
+|}]
+
+type foo +=
+    Foo of int * int option
+  | Bar of int option
+;;
+[%%expect {|
+type foo += Foo of int * int option | Bar of int option
+|}]
+
+let x = Foo(3, Some 4), Bar(Some 5) (* Prints Foo and Bar successfully *)
+;;
+[%%expect {|
+val x : foo * foo = (Foo (3, Some 4), Bar (Some 5))
+|}]
+
+type foo += Foo of string
+;;
+[%%expect {|
+type foo += Foo of string
+|}]
+
+let y = x (* Prints Bar but not Foo (which has been shadowed) *)
+;;
+[%%expect {|
+val y : foo * foo = (, Bar (Some 5))
+|}]
+
+exception Foo of int * int option
+;;
+[%%expect {|
+exception Foo of int * int option
+|}]
+
+exception Bar of int option
+;;
+[%%expect {|
+exception Bar of int option
+|}]
+
+let x = Foo(3, Some 4), Bar(Some 5) (* Prints Foo and Bar successfully *)
+;;
+[%%expect {|
+val x : exn * exn = (Foo (3, Some 4), Bar (Some 5))
+|}]
+
+type foo += Foo of string
+;;
+[%%expect {|
+type foo += Foo of string
+|}]
+
+let y = x (* Prints Bar and part of Foo (which has been shadowed) *)
+;;
+[%%expect {|
+val y : exn * exn = (Foo (3, _), Bar (Some 5))
+|}]
+
+module Empty = struct end
+module F(X:sig end) = struct
+  type t = ..
+  type t += A
+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
+val x : F(Empty).t = 
+|}]
+
+
+(* Test Obj functions *)
+
+type foo = ..
+;;
+[%%expect {|
+type foo = ..
+|}]
+
+type foo +=
+    Foo
+  | Bar of int
+;;
+[%%expect {|
+type foo += Foo | Bar of int
+|}]
+
+let extension_name e = Obj.Extension_constructor.name
+    (Obj.Extension_constructor.of_val e)
+;;
+[%%expect {|
+val extension_name : 'a -> string = 
+|}]
+
+let extension_id e = Obj.Extension_constructor.id
+    (Obj.Extension_constructor.of_val e)
+;;
+[%%expect {|
+val extension_id : 'a -> int = 
+|}]
+
+let n1 = extension_name Foo
+;;
+[%%expect {|
+val n1 : string = "Foo"
+|}]
+
+let n2 = extension_name (Bar 1)
+;;
+[%%expect {|
+val n2 : string = "Bar"
+|}]
+
+let t = (extension_id (Bar 2)) = (extension_id (Bar 3))
+;;
+[%%expect {|
+val t : bool = true
+|}]
+
+let f = (extension_id (Bar 2)) = (extension_id Foo)
+;;
+[%%expect {|
+val f : bool = false
+|}]
+
+let is_foo x = (extension_id Foo) = (extension_id x)
+;;
+[%%expect {|
+val is_foo : 'a -> bool = 
+|}]
+
+type foo += Foo
+;;
+[%%expect {|
+type foo += Foo
+|}]
+
+let f = is_foo Foo
+;;
+[%%expect {|
+val f : bool = false
+|}]
+
+let _ = Obj.Extension_constructor.of_val 7
+;;
+[%%expect {|
+Exception: Invalid_argument "Obj.extension_constructor".
+|}]
+
+let _ = Obj.Extension_constructor.of_val (object method m = 3 end)
+;;
+[%%expect {|
+Exception: Invalid_argument "Obj.extension_constructor".
+|}]
diff --git a/testsuite/tests/typing-extensions/msg.ml b/testsuite/tests/typing-extensions/msg.ml
new file mode 100644
index 00000000..07cdba65
--- /dev/null
+++ b/testsuite/tests/typing-extensions/msg.ml
@@ -0,0 +1,135 @@
+(* TEST
+   * toplevel
+*)
+
+(* Typed names *)
+
+module Msg : sig
+
+  type 'a tag = private ..
+
+  type result = Result : 'a tag * 'a -> result
+
+  val write : 'a tag -> 'a -> unit
+
+  val read : unit -> result
+
+  type 'a tag += Int : int tag
+
+  module type Desc = sig
+    type t
+    val label : string
+    val write : t -> string
+    val read : string -> t
+  end
+
+  module Define (D : Desc) : sig
+    type 'a tag += C : D.t tag
+  end
+
+end = struct
+
+  type 'a tag = ..
+
+  type ktag = T : 'a tag -> ktag
+
+  type 'a kind =
+  { tag : 'a tag;
+    label : string;
+    write : 'a -> string;
+    read : string -> 'a; }
+
+  type rkind = K : 'a kind -> rkind
+
+  type wkind = { f : 'a . 'a tag -> 'a kind }
+
+  let readTbl : (string, rkind) Hashtbl.t = Hashtbl.create 13
+
+  let writeTbl : (ktag, wkind) Hashtbl.t = Hashtbl.create 13
+
+  let read_raw () : string * string = raise (Failure "Not implemented")
+
+  type result = Result : 'a tag * 'a -> result
+
+  let read () =
+    let label, content = read_raw () in
+      let K k = Hashtbl.find readTbl label in
+        let body = k.read content in
+          Result(k.tag, body)
+
+  let write_raw (label : string) (content : string) =
+    raise (Failure "Not implemented")
+
+  let write (tag : 'a tag) (body : 'a) =
+    let {f} = Hashtbl.find writeTbl (T tag) in
+    let k = f tag in
+    let content = k.write body in
+      write_raw k.label content
+
+  (* Add int kind *)
+
+  type 'a tag += Int : int tag
+
+  let ik =
+    { tag = Int;
+      label = "int";
+      write = Int.to_string;
+      read = int_of_string }
+
+  let () = Hashtbl.add readTbl "int" (K ik)
+
+  let () =
+    let f (type t) (i : t tag) : t kind =
+      match i with
+        Int -> ik
+      | _ -> assert false
+    in
+      Hashtbl.add writeTbl (T Int) {f}
+
+  (* Support user defined kinds *)
+
+  module type Desc = sig
+    type t
+    val label : string
+    val write : t -> string
+    val read : string -> t
+  end
+
+  module Define (D : Desc) = struct
+    type 'a tag += C : D.t tag
+    let k =
+      { tag = C;
+        label = D.label;
+        write = D.write;
+        read = D.read }
+    let () = Hashtbl.add readTbl D.label (K k)
+    let () =
+      let f (type t) (c : t tag) : t kind =
+        match c with
+          C -> k
+        | _ -> assert false
+      in
+        Hashtbl.add writeTbl (T C) {f}
+  end
+
+end;;
+
+let write_int i = Msg.write Msg.Int i;;
+
+module StrM = Msg.Define(struct
+  type t = string
+  let label = "string"
+  let read s = s
+  let write s = s
+end);;
+
+type 'a Msg.tag += String = StrM.C;;
+
+let write_string s = Msg.write String s;;
+
+let read_one () =
+  let Msg.Result(tag, body) = Msg.read () in
+  match tag with
+    Msg.Int -> print_int body
+  | String -> print_string body
+  | _ -> print_string "Unknown";;
diff --git a/testsuite/tests/typing-extensions/msg.ocaml.reference b/testsuite/tests/typing-extensions/msg.ocaml.reference
new file mode 100644
index 00000000..c5ed56b3
--- /dev/null
+++ b/testsuite/tests/typing-extensions/msg.ocaml.reference
@@ -0,0 +1,22 @@
+module Msg :
+  sig
+    type 'a tag = private ..
+    type result = Result : 'a tag * 'a -> result
+    val write : 'a tag -> 'a -> unit
+    val read : unit -> result
+    type 'a tag += Int : int tag
+    module type Desc =
+      sig
+        type t
+        val label : string
+        val write : t -> string
+        val read : string -> t
+      end
+    module Define : functor (D : Desc) -> sig type 'a tag += C : D.t tag end
+  end
+val write_int : int -> unit = 
+module StrM : sig type 'a Msg.tag += C : string Msg.tag end
+type 'a Msg.tag += String : string Msg.tag
+val write_string : string -> unit = 
+val read_one : unit -> unit = 
+
diff --git a/testsuite/tests/typing-extensions/open_types.ml b/testsuite/tests/typing-extensions/open_types.ml
new file mode 100644
index 00000000..dd5ed138
--- /dev/null
+++ b/testsuite/tests/typing-extensions/open_types.ml
@@ -0,0 +1,359 @@
+(* TEST
+   * expect
+*)
+
+type foo = ..
+;;
+[%%expect {|
+type foo = ..
+|}]
+
+(* Check that abbreviations work *)
+
+type bar = foo = ..
+;;
+[%%expect {|
+type bar = foo = ..
+|}]
+
+type baz = foo = ..
+;;
+[%%expect {|
+type baz = foo = ..
+|}]
+
+type bar += Bar1 of int
+;;
+[%%expect {|
+type bar += Bar1 of int
+|}]
+
+type baz += Bar2 of int
+;;
+[%%expect {|
+type baz += Bar2 of int
+|}]
+
+module M = struct type bar += Foo of float end
+;;
+[%%expect {|
+module M : sig type bar += Foo of float end
+|}]
+
+module type S = sig type baz += Foo of float end
+;;
+[%%expect {|
+module type S = sig type baz += Foo of float end
+|}]
+
+module M_S = (M : S)
+;;
+[%%expect {|
+module M_S : S
+|}]
+
+(* Abbreviations need to be made open *)
+
+type foo = ..
+;;
+[%%expect {|
+type foo = ..
+|}]
+
+type bar = foo
+;;
+[%%expect {|
+type bar = foo
+|}]
+
+type bar += Bar of int
+;;
+[%%expect {|
+Line 1, characters 0-22:
+1 | type bar += Bar of int
+    ^^^^^^^^^^^^^^^^^^^^^^
+Error: Type definition bar is not extensible
+|}]
+
+type baz = bar = ..
+;;
+[%%expect {|
+Line 1, characters 0-19:
+1 | type baz = bar = ..
+    ^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type bar
+       Their kinds differ.
+|}]
+
+(* Abbreviations need to match parameters *)
+
+type 'a foo = ..
+;;
+[%%expect {|
+type 'a foo = ..
+|}]
+
+type ('a, 'b) bar = 'a foo = ..
+;;
+[%%expect {|
+Line 1, characters 0-31:
+1 | type ('a, 'b) bar = 'a foo = ..
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type 'a foo
+       They have different arities.
+|}]
+
+type ('a, 'b) foo = ..
+;;
+[%%expect {|
+type ('a, 'b) foo = ..
+|}]
+
+type ('a, 'b) bar = ('a, 'a) foo = ..
+;;
+[%%expect {|
+Line 1, characters 0-37:
+1 | type ('a, 'b) bar = ('a, 'a) foo = ..
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type
+         ('a, 'a) foo
+       Their constraints differ.
+|}]
+
+(* Check that signatures can hide exstensibility *)
+
+module M = struct type foo = .. end
+;;
+[%%expect {|
+module M : sig type foo = .. end
+|}]
+
+module type S = sig type foo end
+;;
+[%%expect {|
+module type S = sig type foo end
+|}]
+
+module M_S = (M : S)
+;;
+[%%expect {|
+module M_S : S
+|}]
+
+type M_S.foo += Foo
+;;
+[%%expect {|
+Line 1, characters 0-19:
+1 | type M_S.foo += Foo
+    ^^^^^^^^^^^^^^^^^^^
+Error: Type definition M_S.foo is not extensible
+|}]
+
+(* Check that signatures cannot add extensibility *)
+
+module M = struct type foo end
+;;
+[%%expect {|
+module M : sig type foo end
+|}]
+
+module type S = sig type foo = .. end
+;;
+[%%expect {|
+module type S = sig type foo = .. end
+|}]
+
+module M_S = (M : S)
+;;
+[%%expect {|
+Line 1, characters 14-15:
+1 | module M_S = (M : S)
+                  ^
+Error: Signature mismatch:
+       Modules do not match: sig type foo = M.foo end is not included in S
+       Type declarations do not match:
+         type foo = M.foo
+       is not included in
+         type foo = ..
+       Their kinds differ.
+|}]
+
+(* Check that signatures can make exstensibility private *)
+
+module M = struct type foo = .. end
+;;
+[%%expect {|
+module M : sig type foo = .. end
+|}]
+
+module type S = sig type foo = private .. end
+;;
+[%%expect {|
+module type S = sig type foo = private .. end
+|}]
+
+module M_S = (M : S)
+;;
+[%%expect {|
+module M_S : S
+|}]
+
+type M_S.foo += Foo
+;;
+[%%expect {|
+Line 1, characters 16-19:
+1 | type M_S.foo += Foo
+                    ^^^
+Error: Cannot extend private type definition M_S.foo
+|}]
+
+(* Check that signatures cannot make private extensibility public *)
+
+module M = struct type foo = private .. end
+;;
+[%%expect {|
+module M : sig type foo = private .. end
+|}]
+
+module type S = sig type foo = .. end
+;;
+[%%expect {|
+module type S = sig type foo = .. end
+|}]
+
+module M_S = (M : S)
+;;
+[%%expect {|
+Line 1, characters 14-15:
+1 | module M_S = (M : S)
+                  ^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type foo = M.foo = private .. end
+       is not included in
+         S
+       Type declarations do not match:
+         type foo = M.foo = private ..
+       is not included in
+         type foo = ..
+       A private type would be revealed.
+|}]
+
+
+(* Check that signatures maintain variances *)
+
+module M = struct type +'a foo = .. type 'a bar = 'a foo = .. end
+;;
+[%%expect {|
+module M : sig type +'a foo = .. type 'a bar = 'a foo = .. end
+|}]
+
+module type S = sig type 'a foo = .. type 'a bar = 'a foo = .. end
+;;
+[%%expect {|
+module type S = sig type 'a foo = .. type 'a bar = 'a foo = .. end
+|}]
+
+module M_S = (M : S)
+;;
+[%%expect {|
+Line 1, characters 14-15:
+1 | module M_S = (M : S)
+                  ^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type 'a foo = 'a M.foo = .. type 'a bar = 'a foo = .. end
+       is not included in
+         S
+       Type declarations do not match:
+         type 'a foo = 'a M.foo = ..
+       is not included in
+         type 'a foo = ..
+       Their variances do not agree.
+|}]
+
+(* Exn is an open type *)
+
+type exn2 = exn = ..
+;;
+[%%expect {|
+type exn2 = exn = ..
+|}]
+
+(* PR#8579 exceptions can be private *)
+
+type exn += private Foobar
+let _ = raise Foobar
+;;
+[%%expect {|
+type exn += private Foobar
+Line 2, characters 14-20:
+2 | let _ = raise Foobar
+                  ^^^^^^
+Error: Cannot use private constructor Foobar to create values of type exn
+|}]
+
+
+(* Exhaustiveness *)
+
+type foo = ..
+type foo += Foo
+let f = function Foo -> ()
+;;
+[%%expect {|
+type foo = ..
+type foo += Foo
+Line 3, characters 8-26:
+3 | let f = function Foo -> ()
+            ^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+*extension*
+Matching over values of extensible variant types (the *extension* above)
+must include a wild card pattern in order to be exhaustive.
+val f : foo -> unit = 
+|}]
+
+(* More complex exhaustiveness *)
+
+let f = function
+  | [Foo] -> 1
+  | _::_::_ -> 3
+  | [] -> 2
+;;
+[%%expect {|
+Lines 1-4, characters 8-11:
+1 | ........function
+2 |   | [Foo] -> 1
+3 |   | _::_::_ -> 3
+4 |   | [] -> 2
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+*extension*::[]
+Matching over values of extensible variant types (the *extension* above)
+must include a wild card pattern in order to be exhaustive.
+val f : foo list -> int = 
+|}]
+
+
+(* PR#7330: exhaustiveness with GADTs *)
+
+type t = ..
+type t += IPair : (int * int) -> t ;;
+[%%expect {|
+type t = ..
+type t += IPair : (int * int) -> t
+|}]
+
+let f = function IPair (i, j) -> Format.sprintf "(%d, %d)" i j ;;
+[%%expect {|
+Line 1, characters 8-62:
+1 | let f = function IPair (i, j) -> Format.sprintf "(%d, %d)" i j ;;
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+*extension*
+Matching over values of extensible variant types (the *extension* above)
+must include a wild card pattern in order to be exhaustive.
+val f : t -> string = 
+|}]
diff --git a/testsuite/tests/typing-fstclassmod/fstclassmod.ml b/testsuite/tests/typing-fstclassmod/fstclassmod.ml
new file mode 100644
index 00000000..9be53992
--- /dev/null
+++ b/testsuite/tests/typing-fstclassmod/fstclassmod.ml
@@ -0,0 +1,171 @@
+(* TEST
+   flags = "-w A -warn-error A"
+*)
+
+(* Example of algorithm parametrized with modules *)
+
+let sort (type s) set l =
+  let module Set = (val set : Set.S with type elt = s) in
+  Set.elements (List.fold_right Set.add l Set.empty)
+
+let make_set (type s) cmp =
+  let module S = Set.Make(struct
+    type t = s
+    let compare = cmp
+  end) in
+  (module S : Set.S with type elt = s)
+
+let both l =
+  List.map
+    (fun set -> sort set l)
+    [ make_set compare; make_set (fun x y -> compare y x) ]
+
+let () =
+  print_endline (String.concat "  " (List.map (String.concat "/")
+                                              (both ["abc";"xyz";"def"])))
+
+
+(* Hiding the internal representation *)
+
+module type S = sig
+  type t
+  val to_string: t -> string
+  val apply: t -> t
+  val x: t
+end
+
+let create (type s) to_string apply x =
+  let module M = struct
+    type t = s
+    let to_string = to_string
+    let apply = apply
+    let x = x
+  end in
+  (module M : S with type t = s)
+
+let forget (type s) x =
+  let module M = (val x : S with type t = s) in
+  (module M : S)
+
+let print x =
+  let module M = (val x : S) in
+  print_endline (M.to_string M.x)
+
+let apply x =
+  let module M = (val x : S) in
+  let module N = struct
+    include M
+    let x = apply x
+  end in
+  (module N : S)
+
+let () =
+  let int = forget (create Int.to_string succ 0) in
+  let str = forget (create (fun s -> s) (fun s -> s ^ s) "X") in
+  List.iter print (List.map apply [int; apply int; apply (apply str)])
+
+
+(* Existential types + type equality witnesses -> pseudo GADT *)
+
+module TypEq : sig
+  type ('a, 'b) t
+  val apply: ('a, 'b) t -> 'a -> 'b
+  val refl: ('a, 'a) t
+  val sym: ('a, 'b) t -> ('b, 'a) t
+end = struct
+  type ('a, 'b) t = unit
+  let apply _ = Obj.magic
+  let refl = ()
+  let sym () = ()
+end
+
+
+module rec Typ : sig
+  module type PAIR = sig
+    type t
+    type t1
+    type t2
+    val eq: (t, t1 * t2) TypEq.t
+    val t1: t1 Typ.typ
+    val t2: t2 Typ.typ
+  end
+
+  type 'a typ =
+    | Int of ('a, int) TypEq.t
+    | String of ('a, string) TypEq.t
+    | Pair of (module PAIR with type t = 'a)
+end = struct
+  module type PAIR = sig
+    type t
+    type t1
+    type t2
+    val eq: (t, t1 * t2) TypEq.t
+    val t1: t1 Typ.typ
+    val t2: t2 Typ.typ
+  end
+
+  type 'a typ =
+    | Int of ('a, int) TypEq.t
+    | String of ('a, string) TypEq.t
+    | Pair of (module PAIR with type t = 'a)
+end
+
+open Typ
+
+let int = Int TypEq.refl
+
+let str = String TypEq.refl
+
+let pair (type s1) (type s2) t1 t2 =
+  let module P = struct
+    type t = s1 * s2
+    type t1 = s1
+    type t2 = s2
+    let eq = TypEq.refl
+    let t1 = t1
+    let t2 = t2
+  end in
+  let pair = (module P : PAIR with type t = s1 * s2) in
+  Pair pair
+
+module rec Print : sig
+  val to_string: 'a Typ.typ -> 'a -> string
+end = struct
+  let to_string (type s) t x =
+    match t with
+    | Int eq -> Int.to_string (TypEq.apply eq x)
+    | String eq -> Printf.sprintf "%S" (TypEq.apply eq x)
+    | Pair p ->
+        let module P = (val p : PAIR with type t = s) in
+        let (x1, x2) = TypEq.apply P.eq x in
+        Printf.sprintf "(%s,%s)" (Print.to_string P.t1 x1)
+                       (Print.to_string P.t2 x2)
+end
+
+let () =
+  print_endline (Print.to_string int 10);
+  print_endline (Print.to_string (pair int (pair str int)) (123, ("A", 456)))
+
+
+(* #6262: first-class modules and module type aliases *)
+
+module type S1 = sig end
+module type S2 = S1
+
+let _f (x : (module S1)) : (module S2) = x
+
+module X = struct
+  module type S
+end
+module Y = struct include X end
+
+let _f (x : (module X.S)) : (module Y.S) = x
+
+(* PR#6194, main example *)
+module type S3 = sig val x : bool end;;
+let f = function
+  | Some (module M : S3) when M.x ->1
+  | Some _ -> 2
+  | None -> 3
+;;
+print_endline (Int.to_string (f (Some (module struct let x = false end))));;
diff --git a/testsuite/tests/typing-fstclassmod/fstclassmod.reference b/testsuite/tests/typing-fstclassmod/fstclassmod.reference
new file mode 100644
index 00000000..ec517d78
--- /dev/null
+++ b/testsuite/tests/typing-fstclassmod/fstclassmod.reference
@@ -0,0 +1,7 @@
+abc/def/xyz  xyz/def/abc
+1
+2
+XXXXXXXX
+10
+(123,("A",456))
+2
diff --git a/testsuite/tests/typing-gadts/ambiguity.ml b/testsuite/tests/typing-gadts/ambiguity.ml
new file mode 100644
index 00000000..d43f3384
--- /dev/null
+++ b/testsuite/tests/typing-gadts/ambiguity.ml
@@ -0,0 +1,267 @@
+(* TEST
+   * expect
+*)
+
+[@@@warning "-8-11-12"] (* reduce the noise. *)
+
+type ('a, 'b) eq = Refl : ('a, 'a) eq;;
+[%%expect{|
+type ('a, 'b) eq = Refl : ('a, 'a) eq
+|}];;
+
+let ret_e1 (type a b) (b : bool) (wit : (a, b) eq) (x : a) (y : b) =
+  match wit with
+  | Refl -> if b then x else y
+  | _ -> x
+;;
+[%%expect{|
+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
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+let ret_e2 (type a b) (b : bool) (wit : (a, b) eq) (x : a) (y : b) =
+  match wit with
+  | Refl -> if b then x else y
+  | _ -> y
+;;
+[%%expect{|
+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
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+let ret_ei1 (type a) (b : bool) (wit : (a, int) eq) (x : a) =
+  match wit with
+  | Refl -> if b then x else 0
+  | _ -> x
+;;
+[%%expect{|
+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
+         a = int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+let ret_ei2 (type a) (b : bool) (wit : (a, int) eq) (x : a) =
+  match wit with
+  | Refl -> if b then x else 0
+  | _ -> x
+;;
+[%%expect{|
+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
+         a = int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+
+let ret_f (type a b) (wit : (a, b) eq) (x : a) (y : b) =
+  match wit with
+  | Refl -> [x; y]
+  | _ -> [x]
+;;
+[%%expect{|
+Line 3, characters 16-17:
+3 |   | Refl -> [x; y]
+                    ^
+Error: This expression 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
+|}]
+
+let ret_g1 (type a b) (wit : (a, b) eq) (x : a) (y : b) =
+  match wit with
+  | Refl -> [x; y]
+  | _ -> [y]
+;;
+[%%expect{|
+Line 3, characters 16-17:
+3 |   | Refl -> [x; y]
+                    ^
+Error: This expression 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
+|}]
+
+(* First reported in MPR#7617: the typechecker arbitrarily picks a
+   representative for an ambivalent type escaping its scope.
+   The commit that was implemented poses problems of its own: we are now
+   unifying the type of the patterns in the environment of each pattern, instead
+   of the outer one. The code discussed in PR#7617 passes because each branch
+   contains the same equation, but consider the following cases: *)
+
+let f (type a b) (x : (a, b) eq) =
+  match x, [] with
+  | Refl, [(_ : a) | (_ : b)] -> []
+  | _, [(_ : a)] -> []
+;;
+[%%expect{|
+Line 3, characters 4-29:
+3 |   | Refl, [(_ : a) | (_ : b)] -> []
+        ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type (a, b) eq * b list
+       This instance of b is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+let g1 (type a b) (x : (a, b) eq) =
+  match x, [] with
+  | Refl, [(_ : a) | (_ : b)] -> []
+  | _, [(_ : b)] -> []
+;;
+[%%expect{|
+Line 3, characters 4-29:
+3 |   | Refl, [(_ : a) | (_ : b)] -> []
+        ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type (a, b) eq * b list
+       This instance of b is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+let g2 (type a b) (x : (a, b) eq) =
+  match x, [] with
+  | Refl, [(_ : b) | (_ : a)] -> []
+  | _, [(_ : a)] -> []
+;;
+[%%expect{|
+Line 3, characters 4-29:
+3 |   | Refl, [(_ : b) | (_ : a)] -> []
+        ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type (a, b) eq * b list
+       This instance of b is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+let h1 (type a b) (x : (a, b) eq) =
+  match x, [] with
+  | _, [(_ : a)] -> []
+  | Refl, [(_ : a) | (_ : b)] -> []
+;;
+[%%expect{|
+Line 4, characters 4-29:
+4 |   | Refl, [(_ : a) | (_ : b)] -> []
+        ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type (a, b) eq * b list
+       This instance of b is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+let h2 (type a b) (x : (a, b) eq) =
+  match x, [] with
+  | _, [(_ : b)] -> []
+  | Refl, [(_ : a) | (_ : b)] -> []
+;;
+[%%expect{|
+Line 4, characters 4-29:
+4 |   | Refl, [(_ : a) | (_ : b)] -> []
+        ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type (a, b) eq * b list
+       This instance of b is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+let h3 (type a b) (x : (a, b) eq) =
+  match x, [] with
+  | _, [(_ : a)] -> []
+  | Refl, [(_ : b) | (_ : a)] -> []
+;;
+[%%expect{|
+Line 4, characters 4-29:
+4 |   | Refl, [(_ : b) | (_ : a)] -> []
+        ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type (a, b) eq * b list
+       This instance of b is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+module T : sig
+  type t
+  type u
+  val eq : (t, u) eq
+end = struct
+  type t = int
+  type u = int
+  let eq = Refl
+end;;
+[%%expect{|
+module T : sig type t type u val eq : (t, u) eq end
+|}]
+
+module M = struct
+  let r = ref []
+end
+
+let foo p (e : (T.t, T.u) eq) (x : T.t) (y : T.u) =
+  match e with
+  | Refl ->
+    let z = if p then x else y in
+    let module N = struct
+      module type S = module type of struct let r = ref [z] end
+    end in
+    let module O : N.S = M in
+    ()
+
+module type S = module type of M ;;
+[%%expect{|
+module M : sig val r : '_weak1 list ref end
+Line 12, characters 25-26:
+12 |     let module O : N.S = M in
+                              ^
+Error: Signature mismatch:
+       Modules do not match:
+         sig val r : '_weak1 list ref end
+       is not included in
+         N.S
+       Values do not match:
+         val r : '_weak1 list ref
+       is not included in
+         val r : T.u list ref
+|}]
+
+module M = struct
+  let r = ref []
+end
+
+let foo p (e : (T.u, T.t) eq) (x : T.t) (y : T.u) =
+  match e with
+  | Refl ->
+    let z = if p then x else y in
+    let module N = struct
+      module type S = module type of struct let r = ref [z] end
+    end in
+    let module O : N.S = M in
+    ()
+
+module type S = module type of M ;;
+[%%expect{|
+module M : sig val r : '_weak2 list ref end
+Line 12, characters 25-26:
+12 |     let module O : N.S = M in
+                              ^
+Error: Signature mismatch:
+       Modules do not match:
+         sig val r : '_weak2 list ref end
+       is not included in
+         N.S
+       Values do not match:
+         val r : '_weak2 list ref
+       is not included in
+         val r : T.t list ref
+|}]
diff --git a/testsuite/tests/typing-gadts/didier.ml b/testsuite/tests/typing-gadts/didier.ml
new file mode 100644
index 00000000..7c13cb4f
--- /dev/null
+++ b/testsuite/tests/typing-gadts/didier.ml
@@ -0,0 +1,115 @@
+(* TEST
+   * expect
+*)
+
+type 'a ty =
+  | Int : int ty
+  | Bool : bool ty
+
+let fbool (type t) (x : t) (tag : t ty) =
+  match tag with
+  | Bool -> x
+;;
+[%%expect{|
+type 'a ty = Int : int ty | Bool : bool ty
+Lines 6-7, characters 2-13:
+6 | ..match tag with
+7 |   | Bool -> x
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Int
+val fbool : 't -> 't ty -> 't = 
+|}];;
+(* val fbool : 'a -> 'a ty -> 'a =  *)
+(** OK: the return value is x of type t **)
+
+let fint (type t) (x : t) (tag : t ty) =
+  match tag with
+  | Int -> x > 0
+;;
+[%%expect{|
+Lines 2-3, characters 2-16:
+2 | ..match tag with
+3 |   | Int -> x > 0
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Bool
+val fint : 't -> 't ty -> bool = 
+|}];;
+(* val fint : 'a -> 'a ty -> bool =  *)
+(** OK: the return value is x > 0 of type bool;
+This has used the equation t = bool, not visible in the return type **)
+
+(* not principal *)
+let f (type t) (x : t) (tag : t ty) =
+  match tag with
+  | Int -> x > 0
+  | Bool -> x
+;;
+[%%expect{|
+val f : 't -> 't ty -> bool = 
+|}, Principal{|
+Line 4, characters 12-13:
+4 |   | Bool -> x
+                ^
+Error: This expression has type t but an expression was expected of type bool
+|}];;
+(* val f : 'a -> 'a ty -> bool =  *)
+
+(* fail for both *)
+let g (type t) (x : t) (tag : t ty) =
+  match tag with
+  | Bool -> x
+  | Int -> x > 0
+;;
+[%%expect{|
+Line 4, characters 11-16:
+4 |   | Int -> x > 0
+               ^^^^^
+Error: This expression has type bool but an expression was expected of type
+         t = int
+|}, Principal{|
+Line 4, characters 11-16:
+4 |   | Int -> x > 0
+               ^^^^^
+Error: This expression has type bool but an expression was expected of type t
+|}];;
+(* Error: This expression has type bool but an expression was expected of type
+t = int *)
+
+(* OK *)
+let g (type t) (x : t) (tag : t ty) : bool =
+  match tag with
+  | Bool -> x
+  | Int -> x > 0
+;;
+[%%expect{|
+val g : 't -> 't ty -> bool = 
+|}];;
+
+let id x = x;;
+let idb1 = (fun id -> let _ = id true in id) id;;
+let idb2 : bool -> bool = id;;
+let idb3 ( _ : bool ) = false;;
+
+let g (type t) (x : t) (tag : t ty) =
+  match tag with
+  | Bool -> idb3 x
+  | Int -> x > 0
+;;
+[%%expect{|
+val id : 'a -> 'a = 
+val idb1 : bool -> bool = 
+val idb2 : bool -> bool = 
+val idb3 : bool -> bool = 
+val g : 't -> 't ty -> bool = 
+|}];;
+
+let g (type t) (x : t) (tag : t ty) =
+  match tag with
+  | Bool -> idb2 x
+  | Int -> x > 0
+;;
+[%%expect{|
+val g : 't -> 't ty -> bool = 
+|}];;
diff --git a/testsuite/tests/typing-gadts/dynamic_frisch.ml b/testsuite/tests/typing-gadts/dynamic_frisch.ml
new file mode 100644
index 00000000..8bef4074
--- /dev/null
+++ b/testsuite/tests/typing-gadts/dynamic_frisch.ml
@@ -0,0 +1,715 @@
+(* TEST
+   * expect
+*)
+
+(* Encoding generics using GADTs *)
+(* (c) Alain Frisch / Lexifi *)
+(* cf. http://www.lexifi.com/blog/dynamic-types *)
+
+(* Basic tag *)
+
+type 'a ty =
+  | Int: int ty
+  | String: string ty
+  | List: 'a ty -> 'a list ty
+  | Pair: ('a ty * 'b ty) -> ('a * 'b) ty
+;;
+
+(* Tagging data *)
+
+type variant =
+  | VInt of int
+  | VString of string
+  | VList of variant list
+  | VPair of variant * variant
+;;
+
+let rec variantize: type t. t ty -> t -> variant =
+  fun ty x ->
+    (* type t is abstract here *)
+    match ty with
+    | Int -> VInt x  (* in this branch: t = int *)
+    | String -> VString x (* t = string *)
+    | List ty1 ->
+        VList (List.map (variantize ty1) x)
+        (* t = 'a list for some 'a *)
+    | Pair (ty1, ty2) ->
+        VPair (variantize ty1 (fst x), variantize ty2 (snd x))
+        (* t = ('a, 'b) for some 'a and 'b *)
+;;
+[%%expect{|
+type 'a ty =
+    Int : int ty
+  | String : string ty
+  | List : 'a ty -> 'a list ty
+  | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
+type variant =
+    VInt of int
+  | VString of string
+  | VList of variant list
+  | VPair of variant * variant
+val variantize : 't ty -> 't -> variant = 
+|}];;
+
+exception VariantMismatch
+;;
+
+let rec devariantize: type t. t ty -> variant -> t =
+  fun ty v ->
+    match ty, v with
+    | Int, VInt x -> x
+    | String, VString x -> x
+    | List ty1, VList vl ->
+        List.map (devariantize ty1) vl
+    | Pair (ty1, ty2), VPair (x1, x2) ->
+        (devariantize ty1 x1, devariantize ty2 x2)
+    | _ -> raise VariantMismatch
+;;
+[%%expect{|
+exception VariantMismatch
+val devariantize : 't ty -> variant -> 't = 
+|}];;
+
+(* Handling records *)
+
+type 'a ty =
+  | Int: int ty
+  | String: string ty
+  | List: 'a ty -> 'a list ty
+  | Pair: ('a ty * 'b ty) -> ('a * 'b) ty
+  | Record: 'a record -> 'a ty
+
+and 'a record =
+    {
+     path: string;
+     fields: 'a field_ list;
+    }
+
+and 'a field_ =
+  | Field: ('a, 'b) field -> 'a field_
+
+and ('a, 'b) field =
+    {
+     label: string;
+     field_type: 'b ty;
+     get: ('a -> 'b);
+    }
+;;
+
+(* Again *)
+
+type variant =
+  | VInt of int
+  | VString of string
+  | VList of variant list
+  | VPair of variant * variant
+  | VRecord of (string * variant) list
+;;
+
+let rec variantize: type t. t ty -> t -> variant =
+  fun ty x ->
+    (* type t is abstract here *)
+    match ty with
+    | Int -> VInt x  (* in this branch: t = int *)
+    | String -> VString x (* t = string *)
+    | List ty1 ->
+        VList (List.map (variantize ty1) x)
+        (* t = 'a list for some 'a *)
+    | Pair (ty1, ty2) ->
+        VPair (variantize ty1 (fst x), variantize ty2 (snd x))
+        (* t = ('a, 'b) for some 'a and 'b *)
+    | Record {fields} ->
+        VRecord
+          (List.map (fun (Field{field_type; label; get}) ->
+                       (label, variantize field_type (get x))) fields)
+;;
+[%%expect{|
+type 'a ty =
+    Int : int ty
+  | String : string ty
+  | List : 'a ty -> 'a list ty
+  | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
+  | Record : 'a record -> 'a ty
+and 'a record = { path : string; fields : 'a field_ list; }
+and 'a field_ = Field : ('a, 'b) field -> 'a field_
+and ('a, 'b) field = { label : string; field_type : 'b ty; get : 'a -> 'b; }
+type variant =
+    VInt of int
+  | VString of string
+  | VList of variant list
+  | VPair of variant * variant
+  | VRecord of (string * variant) list
+val variantize : 't ty -> 't -> variant = 
+|}];;
+
+(* Extraction *)
+
+type 'a ty =
+  | Int: int ty
+  | String: string ty
+  | List: 'a ty -> 'a list ty
+  | Pair: ('a ty * 'b ty) -> ('a * 'b) ty
+  | Record: ('a, 'builder) record -> 'a ty
+
+and ('a, 'builder) record =
+    {
+     path: string;
+     fields: ('a, 'builder) field list;
+     create_builder: (unit -> 'builder);
+     of_builder: ('builder -> 'a);
+    }
+
+and ('a, 'builder) field =
+  | Field: ('a, 'builder, 'b) field_ -> ('a, 'builder) field
+
+and ('a, 'builder, 'b) field_ =
+  {
+   label: string;
+   field_type: 'b ty;
+   get: ('a -> 'b);
+   set: ('builder -> 'b -> unit);
+  }
+;;
+
+let rec devariantize: type t. t ty -> variant -> t =
+  fun ty v ->
+    match ty, v with
+    | Int, VInt x -> x
+    | String, VString x -> x
+    | List ty1, VList vl ->
+        List.map (devariantize ty1) vl
+    | Pair (ty1, ty2), VPair (x1, x2) ->
+        (devariantize ty1 x1, devariantize ty2 x2)
+    | Record {fields; create_builder; of_builder}, VRecord fl ->
+        if List.length fields <> List.length fl then raise VariantMismatch;
+        let builder = create_builder () in
+        List.iter2
+          (fun (Field {label; field_type; set}) (lab, v) ->
+            if label <> lab then raise VariantMismatch;
+            set builder (devariantize field_type v)
+          )
+          fields fl;
+        of_builder builder
+    | _ -> raise VariantMismatch
+;;
+[%%expect{|
+type 'a ty =
+    Int : int ty
+  | String : string ty
+  | List : 'a ty -> 'a list ty
+  | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
+  | Record : ('a, 'builder) record -> 'a ty
+and ('a, 'builder) record = {
+  path : string;
+  fields : ('a, 'builder) field list;
+  create_builder : unit -> 'builder;
+  of_builder : 'builder -> 'a;
+}
+and ('a, 'builder) field =
+    Field : ('a, 'builder, 'b) field_ -> ('a, 'builder) field
+and ('a, 'builder, 'b) field_ = {
+  label : string;
+  field_type : 'b ty;
+  get : 'a -> 'b;
+  set : 'builder -> 'b -> unit;
+}
+val devariantize : 't ty -> variant -> 't = 
+|}];;
+
+type my_record  =
+    {
+     a: int;
+     b: string list;
+    }
+;;
+
+let my_record =
+  let fields =
+    [
+     Field {label = "a"; field_type = Int;
+            get = (fun {a} -> a);
+            set = (fun (r, _) x -> r := Some x)};
+     Field {label = "b"; field_type = List String;
+            get = (fun {b} -> b);
+            set = (fun (_, r) x -> r := Some x)};
+    ]
+  in
+  let create_builder () = (ref None, ref None) in
+  let of_builder (a, b) =
+    match !a, !b with
+    | Some a, Some b -> {a; b}
+    | _ -> failwith "Some fields are missing in record of type my_record"
+  in
+  Record {path = "My_module.my_record"; fields; create_builder; of_builder}
+;;
+[%%expect{|
+type my_record = { a : int; b : string list; }
+val my_record : my_record ty =
+  Record
+   {path = "My_module.my_record";
+    fields =
+     [Field {label = "a"; field_type = Int; get = ; set = };
+      Field {label = "b"; field_type = List String; get = ; set = }];
+    create_builder = ; of_builder = }
+|}];;
+
+(* Extension to recursive types and polymorphic variants *)
+(* by Jacques Garrigue *)
+
+type noarg = Noarg
+
+type (_,_) ty =
+  | Int: (int,_) ty
+  | String: (string,_) ty
+  | List: ('a,'e) ty -> ('a list, 'e) ty
+  | Option: ('a,'e) ty -> ('a option, 'e) ty
+  | Pair: (('a,'e) ty * ('b,'e) ty) -> ('a * 'b,'e) ty
+  (* Support for type variables and recursive types *)
+  | Var: ('a, 'a -> 'e) ty
+  | Rec: ('a, 'a -> 'e) ty -> ('a,'e) ty
+  | Pop: ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  (* Change the representation of a type *)
+  | Conv: string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  (* Sum types (both normal sums and polymorphic variants) *)
+  | Sum: ('a, 'e, 'b) ty_sum -> ('a, 'e) ty
+
+and ('a, 'e, 'b) ty_sum =
+    { sum_proj: 'a -> string * 'e ty_dyn option;
+      sum_cases: (string * ('e,'b) ty_case) list;
+      sum_inj: 'c. ('b,'c) ty_sel * 'c -> 'a; }
+
+and 'e ty_dyn =              (* dynamic type *)
+  | Tdyn : ('a,'e) ty * 'a -> 'e ty_dyn
+
+and (_,_) ty_sel =           (* selector from a list of types *)
+  | Thd : ('a -> 'b, 'a) ty_sel
+  | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
+
+and (_,_) ty_case =          (* type a sum case *)
+  | TCarg : ('b,'a) ty_sel * ('a,'e) ty -> ('e,'b) ty_case
+  | TCnoarg : ('b,noarg) ty_sel -> ('e,'b) ty_case
+;;
+
+type _ ty_env =              (* type variable substitution *)
+  | Enil : unit ty_env
+  | Econs : ('a,'e) ty * 'e ty_env -> ('a -> 'e) ty_env
+;;
+
+(* Comparing selectors *)
+type (_,_) eq = Eq: ('a,'a) eq
+;;
+
+let rec eq_sel : type a b c. (a,b) ty_sel -> (a,c) ty_sel -> (b,c) eq option =
+  fun s1 s2 ->
+    match s1, s2 with
+    | Thd, Thd -> Some Eq
+    | Ttl s1, Ttl s2 ->
+        (match eq_sel s1 s2 with None -> None | Some Eq -> Some Eq)
+    | _ -> None
+;;
+[%%expect{|
+type noarg = Noarg
+type (_, _) ty =
+    Int : (int, 'c) ty
+  | String : (string, 'd) ty
+  | List : ('a, 'e) ty -> ('a list, 'e) ty
+  | Option : ('a, 'e) ty -> ('a option, 'e) ty
+  | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty
+  | Var : ('a, 'a -> 'e) ty
+  | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty
+  | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  | Sum : ('a, 'e, 'b) ty_sum -> ('a, 'e) ty
+and ('a, 'e, 'b) ty_sum = {
+  sum_proj : 'a -> string * 'e ty_dyn option;
+  sum_cases : (string * ('e, 'b) ty_case) list;
+  sum_inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
+}
+and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
+and (_, _) ty_sel =
+    Thd : ('a -> 'b, 'a) ty_sel
+  | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
+and (_, _) ty_case =
+    TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
+  | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
+type _ ty_env =
+    Enil : unit ty_env
+  | Econs : ('a, 'e) ty * 'e ty_env -> ('a -> 'e) ty_env
+type (_, _) eq = Eq : ('a, 'a) eq
+val eq_sel : ('a, 'b) ty_sel -> ('a, 'c) ty_sel -> ('b, 'c) eq option = 
+|}];;
+
+(* Auxiliary function to get the type of a case from its selector *)
+let rec get_case : type a b e.
+  (b, a) ty_sel -> (string * (e,b) ty_case) list -> string * (a, e) ty option =
+  fun sel cases ->
+  match cases with
+  | (name, TCnoarg sel') :: rem ->
+      begin match eq_sel sel sel' with
+      | None -> get_case sel rem
+      | Some Eq -> name, None
+      end
+  | (name, TCarg (sel', ty)) :: rem ->
+      begin match eq_sel sel sel' with
+      | None -> get_case sel rem
+      | Some Eq -> name, Some ty
+      end
+  | [] -> raise Not_found
+;;
+[%%expect{|
+val get_case :
+  ('b, 'a) ty_sel ->
+  (string * ('e, 'b) ty_case) list -> string * ('a, 'e) ty option = 
+|}];;
+
+(* Untyped representation of values *)
+type variant =
+  | VInt of int
+  | VString of string
+  | VList of variant list
+  | VOption of variant option
+  | VPair of variant * variant
+  | VConv of string * variant
+  | VSum of string * variant option
+;;
+
+let may_map f = function Some x -> Some (f x) | None -> None ;;
+
+let rec variantize : type a e. e ty_env -> (a,e) ty -> a -> variant =
+  fun e ty v ->
+  match ty with
+  | Int -> VInt v
+  | String -> VString v
+  | List t -> VList (List.map (variantize e t) v)
+  | Option t -> VOption (may_map (variantize e t) v)
+  | Pair (t1, t2) -> VPair (variantize e t1 (fst v), variantize e t2 (snd v))
+  | Rec t -> variantize (Econs (ty, e)) t v
+  | Pop t -> (match e with Econs (_, e') -> variantize e' t v)
+  | Var -> (match e with Econs (t, e') -> variantize e' t v)
+  | Conv (s, proj, inj, t) -> VConv (s, variantize e t (proj v))
+  | Sum ops ->
+      let tag, arg = ops.sum_proj v in
+      VSum (tag, may_map (function Tdyn (ty,arg) -> variantize e ty arg) arg)
+;;
+[%%expect{|
+type variant =
+    VInt of int
+  | VString of string
+  | VList of variant list
+  | VOption of variant option
+  | VPair of variant * variant
+  | VConv of string * variant
+  | VSum of string * variant option
+val may_map : ('a -> 'b) -> 'a option -> 'b option = 
+val variantize : 'e ty_env -> ('a, 'e) ty -> 'a -> variant = 
+|}];;
+
+let rec devariantize : type t e. e ty_env -> (t, e) ty -> variant -> t =
+  fun e ty v ->
+  match ty, v with
+  | Int, VInt x -> x
+  | String, VString x -> x
+  | List ty1, VList vl ->
+      List.map (devariantize e ty1) vl
+  | Pair (ty1, ty2), VPair (x1, x2) ->
+      (devariantize e ty1 x1, devariantize e ty2 x2)
+  | Rec t, _ -> devariantize (Econs (ty, e)) t v
+  | Pop t, _ -> (match e with Econs (_, e') -> devariantize e' t v)
+  | Var, _ -> (match e with Econs (t, e') -> devariantize e' t v)
+  | Conv (s, proj, inj, t), VConv (s', v) when s = s' ->
+      inj (devariantize e t v)
+  | Sum ops, VSum (tag, a) ->
+      begin try match List.assoc tag ops.sum_cases, a with
+      | TCarg (sel, t), Some a -> ops.sum_inj (sel, devariantize e t a)
+      | TCnoarg sel, None -> ops.sum_inj (sel, Noarg)
+      | _ -> raise VariantMismatch
+      with Not_found -> raise VariantMismatch
+      end
+  | _ -> raise VariantMismatch
+;;
+[%%expect{|
+val devariantize : 'e ty_env -> ('t, 'e) ty -> variant -> 't = 
+|}];;
+
+(* First attempt: represent 1-constructor variants using Conv *)
+let wrap_A t = Conv ("`A", (fun (`A x) -> x), (fun x -> `A x), t);;
+[%%expect{|
+val wrap_A : ('a, 'b) ty -> ([ `A of 'a ], 'b) ty = 
+|}];;
+
+let ty a = Rec (wrap_A (Option (Pair (a, Var)))) ;;
+[%%expect{|
+val ty : ('a, ([ `A of ('a * 'b) option ] as 'b) -> 'c) ty -> ('b, 'c) ty =
+  
+|}];;
+let v = variantize Enil (ty Int);;
+[%%expect{|
+val v : ([ `A of (int * 'a) option ] as 'a) -> variant = 
+|}];;
+let x = v (`A (Some (1, `A (Some (2, `A None))))) ;;
+[%%expect{|
+val x : variant =
+  VConv ("`A",
+   VOption
+    (Some
+      (VPair (VInt 1,
+        VConv ("`A",
+         VOption (Some (VPair (VInt 2, VConv ("`A", VOption None)))))))))
+|}];;
+
+(* Can also use it to decompose a tuple *)
+
+let triple t1 t2 t3 =
+  Conv ("Triple", (fun (a,b,c) -> (a,(b,c))),
+        (fun (a,(b,c)) -> (a,b,c)), Pair (t1, Pair (t2, t3)));;
+[%%expect{|
+val triple :
+  ('a, 'b) ty -> ('c, 'b) ty -> ('d, 'b) ty -> ('a * 'c * 'd, 'b) ty = 
+|}];;
+
+let v = variantize Enil (triple String Int Int) ("A", 2, 3) ;;
+[%%expect{|
+val v : variant =
+  VConv ("Triple", VPair (VString "A", VPair (VInt 2, VInt 3)))
+|}];;
+
+(* Second attempt: introduce a real sum construct *)
+let ty_abc =
+  (* Could also use [get_case] for proj, but direct definition is shorter *)
+  let proj = function
+      `A n -> "A", Some (Tdyn (Int, n))
+    | `B s -> "B", Some (Tdyn (String, s))
+    | `C   -> "C", None
+  (* Define inj in advance to be able to write the type annotation easily *)
+  and inj : type c. (int -> string -> noarg -> unit, c) ty_sel * c ->
+    [`A of int | `B of string | `C] = function
+        Thd, v -> `A v
+      | Ttl Thd, v -> `B v
+      | Ttl (Ttl Thd), Noarg -> `C
+  in
+  (* Coherence of sum_inj and sum_cases is checked by the typing *)
+  Sum { sum_proj = proj; sum_inj = inj; sum_cases =
+        [ "A", TCarg (Thd, Int); "B", TCarg (Ttl Thd, String);
+          "C", TCnoarg (Ttl (Ttl Thd)) ] }
+;;
+[%%expect{|
+val ty_abc : ([ `A of int | `B of string | `C ], 'a) ty =
+  Sum
+   {sum_proj = ;
+    sum_cases =
+     [("A", TCarg (Thd, Int)); ("B", TCarg (Ttl Thd, String));
+      ("C", TCnoarg (Ttl (Ttl Thd)))];
+    sum_inj = }
+|}];;
+
+let v = variantize Enil ty_abc (`A 3);;
+[%%expect{|
+val v : variant = VSum ("A", Some (VInt 3))
+|}];;
+let a = devariantize Enil ty_abc v;;
+[%%expect{|
+val a : [ `A of int | `B of string | `C ] = `A 3
+|}];;
+
+(* And an example with recursion... *)
+type 'a vlist = [`Nil | `Cons of 'a * 'a vlist]
+;;
+
+let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = fun t ->
+  let tcons = Pair (Pop t, Var) in
+  Rec (Sum {
+       sum_proj = (function
+           `Nil -> "Nil", None
+         | `Cons p -> "Cons", Some (Tdyn (tcons, p)));
+       sum_cases = ["Nil", TCnoarg Thd; "Cons", TCarg (Ttl Thd, tcons)];
+       sum_inj = fun (type c) ->
+         (function
+         | Thd, Noarg -> `Nil
+         | Ttl Thd, v -> `Cons v
+         : (noarg -> a * a vlist -> unit, c) ty_sel * c -> a vlist)
+         (* One can also write the type annotation directly *)
+     })
+;;
+[%%expect{|
+type 'a vlist = [ `Cons of 'a * 'a vlist | `Nil ]
+val ty_list : ('a, 'e) ty -> ('a vlist, 'e) ty = 
+|}];;
+
+let v = variantize Enil (ty_list Int) (`Cons (1, `Cons (2, `Nil))) ;;
+[%%expect{|
+val v : variant =
+  VSum ("Cons",
+   Some
+    (VPair (VInt 1, VSum ("Cons", Some (VPair (VInt 2, VSum ("Nil", None)))))))
+|}];;
+
+(* Simpler but weaker approach *)
+
+type (_,_) ty =
+  | Int: (int,_) ty
+  | String: (string,_) ty
+  | List: ('a,'e) ty -> ('a list, 'e) ty
+  | Option: ('a,'e) ty -> ('a option, 'e) ty
+  | Pair: (('a,'e) ty * ('b,'e) ty) -> ('a * 'b,'e) ty
+  | Var: ('a, 'a -> 'e) ty
+  | Rec: ('a, 'a -> 'e) ty -> ('a,'e) ty
+  | Pop: ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  | Conv: string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  | Sum: ('a -> string * 'e ty_dyn option) * (string * 'e ty_dyn option -> 'a)
+             -> ('a, 'e) ty
+and 'e ty_dyn =
+  | Tdyn : ('a,'e) ty * 'a -> 'e ty_dyn
+;;
+
+let ty_abc : ([`A of int | `B of string | `C],'e) ty =
+  (* Could also use [get_case] for proj, but direct definition is shorter *)
+  Sum (
+  (function
+      `A n -> "A", Some (Tdyn (Int, n))
+    | `B s -> "B", Some (Tdyn (String, s))
+    | `C   -> "C", None),
+  (function
+      "A", Some (Tdyn (Int, n)) -> `A n
+    | "B", Some (Tdyn (String, s)) -> `B s
+    | "C", None -> `C
+    | _ -> invalid_arg "ty_abc"))
+;;
+[%%expect{|
+type (_, _) ty =
+    Int : (int, 'c) ty
+  | String : (string, 'd) ty
+  | List : ('a, 'e) ty -> ('a list, 'e) ty
+  | Option : ('a, 'e) ty -> ('a option, 'e) ty
+  | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty
+  | Var : ('a, 'a -> 'e) ty
+  | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty
+  | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  | Sum : ('a -> string * 'e ty_dyn option) *
+      (string * 'e ty_dyn option -> 'a) -> ('a, 'e) ty
+and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
+val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum (, )
+|}];;
+
+(* Breaks: no way to pattern-match on a full recursive type *)
+let ty_list : type a e. (a,e) ty -> (a vlist,e) ty = fun t ->
+  let targ = Pair (Pop t, Var) in
+  Rec (Sum (
+  (function `Nil -> "Nil", None
+    | `Cons p -> "Cons", Some (Tdyn (targ, p))),
+  (function "Nil", None -> `Nil
+    | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p)))
+;;
+[%%expect{|
+Line 7, characters 41-58:
+7 |     | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p)))
+                                             ^^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type a * a vlist
+       but a pattern was expected which matches values of type
+         $Tdyn_'a = $0 * $1
+       Type a is not compatible with type $0
+|}];;
+
+(* Define Sum using object instead of record for first-class polymorphism *)
+
+type (_,_) ty =
+  | Int: (int,_) ty
+  | String: (string,_) ty
+  | List: ('a,'e) ty -> ('a list, 'e) ty
+  | Option: ('a,'e) ty -> ('a option, 'e) ty
+  | Pair: (('a,'e) ty * ('b,'e) ty) -> ('a * 'b,'e) ty
+  | Var: ('a, 'a -> 'e) ty
+  | Rec: ('a, 'a -> 'e) ty -> ('a,'e) ty
+  | Pop: ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  | Conv: string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  | Sum: < proj: 'a -> string * 'e ty_dyn option;
+           cases: (string * ('e,'b) ty_case) list;
+           inj: 'c. ('b,'c) ty_sel * 'c -> 'a >
+          -> ('a, 'e) ty
+
+and 'e ty_dyn =
+  | Tdyn : ('a,'e) ty * 'a -> 'e ty_dyn
+
+and (_,_) ty_sel =
+  | Thd : ('a -> 'b, 'a) ty_sel
+  | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
+
+and (_,_) ty_case =
+  | TCarg : ('b,'a) ty_sel * ('a,'e) ty -> ('e,'b) ty_case
+  | TCnoarg : ('b,noarg) ty_sel -> ('e,'b) ty_case
+;;
+
+let ty_abc : ([`A of int | `B of string | `C] as 'a, 'e) ty =
+  Sum (object
+    method proj = function
+        `A n -> "A", Some (Tdyn (Int, n))
+      | `B s -> "B", Some (Tdyn (String, s))
+      | `C -> "C", None
+    method cases =
+      [ "A", TCarg (Thd, Int); "B", TCarg (Ttl Thd, String);
+        "C", TCnoarg (Ttl (Ttl Thd)) ];
+    method inj : type c.
+        (int -> string -> noarg -> unit, c) ty_sel * c ->
+          [`A of int | `B of string | `C] =
+      function
+        Thd, v -> `A v
+      | Ttl Thd, v -> `B v
+      | Ttl (Ttl Thd), Noarg -> `C
+  end)
+;;
+[%%expect{|
+type (_, _) ty =
+    Int : (int, 'd) ty
+  | String : (string, 'f) ty
+  | List : ('a, 'e) ty -> ('a list, 'e) ty
+  | Option : ('a, 'e) ty -> ('a option, 'e) ty
+  | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty
+  | Var : ('a, 'a -> 'e) ty
+  | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty
+  | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  | Sum :
+      < cases : (string * ('e, 'b) ty_case) list;
+        inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
+        proj : 'a -> string * 'e ty_dyn option > -> ('a, 'e) ty
+and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
+and (_, _) ty_sel =
+    Thd : ('a -> 'b, 'a) ty_sel
+  | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
+and (_, _) ty_case =
+    TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
+  | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
+val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum 
+|}];;
+
+type 'a vlist = [`Nil | `Cons of 'a * 'a vlist]
+;;
+
+let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = fun t ->
+  let tcons = Pair (Pop t, Var) in
+  Rec (Sum (object
+    method proj = function
+        `Nil -> "Nil", None
+      | `Cons p -> "Cons", Some (Tdyn (tcons, p))
+    method cases = ["Nil", TCnoarg Thd; "Cons", TCarg (Ttl Thd, tcons)]
+    method inj : type c.(noarg -> a * a vlist -> unit, c) ty_sel * c -> a vlist
+    = function
+      | Thd, Noarg -> `Nil
+      | Ttl Thd, v -> `Cons v
+  end))
+;;
+[%%expect{|
+type 'a vlist = [ `Cons of 'a * 'a vlist | `Nil ]
+val ty_list : ('a, 'e) ty -> ('a vlist, 'e) ty = 
+|}];;
+
+(*
+type (_,_) ty_assoc =
+  | Anil : (unit,'e) ty_assoc
+  | Acons : string * ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc
+
+and (_,_) ty_pvar =
+  | Pnil : ('a,'e) ty_pvar
+  | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar
+  | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar
+*)
diff --git a/testsuite/tests/typing-gadts/nested_equations.ml b/testsuite/tests/typing-gadts/nested_equations.ml
new file mode 100644
index 00000000..b1719bfb
--- /dev/null
+++ b/testsuite/tests/typing-gadts/nested_equations.ml
@@ -0,0 +1,92 @@
+(* TEST
+   * expect
+*)
+
+(* Tests for nested equations (bind abstract types from other modules) *)
+
+type _ t = Int : int t;;
+
+let to_int (type a) (w : a t) (x : a) : int = let Int = w in x;;
+[%%expect{|
+type _ t = Int : int t
+val to_int : 'a t -> 'a -> int = 
+|}];;
+
+let w_bool : bool t = Obj.magic 0;;
+let f_bool (x : bool) : int = let Int = w_bool in x;; (* fail *)
+[%%expect{|
+val w_bool : bool t = Int
+Line 2, characters 34-37:
+2 | let f_bool (x : bool) : int = let Int = w_bool in x;; (* fail *)
+                                      ^^^
+Error: This pattern matches values of type int t
+       but a pattern was expected which matches values of type bool t
+       Type int is not compatible with type bool
+|}];;
+
+let w_buffer : Buffer.t t = Obj.magic 0;;
+let f_buffer (x : Buffer.t) : int = let Int = w_buffer in x;; (* ok *)
+[%%expect{|
+val w_buffer : Buffer.t t = Int
+val f_buffer : Buffer.t -> int = 
+|}];;
+
+let w_spec : Arg.spec t = Obj.magic 0;;
+let f_spec (x : Arg.spec) : int = let Int = w_spec in x;; (* fail *)
+[%%expect{|
+val w_spec : Arg.spec t = Int
+Line 2, characters 38-41:
+2 | let f_spec (x : Arg.spec) : int = let Int = w_spec in x;; (* fail *)
+                                          ^^^
+Error: This pattern matches values of type int t
+       but a pattern was expected which matches values of type Arg.spec t
+       Type int is not compatible with type Arg.spec
+|}];;
+
+module M : sig type u val w : u t val x : u end =
+  struct type u = int let w = Int let x = 33 end;;
+let m_x : int = let Int = M.w in M.x;;
+[%%expect{|
+module M : sig type u val w : u t val x : u end
+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
+val fm_x : int = 33
+|}];;
+
+module M' = struct module M : sig type u val w : u t val x : u end = M end;;
+module F' (X : sig module M : sig type u = int val x : u end end) =
+  struct let x : int = X.M.x end;;
+let fm'_x : int =
+  let Int = M'.M.w in let module FM' = F'(M') in FM'.x;; (* ok *)
+[%%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) ->
+    sig val x : int end
+val fm'_x : int = 33
+|}];;
+
+(* PR#7233 *)
+
+type (_, _) eq = Refl : ('a, 'a) eq
+
+module type S = sig
+  type t
+  val eql : (t, int) eq
+end
+
+module F (M : S) = struct
+  let zero : M.t =
+    let Refl = M.eql in 0
+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
+|}];;
diff --git a/testsuite/tests/typing-gadts/omega07.ml b/testsuite/tests/typing-gadts/omega07.ml
new file mode 100644
index 00000000..a8a78b17
--- /dev/null
+++ b/testsuite/tests/typing-gadts/omega07.ml
@@ -0,0 +1,1218 @@
+(* TEST
+   * expect
+*)
+
+(*
+   An attempt at encoding omega examples from the 2nd Central European
+   Functional Programming School:
+     Generic Programming in Omega, by Tim Sheard and Nathan Linger
+          http://web.cecs.pdx.edu/~sheard/
+*)
+
+(* Basic types *)
+
+type ('a,'b) sum = Inl of 'a | Inr of 'b
+
+type zero = Zero
+type 'a succ = Succ of 'a
+type _ nat =
+  | NZ : zero nat
+  | NS : 'a nat -> 'a succ nat
+;;
+
+(* 2: A simple example *)
+
+type (_,_) seq =
+  | Snil  : ('a,zero) seq
+  | Scons : 'a * ('a,'n) seq -> ('a, 'n succ) seq
+;;
+
+let l1 = Scons (3, Scons (5, Snil)) ;;
+[%%expect{|
+type ('a, 'b) sum = Inl of 'a | Inr of 'b
+type zero = Zero
+type 'a succ = Succ of 'a
+type _ nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
+type (_, _) seq =
+    Snil : ('a, zero) seq
+  | Scons : 'a * ('a, 'n) seq -> ('a, 'n succ) seq
+val l1 : (int, zero succ succ) seq = Scons (3, Scons (5, Snil))
+|}];;
+
+(* We do not have type level functions, so we need to use witnesses. *)
+(* We copy here the definitions from section 3.9 *)
+(* Note the addition of the ['a nat] argument to PlusZ, since we do not
+   have kinds *)
+type (_,_,_) plus =
+  | PlusZ : 'a nat -> (zero, 'a, 'a) plus
+  | PlusS : ('a,'b,'c) plus -> ('a succ, 'b, 'c succ) plus
+;;
+
+let rec length : type a n. (a,n) seq -> n nat = function
+  | Snil -> NZ
+  | Scons (_, s) -> NS (length s)
+;;
+[%%expect{|
+type (_, _, _) plus =
+    PlusZ : 'a nat -> (zero, 'a, 'a) plus
+  | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus
+val length : ('a, 'n) seq -> 'n nat = 
+|}];;
+
+(* app returns the catenated lists with a witness proving that
+   the size is the sum of its two inputs *)
+type (_,_,_) app = App : ('a,'p) seq * ('n,'m,'p) plus -> ('a,'n,'m) app
+
+let rec app : type a n m. (a,n) seq -> (a,m) seq -> (a,n,m) app =
+  fun xs ys ->
+  match xs with
+  | Snil -> App (ys, PlusZ (length ys))
+  | Scons (x, xs') ->
+      let App (xs'', pl) = app xs' ys in
+      App (Scons (x, xs''), PlusS pl)
+;;
+[%%expect{|
+type (_, _, _) app =
+    App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app
+val app : ('a, 'n) seq -> ('a, 'm) seq -> ('a, 'n, 'm) app = 
+|}];;
+
+(* 3.1 Feature: kinds *)
+
+(* We do not have kinds, but we can encode them as predicates *)
+
+type tp = TP
+type nd = ND
+type ('a,'b) fk = FK
+type _ shape =
+  | Tp : tp shape
+  | Nd : nd shape
+  | Fk : 'a shape * 'b shape -> ('a,'b) fk shape
+;;
+type tt = TT
+type ff = FF
+type _ boolean =
+  | BT : tt boolean
+  | BF : ff boolean
+;;
+
+(* 3.3 Feature : GADTs *)
+
+type (_,_) path =
+  | Pnone : 'a -> (tp,'a) path
+  | Phere : (nd,'a) path
+  | Pleft : ('x,'a) path -> (('x,'y) fk, 'a) path
+  | Pright : ('y,'a) path -> (('x,'y) fk, 'a) path
+;;
+type (_,_) tree =
+  | Ttip  : (tp,'a) tree
+  | Tnode : 'a -> (nd,'a) tree
+  | Tfork : ('x,'a) tree * ('y,'a) tree -> (('x,'y)fk, 'a) tree
+;;
+let tree1 = Tfork (Tfork (Ttip, Tnode 4), Tfork (Tnode 4, Tnode 3))
+;;
+[%%expect{|
+type tp = TP
+type nd = ND
+type ('a, 'b) fk = FK
+type _ shape =
+    Tp : tp shape
+  | Nd : nd shape
+  | Fk : 'a shape * 'b shape -> ('a, 'b) fk shape
+type tt = TT
+type ff = FF
+type _ boolean = BT : tt boolean | BF : ff boolean
+type (_, _) path =
+    Pnone : 'a -> (tp, 'a) path
+  | Phere : (nd, 'a) path
+  | Pleft : ('x, 'a) path -> (('x, 'y) fk, 'a) path
+  | Pright : ('y, 'a) path -> (('x, 'y) fk, 'a) path
+type (_, _) tree =
+    Ttip : (tp, 'a) tree
+  | Tnode : 'a -> (nd, 'a) tree
+  | Tfork : ('x, 'a) tree * ('y, 'a) tree -> (('x, 'y) fk, 'a) tree
+val tree1 : (((tp, nd) fk, (nd, nd) fk) fk, int) tree =
+  Tfork (Tfork (Ttip, Tnode 4), Tfork (Tnode 4, Tnode 3))
+|}];;
+let rec find : type sh.
+    ('a -> 'a -> bool) -> 'a -> (sh,'a) tree -> (sh,'a) path list
+  = fun eq n t ->
+    match t with
+    | Ttip -> []
+    | Tnode m ->
+        if eq n m then [Phere] else []
+    | Tfork (x, y) ->
+        List.map (fun x -> Pleft x) (find eq n x) @
+        List.map (fun x -> Pright x) (find eq n y)
+;;
+[%%expect{|
+val find : ('a -> 'a -> bool) -> 'a -> ('sh, 'a) tree -> ('sh, 'a) path list =
+  
+|}];;
+let rec extract : type sh. (sh,'a) path -> (sh,'a) tree -> 'a = fun p t ->
+  match (p, t) with
+  | Pnone x, Ttip -> x
+  | Phere, Tnode y -> y
+  | Pleft p, Tfork(l,_) -> extract p l
+  | Pright p, Tfork(_,r) -> extract p r
+;;
+[%%expect{|
+val extract : ('sh, 'a) path -> ('sh, 'a) tree -> 'a = 
+|}];;
+
+(* 3.4 Pattern : Witness *)
+
+type (_,_) le =
+  | LeZ : 'a nat -> (zero, 'a) le
+  | LeS : ('n, 'm) le -> ('n succ, 'm succ) le
+;;
+type _ even =
+  | EvenZ : zero even
+  | EvenSS : 'n even -> 'n succ succ even
+;;
+type one = zero succ
+type two = one succ
+type three = two succ
+type four = three succ
+;;
+let even0 : zero even = EvenZ
+let even2 : two even = EvenSS EvenZ
+let even4 : four even = EvenSS (EvenSS EvenZ)
+;;
+let p1 : (two, one, three) plus = PlusS (PlusS (PlusZ (NS NZ)))
+;;
+[%%expect{|
+type (_, _) le =
+    LeZ : 'a nat -> (zero, 'a) le
+  | LeS : ('n, 'm) le -> ('n succ, 'm succ) le
+type _ even = EvenZ : zero even | EvenSS : 'n even -> 'n succ succ even
+type one = zero succ
+type two = one succ
+type three = two succ
+type four = three succ
+val even0 : zero even = EvenZ
+val even2 : two even = EvenSS EvenZ
+val even4 : four even = EvenSS (EvenSS EvenZ)
+val p1 : (two, one, three) plus = PlusS (PlusS (PlusZ (NS NZ)))
+|}];;
+let rec summandLessThanSum : type a b c. (a,b,c) plus -> (a,c) le = fun p ->
+  match p with
+  | PlusZ n -> LeZ n
+  | PlusS p' -> LeS (summandLessThanSum p')
+;;
+[%%expect{|
+val summandLessThanSum : ('a, 'b, 'c) plus -> ('a, 'c) le = 
+|}];;
+
+(* 3.8 Pattern: Leibniz Equality *)
+
+type (_,_) equal = Eq : ('a,'a) equal
+
+let convert : type a b. (a,b) equal -> a -> b = fun Eq x -> x
+[%%expect{|
+type (_, _) equal = Eq : ('a, 'a) equal
+val convert : ('a, 'b) equal -> 'a -> 'b = 
+|}];;
+
+let rec sameNat : type a b. a nat -> b nat -> (a,b) equal option = fun a b ->
+  match a, b with
+  | NZ, NZ -> Some Eq
+  | NS a', NS b' ->
+      begin match sameNat a' b' with
+      | Some Eq -> Some Eq
+      | None -> None
+      end
+  | _ -> None
+;;
+[%%expect{|
+val sameNat : 'a nat -> 'b nat -> ('a, 'b) equal option = 
+|}];;
+
+(* Extra: associativity of addition *)
+
+let rec plus_func : type a b m n.
+  (a,b,m) plus -> (a,b,n) plus -> (m,n) equal =
+  fun p1 p2 ->
+  match p1, p2 with
+  | PlusZ _, PlusZ _ -> Eq
+  | PlusS p1', PlusS p2' ->
+      let Eq = plus_func p1' p2' in Eq
+;;
+[%%expect{|
+val plus_func : ('a, 'b, 'm) plus -> ('a, 'b, 'n) plus -> ('m, 'n) equal =
+  
+|}];;
+
+let rec plus_assoc : type a b c ab bc m n.
+  (a,b,ab) plus -> (ab,c,m) plus ->
+  (b,c,bc) plus -> (a,bc,n) plus -> (m,n) equal = fun p1 p2 p3 p4 ->
+  match p1, p4 with
+  | PlusZ b, PlusZ bc ->
+      let Eq = plus_func p2 p3 in Eq
+  | PlusS p1', PlusS p4' ->
+      let PlusS p2' = p2 in
+      let Eq = plus_assoc p1' p2' p3 p4' in Eq
+;;
+[%%expect{|
+val plus_assoc :
+  ('a, 'b, 'ab) plus ->
+  ('ab, 'c, 'm) plus ->
+  ('b, 'c, 'bc) plus -> ('a, 'bc, 'n) plus -> ('m, 'n) equal = 
+|}];;
+
+(* 3.9 Computing Programs and Properties Simultaneously *)
+
+(* Plus and app1 are moved to section 2 *)
+
+let smaller : type a b. (a succ, b succ) le -> (a,b) le =
+  function LeS x -> x ;;
+[%%expect{|
+val smaller : ('a succ, 'b succ) le -> ('a, 'b) le = 
+|}];;
+
+type (_,_) diff = Diff : 'c nat * ('a,'c,'b) plus -> ('a,'b) diff ;;
+
+(*
+let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff =
+  fun le a b ->
+  match a, b, le with
+  | NZ, m, _ -> Diff (m, PlusZ m)
+  | NS x, NZ, _ -> assert false
+  | NS x, NS y, q ->
+      match diff (smaller q) x y with Diff (m, p) -> Diff (m, PlusS p)
+;;
+*)
+
+let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff =
+  fun le a b ->
+  match le, a, b with
+  | LeZ _, _, m -> Diff (m, PlusZ m)
+  | LeS q, NS x, NS y ->
+      match diff q x y with Diff (m, p) -> Diff (m, PlusS p)
+;;
+[%%expect{|
+type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
+val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = 
+|}];;
+
+let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff =
+  fun le a b ->
+  match a, b,le with (* warning *)
+  | NZ, m, LeZ _ -> Diff (m, PlusZ m)
+  | NS x, NS y, LeS q ->
+      (match diff q x y with Diff (m, p) -> Diff (m, PlusS p))
+  | _ -> .
+;;
+[%%expect{|
+val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = 
+|}];;
+
+let rec diff : type a b. (a,b) le -> b nat -> (a,b) diff =
+  fun le b ->
+  match b,le with
+  | m, LeZ _ -> Diff (m, PlusZ m)
+  | NS y, LeS q ->
+      match diff q y with Diff (m, p) -> Diff (m, PlusS p)
+;;
+[%%expect{|
+val diff : ('a, 'b) le -> 'b nat -> ('a, 'b) diff = 
+|}];;
+
+type (_,_) filter = Filter : ('m,'n) le * ('a,'m) seq -> ('a,'n) filter
+
+let rec leS' : type m n. (m,n) le -> (m,n succ) le = function
+  | LeZ n -> LeZ (NS n)
+  | LeS le -> LeS (leS' le)
+;;
+[%%expect{|
+type (_, _) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter
+val leS' : ('m, 'n) le -> ('m, 'n succ) le = 
+|}];;
+
+let rec filter : type a n. (a -> bool) -> (a,n) seq -> (a,n) filter =
+  fun f s ->
+  match s with
+  | Snil -> Filter (LeZ NZ, Snil)
+  | Scons (a,l) ->
+      match filter f l with Filter (le, l') ->
+        if f a then Filter (LeS le, Scons (a, l'))
+        else Filter (leS' le, l')
+;;
+[%%expect{|
+val filter : ('a -> bool) -> ('a, 'n) seq -> ('a, 'n) filter = 
+|}];;
+
+(* 4.1 AVL trees *)
+
+type (_,_,_) balance =
+  | Less : ('h, 'h succ, 'h succ) balance
+  | Same : ('h, 'h, 'h) balance
+  | More : ('h succ, 'h, 'h succ) balance
+
+type _ avl =
+  | Leaf : zero avl
+  | Node :
+      ('hL, 'hR, 'hMax) balance * 'hL avl * int * 'hR avl -> 'hMax succ avl
+
+type avl' = Avl : 'h avl -> avl'
+;;
+
+let empty = Avl Leaf;;
+[%%expect{|
+type (_, _, _) balance =
+    Less : ('h, 'h succ, 'h succ) balance
+  | Same : ('h, 'h, 'h) balance
+  | More : ('h succ, 'h, 'h succ) balance
+type _ avl =
+    Leaf : zero avl
+  | Node : ('hL, 'hR, 'hMax) balance * 'hL avl * int *
+      'hR avl -> 'hMax succ avl
+type avl' = Avl : 'h avl -> avl'
+val empty : avl' = Avl Leaf
+|}];;
+
+let rec elem : type h. int -> h avl -> bool = fun x t ->
+  match t with
+  | Leaf -> false
+  | Node (_, l, y, r) ->
+      x = y || if x < y then elem x l else elem x r
+;;
+[%%expect{|
+val elem : int -> 'h avl -> bool = 
+|}];;
+
+let rec rotr : type n. (n succ succ) avl -> int -> n avl ->
+  ((n succ succ) avl, (n succ succ succ) avl) sum =
+  fun tL y tR ->
+  match tL with
+  | Node (Same, a, x, b) -> Inr (Node (Less, a, x, Node (More, b, y, tR)))
+  | Node (More, a, x, b) -> Inl (Node (Same, a, x, Node (Same, b, y, tR)))
+  | Node (Less, a, x, Node (Same, b, z, c)) ->
+      Inl (Node (Same, Node (Same, a, x, b), z, Node (Same, c, y, tR)))
+  | Node (Less, a, x, Node (Less, b, z, c)) ->
+      Inl (Node (Same, Node (More, a, x, b), z, Node (Same, c, y, tR)))
+  | Node (Less, a, x, Node (More, b, z, c)) ->
+      Inl (Node (Same, Node (Same, a, x, b), z, Node (Less, c, y, tR)))
+;;
+[%%expect{|
+val rotr :
+  'n succ succ avl ->
+  int -> 'n avl -> ('n succ succ avl, 'n succ succ succ avl) sum = 
+|}];;
+let rec rotl : type n. n avl -> int -> (n succ succ) avl ->
+  ((n succ succ) avl, (n succ succ succ) avl) sum =
+  fun tL u tR ->
+  match tR with
+  | Node (Same, a, x, b) -> Inr (Node (More, Node (Less, tL, u, a), x, b))
+  | Node (Less, a, x, b) -> Inl (Node (Same, Node (Same, tL, u, a), x, b))
+  | Node (More, Node (Same, a, x, b), y, c) ->
+      Inl (Node (Same, Node (Same, tL, u, a), x, Node (Same, b, y, c)))
+  | Node (More, Node (Less, a, x, b), y, c) ->
+      Inl (Node (Same, Node (More, tL, u, a), x, Node (Same, b, y, c)))
+  | Node (More, Node (More, a, x, b), y, c) ->
+      Inl (Node (Same, Node (Same, tL, u, a), x, Node (Less, b, y, c)))
+;;
+[%%expect{|
+val rotl :
+  'n avl ->
+  int -> 'n succ succ avl -> ('n succ succ avl, 'n succ succ succ avl) sum =
+  
+|}];;
+let rec ins : type n. int -> n avl -> (n avl, (n succ) avl) sum =
+  fun x t ->
+  match t with
+  | Leaf -> Inr (Node (Same, Leaf, x, Leaf))
+  | Node (bal, a, y, b) ->
+      if x = y then Inl t else
+      if x < y then begin
+        match ins x a with
+        | Inl a -> Inl (Node (bal, a, y, b))
+        | Inr a ->
+            match bal with
+            | Less -> Inl (Node (Same, a, y, b))
+            | Same -> Inr (Node (More, a, y, b))
+            | More -> rotr a y b
+      end else begin
+        match ins x b with
+        | Inl b -> Inl (Node (bal, a, y, b) : n avl)
+        | Inr b ->
+            match bal with
+            | More -> Inl (Node (Same, a, y, b) : n avl)
+            | Same -> Inr (Node (Less, a, y, b) : n succ avl)
+            | Less -> rotl a y b
+      end
+;;
+[%%expect{|
+val ins : int -> 'n avl -> ('n avl, 'n succ avl) sum = 
+|}];;
+
+let insert x (Avl t) =
+  match ins x t with
+  | Inl t -> Avl t
+  | Inr t -> Avl t
+;;
+[%%expect{|
+val insert : int -> avl' -> avl' = 
+|}];;
+
+let rec del_min : type n. (n succ) avl -> int * (n avl, (n succ) avl) sum =
+  function
+  | Node (Less, Leaf, x, r) -> (x, Inl r)
+  | Node (Same, Leaf, x, r) -> (x, Inl r)
+  | Node (bal, (Node _ as l) , x, r) ->
+      match del_min l with
+      | y, Inr l -> (y, Inr (Node (bal, l, x, r)))
+      | y, Inl l ->
+          (y, match bal with
+          | Same -> Inr (Node (Less, l, x, r))
+          | More -> Inl (Node (Same, l, x, r))
+          | Less -> rotl l x r)
+;;
+[%%expect{|
+val del_min : 'n succ avl -> int * ('n avl, 'n succ avl) sum = 
+|}];;
+
+type _ avl_del =
+  | Dsame : 'n avl -> 'n avl_del
+  | Ddecr : ('m succ, 'n) equal * 'm avl -> 'n avl_del
+
+let rec del : type n. int -> n avl -> n avl_del = fun y t ->
+  match t with
+  | Leaf -> Dsame Leaf
+  | Node (bal, l, x, r) ->
+      if x = y then begin
+        match r with
+        | Leaf ->
+            begin match bal with
+            | Same -> Ddecr (Eq, l)
+            | More -> Ddecr (Eq, l)
+            end
+        | Node _ ->
+            begin match bal, del_min r with
+            | _, (z, Inr r) -> Dsame (Node (bal, l, z, r))
+            | Same, (z, Inl r) -> Dsame (Node (More, l, z, r))
+            | Less, (z, Inl r) -> Ddecr (Eq, Node (Same, l, z, r))
+            | More, (z, Inl r) ->
+                match rotr l z r with
+                | Inl t -> Ddecr (Eq, t)
+                | Inr t -> Dsame t
+            end
+      end else if y < x then begin
+        match del y l with
+        | Dsame l -> Dsame (Node (bal, l, x, r))
+        | Ddecr(Eq,l) ->
+            begin match bal with
+            | Same -> Dsame (Node (Less, l, x, r))
+            | More -> Ddecr (Eq, Node (Same, l, x, r))
+            | Less ->
+                match rotl l x r with
+                | Inl t -> Ddecr (Eq, t)
+                | Inr t -> Dsame t
+            end
+      end else begin
+        match del y r with
+        | Dsame r -> Dsame (Node (bal, l, x, r))
+        | Ddecr(Eq,r) ->
+            begin match bal with
+            | Same -> Dsame (Node (More, l, x, r))
+            | Less -> Ddecr (Eq, Node (Same, l, x, r))
+            | More ->
+                match rotr l x r with
+                | Inl t -> Ddecr (Eq, t)
+                | Inr t -> Dsame t
+            end
+      end
+;;
+[%%expect{|
+type _ avl_del =
+    Dsame : 'n avl -> 'n avl_del
+  | Ddecr : ('m succ, 'n) equal * 'm avl -> 'n avl_del
+val del : int -> 'n avl -> 'n avl_del = 
+|}];;
+
+let delete x (Avl t) =
+  match del x t with
+  | Dsame t -> Avl t
+  | Ddecr (_, t) -> Avl t
+;;
+[%%expect{|
+val delete : int -> avl' -> avl' = 
+|}];;
+
+
+(* Exercise 22: Red-black trees *)
+
+type red = RED
+type black = BLACK
+type (_,_) sub_tree =
+  | Bleaf : (black, zero) sub_tree
+  | Rnode :
+      (black, 'n) sub_tree * int * (black, 'n) sub_tree -> (red, 'n) sub_tree
+  | Bnode :
+      ('cL, 'n) sub_tree * int * ('cR, 'n) sub_tree -> (black, 'n succ) sub_tree
+
+type rb_tree = Root : (black, 'n) sub_tree -> rb_tree
+;;
+
+type dir = LeftD | RightD
+
+type (_,_) ctxt =
+  | CNil : (black,'n) ctxt
+  | CRed : int * dir * (black,'n) sub_tree * (red,'n) ctxt -> (black,'n) ctxt
+  | CBlk : int * dir * ('c1,'n) sub_tree * (black, 'n succ) ctxt -> ('c,'n) ctxt
+;;
+
+let blacken = function
+    Rnode (l, e, r) -> Bnode (l, e, r)
+;;
+[%%expect{|
+type red = RED
+type black = BLACK
+type (_, _) sub_tree =
+    Bleaf : (black, zero) sub_tree
+  | Rnode : (black, 'n) sub_tree * int *
+      (black, 'n) sub_tree -> (red, 'n) sub_tree
+  | Bnode : ('cL, 'n) sub_tree * int *
+      ('cR, 'n) sub_tree -> (black, 'n succ) sub_tree
+type rb_tree = Root : (black, 'n) sub_tree -> rb_tree
+type dir = LeftD | RightD
+type (_, _) ctxt =
+    CNil : (black, 'n) ctxt
+  | CRed : int * dir * (black, 'n) sub_tree *
+      (red, 'n) ctxt -> (black, 'n) ctxt
+  | CBlk : int * dir * ('c1, 'n) sub_tree *
+      (black, 'n succ) ctxt -> ('c, 'n) ctxt
+val blacken : (red, 'a) sub_tree -> (black, 'a succ) sub_tree = 
+|}];;
+
+type _ crep =
+  | Red : red crep
+  | Black : black crep
+
+let color : type c n. (c,n) sub_tree -> c crep = function
+  | Bleaf -> Black
+  | Rnode _ -> Red
+  | Bnode _ -> Black
+;;
+[%%expect{|
+type _ crep = Red : red crep | Black : black crep
+val color : ('c, 'n) sub_tree -> 'c crep = 
+|}];;
+
+let rec fill : type c n. (c,n) ctxt -> (c,n) sub_tree -> rb_tree =
+  fun ct t ->
+  match ct with
+  | CNil -> Root t
+  | CRed (e, LeftD, uncle, c) -> fill c (Rnode (uncle, e, t))
+  | CRed (e, RightD, uncle, c) -> fill c (Rnode (t, e, uncle))
+  | CBlk (e, LeftD, uncle, c) -> fill c (Bnode (uncle, e, t))
+  | CBlk (e, RightD, uncle, c) -> fill c (Bnode (t, e, uncle))
+;;
+[%%expect{|
+val fill : ('c, 'n) ctxt -> ('c, 'n) sub_tree -> rb_tree = 
+|}];;
+let recolor d1 pE sib d2 gE uncle t =
+  match d1, d2 with
+  | LeftD, RightD -> Rnode (Bnode (sib, pE, t), gE, uncle)
+  | RightD, RightD -> Rnode (Bnode (t, pE, sib), gE, uncle)
+  | LeftD, LeftD -> Rnode (uncle, gE, Bnode (sib, pE, t))
+  | RightD, LeftD -> Rnode (uncle, gE, Bnode (t, pE, sib))
+;;
+[%%expect{|
+val recolor :
+  dir ->
+  int ->
+  ('a, 'b) sub_tree ->
+  dir ->
+  int ->
+  (black, 'b succ) sub_tree -> ('c, 'b) sub_tree -> (red, 'b succ) sub_tree =
+  
+|}];;
+let rotate d1 pE sib d2 gE uncle (Rnode (x, e, y)) =
+  match d1, d2 with
+  | RightD, RightD -> Bnode (Rnode (x,e,y), pE, Rnode (sib, gE, uncle))
+  | LeftD,  RightD -> Bnode (Rnode (sib, pE, x), e, Rnode (y, gE, uncle))
+  | LeftD,  LeftD  -> Bnode (Rnode (uncle, gE, sib), pE, Rnode (x,e,y))
+  | RightD, LeftD  -> Bnode (Rnode (uncle, gE, x), e, Rnode (y, pE, sib))
+;;
+[%%expect{|
+val rotate :
+  dir ->
+  int ->
+  (black, 'a) sub_tree ->
+  dir ->
+  int ->
+  (black, 'a) sub_tree -> (red, 'a) sub_tree -> (black, 'a succ) sub_tree =
+  
+|}];;
+let rec repair : type c n. (red,n) sub_tree -> (c,n) ctxt -> rb_tree =
+  fun t ct ->
+  match ct with
+  | CNil -> Root (blacken t)
+  | CBlk (e, LeftD, sib, c) -> fill c (Bnode (sib, e, t))
+  | CBlk (e, RightD, sib, c) -> fill c (Bnode (t, e, sib))
+  | CRed (e, dir, sib, CBlk (e', dir', uncle, ct)) ->
+      match color uncle with
+      | Red -> repair (recolor dir e sib dir' e' (blacken uncle) t) ct
+      | Black -> fill ct (rotate dir e sib dir' e' uncle t)
+;;
+[%%expect{|
+val repair : (red, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = 
+|}];;
+let rec ins : type c n. int -> (c,n) sub_tree -> (c,n) ctxt -> rb_tree =
+  fun e t ct ->
+  match t with
+  | Rnode (l, e', r) ->
+      if e < e' then ins e l (CRed (e', RightD, r, ct))
+                else ins e r (CRed (e', LeftD, l, ct))
+  | Bnode (l, e', r) ->
+      if e < e' then ins e l (CBlk (e', RightD, r, ct))
+                else ins e r (CBlk (e', LeftD, l, ct))
+  | Bleaf -> repair (Rnode (Bleaf, e, Bleaf)) ct
+;;
+[%%expect{|
+val ins : int -> ('c, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = 
+|}];;
+let insert e (Root t) = ins e t CNil
+;;
+[%%expect{|
+val insert : int -> rb_tree -> rb_tree = 
+|}];;
+
+(* 5.7 typed object languages using GADTs *)
+
+type _ term =
+  | Const : int -> int term
+  | Add   : (int * int -> int) term
+  | LT    : (int * int -> bool) term
+  | Ap    : ('a -> 'b) term * 'a term -> 'b term
+  | Pair  : 'a term * 'b term -> ('a * 'b) term
+
+let ex1 = Ap (Add, Pair (Const 3, Const 5))
+let ex2 = Pair (ex1, Const 1)
+;;
+[%%expect{|
+type _ term =
+    Const : int -> int term
+  | Add : (int * int -> int) term
+  | LT : (int * int -> bool) term
+  | Ap : ('a -> 'b) term * 'a term -> 'b term
+  | Pair : 'a term * 'b term -> ('a * 'b) term
+val ex1 : int term = Ap (Add, Pair (Const 3, Const 5))
+val ex2 : (int * int) term =
+  Pair (Ap (Add, Pair (Const 3, Const 5)), Const 1)
+|}];;
+
+let rec eval_term : type a. a term -> a = function
+  | Const x -> x
+  | Add -> fun (x,y) -> x+y
+  | LT  -> fun (x,y) -> x eval_term f (eval_term x)
+  | Pair(x,y) -> (eval_term x, eval_term y)
+;;
+[%%expect{|
+val eval_term : 'a term -> 'a = 
+|}];;
+
+type _ rep =
+  | Rint  : int rep
+  | Rbool : bool rep
+  | Rpair : 'a rep * 'b rep -> ('a * 'b) rep
+  | Rfun  : 'a rep * 'b rep -> ('a -> 'b) rep
+
+type (_,_) equal = Eq : ('a,'a) equal
+
+let rec rep_equal : type a b. a rep -> b rep -> (a, b) equal option =
+  fun ra rb ->
+  match ra, rb with
+  | Rint, Rint -> Some Eq
+  | Rbool, Rbool -> Some Eq
+  | Rpair (a1, a2), Rpair (b1, b2) ->
+      begin match rep_equal a1 b1 with
+      | None -> None
+      | Some Eq -> match rep_equal a2 b2 with
+        | None -> None
+        | Some Eq -> Some Eq
+      end
+  | Rfun (a1, a2), Rfun (b1, b2) ->
+      begin match rep_equal a1 b1 with
+      | None -> None
+      | Some Eq -> match rep_equal a2 b2 with
+        | None -> None
+        | Some Eq -> Some Eq
+      end
+  | _ -> None
+;;
+[%%expect{|
+type _ rep =
+    Rint : int rep
+  | Rbool : bool rep
+  | Rpair : 'a rep * 'b rep -> ('a * 'b) rep
+  | Rfun : 'a rep * 'b rep -> ('a -> 'b) rep
+type (_, _) equal = Eq : ('a, 'a) equal
+val rep_equal : 'a rep -> 'b rep -> ('a, 'b) equal option = 
+|}];;
+
+type assoc = Assoc : string * 'a rep * 'a -> assoc
+
+let rec assoc : type a. string -> a rep -> assoc list -> a =
+  fun x r -> function
+  | [] -> raise Not_found
+  | Assoc (x', r', v) :: env ->
+      if x = x' then
+        match rep_equal r r' with
+        | None -> failwith ("Wrong type for " ^ x)
+        | Some Eq -> v
+      else assoc x r env
+;;
+[%%expect{|
+type assoc = Assoc : string * 'a rep * 'a -> assoc
+val assoc : string -> 'a rep -> assoc list -> 'a = 
+|}];;
+
+type _ term =
+  | Var   : string * 'a rep -> 'a term
+  | Abs   : string * 'a rep * 'b term -> ('a -> 'b) term
+  | Const : int -> int term
+  | Add   : (int * int -> int) term
+  | LT    : (int * int -> bool) term
+  | Ap    : ('a -> 'b) term * 'a term -> 'b term
+  | Pair  : 'a term * 'b term -> ('a * 'b) term
+
+let rec eval_term : type a. assoc list -> a term -> a =
+  fun env -> function
+  | Var (x, r) -> assoc x r env
+  | Abs (x, r, e) -> fun v -> eval_term (Assoc (x, r, v) :: env) e
+  | Const x -> x
+  | Add -> fun (x,y) -> x+y
+  | LT  -> fun (x,y) -> x eval_term env f (eval_term env x)
+  | Pair(x,y) -> (eval_term env x, eval_term env y)
+;;
+[%%expect{|
+type _ term =
+    Var : string * 'a rep -> 'a term
+  | Abs : string * 'a rep * 'b term -> ('a -> 'b) term
+  | Const : int -> int term
+  | Add : (int * int -> int) term
+  | LT : (int * int -> bool) term
+  | Ap : ('a -> 'b) term * 'a term -> 'b term
+  | Pair : 'a term * 'b term -> ('a * 'b) term
+val eval_term : assoc list -> 'a term -> 'a = 
+|}];;
+
+let ex3 = Abs ("x", Rint, Ap (Add, Pair (Var("x",Rint), Var("x",Rint))))
+let ex4 = Ap (ex3, Const 3)
+
+let v4 = eval_term [] ex4
+;;
+[%%expect{|
+val ex3 : (int -> int) term =
+  Abs ("x", Rint, Ap (Add, Pair (Var ("x", Rint), Var ("x", Rint))))
+val ex4 : int term =
+  Ap (Abs ("x", Rint, Ap (Add, Pair (Var ("x", Rint), Var ("x", Rint)))),
+   Const 3)
+val v4 : int = 6
+|}];;
+
+(* 5.9/5.10 Language with binding *)
+
+type rnil = RNIL
+type ('a,'b,'c) rcons = RCons of 'a * 'b * 'c
+
+type _ is_row =
+  | Rnil  : rnil is_row
+  | Rcons : 'c is_row -> ('a,'b,'c) rcons is_row
+
+type (_,_) lam =
+  | Const : int -> ('e, int) lam
+  | Var : 'a -> (('a,'t,'e) rcons, 't) lam
+  | Shift : ('e,'t) lam -> (('a,'q,'e) rcons, 't) lam
+  | Abs : 'a * (('a,'s,'e) rcons, 't) lam -> ('e, 's -> 't) lam
+  | App : ('e, 's -> 't) lam * ('e, 's) lam -> ('e, 't) lam
+
+type x = X
+type y = Y
+
+let ex1 = App (Var X, Shift (Var Y))
+let ex2 = Abs (X, Abs (Y, App (Shift (Var X), Var Y)))
+;;
+[%%expect{|
+type rnil = RNIL
+type ('a, 'b, 'c) rcons = RCons of 'a * 'b * 'c
+type _ is_row =
+    Rnil : rnil is_row
+  | Rcons : 'c is_row -> ('a, 'b, 'c) rcons is_row
+type (_, _) lam =
+    Const : int -> ('e, int) lam
+  | Var : 'a -> (('a, 't, 'e) rcons, 't) lam
+  | Shift : ('e, 't) lam -> (('a, 'q, 'e) rcons, 't) lam
+  | Abs : 'a * (('a, 's, 'e) rcons, 't) lam -> ('e, 's -> 't) lam
+  | App : ('e, 's -> 't) lam * ('e, 's) lam -> ('e, 't) lam
+type x = X
+type y = Y
+val ex1 : ((x, 'a -> 'b, (y, 'a, 'c) rcons) rcons, 'b) lam =
+  App (Var X, Shift (Var Y))
+val ex2 : ('a, ('b -> 'c) -> 'b -> 'c) lam =
+  Abs (, Abs (, App (Shift (Var ), Var )))
+|}];;
+
+type _ env =
+  | Enil : rnil env
+  | Econs : 'a * 't * 'e env -> ('a, 't, 'e) rcons env
+
+let rec eval_lam : type e t. e env -> (e, t) lam -> t =
+  fun env m ->
+  match env, m with
+  | _, Const n -> n
+  | Econs (_, v, r), Var _ -> v
+  | Econs (_, _, r), Shift e -> eval_lam r e
+  | _, Abs (n, body) -> fun x -> eval_lam (Econs (n, x, env)) body
+  | _, App (f, x)    -> eval_lam env f (eval_lam env x)
+;;
+[%%expect{|
+type _ env =
+    Enil : rnil env
+  | Econs : 'a * 't * 'e env -> ('a, 't, 'e) rcons env
+val eval_lam : 'e env -> ('e, 't) lam -> 't = 
+|}];;
+
+type add = Add
+type suc = Suc
+
+let env0 = Econs (Zero, 0, Econs (Suc, succ, Econs (Add, (+), Enil)))
+
+let _0 : (_, int) lam = Var Zero
+let suc x = App (Shift (Var Suc : (_, int -> int) lam), x)
+let _1 = suc _0
+let _2 = suc _1
+let _3 = suc _2
+let add = Shift (Shift (Var Add : (_, int -> int -> int) lam))
+
+let double = Abs (X, App (App (Shift add, Var X), Var X))
+let ex3 = App (double, _3)
+;;
+[%%expect{|
+type add = Add
+type suc = Suc
+val env0 :
+  (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
+  rcons env = Econs (Zero, 0, Econs (Suc, , Econs (Add, , Enil)))
+val _0 : ((zero, int, 'a) rcons, int) lam = Var Zero
+val suc :
+  (('a, 'b, (suc, int -> int, 'c) rcons) rcons, int) lam ->
+  (('a, 'b, (suc, int -> int, 'c) rcons) rcons, int) lam = 
+val _1 : ((zero, int, (suc, int -> int, '_weak1) rcons) rcons, int) lam =
+  App (Shift (Var Suc), Var Zero)
+val _2 : ((zero, int, (suc, int -> int, '_weak2) rcons) rcons, int) lam =
+  App (Shift (Var Suc), App (Shift (Var Suc), Var Zero))
+val _3 : ((zero, int, (suc, int -> int, '_weak3) rcons) rcons, int) lam =
+  App (Shift (Var Suc),
+   App (Shift (Var Suc), App (Shift (Var Suc), Var Zero)))
+val add :
+  (('a, 'b, ('c, 'd, (add, int -> int -> int, 'e) rcons) rcons) rcons,
+   int -> int -> int)
+  lam = Shift (Shift (Var Add))
+val double :
+  (('a, 'b, ('c, 'd, (add, int -> int -> int, 'e) rcons) rcons) rcons,
+   int -> int)
+  lam =
+  Abs (,
+   App (App (Shift (Shift (Shift (Var Add))), Var ), Var ))
+val ex3 :
+  ((zero, int,
+    (suc, int -> int, (add, int -> int -> int, '_weak4) rcons) rcons)
+   rcons, int)
+  lam =
+  App
+   (Abs (,
+     App (App (Shift (Shift (Shift (Var Add))), Var ), Var )),
+   App (Shift (Var Suc),
+    App (Shift (Var Suc), App (Shift (Var Suc), Var Zero))))
+|}];;
+
+let v3 = eval_lam env0 ex3
+;;
+[%%expect{|
+val v3 : int = 6
+|}];;
+
+(* 5.13: Constructing typing derivations at runtime *)
+
+(* Modified slightly to use the language of 5.10, since this is more fun.
+   Of course this works also with the language of 5.12. *)
+
+type _ rep =
+  | I : int rep
+  | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
+
+let rec compare : type a b. a rep -> b rep -> (string, (a,b) equal) sum =
+  fun a b ->
+  match a, b with
+  | I, I -> Inr Eq
+  | Ar(x,y), Ar(s,t) ->
+      begin match compare x s with
+      | Inl _ as e -> e
+      | Inr Eq -> match compare y t with
+        | Inl _ as e -> e
+        | Inr Eq as e -> e
+      end
+  | I, Ar _ -> Inl "I <> Ar _"
+  | Ar _, I -> Inl "Ar _ <> I"
+;;
+[%%expect{|
+type _ rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
+val compare : 'a rep -> 'b rep -> (string, ('a, 'b) equal) sum = 
+|}];;
+
+type term =
+  | C of int
+  | Ab : string * 'a rep * term -> term
+  | Ap of term * term
+  | V of string
+
+type _ ctx =
+  | Cnil : rnil ctx
+  | Ccons : 't * string * 'x rep * 'e ctx -> ('t,'x,'e) rcons ctx
+;;
+
+type _ checked =
+  | Cerror of string
+  | Cok : ('e,'t) lam * 't rep -> 'e checked
+
+let rec lookup : type e. string -> e ctx -> e checked =
+  fun name ctx ->
+  match ctx with
+  | Cnil -> Cerror ("Name not found: " ^ name)
+  | Ccons (l,s,t,rs) ->
+      if s = name then Cok (Var l,t) else
+      match lookup name rs with
+      | Cerror m -> Cerror m
+      | Cok (v, t) -> Cok (Shift v, t)
+;;
+[%%expect{|
+type term =
+    C of int
+  | Ab : string * 'a rep * term -> term
+  | Ap of term * term
+  | V of string
+type _ ctx =
+    Cnil : rnil ctx
+  | Ccons : 't * string * 'x rep * 'e ctx -> ('t, 'x, 'e) rcons ctx
+type _ checked = Cerror of string | Cok : ('e, 't) lam * 't rep -> 'e checked
+val lookup : string -> 'e ctx -> 'e checked = 
+|}];;
+
+let rec tc : type n e. n nat -> e ctx -> term -> e checked =
+  fun n ctx t ->
+  match t with
+  | V s -> lookup s ctx
+  | Ap(f,x) ->
+      begin match tc n ctx f with
+      | Cerror _ as e -> e
+      | Cok (f', ft) -> match tc n ctx x with
+        | Cerror _ as e -> e
+        | Cok (x', xt) ->
+            match ft with
+            | Ar (a, b) ->
+                begin match compare a xt with
+                | Inl s -> Cerror s
+                | Inr Eq -> Cok (App (f',x'), b)
+                end
+            | _ -> Cerror "Non fun in Ap"
+      end
+  | Ab(s,t,body) ->
+      begin match tc (NS n) (Ccons (n, s, t, ctx)) body with
+      | Cerror _ as e -> e
+      | Cok (body', et) -> Cok (Abs (n, body'), Ar (t, et))
+      end
+  | C m -> Cok (Const m, I)
+;;
+[%%expect{|
+val tc : 'n nat -> 'e ctx -> term -> 'e checked = 
+|}];;
+
+let ctx0 =
+  Ccons (Zero, "0", I,
+         Ccons (Suc, "S", Ar(I,I),
+                Ccons (Add, "+", Ar(I,Ar(I,I)), Cnil)))
+
+let ex1 = Ab ("x", I, Ap(Ap(V"+",V"x"),V"x"));;
+let c1 = tc NZ ctx0 ex1;;
+let ex2 = Ap (ex1, C 3);;
+let c2 = tc NZ ctx0 ex2;;
+[%%expect{|
+val ctx0 :
+  (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
+  rcons ctx =
+  Ccons (Zero, "0", I,
+   Ccons (Suc, "S", Ar (I, I), Ccons (Add, "+", Ar (I, Ar (I, I)), Cnil)))
+val ex1 : term = Ab ("x", I, Ap (Ap (V "+", V "x"), V "x"))
+val c1 :
+  (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
+  rcons checked =
+  Cok
+   (Abs (,
+     App (App (Shift (Shift (Shift (Var Add))), Var ), Var )),
+   Ar (I, I))
+val ex2 : term = Ap (Ab ("x", I, Ap (Ap (V "+", V "x"), V "x")), C 3)
+val c2 :
+  (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
+  rcons checked =
+  Cok
+   (App
+     (Abs (,
+       App (App (Shift (Shift (Shift (Var Add))), Var ), Var )),
+     Const 3),
+   I)
+|}];;
+
+let eval_checked env = function
+  | Cerror s -> failwith s
+  | Cok (e, I) -> (eval_lam env e : int)
+  | Cok _ -> failwith "Can only evaluate expressions of type I"
+;;
+[%%expect{|
+val eval_checked : 'a env -> 'a checked -> int = 
+|}];;
+
+let v2 = eval_checked env0 c2 ;;
+[%%expect{|
+val v2 : int = 6
+|}];;
+
+(* 5.12 Soundness *)
+
+type pexp = PEXP
+type pval = PVAL
+type _ mode =
+  | Pexp : pexp mode
+  | Pval : pval mode
+
+type ('a,'b) tarr = TARR
+type tint = TINT
+
+type (_,_) rel =
+  | IntR : (tint, int) rel
+  | IntTo : ('b, 's) rel -> ((tint, 'b) tarr, int -> 's) rel
+
+type (_,_,_) lam =
+  | Const : ('a,'b) rel * 'b -> (pval, 'env, 'a) lam
+  | Var : 'a -> (pval, ('a,'t,'e) rcons, 't) lam
+  | Shift : ('m,'e,'t) lam -> ('m, ('a,'q,'e) rcons, 't) lam
+  | Lam : 'a * ('m, ('a,'s,'e) rcons, 't) lam -> (pval, 'e, ('s,'t) tarr) lam
+  | App : ('m1, 'e, ('s,'t) tarr) lam * ('m2, 'e, 's) lam -> (pexp, 'e, 't) lam
+;;
+
+let ex1 = App (Lam (X, Var X), Const (IntR, 3))
+[%%expect{|
+type pexp = PEXP
+type pval = PVAL
+type _ mode = Pexp : pexp mode | Pval : pval mode
+type ('a, 'b) tarr = TARR
+type tint = TINT
+type (_, _) rel =
+    IntR : (tint, int) rel
+  | IntTo : ('b, 's) rel -> ((tint, 'b) tarr, int -> 's) rel
+type (_, _, _) lam =
+    Const : ('a, 'b) rel * 'b -> (pval, 'env, 'a) lam
+  | Var : 'a -> (pval, ('a, 't, 'e) rcons, 't) lam
+  | Shift : ('m, 'e, 't) lam -> ('m, ('a, 'q, 'e) rcons, 't) lam
+  | Lam : 'a *
+      ('m, ('a, 's, 'e) rcons, 't) lam -> (pval, 'e, ('s, 't) tarr) lam
+  | App : ('m1, 'e, ('s, 't) tarr) lam *
+      ('m2, 'e, 's) lam -> (pexp, 'e, 't) lam
+val ex1 : (pexp, 'a, tint) lam =
+  App (Lam (, Var ), Const (IntR, ))
+|}];;
+
+let rec mode : type m e t. (m,e,t) lam -> m mode = function
+  | Lam (v, body) -> Pval
+  | Var v -> Pval
+  | Const (r, v) -> Pval
+  | Shift e -> mode e
+  | App _ -> Pexp
+;;
+[%%expect{|
+val mode : ('m, 'e, 't) lam -> 'm mode = 
+|}];;
+
+type (_,_) sub =
+  | Id : ('r,'r) sub
+  | Bind : 't * ('m,'r2,'x) lam * ('r,'r2) sub -> (('t,'x,'r) rcons, 'r2) sub
+  | Push : ('r1,'r2) sub -> (('a,'b,'r1) rcons, ('a,'b,'r2) rcons) sub
+
+type (_,_) lam' = Ex : ('m, 's, 't) lam -> ('s,'t) lam'
+;;
+
+let rec subst : type m1 r t s. (m1,r,t) lam -> (r,s) sub -> (s,t) lam' =
+  fun t s ->
+  match t, s with
+  | _, Id -> Ex t
+  | Const(r,c), sub -> Ex (Const (r,c))
+  | Var v, Bind (x, e, r) -> Ex e
+  | Var v, Push sub -> Ex (Var v)
+  | Shift e, Bind (_, _, r) -> subst e r
+  | Shift e, Push sub ->
+      (match subst e sub with Ex a -> Ex (Shift a))
+  | App(f,x), sub ->
+      (match subst f sub, subst x sub with Ex g, Ex y -> Ex (App (g,y)))
+  | Lam(v,x), sub ->
+      (match subst x (Push sub) with Ex body -> Ex (Lam (v, body)))
+;;
+[%%expect{|
+type (_, _) sub =
+    Id : ('r, 'r) sub
+  | Bind : 't * ('m, 'r2, 'x) lam *
+      ('r, 'r2) sub -> (('t, 'x, 'r) rcons, 'r2) sub
+  | Push : ('r1, 'r2) sub -> (('a, 'b, 'r1) rcons, ('a, 'b, 'r2) rcons) sub
+type (_, _) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam'
+val subst : ('m1, 'r, 't) lam -> ('r, 's) sub -> ('s, 't) lam' = 
+|}];;
+
+type closed = rnil
+
+type 'a rlam = ((pexp,closed,'a) lam, (pval,closed,'a) lam) sum ;;
+
+let rec rule : type a b.
+  (pval, closed, (a,b) tarr) lam -> (pval, closed, a) lam -> b rlam =
+  fun v1 v2 ->
+  match v1, v2 with
+  | Lam(x,body), v ->
+      begin
+        match subst body (Bind (x, v, Id)) with Ex term ->
+        match mode term with
+        | Pexp -> Inl term
+        | Pval -> Inr term
+      end
+  | Const (IntTo b, f), Const (IntR, x) ->
+      Inr (Const (b, f x))
+;;
+[%%expect{|
+type closed = rnil
+type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
+val rule :
+  (pval, closed, ('a, 'b) tarr) lam -> (pval, closed, 'a) lam -> 'b rlam =
+  
+|}];;
+
+let rec onestep : type m t. (m,closed,t) lam -> t rlam = function
+  | Lam (v, body) -> Inr (Lam (v, body))
+  | Const (r, v)  -> Inr (Const (r, v))
+  | App (e1, e2) ->
+      match mode e1, mode e2 with
+      | Pexp, _->
+          begin match onestep e1 with
+          | Inl e -> Inl(App(e,e2))
+          | Inr v -> Inl(App(v,e2))
+          end
+      | Pval, Pexp ->
+          begin match onestep e2 with
+          | Inl e -> Inl(App(e1,e))
+          | Inr v -> Inl(App(e1,v))
+          end
+      | Pval, Pval -> rule e1 e2
+;;
+[%%expect{|
+val onestep : ('m, closed, 't) lam -> 't rlam = 
+|}];;
diff --git a/testsuite/tests/typing-gadts/or_patterns.ml b/testsuite/tests/typing-gadts/or_patterns.ml
new file mode 100644
index 00000000..6fc7f8c2
--- /dev/null
+++ b/testsuite/tests/typing-gadts/or_patterns.ml
@@ -0,0 +1,757 @@
+(* TEST
+   * expect
+*)
+
+type _ t =
+  | IntLit : int t
+  | BoolLit : bool t
+;;
+
+[%%expect{|
+type _ t = IntLit : int t | BoolLit : bool t
+|}]
+
+let trivial t =
+  match t with
+  | IntLit -> ()
+  | BoolLit -> ()
+;;
+
+[%%expect{|
+Line 4, characters 4-11:
+4 |   | BoolLit -> ()
+        ^^^^^^^
+Error: This pattern matches values of type bool t
+       but a pattern was expected which matches values of type int t
+       Type bool is not compatible with type int
+|}]
+
+let trivial_annotated (type a) (t : a t) =
+  match t with
+  | IntLit -> ()
+  | BoolLit -> ()
+;;
+
+[%%expect{|
+val trivial_annotated : 'a t -> unit = 
+|}]
+
+let trivial_merged t =
+  match t with
+  | IntLit
+  | BoolLit -> ()
+;;
+
+[%%expect{|
+Line 4, characters 4-11:
+4 |   | BoolLit -> ()
+        ^^^^^^^
+Error: This pattern matches values of type bool t
+       but a pattern was expected which matches values of type int t
+       Type bool is not compatible with type int
+|}]
+
+let trivial_merged_annotated (type a) (t : a t) =
+  match t with
+  | IntLit
+  | BoolLit -> ()
+;;
+
+[%%expect{|
+val trivial_merged_annotated : 'a t -> unit = 
+|}]
+
+let trivial_merged_annotated_under_tuple1 (type a) (t : a t) =
+  match (3, t) with
+  | _, (IntLit
+       | BoolLit) -> ()
+;;
+
+[%%expect{|
+val trivial_merged_annotated_under_tuple1 : 'a t -> unit = 
+|}]
+
+let trivial_merged_annotated_under_tuple2 (type a) (tt : a t * a t) =
+  match tt with
+  | IntLit, (IntLit | BoolLit) -> ()
+  | _ -> ()
+;;
+
+[%%expect{|
+Line 3, characters 22-29:
+3 |   | IntLit, (IntLit | BoolLit) -> ()
+                          ^^^^^^^
+Error: This pattern matches values of type bool t
+       but a pattern was expected which matches values of type a t
+       Type bool is not compatible with type a = int
+|}]
+
+let trivial_merged_annotated_under_tuple2 (type a) (tt : a t * a t) =
+  match tt with
+  | (IntLit | BoolLit), IntLit -> ()
+  | _ -> ()
+;;
+
+[%%expect{|
+val trivial_merged_annotated_under_tuple2 : 'a t * 'a t -> unit = 
+|}]
+
+
+let trivial_merged_annotated_under_array (type a) (t : a t array) =
+  match t with
+  | [| (IntLit | BoolLit); _ |] -> ()
+  | [| _; _; (BoolLit | IntLit) |] -> ()
+  | [| _; _; _; (BoolLit | IntLit) |]
+  | [| _; _; _; (BoolLit | IntLit); _ |] -> ()
+  | _ -> ()
+;;
+
+[%%expect{|
+val trivial_merged_annotated_under_array : 'a t array -> unit = 
+|}]
+
+let simple t a =
+  match t, a with
+  | IntLit, 3 -> ()
+  | BoolLit, true -> ()
+  | _, _ -> ()
+;;
+
+[%%expect{|
+Line 4, characters 4-11:
+4 |   | BoolLit, true -> ()
+        ^^^^^^^
+Error: This pattern matches values of type bool t
+       but a pattern was expected which matches values of type int t
+       Type bool is not compatible with type int
+|}, Principal{|
+Line 4, characters 4-17:
+4 |   | BoolLit, true -> ()
+        ^^^^^^^^^^^^^
+Error: This pattern matches values of type bool t * bool
+       but a pattern was expected which matches values of type int t * int
+       Type bool is not compatible with type int
+|}]
+
+let simple_annotated (type a) (t : a t) (a : a) =
+  match t, a with
+  | IntLit, 3 -> ()
+  | BoolLit, true -> ()
+  | _, _ -> ()
+;;
+
+[%%expect{|
+val simple_annotated : 'a t -> 'a -> unit = 
+|}]
+
+let simple_merged t a =
+  match t, a with
+  | IntLit, 3
+  | BoolLit, true -> ()
+  | _, _ -> ()
+;;
+
+[%%expect{|
+Line 4, characters 4-11:
+4 |   | BoolLit, true -> ()
+        ^^^^^^^
+Error: This pattern matches values of type bool t
+       but a pattern was expected which matches values of type int t
+       Type bool is not compatible with type int
+|}]
+
+let simple_merged_ambi (type a) (t : a t) a =
+  match t, a with
+  | IntLit, (3 : a)
+  | BoolLit, true -> ()
+  | _, _ -> ()
+;;
+
+[%%expect{|
+Line 4, characters 13-17:
+4 |   | BoolLit, true -> ()
+                 ^^^^
+Error: This pattern matches values of type bool
+       but a pattern was expected which matches values of type a = bool
+       This instance of bool is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+
+let simple_merged_not_annotated_enough (type a) (t : a t) a =
+  match t, a with
+  | IntLit, 3
+  | BoolLit, true -> ()
+  | _, _ -> ()
+;;
+
+[%%expect{|
+Line 4, characters 13-17:
+4 |   | BoolLit, true -> ()
+                 ^^^^
+Error: This pattern matches values of type bool
+       but a pattern was expected which matches values of type int
+|}]
+
+
+let simple_merged_annotated (type a) (t : a t) (a : a) =
+  match t, a with
+  | IntLit, 3
+  | BoolLit, true -> ()
+  | _, _ -> ()
+;;
+
+[%%expect{|
+val simple_merged_annotated : 'a t -> 'a -> unit = 
+|}]
+
+let simple_mega_merged_annotated (type a) (t : a t) (a : a) =
+  match t, a with
+  | IntLit, 3
+  | BoolLit, true
+  | _, _ -> ()
+;;
+
+[%%expect{|
+val simple_mega_merged_annotated : 'a t -> 'a -> unit = 
+|}]
+
+let simple_merged_annotated_return (type a) (t : a t) (a : a) =
+  match t, a with
+  | IntLit, (3 as x)
+  | BoolLit, (true as x) -> ignore x
+  | _, _ -> ()
+;;
+
+[%%expect{|
+Line 3, characters 12-20:
+3 |   | IntLit, (3 as x)
+                ^^^^^^^^
+Error: This pattern matches values of type a
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+let simple_merged_annotated_return_annotated (type a) (t : a t) (a : a) =
+  match t, a with
+  | IntLit, ((3 : a) as x)
+  | BoolLit, ((true : a) as x) -> ignore x
+  | _, _ -> ()
+;;
+
+[%%expect{|
+Lines 3-4, characters 4-30:
+3 | ....IntLit, ((3 : a) as x)
+4 |   | BoolLit, ((true : a) as x)............
+Error: The variable x on the left-hand side of this or-pattern has type
+       a but on the right-hand side it has type bool
+|}]
+
+(* test more scenarios: when the or-pattern itself is not at toplevel but under
+   other patterns. *)
+
+let simple_merged_annotated_under_tuple (type a) (pair : a t * a) =
+  match (), pair with
+  | (), ( IntLit, 3
+        | BoolLit, true) -> ()
+  | _, _ -> ()
+;;
+
+[%%expect{|
+val simple_merged_annotated_under_tuple : 'a t * 'a -> unit = 
+|}]
+
+let simple_merged_annotated_under_arrays (type a) (pair : a t * a) =
+  match [| [| pair |] |] with
+  | [| _ ; [| ( IntLit, 3
+              | BoolLit, true) |] |] -> ()
+  | _ -> ()
+;;
+
+[%%expect{|
+val simple_merged_annotated_under_arrays : 'a t * 'a -> unit = 
+|}]
+
+
+let simple_merged_annotated_under_poly_variant (type a) (pair : a t * a) =
+  match `Foo pair with
+  | `Foo ( IntLit, 3
+         | BoolLit, true ) -> ()
+  | _ -> ()
+;;
+
+[%%expect{|
+val simple_merged_annotated_under_poly_variant : 'a t * 'a -> unit = 
+|}]
+
+let simple_merged_annotated_under_poly_variant_annotated (type a) pair =
+  match (`Foo pair : [ `Foo of (a t * a) ]) with
+  | `Foo ( IntLit, 3
+         | BoolLit, true ) -> ()
+  | _ -> ()
+;;
+
+[%%expect{|
+val simple_merged_annotated_under_poly_variant_annotated : 'a t * 'a -> unit =
+  
+|}]
+
+type 'a iref = { content : 'a; };;
+[%%expect{|
+type 'a iref = { content : 'a; }
+|}]
+
+let simple_merged_annotated_under_record (type a) (pair : a t * a) =
+  match { content = pair } with
+  | { content = ( IntLit, 3
+                | BoolLit, true ) } -> ()
+  | _ -> ()
+;;
+[%%expect{|
+val simple_merged_annotated_under_record : 'a t * 'a -> unit = 
+|}]
+
+let simple_merged_annotated_under_mutable_record (type a) (pair : a t * a) =
+  match { contents = pair } with
+  | { contents = ( IntLit, 3
+                 | BoolLit, true ) } -> ()
+  | _ -> ()
+;;
+[%%expect{|
+val simple_merged_annotated_under_mutable_record : 'a t * 'a -> unit = 
+|}]
+
+type 'a piref = { pcontent : 'b. 'a * 'b; };;
+[%%expect{|
+type 'a piref = { pcontent : 'b. 'a * 'b; }
+|}]
+
+let simple_merged_annotated_under_poly_record1 (type a) (r : (a t * a) piref) =
+  match r with
+  | { pcontent = ( IntLit, 3
+                 | BoolLit, true ), _ } -> ()
+  | _ -> ()
+;;
+[%%expect{|
+val simple_merged_annotated_under_poly_record1 : ('a t * 'a) piref -> unit =
+  
+|}]
+
+let simple_merged_annotated_under_poly_record2 (type a) (r : (a t * a) piref) =
+  match r with
+  | { pcontent = ( (IntLit, 3), _
+                 | (BoolLit, true), _ ) } -> ()
+  | _ -> ()
+;;
+[%%expect{|
+val simple_merged_annotated_under_poly_record2 : ('a t * 'a) piref -> unit =
+  
+|}]
+
+let simple_merged_annotated_under_constructor (type a) (pair : a t * a) =
+  match Some pair with
+  | Some ( IntLit, 3
+         | BoolLit, true ) -> ()
+  | _ -> ()
+;;
+[%%expect{|
+val simple_merged_annotated_under_constructor : 'a t * 'a -> unit = 
+|}]
+
+type _ gadt_opt =
+  | GNone : 'a gadt_opt
+  | GSome : 'a -> 'a gadt_opt
+;;
+[%%expect{|
+type _ gadt_opt = GNone : 'a gadt_opt | GSome : 'a -> 'a gadt_opt
+|}]
+
+let simple_merged_annotated_under_gadt_constructor (type a) (pair : a t * a) =
+  match GSome pair with
+  | GSome ( IntLit, 3
+          | BoolLit, true ) -> ()
+  | _ -> ()
+;;
+[%%expect{|
+val simple_merged_annotated_under_gadt_constructor : 'a t * 'a -> unit =
+  
+|}]
+
+(* back to simpler tests. *)
+
+let noop t a =
+  match t, a with
+  | IntLit, x -> x
+  | BoolLit, x -> x
+;;
+
+[%%expect{|
+Line 4, characters 4-11:
+4 |   | BoolLit, x -> x
+        ^^^^^^^
+Error: This pattern matches values of type bool t
+       but a pattern was expected which matches values of type int t
+       Type bool is not compatible with type int
+|}, Principal{|
+Line 4, characters 4-14:
+4 |   | BoolLit, x -> x
+        ^^^^^^^^^^
+Error: This pattern matches values of type bool t * 'a
+       but a pattern was expected which matches values of type int t * 'b
+       Type bool is not compatible with type int
+|}]
+
+let noop_annotated (type a) (t : a t) (a : a) : a =
+  match t, a with
+  | IntLit, x -> x
+  | BoolLit, x -> x
+;;
+
+[%%expect{|
+val noop_annotated : 'a t -> 'a -> 'a = 
+|}]
+
+let noop_merged t a =
+  match t, a with
+  | IntLit, x
+  | BoolLit, x -> x
+;;
+
+[%%expect{|
+Line 4, characters 4-11:
+4 |   | BoolLit, x -> x
+        ^^^^^^^
+Error: This pattern matches values of type bool t
+       but a pattern was expected which matches values of type int t
+       Type bool is not compatible with type int
+|}]
+
+let noop_merged_annotated (type a) (t : a t) (a : a) : a =
+  match t, a with
+  | IntLit, x
+  | BoolLit, x -> x
+;;
+
+[%%expect{|
+val noop_merged_annotated : 'a t -> 'a -> 'a = 
+|}]
+
+(***)
+
+type _ t2 =
+  | Int : int -> int t2
+  | Bool : bool -> bool t2
+
+[%%expect{|
+type _ t2 = Int : int -> int t2 | Bool : bool -> bool t2
+|}]
+
+let trivial2 t2 =
+  match t2 with
+  | Int _ -> ()
+  | Bool _ -> ()
+;;
+
+[%%expect{|
+Line 4, characters 4-10:
+4 |   | Bool _ -> ()
+        ^^^^^^
+Error: This pattern matches values of type bool t2
+       but a pattern was expected which matches values of type int t2
+       Type bool is not compatible with type int
+|}]
+
+let trivial2_annotated (type a) (t2 : a t2) =
+  match t2 with
+  | Int _ -> ()
+  | Bool _ -> ()
+;;
+
+[%%expect{|
+val trivial2_annotated : 'a t2 -> unit = 
+|}]
+
+let trivial2_merged t2 =
+  match t2 with
+  | Int _
+  | Bool _ -> ()
+;;
+
+[%%expect{|
+Line 4, characters 4-10:
+4 |   | Bool _ -> ()
+        ^^^^^^
+Error: This pattern matches values of type bool t2
+       but a pattern was expected which matches values of type int t2
+       Type bool is not compatible with type int
+|}]
+
+let trivial2_merged_annotated (type a) (t2 : a t2) =
+  match t2 with
+  | Int _
+  | Bool _ -> ()
+;;
+
+[%%expect{|
+val trivial2_merged_annotated : 'a t2 -> unit = 
+|}]
+
+
+let extract t2 =
+  match t2 with
+  | Int _ -> x
+  | Bool _ -> x
+;;
+
+[%%expect{|
+Line 4, characters 4-10:
+4 |   | Bool _ -> x
+        ^^^^^^
+Error: This pattern matches values of type bool t2
+       but a pattern was expected which matches values of type int t2
+       Type bool is not compatible with type int
+|}]
+
+let extract_annotated (type a) (t2 : a t2) : a =
+  match t2 with
+  | Int x -> x
+  | Bool x -> x
+;;
+
+[%%expect{|
+val extract_annotated : 'a t2 -> 'a = 
+|}]
+
+let extract_merged t2 =
+  match t2 with
+  | Int x
+  | Bool x -> x
+;;
+
+[%%expect{|
+Line 4, characters 4-10:
+4 |   | Bool x -> x
+        ^^^^^^
+Error: This pattern matches values of type bool t2
+       but a pattern was expected which matches values of type int t2
+       Type bool is not compatible with type int
+|}]
+
+let extract_merged_annotated (type a) (t2 : a t2) : a =
+  match t2 with
+  | Int x
+  | Bool x -> x
+;;
+
+
+[%%expect{|
+Lines 3-4, characters 4-10:
+3 | ....Int x
+4 |   | Bool x.....
+Error: The variable x on the left-hand side of this or-pattern has type
+       int but on the right-hand side it has type bool
+|}]
+
+let extract_merged_super_annotated (type a) (t2 : a t2) : a =
+  match t2 with
+  | Int (x : a)
+  | Bool (x : a) -> x
+;;
+
+[%%expect{|
+val extract_merged_super_annotated : 'a t2 -> 'a = 
+|}]
+
+let extract_merged_too_lightly_annotated (type a) (t2 : a t2) : a =
+  match t2 with
+  | Int (x : a)
+  | Bool x -> x
+;;
+
+[%%expect{|
+Lines 3-4, characters 4-10:
+3 | ....Int (x : a)
+4 |   | Bool x.....
+Error: The variable x on the left-hand side of this or-pattern has type
+       a but on the right-hand side it has type bool
+|}]
+
+let extract_merged_super_lightly_annotated (type a) (t2 : a t2) =
+  match t2 with
+  | Int (x : a)
+  | Bool (x : a) -> x
+;;
+
+[%%expect{|
+val extract_merged_super_lightly_annotated : 'a t2 -> 'a = 
+|}]
+
+let lambiguity (type a) (t2 : a t2) =
+  match t2 with
+  | Int ((_ : a) as x)
+  | Bool (x : a) -> x
+;;
+
+[%%expect{|
+Line 3, characters 8-22:
+3 |   | Int ((_ : a) as x)
+            ^^^^^^^^^^^^^^
+Error: This pattern matches values of type a
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+let rambiguity (type a) (t2 : a t2) =
+  match t2 with
+  | Int (_ as x)
+  | Bool ((_ : a) as x) -> x
+;;
+
+[%%expect{|
+Line 4, characters 9-23:
+4 |   | Bool ((_ : a) as x) -> x
+             ^^^^^^^^^^^^^^
+Error: This pattern matches values of type a
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+
+(***)
+
+type _ t3 =
+  | A : int t3
+  | B : int t3
+
+[%%expect{|
+type _ t3 = A : int t3 | B : int t3
+|}]
+
+(* This was always allowed as the branches can unify. *)
+let not_annotated x =
+  match x with
+  | A | B -> 3
+;;
+
+[%%expect{|
+val not_annotated : int t3 -> int = 
+|}]
+
+let return_int (type a) (x : a t3) =
+  match x with
+  | A | B -> 3
+;;
+
+[%%expect{|
+val return_int : 'a t3 -> int = 
+|}]
+
+let return_a (type a) (x : a t3) : a =
+  match x with
+  | A | B -> 3 (* fails because the equation [a = int] doesn't escape any of
+                  the branches of this or-pattern. *)
+;;
+
+[%%expect{|
+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
+|}]
+
+(* Making sure we don't break a frequent pattern of GADTs indexed by polymorphic
+   variants, where or-patterns were already accepted under or-patterns. *)
+
+type any = [ `A | `B | `C | `D | `E | `F ]
+
+type voyel = [ `A | `E ]
+
+type _ letter =
+  | A : [< any > `A ] letter
+  | B : [< any > `B ] letter
+  | C : [< any > `C ] letter
+  | D : [< any > `D ] letter
+  | E : [< any > `E ] letter
+  | F : [< any > `F ] letter
+
+type _ cased =
+  | Up : 'a letter -> ([< any ] as 'a) cased
+  | Lo : 'a letter -> ([< any ] as 'a) cased
+
+type gvoyel = voyel cased
+type a = [ `A ] cased
+;;
+[%%expect{|
+type any = [ `A | `B | `C | `D | `E | `F ]
+type voyel = [ `A | `E ]
+type _ letter =
+    A : [< any > `A ] letter
+  | B : [< any > `B ] letter
+  | C : [< any > `C ] letter
+  | D : [< any > `D ] letter
+  | E : [< any > `E ] letter
+  | F : [< any > `F ] letter
+type _ cased =
+    Up : 'a letter -> ([< any ] as 'a) cased
+  | Lo : 'a letter -> ([< any ] as 'a) cased
+type gvoyel = voyel cased
+type a = [ `A ] cased
+|}]
+
+let gvoyel_of_a : a -> gvoyel = function
+  | Up A | Lo A as a -> a
+;;
+[%%expect{|
+val gvoyel_of_a : a -> gvoyel = 
+|}]
+
+(* Some other illustrations of the issues with as-patterns. *)
+
+let f_ok (type a) (t : a t) (a : bool iref) (b : a iref) =
+  match t, a, b with
+  | IntLit,  ({ content = true } as x), _
+  | BoolLit,  _,                        ({ content = true} as x) -> ignore x
+  | _, _, _ -> ()
+;;
+[%%expect{|
+val f_ok : 'a t -> bool iref -> 'a iref -> unit = 
+|}]
+
+
+let f_amb (type a) (t : a t) (a : bool ref) (b : a ref) =
+  match t, a, b with
+  | IntLit,  ({ contents = true } as x), _
+  | BoolLit,  _,                        ({ contents = true} as x) -> ignore x
+  | _, _, _ -> ()
+;;
+[%%expect{|
+Lines 3-4, characters 4-65:
+3 | ....IntLit,  ({ contents = true } as x), _
+4 |   | BoolLit,  _,                        ({ contents = true} as x)............
+Error: The variable x on the left-hand side of this or-pattern has type
+         bool ref
+       but on the right-hand side it has type a ref
+       Type bool is not compatible with type a
+|}]
+
+(********************************************)
+
+type t =
+  | A : 'a -> t
+  | B : 'a -> t
+;;
+[%%expect{|
+type t = A : 'a -> t | B : 'a -> t
+|}]
+
+let f = function
+  | A x
+  | B x -> ignore x
+;;
+[%%expect{|
+Line 2, characters 6-7:
+2 |   | A x
+          ^
+Error: This pattern matches values of type $A_'a
+       The type constructor $A_'a would escape its scope
+|}]
diff --git a/testsuite/tests/typing-gadts/pr5332.ml b/testsuite/tests/typing-gadts/pr5332.ml
new file mode 100644
index 00000000..f81fff49
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr5332.ml
@@ -0,0 +1,35 @@
+(* TEST
+   * expect
+*)
+
+type ('env, 'a) var =
+ | Zero : ('a * 'env, 'a) var
+ | Succ : ('env, 'a) var -> ('b * 'env, 'a) var
+;;
+type ('env, 'a) typ =
+ | Tint : ('env, int) typ
+ | Tbool : ('env, bool) typ
+ | Tvar : ('env, 'a) var -> ('env, 'a) typ
+;;
+let f : type env a. (env, a) typ -> (env, a) typ -> int = fun ta tb ->
+ match ta, tb with
+   | Tint, Tint -> 0
+   | Tbool, Tbool -> 1
+   | Tvar var, tb -> 2
+   | _ -> .   (* error *)
+;;
+[%%expect{|
+type ('env, 'a) var =
+    Zero : ('a * 'env, 'a) var
+  | Succ : ('env, 'a) var -> ('b * 'env, 'a) var
+type ('env, 'a) typ =
+    Tint : ('env, int) typ
+  | Tbool : ('env, bool) typ
+  | Tvar : ('env, 'a) var -> ('env, 'a) typ
+Line 15, characters 5-6:
+15 |    | _ -> .   (* error *)
+          ^
+Error: This match case could not be refuted.
+       Here is an example of a value that would reach it: (Tint, Tvar Zero)
+|}];;
+(* let x = f Tint (Tvar Zero) ;; *)
diff --git a/testsuite/tests/typing-gadts/pr5689.ml b/testsuite/tests/typing-gadts/pr5689.ml
new file mode 100644
index 00000000..acbb195c
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr5689.ml
@@ -0,0 +1,112 @@
+(* TEST
+   * expect
+*)
+
+type inkind = [ `Link | `Nonlink ]
+
+type _ inline_t =
+   | Text: string -> [< inkind > `Nonlink ] inline_t
+   | Bold: 'a inline_t list -> 'a inline_t
+   | Link: string -> [< inkind > `Link ] inline_t
+   | Mref: string * [ `Nonlink ] inline_t list -> [< inkind > `Link ] inline_t
+;;
+
+let uppercase seq =
+   let rec process: type a. a inline_t -> a inline_t = function
+       | Text txt       -> Text (String.uppercase_ascii txt)
+       | Bold xs        -> Bold (List.map process xs)
+       | Link lnk       -> Link lnk
+       | Mref (lnk, xs) -> Mref (lnk, List.map process xs)
+   in List.map process seq
+;;
+[%%expect{|
+type inkind = [ `Link | `Nonlink ]
+type _ inline_t =
+    Text : string -> [< inkind > `Nonlink ] inline_t
+  | Bold : 'a inline_t list -> 'a inline_t
+  | Link : string -> [< inkind > `Link ] inline_t
+  | Mref : string *
+      [ `Nonlink ] inline_t list -> [< inkind > `Link ] inline_t
+val uppercase : 'a inline_t list -> 'a inline_t list = 
+|}];;
+
+type ast_t =
+   | Ast_Text of string
+   | Ast_Bold of ast_t list
+   | Ast_Link of string
+   | Ast_Mref of string * ast_t list
+;;
+
+let inlineseq_from_astseq seq =
+   let rec process_nonlink = function
+       | Ast_Text txt  -> Text txt
+       | Ast_Bold xs   -> Bold (List.map process_nonlink xs)
+       | _             -> assert false in
+   let rec process_any = function
+       | Ast_Text txt       -> Text txt
+       | Ast_Bold xs        -> Bold (List.map process_any xs)
+       | Ast_Link lnk       -> Link lnk
+       | Ast_Mref (lnk, xs) -> Mref (lnk, List.map process_nonlink xs)
+   in List.map process_any seq
+;;
+[%%expect{|
+type ast_t =
+    Ast_Text of string
+  | Ast_Bold of ast_t list
+  | Ast_Link of string
+  | Ast_Mref of string * ast_t list
+val inlineseq_from_astseq : ast_t list -> inkind inline_t list = 
+|}];;
+
+(* OK *)
+type _ linkp =
+ | Nonlink : [ `Nonlink ] linkp
+ | Maylink : inkind linkp
+;;
+let inlineseq_from_astseq seq =
+ let rec process : type a. a linkp -> ast_t -> a inline_t =
+   fun allow_link ast ->
+     match (allow_link, ast) with
+     | (Maylink, Ast_Text txt)    -> Text txt
+     | (Nonlink, Ast_Text txt)    -> Text txt
+     | (x, Ast_Bold xs)           -> Bold (List.map (process x) xs)
+     | (Maylink, Ast_Link lnk)    -> Link lnk
+     | (Nonlink, Ast_Link _)      -> assert false
+     | (Maylink, Ast_Mref (lnk, xs)) ->
+         Mref (lnk, List.map (process Nonlink) xs)
+     | (Nonlink, Ast_Mref _)      -> assert false
+   in List.map (process Maylink) seq
+;;
+[%%expect{|
+type _ linkp = Nonlink : [ `Nonlink ] linkp | Maylink : inkind linkp
+val inlineseq_from_astseq : ast_t list -> inkind inline_t list = 
+|}];;
+
+(* Bad *)
+type _ linkp2 = Kind : 'a linkp -> ([< inkind ] as 'a) linkp2
+;;
+let inlineseq_from_astseq seq =
+let rec process : type a. a linkp2 -> ast_t -> a inline_t =
+  fun allow_link ast ->
+    match (allow_link, ast) with
+    | (Kind _, Ast_Text txt)    -> Text txt
+    | (x, Ast_Bold xs)           -> Bold (List.map (process x) xs)
+    | (Kind Maylink, Ast_Link lnk)    -> Link lnk
+    | (Kind Nonlink, Ast_Link _)      -> assert false
+    | (Kind Maylink, Ast_Mref (lnk, xs)) ->
+        Mref (lnk, List.map (process (Kind Nonlink)) xs)
+    | (Kind Nonlink, Ast_Mref _)      -> assert false
+  in List.map (process (Kind Maylink)) seq
+;;
+[%%expect{|
+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 ] as 'a) inline_t
+       but an expression was expected of type a inline_t
+       Type 'a = [< `Link | `Nonlink > `Nonlink ] is not compatible with type
+         a = [< `Link | `Nonlink ]
+       The second variant type is bound to $'a,
+       it may not allow the tag(s) `Nonlink
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr5785.ml b/testsuite/tests/typing-gadts/pr5785.ml
new file mode 100644
index 00000000..00420834
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr5785.ml
@@ -0,0 +1,29 @@
+(* TEST
+   * expect
+*)
+
+module Add (T : sig type two end) =
+struct
+  type _ t =
+  | One : [`One] t
+  | Two : T.two t
+
+  let add (type a) : a t * a t -> string = function
+    | One, One -> "two"
+    | Two, Two -> "four"
+end;;
+[%%expect{|
+Lines 7-9, characters 43-24:
+7 | ...........................................function
+8 |     | One, One -> "two"
+9 |     | Two, Two -> "four"
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(Two, One)
+module Add :
+  functor (T : sig type two end) ->
+    sig
+      type _ t = One : [ `One ] t | Two : T.two t
+      val add : 'a t * 'a t -> string
+    end
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr5848.ml b/testsuite/tests/typing-gadts/pr5848.ml
new file mode 100644
index 00000000..1c908d78
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr5848.ml
@@ -0,0 +1,23 @@
+(* TEST
+   * expect
+*)
+
+module B : sig
+ type (_, _) t = Eq: ('a, 'a) t
+ val f: 'a -> 'b -> ('a, 'b) t
+end
+=
+struct
+ type (_, _) t = Eq: ('a, 'a) t
+ let f t1 t2 = Obj.magic Eq
+end;;
+
+let of_type: type a. a -> a = fun x ->
+  match B.f x 4 with
+  | Eq -> 5
+;;
+[%%expect{|
+module B :
+  sig type (_, _) t = Eq : ('a, 'a) t val f : 'a -> 'b -> ('a, 'b) t end
+val of_type : 'a -> 'a = 
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr5906.ml b/testsuite/tests/typing-gadts/pr5906.ml
new file mode 100644
index 00000000..c722ec27
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr5906.ml
@@ -0,0 +1,42 @@
+(* TEST
+   * expect
+*)
+
+type _ constant =
+  | Int: int -> int constant
+  | Bool: bool -> bool constant
+
+type (_, _, _) binop =
+  | Eq: ('a, 'a, bool) binop
+  | Leq: ('a, 'a, bool) binop
+  | Add: (int, int, int) binop
+
+let eval (type a) (type b) (type c) (bop:(a,b,c) binop) (x:a constant)
+         (y:b constant) : c constant =
+  match bop, x, y with
+  | Eq, Bool x, Bool y -> Bool (if x then y else not y)
+  | Leq, Int x, Int y -> Bool (x <= y)
+  | Leq, Bool x, Bool y -> Bool (x <= y)
+  | Add, Int x, Int y -> Int (x + y)
+
+let _ = eval Eq (Int 2) (Int 3)
+
+[%%expect{|
+type _ constant = Int : int -> int constant | Bool : bool -> bool constant
+type (_, _, _) binop =
+    Eq : ('a, 'a, bool) binop
+  | Leq : ('a, 'a, bool) binop
+  | Add : (int, int, int) binop
+Lines 12-16, characters 2-36:
+12 | ..match bop, x, y with
+13 |   | Eq, Bool x, Bool y -> Bool (if x then y else not y)
+14 |   | Leq, Int x, Int y -> Bool (x <= y)
+15 |   | Leq, Bool x, Bool y -> Bool (x <= y)
+16 |   | Add, Int x, Int y -> Int (x + y)
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(Eq, Int _, _)
+val eval : ('a, 'b, 'c) binop -> 'a constant -> 'b constant -> 'c constant =
+  
+Exception: Match_failure ("", 12, 2).
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr5948.ml b/testsuite/tests/typing-gadts/pr5948.ml
new file mode 100644
index 00000000..29547ea6
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr5948.ml
@@ -0,0 +1,59 @@
+(* TEST
+   * expect
+*)
+
+type tag = [`TagA | `TagB | `TagC];;
+
+type 'a poly =
+    AandBTags : [< `TagA of int | `TagB ] poly
+  | ATag : [< `TagA of int] poly
+(* constraint 'a = [< `TagA of int | `TagB] *)
+;;
+
+let intA = function `TagA i -> i
+let intB = function `TagB -> 4
+;;
+
+let intAorB = function
+    `TagA i -> i
+  | `TagB -> 4
+;;
+
+type _ wrapPoly =
+    WrapPoly : 'a poly -> ([< `TagA of int | `TagB] as 'a) wrapPoly
+;;
+
+let example6 : type a. a wrapPoly -> (a -> int) =
+  fun w  ->
+    match w with
+    | WrapPoly ATag -> intA
+    | WrapPoly _ -> intA (* This should not be allowed *)
+;;
+[%%expect{|
+type tag = [ `TagA | `TagB | `TagC ]
+type 'a poly =
+    AandBTags : [< `TagA of int | `TagB ] poly
+  | ATag : [< `TagA of int ] poly
+val intA : [< `TagA of 'a ] -> 'a = 
+val intB : [< `TagB ] -> int = 
+val intAorB : [< `TagA of int | `TagB ] -> int = 
+type _ wrapPoly =
+    WrapPoly : 'a poly -> ([< `TagA of int | `TagB ] as 'a) wrapPoly
+Line 25, characters 23-27:
+25 |     | WrapPoly ATag -> intA
+                            ^^^^
+Error: This expression has type ([< `TagA of 'b ] as 'a) -> 'b
+       but an expression was expected of type a -> int
+       Type [< `TagA of 'b ] as 'a is not compatible with type
+         a = [< `TagA of int | `TagB ]
+       The first variant type does not allow tag(s) `TagB
+|}];;
+
+let _ =  example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *)
+;;
+[%%expect{|
+Line 1, characters 9-17:
+1 | let _ =  example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *)
+             ^^^^^^^^
+Error: Unbound value example6
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr5981.ml b/testsuite/tests/typing-gadts/pr5981.ml
new file mode 100644
index 00000000..9431a1ca
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr5981.ml
@@ -0,0 +1,56 @@
+(* TEST
+   * expect
+*)
+
+module F(S : sig type 'a t end) = struct
+  type _ ab =
+      A : int S.t ab
+    | B : float S.t ab
+
+  let f : int S.t ab -> float S.t ab -> string =
+    fun (l : int S.t ab) (r : float S.t ab) -> match l, r with
+    | A, B -> "f A B"
+end;;
+[%%expect{|
+Lines 7-8, characters 47-21:
+7 | ...............................................match l, r with
+8 |     | A, B -> "f A B"
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(A, A)
+module F :
+  functor (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
+    end
+|}];;
+
+module F(S : sig type 'a t end) = struct
+  type a = int * int
+  type b = int -> int
+
+  type _ ab =
+      A : a S.t ab
+    | B : b S.t ab
+
+  let f : a S.t ab -> b S.t ab -> string =
+    fun l r -> match l, r with
+    | A, B -> "f A B"
+end;;
+[%%expect{|
+Lines 10-11, characters 15-21:
+10 | ...............match l, r with
+11 |     | A, B -> "f A B"
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(A, A)
+module F :
+  functor (S : sig type 'a t end) ->
+    sig
+      type a = int * int
+      type b = int -> int
+      type _ ab = A : a S.t ab | B : b S.t ab
+      val f : a S.t ab -> b S.t ab -> string
+    end
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr5985.ml b/testsuite/tests/typing-gadts/pr5985.ml
new file mode 100644
index 00000000..c8a9c6f2
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr5985.ml
@@ -0,0 +1,203 @@
+(* TEST
+   * expect
+*)
+
+(* Report from Jeremy Yallop *)
+module F (S : sig type 'a s end) = struct
+  include S
+  type _ t = T : 'a -> 'a s t
+end;; (* fail *)
+[%%expect{|
+Line 3, characters 2-29:
+3 |   type _ t = T : 'a -> 'a s t
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable cannot be deduced
+       from the type parameters.
+|}];;
+(*
+module M = F (struct type 'a s = int end) ;;
+let M.T x = M.T 3 in x = true;;
+*)
+
+(* Fix it using #-annotations *)
+(*
+module F (S : sig type #'a s end) = struct
+  include S
+  type _ t = T : 'a -> 'a s t
+end;; (* syntax error *)
+module M = F (struct type 'a s = int end) ;; (* fail *)
+module M = F (struct type 'a s = new int end) ;; (* ok *)
+let M.T x = M.T 3 in x = true;; (* fail *)
+let M.T x = M.T 3 in x = 3;; (* ok *)
+*)
+
+(* Another version using OCaml 2.00 objects *)
+module F(T:sig type 'a t end) = struct
+  class ['a] c x =
+    object constraint 'a = 'b T.t val x' : 'b = x method x = x' end
+end;; (* fail *)
+[%%expect{|
+Lines 2-3, characters 2-67:
+2 | ..class ['a] c x =
+3 |     object constraint 'a = 'b T.t val x' : 'b = x method x = x' end
+Error: In this definition, a type variable cannot be deduced
+       from the type parameters.
+|}];;
+
+(* Another (more direct) instance using polymorphic variants *)
+(* PR#6275 *)
+type 'x t = A of 'a constraint 'x = [< `X of 'a ] ;; (* fail *)
+let magic (x : int) : bool  =
+  let A x = A x in
+  x;; (* fail *)
+[%%expect{|
+Line 1, characters 0-49:
+1 | type 'x t = A of 'a constraint 'x = [< `X of 'a ] ;; (* fail *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable cannot be deduced
+       from the type parameters.
+|}];;
+
+type 'a t = A : 'a -> [< `X of 'a ] t;; (* fail *)
+[%%expect{|
+Line 1, characters 0-37:
+1 | type 'a t = A : 'a -> [< `X of 'a ] t;; (* fail *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable cannot be deduced
+       from the type parameters.
+|}];;
+
+(* It is not OK to allow modules exported by other compilation units *)
+type (_,_) eq = Eq : ('a,'a) eq;;
+let eq = Obj.magic Eq;;
+(* pretend that Queue.t is not injective *)
+let eq : ('a Queue.t, 'b Queue.t) eq = eq;;
+type _ t = T : 'a -> 'a Queue.t t;; (* fail *)
+[%%expect{|
+type (_, _) eq = Eq : ('a, 'a) eq
+val eq : 'a = 
+val eq : ('a Queue.t, 'b Queue.t) eq = Eq
+Line 5, characters 0-33:
+5 | type _ t = T : 'a -> 'a Queue.t t;; (* fail *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable cannot be deduced
+       from the type parameters.
+|}];;
+(*
+let castT (type a) (type b) (x : a t) (e: (a, b) eq) : b t =
+  let Eq = e in (x : b t);;
+let T (x : bool) = castT (T 3) eq;; (* we found a contradiction *)
+*)
+
+(* The following signature should not be accepted *)
+module type S = sig
+  type 'a s
+  type _ t = T : 'a -> 'a s t
+end;; (* fail *)
+[%%expect{|
+Line 3, characters 2-29:
+3 |   type _ t = T : 'a -> 'a s t
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable cannot be deduced
+       from the type parameters.
+|}];;
+(* Otherwise we can write the following *)
+module rec M : (S with type 'a s = unit) = M;;
+[%%expect{|
+Line 1, characters 16-17:
+1 | module rec M : (S with type 'a s = unit) = M;;
+                    ^
+Error: Unbound module type S
+|}];;
+(* For the above reason, we cannot allow the abstract declaration
+   of s and the definition of t to be in the same module, as
+   we could create the signature using [module type of ...] *)
+
+
+(* Another problem with variance *)
+(*
+module M = struct type 'a t = 'a -> unit end;;
+module F(X:sig type #'a t end) =
+  struct type +'a s = S of 'b constraint 'a = 'b X.t end;; (* fail *)
+module N = F(M);;
+let o = N.S (object end);;
+let N.S o' = (o :>  M.t N.s);; (* unsound! *)
+*)
+
+(* And yet another *)
+type 'a q = Q;;
+type +'a t = 'b constraint 'a = 'b q;;
+[%%expect{|
+type 'a q = Q
+Line 2, characters 0-36:
+2 | type +'a t = 'b constraint 'a = 'b q;;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable has a variance that
+       cannot be deduced from the type parameters.
+       It was expected to be unrestricted, but it is covariant.
+|}];;
+(* should fail: we do not know for sure the variance of Queue.t *)
+
+type +'a t = T of 'a;;
+type +'a s = 'b constraint 'a = 'b t;; (* ok *)
+[%%expect{|
+type 'a t = T of 'a
+type +'a s = 'b constraint 'a = 'b t
+|}];;
+type -'a s = 'b constraint 'a = 'b t;; (* fail *)
+[%%expect{|
+Line 1, characters 0-36:
+1 | type -'a s = 'b constraint 'a = 'b t;; (* fail *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable has a variance that
+       is not reflected by its occurrence in type parameters.
+       It was expected to be contravariant, but it is covariant.
+|}];;
+type +'a u = 'a t;;
+type 'a t = T of ('a -> 'a);;
+type -'a s = 'b constraint 'a = 'b t;; (* ok *)
+[%%expect{|
+type 'a u = 'a t
+type 'a t = T of ('a -> 'a)
+type -'a s = 'b constraint 'a = 'b t
+|}];;
+type +'a s = 'b constraint 'a = 'b q t;; (* ok *)
+[%%expect{|
+type +'a s = 'b constraint 'a = 'b q t
+|}];;
+type +'a s = 'b constraint 'a = 'b t q;; (* fail *)
+[%%expect{|
+Line 1, characters 0-38:
+1 | type +'a s = 'b constraint 'a = 'b t q;; (* fail *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable has a variance that
+       cannot be deduced from the type parameters.
+       It was expected to be unrestricted, but it is covariant.
+|}];;
+
+
+(* the problem from lablgtk2 *)
+(*
+module Gobject = struct
+  type -'a obj
+end
+open Gobject;;
+
+class virtual ['a] item_container =
+ object
+   constraint 'a = < as_item : [>`widget] obj; .. >
+   method virtual add : 'a -> unit
+ end;;
+*)
+
+(* Another variance anomaly, should not expand t in g before checking *)
+type +'a t = unit constraint 'a = 'b list;;
+type _ g = G : 'a -> 'a t g;; (* fail *)
+[%%expect{|
+type +'a t = unit constraint 'a = 'b list
+Line 2, characters 0-27:
+2 | type _ g = G : 'a -> 'a t g;; (* fail *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable cannot be deduced
+       from the type parameters.
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr5989.ml b/testsuite/tests/typing-gadts/pr5989.ml
new file mode 100644
index 00000000..def3e533
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr5989.ml
@@ -0,0 +1,65 @@
+(* TEST
+   * expect
+*)
+
+type (_, _) t =
+    Any : ('a, 'b) t
+  | Eq : ('a, 'a) t
+;;
+
+module M :
+sig
+  type s = private [> `A]
+  val eq : (s, [`A | `B]) t
+end =
+struct
+  type s = [`A | `B]
+  let eq = Eq
+end;;
+
+let f : (M.s, [`A | `B]) t -> string = function
+  | Any -> "Any"
+;;
+
+let () = print_endline (f M.eq) ;;
+[%%expect{|
+type (_, _) t = Any : ('a, 'b) t | Eq : ('a, 'a) t
+module M : sig type s = private [> `A ] val eq : (s, [ `A | `B ]) t end
+Lines 16-17, characters 39-16:
+16 | .......................................function
+17 |   | Any -> "Any"
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Eq
+val f : (M.s, [ `A | `B ]) t -> string = 
+Exception: Match_failure ("", 16, 39).
+|}];;
+
+module N :
+sig
+  type s = private < a : int; .. >
+  val eq : (s, ) t
+end =
+struct
+  type s = 
+  let eq = Eq
+end
+;;
+
+let f : (N.s, ) t -> string = function
+  | Any -> "Any"
+;;
+[%%expect{|
+module N :
+  sig
+    type s = private < a : int; .. >
+    val eq : (s, < a : int; b : bool >) t
+  end
+Lines 12-13, characters 49-16:
+12 | .................................................function
+13 |   | Any -> "Any"
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Eq
+val f : (N.s, < a : int; b : bool >) t -> string = 
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr5997.ml b/testsuite/tests/typing-gadts/pr5997.ml
new file mode 100644
index 00000000..27e35b35
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr5997.ml
@@ -0,0 +1,55 @@
+(* TEST
+   * expect
+*)
+
+type (_, _) comp =
+  | Eq : ('a, 'a) comp
+  | Diff : ('a, 'b) comp
+;;
+
+module U = struct type t = T end;;
+
+module M : sig
+  type t = T
+  val comp : (U.t, t) comp
+end = struct
+  include U
+  let comp = Eq
+end;;
+
+match M.comp with | Diff -> false;;
+[%%expect{|
+type (_, _) comp = Eq : ('a, 'a) comp | Diff : ('a, 'b) comp
+module U : sig type t = T end
+module M : sig type t = T val comp : (U.t, t) comp end
+Line 16, characters 0-33:
+16 | match M.comp with | Diff -> false;;
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Eq
+Exception: Match_failure ("", 16, 0).
+|}];;
+
+module U = struct type t = {x : int} end;;
+
+module M : sig
+  type t = {x : int}
+  val comp : (U.t, t) comp
+end = struct
+  include U
+  let comp = Eq
+end;;
+
+match M.comp with | Diff -> false;;
+[%%expect{|
+module U : sig type t = { x : int; } end
+module M : sig type t = { x : int; } val comp : (U.t, t) comp end
+Line 11, characters 0-33:
+11 | match M.comp with | Diff -> false;;
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Eq
+Exception: Match_failure ("", 11, 0).
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr6158.ml b/testsuite/tests/typing-gadts/pr6158.ml
new file mode 100644
index 00000000..711304bb
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr6158.ml
@@ -0,0 +1,25 @@
+(* TEST
+   * expect
+*)
+
+type 'a t = T of 'a
+type 'a s = S of 'a
+
+type (_, _) eq = Refl : ('a, 'a) eq;;
+
+let f : (int s, int t) eq -> unit = function Refl -> ();;
+
+module M (S : sig type 'a t = T of 'a type 'a s = T of 'a end) =
+struct let f : ('a S.s, 'a S.t) eq -> unit = function Refl -> () end;;
+[%%expect{|
+type 'a t = T of 'a
+type 'a s = S of 'a
+type (_, _) eq = Refl : ('a, 'a) eq
+Line 6, characters 45-49:
+6 | let f : (int s, int t) eq -> unit = function Refl -> ();;
+                                                 ^^^^
+Error: This pattern matches values of type (int s, int s) eq
+       but a pattern was expected which matches values of type
+         (int s, int t) eq
+       Type int s is not compatible with type int t
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr6163.ml b/testsuite/tests/typing-gadts/pr6163.ml
new file mode 100644
index 00000000..cf06eaf5
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr6163.ml
@@ -0,0 +1,33 @@
+(* TEST
+   * expect
+*)
+
+type _ nat =
+    Zero : [`Zero] nat
+  | Succ : 'a nat -> [`Succ of 'a] nat;;
+type 'a pre_nat = [`Zero | `Succ of 'a];;
+type aux =
+  | Aux : [`Succ of [<[<[<[`Zero] pre_nat] pre_nat] pre_nat]] nat -> aux;;
+
+let f (Aux x) =
+  match x with
+  | Succ Zero -> "1"
+  | Succ (Succ Zero) -> "2"
+  | Succ (Succ (Succ Zero)) -> "3"
+  | Succ (Succ (Succ (Succ Zero))) -> "4"
+  | _ -> .  (* error *)
+;;
+[%%expect{|
+type _ nat = Zero : [ `Zero ] nat | Succ : 'a nat -> [ `Succ of 'a ] nat
+type 'a pre_nat = [ `Succ of 'a | `Zero ]
+type aux =
+    Aux :
+      [ `Succ of [< [< [< [ `Zero ] pre_nat ] pre_nat ] pre_nat ] ] nat ->
+      aux
+Line 14, characters 4-5:
+14 |   | _ -> .  (* error *)
+         ^
+Error: This match case could not be refuted.
+       Here is an example of a value that would reach it:
+       Succ (Succ (Succ (Succ (Succ Zero))))
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr6174.ml b/testsuite/tests/typing-gadts/pr6174.ml
new file mode 100644
index 00000000..9f672c4f
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr6174.ml
@@ -0,0 +1,15 @@
+(* TEST
+   * expect
+*)
+
+type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t
+let f : type a o. ((a -> o) -> o) t -> (a -> o) -> o =
+ fun C k -> k (fun x -> x);;
+[%%expect{|
+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 = ($2 -> $1) -> $1
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr6241.ml b/testsuite/tests/typing-gadts/pr6241.ml
new file mode 100644
index 00000000..330965f7
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr6241.ml
@@ -0,0 +1,36 @@
+(* TEST
+   * expect
+*)
+
+type (_, _) t =
+ A : ('a, 'a) t
+| B : string -> ('a, 'b) t
+;;
+
+module M (A : sig module type T end) (B : sig module type T end) =
+struct
+ let f : ((module A.T), (module B.T)) t -> string = function
+   | B s -> s
+end;;
+
+module A = struct module type T = sig end end;;
+
+module N = M(A)(A);;
+
+let x = N.f A;;
+
+[%%expect{|
+type (_, _) t = A : ('a, 'a) t | B : string -> ('a, 'b) t
+Lines 8-9, characters 52-13:
+8 | ....................................................function
+9 |    | B s -> s
+Warning 8: this pattern-matching is not exhaustive.
+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) ->
+    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
+Exception: Match_failure ("", 8, 52).
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr6690.ml b/testsuite/tests/typing-gadts/pr6690.ml
new file mode 100644
index 00000000..858547ea
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr6690.ml
@@ -0,0 +1,85 @@
+(* TEST
+   * expect
+*)
+
+type 'a visit_action
+
+type insert
+
+type 'a local_visit_action
+
+type ('a, 'result, 'visit_action) context =
+  | Local : ('a, ('a * insert) as 'result, 'a local_visit_action) context
+  | Global : ('a, 'a, 'a visit_action) context
+;;
+
+let vexpr (type visit_action)
+    : (_, _, visit_action) context -> _ -> visit_action =
+  function
+  | Local -> fun _ -> raise Exit
+  | Global -> fun _ -> raise Exit
+;;
+[%%expect{|
+type 'a visit_action
+type insert
+type 'a local_visit_action
+type ('a, 'result, 'visit_action) context =
+    Local : ('a, 'a * insert, 'a local_visit_action) context
+  | Global : ('a, 'a, 'a visit_action) context
+Line 15, characters 4-9:
+15 |   | Local -> fun _ -> raise Exit
+         ^^^^^
+Error: This pattern matches values of type
+         ($0, $0 * insert, $0 local_visit_action) context
+       but a pattern was expected which matches values of type
+         ($0, $0 * insert, visit_action) context
+       The type constructor $0 would escape its scope
+|}, Principal{|
+type 'a visit_action
+type insert
+type 'a local_visit_action
+type ('a, 'result, 'visit_action) context =
+    Local : ('a, 'a * insert, 'a local_visit_action) context
+  | Global : ('a, 'a, 'a visit_action) context
+Line 15, characters 4-9:
+15 |   | Local -> fun _ -> raise Exit
+         ^^^^^
+Error: This pattern matches values of type
+         ($0, $0 * insert, visit_action) context
+       The type constructor $0 would escape its scope
+|}];;
+
+let vexpr (type visit_action)
+    : ('a, 'result, visit_action) context -> 'a -> visit_action =
+  function
+  | Local -> fun _ -> raise Exit
+  | Global -> fun _ -> raise Exit
+;;
+[%%expect{|
+Line 4, characters 4-9:
+4 |   | Local -> fun _ -> raise Exit
+        ^^^^^
+Error: This pattern matches values of type
+         ($'a, $'a * insert, $'a local_visit_action) context
+       but a pattern was expected which matches values of type
+         ($'a, $'a * insert, visit_action) context
+       The type constructor $'a would escape its scope
+|}, Principal{|
+Line 4, characters 4-9:
+4 |   | Local -> fun _ -> raise Exit
+        ^^^^^
+Error: This pattern matches values of type
+         ($0, $0 * insert, visit_action) context
+       The type constructor $0 would escape its scope
+|}];;
+
+let vexpr (type result) (type visit_action)
+    : (unit, result, visit_action) context -> unit -> visit_action =
+  function
+  | Local -> fun _ -> raise Exit
+  | Global -> fun _ -> raise Exit
+;;
+[%%expect{|
+val vexpr : (unit, 'result, 'visit_action) context -> unit -> 'visit_action =
+  
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr6817.ml b/testsuite/tests/typing-gadts/pr6817.ml
new file mode 100644
index 00000000..64621436
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr6817.ml
@@ -0,0 +1,38 @@
+(* TEST
+   * expect
+*)
+
+module A = struct
+    type nil = Cstr
+  end
+open A
+;;
+
+type _ s =
+  | Nil : nil s
+  | Cons : 't s -> ('h -> 't) s
+
+type ('stack, 'typ) var =
+  | Head : (('typ -> _) s, 'typ) var
+  | Tail : ('tail s, 'typ) var -> ((_ -> 'tail) s, 'typ) var
+
+type _ lst =
+  | CNil : nil lst
+  | CCons : 'h * ('t lst) -> ('h -> 't) lst
+;;
+
+let rec get_var : type stk ret. (stk s, ret) var -> stk lst -> ret = fun n s ->
+  match n, s with
+  | Head, CCons (h, _) -> h
+  | Tail n', CCons (_, t) -> get_var n' t
+;;
+
+[%%expect{|
+module A : sig type nil = Cstr end
+type _ s = Nil : A.nil s | Cons : 't s -> ('h -> 't) s
+type ('stack, 'typ) var =
+    Head : (('typ -> 'a) s, 'typ) var
+  | Tail : ('tail s, 'typ) var -> (('b -> 'tail) s, 'typ) var
+type _ lst = CNil : A.nil lst | CCons : 'h * 't lst -> ('h -> 't) lst
+val get_var : ('stk s, 'ret) var -> 'stk lst -> 'ret = 
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr6934.ml b/testsuite/tests/typing-gadts/pr6934.ml
new file mode 100644
index 00000000..76cb0563
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr6934.ml
@@ -0,0 +1,11 @@
+(* TEST
+   * expect
+*)
+
+type nonrec t = A : t;;
+[%%expect{|
+Line 1, characters 16-21:
+1 | type nonrec t = A : t;;
+                    ^^^^^
+Error: GADT case syntax cannot be used in a 'nonrec' block.
+|}]
diff --git a/testsuite/tests/typing-gadts/pr6980.ml b/testsuite/tests/typing-gadts/pr6980.ml
new file mode 100644
index 00000000..75a302e3
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr6980.ml
@@ -0,0 +1,31 @@
+(* TEST
+   * expect
+*)
+
+type 'a t = [< `Foo | `Bar] as 'a;;
+type 'a s = [< `Foo | `Bar | `Baz > `Bar] as 'a;;
+
+type 'a first = First : 'a second -> ('b t as 'a) first
+and 'a second = Second : ('b s as 'a) second;;
+
+type aux = Aux : 'a t second * ('a -> int) -> aux;;
+
+let it : 'a. [< `Bar | `Foo > `Bar ] as 'a = `Bar;;
+
+let g (Aux(Second, f)) = f it;;
+
+[%%expect{|
+type 'a t = 'a constraint 'a = [< `Bar | `Foo ]
+type 'a s = 'a constraint 'a = [< `Bar | `Baz | `Foo > `Bar ]
+type 'a first = First : 'b t second -> ([< `Bar | `Foo ] as 'b) t first
+and 'a second = Second : [< `Bar | `Baz | `Foo > `Bar ] s second
+type aux = Aux : ([< `Bar | `Foo ] as 'a) t second * ('a -> int) -> aux
+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 ]
+       but an expression was expected of type [< `Bar | `Foo ]
+       The second variant type is bound to $Aux,
+       it may not allow the tag(s) `Bar
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr6993_bad.ml b/testsuite/tests/typing-gadts/pr6993_bad.ml
new file mode 100644
index 00000000..e33808a7
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr6993_bad.ml
@@ -0,0 +1,30 @@
+(* TEST
+   * expect
+*)
+
+type (_, _) eqp = Y : ('a, 'a) eqp | N : string -> ('a, 'b) eqp
+let f : ('a list, 'a) eqp -> unit = function N s -> print_string s;;
+
+module rec A :  sig type t = B.t list end =
+  struct type t = B.t list end
+and B : sig  type t val eq : (B.t list, t) eqp end =
+  struct
+    type t = A.t
+    let eq = Y
+  end;;
+
+f B.eq;;
+
+[%%expect{|
+type (_, _) eqp = Y : ('a, 'a) eqp | N : string -> ('a, 'b) eqp
+Line 2, characters 36-66:
+2 | let f : ('a list, 'a) eqp -> unit = function N s -> print_string s;;
+                                        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Y
+val f : ('a list, 'a) eqp -> unit = 
+module rec A : sig type t = B.t list end
+and B : sig type t val eq : (B.t list, t) eqp end
+Exception: Match_failure ("", 2, 36).
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr7016.ml b/testsuite/tests/typing-gadts/pr7016.ml
new file mode 100644
index 00000000..be4f1a87
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7016.ml
@@ -0,0 +1,36 @@
+(* TEST
+   * expect
+*)
+
+type (_, _) t =
+  | Nil : ('tl, 'tl) t
+  | Cons : 'a * ('b, 'tl) t -> ('a * 'b, 'tl) t;;
+
+let get1 (Cons (x, _) : (_ * 'a, 'a) t) = x ;; (* warn, cf PR#6993 *)
+[%%expect{|
+type (_, _) t =
+    Nil : ('tl, 'tl) t
+  | Cons : 'a * ('b, 'tl) t -> ('a * 'b, 'tl) t
+Line 5, characters 9-43:
+5 | let get1 (Cons (x, _) : (_ * 'a, 'a) t) = x ;; (* warn, cf PR#6993 *)
+             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Nil
+val get1 : ('b * 'a, 'a) t -> 'b = 
+|}];;
+
+let get1' = function
+  | (Cons (x, _) : (_ * 'a, 'a) t) -> x
+  | Nil -> assert false ;; (* ok *)
+[%%expect{|
+val get1' : ('b * 'a as 'a, 'a) t -> 'b = 
+|}, Principal{|
+Line 3, characters 4-7:
+3 |   | Nil -> assert false ;; (* ok *)
+        ^^^
+Error: This pattern matches values of type ('b * 'a, 'b * 'a) t
+       but a pattern was expected which matches values of type
+         ('b * 'a, 'a) t
+       The type variable 'a occurs inside 'b * 'a
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr7160.ml b/testsuite/tests/typing-gadts/pr7160.ml
new file mode 100644
index 00000000..a615a462
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7160.ml
@@ -0,0 +1,26 @@
+(* TEST
+   * expect
+*)
+
+type _ t =
+  Int : int -> int t | String : string -> string t | Same : 'l t -> 'l t;;
+let rec f = function Int x -> x | Same s -> f s;;
+type 'a tt = 'a t =
+  Int : int -> int tt | String : string -> string tt | Same : 'l1 t -> 'l2 tt;;
+
+[%%expect{|
+type _ t =
+    Int : int -> int t
+  | String : string -> string t
+  | Same : 'l t -> 'l t
+val f : int t -> int = 
+Lines 4-5, characters 0-77:
+4 | type 'a tt = 'a t =
+5 |   Int : int -> int tt | String : string -> string tt | Same : 'l1 t -> 'l2 tt..
+Error: This variant or record definition does not match that of type 'a t
+       Constructors do not match:
+         Same : 'l t -> 'l t
+       is not compatible with:
+         Same : 'l1 t -> 'l2 t
+       The types are not equal.
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr7214.ml b/testsuite/tests/typing-gadts/pr7214.ml
new file mode 100644
index 00000000..a14616d7
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7214.ml
@@ -0,0 +1,45 @@
+(* TEST
+   * expect
+*)
+
+type _ t = I : int t;;
+
+let f (type a) (x : a t) =
+  let module M = struct
+    let (I : a t) = x     (* fail because of toplevel let *)
+    let x = (I : a t)
+  end in
+  () ;;
+[%%expect{|
+type _ t = I : int t
+Line 5, characters 9-10:
+5 |     let (I : a t) = x     (* fail because of toplevel let *)
+             ^
+Error: This pattern matches values of type int t
+       but a pattern was expected which matches values of type a t
+       Type int is not compatible with type a
+|}];;
+
+(* extra example by Stephen Dolan, using recursive modules *)
+(* Should not be allowed! *)
+type (_,_) eq = Refl : ('a, 'a) eq;;
+
+let bad (type a) =
+ let module N = struct
+   module rec M : sig
+     val e : (int, a) eq
+   end = struct
+     let (Refl : (int, a) eq) = M.e  (* must fail for soundness *)
+     let e : (int, a) eq = Refl
+   end
+ end in N.M.e
+;;
+[%%expect{|
+type (_, _) eq = Refl : ('a, 'a) eq
+Line 8, characters 10-14:
+8 |      let (Refl : (int, a) eq) = M.e  (* must fail for soundness *)
+              ^^^^
+Error: This pattern matches values of type (int, int) eq
+       but a pattern was expected which matches values of type (int, a) eq
+       Type int is not compatible with type a
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr7222.ml b/testsuite/tests/typing-gadts/pr7222.ml
new file mode 100644
index 00000000..683458b4
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7222.ml
@@ -0,0 +1,42 @@
+(* TEST
+   * expect
+*)
+
+type +'a n = private int
+type nil = private Nil_type
+type (_,_) elt =
+  | Elt_fine: 'nat n -> ('l,'nat * 'l) elt
+  | Elt: 'nat n -> ('l,'nat -> 'l) elt
+type _ t = Nil : nil t | Cons : ('x, 'fx) elt * 'x t -> 'fx t;;
+
+let undetected: ('a -> 'b -> nil) t -> 'a n -> 'b n -> unit = fun sh i j ->
+  let Cons(Elt dim, _) = sh in ()
+;;
+
+[%%expect{|
+type +'a n = private int
+type nil = private Nil_type
+type (_, _) elt =
+    Elt_fine : 'nat n -> ('l, 'nat * 'l) elt
+  | Elt : 'nat n -> ('l, 'nat -> 'l) elt
+type _ t = Nil : nil t | Cons : ('x, 'fx) elt * 'x t -> 'fx t
+Line 9, characters 11-18:
+9 |   let Cons(Elt dim, _) = sh in ()
+               ^^^^^^^
+Error: This pattern matches values of type ($Cons_'x, 'a -> $Cons_'x) elt
+       but a pattern was expected which matches values of type
+         ($Cons_'x, 'a -> $'b -> nil) elt
+       The type constructor $'b would escape its scope
+|}, Principal{|
+type +'a n = private int
+type nil = private Nil_type
+type (_, _) elt =
+    Elt_fine : 'nat n -> ('l, 'nat * 'l) elt
+  | Elt : 'nat n -> ('l, 'nat -> 'l) elt
+type _ t = Nil : nil t | Cons : ('x, 'fx) elt * 'x t -> 'fx t
+Line 9, characters 6-22:
+9 |   let Cons(Elt dim, _) = sh in ()
+          ^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type ('a -> $0 -> nil) t
+       The type constructor $0 would escape its scope
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr7230.ml b/testsuite/tests/typing-gadts/pr7230.ml
new file mode 100644
index 00000000..1c29f5e4
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7230.ml
@@ -0,0 +1,13 @@
+(* TEST
+   * expect
+*)
+
+type _ t = T : int t;;
+
+(* Should raise Not_found *)
+let _ = match (raise Not_found : float t) with _ -> .;;
+
+[%%expect{|
+type _ t = T : int t
+Exception: Not_found.
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr7234.ml b/testsuite/tests/typing-gadts/pr7234.ml
new file mode 100644
index 00000000..ae98e02c
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7234.ml
@@ -0,0 +1,32 @@
+(* TEST
+   * expect
+*)
+
+type (_, _) eq = Eq : ('a, 'a) eq | Neq : int -> ('a, 'b) eq;;
+type 'a t;;
+let f (type a) (Neq n : (a, a t) eq) = n;;   (* warn! *)
+[%%expect{|
+type (_, _) eq = Eq : ('a, 'a) eq | Neq : int -> ('a, 'b) eq
+type 'a t
+Line 3, characters 15-40:
+3 | let f (type a) (Neq n : (a, a t) eq) = n;;   (* warn! *)
+                   ^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Eq
+val f : ('a, 'a t) eq -> int = 
+|}];;
+
+module F (T : sig type _ t end) = struct
+ let f (type a) (Neq n : (a, a T.t) eq) = n  (* warn! *)
+end;;
+[%%expect{|
+Line 2, characters 16-43:
+2 |  let f (type a) (Neq n : (a, a T.t) eq) = n  (* warn! *)
+                    ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: 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
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr7260.ml b/testsuite/tests/typing-gadts/pr7260.ml
new file mode 100644
index 00000000..87e7d30e
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7260.ml
@@ -0,0 +1,31 @@
+(* TEST
+   * expect
+*)
+
+type bar = < bar: unit >
+
+type _ ty = Int : int ty
+
+type dyn = Dyn : 'a ty -> dyn;;
+
+class foo =
+  object (this)
+    method foo (Dyn ty) =
+      match ty with
+      | Int -> (this :> bar)
+  end;;  (* fail, but not for scope *)
+
+[%%expect{|
+type bar = < bar : unit >
+type _ ty = Int : int ty
+type dyn = Dyn : 'a ty -> dyn
+Lines 7-12, characters 0-5:
+ 7 | class foo =
+ 8 |   object (this)
+ 9 |     method foo (Dyn ty) =
+10 |       match ty with
+11 |       | Int -> (this :> bar)
+12 |   end.................................
+Error: This class should be virtual.
+       The following methods are undefined : bar
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr7269.ml b/testsuite/tests/typing-gadts/pr7269.ml
new file mode 100644
index 00000000..9293eb3b
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7269.ml
@@ -0,0 +1,81 @@
+(* TEST
+   * expect
+*)
+
+type s = [`A | `B] and sub = [`B];;
+type +'a t = T : [< `Conj of 'a & sub | `Other of string] -> 'a t;; (* ok *)
+
+let f (T (`Other msg) : s t) = print_string msg;;
+let _ = f (T (`Conj `B) :> s t);; (* warn *)
+[%%expect{|
+type s = [ `A | `B ]
+and sub = [ `B ]
+type +'a t = T : [< `Conj of 'a & sub | `Other of string ] -> 'a t
+Line 4, characters 6-47:
+4 | let f (T (`Other msg) : s t) = print_string msg;;
+          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+T (`Conj _)
+val f : s t -> unit = 
+Exception: Match_failure ("", 4, 6).
+|}];;
+
+module M : sig
+  type s
+  type t = T : [< `Conj of int & s | `Other of string] -> t
+  val x : t
+end = struct
+  type s = int
+  type t = T : [< `Conj of int | `Other of string] -> t
+  let x = T (`Conj 42)
+end;;
+
+let () = M.(match x with T (`Other msg) -> print_string msg);; (* warn *)
+[%%expect{|
+module M :
+  sig
+    type s
+    type t = T : [< `Conj of int & s | `Other of string ] -> t
+    val x : t
+  end
+Line 11, characters 12-59:
+11 | let () = M.(match x with T (`Other msg) -> print_string msg);; (* warn *)
+                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+T (`Conj _)
+Exception: Match_failure ("", 11, 12).
+|}];;
+
+
+module M : sig
+  type s
+  type elim =
+      { ex : 'a . ([<`Conj of int & s | `Other of string] as 'a) -> unit }
+  val e : elim -> unit
+end = struct
+  type s = int
+  type elim =
+      { ex : 'a . (([<`Conj of int | `Other of string] as 'a) -> unit) }
+  let e { ex } = ex (`Conj 42 : [`Conj of int])
+end;;
+
+let () = M.(e { ex = fun (`Other msg) -> print_string msg });; (* warn *)
+[%%expect{|
+module M :
+  sig
+    type s
+    type elim = {
+      ex : 'a. ([< `Conj of int & s | `Other of string ] as 'a) -> unit;
+    }
+    val e : elim -> unit
+  end
+Line 13, characters 21-57:
+13 | let () = M.(e { ex = fun (`Other msg) -> print_string msg });; (* warn *)
+                          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+`Conj _
+Exception: Match_failure ("", 13, 21).
+|}];;
diff --git a/testsuite/tests/typing-gadts/pr7298.ml b/testsuite/tests/typing-gadts/pr7298.ml
new file mode 100644
index 00000000..931d9612
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7298.ml
@@ -0,0 +1,18 @@
+(* TEST
+   * expect
+*)
+
+type t = T : t;;
+
+module M : sig
+  type free = < bar : t -> unit; foo : free -> unit >
+end = struct
+  class free = object (self : 'self)
+    method foo self = ()
+    method bar T = self#foo self
+  end
+end;;
+[%%expect{|
+type t = T : t
+module M : sig type free = < bar : t -> unit; foo : free -> unit > end
+|}]
diff --git a/testsuite/tests/typing-gadts/pr7374.ml b/testsuite/tests/typing-gadts/pr7374.ml
new file mode 100644
index 00000000..1eb4166c
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7374.ml
@@ -0,0 +1,57 @@
+(* TEST
+   * expect
+*)
+
+type ('a, 'b) eq = Refl : ('a, 'a) eq
+
+module type S = sig
+  type 'a t constraint 'a = [`Rec of 'b]
+end;;
+[%%expect{|
+type ('a, 'b) eq = Refl : ('a, 'a) eq
+module type S = sig type 'a t constraint 'a = [ `Rec of 'b ] end
+|}]
+
+module Fix (X : S) : sig
+  type t
+  val uniq : ('a, [`Rec of 'a] X.t) eq -> ('a, t) eq
+end = struct
+  type t = [`Rec of 'a] X.t as 'a
+  let uniq : type a . (a, [`Rec of a] X.t) eq -> (a, t) eq =
+    fun Refl -> Refl
+end;; (* should fail *)
+[%%expect{|
+Line 7, characters 16-20:
+7 |     fun Refl -> Refl
+                    ^^^^
+Error: This expression 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
+|}]
+
+(* trigger segfault
+module Id = struct
+  type 'a t = 'b constraint 'a = [ `Rec of 'b ]
+end
+
+module Bad = Fix(Id)
+
+let segfault () =
+  print_endline (cast (trans (Bad.uniq Refl) (Bad.uniq Refl)) 0)
+*)
+
+(* addendum: ensure that hidden paths are checked too *)
+module F (X : sig type 'a t end) = struct
+  open X
+  let f : type a b. (a, b t) eq -> (b, a t) eq -> (a, a t t) eq =
+    fun Refl Refl -> Refl;;
+end;; (* should fail *)
+[%%expect{|
+Line 4, characters 21-25:
+4 |     fun Refl Refl -> Refl;;
+                         ^^^^
+Error: This expression 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/pr7378.ml b/testsuite/tests/typing-gadts/pr7378.ml
new file mode 100644
index 00000000..9252b43d
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7378.ml
@@ -0,0 +1,33 @@
+(* TEST
+   * expect
+*)
+
+module X = struct
+  type t =
+    | A : 'a * 'b * ('a -> unit) -> t
+end;;
+[%%expect{|
+module X : sig type t = A : 'a * 'b * ('a -> unit) -> t end
+|}]
+
+module Y = struct
+  type t = X.t =
+    | A : 'a * 'b * ('b -> unit) -> t
+end;; (* should fail *)
+[%%expect{|
+Lines 2-3, characters 2-37:
+2 | ..type t = X.t =
+3 |     | A : 'a * 'b * ('b -> unit) -> t
+Error: This variant or record definition does not match that of type X.t
+       Constructors do not match:
+         A : 'a * 'b * ('a -> unit) -> X.t
+       is not compatible with:
+         A : 'a * 'b * ('b -> unit) -> X.t
+       The types are not equal.
+|}]
+
+(* would segfault
+let () =
+  match Y.A (1, "", print_string) with
+  | X.A (x, y, f) -> f x
+*)
diff --git a/testsuite/tests/typing-gadts/pr7381.ml b/testsuite/tests/typing-gadts/pr7381.ml
new file mode 100644
index 00000000..7609cce7
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7381.ml
@@ -0,0 +1,19 @@
+(* TEST
+   * expect
+*)
+
+type (_,_) eql = Refl : ('a, 'a) eql;;
+[%%expect{|
+type (_, _) eql = Refl : ('a, 'a) eql
+|}]
+
+let f : type t. (int, t) eql * (t, string) eql -> unit = function _ -> . ;;
+[%%expect{|
+val f : (int, 't) eql * ('t, string) eql -> unit = 
+|}]
+
+let f : type t. ((int, t) eql * (t, string) eql) option -> unit =
+  function None -> () ;;
+[%%expect{|
+val f : ((int, 't) eql * ('t, string) eql) option -> unit = 
+|}]
diff --git a/testsuite/tests/typing-gadts/pr7390.ml b/testsuite/tests/typing-gadts/pr7390.ml
new file mode 100644
index 00000000..2a988e1c
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7390.ml
@@ -0,0 +1,31 @@
+(* TEST
+   * expect
+*)
+
+type empty = Empty and filled = Filled
+type ('a,'fout,'fin) opt =
+  | N : ('a, 'f, 'f) opt
+  | Y : 'a -> ('a, filled, empty) opt
+type 'fill either =
+  | Either : (string, 'fill, 'f) opt * (int, 'f, empty) opt -> 'fill either;;
+[%%expect{|
+type empty = Empty
+and filled = Filled
+type ('a, 'fout, 'fin) opt =
+    N : ('a, 'f, 'f) opt
+  | Y : 'a -> ('a, filled, empty) opt
+type 'fill either =
+    Either : (string, 'fill, 'f) opt * (int, 'f, empty) opt -> 'fill either
+|}]
+
+let f (* : filled either -> string *) =
+  fun (Either (Y a, N)) -> a;;
+[%%expect{|
+Line 2, characters 2-28:
+2 |   fun (Either (Y a, N)) -> a;;
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Either (N, Y _)
+val f : filled either -> string = 
+|}]
diff --git a/testsuite/tests/typing-gadts/pr7391.ml b/testsuite/tests/typing-gadts/pr7391.ml
new file mode 100644
index 00000000..f5ffc205
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7391.ml
@@ -0,0 +1,95 @@
+(* TEST
+   * expect
+*)
+
+class virtual child1 parent =
+  object
+    method private parent = parent
+  end
+
+class virtual child2 =
+  object(_ : 'self)
+    constraint 'parent = < previous: 'self option; .. >
+    method private virtual parent: 'parent
+  end
+
+(* Worked in 4.03 *)
+let _ =
+  object(self)
+    method previous = None
+    method child =
+      object
+        inherit child1 self
+        inherit child2
+      end
+  end;;
+[%%expect{|
+class virtual child1 : 'a -> object method private parent : 'a end
+class virtual child2 :
+  object ('a)
+    method private virtual parent : < previous : 'a option; .. >
+  end
+- : < child : child2; previous : child2 option > = 
+|}]
+
+(* Worked in 4.03 *)
+let _ =
+  object(self)
+    method previous = None
+    method child (_ : unit) =
+      object
+        inherit child1 self
+        inherit child2
+      end
+  end;;
+[%%expect{|
+- : < child : unit -> child2; previous : child2 option > = 
+|}]
+
+(* Worked in 4.03 *)
+let _ =
+  object(self)
+    method previous = None
+    method child () =
+      object
+        inherit child1 self
+        inherit child2
+      end
+  end;;
+[%%expect{|
+- : < child : unit -> child2; previous : child2 option > = 
+|}]
+
+(* Didn't work in 4.03, but works in 4.07 *)
+let _ =
+  object(self)
+    method previous = None
+    method child =
+      let o =
+      object
+        inherit child1 self
+        inherit child2
+      end
+      in o
+  end;;
+[%%expect{|
+- : < child : child2; previous : child2 option > = 
+|}]
+
+(* Also didn't work in 4.03 *)
+
+type gadt = Not_really_though : gadt
+
+let _ =
+  object(self)
+    method previous = None
+    method child Not_really_though =
+      object
+        inherit child1 self
+        inherit child2
+      end
+  end;;
+[%%expect{|
+type gadt = Not_really_though : gadt
+- : < child : gadt -> child2; previous : child2 option > = 
+|}]
diff --git a/testsuite/tests/typing-gadts/pr7397.ml b/testsuite/tests/typing-gadts/pr7397.ml
new file mode 100644
index 00000000..8a85eaff
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7397.ml
@@ -0,0 +1,29 @@
+(* TEST
+   * expect
+*)
+
+type +'a t
+
+class type a = object
+ method b : b
+end
+
+and b = object
+ method a : a
+end
+
+type _ response =
+ | C : #a t response;;
+[%%expect{|
+type +'a t
+class type a = object method b : b end
+and b = object method a : a end
+type _ response = C : #a t response
+|}]
+
+let f (type a) (a : a response) =
+ match a with
+ | C -> 0;;
+[%%expect{|
+val f : 'a response -> int = 
+|}]
diff --git a/testsuite/tests/typing-gadts/pr7421.ml b/testsuite/tests/typing-gadts/pr7421.ml
new file mode 100644
index 00000000..79acaceb
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7421.ml
@@ -0,0 +1,34 @@
+(* TEST
+   * expect
+*)
+
+type (_, _) eq = Refl : ('a, 'a) eq;;
+type empty = (int, unit) eq;;
+[%%expect{|
+type (_, _) eq = Refl : ('a, 'a) eq
+type empty = (int, unit) eq
+|}]
+let f (x : ('a, empty Lazy.t) result) =
+  match x with
+  | Ok x -> x
+  | Error (lazy _) -> .;;
+[%%expect{|
+Line 4, characters 4-18:
+4 |   | Error (lazy _) -> .;;
+        ^^^^^^^^^^^^^^
+Error: This match case could not be refuted.
+       Here is an example of a value that would reach it: Error lazy _
+|}]
+let f (x : ('a, empty Lazy.t) result) =
+  match x with
+  | Ok x -> x
+  | Error (lazy Refl) -> .;;
+[%%expect{|
+Line 4, characters 16-20:
+4 |   | Error (lazy Refl) -> .;;
+                    ^^^^
+Error: This pattern matches values of type (int, int) eq
+       but a pattern was expected which matches values of type
+         empty = (int, unit) eq
+       Type int is not compatible with type unit
+|}]
diff --git a/testsuite/tests/typing-gadts/pr7432.ml b/testsuite/tests/typing-gadts/pr7432.ml
new file mode 100644
index 00000000..014fd7e4
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7432.ml
@@ -0,0 +1,33 @@
+(* TEST
+   * expect
+*)
+
+#labels false;;
+type (_,_) eql = Refl : ('a, 'a) eql
+type s = x:int -> y:float -> unit
+type t = y:int -> x:float -> unit
+type silly = {silly: 'a.'a};;
+let eql : (s, t) eql = Refl;;
+[%%expect{|
+type (_, _) eql = Refl : ('a, 'a) eql
+type s = x:int -> y:float -> unit
+type t = y:int -> x:float -> unit
+type silly = { silly : 'a. 'a; }
+val eql : (s, t) eql = Refl
+|}]
+
+#labels true;;
+let f : [`L of (s, t) eql | `R of silly] -> 'a =
+  function `R {silly} -> silly
+;;
+[%%expect{|
+Line 2, characters 2-30:
+2 |   function `R {silly} -> silly
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+`L Refl
+val f : [ `L of (s, t) eql | `R of silly ] -> 'a = 
+|}]
+
+(* Segfault: let () = print_endline (f (`L eql)) *)
diff --git a/testsuite/tests/typing-gadts/pr7520.ml b/testsuite/tests/typing-gadts/pr7520.ml
new file mode 100644
index 00000000..b4bfe2f4
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7520.ml
@@ -0,0 +1,13 @@
+(* TEST
+   * expect
+*)
+
+type ('a, 'b) eq = Refl : ('a, 'a) eq
+type empty = (int, string) eq
+
+let f = function `Foo (_ : empty) -> .
+[%%expect{|
+type ('a, 'b) eq = Refl : ('a, 'a) eq
+type empty = (int, string) eq
+val f : [< `Foo of empty ] -> 'a = 
+|}]
diff --git a/testsuite/tests/typing-gadts/pr7618.ml b/testsuite/tests/typing-gadts/pr7618.ml
new file mode 100644
index 00000000..ce98c531
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7618.ml
@@ -0,0 +1,52 @@
+(* TEST
+   * expect
+*)
+
+type _ t = I : int t;;
+let f (type a) (x : a t) (y : int) =
+  match x, y with
+  | I, (_:a) -> ()
+;;
+[%%expect{|
+type _ t = I : int t
+val f : 'a t -> int -> unit = 
+|}]
+
+type ('a, 'b) eq = Refl : ('a, 'a) eq;;
+let ok (type a b) (x : (a, b) eq) =
+  match x, [] with
+  | Refl, [(_ : a) | (_ : b)] -> []
+;;
+[%%expect{|
+type ('a, 'b) eq = Refl : ('a, 'a) eq
+Line 4, characters 4-29:
+4 |   | Refl, [(_ : a) | (_ : b)] -> []
+        ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type (a, b) eq * b list
+       This instance of b is ambiguous:
+       it would escape the scope of its equation
+|}]
+let fails (type a b) (x : (a, b) eq) =
+  match x, [] with
+  | Refl, [(_ : a) | (_ : b)] -> []
+  | Refl, [(_ : b) | (_ : a)] -> []
+;;
+[%%expect{|
+Line 3, characters 4-29:
+3 |   | Refl, [(_ : a) | (_ : b)] -> []
+        ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type (a, b) eq * b list
+       This instance of b is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+(* branches must be unified! *)
+let x = match [] with ["1"] -> 1 | [1.0] -> 2 | [1] -> 3 | _ -> 4;;
+[%%expect{|
+Line 1, characters 35-40:
+1 | let x = match [] with ["1"] -> 1 | [1.0] -> 2 | [1] -> 3 | _ -> 4;;
+                                       ^^^^^
+Error: This pattern matches values of type float list
+       but a pattern was expected which matches values of type string list
+       Type float is not compatible with type string
+|}]
diff --git a/testsuite/tests/typing-gadts/pr7747.ml b/testsuite/tests/typing-gadts/pr7747.ml
new file mode 100644
index 00000000..97b89061
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr7747.ml
@@ -0,0 +1,35 @@
+(* TEST
+   * expect
+*)
+
+type (_,_) eq = Refl : ('a,'a) eq
+
+module M = struct type t end
+module N : sig type t = private M.t val eq : (t, M.t) eq end =
+  struct type t = M.t let eq = Refl end;;
+
+(*
+  as long as we are casting between M.t and N.t
+  there is no problem, this will type check.
+*)
+
+let f x = match N.eq with Refl -> (x : N.t :> M.t);;
+[%%expect{|
+type (_, _) eq = Refl : ('a, 'a) eq
+module M : sig type t end
+module N : sig type t = private M.t val eq : (t, M.t) eq end
+val f : N.t -> M.t = 
+|}]
+let f x = match N.eq with Refl -> (x : M.t :> N.t);;
+[%%expect{|
+Line 1, characters 34-50:
+1 | let f x = match N.eq with Refl -> (x : M.t :> N.t);;
+                                      ^^^^^^^^^^^^^^^^
+Error: Type M.t is not a subtype of N.t
+|}]
+
+(*
+  but as soon we're trying to cast to another type,
+  the type checker will never return and memory
+  consumption will increase drastically.
+*)
diff --git a/testsuite/tests/typing-gadts/pr9019.ml b/testsuite/tests/typing-gadts/pr9019.ml
new file mode 100644
index 00000000..7a946bfb
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr9019.ml
@@ -0,0 +1,236 @@
+(* TEST
+   * expect
+*)
+
+(* #9012 by Thomas Refis *)
+
+type ab = A | B
+
+module M : sig
+  type mab = A | B
+  type _ t = AB : ab t | MAB : mab t
+  val ab : mab t
+end = struct
+  type mab = ab = A | B
+  type _ t = AB : ab t | MAB : mab t
+  let ab = AB
+end
+[%%expect{|
+type ab = A | B
+module M :
+  sig type mab = A | B type _ t = AB : ab t | MAB : mab t val ab : mab t end
+|}]
+
+open M
+
+let f (type x) (t1 : x t) (t2 : x t) (x : x) =
+  match t1, t2, x with
+  | AB,  AB, A -> 1
+  | MAB, _, A -> 2
+  | _,  AB, B -> 3
+  | _, MAB, B -> 4
+[%%expect{|
+Lines 4-8, characters 2-18:
+4 | ..match t1, t2, x with
+5 |   | AB,  AB, A -> 1
+6 |   | MAB, _, A -> 2
+7 |   | _,  AB, B -> 3
+8 |   | _, MAB, B -> 4
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(AB, MAB, A)
+val f : 'x M.t -> 'x M.t -> 'x -> int = 
+|}]
+
+let () = ignore (f M.ab MAB A)
+[%%expect{|
+Exception: Match_failure ("", 4, 2).
+|}]
+
+(* variant *)
+
+type _ ab = A | B
+
+module M : sig
+  type _ mab
+  type _ t = AB : unit ab t | MAB : unit mab t
+  val ab : unit mab t
+  val a : 'a mab
+  val b : 'a mab
+end = struct
+  type 'a mab = 'a ab = A | B
+  type _ t = AB : unit ab t | MAB : unit mab t
+  let ab = AB
+  let a = A
+  let b = B
+end;;
+[%%expect{|
+type _ ab = A | B
+module M :
+  sig
+    type _ mab
+    type _ t = AB : unit ab t | MAB : unit mab t
+    val ab : unit mab t
+    val a : 'a mab
+    val b : 'a mab
+  end
+|}]
+
+open M
+
+(* The second clause isn't redundant *)
+let f (type x) (t1 : x t) (t2 : x t) (x : x) =
+  match t1, t2, x with
+  | AB,  AB, A -> 1
+  | _, AB, A -> 2
+  | _, AB, B -> 3
+  | _, MAB, _ -> 4;;
+[%%expect{|
+val f : 'x M.t -> 'x M.t -> 'x -> int = 
+|}]
+
+(* the answer shouldn't be 3 *)
+let x = f MAB M.ab M.a;;
+[%%expect{|
+val x : int = 2
+|}]
+
+(* using records *)
+
+type ab = { a : int }
+
+module M : sig
+  type mab = { a : int }
+
+  type _ t = AB : ab t | MAB : mab t
+
+  val a : mab
+  val ab : mab t
+end = struct
+  type mab = ab = { a : int }
+
+  type _ t = AB : ab t | MAB : mab t
+
+  let a = { a = 42 }
+  let ab = AB
+end;;
+[%%expect{|
+type ab = { a : int; }
+module M :
+  sig
+    type mab = { a : int; }
+    type _ t = AB : ab t | MAB : mab t
+    val a : mab
+    val ab : mab t
+  end
+|}]
+
+open M
+
+let f (type x) (t1 : x t) (t2 : x t) (x : x) =
+  match t1, t2, x with
+  | AB,  AB, { a = _ } -> 1
+  | MAB, _,  { a = _ } -> 2
+  | _,  AB,  { a = _ } -> 3
+  | _, MAB,  { a = _ } -> 4;;
+[%%expect{|
+Line 7, characters 4-22:
+7 |   | _,  AB,  { a = _ } -> 3
+        ^^^^^^^^^^^^^^^^^^
+Warning 11: this match case is unused.
+val f : 'x M.t -> 'x M.t -> 'x -> int = 
+|}]
+
+let p = f M.ab MAB { a = 42 };;
+[%%expect{|
+val p : int = 4
+|}]
+
+
+(* #9019 by Leo White *)
+
+type _ a_or_b =
+  A_or_B : [< `A of string | `B of int] a_or_b
+
+type _ a =
+  | A : [> `A of string] a
+  | Not_A : _ a
+
+let f (type x) (a : x a) (a_or_b : x a_or_b) (x : x) =
+  match a, a_or_b, x with
+  | Not_A, A_or_B, `B i -> print_int i
+  | _, A_or_B, `A s -> print_string s
+[%%expect{|
+type _ a_or_b = A_or_B : [< `A of string | `B of int ] a_or_b
+type _ a = A : [> `A of string ] a | Not_A : 'a a
+Lines 9-11, characters 2-37:
+ 9 | ..match a, a_or_b, x with
+10 |   | Not_A, A_or_B, `B i -> print_int i
+11 |   | _, A_or_B, `A s -> print_string s
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(A, A_or_B, `B _)
+val f : 'x a -> 'x a_or_b -> 'x -> unit = 
+|}]
+
+let segfault = f A A_or_B (`B 0)
+[%%expect{|
+Exception: Match_failure ("", 9, 2).
+|}]
+
+
+(* Another example *)
+type (_, _) b =
+  | A : ([< `A ], 'a) b
+  | B : ([< `B of 'a], 'a) b
+
+type _ ty =
+  | String_option : string option ty
+
+let f (type x) (type y) (b : (x, y ty) b) (x : x) (y : y) =
+  match b, x, y with
+  | B, `B String_option, Some s -> print_string s
+  | A, `A, _ -> ()
+[%%expect{|
+type (_, _) b = A : ([< `A ], 'a) b | B : ([< `B of 'a ], 'a) b
+type _ ty = String_option : string option ty
+Lines 9-11, characters 2-18:
+ 9 | ..match b, x, y with
+10 |   | B, `B String_option, Some s -> print_string s
+11 |   | A, `A, _ -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(B, `B String_option, None)
+val f : ('x, 'y ty) b -> 'x -> 'y -> unit = 
+|}]
+
+let segfault = f B (`B String_option) None
+[%%expect{|
+Exception: Match_failure ("", 9, 2).
+|}]
+
+(* More polymorphic variants *)
+
+type 'a a = private [< `A of 'a];;
+let f (x : _ a) = match x with `A None -> ();;
+[%%expect{|
+type 'a a = private [< `A of 'a ]
+Line 2, characters 18-44:
+2 | let f (x : _ a) = match x with `A None -> ();;
+                      ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+`A (Some _)
+val f : 'a option a -> unit = 
+|}]
+
+let f (x : [> `A] a) = match x with `A `B -> ();;
+[%%expect{|
+Line 1, characters 23-47:
+1 | let f (x : [> `A] a) = match x with `A `B -> ();;
+                           ^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+`A `A
+val f : [< `A | `B > `A ] a -> unit = 
+|}]
diff --git a/testsuite/tests/typing-gadts/term-conv.ml b/testsuite/tests/typing-gadts/term-conv.ml
new file mode 100644
index 00000000..436100ba
--- /dev/null
+++ b/testsuite/tests/typing-gadts/term-conv.ml
@@ -0,0 +1,222 @@
+(* TEST
+   * expect
+*)
+
+(* HOAS to de Bruijn, by chak *)
+(* http://www.cse.unsw.edu.au/~chak/haskell/term-conv/ *)
+
+module Typeable = struct
+  type 'a ty =
+    | Int: int ty
+    | String: string ty
+    | List: 'a ty -> 'a list ty
+    | Pair: ('a ty * 'b ty) -> ('a * 'b) ty
+    | Fun: ('a ty * 'b ty) -> ('a -> 'b) ty
+
+  type (_,_) eq = Eq : ('a,'a) eq
+
+  exception CastFailure
+  let rec check_eq : type t t'. t ty -> t' ty -> (t,t') eq = fun t t' ->
+    match t, t' with
+    | Int, Int -> Eq
+    | String, String -> Eq
+    | List t, List t' -> (match check_eq t t' with Eq -> Eq)
+    | Pair (t1,t2), Pair (t1',t2') ->
+        (match check_eq t1 t1', check_eq t2 t2' with Eq, Eq -> Eq)
+    | Fun (t1,t2), Fun (t1',t2') ->
+        (match check_eq t1 t1', check_eq t2 t2' with Eq, Eq -> Eq)
+    | _ -> raise CastFailure
+
+  let gcast : type t t'. t ty -> t' ty -> t -> t' = fun t t' x ->
+    match check_eq t t' with Eq -> x
+end;;
+[%%expect{|
+module Typeable :
+  sig
+    type 'a ty =
+        Int : int ty
+      | String : string ty
+      | List : 'a ty -> 'a list ty
+      | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
+      | Fun : ('a ty * 'b ty) -> ('a -> 'b) ty
+    type (_, _) eq = Eq : ('a, 'a) eq
+    exception CastFailure
+    val check_eq : 't ty -> ' t' ty -> ('t, ' t') eq
+    val gcast : 't ty -> ' t' ty -> 't -> ' t'
+  end
+|}];;
+
+module HOAS = struct
+  open Typeable
+
+  type _ term =
+    | Tag : 't ty * int -> 't term
+    | Con : 't -> 't term
+    | Lam : 's ty * ('s term -> 't term) -> ('s -> 't) term
+    | App : ('s -> 't) term * 's term -> 't term
+
+  let rec intp : type t. t term -> t = function
+    | Tag (_, ix) -> failwith "HOAS.intp"
+    | Con v      -> v
+    | Lam (_, f) -> fun x -> intp (f (Con x))
+    | App (f, a) -> intp f (intp a)
+end;;
+[%%expect{|
+module HOAS :
+  sig
+    type _ term =
+        Tag : 't Typeable.ty * int -> 't term
+      | Con : 't -> 't term
+      | Lam : 's Typeable.ty * ('s term -> 't term) -> ('s -> 't) term
+      | App : ('s -> 't) term * 's term -> 't term
+    val intp : 't term -> 't
+  end
+|}];;
+
+module DeBruijn = struct
+  type ('env,'t) ix =
+    | ZeroIx : ('env * 't, 't) ix
+    | SuccIx : ('env,'t) ix -> ('env * 's, 't) ix
+
+  let rec to_int : type env t. (env,t) ix -> int = function
+    | ZeroIx   -> 0
+    | SuccIx n -> to_int n + 1
+
+  type ('env,'t) term =
+    | Var : ('env,'t) ix -> ('env,'t) term
+    | Con : 't -> ('env,'t) term
+    | Lam : ('env * 's, 't) term -> ('env, 's -> 't) term
+    | App : ('env, 's -> 't) term * ('env, 's) term -> ('env, 't) term
+
+  type _ stack =
+    | Empty : unit stack
+    | Push : 'env stack * 't -> ('env * 't) stack
+
+  let rec prj : type env t. (env,t) ix -> env stack -> t = fun i s ->
+    match i, s with
+    | ZeroIx, Push (s,v) -> v
+    | SuccIx i, Push (s,_) -> prj i s
+
+  let rec intp : type env t. (env,t) term -> env stack -> t = fun t s ->
+    match t with
+    | Var ix -> prj ix s
+    | Con v  -> v
+    | Lam b  -> fun x -> intp b (Push (s, x))
+    | App(f,a) -> intp f s (intp a s)
+end;;
+[%%expect{|
+module DeBruijn :
+  sig
+    type ('env, 't) ix =
+        ZeroIx : ('env * 't, 't) ix
+      | SuccIx : ('env, 't) ix -> ('env * 's, 't) ix
+    val to_int : ('env, 't) ix -> int
+    type ('env, 't) term =
+        Var : ('env, 't) ix -> ('env, 't) term
+      | Con : 't -> ('env, 't) term
+      | Lam : ('env * 's, 't) term -> ('env, 's -> 't) term
+      | App : ('env, 's -> 't) term * ('env, 's) term -> ('env, 't) term
+    type _ stack =
+        Empty : unit stack
+      | Push : 'env stack * 't -> ('env * 't) stack
+    val prj : ('env, 't) ix -> 'env stack -> 't
+    val intp : ('env, 't) term -> 'env stack -> 't
+  end
+|}];;
+
+module Convert = struct
+  type (_,_) layout =
+    | EmptyLayout : ('env, unit) layout
+    | PushLayout  :
+        't Typeable.ty * ('env,'env') layout * ('env,'t) DeBruijn.ix
+           -> ('env,'env' * 't) layout
+
+  let rec size : type env env'. (env,env') layout -> int = function
+    | EmptyLayout -> 0
+    | PushLayout (_, lyt, _) -> size lyt + 1
+
+  let rec inc : type env env'. (env,env') layout -> (env * 't, env') layout =
+    function
+      | EmptyLayout -> EmptyLayout
+      | PushLayout (t, lyt, ix) -> PushLayout (t, inc lyt, DeBruijn.SuccIx ix)
+
+  let rec prj : type env env' t.
+        t Typeable.ty -> int -> (env,env') layout -> (env,t) DeBruijn.ix
+    = fun t n -> function
+      | EmptyLayout -> failwith "Convert.prj: internal error"
+      | PushLayout (t', l, ix) ->
+          if n = 0 then
+            match Typeable.check_eq t t' with Typeable.Eq -> ix
+          else prj t (n-1) l
+
+  let rec cvt :
+    type env t. (env,env) layout -> t HOAS.term -> (env,t) DeBruijn.term =
+    fun lyt -> function
+      | HOAS.Tag (t, sz) -> DeBruijn.Var (prj t (size lyt - sz -1) lyt)
+      | HOAS.Con v -> DeBruijn.Con v
+      | HOAS.Lam (t, f) ->
+          let lyt' = PushLayout (t, inc lyt, DeBruijn.ZeroIx) in
+          DeBruijn.Lam (cvt lyt' (f (HOAS.Tag (t, size lyt))))
+      | HOAS.App (f, a) ->
+          DeBruijn.App (cvt lyt f, cvt lyt a)
+
+  let convert t = cvt EmptyLayout t
+end;;
+[%%expect{|
+module Convert :
+  sig
+    type (_, _) layout =
+        EmptyLayout : ('env, unit) layout
+      | PushLayout : 't Typeable.ty * ('env, 'env') layout *
+          ('env, 't) DeBruijn.ix -> ('env, 'env' * 't) layout
+    val size : ('env, 'env') layout -> int
+    val inc : ('env, 'env') layout -> ('env * 't, 'env') layout
+    val prj :
+      't Typeable.ty -> int -> ('env, 'env') layout -> ('env, 't) DeBruijn.ix
+    val cvt : ('env, 'env) layout -> 't HOAS.term -> ('env, 't) DeBruijn.term
+    val convert : 'a HOAS.term -> (unit, 'a) DeBruijn.term
+  end
+|}];;
+
+module Main = struct
+  open HOAS
+  let i t = Lam (t, fun x -> x)
+  let zero t = Lam (Typeable.Fun(t,t), fun f -> Lam(t, fun x -> x))
+  let one t = Lam (Typeable.Fun(t,t), fun f -> Lam(t, fun x -> App (f, x)))
+  let two t =
+    Lam (Typeable.Fun(t,t), fun f -> Lam(t, fun x -> App (f, App (f, x))))
+  let three t =
+    Lam (Typeable.Fun(t,t),
+         fun f -> Lam(t, fun x -> App (f, App (f, App (f, x)))))
+  let plus t =
+    let t1 = Typeable.Fun(t,t) in let t2 = Typeable.Fun(t1,t1) in
+    Lam (t2, fun m -> Lam (t2, fun n ->
+      Lam (t1, fun f -> Lam(t, fun x -> App(App(m,f), App(App(n,f),x))))))
+
+  let plus_2_3 t = App (App (plus t, two t), three t)
+
+  open Convert
+
+  let i' = convert (i Typeable.Int)
+  let plus_2_3' = convert (plus_2_3 Typeable.Int)
+  let eval_plus_2_3' = DeBruijn.intp plus_2_3' DeBruijn.Empty succ 0
+end;;
+[%%expect{|
+module Main :
+  sig
+    val i : 'a Typeable.ty -> ('a -> 'a) HOAS.term
+    val zero : 'a Typeable.ty -> (('a -> 'a) -> 'a -> 'a) HOAS.term
+    val one : 'a Typeable.ty -> (('a -> 'a) -> 'a -> 'a) HOAS.term
+    val two : 'a Typeable.ty -> (('a -> 'a) -> 'a -> 'a) HOAS.term
+    val three : 'a Typeable.ty -> (('a -> 'a) -> 'a -> 'a) HOAS.term
+    val plus :
+      'a Typeable.ty ->
+      ((('a -> 'a) -> 'a -> 'a) ->
+       (('a -> 'a) -> 'a -> 'a) -> ('a -> 'a) -> 'a -> 'a)
+      HOAS.term
+    val plus_2_3 : 'a Typeable.ty -> (('a -> 'a) -> 'a -> 'a) HOAS.term
+    val i' : (unit, int -> int) DeBruijn.term
+    val plus_2_3' : (unit, (int -> int) -> int -> int) DeBruijn.term
+    val eval_plus_2_3' : int
+  end
+|}];;
diff --git a/testsuite/tests/typing-gadts/test.ml b/testsuite/tests/typing-gadts/test.ml
new file mode 100644
index 00000000..a91f685e
--- /dev/null
+++ b/testsuite/tests/typing-gadts/test.ml
@@ -0,0 +1,1232 @@
+(* TEST
+   * expect
+*)
+
+module Exp =
+  struct
+
+    type _ t =
+      | IntLit : int -> int t
+      | BoolLit : bool -> bool t
+      | Pair : 'a t * 'b t -> ('a * 'b) t
+      | App : ('a -> 'b) t * 'a t -> 'b t
+      | Abs : ('a -> 'b) -> ('a -> 'b) t
+
+
+    let rec eval : type s . s t -> s =
+      function
+        | IntLit x -> x
+        | BoolLit y -> y
+        | Pair (x,y) ->
+            (eval x,eval y)
+        | App (f,a) ->
+            (eval f) (eval a)
+        | Abs f -> f
+
+    let discern : type a. a t -> _ = function
+        IntLit _ -> 1
+      | BoolLit _ -> 2
+      | Pair _ -> 3
+      | App _ -> 4
+      | Abs _ -> 5
+  end
+;;
+[%%expect{|
+module Exp :
+  sig
+    type _ t =
+        IntLit : int -> int t
+      | BoolLit : bool -> bool t
+      | Pair : 'a t * 'b t -> ('a * 'b) t
+      | App : ('a -> 'b) t * 'a t -> 'b t
+      | Abs : ('a -> 'b) -> ('a -> 'b) t
+    val eval : 's t -> 's
+    val discern : 'a t -> int
+  end
+|}];;
+
+module List =
+  struct
+    type zero
+    type _ t =
+      | Nil : zero t
+      | Cons : 'a * 'b t -> ('a * 'b) t
+    let head =
+      function
+        | Cons (a,b) -> a
+    let tail =
+      function
+        | Cons (a,b) -> b
+    let rec length : type a . a t -> int =
+      function
+        | Nil -> 0
+        | Cons (a,b) -> length b
+  end
+;;
+[%%expect{|
+module List :
+  sig
+    type zero
+    type _ t = Nil : zero t | Cons : 'a * 'b t -> ('a * 'b) t
+    val head : ('a * 'b) t -> 'a
+    val tail : ('a * 'b) t -> 'b t
+    val length : 'a t -> int
+  end
+|}];;
+
+module Nonexhaustive =
+  struct
+    type 'a u =
+      | C1 : int -> int u
+      | C2 : bool -> bool u
+
+    type 'a v =
+      | C1 : int -> int v
+
+    let unexhaustive : type s . s u -> s =
+      function
+        | C2 x -> x
+
+
+    module M : sig type t type u end =
+      struct
+        type t = int
+        type u = bool
+      end
+    type 'a t =
+      | Foo : M.t -> M.t t
+      | Bar : M.u -> M.u t
+    let same_type : type s . s t * s t -> bool  =
+      function
+        | Foo _ , Foo _ -> true
+        | Bar _, Bar _ -> true
+  end
+;;
+[%%expect{|
+Lines 11-12, characters 6-19:
+11 | ......function
+12 |         | C2 x -> x
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+C1 _
+Lines 24-26, characters 6-30:
+24 | ......function
+25 |         | Foo _ , Foo _ -> true
+26 |         | Bar _, Bar _ -> true
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(Bar _, Foo _)
+module Nonexhaustive :
+  sig
+    type 'a u = C1 : int -> int u | C2 : bool -> bool u
+    type 'a v = C1 : int -> int v
+    val unexhaustive : 's u -> 's
+    module M : sig type t type u end
+    type 'a t = Foo : M.t -> M.t t | Bar : M.u -> M.u t
+    val same_type : 's t * 's t -> bool
+  end
+|}];;
+
+module Exhaustive =
+  struct
+    type t = int
+    type u = bool
+    type 'a v =
+      | Foo : t -> t v
+      | Bar : u -> u v
+
+    let same_type : type s . s v * s v -> bool  =
+      function
+        | Foo _ , Foo _ -> true
+        | Bar _, Bar _ -> true
+  end
+;;
+[%%expect{|
+module Exhaustive :
+  sig
+    type t = int
+    type u = bool
+    type 'a v = Foo : t -> t v | Bar : u -> u v
+    val same_type : 's v * 's v -> bool
+  end
+|}];;
+
+module PR6862 = struct
+  class c (Some x) = object method x : int = x end
+  type _ opt = Just : 'a -> 'a opt | Nothing : 'a opt
+  class d (Just x) = object method x : int = x end
+end;;
+[%%expect{|
+Line 2, characters 10-18:
+2 |   class c (Some x) = object method x : int = x end
+              ^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+None
+Line 4, characters 10-18:
+4 |   class d (Just x) = object method x : int = x end
+              ^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Nothing
+module PR6862 :
+  sig
+    class c : int option -> object method x : int end
+    type _ opt = Just : 'a -> 'a opt | Nothing : 'a opt
+    class d : int opt -> object method x : int end
+  end
+|}];;
+
+module Exhaustive2 = struct
+  type _ t = Int : int t
+  let f (x : bool t option) = match x with None -> ()
+end;;
+[%%expect{|
+module Exhaustive2 :
+  sig type _ t = Int : int t val f : bool t option -> unit end
+|}];;
+
+module PR6220 = struct
+  type 'a t = I : int t | F : float t
+  let f : int t -> int = function I -> 1
+  let g : int t -> int = function I -> 1 | _ -> 2 (* warn *)
+end;;
+[%%expect{|
+Line 4, characters 43-44:
+4 |   let g : int t -> int = function I -> 1 | _ -> 2 (* warn *)
+                                               ^
+Warning 56: this match case is unreachable.
+Consider replacing it with a refutation case ' -> .'
+module PR6220 :
+  sig
+    type 'a t = I : int t | F : float t
+    val f : int t -> int
+    val g : int t -> int
+  end
+|}];;
+
+module PR6403 = struct
+  type (_, _) eq = Refl : ('a, 'a) eq
+  type empty = { bottom : 'a . 'a }
+  type ('a, 'b) sum = Left of 'a | Right of 'b
+
+  let notequal : ((int, bool) eq, empty) sum -> empty = function
+    | Right empty -> empty
+end;;
+[%%expect{|
+module PR6403 :
+  sig
+    type (_, _) eq = Refl : ('a, 'a) eq
+    type empty = { bottom : 'a. 'a; }
+    type ('a, 'b) sum = Left of 'a | Right of 'b
+    val notequal : ((int, bool) eq, empty) sum -> empty
+  end
+|}];;
+
+module PR6437 = struct
+  type ('a, 'b) ctx =
+    | Nil : (unit, unit) ctx
+    | Cons : ('a, 'b) ctx -> ('a * unit, 'b * unit) ctx
+
+  type 'a var =
+    | O : ('a * unit) var
+    | S : 'a var -> ('a * unit) var
+
+  let rec f : type g1 g2. (g1, g2) ctx * g1 var -> g2 var = function
+    | Cons g, O -> O
+    | Cons g, S n -> S (f (g, n))
+    | _ -> .
+  (*| Nil, _ -> (assert false) *)  (* warns, but shouldn't *)
+end;;
+[%%expect{|
+module PR6437 :
+  sig
+    type ('a, 'b) ctx =
+        Nil : (unit, unit) ctx
+      | Cons : ('a, 'b) ctx -> ('a * unit, 'b * unit) ctx
+    type 'a var = O : ('a * unit) var | S : 'a var -> ('a * unit) var
+    val f : ('g1, 'g2) ctx * 'g1 var -> 'g2 var
+  end
+|}];;
+
+module PR6801 = struct
+  type _ value =
+    | String : string -> string value
+    | Float : float -> float value
+    | Any
+
+  let print_string_value (x : string value) =
+    match x with
+    | String s -> print_endline s (* warn : Any *)
+end;;
+[%%expect{|
+Lines 8-9, characters 4-33:
+8 | ....match x with
+9 |     | String s -> print_endline s.................
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Any
+module PR6801 :
+  sig
+    type _ value =
+        String : string -> string value
+      | Float : float -> float value
+      | Any
+    val print_string_value : string value -> unit
+  end
+|}];;
+
+module Existential_escape =
+  struct
+    type _ t = C : int -> int t
+    type u = D : 'a t -> u
+    let eval (D x) = x
+  end
+;;
+[%%expect{|
+Line 5, characters 21-22:
+5 |     let eval (D x) = x
+                         ^
+Error: This expression has type $D_'a t
+       but an expression was expected of type 'a
+       The type constructor $D_'a would escape its scope
+|}];;
+
+module Rectype =
+  struct
+    type (_,_) t = C : ('a,'a) t
+    let f : type s. (s, s*s) t -> unit =
+      fun C -> () (* here s = s*s! *)
+  end
+;;
+[%%expect{|
+module Rectype :
+  sig type (_, _) t = C : ('a, 'a) t val f : ('s, 's * 's) t -> unit end
+|}];;
+
+module Or_patterns =
+  struct
+      type _ t =
+      | IntLit : int -> int t
+      | BoolLit : bool -> bool t
+
+    let rec eval : type s . s t -> unit =
+      function
+        | (IntLit _ | BoolLit _) -> ()
+
+end
+;;
+[%%expect{|
+module Or_patterns :
+  sig
+    type _ t = IntLit : int -> int t | BoolLit : bool -> bool t
+    val eval : 's t -> unit
+  end
+|}];;
+
+module Polymorphic_variants =
+  struct
+      type _ t =
+      | IntLit : int -> int t
+      | BoolLit : bool -> bool t
+
+    let rec eval : type s . [`A] * s t -> unit =
+      function
+        | `A, IntLit _ -> ()
+        | `A, BoolLit _ -> ()
+  end
+;;
+[%%expect{|
+module Polymorphic_variants :
+  sig
+    type _ t = IntLit : int -> int t | BoolLit : bool -> bool t
+    val eval : [ `A ] * 's t -> unit
+  end
+|}];;
+
+module Propagation = struct
+  type _ t =
+      IntLit : int -> int t
+    | BoolLit : bool -> bool t
+
+  let check : type s. s t -> s = function
+    | IntLit n -> n
+    | BoolLit b -> b
+
+  let check : type s. s t -> s = fun x ->
+    let r = match x with
+    | IntLit n -> (n : s )
+    | BoolLit b -> b
+    in r
+end
+;;
+[%%expect{|
+module Propagation :
+  sig
+    type _ t = IntLit : int -> int t | BoolLit : bool -> bool t
+    val check : 's t -> 's
+  end
+|}, Principal{|
+Line 13, characters 19-20:
+13 |     | BoolLit b -> b
+                        ^
+Error: This expression has type bool but an expression was expected of type s
+|}];;
+
+module Normal_constrs = struct
+  type a = A
+  type b = B
+
+  let f = function A -> 1 | B -> 2
+end;;
+[%%expect{|
+Line 5, characters 28-29:
+5 |   let f = function A -> 1 | B -> 2
+                                ^
+Error: This variant pattern is expected to have type a
+       The constructor B does not belong to type a
+|}, Principal{|
+Line 5, characters 28-29:
+5 |   let f = function A -> 1 | B -> 2
+                                ^
+Error: This pattern matches values of type b
+       but a pattern was expected which matches values of type a
+|}];;
+
+module PR6849 = struct
+  type 'a t = Foo : int t
+
+  let f : int -> int = function
+      Foo -> 5
+end;;
+[%%expect{|
+Line 5, characters 6-9:
+5 |       Foo -> 5
+          ^^^
+Error: This pattern matches values of type 'a t
+       but a pattern was expected which matches values of type int
+|}];;
+
+type _ t = Int : int t ;;
+
+let ky x y = ignore (x = y); x ;;
+
+let test : type a. a t -> a =
+  function Int -> ky (1 : a) 1
+;;
+[%%expect{|
+type _ t = Int : int t
+val ky : 'a -> 'a -> 'a = 
+val test : 'a t -> 'a = 
+|}];;
+
+let test : type a. a t -> _ =
+  function Int -> 1       (* ok *)
+;;
+[%%expect{|
+val test : 'a t -> int = 
+|}];;
+
+let test : type a. a t -> _ =
+  function Int -> ky (1 : a) 1  (* fails *)
+;;
+[%%expect{|
+Line 2, characters 18-30:
+2 |   function Int -> ky (1 : a) 1  (* fails *)
+                      ^^^^^^^^^^^^
+Error: This expression has type a = int
+       but an expression was expected of type 'a
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+|}];;
+
+let test : type a. a t -> a = fun x ->
+  let r = match x with Int -> ky (1 : a) 1  (* fails *)
+  in r
+;;
+[%%expect{|
+Line 2, characters 30-42:
+2 |   let r = match x with Int -> ky (1 : a) 1  (* fails *)
+                                  ^^^^^^^^^^^^
+Error: This expression has type a = int
+       but an expression was expected of type 'a
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+|}];;
+
+let test : type a. a t -> a = fun x ->
+  let r = match x with Int -> ky 1 (1 : a)  (* fails *)
+  in r
+;;
+[%%expect{|
+Line 2, characters 30-42:
+2 |   let r = match x with Int -> ky 1 (1 : a)  (* fails *)
+                                  ^^^^^^^^^^^^
+Error: This expression has type a = int
+       but an expression was expected of type 'a
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+|}];;
+
+let test (type a) x =
+  let r = match (x : a t) with Int -> ky 1 1
+  in r
+;;
+[%%expect{|
+val test : 'a t -> int = 
+|}];;
+
+let test : type a. a t -> a = fun x ->
+  let r = match x with Int -> (1 : a)       (* ok! *)
+  in r
+;;
+[%%expect{|
+val test : 'a t -> 'a = 
+|}];;
+
+let test : type a. a t -> _ = fun x ->
+  let r = match x with Int -> 1       (* ok! *)
+  in r
+;;
+[%%expect{|
+val test : 'a t -> int = 
+|}];;
+
+let test : type a. a t -> a = fun x ->
+  let r : a = match x with Int -> 1
+  in r (* ok *)
+;;
+[%%expect{|
+val test : 'a t -> 'a = 
+|}];;
+
+let test2 : type a. a t -> a option = fun x ->
+  let r = ref None in
+  begin match x with Int -> r := Some (1 : a) end;
+  !r (* ok *)
+;;
+[%%expect{|
+val test2 : 'a t -> 'a option = 
+|}];;
+
+let test2 : type a. a t -> a option = fun x ->
+  let r : a option ref = ref None in
+  begin match x with Int -> r := Some 1 end;
+  !r (* ok *)
+;;
+[%%expect{|
+val test2 : 'a t -> 'a option = 
+|}];;
+
+let test2 : type a. a t -> a option = fun x ->
+  let r : a option ref = ref None in
+  let u = ref None in
+  begin match x with Int -> r := Some 1; u := !r end;
+  !u
+;; (* ok (u non-ambiguous) *)
+[%%expect{|
+val test2 : 'a t -> 'a option = 
+|}];;
+
+let test2 : type a. a t -> a option = fun x ->
+  let r : a option ref = ref None in
+  let u = ref None in
+  begin match x with Int -> u := Some 1; r := !u end;
+  !u
+;; (* fails because u : (int | a) option ref *)
+[%%expect{|
+Line 4, characters 46-48:
+4 |   begin match x with Int -> u := Some 1; r := !u end;
+                                                  ^^
+Error: This expression has type int option
+       but an expression was expected of type a option
+       Type int is not compatible with type a = int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+|}];;
+
+let test2 : type a. a t -> a option = fun x ->
+  let u = ref None in
+  let r : a option ref = ref None in
+  begin match x with Int -> r := Some 1; u := !r end;
+  !u
+;; (* ok *)
+[%%expect{|
+val test2 : 'a t -> 'a option = 
+|}];;
+
+let test2 : type a. a t -> a option = fun x ->
+  let u = ref None in
+  let a =
+    let r : a option ref = ref None in
+    begin match x with Int -> r := Some 1; u := !r end;
+    !u
+  in a
+;; (* ok *)
+[%%expect{|
+val test2 : 'a t -> 'a option = 
+|}];;
+
+let either = ky
+let we_y1x (type a) (x : a) (v : a t) =
+  match v with Int -> let y = either 1 x in y
+;; (* fail *)
+[%%expect{|
+val either : 'a -> 'a -> 'a = 
+Line 3, characters 44-45:
+3 |   match v with Int -> let y = either 1 x in y
+                                                ^
+Error: This expression has type a = int
+       but an expression was expected of type 'a
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+|}];;
+
+(* Effect of external consraints *)
+let f (type a) (x : a t) y =
+  ignore (y : a);
+  let r = match x with Int -> (y : a) in (* ok *)
+  r
+;;
+[%%expect{|
+val f : 'a t -> 'a -> 'a = 
+|}];;
+
+let f (type a) (x : a t) y =
+  let r = match x with Int -> (y : a) in
+  ignore (y : a); (* ok *)
+  r
+;;
+[%%expect{|
+val f : 'a t -> 'a -> 'a = 
+|}];;
+
+let f (type a) (x : a t) y =
+  ignore (y : a);
+  let r = match x with Int -> y in (* ok *)
+  r
+;;
+[%%expect{|
+val f : 'a t -> 'a -> 'a = 
+|}];;
+
+let f (type a) (x : a t) y =
+  let r = match x with Int -> y in
+  ignore (y : a); (* ok *)
+  r
+;;
+[%%expect{|
+val f : 'a t -> 'a -> 'a = 
+|}];;
+
+let f (type a) (x : a t) (y : a) =
+  match x with Int -> y (* returns 'a *)
+;;
+[%%expect{|
+val f : 'a t -> 'a -> 'a = 
+|}];;
+
+(* Combination with local modules *)
+
+let f (type a) (x : a t) y =
+  match x with Int ->
+    let module M = struct type b = a let z = (y : b) end
+    in M.z
+;; (* fails because of aliasing... *)
+[%%expect{|
+Line 3, characters 46-47:
+3 |     let module M = struct type b = a let z = (y : b) end
+                                                  ^
+Error: This expression 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
+|}];;
+
+let f (type a) (x : a t) y =
+  match x with Int ->
+    let module M = struct type b = int let z = (y : b) end
+    in M.z
+;; (* ok *)
+[%%expect{|
+val f : 'a t -> int -> int = 
+|}];;
+
+(* Objects and variants *)
+
+type _ h =
+  | Has_m :  h
+  | Has_b :  h
+
+let f : type a. a h -> a = function
+  | Has_m -> object method m = 1 end
+  | Has_b -> object method b = true end
+;;
+[%%expect{|
+type _ h = Has_m : < m : int > h | Has_b : < b : bool > h
+val f : 'a h -> 'a = 
+|}];;
+
+type _ j =
+  | Has_A : [`A of int] j
+  | Has_B : [`B of bool] j
+
+let f : type a. a j -> a = function
+  | Has_A -> `A 1
+  | Has_B -> `B true
+;;
+[%%expect{|
+type _ j = Has_A : [ `A of int ] j | Has_B : [ `B of bool ] j
+val f : 'a j -> 'a = 
+|}];;
+
+type (_,_) eq = Eq : ('a,'a) eq ;;
+
+let f : type a b. (a,b) eq -> ( as 'c) -> ( as 'c) =
+  fun Eq o -> o
+;; (* fail *)
+[%%expect{|
+type (_, _) eq = Eq : ('a, 'a) eq
+Lines 3-4, characters 4-15:
+3 | ....f : type a b. (a,b) eq -> ( as 'c) -> ( as 'c) =
+4 |   fun Eq o -> o
+Error: The universal type variable 'b cannot be generalized:
+       it is already bound to another variable.
+|}];;
+
+let f : type a b. (a,b) eq ->  ->  =
+  fun Eq o -> o
+;; (* fail *)
+[%%expect{|
+Line 2, characters 14-15:
+2 |   fun Eq o -> o
+                  ^
+Error: This expression 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
+|}];;
+
+let f (type a) (type b) (eq : (a,b) eq) (o : ) :  =
+  match eq with Eq -> o ;; (* should fail *)
+[%%expect{|
+Line 2, characters 22-23:
+2 |   match eq with Eq -> o ;; (* should fail *)
+                          ^
+Error: This expression 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
+|}];;
+
+let f : type a b. (a,b) eq ->  ->  =
+  fun Eq o -> o
+;; (* ok *)
+[%%expect{|
+val f : ('a, 'b) eq -> < m : 'a > -> < m : 'b > = 
+|}];;
+
+let int_of_bool : (bool,int) eq = Obj.magic Eq;;
+
+let x = object method m = true end;;
+let y = (x, f int_of_bool x);;
+
+let f : type a. (a, int) eq ->  -> bool =
+  fun Eq o -> ignore (o : ); o#m = 3
+;; (* should be ok *)
+[%%expect{|
+val int_of_bool : (bool, int) eq = Eq
+val x : < m : bool > = 
+val y : < m : bool > * < m : int > = (, )
+val f : ('a, int) eq -> < m : 'a > -> bool = 
+|}];;
+
+let f : type a b. (a,b) eq -> < m : a; .. > -> < m : b > =
+  fun eq o ->
+    ignore (o : < m : a >);
+    let r : < m : b > = match eq with Eq -> o in (* fail with principal *)
+    r;;
+[%%expect{|
+val f : ('a, 'b) eq -> < m : 'a > -> < m : 'b > = 
+|}, Principal{|
+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 >
+       Type a is not compatible with type b = a
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+|}];;
+
+let f : type a b. (a,b) eq -> < m : a; .. > -> < m : b > =
+  fun eq o ->
+    let r : < m : b > = match eq with Eq -> o in (* fail *)
+    ignore (o : < m : a >);
+    r;;
+[%%expect{|
+Line 3, characters 44-45:
+3 |     let r : < m : b > = match eq with Eq -> o in (* fail *)
+                                                ^
+Error: This expression 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
+|}];;
+
+let f : type a b. (a,b) eq -> [> `A of a] -> [> `A of b] =
+  fun Eq o -> o ;; (* fail *)
+[%%expect{|
+Line 2, characters 14-15:
+2 |   fun Eq o -> o ;; (* fail *)
+                  ^
+Error: This expression 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:
+       it would escape the scope of its equation
+|}, Principal{|
+Line 2, characters 9-15:
+2 |   fun Eq o -> o ;; (* fail *)
+             ^^^^^^
+Error: This expression has type ([> `A of b ] as 'a) -> 'a
+       but an expression was expected of type [> `A of a ] -> [> `A of b ]
+       Types for tag `A are incompatible
+|}];;
+
+let f (type a b) (eq : (a,b) eq) (v : [> `A of a]) : [> `A of b] =
+  match eq with Eq -> v ;; (* should fail *)
+[%%expect{|
+Line 2, characters 22-23:
+2 |   match eq with Eq -> v ;; (* should fail *)
+                          ^
+Error: This expression 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:
+       it would escape the scope of its equation
+|}];;
+
+let f : type a b. (a,b) eq -> [< `A of a | `B] -> [< `A of b | `B] =
+  fun Eq o -> o ;; (* fail *)
+[%%expect{|
+Lines 1-2, characters 4-15:
+1 | ....f : type a b. (a,b) eq -> [< `A of a | `B] -> [< `A of b | `B] =
+2 |   fun Eq o -> o..............
+Error: This definition has type
+         'c. ('d, 'c) eq -> ([< `A of 'c & 'f & 'd | `B ] as 'e) -> 'e
+       which is less general than
+         'a 'b. ('a, 'b) eq -> ([< `A of 'b & 'h | `B ] as 'g) -> 'g
+|}];;
+
+let f : type a b. (a,b) eq -> [`A of a | `B] -> [`A of b | `B] =
+  fun Eq o -> o ;; (* ok *)
+[%%expect{|
+val f : ('a, 'b) eq -> [ `A of 'a | `B ] -> [ `A of 'b | `B ] = 
+|}];;
+
+let f : type a. (a, int) eq -> [`A of a] -> bool =
+  fun Eq v -> match v with `A 1 -> true | _ -> false
+;; (* ok *)
+[%%expect{|
+val f : ('a, int) eq -> [ `A of 'a ] -> bool = 
+|}];;
+
+let f : type a b. (a,b) eq -> [> `A of a | `B] -> [`A of b | `B] =
+  fun eq o ->
+    ignore (o : [< `A of a | `B]);
+    let r : [`A of b | `B] = match eq with Eq -> o in (* fail with principal *)
+    r;;
+[%%expect{|
+val f : ('a, 'b) eq -> [ `A of 'a | `B ] -> [ `A of 'b | `B ] = 
+|}, Principal{|
+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 ]
+       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:
+       it would escape the scope of its equation
+|}];;
+
+let f : type a b. (a,b) eq -> [> `A of a | `B] -> [`A of b | `B] =
+  fun eq o ->
+    let r : [`A of b | `B] = match eq with Eq -> o in (* fail *)
+    ignore (o : [< `A of a | `B]);
+    r;;
+[%%expect{|
+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 ]
+       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:
+       it would escape the scope of its equation
+|}];;
+
+(* Pattern matching *)
+
+type 'a t =
+    A of int | B of bool | C of float | D of 'a
+
+type _ ty =
+  | TE : 'a ty -> 'a array ty
+  | TA : int ty
+  | TB : bool ty
+  | TC : float ty
+  | TD : string -> bool ty
+
+let f : type a. a ty -> a t -> int = fun x y ->
+  match x, y with
+  | _, A z -> z
+  | _, B z -> if z then 1 else 2
+  | _, C z -> truncate z
+  | TE TC, D [|1.0|] -> 14
+  | TA, D 0 -> -1
+  | TA, D z -> z
+  | TD "bye", D false -> 13
+  | TD "hello", D true -> 12
+ (* | TB, D z -> if z then 1 else 2 *)
+  | TC, D z -> truncate z
+  | _, D _ -> 0
+;;
+[%%expect{|
+type 'a t = A of int | B of bool | C of float | D of 'a
+type _ ty =
+    TE : 'a ty -> 'a array ty
+  | TA : int ty
+  | TB : bool ty
+  | TC : float ty
+  | TD : string -> bool ty
+val f : 'a ty -> 'a t -> int = 
+|}];;
+
+let f : type a. a ty -> a t -> int = fun x y ->
+  match x, y with
+  | _, A z -> z
+  | _, B z -> if z then 1 else 2
+  | _, C z -> truncate z
+  | TE TC, D [|1.0|] -> 14
+  | TA, D 0 -> -1
+  | TA, D z -> z
+;; (* warn *)
+[%%expect{|
+Lines 2-8, characters 2-16:
+2 | ..match x, y with
+3 |   | _, A z -> z
+4 |   | _, B z -> if z then 1 else 2
+5 |   | _, C z -> truncate z
+6 |   | TE TC, D [|1.0|] -> 14
+7 |   | TA, D 0 -> -1
+8 |   | TA, D z -> z
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(TE TC, D [| 0. |])
+val f : 'a ty -> 'a t -> int = 
+|}];;
+
+let f : type a. a ty -> a t -> int = fun x y ->
+  match y, x with
+  | A z, _ -> z
+  | B z, _ -> if z then 1 else 2
+  | C z, _ -> truncate z
+  | D [|1.0|], TE TC -> 14
+  | D 0, TA -> -1
+  | D z, TA -> z
+;; (* fail *)
+[%%expect{|
+Line 6, characters 6-13:
+6 |   | D [|1.0|], TE TC -> 14
+          ^^^^^^^
+Error: This pattern matches values of type 'a array
+       but a pattern was expected which matches values of type a
+|}];;
+
+type ('a,'b) pair = {right:'a; left:'b}
+
+let f : type a. a ty -> a t -> int = fun x y ->
+  match {left=x; right=y} with
+  | {left=_; right=A z} -> z
+  | {left=_; right=B z} -> if z then 1 else 2
+  | {left=_; right=C z} -> truncate z
+  | {left=TE TC; right=D [|1.0|]} -> 14
+  | {left=TA; right=D 0} -> -1
+  | {left=TA; right=D z} -> z
+;; (* fail *)
+[%%expect{|
+type ('a, 'b) pair = { right : 'a; left : 'b; }
+Line 8, characters 25-32:
+8 |   | {left=TE TC; right=D [|1.0|]} -> 14
+                             ^^^^^^^
+Error: This pattern matches values of type 'a array
+       but a pattern was expected which matches values of type a
+|}];;
+
+type ('a,'b) pair = {left:'a; right:'b}
+
+let f : type a. a ty -> a t -> int = fun x y ->
+  match {left=x; right=y} with
+  | {left=_; right=A z} -> z
+  | {left=_; right=B z} -> if z then 1 else 2
+  | {left=_; right=C z} -> truncate z
+  | {left=TE TC; right=D [|1.0|]} -> 14
+  | {left=TA; right=D 0} -> -1
+  | {left=TA; right=D z} -> z
+;; (* ok *)
+[%%expect{|
+type ('a, 'b) pair = { left : 'a; right : 'b; }
+Lines 4-10, characters 2-29:
+ 4 | ..match {left=x; right=y} with
+ 5 |   | {left=_; right=A z} -> z
+ 6 |   | {left=_; right=B z} -> if z then 1 else 2
+ 7 |   | {left=_; right=C z} -> truncate z
+ 8 |   | {left=TE TC; right=D [|1.0|]} -> 14
+ 9 |   | {left=TA; right=D 0} -> -1
+10 |   | {left=TA; right=D z} -> z
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+{left=TE TC; right=D [| 0. |]}
+val f : 'a ty -> 'a t -> int = 
+|}];;
+
+(* Injectivity *)
+
+module M : sig type 'a t val eq : ('a t, 'b t) eq end =
+  struct type 'a t = int let eq = Eq end
+;;
+
+let f : type a b. (a M.t, b M.t) eq -> (a, b) eq =
+  function Eq -> Eq (* fail *)
+;;
+[%%expect{|
+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
+       but an expression was expected of type (a, b) eq
+       Type a is not compatible with type b
+|}];;
+
+let f : type a b. (a M.t * a, b M.t * b) eq -> (a, b) eq =
+  function Eq -> Eq (* ok *)
+;;
+[%%expect{|
+val f : ('a M.t * 'a, 'b M.t * 'b) eq -> ('a, 'b) eq = 
+|}];;
+
+let f : type a b. (a * a M.t, b * b M.t) eq -> (a, b) eq =
+  function Eq -> Eq (* ok *)
+;;
+[%%expect{|
+val f : ('a * 'a M.t, 'b * 'b M.t) eq -> ('a, 'b) eq = 
+|}];;
+
+(* Applications of polymorphic variants *)
+
+type _ t =
+  | V1 : [`A | `B] t
+  | V2 : [`C | `D] t
+
+let f : type a. a t -> a = function
+  | V1 -> `A
+  | V2 -> `C
+;;
+
+f V1;;
+[%%expect{|
+type _ t = V1 : [ `A | `B ] t | V2 : [ `C | `D ] t
+val f : 'a t -> 'a = 
+- : [ `A | `B ] = `A
+|}];;
+
+(* PR#5425 and PR#5427 *)
+
+type _ int_foo =
+  | IF_constr :  int_foo
+
+type _ int_bar =
+  | IB_constr :  int_bar
+;;
+
+let g (type t) (x:t) (e : t int_foo) (e' : t int_bar) =
+  let IF_constr, IB_constr = e, e' in
+  (x:)
+;;
+[%%expect{|
+type _ int_foo = IF_constr : < foo : int; .. > int_foo
+type _ int_bar = IB_constr : < bar : int; .. > int_bar
+Line 10, characters 3-4:
+10 |   (x:)
+        ^
+Error: This expression 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
+|}];;
+
+let g (type t) (x:t) (e : t int_foo) (e' : t int_bar) =
+  let IF_constr, IB_constr = e, e' in
+  (x:)
+;;
+[%%expect{|
+Line 3, characters 3-4:
+3 |   (x:)
+       ^
+Error: This expression 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
+|}];;
+
+let g (type t) (x:t) (e : t int_foo) (e' : t int_bar) =
+  let IF_constr, IB_constr = e, e' in
+  (x:)
+;;
+[%%expect{|
+Line 3, characters 2-26:
+3 |   (x:)
+      ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This expression has type < bar : int; foo : int; .. >
+       but an expression was expected of type 'a
+       The type constructor $1 would escape its scope
+|}];;
+
+let g (type t) (x:t) (e : t int_foo) (e' : t int_bar) : t =
+  let IF_constr, IB_constr = e, e' in
+  (x:)
+;;
+[%%expect{|
+val g : 't -> 't int_foo -> 't int_bar -> 't = 
+|}];;
+
+let g (type t) (x:t) (e : t int_foo) (e' : t int_bar) =
+  let IF_constr, IB_constr = e, e' in
+  x, x#foo, x#bar
+;;
+[%%expect{|
+val g : 't -> 't int_foo -> 't int_bar -> 't * int * int = 
+|}];;
+
+(* PR#5554 *)
+
+type 'a ty = Int : int -> int ty;;
+
+let f : type a. a ty -> a =
+  fun x -> match x with Int y -> y;;
+
+let g : type a. a ty -> a =
+  let () = () in
+  fun x -> match x with Int y -> y;;
+[%%expect{|
+type 'a ty = Int : int -> int ty
+val f : 'a ty -> 'a = 
+val g : 'a ty -> 'a = 
+|}];;
+
+(* Printing of anonymous variables *)
+
+module M = struct type _ t = int end;;
+module M = struct type _ t = T : int t end;;
+module N = M;;
+[%%expect{|
+module M : sig type _ t = int end
+module M : sig type _ t = T : int t end
+module N = M
+|}];;
+
+(* Principality *)
+
+(* adding a useless equation should not break inference *)
+let f : type a b. (a,b) eq -> (a,int) eq -> a -> b -> _ = fun ab aint a b ->
+  let Eq = ab in
+  let x =
+    let Eq = aint in
+    if true then a else b
+  in ignore x
+;; (* ok *)
+[%%expect{|
+val f : ('a, 'b) eq -> ('a, int) eq -> 'a -> 'b -> unit = 
+|}];;
+
+let f : type a b. (a,b) eq -> (b,int) eq -> a -> b -> _ = fun ab bint a b ->
+  let Eq = ab in
+  let x =
+    let Eq = bint in
+    if true then a else b
+  in ignore x
+;; (* ok *)
+[%%expect{|
+val f : ('a, 'b) eq -> ('b, int) eq -> 'a -> 'b -> unit = 
+|}];;
+
+let f : type a b. (a,b) eq -> (a,int) eq -> a -> b -> _ = fun ab aint a b ->
+  let Eq = aint in
+  let x =
+    let Eq = ab in
+    if true then a else b
+  in ignore x
+;; (* ok *)
+[%%expect{|
+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
+       Type b = int is not compatible with type int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+|}];;
+
+let f : type a b. (a,b) eq -> (b,int) eq -> a -> b -> _ = fun ab bint a b ->
+  let Eq = bint in
+  let x =
+    let Eq = ab in
+    if true then a else b
+  in ignore x
+;; (* ok *)
+[%%expect{|
+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
+       Type int is not compatible with type a = int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+|}];;
+
+let f (type a b c) (b : bool) (w1 : (a,b) eq) (w2 : (a,int) eq) (x : a) (y : b) =
+  let Eq = w1 in
+  let Eq = w2 in
+  if b then x else y
+;;
+[%%expect{|
+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
+       Type a = int is not compatible with type a = int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+|}];;
+
+let f (type a b c) (b : bool) (w1 : (a,b) eq) (w2 : (a,int) eq) (x : a) (y : b) =
+  let Eq = w1 in
+  let Eq = w2 in
+  if b then y else x
+[%%expect{|
+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
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+|}];;
diff --git a/testsuite/tests/typing-gadts/unexpected_existentials.ml b/testsuite/tests/typing-gadts/unexpected_existentials.ml
new file mode 100644
index 00000000..5216dc50
--- /dev/null
+++ b/testsuite/tests/typing-gadts/unexpected_existentials.ml
@@ -0,0 +1,158 @@
+(* TEST
+ * expect
+*)
+(** Test the error message for existential types apparearing
+    in unexpected position *)
+type any = Any: 'a -> any
+[%%expect {|
+type any = Any : 'a -> any
+|}]
+
+let Any x = Any ()
+[%%expect {|
+Line 1, characters 4-9:
+1 | let Any x = Any ()
+        ^^^^^
+Error: Existential types are not allowed in toplevel bindings,
+       but this pattern introduces the existential type $Any_'a.
+|}]
+
+let () =
+  let Any x = Any () and () = () in
+  ()
+[%%expect {|
+Line 2, characters 6-11:
+2 |   let Any x = Any () and () = () in
+          ^^^^^
+Error: Existential types are not allowed in "let ... and ..." bindings,
+       but this pattern introduces the existential type $Any_'a.
+|}]
+
+
+let () =
+  let rec Any x = Any () in
+  ()
+[%%expect {|
+Line 2, characters 10-15:
+2 |   let rec Any x = Any () in
+              ^^^^^
+Error: Existential types are not allowed in recursive bindings,
+       but this pattern introduces the existential type $Any_'a.
+|}]
+
+
+let () =
+  let[@attribute] Any x = Any () in
+  ()
+[%%expect {|
+Line 2, characters 18-23:
+2 |   let[@attribute] Any x = Any () in
+                      ^^^^^
+Error: Existential types are not allowed in presence of attributes,
+       but this pattern introduces the existential type $Any_'a.
+|}]
+
+
+class c (Any x) = object end
+[%%expect {|
+Line 1, characters 8-15:
+1 | class c (Any x) = object end
+            ^^^^^^^
+Error: Existential types are not allowed in class arguments,
+       but this pattern introduces the existential type $Any_'a.
+|}]
+
+class c = object(Any x)end
+[%%expect {|
+Line 1, characters 16-23:
+1 | class c = object(Any x)end
+                    ^^^^^^^
+Error: Existential types are not allowed in self patterns,
+       but this pattern introduces the existential type $Any_'a.
+|}]
+
+type other = Any: _ -> other
+[%%expect {|
+type other = Any : 'a -> other
+|}]
+
+let Any x = Any ()
+[%%expect {|
+Line 1, characters 4-9:
+1 | let Any x = Any ()
+        ^^^^^
+Error: Existential types are not allowed in toplevel bindings,
+       but the constructor Any introduces existential types.
+|}]
+
+
+class c = let Any _x = () in object end
+[%%expect {|
+Line 1, characters 14-20:
+1 | class c = let Any _x = () in object end
+                  ^^^^^^
+Error: Existential types are not allowed in bindings inside class definition,
+       but the constructor Any introduces existential types.
+|}]
+
+let () =
+  let Any x = Any () and () = () in
+  ()
+[%%expect {|
+Line 2, characters 6-11:
+2 |   let Any x = Any () and () = () in
+          ^^^^^
+Error: Existential types are not allowed in "let ... and ..." bindings,
+       but the constructor Any introduces existential types.
+|}]
+
+
+let () =
+  let rec Any x = Any () in
+  ()
+[%%expect {|
+Line 2, characters 10-15:
+2 |   let rec Any x = Any () in
+              ^^^^^
+Error: Existential types are not allowed in recursive bindings,
+       but the constructor Any introduces existential types.
+|}]
+
+
+let () =
+  let[@attribute] Any x = Any () in
+  ()
+[%%expect {|
+Line 2, characters 18-23:
+2 |   let[@attribute] Any x = Any () in
+                      ^^^^^
+Error: Existential types are not allowed in presence of attributes,
+       but the constructor Any introduces existential types.
+|}]
+
+class c (Any x) = object end
+[%%expect {|
+Line 1, characters 8-15:
+1 | class c (Any x) = object end
+            ^^^^^^^
+Error: Existential types are not allowed in class arguments,
+       but the constructor Any introduces existential types.
+|}]
+
+class c = object(Any x) end
+[%%expect {|
+Line 1, characters 16-23:
+1 | class c = object(Any x) end
+                    ^^^^^^^
+Error: Existential types are not allowed in self patterns,
+       but the constructor Any introduces existential types.
+|}]
+
+class c = let Any _x = () in object end
+[%%expect {|
+Line 1, characters 14-20:
+1 | class c = let Any _x = () in object end
+                  ^^^^^^
+Error: Existential types are not allowed in bindings inside class definition,
+       but the constructor Any introduces existential types.
+|}]
diff --git a/testsuite/tests/typing-gadts/unify_mb.ml b/testsuite/tests/typing-gadts/unify_mb.ml
new file mode 100644
index 00000000..cea21717
--- /dev/null
+++ b/testsuite/tests/typing-gadts/unify_mb.ml
@@ -0,0 +1,245 @@
+(* TEST
+   * expect
+*)
+
+(* First-Order Unification by Structural Recursion *)
+(* Conor McBride, JFP 13(6) *)
+(* http://strictlypositive.org/publications.html *)
+
+(* This is a translation of the code part to ocaml *)
+(* Of course, we do not prove other properties, not even termination *)
+
+(* 2.2 Inductive Families *)
+
+type zero = Zero
+type _ succ = Succ
+type _ nat =
+  | NZ : zero nat
+  | NS : 'a nat -> 'a succ nat
+
+type _ fin =
+  | FZ : 'a succ fin
+  | FS : 'a fin -> 'a succ fin
+
+(* We cannot define
+     val empty : zero fin -> 'a
+   because we cannot write an empty pattern matching.
+   This might be useful to have *)
+
+(* In place, prove that the parameter is 'a succ *)
+type _ is_succ = IS : 'a succ is_succ
+
+let fin_succ : type n. n fin -> n is_succ = function
+  | FZ -> IS
+  | FS _ -> IS
+;;
+[%%expect{|
+type zero = Zero
+type _ succ = Succ
+type _ nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
+type _ fin = FZ : 'a succ fin | FS : 'a fin -> 'a succ fin
+type _ is_succ = IS : 'a succ is_succ
+val fin_succ : 'n fin -> 'n is_succ = 
+|}];;
+
+(* 3 First-Order Terms, Renaming and Substitution *)
+
+type 'a term =
+  | Var of 'a fin
+  | Leaf
+  | Fork of 'a term * 'a term
+
+let var x = Var x
+
+let lift r : 'm fin -> 'n term = fun x -> Var (r x)
+
+let rec pre_subst f = function
+  | Var x -> f x
+  | Leaf -> Leaf
+  | Fork (t1, t2) -> Fork (pre_subst f t1, pre_subst f t2)
+
+let comp_subst f g (x : 'a fin) = pre_subst f (g x)
+(*  val comp_subst :
+    ('b fin -> 'c term) -> ('a fin -> 'b term) -> 'a fin -> 'c term *)
+;;
+[%%expect{|
+type 'a term = Var of 'a fin | Leaf | Fork of 'a term * 'a term
+val var : 'a fin -> 'a term = 
+val lift : ('m fin -> 'n fin) -> 'm fin -> 'n term = 
+val pre_subst : ('a fin -> 'b term) -> 'a term -> 'b term = 
+val comp_subst :
+  ('b fin -> 'c term) -> ('a fin -> 'b term) -> 'a fin -> 'c term = 
+|}];;
+
+(* 4 The Occur-Check, through thick and thin *)
+
+let rec thin : type n. n succ fin -> n fin -> n succ fin =
+  fun x y -> match x, y with
+  | FZ, y    -> FS y
+  | FS x, FZ -> FZ
+  | FS x, FS y -> FS (thin x y)
+[%%expect{|
+val thin : 'n succ fin -> 'n fin -> 'n succ fin = 
+|}];;
+
+let bind t f =
+  match t with
+  | None   -> None
+  | Some x -> f x
+(* val bind : 'a option -> ('a -> 'b option) -> 'b option *)
+[%%expect{|
+val bind : 'a option -> ('a -> 'b option) -> 'b option = 
+|}];;
+
+let rec thick : type n. n succ fin -> n succ fin -> n fin option =
+  fun x y -> match x, y with
+  | FZ, FZ   -> None
+  | FZ, FS y -> Some y
+  | FS x, FZ -> let IS = fin_succ x in Some FZ
+  | FS x, FS y ->
+      let IS = fin_succ x in bind (thick x y) (fun x -> Some (FS x))
+[%%expect{|
+val thick : 'n succ fin -> 'n succ fin -> 'n fin option = 
+|}];;
+
+let rec check : type n. n succ fin -> n succ term -> n term option =
+  fun x t -> match t with
+  | Var y -> bind (thick x y) (fun x -> Some (Var x))
+  | Leaf  -> Some Leaf
+  | Fork (t1, t2) ->
+      bind (check x t1) (fun t1 ->
+        bind (check x t2) (fun t2 -> Some (Fork (t1, t2))))
+[%%expect{|
+val check : 'n succ fin -> 'n succ term -> 'n term option = 
+|}];;
+
+let subst_var x t' y =
+  match thick x y with
+  | None -> t'
+  | Some y' -> Var y'
+(* val subst_var : 'a succ fin -> 'a term -> 'a succ fin -> 'a term *)
+[%%expect{|
+val subst_var : 'a succ fin -> 'a term -> 'a succ fin -> 'a term = 
+|}];;
+
+let subst x t' = pre_subst (subst_var x t')
+(* val subst : 'a succ fin -> 'a term -> 'a succ term -> 'a term *)
+;;
+[%%expect{|
+val subst : 'a succ fin -> 'a term -> 'a succ term -> 'a term = 
+|}];;
+
+(* 5 A Refinement of Substitution *)
+
+type (_,_) alist =
+  | Anil  : ('n,'n) alist
+  | Asnoc : ('m,'n) alist * 'm term * 'm succ fin -> ('m succ, 'n) alist
+
+let rec sub : type m n. (m,n) alist -> m fin -> n term = function
+  | Anil -> var
+  | Asnoc (s, t, x) -> comp_subst (sub s) (subst_var x t)
+[%%expect{|
+type (_, _) alist =
+    Anil : ('n, 'n) alist
+  | Asnoc : ('m, 'n) alist * 'm term * 'm succ fin -> ('m succ, 'n) alist
+val sub : ('m, 'n) alist -> 'm fin -> 'n term = 
+|}];;
+
+let rec append : type m n l. (m,n) alist -> (l,m) alist -> (l,n) alist =
+  fun r s -> match s with
+  | Anil -> r
+  | Asnoc (s, t, x) -> Asnoc (append r s, t, x)
+[%%expect{|
+val append : ('m, 'n) alist -> ('l, 'm) alist -> ('l, 'n) alist = 
+|}];;
+
+type _ ealist = EAlist : ('a,'b) alist -> 'a ealist
+
+let asnoc a t' x = EAlist (Asnoc (a, t', x))
+[%%expect{|
+type _ ealist = EAlist : ('a, 'b) alist -> 'a ealist
+val asnoc : ('a, 'b) alist -> 'a term -> 'a succ fin -> 'a succ ealist =
+  
+|}];;
+
+(* Extra work: we need sub to work on ealist too, for examples *)
+let rec weaken_fin : type n. n fin -> n succ fin = function
+  | FZ -> FZ
+  | FS x -> FS (weaken_fin x)
+
+let weaken_term t = pre_subst (fun x -> Var (weaken_fin x)) t
+
+let rec weaken_alist : type m n. (m, n) alist -> (m succ, n succ) alist =
+  function
+    | Anil -> Anil
+    | Asnoc (s, t, x) -> Asnoc (weaken_alist s, weaken_term t, weaken_fin x)
+
+let rec sub' : type m. m ealist -> m fin -> m term = function
+  | EAlist Anil -> var
+  | EAlist (Asnoc (s, t, x)) ->
+      comp_subst (sub' (EAlist (weaken_alist s)))
+        (fun t' -> weaken_term (subst_var x t t'))
+
+let subst' d = pre_subst (sub' d)
+(*  val subst' : 'a ealist -> 'a term -> 'a term *)
+;;
+[%%expect{|
+val weaken_fin : 'n fin -> 'n succ fin = 
+val weaken_term : 'a term -> 'a succ term = 
+val weaken_alist : ('m, 'n) alist -> ('m succ, 'n succ) alist = 
+val sub' : 'm ealist -> 'm fin -> 'm term = 
+val subst' : 'a ealist -> 'a term -> 'a term = 
+|}];;
+
+(* 6 First-Order Unification *)
+
+let flex_flex x y =
+  match thick x y with
+  | Some y' -> asnoc Anil (Var y') x
+  | None -> EAlist Anil
+(* val flex_flex : 'a succ fin -> 'a succ fin -> 'a succ ealist *)
+
+let flex_rigid x t =
+  bind (check x t) (fun t' -> Some (asnoc Anil t' x))
+(* val flex_rigid : 'a succ fin -> 'a succ term -> 'a succ ealist option *)
+
+let rec amgu : type m. m term -> m term -> m ealist -> m ealist option =
+  fun s t acc -> match s, t, acc with
+  | Leaf, Leaf, _   -> Some acc
+  | Leaf, Fork _, _ -> None
+  | Fork _, Leaf, _ -> None
+  | Fork (s1, s2), Fork (t1, t2), _ ->
+      bind (amgu s1 t1 acc) (amgu s2 t2)
+  | Var x, Var y, EAlist Anil -> let IS = fin_succ x in Some (flex_flex x y)
+  | Var x, t,     EAlist Anil -> let IS = fin_succ x in flex_rigid x t
+  | t, Var x,     EAlist Anil -> let IS = fin_succ x in flex_rigid x t
+  | s, t, EAlist(Asnoc(d,r,z)) ->
+      bind (amgu (subst z r s) (subst z r t) (EAlist d))
+           (fun (EAlist d) -> Some (asnoc d r z))
+
+let mgu s t = amgu s t (EAlist Anil)
+(* val mgu : 'a term -> 'a term -> 'a ealist option *)
+;;
+[%%expect{|
+val flex_flex : 'a succ fin -> 'a succ fin -> 'a succ ealist = 
+val flex_rigid : 'a succ fin -> 'a succ term -> 'a succ ealist option = 
+val amgu : 'm term -> 'm term -> 'm ealist -> 'm ealist option = 
+val mgu : 'a term -> 'a term -> 'a ealist option = 
+|}];;
+
+let s = Fork (Var FZ, Fork (Var (FS (FS FZ)), Leaf))
+let t = Fork (Var (FS FZ), Var (FS FZ))
+let d = match mgu s t with Some x -> x | None -> failwith "mgu"
+let s' = subst' d s
+let t' = subst' d t
+;;
+[%%expect{|
+val s : 'a succ succ succ term = Fork (Var FZ, Fork (Var (FS (FS FZ)), Leaf))
+val t : 'a succ succ term = Fork (Var (FS FZ), Var (FS FZ))
+val d : '_weak1 succ succ succ ealist =
+  EAlist (Asnoc (Asnoc (Anil, Fork (Var FZ, Leaf), FZ), Var FZ, FZ))
+val s' : '_weak1 succ succ succ term =
+  Fork (Fork (Var FZ, Leaf), Fork (Var FZ, Leaf))
+val t' : '_weak1 succ succ succ term =
+  Fork (Fork (Var FZ, Leaf), Fork (Var FZ, Leaf))
+|}];;
diff --git a/testsuite/tests/typing-gadts/variables_in_mcomp.ml b/testsuite/tests/typing-gadts/variables_in_mcomp.ml
new file mode 100644
index 00000000..0a370454
--- /dev/null
+++ b/testsuite/tests/typing-gadts/variables_in_mcomp.ml
@@ -0,0 +1,26 @@
+(* TEST
+   * expect
+*)
+
+module M = struct
+  type 'a s = 'a
+  type t = T : 'a s -> t
+end
+
+module N = struct
+  type 'a s = 'a
+  type t = T : 'a s -> t
+end
+
+type (_, _) eq = Refl : ('a, 'a) eq
+
+let f (x : (M.t, N.t) eq)=
+  match x with
+  | Refl -> ()
+
+[%%expect{|
+module M : sig type 'a s = 'a type t = T : 'a s -> t end
+module N : sig type 'a s = 'a type t = T : 'a s -> t end
+type (_, _) eq = Refl : ('a, 'a) eq
+val f : (M.t, N.t) eq -> unit = 
+|}]
diff --git a/testsuite/tests/typing-gadts/yallop_bugs.ml b/testsuite/tests/typing-gadts/yallop_bugs.ml
new file mode 100644
index 00000000..d94e63fd
--- /dev/null
+++ b/testsuite/tests/typing-gadts/yallop_bugs.ml
@@ -0,0 +1,85 @@
+(* TEST
+   * expect
+*)
+
+(* Injectivity *)
+
+type (_, _) eq = Refl : ('a, 'a) eq
+
+let magic : 'a 'b. 'a -> 'b =
+  fun (type a b) (x : a) ->
+    let module M =
+      (functor (T : sig type 'a t end) ->
+       struct
+         let f (Refl : (a T.t, b T.t) eq) = (x :> b)
+       end)
+        (struct type 'a t = unit end)
+    in M.f Refl
+;;
+[%%expect{|
+type (_, _) eq = Refl : ('a, 'a) eq
+Line 8, characters 44-52:
+8 |          let f (Refl : (a T.t, b T.t) eq) = (x :> b)
+                                                ^^^^^^^^
+Error: Type a is not a subtype of b
+|}];;
+
+(* Variance and subtyping *)
+
+type (_, +_) eq = Refl : ('a, 'a) eq
+
+let magic : 'a 'b. 'a -> 'b =
+  fun (type a) (type b) (x : a) ->
+    let bad_proof (type a) =
+      (Refl : (< m : a>, ) eq :> (, < >) eq) in
+    let downcast : type a. (a, < >) eq -> < > -> a =
+      fun (type a) (Refl : (a, < >) eq) (s : < >) -> (s :> a) in
+    (downcast bad_proof ((object method m = x end) :> < >)) # m
+;;
+[%%expect{|
+Line 1, characters 0-36:
+1 | type (_, +_) eq = Refl : ('a, 'a) eq
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this GADT definition, the variance of some parameter
+       cannot be checked
+|}];;
+
+(* Record patterns *)
+
+type _ t =
+  | IntLit : int t
+  | BoolLit : bool t
+
+let check : type s . s t * s -> bool = function
+  | BoolLit, false -> false
+  | IntLit , 6 -> false
+;;
+[%%expect{|
+type _ t = IntLit : int t | BoolLit : bool t
+Lines 5-7, characters 39-23:
+5 | .......................................function
+6 |   | BoolLit, false -> false
+7 |   | IntLit , 6 -> false
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(IntLit, 0)
+val check : 's t * 's -> bool = 
+|}];;
+
+type ('a, 'b) pair = { fst : 'a; snd : 'b }
+
+let check : type s . (s t, s) pair -> bool = function
+  | {fst = BoolLit; snd = false} -> false
+  | {fst = IntLit ; snd =  6} -> false
+;;
+[%%expect{|
+type ('a, 'b) pair = { fst : 'a; snd : 'b; }
+Lines 3-5, characters 45-38:
+3 | .............................................function
+4 |   | {fst = BoolLit; snd = false} -> false
+5 |   | {fst = IntLit ; snd =  6} -> false
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+{fst=IntLit; snd=0}
+val check : ('s t, 's) pair -> bool = 
+|}];;
diff --git a/testsuite/tests/typing-immediate/immediate.ml b/testsuite/tests/typing-immediate/immediate.ml
new file mode 100644
index 00000000..74575aa7
--- /dev/null
+++ b/testsuite/tests/typing-immediate/immediate.ml
@@ -0,0 +1,177 @@
+(* TEST
+   * expect
+*)
+
+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
+|}];;
+
+(* VALID DECLARATIONS *)
+
+module A = struct
+  (* Abstract types can be immediate *)
+  type t [@@immediate]
+
+  (* [@@immediate] tag here is unnecessary but valid since t has it *)
+  type s = t [@@immediate]
+
+  (* Again, valid alias even without tag *)
+  type r = s
+
+  (* Mutually recursive declarations work as well *)
+  type p = q [@@immediate]
+  and q = int
+end;;
+[%%expect{|
+module A :
+  sig
+    type t [@@immediate]
+    type s = t [@@immediate]
+    type r = s
+    type p = q [@@immediate]
+    and q = int
+  end
+|}];;
+
+(* Valid using with constraints *)
+module type X = sig type t end;;
+module Y = struct type t = int end;;
+module Z = ((Y : X with type t = int) : sig type t [@@immediate] end);;
+[%%expect{|
+module type X = sig type t end
+module Y : sig type t = int end
+module Z : sig type t [@@immediate] end
+|}];;
+
+(* Valid using an explicit signature *)
+module M_valid : S = struct type t = int end;;
+module FM_valid = F (struct type t = int end);;
+[%%expect{|
+module M_valid : S
+module FM_valid : S
+|}];;
+
+(* Practical usage over modules *)
+module Foo : sig type t val x : t ref end = struct
+  type t = int
+  let x = ref 0
+end;;
+[%%expect{|
+module Foo : sig type t val x : t ref end
+|}];;
+
+module Bar : sig type t [@@immediate] val x : t ref end = struct
+  type t = int
+  let x = ref 0
+end;;
+[%%expect{|
+module Bar : sig type t [@@immediate] val x : t ref end
+|}];;
+
+let test f =
+  let start = Sys.time() in f ();
+  (Sys.time() -. start);;
+[%%expect{|
+val test : (unit -> 'a) -> float = 
+|}];;
+
+let test_foo () =
+  for i = 0 to 100_000_000 do
+    Foo.x := !Foo.x
+  done;;
+[%%expect{|
+val test_foo : unit -> unit = 
+|}];;
+
+let test_bar () =
+  for i = 0 to 100_000_000 do
+    Bar.x := !Bar.x
+  done;;
+[%%expect{|
+val test_bar : unit -> unit = 
+|}];;
+
+(* Uncomment these to test. Should see substantial speedup!
+let () = Printf.printf "No @@immediate: %fs\n" (test test_foo)
+let () = Printf.printf "With @@immediate: %fs\n" (test test_bar) *)
+
+
+(* INVALID DECLARATIONS *)
+
+(* Cannot directly declare a non-immediate type as immediate *)
+module B = struct
+  type t = string [@@immediate]
+end;;
+[%%expect{|
+Line 2, characters 2-31:
+2 |   type t = string [@@immediate]
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Types marked with the immediate attribute must be non-pointer types
+       like int or bool.
+|}];;
+
+(* Not guaranteed that t is immediate, so this is an invalid declaration *)
+module C = struct
+  type t
+  type s = t [@@immediate]
+end;;
+[%%expect{|
+Line 3, characters 2-26:
+3 |   type s = t [@@immediate]
+      ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Types marked with the immediate attribute must be non-pointer types
+       like int or bool.
+|}];;
+
+(* Can't ascribe to an immediate type signature with a non-immediate type *)
+module D : sig type t [@@immediate] end = struct
+  type t = string
+end;;
+[%%expect{|
+Lines 1-3, characters 42-3:
+1 | ..........................................struct
+2 |   type t = string
+3 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = string end
+       is not included in
+         sig type t [@@immediate] end
+       Type declarations do not match:
+         type t = string
+       is not included in
+         type t [@@immediate]
+       The first is not an immediate type.
+|}];;
+
+(* Same as above but with explicit signature *)
+module M_invalid : S = struct type t = string end;;
+module FM_invalid = F (struct type t = string end);;
+[%%expect{|
+Line 1, characters 23-49:
+1 | module M_invalid : S = struct type t = string end;;
+                           ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match: sig type t = string end is not included in S
+       Type declarations do not match:
+         type t = string
+       is not included in
+         type t [@@immediate]
+       The first is not an immediate type.
+|}];;
+
+(* Can't use a non-immediate type even if mutually recursive *)
+module E = struct
+  type t = s [@@immediate]
+  and s = string
+end;;
+[%%expect{|
+Line 2, characters 2-26:
+2 |   type t = s [@@immediate]
+      ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Types marked with the immediate attribute must be non-pointer types
+       like int or bool.
+|}];;
diff --git a/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml b/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml
new file mode 100644
index 00000000..04334d66
--- /dev/null
+++ b/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml
@@ -0,0 +1,503 @@
+(* TEST
+   * expect
+*)
+
+(*
+   Implicit unpack allows the signature in (val ...) expressions to be omitted.
+
+   It also adds (module M : S) and (module M) patterns, relying on
+   implicit (val ...) for the implementation. Such patterns can only
+   be used in function definition, match clauses, and let ... in.
+
+   New: implicit pack is also supported, and you only need to be able
+   to infer the the module type path from the context.
+ *)
+(* ocaml -principal *)
+
+(* Use a module pattern *)
+let sort (type s) (module Set : Set.S with type elt = s) l =
+  Set.elements (List.fold_right Set.add l Set.empty)
+;;
+[%%expect{|
+val sort : (module Set.S with type elt = 's) -> 's list -> 's list = 
+|}];;
+
+(* No real improvement here? *)
+let make_set (type s) cmp : (module Set.S with type elt = s) =
+  (module Set.Make (struct type t = s let compare = cmp end))
+;;
+[%%expect{|
+val make_set : ('s -> 's -> int) -> (module Set.S with type elt = 's) = 
+|}];;
+
+(* No type annotation here *)
+let sort_cmp (type s) cmp =
+  sort (module Set.Make (struct type t = s let compare = cmp end))
+;;
+[%%expect{|
+val sort_cmp : ('s -> 's -> int) -> 's list -> 's list = 
+|}];;
+
+module type S = sig type t val x : t end;;
+[%%expect{|
+module type S = sig type t val x : t end
+|}];;
+
+let f (module M : S with type t = int) = M.x;;
+[%%expect{|
+val f : (module S with type t = int) -> int = 
+|}];;
+
+let f (module M : S with type t = 'a) = M.x;; (* Error *)
+[%%expect{|
+Line 1, characters 6-37:
+1 | let f (module M : S with type t = 'a) = M.x;; (* Error *)
+          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type of this packed module contains variables:
+       (module S with type t = 'a)
+|}];;
+
+let f (type a) (module M : S with type t = a) = M.x;;
+f (module struct type t = int let x = 1 end);;
+[%%expect{|
+val f : (module S with type t = 'a) -> 'a = 
+- : int = 1
+|}];;
+
+(***)
+
+type 'a s = {s: (module S with type t = 'a)};;
+[%%expect{|
+type 'a s = { s : (module S with type t = 'a); }
+|}];;
+
+{s=(module struct type t = int let x = 1 end)};;
+[%%expect{|
+- : int s = {s = }
+|}];;
+
+let f {s=(module M)} = M.x;; (* Error *)
+[%%expect{|
+Line 1, characters 9-19:
+1 | let f {s=(module M)} = M.x;; (* Error *)
+             ^^^^^^^^^^
+Error: The type of this packed module contains variables:
+       (module S with type t = 'a)
+|}];;
+
+let f (type a) ({s=(module M)} : a s) = M.x;;
+[%%expect{|
+val f : 'a s -> 'a = 
+|}];;
+
+type s = {s: (module S with type t = int)};;
+let f {s=(module M)} = M.x;;
+let f {s=(module M)} {s=(module N)} = M.x + N.x;;
+[%%expect{|
+type s = { s : (module S with type t = int); }
+val f : s -> int = 
+val f : s -> s -> int = 
+|}];;
+
+(***)
+
+module type S = sig val x : int end;;
+[%%expect{|
+module type S = sig val x : int end
+|}];;
+
+let f (module M : S) y (module N : S) = M.x + y + N.x;;
+[%%expect{|
+val f : (module S) -> int -> (module S) -> int = 
+|}];;
+
+let m = (module struct let x = 3 end);; (* Error *)
+[%%expect{|
+Line 1, characters 8-37:
+1 | let m = (module struct let x = 3 end);; (* Error *)
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The signature for this packaged module couldn't be inferred.
+|}];;
+
+let m = (module struct let x = 3 end : S);;
+[%%expect{|
+val m : (module S) = 
+|}];;
+
+f m 1 m;;
+[%%expect{|
+- : int = 7
+|}];;
+f m 1 (module struct let x = 2 end);;
+[%%expect{|
+- : int = 6
+|}];;
+
+(***)
+
+let (module M) = m in M.x;;
+[%%expect{|
+- : int = 3
+|}];;
+
+let (module M) = m;; (* Error: only allowed in [let .. in] *)
+[%%expect{|
+Line 1, characters 4-14:
+1 | let (module M) = m;; (* Error: only allowed in [let .. in] *)
+        ^^^^^^^^^^
+Error: Modules are not allowed in this pattern.
+|}];;
+
+class c = let (module M) = m in object end;; (* Error again *)
+[%%expect{|
+Line 1, characters 14-24:
+1 | class c = let (module M) = m in object end;; (* Error again *)
+                  ^^^^^^^^^^
+Error: Modules are not allowed in this pattern.
+|}];;
+
+module M = (val m);;
+[%%expect{|
+module M : S
+|}];;
+
+(***)
+
+module type S' = sig val f : int -> int end;;
+[%%expect{|
+module type S' = sig val f : int -> int end
+|}];;
+
+(* Even works with recursion, but must be fully explicit *)
+let rec (module M : S') =
+  (module struct let f n = if n <= 0 then 1 else n * M.f (n-1) end : S')
+in M.f 3;;
+[%%expect{|
+- : int = 6
+|}];;
+
+(* Subtyping *)
+
+module type S = sig type t type u val x : t * u end
+
+let f (l : (module S with type t = int and type u = bool) list) =
+  (l :> (module S with type u = bool) list)
+;;
+[%%expect{|
+module type S = sig type t type u val x : t * u end
+val f :
+  (module S with type t = int and type u = bool) list ->
+  (module S with type u = bool) list = 
+|}];;
+
+(* GADTs from the manual *)
+(* the only modification is in to_string *)
+
+module TypEq : sig
+  type ('a, 'b) t
+  val apply: ('a, 'b) t -> 'a -> 'b
+  val refl: ('a, 'a) t
+  val sym: ('a, 'b) t -> ('b, 'a) t
+end = struct
+  type ('a, 'b) t = ('a -> 'b) * ('b -> 'a)
+  let refl = (fun x -> x), (fun x -> x)
+  let apply (f, _) x = f x
+  let sym (f, g) = (g, f)
+end
+
+module rec Typ : sig
+  module type PAIR = sig
+    type t and t1 and t2
+    val eq: (t, t1 * t2) TypEq.t
+    val t1: t1 Typ.typ
+    val t2: t2 Typ.typ
+  end
+
+  type 'a typ =
+    | Int of ('a, int) TypEq.t
+    | String of ('a, string) TypEq.t
+    | Pair of (module PAIR with type t = 'a)
+end = Typ
+
+let int = Typ.Int TypEq.refl
+
+let str = Typ.String TypEq.refl
+
+let pair (type s1) (type s2) t1 t2 =
+  let module P = struct
+    type t = s1 * s2
+    type t1 = s1
+    type t2 = s2
+    let eq = TypEq.refl
+    let t1 = t1
+    let t2 = t2
+  end in
+  Typ.Pair (module P)
+
+open Typ
+let rec to_string: 'a. 'a Typ.typ -> 'a -> string =
+  fun (type s) t x ->
+    match (t : s typ) with
+    | Int eq -> Int.to_string (TypEq.apply eq x)
+    | String eq -> Printf.sprintf "%S" (TypEq.apply eq x)
+    | Pair (module P) ->
+        let (x1, x2) = TypEq.apply P.eq x in
+        Printf.sprintf "(%s,%s)" (to_string P.t1 x1) (to_string P.t2 x2)
+;;
+[%%expect{|
+module TypEq :
+  sig
+    type ('a, 'b) t
+    val apply : ('a, 'b) t -> 'a -> 'b
+    val refl : ('a, 'a) t
+    val sym : ('a, 'b) t -> ('b, 'a) t
+  end
+module rec Typ :
+  sig
+    module type PAIR =
+      sig
+        type t
+        and t1
+        and t2
+        val eq : (t, t1 * t2) TypEq.t
+        val t1 : t1 Typ.typ
+        val t2 : t2 Typ.typ
+      end
+    type 'a typ =
+        Int of ('a, int) TypEq.t
+      | String of ('a, string) TypEq.t
+      | Pair of (module PAIR with type t = 'a)
+  end
+val int : int Typ.typ = Typ.Int 
+val str : string Typ.typ = Typ.String 
+val pair : 's1 Typ.typ -> 's2 Typ.typ -> ('s1 * 's2) Typ.typ = 
+val to_string : 'a Typ.typ -> 'a -> string = 
+|}];;
+
+(* Wrapping maps *)
+module type MapT = sig
+  include Map.S
+  type data
+  type map
+  val of_t : data t -> map
+  val to_t : map -> data t
+end
+
+type ('k,'d,'m) map =
+    (module MapT with type key = 'k and type data = 'd and type map = 'm)
+
+let add (type k) (type d) (type m) (m:(k,d,m) map) x y s =
+   let module M =
+     (val m:MapT with type key = k and type data = d and type map = m) in
+   M.of_t (M.add x y (M.to_t s))
+
+module SSMap = struct
+  include Map.Make(String)
+  type data = string
+  type map = data t
+  let of_t x = x
+  let to_t x = x
+end
+;;
+[%%expect{|
+module type MapT =
+  sig
+    type key
+    type +'a t
+    val empty : 'a t
+    val is_empty : 'a t -> bool
+    val mem : key -> 'a t -> bool
+    val add : key -> 'a -> 'a t -> 'a t
+    val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
+    val singleton : key -> 'a -> 'a t
+    val remove : key -> 'a t -> 'a t
+    val merge :
+      (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+    val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+    val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
+    val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+    val iter : (key -> 'a -> unit) -> 'a t -> unit
+    val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val for_all : (key -> 'a -> bool) -> 'a t -> bool
+    val exists : (key -> 'a -> bool) -> 'a t -> bool
+    val filter : (key -> 'a -> bool) -> 'a t -> 'a t
+    val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
+    val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+    val cardinal : 'a t -> int
+    val bindings : 'a t -> (key * 'a) list
+    val min_binding : 'a t -> key * 'a
+    val min_binding_opt : 'a t -> (key * 'a) option
+    val max_binding : 'a t -> key * 'a
+    val max_binding_opt : 'a t -> (key * 'a) option
+    val choose : 'a t -> key * 'a
+    val choose_opt : 'a t -> (key * 'a) option
+    val split : key -> 'a t -> 'a t * 'a option * 'a t
+    val find : key -> 'a t -> 'a
+    val find_opt : key -> 'a t -> 'a option
+    val find_first : (key -> bool) -> 'a t -> key * 'a
+    val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
+    val find_last : (key -> bool) -> 'a t -> key * 'a
+    val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
+    val map : ('a -> 'b) -> 'a t -> 'b t
+    val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
+    val to_seq : 'a t -> (key * 'a) Seq.t
+    val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
+    val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
+    val of_seq : (key * 'a) Seq.t -> 'a t
+    type data
+    type map
+    val of_t : data t -> map
+    val to_t : map -> data t
+  end
+type ('k, 'd, 'm) map =
+    (module MapT with type data = 'd and type key = 'k and type map = 'm)
+val add : ('k, 'd, 'm) map -> 'k -> 'd -> 'm -> 'm = 
+module SSMap :
+  sig
+    type key = String.t
+    type 'a t = 'a Map.Make(String).t
+    val empty : 'a t
+    val is_empty : 'a t -> bool
+    val mem : key -> 'a t -> bool
+    val add : key -> 'a -> 'a t -> 'a t
+    val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
+    val singleton : key -> 'a -> 'a t
+    val remove : key -> 'a t -> 'a t
+    val merge :
+      (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+    val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+    val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
+    val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+    val iter : (key -> 'a -> unit) -> 'a t -> unit
+    val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val for_all : (key -> 'a -> bool) -> 'a t -> bool
+    val exists : (key -> 'a -> bool) -> 'a t -> bool
+    val filter : (key -> 'a -> bool) -> 'a t -> 'a t
+    val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
+    val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+    val cardinal : 'a t -> int
+    val bindings : 'a t -> (key * 'a) list
+    val min_binding : 'a t -> key * 'a
+    val min_binding_opt : 'a t -> (key * 'a) option
+    val max_binding : 'a t -> key * 'a
+    val max_binding_opt : 'a t -> (key * 'a) option
+    val choose : 'a t -> key * 'a
+    val choose_opt : 'a t -> (key * 'a) option
+    val split : key -> 'a t -> 'a t * 'a option * 'a t
+    val find : key -> 'a t -> 'a
+    val find_opt : key -> 'a t -> 'a option
+    val find_first : (key -> bool) -> 'a t -> key * 'a
+    val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
+    val find_last : (key -> bool) -> 'a t -> key * 'a
+    val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
+    val map : ('a -> 'b) -> 'a t -> 'b t
+    val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
+    val to_seq : 'a t -> (key * 'a) Seq.t
+    val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
+    val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
+    val of_seq : (key * 'a) Seq.t -> 'a t
+    type data = string
+    type map = data t
+    val of_t : 'a -> 'a
+    val to_t : 'a -> 'a
+  end
+|}];;
+
+let ssmap =
+  (module SSMap:
+   MapT with type key = string and type data = string and type map = SSMap.map)
+;;
+[%%expect{|
+val ssmap :
+  (module MapT with type data = string and type key = string and type map =
+   SSMap.map) =
+  
+|}];;
+
+let ssmap =
+  (module struct include SSMap end :
+   MapT with type key = string and type data = string and type map = SSMap.map)
+;;
+[%%expect{|
+val ssmap :
+  (module MapT with type data = string and type key = string and type map =
+   SSMap.map) =
+  
+|}];;
+
+let ssmap =
+  (let module S = struct include SSMap end in (module S) :
+  (module
+   MapT with type key = string and type data = string and type map = SSMap.map))
+;;
+[%%expect{|
+val ssmap :
+  (module MapT with type data = string and type key = string and type map =
+   SSMap.map) =
+  
+|}];;
+
+let ssmap =
+  (module SSMap: MapT with type key = _ and type data = _ and type map = _)
+;;
+[%%expect{|
+val ssmap :
+  (module MapT with type data = SSMap.data and type key = SSMap.key and type map =
+   SSMap.map) =
+  
+|}];;
+
+let ssmap : (_,_,_) map = (module SSMap);;
+[%%expect{|
+val ssmap : (SSMap.key, SSMap.data, SSMap.map) map = 
+|}];;
+
+add ssmap;;
+[%%expect{|
+- : SSMap.key -> SSMap.data -> SSMap.map -> SSMap.map = 
+|}];;
+
+(*****)
+
+module type S = sig type t end
+
+let x =
+  (module struct type elt = A type t = elt list end : S with type t = _ list)
+;;
+[%%expect{|
+module type S = sig type t end
+Line 4, characters 10-51:
+4 |   (module struct type elt = A type t = elt list end : S with type t = _ list)
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type t in this module cannot be exported.
+       Its type contains local dependencies: elt list
+|}];;
+
+type 'a s = (module S with type t = 'a);;
+[%%expect{|
+type 'a s = (module S with type t = 'a)
+|}];;
+
+let x : 'a s = (module struct type t = int end);;
+[%%expect{|
+val x : int s = 
+|}];;
+
+let x : 'a s = (module struct type t = A end);;
+[%%expect{|
+Line 1, characters 23-44:
+1 | let x : 'a s = (module struct type t = A end);;
+                           ^^^^^^^^^^^^^^^^^^^^^
+Error: The type t in this module cannot be exported.
+       Its type contains local dependencies: t
+|}];;
+
+let x : 'a s = (module struct end);;
+[%%expect{|
+Line 1, characters 23-33:
+1 | let x : 'a s = (module struct end);;
+                           ^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match: sig end is not included in S
+       The type `t' is required but not provided
+|}];;
diff --git a/testsuite/tests/typing-labels/mixin.ml b/testsuite/tests/typing-labels/mixin.ml
new file mode 100644
index 00000000..ed5848c9
--- /dev/null
+++ b/testsuite/tests/typing-labels/mixin.ml
@@ -0,0 +1,157 @@
+(* TEST *)
+
+open StdLabels
+open MoreLabels
+
+(* Use maps for substitutions and sets for free variables *)
+
+module Subst = Map.Make(struct type t = string let compare = compare end)
+module Names = Set.Make(struct type t = string let compare = compare end)
+
+
+(* Variables are common to lambda and expr *)
+
+type var = [`Var of string]
+
+let subst_var ~subst : var -> _ =
+  function `Var s as x ->
+    try Subst.find s subst
+    with Not_found -> x
+
+let free_var : var -> _ = function `Var s -> Names.singleton s
+
+
+(* The lambda language: free variables, substitutions, and evaluation *)
+
+type 'a lambda = [`Var of string | `Abs of string * 'a | `App of 'a * 'a]
+
+let free_lambda ~free_rec : _ lambda -> _ = function
+    #var as x -> free_var x
+  | `Abs (s, t) -> Names.remove s (free_rec t)
+  | `App (t1, t2) -> Names.union (free_rec t1) (free_rec t2)
+
+let map_lambda ~map_rec : _ lambda -> _ = function
+    #var as x -> x
+  | `Abs (s, t) as l ->
+      let t' = map_rec t in
+      if t == t' then l else `Abs(s, t')
+  | `App (t1, t2) as l ->
+      let t'1 = map_rec t1 and t'2 = map_rec t2 in
+      if t'1 == t1 && t'2 == t2 then l else `App (t'1, t'2)
+
+let next_id =
+  let current = ref 3 in
+  fun () -> incr current; !current
+
+let subst_lambda ~subst_rec ~free ~subst : _ lambda -> _ = function
+    #var as x -> subst_var ~subst x
+  | `Abs(s, t) as l ->
+      let used = free t in
+      let used_expr =
+        Subst.fold subst ~init:[]
+          ~f:(fun ~key ~data acc ->
+                if Names.mem s used then data::acc else acc) in
+      if List.exists used_expr ~f:(fun t -> Names.mem s (free t)) then
+        let name = s ^ Int.to_string (next_id ()) in
+        `Abs(name,
+             subst_rec ~subst:(Subst.add ~key:s ~data:(`Var name) subst) t)
+      else
+        map_lambda ~map_rec:(subst_rec ~subst:(Subst.remove s subst)) l
+  | `App _ as l ->
+      map_lambda ~map_rec:(subst_rec ~subst) l
+
+let eval_lambda ~eval_rec ~subst l =
+  match map_lambda ~map_rec:eval_rec l with
+    `App(`Abs(s,t1), t2) ->
+      eval_rec (subst ~subst:(Subst.add ~key:s ~data:t2 Subst.empty) t1)
+  | t -> t
+
+(* Specialized versions to use on lambda *)
+
+let rec free1 x = free_lambda ~free_rec:free1 x
+let rec subst1 ~subst = subst_lambda ~subst_rec:subst1 ~free:free1 ~subst
+let rec eval1 x = eval_lambda ~eval_rec:eval1 ~subst:subst1 x
+
+
+(* The expr language of arithmetic expressions *)
+
+type 'a expr =
+    [`Var of string | `Num of int | `Add of 'a * 'a
+    | `Neg of 'a | `Mult of 'a * 'a]
+
+let free_expr ~free_rec : _ expr -> _ = function
+    #var as x -> free_var x
+  | `Num _ -> Names.empty
+  | `Add(x, y) -> Names.union (free_rec x) (free_rec y)
+  | `Neg x -> free_rec x
+  | `Mult(x, y) -> Names.union (free_rec x) (free_rec y)
+
+(* Here map_expr helps a lot *)
+let map_expr ~map_rec : _ expr -> _ = function
+    #var as x -> x
+  | `Num _ as x -> x
+  | `Add(x, y) as e ->
+      let x' = map_rec x and y' = map_rec y in
+      if x == x' && y == y' then e
+      else `Add(x', y')
+  | `Neg x as e ->
+      let x' = map_rec x in
+      if x == x' then e else `Neg x'
+  | `Mult(x, y) as e ->
+      let x' = map_rec x and y' = map_rec y in
+      if x == x' && y == y' then e
+      else `Mult(x', y')
+
+let subst_expr ~subst_rec ~subst : _ expr -> _ = function
+    #var as x -> subst_var ~subst x
+  | #expr as e -> map_expr ~map_rec:(subst_rec ~subst) e
+
+let eval_expr ~eval_rec e =
+  match map_expr ~map_rec:eval_rec e with
+    `Add(`Num m, `Num n) -> `Num (m+n)
+  | `Neg(`Num n) -> `Num (-n)
+  | `Mult(`Num m, `Num n) -> `Num (m*n)
+  | #expr as e -> e
+
+(* Specialized versions *)
+
+let rec free2 x = free_expr ~free_rec:free2 x
+let rec subst2 ~subst = subst_expr ~subst_rec:subst2 ~subst
+let rec eval2 x = eval_expr ~eval_rec:eval2 x
+
+
+(* The lexpr language, reunion of lambda and expr *)
+
+type lexpr =
+  [ `Var of string | `Abs of string * lexpr | `App of lexpr * lexpr
+  | `Num of int | `Add of lexpr * lexpr | `Neg of lexpr
+  | `Mult of lexpr * lexpr ]
+
+let rec free : lexpr -> _ = function
+    #lambda as x -> free_lambda ~free_rec:free x
+  | #expr as x -> free_expr ~free_rec:free x
+
+let rec subst ~subst:s : lexpr -> _ = function
+    #lambda as x -> subst_lambda ~subst_rec:subst ~subst:s ~free x
+  | #expr as x -> subst_expr ~subst_rec:subst ~subst:s x
+
+let rec eval : lexpr -> _ = function
+    #lambda as x -> eval_lambda ~eval_rec:eval ~subst x
+  | #expr as x -> eval_expr ~eval_rec:eval x
+
+let rec print = function
+  | `Var id -> print_string id
+  | `Abs (id, l) -> print_string ("\ " ^ id ^ " . "); print l
+  | `App (l1, l2) -> print l1; print_string " "; print l2
+  | `Num x -> print_int x
+  | `Add (e1, e2) -> print e1; print_string " + "; print e2
+  | `Neg e -> print_string "-"; print e
+  | `Mult (e1, e2) -> print e1; print_string " * "; print e2
+
+let () =
+  let e1 = eval1 (`App(`Abs("x",`Var"x"), `Var"y")) in
+  let e2 = eval2 (`Add(`Mult(`Num 3,`Neg(`Num 2)), `Var"x")) in
+  let e3 = eval (`Add(`App(`Abs("x",`Mult(`Var"x",`Var"x")),`Num 2), `Num 5)) in
+  print e1; print_newline ();
+  print e2; print_newline ();
+  print e3; print_newline ()
diff --git a/testsuite/tests/typing-labels/mixin.reference b/testsuite/tests/typing-labels/mixin.reference
new file mode 100644
index 00000000..27087bd9
--- /dev/null
+++ b/testsuite/tests/typing-labels/mixin.reference
@@ -0,0 +1,3 @@
+y
+-6 + x
+9
diff --git a/testsuite/tests/typing-labels/mixin2.ml b/testsuite/tests/typing-labels/mixin2.ml
new file mode 100644
index 00000000..0beebf49
--- /dev/null
+++ b/testsuite/tests/typing-labels/mixin2.ml
@@ -0,0 +1,192 @@
+(* TEST *)
+
+(* Full fledge version, using objects to structure code *)
+
+open StdLabels
+open MoreLabels
+
+(* Use maps for substitutions and sets for free variables *)
+
+module Subst = Map.Make(struct type t = string let compare = compare end)
+module Names = Set.Make(struct type t = string let compare = compare end)
+
+(* To build recursive objects *)
+
+let lazy_fix make =
+  let rec obj () = make (lazy (obj ()) : _ Lazy.t) in
+  obj ()
+
+let (!!) = Lazy.force
+
+(* The basic operations *)
+
+class type ['a, 'b] ops =
+  object
+    method free : 'b -> Names.t
+    method subst : sub:'a Subst.t -> 'b -> 'a
+    method eval : 'b -> 'a
+  end
+
+(* Variables are common to lambda and expr *)
+
+type var = [`Var of string]
+
+class ['a] var_ops = object (self : ('a, var) #ops)
+  constraint 'a = [> var]
+  method subst ~sub (`Var s as x) =
+    try Subst.find s sub with Not_found -> x
+  method free (`Var s) =
+    Names.singleton s
+  method eval (#var as v) = v
+end
+
+(* The lambda language: free variables, substitutions, and evaluation *)
+
+type 'a lambda = [`Var of string | `Abs of string * 'a | `App of 'a * 'a]
+
+let next_id =
+  let current = ref 3 in
+  fun () -> incr current; !current
+
+class ['a] lambda_ops (ops : ('a,'a) #ops Lazy.t) =
+  let var : 'a var_ops = new var_ops
+  and free = lazy !!ops#free
+  and subst = lazy !!ops#subst
+  and eval = lazy !!ops#eval in
+  object (self : ('a, 'a lambda) #ops)
+    constraint 'a = [> 'a lambda]
+    method free = function
+        #var as x -> var#free x
+      | `Abs (s, t) -> Names.remove s (!!free t)
+      | `App (t1, t2) -> Names.union (!!free t1) (!!free t2)
+
+    method map ~f = function
+        #var as x -> x
+      | `Abs (s, t) as l ->
+          let t' = f t in
+          if t == t' then l else `Abs(s, t')
+      | `App (t1, t2) as l ->
+          let t'1 = f t1 and t'2 = f t2 in
+          if t'1 == t1 && t'2 == t2 then l else `App (t'1, t'2)
+
+    method subst ~sub = function
+        #var as x -> var#subst ~sub x
+      | `Abs(s, t) as l ->
+          let used = !!free t in
+          let used_expr =
+            Subst.fold sub ~init:[]
+              ~f:(fun ~key ~data acc ->
+                if Names.mem s used then data::acc else acc) in
+          if List.exists used_expr ~f:(fun t -> Names.mem s (!!free t)) then
+            let name = s ^ Int.to_string (next_id ()) in
+            `Abs(name,
+                 !!subst ~sub:(Subst.add ~key:s ~data:(`Var name) sub) t)
+          else
+            self#map ~f:(!!subst ~sub:(Subst.remove s sub)) l
+      | `App _ as l ->
+          self#map ~f:(!!subst ~sub) l
+
+    method eval l =
+      match self#map ~f:!!eval l with
+        `App(`Abs(s,t1), t2) ->
+          !!eval (!!subst ~sub:(Subst.add ~key:s ~data:t2 Subst.empty) t1)
+      | t -> t
+end
+
+(* Operations specialized to lambda *)
+
+let lambda = lazy_fix (new lambda_ops)
+
+(* The expr language of arithmetic expressions *)
+
+type 'a expr =
+    [ `Var of string | `Num of int | `Add of 'a * 'a
+    | `Neg of 'a | `Mult of 'a * 'a]
+
+class ['a] expr_ops (ops : ('a,'a) #ops Lazy.t) =
+  let var : 'a var_ops = new var_ops
+  and free = lazy !!ops#free
+  and subst = lazy !!ops#subst
+  and eval = lazy !!ops#eval in
+  object (self : ('a, 'a expr) #ops)
+    constraint 'a = [> 'a expr]
+    method free = function
+        #var as x -> var#free x
+      | `Num _ -> Names.empty
+      | `Add(x, y) -> Names.union (!!free x) (!!free y)
+      | `Neg x -> !!free x
+      | `Mult(x, y) -> Names.union (!!free x) (!!free y)
+
+    method map ~f = function
+        #var as x -> x
+      | `Num _ as x -> x
+      | `Add(x, y) as e ->
+          let x' = f x and y' = f y in
+          if x == x' && y == y' then e
+          else `Add(x', y')
+      | `Neg x as e ->
+          let x' = f x in
+          if x == x' then e else `Neg x'
+      | `Mult(x, y) as e ->
+          let x' = f x and y' = f y in
+          if x == x' && y == y' then e
+          else `Mult(x', y')
+
+    method subst ~sub = function
+        #var as x -> var#subst ~sub x
+      | #expr as e -> self#map ~f:(!!subst ~sub) e
+
+    method eval (#expr as e) =
+      match self#map ~f:!!eval e with
+        `Add(`Num m, `Num n) -> `Num (m+n)
+      | `Neg(`Num n) -> `Num (-n)
+      | `Mult(`Num m, `Num n) -> `Num (m*n)
+      | e -> e
+  end
+
+(* Specialized versions *)
+
+let expr = lazy_fix (new expr_ops)
+
+(* The lexpr language, reunion of lambda and expr *)
+
+type 'a lexpr = [ 'a lambda | 'a expr ]
+
+class ['a] lexpr_ops (ops : ('a,'a) #ops Lazy.t) =
+  let lambda = new lambda_ops ops in
+  let expr = new expr_ops ops in
+  object (self : ('a, 'a lexpr) #ops)
+    constraint 'a = [> 'a lexpr]
+    method free = function
+        #lambda as x -> lambda#free x
+      | #expr as x -> expr#free x
+
+    method subst ~sub = function
+        #lambda as x -> lambda#subst ~sub x
+      | #expr as x -> expr#subst ~sub x
+
+    method eval = function
+        #lambda as x -> lambda#eval x
+      | #expr as x -> expr#eval x
+end
+
+let lexpr = lazy_fix (new lexpr_ops)
+
+let rec print = function
+  | `Var id -> print_string id
+  | `Abs (id, l) -> print_string ("\ " ^ id ^ " . "); print l
+  | `App (l1, l2) -> print l1; print_string " "; print l2
+  | `Num x -> print_int x
+  | `Add (e1, e2) -> print e1; print_string " + "; print e2
+  | `Neg e -> print_string "-"; print e
+  | `Mult (e1, e2) -> print e1; print_string " * "; print e2
+
+let () =
+  let e1 = lambda#eval (`App(`Abs("x",`Var"x"), `Var"y")) in
+  let e2 = expr#eval (`Add(`Mult(`Num 3,`Neg(`Num 2)), `Var"x")) in
+  let e3 =
+    lexpr#eval (`Add(`App(`Abs("x",`Mult(`Var"x",`Var"x")),`Num 2), `Num 5))
+  in
+  print e1; print_newline ();
+  print e2; print_newline ();
+  print e3; print_newline ()
diff --git a/testsuite/tests/typing-labels/mixin2.reference b/testsuite/tests/typing-labels/mixin2.reference
new file mode 100644
index 00000000..27087bd9
--- /dev/null
+++ b/testsuite/tests/typing-labels/mixin2.reference
@@ -0,0 +1,3 @@
+y
+-6 + x
+9
diff --git a/testsuite/tests/typing-labels/mixin3.ml b/testsuite/tests/typing-labels/mixin3.ml
new file mode 100644
index 00000000..92975a8b
--- /dev/null
+++ b/testsuite/tests/typing-labels/mixin3.ml
@@ -0,0 +1,186 @@
+(* TEST *)
+
+(* Full fledge version, using objects to structure code *)
+
+open StdLabels
+open MoreLabels
+
+(* Use maps for substitutions and sets for free variables *)
+
+module Subst = Map.Make(struct type t = string let compare = compare end)
+module Names = Set.Make(struct type t = string let compare = compare end)
+
+(* To build recursive objects *)
+
+let lazy_fix make =
+  let rec obj () = make (lazy (obj ()) : _ Lazy.t) in
+  obj ()
+
+let (!!) = Lazy.force
+
+(* The basic operations *)
+
+class type ['a, 'b] ops =
+  object
+    method free : 'b -> Names.t
+    method subst : sub:'a Subst.t -> 'b -> 'a
+    method eval : 'b -> 'a
+  end
+
+(* Variables are common to lambda and expr *)
+
+type var = [`Var of string]
+
+let var = object (self : ([>var], var) #ops)
+  method subst ~sub (`Var s as x) =
+    try Subst.find s sub with Not_found -> x
+  method free (`Var s) =
+    Names.singleton s
+  method eval (#var as v) = v
+end
+
+(* The lambda language: free variables, substitutions, and evaluation *)
+
+type 'a lambda = [`Var of string | `Abs of string * 'a | `App of 'a * 'a]
+
+let next_id =
+  let current = ref 3 in
+  fun () -> incr current; !current
+
+let lambda_ops (ops : ('a,'a) #ops Lazy.t) =
+  let free = lazy !!ops#free
+  and subst = lazy !!ops#subst
+  and eval = lazy !!ops#eval in
+  object (self : ([> 'a lambda], 'a lambda) #ops)
+    method free = function
+        #var as x -> var#free x
+      | `Abs (s, t) -> Names.remove s (!!free t)
+      | `App (t1, t2) -> Names.union (!!free t1) (!!free t2)
+
+    method private map ~f = function
+        #var as x -> x
+      | `Abs (s, t) as l ->
+          let t' = f t in
+          if t == t' then l else `Abs(s, t')
+      | `App (t1, t2) as l ->
+          let t'1 = f t1 and t'2 = f t2 in
+          if t'1 == t1 && t'2 == t2 then l else `App (t'1, t'2)
+
+    method subst ~sub = function
+        #var as x -> var#subst ~sub x
+      | `Abs(s, t) as l ->
+          let used = !!free t in
+          let used_expr =
+            Subst.fold sub ~init:[]
+              ~f:(fun ~key ~data acc ->
+                if Names.mem s used then data::acc else acc) in
+          if List.exists used_expr ~f:(fun t -> Names.mem s (!!free t)) then
+            let name = s ^ Int.to_string (next_id ()) in
+            `Abs(name,
+                 !!subst ~sub:(Subst.add ~key:s ~data:(`Var name) sub) t)
+          else
+            self#map ~f:(!!subst ~sub:(Subst.remove s sub)) l
+      | `App _ as l ->
+          self#map ~f:(!!subst ~sub) l
+
+    method eval l =
+      match self#map ~f:!!eval l with
+        `App(`Abs(s,t1), t2) ->
+          !!eval (!!subst ~sub:(Subst.add ~key:s ~data:t2 Subst.empty) t1)
+      | t -> t
+end
+
+(* Operations specialized to lambda *)
+
+let lambda = lazy_fix lambda_ops
+
+(* The expr language of arithmetic expressions *)
+
+type 'a expr =
+    [ `Var of string | `Num of int | `Add of 'a * 'a
+    | `Neg of 'a | `Mult of 'a * 'a]
+
+let expr_ops (ops : ('a,'a) #ops Lazy.t) =
+  let free = lazy !!ops#free
+  and subst = lazy !!ops#subst
+  and eval = lazy !!ops#eval in
+  object (self : ([> 'a expr], 'a expr) #ops)
+    method free = function
+        #var as x -> var#free x
+      | `Num _ -> Names.empty
+      | `Add(x, y) -> Names.union (!!free x) (!!free y)
+      | `Neg x -> !!free x
+      | `Mult(x, y) -> Names.union (!!free x) (!!free y)
+
+    method private map ~f = function
+        #var as x -> x
+      | `Num _ as x -> x
+      | `Add(x, y) as e ->
+          let x' = f x and y' = f y in
+          if x == x' && y == y' then e
+          else `Add(x', y')
+      | `Neg x as e ->
+          let x' = f x in
+          if x == x' then e else `Neg x'
+      | `Mult(x, y) as e ->
+          let x' = f x and y' = f y in
+          if x == x' && y == y' then e
+          else `Mult(x', y')
+
+    method subst ~sub = function
+        #var as x -> var#subst ~sub x
+      | #expr as e -> self#map ~f:(!!subst ~sub) e
+
+    method eval (#expr as e) =
+      match self#map ~f:!!eval e with
+        `Add(`Num m, `Num n) -> `Num (m+n)
+      | `Neg(`Num n) -> `Num (-n)
+      | `Mult(`Num m, `Num n) -> `Num (m*n)
+      | e -> e
+  end
+
+(* Specialized versions *)
+
+let expr = lazy_fix expr_ops
+
+(* The lexpr language, reunion of lambda and expr *)
+
+type 'a lexpr = [ 'a lambda | 'a expr ]
+
+let lexpr_ops (ops : ('a,'a) #ops Lazy.t) =
+  let lambda = lambda_ops ops in
+  let expr = expr_ops ops in
+  object (self : ([> 'a lexpr], 'a lexpr) #ops)
+    method free = function
+        #lambda as x -> lambda#free x
+      | #expr as x -> expr#free x
+
+    method subst ~sub = function
+        #lambda as x -> lambda#subst ~sub x
+      | #expr as x -> expr#subst ~sub x
+
+    method eval = function
+        #lambda as x -> lambda#eval x
+      | #expr as x -> expr#eval x
+end
+
+let lexpr = lazy_fix lexpr_ops
+
+let rec print = function
+  | `Var id -> print_string id
+  | `Abs (id, l) -> print_string ("\ " ^ id ^ " . "); print l
+  | `App (l1, l2) -> print l1; print_string " "; print l2
+  | `Num x -> print_int x
+  | `Add (e1, e2) -> print e1; print_string " + "; print e2
+  | `Neg e -> print_string "-"; print e
+  | `Mult (e1, e2) -> print e1; print_string " * "; print e2
+
+let () =
+  let e1 = lambda#eval (`App(`Abs("x",`Var"x"), `Var"y")) in
+  let e2 = expr#eval (`Add(`Mult(`Num 3,`Neg(`Num 2)), `Var"x")) in
+  let e3 =
+    lexpr#eval (`Add(`App(`Abs("x",`Mult(`Var"x",`Var"x")),`Num 2), `Num 5))
+  in
+  print e1; print_newline ();
+  print e2; print_newline ();
+  print e3; print_newline ()
diff --git a/testsuite/tests/typing-labels/mixin3.reference b/testsuite/tests/typing-labels/mixin3.reference
new file mode 100644
index 00000000..27087bd9
--- /dev/null
+++ b/testsuite/tests/typing-labels/mixin3.reference
@@ -0,0 +1,3 @@
+y
+-6 + x
+9
diff --git a/testsuite/tests/typing-misc-bugs/core_array_reduced_ok.ml b/testsuite/tests/typing-misc-bugs/core_array_reduced_ok.ml
new file mode 100644
index 00000000..de5eb117
--- /dev/null
+++ b/testsuite/tests/typing-misc-bugs/core_array_reduced_ok.ml
@@ -0,0 +1,101 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+type sexp = A of string | L of sexp list
+type 'a t = 'a array
+let _ = fun (_ : 'a t)  -> ()
+
+let array_of_sexp _ _ = [| |]
+let sexp_of_array _ _ = A "foo"
+let sexp_of_int _ = A "42"
+let int_of_sexp _ = 42
+
+let t_of_sexp : 'a . (sexp -> 'a) -> sexp -> 'a t=
+  let _tp_loc = "core_array.ml.t" in
+  fun _of_a  -> fun t  -> (array_of_sexp _of_a) t
+let _ = t_of_sexp
+let sexp_of_t : 'a . ('a -> sexp) -> 'a t -> sexp=
+  fun _of_a  -> fun v  -> (sexp_of_array _of_a) v
+let _ = sexp_of_t
+module T =
+  struct
+    module Int =
+      struct
+        type t_ = int array
+        let _ = fun (_ : t_)  -> ()
+
+        let t__of_sexp: sexp -> t_ =
+          let _tp_loc = "core_array.ml.T.Int.t_" in
+          fun t  -> (array_of_sexp int_of_sexp) t
+        let _ = t__of_sexp
+        let sexp_of_t_: t_ -> sexp =
+          fun v  -> (sexp_of_array sexp_of_int) v
+        let _ = sexp_of_t_
+      end
+  end
+module type Permissioned  =
+  sig
+    type ('a,-'perms) t
+  end
+module Permissioned :
+  sig
+    type ('a,-'perms) t
+    include
+      sig
+        val t_of_sexp :
+          (sexp -> 'a) ->
+            (sexp -> 'perms) -> sexp -> ('a,'perms) t
+        val sexp_of_t :
+          ('a -> sexp) ->
+            ('perms -> sexp) -> ('a,'perms) t -> sexp
+      end
+    module Int :
+    sig
+      type nonrec -'perms t = (int,'perms) t
+      include
+        sig
+          val t_of_sexp :
+            (sexp -> 'perms) -> sexp -> 'perms t
+          val sexp_of_t :
+            ('perms -> sexp) -> 'perms t -> sexp
+        end
+    end
+  end =
+  struct
+    type ('a,-'perms) t = 'a array
+    let _ = fun (_ : ('a,'perms) t)  -> ()
+
+    let t_of_sexp :
+      'a 'perms .
+        (sexp -> 'a) ->
+          (sexp -> 'perms) -> sexp -> ('a,'perms) t=
+      let _tp_loc = "core_array.ml.Permissioned.t" in
+      fun _of_a  -> fun _of_perms  -> fun t  -> (array_of_sexp _of_a) t
+    let _ = t_of_sexp
+    let sexp_of_t :
+      'a 'perms .
+        ('a -> sexp) ->
+          ('perms -> sexp) -> ('a,'perms) t -> sexp=
+      fun _of_a  -> fun _of_perms  -> fun v  -> (sexp_of_array _of_a) v
+    let _ = sexp_of_t
+    module Int =
+      struct
+        include T.Int
+        type -'perms t = t_
+        let _ = fun (_ : 'perms t)  -> ()
+
+        let t_of_sexp :
+          'perms . (sexp -> 'perms) -> sexp -> 'perms t=
+          let _tp_loc = "core_array.ml.Permissioned.Int.t" in
+          fun _of_perms  -> fun t  -> t__of_sexp t
+        let _ = t_of_sexp
+        let sexp_of_t :
+          'perms . ('perms -> sexp) -> 'perms t -> sexp=
+          fun _of_perms  -> fun v  -> sexp_of_t_ v
+        let _ = sexp_of_t
+      end
+  end
diff --git a/testsuite/tests/typing-misc-bugs/gadt_declaration_check.ml b/testsuite/tests/typing-misc-bugs/gadt_declaration_check.ml
new file mode 100644
index 00000000..432a502f
--- /dev/null
+++ b/testsuite/tests/typing-misc-bugs/gadt_declaration_check.ml
@@ -0,0 +1,19 @@
+(* TEST
+   * expect
+*)
+type foo = Foo;;
+[%%expect{|
+type foo = Foo
+|}];;
+
+(* this should fail with an error message,
+   not an uncaught exception (as it did temporarily
+   during the development of typedecl_separability) *)
+type bar = Bar : foo;;
+[%%expect{|
+Line 1, characters 17-20:
+1 | type bar = Bar : foo;;
+                     ^^^
+Error: Constraints are not satisfied in this type.
+       Type foo should be an instance of bar
+|}];;
diff --git a/testsuite/tests/typing-misc-bugs/pr6303_bad.compilers.reference b/testsuite/tests/typing-misc-bugs/pr6303_bad.compilers.reference
new file mode 100644
index 00000000..39da9708
--- /dev/null
+++ b/testsuite/tests/typing-misc-bugs/pr6303_bad.compilers.reference
@@ -0,0 +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
+       Type int is not compatible with type string 
diff --git a/testsuite/tests/typing-misc-bugs/pr6303_bad.ml b/testsuite/tests/typing-misc-bugs/pr6303_bad.ml
new file mode 100644
index 00000000..0f67b86d
--- /dev/null
+++ b/testsuite/tests/typing-misc-bugs/pr6303_bad.ml
@@ -0,0 +1,11 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+type 'a  foo = {x: 'a; y: int}
+let r = {{x = 0; y = 0} with x = 0}
+let r' : string foo = r
diff --git a/testsuite/tests/typing-misc-bugs/pr6946_bad.compilers.reference b/testsuite/tests/typing-misc-bugs/pr6946_bad.compilers.reference
new file mode 100644
index 00000000..608d9a23
--- /dev/null
+++ b/testsuite/tests/typing-misc-bugs/pr6946_bad.compilers.reference
@@ -0,0 +1,5 @@
+File "pr6946_bad.ml", line 10, characters 8-11:
+10 | let _ = foo ();;
+             ^^^
+Error: This expression has type int
+       This is not a function; it cannot be applied.
diff --git a/testsuite/tests/typing-misc-bugs/pr6946_bad.ml b/testsuite/tests/typing-misc-bugs/pr6946_bad.ml
new file mode 100644
index 00000000..59bcda10
--- /dev/null
+++ b/testsuite/tests/typing-misc-bugs/pr6946_bad.ml
@@ -0,0 +1,10 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+external foo : int = "%ignore";;
+let _ = foo ();;
diff --git a/testsuite/tests/typing-misc/constraints.ml b/testsuite/tests/typing-misc/constraints.ml
new file mode 100644
index 00000000..0fe7387a
--- /dev/null
+++ b/testsuite/tests/typing-misc/constraints.ml
@@ -0,0 +1,141 @@
+(* TEST
+   * expect
+*)
+
+type 'a t = [`A of 'a t t] as 'a;; (* fails *)
+[%%expect{|
+Line 1, characters 0-32:
+1 | type 'a t = [`A of 'a t t] as 'a;; (* fails *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of t contains a cycle:
+       'a t t as 'a
+|}, Principal{|
+Line 1, characters 0-32:
+1 | type 'a t = [`A of 'a t t] as 'a;; (* fails *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of t contains a cycle:
+       [ `A of 'a t t ] as 'a
+|}];;
+type 'a t = [`A of 'a t t];; (* fails *)
+[%%expect{|
+Line 1, characters 0-26:
+1 | type 'a t = [`A of 'a t t];; (* fails *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This recursive type is not regular.
+       The type constructor t is defined as
+         type 'a t
+       but it is used as
+         'a t t.
+       All uses need to match the definition for the recursive type to be regular.
+|}];;
+type 'a t = [`A of 'a t t] constraint 'a = 'a t;; (* fails since 4.04 *)
+[%%expect{|
+Line 1, characters 0-47:
+1 | type 'a t = [`A of 'a t t] constraint 'a = 'a t;; (* fails since 4.04 *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type abbreviation t is cyclic
+|}];;
+type 'a t = [`A of 'a t] constraint 'a = 'a t;; (* fails since 4.04 *)
+[%%expect{|
+Line 1, characters 0-45:
+1 | type 'a t = [`A of 'a t] constraint 'a = 'a t;; (* fails since 4.04 *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type abbreviation t is cyclic
+|}];;
+type 'a t = [`A of 'a] as 'a;;
+[%%expect{|
+type 'a t = 'a constraint 'a = [ `A of 'a ]
+|}, Principal{|
+type 'a t = [ `A of 'b ] as 'b constraint 'a = [ `A of 'a ]
+|}];;
+type 'a v = [`A of u v] constraint 'a = t and t = u and u = t;; (* fails *)
+[%%expect{|
+Line 1, characters 0-41:
+1 | type 'a v = [`A of u v] constraint 'a = t and t = u and u = t;; (* fails *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of v contains a cycle:
+       t
+|}];;
+
+type 'a t = 'a;;
+let f (x : 'a t as 'a) = ();; (* ok *)
+[%%expect{|
+type 'a t = 'a
+val f : 'a -> unit = 
+|}];;
+
+let f (x : 'a t) (y : 'a) = x = y;;
+[%%expect{|
+val f : 'a t -> 'a -> bool = 
+|}];;
+
+(* PR#6505 *)
+module type PR6505 = sig
+  type 'o is_an_object = < .. > as 'o
+  and 'o abs constraint 'o = 'o is_an_object
+  val abs : 'o is_an_object -> 'o abs
+  val unabs : 'o abs -> 'o
+end
+;; (* fails *)
+[%%expect{|
+Line 3, characters 2-44:
+3 |   and 'o abs constraint 'o = 'o is_an_object
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of abs contains a cycle:
+       'a is_an_object as 'a
+|}];;
+
+module PR6505a = struct
+  type 'o is_an_object = < .. > as 'o
+  and ('k,'l) abs = 'l constraint 'k = 'l is_an_object
+  let y : ('o, 'o) abs = object end
+end;;
+let _ = PR6505a.y#bang;; (* fails *)
+[%%expect{|
+module PR6505a :
+  sig
+    type 'o is_an_object = 'o constraint 'o = < .. >
+    and ('a, 'l) abs = 'l constraint 'a = 'l is_an_object
+    val y : (<  > is_an_object, <  > is_an_object) abs
+  end
+Line 6, characters 8-17:
+6 | let _ = PR6505a.y#bang;; (* fails *)
+            ^^^^^^^^^
+Error: This expression has type
+         (<  > PR6505a.is_an_object, <  > PR6505a.is_an_object) PR6505a.abs
+       It has no method bang
+|}, Principal{|
+module PR6505a :
+  sig
+    type 'o is_an_object = 'o constraint 'o = < .. >
+    and ('a, 'l) abs = 'l constraint 'a = 'l is_an_object
+    val y : (<  >, <  >) abs
+  end
+Line 6, characters 8-17:
+6 | let _ = PR6505a.y#bang;; (* fails *)
+            ^^^^^^^^^
+Error: This expression has type (<  >, <  >) PR6505a.abs
+       It has no method bang
+|}]
+
+module PR6505b = struct
+  type 'o is_an_object = [> ] as 'o
+  and ('k,'l) abs = 'l constraint 'k = 'l is_an_object
+  let x : ('a, 'a) abs = `Foo 6
+end;;
+let () = print_endline (match PR6505b.x with `Bar s -> s);; (* fails *)
+[%%expect{|
+module PR6505b :
+  sig
+    type 'o is_an_object = 'o constraint 'o = [>  ]
+    and ('a, 'l) abs = 'l constraint 'a = 'l is_an_object
+    val x : (([> `Foo of int ] as 'a) is_an_object, 'a is_an_object) abs
+  end
+Line 6, characters 23-57:
+6 | let () = print_endline (match PR6505b.x with `Bar s -> s);; (* fails *)
+                           ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+`Foo _
+Exception: Match_failure ("", 6, 23).
+|}]
diff --git a/testsuite/tests/typing-misc/disambiguate_principality.ml b/testsuite/tests/typing-misc/disambiguate_principality.ml
new file mode 100644
index 00000000..d1b61f03
--- /dev/null
+++ b/testsuite/tests/typing-misc/disambiguate_principality.ml
@@ -0,0 +1,518 @@
+(* TEST
+   * expect
+*)
+
+(*** Record ***)
+
+(* Expressions *)
+
+module M = struct
+  type r = { lbl : int }
+end
+;;
+[%%expect{|
+module M : sig type r = { lbl : int; } end
+|}]
+
+let before_a : M.r =
+  { lbl = 3 }
+;;
+[%%expect{|
+val before_a : M.r = {M.lbl = 3}
+|}]
+
+let a =
+  let x = ({ M.lbl = 3 } : M.r) in
+  x.lbl
+;;
+[%%expect{|
+val a : int = 3
+|}]
+
+let after_a =
+  let x = ({ M.lbl = 3 } : M.r) in
+  { x with lbl = 4 }
+;;
+[%%expect{|
+Line 3, characters 2-20:
+3 |   { x with lbl = 4 }
+      ^^^^^^^^^^^^^^^^^^
+Warning 23: all the fields are explicitly listed in this record:
+the 'with' clause is useless.
+val after_a : M.r = {M.lbl = 4}
+|}]
+
+let b =
+  let x = ({ contents = { M.lbl = 3 } } : M.r ref) in
+  x := { lbl = 4 }
+;;
+[%%expect{|
+val b : unit = ()
+|}, Principal{|
+Line 3, characters 7-18:
+3 |   x := { lbl = 4 }
+           ^^^^^^^^^^^
+Warning 18: this type-based record disambiguation is not principal.
+val b : unit = ()
+|}]
+
+let c =
+  let x = ({ contents = { M.lbl = 3 } } : M.r ref) in
+  !x.lbl
+;;
+[%%expect{|
+val c : int = 3
+|}]
+
+let d =
+  let x = ({ contents = { M.lbl = 3 } } : M.r ref) in
+  x.contents <- { lbl = 4 }
+;;
+[%%expect{|
+val d : unit = ()
+|}]
+
+let e =
+  let x = ({ contents = { M.lbl = 3 } } : M.r ref) in
+  { x with contents = { lbl = 4 } }
+;;
+[%%expect{|
+Line 3, characters 24-27:
+3 |   { x with contents = { lbl = 4 } }
+                            ^^^
+Error: Unbound record field lbl
+|}]
+
+let f =
+  let x = ({ contents = { M.lbl = 3 } } : M.r ref) in
+  x.contents.lbl
+;;
+[%%expect{|
+val f : int = 3
+|}]
+
+(* Patterns *)
+
+let g (x : M.r) =
+  match x with
+  | { lbl = _ } -> ()
+;;
+[%%expect{|
+val g : M.r -> unit = 
+|}]
+
+let h x =
+  match x with
+  | (_ : M.r) -> ()
+  | { lbl = _ } -> ()
+;;
+[%%expect{|
+Line 4, characters 4-15:
+4 |   | { lbl = _ } -> ()
+        ^^^^^^^^^^^
+Warning 11: this match case is unused.
+val h : M.r -> unit = 
+|}, Principal{|
+Line 4, characters 6-9:
+4 |   | { lbl = _ } -> ()
+          ^^^
+Error: Unbound record field lbl
+|}]
+
+let i x =
+  match x with
+  | { lbl = _ } -> ()
+  | (_ : M.r) -> ()
+;;
+[%%expect{|
+Line 3, characters 6-9:
+3 |   | { lbl = _ } -> ()
+          ^^^
+Error: Unbound record field lbl
+|}]
+
+let j x =
+  match x with
+  | (_ : M.r)
+  | { lbl = _ } -> ()
+;;
+[%%expect{|
+Line 4, characters 4-15:
+4 |   | { lbl = _ } -> ()
+        ^^^^^^^^^^^
+Warning 12: this sub-pattern is unused.
+val j : M.r -> unit = 
+|}]
+
+let k x =
+  match x with
+  | { lbl = _ }
+  | (_ : M.r) -> ()
+;;
+[%%expect{|
+Line 3, characters 6-9:
+3 |   | { lbl = _ }
+          ^^^
+Error: Unbound record field lbl
+|}]
+
+let l (x : M.r ref) =
+  match x with
+  | { contents = { lbl = _ } } -> ()
+;;
+[%%expect{|
+val l : M.r ref -> unit = 
+|}]
+
+let m x =
+  match x with
+  | { contents = { lbl = _ } } -> ()
+;;
+[%%expect{|
+Line 3, characters 19-22:
+3 |   | { contents = { lbl = _ } } -> ()
+                       ^^^
+Error: Unbound record field lbl
+|}]
+
+let n x =
+  match x with
+  | (_ : M.r ref) -> ()
+  | { contents = { lbl = _ } } -> ()
+;;
+[%%expect{|
+Line 4, characters 4-30:
+4 |   | { contents = { lbl = _ } } -> ()
+        ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 11: this match case is unused.
+val n : M.r ref -> unit = 
+|}, Principal{|
+Line 4, characters 19-22:
+4 |   | { contents = { lbl = _ } } -> ()
+                       ^^^
+Error: Unbound record field lbl
+|}]
+
+let o x =
+  match x with
+  | { contents = { lbl = _ } } -> ()
+  | (_ : M.r ref) -> ()
+;;
+[%%expect{|
+Line 3, characters 19-22:
+3 |   | { contents = { lbl = _ } } -> ()
+                       ^^^
+Error: Unbound record field lbl
+|}]
+
+let p x =
+  match x with
+  | (_ : M.r ref)
+  | { contents = { lbl = _ } } -> ()
+;;
+[%%expect{|
+Line 4, characters 4-30:
+4 |   | { contents = { lbl = _ } } -> ()
+        ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 12: this sub-pattern is unused.
+val p : M.r ref -> unit = 
+|}]
+
+let q x =
+  match x with
+  | { contents = { lbl = _ } }
+  | (_ : M.r ref) -> ()
+;;
+[%%expect{|
+Line 3, characters 19-22:
+3 |   | { contents = { lbl = _ } }
+                       ^^^
+Error: Unbound record field lbl
+|}]
+
+let r arg =
+  match arg with
+  | (x : M.r ref) ->
+    !x.lbl
+;;
+[%%expect{|
+val r : M.r ref -> int = 
+|}]
+
+let s arg =
+  match arg with
+  | (x : M.r ref) ->
+    x := { lbl = 4 }
+;;
+[%%expect{|
+val s : M.r ref -> unit = 
+|}, Principal{|
+Line 4, characters 9-20:
+4 |     x := { lbl = 4 }
+             ^^^^^^^^^^^
+Warning 18: this type-based record disambiguation is not principal.
+val s : M.r ref -> unit = 
+|}]
+
+let t = function
+  | ({ contents = { M.lbl = _ } } : M.r ref) as x ->
+    x := { lbl = 4 }
+;;
+[%%expect{|
+val t : M.r ref -> unit = 
+|}, Principal{|
+Line 3, characters 9-20:
+3 |     x := { lbl = 4 }
+             ^^^^^^^^^^^
+Warning 18: this type-based record disambiguation is not principal.
+val t : M.r ref -> unit = 
+|}]
+
+let u = function
+  | ({ contents = { M.lbl = _ } } : M.r ref) as x ->
+    !x.lbl
+;;
+[%%expect{|
+val u : M.r ref -> int = 
+|}, Principal{|
+Line 3, characters 7-10:
+3 |     !x.lbl
+           ^^^
+Warning 18: this type-based field disambiguation is not principal.
+val u : M.r ref -> int = 
+|}]
+
+
+(*** Constructors ***)
+
+(* Expressions *)
+
+module M = struct
+  type t = A | B
+end
+;;
+[%%expect{|
+module M : sig type t = A | B end
+|}]
+
+let before_a : M.t =
+  A
+;;
+[%%expect{|
+val before_a : M.t = M.A
+|}]
+
+let a =
+  let x = (A : M.t) in
+  x
+;;
+[%%expect{|
+val a : M.t = M.A
+|}]
+
+let b =
+  let x = ({ contents = A } : M.t ref) in
+  x := B
+;;
+[%%expect{|
+val b : unit = ()
+|}, Principal{|
+Line 3, characters 7-8:
+3 |   x := B
+           ^
+Warning 18: this type-based constructor disambiguation is not principal.
+val b : unit = ()
+|}]
+
+let d =
+  let x = ({ contents = A } : M.t ref) in
+  x.contents <- B
+;;
+[%%expect{|
+val d : unit = ()
+|}]
+
+let e =
+  let x = ({ contents = A } : M.t ref) in
+  { x with contents = B }
+;;
+[%%expect{|
+Line 3, characters 22-23:
+3 |   { x with contents = B }
+                          ^
+Error: Unbound constructor B
+|}]
+
+(* Patterns *)
+
+let g (x : M.t) =
+  match x with
+  | A | B  -> ()
+;;
+[%%expect{|
+val g : M.t -> unit = 
+|}]
+
+let h x =
+  match x with
+  | (A : M.t) -> ()
+  | B -> ()
+;;
+[%%expect{|
+val h : M.t -> unit = 
+|}, Principal{|
+Line 4, characters 4-5:
+4 |   | B -> ()
+        ^
+Error: Unbound constructor B
+|}]
+
+let i x =
+  match x with
+  | A -> ()
+  | (B : M.t) -> ()
+;;
+[%%expect{|
+Line 3, characters 4-5:
+3 |   | A -> ()
+        ^
+Error: Unbound constructor A
+|}]
+
+let j x =
+  match x with
+  | (A : M.t)
+  | B -> ()
+;;
+[%%expect{|
+val j : M.t -> unit = 
+|}]
+
+let k x =
+  match x with
+  | A
+  | (B : M.t) -> ()
+;;
+[%%expect{|
+Line 3, characters 4-5:
+3 |   | A
+        ^
+Error: Unbound constructor A
+|}]
+
+let l (x : M.t ref) =
+  match x with
+  | { contents = (A | B) } -> ()
+;;
+[%%expect{|
+val l : M.t ref -> unit = 
+|}]
+
+let m x =
+  match x with
+  | { contents = (A | B) } -> ()
+;;
+[%%expect{|
+Line 3, characters 18-19:
+3 |   | { contents = (A | B) } -> ()
+                      ^
+Error: Unbound constructor A
+|}]
+
+let n x =
+  match x with
+  | (_ : M.t ref) -> ()
+  | { contents = A } -> ()
+;;
+[%%expect{|
+Line 4, characters 4-20:
+4 |   | { contents = A } -> ()
+        ^^^^^^^^^^^^^^^^
+Warning 11: this match case is unused.
+val n : M.t ref -> unit = 
+|}, Principal{|
+Line 4, characters 17-18:
+4 |   | { contents = A } -> ()
+                     ^
+Error: Unbound constructor A
+|}]
+
+let o x =
+  match x with
+  | { contents = A } -> ()
+  | (_ : M.t ref) -> ()
+;;
+[%%expect{|
+Line 3, characters 17-18:
+3 |   | { contents = A } -> ()
+                     ^
+Error: Unbound constructor A
+|}]
+
+let p x =
+  match x with
+  | (_ : M.t ref)
+  | { contents = A } -> ()
+;;
+[%%expect{|
+Line 4, characters 4-20:
+4 |   | { contents = A } -> ()
+        ^^^^^^^^^^^^^^^^
+Warning 12: this sub-pattern is unused.
+val p : M.t ref -> unit = 
+|}]
+
+let q x =
+  match x with
+  | { contents = A }
+  | (_ : M.t ref) -> ()
+;;
+[%%expect{|
+Line 3, characters 17-18:
+3 |   | { contents = A }
+                     ^
+Error: Unbound constructor A
+|}]
+
+let s arg =
+  match arg with
+  | (x : M.t ref) ->
+    x := A
+;;
+[%%expect{|
+val s : M.t ref -> unit = 
+|}, Principal{|
+Line 4, characters 9-10:
+4 |     x := A
+             ^
+Warning 18: this type-based constructor disambiguation is not principal.
+val s : M.t ref -> unit = 
+|}]
+
+let t = function
+  | ({ contents = M.A } : M.t ref) as x ->
+    x := B
+;;
+[%%expect{|
+Lines 1-3, characters 8-10:
+1 | ........function
+2 |   | ({ contents = M.A } : M.t ref) as x ->
+3 |     x := B
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+{contents=B}
+val t : M.t ref -> unit = 
+|}, Principal{|
+Line 3, characters 9-10:
+3 |     x := B
+             ^
+Warning 18: this type-based constructor disambiguation is not principal.
+Lines 1-3, characters 8-10:
+1 | ........function
+2 |   | ({ contents = M.A } : M.t ref) as x ->
+3 |     x := B
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+{contents=B}
+val t : M.t ref -> unit = 
+|}]
diff --git a/testsuite/tests/typing-misc/empty_ppx.ml b/testsuite/tests/typing-misc/empty_ppx.ml
new file mode 100644
index 00000000..431ba868
--- /dev/null
+++ b/testsuite/tests/typing-misc/empty_ppx.ml
@@ -0,0 +1,14 @@
+module H = Ast_helper
+module M = Ast_mapper
+open Parsetree
+let empty_polyvar loc = H.Typ.variant ~loc [] Asttypes.Closed None
+
+let super = M.default_mapper
+let typ mapper e =
+  match e.ptyp_desc with
+  | Ptyp_extension ({txt="empty_polyvar";loc},_) -> empty_polyvar loc
+  | _ -> super.M.typ mapper e
+
+let () = M.register "empty ppx" (fun _ ->
+    { super with typ }
+  )
diff --git a/testsuite/tests/typing-misc/empty_variant.ml b/testsuite/tests/typing-misc/empty_variant.ml
new file mode 100644
index 00000000..40a81602
--- /dev/null
+++ b/testsuite/tests/typing-misc/empty_variant.ml
@@ -0,0 +1,79 @@
+(* TEST
+   * expect
+*)
+
+(* empty variant *)
+type t = |;;
+[%%expect{|
+type t = |
+|}];;
+
+let f (x:t) = match x with _ -> .
+[%%expect{|
+val f : t -> 'a = 
+|}];;
+
+type m = A of t | B of int * t | C of {g:t}
+[%%expect{|
+type m = A of t | B of int * t | C of { g : t; }
+|}]
+
+let g (x:m) =
+  match x with
+  | A _ | B _ | C _ -> .
+[%%expect{|
+val g : m -> 'a = 
+|}]
+
+let f : t option -> int = function None -> 3
+[%%expect{|
+val f : t option -> int = 
+|}]
+
+type nothing = |
+type ('a, 'b, 'c) t = | A of 'a | B of 'b | C of 'c
+module Runner : sig
+  val ac : f:((unit, _, unit) t -> unit) -> unit
+end = struct
+  let ac ~f =
+    f (A ());
+    f (C ());
+  ;;
+end
+
+let f () =
+  Runner.ac
+    ~f:(fun (abc : (_,nothing,_) t) ->
+      let value =
+        match abc with
+        | A _ -> 1
+      in
+      Printf.printf "%i\n" value
+    )
+[%%expect{|
+type nothing = |
+type ('a, 'b, 'c) t = A of 'a | B of 'b | C of 'c
+module Runner : sig val ac : f:((unit, 'a, unit) t -> unit) -> unit end
+Lines 16-17, characters 8-18:
+16 | ........match abc with
+17 |         | A _ -> 1
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+C ()
+val f : unit -> unit = 
+|}]
+
+type nothing = |
+type 'b t = A | B of 'b | C
+let g (x:nothing t) = match x with A -> ()
+[%%expect{|
+type nothing = |
+type 'b t = A | B of 'b | C
+Line 3, characters 22-42:
+3 | let g (x:nothing t) = match x with A -> ()
+                          ^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+C
+val g : nothing t -> unit = 
+|}]
diff --git a/testsuite/tests/typing-misc/enrich_typedecl.ml b/testsuite/tests/typing-misc/enrich_typedecl.ml
new file mode 100644
index 00000000..295cab1e
--- /dev/null
+++ b/testsuite/tests/typing-misc/enrich_typedecl.ml
@@ -0,0 +1,260 @@
+(* TEST
+   * expect
+*)
+
+module rec A : sig
+  type t = int * string
+end = struct
+  type t = A | B
+
+  let f (x : t) =
+    match x with
+    | A -> ()
+    | B -> ()
+end;;
+[%%expect{|
+Lines 3-10, characters 6-3:
+ 3 | ......struct
+ 4 |   type t = A | B
+ 5 |
+ 6 |   let f (x : t) =
+ 7 |     match x with
+ 8 |     | A -> ()
+ 9 |     | B -> ()
+10 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = A.t = A | B val f : t -> unit end
+       is not included in
+         sig type t = int * string end
+       Type declarations do not match:
+         type t = A.t = A | B
+       is not included in
+         type t = int * string
+|}]
+
+module rec B : sig
+  type 'a t = 'a
+end = struct
+  type 'a t = A of 'a | B
+
+  let f (x : _ t) =
+    match x with
+    | A _ -> ()
+    | B -> ()
+end;;
+[%%expect{|
+Lines 3-10, characters 6-3:
+ 3 | ......struct
+ 4 |   type 'a t = A of 'a | B
+ 5 |
+ 6 |   let f (x : _ t) =
+ 7 |     match x with
+ 8 |     | A _ -> ()
+ 9 |     | B -> ()
+10 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type 'a t = 'a B.t = A of 'a | B val f : 'a t -> unit end
+       is not included in
+         sig type 'a t = 'a end
+       Type declarations do not match:
+         type 'a t = 'a B.t = A of 'a | B
+       is not included in
+         type 'a t = 'a
+|}];;
+
+module rec C : sig
+  type 'a t = { x : 'a }
+end = struct
+  type 'a t = A of 'a | B
+
+  let f (x : _ t) =
+    match x with
+    | A _ -> ()
+    | B -> ()
+end;;
+[%%expect{|
+Lines 3-10, characters 6-3:
+ 3 | ......struct
+ 4 |   type 'a t = A of 'a | B
+ 5 |
+ 6 |   let f (x : _ t) =
+ 7 |     match x with
+ 8 |     | A _ -> ()
+ 9 |     | B -> ()
+10 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type 'a t = 'a C.t = A of 'a | B val f : 'a t -> unit end
+       is not included in
+         sig type 'a t = { x : 'a; } end
+       Type declarations do not match:
+         type 'a t = 'a C.t = A of 'a | B
+       is not included in
+         type 'a t = { x : 'a; }
+       Their kinds differ.
+|}];;
+
+
+module rec D : sig
+  type 'a t = int
+end = struct
+  type 'a t = A of 'a | B
+
+  let f (x : _ t) =
+    match x with
+    | A _ -> ()
+    | B -> ()
+end;;
+[%%expect{|
+Lines 3-10, characters 6-3:
+ 3 | ......struct
+ 4 |   type 'a t = A of 'a | B
+ 5 |
+ 6 |   let f (x : _ t) =
+ 7 |     match x with
+ 8 |     | A _ -> ()
+ 9 |     | B -> ()
+10 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type 'a t = 'a D.t = A of 'a | B val f : 'a t -> unit end
+       is not included in
+         sig type 'a t = int end
+       Type declarations do not match:
+         type 'a t = 'a D.t = A of 'a | B
+       is not included in
+         type 'a t = int
+|}];;
+
+module rec E : sig
+  type 'a t = [> `Foo ] as 'a
+end = struct
+  type 'a t = A of 'a | B
+
+  let f (x : _ t) =
+    match x with
+    | A _ -> ()
+    | B -> ()
+end;;
+[%%expect{|
+Lines 3-10, characters 6-3:
+ 3 | ......struct
+ 4 |   type 'a t = A of 'a | B
+ 5 |
+ 6 |   let f (x : _ t) =
+ 7 |     match x with
+ 8 |     | A _ -> ()
+ 9 |     | B -> ()
+10 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type 'a t = 'a E.t = A of 'a | B val f : 'a t -> unit end
+       is not included in
+         sig type 'a t = 'a constraint 'a = [> `Foo ] end
+       Type declarations do not match:
+         type 'a t = 'a E.t = A of 'a | B
+       is not included in
+         type 'a t = 'a constraint 'a = [> `Foo ]
+|}];;
+
+module rec E2 : sig
+  type 'a t = [ `Foo ]
+end = struct
+  type 'a t = A of 'a | B
+
+  let f (x : _ t) =
+    match x with
+    | A _ -> ()
+    | B -> ()
+end;;
+[%%expect{|
+Lines 3-10, characters 6-3:
+ 3 | ......struct
+ 4 |   type 'a t = A of 'a | B
+ 5 |
+ 6 |   let f (x : _ t) =
+ 7 |     match x with
+ 8 |     | A _ -> ()
+ 9 |     | B -> ()
+10 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type 'a t = 'a E2.t = A of 'a | B val f : 'a t -> unit end
+       is not included in
+         sig type 'a t = [ `Foo ] end
+       Type declarations do not match:
+         type 'a t = 'a E2.t = A of 'a | B
+       is not included in
+         type 'a t = [ `Foo ]
+|}];;
+
+module rec E3 : sig
+  type 'a t = [< `Foo ] as 'a
+end = struct
+  type 'a t = A of 'a | B
+
+  let f (x : _ t) =
+    match x with
+    | A _ -> ()
+    | B -> ()
+end;;
+[%%expect{|
+Lines 3-10, characters 6-3:
+ 3 | ......struct
+ 4 |   type 'a t = A of 'a | B
+ 5 |
+ 6 |   let f (x : _ t) =
+ 7 |     match x with
+ 8 |     | A _ -> ()
+ 9 |     | B -> ()
+10 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type 'a t = 'a E3.t = A of 'a | B val f : 'a t -> unit end
+       is not included in
+         sig type 'a t = 'a constraint 'a = [< `Foo ] end
+       Type declarations do not match:
+         type 'a t = 'a E3.t = A of 'a | B
+       is not included in
+         type 'a t = 'a constraint 'a = [< `Foo ]
+|}];;
+
+
+module rec F : sig
+  type ('a, 'b) t = Foo of 'a
+end = struct
+  type ('a, 'b) t = Foo of 'b
+
+  (* this function typechecks properly, which means that we've added the
+     manisfest. *)
+  let coerce : 'a 'b. ('a, 'b) t -> ('a, 'b) F.t = fun x -> x
+end;;
+[%%expect{|
+Lines 3-9, characters 6-3:
+3 | ......struct
+4 |   type ('a, 'b) t = Foo of 'b
+5 |
+6 |   (* this function typechecks properly, which means that we've added the
+7 |      manisfest. *)
+8 |   let coerce : 'a 'b. ('a, 'b) t -> ('a, 'b) F.t = fun x -> x
+9 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig
+           type ('a, 'b) t = ('a, 'b) F.t = Foo of 'b
+           val coerce : ('a, 'b) t -> ('a, 'b) F.t
+         end
+       is not included in
+         sig type ('a, 'b) t = Foo of 'a end
+       Type declarations do not match:
+         type ('a, 'b) t = ('a, 'b) F.t = Foo of 'b
+       is not included in
+         type ('a, 'b) t = Foo of 'a
+       Constructors do not match:
+         Foo of 'b
+       is not compatible with:
+         Foo of 'a
+       The types are not equal.
+|}];;
diff --git a/testsuite/tests/typing-misc/exotic_unifications.ml b/testsuite/tests/typing-misc/exotic_unifications.ml
new file mode 100644
index 00000000..9f27b561
--- /dev/null
+++ b/testsuite/tests/typing-misc/exotic_unifications.ml
@@ -0,0 +1,29 @@
+(* TEST
+   * expect
+*)
+
+class virtual t = object method virtual x: float end
+
+class x = object(self: )
+        inherit t
+end
+[%%expect {|
+class virtual t : object method virtual x : float end
+Line 4, characters 16-17:
+4 |         inherit t
+                    ^
+Error: The method x has type int but is expected to have type float
+       Type int is not compatible with type float
+|}]
+
+let x =
+  let module M = struct module type t = sig end end in
+  (module struct end: M.t)
+[%%expect {|
+Line 3, characters 2-26:
+3 |   (module struct end: M.t)
+      ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This expression has type (module M.t)
+       but an expression was expected of type 'a
+       The module type M.t would escape its scope
+|}]
diff --git a/testsuite/tests/typing-misc/external_arity.ml b/testsuite/tests/typing-misc/external_arity.ml
new file mode 100644
index 00000000..bad0fb17
--- /dev/null
+++ b/testsuite/tests/typing-misc/external_arity.ml
@@ -0,0 +1,33 @@
+(* TEST
+   * expect
+*)
+
+let f a b c = a + b + c
+
+let _ : int = Obj.magic f None None None
+
+[%%expect
+{|
+val f : int -> int -> int -> int = 
+- : int = 0
+|}]
+
+external cmp : 'a -> 'b = "%compare"
+
+[%%expect
+{|
+Line 1, characters 0-36:
+1 | external cmp : 'a -> 'b = "%compare"
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Wrong arity for builtin primitive "%compare"
+|}]
+
+external apply : 'a -> 'b = "%apply"
+
+[%%expect
+{|
+Line 1, characters 0-36:
+1 | external apply : 'a -> 'b = "%apply"
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Wrong arity for builtin primitive "%apply"
+|}]
diff --git a/testsuite/tests/typing-misc/gpr2277.ml b/testsuite/tests/typing-misc/gpr2277.ml
new file mode 100644
index 00000000..eabd3cc0
--- /dev/null
+++ b/testsuite/tests/typing-misc/gpr2277.ml
@@ -0,0 +1,54 @@
+(* TEST
+   * expect
+*)
+
+let f (type t) (x : t) = x
+
+[%%expect {|
+val f : 't -> 't = 
+|}]
+
+let g (type t') (x : t') = x
+
+let g' (x : ' t') = x
+
+[%%expect {|
+val g : ' t' -> ' t' = 
+val g' : ' t' -> ' t' = 
+|}]
+
+let h (type a'bc) (x : a'bc) = x
+
+let h' (x : ' a'bc) = x
+
+[%%expect {|
+val h : ' a'bc -> ' a'bc = 
+val h' : ' a'bc -> ' a'bc = 
+|}]
+
+let i (type fst snd) (x : fst) (y : snd) = (x, y)
+
+[%%expect {|
+val i : 'fst -> 'snd -> 'fst * 'snd = 
+|}]
+
+let j (type fst snd fst' snd') (x : fst) (y : snd) (a : fst') (b : snd') =
+  ((x, y), (a, b))
+
+[%%expect {|
+val j : 'fst -> 'snd -> 'fst' -> 'snd' -> ('fst * 'snd) * ('fst' * 'snd') =
+  
+|}]
+
+(* Variable names starting with _ are reserved for the compiler. *)
+let k (type _weak1) (x : _weak1) = x
+
+[%%expect {|
+val k : 'a -> 'a = 
+|}]
+
+let l (type _') (x : _') = x
+
+[%%expect {|
+val l : 'a -> 'a = 
+|}]
diff --git a/testsuite/tests/typing-misc/includeclass_errors.ml b/testsuite/tests/typing-misc/includeclass_errors.ml
new file mode 100644
index 00000000..9d1b8be4
--- /dev/null
+++ b/testsuite/tests/typing-misc/includeclass_errors.ml
@@ -0,0 +1,253 @@
+(* TEST
+   * expect
+*)
+
+class type foo_t =
+  object
+    method foo: string
+  end
+
+module M: sig
+  class type ct = object val m: string end
+end = struct
+  class type ct = object end
+end
+
+[%%expect{|
+class type foo_t = object method foo : string end
+Lines 8-10, characters 6-3:
+ 8 | ......struct
+ 9 |   class type ct = object end
+10 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig class type ct = object  end end
+       is not included in
+         sig class type ct = object val m : string end end
+       Class type declarations do not match:
+         class type ct = object  end
+       does not match
+         class type ct = object val m : string end
+       The first class type has no instance variable m
+|}]
+
+module M: sig
+  class c : object
+    method a: string
+  end
+end = struct
+  class virtual c = object
+    method virtual a: string
+  end
+end
+;;
+[%%expect{|
+Lines 5-9, characters 6-3:
+5 | ......struct
+6 |   class virtual c = object
+7 |     method virtual a: string
+8 |   end
+9 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig class virtual c : object method virtual a : string end end
+       is not included in
+         sig class c : object method a : string end end
+       Class declarations do not match:
+         class virtual c : object method virtual a : string end
+       does not match
+         class c : object method a : string end
+       A class cannot be changed from virtual to concrete
+|}]
+
+class type ['a] ct = object val x: 'a end
+
+module M: sig
+  class type ['a] c = object end
+end = struct
+  class type c = object end
+end
+;;
+
+[%%expect{|
+class type ['a] ct = object val x : 'a end
+Lines 5-7, characters 6-3:
+5 | ......struct
+6 |   class type c = object end
+7 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig class type c = object  end end
+       is not included in
+         sig class type ['a] c = object  end end
+       Class type declarations do not match:
+         class type c = object  end
+       does not match
+         class type ['a] c = object  end
+       The classes do not have the same number of type parameters
+|}]
+
+module M: sig
+  class ['a] c: object constraint 'a = int end
+end = struct
+  class ['a] c = object end
+end
+;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   class ['a] c = object end
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig class ['a] c : object  end end
+       is not included in
+         sig class ['a] c : object constraint 'a = int end end
+       Class declarations do not match:
+         class ['a] c : object  end
+       does not match
+         class ['a] c : object constraint 'a = int end
+       A type parameter has type 'a but is expected to have type int
+|}]
+
+module M: sig
+  class c : int -> object end
+end = struct
+  class c (x : float) = object end
+end
+;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   class c (x : float) = object end
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig class c : float -> object  end end
+       is not included in
+         sig class c : int -> object  end end
+       Class declarations do not match:
+         class c : float -> object  end
+       does not match
+         class c : int -> object  end
+       A parameter has type float but is expected to have type int
+|}]
+
+class virtual foo: foo_t =
+    object
+        method foo = "foo"
+        method private virtual cast: int
+    end
+;;
+
+[%%expect{|
+Lines 2-5, characters 4-7:
+2 | ....object
+3 |         method foo = "foo"
+4 |         method private virtual cast: int
+5 |     end
+Error: The class type object method foo : string end
+       is not matched by the class type foo_t
+       The virtual method cast cannot be hidden
+|}]
+
+class type foo_t2 =
+    object
+        method private foo: string
+    end
+
+class foo: foo_t2 =
+    object
+        method foo = "foo"
+    end
+;;
+[%%expect{|
+class type foo_t2 = object method private foo : string end
+Lines 7-9, characters 4-7:
+7 | ....object
+8 |         method foo = "foo"
+9 |     end
+Error: The class type object method foo : string end
+       is not matched by the class type foo_t2
+       The public method foo cannot become private
+|}]
+
+class virtual foo: foo_t =
+    object
+        method virtual foo: string
+    end
+;;
+[%%expect{|
+Lines 2-4, characters 4-7:
+2 | ....object
+3 |         method virtual foo: string
+4 |     end
+Error: The class type object method virtual foo : string end
+       is not matched by the class type foo_t
+       The virtual method foo cannot become concrete
+|}]
+
+class type foo_t3 =
+    object
+        val mutable x : int
+    end
+
+class foo: foo_t3 =
+    object
+        val x = 1
+    end
+;;
+[%%expect{|
+class type foo_t3 = object val mutable x : int end
+Lines 7-9, characters 4-7:
+7 | ....object
+8 |         val x = 1
+9 |     end
+Error: The class type object val x : int end is not matched by the class type
+         foo_t3
+       The non-mutable instance variable x cannot become mutable
+|}]
+
+class type foo_t4 =
+    object
+        val x : int
+    end
+
+class virtual foo: foo_t4 =
+    object
+        val virtual x : int
+    end
+;;
+[%%expect{|
+class type foo_t4 = object val x : int end
+Lines 7-9, characters 4-7:
+7 | ....object
+8 |         val virtual x : int
+9 |     end
+Error: The class type object val virtual x : int end
+       is not matched by the class type foo_t4
+       The virtual instance variable x cannot become concrete
+|}]
+
+module M: sig
+  class type c = object method m: string end
+end = struct
+  class type c = object method private m: string end
+end
+;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   class type c = object method private m: string end
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig class type c = object method private m : string end end
+       is not included in
+         sig class type c = object method m : string end end
+       Class type declarations do not match:
+         class type c = object method private m : string end
+       does not match
+         class type c = object method m : string end
+       The private method m cannot become public
+|}]
diff --git a/testsuite/tests/typing-misc/inside_out.ml b/testsuite/tests/typing-misc/inside_out.ml
new file mode 100644
index 00000000..077af370
--- /dev/null
+++ b/testsuite/tests/typing-misc/inside_out.ml
@@ -0,0 +1,123 @@
+(* TEST
+   * expect
+*)
+
+type ('a, 'b) eq = Refl : ('a, 'a) eq
+
+type empty = (int, string) eq
+
+type ('a, 'b) t = Left : 'a -> ('a, 'b) t | Right : 'b -> ('a, 'b) t;;
+
+[%%expect{|
+type ('a, 'b) eq = Refl : ('a, 'a) eq
+type empty = (int, string) eq
+type ('a, 'b) t = Left : 'a -> ('a, 'b) t | Right : 'b -> ('a, 'b) t
+|}]
+
+let f1 x =
+  match x with
+  | (None : empty option) -> ()
+;;
+[%%expect {|
+val f1 : empty option -> unit = 
+|}]
+
+let f2 () =
+  match None with
+  | (None : empty option) -> ()
+;;
+[%%expect {|
+val f2 : unit -> unit = 
+|}]
+
+let f3 () =
+  let x = None in
+  match x with
+  | (None : empty option) -> ()
+;;
+[%%expect {|
+val f3 : unit -> unit = 
+|}]
+
+let f1' x =
+  match x with
+  | (None : empty option) -> ()
+  | Some _ -> .
+;;
+[%%expect {|
+val f1' : empty option -> unit = 
+|}]
+
+let f2' () =
+  match None with
+  | (None : empty option) -> ()
+  | Some _ -> .
+;;
+[%%expect {|
+val f2' : unit -> unit = 
+|}]
+
+let f3' () =
+  let x = None in
+  match x with
+  | (None : empty option) -> ()
+  | Some _ -> .
+;;
+[%%expect {|
+val f3' : unit -> unit = 
+|}]
+
+
+let (Left () : (unit, empty) t) = Left ();;
+[%%expect {|
+|}]
+
+let f () =
+  let Left () = (Left () : (unit, empty) t) in
+  ()
+;;
+[%%expect {|
+val f : unit -> unit = 
+|}]
+
+let f () =
+  let (Left () : (unit, empty) t) = Left () in
+  ()
+;;
+[%%expect{|
+val f : unit -> unit = 
+|}]
+
+let f () =
+  match (Left () : (unit, empty) t) with
+  | Left () -> ()
+;;
+[%%expect {|
+val f : unit -> unit = 
+|}]
+
+let f () =
+  match (Left () : (unit, empty) t) with
+  | Left () -> ()
+  | Right _ -> .
+;;
+[%%expect {|
+val f : unit -> unit = 
+|}]
+
+let f () =
+  match Left () with
+  | (Left () : (unit, empty) t) -> ()
+;;
+[%%expect {|
+val f : unit -> unit = 
+|}]
+
+let f () =
+  match Left () with
+  | (Left () : (unit, empty) t) -> ()
+  | (Right _ : (unit, empty) t) -> .
+;;
+[%%expect {|
+val f : unit -> unit = 
+|}]
diff --git a/testsuite/tests/typing-misc/is_expansive.ml b/testsuite/tests/typing-misc/is_expansive.ml
new file mode 100644
index 00000000..3bab4f93
--- /dev/null
+++ b/testsuite/tests/typing-misc/is_expansive.ml
@@ -0,0 +1,12 @@
+(* TEST
+   * expect *)
+
+match [] with x -> (fun x -> x);;
+[%%expect{|
+- : 'a -> 'a = 
+|}];;
+
+match [] with x -> (fun x -> x) | _ -> .;;
+[%%expect{|
+- : 'a -> 'a = 
+|}];;
diff --git a/testsuite/tests/typing-misc/labels.ml b/testsuite/tests/typing-misc/labels.ml
new file mode 100644
index 00000000..62e1c07b
--- /dev/null
+++ b/testsuite/tests/typing-misc/labels.ml
@@ -0,0 +1,121 @@
+(* TEST
+   * expect
+*)
+
+(* PR#5835 *)
+let f ~x = x + 1;;
+f ?x:0;;
+[%%expect{|
+val f : x:int -> int = 
+Line 2, characters 5-6:
+2 | f ?x:0;;
+         ^
+Warning 43: the label x is not optional.
+- : int = 1
+|}];;
+
+(* PR#6352 *)
+let foo (f : unit -> unit) = ();;
+let g ?x () = ();;
+foo ((); g);;
+[%%expect{|
+val foo : (unit -> unit) -> unit = 
+val g : ?x:'a -> unit -> unit = 
+- : unit = ()
+|}];;
+
+(* PR#5748 *)
+foo (fun ?opt () -> ()) ;; (* fails *)
+[%%expect{|
+Line 1, characters 4-23:
+1 | foo (fun ?opt () -> ()) ;; (* fails *)
+        ^^^^^^^^^^^^^^^^^^^
+Error: This function should have type unit -> unit
+       but its first argument is labelled ?opt
+|}];;
+
+
+(* More examples *)
+
+let f g = ignore (g ?x:(Some 2) ()); g ~x:3 () ;;
+[%%expect{|
+Line 1, characters 37-38:
+1 | let f g = ignore (g ?x:(Some 2) ()); g ~x:3 () ;;
+                                         ^
+Error: This function is applied to arguments
+       in an order different from other calls.
+       This is only allowed when the real type is known.
+|}];;
+
+let f g = let _ = g ?x:(Some 2) () in g ~x:3 () ;;
+[%%expect{|
+Line 1, characters 38-39:
+1 | let f g = let _ = g ?x:(Some 2) () in g ~x:3 () ;;
+                                          ^
+Error: This function is applied to arguments
+       in an order different from other calls.
+       This is only allowed when the real type is known.
+|}];;
+
+(* principality warning *)
+let f g = ignore (g : ?x:int -> unit -> int); g ~x:3 () ;;
+[%%expect{|
+val f : (?x:int -> unit -> int) -> int = 
+|}, Principal{|
+Line 1, characters 51-52:
+1 | let f g = ignore (g : ?x:int -> unit -> int); g ~x:3 () ;;
+                                                       ^
+Warning 18: using an optional argument here is not principal.
+val f : (?x:int -> unit -> int) -> int = 
+|}];;
+
+let f g = ignore (g : ?x:int -> unit -> int); g ();;
+[%%expect{|
+val f : (?x:int -> unit -> int) -> int = 
+|}, Principal{|
+Line 1, characters 46-47:
+1 | let f g = ignore (g : ?x:int -> unit -> int); g ();;
+                                                  ^
+Warning 19: eliminated optional argument without principality.
+val f : (?x:int -> unit -> int) -> int = 
+|}];;
+
+let f g = ignore (g : x:int -> unit -> int); g ();;
+[%%expect{|
+val f : (x:int -> unit -> int) -> x:int -> int = 
+|}, Principal{|
+Line 1, characters 45-46:
+1 | let f g = ignore (g : x:int -> unit -> int); g ();;
+                                                 ^
+Warning 19: commuted an argument without principality.
+val f : (x:int -> unit -> int) -> x:int -> int = 
+|}];;
+
+(* 9859: inferred function types may appear in the right hand side of :> *)
+class setup = object
+  method with_ f = (f 0:unit)
+end
+class virtual fail = object (self)
+  method trigger = (self :> setup )
+end
+[%%expect {|
+class setup : object method with_ : (int -> unit) -> unit end
+class virtual fail :
+  object
+    method trigger : setup
+    method virtual with_ : (int -> unit) -> unit
+  end
+|}]
+
+module type T = sig type t  end
+let type_of (type x) (x: x) = (module struct type t = x end: T with type t = x)
+let f g = 1 + g ~x:0 ~y:0;;
+module E = (val type_of f)
+let g = ( (fun _ -> f) :> 'a -> E.t)
+[%%expect {|
+module type T = sig type t end
+val type_of : 'x -> (module T with type t = 'x) = 
+val f : (x:int -> y:int -> int) -> int = 
+module E : sig type t = (x:int -> y:int -> int) -> int end
+val g : 'a -> E.t = 
+|}]
diff --git a/testsuite/tests/typing-misc/mapping.ml b/testsuite/tests/typing-misc/mapping.ml
new file mode 100644
index 00000000..79eaaab7
--- /dev/null
+++ b/testsuite/tests/typing-misc/mapping.ml
@@ -0,0 +1,4 @@
+module Range_intf = Pr8548__Range_intf
+module Range = Pr8548__Range
+module Ranged_intf = Pr8548__Ranged_intf
+module Ranged = Pr8548__Ranged
diff --git a/testsuite/tests/typing-misc/occur_check.ml b/testsuite/tests/typing-misc/occur_check.ml
new file mode 100644
index 00000000..9d681c88
--- /dev/null
+++ b/testsuite/tests/typing-misc/occur_check.ml
@@ -0,0 +1,26 @@
+(* TEST
+   * expect
+*)
+
+(* PR#5907 *)
+
+type 'a t = 'a;;
+let f (g : 'a list -> 'a t -> 'a) s = g s s;;
+[%%expect{|
+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
+       The type variable 'a occurs inside 'a list
+|}];;
+let f (g : 'a * 'b -> 'a t -> 'a) s = g s s;;
+[%%expect{|
+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
+       The type variable 'a occurs inside 'a * 'b
+|}];;
diff --git a/testsuite/tests/typing-misc/pat_type_sharing.ml b/testsuite/tests/typing-misc/pat_type_sharing.ml
new file mode 100644
index 00000000..1cbf6964
--- /dev/null
+++ b/testsuite/tests/typing-misc/pat_type_sharing.ml
@@ -0,0 +1,17 @@
+(* TEST
+   * expect
+*)
+type 'a r = { a : 'a; b : 'a; }
+type 'a ty = Int : int ty | Float : float ty;;
+[%%expect{|
+type 'a r = { a : 'a; b : 'a; }
+type 'a ty = Int : int ty | Float : float ty
+|}]
+
+let foo (type a) (ty : a ty) (x : a r) =
+  match ty, x with
+  | Int, { a = 3; b } -> b
+  | _ -> assert false;;
+[%%expect{|
+val foo : 'a ty -> 'a r -> 'a = 
+|}]
diff --git a/testsuite/tests/typing-misc/pattern_open.ml b/testsuite/tests/typing-misc/pattern_open.ml
new file mode 100644
index 00000000..16572b6e
--- /dev/null
+++ b/testsuite/tests/typing-misc/pattern_open.ml
@@ -0,0 +1,249 @@
+(* TEST
+   * expect
+*)
+
+let pp fmt = Format.printf (fmt^^"@.")
+
+type 'a box = B of 'a
+(* Basic tests *)
+module M = struct
+  type c = C
+  type t = {x : c box }
+end
+
+module N = struct
+  type d = D
+  let d = D
+  type t = {x: d box}
+end
+open N;;
+[%%expect {|
+val pp : ('a, Format.formatter, unit, unit, unit, unit) format6 -> 'a = 
+type 'a box = B of 'a
+module M : sig type c = C type t = { x : c box; } end
+module N : sig type d = D val d : d type t = { x : d box; } end
+|}]
+
+let f M.{ x=B C } y  = M.C,y;;
+let g M.(x) M.(w) = x * w
+;;
+let g = function
+  | M.[] -> []
+  | M.[C] -> M.[C]
+  | _ -> []
+;;
+let h = function
+  | M.[||] -> None
+  | M.[| C |] -> Some M.C
+  | _ -> None
+;;
+let f2 = function
+  | M.( B (B C) ) -> M.C
+;;
+(* () constructor *)
+let M.() = ()
+;;
+[%%expect {|
+val f : M.t -> 'a -> M.c * 'a = 
+val g : int -> int -> int = 
+val g : M.c list -> M.c list = 
+val h : M.c array -> M.c option = 
+val f2 : M.c box box -> M.c = 
+|}]
+
+(* Pattern open separation*)
+module L = struct
+  type _ c = C : unit c
+  type t = { t : unit c }
+  type r = { r : unit c }
+  let x ()= pp "Wrong value L.x"
+end
+;;
+module K = struct
+  type _ c = C : unit c
+  type t = { t : unit c }
+  type r = { r : unit c }
+  let x ()= pp "Right value K.x"
+end;;
+[%%expect {|
+module L :
+  sig
+    type _ c = C : unit c
+    type t = { t : unit c; }
+    type r = { r : unit c; }
+    val x : unit -> unit
+  end
+module K :
+  sig
+    type _ c = C : unit c
+    type t = { t : unit c; }
+    type r = { r : unit c; }
+    val x : unit -> unit
+  end
+|}]
+
+let () =
+  let test =
+    let open K in
+    function
+    | L.{t}, ({r=C} : K.r)  -> x ()
+  in
+  test (L.{t=C}, K.{r=C});;
+[%%expect {|
+Right value K.x
+|}]
+
+module Exterior = struct
+  module Gadt = struct
+    module Boolean = struct
+      type t = { b : bool }
+      type wrong = false | true
+      let print () = pp "Wrong function: Exterior.Gadt.Boolean.print"
+    end
+
+    type _ t =
+      | Bool : Boolean.t -> bool t
+      | Int : int -> int t
+      | Eq : 'a t * 'a t -> bool t
+
+    let print () = pp "Wrong function: Exterior.Gadt.print"
+  end
+  let print () = pp "Wrong function: Exterior.print"
+end;;
+[%%expect {|
+module Exterior :
+  sig
+    module Gadt :
+      sig
+        module Boolean :
+          sig
+            type t = { b : bool; }
+            type wrong = false | true
+            val print : unit -> unit
+          end
+        type _ t =
+            Bool : Boolean.t -> bool t
+          | Int : int -> int t
+          | Eq : 'a t * 'a t -> bool t
+        val print : unit -> unit
+      end
+    val print : unit -> unit
+  end
+|}]
+let rec eval: type t. t Exterior.Gadt.t -> t = function
+  | Exterior.( Gadt.( Eq (a,b) ) ) -> (eval a) = (eval b)
+  | Exterior.( Gadt.( Bool Boolean.{b} ) ) -> b
+  | Exterior.Gadt.( Int n ) -> n
+let () =
+  let print () = pp "Right function print" in
+  let choose (type a):a Exterior.Gadt.t * a Exterior.Gadt.t -> a -> a =
+    fun (a,b) c ->
+      match a, b, c with
+      | Exterior.( Gadt.( Bool Boolean.{b} ), Gadt.Bool _ , _ ) -> print(); true
+      | Exterior.(Gadt.Bool Gadt.Boolean.{b}), _ , true -> print(); true
+      | Exterior.(Gadt.Bool Gadt.Boolean.{b}), _ , false -> print(); b
+      | Exterior.Gadt.( Int n, Int k, 0 ) -> print(); 0
+      | Exterior.( Gadt.(Int n, Gadt.Int k, l) ) -> print(); k+n+l
+      | Exterior.Gadt.( Eq (a,b) ), _,  true -> print(); true
+      | Exterior.(Gadt.( Eq (a,b), _ ,  false )) -> print(); eval a = eval b in
+  let _ =
+    choose Exterior.Gadt.(Bool Boolean.{b=true}, Bool Boolean.{b=false}) false
+  in
+  print ()
+;;
+[%%expect {|
+val eval : 't Exterior.Gadt.t -> 't = 
+Right function print
+Right function print
+|}
+]
+(* existential type *)
+module Existential = struct
+  type printable = E : 'a * ('a -> unit) -> printable
+end
+
+let rec print: Existential.printable -> unit  = function
+  | Existential.( E(x, print) ) -> print x
+;;
+[%%expect {|
+module Existential :
+  sig type printable = E : 'a * ('a -> unit) -> printable end
+val print : Existential.printable -> unit = 
+|}]
+
+(* Test that constructors and variables introduced in scope inside
+   M.(..) are not propagated outside of M.(..) *)
+module S = struct
+  type 'a t = Sep : unit t
+  type ex = Ex: 'a * 'a -> ex
+  let s = Sep
+end
+;;
+[%%expect {|
+module S :
+  sig
+    type 'a t = Sep : unit t
+    type ex = Ex : 'a * 'a -> ex
+    val s : unit t
+  end
+|}]
+let test_separation = function
+  | S.(Sep), (S.(Sep,Sep), Sep) -> ();;
+[%%expect {|
+Line 2, characters 27-30:
+2 |   | S.(Sep), (S.(Sep,Sep), Sep) -> ();;
+                               ^^^
+Error: Unbound constructor Sep
+|}]
+let test_separation_2 = function
+  | S.(Ex(a,b)), Ex(c,d) -> ();;
+[%%expect {|
+Line 2, characters 17-19:
+2 |   | S.(Ex(a,b)), Ex(c,d) -> ();;
+                     ^^
+Error: Unbound constructor Ex
+|}]
+let test_separation_3 = function
+  | S.(Sep) -> s;;
+[%%expect {|
+Line 2, characters 15-16:
+2 |   | S.(Sep) -> s;;
+                   ^
+Error: Unbound value s
+|}]
+
+(* Testing interaction of local open in pattern and backtracking *)
+module PR6437 = struct
+  module Ctx = struct
+    type ('a, 'b) t =
+      | Nil : (unit, unit) t
+      | Cons : ('a, 'b) t -> ('a * unit, 'b * unit) t
+  end
+
+  module Var = struct
+    type 'a t =
+      | O : ('a * unit) t
+      | S : 'a t -> ('a * unit) t
+  end
+end
+
+let rec f : type g1 g2. (g1, g2) PR6437.Ctx.t * g1 PR6437.Var.t
+  -> g2 PR6437.Var.t = function
+  | PR6437.( Ctx.(Cons g), Var.(O) ) -> PR6437.Var.O
+  | PR6437.( Ctx.(Cons g), Var.(S n) ) -> PR6437.Var.S (f (g, n))
+  | _ -> . ;;
+[%%expect {|
+module PR6437 :
+  sig
+    module Ctx :
+      sig
+        type ('a, 'b) t =
+            Nil : (unit, unit) t
+          | Cons : ('a, 'b) t -> ('a * unit, 'b * unit) t
+      end
+    module Var :
+      sig type 'a t = O : ('a * unit) t | S : 'a t -> ('a * unit) t end
+  end
+val f : ('g1, 'g2) PR6437.Ctx.t * 'g1 PR6437.Var.t -> 'g2 PR6437.Var.t =
+  
+|}]
diff --git a/testsuite/tests/typing-misc/polyvars.ml b/testsuite/tests/typing-misc/polyvars.ml
new file mode 100644
index 00000000..52bc178f
--- /dev/null
+++ b/testsuite/tests/typing-misc/polyvars.ml
@@ -0,0 +1,199 @@
+(* TEST
+   * expect
+*)
+
+type ab = [ `A | `B ];;
+let f (x : [`A]) = match x with #ab -> 1;;
+[%%expect{|
+type ab = [ `A | `B ]
+Line 2, characters 32-35:
+2 | let f (x : [`A]) = match x with #ab -> 1;;
+                                    ^^^
+Error: This pattern matches values of type [? `A | `B ]
+       but a pattern was expected which matches values of type [ `A ]
+       The second variant type does not allow tag(s) `B
+|}];;
+let f x = ignore (match x with #ab -> 1); ignore (x : [`A]);;
+[%%expect{|
+Line 1, characters 31-34:
+1 | let f x = ignore (match x with #ab -> 1); ignore (x : [`A]);;
+                                   ^^^
+Error: This pattern matches values of type [? `B ]
+       but a pattern was expected which matches values of type [ `A ]
+       The second variant type does not allow tag(s) `B
+|}];;
+let f x = ignore (match x with `A|`B -> 1); ignore (x : [`A]);;
+[%%expect{|
+Line 1, characters 34-36:
+1 | let f x = ignore (match x with `A|`B -> 1); ignore (x : [`A]);;
+                                      ^^
+Error: This pattern matches values of type [? `B ]
+       but a pattern was expected which matches values of type [ `A ]
+       The second variant type does not allow tag(s) `B
+|}];;
+
+let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *)
+[%%expect{|
+Line 1, characters 49-51:
+1 | let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *)
+                                                     ^^
+Warning 12: this sub-pattern is unused.
+val f : [< `A | `B ] -> int = 
+|}];;
+let f (x : [`A | `B]) = match x with `A | `B | `C -> 0;; (* fail *)
+[%%expect{|
+Line 1, characters 47-49:
+1 | let f (x : [`A | `B]) = match x with `A | `B | `C -> 0;; (* fail *)
+                                                   ^^
+Error: This pattern matches values of type [? `C ]
+       but a pattern was expected which matches values of type [ `A | `B ]
+       The second variant type does not allow tag(s) `C
+|}];;
+
+(* imported from in poly.ml *)
+type t = A | B;;
+function `A,_ -> 1 | _,A -> 2 | _,B -> 3;;
+function `A,_ -> 1 | _,(A|B) -> 2;;
+function Some `A, _ -> 1 | Some _, A -> 2 | None, A -> 3 | _, B -> 4;;
+function Some `A, A -> 1 | Some `A, B -> 1
+       | Some _, A -> 2  | None, A -> 3 | _, B -> 4;;
+function A, `A -> 1 | A, `B -> 2 | B, _ -> 3;;
+function `A, A -> 1 | `B, A -> 2 | _, B -> 3;;
+function (`A|`B), _ -> 0 | _,(`A|`B) -> 1;;
+function `B,1 -> 1 | _,1 -> 2;;
+function 1,`B -> 1 | 1,_ -> 2;;
+[%%expect {|
+type t = A | B
+- : [> `A ] * t -> int = 
+- : [> `A ] * t -> int = 
+- : [> `A ] option * t -> int = 
+- : [> `A ] option * t -> int = 
+- : t * [< `A | `B ] -> int = 
+- : [< `A | `B ] * t -> int = 
+Line 9, characters 0-41:
+9 | function (`A|`B), _ -> 0 | _,(`A|`B) -> 1;;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(`AnyOtherTag, `AnyOtherTag)
+- : [> `A | `B ] * [> `A | `B ] -> int = 
+Line 10, characters 0-29:
+10 | function `B,1 -> 1 | _,1 -> 2;;
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(_, 0)
+Line 10, characters 21-24:
+10 | function `B,1 -> 1 | _,1 -> 2;;
+                          ^^^
+Warning 11: this match case is unused.
+- : [< `B ] * int -> int = 
+Line 11, characters 0-29:
+11 | function 1,`B -> 1 | 1,_ -> 2;;
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(0, _)
+Line 11, characters 21-24:
+11 | function 1,`B -> 1 | 1,_ -> 2;;
+                          ^^^
+Warning 11: this match case is unused.
+- : int * [< `B ] -> int = 
+|}];;
+
+(* PR#6787 *)
+let revapply x f = f x;;
+
+let f x (g : [< `Foo]) =
+  let y = `Bar x, g in
+  revapply y (fun ((`Bar i), _) -> i);;
+(* f : 'a -> [< `Foo ] -> 'a *)
+[%%expect{|
+val revapply : 'a -> ('a -> 'b) -> 'b = 
+val f : 'a -> [< `Foo ] -> 'a = 
+|}];;
+
+(* PR#6124 *)
+let f : ([`A | `B ] as 'a) -> [> 'a] -> unit = fun x (y : [> 'a]) -> ();;
+let f (x : [`A | `B] as 'a) (y : [> 'a]) = ();;
+[%%expect{|
+Line 1, characters 61-63:
+1 | let f : ([`A | `B ] as 'a) -> [> 'a] -> unit = fun x (y : [> 'a]) -> ();;
+                                                                 ^^
+Error: The type 'a does not expand to a polymorphic variant type
+Hint: Did you mean `a?
+|}]
+
+(* PR#5927 *)
+type 'a foo = 'a constraint 'a = [< `Tag of & int];;
+[%%expect{|
+type 'a foo = 'a constraint 'a = [< `Tag of & int ]
+|}]
+
+(* PR#7704 *)
+type t = private [> `A of string ];;
+function (`A x : t) -> x;;
+[%%expect{|
+type t = private [> `A of string ]
+Line 2, characters 0-24:
+2 | function (`A x : t) -> x;;
+    ^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+`
+- : t -> string = 
+|}]
+
+let f = function `AnyOtherTag, _ -> 1 | _, (`AnyOtherTag|`AnyOtherTag') -> 2;;
+[%%expect{|
+Line 1, characters 8-76:
+1 | let f = function `AnyOtherTag, _ -> 1 | _, (`AnyOtherTag|`AnyOtherTag') -> 2;;
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(`AnyOtherTag', `AnyOtherTag'')
+val f : [> `AnyOtherTag ] * [> `AnyOtherTag | `AnyOtherTag' ] -> int = 
+|}]
+
+let x:(([`A] as 'a)* ([`B] as 'a)) = [`A]
+[%%expect {|
+Line 1, characters 22-32:
+1 | let x:(([`A] as 'a)* ([`B] as 'a)) = [`A]
+                          ^^^^^^^^^^
+Error: This alias is bound to type [ `B ] but is used as an instance of type
+         [ `A ]
+       These two variant types have no intersection
+|}]
+
+type t = private [< `A]
+let f: t -> [ `A ] = fun x -> x
+[%%expect {|
+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 ]
+       The first variant type is private, it may not allow the tag(s) `A
+|}]
+
+
+(** Check that the non-regularity error message is robust to permutation *)
+
+type ('a,'b,'c,'d,'e) a = [ `A of ('d,'a,'e,'c,'b) b ]
+and  ('a,'b,'c,'d,'e) b = [ `B of ('c,'d,'e,'a,'b) c ]
+and  ('a,'b,'c,'d,'e) c = [ `C of ('a,'b,'c,'d,'e) a ]
+[%%expect {|
+Line 3, characters 0-54:
+3 | type ('a,'b,'c,'d,'e) a = [ `A of ('d,'a,'e,'c,'b) b ]
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This recursive type is not regular.
+       The type constructor a is defined as
+         type ('a, 'b, 'c, 'd, 'e) a
+       but it is used as
+         ('e, 'c, 'b, 'd, 'a) a
+       after the following expansion(s):
+         ('d, 'a, 'e, 'c, 'b) b = [ `B of ('e, 'c, 'b, 'd, 'a) c ],
+         ('e, 'c, 'b, 'd, 'a) c = [ `C of ('e, 'c, 'b, 'd, 'a) a ]
+       All uses need to match the definition for the recursive type to be regular.
+|}]
diff --git a/testsuite/tests/typing-misc/pr6416.ml b/testsuite/tests/typing-misc/pr6416.ml
new file mode 100644
index 00000000..bda17f1d
--- /dev/null
+++ b/testsuite/tests/typing-misc/pr6416.ml
@@ -0,0 +1,414 @@
+(* TEST
+  flags="-no-alias-deps -w +40"
+  * expect
+*)
+module M = struct
+  type t = A
+  module M : sig
+    val f : t -> unit
+  end = struct
+    type t = B
+    let f B = ()
+  end
+end;;
+[%%expect{|
+Lines 5-8, characters 8-5:
+5 | ........struct
+6 |     type t = B
+7 |     let f B = ()
+8 |   end
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = B val f : t -> unit end
+       is not included in
+         sig val f : t -> unit end
+       Values do not match:
+         val f : t/1 -> unit
+       is not included in
+         val f : t/2 -> unit
+       Line 6, characters 4-14:
+         Definition of type t/1
+       Line 2, characters 2-12:
+         Definition of type t/2
+|}]
+
+module N = struct
+  type t= A
+  module M: sig type u = A of t end =
+  struct type t = B type u = A of t end
+end;;
+[%%expect{|
+Line 4, characters 2-39:
+4 |   struct type t = B type u = A of t end
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = B type u = A of t end
+       is not included in
+         sig type u = A of t end
+       Type declarations do not match:
+         type u = A of t/1
+       is not included in
+         type u = A of t/2
+       Constructors do not match:
+         A of t/1
+       is not compatible with:
+         A of t/2
+       The types are not equal.
+       Line 4, characters 9-19:
+         Definition of type t/1
+       Line 2, characters 2-11:
+         Definition of type t/2
+|}]
+
+module K = struct
+  module type s
+  module M: sig module A:functor(X:s) -> sig end end =
+    struct
+      module type s
+      module A(X:s) =struct end
+    end
+end;;
+
+[%%expect{|
+Lines 4-7, characters 4-7:
+4 | ....struct
+5 |       module type s
+6 |       module A(X:s) =struct end
+7 |     end
+Error: Signature mismatch:
+       Modules do not match:
+         sig module type s module A : functor (X : s) -> sig end end
+       is not included in
+         sig module A : functor (X : s) -> sig end end
+       In module A:
+       Modules do not match:
+         functor (X : s/1) -> sig end
+       is not included in
+         functor (X : s/2) -> sig end
+       At position module A(X : ) : ...
+       Modules do not match: s/2 is not included in s/1
+       Line 5, characters 6-19:
+         Definition of module type s/1
+       Line 2, characters 2-15:
+         Definition of module type s/2
+|}]
+
+module L = struct
+  module T = struct type t end
+  module M: sig type t = A of T.t end =
+    struct
+      module T = struct type t end
+      type t = A of T.t
+    end
+end;;
+      [%%expect {|
+Lines 4-7, characters 4-7:
+4 | ....struct
+5 |       module T = struct type t end
+6 |       type t = A of T.t
+7 |     end
+Error: Signature mismatch:
+       Modules do not match:
+         sig module T : sig type t end type t = A of T.t end
+       is not included in
+         sig type t = A of T.t end
+       Type declarations do not match:
+         type t = A of T/1.t
+       is not included in
+         type t = A of T/2.t
+       Constructors do not match:
+         A of T/1.t
+       is not compatible with:
+         A of T/2.t
+       The types are not equal.
+       Line 5, characters 6-34:
+         Definition of module T/1
+       Line 2, characters 2-30:
+         Definition of module T/2
+|}]
+
+module O = struct
+  module type s
+  type t = A
+  module M: sig val f: (module s) -> t -> t end =
+  struct module type s type t = B let f (module X:s) A = B end
+end;;
+
+[%%expect{|
+Line 5, characters 2-62:
+5 |   struct module type s type t = B let f (module X:s) A = B end
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig module type s type t = B val f : (module s) -> t/2 -> t/1 end
+       is not included in
+         sig val f : (module s) -> t -> t end
+       Values do not match:
+         val f : (module s/1) -> t/2 -> t/1
+       is not included in
+         val f : (module s/2) -> t/2 -> t/2
+       Line 5, characters 23-33:
+         Definition of type t/1
+       Line 3, characters 2-12:
+         Definition of type t/2
+       Line 5, characters 9-22:
+         Definition of module type s/1
+       Line 2, characters 2-15:
+         Definition of module type s/2
+|}]
+
+module P = struct
+  module type a
+  type a = A
+   module M : sig val f: a -> (module a) -> a  end
+   = struct type a = B let f A _  = B end
+end;;
+
+[%%expect{|
+Line 5, characters 5-41:
+5 |    = struct type a = B let f A _  = B end
+         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type a = B val f : a/2 -> 'a -> a/1 end
+       is not included in
+         sig val f : a -> (module a) -> a end
+       Values do not match:
+         val f : a/2 -> 'a -> a/1
+       is not included in
+         val f : a/2 -> (module a) -> a/2
+       Line 5, characters 12-22:
+         Definition of type a/1
+       Line 3, characters 2-12:
+         Definition of type a/2
+|}]
+
+module Q = struct
+  class a = object method m = () end
+  module M: sig class b: a end =
+  struct
+    class a = object method c = let module X = struct type t end in () end
+    class b = a
+  end
+end;;
+
+
+[%%expect{|
+Lines 4-7, characters 2-5:
+4 | ..struct
+5 |     class a = object method c = let module X = struct type t end in () end
+6 |     class b = a
+7 |   end
+Error: Signature mismatch:
+       Modules do not match:
+         sig class a : object method c : unit end class b : a end
+       is not included in
+         sig class b : a end
+       Class declarations do not match:
+         class b : a
+       does not match
+         class b : a/2
+       The first class type has no method m
+       The public method c cannot be hidden
+       Line 5, characters 4-74:
+         Definition of class type a/1
+       Line 2, characters 2-36:
+         Definition of class type a/2
+|}]
+
+module R = struct
+  class type a = object method m: unit end
+  module M: sig class type b= a end =
+  struct
+    class type a = object end
+    class type b = a
+  end
+end;;
+
+[%%expect{|
+Lines 4-7, characters 2-5:
+4 | ..struct
+5 |     class type a = object end
+6 |     class type b = a
+7 |   end
+Error: Signature mismatch:
+       Modules do not match:
+         sig class type a = object  end class type b = a end
+       is not included in
+         sig class type b = a end
+       Class type declarations do not match:
+         class type b = a/1
+       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/1
+       Line 2, characters 2-42:
+         Definition of class type a/2
+|}]
+
+module S = struct
+  class a= object end
+  class b = a
+end;;
+
+[%%expect{|
+module S : sig class a : object  end class b : a end
+|}]
+
+module X: sig
+  type t
+  class type a = object method m:t end
+  module K: sig
+    type t
+    class type c = object method m: t end
+  end
+end = struct
+  type t
+  class type a = object method m:t end
+  module K = struct
+    type t
+    class type c = object inherit a end
+  end
+end;;
+
+[%%expect{|
+Lines 8-15, characters 6-3:
+ 8 | ......struct
+ 9 |   type t
+10 |   class type a = object method m:t end
+11 |   module K = struct
+12 |     type t
+13 |     class type c = object inherit a end
+14 |   end
+15 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig
+           type t
+           class type a = object method m : t end
+           module K : sig type t class type c = object method m : t/2 end end
+         end
+       is not included in
+         sig
+           type t
+           class type a = object method m : t end
+           module K : sig type t class type c = object method m : t end end
+         end
+       In module K:
+       Modules do not match:
+         sig type t = K.t class type c = object method m : t/2 end end
+       is not included in
+         sig type t class type c = object method m : t end end
+       In module K:
+       Class type declarations do not match:
+         class type c = object method m : t/2 end
+       does not match
+         class type c = object method m : t/1 end
+       The method m has type t/2 but is expected to have type t/1
+       Type t/2 is not compatible with type t/1 = K.t
+       Line 12, characters 4-10:
+         Definition of type t/1
+       Line 9, characters 2-8:
+         Definition of type t/2
+|}]
+;;
+
+module rec M: sig type t type a = M.t end  =
+struct type t module M = struct type t end type a = M.t end;;
+
+[%%expect{|
+Line 2, characters 0-59:
+2 | struct type t module M = struct type t end type a = M.t end;;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = M.t module M : sig type t = M.M.t end type a = M.t end
+       is not included in
+         sig type t type a = M.t end
+       Type declarations do not match:
+         type a = M/1.t
+       is not included in
+         type a = M/2.t
+       Line 2, characters 14-42:
+         Definition of module M/1
+       File "_none_", line 1:
+         Definition of module M/2
+|}]
+
+
+(** Multiple redefinition of t *)
+type t = A;;
+type t = B;;
+type t = C;;
+type t = D;;
+module M: sig val f: t -> t -> t -> t end = struct
+  let f A B C = D
+end;;
+[%%expect {|
+type t = A
+type t = B
+type t = C
+type t = D
+Lines 5-7, characters 44-3:
+5 | ............................................struct
+6 |   let f A B C = D
+7 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig val f : t/2 -> t/3 -> t/4 -> t/1 end
+       is not included in
+         sig val f : t -> t -> t -> t end
+       Values do not match:
+         val f : t/2 -> t/3 -> t/4 -> t/1
+       is not included in
+         val f : t/1 -> t/1 -> t/1 -> t/1
+       Line 4, characters 0-10:
+         Definition of type t/1
+       Line 1, characters 0-10:
+         Definition of type t/2
+       Line 2, characters 0-10:
+         Definition of type t/3
+       Line 3, characters 0-10:
+         Definition of type t/4
+|}]
+
+(** Check interaction with no-alias-deps *)
+module Foo = struct
+  type info = { doc : unit }
+  type t = { info : info }
+end
+let add_extra_info arg = arg.Foo.info.doc
+[%%expect {|
+module Foo : sig type info = { doc : unit; } type t = { info : info; } end
+Line 5, characters 38-41:
+5 | let add_extra_info arg = arg.Foo.info.doc
+                                          ^^^
+Warning 40: doc was selected from type Foo.info.
+It is not visible in the current scope, and will not
+be selected if the type becomes unknown.
+val add_extra_info : Foo.t -> unit = 
+|}]
+
+(** Check type-directed disambiguation *)
+module Bar = struct
+  type info = { doc : unit }
+end;;
+module Foo = struct
+  type t = { info : Bar.info }
+end;;
+module Bar = struct end;;
+let add_extra_info arg = arg.Foo.info.doc
+[%%expect{|
+module Bar : sig type info = { doc : unit; } end
+module Foo : sig type t = { info : Bar.info; } end
+module Bar : sig end
+Line 8, characters 38-41:
+8 | let add_extra_info arg = arg.Foo.info.doc
+                                          ^^^
+Warning 40: doc was selected from type Bar/2.info.
+It is not visible in the current scope, and will not
+be selected if the type becomes unknown.
+val add_extra_info : Foo.t -> unit = 
+|}]
diff --git a/testsuite/tests/typing-misc/pr6634.ml b/testsuite/tests/typing-misc/pr6634.ml
new file mode 100644
index 00000000..3e1daa82
--- /dev/null
+++ b/testsuite/tests/typing-misc/pr6634.ml
@@ -0,0 +1,30 @@
+(* TEST
+   * expect
+ *)
+
+type t = int
+module M : sig type t end with type t = [`T of t] =
+struct
+  type t = [`T of t]
+end;;
+
+[%%expect{|
+type t = int
+Lines 3-5, characters 0-3:
+3 | struct
+4 |   type t = [`T of t]
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = [ `T of t ] end
+       is not included in
+         sig type t = [ `T of t ] end
+       Type declarations do not match:
+         type t = [ `T of t/2 ]
+       is not included in
+         type t = [ `T of t/1 ]
+       Line 1, characters 0-12:
+         Definition of type t/1
+       Line 4, characters 2-20:
+         Definition of type t/2
+|}]
diff --git a/testsuite/tests/typing-misc/pr6939-flat-float-array.ml b/testsuite/tests/typing-misc/pr6939-flat-float-array.ml
new file mode 100644
index 00000000..2fe2fcd5
--- /dev/null
+++ b/testsuite/tests/typing-misc/pr6939-flat-float-array.ml
@@ -0,0 +1,24 @@
+(* TEST
+   * flat-float-array
+   ** expect
+*)
+
+let rec x = [| x |]; 1.;;
+[%%expect{|
+Line 1, characters 12-19:
+1 | let rec x = [| x |]; 1.;;
+                ^^^^^^^
+Warning 10: this expression should have type unit.
+Line 1, characters 12-23:
+1 | let rec x = [| x |]; 1.;;
+                ^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+let rec x = let u = [|y|] in 10. and y = 1.;;
+[%%expect{|
+Line 1, characters 12-32:
+1 | let rec x = let u = [|y|] in 10. and y = 1.;;
+                ^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
diff --git a/testsuite/tests/typing-misc/pr6939-no-flat-float-array.ml b/testsuite/tests/typing-misc/pr6939-no-flat-float-array.ml
new file mode 100644
index 00000000..a08bb57a
--- /dev/null
+++ b/testsuite/tests/typing-misc/pr6939-no-flat-float-array.ml
@@ -0,0 +1,23 @@
+(* TEST
+   * no-flat-float-array
+   ** expect
+*)
+
+let rec x = [| x |]; 1.;;
+[%%expect{|
+Line 1, characters 12-19:
+1 | let rec x = [| x |]; 1.;;
+                ^^^^^^^
+Warning 10: this expression should have type unit.
+val x : float = 1.
+|}];;
+
+let rec x = let u = [|y|] in 10. and y = 1.;;
+[%%expect{|
+Line 1, characters 16-17:
+1 | let rec x = let u = [|y|] in 10. and y = 1.;;
+                    ^
+Warning 26: unused variable u.
+val x : float = 10.
+val y : float = 1.
+|}];;
diff --git a/testsuite/tests/typing-misc/pr7103.ml b/testsuite/tests/typing-misc/pr7103.ml
new file mode 100644
index 00000000..524ca3f7
--- /dev/null
+++ b/testsuite/tests/typing-misc/pr7103.ml
@@ -0,0 +1,49 @@
+(* TEST
+   * expect
+*)
+
+type 'a t
+type a
+
+let f : < .. > t -> unit = fun _ -> ();;
+
+let g : [< `b] t -> unit = fun _ -> ();;
+
+let h : [> `b] t -> unit = fun _ -> ();;
+[%%expect{|
+type 'a t
+type a
+val f : < .. > t -> unit = 
+val g : [< `b ] t -> unit = 
+val h : [> `b ] t -> unit = 
+|}];;
+
+let _ = fun (x : a t) -> f x;;
+[%%expect{|
+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
+         (< .. > as 'a) t
+       Type a is not compatible with type < .. > as 'a
+|}];;
+
+let _ = fun (x : a t) -> g x;;
+[%%expect{|
+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
+         ([< `b ] as 'a) t
+       Type a is not compatible with type [< `b ] as 'a
+|}];;
+
+let _ = fun (x : a t) -> h x;;
+[%%expect{|
+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
+         ([> `b ] as 'a) t
+       Type a is not compatible with type [> `b ] as 'a
+|}];;
diff --git a/testsuite/tests/typing-misc/pr7228.ml b/testsuite/tests/typing-misc/pr7228.ml
new file mode 100644
index 00000000..1e98cca5
--- /dev/null
+++ b/testsuite/tests/typing-misc/pr7228.ml
@@ -0,0 +1,21 @@
+(* TEST
+   * expect
+*)
+
+type t = A of {mutable x: int};;
+fun (A r) -> r.x <- 42;;
+[%%expect{|
+type t = A of { mutable x : int; }
+- : t -> unit = 
+|}];;
+
+(* Check that mutability is blocked for inline records on private types *)
+type t = private A of {mutable x: int};;
+fun (A r) -> r.x <- 42;;
+[%%expect{|
+type t = private A of { mutable x : int; }
+Line 2, characters 15-16:
+2 | fun (A r) -> r.x <- 42;;
+                   ^
+Error: Cannot assign field x of the private type t.A
+|}];;
diff --git a/testsuite/tests/typing-misc/pr7668_bad.ml b/testsuite/tests/typing-misc/pr7668_bad.ml
new file mode 100644
index 00000000..95b64fb5
--- /dev/null
+++ b/testsuite/tests/typing-misc/pr7668_bad.ml
@@ -0,0 +1,92 @@
+(* TEST
+   * expect
+*)
+
+let partition_map f xs =
+ let rec part left right = function
+   | [] -> List.rev left, List.rev right
+   | x::xs ->
+       match f x with
+       | `Left v -> part (v::left) right xs
+       | `Right v -> part left (v::right) xs
+ in
+ part [] [] xs
+;;
+
+let f xs : (int list * int list) = partition_map (fun x -> if x then `Left ()
+else `Right ()) xs
+;;
+[%%expect{|
+val partition_map :
+  ('a -> [< `Left of 'b | `Right of 'c ]) -> 'a list -> 'b list * 'c list =
+  
+Lines 12-13, characters 35-18:
+12 | ...................................partition_map (fun x -> if x then `Left ()
+13 | else `Right ()) xs
+Error: This expression has type unit list * unit list
+       but an expression was expected of type int list * int list
+       Type unit is not compatible with type int
+|}]
+
+module M : sig
+  type t = [
+    | `A of int
+    | `B of [ `BA | `BB of unit list ]
+    | `C of unit ]
+
+  val a : t -> t
+end = struct
+  type t = [
+    | `A of int
+    | `B of [ `BA | `BB of unit list ]
+    | `C of unit ]
+
+let a b =
+  let f = function
+    | Ok x -> x
+    | Error _ -> `C ()
+  in
+  f (match b with
+      | `A pc ->
+        begin match pc with
+          | 1 -> Ok (`B `BA)
+          | _ -> Ok (`B (`BB [1;2;3]))
+        end
+      | _ -> assert false)
+
+end
+;;
+[%%expect{|
+Lines 8-27, characters 6-3:
+ 8 | ......struct
+ 9 |   type t = [
+10 |     | `A of int
+11 |     | `B of [ `BA | `BB of unit list ]
+12 |     | `C of unit ]
+...
+24 |         end
+25 |       | _ -> assert false)
+26 |
+27 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig
+           type t =
+               [ `A of int | `B of [ `BA | `BB of unit list ] | `C of unit ]
+           val a :
+             [> `A of int ] ->
+             [> `B of [> `BA | `BB of int list ] | `C of unit ]
+         end
+       is not included in
+         sig
+           type t =
+               [ `A of int | `B of [ `BA | `BB of unit list ] | `C of unit ]
+           val a : t -> t
+         end
+       Values do not match:
+         val a :
+           [> `A of int ] ->
+           [> `B of [> `BA | `BB of int list ] | `C of unit ]
+       is not included in
+         val a : t -> t
+|}]
diff --git a/testsuite/tests/typing-misc/pr7712.ml b/testsuite/tests/typing-misc/pr7712.ml
new file mode 100644
index 00000000..09ffb4d2
--- /dev/null
+++ b/testsuite/tests/typing-misc/pr7712.ml
@@ -0,0 +1,20 @@
+(* TEST
+   * expect
+*)
+
+type 'a or_error = string
+
+type ('a, 'b) t_ =
+  | Bar : ('a, 'a or_error) t_
+
+type 'a t = ('a, 'a) t_
+
+let f : type a. a t -> a t = function
+  | Bar -> Bar
+;;
+[%%expect{|
+type 'a or_error = string
+type ('a, 'b) t_ = Bar : ('a, 'a or_error) t_
+type 'a t = ('a, 'a) t_
+val f : 'a t -> 'a t = 
+|}];;
diff --git a/testsuite/tests/typing-misc/pr7937.ml b/testsuite/tests/typing-misc/pr7937.ml
new file mode 100644
index 00000000..c4e42c7d
--- /dev/null
+++ b/testsuite/tests/typing-misc/pr7937.ml
@@ -0,0 +1,84 @@
+(* TEST
+   * expect
+*)
+
+type 'a r = [< `X of int & 'a ] as 'a
+
+let f: 'a. 'a r -> 'a r = fun x -> true;;
+[%%expect {|
+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
+       Types for tag `X are incompatible
+|}, Principal{|
+type 'a r = 'a constraint 'a = [< `X of int & 'a ]
+Line 3, characters 30-31:
+3 | let f: 'a. 'a r -> 'a r = fun x -> true;;
+                                  ^
+Error: This pattern matches values of type
+         ([< `X of 'b & 'a & 'c & 'd & 'e ] as 'a) r
+       but a pattern was expected which matches values of type
+         ([< `X of int & 'f ] as 'f) r
+       Types for tag `X are incompatible
+|}]
+
+let g: 'a. 'a r -> 'a r = fun x -> { contents = 0 };;
+[%%expect {|
+Line 1, characters 35-51:
+1 | let g: 'a. 'a r -> 'a r = fun x -> { contents = 0 };;
+                                       ^^^^^^^^^^^^^^^^
+Error: This expression has type int ref
+       but an expression was expected of type ([< `X of int & 'a ] as 'a) r
+       Types for tag `X are incompatible
+|}, Principal{|
+Line 1, characters 30-31:
+1 | let g: 'a. 'a r -> 'a r = fun x -> { contents = 0 };;
+                                  ^
+Error: This pattern matches values of type
+         ([< `X of 'b & 'a & 'c & 'd & 'e ] as 'a) r
+       but a pattern was expected which matches values of type
+         ([< `X of int & 'f ] as 'f) r
+       Types for tag `X are incompatible
+|}]
+
+let h: 'a. 'a r -> _ = function true | false -> ();;
+[%%expect {|
+Line 1, characters 32-36:
+1 | let h: 'a. 'a r -> _ = function true | false -> ();;
+                                    ^^^^
+Error: This pattern matches values of type bool
+       but a pattern was expected which matches values of type
+         ([< `X of int & 'a ] as 'a) r
+       Types for tag `X are incompatible
+|}, Principal{|
+Line 1, characters 32-36:
+1 | let h: 'a. 'a r -> _ = function true | false -> ();;
+                                    ^^^^
+Error: This pattern matches values of type bool
+       but a pattern was expected which matches values of type
+         ([< `X of 'b & 'a & 'c ] as 'a) r
+       Types for tag `X are incompatible
+|}]
+
+
+let i: 'a. 'a r -> _ = function { contents = 0 } -> ();;
+[%%expect {|
+Line 1, characters 32-48:
+1 | let i: 'a. 'a r -> _ = function { contents = 0 } -> ();;
+                                    ^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type int ref
+       but a pattern was expected which matches values of type
+         ([< `X of int & 'a ] as 'a) r
+       Types for tag `X are incompatible
+|}, Principal{|
+Line 1, characters 32-48:
+1 | let i: 'a. 'a r -> _ = function { contents = 0 } -> ();;
+                                    ^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type int ref
+       but a pattern was expected which matches values of type
+         ([< `X of 'b & 'a & 'c ] as 'a) r
+       Types for tag `X are incompatible
+|}]
diff --git a/testsuite/tests/typing-misc/pr8548.ml b/testsuite/tests/typing-misc/pr8548.ml
new file mode 100644
index 00000000..7053ed68
--- /dev/null
+++ b/testsuite/tests/typing-misc/pr8548.ml
@@ -0,0 +1,147 @@
+(* TEST
+   * expect *)
+
+module type Endpoint_intf = sig
+  type t
+end
+;;
+[%%expect{|
+module type Endpoint_intf = sig type t end
+|}]
+
+module type S = sig
+  module Endpoint : Endpoint_intf
+
+  type finite = [ `Before of Endpoint.t ]
+  type infinite = [ `Until_infinity ]
+
+  type +'a range = private { until : 'a } constraint 'a = [< finite | infinite ]
+
+  val until : 'a range -> 'a
+end
+;;
+[%%expect{|
+module type S =
+  sig
+    module Endpoint : Endpoint_intf
+    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 type Ranged = sig
+  module Endpoint : Endpoint_intf
+  module Range : S with type Endpoint.t = Endpoint.t
+end
+;;
+[%%expect{|
+module type Ranged =
+  sig
+    module Endpoint : Endpoint_intf
+    module Range :
+      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
+  end
+|}]
+
+module Assume (Given : sig
+    module Make_range (Endpoint : Endpoint_intf) :
+      S with module Endpoint = Endpoint
+
+    module Make_ranged (Range : S) :
+      Ranged with module Endpoint = Range.Endpoint
+              and module Range = Range
+  end) =
+struct
+  module Point = struct
+    type t
+  end
+
+  open Given
+
+  module Test_range = Make_range(Point)
+  module Test_ranged = Make_ranged(Test_range)
+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)
+    ->
+    sig
+      module Point : sig type t end
+      module Test_range :
+        sig
+          module Endpoint : sig type t = Point.t end
+          type finite = [ `Before of Endpoint.t ]
+          type infinite = [ `Until_infinity ]
+          type +'a range =
+            'a Given.Make_range(Point).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 Test_ranged :
+        sig
+          module Endpoint : sig type t = Test_range.Endpoint.t end
+          module Range :
+            sig
+              module Endpoint : sig type t = Test_range.Endpoint.t end
+              type finite = [ `Before of Endpoint.t ]
+              type infinite = [ `Until_infinity ]
+              type +'a range = 'a Test_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
+|}]
diff --git a/testsuite/tests/typing-misc/pr8548_split.ml b/testsuite/tests/typing-misc/pr8548_split.ml
new file mode 100644
index 00000000..65f9a00c
--- /dev/null
+++ b/testsuite/tests/typing-misc/pr8548_split.ml
@@ -0,0 +1,20 @@
+(* TEST
+files = "mapping.ml range_intf.ml ranged_intf.ml range.ml ranged.ml"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+flags = "-no-alias-deps -w -49 -o Pr8548__Mapping"
+module = "mapping.ml"
+** ocamlc.byte
+flags = "-no-alias-deps -open Pr8548__Mapping -o pr8548__Range_intf.cmo"
+module = "range_intf.ml"
+*** ocamlc.byte
+flags = "-no-alias-deps -open Pr8548__Mapping -o pr8548__Range.cmo"
+module = "range.ml"
+*** ocamlc.byte
+flags = "-no-alias-deps -open Pr8548__Mapping -o pr8548__Ranged_intf.cmo"
+module = "ranged_intf.ml"
+**** ocamlc.byte
+flags = "-no-alias-deps -open Pr8548__Mapping -o pr8548__Ranged.cmo"
+module = "ranged.ml"
+ocamlc_byte_exit_status = "0"
+*)
diff --git a/testsuite/tests/typing-misc/printing.ml b/testsuite/tests/typing-misc/printing.ml
new file mode 100644
index 00000000..911ba30e
--- /dev/null
+++ b/testsuite/tests/typing-misc/printing.ml
@@ -0,0 +1,101 @@
+(* TEST
+   * expect
+*)
+
+(* PR#7012 *)
+
+type t = [ 'A_name | `Hi ];;
+[%%expect{|
+Line 1, characters 11-18:
+1 | type t = [ 'A_name | `Hi ];;
+               ^^^^^^^
+Error: The type 'A_name does not expand to a polymorphic variant type
+Hint: Did you mean `A_name?
+|}];;
+
+let f (x:'id_arg) = x;;
+[%%expect{|
+val f : 'id_arg -> 'id_arg = 
+|}];;
+
+let f (x:'Id_arg) = x;;
+[%%expect{|
+val f : 'Id_arg -> 'Id_arg = 
+|}];;
+
+(* GPR#1204, GPR#1329 *)
+type 'a id = 'a
+let f (x : [< [`Foo] id]) = ();;
+[%%expect{|
+type 'a id = 'a
+val f : [< [ `Foo ] id ] -> unit = 
+|}];;
+
+module M = struct module N = struct type t = [`A] end end;;
+let f x = (x :> M.N.t);;
+[%%expect{|
+module M : sig module N : sig type t = [ `A ] end end
+val f : [< M.N.t ] -> M.N.t = 
+|}]
+module G = M.N;;
+let f x = (x :> G.t);;
+[%%expect{|
+module G = M.N
+val f : [< G.t ] -> G.t = 
+|}]
+
+
+(* GPR#2034 *)
+
+type (+' a', -' a'b, 'cd') t = ' a'b -> ' a'  * 'cd';;
+[%%expect{|
+type (' a', ' a'b, 'cd') t = ' a'b -> ' a' * 'cd'
+|}];;
+
+
+(* #8856: cycles in types expressions could trigger stack overflows
+   when printing subpart of error messages *)
+
+type 'a t = private X of 'a
+let zeros = object(self) method next = 0, self end
+let x = X zeros;;
+[%%expect {|
+type 'a t = private X of 'a
+val zeros : < next : int * 'a > as 'a = 
+Line 3, characters 8-15:
+3 | let x = X zeros;;
+            ^^^^^^^
+Error: Cannot create values of the private type (< next : int * 'a > as 'a) t
+|}]
+
+
+type ('a,'b) eq = Refl: ('a,'a) eq
+type t =  as 't
+let f (x:t) (type a) (y:a) (witness:(a,t) eq) = match witness with
+  | Refl -> if true then x else y
+[%%expect {|
+type ('a, 'b) eq = Refl : ('a, 'a) eq
+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
+       This instance of < m : int * 'a > as 'a is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+
+type t1 =  as 'bar)>
+type t2 =  as 'foo
+let f (x : t1) : t2 = x;;
+[%%expect {|
+type t1 = < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) >
+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
+       The method m has type 'c. 'c * ('a * < m : 'c. 'b >) as 'b,
+       but the expected method type was 'a. 'a * ('a * < m : 'a. 'b >) as 'b
+       The universal variable 'a would escape its scope
+|}]
diff --git a/testsuite/tests/typing-misc/range.ml b/testsuite/tests/typing-misc/range.ml
new file mode 100644
index 00000000..fd83af95
--- /dev/null
+++ b/testsuite/tests/typing-misc/range.ml
@@ -0,0 +1,16 @@
+module Make (Endpoint : Range_intf.Endpoint_intf) :
+  Range_intf.S with module Endpoint = Endpoint
+= struct
+  module Endpoint = Endpoint
+
+  type finite = [ `Before of Endpoint.t ]
+  type infinite = [ `Until_infinity ]
+
+  type +'a range = { until : 'a } constraint 'a = [< finite | infinite ]
+
+  let until r = r.until
+
+  type t = [finite | infinite] range
+
+  let compare_range _ _ _ = 0
+end
diff --git a/testsuite/tests/typing-misc/range_intf.ml b/testsuite/tests/typing-misc/range_intf.ml
new file mode 100644
index 00000000..4a620a9b
--- /dev/null
+++ b/testsuite/tests/typing-misc/range_intf.ml
@@ -0,0 +1,16 @@
+module type Endpoint_intf = sig
+  type t
+end
+
+module type S = sig
+  module Endpoint : Endpoint_intf
+
+  type finite = [ `Before of Endpoint.t ]
+  type infinite = [ `Until_infinity ]
+
+  type +'a range = private { until : 'a } constraint 'a = [< finite | infinite ]
+
+  val compare_range : ('a -> 'a -> int) -> 'a range -> 'a range -> int
+
+  type t = [finite | infinite] range
+end
diff --git a/testsuite/tests/typing-misc/ranged.ml b/testsuite/tests/typing-misc/ranged.ml
new file mode 100644
index 00000000..3aadcc52
--- /dev/null
+++ b/testsuite/tests/typing-misc/ranged.ml
@@ -0,0 +1,14 @@
+module Make (Range : Range_intf.S) :
+  Ranged_intf.S with module Endpoint = Range.Endpoint
+                 and module Range = Range
+= struct
+  module Endpoint = Range.Endpoint
+  module Range = Range
+end
+
+module Test = struct
+  type t = T
+end
+
+module Test_range = Range.Make(Test)
+module Test_ranged = Make(Test_range)
diff --git a/testsuite/tests/typing-misc/ranged_intf.ml b/testsuite/tests/typing-misc/ranged_intf.ml
new file mode 100644
index 00000000..1672d6e7
--- /dev/null
+++ b/testsuite/tests/typing-misc/ranged_intf.ml
@@ -0,0 +1,4 @@
+module type S = sig
+  module Endpoint : Range_intf.Endpoint_intf
+  module Range : Range_intf.S with type Endpoint.t = Endpoint.t
+end
diff --git a/testsuite/tests/typing-misc/records.ml b/testsuite/tests/typing-misc/records.ml
new file mode 100644
index 00000000..d11f1b4e
--- /dev/null
+++ b/testsuite/tests/typing-misc/records.ml
@@ -0,0 +1,268 @@
+(* TEST
+   * expect
+*)
+
+(* undefined labels *)
+type t = {x:int;y:int};;
+{x=3;z=2};;
+[%%expect{|
+type t = { x : int; y : int; }
+Line 2, characters 5-6:
+2 | {x=3;z=2};;
+         ^
+Error: Unbound record field z
+|}];;
+fun {x=3;z=2} -> ();;
+[%%expect{|
+Line 1, characters 9-10:
+1 | fun {x=3;z=2} -> ();;
+             ^
+Error: Unbound record field z
+|}];;
+
+(* mixed labels *)
+{x=3; contents=2};;
+[%%expect{|
+Line 1, characters 6-14:
+1 | {x=3; contents=2};;
+          ^^^^^^^^
+Error: The record field contents belongs to the type 'a ref
+       but is mixed here with fields of type t
+|}];;
+
+(* private types *)
+type u = private {mutable u:int};;
+{u=3};;
+[%%expect{|
+type u = private { mutable u : int; }
+Line 2, characters 0-5:
+2 | {u=3};;
+    ^^^^^
+Error: Cannot create values of the private type u
+|}];;
+fun x -> x.u <- 3;;
+[%%expect{|
+Line 1, characters 11-12:
+1 | fun x -> x.u <- 3;;
+               ^
+Error: Cannot assign field u of the private type u
+|}];;
+
+(* Punning and abbreviations *)
+module M = struct
+  type t = {x: int; y: int}
+end;;
+[%%expect{|
+module M : sig type t = { x : int; y : int; } end
+|}];;
+
+let f {M.x; y} = x+y;;
+let r = {M.x=1; y=2};;
+let z = f r;;
+[%%expect{|
+val f : M.t -> int = 
+val r : M.t = {M.x = 1; y = 2}
+val z : int = 3
+|}];;
+
+(* messages *)
+type foo = { mutable y:int };;
+let f (r: int) = r.y <- 3;;
+[%%expect{|
+type foo = { mutable y : int; }
+Line 2, characters 17-18:
+2 | let f (r: int) = r.y <- 3;;
+                     ^
+Error: This expression has type int but an expression was expected of type
+         foo
+|}];;
+
+let f (r: int) =
+  match r with
+  | { contents = 3 } -> ()
+[%%expect{|
+Line 3, characters 4-20:
+3 |   | { contents = 3 } -> ()
+        ^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type int ref
+       but a pattern was expected which matches values of type int
+|}];;
+
+
+
+(* bugs *)
+type foo = { y: int; z: int };;
+type bar = { x: int };;
+let f (r: bar) = ({ r with z = 3 } : foo)
+[%%expect{|
+type foo = { y : int; z : int; }
+type bar = { x : int; }
+Line 3, characters 20-21:
+3 | let f (r: bar) = ({ r with z = 3 } : foo)
+                        ^
+Error: This expression has type bar but an expression was expected of type
+         foo
+|}];;
+
+type foo = { x: int };;
+let r : foo = { ZZZ.x = 2 };;
+[%%expect{|
+type foo = { x : int; }
+Line 2, characters 16-21:
+2 | let r : foo = { ZZZ.x = 2 };;
+                    ^^^^^
+Error: Unbound module ZZZ
+|}];;
+
+(ZZZ.X : int option);;
+[%%expect{|
+Line 1, characters 1-6:
+1 | (ZZZ.X : int option);;
+     ^^^^^
+Error: Unbound module ZZZ
+|}];;
+
+(* PR#5865 *)
+let f (x : Complex.t) = x.Complex.z;;
+[%%expect{|
+Line 1, characters 26-35:
+1 | let f (x : Complex.t) = x.Complex.z;;
+                              ^^^^^^^^^
+Error: Unbound record field Complex.z
+|}];;
+
+(* PR#6608 *)
+{ true with contents = 0 };;
+[%%expect{|
+Line 1, characters 2-6:
+1 | { true with contents = 0 };;
+      ^^^^
+Error: This expression has type bool but an expression was expected of type
+         'a ref
+|}];;
+
+type ('a, 'b) t = { fst : 'a; snd : 'b };;
+let with_fst r fst = { r with fst };;
+with_fst { fst=""; snd="" } 2;;
+[%%expect{|
+type ('a, 'b) t = { fst : 'a; snd : 'b; }
+val with_fst : ('a, 'b) t -> 'c -> ('c, 'b) t = 
+- : (int, string) t = {fst = 2; snd = ""}
+|}];;
+
+(* PR#7695 *)
+type 'a t = { f : 'a; g : 'a };;
+let x = { f = 12; g = 43 };;
+{x with f = "hola"};;
+[%%expect{|
+type 'a t = { f : 'a; g : 'a; }
+val x : int t = {f = 12; g = 43}
+Line 3, characters 0-19:
+3 | {x with f = "hola"};;
+    ^^^^^^^^^^^^^^^^^^^
+Error: This expression has type string t
+       but an expression was expected of type int t
+       Type string is not compatible with type int
+|}]
+
+(* PR#7696 *)
+let r = { (assert false) with contents = 1 } ;;
+[%%expect{|
+Line 1, characters 8-44:
+1 | let r = { (assert false) with contents = 1 } ;;
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 23: all the fields are explicitly listed in this record:
+the 'with' clause is useless.
+Exception: Assert_failure ("", 1, 10).
+|}]
+
+(* reexport *)
+
+type ('a,'b) def = { x:int } constraint 'b = [> `A]
+
+type arity = (int, [`A]) def = {x:int};;
+[%%expect{|
+type ('a, 'b) def = { x : int; } constraint 'b = [> `A ]
+Line 3, characters 0-38:
+3 | type arity = (int, [`A]) def = {x:int};;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type
+         (int, [ `A ]) def
+       They have different arities.
+|}]
+
+type ('a,'b) ct = (int,'b) def = {x:int};;
+[%%expect{|
+Line 1, characters 0-40:
+1 | type ('a,'b) ct = (int,'b) def = {x:int};;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type
+         (int, [> `A ]) def
+       Their constraints differ.
+|}]
+
+type ('a,'b) kind = ('a, 'b) def = A constraint 'b = [> `A];;
+[%%expect{|
+Line 1, characters 0-59:
+1 | type ('a,'b) kind = ('a, 'b) def = A constraint 'b = [> `A];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type
+         ('a, [> `A ]) def
+       Their kinds differ.
+|}]
+
+type d = { x:int; y : int }
+type mut = d = {x:int; mutable y:int}
+[%%expect{|
+type d = { x : int; y : int; }
+Line 2, characters 0-37:
+2 | type mut = d = {x:int; mutable y:int}
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type d
+       Fields do not match:
+         y : int;
+       is not compatible with:
+         mutable y : int;
+       This is mutable and the original is not.
+|}]
+
+type missing = d = { x:int }
+[%%expect{|
+Line 1, characters 0-28:
+1 | type missing = d = { x:int }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type d
+       The field y is only present in the original definition.
+|}]
+
+type wrong_type = d = {x:float}
+[%%expect{|
+Line 1, characters 0-31:
+1 | type wrong_type = d = {x:float}
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type d
+       Fields do not match:
+         x : int;
+       is not compatible with:
+         x : float;
+       The types are not equal.
+|}]
+
+type unboxed = d = {x:float} [@@unboxed]
+[%%expect{|
+Line 1, characters 0-40:
+1 | type unboxed = d = {x:float} [@@unboxed]
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type d
+       Their internal representations differ:
+       this definition uses unboxed representation.
+|}]
+
+type perm = d = {y:int; x:int}
+[%%expect{|
+Line 1, characters 0-30:
+1 | type perm = d = {y:int; x:int}
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type d
+       Fields number 1 have different names, x and y.
+|}]
diff --git a/testsuite/tests/typing-misc/scope_escape.ml b/testsuite/tests/typing-misc/scope_escape.ml
new file mode 100644
index 00000000..94a47d23
--- /dev/null
+++ b/testsuite/tests/typing-misc/scope_escape.ml
@@ -0,0 +1,15 @@
+(* TEST
+   * expect
+*)
+
+let x = ref []
+module M = struct type t let _ = (x : t list ref) end;;
+[%%expect{|
+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
+       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_empty_polyvariant_error.compilers.reference b/testsuite/tests/typing-misc/typecore_empty_polyvariant_error.compilers.reference
new file mode 100644
index 00000000..39673507
--- /dev/null
+++ b/testsuite/tests/typing-misc/typecore_empty_polyvariant_error.compilers.reference
@@ -0,0 +1,6 @@
+type t = [  ]
+Line 1, characters 31-32:
+1 | let f: 'a. t -> 'a = function #t -> . ;;
+                                   ^
+Error: The type t is not a variant type
+
diff --git a/testsuite/tests/typing-misc/typecore_empty_polyvariant_error.ml b/testsuite/tests/typing-misc/typecore_empty_polyvariant_error.ml
new file mode 100644
index 00000000..11c23d9b
--- /dev/null
+++ b/testsuite/tests/typing-misc/typecore_empty_polyvariant_error.ml
@@ -0,0 +1,13 @@
+(* TEST
+  files="empty_ppx.ml"
+  * setup-ocamlc.byte-build-env
+  ** ocamlc.byte with ocamlcommon
+  all_modules="empty_ppx.ml"
+  program="ppx.exe"
+  *** toplevel
+  all_modules="${test_file}"
+  flags="-ppx '${ocamlrun} ${test_build_directory_prefix}/ocamlc.byte/ppx.exe'"
+*)
+
+type t = [%empty_polyvar];;
+let f: 'a. t -> 'a = function #t -> . ;;
diff --git a/testsuite/tests/typing-misc/typecore_errors.ml b/testsuite/tests/typing-misc/typecore_errors.ml
new file mode 100644
index 00000000..9b00a4f6
--- /dev/null
+++ b/testsuite/tests/typing-misc/typecore_errors.ml
@@ -0,0 +1,464 @@
+(* TEST
+   * expect
+*)
+
+
+(** Gives an example for every [raise(Error(_,_,_)] in typing/typecore.ml
+    that is no covered by another test in the testsuite and does not
+    require special flags or ppx.
+*)
+
+(** Illegal interval *)
+
+let x = function 0. .. 1. -> ()
+[%%expect {|
+Line 8, characters 17-25:
+8 | let x = function 0. .. 1. -> ()
+                     ^^^^^^^^
+Error: Only character intervals are supported in patterns.
+|}]
+
+(** Constructor arity mismatch *)
+let f = function None None -> 0
+
+[%%expect{|
+Line 1, characters 17-26:
+1 | let f = function None None -> 0
+                     ^^^^^^^^^
+Error: The constructor None expects 0 argument(s),
+       but is applied here to 1 argument(s)
+|}]
+
+let x = None None
+[%%expect{|
+Line 1, characters 8-17:
+1 | let x = None None
+            ^^^^^^^^^
+Error: The constructor None expects 0 argument(s),
+       but is applied here to 1 argument(s)
+|}]
+
+(** Inline record escape *)
+type t = A of {x:int}
+let f = function (A (x:_)) -> 0
+
+[%%expect{|
+type t = A of { x : int; }
+Line 2, characters 20-25:
+2 | let f = function (A (x:_)) -> 0
+                        ^^^^^
+Error: This form is not allowed as the type of the inlined record could escape.
+|}]
+
+
+(** Exception below toplevel *)
+let f = function Some(exception Not_found) -> 0
+[%%expect{|
+Line 1, characters 21-42:
+1 | let f = function Some(exception Not_found) -> 0
+                         ^^^^^^^^^^^^^^^^^^^^^
+Error: Exception patterns are not allowed in this position.
+|}]
+
+(** Extension *)
+let f = function [%ext] -> 0
+[%%expect{|
+Line 1, characters 19-22:
+1 | let f = function [%ext] -> 0
+                       ^^^
+Error: Uninterpreted extension 'ext'.
+|}]
+
+
+(** Unification error in type approx *)
+
+let rec f x = ( (), () : _ -> _ -> _ )
+[%%expect{|
+Line 3, characters 14-38:
+3 | let rec f x = ( (), () : _ -> _ -> _ )
+                  ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This expression has type 'a * 'b
+       but an expression was expected of type 'c -> 'd -> 'e
+|}]
+
+let rec g x = ( ((), ()) : _ -> _ :> _ )
+[%%expect{|
+Line 1, characters 14-40:
+1 | let rec g x = ( ((), ()) : _ -> _ :> _ )
+                  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This expression has type 'a * 'b
+       but an expression was expected of type 'c -> 'd
+|}]
+
+
+(** No value clause *)
+
+let f x = match x with exception Not_found -> ();;
+[%%expect{|
+Line 3, characters 10-48:
+3 | let f x = match x with exception Not_found -> ();;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: None of the patterns in this 'match' expression match values.
+|}]
+
+(** Check duplicate *)
+type r = { x : int }
+let r = { x= 1; x= 1}
+
+[%%expect{|
+type r = { x : int; }
+Line 2, characters 8-21:
+2 | let r = { x= 1; x= 1}
+            ^^^^^^^^^^^^^
+Error: The record field label x is defined several times
+|}]
+
+(** Non-mutable is non mutable *)
+let () = { x = 1 }.x <- 2
+
+[%%expect{|
+Line 1, characters 9-25:
+1 | let () = { x = 1 }.x <- 2
+             ^^^^^^^^^^^^^^^^
+Error: The record field x is not mutable
+|}]
+
+
+(** Invalid for loop *)
+
+let () = for Some i = 3 to 4 do () done;
+[%%expect{|
+Line 3, characters 13-19:
+3 | let () = for Some i = 3 to 4 do () done;
+                 ^^^^^^
+Error: Invalid for-loop index: only variables and _ are allowed.
+|}]
+
+
+(** Inherited methods not defined *)
+
+class virtual v = object method virtual m: int end;;
+class c = object(self)
+  inherit v as super
+  method m = 0
+  method x: int = super#m
+end;;
+
+[%%expect{|
+class virtual v : object method virtual m : int end
+Line 7, characters 18-23:
+7 |   method x: int = super#m
+                      ^^^^^
+Error: This expression has no method m
+|}]
+
+(** New virtual class *)
+
+let x = new v
+
+[%%expect{|
+Line 3, characters 8-13:
+3 | let x = new v
+            ^^^^^
+Error: Cannot instantiate the virtual class v
+|}]
+
+
+(* Immutable instance variable cannot be mutated *)
+let x = object val x = 1 method m = x<-0 end
+
+[%%expect{|
+Line 1, characters 36-40:
+1 | let x = object val x = 1 method m = x<-0 end
+                                        ^^^^
+Error: The instance variable x is not mutable
+|}]
+
+(** Self variables cannot be mutated *)
+let x = object(self) method m = self <-0 end
+
+[%%expect{|
+Line 1, characters 32-40:
+1 | let x = object(self) method m = self <-0 end
+                                    ^^^^^^^^
+Error: The value self is not an instance variable
+|}]
+
+(** Multiply override *)
+
+class c = object val x = 0 method m: c = {< x=0; x=1 >} end
+
+[%%expect{|
+Line 3, characters 41-55:
+3 | class c = object val x = 0 method m: c = {< x=0; x=1 >} end
+                                             ^^^^^^^^^^^^^^
+Error: The instance variable x is overridden several times
+|}]
+
+(** Override outside of classes *)
+
+let f x = {< y = x >}
+
+[%%expect{|
+Line 3, characters 10-21:
+3 | let f x = {< y = x >}
+              ^^^^^^^^^^^
+Error: This object duplication occurs outside a method definition
+|}]
+
+
+(** Unbound instance variable in object duplication *)
+
+class c = object val x = 0 method m: c = {< y=1 >} end
+
+[%%expect{|
+Line 3, characters 41-50:
+3 | class c = object val x = 0 method m: c = {< y=1 >} end
+                                             ^^^^^^^^^
+Error: Unbound instance variable y
+|}]
+
+
+(** Not a packed type *)
+module type empty = sig  end
+let f (x:int) = ()
+let x = f (module struct end)
+[%%expect {|
+module type empty = sig end
+val f : int -> unit = 
+Line 3, characters 10-29:
+3 | let x = f (module struct end)
+              ^^^^^^^^^^^^^^^^^^^
+Error: This expression is packed module, but the expected type is int
+|}]
+
+
+(** Builtin [%extension_constructor *)
+type t = A
+let x = [%extension_constructor A]
+[%%expect {|
+type t = A
+Line 2, characters 32-33:
+2 | let x = [%extension_constructor A]
+                                    ^
+Error: This constructor is not an extension constructor.
+|}]
+
+let x = [%extension_constructor]
+[%%expect {|
+Line 1, characters 8-32:
+1 | let x = [%extension_constructor]
+            ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Invalid [%extension_constructor] payload, a constructor is expected.
+|}]
+
+(** Invalid format *)
+let x = format_of_string "%z"
+[%%expect {|
+Line 1, characters 25-29:
+1 | let x = format_of_string "%z"
+                             ^^^^
+Error: invalid format "%z": at character number 1, invalid conversion "%z"
+|}]
+
+(** Apply wrong label *)
+
+let f ~x = x + 2
+let y = f ~y:1
+[%%expect {|
+val f : x:int -> int = 
+Line 4, characters 13-14:
+4 | let y = f ~y:1
+                 ^
+Error: The function applied to this argument has type x:int -> int
+This argument cannot be applied with label ~y
+|}]
+
+let g f = f ~x:0 ~y:0; f ~y:0 ~x:0
+[%%expect {|
+Line 1, characters 23-24:
+1 | let g f = f ~x:0 ~y:0; f ~y:0 ~x:0
+                           ^
+Error: This function is applied to arguments
+       in an order different from other calls.
+       This is only allowed when the real type is known.
+|}]
+
+(** Inlined record *)
+type t = A of { x: int }
+let x = A 1
+[%%expect {|
+type t = A of { x : int; }
+Line 2, characters 8-11:
+2 | let x = A 1
+            ^^^
+Error: This constructor expects an inlined record argument.
+|}]
+
+(** Illegal let rec *)
+type 'a t = A of 'a
+let rec A x = A (A ())
+
+[%%expect {|
+type 'a t = A of 'a
+Line 2, characters 8-11:
+2 | let rec A x = A (A ())
+            ^^^
+Error: Only variables are allowed as left-hand side of `let rec'
+|}]
+
+(** Non-linear pattern *)
+
+let quadratic (x,x) = x * x
+[%%expect {|
+Line 3, characters 17-18:
+3 | let quadratic (x,x) = x * x
+                     ^
+Error: Variable x is bound several times in this matching
+|}]
+
+(** Or-patter clash *)
+type t = A of int | B of float|C
+let f (A x|B x) = 0
+[%%expect {|
+type t = A of int | B of float | C
+Line 2, characters 6-15:
+2 | let f (A x|B x) = 0
+          ^^^^^^^^^
+Error: The variable x on the left-hand side of this or-pattern has type
+       int but on the right-hand side it has type float
+|}]
+
+(** Orphan pattern variable *)
+
+let f (A x|C) = 0
+[%%expect {|
+Line 3, characters 6-13:
+3 | let f (A x|C) = 0
+          ^^^^^^^
+Error: Variable x must occur on both sides of this | pattern
+|}]
+
+
+let f (A x|B y) = 0
+[%%expect {|
+Line 1, characters 6-15:
+1 | let f (A x|B y) = 0
+          ^^^^^^^^^
+Error: Variable x must occur on both sides of this | pattern
+|}]
+
+(** #t *)
+type t = []
+let f = function #t -> ()
+[%%expect {|
+type t = []
+Line 2, characters 18-19:
+2 | let f = function #t -> ()
+                      ^
+Error: The type t is not a variant type
+|}]
+
+let f {x;x=y;x=z} = x
+[%%expect {|
+Line 1, characters 6-17:
+1 | let f {x;x=y;x=z} = x
+          ^^^^^^^^^^^
+Error: The record field label x is defined several times
+|}]
+
+(** Coercion failure *)
+
+let x = ([`B]:>[`A])
+[%%expect {|
+Line 3, characters 9-13:
+3 | let x = ([`B]:>[`A])
+             ^^^^
+Error: This expression cannot be coerced to type [ `A ]; it has type
+         [> `B ] list
+       but is here used with type [< `A ]
+|}]
+
+(** Unbound instance variable *)
+
+let o = object method m = instance <- 0 end
+
+[%%expect{|
+Line 3, characters 26-39:
+3 | let o = object method m = instance <- 0 end
+                              ^^^^^^^^^^^^^
+Error: Unbound instance variable instance
+|}]
+
+
+(** Hash collision *)
+let x = function
+  | `azdwbie -> ()
+  | `c7diagq -> ()
+[%%expect{|
+Line 3, characters 4-12:
+3 |   | `c7diagq -> ()
+        ^^^^^^^^
+Error: Variant tags `azdwbie and `c7diagq have the same hash value.
+       Change one of them.
+|}]
+
+
+let x =  `azdwbie = `c7diagq
+[%%expect{|
+Line 1, characters 20-28:
+1 | let x =  `azdwbie = `c7diagq
+                        ^^^^^^^^
+Error: Variant tags `azdwbie and `c7diagq have the same hash value.
+       Change one of them.
+|}]
+
+type 'a x =
+  | X: [>`azdwbie] x
+  | Y: [>`c7diagq] x
+
+let x  = function
+  | X -> ()
+  | Y  -> ()
+
+[%%expect{|
+type 'a x = X : [> `azdwbie ] x | Y : [> `c7diagq ] x
+Line 7, characters 4-5:
+7 |   | Y  -> ()
+        ^
+Error: Variant tags `azdwbie and `c7diagq have the same hash value.
+       Change one of them.
+|}]
+
+
+type t = {x:unit}
+type s = {y:unit}
+let f = function {x; y} -> x
+[%%expect {|
+type t = { x : unit; }
+type s = { y : unit; }
+Line 3, characters 21-22:
+3 | let f = function {x; y} -> x
+                         ^
+Error: The record field y belongs to the type s
+       but is mixed here with fields of type t
+|}]
+
+
+(** Error extension node *)
+
+let x = [%ocaml.error "Expression error"]
+[%%expect {|
+Line 3, characters 10-21:
+3 | let x = [%ocaml.error "Expression error"]
+              ^^^^^^^^^^^
+Error: Expression error
+|}]
+
+let f [%ocaml.error "Pattern error"] = ()
+[%%expect {|
+Line 1, characters 8-19:
+1 | let f [%ocaml.error "Pattern error"] = ()
+            ^^^^^^^^^^^
+Error: Pattern error
+|}]
diff --git a/testsuite/tests/typing-misc/typecore_nolabel_errors.ml b/testsuite/tests/typing-misc/typecore_nolabel_errors.ml
new file mode 100644
index 00000000..6a3ba99b
--- /dev/null
+++ b/testsuite/tests/typing-misc/typecore_nolabel_errors.ml
@@ -0,0 +1,136 @@
+(* TEST
+   flags="-nolabels"
+   * expect
+*)
+
+
+(** Gives an example for every [raise(Error(_,_,_)] in typing/typecore.ml
+    which both requires the "-nolabel" flags and is no covered by another test
+    in the testsuite.
+*)
+
+let check f = f ()
+
+let f ~x = ()
+let () = check f;;
+[%%expect {|
+val check : (unit -> 'a) -> 'a = 
+val f : x:'a -> unit = 
+|}]
+
+let () = f ~y:1
+[%%expect {|
+Line 1, characters 14-15:
+1 | let () = f ~y:1
+                  ^
+Error: The function applied to this argument has type x:'a -> unit
+This argument cannot be applied with label ~y
+|}]
+
+let f ?x ~a ?y ~z = ()
+let g = f ?y:None ?x:None ~a:()
+[%%expect {|
+val f : ?x:'a -> a:'b -> ?y:'c -> z:'d -> unit = 
+Line 2, characters 13-17:
+2 | let g = f ?y:None ?x:None ~a:()
+                 ^^^^
+Error: The function applied to this argument has type
+         ?x:'a -> a:'b -> ?y:'c -> z:'d -> unit
+This argument cannot be applied with label ?y
+  Since OCaml 4.11, optional arguments do not commute when -nolabels is given
+|}]
+
+let f (g: ?x:_ -> _) = g ~y:None ?x:None; g ?x:None ()
+
+[%%expect{|
+Line 1, characters 28-32:
+1 | let f (g: ?x:_ -> _) = g ~y:None ?x:None; g ?x:None ()
+                                ^^^^
+Error: The function applied to this argument has type ?x:'a -> 'b
+This argument cannot be applied with label ~y
+  Since OCaml 4.11, optional arguments do not commute when -nolabels is given
+|}]
+
+(** Show that optional arguments can be commuted, to some degree. *)
+
+let f i ?(a=0) ?(b=0) ?(c=0) ~x j =
+  i + a + b + c + x + j
+;;
+[%%expect{|
+val f : int -> ?a:int -> ?b:int -> ?c:int -> x:int -> int -> int = 
+|}]
+;;
+
+(* [a], [b] and [c] can be commuted without issues *)
+
+f 3 ~c:2 ~a:1 ~b:0 ~x:4 5;;
+[%%expect{|
+Line 1, characters 7-8:
+1 | f 3 ~c:2 ~a:1 ~b:0 ~x:4 5;;
+           ^
+Error: The function applied to this argument has type
+         ?a:int -> ?b:int -> ?c:int -> x:int -> int -> int
+This argument cannot be applied with label ~c
+  Since OCaml 4.11, optional arguments do not commute when -nolabels is given
+|}]
+;;
+
+(* Now, for all of the following, the error appears on the first non optional
+   argument, but compare the reported function types: *)
+
+f 3 ~a:1 ~b:2 5 ~c:0 ~x:4;;
+[%%expect{|
+Line 1, characters 14-15:
+1 | f 3 ~a:1 ~b:2 5 ~c:0 ~x:4;;
+                  ^
+Error: The function applied to this argument has type
+         ?c:int -> x:int -> int -> int
+This argument cannot be applied without label
+  Since OCaml 4.11, optional arguments do not commute when -nolabels is given
+|}]
+;;
+
+f 3 ~a:1 ~c:2 5 ~b:0 ~x:4;;
+[%%expect{|
+Line 1, characters 12-13:
+1 | f 3 ~a:1 ~c:2 5 ~b:0 ~x:4;;
+                ^
+Error: The function applied to this argument has type
+         ?b:int -> ?c:int -> x:int -> int -> int
+This argument cannot be applied with label ~c
+  Since OCaml 4.11, optional arguments do not commute when -nolabels is given
+|}]
+;;
+
+f 3 ~b:1 ~c:2 5 ~a:0 ~x:4;;
+[%%expect{|
+Line 1, characters 7-8:
+1 | f 3 ~b:1 ~c:2 5 ~a:0 ~x:4;;
+           ^
+Error: The function applied to this argument has type
+         ?a:int -> ?b:int -> ?c:int -> x:int -> int -> int
+This argument cannot be applied with label ~b
+  Since OCaml 4.11, optional arguments do not commute when -nolabels is given
+|}]
+;;
+
+(* Example given by Jacques when reviewing
+   https://github.com/ocaml/ocaml/pull/9411 *)
+
+let f ?x ?y () = ();;
+[%%expect{|
+val f : ?x:'a -> ?y:'b -> unit -> unit = 
+|}]
+;;
+
+f ~y:3;;
+[%%expect{|
+Line 1, characters 5-6:
+1 | f ~y:3;;
+         ^
+Error: The function applied to this argument has type
+         ?x:'a -> ?y:'b -> unit -> unit
+This argument cannot be applied with label ~y
+  Since OCaml 4.11, optional arguments do not commute when -nolabels is given
+|}]
+;;
diff --git a/testsuite/tests/typing-misc/typetexp_errors.ml b/testsuite/tests/typing-misc/typetexp_errors.ml
new file mode 100644
index 00000000..986d8585
--- /dev/null
+++ b/testsuite/tests/typing-misc/typetexp_errors.ml
@@ -0,0 +1,33 @@
+(* TEST
+   * expect
+*)
+
+type ('a,'at,'any,'en) t = A of 'an
+[%%expect {|
+Line 1, characters 32-35:
+1 | type ('a,'at,'any,'en) t = A of 'an
+                                    ^^^
+Error: The type variable 'an is unbound in this type declaration.
+Hint: Did you mean 'a, 'any, 'at or 'en?
+|}
+]
+
+type mismatched = [< `A of int | `B of float > `B `C]
+[%%expect {|
+Line 1, characters 18-53:
+1 | type mismatched = [< `A of int | `B of float > `B `C]
+                      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The constructor C is missing from the upper bound (between '<'
+       and '>') of this polymorphic variant but is present in
+       its lower bound (after '>').
+       Hint: Either add `C in the upper bound, or remove it
+       from the lower bound.
+|}]
+
+type ('_a) underscored = A of '_a
+[%%expect {|
+Line 1, characters 6-9:
+1 | type ('_a) underscored = A of '_a
+          ^^^
+Error: The type variable name '_a is not allowed in programs
+|}]
diff --git a/testsuite/tests/typing-misc/unique_names_in_unification.ml b/testsuite/tests/typing-misc/unique_names_in_unification.ml
new file mode 100644
index 00000000..ff7efe72
--- /dev/null
+++ b/testsuite/tests/typing-misc/unique_names_in_unification.ml
@@ -0,0 +1,87 @@
+(* TEST
+   * expect
+ *)
+type t = A
+let x = A
+module M = struct
+  type t = B
+  let f: t -> t = fun B -> x
+end;;
+
+[%%expect{|
+type t = A
+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/1
+       Line 4, characters 2-12:
+         Definition of type t/1
+       Line 1, characters 0-10:
+         Definition of type t/2
+|}]
+
+module M = struct type t = B end
+let y = M.B
+module N = struct
+  module M = struct
+     type t = C
+  end
+  let f : M.t -> M.t = fun M.C -> y
+end;;
+
+[%%expect{|
+module M : sig type t = B end
+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/1.t
+       Lines 4-6, characters 2-5:
+         Definition of module M/1
+       Line 1, characters 0-32:
+         Definition of module M/2
+|}]
+
+type t = D
+let f: t -> t = fun D -> x;;
+
+
+[%%expect{|
+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/1
+       Line 1, characters 0-10:
+         Definition of type t/1
+       Line 1, characters 0-10:
+         Definition of type t/2
+|}]
+
+type ttt
+type ttt = A of ttt | B of uuu
+and uuu  = C of uuu | D of ttt;;
+[%%expect{|
+type ttt
+type ttt = A of ttt | B of uuu
+and uuu = C of uuu | D of ttt
+|}]
+
+type nonrec ttt = X of ttt
+let x: ttt = let rec y = A y in y;;
+[%%expect{|
+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/1
+       Line 1, characters 0-26:
+         Definition of type ttt/1
+       Line 2, characters 0-30:
+         Definition of type ttt/2
+|}]
diff --git a/testsuite/tests/typing-misc/variance.ml b/testsuite/tests/typing-misc/variance.ml
new file mode 100644
index 00000000..8ba7530f
--- /dev/null
+++ b/testsuite/tests/typing-misc/variance.ml
@@ -0,0 +1,13 @@
+(* TEST
+   * expect
+*)
+
+(* #8698 *)
+
+(* Actually, this is not a bug *)
+type +'a t = [> `Foo of 'a -> unit] as 'a;;
+[%%expect{|
+type 'a t = 'a constraint 'a = [> `Foo of 'a -> unit ]
+|}, Principal{|
+type +'a t = 'a constraint 'a = [> `Foo of 'a -> unit ]
+|}]
diff --git a/testsuite/tests/typing-misc/variant.ml b/testsuite/tests/typing-misc/variant.ml
new file mode 100644
index 00000000..d8356cd8
--- /dev/null
+++ b/testsuite/tests/typing-misc/variant.ml
@@ -0,0 +1,149 @@
+(* TEST
+   * expect
+*)
+
+(* PR#6394 *)
+
+module rec X : sig
+ type t = int * bool
+end = struct
+ type t = A | B
+ let f = function A | B -> 0
+end;;
+[%%expect{|
+Lines 3-6, characters 6-3:
+3 | ......struct
+4 |  type t = A | B
+5 |  let f = function A | B -> 0
+6 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = X.t = A | B val f : t -> int end
+       is not included in
+         sig type t = int * bool end
+       Type declarations do not match:
+         type t = X.t = A | B
+       is not included in
+         type t = int * bool
+|}];;
+
+
+(* PR#7838 *)
+
+module Make (X : sig val f : [ `A ] -> unit end) = struct
+ let make f1 f2 arg = match arg with `A -> f1 arg; f2 arg
+ let f = make X.f (fun _ -> ())
+end;;
+[%%expect{|
+module Make :
+  functor (X : sig val f : [ `A ] -> unit end) ->
+    sig
+      val make : (([< `A ] as 'a) -> 'b) -> ('a -> 'c) -> 'a -> 'c
+      val f : [ `A ] -> unit
+    end
+|}]
+
+
+(* reexport *)
+type ('a,'b) def = X of int constraint 'b = [> `A]
+
+type arity = (int, [`A]) def = X of int;;
+[%%expect{|
+type ('a, 'b) def = X of int constraint 'b = [> `A ]
+Line 3, characters 0-39:
+3 | type arity = (int, [`A]) def = X of int;;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type
+         (int, [ `A ]) def
+       They have different arities.
+|}]
+
+type ('a,'b) ct = (int,'b) def = X of int;;
+[%%expect{|
+Line 1, characters 0-41:
+1 | type ('a,'b) ct = (int,'b) def = X of int;;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type
+         (int, [> `A ]) def
+       Their constraints differ.
+|}]
+
+type ('a,'b) kind = ('a, 'b) def = {a:int} constraint 'b = [> `A];;
+[%%expect{|
+Line 1, characters 0-65:
+1 | type ('a,'b) kind = ('a, 'b) def = {a:int} constraint 'b = [> `A];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type
+         ('a, [> `A ]) def
+       Their kinds differ.
+|}]
+
+type d = X of int | Y of int
+
+type missing = d = X of int
+[%%expect{|
+type d = X of int | Y of int
+Line 3, characters 0-27:
+3 | type missing = d = X of int
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type d
+       The constructor Y is only present in the original definition.
+|}]
+
+type wrong_type = d = X of float
+[%%expect{|
+Line 1, characters 0-32:
+1 | type wrong_type = d = X of float
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type d
+       Constructors do not match:
+         X of int
+       is not compatible with:
+         X of float
+       The types are not equal.
+|}]
+
+type unboxed = d = X of float [@@unboxed]
+[%%expect{|
+Line 1, characters 0-41:
+1 | type unboxed = d = X of float [@@unboxed]
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type d
+       Their internal representations differ:
+       this definition uses unboxed representation.
+|}]
+
+type perm = d = Y of int | X of int
+[%%expect{|
+Line 1, characters 0-35:
+1 | type perm = d = Y of int | X of int
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type d
+       Constructors number 1 have different names, X and Y.
+|}]
+
+module M : sig
+  type t = Foo of int
+end = struct
+  type t = Foo : int -> t
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = Foo : int -> t
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = Foo : int -> t end
+       is not included in
+         sig type t = Foo of int end
+       Type declarations do not match:
+         type t = Foo : int -> t
+       is not included in
+         type t = Foo of int
+       Constructors do not match:
+         Foo : int -> t
+       is not compatible with:
+         Foo of int
+       The first has explicit return type and the second doesn't.
+|}]
diff --git a/testsuite/tests/typing-misc/wellfounded.ml b/testsuite/tests/typing-misc/wellfounded.ml
new file mode 100644
index 00000000..f6043128
--- /dev/null
+++ b/testsuite/tests/typing-misc/wellfounded.ml
@@ -0,0 +1,22 @@
+(* TEST
+   * expect
+*)
+
+(* PR#6768 *)
+
+type _ prod = Prod : ('a * 'y) prod;;
+
+let f : type t. t prod -> _ = function Prod ->
+  let module M =
+    struct
+      type d = d * d
+    end
+  in ()
+;;
+[%%expect{|
+type _ prod = Prod : ('a * 'y) prod
+Line 6, characters 6-20:
+6 |       type d = d * d
+          ^^^^^^^^^^^^^^
+Error: The type abbreviation d is cyclic
+|}];;
diff --git a/testsuite/tests/typing-missing-cmi-2/bar.mli b/testsuite/tests/typing-missing-cmi-2/bar.mli
new file mode 100644
index 00000000..752ac028
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi-2/bar.mli
@@ -0,0 +1 @@
+val foo : unit -> 'a Foo.t
diff --git a/testsuite/tests/typing-missing-cmi-2/baz.ml b/testsuite/tests/typing-missing-cmi-2/baz.ml
new file mode 100644
index 00000000..2dd4482a
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi-2/baz.ml
@@ -0,0 +1 @@
+let x = Bar.foo ()
diff --git a/testsuite/tests/typing-missing-cmi-2/foo.mli b/testsuite/tests/typing-missing-cmi-2/foo.mli
new file mode 100644
index 00000000..cbc4635f
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi-2/foo.mli
@@ -0,0 +1 @@
+type 'a t
diff --git a/testsuite/tests/typing-missing-cmi-2/test.compilers.reference b/testsuite/tests/typing-missing-cmi-2/test.compilers.reference
new file mode 100644
index 00000000..0927ee4b
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi-2/test.compilers.reference
@@ -0,0 +1 @@
+val x : '_weak1 Foo.t
diff --git a/testsuite/tests/typing-missing-cmi-2/test.ml b/testsuite/tests/typing-missing-cmi-2/test.ml
new file mode 100644
index 00000000..2ef1c6d3
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi-2/test.ml
@@ -0,0 +1,15 @@
+(* TEST
+files = "foo.mli bar.mli baz.ml"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+module = "foo.mli"
+*** ocamlc.byte
+module = "bar.mli"
+**** script
+script = "rm foo.cmi"
+***** ocamlc.byte
+flags = "-c -i"
+module = "baz.ml"
+ocamlc_byte_exit_status = "0"
+****** check-ocamlc.byte-output
+*)
diff --git a/testsuite/tests/typing-missing-cmi-3/middle.ml b/testsuite/tests/typing-missing-cmi-3/middle.ml
new file mode 100644
index 00000000..cc4b1322
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi-3/middle.ml
@@ -0,0 +1,5 @@
+type 'a t = 'a Original.t = T
+
+let f: (module Original.T with type t = int) -> unit = fun _ -> ()
+let x = (module struct type t end: Original.T )
+let g: (module Original.T) -> unit = fun _ -> ()
diff --git a/testsuite/tests/typing-missing-cmi-3/original.ml b/testsuite/tests/typing-missing-cmi-3/original.ml
new file mode 100644
index 00000000..04c6c5e9
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi-3/original.ml
@@ -0,0 +1,2 @@
+type 'a t = T
+module type T = sig type t end
diff --git a/testsuite/tests/typing-missing-cmi-3/user.ml b/testsuite/tests/typing-missing-cmi-3/user.ml
new file mode 100644
index 00000000..aacd19f7
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi-3/user.ml
@@ -0,0 +1,47 @@
+(* TEST
+
+files = "original.ml middle.ml"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+module = "original.ml"
+*** ocamlc.byte
+module = "middle.ml"
+**** script
+script = "rm -f original.cmi"
+***** expect
+*)
+
+
+#directory "ocamlc.byte";;
+#load "middle.cmo"
+
+let x:'a. 'a Middle.t =
+  let _r = ref 0 in
+  Middle.T
+[%%expect {|
+val x : 'a Middle.t = Middle.T
+|}]
+
+
+let () = Middle.(g x)
+[%%expect {|
+|}]
+
+let () = Middle.(f x)
+[%%expect {|
+Line 1, characters 19-20:
+1 | let () = Middle.(f x)
+                       ^
+Error: This expression has type (module Original.T)
+       but an expression was expected of type
+         (module Original.T with type t = int)
+|}]
+
+let () = Middle.f (module struct end)
+[%%expect {|
+Line 1, characters 26-36:
+1 | let () = Middle.f (module struct end)
+                              ^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match: sig end is not included in Original.T
+|}]
diff --git a/testsuite/tests/typing-missing-cmi/a.ml b/testsuite/tests/typing-missing-cmi/a.ml
new file mode 100644
index 00000000..0631d439
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi/a.ml
@@ -0,0 +1 @@
+let (a : M.a) = 2
diff --git a/testsuite/tests/typing-missing-cmi/b.ml b/testsuite/tests/typing-missing-cmi/b.ml
new file mode 100644
index 00000000..eb1e004a
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi/b.ml
@@ -0,0 +1 @@
+let (b : M.b) = 2
diff --git a/testsuite/tests/typing-missing-cmi/c.ml b/testsuite/tests/typing-missing-cmi/c.ml
new file mode 100644
index 00000000..35a6ce59
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi/c.ml
@@ -0,0 +1,10 @@
+(* GPR#816 *)
+(* This PR means that Foo(Bar).t is known to be equal to Foo(Baz).t
+   when Bar is an alias for Baz, even when the definition for Foo is unknown.
+   This can happen when .cmi files depend on other .cmi files not in the path
+   -- a situation that is partially supported. *)
+
+module A = M
+
+type t1 = M.Foo(M).t
+type t2 = A.Foo(A).t
diff --git a/testsuite/tests/typing-missing-cmi/main.ml b/testsuite/tests/typing-missing-cmi/main.ml
new file mode 100644
index 00000000..1bf8c991
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi/main.ml
@@ -0,0 +1 @@
+let _ = A.a = B.b
diff --git a/testsuite/tests/typing-missing-cmi/main.ml.reference b/testsuite/tests/typing-missing-cmi/main.ml.reference
new file mode 100644
index 00000000..dfcfd020
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi/main.ml.reference
@@ -0,0 +1,5 @@
+File "main.ml", line 1, characters 14-17:
+Error: This expression has type M.b but an expression was expected of type
+         M.a
+M.b is abstract because no corresponding cmi file was found in path.
+M.a is abstract because no corresponding cmi file was found in path.
diff --git a/testsuite/tests/typing-missing-cmi/main_ok.ml b/testsuite/tests/typing-missing-cmi/main_ok.ml
new file mode 100644
index 00000000..e6907190
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi/main_ok.ml
@@ -0,0 +1 @@
+let f (x : C.t1) = (x : C.t2)
diff --git a/testsuite/tests/typing-missing-cmi/subdir/m.ml b/testsuite/tests/typing-missing-cmi/subdir/m.ml
new file mode 100644
index 00000000..c939a6a6
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi/subdir/m.ml
@@ -0,0 +1,4 @@
+type a = int
+type b = a
+
+module Foo(X : sig end) = struct type t = T end
diff --git a/testsuite/tests/typing-missing-cmi/test.compilers.reference b/testsuite/tests/typing-missing-cmi/test.compilers.reference
new file mode 100644
index 00000000..92bfbe7e
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi/test.compilers.reference
@@ -0,0 +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
+       M.b is abstract because no corresponding cmi file was found in path.
+       M.a is abstract because no corresponding cmi file was found in path.
diff --git a/testsuite/tests/typing-missing-cmi/test.ml b/testsuite/tests/typing-missing-cmi/test.ml
new file mode 100644
index 00000000..087374e0
--- /dev/null
+++ b/testsuite/tests/typing-missing-cmi/test.ml
@@ -0,0 +1,24 @@
+(* TEST
+files = "a.ml b.ml c.ml main.ml main_ok.ml"
+* setup-ocamlc.byte-build-env
+** script
+script = "mkdir -p subdir"
+*** script
+script = "cp ${test_source_directory}/subdir/m.ml subdir"
+**** ocamlc.byte
+module = "subdir/m.ml"
+***** ocamlc.byte
+flags = "-I subdir"
+module = "a.ml"
+****** ocamlc.byte
+module = "b.ml"
+******* ocamlc.byte
+module = "c.ml"
+******** ocamlc.byte
+flags = ""
+module = "main_ok.ml"
+********* ocamlc.byte
+module = "main.ml"
+ocamlc_byte_exit_status = "2"
+********** check-ocamlc.byte-output
+*)
diff --git a/testsuite/tests/typing-modules-bugs/gatien_baron_20131019_ok.ml b/testsuite/tests/typing-modules-bugs/gatien_baron_20131019_ok.ml
new file mode 100644
index 00000000..1241d53c
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/gatien_baron_20131019_ok.ml
@@ -0,0 +1,38 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module Std = struct module Hash = Hashtbl end;;
+
+open Std;;
+module Hash1 : module type of Hash = Hash;;
+module Hash2 : sig include (module type of Hash) end = Hash;;
+let f1 (x : (_,_) Hash1.t) = (x : (_,_) Hashtbl.t);;
+let f2 (x : (_,_) Hash2.t) = (x : (_,_) Hashtbl.t);;
+
+(* Another case, not using include *)
+
+module Std2 = struct module M = struct type t end end;;
+module Std' = Std2;;
+module M' : module type of Std'.M = Std2.M;;
+let f3 (x : M'.t) = (x : Std2.M.t);;
+
+(* original report required Core_kernel:
+module type S = sig
+open Core_kernel.Std
+
+module Hashtbl1 : module type of Hashtbl
+module Hashtbl2 : sig
+  include (module type of Hashtbl)
+end
+
+module Coverage : Core_kernel.Std.Hashable
+
+type types = unit constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl1.t
+type doesnt_type = unit
+  constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl2.t
+end
+*)
diff --git a/testsuite/tests/typing-modules-bugs/pr5164_ok.ml b/testsuite/tests/typing-modules-bugs/pr5164_ok.ml
new file mode 100644
index 00000000..4837aac5
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr5164_ok.ml
@@ -0,0 +1,16 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type INCLUDING = sig
+  include module type of List
+  include module type of ListLabels
+end
+
+module Including_typed: INCLUDING = struct
+  include List
+  include ListLabels
+end
diff --git a/testsuite/tests/typing-modules-bugs/pr51_ok.ml b/testsuite/tests/typing-modules-bugs/pr51_ok.ml
new file mode 100644
index 00000000..14c517fb
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr51_ok.ml
@@ -0,0 +1,25 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module X=struct
+  module type SIG=sig type t=int val x:t end
+  module F(Y:SIG) : SIG = struct type t=Y.t let x=Y.x end
+end;;
+module DUMMY=struct type t=int let x=2 end;;
+let x = (3 : X.F(DUMMY).t);;
+
+module X2=struct
+  module type SIG=sig type t=int val x:t end
+  module F(Y:SIG)(Z:SIG) = struct
+    type t=Y.t
+    let x=Y.x
+    type t'=Z.t
+    let x'=Z.x
+  end
+end;;
+let x = (3 : X2.F(DUMMY)(DUMMY).t);;
+let x = (3 : X2.F(DUMMY)(DUMMY).t');;
diff --git a/testsuite/tests/typing-modules-bugs/pr5663_ok.ml b/testsuite/tests/typing-modules-bugs/pr5663_ok.ml
new file mode 100644
index 00000000..813c7de0
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr5663_ok.ml
@@ -0,0 +1,14 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module F (M : sig
+    type 'a t
+    type 'a u = string
+    val f : unit -> _ u t
+  end) = struct
+    let t = M.f ()
+  end
diff --git a/testsuite/tests/typing-modules-bugs/pr5914_ok.ml b/testsuite/tests/typing-modules-bugs/pr5914_ok.ml
new file mode 100644
index 00000000..e5e7e8b9
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr5914_ok.ml
@@ -0,0 +1,25 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+type 't a = [ `A ]
+type 't wrap = 't constraint 't = [> 't wrap a ]
+type t = t a wrap
+
+module T = struct
+  let foo : 't wrap -> 't wrap -> unit = fun _ _ -> ()
+  let bar : ('a a wrap as 'a) = `A
+end
+
+module Good : sig
+  val bar: t
+  val foo: t -> t -> unit
+end = T
+
+module Bad : sig
+  val foo: t -> t -> unit
+  val bar: t
+end = T
diff --git a/testsuite/tests/typing-modules-bugs/pr6240_ok.ml b/testsuite/tests/typing-modules-bugs/pr6240_ok.ml
new file mode 100644
index 00000000..fa166aa3
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6240_ok.ml
@@ -0,0 +1,18 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module M : sig
+  module type T
+  module F (X : T) : sig end
+end = struct
+  module type T = sig end
+  module F (X : T) = struct end
+end
+
+module type T = M.T
+
+module F : functor (X : T) -> sig end = M.F
diff --git a/testsuite/tests/typing-modules-bugs/pr6293_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr6293_bad.compilers.reference
new file mode 100644
index 00000000..de6d9079
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6293_bad.compilers.reference
@@ -0,0 +1,12 @@
+File "pr6293_bad.ml", line 10, characters 18-37:
+10 | let f (module M : S with type t = int) = { M.a = 0 };;
+                       ^^^^^^^^^^^^^^^^^^^
+Error: In this `with' constraint, the new definition of t
+       does not match its original definition in the constrained signature:
+       Type declarations do not match:
+         type t
+       is not included in
+         type t = { a : int; b : int; }
+       Their kinds differ.
+       File "pr6293_bad.ml", line 9, characters 20-50: Expected declaration
+       File "pr6293_bad.ml", line 10, characters 18-37: Actual declaration
diff --git a/testsuite/tests/typing-modules-bugs/pr6293_bad.ml b/testsuite/tests/typing-modules-bugs/pr6293_bad.ml
new file mode 100644
index 00000000..d216e2db
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6293_bad.ml
@@ -0,0 +1,10 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type S = sig type t = { a : int; b : int; } end;;
+let f (module M : S with type t = int) = { M.a = 0 };;
diff --git a/testsuite/tests/typing-modules-bugs/pr6427_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr6427_bad.compilers.reference
new file mode 100644
index 00000000..8dd13d5a
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6427_bad.compilers.reference
@@ -0,0 +1,5 @@
+File "pr6427_bad.ml", line 12, characters 13-65:
+12 |   module X = (val if !flag then (module A) else (module B) : S.T)
+                  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This expression creates fresh types.
+       It is not allowed inside applicative functors.
diff --git a/testsuite/tests/typing-modules-bugs/pr6427_bad.ml b/testsuite/tests/typing-modules-bugs/pr6427_bad.ml
new file mode 100644
index 00000000..d05baaf0
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6427_bad.ml
@@ -0,0 +1,28 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+let flag = ref false
+module F(S : sig module type T end) (A : S.T) (B : S.T) =
+struct
+  module X = (val if !flag then (module A) else (module B) : S.T)
+end
+
+(* If the above were accepted, one could break soundness *)
+module type S = sig type t val x : t end
+module Float = struct type t = float let x = 0.0 end
+module Int = struct type t = int let x = 0 end
+
+module M = F(struct module type T = S end)
+
+let () = flag := false
+module M1 = M(Float)(Int)
+
+let () = flag := true
+module M2 = M(Float)(Int)
+
+let _ = [| M2.X.x; M1.X.x |]
diff --git a/testsuite/tests/typing-modules-bugs/pr6485_ok.ml b/testsuite/tests/typing-modules-bugs/pr6485_ok.ml
new file mode 100644
index 00000000..641a3552
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6485_ok.ml
@@ -0,0 +1,53 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(** Check that rebinding module preserves private type aliases *)
+
+module String_id : sig
+  module type S = sig
+    type t = private string
+    val of_string : string -> t
+  end
+
+  include S
+
+  module Make (M : sig val module_name : string end) : S
+end = struct
+  module type S = sig
+    type t = private string
+    val of_string : string -> t
+  end
+
+  module String = struct
+    type t = string
+  end
+
+  module Make (M : sig val module_name : string end) = struct
+    include String
+
+    let of_string s =
+      Printf.printf "converting %s\n" M.module_name;
+      s
+  end
+
+  include Make (struct let module_name = "String_id" end)
+end
+
+let () =
+  let foo = String_id.of_string "foo" in
+  Printf.printf "foo = %s\n" (foo :> string)
+
+let () =
+  let module Bar = String_id.Make(struct let module_name="Bar" end) in
+  let bar = Bar.of_string "bar" in
+  Printf.printf "bar = %s\n" (bar :> string)
+
+let () =
+  let module String_id2 = String_id in
+  let module Baz = String_id2.Make(struct let module_name="Baz" end) in
+  let baz = Baz.of_string "baz" in
+  Printf.printf "baz = %s\n" (baz :> string)
diff --git a/testsuite/tests/typing-modules-bugs/pr6513_ok.ml b/testsuite/tests/typing-modules-bugs/pr6513_ok.ml
new file mode 100644
index 00000000..5e3a8f06
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6513_ok.ml
@@ -0,0 +1,35 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type PR6513 = sig
+module type S = sig type u end
+
+module type T = sig
+  type 'a wrap
+  type uri
+end
+
+module Make: functor (Html5 : T with type 'a wrap = 'a) ->
+  S with type u = < foo : Html5.uri >
+end
+
+(* Requires -package tyxml
+module type PR6513_orig = sig
+module type S =
+sig
+        type t
+        type u
+end
+
+module Make: functor (Html5: Html5_sigs.T
+                             with type 'a Xml.wrap = 'a and
+                             type 'a wrap = 'a and
+                             type 'a list_wrap = 'a list)
+                     -> S with type t = Html5_types.div Html5.elt and
+                               type u = < foo: Html5.uri >
+end
+*)
diff --git a/testsuite/tests/typing-modules-bugs/pr6572_ok.ml b/testsuite/tests/typing-modules-bugs/pr6572_ok.ml
new file mode 100644
index 00000000..94cd21c5
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6572_ok.ml
@@ -0,0 +1,26 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type S = sig
+  include Set.S
+  module E : sig val x : int end
+end
+
+module Make(O : Set.OrderedType) : S with type elt = O.t =
+  struct
+    include Set.Make(O)
+    module E = struct let x = 1 end
+  end
+
+module rec A : Set.OrderedType = struct
+ type t = int
+  let compare = Stdlib.compare
+end
+and B : S = struct
+ module C = Make(A)
+ include C
+end
diff --git a/testsuite/tests/typing-modules-bugs/pr6651_ok.ml b/testsuite/tests/typing-modules-bugs/pr6651_ok.ml
new file mode 100644
index 00000000..c3adc8ca
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6651_ok.ml
@@ -0,0 +1,20 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type S = sig
+  module type T
+  module X : T
+end
+
+module F (X : S) = X.X
+
+module M = struct
+  module type T = sig type t end
+  module X = struct type t = int end
+end
+
+type t = F(M).t
diff --git a/testsuite/tests/typing-modules-bugs/pr6752_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr6752_bad.compilers.reference
new file mode 100644
index 00000000..c14ca406
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6752_bad.compilers.reference
@@ -0,0 +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
+       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/pr6752_bad.ml b/testsuite/tests/typing-modules-bugs/pr6752_bad.ml
new file mode 100644
index 00000000..9ee4b12d
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6752_bad.ml
@@ -0,0 +1,54 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* Sorry, we have to disable this as this requires accepting
+   potentially badly formed programs (after expliciting) *)
+
+module Common0 =
+ struct
+   type msg = Msg
+
+   let handle_msg = ref (function _ -> failwith "Unable to handle message")
+   let extend_handle f =
+   let old = !handle_msg in
+   handle_msg := f old
+
+   let q : _ Queue.t = Queue.create ()
+   let add msg = Queue.add msg q
+   let handle_queue_messages () = Queue.iter !handle_msg q
+ end
+
+let q' : Common0.msg Queue.t = Common0.q
+
+module Common =
+ struct
+   type msg = ..
+
+   let handle_msg = ref (function _ -> failwith "Unable to handle message")
+   let extend_handle f =
+   let old = !handle_msg in
+   handle_msg := f old
+
+   let q : _ Queue.t = Queue.create ()
+   let add msg = Queue.add msg q
+   let handle_queue_messages () = Queue.iter !handle_msg q
+ end
+
+module M1 =
+ struct
+   type Common.msg += Reload of string | Alert of string
+
+   let handle fallback = function
+     Reload s -> print_endline ("Reload "^s)
+   | Alert s -> print_endline ("Alert "^s)
+   | x -> fallback x
+
+   let () = Common.extend_handle handle
+   let () = Common.add (Reload "config.file")
+   let () = Common.add (Alert "Initialisation done")
+ end
diff --git a/testsuite/tests/typing-modules-bugs/pr6752_ok.ml b/testsuite/tests/typing-modules-bugs/pr6752_ok.ml
new file mode 100644
index 00000000..d3b0fdcd
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6752_ok.ml
@@ -0,0 +1,52 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* Adding a type annotation is sufficient to make typing go through *)
+
+module Common0 =
+ struct
+   type msg = Msg
+
+   let handle_msg = ref (function _ -> failwith "Unable to handle message")
+   let extend_handle f =
+   let old = !handle_msg in
+   handle_msg := f old
+
+   let q : msg Queue.t = Queue.create ()
+   let add msg = Queue.add msg q
+   let handle_queue_messages () = Queue.iter !handle_msg q
+ end
+
+let q' : Common0.msg Queue.t = Common0.q
+
+module Common =
+ struct
+   type msg = ..
+
+   let handle_msg = ref (function _ -> failwith "Unable to handle message")
+   let extend_handle f =
+   let old = !handle_msg in
+   handle_msg := f old
+
+   let q : msg Queue.t = Queue.create ()
+   let add msg = Queue.add msg q
+   let handle_queue_messages () = Queue.iter !handle_msg q
+ end
+
+module M1 =
+ struct
+   type Common.msg += Reload of string | Alert of string
+
+   let handle fallback = function
+     Reload s -> print_endline ("Reload "^s)
+   | Alert s -> print_endline ("Alert "^s)
+   | x -> fallback x
+
+   let () = Common.extend_handle handle
+   let () = Common.add (Reload "config.file")
+   let () = Common.add (Alert "Initialisation done")
+ end
diff --git a/testsuite/tests/typing-modules-bugs/pr6899_first_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr6899_first_bad.compilers.reference
new file mode 100644
index 00000000..82c11aa3
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6899_first_bad.compilers.reference
@@ -0,0 +1,5 @@
+File "pr6899_first_bad.ml", line 9, characters 4-17:
+9 | let should_reject =
+        ^^^^^^^^^^^^^
+Error: The type of this expression, '_weak1 -> '_weak2 -> unit,
+       contains type variables that cannot be generalized
diff --git a/testsuite/tests/typing-modules-bugs/pr6899_first_bad.ml b/testsuite/tests/typing-modules-bugs/pr6899_first_bad.ml
new file mode 100644
index 00000000..82b9ca12
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6899_first_bad.ml
@@ -0,0 +1,11 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+let should_reject =
+  let table = Hashtbl.create 1 in
+  fun x y -> Hashtbl.add table x y
diff --git a/testsuite/tests/typing-modules-bugs/pr6899_ok.ml b/testsuite/tests/typing-modules-bugs/pr6899_ok.ml
new file mode 100644
index 00000000..38d91053
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6899_ok.ml
@@ -0,0 +1,13 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+type 'a t = 'a option
+let is_some = function
+  | None -> false
+  | Some _ -> true
+
+let should_accept ?x () = is_some x
diff --git a/testsuite/tests/typing-modules-bugs/pr6899_second_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr6899_second_bad.compilers.reference
new file mode 100644
index 00000000..66950a17
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6899_second_bad.compilers.reference
@@ -0,0 +1,5 @@
+File "pr6899_second_bad.ml", line 12, characters 6-9:
+12 |   let bar = wrap ()
+           ^^^
+Error: The type of this expression, _[< `Test ] -> unit,
+       contains type variables that cannot be generalized
diff --git a/testsuite/tests/typing-modules-bugs/pr6899_second_bad.ml b/testsuite/tests/typing-modules-bugs/pr6899_second_bad.ml
new file mode 100644
index 00000000..4a563527
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6899_second_bad.ml
@@ -0,0 +1,13 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+include struct
+  let foo `Test = ()
+  let wrap f `Test = f
+  let bar = wrap ()
+end
diff --git a/testsuite/tests/typing-modules-bugs/pr6944_ok.ml b/testsuite/tests/typing-modules-bugs/pr6944_ok.ml
new file mode 100644
index 00000000..88c325a9
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6944_ok.ml
@@ -0,0 +1,11 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+let f () =
+   let module S = String in
+   let module N = Map.Make(S) in
+   N.add "sum" 41 N.empty;;
diff --git a/testsuite/tests/typing-modules-bugs/pr6954_ok.ml b/testsuite/tests/typing-modules-bugs/pr6954_ok.ml
new file mode 100644
index 00000000..e72c47e2
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6954_ok.ml
@@ -0,0 +1,18 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module X = struct module Y = struct module type S = sig type t end end end
+
+(* open X  (* works! *) *)
+module Y = X.Y
+
+type 'a arg_t = 'at constraint 'a = (module Y.S with type t = 'at)
+type t = (module X.Y.S with type t = unit)
+
+let f (x : t arg_t) = ()
+
+let () = f ()
diff --git a/testsuite/tests/typing-modules-bugs/pr6981_ok.ml b/testsuite/tests/typing-modules-bugs/pr6981_ok.ml
new file mode 100644
index 00000000..0cc39261
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6981_ok.ml
@@ -0,0 +1,17 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type S =
+sig
+  type a
+  type b
+end
+module Foo
+    (Bar : S with type a = private [> `A])
+    (Baz : S with type b = private < b : Bar.b ; .. >) =
+struct
+end
diff --git a/testsuite/tests/typing-modules-bugs/pr6982_ok.ml b/testsuite/tests/typing-modules-bugs/pr6982_ok.ml
new file mode 100644
index 00000000..d3181a0a
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6982_ok.ml
@@ -0,0 +1,33 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module A = struct
+ module type A_S = sig
+ end
+
+ type t = (module A_S)
+end
+
+module type S = sig type t end
+
+let f (type a) (module X : S with type t = a) = ()
+
+let _ = f (module A) (* ok *)
+
+module A_annotated_alias : S with type t = (module A.A_S) = A
+
+let _ = f (module A_annotated_alias) (* ok *)
+let _ = f (module A_annotated_alias : S with type t = (module A.A_S)) (* ok *)
+
+module A_alias = A
+module A_alias_expanded = struct include A_alias end
+
+let _ = f (module A_alias_expanded : S with type t = (module A.A_S)) (* ok *)
+let _ = f (module A_alias_expanded) (* ok *)
+
+let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type *)
+let _ = f (module A_alias) (* doesn't type either *)
diff --git a/testsuite/tests/typing-modules-bugs/pr6985_ok.ml b/testsuite/tests/typing-modules-bugs/pr6985_ok.ml
new file mode 100644
index 00000000..20ed0a6b
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6985_ok.ml
@@ -0,0 +1,14 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module Foo
+ (Bar : sig type a = private [> `A ] end)
+ (Baz : module type of struct include Bar end) =
+struct
+end
+module Bazoinks = struct type a = [ `A ] end
+module Bug = Foo(Bazoinks)(Bazoinks)
diff --git a/testsuite/tests/typing-modules-bugs/pr6992_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr6992_bad.compilers.reference
new file mode 100644
index 00000000..0054f28d
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6992_bad.compilers.reference
@@ -0,0 +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
+       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/pr6992_bad.ml b/testsuite/tests/typing-modules-bugs/pr6992_bad.ml
new file mode 100644
index 00000000..21fea7f7
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6992_bad.ml
@@ -0,0 +1,23 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* PR#6992, reported by Stephen Dolan *)
+
+type (_, _) eq = Eq : ('a, 'a) eq
+let cast : type a b . (a, b) eq -> a -> b = fun Eq x -> x
+
+module Fix (F : sig type 'a f end) = struct
+  type 'a fix = ('a, 'a F.f) eq
+  let uniq (type a) (type b) (Eq : a fix) (Eq : b fix) : (a, b) eq = Eq
+end
+
+(* This would allow:
+module FixId = Fix (struct type 'a f = 'a end)
+ let bad : (int, string) eq = FixId.uniq Eq Eq
+ let _ = Printf.printf "Oh dear: %s" (cast bad 42)
+*)
diff --git a/testsuite/tests/typing-modules-bugs/pr7036_ok.ml b/testsuite/tests/typing-modules-bugs/pr7036_ok.ml
new file mode 100644
index 00000000..011cc1b1
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7036_ok.ml
@@ -0,0 +1,28 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module M = struct
+ module type S = sig type a val v : a end
+ type 'a s = (module S with type a = 'a)
+end
+
+module B = struct
+ class type a = object method a : 'a. 'a M.s -> 'a end
+end
+
+module M' = M
+module B' = B
+
+class b : B.a = object
+ method a : 'a. 'a M.s -> 'a = fun (type a) ((module X) : (module M.S with type
+a = a)) -> X.v
+end
+
+class b' : B.a = object
+ method a : 'a. 'a M'.s -> 'a = fun (type a) ((module X) : (module M'.S with
+type a = a)) -> X.v
+end
diff --git a/testsuite/tests/typing-modules-bugs/pr7082_ok.ml b/testsuite/tests/typing-modules-bugs/pr7082_ok.ml
new file mode 100644
index 00000000..b73052e3
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7082_ok.ml
@@ -0,0 +1,14 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type FOO = sig type t end
+module type BAR =
+sig
+  (* Works: module rec A : (sig include FOO with type t = < b:B.t > end) *)
+  module rec A : (FOO with type t = < b:B.t >)
+         and B : FOO
+end
diff --git a/testsuite/tests/typing-modules-bugs/pr7112_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr7112_bad.compilers.reference
new file mode 100644
index 00000000..7d1ade32
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7112_bad.compilers.reference
@@ -0,0 +1,5 @@
+File "pr7112_bad.ml", line 13, characters 30-31:
+13 | module G (X : F(N).S) : A.S = X
+                                   ^
+Error: Signature mismatch:
+       Modules do not match: F(N).S is not included in A.S
diff --git a/testsuite/tests/typing-modules-bugs/pr7112_bad.ml b/testsuite/tests/typing-modules-bugs/pr7112_bad.ml
new file mode 100644
index 00000000..e67e0279
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7112_bad.ml
@@ -0,0 +1,13 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module A = struct module type S module S = struct end end
+module F (_ : sig end) = struct module type S module S = A.S end
+module M = struct end
+module N = M
+module G (X : F(N).S) : A.S = X
diff --git a/testsuite/tests/typing-modules-bugs/pr7112_ok.ml b/testsuite/tests/typing-modules-bugs/pr7112_ok.ml
new file mode 100644
index 00000000..949d4ab5
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7112_ok.ml
@@ -0,0 +1,11 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module F (_ : sig end) = struct module type S end
+module M = struct end
+module N = M
+module G (X : F(N).S) : F(M).S = X
diff --git a/testsuite/tests/typing-modules-bugs/pr7152_ok.ml b/testsuite/tests/typing-modules-bugs/pr7152_ok.ml
new file mode 100644
index 00000000..2e70dabf
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7152_ok.ml
@@ -0,0 +1,122 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module M :  sig
+  type make_dec
+  val add_dec: make_dec -> unit
+end = struct
+  type u
+
+  module Fast: sig
+    type 'd t
+    val create: unit -> 'd t
+    module type S = sig
+      module Data: sig type t end
+      val key: Data.t t
+    end
+    module Register (D:S): sig end
+    val attach: 'd t -> 'd -> unit
+  end = struct
+    type 'd t = unit
+    let create () = ()
+    module type S = sig
+      module Data: sig type t end
+      val key: Data.t t
+    end
+    module Register (D:S) = struct end
+    let attach _ _ = ()
+  end
+
+  type make_dec
+
+  module Dem = struct
+    module Data = struct
+      type t = make_dec
+    end
+    let key = Fast.create ()
+  end
+
+  let _ = Dem.key (* force to evaluation the lazy substitution *)
+
+  module EDem = Fast.Register(Dem)
+
+  let add_dec dec =
+    Fast.attach Dem.key dec
+end
+
+(* variant without using a Data module *)
+
+module M' :  sig
+  type make_dec
+  val add_dec: make_dec -> unit
+end = struct
+  type u
+
+  module Fast: sig
+    type 'd t
+    val create: unit -> 'd t
+    module type S = sig
+      type data
+      val key: data t
+    end
+    module Register (D:S): sig end
+    val attach: 'd t -> 'd -> unit
+  end = struct
+    type 'd t = unit
+    let create () = ()
+    module type S = sig
+      type data
+      val key: data t
+    end
+    module Register (D:S) = struct end
+    let attach _ _ = ()
+  end
+
+  type make_dec
+
+  module Dem = struct
+    type data = make_dec
+    let key = Fast.create ()
+  end
+
+  module EDem = Fast.Register(Dem)
+
+  let add_dec dec =
+    Fast.attach Dem.key dec
+end
+
+(* simpler version *)
+
+module Simple = struct
+  type 'a t
+  module type S = sig
+    module Data: sig type t end
+    val key: Data.t t
+  end
+  module Register (D:S) = struct let key = D.key end
+  module M = struct
+    module Data = struct type t = int end
+    let key : _ t = Obj.magic ()
+  end
+end;;
+module EM = Simple.Register(Simple.M);;
+Simple.M.key;;
+
+module Simple2 = struct
+  type 'a t
+  module type S = sig
+    module Data: sig type t end
+    val key: Data.t t
+  end
+  module M = struct
+    module Data = struct type t = int end
+    let key : _ t = Obj.magic ()
+  end
+  module Register (D:S) = struct let key = D.key end
+  module EM = Simple.Register(Simple.M)
+  let k : M.Data.t t = M.key
+end;;
diff --git a/testsuite/tests/typing-modules-bugs/pr7182_ok.ml b/testsuite/tests/typing-modules-bugs/pr7182_ok.ml
new file mode 100644
index 00000000..c32d1d11
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7182_ok.ml
@@ -0,0 +1,10 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module rec M
+    : sig external f : int -> int = "%identity" end
+    = struct external f : int -> int = "%identity" end
diff --git a/testsuite/tests/typing-modules-bugs/pr7305_principal.ml b/testsuite/tests/typing-modules-bugs/pr7305_principal.ml
new file mode 100644
index 00000000..045ab5aa
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7305_principal.ml
@@ -0,0 +1,36 @@
+(* TEST
+flags = " -principal -w +18+19 -warn-error A "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+type c1 = < c1: c1 >
+type c2 = < c1: c1; c2: c1; c3: c1; c4: c1; c5: c1; c6: c1 >
+type c3 = < c1: c2; c2: c2; c3: c2; c4: c2; c5: c2; c6: c2 >
+type c4 = < c1: c3; c2: c3; c3: c3; c4: c3; c5: c3; c6: c3 >
+type c5 = < c1: c4; c2: c4; c3: c4; c4: c4; c5: c4; c6: c4 >
+type c6 = < c1: c5; c2: c5; c3: c5; c4: c5; c5: c5; c6: c5 >
+type c7 = < c1: c6; c2: c6; c3: c6; c4: c6; c5: c6; c6: c6 >
+
+(* If you use this example, then checking the types themselves
+   takes a long time.
+type c1 = < c1: c1; c2: c2; c3: c3; c4: c4; c5: c5; c6: c6 >
+and  c2 = < c1: c1; c2: c2; c3: c3; c4: c4; c5: c5; c6: c6 >
+and  c3 = < c1: c1; c2: c2; c3: c3; c4: c4; c5: c5; c6: c6 >
+and  c4 = < c1: c1; c2: c2; c3: c3; c4: c4; c5: c5; c6: c6 >
+and  c5 = < c1: c1; c2: c2; c3: c3; c4: c4; c5: c5; c6: c6 >
+and  c6 = < c1: c1; c2: c2; c3: c3; c4: c4; c5: c5; c6: c6 >
+*)
+
+(* Same for this example
+type 'a c1 = 
+type 'a c2 = 
+type 'a c3 = 
+type 'a c4 = 
+type 'a c5 = 
+type 'a c6 = 
+type 'a c7 = 
+*)
+
+let x = ref ([] : c7 list)
diff --git a/testsuite/tests/typing-modules-bugs/pr7321_ok.ml b/testsuite/tests/typing-modules-bugs/pr7321_ok.ml
new file mode 100644
index 00000000..73f40443
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7321_ok.ml
@@ -0,0 +1,15 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type S = sig type 'a t end
+module type Sp = sig type 'a t = private 'a array end
+
+module Id (S : S) = S
+
+module M : Sp = struct
+  include Id (struct type 'a t = 'a array end)
+end
diff --git a/testsuite/tests/typing-modules-bugs/pr7414_2_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr7414_2_bad.compilers.reference
new file mode 100644
index 00000000..e606767e
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7414_2_bad.compilers.reference
@@ -0,0 +1,20 @@
+File "pr7414_2_bad.ml", line 46, characters 28-34:
+46 |   let module Ignore = Force(Choose) in
+                                 ^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         functor () -> sig module Choice : T val r : '_weak1 list ref ref end
+       is not included in
+         functor () -> S
+       At position functor () -> 
+       Modules do not match:
+         sig module Choice : T val r : '_weak1 list ref ref end
+       is not included in
+         S
+       At position functor () -> 
+       Values do not match:
+         val r : '_weak1 list ref ref
+       is not included in
+         val r : Choice.t list ref ref
+       File "pr7414_2_bad.ml", line 29, characters 2-31: Expected declaration
+       File "pr7414_2_bad.ml", line 40, characters 8-9: Actual declaration
diff --git a/testsuite/tests/typing-modules-bugs/pr7414_2_bad.ml b/testsuite/tests/typing-modules-bugs/pr7414_2_bad.ml
new file mode 100644
index 00000000..e3cfca5f
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7414_2_bad.ml
@@ -0,0 +1,50 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type T = sig
+  type t
+  val x : t
+  val show : t -> string
+end
+
+module Int = struct
+  type t = int
+  let x = 0
+  let show x = Int.to_string x
+end
+
+module String = struct
+  type t = string
+  let x = "Hello"
+  let show x = x
+end
+
+module type S = sig
+  module Choice : T
+  val r : Choice.t list ref ref
+end
+
+module Force (X : functor () -> S) = struct end
+
+let () =
+  let switch = ref true in
+  let module Choose () = struct
+    module Choice =
+      (val if !switch then (module Int : T)
+        else (module String : T))
+    let r = ref (ref [])
+  end in
+  let module M = Choose () in
+  let () = switch := false in
+  let module N = Choose () in
+  let () = N.r := !M.r in
+  let module Ignore = Force(Choose) in
+  let module M' = (M : S) in
+  let () = (!M'.r) := [M'.Choice.x] in
+  let module N' = (N : S) in
+  List.iter (fun x -> print_string (N'.Choice.show x)) !(!N'.r)
diff --git a/testsuite/tests/typing-modules-bugs/pr7414_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr7414_bad.compilers.reference
new file mode 100644
index 00000000..5bdae1de
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7414_bad.compilers.reference
@@ -0,0 +1,20 @@
+File "pr7414_bad.ml", line 52, characters 22-28:
+52 | module Ignore = Force(Choose)
+                           ^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         functor () -> sig module Choice : T val r : '_weak1 list ref ref end
+       is not included in
+         functor () -> S
+       At position functor () -> 
+       Modules do not match:
+         sig module Choice : T val r : '_weak1 list ref ref end
+       is not included in
+         S
+       At position functor () -> 
+       Values do not match:
+         val r : '_weak1 list ref ref
+       is not included in
+         val r : Choice.t list ref ref
+       File "pr7414_bad.ml", line 38, characters 2-31: Expected declaration
+       File "pr7414_bad.ml", line 33, characters 6-7: Actual declaration
diff --git a/testsuite/tests/typing-modules-bugs/pr7414_bad.ml b/testsuite/tests/typing-modules-bugs/pr7414_bad.ml
new file mode 100644
index 00000000..c95e0ac1
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7414_bad.ml
@@ -0,0 +1,63 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type T = sig
+  type t
+  val x : t
+  val show : t -> string
+end
+
+module Int = struct
+  type t = int
+  let x = 0
+  let show x = Int.to_string x
+end
+
+module String = struct
+  type t = string
+  let x = "Hello"
+  let show x = x
+end
+
+let switch = ref true
+
+module Choose () = struct
+  module Choice =
+    (val if !switch then (module Int : T)
+    else (module String : T))
+  let r = ref (ref [])
+end
+
+module type S = sig
+  module Choice : T
+  val r : Choice.t list ref ref
+end
+
+module Force (X : functor () -> S) = struct end
+
+module M = Choose ()
+
+let () = switch := false
+
+module N = Choose ()
+
+let () = N.r := !M.r
+;;
+
+module Ignore = Force(Choose)
+;; (* fail *)
+
+(* would cause segfault
+module M' = (M : S)
+
+let () = (!M'.r) := [M'.Choice.x]
+
+module N' = (N : S)
+
+let () = List.iter (fun x -> print_string (N'.Choice.show x)) !(!N'.r)
+*)
diff --git a/testsuite/tests/typing-modules-bugs/pr7519_ok.ml b/testsuite/tests/typing-modules-bugs/pr7519_ok.ml
new file mode 100644
index 00000000..1db6bc3d
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7519_ok.ml
@@ -0,0 +1,25 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module Gen_spec = struct type 't extra = unit end
+
+module type S = sig
+  module Spec : sig type 't extra = unit end
+
+  type t
+  val make : unit -> t Spec.extra
+end (* S *)
+
+module Make () : S with module Spec := Gen_spec = struct
+  type t = int
+  let make () = ()
+end (* Make *)
+
+let () =
+  let module M = Make () in
+  M.make ()
+  (* (M.make () : unit) *)
diff --git a/testsuite/tests/typing-modules-bugs/pr7601_ok.ml b/testsuite/tests/typing-modules-bugs/pr7601_ok.ml
new file mode 100644
index 00000000..9b3cf39b
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7601_ok.ml
@@ -0,0 +1,30 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(**************************************************************************)
+(*                                                                        *)
+(*  Crude slicer for preprocessing reachability verification tasks        *)
+(*                                                                        *)
+(*  Copyright (C) 2016-2017 Mikhail Mandrykin, ISP RAS                    *)
+(*                                                                        *)
+(**************************************************************************)
+
+module type Analysis = sig
+  type t
+  type 'a maybe_region =
+    [< `Location of t
+    |  `Value of t
+    |  `None ] as 'a
+  val of_var :
+    ?f:string -> string ->
+      [ `Location of _ | `Value of _  | `None ] maybe_region
+end
+
+module Make (Analysis : Analysis) = struct
+  include Analysis
+  let of_var  = of_var ~f:""
+end
diff --git a/testsuite/tests/typing-modules-bugs/pr7601a_ok.ml b/testsuite/tests/typing-modules-bugs/pr7601a_ok.ml
new file mode 100644
index 00000000..fd046d8a
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr7601a_ok.ml
@@ -0,0 +1,27 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type Param1 = sig
+  type 'a r = [< `A of int ] as 'a
+  val f : ?a:string -> string -> [ `A of _ ] r
+end
+
+module Make1 (M : Param1) = struct
+  include M
+  let f = f ~a:""
+end
+
+module type Param2 = sig
+  type t
+  type 'a r = [< `A of t ] as 'a
+  val f : ?a:string -> string -> [ `A of _ ] r
+end
+
+module Make2 (M : Param2) = struct
+  include M
+  let f = f ~a:""
+end
diff --git a/testsuite/tests/typing-modules-bugs/pr9695_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr9695_bad.compilers.reference
new file mode 100644
index 00000000..d52aba54
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr9695_bad.compilers.reference
@@ -0,0 +1,4 @@
+File "pr9695_bad.ml", line 10, characters 18-19:
+10 | let () = let open A in x
+                       ^
+Error: This is an alias for module MissingModule, which is missing
diff --git a/testsuite/tests/typing-modules-bugs/pr9695_bad.ml b/testsuite/tests/typing-modules-bugs/pr9695_bad.ml
new file mode 100644
index 00000000..191248a2
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr9695_bad.ml
@@ -0,0 +1,10 @@
+(* TEST
+flags = " -w a -no-alias-deps"
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module A = MissingModule
+let () = let open A in x
diff --git a/testsuite/tests/typing-modules/.gitattributes b/testsuite/tests/typing-modules/.gitattributes
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/typing-modules/Test.ml b/testsuite/tests/typing-modules/Test.ml
new file mode 100644
index 00000000..6287a6e6
--- /dev/null
+++ b/testsuite/tests/typing-modules/Test.ml
@@ -0,0 +1,213 @@
+(* TEST
+   * expect
+*)
+
+(* with module *)
+
+module type S = sig type t and s = t end;;
+module type S' = S with type t := int;;
+[%%expect{|
+module type S = sig type t and s = t end
+module type S' = sig type s = int end
+|}];;
+
+module type S = sig module rec M : sig end and N : sig end end;;
+module type S' = S with module M := String;;
+[%%expect{|
+module type S = sig module rec M : sig end and N : sig end end
+module type S' = sig module rec N : sig end end
+|}];;
+
+(* with module type *)
+(*
+module type S = sig module type T module F(X:T) : T end;;
+module type T0 = sig type t end;;
+module type S1 = S with module type T = T0;;
+module type S2 = S with module type T := T0;;
+module type S3 = S with module type T := sig type t = int end;;
+module H = struct
+  include (Hashtbl : module type of Hashtbl with
+           type statistics := Hashtbl.statistics
+           and module type S := Hashtbl.S
+           and module Make := Hashtbl.Make
+           and module MakeSeeded := Hashtbl.MakeSeeded
+           and module type SeededS := Hashtbl.SeededS
+           and module type HashedType := Hashtbl.HashedType
+           and module type SeededHashedType := Hashtbl.SeededHashedType)
+end;;
+*)
+
+(* A subtle problem appearing with -principal *)
+type -'a t
+class type c = object method m : [ `A ] t end;;
+module M : sig val v : (#c as 'a) -> 'a end =
+  struct let v x = ignore (x :> c); x end;;
+[%%expect{|
+type -'a t
+class type c = object method m : [ `A ] t end
+module M : sig val v : (#c as 'a) -> 'a end
+|}];;
+
+(* PR#4838 *)
+
+let id = let module M = struct end in fun x -> x;;
+[%%expect{|
+val id : 'a -> 'a = 
+|}];;
+
+(* PR#4511 *)
+
+let ko = let module M = struct end in fun _ -> ();;
+[%%expect{|
+val ko : 'a -> unit = 
+|}];;
+
+(* PR#5993 *)
+
+module M : sig type -'a t = private int end =
+  struct type +'a t = private int end
+;;
+[%%expect{|
+Line 2, characters 2-37:
+2 |   struct type +'a t = private int end
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type +'a t = private int end
+       is not included in
+         sig type -'a t = private int end
+       Type declarations do not match:
+         type +'a t = private int
+       is not included in
+         type -'a t = private int
+       Their variances do not agree.
+|}];;
+
+(* PR#6005 *)
+
+module type A = sig type t = X of int end;;
+type u = X of bool;;
+module type B = A with type t = u;; (* fail *)
+[%%expect{|
+module type A = sig type t = X of int end
+type u = X of bool
+Line 3, characters 23-33:
+3 | module type B = A with type t = u;; (* fail *)
+                           ^^^^^^^^^^
+Error: This variant or record definition does not match that of type u
+       Constructors do not match:
+         X of bool
+       is not compatible with:
+         X of int
+       The types are not equal.
+|}];;
+
+(* PR#5815 *)
+(* ---> duplicated exception name is now an error *)
+
+module type S = sig exception Foo of int  exception Foo of bool end;;
+[%%expect{|
+Line 1, characters 42-63:
+1 | module type S = sig exception Foo of int  exception Foo of bool end;;
+                                              ^^^^^^^^^^^^^^^^^^^^^
+Error: Multiple definition of the extension constructor name Foo.
+       Names must be unique in a given structure or signature.
+|}];;
+
+(* PR#6410 *)
+
+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
+Line 2, characters 0-3:
+2 | F.x;; (* fail *)
+    ^^^
+Error: The module F is a functor, it cannot have any components
+|}];;
+
+type t = ..;;
+[%%expect{|
+type t = ..
+|}];;
+
+module M : sig type t += E end = struct type t += E of int end;;
+[%%expect{|
+Line 1, characters 33-62:
+1 | module M : sig type t += E end = struct type t += E of int end;;
+                                     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t += E of int end
+       is not included in
+         sig type t += E end
+       Extension declarations do not match:
+         type t += E of int
+       is not included in
+         type t += E
+       Constructors do not match:
+         E of int
+       is not compatible with:
+         E
+       They have different arities.
+|}];;
+
+module M : sig type t += E of char end = struct type t += E of int end;;
+[%%expect{|
+Line 1, characters 41-70:
+1 | module M : sig type t += E of char end = struct type t += E of int end;;
+                                             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t += E of int end
+       is not included in
+         sig type t += E of char end
+       Extension declarations do not match:
+         type t += E of int
+       is not included in
+         type t += E of char
+       Constructors do not match:
+         E of int
+       is not compatible with:
+         E of char
+       The types are not equal.
+|}];;
+
+module M : sig type t += C of int end = struct type t += E of int end;;
+[%%expect{|
+Line 1, characters 40-69:
+1 | module M : sig type t += C of int end = struct type t += E of int end;;
+                                            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t += E of int end
+       is not included in
+         sig type t += C of int end
+       The extension constructor `C' is required but not provided
+|}];;
+
+module M : sig
+  type t += E of { x : int }
+end = struct
+  type t += E of int
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t += E of int
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t += E of int end
+       is not included in
+         sig type t += E of { x : int; } end
+       Extension declarations do not match:
+         type t += E of int
+       is not included in
+         type t += E of { x : int; }
+       Constructors do not match:
+         E of int
+       is not compatible with:
+         E of { x : int; }
+       The second uses inline records and the first doesn't.
+|}];;
diff --git a/testsuite/tests/typing-modules/aliases.ml b/testsuite/tests/typing-modules/aliases.ml
new file mode 100644
index 00000000..aac8c2a0
--- /dev/null
+++ b/testsuite/tests/typing-modules/aliases.ml
@@ -0,0 +1,862 @@
+(* TEST
+   * expect
+*)
+
+module C = Char;;
+C.chr 66;;
+
+module C' : module type of Char = C;;
+C'.chr 66;;
+
+module C3 = struct include Char end;;
+C3.chr 66;;
+[%%expect{|
+module C = Char
+- : char = 'B'
+module C' :
+  sig
+    external code : char -> int = "%identity"
+    val chr : int -> char
+    val escaped : char -> string
+    val lowercase : char -> char
+    val uppercase : char -> char
+    val lowercase_ascii : char -> char
+    val uppercase_ascii : char -> char
+    type t = char
+    val compare : t -> t -> int
+    val equal : t -> t -> bool
+    external unsafe_chr : int -> char = "%identity"
+  end
+- : char = 'B'
+module C3 :
+  sig
+    external code : char -> int = "%identity"
+    val chr : int -> char
+    val escaped : char -> string
+    val lowercase : char -> char
+    val uppercase : char -> char
+    val lowercase_ascii : char -> char
+    val uppercase_ascii : char -> char
+    type t = char
+    val compare : t -> t -> int
+    val equal : t -> t -> bool
+    external unsafe_chr : int -> char = "%identity"
+  end
+- : char = 'B'
+|}];;
+
+let f x = let module M = struct module L = List end in M.L.length x;;
+let g x = let module L = List in L.length (L.map succ x);;
+[%%expect{|
+val f : 'a list -> int = 
+val g : int list -> int = 
+|}];;
+
+module F(X:sig end) = Char;;
+module C4 = F(struct end);;
+C4.chr 66;;
+[%%expect{|
+module F :
+  functor (X : sig end) ->
+    sig
+      external code : char -> int = "%identity"
+      val chr : int -> char
+      val escaped : char -> string
+      val lowercase : char -> char
+      val uppercase : char -> char
+      val lowercase_ascii : char -> char
+      val uppercase_ascii : char -> char
+      type t = char
+      val compare : t -> t -> int
+      val equal : t -> t -> bool
+      external unsafe_chr : int -> char = "%identity"
+    end
+module C4 :
+  sig
+    external code : char -> int = "%identity"
+    val chr : int -> char
+    val escaped : char -> string
+    val lowercase : char -> char
+    val uppercase : char -> char
+    val lowercase_ascii : char -> char
+    val uppercase_ascii : char -> char
+    type t = char
+    val compare : t -> t -> int
+    val equal : t -> t -> bool
+    external unsafe_chr : int -> char = "%identity"
+  end
+- : char = 'B'
+|}];;
+
+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 M : sig module M : sig end end
+|}];;
+
+module M' = struct
+  module N = struct let x = 1 end
+  module N' = N
+end;;
+M'.N'.x;;
+[%%expect{|
+module M' : sig module N : sig val x : int end module N' = N end
+- : int = 1
+|}];;
+
+module M'' : sig module N' : sig val x : int end end = M';;
+M''.N'.x;;
+module M2 = struct include M' end;;
+module M3 : sig module N' : sig val x : int end end = struct include M' end;;
+M3.N'.x;;
+module M3' : sig module N' : sig val x : int end end = M2;;
+M3'.N'.x;;
+[%%expect{|
+module M'' : sig module N' : sig val x : int end end
+- : int = 1
+module M2 : sig module N = M'.N module N' = N end
+module M3 : sig module N' : sig val x : int end end
+- : int = 1
+module M3' : sig module N' : sig val x : int end end
+- : int = 1
+|}];;
+
+module M4 : sig module N' : sig val x : int end end = struct
+  module N = struct let x = 1 end
+  module N' = N
+end;;
+M4.N'.x;;
+[%%expect{|
+module M4 : sig module N' : sig val x : int end end
+- : int = 1
+|}];;
+
+module F(X:sig end) = struct
+  module N = struct let x = 1 end
+  module N' = N
+end;;
+module G : functor(X:sig end) -> sig module N' : sig val x : int end end = F;;
+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
+module M5 : sig module N' : sig val x : int end end
+- : int = 1
+|}];;
+
+module M = struct
+  module D = struct let y = 3 end
+  module N = struct let x = 1 end
+  module N' = N
+end;;
+
+module M1 : sig module N : sig val x : int end module N' = N end = M;;
+M1.N'.x;;
+module M2 : sig module N' : sig val x : int end end =
+  (M : sig module N : sig val x : int end module N' = N end);;
+M2.N'.x;;
+
+open M;;
+N'.x;;
+[%%expect{|
+module M :
+  sig
+    module D : sig val y : int end
+    module N : sig val x : int end
+    module N' = N
+  end
+module M1 : sig module N : sig val x : int end module N' = N end
+- : int = 1
+module M2 : sig module N' : sig val x : int end end
+- : int = 1
+- : int = 1
+|}];;
+
+module M = struct
+  module C = Char
+  module C' = C
+end;;
+module M1
+  : sig module C : sig val escaped : char -> string end module C' = C end
+  = M;; (* sound, but should probably fail *)
+M1.C'.escaped 'A';;
+module M2 : sig module C' : sig val chr : int -> char end end =
+  (M : sig module C : sig val chr : int -> char end module C' = C end);;
+M2.C'.chr 66;;
+[%%expect{|
+module M : sig module C = Char module C' = C end
+module M1 :
+  sig module C : sig val escaped : char -> string end module C' = C end
+- : string = "A"
+module M2 : sig module C' : sig val chr : int -> char end end
+- : char = 'B'
+|}];;
+
+StdLabels.List.map;;
+[%%expect{|
+- : f:('a -> 'b) -> 'a list -> 'b list = 
+|}];;
+
+module Q = Queue;;
+exception QE = Q.Empty;;
+try Q.pop (Q.create ()) with QE -> "Ok";;
+[%%expect{|
+module Q = Queue
+exception QE
+- : string = "Ok"
+|}];;
+
+module type Complex = module type of Complex with type t = Complex.t;;
+module M : sig module C : Complex end = struct module C = Complex end;;
+
+module C = Complex;;
+C.one.Complex.re;;
+include C;;
+[%%expect{|
+module type Complex =
+  sig
+    type t = Complex.t = { re : float; im : float; }
+    val zero : t
+    val one : t
+    val i : t
+    val neg : t -> t
+    val conj : t -> t
+    val add : t -> t -> t
+    val sub : t -> t -> t
+    val mul : t -> t -> t
+    val inv : t -> t
+    val div : t -> t -> t
+    val sqrt : t -> t
+    val norm2 : t -> float
+    val norm : t -> float
+    val arg : t -> float
+    val polar : float -> float -> t
+    val exp : t -> t
+    val log : t -> t
+    val pow : t -> t -> t
+  end
+module M : sig module C : Complex end
+module C = Complex
+- : float = 1.
+type t = Complex.t = { re : float; im : float; }
+val zero : t = {re = 0.; im = 0.}
+val one : t = {re = 1.; im = 0.}
+val i : t = {re = 0.; im = 1.}
+val neg : t -> t = 
+val conj : t -> t = 
+val add : t -> t -> t = 
+val sub : t -> t -> t = 
+val mul : t -> t -> t = 
+val inv : t -> t = 
+val div : t -> t -> t = 
+val sqrt : t -> t = 
+val norm2 : t -> float = 
+val norm : t -> float = 
+val arg : t -> float = 
+val polar : float -> float -> t = 
+val exp : t -> t = 
+val log : t -> t = 
+val pow : t -> t -> t = 
+|}];;
+
+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
+|}];;
+
+(* Applicative functors *)
+module S = String
+module StringSet = Set.Make(String)
+module SSet = Set.Make(S);;
+let f (x : StringSet.t) = (x : SSet.t);;
+[%%expect{|
+module S = String
+module StringSet :
+  sig
+    type elt = String.t
+    type t = Set.Make(String).t
+    val empty : t
+    val is_empty : t -> bool
+    val mem : elt -> t -> bool
+    val add : elt -> t -> t
+    val singleton : elt -> t
+    val remove : elt -> t -> t
+    val union : t -> t -> t
+    val inter : t -> t -> t
+    val disjoint : t -> t -> bool
+    val diff : t -> t -> t
+    val compare : t -> t -> int
+    val equal : t -> t -> bool
+    val subset : t -> t -> bool
+    val iter : (elt -> unit) -> t -> unit
+    val map : (elt -> elt) -> t -> t
+    val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
+    val for_all : (elt -> bool) -> t -> bool
+    val exists : (elt -> bool) -> t -> bool
+    val filter : (elt -> bool) -> t -> t
+    val filter_map : (elt -> elt option) -> t -> t
+    val partition : (elt -> bool) -> t -> t * t
+    val cardinal : t -> int
+    val elements : t -> elt list
+    val min_elt : t -> elt
+    val min_elt_opt : t -> elt option
+    val max_elt : t -> elt
+    val max_elt_opt : t -> elt option
+    val choose : t -> elt
+    val choose_opt : t -> elt option
+    val split : elt -> t -> t * bool * t
+    val find : elt -> t -> elt
+    val find_opt : elt -> t -> elt option
+    val find_first : (elt -> bool) -> t -> elt
+    val find_first_opt : (elt -> bool) -> t -> elt option
+    val find_last : (elt -> bool) -> t -> elt
+    val find_last_opt : (elt -> bool) -> t -> elt option
+    val of_list : elt list -> t
+    val to_seq_from : elt -> t -> elt Seq.t
+    val to_seq : t -> elt Seq.t
+    val add_seq : elt Seq.t -> t -> t
+    val of_seq : elt Seq.t -> t
+  end
+module SSet :
+  sig
+    type elt = S.t
+    type t = Set.Make(S).t
+    val empty : t
+    val is_empty : t -> bool
+    val mem : elt -> t -> bool
+    val add : elt -> t -> t
+    val singleton : elt -> t
+    val remove : elt -> t -> t
+    val union : t -> t -> t
+    val inter : t -> t -> t
+    val disjoint : t -> t -> bool
+    val diff : t -> t -> t
+    val compare : t -> t -> int
+    val equal : t -> t -> bool
+    val subset : t -> t -> bool
+    val iter : (elt -> unit) -> t -> unit
+    val map : (elt -> elt) -> t -> t
+    val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
+    val for_all : (elt -> bool) -> t -> bool
+    val exists : (elt -> bool) -> t -> bool
+    val filter : (elt -> bool) -> t -> t
+    val filter_map : (elt -> elt option) -> t -> t
+    val partition : (elt -> bool) -> t -> t * t
+    val cardinal : t -> int
+    val elements : t -> elt list
+    val min_elt : t -> elt
+    val min_elt_opt : t -> elt option
+    val max_elt : t -> elt
+    val max_elt_opt : t -> elt option
+    val choose : t -> elt
+    val choose_opt : t -> elt option
+    val split : elt -> t -> t * bool * t
+    val find : elt -> t -> elt
+    val find_opt : elt -> t -> elt option
+    val find_first : (elt -> bool) -> t -> elt
+    val find_first_opt : (elt -> bool) -> t -> elt option
+    val find_last : (elt -> bool) -> t -> elt
+    val find_last_opt : (elt -> bool) -> t -> elt option
+    val of_list : elt list -> t
+    val to_seq_from : elt -> t -> elt Seq.t
+    val to_seq : t -> elt Seq.t
+    val add_seq : elt Seq.t -> t -> t
+    val of_seq : elt Seq.t -> t
+  end
+val f : StringSet.t -> SSet.t = 
+|}];;
+
+(* Also using include (cf. Leo's mail 2013-11-16) *)
+module F (M : sig end) : sig type t end = struct type t = int end
+module T = struct
+  module M = struct end
+  include F(M)
+end;;
+include T;;
+let f (x : t) : T.t = x ;;
+[%%expect{|
+module F : functor (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
+val f : t -> T.t = 
+|}];;
+
+(* PR#4049 *)
+(* This works thanks to abbreviations *)
+module A = struct
+  module B = struct type t let compare x y = 0 end
+  module S = Set.Make(B)
+  let empty = S.empty
+end
+module A1 = A;;
+A1.empty = A.empty;;
+[%%expect{|
+module A :
+  sig
+    module B : sig type t val compare : 'a -> 'b -> int end
+    module S :
+      sig
+        type elt = B.t
+        type t = Set.Make(B).t
+        val empty : t
+        val is_empty : t -> bool
+        val mem : elt -> t -> bool
+        val add : elt -> t -> t
+        val singleton : elt -> t
+        val remove : elt -> t -> t
+        val union : t -> t -> t
+        val inter : t -> t -> t
+        val disjoint : t -> t -> bool
+        val diff : t -> t -> t
+        val compare : t -> t -> int
+        val equal : t -> t -> bool
+        val subset : t -> t -> bool
+        val iter : (elt -> unit) -> t -> unit
+        val map : (elt -> elt) -> t -> t
+        val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
+        val for_all : (elt -> bool) -> t -> bool
+        val exists : (elt -> bool) -> t -> bool
+        val filter : (elt -> bool) -> t -> t
+        val filter_map : (elt -> elt option) -> t -> t
+        val partition : (elt -> bool) -> t -> t * t
+        val cardinal : t -> int
+        val elements : t -> elt list
+        val min_elt : t -> elt
+        val min_elt_opt : t -> elt option
+        val max_elt : t -> elt
+        val max_elt_opt : t -> elt option
+        val choose : t -> elt
+        val choose_opt : t -> elt option
+        val split : elt -> t -> t * bool * t
+        val find : elt -> t -> elt
+        val find_opt : elt -> t -> elt option
+        val find_first : (elt -> bool) -> t -> elt
+        val find_first_opt : (elt -> bool) -> t -> elt option
+        val find_last : (elt -> bool) -> t -> elt
+        val find_last_opt : (elt -> bool) -> t -> elt option
+        val of_list : elt list -> t
+        val to_seq_from : elt -> t -> elt Seq.t
+        val to_seq : t -> elt Seq.t
+        val add_seq : elt Seq.t -> t -> t
+        val of_seq : elt Seq.t -> t
+      end
+    val empty : S.t
+  end
+module A1 = A
+- : bool = true
+|}];;
+
+(* PR#3476 *)
+(* Does not work yet *)
+module FF(X : sig end) = struct type t end
+module M = struct
+  module X = struct end
+  module Y = FF (X) (* XXX *)
+  type t = Y.t
+end
+module F (Y : sig type t end) (M : sig type t = Y.t end) = struct end;;
+
+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 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
+|}];;
+
+(* PR#6307 *)
+
+module A1 = struct end
+module A2 = struct end
+module L1 = struct module X = A1 end
+module L2 = struct module X = A2 end;;
+
+module F (L : (module type of L1 [@remove_aliases])) = struct end;;
+
+module F1 = F(L1);; (* ok *)
+module F2 = F(L2);; (* should succeed too *)
+[%%expect{|
+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 F1 : sig end
+module F2 : sig end
+|}];;
+
+(* Counter example: why we need to be careful with PR#6307 *)
+module Int = struct type t = int let compare = compare end
+module SInt = Set.Make(Int)
+type (_,_) eq = Eq : ('a,'a) eq
+type wrap = W of (SInt.t, SInt.t) eq
+
+module M = struct
+  module I = Int
+  type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(I).t) eq
+end;;
+module type S = module type of M [@remove_aliases];; (* keep alias *)
+
+module Int2 = struct type t = int let compare x y = compare y x end;;
+module type S' = sig
+  module I = Int2
+  include S with module I := I
+end;; (* fail *)
+[%%expect{|
+module Int : sig type t = int val compare : 'a -> 'a -> int end
+module SInt :
+  sig
+    type elt = Int.t
+    type t = Set.Make(Int).t
+    val empty : t
+    val is_empty : t -> bool
+    val mem : elt -> t -> bool
+    val add : elt -> t -> t
+    val singleton : elt -> t
+    val remove : elt -> t -> t
+    val union : t -> t -> t
+    val inter : t -> t -> t
+    val disjoint : t -> t -> bool
+    val diff : t -> t -> t
+    val compare : t -> t -> int
+    val equal : t -> t -> bool
+    val subset : t -> t -> bool
+    val iter : (elt -> unit) -> t -> unit
+    val map : (elt -> elt) -> t -> t
+    val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
+    val for_all : (elt -> bool) -> t -> bool
+    val exists : (elt -> bool) -> t -> bool
+    val filter : (elt -> bool) -> t -> t
+    val filter_map : (elt -> elt option) -> t -> t
+    val partition : (elt -> bool) -> t -> t * t
+    val cardinal : t -> int
+    val elements : t -> elt list
+    val min_elt : t -> elt
+    val min_elt_opt : t -> elt option
+    val max_elt : t -> elt
+    val max_elt_opt : t -> elt option
+    val choose : t -> elt
+    val choose_opt : t -> elt option
+    val split : elt -> t -> t * bool * t
+    val find : elt -> t -> elt
+    val find_opt : elt -> t -> elt option
+    val find_first : (elt -> bool) -> t -> elt
+    val find_first_opt : (elt -> bool) -> t -> elt option
+    val find_last : (elt -> bool) -> t -> elt
+    val find_last_opt : (elt -> bool) -> t -> elt option
+    val of_list : elt list -> t
+    val to_seq_from : elt -> t -> elt Seq.t
+    val to_seq : t -> elt Seq.t
+    val add_seq : elt Seq.t -> t -> t
+    val of_seq : elt Seq.t -> t
+  end
+type (_, _) eq = Eq : ('a, 'a) eq
+type wrap = W of (SInt.t, SInt.t) eq
+module M :
+  sig
+    module I = Int
+    type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(I).t) eq
+  end
+module type S =
+  sig
+    module I = Int
+    type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(I).t) eq
+  end
+module Int2 : sig type t = int val compare : 'a -> 'a -> int end
+Line 15, characters 10-30:
+15 |   include S with module I := I
+               ^^^^^^^^^^^^^^^^^^^^
+Error: In this `with' constraint, the new definition of I
+       does not match its original definition in the constrained signature:
+       Modules do not match: (module Int2) is not included in (module Int)
+|}];;
+
+(* (* if the above succeeded, one could break invariants *)
+module rec M2 : S' = M2;; (* should succeed! (but this is bad) *)
+
+let M2.W eq = W Eq;;
+
+let s = List.fold_right SInt.add [1;2;3] SInt.empty;;
+module SInt2 = Set.Make(Int2);;
+let conv : type a b. (a,b) eq -> a -> b = fun Eq x -> x;;
+let s' : SInt2.t = conv eq s;;
+SInt2.elements s';;
+SInt2.mem 2 s';; (* invariants are broken *)
+*)
+
+(* Check behavior with submodules *)
+module M = struct
+  module N = struct module I = Int end
+  module P = struct module I = N.I end
+  module Q = struct
+    type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(P.I).t) eq
+  end
+end;;
+module type S = module type of M [@remove_aliases];;
+[%%expect{|
+module M :
+  sig
+    module N : sig module I = Int end
+    module P : sig module I = N.I end
+    module Q :
+      sig type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(P.I).t) eq end
+  end
+module type S =
+  sig
+    module N : sig module I = Int end
+    module P : sig module I = N.I end
+    module Q :
+      sig type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(P.I).t) eq end
+  end
+|}];;
+
+module M = struct
+  module N = struct module I = Int end
+  module P = struct module I = N.I end
+  module Q = struct
+    type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(N.I).t) eq
+  end
+end;;
+module type S = module type of M [@remove_aliases];;
+[%%expect{|
+module M :
+  sig
+    module N : sig module I = Int end
+    module P : sig module I = N.I end
+    module Q :
+      sig type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(N.I).t) eq end
+  end
+module type S =
+  sig
+    module N : sig module I = Int end
+    module P :
+      sig module I : sig type t = int val compare : 'a -> 'a -> int end end
+    module Q :
+      sig type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(N.I).t) eq end
+  end
+|}];;
+
+(* PR#6365 *)
+module type S = sig module M : sig type t val x : t end end;;
+module H = struct type t = A let x = A end;;
+module H' = H;;
+module type S' = S with module M = H';; (* shouldn't introduce an alias *)
+[%%expect{|
+module type S = sig module M : sig type t val x : t end end
+module H : sig type t = A val x : t end
+module H' = H
+module type S' = sig module M : sig type t = H.t = A val x : t end end
+|}];;
+
+(* PR#6376 *)
+module type Alias = sig module N : sig end module M = N end;;
+module F (X : sig end) = struct type t end;;
+module type A = Alias with module N := F(List);;
+module rec Bad : A = Bad;;
+[%%expect{|
+module type Alias = sig module N : sig end module M = N end
+module F : functor (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
+       does not match
+         module type A = sig module M = F(List) end
+       At position module type A = 
+       Modules do not match:
+         sig module M = F(List) end
+       is not included in
+         sig module M = F(List) end
+       At position module type A = sig module M :  end
+       Module F(List) cannot be aliased
+|}];;
+
+(* Shinwell 2014-04-23 *)
+module B = struct
+ module R = struct
+   type t = string
+ end
+
+ module O = R
+end
+
+module K = struct
+ module E = B
+ module N = E.O
+end;;
+
+let x : K.N.t = "foo";;
+[%%expect{|
+module B : sig module R : sig type t = string end module O = R end
+module K : sig module E = B module N = E.O end
+val x : K.N.t = "foo"
+|}];;
+
+(* PR#6465 *)
+
+module M = struct type t = A module B = struct type u = B end end;;
+module P : sig type t = M.t = A module B = M.B end = M;;
+module P : sig type t = M.t = A module B = M.B end = struct include M end;;
+[%%expect{|
+module M : sig type t = A module B : sig type u = B end end
+module P : sig type t = M.t = A module B = M.B end
+module P : sig type t = M.t = A module B = M.B end
+|}];;
+
+module type S = sig
+  module M : sig module P : sig end end
+  module Q = M
+end;;
+[%%expect{|
+module type S = sig module M : sig module P : sig end end module Q = M end
+|}];;
+module type S = sig
+  module M : sig module N : sig end module P : sig end end
+  module Q : sig module N = M.N module P = M.P end
+end;;
+module R = struct
+  module M = struct module N = struct end module P = struct end end
+  module Q = M
+end;;
+module R' : S = R;;
+[%%expect{|
+module type S =
+  sig
+    module M : sig module N : sig end module P : sig end end
+    module Q : sig module N = M.N module P = M.P end
+  end
+module R :
+  sig
+    module M : sig module N : sig end module P : sig end end
+    module Q = M
+  end
+module R' : S
+|}];;
+
+module F (X : sig end) = struct type t end;;
+module M : sig
+  type a
+  module Foo : sig
+    module Bar : sig end
+    type b = a
+  end
+end = struct
+  module Foo = struct
+    module Bar = struct end
+    type b = F(Bar).t
+  end
+  type a = Foo.b
+end;;
+[%%expect{|
+module F : functor (X : sig end) -> sig type t end
+module M :
+  sig type a module Foo : sig module Bar : sig end type b = a end end
+|}];;
+
+(* PR#6578 *)
+
+module M = struct let f x = x end
+module rec R : sig module M : sig val f : 'a -> 'a end end =
+  struct module M = M end;;
+R.M.f 3;;
+[%%expect{|
+module M : sig val f : 'a -> 'a end
+module rec R : sig module M : sig val f : 'a -> 'a end end
+- : int = 3
+|}];;
+module rec R : sig module M = M end = struct module M = M end;;
+R.M.f 3;;
+[%%expect{|
+module rec R : sig module M = M end
+- : int = 3
+|}];;
+
+module M = struct type t end
+module type S = sig module N = M val x : N.t end
+module type T = S with module N := M;;
+[%%expect{|
+module M : sig type t end
+module type S = sig module N = M val x : N.t end
+module type T = sig val x : M.t end
+|}];;
+
+
+module X = struct module N = struct end end
+module Y : sig
+  module type S = sig module N = X.N end
+end = struct
+  module type S = module type of struct include X end
+end;;
+[%%expect{|
+module X : sig module N : sig end end
+module Y : sig module type S = sig module N = X.N end end
+|}];;
+
+module type S = sig
+  module M : sig
+    module A : sig end
+    module B : sig end
+  end
+  module N = M.A
+end
+
+module Foo = struct
+  module B = struct let x = 0 end
+  module A = struct let x = "hello" end
+end
+
+module Bar : S with module M := Foo = struct module N = Foo.A end
+
+let s : string = Bar.N.x
+[%%expect {|
+module type S =
+  sig
+    module M : sig module A : sig end module B : sig end end
+    module N = M.A
+  end
+module Foo :
+  sig module B : sig val x : int end module A : sig val x : string end end
+module Bar : sig module N = Foo.A end
+val s : string = "hello"
+|}]
+
+
+module M : sig
+  module N : sig
+    module A : sig val x : string end
+    module B : sig val x : int end
+  end
+  module F (X : sig module A = N.A end) : sig val s : string end
+end = struct
+  module N = struct
+    module B = struct let x = 0 end
+    module A = struct let x = "hello" end
+  end
+  module F (X : sig module A : sig val x : string end end) = struct
+    let s = X.A.x
+  end
+end
+
+module N = M.F(struct module A = M.N.A end)
+
+let s : string = N.s
+[%%expect {|
+module M :
+  sig
+    module N :
+      sig
+        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
+  end
+module N : sig val s : string end
+val s : string = "hello"
+|}]
diff --git a/testsuite/tests/typing-modules/anonymous.ml b/testsuite/tests/typing-modules/anonymous.ml
new file mode 100644
index 00000000..c250e922
--- /dev/null
+++ b/testsuite/tests/typing-modules/anonymous.ml
@@ -0,0 +1,39 @@
+(* TEST
+   * expect
+*)
+
+module _ = struct end;;
+[%%expect{|
+|}];;
+
+module rec A : sig
+  type t = B.t
+end = A
+and _ : sig type t = A.t end = struct type t = A.t end
+and B : sig type t end = B
+;;
+[%%expect{|
+module rec A : sig type t = B.t end
+and B : sig type t end
+|}]
+
+module type S = sig
+  module _ : sig end
+
+  module rec A : sig
+    type t = B.t
+  end
+  and _ : sig type t = A.t end
+  and B : sig type t end
+end
+;;
+[%%expect{|
+module type S =
+  sig module rec A : sig type t = B/2.t end and B : sig type t end end
+|}]
+
+let f (module _ : S) = ()
+;;
+[%%expect{|
+val f : (module S) -> unit = 
+|}]
diff --git a/testsuite/tests/typing-modules/applicative_functor_type.ml b/testsuite/tests/typing-modules/applicative_functor_type.ml
new file mode 100644
index 00000000..e62b7e63
--- /dev/null
+++ b/testsuite/tests/typing-modules/applicative_functor_type.ml
@@ -0,0 +1,83 @@
+(* TEST
+   * expect
+*)
+
+type t = Set.Make(String).t
+[%%expect{|
+type t = Set.Make(String).t
+|} ]
+
+
+(* Check the error messages of an ill-typed applicatived functor type. *)
+module M = struct type t let equal = (=) end
+[%%expect{|
+module M : sig type t val equal : 'a -> 'a -> bool end
+|} ]
+
+type t = Set.Make(M).t
+[%%expect{|
+Line 1, characters 9-22:
+1 | type t = Set.Make(M).t
+             ^^^^^^^^^^^^^
+Error: The type of M does not match Set.Make's parameter
+       Modules do not match:
+         sig type t = M.t val equal : 'a -> 'a -> bool end
+       is not included in
+         Set.OrderedType
+       The value `compare' is required but not provided
+       File "set.mli", line 52, characters 4-31: Expected declaration
+|} ]
+
+
+(* We would report the wrong error here if we didn't strengthen the
+   type of the argument (type t wouldn't 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
+|} ]
+
+type t = F(M).t
+[%%expect{|
+Line 1, characters 9-15:
+1 | type t = F(M).t
+             ^^^^^^
+Error: The type of M does not match F's parameter
+       Modules do not match:
+         sig type t = M.t val equal : 'a -> 'a -> bool end
+       is not included in
+         sig type t = M.t val equal : unit end
+       Values do not match:
+         val equal : 'a -> 'a -> bool
+       is not included in
+         val equal : unit
+|} ]
+
+
+(* MPR#7611 *)
+module Generative() = struct type t end
+[%%expect{|
+module Generative : functor () -> sig type t end
+|}]
+
+type t = Generative(M).t
+[%%expect{|
+Line 1, characters 9-24:
+1 | type t = Generative(M).t
+             ^^^^^^^^^^^^^^^
+Error: The functor Generative is generative, it cannot be applied in type
+       expressions
+|}]
+
+
+
+module F(X : sig module type S module F : S end) = struct
+  type t = X.F(Parsing).t
+end
+[%%expect{|
+Line 2, characters 11-25:
+2 |   type t = X.F(Parsing).t
+               ^^^^^^^^^^^^^^
+Error: The module X.F is abstract, it cannot be applied
+|}]
diff --git a/testsuite/tests/typing-modules/extension_constructors_errors_test.ml b/testsuite/tests/typing-modules/extension_constructors_errors_test.ml
new file mode 100644
index 00000000..fb4b914f
--- /dev/null
+++ b/testsuite/tests/typing-modules/extension_constructors_errors_test.ml
@@ -0,0 +1,44 @@
+(* TEST
+ * expect
+*)
+
+type t = ..;;
+
+module M : sig type t += E | F end = struct type t += E | F of int end;;
+[%%expect{|
+type t = ..
+Line 3, characters 37-70:
+3 | module M : sig type t += E | F end = struct type t += E | F of int end;;
+                                         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t += E | F of int  end
+       is not included in
+         sig type t += E | F  end
+       Extension declarations do not match:
+         type t += F of int
+       is not included in
+         type t += F
+       Constructors do not match:
+         F of int
+       is not compatible with:
+         F
+       They have different arities.
+|}];;
+
+module M1 : sig type t += A end = struct type t += private A end;;
+[%%expect{|
+Line 1, characters 34-64:
+1 | module M1 : sig type t += A end = struct type t += private A end;;
+                                      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t += private A end
+       is not included in
+         sig type t += A end
+       Extension declarations do not match:
+         type t += private A
+       is not included in
+         type t += A
+       A private type would be revealed.
+|}];;
diff --git a/testsuite/tests/typing-modules/firstclass.ml b/testsuite/tests/typing-modules/firstclass.ml
new file mode 100644
index 00000000..a79d01d9
--- /dev/null
+++ b/testsuite/tests/typing-modules/firstclass.ml
@@ -0,0 +1,51 @@
+(* TEST
+   * expect
+*)
+
+module type S = sig type u type t end;;
+module type S' = sig type t = int type u = bool end;;
+
+(* ok to convert between structurally equal signatures, and parameters
+   are inferred *)
+let f (x : (module S with type t = 'a and type u = 'b)) = (x : (module S'));;
+let g x = (x : (module S with type t = 'a and type u = 'b) :> (module S'));;
+[%%expect{|
+module type S = sig type u type t end
+module type S' = sig type t = int type u = bool end
+val f : (module S with type t = int and type u = bool) -> (module S') = 
+val g : (module S with type t = int and type u = bool) -> (module S') = 
+|}];;
+
+(* with subtyping it is also ok to forget some types *)
+module type S2 = sig type u type t type w end;;
+let g2 x = (x : (module S2 with type t = 'a and type u = 'b) :> (module S'));;
+let h x = (x : (module S2 with type t = 'a) :> (module S with type t = 'a));;
+let f2 (x : (module S2 with type t = 'a and type u = 'b)) =
+  (x : (module S'));; (* fail *)
+let k (x : (module S2 with type t = 'a)) =
+  (x : (module S with type t = 'a));; (* fail *)
+[%%expect{|
+module type S2 = sig type u type t type w end
+val g2 : (module S2 with type t = int and type u = bool) -> (module S') =
+  
+val h : (module S2 with type t = 'a) -> (module S with type t = 'a) = 
+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)
+       but an expression was expected of type (module S')
+|}];;
+
+(* but you cannot forget values (no physical coercions) *)
+module type S3 = sig type u type t val x : int end;;
+let g3 x =
+  (x : (module S3 with type t = 'a and type u = 'b) :> (module S'));; (* fail *)
+[%%expect{|
+module type S3 = sig type u type t val x : int end
+Line 3, characters 2-67:
+3 |   (x : (module S3 with type t = 'a and type u = 'b) :> (module S'));; (* fail *)
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type (module S3 with type t = int and type u = bool)
+       is not a subtype of (module S')
+|}];;
diff --git a/testsuite/tests/typing-modules/generative.ml b/testsuite/tests/typing-modules/generative.ml
new file mode 100644
index 00000000..c9411da3
--- /dev/null
+++ b/testsuite/tests/typing-modules/generative.ml
@@ -0,0 +1,98 @@
+(* TEST
+   * expect
+*)
+
+(* Using generative functors *)
+
+(* Without type *)
+module type S = sig val x : int end;;
+let v = (module struct let x = 3 end : S);;
+module F() = (val v);; (* ok *)
+module G (X : sig end) : S = F ();; (* ok *)
+module H (X : sig end) = (val v);; (* ok *)
+[%%expect{|
+module type S = sig val x : int end
+val v : (module S) = 
+module F : functor () -> S
+module G : functor (X : sig end) -> S
+module H : functor (X : sig end) -> S
+|}];;
+
+(* With type *)
+module type S = sig type t val x : t end;;
+let v = (module struct type t = int let x = 3 end : S);;
+module F() = (val v);; (* ok *)
+[%%expect{|
+module type S = sig type t val x : t end
+val v : (module S) = 
+module F : functor () -> S
+|}];;
+module G (X : sig end) : S = F ();; (* fail *)
+[%%expect{|
+Line 1, characters 29-33:
+1 | module G (X : sig end) : S = F ();; (* fail *)
+                                 ^^^^
+Error: This expression creates fresh types.
+       It is not allowed inside applicative functors.
+|}];;
+module H() = F();; (* ok *)
+[%%expect{|
+module H : functor () -> S
+|}];;
+
+(* Alias *)
+module U = struct end;;
+module M = F(struct end);; (* ok *)
+[%%expect{|
+module U : sig end
+module M : S
+|}];;
+module M = F(U);; (* fail *)
+[%%expect{|
+Line 1, characters 11-12:
+1 | module M = F(U);; (* fail *)
+               ^
+Error: This is a generative functor. It can only be applied to ()
+|}];;
+
+(* Cannot coerce between applicative and generative *)
+module F1 (X : sig end) = struct end;;
+module F2 : functor () -> sig end = F1;; (* fail *)
+[%%expect{|
+module F1 : functor (X : sig end) -> sig end
+Line 2, characters 36-38:
+2 | module F2 : functor () -> sig end = F1;; (* fail *)
+                                        ^^
+Error: Signature mismatch:
+       Modules do not match:
+         functor (X : sig end) -> sig end
+       is not included in
+         functor () -> sig end
+|}];;
+module F3 () = struct end;;
+module F4 : functor (X : sig end) -> sig end = F3;; (* fail *)
+[%%expect{|
+module F3 : functor () -> 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 () -> sig end
+       is not included in
+         functor (X : sig end) -> sig end
+|}];;
+
+(* tests for shortened functor notation () *)
+module X (X: sig end) (Y: sig end) = functor (Z: sig end) -> struct end;;
+module Y = functor (X: sig end) (Y:sig end) -> functor (Z: sig end) ->
+  struct end;;
+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 Z : sig end -> sig end -> sig end -> sig end
+module GZ : functor (X : sig end) () (Z : sig end) -> sig end
+|}];;
diff --git a/testsuite/tests/typing-modules/illegal_permutation.ml b/testsuite/tests/typing-modules/illegal_permutation.ml
new file mode 100644
index 00000000..5a5998da
--- /dev/null
+++ b/testsuite/tests/typing-modules/illegal_permutation.ml
@@ -0,0 +1,630 @@
+(* TEST
+* expect
+*)
+class type ct = object end
+module type s = sig type a val one:int type b class two:ct type c type exn+=Three type d end
+module type c12 = sig type a class two:ct type b val one:int type c type exn+=Three type d end
+module type c123 = sig type a type exn+=Three type b class two:ct type c val one:int type d end
+
+module type expected = sig module type x = s end
+
+module A: expected = struct module type x = c12 end
+[%%expect {|
+class type ct = object  end
+module type s =
+  sig
+    type a
+    val one : int
+    type b
+    class two : ct
+    type c
+    type exn += Three
+    type d
+  end
+module type c12 =
+  sig
+    type a
+    class two : ct
+    type b
+    val one : int
+    type c
+    type exn += Three
+    type d
+  end
+module type c123 =
+  sig
+    type a
+    type exn += Three
+    type b
+    class two : ct
+    type c
+    val one : int
+    type d
+  end
+module type expected = sig module type x = s end
+Line 8, characters 21-51:
+8 | module A: expected = struct module type x = c12 end
+                         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig module type x = c12 end
+       is not included in
+         expected
+       Module type declarations do not match:
+         module type x = c12
+       does not match
+         module type x = s
+       At position module type x = 
+       Illegal permutation of runtime components in a module type.
+         For example,
+         the class "two" and the value "one" are not in the same order
+         in the expected and actual module types.
+|}]
+
+module B: expected = struct module type x = c123 end
+[%%expect {|
+Line 1, characters 21-52:
+1 | module B: expected = struct module type x = c123 end
+                         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig module type x = c123 end
+       is not included in
+         expected
+       Module type declarations do not match:
+         module type x = c123
+       does not match
+         module type x = s
+       At position module type x = 
+       Illegal permutation of runtime components in a module type.
+         For example,
+         the exception "Three" and the value "one" are not in the same order
+         in the expected and actual module types.
+|}]
+
+
+module Far: sig
+  module type x = sig
+    val a:int
+    val b: int
+    val c: int
+    val d: int
+    val e:int
+  end
+end = struct
+  module type x = sig
+    val a:int
+    val b:int
+    val e:int
+    val d:int
+    val c:int
+  end
+end
+[%%expect {|
+Lines 9-17, characters 6-3:
+ 9 | ......struct
+10 |   module type x = sig
+11 |     val a:int
+12 |     val b:int
+13 |     val e:int
+14 |     val d:int
+15 |     val c:int
+16 |   end
+17 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig
+           module type x =
+             sig
+               val a : int
+               val b : int
+               val e : int
+               val d : int
+               val c : int
+             end
+         end
+       is not included in
+         sig
+           module type x =
+             sig
+               val a : int
+               val b : int
+               val c : int
+               val d : int
+               val e : int
+             end
+         end
+       Module type declarations do not match:
+         module type x =
+           sig
+             val a : int
+             val b : int
+             val e : int
+             val d : int
+             val c : int
+           end
+       does not match
+         module type x =
+           sig
+             val a : int
+             val b : int
+             val c : int
+             val d : int
+             val e : int
+           end
+       At position module type x = 
+       Illegal permutation of runtime components in a module type.
+         For example,
+         the value "e" and the value "c" are not in the same order
+         in the expected and actual module types.
+|}]
+
+module Confusing: sig
+  module type x= sig
+    class x:ct
+    val x:int
+  end
+end = struct
+  module type x= sig
+    val x:int
+    class x:ct
+  end
+end
+[%%expect {|
+Lines 6-11, characters 6-3:
+ 6 | ......struct
+ 7 |   module type x= sig
+ 8 |     val x:int
+ 9 |     class x:ct
+10 |   end
+11 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig module type x = sig val x : int class x : ct end end
+       is not included in
+         sig module type x = sig class x : ct val x : int end end
+       Module type declarations do not match:
+         module type x = sig val x : int class x : ct end
+       does not match
+         module type x = sig class x : ct val x : int end
+       At position module type x = 
+       Illegal permutation of runtime components in a module type.
+         For example,
+         the value "x" and the class "x" are not in the same order
+         in the expected and actual module types.
+|}]
+
+module MT: sig
+  module type a = sig
+    module type b = sig
+      val x:int
+      val y:int
+    end
+  end
+end = struct
+  module type a = sig
+    module type b = sig
+      val y:int
+      val x:int
+    end
+  end
+end
+[%%expect {|
+Lines 8-15, characters 6-3:
+ 8 | ......struct
+ 9 |   module type a = sig
+10 |     module type b = sig
+11 |       val y:int
+12 |       val x:int
+13 |     end
+14 |   end
+15 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig
+           module type a =
+             sig module type b = sig val y : int val x : int end end
+         end
+       is not included in
+         sig
+           module type a =
+             sig module type b = sig val x : int val y : int end end
+         end
+       Module type declarations do not match:
+         module type a =
+           sig module type b = sig val y : int val x : int end end
+       does not match
+         module type a =
+           sig module type b = sig val x : int val y : int end end
+       At position module type a = 
+       Modules do not match:
+         sig module type b = sig val y : int val x : int end end
+       is not included in
+         sig module type b = sig val x : int val y : int end end
+       At position module type a = 
+       Module type declarations do not match:
+         module type b = sig val y : int val x : int end
+       does not match
+         module type b = sig val x : int val y : int end
+       At position module type a = sig module type b =  end
+       Illegal permutation of runtime components in a module type.
+         For example,
+         the value "y" and the value "x" are not in the same order
+         in the expected and actual module types.
+|}]
+
+class type ct = object end
+module Classes: sig
+  module type x = sig
+    class a: ct
+    class b: ct
+  end
+end = struct
+  module type x = sig
+    class b: ct
+    class a: ct
+  end
+end
+[%%expect{|
+class type ct = object  end
+Lines 7-12, characters 6-3:
+ 7 | ......struct
+ 8 |   module type x = sig
+ 9 |     class b: ct
+10 |     class a: ct
+11 |   end
+12 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig module type x = sig class b : ct class a : ct end end
+       is not included in
+         sig module type x = sig class a : ct class b : ct end end
+       Module type declarations do not match:
+         module type x = sig class b : ct class a : ct end
+       does not match
+         module type x = sig class a : ct class b : ct end
+       At position module type x = 
+       Illegal permutation of runtime components in a module type.
+         For example,
+         the class "b" and the class "a" are not in the same order
+         in the expected and actual module types.
+|}]
+
+module Ext: sig
+  module type x = sig
+    type exn+=A
+    type exn+=B
+  end
+end = struct
+  module type x = sig
+    type exn+=B
+    type exn+=A
+  end
+end
+[%%expect{|
+Lines 6-11, characters 6-3:
+ 6 | ......struct
+ 7 |   module type x = sig
+ 8 |     type exn+=B
+ 9 |     type exn+=A
+10 |   end
+11 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig module type x = sig type exn += B type exn += A end end
+       is not included in
+         sig module type x = sig type exn += A type exn += B end end
+       Module type declarations do not match:
+         module type x = sig type exn += B type exn += A end
+       does not match
+         module type x = sig type exn += A type exn += B end
+       At position module type x = 
+       Illegal permutation of runtime components in a module type.
+         For example,
+         the exception "B" and the exception "A" are not in the same order
+         in the expected and actual module types.
+|}]
+
+
+module type w = sig
+  module One:s
+  module Two:s
+end
+
+module type w21 = sig
+  module Two:s
+  module One:s
+end
+
+module type wOne21 = sig
+  module One:c12
+  module Two:s
+end
+
+module C: sig module type x = w end = struct module type x = w21 end
+[%%expect {|
+module type w = sig module One : s module Two : s end
+module type w21 = sig module Two : s module One : s end
+module type wOne21 = sig module One : c12 module Two : s end
+Line 16, characters 38-68:
+16 | module C: sig module type x = w end = struct module type x = w21 end
+                                           ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig module type x = w21 end
+       is not included in
+         sig module type x = w end
+       Module type declarations do not match:
+         module type x = w21
+       does not match
+         module type x = w
+       At position module type x = 
+       Illegal permutation of runtime components in a module type.
+         For example,
+         the module "Two" and the module "One" are not in the same order
+         in the expected and actual module types.
+|}]
+
+module D: sig module type x = w end = struct module type x = wOne21 end
+[%%expect {|
+Line 1, characters 38-71:
+1 | module D: sig module type x = w end = struct module type x = wOne21 end
+                                          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig module type x = wOne21 end
+       is not included in
+         sig module type x = w end
+       Module type declarations do not match:
+         module type x = wOne21
+       does not match
+         module type x = w
+       At position module type x = 
+       Illegal permutation of runtime components in a module type.
+         For example, in module One,
+         the class "two" and the value "one" are not in the same order
+         in the expected and actual module types.
+|}]
+
+module F1: sig module type x = functor(X:s) -> s end =
+struct
+  module type x = functor(X:c12) -> s
+end
+[%%expect {|
+Lines 2-4, characters 0-3:
+2 | struct
+3 |   module type x = functor(X:c12) -> s
+4 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig module type x = functor (X : c12) -> s end
+       is not included in
+         sig module type x = functor (X : s) -> s end
+       Module type declarations do not match:
+         module type x = functor (X : c12) -> s
+       does not match
+         module type x = functor (X : s) -> s
+       At position module type x = 
+       Illegal permutation of runtime components in a module type.
+         For example, at position functor (X : ) -> ...,
+         the class "two" and the value "one" are not in the same order
+         in the expected and actual module types.
+|}]
+
+module F2: sig module type x = functor(X:s) -> s end =
+struct
+  module type x = functor(X:s) -> c12
+end
+[%%expect {|
+Lines 2-4, characters 0-3:
+2 | struct
+3 |   module type x = functor(X:s) -> c12
+4 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig module type x = functor (X : s) -> c12 end
+       is not included in
+         sig module type x = functor (X : s) -> s end
+       Module type declarations do not match:
+         module type x = functor (X : s) -> c12
+       does not match
+         module type x = functor (X : s) -> s
+       At position module type x = 
+       Illegal permutation of runtime components in a module type.
+         For example, at position functor (X) -> ,
+         the class "two" and the value "one" are not in the same order
+         in the expected and actual module types.
+|}]
+
+module Nested: sig
+  module type x = sig
+    module A: sig
+      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)
+          -> sig end
+      end
+    end
+  end
+end=struct
+  module type x = sig
+    module A: sig
+      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)
+          -> sig end
+      end
+    end
+  end
+end
+[%%expect {|
+Lines 22-43, characters 4-3:
+22 | ....struct
+23 |   module type x = sig
+24 |     module A: sig
+25 |       module B: sig
+26 |         module C: functor(X:sig end)(Y:sig end)
+...
+40 |       end
+41 |     end
+42 |   end
+43 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig
+           module type x =
+             sig
+               module A :
+                 sig
+                   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)
+                           -> sig end
+                     end
+                 end
+             end
+         end
+       is not included in
+         sig
+           module type x =
+             sig
+               module A :
+                 sig
+                   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)
+                           -> sig end
+                     end
+                 end
+             end
+         end
+       Module type declarations do not match:
+         module type x =
+           sig
+             module A :
+               sig
+                 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)
+                         -> sig end
+                   end
+               end
+           end
+       does not match
+         module type x =
+           sig
+             module A :
+               sig
+                 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)
+                         -> sig end
+                   end
+               end
+           end
+       At position module type x = 
+       Illegal permutation of runtime components in a module type.
+         For example,
+         at position
+           module A :
+             sig
+               module B :
+                 sig
+                   module C(X)(Y)(Z :
+                     sig
+                       module D :
+                         sig
+                           module E : sig module F(X)(Arg : ) : ... end
+                         end
+                     end) : ...
+                 end
+             end,
+         the value "two" and the value "one" are not in the same order
+         in the expected and actual module types.
+|}]
diff --git a/testsuite/tests/typing-modules/merge_constraint.ml b/testsuite/tests/typing-modules/merge_constraint.ml
new file mode 100644
index 00000000..a26bf835
--- /dev/null
+++ b/testsuite/tests/typing-modules/merge_constraint.ml
@@ -0,0 +1,248 @@
+(* TEST
+   * expect *)
+
+(* #9623 *)
+
+module RhsScopeCheck = struct
+  module type Sig1 = sig
+    type t
+    type u = t
+  end
+
+  (* A scoping error here is intentional:
+     with-constraints "with  = "
+     have their  evaluated in the current
+     typing environment, not within the signature
+     that they are constraining. [t] is unbound
+     in the current environment, so [with u = t]
+     must be rejected. *)
+  module type Check1 = Sig1
+    with type u = t
+end
+[%%expect{|
+Line 15, characters 18-19:
+15 |     with type u = t
+                       ^
+Error: Unbound type constructor t
+|}]
+
+
+module VarianceEnv = struct
+  module type Sig = sig
+    type +'a abstract
+    type +'a user = Foo of 'a abstract
+  end
+
+  module type Problem = sig
+    include Sig
+    module M : Sig
+      with type 'a abstract = 'a abstract
+       and type 'a user = 'a user
+
+    (* the variance annotation of [+'a foo] should be accepted, which
+       would not be the case if the with-constraint [and type 'a
+       user = 'a user] had its variance type-checked in the wrong typing
+       environment: see #9624 *)
+    type +'a foo = 'a M.user
+  end
+end
+[%%expect{|
+module VarianceEnv :
+  sig
+    module type Sig =
+      sig type +'a abstract type 'a user = Foo of 'a abstract end
+    module type Problem =
+      sig
+        type +'a abstract
+        type 'a user = Foo of 'a abstract
+        module M :
+          sig
+            type 'a abstract = 'a abstract
+            type 'a user = 'a user = Foo of 'a abstract
+          end
+        type 'a foo = 'a M.user
+      end
+  end
+|}]
+
+module UnboxedEnv = struct
+  module type Sig = sig
+    type 'a ind = 'a * int
+    type t = T : 'e ind -> t [@@unboxed]
+  end
+
+  module type Problem = sig
+    include Sig
+    module type ReboundSig = Sig
+      with type 'a ind = 'a ind
+       and type t = t
+    (* the with-definition [and type t = t] above should be accepted,
+       which would not be the case if its definition had separability
+       checked in the wrong typing environment: see #9624 *)
+  end
+end
+[%%expect{|
+module UnboxedEnv :
+  sig
+    module type Sig =
+      sig type 'a ind = 'a * int type t = T : 'e ind -> t [@@unboxed] end
+    module type Problem =
+      sig
+        type 'a ind = 'a * int
+        type t = T : 'e ind -> t [@@unboxed]
+        module type ReboundSig =
+          sig
+            type 'a ind = 'a ind
+            type t = t/2 = T : 'a ind -> t/1 [@@unboxed]
+          end
+      end
+  end
+|}]
+
+(* We can also have environment issues when unifying type parameters;
+   regression test contributed by Jacques Garrigue in #9623. *)
+module ParamsUnificationEnv = struct
+  module type Sig =
+    sig type 'a u = 'a list type +'a t constraint 'a = 'b u end
+  type +'a t = 'b constraint 'a = 'b list
+  module type Sig2 = Sig with type +'a t = 'a t
+end
+[%%expect{|
+module ParamsUnificationEnv :
+  sig
+    module type Sig =
+      sig type 'a u = 'a list type +'a t constraint 'a = 'b u end
+    type +'a t = 'b constraint 'a = 'b list
+    module type Sig2 =
+      sig type 'a u = 'a list type +'a t = 'a t constraint 'a = 'b u end
+  end
+|}]
+
+
+(* The construction of the "signature environment" was also broken
+   in earlier versions of the code. Regression test by Leo White in #9623. *)
+module CorrectEnvConstructionTest = struct
+  module type Sig = sig
+    type +'a user = Foo of 'a abstract
+    and +'a abstract
+  end
+
+  module type Problem = sig
+    include Sig
+    module M : Sig
+      with type 'a abstract = 'a abstract
+       and type 'a user = 'a user
+    type +'a foo = 'a M.user
+  end
+end
+[%%expect{|
+module CorrectEnvConstructionTest :
+  sig
+    module type Sig =
+      sig type 'a user = Foo of 'a abstract and +'a abstract end
+    module type Problem =
+      sig
+        type 'a user = Foo of 'a abstract
+        and +'a abstract
+        module M :
+          sig
+            type 'a user = 'a user = Foo of 'a abstract
+            and 'a abstract = 'a abstract
+          end
+        type 'a foo = 'a M.user
+      end
+  end
+|}]
+
+(* #9640 *)
+
+module type Packet_type = sig
+  type t
+end
+module type Unpacked_header = sig
+  module Packet_type : Packet_type
+  type t
+  val f : t -> Packet_type.t -> unit
+end
+module type Header = sig
+  module Packet_type : Packet_type
+  module Unpacked : Unpacked_header with module Packet_type := Packet_type
+end
+module type S = sig
+  module Packet_type : Packet_type
+  module Header : Header with module Packet_type = Packet_type
+end
+[%%expect{|
+module type Packet_type = sig type t end
+module type Unpacked_header =
+  sig
+    module Packet_type : Packet_type
+    type t
+    val f : t -> Packet_type.t -> unit
+  end
+module type Header =
+  sig
+    module Packet_type : Packet_type
+    module Unpacked : sig type t val f : t -> Packet_type.t -> unit end
+  end
+module type S =
+  sig
+    module Packet_type : Packet_type
+    module Header :
+      sig
+        module Packet_type : sig type t = Packet_type.t end
+        module Unpacked : sig type t val f : t -> Packet_type.t -> unit end
+      end
+  end
+|}]
+module type Iobuf_packet = sig
+  module Make (Header : Header) () :
+    S
+    with module Packet_type = Header.Packet_type
+    with module Header.Unpacked = Header.Unpacked
+end
+[%%expect{|
+module type Iobuf_packet =
+  sig
+    module Make :
+      functor (Header : Header) () ->
+        sig
+          module Packet_type : sig type t = Header.Packet_type.t end
+          module Header :
+            sig
+              module Packet_type : sig type t = Packet_type.t end
+              module Unpacked :
+                sig
+                  type t = Header.Unpacked.t
+                  val f : t -> Header.Packet_type.t -> unit
+                end
+            end
+        end
+  end
+|}]
+
+(* Simpler example by @gasche *)
+module type S = sig
+  type t
+  type u = t
+end
+module type Pack = sig
+  module M : S
+end
+[%%expect{|
+module type S = sig type t type u = t end
+module type Pack = sig module M : S end
+|}]
+module type Weird = sig
+  module M : S
+  module P : Pack
+    with type M.t = M.t
+    with type M.u = M.u
+end
+[%%expect{|
+module type Weird =
+  sig
+    module M : S
+    module P : sig module M : sig type t = M.t type u = M.u end end
+  end
+|}]
diff --git a/testsuite/tests/typing-modules/nondep.ml b/testsuite/tests/typing-modules/nondep.ml
new file mode 100644
index 00000000..6662dc5b
--- /dev/null
+++ b/testsuite/tests/typing-modules/nondep.ml
@@ -0,0 +1,21 @@
+(* TEST
+   * expect
+*)
+
+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 M = F(struct type t = T end);;
+[%%expect{|
+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
+       The parameter cannot be eliminated in the result type.
+       Please bind the argument to a module identifier.
+|}]
diff --git a/testsuite/tests/typing-modules/nondep_private_abbrev.ml b/testsuite/tests/typing-modules/nondep_private_abbrev.ml
new file mode 100644
index 00000000..4c8e4e1e
--- /dev/null
+++ b/testsuite/tests/typing-modules/nondep_private_abbrev.ml
@@ -0,0 +1,137 @@
+(* TEST
+   * expect
+*)
+
+module F(_ : sig end) : sig
+  type t = private int
+end = struct
+  type t = int
+end;;
+[%%expect{|
+module F : sig end -> sig type t = private int end
+|}]
+
+module Direct = F(struct end);;
+[%%expect{|
+module Direct : sig type t = private int end
+|}]
+
+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 Indirect = G(struct end);;
+[%%expect{|
+module Indirect : sig type t = private int end
+|}]
+
+(* unroll_abbrev *)
+
+module Pub(_ : sig end) = struct
+  type t = [ `Foo of t ]
+end;;
+[%%expect{|
+module Pub : sig end -> sig type t = [ `Foo of t ] end
+|}]
+
+module Priv(_ : sig end) = struct
+  type t = private [ `Foo of t ]
+end;;
+[%%expect{|
+module Priv : sig end -> sig type t = private [ `Foo of t ] end
+|}]
+
+module DirectPub = Pub(struct end);;
+[%%expect{|
+module DirectPub : sig type t = [ `Foo of t ] end
+|}]
+
+module DirectPriv = Priv(struct end);;
+[%%expect{|
+module DirectPriv : sig type t = private [ `Foo of t ] end
+|}]
+
+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 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 IndirectPub = H(struct end);;
+[%%expect{|
+module IndirectPub : sig type t = [ `Foo of 'a ] as 'a end
+|}]
+
+(* The result would be
+   {[
+     type t = private [ `Foo of t ]
+   ]}
+   if we were unrolling the abbrev.  *)
+module IndirectPriv = I(struct end);;
+[%%expect{|
+module IndirectPriv : sig type t end
+|}]
+
+(*** Test proposed by Jacques in
+     https://github.com/ocaml/ocaml/pull/1826#discussion_r194290729 ***)
+
+(* Baseline *)
+
+type t = private [ `Bar of int | `Foo of t -> int ];;
+[%%expect{|
+type t = private [ `Bar of int | `Foo of t -> int ]
+|}]
+
+module M : sig
+  type s = private [ `Bar of int | `Foo of 'a -> int ] as 'a
+end = struct
+  type s = t
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type s = t
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type s = t end
+       is not included in
+         sig type s = private [ `Bar of int | `Foo of 'a -> int ] as 'a end
+       Type declarations do not match:
+         type s = t
+       is not included in
+         type s = private [ `Bar of int | `Foo of 'a -> int ] as 'a
+|}]
+
+(* nondep_type_decl + nondep_type_rec *)
+
+module Priv(_ : sig end) = struct
+  type t = private [ `Foo of t -> int | `Bar of int ]
+end;;
+[%%expect{|
+module Priv :
+  sig end -> sig type t = private [ `Bar of int | `Foo of t -> int ] 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 IndirectPriv = I(struct end);;
+[%%expect{|
+module IndirectPriv : sig type t end
+|}]
diff --git a/testsuite/tests/typing-modules/normalize_path.ml b/testsuite/tests/typing-modules/normalize_path.ml
new file mode 100644
index 00000000..44f45ef4
--- /dev/null
+++ b/testsuite/tests/typing-modules/normalize_path.ml
@@ -0,0 +1,17 @@
+(* TEST
+   * expect
+*)
+
+module X = struct
+
+  module B = List
+
+  exception B of {x:int}
+end
+
+let _ = X.B {x=2}
+;;
+[%%expect{|
+module X : sig module B = List exception B of { x : int; } end
+- : exn = X.B {x = 2}
+|}]
diff --git a/testsuite/tests/typing-modules/pr5911.ml b/testsuite/tests/typing-modules/pr5911.ml
new file mode 100644
index 00000000..1c08b37a
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr5911.ml
@@ -0,0 +1,27 @@
+(* TEST
+   * expect
+*)
+
+module type S = sig
+ type t
+ val x : t
+end;;
+
+module Good (X : S with type t := unit) = struct
+ let () = X.x
+end;;
+[%%expect{|
+module type S = sig type t val x : t end
+module Good : functor (X : sig val x : unit end) -> sig end
+|}];;
+
+module type T = sig module M : S end;;
+
+module Bad (X : T with type M.t = unit) = struct
+ let () = X.M.x
+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
+|}];;
diff --git a/testsuite/tests/typing-modules/pr6394.ml b/testsuite/tests/typing-modules/pr6394.ml
new file mode 100644
index 00000000..97bbeebf
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr6394.ml
@@ -0,0 +1,27 @@
+(* TEST
+   * expect
+*)
+
+[@@@ ocaml.warning "+4"]
+module rec X : sig
+  type t = int * bool
+end = struct
+  type t = A | B
+  let f = function A | B -> 0
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 |   type t = A | B
+6 |   let f = function A | B -> 0
+7 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = X.t = A | B val f : t -> int end
+       is not included in
+         sig type t = int * bool end
+       Type declarations do not match:
+         type t = X.t = A | B
+       is not included in
+         type t = int * bool
+|}];;
diff --git a/testsuite/tests/typing-modules/pr7207.ml b/testsuite/tests/typing-modules/pr7207.ml
new file mode 100644
index 00000000..a061a34d
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr7207.ml
@@ -0,0 +1,13 @@
+(* TEST
+   * expect
+*)
+
+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
+Line 2, characters 9-28:
+2 | type t = F(Does_not_exist).t;;
+             ^^^^^^^^^^^^^^^^^^^
+Error: Unbound module Does_not_exist
+|}];;
diff --git a/testsuite/tests/typing-modules/pr7348.ml b/testsuite/tests/typing-modules/pr7348.ml
new file mode 100644
index 00000000..dc0cf405
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr7348.ml
@@ -0,0 +1,41 @@
+(* TEST
+   * expect
+*)
+
+module F (X : sig type t = private < foo:int; ..> val x : t end) = struct
+  let x : < foo: int; ..> = X.x
+end;;
+[%%expect{|
+module F :
+  functor (X : sig type t = private < foo : int; .. > val x : t end) ->
+    sig val x : X.t end
+|}]
+
+module M = struct
+  type t = < foo: int; bar: int>
+  let x = object
+    method foo = 0
+    method bar = 0
+  end
+end;;
+[%%expect{|
+module M :
+  sig type t = < bar : int; foo : int > val x : < bar : int; foo : int > end
+|}]
+
+module N = F(M);;
+[%%expect{|
+module N : sig val x : M.t end
+|}]
+
+module A : sig end = struct
+  module F (X : sig type t = private < foo:int; ..> val x : t end) = struct
+    let x : < foo: int; ..> = X.x
+  end
+
+  module N = F(M)
+  let _ = (N.x = M.x)
+end;;
+[%%expect{|
+module A : sig end
+|}]
diff --git a/testsuite/tests/typing-modules/pr7726.ml b/testsuite/tests/typing-modules/pr7726.ml
new file mode 100644
index 00000000..c404983f
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr7726.ml
@@ -0,0 +1,150 @@
+(* TEST
+   * expect
+*)
+
+module type T = sig type t end
+module Fix(F:(T -> T)) = struct
+  module rec Fixed : T with type t = F(Fixed).t = F(Fixed)
+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
+|}]
+
+module T1 = Fix(functor (X:sig type t end) -> struct type t = X.t option end);;
+[%%expect{|
+Line 1, characters 12-77:
+1 | module T1 = Fix(functor (X:sig type t end) -> struct type t = X.t option end);;
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In the signature of this functor application:
+       The type abbreviation Fixed.t is cyclic
+|}]
+module T2 = Fix(functor (X:sig type t end) -> struct type t = X.t end);;
+[%%expect{|
+Line 1, characters 12-70:
+1 | module T2 = Fix(functor (X:sig type t end) -> struct type t = X.t end);;
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In the signature of this functor application:
+       The definition of Fixed.t contains a cycle:
+       F(Fixed).t
+|}]
+
+(* Positive example *)
+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 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
+|}]
+
+(* Torture the type checker more *)
+module M = struct
+  module F (X : T) : T = X
+  module rec Fixed : sig type t = F(Fixed).t end = Fixed
+end
+module type S = module type of M
+module Id (X : T) = X;;
+[%%expect{|
+module M :
+  sig
+    module F : functor (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 rec Fixed : sig type t = F(Fixed).t end
+  end
+module Id : functor (X : T) -> sig type t = X.t end
+|}]
+
+module type Bad = S with module F = Id;;
+[%%expect{|
+Line 1, characters 18-38:
+1 | module type Bad = S with module F = Id;;
+                      ^^^^^^^^^^^^^^^^^^^^
+Error: In this instantiated signature:
+       The definition of Fixed.t contains a cycle:
+       F(Fixed).t
+|}]
+
+(* More examples by lpw25 *)
+module M = Fix(Id);;
+[%%expect{|
+Line 1, characters 11-18:
+1 | module M = Fix(Id);;
+               ^^^^^^^
+Error: In the signature of this functor application:
+       The definition of Fixed.t contains a cycle:
+       Id(Fixed).t
+|}]
+type t = Fix(Id).Fixed.t;;
+[%%expect{|
+Line 1, characters 9-24:
+1 | type t = Fix(Id).Fixed.t;;
+             ^^^^^^^^^^^^^^^
+Error: In the signature of Fix(Id):
+       The definition of Fixed.t contains a cycle:
+       Id(Fixed).t
+|}]
+let f (x : Fix(Id).Fixed.t) = x;;
+[%%expect{|
+Line 1, characters 11-26:
+1 | let f (x : Fix(Id).Fixed.t) = x;;
+               ^^^^^^^^^^^^^^^
+Error: In the signature of Fix(Id):
+       The definition of Fixed.t contains a cycle:
+       Id(Fixed).t
+|}]
+
+module Foo (F : T -> T) = struct
+    let f (x : Fix(F).Fixed.t) = x
+  end
+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 M : sig val f : Fix(Id).Fixed.t -> Fix(Id).Fixed.t end
+Line 1:
+Error: In the signature of Fix(Id):
+       The definition of Fixed.t contains a cycle:
+       Id(Fixed).t
+|}]
+
+(* Extra tests for GPR#1676 *)
+module F() = struct type t end
+module M = struct end;;
+type t = F(M).t;;
+[%%expect{|
+module F : functor () -> sig type t end
+module M : sig end
+Line 3, characters 9-15:
+3 | type t = F(M).t;;
+             ^^^^^^
+Error: The functor F is generative, it cannot be applied in type expressions
+|}]
+
+module Fix2(F:(T -> T)) = struct
+  module rec Fixed : T with type t = F(Fixed).t = F(Fixed)
+  module R(X:sig end) = struct type t = Fixed.t end
+end;;
+let f (x : Fix2(Id).R(M).t) = x;;
+[%%expect{|
+module Fix2 :
+  functor (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
+    end
+Line 5, characters 11-26:
+5 | let f (x : Fix2(Id).R(M).t) = x;;
+               ^^^^^^^^^^^^^^^
+Error: In the signature of Fix2(Id):
+       The definition of Fixed.t contains a cycle:
+       Id(Fixed).t
+|}]
diff --git a/testsuite/tests/typing-modules/pr7787.ml b/testsuite/tests/typing-modules/pr7787.ml
new file mode 100644
index 00000000..4738df38
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr7787.ml
@@ -0,0 +1,45 @@
+(* TEST
+   * expect
+*)
+
+module O (T : sig
+    module N : sig
+      val foo : int -> int
+    end
+  end) = struct
+  open T
+
+  let go () =
+    N.foo 42 (* finding N (from T) goes wrong *)
+end
+
+module T = struct
+  module N = struct
+    let foo x = x + 3
+  end
+end;;
+[%%expect{|
+module O :
+  functor (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
+|}]
+
+(* Incidentally, M isn't used in T2, but it doesn't seem to fail if
+   it's just "module M" and "module T2" separately *)
+module rec M : sig
+  val go : unit -> int
+end = O (T2)
+and T2 : sig
+  include module type of struct include T end
+end = struct
+  include T
+end;;
+[%%expect{|
+module rec M : sig val go : unit -> int end
+and T2 : sig module N = T.N end
+|}]
+
+let () = ignore (M.go ())
+[%%expect{|
+|}]
diff --git a/testsuite/tests/typing-modules/pr7818.ml b/testsuite/tests/typing-modules/pr7818.ml
new file mode 100644
index 00000000..62ed82fa
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr7818.ml
@@ -0,0 +1,328 @@
+(* TEST
+   * expect
+*)
+
+(* cannot_alias.ml *)
+module Termsig = struct
+  module Term0 = struct
+    module type S = sig
+      module Id : sig end
+    end
+  end
+  module Term = struct
+    module type S = sig
+      module Term0 : Term0.S
+      module T = Term0
+    end
+  end
+end;;
+[%%expect{|
+module Termsig :
+  sig
+    module Term0 : sig module type S = sig module Id : sig end end end
+    module Term :
+      sig module type S = sig module Term0 : Term0.S module T = Term0 end end
+  end
+|}]
+
+module Make1 (T' : Termsig.Term.S) = struct
+  module T = struct
+    include T'.T
+    let u = 1
+  end
+end;;
+[%%expect{|
+module Make1 :
+  functor
+    (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
+|}]
+
+module Make2 (T' : Termsig.Term.S) = struct
+  module T = struct
+    include T'.T
+    module Id2 = Id
+    let u = 1
+  end
+end;;
+[%%expect{|
+module Make2 :
+  functor
+    (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
+    end
+|}]
+
+module Make3 (T' : Termsig.Term.S) = struct
+  module T = struct
+    include T'.T
+    module Id2 = Id
+    let u = 1
+    let u = 1
+  end
+end;;
+[%%expect{|
+module Make3 :
+  functor
+    (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
+    end
+|}]
+
+(* cannot_alias2.ml *)
+module type S = sig
+  module Term0 : sig module Id : sig end end
+  module T = Term0
+end;;
+
+module Make1 (T' : S)  = struct
+  module Id = T'.T.Id
+  module Id2 = Id
+end;;
+[%%expect{|
+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)
+    -> sig module Id : sig end module Id2 = Id end
+|}]
+
+module Make2 (T' : S) : sig module Id : sig end module Id2 = Id end
+                        with module Id := T'.Term0.Id  = struct
+  module Id = T'.T.Id
+  module Id2 = Id
+end;;
+[%%expect{|
+Lines 2-5, characters 57-3:
+2 | .........................................................struct
+3 |   module Id = T'.T.Id
+4 |   module Id2 = Id
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig module Id : sig end module Id2 = Id end
+       is not included in
+         sig module Id2 = T'.Term0.Id end
+       In module Id2:
+       Module T'.Term0.Id cannot be aliased
+|}]
+
+module Make3 (T' : S) = struct
+  module T = struct
+    module Id = T'.T.Id
+    module Id2 = Id
+    let u = 1
+    let u = 1
+  end
+end;;
+[%%expect{|
+module Make3 :
+  functor
+    (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
+    end
+|}]
+
+(* unsoundness if Make1 returned an Id.x field *)
+module M = Make1 (struct module Term0 =
+  struct module Id = struct let x = "a" end end module T = Term0 end);;
+M.Id.x;;
+[%%expect{|
+module M : sig module Id : sig end module Id2 = Id end
+Line 3, characters 0-6:
+3 | M.Id.x;;
+    ^^^^^^
+Error: Unbound value M.Id.x
+|}]
+
+
+(* cannot_alias3.ml *)
+module MkT(X : sig end) = struct type t end
+module type S = sig
+  module Term0 : sig module Id : sig end end
+  module T = Term0
+  type t = MkT(T).t
+end;;
+
+module Make1 (T' : S)  = struct
+  module Id = T'.T.Id
+  module Id2 = Id
+  type t = T'.t
+end;;
+
+module IS = struct
+  module Term0 = struct module Id = struct let x = "a" end end
+  module T = Term0
+  type t = MkT(T).t
+end;;
+
+module M = Make1(IS);;
+[%%expect{|
+module MkT : functor (X : sig end) -> sig type t end
+module type S =
+  sig
+    module Term0 : sig module Id : sig end end
+    module T = Term0
+    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)
+    -> sig module Id : sig end module Id2 = Id type t = T'.t end
+module IS :
+  sig
+    module Term0 : sig module Id : sig val x : string end end
+    module T = Term0
+    type t = MkT(T).t
+  end
+module M : sig module Id : sig end module Id2 = Id type t = IS.t end
+|}]
+
+
+(* cannot_alias4.ml *)
+(* Can be used to break module abstraction *)
+(* Still sound ? *)
+(* It seems to only work if Term0 and Term contain identical types *)
+(* It may also be possible to do the same thing using
+   Mtype.nondep_supertype anyway *)
+type (_,_) eq = Eq : ('a,'a) eq
+module MkT(X : Set.OrderedType) = Set.Make(X)
+module type S = sig
+  module Term0 : Set.OrderedType with type t = int
+  module T = Term0
+  type t = E of (MkT(T).t,MkT(T).t) eq
+  type u = t = E of (MkT(Term0).t,MkT(T).t) eq
+end;;
+module F(X:S) = X;;
+module rec M : S = M;;
+module M' = F(M);;
+module type S' = module type of M';;
+module Asc = struct type t = int let compare x y = x - y end;;
+module Desc = struct type t = int let compare x y = y - x end;;
+module rec M1 : S' with module Term0 := Asc and module T := Desc = M1;;
+(* And now we have a witness of MkT(Asc).t = MkT(Desc).t ... *)
+let (E eq : M1.u) = (E Eq : M1.t);;
+[%%expect{|
+type (_, _) eq = Eq : ('a, 'a) eq
+module MkT :
+  functor (X : Set.OrderedType) ->
+    sig
+      type elt = X.t
+      type t = Set.Make(X).t
+      val empty : t
+      val is_empty : t -> bool
+      val mem : elt -> t -> bool
+      val add : elt -> t -> t
+      val singleton : elt -> t
+      val remove : elt -> t -> t
+      val union : t -> t -> t
+      val inter : t -> t -> t
+      val disjoint : t -> t -> bool
+      val diff : t -> t -> t
+      val compare : t -> t -> int
+      val equal : t -> t -> bool
+      val subset : t -> t -> bool
+      val iter : (elt -> unit) -> t -> unit
+      val map : (elt -> elt) -> t -> t
+      val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
+      val for_all : (elt -> bool) -> t -> bool
+      val exists : (elt -> bool) -> t -> bool
+      val filter : (elt -> bool) -> t -> t
+      val filter_map : (elt -> elt option) -> t -> t
+      val partition : (elt -> bool) -> t -> t * t
+      val cardinal : t -> int
+      val elements : t -> elt list
+      val min_elt : t -> elt
+      val min_elt_opt : t -> elt option
+      val max_elt : t -> elt
+      val max_elt_opt : t -> elt option
+      val choose : t -> elt
+      val choose_opt : t -> elt option
+      val split : elt -> t -> t * bool * t
+      val find : elt -> t -> elt
+      val find_opt : elt -> t -> elt option
+      val find_first : (elt -> bool) -> t -> elt
+      val find_first_opt : (elt -> bool) -> t -> elt option
+      val find_last : (elt -> bool) -> t -> elt
+      val find_last_opt : (elt -> bool) -> t -> elt option
+      val of_list : elt list -> t
+      val to_seq_from : elt -> t -> elt Seq.t
+      val to_seq : t -> elt Seq.t
+      val add_seq : elt Seq.t -> t -> t
+      val of_seq : elt Seq.t -> t
+    end
+module type S =
+  sig
+    module Term0 : sig type t = int val compare : t -> t -> int end
+    module T = Term0
+    type t = E of (MkT(T).t, MkT(T).t) eq
+    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)
+    ->
+    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 = X.t = E of (MkT(T).t, MkT(T).t) eq
+      type u = t = E of (MkT(Term0).t, MkT(T).t) eq
+    end
+module rec M : S
+module M' :
+  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 = M.t = E of (MkT(T).t, MkT(T).t) eq
+    type u = t = E of (MkT(Term0).t, MkT(T).t) eq
+  end
+module type S' =
+  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 = M.t = E of (MkT(T).t, MkT(T).t) eq
+    type u = t = E of (MkT(Term0).t, MkT(T).t) eq
+  end
+module Asc : sig type t = int val compare : int -> int -> int end
+module Desc : sig type t = int val compare : int -> int -> int end
+Line 15, characters 0-69:
+15 | module rec M1 : S' with module Term0 := Asc and module T := Desc = M1;;
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type M.t
+       Constructors do not match:
+         E of (MkT(M.T).t, MkT(M.T).t) eq
+       is not compatible with:
+         E of (MkT(Desc).t, MkT(Desc).t) eq
+       The types are not equal.
+|}]
diff --git a/testsuite/tests/typing-modules/pr7851.ml b/testsuite/tests/typing-modules/pr7851.ml
new file mode 100644
index 00000000..bcd3281b
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr7851.ml
@@ -0,0 +1,87 @@
+(* TEST
+   * expect
+*)
+
+(* Leo's version *)
+module F(X : sig type t end) = struct
+  type x = X.t
+  type y = X.t
+  type t = E of x
+  type u = t = E of y
+end;;
+
+module M = F(struct type t end);;
+
+module type S = module type of M;;
+[%%expect{|
+module F :
+  functor (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
+|}]
+
+module rec M1 : S with type x = int and type y = bool = M1;;
+[%%expect{|
+Line 1, characters 0-58:
+1 | module rec M1 : S with type x = int and type y = bool = M1;;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type M1.t
+       Constructors do not match:
+         E of M1.x
+       is not compatible with:
+         E of M1.y
+       The types are not equal.
+|}]
+
+let bool_of_int x =
+  let (E y : M1.u) = (E x : M1.t) in
+  y;;
+
+bool_of_int 3;;
+[%%expect{|
+Line 2, characters 28-32:
+2 |   let (E y : M1.u) = (E x : M1.t) in
+                                ^^^^
+Error: Unbound module M1
+|}]
+
+(* Also check the original version *)
+type (_,_) eq = Eq : ('a,'a) eq
+module F(X : Set.OrderedType) = struct
+type x = Set.Make(X).t and y = Set.Make(X).t
+type t = E of (x,x) eq
+type u = t = E of (x,y) eq
+end;;
+module M = F(struct type t let compare = compare end);;
+module type S = module type of M;;
+[%%expect{|
+type (_, _) eq = Eq : ('a, 'a) eq
+module F :
+  functor (X : Set.OrderedType) ->
+    sig
+      type x = Set.Make(X).t
+      and y = Set.Make(X).t
+      type t = E of (x, x) eq
+      type u = t = E of (x, y) eq
+    end
+module M :
+  sig type x and y type t = E of (x, x) eq type u = t = E of (x, y) eq end
+module type S =
+  sig type x and y type t = E of (x, x) eq type u = t = E of (x, y) eq end
+|}]
+module rec M1 : S with type x = int and type y = bool = M1;;
+let (E eq : M1.u) = (E Eq : M1.t);;
+let cast : type a b. (a,b) eq -> a -> b = fun Eq x -> x;;
+cast eq 3;;
+[%%expect{|
+Line 1, characters 0-58:
+1 | module rec M1 : S with type x = int and type y = bool = M1;;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type M1.t
+       Constructors do not match:
+         E of (M1.x, M1.x) eq
+       is not compatible with:
+         E of (M1.x, M1.y) eq
+       The types are not equal.
+|}]
diff --git a/testsuite/tests/typing-modules/pr8810.ml b/testsuite/tests/typing-modules/pr8810.ml
new file mode 100644
index 00000000..57bfa17f
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr8810.ml
@@ -0,0 +1,7 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+flags = "-no-alias-deps -w -49 -c"
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+*)
+module Loop = Pr8810
diff --git a/testsuite/tests/typing-modules/pr9384.ml b/testsuite/tests/typing-modules/pr9384.ml
new file mode 100644
index 00000000..941bdadf
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr9384.ml
@@ -0,0 +1,46 @@
+(* TEST
+   * expect
+*)
+
+module M : sig
+  type 'a t := [< `A ] as 'a
+  val f : 'a -> 'a t
+end = struct
+  let f x = x
+end;;
+[%%expect{|
+Line 2, characters 2-28:
+2 |   type 'a t := [< `A ] as 'a
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Destructive substitutions are not supported for constrained
+       types (other than when replacing a type constructor with
+       a type constructor with the same arguments).
+|}]
+
+type foo = { foo : 'a. ([< `A] as 'a) -> 'a }
+
+module Foo (X : sig type 'a t := [< `A ] as 'a type foo2 = foo = { foo : 'a. 'a t -> 'a t } end) = struct
+    let f { X.foo } = foo
+end;;
+[%%expect{|
+type foo = { foo : 'a. ([< `A ] as 'a) -> 'a; }
+Line 3, characters 20-46:
+3 | module Foo (X : sig type 'a t := [< `A ] as 'a type foo2 = foo = { foo : 'a. 'a t -> 'a t } end) = struct
+                        ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Destructive substitutions are not supported for constrained
+       types (other than when replacing a type constructor with
+       a type constructor with the same arguments).
+|}]
+
+type bar = { bar : 'a. ([< `A] as 'a) -> 'a }
+
+module Bar (X : sig type 'a t := 'a type bar2 = bar = { bar : 'a. ([< `A] as 'a) t -> 'a t } end) = struct
+  let f { X.bar } = bar
+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) ->
+    sig val f : X.bar2 -> ([< `A ] as 'a) -> 'a end
+|}]
diff --git a/testsuite/tests/typing-modules/pr9695.ml b/testsuite/tests/typing-modules/pr9695.ml
new file mode 100644
index 00000000..ad025fea
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr9695.ml
@@ -0,0 +1,12 @@
+(* TEST
+   * expect
+*)
+
+module Test (S : sig module type S end) (M : S.S) =
+  struct open M (* should not succeed silently *) end
+[%%expect{|
+Line 2, characters 14-15:
+2 |   struct open M (* should not succeed silently *) end
+                  ^
+Error: This module is not a structure; it has type S.S
+|}]
diff --git a/testsuite/tests/typing-modules/printing.ml b/testsuite/tests/typing-modules/printing.ml
new file mode 100644
index 00000000..79643150
--- /dev/null
+++ b/testsuite/tests/typing-modules/printing.ml
@@ -0,0 +1,58 @@
+(* TEST
+   * expect
+*)
+
+(* PR#6650 *)
+
+module type S = sig
+  class type c = object method m : int end
+  module M : sig
+    class type d = c
+  end
+end;;
+module F (X : S) = X.M;;
+[%%expect{|
+module type S =
+  sig
+    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
+|}];;
+
+(* PR#6648 *)
+
+module M = struct module N = struct let x = 1 end end;;
+#show_module M;;
+[%%expect{|
+module M : sig module N : sig val x : int end end
+module M : sig module N : sig ... end end
+|}];;
+
+(* Shortcut notation for functors *)
+module type A
+module type B
+module type C
+module type D
+module type E
+module type F
+module Test(X: ((A->(B->C)->D) -> (E -> F))) = struct end
+[%%expect {|
+module type A
+module type B
+module type C
+module type D
+module type E
+module type F
+module Test : functor (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 LongFunctor2 = functor (_ : A) () (_ : B) () -> C -> D -> sig end
+[%%expect {|
+module type LongFunctor2 = A -> functor () (_ : 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
new file mode 100644
index 00000000..f85c1e7d
--- /dev/null
+++ b/testsuite/tests/typing-modules/records_errors_test.ml
@@ -0,0 +1,138 @@
+(* TEST
+ * expect
+*)
+
+module M1 : sig
+  type t = {f0 : unit * unit * unit * int * unit * unit * unit;
+            f1 : unit * unit * unit * int * unit * unit * unit}
+end = struct
+  type t = {f0 : unit * unit * unit * float* unit * unit * unit;
+            f1 : unit * unit * unit * string * unit * unit * unit}
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 |   type t = {f0 : unit * unit * unit * float* unit * unit * unit;
+6 |             f1 : unit * unit * unit * string * unit * unit * unit}
+7 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig
+           type t = {
+             f0 : unit * unit * unit * float * unit * unit * unit;
+             f1 : unit * unit * unit * string * unit * unit * unit;
+           }
+         end
+       is not included in
+         sig
+           type t = {
+             f0 : unit * unit * unit * int * unit * unit * unit;
+             f1 : unit * unit * unit * int * unit * unit * unit;
+           }
+         end
+       Type declarations do not match:
+         type t = {
+           f0 : unit * unit * unit * float * unit * unit * unit;
+           f1 : unit * unit * unit * string * unit * unit * unit;
+         }
+       is not included in
+         type t = {
+           f0 : unit * unit * unit * int * unit * unit * unit;
+           f1 : unit * unit * unit * int * unit * unit * unit;
+         }
+       Fields do not match:
+         f0 : unit * unit * unit * float * unit * unit * unit;
+       is not compatible with:
+         f0 : unit * unit * unit * int * unit * unit * unit;
+       The types are not equal.
+|}];;
+
+
+module M2 : sig
+  type t = {mutable f0 : unit * unit * unit * int * unit * unit * unit;
+            f1 : unit * unit * unit * int * unit * unit * unit}
+end = struct
+  type t = {f0 : unit * unit * unit * float* unit * unit * unit;
+            f1 : unit * unit * unit * string * unit * unit * unit}
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 |   type t = {f0 : unit * unit * unit * float* unit * unit * unit;
+6 |             f1 : unit * unit * unit * string * unit * unit * unit}
+7 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig
+           type t = {
+             f0 : unit * unit * unit * float * unit * unit * unit;
+             f1 : unit * unit * unit * string * unit * unit * unit;
+           }
+         end
+       is not included in
+         sig
+           type t = {
+             mutable f0 : unit * unit * unit * int * unit * unit * unit;
+             f1 : unit * unit * unit * int * unit * unit * unit;
+           }
+         end
+       Type declarations do not match:
+         type t = {
+           f0 : unit * unit * unit * float * unit * unit * unit;
+           f1 : unit * unit * unit * string * unit * unit * unit;
+         }
+       is not included in
+         type t = {
+           mutable f0 : unit * unit * unit * int * unit * unit * unit;
+           f1 : unit * unit * unit * int * unit * unit * unit;
+         }
+       Fields do not match:
+         f0 : unit * unit * unit * float * unit * unit * unit;
+       is not compatible with:
+         mutable f0 : unit * unit * unit * int * unit * unit * unit;
+       The second is mutable and the first is not.
+|}];;
+
+module M3 : sig
+  type t = {f0 : unit}
+end = struct
+  type t = {f1 : unit}
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = {f1 : unit}
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = { f1 : unit; } end
+       is not included in
+         sig type t = { f0 : unit; } end
+       Type declarations do not match:
+         type t = { f1 : unit; }
+       is not included in
+         type t = { f0 : unit; }
+       Fields number 1 have different names, f1 and f0.
+|}];;
+
+module M4 : sig
+  type t = {f0 : unit; f1 : unit}
+end = struct
+  type t = {f0 : unit}
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = {f0 : unit}
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = { f0 : unit; } end
+       is not included in
+         sig type t = { f0 : unit; f1 : unit; } end
+       Type declarations do not match:
+         type t = { f0 : unit; }
+       is not included in
+         type t = { f0 : unit; f1 : unit; }
+       The field f1 is only present in the second declaration.
+|}];;
diff --git a/testsuite/tests/typing-modules/recursive.ml b/testsuite/tests/typing-modules/recursive.ml
new file mode 100644
index 00000000..8e6cdb17
--- /dev/null
+++ b/testsuite/tests/typing-modules/recursive.ml
@@ -0,0 +1,13 @@
+(* TEST
+   * expect
+*)
+
+(* PR#7324 *)
+
+module rec T : sig type t = T.t end = T;;
+[%%expect{|
+Line 1, characters 0-39:
+1 | module rec T : sig type t = T.t end = T;;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type abbreviation T.t is cyclic
+|}]
diff --git a/testsuite/tests/typing-modules/unroll_private_abbrev.ml b/testsuite/tests/typing-modules/unroll_private_abbrev.ml
new file mode 100644
index 00000000..4fa7f7da
--- /dev/null
+++ b/testsuite/tests/typing-modules/unroll_private_abbrev.ml
@@ -0,0 +1,80 @@
+(* TEST
+   * expect
+*)
+
+module M : sig
+  type t = private [ `Bar of 'a | `Foo ] as 'a
+  val bar : t
+end = struct
+  type t = [ `Bar of 'a | `Foo ] as 'a
+  let bar = `Bar `Foo
+end;;
+[%%expect{|
+module M : sig type t = private [ `Bar of 'a | `Foo ] as 'a val bar : t end
+|}]
+
+let y =
+  match (M.bar :> [ `Bar of 'a | `Foo ] as 'a) with
+  | `Bar x -> x
+  | `Foo -> assert false
+;;
+[%%expect{|
+val y : [ `Bar of 'a | `Foo ] as 'a = `Foo
+|}]
+
+let y =
+  match (M.bar :> [ `Bar of M.t | `Foo ]) with
+  | `Bar x -> x
+  | `Foo -> assert false
+;;
+[%%expect{|
+Line 2, characters 8-41:
+2 |   match (M.bar :> [ `Bar of M.t | `Foo ]) with
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type M.t is not a subtype of [ `Bar of M.t | `Foo ]
+       Type M.t = [ `Bar of M.t | `Foo ] is not a subtype of M.t
+|}]
+
+module F(X : sig end) : sig
+  type s = private [ `Bar of 'a | `Foo ] as 'a
+
+  val from : M.t -> s
+  val to_  : s -> M.t
+end = struct
+  type s = M.t
+
+  let from x = x
+  let to_ x = x
+end;;
+[%%expect{|
+module F :
+  functor (X : sig end) ->
+    sig
+      type s = private [ `Bar of 'a | `Foo ] as 'a
+      val from : M.t -> s
+      val to_ : s -> M.t
+    end
+|}]
+
+module N = F(struct end);;
+[%%expect{|
+module N :
+  sig
+    type s = private [ `Bar of 'a | `Foo ] as 'a
+    val from : M.t -> s
+    val to_ : s -> M.t
+  end
+|}]
+
+let y =
+  match (N.from M.bar :> [ `Bar of N.s | `Foo ]) with
+  | `Bar x -> N.to_ x
+  | `Foo -> assert false
+;;
+[%%expect{|
+Line 2, characters 8-48:
+2 |   match (N.from M.bar :> [ `Bar of N.s | `Foo ]) with
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type N.s is not a subtype of [ `Bar of N.s | `Foo ]
+       Type N.s = [ `Bar of N.s | `Foo ] is not a subtype of N.s
+|}]
diff --git a/testsuite/tests/typing-modules/variants_errors_test.ml b/testsuite/tests/typing-modules/variants_errors_test.ml
new file mode 100644
index 00000000..a923ebcf
--- /dev/null
+++ b/testsuite/tests/typing-modules/variants_errors_test.ml
@@ -0,0 +1,204 @@
+(* TEST
+  * expect
+ *)
+
+module M1 : sig
+  type t =
+    | Foo of int * int
+end = struct
+  type t =
+    | Foo of float * int
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 |   type t =
+6 |     | Foo of float * int
+7 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = Foo of float * int end
+       is not included in
+         sig type t = Foo of int * int end
+       Type declarations do not match:
+         type t = Foo of float * int
+       is not included in
+         type t = Foo of int * int
+       Constructors do not match:
+         Foo of float * int
+       is not compatible with:
+         Foo of int * int
+       The types are not equal.
+|}];;
+
+module M2 : sig
+  type t =
+    | Foo of int * int
+end = struct
+  type t =
+    | Foo of float
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 |   type t =
+6 |     | Foo of float
+7 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = Foo of float end
+       is not included in
+         sig type t = Foo of int * int end
+       Type declarations do not match:
+         type t = Foo of float
+       is not included in
+         type t = Foo of int * int
+       Constructors do not match:
+         Foo of float
+       is not compatible with:
+         Foo of int * int
+       They have different arities.
+|}];;
+
+module M3 : sig
+  type t =
+    | Foo of {x : int; y : int}
+end = struct
+  type t =
+    | Foo of {x : float; y : int}
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 |   type t =
+6 |     | Foo of {x : float; y : int}
+7 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = Foo of { x : float; y : int; } end
+       is not included in
+         sig type t = Foo of { x : int; y : int; } end
+       Type declarations do not match:
+         type t = Foo of { x : float; y : int; }
+       is not included in
+         type t = Foo of { x : int; y : int; }
+       Constructors do not match:
+         Foo of { x : float; y : int; }
+       is not compatible with:
+         Foo of { x : int; y : int; }
+       Fields do not match:
+         x : float;
+       is not compatible with:
+         x : int;
+       The types are not equal.
+|}];;
+
+module M4 : sig
+  type t =
+    | Foo of {x : int; y : int}
+end = struct
+  type t =
+    | Foo of float
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 |   type t =
+6 |     | Foo of float
+7 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = Foo of float end
+       is not included in
+         sig type t = Foo of { x : int; y : int; } end
+       Type declarations do not match:
+         type t = Foo of float
+       is not included in
+         type t = Foo of { x : int; y : int; }
+       Constructors do not match:
+         Foo of float
+       is not compatible with:
+         Foo of { x : int; y : int; }
+       The second uses inline records and the first doesn't.
+|}];;
+
+module M5 : sig
+  type 'a t =
+    | Foo : int -> int t
+end = struct
+  type 'a t =
+    | Foo of 'a
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 |   type 'a t =
+6 |     | Foo of 'a
+7 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type 'a t = Foo of 'a end
+       is not included in
+         sig type 'a t = Foo : int -> int t end
+       Type declarations do not match:
+         type 'a t = Foo of 'a
+       is not included in
+         type 'a t = Foo : int -> int t
+       Constructors do not match:
+         Foo of 'a
+       is not compatible with:
+         Foo : int -> int t
+       The second has explicit return type and the first doesn't.
+|}];;
+
+module M : sig
+  type ('a, 'b) t = A of 'a
+end = struct
+  type ('a, 'b) t = A of 'b
+end;;
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type ('a, 'b) t = A of 'b
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type ('a, 'b) t = A of 'b end
+       is not included in
+         sig type ('a, 'b) t = A of 'a end
+       Type declarations do not match:
+         type ('a, 'b) t = A of 'b
+       is not included in
+         type ('a, 'b) t = A of 'a
+       Constructors do not match:
+         A of 'b
+       is not compatible with:
+         A of 'a
+       The types are not equal.
+|}];;
+
+module M : sig
+  type ('a, 'b) t = A of 'a
+end = struct
+  type ('b, 'a) t = A of 'a
+end;;
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type ('b, 'a) t = A of 'a
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type ('b, 'a) t = A of 'a end
+       is not included in
+         sig type ('a, 'b) t = A of 'a end
+       Type declarations do not match:
+         type ('b, 'a) t = A of 'a
+       is not included in
+         type ('a, 'b) t = A of 'a
+       Constructors do not match:
+         A of 'a
+       is not compatible with:
+         A of 'a
+       The types are not equal.
+|}];;
diff --git a/testsuite/tests/typing-multifile/a.ml b/testsuite/tests/typing-multifile/a.ml
new file mode 100644
index 00000000..03ee0dcd
--- /dev/null
+++ b/testsuite/tests/typing-multifile/a.ml
@@ -0,0 +1 @@
+type _ t = T
diff --git a/testsuite/tests/typing-multifile/b.ml b/testsuite/tests/typing-multifile/b.ml
new file mode 100644
index 00000000..ea1529f6
--- /dev/null
+++ b/testsuite/tests/typing-multifile/b.ml
@@ -0,0 +1 @@
+type 'a t = 'a A.t
diff --git a/testsuite/tests/typing-multifile/c.ml b/testsuite/tests/typing-multifile/c.ml
new file mode 100644
index 00000000..28e2e982
--- /dev/null
+++ b/testsuite/tests/typing-multifile/c.ml
@@ -0,0 +1 @@
+external f : unit -> unit B.t = "%identity"
diff --git a/testsuite/tests/typing-multifile/d.mli b/testsuite/tests/typing-multifile/d.mli
new file mode 100644
index 00000000..3dfbd091
--- /dev/null
+++ b/testsuite/tests/typing-multifile/d.mli
@@ -0,0 +1 @@
+type _ t =  C: { f: ('a -> [<`X]) t } -> [<`X] t
diff --git a/testsuite/tests/typing-multifile/e.ml b/testsuite/tests/typing-multifile/e.ml
new file mode 100644
index 00000000..c9e89ba9
--- /dev/null
+++ b/testsuite/tests/typing-multifile/e.ml
@@ -0,0 +1 @@
+open D;; let f (C {f}) = ()
diff --git a/testsuite/tests/typing-multifile/f.ml b/testsuite/tests/typing-multifile/f.ml
new file mode 100644
index 00000000..ac45c734
--- /dev/null
+++ b/testsuite/tests/typing-multifile/f.ml
@@ -0,0 +1,4 @@
+module A = struct end
+module Alias = A
+exception Alias
+let alias = Alias
diff --git a/testsuite/tests/typing-multifile/pr6372.ml b/testsuite/tests/typing-multifile/pr6372.ml
new file mode 100644
index 00000000..727839cf
--- /dev/null
+++ b/testsuite/tests/typing-multifile/pr6372.ml
@@ -0,0 +1,9 @@
+(* TEST
+files = "d.mli e.ml"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+module = "d.mli"
+*** ocamlc.byte
+module = "e.ml"
+**** check-ocamlc.byte-output
+*)
diff --git a/testsuite/tests/typing-multifile/pr7325.ml b/testsuite/tests/typing-multifile/pr7325.ml
new file mode 100644
index 00000000..33b69bc9
--- /dev/null
+++ b/testsuite/tests/typing-multifile/pr7325.ml
@@ -0,0 +1,13 @@
+(* TEST
+files = "a.ml b.ml c.ml"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+module = "a.ml"
+*** ocamlc.byte
+module = "b.ml"
+**** script
+script = "rm a.cmi"
+***** ocamlc.byte
+module = "c.ml"
+****** check-ocamlc.byte-output
+*)
diff --git a/testsuite/tests/typing-multifile/pr7563.ml b/testsuite/tests/typing-multifile/pr7563.ml
new file mode 100644
index 00000000..d7950efb
--- /dev/null
+++ b/testsuite/tests/typing-multifile/pr7563.ml
@@ -0,0 +1,5 @@
+(* TEST
+modules = "f.ml"
+*)
+
+exit (if F.Alias = F.alias then 0 else 1)
diff --git a/testsuite/tests/typing-multifile/pr9218.ml b/testsuite/tests/typing-multifile/pr9218.ml
new file mode 100644
index 00000000..3c025aff
--- /dev/null
+++ b/testsuite/tests/typing-multifile/pr9218.ml
@@ -0,0 +1,9 @@
+(* TEST
+   flags="-annot"
+   modules="a.ml"
+ *)
+
+(* Test interference between inline record path
+   [a.A] and the [a.ml] compilation unit *)
+type 'x a = A of { x: int }
+let v = A { x = 0 }
diff --git a/testsuite/tests/typing-objects-bugs/pr3968_bad.compilers.reference b/testsuite/tests/typing-objects-bugs/pr3968_bad.compilers.reference
new file mode 100644
index 00000000..a5685448
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/pr3968_bad.compilers.reference
@@ -0,0 +1,49 @@
+File "pr3968_bad.ml", lines 20-29, characters 0-3:
+20 | object
+21 |   val l = e1
+22 |   val r = e2
+23 |   method eval env =
+24 |       match l with
+25 |     | `Abs(var,body) ->
+26 |         Hashtbl.add env var r;
+27 |         body
+28 |     | _ -> `App(l,r);
+29 | end
+Error: The class type
+         object
+           val l :
+             [ `Abs of
+                 string *
+                 ([ `Abs of string * expr | `App of 'a * exp ] as 'b)
+             | `App of expr * expr ] as 'a
+           val r : exp
+           method eval : (string, exp) Hashtbl.t -> 'b
+         end
+       is not matched by the class type exp
+       The class type
+         object
+           val l :
+             [ `Abs of
+                 string *
+                 ([ `Abs of string * expr | `App of 'a * exp ] as 'b)
+             | `App of expr * expr ] as 'a
+           val r : exp
+           method eval : (string, exp) Hashtbl.t -> 'b
+         end
+       is not matched by the class type
+         object method eval : (string, exp) Hashtbl.t -> expr end
+       The method eval has type
+         (string, exp) Hashtbl.t ->
+         ([ `Abs of string * expr
+          | `App of [ `Abs of string * 'a | `App of expr * expr ] * exp ]
+          as 'a)
+       but is expected to have type (string, exp) Hashtbl.t -> expr
+       Type
+         [ `Abs of string * expr
+         | `App of [ `Abs of string * 'a | `App of expr * expr ] * exp ]
+         as 'a
+       is not compatible with type
+         expr = [ `Abs of string * expr | `App of expr * expr ] 
+       Type exp = < eval : (string, exp) Hashtbl.t -> expr >
+       is not compatible with type
+         expr = [ `Abs of string * expr | `App of expr * expr ] 
diff --git a/testsuite/tests/typing-objects-bugs/pr3968_bad.ml b/testsuite/tests/typing-objects-bugs/pr3968_bad.ml
new file mode 100644
index 00000000..6b04eee0
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/pr3968_bad.ml
@@ -0,0 +1,29 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+type expr =
+  [ `Abs of string * expr
+  | `App of expr * expr
+  ]
+
+class type exp =
+object
+  method eval : (string, exp) Hashtbl.t -> expr
+end;;
+
+class app e1 e2 : exp =
+object
+  val l = e1
+  val r = e2
+  method eval env =
+      match l with
+    | `Abs(var,body) ->
+        Hashtbl.add env var r;
+        body
+    | _ -> `App(l,r);
+end
diff --git a/testsuite/tests/typing-objects-bugs/pr4018_bad.compilers.reference b/testsuite/tests/typing-objects-bugs/pr4018_bad.compilers.reference
new file mode 100644
index 00000000..68b17665
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/pr4018_bad.compilers.reference
@@ -0,0 +1,40 @@
+File "pr4018_bad.ml", line 42, characters 11-17:
+42 | let f (x : entity entity_container) = ()
+                ^^^^^^
+Error: This type entity = < destroy_subject : id subject; entity_id : id >
+       should be an instance of type
+         < destroy_subject : < add_observer : 'a entity_container -> 'c; .. >
+                             as 'b;
+           .. >
+         as 'a
+       Type
+         id subject =
+           < add_observer : (id subject, id) observer -> unit;
+             notify_observers : id -> unit >
+       is not compatible with type
+         < add_observer : 'a entity_container -> 'c; .. > as 'b 
+       Type (id subject, id) observer = < notify : id subject -> id -> unit >
+       is not compatible with type
+         'a entity_container =
+           < add_entity : (< destroy_subject : < add_observer : 'a
+                                                                entity_container ->
+                                                                'f;
+                                                 .. >
+                                               as 'e;
+                             .. >
+                           as 'd) ->
+                          'f;
+             notify : 'd -> id -> unit > 
+       Type entity = < destroy_subject : id subject; entity_id : id >
+       is not compatible with type < destroy_subject : 'e; .. > as 'd 
+       Type
+         id subject =
+           < add_observer : (id subject, id) observer -> unit;
+             notify_observers : id -> unit >
+       is not compatible with type
+         < add_observer : 'a entity_container -> 'f; .. > as 'e 
+       Type (id subject, id) observer = < notify : id subject -> id -> unit >
+       is not compatible with type
+         'a entity_container =
+           < add_entity : 'd -> 'f; notify : 'd -> id -> unit > 
+       The first object type has no method add_entity
diff --git a/testsuite/tests/typing-objects-bugs/pr4018_bad.ml b/testsuite/tests/typing-objects-bugs/pr4018_bad.ml
new file mode 100644
index 00000000..8d23f82d
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/pr4018_bad.ml
@@ -0,0 +1,53 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+class virtual ['subject, 'event] observer =
+   object
+     method virtual notify : 'subject ->  'event -> unit
+   end
+
+class ['event] subject =
+   object (self : 'subject)
+     val mutable observers = ([]: (('subject, 'event) observer) list)
+     method add_observer obs = observers <- (obs :: observers)
+     method notify_observers (e : 'event) =
+         List.iter (fun x -> x#notify self e) observers
+   end
+
+type id = int
+
+class entity (id : id) =
+  object
+    val ent_destroy_subject = new subject
+    method destroy_subject : (id) subject = ent_destroy_subject
+
+    method entity_id = id
+  end
+
+class ['entity] entity_container =
+  object (self)
+    inherit ['entity, id] observer as observer
+
+    method add_entity (e : 'entity) =
+      e#destroy_subject#add_observer (self)
+
+    method notify _ id = ()
+  end
+
+let f (x : entity entity_container) = ()
+
+(*
+class world =
+  object
+    val entity_container : entity entity_container = new entity_container
+
+    method add_entity (s : entity) =
+      entity_container#add_entity (s :> entity)
+
+  end
+*)
diff --git a/testsuite/tests/typing-objects-bugs/pr4435_bad.compilers.reference b/testsuite/tests/typing-objects-bugs/pr4435_bad.compilers.reference
new file mode 100644
index 00000000..4a75d176
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/pr4435_bad.compilers.reference
@@ -0,0 +1,5 @@
+File "pr4435_bad.ml", line 14, characters 6-7:
+14 | class c (v : int) =
+           ^
+Error: Multiple definition of the class name c.
+       Names must be unique in a given structure or signature.
diff --git a/testsuite/tests/typing-objects-bugs/pr4435_bad.ml b/testsuite/tests/typing-objects-bugs/pr4435_bad.ml
new file mode 100644
index 00000000..f869e7d6
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/pr4435_bad.ml
@@ -0,0 +1,19 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* Two v's in the same class *)
+class c v = object initializer  print_endline v val v = 42 end;;
+new c "42";;
+
+(* Two hidden v's in the same class! *)
+class c (v : int) =
+  object
+    method v0 = v
+    inherit ((fun v -> object method v : string = v end) "42")
+  end;;
+(new c 42)#v0;;
diff --git a/testsuite/tests/typing-objects-bugs/pr4766_ok.ml b/testsuite/tests/typing-objects-bugs/pr4766_ok.ml
new file mode 100644
index 00000000..d8511e56
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/pr4766_ok.ml
@@ -0,0 +1,17 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+class virtual ['a] c =
+object (s : 'a)
+  method virtual m : 'b
+end
+
+let o =
+    object (s :'a)
+      inherit ['a] c
+      method m = 42
+    end
diff --git a/testsuite/tests/typing-objects-bugs/pr4824_ok.ml b/testsuite/tests/typing-objects-bugs/pr4824_ok.ml
new file mode 100644
index 00000000..7b31b5d9
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/pr4824_ok.ml
@@ -0,0 +1,17 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module M :
+   sig
+     class x : int -> object method m : int end
+  end
+=
+struct
+  class x _ = object
+    method m = 42
+  end
+end;;
diff --git a/testsuite/tests/typing-objects-bugs/pr4824a_bad.compilers.reference b/testsuite/tests/typing-objects-bugs/pr4824a_bad.compilers.reference
new file mode 100644
index 00000000..8c644ef0
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/pr4824a_bad.compilers.reference
@@ -0,0 +1,10 @@
+File "pr4824a_bad.ml", line 10, characters 2-45:
+10 |   struct class c x = object val x = x end end
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       ...
+       Class declarations do not match:
+         class c : 'a -> object val x : 'a end
+       does not match
+         class c : 'a -> object val x : 'b end
+       The instance variable x has type 'a but is expected to have type 'b
diff --git a/testsuite/tests/typing-objects-bugs/pr4824a_bad.ml b/testsuite/tests/typing-objects-bugs/pr4824a_bad.ml
new file mode 100644
index 00000000..37002d71
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/pr4824a_bad.ml
@@ -0,0 +1,14 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module M : sig class c : 'a -> object val x : 'b end end =
+  struct class c x = object val x = x end end
+
+class c (x : int) = object inherit M.c x method x : bool = x end
+
+let r = (new c 2)#x;;
diff --git a/testsuite/tests/typing-objects-bugs/pr5156_ok.ml b/testsuite/tests/typing-objects-bugs/pr5156_ok.ml
new file mode 100644
index 00000000..6c52480c
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/pr5156_ok.ml
@@ -0,0 +1,17 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+class type t = object end;;
+class ['a] o1 = object (self : #t as 'a) end;;
+type 'a obj = ( < .. > as 'a);;
+class type ['a] o2 = object ('a obj) end;;
+class ['a] o3 = object (self : 'a obj) end;;
+class ['a] o4 = object (self) method m = (self : 'a obj) end;;
+(*
+let o = object (self : 'a obj) end;;
+let o = object (self) method m = (self : 'a obj) end;;
+*)
diff --git a/testsuite/tests/typing-objects-bugs/pr7284_bad.compilers.reference b/testsuite/tests/typing-objects-bugs/pr7284_bad.compilers.reference
new file mode 100644
index 00000000..de957e79
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/pr7284_bad.compilers.reference
@@ -0,0 +1,6 @@
+File "pr7284_bad.ml", line 35, characters 30-62:
+35 |    let f : X.v1 wit -> unit = function V1 s -> print_endline s
+                                   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error (warning 8): this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+V2 _
diff --git a/testsuite/tests/typing-objects-bugs/pr7284_bad.ml b/testsuite/tests/typing-objects-bugs/pr7284_bad.ml
new file mode 100644
index 00000000..4d236cb5
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/pr7284_bad.ml
@@ -0,0 +1,41 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type S = sig
+
+   type o1 = < bar : int; foo : int >
+   type o2 = private < foo : int; .. >
+
+   type v1 = T of o1
+   type v2 = T of o2
+
+ end
+
+ module M = struct
+
+   type o1 = < bar : int; foo : int >
+   type o2 = o1
+
+   type v1 = T of o1
+   type v2 = v1 = T of o2
+
+ end
+
+ module F(X : S) = struct
+
+   type 'a wit =
+   | V1 : string -> X.v1 wit
+   | V2 : int -> X.v2 wit
+
+   let f : X.v1 wit -> unit = function V1 s -> print_endline s
+
+ end [@@warning "+8"] [@@warnerror "+8"]
+
+ module N = F(M)
+
+ let () = N.f (N.V2 0)
diff --git a/testsuite/tests/typing-objects-bugs/pr7293_ok.ml b/testsuite/tests/typing-objects-bugs/pr7293_ok.ml
new file mode 100644
index 00000000..88694877
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/pr7293_ok.ml
@@ -0,0 +1,18 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+type t = T : t
+type s = T
+
+class c = object (self : 'self)
+
+  method foo : s -> 'self = function
+    | T -> self#bar ()
+
+  method bar : unit -> 'self = fun () -> self
+
+end
diff --git a/testsuite/tests/typing-objects-bugs/woodyatt_ok.ml b/testsuite/tests/typing-objects-bugs/woodyatt_ok.ml
new file mode 100644
index 00000000..d0969457
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/woodyatt_ok.ml
@@ -0,0 +1,21 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* test.ml *)
+class alfa = object(_:'self)
+  method x: 'a. ('a, out_channel, unit) format -> 'a = Printf.printf
+end
+
+class bravo a = object
+  val y = (a :> alfa)
+  initializer y#x "bravo initialized"
+end
+
+class charlie a = object
+  inherit bravo a
+  initializer y#x "charlie initialized"
+end
diff --git a/testsuite/tests/typing-objects-bugs/yamagata021012_ok.ml b/testsuite/tests/typing-objects-bugs/yamagata021012_ok.ml
new file mode 100644
index 00000000..09282762
--- /dev/null
+++ b/testsuite/tests/typing-objects-bugs/yamagata021012_ok.ml
@@ -0,0 +1,200 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* The module begins *)
+exception Out_of_range
+
+class type ['a] cursor =
+  object
+    method get : 'a
+    method incr : unit -> unit
+    method is_last : bool
+  end
+
+class type ['a] storage =
+  object ('self)
+    method first : 'a cursor
+    method len : int
+    method nth : int -> 'a cursor
+    method copy : 'self
+    method sub : int -> int -> 'self
+    method concat : 'a storage -> 'self
+    method fold : 'b. ('a -> int -> 'b -> 'b) -> 'b -> 'b
+    method iter : ('a -> unit) -> unit
+  end
+
+class virtual ['a, 'cursor] storage_base =
+  object (self : 'self)
+    constraint 'cursor = 'a #cursor
+    method virtual first : 'cursor
+    method virtual len : int
+    method virtual copy : 'self
+    method virtual sub : int -> int -> 'self
+    method virtual concat : 'a storage -> 'self
+    method fold : 'b. ('a -> int -> 'b -> 'b) -> 'b -> 'b = fun f a0 ->
+      let cur = self#first in
+      let rec loop count a =
+        if count >= self#len then a else
+        let a' = f cur#get count a in
+        cur#incr (); loop (count + 1) a'
+      in
+      loop 0 a0
+    method iter proc =
+      let p = self#first in
+      for i = 0 to self#len - 2 do proc p#get; p#incr () done;
+      if self#len > 0 then proc p#get else ()
+  end
+
+class type ['a] obj_input_channel =
+  object
+    method get : unit -> 'a
+    method close : unit -> unit
+  end
+
+class type ['a] obj_output_channel =
+  object
+    method put : 'a -> unit
+    method flush : unit -> unit
+    method close : unit -> unit
+  end
+
+module UChar =
+struct
+
+  type t = int
+
+  let highest_bit = 1 lsl 30
+  let lower_bits = highest_bit - 1
+
+  let char_of c =
+    try Char.chr c with Invalid_argument _ ->  raise Out_of_range
+
+  let of_char = Char.code
+
+  let code c =
+    if c lsr 30 = 0
+    then c
+    else raise Out_of_range
+
+  let chr n =
+    if n >= 0 && (n lsr 31 = 0) then n else raise Out_of_range
+
+  let uint_code c = c
+  let chr_of_uint n = n
+
+end
+
+type uchar = UChar.t
+
+let int_of_uchar u = UChar.uint_code u
+let uchar_of_int n = UChar.chr_of_uint n
+
+class type ucursor = [uchar] cursor
+
+class type ustorage = [uchar] storage
+
+class virtual ['ucursor] ustorage_base = [uchar, 'ucursor] storage_base
+
+module UText =
+struct
+
+(* the internal representation is UCS4 with big endian*)
+(* The most significant digit appears first. *)
+let get_buf s i =
+  let n = Bytes.get s i |> Char.code in
+  let n = (n lsl 8) lor (Bytes.get s (i + 1) |> Char.code) in
+  let n = (n lsl 8) lor (Bytes.get s (i + 2) |> Char.code) in
+  let n = (n lsl 8) lor (Bytes.get s (i + 3) |> Char.code) in
+  UChar.chr_of_uint n
+
+let set_buf s i u =
+  let n = UChar.uint_code u in
+  begin
+    s.[i] <- Char.chr (n lsr 24);
+    s.[i + 1] <- Char.chr (n lsr 16 lor 0xff);
+    s.[i + 2] <- Char.chr (n lsr 8 lor 0xff);
+    s.[i + 3] <- Char.chr (n lor 0xff);
+  end
+
+let init_buf buf pos init =
+  if init#len = 0 then () else
+  let cur = init#first in
+  for i = 0 to init#len - 2 do
+    set_buf buf (pos + i lsl 2) (cur#get); cur#incr ()
+  done;
+  set_buf buf (pos + (init#len - 1) lsl 2) (cur#get)
+
+let make_buf init =
+  let s = String.create (init#len lsl 2) in
+  init_buf s 0 init; s
+
+class text_raw buf =
+  object (self : 'self)
+    inherit [cursor] ustorage_base
+    val contents = buf
+    method first = new cursor (self :> text_raw) 0
+    method len = (Bytes.length contents) / 4
+    method get i = get_buf contents (4 * i)
+    method nth i = new cursor (self :> text_raw) i
+    method copy = {< contents = Bytes.copy contents >}
+    method sub pos len =
+      {< contents = Bytes.sub contents (pos * 4) (len * 4) >}
+    method concat (text : ustorage) =
+      let buf = Bytes.create (Bytes.length contents + 4 * text#len) in
+      Bytes.blit contents 0 buf 0 (Bytes.length contents);
+      init_buf buf (Bytes.length contents) text;
+      {< contents = buf >}
+  end
+and cursor text i =
+  object
+    val contents = text
+    val mutable pos = i
+    method get = contents#get pos
+    method incr () = pos <- pos + 1
+    method is_last = (pos + 1 >= contents#len)
+  end
+
+class string_raw buf =
+  object
+    inherit text_raw buf
+    method set i u = set_buf contents (4 * i) u
+  end
+
+class text init = text_raw (make_buf init)
+class string init = string_raw (make_buf init)
+
+let of_string s =
+  let buf = Bytes.make (4 * String.length s) '\000' in
+  for i = 0 to String.length s - 1 do
+    buf.[4 * i] <- s.[i]
+  done;
+  new text_raw buf
+
+let make len u =
+  let s = String.create (4 * len) in
+  for i = 0 to len - 1 do set_buf s (4 * i) u done;
+  new string_raw s
+
+let create len = make len (UChar.chr 0)
+
+let copy s = s#copy
+
+let sub s start len = s#sub start len
+
+let fill s start len u =
+  for i = start to start + len - 1 do s#set i u done
+
+let blit src srcoff dst dstoff len =
+  for i = 0 to len - 1 do
+    let u = src#get (srcoff + i) in
+    dst#set (dstoff + i) u
+  done
+
+let concat s1 s2 = s1#concat (s2 (* : #ustorage *) :> uchar storage)
+
+let iter proc s = s#iter proc
+end
diff --git a/testsuite/tests/typing-objects/Exemples.ml b/testsuite/tests/typing-objects/Exemples.ml
new file mode 100644
index 00000000..00cbde53
--- /dev/null
+++ b/testsuite/tests/typing-objects/Exemples.ml
@@ -0,0 +1,890 @@
+(* TEST
+   * expect
+*)
+
+class point x_init = object
+  val mutable x = x_init
+  method get_x = x
+  method move d = x <- x + d
+end;;
+[%%expect{|
+class point :
+  int ->
+  object val mutable x : int method get_x : int method move : int -> unit end
+|}];;
+
+let p = new point 7;;
+[%%expect{|
+val p : point = 
+|}];;
+
+p#get_x;;
+[%%expect{|
+- : int = 7
+|}];;
+p#move 3;;
+[%%expect{|
+- : unit = ()
+|}];;
+p#get_x;;
+[%%expect{|
+- : int = 10
+|}];;
+
+let q = Oo.copy p;;
+[%%expect{|
+val q : point = 
+|}, Principal{|
+val q : < get_x : int; move : int -> unit > = 
+|}];;
+
+q#move 7; p#get_x, q#get_x;;
+[%%expect{|
+- : int * int = (10, 17)
+|}];;
+
+class color_point x (c : string) = object
+  inherit point x
+  val c = c
+  method color = c
+end;;
+[%%expect{|
+class color_point :
+  int ->
+  string ->
+  object
+    val c : string
+    val mutable x : int
+    method color : string
+    method get_x : int
+    method move : int -> unit
+  end
+|}];;
+
+let p' = new color_point 5 "red";;
+[%%expect{|
+val p' : color_point = 
+|}];;
+
+p'#get_x, p'#color;;
+[%%expect{|
+- : int * string = (5, "red")
+|}];;
+
+let l = [p; (p' :> point)];;
+[%%expect{|
+val l : point list = [; ]
+|}];;
+
+let get_x p = p#get_x;;
+[%%expect{|
+val get_x : < get_x : 'a; .. > -> 'a = 
+|}];;
+let set_x p = p#set_x;;
+[%%expect{|
+val set_x : < set_x : 'a; .. > -> 'a = 
+|}];;
+List.map get_x l;;
+[%%expect{|
+- : int list = [10; 5]
+|}];;
+
+class ref x_init = object
+  val mutable x = x_init
+  method get = x
+  method set y = x <- y
+end;;
+[%%expect{|
+Lines 1-5, characters 0-3:
+1 | class ref x_init = object
+2 |   val mutable x = x_init
+3 |   method get = x
+4 |   method set y = x <- y
+5 | end..
+Error: Some type variables are unbound in this type:
+         class ref :
+           'a ->
+           object
+             val mutable x : 'a
+             method get : 'a
+             method set : 'a -> unit
+           end
+       The method get has type 'a where 'a is unbound
+|}];;
+
+class ref (x_init:int) = object
+  val mutable x = x_init
+  method get = x
+  method set y = x <- y
+end;;
+[%%expect{|
+class ref :
+  int ->
+  object val mutable x : int method get : int method set : int -> unit end
+|}];;
+
+class ['a] ref x_init = object
+  val mutable x = (x_init : 'a)
+  method get = x
+  method set y = x <- y
+end;;
+[%%expect{|
+class ['a] ref :
+  'a -> object val mutable x : 'a method get : 'a method set : 'a -> unit end
+|}];;
+
+let r = new ref 1 in r#set 2; (r#get);;
+[%%expect{|
+- : int = 2
+|}];;
+
+class ['a] circle (c : 'a) = object
+  val mutable center = c
+  method center = center
+  method set_center c = center <- c
+  method move = (center#move : int -> unit)
+end;;
+[%%expect{|
+class ['a] circle :
+  'a ->
+  object
+    constraint 'a = < move : int -> unit; .. >
+    val mutable center : 'a
+    method center : 'a
+    method move : int -> unit
+    method set_center : 'a -> unit
+  end
+|}];;
+
+class ['a] circle (c : 'a) = object
+  constraint 'a = #point
+  val mutable center = c
+  method center = center
+  method set_center c = center <- c
+  method move = center#move
+end;;
+[%%expect{|
+class ['a] circle :
+  'a ->
+  object
+    constraint 'a = #point
+    val mutable center : 'a
+    method center : 'a
+    method move : int -> unit
+    method set_center : 'a -> unit
+  end
+|}];;
+
+let (c, c') = (new circle p, new circle p');;
+[%%expect{|
+val c : point circle = 
+val c' : color_point circle = 
+|}, Principal{|
+val c : point circle = 
+val c' : < color : string; get_x : int; move : int -> unit > circle = 
+|}];;
+
+class ['a] color_circle c = object
+  constraint 'a = #color_point
+  inherit ['a] circle c
+  method color = center#color
+end;;
+[%%expect{|
+class ['a] color_circle :
+  'a ->
+  object
+    constraint 'a = #color_point
+    val mutable center : 'a
+    method center : 'a
+    method color : string
+    method move : int -> unit
+    method set_center : 'a -> unit
+  end
+|}];;
+
+let c'' = new color_circle p;;
+[%%expect{|
+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
+         #color_point
+       The first object type has no method color
+|}];;
+let c'' = new color_circle p';;
+[%%expect{|
+val c'' : color_point color_circle = 
+|}];;
+
+(c'' :> color_point circle);;
+[%%expect{|
+- : color_point circle = 
+|}];;
+(c'' :> point circle);;
+[%%expect{|
+Line 1, characters 0-21:
+1 | (c'' :> point circle);;
+    ^^^^^^^^^^^^^^^^^^^^^
+Error: Type
+         color_point color_circle =
+           < center : color_point; color : string; move : int -> unit;
+             set_center : color_point -> unit >
+       is not a subtype of
+         point circle =
+           < center : point; move : int -> unit; set_center : point -> unit >
+       Type point is not a subtype of color_point
+       The first object type has no method color
+|}];;                 (* Fail *)
+fun x -> (x : color_point color_circle :> point circle);;
+[%%expect{|
+Line 1, characters 9-55:
+1 | fun x -> (x : color_point color_circle :> point circle);;
+             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type
+         color_point color_circle =
+           < center : color_point; color : string; move : int -> unit;
+             set_center : color_point -> unit >
+       is not a subtype of
+         point circle =
+           < center : point; move : int -> unit; set_center : point -> unit >
+       Type point is not a subtype of color_point
+       The first object type has no method color
+|}];;
+
+class printable_point y = object (s)
+  inherit point y
+  method print = Format.print_int s#get_x
+end;;
+[%%expect{|
+class printable_point :
+  int ->
+  object
+    val mutable x : int
+    method get_x : int
+    method move : int -> unit
+    method print : unit
+  end
+|}];;
+
+let p = new printable_point 7;;
+[%%expect{|
+val p : printable_point = 
+|}];;
+p#print;;
+[%%expect{|
+- : unit = ()
+|}];;
+
+class printable_color_point y c = object (self)
+  inherit color_point y c
+  inherit printable_point y as super
+  method print =
+    Format.print_string "(";
+    super#print;
+    Format.print_string ", ";
+    Format.print_string (self#color);
+    Format.print_string ")"
+end;;
+[%%expect{|
+Line 3, characters 10-27:
+3 |   inherit printable_point y as super
+              ^^^^^^^^^^^^^^^^^
+Warning 13: the following instance variables are overridden by the class printable_point :
+  x
+The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
+class printable_color_point :
+  int ->
+  string ->
+  object
+    val c : string
+    val mutable x : int
+    method color : string
+    method get_x : int
+    method move : int -> unit
+    method print : unit
+  end
+|}];;
+
+let p' = new printable_color_point 7 "red";;
+[%%expect{|
+val p' : printable_color_point = 
+|}];;
+p'#print;;
+[%%expect{|
+- : unit = ()
+|}];;
+
+class functional_point y = object
+  val x = y
+  method get_x = x
+  method move d = {< x = x + d >}
+end;;
+[%%expect{|
+class functional_point :
+  int ->
+  object ('a) val x : int method get_x : int method move : int -> 'a end
+|}];;
+
+let p = new functional_point 7;;
+[%%expect{|
+val p : functional_point = 
+|}];;
+
+p#get_x;;
+[%%expect{|
+- : int = 7
+|}];;
+(p#move 3)#get_x;;
+[%%expect{|
+- : int = 10
+|}];;
+p#get_x;;
+[%%expect{|
+- : int = 7
+|}];;
+
+fun x -> (x :> functional_point);;
+[%%expect{|
+- : #functional_point -> functional_point = 
+|}];;
+
+(*******************************************************************)
+
+class virtual ['a] lst () = object (self)
+  method virtual null : bool
+  method virtual hd : 'a
+  method virtual tl : 'a lst
+  method map f =
+    (if self#null then
+       new nil ()
+     else
+       new cons (f self#hd) (self#tl#map f)
+     : 'a lst)
+  method iter (f : 'a -> unit) =
+    if self#null then ()
+    else begin
+      f self#hd;
+      self#tl#iter f
+    end
+  method print (f : 'a -> unit) =
+    Format.print_string "(";
+    self#iter (fun x -> f x; Format.print_string "::");
+    Format.print_string "[]";
+    Format.print_string ")"
+end and ['a] nil () = object
+  inherit ['a] lst ()
+  method null = true
+  method hd   = failwith "hd"
+  method tl   = failwith "tl"
+end and ['a] cons h t = object
+  inherit ['a] lst ()
+  val h = h val t = t
+  method null = false
+  method hd   = h
+  method tl   = t
+end;;
+[%%expect{|
+class virtual ['a] lst :
+  unit ->
+  object
+    method virtual hd : 'a
+    method iter : ('a -> unit) -> unit
+    method map : ('a -> 'a) -> 'a lst
+    method virtual null : bool
+    method print : ('a -> unit) -> unit
+    method virtual tl : 'a lst
+  end
+and ['a] nil :
+  unit ->
+  object
+    method hd : 'a
+    method iter : ('a -> unit) -> unit
+    method map : ('a -> 'a) -> 'a lst
+    method null : bool
+    method print : ('a -> unit) -> unit
+    method tl : 'a lst
+  end
+and ['a] cons :
+  'a ->
+  'a lst ->
+  object
+    val h : 'a
+    val t : 'a lst
+    method hd : 'a
+    method iter : ('a -> unit) -> unit
+    method map : ('a -> 'a) -> 'a lst
+    method null : bool
+    method print : ('a -> unit) -> unit
+    method tl : 'a lst
+  end
+|}];;
+
+let l1 = new cons 3 (new cons 10 (new nil ()));;
+[%%expect{|
+val l1 : int lst = 
+|}];;
+
+l1#print Format.print_int;;
+[%%expect{|
+- : unit = ()
+|}];;
+
+let l2 = l1#map (fun x -> x + 1);;
+[%%expect{|
+val l2 : int lst = 
+|}];;
+l2#print Format.print_int;;
+[%%expect{|
+- : unit = ()
+|}];;
+
+let rec map_list f (x:'a lst) =
+  if x#null then new nil()
+  else new cons (f x#hd) (map_list f x#tl);;
+[%%expect{|
+val map_list : ('a -> 'b) -> 'a lst -> 'b lst = 
+|}];;
+
+let p1 = (map_list (fun x -> new printable_color_point x "red") l1);;
+[%%expect{|
+val p1 : printable_color_point lst = 
+|}];;
+p1#print (fun x -> x#print);;
+[%%expect{|
+- : unit = ()
+|}];;
+
+(*******************************************************************)
+
+class virtual comparable () = object (self : 'a)
+  method virtual cmp : 'a -> int
+  end;;
+[%%expect{|
+class virtual comparable :
+  unit -> object ('a) method virtual cmp : 'a -> int end
+|}];;
+
+class int_comparable (x : int) = object
+  inherit comparable ()
+  val x = x
+  method x = x
+  method cmp p = compare x p#x
+end;;
+[%%expect{|
+class int_comparable :
+  int -> object ('a) val x : int method cmp : 'a -> int method x : int end
+|}];;
+
+class int_comparable2 xi = object
+  inherit int_comparable xi
+  val mutable x' = xi
+  method set_x y = x' <- y
+end;;
+[%%expect{|
+class int_comparable2 :
+  int ->
+  object ('a)
+    val x : int
+    val mutable x' : int
+    method cmp : 'a -> int
+    method set_x : int -> unit
+    method x : int
+  end
+|}];;
+
+class ['a] sorted_list () = object
+  constraint 'a = #comparable
+  val mutable l = ([] : 'a list)
+  method add x =
+    let rec insert =
+      function
+            []     ->  [x]
+      | a::l as l' -> if a#cmp x <= 0 then a::(insert l) else x::l'
+    in
+      l <- insert l
+  method hd = List.hd l
+end;;
+[%%expect{|
+class ['a] sorted_list :
+  unit ->
+  object
+    constraint 'a = #comparable
+    val mutable l : 'a list
+    method add : 'a -> unit
+    method hd : 'a
+  end
+|}];;
+
+let l = new sorted_list ();;
+[%%expect{|
+val l : _#comparable sorted_list = 
+|}];;
+let c = new int_comparable 10;;
+[%%expect{|
+val c : int_comparable = 
+|}];;
+l#add c;;
+[%%expect{|
+- : unit = ()
+|}];;
+
+let c2 = new int_comparable2 15;;
+[%%expect{|
+val c2 : int_comparable2 = 
+|}];;
+l#add (c2 :> int_comparable);;
+[%%expect{|
+Line 1, characters 6-28:
+1 | l#add (c2 :> int_comparable);;
+          ^^^^^^^^^^^^^^^^^^^^^^
+Error: Type
+         int_comparable2 =
+           < cmp : int_comparable2 -> int; set_x : int -> unit; x : int >
+       is not a subtype of
+         int_comparable = < cmp : int_comparable -> int; x : int >
+       Type int_comparable = < cmp : int_comparable -> int; x : int >
+       is not a subtype of
+         int_comparable2 =
+           < cmp : int_comparable2 -> int; set_x : int -> unit; x : int >
+       The first object type has no method set_x
+|}];;      (* Fail : 'a comp2 is not a subtype *)
+(new sorted_list ())#add c2;;
+[%%expect{|
+- : unit = ()
+|}];;
+
+class int_comparable3 (x : int) = object
+  val mutable x = x
+  method cmp (y : int_comparable) = compare x y#x
+  method x = x
+  method setx y = x <- y
+end;;
+[%%expect{|
+class int_comparable3 :
+  int ->
+  object
+    val mutable x : int
+    method cmp : int_comparable -> int
+    method setx : int -> unit
+    method x : int
+  end
+|}];;
+
+let c3 = new int_comparable3 15;;
+[%%expect{|
+val c3 : int_comparable3 = 
+|}];;
+l#add (c3 :> int_comparable);;
+[%%expect{|
+- : unit = ()
+|}];;
+(new sorted_list ())#add c3;;
+[%%expect{|
+Line 1, characters 25-27:
+1 | (new sorted_list ())#add c3;;
+                             ^^
+Error: This expression has type
+         int_comparable3 =
+           < cmp : int_comparable -> int; setx : int -> unit; x : int >
+       but an expression was expected of type
+         #comparable as 'a = < cmp : 'a -> int; .. >
+       Type int_comparable = < cmp : int_comparable -> int; x : int >
+       is not compatible with type
+         int_comparable3 =
+           < cmp : int_comparable -> int; setx : int -> unit; x : int >
+       The first object type has no method setx
+|}, Principal{|
+Line 1, characters 25-27:
+1 | (new sorted_list ())#add c3;;
+                             ^^
+Error: This expression has type
+         int_comparable3 =
+           < cmp : int_comparable -> int; setx : int -> unit; x : int >
+       but an expression was expected of type
+         #comparable as 'a = < cmp : 'a -> int; .. >
+       Type int_comparable = < cmp : int_comparable -> int; x : int >
+       is not compatible with type 'a = < cmp : 'a -> int; .. >
+       The first object type has no method setx
+|}];;   (* Error; strange message with -principal *)
+
+let sort (l : #comparable list) = List.sort (fun x -> x#cmp) l;;
+[%%expect{|
+val sort : (#comparable as 'a) list -> 'a list = 
+|}];;
+let pr l =
+  List.map (fun c -> Format.print_int c#x; Format.print_string " ") l;
+  Format.print_newline ();;
+[%%expect{|
+Line 2, characters 2-69:
+2 |   List.map (fun c -> Format.print_int c#x; Format.print_string " ") l;
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 10: this expression should have type unit.
+val pr : < x : int; .. > list -> unit = 
+|}];;
+let l = [new int_comparable 5; (new int_comparable3 2 :> int_comparable);
+         new int_comparable 4];;
+[%%expect{|
+val l : int_comparable list = [; ; ]
+|}];;
+pr l;;
+[%%expect{|
+7(7, red)(3::10::[])(4::11::[])((3, red)::(10, red)::[])5 2 4
+- : unit = ()
+|}];;
+pr (sort l);;
+[%%expect{|
+2 4 5
+- : unit = ()
+|}];;
+let l = [new int_comparable2 2; new int_comparable2 0];;
+[%%expect{|
+val l : int_comparable2 list = [; ]
+|}];;
+pr l;;
+[%%expect{|
+2 0
+- : unit = ()
+|}];;
+pr (sort l);;
+[%%expect{|
+0 2
+- : unit = ()
+|}];;
+
+let min (x : #comparable) y =
+  if x#cmp y <= 0 then x else y;;
+[%%expect{|
+val min : (#comparable as 'a) -> 'a -> 'a = 
+|}];;
+
+(min (new int_comparable  7) (new int_comparable 11))#x;;
+[%%expect{|
+- : int = 7
+|}];;
+(min (new int_comparable2 5) (new int_comparable2 3))#x;;
+[%%expect{|
+- : int = 3
+|}];;
+
+(*******************************************************************)
+
+class ['a] link (x : 'a) = object (self : 'b)
+  val mutable x = x
+  val mutable next = (None : 'b option)
+  method x = x
+  method  next = next
+  method  set_x y = x <- y
+  method  set_next l = next <- l
+  method  append l =
+    match next with
+      None ->
+        self#set_next l
+    | Some l' ->
+        l'#append l
+end;;
+[%%expect{|
+class ['a] link :
+  'a ->
+  object ('b)
+    val mutable next : 'b option
+    val mutable x : 'a
+    method append : 'b option -> unit
+    method next : 'b option
+    method set_next : 'b option -> unit
+    method set_x : 'a -> unit
+    method x : 'a
+  end
+|}];;
+
+class ['a] double_link x = object (self)
+  inherit ['a] link x
+  val mutable prev = None
+  method prev = prev
+  method  set_next l =
+         next <- l;
+         match l with Some l -> l#set_prev (Some self) | None -> ()
+  method  set_prev l = prev <- l
+end;;
+[%%expect{|
+class ['a] double_link :
+  'a ->
+  object ('b)
+    val mutable next : 'b option
+    val mutable prev : 'b option
+    val mutable x : 'a
+    method append : 'b option -> unit
+    method next : 'b option
+    method prev : 'b option
+    method set_next : 'b option -> unit
+    method set_prev : 'b option -> unit
+    method set_x : 'a -> unit
+    method x : 'a
+  end
+|}];;
+
+let rec fold_right f (l : 'a #link option) accu =
+  match l with
+    None -> accu
+  | Some l ->
+      f l#x (fold_right f l#next accu);;
+[%%expect{|
+val fold_right : ('a -> 'b -> 'b) -> 'a #link option -> 'b -> 'b = 
+|}];;
+
+(*******************************************************************)
+
+class calculator () = object (self)
+  val mutable arg = 0.
+  val mutable acc = 0.
+  val mutable equals = function s -> s#arg
+  method arg = arg
+  method acc = acc
+  method enter n = arg <- n; self
+  method add =
+    acc <- equals self;
+    equals <- (function s -> s#acc +. s#arg);
+    self
+  method sub =
+    acc <- equals self;
+    equals <- (function s -> s#acc -. s#arg);
+    self
+  method equals = equals self
+end;;
+[%%expect{|
+class calculator :
+  unit ->
+  object ('a)
+    val mutable acc : float
+    val mutable arg : float
+    val mutable equals : 'a -> float
+    method acc : float
+    method add : 'a
+    method arg : float
+    method enter : float -> 'a
+    method equals : float
+    method sub : 'a
+  end
+|}];;
+
+((new calculator ())#enter 5.)#equals;;
+[%%expect{|
+- : float = 5.
+|}];;
+(((new calculator ())#enter 5.)#sub#enter 3.5)#equals;;
+[%%expect{|
+- : float = 1.5
+|}];;
+((new calculator ())#enter 5.)#add#add#equals;;
+[%%expect{|
+- : float = 15.
+|}];;
+
+class calculator () = object (self)
+  val mutable arg = 0.
+  val mutable acc = 0.
+  val mutable equals = function s -> s#arg
+  method arg = arg
+  method acc = acc
+  method enter n = arg <- n; self
+  method add = {< acc = equals self; equals = function s -> s#acc +. s#arg >}
+  method sub = {< acc = equals self; equals = function s -> s#acc -. s#arg >}
+  method equals = equals self
+end;;
+[%%expect{|
+class calculator :
+  unit ->
+  object ('a)
+    val mutable acc : float
+    val mutable arg : float
+    val mutable equals : 'a -> float
+    method acc : float
+    method add : 'a
+    method arg : float
+    method enter : float -> 'a
+    method equals : float
+    method sub : 'a
+  end
+|}];;
+
+((new calculator ())#enter 5.)#equals;;
+[%%expect{|
+- : float = 5.
+|}];;
+(((new calculator ())#enter 5.)#sub#enter 3.5)#equals;;
+[%%expect{|
+- : float = 1.5
+|}];;
+((new calculator ())#enter 5.)#add#add#equals;;
+[%%expect{|
+- : float = 15.
+|}];;
+
+class calculator arg acc = object (self)
+  val arg = arg
+  val acc = acc
+  method enter n = new calculator n acc
+  method add = new calculator_add arg self#equals
+  method sub = new calculator_sub arg self#equals
+  method equals = arg
+end and calculator_add arg acc = object
+  inherit calculator arg acc
+  method enter n = new calculator_add n acc
+  method equals = acc +. arg
+end and calculator_sub arg acc = object
+  inherit calculator arg acc
+  method enter n = new calculator_sub n acc
+  method equals = acc -. arg
+end;;
+[%%expect{|
+class calculator :
+  float ->
+  float ->
+  object
+    val acc : float
+    val arg : float
+    method add : calculator
+    method enter : float -> calculator
+    method equals : float
+    method sub : calculator
+  end
+and calculator_add :
+  float ->
+  float ->
+  object
+    val acc : float
+    val arg : float
+    method add : calculator
+    method enter : float -> calculator
+    method equals : float
+    method sub : calculator
+  end
+and calculator_sub :
+  float ->
+  float ->
+  object
+    val acc : float
+    val arg : float
+    method add : calculator
+    method enter : float -> calculator
+    method equals : float
+    method sub : calculator
+  end
+|}];;
+
+let calculator = new calculator 0. 0.;;
+[%%expect{|
+val calculator : calculator = 
+|}];;
+
+(calculator#enter 5.)#equals;;
+[%%expect{|
+- : float = 5.
+|}];;
+((calculator#enter 5.)#sub#enter 3.5)#equals;;
+[%%expect{|
+- : float = 1.5
+|}];;
+(calculator#enter 5.)#add#add#equals;;
+[%%expect{|
+- : float = 15.
+|}];;
diff --git a/testsuite/tests/typing-objects/Tests.ml b/testsuite/tests/typing-objects/Tests.ml
new file mode 100644
index 00000000..82a2bbc9
--- /dev/null
+++ b/testsuite/tests/typing-objects/Tests.ml
@@ -0,0 +1,920 @@
+(* TEST
+   * expect
+*)
+
+(* Subtyping is "syntactic" *)
+fun (x : < x : int >) y z -> (y :> 'a), (x :> 'a), (z :> 'a);;
+[%%expect{|
+- : < x : int > ->
+    < x : int > -> < x : int > -> < x : int > * < x : int > * < x : int >
+= 
+|}];;
+(* - : (< x : int > as 'a) -> 'a -> 'a * 'a =  *)
+
+(* Quirks of class typing.  *)
+class ['a] c () = object
+  method f = (new c (): int c)
+end and ['a] d () = object
+  inherit ['a] c ()
+end;;
+[%%expect{|
+class ['a] c : unit -> object constraint 'a = int method f : int c end
+and ['a] d : unit -> object constraint 'a = int method f : int c end
+|}];;
+(* class ['a] c : unit -> object constraint 'a = int method f : 'a c end *)
+(* and ['a] d : unit -> object constraint 'a = int method f : 'a c end *)
+
+(* 'a free in class d *)
+class ['a] c () = object
+  method f (x : 'a) = ()
+end and d () = object
+  inherit ['a] c ()
+end;;
+[%%expect{|
+Lines 3-5, characters 4-3:
+3 | ....and d () = object
+4 |   inherit ['a] c ()
+5 | end..
+Error: Some type variables are unbound in this type:
+         class d : unit -> object method f : 'a -> unit end
+       The method f has type 'a -> unit where 'a is unbound
+|}];;
+
+(* Create instance #c *)
+class virtual c () = object
+end and ['a] d () = object
+  constraint 'a = #c
+  method f (x : #c) = (x#x : int)
+end;;
+[%%expect{|
+class virtual c : unit -> object  end
+and ['a] d :
+  unit -> object constraint 'a = < x : int; .. > method f : 'a -> int end
+|}];;
+(* class virtual c : unit -> object  end *)
+(* and ['a] d : *)
+(*  unit -> object constraint 'a = < x : int; .. > method f : 'a -> int end *)
+
+class ['a] c () = object
+  constraint 'a = int
+end and ['a] d () = object
+  constraint 'a = 'b #c
+end;;
+[%%expect{|
+class ['a] c : unit -> object constraint 'a = int end
+and ['a] d : unit -> object constraint 'a = int #c end
+|}];;
+(* class ['a] c : unit -> object constraint 'a = int end
+   and ['a] d : unit -> object constraint 'a = int #c end *)
+(* Class type constraint *)
+module F(X:sig type t end) = struct
+  class type ['a] c = object
+    method m: 'a -> X.t
+  end
+end
+class ['a] c = object
+  constraint 'a = 'a #F(Int).c
+end
+[%%expect {|
+module F :
+  functor (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
+|}]
+
+(* Self as parameter *)
+class ['a] c (x : 'a) = object (self : 'b)
+  constraint 'a = 'b
+  method f = self
+end;;
+[%%expect{|
+class ['a] c :
+  'a -> object ('a) constraint 'a = < f : 'a; .. > method f : 'a end
+|}];;
+new c;;
+[%%expect{|
+- : ('a c as 'a) -> 'a = 
+|}];;
+(* class ['a] c :
+  'a -> object ('a) constraint 'a = < f : 'a; .. > method f : 'a end *)
+(* - : ('a c as 'a) -> 'a =  *)
+
+class x () = object
+  method virtual f : int
+end;;
+[%%expect{|
+Lines 1-3, characters 0-3:
+1 | class x () = object
+2 |   method virtual f : int
+3 | end..
+Error: This class should be virtual. The following methods are undefined : f
+|}];;
+(* The class x should be virtual:  its methods f is undefined *)
+
+(* Supplementary method g *)
+class virtual c ((x : 'a): < f : int >) = object (_ : 'a) end
+and virtual d x = object (_ : 'a)
+  inherit c x
+  method g = true
+end;;
+[%%expect{|
+Line 1, characters 49-57:
+1 | class virtual c ((x : 'a): < f : int >) = object (_ : 'a) end
+                                                     ^^^^^^^^
+Error: This pattern cannot match self: it only matches values of type
+       < f : int >
+|}];;
+
+(* Constraint not respected *)
+class ['a] c () = object
+  constraint 'a = int
+  method f x = (x : bool c)
+end;;
+[%%expect{|
+Lines 1-4, characters 0-3:
+1 | class ['a] c () = object
+2 |   constraint 'a = int
+3 |   method f x = (x : bool c)
+4 | end..
+Error: The abbreviation c is used with parameters bool c
+       which are incompatible with constraints int c
+|}];;
+
+(* Different constraints *)
+class ['a, 'b] c () = object
+  constraint 'a = int -> 'c
+  constraint 'b = 'a *  * 'c * 'd
+  method f (x : 'a) (y : 'b) = ()
+end;;
+[%%expect{|
+class ['a, 'b] c :
+  unit ->
+  object
+    constraint 'a = int -> 'c
+    constraint 'b = 'a * < x : 'b > * 'c * 'd
+    method f : 'a -> 'b -> unit
+  end
+|}];;
+class ['a, 'b] d () = object
+  inherit ['a, 'b] c ()
+end;;
+[%%expect{|
+class ['a, 'b] d :
+  unit ->
+  object
+    constraint 'a = int -> 'c
+    constraint 'b = 'a * < x : 'b > * 'c * 'd
+    method f : 'a -> 'b -> unit
+  end
+|}];;
+
+(* Non-generic constraint *)
+let x = ref [];;
+[%%expect{|
+val x : '_weak1 list ref = {contents = []}
+|}];;
+class ['a] c () = object
+  method f = (x : 'a)
+end;;
+[%%expect{|
+Lines 1-3, characters 0-3:
+1 | class ['a] c () = object
+2 |   method f = (x : 'a)
+3 | end..
+Error: The type of this class,
+       class ['a] c :
+         unit -> object constraint 'a = '_weak1 list ref method f : 'a end,
+       contains type variables that cannot be generalized
+|}];;
+
+(* Abbreviations *)
+type 'a c = 
+and 'a d = ;;
+[%%expect{|
+Line 1, characters 0-32:
+1 | type 'a c = 
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This recursive type is not regular.
+       The type constructor c is defined as
+         type 'a c
+       but it is used as
+         int c
+       after the following expansion(s):
+         'a d = < f : int c >
+       All uses need to match the definition for the recursive type to be regular.
+|}];;
+type 'a c = 
+and 'a d = ;;
+[%%expect{|
+type 'a c = < f : 'a c; g : 'a d >
+and 'a d = < f : 'a c >
+|}];;
+type 'a c = 
+and 'a d = ;;
+[%%expect{|
+type 'a c = < f : 'a c >
+and 'a d = < f : int c >
+|}];;
+type 'a u = < x : 'a>
+and 'a t = 'a t u;;
+[%%expect{|
+Line 2, characters 0-17:
+2 | and 'a t = 'a t u;;
+    ^^^^^^^^^^^^^^^^^
+Error: The definition of t contains a cycle:
+       'a t u
+|}];; (* fails since 4.04 *)
+type 'a u = 'a
+and 'a t = 'a t u;;
+[%%expect{|
+Line 2, characters 0-17:
+2 | and 'a t = 'a t u;;
+    ^^^^^^^^^^^^^^^^^
+Error: The type abbreviation t is cyclic
+|}];;
+type 'a u = 'a;;
+[%%expect{|
+type 'a u = 'a
+|}];;
+type t = t u * t u;;
+[%%expect{|
+Line 1, characters 0-18:
+1 | type t = t u * t u;;
+    ^^^^^^^^^^^^^^^^^^
+Error: The type abbreviation t is cyclic
+|}];;
+
+type t =  as 'a;;
+[%%expect{|
+type t = < x : 'a > as 'a
+|}];;
+type 'a u = 'a;;
+[%%expect{|
+type 'a u = 'a
+|}];;
+fun (x : t) (y : 'a u) -> x = y;;
+[%%expect{|
+- : t -> t u -> bool = 
+|}];;
+fun (x : t) (y : 'a u) -> y = x;;
+[%%expect{|
+- : t -> t u -> bool = 
+|}];;
+(* - : t -> t u -> bool =  *)
+
+(* Modules *)
+module M =
+  struct
+    class ['a, 'b] c (x: int) (y: 'b) = object
+      constraint 'a = int -> bool
+      val x : float list = []
+      val y = y
+      method f (x : 'a) = ()
+      method g = y
+    end
+  end;;
+[%%expect{|
+module M :
+  sig
+    class ['a, 'b] c :
+      int ->
+      'b ->
+      object
+        constraint 'a = int -> bool
+        val x : float list
+        val y : 'b
+        method f : 'a -> unit
+        method g : 'b
+      end
+  end
+|}];;
+module M' = (M :
+  sig
+     class virtual ['a, 'b] c : int -> 'b -> object
+       constraint 'a = int -> bool
+       val x : float list
+       val y : 'b
+       method f : 'a -> unit
+       method g : 'b
+     end
+   end);;
+[%%expect{|
+module M' :
+  sig
+    class virtual ['a, 'b] c :
+      int ->
+      'b ->
+      object
+        constraint 'a = int -> bool
+        val x : float list
+        val y : 'b
+        method f : 'a -> unit
+        method g : 'b
+      end
+  end
+|}];;
+class ['a, 'b] d () y = object inherit ['a, 'b] M.c 7 y end;;
+[%%expect{|
+class ['a, 'b] d :
+  unit ->
+  'b ->
+  object
+    constraint 'a = int -> bool
+    val x : float list
+    val y : 'b
+    method f : 'a -> unit
+    method g : 'b
+  end
+|}];;
+class ['a, 'b] e () y = object inherit ['a, 'b] M'.c 1 y end;;
+[%%expect{|
+class ['a, 'b] e :
+  unit ->
+  'b ->
+  object
+    constraint 'a = int -> bool
+    val x : float list
+    val y : 'b
+    method f : 'a -> unit
+    method g : 'b
+  end
+|}];;
+(new M.c 3 "a")#g;;
+[%%expect{|
+- : string = "a"
+|}];;
+(new d () 10)#g;;
+[%%expect{|
+- : int = 10
+|}];;
+(new e () 7.1)#g;;
+[%%expect{|
+- : float = 7.1
+|}];;
+open M;;
+[%%expect{|
+|}];;
+(new c 5 true)#g;;
+[%%expect{|
+- : bool = true
+|}];;
+
+(* #cl when cl is closed *)
+module M = struct class ['a] c () = object method f (x : 'a) = () end end;;
+[%%expect{|
+module M : sig class ['a] c : unit -> object method f : 'a -> unit end end
+|}];;
+module M' =
+  (M : sig class ['a] c : unit -> object method f : 'a -> unit end end);;
+[%%expect{|
+module M' : sig class ['a] c : unit -> object method f : 'a -> unit end end
+|}];;
+fun x -> (x :> 'a #M.c);;
+[%%expect{|
+- : ('a #M.c as 'b) -> 'b = 
+|}];;
+fun x -> (x :> 'a #M'.c);;
+[%%expect{|
+- : ('a #M'.c as 'b) -> 'b = 
+|}];;
+class ['a] c (x : 'b #c) = object end;;
+[%%expect{|
+class ['a] c : 'a #c -> object  end
+|}];;
+class ['a] c (x : 'b #c) = object end;;
+[%%expect{|
+class ['a] c : 'a #c -> object  end
+|}];;
+
+(* Computation order *)
+class c () = object method f = 1 end and d () = object method f = 2 end;;
+[%%expect{|
+class c : unit -> object method f : int end
+and d : unit -> object method f : int end
+|}];;
+class e () = object inherit c () inherit d () end;;
+[%%expect{|
+class e : unit -> object method f : int end
+|}];;
+(new e ())#f;;
+[%%expect{|
+- : int = 2
+|}];;
+class c () = object val x = - true val y = -. () end;;
+[%%expect{|
+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
+|}];;
+
+class c () = object method f = 1 method g = 1 method h = 1 end;;
+[%%expect{|
+class c : unit -> object method f : int method g : int method h : int end
+|}];;
+class d () = object method h = 2 method i = 2 method j = 2 end;;
+[%%expect{|
+class d : unit -> object method h : int method i : int method j : int end
+|}];;
+class e () = object
+  method f = 3
+  inherit c ()
+  method g = 3
+  method i = 3
+  inherit d ()
+  method j = 3
+end;;
+[%%expect{|
+class e :
+  unit ->
+  object
+    method f : int
+    method g : int
+    method h : int
+    method i : int
+    method j : int
+  end
+|}];;
+let e = new e ();;
+[%%expect{|
+val e : e = 
+|}];;
+e#f, e#g, e#h, e#i, e#j;;
+[%%expect{|
+- : int * int * int * int * int = (1, 3, 2, 2, 3)
+|}];;
+
+class c a = object val x = 1 val y = 1 val z = 1 val a = a end;;
+[%%expect{|
+class c : 'a -> object val a : 'a val x : int val y : int val z : int end
+|}];;
+class d b = object val z = 2 val t = 2 val u = 2 val b = b end;;
+[%%expect{|
+class d : 'a -> object val b : 'a val t : int val u : int val z : int end
+|}];;
+class e () = object
+  val x = 3
+  inherit c 5
+  val y = 3
+  val t = 3
+  inherit d 7
+  val u = 3
+  method x = x
+  method y = y
+  method z = z
+  method t = t
+  method u = u
+  method a = a
+  method b = b
+end;;
+[%%expect{|
+Line 3, characters 10-13:
+3 |   inherit c 5
+              ^^^
+Warning 13: the following instance variables are overridden by the class c :
+  x
+The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
+Line 4, characters 6-7:
+4 |   val y = 3
+          ^
+Warning 13: the instance variable y is overridden.
+The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
+Line 6, characters 10-13:
+6 |   inherit d 7
+              ^^^
+Warning 13: the following instance variables are overridden by the class d :
+  t z
+The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
+Line 7, characters 6-7:
+7 |   val u = 3
+          ^
+Warning 13: the instance variable u is overridden.
+The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
+class e :
+  unit ->
+  object
+    val a : int
+    val b : int
+    val t : int
+    val u : int
+    val x : int
+    val y : int
+    val z : int
+    method a : int
+    method b : int
+    method t : int
+    method u : int
+    method x : int
+    method y : int
+    method z : int
+  end
+|}];;
+let e = new e ();;
+[%%expect{|
+val e : e = 
+|}];;
+e#x, e#y, e#z, e#t, e#u, e#a, e#b;;
+[%%expect{|
+- : int * int * int * int * int * int * int = (1, 3, 2, 2, 3, 5, 7)
+|}];;
+
+class c (x : int) (y : int) = object
+  val x = x
+  val y = y
+  method x = x
+  method y = y
+end;;
+[%%expect{|
+class c :
+  int ->
+  int -> object val x : int val y : int method x : int method y : int end
+|}];;
+class d x y = object inherit c x y end;;
+[%%expect{|
+class d :
+  int ->
+  int -> object val x : int val y : int method x : int method y : int end
+|}];;
+let c = new c 1 2 in c#x, c#y;;
+[%%expect{|
+- : int * int = (1, 2)
+|}];;
+let d = new d 1 2 in d#x, d#y;;
+[%%expect{|
+- : int * int = (1, 2)
+|}];;
+
+(* Parameters which does not appear in the object type *)
+class ['a] c (x : 'a) = object end;;
+[%%expect{|
+class ['a] c : 'a -> object  end
+|}];;
+new c;;
+[%%expect{|
+- : 'a -> 'a c = 
+|}];;
+
+(* Private variables *)
+(*
+module type M = sig
+  class c : unit -> object val x : int end
+  class d : unit -> object inherit c val private x : int val x : bool end
+end;;
+[%%expect{|
+foo
+|}];;
+class c (x : int) =
+  val private mutable x = x
+  method get = x
+  method set y = x <- y
+end;;
+[%%expect{|
+foo
+|}];;
+let c = new c 5;;
+[%%expect{|
+foo
+|}];;
+c#get;;
+[%%expect{|
+foo
+|}];;
+c#set 7; c#get;;
+[%%expect{|
+foo
+|}];;
+
+
+class c () = val x = 1 val y = 1 method c = x end;;
+[%%expect{|
+foo
+|}];;
+class d () = inherit c () val private x method d = x end;;
+[%%expect{|
+foo
+|}];;
+class e () =
+  val x = 2 val y = 2 inherit d () method x = x method y = y
+end;;
+[%%expect{|
+foo
+|}];;
+let e = new e () in e#x, e#y, e#c, e#d;;
+[%%expect{|
+foo
+|}];;
+*)
+
+(* Forgotten variables in interfaces *)
+module M :
+  sig
+    class c : unit -> object
+      method xc : int
+    end
+  end =
+  struct
+    class c () = object
+      val x = 1
+      method xc = x
+    end
+  end;;
+[%%expect{|
+module M : sig class c : unit -> object method xc : int end end
+|}];;
+class d () = object
+  val x = 2
+  method xd = x
+  inherit M.c ()
+end;;
+[%%expect{|
+class d : unit -> object val x : int method xc : int method xd : int end
+|}];;
+let d = new d () in d#xc, d#xd;;
+[%%expect{|
+- : int * int = (1, 2)
+|}];;
+
+class virtual ['a] matrix (sz, init : int * 'a) = object
+  val m = Array.make_matrix sz sz init
+  method add (mtx : 'a matrix) = (mtx#m.(0).(0) : 'a)
+end;;
+[%%expect{|
+Lines 1-4, characters 0-3:
+1 | class virtual ['a] matrix (sz, init : int * 'a) = object
+2 |   val m = Array.make_matrix sz sz init
+3 |   method add (mtx : 'a matrix) = (mtx#m.(0).(0) : 'a)
+4 | end..
+Error: The abbreviation 'a matrix expands to type < add : 'a matrix -> 'a >
+       but is used with type < m : 'a array array; .. >
+|}];;
+
+class c () = object method m = new c () end;;
+[%%expect{|
+class c : unit -> object method m : c end
+|}];;
+(new c ())#m;;
+[%%expect{|
+- : c = 
+|}];;
+module M = struct class c () = object method m = new c () end end;;
+[%%expect{|
+module M : sig class c : unit -> object method m : c end end
+|}];;
+(new M.c ())#m;;
+[%%expect{|
+- : M.c = 
+|}];;
+
+type uu = A of int | B of ( as 'a);;
+[%%expect{|
+type uu = A of int | B of (< leq : 'a > as 'a)
+|}];;
+
+class virtual c () = object (_ : 'a) method virtual m : 'a end;;
+[%%expect{|
+class virtual c : unit -> object ('a) method virtual m : 'a end
+|}];;
+module S = (struct
+  let f (x : #c) = x
+end : sig
+  val f : (#c as 'a) -> 'a
+end);;
+[%%expect{|
+module S : sig val f : (#c as 'a) -> 'a end
+|}];;
+module S = (struct
+  let f (x : #c) = x
+end : sig
+  val f : #c -> #c
+end);;
+[%%expect{|
+Lines 1-3, characters 12-3:
+1 | ............struct
+2 |   let f (x : #c) = x
+3 | end......
+Error: Signature mismatch:
+       Modules do not match:
+         sig val f : (#c as 'a) -> 'a end
+       is not included in
+         sig val f : #c -> #c end
+       Values do not match:
+         val f : (#c as 'a) -> 'a
+       is not included in
+         val f : #c -> #c
+|}];;
+
+module M = struct type t = int class t () = object end end;;
+[%%expect{|
+Line 1, characters 37-38:
+1 | module M = struct type t = int class t () = object end end;;
+                                         ^
+Error: Multiple definition of the type name t.
+       Names must be unique in a given structure or signature.
+|}];;
+
+fun x -> (x :> < m : 'a -> 'a > as 'a);;
+[%%expect{|
+- : < m : (< m : 'a > as 'b) -> 'b as 'a; .. > -> 'b = 
+|}];;
+
+fun x -> (x : int -> bool :> 'a -> 'a);;
+[%%expect{|
+Line 1, characters 9-38:
+1 | fun x -> (x : int -> bool :> 'a -> 'a);;
+             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type int -> bool is not a subtype of int -> int
+       Type bool is not a subtype of int
+|}];;
+fun x -> (x : int -> bool :> int -> int);;
+[%%expect{|
+Line 1, characters 9-40:
+1 | fun x -> (x : int -> bool :> int -> int);;
+             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type int -> bool is not a subtype of int -> int
+       Type bool is not a subtype of int
+|}];;
+fun x -> (x : < > :> < .. >);;
+[%%expect{|
+- : <  > -> <  > = 
+|}];;
+fun x -> (x : < .. > :> < >);;
+[%%expect{|
+- : < .. > -> <  > = 
+|}];;
+
+let x = ref [];;
+[%%expect{|
+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
+|}];;
+x;;
+[%%expect{|
+- : < m : int > list ref = {contents = []}
+|}];;
+
+type 'a t;;
+[%%expect{|
+type 'a t
+|}];;
+fun (x : 'a t as 'a) -> ();;
+[%%expect{|
+Line 1, characters 9-19:
+1 | fun (x : 'a t as 'a) -> ();;
+             ^^^^^^^^^^
+Error: This alias is bound to type 'a t but is used as an instance of type 'a
+       The type variable 'a occurs inside 'a t
+|}];;
+fun (x : 'a t) -> (x : 'a); ();;
+[%%expect{|
+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
+       The type variable 'a occurs inside 'a t
+|}];;
+type 'a t = < x : 'a >;;
+[%%expect{|
+type 'a t = < x : 'a >
+|}];;
+fun (x : 'a t as 'a) -> ();;
+[%%expect{|
+- : ('a t as 'a) -> unit = 
+|}];;
+fun (x : 'a t) -> (x : 'a); ();;
+[%%expect{|
+Line 1, characters 18-26:
+1 | fun (x : 'a t) -> (x : 'a); ();;
+                      ^^^^^^^^
+Warning 10: this expression should have type unit.
+- : ('a t as 'a) t -> unit = 
+|}];;
+
+class ['a] c () = object
+  constraint 'a = < .. > -> unit
+  method m = (fun x -> () : 'a)
+end;;
+[%%expect{|
+class ['a] c :
+  unit ->
+  object constraint 'a = (< .. > as 'b) -> unit method m : 'b -> unit end
+|}];;
+class ['a] c () = object
+  constraint 'a = unit -> < .. >
+  method m (f : 'a) = f ()
+end;;
+[%%expect{|
+class ['a] c :
+  unit ->
+  object constraint 'a = unit -> (< .. > as 'b) method m : 'a -> 'b end
+|}];;
+
+class c () = object (self)
+  method private m = 1
+  method n = self#m
+end;;
+[%%expect{|
+class c : unit -> object method private m : int method n : int end
+|}];;
+
+class d () = object (self)
+  inherit c ()
+  method o = self#m
+end;;
+[%%expect{|
+class d :
+  unit -> object method private m : int method n : int method o : int end
+|}];;
+
+let x = new d () in x#n, x#o;;
+[%%expect{|
+- : int * int = (1, 1)
+|}];;
+
+class c () = object method virtual m : int method private m = 1 end;;
+[%%expect{|
+class c : unit -> object method m : int end
+|}];;
+
+(* Recursion (cf. PR#5291) *)
+
+class a = let _ = new b in object end
+and b = let _ = new a in object end;;
+[%%expect{|
+Line 1, characters 10-37:
+1 | class a = let _ = new b in object end
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of recursive class expression is not allowed
+|}];;
+
+class a = let _ = new a in object end;;
+[%%expect{|
+Line 1, characters 10-37:
+1 | class a = let _ = new a in object end;;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of recursive class expression is not allowed
+|}];;
+
+(* More tests about recursion in class declarations *)
+class a = let _x() = new a in object end;;
+[%%expect{|
+class a : object  end
+|}];;
+
+class a = object end
+and b = let _x() = new a in object end;;
+[%%expect{|
+class a : object  end
+and b : object  end
+|}];;
+
+class a = let x() = new a in let y = x() in object end;;
+[%%expect{|
+Line 1, characters 10-54:
+1 | class a = let x() = new a in let y = x() in object end;;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of recursive class expression is not allowed
+|}];;
+
+class a = object end
+and b = let x() = new a in let y = x() in object end;;
+[%%expect{|
+Line 2, characters 8-52:
+2 | and b = let x() = new a in let y = x() in object end;;
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of recursive class expression is not allowed
+|}];;
+
+class a = object val x = 3 val y = x + 2 end;;
+[%%expect{|
+Line 1, characters 35-36:
+1 | class a = object val x = 3 val y = x + 2 end;;
+                                       ^
+Error: The instance variable x
+       cannot be accessed from the definition of another instance variable
+|}];;
+
+class a = object (self) val x = self#m method m = 3 end;;
+[%%expect{|
+Line 1, characters 32-36:
+1 | class a = object (self) val x = self#m method m = 3 end;;
+                                    ^^^^
+Error: The self variable self
+       cannot be accessed from the definition of an instance variable
+|}];;
+
+class a = object method m = 3 end
+class b = object inherit a as super val x = super#m end;;
+[%%expect{|
+class a : object method m : int end
+Line 2, characters 44-49:
+2 | class b = object inherit a as super val x = super#m end;;
+                                                ^^^^^
+Error: The ancestor variable super
+       cannot be accessed from the definition of an instance variable
+|}];;
diff --git a/testsuite/tests/typing-objects/abstract_rows.ml b/testsuite/tests/typing-objects/abstract_rows.ml
new file mode 100644
index 00000000..0ae3d307
--- /dev/null
+++ b/testsuite/tests/typing-objects/abstract_rows.ml
@@ -0,0 +1,26 @@
+(* TEST
+   * expect
+*)
+type u = 
+type t = private 
+
+let f (x:t) (y:u) = x = y;;
+[%%expect{|
+type u = < x : int >
+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
+       The second object type has an abstract row, it cannot be closed
+|}]
+
+
+let g (x:u) (y:t) = x = y;;
+[%%expect{|
+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
+       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
new file mode 100644
index 00000000..3256e48a
--- /dev/null
+++ b/testsuite/tests/typing-objects/dummy.ml
@@ -0,0 +1,177 @@
+(* TEST
+   * expect
+*)
+
+class virtual child1 parent =
+  object
+    method private parent = parent
+  end
+
+and virtual child2 =
+  object(_ : 'self)
+    constraint 'parent = < previous: 'self option; .. >
+    method private virtual parent: 'parent
+  end
+
+[%%expect{|
+class virtual child1 : 'a -> object method private parent : 'a end
+and virtual child2 :
+  object ('a)
+    method private virtual parent : < previous : 'a option; .. >
+  end
+|}]
+
+class virtual child1' parent =
+  object
+    method private parent = parent
+  end
+
+and virtual child2' =
+  object(_ : 'self)
+    constraint 'parent = < previous: 'self option; .. >
+    method private virtual parent: 'parent
+  end
+
+and foo = object(self)
+  method previous = None
+  method child =
+    object
+      inherit child1' self
+      inherit child2'
+    end
+end;;
+
+[%%expect{|
+Line 16, characters 22-26:
+16 |       inherit child1' self
+                           ^^^^
+Error: This expression has type < child : 'a; previous : 'b option; .. >
+       but an expression was expected of type 'c
+       Self type cannot escape its class
+|}]
+
+(* Whether we have [class foo1] or [let foo1] doesn't change a thing. *)
+class foo1 = object(self)
+  method previous = None
+  method child =
+    object
+      inherit child1 self
+      inherit child2
+    end
+end;;
+[%%expect{|
+class foo1 : object method child : child2 method previous : child2 option end
+|}]
+
+class nested = object
+  method obj = object(self)
+    method previous = None
+    method child () =
+      object
+        inherit child1 self
+        inherit child2
+      end
+  end
+end;;
+[%%expect{|
+class nested :
+  object
+    method obj : < child : unit -> child2; previous : child2 option >
+  end
+|}]
+
+class just_to_see = object(self)
+  method previous = None
+  method child =
+    let o =
+      object
+        inherit child1 self
+        inherit child2
+      end
+    in
+    o
+end;;
+[%%expect{|
+class just_to_see :
+  object method child : child2 method previous : child2 option end
+|}]
+
+class just_to_see2 = object
+  method obj = object(self)
+    method previous = None
+    method child =
+      let o =
+        object
+          inherit child1 self
+          inherit child2
+        end
+      in
+      o
+  end
+end;;
+[%%expect{|
+class just_to_see2 :
+  object method obj : < child : child2; previous : child2 option > end
+|}]
+
+type gadt = Not_really_though : gadt
+
+class just_to_see3 = object(self)
+  method previous = None
+  method child Not_really_though =
+    object
+      inherit child1 self
+      inherit child2
+    end
+end;;
+[%%expect{|
+type gadt = Not_really_though : gadt
+class just_to_see3 :
+  object method child : gadt -> child2 method previous : child2 option end
+|}]
+
+class leading_up_to = object(self : 'a)
+  method previous : 'a option = None
+  method child =
+    object
+      inherit child1 self
+      inherit child2
+    end
+end;;
+[%%expect{|
+Lines 4-7, characters 4-7:
+4 | ....object
+5 |       inherit child1 self
+6 |       inherit child2
+7 |     end
+Error: Cannot close type of object literal:
+       < child : '_weak1; previous : 'a option; _.. > as 'a
+       it has been unified with the self type of a class that is not yet
+       completely defined.
+|}]
+
+class assertion_failure = object(self : 'a)
+  method previous : 'a option = None
+  method child =
+    object
+      inherit child1 self
+      inherit child2
+
+      method previous = None
+      method child = assert false
+    end
+end;;
+[%%expect{|
+Lines 4-10, characters 4-7:
+ 4 | ....object
+ 5 |       inherit child1 self
+ 6 |       inherit child2
+ 7 |
+ 8 |       method previous = None
+ 9 |       method child = assert false
+10 |     end
+Error: Cannot close type of object literal:
+       < child : '_weak2; previous : 'a option; _.. > as 'a
+       it has been unified with the self type of a class that is not yet
+       completely defined.
+|}]
diff --git a/testsuite/tests/typing-objects/errors.ml b/testsuite/tests/typing-objects/errors.ml
new file mode 100644
index 00000000..bd905628
--- /dev/null
+++ b/testsuite/tests/typing-objects/errors.ml
@@ -0,0 +1,15 @@
+(* TEST
+   * expect
+*)
+
+class type virtual ['a] c = object constraint 'a = [<`A of int & float] end
+[%%expect {|
+Line 1, characters 0-75:
+1 | class type virtual ['a] c = object constraint 'a = [<`A of int & float] end
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type of this class,
+       class virtual ['a] c :
+         object constraint 'a = _[< `A of int & float ] end,
+       contains non-collapsible conjunctive types in constraints.
+       Type int is not compatible with type float
+|}]
diff --git a/testsuite/tests/typing-objects/open_in_classes.ml b/testsuite/tests/typing-objects/open_in_classes.ml
new file mode 100644
index 00000000..05f33b91
--- /dev/null
+++ b/testsuite/tests/typing-objects/open_in_classes.ml
@@ -0,0 +1,30 @@
+(* TEST
+   * expect
+*)
+
+module M = struct
+  type t = int
+  let x = 42
+end
+;;
+[%%expect{|
+module M : sig type t = int val x : int end
+|}]
+class c =
+  let open M in
+  object
+    method f : t = x
+  end
+;;
+[%%expect{|
+class c : object method f : M.t end
+|}]
+class type ct =
+  let open M in
+  object
+    method f : t
+  end
+;;
+[%%expect{|
+class type ct = object method f : M.t end
+|}]
diff --git a/testsuite/tests/typing-objects/pr5545.ml b/testsuite/tests/typing-objects/pr5545.ml
new file mode 100644
index 00000000..8bb92adf
--- /dev/null
+++ b/testsuite/tests/typing-objects/pr5545.ml
@@ -0,0 +1,38 @@
+(* TEST
+   * expect
+*)
+
+type foo = int;;
+[%%expect{|
+type foo = int
+|}]
+
+class o =
+  object(this)
+    method x : foo = 10
+    method y : int = this # x
+  end;;
+[%%expect{|
+class o : object method x : foo method y : int end
+|}]
+
+
+class o =
+  object(this)
+    method x : foo = 10
+    method y = (this # x : int)
+  end;;
+[%%expect{|
+class o : object method x : foo method y : int end
+|}]
+
+
+
+class o =
+  object(this)
+    method x : int = (10 : int)
+    method y = (this # x : foo)
+  end;;
+[%%expect{|
+class o : object method x : int method y : foo end
+|}]
diff --git a/testsuite/tests/typing-objects/pr5619_bad.ml b/testsuite/tests/typing-objects/pr5619_bad.ml
new file mode 100644
index 00000000..bfbf6dd8
--- /dev/null
+++ b/testsuite/tests/typing-objects/pr5619_bad.ml
@@ -0,0 +1,55 @@
+(* TEST
+   * expect
+*)
+
+class type foo_t =
+  object
+    method foo: string
+  end
+
+type 'a name =
+    Foo: foo_t name
+  | Int: int name
+;;
+
+[%%expect{|
+class type foo_t = object method foo : string end
+type 'a name = Foo : foo_t name | Int : int name
+|}]
+
+class foo =
+  object(self)
+    method foo = "foo"
+    method cast =
+      function
+          Foo -> (self :> )
+  end
+;;
+[%%expect{|
+class foo :
+  object method cast : foo_t name -> < foo : string > method foo : string end
+|}]
+
+class foo: foo_t =
+  object(self)
+    method foo = "foo"
+    method cast: type a. a name -> a =
+      function
+          Foo -> (self :> foo_t)
+        | _ -> raise Exit
+  end
+;;
+[%%expect{|
+Lines 2-8, characters 2-5:
+2 | ..object(self)
+3 |     method foo = "foo"
+4 |     method cast: type a. a name -> a =
+5 |       function
+6 |           Foo -> (self :> foo_t)
+7 |         | _ -> raise Exit
+8 |   end
+Error: The class type
+         object method cast : 'a name -> 'a method foo : string end
+       is not matched by the class type foo_t
+       The public method cast cannot be hidden
+|}]
diff --git a/testsuite/tests/typing-objects/pr5858.ml b/testsuite/tests/typing-objects/pr5858.ml
new file mode 100644
index 00000000..a7f0bf84
--- /dev/null
+++ b/testsuite/tests/typing-objects/pr5858.ml
@@ -0,0 +1,16 @@
+(* TEST
+   * expect
+*)
+
+class type c = object end;;
+[%%expect{|
+class type c = object  end
+|}]
+
+module type S = sig class c: c end;;
+[%%expect{|
+Line 1, characters 29-30:
+1 | module type S = sig class c: c end;;
+                                 ^
+Error: The class type c is not yet completely defined
+|}]
diff --git a/testsuite/tests/typing-objects/pr6123_bad.ml b/testsuite/tests/typing-objects/pr6123_bad.ml
new file mode 100644
index 00000000..6dff6598
--- /dev/null
+++ b/testsuite/tests/typing-objects/pr6123_bad.ml
@@ -0,0 +1,35 @@
+(* TEST
+   * expect
+*)
+
+class virtual name =
+object
+end
+
+and func (args_ty, ret_ty) =
+object(self)
+  inherit name
+
+  val mutable memo_args = None
+
+  method arguments =
+    match memo_args with
+    | Some xs -> xs
+    | None ->
+      let args = List.map (fun ty -> new argument(self, ty)) args_ty in
+        memo_args <- Some args; args
+end
+
+and argument (func, ty) =
+object
+  inherit name
+end
+;;
+[%%expect{|
+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; .. >
+       but an expression was expected of type 'b
+       Self type cannot escape its class
+|}]
diff --git a/testsuite/tests/typing-objects/pr6383.ml b/testsuite/tests/typing-objects/pr6383.ml
new file mode 100644
index 00000000..12bc876e
--- /dev/null
+++ b/testsuite/tests/typing-objects/pr6383.ml
@@ -0,0 +1,11 @@
+(* TEST
+   * expect
+*)
+
+let f (x: #M.foo) = 0;;
+[%%expect{|
+Line 1, characters 11-16:
+1 | let f (x: #M.foo) = 0;;
+               ^^^^^
+Error: Unbound module M
+|}];;
diff --git a/testsuite/tests/typing-objects/pr6907_bad.ml b/testsuite/tests/typing-objects/pr6907_bad.ml
new file mode 100644
index 00000000..427ad987
--- /dev/null
+++ b/testsuite/tests/typing-objects/pr6907_bad.ml
@@ -0,0 +1,23 @@
+(* TEST
+   * expect
+*)
+
+class type ['e] t = object('s)
+  method update : 'e -> 's
+end;;
+[%%expect{|
+class type ['e] t = object ('a) method update : 'e -> 'a end
+|}];;
+
+module type S = sig
+  class base : 'e -> ['e] t
+end;;
+[%%expect{|
+Line 2, characters 2-27:
+2 |   class base : 'e -> ['e] t
+      ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Some type variables are unbound in this type:
+         class base : 'e -> ['e] t
+       The method update has type 'e -> < update : 'a; .. > as 'a where 'e
+       is unbound
+|}];;
diff --git a/testsuite/tests/typing-objects/pr7711_ok.ml b/testsuite/tests/typing-objects/pr7711_ok.ml
new file mode 100644
index 00000000..7f188cf5
--- /dev/null
+++ b/testsuite/tests/typing-objects/pr7711_ok.ml
@@ -0,0 +1,15 @@
+(* TEST
+   * expect
+*)
+
+type 'a r =  int; .. > as 'a;;
+[%%expect{|
+type 'a r = 'a constraint 'a = < w : int -> int; .. >
+|}];;
+
+class type virtual ct = object('self)
+  constraint 'self = 'not_self r
+end;;
+[%%expect{|
+class type virtual ct = object method virtual w : int -> int end
+|}];;
diff --git a/testsuite/tests/typing-objects/self_cannot_be_closed.ml b/testsuite/tests/typing-objects/self_cannot_be_closed.ml
new file mode 100644
index 00000000..f2cbc406
--- /dev/null
+++ b/testsuite/tests/typing-objects/self_cannot_be_closed.ml
@@ -0,0 +1,17 @@
+(* TEST
+   * expect
+ *)
+let is_empty (x : < >) = ();;
+[%%expect {|
+val is_empty : <  > -> unit = 
+|}]
+
+class c = object (self) method private foo = is_empty self end;;
+[%%expect {|
+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
+         <  >
+       Self type cannot be unified with a closed object type
+|}]
diff --git a/testsuite/tests/typing-objects/self_cannot_escape_pr7865.ml b/testsuite/tests/typing-objects/self_cannot_escape_pr7865.ml
new file mode 100644
index 00000000..d350fbb5
--- /dev/null
+++ b/testsuite/tests/typing-objects/self_cannot_escape_pr7865.ml
@@ -0,0 +1,21 @@
+(* TEST
+   * expect
+*)
+
+class c =
+object (o)
+  method foo = o
+end;;
+[%%expect {|
+class c : object ('a) method foo : 'a end
+|}]
+
+class d =
+object (o) inherit c
+  method bar = fun () ->
+    let o = List.fold_right (fun _ o -> o#foo) [] o in
+    let o = match () with () -> o in o
+end;;
+[%%expect {|
+class d : object ('a) method bar : unit -> 'a method foo : 'a end
+|}]
diff --git a/testsuite/tests/typing-ocamlc-i/pervasives_leitmotiv.compilers.reference b/testsuite/tests/typing-ocamlc-i/pervasives_leitmotiv.compilers.reference
new file mode 100644
index 00000000..def5d748
--- /dev/null
+++ b/testsuite/tests/typing-ocamlc-i/pervasives_leitmotiv.compilers.reference
@@ -0,0 +1,13 @@
+File "pervasives_leitmotiv.ml", line 1:
+Warning 63: The printed interface differs from the inferred interface.
+The inferred interface contained items which could not be printed
+properly due to name collisions between identifiers.
+File "pervasives_leitmotiv.ml", lines 10-12, characters 0-3:
+  Definition of module Stdlib/1
+File "_none_", line 1:
+  Definition of module Stdlib/2
+Beware that this warning is purely informational and will not catch
+all instances of erroneous printed interface.
+type fpclass = A
+module Stdlib : sig type fpclass = B end
+val f : fpclass -> Stdlib/1.fpclass -> Stdlib/2.fpclass
diff --git a/testsuite/tests/typing-ocamlc-i/pervasives_leitmotiv.ml b/testsuite/tests/typing-ocamlc-i/pervasives_leitmotiv.ml
new file mode 100644
index 00000000..f6ec3f9b
--- /dev/null
+++ b/testsuite/tests/typing-ocamlc-i/pervasives_leitmotiv.ml
@@ -0,0 +1,14 @@
+(* TEST
+flags = "-i -w +63"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+type fpclass = A
+
+module Stdlib = struct
+  type fpclass = B
+end
+
+let f A Stdlib.B = FP_normal
diff --git a/testsuite/tests/typing-ocamlc-i/pr4791.compilers.reference b/testsuite/tests/typing-ocamlc-i/pr4791.compilers.reference
new file mode 100644
index 00000000..b4938f16
--- /dev/null
+++ b/testsuite/tests/typing-ocamlc-i/pr4791.compilers.reference
@@ -0,0 +1,12 @@
+File "pr4791.ml", line 1:
+Warning 63: The printed interface differs from the inferred interface.
+The inferred interface contained items which could not be printed
+properly due to name collisions between identifiers.
+File "pr4791.ml", line 11, characters 2-12:
+  Definition of type t/1
+File "pr4791.ml", line 8, characters 0-10:
+  Definition of type t/2
+Beware that this warning is purely informational and will not catch
+all instances of erroneous printed interface.
+type t = A
+module B : sig type t = B val f : t/2 -> t/1 end
diff --git a/testsuite/tests/typing-ocamlc-i/pr4791.ml b/testsuite/tests/typing-ocamlc-i/pr4791.ml
new file mode 100644
index 00000000..f7810170
--- /dev/null
+++ b/testsuite/tests/typing-ocamlc-i/pr4791.ml
@@ -0,0 +1,13 @@
+(* TEST
+flags = "-i -w +63"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+type t = A
+module B =
+struct
+  type t = B
+  let f A = B
+end
diff --git a/testsuite/tests/typing-ocamlc-i/pr6323.compilers.reference b/testsuite/tests/typing-ocamlc-i/pr6323.compilers.reference
new file mode 100644
index 00000000..c06cebec
--- /dev/null
+++ b/testsuite/tests/typing-ocamlc-i/pr6323.compilers.reference
@@ -0,0 +1,14 @@
+File "pr6323.ml", line 1:
+Warning 63: The printed interface differs from the inferred interface.
+The inferred interface contained items which could not be printed
+properly due to name collisions between identifiers.
+File "pr6323.ml", line 15, characters 2-24:
+  Definition of type t/1
+File "pr6323.ml", line 8, characters 0-26:
+  Definition of type t/2
+Beware that this warning is purely informational and will not catch
+all instances of erroneous printed interface.
+type 'a t = B of 'a t list
+val foo : 'a -> 'b t list -> 'c t list
+module DT :
+  sig type 'a t = { bar : 'a; } val p : 'a t/2 list -> 'b t/2 list end
diff --git a/testsuite/tests/typing-ocamlc-i/pr6323.ml b/testsuite/tests/typing-ocamlc-i/pr6323.ml
new file mode 100644
index 00000000..7aff93f1
--- /dev/null
+++ b/testsuite/tests/typing-ocamlc-i/pr6323.ml
@@ -0,0 +1,17 @@
+(* TEST
+flags = "-i -w +63"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+type 'a t = B of 'a t list
+
+let rec foo f = function
+  | B(v)::tl -> B(foo f v)::foo f tl
+  | [] -> []
+
+module DT = struct
+  type 'a t = {bar : 'a}
+  let p t = foo (fun x -> x) t
+end
diff --git a/testsuite/tests/typing-ocamlc-i/pr7402.compilers.reference b/testsuite/tests/typing-ocamlc-i/pr7402.compilers.reference
new file mode 100644
index 00000000..46811961
--- /dev/null
+++ b/testsuite/tests/typing-ocamlc-i/pr7402.compilers.reference
@@ -0,0 +1,12 @@
+File "pr7402.ml", line 1:
+Warning 63: The printed interface differs from the inferred interface.
+The inferred interface contained items which could not be printed
+properly due to name collisions between identifiers.
+File "pr7402.ml", lines 14-16, characters 0-5:
+  Definition of module M/1
+File "pr7402.ml", lines 8-11, characters 0-3:
+  Definition of module M/2
+Beware that this warning is purely informational and will not catch
+all instances of erroneous printed interface.
+module M : sig type t val v : t end
+module F : sig module M : sig val v : M.t end val v : M/2.t end
diff --git a/testsuite/tests/typing-ocamlc-i/pr7402.ml b/testsuite/tests/typing-ocamlc-i/pr7402.ml
new file mode 100644
index 00000000..b1ccef88
--- /dev/null
+++ b/testsuite/tests/typing-ocamlc-i/pr7402.ml
@@ -0,0 +1,19 @@
+(* TEST
+flags = "-i -w +63"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module M: sig type t val v:t end = struct
+  type t = A
+  let v = A
+end
+
+module F = struct
+module M = struct
+    let v = M.v
+  end
+
+  let v = M.v
+end
diff --git a/testsuite/tests/typing-ocamlc-i/pr7620_bad.compilers.reference b/testsuite/tests/typing-ocamlc-i/pr7620_bad.compilers.reference
new file mode 100644
index 00000000..89740996
--- /dev/null
+++ b/testsuite/tests/typing-ocamlc-i/pr7620_bad.compilers.reference
@@ -0,0 +1,6 @@
+File "pr7620_bad.ml", line 10, characters 17-19:
+10 |   (function `A | `B -> () : 'a) (`A : [`A]);
+                      ^^
+Error: This pattern matches values of type [? `B ]
+       but a pattern was expected which matches values of type [ `A ]
+       Types for tag `B are incompatible
diff --git a/testsuite/tests/typing-ocamlc-i/pr7620_bad.ml b/testsuite/tests/typing-ocamlc-i/pr7620_bad.ml
new file mode 100644
index 00000000..25d199a6
--- /dev/null
+++ b/testsuite/tests/typing-ocamlc-i/pr7620_bad.ml
@@ -0,0 +1,11 @@
+(* TEST
+flags = "-i"
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+let t =
+  (function `A | `B -> () : 'a) (`A : [`A]);
+  (failwith "dummy" : 'a) (* to know how 'a is unified *)
diff --git a/testsuite/tests/typing-poly-bugs/pr5322_ok.ml b/testsuite/tests/typing-poly-bugs/pr5322_ok.ml
new file mode 100644
index 00000000..aeda3322
--- /dev/null
+++ b/testsuite/tests/typing-poly-bugs/pr5322_ok.ml
@@ -0,0 +1,13 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+type 'par t = 'par
+module M : sig val x :  end =
+  struct let x :  = Obj.magic () end
+
+let ident v = v
+class alias = object method alias : 'a . 'a t -> 'a = ident end
diff --git a/testsuite/tests/typing-poly-bugs/pr5673_ok.ml b/testsuite/tests/typing-poly-bugs/pr5673_ok.ml
new file mode 100644
index 00000000..f5a5cec7
--- /dev/null
+++ b/testsuite/tests/typing-poly-bugs/pr5673_ok.ml
@@ -0,0 +1,36 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module Classdef = struct
+  class virtual ['a, 'b, 'c] cl0 =
+    object
+      constraint 'c = < m : 'a -> 'b -> int; .. >
+    end
+
+  class virtual ['a, 'b] cl1 =
+    object
+      method virtual raise_trouble : int -> 'a
+      method virtual m : 'a -> 'b -> int
+    end
+
+  class virtual ['a, 'b] cl2 =
+    object
+      method virtual as_cl0 : ('a, 'b, ('a, 'b) cl1) cl0
+    end
+end
+
+module M : sig
+  type refer = { poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) }
+end = struct
+  type refer = { poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) }
+end
+
+type refer1 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) >
+type refer2 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) >
+
+(* Now this works too *)
+let f (x : refer1) = (x : refer2)
diff --git a/testsuite/tests/typing-poly-bugs/pr6922_ok.ml b/testsuite/tests/typing-poly-bugs/pr6922_ok.ml
new file mode 100644
index 00000000..0e8b7a4a
--- /dev/null
+++ b/testsuite/tests/typing-poly-bugs/pr6922_ok.ml
@@ -0,0 +1,216 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module Order = struct
+    module type Total = sig
+        type t
+        val compare: t -> t -> int
+    end
+end
+
+module type Profile = sig
+    module Priority: Order.Total
+
+    class type ['level] prioritizer = object
+        method code: 'level -> Priority.t
+        method tag: 'level -> string
+    end
+
+    class ['level] event:
+        'level #prioritizer -> 'level -> string ->
+        object
+            method prioritizer: 'level prioritizer
+            method level: 'level
+            method message: string
+        end
+
+    class type ['event] archiver = object
+        constraint 'event = 'level #event
+        method emit: 'event -> unit
+    end
+
+    class virtual ['archiver] agent:
+        'level #prioritizer -> 'level -> 'archiver list ->
+        object
+            constraint 'event = 'level #event
+            constraint 'archiver = 'event #archiver
+            val mutable archivers_: 'archiver list
+            val mutable limit_: Priority.t
+            method virtual private event: 'level -> string -> 'event
+            method setlimit: 'level -> unit
+            method enabled: 'level -> bool
+            method private put: 'a 'b. 'level -> ('event -> 'b) -> ('a, unit, string, string, string, 'b) format6 -> 'a
+        end
+end
+
+module Create(P: Order.Total) = struct
+    module Priority = P
+
+    class type ['level] prioritizer = object
+        method code: 'level -> Priority.t
+        method tag: 'level -> string
+    end
+
+    class ['level] event prioritizer level message =
+        let prioritizer = (prioritizer :> 'level prioritizer) in
+        object
+            method prioritizer = prioritizer
+            method level: 'level = level
+            method message: string = message
+        end
+
+    class type ['event] archiver = object
+        constraint 'event = 'level #event
+        method emit: 'event -> unit
+    end
+
+    class virtual ['archiver] agent prioritizer limit archivers =
+        let _ = (prioritizer :> 'level prioritizer) in
+        let _ = (archivers :> 'archiver list) in
+        object(self:'self)
+            constraint 'event = 'level #event
+            constraint 'archiver = 'event #archiver
+
+            val mutable archivers_ = archivers
+            val mutable limit_ = prioritizer#code limit
+
+            method virtual private event: 'level -> string -> 'event
+
+            method setlimit limit = limit_ <- prioritizer#code limit
+            method enabled limit = prioritizer#code limit >= limit_
+
+            method private put:
+                type a b. 'level -> ('event -> b) ->
+                (a, unit, string, string, string, b) format6 -> a
+                = fun level cont ->
+                    let f message =
+                        let e = self#event level message in
+                        if self#enabled level then
+                            List.iter (fun j -> j#emit e) archivers_;
+                        cont e
+                    in
+                    Printf.kprintf f
+        end
+end
+
+module Basic = struct
+    include Create(struct type t = int  let compare a b = b - a end)
+
+    type invalid = [ `Invalid ]
+    type fail = [ `Fail ]
+    type error = [ `Error ]
+    type warn = [ `Warn ]
+    type notice = [ `Notice ]
+    type info = [ `Info ]
+    type debug = [ `Debug ]
+
+    type basic = [ invalid | fail | error | warn | notice | info | debug ]
+    type enable = [ `None | `All ]
+    type level = [ basic | enable ]
+end
+
+class ['level] basic_prioritizer =
+    object(_:'self)
+        constraint 'self = 'level #Basic.prioritizer
+        constraint 'level = [> Basic.level ]
+
+        method code = function
+            | `All -> max_int
+            | `Invalid -> 7000
+            | `Fail -> 6000
+            | `Error -> 5000
+            | `Warn -> 4000
+            | `Notice -> 3000
+            | `Info -> 2000
+            | `Debug -> 1000
+            | `None -> min_int
+            | _ -> invalid_arg "Oni_cf_journal: no code defined for priority!"
+
+        method tag =
+            let invalid_ = "INVALID" in
+            let fail_ = "FAIL" in
+            let error_ = "ERROR" in
+            let warn_ = "WARN" in
+            let notice_ = "NOTICE" in
+            let info_ = "INFO" in
+            let debug_ = "DEBUG" in
+            function
+            | `Invalid -> invalid_
+            | `Fail -> fail_
+            | `Error -> error_
+            | `Warn -> warn_
+            | `Notice -> notice_
+            | `Info -> info_
+            | `Debug -> debug_
+            | _ -> invalid_arg "Oni_cf_journal: no tag defined for priority!"
+    end
+
+class ['event] basic_channel_archiver channel = object
+    constraint 'self = 'event #Basic.archiver
+    constraint 'level = [> Basic.level ]
+    constraint 'event = 'level #Basic.event
+
+    method channel = channel
+
+    method emit e =
+        let _ = (e :> 'event) in
+        let n = e#level in
+        let p = e#prioritizer in
+        if (p#code `Fail) - (p#code e#level) > 0 then begin
+            let tag = p#tag n in
+            let m = e#message in
+            Printf.fprintf channel "%s: %s\n" tag m;
+            flush channel
+        end
+end
+
+class virtual ['archiver] basic_agent prioritizer limit archivers =
+    let _ = (prioritizer :> 'level basic_prioritizer) in
+    (*
+    let _ = (limit : 'level) in
+    let _ = (archivers : 'archiver list) in
+    *)
+    object(self)
+        constraint 'level = [> Basic.level ]
+        constraint 'event = 'level #Basic.event
+        constraint 'archiver = 'event #Basic.archiver
+        inherit ['archiver] Basic.agent prioritizer limit archivers (* as super *)
+
+        (*
+        method! private put:
+            'a 'b. 'level -> ('event -> 'b) ->
+            ('a, unit, string, 'b) format4 -> 'a = super#put
+        *)
+
+        method invalid:
+            'a 'b. ('a, unit, string, string, string, 'b) format6 -> 'a =
+            self#put `Invalid (fun x -> invalid_arg x#message)
+
+        method fail:
+            'a 'b. ('a, unit, string, string, string, 'b) format6 -> 'a =
+            self#put `Fail (fun x -> failwith x#message)
+
+        method error:
+            'a. ('a, unit, string, string, string, unit) format6 -> 'a =
+            self#put `Error ignore
+
+        method warn:
+            'a. ('a, unit, string, string, string, unit) format6 -> 'a =
+            self#put `Warn ignore
+
+        method notice:
+            'a. ('a, unit, string, string, string, unit) format6 -> 'a =
+            self#put `Notice ignore
+
+        method info:
+            'a. ('a, unit, string, string, string, unit) format6 -> 'a =
+            self#put `Info ignore
+
+        method debug:
+            'a. ('a, unit, string, string, string, bool) format6 -> 'a =
+            self#put `Debug (fun _ -> true)
+    end
diff --git a/testsuite/tests/typing-poly/error_messages.ml b/testsuite/tests/typing-poly/error_messages.ml
new file mode 100644
index 00000000..eb26a7f9
--- /dev/null
+++ b/testsuite/tests/typing-poly/error_messages.ml
@@ -0,0 +1,133 @@
+(* TEST
+   * expect
+*)
+
+type t = < x : 'a. int as 'a >
+[%%expect {|
+Line 1, characters 15-28:
+1 | type t = < x : 'a. int as 'a >
+                   ^^^^^^^^^^^^^
+Error: The universal type variable 'a cannot be generalized: it is bound to
+       int.
+|}]
+type u = < x : 'a 'b. 'a as 'b >
+[%%expect {|
+Line 1, characters 15-30:
+1 | type u = < x : 'a 'b. 'a as 'b >
+                   ^^^^^^^^^^^^^^^
+Error: The universal type variable 'b cannot be generalized:
+       it is already bound to another variable.
+|}]
+type v = 'b -> < x : 'a. 'b as 'a >
+[%%expect {|
+Line 1, characters 21-33:
+1 | type v = 'b -> < x : 'a. 'b as 'a >
+                         ^^^^^^^^^^^^
+Error: The universal type variable 'a cannot be generalized:
+       it escapes its scope.
+|}]
+
+
+(** Check that renaming universal type variable is properly tracked
+    in printtyp *)
+
+let f (x:) (y:) = x = y
+[%%expect {|
+Line 4, characters 49-50:
+4 | let f (x:) (y:) = x = y
+                                                     ^
+Error: This expression 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 'a. 'a
+       The universal variable 'a would escape its scope
+|}]
+
+
+(** MPR 7565 *)
+class type t_a = object
+    method f: 'a. 'a -> int
+  end
+let f (o:t_a) = o # f 0
+let _ = f (object
+    method f _ = 0
+ end);;
+[%%expect {|
+class type t_a = object method f : 'a -> int end
+val f : t_a -> int = 
+Lines 5-7, characters 10-5:
+5 | ..........(object
+6 |     method f _ = 0
+7 |  end)..
+Error: This expression has type < f : 'a -> int >
+       but an expression was expected of type t_a
+       The method f has type 'a -> int, but the expected method type was
+       'a. 'a -> int
+       The universal variable 'a would escape its scope
+|}
+]
+
+type uv = [ `A of  int > ]
+type 'a v = [ `A of  int > ]
+let f (`A o:uv) = o # f 0
+let () = f ( `A (object method f _ = 0 end): _ v);;
+[%%expect {|
+type uv = [ `A of < f : 'a. 'a -> int > ]
+type 'a v = [ `A of < f : 'a -> int > ]
+val f : uv -> int = 
+Line 4, characters 11-49:
+4 | let () = f ( `A (object method f _ = 0 end): _ v);;
+               ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This expression has type 'a v but an expression was expected of type
+         uv
+       The method f has type 'a -> int, but the expected method type was
+       'a. 'a -> int
+       The universal variable 'a would escape its scope
+|}]
+
+(* Issue #8702: row types unified with universally quantified types*)
+
+let f: 'a. ([> `A ] as 'a) -> [ `A ] = fun x -> x
+[%%expect {|
+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 ]
+       The first variant type is bound to the universal type variable 'a,
+       it cannot be closed
+|}]
+
+let f: 'a. [ `A ] -> ([> `A ] as 'a) = fun x -> x
+[%%expect {|
+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
+         [> `A ]
+       The second variant type is bound to the universal type variable 'a,
+       it cannot be closed
+|}]
+
+
+let f: 'a. [ `A | `B ] -> ([> `A ] as 'a) = fun x -> x
+[%%expect {|
+Line 1, characters 53-54:
+1 | let f: 'a. [ `A | `B ] -> ([> `A ] as 'a) = fun x -> x
+                                                         ^
+Error: This expression 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
+|}]
+
+
+let f: 'a. [> `A | `B | `C ] -> ([> `A ] as 'a) = fun x -> x
+[%%expect {|
+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 ]
+       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
new file mode 100644
index 00000000..655a1ee9
--- /dev/null
+++ b/testsuite/tests/typing-poly/poly.ml
@@ -0,0 +1,1878 @@
+(* TEST
+   * expect
+*)
+
+(*
+   Polymorphic methods are now available in the main branch.
+   Enjoy.
+*)
+
+(* Tests for explicit polymorphism *)
+open StdLabels;;
+
+type 'a t = { t : 'a };;
+type 'a fold = { fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b };;
+let f l = { fold = List.fold_left l };;
+(f [1;2;3]).fold ~f:(+) ~init:0;;
+[%%expect {|
+type 'a t = { t : 'a; }
+type 'a fold = { fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b; }
+val f : 'a list -> 'a fold = 
+- : int = 6
+|}];;
+
+type pty = {pv : 'a. 'a list};;
+[%%expect {|
+type pty = { pv : 'a. 'a list; }
+|}];;
+
+
+type id = { id : 'a. 'a -> 'a };;
+let id x = x;;
+let {id} = id { id };;
+[%%expect {|
+type id = { id : 'a. 'a -> 'a; }
+val id : 'a -> 'a = 
+val id : 'a -> 'a = 
+|}];;
+
+let px = {pv = []};;
+[%%expect {|
+val px : pty = {pv = []}
+|}];;
+
+match px with
+| {pv=[]} -> "OK"
+| {pv=5::_} -> "int"
+| {pv=true::_} -> "bool"
+;;
+[%%expect {|
+Lines 1-4, characters 0-24:
+1 | match px with
+2 | | {pv=[]} -> "OK"
+3 | | {pv=5::_} -> "int"
+4 | | {pv=true::_} -> "bool"
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+{pv=false::_}
+- : string = "OK"
+|}];;
+
+match px with
+| {pv=[]} -> "OK"
+| {pv=true::_} -> "bool"
+| {pv=5::_} -> "int"
+;;
+[%%expect {|
+Lines 1-4, characters 0-20:
+1 | match px with
+2 | | {pv=[]} -> "OK"
+3 | | {pv=true::_} -> "bool"
+4 | | {pv=5::_} -> "int"
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+{pv=0::_}
+- : string = "OK"
+|}];;
+
+match px with
+| {pv=[]} -> "OK"
+| {pv=5::_} -> "int"
+| {pv=true::_} -> "bool"
+| {pv=false::_} -> "bool"
+;;
+[%%expect {|
+- : string = "OK"
+|}];;
+
+fun {pv=v} -> true::v, 1::v;;
+[%%expect {|
+- : pty -> bool list * int list = 
+|}];;
+
+class ['b] ilist l = object
+  val l = l
+  method add x = {< l = x :: l >}
+  method fold : 'a. f:('a -> 'b -> 'a) -> init:'a -> 'a =
+    List.fold_left l
+end
+;;
+[%%expect {|
+class ['b] ilist :
+  'b list ->
+  object ('c)
+    val l : 'b list
+    method add : 'b -> 'c
+    method fold : f:('a -> 'b -> 'a) -> init:'a -> 'a
+  end
+|}];;
+
+class virtual ['a] vlist = object (_ : 'self)
+  method virtual add : 'a -> 'self
+  method virtual fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b
+end
+;;
+[%%expect {|
+class virtual ['a] vlist :
+  object ('c)
+    method virtual add : 'a -> 'c
+    method virtual fold : f:('b -> 'a -> 'b) -> init:'b -> 'b
+  end
+|}];;
+
+class ilist2 l = object
+  inherit [int] vlist
+  val l = l
+  method add x = {< l = x :: l >}
+  method fold = List.fold_left l
+end
+;;
+[%%expect {|
+class ilist2 :
+  int list ->
+  object ('a)
+    val l : int list
+    method add : int -> 'a
+    method fold : f:('b -> int -> 'b) -> init:'b -> 'b
+  end
+|}];;
+
+let ilist2 l = object
+  inherit [_] vlist
+  val l = l
+  method add x = {< l = x :: l >}
+  method fold = List.fold_left l
+end
+;;
+[%%expect {|
+val ilist2 : 'a list -> 'a vlist = 
+|}];;
+
+class ['a] ilist3 l = object
+  inherit ['a] vlist
+  val l = l
+  method add x = {< l = x :: l >}
+  method fold = List.fold_left l
+end
+;;
+[%%expect {|
+class ['a] ilist3 :
+  'a list ->
+  object ('c)
+    val l : 'a list
+    method add : 'a -> 'c
+    method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b
+  end
+|}];;
+
+class ['a] ilist4 (l : 'a list) = object
+  val l = l
+  method virtual add : _
+  method add x = {< l = x :: l >}
+  method virtual fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b
+  method fold = List.fold_left l
+end
+;;
+[%%expect {|
+class ['a] ilist4 :
+  'a list ->
+  object ('c)
+    val l : 'a list
+    method add : 'a -> 'c
+    method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b
+  end
+|}];;
+
+class ['a] ilist5 (l : 'a list) = object (self)
+  val l = l
+  method add x = {< l = x :: l >}
+  method virtual fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b
+  method virtual fold2 : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b
+  method fold2 ~f ~init = self#fold ~f ~init:(self#fold ~f ~init)
+  method fold = List.fold_left l
+end
+;;
+[%%expect {|
+class ['a] ilist5 :
+  'a list ->
+  object ('c)
+    val l : 'a list
+    method add : 'a -> 'c
+    method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b
+    method fold2 : f:('b -> 'a -> 'b) -> init:'b -> 'b
+  end
+|}];;
+
+class ['a] ilist6 l = object (self)
+  inherit ['a] vlist
+  val l = l
+  method add x = {< l = x :: l >}
+  method virtual fold2 : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b
+  method fold2 ~f ~init = self#fold ~f ~init:(self#fold ~f ~init)
+  method fold = List.fold_left l
+end
+;;
+[%%expect {|
+class ['a] ilist6 :
+  'a list ->
+  object ('c)
+    val l : 'a list
+    method add : 'a -> 'c
+    method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b
+    method fold2 : f:('b -> 'a -> 'b) -> init:'b -> 'b
+  end
+|}];;
+
+class virtual ['a] olist = object
+  method virtual fold : 'c. f:('a -> 'c -> 'c) -> init:'c -> 'c
+end
+;;
+[%%expect {|
+class virtual ['a] olist :
+  object method virtual fold : f:('a -> 'c -> 'c) -> init:'c -> 'c end
+|}];;
+
+class ['a] onil = object
+  inherit ['a] olist
+  method fold ~f ~init = init
+end
+;;
+[%%expect {|
+class ['a] onil :
+  object method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c end
+|}];;
+
+class ['a] ocons ~hd ~tl = object (_ : 'b)
+  inherit ['a] olist
+  val hd : 'a = hd
+  val tl : 'a olist = tl
+  method fold ~f ~init = f hd (tl#fold ~f ~init)
+end
+;;
+[%%expect {|
+class ['a] ocons :
+  hd:'a ->
+  tl:'a olist ->
+  object
+    val hd : 'a
+    val tl : 'a olist
+    method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c
+  end
+|}];;
+
+class ['a] ostream ~hd ~tl = object (_ : 'b)
+  inherit ['a] olist
+  val hd : 'a = hd
+  val tl : _ #olist = (tl : 'a ostream)
+  method fold ~f ~init = f hd (tl#fold ~f ~init)
+  method empty = false
+end
+;;
+[%%expect {|
+class ['a] ostream :
+  hd:'a ->
+  tl:'a ostream ->
+  object
+    val hd : 'a
+    val tl : < empty : bool; fold : 'c. f:('a -> 'c -> 'c) -> init:'c -> 'c >
+    method empty : bool
+    method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c
+  end
+|}];;
+
+class ['a] ostream1 ~hd ~tl = object (self : 'b)
+  inherit ['a] olist
+  val hd = hd
+  val tl : 'b = tl
+  method hd = hd
+  method tl = tl
+  method fold ~f ~init =
+    self#tl#fold ~f ~init:(f self#hd init)
+end
+[%%expect {|
+class ['a] ostream1 :
+  hd:'a ->
+  tl:'b ->
+  object ('b)
+    val hd : 'a
+    val tl : 'b
+    method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c
+    method hd : 'a
+    method tl : 'b
+  end
+|}, Principal{|
+Line 8, characters 4-16:
+8 |     self#tl#fold ~f ~init:(f self#hd init)
+        ^^^^^^^^^^^^
+Warning 18: this use of a polymorphic method is not principal.
+class ['a] ostream1 :
+  hd:'a ->
+  tl:'b ->
+  object ('b)
+    val hd : 'a
+    val tl : 'b
+    method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c
+    method hd : 'a
+    method tl : 'b
+  end
+|}];;
+
+class vari = object
+  method virtual m : 'a. ([< `A|`B|`C] as 'a) -> int
+  method m = function `A -> 1 | `B|`C  -> 0
+end
+;;
+[%%expect {|
+class vari : object method m : [< `A | `B | `C ] -> int end
+|}];;
+
+class vari = object
+  method m : 'a. ([< `A|`B|`C] as 'a) -> int = function `A -> 1 | `B|`C -> 0
+end
+;;
+[%%expect {|
+class vari : object method m : [< `A | `B | `C ] -> int end
+|}];;
+
+module V =
+  struct
+    type v = [`A | `B | `C]
+    let m : [< v] -> int = function `A -> 1 | #v -> 0
+  end
+;;
+[%%expect {|
+module V : sig type v = [ `A | `B | `C ] val m : [< v ] -> int end
+|}];;
+
+class varj = object
+  method virtual m : 'a. ([< V.v] as 'a) -> int
+  method m = V.m
+end
+;;
+[%%expect {|
+class varj : object method m : [< V.v ] -> int end
+|}];;
+
+
+module type T = sig
+  class vari : object method m : 'a. ([< `A | `B | `C] as 'a) -> int end
+end
+;;
+[%%expect {|
+module type T =
+  sig class vari : object method m : [< `A | `B | `C ] -> int end end
+|}];;
+
+module M0 = struct
+  class vari = object
+    method virtual m : 'a. ([< `A|`B|`C] as 'a) -> int
+    method m = function `A -> 1 | `B|`C -> 0
+  end
+end
+;;
+[%%expect {|
+module M0 :
+  sig class vari : object method m : [< `A | `B | `C ] -> int end end
+|}];;
+
+module M : T = M0
+;;
+[%%expect {|
+module M : T
+|}];;
+
+let v = new M.vari;;
+[%%expect {|
+val v : M.vari = 
+|}];;
+
+v#m `A;;
+[%%expect {|
+- : int = 1
+|}];;
+
+
+class point ~x ~y = object
+  val x : int = x
+  val y : int = y
+  method x = x
+  method y = y
+end
+;;
+[%%expect {|
+class point :
+  x:int ->
+  y:int -> object val x : int val y : int method x : int method y : int end
+|}];;
+
+class color_point ~x ~y ~color = object
+  inherit point ~x ~y
+  val color : string = color
+  method color = color
+end
+;;
+[%%expect {|
+class color_point :
+  x:int ->
+  y:int ->
+  color:string ->
+  object
+    val color : string
+    val x : int
+    val y : int
+    method color : string
+    method x : int
+    method y : int
+  end
+|}];;
+
+class circle (p : #point) ~r = object
+  val p = (p :> point)
+  val r = r
+  method virtual distance : 'a. (#point as 'a) -> float
+  method distance p' =
+    let dx = p#x - p'#x and dy = p#y - p'#y in
+    let d = sqrt (float (dx * dx + dy * dy)) -. float r in
+    if d < 0. then 0. else d
+end
+;;
+[%%expect {|
+class circle :
+  #point ->
+  r:int ->
+  object val p : point val r : int method distance : #point -> float end
+|}];;
+
+let p0 = new point ~x:3 ~y:5
+let p1 = new point ~x:10 ~y:13
+let cp = new color_point ~x:12 ~y:(-5) ~color:"green"
+let c = new circle p0 ~r:2
+let d = floor (c#distance cp)
+;;
+let f (x : < m : 'a. 'a -> 'a >) = (x : < m : 'b. 'b -> 'b >)
+;;
+let f (x : < m : 'a. 'a -> 'a list >) = (x : < m : 'b. 'b -> 'c >)
+;;
+[%%expect {|
+val p0 : point = 
+val p1 : point = 
+val cp : color_point = 
+val c : circle = 
+val d : float = 11.
+val f : < m : 'a. 'a -> 'a > -> < m : 'b. 'b -> 'b > = 
+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 >
+       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
+       The universal variable 'b would escape its scope
+|}];;
+
+class id = object
+  method virtual id : 'a. 'a -> 'a
+  method id x = x
+end
+;;
+[%%expect {|
+class id : object method id : 'a -> 'a end
+|}];;
+
+class type id_spec = object
+  method id : 'a -> 'a
+end
+;;
+[%%expect {|
+class type id_spec = object method id : 'a -> 'a end
+|}];;
+
+class id_impl = object (_ : #id_spec)
+  method id x = x
+end
+;;
+[%%expect {|
+class id_impl : object method id : 'a -> 'a end
+|}];;
+
+class a = object
+  method m = (new b : id_spec)#id true
+end
+and b = object (_ : #id_spec)
+  method id x = x
+end
+;;
+[%%expect {|
+class a : object method m : bool end
+and b : object method id : 'a -> 'a end
+|}];;
+
+
+class ['a] id1 = object
+  method virtual id : 'b. 'b -> 'a
+  method id x = x
+end
+;;
+[%%expect {|
+Line 3, characters 12-17:
+3 |   method id x = x
+                ^^^^^
+Error: This method has type 'a -> 'a which is less general than 'b. 'b -> 'a
+|}];;
+
+class id2 (x : 'a) = object
+  method virtual id : 'b. 'b -> 'a
+  method id x = x
+end
+;;
+[%%expect {|
+Line 3, characters 12-17:
+3 |   method id x = x
+                ^^^^^
+Error: This method has type 'a -> 'a which is less general than 'b. 'b -> 'a
+|}];;
+
+class id3 x = object
+  val x = x
+  method virtual id : 'a. 'a -> 'a
+  method id _ = x
+end
+;;
+[%%expect {|
+Line 4, characters 12-17:
+4 |   method id _ = x
+                ^^^^^
+Error: This method has type 'b -> 'b which is less general than 'a. 'a -> 'a
+|}];;
+
+class id4 () = object
+  val mutable r = None
+  method virtual id : 'a. 'a -> 'a
+  method id x =
+    match r with
+      None -> r <- Some x; x
+    | Some y -> y
+end
+;;
+[%%expect {|
+Lines 4-7, characters 12-17:
+4 | ............x =
+5 |     match r with
+6 |       None -> r <- Some x; x
+7 |     | Some y -> y
+Error: This method has type 'b -> 'b which is less general than 'a. 'a -> 'a
+|}];;
+
+class c = object
+  method virtual m : 'a 'b. 'a -> 'b -> 'a
+  method m x y = x
+end
+;;
+[%%expect {|
+class c : object method m : 'a -> 'b -> 'a end
+|}];;
+
+
+let f1 (f : id) = f#id 1, f#id true
+;;
+let f2 f = (f : id)#id 1, (f : id)#id true
+;;
+let f3 f = f#id 1, f#id true
+;;
+let f4 f = ignore(f : id); f#id 1, f#id true
+;;
+[%%expect {|
+val f1 : id -> int * bool = 
+val f2 : id -> int * bool = 
+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
+|}];;
+
+class c = object
+  method virtual m : 'a. (#id as 'a) -> int * bool
+  method m (f : #id) = f#id 1, f#id true
+end
+;;
+[%%expect {|
+class c : object method m : #id -> int * bool end
+|}];;
+
+
+class id2 = object (_ : 'b)
+  method virtual id : 'a. 'a -> 'a
+  method id x = x
+  method mono (x : int) = x
+end
+;;
+let app = new c #m (new id2)
+;;
+type 'a foo = 'a foo list
+;;
+[%%expect {|
+class id2 : object method id : 'a -> 'a method mono : int -> int end
+val app : int * bool = (1, true)
+Line 9, characters 0-25:
+9 | type 'a foo = 'a foo list
+    ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type abbreviation foo is cyclic
+|}];;
+
+class ['a] bar (x : 'a) = object end
+;;
+type 'a foo = 'a foo bar
+;;
+[%%expect {|
+class ['a] bar : 'a -> object  end
+type 'a foo = 'a foo bar
+|}];;
+
+fun x -> (x : < m : 'a. 'a * 'b > as 'b)#m;;
+fun x -> (x : < m : 'a. 'b * 'a list> as 'b)#m;;
+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 :  as 'c> as 'd) -> x#m;;
+(* printer is wrong on the next (no official syntax) *)
+fun (x :  >) -> x#m;;
+[%%expect {|
+- : (< m : 'a. 'a * 'b > as 'b) -> 'c * 'b = 
+- : (< m : 'a. 'b * 'a list > as 'b) -> 'b * 'c list = 
+val f :
+  (< m : 'b. 'a * (< n : 'b; .. > as 'b) > as 'a) ->
+  'a * (< n : 'c; .. > as 'c) = 
+- : (< p : 'b. < m : 'b; n : 'a; .. > as 'b > as 'a) ->
+    (< m : 'c; n : 'a; .. > as 'c)
+= 
+- : (< m : 'a. 'a * < p : 'b. 'b * 'd * 'c > as 'd > as 'c) ->
+    ('f * < p : 'b. 'b * 'e * 'c > as 'e)
+= 
+- : < m : 'a. < p : 'a; .. > as 'b > -> 'b = 
+|}, Principal{|
+- : (< m : 'a. 'a * 'b > as 'b) -> 'c * (< m : 'a. 'a * 'd > as 'd) = 
+- : (< m : 'a. 'b * 'a list > as 'b) ->
+    (< m : 'a. 'c * 'a list > as 'c) * 'd list
+= 
+val f :
+  (< m : 'b. 'a * (< n : 'b; .. > as 'b) > as 'a) ->
+  (< m : 'd. 'c * (< n : 'd; .. > as 'd) > as 'c) * (< n : 'e; .. > as 'e) =
+  
+- : (< p : 'b. < m : 'b; n : 'a; .. > as 'b > as 'a) ->
+    (< m : 'c; n : < p : 'e. < m : 'e; n : 'd; .. > as 'e > as 'd; .. > as 'c)
+= 
+- : (< m : 'a. 'a * < p : 'b. 'b * 'd * 'c > as 'd > as 'c) ->
+    ('f *
+     < p : 'b.
+             'b * 'e *
+             (< m : 'a. 'a * < p : 'b0. 'b0 * 'h * 'g > as 'h > as 'g) >
+     as 'e)
+= 
+- : < m : 'a. < p : 'a; .. > as 'b > -> 'b = 
+|}];;
+
+type sum = T of < id: 'a. 'a -> 'a > ;;
+fun (T x) -> x#id;;
+[%%expect {|
+type sum = T of < id : 'a. 'a -> 'a >
+- : sum -> 'a -> 'a = 
+|}];;
+
+type record = { r: < id: 'a. 'a -> 'a > } ;;
+fun x -> x.r#id;;
+fun {r=x} -> x#id;;
+[%%expect {|
+type record = { r : < id : 'a. 'a -> 'a >; }
+- : record -> 'a -> 'a = 
+- : record -> 'a -> 'a = 
+|}];;
+
+class myself = object (self)
+  method self : 'a. 'a -> 'b = fun _ -> self
+end;;
+[%%expect {|
+class myself : object ('b) method self : 'a -> 'b end
+|}];;
+
+class number = object (self : 'self)
+  val num = 0
+  method num = num
+  method succ = {< num = num + 1 >}
+  method prev =
+    self#switch ~zero:(fun () -> failwith "zero") ~prev:(fun x -> x)
+  method switch : 'a. zero:(unit -> 'a) -> prev:('self -> 'a) -> 'a =
+    fun ~zero ~prev ->
+      if num = 0 then zero () else prev {< num = num - 1 >}
+end
+;;
+[%%expect {|
+class number :
+  object ('b)
+    val num : int
+    method num : int
+    method prev : 'b
+    method succ : 'b
+    method switch : zero:(unit -> 'a) -> prev:('b -> 'a) -> 'a
+  end
+|}];;
+
+let id x = x
+;;
+class c = object
+  method id : 'a. 'a -> 'a = id
+end
+;;
+class c' = object
+  inherit c
+  method id = id
+end
+;;
+class d = object
+  inherit c as c
+  val mutable count = 0
+  method id x = count <- count+1; x
+  method count = count
+  method old : 'a. 'a -> 'a = c#id
+end
+;;
+class ['a] olist l = object
+  val l = l
+  method fold : 'b. f:('a -> 'b -> 'b) -> init:'b -> 'b
+      = List.fold_right l
+  method cons a = {< l = a :: l >}
+end
+;;
+let sum (l : 'a #olist) = l#fold ~f:(fun x acc -> x+acc) ~init:0
+;;
+let count (l : 'a #olist) = l#fold ~f:(fun _ acc -> acc+1) ~init:0
+;;
+let append (l : 'a #olist) (l' : 'b #olist) =
+  l#fold ~init:l' ~f:(fun x acc -> acc#cons x)
+;;
+[%%expect {|
+val id : 'a -> 'a = 
+class c : object method id : 'a -> 'a end
+class c' : object method id : 'a -> 'a end
+class d :
+  object
+    val mutable count : int
+    method count : int
+    method id : 'a -> 'a
+    method old : 'a -> 'a
+  end
+class ['a] olist :
+  'a list ->
+  object ('c)
+    val l : 'a list
+    method cons : 'a -> 'c
+    method fold : f:('a -> 'b -> 'b) -> init:'b -> 'b
+  end
+val sum : int #olist -> int = 
+val count : 'a #olist -> int = 
+val append : 'a #olist -> ('a #olist as 'b) -> 'b = 
+|}];;
+
+type 'a t = unit
+;;
+class o = object method x : 'a. ([> `A] as 'a) t -> unit = fun _ -> () end
+;;
+[%%expect {|
+type 'a t = unit
+class o : object method x : unit -> unit end
+|}];;
+
+class c = object method m = new d () end and d ?(x=0) () = object end;;
+class d ?(x=0) () = object end and c = object method m = new d () end;;
+[%%expect {|
+class c : object method m : d end
+and d : ?x:int -> unit -> object  end
+class d : ?x:int -> unit -> object  end
+and c : object method m : d end
+|}];;
+
+class type numeral = object method fold : ('a -> 'a) -> 'a -> 'a end
+class zero = object (_ : #numeral) method fold f x = x end
+class next (n : #numeral) =
+  object (_ : #numeral) method fold f x = n#fold f (f x) end
+;;
+[%%expect {|
+class type numeral = object method fold : ('a -> 'a) -> 'a -> 'a end
+class zero : object method fold : ('a -> 'a) -> 'a -> 'a end
+class next : #numeral -> object method fold : ('a -> 'a) -> 'a -> 'a end
+|}];;
+
+class type node_type =  object
+  method as_variant : [> `Node of node_type]
+end;;
+class node : node_type = object (self)
+  method as_variant : 'a. [> `Node of node_type] as 'a
+                    = `Node (self :>  node_type)
+end;;
+class node = object (self : #node_type)
+  method as_variant = `Node (self :> node_type)
+end;;
+[%%expect {|
+class type node_type = object method as_variant : [> `Node of node_type ] end
+class node : node_type
+class node : object method as_variant : [> `Node of node_type ] end
+|}];;
+
+type bad = {bad : 'a. 'a option ref};;
+let bad = {bad = ref None};;
+type bad2 = {mutable bad2 : 'a. 'a option ref option};;
+let bad2 = {bad2 = None};;
+bad2.bad2 <- Some (ref None);;
+[%%expect {|
+type bad = { bad : 'a. 'a option ref; }
+Line 2, characters 17-25:
+2 | let bad = {bad = ref None};;
+                     ^^^^^^^^
+Error: This field value has type 'b option ref which is less general than
+         'a. 'a option ref
+|}];;
+
+(* Type variable scope *)
+
+let f (x:  as 'b>) (y : 'b) = ();;
+let f (x:  as 'b)>) (y : 'b) = ();;
+[%%expect {|
+val f : < m : 'a. < p : 'a * 'c > as 'c > -> 'b -> unit = 
+val f : < m : 'a. 'a * (< p : int * 'b > as 'b) > -> 'b -> unit = 
+|}, Principal{|
+val f : < m : 'a. < p : 'a * 'c > as 'c > -> 'b -> unit = 
+val f :
+  < m : 'a. 'a * (< p : int * 'b > as 'b) > ->
+  (< p : int * 'c > as 'c) -> unit = 
+|}];;
+
+(* PR#3643 *)
+
+type 'a t= [`A of 'a];;
+class c = object (self)
+  method m :  'a. ([> 'a t] as 'a) -> unit
+    = fun x -> self#m x
+end;;
+class c = object (self)
+  method m : 'a. ([> 'a t] as 'a) -> unit = function
+    | `A x' -> self#m x'
+    | _ -> failwith "c#m"
+end;;
+class c = object (self)
+  method m :  'a. ([> 'a t] as 'a) -> 'a = fun x -> self#m x
+end;;
+[%%expect {|
+type 'a t = [ `A of 'a ]
+class c : object method m : ([> 'a t ] as 'a) -> unit end
+class c : object method m : ([> 'a t ] as 'a) -> unit end
+class c : object method m : ([> 'a t ] as 'a) -> 'a end
+|}];;
+
+(* use before instancing *)
+class c = object method m : 'a. 'a option -> ([> `A] as 'a) = fun x -> `A end;;
+[%%expect {|
+class c : object method m : ([> `A ] as 'a) option -> 'a end
+|}];;
+
+(* various old bugs *)
+class virtual ['a] visitor =
+object method virtual caseNil : 'a end
+and virtual int_list =
+object method virtual visit : 'a.('a visitor -> 'a) end;;
+[%%expect {|
+Line 4, characters 30-51:
+4 | object method virtual visit : 'a.('a visitor -> 'a) end;;
+                                  ^^^^^^^^^^^^^^^^^^^^^
+Error: The universal type variable 'a cannot be generalized:
+       it escapes its scope.
+|}];;
+
+type ('a,'b) list_visitor = < caseNil : 'a; caseCons : 'b -> 'b list -> 'a >
+type 'b alist = < visit : 'a. ('a,'b) list_visitor -> 'a >
+[%%expect {|
+type ('a, 'b) list_visitor = < caseCons : 'b -> 'b list -> 'a; caseNil : 'a >
+type 'b alist = < visit : 'a. ('a, 'b) list_visitor -> 'a >
+|}];;
+
+(* PR#8074 *)
+class type ct = object ('s)
+  method fold : ('b -> 's -> 'b) -> 'b -> 'b
+end
+type t = {f : 'a 'b. ('b -> (#ct as 'a) -> 'b) -> 'b};;
+[%%expect {|
+class type ct = object ('a) method fold : ('b -> 'a -> 'b) -> 'b -> 'b end
+type t = { f : 'a 'b. ('b -> (#ct as 'a) -> 'b) -> 'b; }
+|}];;
+
+(* PR#8124 *)
+type t = u and u = t;;
+[%%expect {|
+Line 1, characters 0-10:
+1 | type t = u and u = t;;
+    ^^^^^^^^^^
+Error: The definition of t contains a cycle:
+       u
+|}];;
+
+(* PR#8188 *)
+class ['t] a = object constraint 't = [> `A of 't a] end
+type t = [ `A of t a ];;
+[%%expect {|
+class ['a] a : object constraint 'a = [> `A of 'a a ] end
+type t = [ `A of t a ]
+|}];;
+
+(* Wrong in 3.06 *)
+type ('a,'b) t constraint 'a = 'b and ('a,'b) u = ('a,'b) t;;
+[%%expect {|
+Line 1, characters 50-59:
+1 | type ('a,'b) t constraint 'a = 'b and ('a,'b) u = ('a,'b) t;;
+                                                      ^^^^^^^^^
+Error: Constraints are not satisfied in this type.
+       Type ('a, 'b) t should be an instance of ('c, 'c) t
+|}];;
+
+(* Full polymorphism if we do not expand *)
+type 'a t = 'a and u = int t;;
+[%%expect {|
+type 'a t = 'a
+and u = int t
+|}];;
+
+(* Loose polymorphism if we expand *)
+type 'a t constraint 'a = int;;
+type 'a u = 'a and 'a v = 'a u t;;
+type 'a u = 'a and 'a v = 'a u t constraint 'a = int;;
+[%%expect {|
+type 'a t constraint 'a = int
+Line 2, characters 26-32:
+2 | type 'a u = 'a and 'a v = 'a u t;;
+                              ^^^^^^
+Error: Constraints are not satisfied in this type.
+       Type 'a u t should be an instance of int t
+|}];;
+
+(* Behaviour is unstable *)
+type g = int;;
+type 'a t = unit constraint 'a = g;;
+type 'a u = 'a and 'a v = 'a u t;;
+type 'a u = 'a and 'a v = 'a u t constraint 'a = int;;
+[%%expect {|
+type g = int
+type 'a t = unit constraint 'a = g
+Line 3, characters 26-32:
+3 | type 'a u = 'a and 'a v = 'a u t;;
+                              ^^^^^^
+Error: Constraints are not satisfied in this type.
+       Type 'a u t should be an instance of g t
+|}];;
+
+(* Example of wrong expansion *)
+type 'a u = < m : 'a v > and 'a v = 'a list u;;
+[%%expect {|
+Line 1, characters 0-24:
+1 | type 'a u = < m : 'a v > and 'a v = 'a list u;;
+    ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This recursive type is not regular.
+       The type constructor u is defined as
+         type 'a u
+       but it is used as
+         'a list u
+       after the following expansion(s):
+         'a v = 'a list u
+       All uses need to match the definition for the recursive type to be regular.
+|}];;
+
+(* PR#8198: Ctype.matches *)
+type 'a t = 'a
+type 'a u = A of 'a t;;
+[%%expect {|
+type 'a t = 'a
+type 'a u = A of 'a t
+|}];;
+
+(* Unification of cyclic terms *)
+type 'a t = < a : 'a >;;
+fun (x : 'a t as 'a) -> (x : 'b t);;
+type u = 'a t as 'a;;
+[%%expect {|
+type 'a t = < a : 'a >
+- : ('a t as 'a) -> 'a t = 
+type u = 'a t as 'a
+|}, Principal{|
+type 'a t = < a : 'a >
+- : ('a t as 'a) -> ('b t as 'b) t = 
+type u = 'a t as 'a
+|}];;
+
+(* pass typetexp, but fails during Typedecl.check_recursion *)
+type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b]
+and  ('a, 'b) b = 'b -> unit constraint 'b = [> `A of ('a, 'b) a as 'a];;
+[%%expect {|
+Line 1, characters 0-71:
+1 | type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b]
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of a contains a cycle:
+       [> `B of ('a, 'b) b as 'b ] as 'a
+|}];;
+
+(* PR#8359: expanding may change original in Ctype.unify2 *)
+(* Note: since 3.11, the abbreviations are not used when printing
+   a type where they occur recursively inside. *)
+class type ['a, 'b] a = object
+  method b: ('a, 'b) #b as 'b
+  method as_a: ('a, 'b) a
+end and ['a, 'b] b = object
+  method a: ('a, 'b) #a as 'a
+  method as_b: ('a, 'b) b
+end;;
+[%%expect {|
+class type ['a, 'b] a =
+  object
+    constraint 'a = < as_a : ('a, 'b) a as 'c; b : 'b; .. >
+    constraint 'b = < a : 'a; as_b : ('a, 'b) b; .. >
+    method as_a : 'c
+    method b : 'b
+  end
+and ['a, 'b] b =
+  object
+    constraint 'a = < as_a : ('a, 'b) a; b : 'b; .. >
+    constraint 'b = < a : 'a; as_b : ('a, 'b) b; .. >
+    method a : 'a
+    method as_b : ('a, 'b) b
+  end
+|}];;
+
+class type ['b] ca = object ('s) inherit ['s, 'b] a end;;
+class type ['a] cb = object ('s) inherit ['a, 's] b end;;
+[%%expect {|
+class type ['a] ca =
+  object ('b)
+    constraint 'a = < a : 'b; as_b : ('b, 'a) b; .. >
+    method as_a : ('b, 'a) a
+    method b : 'a
+  end
+class type ['a] cb =
+  object ('b)
+    constraint 'a = < as_a : ('a, 'b) a; b : 'b; .. >
+    method a : 'a
+    method as_b : ('a, 'b) b
+  end
+|}];;
+
+type bt = 'b ca cb as 'b
+;;
+[%%expect {|
+type bt = 'a ca cb as 'a
+|}];;
+
+(* final classes, etc... *)
+class c = object method m = 1 end;;
+let f () = object (self:c) method m = 1 end;;
+let f () = object (self:c) method private n = 1 method m = self#n end;;
+let f () = object method private n = 1 method m = {<>}#n end;;
+let f () = object (self:c) method n = 1 method m = 2 end;;
+let f () = object (_:'s) constraint 's = < n : int > method m = 1 end;;
+class c = object (_ : 's)
+  method x = 1
+  method private m =
+    object (self: 's) method x = 3 method private m = self end
+end;;
+let o = object (_ : 's)
+  method x = 1
+  method private m =
+    object (self: 's) method x = 3 method private m = self end
+end;;
+[%%expect {|
+class c : object method m : int end
+val f : unit -> c = 
+val f : unit -> c = 
+Line 4, characters 11-60:
+4 | let f () = object method private n = 1 method m = {<>}#n end;;
+               ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 15: the following private methods were made public implicitly:
+ n.
+val f : unit -> < m : int; n : int > = 
+Line 5, characters 11-56:
+5 | let f () = object (self:c) method n = 1 method m = 2 end;;
+               ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This object is expected to have type c but actually has type
+         < m : int; n : 'a >
+       The first object type has no method n
+|}];;
+
+
+(* Unsound! *)
+fun (x :  > as 'foo) ->
+  (x :  > as 'bar) >);;
+type 'a foo = 
+type foo' =   
+type 'a bar =  >
+type bar' =   
+let f (x : foo') = (x : bar');;
+[%%expect {|
+Line 2, characters 3-4:
+2 |   (x :  > as 'bar) >);;
+       ^
+Error: This expression 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
+       'a. 'a * (< m : 'a * < m : 'c. 'c * 'b > > as 'b),
+       but the expected method type was
+       'c. 'c * < m : 'a * < m : 'c. 'b > > as 'b
+       The universal variable 'a would escape its scope
+|}];;
+
+fun (x :  as 'foo)>) ->
+  (x : )> as 'bar);;
+fun (x :  as 'foo)>) ->
+  (x : )> as 'bar);;
+fun (x :  as 'foo) ->
+  (x :  as 'bar)>);;
+let f x =
+    (x :  ('a *  'bar> as 'bar)>
+       :>  ('a * 'foo)> as 'foo);;
+[%%expect {|
+Line 2, characters 3-4:
+2 |   (x : )> as 'bar);;
+       ^
+Error: This expression 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
+       Types for method m are incompatible
+|}];;
+
+module M
+: sig val f : ( as 'bar)>) -> unit end
+= struct let f (x :  as 'foo) = () end;;
+module M
+: sig type t =  as 'bar)> end
+= struct type t =  as 'foo end;;
+[%%expect {|
+Line 3, characters 2-64:
+3 | = struct let f (x :  as 'foo) = () end;;
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig val f : (< m : 'a. 'a * ('a * 'b) > as 'b) -> unit end
+       is not included in
+         sig
+           val f : < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) > -> unit
+         end
+       Values do not match:
+         val f : (< m : 'a. 'a * ('a * 'b) > as 'b) -> unit
+       is not included in
+         val f : < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) > -> unit
+|}];;
+
+module M : sig type 'a t type u =  end
+= struct type 'a t = int type u =  end;;
+module M : sig type 'a t val f :  -> int end
+= struct type 'a t = int let f (x : ) = x#m end;;
+(* The following should be accepted too! *)
+module M : sig type 'a t val f :  -> int end
+= struct type 'a t = int let f x = x#m end;;
+[%%expect {|
+module M : sig type 'a t type u = < m : 'a. 'a t > end
+module M : sig type 'a t val f : < m : 'a. 'a t > -> int end
+module M : sig type 'a t val f : < m : 'a. 'a t > -> int end
+|}];;
+
+let f x y =
+  ignore (x :>  'c * < > > as 'c);
+  ignore (y :>  'd * < > > as 'd);
+  x = y;;
+[%%expect {|
+val f :
+  (< m : 'a. 'a -> (< m : 'a. 'a -> 'c * <  > > as 'c) * < .. >; .. > as 'b) ->
+  'b -> bool = 
+|}];;
+
+
+(* Subtyping *)
+
+type t = [`A|`B];;
+type v = private [> t];;
+fun x -> (x : t :> v);;
+type u = private [< t];;
+fun x -> (x : u :> v);;
+fun x -> (x : v :> u);;
+type v = private [< t];;
+fun x -> (x : u :> v);;
+type p = ;;
+type q = private ;;
+fun x -> (x : q :> p);;
+fun x -> (x : p :> q);;
+[%%expect {|
+type t = [ `A | `B ]
+type v = private [> t ]
+- : t -> v = 
+type u = private [< t ]
+- : u -> v = 
+Line 6, characters 9-21:
+6 | fun x -> (x : v :> u);;
+             ^^^^^^^^^^^^
+Error: Type v = [> `A | `B ] is not a subtype of u = [< `A | `B ]
+|}];;
+
+let f1 x =
+  (x :  as 'a) -> int>
+    :>  as 'b) -> int>);;
+let f2 x =
+  (x : ;..> as 'a) -> int>
+    :> ;..> as 'b) -> int>);;
+let f3 x =
+  (x : ;..> as 'a) -> int>
+    :> ;..> as 'b) -> int>);;
+let f4 x = (x : ;..> :> ;..>);;
+let f5 x =
+  (x :  ] as 'a> :>  ] as 'a>);;
+let f6 x =
+  (x :  ] as 'a> :>  ] as 'a>);;
+[%%expect {|
+Lines 2-3, characters 2-47:
+2 | ..(x :  as 'a) -> int>
+3 |     :>  as 'b) -> int>)..
+Error: Type < m : 'a. (< p : int; .. > as 'a) -> int > is not a subtype of
+         < m : 'b. (< p : int; q : int; .. > as 'b) -> int >
+       Type < p : int; q : int; .. > as 'c is not a subtype of
+         < p : int; .. > as 'd
+|}];;
+
+(* Keep sharing the epsilons *)
+let f x = if true then (x : < m : 'a. 'a -> 'a >) else x;;
+fun x -> (f x)#m;; (* Warning 18 *)
+let f (x, y) = if true then (x : < m : 'a. 'a -> 'a >) else x;;
+fun x -> (f (x,x))#m;; (* Warning 18 *)
+let f x = if true then [| (x : < m : 'a. 'a -> 'a >) |] else [|x|];;
+fun x -> (f x).(0)#m;; (* Warning 18 *)
+[%%expect {|
+val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > = 
+- : < m : 'a. 'a -> 'a > -> 'b -> 'b = 
+val f : < m : 'a. 'a -> 'a > * 'b -> < m : 'a. 'a -> 'a > = 
+- : < m : 'a. 'a -> 'a > -> 'b -> 'b = 
+val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > array = 
+- : < m : 'a. 'a -> 'a > -> 'b -> 'b = 
+|}, Principal{|
+val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > = 
+Line 2, characters 9-16:
+2 | fun x -> (f x)#m;; (* Warning 18 *)
+             ^^^^^^^
+Warning 18: this use of a polymorphic method is not principal.
+- : < m : 'a. 'a -> 'a > -> 'b -> 'b = 
+val f : < m : 'a. 'a -> 'a > * 'b -> < m : 'a. 'a -> 'a > = 
+Line 4, characters 9-20:
+4 | fun x -> (f (x,x))#m;; (* Warning 18 *)
+             ^^^^^^^^^^^
+Warning 18: this use of a polymorphic method is not principal.
+- : < m : 'a. 'a -> 'a > -> 'b -> 'b = 
+val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > array = 
+Line 6, characters 9-20:
+6 | fun x -> (f x).(0)#m;; (* Warning 18 *)
+             ^^^^^^^^^^^
+Warning 18: this use of a polymorphic method is not principal.
+- : < m : 'a. 'a -> 'a > -> 'b -> 'b = 
+|}];;
+
+(* Not really principal? *)
+class c = object method id : 'a. 'a -> 'a = fun x -> x end;;
+type u = c option;;
+let just = function None -> failwith "just" | Some x -> x;;
+let f x = let l = [Some x; (None : u)] in (just(List.hd l))#id;;
+let g x =
+  let none = (fun y -> ignore [y;(None:u)]; y) None in
+  let x = List.hd [Some x; none] in (just x)#id;;
+let h x =
+  let none = let y = None in ignore [y;(None:u)]; y in
+  let x = List.hd [Some x; none] in (just x)#id;;
+[%%expect {|
+class c : object method id : 'a -> 'a end
+type u = c option
+val just : 'a option -> 'a = 
+val f : c -> 'a -> 'a = 
+val g : c -> 'a -> 'a = 
+val h : < id : 'a; .. > -> 'a = 
+|}, Principal{|
+class c : object method id : 'a -> 'a end
+type u = c option
+val just : 'a option -> 'a = 
+Line 4, characters 42-62:
+4 | let f x = let l = [Some x; (None : u)] in (just(List.hd l))#id;;
+                                              ^^^^^^^^^^^^^^^^^^^^
+Warning 18: this use of a polymorphic method is not principal.
+val f : c -> 'a -> 'a = 
+Line 7, characters 36-47:
+7 |   let x = List.hd [Some x; none] in (just x)#id;;
+                                        ^^^^^^^^^^^
+Warning 18: this use of a polymorphic method is not principal.
+val g : c -> 'a -> 'a = 
+val h : < id : 'a; .. > -> 'a = 
+|}];;
+
+(* Only solved for parameterless abbreviations *)
+type 'a u = c option;;
+let just = function None -> failwith "just" | Some x -> x;;
+let f x = let l = [Some x; (None : _ u)] in (just(List.hd l))#id;;
+[%%expect {|
+type 'a u = c option
+val just : 'a option -> 'a = 
+val f : c -> 'a -> 'a = 
+|}];;
+
+(* polymorphic recursion *)
+
+let rec f : 'a. 'a -> _ = fun x -> 1 and g x = f x;;
+type 'a t = Leaf of 'a | Node of ('a * 'a) t;;
+let rec depth : 'a. 'a t -> _ =
+  function Leaf _ -> 1 | Node x -> 1 + depth x;;
+let rec depth : 'a. 'a t -> _ =
+  function Leaf _ -> 1 | Node x -> 1 + d x
+and d x = depth x;; (* fails *)
+let rec depth : 'a. 'a t -> _ =
+  function Leaf x -> x | Node x -> 1 + depth x;; (* fails *)
+let rec depth : 'a. 'a t -> _ =
+  function Leaf x -> x | Node x -> depth x;; (* fails *)
+let rec depth : 'a 'b. 'a t -> 'b =
+  function Leaf x -> x | Node x -> depth x;; (* fails *)
+let rec r : 'a. 'a list * 'b list ref = [], ref []
+and q () = r;;
+let f : 'a. _ -> _ = fun x -> x;;
+let zero : 'a. [> `Int of int | `B of 'a] as 'a  = `Int 0;; (* ok *)
+let zero : 'a. [< `Int of int] as 'a = `Int 0;; (* fails *)
+[%%expect {|
+val f : 'a -> int = 
+val g : 'a -> int = 
+type 'a t = Leaf of 'a | Node of ('a * 'a) t
+val depth : 'a t -> int = 
+val depth : 'a t -> int = 
+val d : ('a * 'a) t -> int = 
+Line 9, characters 2-46:
+9 |   function Leaf x -> x | Node x -> 1 + depth x;; (* fails *)
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This definition has type int t -> int which is less general than
+         'a. 'a t -> int
+|}];;
+
+(* compare with records (should be the same) *)
+type t = {f: 'a. [> `Int of int | `B of 'a] as 'a}
+let zero = {f = `Int 0} ;;
+type t = {f: 'a. [< `Int of int] as 'a}
+let zero = {f = `Int 0} ;; (* fails *)
+[%%expect {|
+type t = { f : 'a. [> `B of 'a | `Int of int ] as 'a; }
+val zero : t = {f = `Int 0}
+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 ]
+       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
+|}];;
+
+(* Yet another example *)
+let rec id : 'a. 'a -> 'a = fun x -> x
+and neg i b = (id (-i), id (not b));;
+[%%expect {|
+val id : 'a -> 'a = 
+val neg : int -> bool -> int * bool = 
+|}];;
+
+(* De Xavier *)
+
+type t = A of int | B of (int*t) list | C of (string*t) list
+[%%expect {|
+type t = A of int | B of (int * t) list | C of (string * t) list
+|}];;
+
+let rec transf f = function
+  | A x -> f x
+  | B l -> B (transf_alist f l)
+  | C l -> C (transf_alist f l)
+and transf_alist : 'a. _ -> ('a*t) list -> ('a*t) list = fun f -> function
+  | [] -> []
+  | (k,v)::tl -> (k, transf f v) :: transf_alist f tl
+;;
+[%%expect {|
+val transf : (int -> t) -> t -> t = 
+val transf_alist : (int -> t) -> ('a * t) list -> ('a * t) list = 
+|}];;
+
+(* PR#4862 *)
+
+type t = {f: 'a. ('a list -> int) Lazy.t}
+let l : t = { f = lazy (raise Not_found)};;
+[%%expect {|
+type t = { f : 'a. ('a list -> int) Lazy.t; }
+val l : t = {f = }
+|}];;
+
+(* variant *)
+type t = {f: 'a. 'a -> unit};;
+let f ?x y = () in {f};;
+let f ?x y = y in {f};; (* fail *)
+[%%expect {|
+type t = { f : 'a. 'a -> unit; }
+- : t = {f = }
+Line 3, characters 19-20:
+3 | let f ?x y = y in {f};; (* fail *)
+                       ^
+Error: This field value has type unit -> unit which is less general than
+         'a. 'a -> unit
+|}];;
+
+(* Polux Moon caml-list 2011-07-26 *)
+module Polux = struct
+  type 'par t = 'par
+  let ident v = v
+  class alias = object method alias : 'a . 'a t -> 'a = ident end
+  let f (x : ) = (x : )
+end;;
+[%%expect {|
+module Polux :
+  sig
+    type 'par t = 'par
+    val ident : 'a -> 'a
+    class alias : object method alias : 'a t -> 'a end
+    val f : < m : 'a. 'a t > -> < m : 'a. 'a >
+  end
+|}];;
+
+(* PR#5560 *)
+
+let (a, b) = (raise Exit : int * int);;
+type t = { foo : int }
+let {foo} = (raise Exit : t);;
+type s = A of int
+let (A x) = (raise Exit : s);;
+[%%expect {|
+Exception: Stdlib.Exit.
+|}];;
+
+(* PR#5224 *)
+
+type 'x t = < f : 'y. 'y t >;;
+[%%expect {|
+Line 1, characters 0-28:
+1 | type 'x t = < f : 'y. 'y t >;;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This recursive type is not regular.
+       The type constructor t is defined as
+         type 'x t
+       but it is used as
+         'y t.
+       All uses need to match the definition for the recursive type to be regular.
+|}];;
+
+(* PR#6056, PR#6057 *)
+let using_match b =
+  let f =
+    match b with
+    | true -> fun x -> x
+    | false -> fun x -> x
+  in
+  f 0,f
+;;
+[%%expect {|
+val using_match : bool -> int * ('a -> 'a) = 
+|}];;
+
+match (fun x -> x), fun x -> x with x, y -> x, y;;
+match fun x -> x with x -> x, x;;
+[%%expect {|
+- : ('a -> 'a) * ('b -> 'b) = (, )
+- : ('a -> 'a) * ('b -> 'b) = (, )
+|}];;
+
+(* PR#6747 *)
+(* ok *)
+let n = object
+  method m : 'x 'o. ([< `Foo of 'x] as 'o) -> 'x = fun x -> assert false
+end;;
+[%%expect {|
+val n : < m : 'x 'a. ([< `Foo of 'x ] as 'a) -> 'x > = 
+|}];;
+(* ok *)
+let n =
+  object method m : 'x. [< `Foo of 'x] -> 'x = fun x -> assert false end;;
+[%%expect {|
+val n : < m : 'x. [< `Foo of 'x ] -> 'x > = 
+|}];;
+(* fail *)
+let (n : < m : 'a. [< `Foo of int] -> 'a >) =
+  object method m : 'x. [< `Foo of 'x] -> 'x = fun x -> assert false end;;
+[%%expect {|
+Line 2, characters 2-72:
+2 |   object method m : 'x. [< `Foo of 'x] -> 'x = fun x -> assert false end;;
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This expression has type < m : 'x. [< `Foo of 'x ] -> 'x >
+       but an expression was expected of type
+         < m : 'a. [< `Foo of int ] -> 'a >
+       The universal variable 'x would escape its scope
+|}];;
+(* fail *)
+let (n : 'b -> < m : 'a . ([< `Foo of int] as 'b) -> 'a >) = fun x ->
+  object method m : 'x. [< `Foo of 'x] -> 'x = fun x -> assert false end;;
+[%%expect {|
+Line 2, characters 2-72:
+2 |   object method m : 'x. [< `Foo of 'x] -> 'x = fun x -> assert false end;;
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This expression has type < m : 'x. [< `Foo of 'x ] -> 'x >
+       but an expression was expected of type
+         < m : 'a. [< `Foo of int ] -> 'a >
+       The universal variable 'x would escape its scope
+|}];;
+
+(* PR#6171 *)
+let f b (x: 'x) =
+  let module M = struct type t = A end in
+  if b then x else M.A;;
+[%%expect {|
+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
+       The type constructor M.t would escape its scope
+|}];;
+
+
+(* PR#6987 *)
+type 'a t = V1 of 'a
+
+type ('c,'t) pvariant = [ `V of ('c * 't t) ]
+
+class ['c] clss =
+  object
+    method mthod : 't . 'c -> 't t -> ('c, 't) pvariant = fun c x ->
+      `V (c, x)
+  end;;
+
+let f2 = fun o c x -> match x with | V1 _ -> x
+
+let rec f1 o c x =
+  match (o :> _ clss)#mthod c x with
+  | `V c -> f2 o c x;;
+[%%expect{|
+type 'a t = V1 of 'a
+type ('c, 't) pvariant = [ `V of 'c * 't t ]
+class ['c] clss : object method mthod : 'c -> 't t -> ('c, 't) pvariant end
+val f2 : 'a -> 'b -> 'c t -> 'c t = 
+val f1 :
+  < mthod : 't. 'a -> 't t -> [< `V of 'a * 't t ]; .. > ->
+  'a -> 'b t -> 'b t = 
+|}]
+
+(* PR#7285 *)
+type (+'a,-'b) foo = private int;;
+let f (x : int) : ('a,'a) foo = Obj.magic x;;
+let x = f 3;;
+[%%expect{|
+type (+'a, -'b) foo = private int
+val f : int -> ('a, 'a) foo = 
+val x : ('_weak1, '_weak1) foo = 3
+|}]
+
+
+(* PR#7344*)
+let rec f : unit -> < m: 'a. 'a -> 'a> = fun () ->
+  let x = f () in
+  ignore (x#m 1);
+  ignore (x#m "hello");
+  assert false;;
+[%%expect{|
+val f : unit -> < m : 'a. 'a -> 'a > = 
+|}]
+
+(* PR#7395 *)
+type u
+type 'a t = u;;
+let c (f : u -> u) =
+ object
+   method apply: 'a. 'a t -> 'a t = fun x -> f x
+ end;;
+[%%expect{|
+type u
+type 'a t = u
+val c : (u -> u) -> < apply : 'a. u -> u > = 
+|}]
+
+(* PR#7496 *)
+let f (x : < m: 'a. ([< `Foo of int & float] as 'a) -> unit>)
+         : < m: 'a. ([< `Foo of int & float] as 'a) -> unit> = x;;
+
+type t = { x : 'a. ([< `Foo of int & float ] as 'a) -> unit };;
+let f t = { x = t.x };;
+[%%expect{|
+val f :
+  < m : 'a. ([< `Foo of int & float ] as 'a) -> unit > ->
+  < m : 'b. ([< `Foo of int & float ] as 'b) -> unit > = 
+type t = { x : 'a. ([< `Foo of int & float ] as 'a) -> unit; }
+val f : t -> t = 
+|}]
+
+type t = 
+type g = 
+type h = 
+[%%expect{|
+type t = < m : int >
+type g = < m : int; n : string >
+type h = < m : int; n : string; x : string; y : int >
+|}]
+
+type t = 
+and g = 
+[%%expect{|
+Line 1, characters 10-11:
+1 | type t = 
+              ^
+Error: The type constructor g is not yet completely defined
+|}]
+
+type t = int
+type g = 
+[%%expect{|
+type t = int
+Line 2, characters 10-11:
+2 | type g = 
+              ^
+Error: The type int is not an object type
+|}]
+
+type t = 
+type g = 
+[%%expect{|
+type t = < a : int >
+type g = < a : int >
+|}]
+
+type c = 
+let s:c = object method a=1; method d="123" end
+[%%expect{|
+type c = < a : int; d : string >
+val s : c = 
+|}]
+
+type 'a t = < m: 'a >
+type s = < int t >
+module M = struct type t = < m: int > end
+type u = < M.t >
+type r = < a : int; < b : int > >
+type e = < >
+type r1 = < a : int; e >
+type r2 = < a : int; < < < > > > >
+[%%expect{|
+type 'a t = < m : 'a >
+type s = < m : int >
+module M : sig type t = < m : int > end
+type u = < m : int >
+type r = < a : int; b : int >
+type e = <  >
+type r1 = < a : int >
+type r2 = < a : int >
+|}]
+
+type gg = float; a:int>
+[%%expect{|
+Line 1, characters 27-30:
+1 | type gg = float; a:int>
+                               ^^^
+Error: Method 'a' has type int, which should be int -> float
+|}]
+
+type t = 
+type g = 
+[%%expect{|
+type t = < a : int; b : string >
+Line 2, characters 19-20:
+2 | type g = 
+                       ^
+Error: Method 'b' has type string, which should be float
+|}]
+
+module A = struct
+  class type ['a] t1 = object method f : 'a end
+end
+type t = < int A.t1 >
+[%%expect{|
+module A : sig class type ['a] t1 = object method f : 'a end end
+type t = < f : int >
+|}]
+
+type t = < int #A.t1 >
+[%%expect{|
+Line 1, characters 11-20:
+1 | type t = < int #A.t1 >
+               ^^^^^^^^^
+Error: Illegal open object type
+|}]
+
+let g = fun (y : ('a * 'b)) x -> (x : <  ;  >)
+[%%expect{|
+val g : 'a * 'a -> < m : 'a > -> < m : 'a > = 
+|}]
+
+type 'a t = 
+[%%expect{|
+type 'a t = < m : 'a > constraint 'a = int
+|}]
+
+(* GPR#1142 *)
+external reraise : exn -> 'a = "%reraise"
+
+module M () = struct
+  let f : 'a -> 'a = assert false
+  let g : 'a -> 'a = raise Not_found
+  let h : 'a -> 'a = reraise Not_found
+  let i : 'a -> 'a = raise_notrace Not_found
+end
+
+[%%expect{|
+external reraise : exn -> 'a = "%reraise"
+module M :
+  functor () ->
+    sig
+      val f : 'a -> 'a
+      val g : 'a -> 'a
+      val h : 'a -> 'a
+      val i : 'a -> 'a
+    end
+|}]
+
+(* #8550 *)
+class ['a] r = let r : 'a = ref [] in object method get = r end;;
+[%%expect{|
+Line 1, characters 0-63:
+1 | class ['a] r = let r : 'a = ref [] in object method get = r end;;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type of this class,
+       class ['a] r :
+         object constraint 'a = '_weak2 list ref method get : 'a end,
+       contains type variables that cannot be generalized
+|}]
+
+(* #8701 *)
+type 'a t = 'a constraint 'a = 'b list;;
+type 'a s = 'a list;;
+let id x = x;;
+[%%expect{|
+type 'a t = 'a constraint 'a = 'b list
+type 'a s = 'a list
+val id : 'a -> 'a = 
+|}]
+
+let x : [ `Foo of _ s | `Foo of 'a t ] = id (`Foo []);;
+[%%expect{|
+val x : [ `Foo of 'a s ] = `Foo []
+|}]
+let x : [ `Foo of 'a t | `Foo of _ s ] = id (`Foo []);;
+[%%expect{|
+val x : [ `Foo of 'a list t ] = `Foo []
+|}]
+
+(* generalize spine of inherited methods too *)
+
+class c = object (self) method m ?(x=0) () = x method n = self#m () end;;
+class d = object (self) inherit c method n' = self#m () end;;
+[%%expect{|
+class c : object method m : ?x:int -> unit -> int method n : int end
+class d :
+  object method m : ?x:int -> unit -> int method n : int method n' : int end
+|}]
+
+(* #1132 *)
+let rec foo : 'a . 'a -> 'd = fun x -> x
+[%%expect{|
+Line 1, characters 30-40:
+1 | let rec foo : 'a . 'a -> 'd = fun x -> x
+                                  ^^^^^^^^^^
+Error: This definition has type 'b -> 'b which is less general than
+         'a. 'a -> 'c
+|}]
+
+(* #7741 *)
+type 'a s = S
+
+class type ['x] c = object
+  method x : 'x list
+end
+[%%expect{|
+type 'a s = S
+class type ['x] c = object method x : 'x list end
+|}]
+
+let x : 'a c = object
+  method x : 'b . 'b s list = [S]
+end
+[%%expect{|
+Lines 1-3, characters 15-3:
+1 | ...............object
+2 |   method x : 'b . 'b s list = [S]
+3 | end
+Error: This expression has type < x : 'b. 'b s list >
+       but an expression was expected of type 'a c
+       The method x has type 'b. 'b s list, but the expected method type was
+       'a list
+       The universal variable 'b would escape its scope
+|}]
+
+type u = < m : 'a. 'a s list * (< m : 'b. 'a s list * 'c > as 'c) >
+type v = < m : 'a. 'a s list * 'c > as 'c
+[%%expect{|
+type u = < m : 'a. 'a s list * (< m : 'a s list * 'b > as 'b) >
+type v = < m : 'a. 'a s list * 'b > as 'b
+|}]
+let f (x : u) = (x : v)
+[%%expect{|
+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
+       The method m has type 'a s list * < m : 'b > as 'b,
+       but the expected method type was 'a. 'a s list * < m : 'a. 'b > as 'b
+       The universal variable 'a would escape its scope
+|}]
+
+type 'a s = private int
+[%%expect{|
+type 'a s = private int
+|}]
+let x : 'a c = object
+  method x : 'b . 'b s list = []
+end
+[%%expect{|
+Lines 1-3, characters 15-3:
+1 | ...............object
+2 |   method x : 'b . 'b s list = []
+3 | end
+Error: This expression has type < x : 'b. 'b s list >
+       but an expression was expected of type 'a c
+       The method x has type 'b. 'b s list, but the expected method type was
+       'a list
+       The universal variable 'b would escape its scope
+|}]
+
+(* #9856 *)
+let f x =
+  let ref : type a . a option ref = ref None in
+  ref := Some x;
+  Option.get !ref
+[%%expect{|
+Line 2, characters 6-44:
+2 |   let ref : type a . a option ref = ref None in
+          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This definition has type 'a option ref which is less general than
+         'a0. 'a0 option ref
+|}]
+
+type pr = { foo : 'a. 'a option ref }
+let x = { foo = ref None }
+[%%expect{|
+type pr = { foo : 'a. 'a option ref; }
+Line 2, characters 16-24:
+2 | let x = { foo = ref None }
+                    ^^^^^^^^
+Error: This field value has type 'b option ref which is less general than
+         'a. 'a option ref
+|}]
diff --git a/testsuite/tests/typing-poly/pr7636.ml b/testsuite/tests/typing-poly/pr7636.ml
new file mode 100644
index 00000000..16074ab5
--- /dev/null
+++ b/testsuite/tests/typing-poly/pr7636.ml
@@ -0,0 +1,37 @@
+(* TEST
+   * expect
+*)
+
+module M = struct
+  type ('a, 'b) elt = 'a
+
+  type 'a iter = { f : 'b.('a, 'b) elt -> unit }
+
+  let promote (f : 'a -> unit) =
+    let f : 'b.('a, 'b) elt -> unit = fun x -> f x in
+    { f }
+end
+[%%expect{|
+module M :
+  sig
+    type ('a, 'b) elt = 'a
+    type 'a iter = { f : 'b. 'a -> unit; }
+    val promote : ('a -> unit) -> 'a iter
+  end
+|}]
+
+module M' : sig
+  type ('a, 'b) elt
+  type 'a iter = { f : 'b.('a, 'b) elt -> unit }
+end = M
+[%%expect{|
+module M' :
+  sig type ('a, 'b) elt type 'a iter = { f : 'b. ('a, 'b) elt -> unit; } end
+|}]
+
+type 'a t = int
+let test : 'a. int -> 'a t = fun i -> i;;
+[%%expect{|
+type 'a t = int
+val test : int -> int = 
+|}]
diff --git a/testsuite/tests/typing-poly/pr9603.ml b/testsuite/tests/typing-poly/pr9603.ml
new file mode 100644
index 00000000..382b1c2b
--- /dev/null
+++ b/testsuite/tests/typing-poly/pr9603.ml
@@ -0,0 +1,48 @@
+(* TEST
+   * expect
+*)
+
+type 'p pair = 'a * 'b constraint 'p = < left:'a; right:'b>
+
+(* New in 4.11 *)
+let error: 'left 'right.
+   pair ->  pair =
+  fun (x,y) -> (y,x)
+[%%expect{|
+type 'c pair = 'a * 'b constraint 'c = < left : 'a; right : 'b >
+val error :
+  < left : 'left; right : 'right > pair ->
+  < left : 'right; right : 'left > pair = 
+|}]
+
+(* Known problem with polymorphic methods *)
+let foo :
+  < m : 'left 'right.  pair >
+   -> < m : 'left 'right.  pair >
+= fun x -> x
+
+[%%expect{|
+Line 4, characters 11-12:
+4 | = fun x -> x
+               ^
+Error: This expression 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 >
+       Type < left : 'left; right : 'right > pair = 'a * 'b
+       is not compatible with type < left : 'left0; right : 'right0 > pair
+       The method left has type 'a, but the expected method type was 'left
+       The universal variable 'left would escape its scope
+|}, Principal{|
+Line 4, characters 6-7:
+4 | = fun x -> x
+          ^
+Error: This pattern matches values of type
+         < m : 'left 'right. < left : 'left; right : 'right > pair >
+       but a pattern was expected which matches values of type
+         < m : 'left 'right. < left : 'left; right : 'right > pair >
+       Type < left : 'left; right : 'right > pair = 'a * 'b
+       is not compatible with type < left : 'left0; right : 'right0 > pair
+       The method left has type 'a, but the expected method type was 'left
+       The universal variable 'left would escape its scope
+|}]
diff --git a/testsuite/tests/typing-polyvariants-bugs-2/pr3918a.mli b/testsuite/tests/typing-polyvariants-bugs-2/pr3918a.mli
new file mode 100644
index 00000000..b0afbbe5
--- /dev/null
+++ b/testsuite/tests/typing-polyvariants-bugs-2/pr3918a.mli
@@ -0,0 +1 @@
+type 'a voption = [ `None | `Some of 'a]
diff --git a/testsuite/tests/typing-polyvariants-bugs-2/pr3918b.mli b/testsuite/tests/typing-polyvariants-bugs-2/pr3918b.mli
new file mode 100644
index 00000000..3513ff9c
--- /dev/null
+++ b/testsuite/tests/typing-polyvariants-bugs-2/pr3918b.mli
@@ -0,0 +1 @@
+type 'a vlist = ('a * 'b) Pr3918a.voption as 'b
diff --git a/testsuite/tests/typing-polyvariants-bugs-2/pr3918c.compilers.reference b/testsuite/tests/typing-polyvariants-bugs-2/pr3918c.compilers.reference
new file mode 100644
index 00000000..411578cf
--- /dev/null
+++ b/testsuite/tests/typing-polyvariants-bugs-2/pr3918c.compilers.reference
@@ -0,0 +1,6 @@
+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 = 'a
+       but an expression was expected of type 'b Pr3918b.vlist
+       The type variable 'a occurs inside ('d * 'c) Pr3918a.voption as 'c
diff --git a/testsuite/tests/typing-polyvariants-bugs-2/pr3918c.ml b/testsuite/tests/typing-polyvariants-bugs-2/pr3918c.ml
new file mode 100644
index 00000000..f3a7ccca
--- /dev/null
+++ b/testsuite/tests/typing-polyvariants-bugs-2/pr3918c.ml
@@ -0,0 +1,25 @@
+(* TEST
+files = "pr3918a.mli pr3918b.mli"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+module = "pr3918a.mli"
+*** ocamlc.byte
+module = "pr3918b.mli"
+**** script
+script = "rm -f pr3918a.cmi"
+***** ocamlc.byte
+module = "pr3918c.ml"
+ocamlc_byte_exit_status = "2"
+***** check-ocamlc.byte-output
+*)
+
+(*
+  ocamlc -c pr3918a.mli pr3918b.mli
+  rm -f pr3918a.cmi
+  ocamlc -c pr3918c.ml
+*)
+
+open Pr3918b
+
+let f x = (x : 'a vlist :> 'b vlist)
+let f (x : 'a vlist) = (x : 'b vlist)
diff --git a/testsuite/tests/typing-polyvariants-bugs/pr4775_ok.ml b/testsuite/tests/typing-polyvariants-bugs/pr4775_ok.ml
new file mode 100644
index 00000000..e471f4ec
--- /dev/null
+++ b/testsuite/tests/typing-polyvariants-bugs/pr4775_ok.ml
@@ -0,0 +1,18 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type Poly = sig
+  type 'a t = 'a constraint 'a = [> ]
+end
+
+module Combine (A : Poly) (B : Poly) = struct
+  type ('a, 'b) t = 'a A.t constraint 'a = 'b B.t
+end
+
+module C = Combine
+  (struct type 'a t = 'a constraint 'a = [> ] end)
+  (struct type 'a t = 'a constraint 'a = [> ] end)
diff --git a/testsuite/tests/typing-polyvariants-bugs/pr4933_ok.ml b/testsuite/tests/typing-polyvariants-bugs/pr4933_ok.ml
new file mode 100644
index 00000000..35316922
--- /dev/null
+++ b/testsuite/tests/typing-polyvariants-bugs/pr4933_ok.ml
@@ -0,0 +1,22 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type Priv = sig
+  type t = private int
+end
+
+module Make (Unit:sig end): Priv = struct type t = int end
+
+module A = Make (struct end)
+
+module type Priv' = sig
+  type t = private [> `A]
+end
+
+module Make' (Unit:sig end): Priv' = struct type t = [`A] end
+
+module A' = Make' (struct end)
diff --git a/testsuite/tests/typing-polyvariants-bugs/pr5057_ok.ml b/testsuite/tests/typing-polyvariants-bugs/pr5057_ok.ml
new file mode 100644
index 00000000..8edd6b7f
--- /dev/null
+++ b/testsuite/tests/typing-polyvariants-bugs/pr5057_ok.ml
@@ -0,0 +1,21 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* PR5057 *)
+
+module TT = struct
+  module IntSet = Set.Make(struct type t = int let compare = compare end)
+end
+
+let () =
+  let f flag =
+    let module T = TT in
+    let _ = match flag with `A -> 0 | `B r -> r in
+    let _ = match flag with `A -> T.IntSet.mem | `B r -> r in
+    ()
+  in
+  f `A
diff --git a/testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.compilers.reference b/testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.compilers.reference
new file mode 100644
index 00000000..0dd205a3
--- /dev/null
+++ b/testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.compilers.reference
@@ -0,0 +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
+         int -> T.t -> bool
+       The type constructor T.t would escape its scope
diff --git a/testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.ml b/testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.ml
new file mode 100644
index 00000000..11a84c59
--- /dev/null
+++ b/testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.ml
@@ -0,0 +1,15 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* This one should fail *)
+
+let f flag =
+  let module T = Set.Make(struct type t = int let compare = compare end) in
+  let _ = match flag with `A -> 0 | `B r -> r in
+  let _ = match flag with `A -> T.mem | `B r -> r in
+  ()
diff --git a/testsuite/tests/typing-polyvariants-bugs/pr7199_ok.ml b/testsuite/tests/typing-polyvariants-bugs/pr7199_ok.ml
new file mode 100644
index 00000000..02675e05
--- /dev/null
+++ b/testsuite/tests/typing-polyvariants-bugs/pr7199_ok.ml
@@ -0,0 +1,20 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type S = sig
+ type +'a t
+
+ val foo : [`A] t -> unit
+ val bar : [< `A | `B] t -> unit
+end
+
+module Make(T : S) = struct
+ let f x =
+   T.foo x;
+   T.bar x;
+   (x :> [`A | `C] T.t)
+end
diff --git a/testsuite/tests/typing-polyvariants-bugs/pr7817_bad.ml b/testsuite/tests/typing-polyvariants-bugs/pr7817_bad.ml
new file mode 100644
index 00000000..85d82c92
--- /dev/null
+++ b/testsuite/tests/typing-polyvariants-bugs/pr7817_bad.ml
@@ -0,0 +1,29 @@
+(* TEST
+   * expect
+*)
+
+let r = ref None
+
+module M : sig
+  val write : ([< `A of string | `B of int ] -> unit)
+end = struct
+  let write x =
+    match x with `A _ | `B _ -> r := Some x
+end
+[%%expect{|
+val r : '_weak1 option ref = {contents = None}
+Lines 5-8, characters 6-3:
+5 | ......struct
+6 |   let write x =
+7 |     match x with `A _ | `B _ -> r := Some x
+8 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig val write : _[< `A of '_weak2 | `B of '_weak3 ] -> unit end
+       is not included in
+         sig val write : [< `A of string | `B of int ] -> unit end
+       Values do not match:
+         val write : _[< `A of '_weak2 | `B of '_weak3 ] -> unit
+       is not included in
+         val write : [< `A of string | `B of int ] -> unit
+|}]
diff --git a/testsuite/tests/typing-polyvariants-bugs/pr7824.ml b/testsuite/tests/typing-polyvariants-bugs/pr7824.ml
new file mode 100644
index 00000000..a4484494
--- /dev/null
+++ b/testsuite/tests/typing-polyvariants-bugs/pr7824.ml
@@ -0,0 +1,78 @@
+(* TEST
+   * expect
+*)
+
+module Element : sig
+  type +'a t
+
+  val from_a  : [`A] t -> unit
+  val from_ab : [< `A | `B] t -> unit
+
+  val to_a  : unit -> [`A] t
+  val to_ab : unit -> [< `A | `B] t
+end = struct
+  type +'a t
+
+  let from_a x = assert false
+  let from_ab x = assert false
+
+  let to_a x = assert false
+  let to_ab x = assert false
+end ;;
+[%%expect{|
+module Element :
+  sig
+    type +'a t
+    val from_a : [ `A ] t -> unit
+    val from_ab : [< `A | `B ] t -> unit
+    val to_a : unit -> [ `A ] t
+    val to_ab : unit -> [< `A | `B ] t
+  end
+|}];;
+
+let f x =
+  Element.from_a x;
+  Element.from_ab x;
+  match [] with
+  | _::_ -> (x :> [`A | `C] Element.t)
+;;
+[%%expect{|
+Lines 4-5, characters 2-38:
+4 | ..match [] with
+5 |   | _::_ -> (x :> [`A | `C] Element.t)
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+[]
+val f : [ `A ] Element.t -> [ `A | `C ] Element.t = 
+|}];;
+
+type _ t = T : 'a -> 'a t
+
+let f x =
+  Element.from_a x;
+  Element.from_ab x;
+  match T () with
+  | T _ -> (x :> [`A | `C] Element.t)
+;;
+[%%expect{|
+type _ t = T : 'a -> 'a t
+val f : [ `A ] Element.t -> [ `A | `C ] Element.t = 
+|}];;
+
+let f () =
+  let open Element in
+  let x = if true then to_ab () else to_a () in
+  (x :> [ `A | `C ] Element.t)
+;;
+[%%expect{|
+val f : unit -> [ `A | `C ] Element.t = 
+|}];;
+
+let f () =
+  let open Element in
+  let x = if true then to_a () else to_ab () in
+  (x :> [ `A | `C ] Element.t)
+;;
+[%%expect{|
+val f : unit -> [ `A | `C ] Element.t = 
+|}];;
diff --git a/testsuite/tests/typing-polyvariants-bugs/privrowsabate_ok.ml b/testsuite/tests/typing-polyvariants-bugs/privrowsabate_ok.ml
new file mode 100644
index 00000000..7c738346
--- /dev/null
+++ b/testsuite/tests/typing-polyvariants-bugs/privrowsabate_ok.ml
@@ -0,0 +1,60 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+type 'a termpc =
+    [`And of 'a * 'a
+    |`Or of 'a * 'a
+    |`Not of 'a
+    |`Atom of string
+    ]
+
+type 'a termk =
+    [`Dia of 'a
+    |`Box of 'a
+    |'a termpc
+    ]
+
+module type T = sig
+  type term
+  val map : (term -> term) -> term -> term
+  val nnf : term -> term
+  val nnf_not : term -> term
+end
+
+module Fpc(X : T with type term = private [> 'a termpc] as 'a) =
+  struct
+    type term = X.term termpc
+    let nnf = function
+      |`Not(`Atom _) as x -> x
+      |`Not x     -> X.nnf_not x
+      | x         -> X.map X.nnf x
+    let map f : term -> X.term = function
+      |`Not x    -> `Not (f x)
+      |`And(x,y) -> `And (f x, f y)
+      |`Or (x,y) -> `Or  (f x, f y)
+      |`Atom _ as x -> x
+    let nnf_not : term -> _ = function
+      |`Not x    -> X.nnf x
+      |`And(x,y) -> `Or  (X.nnf_not x, X.nnf_not y)
+      |`Or (x,y) -> `And (X.nnf_not x, X.nnf_not y)
+      |`Atom _ as x -> `Not x
+  end
+
+module Fk(X : T with type term = private [> 'a termk] as 'a) =
+  struct
+    type term = X.term termk
+    module Pc = Fpc(X)
+    let map f : term -> _ = function
+      |`Dia x -> `Dia (f x)
+      |`Box x -> `Box (f x)
+      |#termpc as x -> Pc.map f x
+    let nnf = Pc.nnf
+    let nnf_not : term -> _ = function
+      |`Dia x -> `Box (X.nnf_not x)
+      |`Box x -> `Dia (X.nnf_not x)
+      |#termpc as x -> Pc.nnf_not x
+  end
diff --git a/testsuite/tests/typing-private-bugs/pr5026_bad.compilers.reference b/testsuite/tests/typing-private-bugs/pr5026_bad.compilers.reference
new file mode 100644
index 00000000..3f23c33f
--- /dev/null
+++ b/testsuite/tests/typing-private-bugs/pr5026_bad.compilers.reference
@@ -0,0 +1,5 @@
+File "pr5026_bad.ml", line 11, characters 0-36:
+11 | type -'typing wrapped = private sexp
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of wrapped contains a cycle:
+       sexp
diff --git a/testsuite/tests/typing-private-bugs/pr5026_bad.ml b/testsuite/tests/typing-private-bugs/pr5026_bad.ml
new file mode 100644
index 00000000..52c135b3
--- /dev/null
+++ b/testsuite/tests/typing-private-bugs/pr5026_bad.ml
@@ -0,0 +1,19 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+type untyped;;
+type -'a typed = private untyped;;
+type -'typing wrapped = private sexp
+and +'a t = 'a typed wrapped
+and sexp = private untyped wrapped;;
+class type ['a] s3 = object
+  val underlying : 'a t
+end;;
+class ['a] s3object r : ['a] s3 = object
+  val underlying = r
+end;;
diff --git a/testsuite/tests/typing-private-bugs/pr5469_ok.ml b/testsuite/tests/typing-private-bugs/pr5469_ok.ml
new file mode 100644
index 00000000..e7311b1a
--- /dev/null
+++ b/testsuite/tests/typing-private-bugs/pr5469_ok.ml
@@ -0,0 +1,14 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module M (T:sig type t end)
+ = struct type t = private { t : T.t } end
+module P
+ = struct
+       module T = struct type t end
+       module R = M(T)
+ end
diff --git a/testsuite/tests/typing-private/private.compilers.principal.reference b/testsuite/tests/typing-private/private.compilers.principal.reference
new file mode 100644
index 00000000..ee60a677
--- /dev/null
+++ b/testsuite/tests/typing-private/private.compilers.principal.reference
@@ -0,0 +1,124 @@
+module Foobar : sig type t = private int end
+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
+         Foobar.t
+module F = Foobar
+val f : F.t -> Foobar.t = 
+module M : sig type t = < m : int > end
+module M1 : sig type t = private < m : int; .. > end
+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
+module M3 : sig type t = private M1.t end
+- : M3.t -> M1.t = 
+- : M3.t -> M.t = 
+Line 1, characters 44-46:
+1 | module M4 : sig type t = private M3.t end = M2;; (* fails *)
+                                                ^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = M2.t end
+       is not included in
+         sig type t = private M3.t end
+       Type declarations do not match:
+         type t = M2.t
+       is not included in
+         type t = private M3.t
+Line 1, characters 44-45:
+1 | module M4 : sig type t = private M3.t end = M;; (* fails *)
+                                                ^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = < m : int > end
+       is not included in
+         sig type t = private M3.t end
+       Type declarations do not match:
+         type t = < m : int >
+       is not included in
+         type t = private M3.t
+Line 1, characters 44-46:
+1 | module M4 : sig type t = private M3.t end = M1;; (* might be ok *)
+                                                ^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = M1.t end
+       is not included in
+         sig type t = private M3.t end
+       Type declarations do not match:
+         type t = M1.t
+       is not included in
+         type t = private M3.t
+module M5 : sig type t = private M1.t end
+Line 1, characters 53-55:
+1 | module M6 : sig type t = private < n:int; .. > end = M1;; (* fails *)
+                                                         ^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = M1.t end
+       is not included in
+         sig type t = private < n : int; .. > end
+       Type declarations do not match:
+         type t = M1.t
+       is not included in
+         type t = private < n : int; .. >
+Line 3, characters 2-51:
+3 |   struct type t = int let f (x : int) = (x : t) end;; (* must fail *)
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = int val f : int -> t end
+       is not included in
+         sig type t = private Foobar.t val f : int -> t end
+       Type declarations do not match:
+         type t = int
+       is not included in
+         type t = private Foobar.t
+module M : sig type t = private T of int val mk : int -> t end
+module M1 : sig type t = M.t val mk : int -> t end
+module M2 : sig type t = M.t val mk : int -> t end
+module M3 : sig type t = M.t val mk : int -> t end
+Line 3, characters 4-27:
+3 |     type t = M.t = T of int
+        ^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type M.t
+       A private type would be revealed.
+module M5 : sig type t = M.t = private T of int val mk : int -> t end
+module M6 : sig type t = private T of int val mk : int -> t end
+module M' :
+  sig type t_priv = private T of int type t = t_priv val mk : int -> t end
+module M3' : sig type t = M'.t val mk : int -> t end
+module M : sig type 'a t = private T of 'a end
+module M1 : sig type 'a t = 'a M.t = private T of 'a end
+module Test : sig type t = private A end
+module Test2 : sig type t = Test.t = private A end
+val f : Test.t -> Test2.t = 
+val f : Test2.t -> unit = 
+Line 1, characters 8-15:
+1 | let a = Test2.A;; (* fail *)
+            ^^^^^^^
+Error: Cannot create values of the private type Test2.t
+Line 3, characters 40-63:
+3 | module Test2 : module type of Test with type t = private Test.t = Test;;
+                                            ^^^^^^^^^^^^^^^^^^^^^^^
+Alert deprecated: spurious use of private
+module Test2 : sig type t = Test.t = private A end
+type t = private < x : int; .. >
+type t = private < x : int; .. >
+type t = private < x : int >
+type t = private < x : int >
+Line 1:
+Error: Type declarations do not match:
+         type 'a t = private 'a constraint 'a = < x : int; .. >
+       is not included in
+         type 'a t
+       Their constraints differ.
+type 'a t = private 'a constraint 'a = < x : int; .. >
+type t = [ `Closed ]
+type nonrec t = private [> t ]
+
diff --git a/testsuite/tests/typing-private/private.compilers.reference b/testsuite/tests/typing-private/private.compilers.reference
new file mode 100644
index 00000000..bead385a
--- /dev/null
+++ b/testsuite/tests/typing-private/private.compilers.reference
@@ -0,0 +1,124 @@
+module Foobar : sig type t = private int end
+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
+         Foobar.t
+module F = Foobar
+val f : F.t -> Foobar.t = 
+module M : sig type t = < m : int > end
+module M1 : sig type t = private < m : int; .. > end
+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
+module M3 : sig type t = private M1.t end
+- : M3.t -> M1.t = 
+- : M3.t -> M.t = 
+Line 1, characters 44-46:
+1 | module M4 : sig type t = private M3.t end = M2;; (* fails *)
+                                                ^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = M2.t end
+       is not included in
+         sig type t = private M3.t end
+       Type declarations do not match:
+         type t = M2.t
+       is not included in
+         type t = private M3.t
+Line 1, characters 44-45:
+1 | module M4 : sig type t = private M3.t end = M;; (* fails *)
+                                                ^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = < m : int > end
+       is not included in
+         sig type t = private M3.t end
+       Type declarations do not match:
+         type t = < m : int >
+       is not included in
+         type t = private M3.t
+Line 1, characters 44-46:
+1 | module M4 : sig type t = private M3.t end = M1;; (* might be ok *)
+                                                ^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = M1.t end
+       is not included in
+         sig type t = private M3.t end
+       Type declarations do not match:
+         type t = M1.t
+       is not included in
+         type t = private M3.t
+module M5 : sig type t = private M1.t end
+Line 1, characters 53-55:
+1 | module M6 : sig type t = private < n:int; .. > end = M1;; (* fails *)
+                                                         ^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = M1.t end
+       is not included in
+         sig type t = private < n : int; .. > end
+       Type declarations do not match:
+         type t = M1.t
+       is not included in
+         type t = private < n : int; .. >
+Line 3, characters 2-51:
+3 |   struct type t = int let f (x : int) = (x : t) end;; (* must fail *)
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = int val f : int -> t end
+       is not included in
+         sig type t = private Foobar.t val f : int -> t end
+       Type declarations do not match:
+         type t = int
+       is not included in
+         type t = private Foobar.t
+module M : sig type t = private T of int val mk : int -> t end
+module M1 : sig type t = M.t val mk : int -> t end
+module M2 : sig type t = M.t val mk : int -> t end
+module M3 : sig type t = M.t val mk : int -> t end
+Line 3, characters 4-27:
+3 |     type t = M.t = T of int
+        ^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type M.t
+       A private type would be revealed.
+module M5 : sig type t = M.t = private T of int val mk : int -> t end
+module M6 : sig type t = private T of int val mk : int -> t end
+module M' :
+  sig type t_priv = private T of int type t = t_priv val mk : int -> t end
+module M3' : sig type t = M'.t val mk : int -> t end
+module M : sig type 'a t = private T of 'a end
+module M1 : sig type 'a t = 'a M.t = private T of 'a end
+module Test : sig type t = private A end
+module Test2 : sig type t = Test.t = private A end
+val f : Test.t -> Test2.t = 
+val f : Test2.t -> unit = 
+Line 1, characters 8-15:
+1 | let a = Test2.A;; (* fail *)
+            ^^^^^^^
+Error: Cannot create values of the private type Test2.t
+Line 3, characters 40-63:
+3 | module Test2 : module type of Test with type t = private Test.t = Test;;
+                                            ^^^^^^^^^^^^^^^^^^^^^^^
+Alert deprecated: spurious use of private
+module Test2 : sig type t = Test.t = private A end
+type t = private < x : int; .. >
+type t = private < x : int; .. >
+type t = private < x : int >
+type t = private < x : int >
+Line 1:
+Error: Type declarations do not match:
+         type 'a t = private < x : int; .. > constraint 'a = 'a t
+       is not included in
+         type 'a t
+       Their constraints differ.
+type 'a t = private 'a constraint 'a = < x : int; .. >
+type t = [ `Closed ]
+type nonrec t = private [> t ]
+
diff --git a/testsuite/tests/typing-private/private.ml b/testsuite/tests/typing-private/private.ml
new file mode 100644
index 00000000..156e9ba5
--- /dev/null
+++ b/testsuite/tests/typing-private/private.ml
@@ -0,0 +1,122 @@
+(* TEST
+   * toplevel
+   * toplevel with principal
+*)
+
+module Foobar : sig
+  type t = private int
+end = struct
+  type t = int
+end;;
+
+module F0 : sig type t = private int end = Foobar;;
+
+let f (x : F0.t) = (x : Foobar.t);; (* fails *)
+
+module F = Foobar;;
+
+let f (x : F.t) = (x : Foobar.t);;
+
+module M = struct type t =  end;;
+module M1 : sig type t = private  end = M;;
+module M2 :  sig type t = private  end = M1;;
+fun (x : M1.t) -> (x : M2.t);; (* fails *)
+
+module M3 : sig type t = private M1.t end = M1;;
+fun x -> (x : M3.t :> M1.t);;
+fun x -> (x : M3.t :> M.t);;
+module M4 : sig type t = private M3.t end = M2;; (* fails *)
+module M4 : sig type t = private M3.t end = M;; (* fails *)
+module M4 : sig type t = private M3.t end = M1;; (* might be ok *)
+module M5 : sig type t = private M1.t end = M3;;
+module M6 : sig type t = private < n:int; .. > end = M1;; (* fails *)
+
+module Bar : sig type t = private Foobar.t val f : int -> t end =
+  struct type t = int let f (x : int) = (x : t) end;; (* must fail *)
+
+module M : sig
+  type t = private T of int
+  val mk : int -> t
+end = struct
+  type t = T of int
+  let mk x = T(x)
+end;;
+
+module M1 : sig
+  type t = M.t
+  val mk : int -> t
+end = struct
+  type t = M.t
+  let mk = M.mk
+end;;
+
+module M2 : sig
+  type t = M.t
+  val mk : int -> t
+end = struct
+  include M
+end;;
+
+module M3 : sig
+  type t = M.t
+  val mk : int -> t
+end = M;;
+
+module M4 : sig
+    type t = M.t = T of int
+    val mk : int -> t
+  end = M;;
+(* Error: The variant or record definition does not match that of type M.t *)
+
+module M5 : sig
+  type t = M.t = private T of int
+  val mk : int -> t
+end = M;;
+
+module M6 : sig
+  type t = private T of int
+  val mk : int -> t
+end = M;;
+
+module M' : sig
+  type t_priv = private T of int
+  type t = t_priv
+  val mk : int -> t
+end = struct
+  type t_priv = T of int
+  type t = t_priv
+  let mk x = T(x)
+end;;
+
+module M3' : sig
+  type t = M'.t
+  val mk : int -> t
+end = M';;
+
+module M : sig type 'a t = private T of 'a end =
+  struct type 'a t = T of 'a end;;
+
+module M1 : sig type 'a t = 'a M.t = private T of 'a end =
+  struct type 'a t = 'a M.t = private T of 'a end;;
+
+(* PR#6090 *)
+module Test = struct type t = private A end
+module Test2 : module type of Test with type t = Test.t = Test;;
+let f (x : Test.t) = (x : Test2.t);;
+let f Test2.A = ();;
+let a = Test2.A;; (* fail *)
+(* The following should fail from a semantical point of view,
+   but allow it for backward compatibility *)
+module Test2 : module type of Test with type t = private Test.t = Test;;
+
+(* PR#6331 *)
+type t = private < x : int; .. > as 'a;;
+type t = private (< x : int; .. > as 'a) as 'a;;
+type t = private < x : int > as 'a;;
+type t = private (< x : int > as 'a) as 'b;;
+type 'a t = private < x : int; .. > as 'a;;
+type 'a t = private 'a constraint 'a = < x : int; .. >;;
+
+(* PR#7437 *)
+type t = [` Closed ];;
+type nonrec t = private [> t];;
diff --git a/testsuite/tests/typing-recmod/gpr1626.ml b/testsuite/tests/typing-recmod/gpr1626.ml
new file mode 100644
index 00000000..9629f2c6
--- /dev/null
+++ b/testsuite/tests/typing-recmod/gpr1626.ml
@@ -0,0 +1,16 @@
+(* TEST
+   * expect
+*)
+
+module type S = sig module M : sig end module N = M end;;
+[%%expect{|
+module type S = sig module M : sig end module N = M end
+|}];;
+
+module rec M : S with module M := M = M;;
+[%%expect{|
+Line 1, characters 34-35:
+1 | module rec M : S with module M := M = M;;
+                                      ^
+Error: Illegal recursive module reference
+|}];;
diff --git a/testsuite/tests/typing-recmod/pr9494.ml b/testsuite/tests/typing-recmod/pr9494.ml
new file mode 100644
index 00000000..41fda6aa
--- /dev/null
+++ b/testsuite/tests/typing-recmod/pr9494.ml
@@ -0,0 +1,38 @@
+(* TEST
+*)
+
+(* PR#9494 *)
+
+(* Additional test cases from Vincent Laviron: *)
+
+(* Looping version *)
+module rec M1 : sig
+  val f : unit -> unit
+  val g : unit -> unit
+end = struct
+  let f = M1.g
+  let g () = M1.f ()
+end
+
+(* Alias chain *)
+module rec M2 : sig
+  val f : unit -> unit
+  val g : unit -> unit
+end = struct
+  let f = M2.g
+  let g = M2.f
+end
+
+(* Original test case from the issue: *)
+
+module rec Id : sig
+  type t = {id : int}
+  val compare : t -> t -> int
+end = Id (* error here: undefined compare function *)
+
+module IdSet = Set.Make(Id)
+
+let _ = try
+  let basic_set = IdSet.singleton {id = 0} in
+  IdSet.mem {id = 1} basic_set (* diverge here *)
+with e -> print_endline @@ Printexc.to_string e; false
diff --git a/testsuite/tests/typing-recmod/pr9494.reference b/testsuite/tests/typing-recmod/pr9494.reference
new file mode 100644
index 00000000..f9982e6b
--- /dev/null
+++ b/testsuite/tests/typing-recmod/pr9494.reference
@@ -0,0 +1 @@
+File "pr9494.ml", line 31, characters 6-12: Undefined recursive module
diff --git a/testsuite/tests/typing-recmod/t01bad.compilers.reference b/testsuite/tests/typing-recmod/t01bad.compilers.reference
new file mode 100644
index 00000000..5da0bcdc
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t01bad.compilers.reference
@@ -0,0 +1,4 @@
+File "t01bad.ml", line 10, characters 0-61:
+10 | module rec A : sig type t = A.t end = struct type t = A.t end;;
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type abbreviation A.t is cyclic
diff --git a/testsuite/tests/typing-recmod/t01bad.ml b/testsuite/tests/typing-recmod/t01bad.ml
new file mode 100644
index 00000000..f0ae828a
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t01bad.ml
@@ -0,0 +1,10 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* Bad (t = t) *)
+module rec A : sig type t = A.t end = struct type t = A.t end;;
diff --git a/testsuite/tests/typing-recmod/t02bad.compilers.reference b/testsuite/tests/typing-recmod/t02bad.compilers.reference
new file mode 100644
index 00000000..ef3f6ed8
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t02bad.compilers.reference
@@ -0,0 +1,5 @@
+File "t02bad.ml", line 10, characters 0-61:
+10 | module rec A : sig type t = B.t end = struct type t = B.t end
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of A.t contains a cycle:
+       B.t
diff --git a/testsuite/tests/typing-recmod/t02bad.ml b/testsuite/tests/typing-recmod/t02bad.ml
new file mode 100644
index 00000000..9a490d89
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t02bad.ml
@@ -0,0 +1,11 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* Bad (t = t) *)
+module rec A : sig type t = B.t end = struct type t = B.t end
+       and B : sig type t = A.t end = struct type t = A.t end;;
diff --git a/testsuite/tests/typing-recmod/t03ok.ml b/testsuite/tests/typing-recmod/t03ok.ml
new file mode 100644
index 00000000..948d9bf8
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t03ok.ml
@@ -0,0 +1,10 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* OK (t = int) *)
+module rec A : sig type t = B.t end = struct type t = B.t end
+       and B : sig type t = int end = struct type t = int end;;
diff --git a/testsuite/tests/typing-recmod/t04bad.compilers.reference b/testsuite/tests/typing-recmod/t04bad.compilers.reference
new file mode 100644
index 00000000..525dd301
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t04bad.compilers.reference
@@ -0,0 +1,5 @@
+File "t04bad.ml", line 10, characters 0-73:
+10 | module rec A : sig type t = int * A.t end = struct type t = int * A.t end;;
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of A.t contains a cycle:
+       int * A.t
diff --git a/testsuite/tests/typing-recmod/t04bad.ml b/testsuite/tests/typing-recmod/t04bad.ml
new file mode 100644
index 00000000..3de1bb10
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t04bad.ml
@@ -0,0 +1,10 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* Bad (t = int * t) *)
+module rec A : sig type t = int * A.t end = struct type t = int * A.t end;;
diff --git a/testsuite/tests/typing-recmod/t05bad.compilers.reference b/testsuite/tests/typing-recmod/t05bad.compilers.reference
new file mode 100644
index 00000000..3daf0ab2
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t05bad.compilers.reference
@@ -0,0 +1,5 @@
+File "t05bad.ml", line 10, characters 0-75:
+10 | module rec A : sig type t = B.t -> int end = struct type t = B.t -> int end
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of A.t contains a cycle:
+       B.t -> int
diff --git a/testsuite/tests/typing-recmod/t05bad.ml b/testsuite/tests/typing-recmod/t05bad.ml
new file mode 100644
index 00000000..c413cec2
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t05bad.ml
@@ -0,0 +1,11 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* Bad (t = t -> int) *)
+module rec A : sig type t = B.t -> int end = struct type t = B.t -> int end
+       and B : sig type t = A.t end = struct type t = A.t end;;
diff --git a/testsuite/tests/typing-recmod/t06ok.ml b/testsuite/tests/typing-recmod/t06ok.ml
new file mode 100644
index 00000000..4305f243
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t06ok.ml
@@ -0,0 +1,10 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* OK (t = ) *)
+module rec A : sig type t =  end = struct type t =  end
+       and B : sig type t = A.t end = struct type t = A.t end;;
diff --git a/testsuite/tests/typing-recmod/t07bad.compilers.reference b/testsuite/tests/typing-recmod/t07bad.compilers.reference
new file mode 100644
index 00000000..78fa7b85
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t07bad.compilers.reference
@@ -0,0 +1,9 @@
+File "t07bad.ml", lines 10-11, characters 0-54:
+10 | module rec A : sig type 'a t =  end
+11 |              = struct type 'a t =  end..
+Error: This recursive type is not regular.
+       The type constructor A.t is defined as
+         type 'a A.t
+       but it is used as
+         'a list A.t.
+       All uses need to match the definition for the recursive type to be regular.
diff --git a/testsuite/tests/typing-recmod/t07bad.ml b/testsuite/tests/typing-recmod/t07bad.ml
new file mode 100644
index 00000000..1aa75ab7
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t07bad.ml
@@ -0,0 +1,11 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* Bad (not regular) *)
+module rec A : sig type 'a t =  end
+             = struct type 'a t =  end;;
diff --git a/testsuite/tests/typing-recmod/t08bad.compilers.reference b/testsuite/tests/typing-recmod/t08bad.compilers.reference
new file mode 100644
index 00000000..b85c1968
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t08bad.compilers.reference
@@ -0,0 +1,11 @@
+File "t08bad.ml", lines 10-11, characters 0-71:
+10 | module rec A : sig type 'a t =  end
+11 |              = struct type 'a t =  end
+Error: This recursive type is not regular.
+       The type constructor A.t is defined as
+         type 'a A.t
+       but it is used as
+         'a array A.t
+       after the following expansion(s):
+         'a array B.t = 'a array A.t
+       All uses need to match the definition for the recursive type to be regular.
diff --git a/testsuite/tests/typing-recmod/t08bad.ml b/testsuite/tests/typing-recmod/t08bad.ml
new file mode 100644
index 00000000..0647311b
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t08bad.ml
@@ -0,0 +1,12 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* Bad (not regular) *)
+module rec A : sig type 'a t =  end
+             = struct type 'a t =  end
+       and B : sig type 'a t = 'a A.t end = struct type 'a t = 'a A.t end;;
diff --git a/testsuite/tests/typing-recmod/t09bad.compilers.reference b/testsuite/tests/typing-recmod/t09bad.compilers.reference
new file mode 100644
index 00000000..f630daa1
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t09bad.compilers.reference
@@ -0,0 +1,11 @@
+File "t09bad.ml", lines 10-11, characters 0-44:
+10 | module rec A : sig type 'a t = 'a B.t end
+11 |              = struct type 'a t = 'a B.t end
+Error: This recursive type is not regular.
+       The type constructor A.t is defined as
+         type 'a A.t
+       but it is used as
+         'a array A.t
+       after the following expansion(s):
+         'a B.t = < m : 'a list A.t; n : 'a array A.t >
+       All uses need to match the definition for the recursive type to be regular.
diff --git a/testsuite/tests/typing-recmod/t09bad.ml b/testsuite/tests/typing-recmod/t09bad.ml
new file mode 100644
index 00000000..ce281c5f
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t09bad.ml
@@ -0,0 +1,13 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* Bad (not regular) *)
+module rec A : sig type 'a t = 'a B.t end
+             = struct type 'a t = 'a B.t end
+       and B : sig type 'a t =  end
+             = struct type 'a t =  end;;
diff --git a/testsuite/tests/typing-recmod/t10ok.ml b/testsuite/tests/typing-recmod/t10ok.ml
new file mode 100644
index 00000000..e91fe998
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t10ok.ml
@@ -0,0 +1,12 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* OK *)
+module rec A : sig type 'a t = 'a array B.t * 'a list B.t end
+             = struct type 'a t = 'a array B.t * 'a list B.t end
+       and B : sig type 'a t =  end
+             = struct type 'a t =  end;;
diff --git a/testsuite/tests/typing-recmod/t11bad.compilers.reference b/testsuite/tests/typing-recmod/t11bad.compilers.reference
new file mode 100644
index 00000000..360bc743
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t11bad.compilers.reference
@@ -0,0 +1,9 @@
+File "t11bad.ml", lines 12-13, characters 7-55:
+12 | .......and B : sig type 'a t =  end
+13 |              = struct type 'a t =  end..
+Error: This recursive type is not regular.
+       The type constructor B.t is defined as
+         type 'a B.t
+       but it is used as
+         'a array B.t.
+       All uses need to match the definition for the recursive type to be regular.
diff --git a/testsuite/tests/typing-recmod/t11bad.ml b/testsuite/tests/typing-recmod/t11bad.ml
new file mode 100644
index 00000000..1c8fbee2
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t11bad.ml
@@ -0,0 +1,13 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* Bad (not regular) *)
+module rec A : sig type 'a t = 'a list B.t end
+             = struct type 'a t = 'a list B.t end
+       and B : sig type 'a t =  end
+             = struct type 'a t =  end;;
diff --git a/testsuite/tests/typing-recmod/t12bad.compilers.reference b/testsuite/tests/typing-recmod/t12bad.compilers.reference
new file mode 100644
index 00000000..b1adf92f
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t12bad.compilers.reference
@@ -0,0 +1,17 @@
+File "t12bad.ml", lines 10-21, characters 0-7:
+10 | module rec M :
+11 |     sig
+12 |       class ['a] c : 'a -> object
+13 |         method map : ('a -> 'b) -> 'b M.c
+14 |       end
+...
+18 |         method map : 'b. ('a -> 'b) -> 'b M.c
+19 |           = fun f -> new M.c (f x)
+20 |       end
+21 |     end..
+Error: This recursive type is not regular.
+       The type constructor M.c is defined as
+         type 'a M.c
+       but it is used as
+         'b M.c.
+       All uses need to match the definition for the recursive type to be regular.
diff --git a/testsuite/tests/typing-recmod/t12bad.ml b/testsuite/tests/typing-recmod/t12bad.ml
new file mode 100644
index 00000000..a0094bed
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t12bad.ml
@@ -0,0 +1,21 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* Bad (not regular) *)
+module rec M :
+    sig
+      class ['a] c : 'a -> object
+        method map : ('a -> 'b) -> 'b M.c
+      end
+    end
+  = struct
+      class ['a] c (x : 'a) = object
+        method map : 'b. ('a -> 'b) -> 'b M.c
+          = fun f -> new M.c (f x)
+      end
+    end;;
diff --git a/testsuite/tests/typing-recmod/t13ok.ml b/testsuite/tests/typing-recmod/t13ok.ml
new file mode 100644
index 00000000..5ba8026e
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t13ok.ml
@@ -0,0 +1,12 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* OK *)
+class type [ 'node ] extension = object method node : 'node end
+class type [ 'ext ] node = object constraint 'ext = 'ext node #extension end
+class x = object method node : x node = assert false end
+type t = x node;;
diff --git a/testsuite/tests/typing-recmod/t14bad.compilers.reference b/testsuite/tests/typing-recmod/t14bad.compilers.reference
new file mode 100644
index 00000000..8197a02f
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t14bad.compilers.reference
@@ -0,0 +1,5 @@
+File "t14bad.ml", line 23, characters 2-43:
+23 |   module rec U : T with type D.t = U'.t = U
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of U.D.t contains a cycle:
+       U'.t
diff --git a/testsuite/tests/typing-recmod/t14bad.ml b/testsuite/tests/typing-recmod/t14bad.ml
new file mode 100644
index 00000000..4ef06167
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t14bad.ml
@@ -0,0 +1,25 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* Bad - PR 4261 *)
+
+module PR_4261 = struct
+  module type S =
+  sig
+    type t
+  end
+
+  module type T =
+  sig
+    module D : S
+    type t = D.t
+  end
+
+  module rec U : T with type D.t = U'.t = U
+  and U' : S with type t = U'.t = U
+end;;
diff --git a/testsuite/tests/typing-recmod/t15bad.compilers.reference b/testsuite/tests/typing-recmod/t15bad.compilers.reference
new file mode 100644
index 00000000..82f0dc09
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t15bad.compilers.reference
@@ -0,0 +1,4 @@
+File "t15bad.ml", line 11, characters 0-61:
+11 | module rec M : S' with type t = M.t = struct type t = M.t end;;
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type abbreviation M.t is cyclic
diff --git a/testsuite/tests/typing-recmod/t15bad.ml b/testsuite/tests/typing-recmod/t15bad.ml
new file mode 100644
index 00000000..71aa31c1
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t15bad.ml
@@ -0,0 +1,11 @@
+(* TEST
+flags = " -w a "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* Bad - PR 4512 *)
+module type S' = sig type t = int end
+module rec M : S' with type t = M.t = struct type t = M.t end;;
diff --git a/testsuite/tests/typing-recmod/t16ok.ml b/testsuite/tests/typing-recmod/t16ok.ml
new file mode 100644
index 00000000..abd6d6a4
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t16ok.ml
@@ -0,0 +1,37 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* PR#4450 *)
+
+module PR_4450_1 = struct
+  module type MyT = sig type 'a t = Succ of 'a t end
+  module MyMap(X : MyT) = X
+  module rec MyList : MyT = MyMap(MyList)
+end;;
+
+module PR_4450_2 = struct
+  module type MyT = sig
+    type 'a wrap = My of 'a t
+    and 'a t = private < map : 'b. ('a -> 'b) ->'b wrap; .. >
+    val create : 'a list -> 'a t
+  end
+  module MyMap(X : MyT) = struct
+    include X
+    class ['a] c l = object (self)
+      method map : 'b. ('a -> 'b) -> 'b wrap =
+        fun f -> My (create (List.map f l))
+    end
+  end
+  module rec MyList : sig
+    type 'a wrap = My of 'a t
+    and 'a t = < map : 'b. ('a -> 'b) ->'b wrap >
+    val create : 'a list -> 'a t
+  end = struct
+    include MyMap(MyList)
+    let create l = new c l
+  end
+end;;
diff --git a/testsuite/tests/typing-recmod/t17ok.ml b/testsuite/tests/typing-recmod/t17ok.ml
new file mode 100644
index 00000000..b59e80e2
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t17ok.ml
@@ -0,0 +1,48 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* A synthetic example of bootstrapped data structure
+   (suggested by J-C Filliatre) *)
+
+module type ORD = sig
+  type t
+  val compare : t -> t -> int
+end
+
+module type SET = sig
+  type elt
+  type t
+  val iter : (elt -> unit) -> t -> unit
+end
+
+type 'a tree = E | N of 'a tree * 'a * 'a tree
+
+module Bootstrap2
+  (MakeDiet : functor (X: ORD) -> SET with type t = X.t tree and type elt = X.t)
+  : SET with type elt = int =
+struct
+
+  type elt = int
+
+  module rec Elt : sig
+    type t = I of int * int | D of int * Diet.t * int
+    val compare : t -> t -> int
+    val iter : (int -> unit) -> t -> unit
+  end =
+  struct
+    type t = I of int * int | D of int * Diet.t * int
+    let compare x1 x2 = 0
+    let rec iter f = function
+      | I (l, r) -> for i = l to r do f i done
+      | D (_, d, _) -> Diet.iter (iter f) d
+  end
+
+  and Diet : SET with type t = Elt.t tree and type elt = Elt.t = MakeDiet(Elt)
+
+  type t = Diet.t
+  let iter f = Diet.iter (Elt.iter f)
+end
diff --git a/testsuite/tests/typing-recmod/t18ok.ml b/testsuite/tests/typing-recmod/t18ok.ml
new file mode 100644
index 00000000..3523f338
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t18ok.ml
@@ -0,0 +1,32 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* PR 4470: simplified from OMake's sources *)
+
+module rec DirElt
+  : sig
+      type t = DirRoot | DirSub of DirHash.t
+    end
+  = struct
+      type t = DirRoot | DirSub of DirHash.t
+    end
+
+and DirCompare
+  : sig
+      type t = DirElt.t
+    end
+  = struct
+      type t = DirElt.t
+    end
+
+and DirHash
+  : sig
+      type t = DirElt.t list
+    end
+  = struct
+      type t = DirCompare.t list
+    end
diff --git a/testsuite/tests/typing-recmod/t20ok.ml b/testsuite/tests/typing-recmod/t20ok.ml
new file mode 100644
index 00000000..98222594
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t20ok.ml
@@ -0,0 +1,37 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* PR 4557 *)
+module PR_4557 = struct
+  module F ( X : Set.OrderedType ) = struct
+    module rec Mod : sig
+      module XSet :
+        sig
+          type elt = X.t
+          type t = Set.Make( X ).t
+        end
+      module XMap :
+        sig
+          type key = X.t
+          type 'a t = 'a Map.Make(X).t
+        end
+      type elt = X.t
+      type t = XSet.t XMap.t
+      val compare: t -> t -> int
+    end
+       =
+    struct
+      module XSet = Set.Make( X )
+      module XMap = Map.Make( X )
+
+      type elt = X.t
+      type t = XSet.t XMap.t
+      let compare = (fun x y -> 0)
+    end
+    and ModSet : Set.S with type elt = Mod.t = Set.Make( Mod )
+  end
+end
diff --git a/testsuite/tests/typing-recmod/t21ok.ml b/testsuite/tests/typing-recmod/t21ok.ml
new file mode 100644
index 00000000..59cdcc9f
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t21ok.ml
@@ -0,0 +1,34 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module F ( X : Set.OrderedType ) = struct
+  module rec Mod : sig
+    module XSet :
+      sig
+        type elt = X.t
+        type t = Set.Make( X ).t
+      end
+    module XMap :
+      sig
+        type key = X.t
+        type 'a t = 'a Map.Make(X).t
+      end
+    type elt = X.t
+    type t = XSet.t XMap.t
+    val compare: t -> t -> int
+  end
+     =
+  struct
+    module XSet = Set.Make( X )
+    module XMap = Map.Make( X )
+
+    type elt = X.t
+    type t = XSet.t XMap.t
+    let compare = (fun x y -> 0)
+  end
+  and ModSet : Set.S with type elt = Mod.t = Set.Make( Mod )
+end
diff --git a/testsuite/tests/typing-recmod/t22ok.ml b/testsuite/tests/typing-recmod/t22ok.ml
new file mode 100644
index 00000000..16e9cbcf
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t22ok.ml
@@ -0,0 +1,518 @@
+(* TEST
+flags = " -w a "
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+(* Tests for recursive modules *)
+
+let test number result expected =
+  if result = expected
+  then Printf.printf "Test %d passed.\n" number
+  else Printf.printf "Test %d FAILED.\n" number;
+  flush stdout
+
+(* Tree of sets *)
+
+module rec A
+ : sig
+     type t = Leaf of int | Node of ASet.t
+     val compare: t -> t -> int
+   end
+ = struct
+     type t = Leaf of int | Node of ASet.t
+     let compare x y =
+       match (x,y) with
+         (Leaf i, Leaf j) -> Stdlib.compare i j
+       | (Leaf i, Node t) -> -1
+       | (Node s, Leaf j) -> 1
+       | (Node s, Node t) -> ASet.compare s t
+   end
+
+and ASet : Set.S with type elt = A.t = Set.Make(A)
+;;
+
+let _ =
+  let x = A.Node (ASet.add (A.Leaf 3) (ASet.singleton (A.Leaf 2))) in
+  let y = A.Node (ASet.add (A.Leaf 1) (ASet.singleton x)) in
+  test 10 (A.compare x x) 0;
+  test 11 (A.compare x (A.Leaf 3)) 1;
+  test 12 (A.compare (A.Leaf 0) x) (-1);
+  test 13 (A.compare y y) 0;
+  test 14 (A.compare x y) 1
+;;
+
+(* Simple value recursion *)
+
+module rec Fib
+  : sig val f : int -> int end
+  = struct let f x = if x < 2 then 1 else Fib.f(x-1) + Fib.f(x-2) end
+;;
+
+let _ =
+  test 20 (Fib.f 10) 89
+;;
+
+(* Update function by infix *)
+
+module rec Fib2
+  : sig val f : int -> int end
+  = struct let rec g x = Fib2.f(x-1) + Fib2.f(x-2)
+               and f x = if x < 2 then 1 else g x
+    end
+;;
+
+let _ =
+  test 21 (Fib2.f 10) 89
+;;
+
+(* Early application *)
+
+let _ =
+  let res =
+    try
+      let module A =
+        struct
+          module rec Bad
+            : sig val f : int -> int end
+            = struct let f = let y = Bad.f 5 in fun x -> x+y end
+          end in
+      false
+    with Undefined_recursive_module _ ->
+      true in
+  test 30 res true
+;;
+
+(* Early strict evaluation *)
+
+(*
+module rec Cyclic
+  : sig val x : int end
+  = struct let x = Cyclic.x + 1 end
+;;
+*)
+
+(* Reordering of evaluation based on dependencies *)
+
+module rec After
+  : sig val x : int end
+  = struct let x = Before.x + 1 end
+and Before
+  : sig val x : int end
+  = struct let x = 3 end
+;;
+
+let _ =
+  test 40 After.x 4
+;;
+
+(* Type identity between A.t and t within A's definition *)
+
+module rec Strengthen
+  : sig type t val f : t -> t end
+  = struct
+      type t = A | B
+      let _ = (A : Strengthen.t)
+      let f x = if true then A else Strengthen.f B
+    end
+;;
+
+module rec Strengthen2
+  : sig type t
+        val f : t -> t
+        module M : sig type u end
+        module R : sig type v end
+    end
+  = struct
+      type t = A | B
+      let _ = (A : Strengthen2.t)
+      let f x = if true then A else Strengthen2.f B
+      module M =
+        struct
+          type u = C
+          let _ = (C: Strengthen2.M.u)
+        end
+      module rec R : sig type v  = Strengthen2.R.v end =
+        struct
+          type v = D
+          let _ = (D : R.v)
+          let _ = (D : Strengthen2.R.v)
+        end
+    end
+;;
+
+(* Polymorphic recursion *)
+
+module rec PolyRec
+  : sig
+      type 'a t = Leaf of 'a | Node of 'a list t * 'a list t
+      val depth: 'a t -> int
+    end
+  = struct
+      type 'a t = Leaf of 'a | Node of 'a list t * 'a list t
+      let x = (PolyRec.Leaf 1 : int t)
+      let depth = function
+        Leaf x -> 0
+      | Node(l,r) -> 1 + max (PolyRec.depth l) (PolyRec.depth r)
+    end
+;;
+
+(* Wrong LHS signatures (PR#4336) *)
+
+(*
+module type ASig = sig type a val a:a val print:a -> unit end
+module type BSig = sig type b val b:b val print:b -> unit end
+
+module A = struct type a = int let a = 0 let print = print_int end
+module B = struct type b = float let b = 0.0 let print = print_float end
+
+module MakeA (Empty:sig end) : ASig = A
+module MakeB (Empty:sig end) : BSig = B
+
+module
+   rec NewA : ASig = MakeA (struct end)
+   and NewB : BSig with type b = NewA.a = MakeB (struct end);;
+
+*)
+
+(* Expressions and bindings *)
+
+module StringSet = Set.Make(String);;
+
+module rec Expr
+  : sig
+      type t =
+        Var of string
+      | Const of int
+      | Add of t * t
+      | Binding of Binding.t * t
+      val make_let: string -> t -> t -> t
+      val fv: t -> StringSet.t
+      val simpl: t -> t
+    end
+  = struct
+      type t =
+        Var of string
+      | Const of int
+      | Add of t * t
+      | Binding of Binding.t * t
+      let make_let id e1 e2 = Binding([id, e1], e2)
+      let rec fv = function
+        Var s -> StringSet.singleton s
+      | Const n -> StringSet.empty
+      | Add(t1,t2) -> StringSet.union (fv t1) (fv t2)
+      | Binding(b,t) ->
+          StringSet.union (Binding.fv b)
+            (StringSet.diff (fv t) (Binding.bv b))
+      let rec simpl = function
+        Var s -> Var s
+      | Const n -> Const n
+      | Add(Const i, Const j) -> Const (i+j)
+      | Add(Const 0, t) -> simpl t
+      | Add(t, Const 0) -> simpl t
+      | Add(t1,t2) -> Add(simpl t1, simpl t2)
+      | Binding(b, t) -> Binding(Binding.simpl b, simpl t)
+    end
+
+and Binding
+  : sig
+      type t = (string * Expr.t) list
+      val fv: t -> StringSet.t
+      val bv: t -> StringSet.t
+      val simpl: t -> t
+    end
+  = struct
+      type t = (string * Expr.t) list
+      let fv b =
+        List.fold_left (fun v (id,e) -> StringSet.union v (Expr.fv e))
+                       StringSet.empty b
+      let bv b =
+        List.fold_left (fun v (id,e) -> StringSet.add id v)
+                       StringSet.empty b
+      let simpl b =
+        List.map (fun (id,e) -> (id, Expr.simpl e)) b
+    end
+;;
+
+let _ =
+  let e = Expr.make_let "x" (Expr.Add (Expr.Var "y", Expr.Const 0))
+                            (Expr.Var "x") in
+  let e' = Expr.make_let "x" (Expr.Var "y") (Expr.Var "x") in
+  test 50 (StringSet.elements (Expr.fv e)) ["y"];
+  test 51 (Expr.simpl e) e'
+;;
+
+(* Okasaki's bootstrapping *)
+
+module type ORDERED =
+  sig
+    type t
+    val eq: t -> t -> bool
+    val lt: t -> t -> bool
+    val leq: t -> t -> bool
+  end
+
+module type HEAP =
+  sig
+    module Elem: ORDERED
+    type heap
+    val empty: heap
+    val isEmpty: heap -> bool
+    val insert: Elem.t -> heap -> heap
+    val merge: heap -> heap -> heap
+    val findMin: heap -> Elem.t
+    val deleteMin: heap -> heap
+  end
+
+module Bootstrap (MakeH: functor (Element:ORDERED) ->
+                                    HEAP with module Elem = Element)
+                 (Element: ORDERED) : HEAP with module Elem = Element =
+  struct
+    module Elem = Element
+    module rec BE
+    : sig type t = E | H of Elem.t * PrimH.heap
+          val eq: t -> t -> bool
+          val lt: t -> t -> bool
+          val leq: t -> t -> bool
+      end
+    = struct
+        type t = E | H of Elem.t * PrimH.heap
+        let leq t1 t2 =
+          match t1, t2 with
+          | (H(x, _)), (H(y, _)) -> Elem.leq x y
+          | H _, E -> false
+          | E, H _ -> true
+          | E, E -> true
+        let eq t1 t2 =
+          match t1, t2 with
+          | (H(x, _)), (H(y, _)) -> Elem.eq x y
+          | H _, E -> false
+          | E, H _ -> false
+          | E, E -> true
+        let lt t1 t2 =
+          match t1, t2 with
+          | (H(x, _)), (H(y, _)) -> Elem.lt x y
+          | H _, E -> false
+          | E, H _ -> true
+          | E, E -> false
+      end
+    and PrimH
+    : HEAP with type Elem.t = BE.t
+    = MakeH(BE)
+    type heap = BE.t
+    let empty = BE.E
+    let isEmpty = function BE.E -> true | _ -> false
+    let rec merge x y =
+      match (x,y) with
+        (BE.E, _) -> y
+      | (_, BE.E) -> x
+      | (BE.H(e1,p1) as h1), (BE.H(e2,p2) as h2) ->
+          if Elem.leq e1 e2
+          then BE.H(e1, PrimH.insert h2 p1)
+          else BE.H(e2, PrimH.insert h1 p2)
+    let insert x h =
+      merge (BE.H(x, PrimH.empty)) h
+    let findMin = function
+        BE.E -> raise Not_found
+      | BE.H(x, _) -> x
+    let deleteMin = function
+        BE.E -> raise Not_found
+      | BE.H(x, p) ->
+          if PrimH.isEmpty p then BE.E else begin
+            match PrimH.findMin p with
+            | (BE.H(y, p1)) ->
+              let p2 = PrimH.deleteMin p in
+              BE.H(y, PrimH.merge p1 p2)
+            | BE.E -> assert false
+          end
+  end
+;;
+
+module LeftistHeap(Element: ORDERED): HEAP with module Elem = Element =
+  struct
+    module Elem = Element
+    type heap = E | T of int * Elem.t * heap * heap
+    let rank = function E -> 0 | T(r,_,_,_) -> r
+    let make x a b =
+      if rank a >= rank b
+      then T(rank b + 1, x, a, b)
+      else T(rank a + 1, x, b, a)
+    let empty = E
+    let isEmpty = function E -> true | _ -> false
+    let rec merge h1 h2 =
+      match (h1, h2) with
+        (_, E) -> h1
+      | (E, _) -> h2
+      | (T(_, x1, a1, b1), T(_, x2, a2, b2)) ->
+          if Elem.leq x1 x2
+          then make x1 a1 (merge b1 h2)
+          else make x2 a2 (merge h1 b2)
+    let insert x h = merge (T(1, x, E, E)) h
+    let findMin = function
+      E -> raise Not_found
+    | T(_, x, _, _) -> x
+    let deleteMin = function
+      E -> raise Not_found
+    | T(_, x, a, b) -> merge a b
+  end
+;;
+
+module Ints =
+  struct
+    type t = int
+    let eq = (=)
+    let lt = (<)
+    let leq = (<=)
+  end
+;;
+
+module C = Bootstrap(LeftistHeap)(Ints);;
+
+let _ =
+  let h = List.fold_right C.insert [6;4;8;7;3;1] C.empty in
+  test 60 (C.findMin h) 1;
+  test 61 (C.findMin (C.deleteMin h)) 3;
+  test 62 (C.findMin (C.deleteMin (C.deleteMin h))) 4
+;;
+
+(* Classes *)
+
+module rec Class1
+  : sig
+      class c : object method m : int -> int end
+    end
+  = struct
+      class c =
+        object
+          method m x = if x <= 0 then x else (new Class2.d)#m x
+        end
+    end
+and Class2
+  : sig
+      class d : object method m : int -> int end
+    end
+  = struct
+      class d =
+        object(self)
+          inherit Class1.c as super
+          method m (x:int) = super#m 0
+        end
+    end
+;;
+
+let _ =
+  test 70 ((new Class1.c)#m 7) 0
+;;
+
+let _ =
+  try
+    let module A = struct
+       module rec BadClass1
+         : sig
+             class c : object method m : int end
+           end
+         = struct
+             class c = object method m = 123 end
+           end
+       and BadClass2
+         : sig
+             val x: int
+           end
+         = struct
+             let x = (new BadClass1.c)#m
+           end
+    end in
+      test 71 true false
+  with Undefined_recursive_module _ ->
+    test 71 true true
+;;
+
+(* Coercions *)
+
+module rec Coerce1
+  : sig
+      val g: int -> int
+      val f: int -> int
+    end
+  = struct
+      module A = (Coerce1: sig val f: int -> int end)
+      let g x = x
+      let f x = if x <= 0 then 1 else A.f (x-1) * x
+    end
+;;
+
+let _ =
+  test 80 (Coerce1.f 10) 3628800
+;;
+
+module CoerceF(S: sig end) = struct
+  let f1 () = 1
+  let f2 () = 2
+  let f3 () = 3
+  let f4 () = 4
+  let f5 () = 5
+end
+
+module rec Coerce2: sig val f1: unit -> int end = CoerceF(Coerce3)
+       and Coerce3: sig end = struct end
+;;
+
+let _ =
+  test 81 (Coerce2.f1 ()) 1
+;;
+
+module Coerce4(A : sig val f : int -> int end) = struct
+  let x = 0
+  let at a = A.f a
+end
+
+module rec Coerce5
+  : sig val blabla: int -> int val f: int -> int end
+  = struct let blabla x = 0 let f x = 5 end
+and Coerce6
+  : sig val at: int -> int end
+  = Coerce4(Coerce5)
+
+let _ =
+  test 82 (Coerce6.at 100) 5
+;;
+
+(* Miscellaneous bug reports *)
+
+module rec F
+  : sig type t = X of int | Y of int
+        val f: t -> bool
+    end
+  = struct
+      type t = X of int | Y of int
+      let f = function
+        | X _ -> false
+        | _ -> true
+    end;;
+
+let _ =
+  test 100 (F.f (F.X 1)) false;
+  test 101 (F.f (F.Y 2)) true
+
+(* PR#4316 *)
+module G(S : sig val x : int Lazy.t end) = struct include S end
+
+module M1 = struct let x = lazy 3 end
+
+let _ = Lazy.force M1.x
+
+module rec M2 : sig val x : int Lazy.t end = G(M1)
+
+let _ =
+  test 102 (Lazy.force M2.x) 3
+
+let _ = Gc.full_major()   (* will shortcut forwarding in M1.x *)
+
+module rec M3 : sig val x : int Lazy.t end = G(M1)
+
+let _ =
+  test 103 (Lazy.force M3.x) 3
+
+
+(** Pure type-checking tests: see recmod/*.ml  *)
diff --git a/testsuite/tests/typing-recmod/t22ok.mli b/testsuite/tests/typing-recmod/t22ok.mli
new file mode 100644
index 00000000..6c1fad36
--- /dev/null
+++ b/testsuite/tests/typing-recmod/t22ok.mli
@@ -0,0 +1,134 @@
+module rec A :
+  sig type t = Leaf of int | Node of ASet.t val compare : t -> t -> int end
+and ASet : Set.S with type elt = A.t
+module Fib : sig val f : int -> int end
+module After : sig val x : int end
+module Before : sig val x : int end
+module Strengthen : sig type t val f : t -> t end
+module Strengthen2 :
+  sig
+    type t
+    val f : t -> t
+    module M : sig type u end
+    module R : sig type v end
+  end
+module PolyRec :
+  sig
+    type 'a t = Leaf of 'a | Node of 'a list t * 'a list t
+    val depth : 'a t -> int
+  end
+module StringSet : Set.S with type elt = string
+module rec Expr :
+  sig
+    type t =
+        Var of string
+      | Const of int
+      | Add of t * t
+      | Binding of Binding.t * t
+    val make_let : string -> t -> t -> t
+    val fv : t -> StringSet.t
+    val simpl : t -> t
+  end
+and Binding :
+  sig
+    type t = (string * Expr.t) list
+    val fv : t -> StringSet.t
+    val bv : t -> StringSet.t
+    val simpl : t -> t
+  end
+module type ORDERED =
+  sig
+    type t
+    val eq : t -> t -> bool
+    val lt : t -> t -> bool
+    val leq : t -> t -> bool
+  end
+module type HEAP =
+  sig
+    module Elem : ORDERED
+    type heap
+    val empty : heap
+    val isEmpty : heap -> bool
+    val insert : Elem.t -> heap -> heap
+    val merge : heap -> heap -> heap
+    val findMin : heap -> Elem.t
+    val deleteMin : heap -> heap
+  end
+module Bootstrap :
+  functor
+    (MakeH : functor (Element : ORDERED) ->
+               sig
+                 module Elem :
+                   sig
+                     type t = Element.t
+                     val eq : t -> t -> bool
+                     val lt : t -> t -> bool
+                     val leq : t -> t -> bool
+                   end
+                 type heap
+                 val empty : heap
+                 val isEmpty : heap -> bool
+                 val insert : Elem.t -> heap -> heap
+                 val merge : heap -> heap -> heap
+                 val findMin : heap -> Elem.t
+                 val deleteMin : heap -> heap
+               end) ->
+    functor (Element : ORDERED) ->
+      sig
+        module Elem :
+          sig
+            type t = Element.t
+            val eq : t -> t -> bool
+            val lt : t -> t -> bool
+            val leq : t -> t -> bool
+          end
+        type heap
+        val empty : heap
+        val isEmpty : heap -> bool
+        val insert : Elem.t -> heap -> heap
+        val merge : heap -> heap -> heap
+        val findMin : heap -> Elem.t
+        val deleteMin : heap -> heap
+      end
+module LeftistHeap :
+  functor (Element : ORDERED) ->
+    sig
+      module Elem :
+        sig
+          type t = Element.t
+          val eq : t -> t -> bool
+          val lt : t -> t -> bool
+          val leq : t -> t -> bool
+        end
+      type heap
+      val empty : heap
+      val isEmpty : heap -> bool
+      val insert : Elem.t -> heap -> heap
+      val merge : heap -> heap -> heap
+      val findMin : heap -> Elem.t
+      val deleteMin : heap -> heap
+    end
+module Ints :
+  sig
+    type t = int
+    val eq : 'a -> 'a -> bool
+    val lt : 'a -> 'a -> bool
+    val leq : 'a -> 'a -> bool
+  end
+module C :
+  sig
+    module Elem :
+      sig
+        type t = Ints.t
+        val eq : t -> t -> bool
+        val lt : t -> t -> bool
+        val leq : t -> t -> bool
+      end
+    type heap = Bootstrap(LeftistHeap)(Ints).heap
+    val empty : heap
+    val isEmpty : heap -> bool
+    val insert : Elem.t -> heap -> heap
+    val merge : heap -> heap -> heap
+    val findMin : heap -> Elem.t
+    val deleteMin : heap -> heap
+  end
diff --git a/testsuite/tests/typing-recordarg/recordarg.ml b/testsuite/tests/typing-recordarg/recordarg.ml
new file mode 100644
index 00000000..5477de1e
--- /dev/null
+++ b/testsuite/tests/typing-recordarg/recordarg.ml
@@ -0,0 +1,96 @@
+(* TEST
+   * toplevel
+*)
+
+type t = A of {x:int; mutable y:int};;
+let f (A r) = r;;  (* -> escape *)
+let f (A r) = r.x;; (* ok *)
+let f x = A {x; y = x};; (* ok *)
+let f (A r) = A {r with y = r.x + 1};; (* ok *)
+let f () = A {a = 1};; (* customized error message *)
+let f () = A {x = 1; y = 3};; (* ok *)
+
+type _ t = A: {x : 'a; y : 'b} -> 'a t;;
+let f (A {x; y}) = A {x; y = ()};;  (* ok *)
+let f (A ({x; y} as r)) = A {x = r.x; y = r.y};; (* ok *)
+
+module M = struct
+  type 'a t =
+    | A of {x : 'a}
+    | B: {u : 'b} -> unit t;;
+
+  exception Foo of {x : int};;
+end;;
+
+module N : sig
+  type 'b t = 'b M.t =
+    | A of {x : 'b}
+    | B: {u : 'bla} -> unit t
+
+  exception Foo of {x : int}
+end = struct
+  type 'b t = 'b M.t =
+    | A of {x : 'b}
+    | B: {u : 'z} -> unit t
+
+  exception Foo = M.Foo
+end;;
+
+
+module type S = sig exception A of {x:int}  end;;
+
+module F (X : sig val x : (module S) end) = struct
+  module A = (val X.x)
+end;;  (* -> this expression creates fresh types (not really!) *)
+
+
+module type S = sig
+  exception A of {x : int}
+  exception A of {x : string}
+end;;
+
+module M = struct
+  exception A of {x : int}
+  exception A of {x : string}
+end;;
+
+
+module M1 = struct
+  exception A of {x : int}
+end;;
+
+module M = struct
+  include M1
+  include M1
+end;;
+
+
+module type S1 = sig
+  exception A of {x : int}
+end;;
+
+module type S = sig
+  include S1
+  include S1
+end;;
+
+module M = struct
+  exception A = M1.A
+end;;
+
+module X1 = struct
+  type t = ..
+end;;
+module X2 = struct
+  type t = ..
+end;;
+module Z = struct
+  type X1.t += A of {x: int}
+  type X2.t += A of {x: int}
+end;;
+
+(* PR#6716 *)
+
+type _ c = C : [`A] c
+type t = T : {x:[<`A] c} -> t;;
+let f (T { x = C }) = ();;
diff --git a/testsuite/tests/typing-recordarg/recordarg.ocaml.reference b/testsuite/tests/typing-recordarg/recordarg.ocaml.reference
new file mode 100644
index 00000000..c6a5fb53
--- /dev/null
+++ b/testsuite/tests/typing-recordarg/recordarg.ocaml.reference
@@ -0,0 +1,58 @@
+type t = A of { x : int; mutable y : int; }
+Line 1, characters 14-15:
+1 | let f (A r) = r;;  (* -> escape *)
+                  ^
+Error: This form is not allowed as the type of the inlined record could escape.
+val f : t -> int = 
+val f : int -> t = 
+val f : t -> t = 
+Line 1, characters 14-15:
+1 | let f () = A {a = 1};; (* customized error message *)
+                  ^
+Error: The field a is not part of the record argument for the t.A constructor
+val f : unit -> t = 
+type _ t = A : { x : 'a; y : 'b; } -> 'a t
+val f : 'a t -> 'a t = 
+val f : 'a t -> 'a t = 
+module M :
+  sig
+    type 'a t = A of { x : 'a; } | B : { u : 'b; } -> unit t
+    exception Foo of { x : int; }
+  end
+module N :
+  sig
+    type 'b t = 'b M.t = A of { x : 'b; } | B : { u : 'bla; } -> unit t
+    exception Foo of { x : int; }
+  end
+module type S = sig exception A of { x : int; } end
+Line 3, characters 13-22:
+3 |   module A = (val X.x)
+                 ^^^^^^^^^
+Error: This expression creates fresh types.
+       It is not allowed inside applicative functors.
+Line 5, characters 2-29:
+5 |   exception A of {x : string}
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Multiple definition of the extension constructor name A.
+       Names must be unique in a given structure or signature.
+Line 4, characters 2-29:
+4 |   exception A of {x : string}
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Multiple definition of the extension constructor name A.
+       Names must be unique in a given structure or signature.
+module M1 : sig exception A of { x : int; } end
+module M : sig exception A of { x : int; } end
+module type S1 = sig exception A of { x : int; } end
+module type S = sig exception A of { x : int; } end
+module M : sig exception A of { x : int; } end
+module X1 : sig type t = .. end
+module X2 : sig type t = .. end
+Line 3, characters 15-28:
+3 |   type X2.t += A of {x: int}
+                   ^^^^^^^^^^^^^
+Error: Multiple definition of the extension constructor name A.
+       Names must be unique in a given structure or signature.
+type _ c = C : [ `A ] c
+type t = T : { x : [< `A ] c; } -> t
+val f : t -> unit = 
+
diff --git a/testsuite/tests/typing-rectypes-bugs/pr5343_bad.compilers.reference b/testsuite/tests/typing-rectypes-bugs/pr5343_bad.compilers.reference
new file mode 100644
index 00000000..9fc704a3
--- /dev/null
+++ b/testsuite/tests/typing-rectypes-bugs/pr5343_bad.compilers.reference
@@ -0,0 +1,4 @@
+File "pr5343_bad.ml", line 11, characters 2-14:
+11 |   type u = u t and v = v t
+       ^^^^^^^^^^^^
+Error: The type abbreviation u is cyclic
diff --git a/testsuite/tests/typing-rectypes-bugs/pr5343_bad.ml b/testsuite/tests/typing-rectypes-bugs/pr5343_bad.ml
new file mode 100644
index 00000000..588c9479
--- /dev/null
+++ b/testsuite/tests/typing-rectypes-bugs/pr5343_bad.ml
@@ -0,0 +1,21 @@
+(* TEST
+flags = " -w a -rectypes "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module M : sig
+  type 'a t
+  type u = u t and v = v t
+  val f : int -> u
+  val g : v -> bool
+end = struct
+  type 'a t = 'a
+  type u = int and v = bool
+  let f x = x
+  let g x = x
+end;;
+
+let h (x : int) : bool = M.g (M.f x);;
diff --git a/testsuite/tests/typing-rectypes-bugs/pr6174_bad.compilers.reference b/testsuite/tests/typing-rectypes-bugs/pr6174_bad.compilers.reference
new file mode 100644
index 00000000..8559e40c
--- /dev/null
+++ b/testsuite/tests/typing-rectypes-bugs/pr6174_bad.compilers.reference
@@ -0,0 +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
+         $1 = ($2 -> $1) -> $1
diff --git a/testsuite/tests/typing-rectypes-bugs/pr6174_bad.ml b/testsuite/tests/typing-rectypes-bugs/pr6174_bad.ml
new file mode 100644
index 00000000..1c95a47d
--- /dev/null
+++ b/testsuite/tests/typing-rectypes-bugs/pr6174_bad.ml
@@ -0,0 +1,11 @@
+(* TEST
+flags = " -w a -rectypes "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t
+let f : type a o. ((a -> o) -> o) t -> (a -> o) -> o =
+ fun C k -> k (fun x -> x);;
diff --git a/testsuite/tests/typing-rectypes-bugs/pr6870_bad.compilers.reference b/testsuite/tests/typing-rectypes-bugs/pr6870_bad.compilers.reference
new file mode 100644
index 00000000..80fc303e
--- /dev/null
+++ b/testsuite/tests/typing-rectypes-bugs/pr6870_bad.compilers.reference
@@ -0,0 +1,6 @@
+File "pr6870_bad.ml", line 10, characters 38-50:
+10 | module Fix (T : T) = struct type r = ('r T.t as 'r) end
+                                           ^^^^^^^^^^^^
+Error: This alias is bound to type 'a T.t but is used as an instance of type
+         'a
+       The type variable 'a occurs inside 'a T.t
diff --git a/testsuite/tests/typing-rectypes-bugs/pr6870_bad.ml b/testsuite/tests/typing-rectypes-bugs/pr6870_bad.ml
new file mode 100644
index 00000000..4c771b87
--- /dev/null
+++ b/testsuite/tests/typing-rectypes-bugs/pr6870_bad.ml
@@ -0,0 +1,10 @@
+(* TEST
+flags = " -w a -rectypes "
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+
+module type T = sig type 'a t end
+module Fix (T : T) = struct type r = ('r T.t as 'r) end
diff --git a/testsuite/tests/typing-safe-linking/a.ml b/testsuite/tests/typing-safe-linking/a.ml
new file mode 100644
index 00000000..5556e495
--- /dev/null
+++ b/testsuite/tests/typing-safe-linking/a.ml
@@ -0,0 +1,3 @@
+ type _ t =
+     X of string
+   | Y : bytes t
diff --git a/testsuite/tests/typing-safe-linking/b_bad.compilers.reference b/testsuite/tests/typing-safe-linking/b_bad.compilers.reference
new file mode 100644
index 00000000..4f9cd7e5
--- /dev/null
+++ b/testsuite/tests/typing-safe-linking/b_bad.compilers.reference
@@ -0,0 +1,10 @@
+File "b_bad.ml", lines 13-14, characters 29-28:
+13 | .............................function
+14 |     A.X s -> print_endline s
+Error (warning 8): this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Y
+File "b_bad.ml", line 18, characters 11-14:
+18 | let () = f A.y
+                ^^^
+Error: Unbound value A.y
diff --git a/testsuite/tests/typing-safe-linking/b_bad.ml b/testsuite/tests/typing-safe-linking/b_bad.ml
new file mode 100644
index 00000000..4dc6e6b4
--- /dev/null
+++ b/testsuite/tests/typing-safe-linking/b_bad.ml
@@ -0,0 +1,18 @@
+(* TEST
+files = "a.ml"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+module = "a.ml"
+*** ocamlc.byte
+module = "b_bad.ml"
+flags = "-safe-string -warn-error +8"
+ocamlc_byte_exit_status = "2"
+**** check-ocamlc.byte-output
+*)
+
+let f : string A.t -> unit = function
+    A.X s -> print_endline s
+
+(* It is important that the line below is the last line of the file
+   (see Makefile) *)
+let () = f A.y
diff --git a/testsuite/tests/typing-shadowing-of-pervasives-submodules/largeFile.ml b/testsuite/tests/typing-shadowing-of-pervasives-submodules/largeFile.ml
new file mode 100644
index 00000000..e9066706
--- /dev/null
+++ b/testsuite/tests/typing-shadowing-of-pervasives-submodules/largeFile.ml
@@ -0,0 +1 @@
+let message = "Hello, world!"
diff --git a/testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile.ml b/testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile.ml
new file mode 100644
index 00000000..5d4ac627
--- /dev/null
+++ b/testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile.ml
@@ -0,0 +1,4 @@
+(* TEST
+   modules = "largeFile.ml"
+*)
+print_string LargeFile.message
diff --git a/testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile.reference b/testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile.reference
new file mode 100644
index 00000000..af5626b4
--- /dev/null
+++ b/testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile.reference
@@ -0,0 +1 @@
+Hello, world!
diff --git a/testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile_top.compilers.reference b/testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile_top.compilers.reference
new file mode 100644
index 00000000..cd257cfd
--- /dev/null
+++ b/testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile_top.compilers.reference
@@ -0,0 +1,2 @@
+Hello, world!- : unit = ()
+
diff --git a/testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile_top.ml b/testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile_top.ml
new file mode 100644
index 00000000..2b4ee473
--- /dev/null
+++ b/testsuite/tests/typing-shadowing-of-pervasives-submodules/redefine_largefile_top.ml
@@ -0,0 +1,16 @@
+(* TEST
+   files = "largeFile.ml"
+   * setup-ocaml-build-env
+   ** ocamlc.byte
+   compile_only = "true"
+   all_modules = "largeFile.ml"
+   *** script
+   script = "mkdir -p inc"
+   **** script
+   script = "mv largeFile.cmi largeFile.cmo inc/"
+   ***** ocaml
+   ****** check-ocaml-output
+*)
+#directory "inc";;
+#load "largeFile.cmo";;
+print_string LargeFile.message;;
diff --git a/testsuite/tests/typing-short-paths/errors.ml b/testsuite/tests/typing-short-paths/errors.ml
new file mode 100644
index 00000000..2f08791d
--- /dev/null
+++ b/testsuite/tests/typing-short-paths/errors.ml
@@ -0,0 +1,36 @@
+(* TEST
+   flags = " -short-paths "
+   * expect
+*)
+
+module M = struct type t = T end
+
+type t = M.t
+
+let x : M.t = S
+[%%expect {|
+module M : sig type t = T end
+type t = M.t
+Line 5, characters 14-15:
+5 | let x : M.t = S
+                  ^
+Error: This variant expression is expected to have type t
+       The constructor S does not belong to type t
+|}]
+
+module M = struct
+  class c = object method foo = 3 end
+end
+
+type c = M.c
+
+let () = (new M.c)#bar
+[%%expect {|
+module M : sig class c : object method foo : int end end
+type c = M.c
+Line 7, characters 9-18:
+7 | let () = (new M.c)#bar
+             ^^^^^^^^^
+Error: This expression has type c
+       It has no method bar
+|}]
diff --git a/testsuite/tests/typing-short-paths/gpr1223.compilers.reference b/testsuite/tests/typing-short-paths/gpr1223.compilers.reference
new file mode 100644
index 00000000..bd28b952
--- /dev/null
+++ b/testsuite/tests/typing-short-paths/gpr1223.compilers.reference
@@ -0,0 +1,3 @@
+val y : Gpr1223_bar.N.O.t = Gpr1223_bar.N.O.T
+val x : Gpr1223_bar.M.t = Gpr1223_bar.M.T
+
diff --git a/testsuite/tests/typing-short-paths/gpr1223.ml b/testsuite/tests/typing-short-paths/gpr1223.ml
new file mode 100644
index 00000000..9e66dfb9
--- /dev/null
+++ b/testsuite/tests/typing-short-paths/gpr1223.ml
@@ -0,0 +1,9 @@
+(* TEST
+   flags = " -short-paths "
+   modules = "gpr1223_foo.mli gpr1223_bar.mli"
+   * toplevel
+*)
+
+let y = Gpr1223_bar.N.O.T;;
+
+let x = Gpr1223_bar.M.T;;
diff --git a/testsuite/tests/typing-short-paths/gpr1223_bar.mli b/testsuite/tests/typing-short-paths/gpr1223_bar.mli
new file mode 100644
index 00000000..f3f51e09
--- /dev/null
+++ b/testsuite/tests/typing-short-paths/gpr1223_bar.mli
@@ -0,0 +1,12 @@
+
+module M : Gpr1223_foo.S
+
+module N : sig
+
+  module O : sig
+
+    type t = T
+
+  end
+
+end
diff --git a/testsuite/tests/typing-short-paths/gpr1223_foo.mli b/testsuite/tests/typing-short-paths/gpr1223_foo.mli
new file mode 100644
index 00000000..b46079d7
--- /dev/null
+++ b/testsuite/tests/typing-short-paths/gpr1223_foo.mli
@@ -0,0 +1,6 @@
+
+module type S = sig
+
+  type t = T
+
+end
diff --git a/testsuite/tests/typing-short-paths/pr5918.compilers.reference b/testsuite/tests/typing-short-paths/pr5918.compilers.reference
new file mode 100644
index 00000000..268cb427
--- /dev/null
+++ b/testsuite/tests/typing-short-paths/pr5918.compilers.reference
@@ -0,0 +1,5 @@
+Line 10, characters 9-19:
+10 |  let _ = { a = () }
+              ^^^^^^^^^^
+Error: Some record fields are undefined: b
+
diff --git a/testsuite/tests/typing-short-paths/pr5918.ml b/testsuite/tests/typing-short-paths/pr5918.ml
new file mode 100644
index 00000000..191ee1fd
--- /dev/null
+++ b/testsuite/tests/typing-short-paths/pr5918.ml
@@ -0,0 +1,12 @@
+(* TEST
+   flags = " -short-paths "
+   * toplevel
+*)
+
+module rec A : sig
+ type t
+end = struct
+ type t = { a : unit; b : unit }
+ let _ = { a = () }
+end
+;;
diff --git a/testsuite/tests/typing-short-paths/pr6836.compilers.reference b/testsuite/tests/typing-short-paths/pr6836.compilers.reference
new file mode 100644
index 00000000..54fccac1
--- /dev/null
+++ b/testsuite/tests/typing-short-paths/pr6836.compilers.reference
@@ -0,0 +1,6 @@
+type t = [ `A | `B ]
+type 'a u = t
+val a : [< t > `A ] = `A
+type 'a s = 'a
+val b : [< t > `B ] = `B
+
diff --git a/testsuite/tests/typing-short-paths/pr6836.ml b/testsuite/tests/typing-short-paths/pr6836.ml
new file mode 100644
index 00000000..ade6635b
--- /dev/null
+++ b/testsuite/tests/typing-short-paths/pr6836.ml
@@ -0,0 +1,11 @@
+(* TEST
+   flags = " -short-paths "
+   * toplevel
+*)
+
+type t = [`A | `B];;
+type 'a u = t;;
+let a : [< int u] = `A;;
+
+type 'a s = 'a;;
+let b : [< t s] = `B;;
diff --git a/testsuite/tests/typing-short-paths/pr7543.compilers.reference b/testsuite/tests/typing-short-paths/pr7543.compilers.reference
new file mode 100644
index 00000000..67c42e5c
--- /dev/null
+++ b/testsuite/tests/typing-short-paths/pr7543.compilers.reference
@@ -0,0 +1,14 @@
+module type S = sig type t end
+module N : sig type 'a t = 'a end
+val f : (module S with type t = unit) -> unit = 
+Line 1, characters 19-20:
+1 | let () = f (module N);;
+                       ^
+Error: Signature mismatch:
+       Modules do not match: sig type 'a t = 'a end is not included in S
+       Type declarations do not match:
+         type 'a t = 'a
+       is not included in
+         type t
+       They have different arities.
+
diff --git a/testsuite/tests/typing-short-paths/pr7543.ml b/testsuite/tests/typing-short-paths/pr7543.ml
new file mode 100644
index 00000000..abe5d530
--- /dev/null
+++ b/testsuite/tests/typing-short-paths/pr7543.ml
@@ -0,0 +1,14 @@
+(* TEST
+   flags = " -short-paths "
+   * toplevel
+*)
+
+(** Test that short-path printtyp does not fail on packed module.
+
+  Packed modules does not respect the arity of type constructor, which can break
+  the path normalization within the short-path code path.
+*)
+module type S = sig type t end;;
+module N = struct type 'a t = 'a end;;
+let f (module M:S with type t = unit) = ();;
+let () = f (module N);;
diff --git a/testsuite/tests/typing-short-paths/short-paths.compilers.reference b/testsuite/tests/typing-short-paths/short-paths.compilers.reference
new file mode 100644
index 00000000..1619e340
--- /dev/null
+++ b/testsuite/tests/typing-short-paths/short-paths.compilers.reference
@@ -0,0 +1,100 @@
+module Core :
+  sig
+    module Int :
+      sig
+        module T :
+          sig
+            type t = int
+            val compare : 'a -> 'a -> t
+            val ( + ) : t -> t -> t
+          end
+        type t = int
+        val compare : 'a -> 'a -> t
+        val ( + ) : t -> t -> t
+        module Map :
+          sig
+            type key = t
+            type 'a t = 'a Map.Make(T).t
+            val empty : 'a t
+            val is_empty : 'a t -> bool
+            val mem : key -> 'a t -> bool
+            val add : key -> 'a -> 'a t -> 'a t
+            val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
+            val singleton : key -> 'a -> 'a t
+            val remove : key -> 'a t -> 'a t
+            val merge :
+              (key -> 'a option -> 'b option -> 'c option) ->
+              'a t -> 'b t -> 'c t
+            val union :
+              (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+            val compare : ('a -> 'a -> key) -> 'a t -> 'a t -> key
+            val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+            val iter : (key -> 'a -> unit) -> 'a t -> unit
+            val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+            val for_all : (key -> 'a -> bool) -> 'a t -> bool
+            val exists : (key -> 'a -> bool) -> 'a t -> bool
+            val filter : (key -> 'a -> bool) -> 'a t -> 'a t
+            val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
+            val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+            val cardinal : 'a t -> key
+            val bindings : 'a t -> (key * 'a) list
+            val min_binding : 'a t -> key * 'a
+            val min_binding_opt : 'a t -> (key * 'a) option
+            val max_binding : 'a t -> key * 'a
+            val max_binding_opt : 'a t -> (key * 'a) option
+            val choose : 'a t -> key * 'a
+            val choose_opt : 'a t -> (key * 'a) option
+            val split : key -> 'a t -> 'a t * 'a option * 'a t
+            val find : key -> 'a t -> 'a
+            val find_opt : key -> 'a t -> 'a option
+            val find_first : (key -> bool) -> 'a t -> key * 'a
+            val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
+            val find_last : (key -> bool) -> 'a t -> key * 'a
+            val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
+            val map : ('a -> 'b) -> 'a t -> 'b t
+            val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
+            val to_seq : 'a t -> (key * 'a) Seq.t
+            val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
+            val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
+            val of_seq : (key * 'a) Seq.t -> 'a t
+          end
+      end
+    module Std : sig module Int = Int end
+  end
+val x : 'a Int.Map.t = 
+Line 1, characters 8-9:
+1 | let y = x + x ;;
+            ^
+Error: This expression 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
+- : M.t = A
+- : N.t = B
+- : u = C
+type t = M.t = A
+type u = M.u = C
+- : u = C
+module L : sig type v = V end
+- : v = V
+module L : sig type v = V end
+- : v = V
+type t1 = A
+module M1 : sig type u = v and v = t1 end
+module N1 : sig type u = v and v = t1 end
+type t1 = B
+module N2 : sig type u = v and v = N1.v end
+module type PR6566 = sig type t = string end
+module PR6566 : sig type t = int end
+Line 1, characters 26-32:
+1 | module PR6566' : PR6566 = PR6566;;
+                              ^^^^^^
+Error: Signature mismatch:
+       Modules do not match: sig type t = int end is not included in PR6566
+       Type declarations do not match:
+         type t = int
+       is not included in
+         type t = string
+module A : sig module B : sig type t = T end end
+module M2 : sig type u = A.B.t type foo = int type v = u end
+
diff --git a/testsuite/tests/typing-short-paths/short-paths.ml b/testsuite/tests/typing-short-paths/short-paths.ml
new file mode 100644
index 00000000..b55e4133
--- /dev/null
+++ b/testsuite/tests/typing-short-paths/short-paths.ml
@@ -0,0 +1,62 @@
+(* TEST
+   flags = " -short-paths "
+   * toplevel
+*)
+
+module Core = struct
+  module Int = struct
+    module T = struct
+      type t = int
+      let compare = compare
+      let (+) x y = x + y
+    end
+    include T
+    module Map = Map.Make(T)
+  end
+
+  module Std = struct
+    module Int = Int
+  end
+end
+;;
+
+open Core.Std
+;;
+
+let x = Int.Map.empty ;;
+let y = x + x ;;
+
+(* Avoid ambiguity *)
+
+module M = struct type t = A type u = C end
+module N = struct type t = B end
+open M open N;;
+A;;
+B;;
+C;;
+
+include M open M;;
+C;;
+
+module L = struct type v = V end
+open L;;
+V;;
+module L = struct type v = V end
+open L;;
+V;;
+
+
+type t1 = A;;
+module M1 = struct type u = v and v = t1 end;;
+module N1 = struct type u = v and v = M1.v end;;
+type t1 = B;;
+module N2 = struct type u = v and v = M1.v end;;
+
+
+(* PR#6566 *)
+module type PR6566 = sig type t = string end;;
+module PR6566 = struct type t = int end;;
+module PR6566' : PR6566 = PR6566;;
+
+module A = struct module B = struct type t = T end end;;
+module M2 = struct type u = A.B.t type foo = int type v = A.B.t end;;
diff --git a/testsuite/tests/typing-signatures/els.ml b/testsuite/tests/typing-signatures/els.ml
new file mode 100644
index 00000000..a438c735
--- /dev/null
+++ b/testsuite/tests/typing-signatures/els.ml
@@ -0,0 +1,99 @@
+(* TEST
+   * toplevel
+*)
+
+(* Adapted from: An Expressive Language of Signatures
+   by Norman Ramsey, Kathleen Fisher and Paul Govereau *)
+
+module type VALUE = sig
+  type value (* a Lua value *)
+  type state (* the state of a Lua interpreter *)
+  type usert (* a user-defined value *)
+end;;
+
+module type CORE0 = sig
+  module V : VALUE
+  val setglobal : V.state -> string -> V.value -> unit
+  (* five more functions common to core and evaluator *)
+end;;
+
+module type CORE = sig
+  include CORE0
+  val apply : V.value -> V.state -> V.value list -> V.value
+  (* apply function f in state s to list of args *)
+end;;
+
+module type AST = sig
+  module Value : VALUE
+  type chunk
+  type program
+  val get_value : chunk -> Value.value
+end;;
+
+module type EVALUATOR = sig
+  module Value : VALUE
+  module Ast : (AST with module Value := Value)
+  type state = Value.state
+  type value = Value.value
+  exception Error of string
+  val compile : Ast.program -> string
+  include CORE0 with module V := Value
+end;;
+
+module type PARSER = sig
+  type chunk
+  val parse : string -> chunk
+end;;
+
+module type INTERP = sig
+  include EVALUATOR
+  module Parser : PARSER with type chunk = Ast.chunk
+  val dostring : state -> string -> value list
+  val mk : unit -> state
+end;;
+
+module type USERTYPE = sig
+  type t
+  val eq : t -> t -> bool
+  val to_string : t -> string
+end;;
+
+module type TYPEVIEW = sig
+  type combined
+  type t
+  val map : (combined -> t) * (t -> combined)
+end;;
+
+module type COMBINED_COMMON = sig
+  module T : sig type t end
+  module TV1 : TYPEVIEW with type combined := T.t
+  module TV2 : TYPEVIEW with type combined := T.t
+end;;
+
+module type COMBINED_TYPE = sig
+  module T : USERTYPE
+  include COMBINED_COMMON with module T := T
+end;;
+
+module type BARECODE = sig
+  type state
+  val init : state -> unit
+end;;
+
+module USERCODE(X : TYPEVIEW) = struct
+  module type F =
+      functor (C : CORE with type V.usert = X.combined) ->
+        BARECODE with type state := C.V.state
+end;;
+
+module Weapon = struct type t end;;
+
+module type WEAPON_LIB = sig
+  type t = Weapon.t
+  module T : USERTYPE with type t = t
+  module Make :
+    functor (TV : TYPEVIEW with type t = t) -> USERCODE(TV).F
+end;;
+
+module type X = functor (X: CORE) -> BARECODE;;
+module type X = functor (_: CORE) -> BARECODE;;
diff --git a/testsuite/tests/typing-signatures/els.ocaml.reference b/testsuite/tests/typing-signatures/els.ocaml.reference
new file mode 100644
index 00000000..678b88e7
--- /dev/null
+++ b/testsuite/tests/typing-signatures/els.ocaml.reference
@@ -0,0 +1,94 @@
+module type VALUE = sig type value type state type usert end
+module type CORE0 =
+  sig
+    module V : VALUE
+    val setglobal : V.state -> string -> V.value -> unit
+  end
+module type CORE =
+  sig
+    module V : VALUE
+    val setglobal : V.state -> string -> V.value -> unit
+    val apply : V.value -> V.state -> V.value list -> V.value
+  end
+module type AST =
+  sig
+    module Value : VALUE
+    type chunk
+    type program
+    val get_value : chunk -> Value.value
+  end
+module type EVALUATOR =
+  sig
+    module Value : VALUE
+    module Ast :
+      sig type chunk type program val get_value : chunk -> Value.value end
+    type state = Value.state
+    type value = Value.value
+    exception Error of string
+    val compile : Ast.program -> string
+    val setglobal : Value.state -> string -> Value.value -> unit
+  end
+module type PARSER = sig type chunk val parse : string -> chunk end
+module type INTERP =
+  sig
+    module Value : VALUE
+    module Ast :
+      sig type chunk type program val get_value : chunk -> Value.value end
+    type state = Value.state
+    type value = Value.value
+    exception Error of string
+    val compile : Ast.program -> string
+    val setglobal : Value.state -> string -> Value.value -> unit
+    module Parser :
+      sig type chunk = Ast.chunk val parse : string -> chunk end
+    val dostring : state -> string -> value list
+    val mk : unit -> state
+  end
+module type USERTYPE =
+  sig type t val eq : t -> t -> bool val to_string : t -> string end
+module type TYPEVIEW =
+  sig type combined type t val map : (combined -> t) * (t -> combined) end
+module type COMBINED_COMMON =
+  sig
+    module T : sig type t end
+    module TV1 : sig type t val map : (T.t -> t) * (t -> T.t) end
+    module TV2 : sig type t val map : (T.t -> t) * (t -> T.t) end
+  end
+module type COMBINED_TYPE =
+  sig
+    module T : USERTYPE
+    module TV1 : sig type t val map : (T.t -> t) * (t -> T.t) end
+    module TV2 : sig type t val map : (T.t -> t) * (t -> T.t) end
+  end
+module type BARECODE = sig type state val init : state -> unit end
+module USERCODE :
+  functor (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)
+          -> sig val init : C.V.state -> unit end
+    end
+module Weapon : sig type t end
+module type WEAPON_LIB =
+  sig
+    type t = Weapon.t
+    module T :
+      sig type t = t val eq : t -> t -> bool val to_string : t -> string end
+    module Make :
+      functor
+        (TV : sig
+                type combined
+                type t = t
+                val map : (combined -> t) * (t -> combined)
+              end)
+        -> USERCODE(TV).F
+  end
+module type X = functor (X : CORE) -> BARECODE
+module type X = CORE -> BARECODE
+
diff --git a/testsuite/tests/typing-signatures/pr6371.ml b/testsuite/tests/typing-signatures/pr6371.ml
new file mode 100644
index 00000000..c5516c3f
--- /dev/null
+++ b/testsuite/tests/typing-signatures/pr6371.ml
@@ -0,0 +1,11 @@
+(* TEST
+   * toplevel
+*)
+
+module M = struct
+  type t = int * (< m : 'a > as 'a)
+end;;
+
+module type S =
+    sig module M : sig type t end end with module M = M
+;;
diff --git a/testsuite/tests/typing-signatures/pr6371.ocaml.reference b/testsuite/tests/typing-signatures/pr6371.ocaml.reference
new file mode 100644
index 00000000..bd100af0
--- /dev/null
+++ b/testsuite/tests/typing-signatures/pr6371.ocaml.reference
@@ -0,0 +1,3 @@
+module M : sig type t = int * (< m : 'a > as 'a) end
+module type S = sig module M : sig type t = int * (< m : 'a > as 'a) end end
+
diff --git a/testsuite/tests/typing-signatures/pr6672.ml b/testsuite/tests/typing-signatures/pr6672.ml
new file mode 100644
index 00000000..66852161
--- /dev/null
+++ b/testsuite/tests/typing-signatures/pr6672.ml
@@ -0,0 +1,7 @@
+(* TEST
+   * toplevel
+*)
+
+module type S = sig type 'a t end;;
+module type T = S with type +'a t = 'a list;;
+module type T = S with type -'a t = 'a list;;
diff --git a/testsuite/tests/typing-signatures/pr6672.ocaml.reference b/testsuite/tests/typing-signatures/pr6672.ocaml.reference
new file mode 100644
index 00000000..d99090fc
--- /dev/null
+++ b/testsuite/tests/typing-signatures/pr6672.ocaml.reference
@@ -0,0 +1,9 @@
+module type S = sig type 'a t end
+module type T = sig type 'a t = 'a list end
+Line 1, characters 23-43:
+1 | module type T = S with type -'a t = 'a list;;
+                           ^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, expected parameter variances are not satisfied.
+       The 1st type parameter was expected to be contravariant,
+       but it is injective covariant.
+
diff --git a/testsuite/tests/typing-sigsubst/mpr7852.mli b/testsuite/tests/typing-sigsubst/mpr7852.mli
new file mode 100644
index 00000000..28a8d855
--- /dev/null
+++ b/testsuite/tests/typing-sigsubst/mpr7852.mli
@@ -0,0 +1,12 @@
+module M : sig
+  type t
+  val foo : t -> int
+  val bar : t -> int
+end
+
+module N : sig
+  type outer
+  type t
+  val foo : t -> outer
+  val bar : t -> outer
+end with type outer := int
diff --git a/testsuite/tests/typing-sigsubst/sig_local_aliases.ml b/testsuite/tests/typing-sigsubst/sig_local_aliases.ml
new file mode 100644
index 00000000..096312ad
--- /dev/null
+++ b/testsuite/tests/typing-sigsubst/sig_local_aliases.ml
@@ -0,0 +1,123 @@
+(* TEST
+   * expect
+*)
+
+module M = struct
+  type t
+end;;
+[%%expect{|
+module M : sig type t end
+|}]
+
+module type Accepted = sig
+  type t := int
+
+  type 'a u := 'a list
+
+  type 'a v := (string * 'a) list
+
+  module T := M
+
+  type _ w := T.t
+
+  val f : t u -> char w v
+end;;
+[%%expect{|
+module type Accepted = sig val f : int list -> (string * M.t) list end
+|}]
+
+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 type Accepted2 = sig
+  module N := F(M)
+
+  val foo : N.t -> int
+end;;
+[%%expect{|
+module type Accepted2 = sig val foo : F(M).t -> int end
+|}]
+
+module type Reject1 = sig
+  module M := Funct(M)
+end;;
+[%%expect{|
+Line 2, characters 14-22:
+2 |   module M := Funct(M)
+                  ^^^^^^^^
+Error: Unbound module Funct
+Hint: Did you mean Fun?
+|}]
+
+module type Reject2 = sig
+  module M := F(N)
+end;;
+[%%expect{|
+Line 2, characters 14-18:
+2 |   module M := F(N)
+                  ^^^^
+Error: Unbound module N
+|}]
+
+module type Reject3 = sig
+  type t := u
+end;;
+[%%expect{|
+Line 2, characters 12-13:
+2 |   type t := u
+                ^
+Error: Unbound type constructor u
+|}]
+
+module type RejectRec = sig
+  type t := [ `Foo of t | `Nil ]
+end;;
+[%%expect{|
+Line 2, characters 22-23:
+2 |   type t := [ `Foo of t | `Nil ]
+                          ^
+Error: Unbound type constructor t
+|}]
+
+module type AcceptAnd = sig
+  type t := int
+  and u := int * int
+end;;
+[%%expect{|
+module type AcceptAnd = sig end
+|}]
+
+module type RejectAnd = sig
+  type t := int
+  and u := t * int
+end;;
+[%%expect{|
+Line 3, characters 11-12:
+3 |   and u := t * int
+               ^
+Error: Unbound type constructor t
+|}]
+
+type ('a, 'b) foo = Foo
+
+type 'a s = 'b list constraint 'a = (int, 'b) foo
+
+module type S = sig
+  type 'a t := 'a s * bool
+  type 'a bar = (int, 'a) foo
+  val x : string bar t
+end
+[%%expect{|
+type ('a, 'b) foo = Foo
+type 'a s = 'b list constraint 'a = (int, 'b) foo
+Line 6, characters 2-26:
+6 |   type 'a t := 'a s * bool
+      ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Destructive substitutions are not supported for constrained
+       types (other than when replacing a type constructor with
+       a type constructor with the same arguments).
+|}]
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
new file mode 100644
index 00000000..860a36bf
--- /dev/null
+++ b/testsuite/tests/typing-sigsubst/sig_local_aliases_syntax_errors.compilers.reference
@@ -0,0 +1,38 @@
+Line 6, characters 2-14:
+6 |   type t1 := A
+      ^^^^^^^^^^^^
+Error: Only type synonyms are allowed on the right of :=
+Line 3, characters 2-24:
+3 |   type t2 := { x : int }
+      ^^^^^^^^^^^^^^^^^^^^^^
+Error: Only type synonyms are allowed on the right of :=
+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
+Line 3, characters 17-23:
+3 |   module M2 := F(struct type t = int end)
+                     ^^^^^^
+Error: Syntax error: module path expected.
+Line 2, characters 7-9:
+2 | type t := int;;
+           ^^
+Error: Syntax error
+Line 2, characters 9-11:
+2 | module M := List;;
+             ^^
+Error: Syntax error
+Line 4, characters 9-10:
+4 |   and u3 = char
+             ^
+Error: Syntax error: 'end' expected
+Line 2, characters 24-27:
+2 | module type Rejected3 = sig
+                            ^^^
+  This 'sig' might be unmatched
+Line 3, characters 7-13:
+3 |   type nonrec t := int
+           ^^^^^^
+Error: Syntax error: nonrec flag not expected.
+
diff --git a/testsuite/tests/typing-sigsubst/sig_local_aliases_syntax_errors.ml b/testsuite/tests/typing-sigsubst/sig_local_aliases_syntax_errors.ml
new file mode 100644
index 00000000..b387ec6a
--- /dev/null
+++ b/testsuite/tests/typing-sigsubst/sig_local_aliases_syntax_errors.ml
@@ -0,0 +1,36 @@
+(* TEST
+   * toplevel
+*)
+
+module type Rejected1 = sig
+  type t1 := A
+end;;
+
+module type Rejected2 = sig
+  type t2 := { x : int }
+end;;
+
+module type RejectedM1 = sig
+  module M1 := sig end
+end;;
+
+module F(X : sig type t end) = struct
+  type t = X.t
+end;;
+
+module type RejectedM2 = sig
+  module M2 := F(struct type t = int end)
+end;;
+
+type t := int;;
+
+module M := List;;
+
+module type Rejected3 = sig
+  type t3 := int
+  and u3 = char
+end;;
+
+module type Rejected0 = sig
+  type nonrec t := int
+end;;
diff --git a/testsuite/tests/typing-sigsubst/sigsubst.ml b/testsuite/tests/typing-sigsubst/sigsubst.ml
new file mode 100644
index 00000000..b2b835e9
--- /dev/null
+++ b/testsuite/tests/typing-sigsubst/sigsubst.ml
@@ -0,0 +1,378 @@
+(* TEST
+   * expect
+*)
+
+module type Printable = sig
+  type t
+  val print : t -> unit
+end
+[%%expect {|
+module type Printable = sig type t val print : t -> unit end
+|}]
+module type Comparable = sig
+  type t
+  val compare : t -> t -> int
+end
+[%%expect {|
+module type Comparable = sig type t val compare : t -> t -> int end
+|}]
+module type PrintableComparable = sig
+  include Printable
+  include Comparable with type t = t
+end
+[%%expect {|
+Line 3, characters 2-36:
+3 |   include Comparable with type t = t
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Illegal shadowing of included type t/97 by t/101
+       Line 2, characters 2-19:
+         Type t/97 came from this include
+       Line 3, characters 2-23:
+         The value print has no valid type if t/97 is shadowed
+|}]
+
+module type Sunderscore = sig
+  type (_, _) t
+end with type (_, 'a) t = int * 'a
+[%%expect {|
+module type Sunderscore = sig type (_, 'a) t = int * 'a end
+|}]
+
+
+(* Valid substitutions in a recursive module used to fail
+   due to the ordering of the modules. This is fixed since #9623. *)
+module type S0 = sig
+  module rec M : sig type t = M2.t end
+  and M2 : sig type t = int end
+end with type M.t = int
+[%%expect {|
+module type S0 =
+  sig module rec M : sig type t = int end and M2 : sig type t = int end end
+|}]
+
+
+module type PrintableComparable = sig
+  type t
+  include Printable with type t := t
+  include Comparable with type t := t
+end
+[%%expect {|
+module type PrintableComparable =
+  sig type t val print : t -> unit val compare : t -> t -> int end
+|}]
+module type PrintableComparable = sig
+  include Printable
+  include Comparable with type t := t
+end
+[%%expect {|
+module type PrintableComparable =
+  sig type t val print : t -> unit val compare : t -> t -> int end
+|}]
+module type ComparableInt = Comparable with type t := int
+[%%expect {|
+module type ComparableInt = sig val compare : int -> int -> int end
+|}]
+module type S = sig type t val f : t -> t end
+[%%expect {|
+module type S = sig type t val f : t -> t end
+|}]
+module type S' = S with type t := int
+[%%expect {|
+module type S' = sig val f : int -> int end
+|}]
+
+module type S = sig type 'a t val map : ('a -> 'b) -> 'a t -> 'b t end
+module type S1 = S with type 'a t := 'a list
+[%%expect {|
+module type S = sig type 'a t val map : ('a -> 'b) -> 'a t -> 'b t end
+module type S1 = sig val map : ('a -> 'b) -> 'a list -> 'b list end
+|}]
+module type S2 = S with type 'a t := (string * 'a) list
+[%%expect {|
+module type S2 =
+  sig val map : ('a -> 'b) -> (string * 'a) list -> (string * 'b) list end
+|}]
+module type S3 = S with type _ t := int
+[%%expect {|
+module type S3 = sig val map : ('a -> 'b) -> int -> int end
+|}]
+
+
+module type S =
+  sig module T : sig type exp type arg end val f : T.exp -> T.arg end
+module M = struct type exp = string type arg = int end
+module type S' = S with module T := M
+[%%expect {|
+module type S =
+  sig module T : sig type exp type arg end val f : T.exp -> T.arg end
+module M : sig type exp = string type arg = int end
+module type S' = sig val f : M.exp -> M.arg end
+|}]
+
+
+module type S = sig type 'a t end with type 'a t := unit
+[%%expect {|
+module type S = sig end
+|}]
+
+module type S = sig
+  type t = [ `Foo ]
+  type s = private [< t ]
+end with type t := [ `Foo ]
+[%%expect {|
+module type S = sig type s = private [< `Foo ] end
+|}]
+
+module type S = sig
+  type t = ..
+  type t += A
+end with type t := exn
+[%%expect {|
+module type S = sig type exn += A end
+|}]
+
+(* We allow type constraints when replacing a path by a path. *)
+type 'a t constraint 'a = 'b list
+module type S = sig
+  type 'a t2 constraint 'a = 'b list
+  type 'a mylist = 'a list
+  val x : int mylist t2
+end with type 'a t2 := 'a t
+[%%expect {|
+type 'a t constraint 'a = 'b list
+module type S = sig type 'a mylist = 'a list val x : int mylist t end
+|}]
+
+(* but not when replacing a path by a type expression *)
+type 'a t constraint 'a = 'b list
+module type S = sig
+  type 'a t2 constraint 'a = 'b list
+  type 'a mylist = 'a list
+  val x : int mylist t2
+end with type 'a t2 := 'a t * bool
+[%%expect {|
+type 'a t constraint 'a = 'b list
+Lines 2-6, characters 16-34:
+2 | ................sig
+3 |   type 'a t2 constraint 'a = 'b list
+4 |   type 'a mylist = 'a list
+5 |   val x : int mylist t2
+6 | end with type 'a t2 := 'a t * bool
+Error: Destructive substitutions are not supported for constrained
+       types (other than when replacing a type constructor with
+       a type constructor with the same arguments).
+|}]
+
+(* Issue where the typer weakens an alias, which breaks the typing of the rest
+   of the signature. (MPR#7723)*)
+module type S = sig
+  module M1 : sig type t = int end
+  module M2 = M1
+  module M3 : sig module M = M2 end
+  module F(X : sig module M = M1 end) : sig type t end
+  type t = F(M3).t
+end with type M2.t = int
+[%%expect {|
+module type S =
+  sig
+    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
+    type t = F(M3).t
+  end
+|}]
+
+type (_, _) eq = Refl : ('a, 'a) eq
+
+module Equal (M : Set.OrderedType) (N : Set.OrderedType with type t = M.t) : sig
+  val eq : (Set.Make(M).t, Set.Make(N).t) eq
+end = struct
+  type meq = Eq of (Set.Make(M).t, Set.Make(M).t) eq
+  module type S = sig
+    module N = M
+    type neq = meq = Eq of (Set.Make(M).t, Set.Make(N).t) eq
+  end
+  module type T = S with type N.t = M.t with module N := N;;
+  module rec T : T = T
+  let eq =
+    let T.Eq eq = Eq Refl in
+    eq
+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)
+|}]
+
+(* Checking that the uses of M.t are rewritten regardless of how they
+   are named, but we don't rewrite other types by the same name. *)
+module type S = sig
+  module M : sig type t val x : t end
+  val y : M.t
+  module A : sig module M : sig type t val z : t -> M.t end end
+end with type M.t := float
+[%%expect {|
+module type S =
+  sig
+    module M : sig val x : float end
+    val y : float
+    module A : sig module M : sig type t val z : t -> float end end
+  end
+|}]
+
+(* Regression test: at some point, expanding S1 twice in the same
+   "with type" would result in a signature with duplicate ids, which
+   would confuse the rewriting (we would end with (M2.x : int)) and
+   only then get refreshened. *)
+module type S = sig
+  module type S1 = sig type t type a val x : t end
+  module M1 : S1
+  type a = M1.t
+  module M2 : S1
+  type b = M2.t
+end with type M1.a = int and type M2.a = int and type M1.t := int;;
+[%%expect {|
+module type S =
+  sig
+    module type S1 = sig type t type a val x : t end
+    module M1 : sig type a = int val x : int end
+    type a = int
+    module M2 : sig type t type a = int val x : t end
+    type b = M2.t
+  end
+|}]
+
+(* And now some corner cases with aliases: *)
+
+module type S = sig
+  module M : sig type t end
+  module A = M
+end with type M.t := float
+[%%expect {|
+Lines 1-4, characters 16-26:
+1 | ................sig
+2 |   module M : sig type t end
+3 |   module A = M
+4 | end with type M.t := float
+Error: This `with' constraint on M.t changes M, which is aliased
+       in the constrained signature (as A).
+|}]
+
+(* And more corner cases with applicative functors: *)
+
+module type S = sig
+  module M : sig type t type u end
+  module F(X : sig type t end) : sig type t end
+  type t = F(M).t
+end
+[%%expect {|
+module type S =
+  sig
+    module M : sig type t type u end
+    module F : functor (X : sig type t end) -> sig type t end
+    type t = F(M).t
+  end
+|}]
+
+(* This particular substitution cannot be made to work *)
+module type S2 = S with type M.t := float
+[%%expect {|
+Line 1, characters 17-41:
+1 | module type S2 = S with type M.t := float
+                     ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This `with' constraint on M.t makes the applicative functor
+       type F(M).t ill-typed in the constrained signature:
+       Modules do not match:
+         sig type u = M.u end
+       is not included in
+         sig type t end
+       The type `t' is required but not provided
+|}]
+
+(* However if the applicative functor doesn't care about the type
+   we're removing, the typer accepts the removal. *)
+module type S2 = S with type M.u := float
+[%%expect {|
+module type S2 =
+  sig
+    module M : sig type t end
+    module F : functor (X : sig type t end) -> sig type t end
+    type t = F(M).t
+  end
+|}]
+
+(* In the presence of recursive modules, the use of a module can come before its
+   definition (in the typed tree). *)
+
+module Id(X : sig type t end) = struct type t = X.t end
+module type S3 = sig
+  module rec M : sig type t = A of Id(M2).t end
+  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
+Lines 2-5, characters 17-25:
+2 | .................sig
+3 |   module rec M : sig type t = A of Id(M2).t end
+4 |   and M2 : sig type t end
+5 | end with type M2.t := int
+Error: This `with' constraint on M2.t makes the applicative functor
+       type Id(M2).t ill-typed in the constrained signature:
+       Modules do not match: sig end is not included in sig type t end
+       The type `t' is required but not provided
+|}]
+
+
+(* Deep destructive module substitution: *)
+
+module A = struct module P = struct type t let x = 1 end end
+module type S = sig
+  module M : sig
+    module N : sig
+      module P : sig
+        type t
+      end
+    end
+  end
+  type t = M.N.P.t
+end with module M.N := A
+[%%expect {|
+module A : sig module P : sig type t val x : int end end
+module type S = sig module M : sig end type t = A.P.t end
+|}]
+
+(* Same as for types, not all substitutions are accepted *)
+
+module type S = sig
+  module M : sig
+    module N : sig
+      module P : sig
+        type t
+      end
+    end
+  end
+  module Alias = M
+end with module M.N := A
+[%%expect {|
+Lines 1-10, characters 16-24:
+ 1 | ................sig
+ 2 |   module M : sig
+ 3 |     module N : sig
+ 4 |       module P : sig
+ 5 |         type t
+ 6 |       end
+ 7 |     end
+ 8 |   end
+ 9 |   module Alias = M
+10 | end with module M.N := A
+Error: This `with' constraint on M.N changes M, which is aliased
+       in the constrained signature (as Alias).
+|}]
diff --git a/testsuite/tests/typing-sigsubst/test_functor.ml b/testsuite/tests/typing-sigsubst/test_functor.ml
new file mode 100644
index 00000000..f0926653
--- /dev/null
+++ b/testsuite/tests/typing-sigsubst/test_functor.ml
@@ -0,0 +1,13 @@
+module type S = sig
+  type elt
+  type t
+
+  val create : elt -> t
+end
+
+module Apply (Arg : sig type t end) : S with type elt = Arg.t = struct
+  type elt = Arg.t
+  type t = elt list
+
+  let create x = [ x ]
+end
diff --git a/testsuite/tests/typing-sigsubst/test_loc_modtype_type_eq.ml b/testsuite/tests/typing-sigsubst/test_loc_modtype_type_eq.ml
new file mode 100644
index 00000000..db74e843
--- /dev/null
+++ b/testsuite/tests/typing-sigsubst/test_loc_modtype_type_eq.ml
@@ -0,0 +1,3 @@
+module type S = Test_functor.S with type elt = unit
+
+module M : S = Test_functor.Apply (String)
diff --git a/testsuite/tests/typing-sigsubst/test_loc_modtype_type_subst.ml b/testsuite/tests/typing-sigsubst/test_loc_modtype_type_subst.ml
new file mode 100644
index 00000000..f8880e6e
--- /dev/null
+++ b/testsuite/tests/typing-sigsubst/test_loc_modtype_type_subst.ml
@@ -0,0 +1,3 @@
+module type S = Test_functor.S with type elt := unit
+
+module M : S = Test_functor.Apply (String)
diff --git a/testsuite/tests/typing-sigsubst/test_loc_type_eq.ml b/testsuite/tests/typing-sigsubst/test_loc_type_eq.ml
new file mode 100644
index 00000000..9bec56d6
--- /dev/null
+++ b/testsuite/tests/typing-sigsubst/test_loc_type_eq.ml
@@ -0,0 +1 @@
+module M : Test_functor.S with type elt = unit = Test_functor.Apply (String)
diff --git a/testsuite/tests/typing-sigsubst/test_loc_type_subst.ml b/testsuite/tests/typing-sigsubst/test_loc_type_subst.ml
new file mode 100644
index 00000000..a32ec8aa
--- /dev/null
+++ b/testsuite/tests/typing-sigsubst/test_loc_type_subst.ml
@@ -0,0 +1 @@
+module M : Test_functor.S with type elt := unit = Test_functor.Apply (String)
diff --git a/testsuite/tests/typing-sigsubst/test_locations.compilers.reference b/testsuite/tests/typing-sigsubst/test_locations.compilers.reference
new file mode 100644
index 00000000..c3155381
--- /dev/null
+++ b/testsuite/tests/typing-sigsubst/test_locations.compilers.reference
@@ -0,0 +1,67 @@
+File "test_loc_type_eq.ml", line 1, characters 49-76:
+1 | module M : Test_functor.S with type elt = unit = Test_functor.Apply (String)
+                                                     ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       ...
+       Type declarations do not match:
+         type elt = String.t
+       is not included in
+         type elt = unit
+       File "test_loc_type_eq.ml", line 1, characters 31-46:
+         Expected declaration
+       File "test_functor.ml", line 8, characters 45-61: Actual declaration
+File "test_loc_modtype_type_eq.ml", line 3, characters 15-42:
+3 | module M : S = Test_functor.Apply (String)
+                   ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig
+           type elt = String.t
+           type t = Test_functor.Apply(String).t
+           val create : elt -> t
+         end
+       is not included in
+         S
+       Type declarations do not match:
+         type elt = String.t
+       is not included in
+         type elt = unit
+       File "test_loc_modtype_type_eq.ml", line 1, characters 36-51:
+         Expected declaration
+       File "test_functor.ml", line 8, characters 45-61: Actual declaration
+File "test_loc_type_subst.ml", line 1, characters 50-77:
+1 | module M : Test_functor.S with type elt := unit = Test_functor.Apply (String)
+                                                      ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig
+           type elt = String.t
+           type t = Test_functor.Apply(String).t
+           val create : elt -> t
+         end
+       is not included in
+         sig type t val create : unit -> t end
+       Values do not match:
+         val create : elt -> t
+       is not included in
+         val create : unit -> t
+       File "test_functor.ml", line 5, characters 2-23: Expected declaration
+       File "test_functor.ml", line 5, characters 2-23: Actual declaration
+File "test_loc_modtype_type_subst.ml", line 3, characters 15-42:
+3 | module M : S = Test_functor.Apply (String)
+                   ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig
+           type elt = String.t
+           type t = Test_functor.Apply(String).t
+           val create : elt -> t
+         end
+       is not included in
+         S
+       Values do not match:
+         val create : elt -> t
+       is not included in
+         val create : unit -> t
+       File "test_functor.ml", line 5, characters 2-23: Expected declaration
+       File "test_functor.ml", line 5, characters 2-23: Actual declaration
diff --git a/testsuite/tests/typing-sigsubst/test_locations.ml b/testsuite/tests/typing-sigsubst/test_locations.ml
new file mode 100644
index 00000000..31084001
--- /dev/null
+++ b/testsuite/tests/typing-sigsubst/test_locations.ml
@@ -0,0 +1,26 @@
+(* TEST
+files = "test_functor.ml test_loc_modtype_type_eq.ml \
+         test_loc_modtype_type_subst.ml test_loc_type_eq.ml \
+         test_loc_type_subst.ml mpr7852.mli"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+module = "test_functor.ml"
+** ocamlc.byte
+module = "test_loc_type_eq.ml"
+ocamlc_byte_exit_status = "2"
+** ocamlc.byte
+module = "test_loc_modtype_type_eq.ml"
+ocamlc_byte_exit_status = "2"
+** ocamlc.byte
+module = "test_loc_type_subst.ml"
+ocamlc_byte_exit_status = "2"
+** ocamlc.byte
+module = "test_loc_modtype_type_subst.ml"
+ocamlc_byte_exit_status = "2"
+** check-ocamlc.byte-output
+** ocamlc.byte
+flags = "-w +32"
+module = "mpr7852.mli"
+ocamlc_byte_exit_status = "0"
+** check-ocamlc.byte-output
+*)
diff --git a/testsuite/tests/typing-typeparam/newtype.ml b/testsuite/tests/typing-typeparam/newtype.ml
new file mode 100644
index 00000000..b41d0dfc
--- /dev/null
+++ b/testsuite/tests/typing-typeparam/newtype.ml
@@ -0,0 +1,36 @@
+(* TEST
+   * toplevel
+*)
+
+let property (type t) () =
+  let module M = struct exception E of t end in
+  (fun x -> M.E x), (function M.E x -> Some x | _ -> None)
+;;
+
+let () =
+  let (int_inj, int_proj) = property () in
+  let (string_inj, string_proj) = property () in
+
+  let i = int_inj 3 in
+  let s = string_inj "abc" in
+
+  Printf.printf "%B\n%!" (int_proj i = None);
+  Printf.printf "%B\n%!" (int_proj s = None);
+  Printf.printf "%B\n%!" (string_proj i = None);
+  Printf.printf "%B\n%!" (string_proj s = None)
+;;
+
+let sort_uniq (type s) cmp l =
+  let module S = Set.Make(struct type t = s let compare = cmp end) in
+  S.elements (List.fold_right S.add l S.empty)
+;;
+
+let () =
+  print_endline (String.concat "," (sort_uniq compare [ "abc"; "xyz"; "abc" ]))
+;;
+
+let f x (type a) (y : a) = (x = y);; (* Fails *)
+class ['a] c = object (self)
+  method m : 'a -> 'a = fun x -> x
+  method n : 'a -> 'a = fun (type g) (x:g) -> self#m x
+end;; (* Fails *)
diff --git a/testsuite/tests/typing-typeparam/newtype.ocaml.reference b/testsuite/tests/typing-typeparam/newtype.ocaml.reference
new file mode 100644
index 00000000..911fb8a5
--- /dev/null
+++ b/testsuite/tests/typing-typeparam/newtype.ocaml.reference
@@ -0,0 +1,18 @@
+val property : unit -> ('t -> exn) * (exn -> 't option) = 
+false
+true
+true
+false
+val sort_uniq : ('s -> 's -> int) -> 's list -> 's list = 
+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
+       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
+       The type constructor g would escape its scope
+
diff --git a/testsuite/tests/typing-unboxed-types/test.ml b/testsuite/tests/typing-unboxed-types/test.ml
new file mode 100644
index 00000000..5e81a3d7
--- /dev/null
+++ b/testsuite/tests/typing-unboxed-types/test.ml
@@ -0,0 +1,377 @@
+(* TEST
+   * expect
+*)
+
+(* Check the unboxing *)
+
+(* For concrete types *)
+type t1 = A of string [@@ocaml.unboxed];;
+[%%expect{|
+type t1 = A of string [@@unboxed]
+|}];;
+
+let x = A "foo" in
+Obj.repr x == Obj.repr (match x with A s -> s)
+;;
+[%%expect{|
+- : bool = true
+|}];;
+
+(* For records *)
+type t2 = { f : string } [@@ocaml.unboxed];;
+[%%expect{|
+type t2 = { f : string; } [@@unboxed]
+|}];;
+
+let x = { f = "foo" } in
+Obj.repr x == Obj.repr x.f
+;;
+[%%expect{|
+- : bool = true
+|}];;
+
+(* For inline records *)
+type t3 = B of { g : string } [@@ocaml.unboxed];;
+[%%expect{|
+type t3 = B of { g : string; } [@@unboxed]
+|}];;
+
+let x = B { g = "foo" } in
+Obj.repr x == Obj.repr (match x with B {g} -> g)
+;;
+[%%expect{|
+- : bool = true
+|}];;
+
+(* Check unboxable types *)
+type t4 = C [@@ocaml.unboxed];;  (* no argument *)
+[%%expect{|
+Line 1, characters 0-29:
+1 | type t4 = C [@@ocaml.unboxed];;  (* no argument *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because its constructor has no argument.
+|}];;
+type t5 = D of int * string [@@ocaml.unboxed];; (* more than one argument *)
+[%%expect{|
+Line 1, characters 0-45:
+1 | type t5 = D of int * string [@@ocaml.unboxed];; (* more than one argument *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       its constructor has more than one argument.
+|}];;
+type t5 = E | F [@@ocaml.unboxed];;          (* more than one constructor *)
+[%%expect{|
+Line 1, characters 0-33:
+1 | type t5 = E | F [@@ocaml.unboxed];;          (* more than one constructor *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because it has more than one constructor.
+|}];;
+type t6 = G of int | H [@@ocaml.unboxed];;
+[%%expect{|
+Line 1, characters 0-40:
+1 | type t6 = G of int | H [@@ocaml.unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because it has more than one constructor.
+|}];;
+type t7 = I of string | J of bool [@@ocaml.unboxed];;
+
+type t8 = { h : bool; i : int } [@@ocaml.unboxed];;  (* more than one field *)
+[%%expect{|
+Line 1, characters 0-51:
+1 | type t7 = I of string | J of bool [@@ocaml.unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because it has more than one constructor.
+|}];;
+type t9 = K of { j : string; l : int } [@@ocaml.unboxed];;
+[%%expect{|
+Line 1, characters 0-56:
+1 | type t9 = K of { j : string; l : int } [@@ocaml.unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       its constructor has more than one field.
+|}];;
+
+(* let rec must be rejected *)
+type t10 = A of t10 [@@ocaml.unboxed];;
+[%%expect{|
+type t10 = A of t10 [@@unboxed]
+|}];;
+let rec x = A x;;
+[%%expect{|
+Line 1, characters 12-15:
+1 | let rec x = A x;;
+                ^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+|}];;
+
+(* Representation mismatch between module and signature must be rejected *)
+module M : sig
+  type t = A of string
+end = struct
+  type t = A of string [@@ocaml.unboxed]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = A of string [@@ocaml.unboxed]
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = A of string [@@unboxed] end
+       is not included in
+         sig type t = A of string end
+       Type declarations do not match:
+         type t = A of string [@@unboxed]
+       is not included in
+         type t = A of string
+       Their internal representations differ:
+       the first declaration uses unboxed representation.
+|}];;
+
+module N : sig
+  type t = A of string [@@ocaml.unboxed]
+end = struct
+  type t = A of string
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = A of string
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = A of string end
+       is not included in
+         sig type t = A of string [@@unboxed] end
+       Type declarations do not match:
+         type t = A of string
+       is not included in
+         type t = A of string [@@unboxed]
+       Their internal representations differ:
+       the second declaration uses unboxed representation.
+|}];;
+
+module O : sig
+  type t = { f : string }
+end = struct
+  type t = { f : string } [@@ocaml.unboxed]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = { f : string } [@@ocaml.unboxed]
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = { f : string; } [@@unboxed] end
+       is not included in
+         sig type t = { f : string; } end
+       Type declarations do not match:
+         type t = { f : string; } [@@unboxed]
+       is not included in
+         type t = { f : string; }
+       Their internal representations differ:
+       the first declaration uses unboxed representation.
+|}];;
+
+module P : sig
+  type t = { f : string } [@@ocaml.unboxed]
+end = struct
+  type t = { f : string }
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = { f : string }
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = { f : string; } end
+       is not included in
+         sig type t = { f : string; } [@@unboxed] end
+       Type declarations do not match:
+         type t = { f : string; }
+       is not included in
+         type t = { f : string; } [@@unboxed]
+       Their internal representations differ:
+       the second declaration uses unboxed representation.
+|}];;
+
+module Q : sig
+  type t = A of { f : string }
+end = struct
+  type t = A of { f : string } [@@ocaml.unboxed]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = A of { f : string } [@@ocaml.unboxed]
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = A of { f : string; } [@@unboxed] end
+       is not included in
+         sig type t = A of { f : string; } end
+       Type declarations do not match:
+         type t = A of { f : string; } [@@unboxed]
+       is not included in
+         type t = A of { f : string; }
+       Their internal representations differ:
+       the first declaration uses unboxed representation.
+|}];;
+
+module R : sig
+  type t = A of { f : string } [@@ocaml.unboxed]
+end = struct
+  type t = A of { f : string }
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = A of { f : string }
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = A of { f : string; } end
+       is not included in
+         sig type t = A of { f : string; } [@@unboxed] end
+       Type declarations do not match:
+         type t = A of { f : string; }
+       is not included in
+         type t = A of { f : string; } [@@unboxed]
+       Their internal representations differ:
+       the second declaration uses unboxed representation.
+|}];;
+
+
+(* Check interference with representation of float arrays. *)
+type t11 = L of float [@@ocaml.unboxed];;
+[%%expect{|
+type t11 = L of float [@@unboxed]
+|}];;
+let x = Array.make 10 (L 3.14)   (* represented as a flat array *)
+and f (a : t11 array) = a.(0)    (* might wrongly assume an array of pointers *)
+in assert (f x = L 3.14);;
+[%%expect{|
+- : unit = ()
+|}];;
+
+
+(* Check for a potential infinite loop in the typing algorithm. *)
+type 'a t12 = M of 'a t12 [@@ocaml.unboxed];;
+[%%expect{|
+type 'a t12 = M of 'a t12 [@@unboxed]
+|}];;
+let f (a : int t12 array) = a.(0);;
+[%%expect{|
+val f : int t12 array -> int t12 = 
+|}];;
+
+(* Check for another possible loop *)
+type t13 = A : _ t12 -> t13 [@@ocaml.unboxed];;
+[%%expect{|
+type t13 = A : 'a t12 -> t13 [@@unboxed]
+|}];;
+
+
+(* should work *)
+type t14;;
+type t15 = A of t14 [@@ocaml.unboxed];;
+[%%expect{|
+type t14
+type t15 = A of t14 [@@unboxed]
+|}];;
+
+(* should fail because the compiler knows that t is actually float and
+   optimizes the record's representation *)
+module S : sig
+  type t
+  type u = { f1 : t; f2 : t }
+end = struct
+  type t = A of float [@@ocaml.unboxed]
+  type u = { f1 : t; f2 : t }
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 |   type t = A of float [@@ocaml.unboxed]
+6 |   type u = { f1 : t; f2 : t }
+7 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = A of float [@@unboxed] type u = { f1 : t; f2 : t; } end
+       is not included in
+         sig type t type u = { f1 : t; f2 : t; } end
+       Type declarations do not match:
+         type u = { f1 : t; f2 : t; }
+       is not included in
+         type u = { f1 : t; f2 : t; }
+       Their internal representations differ:
+       the first declaration uses unboxed float representation.
+|}];;
+
+(* implementing [@@immediate] with [@@ocaml.unboxed]: this works because the
+   representation of [t] is [int]
+ *)
+module T : sig
+  type t [@@immediate]
+end = struct
+  type t = A of int [@@ocaml.unboxed]
+end;;
+[%%expect{|
+module T : sig type t [@@immediate] end
+|}];;
+
+(* Another corner case *)
+type 'a s
+type ('a, 'p) t = private 'a s
+type 'a packed = T : ('a, _) t -> 'a packed [@@unboxed]
+;;
+[%%expect{|
+type 'a s
+type ('a, 'p) t = private 'a s
+type 'a packed = T : ('a, 'b) t -> 'a packed [@@unboxed]
+|}];;
+
+(* MPR#7682 *)
+type f = {field: 'a. 'a list} [@@unboxed];;
+let g = Array.make 10 { field=[] };;
+let h = g.(5);;
+[%%expect{|
+type f = { field : 'a. 'a list; } [@@unboxed]
+val g : f array =
+  [|{field = []}; {field = []}; {field = []}; {field = []}; {field = []};
+    {field = []}; {field = []}; {field = []}; {field = []}; {field = []}|]
+val h : f = {field = []}
+|}];;
+
+(* Using [@@immediate] information (GPR#1469) *)
+type 'a t [@@immediate];;
+type u = U : 'a t -> u [@@unboxed];;
+[%%expect{|
+type 'a t [@@immediate]
+type u = U : 'a t -> u [@@unboxed]
+|}];;
+
+(* This could not be accepted without using a fixpoint to check unboxed declarations
+   (GPR#2188) *)
+type ('a, 'b) t = K : 'c -> (bool, 'c) t [@@unboxed]
+and t1 = T1 : (bool, int) t -> t1 [@@unboxed]
+[%%expect{|
+type ('a, 'b) t = K : 'c -> (bool, 'c) t [@@unboxed]
+and t1 = T1 : (bool, int) t -> t1 [@@unboxed]
+|}];;
+
+(* This real-world example of recursive declaration comes from Markus Mottl
+   -- see MPR#7361 *)
+type ('a, 'kind) tree =
+  | Root : { mutable value : 'a; mutable rank : int } -> ('a, [ `root ]) tree
+  | Inner : { mutable parent : 'a node } -> ('a, [ `inner ]) tree
+and 'a node = Node : ('a, _) tree -> 'a node [@@ocaml.unboxed]
+[%%expect{|
+type ('a, 'kind) tree =
+    Root : { mutable value : 'a; mutable rank : int;
+    } -> ('a, [ `root ]) tree
+  | Inner : { mutable parent : 'a node; } -> ('a, [ `inner ]) tree
+and 'a node = Node : ('a, 'b) tree -> 'a node [@@unboxed]
+|}];;
diff --git a/testsuite/tests/typing-unboxed-types/test_flat.ml b/testsuite/tests/typing-unboxed-types/test_flat.ml
new file mode 100644
index 00000000..c093efe1
--- /dev/null
+++ b/testsuite/tests/typing-unboxed-types/test_flat.ml
@@ -0,0 +1,315 @@
+(* TEST
+   * flat-float-array
+   ** expect
+*)
+
+(* should fail *)
+type 'a abs;;
+type t16 = A : 'a abs -> t16 [@@ocaml.unboxed];;
+[%%expect{|
+type 'a abs
+Line 2, characters 0-46:
+2 | type t16 = A : 'a abs -> t16 [@@ocaml.unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       it might contain both float and non-float values,
+       depending on the instantiation of the existential variable 'a.
+       You should annotate it with [@@ocaml.boxed].
+|}];;
+
+(* should fail (the existential _ still occurs in an abstract type) *)
+type t18 = A : _ list abs -> t18 [@@ocaml.unboxed];;
+[%%expect{|
+Line 1, characters 0-50:
+1 | type t18 = A : _ list abs -> t18 [@@ocaml.unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       it might contain both float and non-float values,
+       depending on the instantiation of an unnamed existential variable.
+       You should annotate it with [@@ocaml.boxed].
+|}];;
+
+(* regression test for PR#7511 (wrong determination of unboxability for GADTs)
+*)
+type 'a s = S : 'a -> 'a s [@@unboxed];;
+type t = T : 'a s -> t [@@unboxed];;
+[%%expect{|
+type 'a s = S : 'a -> 'a s [@@unboxed]
+Line 2, characters 0-34:
+2 | type t = T : 'a s -> t [@@unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       it might contain both float and non-float values,
+       depending on the instantiation of the existential variable 'a.
+       You should annotate it with [@@ocaml.boxed].
+|}];;
+
+(* regression test for GPR#1133 (follow-up to PR#7511) *)
+type 'a s = S : 'a -> 'a option s [@@unboxed];;
+type t = T : 'a s -> t [@@unboxed];;
+[%%expect{|
+type 'a s = S : 'a -> 'a option s [@@unboxed]
+Line 2, characters 0-34:
+2 | type t = T : 'a s -> t [@@unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       it might contain both float and non-float values,
+       depending on the instantiation of the existential variable 'a.
+       You should annotate it with [@@ocaml.boxed].
+|}];;
+
+(* Another test for GPR#1133: abstract types *)
+module M : sig
+  type 'a r constraint 'a = unit -> 'b
+  val inj : 'b -> (unit -> 'b) r
+end = struct
+  type 'a r = 'b constraint 'a = unit -> 'b
+  let inj x = x
+end;;
+[%%expect{|
+module M :
+  sig type 'a r constraint 'a = unit -> 'b val inj : 'b -> (unit -> 'b) r end
+|}];;
+
+(* reject *)
+type t = T : (unit -> _) M.r -> t [@@unboxed];;
+[%%expect{|
+Line 1, characters 0-45:
+1 | type t = T : (unit -> _) M.r -> t [@@unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       it might contain both float and non-float values,
+       depending on the instantiation of an unnamed existential variable.
+       You should annotate it with [@@ocaml.boxed].
+|}];;
+
+(* accept *)
+type 'a s = S : (unit -> 'a) M.r -> 'a option s [@@unboxed];;
+[%%expect{|
+type 'a s = S : (unit -> 'a) M.r -> 'a option s [@@unboxed]
+|}];;
+
+(* reject *)
+type t = T : 'a s -> t [@@unboxed];;
+[%%expect{|
+Line 1, characters 0-34:
+1 | type t = T : 'a s -> t [@@unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       it might contain both float and non-float values,
+       depending on the instantiation of the existential variable 'a.
+       You should annotate it with [@@ocaml.boxed].
+|}];;
+
+(* accept *)
+type 'a t = T : 'a s -> 'a t [@@unboxed];;
+[%%expect{|
+type 'a t = T : 'a s -> 'a t [@@unboxed]
+|}];;
+
+(* Even without constraints, we need to mark abstract types as Deepsep:
+   unboxed GADTs can introduce equations that do not appear in the signature
+   (see GPR#2188) *)
+module N : sig
+  type 'a r
+  val inj : 'b -> (unit -> 'b) r
+end = struct
+  type _ r = K : 'b -> (unit -> 'b) r [@@unboxed]
+  let inj x = K x
+end;;
+[%%expect{|
+module N : sig type 'a r val inj : 'b -> (unit -> 'b) r end
+|}];;
+
+(* reject *)
+type t = T : (unit -> _) N.r -> t [@@unboxed];;
+[%%expect{|
+Line 1, characters 0-45:
+1 | type t = T : (unit -> _) N.r -> t [@@unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       it might contain both float and non-float values,
+       depending on the instantiation of an unnamed existential variable.
+       You should annotate it with [@@ocaml.boxed].
+|}];;
+
+(* accept *)
+type 'a s = S : (unit -> 'a) N.r -> 'a option s [@@unboxed];;
+[%%expect{|
+type 'a s = S : (unit -> 'a) N.r -> 'a option s [@@unboxed]
+|}];;
+
+(* Another corner case from GPR#1133 *)
+type _ s = S : 'a t -> _ s  [@@unboxed]
+ and _ t = T : 'a -> 'a s t
+;;
+[%%expect{|
+type _ s = S : 'a t -> 'b s [@@unboxed]
+and _ t = T : 'a -> 'a s t
+|}];;
+
+(* regression test for PR#7511 (wrong determination of unboxability for GADTs)
+*)
+type 'a s = S : 'a -> 'a s [@@unboxed];;
+type t = T : 'a s -> t [@@unboxed];;
+[%%expect{|
+type 'a s = S : 'a -> 'a s [@@unboxed]
+Line 2, characters 0-34:
+2 | type t = T : 'a s -> t [@@unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       it might contain both float and non-float values,
+       depending on the instantiation of the existential variable 'a.
+       You should annotate it with [@@ocaml.boxed].
+|}];;
+
+(* regression test for GPR#1133 (follow-up to PR#7511) *)
+type 'a s = S : 'a -> 'a option s [@@unboxed];;
+type t = T : 'a s -> t [@@unboxed];;
+[%%expect{|
+type 'a s = S : 'a -> 'a option s [@@unboxed]
+Line 2, characters 0-34:
+2 | type t = T : 'a s -> t [@@unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       it might contain both float and non-float values,
+       depending on the instantiation of the existential variable 'a.
+       You should annotate it with [@@ocaml.boxed].
+|}];;
+
+(* Another test for GPR#1133: abstract types *)
+module M : sig
+  type 'a r constraint 'a = unit -> 'b
+  val inj : 'b -> (unit -> 'b) r
+end = struct
+  type 'a r = 'b constraint 'a = unit -> 'b
+  let inj x = x
+end;;
+[%%expect{|
+module M :
+  sig type 'a r constraint 'a = unit -> 'b val inj : 'b -> (unit -> 'b) r end
+|}];;
+
+(* reject *)
+type t = T : (unit -> _) M.r -> t [@@unboxed];;
+[%%expect{|
+Line 1, characters 0-45:
+1 | type t = T : (unit -> _) M.r -> t [@@unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       it might contain both float and non-float values,
+       depending on the instantiation of an unnamed existential variable.
+       You should annotate it with [@@ocaml.boxed].
+|}];;
+
+type 'a s = S : (unit -> 'a) M.r -> 'a option s [@@unboxed];;
+[%%expect{|
+type 'a s = S : (unit -> 'a) M.r -> 'a option s [@@unboxed]
+|}];;
+
+(* reject *)
+type t = T : 'a s -> t [@@unboxed];;
+[%%expect{|
+Line 1, characters 0-34:
+1 | type t = T : 'a s -> t [@@unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       it might contain both float and non-float values,
+       depending on the instantiation of the existential variable 'a.
+       You should annotate it with [@@ocaml.boxed].
+|}];;
+
+(* accept *)
+type 'a t = T : 'a s -> 'a t [@@unboxed];;
+[%%expect{|
+type 'a t = T : 'a s -> 'a t [@@unboxed]
+|}];;
+
+
+(* Another corner case from GPR#1133 *)
+type _ s = S : 'a t -> _ s  [@@unboxed]
+ and _ t = T : 'a -> 'a s t
+;;
+[%%expect{|
+type _ s = S : 'a t -> 'b s [@@unboxed]
+and _ t = T : 'a -> 'a s t
+|}];;
+
+(* GPR#2188: non-principality examples.
+   One of the two declarations [valid1] and [valid2] below will fail,
+   depending on the order in which GADT equality constraints
+   are processed by our implementation.
+   The previous unfolding implementation would accept both.
+
+   We decided to specify that, if two parameters are equal to each other,
+   then we would use the more constrained mode (Sep rather than Ind) for the
+   first/leftmost parameter, and Ind for the second one. With a left-to-right
+   reading of parameters, this corresponds to considering that the equality
+   is on the second parameter, equal to a parameter already seen, rather than
+   an equality on a not-yet-seen parameter.
+
+   In the example below, almost_eq will thus get the mode signature
+   (Sep, Ind) rather than (Ind, Sep).
+*)
+type (_, _) almost_eq = Almost_refl : 'a -> ('a, 'a) almost_eq [@@unboxed]
+[%%expect{|
+type (_, _) almost_eq = Almost_refl : 'a -> ('a, 'a) almost_eq [@@unboxed]
+|}];;
+
+
+type valid1 = Any : ('a, int) almost_eq -> valid1 [@@unboxed];;
+[%%expect{|
+Line 1, characters 0-61:
+1 | type valid1 = Any : ('a, int) almost_eq -> valid1 [@@unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       it might contain both float and non-float values,
+       depending on the instantiation of the existential variable 'a.
+       You should annotate it with [@@ocaml.boxed].
+|}];;
+type valid2 = Any : (int, 'a) almost_eq -> valid2 [@@unboxed];;
+[%%expect{|
+type valid2 = Any : (int, 'a) almost_eq -> valid2 [@@unboxed]
+|}];;
+
+(* rejected: equivalent to (exits 'a. 'a) *)
+type danger = Any : ('a, 'a) almost_eq -> danger [@@unboxed];;
+[%%expect{|
+Line 1, characters 0-60:
+1 | type danger = Any : ('a, 'a) almost_eq -> danger [@@unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This type cannot be unboxed because
+       it might contain both float and non-float values,
+       depending on the instantiation of the existential variable 'a.
+       You should annotate it with [@@ocaml.boxed].
+|}];;
+
+
+(* GPR#2188: handling of cyclic types *)
+type 'a stream = unit -> [ `Cons of 'a * 'a stream ];;
+type safe = Any : 'a stream -> safe;;
+[%%expect{|
+type 'a stream = unit -> [ `Cons of 'a * 'a stream ]
+type safe = Any : 'a stream -> safe
+|}];;
+
+type 'a infinite_full_tree = unit -> [ `Node of 'a * ('a * 'a) stream ];;
+type safe_again = Any : 'a stream -> safe_again;;
+[%%expect{|
+type 'a infinite_full_tree = unit -> [ `Node of 'a * ('a * 'a) stream ]
+type safe_again = Any : 'a stream -> safe_again
+|}];;
+
+(** Note: there are no tests of rejected cyclic types, because
+    the type declarations that would be required to check these cases
+    (unproductive cycles in the type declaration) are already rejected by the
+    type-checker, before separability checking. See below *)
+type 'a id = Id of 'a [@@unboxed]
+type cycle = cycle id
+[%%expect{|
+type 'a id = Id of 'a [@@unboxed]
+Line 2, characters 0-21:
+2 | type cycle = cycle id
+    ^^^^^^^^^^^^^^^^^^^^^
+Error: The type abbreviation cycle is cyclic
+|}];;
diff --git a/testsuite/tests/typing-unboxed-types/test_no_flat.ml b/testsuite/tests/typing-unboxed-types/test_no_flat.ml
new file mode 100644
index 00000000..a1c48d2c
--- /dev/null
+++ b/testsuite/tests/typing-unboxed-types/test_no_flat.ml
@@ -0,0 +1,154 @@
+(* TEST
+   * no-flat-float-array
+   ** expect
+*)
+
+(* This file copies the tests from test_flat.ml,
+   but is only tested when -no-flat-float-array
+   is set, and thus all types are unboxable.
+
+   We kept the comments on why each test should fail,
+   to make it easier to compare the two files,
+   but the test in this file should all pass,
+   as shown in the expected outputs.
+*)
+
+(* should fail *)
+type 'a abs;;
+type t16 = A : _ abs -> t16 [@@ocaml.unboxed];;
+[%%expect{|
+type 'a abs
+type t16 = A : 'a abs -> t16 [@@unboxed]
+|}];;
+
+(* should fail (the existential _ still occurs in an abstract type) *)
+type t18 = A : _ list abs -> t18 [@@ocaml.unboxed];;
+[%%expect{|
+type t18 = A : 'a list abs -> t18 [@@unboxed]
+|}];;
+
+(* regression test for PR#7511 (wrong determination of unboxability for GADTs)
+*)
+type 'a s = S : 'a -> 'a s [@@unboxed];;
+type t = T : _ s -> t [@@unboxed];;
+[%%expect{|
+type 'a s = S : 'a -> 'a s [@@unboxed]
+type t = T : 'a s -> t [@@unboxed]
+|}];;
+
+(* regression test for GPR#1133 (follow-up to PR#7511) *)
+type 'a s = S : 'a -> 'a option s [@@unboxed];;
+type t = T : _ s -> t [@@unboxed];;
+[%%expect{|
+type 'a s = S : 'a -> 'a option s [@@unboxed]
+type t = T : 'a s -> t [@@unboxed]
+|}];;
+
+(* Another test for GPR#1133: abstract types *)
+module M : sig
+  type 'a r constraint 'a = unit -> 'b
+  val inj : 'b -> (unit -> 'b) r
+end = struct
+  type 'a r = 'b constraint 'a = unit -> 'b
+  let inj x = x
+end;;
+[%%expect{|
+module M :
+  sig type 'a r constraint 'a = unit -> 'b val inj : 'b -> (unit -> 'b) r end
+|}];;
+
+(* reject *)
+type t = T : (unit -> _) M.r -> t [@@unboxed];;
+[%%expect{|
+type t = T : (unit -> 'a) M.r -> t [@@unboxed]
+|}];;
+
+type 'a s = S : (unit -> 'a) M.r -> 'a option s [@@unboxed];;
+[%%expect{|
+type 'a s = S : (unit -> 'a) M.r -> 'a option s [@@unboxed]
+|}];;
+
+(* reject *)
+type t = T : _ s -> t [@@unboxed];;
+[%%expect{|
+type t = T : 'a s -> t [@@unboxed]
+|}];;
+
+(* accept *)
+type 'a t = T : 'a s -> 'a t [@@unboxed];;
+[%%expect{|
+type 'a t = T : 'a s -> 'a t [@@unboxed]
+|}];;
+
+
+(* Another corner case from GPR#1133 *)
+type _ s = S : 'a t -> _ s  [@@unboxed]
+ and _ t = T : 'a -> 'a s t
+;;
+[%%expect{|
+type _ s = S : 'a t -> 'b s [@@unboxed]
+and _ t = T : 'a -> 'a s t
+|}];;
+
+(* regression test for PR#7511 (wrong determination of unboxability for GADTs)
+*)
+type 'a s = S : 'a -> 'a s [@@unboxed];;
+type t = T : _ s -> t [@@unboxed];;
+[%%expect{|
+type 'a s = S : 'a -> 'a s [@@unboxed]
+type t = T : 'a s -> t [@@unboxed]
+|}];;
+
+(* regression test for GPR#1133 (follow-up to PR#7511) *)
+type 'a s = S : 'a -> 'a option s [@@unboxed];;
+type t = T : _ s -> t [@@unboxed];;
+[%%expect{|
+type 'a s = S : 'a -> 'a option s [@@unboxed]
+type t = T : 'a s -> t [@@unboxed]
+|}];;
+
+(* Another test for GPR#1133: abstract types *)
+module M : sig
+  type 'a r constraint 'a = unit -> 'b
+  val inj : 'b -> (unit -> 'b) r
+end = struct
+  type 'a r = 'b constraint 'a = unit -> 'b
+  let inj x = x
+end;;
+[%%expect{|
+module M :
+  sig type 'a r constraint 'a = unit -> 'b val inj : 'b -> (unit -> 'b) r end
+|}];;
+
+(* reject *)
+type t = T : (unit -> _) M.r -> t [@@unboxed];;
+[%%expect{|
+type t = T : (unit -> 'a) M.r -> t [@@unboxed]
+|}];;
+
+type 'a s = S : (unit -> 'a) M.r -> 'a option s [@@unboxed];;
+[%%expect{|
+type 'a s = S : (unit -> 'a) M.r -> 'a option s [@@unboxed]
+|}];;
+
+(* reject *)
+type t = T : _ s -> t [@@unboxed];;
+[%%expect{|
+type t = T : 'a s -> t [@@unboxed]
+|}];;
+
+(* accept *)
+type 'a t = T : 'a s -> 'a t [@@unboxed];;
+[%%expect{|
+type 'a t = T : 'a s -> 'a t [@@unboxed]
+|}];;
+
+
+(* Another corner case from GPR#1133 *)
+type _ s = S : 'a t -> _ s  [@@unboxed]
+ and _ t = T : 'a -> 'a s t
+;;
+[%%expect{|
+type _ s = S : 'a t -> 'b s [@@unboxed]
+and _ t = T : 'a -> 'a s t
+|}];;
diff --git a/testsuite/tests/typing-unboxed/test.ml b/testsuite/tests/typing-unboxed/test.ml
new file mode 100644
index 00000000..741ac3d9
--- /dev/null
+++ b/testsuite/tests/typing-unboxed/test.ml
@@ -0,0 +1,483 @@
+(* TEST
+   flags = "-strict-sequence"
+   * expect
+*)
+external a : (int [@untagged]) -> unit = "a" "a_nat"
+external b : (int32 [@unboxed]) -> unit = "b" "b_nat"
+external c : (int64 [@unboxed]) -> unit = "c" "c_nat"
+external d : (nativeint [@unboxed]) -> unit = "d" "d_nat"
+external e : (float [@unboxed]) -> unit = "e" "e_nat"
+
+type t = private int
+
+external f : (t [@untagged]) -> unit = "f" "f_nat"
+
+module M : sig
+  external a : int -> (int [@untagged]) = "a" "a_nat"
+  external b : (int [@untagged]) -> int = "b" "b_nat"
+end = struct
+  external a : int -> (int [@untagged]) = "a" "a_nat"
+  external b : (int [@untagged]) -> int = "b" "b_nat"
+end;;
+
+[%%expect{|
+external a : (int [@untagged]) -> unit = "a" "a_nat"
+external b : (int32 [@unboxed]) -> unit = "b" "b_nat"
+external c : (int64 [@unboxed]) -> unit = "c" "c_nat"
+external d : (nativeint [@unboxed]) -> unit = "d" "d_nat"
+external e : (float [@unboxed]) -> unit = "e" "e_nat"
+type t = private int
+external f : (t [@untagged]) -> unit = "f" "f_nat"
+module M :
+  sig
+    external a : int -> (int [@untagged]) = "a" "a_nat"
+    external b : (int [@untagged]) -> int = "b" "b_nat"
+  end
+|}]
+
+module Global_attributes = struct
+  [@@@ocaml.alert "-deprecated"]
+
+  external a : float -> float = "a" "noalloc" "a_nat" "float"
+  external b : float -> float = "b" "noalloc" "b_nat"
+  external c : float -> float = "c" "c_nat" "float"
+  external d : float -> float = "d" "noalloc"
+  external e : float -> float = "e"
+
+  (* Should output a warning: no native implementation provided *)
+  external f : (int32 [@unboxed]) -> (int32 [@unboxed]) = "f" "noalloc"
+  external g : int32 -> int32 = "g" "g_nat" [@@unboxed] [@@noalloc]
+
+  external h : (int [@untagged]) -> (int [@untagged]) = "h" "h_nat" "noalloc"
+  external i : int -> int = "i" "i_nat" [@@untagged] [@@noalloc]
+end;;
+
+[%%expect{|
+Line 11, characters 2-71:
+11 |   external f : (int32 [@unboxed]) -> (int32 [@unboxed]) = "f" "noalloc"
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: [@The native code version of the primitive is mandatory
+       when attributes [@untagged] or [@unboxed] are present.
+|}]
+
+module Old_style_warning = struct
+  [@@@ocaml.warning "+3"]
+  external a : float -> float = "a" "noalloc" "a_nat" "float"
+  external b : float -> float = "b" "noalloc" "b_nat"
+  external c : float -> float = "c" "c_nat" "float"
+  external d : float -> float = "d" "noalloc"
+  external e : float -> float = "c" "float"
+end;;
+[%%expect{|
+Line 3, characters 2-61:
+3 |   external a : float -> float = "a" "noalloc" "a_nat" "float"
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Alert deprecated: [@@unboxed] + [@@noalloc] should be used
+instead of "float"
+Line 4, characters 2-53:
+4 |   external b : float -> float = "b" "noalloc" "b_nat"
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Alert deprecated: [@@noalloc] should be used instead of "noalloc"
+Line 5, characters 2-51:
+5 |   external c : float -> float = "c" "c_nat" "float"
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Alert deprecated: [@@unboxed] + [@@noalloc] should be used
+instead of "float"
+Line 6, characters 2-45:
+6 |   external d : float -> float = "d" "noalloc"
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Alert deprecated: [@@noalloc] should be used instead of "noalloc"
+module Old_style_warning :
+  sig
+    external a : float -> float = "a" "a_nat" [@@unboxed] [@@noalloc]
+    external b : float -> float = "b" "b_nat" [@@noalloc]
+    external c : float -> float = "c" "c_nat" [@@unboxed] [@@noalloc]
+    external d : float -> float = "d" [@@noalloc]
+    external e : float -> float = "c" "float"
+  end
+|}]
+
+(* Bad: attributes not reported in the interface *)
+
+module Bad1 : sig
+  external f : int -> int = "f" "f_nat"
+end = struct
+  external f : int -> (int [@untagged]) = "f" "f_nat"
+end;;
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   external f : int -> (int [@untagged]) = "f" "f_nat"
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : int -> (int [@untagged]) = "f" "f_nat" end
+       is not included in
+         sig external f : int -> int = "f" "f_nat" end
+       Values do not match:
+         external f : int -> (int [@untagged]) = "f" "f_nat"
+       is not included in
+         external f : int -> int = "f" "f_nat"
+|}]
+
+module Bad2 : sig
+  external f : int -> int = "a" "a_nat"
+end = struct
+  external f : (int [@untagged]) -> int = "f" "f_nat"
+end;;
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   external f : (int [@untagged]) -> int = "f" "f_nat"
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : (int [@untagged]) -> int = "f" "f_nat" end
+       is not included in
+         sig external f : int -> int = "a" "a_nat" end
+       Values do not match:
+         external f : (int [@untagged]) -> int = "f" "f_nat"
+       is not included in
+         external f : int -> int = "a" "a_nat"
+|}]
+
+module Bad3 : sig
+  external f : float -> float = "f" "f_nat"
+end = struct
+  external f : float -> (float [@unboxed]) = "f" "f_nat"
+end;;
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   external f : float -> (float [@unboxed]) = "f" "f_nat"
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : float -> (float [@unboxed]) = "f" "f_nat" end
+       is not included in
+         sig external f : float -> float = "f" "f_nat" end
+       Values do not match:
+         external f : float -> (float [@unboxed]) = "f" "f_nat"
+       is not included in
+         external f : float -> float = "f" "f_nat"
+|}]
+
+module Bad4 : sig
+  external f : float -> float = "a" "a_nat"
+end = struct
+  external f : (float [@unboxed]) -> float = "f" "f_nat"
+end;;
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   external f : (float [@unboxed]) -> float = "f" "f_nat"
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : (float [@unboxed]) -> float = "f" "f_nat" end
+       is not included in
+         sig external f : float -> float = "a" "a_nat" end
+       Values do not match:
+         external f : (float [@unboxed]) -> float = "f" "f_nat"
+       is not included in
+         external f : float -> float = "a" "a_nat"
+|}]
+
+(* Bad: attributes in the interface but not in the implementation *)
+
+module Bad5 : sig
+  external f : int -> (int [@untagged]) = "f" "f_nat"
+end = struct
+  external f : int -> int = "f" "f_nat"
+end;;
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   external f : int -> int = "f" "f_nat"
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : int -> int = "f" "f_nat" end
+       is not included in
+         sig external f : int -> (int [@untagged]) = "f" "f_nat" end
+       Values do not match:
+         external f : int -> int = "f" "f_nat"
+       is not included in
+         external f : int -> (int [@untagged]) = "f" "f_nat"
+|}]
+
+module Bad6 : sig
+  external f : (int [@untagged]) -> int = "f" "f_nat"
+end = struct
+  external f : int -> int = "a" "a_nat"
+end;;
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   external f : int -> int = "a" "a_nat"
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : int -> int = "a" "a_nat" end
+       is not included in
+         sig external f : (int [@untagged]) -> int = "f" "f_nat" end
+       Values do not match:
+         external f : int -> int = "a" "a_nat"
+       is not included in
+         external f : (int [@untagged]) -> int = "f" "f_nat"
+|}]
+
+module Bad7 : sig
+  external f : float -> (float [@unboxed]) = "f" "f_nat"
+end = struct
+  external f : float -> float = "f" "f_nat"
+end;;
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   external f : float -> float = "f" "f_nat"
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : float -> float = "f" "f_nat" end
+       is not included in
+         sig external f : float -> (float [@unboxed]) = "f" "f_nat" end
+       Values do not match:
+         external f : float -> float = "f" "f_nat"
+       is not included in
+         external f : float -> (float [@unboxed]) = "f" "f_nat"
+|}]
+
+module Bad8 : sig
+  external f : (float [@unboxed]) -> float = "f" "f_nat"
+end = struct
+  external f : float -> float = "a" "a_nat"
+end;;
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   external f : float -> float = "a" "a_nat"
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : float -> float = "a" "a_nat" end
+       is not included in
+         sig external f : (float [@unboxed]) -> float = "f" "f_nat" end
+       Values do not match:
+         external f : float -> float = "a" "a_nat"
+       is not included in
+         external f : (float [@unboxed]) -> float = "f" "f_nat"
+|}]
+
+(* Bad: unboxed or untagged with the wrong type *)
+
+external g : (float [@untagged]) -> float = "g" "g_nat";;
+[%%expect{|
+Line 1, characters 14-19:
+1 | external g : (float [@untagged]) -> float = "g" "g_nat";;
+                  ^^^^^
+Error: Don't know how to untag this type. Only int can be untagged.
+|}]
+external h : (int [@unboxed]) -> float = "h" "h_nat";;
+[%%expect{|
+Line 1, characters 14-17:
+1 | external h : (int [@unboxed]) -> float = "h" "h_nat";;
+                  ^^^
+Error: Don't know how to unbox this type.
+       Only float, int32, int64 and nativeint can be unboxed.
+|}]
+
+(* Bad: unboxing the function type *)
+external i : int -> float [@unboxed] = "i" "i_nat";;
+[%%expect{|
+Line 1, characters 13-25:
+1 | external i : int -> float [@unboxed] = "i" "i_nat";;
+                 ^^^^^^^^^^^^
+Error: Don't know how to unbox this type.
+       Only float, int32, int64 and nativeint can be unboxed.
+|}]
+
+(* Bad: unboxing a "deep" sub-type. *)
+external j : int -> (float [@unboxed]) * float = "j" "j_nat";;
+[%%expect{|
+Line 1, characters 21-26:
+1 | external j : int -> (float [@unboxed]) * float = "j" "j_nat";;
+                         ^^^^^
+Error: The attribute '@unboxed' should be attached to
+       a direct argument or result of the primitive,
+       it should not occur deeply into its type.
+|}]
+
+(* This should be rejected, but it is quite complicated to do
+   in the current state of things *)
+
+external k : int -> (float [@unboxd]) = "k" "k_nat";;
+[%%expect{|
+external k : int -> float = "k" "k_nat"
+|}]
+
+(* Bad: old style annotations + new style attributes *)
+
+external l : float -> float = "l" "l_nat" "float" [@@unboxed];;
+[%%expect{|
+Line 1, characters 0-61:
+1 | external l : float -> float = "l" "l_nat" "float" [@@unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Cannot use "float" in conjunction with [@unboxed]/[@untagged].
+|}]
+external m : (float [@unboxed]) -> float = "m" "m_nat" "float";;
+[%%expect{|
+Line 1, characters 0-62:
+1 | external m : (float [@unboxed]) -> float = "m" "m_nat" "float";;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Cannot use "float" in conjunction with [@unboxed]/[@untagged].
+|}]
+external n : float -> float = "n" "noalloc" [@@noalloc];;
+[%%expect{|
+Line 1, characters 0-55:
+1 | external n : float -> float = "n" "noalloc" [@@noalloc];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Cannot use "noalloc" in conjunction with [@@noalloc].
+|}]
+
+(* Warnings: unboxed / untagged without any native implementation *)
+external o : (float[@unboxed]) -> float = "o";;
+[%%expect{|
+Line 1, characters 0-45:
+1 | external o : (float[@unboxed]) -> float = "o";;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: [@The native code version of the primitive is mandatory
+       when attributes [@untagged] or [@unboxed] are present.
+|}]
+external p : float -> (float[@unboxed]) = "p";;
+[%%expect{|
+Line 1, characters 0-45:
+1 | external p : float -> (float[@unboxed]) = "p";;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: [@The native code version of the primitive is mandatory
+       when attributes [@untagged] or [@unboxed] are present.
+|}]
+external q : (int[@untagged]) -> float = "q";;
+[%%expect{|
+Line 1, characters 0-44:
+1 | external q : (int[@untagged]) -> float = "q";;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: [@The native code version of the primitive is mandatory
+       when attributes [@untagged] or [@unboxed] are present.
+|}]
+external r : int -> (int[@untagged]) = "r";;
+[%%expect{|
+Line 1, characters 0-42:
+1 | external r : int -> (int[@untagged]) = "r";;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: [@The native code version of the primitive is mandatory
+       when attributes [@untagged] or [@unboxed] are present.
+|}]
+external s : int -> int = "s" [@@untagged];;
+[%%expect{|
+Line 1, characters 0-42:
+1 | external s : int -> int = "s" [@@untagged];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: [@The native code version of the primitive is mandatory
+       when attributes [@untagged] or [@unboxed] are present.
+|}]
+external t : float -> float = "t" [@@unboxed];;
+[%%expect{|
+Line 1, characters 0-45:
+1 | external t : float -> float = "t" [@@unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: [@The native code version of the primitive is mandatory
+       when attributes [@untagged] or [@unboxed] are present.
+|}]
+
+(* PR#7424 *)
+type 'a b = B of 'a b b [@@unboxed];;
+[%%expect{|
+type 'a b = B of 'a b b [@@unboxed]
+|}]
+
+
+(* MPR#7828 *)
+type i = I of int
+external id : i -> i = "%identity";;
+[%%expect{|
+type i = I of int
+Line 2, characters 0-34:
+2 | external id : i -> i = "%identity";;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 61: This primitive declaration uses type i, whose representation
+may be either boxed or unboxed. Without an annotation to indicate
+which representation is intended, the boxed representation has been
+selected by default. This default choice may change in future
+versions of the compiler, breaking the primitive implementation.
+You should explicitly annotate the declaration of i
+with [@@boxed] or [@@unboxed], so that its external interface
+remains stable in the future.
+external id : i -> i = "%identity"
+|}];;
+
+type i = I of int
+type j = J of int
+external id : i -> j = "%identity";;
+[%%expect{|
+type i = I of int
+type j = J of int
+Line 3, characters 0-34:
+3 | external id : i -> j = "%identity";;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 61: This primitive declaration uses type i, whose representation
+may be either boxed or unboxed. Without an annotation to indicate
+which representation is intended, the boxed representation has been
+selected by default. This default choice may change in future
+versions of the compiler, breaking the primitive implementation.
+You should explicitly annotate the declaration of i
+with [@@boxed] or [@@unboxed], so that its external interface
+remains stable in the future.
+Line 3, characters 0-34:
+3 | external id : i -> j = "%identity";;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 61: This primitive declaration uses type j, whose representation
+may be either boxed or unboxed. Without an annotation to indicate
+which representation is intended, the boxed representation has been
+selected by default. This default choice may change in future
+versions of the compiler, breaking the primitive implementation.
+You should explicitly annotate the declaration of j
+with [@@boxed] or [@@unboxed], so that its external interface
+remains stable in the future.
+external id : i -> j = "%identity"
+|}];;
+
+type ib = I of int [@@boxed]
+external idb : ib -> ib = "%identity";;
+[%%expect{|
+type ib = I of int
+external idb : ib -> ib = "%identity"
+|}];;
+
+type iub = I of int [@@unboxed]
+external idub : iub -> iub = "%identity";;
+[%%expect{|
+type iub = I of int [@@unboxed]
+external idub : iub -> iub = "%identity"
+|}];;
+
+(* #9607: separability was not computed on with-constraints *)
+module type T  = sig type 'k t end
+module M : T with type 'k t = string = struct
+  type 'k t = string
+end
+type t = T : 'k M.t -> t [@@unboxed]
+
+[%%expect{|
+module type T = sig type 'k t end
+module M : sig type 'k t = string end
+type t = T : 'k M.t -> t [@@unboxed]
+|}];;
diff --git a/testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml b/testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml
new file mode 100644
index 00000000..27b12920
--- /dev/null
+++ b/testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml
@@ -0,0 +1,495 @@
+(* TEST
+   flags = " -w A -strict-sequence "
+   * expect
+*)
+
+(* Ignore OCAMLRUNPARAM=b to be reproducible *)
+Printexc.record_backtrace false;;
+[%%expect {|
+- : unit = ()
+|}]
+
+type expr = Val of int | Rest;;
+[%%expect {|
+type expr = Val of int | Rest
+|}]
+
+let ambiguous_typical_example = function
+  | ((Val x, _) | (_, Val x)) when x < 0 -> ()
+  | (_, Rest) -> ()
+  | (_, Val x) ->
+      (* the reader might expect *)
+      assert (x >= 0);
+      (* to hold here, but it is wrong! *)
+      ()
+;;
+[%%expect {|
+Line 2, characters 4-29:
+2 |   | ((Val x, _) | (_, Val x)) when x < 0 -> ()
+        ^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 57: Ambiguous or-pattern variables under guard;
+variable x may match different arguments. (See manual section 9.5)
+val ambiguous_typical_example : expr * expr -> unit = 
+|}]
+
+let fails = ambiguous_typical_example (Val 2, Val (-1))
+;;
+[%%expect {|
+Exception: Assert_failure ("", 6, 6).
+|}]
+
+let not_ambiguous__no_orpat = function
+  | Some x when x > 0 -> ()
+  | Some _ -> ()
+  | None -> ()
+;;
+[%%expect {|
+val not_ambiguous__no_orpat : int option -> unit = 
+|}]
+
+let not_ambiguous__no_guard = function
+  | `A -> ()
+  | (`B | `C) -> ()
+;;
+[%%expect {|
+val not_ambiguous__no_guard : [< `A | `B | `C ] -> unit = 
+|}]
+
+let not_ambiguous__no_patvar_in_guard b = function
+  | (`B x | `C x) when b -> ignore x
+  | _ -> ()
+;;
+[%%expect {|
+val not_ambiguous__no_patvar_in_guard :
+  bool -> [> `B of 'a | `C of 'a ] -> unit = 
+|}]
+
+let not_ambiguous__disjoint_cases = function
+  | (`B x | `C x) when x -> ()
+  | _ -> ()
+;;
+[%%expect {|
+val not_ambiguous__disjoint_cases : [> `B of bool | `C of bool ] -> unit =
+  
+|}]
+
+(* the curious (..., _, Some _) | (..., Some _, _) device used in
+   those tests serves to avoid warning 12 (this sub-pattern
+   is unused), by making sure that, even if the two sides of the
+   disjunction overlap, none is fully included in the other. *)
+let not_ambiguous__prefix_variables = function
+  | (`B (x, _, Some y) | `B (x, Some y, _)) when x -> ignore y
+  | _ -> ()
+;;
+[%%expect {|
+val not_ambiguous__prefix_variables :
+  [> `B of bool * 'a option * 'a option ] -> unit = 
+|}]
+
+let ambiguous__y = function
+  | (`B (x, _, Some y) | `B (x, Some y, _)) when y -> ignore x
+  | _ -> ()
+;;
+[%%expect {|
+Line 2, characters 4-43:
+2 |   | (`B (x, _, Some y) | `B (x, Some y, _)) when y -> ignore x
+        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 57: Ambiguous or-pattern variables under guard;
+variable y may match different arguments. (See manual section 9.5)
+val ambiguous__y : [> `B of 'a * bool option * bool option ] -> unit = 
+|}]
+
+(* it should be understood that the ambiguity warning only protects
+     (p | q) when guard -> ...
+   it will never warn on
+     (p | q) -> if guard ...
+   This is not a limitation. The point is that people have an
+   intuitive understanding of [(p | q) when guard -> ...] that differs
+   from the reality, while there is no such issue with
+   [(p | q) -> if guard ...].
+*)
+let not_ambiguous__rhs_not_protected = function
+  | (`B (x, _, Some y) | `B (x, Some y, _)) -> if y then ignore x else ()
+  | _ -> ()
+;;
+[%%expect {|
+val not_ambiguous__rhs_not_protected :
+  [> `B of 'a * bool option * bool option ] -> unit = 
+|}]
+
+let ambiguous__x_y = function
+  | (`B (x, _, Some y) | `B (x, Some y, _)) when x < y -> ()
+  | _ -> ()
+;;
+[%%expect {|
+Line 2, characters 4-43:
+2 |   | (`B (x, _, Some y) | `B (x, Some y, _)) when x < y -> ()
+        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 57: Ambiguous or-pattern variables under guard;
+variable y may match different arguments. (See manual section 9.5)
+val ambiguous__x_y : [> `B of 'a * 'a option * 'a option ] -> unit = 
+|}]
+
+let ambiguous__x_y_z = function
+  | (`B (x, z, Some y) | `B (x, Some y, z)) when x < y || Some x = z -> ()
+  | _ -> ()
+;;
+[%%expect {|
+Line 2, characters 4-43:
+2 |   | (`B (x, z, Some y) | `B (x, Some y, z)) when x < y || Some x = z -> ()
+        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 57: Ambiguous or-pattern variables under guard;
+variables y,z may match different arguments. (See manual section 9.5)
+val ambiguous__x_y_z : [> `B of 'a * 'a option * 'a option ] -> unit = 
+|}]
+
+let not_ambiguous__disjoint_in_depth = function
+  | `A (`B x | `C x) when x -> ()
+  | _ -> ()
+;;
+[%%expect {|
+val not_ambiguous__disjoint_in_depth :
+  [> `A of [> `B of bool | `C of bool ] ] -> unit = 
+|}]
+
+let not_ambiguous__prefix_variables_in_depth = function
+  | `A (`B (x, `C1) | `B (x, `C2)) when x -> ()
+  | _ -> ()
+;;
+[%%expect {|
+val not_ambiguous__prefix_variables_in_depth :
+  [> `A of [> `B of bool * [> `C1 | `C2 ] ] ] -> unit = 
+|}]
+
+let ambiguous__in_depth = function
+  | `A (`B (Some x, _) | `B (_, Some x)) when x -> ()
+  | _ -> ()
+;;
+[%%expect {|
+Line 2, characters 4-40:
+2 |   | `A (`B (Some x, _) | `B (_, Some x)) when x -> ()
+        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 57: Ambiguous or-pattern variables under guard;
+variable x may match different arguments. (See manual section 9.5)
+val ambiguous__in_depth :
+  [> `A of [> `B of bool option * bool option ] ] -> unit = 
+|}]
+
+let not_ambiguous__several_orpats = function
+  | `A ((`B (x, Some _, _) | `B (x, _, Some _)),
+        (`C (y, Some _, _) | `C (y, _, Some _)),
+        (`D1 (_, z, Some _, _) | `D2 (_, z, _, Some _))) when x < y && x < z ->
+      ()
+  | _ -> ()
+;;
+[%%expect {|
+val not_ambiguous__several_orpats :
+  [> `A of
+       [> `B of 'a * 'b option * 'c option ] *
+       [> `C of 'a * 'd option * 'e option ] *
+       [> `D1 of 'f * 'a * 'g option * 'h | `D2 of 'i * 'a * 'j * 'k option ]
+  ] -> unit = 
+|}]
+
+let ambiguous__first_orpat = function
+  | `A ((`B (Some x, _) | `B (_, Some x)),
+        (`C (Some y, Some _, _) | `C (Some y, _, Some _))) when x < y -> ()
+  | _ -> ()
+;;
+[%%expect {|
+Lines 2-3, characters 4-58:
+2 | ....`A ((`B (Some x, _) | `B (_, Some x)),
+3 |         (`C (Some y, Some _, _) | `C (Some y, _, Some _))).................
+Warning 57: Ambiguous or-pattern variables under guard;
+variable x may match different arguments. (See manual section 9.5)
+val ambiguous__first_orpat :
+  [> `A of
+       [> `B of 'a option * 'a option ] *
+       [> `C of 'a option * 'b option * 'c option ] ] ->
+  unit = 
+|}]
+
+let ambiguous__second_orpat = function
+  | `A ((`B (Some x, Some _, _) | `B (Some x, _, Some _)),
+        (`C (Some y, _) | `C (_, Some y))) when x < y -> ()
+  | _ -> ()
+;;
+[%%expect {|
+Lines 2-3, characters 4-42:
+2 | ....`A ((`B (Some x, Some _, _) | `B (Some x, _, Some _)),
+3 |         (`C (Some y, _) | `C (_, Some y))).................
+Warning 57: Ambiguous or-pattern variables under guard;
+variable y may match different arguments. (See manual section 9.5)
+val ambiguous__second_orpat :
+  [> `A of
+       [> `B of 'a option * 'b option * 'c option ] *
+       [> `C of 'a option * 'a option ] ] ->
+  unit = 
+|}]
+
+(* check that common prefixes work as expected *)
+let not_ambiguous__pairs = function
+  | (x, Some _, _) | (x, _, Some _) when x -> ()
+  | _ -> ()
+;;
+[%%expect {|
+val not_ambiguous__pairs : bool * 'a option * 'b option -> unit = 
+|}]
+
+let not_ambiguous__vars =
+  begin[@warning "-12"] function
+  | (x | x) when x -> ()
+  | _ -> ()
+  end
+;;
+[%%expect {|
+val not_ambiguous__vars : bool -> unit = 
+|}]
+
+let not_ambiguous__as p = function
+  | (([], _) as x | ((_, []) as x)) when p x -> ()
+  | _ -> ()
+;;
+[%%expect {|
+val not_ambiguous__as :
+  ('a list * 'b list -> bool) -> 'a list * 'b list -> unit = 
+|}]
+
+let not_ambiguous__as_var p = function
+  | (([], _) as x | x) when p x -> ()
+  | _ -> ()
+;;
+[%%expect {|
+val not_ambiguous__as_var : ('a list * 'b -> bool) -> 'a list * 'b -> unit =
+  
+|}]
+
+let not_ambiguous__var_as p = function
+  | (x, Some _, _) | (([], _) as x, _, Some _) when p x -> ()
+  | _ -> ()
+;;
+[%%expect {|
+val not_ambiguous__var_as :
+  ('a list * 'b -> bool) -> ('a list * 'b) * 'c option * 'd option -> unit =
+  
+|}]
+
+let not_ambiguous__lazy = function
+  | (([], _), lazy x) | ((_, []), lazy x) when x -> ()
+  | _ -> ()
+;;
+[%%expect {|
+val not_ambiguous__lazy : ('a list * 'b list) * bool lazy_t -> unit = 
+|}]
+
+type t = A of int * int option * int option | B;;
+[%%expect {|
+type t = A of int * int option * int option | B
+|}]
+
+let not_ambiguous__constructor = function
+  | A (x, Some _, _) | A (x, _, Some _) when x > 0 -> ()
+  | A _ | B -> ()
+;;
+[%%expect {|
+val not_ambiguous__constructor : t -> unit = 
+|}]
+
+type amoi = Z of int | Y of int * int  | X of amoi * amoi
+;;
+[%%expect {|
+type amoi = Z of int | Y of int * int | X of amoi * amoi
+|}]
+
+let ambiguous__amoi a = match a with
+| X (Z x,Y (y,0))
+| X (Z y,Y (x,_))
+ when x+y > 0 -> 0
+| X _|Y _|Z _ -> 1
+;;
+[%%expect {|
+Lines 2-3, characters 2-17:
+2 | ..X (Z x,Y (y,0))
+3 | | X (Z y,Y (x,_))
+Warning 57: Ambiguous or-pattern variables under guard;
+variables x,y may match different arguments. (See manual section 9.5)
+val ambiguous__amoi : amoi -> int = 
+|}]
+
+module type S = sig val b : bool end
+;;
+[%%expect {|
+module type S = sig val b : bool end
+|}]
+
+let ambiguous__module_variable x b =  match x with
+  | (module M:S),_,(1,_)
+  | _,(module M:S),(_,1) when M.b && b -> 1
+  | _ -> 2
+;;
+[%%expect {|
+Lines 2-3, characters 4-24:
+2 | ....(module M:S),_,(1,_)
+3 |   | _,(module M:S),(_,1)...................
+Warning 57: Ambiguous or-pattern variables under guard;
+variable M may match different arguments. (See manual section 9.5)
+val ambiguous__module_variable :
+  (module S) * (module S) * (int * int) -> bool -> int = 
+|}]
+
+let not_ambiguous__module_variable x b =  match x with
+  | (module M:S),_,(1,_)
+  | _,(module M:S),(_,1) when b -> 1
+  | _ -> 2
+;;
+[%%expect {|
+Line 2, characters 12-13:
+2 |   | (module M:S),_,(1,_)
+                ^
+Warning 60: unused module M.
+val not_ambiguous__module_variable :
+  (module S) * (module S) * (int * int) -> bool -> int = 
+|}]
+
+(* Mixed case *)
+
+type t2 = A of int * int | B of int * int
+;;
+[%%expect {|
+type t2 = A of int * int | B of int * int
+|}]
+
+let ambiguous_xy_but_not_ambiguous_z g = function
+  | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
+  | _ -> 2
+;;
+[%%expect {|
+Line 2, characters 4-5:
+2 |   | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
+        ^
+Warning 41: A belongs to several types: t2 t
+The first one was selected. Please disambiguate if this is wrong.
+Lines 1-3, characters 41-10:
+1 | .........................................function
+2 |   | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
+3 |   | _ -> 2
+Warning 4: this pattern-matching is fragile.
+It will remain exhaustive when constructors are added to type t2.
+Line 2, characters 4-56:
+2 |   | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
+        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 57: Ambiguous or-pattern variables under guard;
+variables x,y may match different arguments. (See manual section 9.5)
+val ambiguous_xy_but_not_ambiguous_z : (int -> int -> bool) -> t2 -> int =
+  
+|}]
+
+(* Regression test against an erroneous simplification of the algorithm
+
+   One cannot compute the stable variable of the first row of a matrix
+   after its simplification and before splitting the
+   submatrices. Indeed, further splits on the submatrices may reveal
+   that some rows of this first column belong to disjoint submatrices,
+   and thus that the variables are more stable than is visible when
+   looking at the full column.
+*)
+let not_ambiguous__as_disjoint_on_second_column_split = function
+| ((Some a, (1 as b)) | (Some b, (2 as a))) when a = 0 -> ignore a; ignore b
+| _ -> ()
+;;
+[%%expect {|
+val not_ambiguous__as_disjoint_on_second_column_split :
+  int option * int -> unit = 
+|}]
+
+(* we check for the ambiguous case first, so there
+   is no warning *)
+let solved_ambiguity_typical_example = function
+  | (Val x, Val y) ->
+      if x < 0 || y < 0
+      then ()
+      else ()
+  | ((Val x, _) | (_, Val x)) when x < 0 -> ()
+  | (_, Rest) -> ()
+  | (_, Val x) ->
+      (* the reader can expect *)
+      assert (x >= 0);
+      (* to hold here. *)
+      ()
+;;
+[%%expect {|
+val solved_ambiguity_typical_example : expr * expr -> unit = 
+|}]
+
+(* if the check for the ambiguous case is guarded,
+   there is still a warning *)
+let guarded_ambiguity = function
+  | (Val x, Val y) when x < 0 || y < 0 -> ()
+  | ((Val y, _) | (_, Val y)) when y < 0 -> ()
+  | (_, Rest) -> ()
+  | (_, Val x) ->
+      (* the reader can expect *)
+      assert (x >= 0);
+      (* to hold here. *)
+      ()
+;;
+[%%expect {|
+Line 3, characters 4-29:
+3 |   | ((Val y, _) | (_, Val y)) when y < 0 -> ()
+        ^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 57: Ambiguous or-pattern variables under guard;
+variable y may match different arguments. (See manual section 9.5)
+val guarded_ambiguity : expr * expr -> unit = 
+|}]
+
+(* see GPR#1552 *)
+type a = A1 | A2;;
+[%%expect {|
+type a = A1 | A2
+|}]
+
+type 'a alg =
+  | Val of 'a
+  | Binop of 'a alg * 'a alg;;
+[%%expect {|
+type 'a alg = Val of 'a | Binop of 'a alg * 'a alg
+|}]
+
+let cmp (pred : a -> bool) (x : a alg) (y : a alg) =
+  match x, y with
+  | Val A1, Val A1 -> ()
+  | ((Val x, _) | (_, Val x)) when pred x -> ()
+  (* below: silence exhaustiveness/fragility warnings *)
+  | (Val (A1 | A2) | Binop _), _ -> ()
+;;
+[%%expect {|
+Line 4, characters 4-29:
+4 |   | ((Val x, _) | (_, Val x)) when pred x -> ()
+        ^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 57: Ambiguous or-pattern variables under guard;
+variable x may match different arguments. (See manual section 9.5)
+val cmp : (a -> bool) -> a alg -> a alg -> unit = 
+|}]
+
+type a = A1;;
+[%%expect {|
+type a = A1
+|}]
+
+type 'a alg =
+  | Val of 'a
+  | Binop of 'a alg * 'a alg;;
+[%%expect {|
+type 'a alg = Val of 'a | Binop of 'a alg * 'a alg
+|}]
+
+let cmp (pred : a -> bool) (x : a alg) (y : a alg) =
+  match x, y with
+  | Val A1, Val A1 -> ()
+  | ((Val x, _) | (_, Val x)) when pred x -> ()
+  (* below: silence exhaustiveness/fragility warnings *)
+  | (Val A1 | Binop _), _ -> ()
+;;
+[%%expect {|
+val cmp : (a -> bool) -> a alg -> a alg -> unit = 
+|}]
diff --git a/testsuite/tests/typing-warnings/application.ml b/testsuite/tests/typing-warnings/application.ml
new file mode 100644
index 00000000..6a5105f7
--- /dev/null
+++ b/testsuite/tests/typing-warnings/application.ml
@@ -0,0 +1,86 @@
+(* TEST
+   flags = " -w A -strict-sequence "
+   * expect
+*)
+
+(* Ignore OCAMLRUNPARAM=b to be reproducible *)
+Printexc.record_backtrace false;;
+[%%expect {|
+- : unit = ()
+|}]
+
+let _ = Array.get;;
+[%%expect {|
+- : 'a array -> int -> 'a = 
+|}]
+
+let _ = Array.get [||];;
+[%%expect {|
+Line 1, characters 8-22:
+1 | let _ = Array.get [||];;
+            ^^^^^^^^^^^^^^
+Warning 5: this function application is partial,
+maybe some arguments are missing.
+- : int -> 'a = 
+|}]
+
+let () = ignore Array.get;;
+[%%expect {|
+|}]
+
+let () = ignore (Array.get [||]);;
+[%%expect {|
+Line 1, characters 16-32:
+1 | let () = ignore (Array.get [||]);;
+                    ^^^^^^^^^^^^^^^^
+Warning 5: this function application is partial,
+maybe some arguments are missing.
+|}]
+
+
+let _ = if true then Array.get else (fun _ _ -> 12);;
+[%%expect {|
+- : int array -> int -> int = 
+|}]
+
+let _ = if true then Array.get [||] else (fun _ -> 12);;
+[%%expect {|
+Line 1, characters 21-35:
+1 | let _ = if true then Array.get [||] else (fun _ -> 12);;
+                         ^^^^^^^^^^^^^^
+Warning 5: this function application is partial,
+maybe some arguments are missing.
+- : int -> int = 
+|}]
+
+let _ = (if true then Array.get [||] else (fun _ -> 12) : _ -> _);;
+[%%expect {|
+- : int -> int = 
+|}]
+
+type t = {r: int -> int -> int}
+
+let f x = let _ = x.r in ();;
+[%%expect {|
+type t = { r : int -> int -> int; }
+val f : t -> unit = 
+|}]
+
+let f x = let _ = x.r 1 in ();;
+[%%expect {|
+Line 1, characters 18-23:
+1 | let f x = let _ = x.r 1 in ();;
+                      ^^^^^
+Warning 5: this function application is partial,
+maybe some arguments are missing.
+val f : t -> unit = 
+|}]
+
+let _ = raise Exit 3;;
+[%%expect {|
+Line 1, characters 19-20:
+1 | let _ = raise Exit 3;;
+                       ^
+Warning 20: this argument will not be used by the function.
+Exception: Stdlib.Exit.
+|}]
diff --git a/testsuite/tests/typing-warnings/coercions.ml b/testsuite/tests/typing-warnings/coercions.ml
new file mode 100644
index 00000000..ac238bef
--- /dev/null
+++ b/testsuite/tests/typing-warnings/coercions.ml
@@ -0,0 +1,70 @@
+(* TEST
+   flags = " -w A -strict-sequence "
+   * expect
+*)
+
+(* comment 9644 of PR#6000 *)
+
+fun b -> if b then format_of_string "x" else "y"
+[%%expect {|
+- : bool -> ('a, 'b, 'c, 'd, 'd, 'a) format6 = 
+|}, Principal{|
+Line 1, characters 45-48:
+1 | fun b -> if b then format_of_string "x" else "y"
+                                                 ^^^
+Warning 18: this coercion to format6 is not principal.
+- : bool -> ('a, 'b, 'c, 'd, 'd, 'a) format6 = 
+|}]
+;;
+
+fun b -> if b then "x" else format_of_string "y"
+[%%expect {|
+Line 1, characters 28-48:
+1 | fun b -> if b then "x" else format_of_string "y"
+                                ^^^^^^^^^^^^^^^^^^^^
+Error: This expression has type
+         ('a, 'b, 'c, 'd, 'd, 'a) format6 =
+           ('a, 'b, 'c, 'd, 'd, 'a) CamlinternalFormatBasics.format6
+       but an expression was expected of type string
+|}]
+;;
+
+fun b : (_,_,_) format -> if b then "x" else "y"
+[%%expect {|
+- : bool -> ('a, 'b, 'a) format = 
+|}]
+;;
+
+(* PR#7135 *)
+
+module PR7135 = struct
+  module M : sig type t = private int end =  struct type t = int end
+  include M
+
+  let lift2 (f : int -> int -> int) (x : t) (y : t) =
+    f (x :> int) (y :> int)
+end;;
+[%%expect {|
+module PR7135 :
+  sig
+    module M : sig type t = private int end
+    type t = M.t
+    val lift2 : (int -> int -> int) -> t -> t -> int
+  end
+|}]
+
+(* example of non-ground coercion *)
+
+module Test1 = struct
+  type t = private int
+  let f x = let y = if true then x else (x:t) in (y :> int)
+end;;
+[%%expect {|
+module Test1 : sig type t = private int val f : t -> int end
+|}, Principal{|
+Line 3, characters 49-59:
+3 |   let f x = let y = if true then x else (x:t) in (y :> int)
+                                                     ^^^^^^^^^^
+Warning 18: this ground coercion is not principal.
+module Test1 : sig type t = private int val f : t -> int end
+|}]
diff --git a/testsuite/tests/typing-warnings/exhaustiveness.ml b/testsuite/tests/typing-warnings/exhaustiveness.ml
new file mode 100644
index 00000000..1ed1aefc
--- /dev/null
+++ b/testsuite/tests/typing-warnings/exhaustiveness.ml
@@ -0,0 +1,371 @@
+(* TEST
+   flags = " -w A -strict-sequence "
+   * expect
+*)
+
+(* Warn about all relevant cases when possible *)
+let f = function
+    None, None -> 1
+  | Some _, Some _ -> 2;;
+[%%expect {|
+Lines 1-3, characters 8-23:
+1 | ........function
+2 |     None, None -> 1
+3 |   | Some _, Some _ -> 2..
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+((Some _, None)|(None, Some _))
+val f : 'a option * 'b option -> int = 
+|}]
+
+(* Exhaustiveness check is very slow *)
+type _ t =
+  A : int t | B : bool t | C : char t | D : float t
+type (_,_,_,_) u = U : (int, int, int, int) u
+type v = E | F | G
+;;
+[%%expect {|
+type _ t = A : int t | B : bool t | C : char t | D : float t
+type (_, _, _, _) u = U : (int, int, int, int) u
+type v = E | F | G
+|}]
+
+let f : type a b c d e f g.
+      a t * b t * c t * d t * e t * f t * g t * v
+       * (a,b,c,d) u * (e,f,g,g) u -> int =
+ function A, A, A, A, A, A, A, _, U, U -> 1
+   | _, _, _, _, _, _, _, G, _, _ -> 1
+   (*| _ -> _ *)
+;;
+[%%expect {|
+Lines 4-5, characters 1-38:
+4 | .function A, A, A, A, A, A, A, _, U, U -> 1
+5 |    | _, _, _, _, _, _, _, G, _, _ -> 1
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(A, A, A, A, A, A, B, (E|F), _, _)
+Line 5, characters 5-33:
+5 |    | _, _, _, _, _, _, _, G, _, _ -> 1
+         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 56: this match case is unreachable.
+Consider replacing it with a refutation case ' -> .'
+val f :
+  'a t * 'b t * 'c t * 'd t * 'e t * 'f t * 'g t * v * ('a, 'b, 'c, 'd) u *
+  ('e, 'f, 'g, 'g) u -> int = 
+|}]
+
+(* Unused cases *)
+let f (x : int t) = match x with A -> 1 | _ -> 2;; (* warn *)
+[%%expect {|
+Line 1, characters 20-48:
+1 | let f (x : int t) = match x with A -> 1 | _ -> 2;; (* warn *)
+                        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 4: this pattern-matching is fragile.
+It will remain exhaustive when constructors are added to type t.
+Line 1, characters 42-43:
+1 | let f (x : int t) = match x with A -> 1 | _ -> 2;; (* warn *)
+                                              ^
+Warning 56: this match case is unreachable.
+Consider replacing it with a refutation case ' -> .'
+val f : int t -> int = 
+|}]
+
+let f (x : unit t option) = match x with None -> 1 | _ -> 2 ;; (* warn? *)
+[%%expect {|
+Line 1, characters 53-54:
+1 | let f (x : unit t option) = match x with None -> 1 | _ -> 2 ;; (* warn? *)
+                                                         ^
+Warning 56: this match case is unreachable.
+Consider replacing it with a refutation case ' -> .'
+val f : unit t option -> int = 
+|}]
+
+let f (x : unit t option) = match x with None -> 1 | Some _ -> 2 ;; (* warn *)
+[%%expect {|
+Line 1, characters 53-59:
+1 | let f (x : unit t option) = match x with None -> 1 | Some _ -> 2 ;; (* warn *)
+                                                         ^^^^^^
+Warning 56: this match case is unreachable.
+Consider replacing it with a refutation case ' -> .'
+val f : unit t option -> int = 
+|}]
+
+let f (x : int t option) = match x with None -> 1 | _ -> 2;;
+[%%expect {|
+val f : int t option -> int = 
+|}]
+
+let f (x : int t option) = match x with None -> 1;; (* warn *)
+[%%expect {|
+Line 1, characters 27-49:
+1 | let f (x : int t option) = match x with None -> 1;; (* warn *)
+                               ^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Some A
+val f : int t option -> int = 
+|}]
+
+(* Example with record, type, single case *)
+
+type 'a box = Box of 'a
+type 'a pair = {left: 'a; right: 'a};;
+[%%expect {|
+type 'a box = Box of 'a
+type 'a pair = { left : 'a; right : 'a; }
+|}]
+
+let f : (int t box pair * bool) option -> unit = function None -> ();;
+[%%expect {|
+Line 1, characters 49-68:
+1 | let f : (int t box pair * bool) option -> unit = function None -> ();;
+                                                     ^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Some ({left=Box A; right=Box A}, _)
+val f : (int t box pair * bool) option -> unit = 
+|}]
+
+let f : (string t box pair * bool) option -> unit = function None -> ();;
+[%%expect {|
+val f : (string t box pair * bool) option -> unit = 
+|}]
+
+let f = function {left=Box 0; _ } -> ();;
+[%%expect {|
+Line 1, characters 8-39:
+1 | let f = function {left=Box 0; _ } -> ();;
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+{left=Box 1; _ }
+val f : int box pair -> unit = 
+|}]
+
+let f = function {left=Box 0;right=Box 1} -> ();;
+[%%expect {|
+Line 1, characters 8-47:
+1 | let f = function {left=Box 0;right=Box 1} -> ();;
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+({left=Box 0; right=Box 0}|{left=Box 1; right=Box _})
+val f : int box pair -> unit = 
+|}]
+
+(* Examples from ML2015 paper *)
+
+type _ t =
+  | Int : int t
+  | Bool : bool t
+;;
+[%%expect {|
+type _ t = Int : int t | Bool : bool t
+|}]
+
+let f : type a. a t -> a = function
+  | Int -> 1
+  | Bool -> true
+;;
+[%%expect {|
+val f : 'a t -> 'a = 
+|}]
+
+let g : int t -> int = function
+  | Int -> 1
+;;
+[%%expect {|
+val g : int t -> int = 
+|}]
+
+let h : type a. a t -> a t -> bool =
+  fun x y -> match x, y with
+  | Int, Int -> true
+  | Bool, Bool -> true
+;;
+[%%expect {|
+val h : 'a t -> 'a t -> bool = 
+|}]
+
+type (_, _) cmp =
+ | Eq : ('a, 'a) cmp
+ | Any: ('a, 'b) cmp
+module A : sig type a type b val eq : (a, b) cmp end
+  = struct type a type b = a let eq = Eq end
+;;
+[%%expect {|
+type (_, _) cmp = Eq : ('a, 'a) cmp | Any : ('a, 'b) cmp
+module A : sig type a type b val eq : (a, b) cmp end
+|}]
+
+let f : (A.a, A.b) cmp -> unit = function Any -> ()
+;;
+[%%expect {|
+Line 1, characters 33-51:
+1 | let f : (A.a, A.b) cmp -> unit = function Any -> ()
+                                     ^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Eq
+val f : (A.a, A.b) cmp -> unit = 
+|}]
+
+let deep : char t option -> char =
+  function None -> 'c'
+;;
+[%%expect {|
+val deep : char t option -> char = 
+|}]
+
+type zero = Zero
+type _ succ = Succ
+;;
+[%%expect {|
+type zero = Zero
+type _ succ = Succ
+|}]
+
+type (_,_,_) plus =
+  | Plus0 : (zero, 'a, 'a) plus
+  | PlusS : ('a, 'b, 'c) plus ->
+       ('a succ, 'b, 'c succ) plus
+;;
+[%%expect {|
+type (_, _, _) plus =
+    Plus0 : (zero, 'a, 'a) plus
+  | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus
+|}]
+
+let trivial : (zero succ, zero, zero) plus option -> bool =
+  function None -> false
+;;
+[%%expect {|
+val trivial : (zero succ, zero, zero) plus option -> bool = 
+|}]
+
+let easy : (zero, zero succ, zero) plus option -> bool =
+  function None -> false
+;;
+[%%expect {|
+val easy : (zero, zero succ, zero) plus option -> bool = 
+|}]
+
+let harder : (zero succ, zero succ, zero succ) plus option -> bool =
+  function None -> false
+;;
+[%%expect {|
+Line 2, characters 2-24:
+2 |   function None -> false
+      ^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Some (PlusS _)
+val harder : (zero succ, zero succ, zero succ) plus option -> bool = 
+|}]
+
+let harder : (zero succ, zero succ, zero succ) plus option  -> bool =
+  function None -> false | Some (PlusS _) -> .
+;;
+[%%expect {|
+val harder : (zero succ, zero succ, zero succ) plus option -> bool = 
+|}]
+
+let inv_zero : type a b c d. (a,b,c) plus -> (c,d,zero) plus -> bool =
+  fun p1 p2 ->
+    match p1, p2 with
+    | Plus0, Plus0 -> true
+;;
+[%%expect {|
+val inv_zero : ('a, 'b, 'c) plus -> ('c, 'd, zero) plus -> bool = 
+|}]
+
+
+(* Empty match *)
+
+type _ t = Int : int t;;
+[%%expect {|
+type _ t = Int : int t
+|}]
+
+let f (x : bool t) = match x with _ -> . ;; (* ok *)
+[%%expect {|
+val f : bool t -> 'a = 
+|}]
+
+
+(* trefis in PR#6437 *)
+
+let f () = match None with _ -> .;; (* error *)
+[%%expect {|
+Line 1, characters 27-28:
+1 | let f () = match None with _ -> .;; (* error *)
+                               ^
+Error: This match case could not be refuted.
+       Here is an example of a value that would reach it: _
+|}]
+
+let g () = match None with _ -> () | exception _ -> .;; (* error *)
+[%%expect {|
+Line 1, characters 47-48:
+1 | let g () = match None with _ -> () | exception _ -> .;; (* error *)
+                                                   ^
+Error: This match case could not be refuted.
+       Here is an example of a value that would reach it: _
+|}]
+
+let h () = match None with _ -> .  | exception _ -> .;; (* error *)
+[%%expect {|
+Line 1, characters 27-28:
+1 | let h () = match None with _ -> .  | exception _ -> .;; (* error *)
+                               ^
+Error: This match case could not be refuted.
+       Here is an example of a value that would reach it: _
+|}]
+
+let f x = match x with _ -> () | None -> .;; (* do not warn *)
+[%%expect {|
+val f : 'a option -> unit = 
+|}]
+
+(* #7059, all clauses guarded *)
+
+let f x y = match 1 with 1 when x = y -> 1;;
+[%%expect {|
+Line 1, characters 12-42:
+1 | let f x y = match 1 with 1 when x = y -> 1;;
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+All clauses in this pattern-matching are guarded.
+val f : 'a -> 'a -> int = 
+|}]
+
+(* #7504, Example with no constraints on a record *)
+let f = function {contents=_}, 0 -> 0;;
+[%%expect {|
+Line 1, characters 8-37:
+1 | let f = function {contents=_}, 0 -> 0;;
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+(_, 1)
+val f : 'a ref * int -> int = 
+|}]
+
+(* inexhaustive however some guarded clause might match *)
+let f = function
+  | None -> ()
+  | Some x when x > 0 -> ()
+  | Some x when x <= 0 -> ()
+;;
+[%%expect {|
+Lines 1-4, characters 8-28:
+1 | ........function
+2 |   | None -> ()
+3 |   | Some x when x > 0 -> ()
+4 |   | Some x when x <= 0 -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Some _
+(However, some guarded clause may match this value.)
+val f : int option -> unit = 
+|}]
diff --git a/testsuite/tests/typing-warnings/never_returns.ml b/testsuite/tests/typing-warnings/never_returns.ml
new file mode 100644
index 00000000..6b5aac60
--- /dev/null
+++ b/testsuite/tests/typing-warnings/never_returns.ml
@@ -0,0 +1,37 @@
+(* TEST
+   flags = " -w -a+21 "
+   * expect
+*)
+
+let () = (let module L = List in raise Exit); () ;;
+[%%expect {|
+Line 1, characters 33-43:
+1 | let () = (let module L = List in raise Exit); () ;;
+                                     ^^^^^^^^^^
+Warning 21: this statement never returns (or has an unsound type.)
+Exception: Stdlib.Exit.
+|}]
+let () = (let exception E in raise Exit); ();;
+[%%expect {|
+Line 1, characters 29-39:
+1 | let () = (let exception E in raise Exit); ();;
+                                 ^^^^^^^^^^
+Warning 21: this statement never returns (or has an unsound type.)
+Exception: Stdlib.Exit.
+|}]
+let () = (raise Exit : _); ();;
+[%%expect {|
+Line 1, characters 10-20:
+1 | let () = (raise Exit : _); ();;
+              ^^^^^^^^^^
+Warning 21: this statement never returns (or has an unsound type.)
+Exception: Stdlib.Exit.
+|}]
+let () = (let open Stdlib in raise Exit); ();;
+[%%expect {|
+Line 1, characters 29-39:
+1 | let () = (let open Stdlib in raise Exit); ();;
+                                 ^^^^^^^^^^
+Warning 21: this statement never returns (or has an unsound type.)
+Exception: Stdlib.Exit.
+|}]
diff --git a/testsuite/tests/typing-warnings/open_warnings.ml b/testsuite/tests/typing-warnings/open_warnings.ml
new file mode 100644
index 00000000..e6c65691
--- /dev/null
+++ b/testsuite/tests/typing-warnings/open_warnings.ml
@@ -0,0 +1,229 @@
+(* TEST
+   flags = " -w A-41-42-18"
+   * expect
+*)
+module T1 : sig end = struct
+  module M = struct type t end  (* unused type t *)
+  open M  (* unused open *)
+end;;
+[%%expect{|
+Line 2, characters 20-26:
+2 |   module M = struct type t end  (* unused type t *)
+                        ^^^^^^
+Warning 34: unused type t.
+Line 3, characters 2-8:
+3 |   open M  (* unused open *)
+      ^^^^^^
+Warning 33: unused open M.
+module T1 : sig end
+|}]
+
+
+module T2 : sig type s end = struct
+  module M = struct type t end
+  open M  (* used by line below *)
+  type s = t
+end;;
+[%%expect{|
+module T2 : sig type s end
+|}]
+
+module T3 : sig end = struct
+  type t0 = A  (* unused type and constructor *)
+  module M = struct type t = A end
+  open M (* used by line below; shadow constructor A *)
+  let _ = A (* A belongs to several types *)
+end;;
+[%%expect{|
+Line 4, characters 2-8:
+4 |   open M (* used by line below; shadow constructor A *)
+      ^^^^^^
+Warning 45: this open statement shadows the constructor A (which is later used)
+Line 2, characters 2-13:
+2 |   type t0 = A  (* unused type and constructor *)
+      ^^^^^^^^^^^
+Warning 34: unused type t0.
+Line 2, characters 12-13:
+2 |   type t0 = A  (* unused type and constructor *)
+                ^
+Warning 37: unused constructor A.
+module T3 : sig end
+|}]
+
+module T4 : sig end = struct
+  type t0 = A
+  module M = struct type t = A end (* unused type and constructor *)
+  open M (* unused open; no shadowing (A below refers to the one in t0) *)
+  let _ : t0 = A (* disambiguation used *)
+end;;
+[%%expect{|
+Line 3, characters 20-30:
+3 |   module M = struct type t = A end (* unused type and constructor *)
+                        ^^^^^^^^^^
+Warning 34: unused type t.
+Line 3, characters 29-30:
+3 |   module M = struct type t = A end (* unused type and constructor *)
+                                 ^
+Warning 37: unused constructor A.
+Line 4, characters 2-8:
+4 |   open M (* unused open; no shadowing (A below refers to the one in t0) *)
+      ^^^^^^
+Warning 33: unused open M.
+module T4 : sig end
+|}]
+
+module T5 : sig end = struct
+  type t0 = A (* unused type and constructor *)
+  module M = struct type t = A end
+  open M (* shadow constructor A *)
+  let _ : t = A
+end;;
+[%%expect{|
+Line 4, characters 2-8:
+4 |   open M (* shadow constructor A *)
+      ^^^^^^
+Warning 45: this open statement shadows the constructor A (which is later used)
+Line 2, characters 2-13:
+2 |   type t0 = A (* unused type and constructor *)
+      ^^^^^^^^^^^
+Warning 34: unused type t0.
+Line 2, characters 12-13:
+2 |   type t0 = A (* unused type and constructor *)
+                ^
+Warning 37: unused constructor A.
+module T5 : sig end
+|}]
+
+
+module T1_bis : sig end = struct
+  module M = struct type t end  (* unused type t *)
+  open! M  (* unused open *)
+end;;
+[%%expect{|
+Line 2, characters 20-26:
+2 |   module M = struct type t end  (* unused type t *)
+                        ^^^^^^
+Warning 34: unused type t.
+Line 3, characters 2-9:
+3 |   open! M  (* unused open *)
+      ^^^^^^^
+Warning 66: unused open! M.
+module T1_bis : sig end
+|}]
+
+module T2_bis : sig type s end = struct
+  module M = struct type t end
+  open! M  (* used by line below *)
+  type s = t
+end;;
+[%%expect{|
+module T2_bis : sig type s end
+|}]
+
+module T3_bis : sig end = struct
+  type t0 = A  (* unused type and constructor *)
+  module M = struct type t = A end
+  open! M (* used by line below; shadow constructor A (disabled) *)
+  let _ = A (* A belongs to several types *)
+end;;
+[%%expect{|
+Line 2, characters 2-13:
+2 |   type t0 = A  (* unused type and constructor *)
+      ^^^^^^^^^^^
+Warning 34: unused type t0.
+Line 2, characters 12-13:
+2 |   type t0 = A  (* unused type and constructor *)
+                ^
+Warning 37: unused constructor A.
+module T3_bis : sig end
+|}]
+
+module T4_bis : sig end = struct
+  type t0 = A
+  module M = struct type t = A end (* unused type and constructor *)
+  open! M (* unused open; no shadowing (A below refers to the one in t0) *)
+  let _ : t0 = A (* disambiguation used *)
+end;;
+[%%expect{|
+Line 3, characters 20-30:
+3 |   module M = struct type t = A end (* unused type and constructor *)
+                        ^^^^^^^^^^
+Warning 34: unused type t.
+Line 3, characters 29-30:
+3 |   module M = struct type t = A end (* unused type and constructor *)
+                                 ^
+Warning 37: unused constructor A.
+Line 4, characters 2-9:
+4 |   open! M (* unused open; no shadowing (A below refers to the one in t0) *)
+      ^^^^^^^
+Warning 66: unused open! M.
+module T4_bis : sig end
+|}]
+
+module T5_bis : sig end = struct
+  type t0 = A (* unused type and constructor *)
+  module M = struct type t = A end
+  open! M (* shadow constructor A (disabled) *)
+  let _ : t = A
+end;;
+[%%expect{|
+Line 2, characters 2-13:
+2 |   type t0 = A (* unused type and constructor *)
+      ^^^^^^^^^^^
+Warning 34: unused type t0.
+Line 2, characters 12-13:
+2 |   type t0 = A (* unused type and constructor *)
+                ^
+Warning 37: unused constructor A.
+module T5_bis : sig end
+|}]
+
+
+module T6 : sig end = struct
+  (* GPR9170 *)
+  module M = struct
+    type t = [`A | `B]
+  end
+  module type S = sig
+    open M
+    val f: #t -> unit
+  end
+  let _ = fun ((module S : S)) -> S.f `A
+end;;
+[%%expect {|
+Line 8, characters 11-13:
+8 |     val f: #t -> unit
+               ^^
+Alert deprecated: old syntax for polymorphic variant type
+module T6 : sig end
+|}]
+
+module T7 : sig end = struct
+  (* GPR9170 *)
+  module M = struct
+    class type t = object end
+  end
+  module type S = sig
+    open M
+    val f: #t -> unit
+  end
+  let _ = fun ((module S : S)) -> S.f (object end)
+end;;
+[%%expect {|
+module T7 : sig end
+|}]
+
+module T8 : sig end = struct
+  (* GPR9170 *)
+  module M = struct
+    class t = object end
+  end
+  module type S = sig
+    open M
+    val f: #t -> unit
+  end
+  let _ = fun ((module S : S)) -> S.f (object end)
+end;;
+[%%expect {|
+module T8 : sig end
+|}]
diff --git a/testsuite/tests/typing-warnings/pr5892.ml b/testsuite/tests/typing-warnings/pr5892.ml
new file mode 100644
index 00000000..46213d74
--- /dev/null
+++ b/testsuite/tests/typing-warnings/pr5892.ml
@@ -0,0 +1,24 @@
+(* TEST
+   flags = " -w A -strict-sequence "
+   * expect
+*)
+
+open CamlinternalOO;;
+
+type _ choice = Left : label choice | Right : tag choice;;
+[%%expect {|
+type _ choice =
+    Left : CamlinternalOO.label choice
+  | Right : CamlinternalOO.tag choice
+|}]
+
+let f : label choice -> bool = function Left -> true;; (* warn *)
+[%%expect {|
+Line 1, characters 31-52:
+1 | let f : label choice -> bool = function Left -> true;; (* warn *)
+                                   ^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Right
+val f : CamlinternalOO.label choice -> bool = 
+|}]
diff --git a/testsuite/tests/typing-warnings/pr6587.ml b/testsuite/tests/typing-warnings/pr6587.ml
new file mode 100644
index 00000000..665f6ed7
--- /dev/null
+++ b/testsuite/tests/typing-warnings/pr6587.ml
@@ -0,0 +1,39 @@
+(* TEST
+   flags = " -w A -strict-sequence "
+   * expect
+*)
+
+
+module A: sig val f: fpclass -> fpclass end =
+  struct
+    let f _ = FP_normal
+  end;;
+[%%expect {|
+module A : sig val f : fpclass -> fpclass end
+|}]
+
+type fpclass = A ;;
+[%%expect {|
+type fpclass = A
+|}]
+
+module B: sig val f: fpclass -> fpclass end =
+  struct
+    let f A = FP_normal
+  end
+    ;;
+[%%expect {|
+Lines 2-4, characters 2-5:
+2 | ..struct
+3 |     let f A = FP_normal
+4 |   end
+Error: Signature mismatch:
+       Modules do not match:
+         sig val f : fpclass -> Stdlib.fpclass end
+       is not included in
+         sig val f : fpclass -> fpclass end
+       Values do not match:
+         val f : fpclass -> Stdlib.fpclass
+       is not included in
+         val f : fpclass -> fpclass
+|}]
diff --git a/testsuite/tests/typing-warnings/pr6872.ml b/testsuite/tests/typing-warnings/pr6872.ml
new file mode 100644
index 00000000..2bf9b848
--- /dev/null
+++ b/testsuite/tests/typing-warnings/pr6872.ml
@@ -0,0 +1,89 @@
+(* TEST
+   flags = " -w A -strict-sequence "
+   * expect
+*)
+
+(* Ignore OCAMLRUNPARAM=b to be reproducible *)
+Printexc.record_backtrace false
+[%%expect {|
+- : unit = ()
+|}]
+;;
+
+exception A
+[%%expect {|
+exception A
+|}]
+;;
+
+type a = A
+[%%expect {|
+type a = A
+|}]
+;;
+
+A
+[%%expect {|
+Line 1, characters 0-1:
+1 | A
+    ^
+Warning 41: A belongs to several types: a exn
+The first one was selected. Please disambiguate if this is wrong.
+- : a = A
+|}]
+;;
+
+raise A
+[%%expect {|
+Line 1, characters 6-7:
+1 | raise A
+          ^
+Warning 42: this use of A relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Exception: A.
+|}]
+;;
+
+fun (A : a) -> ()
+[%%expect {|
+- : a -> unit = 
+|}]
+;;
+
+function Not_found -> 1 | A -> 2 | _ -> 3
+[%%expect {|
+Line 1, characters 26-27:
+1 | function Not_found -> 1 | A -> 2 | _ -> 3
+                              ^
+Warning 42: this use of A relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+- : exn -> int = 
+|}, Principal{|
+Line 1, characters 26-27:
+1 | function Not_found -> 1 | A -> 2 | _ -> 3
+                              ^
+Warning 41: A belongs to several types: a exn
+The first one was selected. Please disambiguate if this is wrong.
+Line 1, characters 26-27:
+1 | function Not_found -> 1 | A -> 2 | _ -> 3
+                              ^
+Error: This pattern matches values of type a
+       but a pattern was expected which matches values of type exn
+|}]
+;;
+
+try raise A with A -> 2
+[%%expect {|
+Line 1, characters 10-11:
+1 | try raise A with A -> 2
+              ^
+Warning 42: this use of A relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 1, characters 17-18:
+1 | try raise A with A -> 2
+                     ^
+Warning 42: this use of A relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+- : int = 2
+|}]
+;;
diff --git a/testsuite/tests/typing-warnings/pr7085.ml b/testsuite/tests/typing-warnings/pr7085.ml
new file mode 100644
index 00000000..0307b468
--- /dev/null
+++ b/testsuite/tests/typing-warnings/pr7085.ml
@@ -0,0 +1,50 @@
+(* TEST
+   flags = " -w A -strict-sequence "
+   * expect
+*)
+
+module TypEq = struct
+ type (_, _) t = Eq : ('a, 'a) t
+end
+
+module type T = sig
+ type _ is_t = Is : ('a, 'b) TypEq.t -> 'a is_t
+ val is_t : unit -> unit is_t option
+end
+
+module Make (M : T) =
+ struct
+   let _ =
+     match M.is_t () with
+     | None -> 0
+     | Some _ -> 0
+   let f () =
+     match M.is_t () with None -> 0
+end;;
+[%%expect {|
+module TypEq : sig type (_, _) t = Eq : ('a, 'a) t end
+module type T =
+  sig
+    type _ is_t = Is : ('a, 'b) TypEq.t -> 'a is_t
+    val is_t : unit -> unit is_t option
+  end
+Line 17, characters 5-35:
+17 |      match M.is_t () with None -> 0
+          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: 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 Make2 (M : T) = struct
+  type t = T of unit M.is_t
+  let g : t -> int = function _ -> .
+end;;
+[%%expect {|
+Line 3, characters 30-31:
+3 |   let g : t -> int = function _ -> .
+                                  ^
+Error: This match case could not be refuted.
+       Here is an example of a value that would reach it: T (Is Eq)
+|}]
diff --git a/testsuite/tests/typing-warnings/pr7115.ml b/testsuite/tests/typing-warnings/pr7115.ml
new file mode 100644
index 00000000..f4f5c35b
--- /dev/null
+++ b/testsuite/tests/typing-warnings/pr7115.ml
@@ -0,0 +1,53 @@
+(* TEST
+   flags = " -w A -strict-sequence "
+   * expect
+*)
+
+type t = A : t;;
+[%%expect {|
+type t = A : t
+|}]
+
+module X1 : sig end = struct
+  let _f ~x (* x unused argument *) = function
+    | A -> let x = () in x
+end;;
+[%%expect {|
+Line 2, characters 10-11:
+2 |   let _f ~x (* x unused argument *) = function
+              ^
+Warning 27: unused variable x.
+module X1 : sig end
+|}]
+
+module X2 : sig end = struct
+  let x = 42 (* unused value *)
+  let _f = function
+    | A -> let x = () in x
+end;;
+[%%expect {|
+Line 2, characters 6-7:
+2 |   let x = 42 (* unused value *)
+          ^
+Warning 32: unused value x.
+module X2 : sig end
+|}]
+
+module X3 : sig end = struct
+  module O = struct let x = 42 (* unused *) end
+  open O (* unused open *)
+
+  let _f = function
+    | A -> let x = () in x
+end;;
+[%%expect {|
+Line 2, characters 24-25:
+2 |   module O = struct let x = 42 (* unused *) end
+                            ^
+Warning 32: unused value x.
+Line 3, characters 2-8:
+3 |   open O (* unused open *)
+      ^^^^^^
+Warning 33: unused open O.
+module X3 : sig end
+|}]
diff --git a/testsuite/tests/typing-warnings/pr7261.compilers.reference b/testsuite/tests/typing-warnings/pr7261.compilers.reference
new file mode 100644
index 00000000..671e51d8
--- /dev/null
+++ b/testsuite/tests/typing-warnings/pr7261.compilers.reference
@@ -0,0 +1,10 @@
+Line 7, characters 19-21:
+7 |     Foo: [> `Bla ] as 'b ) * 'b -> foo;;
+                       ^^
+Error: Syntax error
+Line 2, characters 35-49:
+2 |     Foo: 'b * 'b -> foo constraint 'b = [> `Bla ];;
+                                       ^^^^^^^^^^^^^^
+Warning 62: Type constraints do not apply to GADT cases of variant types.
+type foo = Foo : 'b * 'b -> foo
+
diff --git a/testsuite/tests/typing-warnings/pr7261.ml b/testsuite/tests/typing-warnings/pr7261.ml
new file mode 100644
index 00000000..ecbbdda2
--- /dev/null
+++ b/testsuite/tests/typing-warnings/pr7261.ml
@@ -0,0 +1,9 @@
+(* TEST
+   flags = " -w A -strict-sequence "
+   * toplevel
+*)
+
+type foo =
+    Foo: [> `Bla ] as 'b ) * 'b -> foo;;
+type foo =
+    Foo: 'b * 'b -> foo constraint 'b = [> `Bla ];;
diff --git a/testsuite/tests/typing-warnings/pr7297.compilers.reference b/testsuite/tests/typing-warnings/pr7297.compilers.reference
new file mode 100644
index 00000000..14402e75
--- /dev/null
+++ b/testsuite/tests/typing-warnings/pr7297.compilers.reference
@@ -0,0 +1,7 @@
+- : unit = ()
+Characters 10-20:
+  let () = raise Exit; () ;; (* warn *)
+           ^^^^^^^^^^
+Warning 21: this statement never returns (or has an unsound type.)
+Exception: Stdlib.Exit.
+
diff --git a/testsuite/tests/typing-warnings/pr7297.ml b/testsuite/tests/typing-warnings/pr7297.ml
new file mode 100644
index 00000000..99131274
--- /dev/null
+++ b/testsuite/tests/typing-warnings/pr7297.ml
@@ -0,0 +1,19 @@
+(* TEST
+   flags = " -w A -strict-sequence "
+   * expect
+*)
+
+(* Ignore OCAMLRUNPARAM=b to be reproducible *)
+Printexc.record_backtrace false;;
+[%%expect {|
+- : unit = ()
+|}]
+
+let () = raise Exit; () ;; (* warn *)
+[%%expect {|
+Line 1, characters 9-19:
+1 | let () = raise Exit; () ;; (* warn *)
+             ^^^^^^^^^^
+Warning 21: this statement never returns (or has an unsound type.)
+Exception: Stdlib.Exit.
+|}]
diff --git a/testsuite/tests/typing-warnings/pr7553.ml b/testsuite/tests/typing-warnings/pr7553.ml
new file mode 100644
index 00000000..d479c419
--- /dev/null
+++ b/testsuite/tests/typing-warnings/pr7553.ml
@@ -0,0 +1,50 @@
+(* TEST
+   flags = " -w A -strict-sequence "
+   * expect
+*)
+
+module A = struct type foo end;;
+[%%expect {|
+module A : sig type foo end
+|}]
+
+module rec B : sig
+  open A
+  type bar = Bar of foo
+end = B;;
+[%%expect {|
+module rec B : sig type bar = Bar of A.foo end
+|}]
+
+module rec C : sig
+  open A
+end = C;;
+[%%expect {|
+Line 2, characters 2-8:
+2 |   open A
+      ^^^^^^
+Warning 33: unused open A.
+module rec C : sig end
+|}]
+
+module rec D : sig
+  module M : module type of struct
+    module X : sig end = struct
+      open A
+      let None = None
+    end
+  end
+end = D;;
+[%%expect {|
+Line 5, characters 10-14:
+5 |       let None = None
+              ^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Some _
+Line 4, characters 6-12:
+4 |       open A
+          ^^^^^^
+Warning 33: unused open A.
+module rec D : sig module M : sig module X : sig end end end
+|}]
diff --git a/testsuite/tests/typing-warnings/pr9244.ml b/testsuite/tests/typing-warnings/pr9244.ml
new file mode 100644
index 00000000..01b9d08e
--- /dev/null
+++ b/testsuite/tests/typing-warnings/pr9244.ml
@@ -0,0 +1,55 @@
+(* TEST
+   flags = " -w A "
+   * expect
+*)
+
+module type U = sig end
+[%%expect {|
+module type U = sig end
+|}]
+
+module M : sig
+  module F2 (_ : U) : U
+end = struct
+  module X = struct
+    let x = 13
+  end
+
+  module F1 (_ : U) = X
+  module F2 (M : U) = F1 (M)
+end
+[%%expect {|
+Line 5, characters 8-9:
+5 |     let x = 13
+            ^
+Warning 32: unused value x.
+module M : sig module F2 : U -> U end
+|}]
+
+module N : sig
+  module F2 (_ : U) : U
+end = struct
+  module X = struct
+    let x = 13
+  end
+
+  module F1 (_ : U) = X
+  module F2 (_ : U) = F1 (struct end)
+end
+[%%expect {|
+Line 5, characters 8-9:
+5 |     let x = 13
+            ^
+Warning 32: unused value x.
+module N : sig module F2 : U -> U end
+|}]
+
+
+module F (X : sig type t type s end) = struct type t = X.t end
+[%%expect {|
+Line 1, characters 25-31:
+1 | module F (X : sig type t type s end) = struct type t = X.t end
+                             ^^^^^^
+Warning 34: unused type s.
+module F : functor (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
new file mode 100644
index 00000000..ed7ff7e7
--- /dev/null
+++ b/testsuite/tests/typing-warnings/records.ml
@@ -0,0 +1,672 @@
+(* TEST
+   flags = " -w A -strict-sequence "
+   * expect
+*)
+
+(* Use type information *)
+module M1 = struct
+  type t = {x: int; y: int}
+  type u = {x: bool; y: bool}
+end;;
+[%%expect{|
+module M1 :
+  sig type t = { x : int; y : int; } type u = { x : bool; y : bool; } end
+|}]
+
+module OK = struct
+  open M1
+  let f1 (r:t) = r.x (* ok *)
+  let f2 r = ignore (r:t); r.x (* non principal *)
+
+  let f3 (r: t) =
+    match r with {x; y} -> y + y (* ok *)
+end;;
+[%%expect{|
+Line 3, characters 19-20:
+3 |   let f1 (r:t) = r.x (* ok *)
+                       ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 4, characters 29-30:
+4 |   let f2 r = ignore (r:t); r.x (* non principal *)
+                                 ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 7, characters 18-19:
+7 |     match r with {x; y} -> y + y (* ok *)
+                      ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 7, characters 21-22:
+7 |     match r with {x; y} -> y + y (* ok *)
+                         ^
+Warning 42: this use of y relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 7, characters 18-19:
+7 |     match r with {x; y} -> y + y (* ok *)
+                      ^
+Warning 27: unused variable x.
+module OK :
+  sig val f1 : M1.t -> int val f2 : M1.t -> int val f3 : M1.t -> int end
+|}, Principal{|
+Line 3, characters 19-20:
+3 |   let f1 (r:t) = r.x (* ok *)
+                       ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 4, characters 29-30:
+4 |   let f2 r = ignore (r:t); r.x (* non principal *)
+                                 ^
+Warning 18: this type-based field disambiguation is not principal.
+Line 4, characters 29-30:
+4 |   let f2 r = ignore (r:t); r.x (* non principal *)
+                                 ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 7, characters 18-19:
+7 |     match r with {x; y} -> y + y (* ok *)
+                      ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 7, characters 21-22:
+7 |     match r with {x; y} -> y + y (* ok *)
+                         ^
+Warning 42: this use of y relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 7, characters 18-19:
+7 |     match r with {x; y} -> y + y (* ok *)
+                      ^
+Warning 27: unused variable x.
+module OK :
+  sig val f1 : M1.t -> int val f2 : M1.t -> int val f3 : M1.t -> int end
+|}]
+
+module F1 = struct
+  open M1
+  let f r = match r with {x; y} -> y + y
+end;; (* fails *)
+[%%expect{|
+Line 3, characters 25-31:
+3 |   let f r = match r with {x; y} -> y + y
+                             ^^^^^^
+Warning 41: these field labels belong to several types: M1.u M1.t
+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
+|}]
+
+module F2 = struct
+  open M1
+  let f r =
+    ignore (r: t);
+    match r with
+       {x; y} -> y + y
+end;; (* fails for -principal *)
+[%%expect{|
+Line 6, characters 8-9:
+6 |        {x; y} -> y + y
+            ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 6, characters 11-12:
+6 |        {x; y} -> y + y
+               ^
+Warning 42: this use of y relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 6, characters 8-9:
+6 |        {x; y} -> y + y
+            ^
+Warning 27: unused variable x.
+module F2 : sig val f : M1.t -> int end
+|}, Principal{|
+Line 6, characters 7-13:
+6 |        {x; y} -> y + y
+           ^^^^^^
+Warning 41: these field labels belong to several types: M1.u M1.t
+The first one was selected. Please disambiguate if this is wrong.
+Line 6, characters 7-13:
+6 |        {x; y} -> y + y
+           ^^^^^^
+Error: This pattern matches values of type M1.u
+       but a pattern was expected which matches values of type M1.t
+|}]
+
+(* Use type information with modules*)
+module M = struct
+  type t = {x:int}
+  type u = {x:bool}
+end;;
+[%%expect{|
+module M : sig type t = { x : int; } type u = { x : bool; } end
+|}]
+let f (r:M.t) = r.M.x;; (* ok *)
+[%%expect{|
+Line 1, characters 18-21:
+1 | let f (r:M.t) = r.M.x;; (* ok *)
+                      ^^^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+val f : M.t -> int = 
+|}]
+let f (r:M.t) = r.x;; (* warning *)
+[%%expect{|
+Line 1, characters 18-19:
+1 | let f (r:M.t) = r.x;; (* warning *)
+                      ^
+Warning 40: x was selected from type M.t.
+It is not visible in the current scope, and will not
+be selected if the type becomes unknown.
+Line 1, characters 18-19:
+1 | let f (r:M.t) = r.x;; (* warning *)
+                      ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+val f : M.t -> int = 
+|}]
+let f ({x}:M.t) = x;; (* warning *)
+[%%expect{|
+Line 1, characters 8-9:
+1 | let f ({x}:M.t) = x;; (* warning *)
+            ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 1, characters 7-10:
+1 | let f ({x}:M.t) = x;; (* warning *)
+           ^^^
+Warning 40: this record of type M.t contains fields that are
+not visible in the current scope: x.
+They will not be selected if the type becomes unknown.
+val f : M.t -> int = 
+|}]
+
+module M = struct
+  type t = {x: int; y: int}
+end;;
+[%%expect{|
+module M : sig type t = { x : int; y : int; } end
+|}]
+module N = struct
+  type u = {x: bool; y: bool}
+end;;
+[%%expect{|
+module N : sig type u = { x : bool; y : bool; } end
+|}]
+module OK = struct
+  open M
+  open N
+  let f (r:M.t) = r.x
+end;;
+[%%expect{|
+Line 4, characters 20-21:
+4 |   let f (r:M.t) = r.x
+                        ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 3, characters 2-8:
+3 |   open N
+      ^^^^^^
+Warning 33: unused open N.
+module OK : sig val f : M.t -> int end
+|}]
+
+module M = struct
+  type t = {x:int}
+  module N = struct type s = t = {x:int} end
+  type u = {x:bool}
+end;;
+[%%expect{|
+module M :
+  sig
+    type t = { x : int; }
+    module N : sig type s = t = { x : int; } end
+    type u = { x : bool; }
+  end
+|}]
+module OK = struct
+  open M.N
+  let f (r:M.t) = r.x
+end;;
+[%%expect{|
+module OK : sig val f : M.t -> int end
+|}]
+
+(* Use field information *)
+module M = struct
+  type u = {x:bool;y:int;z:char}
+  type t = {x:int;y:bool}
+end;;
+[%%expect{|
+module M :
+  sig
+    type u = { x : bool; y : int; z : char; }
+    type t = { x : int; y : bool; }
+  end
+|}]
+module OK = struct
+  open M
+  let f {x;z} = x,z
+end;; (* ok *)
+[%%expect{|
+Line 3, characters 9-10:
+3 |   let f {x;z} = x,z
+             ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 3, characters 8-13:
+3 |   let f {x;z} = x,z
+            ^^^^^
+Warning 9: the following labels are not bound in this record pattern:
+y
+Either bind these labels explicitly or add '; _' to the pattern.
+module OK : sig val f : M.u -> bool * char end
+|}]
+module F3 = struct
+  open M
+  let r = {x=true;z='z'}
+end;; (* fail for missing label *)
+[%%expect{|
+Line 3, characters 11-12:
+3 |   let r = {x=true;z='z'}
+               ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 3, characters 10-24:
+3 |   let r = {x=true;z='z'}
+              ^^^^^^^^^^^^^^
+Error: Some record fields are undefined: y
+|}]
+
+module OK = struct
+  type u = {x:int;y:bool}
+  type t = {x:bool;y:int;z:char}
+  let r = {x=3; y=true}
+end;; (* ok *)
+[%%expect{|
+Line 4, characters 11-12:
+4 |   let r = {x=3; y=true}
+               ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 4, characters 16-17:
+4 |   let r = {x=3; y=true}
+                    ^
+Warning 42: this use of y relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+module OK :
+  sig
+    type u = { x : int; y : bool; }
+    type t = { x : bool; y : int; z : char; }
+    val r : u
+  end
+|}]
+
+(* Corner cases *)
+
+module F4 = struct
+  type foo = {x:int; y:int}
+  type bar = {x:int}
+  let b : bar = {x=3; y=4}
+end;; (* fail but don't warn *)
+[%%expect{|
+Line 4, characters 22-23:
+4 |   let b : bar = {x=3; y=4}
+                          ^
+Error: This record expression is expected to have type bar
+       The field y does not belong to type bar
+|}]
+
+module M = struct type foo = {x:int;y:int} end;;
+[%%expect{|
+module M : sig type foo = { x : int; y : int; } end
+|}]
+module N = struct type bar = {x:int;y:int} end;;
+[%%expect{|
+module N : sig type bar = { x : int; y : int; } end
+|}]
+let r = { M.x = 3; N.y = 4; };; (* error: different definitions *)
+[%%expect{|
+Line 1, characters 19-22:
+1 | let r = { M.x = 3; N.y = 4; };; (* error: different definitions *)
+                       ^^^
+Error: The record field N.y belongs to the type N.bar
+       but is mixed here with fields of type M.foo
+|}]
+
+module MN = struct include M include N end
+module NM = struct include N include M end;;
+[%%expect{|
+module MN :
+  sig
+    type foo = M.foo = { x : int; y : int; }
+    type bar = N.bar = { x : int; y : int; }
+  end
+module NM :
+  sig
+    type bar = N.bar = { x : int; y : int; }
+    type foo = M.foo = { x : int; y : int; }
+  end
+|}]
+let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
+[%%expect{|
+Line 1, characters 8-28:
+1 | let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
+            ^^^^^^^^^^^^^^^^^^^^
+Warning 41: x belongs to several types: MN.bar MN.foo
+The first one was selected. Please disambiguate if this is wrong.
+Line 1, characters 8-28:
+1 | let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
+            ^^^^^^^^^^^^^^^^^^^^
+Warning 41: y belongs to several types: NM.foo NM.bar
+The first one was selected. Please disambiguate if this is wrong.
+Line 1, characters 19-23:
+1 | let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
+                       ^^^^
+Error: The record field NM.y belongs to the type NM.foo = M.foo
+       but is mixed here with fields of type MN.bar = N.bar
+|}]
+
+(* Lpw25 *)
+
+module M = struct
+  type foo = { x: int; y: int }
+  type bar = { x:int; y: int; z: int}
+end;;
+[%%expect{|
+module M :
+  sig
+    type foo = { x : int; y : int; }
+    type bar = { x : int; y : int; z : int; }
+  end
+|}]
+module F5 = struct
+  open M
+  let f r = ignore (r: foo); {r with x = 2; z = 3}
+end;;
+[%%expect{|
+Line 3, characters 37-38:
+3 |   let f r = ignore (r: foo); {r with x = 2; z = 3}
+                                         ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 3, characters 44-45:
+3 |   let f r = ignore (r: foo); {r with x = 2; z = 3}
+                                                ^
+Error: This record expression is expected to have type M.foo
+       The field z does not belong to type M.foo
+|}]
+module M = struct
+  include M
+  type other = { a: int; b: int }
+end;;
+[%%expect{|
+module M :
+  sig
+    type foo = M.foo = { x : int; y : int; }
+    type bar = M.bar = { x : int; y : int; z : int; }
+    type other = { a : int; b : int; }
+  end
+|}]
+module F6 = struct
+  open M
+  let f r = ignore (r: foo); { r with x = 3; a = 4 }
+end;;
+[%%expect{|
+Line 3, characters 38-39:
+3 |   let f r = ignore (r: foo); { r with x = 3; a = 4 }
+                                          ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 3, characters 45-46:
+3 |   let f r = ignore (r: foo); { r with x = 3; a = 4 }
+                                                 ^
+Error: This record expression is expected to have type M.foo
+       The field a does not belong to type M.foo
+|}]
+module F7 = struct
+  open M
+  let r = {x=1; y=2}
+  let r: other = {x=1; y=2}
+end;;
+[%%expect{|
+Line 3, characters 11-12:
+3 |   let r = {x=1; y=2}
+               ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 3, characters 16-17:
+3 |   let r = {x=1; y=2}
+                    ^
+Warning 42: this use of y relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 4, characters 18-19:
+4 |   let r: other = {x=1; y=2}
+                      ^
+Error: This record expression is expected to have type M.other
+       The field x does not belong to type M.other
+|}]
+
+module A = struct type t = {x: int} end
+module B = struct type t = {x: int} end;;
+[%%expect{|
+module A : sig type t = { x : int; } end
+module B : sig type t = { x : int; } end
+|}]
+let f (r : B.t) = r.A.x;; (* fail *)
+[%%expect{|
+Line 1, characters 20-23:
+1 | let f (r : B.t) = r.A.x;; (* fail *)
+                        ^^^
+Error: The field A.x belongs to the record type A.t
+       but a field was expected belonging to the record type B.t
+|}]
+
+(* Spellchecking *)
+
+module F8 = struct
+  type t = {x:int; yyy:int}
+  let a : t = {x=1;yyz=2}
+end;;
+[%%expect{|
+Line 3, characters 19-22:
+3 |   let a : t = {x=1;yyz=2}
+                       ^^^
+Error: This record expression is expected to have type t
+       The field yyz does not belong to type t
+Hint: Did you mean yyy?
+|}]
+
+(* PR#6004 *)
+
+type t = A
+type s = A
+
+class f (_ : t) = object end;;
+[%%expect{|
+type t = A
+type s = A
+class f : t -> object  end
+|}]
+class g = f A;; (* ok *)
+
+class f (_ : 'a) (_ : 'a) = object end;;
+[%%expect{|
+Line 1, characters 12-13:
+1 | class g = f A;; (* ok *)
+                ^
+Warning 42: this use of A relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+class g : f
+class f : 'a -> 'a -> object  end
+|}]
+class g = f (A : t) A;; (* warn with -principal *)
+[%%expect{|
+Line 1, characters 13-14:
+1 | class g = f (A : t) A;; (* warn with -principal *)
+                 ^
+Warning 42: this use of A relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 1, characters 20-21:
+1 | class g = f (A : t) A;; (* warn with -principal *)
+                        ^
+Warning 42: this use of A relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+class g : f
+|}, Principal{|
+Line 1, characters 13-14:
+1 | class g = f (A : t) A;; (* warn with -principal *)
+                 ^
+Warning 42: this use of A relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 1, characters 20-21:
+1 | class g = f (A : t) A;; (* warn with -principal *)
+                        ^
+Warning 18: this type-based constructor disambiguation is not principal.
+Line 1, characters 20-21:
+1 | class g = f (A : t) A;; (* warn with -principal *)
+                        ^
+Warning 42: this use of A relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+class g : f
+|}]
+
+
+(* PR#5980 *)
+
+module Shadow1 = struct
+  type t = {x: int}
+  module M = struct
+    type s = {x: string}
+  end
+  open M  (* this open is unused, it isn't reported as shadowing 'x' *)
+  let y : t = {x = 0}
+end;;
+[%%expect{|
+Line 7, characters 15-16:
+7 |   let y : t = {x = 0}
+                   ^
+Warning 42: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 6, characters 2-8:
+6 |   open M  (* this open is unused, it isn't reported as shadowing 'x' *)
+      ^^^^^^
+Warning 33: unused open M.
+module Shadow1 :
+  sig
+    type t = { x : int; }
+    module M : sig type s = { x : string; } end
+    val y : t
+  end
+|}]
+module Shadow2 = struct
+  type t = {x: int}
+  module M = struct
+    type s = {x: string}
+  end
+  open M  (* this open shadows label 'x' *)
+  let y = {x = ""}
+end;;
+[%%expect{|
+Line 6, characters 2-8:
+6 |   open M  (* this open shadows label 'x' *)
+      ^^^^^^
+Warning 45: this open statement shadows the label x (which is later used)
+Line 7, characters 10-18:
+7 |   let y = {x = ""}
+              ^^^^^^^^
+Warning 41: these field labels belong to several types: M.s t
+The first one was selected. Please disambiguate if this is wrong.
+module Shadow2 :
+  sig
+    type t = { x : int; }
+    module M : sig type s = { x : string; } end
+    val y : M.s
+  end
+|}]
+
+(* PR#6235 *)
+
+module P6235 = struct
+  type t = { loc : string; }
+  type v = { loc : string; x : int; }
+  type u = [ `Key of t ]
+  let f (u : u) = match u with `Key {loc} -> loc
+end;;
+[%%expect{|
+Line 5, characters 37-40:
+5 |   let f (u : u) = match u with `Key {loc} -> loc
+                                         ^^^
+Warning 42: this use of loc relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+module P6235 :
+  sig
+    type t = { loc : string; }
+    type v = { loc : string; x : int; }
+    type u = [ `Key of t ]
+    val f : u -> string
+  end
+|}]
+
+(* Remove interaction between branches *)
+
+module P6235' = struct
+  type t = { loc : string; }
+  type v = { loc : string; x : int; }
+  type u = [ `Key of t ]
+  let f = function
+    | (_ : u) when false -> ""
+    |`Key {loc} -> loc
+end;;
+[%%expect{|
+Line 7, characters 11-14:
+7 |     |`Key {loc} -> loc
+               ^^^
+Warning 42: this use of loc relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+module P6235' :
+  sig
+    type t = { loc : string; }
+    type v = { loc : string; x : int; }
+    type u = [ `Key of t ]
+    val f : u -> string
+  end
+|}, Principal{|
+Line 7, characters 10-15:
+7 |     |`Key {loc} -> loc
+              ^^^^^
+Warning 41: these field labels belong to several types: v t
+The first one was selected. Please disambiguate if this is wrong.
+Line 7, characters 10-15:
+7 |     |`Key {loc} -> loc
+              ^^^^^
+Warning 9: the following labels are not bound in this record pattern:
+x
+Either bind these labels explicitly or add '; _' to the pattern.
+Line 7, characters 5-15:
+7 |     |`Key {loc} -> loc
+         ^^^^^^^^^^
+Error: This pattern matches values of type [? `Key of v ]
+       but a pattern was expected which matches values of type u
+       Types for tag `Key are incompatible
+|}]
+
+(** no candidates after filtering;
+    This caused a temporary trunk regression identified by Florian Angeletti
+    while reviewing #9196
+ *)
+module M = struct
+  type t = { x:int; y:int}
+end
+type u = { a:int }
+let _ = ( { M.x=0 } : u );;
+[%%expect{|
+module M : sig type t = { x : int; y : int; } end
+type u = { a : int; }
+Line 5, characters 12-15:
+5 | let _ = ( { M.x=0 } : u );;
+                ^^^
+Error: The field M.x belongs to the record type M.t
+       but a field was expected belonging to the record type u
+|}]
diff --git a/testsuite/tests/typing-warnings/unused_functor_parameter.ml b/testsuite/tests/typing-warnings/unused_functor_parameter.ml
new file mode 100644
index 00000000..c8691af9
--- /dev/null
+++ b/testsuite/tests/typing-warnings/unused_functor_parameter.ml
@@ -0,0 +1,33 @@
+(* TEST
+   flags = " -w A "
+   * expect
+*)
+
+module Foo(Unused : sig end) = struct end;;
+[%%expect {|
+Line 1, characters 11-17:
+1 | module Foo(Unused : sig end) = struct end;;
+               ^^^^^^
+Warning 60: unused module Unused.
+module Foo : functor (Unused : sig end) -> sig end
+|}]
+
+module type S = functor (Unused : sig end) -> sig end;;
+[%%expect {|
+Line 1, characters 25-31:
+1 | module type S = functor (Unused : sig end) -> sig end;;
+                             ^^^^^^
+Warning 67: unused functor parameter Unused.
+module type S = functor (Unused : sig end) -> sig end
+|}]
+
+module type S = sig
+  module M (Unused : sig end) : sig end
+end;;
+[%%expect{|
+Line 2, characters 12-18:
+2 |   module M (Unused : sig end) : sig end
+                ^^^^^^
+Warning 67: unused functor parameter Unused.
+module type S = sig module M : functor (Unused : sig end) -> sig end end
+|}]
diff --git a/testsuite/tests/typing-warnings/unused_rec.ml b/testsuite/tests/typing-warnings/unused_rec.ml
new file mode 100644
index 00000000..0ba9849f
--- /dev/null
+++ b/testsuite/tests/typing-warnings/unused_rec.ml
@@ -0,0 +1,49 @@
+(* TEST
+   * expect
+*)
+
+[@@@ocaml.warning "+39"]
+
+let rec f () = 3;;
+[%%expect{|
+Line 3, characters 8-9:
+3 | let rec f () = 3;;
+            ^
+Warning 39: unused rec flag.
+val f : unit -> int = 
+|}];;
+
+let[@warning "-39"] rec g () = 3;;
+[%%expect{|
+val g : unit -> int = 
+|}];;
+
+let[@warning "+39"] rec h () = 3;;
+[%%expect{|
+Line 1, characters 24-25:
+1 | let[@warning "+39"] rec h () = 3;;
+                            ^
+Warning 39: unused rec flag.
+val h : unit -> int = 
+|}];;
+
+[@@@ocaml.warning "-39"]
+
+let rec f () = 3;;
+[%%expect{|
+val f : unit -> int = 
+|}];;
+
+let[@warning "-39"] rec g () = 3;;
+[%%expect{|
+val g : unit -> int = 
+|}];;
+
+let[@warning "+39"] rec h () = 3;;
+[%%expect{|
+Line 1, characters 24-25:
+1 | let[@warning "+39"] rec h () = 3;;
+                            ^
+Warning 39: unused rec flag.
+val h : unit -> int = 
+|}];;
diff --git a/testsuite/tests/typing-warnings/unused_recmodule.ml b/testsuite/tests/typing-warnings/unused_recmodule.ml
new file mode 100644
index 00000000..78ce42ef
--- /dev/null
+++ b/testsuite/tests/typing-warnings/unused_recmodule.ml
@@ -0,0 +1,31 @@
+(* TEST
+   * expect
+*)
+
+[@@@ocaml.warning "+a"]
+
+module M : sig end = struct
+  module rec Foo : sig
+    type t
+    val create : Bar.t -> t
+  end = struct
+    type t = unit
+
+    let create _ = ()
+  end
+
+  and Bar : sig
+    type t
+  end = struct
+    type t = unit
+  end
+
+  let _ = Foo.create
+end;;
+[%%expect{|
+Line 14, characters 4-10:
+14 |     type t
+         ^^^^^^
+Warning 34: unused type t.
+module M : sig end
+|}];;
diff --git a/testsuite/tests/typing-warnings/unused_types.ml b/testsuite/tests/typing-warnings/unused_types.ml
new file mode 100644
index 00000000..a7385e76
--- /dev/null
+++ b/testsuite/tests/typing-warnings/unused_types.ml
@@ -0,0 +1,347 @@
+(* TEST
+   flags = " -w A -strict-sequence "
+   * expect
+*)
+
+module Unused : sig
+end = struct
+  type unused = int
+end
+;;
+[%%expect {|
+Line 3, characters 2-19:
+3 |   type unused = int
+      ^^^^^^^^^^^^^^^^^
+Warning 34: unused type unused.
+module Unused : sig end
+|}]
+
+module Unused_nonrec : sig
+end = struct
+  type nonrec used = int
+  type nonrec unused = used
+end
+;;
+[%%expect {|
+Line 4, characters 2-27:
+4 |   type nonrec unused = used
+      ^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 34: unused type unused.
+module Unused_nonrec : sig end
+|}]
+
+module Unused_rec : sig
+end = struct
+  type unused = A of unused
+end
+;;
+[%%expect {|
+Line 3, characters 2-27:
+3 |   type unused = A of unused
+      ^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 34: unused type unused.
+Line 3, characters 16-27:
+3 |   type unused = A of unused
+                    ^^^^^^^^^^^
+Warning 37: unused constructor A.
+module Unused_rec : sig end
+|}]
+
+module Used_constructor : sig
+  type t
+  val t : t
+end = struct
+  type t = T
+  let t = T
+end
+;;
+[%%expect {|
+module Used_constructor : sig type t val t : t end
+|}]
+
+module Unused_constructor : sig
+  type t
+end = struct
+  type t = T
+end
+;;
+[%%expect {|
+Line 4, characters 11-12:
+4 |   type t = T
+               ^
+Warning 37: unused constructor T.
+module Unused_constructor : sig type t end
+|}]
+
+module Unused_constructor_outside_patterns : sig
+  type t
+  val nothing : t -> unit
+end = struct
+  type t = T
+  let nothing = function
+    | T -> ()
+end
+;;
+[%%expect {|
+Line 5, characters 11-12:
+5 |   type t = T
+               ^
+Warning 37: constructor T is never used to build values.
+(However, this constructor appears in patterns.)
+module Unused_constructor_outside_patterns :
+  sig type t val nothing : t -> unit end
+|}]
+
+module Unused_constructor_exported_private : sig
+  type t = private T
+end = struct
+  type t = T
+end
+;;
+[%%expect {|
+Line 4, characters 11-12:
+4 |   type t = T
+               ^
+Warning 37: constructor T is never used to build values.
+Its type is exported as a private type.
+module Unused_constructor_exported_private : sig type t = private T end
+|}]
+
+module Used_private_constructor : sig
+  type t
+  val nothing : t -> unit
+end = struct
+  type t = private T
+  let nothing = function
+    | T -> ()
+end
+;;
+[%%expect {|
+module Used_private_constructor : sig type t val nothing : t -> unit end
+|}]
+
+module Unused_private_constructor : sig
+  type t
+end = struct
+  type t = private T
+end
+;;
+[%%expect {|
+Line 4, characters 19-20:
+4 |   type t = private T
+                       ^
+Warning 37: unused constructor T.
+module Unused_private_constructor : sig type t end
+|}]
+
+module Exported_private_constructor : sig
+  type t = private T
+end = struct
+  type t = private T
+end
+;;
+[%%expect {|
+module Exported_private_constructor : sig type t = private T end
+|}]
+
+module Used_exception : sig
+  val e : exn
+end = struct
+  exception Somebody_uses_me
+  let e = Somebody_uses_me
+end
+;;
+[%%expect {|
+module Used_exception : sig val e : exn end
+|}]
+
+module Used_extension_constructor : sig
+  type t
+  val t : t
+end = struct
+  type t = ..
+  type t += Somebody_uses_me
+  let t = Somebody_uses_me
+end
+;;
+[%%expect {|
+module Used_extension_constructor : sig type t val t : t end
+|}]
+
+module Unused_exception : sig
+end = struct
+  exception Nobody_uses_me
+end
+;;
+[%%expect {|
+Line 3, characters 2-26:
+3 |   exception Nobody_uses_me
+      ^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 38: unused exception Nobody_uses_me
+module Unused_exception : sig end
+|}]
+
+module Unused_extension_constructor : sig
+  type t = ..
+end = struct
+  type t = ..
+  type t += Nobody_uses_me
+end
+;;
+[%%expect {|
+Line 5, characters 12-26:
+5 |   type t += Nobody_uses_me
+                ^^^^^^^^^^^^^^
+Warning 38: unused extension constructor Nobody_uses_me
+module Unused_extension_constructor : sig type t = .. end
+|}]
+
+module Unused_exception_outside_patterns : sig
+  val falsity : exn -> bool
+end = struct
+  exception Nobody_constructs_me
+  let falsity = function
+    | Nobody_constructs_me -> true
+    | _ -> false
+end
+;;
+[%%expect {|
+Line 4, characters 2-32:
+4 |   exception Nobody_constructs_me
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 38: exception Nobody_constructs_me is never used to build values.
+(However, this constructor appears in patterns.)
+module Unused_exception_outside_patterns : sig val falsity : exn -> bool end
+|}]
+
+module Unused_extension_outside_patterns : sig
+  type t = ..
+  val falsity : t -> bool
+end = struct
+  type t = ..
+  type t += Noone_builds_me
+  let falsity = function
+    | Noone_builds_me -> true
+    | _ -> false
+end
+;;
+[%%expect {|
+Line 6, characters 12-27:
+6 |   type t += Noone_builds_me
+                ^^^^^^^^^^^^^^^
+Warning 38: extension constructor Noone_builds_me is never used to build values.
+(However, this constructor appears in patterns.)
+module Unused_extension_outside_patterns :
+  sig type t = .. val falsity : t -> bool end
+|}]
+
+module Unused_exception_exported_private : sig
+  type exn += private Private_exn
+end = struct
+  exception Private_exn
+end
+;;
+[%%expect {|
+Line 4, characters 2-23:
+4 |   exception Private_exn
+      ^^^^^^^^^^^^^^^^^^^^^
+Warning 38: exception Private_exn is never used to build values.
+It is exported or rebound as a private extension.
+module Unused_exception_exported_private :
+  sig type exn += private Private_exn end
+|}]
+
+module Unused_extension_exported_private : sig
+  type t = ..
+  type t += private Private_ext
+end = struct
+  type t = ..
+  type t += Private_ext
+end
+;;
+[%%expect {|
+Line 6, characters 12-23:
+6 |   type t += Private_ext
+                ^^^^^^^^^^^
+Warning 38: extension constructor Private_ext is never used to build values.
+It is exported or rebound as a private extension.
+module Unused_extension_exported_private :
+  sig type t = .. type t += private Private_ext end
+|}]
+
+module Used_private_extension : sig
+  type t
+  val nothing : t -> unit
+end = struct
+  type t = ..
+  type t += private Private_ext
+  let nothing = function
+    | Private_ext | _ -> ()
+end
+;;
+[%%expect {|
+module Used_private_extension : sig type t val nothing : t -> unit end
+|}]
+
+module Unused_private_extension : sig
+  type t
+end = struct
+  type t = ..
+  type t += private Private_ext
+end
+;;
+[%%expect {|
+Line 5, characters 20-31:
+5 |   type t += private Private_ext
+                        ^^^^^^^^^^^
+Warning 38: unused extension constructor Private_ext
+module Unused_private_extension : sig type t end
+|}]
+
+module Exported_private_extension : sig
+  type t = ..
+  type t += private Private_ext
+end = struct
+  type t = ..
+  type t += private Private_ext
+end
+;;
+[%%expect {|
+module Exported_private_extension :
+  sig type t = .. type t += private Private_ext end
+|}]
+
+
+module Pr7438 : sig
+end = struct
+  module type S = sig type t = private [> `Foo] end
+  module type X =
+    sig type t = private [> `Foo | `Bar] include S with type t := t end
+end;;
+[%%expect {|
+module Pr7438 : sig end
+|}]
+
+module Unused_type_disable_warning : sig
+end = struct
+  type t = A [@@warning "-34"]
+end;;
+[%%expect {|
+Line 3, characters 11-12:
+3 |   type t = A [@@warning "-34"]
+               ^
+Warning 37: unused constructor A.
+module Unused_type_disable_warning : sig end
+|}]
+
+module Unused_constructor_disable_warning : sig
+end = struct
+  type t = A [@@warning "-37"]
+end;;
+[%%expect {|
+Line 3, characters 2-30:
+3 |   type t = A [@@warning "-37"]
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 34: unused type t.
+module Unused_constructor_disable_warning : sig end
+|}]
diff --git a/testsuite/tests/unboxed-primitive-args/README b/testsuite/tests/unboxed-primitive-args/README
new file mode 100644
index 00000000..4bd7601e
--- /dev/null
+++ b/testsuite/tests/unboxed-primitive-args/README
@@ -0,0 +1,26 @@
+This directory contains tests to check that OCaml values are correctly
+passed between OCaml and C when a primitive takes some or all of its
+arguments unboxed/untagged and/or return its result unboxed/untagged.
+
+To test one primitive we do:
+- write all its argument and expected result in buffer A
+- call the C external using arguments read from buffer A
+- the C function write all the arguments it receive into buffer B
+- the C function read the result from buffer A and returns it
+- on the OCaml side we write the received result into buffer B
+- the test is successful if A and B have the same contents
+
+Between each call, we call a function with 128 value arguments set to
+0 and a function with 32 unboxed float arguments set to 0., just to
+clean-up the registers and stacks in case garbage would make a test
+succeed. We don't pass more floats as it doesn't build on arm32.
+
+We construct the set of primitives to test as follow:
+- all combination of unboxed int32/int64/float arguments for functions
+  taking up to 6 arguments (with more than 6 ocamlopt takes a really
+  long time to compile the test files)
+- a bunch of manual tests for the rest and specific patterns.
+  The list is [Gen_test.manual_tests]
+
+We test the set of primitives a thousand times, with different random
+data each time.
diff --git a/testsuite/tests/unboxed-primitive-args/common.ml b/testsuite/tests/unboxed-primitive-args/common.ml
new file mode 100644
index 00000000..19c0451e
--- /dev/null
+++ b/testsuite/tests/unboxed-primitive-args/common.ml
@@ -0,0 +1,286 @@
+open StdLabels
+
+open Bigarray
+
+type 'a typ =
+  | Int       : int       typ
+  | Int32     : int32     typ
+  | Int64     : int64     typ
+  | Nativeint : nativeint typ
+  | Float     : float     typ
+
+type 'a proto =
+  | Ret : 'a typ -> 'a proto
+  | Abs : 'a typ * 'b proto -> ('a -> 'b) proto
+
+let ( ** ) x y = Abs (x, y)
+
+(* This form is easier to process programmatically. We don't expose it as
+   ocamlopt takes a really really long time to compile a constant list
+   of these. *)
+type simplified_test = Test : string * 'a * 'a proto -> simplified_test
+
+type test =
+  | T1 : string * ('a -> 'b) * 'a typ * 'b typ -> test
+  | T2 : string * ('a -> 'b -> 'c) * 'a typ * 'b typ * 'c typ -> test
+  | T3 : string * ('a -> 'b -> 'c -> 'd) *
+         'a typ * 'b typ * 'c typ * 'd typ -> test
+  | T4 : string * ('a -> 'b -> 'c -> 'd -> 'e) *
+         'a typ * 'b typ * 'c typ * 'd typ * 'e typ -> test
+  | T5 : string * ('a -> 'b -> 'c -> 'd -> 'e -> 'f) *
+         'a typ * 'b typ * 'c typ * 'd typ * 'e typ * 'f typ -> test
+  | T6 : string * ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g) *
+         'a typ * 'b typ * 'c typ * 'd typ * 'e typ * 'f typ * 'g typ -> test
+  | T : string * 'a * 'a proto -> test
+
+let expand_test = function
+  | T1 (s, fn, a, b) -> Test (s, fn, a ** Ret b)
+  | T2 (s, fn, a, b, c) -> Test (s, fn, a ** b ** Ret c)
+  | T3 (s, fn, a, b, c, d) -> Test (s, fn, a ** b ** c ** Ret d)
+  | T4 (s, fn, a, b, c, d, e) -> Test (s, fn, a ** b ** c ** d ** Ret e)
+  | T5 (s, fn, a, b, c, d, e, f) ->
+    Test (s, fn, a ** b ** c ** d ** e ** Ret f)
+  | T6 (s, fn, a, b, c, d, e, f, g) ->
+    Test (s, fn, a ** b ** c ** d ** e ** f ** Ret g)
+  | T (s, fn, p) -> Test (s, fn, p)
+
+let string_of : type a. a typ -> a -> string = function
+  | Int       -> Int.to_string
+  | Int32     -> Printf.sprintf "%ldl"
+  | Int64     -> Printf.sprintf "%LdL"
+  | Nativeint -> Printf.sprintf "%ndn"
+  | Float     ->
+      fun f -> Printf.sprintf "float_of_bits 0x%LxL" (Int64.bits_of_float f)
+
+let rec arity : type a. a proto -> int = function
+  | Ret _ -> 0
+  | Abs (_, p) -> 1 + arity p
+
+module Buffer = struct
+  type t = (char, int8_unsigned_elt, c_layout) Array1.t
+
+  let arg_size = 8
+
+  let create ~arity : t =
+    Array1.create char c_layout ((arity + 1) * arg_size)
+
+  let clear (t : t) = Array1.fill t '\000'
+
+  let length : t -> int = Array1.dim
+
+  external init_c_side : ocaml_buffer:t -> c_buffer:t -> unit
+    = "test_set_buffers"
+
+  external get_int32 : t -> int -> int32 = "%caml_bigstring_get32"
+  external get_int64 : t -> int -> int64 = "%caml_bigstring_get64"
+  external set_int32 : t -> int -> int32 -> unit = "%caml_bigstring_set32"
+  external set_int64 : t -> int -> int64 -> unit = "%caml_bigstring_set64"
+
+  let get_int32 t ~arg = get_int32 t (arg * arg_size)
+  let get_int64 t ~arg = get_int64 t (arg * arg_size)
+  let set_int32 t ~arg x = set_int32 t (arg * arg_size) x
+  let set_int64 t ~arg x = set_int64 t (arg * arg_size) x
+
+  let get_nativeint, set_nativeint =
+    match Sys.word_size with
+    | 32 -> ((fun t ~arg -> get_int32 t ~arg |> Nativeint.of_int32),
+             (fun t ~arg x -> set_int32 t ~arg (Nativeint.to_int32 x)))
+    | 64 -> ((fun t ~arg -> get_int64 t ~arg |> Int64.to_nativeint),
+             (fun t ~arg x -> set_int64 t ~arg (Int64.of_nativeint x)))
+    | n  -> Printf.ksprintf failwith "unknown word size (%d)" n
+
+  let get_int =
+    if Sys.word_size = 32 then
+      fun buf ~arg -> get_int32 buf ~arg |> Int32.to_int
+    else
+      fun buf ~arg -> get_int64 buf ~arg |> Int64.to_int
+
+  let set_int =
+    if Sys.word_size = 32 then
+      fun buf ~arg x -> set_int32 buf ~arg (Int32.of_int x)
+    else
+      fun buf ~arg x -> set_int64 buf ~arg (Int64.of_int x)
+
+  let get_float buf ~arg = get_int64 buf ~arg |> Int64.float_of_bits
+  let set_float buf ~arg x = set_int64 buf ~arg (Int64.bits_of_float x)
+
+  let get : type a. a typ -> t -> arg:int -> a = function
+    | Int       -> get_int
+    | Int32     -> get_int32
+    | Int64     -> get_int64
+    | Nativeint -> get_nativeint
+    | Float     -> get_float
+
+  let set : type a. a typ -> t -> arg:int -> a -> unit = function
+    | Int       -> set_int
+    | Int32     -> set_int32
+    | Int64     -> set_int64
+    | Nativeint -> set_nativeint
+    | Float     -> set_float
+
+  (* This is almost a memcpy except that we use get/set which should
+     ensure that the values in [dst] don't overflow. *)
+  let copy_args ~src ~dst proto =
+    let rec loop : type a. a proto -> int -> unit = fun proto arg ->
+      match proto with
+      | Ret typ ->
+        set typ dst ~arg (get typ src ~arg)
+      | Abs (typ, rest) ->
+        set typ dst ~arg (get typ src ~arg);
+        loop rest (arg + 1)
+    in
+    loop proto 0
+end
+
+let exec proto f ~ocaml_buffer ~c_buffer =
+  let rec loop : type a. a proto -> a -> int -> unit = fun proto f arg ->
+    match proto with
+    | Ret typ ->
+      Buffer.set typ c_buffer ~arg f
+    | Abs (typ, rest) ->
+      let x = Buffer.get typ ocaml_buffer ~arg in
+      loop rest (f x) (arg + 1)
+  in
+  loop proto f 0
+
+let strings_of_test_instance name proto buffer =
+  let rec loop : type a. a proto -> int -> string list -> string list * string =
+    fun proto arg acc ->
+      match proto with
+      | Ret typ ->
+        (List.rev acc, string_of typ (Buffer.get typ buffer ~arg))
+      | Abs (typ, rest) ->
+        let s = string_of typ (Buffer.get typ buffer ~arg) in
+        loop rest (arg + 1) (s :: acc)
+  in
+  loop proto 0 []
+
+let typ_size : type a. a typ -> int = function
+  | Int       -> Sys.word_size / 8
+  | Int32     -> 4
+  | Int64     -> 8
+  | Nativeint -> Sys.word_size / 8
+  | Float     -> 8
+
+let rec sizes : type a. a proto -> int list = function
+  | Ret typ         -> [typ_size typ]
+  | Abs (typ, rest) -> typ_size typ :: sizes rest
+
+let print_hex ~sizes ~arity buffer =
+  let printf = Printf.printf in
+  printf "(";
+  for i = 0 to arity do
+    if i = arity then
+      printf ") -> "
+    else if i > 0 then
+      printf ", ";
+    for ofs = i * Buffer.arg_size to i * Buffer.arg_size + sizes.(i) - 1 do
+      printf "%02x" (Char.code buffer.{ofs});
+    done;
+  done
+
+let printed_mismatches = ref 0
+
+let print_mismatch name proto ~ocaml_buffer ~c_buffer =
+  let printf = Printf.printf in
+  printf "Mismatch for %s\n" name;
+  let o_args, o_res = strings_of_test_instance name proto ocaml_buffer in
+  let c_args, c_res = strings_of_test_instance name proto     c_buffer in
+  let o_args, c_args =
+    (* Align arguments *)
+    List.map2 o_args c_args ~f:(fun a b ->
+      let len_a = String.length a and len_b = String.length b in
+      let len = max len_a len_b in
+      (Printf.sprintf "%*s" len a,
+       Printf.sprintf "%*s" len b))
+    |> List.split
+  in
+  printf "ocaml side : (%s) -> %s\n" (String.concat ~sep:", " o_args) o_res;
+  printf "c side     : (%s) -> %s\n" (String.concat ~sep:", " c_args) c_res;
+  let sizes = sizes proto |> Array.of_list in
+  let arity = arity proto in
+  printf "ocaml side : "; print_hex ~sizes ~arity ocaml_buffer; printf "\n";
+  printf "c side     : "; print_hex ~sizes ~arity     c_buffer; printf "\n";
+  incr printed_mismatches;
+  if !printed_mismatches >= 1000 then begin
+    printf "Output truncated at 1000 failures.";
+    exit 0
+  end
+
+external cleanup_normal
+  :  int -> int -> int -> int -> int -> int -> int -> int
+  -> int -> int -> int -> int -> int -> int -> int -> int
+  -> int -> int -> int -> int -> int -> int -> int -> int
+  -> int -> int -> int -> int -> int -> int -> int -> int
+  -> int -> int -> int -> int -> int -> int -> int -> int
+  -> int -> int -> int -> int -> int -> int -> int -> int
+  -> int -> int -> int -> int -> int -> int -> int -> int
+  -> int -> int -> int -> int -> int -> int -> int -> int
+  -> int -> int -> int -> int -> int -> int -> int -> int
+  -> int -> int -> int -> int -> int -> int -> int -> int
+  -> int -> int -> int -> int -> int -> int -> int -> int
+  -> int -> int -> int -> int -> int -> int -> int -> int
+  -> int -> int -> int -> int -> int -> int -> int -> int
+  -> int -> int -> int -> int -> int -> int -> int -> int
+  -> int -> int -> int -> int -> int -> int -> int -> int
+  -> int -> int -> int -> int -> int -> int -> int -> int
+  -> int = "" "test_cleanup_normal" [@@noalloc]
+
+external cleanup_float
+  :  float -> float -> float -> float -> float -> float -> float -> float
+  -> float -> float -> float -> float -> float -> float -> float -> float
+  -> float -> float -> float -> float -> float -> float -> float -> float
+  -> float -> float -> float -> float -> float -> float -> float -> float
+  -> float = "" "test_cleanup_float" [@@noalloc] [@@unboxed]
+
+let cleanup_args_and_stack () =
+  let _ : int =
+    cleanup_normal
+      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 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 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
+  in
+  let _ : float =
+    cleanup_float
+       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.
+  in
+  ()
+
+let run_test ~random_data ~ocaml_buffer ~c_buffer (Test (name, f, proto)) =
+  Buffer.clear ocaml_buffer;
+  Buffer.clear c_buffer;
+  Buffer.copy_args ~src:random_data ~dst:ocaml_buffer proto;
+  cleanup_args_and_stack ();
+  exec proto f ~ocaml_buffer ~c_buffer;
+  let success = ocaml_buffer = c_buffer in
+  if not success then print_mismatch name proto ~ocaml_buffer ~c_buffer;
+  success
+
+let run_tests tests =
+  let tests = List.map tests ~f:expand_test in
+  let max_args =
+    List.fold_left tests ~init:0 ~f:(fun acc (Test (_, _, p)) ->
+      max acc (arity p))
+  in
+
+  let ocaml_buffer = Buffer.create ~arity:max_args
+  and     c_buffer = Buffer.create ~arity:max_args in
+  Buffer.init_c_side ~ocaml_buffer ~c_buffer;
+
+  let random_data = Buffer.create ~arity:max_args in
+  let new_random_data () =
+    for i = 0 to Buffer.length random_data - 1 do
+      random_data.{i} <- char_of_int (Random.int 256)
+    done
+  in
+
+  let failure = ref false in
+  for i = 1 to 1000 do
+    new_random_data ();
+    List.iter tests ~f:(fun test ->
+      if not (run_test ~random_data ~ocaml_buffer ~c_buffer test) then
+        failure := true)
+  done;
+  exit (if !failure then 1 else 0)
diff --git a/testsuite/tests/unboxed-primitive-args/common.mli b/testsuite/tests/unboxed-primitive-args/common.mli
new file mode 100644
index 00000000..b7459bb1
--- /dev/null
+++ b/testsuite/tests/unboxed-primitive-args/common.mli
@@ -0,0 +1,29 @@
+(** Type of arguments/result *)
+type 'a typ =
+  | Int       : int       typ
+  | Int32     : int32     typ
+  | Int64     : int64     typ
+  | Nativeint : nativeint typ
+  | Float     : float     typ
+
+type 'a proto =
+  | Ret : 'a typ -> 'a proto
+  | Abs : 'a typ * 'b proto -> ('a -> 'b) proto
+
+(** Same as [Abs]. We choose this operator for its associativity. *)
+val ( ** ) : 'a typ -> 'b proto -> ('a -> 'b) proto
+
+type test =
+  | T1 : string * ('a -> 'b) * 'a typ * 'b typ -> test
+  | T2 : string * ('a -> 'b -> 'c) * 'a typ * 'b typ * 'c typ -> test
+  | T3 : string * ('a -> 'b -> 'c -> 'd) *
+         'a typ * 'b typ * 'c typ * 'd typ -> test
+  | T4 : string * ('a -> 'b -> 'c -> 'd -> 'e) *
+         'a typ * 'b typ * 'c typ * 'd typ * 'e typ -> test
+  | T5 : string * ('a -> 'b -> 'c -> 'd -> 'e -> 'f) *
+         'a typ * 'b typ * 'c typ * 'd typ * 'e typ * 'f typ -> test
+  | T6 : string * ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g) *
+         'a typ * 'b typ * 'c typ * 'd typ * 'e typ * 'f typ * 'g typ -> test
+  | T : string * 'a * 'a proto -> test
+
+val run_tests : test list -> unit
diff --git a/testsuite/tests/unboxed-primitive-args/gen_test.ml b/testsuite/tests/unboxed-primitive-args/gen_test.ml
new file mode 100644
index 00000000..8f4b2dfe
--- /dev/null
+++ b/testsuite/tests/unboxed-primitive-args/gen_test.ml
@@ -0,0 +1,228 @@
+(* This programs generate stubs with various prototype combinations *)
+
+open StdLabels
+
+type boxed_integer = Pnativeint | Pint32 | Pint64
+
+type native_repr =
+  | Same_as_ocaml_repr
+  | Unboxed_float
+  | Unboxed_integer of boxed_integer
+  | Untagged_int
+
+(* Generate primitives with up to this number of arguments *)
+let test_all_combination_up_to_n_args = 6
+
+(* Generate primitives using all combination of these argument
+   representations. No need to test all combination of other
+   representations: regarding the calling convention
+   [Same_as_ocaml_repr], [Untagged_int] and
+   [Unboxed_integer Pnativeint] are all the same, and are the
+   same as [Unboxed_integer Pint].
+
+   We have specific tests for the other representations and for the
+   result representation in [manual_tests].
+*)
+let test_all_args_combination_of =
+  [ Unboxed_float
+  ; Unboxed_integer Pint32
+  ; Unboxed_integer Pint64
+  ]
+
+let code_of_repr = function
+  | Same_as_ocaml_repr         -> "v" (* for "value" *)
+  | Unboxed_float              -> "f"
+  | Unboxed_integer Pint32     -> "l"
+  | Unboxed_integer Pint64     -> "L"
+  | Unboxed_integer Pnativeint -> "n"
+  | Untagged_int               -> "i"
+
+let repr_of_code = function
+  | 'v' -> Same_as_ocaml_repr
+  | 'f' -> Unboxed_float
+  | 'l' -> Unboxed_integer Pint32
+  | 'L' -> Unboxed_integer Pint64
+  | 'n' -> Unboxed_integer Pnativeint
+  | 'i' -> Untagged_int
+  | _   -> assert false
+
+let manual_tests =
+  [ "v_v"
+  ; "f_f"
+  ; "l_l"
+  ; "L_L"
+  ; "n_n"
+  ; "i_i"
+  ; "f_fffff"
+  ; "f_ffffff"
+  ; "f_fffffff"
+  ; "f_fffffffffffffffff"
+  ; "v_iiiiiiiiiiiiiiiii"
+  ; "v_lllllllllllllllll"
+  ; "v_LLLLLLLLLLLLLLLLL"
+  ; "v_iLiLiLiLiLiLiLiLi"
+  ; "v_LiLiLiLiLiLiLiLiL"
+  ; "v_flflflflflflflflflflflflflflflflflfl"
+  ; "v_fLfLfLfLfLfLfLfLfLfLfLfLfLfLfLfLfLfL"
+  ]
+
+let ocaml_type_of_repr = function
+  (* Doesn't really matters what we choose for this case *)
+  | Same_as_ocaml_repr         -> "int"
+  | Unboxed_float              -> "(float [@unboxed])"
+  | Unboxed_integer Pint32     -> "(int32 [@unboxed])"
+  | Unboxed_integer Pint64     -> "(int64 [@unboxed])"
+  | Unboxed_integer Pnativeint -> "(nativeint [@unboxed])"
+  | Untagged_int               -> "(int [@untagged])"
+
+let ocaml_type_gadt_of_repr = function
+  (* Doesn't really matters what we choose for this case *)
+  | Same_as_ocaml_repr         -> "Int"
+  | Unboxed_float              -> "Float"
+  | Unboxed_integer Pint32     -> "Int32"
+  | Unboxed_integer Pint64     -> "Int64"
+  | Unboxed_integer Pnativeint -> "Nativeint"
+  | Untagged_int               -> "Int"
+
+let c_type_of_repr = function
+  | Same_as_ocaml_repr         -> "value"
+  | Unboxed_float              -> "double"
+  | Unboxed_integer Pint32     -> "int32_t"
+  | Unboxed_integer Pint64     -> "int64_t"
+  | Unboxed_integer Pnativeint -> "intnat"
+  | Untagged_int               -> "intnat"
+
+type proto =
+  { params : native_repr list
+  ; return : native_repr
+  }
+
+let rec explode s =
+  let rec loop i acc =
+    if i < 0 then
+      acc
+    else
+      loop (i - 1) (s.[i] :: acc)
+  in
+  loop (String.length s - 1) []
+
+let proto_of_str s =
+  Scanf.sscanf s "%c_%s" (fun return params ->
+    { params = List.map (explode params) ~f:repr_of_code
+    ; return = repr_of_code return
+    })
+
+let function_name_of_proto proto =
+  Printf.sprintf "test_%s_%s" (code_of_repr proto.return)
+    (String.concat ~sep:"" (List.map proto.params ~f:code_of_repr))
+
+let ocaml_type_gadt_of_proto proto =
+  Printf.sprintf "%s ** Ret %s"
+    (String.concat ~sep:" ** "
+       (List.map proto.params ~f:ocaml_type_gadt_of_repr))
+    (ocaml_type_gadt_of_repr proto.return)
+
+let ocaml_type_of_proto proto =
+  String.concat ~sep:" -> "
+    (List.map proto.params ~f:ocaml_type_of_repr
+     @ [ocaml_type_of_repr proto.return])
+
+let c_args_of_proto proto =
+  String.concat ~sep:", "
+    (List.mapi proto.params ~f:(fun i p ->
+       Printf.sprintf "%s x%d" (c_type_of_repr p) i))
+
+let manual_protos = List.map manual_tests ~f:proto_of_str
+
+let iter_protos ~f =
+  let iter_for_arity arity =
+    let rec loop params to_gen =
+      List.iter test_all_args_combination_of ~f:(fun repr ->
+        let params = repr :: params in
+        let to_gen = to_gen - 1 in
+        if to_gen = 0 then
+          f { params = List.rev params
+            ; return = Same_as_ocaml_repr
+            }
+        else
+          loop params to_gen)
+    in
+    loop [] arity
+  in
+  let rec iter_arities arity =
+    if arity <= test_all_combination_up_to_n_args then begin
+      iter_for_arity arity;
+      iter_arities (arity + 1)
+    end
+  in
+  List.iter manual_protos ~f;
+  iter_arities 1
+
+let pr fmt = Printf.ksprintf (fun s -> print_string s; print_char '\n') fmt
+
+let generate_ml () =
+  pr "open Common";
+  pr "";
+  iter_protos ~f:(fun proto ->
+    let name = function_name_of_proto proto in
+    pr "external %s : %s = \"\" %S [@@noalloc]"
+      name (ocaml_type_of_proto proto) name;
+  );
+  pr "";
+  pr "let tests = []";
+  iter_protos ~f:(fun proto ->
+    let name = function_name_of_proto proto in
+    let arity = List.length proto.params in
+    if arity <= 6 then
+      pr "let tests = T%d (%S, %s, %s, %s) :: tests"
+        arity name name
+        (List.map proto.params ~f:ocaml_type_gadt_of_repr
+         |> String.concat ~sep:", ")
+        (ocaml_type_gadt_of_repr proto.return)
+    else
+      pr "let tests = T (%S, %s, %s) :: tests"
+        name name (ocaml_type_gadt_of_proto proto));
+  pr "";
+  pr "let () = run_tests (List.rev tests)"
+
+let generate_stubs () =
+  pr "#include ";
+  pr "#include ";
+  pr "#include \"test_common.h\"";
+  iter_protos ~f:(fun proto ->
+      let name = function_name_of_proto proto in
+      pr "";
+      pr "%s %s(%s)"
+        (c_type_of_repr proto.return)
+        name
+        (c_args_of_proto proto);
+      pr "{";
+      List.iteri proto.params ~f:(fun i p ->
+        pr "  %(%d%d%);"
+          (match p with
+           | Same_as_ocaml_repr         -> "set_intnat(%d, Long_val(x%d))"
+           | Unboxed_float              -> "set_double(%d, x%d)"
+           | Unboxed_integer Pint32     -> "set_int32(%d, x%d)"
+           | Unboxed_integer Pint64     -> "set_int64(%d, x%d)"
+           | Unboxed_integer Pnativeint -> "set_intnat(%d, x%d)"
+           | Untagged_int               -> "set_intnat(%d, x%d)")
+          i i);
+      pr "  return %(%d%);"
+        (match proto.return with
+         | Same_as_ocaml_repr         -> "Val_long(get_intnat(%d))"
+         | Unboxed_float              -> "get_double(%d)"
+         | Unboxed_integer Pint32     -> "get_int32(%d)"
+         | Unboxed_integer Pint64     -> "get_int64(%d)"
+         | Unboxed_integer Pnativeint -> "get_intnat(%d)"
+         | Untagged_int               -> "get_intnat(%d)")
+        (List.length proto.params);
+      pr "}"
+  )
+
+let () =
+  match Sys.argv with
+  | [|_; "ml"|] -> generate_ml ()
+  | [|_; "c" |] -> generate_stubs ()
+  | _ ->
+    prerr_endline "Usage: ocaml gen_test.ml {ml|c}";
+    exit 2
diff --git a/testsuite/tests/unboxed-primitive-args/test.ml b/testsuite/tests/unboxed-primitive-args/test.ml
new file mode 100644
index 00000000..62104351
--- /dev/null
+++ b/testsuite/tests/unboxed-primitive-args/test.ml
@@ -0,0 +1,22 @@
+(* TEST
+
+* hasunix
+include unix
+
+files = "common.mli common.ml test_common.c test_common.h"
+
+** setup-ocamlopt.byte-build-env
+*** ocaml
+test_file = "${test_source_directory}/gen_test.ml"
+ocaml_script_as_argument = "true"
+arguments = "c"
+compiler_output = "stubs.c"
+**** ocaml
+arguments = "ml"
+compiler_output = "main.ml"
+***** ocamlopt.byte
+all_modules = "test_common.c stubs.c common.mli common.ml main.ml"
+****** run
+******* check-program-output
+
+*)
diff --git a/testsuite/tests/unboxed-primitive-args/test.reference b/testsuite/tests/unboxed-primitive-args/test.reference
new file mode 100644
index 00000000..e69de29b
diff --git a/testsuite/tests/unboxed-primitive-args/test_common.c b/testsuite/tests/unboxed-primitive-args/test_common.c
new file mode 100644
index 00000000..c6b873c5
--- /dev/null
+++ b/testsuite/tests/unboxed-primitive-args/test_common.c
@@ -0,0 +1,37 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*                  Jeremie Dimino, Jane Street Europe                    */
+/*                                                                        */
+/*   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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include 
+#include 
+
+char *ocaml_buffer;
+char *c_buffer;
+
+value test_set_buffers(value v_ocaml_buffer, value v_c_buffer)
+{
+  ocaml_buffer = Caml_ba_data_val(v_ocaml_buffer);
+  c_buffer = Caml_ba_data_val(v_c_buffer);
+  return Val_unit;
+}
+
+value test_cleanup_normal(void)
+{
+  return Val_int(0);
+}
+
+double test_cleanup_float(void)
+{
+  return 0.;
+}
diff --git a/testsuite/tests/unboxed-primitive-args/test_common.h b/testsuite/tests/unboxed-primitive-args/test_common.h
new file mode 100644
index 00000000..2a1019ca
--- /dev/null
+++ b/testsuite/tests/unboxed-primitive-args/test_common.h
@@ -0,0 +1,44 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*                  Jeremie Dimino, Jane Street Europe                    */
+/*                                                                        */
+/*   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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifndef __TEST_COMMON_H
+#define __TEST_COMMON_H
+
+/* Where the OCaml side stores the arguments and result for a test
+   case. The C function will read the result it is supposed to return
+   from this buffer.
+
+   Argument [n] is stored at [n * 8] and the result is stored at
+   [arity * 8].
+*/
+extern char *ocaml_buffer;
+
+/* Where the C function stores the arguments it receive for a test
+   case. The OCaml side will store the result from the C function in
+   this buffer. At the of a test case, both these buffers must be
+   equal. */
+extern char *c_buffer;
+
+#define get_intnat(n) *(intnat*)(ocaml_buffer+((n)*8))
+#define get_int32(n) *(int32_t*)(ocaml_buffer+((n)*8))
+#define get_int64(n) *(int64_t*)(ocaml_buffer+((n)*8))
+#define get_double(n) *(double*)(ocaml_buffer+((n)*8))
+
+#define set_intnat(n, x) *(intnat*)(c_buffer+((n)*8)) = (x)
+#define set_int32(n, x) *(int32_t*)(c_buffer+((n)*8)) = (x)
+#define set_int64(n, x) *(int64_t*)(c_buffer+((n)*8)) = (x)
+#define set_double(n, x) *(double*)(c_buffer+((n)*8)) = (x)
+
+#endif /* __TEST_COMMON_H */
diff --git a/testsuite/tests/unwind/README b/testsuite/tests/unwind/README
new file mode 100644
index 00000000..ff467e25
--- /dev/null
+++ b/testsuite/tests/unwind/README
@@ -0,0 +1,9 @@
+This test case is motivated by the fact that on OS X, external functions may
+cause stack walks into the OCaml-generated stack frames. In particular, the
+Objective-C runtime does so in function objc_addExceptionHandler. This function
+is invoked from Cocoa. Errors in the stack unwinding info generated by OCaml
+can cause random crashes. This test case checks that, for at least one OCaml
+program, correct unwind info is generated such that the platform's unwinder
+(called libunwind) correctly walks the stack up to the main function. OCaml
+used to generate incorrect stack unwinding information for this program. See
+PR#7118, PR#7120.
diff --git a/testsuite/tests/unwind/check-linker-version.sh b/testsuite/tests/unwind/check-linker-version.sh
new file mode 100755
index 00000000..f1120da7
--- /dev/null
+++ b/testsuite/tests/unwind/check-linker-version.sh
@@ -0,0 +1,16 @@
+#!/bin/sh
+exec > ${ocamltest_response} 2>&1
+LDFULL="`ld -v 2>&1`"
+LD="`echo $LDFULL | grep -o \"ld64-[0-9]*\"`"
+LDVER="`echo $LD | sed \"s/ld64-//\"`"
+if [[ -z "$LD" ]]; then
+  echo "unknown linker: pattern ld64-[0-9]* not found in 'ld -v' output";
+  test_result=${TEST_SKIP};
+elif [[ $LDVER -lt 224 ]]; then
+  echo "ld version is $LDVER, only 224 or above are supported";
+  test_result=${TEST_SKIP};
+else
+  test_result=${TEST_PASS};
+fi
+
+exit ${TEST_RESULT}
diff --git a/testsuite/tests/unwind/driver.ml b/testsuite/tests/unwind/driver.ml
new file mode 100644
index 00000000..421f85a6
--- /dev/null
+++ b/testsuite/tests/unwind/driver.ml
@@ -0,0 +1,23 @@
+(* TEST
+
+script = "sh ${test_source_directory}/check-linker-version.sh"
+files = "mylib.mli mylib.ml stack_walker.c"
+
+* macos
+** script
+*** setup-ocamlopt.byte-build-env
+**** ocamlopt.byte
+flags = "-opaque"
+module = "mylib.mli"
+***** ocamlopt.byte
+module = ""
+flags = "-cclib -Wl,-keep_dwarf_unwind"
+all_modules = "mylib.ml driver.ml stack_walker.c"
+program = "${test_build_directory}/unwind_test"
+****** run
+
+*)
+
+let () =
+  Mylib.foo1 Mylib.bar 1 2 3 4 5 6 7 8 9 10;
+  Mylib.foo2 Mylib.baz 1 2 3 4 5 6 7 8 9 10
diff --git a/testsuite/tests/unwind/mylib.ml b/testsuite/tests/unwind/mylib.ml
new file mode 100644
index 00000000..318b537a
--- /dev/null
+++ b/testsuite/tests/unwind/mylib.ml
@@ -0,0 +1,20 @@
+let foo1 f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 =
+  f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10
+
+let foo2 f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 =
+  f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10
+
+external func_with_10_params:
+  int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> unit
+  = "ml_func_with_10_params_bytecode" "ml_func_with_10_params_native"
+
+let bar x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 =
+  func_with_10_params x1 x2 x3 x4 x5 x6 x7 x8 x9 x10;
+  func_with_10_params x1 x2 x3 x4 x5 x6 x7 x8 x9 x10
+
+external perform_stack_walk: unit -> unit = "ml_perform_stack_walk"
+
+let baz x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 =
+  func_with_10_params x1 x2 x3 x4 x5 x6 x7 x8 x9 x10;
+  func_with_10_params x1 x2 x3 x4 x5 x6 x7 x8 x9 x10;
+  perform_stack_walk ()
diff --git a/testsuite/tests/unwind/mylib.mli b/testsuite/tests/unwind/mylib.mli
new file mode 100644
index 00000000..c1655228
--- /dev/null
+++ b/testsuite/tests/unwind/mylib.mli
@@ -0,0 +1,10 @@
+val foo1: ('a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit)
+          -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit
+
+val foo2: ('a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit)
+          -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit
+
+val bar:
+  int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> unit
+val baz:
+  int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> unit
diff --git a/testsuite/tests/unwind/stack_walker.c b/testsuite/tests/unwind/stack_walker.c
new file mode 100644
index 00000000..09afcadd
--- /dev/null
+++ b/testsuite/tests/unwind/stack_walker.c
@@ -0,0 +1,59 @@
+#include 
+#include 
+#include 
+#include 
+#include 
+#include 
+
+value ml_func_with_10_params_native(value x1, value x2, value x3, value x4,
+                                    value x5, value x6, value x7, value x8,
+                                    value x9, value x10) {
+    return Val_unit;
+}
+
+void error() {
+    exit(1);
+}
+
+void perform_stack_walk() {
+    unw_context_t ctxt;
+    unw_getcontext(&ctxt);
+
+    unw_cursor_t cursor;
+    {
+        int result = unw_init_local(&cursor, &ctxt);
+        if (result != 0) error();
+    }
+
+    int reached_main = 0;
+
+    for (;;) {
+        {
+            char procname[256];
+            unw_word_t ip_offset; // IP - start_of_proc
+            int result = unw_get_proc_name(&cursor, procname, sizeof(procname),
+                                           &ip_offset);
+            if (result != 0) error();
+            if (strcmp(procname, "main") == 0)
+                reached_main = 1;
+            //printf("%s + %lld\n", procname, (long long int)ip_offset);
+        }
+
+        {
+            int result = unw_step(&cursor);
+            if (result == 0) break;
+            if (result < 0) error();
+        }
+    }
+
+    //printf("Reached end of stack.\n");
+    if (!reached_main) {
+        //printf("Failure: Did not reach main.\n");
+        error();
+    }
+}
+
+value ml_perform_stack_walk() {
+    perform_stack_walk();
+    return Val_unit;
+}
diff --git a/testsuite/tests/utils/edit_distance.ml b/testsuite/tests/utils/edit_distance.ml
new file mode 100644
index 00000000..1ac10701
--- /dev/null
+++ b/testsuite/tests/utils/edit_distance.ml
@@ -0,0 +1,55 @@
+(* TEST
+include config
+include testing
+binary_modules = "config build_path_prefix_map misc identifiable numbers"
+* bytecode
+*)
+
+let edit_distance = Misc.edit_distance
+
+let show_cutoff n =
+  if n = max_int then "max_int" else Printf.sprintf "%d" n
+;;
+
+let test =
+  let counter = ref 0 in
+  fun a b cutoff expected ->
+    let show_result = function
+      | None -> "None"
+      | Some d -> "Some " ^ Int.to_string d in
+    incr counter;
+    Printf.printf "[%02d] (edit_distance %S %S %s), expected %s\n"
+      !counter a b (show_cutoff cutoff) (show_result expected);
+    let result = edit_distance a b cutoff in
+    if result = expected
+    then print_endline "OK"
+    else Printf.printf "FAIL: got %s\n%!" (show_result result)
+
+let () =
+  test "a" "a" 1 (Some 0);
+  test "a" "a" 0 (Some 0);
+  test "a" "b" 1 (Some 1);
+  test "a" "b" 0 None;
+  test "add" "adad" 3 (Some 1);
+  test "delete" "delte" 3 (Some 1);
+  test "subst" "sabst" 3 (Some 1);
+  test "swap" "sawp" 3 (Some 1);
+  test "abbb" "bbba" 3 (Some 2);
+  test "abbb" "bbba" 1 None;
+
+  (* check for bugs where a small common suffix, or common prefix, is
+     enough to make the distance goes down *)
+  test "xyzwabc" "mnpqrabc" 10 (Some 5);
+  test "abcxyzw" "abcmnpqr" 10 (Some 5);
+
+  (* check that using "max_int" as cutoff works *)
+  test "a" "a" max_int (Some 0);
+  test "a" "b" max_int (Some 1);
+  test "abc" "ade" max_int (Some 2);
+
+  (* check empty strings*)
+  test "" "" 3 (Some 0);
+  test "" "abc" 3 (Some 3);
+  test "abcd" "" 3 None;
+
+  ()
diff --git a/testsuite/tests/utils/edit_distance.reference b/testsuite/tests/utils/edit_distance.reference
new file mode 100644
index 00000000..c2816dab
--- /dev/null
+++ b/testsuite/tests/utils/edit_distance.reference
@@ -0,0 +1,38 @@
+[01] (edit_distance "a" "a" 1), expected Some 0
+OK
+[02] (edit_distance "a" "a" 0), expected Some 0
+OK
+[03] (edit_distance "a" "b" 1), expected Some 1
+OK
+[04] (edit_distance "a" "b" 0), expected None
+OK
+[05] (edit_distance "add" "adad" 3), expected Some 1
+OK
+[06] (edit_distance "delete" "delte" 3), expected Some 1
+OK
+[07] (edit_distance "subst" "sabst" 3), expected Some 1
+OK
+[08] (edit_distance "swap" "sawp" 3), expected Some 1
+OK
+[09] (edit_distance "abbb" "bbba" 3), expected Some 2
+OK
+[10] (edit_distance "abbb" "bbba" 1), expected None
+OK
+[11] (edit_distance "xyzwabc" "mnpqrabc" 10), expected Some 5
+OK
+[12] (edit_distance "abcxyzw" "abcmnpqr" 10), expected Some 5
+OK
+[13] (edit_distance "a" "a" max_int), expected Some 0
+OK
+[14] (edit_distance "a" "b" max_int), expected Some 1
+OK
+[15] (edit_distance "abc" "ade" max_int), expected Some 2
+OK
+[16] (edit_distance "" "" 3), expected Some 0
+OK
+[17] (edit_distance "" "abc" 3), expected Some 3
+OK
+[18] (edit_distance "abcd" "" 3), expected None
+OK
+
+All tests succeeded.
diff --git a/testsuite/tests/utils/magic_number.ml b/testsuite/tests/utils/magic_number.ml
new file mode 100644
index 00000000..a443e253
--- /dev/null
+++ b/testsuite/tests/utils/magic_number.ml
@@ -0,0 +1,38 @@
+(* TEST
+include config
+binary_modules = "config build_path_prefix_map misc"
+* bytecode
+*)
+
+open Misc
+open Magic_number
+
+(* sanity checking: the magic number at a given kind can be parsed back *)
+let error kind test =
+  fatal_errorf
+    "Internal compiler error (%s): there is a magic number mismatch on kind %s"
+    test
+    (string_of_kind kind)
+
+let check_raw_kind kind =
+  let valid =
+    match parse_kind (raw_kind kind) with
+      | None -> false
+      | Some kind_roundtrip ->
+         kind_roundtrip = kind
+  in
+  if not valid then error kind "raw_kind"
+
+let check_current_raw kind =
+  let valid =
+    match parse (current_raw kind) with
+      | Error _ -> false
+      | Ok magic ->
+         magic.kind = kind
+         && raw magic = current_raw kind
+  in
+  if not valid then error kind "current_raw"
+
+let () =
+  all_kinds
+  |> List.iter (fun kind -> check_raw_kind kind; check_current_raw kind)
diff --git a/testsuite/tests/utils/overflow_detection.ml b/testsuite/tests/utils/overflow_detection.ml
new file mode 100644
index 00000000..11f3aafa
--- /dev/null
+++ b/testsuite/tests/utils/overflow_detection.ml
@@ -0,0 +1,45 @@
+(* TEST
+include config
+include testing
+binary_modules = "config build_path_prefix_map misc identifiable numbers"
+* bytecode
+*)
+
+let print_int i =
+  if i = max_int then
+    "max_int"
+  else if i = min_int then
+    "min_int"
+  else
+    Int.to_string i
+
+let test_no_overflow_add a b =
+  Printf.printf "Misc.no_overflow_add %s %s = %b\n"
+    (print_int a)
+    (print_int b)
+    (Misc.no_overflow_add a b)
+
+let test_no_overflow_sub a b =
+  Printf.printf "Misc.no_overflow_sub %s %s = %b\n"
+    (print_int a)
+    (print_int b)
+    (Misc.no_overflow_sub a b)
+
+let test_no_overflow_mul a b =
+  Printf.printf "Misc.no_overflow_mul %s %s = %b\n"
+    (print_int a)
+    (print_int b)
+    (Misc.no_overflow_mul a b)
+
+let cartesian_product l1 l2 =
+  List.concat
+    (l1 |> List.map (fun v1 ->
+     l2 |> List.map (fun v2 ->
+     (v1, v2))))
+
+let () =
+  let ints = [ 0; 1; 2; max_int; -1; -2; min_int ] in
+  let int_pairs = cartesian_product ints ints in
+  int_pairs |> List.iter (fun (a, b) -> test_no_overflow_add a b);
+  int_pairs |> List.iter (fun (a, b) -> test_no_overflow_sub a b);
+  int_pairs |> List.iter (fun (a, b) -> test_no_overflow_mul a b)
diff --git a/testsuite/tests/utils/overflow_detection.reference b/testsuite/tests/utils/overflow_detection.reference
new file mode 100644
index 00000000..ce16f0b3
--- /dev/null
+++ b/testsuite/tests/utils/overflow_detection.reference
@@ -0,0 +1,149 @@
+Misc.no_overflow_add 0 0 = true
+Misc.no_overflow_add 0 1 = true
+Misc.no_overflow_add 0 2 = true
+Misc.no_overflow_add 0 max_int = true
+Misc.no_overflow_add 0 -1 = true
+Misc.no_overflow_add 0 -2 = true
+Misc.no_overflow_add 0 min_int = true
+Misc.no_overflow_add 1 0 = true
+Misc.no_overflow_add 1 1 = true
+Misc.no_overflow_add 1 2 = true
+Misc.no_overflow_add 1 max_int = false
+Misc.no_overflow_add 1 -1 = true
+Misc.no_overflow_add 1 -2 = true
+Misc.no_overflow_add 1 min_int = true
+Misc.no_overflow_add 2 0 = true
+Misc.no_overflow_add 2 1 = true
+Misc.no_overflow_add 2 2 = true
+Misc.no_overflow_add 2 max_int = false
+Misc.no_overflow_add 2 -1 = true
+Misc.no_overflow_add 2 -2 = true
+Misc.no_overflow_add 2 min_int = true
+Misc.no_overflow_add max_int 0 = true
+Misc.no_overflow_add max_int 1 = false
+Misc.no_overflow_add max_int 2 = false
+Misc.no_overflow_add max_int max_int = false
+Misc.no_overflow_add max_int -1 = true
+Misc.no_overflow_add max_int -2 = true
+Misc.no_overflow_add max_int min_int = true
+Misc.no_overflow_add -1 0 = true
+Misc.no_overflow_add -1 1 = true
+Misc.no_overflow_add -1 2 = true
+Misc.no_overflow_add -1 max_int = true
+Misc.no_overflow_add -1 -1 = true
+Misc.no_overflow_add -1 -2 = true
+Misc.no_overflow_add -1 min_int = false
+Misc.no_overflow_add -2 0 = true
+Misc.no_overflow_add -2 1 = true
+Misc.no_overflow_add -2 2 = true
+Misc.no_overflow_add -2 max_int = true
+Misc.no_overflow_add -2 -1 = true
+Misc.no_overflow_add -2 -2 = true
+Misc.no_overflow_add -2 min_int = false
+Misc.no_overflow_add min_int 0 = true
+Misc.no_overflow_add min_int 1 = true
+Misc.no_overflow_add min_int 2 = true
+Misc.no_overflow_add min_int max_int = true
+Misc.no_overflow_add min_int -1 = false
+Misc.no_overflow_add min_int -2 = false
+Misc.no_overflow_add min_int min_int = false
+Misc.no_overflow_sub 0 0 = true
+Misc.no_overflow_sub 0 1 = true
+Misc.no_overflow_sub 0 2 = true
+Misc.no_overflow_sub 0 max_int = true
+Misc.no_overflow_sub 0 -1 = true
+Misc.no_overflow_sub 0 -2 = true
+Misc.no_overflow_sub 0 min_int = false
+Misc.no_overflow_sub 1 0 = true
+Misc.no_overflow_sub 1 1 = true
+Misc.no_overflow_sub 1 2 = true
+Misc.no_overflow_sub 1 max_int = true
+Misc.no_overflow_sub 1 -1 = true
+Misc.no_overflow_sub 1 -2 = true
+Misc.no_overflow_sub 1 min_int = false
+Misc.no_overflow_sub 2 0 = true
+Misc.no_overflow_sub 2 1 = true
+Misc.no_overflow_sub 2 2 = true
+Misc.no_overflow_sub 2 max_int = true
+Misc.no_overflow_sub 2 -1 = true
+Misc.no_overflow_sub 2 -2 = true
+Misc.no_overflow_sub 2 min_int = false
+Misc.no_overflow_sub max_int 0 = true
+Misc.no_overflow_sub max_int 1 = true
+Misc.no_overflow_sub max_int 2 = true
+Misc.no_overflow_sub max_int max_int = true
+Misc.no_overflow_sub max_int -1 = false
+Misc.no_overflow_sub max_int -2 = false
+Misc.no_overflow_sub max_int min_int = false
+Misc.no_overflow_sub -1 0 = true
+Misc.no_overflow_sub -1 1 = true
+Misc.no_overflow_sub -1 2 = true
+Misc.no_overflow_sub -1 max_int = true
+Misc.no_overflow_sub -1 -1 = true
+Misc.no_overflow_sub -1 -2 = true
+Misc.no_overflow_sub -1 min_int = true
+Misc.no_overflow_sub -2 0 = true
+Misc.no_overflow_sub -2 1 = true
+Misc.no_overflow_sub -2 2 = true
+Misc.no_overflow_sub -2 max_int = false
+Misc.no_overflow_sub -2 -1 = true
+Misc.no_overflow_sub -2 -2 = true
+Misc.no_overflow_sub -2 min_int = true
+Misc.no_overflow_sub min_int 0 = true
+Misc.no_overflow_sub min_int 1 = false
+Misc.no_overflow_sub min_int 2 = false
+Misc.no_overflow_sub min_int max_int = false
+Misc.no_overflow_sub min_int -1 = true
+Misc.no_overflow_sub min_int -2 = true
+Misc.no_overflow_sub min_int min_int = true
+Misc.no_overflow_mul 0 0 = true
+Misc.no_overflow_mul 0 1 = true
+Misc.no_overflow_mul 0 2 = true
+Misc.no_overflow_mul 0 max_int = true
+Misc.no_overflow_mul 0 -1 = true
+Misc.no_overflow_mul 0 -2 = true
+Misc.no_overflow_mul 0 min_int = true
+Misc.no_overflow_mul 1 0 = true
+Misc.no_overflow_mul 1 1 = true
+Misc.no_overflow_mul 1 2 = true
+Misc.no_overflow_mul 1 max_int = true
+Misc.no_overflow_mul 1 -1 = true
+Misc.no_overflow_mul 1 -2 = true
+Misc.no_overflow_mul 1 min_int = true
+Misc.no_overflow_mul 2 0 = true
+Misc.no_overflow_mul 2 1 = true
+Misc.no_overflow_mul 2 2 = true
+Misc.no_overflow_mul 2 max_int = false
+Misc.no_overflow_mul 2 -1 = true
+Misc.no_overflow_mul 2 -2 = true
+Misc.no_overflow_mul 2 min_int = false
+Misc.no_overflow_mul max_int 0 = true
+Misc.no_overflow_mul max_int 1 = true
+Misc.no_overflow_mul max_int 2 = false
+Misc.no_overflow_mul max_int max_int = false
+Misc.no_overflow_mul max_int -1 = true
+Misc.no_overflow_mul max_int -2 = false
+Misc.no_overflow_mul max_int min_int = false
+Misc.no_overflow_mul -1 0 = true
+Misc.no_overflow_mul -1 1 = true
+Misc.no_overflow_mul -1 2 = true
+Misc.no_overflow_mul -1 max_int = true
+Misc.no_overflow_mul -1 -1 = true
+Misc.no_overflow_mul -1 -2 = true
+Misc.no_overflow_mul -1 min_int = false
+Misc.no_overflow_mul -2 0 = true
+Misc.no_overflow_mul -2 1 = true
+Misc.no_overflow_mul -2 2 = true
+Misc.no_overflow_mul -2 max_int = false
+Misc.no_overflow_mul -2 -1 = true
+Misc.no_overflow_mul -2 -2 = true
+Misc.no_overflow_mul -2 min_int = false
+Misc.no_overflow_mul min_int 0 = true
+Misc.no_overflow_mul min_int 1 = true
+Misc.no_overflow_mul min_int 2 = false
+Misc.no_overflow_mul min_int max_int = false
+Misc.no_overflow_mul min_int -1 = false
+Misc.no_overflow_mul min_int -2 = false
+Misc.no_overflow_mul min_int min_int = false
+
+All tests succeeded.
diff --git a/testsuite/tests/utils/test_strongly_connected_components.ml b/testsuite/tests/utils/test_strongly_connected_components.ml
new file mode 100644
index 00000000..05845228
--- /dev/null
+++ b/testsuite/tests/utils/test_strongly_connected_components.ml
@@ -0,0 +1,38 @@
+(* TEST
+include config
+include testing
+binary_modules =
+  "config build_path_prefix_map misc identifiable numbers \
+   strongly_connected_components"
+* bytecode
+*)
+
+module Int = Numbers.Int
+module SCC = Strongly_connected_components.Make (Int)
+
+let graph_1 =
+  [1, [2;3;4];
+   2, [3;5];
+   3, [5];
+   4, [1];
+   5, [5]]
+
+let empty = []
+
+let print_scc scc =
+  Printf.printf "begin\n";
+  Array.iter (function
+      | SCC.No_loop e -> Printf.printf "%i\n" e
+      | SCC.Has_loop l ->
+          Printf.printf "[%s]\n"
+            (String.concat "; " (List.map Stdlib.Int.to_string l))) scc;
+  Printf.printf "end\n"
+
+let scc graph =
+  SCC.connected_components_sorted_from_roots_to_leaf
+    (Int.Map.map Int.Set.of_list (Int.Map.of_list graph))
+
+let run () =
+  print_scc (scc empty);
+  print_scc (scc graph_1);
+  Format.printf "done@."
diff --git a/testsuite/tests/utils/test_strongly_connected_components.reference b/testsuite/tests/utils/test_strongly_connected_components.reference
new file mode 100644
index 00000000..197c9280
--- /dev/null
+++ b/testsuite/tests/utils/test_strongly_connected_components.reference
@@ -0,0 +1,2 @@
+
+All tests succeeded.
diff --git a/testsuite/tests/warnings/deprecated_module.compilers.reference b/testsuite/tests/warnings/deprecated_module.compilers.reference
new file mode 100644
index 00000000..c733b917
--- /dev/null
+++ b/testsuite/tests/warnings/deprecated_module.compilers.reference
@@ -0,0 +1,8 @@
+File "deprecated_module.ml", line 16, characters 8-11:
+16 | let _ = M.x
+             ^^^
+Alert deprecated: module M
+File "deprecated_module.ml", line 17, characters 8-9:
+17 | include M
+             ^
+Alert deprecated: module M
diff --git a/testsuite/tests/warnings/deprecated_module.ml b/testsuite/tests/warnings/deprecated_module.ml
new file mode 100644
index 00000000..b6a0121d
--- /dev/null
+++ b/testsuite/tests/warnings/deprecated_module.ml
@@ -0,0 +1,17 @@
+(* TEST
+
+flags = "-w A"
+
+* bytecode
+
+*)
+
+module M = struct
+  type t = int
+
+  let x = 10
+end
+[@@ocaml.deprecated]
+
+let _ = M.x
+include M
diff --git a/testsuite/tests/warnings/deprecated_module.mli b/testsuite/tests/warnings/deprecated_module.mli
new file mode 100644
index 00000000..dbcb19b6
--- /dev/null
+++ b/testsuite/tests/warnings/deprecated_module.mli
@@ -0,0 +1,13 @@
+[@@@ocaml.deprecated {|
+  As you could guess, Deprecated_module is deprecated.
+  Please use something else!
+|} ]
+
+module M: sig
+  val x: int
+    [@@ocaml.deprecated]
+
+  type t
+    [@@ocaml.deprecated]
+end
+[@@ocaml.deprecated]
diff --git a/testsuite/tests/warnings/deprecated_module_assigment.compilers.reference b/testsuite/tests/warnings/deprecated_module_assigment.compilers.reference
new file mode 100644
index 00000000..e918a19d
--- /dev/null
+++ b/testsuite/tests/warnings/deprecated_module_assigment.compilers.reference
@@ -0,0 +1,138 @@
+File "deprecated_module_assigment.ml", line 17, characters 33-34:
+17 | module Y : sig val x : int end = X
+                                      ^
+Alert deprecated: x
+DEPRECATED
+File "deprecated_module_assigment.ml", line 12, characters 2-41:
+12 |   val x : int [@@deprecated "DEPRECATED"]
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+File "deprecated_module_assigment.ml", line 17, characters 15-26:
+17 | module Y : sig val x : int end = X
+                    ^^^^^^^^^^^
+  Expected signature
+File "deprecated_module_assigment.ml", line 23, characters 13-14:
+23 | module B = F(X)
+                  ^
+Alert deprecated: x
+DEPRECATED
+File "deprecated_module_assigment.ml", line 12, characters 2-41:
+12 |   val x : int [@@deprecated "DEPRECATED"]
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+File "deprecated_module_assigment.ml", line 21, characters 17-28:
+21 | module F(A : sig val x : int end) = struct let _ = A.x end
+                      ^^^^^^^^^^^
+  Expected signature
+File "deprecated_module_assigment.ml", line 33, characters 39-78:
+33 | module CSTR : sig type t = A | B end = struct type t = A [@deprecated] | B end
+                                            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Alert deprecated: A
+File "deprecated_module_assigment.ml", line 33, characters 55-70:
+33 | module CSTR : sig type t = A | B end = struct type t = A [@deprecated] | B end
+                                                            ^^^^^^^^^^^^^^^
+  Definition
+File "deprecated_module_assigment.ml", line 33, characters 27-28:
+33 | module CSTR : sig type t = A | B end = struct type t = A [@deprecated] | B end
+                                ^
+  Expected signature
+File "deprecated_module_assigment.ml", line 37, characters 2-20:
+37 |   type s = t = A | B
+       ^^^^^^^^^^^^^^^^^^
+Alert deprecated: A
+File "deprecated_module_assigment.ml", line 36, characters 11-26:
+36 |   type t = A [@deprecated] | B
+                ^^^^^^^^^^^^^^^
+  Definition
+File "deprecated_module_assigment.ml", line 37, characters 15-16:
+37 |   type s = t = A | B
+                    ^
+  Expected signature
+File "deprecated_module_assigment.ml", line 45, characters 0-58:
+45 | struct type t = {mutable x: int [@deprecated_mutable]} end
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Alert deprecated: mutating field x
+File "deprecated_module_assigment.ml", line 45, characters 17-53:
+45 | struct type t = {mutable x: int [@deprecated_mutable]} end
+                      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+File "deprecated_module_assigment.ml", line 44, characters 14-28:
+44 | sig type t = {mutable x: int} end =
+                   ^^^^^^^^^^^^^^
+  Expected signature
+File "deprecated_module_assigment.ml", line 49, characters 2-31:
+49 |   type s = t = {mutable x: int}
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Alert deprecated: mutating field x
+File "deprecated_module_assigment.ml", line 48, characters 12-48:
+48 |   type t = {mutable x: int [@deprecated_mutable]}
+                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+File "deprecated_module_assigment.ml", line 49, characters 16-30:
+49 |   type s = t = {mutable x: int}
+                     ^^^^^^^^^^^^^^
+  Expected signature
+File "deprecated_module_assigment.ml", line 54, characters 37-75:
+54 | module TYPE : sig type t = int end = struct type t = int [@@deprecated] end
+                                          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Alert deprecated: t
+File "deprecated_module_assigment.ml", line 54, characters 44-71:
+54 | module TYPE : sig type t = int end = struct type t = int [@@deprecated] end
+                                                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+File "deprecated_module_assigment.ml", line 54, characters 18-30:
+54 | module TYPE : sig type t = int end = struct type t = int [@@deprecated] end
+                       ^^^^^^^^^^^^
+  Expected signature
+File "deprecated_module_assigment.ml", line 60, characters 0-52:
+60 | struct class c = object end [@@deprecated "FOO"] end
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Alert deprecated: c
+FOO
+File "deprecated_module_assigment.ml", line 60, characters 7-48:
+60 | struct class c = object end [@@deprecated "FOO"] end
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+File "deprecated_module_assigment.ml", line 59, characters 4-24:
+59 | sig class c : object end end =
+         ^^^^^^^^^^^^^^^^^^^^
+  Expected signature
+File "deprecated_module_assigment.ml", line 64, characters 0-57:
+64 | struct class type c = object end [@@deprecated "FOO"] end
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Alert deprecated: c
+FOO
+File "deprecated_module_assigment.ml", line 64, characters 7-53:
+64 | struct class type c = object end [@@deprecated "FOO"] end
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+File "deprecated_module_assigment.ml", line 63, characters 4-29:
+63 | sig class type c = object end end =
+         ^^^^^^^^^^^^^^^^^^^^^^^^^
+  Expected signature
+File "deprecated_module_assigment.ml", line 71, characters 0-55:
+71 | struct module type S = sig end [@@deprecated "FOO"] end
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Alert deprecated: S
+FOO
+File "deprecated_module_assigment.ml", line 71, characters 7-51:
+71 | struct module type S = sig end [@@deprecated "FOO"] end
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+File "deprecated_module_assigment.ml", line 70, characters 4-27:
+70 | sig module type S = sig end end =
+         ^^^^^^^^^^^^^^^^^^^^^^^
+  Expected signature
+File "deprecated_module_assigment.ml", line 82, characters 0-53:
+82 | struct module M = struct end [@@deprecated "FOO"] end
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Alert deprecated: M
+FOO
+File "deprecated_module_assigment.ml", line 82, characters 7-49:
+82 | struct module M = struct end [@@deprecated "FOO"] end
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Definition
+File "deprecated_module_assigment.ml", line 81, characters 4-22:
+81 | sig module M : sig end end =
+         ^^^^^^^^^^^^^^^^^^
+  Expected signature
diff --git a/testsuite/tests/warnings/deprecated_module_assigment.ml b/testsuite/tests/warnings/deprecated_module_assigment.ml
new file mode 100644
index 00000000..93f0e305
--- /dev/null
+++ b/testsuite/tests/warnings/deprecated_module_assigment.ml
@@ -0,0 +1,86 @@
+(* TEST
+
+flags = "-w A"
+
+* bytecode
+
+*)
+
+(* Values *)
+
+module X : sig
+  val x : int [@@deprecated "DEPRECATED"]
+end = struct
+  let x = 7
+end
+
+module Y : sig val x : int end = X
+
+module Z : sig val x : int [@@deprecated "..."] end = X
+
+module F(A : sig val x : int end) = struct let _ = A.x end
+
+module B = F(X)
+
+
+
+module XX = struct let x = 7 end
+module YY : sig val x : int [@@deprecated "..."] end = XX
+
+
+(* Constructors *)
+
+module CSTR : sig type t = A | B end = struct type t = A [@deprecated] | B end
+
+module CSTR1 = struct
+  type t = A [@deprecated] | B
+  type s = t = A | B
+end
+
+
+(* Fields *)
+
+module FIELD :
+sig type t = {mutable x: int} end =
+struct type t = {mutable x: int [@deprecated_mutable]} end
+
+module FIELD1 = struct
+  type t = {mutable x: int [@deprecated_mutable]}
+  type s = t = {mutable x: int}
+end
+
+(* Types *)
+
+module TYPE : sig type t = int end = struct type t = int [@@deprecated] end
+
+(* Class, class types *)
+
+module CL :
+sig class c : object end end =
+struct class c = object end [@@deprecated "FOO"] end
+
+module CLT :
+sig class type c = object end end =
+struct class type c = object end [@@deprecated "FOO"] end
+
+
+(* Module types *)
+
+module MT :
+sig module type S = sig end end =
+struct module type S = sig end [@@deprecated "FOO"] end
+
+module MT_OK :
+sig module type S = sig end [@@deprecated] end =
+struct module type S = sig end [@@deprecated "FOO"] end
+
+
+(* Modules *)
+
+module MD :
+sig module M : sig end end =
+struct module M = struct end [@@deprecated "FOO"] end
+
+module MD_OK :
+sig module M : sig end [@@deprecated] end =
+struct module M = struct end [@@deprecated "FOO"] end
diff --git a/testsuite/tests/warnings/deprecated_module_use.compilers.reference b/testsuite/tests/warnings/deprecated_module_use.compilers.reference
new file mode 100644
index 00000000..c713064f
--- /dev/null
+++ b/testsuite/tests/warnings/deprecated_module_use.compilers.reference
@@ -0,0 +1,24 @@
+File "deprecated_module_use.ml", line 18, characters 5-22:
+18 | open Deprecated_module
+          ^^^^^^^^^^^^^^^^^
+Alert deprecated: module Deprecated_module
+
+  As you could guess, Deprecated_module is deprecated.
+  Please use something else!
+
+File "deprecated_module_use.ml", line 20, characters 9-12:
+20 | type s = M.t
+              ^^^
+Alert deprecated: module Deprecated_module.M
+File "deprecated_module_use.ml", line 20, characters 9-12:
+20 | type s = M.t
+              ^^^
+Alert deprecated: Deprecated_module.M.t
+File "deprecated_module_use.ml", line 22, characters 5-6:
+22 | open M
+          ^
+Alert deprecated: module Deprecated_module.M
+File "deprecated_module_use.ml", line 23, characters 8-9:
+23 | let _ = x
+             ^
+Alert deprecated: Deprecated_module.M.x
diff --git a/testsuite/tests/warnings/deprecated_module_use.ml b/testsuite/tests/warnings/deprecated_module_use.ml
new file mode 100644
index 00000000..adf01474
--- /dev/null
+++ b/testsuite/tests/warnings/deprecated_module_use.ml
@@ -0,0 +1,23 @@
+(* TEST
+
+modules = "deprecated_module.mli deprecated_module.ml"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+flags = "-w a"
+module = "deprecated_module.mli"
+*** ocamlc.byte
+module = "deprecated_module.ml"
+**** ocamlc.byte
+flags = "-w A"
+module = "deprecated_module_use.ml"
+***** check-ocamlc.byte-output
+
+*)
+
+open Deprecated_module
+
+type s = M.t
+
+open M
+let _ = x
diff --git a/testsuite/tests/warnings/module_without_cmx.mli b/testsuite/tests/warnings/module_without_cmx.mli
new file mode 100644
index 00000000..36ca7dba
--- /dev/null
+++ b/testsuite/tests/warnings/module_without_cmx.mli
@@ -0,0 +1,2 @@
+
+val id : 'a -> 'a
diff --git a/testsuite/tests/warnings/w01.compilers.reference b/testsuite/tests/warnings/w01.compilers.reference
new file mode 100644
index 00000000..6973f4d5
--- /dev/null
+++ b/testsuite/tests/warnings/w01.compilers.reference
@@ -0,0 +1,27 @@
+File "w01.ml", line 14, characters 12-14:
+14 | let foo = ( *);;
+                 ^^
+Warning 2: this is not the end of a comment.
+File "w01.ml", line 20, characters 0-3:
+20 | f 1; f 1;;
+     ^^^
+Warning 5: this function application is partial,
+maybe some arguments are missing.
+File "w01.ml", line 30, characters 4-5:
+30 | let 1 = 1;;
+         ^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+0
+File "w01.ml", line 35, characters 0-1:
+35 | 1; 1;;
+     ^
+Warning 10: this expression should have type unit.
+File "w01.ml", line 42, characters 2-3:
+42 | | 1 -> ()
+       ^
+Warning 11: this match case is unused.
+File "w01.ml", line 19, characters 8-9:
+19 | let f x y = x;;
+             ^
+Warning 27: unused variable y.
diff --git a/testsuite/tests/warnings/w01.ml b/testsuite/tests/warnings/w01.ml
new file mode 100644
index 00000000..91782259
--- /dev/null
+++ b/testsuite/tests/warnings/w01.ml
@@ -0,0 +1,54 @@
+(* TEST
+
+flags = "-w A"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+(* C *)
+
+let foo = ( *);;
+
+
+(* F *)
+
+let f x y = x;;
+f 1; f 1;;
+
+
+(* M *)
+
+(* duh *)
+
+
+(* P *)
+
+let 1 = 1;;
+
+
+(* S *)
+
+1; 1;;
+
+
+(* U *)
+
+match 1 with
+| 1 -> ()
+| 1 -> ()
+| _ -> ()
+;;
+
+
+(* V *)
+
+(* re-duh *)
+
+
+(* X *)
+
+(* re-re *)
diff --git a/testsuite/tests/warnings/w03.compilers.reference b/testsuite/tests/warnings/w03.compilers.reference
new file mode 100644
index 00000000..3e75b2ef
--- /dev/null
+++ b/testsuite/tests/warnings/w03.compilers.reference
@@ -0,0 +1,8 @@
+File "w03.ml", line 14, characters 8-9:
+14 | let _ = A
+             ^
+Alert deprecated: A
+File "w03.ml", line 17, characters 12-26:
+17 | exception B [@@deprecated]
+                 ^^^^^^^^^^^^^^
+Warning 53: the "deprecated" attribute cannot appear in this context
diff --git a/testsuite/tests/warnings/w03.ml b/testsuite/tests/warnings/w03.ml
new file mode 100644
index 00000000..b9f70b1d
--- /dev/null
+++ b/testsuite/tests/warnings/w03.ml
@@ -0,0 +1,24 @@
+(* TEST
+
+flags = "-w A"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+exception A [@deprecated]
+
+let _ = A
+
+
+exception B [@@deprecated]
+
+let _ = B
+
+
+exception C [@deprecated]
+
+let _ = B [@warning "-53"]
diff --git a/testsuite/tests/warnings/w04.compilers.reference b/testsuite/tests/warnings/w04.compilers.reference
new file mode 100644
index 00000000..bb39fb4d
--- /dev/null
+++ b/testsuite/tests/warnings/w04.compilers.reference
@@ -0,0 +1,6 @@
+File "w04.ml", lines 21-23, characters 10-8:
+21 | ..........match x with
+22 | | A -> 0
+23 | | _ -> 1
+Warning 4: this pattern-matching is fragile.
+It will remain exhaustive when constructors are added to type t.
diff --git a/testsuite/tests/warnings/w04.ml b/testsuite/tests/warnings/w04.ml
new file mode 100644
index 00000000..dd0fa00f
--- /dev/null
+++ b/testsuite/tests/warnings/w04.ml
@@ -0,0 +1,23 @@
+(* TEST
+
+flags = "-w A"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+[@@@ocaml.warning "+4"]
+
+type expr = E of int [@@unboxed]
+
+
+let f x = match x with (E e) -> e
+
+type t = A | B
+
+let g x = match x with
+| A -> 0
+| _ -> 1
diff --git a/testsuite/tests/warnings/w04_failure.compilers.reference b/testsuite/tests/warnings/w04_failure.compilers.reference
new file mode 100644
index 00000000..d0fac4da
--- /dev/null
+++ b/testsuite/tests/warnings/w04_failure.compilers.reference
@@ -0,0 +1,21 @@
+File "w04_failure.ml", lines 20-23, characters 2-17:
+20 | ..match r1, r2, t with
+21 |   | AB, _, A -> ()
+22 |   | _, XY, X -> ()
+23 |   | _, _, _ -> ()
+Warning 4: this pattern-matching is fragile.
+It will remain exhaustive when constructors are added to type repr.
+File "w04_failure.ml", lines 20-23, characters 2-17:
+20 | ..match r1, r2, t with
+21 |   | AB, _, A -> ()
+22 |   | _, XY, X -> ()
+23 |   | _, _, _ -> ()
+Warning 4: this pattern-matching is fragile.
+It will remain exhaustive when constructors are added to type ab.
+File "w04_failure.ml", lines 20-23, characters 2-17:
+20 | ..match r1, r2, t with
+21 |   | AB, _, A -> ()
+22 |   | _, XY, X -> ()
+23 |   | _, _, _ -> ()
+Warning 4: this pattern-matching is fragile.
+It will remain exhaustive when constructors are added to type xy.
diff --git a/testsuite/tests/warnings/w04_failure.ml b/testsuite/tests/warnings/w04_failure.ml
new file mode 100644
index 00000000..98a84ff1
--- /dev/null
+++ b/testsuite/tests/warnings/w04_failure.ml
@@ -0,0 +1,39 @@
+(* TEST
+
+flags = "-w A"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+type ab = A | B
+type xy = X | Y
+
+type _ repr = AB : ab repr | XY : xy repr
+
+(* Correctly reports fragility w.r.t. [repr], [ab] and [xy]. *)
+
+let vocal_fragile (type t) (r1 : t repr) (r2 : t repr) (t : t) =
+  match r1, r2, t with
+  | AB, _, A -> ()
+  | _, XY, X -> ()
+  | _, _, _ -> ()
+
+(* Fails to report fragility on [ab] and [xy]. *)
+
+let silent_fragile1 (type t) (r1 : t repr) (r2 : t repr) (t : t) =
+  match r1, r2, t with
+  | AB, _, A -> ()
+  | _, XY, X -> ()
+  | _, AB, _ -> ()
+  | XY, _, _ -> ()
+
+let silent_fragile2 (type t) (r1 : t repr) (r2 : t repr) (t : t) =
+  match r1, r2, t with
+  | AB, _, A -> ()
+  | _, XY, X -> ()
+  | AB, _, _ -> ()
+  | _, XY, _ -> ()
diff --git a/testsuite/tests/warnings/w06.compilers.reference b/testsuite/tests/warnings/w06.compilers.reference
new file mode 100644
index 00000000..4a118e20
--- /dev/null
+++ b/testsuite/tests/warnings/w06.compilers.reference
@@ -0,0 +1,8 @@
+File "w06.ml", line 16, characters 9-12:
+16 | let () = foo 2
+              ^^^
+Warning 6: label bar was omitted in the application of this function.
+File "w06.ml", line 17, characters 9-12:
+17 | let () = bar 4 2
+              ^^^
+Warning 6: labels foo, baz were omitted in the application of this function.
diff --git a/testsuite/tests/warnings/w06.ml b/testsuite/tests/warnings/w06.ml
new file mode 100644
index 00000000..e8c64ffb
--- /dev/null
+++ b/testsuite/tests/warnings/w06.ml
@@ -0,0 +1,17 @@
+(* TEST
+
+flags = "-w A"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+let foo ~bar = ignore bar (* one label *)
+
+let bar ~foo ~baz = ignore (foo, baz) (* two labels *)
+
+let () = foo 2
+let () = bar 4 2
diff --git a/testsuite/tests/warnings/w32.compilers.reference b/testsuite/tests/warnings/w32.compilers.reference
new file mode 100644
index 00000000..6cf44b0b
--- /dev/null
+++ b/testsuite/tests/warnings/w32.compilers.reference
@@ -0,0 +1,83 @@
+File "w32.mli", line 12, characters 10-11:
+12 | module F (X : sig val x : int end) : sig end
+               ^
+Warning 67: unused functor parameter X.
+File "w32.mli", line 14, characters 10-11:
+14 | module G (X : sig val x : int end) : sig end
+               ^
+Warning 67: unused functor parameter X.
+File "w32.mli", line 16, characters 10-11:
+16 | module H (X : sig val x : int end) : sig val x : int end
+               ^
+Warning 67: unused functor parameter X.
+File "w32.ml", line 40, characters 24-25:
+40 | let[@warning "-32"] rec q x = x
+                             ^
+Warning 39: unused rec flag.
+File "w32.ml", line 43, characters 24-25:
+43 | let[@warning "-32"] rec s x = x
+                             ^
+Warning 39: unused rec flag.
+File "w32.ml", line 20, characters 4-5:
+20 | let h x = x
+         ^
+Warning 32: unused value h.
+File "w32.ml", line 26, characters 4-5:
+26 | and j x = x
+         ^
+Warning 32: unused value j.
+File "w32.ml", line 28, characters 4-5:
+28 | let k x = x
+         ^
+Warning 32: unused value k.
+File "w32.ml", line 41, characters 4-5:
+41 | and r x = x
+         ^
+Warning 32: unused value r.
+File "w32.ml", line 44, characters 20-21:
+44 | and[@warning "-39"] t x = x
+                         ^
+Warning 32: unused value t.
+File "w32.ml", line 46, characters 24-25:
+46 | let[@warning "-39"] rec u x = x
+                             ^
+Warning 32: unused value u.
+File "w32.ml", line 47, characters 4-5:
+47 | and v x = v x
+         ^
+Warning 32: unused value v.
+File "w32.ml", line 55, characters 22-23:
+55 |   let[@warning "+32"] g x = x
+                           ^
+Warning 32: unused value g.
+File "w32.ml", line 56, characters 22-23:
+56 |   let[@warning "+32"] h x = x
+                           ^
+Warning 32: unused value h.
+File "w32.ml", line 59, characters 22-23:
+59 |   and[@warning "+32"] k x = x
+                           ^
+Warning 32: unused value k.
+File "w32.ml", lines 52-60, characters 0-3:
+52 | module M = struct
+53 |   [@@@warning "-32"]
+54 |   let f x = x
+55 |   let[@warning "+32"] g x = x
+56 |   let[@warning "+32"] h x = x
+57 |   and i x = x
+58 |   let j x = x
+59 |   and[@warning "+32"] k x = x
+60 | end
+Warning 60: unused module M.
+File "w32.ml", line 63, characters 18-29:
+63 | module F (X : sig val x : int end) = struct end
+                       ^^^^^^^^^^^
+Warning 32: unused value x.
+File "w32.ml", line 63, characters 10-11:
+63 | module F (X : sig val x : int end) = struct end
+               ^
+Warning 60: unused module X.
+File "w32.ml", line 65, characters 18-29:
+65 | module G (X : sig val x : int end) = X
+                       ^^^^^^^^^^^
+Warning 32: unused value x.
diff --git a/testsuite/tests/warnings/w32.ml b/testsuite/tests/warnings/w32.ml
new file mode 100644
index 00000000..cab52568
--- /dev/null
+++ b/testsuite/tests/warnings/w32.ml
@@ -0,0 +1,67 @@
+(* TEST
+
+flags = "-w A"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+module = "w32.mli"
+*** ocamlc.byte
+module = "w32.ml"
+**** check-ocamlc.byte-output
+
+*)
+
+(* from MPR#7624 *)
+
+let[@warning "-32"] f x = x
+
+let g x = x
+
+let h x = x
+
+
+(* multiple bindings *)
+
+let[@warning "-32"] i x = x
+and j x = x
+
+let k x = x
+and[@warning "-32"] l x = x
+
+let[@warning "-32"] m x = x
+and n x = x
+
+let o x = x
+and[@warning "-32"] p x = x
+
+
+(* recursive bindings *)
+
+let[@warning "-32"] rec q x = x
+and r x = x
+
+let[@warning "-32"] rec s x = x
+and[@warning "-39"] t x = x
+
+let[@warning "-39"] rec u x = x
+and v x = v x
+
+
+(* disabled then re-enabled warnings *)
+
+module M = struct
+  [@@@warning "-32"]
+  let f x = x
+  let[@warning "+32"] g x = x
+  let[@warning "+32"] h x = x
+  and i x = x
+  let j x = x
+  and[@warning "+32"] k x = x
+end
+
+(* unused values in functor argument *)
+module F (X : sig val x : int end) = struct end
+
+module G (X : sig val x : int end) = X
+
+module H (X : sig val x : int end) = X
diff --git a/testsuite/tests/warnings/w32.mli b/testsuite/tests/warnings/w32.mli
new file mode 100644
index 00000000..8ffe03dd
--- /dev/null
+++ b/testsuite/tests/warnings/w32.mli
@@ -0,0 +1,16 @@
+(* from MPR#7624 *)
+
+val g : 'a -> 'a
+
+
+(* multiple bindings *)
+val n : 'a -> 'a
+
+val o : 'a -> 'a
+
+(* value in functor argument *)
+module F (X : sig val x : int end) : sig end
+
+module G (X : sig val x : int end) : sig end
+
+module H (X : sig val x : int end) : sig val x : int end
diff --git a/testsuite/tests/warnings/w32b.compilers.reference b/testsuite/tests/warnings/w32b.compilers.reference
new file mode 100644
index 00000000..79ba5c85
--- /dev/null
+++ b/testsuite/tests/warnings/w32b.compilers.reference
@@ -0,0 +1,8 @@
+File "w32b.ml", line 13, characters 18-24:
+13 | module Q (M : sig type t end) = struct end
+                       ^^^^^^
+Warning 34: unused type t.
+File "w32b.ml", line 13, characters 10-11:
+13 | module Q (M : sig type t end) = struct end
+               ^
+Warning 60: unused module M.
diff --git a/testsuite/tests/warnings/w32b.ml b/testsuite/tests/warnings/w32b.ml
new file mode 100644
index 00000000..7f56659e
--- /dev/null
+++ b/testsuite/tests/warnings/w32b.ml
@@ -0,0 +1,13 @@
+(* TEST
+
+flags = "-w A"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+(* Check that [t] is considered unused without an .mli file (see GPR#1358) *)
+module Q (M : sig type t end) = struct end
diff --git a/testsuite/tests/warnings/w33.compilers.reference b/testsuite/tests/warnings/w33.compilers.reference
new file mode 100644
index 00000000..52b77b10
--- /dev/null
+++ b/testsuite/tests/warnings/w33.compilers.reference
@@ -0,0 +1,12 @@
+File "w33.ml", line 19, characters 6-11:
+19 | let f M.(x) = x (* useless open *)
+           ^^^^^
+Warning 33: unused open M.
+File "w33.ml", line 26, characters 0-7:
+26 | open! M (* useless open! *)
+     ^^^^^^^
+Warning 66: unused open! M.
+File "w33.ml", line 27, characters 0-6:
+27 | open M (* useless open *)
+     ^^^^^^
+Warning 33: unused open M.
diff --git a/testsuite/tests/warnings/w33.ml b/testsuite/tests/warnings/w33.ml
new file mode 100644
index 00000000..cff8d9f3
--- /dev/null
+++ b/testsuite/tests/warnings/w33.ml
@@ -0,0 +1,27 @@
+(* TEST
+
+flags = "-w A"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+(** Test unused opens, in particular in presence of
+     pattern open *)
+
+module M = struct end
+module N = struct type t = A | B end
+module R = struct type r = {x: int} end
+
+let f M.(x) = x (* useless open *)
+let g N.(A|B) = () (* used open *)
+let h R.{x} = R.{x}
+
+open N (* used open *)
+let i (A|B) = B
+
+open! M (* useless open! *)
+open M (* useless open *)
diff --git a/testsuite/tests/warnings/w45.compilers.reference b/testsuite/tests/warnings/w45.compilers.reference
new file mode 100644
index 00000000..74830f68
--- /dev/null
+++ b/testsuite/tests/warnings/w45.compilers.reference
@@ -0,0 +1,13 @@
+File "w45.ml", line 24, characters 2-9:
+24 |   open T2 (* shadow X, which is later used; but not A, see #6762 *)
+       ^^^^^^^
+Warning 45: this open statement shadows the constructor X (which is later used)
+File "w45.ml", line 26, characters 14-15:
+26 |   let _ = (A, X) (* X belongs to several types *)
+                   ^
+Warning 41: X belongs to several types: T2.s T1.s
+The first one was selected. Please disambiguate if this is wrong.
+File "w45.ml", line 23, characters 2-9:
+23 |   open T1 (* unused open *)
+       ^^^^^^^
+Warning 33: unused open T1.
diff --git a/testsuite/tests/warnings/w45.ml b/testsuite/tests/warnings/w45.ml
new file mode 100644
index 00000000..3442c745
--- /dev/null
+++ b/testsuite/tests/warnings/w45.ml
@@ -0,0 +1,27 @@
+(* TEST
+
+flags = "-w A"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+module T1 = struct
+  type t = A
+  type s = X
+end
+
+module T2 = struct
+  type t = T1.t = A
+  type s = X
+end
+
+module T3 = struct
+  open T1 (* unused open *)
+  open T2 (* shadow X, which is later used; but not A, see #6762 *)
+
+  let _ = (A, X) (* X belongs to several types *)
+end
diff --git a/testsuite/tests/warnings/w47_inline.compilers.reference b/testsuite/tests/warnings/w47_inline.compilers.reference
new file mode 100644
index 00000000..c9048adc
--- /dev/null
+++ b/testsuite/tests/warnings/w47_inline.compilers.reference
@@ -0,0 +1,42 @@
+File "w47_inline.ml", line 30, characters 20-22:
+30 |   let[@local never] f2 x = x (* ok *) in
+                         ^^
+Warning 26: unused variable f2.
+File "w47_inline.ml", line 31, characters 24-26:
+31 |   let[@local malformed] f3 x = x (* bad payload *) in
+                             ^^
+Warning 26: unused variable f3.
+File "w47_inline.ml", line 15, characters 23-29:
+15 | let d = (fun x -> x) [@inline malformed attribute] (* rejected *)
+                            ^^^^^^
+Warning 47: illegal payload for attribute 'inline'.
+It must be either 'never', 'always', 'hint' or empty
+File "w47_inline.ml", line 16, characters 23-29:
+16 | let e = (fun x -> x) [@inline malformed_attribute] (* rejected *)
+                            ^^^^^^
+Warning 47: illegal payload for attribute 'inline'.
+It must be either 'never', 'always', 'hint' or empty
+File "w47_inline.ml", line 17, characters 23-29:
+17 | let f = (fun x -> x) [@inline : malformed_attribute] (* rejected *)
+                            ^^^^^^
+Warning 47: illegal payload for attribute 'inline'.
+It must be either 'never', 'always', 'hint' or empty
+File "w47_inline.ml", line 18, characters 23-29:
+18 | let g = (fun x -> x) [@inline ? malformed_attribute] (* rejected *)
+                            ^^^^^^
+Warning 47: illegal payload for attribute 'inline'.
+It must be either 'never', 'always', 'hint' or empty
+File "w47_inline.ml", line 23, characters 15-22:
+23 | let k x = (a [@inlined malformed]) x (* rejected *)
+                    ^^^^^^^
+Warning 47: illegal payload for attribute 'inlined'.
+It must be either 'never', 'always', 'hint' or empty
+File "w47_inline.ml", line 31, characters 7-12:
+31 |   let[@local malformed] f3 x = x (* bad payload *) in
+            ^^^^^
+Warning 47: illegal payload for attribute 'local'.
+It must be either 'never', 'always', 'maybe' or empty
+File "w47_inline.ml", line 32, characters 17-26:
+32 |   let[@local] f4 x = 2 * x (* not local *) in
+                      ^^^^^^^^^
+Warning 55: Cannot inline: This function cannot be compiled into a static continuation
diff --git a/testsuite/tests/warnings/w47_inline.ml b/testsuite/tests/warnings/w47_inline.ml
new file mode 100644
index 00000000..e4b74860
--- /dev/null
+++ b/testsuite/tests/warnings/w47_inline.ml
@@ -0,0 +1,41 @@
+(* TEST
+
+flags = "-w A"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+let a = (fun x -> x) [@inline] (* accepted *)
+let b = (fun x -> x) [@inline never] (* accepted *)
+let c = (fun x -> x) [@inline always] (* accepted *)
+let d = (fun x -> x) [@inline malformed attribute] (* rejected *)
+let e = (fun x -> x) [@inline malformed_attribute] (* rejected *)
+let f = (fun x -> x) [@inline : malformed_attribute] (* rejected *)
+let g = (fun x -> x) [@inline ? malformed_attribute] (* rejected *)
+
+let h x = (a [@inlined]) x (* accepted *)
+let i x = (a [@inlined never]) x (* accepted *)
+let j x = (a [@inlined always]) x (* accepted *)
+let k x = (a [@inlined malformed]) x (* rejected *)
+
+let l x = x [@@inline] (* accepted *)
+
+
+let test x =
+  let[@local always] f1 x = x (* ok *) in
+  let[@local never] f2 x = x (* ok *) in
+  let[@local malformed] f3 x = x (* bad payload *) in
+  let[@local] f4 x = 2 * x (* not local *) in
+  let[@local] f5 x = f1 x (* ok *) in
+  let[@local] f6 x = 3 * x (* ok *) in
+  let r =
+    if x = 1 then f1 x
+    else if x = 2 then f4 x
+    else if x = 3 then f1 x
+    else f5 x
+  in
+  f4 (f6 r)
diff --git a/testsuite/tests/warnings/w50.compilers.reference b/testsuite/tests/warnings/w50.compilers.reference
new file mode 100644
index 00000000..5b41948c
--- /dev/null
+++ b/testsuite/tests/warnings/w50.compilers.reference
@@ -0,0 +1,8 @@
+File "w50.ml", line 13, characters 2-17:
+13 |   module L = List
+       ^^^^^^^^^^^^^^^
+Warning 60: unused module L.
+File "w50.ml", line 17, characters 2-16:
+17 |   module Y1 = X1
+       ^^^^^^^^^^^^^^
+Warning 60: unused module Y1.
diff --git a/testsuite/tests/warnings/w50.ml b/testsuite/tests/warnings/w50.ml
new file mode 100644
index 00000000..d0ac351c
--- /dev/null
+++ b/testsuite/tests/warnings/w50.ml
@@ -0,0 +1,18 @@
+(* TEST
+
+flags = "-w A"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+module A : sig end = struct
+  module L = List
+
+  module X1 = struct end
+
+  module Y1 = X1
+end
diff --git a/testsuite/tests/warnings/w51.compilers.reference b/testsuite/tests/warnings/w51.compilers.reference
new file mode 100644
index 00000000..b09e55a9
--- /dev/null
+++ b/testsuite/tests/warnings/w51.compilers.reference
@@ -0,0 +1,4 @@
+File "w51.ml", line 14, characters 13-37:
+14 |   | n -> n * (fact [@tailcall]) (n-1)
+                  ^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 51: expected tailcall
diff --git a/testsuite/tests/warnings/w51.ml b/testsuite/tests/warnings/w51.ml
new file mode 100644
index 00000000..18d03ffe
--- /dev/null
+++ b/testsuite/tests/warnings/w51.ml
@@ -0,0 +1,15 @@
+(* TEST
+
+flags = "-w A"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+let rec fact = function
+  | 1 -> 1
+  | n -> n * (fact [@tailcall]) (n-1)
+;;
diff --git a/testsuite/tests/warnings/w51_bis.compilers.reference b/testsuite/tests/warnings/w51_bis.compilers.reference
new file mode 100644
index 00000000..79163112
--- /dev/null
+++ b/testsuite/tests/warnings/w51_bis.compilers.reference
@@ -0,0 +1,4 @@
+File "w51_bis.ml", line 15, characters 12-48:
+15 |         try (foldl [@tailcall]) op (op x acc) xs
+                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 51: expected tailcall
diff --git a/testsuite/tests/warnings/w51_bis.ml b/testsuite/tests/warnings/w51_bis.ml
new file mode 100644
index 00000000..58382556
--- /dev/null
+++ b/testsuite/tests/warnings/w51_bis.ml
@@ -0,0 +1,16 @@
+(* TEST
+
+flags = "-w A"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+let rec foldl op acc = function
+    [] -> acc
+    | x :: xs ->
+        try (foldl [@tailcall]) op (op x acc) xs
+        with Not_found -> assert false
diff --git a/testsuite/tests/warnings/w52.ml b/testsuite/tests/warnings/w52.ml
new file mode 100644
index 00000000..2f9e77be
--- /dev/null
+++ b/testsuite/tests/warnings/w52.ml
@@ -0,0 +1,100 @@
+(* TEST
+   flags = "-w A"
+   * expect
+*)
+
+let () = try () with Invalid_argument "Any" -> ();;
+[%%expect{|
+Line 1, characters 38-43:
+1 | let () = try () with Invalid_argument "Any" -> ();;
+                                          ^^^^^
+Warning 52: Code should not depend on the actual values of
+this constructor's arguments. They are only for information
+and may change in future versions. (See manual section 9.5)
+|}];;
+
+let () = try () with Match_failure ("Any",_,_) -> ();;
+[%%expect{|
+Line 1, characters 35-46:
+1 | let () = try () with Match_failure ("Any",_,_) -> ();;
+                                       ^^^^^^^^^^^
+Warning 52: Code should not depend on the actual values of
+this constructor's arguments. They are only for information
+and may change in future versions. (See manual section 9.5)
+|}];;
+
+let () = try () with Match_failure (_,0,_) -> ();;
+[%%expect{|
+Line 1, characters 35-42:
+1 | let () = try () with Match_failure (_,0,_) -> ();;
+                                       ^^^^^^^
+Warning 52: Code should not depend on the actual values of
+this constructor's arguments. They are only for information
+and may change in future versions. (See manual section 9.5)
+|}];;
+
+type t =
+  | Warn of string  [@ocaml.warn_on_literal_pattern]
+  | Without_warning of string
+  | Warn' of nativeint [@ocaml.warn_on_literal_pattern]
+  | Deep of (string * int) list [@ocaml.warn_on_literal_pattern];;
+[%%expect{|
+type t =
+    Warn of string
+  | Without_warning of string
+  | Warn' of nativeint
+  | Deep of (string * int) list
+|}];;
+
+let f = function
+| Warn "anything" -> ()
+| Warn _ | Warn' _ | Without_warning _ | Deep _ -> ();;
+[%%expect{|
+Line 2, characters 7-17:
+2 | | Warn "anything" -> ()
+           ^^^^^^^^^^
+Warning 52: Code should not depend on the actual values of
+this constructor's arguments. They are only for information
+and may change in future versions. (See manual section 9.5)
+val f : t -> unit = 
+|}];;
+
+let g = function
+| Warn' 0n -> ()
+| Warn _ | Warn' _ | Without_warning _ | Deep _ -> ();;
+[%%expect{|
+Line 2, characters 8-10:
+2 | | Warn' 0n -> ()
+            ^^
+Warning 52: Code should not depend on the actual values of
+this constructor's arguments. They are only for information
+and may change in future versions. (See manual section 9.5)
+val g : t -> unit = 
+|}];;
+
+let h = function
+| Without_warning "outside" -> ()
+| Warn _ | Warn' _ | Without_warning _ | Deep _ -> ();;
+[%%expect{|
+val h : t -> unit = 
+|}];;
+
+let i = function
+| Deep (_ :: _ :: _ :: _) -> ()
+| Warn _ | Warn' _ | Without_warning _ | Deep _ -> ();;
+[%%expect{|
+val i : t -> unit = 
+|}];;
+
+let j = function
+| Deep (_ :: _ :: ("deep",_) :: _) -> ()
+| Warn _ | Warn' _ | Without_warning _ | Deep _ -> ();;
+[%%expect{|
+Line 2, characters 7-34:
+2 | | Deep (_ :: _ :: ("deep",_) :: _) -> ()
+           ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 52: Code should not depend on the actual values of
+this constructor's arguments. They are only for information
+and may change in future versions. (See manual section 9.5)
+val j : t -> unit = 
+|}];;
diff --git a/testsuite/tests/warnings/w53.compilers.reference b/testsuite/tests/warnings/w53.compilers.reference
new file mode 100644
index 00000000..e8ee95f3
--- /dev/null
+++ b/testsuite/tests/warnings/w53.compilers.reference
@@ -0,0 +1,52 @@
+File "w53.ml", line 12, characters 4-5:
+12 | let h x = x [@inline] (* rejected *)
+         ^
+Warning 32: unused value h.
+File "w53.ml", line 12, characters 14-20:
+12 | let h x = x [@inline] (* rejected *)
+                   ^^^^^^
+Warning 53: the "inline" attribute cannot appear in this context
+File "w53.ml", line 13, characters 14-26:
+13 | let h x = x [@ocaml.inline] (* rejected *)
+                   ^^^^^^^^^^^^
+Warning 53: the "ocaml.inline" attribute cannot appear in this context
+File "w53.ml", line 15, characters 14-21:
+15 | let i x = x [@inlined] (* rejected *)
+                   ^^^^^^^
+Warning 53: the "inlined" attribute cannot appear in this context
+File "w53.ml", line 16, characters 14-27:
+16 | let j x = x [@ocaml.inlined] (* rejected *)
+                   ^^^^^^^^^^^^^
+Warning 53: the "ocaml.inlined" attribute cannot appear in this context
+File "w53.ml", line 19, characters 16-23:
+19 | let l x = h x [@inlined] (* rejected *)
+                     ^^^^^^^
+Warning 53: the "inlined" attribute cannot appear in this context
+File "w53.ml", line 21, characters 14-22:
+21 | let m x = x [@tailcall] (* rejected *)
+                   ^^^^^^^^
+Warning 53: the "tailcall" attribute cannot appear in this context
+File "w53.ml", line 22, characters 14-28:
+22 | let n x = x [@ocaml.tailcall] (* rejected *)
+                   ^^^^^^^^^^^^^^
+Warning 53: the "ocaml.tailcall" attribute cannot appear in this context
+File "w53.ml", line 25, characters 16-24:
+25 | let q x = h x [@tailcall] (* rejected *)
+                     ^^^^^^^^
+Warning 53: the "tailcall" attribute cannot appear in this context
+File "w53.ml", line 33, characters 0-32:
+33 | module C = struct end [@@inline] (* rejected *)
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 53: the "inline" attribute cannot appear in this context
+File "w53.ml", line 34, characters 0-39:
+34 | module C' = struct end [@@ocaml.inline] (* rejected *)
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 53: the "inline" attribute cannot appear in this context
+File "w53.ml", line 40, characters 16-22:
+40 | module G = (A [@inline])(struct end) (* rejected *)
+                     ^^^^^^
+Warning 53: the "inline" attribute cannot appear in this context
+File "w53.ml", line 41, characters 17-29:
+41 | module G' = (A [@ocaml.inline])(struct end) (* rejected *)
+                      ^^^^^^^^^^^^
+Warning 53: the "ocaml.inline" attribute cannot appear in this context
diff --git a/testsuite/tests/warnings/w53.ml b/testsuite/tests/warnings/w53.ml
new file mode 100644
index 00000000..63a0a83b
--- /dev/null
+++ b/testsuite/tests/warnings/w53.ml
@@ -0,0 +1,43 @@
+(* TEST
+
+flags = "-w A-60"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+let h x = x [@inline] (* rejected *)
+let h x = x [@ocaml.inline] (* rejected *)
+
+let i x = x [@inlined] (* rejected *)
+let j x = x [@ocaml.inlined] (* rejected *)
+let k x = (h [@inlined]) x (* accepted *)
+let k' x = (h [@ocaml.inlined]) x (* accepted *)
+let l x = h x [@inlined] (* rejected *)
+
+let m x = x [@tailcall] (* rejected *)
+let n x = x [@ocaml.tailcall] (* rejected *)
+let o x = (h [@tailcall]) x (* accepted *)
+let p x = (h [@ocaml.tailcall]) x (* accepted *)
+let q x = h x [@tailcall] (* rejected *)
+
+module type E = sig end
+
+module A(E:E) = struct end [@@inline] (* accepted *)
+module A'(E:E) = struct end [@@ocaml.inline] (* accepted *)
+module B = ((functor (E:E) -> struct end) [@inline]) (* accepted *)
+module B' = ((functor (E:E) -> struct end) [@ocaml.inline]) (* accepted *)
+module C = struct end [@@inline] (* rejected *)
+module C' = struct end [@@ocaml.inline] (* rejected *)
+module D = struct end [@@inlined] (* rejected *)
+module D' = struct end [@@ocaml.inlined] (* rejected *)
+
+module F = (A [@inlined])(struct end) (* accepted *)
+module F' = (A [@ocaml.inlined])(struct end) (* accepted *)
+module G = (A [@inline])(struct end) (* rejected *)
+module G' = (A [@ocaml.inline])(struct end) (* rejected *)
+
+module H = Set.Make [@inlined] (Int32) (* GPR#1808 *)
diff --git a/testsuite/tests/warnings/w54.compilers.reference b/testsuite/tests/warnings/w54.compilers.reference
new file mode 100644
index 00000000..e476122c
--- /dev/null
+++ b/testsuite/tests/warnings/w54.compilers.reference
@@ -0,0 +1,16 @@
+File "w54.ml", line 12, characters 33-39:
+12 | let f = (fun x -> x) [@inline] [@inline never]
+                                      ^^^^^^
+Warning 54: the "inline" attribute is used more than once on this expression
+File "w54.ml", line 13, characters 51-63:
+13 | let g = (fun x -> x) [@inline] [@something_else] [@ocaml.inline]
+                                                        ^^^^^^^^^^^^
+Warning 54: the "ocaml.inline" attribute is used more than once on this expression
+File "w54.ml", line 15, characters 26-39:
+15 | let h x = (g [@inlined] [@ocaml.inlined never]) x
+                               ^^^^^^^^^^^^^
+Warning 54: the "ocaml.inlined" attribute is used more than once on this expression
+File "w54.ml", line 19, characters 0-43:
+19 | let i = ((fun x -> x) [@inline]) [@@inline]
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 54: the "inline" attribute is used more than once on this expression
diff --git a/testsuite/tests/warnings/w54.ml b/testsuite/tests/warnings/w54.ml
new file mode 100644
index 00000000..95bd04bd
--- /dev/null
+++ b/testsuite/tests/warnings/w54.ml
@@ -0,0 +1,19 @@
+(* TEST
+
+flags = "-w A"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+let f = (fun x -> x) [@inline] [@inline never]
+let g = (fun x -> x) [@inline] [@something_else] [@ocaml.inline]
+
+let h x = (g [@inlined] [@ocaml.inlined never]) x
+
+let v = ((fun x -> x) [@inline] [@inlined]) 1 (* accepted *)
+
+let i = ((fun x -> x) [@inline]) [@@inline]
diff --git a/testsuite/tests/warnings/w55.flambda.reference b/testsuite/tests/warnings/w55.flambda.reference
new file mode 100644
index 00000000..16012145
--- /dev/null
+++ b/testsuite/tests/warnings/w55.flambda.reference
@@ -0,0 +1,12 @@
+File "w55.ml", line 33, characters 10-26:
+33 | let h x = (j [@inlined]) x
+               ^^^^^^^^^^^^^^^^
+Warning 55: Cannot inline: [@inlined] attributes may not be used on partial applications
+File "w55.ml", line 29, characters 10-27:
+29 | let i x = (!r [@inlined]) x
+               ^^^^^^^^^^^^^^^^^
+Warning 55: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied)
+File "w55.ml", line 39, characters 12-30:
+39 | let b x y = (a [@inlined]) x y
+                 ^^^^^^^^^^^^^^^^^^
+Warning 55: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied)
diff --git a/testsuite/tests/warnings/w55.ml b/testsuite/tests/warnings/w55.ml
new file mode 100644
index 00000000..67fecee7
--- /dev/null
+++ b/testsuite/tests/warnings/w55.ml
@@ -0,0 +1,52 @@
+(* TEST
+
+flags = "-w A"
+compile_only = "true"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+
+* no-flambda
+** setup-ocamlopt.byte-build-env
+*** ocamlopt.byte
+**** check-ocamlopt.byte-output
+
+* flambda
+compiler_reference = "${test_source_directory}/w55.flambda.reference"
+** setup-ocamlopt.byte-build-env
+*** ocamlopt.byte
+**** check-ocamlopt.byte-output
+
+*)
+
+let f = (fun x -> x + 1) [@inline never]
+
+let g x = (f [@inlined]) x
+
+let r = ref f
+
+let i x = (!r [@inlined]) x
+
+let j x y = x + y
+
+let h x = (j [@inlined]) x
+
+let a x =
+  let b = x + 1 in
+  fun y -> y + b
+
+let b x y = (a [@inlined]) x y
+
+let c x = x + 1 [@@inline never]
+let d x = (c [@inlined]) x
+
+let g' x = (f [@inlined hint]) x
+
+let i' x = (!r [@inlined hint]) x
+
+let h' x = (j [@inlined hint]) x
+
+let b' x y = (a [@inlined hint]) x y
+
+let d' x = (c [@inlined hint]) x
diff --git a/testsuite/tests/warnings/w55.native.reference b/testsuite/tests/warnings/w55.native.reference
new file mode 100644
index 00000000..9ffb78f0
--- /dev/null
+++ b/testsuite/tests/warnings/w55.native.reference
@@ -0,0 +1,24 @@
+File "w55.ml", line 25, characters 10-26:
+25 | let g x = (f [@inlined]) x
+               ^^^^^^^^^^^^^^^^
+Warning 55: Cannot inline: Function information unavailable
+File "w55.ml", line 29, characters 10-27:
+29 | let i x = (!r [@inlined]) x
+               ^^^^^^^^^^^^^^^^^
+Warning 55: Cannot inline: Unknown function
+File "w55.ml", line 33, characters 10-26:
+33 | let h x = (j [@inlined]) x
+               ^^^^^^^^^^^^^^^^
+Warning 55: Cannot inline: Partial application
+File "w55.ml", line 39, characters 12-30:
+39 | let b x y = (a [@inlined]) x y
+                 ^^^^^^^^^^^^^^^^^^
+Warning 55: Cannot inline: Over-application
+File "w55.ml", line 39, characters 12-30:
+39 | let b x y = (a [@inlined]) x y
+                 ^^^^^^^^^^^^^^^^^^
+Warning 55: Cannot inline: Function information unavailable
+File "w55.ml", line 42, characters 10-26:
+42 | let d x = (c [@inlined]) x
+               ^^^^^^^^^^^^^^^^
+Warning 55: Cannot inline: Function information unavailable
diff --git a/testsuite/tests/warnings/w58.ml b/testsuite/tests/warnings/w58.ml
new file mode 100644
index 00000000..4e59ca5c
--- /dev/null
+++ b/testsuite/tests/warnings/w58.ml
@@ -0,0 +1,22 @@
+(* TEST
+
+flags = "-w A"
+files = "module_without_cmx.mli"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+module = "module_without_cmx.mli"
+*** ocamlc.byte
+module = "w58.ml"
+**** check-ocamlc.byte-output
+
+* setup-ocamlopt.byte-build-env
+** ocamlopt.byte
+module = "module_without_cmx.mli"
+*** ocamlopt.byte
+module = "w58.ml"
+**** check-ocamlopt.byte-output
+
+*)
+
+let () = print_endline (Module_without_cmx.id "Hello World")
diff --git a/testsuite/tests/warnings/w58.native.reference b/testsuite/tests/warnings/w58.native.reference
new file mode 100644
index 00000000..f913ef94
--- /dev/null
+++ b/testsuite/tests/warnings/w58.native.reference
@@ -0,0 +1,2 @@
+File "_none_", line 1:
+Warning 58: no cmx file was found in path for module Module_without_cmx, and its interface was not compiled with -opaque
diff --git a/testsuite/tests/warnings/w59.flambda.reference b/testsuite/tests/warnings/w59.flambda.reference
new file mode 100644
index 00000000..912da659
--- /dev/null
+++ b/testsuite/tests/warnings/w59.flambda.reference
@@ -0,0 +1,30 @@
+File "w59.ml", line 46, characters 2-43:
+46 |   Obj.set_field (Obj.repr o) 0 (Obj.repr 3);
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 59: A potential assignment to a non-mutable value was detected 
+in this source file.  Such assignments may generate incorrect code 
+when using Flambda.
+File "w59.ml", line 47, characters 2-43:
+47 |   Obj.set_field (Obj.repr p) 0 (Obj.repr 3);
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 59: A potential assignment to a non-mutable value was detected 
+in this source file.  Such assignments may generate incorrect code 
+when using Flambda.
+File "w59.ml", line 48, characters 2-43:
+48 |   Obj.set_field (Obj.repr q) 0 (Obj.repr 3);
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 59: A potential assignment to a non-mutable value was detected 
+in this source file.  Such assignments may generate incorrect code 
+when using Flambda.
+File "w59.ml", line 49, characters 2-43:
+49 |   Obj.set_field (Obj.repr r) 0 (Obj.repr 3)
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 59: A potential assignment to a non-mutable value was detected 
+in this source file.  Such assignments may generate incorrect code 
+when using Flambda.
+File "w59.ml", line 56, characters 2-7:
+56 |   set o
+       ^^^^^
+Warning 59: A potential assignment to a non-mutable value was detected 
+in this source file.  Such assignments may generate incorrect code 
+when using Flambda.
diff --git a/testsuite/tests/warnings/w59.ml b/testsuite/tests/warnings/w59.ml
new file mode 100644
index 00000000..119e3638
--- /dev/null
+++ b/testsuite/tests/warnings/w59.ml
@@ -0,0 +1,65 @@
+(* TEST
+
+flags = "-w A"
+compile_only = "true"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+
+* no-flambda
+** setup-ocamlopt.byte-build-env
+*** ocamlopt.byte
+**** check-ocamlopt.byte-output
+
+* flambda
+compiler_reference = "${test_source_directory}/w59.flambda.reference"
+** setup-ocamlopt.byte-build-env
+*** ocamlopt.byte
+**** check-ocamlopt.byte-output
+
+*)
+
+(* Check that the warning 59 (assignment to immutable value) does not
+   trigger on those examples *)
+let a = Lazy.force (lazy "a")
+let b = Lazy.force (lazy 1)
+let c = Lazy.force (lazy 3.14)
+let d = Lazy.force (lazy 'a')
+let e = Lazy.force (lazy (fun x -> x+1))
+let rec f (x:int) : int = g x and g x = f x
+let h = Lazy.force (lazy f)
+let i = Lazy.force (lazy g)
+let j = Lazy.force (lazy 1L)
+let k = Lazy.force (lazy (1,2))
+let l = Lazy.force (lazy [|3.14|])
+let m = Lazy.force (lazy (Sys.opaque_identity 3.14))
+let n = Lazy.force (lazy None)
+
+(* Check that obviously wrong code is reported *)
+let o = (1,2)
+let p = fun x -> x
+let q = 3.14
+let r = 1
+
+let () =
+  Obj.set_field (Obj.repr o) 0 (Obj.repr 3);
+  Obj.set_field (Obj.repr p) 0 (Obj.repr 3);
+  Obj.set_field (Obj.repr q) 0 (Obj.repr 3);
+  Obj.set_field (Obj.repr r) 0 (Obj.repr 3)
+
+let set v =
+  Obj.set_field (Obj.repr v) 0 (Obj.repr 3)
+  [@@inline]
+
+let () =
+  set o
+
+(* Sys.opaque_identity hides all information and shouldn't warn *)
+
+let opaque = Sys.opaque_identity (1,2)
+let set_opaque =
+  Obj.set_field
+    (Obj.repr opaque)
+    0
+    (Obj.repr 3)
diff --git a/testsuite/tests/warnings/w60.compilers.reference b/testsuite/tests/warnings/w60.compilers.reference
new file mode 100644
index 00000000..9eec5d1e
--- /dev/null
+++ b/testsuite/tests/warnings/w60.compilers.reference
@@ -0,0 +1,4 @@
+File "w60.ml", line 40, characters 13-14:
+40 |   let module M = struct end in
+                  ^
+Warning 60: unused module M.
diff --git a/testsuite/tests/warnings/w60.ml b/testsuite/tests/warnings/w60.ml
new file mode 100644
index 00000000..2e59615c
--- /dev/null
+++ b/testsuite/tests/warnings/w60.ml
@@ -0,0 +1,41 @@
+(* TEST
+
+flags = "-w A-67"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+(* PR#7314 *)
+
+module type Comparable = sig
+  val id: int
+end
+
+module Make_graph (P:sig module Id:Comparable end) = struct
+  let foo = P.Id.id
+end
+
+module Fold_ordered(P: sig module Id:Comparable end) =
+struct
+  include Make_graph(struct module Id = P.Id end)
+end
+
+
+(* PR#7314 *)
+
+module M = struct
+  module N = struct end
+end
+
+module O = M.N
+
+(***************)
+
+let () =
+  (* M is unused, but no warning was emitted before 4.10. *)
+  let module M = struct end in
+  ()
diff --git a/testsuite/tests/warnings/w60.mli b/testsuite/tests/warnings/w60.mli
new file mode 100644
index 00000000..f3c5740c
--- /dev/null
+++ b/testsuite/tests/warnings/w60.mli
@@ -0,0 +1,12 @@
+module type Comparable = sig
+  val id: int
+end
+
+module Fold_ordered(P: sig module Id:Comparable end): sig
+  val foo: int
+end
+
+
+
+module M : sig end
+module O : sig end
diff --git a/testsuite/tests/win-unicode/mltest.compilers.reference b/testsuite/tests/win-unicode/mltest.compilers.reference
new file mode 100644
index 00000000..5a17c421
--- /dev/null
+++ b/testsuite/tests/win-unicode/mltest.compilers.reference
@@ -0,0 +1,83 @@
+val foreign_names : string list = ["été"; "simple"; "sœur"; "你好"]
+val test_files : string list =
+  ["été.txt"; "simple.txt"; "sœur.txt"; "你好.txt"]
+val to_create_and_delete_files : string list =
+  ["верблюды"; "骆驼"; "קעמל"; "اونٹ"; "Lạc đà";
+   "ఒంటె"; "ஒட்டகம்"; "وشتر";
+   "उष्ट्रः"; "اٺ"]
+val foreign_names2 : string list =
+  ["верблюды"; "骆驼"; "קעמל"; "اونٹ"]
+val getenvironmentenv : string -> string = 
+val unix_getcwd : unit -> string = 
+val sys_getcwd : unit -> string = 
+val unix_readdir : string -> string list = 
+val sys_readdir : string -> string list = 
+val test_readdir : (string -> string list) -> string list = 
+val test_open_in : unit -> string list = 
+val test_getenv : unit -> (string * string) list = 
+val test_mkdir : unit -> (bool * bool) list = 
+val test_chdir : (string -> unit) -> (unit -> 'a) -> 'a list = 
+val test_rmdir : unit -> bool list = 
+val test_stat :
+  unit ->
+  (Unix.file_kind * Unix.file_kind * Unix.file_kind * Unix.file_kind) list =
+  
+val test_access : unit -> unit = 
+val test_rename :
+  (string -> string -> unit) -> ((bool * bool) * (bool * bool)) list = 
+val test_open_out : unit -> string list = 
+val test_file_exists : unit -> bool list = 
+val test_remove : unit -> bool list = 
+val create_file : string -> unit = 
+val test_symlink : unit -> bool = 
+- : unit = ()
+val t_unix_readdir : string list =
+  ["été.txt"; "simple.txt"; "sœur.txt"; "你好.txt"]
+val t_sys_readdir : string list =
+  ["été.txt"; "simple.txt"; "sœur.txt"; "你好.txt"]
+val t_open_in : string list =
+  ["été.txt"; "simple.txt"; "sœur.txt"; "你好.txt"]
+val t_open_out : string list =
+  ["Hello, верблюды"; "Hello, 骆驼"; "Hello, קעמל";
+   "Hello, اونٹ"; "Hello, Lạc đà"; "Hello, ఒంటె";
+   "Hello, ஒட்டகம்"; "Hello, وشتر";
+   "Hello, उष्ट्रः"; "Hello, اٺ"]
+val t_file_exists : bool list =
+  [true; true; true; true; true; true; true; true; true; true]
+val t_stat :
+  (Unix.file_kind * Unix.file_kind * Unix.file_kind * Unix.file_kind) list =
+  [(Unix.S_REG, Unix.S_REG, Unix.S_REG, Unix.S_REG);
+   (Unix.S_REG, Unix.S_REG, Unix.S_REG, Unix.S_REG);
+   (Unix.S_REG, Unix.S_REG, Unix.S_REG, Unix.S_REG);
+   (Unix.S_REG, Unix.S_REG, Unix.S_REG, Unix.S_REG);
+   (Unix.S_REG, Unix.S_REG, Unix.S_REG, Unix.S_REG);
+   (Unix.S_REG, Unix.S_REG, Unix.S_REG, Unix.S_REG);
+   (Unix.S_REG, Unix.S_REG, Unix.S_REG, Unix.S_REG);
+   (Unix.S_REG, Unix.S_REG, Unix.S_REG, Unix.S_REG);
+   (Unix.S_REG, Unix.S_REG, Unix.S_REG, Unix.S_REG);
+   (Unix.S_REG, Unix.S_REG, Unix.S_REG, Unix.S_REG)]
+- : unit = ()
+val t_unix_rename : ((bool * bool) * (bool * bool)) list =
+  [((false, true), (true, false)); ((false, true), (true, false));
+   ((false, true), (true, false)); ((false, true), (true, false));
+   ((false, true), (true, false)); ((false, true), (true, false));
+   ((false, true), (true, false)); ((false, true), (true, false));
+   ((false, true), (true, false)); ((false, true), (true, false))]
+val t_sys_rename : ((bool * bool) * (bool * bool)) list =
+  [((false, true), (true, false)); ((false, true), (true, false));
+   ((false, true), (true, false)); ((false, true), (true, false));
+   ((false, true), (true, false)); ((false, true), (true, false));
+   ((false, true), (true, false)); ((false, true), (true, false));
+   ((false, true), (true, false)); ((false, true), (true, false))]
+- : bool list =
+[false; false; false; false; false; false; false; false; false; false]
+- : (bool * bool) list =
+[(true, true); (true, true); (true, true); (true, true)]
+val t_sys_chdir : string list = ["été"; "simple"; "sœur"; "你好"]
+val t_unix_chdir : string list = ["été"; "simple"; "sœur"; "你好"]
+- : bool list = [false; false; false; false]
+val t_getenv : (string * string) list =
+  [("верблюды", "верблюды"); ("骆驼", "骆驼");
+   ("קעמל", "קעמל"); ("اونٹ", "اونٹ")]
+- : bool = true
+
diff --git a/testsuite/tests/win-unicode/mltest.ml b/testsuite/tests/win-unicode/mltest.ml
new file mode 100644
index 00000000..802cf504
--- /dev/null
+++ b/testsuite/tests/win-unicode/mltest.ml
@@ -0,0 +1,277 @@
+(* TEST
+include unix
+flags += "-strict-sequence -safe-string -w A -warn-error A"
+* windows-unicode
+** toplevel
+*)
+
+let foreign_names =
+  List.sort compare
+    [
+      "simple";
+      "\xE4\xBD\xA0\xE5\xA5\xBD"; (* "你好" *)
+      "\x73\xC5\x93\x75\x72"; (* "sœur" *)
+      "e\204\129te\204\129"; (* "été" *)
+    ]
+;;
+
+let test_files =
+  List.map (fun s -> s ^ ".txt") foreign_names
+;;
+
+let to_create_and_delete_files =
+  [
+    (* "верблюды" *)
+    "\xD0\xB2\xD0\xB5\xD1\x80\xD0\xB1\xD0\xBB\xD1\x8E\xD0\xB4\xD1\x8B";
+    "\xE9\xAA\x86\xE9\xA9\xBC"; (* "骆驼" *)
+    "\215\167\215\162\215\158\215\156"; (* "קעמל" *)
+    "\216\167\217\136\217\134\217\185"; (* "اونٹ" *)
+    "L\225\186\161c \196\145\195\160"; (* "Lạc đà" *)
+    "\224\176\146\224\176\130\224\176\159\224\177\134"; (* "ఒంటె" *)
+    "\224\174\146\224\174\159\224\175\141\224\174\159\224\174\149\224\
+     \174\174\224\175\141"; (* "ஒட்டகம்" *)
+    "\217\136\216\180\216\170\216\177"; (* "وشتر" *)
+    "\224\164\137\224\164\183\224\165\141\224\164\159\224\165\141\224\
+     \164\176\224\164\131"; (* "उष्ट्रः" *)
+    "\216\167\217\186"; (* "اٺ" *)
+  ]
+;;
+
+let foreign_names2 =
+  let rec take n l =
+    if n = 0 then []
+    else List.hd l :: take (n-1) (List.tl l)
+  in
+  take (List.length foreign_names) to_create_and_delete_files
+;;
+
+(* let env0 =
+     List.sort compare
+     (List.mapi (fun i v -> Printf.sprintf "OCAML_UTF8_VAR%d=%s" i v)
+                foreign_names2) *)
+
+(* let read_all ic = *)
+(*   set_binary_mode_in ic false; *)
+(*   let rec loop acc = *)
+(*     match input_line ic with *)
+(*     | exception End_of_file -> *)
+(*         List.rev acc *)
+(*     | s -> *)
+(*         loop (s :: acc) *)
+(*   in *)
+(*   loop [] *)
+
+(** WRAPPERS *)
+
+let getenvironmentenv s =
+  let env = Unix.environment () in
+  let rec loop i =
+    if i >= Array.length env then
+      ""
+    else begin
+      let e = env.(i) in
+      let pos = String.index e '=' in
+      if String.sub e 0 pos = s then
+        String.sub e (pos+1) (String.length e - pos - 1)
+      else
+        loop (i+1)
+    end
+  in
+  loop 0
+;;
+
+let unix_getcwd () =
+  Filename.basename (Unix.getcwd ())
+;;
+
+let sys_getcwd () =
+  Filename.basename (Sys.getcwd ())
+;;
+
+let unix_readdir s =
+  let h = Unix.opendir s in
+  let rec loop acc =
+    match Unix.readdir h with
+    | s ->
+        loop (s :: acc)
+    | exception End_of_file ->
+        Unix.closedir h;
+        acc
+  in
+  List.sort compare (loop [])
+;;
+
+let sys_readdir s =
+  List.sort compare (Array.to_list (Sys.readdir s))
+;;
+
+(* let open_process_in cmdline = *)
+(*   let f cmdline = *)
+(*     let ic as proc = Unix.open_process_in cmdline in *)
+(*     let l = List.tl (read_all ic) in *)
+(*     ignore (Unix.close_process_in proc); *)
+(*     l *)
+(*   in *)
+(*   wrap "Unix.open_process_in" f ell cmdline (list quote) *)
+
+(* let open_process_full filter cmdline env =
+     let f cmdline env =
+       let (ic, _, _) as proc =
+         Unix.open_process_full cmdline (Array.of_list env)
+       in
+       let l = read_all ic in
+       ignore (Unix.close_process_full proc);
+       List.sort compare (List.filter filter l)
+     in
+     wrap2 "Unix.open_process_full" f ell (list quote) cmdline env (list quote)
+*)
+
+let test_readdir readdir =
+  let filter s = List.mem s test_files && Filename.check_suffix s ".txt" in
+  List.filter filter (readdir Filename.current_dir_name)
+;;
+
+let test_open_in () =
+  let check s =
+    let ic = open_in s in
+    let l = input_line ic in
+    close_in ic;
+    l
+  in
+  let filter s = List.mem s test_files in
+  let files = List.filter filter (sys_readdir Filename.current_dir_name) in
+  List.map check files
+;;
+
+let test_getenv () =
+  let doit key s =
+    Unix.putenv key s;
+    Sys.getenv key, getenvironmentenv key
+  in
+  List.map2 doit foreign_names foreign_names2
+;;
+
+let test_mkdir () =
+  let doit s =
+    Unix.mkdir s 0o755;
+    Sys.file_exists s, Sys.is_directory s
+  in
+  List.map doit foreign_names
+;;
+
+let test_chdir chdir getcwd =
+  let doit s =
+    chdir s;
+    let d = getcwd () in
+    chdir Filename.parent_dir_name;
+    d
+  in
+  List.map doit foreign_names
+;;
+
+let test_rmdir () =
+  let doit s =
+    Unix.rmdir s;
+    Sys.file_exists s
+  in
+  List.map doit foreign_names
+;;
+
+let test_stat () =
+  let doit s =
+    (Unix.stat s).Unix.st_kind,
+    (Unix.lstat s).Unix.st_kind,
+    (Unix.LargeFile.stat s).Unix.LargeFile.st_kind,
+    (Unix.LargeFile.lstat s).Unix.LargeFile.st_kind
+  in
+  List.map doit to_create_and_delete_files
+;;
+
+let test_access () =
+  List.iter (fun s -> Unix.access s [Unix.F_OK]) to_create_and_delete_files
+
+let test_rename rename =
+  let doit s =
+    let s' = s ^ "-1" in
+    rename s s';
+    let x = Sys.file_exists s, Sys.file_exists s' in
+    rename s' s;
+    let y = Sys.file_exists s, Sys.file_exists s' in
+    x, y
+  in
+  List.map doit to_create_and_delete_files
+;;
+
+let test_open_out () =
+  let doit s =
+    let oc = open_out s in
+    Printf.fprintf oc "Hello, %s\n" s;
+    close_out oc;
+    let ic = open_in s in
+    let l = input_line ic in
+    close_in ic;
+    l
+  in
+  List.map doit to_create_and_delete_files
+;;
+
+let test_file_exists () =
+  List.map Sys.file_exists to_create_and_delete_files
+;;
+
+let test_remove () =
+  let doit s =
+    Sys.remove s;
+    Sys.file_exists s
+  in
+  List.map doit to_create_and_delete_files
+;;
+
+let create_file s =
+  let oc = open_out_bin s in
+  output_string oc s;
+  close_out oc
+;;
+
+let test_symlink () =
+  let foodir = "UNIQU\xE4\xBD\xA0\xE5\xA5\xBD" (* "UNIQU你好" *) in
+  let foofile = "UNIQU\xE4\xBD\xA0\xE5\xA5\xBD/\xE4\xBD\xA0\xE5\xA5\xBD.txt"
+                                                          (* "UNIQU你好/你好.txt" *)
+  in
+  let fileln = "\xE4\xBD\xA0\xE5\xA5\xBD-file-ln-s" (* "你好-file-ln-s" *) in
+  let dirln = "\xE4\xBD\xA0\xE5\xA5\xBD-dir-ln-s" (* "你好-dir-ln-s" *) in
+  Unix.mkdir foodir 0o777;
+  create_file foofile;
+  Unix.symlink ~to_dir:true foodir dirln;
+  Unix.symlink ~to_dir:false foofile fileln;
+  let res =
+    (Unix.stat fileln).Unix.st_kind = Unix.S_REG &&
+    (Unix.stat dirln).Unix.st_kind = Unix.S_DIR &&
+    (Unix.lstat fileln).Unix.st_kind = Unix.S_LNK &&
+    (Unix.lstat dirln).Unix.st_kind = Unix.S_LNK
+  in
+  Sys.remove foofile;
+  Sys.remove fileln;
+  Unix.rmdir dirln;
+  Unix.rmdir foodir;
+  res
+;;
+
+List.iter create_file test_files;;
+
+let t_unix_readdir = test_readdir unix_readdir;;
+let t_sys_readdir = test_readdir sys_readdir;;
+let t_open_in = test_open_in ();;
+let t_open_out = test_open_out ();;
+let t_file_exists = test_file_exists ();;
+let t_stat = test_stat ();;
+test_access ();;
+let t_unix_rename = test_rename Unix.rename;;
+let t_sys_rename = test_rename Sys.rename;;
+test_remove ();;
+test_mkdir ();;
+let t_sys_chdir = test_chdir Sys.chdir sys_getcwd;;
+let t_unix_chdir = test_chdir Unix.chdir unix_getcwd;;
+test_rmdir ();;
+let t_getenv = test_getenv ();;
+if Unix.has_symlink () then test_symlink () else true;;
diff --git a/testsuite/tools/Makefile b/testsuite/tools/Makefile
new file mode 100644
index 00000000..a34116db
--- /dev/null
+++ b/testsuite/tools/Makefile
@@ -0,0 +1,100 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                 Jeremie Dimino, Jane Street Europe                     *
+#*                                                                        *
+#*   Copyright 2016 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.          *
+#*                                                                        *
+#**************************************************************************
+
+.NOTPARALLEL:
+
+TOPDIR = ../..
+
+COMPILERLIBSDIR = $(TOPDIR)/compilerlibs
+
+RUNTIME_VARIANT ?=
+ASPPFLAGS ?=
+
+include $(TOPDIR)/Makefile.tools
+
+expect_MAIN=expect_test
+expect_PROG=$(expect_MAIN)$(EXE)
+expect_DIRS = parsing utils driver typing toplevel
+expect_OCAMLFLAGS = $(addprefix -I $(TOPDIR)/,$(expect_DIRS))
+expect_LIBS := $(addprefix $(COMPILERLIBSDIR)/,\
+  ocamlcommon ocamlbytecomp ocamltoplevel)
+
+codegen_PROG = codegen$(EXE)
+codegen_DIRS = parsing utils typing middle_end bytecomp lambda asmcomp
+codegen_OCAMLFLAGS = $(addprefix -I $(TOPDIR)/, $(codegen_DIRS)) -w +40 -g
+
+codegen_LIBS = $(addprefix $(COMPILERLIBSDIR)/,\
+  ocamlcommon ocamloptcomp)
+
+codegen_OBJECTS = $(addsuffix .cmo,\
+  parsecmmaux parsecmm lexcmm codegen_main)
+
+tools := $(expect_PROG)
+
+ifeq "$(NATIVE_COMPILER)" "true"
+tools += $(codegen_PROG)
+ifneq "$(CCOMPTYPE)-$(ARCH)" "msvc-amd64"
+# The asmgen tests are not ported to MSVC64 yet
+# so do not compile any arch-specific module
+tools += asmgen_$(ARCH).$(O)
+endif
+endif
+
+all: $(tools)
+
+$(expect_PROG): $(expect_LIBS:=.cma) $(expect_MAIN).cmo
+	$(OCAMLC) -linkall -o $@ $^
+
+$(expect_PROG): COMPFLAGS = $(expect_OCAMLFLAGS)
+
+$(codegen_PROG): COMPFLAGS = $(codegen_OCAMLFLAGS)
+
+codegen_main.cmo: parsecmm.cmo
+
+$(codegen_PROG): $(codegen_OBJECTS)
+	$(OCAMLC) -o $@ $(codegen_LIBS:=.cma) $^
+
+parsecmm.mli parsecmm.ml: parsecmm.mly
+	$(OCAMLYACC) -q parsecmm.mly
+
+lexcmm.ml: lexcmm.mll
+	$(OCAMLLEX) -q lexcmm.mll
+
+parsecmmaux.cmo: parsecmmaux.cmi
+
+lexcmm.cmo: lexcmm.cmi
+
+parsecmm.cmo: parsecmm.cmi
+
+asmgen_i386.obj: asmgen_i386nt.asm
+	@set -o pipefail ; \
+	$(ASM) $@ $^ | tail -n +2
+
+%.cmi: %.mli
+	$(OCAMLC) -c $<
+
+%.cmo: %.ml
+	$(OCAMLC) -c $<
+
+%.cmx: %.ml
+	$(OCAMLOPT) -c $<
+
+%.$(O): %.S
+	$(ASPP) $(ASPPFLAGS) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) -o $@ $<
+
+.PHONY: clean
+clean:
+	rm -f *.cm* *.o *.obj
+	rm -f expect_test expect_test.exe codegen codegen.exe
+	rm -f parsecmm.ml parsecmm.mli lexcmm.ml
diff --git a/testsuite/tools/asmgen_amd64.S b/testsuite/tools/asmgen_amd64.S
new file mode 100644
index 00000000..fb87307d
--- /dev/null
+++ b/testsuite/tools/asmgen_amd64.S
@@ -0,0 +1,83 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2000 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#ifdef SYS_macosx
+#define ALIGN 4
+#else
+#define ALIGN 16
+#endif
+
+#ifdef SYS_macosx
+#define CALL_GEN_CODE _call_gen_code
+#define CAML_C_CALL _caml_c_call
+#define CAML_NEGF_MASK _caml_negf_mask
+#define CAML_ABSF_MASK _caml_absf_mask
+#else
+#define CALL_GEN_CODE call_gen_code
+#define CAML_C_CALL caml_c_call
+#define CAML_NEGF_MASK caml_negf_mask
+#define CAML_ABSF_MASK caml_absf_mask
+#endif
+
+        .globl  CALL_GEN_CODE
+        .align  ALIGN
+CALL_GEN_CODE:
+        pushq   %rbx
+        pushq   %rbp
+        pushq   %r12
+        pushq   %r13
+        pushq   %r14
+        pushq   %r15
+        movq    %rdi, %r10
+        movq    %rsi, %rax
+        movq    %rdx, %rbx
+        movq    %rcx, %rdi
+        movq    %r8, %rsi
+        call    *%r10
+        popq    %r15
+        popq    %r14
+        popq    %r13
+        popq    %r12
+        popq    %rbp
+        popq    %rbx
+        ret
+
+        .globl  CAML_C_CALL
+        .align  ALIGN
+CAML_C_CALL:
+        jmp     *%rax
+
+#ifdef SYS_macosx
+        .literal16
+#elif defined(SYS_mingw64) || defined(SYS_cygwin)
+        .section        .rodata.cst8
+#else
+        .section        .rodata.cst8,"aM",@progbits,8
+#endif
+        .globl  CAML_NEGF_MASK
+        .align  ALIGN
+CAML_NEGF_MASK:
+        .quad   0x8000000000000000, 0
+        .globl  CAML_ABSF_MASK
+        .align  ALIGN
+CAML_ABSF_MASK:
+        .quad   0x7FFFFFFFFFFFFFFF, 0
+
+        .comm   young_limit, 8
+
+#if defined(SYS_linux)
+    /* Mark stack as non-executable */
+        .section .note.GNU-stack,"",%progbits
+#endif
diff --git a/testsuite/tools/asmgen_arm.S b/testsuite/tools/asmgen_arm.S
new file mode 100644
index 00000000..da6d9ee7
--- /dev/null
+++ b/testsuite/tools/asmgen_arm.S
@@ -0,0 +1,42 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 1998 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+        .text
+
+        .global call_gen_code
+        .type   call_gen_code, %function
+        .align  0
+call_gen_code:
+        mov     ip, sp
+        stmfd   sp!, {r4, r5, r6, r7, r8, r9, fp, ip, lr, pc}
+        sub     fp, ip, #4
+    @ r0 is function to call
+    @ r1, r2, r3 are arguments 1, 2, 3
+        mov     r4, r0
+        mov     r0, r1
+        mov     r1, r2
+        mov     r2, r3
+        blx     r4
+        ldmea   fp, {r4, r5, r6, r7, r8, r9, fp, sp, pc}
+
+        .global caml_c_call
+        .type   caml_c_call, %function
+        .align  0
+caml_c_call:
+    @ function to call is in r10
+        bx      r10
+
+/* Mark stack as non-executable */
+        .section .note.GNU-stack,"",%progbits
diff --git a/testsuite/tools/asmgen_arm64.S b/testsuite/tools/asmgen_arm64.S
new file mode 100644
index 00000000..4b803d20
--- /dev/null
+++ b/testsuite/tools/asmgen_arm64.S
@@ -0,0 +1,58 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2013 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+        .globl  call_gen_code
+        .align  2
+call_gen_code:
+    /* Set up stack frame and save callee-save registers */
+        stp     x29, x30, [sp, -160]!
+        add     x29, sp, #0
+        stp     x19, x20, [sp, 16]
+        stp     x21, x22, [sp, 32]
+        stp     x23, x24, [sp, 48]
+        stp     x25, x26, [sp, 64]
+        stp     x27, x28, [sp, 80]
+        stp     d8, d9, [sp, 96]
+        stp     d10, d11, [sp, 112]
+        stp     d12, d13, [sp, 128]
+        stp     d14, d15, [sp, 144]
+    /* Shuffle arguments */
+        mov     x8, x0
+        mov     x0, x1
+        mov     x1, x2
+        mov     x2, x3
+        mov     x3, x4
+    /* Call generated asm */
+        blr     x8
+    /* Reload callee-save registers and return address */
+        ldp     x19, x20, [sp, 16]
+        ldp     x21, x22, [sp, 32]
+        ldp     x23, x24, [sp, 48]
+        ldp     x25, x26, [sp, 64]
+        ldp     x27, x28, [sp, 80]
+        ldp     d8, d9, [sp, 96]
+        ldp     d10, d11, [sp, 112]
+        ldp     d12, d13, [sp, 128]
+        ldp     d14, d15, [sp, 144]
+        ldp     x29, x30, [sp], 160
+        ret
+
+        .globl  caml_c_call
+        .align  2
+caml_c_call:
+        br      x15
+
+/* Mark stack as non-executable */
+        .section .note.GNU-stack,"",%progbits
diff --git a/testsuite/tools/asmgen_i386.S b/testsuite/tools/asmgen_i386.S
new file mode 100644
index 00000000..1d16b72d
--- /dev/null
+++ b/testsuite/tools/asmgen_i386.S
@@ -0,0 +1,70 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Linux with ELF binaries does not prefix identifiers with _.
+   Linux with a.out binaries, FreeBSD, and NextStep do. */
+
+#if defined(SYS_linux_elf) || defined(SYS_bsd_elf) \
+ || defined(SYS_solaris) || defined(SYS_beos) || defined(SYS_gnu)
+#define G(x) x
+#define FUNCTION_ALIGN 16
+#else
+#define G(x) _##x
+#define FUNCTION_ALIGN 4
+#endif
+
+        .globl  G(call_gen_code)
+        .align  FUNCTION_ALIGN
+G(call_gen_code):
+        pushl %ebp
+        movl %esp,%ebp
+        pushl %ebx
+        pushl %esi
+        pushl %edi
+        movl 12(%ebp),%eax
+        movl 16(%ebp),%ebx
+        movl 20(%ebp),%ecx
+        movl 24(%ebp),%edx
+        call *8(%ebp)
+        popl %edi
+        popl %esi
+        popl %ebx
+        popl %ebp
+        ret
+
+        .globl  G(caml_c_call)
+        .align  FUNCTION_ALIGN
+G(caml_c_call):
+        jmp     *%eax
+
+        .comm   G(Caml_state), 4
+
+/* Some tests are designed to cause registers to spill; on
+ * x86 we require the caml_extra_params symbol from the RTS. */
+        .data
+        .globl  G(caml_extra_params)
+G(caml_extra_params):
+#ifndef SYS_solaris
+        .space  64
+#else
+        .zero   64
+#endif
+
+
+
+#if defined(SYS_linux_elf)
+    /* Mark stack as non-executable */
+        .section .note.GNU-stack,"",%progbits
+#endif
diff --git a/testsuite/tools/asmgen_i386nt.asm b/testsuite/tools/asmgen_i386nt.asm
new file mode 100644
index 00000000..68ba9b7d
--- /dev/null
+++ b/testsuite/tools/asmgen_i386nt.asm
@@ -0,0 +1,67 @@
+;*********************************************************************;
+;                                                                     ;
+;                                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 Q Public License version 1.0.               ;
+;                                                                     ;
+;*********************************************************************;
+
+        .386
+        .MODEL FLAT
+
+        .CODE
+        PUBLIC  _call_gen_code
+        ALIGN   4
+_call_gen_code:
+        push    ebp
+        mov     ebp, esp
+        push    ebx
+        push    esi
+        push    edi
+        mov     eax, [ebp+12]
+        mov     ebx, [ebp+16]
+        mov     ecx, [ebp+20]
+        mov     edx, [ebp+24]
+        call    DWORD PTR [ebp+8]
+        pop     edi
+        pop     esi
+        pop     ebx
+        pop     ebp
+        ret
+
+        PUBLIC  _caml_c_call
+        ALIGN   4
+_caml_c_call:
+        ffree   st(0)
+        ffree   st(1)
+        ffree   st(2)
+        ffree   st(3)
+        jmp     eax
+
+        PUBLIC  _caml_call_gc
+        PUBLIC  _caml_alloc
+        PUBLIC  _caml_alloc1
+        PUBLIC  _caml_alloc2
+        PUBLIC  _caml_alloc3
+        PUBLIC  _caml_allocN
+        PUBLIC  _caml_extra_params
+        PUBLIC  _caml_raise_exn
+_caml_call_gc:
+_caml_alloc:
+_caml_alloc1:
+_caml_alloc2:
+_caml_alloc3:
+_caml_allocN:
+_caml_extra_params:
+_caml_raise_exn:
+        int     3
+
+        .DATA
+        PUBLIC  _Caml_state
+_Caml_state dword 0
+
+        END
diff --git a/testsuite/tools/asmgen_power.S b/testsuite/tools/asmgen_power.S
new file mode 100644
index 00000000..71c692f9
--- /dev/null
+++ b/testsuite/tools/asmgen_power.S
@@ -0,0 +1,200 @@
+/*********************************************************************/
+/*                                                                   */
+/*                               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 Q Public License version 1.0.              */
+/*                                                                   */
+/*********************************************************************/
+
+#if defined(MODEL_ppc64) || defined(MODEL_ppc64le)
+#define EITHER(a,b) b
+#else
+#define EITHER(a,b) a
+#endif
+
+#define WORD EITHER(4,8)
+#define lg EITHER(lwz,ld)
+#define lgu EITHER(lwzu,ldu)
+#define stg EITHER(stw,std)
+#define stgu EITHER(stwu,stdu)
+
+#if defined(MODEL_ppc)
+#define RESERVED_STACK 16
+#define LR_SAVE_AREA 4
+#endif
+#if defined(MODEL_ppc64)
+#define RESERVED_STACK 48
+#define LR_SAVE_AREA 16
+#endif
+#if defined(MODEL_ppc64le)
+#define RESERVED_STACK 32
+#define LR_SAVE_AREA 16
+#endif
+
+/* Function definitions */
+
+#if defined(MODEL_ppc)
+#define FUNCTION(name) \
+  .section ".text"; \
+  .globl name; \
+  .type name, @function; \
+  .align 2; \
+  name:
+#endif
+
+#if defined(MODEL_ppc64)
+#define FUNCTION(name) \
+  .section ".opd","aw"; \
+  .align 3; \
+  .globl name; \
+  .type name, @function; \
+  name: .quad .L.name,.TOC.@tocbase; \
+  .text; \
+  .align 2; \
+  .L.name:
+#endif
+
+#if defined(MODEL_ppc64le)
+#define FUNCTION(name) \
+  .section ".text"; \
+  .globl name; \
+  .type name, @function; \
+  .align 2; \
+  name: ; \
+  0: addis 2, 12, (.TOC. - 0b)@ha; \
+  addi 2, 2, (.TOC. - 0b)@l; \
+  .localentry name, . - 0b
+#endif
+
+FUNCTION(call_gen_code)
+    /* Allocate and link stack frame */
+        stgu    1, -(WORD*18 + 8*18 + RESERVED_STACK)(1)
+    /* 18 saved GPRs, 18 saved FPRs */
+    /* Save return address */
+        mflr    0
+        stg     0, (WORD*18 + 8*18 + RESERVED_STACK + LR_SAVE_AREA)(1)
+    /* Save all callee-save registers, starting at RESERVED_STACK */
+        addi    11, 1, RESERVED_STACK - WORD
+        stgu    14, WORD(11)
+        stgu    15, WORD(11)
+        stgu    16, WORD(11)
+        stgu    17, WORD(11)
+        stgu    18, WORD(11)
+        stgu    19, WORD(11)
+        stgu    20, WORD(11)
+        stgu    21, WORD(11)
+        stgu    22, WORD(11)
+        stgu    23, WORD(11)
+        stgu    24, WORD(11)
+        stgu    25, WORD(11)
+        stgu    26, WORD(11)
+        stgu    27, WORD(11)
+        stgu    28, WORD(11)
+        stgu    29, WORD(11)
+        stgu    30, WORD(11)
+        stgu    31, WORD(11)
+        stfdu   14, 8(11)
+        stfdu   15, 8(11)
+        stfdu   16, 8(11)
+        stfdu   17, 8(11)
+        stfdu   18, 8(11)
+        stfdu   19, 8(11)
+        stfdu   20, 8(11)
+        stfdu   21, 8(11)
+        stfdu   22, 8(11)
+        stfdu   23, 8(11)
+        stfdu   24, 8(11)
+        stfdu   25, 8(11)
+        stfdu   26, 8(11)
+        stfdu   27, 8(11)
+        stfdu   28, 8(11)
+        stfdu   29, 8(11)
+        stfdu   30, 8(11)
+        stfdu   31, 8(11)
+    /* Get function pointer in CTR */
+#if defined(MODEL_ppc)
+        mtctr   3
+#elif defined(MODEL_ppc64)
+        ld      0, 0(3)
+        mtctr   0
+        ld      2, 8(3)
+#elif defined(MODEL_ppc64le)
+        mtctr   3
+        mr      12, 3
+#else
+#error "wrong MODEL"
+#endif
+    /* Shuffle arguments */
+        mr      3, 4
+        mr      4, 5
+        mr      5, 6
+        mr      6, 7
+    /* Call the function */
+        bctrl
+    /* Restore callee-save registers */
+        addi    11, 1, RESERVED_STACK - WORD
+        lgu     14, WORD(11)
+        lgu     15, WORD(11)
+        lgu     16, WORD(11)
+        lgu     17, WORD(11)
+        lgu     18, WORD(11)
+        lgu     19, WORD(11)
+        lgu     20, WORD(11)
+        lgu     21, WORD(11)
+        lgu     22, WORD(11)
+        lgu     23, WORD(11)
+        lgu     24, WORD(11)
+        lgu     25, WORD(11)
+        lgu     26, WORD(11)
+        lgu     27, WORD(11)
+        lgu     28, WORD(11)
+        lgu     29, WORD(11)
+        lgu     30, WORD(11)
+        lgu     31, WORD(11)
+        lfdu    14, 8(11)
+        lfdu    15, 8(11)
+        lfdu    16, 8(11)
+        lfdu    17, 8(11)
+        lfdu    18, 8(11)
+        lfdu    19, 8(11)
+        lfdu    20, 8(11)
+        lfdu    21, 8(11)
+        lfdu    22, 8(11)
+        lfdu    23, 8(11)
+        lfdu    24, 8(11)
+        lfdu    25, 8(11)
+        lfdu    26, 8(11)
+        lfdu    27, 8(11)
+        lfdu    28, 8(11)
+        lfdu    29, 8(11)
+        lfdu    30, 8(11)
+        lfdu    31, 8(11)
+    /* Reload return address */
+        lg      0, (WORD*18 + 8*18 + RESERVED_STACK + LR_SAVE_AREA)(1)
+        mtlr    0
+    /* Return */
+        addi    1, 1, (WORD*18 + 8*18 + RESERVED_STACK)
+        blr
+
+FUNCTION(caml_c_call)
+    /* Jump to C function (address in r28) */
+#if defined(MODEL_ppc)
+        mtctr   28
+#elif defined(MODEL_ppc64)
+        ld      0, 0(28)
+        mtctr   0
+        ld      2, 8(28)
+#elif defined(MODEL_ppc64le)
+        mtctr   28
+        mr      12, 28
+#else
+#error "wrong MODEL"
+#endif
+        bctr
+
+/* Mark stack as non-executable */
+        .section .note.GNU-stack,"",%progbits
diff --git a/testsuite/tools/asmgen_riscv.S b/testsuite/tools/asmgen_riscv.S
new file mode 100644
index 00000000..efb30a80
--- /dev/null
+++ b/testsuite/tools/asmgen_riscv.S
@@ -0,0 +1,89 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                OCaml                                   */
+/*                                                                        */
+/*                Nicolas Ojeda Bar                  */
+/*                                                                        */
+/*   Copyright 2019 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 STORE sd
+#define LOAD ld
+
+        .globl  call_gen_code
+        .align  2
+call_gen_code:
+    /* Set up stack frame and save callee-save registers */
+        ADDI    sp, sp, -208
+        STORE   ra, 192(sp)
+        STORE   s0, 0(sp)
+        STORE   s1, 8(sp)
+        STORE   s2, 16(sp)
+        STORE   s3, 24(sp)
+        STORE   s4, 32(sp)
+        STORE   s5, 40(sp)
+        STORE   s6, 48(sp)
+        STORE   s7, 56(sp)
+        STORE   s8, 64(sp)
+        STORE   s9, 72(sp)
+        STORE   s10, 80(sp)
+        STORE   s11, 88(sp)
+        fsd     fs0, 96(sp)
+        fsd     fs1, 104(sp)
+        fsd     fs2, 112(sp)
+        fsd     fs3, 120(sp)
+        fsd     fs4, 128(sp)
+        fsd     fs5, 136(sp)
+        fsd     fs6, 144(sp)
+        fsd     fs7, 152(sp)
+        fsd     fs8, 160(sp)
+        fsd     fs9, 168(sp)
+        fsd     fs10, 176(sp)
+        fsd     fs11, 184(sp)
+    /* Shuffle arguments */
+        mv      t0, a0
+        mv      a0, a1
+        mv      a1, a2
+        mv      a2, a3
+        mv      a3, a4
+    /* Call generated asm */
+        jalr    t0
+    /* Reload callee-save registers and return address */
+        LOAD    ra, 192(sp)
+        LOAD    s0, 0(sp)
+        LOAD    s1, 8(sp)
+        LOAD    s2, 16(sp)
+        LOAD    s3, 24(sp)
+        LOAD    s4, 32(sp)
+        LOAD    s5, 40(sp)
+        LOAD    s6, 48(sp)
+        LOAD    s7, 56(sp)
+        LOAD    s8, 64(sp)
+        LOAD    s9, 72(sp)
+        LOAD    s10, 80(sp)
+        LOAD    s11, 88(sp)
+        fld     fs0, 96(sp)
+        fld     fs1, 104(sp)
+        fld     fs2, 112(sp)
+        fld     fs3, 120(sp)
+        fld     fs4, 128(sp)
+        fld     fs5, 136(sp)
+        fld     fs6, 144(sp)
+        fld     fs7, 152(sp)
+        fld     fs8, 160(sp)
+        fld     fs9, 168(sp)
+        fld     fs10, 176(sp)
+        fld     fs11, 184(sp)
+        addi    sp, sp, 208
+        ret
+
+        .globl  caml_c_call
+        .align  2
+caml_c_call:
+        jr      t2
diff --git a/testsuite/tools/asmgen_s390x.S b/testsuite/tools/asmgen_s390x.S
new file mode 100644
index 00000000..99eeca27
--- /dev/null
+++ b/testsuite/tools/asmgen_s390x.S
@@ -0,0 +1,67 @@
+#define ALIGN 8
+
+#define CALL_GEN_CODE call_gen_code
+#define CAML_C_CALL caml_c_call
+#define CAML_NEGF_MASK caml_negf_mask
+#define CAML_ABSF_MASK caml_absf_mask
+
+        .section ".text"
+
+        .globl  CALL_GEN_CODE
+        .type   CALL_GEN_CODE, @function
+        .align  ALIGN
+CALL_GEN_CODE:
+        /* Stack space */
+        lay     %r15, -144(%r15)
+        /* Save registers */
+        stmg    %r6,%r14, 0(%r15)
+        std     %f8, 72(%r15)
+        std     %f9, 80(%r15)
+        std     %f10, 88(%r15)
+        std     %f11, 96(%r15)
+        std     %f12, 104(%r15)
+        std     %f13, 112(%r15)
+        std     %f14, 120(%r15)
+        std     %f15, 128(%r15)
+        /* Shuffle args */
+        lgr     %r1, %r2
+        lgr     %r2, %r3
+        lgr     %r3, %r4
+        lgr     %r4, %r5
+        /* Function call */
+        basr    %r14, %r1
+        /* Restore registers */
+        lmg    %r6,%r14, 0(%r15)
+        ld     %f8, 72(%r15)
+        ld     %f9, 80(%r15)
+        ld     %f10, 88(%r15)
+        ld     %f11, 96(%r15)
+        ld     %f12, 104(%r15)
+        ld     %f13, 112(%r15)
+        ld     %f14, 120(%r15)
+        ld     %f15, 128(%r15)
+        /* Return */
+        lay     %r15, 144(%r15)
+        br      %r14
+
+        .globl  CAML_C_CALL
+        .type   CAML_C_CALL, @function
+        .align  ALIGN
+CAML_C_CALL:
+        br      %r7
+
+        .section ".rodata"
+
+        .global CAML_NEGF_MASK
+        .align  ALIGN
+CAML_NEGF_MASK:
+        .quad   0x8000000000000000, 0
+        .global  CAML_ABSF_MASK
+        .align  ALIGN
+CAML_ABSF_MASK:
+        .quad   0x7FFFFFFFFFFFFFFF, 0
+
+        .comm   young_limit, 8
+
+/* Mark stack as non-executable */
+        .section .note.GNU-stack,"",%progbits
diff --git a/testsuite/tools/codegen_main.ml b/testsuite/tools/codegen_main.ml
new file mode 100644
index 00000000..d0b3d404
--- /dev/null
+++ b/testsuite/tools/codegen_main.ml
@@ -0,0 +1,80 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Clflags
+let write_asm_file = ref false
+
+let compile_file filename =
+  if !write_asm_file then begin
+    let out_name = Filename.chop_extension filename ^ ".s" in
+    Emitaux.output_channel := open_out out_name
+  end; (* otherwise, stdout *)
+  Compilenv.reset "test";
+  Emit.begin_assembly();
+  let ic = open_in filename in
+  let lb = Lexing.from_channel ic in
+  lb.Lexing.lex_curr_p <- Lexing.{ lb.lex_curr_p with pos_fname = filename };
+  try
+    while true do
+      Asmgen.compile_phrase ~ppf_dump:Format.std_formatter
+        (Parsecmm.phrase Lexcmm.token lb)
+    done
+  with
+      End_of_file ->
+        close_in ic; Emit.end_assembly();
+        if !write_asm_file then close_out !Emitaux.output_channel
+    | Lexcmm.Error msg ->
+        close_in ic; Lexcmm.report_error lb msg
+    | Parsing.Parse_error ->
+        close_in ic;
+        let start_p = Lexing.lexeme_start_p lb in
+        let end_p = Lexing.lexeme_end_p lb in
+        Printf.eprintf "File \"%s\", line %i, characters %i-%i:\n\
+                        Syntax error.\n%!"
+          filename
+          start_p.Lexing.pos_lnum
+          (start_p.Lexing.pos_cnum - start_p.Lexing.pos_bol)
+          (end_p.Lexing.pos_cnum - start_p.Lexing.pos_bol)
+    | Parsecmmaux.Error msg ->
+        close_in ic; Parsecmmaux.report_error msg
+    | x ->
+        close_in ic; raise x
+
+let usage = "Usage: codegen  \noptions are:"
+
+let main() =
+  Arg.parse [
+     "-S", Arg.Set write_asm_file,
+       " Output file to filename.s (default is stdout)";
+     "-g", Arg.Set Clflags.debug, "";
+     "-dcmm", Arg.Set dump_cmm, "";
+     "-dcse", Arg.Set dump_cse, "";
+     "-dsel", Arg.Set dump_selection, "";
+     "-dlive", Arg.Unit(fun () -> dump_live := true ), "";
+     "-dspill", Arg.Set dump_spill, "";
+     "-dsplit", Arg.Set dump_split, "";
+     "-dinterf", Arg.Set dump_interf, "";
+     "-dprefer", Arg.Set dump_prefer, "";
+     "-dalloc", Arg.Set dump_regalloc, "";
+     "-dreload", Arg.Set dump_reload, "";
+     "-dscheduling", Arg.Set dump_scheduling, "";
+     "-dlinear", Arg.Set dump_linear, "";
+     "-dtimings", Arg.Unit (fun () -> profile_columns := [ `Time ]), "";
+    ] compile_file usage
+
+let () =
+  main ();
+  Profile.print Format.std_formatter !Clflags.profile_columns;
+  exit 0
diff --git a/testsuite/tools/expect_test.ml b/testsuite/tools/expect_test.ml
new file mode 100644
index 00000000..fed821fc
--- /dev/null
+++ b/testsuite/tools/expect_test.ml
@@ -0,0 +1,372 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Jeremie Dimino, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Execute a list of phrases from a .ml file and compare the result to the
+   expected output, written inside [%%expect ...] nodes. At the end, create
+   a .corrected file containing the corrected expectations. The test is
+   successful if there is no differences between the two files.
+
+   An [%%expect] node always contains both the expected outcome with and
+   without -principal. When the two differ the expectation is written as
+   follows:
+
+   {[
+     [%%expect {|
+     output without -principal
+     |}, Principal{|
+     output with -principal
+     |}]
+   ]}
+*)
+
+[@@@ocaml.warning "-40"]
+
+open StdLabels
+
+(* representation of: {tag|str|tag} *)
+type string_constant =
+  { str : string
+  ; tag : string
+  }
+
+type expectation =
+  { extid_loc   : Location.t (* Location of "expect" in "[%%expect ...]" *)
+  ; payload_loc : Location.t (* Location of the whole payload *)
+  ; normal      : string_constant (* expectation without -principal *)
+  ; principal   : string_constant (* expectation with -principal *)
+  }
+
+(* A list of phrases with the expected toplevel output *)
+type chunk =
+  { phrases     : Parsetree.toplevel_phrase list
+  ; expectation : expectation
+  }
+
+type correction =
+  { corrected_expectations : expectation list
+  ; trailing_output        : string
+  }
+
+let match_expect_extension (ext : Parsetree.extension) =
+  match ext with
+  | ({Asttypes.txt="expect"|"ocaml.expect"; loc = extid_loc}, payload) ->
+    let invalid_payload () =
+      Location.raise_errorf ~loc:extid_loc "invalid [%%%%expect payload]"
+    in
+    let string_constant (e : Parsetree.expression) =
+      match e.pexp_desc with
+      | Pexp_constant (Pconst_string (str, _, Some tag)) ->
+        { str; tag }
+      | _ -> invalid_payload ()
+    in
+    let expectation =
+      match payload with
+      | PStr [{ pstr_desc = Pstr_eval (e, []) }] ->
+        let normal, principal =
+          match e.pexp_desc with
+          | Pexp_tuple
+              [ a
+              ; { pexp_desc = Pexp_construct
+                                ({ txt = Lident "Principal"; _ }, Some b) }
+              ] ->
+            (string_constant a, string_constant b)
+          | _ -> let s = string_constant e in (s, s)
+        in
+        { extid_loc
+        ; payload_loc = e.pexp_loc
+        ; normal
+        ; principal
+        }
+      | PStr [] ->
+        let s = { tag = ""; str = "" } in
+        { extid_loc
+        ; payload_loc  = { extid_loc with loc_start = extid_loc.loc_end }
+        ; normal    = s
+        ; principal = s
+        }
+      | _ -> invalid_payload ()
+    in
+    Some expectation
+  | _ ->
+    None
+
+(* Split a list of phrases from a .ml file *)
+let split_chunks phrases =
+  let rec loop (phrases : Parsetree.toplevel_phrase list) code_acc acc =
+    match phrases with
+    | [] ->
+      if code_acc = [] then
+        (List.rev acc, None)
+      else
+        (List.rev acc, Some (List.rev code_acc))
+    | phrase :: phrases ->
+      match phrase with
+      | Ptop_def [] -> loop phrases code_acc acc
+      | Ptop_def [{pstr_desc = Pstr_extension(ext, [])}] -> begin
+          match match_expect_extension ext with
+          | None -> loop phrases (phrase :: code_acc) acc
+          | Some expectation ->
+            let chunk =
+              { phrases     = List.rev code_acc
+              ; expectation
+              }
+            in
+            loop phrases [] (chunk :: acc)
+        end
+      | _ -> loop phrases (phrase :: code_acc) acc
+  in
+  loop phrases [] []
+
+module Compiler_messages = struct
+  let capture ppf ~f =
+    Misc.protect_refs
+      [ R (Location.formatter_for_warnings, ppf) ]
+      f
+end
+
+let collect_formatters buf pps ~f =
+  let ppb = Format.formatter_of_buffer buf in
+  let out_functions = Format.pp_get_formatter_out_functions ppb () in
+
+  List.iter (fun pp -> Format.pp_print_flush pp ()) pps;
+  let save =
+    List.map (fun pp -> Format.pp_get_formatter_out_functions pp ()) pps
+  in
+  let restore () =
+    List.iter2
+      (fun pp out_functions ->
+         Format.pp_print_flush pp ();
+         Format.pp_set_formatter_out_functions pp out_functions)
+      pps save
+  in
+  List.iter
+    (fun pp -> Format.pp_set_formatter_out_functions pp out_functions)
+    pps;
+  match f () with
+  | x             -> restore (); x
+  | exception exn -> restore (); raise exn
+
+(* Invariant: ppf = Format.formatter_of_buffer buf *)
+let capture_everything buf ppf ~f =
+  collect_formatters buf [Format.std_formatter; Format.err_formatter]
+                     ~f:(fun () -> Compiler_messages.capture ppf ~f)
+
+let exec_phrase ppf phrase =
+  if !Clflags.dump_parsetree then Printast. top_phrase ppf phrase;
+  if !Clflags.dump_source    then Pprintast.top_phrase ppf phrase;
+  Toploop.execute_phrase true ppf phrase
+
+let parse_contents ~fname contents =
+  let lexbuf = Lexing.from_string contents in
+  Location.init lexbuf fname;
+  Location.input_name := fname;
+  Location.input_lexbuf := Some lexbuf;
+  Parse.use_file lexbuf
+
+let eval_expectation expectation ~output =
+  let s =
+    if !Clflags.principal then
+      expectation.principal
+    else
+      expectation.normal
+  in
+  if s.str = output then
+    None
+  else
+    let s = { s with str = output } in
+    Some (
+      if !Clflags.principal then
+        { expectation with principal = s }
+      else
+        { expectation with normal = s }
+    )
+
+let shift_lines delta phrases =
+  let position (pos : Lexing.position) =
+    { pos with pos_lnum = pos.pos_lnum + delta }
+  in
+  let location _this (loc : Location.t) =
+    { loc with
+      loc_start = position loc.loc_start
+    ; loc_end   = position loc.loc_end
+    }
+  in
+  let mapper = { Ast_mapper.default_mapper with location } in
+  List.map phrases ~f:(function
+    | Parsetree.Ptop_dir _ as p -> p
+    | Parsetree.Ptop_def st ->
+      Parsetree.Ptop_def (mapper.structure mapper st))
+
+let rec min_line_number : Parsetree.toplevel_phrase list -> int option =
+function
+  | [] -> None
+  | (Ptop_dir _  | Ptop_def []) :: l -> min_line_number l
+  | Ptop_def (st :: _) :: _ -> Some st.pstr_loc.loc_start.pos_lnum
+
+let eval_expect_file _fname ~file_contents =
+  Warnings.reset_fatal ();
+  let chunks, trailing_code =
+    parse_contents ~fname:"" file_contents |> split_chunks
+  in
+  let buf = Buffer.create 1024 in
+  let ppf = Format.formatter_of_buffer buf in
+  let exec_phrases phrases =
+    let phrases =
+      match min_line_number phrases with
+      | None -> phrases
+      | Some lnum -> shift_lines (1 - lnum) phrases
+    in
+    (* For formatting purposes *)
+    Buffer.add_char buf '\n';
+    let _ : bool =
+      List.fold_left phrases ~init:true ~f:(fun acc phrase ->
+        acc &&
+        let snap = Btype.snapshot () in
+        try
+          exec_phrase ppf phrase
+        with exn ->
+          let bt = Printexc.get_raw_backtrace () in
+          begin try Location.report_exception ppf exn
+          with _ ->
+            Format.fprintf ppf "Uncaught exception: %s\n%s\n"
+              (Printexc.to_string exn)
+              (Printexc.raw_backtrace_to_string bt)
+          end;
+          Btype.backtrack snap;
+          false
+      )
+    in
+    Format.pp_print_flush ppf ();
+    let len = Buffer.length buf in
+    if len > 0 && Buffer.nth buf (len - 1) <> '\n' then
+      (* For formatting purposes *)
+      Buffer.add_char buf '\n';
+    let s = Buffer.contents buf in
+    Buffer.clear buf;
+    Misc.delete_eol_spaces s
+  in
+  let corrected_expectations =
+    capture_everything buf ppf ~f:(fun () ->
+      List.fold_left chunks ~init:[] ~f:(fun acc chunk ->
+        let output = exec_phrases chunk.phrases in
+        match eval_expectation chunk.expectation ~output with
+        | None -> acc
+        | Some correction -> correction :: acc)
+      |> List.rev)
+  in
+  let trailing_output =
+    match trailing_code with
+    | None -> ""
+    | Some phrases ->
+      capture_everything buf ppf ~f:(fun () -> exec_phrases phrases)
+  in
+  { corrected_expectations; trailing_output }
+
+let output_slice oc s a b =
+  output_string oc (String.sub s ~pos:a ~len:(b - a))
+
+let output_corrected oc ~file_contents correction =
+  let output_body oc { str; tag } =
+    Printf.fprintf oc "{%s|%s|%s}" tag str tag
+  in
+  let ofs =
+    List.fold_left correction.corrected_expectations ~init:0
+      ~f:(fun ofs c ->
+        output_slice oc file_contents ofs c.payload_loc.loc_start.pos_cnum;
+        output_body oc c.normal;
+        if c.normal.str <> c.principal.str then begin
+          output_string oc ", Principal";
+          output_body oc c.principal
+        end;
+        c.payload_loc.loc_end.pos_cnum)
+  in
+  output_slice oc file_contents ofs (String.length file_contents);
+  match correction.trailing_output with
+  | "" -> ()
+  | s  -> Printf.fprintf oc "\n[%%%%expect{|%s|}]\n" s
+
+let write_corrected ~file ~file_contents correction =
+  let oc = open_out file in
+  output_corrected oc ~file_contents correction;
+  close_out oc
+
+let process_expect_file fname =
+  let corrected_fname = fname ^ ".corrected" in
+  let file_contents =
+    let ic = open_in_bin fname in
+    match really_input_string ic (in_channel_length ic) with
+    | s           -> close_in ic; Misc.normalise_eol s
+    | exception e -> close_in ic; raise e
+  in
+  let correction = eval_expect_file fname ~file_contents in
+  write_corrected ~file:corrected_fname ~file_contents correction
+
+let repo_root = ref None
+let keep_original_error_size = ref false
+
+let main fname =
+  if not !keep_original_error_size then
+    Clflags.error_size := 0;
+  Toploop.override_sys_argv
+    (Array.sub Sys.argv ~pos:!Arg.current
+       ~len:(Array.length Sys.argv - !Arg.current));
+  (* Ignore OCAMLRUNPARAM=b to be reproducible *)
+  Printexc.record_backtrace false;
+  if not !Clflags.no_std_include then begin
+    match !repo_root with
+    | None -> ()
+    | Some dir ->
+        (* If we pass [-repo-root], use the stdlib from inside the
+           compiler, not the installed one. We use
+           [Compenv.last_include_dirs] to make sure that the stdlib
+           directory is the last one. *)
+        Clflags.no_std_include := true;
+        Compenv.last_include_dirs := [Filename.concat dir "stdlib"]
+  end;
+  Compmisc.init_path ();
+  Toploop.initialize_toplevel_env ();
+  Sys.interactive := false;
+  process_expect_file fname;
+  exit 0
+
+module Options = Main_args.Make_bytetop_options (struct
+  include Main_args.Default.Topmain
+  let _stdin () = (* disabled *) ()
+  let _args = Arg.read_arg
+  let _args0 = Arg.read_arg0
+  let anonymous s = main s
+end);;
+
+let args =
+  Arg.align
+    ( [ "-repo-root", Arg.String (fun s -> repo_root := Some s),
+        " root of the OCaml repository. This causes the tool to use \
+         the stdlib from the current source tree rather than the installed one."
+      ; "-keep-original-error-size", Arg.Set keep_original_error_size,
+        " truncate long error messages as the compiler would"
+      ] @ Options.list
+    )
+
+let usage = "Usage: expect_test  [script-file [arguments]]\n\
+             options are:"
+
+let () =
+  Clflags.color := Some Misc.Color.Never;
+  try
+    Arg.parse args main usage;
+    Printf.eprintf "expect_test: no input file\n";
+    exit 2
+  with exn ->
+    Location.report_exception Format.err_formatter exn;
+    exit 2
diff --git a/testsuite/tools/lexcmm.mli b/testsuite/tools/lexcmm.mli
new file mode 100644
index 00000000..9bac47a0
--- /dev/null
+++ b/testsuite/tools/lexcmm.mli
@@ -0,0 +1,25 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+val token: Lexing.lexbuf -> Parsecmm.token
+
+type error =
+    Illegal_character
+  | Unterminated_comment
+  | Unterminated_string
+
+exception Error of error
+
+val report_error: Lexing.lexbuf -> error -> unit
diff --git a/testsuite/tools/lexcmm.mll b/testsuite/tools/lexcmm.mll
new file mode 100644
index 00000000..fa5ecd1d
--- /dev/null
+++ b/testsuite/tools/lexcmm.mll
@@ -0,0 +1,261 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+{
+open Parsecmm
+
+type error =
+    Illegal_character
+  | Unterminated_comment
+  | Unterminated_string
+
+exception Error of error
+
+(* For nested comments *)
+
+let comment_depth = ref 0
+
+(* The table of keywords *)
+
+let keyword_table =
+  Misc.create_hashtable 149 [
+    "absf", ABSF;
+    "addr", ADDR;
+    "align", ALIGN;
+    "alloc", ALLOC;
+    "and", AND;
+    "app", APPLY;
+    "assign", ASSIGN;
+    "byte", BYTE;
+    "case", CASE;
+    "catch", CATCH;
+    "checkbound", CHECKBOUND;
+    "data", DATA;
+    "exit", EXIT;
+    "extcall", EXTCALL;
+    "float", FLOAT;
+    "float32", FLOAT32;
+    "float64", FLOAT64;
+    "floatofint", FLOATOFINT;
+    "function", FUNCTION;
+    "global", GLOBAL;
+    "half", HALF;
+    "if", IF;
+    "int", INT;
+    "int32", INT32;
+    "intoffloat", INTOFFLOAT;
+    "string", KSTRING;
+    "let", LET;
+    "letmut", LETMUT;
+    "load", LOAD;
+    "mod", MODI;
+    "mulh", MULH;
+    "or", OR;
+    "proj", PROJ;
+    "raise", RAISE Lambda.Raise_regular;
+    "reraise", RAISE Lambda.Raise_reraise;
+    "raise_notrace", RAISE Lambda.Raise_notrace;
+    "seq", SEQ;
+    "signed", SIGNED;
+    "skip", SKIP;
+    "store", STORE;
+    "switch", SWITCH;
+    "try", TRY;
+    "unit", UNIT;
+    "unsigned", UNSIGNED;
+    "val", VAL;
+    "while", WHILE;
+    "with", WITH;
+    "xor", XOR;
+    "addraref", ADDRAREF;
+    "intaref", INTAREF;
+    "floataref", FLOATAREF;
+    "addraset", ADDRASET;
+    "intaset", INTASET;
+    "floataset", FLOATASET
+]
+
+(* To buffer string literals *)
+
+let initial_string_buffer = Bytes.create 256
+let string_buff = ref initial_string_buffer
+let string_index = ref 0
+
+let reset_string_buffer () =
+  string_buff := initial_string_buffer;
+  string_index := 0
+
+let store_string_char c =
+  if !string_index >= Bytes.length (!string_buff) then begin
+    let new_buff = Bytes.create (Bytes.length (!string_buff) * 2) in
+    Bytes.blit (!string_buff) 0 new_buff 0 (Bytes.length (!string_buff));
+    string_buff := new_buff
+  end;
+  Bytes.unsafe_set (!string_buff) (!string_index) c;
+  incr string_index
+
+let get_stored_string () =
+  let s = Bytes.sub_string (!string_buff) 0 (!string_index) in
+  string_buff := initial_string_buffer;
+  s
+
+(* To translate escape sequences *)
+
+let char_for_backslash = function
+    'n' -> '\010'
+  | 'r' -> '\013'
+  | 'b' -> '\008'
+  | 't' -> '\009'
+  | c   -> c
+
+let char_for_decimal_code lexbuf i =
+  Char.chr(100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) +
+               10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) +
+                    (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48))
+
+(* Error report *)
+
+let report_error lexbuf msg =
+  prerr_string "Lexical error around character ";
+  prerr_int (Lexing.lexeme_start lexbuf);
+  match msg with
+    Illegal_character ->
+      prerr_string ": illegal character"
+  | Unterminated_comment ->
+      prerr_string ": unterminated comment"
+  | Unterminated_string ->
+      prerr_string ": unterminated string"
+
+}
+
+let newline = ('\013'* '\010')
+
+rule token = parse
+    newline
+      { Lexing.new_line lexbuf; token lexbuf }
+  | [' ' '\009' '\012'] +
+      { token lexbuf }
+  | "+a" { ADDA }
+  | "+v" { ADDV }
+  | "+f" { ADDF }
+  | "+" { ADDI }
+  | ">>s" { ASR }
+  | ":" { COLON }
+  | "/f" { DIVF }
+  | "/" { DIVI }
+  | eof { EOF }
+  | "==a" { EQA }
+  | "==f" { EQF }
+  | "==" { EQI }
+  | ">=a" { GEA }
+  | ">=f" { GEF }
+  | ">=" { GEI }
+  | ">a" { GTA }
+  | ">f" { GTF }
+  | ">" { GTI }
+  | "[" { LBRACKET }
+  | "<=a" { LEA }
+  | "<=f" { LEF }
+  | "<=" { LEI }
+  | "(" { LPAREN }
+  | "<<" { LSL }
+  | ">>u" { LSR }
+  | "=f" { NGEF }
+  | "!>f" { NGTF }
+  | "!<=f" { NLEF }
+  | "!
+          IDENT s }
+  | "\""
+      { reset_string_buffer();
+        string lexbuf;
+        STRING (get_stored_string()) }
+  | "(*"
+      { comment_depth := 1;
+        comment lexbuf;
+        token lexbuf }
+  | '{' ['A' - 'Z' 'a'-'z' '/' ',' '.' '-' '_' ' ''0'-'9']+
+        ':' [ '0'-'9' ]+ ',' ['0'-'9' ]+ '-' ['0'-'9' ]+ '}'
+      {
+        let loc_s = Lexing.lexeme lexbuf in
+        let pos_fname, pos_lnum, start, end_ =
+          Scanf.sscanf loc_s "{%s@:%i,%i-%i}" (fun file line start end_ ->
+              (file, line, start, end_))
+        in
+        let loc_start =
+          Lexing.{ pos_fname; pos_lnum; pos_bol = 0; pos_cnum = start }
+        in
+        let loc_end =
+          Lexing.{ pos_fname; pos_lnum; pos_bol = 0; pos_cnum = end_ }
+        in
+        let location = Location.{ loc_start; loc_end; loc_ghost = false } in
+        LOCATION location }
+  | _ { raise(Error(Illegal_character)) }
+
+and comment = parse
+    "(*"
+      { comment_depth := succ !comment_depth; comment lexbuf }
+  | "*)"
+      { comment_depth := pred !comment_depth;
+        if !comment_depth > 0 then comment lexbuf }
+  | eof
+      { raise (Error(Unterminated_comment)) }
+  | newline
+      { Lexing.new_line lexbuf; comment lexbuf }
+  | _
+      { comment lexbuf }
+
+and string = parse
+    '"'
+      { () }
+  | '\\' [' ' '\010' '\013' '\009' '\026' '\012'] +
+      { string lexbuf }
+  | '\\' ['\\' '"' 'n' 't' 'b' 'r']
+      { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
+        string lexbuf }
+  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
+      { store_string_char(char_for_decimal_code lexbuf 1);
+         string lexbuf }
+  | eof
+      { raise (Error(Unterminated_string)) }
+  | _
+      { store_string_char(Lexing.lexeme_char lexbuf 0);
+        string lexbuf }
diff --git a/testsuite/tools/parsecmm.mly b/testsuite/tools/parsecmm.mly
new file mode 100644
index 00000000..aa254da8
--- /dev/null
+++ b/testsuite/tools/parsecmm.mly
@@ -0,0 +1,426 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* A simple parser for C-- */
+
+%{
+open Cmm
+open Parsecmmaux
+
+let rec make_letdef def body =
+  match def with
+    [] -> body
+  | (id, def) :: rem ->
+      unbind_ident id;
+      Clet(id, def, make_letdef rem body)
+
+let rec make_letmutdef def body =
+  match def with
+    [] -> body
+  | (id, ty, def) :: rem ->
+      unbind_ident id;
+      Clet_mut(id, ty, def, make_letmutdef rem body)
+
+let make_switch n selector caselist =
+  let index = Array.make n 0 in
+  let casev = Array.of_list caselist in
+  let dbg = Debuginfo.none in
+  let actv = Array.make (Array.length casev) (Cexit(0,[]), dbg) in
+  for i = 0 to Array.length casev - 1 do
+    let (posl, e) = casev.(i) in
+    List.iter (fun pos -> index.(pos) <- i) posl;
+    actv.(i) <- (e, dbg)
+  done;
+  Cswitch(selector, index, actv, dbg)
+
+let access_array base numelt size =
+  match numelt with
+    Cconst_int (0, _) -> base
+  | Cconst_int (n, _) ->
+      let dbg = Debuginfo.none in
+      Cop(Cadda, [base; Cconst_int(n * size, dbg)], dbg)
+  | _ ->
+      let dbg = Debuginfo.none in
+      Cop(Cadda, [base;
+                  Cop(Clsl, [numelt; Cconst_int(Misc.log2 size, dbg)],
+                  dbg)],
+          dbg)
+
+%}
+
+%token ABSF
+%token ADDA
+%token ADDF
+%token ADDI
+%token ADDV
+%token ADDR
+%token ALIGN
+%token ALLOC
+%token AND
+%token APPLY
+%token ASR
+%token ASSIGN
+%token BYTE
+%token CASE
+%token CATCH
+%token CHECKBOUND
+%token COLON
+%token DATA
+%token DIVF
+%token DIVI
+%token EOF
+%token EQA
+%token EQF
+%token EQI
+%token EXIT
+%token EXTCALL
+%token FLOAT
+%token FLOAT32
+%token FLOAT64
+%token  FLOATCONST
+%token FLOATOFINT
+%token FUNCTION
+%token GEA
+%token GEF
+%token GEI
+%token GLOBAL
+%token GTA
+%token GTF
+%token GTI
+%token HALF
+%token  IDENT
+%token IF
+%token INT
+%token INT32
+%token  INTCONST
+%token INTOFFLOAT
+%token KSTRING
+%token LBRACKET
+%token LEA
+%token LEF
+%token LEI
+%token LET
+%token LETMUT
+%token LOAD
+%token  LOCATION
+%token LPAREN
+%token LSL
+%token LSR
+%token LTA
+%token LTF
+%token LTI
+%token MODI
+%token MULF
+%token MULH
+%token MULI
+%token NEA
+%token NEF
+%token NEI
+%token NGEF
+%token NGTF
+%token NLEF
+%token NLTF
+%token OR
+%token  POINTER
+%token PROJ
+%token  RAISE
+%token RBRACKET
+%token RPAREN
+%token SEQ
+%token SIGNED
+%token SKIP
+%token STAR
+%token STORE
+%token  STRING
+%token SUBF
+%token SUBI
+%token SWITCH
+%token TRY
+%token UNIT
+%token UNSIGNED
+%token VAL
+%token WHILE
+%token WITH
+%token XOR
+%token ADDRAREF
+%token INTAREF
+%token FLOATAREF
+%token ADDRASET
+%token INTASET
+%token FLOATASET
+
+%start phrase
+%type  phrase
+
+%%
+
+phrase:
+    fundecl     { Cfunction $1 }
+  | datadecl    { Cdata $1 }
+  | EOF         { raise End_of_file }
+;
+fundecl:
+    LPAREN FUNCTION fun_name LPAREN params RPAREN sequence RPAREN
+      { List.iter (fun (id, ty) -> unbind_ident id) $5;
+        {fun_name = $3; fun_args = $5; fun_body = $7;
+         fun_codegen_options =
+           if Config.flambda then [
+             Reduce_code_size;
+             No_CSE;
+           ]
+           else [ Reduce_code_size ];
+         fun_dbg = debuginfo ()} }
+;
+fun_name:
+    STRING              { $1 }
+  | IDENT               { $1 }
+params:
+    oneparam params     { $1 :: $2 }
+  | /**/                { [] }
+;
+oneparam:
+    IDENT COLON machtype { (bind_ident $1, $3) }
+;
+machtype:
+    UNIT                        { [||] }
+  | componentlist               { Array.of_list(List.rev $1) }
+;
+component:
+    VAL                         { Val }
+  | ADDR                        { Addr }
+  | INT                         { Int }
+  | FLOAT                       { Float }
+;
+componentlist:
+    component                    { [$1] }
+  | componentlist STAR component { $3 :: $1 }
+;
+expr:
+    INTCONST    { Cconst_int ($1, debuginfo ()) }
+  | FLOATCONST  { Cconst_float (float_of_string $1, debuginfo ()) }
+  | STRING      { Cconst_symbol ($1, debuginfo ()) }
+  | POINTER     { Cconst_pointer ($1, debuginfo ()) }
+  | IDENT       { Cvar(find_ident $1) }
+  | LBRACKET RBRACKET { Ctuple [] }
+  | LPAREN LET letdef sequence RPAREN { make_letdef $3 $4 }
+  | LPAREN LETMUT letmutdef sequence RPAREN { make_letmutdef $3 $4 }
+  | LPAREN ASSIGN IDENT expr RPAREN { Cassign(find_ident $3, $4) }
+  | LPAREN APPLY location expr exprlist machtype RPAREN
+                { Cop(Capply $6, $4 :: List.rev $5, debuginfo ?loc:$3 ()) }
+  | LPAREN EXTCALL STRING exprlist machtype RPAREN
+               {Cop(Cextcall($3, $5, false, None), List.rev $4, debuginfo ())}
+  | LPAREN ALLOC exprlist RPAREN { Cop(Calloc, List.rev $3, debuginfo ()) }
+  | LPAREN SUBF expr RPAREN { Cop(Cnegf, [$3], debuginfo ()) }
+  | LPAREN SUBF expr expr RPAREN { Cop(Csubf, [$3; $4], debuginfo ()) }
+  | LPAREN unaryop expr RPAREN { Cop($2, [$3], debuginfo ()) }
+  | LPAREN binaryop expr expr RPAREN { Cop($2, [$3; $4], debuginfo ()) }
+  | LPAREN SEQ sequence RPAREN { $3 }
+  | LPAREN IF expr expr expr RPAREN
+      { Cifthenelse($3, debuginfo (), $4, debuginfo (), $5, debuginfo ()) }
+  | LPAREN SWITCH INTCONST expr caselist RPAREN { make_switch $3 $4 $5 }
+  | LPAREN WHILE expr sequence RPAREN
+      {
+        let lbl0 = Lambda.next_raise_count () in
+        let lbl1 = Lambda.next_raise_count () in
+        let body =
+          match $3 with
+            Cconst_int (x, _) when x <> 0 -> $4
+          | _ -> Cifthenelse($3, debuginfo (), $4, debuginfo (),
+                             (Cexit(lbl0,[])),
+                             debuginfo ()) in
+        Ccatch(Nonrecursive, [lbl0, [], Ctuple [], debuginfo ()],
+          Ccatch(Recursive,
+            [lbl1, [], Csequence(body, Cexit(lbl1, [])), debuginfo ()],
+            Cexit(lbl1, []))) }
+  | LPAREN EXIT IDENT exprlist RPAREN
+    { Cexit(find_label $3, List.rev $4) }
+  | LPAREN CATCH sequence WITH catch_handlers RPAREN
+    { let handlers = $5 in
+      List.iter (fun (_, l, _, _) ->
+        List.iter (fun (x, _) -> unbind_ident x) l) handlers;
+      Ccatch(Recursive, handlers, $3) }
+  | EXIT        { Cexit(0,[]) }
+  | LPAREN TRY sequence WITH bind_ident sequence RPAREN
+                { unbind_ident $5; Ctrywith($3, $5, $6, debuginfo ()) }
+  | LPAREN VAL expr expr RPAREN
+      { let open Asttypes in
+        Cop(Cload (Word_val, Mutable), [access_array $3 $4 Arch.size_addr],
+          debuginfo ()) }
+  | LPAREN ADDRAREF expr expr RPAREN
+      { let open Asttypes in
+        Cop(Cload (Word_val, Mutable), [access_array $3 $4 Arch.size_addr],
+          Debuginfo.none) }
+  | LPAREN INTAREF expr expr RPAREN
+      { let open Asttypes in
+        Cop(Cload (Word_int, Mutable), [access_array $3 $4 Arch.size_int],
+          Debuginfo.none) }
+  | LPAREN FLOATAREF expr expr RPAREN
+      { let open Asttypes in
+        Cop(Cload (Double_u, Mutable), [access_array $3 $4 Arch.size_float],
+          Debuginfo.none) }
+  | LPAREN ADDRASET expr expr expr RPAREN
+      { let open Lambda in
+        Cop(Cstore (Word_val, Assignment),
+            [access_array $3 $4 Arch.size_addr; $5], Debuginfo.none) }
+  | LPAREN INTASET expr expr expr RPAREN
+      { let open Lambda in
+        Cop(Cstore (Word_int, Assignment),
+            [access_array $3 $4 Arch.size_int; $5], Debuginfo.none) }
+  | LPAREN FLOATASET expr expr expr RPAREN
+      { let open Lambda in
+        Cop(Cstore (Double_u, Assignment),
+            [access_array $3 $4 Arch.size_float; $5], Debuginfo.none) }
+;
+exprlist:
+    exprlist expr               { $2 :: $1 }
+  | /**/                        { [] }
+;
+letdef:
+    oneletdef                   { [$1] }
+  | LPAREN letdefmult RPAREN    { $2 }
+;
+letdefmult:
+    /**/                        { [] }
+  | oneletdef letdefmult        { $1 :: $2 }
+;
+oneletdef:
+    IDENT expr                  { (bind_ident $1, $2) }
+;
+letmutdef:
+    oneletmutdef                { [$1] }
+  | LPAREN letmutdefmult RPAREN { $2 }
+;
+letmutdefmult:
+    /**/                        { [] }
+  | oneletmutdef letmutdefmult  { $1 :: $2 }
+;
+oneletmutdef:
+    IDENT machtype expr         { (bind_ident $1, $2, $3) }
+;
+chunk:
+    UNSIGNED BYTE               { Byte_unsigned }
+  | SIGNED BYTE                 { Byte_signed }
+  | UNSIGNED HALF               { Sixteen_unsigned }
+  | SIGNED HALF                 { Sixteen_signed }
+  | UNSIGNED INT32              { Thirtytwo_unsigned }
+  | SIGNED INT32                { Thirtytwo_signed }
+  | INT                         { Word_int }
+  | ADDR                        { Word_val }
+  | FLOAT32                     { Single }
+  | FLOAT64                     { Double }
+  | FLOAT                       { Double_u }
+  | VAL                         { Word_val }
+;
+unaryop:
+    LOAD chunk                  { Cload ($2, Asttypes.Mutable) }
+  | FLOATOFINT                  { Cfloatofint }
+  | INTOFFLOAT                  { Cintoffloat }
+  | RAISE                       { Craise $1 }
+  | ABSF                        { Cabsf }
+;
+binaryop:
+    STORE chunk                 { Cstore ($2, Lambda.Assignment) }
+  | ADDI                        { Caddi }
+  | SUBI                        { Csubi }
+  | STAR                        { Cmuli }
+  | DIVI                        { Cdivi }
+  | MODI                        { Cmodi }
+  | AND                         { Cand }
+  | OR                          { Cor }
+  | XOR                         { Cxor }
+  | LSL                         { Clsl }
+  | LSR                         { Clsr }
+  | ASR                         { Casr }
+  | EQI                         { Ccmpi Ceq }
+  | NEI                         { Ccmpi Cne }
+  | LTI                         { Ccmpi Clt }
+  | LEI                         { Ccmpi Cle }
+  | GTI                         { Ccmpi Cgt }
+  | GEI                         { Ccmpi Cge }
+  | ADDA                        { Cadda }
+  | ADDV                        { Caddv }
+  | EQA                         { Ccmpa Ceq }
+  | NEA                         { Ccmpa Cne }
+  | LTA                         { Ccmpa Clt }
+  | LEA                         { Ccmpa Cle }
+  | GTA                         { Ccmpa Cgt }
+  | GEA                         { Ccmpa Cge }
+  | ADDF                        { Caddf }
+  | MULF                        { Cmulf }
+  | DIVF                        { Cdivf }
+  | EQF                         { Ccmpf CFeq }
+  | NEF                         { Ccmpf CFneq }
+  | LTF                         { Ccmpf CFlt }
+  | NLTF                        { Ccmpf CFnlt }
+  | LEF                         { Ccmpf CFle }
+  | NLEF                        { Ccmpf CFnle }
+  | GTF                         { Ccmpf CFgt }
+  | NGTF                        { Ccmpf CFngt }
+  | GEF                         { Ccmpf CFge }
+  | NGEF                        { Ccmpf CFnge }
+  | CHECKBOUND                  { Ccheckbound }
+  | MULH                        { Cmulhi }
+;
+sequence:
+    expr sequence               { Csequence($1, $2) }
+  | expr                        { $1 }
+;
+caselist:
+    onecase sequence caselist   { ($1, $2) :: $3 }
+  | /**/                        { [] }
+;
+onecase:
+    CASE INTCONST COLON onecase { $2 :: $4 }
+  | CASE INTCONST COLON         { [$2] }
+;
+bind_ident:
+    IDENT                       { bind_ident $1 }
+;
+datadecl:
+    LPAREN datalist RPAREN      { List.rev $2 }
+  | LPAREN DATA datalist RPAREN { List.rev $3 }
+;
+datalist:
+    datalist dataitem           { $2 :: $1 }
+  | /**/                        { [] }
+;
+dataitem:
+    STRING COLON                { Cdefine_symbol $1 }
+  | BYTE INTCONST               { Cint8 $2 }
+  | HALF INTCONST               { Cint16 $2 }
+  | INT INTCONST                { Cint(Nativeint.of_int $2) }
+  | FLOAT FLOATCONST            { Cdouble (float_of_string $2) }
+  | ADDR STRING                 { Csymbol_address $2 }
+  | VAL STRING                 { Csymbol_address $2 }
+  | KSTRING STRING              { Cstring $2 }
+  | SKIP INTCONST               { Cskip $2 }
+  | ALIGN INTCONST              { Calign $2 }
+  | GLOBAL STRING               { Cglobal_symbol $2 }
+;
+catch_handlers:
+  | catch_handler
+    { [$1] }
+  | catch_handler AND catch_handlers
+    { $1 :: $3 }
+
+catch_handler:
+  | sequence
+    { 0, [], $1, debuginfo () }
+  | LPAREN IDENT params RPAREN sequence
+    { find_label $2, $3, $5, debuginfo () }
+
+location:
+    /**/                        { None }
+  | LOCATION                    { Some $1 }
diff --git a/testsuite/tools/parsecmmaux.ml b/testsuite/tools/parsecmmaux.ml
new file mode 100644
index 00000000..89d8b2a3
--- /dev/null
+++ b/testsuite/tools/parsecmmaux.ml
@@ -0,0 +1,58 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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 functions for parsing *)
+
+type error =
+    Unbound of string
+
+exception Error of error
+
+let tbl_ident = (Hashtbl.create 57 : (string, Backend_var.t) Hashtbl.t)
+let tbl_label = (Hashtbl.create 57 : (string, int) Hashtbl.t)
+
+let ident_name s =
+  match String.index s '/' with
+  | exception Not_found -> s
+  | n -> String.sub s 0 n
+
+let bind_ident s =
+  let id = Backend_var.create_local (ident_name s) in
+  Hashtbl.add tbl_ident s id;
+  Backend_var.With_provenance.create id
+
+let find_ident s =
+  try
+    Hashtbl.find tbl_ident s
+  with Not_found ->
+    raise(Error(Unbound s))
+
+let unbind_ident id =
+  Hashtbl.remove tbl_ident (Backend_var.With_provenance.name id)
+
+let find_label s =
+  try
+    Hashtbl.find tbl_label s
+  with Not_found ->
+    let lbl = Lambda.next_raise_count () in
+    Hashtbl.add tbl_label s lbl;
+    lbl
+
+let report_error = function
+    Unbound s ->
+      prerr_string "Unbound identifier "; prerr_string s; prerr_endline "."
+
+let debuginfo ?(loc=Location.symbol_rloc ()) () =
+  Debuginfo.(from_location (Scoped_location.of_location ~scopes:[] loc))
diff --git a/testsuite/tools/parsecmmaux.mli b/testsuite/tools/parsecmmaux.mli
new file mode 100644
index 00000000..a6728b49
--- /dev/null
+++ b/testsuite/tools/parsecmmaux.mli
@@ -0,0 +1,31 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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 functions for parsing *)
+
+val bind_ident: string -> Backend_var.With_provenance.t
+val find_ident: string -> Backend_var.t
+val unbind_ident: Backend_var.With_provenance.t -> unit
+
+val find_label: string -> int
+
+val debuginfo: ?loc:Location.t -> unit -> Debuginfo.t
+
+type error =
+    Unbound of string
+
+exception Error of error
+
+val report_error: error -> unit
diff --git a/tools/.depend b/tools/.depend
new file mode 100644
index 00000000..109cb1f3
--- /dev/null
+++ b/tools/.depend
@@ -0,0 +1,199 @@
+caml_tex.cmo : \
+    ../toplevel/toploop.cmi \
+    ../parsing/syntaxerr.cmi \
+    ../parsing/parsetree.cmi \
+    ../parsing/parse.cmi \
+    ../utils/misc.cmi \
+    ../parsing/location.cmi \
+    ../parsing/lexer.cmi \
+    ../driver/compmisc.cmi \
+    ../driver/compenv.cmi \
+    ../utils/clflags.cmi \
+    ../parsing/ast_iterator.cmi \
+    ../parsing/ast_helper.cmi
+caml_tex.cmx : \
+    ../toplevel/toploop.cmx \
+    ../parsing/syntaxerr.cmx \
+    ../parsing/parsetree.cmi \
+    ../parsing/parse.cmx \
+    ../utils/misc.cmx \
+    ../parsing/location.cmx \
+    ../parsing/lexer.cmx \
+    ../driver/compmisc.cmx \
+    ../driver/compenv.cmx \
+    ../utils/clflags.cmx \
+    ../parsing/ast_iterator.cmx \
+    ../parsing/ast_helper.cmx
+cmpbyt.cmo : \
+    ../bytecomp/bytesections.cmi
+cmpbyt.cmx : \
+    ../bytecomp/bytesections.cmx
+cvt_emit.cmo :
+cvt_emit.cmx :
+dumpobj.cmo : \
+    ../bytecomp/symtable.cmi \
+    opnames.cmo \
+    ../bytecomp/opcodes.cmi \
+    ../parsing/location.cmi \
+    ../lambda/lambda.cmi \
+    ../bytecomp/instruct.cmi \
+    ../typing/ident.cmi \
+    ../utils/config.cmi \
+    ../file_formats/cmo_format.cmi \
+    ../bytecomp/bytesections.cmi \
+    ../parsing/asttypes.cmi
+dumpobj.cmx : \
+    ../bytecomp/symtable.cmx \
+    opnames.cmx \
+    ../bytecomp/opcodes.cmx \
+    ../parsing/location.cmx \
+    ../lambda/lambda.cmx \
+    ../bytecomp/instruct.cmx \
+    ../typing/ident.cmx \
+    ../utils/config.cmx \
+    ../file_formats/cmo_format.cmi \
+    ../bytecomp/bytesections.cmx \
+    ../parsing/asttypes.cmi
+eqparsetree.cmo : \
+    ../parsing/parsetree.cmi \
+    ../parsing/longident.cmi \
+    ../parsing/location.cmi \
+    ../parsing/asttypes.cmi
+eqparsetree.cmx : \
+    ../parsing/parsetree.cmi \
+    ../parsing/longident.cmx \
+    ../parsing/location.cmx \
+    ../parsing/asttypes.cmi
+lintapidiff.cmo : \
+    ../typing/printtyp.cmi \
+    ../driver/pparse.cmi \
+    ../typing/path.cmi \
+    ../parsing/parsetree.cmi \
+    ../parsing/parse.cmi \
+    ../utils/misc.cmi \
+    ../parsing/location.cmi \
+    ../typing/ident.cmi
+lintapidiff.cmx : \
+    ../typing/printtyp.cmx \
+    ../driver/pparse.cmx \
+    ../typing/path.cmx \
+    ../parsing/parsetree.cmi \
+    ../parsing/parse.cmx \
+    ../utils/misc.cmx \
+    ../parsing/location.cmx \
+    ../typing/ident.cmx
+make_opcodes.cmo :
+make_opcodes.cmx :
+objinfo.cmo : \
+    ../bytecomp/symtable.cmi \
+    ../middle_end/symbol.cmi \
+    ../middle_end/printclambda.cmi \
+    ../utils/misc.cmi \
+    ../middle_end/linkage_name.cmi \
+    ../typing/ident.cmi \
+    ../middle_end/flambda/export_info.cmi \
+    ../utils/config.cmi \
+    ../middle_end/compilation_unit.cmi \
+    ../file_formats/cmxs_format.cmi \
+    ../file_formats/cmx_format.cmi \
+    ../file_formats/cmt_format.cmi \
+    ../file_formats/cmo_format.cmi \
+    ../file_formats/cmi_format.cmi \
+    ../bytecomp/bytesections.cmi
+objinfo.cmx : \
+    ../bytecomp/symtable.cmx \
+    ../middle_end/symbol.cmx \
+    ../middle_end/printclambda.cmx \
+    ../utils/misc.cmx \
+    ../middle_end/linkage_name.cmx \
+    ../typing/ident.cmx \
+    ../middle_end/flambda/export_info.cmx \
+    ../utils/config.cmx \
+    ../middle_end/compilation_unit.cmx \
+    ../file_formats/cmxs_format.cmi \
+    ../file_formats/cmx_format.cmi \
+    ../file_formats/cmt_format.cmx \
+    ../file_formats/cmo_format.cmi \
+    ../file_formats/cmi_format.cmx \
+    ../bytecomp/bytesections.cmx
+ocamlcp.cmo : \
+    ../driver/main_args.cmi
+ocamlcp.cmx : \
+    ../driver/main_args.cmx
+ocamldep.cmo : \
+    ../driver/makedepend.cmi
+ocamldep.cmx : \
+    ../driver/makedepend.cmx
+ocamlmklib.cmo : \
+    ocamlmklibconfig.cmo \
+    ../utils/misc.cmi \
+    ../utils/config.cmi
+ocamlmklib.cmx : \
+    ocamlmklibconfig.cmx \
+    ../utils/misc.cmx \
+    ../utils/config.cmx
+ocamlmklibconfig.cmo :
+ocamlmklibconfig.cmx :
+ocamlmktop.cmo : \
+    ../utils/ccomp.cmi
+ocamlmktop.cmx : \
+    ../utils/ccomp.cmx
+ocamloptp.cmo : \
+    ../driver/main_args.cmi
+ocamloptp.cmx : \
+    ../driver/main_args.cmx
+ocamlprof.cmo : \
+    ../utils/warnings.cmi \
+    ../parsing/parsetree.cmi \
+    ../parsing/parse.cmi \
+    ../parsing/location.cmi
+ocamlprof.cmx : \
+    ../utils/warnings.cmx \
+    ../parsing/parsetree.cmi \
+    ../parsing/parse.cmx \
+    ../parsing/location.cmx
+opnames.cmo :
+opnames.cmx :
+primreq.cmo : \
+    ../utils/misc.cmi \
+    ../utils/config.cmi \
+    ../file_formats/cmo_format.cmi
+primreq.cmx : \
+    ../utils/misc.cmx \
+    ../utils/config.cmx \
+    ../file_formats/cmo_format.cmi
+profiling.cmo : \
+    profiling.cmi
+profiling.cmx : \
+    profiling.cmi
+profiling.cmi :
+read_cmt.cmo : \
+    ../typing/untypeast.cmi \
+    ../typing/stypes.cmi \
+    ../parsing/pprintast.cmi \
+    ../parsing/location.cmi \
+    ../utils/load_path.cmi \
+    ../typing/envaux.cmi \
+    ../driver/compmisc.cmi \
+    ../file_formats/cmt_format.cmi \
+    ../typing/cmt2annot.cmo \
+    ../utils/clflags.cmi \
+    ../typing/annot.cmi
+read_cmt.cmx : \
+    ../typing/untypeast.cmx \
+    ../typing/stypes.cmx \
+    ../parsing/pprintast.cmx \
+    ../parsing/location.cmx \
+    ../utils/load_path.cmx \
+    ../typing/envaux.cmx \
+    ../driver/compmisc.cmx \
+    ../file_formats/cmt_format.cmx \
+    ../typing/cmt2annot.cmx \
+    ../utils/clflags.cmx \
+    ../typing/annot.cmi
+stripdebug.cmo : \
+    ../utils/misc.cmi \
+    ../bytecomp/bytesections.cmi
+stripdebug.cmx : \
+    ../utils/misc.cmx \
+    ../bytecomp/bytesections.cmx
diff --git a/tools/Makefile b/tools/Makefile
new file mode 100644
index 00000000..dbad0b74
--- /dev/null
+++ b/tools/Makefile
@@ -0,0 +1,392 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+MAKEFLAGS := -r -R
+ROOTDIR = ..
+
+-include $(ROOTDIR)/Makefile.config
+-include $(ROOTDIR)/Makefile.common
+
+ifeq ($(SYSTEM),unix)
+override define shellquote
+$i := $$(subst ",\",$$(subst $$$$,\$$$$,$$(subst `,\`,$i)))#")#
+endef
+$(foreach i,BINDIR LIBDIR STUBLIBDIR MANDIR,$(eval $(shellquote)))
+endif
+
+DESTDIR ?=
+# Setup GNU make variables storing per-target source and target,
+# a list of installed tools, and a function to quote a filename for
+# the shell.
+override installed_tools := ocamldep ocamlprof ocamlcp ocamloptp \
+                   ocamlmktop ocamlmklib ocamlobjinfo
+
+install_files :=
+define byte2native
+$(patsubst %.cmo,%.cmx,$(patsubst %.cma,%.cmxa,$1))
+endef
+
+# $1 = target, $2 = OCaml object dependencies, $3 = other dependencies
+# There is a lot of subtle code here.  The multiple layers of expansion
+# are due to `make`'s eval() function, which evaluates the string
+# passed to it as a makefile fragment.  So it is crucial that variables
+# not get expanded too many times.
+define byte_and_opt_
+# This check is defensive programming
+$(and $(filter-out 1,$(words $1)),$(error \
+   cannot build file with whitespace in name))
+$1: $3 $2
+	$$(CAMLC) $$(LINKFLAGS) -I $$(ROOTDIR) -o $$@ $2
+
+$1.opt: $3 $$(call byte2native,$2)
+	$$(CAMLOPT_CMD) $$(LINKFLAGS) -I $$(ROOTDIR) -o $$@ \
+	                $$(call byte2native,$2)
+
+all: $1
+
+opt.opt: $1.opt
+
+ifeq '$(filter $(installed_tools),$1)' '$1'
+install_files += $1
+endif
+clean::
+	rm -f -- $1 $1.opt
+
+endef
+
+# Escape any $ characters in the arguments and eval the result.
+define byte_and_opt
+$(eval $(call \
+ byte_and_opt_,$(subst $$,$$$$,$1),$(subst $$,$$$$,$2),$(subst $$,$$$$,$3)))
+endef
+
+CAMLC = $(BOOT_OCAMLC) -g -nostdlib -I $(ROOTDIR)/boot \
+        -use-prims $(ROOTDIR)/runtime/primitives -I $(ROOTDIR)
+CAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -g -nostdlib -I $(ROOTDIR)/stdlib
+CAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex
+INCLUDES = $(addprefix -I $(ROOTDIR)/,utils parsing typing bytecomp \
+                       middle_end middle_end/closure middle_end/flambda \
+                       middle_end/flambda/base_types driver toplevel \
+                       file_formats lambda)
+COMPFLAGS = -absname -w +a-4-9-41-42-44-45-48 -strict-sequence -warn-error A \
+ -principal -safe-string -strict-formats -bin-annot $(INCLUDES)
+LINKFLAGS = $(INCLUDES)
+VPATH := $(filter-out -I,$(INCLUDES))
+
+.PHONY: all allopt opt.opt # allopt and opt.opt are synonyms
+allopt: opt.opt
+
+# The dependency generator
+
+CAMLDEP_OBJ=ocamldep.cmo
+CAMLDEP_IMPORTS= \
+  $(ROOTDIR)/compilerlibs/ocamlcommon.cma \
+  $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma
+ocamldep: LINKFLAGS += -compat-32
+$(call byte_and_opt,ocamldep,$(CAMLDEP_IMPORTS) $(CAMLDEP_OBJ),)
+ocamldep: depend.cmi
+ocamldep.opt: depend.cmi
+
+# ocamldep is precious: sometimes we are stuck in the middle of a
+# bootstrap and we need to remake the dependencies
+clean::
+	if test -f ocamldep; then mv -f ocamldep ocamldep.bak; else :; fi
+	rm -f ocamldep.opt
+
+
+# The profiler
+
+CSLPROF=ocamlprof.cmo
+CSLPROF_IMPORTS=config.cmo build_path_prefix_map.cmo misc.cmo identifiable.cmo \
+  numbers.cmo arg_helper.cmo clflags.cmo terminfo.cmo \
+  warnings.cmo location.cmo longident.cmo docstrings.cmo \
+  syntaxerr.cmo ast_helper.cmo \
+  camlinternalMenhirLib.cmo parser.cmo \
+  pprintast.cmo \
+  lexer.cmo parse.cmo
+
+$(call byte_and_opt,ocamlprof,$(CSLPROF_IMPORTS) profiling.cmo $(CSLPROF),)
+
+ocamlcp_cmos = config.cmo build_path_prefix_map.cmo misc.cmo profile.cmo \
+               warnings.cmo identifiable.cmo numbers.cmo arg_helper.cmo \
+               clflags.cmo \
+               terminfo.cmo location.cmo load_path.cmo ccomp.cmo compenv.cmo \
+               main_args.cmo
+
+$(call byte_and_opt,ocamlcp,$(ocamlcp_cmos) ocamlcp.cmo,)
+$(call byte_and_opt,ocamloptp,$(ocamlcp_cmos) ocamloptp.cmo,)
+
+opt:: profiling.cmx
+
+install::
+	$(INSTALL_DATA) \
+	  profiling.cmi profiling.cmo \
+	  "$(INSTALL_LIBDIR)"
+ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
+	$(INSTALL_DATA) \
+	  profiling.cmt profiling.cmti \
+	  "$(INSTALL_LIBDIR)"
+endif
+
+installopt::
+	$(INSTALL_DATA) \
+          profiling.cmx profiling.$(O) \
+	  "$(INSTALL_LIBDIR)"
+
+# To help building mixed-mode libraries (OCaml + C)
+
+$(call byte_and_opt,ocamlmklib,ocamlmklibconfig.cmo config.cmo \
+	         build_path_prefix_map.cmo misc.cmo ocamlmklib.cmo,)
+
+
+ocamlmklibconfig.ml: $(ROOTDIR)/Makefile.config Makefile
+	(echo 'let bindir = "$(BINDIR)"'; \
+         echo 'let supports_shared_libraries = $(SUPPORTS_SHARED_LIBRARIES)';\
+         echo 'let default_rpath = "$(RPATH)"'; \
+         echo 'let mksharedlibrpath = "$(MKSHAREDLIBRPATH)"'; \
+         echo 'let toolpref = "$(TOOLPREF)"';) \
+        > ocamlmklibconfig.ml
+
+beforedepend:: ocamlmklibconfig.ml
+
+clean::
+	rm -f ocamlmklibconfig.ml
+
+# To make custom toplevels
+
+OCAMLMKTOP=ocamlmktop.cmo
+OCAMLMKTOP_IMPORTS=config.cmo build_path_prefix_map.cmo misc.cmo \
+       identifiable.cmo numbers.cmo arg_helper.cmo clflags.cmo \
+       load_path.cmo profile.cmo ccomp.cmo
+
+$(call byte_and_opt,ocamlmktop,$(OCAMLMKTOP_IMPORTS) $(OCAMLMKTOP),)
+
+# Converter olabl/ocaml 2.99 to ocaml 3
+
+LIBRARY3=config.cmo build_path_prefix_map.cmo misc.cmo warnings.cmo location.cmo
+
+ifeq ($(UNIX_OR_WIN32),unix)
+LN := ln -sf
+else
+LN := cp -pf
+endif
+
+install::
+ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
+	for i in $(install_files); \
+	do \
+	  $(INSTALL_PROG) "$$i" "$(INSTALL_BINDIR)/$$i.byte$(EXE)"; \
+	  if test -f "$$i".opt; then \
+	    $(INSTALL_PROG) "$$i.opt" "$(INSTALL_BINDIR)/$$i.opt$(EXE)" && \
+	    (cd "$(INSTALL_BINDIR)/" && $(LN) "$$i.opt$(EXE)" "$$i$(EXE)"); \
+	  else \
+	    (cd "$(INSTALL_BINDIR)/" && $(LN) "$$i.byte$(EXE)" "$$i$(EXE)"); \
+	  fi; \
+	done
+else
+	for i in $(install_files); \
+	do \
+	  if test -f "$$i".opt; then \
+	    $(INSTALL_PROG) "$$i.opt" "$(INSTALL_BINDIR)/$$i.opt$(EXE)"; \
+	    (cd "$(INSTALL_BINDIR)/" && $(LN) "$$i.opt$(EXE)" "$$i$(EXE)"); \
+	  fi; \
+	done
+endif
+
+# The preprocessor for asm generators
+
+CVT_EMIT=cvt_emit.cmo
+
+cvt_emit: $(CVT_EMIT)
+	$(CAMLC) $(LINKFLAGS) -o cvt_emit $(CVT_EMIT)
+
+# cvt_emit is precious: sometimes we are stuck in the middle of a
+# bootstrap and we need to remake the dependencies
+.PRECIOUS: cvt_emit
+clean::
+	if test -f cvt_emit; then mv -f cvt_emit cvt_emit.bak; else :; fi
+
+clean::
+	rm -f cvt_emit.ml
+
+beforedepend:: cvt_emit.ml
+
+# Reading cmt files
+
+READ_CMT= \
+          $(ROOTDIR)/compilerlibs/ocamlcommon.cma \
+          $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
+          \
+          read_cmt.cmo
+
+# Reading cmt files
+$(call byte_and_opt,read_cmt,$(READ_CMT),)
+
+install::
+	if test -f read_cmt.opt; then \
+	  $(INSTALL_PROG) read_cmt.opt "$(INSTALL_BINDIR)/ocamlcmt$(EXE)"; \
+	else \
+	  $(INSTALL_PROG) read_cmt "$(INSTALL_BINDIR)/ocamlcmt$(EXE)"; \
+	fi
+
+
+# The bytecode disassembler
+
+DUMPOBJ= \
+          $(ROOTDIR)/compilerlibs/ocamlcommon.cma \
+          $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
+          \
+          opnames.cmo dumpobj.cmo
+
+$(call byte_and_opt,dumpobj,$(DUMPOBJ),)
+
+make_opcodes: make_opcodes.ml
+	$(CAMLC) make_opcodes.ml -o $@
+
+opnames.ml: $(ROOTDIR)/runtime/caml/instruct.h make_opcodes
+	$(ROOTDIR)/runtime/ocamlrun make_opcodes -opnames < $< > $@
+
+clean::
+	rm -f opnames.ml make_opcodes make_opcodes.ml
+
+beforedepend:: opnames.ml
+
+# Display info on compiled files
+
+DEF_SYMBOL_PREFIX = '-Dsymbol_prefix=""'
+
+ifeq "$(SYSTEM)" "macosx"
+DEF_SYMBOL_PREFIX = '-Dsymbol_prefix="_"'
+endif
+
+ifeq "$(SYSTEM)" "cygwin"
+DEF_SYMBOL_PREFIX = '-Dsymbol_prefix="_"'
+endif
+
+objinfo_helper$(EXE): objinfo_helper.$(O)
+	$(CC) $(BFD_LDFLAGS) $(OC_CFLAGS) $(OUTPUTEXE)$@ $< $(BFD_LDLIBS)
+
+objinfo_helper.$(O): $(ROOTDIR)/runtime/caml/s.h
+
+objinfo_helper.$(O): \
+  OC_CPPFLAGS += -I$(ROOTDIR)/runtime $(DEF_SYMBOL_PREFIX) $(BFD_CPPFLAGS)
+
+OBJINFO=$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
+        $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
+        $(ROOTDIR)/compilerlibs/ocamlmiddleend.cma \
+        objinfo.cmo
+
+$(call byte_and_opt,ocamlobjinfo,$(OBJINFO),objinfo_helper$(EXE))
+
+install::
+	$(INSTALL_PROG) \
+	  objinfo_helper$(EXE) "$(INSTALL_LIBDIR)/objinfo_helper$(EXE)"
+
+primreq=$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
+        $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
+        primreq.cmo
+
+# Scan object files for required primitives
+$(call byte_and_opt,primreq,$(primreq),)
+
+LINTAPIDIFF=$(ROOTDIR)/compilerlibs/ocamlcommon.cmxa \
+        $(ROOTDIR)/compilerlibs/ocamlbytecomp.cmxa \
+        $(ROOTDIR)/compilerlibs/ocamlmiddleend.cmxa \
+	$(ROOTDIR)/otherlibs/str/str.cmxa \
+	lintapidiff.cmx
+
+lintapidiff.opt: INCLUDES+= -I $(ROOTDIR)/otherlibs/str
+lintapidiff.opt: $(LINTAPIDIFF)
+	$(CAMLOPT_CMD) $(LINKFLAGS) -I $(ROOTDIR) -o $@ $(LINTAPIDIFF)
+clean::
+	rm -f -- lintapidiff.opt lintapidiff.cm? lintapidiff.o lintapidiff.obj
+
+
+clean::
+	rm -f "objinfo_helper" "objinfo_helper.manifest"
+	rm -f "objinfo_helper.exe" "objinfo_helper.exe.manifest"
+
+# Eventlog metadata file
+
+install::
+	$(INSTALL_DATA) \
+	  eventlog_metadata \
+	  "$(INSTALL_LIBDIR)"
+
+# Copy a bytecode executable, stripping debug info
+
+stripdebug=$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
+           $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
+           stripdebug.cmo
+
+$(call byte_and_opt,stripdebug,$(stripdebug),)
+
+# Compare two bytecode executables
+
+CMPBYT=$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
+       $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
+       cmpbyt.cmo
+
+$(call byte_and_opt,cmpbyt,$(CMPBYT),)
+
+CAMLTEX= $(ROOTDIR)/compilerlibs/ocamlcommon.cma \
+	$(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
+	$(ROOTDIR)/compilerlibs/ocamltoplevel.cma \
+	$(ROOTDIR)/otherlibs/str/str.cma \
+	$(ROOTDIR)/otherlibs/$(UNIXLIB)/unix.cma \
+	caml_tex.ml
+
+#Scan latex files, and run ocaml code examples
+
+caml-tex: INCLUDES += $(addprefix -I $(ROOTDIR)/otherlibs/,str $(UNIXLIB))
+caml-tex: $(CAMLTEX)
+	$(ROOTDIR)/runtime/ocamlrun $(ROOTDIR)/ocamlc -nostdlib \
+	                            -I $(ROOTDIR)/stdlib $(LINKFLAGS) -linkall \
+	                            -o $@ -no-alias-deps $(CAMLTEX)
+
+# we need str and unix which depend on the bytecode version of other tools
+# thus we delay building caml-tex to the opt.opt stage
+ifneq "$(WITH_CAMLTEX)" ""
+opt.opt:caml-tex
+endif
+clean::
+	rm -f -- caml-tex caml_tex.cm?
+
+# Common stuff
+
+%.ml: %.mll
+	$(CAMLLEX) $(OCAMLLEX_FLAGS) $<
+
+%.cmo: %.ml
+	$(CAMLC) -c $(COMPFLAGS) - $<
+
+%.cmi: %.mli
+	$(CAMLC) -c $(COMPFLAGS) - $<
+
+%.cmx: %.ml
+	$(CAMLOPT) $(COMPFLAGS) -c - $<
+
+clean::
+	rm -f *.cmo *.cmi *.cma *.dll *.so *.lib *.a
+
+CAMLDEP=$(BOOT_OCAMLC) -depend
+DEPFLAGS=-slash
+DEPINCLUDES=$(INCLUDES)
+depend: beforedepend
+	$(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) *.mli *.ml > .depend
+
+.PHONY: clean install beforedepend depend
+
+include .depend
diff --git a/tools/autogen b/tools/autogen
new file mode 100755
index 00000000..8c85c2cb
--- /dev/null
+++ b/tools/autogen
@@ -0,0 +1,40 @@
+#!/bin/sh -e
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                David Allsopp, MetaStack Solutions Ltd.                 *
+#*                                                                        *
+#*   Copyright 2019 MetaStack Solutions Ltd.                              *
+#*                                                                        *
+#*   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.          *
+#*                                                                        *
+#**************************************************************************
+
+# Remove the autom4te.cache directory to make sure we start in a clean state
+rm -rf autom4te.cache
+
+autoconf --force --warnings=all,error
+
+# Allow pre-processing of configure arguments for Git check-outs
+# The sed call removes dra27's copyright on the whole configure script...
+sed -e '/^#[^!]/d' tools/git-dev-options.sh > configure.tmp
+
+# Some distros have the 2013 --runstatedir patch to autoconf (see
+# http://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=a197431414088a417b407b9b20583b2e8f7363bd
+# in the GNU autoconf repo), and some don't, so ensure its effects are
+# removed for CI consistency...
+# POSIX Notes
+#  - sed -i without a backup file is not portable, hence configure.tmp
+#  - GNU sed's /../,+8d becomes /../{N;..;d;} (and the last ; is important)
+sed -e '/^runstatedir/d' \
+    -e '/-runstatedir /{N;N;N;N;N;N;N;N;d;}' \
+    -e '/--runstatedir=DIR/d' \
+    -e 's/ runstatedir//' \
+    -e '1d' \
+    configure >> configure.tmp
+
+mv -f configure.tmp configure
+chmod +x configure
diff --git a/tools/caml_tex.ml b/tools/caml_tex.ml
new file mode 100644
index 00000000..ae89477d
--- /dev/null
+++ b/tools/caml_tex.ml
@@ -0,0 +1,779 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Paris                  *)
+(*             Jacques Garrigue, Nagoya University                        *)
+(*             Florian Angeletti                                          *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@warning "a-40-6"]
+open StdLabels
+open Str
+
+let camlprefix = "caml"
+
+let latex_escape s = String.concat "" ["$"; s; "$"]
+let camlin = latex_escape {|\\?|} ^ {|\1|}
+let camlout = latex_escape {|\\:|} ^ {|\1|}
+let camlbunderline = "<<"
+let camleunderline = ">>"
+
+
+(** Restrict the number of latex environment *)
+type env = Env of string
+let main = Env "example"
+let input_env = Env "input"
+let ok_output = Env "output"
+let error = Env "error"
+let warning = Env "warn"
+let phrase_env = Env ""
+
+let start out (Env s) args =
+  Format.fprintf out "\\begin{%s%s}" camlprefix s;
+  List.iter (Format.fprintf out "{%s}") args;
+  Format.fprintf out "\n"
+
+let stop out (Env s) =
+  Format.fprintf out "\\end{%s%s}" camlprefix s;
+  Format.fprintf out "\n"
+
+let code_env env out s =
+  let sep = if s.[String.length s - 1] = '\n' then "" else "\n" in
+  Format.fprintf out "%a%s%s%a"
+    (fun ppf env -> start ppf env [])
+    env s sep stop env
+
+
+type example_mode = Toplevel | Verbatim | Signature
+let string_of_mode =  function
+  | Toplevel -> "toplevel"
+  | Verbatim -> "verbatim"
+  | Signature -> "signature"
+
+
+let verbose = ref true
+let linelen = ref 72
+let outfile = ref ""
+let cut_at_blanks = ref false
+let files = ref []
+let repo_root = ref ""
+
+let (~!) =
+  let memo = ref [] in
+  fun key ->
+    try List.assq key !memo
+    with Not_found ->
+      let data = Str.regexp key in
+      memo := (key, data) :: !memo;
+      data
+
+exception Phrase_parsing of string
+
+module Toplevel = struct
+  (** Initialize the toplevel loop, redirect stdout and stderr,
+      capture warnings and error messages *)
+
+  type output =
+    {
+      error : string; (** error message text *)
+      warnings : string list; (** warning messages text *)
+      values : string; (** toplevel output *)
+      stdout : string; (** output printed on the toplevel stdout *)
+      underlined : (int * int) list
+      (** locations to underline in input phrases *)
+    }
+
+  let buffer_fmt () =
+    let b = Buffer.create 30 in b, Format.formatter_of_buffer b
+
+  let error_fmt = buffer_fmt ()
+  let warning_fmt = buffer_fmt ()
+
+  let out_fmt = buffer_fmt ()
+
+  let flush_fmt (b,fmt) =
+    Format.pp_print_flush fmt ();
+    let r = Buffer.contents b in
+    Buffer.reset b;
+    r
+
+  (** Redirect the stdout *)
+  let stdout_out, stdout_in = Unix.pipe ~cloexec:true ()
+  let () = Unix.dup2 stdout_in Unix.stdout
+
+  let self_error_fmt = Format.formatter_of_out_channel stderr
+  let eprintf = Format.eprintf
+
+  let read_stdout =
+    let size = 50 in
+    let b = Bytes.create size in
+    let buffer = Buffer.create 100 in
+    let rec read_toplevel_stdout () =
+      match Unix.select[stdout_out][][] 0. with
+      | [a], _, _ ->
+          let n = Unix.read stdout_out b 0 size in
+          Buffer.add_subbytes buffer b 0 n;
+          if n = size then read_toplevel_stdout ()
+      | _  -> ()
+    in
+    fun () ->
+      let () = flush stdout; read_toplevel_stdout () in
+      let r = Buffer.contents buffer in
+      Buffer.reset buffer;
+      r
+
+  (** Store character intervals directly *)
+  let locs = ref []
+  let register_loc (loc : Location.t) =
+    let startchar = loc.loc_start.pos_cnum in
+    let endchar = loc.loc_end.pos_cnum in
+    if startchar >= 0 then
+      locs := (startchar, endchar) :: !locs
+
+  (** Record locations in the main error and suberrors without printing them *)
+  let printer_register_locs =
+    let base = Location.batch_mode_printer in
+    { Location.pp_main_loc = (fun _ _ _ loc -> register_loc loc);
+      pp_submsg_loc = (fun _ _ _ loc -> register_loc loc);
+
+      (* The following fields are kept identical to [base],
+         listed explicitly so that future field additions result in an error
+         -- using (Location.batch_mode_printer with ...) would be the symmetric
+         problem to a fragile pattern-matching. *)
+      pp = base.pp;
+      pp_report_kind = base.pp_report_kind;
+      pp_main_txt = base.pp_main_txt;
+      pp_submsgs = base.pp_submsgs;
+      pp_submsg = base.pp_submsg;
+      pp_submsg_txt = base.pp_submsg_txt;
+    }
+
+  (** Capture warnings and keep them in a list *)
+  let warnings = ref []
+  let report_printer =
+    (* Extend [printer_register_locs] *)
+    let pp self ppf report =
+      match report.Location.kind with
+      | Location.Report_warning _ | Location.Report_warning_as_error _ ->
+          printer_register_locs.pp self (snd warning_fmt) report;
+          let w = flush_fmt warning_fmt in
+          warnings := w :: !warnings
+      | _ ->
+          printer_register_locs.pp self ppf report
+    in
+    { printer_register_locs with pp }
+
+  let fatal ic oc fmt =
+    Format.kfprintf
+      (fun ppf -> Format.fprintf ppf "@]@."; close_in ic; close_out oc; exit 1)
+      self_error_fmt ("@[  Error " ^^ fmt)
+
+  let init () =
+    Location.report_printer := (fun () -> report_printer);
+    Clflags.color := Some Misc.Color.Never;
+    Clflags.no_std_include := true;
+    Compenv.last_include_dirs := [Filename.concat !repo_root "stdlib"];
+    Compmisc.init_path ();
+    try
+      Toploop.initialize_toplevel_env ();
+      Sys.interactive := false
+    with _ ->
+      (eprintf "Invalid repo root: %s?%!" !repo_root; exit 2)
+
+  let exec (_,ppf) p =
+    try
+      ignore @@ Toploop.execute_phrase true ppf p
+    with exn ->
+      let bt = Printexc.get_raw_backtrace () in
+      begin try Location.report_exception (snd error_fmt) exn
+      with _ ->
+        eprintf "Uncaught exception: %s\n%s\n"
+          (Printexc.to_string exn)
+          (Printexc.raw_backtrace_to_string bt)
+      end
+
+  let parse fname mode s =
+    let lex = Lexing.from_string s in
+    Location.init lex fname;
+    Location.input_name := fname;
+    Location.input_lexbuf := Some lex;
+    try
+      match mode with
+      | Toplevel -> Parse.toplevel_phrase lex
+      | Verbatim -> Ptop_def (Parse.implementation lex)
+      | Signature ->
+          let sign = Parse.interface lex in
+          let name = Location.mknoloc "wrap" in
+          let str =
+            Ast_helper.[Str.modtype @@ Mtd.mk ~typ:(Mty.signature sign) name] in
+          Ptop_def str
+    with
+    | Lexer.Error _ | Syntaxerr.Error _ ->
+        raise (Phrase_parsing s)
+
+  let take x = let r = !x in x := []; r
+
+  let read_output ()  =
+    let warnings = take warnings in
+    let error = flush_fmt error_fmt in
+    let values =
+      replace_first ~!{|^#\( *\*\)* *|} "" @@ flush_fmt out_fmt in
+    (* the inner ( *\* )* group is here to clean the starting "*"
+       introduced for multiline comments *)
+    let underlined = take locs in
+    let stdout = read_stdout () in
+    { values; warnings; error; stdout; underlined }
+
+  (** exec and ignore all output from the toplevel *)
+  let eval b =
+    let s = Buffer.contents b in
+    let ast = Parse.toplevel_phrase (Lexing.from_string s) in
+    exec out_fmt ast;
+    ignore (read_output());
+    Buffer.reset b
+
+end
+
+let () =
+  Arg.parse ["-n", Arg.Int (fun n -> linelen := n), "line length";
+             "-o", Arg.String (fun s -> outfile := s), "output";
+             "-repo-root", Arg.String ((:=) repo_root ), "repo root";
+             "-w", Arg.Set cut_at_blanks, "cut at blanks";
+             "-v", Arg.Bool (fun b -> verbose := b ), "output result on stderr"
+            ]
+    (fun s -> files := s :: !files)
+    "caml-tex: ";
+  Toplevel.init ()
+
+
+(** The Output module deals with the analysis and classification
+    of the interpreter output and the parsing of status-related options
+    or annotations for the caml_example environment *)
+module Output = struct
+
+  (** Interpreter output status *)
+  type status =
+    | Ok
+    | Warning of int
+    | Error
+
+  type kind =
+    | Annotation (** Local annotation: [ [@@expect (*annotation*) ] ]*)
+    | Option (** Global environment option:
+                 [\begin{caml_example}[option[=value]]
+                 ...
+                 \end{caml_example}] *)
+
+  (** Pretty printer for status *)
+  let pp_status ppf = function
+    | Error -> Format.fprintf ppf "error"
+    | Ok -> Format.fprintf ppf "ok"
+    | Warning n -> Format.fprintf ppf "warning %d" n
+
+  (** Pretty printer for status preceded with an undefined determinant *)
+  let pp_a_status ppf = function
+    | Error -> Format.fprintf ppf "an error"
+    | Ok -> Format.fprintf ppf "an ok"
+    | Warning n -> Format.fprintf ppf "a warning %d" n
+
+  (** {1 Related latex environment } *)
+  let env = function
+    | Error -> error
+    | Warning _ -> warning
+    | Ok -> ok_output
+
+  (** {1 Exceptions } *)
+  exception Parsing_error of kind * string
+
+  type source =
+    {
+      file : string;
+      lines : int * int;
+      phrase : string;
+      output : string
+    }
+  type unexpected_report = {source : source; expected : status; got : status}
+  exception Unexpected_status of unexpected_report
+
+  let print_source ppf {file; lines = (start, stop); phrase; output} =
+    Format.fprintf ppf "%s, lines %d to %d:\n\"\n%s\n\"\n\"\n%s\n\"."
+      file start stop phrase output
+
+  let print_unexpected {source; expected; got} =
+    if expected = Ok then
+      Toplevel.eprintf
+        "Error when evaluating a caml_example environment in %a\n\
+         Unexpected %a status.\n\
+         If %a status was expected, add an [@@expect %a] annotation.\n"
+        print_source source
+        pp_status got
+        pp_a_status got
+        pp_status got
+    else
+      Toplevel.eprintf
+        "Error when evaluating a guarded caml_example environment in %a\n\
+         Unexpected %a status, %a status was expected.\n\
+         If %a status was in fact expected, change the status annotation to \
+         [@@expect %a].\n"
+        print_source source
+        pp_status got
+        pp_a_status expected
+        pp_a_status got
+        pp_status got;
+    flush stderr
+
+  let print_parsing_error k s =
+    match k with
+    | Option ->
+        Toplevel.eprintf
+          "Unknown caml_example option: [%s].\n\
+           Supported options are \"ok\",\"error\", or \"warning=n\" (with n \
+           a warning number).\n" s
+    | Annotation ->
+        Toplevel.eprintf
+          "Unknown caml_example phrase annotation: [@@expect %s].\n\
+           Supported annotations are [@@expect ok], [@@expect error],\n\
+           and [@@expect warning n] (with n a warning number).\n" s
+
+  (** {1 Output analysis} *)
+  let catch_error = function
+    | "" -> None
+    | _ -> Some Error
+
+  let catch_warning =
+    function
+    | [] -> None
+    | s :: _ when string_match ~!{|Warning \([0-9]+\):|} s 0 ->
+        Some (Warning (int_of_string @@ matched_group 1 s))
+    | _ -> None
+
+  let status ws es =
+    match catch_warning ws, catch_error es with
+    | Some w, _ -> w
+    | None, Some e -> e
+    | None, None -> Ok
+
+  (** {1 Parsing caml_example options } *)
+
+  (** Parse [warning=n] options for caml_example options *)
+  let parse_warning s =
+    if string_match ~!{|warning=\([0-9]+\)|} s 0 then
+      Some (Warning (int_of_string @@ matched_group 1 s))
+    else
+      None
+
+  (** Parse [warning n] annotations *)
+  let parse_local_warning s =
+    if string_match ~!{|warning \([0-9]+\)|} s 0 then
+      Some (Warning (int_of_string @@ matched_group 1 s))
+    else
+      None
+
+  let parse_error s =
+    if s="error" then Some Error else None
+
+  let parse_ok s =
+    if s = "ok" then Some Ok else None
+
+  (** Parse the environment-wide expected status output *)
+  let expected s =
+    match parse_warning s, parse_error s with
+    | Some w, _ -> w
+    | None, Some e -> e
+    | None, None -> raise (Parsing_error (Option,s))
+
+  (** Parse the local (i.e. phrase-wide) expected status output *)
+  let local_expected s =
+    match parse_local_warning s, parse_error s, parse_ok s with
+    | Some w, _, _ -> w
+    | None, Some e, _ -> e
+    | None, None, Some ok -> ok
+    | None, None, None -> raise (Parsing_error (Annotation,s))
+
+end
+
+module Text_transform = struct
+
+  type kind =
+    | Underline
+    | Ellipsis
+
+  type t = { kind : kind; start : int; stop : int}
+  exception Intersection of
+      {
+        line : int;
+        file : string;
+        left : t;
+        right : t;
+      }
+
+  let pp ppf = function
+    | Underline -> Format.fprintf ppf "underline"
+    | Ellipsis -> Format.fprintf ppf "ellipsis"
+
+  let underline start stop = { kind = Underline; start; stop}
+  let ellipsis start stop = { kind = Ellipsis; start; stop }
+
+  let escape_specials s =
+    s
+    |> global_replace ~!{|\$|} {|$\textdollar$|}
+
+  let rec apply_transform input (pos,underline_stop,out) t =
+    if pos >= String.length input then pos, underline_stop, out
+    else match underline_stop with
+      | Some stop when stop <= t.start ->
+          let f = escape_specials (String.sub input ~pos ~len:(stop - pos)) in
+          let out =  camleunderline :: f :: out in
+          apply_transform input (stop,None,out) t
+      | _ ->
+          let out =
+            escape_specials (String.sub input ~pos ~len:(t.start - pos))::out in
+          match t.kind with
+          | Ellipsis -> t.stop, underline_stop, latex_escape {|\ldots|} :: out
+          | Underline ->
+              t.start, Some t.stop, camlbunderline :: out
+
+  (** Check that all ellipsis are strictly nested inside underline transform
+      and that otherwise no transform starts before the end of the previous
+      transform in a list of transforms *)
+  type partition = U of t * t list | E of t
+  let check_partition line file l =
+    let init = ellipsis 0 0 in
+    let rec partition = function
+      | [] -> []
+      | {kind=Underline; _ } as t :: q -> underline t [] q
+      | {kind=Ellipsis; _ } as t :: q -> E t :: partition q
+    and underline u n = function
+      | [] -> end_underline u n []
+      | {kind=Underline; _ } :: _ as q -> end_underline u n q
+      | {kind=Ellipsis; _ } as t :: q ->
+          if t.stop < u.stop then underline u (t::n) q
+          else end_underline u n (t::q)
+    and end_underline u n l = U(u,List.rev n) :: partition l in
+    let check_elt last t =
+      if t.start < last.stop then
+        raise (Intersection {line;file; left = last; right = t})
+      else
+        t in
+    let check acc = function
+      | E t -> check_elt acc t
+      | U(u,n) ->
+          let _ = check_elt acc u in
+          let _ = List.fold_left ~f:check_elt ~init n in
+          u in
+    List.fold_left ~f:check ~init (partition l)
+    |> ignore
+
+  let apply ts file line s =
+    (* remove duplicated transforms that can appear due to
+        duplicated parse tree elements. For instance,
+        [let f : (_ [@ellipsis] = ()] is transformed to
+        [let f: (_ [@ellipsis]) = (():(_ [@ellipsis])] with the same location
+        for the two ellipses. *)
+    let ts = List.sort_uniq compare ts in
+    let ts = List.sort (fun x y -> compare x.start y.start) ts in
+    check_partition line file ts;
+    let last, underline, ls =
+      List.fold_left ~f:(apply_transform s) ~init:(0,None,[]) ts in
+    let last, ls = match underline with
+      | None -> last, ls
+      | Some stop ->
+          let f = escape_specials (String.sub s ~pos:last ~len:(stop - last)) in
+          stop, camleunderline :: f :: ls in
+    let ls =
+      let n = String.length s in
+      if last = n then ls else
+        escape_specials (String.sub s last (n-last)) :: ls in
+    String.concat "" (List.rev ls)
+end
+
+
+exception Missing_double_semicolon of string * int
+
+exception Missing_mode of string * int
+
+type incompatibility =
+  | Signature_with_visible_answer of string * int
+exception Incompatible_options of incompatibility
+
+
+module Ellipsis = struct
+  (** This module implements the extraction of ellipsis locations
+      from phrases.
+
+      An ellipsis is either an [[@ellipsis]] attribute, or a pair
+      of [[@@@ellipsis.start]...[@@@ellipsis.stop]] attributes. *)
+
+  exception Unmatched_ellipsis of {kind : string; start : int; stop : int}
+  (** raised when an [[@@@ellipsis.start]] or [[@@@ellipsis.stop]] is
+      not paired with another ellipsis attribute *)
+
+  exception Nested_ellipses of {first : int ; second : int}
+  (** raised by [[@@@ellipsis.start][@@@ellipsis.start]] *)
+
+  let extract f x =
+    let transforms = ref [] in
+    let last_loc = ref Location.none in
+    let left_mark = ref None (* stored position of [@@@ellipsis.start]*) in
+    let location _this loc =
+      (* we rely on the fact that the default iterator calls first
+         the location subiterator, then the attribute subiterator *)
+      last_loc := loc in
+    let attribute _this attr =
+      let module L = Location in
+      let module P = Parsetree in
+      let name = attr.P.attr_name.L.txt in
+      let loc = !last_loc in
+      let start = loc.L.loc_start.Lexing.pos_cnum in
+      let attr_start = attr.P.attr_loc.L.loc_start.Lexing.pos_cnum in
+      let attr_stop = attr.P.attr_loc.L.loc_end.Lexing.pos_cnum in
+      let stop = max loc.L.loc_end.Lexing.pos_cnum attr_stop  in
+      let check_nested () = match !left_mark with
+        | Some (first,_) -> raise (Nested_ellipses {first; second=attr_start})
+        | None -> () in
+      match name with
+      | "ellipsis" ->
+          check_nested ();
+          transforms :=
+            {Text_transform.kind=Ellipsis; start; stop }
+            :: !transforms
+      | "ellipsis.start" ->
+          check_nested ();
+          left_mark := Some (start, stop)
+      | "ellipsis.stop" ->
+          begin match !left_mark with
+          | None -> raise (Unmatched_ellipsis {kind="right"; start; stop})
+          | Some (start', stop' ) ->
+              let start, stop = min start start', max stop stop' in
+              transforms := {kind=Ellipsis; start ; stop } :: !transforms;
+              left_mark := None
+          end
+      | _ -> ()
+    in
+    f {Ast_iterator.default_iterator with location; attribute} x;
+    (match !left_mark with
+     | None -> ()
+     | Some (start,stop) ->
+         raise (Unmatched_ellipsis {kind="left"; start; stop })
+    );
+    !transforms
+
+  let find = function
+    | Parsetree.Ptop_def ast -> extract (fun it -> it.structure it) ast
+    | Ptop_dir _ -> []
+
+end
+
+let process_file file =
+  let ic = try open_in file with _ -> failwith "Cannot read input file" in
+  let phrase_start = ref 1 and phrase_stop = ref 1 in
+  let incr_phrase_start () =
+    incr phrase_start;
+    phrase_stop := !phrase_start in
+  let oc =
+    try if !outfile = "-" then
+      stdout
+    else if !outfile = "" then
+      open_out (replace_first ~!"\\.tex$" "" file ^ ".ml.tex")
+    else
+      open_out_gen [Open_wronly; Open_creat; Open_append; Open_text]
+        0x666 !outfile
+    with _ -> failwith "Cannot open output file" in
+  let tex_fmt = Format.formatter_of_out_channel oc in
+  let fatal x = Toplevel.fatal ic oc x in
+  let re_spaces = "[ \t]*" in
+  let re_start = ~!(
+      {|\\begin{caml_example\(\*?\)}|} ^ re_spaces
+      ^ {|\({toplevel}\|{verbatim}\|{signature}\)?|} ^ re_spaces
+      ^ {|\(\[\(.*\)\]\)?|} ^ re_spaces
+      ^ "$"
+    ) in
+  try while true do
+    let input = ref (input_line ic) in
+    incr_phrase_start();
+    if string_match re_start !input 0
+    then begin
+      let omit_answer = matched_group 1 !input = "*" in
+      let mode =
+        match matched_group 2 !input with
+        | exception Not_found -> raise (Missing_mode(file, !phrase_stop))
+        | "{toplevel}" -> Toplevel
+        | "{verbatim}" -> Verbatim
+        | "{signature}" -> Signature
+        | _ -> assert false in
+      if mode = Signature && not omit_answer then raise
+          (Incompatible_options(
+              Signature_with_visible_answer(file,!phrase_stop))
+          );
+      let explicit_stop = match mode with
+        | Verbatim | Signature -> false
+        | Toplevel -> true in
+      let global_expected = try Output.expected @@ matched_group 4 !input
+        with Not_found -> Output.Ok in
+      start tex_fmt main [string_of_mode mode];
+      let first = ref true in
+      let read_phrase () =
+        let phrase = Buffer.create 256 in
+        let rec read () =
+          let input = incr phrase_stop; input_line ic in
+          let implicit_stop =
+            if string_match ~!"\\\\end{caml_example\\*?}[ \t]*$"
+                input 0
+            then
+              begin
+                if !phrase_stop = 1 + !phrase_start then
+                  raise End_of_file
+                else if explicit_stop then
+                  raise @@ Missing_double_semicolon (file,!phrase_stop)
+                else
+                  true
+              end
+            else false in
+          if Buffer.length phrase > 0 then Buffer.add_char phrase '\n';
+          let stop =
+            implicit_stop ||
+            ( not (mode = Signature)
+              && string_match ~!"\\(.*\\)[ \t]*;;[ \t]*$" input 0 )
+          in
+          if not stop then (
+            Buffer.add_string phrase input; read ()
+          )
+          else begin
+            decr phrase_stop;
+            let last_input =
+              if implicit_stop then "" else matched_group 1 input in
+            let expected =
+              if string_match ~!{|\(.*\)\[@@expect \(.*\)\]|} last_input 0 then
+                ( Buffer.add_string phrase (matched_group 1 last_input);
+                  Output.local_expected @@ matched_group 2 last_input )
+              else
+                (Buffer.add_string phrase last_input; global_expected)
+            in
+            if not implicit_stop then Buffer.add_string phrase ";;";
+            implicit_stop, Buffer.contents phrase, expected
+          end in
+        read ()
+      in
+      try while true do
+        let implicit_stop, phrase, expected = read_phrase () in
+        let ast = Toplevel.parse file mode phrase in
+        let ellipses = Ellipsis.find ast in
+        let () = Toplevel.(exec out_fmt) ast in
+        let out = Toplevel.read_output () in
+        let error_msgs = String.concat "" (out.warnings @ [out.error]) in
+        let output = String.concat "" [error_msgs; out.stdout; out.values] in
+        let status = Output.status out.warnings out.error in
+        if status <> expected then (
+          let source = Output.{
+              file;
+              lines = (!phrase_start, !phrase_stop);
+              phrase;
+              output
+            } in
+          raise (Output.Unexpected_status
+                   {Output.got=status; expected; source} ) )
+        else ( incr phrase_stop; phrase_start := !phrase_stop );
+        let phrase =
+          let underline =
+            List.map (fun (x,y) -> Text_transform.underline x y)
+              out.underlined in
+          Text_transform.apply (underline @ ellipses)
+            file !phrase_stop phrase in
+        (* Special characters may also appear in output strings -Didier *)
+        let output = Text_transform.escape_specials output in
+        let phrase = global_replace ~!{|^\(.\)|} camlin phrase
+        and output = global_replace ~!{|^\(.\)|} camlout output in
+        let final_output =
+          if omit_answer && String.length error_msgs > 0 then
+            global_replace ~!{|^\(.\)|} camlout error_msgs
+          else if omit_answer then ""
+          else output in
+        start tex_fmt phrase_env [];
+        code_env input_env tex_fmt phrase;
+        if String.length final_output > 0 then
+          code_env (Output.env status) tex_fmt final_output;
+        stop tex_fmt phrase_env;
+        flush oc;
+        first := false;
+        if implicit_stop then raise End_of_file
+      done
+      with End_of_file -> phrase_start:= !phrase_stop; stop tex_fmt main
+    end
+    else if string_match ~!"\\\\begin{caml_eval}[ \t]*$" !input 0
+    then begin
+      let eval_buffer = Buffer.create 256 in
+      while input := input_line ic;
+        not (string_match ~!"\\\\end{caml_eval}[ \t]*$" !input 0)
+      do
+        Buffer.add_string eval_buffer !input;
+        Buffer.add_char eval_buffer '\n';
+        if string_match ~!".*;;[ \t]*$" !input 0 then begin
+          Toplevel.eval eval_buffer
+        end
+      done;
+      if Buffer.length eval_buffer > 0 then
+        ( Buffer.add_string eval_buffer ";;\n"; Toplevel.eval eval_buffer )
+    end else begin
+      Format.fprintf tex_fmt "%s\n" !input;
+      Format.pp_print_flush tex_fmt ()
+    end
+  done with
+  | End_of_file -> close_in ic; close_out oc
+  | Output.Unexpected_status r ->
+          ( Output.print_unexpected r; close_in ic; close_out oc; exit 1 )
+  | Output.Parsing_error (k,s) ->
+      ( Output.print_parsing_error k s;
+        close_in ic; close_out oc; exit 1 )
+  | Phrase_parsing s -> fatal "when parsing the following phrase:@ %s" s
+  | Missing_double_semicolon (file, line_number) ->
+      fatal
+        "when evaluating a caml_example environment in %s:@;\
+         missing \";;\" at line %d" file (line_number-2)
+  | Missing_mode (file, line_number) ->
+      fatal "when parsing a caml_example environment in %s:@;\
+             missing mode argument at line %d,@ \
+             available modes {toplevel,verbatim}"
+          file (line_number-2)
+  | Incompatible_options Signature_with_visible_answer (file, line_number) ->
+      fatal
+          "when parsing a caml_example environment in@ \
+           %s, line %d:@,\
+           the signature mode is only compatible with \"caml_example*\"@ \
+           Hint: did you forget to add \"*\"?"
+          file (line_number-2);
+  | Text_transform.Intersection {line;file;left;right} ->
+      fatal
+        "when evaluating a caml_example environment in %s, line %d:@ \
+         Textual transforms must be well-separated.@ The \"%a\" transform \
+         spanned the interval %d-%d,@ \
+         intersecting with another \"%a\" transform @ \
+         on the %d-%d interval.@ \
+         Hind: did you try to elide a code fragment which raised a warning?"
+        file (line-2)
+        Text_transform.pp left.kind left.start left.stop
+        Text_transform.pp right.kind right.start right.stop
+  | Ellipsis.Unmatched_ellipsis {kind;start;stop} ->
+      fatal "when evaluating a caml_example environment,@ \
+             the %s mark at position %d-%d was unmatched"
+        kind start stop
+  | Ellipsis.Nested_ellipses {first;second} ->
+      fatal "when evaluating a caml_example environment,@ \
+             there were two nested ellipsis attribute.@ The first one \
+             started at position %d,@ the second one at %d"
+        first second
+
+let _ =
+  if !outfile <> "-" && !outfile <> "" then begin
+    try close_out (open_out !outfile)
+    with _ -> failwith "Cannot open output file"
+  end;
+  List.iter process_file (List.rev !files);
diff --git a/tools/check-parser-uptodate-or-warn.sh b/tools/check-parser-uptodate-or-warn.sh
new file mode 100755
index 00000000..32c8e745
--- /dev/null
+++ b/tools/check-parser-uptodate-or-warn.sh
@@ -0,0 +1,69 @@
+#!/bin/sh
+
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Gabriel Scherer, projet Parsifal, INRIA Saclay              *
+#*                                                                        *
+#*   Copyright 2018 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.          *
+#*                                                                        *
+#**************************************************************************
+
+# stop early if we are not on a development version
+grep -Fq '+dev' VERSION || exit 0
+
+# We try to warn if the user edits parsing/parser.mly but forgets to
+# rebuild the generated parser. Our heuristic is to use the file
+# modification timestamp, but just testing
+#   (parsing/parser.mly -nt boot/menhir/parser.ml)
+# is not robust to clone/checkout refreshing the files in an arbitrary
+# order, so we check whether parser.mly was modified at least 10
+# seconds after boot/menhir/parser.ml.
+
+# mtime(): access a file's last modification time as a timestamp,
+# using either
+#  GNU coreutils' stat --format, or
+#  busybox's stat -c, or
+#  BSD/macOS stat -f.
+# Default to 0 if 'stat' is not available.
+
+stat . 2>/dev/null 1>/dev/null
+if test $? != 0
+then MTIME=""
+elif stat --version 2>/dev/null | grep -Fq 'coreutils'
+then MTIME="stat --format %Y"
+elif stat 2>&1 | grep -Fq 'busybox'
+then MTIME="stat -c %Y"
+else MTIME="stat -f %m" # BSD stat?
+fi
+
+mtime() {
+  if test -z "$MTIME"
+  then echo 0
+  else $MTIME "$1"
+  fi
+}
+
+# The check itself
+SOURCE_MTIME=$(mtime parsing/parser.mly)
+GENERATED_MTIME=$(mtime boot/menhir/parser.ml)
+if test -z "$SOURCE_MTIME" -o -z "$GENERATED_MTIME"
+then
+  echo
+  tput setaf 3; tput bold; printf "Warning: "; tput sgr0
+  echo "Failed to check if boot/menhir/parser.ml is up-to-date."
+elif test "$SOURCE_MTIME" -gt $(( GENERATED_MTIME + 10 ))
+then
+  echo
+  tput setaf 3; tput bold; printf "Warning: "; tput sgr0
+  echo "Your 'parser.mly' file is more recent than the parser in 'boot/'."
+  echo "Its changes will be ignored unless you run:"
+  echo "    make promote-menhir"
+  echo
+fi
diff --git a/tools/check-symbol-names b/tools/check-symbol-names
new file mode 100755
index 00000000..048eb5d1
--- /dev/null
+++ b/tools/check-symbol-names
@@ -0,0 +1,43 @@
+#!/usr/bin/env bash
+
+#**************************************************************************
+#*                                                                        *
+#*                                 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.          *
+#*                                                                        *
+#**************************************************************************
+
+set -o pipefail
+
+[ -z "$*" ] && { echo "Usage: $0 libfoo.a" 1>&2; exit 2; }
+
+nm -A -P "$@" | LC_ALL=C awk '
+# ignore caml_foo, camlFoo_bar, _caml_foo, _camlFoo_bar
+$2 ~ /^(_?caml[_A-Z])/ { next }
+# ignore local and undefined symbols
+$3 ~ /^[a-zU]$/ { next }
+# ignore "main", which should be externally linked
+$2 ~ /^_?main$/ { next }
+$2 ~ /^_?wmain$/ { next }
+# Caml_state escapes the prefixing rule for now
+$2 ~ /^_?Caml_state$/ { next }
+# for x86 PIC mode
+$2 ~ /^__x86.get_pc_thunk./ { next }
+# for mingw32
+$2 ~ /^.debug_/ { next }
+# windows unicode support
+$2 ~ /^_win_multi_byte_to_wide_char$/ { next }
+$2 ~ /^_win_wide_char_to_multi_byte$/ { next }
+# print the rest
+{ found=1; print $1 " " $2 " " $3 }
+# fail if there were any results
+END { exit found ? 1 : 0 }
+'
+exit $?
diff --git a/tools/check-typo b/tools/check-typo
new file mode 100755
index 00000000..6da3c3e6
--- /dev/null
+++ b/tools/check-typo
@@ -0,0 +1,457 @@
+#!/bin/sh
+
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*           Damien Doligez, projet Gallium, INRIA Rocquencourt           *
+#*                                                                        *
+#*   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.          *
+#*                                                                        *
+#**************************************************************************
+
+# check-typo - Check typographic conventions on OCaml sources.
+
+# This program will check files for the following rules:
+
+# - absence of TAB characters (tab)
+# - absence of non-ASCII characters (non-ascii)
+# - absence of non-printing ASCII characters (non-printing)
+# - absence of white space at end of line (white-at-eol)
+# - absence of empty lines at end of file (white-at-eof)
+# - presence of a LF character at the end of the file (missing-lf)
+# - maximum line length of 80 characters (long-line)
+# - maximum line length of 132 characters (very-long-line)
+# - presence of a copyright header (missing-header)
+# - absence of a leftover "$Id" string (svn-keyword)
+
+# Exceptions are handled with git attributes: "typo.*".
+# Its value for a given file is a comma-separated list of rule names,
+# which lists the rules that should be disabled for this file.
+# The rule names are the ones shown above in parentheses.
+
+# Built-in exception:
+# - Any file git identifies as binary
+#   is automatically exempt from all the rules.
+
+# ASCII characters are bytes from 0 to 127.  Any other byte is
+# flagged as a non-ASCII character.
+
+# For the purpose of this tool, printing ASCII characters are:
+# - the non-white printable ASCII characters (33 to 126)
+# - TAB (09)
+# - LF (10)
+# - SPC (32)
+# Anything else is flagged as a non-printing ASCII character.
+
+# This program will recursively explore the files and directories given
+# on the command line (or by default the current directory), and check
+# every file therein for compliance to the rules.
+
+# Directories named .git (and their contents) are always ignored.
+# This program ignores any file that is not under git control, unless
+# explicitly given on the command line.
+
+# If a directory has the git attribute "typo.prune" then it and its contents are
+# ignored.
+
+# You can ignore a rule by giving the option - on the command
+# line (before any file names).
+
+# Files which include the utf8 rule will be validated using grep and line-length
+# computations will take UTF-8 sequences into account. As a special case, UTF-8
+# sequences are always allowed in the copyright headers.
+
+# First prevent i18n from messing up everything.
+export LC_ALL=C
+
+OCAML_CT_CAT=${OCAML_CT_CAT:-cat}
+OCAML_CT_LS_FILES=${OCAML_CT_LS_FILES:-git ls-files}
+OCAML_CT_HEAD=${OCAML_CT_HEAD:-HEAD}
+OCAML_CT_AWK=${OCAML_CT_AWK:-awk}
+if [ -z "${OCAML_CT_GIT_INDEX+x}" ] ; then
+  OCAML_CT_GIT_INDEX=
+else
+  OCAML_CT_GIT_INDEX="GIT_INDEX_FILE=$OCAML_CT_GIT_INDEX"
+fi
+
+# The output of processing the attributes should be whitespace-separated with
+# - the "typo." prefix dropped
+# - unset/false keys not present
+# - set/true keys present
+# - "may" keys present, suffixed by a question mark
+#
+# for example,
+#   typo.long-line: set
+#   typo.missing-header: may
+#   typo.very-long-line: false
+# should result in "long-line missing-header?"
+get_attrs() {
+  env $OCAML_CT_GIT_INDEX git check-attr --all $OCAML_CT_CA_FLAG "$1" \
+  | grep -o " typo\\..*$" | sed "s/ typo\\.//g" \
+  | grep -v ": unset" | grep -v ": false" \
+  | sed "s/: set//g" | sed "s/: true//g" | sed "s/: may/?/g"
+}
+
+# empty if the path is *not* pruned
+check_prune() {
+  env $OCAML_CT_GIT_INDEX git check-attr typo.prune $OCAML_CT_CA_FLAG "$1" \
+  | grep -v ': unspecified$' | grep -v ': false$'
+}
+
+# Special case for recursive call from the find command (see IGNORE_DIRS).
+case "$1" in
+  --check-prune)
+    case $2 in
+      .git|.git/*)
+          echo "INFO: pruned path $2 (.git)" >&2
+          exit 0;;
+    esac
+    if test -n "$(check_prune "$2")"; then
+        echo "INFO: pruned path $2 (typo.prune)" >&2
+        exit 0
+    fi
+    exit 3;;
+esac
+
+case "$1" in
+  --get-attrs)
+      get_attrs "$2"
+      exit 0;;
+esac
+
+usage () {
+  echo "usage: check-typo {-} [--] {}" >&2
+  exit 2
+}
+
+check_script () {
+  if [ "$($OCAML_CT_CAT "$OCAML_CT_PREFIX$1" \
+            | sed -ne '1s/^#!.*/#!/p')" != '#!' ] ; then
+    # These files are listed manually, rather than via gitattributes,
+    # because the list should never expand, and it should not be trivial to
+    # expand (the unix-execvpe test is an ultra-special-case!)
+    f=${1#./}
+    if [ "$f" != "boot/ocamlc" ] && [ "$f" != "boot/ocamllex" ] && \
+       [ "$f" != "testsuite/tests/lib-unix/unix-execvpe/subdir/script2" ] ; then
+      echo "$1 shouldn't be executable; either:"
+      echo " - Add a #! line"
+      echo " - Run chmod -x $1 (on Unix)"
+      echo " - Run git update-index --chmod=-x $1 (on Windows)"
+      echo "You may wish to check your core.fileMode setting"
+      EXIT_CODE=1
+    fi
+  fi
+}
+
+userrules=''
+
+while : ; do
+  case "$1" in
+    -help|--help) usage;;
+    -*) userrules="${1#-} $userrules"; shift;;
+    --) shift; break;;
+    *) break;;
+  esac
+done
+
+IGNORE_DIRS="
+  -name .git -prune -o
+  -type d -exec $0 --check-prune {} ; -prune -o
+"
+# `-type d`: simple files (not directories) are not pruned during the
+# "find" invocation but below (look for "check_prune") for performance
+# reasons: most files outside pruned directories are not pruned, so it
+# is faster to optimistically run check-typo on them (and maybe get
+# out in the middle) than to first check then run.
+
+TEST_AWK='BEGIN {if ("a{1}" ~ /a{1}/) exit 0}'
+if $OCAML_CT_AWK "$TEST_AWK" ; then
+  TEST_AWK='BEGIN {if ("a" ~ /a{1}/) exit 0}'
+  if $OCAML_CT_AWK --re-interval "$TEST_AWK" 2>/dev/null ; then
+    OCAML_CT_AWK="$OCAML_CT_AWK --re-interval"
+  else
+    echo "This script requires interval support in regexes ({m} notation)">&2
+    echo "Please install a version of awk (e.g. gawk) which supports this">&2
+    exit 2
+  fi
+fi
+
+EXIT_CODE=0
+( case $# in
+    0) find . $IGNORE_DIRS -type f -print;;
+    *) for i in "$@"; do find "$i" $IGNORE_DIRS -type f -print; done;;
+  esac
+) | (
+  while read f; do
+    if test -n "$(check_prune "$f")"; then continue; fi
+    if $(git check-ignore -q "$f"); then continue; fi
+    case `$OCAML_CT_LS_FILES "$f" 2>&1` in
+      "") path_in_index=false;;
+      *) path_in_index=true;;
+    esac
+    case "$*" in
+      *$f*) is_cmd_line=true;;
+      *) is_cmd_line=false;;
+    esac
+    if [ -z "$OCAML_CT_PREFIX" ] ; then
+      if [ -x "$f" ] ; then
+        check_script "$f"
+      fi
+    else
+      if git ls-files -s "$f" | grep -q "^100755" ; then
+        check_script "$f"
+      fi
+    fi
+    if $path_in_index || $is_cmd_line; then :; else continue; fi
+    attr_rules=''
+    if $path_in_index; then
+      # Below is a git plumbing command to detect whether git regards a
+      # particular file as binary. This takes into account .gitattributes, but
+      # also works if the file has been automatically detected as binary by git.
+      # EMPTY is the hash of the empty tree (which is specially known to git -
+      # it is automatically included in every repository) as a way to get
+      # `diff-tree` to print the whole tree state; its `--numstat` output then
+      # prints a summary where two dashes in the first two columns indicates a
+      # binary file.
+      #   (See https://git-scm.com/docs/git-diff-tree#_other_diff_formats and
+      #    the documentation for the --numstat option. Commands designated as
+      #    "plumbing" commands in git have stable output intended for parsing)
+      EMPTY=`git hash-object -t tree /dev/null`
+      git diff-tree --numstat $EMPTY $OCAML_CT_HEAD -- "$f" \
+        | grep -q "^-[[:blank:]]-" && continue
+      attr_rules=$(get_attrs "$f")
+    fi
+    rules="$userrules"
+
+    # remove newlines, ensure spaces at boundary
+    rules=" $(echo $rules) "
+    attr_rules=" $(echo $attr_rules) "
+
+    if test -n "$(echo "$rules $attr_rules" | grep " utf8 ")"
+    then
+        # grep -a is used to force the file to be considered as text and -x
+        # requires the entire line to match. This specifically detects the
+        # presence of lines containing malformed UTF-8. It may be tested using
+        # https://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt
+        if $OCAML_CT_CAT "$OCAML_CT_PREFIX$f" \
+             | LC_ALL=en_US.UTF8 grep -qaxv '.*' ; then
+          echo "File \"$f\" is not correctly encoded in UTF-8"
+          exit 2
+        fi
+    fi
+    if ! \
+    ($OCAML_CT_CAT "$OCAML_CT_PREFIX$f" | tr -d '\r'; echo) \
+    | $OCAML_CT_AWK -v rules="$rules" -v attr_rules="$attr_rules" -v file="$f" \
+      '
+        function is_err(name) {
+          return ((rules attr_rules) !~ (" " name "[\\? ]"));
+        }
+
+        function report_err(name, msg) {
+          printf ("%s:%d.%d:", file, NR, RSTART + RLENGTH);
+          printf (" [%s] %s\n", name, msg);
+          got_errors = 1;
+        }
+
+        function err(name, msg) {
+          ++ counts[name];
+          if (is_err(name) && counts[name] <= 10) {
+            report_err(name, msg);
+            if (counts[name] == 10){
+              printf ("WARNING: too many [%s] in this file.", name);
+              printf ("  Others will not be reported.\n");
+            }
+          }
+        }
+
+        function err_if(guard, name, msg) {
+          if (is_err(guard)) {
+            err(name, msg);
+          } else {
+            ++ counts[name];
+          }
+        }
+
+        function more_columns(str, limit,       c){
+          c = 0;
+          for (i = 1; i <= length(str); i++){
+            if (substr(str, i, 1) == "\t"){
+              c = int((c + 8) / 8) * 8;
+            }else{
+              ++ c;
+            }
+          }
+          return c > limit;
+        }
+
+        function utf8_decode(str) {
+          if (is_err("utf8")) {
+            return str;
+          } else {
+            # This script assumes that the UTF-8 has been externally validated
+            t = str;
+            gsub(/[\300-\367][\200-\277]+/, "?", t);
+            if (t != str) {
+              ++ counts["utf8"];
+            }
+            return t;
+          }
+        }
+
+        BEGIN { state = "(first line)"; }
+
+        match($0, /\t/) {
+          err("tab", "TAB character(s)");
+          t = utf8_decode($0);
+          if (more_columns(t, 80)){
+            RSTART=81;
+            RLENGTH = 0;
+            err_if("very-long-line", "long-line", "line is over 80 columns");
+          }
+          if (more_columns(t, 132)){
+            RSTART=133;
+            RLENGTH = 0;
+            err("very-long-line", "line is over 132 columns");
+          }
+        }
+
+        match($0, /[\200-\377]/) \
+        && state != "authors" && state != "copyright" {
+          if (is_err("utf8")) {
+            err("non-ascii", "non-ASCII character(s)");
+            if (header_utf8 && !is_err("non-ascii")) {
+              err("non-ascii-utf8", \
+                  "non-ASCII character(s) AND UTF-8 encountered");
+            }
+          } else {
+            ++ counts["utf8"];
+          }
+        }
+
+        match($0, /[^\t\200-\377 -~]/) {
+          err("non-printing", "non-printing ASCII character(s)");
+        }
+
+        match($0, /[ \t]+$/) {
+          err("white-at-eol", "whitespace at end of line");
+        }
+
+        match($0, /\$Id(: .*)?\$/) {
+          err("svn-keyword", "SVN keyword marker");
+        }
+
+        $0 !~ /\t/ && length($0) > 80 {
+          t = utf8_decode($0);
+          sub(/https?:[A-Za-z0-9._~:\/?#\[\]@!$&\047()*+,;=%-]{73,}$/, "", t);
+          if (length(t) > 80) {
+            RSTART = 81;
+            RLENGTH = 0;
+            err_if("very-long-line", "long-line", "line is over 80 columns");
+          }
+        }
+
+        $0 !~ /\t/ && length($0) > 132 {
+          RSTART = 133;
+          RLENGTH = 0;
+          t = utf8_decode($0);
+          if (length(t) > 132) {
+            err("very-long-line", "line is over 132 columns");
+          }
+        }
+
+        # Record that the header contained UTF-8 sequences
+        match($0, /[\300-\367][\200-\277]+/) \
+        && (state == "authors" || state == "copyright") {
+          header_utf8 = 1;
+          if (counts["non-ascii"] > 0 && is_err("non-ascii")) {
+            err("non-ascii-utf8", \
+                "non-ASCII character(s) AND UTF-8 encountered");
+          }
+        }
+
+        # Header-recognition automaton. Read this from bottom to top.
+        # Valid UTF-8 chars are recognised in copyright and authors
+        # TODO: ensure all files are valid UTF-8 before awking them.
+        # Note that this code also assumes that combining characters are NOT
+        # used (i.e. that every Unicode code-point corresponds to exactly
+        # one displayed character, i.e. no Camels and no including
+        # weird-and-wonderful ways of encoded accented letters).
+
+        state == "close" && $0 ~ /\*{74}/ { state = "OK"; }
+        state == "close" { state = "(last line)"; }
+        state == "blurb" && $0 ~ /\* {72}\*/ { state = "close"; }
+        state == "blurb" && $0 ~ /\/LICENSE/ { state = "(license path)" }
+        state == "blurb1" && $0 ~ /\*   All rights reserved. .{47} \*/ \
+                                                 { state = "blurb"; }
+        state == "blurb1" { state = "(blurb line 1)"; }
+        state == "copyright" && $0 ~ /\* {72}\*/ { state = "blurb1"; }
+        state == "copyright" \
+          && $0 !~ /\*   Copyright [0-9]{4}([\300-\367][\200-\277]+|.){54} \*/ \
+          && $0 !~ /\*     ([\300-\367][\200-\277]+|.){66} \*/ \
+                      { state = "(copyright lines)"; }
+        state == "authors" && $0 ~ /\* {72}\*/ { state = "copyright"; }
+        state == "authors" \
+          && $0 !~ /\* ([\300-\367][\200-\277]+|.){70} \*/ \
+                      { state = "(authors)"; }
+        state == "blank2" && $0 ~ /\* {72}\*/ { state = "authors"; }
+        state == "blank2" { state = "(blank line 2)"; }
+        state == "title" && $0 ~ /\* {33}OCaml {34}\*/ { state = "blank2"; }
+        state == "title" { state = "(title line)"; }
+        state == "blank1" && $0 ~ /\* {72}\*/ { state = "title"; }
+        state == "blank1" { state = "(blank line 1)"; }
+        state == "(first line)" && NR < 4 && $0 ~ /\*{74}/ { state = "blank1"; }
+
+        {
+          prev_line = last_line;
+          last_line = $0;
+        }
+
+        END {
+          if (match(last_line, /.+/)){
+            err("missing-lf", "missing linefeed at EOF");
+            prev_line = last_line;
+            ++ NR;
+            empty_file = 0;
+          }else{
+            empty_file = NR == 1;
+          }
+          if (!empty_file && match(prev_line, /^$/)){
+            err("white-at-eof", "empty line(s) at EOF");
+          }
+          if (state != "OK"){
+            if (NR >= 10){
+              NR = 1;
+              RSTART = 1;
+              RLENGTH = 0;
+              err("missing-header", sprintf("bad copyright header %s", state));
+            }else{
+              counts["missing-header"] = 1;
+            }
+          }
+          split(attr_rules, r, "[? ]");
+          for (i in r){
+            name = r[i];
+            if (name != "" && !counts[name]){
+              NR = 1;
+              RSTART = 1;
+              RLENGTH = 0;
+              if (attr_rules !~ (" " name "\\? ")) {
+                report_err(name,
+                  sprintf("attribute is unused", name));
+              }
+            }
+          }
+          exit got_errors;
+        }
+      ' ; then
+        EXIT_CODE=1
+      fi
+  done
+  exit $EXIT_CODE
+)
diff --git a/tools/check-typo-since b/tools/check-typo-since
new file mode 100755
index 00000000..77a9fa29
--- /dev/null
+++ b/tools/check-typo-since
@@ -0,0 +1,37 @@
+#!/bin/sh
+
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Gabriel Scherer, projet Parsifal, INRIA Saclay              *
+#*                                                                        *
+#*   Copyright 2018 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.          *
+#*                                                                        *
+#**************************************************************************
+
+# Run check-typo, comparing only files that have changed since a particular
+# git state
+
+check_typo_since() {
+  CHECK_TYPO=$(dirname $0)/check-typo
+  git diff --name-only $1 \
+  | (while IFS= read -r path
+  do
+    if test -e "$path"; then :; else continue; fi
+    $CHECK_TYPO --check-prune "$path" 2>/dev/null
+    if test $? -eq 0; then continue; fi
+    $CHECK_TYPO "$path"
+  done)
+}
+
+case $# in
+    0) echo "usage: check-typo-since "; exit 2;;
+    1) check_typo_since $1; break;;
+    *) echo "too many arguments"; exit 2;;
+esac
diff --git a/tools/checkstack.c b/tools/checkstack.c
new file mode 100644
index 00000000..c6c213f0
--- /dev/null
+++ b/tools/checkstack.c
@@ -0,0 +1,43 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*           Damien Doligez, projet Moscova, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 2002 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include 
+#include 
+#include 
+#include 
+#include 
+
+#define MINSTACKBYTES (384 * 1024 * sizeof (long))
+
+int main(int argc, char ** argv)
+{
+  struct rlimit limit;
+  int rc;
+
+  rc = getrlimit (RLIMIT_STACK, &limit);
+  if (rc != 0) exit (0);
+  if (limit.rlim_cur < MINSTACKBYTES){
+    fprintf (stderr,
+             "\nThe current stack size limit is too low (%luk)\n"
+             "You must increase it with one of the following commands:\n"
+             "Under sh, bash, zsh:  ulimit -s %lu\n"
+             "Under csh, tcsh:      limit stacksize %lu\n\n",
+             (unsigned long) (limit.rlim_cur / 1024),
+             (unsigned long) (MINSTACKBYTES / 1024),
+             (unsigned long) (MINSTACKBYTES / 1024));
+    exit (3);
+  }
+  exit (0);
+}
diff --git a/tools/ci/appveyor/appveyor_build.cmd b/tools/ci/appveyor/appveyor_build.cmd
new file mode 100644
index 00000000..15d2d58f
--- /dev/null
+++ b/tools/ci/appveyor/appveyor_build.cmd
@@ -0,0 +1,136 @@
+@rem ***********************************************************************
+@rem *                                                                     *
+@rem *                                 OCaml                               *
+@rem *                                                                     *
+@rem *                 David Allsopp, OCaml Labs, Cambridge.               *
+@rem *                                                                     *
+@rem *   Copyright 2017 MetaStack Solutions Ltd.                           *
+@rem *                                                                     *
+@rem *   All rights reserved.  This file is distributed under the terms of *
+@rem *   the GNU Lesser General Public License version 2.1, with the       *
+@rem *   special exception on linking described in the file LICENSE.       *
+@rem *                                                                     *
+@rem ***********************************************************************
+
+@rem BE CAREFUL ALTERING THIS FILE TO ENSURE THAT ERRORS PROPAGATE
+@rem IF A COMMAND SHOULD FAIL IT PROBABLY NEEDS TO END WITH
+@rem   || exit /b 1
+@rem BASICALLY, DO THE TESTING IN BASH...
+
+@rem Do not call setlocal!
+@echo off
+
+if "%1" neq "install" goto %1
+setlocal enabledelayedexpansion
+echo AppVeyor Environment
+for %%K in (ACCOUNT_NAME ACS_DEPLOYMENT_UPGRADE_MODE API_URL
+            ARTIFACT_UPLOAD_TIMEOUT BUILD_FOLDER BUILD_ID BUILD_NUMBER
+            BUILD_VERSION BUILD_WORKER_IMAGE BUILD_WORKER_IMAGE
+            CACHE_ENTRY_UPLOAD_DOWNLOAD_TIMEOUT CACHE_SKIP_RESTORE
+            CACHE_SKIP_SAVE FILE_DOWNLOAD_TIMEOUT FORCED_BUILD
+            IGNORE_COMMIT_FILTERING_ON_TAG JOB_ID JOB_NAME JOB_NUMBER PROJECT_ID
+            PROJECT_NAME PROJECT_SLUG PULL_REQUEST_HEAD_COMMIT
+            PULL_REQUEST_HEAD_REPO_BRANCH PULL_REQUEST_HEAD_REPO_NAME
+            PULL_REQUEST_NUMBER PULL_REQUEST_TITLE RE_BUILD REPO_BRANCH
+            REPO_COMMIT_AUTHOR REPO_COMMIT_AUTHOR_EMAIL REPO_COMMIT
+            REPO_COMMIT_MESSAGE REPO_COMMIT_MESSAGE_EXTENDED
+            REPO_COMMIT_TIMESTAMP REPO_NAME REPO_PROVIDER REPO_SCM
+            REPOSITORY_SHALLOW_CLONE_TIMEOUT REPO_TAG_NAME REPO_TAG
+            RE_RUN_INCOMPLETE SAVE_CACHE_ON_ERROR SCHEDULED_BUILD
+            SKIP_FINALIZE_ON_EXIT APPVEYOR URL WAP_ARTIFACT_NAME
+            WAP_SKIP_ACLS) do echo APPVEYOR_%%K=!APPVEYOR_%%K!
+echo CI=%CI%
+echo CONFIGURATION=%CONFIGURATION%
+echo PLATFORM=%PLATFORM%
+endlocal
+
+goto install
+
+goto :EOF
+
+:CheckPackage
+"%CYG_ROOT%\bin\bash.exe" -lc "cygcheck -dc %1" | findstr %1 > nul
+if %ERRORLEVEL% equ 1 (
+  echo Cygwin package %1 will be installed
+  set CYGWIN_INSTALL_PACKAGES=%CYGWIN_INSTALL_PACKAGES%,%1
+)
+goto :EOF
+
+:UpgradeCygwin
+if "%CYGWIN_INSTALL_PACKAGES%" neq "" "%CYG_ROOT%\setup-x86_64.exe" --quiet-mode --no-shortcuts --no-startmenu --no-desktop --only-site --root "%CYG_ROOT%" --site "%CYG_MIRROR%" --local-package-dir "%CYG_CACHE%" --packages %CYGWIN_INSTALL_PACKAGES:~1% > nul
+for %%P in (%CYGWIN_COMMANDS%) do "%CYG_ROOT%\bin\%%P.exe" --version > nul || set CYGWIN_UPGRADE_REQUIRED=1
+"%CYG_ROOT%\bin\bash.exe" -lc "cygcheck -dc %CYGWIN_PACKAGES%"
+if %CYGWIN_UPGRADE_REQUIRED% equ 1 (
+  echo Cygwin package upgrade required - please go and drink coffee
+  "%CYG_ROOT%\setup-x86_64.exe" --quiet-mode --no-shortcuts --no-startmenu --no-desktop --only-site --root "%CYG_ROOT%" --site "%CYG_MIRROR%" --local-package-dir "%CYG_CACHE%" --upgrade-also > nul
+  "%CYG_ROOT%\bin\bash.exe" -lc "cygcheck -dc %CYGWIN_PACKAGES%"
+)
+goto :EOF
+
+:install
+chcp 65001 > nul
+rem This must be kept in sync with appveyor_build.sh
+set BUILD_PREFIX=🐫реализация
+git worktree add "..\%BUILD_PREFIX%-%PORT%" -b appveyor-build-%PORT%
+if "%PORT%" equ "msvc64" (
+  git worktree add "..\%BUILD_PREFIX%-msvc32" -b appveyor-build-%PORT%32
+)
+
+cd "..\%BUILD_PREFIX%-%PORT%"
+if "%PORT%" equ "mingw32" (
+  git submodule update --init flexdll
+)
+
+cd "%APPVEYOR_BUILD_FOLDER%"
+appveyor DownloadFile "https://github.com/alainfrisch/flexdll/archive/%FLEXDLL_VERSION%.tar.gz" -FileName "flexdll.tar.gz" || exit /b 1
+appveyor DownloadFile "https://github.com/alainfrisch/flexdll/releases/download/%FLEXDLL_VERSION%/flexdll-bin-%FLEXDLL_VERSION%.zip" -FileName "flexdll.zip" || exit /b 1
+rem flexdll.zip is processed here, rather than in appveyor_build.sh because the
+rem unzip command comes from MSYS2 (via Git for Windows) and it has to be
+rem invoked via cmd /c in a bash script which is weird(er).
+mkdir "%APPVEYOR_BUILD_FOLDER%\..\flexdll"
+move flexdll.zip "%APPVEYOR_BUILD_FOLDER%\..\flexdll"
+cd "%APPVEYOR_BUILD_FOLDER%\..\flexdll" && unzip -q flexdll.zip
+
+rem CYGWIN_PACKAGES is the list of required Cygwin packages (cygwin is included
+rem in the list just so that the Cygwin version is always displayed on the log).
+rem CYGWIN_COMMANDS is a corresponding command to run with --version to test
+rem whether the package works. This is used to verify whether the installation
+rem needs upgrading.
+set CYGWIN_PACKAGES=cygwin make diffutils
+set CYGWIN_COMMANDS=cygcheck make diff
+if "%PORT%" equ "mingw32" (
+  set CYGWIN_PACKAGES=%CYGWIN_PACKAGES% mingw64-i686-gcc-core
+  set CYGWIN_COMMANDS=%CYGWIN_COMMANDS% i686-w64-mingw32-gcc
+)
+
+set CYGWIN_INSTALL_PACKAGES=
+set CYGWIN_UPGRADE_REQUIRED=0
+
+for %%P in (%CYGWIN_PACKAGES%) do call :CheckPackage %%P
+call :UpgradeCygwin
+
+"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh install" || exit /b 1
+
+goto :EOF
+
+:build
+if "%PORT%" equ "msvc64" (
+  setlocal
+  call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\bin\amd64\vcvars64.bat"
+)
+rem Do the main build (either msvc64 or mingw32)
+"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh" || exit /b 1
+
+if "%PORT%" neq "msvc64" goto :EOF
+
+rem Reconfigure the environment and run the msvc32 partial build
+endlocal
+call "C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin\SetEnv.cmd" /x86
+"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh msvc32-only" || exit /b 1
+goto :EOF
+
+:test
+rem Reconfigure the environment for the msvc64 build
+call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\bin\amd64\vcvars64.bat"
+"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh test" || exit /b 1
+goto :EOF
diff --git a/tools/ci/appveyor/appveyor_build.sh b/tools/ci/appveyor/appveyor_build.sh
new file mode 100644
index 00000000..2275fc5c
--- /dev/null
+++ b/tools/ci/appveyor/appveyor_build.sh
@@ -0,0 +1,190 @@
+#!/usr/bin/env bash
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                         Christophe Troestler                           *
+#*                                                                        *
+#*   Copyright 2015 Christophe Troestler                                  *
+#*                                                                        *
+#*   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.          *
+#*                                                                        *
+#**************************************************************************
+
+set -e
+
+BUILD_PID=0
+
+# This must correspond with the entry in appveyor.yml
+CACHE_DIRECTORY=/cygdrive/c/projects/cache
+
+if [[ -z $APPVEYOR_PULL_REQUEST_HEAD_COMMIT ]] ; then
+  MAKE="make -j"
+else
+  MAKE=make
+fi
+
+function run {
+    if [[ $1 = "--show" ]] ; then SHOW_CMD='true'; shift; else SHOW_CMD=''; fi
+    NAME=$1
+    shift
+    echo "-=-=- $NAME -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-"
+    if [[ -n $SHOW_CMD ]]; then (set -x; "$@"); else "$@"; fi
+    CODE=$?
+    if [[ $CODE -ne 0 ]] ; then
+        echo "-=-=- $NAME failed! -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-"
+        if [[ $BUILD_PID -ne 0 ]] ; then
+          kill -KILL $BUILD_PID 2>/dev/null
+          wait $BUILD_PID 2>/dev/null
+        fi
+        exit $CODE
+    else
+        echo "-=-=- End of $NAME -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-"
+    fi
+}
+
+# Function: set_configuration
+# Takes 3 arguments
+# $1:the Windows port. Recognized values: mingw, msvc and msvc64
+# $2: the prefix to use to install
+# $3: C compiler flags to use to turn warnings into errors
+function set_configuration {
+    case "$1" in
+        mingw)
+            build='--build=i686-pc-cygwin'
+            host='--host=i686-w64-mingw32'
+        ;;
+        msvc)
+            build='--build=i686-pc-cygwin'
+            host='--host=i686-pc-windows'
+        ;;
+        msvc64)
+            build='--build=x86_64-unknown-cygwin'
+            host='--host=x86_64-pc-windows'
+        ;;
+    esac
+
+    mkdir -p "$CACHE_DIRECTORY"
+    ./configure --cache-file="$CACHE_DIRECTORY/config.cache-$1" \
+                $build $host --prefix="$2" --enable-ocamltest || ( \
+      rm -f "$CACHE_DIRECTORY/config.cache-$1" ; \
+      ./configure --cache-file="$CACHE_DIRECTORY/config.cache-$1" \
+                  $build $host --prefix="$2" --enable-ocamltest )
+
+    FILE=$(pwd | cygpath -f - -m)/Makefile.config
+    echo "Edit $FILE to turn C compiler warnings into errors"
+    sed -i -e '/^ *OC_CFLAGS *=/s/\r\?$/ '"$3"'\0/' "$FILE"
+#    run "Content of $FILE" cat Makefile.config
+}
+
+APPVEYOR_BUILD_FOLDER=$(echo "$APPVEYOR_BUILD_FOLDER" | cygpath -f -)
+# These directory names are specified here, because getting UTF-8 correctly
+# through appveyor.yml -> Command Script -> Bash is quite painful...
+OCAMLROOT=$(echo "$PROGRAMFILES/Бактріан🐫" | cygpath -f - -m)
+
+# This must be kept in sync with appveyor_build.cmd
+BUILD_PREFIX=🐫реализация
+
+PATH=$(echo "$OCAMLROOT" | cygpath -f -)/bin/flexdll:$PATH
+
+case "$1" in
+  install)
+    mkdir -p "$OCAMLROOT/bin/flexdll"
+    cd "$APPVEYOR_BUILD_FOLDER/../flexdll"
+    # msvc64 objects need to be compiled with VS2015, so are copied later from
+    # a source build.
+    for f in flexdll.h flexlink.exe flexdll*_msvc.obj default*.manifest ; do
+      cp "$f" "$OCAMLROOT/bin/flexdll/"
+    done
+    if [[ $PORT = 'msvc64' ]] ; then
+      echo 'eval $($APPVEYOR_BUILD_FOLDER/tools/msvs-promote-path)' \
+        >> ~/.bash_profile
+    fi
+    ;;
+  msvc32-only)
+    cd "$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-msvc32"
+
+    set_configuration msvc "$OCAMLROOT-msvc32" -WX
+
+    run "$MAKE world" $MAKE world
+    run "$MAKE runtimeopt" $MAKE runtimeopt
+    run "$MAKE -C otherlibs/systhreads libthreadsnat.lib" \
+         $MAKE -C otherlibs/systhreads libthreadsnat.lib
+
+    exit 0
+    ;;
+  test)
+    FULL_BUILD_PREFIX="$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX"
+    run 'ocamlc.opt -version' "$FULL_BUILD_PREFIX-$PORT/ocamlc.opt" -version
+    if [[ $PORT = 'mingw32' ]] ; then
+      run "Check runtime symbols" \
+          "$FULL_BUILD_PREFIX-$PORT/tools/check-symbol-names" \
+          $FULL_BUILD_PREFIX-$PORT/runtime/*.a
+    fi
+    run "test $PORT" $MAKE -C "$FULL_BUILD_PREFIX-$PORT" tests
+    run "install $PORT" $MAKE -C "$FULL_BUILD_PREFIX-$PORT" install
+    if [[ $PORT = 'msvc64' ]] ; then
+      run "$MAKE check_all_arches" \
+           $MAKE -C "$FULL_BUILD_PREFIX-$PORT" check_all_arches
+      cd "$FULL_BUILD_PREFIX-$PORT"
+      # Ensure that .gitignore is up-to-date - this will fail if any untracked
+      # or altered files exist. We revert the change from the bootstrap (that
+      # would have failed the build earlier if necessary)
+      git checkout -- boot/ocamlc boot/ocamllex
+      # Remove the FlexDLL sources placed earlier in the process
+      rm -rf "flexdll-$FLEXDLL_VERSION"
+      run --show "Check tree is tracked" test -z "$(git status --porcelain)"
+      # check that the `distclean` target definitely cleans the tree
+      run "$MAKE distclean" $MAKE distclean
+      # Check the working tree is clean
+      run --show "Check tree is tracked" test -z "$(git status --porcelain)"
+      # Check that there are no ignored files
+      run --show "Check tree is clean" \
+        test -z "$(git ls-files --others -i --exclude-standard)"
+    fi
+    ;;
+  *)
+    cd "$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-$PORT"
+
+    if [[ $PORT = 'msvc64' ]] ; then
+      # Ensure that make distclean can be run from an empty tree
+      run "$MAKE distclean" $MAKE distclean
+      tar -xzf "$APPVEYOR_BUILD_FOLDER/flexdll.tar.gz"
+      cd "flexdll-$FLEXDLL_VERSION"
+      $MAKE MSVC_DETECT=0 CHAINS=msvc64 support
+      cp flexdll*_msvc64.obj "$OCAMLROOT/bin/flexdll/"
+      cd ..
+    fi
+
+    if [[ $PORT = 'msvc64' ]] ; then
+      set_configuration msvc64 "$OCAMLROOT" -WX
+    else
+      set_configuration mingw "$OCAMLROOT-mingw32" -Werror
+    fi
+
+    cd "$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-$PORT"
+
+    export TERM=ansi
+
+    if [[ $PORT = 'mingw32' ]] ; then
+      set -o pipefail
+      # For an explanation of the sed command, see
+      # https://github.com/appveyor/ci/issues/1824
+      script --quiet --return --command \
+        "$MAKE -C ../$BUILD_PREFIX-mingw32 flexdll && "\
+"$MAKE -C ../$BUILD_PREFIX-mingw32 world.opt" \
+        "../$BUILD_PREFIX-mingw32/build.log" |
+          sed -e 's/\d027\[K//g' \
+              -e 's/\d027\[m/\d027[0m/g' \
+              -e 's/\d027\[01\([m;]\)/\d027[1\1/g'
+    else
+      run "$MAKE world" $MAKE world
+      run "$MAKE bootstrap" $MAKE bootstrap
+      run "$MAKE opt" $MAKE opt
+      run "$MAKE opt.opt" $MAKE opt.opt
+    fi
+
+    ;;
+esac
diff --git a/tools/ci/inria/bootstrap b/tools/ci/inria/bootstrap
new file mode 100755
index 00000000..6e993a14
--- /dev/null
+++ b/tools/ci/inria/bootstrap
@@ -0,0 +1,245 @@
+#!/bin/sh
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*          Damien Doligez, projet Gallium, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 2014 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# This script is run on Inria's continuous-integration servers to make sure
+# it is possible to bootstrap the compiler.
+
+# To know the slave's architecture, this script looks at the OCAML_ARCH
+# environment variable. For a given node NODE, this variable can be defined
+# in Jenkins at the following address:
+# https://ci.inria.fr/ocaml/computer/NODE/configure
+
+# Other environments variables that are honored:
+#   OCAML_CONFIGURE_OPTIONS   additional options for configure
+#   OCAML_JOBS                number of jobs to run in parallel (make -j)
+
+# Command-line arguments:
+# -conf configure-option  add configure-option to configure cmd line
+# -patch1 file-name       apply patch with -p1
+# -no-native              do not build "opt" and "opt.opt"
+# -jNN                    pass "-jNN" option to make for parallel builds
+
+error () {
+  echo "$1" >&2
+  exit 3
+}
+
+arch_error() {
+  configure_url="https://ci.inria.fr/ocaml/computer/${NODE_NAME}/configure"
+  msg="Unknown architecture. Make sure the OCAML_ARCH environment"
+  msg="$msg variable has been defined."
+  msg="$msg\nSee ${configure_url}"
+  error "$msg"
+}
+
+# Kill a task on Windows
+# Errors are ignored
+kill_task()
+{
+  task=$1
+  taskkill /f /im ${task} /t || true
+}
+
+quote1 () {
+  printf "'%s'" "`printf %s "$1" | sed -e "s/'/'\\\\\\\\''/g"`";
+}
+
+# Functions used to modify the source code
+
+change_exe_magic_number() {
+  old=`./runtime/ocamlrun -M`
+  new="$1"
+  echo Changing executable magic number from ${old} to ${new}
+  # Change magic number in runtime/caml/exec.h
+  sed -i 's/\x23define \+EXEC_MAGIC \+\x22'${old}\
+'\x22/#define EXEC_MAGIC "'${new}'"/' runtime/caml/exec.h
+  # Change magic number in utils/config.mlp
+  sed -i 's/let \+exec_magic_number \+= \+\x22'${old}\
+'\x22/let exec_magic_number = "'${new}'"/' utils/config.mlp
+}
+
+remove_primitive()
+{
+  echo Removing the \'sinh\' primitive
+  patch -p1 < tools/ci/inria/remove-sinh-primitive.patch
+}
+
+#########################################################################
+# be verbose
+set -x
+
+#########################################################################
+# Save the current directory (on cygwin, /etc/profile changes it)
+jenkinsdir="$(pwd)"
+echo jenkinsdir=${jenkinsdir}
+
+#########################################################################
+# If we are called from a Windows batch script, we must set up the
+# Unix environment variables (e.g. PATH).
+
+case "${OCAML_ARCH}" in
+  bsd|macos|linux) ;;
+  cygwin|cygwin64|mingw|mingw64)
+    . /etc/profile
+    . "$HOME/.profile"
+  ;;
+  msvc)
+    . /etc/profile
+    . "$HOME/.profile"
+    . "$HOME/.msenv32"
+  ;;
+  msvc64)
+    . /etc/profile
+    . "$HOME/.profile"
+    . "$HOME/.msenv64"
+  ;;
+  *) arch_error;;
+esac
+
+#########################################################################
+
+# be considerate towards other potential users of the test machine
+case "${OCAML_ARCH}" in
+  bsd|macos|linux) renice 10 $$ ;;
+esac
+
+# be verbose and stop on error
+set -ex
+
+#########################################################################
+# set up variables
+
+# default values
+make=make
+instdir="$HOME/ocaml-tmp-install"
+confoptions="--enable-ocamltest ${OCAML_CONFIGURE_OPTIONS}"
+make_native=true
+cleanup=false
+check_make_alldepend=false
+dorebase=false
+jobs=''
+build=''
+host=''
+
+case "${OCAML_ARCH}" in
+  bsd) make=gmake ;;
+  macos) ;;
+  linux)
+    check_make_alldepend=true
+  ;;
+  cygwin)
+    cleanup=true
+    check_make_alldepend=true
+  ;;
+  cygwin64)
+    cleanup=true
+    check_make_alldepend=true
+    dorebase=true
+  ;;
+  mingw)
+    build='--build=i686-pc-cygwin'
+    host='--host=i686-w64-mingw32'
+    instdir='C:/ocamlmgw'
+    cleanup=true
+    check_make_alldepend=true
+  ;;
+  mingw64)
+    build='--build=x86_64-unknown-cygwin'
+    host='--host=x86_64-w64-mingw32'
+    instdir='C:/ocamlmgw64'
+    cleanup=true
+    check_make_alldepend=true
+  ;;
+  msvc)
+    build='--build=i686-pc-cygwin'
+    host='--host=i686-pc-windows'
+    instdir='C:/ocamlms'
+    configure=nt
+    cleanup=true
+  ;;
+  msvc64)
+    build='--build=x86_64-unknown-cygwin'
+    host='--host=x86_64-pc-windows'
+    instdir='C:/ocamlms64'
+    configure=nt
+    cleanup=true
+  ;;
+  *) arch_error;;
+esac
+
+# Make sure two builds won't use the same install directory
+instdir="$instdir-$$"
+
+case "${OCAML_JOBS}" in
+  [1-9]|[1-9][0-9]) jobs="-j${OCAML_JOBS}" ;;
+esac
+
+#########################################################################
+# On Windows, cleanup processes that may remain from previous run
+
+if $cleanup; then
+  tasks="tee ocamlrun program ocamltest ocamltest.opt"
+  for task in ${tasks}; do kill_task ${task}.exe; done
+fi
+
+#########################################################################
+# Go to the right directory
+
+pwd
+cd "$jenkinsdir"
+
+#########################################################################
+# parse optional command-line arguments (has to be done after the "cd")
+
+while [ $# -gt 0 ]; do
+  case $1 in
+    -conf) confoptions="$confoptions `quote1 "$2"`"; shift;;
+    -patch1) patch -f -p1 <"$2"; shift;;
+    -no-native) make_native=false;;
+    -j[1-9]|-j[1-9][0-9]) jobs="$1";;
+    *) error "unknown option $1";;
+  esac
+  shift
+done
+
+#########################################################################
+# Do the work
+
+# Tell gcc to use only ASCII in its diagnostic outputs.
+export LC_ALL=C
+
+$make -s distclean || :
+
+# `make distclean` does not clean the files from previous versions that
+# are not produced by the current version, so use `git clean` in addition.
+git clean -f -d -x
+
+# Also make a hard reset
+git reset --hard HEAD
+
+if $flambda; then
+  confoptions="$confoptions -enable-flambda --enable-flambda-invariants"
+fi
+eval "./configure $build $host --prefix='$instdir' $confoptions"
+
+$make world
+
+change_exe_magic_number "CI-bootstrap"
+
+remove_primitive
+
+$make coreall
+$make bootstrap
diff --git a/tools/ci/inria/dune-build b/tools/ci/inria/dune-build
new file mode 100755
index 00000000..6c95220a
--- /dev/null
+++ b/tools/ci/inria/dune-build
@@ -0,0 +1,25 @@
+#!/bin/sh
+
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*          Xavier Leroy, projet Cambium, INRIA Paris-Rocquencourt        *
+#*                                                                        *
+#*   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.          *
+#*                                                                        *
+#**************************************************************************
+
+# Test the Dune-based build
+
+set -ex
+eval $(opam env)
+export LC_ALL=C
+git clean -q -f -d -x
+./configure
+dune build -j2 @libs
diff --git a/tools/ci/inria/extra-checks b/tools/ci/inria/extra-checks
new file mode 100755
index 00000000..3e686478
--- /dev/null
+++ b/tools/ci/inria/extra-checks
@@ -0,0 +1,253 @@
+#!/bin/sh
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*      Damien Doligez, Xavier Leroy, projet Gallium, INRIA Paris         *
+#*                                                                        *
+#*   Copyright 2018 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 script is run on Inria's continuous-integration servers to recompile
+# from scratch, adding more run-time checks ("sanitizers") to the C code,
+# and run the test suite.
+
+# In this context, it is necessary to skip a few tests whose behaviour
+# is modified by the instrumentation:
+
+export OCAMLTEST_SKIP_TESTS="tests/afl-instrumentation/afltest.ml \
+tests/runtime-errors/stackoverflow.ml"
+
+# To know the slave's architecture, this script looks at the OCAML_ARCH
+# environment variable. For a given node NODE, this variable can be defined
+# in Jenkins at the following address:
+# https://ci.inria.fr/ocaml/computer/NODE/configure
+
+# Other environment variables that are honored:
+#   OCAML_JOBS                number of jobs to run in parallel (make -j)
+
+# Command-line arguments:
+# -jNN                    pass "-jNN" option to make for parallel builds
+
+error () {
+  echo "$1" >&2
+  exit 3
+}
+
+arch_error() {
+  configure_url="https://ci.inria.fr/ocaml/computer/${NODE_NAME}/configure"
+  msg="Unknown architecture. Make sure the OCAML_ARCH environment"
+  msg="$msg variable has been defined."
+  msg="$msg\nSee ${configure_url}"
+  error "$msg"
+}
+
+# Change a variable in Makefile.config
+# Usage: set_config_var  
+
+
+set_config_var() {
+  conffile=Makefile.config
+  mv ${conffile} ${conffile}.bak
+  (grep -v "^$1=" ${conffile}.bak; echo "$1=$2") > ${conffile}
+}
+
+#########################################################################
+# stop on error
+set -e
+
+# be considerate towards other potential users of the test machine
+case "${OCAML_ARCH}" in
+  bsd|macos|linux) renice 10 $$ ;;
+esac
+
+# set up variables
+
+make=make
+jobs=''
+
+case "${OCAML_ARCH}" in
+  bsd) make=gmake ;;
+  macos) ;;
+  linux) ;;
+  cygwin|cygwin64|mingw|mingw64|msvc|msvc64)
+    error "Don't run this test under Windows";;
+  *) arch_error;;
+esac
+
+case "${OCAML_JOBS}" in
+  [1-9]|[1-9][0-9]) jobs="-j${OCAML_JOBS}" ;;
+esac
+
+# parse optional command-line arguments
+
+while [ $# -gt 0 ]; do
+  case $1 in
+    -j[1-9]|-j[1-9][0-9]) jobs="$1";;
+    *) error "unknown option $1";;
+  esac
+  shift
+done
+
+# Tell gcc to use only ASCII in its diagnostic outputs.
+export LC_ALL=C
+
+# How to run the test suite
+if test -n "$jobs" && test -x /usr/bin/parallel; then
+  export PARALLEL="$jobs $PARALLEL"
+  run_testsuite="$make -C testsuite parallel"
+else
+  run_testsuite="$make -C testsuite all"
+fi
+
+# A tool that make error backtrace nicer
+# Need to pick the one that matches clang-9 and is named "llvm-symbolizer"
+# (/usr/bin/llvm-symbolizer-9 doesn't work, that would be too easy)
+export ASAN_SYMBOLIZER_PATH=/usr/lib/llvm-9/bin/llvm-symbolizer
+export TSAN_SYMBOLIZER_PATH="$ASAN_SYMBOLIZER_PATH"
+
+#########################################################################
+
+# Cleanup repository
+git clean -q -f -d -x
+
+# Ensure that the repo still passes the check-typo script
+if [ ! -x tools/check-typo ] ; then
+  error "tools/check-typo does not appear to be executable?"
+fi
+tools/check-typo
+
+#########################################################################
+
+echo "======== old school build =========="
+
+instdir="$HOME/ocaml-tmp-install-$$"
+./configure --prefix "$instdir"
+
+# Build the system without using world.opt
+make $jobs world
+make $jobs opt
+make $jobs opt.opt
+make install
+
+rm -rf "$instdir"
+
+# It's a build system test only, so we don't bother testing the compiler
+
+#########################################################################
+
+echo "======== clang 9, address sanitizer, UB sanitizer =========="
+
+git clean -q -f -d -x
+
+# Use clang 9
+# We cannot give the sanitizer options as part of -cc because
+# then various autoconfiguration tests fail.
+# Instead, we'll fix OC_CFLAGS a posteriori.
+./configure CC=clang-9 --disable-stdlib-manpages
+
+# These are the undefined behaviors we want to check
+# Others occur on purpose e.g. signed arithmetic overflow
+ubsan="\
+bool,\
+builtin,\
+bounds,\
+enum,\
+nonnull-attribute,\
+nullability,\
+object-size,\
+pointer-overflow,\
+returns-nonnull-attribute,\
+shift-exponent,\
+unreachable"
+
+# Select address sanitizer and UB sanitizer, with trap-on-error behavior
+# Don't optimize too much to get better backtraces of errors
+set_config_var OC_CFLAGS "-O1 \
+-fno-strict-aliasing -fwrapv -fno-omit-frame-pointer \
+-Wall -Werror \
+-fsanitize=address \
+-fsanitize-trap=$ubsan"
+
+# Build the system.  We want to check for memory leaks, hence
+# 1- force ocamlrun to free memory before exiting
+# 2- add an exception for ocamlyacc, which doesn't free memory
+
+OCAMLRUNPARAM="c=1" \
+LSAN_OPTIONS="suppressions=$(pwd)/tools/ci/inria/lsan-suppr.txt" \
+make $jobs world.opt
+
+# Run the testsuite.
+# We deactivate leak detection for two reasons:
+# - The suppressed leak detections related to ocamlyacc mess up the
+# output of the tests and are reported as failures by ocamltest.
+# - The Ocaml runtime does not free the memory when a fatal error
+# occurs.
+
+# We already use sigaltstack for stack overflow detection. Our use
+# interacts with ASAN's. Hence, we tell ASAN not to use it.
+
+ASAN_OPTIONS="detect_leaks=0,use_sigaltstack=0" $run_testsuite
+
+#########################################################################
+
+echo "======== clang 9, thread sanitizer =========="
+
+git clean -q -f -d -x
+
+./configure CC=clang-9 --disable-stdlib-manpages
+
+# Select thread sanitizer
+# Don't optimize too much to get better backtraces of errors
+set_config_var OC_CFLAGS "-O1 \
+-fno-strict-aliasing -fwrapv -fno-omit-frame-pointer \
+-Wall -Werror \
+-fsanitize=thread"
+
+# Build the system
+make $jobs world.opt
+
+# Run the testsuite.
+# ThreadSanitizer complains about fork() in threaded programs,
+# we ask it to just continue in this case.
+TSAN_OPTIONS="die_after_fork=0" $run_testsuite
+
+#########################################################################
+
+# This is a failed attempt at using the memory sanitizer
+# (to detect reads from uninitialized memory).
+# Some alarms are reported that look like false positive
+# and are impossible to debug.
+
+# echo "======== clang 6.0, memory sanitizer =========="
+
+# git clean -q -f -d -x
+
+# # Use clang 6.0
+# # We cannot give the sanitizer options as part of -cc because
+# # then various autoconfiguration tests fail.
+# # Instead, we'll fix OC_CFLAGS a posteriori.
+# # Memory sanitizer doesn't like the static data generated by ocamlopt,
+# # hence build bytecode only
+# ./configure CC=clang-9 --disable-native-compiler
+
+# # Select memory sanitizer
+# # Don't optimize at all to get better backtraces of errors
+# set_config_var OC_CFLAGS "-O0 -g \
+# -fno-strict-aliasing -fwrapv -fno-omit-frame-pointer \
+# -Wall -Werror \
+# -fsanitize=memory"
+
+# # A tool that make error backtrace nicer
+# # Need to pick the one that matches clang-6.0
+# export MSAN_SYMBOLIZER_PATH=/usr/lib/llvm-6.0/bin/llvm-symbolizer
+
+# # Build the system (bytecode only) and test
+# make $jobs world
+# $run_testsuite
diff --git a/tools/ci/inria/lsan-suppr.txt b/tools/ci/inria/lsan-suppr.txt
new file mode 100644
index 00000000..160e7fc6
--- /dev/null
+++ b/tools/ci/inria/lsan-suppr.txt
@@ -0,0 +1,2 @@
+# ocamlyacc doesn't clean memory on exit
+leak:ocamlyacc
diff --git a/tools/ci/inria/main b/tools/ci/inria/main
new file mode 100755
index 00000000..99fb4667
--- /dev/null
+++ b/tools/ci/inria/main
@@ -0,0 +1,252 @@
+#!/bin/sh
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*          Damien Doligez, projet Gallium, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 2014 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# This script is run on our continuous-integration servers to recompile
+# from scratch and run the test suite.
+
+# To know the slave's architecture, this script looks at the OCAML_ARCH
+# environment variable. For a given node NODE, this variable can be defined
+# in Jenkins at the following address:
+# https://ci.inria.fr/ocaml/computer/NODE/configure
+
+# Other environment variables that are honored:
+#   OCAML_CONFIGURE_OPTIONS   additional options for configure
+#   OCAML_JOBS                number of jobs to run in parallel (make -j)
+
+# Command-line arguments:
+# -conf configure-option  add configure-option to configure cmd line
+# -patch1 file-name       apply patch with -p1
+# -no-native              do not build "opt" and "opt.opt"
+# -jNN                    pass "-jNN" option to make for parallel builds
+
+error () {
+  echo "$1" >&2
+  exit 3
+}
+
+arch_error() {
+  configure_url="https://ci.inria.fr/ocaml/computer/${NODE_NAME}/configure"
+  msg="Unknown architecture. Make sure the OCAML_ARCH environment"
+  msg="$msg variable has been defined."
+  msg="$msg\nSee ${configure_url}"
+  error "$msg"
+}
+
+# Kill a task on Windows
+# Errors are ignored
+kill_task()
+{
+  task=$1
+  taskkill /f /im ${task} /t || true
+}
+
+quote1 () {
+  printf "'%s'" "`printf %s "$1" | sed -e "s/'/'\\\\\\\\''/g"`";
+}
+
+#########################################################################
+# be verbose
+set -x
+
+#########################################################################
+# Save the current directory (on cygwin, /etc/profile changes it)
+jenkinsdir="$(pwd)"
+echo jenkinsdir=${jenkinsdir}
+
+#########################################################################
+# If we are called from a Windows batch script, we must set up the
+# Unix environment variables (e.g. PATH).
+
+case "${OCAML_ARCH}" in
+  bsd|macos|linux) ;;
+  cygwin|cygwin64|mingw|mingw64)
+    . /etc/profile
+    . "$HOME/.profile"
+  ;;
+  msvc)
+    . /etc/profile
+    . "$HOME/.profile"
+    . "$HOME/.msenv32"
+  ;;
+  msvc64)
+    . /etc/profile
+    . "$HOME/.profile"
+    . "$HOME/.msenv64"
+  ;;
+  *) arch_error;;
+esac
+
+#########################################################################
+
+# be considerate towards other potential users of the test machine
+case "${OCAML_ARCH}" in
+  bsd|macos|linux) renice 10 $$ ;;
+esac
+
+# be verbose and stop on error
+set -ex
+
+# On PowerPC, the OCAML_CONFIGURE_OPTIONS is used to specify which C
+# compiler to use. However with the introduction of autoconf the way
+# to do that has changed. Once all the branches on which we do CI will use
+# autoconf, the variable shall be updated on the host. But until then,
+# we leave it with its legacy value and override it here.
+CCOMP=
+case $NODE_NAME in
+  ocaml-ppc-32)
+    CCOMP="CC='gcc -m32'"
+    OCAML_CONFIGURE_OPTIONS=;;
+  ocaml-ppc-64)
+    CCOMP="CC='gcc -m64'"
+    OCAML_CONFIGURE_OPTIONS=;;
+  ocaml-openbsd-64)
+    OCAML_CONFIGURE_OPTIONS='--with-bfd'
+esac
+
+#########################################################################
+# set up variables
+
+# default values
+build=''
+host=''
+conffile=Makefile.config
+make=make
+instdir="$HOME/ocaml-tmp-install"
+confoptions="--enable-ocamltest ${OCAML_CONFIGURE_OPTIONS}"
+make_native=true
+cleanup=false
+check_make_alldepend=false
+dorebase=false
+jobs=''
+
+case "${OCAML_ARCH}" in
+  bsd)
+    make=gmake
+  ;;
+  macos)
+    confoptions="$confoptions --with-bfd "
+  ;;
+  linux)
+    check_make_alldepend=true
+  ;;
+  cygwin)
+    cleanup=true
+    check_make_alldepend=true
+  ;;
+  cygwin64)
+    cleanup=true
+    check_make_alldepend=true
+    dorebase=false
+    confoptions="$confoptions --disable-shared "
+  ;;
+  mingw)
+    build='--build=i686-pc-cygwin'
+    host='--host=i686-w64-mingw32'
+    instdir='C:/ocamlmgw'
+    cleanup=true
+    check_make_alldepend=true
+  ;;
+  mingw64)
+    build='--build=x86_64-unknown-cygwin'
+    host='--host=x86_64-w64-mingw32'
+    instdir='C:/ocamlmgw64'
+    cleanup=true
+    check_make_alldepend=true
+  ;;
+  msvc)
+    build='--build=i686-pc-cygwin'
+    host='--host=i686-pc-windows'
+    instdir='C:/ocamlms'
+    cleanup=true
+  ;;
+  msvc64)
+    build='--build=x86_64-unknown-cygwin'
+    host='--host=x86_64-pc-windows'
+    instdir='C:/ocamlms64'
+    cleanup=true
+  ;;
+  *) arch_error;;
+esac
+
+# Make sure two builds won't use the same install directory
+instdir="$instdir-$$"
+
+case "${OCAML_JOBS}" in
+  [1-9]|[1-9][0-9]) jobs="-j${OCAML_JOBS}" ;;
+esac
+
+#########################################################################
+# On Windows, cleanup processes that may remain from previous run
+
+if $cleanup; then
+  tasks="tee ocamlrun program ocamltest ocamltest.opt"
+  for task in ${tasks}; do kill_task ${task}.exe; done
+fi
+
+#########################################################################
+# Go to the right directory
+
+pwd
+cd "$jenkinsdir"
+
+#########################################################################
+# parse optional command-line arguments (has to be done after the "cd")
+
+while [ $# -gt 0 ]; do
+  case $1 in
+    -conf) confoptions="$confoptions `quote1 "$2"`"; shift;;
+    -patch1) patch -f -p1 <"$2"; shift;;
+    -no-native) make_native=false;;
+    -j[1-9]|-j[1-9][0-9]) jobs="$1";;
+    *) error "unknown option $1";;
+  esac
+  shift
+done
+
+#########################################################################
+# Do the work
+
+# Tell gcc to use only ASCII in its diagnostic outputs.
+export LC_ALL=C
+
+git clean -q -f -d -x
+
+if $flambda; then
+  confoptions="$confoptions --enable-flambda --enable-flambda-invariants"
+fi
+
+eval ./configure "$CCOMP" $build $host --prefix='$instdir' $confoptions
+
+if $make_native; then
+  $make $jobs --warn-undefined-variables
+  if $check_make_alldepend; then $make --warn-undefined-variables alldepend; fi
+else
+  $make $jobs --warn-undefined-variables
+fi
+if $dorebase; then
+    # temporary solution to the cygwin fork problem
+    # see https://github.com/alainfrisch/flexdll/issues/50
+    rebase -b 0x7cd20000 otherlibs/unix/dllunix.so
+    rebase -b 0x7cdc0000 otherlibs/systhreads/dllthreads.so
+fi
+$make --warn-undefined-variables install
+
+rm -rf "$instdir"
+cd testsuite
+if test -n "$jobs" && test -x /usr/bin/parallel
+then PARALLEL="$jobs $PARALLEL" $make --warn-undefined-variables parallel
+else $make --warn-undefined-variables all
+fi
diff --git a/tools/ci/inria/other-configs b/tools/ci/inria/other-configs
new file mode 100755
index 00000000..accd724f
--- /dev/null
+++ b/tools/ci/inria/other-configs
@@ -0,0 +1,29 @@
+#!/bin/sh
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Sebastien Hinderer, projet Gallium, INRIA Paris             *
+#*                                                                        *
+#*   Copyright 2017 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.          *
+#*                                                                        *
+#**************************************************************************
+
+# Commands to run for the 'other-configs' job on Inria's CI
+
+# Stop on error
+set -e
+
+mainjob=./tools/ci/inria/main
+main="${mainjob} -j8"
+
+${main} -conf --disable-native-compiler -no-native
+${main} -conf --disable-naked-pointers
+${main} -conf --disable-flat-float-array
+${main} -conf --enable-flambda -conf --disable-naked-pointers
+OCAMLRUNPARAM="c=1" ${main}
diff --git a/tools/ci/inria/remove-sinh-primitive.patch b/tools/ci/inria/remove-sinh-primitive.patch
new file mode 100644
index 00000000..db9dfe83
--- /dev/null
+++ b/tools/ci/inria/remove-sinh-primitive.patch
@@ -0,0 +1,90 @@
+The patch below removes the 'sinh' primitive from the OCaml runtime
+and standard library.
+
+It is used on Inria's CI to make sure the bootstrap procedure works.
+
+diff --git a/runtime/floats.c b/runtime/floats.c
+index b93f6a409..6edbed9c6 100644
+--- a/runtime/floats.c
++++ b/runtime/floats.c
+@@ -536,11 +536,6 @@ CAMLprim value caml_sin_float(value f)
+   return caml_copy_double(sin(Double_val(f)));
+ }
+ 
+-CAMLprim value caml_sinh_float(value f)
+-{
+-  return caml_copy_double(sinh(Double_val(f)));
+-}
+-
+ CAMLprim value caml_cos_float(value f)
+ {
+   return caml_copy_double(cos(Double_val(f)));
+diff --git a/stdlib/float.ml b/stdlib/float.ml
+index 8d9c5cca6..3b3ca61bc 100644
+--- a/stdlib/float.ml
++++ b/stdlib/float.ml
+@@ -69,8 +69,6 @@ external hypot : float -> float -> float
+                = "caml_hypot_float" "caml_hypot" [@@unboxed] [@@noalloc]
+ external cosh : float -> float = "caml_cosh_float" "cosh"
+   [@@unboxed] [@@noalloc]
+-external sinh : float -> float = "caml_sinh_float" "sinh"
+-  [@@unboxed] [@@noalloc]
+ external tanh : float -> float = "caml_tanh_float" "tanh"
+   [@@unboxed] [@@noalloc]
+ external ceil : float -> float = "caml_ceil_float" "ceil"
+diff --git a/stdlib/float.mli b/stdlib/float.mli
+index 2cdd31608..904f4af0e 100644
+--- a/stdlib/float.mli
++++ b/stdlib/float.mli
+@@ -196,10 +196,6 @@ external cosh : float -> float = "caml_cosh_float" "cosh"
+ [@@unboxed] [@@noalloc]
+ (** Hyperbolic cosine.  Argument is in radians. *)
+ 
+-external sinh : float -> float = "caml_sinh_float" "sinh"
+-[@@unboxed] [@@noalloc]
+-(** Hyperbolic sine.  Argument is in radians. *)
+-
+ external tanh : float -> float = "caml_tanh_float" "tanh"
+ [@@unboxed] [@@noalloc]
+ (** Hyperbolic tangent.  Argument is in radians. *)
+diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
+index 945512716..55bc9e921 100644
+--- a/stdlib/pervasives.ml
++++ b/stdlib/pervasives.ml
+@@ -97,8 +97,6 @@ external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot"
+   [@@unboxed] [@@noalloc]
+ external cosh : float -> float = "caml_cosh_float" "cosh"
+   [@@unboxed] [@@noalloc]
+-external sinh : float -> float = "caml_sinh_float" "sinh"
+-  [@@unboxed] [@@noalloc]
+ external tanh : float -> float = "caml_tanh_float" "tanh"
+   [@@unboxed] [@@noalloc]
+ external ceil : float -> float = "caml_ceil_float" "ceil"
+diff --git a/stdlib/stdlib.ml b/stdlib/stdlib.ml
+index 425728f64..4057dbc90 100644
+--- a/stdlib/stdlib.ml
++++ b/stdlib/stdlib.ml
+@@ -148,8 +148,6 @@ external log10 : float -> float = "caml_log10_float" "log10"
+ external log1p : float -> float = "caml_log1p_float" "caml_log1p"
+   [@@unboxed] [@@noalloc]
+ external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc]
+-external sinh : float -> float = "caml_sinh_float" "sinh"
+-  [@@unboxed] [@@noalloc]
+ external sqrt : float -> float = "caml_sqrt_float" "sqrt"
+   [@@unboxed] [@@noalloc]
+ external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc]
+diff --git a/stdlib/stdlib.mli b/stdlib/stdlib.mli
+index d451bba9c..990a41467 100644
+--- a/stdlib/stdlib.mli
++++ b/stdlib/stdlib.mli
+@@ -461,10 +461,6 @@ external cosh : float -> float = "caml_cosh_float" "cosh"
+   [@@unboxed] [@@noalloc]
+ (** Hyperbolic cosine.  Argument is in radians. *)
+ 
+-external sinh : float -> float = "caml_sinh_float" "sinh"
+-  [@@unboxed] [@@noalloc]
+-(** Hyperbolic sine.  Argument is in radians. *)
+-
+ external tanh : float -> float = "caml_tanh_float" "tanh"
+   [@@unboxed] [@@noalloc]
+ (** Hyperbolic tangent.  Argument is in radians. *)
diff --git a/tools/ci/travis/travis-ci.sh b/tools/ci/travis/travis-ci.sh
new file mode 100755
index 00000000..410c63d3
--- /dev/null
+++ b/tools/ci/travis/travis-ci.sh
@@ -0,0 +1,358 @@
+#!/usr/bin/env bash
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*              Anil Madhavapeddy, OCaml Labs                             *
+#*                                                                        *
+#*   Copyright 2014 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.          *
+#*                                                                        *
+#**************************************************************************
+
+set -e
+
+# TRAVIS_COMMIT_RANGE has the form   ...
+# TRAVIS_CUR_HEAD is 
+# TRAVIS_PR_HEAD is 
+#
+# The following diagram illustrates the relationship between
+# the commits:
+#
+#      (trunk)         (pr branch)
+#  TRAVIS_CUR_HEAD   TRAVIS_PR_HEAD
+#        |            /
+#       ...         ...
+#        |          /
+#  TRAVIS_MERGE_BASE
+#
+echo "TRAVIS_COMMIT_RANGE=$TRAVIS_COMMIT_RANGE"
+echo "TRAVIS_COMMIT=$TRAVIS_COMMIT"
+if [[ $TRAVIS_EVENT_TYPE = 'pull_request' ]] ; then
+  FETCH_HEAD=$(git rev-parse FETCH_HEAD)
+  echo "FETCH_HEAD=$FETCH_HEAD"
+else
+  FETCH_HEAD=$TRAVIS_COMMIT
+fi
+
+if [[ $TRAVIS_EVENT_TYPE = 'push' ]] ; then
+  if ! git cat-file -e "$TRAVIS_COMMIT" 2> /dev/null ; then
+    echo 'TRAVIS_COMMIT does not exist - CI failure'
+    exit 1
+  fi
+else
+  if [[ $TRAVIS_COMMIT != $(git rev-parse FETCH_HEAD) ]] ; then
+    echo 'WARNING! Travis TRAVIS_COMMIT and FETCH_HEAD do not agree!'
+    if git cat-file -e "$TRAVIS_COMMIT" 2> /dev/null ; then
+      echo 'TRAVIS_COMMIT exists, so going with it'
+    else
+      echo 'TRAVIS_COMMIT does not exist; setting to FETCH_HEAD'
+      TRAVIS_COMMIT=$FETCH_HEAD
+    fi
+  fi
+fi
+
+set -x
+
+PREFIX=~/local
+
+MAKE=make SHELL=dash
+
+TRAVIS_CUR_HEAD=${TRAVIS_COMMIT_RANGE%%...*}
+TRAVIS_PR_HEAD=${TRAVIS_COMMIT_RANGE##*...}
+case $TRAVIS_EVENT_TYPE in
+   # If this is not a pull request then TRAVIS_COMMIT_RANGE may be empty.
+   pull_request)
+     DEEPEN=50
+     while ! git merge-base "$TRAVIS_CUR_HEAD" "$TRAVIS_PR_HEAD" >& /dev/null
+     do
+       echo "Deepening $TRAVIS_BRANCH by $DEEPEN commits"
+       git fetch origin --deepen=$DEEPEN "$TRAVIS_BRANCH"
+       ((DEEPEN*=2))
+     done
+     TRAVIS_MERGE_BASE=$(git merge-base "$TRAVIS_CUR_HEAD" "$TRAVIS_PR_HEAD");;
+esac
+
+BuildAndTest () {
+  mkdir -p $PREFIX
+  cat</dev/null  ; then
+    echo Ensuring that all library documentation compiles
+    make -C ocamldoc html_doc pdf_doc texi_doc
+  fi
+  $MAKE install
+  if fgrep 'SUPPORTS_SHARED_LIBRARIES=true' Makefile.config &>/dev/null ; then
+    echo Check the code examples in the manual
+    $MAKE manual-pregen
+  fi
+  # check_all_arches checks tries to compile all backends in place,
+  # we would need to redo (small parts of) world.opt afterwards to
+  # use the compiler again
+  $MAKE check_all_arches
+  # Ensure that .gitignore is up-to-date - this will fail if any untreacked or
+  # altered files exist.
+  test -z "$(git status --porcelain)"
+  # check that the 'clean' target also works
+  $MAKE clean
+  $MAKE -C manual clean
+  # check that the `distclean` target definitely cleans the tree
+  $MAKE distclean
+  # Check the working tree is clean
+  test -z "$(git status --porcelain)"
+  # Check that there are no ignored files
+  test -z "$(git ls-files --others -i --exclude-standard)"
+}
+
+CheckChangesModified () {
+  cat< /dev/null && CheckNoChangesMessage || echo pass
+}
+
+CheckNoChangesMessage () {
+  API_URL=https://api.github.com/repos/$TRAVIS_REPO_SLUG/issues/$TRAVIS_PULL_REQUEST/labels
+  if [[ -n $(git log --grep='[Nn]o [Cc]hange.* needed' --max-count=1 \
+    "$TRAVIS_MERGE_BASE..$TRAVIS_PR_HEAD") ]]
+  then echo pass
+  elif [[ -n $(curl "$API_URL" | grep 'no-change-entry-needed') ]]
+  then echo pass
+  else exit 1
+  fi
+}
+
+CheckManual () {
+      cat< /dev/null && exit 1 || echo pass
+}
+
+# Test to see if any part of the directory name has been marked prune
+not_pruned () {
+  DIR=$(dirname "$1")
+  if [[ $DIR = '.' ]] ; then
+    return 0
+  else
+    case ",$(git check-attr typo.prune "$DIR" | sed -e 's/.*: //')," in
+      ,set,)
+      return 1
+      ;;
+      *)
+
+      not_pruned "$DIR"
+      return $?
+    esac
+  fi
+}
+
+CheckTypoTree () {
+  export OCAML_CT_HEAD=$1
+  export OCAML_CT_LS_FILES="git diff-tree --no-commit-id --name-only -r $2 --"
+  export OCAML_CT_CAT='git cat-file --textconv'
+  export OCAML_CT_PREFIX="$1:"
+  GIT_INDEX_FILE=tmp-index git read-tree --reset -i "$1"
+  git diff-tree --diff-filter=d --no-commit-id --name-only -r "$2" \
+    | (while IFS= read -r path
+  do
+    if not_pruned "$path" ; then
+      echo "Checking $1: $path"
+      if ! tools/check-typo "./$path" ; then
+        touch check-typo-failed
+      fi
+    else
+      echo "NOT checking $1: $path (typo.prune)"
+    fi
+    case "$path" in
+      configure|configure.ac|VERSION|tools/ci/travis/travis-ci.sh)
+        touch CHECK_CONFIGURE;;
+    esac
+  done)
+  rm -f tmp-index
+  if [[ -e CHECK_CONFIGURE ]] ; then
+    rm -f CHECK_CONFIGURE
+    echo "configure generation altered in $1"
+    echo 'Verifying that configure.ac generates configure'
+    git checkout "$1"
+    mv configure configure.ref
+    make configure
+    if ! diff -q configure configure.ref >/dev/null ; then
+      echo "configure.ac no longer generates configure, \
+please run rm configure ; make configure and commit"
+      exit 1
+    fi
+  fi
+}
+
+CHECK_ALL_COMMITS=0
+
+CheckTypo () {
+  export OCAML_CT_GIT_INDEX='tmp-index'
+  export OCAML_CT_CA_FLAG='--cached'
+  # Work around an apparent bug in Ubuntu 12.4.5
+  # See https://bugs.launchpad.net/ubuntu/+source/gawk/+bug/1647879
+  rm -f check-typo-failed
+  if [[ -z $TRAVIS_COMMIT_RANGE ]]
+  then CheckTypoTree "$TRAVIS_COMMIT" "$TRAVIS_COMMIT"
+  else
+    if [[ $TRAVIS_EVENT_TYPE = 'pull_request' ]]
+    then TRAVIS_COMMIT_RANGE=$TRAVIS_MERGE_BASE..$TRAVIS_PULL_REQUEST_SHA
+    fi
+    if [[ $CHECK_ALL_COMMITS -eq 1 ]]
+    then
+      for commit in $(git rev-list "$TRAVIS_COMMIT_RANGE" --reverse)
+      do
+        CheckTypoTree "$commit" "$commit"
+      done
+    else
+      if [[ -z $TRAVIS_PULL_REQUEST_SHA ]]
+      then CheckTypoTree "$TRAVIS_COMMIT" "$TRAVIS_COMMIT"
+      else CheckTypoTree "$TRAVIS_COMMIT" "$TRAVIS_COMMIT_RANGE"
+      fi
+    fi
+  fi
+  echo complete
+  if [[ -e check-typo-failed ]]
+  then exit 1
+  fi
+}
+
+
+case $CI_KIND in
+build) BuildAndTest;;
+changes)
+    case $TRAVIS_EVENT_TYPE in
+        pull_request) CheckChangesModified;;
+    esac;;
+manual)
+    CheckManual;;
+tests)
+    case $TRAVIS_EVENT_TYPE in
+        pull_request) CheckTestsuiteModified;;
+    esac;;
+check-typo)
+   set +x
+   CheckTypo;;
+*) echo unknown CI kind
+   exit 1
+   ;;
+esac
diff --git a/tools/cmpbyt.ml b/tools/cmpbyt.ml
new file mode 100644
index 00000000..983234fe
--- /dev/null
+++ b/tools/cmpbyt.ml
@@ -0,0 +1,87 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Paris                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Compare two bytecode executables for equality.
+   Ignore loader prefix and debug infos. *)
+
+open Printf
+
+let readtoc ic =
+  Bytesections.read_toc ic;
+  (Bytesections.toc(), Bytesections.pos_first_section ic)
+
+type cmpresult = Same | Differ of int
+
+let rec cmpbytes ic1 ic2 len ofs =
+  if len <= 0 then Same else begin
+    let c1 = input_char ic1 and c2 = input_char ic2 in
+    if c1 = c2 then cmpbytes ic1 ic2 (len - 1) (ofs + 1) else Differ ofs
+  end
+
+let skip_section name =
+  name = "DBUG"
+
+let cmpbyt file1 file2 =
+  let ic1 = open_in_bin file1 in
+  let (toc1, pos1) = readtoc ic1 in
+  let ic2 = open_in_bin file2 in
+  let (toc2, pos2) = readtoc ic2 in
+  seek_in ic1 pos1;
+  seek_in ic2 pos2;
+  let rec cmpsections t1 t2 =
+    match t1, t2 with
+    | [], [] ->
+        true
+    | (name1, len1) :: t1, t2  when skip_section name1 ->
+        seek_in ic1 (pos_in ic1 + len1);
+         cmpsections t1 t2
+    | t1, (name2, len2) :: t2  when skip_section name2 ->
+        seek_in ic2 (pos_in ic2 + len2);
+        cmpsections t1 t2
+    | [], _  ->
+        eprintf "%s has more sections than %s\n" file2 file1;
+        false
+    | _,  [] ->
+        eprintf "%s has more sections than %s\n" file1 file2;
+        false
+    | (name1, len1) :: t1, (name2, len2) :: t2 ->
+        if name1 <> name2 then begin
+          eprintf "Section mismatch: %s (in %s) / %s (in %s)\n"
+                  name1 file1 name2 file2;
+          false
+        end else if len1 <> len2 then begin
+          eprintf "Length of section %s differ: %d (in %s) / %d (in %s)\n"
+                  name1 len1 file1 len2 file2;
+          false
+        end else begin
+          match cmpbytes ic1 ic2 len1 0 with
+          | Differ ofs ->
+              eprintf "Files %s and %s differ: section %s, offset %d\n"
+                      file1 file2 name1 ofs;
+              false
+          | Same ->
+              cmpsections t1 t2
+        end
+  in
+  let res = cmpsections toc1 toc2 in
+  close_in ic1; close_in ic2;
+  res
+
+let _ =
+  if Array.length Sys.argv <> 3 then begin
+    eprintf "Usage: cmpbyt  \n";
+    exit 2
+  end;
+  if cmpbyt Sys.argv.(1) Sys.argv.(2) then exit 0 else exit 1
diff --git a/tools/cvt_emit.mll b/tools/cvt_emit.mll
new file mode 100644
index 00000000..396f644b
--- /dev/null
+++ b/tools/cvt_emit.mll
@@ -0,0 +1,86 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+{
+let first_item = ref false
+let command_beginning = ref 0
+
+let add_semicolon () =
+  if !first_item
+  then first_item := false
+  else print_string "; "
+
+let print_unescaped_string s =
+  let l = String.length s in
+  let i = ref 0 in
+  while !i < l do
+    if s.[!i] = '\\'
+    && !i+1 < l
+    && (let c = s.[!i+1] in c = '{' || c = '`') (* ` *)
+    then i := !i+1;
+    print_char s.[!i];
+    i := !i + 1
+  done
+}
+
+rule main = parse
+    "`" { command_beginning := Lexing.lexeme_start lexbuf;
+          first_item := true;
+          print_char '(';
+          command lexbuf;
+          print_char ')';
+          main lexbuf }
+  | "\\`"
+        { print_string "`"; main lexbuf }
+  | eof { () }
+  | _   { print_char(Lexing.lexeme_char lexbuf 0); main lexbuf }
+
+and command = parse
+    "`" { () }
+  | eof { prerr_string "Unterminated `...` at character ";
+          prerr_int !command_beginning;
+          prerr_newline();
+          exit 2 }
+  | "{" [^ '}'] * "}"
+        { let s = Lexing.lexeme lexbuf in
+          add_semicolon();
+          print_string (String.sub s 1 (String.length s - 2));
+          command lexbuf }
+  | ( [^ '`' '{' '\\'] |
+      '\\' ['\\' '"' 'n' 't' 'b' 'r' '`' '{' ] |
+      '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] |
+      '\\' ('\n' | "\r\n")) +
+        { let s = Lexing.lexeme lexbuf in
+          add_semicolon();
+          (* Optimise one-character strings *)
+          if String.length s = 1 && s.[0] <> '\\' && s.[0] <> '\''
+          || String.length s = 2 && s.[0] = '\\' && s.[1] <> '`' && s.[1]<>'{'
+          (* ` *)
+          then begin
+            print_string "emit_char '";
+            print_unescaped_string s;
+            print_string "'"
+          end else begin
+            print_string "emit_string \"";
+            print_unescaped_string s;
+            print_string "\""
+          end;
+          command lexbuf }
+
+{
+let _ = main(Lexing.from_channel stdin)
+
+let _ = exit (0)
+}
diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml
new file mode 100644
index 00000000..a1fce610
--- /dev/null
+++ b/tools/dumpobj.ml
@@ -0,0 +1,582 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Disassembler for executable and .cmo object files *)
+
+open Asttypes
+open Config
+open Instruct
+open Lambda
+open Location
+open Opcodes
+open Opnames
+open Cmo_format
+open Printf
+
+let print_locations = ref true
+let print_reloc_info = ref false
+
+(* Read signed and unsigned integers *)
+
+let inputu ic =
+  let b1 = input_byte ic in
+  let b2 = input_byte ic in
+  let b3 = input_byte ic in
+  let b4 = input_byte ic in
+  (b4 lsl 24) + (b3 lsl 16) + (b2 lsl 8) + b1
+
+let inputs ic =
+  let b1 = input_byte ic in
+  let b2 = input_byte ic in
+  let b3 = input_byte ic in
+  let b4 = input_byte ic in
+  let b4' = if b4 >= 128 then b4-256 else b4 in
+  (b4' lsl 24) + (b3 lsl 16) + (b2 lsl 8) + b1
+
+(* Global variables *)
+
+type global_table_entry =
+    Empty
+  | Global of Ident.t
+  | Constant of Obj.t
+
+let start = ref 0                              (* Position of beg. of code *)
+let reloc = ref ([] : (reloc_info * int) list) (* Relocation table *)
+let globals = ref ([||] : global_table_entry array) (* Global map *)
+let primitives = ref ([||] : string array)     (* Table of primitives *)
+let objfile = ref false                        (* true if dumping a .cmo *)
+
+(* Events (indexed by PC) *)
+
+let event_table = (Hashtbl.create 253 : (int, debug_event) Hashtbl.t)
+
+let relocate_event orig ev =
+  ev.ev_pos <- orig + ev.ev_pos;
+  match ev.ev_repr with
+    Event_parent repr -> repr := ev.ev_pos
+  | _                 -> ()
+
+let record_events orig evl =
+  List.iter
+    (fun ev ->
+      relocate_event orig ev;
+      Hashtbl.add event_table ev.ev_pos ev)
+    evl
+
+(* Print a structured constant *)
+
+let print_float f =
+  if String.contains f '.'
+  then printf "%s" f
+  else printf "%s." f
+;;
+
+let rec print_struct_const = function
+    Const_base(Const_int i) -> printf "%d" i
+  | Const_base(Const_float f) -> print_float f
+  | Const_base(Const_string (s, _, _)) -> printf "%S" s
+  | Const_immstring s -> printf "%S" s
+  | Const_base(Const_char c) -> printf "%C" c
+  | Const_base(Const_int32 i) -> printf "%ldl" i
+  | Const_base(Const_nativeint i) -> printf "%ndn" i
+  | Const_base(Const_int64 i) -> printf "%LdL" i
+  | Const_pointer n -> printf "%da" n
+  | Const_block(tag, args) ->
+      printf "<%d>" tag;
+      begin match args with
+        [] -> ()
+      | [a1] ->
+          printf "("; print_struct_const a1; printf ")"
+      | a1::al ->
+          printf "("; print_struct_const a1;
+          List.iter (fun a -> printf ", "; print_struct_const a) al;
+          printf ")"
+      end
+  | Const_float_array a ->
+      printf "[|";
+      List.iter (fun f -> print_float f; printf "; ") a;
+      printf "|]"
+
+(* Print an obj *)
+
+let same_custom x y =
+  Obj.field x 0 = Obj.field (Obj.repr y) 0
+
+let rec print_obj x =
+  if Obj.is_block x then begin
+    let tag = Obj.tag x in
+    if tag = Obj.string_tag then
+        printf "%S" (Obj.magic x : string)
+    else if tag = Obj.double_tag then
+        printf "%.12g" (Obj.magic x : float)
+    else if tag = Obj.double_array_tag then begin
+        let a = (Obj.magic x : floatarray) in
+        printf "[|";
+        for i = 0 to Array.Floatarray.length a - 1 do
+          if i > 0 then printf ", ";
+          printf "%.12g" (Array.Floatarray.get a i)
+        done;
+        printf "|]"
+    end else if tag = Obj.custom_tag && same_custom x 0l then
+        printf "%ldl" (Obj.magic x : int32)
+    else if tag = Obj.custom_tag && same_custom x 0n then
+        printf "%ndn" (Obj.magic x : nativeint)
+    else if tag = Obj.custom_tag && same_custom x 0L then
+        printf "%LdL" (Obj.magic x : int64)
+    else if tag < Obj.no_scan_tag then begin
+        printf "<%d>" (Obj.tag x);
+        match Obj.size x with
+          0 -> ()
+        | 1 ->
+            printf "("; print_obj (Obj.field x 0); printf ")"
+        | n ->
+            printf "("; print_obj (Obj.field x 0);
+            for i = 1 to n - 1 do
+              printf ", "; print_obj (Obj.field x i)
+            done;
+            printf ")"
+    end else
+        printf "" tag
+  end else
+    printf "%d" (Obj.magic x : int)
+
+(* Current position in input file *)
+
+let currpos ic =
+  pos_in ic - !start
+
+(* Access in the relocation table *)
+
+let rec rassoc key = function
+    [] -> raise Not_found
+  | (a,b) :: l -> if b = key then a else rassoc key l
+
+let find_reloc ic =
+  rassoc (pos_in ic - !start) !reloc
+
+(* Symbolic printing of global names, etc *)
+
+let print_getglobal_name ic =
+  if !objfile then begin
+    begin try
+      match find_reloc ic with
+          Reloc_getglobal id -> print_string (Ident.name id)
+        | Reloc_literal sc -> print_struct_const sc
+        | _ -> print_string ""
+    with Not_found ->
+      print_string ""
+    end;
+    ignore (inputu ic);
+  end
+  else begin
+    let n = inputu ic in
+    if n >= Array.length !globals || n < 0
+    then print_string ""
+    else match !globals.(n) with
+           Global id -> print_string(Ident.name id)
+         | Constant obj -> print_obj obj
+         | _ -> print_string "???"
+  end
+
+let print_setglobal_name ic =
+  if !objfile then begin
+    begin try
+      match find_reloc ic with
+        Reloc_setglobal id -> print_string (Ident.name id)
+      | _ -> print_string ""
+    with Not_found ->
+      print_string ""
+    end;
+    ignore (inputu ic);
+  end
+  else begin
+    let n = inputu ic in
+    if n >= Array.length !globals || n < 0
+    then print_string ""
+    else match !globals.(n) with
+           Global id -> print_string(Ident.name id)
+         | _ -> print_string "???"
+  end
+
+let print_primitive ic =
+  if !objfile then begin
+    begin try
+      match find_reloc ic with
+        Reloc_primitive s -> print_string s
+      | _ -> print_string ""
+    with Not_found ->
+      print_string ""
+    end;
+    ignore (inputu ic);
+  end
+  else begin
+    let n = inputu ic in
+    if n >= Array.length !primitives || n < 0
+    then print_int n
+    else print_string !primitives.(n)
+  end
+
+(* Disassemble one instruction *)
+
+let currpc ic =
+  currpos ic / 4
+
+type shape =
+  | Nothing
+  | Uint
+  | Sint
+  | Uint_Uint
+  | Disp
+  | Uint_Disp
+  | Sint_Disp
+  | Getglobal
+  | Getglobal_Uint
+  | Setglobal
+  | Primitive
+  | Uint_Primitive
+  | Switch
+  | Closurerec
+  | Pubmet
+;;
+
+let op_shapes = [
+  opACC0, Nothing;
+  opACC1, Nothing;
+  opACC2, Nothing;
+  opACC3, Nothing;
+  opACC4, Nothing;
+  opACC5, Nothing;
+  opACC6, Nothing;
+  opACC7, Nothing;
+  opACC, Uint;
+  opPUSH, Nothing;
+  opPUSHACC0, Nothing;
+  opPUSHACC1, Nothing;
+  opPUSHACC2, Nothing;
+  opPUSHACC3, Nothing;
+  opPUSHACC4, Nothing;
+  opPUSHACC5, Nothing;
+  opPUSHACC6, Nothing;
+  opPUSHACC7, Nothing;
+  opPUSHACC, Uint;
+  opPOP, Uint;
+  opASSIGN, Uint;
+  opENVACC1, Nothing;
+  opENVACC2, Nothing;
+  opENVACC3, Nothing;
+  opENVACC4, Nothing;
+  opENVACC, Uint;
+  opPUSHENVACC1, Nothing;
+  opPUSHENVACC2, Nothing;
+  opPUSHENVACC3, Nothing;
+  opPUSHENVACC4, Nothing;
+  opPUSHENVACC, Uint;
+  opPUSH_RETADDR, Disp;
+  opAPPLY, Uint;
+  opAPPLY1, Nothing;
+  opAPPLY2, Nothing;
+  opAPPLY3, Nothing;
+  opAPPTERM, Uint_Uint;
+  opAPPTERM1, Uint;
+  opAPPTERM2, Uint;
+  opAPPTERM3, Uint;
+  opRETURN, Uint;
+  opRESTART, Nothing;
+  opGRAB, Uint;
+  opCLOSURE, Uint_Disp;
+  opCLOSUREREC, Closurerec;
+  opOFFSETCLOSUREM2, Nothing;
+  opOFFSETCLOSURE0, Nothing;
+  opOFFSETCLOSURE2, Nothing;
+  opOFFSETCLOSURE, Sint;  (* was Uint *)
+  opPUSHOFFSETCLOSUREM2, Nothing;
+  opPUSHOFFSETCLOSURE0, Nothing;
+  opPUSHOFFSETCLOSURE2, Nothing;
+  opPUSHOFFSETCLOSURE, Sint; (* was Nothing *)
+  opGETGLOBAL, Getglobal;
+  opPUSHGETGLOBAL, Getglobal;
+  opGETGLOBALFIELD, Getglobal_Uint;
+  opPUSHGETGLOBALFIELD, Getglobal_Uint;
+  opSETGLOBAL, Setglobal;
+  opATOM0, Nothing;
+  opATOM, Uint;
+  opPUSHATOM0, Nothing;
+  opPUSHATOM, Uint;
+  opMAKEBLOCK, Uint_Uint;
+  opMAKEBLOCK1, Uint;
+  opMAKEBLOCK2, Uint;
+  opMAKEBLOCK3, Uint;
+  opMAKEFLOATBLOCK, Uint;
+  opGETFIELD0, Nothing;
+  opGETFIELD1, Nothing;
+  opGETFIELD2, Nothing;
+  opGETFIELD3, Nothing;
+  opGETFIELD, Uint;
+  opGETFLOATFIELD, Uint;
+  opSETFIELD0, Nothing;
+  opSETFIELD1, Nothing;
+  opSETFIELD2, Nothing;
+  opSETFIELD3, Nothing;
+  opSETFIELD, Uint;
+  opSETFLOATFIELD, Uint;
+  opVECTLENGTH, Nothing;
+  opGETVECTITEM, Nothing;
+  opSETVECTITEM, Nothing;
+  opGETSTRINGCHAR, Nothing;
+  opGETBYTESCHAR, Nothing;
+  opSETBYTESCHAR, Nothing;
+  opBRANCH, Disp;
+  opBRANCHIF, Disp;
+  opBRANCHIFNOT, Disp;
+  opSWITCH, Switch;
+  opBOOLNOT, Nothing;
+  opPUSHTRAP, Disp;
+  opPOPTRAP, Nothing;
+  opRAISE, Nothing;
+  opCHECK_SIGNALS, Nothing;
+  opC_CALL1, Primitive;
+  opC_CALL2, Primitive;
+  opC_CALL3, Primitive;
+  opC_CALL4, Primitive;
+  opC_CALL5, Primitive;
+  opC_CALLN, Uint_Primitive;
+  opCONST0, Nothing;
+  opCONST1, Nothing;
+  opCONST2, Nothing;
+  opCONST3, Nothing;
+  opCONSTINT, Sint;
+  opPUSHCONST0, Nothing;
+  opPUSHCONST1, Nothing;
+  opPUSHCONST2, Nothing;
+  opPUSHCONST3, Nothing;
+  opPUSHCONSTINT, Sint;
+  opNEGINT, Nothing;
+  opADDINT, Nothing;
+  opSUBINT, Nothing;
+  opMULINT, Nothing;
+  opDIVINT, Nothing;
+  opMODINT, Nothing;
+  opANDINT, Nothing;
+  opORINT, Nothing;
+  opXORINT, Nothing;
+  opLSLINT, Nothing;
+  opLSRINT, Nothing;
+  opASRINT, Nothing;
+  opEQ, Nothing;
+  opNEQ, Nothing;
+  opLTINT, Nothing;
+  opLEINT, Nothing;
+  opGTINT, Nothing;
+  opGEINT, Nothing;
+  opOFFSETINT, Sint;
+  opOFFSETREF, Sint;
+  opISINT, Nothing;
+  opGETMETHOD, Nothing;
+  opGETDYNMET, Nothing;
+  opGETPUBMET, Pubmet;
+  opBEQ, Sint_Disp;
+  opBNEQ, Sint_Disp;
+  opBLTINT, Sint_Disp;
+  opBLEINT, Sint_Disp;
+  opBGTINT, Sint_Disp;
+  opBGEINT, Sint_Disp;
+  opULTINT, Nothing;
+  opUGEINT, Nothing;
+  opBULTINT, Uint_Disp;
+  opBUGEINT, Uint_Disp;
+  opSTOP, Nothing;
+  opEVENT, Nothing;
+  opBREAK, Nothing;
+  opRERAISE, Nothing;
+  opRAISE_NOTRACE, Nothing;
+];;
+
+let print_event ev =
+  if !print_locations then
+    let ls = ev.ev_loc.loc_start in
+    let le = ev.ev_loc.loc_end in
+    printf "File \"%s\", line %d, characters %d-%d:\n" ls.Lexing.pos_fname
+      ls.Lexing.pos_lnum (ls.Lexing.pos_cnum - ls.Lexing.pos_bol)
+      (le.Lexing.pos_cnum - ls.Lexing.pos_bol)
+
+let print_instr ic =
+  let pos = currpos ic in
+  List.iter print_event (Hashtbl.find_all event_table pos);
+  printf "%8d  " (pos / 4);
+  let op = inputu ic in
+  if op >= Array.length names_of_instructions || op < 0
+  then (print_string "*** unknown opcode : "; print_int op)
+  else print_string names_of_instructions.(op);
+  begin try
+    let shape = List.assoc op op_shapes in
+    if shape <> Nothing then print_string " ";
+    match shape with
+    | Uint -> print_int (inputu ic)
+    | Sint -> print_int (inputs ic)
+    | Uint_Uint
+       -> print_int (inputu ic); print_string ", "; print_int (inputu ic)
+    | Disp -> let p = currpc ic in print_int (p + inputs ic)
+    | Uint_Disp
+       -> print_int (inputu ic); print_string ", ";
+          let p = currpc ic in print_int (p + inputs ic)
+    | Sint_Disp
+       -> print_int (inputs ic); print_string ", ";
+          let p = currpc ic in print_int (p + inputs ic)
+    | Getglobal -> print_getglobal_name ic
+    | Getglobal_Uint
+       -> print_getglobal_name ic; print_string ", "; print_int (inputu ic)
+    | Setglobal -> print_setglobal_name ic
+    | Primitive -> print_primitive ic
+    | Uint_Primitive
+       -> print_int(inputu ic); print_string ", "; print_primitive ic
+    | Switch
+       -> let n = inputu ic in
+          let orig = currpc ic in
+          for i = 0 to (n land 0xFFFF) - 1 do
+            print_string "\n        int "; print_int i; print_string " -> ";
+            print_int(orig + inputs ic);
+          done;
+          for i = 0 to (n lsr 16) - 1 do
+            print_string "\n        tag "; print_int i; print_string " -> ";
+            print_int(orig + inputs ic);
+          done;
+    | Closurerec
+       -> let nfuncs = inputu ic in
+          let nvars = inputu ic in
+          let orig = currpc ic in
+          print_int nvars;
+          for _i = 0 to nfuncs - 1 do
+            print_string ", ";
+            print_int (orig + inputs ic);
+          done;
+    | Pubmet
+       -> let tag = inputs ic in
+          let _cache = inputu ic in
+          print_int tag
+    | Nothing -> ()
+  with Not_found -> print_string " (unknown arguments)"
+  end;
+  print_string "\n";
+;;
+
+(* Disassemble a block of code *)
+
+let print_code ic len =
+  start := pos_in ic;
+  let stop = !start + len in
+  while pos_in ic < stop do print_instr ic done
+
+(* Dump relocation info *)
+
+let print_reloc (info, pos) =
+  printf "    %d    (%d)    " pos (pos/4);
+  match info with
+    Reloc_literal sc -> print_struct_const sc; printf "\n"
+  | Reloc_getglobal id -> printf "require    %s\n" (Ident.name id)
+  | Reloc_setglobal id -> printf "provide    %s\n" (Ident.name id)
+  | Reloc_primitive s -> printf "prim    %s\n" s
+
+(* Print a .cmo file *)
+
+let dump_obj ic =
+  let buffer = really_input_string ic (String.length cmo_magic_number) in
+  if buffer <> cmo_magic_number then begin
+    prerr_endline "Not an object file"; exit 2
+  end;
+  let cu_pos = input_binary_int ic in
+  seek_in ic cu_pos;
+  let cu = (input_value ic : compilation_unit) in
+  reloc := cu.cu_reloc;
+  if !print_reloc_info then
+    List.iter print_reloc cu.cu_reloc;
+  if cu.cu_debug > 0 then begin
+    seek_in ic cu.cu_debug;
+    let evl = (input_value ic : debug_event list) in
+    ignore (input_value ic); (* Skip the list of absolute directory names *)
+    record_events 0 evl
+  end;
+  seek_in ic cu.cu_pos;
+  print_code ic cu.cu_codesize
+
+(* Read the primitive table from an executable *)
+
+let read_primitive_table ic len =
+  let p = really_input_string ic len in
+  String.split_on_char '\000' p |> List.filter ((<>) "") |> Array.of_list
+
+(* Print an executable file *)
+
+let dump_exe ic =
+  Bytesections.read_toc ic;
+  let prim_size = Bytesections.seek_section ic "PRIM" in
+  primitives := read_primitive_table ic prim_size;
+  ignore(Bytesections.seek_section ic "DATA");
+  let init_data = (input_value ic : Obj.t array) in
+  globals := Array.make (Array.length init_data) Empty;
+  for i = 0 to Array.length init_data - 1 do
+    !globals.(i) <- Constant (init_data.(i))
+  done;
+  ignore(Bytesections.seek_section ic "SYMB");
+  let sym_table = (input_value ic : Symtable.global_map) in
+  Symtable.iter_global_map
+    (fun id pos -> !globals.(pos) <- Global id) sym_table;
+  begin try
+    ignore (Bytesections.seek_section ic "DBUG");
+    let num_eventlists = input_binary_int ic in
+    for _i = 1 to num_eventlists do
+      let orig = input_binary_int ic in
+      let evl = (input_value ic : debug_event list) in
+      ignore (input_value ic); (* Skip the list of absolute directory names *)
+      record_events orig evl
+    done
+  with Not_found -> ()
+  end;
+  let code_size = Bytesections.seek_section ic "CODE" in
+  print_code ic code_size
+
+let arg_list = [
+  "-noloc", Arg.Clear print_locations, " : don't print source information";
+  "-reloc", Arg.Set print_reloc_info, " : print relocation information";
+  "-args", Arg.Expand Arg.read_arg,
+     " Read additional newline separated command line arguments \n\
+     \      from ";
+  "-args0", Arg.Expand Arg.read_arg0,
+     " Read additional NUL separated command line arguments from \n\
+     \      ";
+]
+let arg_usage =
+  Printf.sprintf "%s [OPTIONS] FILES : dump content of bytecode files"
+                 Sys.argv.(0)
+
+let first_file = ref true
+
+let arg_fun filename =
+  let ic = open_in_bin filename in
+  if not !first_file then print_newline ();
+  first_file := false;
+  printf "## start of ocaml dump of %S\n%!" filename;
+  begin try
+          objfile := false; dump_exe ic
+    with Bytesections.Bad_magic_number ->
+      objfile := true; seek_in ic 0; dump_obj ic
+  end;
+  close_in ic;
+  printf "## end of ocaml dump of %S\n%!" filename
+
+let main() =
+  Arg.parse_expand arg_list arg_fun arg_usage;
+    exit 0
+
+let _ = main ()
diff --git a/tools/dune b/tools/dune
new file mode 100644
index 00000000..91a71fdc
--- /dev/null
+++ b/tools/dune
@@ -0,0 +1,25 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+(executables
+ (names   make_opcodes cvt_emit)
+ (modules make_opcodes cvt_emit))
+
+(ocamllex
+ (modules make_opcodes)
+ (mode    fallback))
+
+(ocamllex
+ (modules cvt_emit)
+ (mode    fallback))
diff --git a/tools/eqparsetree.ml b/tools/eqparsetree.ml
new file mode 100644
index 00000000..9630fcd8
--- /dev/null
+++ b/tools/eqparsetree.ml
@@ -0,0 +1,792 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*    Hongbo Zhang (University of Pennsylvania)                           *)
+(*                                                                        *)
+(*   Copyright 2007 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 is mainly used to diff two parsetree, it helps to automate the
+  test for parsing/pprintast.ml
+ *)
+
+
+open Parsetree
+let curry f (g, h) = f g h
+let eq_int : (int*int)->bool = curry (=)
+let eq_char : (char*char)->bool=curry (=)
+let eq_string : (string*string)->bool = curry (=)
+let eq_int32 : (int32*int32)->bool=curry (=)
+let eq_int64 : (int64*int64)->bool =curry (=)
+let eq_nativeint : (nativeint*nativeint)->bool= curry (=)
+let eq_bool :(bool*bool) -> bool = curry (=)
+let eq_list mf_a (xs, ys) =
+  let rec loop =
+    function
+      | ([], []) -> true
+        | (x :: xs, y :: ys) -> (mf_a (x, y)) && (loop (xs, ys))
+        | (_, _) -> false
+  in loop (xs, ys)
+let eq_option mf_a (x, y) =
+  match (x, y) with
+  | (None, None) -> true
+  | (Some x, Some y) -> mf_a (x, y)
+  | (_, _) -> false
+
+module Location =struct
+  include Location
+  let eq_t : (t*t) -> bool = fun (_,_) -> true
+end
+module Longident = struct
+  include Longident
+  let rec eq_t : (t * t) -> 'result =
+    function
+    | (Lident a0, Lident b0) -> eq_string (a0, b0)
+    | (Ldot (a0, a1), Ldot (b0, b1)) ->
+      (eq_t (a0, b0)) && (eq_string (a1, b1))
+    | (Lapply (a0, a1), Lapply (b0, b1)) ->
+      (eq_t (a0, b0)) && (eq_t (a1, b1))
+    | (_, _) -> false
+end
+module Asttypes = struct
+  open Asttypes
+  let eq_constant : (constant * constant) -> 'result =
+    function
+    | (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)
+    | (Const_float a0, Const_float b0) -> eq_string (a0, b0)
+    | (Const_int32 a0, Const_int32 b0) -> eq_int32 (a0, b0)
+    | (Const_int64 a0, Const_int64 b0) -> eq_int64 (a0, b0)
+    | (Const_nativeint a0, Const_nativeint b0) -> eq_nativeint (a0, b0)
+    | (_, _) -> false
+
+  let eq_rec_flag : (rec_flag * rec_flag) -> 'result =
+    function
+    | (Nonrecursive, Nonrecursive) -> true
+    | (Recursive, Recursive) -> true
+    | (Default, Default) -> true
+    | (_, _) -> false
+
+  let eq_direction_flag :
+    (direction_flag * direction_flag) -> 'result =
+    function
+    | (Upto, Upto) -> true
+    | (Downto, Downto) -> true
+    | (_, _) -> false
+
+  let eq_private_flag : (private_flag * private_flag) -> 'result =
+    function
+    | (Private, Private) -> true
+    | (Public, Public) -> true
+    | (_, _) -> false
+
+  let eq_mutable_flag : (mutable_flag * mutable_flag) -> 'result =
+    function
+    | (Immutable, Immutable) -> true
+    | (Mutable, Mutable) -> true
+    | (_, _) -> false
+
+  let eq_virtual_flag : (virtual_flag * virtual_flag) -> 'result =
+    function
+    | (Virtual, Virtual) -> true
+    | (Concrete, Concrete) -> true
+    | (_, _) -> false
+
+  let eq_override_flag : (override_flag * override_flag) -> 'result =
+    function
+    | (Override, Override) -> true
+    | (Fresh, Fresh) -> true
+    | (_, _) -> false
+
+  let eq_closed_flag : (closed_flag * closed_flag) -> 'result =
+    function
+    | (Closed, Closed) -> true
+    | (Open, Open) -> true
+    | (_, _) -> false
+
+  let eq_label : (label * label) -> 'result =
+    fun (a0, a1) -> eq_string (a0, a1)
+
+  let  eq_loc :
+    'all_a0.
+      (('all_a0 * 'all_a0) -> 'result) ->
+        (('all_a0 loc) * ('all_a0 loc)) -> 'result =
+    fun mf_a ({ txt = a0; loc = a1 }, { txt = b0; loc = b1 }) ->
+      (mf_a (a0, b0)) && (Location.eq_t (a1, b1))
+
+end
+
+let rec eq_row_field : (row_field * row_field) -> 'result =
+  function
+  | (Rtag (a0, a1, a2), Rtag (b0, b1, b2)) ->
+      ((Asttypes.eq_label (a0, b0)) && (eq_bool (a1, b1))) &&
+        (eq_list eq_core_type (a2, b2))
+  | (Rinherit a0, Rinherit b0) -> eq_core_type (a0, b0)
+  | (_, _) -> false
+and eq_core_field_desc :
+  (core_field_desc * core_field_desc) -> 'result =
+  function
+  | (Pfield (a0, a1), Pfield (b0, b1)) ->
+      (eq_string (a0, b0)) && (eq_core_type (a1, b1))
+  | (Pfield_var, Pfield_var) -> true
+  | (_, _) -> false
+and eq_core_field_type :
+  (core_field_type * core_field_type) -> 'result =
+  fun
+    ({ pfield_desc = a0; pfield_loc = a1 },
+     { pfield_desc = b0; pfield_loc = b1 })
+    -> (eq_core_field_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_package_type : (package_type * package_type) -> 'result =
+  fun (a0, a1) ->
+    (fun ((a0, a1), (b0, b1)) ->
+       (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+         (eq_list
+            (fun ((a0, a1), (b0, b1)) ->
+               (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+                 (eq_core_type (a1, b1)))
+            (a1, b1)))
+      (a0, a1)
+and eq_core_type_desc :
+  (core_type_desc * core_type_desc) -> 'result =
+  function
+  | (Ptyp_any, Ptyp_any) -> true
+  | (Ptyp_var a0, Ptyp_var b0) -> eq_string (a0, b0)
+  | (Ptyp_arrow (a0, a1, a2), Ptyp_arrow (b0, b1, b2)) ->
+      ((Asttypes.eq_label (a0, b0)) && (eq_core_type (a1, b1))) &&
+        (eq_core_type (a2, b2))
+  | (Ptyp_tuple a0, Ptyp_tuple b0) -> eq_list eq_core_type (a0, b0)
+  | (Ptyp_constr (a0, a1), Ptyp_constr (b0, b1)) ->
+      (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+        (eq_list eq_core_type (a1, b1))
+  | (Ptyp_object a0, Ptyp_object b0) ->
+      eq_list eq_core_field_type (a0, b0)
+  | (Ptyp_class (a0, a1, a2), Ptyp_class (b0, b1, b2)) ->
+      ((Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+         (eq_list eq_core_type (a1, b1)))
+        && (eq_list Asttypes.eq_label (a2, b2))
+  | (Ptyp_alias (a0, a1), Ptyp_alias (b0, b1)) ->
+      (eq_core_type (a0, b0)) && (eq_string (a1, b1))
+  | (Ptyp_variant (a0, a1, a2), Ptyp_variant (b0, b1, b2)) ->
+      ((eq_list eq_row_field (a0, b0)) && (eq_bool (a1, b1))) &&
+        (eq_option (eq_list Asttypes.eq_label) (a2, b2))
+  | (Ptyp_poly (a0, a1), Ptyp_poly (b0, b1)) ->
+      (eq_list eq_string (a0, b0)) && (eq_core_type (a1, b1))
+  | (Ptyp_package a0, Ptyp_package b0) -> eq_package_type (a0, b0)
+  | (_, _) -> false
+and eq_core_type : (core_type * core_type) -> 'result =
+  fun
+    ({ ptyp_desc = a0; ptyp_loc = a1 },
+     { ptyp_desc = b0; ptyp_loc = b1 })
+    -> (eq_core_type_desc (a0, b0)) && (Location.eq_t (a1, b1))
+
+let eq_class_infos :
+  'all_a0.
+    (('all_a0 * 'all_a0) -> 'result) ->
+      (('all_a0 class_infos) * ('all_a0 class_infos)) -> 'result =
+  fun mf_a
+    ({
+       pci_virt = a0;
+       pci_params = a1;
+       pci_name = a2;
+       pci_expr = a3;
+       pci_variance = a4;
+       pci_loc = a5
+     },
+     {
+       pci_virt = b0;
+       pci_params = b1;
+       pci_name = b2;
+       pci_expr = b3;
+       pci_variance = b4;
+       pci_loc = b5
+     })
+    ->
+    (((((Asttypes.eq_virtual_flag (a0, b0)) &&
+          ((fun ((a0, a1), (b0, b1)) ->
+              (eq_list (Asttypes.eq_loc eq_string) (a0, b0)) &&
+                (Location.eq_t (a1, b1)))
+             (a1, b1)))
+         && (Asttypes.eq_loc eq_string (a2, b2)))
+        && (mf_a (a3, b3)))
+       &&
+       (eq_list
+          (fun ((a0, a1), (b0, b1)) ->
+             (eq_bool (a0, b0)) && (eq_bool (a1, b1)))
+          (a4, b4)))
+      && (Location.eq_t (a5, b5))
+
+let rec eq_pattern_desc : (pattern_desc * pattern_desc) -> 'result =
+  function
+  | (Ppat_any, Ppat_any) -> true
+  | (Ppat_var a0, Ppat_var b0) -> Asttypes.eq_loc eq_string (a0, b0)
+  | (Ppat_alias (a0, a1), Ppat_alias (b0, b1)) ->
+      (eq_pattern (a0, b0)) && (Asttypes.eq_loc eq_string (a1, b1))
+  | (Ppat_constant a0, Ppat_constant b0) ->
+      Asttypes.eq_constant (a0, b0)
+  | (Ppat_tuple a0, Ppat_tuple b0) -> eq_list eq_pattern (a0, b0)
+  | (Ppat_construct (a0, a1), Ppat_construct (b0, b1)) ->
+      ((Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+         (eq_option eq_pattern (a1, b1)))
+  | (Ppat_variant (a0, a1), Ppat_variant (b0, b1)) ->
+      (Asttypes.eq_label (a0, b0)) && (eq_option eq_pattern (a1, b1))
+  | (Ppat_record (a0, a1), Ppat_record (b0, b1)) ->
+      (eq_list
+         (fun ((a0, a1), (b0, b1)) ->
+            (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+              (eq_pattern (a1, b1)))
+         (a0, b0))
+        && (Asttypes.eq_closed_flag (a1, b1))
+  | (Ppat_array a0, Ppat_array b0) -> eq_list eq_pattern (a0, b0)
+  | (Ppat_or (a0, a1), Ppat_or (b0, b1)) ->
+      (eq_pattern (a0, b0)) && (eq_pattern (a1, b1))
+  | (Ppat_constraint (a0, a1), Ppat_constraint (b0, b1)) ->
+      (eq_pattern (a0, b0)) && (eq_core_type (a1, b1))
+  | (Ppat_type a0, Ppat_type b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Ppat_lazy a0, Ppat_lazy b0) -> eq_pattern (a0, b0)
+  | (Ppat_unpack a0, Ppat_unpack b0) ->
+      Asttypes.eq_loc eq_string (a0, b0)
+  | (_, _) -> false
+and eq_pattern : (pattern * pattern) -> 'result =
+  fun
+    ({ ppat_desc = a0; ppat_loc = a1 },
+     { ppat_desc = b0; ppat_loc = b1 })
+    -> (eq_pattern_desc (a0, b0)) && (Location.eq_t (a1, b1))
+
+let rec eq_structure_item_desc :
+  (structure_item_desc * structure_item_desc) -> 'result =
+  function
+  | (Pstr_eval a0, Pstr_eval b0) -> eq_expression (a0, b0)
+  | (Pstr_value (a0, a1), Pstr_value (b0, b1)) ->
+      (Asttypes.eq_rec_flag (a0, b0)) &&
+        (eq_list
+           (fun ((a0, a1), (b0, b1)) ->
+              (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
+           (a1, b1))
+  | (Pstr_primitive (a0, a1), Pstr_primitive (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_value_description (a1, b1))
+  | (Pstr_type (a0, a1), Pstr_type (b0, b1)) ->
+      (Asttypes.eq_rec_flag (a0, b0)) &&
+      eq_list
+        (fun ((a0, a1), (b0, b1)) ->
+           (Asttypes.eq_loc eq_string (a0, b0)) &&
+             (eq_type_declaration (a1, b1)))
+        (a1, b1)
+  | (Pstr_exception (a0, a1), Pstr_exception (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_exception_declaration (a1, b1))
+  | (Pstr_exn_rebind (a0, a1), Pstr_exn_rebind (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (Asttypes.eq_loc Longident.eq_t (a1, b1))
+  | (Pstr_module (a0, a1), Pstr_module (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_module_expr (a1, b1))
+  | (Pstr_recmodule a0, Pstr_recmodule b0) ->
+      eq_list
+        (fun ((a0, a1, a2), (b0, b1, b2)) ->
+           ((Asttypes.eq_loc eq_string (a0, b0)) &&
+              (eq_module_type (a1, b1)))
+             && (eq_module_expr (a2, b2)))
+        (a0, b0)
+  | (Pstr_modtype (a0, a1), Pstr_modtype (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_module_type (a1, b1))
+  | (Pstr_open a0, Pstr_open b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Pstr_class a0, Pstr_class b0) ->
+      eq_list eq_class_declaration (a0, b0)
+  | (Pstr_class_type a0, Pstr_class_type b0) ->
+      eq_list eq_class_type_declaration (a0, b0)
+  | (Pstr_include a0, Pstr_include b0) -> eq_module_expr (a0, b0)
+  | (_, _) -> false
+and eq_structure_item :
+  (structure_item * structure_item) -> 'result =
+  fun
+    ({ pstr_desc = a0; pstr_loc = a1 },
+     { pstr_desc = b0; pstr_loc = b1 })
+    -> (eq_structure_item_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_structure : (structure * structure) -> 'result =
+  fun (a0, a1) -> eq_list eq_structure_item (a0, a1)
+and eq_module_expr_desc :
+  (module_expr_desc * module_expr_desc) -> 'result =
+  function
+  | (Pmod_ident a0, Pmod_ident b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Pmod_structure a0, Pmod_structure b0) -> eq_structure (a0, b0)
+  | (Pmod_functor (a0, a1, a2), Pmod_functor (b0, b1, b2)) ->
+      ((Asttypes.eq_loc eq_string (a0, b0)) &&
+         (eq_module_type (a1, b1)))
+        && (eq_module_expr (a2, b2))
+  | (Pmod_apply (a0, a1), Pmod_apply (b0, b1)) ->
+      (eq_module_expr (a0, b0)) && (eq_module_expr (a1, b1))
+  | (Pmod_constraint (a0, a1), Pmod_constraint (b0, b1)) ->
+      (eq_module_expr (a0, b0)) && (eq_module_type (a1, b1))
+  | (Pmod_unpack a0, Pmod_unpack b0) -> eq_expression (a0, b0)
+  | (_, _) -> false
+and eq_module_expr : (module_expr * module_expr) -> 'result =
+  fun
+    ({ pmod_desc = a0; pmod_loc = a1 },
+     { pmod_desc = b0; pmod_loc = b1 })
+    -> (eq_module_expr_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_with_constraint :
+  (with_constraint * with_constraint) -> 'result =
+  function
+  | (Pwith_type a0, Pwith_type b0) -> eq_type_declaration (a0, b0)
+  | (Pwith_module a0, Pwith_module b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Pwith_typesubst a0, Pwith_typesubst b0) ->
+      eq_type_declaration (a0, b0)
+  | (Pwith_modsubst a0, Pwith_modsubst b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (_, _) -> false
+and eq_modtype_declaration :
+  (modtype_declaration * modtype_declaration) -> 'result =
+  function
+  | (Pmodtype_abstract, Pmodtype_abstract) -> true
+  | (Pmodtype_manifest a0, Pmodtype_manifest b0) ->
+      eq_module_type (a0, b0)
+  | (_, _) -> false
+and eq_signature_item_desc :
+  (signature_item_desc * signature_item_desc) -> 'result =
+  function
+  | (Psig_value (a0, a1), Psig_value (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_value_description (a1, b1))
+  | (Psig_type (a0, a1), Psig_type (b0, b1)) ->
+      (Asttypes.eq_rec_flag (a0, b0)) &&
+      eq_list
+        (fun ((a0, a1), (b0, b1)) ->
+           (Asttypes.eq_loc eq_string (a0, b0)) &&
+             (eq_type_declaration (a1, b1)))
+        (a1, b1)
+  | (Psig_exception (a0, a1), Psig_exception (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_exception_declaration (a1, b1))
+  | (Psig_module (a0, a1), Psig_module (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_module_type (a1, b1))
+  | (Psig_recmodule a0, Psig_recmodule b0) ->
+      eq_list
+        (fun ((a0, a1), (b0, b1)) ->
+           (Asttypes.eq_loc eq_string (a0, b0)) &&
+             (eq_module_type (a1, b1)))
+        (a0, b0)
+  | (Psig_modtype (a0, a1), Psig_modtype (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_modtype_declaration (a1, b1))
+  | (Psig_open a0, Psig_open b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Psig_include a0, Psig_include b0) -> eq_module_type (a0, b0)
+  | (Psig_class a0, Psig_class b0) ->
+      eq_list eq_class_description (a0, b0)
+  | (Psig_class_type a0, Psig_class_type b0) ->
+      eq_list eq_class_type_declaration (a0, b0)
+  | (_, _) -> false
+and eq_signature_item :
+  (signature_item * signature_item) -> 'result =
+  fun
+    ({ psig_desc = a0; psig_loc = a1 },
+     { psig_desc = b0; psig_loc = b1 })
+    -> (eq_signature_item_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_signature : (signature * signature) -> 'result =
+  fun (a0, a1) -> eq_list eq_signature_item (a0, a1)
+and eq_module_type_desc :
+  (module_type_desc * module_type_desc) -> 'result =
+  function
+  | (Pmty_ident a0, Pmty_ident b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Pmty_signature a0, Pmty_signature b0) -> eq_signature (a0, b0)
+  | (Pmty_functor (a0, a1, a2), Pmty_functor (b0, b1, b2)) ->
+      ((Asttypes.eq_loc eq_string (a0, b0)) &&
+         (eq_module_type (a1, b1)))
+        && (eq_module_type (a2, b2))
+  | (Pmty_with (a0, a1), Pmty_with (b0, b1)) ->
+      (eq_module_type (a0, b0)) &&
+        (eq_list
+           (fun ((a0, a1), (b0, b1)) ->
+              (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+                (eq_with_constraint (a1, b1)))
+           (a1, b1))
+  | (Pmty_typeof a0, Pmty_typeof b0) -> eq_module_expr (a0, b0)
+  | (_, _) -> false
+and eq_module_type : (module_type * module_type) -> 'result =
+  fun
+    ({ pmty_desc = a0; pmty_loc = a1 },
+     { pmty_desc = b0; pmty_loc = b1 })
+    -> (eq_module_type_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_class_declaration :
+  (class_declaration * class_declaration) -> 'result =
+  fun (a0, a1) -> eq_class_infos eq_class_expr (a0, a1)
+and eq_class_field_desc :
+  (class_field_desc * class_field_desc) -> 'result =
+  function
+  | (Pcf_inher (a0, a1, a2), Pcf_inher (b0, b1, b2)) ->
+      ((Asttypes.eq_override_flag (a0, b0)) &&
+         (eq_class_expr (a1, b1)))
+        && (eq_option eq_string (a2, b2))
+  | (Pcf_valvirt a0, Pcf_valvirt b0) ->
+      (fun ((a0, a1, a2), (b0, b1, b2)) ->
+         ((Asttypes.eq_loc eq_string (a0, b0)) &&
+            (Asttypes.eq_mutable_flag (a1, b1)))
+           && (eq_core_type (a2, b2)))
+        (a0, b0)
+  | (Pcf_val a0, Pcf_val b0) ->
+      (fun ((a0, a1, a2, a3), (b0, b1, b2, b3)) ->
+         (((Asttypes.eq_loc eq_string (a0, b0)) &&
+             (Asttypes.eq_mutable_flag (a1, b1)))
+            && (Asttypes.eq_override_flag (a2, b2)))
+           && (eq_expression (a3, b3)))
+        (a0, b0)
+  | (Pcf_virt a0, Pcf_virt b0) ->
+      (fun ((a0, a1, a2), (b0, b1, b2)) ->
+         ((Asttypes.eq_loc eq_string (a0, b0)) &&
+            (Asttypes.eq_private_flag (a1, b1)))
+           && (eq_core_type (a2, b2)))
+        (a0, b0)
+  | (Pcf_meth a0, Pcf_meth b0) ->
+      (fun ((a0, a1, a2, a3), (b0, b1, b2, b3)) ->
+         (((Asttypes.eq_loc eq_string (a0, b0)) &&
+             (Asttypes.eq_private_flag (a1, b1)))
+            && (Asttypes.eq_override_flag (a2, b2)))
+           && (eq_expression (a3, b3)))
+        (a0, b0)
+  | (Pcf_constr a0, Pcf_constr b0) ->
+      (fun ((a0, a1), (b0, b1)) ->
+         (eq_core_type (a0, b0)) && (eq_core_type (a1, b1)))
+        (a0, b0)
+  | (Pcf_init a0, Pcf_init b0) -> eq_expression (a0, b0)
+  | (_, _) -> false
+and eq_class_field : (class_field * class_field) -> 'result =
+  fun
+    ({ pcf_desc = a0; pcf_loc = a1 }, { pcf_desc = b0; pcf_loc = b1
+     })
+    -> (eq_class_field_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_class_structure :
+  (class_structure * class_structure) -> 'result =
+  fun
+    ({ pcstr_self = a0; pcstr_fields = a1 },
+     { pcstr_self = b0; pcstr_fields = b1 })
+    -> (eq_pattern (a0, b0)) && (eq_list eq_class_field (a1, b1))
+and eq_class_expr_desc :
+  (class_expr_desc * class_expr_desc) -> 'result =
+  function
+  | (Pcl_constr (a0, a1), Pcl_constr (b0, b1)) ->
+      (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+        (eq_list eq_core_type (a1, b1))
+  | (Pcl_structure a0, Pcl_structure b0) ->
+      eq_class_structure (a0, b0)
+  | (Pcl_fun (a0, a1, a2, a3), Pcl_fun (b0, b1, b2, b3)) ->
+      (((Asttypes.eq_label (a0, b0)) &&
+          (eq_option eq_expression (a1, b1)))
+         && (eq_pattern (a2, b2)))
+        && (eq_class_expr (a3, b3))
+  | (Pcl_apply (a0, a1), Pcl_apply (b0, b1)) ->
+      (eq_class_expr (a0, b0)) &&
+        (eq_list
+           (fun ((a0, a1), (b0, b1)) ->
+              (Asttypes.eq_label (a0, b0)) &&
+                (eq_expression (a1, b1)))
+           (a1, b1))
+  | (Pcl_let (a0, a1, a2), Pcl_let (b0, b1, b2)) ->
+      ((Asttypes.eq_rec_flag (a0, b0)) &&
+         (eq_list
+            (fun ((a0, a1), (b0, b1)) ->
+               (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
+            (a1, b1)))
+        && (eq_class_expr (a2, b2))
+  | (Pcl_constraint (a0, a1), Pcl_constraint (b0, b1)) ->
+      (eq_class_expr (a0, b0)) && (eq_class_type (a1, b1))
+  | (_, _) -> false
+and eq_class_expr : (class_expr * class_expr) -> 'result =
+  fun
+    ({ pcl_desc = a0; pcl_loc = a1 }, { pcl_desc = b0; pcl_loc = b1
+     })
+    -> (eq_class_expr_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_class_type_declaration :
+  (class_type_declaration * class_type_declaration) -> 'result =
+  fun (a0, a1) -> eq_class_infos eq_class_type (a0, a1)
+and eq_class_description :
+  (class_description * class_description) -> 'result =
+  fun (a0, a1) -> eq_class_infos eq_class_type (a0, a1)
+and eq_class_type_field_desc :
+  (class_type_field_desc * class_type_field_desc) -> 'result =
+  function
+  | (Pctf_inher a0, Pctf_inher b0) -> eq_class_type (a0, b0)
+  | (Pctf_val a0, Pctf_val b0) ->
+      (fun ((a0, a1, a2, a3), (b0, b1, b2, b3)) ->
+         (((eq_string (a0, b0)) &&
+             (Asttypes.eq_mutable_flag (a1, b1)))
+            && (Asttypes.eq_virtual_flag (a2, b2)))
+           && (eq_core_type (a3, b3)))
+        (a0, b0)
+  | (Pctf_virt a0, Pctf_virt b0) ->
+      (fun ((a0, a1, a2), (b0, b1, b2)) ->
+         ((eq_string (a0, b0)) && (Asttypes.eq_private_flag (a1, b1)))
+           && (eq_core_type (a2, b2)))
+        (a0, b0)
+  | (Pctf_meth a0, Pctf_meth b0) ->
+      (fun ((a0, a1, a2), (b0, b1, b2)) ->
+         ((eq_string (a0, b0)) && (Asttypes.eq_private_flag (a1, b1)))
+           && (eq_core_type (a2, b2)))
+        (a0, b0)
+  | (Pctf_cstr a0, Pctf_cstr b0) ->
+      (fun ((a0, a1), (b0, b1)) ->
+         (eq_core_type (a0, b0)) && (eq_core_type (a1, b1)))
+        (a0, b0)
+  | (_, _) -> false
+and eq_class_type_field :
+  (class_type_field * class_type_field) -> 'result =
+  fun
+    ({ pctf_desc = a0; pctf_loc = a1 },
+     { pctf_desc = b0; pctf_loc = b1 })
+    ->
+    (eq_class_type_field_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_class_signature :
+  (class_signature * class_signature) -> 'result =
+  fun
+    ({ pcsig_self = a0; pcsig_fields = a1; pcsig_loc = a2 },
+     { pcsig_self = b0; pcsig_fields = b1; pcsig_loc = b2 })
+    ->
+    ((eq_core_type (a0, b0)) &&
+       (eq_list eq_class_type_field (a1, b1)))
+      && (Location.eq_t (a2, b2))
+and eq_class_type_desc :
+  (class_type_desc * class_type_desc) -> 'result =
+  function
+  | (Pcty_constr (a0, a1), Pcty_constr (b0, b1)) ->
+      (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+        (eq_list eq_core_type (a1, b1))
+  | (Pcty_signature a0, Pcty_signature b0) ->
+      eq_class_signature (a0, b0)
+  | (Pcty_arrow (a0, a1, a2), Pcty_arrow (b0, b1, b2)) ->
+      ((Asttypes.eq_label (a0, b0)) && (eq_core_type (a1, b1))) &&
+        (eq_class_type (a2, b2))
+  | (_, _) -> false
+and eq_class_type : (class_type * class_type) -> 'result =
+  fun
+    ({ pcty_desc = a0; pcty_loc = a1 },
+     { pcty_desc = b0; pcty_loc = b1 })
+    -> (eq_class_type_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_exception_declaration :
+  (exception_declaration * exception_declaration) -> 'result =
+  fun (a0, a1) -> eq_list eq_core_type (a0, a1)
+and eq_type_kind : (type_kind * type_kind) -> 'result =
+  function
+  | (Ptype_abstract, Ptype_abstract) -> true
+  | (Ptype_variant a0, Ptype_variant b0) ->
+      eq_list
+        (fun ((a0, a1, a2, a3), (b0, b1, b2, b3)) ->
+           (((Asttypes.eq_loc eq_string (a0, b0)) &&
+               (eq_list eq_core_type (a1, b1)))
+              && (eq_option eq_core_type (a2, b2)))
+             && (Location.eq_t (a3, b3)))
+        (a0, b0)
+  | (Ptype_record a0, Ptype_record b0) ->
+      eq_list
+        (fun ((a0, a1, a2, a3), (b0, b1, b2, b3)) ->
+           (((Asttypes.eq_loc eq_string (a0, b0)) &&
+               (Asttypes.eq_mutable_flag (a1, b1)))
+              && (eq_core_type (a2, b2)))
+             && (Location.eq_t (a3, b3)))
+        (a0, b0)
+  | (_, _) -> false
+and eq_type_declaration :
+  (type_declaration * type_declaration) -> 'result =
+  fun
+    ({
+       ptype_params = a0;
+       ptype_cstrs = a1;
+       ptype_kind = a2;
+       ptype_private = a3;
+       ptype_manifest = a4;
+       ptype_variance = a5;
+       ptype_loc = a6
+     },
+     {
+       ptype_params = b0;
+       ptype_cstrs = b1;
+       ptype_kind = b2;
+       ptype_private = b3;
+       ptype_manifest = b4;
+       ptype_variance = b5;
+       ptype_loc = b6
+     })
+    ->
+    ((((((eq_list (eq_option (Asttypes.eq_loc eq_string)) (a0, b0))
+           &&
+           (eq_list
+              (fun ((a0, a1, a2), (b0, b1, b2)) ->
+                 ((eq_core_type (a0, b0)) && (eq_core_type (a1, b1)))
+                   && (Location.eq_t (a2, b2)))
+              (a1, b1)))
+          && (eq_type_kind (a2, b2)))
+         && (Asttypes.eq_private_flag (a3, b3)))
+        && (eq_option eq_core_type (a4, b4)))
+       &&
+       (eq_list
+          (fun ((a0, a1), (b0, b1)) ->
+             (eq_bool (a0, b0)) && (eq_bool (a1, b1)))
+          (a5, b5)))
+      && (Location.eq_t (a6, b6))
+and eq_value_description :
+  (value_description * value_description) -> 'result =
+  fun
+    ({ pval_type = a0; pval_prim = a1; pval_loc = a2 },
+     { pval_type = b0; pval_prim = b1; pval_loc = b2 })
+    ->
+    ((eq_core_type (a0, b0)) && (eq_list eq_string (a1, b1))) &&
+      (Location.eq_t (a2, b2))
+and eq_expression_desc :
+  (expression_desc * expression_desc) -> 'result =
+  function
+  | (Pexp_ident a0, Pexp_ident b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Pexp_constant a0, Pexp_constant b0) ->
+      Asttypes.eq_constant (a0, b0)
+  | (Pexp_let (a0, a1, a2), Pexp_let (b0, b1, b2)) ->
+      ((Asttypes.eq_rec_flag (a0, b0)) &&
+         (eq_list
+            (fun ((a0, a1), (b0, b1)) ->
+               (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
+            (a1, b1)))
+        && (eq_expression (a2, b2))
+  | Pexp_fun (a1, a1, a2, a3), Pexp_function (b0, b1, b2, b3) ->
+      ((Asttypes.eq_label (a0, b0)) &&
+       (eq_option eq_expression (a1, b1)) &&
+       (eq_pattern a2 b2) &&
+       (eq_expression (a3, b3)))
+  | (Pexp_function (a0, a1, a2), Pexp_function (b0, b1, b2)) ->
+      (* FIX *)
+      eq_list
+        (fun ((a0, a1), (b0, b1)) ->
+          (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
+        (a2, b2)
+  | (Pexp_apply (a0, a1), Pexp_apply (b0, b1)) ->
+      (eq_expression (a0, b0)) &&
+        (eq_list
+           (fun ((a0, a1), (b0, b1)) ->
+              (Asttypes.eq_label (a0, b0)) &&
+                (eq_expression (a1, b1)))
+           (a1, b1))
+  | (Pexp_match (a0, a1), Pexp_match (b0, b1)) ->
+      (eq_expression (a0, b0)) &&
+        (eq_list
+           (fun ((a0, a1), (b0, b1)) ->
+              (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
+           (a1, b1))
+  | (Pexp_try (a0, a1), Pexp_try (b0, b1)) ->
+      (eq_expression (a0, b0)) &&
+        (eq_list
+           (fun ((a0, a1), (b0, b1)) ->
+              (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
+           (a1, b1))
+  | (Pexp_tuple a0, Pexp_tuple b0) -> eq_list eq_expression (a0, b0)
+  | (Pexp_construct (a0, a1), Pexp_construct (b0, b1)) ->
+      ((Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+         (eq_option eq_expression (a1, b1)))
+  | (Pexp_variant (a0, a1), Pexp_variant (b0, b1)) ->
+      (Asttypes.eq_label (a0, b0)) &&
+        (eq_option eq_expression (a1, b1))
+  | (Pexp_record (a0, a1), Pexp_record (b0, b1)) ->
+      (eq_list
+         (fun ((a0, a1), (b0, b1)) ->
+            (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+              (eq_expression (a1, b1)))
+         (a0, b0))
+        && (eq_option eq_expression (a1, b1))
+  | (Pexp_field (a0, a1), Pexp_field (b0, b1)) ->
+      (eq_expression (a0, b0)) &&
+        (Asttypes.eq_loc Longident.eq_t (a1, b1))
+  | (Pexp_setfield (a0, a1, a2), Pexp_setfield (b0, b1, b2)) ->
+      ((eq_expression (a0, b0)) &&
+         (Asttypes.eq_loc Longident.eq_t (a1, b1)))
+        && (eq_expression (a2, b2))
+  | (Pexp_array a0, Pexp_array b0) -> eq_list eq_expression (a0, b0)
+  | (Pexp_ifthenelse (a0, a1, a2), Pexp_ifthenelse (b0, b1, b2)) ->
+      ((eq_expression (a0, b0)) && (eq_expression (a1, b1))) &&
+        (eq_option eq_expression (a2, b2))
+  | (Pexp_sequence (a0, a1), Pexp_sequence (b0, b1)) ->
+      (eq_expression (a0, b0)) && (eq_expression (a1, b1))
+  | (Pexp_while (a0, a1), Pexp_while (b0, b1)) ->
+      (eq_expression (a0, b0)) && (eq_expression (a1, b1))
+  | (Pexp_for (a0, a1, a2, a3, a4), Pexp_for (b0, b1, b2, b3, b4)) ->
+      ((((Asttypes.eq_loc eq_string (a0, b0)) &&
+           (eq_expression (a1, b1)))
+          && (eq_expression (a2, b2)))
+         && (Asttypes.eq_direction_flag (a3, b3)))
+        && (eq_expression (a4, b4))
+  | (Pexp_constraint (a0, a1, a2), Pexp_constraint (b0, b1, b2)) ->
+      ((eq_expression (a0, b0)) && (eq_option eq_core_type (a1, b1)))
+        && (eq_option eq_core_type (a2, b2))
+  | (Pexp_when (a0, a1), Pexp_when (b0, b1)) ->
+      (eq_expression (a0, b0)) && (eq_expression (a1, b1))
+  | (Pexp_send (a0, a1), Pexp_send (b0, b1)) ->
+      (eq_expression (a0, b0)) && (eq_string (a1, b1))
+  | (Pexp_new a0, Pexp_new b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Pexp_setinstvar (a0, a1), Pexp_setinstvar (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_expression (a1, b1))
+  | (Pexp_override a0, Pexp_override b0) ->
+      eq_list
+        (fun ((a0, a1), (b0, b1)) ->
+           (Asttypes.eq_loc eq_string (a0, b0)) &&
+             (eq_expression (a1, b1)))
+        (a0, b0)
+  | (Pexp_letmodule (a0, a1, a2), Pexp_letmodule (b0, b1, b2)) ->
+      ((Asttypes.eq_loc eq_string (a0, b0)) &&
+         (eq_module_expr (a1, b1)))
+        && (eq_expression (a2, b2))
+  | (Pexp_assert a0, Pexp_assert b0) -> eq_expression (a0, b0)
+  | (Pexp_lazy a0, Pexp_lazy b0) -> eq_expression (a0, b0)
+  | (Pexp_poly (a0, a1), Pexp_poly (b0, b1)) ->
+      (eq_expression (a0, b0)) && (eq_option eq_core_type (a1, b1))
+  | (Pexp_object a0, Pexp_object b0) -> eq_class_structure (a0, b0)
+  | (Pexp_newtype (a0, a1), Pexp_newtype (b0, b1)) ->
+      (eq_string (a0, b0)) && (eq_expression (a1, b1))
+  | (Pexp_pack a0, Pexp_pack b0) -> eq_module_expr (a0, b0)
+  | (Pexp_open (a0, a1), Pexp_open (b0, b1)) ->
+      (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+        (eq_expression (a1, b1))
+  | (_, _) -> false
+and eq_expression : (expression * expression) -> 'result =
+  fun
+    ({ pexp_desc = a0; pexp_loc = a1 },
+     { pexp_desc = b0; pexp_loc = b1 })
+    -> (eq_expression_desc (a0, b0)) && (Location.eq_t (a1, b1))
+
+let rec eq_directive_argument_desc :
+  (directive_argument_desc * directive_argument_desc) -> 'result =
+  function
+  | (Pdir_none, Pdir_none) -> true
+  | (Pdir_string a0, Pdir_string b0) -> eq_string (a0, b0)
+  | (Pdir_int a0, Pdir_int b0) -> eq_int (a0, b0)
+  | (Pdir_ident a0, Pdir_ident b0) -> Longident.eq_t (a0, b0)
+  | (Pdir_bool a0, Pdir_bool b0) -> eq_bool (a0, b0)
+  | (_, _) -> false
+and eq_directive_argument :
+  (directive_argument * directive_argument) -> 'result =
+  fun
+    ({pdira_desc = a0; pdira_loc = a1},
+     {pdira_desc = b0; pdira_loc = b1})
+    -> (eq_directive_argument_desc (a0, b0)) && (Location.eq_t (a1, b1))
+
+and eq_toplevel_phrase :
+  (toplevel_phrase * toplevel_phrase) -> 'result =
+  function
+  | (Ptop_def a0, Ptop_def b0) -> eq_structure (a0, b0)
+  | (Ptop_dir a0, Ptop_dir a1) ->
+    Asttypes.eq_loc eq_string (a0.pdir_name, b0.pdir_name) &&
+    (eq_directive_argument (a1, b1))
+  | (_, _) -> false
diff --git a/tools/eventlog_metadata.in b/tools/eventlog_metadata.in
new file mode 100644
index 00000000..f39364ed
--- /dev/null
+++ b/tools/eventlog_metadata.in
@@ -0,0 +1,216 @@
+/* CTF 1.8 */
+
+typealias integer {size = 8;}  := uint8_t;
+typealias integer {size = 16;} := uint16_t;
+typealias integer {size = 32;} := uint32_t;
+typealias integer {size = 64;} := uint64_t;
+
+clock {
+    name = tracing_clock;
+    freq = 1000000000; /* tick = 1 ns */
+};
+
+typealias integer {
+    size = 64;
+    map = clock.tracing_clock.value;
+} := tracing_clock_int_t;
+
+
+/*
+
+Main trace description,
+major and minor refers to the CTF version being used.
+
+The packet header must contain at the very least
+a stream id and the CTF magic number.
+We only use one stream for now, and CTF magic number is 0xc1fc1fc1.
+
+We add an extra field ocaml_trace_version to enable simpler transition if we add
+or remove metrics in the future.
+
+*/
+trace {
+    major = 1;
+    minor = 8;
+    byte_order = @endianness@;
+    packet.header := struct {
+        uint32_t magic; /* required: must contain CTF magic number */
+        uint16_t ocaml_trace_version; /* our own trace format versioning */
+        uint16_t stream_id; /* required, although we have only one. */
+    };
+};
+
+/*
+
+We use only one stream at the moment.
+Each event payload must contain a header with a timestamp and a pid.
+The id field refers to the various event kinds defined further down this file.
+
+*/
+stream {
+    id = 0;
+    event.header := struct { /* for each event */
+        tracing_clock_int_t timestamp;
+        uint32_t pid;
+        uint32_t id;
+    };
+};
+
+/*
+
+These enumerations are mostly following the instrumented runtime datapoints.
+gc_phase aims to track the entry and exit time of each of the following events
+during collection.
+
+*/
+enum gc_phase : uint16_t {
+    "compact/main" = 0,
+    "compact/recompact",
+    "explicit/gc_set",
+    "explicit/gc_stat",
+    "explicit/gc_minor",
+    "explicit/gc_major",
+    "explicit/gc_full_major",
+    "explicit/gc_compact",
+    "major",
+    "major/roots",
+    "major/sweep",
+    "major/mark/roots",
+    "major/mark/main",
+    "major/mark/final",
+    "major/mark",
+    "major/mark/global_roots_slice",
+    "major_roots/global",
+    "major_roots/dynamic_global",
+    "major_roots/local",
+    "major_roots/C",
+    "major_roots/finalised",
+    "major_roots/memprof",
+    "major_roots/hook",
+    "major/check_and_compact",
+    "minor",
+    "minor/local_roots",
+    "minor/ref_tables",
+    "minor/copy",
+    "minor/update_weak",
+    "minor/finalized",
+    "explicit/gc_major_slice"
+};
+
+/*
+
+Miscellaneous GC counters
+
+*/
+enum gc_counter : uint16_t {
+    "alloc_jump",
+    "force_minor/alloc_small",
+    "force_minor/make_vect",
+    "force_minor/set_minor_heap_size",
+    "force_minor/weak",
+    "force_minor/memprof",
+    "major/mark/slice/remain",
+    "major/mark/slice/fields",
+    "major/mark/slice/pointers",
+    "major/work/extra",
+    "major/work/mark",
+    "major/work/sweep",
+    "minor/promoted",
+    "request_major/alloc_shr",
+    "request_major/adjust_gc_speed",
+    "request_minor/realloc_ref_table",
+    "request_minor/realloc_ephe_ref_table",
+    "request_minor/realloc_custom_table"
+};
+
+/*
+
+Block allocation counters, per size buckets.
+
+*/
+enum alloc_bucket : uint8_t {
+  "alloc 01" = 1,
+  "alloc 02",
+  "alloc 03",
+  "alloc 04",
+  "alloc 05",
+  "alloc 06",
+  "alloc 07",
+  "alloc 08",
+  "alloc 09",
+  "alloc 10-19",
+  "alloc 20-29",
+  "alloc 30-39",
+  "alloc 40-49",
+  "alloc 50-59",
+  "alloc 60-69",
+  "alloc 70-79",
+  "alloc 80-89",
+  "alloc 90-99",
+  "alloc large"
+};
+
+/*
+
+Each event is comprised of the previously defined event.header
+and the fields defined here.
+
+An entry event marks the start of a gc phase.
+
+*/
+event {
+    id = 0;
+    name = "entry";
+    stream_id = 0;
+    fields := struct {
+        enum gc_phase phase;
+    };
+};
+
+/*
+
+exit counterparts to entry events
+
+*/
+event {
+    id = 1;
+    name = "exit";
+    stream_id = 0;
+    fields := struct {
+        enum gc_phase phase;
+    };
+};
+
+event {
+    id = 2;
+    name = "counter";
+    stream_id = 0;
+    fields := struct {
+        uint64_t count;
+        enum gc_counter kind;
+    };
+};
+
+event {
+    id = 3;
+    name = "alloc";
+    stream_id = 0;
+    fields := struct {
+        uint64_t count;
+        enum alloc_bucket bucket;
+    };
+};
+
+/*
+ Flush events are used to track the time spent by the tracing runtime flushing
+ data to disk, useful to remove flushing overhead for other runtime mesurements
+ in the trace.
+*/
+event {
+     id = 4;
+     name = "flush";
+     stream_id = 0;
+     fields := struct {
+        tracing_clock_int_t duration;
+     };
+};
diff --git a/tools/gdb-macros b/tools/gdb-macros
new file mode 100644
index 00000000..17c3110e
--- /dev/null
+++ b/tools/gdb-macros
@@ -0,0 +1,321 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                 Damien Doligez, 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.          *
+#*                                                                        *
+#**************************************************************************
+
+# A set of macros for low-level debugging of OCaml programs and of the
+# OCaml runtime itself (both native and byte-code).
+
+# This file should be loaded in gdb with [ source gdb-macros ].
+# It defines one command: [caml]
+# Usage:
+# [caml ]
+# If  is an OCaml value, this will display it in a low-level
+# but legible format, including the header information.
+
+# To do: a [camlsearch] command to find all (gc-traceable) pointers to
+# a given heap block.
+
+set $camlwordsize = sizeof(char *)
+
+if $camlwordsize == 8
+  set $caml_unalloc_mask = 0xFF00FFFFFF00FFFF
+  set $caml_unalloc_value = 0xD700D7D7D700D6D7
+else
+  set $caml_unalloc_mask = 0xFF00FFFF
+  set $caml_unalloc_value = 0xD700D6D7
+end
+
+define camlcheckheader
+  if $arg0 >> 10 <= 0 || $arg0 >> 10 >= 0x1000000000000
+    if ($arg0 & $caml_unalloc_mask) == $caml_unalloc_value
+      set $camlcheckheader_result = 2
+    else
+      if $arg0 == (unsigned long) 0
+        set $camlcheckheader_result = 3
+      else
+        set $camlcheckheader_result = 1
+      end
+    end
+  else
+    set $camlcheckheader_result = 0
+  end
+end
+
+define camlheader
+  set $hd = * (unsigned long *) ($arg0 - $camlwordsize)
+  set $tag = $hd & 0xFF
+  set $color = ($hd >> 8) & 3
+  set $size = $hd >> 10
+
+  camlcheckheader $hd
+  if $camlcheckheader_result != 0
+    if $camlcheckheader_result == 2
+      printf "[UNALLOCATED MEMORY]"
+    else
+      if $camlcheckheader_result == 3
+        printf "[** fragment **] 0x%016lu", $hd
+      else
+        printf "[**invalid header**] 0x%016lu", $hd
+      end
+    end
+    set $size = 0
+  else
+    printf "["
+    if $color == 0
+      printf "white "
+    end
+    if $color == 1
+      printf "gray "
+    end
+    if $color == 2
+      printf "blue "
+    end
+    if $color == 3
+      printf "black "
+    end
+
+    if $tag < 246
+      printf "tag%d ", $tag
+    end
+    if $tag == 246
+      printf "Lazy "
+    end
+    if $tag == 247
+      printf "Closure "
+    end
+    if $tag == 248
+      printf "Object "
+    end
+    if $tag == 249
+      printf "Infix "
+    end
+    if $tag == 250
+      printf "Forward "
+    end
+    if $tag == 251
+      printf "Abstract "
+    end
+    if $tag == 252
+      printf "String "
+    end
+    if $tag == 253
+      printf "Double "
+    end
+    if $tag == 254
+      printf "Double_array "
+    end
+    if $tag == 255
+      printf "Custom "
+    end
+
+    printf "%lu]", $size
+  end
+end
+
+define camlheap
+  if $arg0 >= Caml_state->young_start && $arg0 < Caml_state->young_end
+    printf "YOUNG"
+    set $camlheap_result = 1
+  else
+    set $chunk = Caml_state->heap_start
+    set $found = 0
+    while $chunk != 0 && ! $found
+      set $chunk_size = * (unsigned long *) ($chunk - 2 * $camlwordsize)
+      if $arg0 > $chunk && $arg0 <= $chunk + $chunk_size
+        printf "OLD"
+        set $found = 1
+      end
+      set $chunk = * (unsigned long *) ($chunk - $camlwordsize)
+    end
+    if $found
+      set $camlheap_result = 1
+    else
+      printf "OUT-OF-HEAP"
+      set $camlheap_result = 0
+    end
+  end
+end
+
+define camlint
+  if ($arg0 & $caml_unalloc_mask) == $caml_unalloc_value
+    printf "UNALLOCATED MEMORY"
+  else
+    printf "INT %ld", ($arg0 >> 1)
+  end
+  if ($arg0 & 0xFF) == 0xF9 && ($arg0 >> 10) < 0x1000000000000
+    printf " [possible infix header]"
+  end
+end
+
+define camlblock
+  printf "%#lx: ", $arg0 - $camlwordsize
+  camlheap $arg0
+  printf " "
+  camlheader $arg0
+  set $mysize = $size
+  set $camlnext = $arg0 + $camlwordsize * ($size + 1)
+  printf "\n"
+
+  if $tag == 252
+    x/s $arg0
+  end
+  if $tag == 253
+    x/f $arg0
+  end
+  if $tag == 254
+    while $count < $mysize && $count < 10
+      if $count + 1 < $size
+        x/2f $arg0 + $camlwordsize * $count
+      else
+        x/f $arg0 + $camlwordsize * $count
+      end
+      set $count = $count + 2
+    end
+    if $count < $mysize
+      printf "... truncated ...\n"
+    end
+  end
+
+  if $tag == 249
+    printf "... infix header, displaying enclosing block:\n"
+    set $mybaseaddr = $arg0 - $camlwordsize * $mysize
+    camlblock $mybaseaddr
+    # reset $tag, which was clobbered by the recursive call (yuck)
+    set $tag = 249
+  end
+
+  if $tag != 249 && $tag != 252 && $tag != 253 && $tag != 254
+    set $isvalues = $tag < 251
+    set $count = 0
+    while $count < $mysize && $count < 10
+      set $adr = $arg0 + $camlwordsize * $count
+      set $field = * (unsigned long *) $adr
+      printf "%#lx: [%d] 0x%016lx ", $adr, $count, $field
+      if ($field & 7) == 0 && $isvalues
+        camlheap $field
+        if $camlheap_result
+          printf " "
+          camlheader $field
+        end
+      end
+      if ($field & 1) == 1
+        camlint $field
+      end
+      printf "\n"
+      set $count = $count + 1
+    end
+    if $count < $mysize
+      printf "... truncated ...\n"
+    end
+  end
+  printf "next block head: %#lx   value: %#lx\n", \
+         $arg0 + $camlwordsize * $mysize, $arg0 + $camlwordsize * ($mysize+1)
+end
+
+# displays an OCaml value
+define caml
+  set $camllast = (long) $arg0
+  if ($camllast & 1) == 1
+    set $camlnext = 0
+    camlint $camllast
+    printf "\n"
+  end
+  if ($camllast & 7) == 0
+    camlblock $camllast
+  end
+  if ($camllast & 7) != 0 && ($camllast & 1) != 1
+    set $camlnext = 0
+    printf "invalid pointer: %#016lx\n", $camllast
+  end
+end
+
+# displays the next OCaml value in memory
+define camlnext
+  caml $camlnext
+end
+
+# displays the n-th field of the previously displayed value
+define camlfield
+  set $camlfield_addr = ((long *) $camllast)[$arg0]
+  caml $camlfield_addr
+end
+
+# displays the list of heap chunks
+define camlchunks
+  set $chunk = * (unsigned long *) &Caml_state->heap_start
+  while $chunk != 0
+    set $chunk_size = * (unsigned long *) ($chunk - 2 * $camlwordsize)
+    set $chunk_alloc = * (unsigned long *) ($chunk - 3 * $camlwordsize)
+    printf "chunk: addr = %#lx .. %#lx", $chunk, $chunk + $chunk_size
+    printf "  (size = %#lx; alloc = %#lx)\n", $chunk_size, $chunk_alloc
+    set $chunk = * (unsigned long *) ($chunk - $camlwordsize)
+  end
+end
+
+# walk the heap and launch command `camlvisitfun` on each block
+# the variables `$hp` `$val` `$hd` `$tag` `$color` and `$size`
+# are set before calling `camlvisitfun`
+# `camlvisitfun` can set `$camlvisitstop` to stop the iteration
+
+define camlvisit
+  set $cvchunk = * (unsigned long *) &Caml_state->heap_start
+  set $camlvisitstop = 0
+  while $cvchunk != 0 && ! $camlvisitstop
+    set $cvchunk_size = * (unsigned long *) ($cvchunk - 2 * $camlwordsize)
+    set $cvhp = $cvchunk
+    while $cvhp < $cvchunk + $cvchunk_size && !$camlvisitstop
+      set $hp = $cvhp
+      set $val = $hp + $camlwordsize
+      set $hd = * (unsigned long *) $hp
+      set $tag = $hd & 0xFF
+      set $color = ($hd >> 8) & 3
+      set $cvsize = $hd >> 10
+      set $size = $cvsize
+      camlvisitfun
+      set $cvhp = $cvhp + (($cvsize + 1) * $camlwordsize)
+    end
+    set $cvchunk = * (unsigned long *) ($cvchunk - $camlwordsize)
+  end
+end
+
+define caml_cv_check_fl0
+  if $hp == * (unsigned long *) &Caml_state->heap_start
+    set $flcheck_prev = ((unsigned long) &sentinels + 16)
+  end
+  if $color == 2 && $size > 5
+    if $val != * (unsigned long *) $flcheck_prev
+      printf "free-list: missing link %#x -> %#x\n", $flcheck_prev, $val
+      set $camlvisitstop = 1
+    end
+    set $flcheck_prev = $val
+  end
+end
+
+define caml_check_fl
+  set $listsize = $arg0
+  set $blueseen = $listsize == 0
+  set $val = * (unsigned long *) ((long) &sentinels + 16 + 32 * $listsize)
+  while $val != 0
+    printf "%#x\n", $val
+    set $hd = * (unsigned long *) ($val - 8)
+    set $color = ($hd >> 8) & 3
+    if $blueseen && $color != 2
+      printf "non-blue block at address %#x\n", $val
+      loop_break
+    else
+      set $blueseen = 1
+    end
+    set $val = * (unsigned long *) $val
+  end
+end
diff --git a/tools/git-dev-options.sh b/tools/git-dev-options.sh
new file mode 100755
index 00000000..41925f43
--- /dev/null
+++ b/tools/git-dev-options.sh
@@ -0,0 +1,71 @@
+#! /bin/sh
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                 David Allsopp, OCaml Labs, Cambridge.                  *
+#*                                                                        *
+#*   Copyright 2019 MetaStack Solutions Ltd.                              *
+#*                                                                        *
+#*   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 script should have the same shebang as configure
+if test -e '.git' ; then :
+  if test -z "$ac_read_git_config" ; then :
+    extra_args=$(git config ocaml.configure 2>/dev/null)
+    extended_cache=$(git config ocaml.configure-cache 2>/dev/null)
+    cache_file=
+
+    # If ocaml.configure-cache is set, parse the command-line for the --host
+    # option, in order to determine the name of the cache file.
+    if test -n "$extended_cache" ; then :
+      echo "Detected Git configuration option ocaml.configure-cache set to \
+\"$extended_cache\""
+      dashdash=
+      prev=
+      host=default
+      # The logic here is pretty borrowed from autoconf's
+      for option in $extra_args "$@"
+      do
+        if test -n "$prev" ; then :
+          host=$option
+          continue
+        fi
+
+        case $dashdash$option in
+          --)
+            dashdash=yes ;;
+          -host | --host | --hos | --ho)
+            prev=host ;;
+          -host=* | --host=* | --hos=* | --ho=*)
+            case $option in
+              *=?*) host=$(expr "X$option" : '[^=]*=\(.*\)') ;;
+              *=) host= ;;
+            esac ;;
+        esac
+      done
+      cache_file="`dirname "$0"`/$extended_cache/ocaml-$host.cache"
+    fi
+
+    # If either option has a value, re-invoke configure
+    if test -n "$extra_args$cache_file" ; then :
+      echo "Detected Git configuration option ocaml.configure set to \
+\"$extra_args\""
+      # Too much effort to get the echo to show appropriate quoting - the
+      # invocation itself intentionally quotes $0 and passes $@ exactly as given
+      # but allows a single expansion of ocaml.configure
+      if test -n "$cache_file" ; then :
+        echo "Re-running $0 $extra_args --cache-file \"$cache_file\" $@"
+        ac_read_git_config=true exec "$0" $extra_args \
+                                          --cache-file "$cache_file" "$@"
+      else
+        echo "Re-running $0 $extra_args $@"
+        ac_read_git_config=true exec "$0" $extra_args "$@"
+      fi
+    fi
+  fi
+fi
diff --git a/tools/lintapidiff.ml b/tools/lintapidiff.ml
new file mode 100644
index 00000000..47fe1cee
--- /dev/null
+++ b/tools/lintapidiff.ml
@@ -0,0 +1,316 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                              Edwin Török                               *)
+(*                                                                        *)
+(*   Copyright 2016--2017 Edwin Török                                     *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Detects newly added symbols that are missing "@since" annotations,
+   or removed symbols that didn't have "@deprecated" annotation before.
+
+   Handles: values, exceptions.
+   Ignores: variants, record fields, classes, module aliasing or includes, ...
+   Out of scope: changes in arity, parameters, ...
+
+   Missing attributes on undocumented identifiers in undocumented modules
+   are not reported.
+
+   Use 'make lintapidiff' in the root directory to run
+*)
+open Location
+open Parsetree
+
+(* oldest Ocaml version that we show missing @since errors for *)
+let oldest = "4.00.0"
+
+(* do not check @since annotations for these *)
+let ignore_changes_for = [
+  "type Pervasives.format6" (* this used to be a built-in type *);
+  (* discarded by stop comments: *)
+  "type Unix.map_file_impl";
+  "value Unix.map_file_impl";
+]
+
+module IdMap = Misc.StringMap
+
+module Version : sig
+  type t
+  val oldest : t
+  val is_same : t -> t -> bool
+  val is_strictly_older: t -> than:t -> bool
+  val of_string_exn : string -> t
+  val pp : Format.formatter -> t -> unit
+end = struct
+  type t = int * int * int
+
+  let is_same a b = a = b
+  let is_strictly_older a ~than = a < than
+  let of_string_exn str =
+    try Scanf.sscanf str "%u.%u.%u" (fun a b c -> (a,b,c))
+    with _ -> Scanf.sscanf str "%u.%u" (fun a b -> (a,b,0))
+
+  let oldest = of_string_exn oldest
+  let pp ppf (major,minor,patch) =
+    Format.fprintf ppf "%u.%02u.%u" major minor patch
+end
+
+module Doc = struct
+  type t = {
+    since: Version.t option;
+    deprecated: bool;
+    loc: Location.t;
+    has_doc_parent: bool;
+    has_doc: bool;
+  }
+
+  let empty = {since = None; deprecated=false; loc=Location.none;
+               has_doc_parent=false;has_doc=false}
+
+  let since = Str.regexp "\\(.\\|\n\\)*@since +\\([^ ]+\\).*"
+
+  let find_attr lst attrs =
+    try Some (List.find (fun (loc, _) -> List.mem loc.txt lst) attrs)
+    with Not_found -> None
+
+  let get_doc lst attrs = match find_attr lst attrs with
+    | Some (_, PStr [{pstr_desc=Pstr_eval(
+        {pexp_desc=Pexp_constant(Pconst_string (doc, _));_}, _);_}])
+      when doc <> "/*" && doc <> "" -> Some doc
+    | _ -> None
+
+  let is_deprecated attrs =
+    find_attr ["ocaml.deprecated"; "deprecated"] attrs <> None ||
+    match get_doc ["ocaml.text"] attrs with (* for toplevel module annotation *)
+    | None -> false
+    | Some text ->
+        try Misc.search_substring "@deprecated" text 0 >= 0
+        with Not_found -> false
+
+  let get parent_info loc attrs =
+    let doc = get_doc ["ocaml.doc"; "ocaml.text"] attrs in
+    {
+      since = (match doc with
+          | Some doc ->
+              if Str.string_match since doc 0 then
+                Some (Str.matched_group 2 doc |> String.trim
+                      |> Version.of_string_exn)
+              else parent_info.since
+          | None -> parent_info.since);
+      deprecated = parent_info.deprecated || is_deprecated attrs;
+      loc;
+      has_doc_parent = parent_info.has_doc_parent || parent_info.has_doc;
+      has_doc = doc <> None
+    }
+end
+
+module Ast = struct
+  let add_path ~f prefix path name attrs inherits map =
+    let path = Path.Pdot (path, name.txt, 0) in
+    let id = prefix ^ " " ^ (Printtyp.string_of_path path) in
+    (* inherits: annotation on parent is inherited by all children,
+       so it suffices to annotate just the new module, and not all its elements
+    *)
+    let info = f inherits name.loc attrs in
+    IdMap.add id info map
+
+  let rec add_item ~f path inherits map item =
+    let rec add_module_type path ty (inherits, map) =
+      let self = add_item ~f path inherits in
+      match ty.pmty_desc with
+      | Pmty_signature lst -> List.fold_left self map lst
+      | Pmty_functor ({txt;_}, _, m) ->
+          let path = Path.Papply(path, Path.Pident (Ident.create txt)) in
+          add_module_type path m (inherits, map)
+      | Pmty_ident _ | Pmty_with _ | Pmty_typeof _| Pmty_extension _
+      | Pmty_alias _ -> map
+    in
+    let enter_path path name ty attrs map =
+      let path = Path.Pdot (path, name.txt, 0) in
+      let inherits = f inherits name.loc attrs in
+      add_module_type path ty (inherits, map)
+    in
+    let add_module map m =
+      enter_path  path m.pmd_name m.pmd_type m.pmd_attributes map
+    in
+    match item.psig_desc with
+    | Psig_value vd ->
+        add_path ~f "value" path vd.pval_name vd.pval_attributes inherits map
+    | Psig_type (_,lst) ->
+        List.fold_left (fun map t ->
+            add_path ~f "type" path t.ptype_name t.ptype_attributes inherits map
+          ) map lst
+    | Psig_exception e ->
+        add_path ~f "exception" path e.pext_name e.pext_attributes inherits map
+    | Psig_module m -> add_module map m
+    | Psig_recmodule lst -> List.fold_left add_module map lst
+    | Psig_modtype s ->
+        begin match s.pmtd_type with
+        | None -> map
+        | Some ty ->
+            enter_path path s.pmtd_name ty s.pmtd_attributes map
+        end
+    | Psig_typext _|Psig_open _|Psig_include _|Psig_class _|Psig_class_type _
+    | Psig_attribute _|Psig_extension _ -> map
+
+  let add_items ~f path (inherits,map) items =
+    (* module doc *)
+    let inherits = List.fold_left (fun inherits -> function
+        | {psig_desc=Psig_attribute a;_}
+          when (Doc.get_doc ["ocaml.doc";"ocaml.text"][a] <> None) ->
+            f inherits (Location.none) [a]
+        | _ -> inherits
+      ) inherits items in
+    List.fold_left (add_item ~f path inherits) map items
+
+  let parse_file ~orig ~f ~init input =
+    try
+      let id =
+        orig |> Filename.chop_extension |> Filename.basename |>
+        String.capitalize_ascii |> Ident.create in
+      let ast = Pparse.file ~tool_name:"lintapidiff" input
+          Parse.interface Pparse.Signature in
+      Location.input_name := orig;
+      add_items ~f (Path.Pident id) (init,IdMap.empty) ast
+    with e ->
+      Format.eprintf "%a@." Location.report_exception e;
+      raise e
+end
+
+module Git = struct
+  let with_show ~f rev path =
+    let obj = rev ^ ":" ^ path in
+    let suffix = Printf.sprintf "-%s:%s" rev (Filename.basename path) in
+    let tmp = Filename.temp_file "lintapidiff" suffix in
+    let cmd = Printf.sprintf "git show %s >%s 2>/dev/null"
+        (Filename.quote obj) (Filename.quote tmp) in
+    Misc.try_finally (fun () ->
+        match Sys.command cmd with
+        | 0 -> Ok (f tmp)
+        | 128 -> Error `Not_found
+        | r ->
+            Location.errorf ~loc:(in_file obj) "exited with code %d" r |>
+            Format.eprintf "%a@." Location.report_error;
+            Error `Exit)
+      (fun () -> Misc.remove_file tmp)
+end
+
+module Diff = struct
+  type seen_info = {
+    last_not_seen: Version.t option;
+    first_seen: Version.t;
+    deprecated: bool;
+  }
+
+  let err k (loc, msg, seen, latest) =
+    let info_seen ppf = function
+      | None ->
+          Format.fprintf ppf "%s was not seen in any analyzed version" k
+      | Some a ->
+          begin match a.last_not_seen with
+          | Some v ->
+              Format.fprintf ppf "%s was not seen in version %a" k Version.pp v
+          | None -> Format.fprintf ppf "%s was seen in all analyzed versions" k
+          end;
+          Format.fprintf ppf "@,%s was seen in version %a"
+            k Version.pp a.first_seen;
+          if a.deprecated then
+            Format.fprintf ppf "@,%s was marked as deprecated" k
+    in
+    let info_latest ppf = function
+      | None -> Format.fprintf ppf "%s was deleted in HEAD" k
+      | Some s ->
+          begin match s.Doc.since with
+          | Some v -> Format.fprintf ppf "%s has @since %a" k Version.pp v
+          | None -> Format.fprintf ppf "%s has no @since annotation" k
+          end;
+          if s.Doc.deprecated then
+            Format.fprintf ppf "@,%s is marked as deprecated" k
+    in
+    Location.errorf ~loc "@[%s %s@,%a@,%a@]" msg k
+      info_seen seen info_latest latest |>
+    Format.eprintf "%a@." Location.report_error
+
+  let parse_file_at_rev ~path (prev,accum) rev =
+    let merge _ a b = match a, b with
+      | Some a, Some b ->
+          Some { a with  deprecated=b.deprecated }
+      | None, Some a -> Some { a with last_not_seen=prev }
+      | Some _, None -> None (* deleted *)
+      | None, None -> assert false
+    in
+    let first_seen = Version.of_string_exn rev in
+    let empty = {last_not_seen=None;first_seen;deprecated=false} in
+    let f = Ast.parse_file ~orig:path ~init:empty ~f:(fun _ _ attrs ->
+        { last_not_seen=None;first_seen; deprecated=Doc.is_deprecated attrs })
+    in
+    let map = match Git.with_show ~f rev path with
+      | Ok r -> r
+      | Error `Not_found -> IdMap.empty
+      | Error `Exit -> raise Exit in
+    Some first_seen, IdMap.merge merge accum map
+
+  let check_changes ~first ~last default k seen latest =
+    let is_old v = Version.is_strictly_older v ~than:Version.oldest ||
+                   Version.is_same v first
+    in
+    if List.mem k ignore_changes_for then None (* ignored *)
+    else let open! Doc in
+    match (seen:seen_info option), latest with
+    | None, None -> assert false
+    | _, Some {has_doc_parent=false;has_doc=false;deprecated=false;_} ->
+        None (* undocumented *)
+    | Some {deprecated=true;_}, None -> None (* deleted deprecated *)
+    | Some _, None ->
+        Some (default, "deleted non-deprecated", seen, latest)
+    | _, Some {deprecated=true;since=None;_} -> None (* marked as deprecated *)
+    | None, Some {loc; since=None; _} ->
+        Some (loc, "missing @since for new", seen, latest)
+    | Some {first_seen;_}, Some {loc; since=None;_} ->
+        if is_old first_seen then None
+        else Some (loc, "missing @since", seen, latest)
+    | Some {first_seen;_}, Some {loc; since=Some s;_} ->
+        if Version.is_same first_seen s then None (* OK, @since matches *)
+        else Some (loc, "mismatched @since", seen, latest)
+    | None, Some {loc; since=Some s;_} ->
+        if Version.is_strictly_older s ~than:last ||
+           Version.is_same s last then
+          Some (loc, "too old @since for new", seen, latest)
+        else None
+
+  let file path tags =
+    let _,syms_vers = List.fold_left (parse_file_at_rev ~path)
+        (None,IdMap.empty) tags in
+    let current = Ast.parse_file ~orig:path ~f:Doc.get ~init:Doc.empty path in
+    let loc = Location.in_file path in
+    let first = List.hd tags |> Version.of_string_exn
+    and last = List.hd (List.rev tags) |> Version.of_string_exn in
+    IdMap.merge (check_changes ~first ~last loc) syms_vers current
+end
+
+let rec read_lines accum =
+  match input_line stdin with
+  | line -> read_lines (line :: accum)
+  | exception End_of_file -> accum
+
+let () =
+  let tags = Sys.argv |> Array.to_list |> List.tl in
+  if tags = [] then begin
+    Printf.eprintf "tags list is empty!\n";
+    exit 1;
+  end;
+  let paths = read_lines [] in
+  Printf.printf "Parsing\n%!";
+  let count = List.fold_left (fun count path ->
+      let problems = Diff.file path tags in
+      IdMap.iter Diff.err problems;
+      count + IdMap.cardinal problems
+    ) 0 paths in
+  Printf.printf "Found %d potential problems\n%!" count;
+  if count > 0 then exit 2
diff --git a/tools/magic b/tools/magic
new file mode 100644
index 00000000..089f169a
--- /dev/null
+++ b/tools/magic
@@ -0,0 +1,11 @@
+# Here are some definitions that can be added to the /usr/share/magic
+# database so that the file(1) command recognizes OCaml compiled files.
+# Contributed by Sven Luther.
+0       string  Caml1999        OCaml
+>8      string  X               bytecode executable
+>8      string  I               interface data (.cmi)
+>8      string  O               bytecode object data (.cmo)
+>8      string  A               bytecode library data (.cma)
+>8      string  Y               native object data (.cmx)
+>8      string  Z               native library data (.cmxa)
+>9      string  >\0             (Version %3.3s).
diff --git a/tools/make-package-macosx b/tools/make-package-macosx
new file mode 100755
index 00000000..1ac36a01
--- /dev/null
+++ b/tools/make-package-macosx
@@ -0,0 +1,138 @@
+#!/bin/sh
+
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*          Damien Doligez, projet Moscova, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 2003 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+cd package-macosx
+rm -rf ocaml.pkg ocaml-rw.dmg
+
+VERSION=`sed -e 1q ../VERSION`
+VERSION_MAJOR=`sed -n -e '1s/^\([0-9]*\)\..*/\1/p' ../VERSION`
+VERSION_MINOR=`sed -n -e '1s/^[0-9]*\.\([0-9]*\)[.+].*/\1/p' ../VERSION`
+
+cat >Description.plist <
+  
+  
+  
+          IFPkgDescriptionDeleteWarning
+          
+          IFPkgDescriptionDescription
+          The OCaml compiler and tools
+          IFPkgDescriptionTitle
+          OCaml
+          IFPkgDescriptionVersion
+          ${VERSION}
+  
+  
+EOF
+
+cat >Info.plist <
+
+
+
+        CFBundleGetInfoString
+        OCaml ${VERSION}
+        CFBundleIdentifier
+        fr.inria.ocaml
+        CFBundleName
+        OCaml
+        CFBundleShortVersionString
+        ${VERSION}
+        IFMajorVersion
+        ${VERSION_MAJOR}
+        IFMinorVersion
+        ${VERSION_MINOR}
+        IFPkgFlagAllowBackRev
+        
+        IFPkgFlagAuthorizationAction
+        AdminAuthorization
+        IFPkgFlagDefaultLocation
+        /usr/local
+        IFPkgFlagInstallFat
+        
+        IFPkgFlagIsRequired
+        
+        IFPkgFlagRelocatable
+        
+        IFPkgFlagRestartAction
+        NoRestart
+        IFPkgFlagRootVolumeOnly
+        
+        IFPkgFlagUpdateInstalledLanguages
+        
+        IFPkgFormatVersion
+        0.10000000149011612
+
+
+EOF
+
+mkdir -p resources
+
+#                                         stop here -> |
+cat >resources/ReadMe.txt <&2
+  exit 3
+fi
+open "/Volumes/$volname"
+sleep 2
+hdiutil detach $name
+
+rm -rf "ocaml-${VERSION}.dmg"
+hdiutil convert ocaml-rw.dmg -format UDZO -o "ocaml-${VERSION}.dmg"
diff --git a/tools/make-version-header.sh b/tools/make-version-header.sh
new file mode 100755
index 00000000..b91fba6c
--- /dev/null
+++ b/tools/make-version-header.sh
@@ -0,0 +1,55 @@
+#!/bin/sh
+
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*          Damien Doligez, projet Gallium, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 2003 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  As an exception to the licensing rules of      *
+#*   OCaml, this file is freely redistributable, modified or not,         *
+#*   without constraints.                                                 *
+#*                                                                        *
+#**************************************************************************
+
+# This script extracts the components from an OCaml version number
+# and provides them as C defines:
+# OCAML_VERSION_MAJOR: the major version number
+# OCAML_VERSION_MAJOR: the minor version number
+# OCAML_VERSION_PATCHLEVEL: the patchlevel number if present, or 0 if absent
+# OCAML_VERSION_ADDITIONAL: this is defined only if the additional-info
+#  field is present, and is a string that contains that field.
+# Note that additional-info is always absent in officially-released
+# versions of OCaml.
+
+# usage:
+# make-version-header.sh [version-file]
+# The argument is the VERSION file from the OCaml sources.
+# If the argument is not given, the version number from "ocamlc -v" will
+# be used.
+
+case $# in
+  0) version="`ocamlc -v | tr -d '\r' | sed -n -e 's/.*version //p'`";;
+  1) version="`sed -e 1q "$1" | tr -d '\r'`";;
+  *) echo "usage: make-version-header.sh [version-file]" >&2
+     exit 2;;
+esac
+
+major="`echo "$version" | sed -n -e '1s/^\([0-9]*\)\..*/\1/p'`"
+minor="`echo "$version" | sed -n -e '1s/^[0-9]*\.0*\([0-9]*\).*/\1/p'`"
+patchlvl="`echo "$version" | sed -n -e '1s/^[0-9]*\.[0-9]*\.\([0-9]*\).*/\1/p'`"
+suffix="`echo "$version" | sed -n -e '1s/^[^+~]*[+~]\(.*\)/\1/p'`"
+
+echo "#define OCAML_VERSION_MAJOR $major"
+printf '#define OCAML_VERSION_MINOR %d\n' "$minor"
+case $patchlvl in "") patchlvl=0;; esac
+echo "#define OCAML_VERSION_PATCHLEVEL $patchlvl"
+case "$suffix" in
+  "") echo "#undef OCAML_VERSION_ADDITIONAL";;
+  *) echo "#define OCAML_VERSION_ADDITIONAL \"$suffix\"";;
+esac
+printf '#define OCAML_VERSION %d%02d%02d\n' "$major" "$minor" "$patchlvl"
+echo "#define OCAML_VERSION_STRING \"$version\""
diff --git a/tools/make_opcodes.mll b/tools/make_opcodes.mll
new file mode 100644
index 00000000..67a09a29
--- /dev/null
+++ b/tools/make_opcodes.mll
@@ -0,0 +1,50 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                      Nicolas Ojeda Bar, LexiFi                         *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let ident = ['a'-'z''A'-'Z''_']['a'-'z''A'-'Z''0'-'9''_']*
+let space = [' ''\n''\r''\t']*
+
+rule find_enum = parse
+| "enum" space (ident as id) space '{' { id, opnames lexbuf }
+| _                                    { find_enum lexbuf }
+
+and opnames = parse
+| space (ident as op) space ','        { op :: opnames lexbuf }
+| space ident space '}'                { [] }
+
+{
+  let print_opnames = ref false
+  let print_opcodes = ref false
+
+  open Printf
+
+  let () =
+    let spec =
+      [
+        "-opnames", Arg.Set print_opnames, " Dump opcode names";
+        "-opcodes", Arg.Set print_opcodes, " Dump opcode numbers";
+      ]
+    in
+    Arg.parse (Arg.align spec) ignore "Extract opcode info from instruct.h";
+    let lexbuf = Lexing.from_channel stdin in
+    let id, opnames = find_enum lexbuf in
+    if !print_opnames then begin
+      printf "let names_of_%s = [|\n" id;
+      List.iter (fun s -> printf "  %S;\n" s) opnames;
+      printf "|]\n"
+    end;
+    if !print_opcodes then
+      List.iteri (fun i op -> printf "let op%s = %i\n" op i) opnames
+}
diff --git a/tools/mantis2gh_stripped.csv b/tools/mantis2gh_stripped.csv
new file mode 100644
index 00000000..f075e829
--- /dev/null
+++ b/tools/mantis2gh_stripped.csv
@@ -0,0 +1,1512 @@
+3,2325
+4,2327
+5,2329
+6,2330
+7,2332
+8,2333
+9,2337
+10,2338
+11,2339
+12,2340
+13,2341
+14,2342
+15,2343
+16,2345
+17,2346
+18,2348
+19,2350
+20,2351
+21,2354
+22,2355
+23,2356
+24,2358
+25,2359
+26,2360
+28,2361
+29,2362
+32,2363
+33,2364
+34,2365
+35,2366
+36,2367
+37,2369
+38,2371
+39,2373
+40,2374
+41,2376
+42,2377
+43,2378
+44,2380
+45,2381
+46,2382
+47,2383
+48,2385
+49,2386
+50,2387
+51,2388
+52,2389
+53,2390
+54,2391
+55,2392
+56,2393
+57,2394
+58,2396
+59,2397
+60,2399
+61,2400
+62,2401
+63,2402
+64,2404
+65,2405
+66,2406
+67,2407
+68,2408
+70,2409
+73,2410
+75,2411
+76,2412
+77,2414
+78,2416
+79,2417
+80,2418
+83,2419
+84,2420
+85,2421
+86,2423
+87,2424
+88,2425
+89,2426
+90,2427
+91,2428
+92,2429
+93,2431
+94,2432
+95,2433
+96,2434
+97,2435
+98,2436
+99,2437
+100,2438
+101,2439
+102,2440
+103,2441
+104,2442
+105,2443
+106,2444
+107,2445
+108,2447
+109,2448
+110,2451
+111,2452
+112,2453
+113,2454
+114,2456
+115,2457
+116,2459
+117,2460
+118,2461
+119,2462
+122,2463
+123,2464
+124,2465
+125,2466
+126,2467
+127,2468
+128,2469
+129,2471
+130,2472
+131,2474
+132,2477
+133,2478
+135,2479
+136,2481
+137,2483
+138,2484
+139,2489
+140,2492
+141,2493
+142,2495
+143,2499
+144,2502
+145,2504
+146,2506
+147,2507
+148,2508
+149,2509
+150,2510
+151,2511
+152,2513
+153,2516
+154,2517
+155,2519
+156,2520
+157,2521
+158,2523
+159,2524
+160,2527
+161,2528
+162,2530
+163,2531
+164,2532
+165,2534
+166,2535
+167,2536
+168,2537
+169,2538
+170,2539
+172,2540
+173,2541
+174,2542
+175,2543
+176,2545
+177,2546
+178,2548
+179,2551
+181,2554
+182,2556
+184,2559
+185,2563
+186,2565
+187,2566
+188,2567
+189,2568
+190,2569
+191,2570
+192,2571
+193,2574
+195,2576
+196,2577
+197,2579
+198,2580
+199,2581
+200,2582
+201,2583
+202,2584
+203,2587
+204,2588
+205,2590
+206,2591
+207,2592
+208,2593
+209,2594
+210,2596
+211,2597
+212,2598
+213,2599
+214,2600
+215,2603
+216,2604
+217,2605
+218,2606
+219,2607
+220,2608
+221,2609
+222,2613
+223,2615
+224,2616
+225,2617
+226,2619
+227,2620
+230,2621
+231,2622
+232,2623
+233,2624
+235,2625
+236,2626
+237,2627
+238,2628
+239,2630
+240,2631
+241,2632
+242,2633
+243,2635
+244,2636
+245,2638
+246,2640
+247,2641
+248,2642
+250,2643
+251,2645
+253,2646
+254,2647
+255,2648
+256,2650
+257,2651
+258,2653
+259,2656
+260,2657
+261,2658
+262,2659
+263,2664
+264,2665
+265,2666
+266,2668
+267,2669
+268,2670
+269,2671
+270,2672
+272,2673
+273,2674
+275,2675
+276,2676
+277,2677
+278,2678
+279,2679
+280,2680
+282,2681
+283,2682
+284,2683
+286,2684
+287,2685
+288,2686
+289,2687
+290,2688
+292,2689
+293,2690
+294,2691
+295,2692
+296,2693
+297,2694
+298,2695
+299,2696
+300,2697
+301,2698
+302,2699
+303,2700
+304,2701
+305,2702
+306,2703
+307,2704
+308,2705
+309,2706
+310,2707
+311,2708
+312,2709
+313,2710
+314,2711
+315,2712
+316,2713
+317,2716
+319,2721
+320,2724
+321,2726
+322,2728
+323,2729
+324,2730
+325,2731
+326,2733
+327,2734
+328,2735
+330,2736
+331,2738
+332,2740
+333,2741
+334,2742
+335,2743
+336,2744
+337,2745
+338,2746
+339,2747
+340,2748
+341,2749
+342,2750
+344,2751
+345,2752
+346,2753
+348,2754
+349,2755
+350,2756
+352,2757
+353,2758
+354,2759
+355,2760
+356,2761
+357,2762
+358,2763
+359,2764
+360,2765
+363,2766
+364,2767
+369,2768
+370,2769
+371,2770
+372,2771
+373,2772
+374,2773
+375,2774
+376,2775
+377,2776
+378,2777
+379,2778
+380,2779
+381,2780
+382,2781
+383,2782
+384,2783
+385,2784
+386,2789
+387,2790
+388,2791
+390,2793
+391,2794
+393,2795
+394,2796
+395,2797
+396,2803
+397,2805
+402,2806
+403,2807
+404,2808
+405,2809
+406,2810
+407,2811
+408,2812
+409,2813
+410,2814
+411,2815
+412,2816
+413,2817
+414,2818
+415,2819
+416,2820
+417,2821
+419,2822
+420,2823
+421,2824
+422,2825
+423,2826
+424,2827
+425,2828
+426,2829
+427,2830
+428,2831
+429,2832
+431,2833
+432,2834
+433,2835
+434,2836
+436,2837
+437,2838
+438,2839
+439,2840
+440,2841
+443,2842
+444,2843
+445,2844
+446,2845
+447,2846
+448,2847
+449,2850
+450,2851
+451,2852
+452,2853
+453,2856
+454,2862
+455,2863
+456,2864
+457,2867
+458,2869
+459,2870
+460,2871
+461,2872
+462,2874
+463,2875
+464,2876
+465,2877
+466,2878
+467,2884
+468,2885
+470,2887
+471,2888
+472,2892
+473,2894
+476,2895
+477,2897
+478,2898
+479,2899
+480,2900
+484,2901
+485,2902
+486,2905
+487,2907
+488,2908
+489,2913
+490,2914
+491,2917
+492,2924
+493,2925
+494,2926
+495,2929
+496,2930
+497,2933
+499,2934
+502,2936
+503,2938
+504,2940
+505,2941
+506,2943
+508,2945
+509,2948
+511,2951
+512,2956
+515,2957
+517,2958
+525,2959
+529,2960
+531,2961
+533,2962
+534,2963
+535,2965
+536,2966
+539,2967
+543,2968
+544,2970
+545,2972
+546,2973
+547,2974
+548,2975
+554,2976
+555,2977
+556,2978
+557,2979
+558,2983
+560,2984
+562,2985
+564,2986
+568,2987
+570,2988
+572,2989
+573,2990
+576,2991
+577,2992
+578,2993
+581,2995
+583,2996
+584,2997
+587,2998
+590,3000
+594,3001
+596,3003
+601,3004
+604,3005
+605,3006
+606,3007
+607,3008
+609,3009
+610,3014
+611,3016
+612,3017
+613,3018
+614,3020
+615,3022
+625,3024
+626,3025
+627,3026
+629,3027
+630,3029
+631,3030
+632,3031
+633,3032
+635,3035
+636,3037
+637,3038
+638,3039
+640,3041
+641,3042
+643,3043
+644,3044
+647,3045
+648,3049
+649,3050
+651,3051
+652,3053
+654,3054
+661,3055
+663,3058
+672,3059
+673,3060
+674,3061
+675,3062
+680,3063
+681,3064
+685,3065
+686,3066
+689,3067
+691,3068
+696,3070
+697,3071
+706,3073
+712,3076
+713,3078
+716,3081
+717,3082
+718,3083
+722,3084
+723,3086
+725,3087
+727,3090
+728,3091
+729,3092
+731,3093
+732,3094
+734,3095
+736,3096
+738,3097
+739,3098
+743,3099
+744,3101
+749,3102
+750,3103
+752,3105
+754,3106
+755,3107
+762,3109
+763,3110
+765,3111
+766,3112
+769,3116
+770,3117
+771,3118
+772,3119
+774,3120
+775,3122
+776,3125
+778,3126
+780,3127
+781,3128
+782,3129
+783,3130
+784,3131
+785,3132
+786,3133
+787,3134
+789,3135
+790,3136
+791,3137
+793,3138
+794,3139
+796,3144
+797,3145
+801,3146
+802,3147
+804,3148
+807,3149
+809,3151
+811,3152
+812,3153
+813,3155
+814,3156
+816,3158
+817,3159
+818,3160
+819,3163
+820,3164
+825,3165
+826,3167
+828,3168
+829,3169
+834,3170
+836,3171
+837,3172
+839,3174
+840,3175
+841,3176
+848,3180
+849,3181
+851,3183
+856,3184
+857,3185
+864,3186
+869,3187
+872,3189
+873,3192
+875,3193
+881,3197
+883,3199
+884,3200
+886,3201
+887,3202
+888,3203
+889,3204
+892,3205
+896,3207
+897,3208
+898,3210
+900,3211
+905,3212
+907,3215
+908,3216
+911,3217
+923,3218
+924,3219
+925,3220
+928,3221
+930,3223
+931,3225
+934,3226
+937,3227
+938,3228
+943,3229
+947,3230
+952,3233
+956,3234
+957,3235
+959,3237
+961,3240
+963,3241
+972,3245
+973,3246
+974,3250
+975,3251
+986,3253
+991,3255
+1001,3256
+1008,3257
+1013,3260
+1014,3261
+1015,3262
+1016,3264
+1017,3266
+1018,3268
+1019,3269
+1020,3271
+1023,3272
+1024,3275
+1025,3277
+1031,3278
+1035,3279
+1036,3282
+1037,3283
+1038,3284
+1039,3285
+1049,3287
+1055,3288
+1064,3289
+1065,3290
+1068,3291
+1069,3292
+1073,3293
+1085,3296
+1087,3297
+1097,3298
+1110,3301
+1111,3305
+1116,3306
+1117,3307
+1118,3308
+1120,3309
+1121,3313
+1122,3314
+1124,3315
+1125,3316
+1126,3317
+1127,3318
+1130,3319
+1131,3321
+1132,3323
+1133,3325
+1134,3326
+1135,3327
+1137,3332
+1139,3335
+1141,3336
+1142,3337
+1143,3338
+1144,3339
+1145,3340
+1147,3344
+1148,3347
+1149,3348
+1151,3350
+1153,3351
+1154,3352
+1156,3353
+1157,3354
+1158,3355
+1159,3356
+1160,3357
+1164,3358
+1165,3359
+1166,3360
+1167,3361
+1170,3362
+1172,3363
+1174,3364
+1176,3365
+1177,3366
+1178,3367
+1179,3368
+1180,3372
+1181,3373
+1183,3374
+1184,3375
+1185,3376
+1186,3377
+1187,3379
+1188,3380
+1189,3381
+1190,3383
+1191,3384
+1192,3385
+1193,3386
+1194,3387
+1196,3388
+1198,3390
+1199,3391
+1200,3393
+1202,3397
+1204,3398
+1205,3399
+1208,3402
+1213,3403
+1214,3405
+1216,3408
+1217,3410
+1222,3411
+1224,3413
+1225,3415
+1226,3417
+1227,3418
+1228,3419
+1229,3420
+1231,3421
+1234,3425
+1235,3426
+1236,3427
+1237,3434
+1241,3435
+1242,3436
+1244,3438
+1245,3440
+1248,3441
+1249,3442
+1250,3443
+1252,3445
+1253,3448
+1254,3449
+1255,3452
+1259,3453
+1260,3459
+1262,3460
+1263,3461
+1264,3466
+1269,3467
+1270,3470
+1272,3471
+1273,3472
+1274,3477
+1275,3478
+1276,3480
+1277,3481
+1278,3482
+1279,3484
+1280,3486
+1281,3487
+1282,3489
+1283,3491
+1284,3492
+1285,3493
+1287,3494
+1288,3496
+1289,3497
+1292,3498
+1293,3499
+1296,3500
+1297,3501
+1298,3502
+1299,3503
+1301,3505
+1303,3507
+1305,3513
+1306,3514
+1307,3515
+1309,3516
+1310,3517
+1311,3518
+1313,3519
+1314,3521
+1316,3522
+1317,3523
+1320,3524
+1321,3525
+1322,3527
+1323,3528
+1324,3529
+1325,3532
+1326,3533
+1333,3534
+1335,3535
+1336,3537
+1337,3538
+1341,3543
+1342,3547
+1343,3550
+1344,3551
+1346,3554
+1347,3557
+1349,3581
+1350,3583
+1351,3585
+1354,3588
+1355,3594
+1356,3596
+1357,3597
+1358,3598
+1359,3605
+1360,3611
+1361,3613
+1362,3614
+1363,3617
+1364,3618
+1365,3627
+1366,3629
+1367,3630
+1368,3631
+1369,3632
+1370,3633
+1371,3634
+1372,3639
+1373,3641
+1374,3643
+1375,3644
+1376,3645
+1377,3646
+1378,3648
+1379,3649
+1380,3650
+1381,3652
+1382,3653
+1383,3655
+1384,3656
+1386,3657
+1388,3661
+1389,3690
+1390,3696
+1391,3697
+1392,3706
+1393,3710
+1394,3711
+1395,3713
+1396,3717
+1397,3724
+1398,3734
+1399,3753
+1400,3754
+1401,3762
+1402,3779
+1403,3781
+1404,3782
+1405,3796
+1407,3808
+1408,3813
+1409,3814
+1410,3815
+1411,3834
+1412,3837
+1413,3840
+1414,3841
+1415,3843
+1416,3845
+1417,3846
+1418,3852
+1420,3854
+1421,3859
+1422,3865
+1423,3867
+1424,3872
+1425,3970
+1426,4291
+1427,4293
+1428,4294
+1431,5431
+1432,5909
+1433,5968
+1434,5969
+1435,5970
+1436,6247
+1437,6248
+1438,6249
+1439,6250
+1440,6251
+1441,6252
+1443,6255
+1444,6487
+1445,6783
+1446,7734
+1448,7736
+1449,7749
+1450,7761
+1451,7762
+1453,7763
+1454,7775
+1456,7801
+1457,7805
+1458,7806
+1459,7840
+1460,7848
+1461,7855
+1462,7871
+1463,7872
+1464,7934
+1465,7941
+1466,7942
+1467,7943
+1468,7944
+1469,7945
+1470,7946
+1471,7947
+1472,7948
+1473,7949
+1474,7950
+1475,7951
+1476,7952
+1477,7953
+1478,7954
+1479,7955
+1480,7956
+1481,7957
+1482,7958
+1484,7959
+1485,7960
+1486,7961
+1487,7962
+1488,7963
+1489,7964
+1490,7965
+1491,7966
+1492,7967
+1493,7968
+1494,7969
+1495,7970
+1496,7971
+1497,7972
+1498,7973
+1499,7974
+1500,7975
+1501,7976
+1502,7977
+1505,7978
+1506,7979
+1507,7980
+1508,7981
+1509,7982
+1510,7983
+1511,7984
+1512,7985
+1513,7986
+1514,7987
+1515,7988
+1516,7989
+1517,7990
+1518,7991
+1519,7992
+1520,7993
+1521,7994
+1522,7995
+1523,7996
+1524,7997
+1525,7998
+1526,7999
+1527,8000
+1528,8001
+1530,8002
+1531,8003
+1532,8004
+1533,8005
+1534,8006
+1535,8007
+1536,8008
+1537,8009
+1538,8010
+1539,8011
+1540,8012
+1541,8013
+1542,8014
+1543,8015
+1544,8016
+1545,8017
+1546,8018
+1547,8019
+1548,8020
+1549,8021
+1550,8022
+1551,8023
+1552,8024
+1553,8025
+1554,8026
+1555,8027
+1557,8028
+1558,8029
+1559,8030
+1560,8031
+1561,8032
+1562,8033
+1563,8034
+1564,8035
+1565,8036
+1566,8037
+1567,8038
+1568,8039
+1569,8040
+1570,8041
+1571,8042
+1572,8043
+1573,8044
+1574,8045
+1575,8046
+1576,8047
+1577,8048
+1578,8049
+1579,8050
+1580,8051
+1581,8052
+1582,8053
+1583,8054
+1584,8055
+1586,8056
+1587,8057
+1588,8058
+1590,8059
+1591,8060
+1592,8061
+1593,8062
+1594,8063
+1595,8064
+1596,8065
+1597,8066
+1598,8067
+1599,8068
+1600,8069
+1601,8070
+1602,8071
+1605,8072
+1606,8073
+1607,8074
+1608,8075
+1609,8076
+1610,8077
+1611,8078
+1613,8079
+1614,8080
+1615,8081
+1616,8082
+1617,8083
+1618,8084
+1619,8085
+1620,8086
+1621,8087
+1622,8088
+1623,8089
+1624,8090
+1625,8091
+1626,8092
+1627,8093
+1628,8094
+1629,8095
+1630,8096
+1631,8097
+1632,8098
+1633,8099
+1634,8100
+1635,8101
+1636,8102
+1637,8103
+1638,8104
+1639,8105
+1640,8106
+1641,8107
+1642,8108
+1643,8109
+1644,8110
+1645,8111
+1646,8112
+1647,8113
+1648,8114
+1649,8115
+1650,8116
+1651,8117
+1652,8118
+1654,8119
+1656,8120
+1657,8121
+1660,8122
+1662,8123
+1663,8124
+1664,8125
+1665,8126
+1666,8127
+1667,8128
+1668,8129
+1669,8130
+1670,8131
+1671,8132
+1672,8133
+1673,8134
+1674,8135
+1675,8136
+1676,8137
+1677,8138
+1678,8139
+1679,8140
+1680,8141
+1681,8142
+1682,8143
+1683,8144
+1686,8145
+1687,8146
+1688,8147
+1689,8148
+1690,8149
+1691,8150
+1692,8151
+1693,8152
+1694,8153
+1695,8154
+1696,8155
+1697,8156
+1698,8157
+1699,8158
+1700,8159
+1701,8160
+1702,8161
+1703,8162
+1704,8163
+1705,8164
+1706,8165
+1707,8166
+1708,8167
+1709,8168
+1710,8169
+1711,8170
+1712,8171
+1713,8172
+1714,8173
+1715,8174
+1716,8175
+1717,8176
+1720,8177
+1721,8178
+1722,8179
+1723,8180
+1724,8181
+1725,8182
+1726,8183
+1727,8184
+1728,8185
+1729,8186
+1730,8187
+1731,8188
+1732,8189
+1733,8190
+1734,8191
+1735,8192
+1736,8193
+1739,8194
+1741,8195
+1742,8196
+1743,8197
+1744,8198
+1745,8199
+1746,8200
+1747,8201
+1750,8202
+1751,8203
+1752,8204
+1753,8205
+1754,8206
+1755,8207
+1756,8208
+1757,8209
+1758,8210
+1759,8211
+1760,8212
+1761,8213
+1762,8214
+1763,8215
+1764,8216
+1765,8217
+1766,8218
+1767,8219
+1768,8220
+1769,8221
+1770,8222
+1771,8223
+1772,8224
+1773,8225
+1774,8226
+1775,8227
+1776,8228
+1777,8229
+1778,8230
+1779,8231
+1780,8232
+1781,8233
+1782,8234
+1783,8235
+1784,8236
+1785,8237
+1786,8238
+1787,8239
+1788,8240
+1789,8241
+1790,8242
+1791,8243
+1792,8244
+1793,8245
+1794,8246
+1795,8247
+1796,8248
+1798,8249
+1799,8250
+1800,8251
+1801,8252
+1802,8253
+1803,8254
+1804,8255
+1805,8256
+1806,8257
+1807,8258
+1808,8259
+1809,8260
+1810,8261
+1811,8262
+1813,8263
+1814,8264
+1815,8265
+1816,8266
+1817,8267
+1818,8268
+1819,8269
+1820,8270
+1821,8271
+1822,8272
+1823,8273
+1824,8274
+1825,8275
+1826,8276
+1827,8277
+1828,8278
+1829,8279
+1830,8280
+1831,8281
+1832,8282
+1833,8283
+1834,8284
+1835,8285
+1836,8286
+1837,8287
+1839,8288
+1840,8289
+1841,8290
+1842,8291
+1843,8292
+1844,8293
+1845,8294
+1846,8295
+1847,8296
+1848,8297
+1849,8298
+1850,8299
+1851,8300
+1852,8301
+1853,8302
+1856,8303
+1857,8304
+1858,8305
+1859,8306
+1860,8307
+1861,8308
+1862,8309
+1863,8310
+1864,8311
+1865,8312
+1866,8313
+1867,8314
+1868,8315
+1869,8316
+1870,8317
+1871,8318
+1872,8319
+1873,8320
+1876,8321
+1877,8322
+1878,8323
+1880,8324
+1881,8325
+1882,8326
+1883,8327
+1884,8328
+1885,8329
+1886,8330
+1887,8331
+1888,8332
+1890,8333
+1891,8334
+1892,8335
+1893,8336
+1894,8337
+1895,8338
+1896,8339
+1897,8340
+1898,8341
+1899,8342
+1900,8343
+1901,8344
+1902,8345
+1903,8346
+1904,8347
+1905,8348
+1906,8349
+1907,8350
+1908,8351
+1909,8352
+1910,8353
+1911,8354
+1913,8355
+1914,8356
+1915,8357
+1916,8358
+1917,8359
+1918,8360
+1919,8361
+1921,8362
+1922,8363
+1923,8364
+1924,8365
+1925,8366
+1926,8367
+1927,8368
+1928,8369
+1929,8370
+1930,8371
+1931,8372
+1932,8373
+1933,8374
+1934,8375
+1935,8376
+1936,8377
+1937,8378
+1938,8379
+1939,8380
+1940,8381
+1941,8382
+1942,8383
+1943,8384
+1944,8385
+1945,8386
+1946,8387
+1947,8388
+1948,8389
+1949,8390
+1952,8391
+1953,8392
+1954,8393
+1955,8394
+1956,8395
+1957,8396
+1959,8397
+1960,8398
+1961,8399
+1963,8400
+1964,8401
+1965,8402
+1967,8403
+1968,8404
+1969,8405
+1970,8406
+1971,8407
+1972,8408
+1973,8409
+1974,8410
+1975,8411
+1976,8412
+1977,8413
+1978,8414
+1979,8415
+1981,8416
+1982,8417
+1983,8418
+1984,8419
+1986,8420
+1987,8421
+1988,8422
+1989,8423
+1990,8424
+1991,8425
+1994,8426
+1996,8427
+1997,8428
+2008,8429
+2016,8430
+2017,8431
+2018,8432
+2019,8433
+2020,8434
+2021,8435
+2022,8436
+2024,8437
+2025,8438
+2026,8439
+2027,8440
+2029,8441
+2030,8442
+2031,8443
+2032,8444
+2035,8445
+2036,8446
+2045,8447
+2046,8448
+2047,8449
+2048,8450
+2049,8451
+2050,8452
+2051,8453
+2052,8454
+2053,8455
+2056,8456
+2058,8457
+2059,8458
+2060,8459
+2061,8460
+2074,8461
+2104,8462
+2106,8463
+2107,8464
+2117,8465
+2121,8466
+2122,8467
+2123,8468
+2124,8469
+2149,8470
+2154,8471
+2160,8472
+2166,8473
+2167,8474
+2170,8475
+2172,8476
+2173,8477
+2181,8478
+2187,8479
+2188,8480
+2198,8481
+2226,8482
+2230,8483
+2235,8484
+2262,8485
+2267,8486
+2269,8487
+2270,8488
+2271,8489
+2272,8490
+2273,8491
+2275,8492
+2278,8493
+2279,8494
+2285,8495
+2297,8496
+2301,8497
+2306,8498
+2309,8499
+2310,8500
+2311,8501
+2321,8502
diff --git a/tools/markdown-add-pr-links.sh b/tools/markdown-add-pr-links.sh
new file mode 100644
index 00000000..3b388006
--- /dev/null
+++ b/tools/markdown-add-pr-links.sh
@@ -0,0 +1,34 @@
+#!/bin/sh
+
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Gabriel Scherer, projet Parsifal, INRIA Saclay              *
+#*                                                                        *
+#*   Copyright 2018 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 script performs a series of transformation on standard input to
+# turn ASCII references into Markdown-format links:
+# - GPR#NNNN links to Github
+# - MPR#NNNN and PR#NNNN link to Mantis
+# - (Changes#VERSION) link to the Changes file
+
+# It was only tested with GNU sed. Sorry!
+
+GITHUB=https://github.com/ocaml/ocaml
+MANTIS=https://caml.inria.fr/mantis
+
+cat \
+| sed "s,GPR#\\([0-9]*\\),[GPR~#~\\1]($GITHUB/pull/\\1),g"\
+| sed "s,MPR#\\([0-9]*\\),[PR~#~\\1]($MANTIS/view.php?id=\\1),g"\
+| sed "s,PR#\\([0-9]*\\),[PR~#~\\1]($MANTIS/view.php?id=\\1),g"\
+| sed "s,(Changes#\\(.*\\)),[Changes file for \\1]($GITHUB/blob/\\1/Changes),g"\
+| sed "s,PR~#~,PR#,g" \
diff --git a/tools/msvs-promote-path b/tools/msvs-promote-path
new file mode 100755
index 00000000..b4f4f9d7
--- /dev/null
+++ b/tools/msvs-promote-path
@@ -0,0 +1,51 @@
+#!/usr/bin/env bash
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                David Allsopp, MetaStack Solutions Ltd.                 *
+#*                                                                        *
+#*   Copyright 2015 MetaStack Solutions Ltd.                              *
+#*                                                                        *
+#*   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.          *
+#*                                                                        *
+#**************************************************************************
+
+# Ensure that the Microsoft Linker isn't being messed up by /usr/bin/link
+if [ "`link --version | head -1 | \
+     fgrep "Microsoft (R) Incremental Linker"`" != "" ] ; then
+  echo "link already refers to the Microsoft Linker">&2
+  exit 0
+fi
+
+IFS=:
+T=
+FOUND=0
+FIRST=1
+for i in $PATH
+do
+  if [ $FIRST -eq 1 ] ; then
+    T="$i"
+    FIRST=0
+  else
+    if [ $FOUND -eq 0 -a -x $i/link ] && [ "`$i/link --version | head -1 | \
+                       fgrep "Microsoft (R) Incremental Linker"`" != "" ] ; then
+      FOUND=1
+      T="$i:$T"
+      PROM=$i
+    else
+      T="$T:$i"
+    fi
+  fi
+done
+unset IFS
+
+if [ $FOUND -eq 0 ] ; then
+  echo The Microsoft Linker was not found in any of the PATH entries!>&2
+  exit 1
+else
+  echo "$PROM moved to the front of \$PATH">&2
+  echo export PATH=\"$T\"
+fi
diff --git a/tools/objinfo.ml b/tools/objinfo.ml
new file mode 100644
index 00000000..d2a01995
--- /dev/null
+++ b/tools/objinfo.ml
@@ -0,0 +1,415 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*         Mehdi Dogguy, PPS laboratory, University Paris Diderot         *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*   Copyright 2010 Mehdi Dogguy                                          *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Dump info on .cmi, .cmo, .cmx, .cma, .cmxa, .cmxs files
+   and on bytecode executables. *)
+
+open Printf
+open Misc
+open Cmo_format
+
+(* Command line options to prevent printing approximation,
+   function code and CRC
+ *)
+let no_approx = ref false
+let no_code = ref false
+let no_crc = ref false
+
+module Magic_number = Misc.Magic_number
+
+let input_stringlist ic len =
+  let get_string_list sect len =
+    let rec fold s e acc =
+      if e != len then
+        if sect.[e] = '\000' then
+          fold (e+1) (e+1) (String.sub sect s (e-s) :: acc)
+        else fold s (e+1) acc
+      else acc
+    in fold 0 0 []
+  in
+  let sect = really_input_string ic len in
+  get_string_list sect len
+
+let dummy_crc = String.make 32 '-'
+let null_crc = String.make 32 '0'
+
+let string_of_crc crc = if !no_crc then null_crc else Digest.to_hex crc
+
+let print_name_crc (name, crco) =
+  let crc =
+    match crco with
+      None -> dummy_crc
+    | Some crc -> string_of_crc crc
+  in
+    printf "\t%s\t%s\n" crc name
+
+let print_line name =
+  printf "\t%s\n" name
+
+let print_required_global id =
+  printf "\t%s\n" (Ident.name id)
+
+let print_cmo_infos cu =
+  printf "Unit name: %s\n" cu.cu_name;
+  print_string "Interfaces imported:\n";
+  List.iter print_name_crc cu.cu_imports;
+  print_string "Required globals:\n";
+  List.iter print_required_global cu.cu_required_globals;
+  printf "Uses unsafe features: ";
+  (match cu.cu_primitives with
+    | [] -> printf "no\n"
+    | l  ->
+        printf "YES\n";
+        printf "Primitives declared in this module:\n";
+        List.iter print_line l);
+  printf "Force link: %s\n" (if cu.cu_force_link then "YES" else "no")
+
+let print_spaced_string s =
+  printf " %s" s
+
+let print_cma_infos (lib : Cmo_format.library) =
+  printf "Force custom: %s\n" (if lib.lib_custom then "YES" else "no");
+  printf "Extra C object files:";
+  (* PR#4949: print in linking order *)
+  List.iter print_spaced_string (List.rev lib.lib_ccobjs);
+  printf "\nExtra C options:";
+  List.iter print_spaced_string (List.rev lib.lib_ccopts);
+  printf "\n";
+  print_string "Extra dynamically-loaded libraries:";
+  List.iter print_spaced_string (List.rev lib.lib_dllibs);
+  printf "\n";
+  List.iter print_cmo_infos lib.lib_units
+
+let print_cmi_infos name crcs =
+  printf "Unit name: %s\n" name;
+  printf "Interfaces imported:\n";
+  List.iter print_name_crc crcs
+
+let print_cmt_infos cmt =
+  let open Cmt_format in
+  printf "Cmt unit name: %s\n" cmt.cmt_modname;
+  print_string "Cmt interfaces imported:\n";
+  List.iter print_name_crc cmt.cmt_imports;
+  printf "Source file: %s\n"
+         (match cmt.cmt_sourcefile with None -> "(none)" | Some f -> f);
+  printf "Compilation flags:";
+  Array.iter print_spaced_string cmt.cmt_args;
+  printf "\nLoad path:";
+  List.iter print_spaced_string cmt.cmt_loadpath;
+  printf "\n";
+  printf "cmt interface digest: %s\n"
+    (match cmt.cmt_interface_digest with
+     | None -> ""
+     | Some crc -> string_of_crc crc)
+
+let print_general_infos name crc defines cmi cmx =
+  printf "Name: %s\n" name;
+  printf "CRC of implementation: %s\n" (string_of_crc crc);
+  printf "Globals defined:\n";
+  List.iter print_line defines;
+  printf "Interfaces imported:\n";
+  List.iter print_name_crc cmi;
+  printf "Implementations imported:\n";
+  List.iter print_name_crc cmx
+
+let print_global_table table =
+  printf "Globals defined:\n";
+  Symtable.iter_global_map
+    (fun id _ -> print_line (Ident.name id))
+    table
+
+open Cmx_format
+open Cmxs_format
+
+let print_cmx_infos (ui, crc) =
+  print_general_infos
+    ui.ui_name crc ui.ui_defines ui.ui_imports_cmi ui.ui_imports_cmx;
+  begin match ui.ui_export_info with
+  | Clambda approx ->
+    if not !no_approx then begin
+      printf "Clambda approximation:\n";
+      Format.fprintf Format.std_formatter "  %a@." Printclambda.approx approx
+    end else
+      Format.printf "Clambda unit@.";
+  | Flambda export ->
+    if not !no_approx || not !no_code then
+      printf "Flambda export information:\n"
+    else
+      printf "Flambda unit\n";
+    if not !no_approx then begin
+      let cu =
+        Compilation_unit.create (Ident.create_persistent ui.ui_name)
+          (Linkage_name.create "__dummy__")
+      in
+      Compilation_unit.set_current cu;
+      let root_symbols =
+        List.map (fun s ->
+            Symbol.of_global_linkage cu (Linkage_name.create ("caml"^s)))
+          ui.ui_defines
+      in
+      Format.printf "approximations@ %a@.@."
+        Export_info.print_approx (export, root_symbols)
+    end;
+    if not !no_code then
+      Format.printf "functions@ %a@.@."
+        Export_info.print_functions export
+  end;
+  let pr_funs _ fns =
+    List.iter (fun arity -> printf " %d" arity) fns in
+  printf "Currying functions:%a\n" pr_funs ui.ui_curry_fun;
+  printf "Apply functions:%a\n" pr_funs ui.ui_apply_fun;
+  printf "Send functions:%a\n" pr_funs ui.ui_send_fun;
+  printf "Force link: %s\n" (if ui.ui_force_link then "YES" else "no")
+
+let print_cmxa_infos (lib : Cmx_format.library_infos) =
+  printf "Extra C object files:";
+  List.iter print_spaced_string (List.rev lib.lib_ccobjs);
+  printf "\nExtra C options:";
+  List.iter print_spaced_string (List.rev lib.lib_ccopts);
+  printf "\n";
+  List.iter print_cmx_infos lib.lib_units
+
+let print_cmxs_infos header =
+  List.iter
+    (fun ui ->
+       print_general_infos
+         ui.dynu_name
+         ui.dynu_crc
+         ui.dynu_defines
+         ui.dynu_imports_cmi
+         ui.dynu_imports_cmx)
+    header.dynu_units
+
+let p_title title = printf "%s:\n" title
+
+let p_section title = function
+  | [] -> ()
+  | l ->
+      p_title title;
+      List.iter print_name_crc l
+
+let p_list title print = function
+  | [] -> ()
+  | l ->
+      p_title title;
+      List.iter print l
+
+let dump_byte ic =
+  Bytesections.read_toc ic;
+  let toc = Bytesections.toc () in
+  let toc = List.sort Stdlib.compare toc in
+  List.iter
+    (fun (section, _) ->
+       try
+         let len = Bytesections.seek_section ic section in
+         if len > 0 then match section with
+           | "CRCS" ->
+               p_section
+                 "Imported units"
+                 (input_value ic : (string * Digest.t option) list)
+           | "DLLS" ->
+               p_list
+                 "Used DLLs"
+                 print_line
+                 (input_stringlist ic len)
+           | "DLPT" ->
+               p_list
+                 "Additional DLL paths"
+                 print_line
+                 (input_stringlist ic len)
+           | "PRIM" ->
+               p_list
+                 "Primitives used"
+                 print_line
+                 (input_stringlist ic len)
+           | "SYMB" ->
+               print_global_table (input_value ic)
+           | _ -> ()
+       with _ -> ()
+    )
+    toc
+
+let find_dyn_offset filename =
+  let helper = Filename.concat Config.standard_library "objinfo_helper" in
+  let tempfile = Filename.temp_file "objinfo" ".out" in
+  match
+    Fun.protect
+      ~finally:(fun () -> remove_file tempfile)
+      (fun () ->
+         let rc =
+           Sys.command
+             (Filename.quote_command helper ~stdout:tempfile [filename])
+         in
+         if rc <> 0 then failwith "cannot read";
+         let tc = Scanf.Scanning.from_file tempfile in
+         Fun.protect
+           ~finally:(fun () -> Scanf.Scanning.close_in tc)
+           (fun () ->
+              Scanf.bscanf tc "%Ld" (fun x -> x)))
+  with
+    | offset -> Some offset
+    | exception (Failure _ | Sys_error _) -> None
+
+let exit_err msg = print_endline msg; exit 2
+let exit_errf fmt = Printf.ksprintf exit_err fmt
+
+let exit_magic_msg msg =
+  exit_errf
+     "Wrong magic number:\n\
+      this tool only supports object files produced by compiler version\n\
+      \t%s\n\
+      %s"
+    Sys.ocaml_version msg
+
+let exit_magic_error ~expected_kind err =
+  exit_magic_msg Magic_number.(match err with
+    | Parse_error err -> explain_parse_error expected_kind err
+    | Unexpected_error err -> explain_unexpected_error err)
+
+(* assume that 'ic' is already positioned at the right place
+   depending on the format (usually right after the magic number,
+   but Exec and Cmxs differ) *)
+let dump_obj_by_kind filename ic obj_kind =
+  let open Magic_number in
+  match obj_kind with
+    | Cmo ->
+       let cu_pos = input_binary_int ic in
+       seek_in ic cu_pos;
+       let cu = (input_value ic : compilation_unit) in
+       close_in ic;
+       print_cmo_infos cu
+    | Cma ->
+       let toc_pos = input_binary_int ic in
+       seek_in ic toc_pos;
+       let toc = (input_value ic : library) in
+       close_in ic;
+       print_cma_infos toc
+    | Cmi | Cmt ->
+       close_in ic;
+       let cmi, cmt = Cmt_format.read filename in
+       begin match cmi with
+         | None -> ()
+         | Some cmi ->
+            print_cmi_infos cmi.Cmi_format.cmi_name cmi.Cmi_format.cmi_crcs
+       end;
+       begin match cmt with
+         | None -> ()
+         | Some cmt -> print_cmt_infos cmt
+       end
+    | Cmx _config ->
+       let ui = (input_value ic : unit_infos) in
+       let crc = Digest.input ic in
+       close_in ic;
+       print_cmx_infos (ui, crc)
+    | Cmxa _config ->
+       let li = (input_value ic : library_infos) in
+       close_in ic;
+       print_cmxa_infos li
+    | Exec ->
+       (* no assumptions on [ic] position,
+          [dump_byte] will seek at the right place *)
+       dump_byte ic;
+       close_in ic
+    | Cmxs ->
+       (* we assume we are at the offset of the dynamic information,
+          as returned by [find_dyn_offset]. *)
+       let header = (input_value ic : dynheader) in
+       close_in ic;
+       print_cmxs_infos header;
+    | Ast_impl | Ast_intf ->
+       exit_errf "The object file type %S \
+                  is currently unsupported by this tool."
+         (human_name_of_kind obj_kind)
+
+let dump_obj filename =
+  let open Magic_number in
+  let dump_standard ic =
+    match read_current_info ~expected_kind:None ic with
+      | Error ((Unexpected_error _) as err) ->
+         exit_magic_error ~expected_kind:None err
+      | Ok { kind; version = _ } ->
+         dump_obj_by_kind filename ic kind;
+         Ok ()
+      | Error (Parse_error head_error) ->
+         Error head_error
+  and dump_exec ic =
+    let pos_trailer = in_channel_length ic - Magic_number.magic_length in
+    let _ = seek_in ic pos_trailer in
+    let expected_kind = Some Exec in
+    match read_current_info ~expected_kind ic with
+      | Error ((Unexpected_error _) as err) ->
+         exit_magic_error ~expected_kind err
+      | Ok _ ->
+         dump_obj_by_kind filename ic Exec;
+         Ok ()
+      | Error (Parse_error _)  ->
+         Error ()
+  and dump_cmxs ic =
+    flush stdout;
+    match find_dyn_offset filename with
+      | None ->
+         exit_errf "Unable to read info on %s %s."
+           (human_name_of_kind Cmxs) filename
+      | Some offset ->
+         LargeFile.seek_in ic offset;
+         let header = (input_value ic : dynheader) in
+         let expected_kind = Some Cmxs in
+         match parse header.dynu_magic with
+           | Error err ->
+              exit_magic_error ~expected_kind (Parse_error err)
+           | Ok info ->
+         match check_current Cmxs info with
+           | Error err ->
+              exit_magic_error ~expected_kind (Unexpected_error err)
+           | Ok () ->
+         LargeFile.seek_in ic offset;
+         dump_obj_by_kind filename ic Cmxs;
+         ()
+  in
+  printf "File %s\n" filename;
+  let ic = open_in_bin filename in
+  match dump_standard ic with
+    | Ok () -> ()
+    | Error head_error ->
+  match dump_exec ic with
+    | Ok () -> ()
+    | Error () ->
+  if Filename.check_suffix filename ".cmxs"
+  then dump_cmxs ic
+  else exit_magic_error ~expected_kind:None (Parse_error head_error)
+
+let arg_list = [
+  "-no-approx", Arg.Set no_approx,
+    " Do not print module approximation information";
+  "-no-code", Arg.Set no_code,
+    " Do not print code from exported flambda functions";
+  "-null-crc", Arg.Set no_crc, " Print a null CRC for imported interfaces";
+  "-args", Arg.Expand Arg.read_arg,
+     " Read additional newline separated command line arguments \n\
+     \      from ";
+  "-args0", Arg.Expand Arg.read_arg0,
+     " Read additional NUL separated command line arguments from \n\
+     \      ";
+]
+let arg_usage =
+   Printf.sprintf "%s [OPTIONS] FILES : give information on files" Sys.argv.(0)
+
+let main() =
+  Arg.parse_expand arg_list dump_obj arg_usage;
+  exit 0
+
+let _ = main ()
diff --git a/tools/objinfo_helper.c b/tools/objinfo_helper.c
new file mode 100644
index 00000000..fe3ebd42
--- /dev/null
+++ b/tools/objinfo_helper.c
@@ -0,0 +1,148 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*         Mehdi Dogguy, PPS laboratory, University Paris Diderot         */
+/*                                                                        */
+/*   Copyright 2010 Mehdi Dogguy                                          */
+/*                                                                        */
+/*   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.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include "caml/s.h"
+#include 
+
+#ifdef HAS_LIBBFD
+#include 
+#include 
+#include 
+
+// PACKAGE: protect against binutils change
+//   https://sourceware.org/bugzilla/show_bug.cgi?id=14243
+#define PACKAGE "ocamlobjinfo"
+#include 
+#undef PACKAGE
+
+#define plugin_header_sym (symbol_prefix "caml_plugin_header")
+
+/* We need to refer to a few functions of the BFD library that are */
+/* actually defined as macros. We thus define equivalent */
+/* functions below */
+
+long get_static_symtab_upper_bound(bfd *fd)
+{
+  return bfd_get_symtab_upper_bound(fd);
+}
+
+long get_dynamic_symtab_upper_bound(bfd *fd)
+{
+  return bfd_get_dynamic_symtab_upper_bound(fd);
+}
+
+long canonicalize_static_symtab(bfd * fd, asymbol **symbolTable)
+{
+  return bfd_canonicalize_symtab(fd, symbolTable);
+}
+
+long canonicalize_dynamic_symtab(bfd * fd, asymbol **symbolTable)
+{
+  return bfd_canonicalize_dynamic_symtab(fd, symbolTable);
+}
+
+typedef struct {
+  long (*get_upper_bound)(bfd *);
+  long (*canonicalize)(bfd *, asymbol **);
+} symTable_ops;
+
+symTable_ops staticSymTable_ops = {
+  &get_static_symtab_upper_bound,
+  &canonicalize_static_symtab
+};
+
+symTable_ops dynamicSymTable_ops = {
+  &get_dynamic_symtab_upper_bound,
+  &canonicalize_dynamic_symtab
+};
+
+/* Print an error message and exit */
+static void error(bfd *fd, char *msg, ...)
+{
+  va_list ap;
+  va_start(ap, msg);
+  vfprintf (stderr, msg, ap);
+  va_end(ap);
+  fprintf(stderr, "\n");
+  if (fd!=NULL) bfd_close(fd);
+  exit(2);
+}
+
+/* Look for plugin_header_sym in the specified symbol table */
+/* Return its address, -1 if not found */
+long lookup(bfd* fd, symTable_ops *ops)
+{
+  long st_size;
+  asymbol ** symbol_table;
+  long sym_count, i;
+
+  st_size = ops->get_upper_bound (fd);
+  if (st_size <= 0) return -1;
+
+  symbol_table = malloc(st_size);
+  if (! symbol_table)
+    error(fd, "Error: out of memory");
+
+  sym_count = ops->canonicalize (fd, symbol_table);
+
+  for (i = 0; i < sym_count; i++) {
+    if (strcmp(symbol_table[i]->name, plugin_header_sym) == 0)
+      return symbol_table[i]->value;
+  }
+  return -1;
+}
+
+int main(int argc, char ** argv)
+{
+  bfd *fd;
+  asection *sec;
+  file_ptr offset;
+  long value;
+
+  if (argc != 2)
+    error(NULL, "Usage: objinfo_helper ");
+
+  fd = bfd_openr(argv[1], "default");
+  if (!fd)
+    error(NULL, "Error opening file %s", argv[1]);
+  if (! bfd_check_format (fd, bfd_object))
+    error(fd, "Error: wrong format");
+
+  sec = bfd_get_section_by_name(fd, ".data");
+  if (! sec)
+    error(fd, "Error: section .data not found");
+
+  offset = sec->filepos;
+
+  value = lookup(fd, &dynamicSymTable_ops);
+
+  if (value == -1)
+    value = lookup(fd, &staticSymTable_ops);
+  bfd_close(fd);
+
+  if (value == -1)
+    error(NULL, "Error: missing symbol %s", plugin_header_sym);
+
+  printf("%ld\n", (long) offset + value);
+}
+
+#else
+
+int main(int argc, char ** argv)
+{
+  fprintf(stderr,"BFD library unavailable, cannot print info on .cmxs files\n");
+  return 2;
+}
+
+#endif
diff --git a/tools/ocaml-objcopy-macosx b/tools/ocaml-objcopy-macosx
new file mode 100755
index 00000000..2a51773f
--- /dev/null
+++ b/tools/ocaml-objcopy-macosx
@@ -0,0 +1,54 @@
+#!/usr/bin/env bash
+
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*           Damien Doligez, projet Cristal, INRIA Rocquencourt           *
+#*                                                                        *
+#*   Copyright 2005 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.          *
+#*                                                                        *
+#**************************************************************************
+
+TMP="${TMPDIR=/tmp}"
+TEMP="${TMP}"/ocaml-objcopy-$$.o
+UNDEF="${TMP}"/ocaml-objcopy-$$.sym
+
+usage () {
+  echo "usage: objcopy {--redefine-sym =} file.o" >&2
+  exit 2
+}
+
+: > "$UNDEF"
+
+while : ; do
+  case $# in
+    0) break;;
+    *) case $1 in
+         --redefine-sym)
+           case $2 in
+             *=*) ALIAS="$ALIAS -i${2#*=}:${2%%=*}"
+                  echo ${2%%=*} >>"$UNDEF"
+                  ;;
+             *) usage;;
+           esac
+           shift 2
+           ;;
+         -*) usage;;
+         *) case $FILE in
+              "") FILE=$1; shift;;
+              *) usage;;
+            esac;;
+       esac;;
+  esac
+done
+
+ld -o "$TEMP" -r $ALIAS "$FILE"
+ld -o "$FILE" -r -unexported_symbols_list "$UNDEF" "$TEMP"
+
+rm -f "$TEMP" "$UNDEF"
diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml
new file mode 100644
index 00000000..d799fff4
--- /dev/null
+++ b/tools/ocamlcp.ml
@@ -0,0 +1,93 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1998 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Printf
+
+let make_archive = ref false;;
+let with_impl = ref false;;
+let with_intf = ref false;;
+let with_mli = ref false;;
+let with_ml = ref false;;
+
+let process_file filename =
+  if Filename.check_suffix filename ".ml" then with_ml := true;
+  if Filename.check_suffix filename ".mli" then with_mli := true;
+;;
+
+let usage = "Usage: ocamlcp  \noptions are:"
+
+let incompatible o =
+  fprintf stderr "ocamlcp: profiling is incompatible with the %s option\n" o;
+  exit 2
+
+module Options = Main_args.Make_bytecomp_options (struct
+    include Main_args.Default.Main
+    let _a () = make_archive := true
+    let _impl _ = with_impl := true
+    let _intf _ = with_intf := true
+    let _pp _ = incompatible "-pp"
+    let _ppx _ = incompatible "-ppx"
+    let anonymous = process_file
+  end);;
+
+let rev_compargs = ref ([] : string list)
+let rev_profargs = ref ([] : string list)
+
+let add_profarg s =
+  rev_profargs := (Filename.quote s) :: "-m" :: !rev_profargs
+;;
+
+let anon filename =
+  process_file filename;
+  rev_compargs := Filename.quote filename :: !rev_compargs
+;;
+
+let optlist =
+    ("-P", Arg.String add_profarg,
+           "[afilmt]  Profile constructs specified by argument (default fm):\n\
+        \032     a  Everything\n\
+        \032     f  Function calls and method calls\n\
+        \032     i  if ... then ... else\n\
+        \032     l  while and for loops\n\
+        \032     m  match ... with\n\
+        \032     t  try ... with")
+    :: ("-p", Arg.String add_profarg, "[afilmt]  Same as option -P")
+    :: Main_args.options_with_command_line_syntax Options.list rev_compargs
+in
+Arg.parse_expand optlist anon usage;
+if !with_impl && !with_intf then begin
+  fprintf stderr "ocamlcp cannot deal with both \"-impl\" and \"-intf\"\n";
+  fprintf stderr "please compile interfaces and implementations separately\n";
+  exit 2;
+end else if !with_impl && !with_mli then begin
+  fprintf stderr "ocamlcp cannot deal with both \"-impl\" and .mli files\n";
+  fprintf stderr "please compile interfaces and implementations separately\n";
+  exit 2;
+end else if !with_intf && !with_ml then begin
+  fprintf stderr "ocamlcp cannot deal with both \"-intf\" and .ml files\n";
+  fprintf stderr "please compile interfaces and implementations separately\n";
+  exit 2;
+end;
+if !with_impl then rev_profargs := "-impl" :: !rev_profargs;
+if !with_intf then rev_profargs := "-intf" :: !rev_profargs;
+let status =
+  Sys.command
+    (Printf.sprintf "ocamlc -pp \"ocamlprof -instrument %s\" %s %s"
+        (String.concat " " (List.rev !rev_profargs))
+        (if !make_archive then "" else "profiling.cmo")
+        (String.concat " " (List.rev !rev_compargs)))
+in
+exit status
+;;
diff --git a/tools/ocamldep.ml b/tools/ocamldep.ml
new file mode 100644
index 00000000..e1971fa8
--- /dev/null
+++ b/tools/ocamldep.ml
@@ -0,0 +1 @@
+let () = Makedepend.main ()
diff --git a/tools/ocamlmklib.ml b/tools/ocamlmklib.ml
new file mode 100644
index 00000000..d5bb84ca
--- /dev/null
+++ b/tools/ocamlmklib.ml
@@ -0,0 +1,363 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Printf
+open Ocamlmklibconfig
+
+let syslib x =
+  if Config.ccomp_type = "msvc" then x ^ ".lib" else "-l" ^ x
+
+let mklib out files opts =
+  if Config.ccomp_type = "msvc"
+  then let machine =
+    if Config.architecture="amd64"
+    then "-machine:AMD64 "
+    else ""
+  in
+  Printf.sprintf "link -lib -nologo %s-out:%s %s %s"
+                 machine out opts files
+  else Printf.sprintf "%s rcs %s %s %s && %s %s"
+                      Config.ar out opts files Config.ranlib out
+
+(* PR#4783: under Windows, don't use absolute paths because we do
+   not know where the binary distribution will be installed. *)
+let compiler_path name =
+  if Sys.os_type = "Win32" then name else Filename.concat bindir name
+
+let bytecode_objs = ref []  (* .cmo,.cma,.ml,.mli files to pass to ocamlc *)
+and native_objs = ref []    (* .cmx,.ml,.mli files to pass to ocamlopt *)
+and c_objs = ref []         (* .o, .a, .obj, .lib, .dll, .dylib, .so files to
+                               pass to mksharedlib and ar *)
+and caml_libs = ref []      (* -cclib to pass to ocamlc, ocamlopt *)
+and caml_opts = ref []      (* -ccopt to pass to ocamlc, ocamlopt *)
+and dynlink = ref supports_shared_libraries
+and failsafe = ref false    (* whether to fall back on static build only *)
+and c_libs = ref []         (* libs to pass to mksharedlib and ocamlc -cclib *)
+and c_Lopts = ref []      (* options to pass to mksharedlib and ocamlc -cclib *)
+and c_opts = ref []       (* options to pass to mksharedlib and ocamlc -ccopt *)
+and ld_opts = ref []        (* options to pass only to the linker *)
+and ocamlc = ref (compiler_path "ocamlc")
+and ocamlc_opts = ref []    (* options to pass only to ocamlc *)
+and ocamlopt = ref (compiler_path "ocamlopt")
+and ocamlopt_opts = ref []  (* options to pass only to ocamlc *)
+and output = ref "a"        (* Output name for OCaml part of library *)
+and output_c = ref ""       (* Output name for C part of library *)
+and rpath = ref []          (* rpath options *)
+and debug = ref false       (* -g option *)
+and verbose = ref false
+
+let starts_with s pref =
+  String.length s >= String.length pref &&
+  String.sub s 0 (String.length pref) = pref
+let ends_with = Filename.check_suffix
+let chop_prefix s pref =
+  String.sub s (String.length pref) (String.length s - String.length pref)
+let chop_suffix = Filename.chop_suffix
+
+exception Bad_argument of string
+
+let print_version () =
+  printf "ocamlmklib, version %s\n" Sys.ocaml_version;
+  exit 0;
+;;
+
+let print_version_num () =
+  printf "%s\n" Sys.ocaml_version;
+  exit 0;
+;;
+
+let parse_arguments argv =
+  let args = Stack.create () in
+  let push_args ~first arr =
+    for i = Array.length arr - 1 downto first do
+      Stack.push arr.(i) args
+    done
+  in
+  let next_arg s =
+    if Stack.is_empty args
+    then raise (Bad_argument("Option " ^ s ^ " expects one argument"));
+    Stack.pop args
+  in
+  push_args ~first:1 argv;
+  while not (Stack.is_empty args) do
+    let s = Stack.pop args in
+    if s = "-args" then
+      push_args ~first:0 (Arg.read_arg (next_arg s))
+    else if s = "-args0" then
+      push_args ~first:0 (Arg.read_arg0 (next_arg s))
+    else if ends_with s ".cmo" || ends_with s ".cma" then
+      bytecode_objs := s :: !bytecode_objs
+    else if ends_with s ".cmx" then
+      native_objs := s :: !native_objs
+    else if ends_with s ".ml" || ends_with s ".mli" then
+     (bytecode_objs := s :: !bytecode_objs;
+      native_objs := s :: !native_objs)
+    else if List.exists (ends_with s)
+                        [".o"; ".a"; ".obj"; ".lib"; ".dll"; ".dylib"; ".so"]
+    then
+      c_objs := s :: !c_objs
+    else if s = "-cclib" then
+      caml_libs := next_arg s :: "-cclib" :: !caml_libs
+    else if s = "-ccopt" then
+      caml_opts := next_arg s :: "-ccopt" :: !caml_opts
+    else if s = "-custom" then
+      dynlink := false
+    else if s = "-I" then
+      caml_opts := next_arg s :: "-I" :: !caml_opts
+    else if s = "-failsafe" then
+      failsafe := true
+    else if s = "-g" then
+      debug := true
+    else if s = "-h" || s = "-help" || s = "--help" then
+      raise (Bad_argument "")
+    else if s = "-ldopt" then
+      ld_opts := next_arg s :: !ld_opts
+    else if s = "-linkall" then
+      caml_opts := s :: !caml_opts
+    else if starts_with s "-l" then
+      let s =
+        if Config.ccomp_type = "msvc" then
+          String.sub s 2 (String.length s - 2) ^ ".lib"
+        else
+          s
+      in
+      c_libs := s :: !c_libs
+    else if starts_with s "-L" then
+     (c_Lopts := s :: !c_Lopts;
+      let l = chop_prefix s "-L" in
+      if not (Filename.is_relative l) then rpath := l :: !rpath)
+    else if s = "-ocamlcflags" then
+      ocamlc_opts := next_arg s :: !ocamlc_opts
+    else if s = "-ocamlc" then
+      ocamlc := next_arg s
+    else if s = "-ocamlopt" then
+      ocamlopt := next_arg s
+    else if s = "-ocamloptflags" then
+      ocamlopt_opts := next_arg s :: !ocamlopt_opts
+    else if s = "-o" then
+      output := next_arg s
+    else if s = "-oc" then
+      output_c := next_arg s
+    else if s = "-dllpath" || s = "-R" || s = "-rpath" then
+      rpath := next_arg s :: !rpath
+    else if starts_with s "-R" then
+      rpath := chop_prefix s "-R" :: !rpath
+    else if s = "-Wl,-rpath" then
+     (let a = next_arg s in
+      if starts_with a "-Wl,"
+      then rpath := chop_prefix a "-Wl," :: !rpath
+      else raise (Bad_argument("Option -Wl,-rpath expects a -Wl, argument")))
+    else if starts_with s "-Wl,-rpath," then
+      rpath := chop_prefix s "-Wl,-rpath," :: !rpath
+    else if starts_with s "-Wl,-R" then
+      rpath := chop_prefix s "-Wl,-R" :: !rpath
+    else if s = "-v" || s = "-verbose" then
+      verbose := true
+    else if s = "-version" then
+      print_version ()
+    else if s = "-vnum" then
+      print_version_num ()
+    else if starts_with s "-F" then
+      c_opts := s :: !c_opts
+    else if s = "-framework" then
+      (let a = next_arg s in c_opts := a :: s :: !c_opts)
+    else if starts_with s "-" then
+      prerr_endline ("Unknown option " ^ s)
+    else
+      raise (Bad_argument("Don't know what to do with " ^ s))
+  done;
+  List.iter
+    (fun r -> r := List.rev !r)
+    [ bytecode_objs; native_objs; caml_libs; caml_opts;
+      c_libs; c_objs; c_opts; ld_opts; rpath ];
+(* Put -L options in front of -l options in -cclib to mimic -ccopt behavior *)
+  c_libs := !c_Lopts @ !c_libs;
+
+  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    Read additional newline-terminated command line arguments\
+\n                 from \
+\n  -args0   Read additional null character terminated command line\
+\n                 arguments from \
+\n  -cclib    C library passed to ocamlc -a or ocamlopt -a only\
+\n  -ccopt    C option passed to ocamlc -a or ocamlopt -a only\
+\n  -custom        Disable dynamic loading\
+\n  -g             Build with debug information\
+\n  -dllpath  Add  to the run-time search path for DLLs\
+\n  -F        Specify a framework directory (MacOSX)\
+\n  -framework     Use framework  (MacOSX)\
+\n  -help          Print this help message and exit\
+\n  --help         Same as -help\
+\n  -h             Same as -help\
+\n  -I        Add  to the path searched for OCaml object files\
+\n  -failsafe      fall back to static linking if DLL construction failed\
+\n  -ldopt    C option passed to the shared linker only\
+\n  -linkall       Build OCaml archive with link-all behavior\
+\n  -l        Specify a dependent C library\
+\n  -L        Add  to the path searched for C libraries\
+\n  -ocamlc   Use  in place of \"ocamlc\"\
+\n  -ocamlcflags     Pass  to ocamlc\
+\n  -ocamlopt  Use  in place of \"ocamlopt\"\
+\n  -ocamloptflags   Pass  to ocamlopt\
+\n  -o       Generated OCaml library is named .cma or .cmxa\
+\n  -oc      Generated C library is named dll.so or lib.a\
+\n  -rpath    Same as -dllpath \
+\n  -R        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,     Same as -dllpath \
+\n  -Wl,-rpath -Wl, Same as -dllpath \
+\n  -Wl,-R          Same as -dllpath \
+\n"
+
+let command cmd =
+  if !verbose then (print_string "+ "; print_string cmd; print_newline());
+  Sys.command cmd
+
+let scommand cmd =
+  if command cmd <> 0 then exit 2
+
+let safe_remove s =
+  try Sys.remove s with Sys_error _ -> ()
+
+let make_set l =
+  let rec merge l = function
+    []     -> List.rev l
+  | p :: r -> if List.mem p l then merge l r else merge (p::l) r
+  in
+  merge [] l
+
+let make_rpath flag =
+  if !rpath = [] || flag = ""
+  then ""
+  else flag ^ String.concat ":" (make_set !rpath)
+
+let make_rpath_ccopt flag =
+  if !rpath = [] || flag = ""
+  then ""
+  else "-ccopt " ^ flag ^ String.concat ":" (make_set !rpath)
+
+let prefix_list pref l =
+  List.map (fun s -> pref ^ s) l
+
+let prepostfix pre name post =
+  let base = Filename.basename name in
+  let dir = Filename.dirname name in
+  Filename.concat dir (pre ^ base ^ post)
+;;
+
+let transl_path s =
+  match Sys.os_type with
+    | "Win32" ->
+        let s = Bytes.of_string s in
+        let rec aux i =
+          if i = Bytes.length s || Bytes.get s i = ' ' then s
+          else begin
+            if Bytes.get s i = '/' then Bytes.set s i '\\';
+            aux (i + 1)
+          end
+        in Bytes.to_string (aux 0)
+    | _ -> s
+
+let flexdll_dirs =
+  let dirs =
+    let expand = Misc.expand_directory Config.standard_library in
+    List.map expand Config.flexdll_dirs
+  in
+  let f dir =
+    let dir =
+      if String.contains dir ' ' then
+        "\"" ^ dir ^ "\""
+      else
+        dir
+    in
+      "-L" ^ dir
+  in
+  List.map f dirs
+
+let build_libs () =
+  if !c_objs <> [] then begin
+    if !dynlink then begin
+      let retcode = command
+          (Printf.sprintf "%s %s -o %s %s %s %s %s %s %s"
+             Config.mkdll
+             (if !debug then "-g" else "")
+             (prepostfix "dll" !output_c Config.ext_dll)
+             (String.concat " " !c_objs)
+             (String.concat " " !c_opts)
+             (String.concat " " !ld_opts)
+             (make_rpath mksharedlibrpath)
+             (String.concat " " !c_libs)
+             (String.concat " " flexdll_dirs)
+          )
+      in
+      if retcode <> 0 then if !failsafe then dynlink := false else exit 2
+    end;
+    safe_remove (prepostfix "lib" !output_c Config.ext_lib);
+    scommand
+      (mklib (prepostfix "lib" !output_c Config.ext_lib)
+             (String.concat " " !c_objs) "");
+  end;
+  if !bytecode_objs <> [] then
+    scommand
+      (sprintf "%s -a %s %s %s -o %s.cma %s %s -dllib -l%s -cclib -l%s \
+                   %s %s %s %s"
+                  (transl_path !ocamlc)
+                  (if !debug then "-g" else "")
+                  (if !dynlink then "" else "-custom")
+                  (String.concat " " !ocamlc_opts)
+                  !output
+                  (String.concat " " !caml_opts)
+                  (String.concat " " !bytecode_objs)
+                  (Filename.basename !output_c)
+                  (Filename.basename !output_c)
+                  (String.concat " " (prefix_list "-ccopt " !c_opts))
+                  (make_rpath_ccopt default_rpath)
+                  (String.concat " " (prefix_list "-cclib " !c_libs))
+                  (String.concat " " !caml_libs));
+  if !native_objs <> [] then
+    scommand
+      (sprintf "%s -a %s %s -o %s.cmxa %s %s -cclib -l%s %s %s %s %s"
+                  (transl_path !ocamlopt)
+                  (if !debug then "-g" else "")
+                  (String.concat " " !ocamlopt_opts)
+                  !output
+                  (String.concat " " !caml_opts)
+                  (String.concat " " !native_objs)
+                  (Filename.basename !output_c)
+                  (String.concat " " (prefix_list "-ccopt " !c_opts))
+                  (make_rpath_ccopt default_rpath)
+                  (String.concat " " (prefix_list "-cclib " !c_libs))
+                  (String.concat " " !caml_libs))
+
+let _ =
+  try
+    parse_arguments Sys.argv;
+    build_libs()
+  with
+  | Bad_argument "" ->
+      prerr_string usage; exit 0
+  | Bad_argument s ->
+      prerr_endline s; prerr_string usage; exit 4
+  | Sys_error s ->
+      prerr_string "System error: "; prerr_endline s; exit 4
+  | x ->
+      raise x
diff --git a/tools/ocamlmktop.ml b/tools/ocamlmktop.ml
new file mode 100644
index 00000000..ab333966
--- /dev/null
+++ b/tools/ocamlmktop.ml
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let _ =
+  let args = Ccomp.quote_files (List.tl (Array.to_list Sys.argv)) in
+  let ocamlmktop = Sys.executable_name in
+  (* On Windows Sys.command calls system() which in turn calls 'cmd.exe /c'.
+     cmd.exe has special quoting rules (see 'cmd.exe /?' for details).
+     Short version: if the string passed to cmd.exe starts with '"',
+     the first and last '"' are removed *)
+  let ocamlc,extra_quote =
+    if Sys.win32 then "ocamlc.exe","\"" else "ocamlc",""
+  in
+  let ocamlc = Filename.(quote (concat (dirname ocamlmktop) ocamlc)) in
+  let cmdline =
+    extra_quote ^ ocamlc ^ " -I +compiler-libs -linkall ocamlcommon.cma " ^
+    "ocamlbytecomp.cma ocamltoplevel.cma " ^ args ^ " topstart.cmo" ^
+    extra_quote
+  in
+  exit(Sys.command cmdline)
diff --git a/tools/ocamloptp.ml b/tools/ocamloptp.ml
new file mode 100644
index 00000000..9b92d3b0
--- /dev/null
+++ b/tools/ocamloptp.ml
@@ -0,0 +1,94 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Damien Doligez, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Printf
+
+let make_archive = ref false;;
+let with_impl = ref false;;
+let with_intf = ref false;;
+let with_mli = ref false;;
+let with_ml = ref false;;
+
+let process_file filename =
+  if Filename.check_suffix filename ".ml" then with_ml := true;
+  if Filename.check_suffix filename ".mli" then with_mli := true;
+;;
+
+let usage = "Usage: ocamloptp  \noptions are:"
+
+let incompatible o =
+  fprintf stderr "ocamloptp: profiling is incompatible with the %s option\n" o;
+  exit 2
+
+module Options = Main_args.Make_optcomp_options (struct
+  include Main_args.Default.Optmain
+  let _a () = make_archive := true
+  let _impl _ = with_impl := true
+  let _intf _ = with_intf := true
+  let _pp _s = incompatible "-pp"
+  let _ppx _s = incompatible "-ppx"
+  let _args = Arg.read_arg
+  let _args0 = Arg.read_arg0
+  let anonymous = process_file
+end);;
+
+let rev_compargs = ref ([] : string list)
+let rev_profargs = ref ([] : string list)
+
+let add_profarg s =
+  rev_profargs := (Filename.quote s) :: "-m" :: !rev_profargs
+;;
+
+let anon filename =
+  process_file filename;
+  rev_compargs := Filename.quote filename :: !rev_compargs
+;;
+
+let optlist =
+    ("-P", Arg.String add_profarg,
+           "[afilmt]  Profile constructs specified by argument (default fm):\n\
+        \032     a  Everything\n\
+        \032     f  Function calls and method calls\n\
+        \032     i  if ... then ... else\n\
+        \032     l  while and for loops\n\
+        \032     m  match ... with\n\
+        \032     t  try ... with")
+    :: Main_args.options_with_command_line_syntax Options.list rev_compargs
+in
+Arg.parse_expand optlist anon usage;
+if !with_impl && !with_intf then begin
+  fprintf stderr "ocamloptp cannot deal with both \"-impl\" and \"-intf\"\n";
+  fprintf stderr "please compile interfaces and implementations separately\n";
+  exit 2;
+end else if !with_impl && !with_mli then begin
+  fprintf stderr "ocamloptp cannot deal with both \"-impl\" and .mli files\n";
+  fprintf stderr "please compile interfaces and implementations separately\n";
+  exit 2;
+end else if !with_intf && !with_ml then begin
+  fprintf stderr "ocamloptp cannot deal with both \"-intf\" and .ml files\n";
+  fprintf stderr "please compile interfaces and implementations separately\n";
+  exit 2;
+end;
+if !with_impl then rev_profargs := "-impl" :: !rev_profargs;
+if !with_intf then rev_profargs := "-intf" :: !rev_profargs;
+let status =
+  Sys.command
+    (Printf.sprintf "ocamlopt -pp \"ocamlprof -instrument %s\" %s %s"
+        (String.concat " " (List.rev !rev_profargs))
+        (if !make_archive then "" else "profiling.cmx")
+        (String.concat " " (List.rev !rev_compargs)))
+in
+exit status
+;;
diff --git a/tools/ocamlprof.ml b/tools/ocamlprof.ml
new file mode 100644
index 00000000..0eed5442
--- /dev/null
+++ b/tools/ocamlprof.ml
@@ -0,0 +1,528 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*       Damien Doligez and Francois Rouaix, INRIA Rocquencourt           *)
+(*           Ported to Caml Special Light by John Malecki                 *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Printf
+
+open Location
+open Parsetree
+
+(* User programs must not use identifiers that start with these prefixes. *)
+let idprefix = "__ocaml_prof_";;
+let modprefix = "OCAML__prof_";;
+
+(* Errors specific to the profiler *)
+exception Profiler of string
+
+(* Modes *)
+let instr_fun    = ref false
+and instr_match  = ref false
+and instr_if     = ref false
+and instr_loops  = ref false
+and instr_try    = ref false
+
+let cur_point = ref 0
+and inchan = ref stdin
+and outchan = ref stdout
+
+(* To copy source fragments *)
+let copy_buffer = Bytes.create 256
+
+let copy_chars_unix nchars =
+  let n = ref nchars in
+  while !n > 0 do
+    let m = input !inchan copy_buffer 0 (min !n 256) in
+    if m = 0 then raise End_of_file;
+    output !outchan copy_buffer 0 m;
+    n := !n - m
+  done
+
+let copy_chars_win32 nchars =
+  for _i = 1 to nchars do
+    let c = input_char !inchan in
+    if c <> '\r' then output_char !outchan c
+  done
+
+let copy_chars =
+  match Sys.os_type with
+    "Win32" | "Cygwin" -> copy_chars_win32
+  | _       -> copy_chars_unix
+
+let copy next =
+  assert (next >= !cur_point);
+  seek_in !inchan !cur_point;
+  copy_chars (next - !cur_point);
+  cur_point := next;
+;;
+
+let prof_counter = ref 0;;
+
+let instr_mode = ref false
+
+type insert = Open | Close;;
+let to_insert = ref ([] : (insert * int) list);;
+
+let insert_action st en =
+  to_insert := (Open, st) :: (Close, en) :: !to_insert
+;;
+
+(* Producing instrumented code *)
+let add_incr_counter modul (kind,pos) =
+   copy pos;
+   match kind with
+   | Open ->
+         fprintf !outchan "(%sProfiling.incr %s%s_cnt %d; "
+                 modprefix idprefix modul !prof_counter;
+         incr prof_counter;
+   | Close -> fprintf !outchan ")";
+;;
+
+let counters = ref (Array.make 0 0)
+
+(* User defined marker *)
+let special_id = ref ""
+
+(* Producing results of profile run *)
+let add_val_counter (kind,pos) =
+  if kind = Open then begin
+    copy pos;
+    fprintf !outchan "(* %s%d *) " !special_id !counters.(!prof_counter);
+    incr prof_counter;
+  end
+;;
+
+(* ************* rewrite ************* *)
+
+let insert_profile rw_exp ex =
+  let st = ex.pexp_loc.loc_start.Lexing.pos_cnum
+  and en = ex.pexp_loc.loc_end.Lexing.pos_cnum
+  and gh = ex.pexp_loc.loc_ghost
+  in
+  if gh || st = en then
+    rw_exp true ex
+  else begin
+    insert_action st en;
+    rw_exp false ex;
+  end
+;;
+
+
+let pos_len = ref 0
+
+let init_rewrite modes mod_name =
+  cur_point := 0;
+  if !instr_mode then begin
+    fprintf !outchan "module %sProfiling = Profiling;; " modprefix;
+    fprintf !outchan "let %s%s_cnt = Array.make 000000000" idprefix mod_name;
+    pos_len := pos_out !outchan;
+    fprintf !outchan
+            " 0;; Profiling.counters := \
+              (\"%s\", (\"%s\", %s%s_cnt)) :: !Profiling.counters;; "
+            mod_name modes idprefix mod_name;
+  end
+
+let final_rewrite add_function =
+  to_insert := List.sort (fun x y -> compare (snd x) (snd y)) !to_insert;
+  prof_counter := 0;
+  List.iter add_function !to_insert;
+  copy (in_channel_length !inchan);
+  if !instr_mode then begin
+    let len = Int.to_string !prof_counter in
+    if String.length len > 9 then raise (Profiler "too many counters");
+    seek_out !outchan (!pos_len - String.length len);
+    output_string !outchan len
+  end;
+  (* Cannot close because outchan is stdout and Format doesn't like
+     a closed stdout.
+    close_out !outchan;
+  *)
+;;
+
+let rec rewrite_patexp_list iflag l =
+  rewrite_exp_list iflag (List.map (fun x -> x.pvb_expr) l)
+
+and rewrite_cases iflag l =
+  List.iter
+    (fun pc ->
+      begin match pc.pc_guard with
+      | None -> ()
+      | Some g -> rewrite_exp iflag g
+      end;
+      rewrite_exp iflag pc.pc_rhs
+    )
+    l
+
+and rewrite_labelexp_list iflag l =
+  rewrite_exp_list iflag (List.map snd l)
+
+and rewrite_exp_list iflag l =
+  List.iter (rewrite_exp iflag) l
+
+and rewrite_exp iflag sexp =
+  if iflag then insert_profile rw_exp sexp
+           else rw_exp false sexp
+
+and rw_exp iflag sexp =
+  match sexp.pexp_desc with
+    Pexp_ident _lid -> ()
+  | Pexp_constant _cst -> ()
+
+  | Pexp_let(_, spat_sexp_list, sbody) ->
+    rewrite_patexp_list iflag spat_sexp_list;
+    rewrite_exp iflag sbody
+
+  | Pexp_function caselist ->
+    if !instr_fun then
+      rewrite_function iflag caselist
+    else
+      rewrite_cases iflag caselist
+
+  | Pexp_fun (_, _, p, e) ->
+      let l = [{pc_lhs=p; pc_guard=None; pc_rhs=e}] in
+      if !instr_fun then
+        rewrite_function iflag l
+      else
+        rewrite_cases iflag l
+
+  | Pexp_match(sarg, caselist) ->
+    rewrite_exp iflag sarg;
+    if !instr_match && not sexp.pexp_loc.loc_ghost then
+      rewrite_funmatching caselist
+    else
+      rewrite_cases iflag caselist
+
+  | Pexp_try(sbody, caselist) ->
+    rewrite_exp iflag sbody;
+    if !instr_try && not sexp.pexp_loc.loc_ghost then
+      rewrite_trymatching caselist
+    else
+      rewrite_cases iflag caselist
+
+  | Pexp_apply(sfunct, sargs) ->
+    rewrite_exp iflag sfunct;
+    rewrite_exp_list iflag (List.map snd sargs)
+
+  | Pexp_tuple sexpl ->
+    rewrite_exp_list iflag sexpl
+
+  | Pexp_construct(_, None) -> ()
+  | Pexp_construct(_, Some sarg) ->
+    rewrite_exp iflag sarg
+
+  | Pexp_variant(_, None) -> ()
+  | Pexp_variant(_, Some sarg) ->
+    rewrite_exp iflag sarg
+
+  | Pexp_record(lid_sexp_list, None) ->
+    rewrite_labelexp_list iflag lid_sexp_list
+  | Pexp_record(lid_sexp_list, Some sexp) ->
+    rewrite_exp iflag sexp;
+    rewrite_labelexp_list iflag lid_sexp_list
+
+  | Pexp_field(sarg, _) ->
+    rewrite_exp iflag sarg
+
+  | Pexp_setfield(srecord, _, snewval) ->
+    rewrite_exp iflag srecord;
+    rewrite_exp iflag snewval
+
+  | Pexp_array(sargl) ->
+    rewrite_exp_list iflag sargl
+
+  | Pexp_ifthenelse(scond, sifso, None) ->
+      rewrite_exp iflag scond;
+      rewrite_ifbody iflag sexp.pexp_loc.loc_ghost sifso
+  | Pexp_ifthenelse(scond, sifso, Some sifnot) ->
+      rewrite_exp iflag scond;
+      rewrite_ifbody iflag sexp.pexp_loc.loc_ghost sifso;
+      rewrite_ifbody iflag sexp.pexp_loc.loc_ghost sifnot
+
+  | Pexp_sequence(sexp1, sexp2) ->
+    rewrite_exp iflag sexp1;
+    rewrite_exp iflag sexp2
+
+  | Pexp_while(scond, sbody) ->
+    rewrite_exp iflag scond;
+    if !instr_loops && not sexp.pexp_loc.loc_ghost
+    then insert_profile rw_exp sbody
+    else rewrite_exp iflag sbody
+
+  | Pexp_for(_, slow, shigh, _, sbody) ->
+    rewrite_exp iflag slow;
+    rewrite_exp iflag shigh;
+    if !instr_loops && not sexp.pexp_loc.loc_ghost
+    then insert_profile rw_exp sbody
+    else rewrite_exp iflag sbody
+
+  | Pexp_constraint(sarg, _) | Pexp_coerce(sarg, _, _) ->
+    rewrite_exp iflag sarg
+
+  | Pexp_send (sobj, _) ->
+    rewrite_exp iflag sobj
+
+  | Pexp_new _ -> ()
+
+  | Pexp_setinstvar (_, sarg) ->
+    rewrite_exp iflag sarg
+
+  | Pexp_override l ->
+      List.iter (fun (_, sexp) -> rewrite_exp iflag sexp) l
+
+  | Pexp_letmodule (_, smod, sexp) ->
+      rewrite_mod iflag smod;
+      rewrite_exp iflag sexp
+
+  | Pexp_letexception (_cd, exp) ->
+      rewrite_exp iflag exp
+
+  | Pexp_assert (cond) -> rewrite_exp iflag cond
+
+  | Pexp_lazy (expr) -> rewrite_exp iflag expr
+
+  | Pexp_poly (sexp, _) -> rewrite_exp iflag sexp
+
+  | Pexp_object cl ->
+      List.iter (rewrite_class_field iflag) cl.pcstr_fields
+
+  | Pexp_newtype (_, sexp) -> rewrite_exp iflag sexp
+  | Pexp_open (_, e) -> rewrite_exp iflag e
+  | Pexp_pack (smod) -> rewrite_mod iflag smod
+  | Pexp_letop {let_; ands; body; _} ->
+      rewrite_exp iflag let_.pbop_exp;
+      List.iter (fun {pbop_exp; _} -> rewrite_exp iflag pbop_exp) ands;
+      rewrite_exp iflag body
+  | Pexp_extension _ -> ()
+  | Pexp_unreachable -> ()
+
+and rewrite_ifbody iflag ghost sifbody =
+  if !instr_if && not ghost then
+    insert_profile rw_exp sifbody
+  else
+    rewrite_exp iflag sifbody
+
+(* called only when !instr_fun *)
+and rewrite_annotate_exp_list l =
+  List.iter
+    (function
+     | {pc_guard=Some scond; pc_rhs=sbody} ->
+         insert_profile rw_exp scond;
+         insert_profile rw_exp sbody;
+     | {pc_rhs={pexp_desc = Pexp_constraint(sbody, _)}} (* let f x : t = e *)
+        -> insert_profile rw_exp sbody
+     | {pc_rhs=sexp} -> insert_profile rw_exp sexp)
+    l
+
+and rewrite_function iflag = function
+  | [{pc_lhs=_; pc_guard=None;
+      pc_rhs={pexp_desc = (Pexp_function _|Pexp_fun _)} as sexp}] ->
+        rewrite_exp iflag sexp
+  | l -> rewrite_funmatching l
+
+and rewrite_funmatching l =
+  rewrite_annotate_exp_list l
+
+and rewrite_trymatching l =
+  rewrite_annotate_exp_list l
+
+(* Rewrite a class definition *)
+
+and rewrite_class_field iflag cf =
+  match cf.pcf_desc with
+    Pcf_inherit (_, cexpr, _)     -> rewrite_class_expr iflag cexpr
+  | Pcf_val (_, _, Cfk_concrete (_, sexp))  -> rewrite_exp iflag sexp
+  | Pcf_method (_, _,
+                Cfk_concrete (_, ({pexp_desc = (Pexp_function _|Pexp_fun _)}
+                                    as sexp))) ->
+      rewrite_exp iflag sexp
+  | Pcf_method (_, _, Cfk_concrete(_, sexp)) ->
+      let loc = cf.pcf_loc in
+      if !instr_fun && not loc.loc_ghost then insert_profile rw_exp sexp
+      else rewrite_exp iflag sexp
+  | Pcf_initializer sexp ->
+      rewrite_exp iflag sexp
+  | Pcf_method (_, _, Cfk_virtual _)
+  | Pcf_val (_, _, Cfk_virtual _)
+  | Pcf_constraint _  -> ()
+  | Pcf_attribute _ -> ()
+  | Pcf_extension _ -> ()
+
+and rewrite_class_expr iflag cexpr =
+  match cexpr.pcl_desc with
+    Pcl_constr _ -> ()
+  | Pcl_structure st ->
+      List.iter (rewrite_class_field iflag) st.pcstr_fields
+  | Pcl_fun (_, _, _, cexpr) ->
+      rewrite_class_expr iflag cexpr
+  | Pcl_apply (cexpr, exprs) ->
+      rewrite_class_expr iflag cexpr;
+      List.iter (rewrite_exp iflag) (List.map snd exprs)
+  | Pcl_let (_, spat_sexp_list, cexpr) ->
+      rewrite_patexp_list iflag spat_sexp_list;
+      rewrite_class_expr iflag cexpr
+  | Pcl_open (_, cexpr)
+  | Pcl_constraint (cexpr, _) ->
+      rewrite_class_expr iflag cexpr
+  | Pcl_extension _ -> ()
+
+and rewrite_class_declaration iflag cl =
+  rewrite_class_expr iflag cl.pci_expr
+
+(* Rewrite a module expression or structure expression *)
+
+and rewrite_mod iflag smod =
+  match smod.pmod_desc with
+    Pmod_ident _ -> ()
+  | Pmod_structure sstr -> List.iter (rewrite_str_item iflag) sstr
+  | Pmod_functor(_param, sbody) -> rewrite_mod iflag sbody
+  | Pmod_apply(smod1, smod2) -> rewrite_mod iflag smod1; rewrite_mod iflag smod2
+  | Pmod_constraint(smod, _smty) -> rewrite_mod iflag smod
+  | Pmod_unpack(sexp) -> rewrite_exp iflag sexp
+  | Pmod_extension _ -> ()
+
+and rewrite_str_item iflag item =
+  match item.pstr_desc with
+    Pstr_eval (exp, _attrs) -> rewrite_exp iflag exp
+  | Pstr_value(_, exps)
+     -> List.iter (fun x -> rewrite_exp iflag x.pvb_expr) exps
+  | Pstr_module x -> rewrite_mod iflag x.pmb_expr
+        (* todo: Pstr_recmodule?? *)
+  | Pstr_class classes -> List.iter (rewrite_class_declaration iflag) classes
+  | _ -> ()
+
+(* Rewrite a .ml file *)
+let rewrite_file srcfile add_function =
+  inchan := open_in_bin srcfile;
+  let lb = Lexing.from_channel !inchan in
+  Location.input_name := srcfile;
+  Location.init lb srcfile;
+  List.iter (rewrite_str_item false) (Parse.implementation lb);
+  final_rewrite add_function;
+  close_in !inchan
+
+(* Copy a non-.ml file without change *)
+let null_rewrite srcfile =
+  inchan := open_in_bin srcfile;
+  copy (in_channel_length !inchan);
+  close_in !inchan
+;;
+
+(* Setting flags from saved config *)
+let set_flags s =
+  for i = 0 to String.length s - 1 do
+    match String.get s i with
+      'f' -> instr_fun := true
+    | 'm' -> instr_match := true
+    | 'i' -> instr_if := true
+    | 'l' -> instr_loops := true
+    | 't' -> instr_try := true
+    | 'a' -> instr_fun := true; instr_match := true;
+             instr_if := true; instr_loops := true;
+             instr_try := true
+    | _ -> ()
+    done
+
+(* Command-line options *)
+
+let modes = ref "fm"
+let dumpfile = ref "ocamlprof.dump"
+
+(* Process a file *)
+
+let process_intf_file filename = null_rewrite filename;;
+
+let process_impl_file filename =
+   let modname = Filename.basename(Filename.chop_extension filename) in
+       (* FIXME should let modname = String.capitalize modname *)
+   if !instr_mode then begin
+     (* Instrumentation mode *)
+     set_flags !modes;
+     init_rewrite !modes modname;
+     rewrite_file filename (add_incr_counter modname);
+   end else begin
+     (* Results mode *)
+     let ic = open_in_bin !dumpfile in
+     let allcounters =
+       (input_value ic : (string * (string * int array)) list) in
+     close_in ic;
+     let (modes, cv) =
+       try
+         List.assoc modname allcounters
+       with Not_found ->
+         raise(Profiler("Module " ^ modname ^ " not used in this profile."))
+     in
+     counters := cv;
+     set_flags modes;
+     init_rewrite modes modname;
+     rewrite_file filename add_val_counter;
+   end
+;;
+
+let process_anon_file filename =
+  if Filename.check_suffix filename ".ml" then
+    process_impl_file filename
+  else
+    process_intf_file filename
+;;
+
+(* Main function *)
+
+open Format
+
+let usage = "Usage: ocamlprof  \noptions are:"
+
+let print_version () =
+  printf "ocamlprof, version %s@." Sys.ocaml_version;
+  exit 0;
+;;
+
+let print_version_num () =
+  printf "%s@." Sys.ocaml_version;
+  exit 0;
+;;
+
+let main () =
+  try
+    Warnings.parse_options false "a";
+    Arg.parse_expand [
+       "-f", Arg.String (fun s -> dumpfile := s),
+             "     Use  as dump file (default ocamlprof.dump)";
+       "-F", Arg.String (fun s -> special_id := s),
+             "        Insert string  with the counts";
+       "-impl", Arg.String process_impl_file,
+                "  Process  as a .ml file";
+       "-instrument", Arg.Set instr_mode, "  (undocumented)";
+       "-intf", Arg.String process_intf_file,
+                "  Process  as a .mli file";
+       "-m", Arg.String (fun s -> modes := s), "    (undocumented)";
+       "-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,
+            " Read additional newline separated command line arguments \n\
+            \      from ";
+       "-args0", Arg.Expand Arg.read_arg0,
+           " Read additional NUL separated command line arguments from \n\
+           \      "
+    ] process_anon_file usage;
+    exit 0
+  with
+  | Profiler msg ->
+      fprintf Format.err_formatter "@[%s@]@." msg;
+      exit 2
+  | exn ->
+      Location.report_exception Format.err_formatter exn
+
+let _ = main ()
diff --git a/tools/ocamlsize b/tools/ocamlsize
new file mode 100755
index 00000000..84798ce1
--- /dev/null
+++ b/tools/ocamlsize
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *
+#*                                                                        *
+#*   Copyright 2002 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.          *
+#*                                                                        *
+#**************************************************************************
+
+foreach $f (@ARGV) {
+    open(FILE, $f) || die("Cannot open $f");
+    seek(FILE, -16, 2);
+    $num_sections = &read_int();
+    read(FILE, $magic, 12);
+    seek(FILE, -16 - 8 * $num_sections, 2);
+    @secname = ();
+    @seclength = ();
+    %length = ();
+    for ($i = 0; $i < $num_sections; $i++) {
+        read(FILE, $sec, 4);
+        $secname[$i] = $sec;
+        $seclength[$i] = &read_int();
+        $length{$sec} = $seclength[$i];
+    }
+    print $f, ":\n" if ($#ARGV > 0);
+    $path =
+        $length{'RNTM'} > 0 ?
+            &read_section('RNTM') :
+            "(default runtime)\n";
+    printf ("\tcode: %-7d data: %-7d symbols: %-7d debug: %-7d\n",
+            $length{'CODE'}, $length{'DATA'},
+            $length{'SYMB'}, $length{'DBUG'});
+    printf ("\tmagic number: %s  runtime system: %s",
+            $magic, $path);
+    close(FILE);
+}
+
+sub read_int {
+    read(FILE, $buff, 4) == 4 || die("Truncated bytecode file $f");
+    @int = unpack("C4", $buff);
+    return ($int[0] << 24) + ($int[1] << 16) + ($int[2] << 8) + $int[3];
+}
+
+sub read_section {
+    local ($sec) = @_;
+    local ($i, $ofs, $data);
+    for ($i = $num_sections - 1; $i >= 0; $i--) {
+        $ofs += $seclength[$i];
+        if ($secname[$i] eq $sec) {
+            seek(FILE, -16 - 8 * $num_sections - $ofs, 2);
+            read(FILE, $data, $seclength[$i]);
+            return $data;
+        }
+    }
+    return '';
+}
diff --git a/tools/pre-commit-githook b/tools/pre-commit-githook
new file mode 100755
index 00000000..dcb6f90f
--- /dev/null
+++ b/tools/pre-commit-githook
@@ -0,0 +1,85 @@
+#!/usr/bin/env bash
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                David Allsopp, MetaStack Solutions Ltd.                 *
+#*                                                                        *
+#*   Copyright 2017 MetaStack Solutions Ltd.                              *
+#*                                                                        *
+#*   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.          *
+#*                                                                        *
+#**************************************************************************
+
+# Bump this on any changes. It's vital that HOOK_VERSION followed by equals
+# appears nowhere else in these sources!
+HOOK_VERSION=4
+
+# For what it's worth, allow for empty trees!
+if git rev-parse --verify HEAD >/dev/null 2>&1
+then
+  against=HEAD
+else
+  # Initial commit: diff against an empty tree object
+  against=4b825dc642cb6eb9a060e54bf8d69288fbee4904
+fi
+
+# Redirect output to stderr.
+exec 1>&2
+
+# Check to see if the script's been updated
+if git ls-files --error-unmatch tools/pre-commit-githook >/dev/null 2>&1 ; then
+  THEIR_VERSION=$(git cat-file --textconv HEAD:tools/pre-commit-githook \
+                    | sed -ne 's/^HOOK_VERSION=//p')
+  if [[ -n $THEIR_VERSION && $THEIR_VERSION -gt $HOOK_VERSION ]] ; then
+    echo "Note: tools/pre-commit-githook is newer than .git/hooks/pre-commit"
+    echo "      You may wish to update your local githook"
+  fi
+fi
+
+# Git's built-in mechanism for whitespace is neater than ours, so do it first.
+# The strange construction below creates a list of files which have either
+# white-at-eol or white-at-eof included in ocaml-typo in .gitattributes and by
+# prefixing the names with :! causes git diff-index to skip over them.
+if [[ -n $(git diff-index --cached --name-only $against) ]] ; then
+  FILES=$(git diff-index --cached --name-only $against \
+          | xargs git check-attr --cached ocaml-typo \
+          | sed -ne 's/\(.*\): ocaml-typo:.*[ ,]white-at-eo[fl]\(,\|$\)/:!\1/p')
+  if ! git diff-index --check --cached $against -- $FILES ; then
+    exit 1
+  fi
+else
+  exit 0
+fi
+
+# Test to see if any part of the directory name has been marked prune
+not_pruned () {
+  DIR=$(dirname "$1")
+  if [ "$DIR" = "." ] ; then
+    return 0
+  else
+    case ",$(git check-attr typo.prune "$DIR" | sed -e 's/.*: //')," in
+      ,set,)
+      return 1
+      ;;
+      *)
+
+      not_pruned "$DIR"
+      return $?
+    esac
+  fi
+}
+
+# Now run check-typo over all the files in the index
+ERRORS=0
+export OCAML_CT_PREFIX=:
+export OCAML_CT_CAT="git cat-file --textconv"
+export OCAML_CT_CA_FLAG=--cached
+git diff --diff-filter=d --staged --name-only | (while IFS= read -r path
+do
+  if not_pruned "$path" && ! tools/check-typo "./$path" ; then
+    ERRORS=1
+  fi
+done; exit $ERRORS)
diff --git a/tools/primreq.ml b/tools/primreq.ml
new file mode 100644
index 00000000..04832ad8
--- /dev/null
+++ b/tools/primreq.ml
@@ -0,0 +1,95 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1999 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Determine the set of C primitives required by the given .cmo and .cma
+   files *)
+
+open Config
+open Cmo_format
+module String = Misc.Stdlib.String
+
+let defined = ref true
+let used = ref false
+let exclude_file = ref ""
+
+let primitives = ref String.Set.empty
+
+let scan_reloc = function
+    (Reloc_primitive s, _) -> primitives := String.Set.add s !primitives
+  | _ -> ()
+
+let scan_prim s =
+  primitives := String.Set.add s !primitives
+
+let scan_info cu =
+  if !used then List.iter scan_reloc cu.cu_reloc;
+  if !defined then List.iter scan_prim cu.cu_primitives
+
+let scan_obj filename =
+  let ic = open_in_bin filename in
+  let buffer = really_input_string ic (String.length cmo_magic_number) in
+  if buffer = cmo_magic_number then begin
+    let cu_pos = input_binary_int ic in
+    seek_in ic cu_pos;
+    let cu = (input_value ic : compilation_unit) in
+    close_in ic;
+    scan_info cu
+  end else
+  if buffer = cma_magic_number then begin
+    let toc_pos = input_binary_int ic in
+    seek_in ic toc_pos;
+    let toc = (input_value ic : library) in
+    close_in ic;
+    List.iter scan_info toc.lib_units
+  end else begin
+    prerr_endline "Not an object file"; exit 2
+  end
+
+let exclude filename =
+  let ic = open_in filename in
+  try
+    while true do
+      let s = input_line ic in
+      primitives := String.Set.remove s !primitives
+    done
+  with End_of_file -> close_in ic
+     | x -> close_in ic; raise x
+
+let main() =
+  Arg.parse_expand
+    ["-used", Arg.Unit(fun () -> used := true; defined := false),
+        "show primitives referenced in the object files";
+     "-defined", Arg.Unit(fun () -> defined := true; used := false),
+        "show primitives defined in the object files (default)";
+     "-all", Arg.Unit(fun () -> defined := true; used := true),
+        "show primitives defined or referenced in the object files";
+     "-exclude", Arg.String(fun s -> exclude_file := s),
+     " don't print the primitives mentioned in ";
+     "-args", Arg.Expand Arg.read_arg,
+     " Read additional newline separated command line arguments \n\
+     \      from ";
+     "-args0", Arg.Expand Arg.read_arg0,
+     " Read additional NUL separated command line arguments from \n\
+     \      ";]
+    scan_obj
+    "Usage: primreq [options] <.cmo and .cma files>\nOptions are:";
+  if String.length !exclude_file > 0 then exclude !exclude_file;
+  String.Set.iter
+    (fun s ->
+      if s.[0] <> '%' then begin print_string s; print_newline() end)
+    !primitives;
+  exit 0
+
+let _ = main ()
diff --git a/tools/profiling.ml b/tools/profiling.ml
new file mode 100644
index 00000000..d2eee4df
--- /dev/null
+++ b/tools/profiling.ml
@@ -0,0 +1,56 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*       Damien Doligez and Francois Rouaix, INRIA Rocquencourt           *)
+(*    Ported to Caml Special Light by John Malecki and Xavier Leroy       *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Run-time library for profiled programs *)
+
+type profiling_counters = (string * (string * int array)) list
+
+let counters = ref ([] : profiling_counters);;
+let incr a i = a.(i) <- a.(i) + 1;;
+
+exception Bad_profile
+
+let dump_counters () =
+  let dumpfile =
+    try Sys.getenv "OCAMLPROF_DUMP" with Not_found -> "ocamlprof.dump"
+  in
+  begin try
+    let ic = open_in_bin dumpfile in
+    let prevl = (input_value ic : profiling_counters) in
+    close_in ic;
+    List.iter2
+      (fun (curname, (curmodes,curcount)) (prevname, (prevmodes,prevcount)) ->
+        if curname <> prevname
+        || curmodes <> prevmodes
+        || Array.length curcount <> Array.length prevcount
+        then raise Bad_profile)
+      !counters prevl;
+    List.iter2
+      (fun (_curname, (_,curcount)) (_prevname, (_,prevcount)) ->
+        for i = 0 to Array.length curcount - 1 do
+          curcount.(i) <- curcount.(i) + prevcount.(i)
+        done)
+      !counters prevl
+  with _ -> ()
+  end;
+  begin try
+    let oc = open_out_bin dumpfile in
+    output_value oc !counters;
+    close_out oc
+  with _ -> ()
+  end
+
+let _ = at_exit dump_counters
diff --git a/tools/profiling.mli b/tools/profiling.mli
new file mode 100644
index 00000000..9d97a4a5
--- /dev/null
+++ b/tools/profiling.mli
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*       Damien Doligez and Francois Rouaix, INRIA Rocquencourt           *)
+(*    Ported to OCaml by John Malecki and Xavier Leroy                    *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Run-time library for profiled programs *)
+
+val counters: (string * (string * int array)) list ref;;
+val incr: int array -> int -> unit;;
diff --git a/tools/read_cmt.ml b/tools/read_cmt.ml
new file mode 100644
index 00000000..ae6b97fd
--- /dev/null
+++ b/tools/read_cmt.ml
@@ -0,0 +1,201 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Fabrice Le Fessant, INRIA Saclay                     *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let gen_annot = ref false
+let gen_ml = ref false
+let print_info_arg = ref false
+let target_filename = ref None
+let save_cmt_info = ref false
+
+let arg_list = Arg.align [
+  "-o", Arg.String (fun s -> target_filename := Some s),
+    " Dump to file  (or stdout if -)";
+  "-annot", Arg.Set gen_annot,
+    " Generate the corresponding .annot file";
+  "-save-cmt-info", Arg.Set save_cmt_info,
+    " Encapsulate additional cmt information in annotations";
+  "-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";
+  "-args", Arg.Expand Arg.read_arg,
+    " Read additional newline separated command line arguments \n\
+    \      from ";
+  "-args0", Arg.Expand Arg.read_arg0,
+    " Read additional NUL separated command line arguments from \n\
+    \      ";
+  "-I", Arg.String (fun s ->
+    Clflags.include_dirs := s :: !Clflags.include_dirs),
+    " Add  to the list of include directories";
+  ]
+
+let arg_usage =
+  "read_cmt [OPTIONS] FILE.cmt : read FILE.cmt and print related information"
+
+let dummy_crc = String.make 32 '-'
+
+let print_info cmt =
+  let oc = match !target_filename with
+    | None -> stdout
+    | Some filename -> open_out filename
+  in
+  let open Cmt_format in
+  Printf.fprintf oc "module name: %s\n" cmt.cmt_modname;
+  begin match cmt.cmt_annots with
+    Packed (_, list) ->
+      Printf.fprintf oc "pack: %s\n" (String.concat " " list)
+  | Implementation _ -> Printf.fprintf oc "kind: implementation\n"
+  | Interface _ -> Printf.fprintf oc "kind: interface\n"
+  | Partial_implementation _ ->
+    Printf.fprintf oc "kind: implementation with errors\n"
+  | Partial_interface _ -> Printf.fprintf oc "kind: interface with errors\n"
+  end;
+  Printf.fprintf oc "command: %s\n"
+    (String.concat " " (Array.to_list cmt.cmt_args));
+  begin match cmt.cmt_sourcefile with
+    None -> ()
+  | Some name ->
+    Printf.fprintf oc "sourcefile: %s\n" name;
+  end;
+  Printf.fprintf oc "build directory: %s\n" cmt.cmt_builddir;
+  List.iter (Printf.fprintf oc "load path: %s\n%!") cmt.cmt_loadpath;
+  begin
+    match cmt.cmt_source_digest with
+      None -> ()
+    | Some digest ->
+      Printf.fprintf oc "source digest: %s\n" (Digest.to_hex digest);
+  end;
+  begin
+    match cmt.cmt_interface_digest with
+      None -> ()
+    | Some digest ->
+      Printf.fprintf oc "interface digest: %s\n" (Digest.to_hex digest);
+  end;
+  List.iter (fun (name, crco) ->
+    let crc =
+      match crco with
+        None -> dummy_crc
+      | Some crc -> Digest.to_hex crc
+    in
+    Printf.fprintf oc "import: %s %s\n" name crc;
+  ) (List.sort compare cmt.cmt_imports);
+  Printf.fprintf oc "%!";
+  begin match !target_filename with
+  | None -> ()
+  | Some _ -> close_out oc
+  end;
+  ()
+
+let generate_ml target_filename filename cmt =
+  let (printer, ext) =
+    match cmt.Cmt_format.cmt_annots with
+      | Cmt_format.Implementation typedtree ->
+          (fun ppf -> Pprintast.structure ppf
+                                        (Untypeast.untype_structure typedtree)),
+          ".ml"
+      | Cmt_format.Interface typedtree ->
+          (fun ppf -> Pprintast.signature ppf
+                                        (Untypeast.untype_signature typedtree)),
+          ".mli"
+      | _ ->
+        Printf.fprintf stderr "File was generated with an error\n%!";
+          exit 2
+  in
+  let target_filename = match target_filename with
+      None -> Some (filename ^ ext)
+    | Some "-" -> None
+    | Some _ -> target_filename
+  in
+  let oc = match target_filename with
+      None -> None
+    | Some filename -> Some (open_out filename) in
+  let ppf = match oc with
+      None -> Format.std_formatter
+    | Some oc -> Format.formatter_of_out_channel oc in
+  printer ppf;
+  Format.pp_print_flush ppf ();
+  match oc with
+      None -> flush stdout
+    | Some oc -> close_out oc
+
+(* Save cmt information as faked annotations, attached to
+   Location.none, on top of the .annot file. Only when -save-cmt-info is
+   provided to ocaml_cmt.
+*)
+let record_cmt_info cmt =
+  let location_none = {
+    Location.none with Location.loc_ghost = false }
+  in
+  let location_file file = {
+    Location.none with
+      Location.loc_start = {
+        Location.none.Location.loc_start with
+          Lexing.pos_fname = file }}
+  in
+  let record_info name value =
+    let ident = Printf.sprintf ".%s" name in
+    Stypes.record (Stypes.An_ident (location_none, ident,
+                                    Annot.Idef (location_file value)))
+  in
+  let open Cmt_format in
+  (* record in reverse order to get them in correct order... *)
+  List.iter (fun dir -> record_info "include" dir) (List.rev cmt.cmt_loadpath);
+  record_info "chdir" cmt.cmt_builddir;
+  (match cmt.cmt_sourcefile with
+    None -> () | Some file -> record_info "source" file)
+
+let main () =
+  Clflags.annotations := true;
+
+  Arg.parse_expand arg_list  (fun filename ->
+    if
+      Filename.check_suffix filename ".cmt" ||
+        Filename.check_suffix filename ".cmti"
+    then begin
+      let open Cmt_format in
+      Compmisc.init_path ();
+      let cmt = read_cmt filename in
+      if !gen_annot then begin
+        if !save_cmt_info then record_cmt_info cmt;
+        let target_filename =
+          match !target_filename with
+          | None -> Some (filename ^ ".annot")
+          | Some "-" -> None
+          | Some _ as x -> x
+        in
+        Envaux.reset_cache ();
+        List.iter Load_path.add_dir (List.rev cmt.cmt_loadpath);
+        Cmt2annot.gen_annot target_filename
+          ~sourcefile:cmt.cmt_sourcefile
+          ~use_summaries:cmt.cmt_use_summaries
+          cmt.cmt_annots
+      end;
+      if !gen_ml then generate_ml !target_filename filename cmt;
+      if !print_info_arg || not (!gen_ml || !gen_annot) then print_info cmt;
+    end else begin
+      Printf.fprintf stderr
+                     "Error: the file's extension must be .cmt or .cmti.\n%!";
+      Arg.usage arg_list arg_usage
+    end
+  ) arg_usage
+
+
+let () =
+  try
+    main ()
+  with x ->
+    Printf.eprintf "Exception in main ()\n%!";
+    Location.report_exception Format.err_formatter x;
+    Format.fprintf Format.err_formatter "@.";
+    exit 2
diff --git a/tools/release-checklist b/tools/release-checklist
new file mode 100644
index 00000000..aab3d95d
--- /dev/null
+++ b/tools/release-checklist
@@ -0,0 +1,594 @@
+These are informal notes on how to do an OCaml release.
+
+Following these steps requires commit right in the OCaml repository,
+as well as SSH access to the inria.fr file servers hosting the
+distribution archives and manual.
+
+We are not fully confident that those steps are correct, feel free to
+check with other release managers in case of doubt.
+
+Note: we say that a new release is a "testing release" if it is a Beta
+version or Release Candidate. Otherwise, we call it a "production
+release".
+
+
+## A few days in advance
+
+Send a mail on caml-devel to warn Gabriel (to make a pass on Changes;
+see the "Changes curation" appendix for more details) and the
+OCamlLabs folks (for OPAM testing).
+
+## 0: release environment setup
+
+```
+rm -f /tmp/env-$USER.sh
+cat >/tmp/env-$USER.sh < 4.07.0+dev9-2018-06-26
+# for production releases: check and change the Changes header
+#  (remove "next version" and add a date)
+make -B configure
+git commit -a -m "last commit before tagging $VERSION"
+
+# update VERSION 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/manual/macros.hva
+rm -r autom4te.cache
+make -B configure
+make coreboot -j5
+make coreboot -j5 # must say "Fixpoint reached, bootstrap succeeded."
+git commit -m "release $VERSION" -a
+git tag -m "release $VERSION" $VERSION
+
+# for production releases, change the VERSION 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.
+rm -r autom4te.cache
+make -B configure
+git commit -m "increment version number after tagging $VERSION" VERSION configure ocaml-variants.opam
+git push
+git push --tags
+```
+
+## 5-bis: Alternative for branching
+
+This needs to be more tested, tread with care.
+```
+# at this point, the VERSION 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
+# to "OCaml $BRANCH"
+make -B configure
+git commit -a -m "last commit before branching $BRANCH"
+git branch $BRANCH
+
+# update VERSION 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
+# Add a "Working version" section" to Changes
+# Add common subsections in Changes, see Changelog.
+git commit -m "first commit after branching $VERSION" -a
+git push
+
+# Switch to the new branch
+git checkout $VERSION
+# increment VERSION, for instance
+#   4.07.0+dev1-2018-06-26 => 4.07.0+dev2-2018-06-30
+make -B configure
+git commit -m "first commit on branch $VERSION" -a
+git push $VERSION
+```
+
+Adjust github branch settings:
+
+Go to
+  https://github.com/ocaml/ocaml/settings/branches
+and add a rule for protecting the new branch
+(copy the rights from the previous version)
+
+## 5.1: create the release on github (only for a production release)
+
+open https://github.com/ocaml/ocaml/releases
+# and click "Draft a new release"
+# for a minor release, the description is:
+ Bug fixes. See [detailed list of changes](https://github.com/ocaml/ocaml/blob/$MAJOR.$MINOR/Changes).
+
+## 5.3: Inria CI (for a new release branch)
+
+Add the new release branch to the Inria CI list.
+Remove the oldest branch from this list.
+
+## 5.4 new badge in README.adoc (for a new release branch)
+
+Add a badge for the new branch in README.adoc.
+Remove any badge that tracks a version older than Debian stable.
+
+
+## 6: create OPAM packages
+
+Create ocaml-variants packages for the new version, copying the particular
+switch configuration choices from the previous version.
+
+Do not forget to add/update the checksum field for the tarballs in the
+"url" section of the opam files. Use opam-lint before sending the pull
+request.
+
+## 6.1 Update OPAM dev packages after branching
+
+Create a new ocaml/ocaml.$NEXT/opam file.
+Copy the opam dev files from ocaml-variants/ocaml-variants.$VERSION+trunk*
+into ocaml-variants/ocaml-variants.$NEXT+trunk+* .
+Update the version in those opam files.
+
+Update the synopsis and "src" field in the opam $VERSION packages.
+The "src" field should point to
+ src: "https://github.com/ocaml/ocaml/archive/$VERSION.tar.gz"
+The synopsis should be "latest $VERSION development(,...)".
+
+## 7: build the release archives
+
+```
+cd $WORKTREE
+TMPDIR=/tmp/ocaml-release
+git checkout $VERSION
+git checkout-index -a -f --prefix=$TMPDIR/ocaml-$VERSION/
+cd $TMPDIR
+gtar -c --owner 0 --group 0 -f ocaml-$VERSION.tar ocaml-$VERSION
+gzip -9 ocaml-$VERSION.tar.gz
+xz ocaml-$VERSION.tar.xz
+```
+
+
+## 8: upload the archives and compute checksums
+
+For the first beta of a major version, create the distribution directory on
+the server:
+```
+ssh $ARCHIVE_HOST "mkdir -p $DIST"
+```
+
+Upload the archives:
+```
+scp ocaml-$VERSION.tar.{xz,gz} $ARCHIVE_HOST:$DIST
+```
+
+To update the checksum files on the remote host, we first upload the
+release environment.
+(note: this assumes the user name is the same on the two machines)
+
+```
+scp /tmp/env-$USER.sh $ARCHIVE_HOST:/tmp/env-$USER.sh
+```
+
+and then login there to update the checksums (MD5SUM, SHA512SUM)
+
+```
+ssh $ARCHIVE_HOST
+source /tmp/env-$USER.sh
+cd $DIST
+
+cp MD5SUM MD5SUM.old
+md5sum ocaml-$VERSION.tar.{xz,gz} > new-md5s
+# check new-md5s to ensure that they look right, and then
+cat new-md5s >> MD5SUM
+# if everything worked well,
+rm MD5SUM.old new-md5s
+
+# same thing for SHA512
+cp SHA512SUM SHA512SUM.old
+sha512sum ocaml-$VERSION.tar.{xz,gz} > new-sha512s
+cat new-sha512s >> SHA512SUM
+rm SHA512SUM.old new-sha512s
+
+# clean up
+rm /tmp/env-$USER.sh
+exit
+```
+
+
+## 9: update note files (technical documentation)
+
+```
+ssh $ARCHIVE_HOST "mkdir -p $DIST/notes"
+cd ocaml-$VERSION
+scp INSTALL.adoc LICENSE README.adoc README.win32.adoc Changes \
+   $ARCHIVE_HOST:$DIST/notes/
+```
+
+
+## 10: upload the reference manual
+
+You don't need to do this if the previous release had the same
+$MAJOR.$MINOR ($BRANCH) value and the exact same manual -- this is frequent if
+it was a release candidate.
+
+```
+cd $WORKTREE
+make
+make install
+export PATH="$INSTDIR/bin:$PATH"
+cd manual
+make clean
+make
+rm -rf /tmp/release
+mkdir -p /tmp/release
+RELEASENAME="ocaml-$BRANCH-"
+make -C manual release RELEASE=/tmp/release/$RELEASENAME
+scp /tmp/release/* $ARCHIVE_HOST:$DIST/
+
+
+# upload manual checksums
+ssh $ARCHIVE_HOST "cd $DIST; md5sum ocaml-$BRANCH-refman* >>MD5SUM"
+ssh $ARCHIVE_HOST "cd $DIST; sha512sum ocaml-$BRANCH-refman* >>SHA512SUM"
+```
+
+Releasing the manual online happens on another machine:
+Do this ONLY FOR A PRODUCTION RELEASE
+
+```
+scp /tmp/env-$USER.sh $ARCHIVE_HOST:/tmp/env-$USER.sh
+ssh $ARCHIVE_HOST
+source /tmp/env-$USER.sh
+scp /tmp/env-$USER.sh $WEB_HOST:/tmp
+ssh $WEB_HOST
+source /tmp/env-$USER.sh
+
+cd $WEB_PATH/caml/pub/docs
+mkdir -p manual-ocaml-$BRANCH
+cd manual-ocaml-$BRANCH
+rm -fR htmlman ocaml-$BRANCH-refman-html.tar.gz
+wget http://caml.inria.fr/pub/distrib/ocaml-$BRANCH/ocaml-$BRANCH-refman-html.tar.gz
+tar -xzvf ocaml-$BRANCH-refman-html.tar.gz # this extracts into htmlman/
+/bin/cp -r htmlman/* . # move HTML content to docs/manual-caml-$BRANCH
+rm -fR htmlman ocaml-$BRANCH-refman-html.tar.gz
+
+cd $WEB_PATH/caml/pub/docs
+rm manual-ocaml
+ln -sf manual-ocaml-$BRANCH manual-ocaml
+```
+
+
+## 11: prepare web announce for the release
+
+For production releases, you should get in touch with ocaml.org to
+organize the webpage for the new release. See
+
+  
+
+
+## 13: announce the release on caml-list and caml-announce
+
+See the email announce templates at the end of this file.
+
+
+
+# Appendix
+
+## Announcing a production release:
+
+```
+Dear OCaml users,
+
+We have the pleasure of celebrating  by announcing the release of
+OCaml version $VERSION.
+This is mainly a bug-fix release, see the list of changes below.
+
+It is (or soon will be) available as a set of OPAM switches,
+and as a source download here:
+  https://caml.inria.fr/pub/distrib/ocaml-$BRANCH/
+
+Happy hacking,
+
+-- Damien Doligez for the OCaml team.
+
+<< insert the relevant Changes section >>
+```
+
+## Announcing a release candidate:
+
+```
+Dear OCaml users,
+
+The release of OCaml version $MAJOR.$MINOR.$BUGFIX is imminent.  We have
+created a release candidate that you can test.
+
+The source code is available at these addresses:
+
+ https://github.com/ocaml/ocaml/archive/$VERSION.tar.gz
+ https://caml.inria.fr/pub/distrib/ocaml-$BRANCH/ocaml-$VERSION.tar.gz
+
+The compiler can also be installed as an OPAM switch with one of the
+following commands.
+
+opam switch create ocaml-variants.$VERSION --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
+
+or
+
+opam switch create ocaml-variants.$VERSION+ --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
+
+ where you replace  with one of these:
+   afl
+   default-unsafe-string
+   force-safe-string
+   flambda
+   fp
+   fp+flambda
+
+We want to know about all bugs. Please report them here:
+ https://github.com/ocaml/ocaml/issues
+
+Happy hacking,
+
+-- Damien Doligez for the OCaml team.
+
+<< insert the relevant Changes section >>
+```
+
+## Announcing a beta version:
+
+```
+Dear OCaml users,
+
+The release of OCaml $MAJOR.$MINOR.$BUGFIX is approaching. We have created
+a beta version to help you adapt your software to the new features
+ahead of the release.
+
+The source code is available at these addresses:
+
+ https://github.com/ocaml/ocaml/archive/$VERSION.tar.gz
+ https://caml.inria.fr/pub/distrib/ocaml-$BRANCH/$VERSION.tar.gz
+
+The compiler can also be installed as an OPAM switch with one of the
+following commands.
+
+opam switch create ocaml-variants.$VERSION --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
+
+or
+
+opam switch create ocaml-variants.$VERSION+ --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
+
+ where you replace  with one of these:
+   afl
+   default-unsafe-string
+   force-safe-string
+   flambda
+   fp
+   fp+flambda
+
+We want to know about all bugs. Please report them here:
+ https://github.com/ocaml/ocaml/issues
+
+Happy hacking,
+
+-- Damien Doligez for the OCaml team.
+```
+
+## Changelog template for a new version
+
+A list of common subsection for the "Changes" file:
+
+```
+### Language features
+
+### Runtime system:
+
+### Code generation and optimizations:
+
+### Standard library:
+
+### Other libraries:
+
+### Tools:
+
+### Manual and documentation:
+
+### Compiler user-interface and warnings:
+
+### Internal/compiler-libs changes:
+
+### Build system:
+
+### Bug fixes:
+```
+
+
+## Changes curation
+
+Here is the process that Gabriel uses to curate the Changes entries of
+a release in preparation. Feel free to take care of it if you wish.
+
+(In theory it would be possible to maintain the Changes in excellent
+ shape so that no curation would be necessary. In practice it is less
+ work and less friction to tolerate imperfect Changes entries, and
+ curate them before the release.)
+
+### Synchronizing the trunk Changes with release branches
+
+The Changes entries of a release branch or past release should be
+exactly included in the trunk Changes, in the section of this release
+(or release branch). Use an interactive diffing tool (for example
+"meld") to compare and synchronize the Changes files of trunk and
+release branches.
+
+Here are typical forms of divergence and their usual solutions:
+
+- A change entry is present in a different section in two branches.
+  (Typically: in the XX.YY section of the XX.YY release branch,
+  but in the trunk section of the trunk branch.)
+
+  This usually happens when the PR is written for a given branch
+  first, and then cherry-picked in an older maintenance branch, but
+  the cherry-picker forgets to move the Change entry in the first
+  branch.
+
+  Fix: ensure that the entry is in the same section on all branches,
+  by putting it in the "smallest" version -- assuming that all bigger
+  versions also contain this cange.
+
+- A change entry is present in a given section, but the change is not
+  present in the corresponding release branch.
+
+  There are two common causes for this with radically different solutions:
+
+  + If a PR is merged a long time after they were submitted, the merge
+    may put their Changes entry in the section of an older release,
+    while it should go in trunk.
+
+    Fix: in trunk, move the entry to the trunk section.
+
+  + Sometimes the author of a PR against trunk intends it to be
+    cherry-picked in an older release branch, and places it in the
+    corresponding Changes entry, but we forget to cherry-pick.
+
+    Fix: cherry-pick the PR in the appropriate branch.
+
+  Reading the PR discussion is often enough to distinguish between the
+  two cases, but one should be careful before cherry-picking in
+  a branch (for an active release branch, check with the release
+  manager(s)).
+
+Figuring out the status of a given Changes entry often requires
+checking the git log for trunk and branches. Grepping for the PR
+number often suffices (note: when you cherry-pick a PR in a release
+branch, please target the merge commit to ensure the PR number is
+present in the log), or parts of the commit message text.
+
+### Ensure each entry is in the appropriate section
+
+(of course)
+
+### Fill more details in unclear Changes entries
+
+Expert users want to learn about the changes in the new release. We
+want to avoid forcing them to read the tortuous PR discussion, by
+giving enough details in the Changes entry.
+
+In particular, for language changes, showing a small example of
+concrete syntax of the new feature is very useful, and giving a few
+words of explanations helps.
+
+Compare for example
+
+    - #8820: quoted string extensions
+      (Gabriel Radanne, Leo White and Gabriel Scherer,
+       request by Bikal Lem)
+
+with
+
+    - #8820: quoted extensions: {%foo|...|} is lighter syntax for
+      [%foo {||}], and {%foo bar|...|bar} for [%foo {bar|...|bar}].
+      (Gabriel Radanne, Leo White and Gabriel Scherer,
+       request by Bikal Lem)
+
+This is also important for changes that break compatibility; users
+will scrutinize them with more care, so please give clear information on
+what breaks and, possibly, recommended update methods.
+
+Having enough details is also useful when you will grep the Changes
+later to know when a given change was introduced (knowing what to grep
+can be difficult).
+
+### Ordering of Changes entries
+
+In the past, we would order Changes entries numerically (this would
+also correspond to a chronological order). Since 4.09 Gabriel is
+trying to order them by importance (being an exciting/notable feature
+for a large number of users). What is the best ordering of sections,
+and the best entry ordering within a section, to put the most
+important changes first? This is guesswork of course, and we commonly
+have a long tail of "not so important PRs" in each section which don't
+need to be ordered with respect to each other -- one may break two
+lines just before this long tail.
+
+The ordering of sections depends on the nature of the changes within
+the release; some releases have an exciting "Runtime" section, many
+release don't. Usually "Language features" is among the first, and
+"Bug fixes" is the very last (who cares about bugs, right?).
+
+If some entries feel very anecdotal, consider moving them to the Bug
+Fixes section.
diff --git a/tools/stripdebug.ml b/tools/stripdebug.ml
new file mode 100644
index 00000000..c977609f
--- /dev/null
+++ b/tools/stripdebug.ml
@@ -0,0 +1,57 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Paris                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Copy a bytecode executable, removing debugging information
+   and #! header from the copy.
+   Usage: stripdebug  
+*)
+
+open Printf
+open Misc
+
+let stripdebug infile outfile =
+  let ic = open_in_bin infile in
+  Bytesections.read_toc ic;
+  let toc = Bytesections.toc() in
+  let pos_first_section = Bytesections.pos_first_section ic in
+  let oc =
+    open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o777
+                 outfile in
+  (* Skip the #! header, going straight to the first section. *)
+  seek_in ic pos_first_section;
+  (* Copy each section except DBUG *)
+  Bytesections.init_record oc;
+  List.iter
+    (fun (name, len) ->
+      if name = "DBUG" then begin
+        seek_in ic (in_channel_length ic + len)
+      end else begin
+        copy_file_chunk ic oc len;
+        Bytesections.record oc name
+      end)
+    toc;
+  (* Rewrite the toc and trailer *)
+  Bytesections.write_toc_and_trailer oc;
+  (* Done *)
+  close_in ic;
+  close_out oc
+
+let _ =
+  if Array.length Sys.argv = 3
+  then stripdebug Sys.argv.(1) Sys.argv.(2)
+  else begin
+    eprintf "Usage: stripdebug  \n";
+    exit 2
+  end
diff --git a/toplevel/dune b/toplevel/dune
new file mode 100644
index 00000000..476274b9
--- /dev/null
+++ b/toplevel/dune
@@ -0,0 +1,98 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+(library
+ (name ocamltoplevel)
+ (wrapped false)
+ (flags (:standard -principal -nostdlib))
+ (libraries stdlib ocamlcommon ocamlbytecomp)
+ (modules genprintval toploop trace topdirs topmain))
+
+(executable
+ (name topstart)
+ (modes byte)
+ (flags (:standard -principal -nostdlib))
+ (libraries ocamlbytecomp ocamlcommon ocamltoplevel runtime stdlib)
+ (modules topstart))
+
+(executable
+ (name expunge)
+ (modes byte)
+ (flags (:standard -principal -nostdlib))
+ (libraries ocamlbytecomp ocamlcommon runtime stdlib)
+ (modules expunge))
+
+(rule
+ (targets ocaml.byte)
+ (action (run %{ocaml_where}/expunge %{dep:topstart.exe} %{targets}
+                    ; FIXME: inlined $(STDLIB_MODULES) ... minus Labels ones ...
+                    stdlib__Spacetime
+                    stdlib__Arg
+                    stdlib__Array
+                    ; stdlib__ArrayLabels
+                    stdlib__Bigarray
+                    stdlib__Buffer
+                    stdlib__Bytes
+                    ; stdlib__BytesLabels
+                    stdlib__Callback
+                    camlinternalFormat
+                    camlinternalFormatBasics
+                    camlinternalLazy
+                    camlinternalMod
+                    camlinternalOO
+                    stdlib__Char
+                    stdlib__Complex
+                    stdlib__Digest
+                    stdlib__Ephemeron
+                    stdlib__Filename
+                    stdlib__Float
+                    stdlib__Format
+                    stdlib__Gc
+                    stdlib__Genlex
+                    stdlib__Hashtbl
+                    stdlib__Int32
+                    stdlib__Int64
+                    stdlib__Lazy
+                    stdlib__Lexing
+                    stdlib__List
+                    ; stdlib__ListLabels
+                    stdlib__Map
+                    stdlib__Marshal
+                    ; stdlib__MoreLabels
+                    stdlib__Nativeint
+                    stdlib__Obj
+                    stdlib__Oo
+                    stdlib__Option
+                    stdlib__Parsing
+                    stdlib__Pervasives
+                    stdlib__Printexc
+                    stdlib__Printf
+                    stdlib__Queue
+                    stdlib__Random
+                    stdlib__Result
+                    stdlib__Scanf
+                    stdlib__Seq
+                    stdlib__Set
+                    stdlib__Stack
+                    ; stdlib__StdLabels
+                    stdlib
+                    stdlib__Stream
+                    stdlib__String
+                    ; stdlib__StringLabels
+                    stdlib__Sys
+                    stdlib__Uchar
+                    stdlib__Weak
+                    ; the rest
+                    outcometree topdirs toploop
+ )))
diff --git a/toplevel/expunge.ml b/toplevel/expunge.ml
new file mode 100644
index 00000000..22eb46f6
--- /dev/null
+++ b/toplevel/expunge.ml
@@ -0,0 +1,79 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* "Expunge" a toplevel by removing compiler modules from the global map.
+   Usage: expunge    *)
+
+open Misc
+module String = Misc.Stdlib.String
+
+let is_exn =
+  let h = Hashtbl.create 64 in
+  Array.iter (fun n -> Hashtbl.add h n ()) Runtimedef.builtin_exceptions;
+  Hashtbl.mem h
+
+let to_keep = ref String.Set.empty
+
+let negate = Sys.argv.(3) = "-v"
+
+let keep =
+  if negate then fun name -> is_exn name || not (String.Set.mem name !to_keep)
+  else fun name -> is_exn name || (String.Set.mem name !to_keep)
+
+let expunge_map tbl =
+  Symtable.filter_global_map (fun id -> keep (Ident.name id)) tbl
+
+let expunge_crcs tbl =
+  List.filter (fun (unit, _crc) -> keep unit) tbl
+
+let main () =
+  let input_name = Sys.argv.(1) in
+  let output_name = Sys.argv.(2) in
+  for i = (if negate then 4 else 3) to Array.length Sys.argv - 1 do
+    to_keep := String.Set.add (String.capitalize_ascii Sys.argv.(i)) !to_keep
+  done;
+  let ic = open_in_bin input_name in
+  Bytesections.read_toc ic;
+  let toc = Bytesections.toc() in
+  let pos_first_section = Bytesections.pos_first_section ic in
+  let oc =
+    open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o777
+                 output_name in
+  (* Copy the file up to the symbol section as is *)
+  seek_in ic 0;
+  copy_file_chunk ic oc pos_first_section;
+  (* Copy each section, modifying the symbol section in passing *)
+  Bytesections.init_record oc;
+  List.iter
+    (fun (name, len) ->
+      begin match name with
+        "SYMB" ->
+          let global_map = (input_value ic : Symtable.global_map) in
+          output_value oc (expunge_map global_map)
+      | "CRCS" ->
+          let crcs = (input_value ic : (string * Digest.t option) list) in
+          output_value oc (expunge_crcs crcs)
+      | _ ->
+          copy_file_chunk ic oc len
+      end;
+      Bytesections.record oc name)
+    toc;
+  (* Rewrite the toc and trailer *)
+  Bytesections.write_toc_and_trailer oc;
+  (* Done *)
+  close_in ic;
+  close_out oc
+
+let _ = Printexc.catch main (); exit 0
diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml
new file mode 100644
index 00000000..27ee2425
--- /dev/null
+++ b/toplevel/genprintval.ml
@@ -0,0 +1,615 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* To print values *)
+
+open Misc
+open Format
+open Longident
+open Path
+open Types
+open Outcometree
+module Out_name = Printtyp.Out_name
+
+module type OBJ =
+  sig
+    type t
+    val repr : 'a -> t
+    val obj : t -> 'a
+    val is_block : t -> bool
+    val tag : t -> int
+    val size : t -> int
+    val field : t -> int -> t
+    val double_array_tag : int
+    val double_field : t -> int -> float
+  end
+
+module type EVALPATH =
+  sig
+    type valu
+    val eval_address: Env.address -> valu
+    exception Error
+    val same_value: valu -> valu -> bool
+  end
+
+type ('a, 'b) gen_printer =
+  | Zero of 'b
+  | Succ of ('a -> ('a, 'b) gen_printer)
+
+module type S =
+  sig
+    type t
+    val install_printer :
+          Path.t -> Types.type_expr -> (formatter -> t -> unit) -> unit
+    val install_generic_printer :
+           Path.t -> Path.t ->
+           (int -> (int -> t -> Outcometree.out_value,
+                    t -> Outcometree.out_value) gen_printer) ->
+           unit
+    val install_generic_printer' :
+           Path.t -> Path.t ->
+           (formatter -> t -> unit,
+            formatter -> t -> unit) gen_printer ->
+           unit
+    val remove_printer : Path.t -> unit
+    val outval_of_untyped_exception : t -> Outcometree.out_value
+    val outval_of_value :
+          int -> int ->
+          (int -> t -> Types.type_expr -> Outcometree.out_value option) ->
+          Env.t -> t -> type_expr -> Outcometree.out_value
+  end
+
+module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
+
+    type t = O.t
+
+    module ObjTbl = Hashtbl.Make(struct
+        type t = O.t
+        let equal = (==)
+        let hash x =
+          try
+            Hashtbl.hash x
+          with _exn -> 0
+      end)
+
+
+    (* Given an exception value, we cannot recover its type,
+       hence we cannot print its arguments in general.
+       Here, we do a feeble attempt to print
+       integer, string and float arguments... *)
+    let outval_of_untyped_exception_args obj start_offset =
+      if O.size obj > start_offset then begin
+        let list = ref [] in
+        for i = start_offset to O.size obj - 1 do
+          let arg = O.field obj i in
+          if not (O.is_block arg) then
+            list := Oval_int (O.obj arg : int) :: !list
+               (* Note: this could be a char or a constant constructor... *)
+          else if O.tag arg = Obj.string_tag then
+            list :=
+              Oval_string ((O.obj arg : string), max_int, Ostr_string) :: !list
+          else if O.tag arg = Obj.double_tag then
+            list := Oval_float (O.obj arg : float) :: !list
+          else
+            list := Oval_constr (Oide_ident (Out_name.create "_"), []) :: !list
+        done;
+        List.rev !list
+      end
+      else []
+
+    let outval_of_untyped_exception bucket =
+      if O.tag bucket <> 0 then
+        let name = Out_name.create (O.obj (O.field bucket 0) : string) in
+        Oval_constr (Oide_ident name, [])
+      else
+      let name = (O.obj(O.field(O.field bucket 0) 0) : string) in
+      let args =
+        if (name = "Match_failure"
+            || name = "Assert_failure"
+            || name = "Undefined_recursive_module")
+        && O.size bucket = 2
+        && O.tag(O.field bucket 1) = 0
+        then outval_of_untyped_exception_args (O.field bucket 1) 0
+        else outval_of_untyped_exception_args bucket 1 in
+      Oval_constr (Oide_ident (Out_name.create name), args)
+
+    (* The user-defined printers. Also used for some builtin types. *)
+
+    type printer =
+      | Simple of Types.type_expr * (O.t -> Outcometree.out_value)
+      | Generic of Path.t * (int -> (int -> O.t -> Outcometree.out_value,
+                                     O.t -> Outcometree.out_value) gen_printer)
+
+    let printers = ref ([
+      ( Pident(Ident.create_local "print_int"),
+        Simple (Predef.type_int,
+                (fun x -> Oval_int (O.obj x : int))) );
+      ( Pident(Ident.create_local "print_float"),
+        Simple (Predef.type_float,
+                (fun x -> Oval_float (O.obj x : float))) );
+      ( Pident(Ident.create_local "print_char"),
+        Simple (Predef.type_char,
+                (fun x -> Oval_char (O.obj x : char))) );
+      ( Pident(Ident.create_local "print_int32"),
+        Simple (Predef.type_int32,
+                (fun x -> Oval_int32 (O.obj x : int32))) );
+      ( Pident(Ident.create_local "print_nativeint"),
+        Simple (Predef.type_nativeint,
+                (fun x -> Oval_nativeint (O.obj x : nativeint))) );
+      ( Pident(Ident.create_local "print_int64"),
+        Simple (Predef.type_int64,
+                (fun x -> Oval_int64 (O.obj x : int64)) ))
+    ] : (Path.t * printer) list)
+
+    let exn_printer ppf path exn =
+      fprintf ppf "" Printtyp.path path
+        (Printexc.to_string exn)
+
+    let out_exn path exn =
+      Oval_printer (fun ppf -> exn_printer ppf path exn)
+
+    let install_printer path ty fn =
+      let print_val ppf obj =
+        try fn ppf obj with exn -> exn_printer ppf path exn in
+      let printer obj = Oval_printer (fun ppf -> print_val ppf obj) in
+      printers := (path, Simple (ty, printer)) :: !printers
+
+    let install_generic_printer function_path constr_path fn =
+      printers := (function_path, Generic (constr_path, fn))  :: !printers
+
+    let install_generic_printer' function_path ty_path fn =
+      let rec build gp depth =
+        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
+              Oval_printer printer in
+            Zero out_printer
+        | Succ fn ->
+            let print_val fn_arg =
+              let print_arg ppf o =
+                !Oprint.out_value ppf (fn_arg (depth+1) o) in
+              build (fn print_arg) depth in
+            Succ print_val in
+      printers := (function_path, Generic (ty_path, build fn)) :: !printers
+
+    let remove_printer path =
+      let rec remove = function
+      | [] -> raise Not_found
+      | ((p, _) as printer) :: rem ->
+          if Path.same p path then rem else printer :: remove rem in
+      printers := remove !printers
+
+    (* Print a constructor or label, giving it the same prefix as the type
+       it comes from. Attempt to omit the prefix if the type comes from
+       a module that has been opened. *)
+
+    let tree_of_qualified find env ty_path name =
+      match ty_path with
+      | Pident _ ->
+          Oide_ident name
+      | Pdot(p, _s) ->
+          if
+            match (find (Lident (Out_name.print name)) env).desc with
+            | Tconstr(ty_path', _, _) -> Path.same ty_path ty_path'
+            | _ -> false
+            | exception Not_found -> false
+          then Oide_ident name
+          else Oide_dot (Printtyp.tree_of_path p, Out_name.print name)
+      | Papply _ ->
+          Printtyp.tree_of_path ty_path
+
+    let tree_of_constr =
+      tree_of_qualified
+        (fun lid env ->
+           (Env.find_constructor_by_name lid env).cstr_res)
+
+    and tree_of_label =
+      tree_of_qualified
+        (fun lid env ->
+           (Env.find_label_by_name lid env).lbl_res)
+
+    (* An abstract type *)
+
+    let abstract_type =
+      let id = Ident.create_local "abstract" in
+      let ty = Btype.newgenty (Tconstr (Pident id, [], ref Mnil)) in
+      ty
+
+    (* The main printing function *)
+
+    let outval_of_value max_steps max_depth check_depth env obj ty =
+
+      let printer_steps = ref max_steps in
+
+      let nested_values = ObjTbl.create 8 in
+      let nest_gen err f depth obj ty =
+        let repr = obj in
+        if not (O.is_block repr) then
+          f depth obj ty
+        else
+          if ObjTbl.mem nested_values repr then
+            err
+          else begin
+            ObjTbl.add nested_values repr ();
+            let ret = f depth obj ty in
+            ObjTbl.remove nested_values repr;
+            ret
+          end
+      in
+
+      let nest f = nest_gen (Oval_stuff "") f in
+
+      let rec tree_of_val depth obj ty =
+        decr printer_steps;
+        if !printer_steps < 0 || depth < 0 then Oval_ellipsis
+        else begin
+        try
+          find_printer depth env ty obj
+        with Not_found ->
+          match (Ctype.repr ty).desc with
+          | Tvar _ | Tunivar _ ->
+              Oval_stuff ""
+          | Tarrow _ ->
+              Oval_stuff ""
+          | 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
+                        in
+                        let next_obj = O.field obj 1 in
+                        nest_gen (Oval_stuff "" :: 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
+                        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 ""
+             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 ) in such
+                    a case (PR#6669).
+
+                    Unfortunately, there is a corner-case that *is*
+                    a real cycle: using -rectypes one can define
+                      let rec x = lazy 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_constr (Oide_ident (Out_name.create "lazy"), [v])
+               end
+          | Tconstr(path, ty_list, _) -> begin
+              try
+                let decl = Env.find_type path env in
+                match decl with
+                | {type_kind = Type_abstract; type_manifest = None} ->
+                    Oval_stuff ""
+                | {type_kind = Type_abstract; type_manifest = Some body} ->
+                    tree_of_val depth obj
+                      (try Ctype.apply env decl.type_params body ty_list with
+                         Ctype.Cannot_apply -> abstract_type)
+                | {type_kind = Type_variant constr_list; type_unboxed} ->
+                    let unbx = type_unboxed.unboxed in
+                    let tag =
+                      if unbx then Cstr_unboxed
+                      else if O.is_block obj
+                      then Cstr_block(O.tag obj)
+                      else Cstr_constant(O.obj obj) in
+                    let {cd_id;cd_args;cd_res} =
+                      Datarepr.find_constr_by_tag tag constr_list in
+                    let type_params =
+                      match cd_res with
+                        Some t ->
+                          begin match (Ctype.repr t).desc with
+                            Tconstr (_,params,_) ->
+                              params
+                          | _ -> assert false end
+                      | None -> decl.type_params
+                    in
+                    begin
+                      match cd_args with
+                      | Cstr_tuple l ->
+                          let ty_args =
+                            List.map
+                              (function ty ->
+                                try Ctype.apply env type_params ty ty_list with
+                                  Ctype.Cannot_apply -> abstract_type)
+                              l
+                          in
+                          tree_of_constr_with_args (tree_of_constr env path)
+                            (Ident.name cd_id) false 0 depth obj
+                            ty_args unbx
+                      | Cstr_record lbls ->
+                          let r =
+                            tree_of_record_fields depth
+                              env path type_params ty_list
+                              lbls 0 obj unbx
+                          in
+                          Oval_constr(tree_of_constr env path
+                                        (Out_name.create (Ident.name cd_id)),
+                                      [ r ])
+                    end
+                | {type_kind = Type_record(lbl_list, rep)} ->
+                    begin match check_depth depth obj ty with
+                      Some x -> x
+                    | None ->
+                        let pos =
+                          match rep with
+                          | Record_extension _ -> 1
+                          | _ -> 0
+                        in
+                        let unbx =
+                          match rep with Record_unboxed _ -> true | _ -> false
+                        in
+                        tree_of_record_fields depth
+                          env path decl.type_params ty_list
+                          lbl_list pos obj unbx
+                    end
+                | {type_kind = Type_open} ->
+                    tree_of_extension path depth obj
+              with
+                Not_found ->                (* raised by Env.find_type *)
+                  Oval_stuff ""
+              | Datarepr.Constr_not_found -> (* raised by find_constr_by_tag *)
+                  Oval_stuff ""
+              end
+          | Tvariant row ->
+              let row = Btype.row_repr row in
+              if O.is_block obj then
+                let tag : int = O.obj (O.field obj 0) in
+                let rec find = function
+                  | (l, f) :: fields ->
+                      if Btype.hash_variant l = tag then
+                        match Btype.row_field_repr f with
+                        | Rpresent(Some ty) | Reither(_,[ty],_,_) ->
+                            let args =
+                              nest tree_of_val (depth - 1) (O.field obj 1) ty
+                            in
+                              Oval_variant (l, Some args)
+                        | _ -> find fields
+                      else find fields
+                  | [] -> Oval_stuff "" in
+                find row.row_fields
+              else
+                let tag : int = O.obj obj in
+                let rec find = function
+                  | (l, _) :: fields ->
+                      if Btype.hash_variant l = tag then
+                        Oval_variant (l, None)
+                      else find fields
+                  | [] -> Oval_stuff "" in
+                find row.row_fields
+          | Tobject (_, _) ->
+              Oval_stuff ""
+          | Tsubst ty ->
+              tree_of_val (depth - 1) obj ty
+          | Tfield(_, _, _, _) | Tnil | Tlink _ ->
+              fatal_error "Printval.outval_of_value"
+          | Tpoly (ty, _) ->
+              tree_of_val (depth - 1) obj ty
+          | Tpackage _ ->
+              Oval_stuff ""
+        end
+
+      and tree_of_record_fields depth env path type_params ty_list
+          lbl_list pos obj unboxed =
+        let rec tree_of_fields pos = function
+          | [] -> []
+          | {ld_id; ld_type} :: remainder ->
+              let ty_arg =
+                try
+                  Ctype.apply env type_params ld_type
+                    ty_list
+                with
+                  Ctype.Cannot_apply -> abstract_type in
+              let name = Ident.name ld_id in
+              (* PR#5722: print full module path only
+                 for first record field *)
+              let lid =
+                if pos = 0 then tree_of_label env path (Out_name.create name)
+                else Oide_ident (Out_name.create name)
+              and v =
+                if unboxed then
+                  tree_of_val (depth - 1) obj ty_arg
+                else begin
+                  let fld =
+                    if O.tag obj = O.double_array_tag then
+                      O.repr (O.double_field obj pos)
+                    else
+                      O.field obj pos
+                  in
+                  nest tree_of_val (depth - 1) fld ty_arg
+                end
+              in
+              (lid, v) :: tree_of_fields (pos + 1) remainder
+        in
+        Oval_record (tree_of_fields pos lbl_list)
+
+      and tree_of_val_list start depth obj ty_list =
+        let rec tree_list i = function
+          | [] -> []
+          | ty :: ty_list ->
+              let tree = nest tree_of_val (depth - 1) (O.field obj i) ty in
+              tree :: tree_list (i + 1) ty_list in
+      tree_list start ty_list
+
+      and tree_of_constr_with_args
+             tree_of_cstr cstr_name inlined start depth obj ty_args unboxed =
+        let lid = tree_of_cstr (Out_name.create cstr_name) in
+        let args =
+          if inlined || unboxed then
+            match ty_args with
+            | [ty] -> [ tree_of_val (depth - 1) obj ty ]
+            | _ -> assert false
+          else
+            tree_of_val_list start depth obj ty_args
+        in
+        Oval_constr (lid, args)
+
+    and tree_of_extension type_path depth bucket =
+      let slot =
+        if O.tag bucket <> 0 then bucket
+        else O.field bucket 0
+      in
+      let name = (O.obj(O.field slot 0) : string) in
+      try
+        (* Attempt to recover the constructor description for the exn
+           from its name *)
+        let lid =
+          try Parse.longident (Lexing.from_string name) with
+          (* The syntactic class for extension constructor names
+             is an extended form of constructor "Longident.t"s
+             that also includes module application (e.g [F(X).A]) *)
+           | Syntaxerr.Error _ | Lexer.Error _ -> raise Not_found in
+        let cstr = Env.find_constructor_by_name lid env in
+        let path =
+          match cstr.cstr_tag with
+            Cstr_extension(p, _) -> p
+            | _ -> raise Not_found
+        in
+        let addr = Env.find_constructor_address path env in
+        (* Make sure this is the right exception and not an homonym,
+           by evaluating the exception found and comparing with the
+           identifier contained in the exception bucket *)
+        if not (EVP.same_value slot (EVP.eval_address addr))
+        then raise Not_found;
+        tree_of_constr_with_args
+           (fun x -> Oide_ident x) name (cstr.cstr_inlined <> None)
+           1 depth bucket
+           cstr.cstr_args false
+      with Not_found | EVP.Error ->
+        match check_depth depth bucket ty with
+          Some x -> x
+        | None when Path.same type_path Predef.path_exn->
+            outval_of_untyped_exception bucket
+        | None ->
+            Oval_stuff ""
+
+    and find_printer depth env ty =
+      let rec find = function
+      | [] -> raise Not_found
+      | (_name, Simple (sch, printer)) :: remainder ->
+          if Ctype.moregeneral env false sch ty
+          then printer
+          else find remainder
+      | (_name, Generic (path, fn)) :: remainder ->
+          begin match (Ctype.expand_head env ty).desc with
+          | Tconstr (p, args, _) when Path.same p path ->
+              begin try apply_generic_printer path (fn depth) args
+              with exn -> (fun _obj -> out_exn path exn) end
+          | _ -> find remainder end in
+      find !printers
+
+    and apply_generic_printer path printer args =
+      match (printer, args) with
+      | (Zero fn, []) ->
+          (fun (obj : O.t)-> try fn obj with exn -> out_exn path exn)
+      | (Succ fn, arg :: args) ->
+          let printer = fn (fun depth obj -> tree_of_val depth obj arg) in
+          apply_generic_printer path printer args
+      | _ ->
+          (fun _obj ->
+            let printer ppf =
+              fprintf ppf ""
+                Printtyp.path path in
+            Oval_printer printer)
+
+
+    in nest tree_of_val max_depth obj ty
+
+end
diff --git a/toplevel/genprintval.mli b/toplevel/genprintval.mli
new file mode 100644
index 00000000..7e150fc8
--- /dev/null
+++ b/toplevel/genprintval.mli
@@ -0,0 +1,73 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Printing of values *)
+
+open Types
+open Format
+
+module type OBJ =
+  sig
+    type t
+    val repr : 'a -> t
+    val obj : t -> 'a
+    val is_block : t -> bool
+    val tag : t -> int
+    val size : t -> int
+    val field : t -> int -> t
+    val double_array_tag : int
+    val double_field : t -> int -> float
+  end
+
+module type EVALPATH =
+  sig
+    type valu
+    val eval_address: Env.address -> valu
+    exception Error
+    val same_value: valu -> valu -> bool
+  end
+
+type ('a, 'b) gen_printer =
+  | Zero of 'b
+  | Succ of ('a -> ('a, 'b) gen_printer)
+
+module type S =
+  sig
+    type t
+    val install_printer :
+          Path.t -> Types.type_expr -> (formatter -> t -> unit) -> unit
+    val install_generic_printer :
+          Path.t -> Path.t ->
+          (int -> (int -> t -> Outcometree.out_value,
+                   t -> Outcometree.out_value) gen_printer) ->
+          unit
+    val install_generic_printer' :
+           Path.t -> Path.t ->
+           (formatter -> t -> unit,
+            formatter -> t -> unit) gen_printer ->
+           unit
+    (** [install_generic_printer' function_path constructor_path printer]
+        function_path is used to remove the printer. *)
+
+    val remove_printer : Path.t -> unit
+    val outval_of_untyped_exception : t -> Outcometree.out_value
+    val outval_of_value :
+          int -> int ->
+          (int -> t -> Types.type_expr -> Outcometree.out_value option) ->
+          Env.t -> t -> type_expr -> Outcometree.out_value
+  end
+
+module Make(O : OBJ)(_ : EVALPATH with type valu = O.t) :
+         (S with type t = O.t)
diff --git a/toplevel/opttopdirs.ml b/toplevel/opttopdirs.ml
new file mode 100644
index 00000000..b8e1c012
--- /dev/null
+++ b/toplevel/opttopdirs.ml
@@ -0,0 +1,218 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Toplevel directives *)
+
+open Format
+open Misc
+open Longident
+open Types
+open Opttoploop
+
+(* The standard output formatter *)
+let std_out = std_formatter
+
+(* To quit *)
+
+let dir_quit () = exit 0
+
+let _ = Hashtbl.add directive_table "quit" (Directive_none dir_quit)
+
+(* To add a directory to the load path *)
+
+let dir_directory s =
+  let d = expand_directory Config.standard_library s in
+  let dir = Load_path.Dir.create d in
+  Load_path.add dir;
+  toplevel_env :=
+    Stdlib.String.Set.fold
+      (fun name env ->
+         Env.add_persistent_structure (Ident.create_persistent name) env)
+      (Env.persistent_structures_of_dir dir)
+      !toplevel_env
+
+let _ = Hashtbl.add directive_table "directory" (Directive_string dir_directory)
+(* To remove a directory from the load path *)
+let dir_remove_directory s =
+  let d = expand_directory Config.standard_library s in
+  let keep id =
+    match Load_path.find_uncap (Ident.name id ^ ".cmi") with
+    | exception Not_found -> true
+    | fn -> Filename.dirname fn <> d
+  in
+  toplevel_env := Env.filter_non_loaded_persistent keep !toplevel_env;
+  Load_path.remove_dir s
+
+let _ =
+  Hashtbl.add directive_table "remove_directory"
+    (Directive_string dir_remove_directory)
+
+let _ = Hashtbl.add directive_table "show_dirs"
+  (Directive_none
+     (fun () ->
+        List.iter print_endline (Load_path.get_paths ())
+     ))
+
+(* To change the current directory *)
+
+let dir_cd s = Sys.chdir s
+
+let _ = Hashtbl.add directive_table "cd" (Directive_string dir_cd)
+
+(* Load in-core a .cmxs file *)
+
+let load_file ppf name0 =
+  let name =
+    try Some (Load_path.find name0)
+    with Not_found -> None
+  in
+  match name with
+  | None -> fprintf ppf "File not found: %s@." name0; false
+  | Some name ->
+    let fn,tmp =
+      if Filename.check_suffix name ".cmx" || Filename.check_suffix name ".cmxa"
+      then
+        let cmxs = Filename.temp_file "caml" ".cmxs" in
+        Asmlink.link_shared ~ppf_dump:ppf [name] cmxs;
+        cmxs,true
+      else
+        name,false
+    in
+    let success =
+      (* The Dynlink interface does not allow us to distinguish between
+          a Dynlink.Error exceptions raised in the loaded modules
+          or a genuine error during dynlink... *)
+      try Dynlink.loadfile fn; true
+      with
+      | Dynlink.Error err ->
+        fprintf ppf "Error while loading %s: %s.@."
+          name (Dynlink.error_message err);
+        false
+      | exn ->
+        print_exception_outcome ppf exn;
+        false
+    in
+    if tmp then (try Sys.remove fn with Sys_error _ -> ());
+    success
+
+
+let dir_load ppf name = ignore (load_file ppf name)
+
+let _ = Hashtbl.add directive_table "load" (Directive_string (dir_load std_out))
+
+(* Load commands from a file *)
+
+let dir_use ppf name = ignore(Opttoploop.use_file ppf name)
+let dir_use_output ppf name = ignore(Opttoploop.use_output ppf name)
+
+let _ = Hashtbl.add directive_table "use" (Directive_string (dir_use std_out))
+let _ = Hashtbl.add directive_table "use_output"
+    (Directive_string (dir_use_output std_out))
+
+(* Install, remove a printer *)
+
+type 'a printer_type_new = Format.formatter -> 'a -> unit
+type 'a printer_type_old = 'a -> unit
+
+let match_printer_type ppf desc typename =
+  let printer_type =
+    match
+      Env.find_type_by_name
+        (Ldot(Lident "Opttopdirs", typename)) !toplevel_env
+    with
+    | (path, _) -> path
+    | exception Not_found ->
+        fprintf ppf "Cannot find type Topdirs.%s.@." typename;
+        raise Exit
+  in
+  Ctype.begin_def();
+  let ty_arg = Ctype.newvar() in
+  Ctype.unify !toplevel_env
+    (Ctype.newconstr printer_type [ty_arg])
+    (Ctype.instance desc.val_type);
+  Ctype.end_def();
+  Ctype.generalize ty_arg;
+  ty_arg
+
+let find_printer_type ppf lid =
+  match Env.find_value_by_name lid !toplevel_env with
+  | (path, desc) -> begin
+    match match_printer_type ppf desc "printer_type_new" with
+    | ty_arg -> (ty_arg, path, false)
+    | exception Ctype.Unify _ -> begin
+        match match_printer_type ppf desc "printer_type_old" with
+        | ty_arg -> (ty_arg, path, true)
+        | exception Ctype.Unify _ ->
+            fprintf ppf "%a has a wrong type for a printing function.@."
+              Printtyp.longident lid;
+            raise Exit
+      end
+  end
+  | exception Not_found ->
+      fprintf ppf "Unbound value %a.@." Printtyp.longident lid;
+      raise Exit
+
+let dir_install_printer ppf lid =
+  try
+    let (ty_arg, path, is_old_style) = find_printer_type ppf lid in
+    let v = eval_value_path !toplevel_env path in
+    let print_function =
+      if is_old_style then
+        (fun _formatter repr -> Obj.obj v (Obj.obj repr))
+      else
+        (fun formatter repr -> Obj.obj v formatter (Obj.obj repr)) in
+    install_printer path ty_arg print_function
+  with Exit -> ()
+
+let dir_remove_printer ppf lid =
+  try
+    let (_ty_arg, path, _is_old_style) = find_printer_type ppf lid in
+    begin try
+      remove_printer path
+    with Not_found ->
+      fprintf ppf "No printer named %a.@." Printtyp.longident lid
+    end
+  with Exit -> ()
+
+let _ = Hashtbl.add directive_table "install_printer"
+             (Directive_ident (dir_install_printer std_out))
+let _ = Hashtbl.add directive_table "remove_printer"
+             (Directive_ident (dir_remove_printer std_out))
+
+let parse_warnings ppf iserr s =
+  try Warnings.parse_options iserr s
+  with Arg.Bad err -> fprintf ppf "%s.@." err
+
+let _ =
+(* Control the printing of values *)
+
+  Hashtbl.add directive_table "print_depth"
+             (Directive_int(fun n -> max_printer_depth := n));
+  Hashtbl.add directive_table "print_length"
+             (Directive_int(fun n -> max_printer_steps := n));
+
+(* Set various compiler flags *)
+
+  Hashtbl.add directive_table "labels"
+             (Directive_bool(fun b -> Clflags.classic := not b));
+
+  Hashtbl.add directive_table "principal"
+             (Directive_bool(fun b -> Clflags.principal := b));
+
+  Hashtbl.add directive_table "warnings"
+             (Directive_string (parse_warnings std_out false));
+
+  Hashtbl.add directive_table "warn_error"
+             (Directive_string (parse_warnings std_out true))
diff --git a/toplevel/opttopdirs.mli b/toplevel/opttopdirs.mli
new file mode 100644
index 00000000..e7043352
--- /dev/null
+++ b/toplevel/opttopdirs.mli
@@ -0,0 +1,34 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The toplevel directives. *)
+
+open Format
+
+val dir_quit : unit -> unit
+val dir_directory : string -> unit
+val dir_remove_directory : string -> unit
+val dir_cd : string -> unit
+val dir_load : formatter -> string -> unit
+val dir_use : formatter -> string -> unit
+val dir_use_output : formatter -> string -> unit
+val dir_install_printer : formatter -> Longident.t -> unit
+val dir_remove_printer : formatter -> Longident.t -> unit
+
+type 'a printer_type_new = Format.formatter -> 'a -> unit
+type 'a printer_type_old = 'a -> unit
+
+(* For topmain.ml. Maybe shouldn't be there *)
+val load_file : formatter -> string -> bool
diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml
new file mode 100644
index 00000000..6c5e10b3
--- /dev/null
+++ b/toplevel/opttoploop.ml
@@ -0,0 +1,684 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The interactive toplevel loop *)
+
+open Format
+open Config
+open Misc
+open Parsetree
+open Types
+open Typedtree
+open Outcometree
+open Ast_helper
+
+type res = Ok of Obj.t | Err of string
+type evaluation_outcome = Result of Obj.t | Exception of exn
+
+let _dummy = (Ok (Obj.magic 0), Err "")
+
+external ndl_run_toplevel: string -> string -> res
+  = "caml_natdynlink_run_toplevel"
+
+let global_symbol id =
+  let sym = Compilenv.symbol_for_global id in
+  match Dynlink.unsafe_get_global_value ~bytecode_or_asm_symbol:sym with
+  | None ->
+    fatal_error ("Opttoploop.global_symbol " ^ (Ident.unique_name id))
+  | Some obj -> obj
+
+let need_symbol sym =
+  Option.is_none (Dynlink.unsafe_get_global_value ~bytecode_or_asm_symbol:sym)
+
+let dll_run dll entry =
+  match (try Result (Obj.magic (ndl_run_toplevel dll entry))
+         with exn -> Exception exn)
+  with
+    | Exception _ as r -> r
+    | Result r ->
+        match Obj.magic r with
+          | Ok x -> Result x
+          | Err s -> fatal_error ("Opttoploop.dll_run " ^ s)
+
+
+type directive_fun =
+   | Directive_none of (unit -> unit)
+   | Directive_string of (string -> unit)
+   | Directive_int of (int -> unit)
+   | Directive_ident of (Longident.t -> unit)
+   | Directive_bool of (bool -> unit)
+
+
+let remembered = ref Ident.empty
+
+let rec remember phrase_name i = function
+  | [] -> ()
+  | Sig_value  (id, _, _) :: rest
+  | Sig_module (id, _, _, _, _) :: rest
+  | Sig_typext (id, _, _, _) :: rest
+  | Sig_class  (id, _, _, _) :: rest ->
+      remembered := Ident.add id (phrase_name, i) !remembered;
+      remember phrase_name (succ i) rest
+  | _ :: rest -> remember phrase_name i rest
+
+let toplevel_value id =
+  try Ident.find_same id !remembered
+  with _ -> Misc.fatal_error @@ "Unknown ident: " ^ Ident.unique_name id
+
+let close_phrase lam =
+  let open Lambda in
+  Ident.Set.fold (fun id l ->
+    let glb, pos = toplevel_value id in
+    let glob =
+      Lprim (Pfield pos,
+             [Lprim (Pgetglobal glb, [], Loc_unknown)],
+             Loc_unknown)
+    in
+    Llet(Strict, Pgenval, id, glob, l)
+  ) (free_variables lam) lam
+
+let toplevel_value id =
+  let glob, pos =
+    if Config.flambda then toplevel_value id else Translmod.nat_toplevel_name id
+  in
+  (Obj.magic (global_symbol glob)).(pos)
+
+(* Return the value referred to by a path *)
+
+let rec eval_address = function
+  | Env.Aident id ->
+      if Ident.persistent id || Ident.global id
+      then global_symbol id
+      else toplevel_value id
+  | Env.Adot(a, pos) ->
+      Obj.field (eval_address a) pos
+
+let eval_path find env path =
+  match find path env with
+  | addr -> eval_address addr
+  | exception Not_found ->
+      fatal_error ("Cannot find address for: " ^ (Path.name path))
+
+let eval_module_path env path =
+  eval_path Env.find_module_address env path
+
+let eval_value_path env path =
+  eval_path Env.find_value_address env path
+
+let eval_extension_path env path =
+  eval_path Env.find_constructor_address env path
+
+let eval_class_path env path =
+  eval_path Env.find_class_address env path
+
+(* To print values *)
+
+module EvalPath = struct
+  type valu = Obj.t
+  exception Error
+  let eval_address addr =
+    try eval_address addr with _ -> raise Error
+  let same_value v1 v2 = (v1 == v2)
+end
+
+module Printer = Genprintval.Make(Obj)(EvalPath)
+
+let max_printer_depth = ref 100
+let max_printer_steps = ref 300
+
+let print_out_value = Oprint.out_value
+let print_out_type = Oprint.out_type
+let print_out_class_type = Oprint.out_class_type
+let print_out_module_type = Oprint.out_module_type
+let print_out_type_extension = Oprint.out_type_extension
+let print_out_sig_item = Oprint.out_sig_item
+let print_out_signature = Oprint.out_signature
+let print_out_phrase = Oprint.out_phrase
+
+let print_untyped_exception ppf obj =
+  !print_out_value ppf (Printer.outval_of_untyped_exception obj)
+let outval_of_value env obj ty =
+  Printer.outval_of_value !max_printer_steps !max_printer_depth
+    (fun _ _ _ -> None) env obj ty
+let print_value env obj ppf ty =
+  !print_out_value ppf (outval_of_value env obj ty)
+
+type ('a, 'b) gen_printer = ('a, 'b) Genprintval.gen_printer =
+  | Zero of 'b
+  | Succ of ('a -> ('a, 'b) gen_printer)
+
+let install_printer = Printer.install_printer
+let install_generic_printer = Printer.install_generic_printer
+let install_generic_printer' = Printer.install_generic_printer'
+let remove_printer = Printer.remove_printer
+
+(* Hooks for parsing functions *)
+
+let parse_toplevel_phrase = ref Parse.toplevel_phrase
+let parse_use_file = ref Parse.use_file
+let print_location = Location.print_loc
+let print_error = Location.print_report
+let print_warning = Location.print_warning
+let input_name = Location.input_name
+
+let parse_mod_use_file name lb =
+  let modname =
+    String.capitalize_ascii
+      (Filename.remove_extension (Filename.basename name))
+  in
+  let items =
+    List.concat
+      (List.map
+         (function Ptop_def s -> s | Ptop_dir _ -> [])
+         (!parse_use_file lb))
+  in
+  [ Ptop_def
+      [ Str.module_
+          (Mb.mk
+             (Location.mknoloc (Some modname))
+             (Mod.structure items)
+          )
+       ]
+   ]
+
+(* Hook for initialization *)
+
+let toplevel_startup_hook = ref (fun () -> ())
+
+type event = ..
+type event +=
+  | Startup
+  | After_setup
+
+let hooks = ref []
+
+let add_hook f = hooks := f :: !hooks
+
+let () =
+  add_hook (function
+      | Startup -> !toplevel_startup_hook ()
+      | _ -> ())
+
+let run_hooks hook = List.iter (fun f -> f hook) !hooks
+
+(* Load in-core and execute a lambda term *)
+
+let phrase_seqid = ref 0
+let phrase_name = ref "TOP"
+
+(* CR-soon trefis for mshinwell: copy/pasted from Optmain. Should it be shared
+   or?
+   mshinwell: It should be shared, but after 4.03. *)
+module Backend = struct
+  (* See backend_intf.mli. *)
+
+  let symbol_for_global' = Compilenv.symbol_for_global'
+  let closure_symbol = Compilenv.closure_symbol
+
+  let really_import_approx = Import_approx.really_import_approx
+  let import_symbol = Import_approx.import_symbol
+
+  let size_int = Arch.size_int
+  let big_endian = Arch.big_endian
+
+  let max_sensible_number_of_arguments =
+    (* The "-1" is to allow for a potential closure environment parameter. *)
+    Proc.max_arguments_for_tailcalls - 1
+end
+let backend = (module Backend : Backend_intf.S)
+
+let load_lambda ppf ~module_ident ~required_globals lam size =
+  if !Clflags.dump_rawlambda then fprintf ppf "%a@." Printlambda.lambda lam;
+  let slam = Simplif.simplify_lambda lam in
+  if !Clflags.dump_lambda then fprintf ppf "%a@." Printlambda.lambda slam;
+
+  let dll =
+    if !Clflags.keep_asm_file then !phrase_name ^ ext_dll
+    else Filename.temp_file ("caml" ^ !phrase_name) ext_dll
+  in
+  let filename = Filename.chop_extension dll in
+  let program =
+    { Lambda.
+      code = slam;
+      main_module_block_size = size;
+      module_ident;
+      required_globals;
+    }
+  in
+  let middle_end =
+    if Config.flambda then Flambda_middle_end.lambda_to_clambda
+    else Closure_middle_end.lambda_to_clambda
+  in
+  Asmgen.compile_implementation ~toplevel:need_symbol
+    ~backend ~filename ~prefixname:filename
+    ~middle_end ~ppf_dump:ppf program;
+  Asmlink.call_linker_shared [filename ^ ext_obj] dll;
+  Sys.remove (filename ^ ext_obj);
+
+  let dll =
+    if Filename.is_implicit dll
+    then Filename.concat (Sys.getcwd ()) dll
+    else dll in
+  let res = dll_run dll !phrase_name in
+  (try Sys.remove dll with Sys_error _ -> ());
+  (* note: under windows, cannot remove a loaded dll
+     (should remember the handles, close them in at_exit, and then remove
+     files) *)
+  res
+
+(* Print the outcome of an evaluation *)
+
+let pr_item =
+  Printtyp.print_items
+    (fun env -> function
+      | Sig_value(id, {val_kind = Val_reg; val_type}, _) ->
+          Some (outval_of_value env (toplevel_value id) val_type)
+      | _ -> None
+    )
+
+(* The current typing environment for the toplevel *)
+
+let toplevel_env = ref Env.empty
+
+(* Print an exception produced by an evaluation *)
+
+let print_out_exception ppf exn outv =
+  !print_out_phrase ppf (Ophr_exception (exn, outv))
+
+let print_exception_outcome ppf exn =
+  if exn = Out_of_memory then Gc.full_major ();
+  let outv = outval_of_value !toplevel_env (Obj.repr exn) Predef.type_exn in
+  print_out_exception ppf exn outv
+
+(* The table of toplevel directives.
+   Filled by functions from module topdirs. *)
+
+let directive_table = (Hashtbl.create 13 : (string, directive_fun) Hashtbl.t)
+
+(* Execute a toplevel phrase *)
+
+let execute_phrase print_outcome ppf phr =
+  match phr with
+  | Ptop_def sstr ->
+      let oldenv = !toplevel_env in
+      incr phrase_seqid;
+      phrase_name := Printf.sprintf "TOP%i" !phrase_seqid;
+      Compilenv.reset ?packname:None !phrase_name;
+      Typecore.reset_delayed_checks ();
+      let sstr, rewritten =
+        match sstr with
+        | [ { pstr_desc = Pstr_eval (e, attrs) ; pstr_loc = loc } ]
+        | [ { pstr_desc = Pstr_value (Asttypes.Nonrecursive,
+                                      [{ pvb_expr = e
+                                       ; pvb_pat = { ppat_desc = Ppat_any ; _ }
+                                       ; pvb_attributes = attrs
+                                       ; _ }])
+            ; pstr_loc = loc }
+          ] ->
+            let pat = Ast_helper.Pat.var (Location.mknoloc "_$") in
+            let vb = Ast_helper.Vb.mk ~loc ~attrs pat e in
+            [ Ast_helper.Str.value ~loc Asttypes.Nonrecursive [vb] ], true
+        | _ -> sstr, false
+      in
+      let (str, sg, names, newenv) = Typemod.type_toplevel_phrase oldenv sstr 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');
+      Typecore.force_delayed_checks ();
+      let module_ident, res, required_globals, size =
+        if Config.flambda then
+          let { Lambda.module_ident; main_module_block_size = size;
+                required_globals; code = res } =
+            Translmod.transl_implementation_flambda !phrase_name
+              (str, Tcoerce_none)
+          in
+          remember module_ident 0 sg';
+          module_ident, close_phrase res, required_globals, size
+        else
+          let size, res = Translmod.transl_store_phrases !phrase_name str in
+          Ident.create_persistent !phrase_name, res, Ident.Set.empty, size
+      in
+      Warnings.check_fatal ();
+      begin try
+        toplevel_env := newenv;
+        let res = load_lambda ppf ~required_globals ~module_ident res size in
+        let out_phr =
+          match res with
+          | Result _ ->
+              if Config.flambda then
+                (* CR-someday trefis: *)
+                Env.register_import_as_opaque (Ident.name module_ident)
+              else
+                Compilenv.record_global_approx_toplevel ();
+              if print_outcome then
+                Printtyp.wrap_printing_env ~error:false oldenv (fun () ->
+                match str.str_items with
+                | [] -> Ophr_signature []
+                | _ ->
+                    if rewritten then
+                      match sg' with
+                      | [ Sig_value (id, vd, _) ] ->
+                          let outv =
+                            outval_of_value newenv (toplevel_value id)
+                              vd.val_type
+                          in
+                          let ty = Printtyp.tree_of_type_scheme vd.val_type in
+                          Ophr_eval (outv, ty)
+                      | _ -> assert false
+                    else
+                      Ophr_signature (pr_item oldenv sg'))
+              else Ophr_signature []
+          | Exception exn ->
+              toplevel_env := oldenv;
+              if exn = Out_of_memory then Gc.full_major();
+              let outv =
+                outval_of_value !toplevel_env (Obj.repr exn) Predef.type_exn
+              in
+              Ophr_exception (exn, outv)
+        in
+        !print_out_phrase ppf out_phr;
+        begin match out_phr with
+        | Ophr_eval (_, _) | Ophr_signature _ -> true
+        | Ophr_exception _ -> false
+        end
+      with x ->
+        toplevel_env := oldenv; raise x
+      end
+  | Ptop_dir {pdir_name = {Location.txt = dir_name}; pdir_arg } ->
+      let d =
+        try Some (Hashtbl.find directive_table dir_name)
+        with Not_found -> None
+      in
+      begin match d with
+      | None ->
+          fprintf ppf "Unknown directive `%s'.@." dir_name;
+          false
+      | Some d ->
+          match d, pdir_arg with
+          | Directive_none f, None -> f (); true
+          | Directive_string f, Some {pdira_desc = Pdir_string s} -> f s; true
+          | Directive_int f, Some {pdira_desc = Pdir_int (n,None)} ->
+             begin match Int_literal_converter.int n with
+             | n -> f n; true
+             | exception _ ->
+               fprintf ppf "Integer literal exceeds the range of \
+                            representable integers for directive `%s'.@."
+                       dir_name;
+               false
+             end
+          | Directive_int _, Some {pdira_desc = Pdir_int (_, Some _)} ->
+              fprintf ppf "Wrong integer literal for directive `%s'.@."
+                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
+          | _ ->
+              fprintf ppf "Wrong type of argument for directive `%s'.@."
+                dir_name;
+              false
+      end
+
+(* Read and execute commands from a file, or from stdin if [name] is "". *)
+
+let use_print_results = ref true
+
+let preprocess_phrase ppf phr =
+  let phr =
+    match phr with
+    | Ptop_def str ->
+        let str =
+          Pparse.apply_rewriters_str ~restore:true ~tool_name:"ocaml" str
+        in
+        Ptop_def str
+    | phr -> phr
+  in
+  if !Clflags.dump_parsetree then Printast.top_phrase ppf phr;
+  if !Clflags.dump_source then Pprintast.top_phrase ppf phr;
+  phr
+
+let use_channel ppf ~wrap_in_module ic name filename =
+  let lb = Lexing.from_channel ic in
+  Location.init lb filename;
+  (* Skip initial #! line if any *)
+  Lexer.skip_hash_bang lb;
+  let success =
+    protect_refs [ R (Location.input_name, filename) ] (fun () ->
+      try
+        List.iter
+          (fun ph ->
+            let ph = preprocess_phrase ppf ph in
+            if not (execute_phrase !use_print_results ppf ph) then raise Exit)
+          (if wrap_in_module then
+             parse_mod_use_file name lb
+           else
+             !parse_use_file lb);
+        true
+      with
+      | Exit -> false
+      | Sys.Break -> fprintf ppf "Interrupted.@."; false
+      | x -> Location.report_exception ppf x; false) in
+  success
+
+let use_output ppf command =
+  let fn = Filename.temp_file "ocaml" "_toploop.ml" in
+  Misc.try_finally ~always:(fun () ->
+      try Sys.remove fn with Sys_error _ -> ())
+    (fun () ->
+       match
+         Printf.ksprintf Sys.command "%s > %s"
+           command
+           (Filename.quote fn)
+       with
+       | 0 ->
+         let ic = open_in_bin fn in
+         Misc.try_finally ~always:(fun () -> close_in ic)
+           (fun () ->
+              use_channel ppf ~wrap_in_module:false ic "" "(command-output)")
+       | n ->
+         fprintf ppf "Command exited with code %d.@." n;
+         false)
+
+let use_file ppf ~wrap_in_module name =
+  match name with
+  | "" ->
+    use_channel ppf ~wrap_in_module stdin name "(stdin)"
+  | _ ->
+    match Load_path.find name with
+    | filename ->
+      let ic = open_in_bin filename in
+      Misc.try_finally ~always:(fun () -> close_in ic)
+        (fun () -> use_channel ppf ~wrap_in_module ic name filename)
+    | exception Not_found ->
+      fprintf ppf "Cannot find file %s.@." name;
+      false
+
+let mod_use_file ppf name =
+  use_file ppf ~wrap_in_module:true name
+let use_file ppf name =
+  use_file ppf ~wrap_in_module:false name
+
+let use_silently ppf name =
+  protect_refs [ R (use_print_results, false) ] (fun () -> use_file ppf name)
+
+(* Reading function for interactive use *)
+
+let first_line = ref true
+let got_eof = ref false;;
+
+let read_input_default prompt buffer len =
+  output_string stdout prompt; flush stdout;
+  let i = ref 0 in
+  try
+    while true do
+      if !i >= len then raise Exit;
+      let c = input_char stdin in
+      Bytes.set buffer !i c;
+      incr i;
+      if c = '\n' then raise Exit;
+    done;
+    (!i, false)
+  with
+  | End_of_file ->
+      (!i, true)
+  | Exit ->
+      (!i, false)
+
+let read_interactive_input = ref read_input_default
+
+let refill_lexbuf buffer len =
+  if !got_eof then (got_eof := false; 0) else begin
+    let prompt =
+      if !Clflags.noprompt then ""
+      else if !first_line then "# "
+      else if !Clflags.nopromptcont then ""
+      else if Lexer.in_comment () then "* "
+      else "  "
+    in
+    first_line := false;
+    let (len, eof) = !read_interactive_input prompt buffer len in
+    if eof then begin
+      Location.echo_eof ();
+      if len > 0 then got_eof := true;
+      len
+    end else
+      len
+  end
+
+(* Toplevel initialization. Performed here instead of at the
+   beginning of loop() so that user code linked in with ocamlmktop
+   can call directives from Topdirs. *)
+
+let _ =
+  Sys.interactive := true;
+  Compmisc.init_path ();
+  Clflags.dlcode := true;
+  ()
+
+let find_ocamlinit () =
+  let ocamlinit = ".ocamlinit" in
+  if Sys.file_exists ocamlinit then Some ocamlinit else
+  let getenv var = match Sys.getenv var with
+    | exception Not_found -> None | "" -> None | v -> Some v
+  in
+  let exists_in_dir dir file = match dir with
+    | None -> None
+    | Some dir ->
+        let file = Filename.concat dir file in
+        if Sys.file_exists file then Some file else None
+  in
+  let home_dir () = getenv "HOME" in
+  let config_dir () =
+    if Sys.win32 then None else
+    match getenv "XDG_CONFIG_HOME" with
+    | Some _ as v -> v
+    | None ->
+        match home_dir () with
+        | None -> None
+        | Some dir -> Some (Filename.concat dir ".config")
+  in
+  let init_ml = Filename.concat "ocaml" "init.ml" in
+  match exists_in_dir (config_dir ()) init_ml with
+  | Some _ as v -> v
+  | None -> exists_in_dir (home_dir ()) ocamlinit
+
+let load_ocamlinit ppf =
+  if !Clflags.noinit then ()
+  else match !Clflags.init_file with
+  | Some f -> if Sys.file_exists f then ignore (use_silently ppf f)
+              else fprintf ppf "Init file not found: \"%s\".@." f
+  | None ->
+      match find_ocamlinit () with
+      | None -> ()
+      | Some file -> ignore (use_silently ppf file)
+;;
+
+let set_paths () =
+  (* 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 current_load_path = Load_path.get_paths () in
+  let load_path = List.concat [
+      [ "" ];
+      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);
+      current_load_path;
+      [expand "+camlp4"];
+    ]
+  in
+  Load_path.init load_path
+
+let initialize_toplevel_env () =
+  toplevel_env := Compmisc.initial_env()
+
+(* The interactive loop *)
+
+exception PPerror
+
+let loop ppf =
+  Location.formatter_for_warnings := ppf;
+  if not !Clflags.noversion then
+    fprintf ppf "        OCaml version %s - native toplevel@.@." Config.version;
+  initialize_toplevel_env ();
+  let lb = Lexing.from_function refill_lexbuf in
+  Location.init lb "//toplevel//";
+  Location.input_name := "//toplevel//";
+  Location.input_lexbuf := Some lb;
+  Sys.catch_break true;
+  run_hooks After_setup;
+  load_ocamlinit ppf;
+  while true do
+    let snap = Btype.snapshot () in
+    try
+      Lexing.flush_input lb;
+      Location.reset();
+      first_line := true;
+      let phr = try !parse_toplevel_phrase lb with Exit -> raise PPerror in
+      let phr = preprocess_phrase ppf phr  in
+      Env.reset_cache_toplevel ();
+      if !Clflags.dump_parsetree then Printast.top_phrase ppf phr;
+      if !Clflags.dump_source then Pprintast.top_phrase ppf phr;
+      ignore(execute_phrase true ppf phr)
+    with
+    | End_of_file -> exit 0
+    | Sys.Break -> fprintf ppf "Interrupted.@."; Btype.backtrack snap
+    | PPerror -> ()
+    | x -> Location.report_exception ppf x; Btype.backtrack snap
+  done
+
+external caml_sys_modify_argv : string array -> unit =
+  "caml_sys_modify_argv"
+
+let override_sys_argv new_argv =
+  caml_sys_modify_argv new_argv;
+  Arg.current := 0
+
+(* Execute a script.  If [name] is "", read the script from stdin. *)
+
+let run_script ppf name args =
+  override_sys_argv args;
+  Compmisc.init_path ~dir:(Filename.dirname name) ();
+                   (* Note: would use [Filename.abspath] here, if we had it. *)
+  toplevel_env := Compmisc.initial_env();
+  Sys.interactive := false;
+  run_hooks After_setup;
+  let explicit_name =
+    (* Prevent use_silently from searching in the path. *)
+    if Filename.is_implicit name
+    then Filename.concat Filename.current_dir_name name
+    else name
+  in
+  use_silently ppf explicit_name
diff --git a/toplevel/opttoploop.mli b/toplevel/opttoploop.mli
new file mode 100644
index 00000000..8345ec29
--- /dev/null
+++ b/toplevel/opttoploop.mli
@@ -0,0 +1,153 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Format
+
+(* Set the load paths, before running anything *)
+
+val set_paths : unit -> unit
+
+(* The interactive toplevel loop *)
+
+val loop : formatter -> unit
+
+(* Read and execute a script from the given file *)
+
+val run_script : formatter -> string -> string array -> bool
+        (* true if successful, false if error *)
+
+(* Interface with toplevel directives *)
+
+type directive_fun =
+   | Directive_none of (unit -> unit)
+   | Directive_string of (string -> unit)
+   | Directive_int of (int -> unit)
+   | Directive_ident of (Longident.t -> unit)
+   | Directive_bool of (bool -> unit)
+
+val directive_table : (string, directive_fun) Hashtbl.t
+        (* Table of known directives, with their execution function *)
+val toplevel_env : Env.t ref
+        (* Typing environment for the toplevel *)
+val initialize_toplevel_env : unit -> unit
+        (* Initialize the typing environment for the toplevel *)
+val print_exception_outcome : formatter -> exn -> unit
+        (* Print an exception resulting from the evaluation of user code. *)
+val execute_phrase : bool -> formatter -> Parsetree.toplevel_phrase -> bool
+        (* Execute the given toplevel phrase. Return [true] if the
+           phrase executed with no errors and [false] otherwise.
+           First bool says whether the values and types of the results
+           should be printed. Uncaught exceptions are always printed. *)
+val preprocess_phrase :
+      formatter -> Parsetree.toplevel_phrase ->  Parsetree.toplevel_phrase
+        (* Preprocess the given toplevel phrase using regular and ppx
+           preprocessors. Return the updated phrase. *)
+val use_file : formatter -> string -> bool
+val use_output : formatter -> string -> bool
+val use_silently : formatter -> string -> bool
+val mod_use_file : formatter -> string -> bool
+        (* Read and execute commands from a file.
+           [use_file] prints the types and values of the results.
+           [use_silently] does not print them.
+           [mod_use_file] wrap the file contents into a module. *)
+val eval_module_path: Env.t -> Path.t -> Obj.t
+val eval_value_path: Env.t -> Path.t -> Obj.t
+val eval_extension_path: Env.t -> Path.t -> Obj.t
+val eval_class_path: Env.t -> Path.t -> Obj.t
+        (* Return the toplevel object referred to by the given path *)
+
+(* Printing of values *)
+
+val print_value: Env.t -> Obj.t -> formatter -> Types.type_expr -> unit
+val print_untyped_exception: formatter -> Obj.t -> unit
+
+type ('a, 'b) gen_printer =
+  | Zero of 'b
+  | Succ of ('a -> ('a, 'b) gen_printer)
+
+val install_printer :
+  Path.t -> Types.type_expr -> (formatter -> Obj.t -> unit) -> unit
+val install_generic_printer :
+  Path.t -> Path.t ->
+  (int -> (int -> Obj.t -> Outcometree.out_value,
+           Obj.t -> Outcometree.out_value) gen_printer) -> unit
+val install_generic_printer' :
+  Path.t -> Path.t -> (formatter -> Obj.t -> unit,
+                       formatter -> Obj.t -> unit) gen_printer -> unit
+val remove_printer : Path.t -> unit
+
+val max_printer_depth: int ref
+val max_printer_steps: int ref
+
+(* Hooks for external parsers and printers *)
+
+val parse_toplevel_phrase : (Lexing.lexbuf -> Parsetree.toplevel_phrase) ref
+val parse_use_file : (Lexing.lexbuf -> Parsetree.toplevel_phrase list) ref
+val print_location : formatter -> Location.t -> unit
+val print_error : formatter -> Location.error -> unit
+val print_warning : Location.t -> formatter -> Warnings.t -> unit
+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
+val print_out_phrase :
+  (formatter -> Outcometree.out_phrase -> unit) ref
+
+(* Hooks for external line editor *)
+
+val read_interactive_input : (string -> bytes -> int -> int * bool) ref
+
+(* Hooks *)
+
+val toplevel_startup_hook : (unit -> unit) ref
+
+type event = ..
+type event +=
+  | Startup
+  | After_setup
+  (* Just after the setup, when the toplevel is ready to evaluate user
+     input. This happens before the toplevel has evaluated any kind of
+     user input, in particular this happens before loading the
+     [.ocamlinit] file. *)
+
+val add_hook : (event -> unit) -> unit
+(* Add a function that will be called at key points of the toplevel
+   initialization process. *)
+
+val run_hooks : event -> unit
+(* Run all the registered hooks. *)
+
+
+(* Misc *)
+
+val override_sys_argv : string array -> unit
+(* [override_sys_argv args] replaces the contents of [Sys.argv] by [args]
+   and reset [Arg.current] to [0].
+
+   This is called by [run_script] so that [Sys.argv] represents
+   "script.ml args..." instead of the full command line:
+   "ocamlrun unix.cma ... script.ml args...". *)
diff --git a/toplevel/opttopmain.ml b/toplevel/opttopmain.ml
new file mode 100644
index 00000000..b0573173
--- /dev/null
+++ b/toplevel/opttopmain.ml
@@ -0,0 +1,116 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Clflags
+
+let usage =
+   "Usage: ocamlnat   [script-file]\noptions are:"
+
+let preload_objects = ref []
+
+(* Position of the first non expanded argument *)
+let first_nonexpanded_pos = ref 0
+
+let current = ref (!Arg.current)
+
+let argv = ref Sys.argv
+
+(* Test whether the option is part of a responsefile *)
+let is_expanded pos = pos < !first_nonexpanded_pos
+
+let expand_position pos len =
+  if pos < !first_nonexpanded_pos then
+    (* Shift the position *)
+    first_nonexpanded_pos := !first_nonexpanded_pos + len
+  else
+    (* New last position *)
+    first_nonexpanded_pos := pos + len + 2
+
+
+let prepare ppf =
+  Opttoploop.set_paths ();
+  try
+    let res =
+      List.for_all (Opttopdirs.load_file ppf) (List.rev !preload_objects)
+    in
+    Opttoploop.run_hooks Opttoploop.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 file_argument name =
+  let ppf = Format.err_formatter in
+  if Filename.check_suffix name ".cmxs"
+    || Filename.check_suffix name ".cmx"
+    || Filename.check_suffix name ".cmxa"
+  then preload_objects := name :: !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
+       than the original argv.
+    *)
+    Printf.eprintf "For implementation reasons, the toplevel does not support\
+    \ having script files (here %S) inside expanded arguments passed through\
+    \ the -args{,0} command-line option.\n" name;
+    exit 2
+  end else begin
+    let newargs = Array.sub !argv !Arg.current
+                              (Array.length !argv - !Arg.current)
+      in
+      Compmisc.read_clflags_from_env ();
+      if prepare ppf && Opttoploop.run_script ppf name newargs
+      then exit 0
+      else exit 2
+    end
+
+let wrap_expand f s =
+  let start = !current in
+  let arr = f s in
+  expand_position start (Array.length arr);
+  arr
+
+module Options = Main_args.Make_opttop_options (struct
+    include Main_args.Default.Opttopmain
+    let _stdin () = file_argument ""
+    let _args = wrap_expand Arg.read_arg
+    let _args0 = wrap_expand Arg.read_arg0
+    let anonymous s = file_argument s
+end);;
+
+let () =
+  let extra_paths =
+    match Sys.getenv "OCAMLTOP_INCLUDE_PATH" with
+    | exception Not_found -> []
+    | s -> Misc.split_path_contents s
+  in
+  Clflags.include_dirs := List.rev_append extra_paths !Clflags.include_dirs
+
+let main () =
+  native_code := true;
+  let list = ref Options.list in
+  begin
+    try
+      Arg.parse_and_expand_argv_dynamic current argv list file_argument usage;
+    with
+    | Arg.Bad msg -> Format.fprintf Format.err_formatter "%s%!" msg; exit 2
+    | Arg.Help msg -> Format.fprintf Format.std_formatter "%s%!" msg; exit 0
+  end;
+  Compmisc.read_clflags_from_env ();
+  if not (prepare Format.err_formatter) then exit 2;
+  Compmisc.init_path ();
+  Opttoploop.loop Format.std_formatter
diff --git a/toplevel/opttopmain.mli b/toplevel/opttopmain.mli
new file mode 100644
index 00000000..93fea4c7
--- /dev/null
+++ b/toplevel/opttopmain.mli
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Start the [ocaml] toplevel loop *)
+
+val main: unit -> unit
diff --git a/toplevel/opttopstart.ml b/toplevel/opttopstart.ml
new file mode 100644
index 00000000..a8127208
--- /dev/null
+++ b/toplevel/opttopstart.ml
@@ -0,0 +1,16 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let _ = Opttopmain.main()
diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml
new file mode 100644
index 00000000..530a927f
--- /dev/null
+++ b/toplevel/topdirs.ml
@@ -0,0 +1,847 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Toplevel directives *)
+
+open Format
+open Misc
+open Longident
+open Types
+open Cmo_format
+open Trace
+open Toploop
+
+(* The standard output formatter *)
+let std_out = std_formatter
+
+(* Directive sections (used in #help) *)
+let section_general = "General"
+let section_run = "Loading code"
+let section_env = "Environment queries"
+
+let section_print = "Pretty-printing"
+let section_trace = "Tracing"
+let section_options = "Compiler options"
+
+let section_undocumented = "Undocumented"
+
+(* we will print the sections in the first list,
+   then all user-defined sections,
+   then the sections in the second list,
+   then all undocumented directives *)
+let order_of_sections =
+  ([
+    section_general;
+    section_run;
+    section_env;
+  ], [
+    section_print;
+    section_trace;
+    section_options;
+
+    section_undocumented;
+  ])
+(* Do not forget to keep the directives synchronized with the manual in
+   manual/manual/cmds/top.etex *)
+
+(* To quit *)
+
+let dir_quit () = exit 0
+
+let _ = add_directive "quit" (Directive_none dir_quit)
+    {
+      section = section_general;
+      doc = "Exit the toplevel.";
+    }
+
+(* To add a directory to the load path *)
+
+let dir_directory s =
+  let d = expand_directory Config.standard_library s in
+  Dll.add_path [d];
+  let dir = Load_path.Dir.create d in
+  Load_path.add dir;
+  toplevel_env :=
+    Stdlib.String.Set.fold
+      (fun name env ->
+         Env.add_persistent_structure (Ident.create_persistent name) env)
+      (Env.persistent_structures_of_dir dir)
+      !toplevel_env
+
+let _ = add_directive "directory" (Directive_string dir_directory)
+    {
+      section = section_run;
+      doc = "Add the given directory to search path for source and compiled \
+             files.";
+    }
+
+(* To remove a directory from the load path *)
+let dir_remove_directory s =
+  let d = expand_directory Config.standard_library s in
+  let keep id =
+    match Load_path.find_uncap (Ident.name id ^ ".cmi") with
+    | exception Not_found -> true
+    | fn -> Filename.dirname fn <> d
+  in
+  toplevel_env := Env.filter_non_loaded_persistent keep !toplevel_env;
+  Load_path.remove_dir s;
+  Dll.remove_path [d]
+
+let _ = add_directive "remove_directory" (Directive_string dir_remove_directory)
+    {
+      section = section_run;
+      doc = "Remove the given directory from the search path.";
+    }
+(* To change the current directory *)
+
+let dir_cd s = Sys.chdir s
+
+let _ = add_directive "cd" (Directive_string dir_cd)
+    {
+      section = section_run;
+      doc = "Change the current working directory.";
+    }
+(* Load in-core a .cmo file *)
+
+exception Load_failed
+
+let check_consistency ppf filename cu =
+  try Env.import_crcs ~source:filename cu.cu_imports
+  with Persistent_env.Consistbl.Inconsistency {
+      unit_name = name;
+      inconsistent_source = user;
+      original_source = auth;
+    } ->
+    fprintf ppf "@[The files %s@ and %s@ \
+                 disagree over interface %s@]@."
+            user auth name;
+    raise Load_failed
+
+let load_compunit ic filename ppf compunit =
+  check_consistency ppf filename compunit;
+  seek_in ic compunit.cu_pos;
+  let code_size = compunit.cu_codesize + 8 in
+  let code = LongString.create code_size in
+  LongString.input_bytes_into code ic compunit.cu_codesize;
+  LongString.set code compunit.cu_codesize (Char.chr Opcodes.opRETURN);
+  LongString.blit_string "\000\000\000\001\000\000\000" 0
+                     code (compunit.cu_codesize + 1) 7;
+  let initial_symtable = Symtable.current_state() in
+  Symtable.patch_object code compunit.cu_reloc;
+  Symtable.update_global_table();
+  let events =
+    if compunit.cu_debug = 0 then [| |]
+    else begin
+      seek_in ic compunit.cu_debug;
+      [| input_value ic |]
+    end in
+  begin try
+    may_trace := true;
+    let _bytecode, closure = Meta.reify_bytecode code events None in
+    ignore (closure ());
+    may_trace := false;
+  with exn ->
+    record_backtrace ();
+    may_trace := false;
+    Symtable.restore_state initial_symtable;
+    print_exception_outcome ppf exn;
+    raise Load_failed
+  end
+
+let rec load_file recursive ppf name =
+  let filename =
+    try Some (Load_path.find name) with Not_found -> None
+  in
+  match filename with
+  | None -> fprintf ppf "Cannot find file %s.@." name; false
+  | Some filename ->
+      let ic = open_in_bin filename in
+      Misc.try_finally
+        ~always:(fun () -> close_in ic)
+        (fun () -> really_load_file recursive ppf name filename ic)
+
+and really_load_file recursive ppf name filename ic =
+  let buffer = really_input_string ic (String.length Config.cmo_magic_number) in
+  try
+    if buffer = Config.cmo_magic_number then begin
+      let compunit_pos = input_binary_int ic in  (* Go to descriptor *)
+      seek_in ic compunit_pos;
+      let cu : compilation_unit = input_value ic in
+      if recursive then
+        List.iter
+          (function
+            | (Reloc_getglobal id, _)
+              when not (Symtable.is_global_defined id) ->
+                let file = Ident.name id ^ ".cmo" in
+                begin match Load_path.find_uncap file with
+                | exception Not_found -> ()
+                | file ->
+                    if not (load_file recursive ppf file) then raise Load_failed
+                end
+            | _ -> ()
+          )
+          cu.cu_reloc;
+      load_compunit ic filename ppf cu;
+      true
+    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 : library) in
+        List.iter
+          (fun dllib ->
+            let name = Dll.extract_dll_name dllib in
+            try Dll.open_dlls Dll.For_execution [name]
+            with Failure reason ->
+              fprintf ppf
+                "Cannot load required shared library %s.@.Reason: %s.@."
+                name reason;
+              raise Load_failed)
+          lib.lib_dllibs;
+        List.iter (load_compunit ic filename ppf) lib.lib_units;
+        true
+      end else begin
+        fprintf ppf "File %s is not a bytecode object file.@." name;
+        false
+      end
+  with Load_failed -> false
+
+let dir_load ppf name = ignore (load_file false ppf name)
+
+let _ = add_directive "load" (Directive_string (dir_load std_out))
+    {
+      section = section_run;
+      doc = "Load in memory a bytecode object, produced by ocamlc.";
+    }
+
+let dir_load_rec ppf name = ignore (load_file true ppf name)
+
+let _ = add_directive "load_rec"
+    (Directive_string (dir_load_rec std_out))
+    {
+      section = section_run;
+      doc = "As #load, but loads dependencies recursively.";
+    }
+
+let load_file = load_file false
+
+(* Load commands from a file *)
+
+let dir_use ppf name = ignore(Toploop.use_file ppf name)
+let dir_use_output ppf name = ignore(Toploop.use_output ppf name)
+let dir_mod_use ppf name = ignore(Toploop.mod_use_file ppf name)
+
+let _ = add_directive "use" (Directive_string (dir_use std_out))
+    {
+      section = section_run;
+      doc = "Read, compile and execute source phrases from the given file.";
+    }
+
+let _ = add_directive "use_output" (Directive_string (dir_use_output std_out))
+    {
+      section = section_run;
+      doc = "Execute a command and read, compile and execute source phrases \
+             from its output.";
+    }
+
+let _ = add_directive "mod_use" (Directive_string (dir_mod_use std_out))
+    {
+      section = section_run;
+      doc = "Usage is identical to #use but #mod_use \
+             wraps the contents in a module.";
+    }
+
+(* Install, remove a printer *)
+
+let filter_arrow ty =
+  let ty = Ctype.expand_head !toplevel_env ty in
+  match ty.desc with
+  | Tarrow (lbl, l, r, _) when not (Btype.is_optional lbl) -> Some (l, r)
+  | _ -> None
+
+let rec extract_last_arrow desc =
+  match filter_arrow desc with
+  | None -> raise (Ctype.Unify [])
+  | Some (_, r as res) ->
+      try extract_last_arrow r
+      with Ctype.Unify _ -> res
+
+let extract_target_type ty = fst (extract_last_arrow ty)
+let extract_target_parameters ty =
+  let ty = extract_target_type ty |> Ctype.expand_head !toplevel_env in
+  match ty.desc with
+  | Tconstr (path, (_ :: _ as args), _)
+      when Ctype.all_distinct_vars !toplevel_env args -> Some (path, args)
+  | _ -> None
+
+type 'a printer_type_new = Format.formatter -> 'a -> unit
+type 'a printer_type_old = 'a -> unit
+
+let printer_type ppf typename =
+  let printer_type =
+    match
+      Env.find_type_by_name
+        (Ldot(Lident "Topdirs", typename)) !toplevel_env
+    with
+    | path, _ -> path
+    | exception Not_found ->
+        fprintf ppf "Cannot find type Topdirs.%s.@." typename;
+        raise Exit
+  in
+  printer_type
+
+let match_simple_printer_type desc printer_type =
+  Ctype.begin_def();
+  let ty_arg = Ctype.newvar() in
+  Ctype.unify !toplevel_env
+    (Ctype.newconstr printer_type [ty_arg])
+    (Ctype.instance desc.val_type);
+  Ctype.end_def();
+  Ctype.generalize ty_arg;
+  (ty_arg, None)
+
+let match_generic_printer_type desc path args printer_type =
+  Ctype.begin_def();
+  let args = List.map (fun _ -> Ctype.newvar ()) args in
+  let ty_target = Ctype.newty (Tconstr (path, args, ref Mnil)) in
+  let ty_args =
+    List.map (fun ty_var -> Ctype.newconstr printer_type [ty_var]) args in
+  let ty_expected =
+    List.fold_right
+      (fun ty_arg ty -> Ctype.newty (Tarrow (Asttypes.Nolabel, ty_arg, ty,
+                                             Cunknown)))
+      ty_args (Ctype.newconstr printer_type [ty_target]) in
+  Ctype.unify !toplevel_env
+    ty_expected
+    (Ctype.instance desc.val_type);
+  Ctype.end_def();
+  Ctype.generalize ty_expected;
+  if not (Ctype.all_distinct_vars !toplevel_env args) then
+    raise (Ctype.Unify []);
+  (ty_expected, Some (path, ty_args))
+
+let match_printer_type ppf desc =
+  let printer_type_new = printer_type ppf "printer_type_new" in
+  let printer_type_old = printer_type ppf "printer_type_old" in
+  try
+    (match_simple_printer_type desc printer_type_new, false)
+  with Ctype.Unify _ ->
+    try
+      (match_simple_printer_type desc printer_type_old, true)
+    with Ctype.Unify _ as exn ->
+      match extract_target_parameters desc.val_type with
+      | None -> raise exn
+      | Some (path, args) ->
+          (match_generic_printer_type desc path args printer_type_new,
+           false)
+
+let find_printer_type ppf lid =
+  match Env.find_value_by_name lid !toplevel_env with
+  | (path, desc) -> begin
+    match match_printer_type ppf desc with
+    | (ty_arg, is_old_style) -> (ty_arg, path, is_old_style)
+    | exception Ctype.Unify _ ->
+      fprintf ppf "%a has a wrong type for a printing function.@."
+      Printtyp.longident lid;
+      raise Exit
+  end
+  | exception Not_found ->
+      fprintf ppf "Unbound value %a.@." Printtyp.longident lid;
+      raise Exit
+
+let dir_install_printer ppf lid =
+  try
+    let ((ty_arg, ty), path, is_old_style) =
+      find_printer_type ppf lid in
+    let v = eval_value_path !toplevel_env path in
+    match ty with
+    | None ->
+       let print_function =
+         if is_old_style then
+           (fun _formatter repr -> Obj.obj v (Obj.obj repr))
+         else
+           (fun formatter repr -> Obj.obj v formatter (Obj.obj repr)) in
+       install_printer path ty_arg print_function
+    | Some (ty_path, ty_args) ->
+       let rec build v = function
+         | [] ->
+            let print_function =
+              if is_old_style then
+                (fun _formatter repr -> Obj.obj v (Obj.obj repr))
+              else
+                (fun formatter repr -> Obj.obj v formatter (Obj.obj repr)) in
+            Zero print_function
+         | _ :: args ->
+            Succ
+              (fun fn -> build ((Obj.obj v : _ -> Obj.t) fn) args) in
+       install_generic_printer' path ty_path (build v ty_args)
+  with Exit -> ()
+
+let dir_remove_printer ppf lid =
+  try
+    let (_ty_arg, path, _is_old_style) = find_printer_type ppf lid in
+    begin try
+      remove_printer path
+    with Not_found ->
+      fprintf ppf "No printer named %a.@." Printtyp.longident lid
+    end
+  with Exit -> ()
+
+let _ = add_directive "install_printer"
+    (Directive_ident (dir_install_printer std_out))
+    {
+      section = section_print;
+      doc = "Registers a printer for values of a certain type.";
+    }
+
+let _ = add_directive "remove_printer"
+    (Directive_ident (dir_remove_printer std_out))
+    {
+      section = section_print;
+      doc = "Remove the named function from the table of toplevel printers.";
+    }
+
+(* The trace *)
+
+external current_environment: unit -> Obj.t = "caml_get_current_environment"
+
+let tracing_function_ptr =
+  get_code_pointer
+    (Obj.repr (fun arg -> Trace.print_trace (current_environment()) arg))
+
+let dir_trace ppf lid =
+  match Env.find_value_by_name lid !toplevel_env with
+  | (path, desc) -> begin
+      (* Check if this is a primitive *)
+      match desc.val_kind with
+      | Val_prim _ ->
+          fprintf ppf "%a is an external function and cannot be traced.@."
+          Printtyp.longident lid
+      | _ ->
+          let clos = eval_value_path !toplevel_env path in
+          (* Nothing to do if it's not a closure *)
+          if Obj.is_block clos
+          && (Obj.tag clos = Obj.closure_tag || Obj.tag clos = Obj.infix_tag)
+          && (match Ctype.(repr (expand_head !toplevel_env desc.val_type))
+              with {desc=Tarrow _} -> true | _ -> false)
+          then begin
+          match is_traced clos with
+          | Some opath ->
+              fprintf ppf "%a is already traced (under the name %a).@."
+              Printtyp.path path
+              Printtyp.path opath
+          | None ->
+              (* Instrument the old closure *)
+              traced_functions :=
+                { path = path;
+                  closure = clos;
+                  actual_code = get_code_pointer clos;
+                  instrumented_fun =
+                    instrument_closure !toplevel_env lid ppf desc.val_type }
+                :: !traced_functions;
+              (* Redirect the code field of the closure to point
+                 to the instrumentation function *)
+              set_code_pointer clos tracing_function_ptr;
+              fprintf ppf "%a is now traced.@." Printtyp.longident lid
+          end else fprintf ppf "%a is not a function.@." Printtyp.longident lid
+    end
+  | exception Not_found ->
+      fprintf ppf "Unbound value %a.@." Printtyp.longident lid
+
+let dir_untrace ppf lid =
+  match Env.find_value_by_name lid !toplevel_env with
+  | (path, _desc) ->
+      let rec remove = function
+      | [] ->
+          fprintf ppf "%a was not traced.@." Printtyp.longident lid;
+          []
+      | f :: rem ->
+          if Path.same f.path path then begin
+            set_code_pointer f.closure f.actual_code;
+            fprintf ppf "%a is no longer traced.@." Printtyp.longident lid;
+            rem
+          end else f :: remove rem in
+      traced_functions := remove !traced_functions
+  | exception Not_found ->
+      fprintf ppf "Unbound value %a.@." Printtyp.longident lid
+
+let dir_untrace_all ppf () =
+  List.iter
+    (fun f ->
+      set_code_pointer f.closure f.actual_code;
+      fprintf ppf "%a is no longer traced.@." Printtyp.path f.path)
+    !traced_functions;
+  traced_functions := []
+
+let parse_warnings ppf iserr s =
+  try Warnings.parse_options iserr s
+  with Arg.Bad err -> fprintf ppf "%s.@." err
+
+(* Typing information *)
+
+let trim_signature = function
+    Mty_signature sg ->
+      Mty_signature
+        (List.map
+           (function
+               Sig_module (id, pres, md, rs, priv) ->
+                 let attribute =
+                   Ast_helper.Attr.mk
+                     (Location.mknoloc "...")
+                     (Parsetree.PStr [])
+                 in
+                 Sig_module (id, pres, {md with md_attributes =
+                                          attribute :: md.md_attributes},
+                             rs, priv)
+             (*| Sig_modtype (id, Modtype_manifest mty) ->
+                 Sig_modtype (id, Modtype_manifest (trim_modtype mty))*)
+             | item -> item)
+           sg)
+  | mty -> mty
+
+let show_prim to_sig ppf lid =
+  let env = !Toploop.toplevel_env in
+  let loc = Location.none in
+  try
+    let s =
+      match lid with
+      | Longident.Lident s -> s
+      | Longident.Ldot (_,s) -> s
+      | Longident.Lapply _ ->
+          fprintf ppf "Invalid path %a@." Printtyp.longident lid;
+          raise Exit
+    in
+    let id = Ident.create_persistent s in
+    let sg = to_sig env loc id lid in
+    Printtyp.wrap_printing_env ~error:false env
+      (fun () -> fprintf ppf "@[%a@]@." Printtyp.signature sg)
+  with
+  | Not_found ->
+      fprintf ppf "@[Unknown element.@]@."
+  | Exit -> ()
+
+let all_show_funs = ref []
+
+let reg_show_prim name to_sig doc =
+  all_show_funs := to_sig :: !all_show_funs;
+  add_directive
+    name
+    (Directive_ident (show_prim to_sig std_out))
+    {
+      section = section_env;
+      doc;
+    }
+
+let () =
+  reg_show_prim "show_val"
+    (fun env loc id lid ->
+       let _path, desc = Env.lookup_value ~loc lid env in
+       [ Sig_value (id, desc, Exported) ]
+    )
+    "Print the signature of the corresponding value."
+
+let () =
+  reg_show_prim "show_type"
+    (fun env loc id lid ->
+       let _path, desc = Env.lookup_type ~loc lid env in
+       [ Sig_type (id, desc, Trec_not, Exported) ]
+    )
+    "Print the signature of the corresponding type constructor."
+
+(* Each registered show_prim function is called in turn
+ * and any output produced is sent to std_out.
+ * Two show_prim functions are needed for constructors,
+ * one for exception constructors and another for
+ * non-exception constructors (normal and extensible variants). *)
+let is_exception_constructor env type_expr =
+  Ctype.equal env true [type_expr] [Predef.type_exn]
+
+let is_extension_constructor = function
+  | Cstr_extension _ -> true
+  | _ -> false
+
+let () =
+  (* This show_prim function will only show constructor types
+   * that are not also exception types. *)
+  reg_show_prim "show_constructor"
+    (fun env loc id lid ->
+       let desc = Env.lookup_constructor ~loc Env.Positive lid env in
+       if is_exception_constructor env desc.cstr_res then
+         raise Not_found;
+       let path =
+         match Ctype.repr desc.cstr_res with
+         | {desc=Tconstr(path, _, _)} -> path
+         | _ -> raise Not_found
+       in
+       let type_decl = Env.find_type path env in
+       if is_extension_constructor desc.cstr_tag then
+         let ret_type =
+           if desc.cstr_generalized then Some desc.cstr_res
+           else None
+         in
+         let ext =
+           { ext_type_path = path;
+             ext_type_params = type_decl.type_params;
+             ext_args = Cstr_tuple desc.cstr_args;
+             ext_ret_type = ret_type;
+             ext_private = Asttypes.Public;
+             ext_loc = desc.cstr_loc;
+             ext_attributes = desc.cstr_attributes;
+             ext_uid = desc.cstr_uid; }
+           in
+             [Sig_typext (id, ext, Text_first, Exported)]
+       else
+         (* make up a fake Ident.t as type_decl : Types.type_declaration
+          * does not have an Ident.t yet. Ident.create_presistent is a
+          * good choice because it has no side-effects.
+          * *)
+         let type_id = Ident.create_persistent (Path.name path) in
+         [ Sig_type (type_id, type_decl, Trec_first, Exported) ]
+    )
+    "Print the signature of the corresponding value constructor."
+
+let () =
+  reg_show_prim "show_exception"
+    (fun env loc id lid ->
+       let desc = Env.lookup_constructor ~loc Env.Positive lid env in
+       if not (is_exception_constructor env desc.cstr_res) then
+         raise Not_found;
+       let ret_type =
+         if desc.cstr_generalized then Some Predef.type_exn
+         else None
+       in
+       let ext =
+         { ext_type_path = Predef.path_exn;
+           ext_type_params = [];
+           ext_args = Cstr_tuple desc.cstr_args;
+           ext_ret_type = ret_type;
+           ext_private = Asttypes.Public;
+           ext_loc = desc.cstr_loc;
+           ext_attributes = desc.cstr_attributes;
+           ext_uid = desc.cstr_uid;
+         }
+       in
+         [Sig_typext (id, ext, Text_exception, Exported)]
+    )
+    "Print the signature of the corresponding exception."
+
+let () =
+  reg_show_prim "show_module"
+    (fun env loc id lid ->
+       let rec accum_aliases md acc =
+         let acc =
+           Sig_module (id, Mp_present,
+                       {md with md_type = trim_signature md.md_type},
+                       Trec_not, Exported) :: acc in
+         match md.md_type with
+         | Mty_alias path ->
+             let md = Env.find_module path env in
+             accum_aliases md acc
+         | Mty_ident _ | Mty_signature _ | Mty_functor _ ->
+             List.rev acc
+       in
+       let _, md = Env.lookup_module ~loc lid env in
+       accum_aliases md []
+    )
+    "Print the signature of the corresponding module."
+
+let () =
+  reg_show_prim "show_module_type"
+    (fun env loc id lid ->
+       let _path, desc = Env.lookup_modtype ~loc lid env in
+       [ Sig_modtype (id, desc, Exported) ]
+    )
+    "Print the signature of the corresponding module type."
+
+let () =
+  reg_show_prim "show_class"
+    (fun env loc id lid ->
+       let _path, desc = Env.lookup_class ~loc lid env in
+       [ Sig_class (id, desc, Trec_not, Exported) ]
+    )
+    "Print the signature of the corresponding class."
+
+let () =
+  reg_show_prim "show_class_type"
+    (fun env loc id lid ->
+       let _path, desc = Env.lookup_cltype ~loc lid env in
+       [ Sig_class_type (id, desc, Trec_not, Exported) ]
+    )
+    "Print the signature of the corresponding class type."
+
+let show env loc id lid =
+  let sg =
+    List.fold_left
+      (fun sg f -> try (f env loc id lid) @ sg with _ -> sg)
+      [] !all_show_funs
+  in
+  if sg = [] then raise Not_found else sg
+
+let () =
+  add_directive "show" (Directive_ident (show_prim show std_out))
+    {
+      section = section_env;
+      doc = "Print the signatures of components \
+             from any of the categories below.";
+    }
+
+let _ = add_directive "trace"
+    (Directive_ident (dir_trace std_out))
+    {
+      section = section_trace;
+      doc = "All calls to the function \
+          named function-name will be traced.";
+    }
+
+let _ = add_directive "untrace"
+    (Directive_ident (dir_untrace std_out))
+    {
+      section = section_trace;
+      doc = "Stop tracing the given function.";
+    }
+
+let _ = add_directive "untrace_all"
+    (Directive_none (dir_untrace_all std_out))
+    {
+      section = section_trace;
+      doc = "Stop tracing all functions traced so far.";
+    }
+
+(* Control the printing of values *)
+
+let _ = add_directive "print_depth"
+    (Directive_int(fun n -> max_printer_depth := n))
+    {
+      section = section_print;
+      doc = "Limit the printing of values to a maximal depth of n.";
+    }
+
+let _ = add_directive "print_length"
+    (Directive_int(fun n -> max_printer_steps := n))
+    {
+      section = section_print;
+      doc = "Limit the number of value nodes printed to at most n.";
+    }
+
+(* Set various compiler flags *)
+
+let _ = add_directive "labels"
+    (Directive_bool(fun b -> Clflags.classic := not b))
+    {
+      section = section_options;
+      doc = "Choose whether to ignore labels in function types.";
+    }
+
+let _ = add_directive "principal"
+    (Directive_bool(fun b -> Clflags.principal := b))
+    {
+      section = section_options;
+      doc = "Make sure that all types are derived in a principal way.";
+    }
+
+let _ = add_directive "rectypes"
+    (Directive_none(fun () -> Clflags.recursive_types := true))
+    {
+      section = section_options;
+      doc = "Allow arbitrary recursive types during type-checking.";
+    }
+
+let _ = add_directive "ppx"
+    (Directive_string(fun s -> Clflags.all_ppx := s :: !Clflags.all_ppx))
+    {
+      section = section_options;
+      doc = "After parsing, pipe the abstract \
+          syntax tree through the preprocessor command.";
+    }
+
+let _ = add_directive "warnings"
+    (Directive_string (parse_warnings std_out false))
+    {
+      section = section_options;
+      doc = "Enable or disable warnings according to the argument.";
+    }
+
+let _ = add_directive "warn_error"
+    (Directive_string (parse_warnings std_out true))
+    {
+      section = section_options;
+      doc = "Treat as errors the warnings enabled by the argument.";
+    }
+
+(* #help directive *)
+
+let directive_sections () =
+  let sections = Hashtbl.create 10 in
+  let add_dir name dir =
+    let section, doc =
+      match Hashtbl.find directive_info_table name with
+      | { section; doc } -> section, Some doc
+      | exception Not_found -> "Undocumented", None
+    in
+    Hashtbl.replace sections section
+      ((name, dir, doc)
+       :: (try Hashtbl.find sections section with Not_found -> []))
+  in
+  Hashtbl.iter add_dir directive_table;
+  let take_section section =
+    if not (Hashtbl.mem sections section) then (section, [])
+    else begin
+      let section_dirs =
+        Hashtbl.find sections section
+        |> List.sort (fun (n1, _, _) (n2, _, _) -> String.compare n1 n2) in
+      Hashtbl.remove sections section;
+      (section, section_dirs)
+    end
+  in
+  let before, after = order_of_sections in
+  let sections_before = List.map take_section before in
+  let sections_after = List.map take_section after in
+  let sections_user =
+    Hashtbl.fold (fun section _ acc -> section::acc) sections []
+    |> List.sort String.compare
+    |> List.map take_section in
+  sections_before @ sections_user @ sections_after
+
+let print_directive ppf (name, directive, doc) =
+  let param = match directive with
+    | Directive_none _ -> ""
+    | Directive_string _ -> " "
+    | Directive_int _ -> " "
+    | Directive_bool _ -> " "
+    | Directive_ident _ -> " " in
+  match doc with
+  | None -> fprintf ppf "#%s%s@." name param
+  | Some doc ->
+      fprintf ppf "@[#%s%s@\n%a@]@."
+        name param
+        Format.pp_print_text doc
+
+let print_section ppf (section, directives) =
+  if directives <> [] then begin
+    fprintf ppf "%30s%s@." "" section;
+    List.iter (print_directive ppf) directives;
+    fprintf ppf "@.";
+  end
+
+let print_directives ppf () =
+  List.iter (print_section ppf) (directive_sections ())
+
+let _ = add_directive "help"
+    (Directive_none (print_directives std_out))
+    {
+      section = section_general;
+      doc = "Prints a list of all available directives, with \
+          corresponding argument type if appropriate.";
+    }
diff --git a/toplevel/topdirs.mli b/toplevel/topdirs.mli
new file mode 100644
index 00000000..77d36600
--- /dev/null
+++ b/toplevel/topdirs.mli
@@ -0,0 +1,37 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The toplevel directives. *)
+
+open Format
+
+val dir_quit : unit -> unit
+val dir_directory : string -> unit
+val dir_remove_directory : string -> unit
+val dir_cd : string -> unit
+val dir_load : formatter -> string -> unit
+val dir_use : formatter -> string -> unit
+val dir_use_output : formatter -> string -> unit
+val dir_install_printer : formatter -> Longident.t -> unit
+val dir_remove_printer : formatter -> Longident.t -> unit
+val dir_trace : formatter -> Longident.t -> unit
+val dir_untrace : formatter -> Longident.t -> unit
+val dir_untrace_all : formatter -> unit -> unit
+
+type 'a printer_type_new = Format.formatter -> 'a -> unit
+type 'a printer_type_old = 'a -> unit
+
+(* For topmain.ml. Maybe shouldn't be there *)
+val load_file : formatter -> string -> bool
diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml
new file mode 100644
index 00000000..f2b3845a
--- /dev/null
+++ b/toplevel/toploop.ml
@@ -0,0 +1,649 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The interactive toplevel loop *)
+
+open Format
+open Misc
+open Parsetree
+open Types
+open Typedtree
+open Outcometree
+open Ast_helper
+module String = Misc.Stdlib.String
+
+type directive_fun =
+   | Directive_none of (unit -> unit)
+   | Directive_string of (string -> unit)
+   | Directive_int of (int -> unit)
+   | Directive_ident of (Longident.t -> unit)
+   | Directive_bool of (bool -> unit)
+
+type directive_info = {
+  section: string;
+  doc: string;
+}
+
+(* Phase buffer that stores the last toplevel phrase (see
+   [Location.input_phrase_buffer]). *)
+let phrase_buffer = Buffer.create 1024
+
+(* The table of toplevel value bindings and its accessors *)
+
+let toplevel_value_bindings : Obj.t String.Map.t ref = ref String.Map.empty
+
+let getvalue name =
+  try
+    String.Map.find name !toplevel_value_bindings
+  with Not_found ->
+    fatal_error (name ^ " unbound at toplevel")
+
+let setvalue name v =
+  toplevel_value_bindings := String.Map.add name v !toplevel_value_bindings
+
+(* Return the value referred to by a path *)
+
+let rec eval_address = function
+  | Env.Aident id ->
+      if Ident.persistent id || Ident.global id then
+        Symtable.get_global_value id
+      else begin
+        let name = Translmod.toplevel_name id in
+        try
+          String.Map.find name !toplevel_value_bindings
+        with Not_found ->
+          raise (Symtable.Error(Symtable.Undefined_global name))
+      end
+  | Env.Adot(p, pos) ->
+      Obj.field (eval_address p) pos
+
+let eval_path find env path =
+  match find path env with
+  | addr -> eval_address addr
+  | exception Not_found ->
+      fatal_error ("Cannot find address for: " ^ (Path.name path))
+
+let eval_module_path env path =
+  eval_path Env.find_module_address env path
+
+let eval_value_path env path =
+  eval_path Env.find_value_address env path
+
+let eval_extension_path env path =
+  eval_path Env.find_constructor_address env path
+
+let eval_class_path env path =
+  eval_path Env.find_class_address env path
+
+(* To print values *)
+
+module EvalPath = struct
+  type valu = Obj.t
+  exception Error
+  let eval_address addr =
+    try eval_address addr with Symtable.Error _ -> raise Error
+  let same_value v1 v2 = (v1 == v2)
+end
+
+module Printer = Genprintval.Make(Obj)(EvalPath)
+
+let max_printer_depth = ref 100
+let max_printer_steps = ref 300
+
+let print_out_value = Oprint.out_value
+let print_out_type = Oprint.out_type
+let print_out_class_type = Oprint.out_class_type
+let print_out_module_type = Oprint.out_module_type
+let print_out_type_extension = Oprint.out_type_extension
+let print_out_sig_item = Oprint.out_sig_item
+let print_out_signature = Oprint.out_signature
+let print_out_phrase = Oprint.out_phrase
+
+let print_untyped_exception ppf obj =
+  !print_out_value ppf (Printer.outval_of_untyped_exception obj)
+let outval_of_value env obj ty =
+  Printer.outval_of_value !max_printer_steps !max_printer_depth
+    (fun _ _ _ -> None) env obj ty
+let print_value env obj ppf ty =
+  !print_out_value ppf (outval_of_value env obj ty)
+
+type ('a, 'b) gen_printer = ('a, 'b) Genprintval.gen_printer =
+  | Zero of 'b
+  | Succ of ('a -> ('a, 'b) gen_printer)
+
+let install_printer = Printer.install_printer
+let install_generic_printer = Printer.install_generic_printer
+let install_generic_printer' = Printer.install_generic_printer'
+let remove_printer = Printer.remove_printer
+
+(* Hooks for parsing functions *)
+
+let parse_toplevel_phrase = ref Parse.toplevel_phrase
+let parse_use_file = ref Parse.use_file
+let print_location = Location.print_loc
+let print_error = Location.print_report
+let print_warning = Location.print_warning
+let input_name = Location.input_name
+
+let parse_mod_use_file name lb =
+  let modname =
+    String.capitalize_ascii
+      (Filename.remove_extension (Filename.basename name))
+  in
+  let items =
+    List.concat
+      (List.map
+         (function Ptop_def s -> s | Ptop_dir _ -> [])
+         (!parse_use_file lb))
+  in
+  [ Ptop_def
+      [ Str.module_
+          (Mb.mk
+             (Location.mknoloc (Some modname))
+             (Mod.structure items)
+          )
+       ]
+   ]
+
+(* Hook for initialization *)
+
+let toplevel_startup_hook = ref (fun () -> ())
+
+type event = ..
+type event +=
+  | Startup
+  | After_setup
+
+let hooks = ref []
+
+let add_hook f = hooks := f :: !hooks
+
+let () =
+  add_hook (function
+      | Startup -> !toplevel_startup_hook ()
+      | _ -> ())
+
+let run_hooks hook = List.iter (fun f -> f hook) !hooks
+
+(* Load in-core and execute a lambda term *)
+
+let may_trace = ref false (* Global lock on tracing *)
+type evaluation_outcome = Result of Obj.t | Exception of exn
+
+let backtrace = ref None
+
+let record_backtrace () =
+  if Printexc.backtrace_status ()
+  then backtrace := Some (Printexc.get_backtrace ())
+
+let load_lambda ppf lam =
+  if !Clflags.dump_rawlambda then fprintf ppf "%a@." Printlambda.lambda lam;
+  let slam = Simplif.simplify_lambda lam in
+  if !Clflags.dump_lambda then fprintf ppf "%a@." Printlambda.lambda slam;
+  let (init_code, fun_code) = Bytegen.compile_phrase slam in
+  if !Clflags.dump_instr then
+    fprintf ppf "%a%a@."
+    Printinstr.instrlist init_code
+    Printinstr.instrlist fun_code;
+  let (code, reloc, events) =
+    Emitcode.to_memory init_code fun_code
+  in
+  let can_free = (fun_code = []) in
+  let initial_symtable = Symtable.current_state() in
+  Symtable.patch_object code reloc;
+  Symtable.check_global_initialized reloc;
+  Symtable.update_global_table();
+  let initial_bindings = !toplevel_value_bindings in
+  let bytecode, closure = Meta.reify_bytecode code [| events |] None in
+  try
+    may_trace := true;
+    let retval = closure () in
+    may_trace := false;
+    if can_free then Meta.release_bytecode bytecode;
+    Result retval
+  with x ->
+    may_trace := false;
+    if can_free then Meta.release_bytecode bytecode;
+    record_backtrace ();
+    toplevel_value_bindings := initial_bindings; (* PR#6211 *)
+    Symtable.restore_state initial_symtable;
+    Exception x
+
+(* Print the outcome of an evaluation *)
+
+let pr_item =
+  Printtyp.print_items
+    (fun env -> function
+      | Sig_value(id, {val_kind = Val_reg; val_type}, _) ->
+          Some (outval_of_value env (getvalue (Translmod.toplevel_name id))
+                  val_type)
+      | _ -> None
+    )
+
+(* The current typing environment for the toplevel *)
+
+let toplevel_env = ref Env.empty
+
+(* Print an exception produced by an evaluation *)
+
+let print_out_exception ppf exn outv =
+  !print_out_phrase ppf (Ophr_exception (exn, outv))
+
+let print_exception_outcome ppf exn =
+  if exn = Out_of_memory then Gc.full_major ();
+  let outv = outval_of_value !toplevel_env (Obj.repr exn) Predef.type_exn in
+  print_out_exception ppf exn outv;
+  if Printexc.backtrace_status ()
+  then
+    match !backtrace with
+      | None -> ()
+      | Some b ->
+          print_string b;
+          backtrace := None
+
+
+(* Inserting new toplevel directives *)
+
+let directive_table = (Hashtbl.create 23 : (string, directive_fun) Hashtbl.t)
+
+let directive_info_table =
+  (Hashtbl.create 23 : (string, directive_info) Hashtbl.t)
+
+let add_directive name dir_fun dir_info =
+  Hashtbl.add directive_table name dir_fun;
+  Hashtbl.add directive_info_table name dir_info
+
+(* Execute a toplevel phrase *)
+
+let execute_phrase print_outcome ppf phr =
+  match phr with
+  | Ptop_def sstr ->
+      let oldenv = !toplevel_env in
+      Typecore.reset_delayed_checks ();
+      let (str, sg, sn, newenv) = Typemod.type_toplevel_phrase oldenv sstr 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');
+      Typecore.force_delayed_checks ();
+      let lam = Translmod.transl_toplevel_definition str in
+      Warnings.check_fatal ();
+      begin try
+        toplevel_env := newenv;
+        let res = load_lambda ppf lam in
+        let out_phr =
+          match res with
+          | Result v ->
+              if print_outcome then
+                Printtyp.wrap_printing_env ~error:false oldenv (fun () ->
+                  match str.str_items with
+                  | [ { str_desc =
+                          (Tstr_eval (exp, _)
+                          |Tstr_value
+                              (Asttypes.Nonrecursive,
+                               [{vb_pat = {pat_desc=Tpat_any};
+                                 vb_expr = exp}
+                               ]
+                              )
+                          )
+                      }
+                    ] ->
+                      let outv = outval_of_value newenv v exp.exp_type in
+                      let ty = Printtyp.tree_of_type_scheme exp.exp_type in
+                      Ophr_eval (outv, ty)
+
+                  | [] -> Ophr_signature []
+                  | _ -> Ophr_signature (pr_item oldenv sg'))
+              else Ophr_signature []
+          | Exception exn ->
+              toplevel_env := oldenv;
+              if exn = Out_of_memory then Gc.full_major();
+              let outv =
+                outval_of_value !toplevel_env (Obj.repr exn) Predef.type_exn
+              in
+              Ophr_exception (exn, outv)
+        in
+        !print_out_phrase ppf out_phr;
+        if Printexc.backtrace_status ()
+        then begin
+          match !backtrace with
+            | None -> ()
+            | Some b ->
+                pp_print_string ppf b;
+                pp_print_flush ppf ();
+                backtrace := None;
+        end;
+        begin match out_phr with
+        | Ophr_eval (_, _) | Ophr_signature _ -> true
+        | Ophr_exception _ -> false
+        end
+      with x ->
+        toplevel_env := oldenv; raise x
+      end
+  | Ptop_dir {pdir_name = {Location.txt = dir_name}; pdir_arg } ->
+      let d =
+        try Some (Hashtbl.find directive_table dir_name)
+        with Not_found -> None
+      in
+      begin match d with
+      | None ->
+          fprintf ppf "Unknown directive `%s'." dir_name;
+          let directives =
+            Hashtbl.fold (fun dir _ acc -> dir::acc) directive_table [] in
+          Misc.did_you_mean ppf
+            (fun () -> Misc.spellcheck directives dir_name);
+          fprintf ppf "@.";
+          false
+      | Some d ->
+          match d, pdir_arg with
+          | Directive_none f, None -> f (); true
+          | Directive_string f, Some {pdira_desc = Pdir_string s} -> f s; true
+          | Directive_int f, Some {pdira_desc = Pdir_int (n,None) } ->
+             begin match Int_literal_converter.int n with
+             | n -> f n; true
+             | exception _ ->
+               fprintf ppf "Integer literal exceeds the range of \
+                            representable integers for directive `%s'.@."
+                       dir_name;
+               false
+             end
+          | Directive_int _, Some {pdira_desc = Pdir_int (_, Some _)} ->
+              fprintf ppf "Wrong integer literal for directive `%s'.@."
+                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
+          | _ ->
+              fprintf ppf "Wrong type of argument for directive `%s'.@."
+                dir_name;
+              false
+      end
+
+let execute_phrase print_outcome ppf phr =
+  try execute_phrase print_outcome ppf phr
+  with exn ->
+    Warnings.reset_fatal ();
+    raise exn
+
+(* Read and execute commands from a file, or from stdin if [name] is "". *)
+
+let use_print_results = ref true
+
+let preprocess_phrase ppf phr =
+  let phr =
+    match phr with
+    | Ptop_def str ->
+        let str =
+          Pparse.apply_rewriters_str ~restore:true ~tool_name:"ocaml" str
+        in
+        Ptop_def str
+    | phr -> phr
+  in
+  if !Clflags.dump_parsetree then Printast.top_phrase ppf phr;
+  if !Clflags.dump_source then Pprintast.top_phrase ppf phr;
+  phr
+
+let use_channel ppf ~wrap_in_module ic name filename =
+  let lb = Lexing.from_channel ic in
+  Warnings.reset_fatal ();
+  Location.init lb filename;
+  (* Skip initial #! line if any *)
+  Lexer.skip_hash_bang lb;
+  protect_refs [ R (Location.input_name, filename);
+                 R (Location.input_lexbuf, Some lb); ]
+    (fun () ->
+    try
+      List.iter
+        (fun ph ->
+          let ph = preprocess_phrase ppf ph in
+          if not (execute_phrase !use_print_results ppf ph) then raise Exit)
+        (if wrap_in_module then
+           parse_mod_use_file name lb
+         else
+           !parse_use_file lb);
+      true
+    with
+    | Exit -> false
+    | Sys.Break -> fprintf ppf "Interrupted.@."; false
+    | x -> Location.report_exception ppf x; false)
+
+let use_output ppf command =
+  let fn = Filename.temp_file "ocaml" "_toploop.ml" in
+  Misc.try_finally ~always:(fun () ->
+      try Sys.remove fn with Sys_error _ -> ())
+    (fun () ->
+       match
+         Printf.ksprintf Sys.command "%s > %s"
+           command
+           (Filename.quote fn)
+       with
+       | 0 ->
+         let ic = open_in_bin fn in
+         Misc.try_finally ~always:(fun () -> close_in ic)
+           (fun () ->
+              use_channel ppf ~wrap_in_module:false ic "" "(command-output)")
+       | n ->
+         fprintf ppf "Command exited with code %d.@." n;
+         false)
+
+let use_file ppf ~wrap_in_module name =
+  match name with
+  | "" ->
+    use_channel ppf ~wrap_in_module stdin name "(stdin)"
+  | _ ->
+    match Load_path.find name with
+    | filename ->
+      let ic = open_in_bin filename in
+      Misc.try_finally ~always:(fun () -> close_in ic)
+        (fun () -> use_channel ppf ~wrap_in_module ic name filename)
+    | exception Not_found ->
+      fprintf ppf "Cannot find file %s.@." name;
+      false
+
+let mod_use_file ppf name =
+  use_file ppf ~wrap_in_module:true name
+let use_file ppf name =
+  use_file ppf ~wrap_in_module:false name
+
+let use_silently ppf name =
+  protect_refs [ R (use_print_results, false) ] (fun () -> use_file ppf name)
+
+(* Reading function for interactive use *)
+
+let first_line = ref true
+let got_eof = ref false;;
+
+let read_input_default prompt buffer len =
+  output_string stdout prompt; flush stdout;
+  let i = ref 0 in
+  try
+    while true do
+      if !i >= len then raise Exit;
+      let c = input_char stdin in
+      Bytes.set buffer !i c;
+      (* Also populate the phrase buffer as new characters are added. *)
+      Buffer.add_char phrase_buffer c;
+      incr i;
+      if c = '\n' then raise Exit;
+    done;
+    (!i, false)
+  with
+  | End_of_file ->
+      (!i, true)
+  | Exit ->
+      (!i, false)
+
+let read_interactive_input = ref read_input_default
+
+let refill_lexbuf buffer len =
+  if !got_eof then (got_eof := false; 0) else begin
+    let prompt =
+      if !Clflags.noprompt then ""
+      else if !first_line then "# "
+      else if !Clflags.nopromptcont then ""
+      else if Lexer.in_comment () then "* "
+      else "  "
+    in
+    first_line := false;
+    let (len, eof) = !read_interactive_input prompt buffer len in
+    if eof then begin
+      Location.echo_eof ();
+      if len > 0 then got_eof := true;
+      len
+    end else
+      len
+  end
+
+(* Toplevel initialization. Performed here instead of at the
+   beginning of loop() so that user code linked in with ocamlmktop
+   can call directives from Topdirs. *)
+
+let _ =
+  if !Sys.interactive then (* PR#6108 *)
+    invalid_arg "The ocamltoplevel.cma library from compiler-libs \
+                 cannot be loaded inside the OCaml toplevel";
+  Sys.interactive := true;
+  let crc_intfs = Symtable.init_toplevel() in
+  Compmisc.init_path ();
+  Env.import_crcs ~source:Sys.executable_name crc_intfs;
+  ()
+
+let find_ocamlinit () =
+  let ocamlinit = ".ocamlinit" in
+  if Sys.file_exists ocamlinit then Some ocamlinit else
+  let getenv var = match Sys.getenv var with
+    | exception Not_found -> None | "" -> None | v -> Some v
+  in
+  let exists_in_dir dir file = match dir with
+    | None -> None
+    | Some dir ->
+        let file = Filename.concat dir file in
+        if Sys.file_exists file then Some file else None
+  in
+  let home_dir () = getenv "HOME" in
+  let config_dir () =
+    if Sys.win32 then None else
+    match getenv "XDG_CONFIG_HOME" with
+    | Some _ as v -> v
+    | None ->
+        match home_dir () with
+        | None -> None
+        | Some dir -> Some (Filename.concat dir ".config")
+  in
+  let init_ml = Filename.concat "ocaml" "init.ml" in
+  match exists_in_dir (config_dir ()) init_ml with
+  | Some _ as v -> v
+  | None -> exists_in_dir (home_dir ()) ocamlinit
+
+let load_ocamlinit ppf =
+  if !Clflags.noinit then ()
+  else match !Clflags.init_file with
+  | Some f -> if Sys.file_exists f then ignore (use_silently ppf f)
+              else fprintf ppf "Init file not found: \"%s\".@." f
+  | None ->
+      match find_ocamlinit () with
+      | None -> ()
+      | Some file -> ignore (use_silently ppf file)
+;;
+
+let set_paths () =
+  (* 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 current_load_path = Load_path.get_paths () in
+  let load_path = List.concat [
+      [ "" ];
+      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);
+      current_load_path;
+      [expand "+camlp4"];
+    ]
+  in
+  Load_path.init load_path;
+  Dll.add_path load_path
+
+let initialize_toplevel_env () =
+  toplevel_env := Compmisc.initial_env()
+
+(* The interactive loop *)
+
+exception PPerror
+
+let loop ppf =
+  Clflags.debug := true;
+  Location.formatter_for_warnings := ppf;
+  if not !Clflags.noversion then
+    fprintf ppf "        OCaml version %s@.@." Config.version;
+  begin
+    try initialize_toplevel_env ()
+    with Env.Error _ | Typetexp.Error _ as exn ->
+      Location.report_exception ppf exn; exit 2
+  end;
+  let lb = Lexing.from_function refill_lexbuf in
+  Location.init lb "//toplevel//";
+  Location.input_name := "//toplevel//";
+  Location.input_lexbuf := Some lb;
+  Location.input_phrase_buffer := Some phrase_buffer;
+  Sys.catch_break true;
+  run_hooks After_setup;
+  load_ocamlinit ppf;
+  while true do
+    let snap = Btype.snapshot () in
+    try
+      Lexing.flush_input lb;
+      (* Reset the phrase buffer when we flush the lexing buffer. *)
+      Buffer.reset phrase_buffer;
+      Location.reset();
+      Warnings.reset_fatal ();
+      first_line := true;
+      let phr = try !parse_toplevel_phrase lb with Exit -> raise PPerror in
+      let phr = preprocess_phrase ppf phr  in
+      Env.reset_cache_toplevel ();
+      ignore(execute_phrase true ppf phr)
+    with
+    | End_of_file -> exit 0
+    | Sys.Break -> fprintf ppf "Interrupted.@."; Btype.backtrack snap
+    | PPerror -> ()
+    | x -> Location.report_exception ppf x; Btype.backtrack snap
+  done
+
+external caml_sys_modify_argv : string array -> unit =
+  "caml_sys_modify_argv"
+
+let override_sys_argv new_argv =
+  caml_sys_modify_argv new_argv;
+  Arg.current := 0
+
+(* Execute a script.  If [name] is "", read the script from stdin. *)
+
+let run_script ppf name args =
+  override_sys_argv args;
+  Compmisc.init_path ~dir:(Filename.dirname name) ();
+                   (* 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; exit 2
+  end;
+  Sys.interactive := false;
+  run_hooks After_setup;
+  let explicit_name =
+    (* Prevent use_silently from searching in the path. *)
+    if name <> "" && Filename.is_implicit name
+    then Filename.concat Filename.current_dir_name name
+    else name
+  in
+  use_silently ppf explicit_name
diff --git a/toplevel/toploop.mli b/toplevel/toploop.mli
new file mode 100644
index 00000000..45a43bc3
--- /dev/null
+++ b/toplevel/toploop.mli
@@ -0,0 +1,177 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Format
+
+(* Accessors for the table of toplevel value bindings.  These functions
+   must appear as first and second exported functions in this module.
+   (See module Translmod.) *)
+val getvalue : string -> Obj.t
+val setvalue : string -> Obj.t -> unit
+
+(* Set the load paths, before running anything *)
+
+val set_paths : unit -> unit
+
+(* The interactive toplevel loop *)
+
+val loop : formatter -> unit
+
+(* Read and execute a script from the given file *)
+
+val run_script : formatter -> string -> string array -> bool
+        (* true if successful, false if error *)
+
+(* Interface with toplevel directives *)
+
+type directive_fun =
+   | Directive_none of (unit -> unit)
+   | Directive_string of (string -> unit)
+   | Directive_int of (int -> unit)
+   | Directive_ident of (Longident.t -> unit)
+   | Directive_bool of (bool -> unit)
+
+type directive_info = {
+  section: string;
+  doc: string;
+}
+
+val add_directive : string -> directive_fun -> directive_info -> unit
+        (* Add toplevel directive and its documentation.
+
+           @since 4.03 *)
+
+val directive_table : (string, directive_fun) Hashtbl.t
+  (* Deprecated: please use [add_directive] instead of inserting
+     in this table directly. *)
+
+val directive_info_table : (string, directive_info) Hashtbl.t
+
+val toplevel_env : Env.t ref
+        (* Typing environment for the toplevel *)
+val initialize_toplevel_env : unit -> unit
+        (* Initialize the typing environment for the toplevel *)
+val print_exception_outcome : formatter -> exn -> unit
+        (* Print an exception resulting from the evaluation of user code. *)
+val execute_phrase : bool -> formatter -> Parsetree.toplevel_phrase -> bool
+        (* Execute the given toplevel phrase. Return [true] if the
+           phrase executed with no errors and [false] otherwise.
+           First bool says whether the values and types of the results
+           should be printed. Uncaught exceptions are always printed. *)
+val preprocess_phrase :
+      formatter -> Parsetree.toplevel_phrase ->  Parsetree.toplevel_phrase
+        (* Preprocess the given toplevel phrase using regular and ppx
+           preprocessors. Return the updated phrase. *)
+val use_file : formatter -> string -> bool
+val use_output : formatter -> string -> bool
+val use_silently : formatter -> string -> bool
+val mod_use_file : formatter -> string -> bool
+        (* Read and execute commands from a file.
+           [use_file] prints the types and values of the results.
+           [use_silently] does not print them.
+           [mod_use_file] wrap the file contents into a module. *)
+val eval_module_path: Env.t -> Path.t -> Obj.t
+val eval_value_path: Env.t -> Path.t -> Obj.t
+val eval_extension_path: Env.t -> Path.t -> Obj.t
+val eval_class_path: Env.t -> Path.t -> Obj.t
+        (* Return the toplevel object referred to by the given path *)
+val record_backtrace : unit -> unit
+
+(* Printing of values *)
+
+val print_value: Env.t -> Obj.t -> formatter -> Types.type_expr -> unit
+val print_untyped_exception: formatter -> Obj.t -> unit
+
+type ('a, 'b) gen_printer =
+  | Zero of 'b
+  | Succ of ('a -> ('a, 'b) gen_printer)
+
+val install_printer :
+  Path.t -> Types.type_expr -> (formatter -> Obj.t -> unit) -> unit
+val install_generic_printer :
+  Path.t -> Path.t ->
+  (int -> (int -> Obj.t -> Outcometree.out_value,
+           Obj.t -> Outcometree.out_value) gen_printer) -> unit
+val install_generic_printer' :
+  Path.t -> Path.t -> (formatter -> Obj.t -> unit,
+                       formatter -> Obj.t -> unit) gen_printer -> unit
+val remove_printer : Path.t -> unit
+
+val max_printer_depth: int ref
+val max_printer_steps: int ref
+
+(* Hooks for external parsers and printers *)
+
+val parse_toplevel_phrase : (Lexing.lexbuf -> Parsetree.toplevel_phrase) ref
+val parse_use_file : (Lexing.lexbuf -> Parsetree.toplevel_phrase list) ref
+val print_location : formatter -> Location.t -> unit
+val print_error : formatter -> Location.error -> unit
+val print_warning : Location.t -> formatter -> Warnings.t -> unit
+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
+val print_out_phrase :
+  (formatter -> Outcometree.out_phrase -> unit) ref
+
+(* Hooks for external line editor *)
+
+val read_interactive_input : (string -> bytes -> int -> int * bool) ref
+
+(* Hooks *)
+
+val toplevel_startup_hook : (unit -> unit) ref
+
+type event = ..
+type event +=
+  | Startup
+  | After_setup
+  (* Just after the setup, when the toplevel is ready to evaluate user
+     input. This happens before the toplevel has evaluated any kind of
+     user input, in particular this happens before loading the
+     [.ocamlinit] file. *)
+
+val add_hook : (event -> unit) -> unit
+(* Add a function that will be called at key points of the toplevel
+   initialization process. *)
+
+val run_hooks : event -> unit
+(* Run all the registered hooks. *)
+
+(* Used by Trace module *)
+
+val may_trace : bool ref
+
+(* Misc *)
+
+val override_sys_argv : string array -> unit
+(* [override_sys_argv args] replaces the contents of [Sys.argv] by [args]
+   and reset [Arg.current] to [0].
+
+   This is called by [run_script] so that [Sys.argv] represents
+   "script.ml args..." instead of the full command line:
+   "ocamlrun unix.cma ... script.ml args...". *)
diff --git a/toplevel/topmain.ml b/toplevel/topmain.ml
new file mode 100644
index 00000000..dec1659d
--- /dev/null
+++ b/toplevel/topmain.ml
@@ -0,0 +1,121 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Compenv
+
+let usage = "Usage: ocaml   [script-file [arguments]]\n\
+             options are:"
+
+let preload_objects = ref []
+
+(* Position of the first non expanded argument *)
+let first_nonexpanded_pos = ref 0
+
+let current = ref (!Arg.current)
+
+let argv = ref Sys.argv
+
+(* Test whether the option is part of a responsefile *)
+let is_expanded pos = pos < !first_nonexpanded_pos
+
+let expand_position pos len =
+  if pos < !first_nonexpanded_pos then
+    (* Shift the position *)
+    first_nonexpanded_pos := !first_nonexpanded_pos + len
+  else
+    (* New last position *)
+    first_nonexpanded_pos := pos + len + 2
+
+let prepare ppf =
+  Toploop.set_paths ();
+  try
+    let res =
+      let objects =
+        List.rev (!preload_objects @ !first_objfiles)
+      in
+      List.for_all (Topdirs.load_file ppf) objects
+    in
+    Toploop.run_hooks Toploop.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
+
+(* If [name] is "", then the "file" is stdin treated as a script file. *)
+let file_argument name =
+  let ppf = Format.err_formatter in
+  if Filename.check_suffix name ".cmo" || Filename.check_suffix name ".cma"
+  then preload_objects := name :: !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
+       than the original argv.
+    *)
+    Printf.eprintf "For implementation reasons, the toplevel does not support\
+   \ having script files (here %S) inside expanded arguments passed through the\
+   \ -args{,0} command-line option.\n" name;
+    exit 2
+  end else begin
+      let newargs = Array.sub !argv !current
+                              (Array.length !argv - !current)
+      in
+      Compenv.readenv ppf Before_link;
+      Compmisc.read_clflags_from_env ();
+      if prepare ppf && Toploop.run_script ppf name newargs
+      then exit 0
+      else exit 2
+    end
+
+
+let wrap_expand f s =
+  let start = !current in
+  let arr = f s in
+  expand_position start (Array.length arr);
+  arr
+
+module Options = Main_args.Make_bytetop_options (struct
+    include Main_args.Default.Topmain
+    let _stdin () = file_argument ""
+    let _args = wrap_expand Arg.read_arg
+    let _args0 = wrap_expand Arg.read_arg0
+    let anonymous s = file_argument s
+end);;
+
+let () =
+  let extra_paths =
+    match Sys.getenv "OCAMLTOP_INCLUDE_PATH" with
+    | exception Not_found -> []
+    | s -> Misc.split_path_contents s
+  in
+  Clflags.include_dirs := List.rev_append extra_paths !Clflags.include_dirs
+
+let main () =
+  let ppf = Format.err_formatter in
+  Compenv.readenv ppf Before_args;
+  let list = ref Options.list in
+  begin
+    try
+      Arg.parse_and_expand_argv_dynamic current argv list file_argument usage;
+    with
+    | Arg.Bad msg -> Printf.eprintf "%s" msg; exit 2
+    | Arg.Help msg -> Printf.printf "%s" msg; exit 0
+  end;
+  Compenv.readenv ppf Before_link;
+  Compmisc.read_clflags_from_env ();
+  if not (prepare ppf) then exit 2;
+  Compmisc.init_path ();
+  Toploop.loop Format.std_formatter
diff --git a/toplevel/topmain.mli b/toplevel/topmain.mli
new file mode 100644
index 00000000..93fea4c7
--- /dev/null
+++ b/toplevel/topmain.mli
@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Start the [ocaml] toplevel loop *)
+
+val main: unit -> unit
diff --git a/toplevel/topstart.ml b/toplevel/topstart.ml
new file mode 100644
index 00000000..e3dd62c9
--- /dev/null
+++ b/toplevel/topstart.ml
@@ -0,0 +1,16 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let _ = Topmain.main()
diff --git a/toplevel/trace.ml b/toplevel/trace.ml
new file mode 100644
index 00000000..cc732a61
--- /dev/null
+++ b/toplevel/trace.ml
@@ -0,0 +1,150 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The "trace" facility *)
+
+open Format
+open Misc
+open Longident
+open Types
+open Toploop
+
+type codeptr = Obj.t
+
+type traced_function =
+  { path: Path.t;                       (* Name under which it is traced *)
+    closure: Obj.t;                     (* Its function closure (patched) *)
+    actual_code: codeptr;               (* Its original code pointer *)
+    instrumented_fun: codeptr -> Obj.t -> Obj.t -> Obj.t }
+                                        (* Printing function *)
+
+let traced_functions = ref ([] : traced_function list)
+
+(* Check if a function is already traced *)
+
+let is_traced clos =
+  let rec is_traced = function
+      [] -> None
+    | tf :: rem -> if tf.closure == clos then Some tf.path else is_traced rem
+  in is_traced !traced_functions
+
+(* Get or overwrite the code pointer of a closure *)
+
+let get_code_pointer cls = Obj.field cls 0
+
+let set_code_pointer cls ptr = Obj.set_field cls 0 ptr
+
+(* Call a traced function (use old code pointer, but new closure as
+   environment so that recursive calls are also traced).
+   It is necessary to wrap Meta.invoke_traced_function in an ML function
+   so that the RETURN at the end of the ML wrapper takes us to the
+   code of the function. *)
+
+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 a function returns a functional value, wrap it into a trace code *)
+
+let rec instrument_result env name ppf clos_typ =
+  match (Ctype.repr(Ctype.expand_head env clos_typ)).desc with
+  | Tarrow(l, t1, t2, _) ->
+      let starred_name =
+        match name with
+        | Lident s -> Lident(s ^ "*")
+        | Ldot(lid, s) -> Ldot(lid, s ^ "*")
+        | Lapply _ -> fatal_error "Trace.instrument_result" in
+      let trace_res = instrument_result env starred_name ppf t2 in
+      (fun clos_val ->
+        Obj.repr (fun arg ->
+          if not !may_trace then
+            (Obj.magic clos_val : Obj.t -> Obj.t) arg
+          else begin
+            may_trace := false;
+            try
+              fprintf ppf "@[<2>%a <--@ %a%a@]@."
+                Printtyp.longident starred_name
+                print_label l
+                (print_value !toplevel_env arg) t1;
+              may_trace := true;
+              let res = (Obj.magic clos_val : Obj.t -> Obj.t) arg in
+              may_trace := false;
+              fprintf ppf "@[<2>%a -->@ %a@]@."
+                Printtyp.longident starred_name
+                (print_value !toplevel_env res) t2;
+              may_trace := true;
+              trace_res res
+            with exn ->
+              may_trace := false;
+              fprintf ppf "@[<2>%a raises@ %a@]@."
+                Printtyp.longident starred_name
+                (print_value !toplevel_env (Obj.repr exn)) Predef.type_exn;
+              may_trace := true;
+              raise exn
+          end))
+  | _ -> (fun v -> v)
+
+(* Same as instrument_result, but for a toplevel closure (modified in place) *)
+
+exception Dummy
+let _ = Dummy
+
+let instrument_closure env name ppf clos_typ =
+  match (Ctype.repr(Ctype.expand_head env clos_typ)).desc with
+  | Tarrow(l, t1, t2, _) ->
+      let trace_res = instrument_result env name ppf t2 in
+      (fun actual_code closure arg ->
+        if not !may_trace then begin
+          try invoke_traced_function actual_code closure arg
+          with Dummy -> assert false
+          (* do not remove handler, prevents tail-call to invoke_traced_ *)
+        end else begin
+          may_trace := false;
+          try
+            fprintf ppf "@[<2>%a <--@ %a%a@]@."
+              Printtyp.longident name
+              print_label l
+              (print_value !toplevel_env arg) t1;
+            may_trace := true;
+            let res = invoke_traced_function actual_code closure arg in
+            may_trace := false;
+            fprintf ppf "@[<2>%a -->@ %a@]@."
+              Printtyp.longident name
+              (print_value !toplevel_env res) t2;
+            may_trace := true;
+            trace_res res
+          with exn ->
+            may_trace := false;
+            fprintf ppf "@[<2>%a raises@ %a@]@."
+              Printtyp.longident name
+              (print_value !toplevel_env (Obj.repr exn)) Predef.type_exn;
+            may_trace := true;
+            raise exn
+        end)
+  | _ -> assert false
+
+(* Given the address of a closure, find its tracing info *)
+
+let rec find_traced_closure clos = function
+  | [] -> fatal_error "Trace.find_traced_closure"
+  | f :: rem -> if f.closure == clos then f else find_traced_closure clos rem
+
+(* Trace the application of an (instrumented) closure to an argument *)
+
+let print_trace clos arg =
+  let f = find_traced_closure clos !traced_functions in
+  f.instrumented_fun f.actual_code clos arg
diff --git a/toplevel/trace.mli b/toplevel/trace.mli
new file mode 100644
index 00000000..ab9d217e
--- /dev/null
+++ b/toplevel/trace.mli
@@ -0,0 +1,36 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The "trace" facility *)
+
+open Format
+
+type codeptr
+
+type traced_function =
+  { path: Path.t;                       (* Name under which it is traced *)
+    closure: Obj.t;                     (* Its function closure (patched) *)
+    actual_code: codeptr;               (* Its original code pointer *)
+    instrumented_fun: codeptr -> Obj.t -> Obj.t -> Obj.t }
+                                        (* Printing function *)
+
+val traced_functions: traced_function list ref
+val is_traced: Obj.t -> Path.t option
+val get_code_pointer: Obj.t -> codeptr
+val set_code_pointer: Obj.t -> codeptr -> unit
+val instrument_closure:
+        Env.t -> Longident.t -> formatter -> Types.type_expr ->
+        codeptr -> Obj.t -> Obj.t -> Obj.t
+val print_trace: Obj.t -> Obj.t -> Obj.t
diff --git a/typing/HACKING.adoc b/typing/HACKING.adoc
new file mode 100644
index 00000000..8633ef52
--- /dev/null
+++ b/typing/HACKING.adoc
@@ -0,0 +1,58 @@
+The implementation of the OCaml typechecker is complex. Modifying it
+will need a good understanding of the OCaml type system and type
+inference. Here is a reading list to ease your discovery of the
+typechecker:
+
+http://caml.inria.fr/pub/docs/u3-ocaml/index.html[Using, Understanding, and Unraveling the OCaml Language by Didier Rémy] ::
+This book provides (among other things) a formal description of parts
+of the core OCaml language, starting with a simple Core ML.
+
+http://okmij.org/ftp/ML/generalization.html[Efficient and Insightful Generalization by Oleg Kiselyov] ::
+This article describes the basis of the type inference algorithm used
+by the OCaml type checker. It is a recommended read if you want to
+understand the type-checker codebase, in particular its handling of
+polymorphism/generalization.
+
+After that, it is best to dive right in. There is no real "entry
+point", but an understanding of both the parsetree and the typedtree
+is necessary.
+
+The datastructures ::
+link:types.mli[Types] and link:typedtree.mli[Typedtree]
+are the two main datastructures in the typechecker. They correspond to
+the source code annotated with all the information needed for type
+checking and type inference. link:env.mli[Env] contains all the
+environments that are used in the typechecker. Each node in the
+typedtree is annotated with the local environment in which it was
+type-checked.
+
+Core utilities ::
+link:btype.mli[Btype] and link:ctype.mli[Ctype] contain
+the various low-level function needed for typing, in particular
+related to levels, unification and
+backtracking. link:mtype.mli[Mtype] contains utilities related
+to modules.
+
+Inference and checking::
+The `Type..` modules are related to inference and typechecking, each
+for a different part of the language:
+link:typetexp.mli[Typetexp] for type expressions,
+link:typecore.mli[Typecore] for the core language,
+link:typemod.mli[Typemod] for modules,
+link:typedecl.mli[Typedecl] for type declarations and finally
+link:typeclass.mli[Typeclass] for the object system.
+
+Inclusion/Module subtyping::
+Handling of inclusion relations are separated in the `Include...`
+modules: link:includecore.ml[Includecore] for the type and
+value declarations, link:includemod.mli[Includemod] for modules
+and finally link:includeclass.mli[Includeclass] for the object
+system.
+
+Dependencies between modules::
+Most of the modules presented above are inter-dependent. Since OCaml
+does not permit circular dependencies between files, the
+implementation uses forward declarations, implemented with references
+to functions that are filled later on. An example can be seen in
+link:typecore.ml[Typecore.type_module], which is filled in
+link:typemod.ml[Typemod].
diff --git a/typing/TODO.md b/typing/TODO.md
new file mode 100644
index 00000000..c1151161
--- /dev/null
+++ b/typing/TODO.md
@@ -0,0 +1,101 @@
+TODO for the OCaml typechecker implementation
+=============================================
+
+There is a consensus that the current implementation of the OCaml
+typechecker is overly complex and fragile.  A big rewriting "from
+scratch" might be possible or desirable at some point, or not, but
+incremental cleanup steps are certainly accessible and could bring the
+current implementation in a better shape at a relatively small cost
+and in a reasonably distant future.
+
+Goals of the cleanup:
+
+ - Make the implementation more maintainable and less fragile.
+
+ - Allow new contributors, or people involved in bigger rewriting
+   projects, to get familiar with the code base more easily.
+
+ - Pave the way for future extensions or bigger structural changes to
+   the implementation.
+
+This file collects specific cleanup ideas which have been discussed
+amongst maintainers.  Having the list committed in the repo allows for
+everyone to get an idea of planned tasks, refine them through Pull
+Requests, suggest more cleanups, or even start working on specific
+tasks (ideally after discussing it first with maintainers).
+
+# Code smells
+
+- global mutable state
+- poor data representation
+- avoid constructing a parsetree locally
+  (methods build a piece of AST with a self argument
+   with a *-using name to avoid conflicts; #row, etc.)
+- avoid magic string literals
+
+# TODO List
+
+Not all ideas have been thoroughly discussed, and there might not be a
+consensus for all of them.
+
+- Make the level generator be part of `Env.t` instead of being global.
+
+- Introduce an abstraction boundary between "the type algebra" and
+  "the type checker" (at first between Ctype and Typecore) so that the
+  type checker is forced to go through a proper API to access/mutate
+  type nodes.  This would make it impossible to "forget" a call
+  to `repr` and will allow further changes on the internal representation.
+
+- Tidy up Typeclass (use records instead of 14-tuples, avoid
+  "#"-encoding, etc).
+
+- Collect all global state of the type checker in a single place,
+  possibly a single reference to a persistent data structure
+  (e.g. maps instead of hashtables).
+
+- Get rid of Tsubst.  With the unique ids on each type node, copying
+  can be implemented rather efficiently with a map.
+
+- Document row_desc, get rid of row_bound.
+
+- Implement union-find with a more abstract/persistent datastructure
+  (be careful about memory leaks with the naive approach of representing
+  links with a persistent heap).
+
+  Modest version of the proposal: have an explicit indirection layer
+    (type_expr Unode.t)
+  for nodes in the union-find structure. Efficiency cost?
+
+- Make the logic for record/constructor disambiguation more readable.
+
+  (Jacques should write a specification, and then we could try
+  to make the implementation easier for others to understand.)
+
+- Tidy up destructive substitution.
+
+- Get rid of syntactic encodings (generating Parsetree fragments
+  during type-checking, cf optional arguments or classes).
+
+- Track "string literals" in the type-checker, which often act as
+  magic "internal" names which should be avoided.
+
+- Consider storing warning settings (+other context) as part of `Env.t`?
+
+- Parse attributes understood (e.g. the deprecated attribute) by the
+  compiler into a structured representation during type-checking.
+
+- Introduce a notion of syntactic "path-like location" to point to
+  allow pointing to AST fragments, and use that to implement "unused"
+  warnings in a less invasive and less imperative way.
+  (See Thomas' PR)
+
+- Deprecate -nolabels, or even get rid of it?
+  (We could even stop supporting unlabeled full applications.
+   First turn on the warning by default.)
+
+- Using e.g. bisect_ppx, monitor coverage of the typechecker
+  implementation while running the testsuite, and expand the testsuite
+  and/or kill dead code in the typechecker to increase coverage ratio.
+  (Partially done by Oxana's Outreachy internship.
+   See PR#8874.
+   Ask Florian Angeletti and Sebastien Hinderer about the current state.)
diff --git a/typing/annot.mli b/typing/annot.mli
new file mode 100644
index 00000000..3cae8f27
--- /dev/null
+++ b/typing/annot.mli
@@ -0,0 +1,24 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Damien Doligez, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2007 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Data types for annotations (Stypes.ml) *)
+
+type call = Tail | Stack | Inline;;
+
+type ident =
+  | Iref_internal of Location.t (* defining occurrence *)
+  | Iref_external
+  | Idef of Location.t          (* scope *)
+;;
diff --git a/typing/btype.ml b/typing/btype.ml
new file mode 100644
index 00000000..bec31496
--- /dev/null
+++ b/typing/btype.ml
@@ -0,0 +1,820 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Basic operations on core types *)
+
+open Asttypes
+open Types
+
+(**** Sets, maps and hashtables of types ****)
+
+module TypeSet = Set.Make(TypeOps)
+module TypeMap = Map.Make (TypeOps)
+module TypeHash = Hashtbl.Make(TypeOps)
+
+(**** 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 *)
+
+(**** Some type creators ****)
+
+let new_id = ref (-1)
+
+let newty2 level desc  =
+  incr new_id; { desc; level; scope = lowest_level; id = !new_id }
+let newgenty desc      = newty2 generic_level desc
+let newgenvar ?name () = newgenty (Tvar name)
+(*
+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 = function {desc=Tvar _} -> true | _ -> false
+let is_Tunivar = function {desc=Tunivar _} -> true | _ -> false
+let is_Tconstr = function {desc=Tconstr _} -> true | _ -> false
+
+let dummy_method = "*dummy method*"
+
+(**** Definitions for backtracking ****)
+
+type change =
+    Ctype of type_expr * type_desc
+  | Ccompress of type_expr * type_desc * type_desc
+  | Clevel of type_expr * int
+  | Cscope of type_expr * int
+  | Cname of
+      (Path.t * type_expr list) option ref * (Path.t * type_expr list) option
+  | Crow of row_field option ref * row_field option
+  | Ckind of field_kind option ref * field_kind option
+  | Ccommu of commutable ref * commutable
+  | Cuniv of type_expr option ref * type_expr option
+  | Ctypeset of TypeSet.t ref * TypeSet.t
+
+type changes =
+    Change of change * changes ref
+  | Unchanged
+  | Invalid
+
+let trail = Weak.create 1
+
+let log_change ch =
+  match Weak.get trail 0 with None -> ()
+  | Some r ->
+      let r' = ref Unchanged in
+      r := Change (ch, r');
+      Weak.set trail 0 (Some r')
+
+(**** Representative of a type ****)
+
+let rec field_kind_repr =
+  function
+    Fvar {contents = Some kind} -> field_kind_repr kind
+  | kind                        -> kind
+
+let rec repr_link compress t d =
+ function
+   {desc = Tlink t' as d'} ->
+     repr_link true t d' t'
+ | {desc = Tfield (_, k, _, t') as d'} when field_kind_repr k = Fabsent ->
+     repr_link true t d' t'
+ | t' ->
+     if compress then begin
+       log_change (Ccompress (t, t.desc, d)); t.desc <- d
+     end;
+     t'
+
+let repr t =
+  match t.desc with
+   Tlink t' as d ->
+     repr_link false t d t'
+ | Tfield (_, k, _, t') as d when field_kind_repr k = Fabsent ->
+     repr_link false t d t'
+ | _ -> t
+
+let rec commu_repr = function
+    Clink r when !r <> Cunknown -> commu_repr !r
+  | c -> c
+
+let rec row_field_repr_aux tl = function
+    Reither(_, tl', _, {contents = Some fi}) ->
+      row_field_repr_aux (tl@tl') fi
+  | Reither(c, tl', m, r) ->
+      Reither(c, tl@tl', m, r)
+  | Rpresent (Some _) when tl <> [] ->
+      Rpresent (Some (List.hd tl))
+  | fi -> fi
+
+let row_field_repr fi = row_field_repr_aux [] fi
+
+let rec rev_concat l ll =
+  match ll with
+    [] -> l
+  | l'::ll -> rev_concat (l'@l) ll
+
+let rec row_repr_aux ll row =
+  match (repr row.row_more).desc with
+  | Tvariant row' ->
+      let f = row.row_fields in
+      row_repr_aux (if f = [] then ll else f::ll) row'
+  | _ ->
+      if ll = [] then row else
+      {row with row_fields = rev_concat row.row_fields ll}
+
+let row_repr row = row_repr_aux [] row
+
+let rec row_field tag row =
+  let rec find = function
+    | (tag',f) :: fields ->
+        if tag = tag' then row_field_repr f else find fields
+    | [] ->
+        match repr row.row_more with
+        | {desc=Tvariant row'} -> row_field tag row'
+        | _ -> Rabsent
+  in find row.row_fields
+
+let rec row_more row =
+  match repr row.row_more with
+  | {desc=Tvariant row'} -> row_more row'
+  | ty -> ty
+
+let merge_fixed_explanation fixed1 fixed2 =
+  match fixed1, fixed2 with
+  | Some Univar _ as x, _ | _, (Some Univar _ as x) -> x
+  | Some Fixed_private as x, _ | _, (Some Fixed_private as x) -> x
+  | Some Reified _ as x, _ | _, (Some Reified _ as x) -> x
+  | Some Rigid as x, _ | _, (Some Rigid as x) -> x
+  | None, None -> None
+
+
+let fixed_explanation row =
+  let row = row_repr row in
+  match row.row_fixed with
+  | Some _ as x -> x
+  | None ->
+      let more = repr row.row_more in
+      match more.desc with
+      | Tvar _ | Tnil -> None
+      | Tunivar _ -> Some (Univar more)
+      | Tconstr (p,_,_) -> Some (Reified p)
+      | _ -> assert false
+
+let is_fixed row = match row.row_fixed with
+  | None -> false
+  | Some _ -> true
+
+let row_fixed row = fixed_explanation row <> None
+
+
+let static_row row =
+  let row = row_repr row in
+  row.row_closed &&
+  List.for_all
+    (fun (_,f) -> match row_field_repr f with Reither _ -> false | _ -> true)
+    row.row_fields
+
+let hash_variant s =
+  let accu = ref 0 in
+  for i = 0 to String.length s - 1 do
+    accu := 223 * !accu + Char.code s.[i]
+  done;
+  (* reduce to 31 bits *)
+  accu := !accu land (1 lsl 31 - 1);
+  (* make it signed for 64 bits architectures *)
+  if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu
+
+let proxy ty =
+  let ty0 = repr ty in
+  match ty0.desc with
+  | Tvariant row when not (static_row row) ->
+      row_more row
+  | Tobject (ty, _) ->
+      let rec proxy_obj ty =
+        match ty.desc with
+          Tfield (_, _, _, ty) | Tlink ty -> proxy_obj ty
+        | Tvar _ | Tunivar _ | Tconstr _ -> ty
+        | Tnil -> ty0
+        | _ -> assert false
+      in proxy_obj ty
+  | _ -> ty0
+
+(**** Utilities for fixed row private types ****)
+
+let row_of_type t =
+  match (repr t).desc with
+    Tobject(t,_) ->
+      let rec get_row t =
+        let t = repr t in
+        match t.desc with
+          Tfield(_,_,_,t) -> get_row t
+        | _ -> t
+      in get_row t
+  | Tvariant row ->
+      row_more row
+  | _ ->
+      t
+
+let has_constr_row t =
+  not (is_Tconstr t) && is_Tconstr (row_of_type t)
+
+let is_row_name s =
+  let l = String.length s in
+  if l < 4 then false else String.sub s (l-4) 4 = "#row"
+
+let is_constr_row ~allow_ident t =
+  match t.desc with
+    Tconstr (Path.Pident id, _, _) when allow_ident ->
+      is_row_name (Ident.name id)
+  | Tconstr (Path.Pdot (_, s), _, _) -> is_row_name s
+  | _ -> false
+
+
+                  (**********************************)
+                  (*  Utilities for type traversal  *)
+                  (**********************************)
+
+let rec fold_row f init row =
+  let result =
+    List.fold_left
+      (fun init (_, fi) ->
+         match row_field_repr fi with
+         | Rpresent(Some ty) -> f init ty
+         | Reither(_, tl, _, _) -> List.fold_left f init tl
+         | _ -> init)
+      init
+      row.row_fields
+  in
+  match (repr row.row_more).desc with
+    Tvariant row -> fold_row f result row
+  | Tvar _ | Tunivar _ | Tsubst _ | Tconstr _ | Tnil ->
+    begin match
+      Option.map (fun (_,l) -> List.fold_left f result l) row.row_name
+    with
+    | None -> result
+    | Some result -> result
+    end
+  | _ -> assert false
+
+let iter_row f row =
+  fold_row (fun () v -> f v) () row
+
+let fold_type_expr f init ty =
+  match ty.desc with
+    Tvar _              -> init
+  | Tarrow (_, ty1, ty2, _) ->
+    let result = f init ty1 in
+    f result ty2
+  | Ttuple l            -> List.fold_left f init l
+  | Tconstr (_, l, _)   -> List.fold_left f init l
+  | Tobject(ty, {contents = Some (_, p)})
+    ->
+    let result = f init ty in
+    List.fold_left f result p
+  | Tobject (ty, _)     -> f init ty
+  | Tvariant row        ->
+    let result = fold_row f init row in
+    f result (row_more row)
+  | Tfield (_, _, ty1, ty2) ->
+    let result = f init ty1 in
+    f result ty2
+  | Tnil                -> init
+  | Tlink ty            -> f init ty
+  | Tsubst ty           -> f init ty
+  | Tunivar _           -> init
+  | Tpoly (ty, tyl)     ->
+    let result = f init ty in
+    List.fold_left f result tyl
+  | Tpackage (_, _, l)  -> List.fold_left f init l
+
+let iter_type_expr f ty =
+  fold_type_expr (fun () v -> f v) () ty
+
+let rec iter_abbrev f = function
+    Mnil                   -> ()
+  | 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_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
+
+let map_type_expr_cstr_args f = function
+  | Cstr_tuple tl -> Cstr_tuple (List.map f tl)
+  | Cstr_record lbls ->
+      Cstr_record (List.map (fun d -> {d with ld_type=f d.ld_type}) lbls)
+
+let iter_type_expr_kind f = function
+  | Type_abstract -> ()
+  | Type_variant cstrs ->
+      List.iter
+        (fun cd ->
+           iter_type_expr_cstr_args f cd.cd_args;
+           Option.iter f cd.cd_res
+        )
+        cstrs
+  | Type_record(lbls, _) ->
+      List.iter (fun d -> f d.ld_type) lbls
+  | Type_open ->
+      ()
+
+
+let type_iterators =
+  let it_signature it =
+    List.iter (it.it_signature_item it)
+  and it_signature_item it = function
+      Sig_value (_, vd, _)          -> it.it_value_description it vd
+    | Sig_type (_, td, _, _)        -> it.it_type_declaration it td
+    | Sig_typext (_, td, _, _)      -> it.it_extension_constructor it td
+    | Sig_module (_, _, md, _, _)   -> it.it_module_declaration it md
+    | Sig_modtype (_, mtd, _)       -> it.it_modtype_declaration it mtd
+    | Sig_class (_, cd, _, _)       -> it.it_class_declaration it cd
+    | Sig_class_type (_, ctd, _, _) -> it.it_class_type_declaration it ctd
+  and it_value_description it vd =
+    it.it_type_expr it vd.val_type
+  and it_type_declaration it td =
+    List.iter (it.it_type_expr it) td.type_params;
+    Option.iter (it.it_type_expr it) td.type_manifest;
+    it.it_type_kind it td.type_kind
+  and it_extension_constructor it td =
+    it.it_path td.ext_type_path;
+    List.iter (it.it_type_expr it) td.ext_type_params;
+    iter_type_expr_cstr_args (it.it_type_expr it) td.ext_args;
+    Option.iter (it.it_type_expr it) td.ext_ret_type
+  and it_module_declaration it md =
+    it.it_module_type it md.md_type
+  and it_modtype_declaration it mtd =
+    Option.iter (it.it_module_type it) mtd.mtd_type
+  and it_class_declaration it cd =
+    List.iter (it.it_type_expr it) cd.cty_params;
+    it.it_class_type it cd.cty_type;
+    Option.iter (it.it_type_expr it) cd.cty_new;
+    it.it_path cd.cty_path
+  and it_class_type_declaration it ctd =
+    List.iter (it.it_type_expr it) ctd.clty_params;
+    it.it_class_type it ctd.clty_type;
+    it.it_path ctd.clty_path
+  and it_functor_param it = function
+    | Unit -> ()
+    | Named (_, mt) -> it.it_module_type it mt
+  and it_module_type it = function
+      Mty_ident p
+    | Mty_alias p -> it.it_path p
+    | Mty_signature sg -> it.it_signature it sg
+    | Mty_functor (p, mt) ->
+        it.it_functor_param it p;
+        it.it_module_type it mt
+  and it_class_type it = function
+      Cty_constr (p, tyl, cty) ->
+        it.it_path p;
+        List.iter (it.it_type_expr it) tyl;
+        it.it_class_type it cty
+    | Cty_signature cs ->
+        it.it_type_expr it cs.csig_self;
+        Vars.iter (fun _ (_,_,ty) -> it.it_type_expr it ty) cs.csig_vars;
+        List.iter
+          (fun (p, tl) -> it.it_path p; List.iter (it.it_type_expr it) tl)
+          cs.csig_inher
+    | Cty_arrow  (_, ty, cty) ->
+        it.it_type_expr it ty;
+        it.it_class_type it cty
+  and it_type_kind it kind =
+    iter_type_expr_kind (it.it_type_expr it) kind
+  and it_do_type_expr it ty =
+    iter_type_expr (it.it_type_expr it) ty;
+    match ty.desc with
+      Tconstr (p, _, _)
+    | Tobject (_, {contents=Some (p, _)})
+    | Tpackage (p, _, _) ->
+        it.it_path p
+    | Tvariant row ->
+        Option.iter (fun (p,_) -> it.it_path p) (row_repr row).row_name
+    | _ -> ()
+  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; }
+
+let copy_row f fixed row keep more =
+  let fields = List.map
+      (fun (l, fi) -> l,
+        match row_field_repr fi with
+        | Rpresent(Some ty) -> Rpresent(Some(f ty))
+        | Reither(c, tl, m, e) ->
+            let e = if keep then e else ref None in
+            let m = if is_fixed row then fixed else m in
+            let tl = List.map f tl in
+            Reither(c, tl, m, e)
+        | _ -> fi)
+      row.row_fields in
+  let name =
+    match row.row_name with
+    | None -> None
+    | Some (path, tl) -> Some (path, List.map f tl) in
+  let row_fixed = if fixed then row.row_fixed else None in
+  { row_fields = fields; row_more = more;
+    row_bound = (); row_fixed;
+    row_closed = row.row_closed; row_name = name; }
+
+let rec copy_kind = function
+    Fvar{contents = Some k} -> copy_kind k
+  | Fvar _   -> Fvar (ref None)
+  | Fpresent -> Fpresent
+  | Fabsent  -> assert false
+
+let copy_commu c =
+  if commu_repr c = Cok then Cok else Clink (ref Cunknown)
+
+(* Since univars may be used as row variables, we need to do some
+   encoding during substitution *)
+let rec norm_univar ty =
+  match ty.desc with
+    Tunivar _ | Tsubst _ -> ty
+  | Tlink ty           -> norm_univar ty
+  | Ttuple (ty :: _)   -> norm_univar ty
+  | _                  -> assert false
+
+let rec copy_type_desc ?(keep_names=false) f = function
+    Tvar _ as ty        -> if keep_names then ty else Tvar None
+  | Tarrow (p, ty1, ty2, c)-> Tarrow (p, f ty1, f ty2, copy_commu c)
+  | Ttuple l            -> Ttuple (List.map f l)
+  | Tconstr (p, l, _)   -> Tconstr (p, List.map f l, ref Mnil)
+  | Tobject(ty, {contents = Some (p, tl)})
+                        -> Tobject (f ty, ref (Some(p, List.map f tl)))
+  | Tobject (ty, _)     -> Tobject (f ty, ref None)
+  | Tvariant _          -> assert false (* too ambiguous *)
+  | Tfield (p, k, ty1, ty2) -> (* the kind is kept shared *)
+      Tfield (p, field_kind_repr k, f ty1, f ty2)
+  | Tnil                -> Tnil
+  | Tlink ty            -> copy_type_desc f ty.desc
+  | Tsubst _            -> assert false
+  | Tunivar _ as ty     -> ty (* always keep the name *)
+  | Tpoly (ty, tyl)     ->
+      let tyl = List.map (fun x -> norm_univar (f x)) tyl in
+      Tpoly (f ty, tyl)
+  | Tpackage (p, n, l)  -> Tpackage (p, n, List.map f l)
+
+(* Utilities for copying *)
+
+module For_copy : sig
+  type copy_scope
+
+  val save_desc: copy_scope -> type_expr -> type_desc -> unit
+
+  val dup_kind: copy_scope -> field_kind option ref -> unit
+
+  val with_scope: (copy_scope -> 'a) -> 'a
+end = struct
+  type copy_scope = {
+    mutable saved_desc : (type_expr * type_desc) list;
+    (* Save association of generic nodes with their description. *)
+
+    mutable saved_kinds: field_kind option ref list;
+    (* duplicated kind variables *)
+
+    mutable new_kinds  : field_kind option ref list;
+    (* new kind variables *)
+  }
+
+  let save_desc copy_scope ty desc =
+    copy_scope.saved_desc <- (ty, desc) :: copy_scope.saved_desc
+
+  let dup_kind copy_scope r =
+    assert (Option.is_none !r);
+    if not (List.memq r copy_scope.new_kinds) then begin
+      copy_scope.saved_kinds <- r :: copy_scope.saved_kinds;
+      let r' = ref None in
+      copy_scope.new_kinds <- r' :: copy_scope.new_kinds;
+      r := Some (Fvar r')
+    end
+
+  (* Restore type descriptions. *)
+  let cleanup { saved_desc; saved_kinds; _ } =
+    List.iter (fun (ty, desc) -> ty.desc <- desc) saved_desc;
+    List.iter (fun r -> r := None) saved_kinds
+
+  let with_scope f =
+    let scope = { saved_desc = []; saved_kinds = []; new_kinds = [] } in
+    let res = f scope in
+    cleanup scope;
+    res
+end
+
+(* Mark a type. *)
+let rec mark_type ty =
+  let ty = repr ty in
+  if ty.level >= lowest_level then begin
+    ty.level <- pivot_level - ty.level;
+    iter_type_expr mark_type ty
+  end
+
+let mark_type_node ty =
+  let ty = repr ty in
+  if ty.level >= lowest_level then begin
+    ty.level <- pivot_level - ty.level;
+  end
+
+let mark_type_params ty =
+  iter_type_expr mark_type ty
+
+let type_iterators =
+  let it_type_expr it ty =
+    let ty = repr ty in
+    if ty.level >= lowest_level then begin
+      mark_type_node ty;
+      it.it_do_type_expr it ty;
+    end
+  in
+  {type_iterators with it_type_expr}
+
+
+(* Remove marks from a type. *)
+let rec unmark_type ty =
+  let ty = repr ty in
+  if ty.level < lowest_level then begin
+    ty.level <- pivot_level - ty.level;
+    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;
+  Vars.iter (fun _l (_m, _v, t) -> unmark_type t) sign.csig_vars
+
+let unmark_class_type cty =
+  unmark_iterators.it_class_type unmark_iterators cty
+
+
+                  (*******************************************)
+                  (*  Memorization of abbreviation expansion *)
+                  (*******************************************)
+
+(* Search whether the expansion has been memorized. *)
+
+let lte_public p1 p2 =  (* Private <= Public *)
+  match p1, p2 with
+  | Private, _ | _, Public -> true
+  | Public, Private -> false
+
+let rec find_expans priv p1 = function
+    Mnil -> None
+  | Mcons (priv', p2, _ty0, ty, _)
+    when lte_public priv priv' && Path.same p1 p2 -> Some ty
+  | Mcons (_, _, _, _, rem)   -> find_expans priv p1 rem
+  | Mlink {contents = rem} -> find_expans priv p1 rem
+
+(* debug: check for cycles in abbreviation. only works with -principal
+let rec check_expans visited ty =
+  let ty = repr ty in
+  assert (not (List.memq ty visited));
+  match ty.desc with
+    Tconstr (path, args, abbrev) ->
+      begin match find_expans path !abbrev with
+        Some ty' -> check_expans (ty :: visited) ty'
+      | None -> ()
+      end
+  | _ -> ()
+*)
+
+let memo = ref []
+        (* Contains the list of saved abbreviation expansions. *)
+
+let cleanup_abbrev () =
+        (* Remove all memorized abbreviation expansions. *)
+  List.iter (fun abbr -> abbr := Mnil) !memo;
+  memo := []
+
+let memorize_abbrev mem priv path v v' =
+        (* Memorize the expansion of an abbreviation. *)
+  mem := Mcons (priv, path, v, v', !mem);
+  (* check_expans [] v; *)
+  memo := mem :: !memo
+
+let rec forget_abbrev_rec mem path =
+  match mem with
+    Mnil ->
+      mem
+  | Mcons (_, path', _, _, rem) when Path.same path path' ->
+      rem
+  | Mcons (priv, path', v, v', rem) ->
+      Mcons (priv, path', v, v', forget_abbrev_rec rem path)
+  | Mlink mem' ->
+      mem' := forget_abbrev_rec !mem' path;
+      raise Exit
+
+let forget_abbrev mem path =
+  try mem := forget_abbrev_rec !mem path with Exit -> ()
+
+(* debug: check for invalid abbreviations
+let rec check_abbrev_rec = function
+    Mnil -> true
+  | Mcons (_, ty1, ty2, rem) ->
+      repr ty1 != repr ty2
+  | Mlink mem' ->
+      check_abbrev_rec !mem'
+
+let check_memorized_abbrevs () =
+  List.for_all (fun mem -> check_abbrev_rec !mem) !memo
+*)
+
+                  (**********************************)
+                  (*  Utilities for labels          *)
+                  (**********************************)
+
+let is_optional = function Optional _ -> true | _ -> false
+
+let label_name = function
+    Nolabel -> ""
+  | Labelled s
+  | Optional s -> s
+
+let prefixed_label_name = function
+    Nolabel -> ""
+  | Labelled s -> "~" ^ s
+  | Optional s -> "?" ^ s
+
+let rec extract_label_aux hd l = function
+  | [] -> None
+  | (l',t as p) :: ls ->
+      if label_name l' = l then
+        Some (l', t, hd <> [], List.rev_append hd ls)
+      else
+        extract_label_aux (p::hd) l ls
+
+let extract_label l ls = extract_label_aux [] l ls
+
+
+                  (**********************************)
+                  (*  Utilities for backtracking    *)
+                  (**********************************)
+
+let undo_change = function
+    Ctype  (ty, desc) -> ty.desc <- desc
+  | Ccompress  (ty, desc, _) -> ty.desc <- desc
+  | Clevel (ty, level) -> ty.level <- level
+  | Cscope (ty, scope) -> ty.scope <- scope
+  | Cname  (r, v) -> r := v
+  | Crow   (r, v) -> r := v
+  | Ckind  (r, v) -> r := v
+  | Ccommu (r, v) -> r := v
+  | Cuniv  (r, v) -> r := v
+  | Ctypeset (r, v) -> r := v
+
+type snapshot = changes ref * int
+let last_snapshot = ref 0
+
+let log_type ty =
+  if ty.id <= !last_snapshot then log_change (Ctype (ty, ty.desc))
+let link_type ty ty' =
+  log_type ty;
+  let desc = ty.desc in
+  ty.desc <- Tlink ty';
+  (* Name is a user-supplied name for this unification variable (obtained
+   * through a type annotation for instance). *)
+  match desc, ty'.desc with
+    Tvar name, Tvar name' ->
+      begin match name, name' with
+      | Some _, None ->  log_type ty'; ty'.desc <- Tvar name
+      | None, Some _ ->  ()
+      | Some _, Some _ ->
+          if ty.level < ty'.level then (log_type ty'; ty'.desc <- Tvar name)
+      | None, None   ->  ()
+      end
+  | _ -> ()
+  (* ; assert (check_memorized_abbrevs ()) *)
+  (*  ; check_expans [] ty' *)
+let set_type_desc ty td =
+  if td != ty.desc then begin
+    log_type ty;
+    ty.desc <- td
+  end
+let set_level ty level =
+  if level <> ty.level then begin
+    if ty.id <= !last_snapshot then log_change (Clevel (ty, ty.level));
+    ty.level <- level
+  end
+let set_scope ty scope =
+  if scope <> ty.scope then begin
+    if ty.id <= !last_snapshot then log_change (Cscope (ty, ty.scope));
+    ty.scope <- scope
+  end
+let set_univar rty ty =
+  log_change (Cuniv (rty, !rty)); rty := Some ty
+let set_name nm v =
+  log_change (Cname (nm, !nm)); nm := v
+let set_row_field e v =
+  log_change (Crow (e, !e)); e := Some v
+let set_kind rk k =
+  log_change (Ckind (rk, !rk)); rk := Some k
+let set_commu rc c =
+  log_change (Ccommu (rc, !rc)); rc := c
+let set_typeset rs s =
+  log_change (Ctypeset (rs, !rs)); rs := s
+
+let snapshot () =
+  let old = !last_snapshot in
+  last_snapshot := !new_id;
+  match Weak.get trail 0 with Some r -> (r, old)
+  | None ->
+      let r = ref Unchanged in
+      Weak.set trail 0 (Some r);
+      (r, old)
+
+let rec rev_log accu = function
+    Unchanged -> accu
+  | Invalid -> assert false
+  | Change (ch, next) ->
+      let d = !next in
+      next := Invalid;
+      rev_log (ch::accu) d
+
+let backtrack (changes, old) =
+  match !changes with
+    Unchanged -> last_snapshot := old
+  | Invalid -> failwith "Btype.backtrack"
+  | Change _ as change ->
+      cleanup_abbrev ();
+      let backlog = rev_log [] change in
+      List.iter undo_change backlog;
+      changes := Unchanged;
+      last_snapshot := old;
+      Weak.set trail 0 (Some changes)
+
+let rec rev_compress_log log r =
+  match !r with
+    Unchanged | Invalid ->
+      log
+  | Change (Ccompress _, next) ->
+      rev_compress_log (r::log) next
+  | Change (_, next) ->
+      rev_compress_log log next
+
+let undo_compress (changes, _old) =
+  match !changes with
+    Unchanged
+  | Invalid -> ()
+  | Change _ ->
+      let log = rev_compress_log [] changes in
+      List.iter
+        (fun r -> match !r with
+          Change (Ccompress (ty, desc, d), next) when ty.desc == d ->
+            ty.desc <- desc; r := !next
+        | _ -> ())
+        log
diff --git a/typing/btype.mli b/typing/btype.mli
new file mode 100644
index 00000000..7c215ed9
--- /dev/null
+++ b/typing/btype.mli
@@ -0,0 +1,255 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Basic operations on core types *)
+
+open Asttypes
+open Types
+
+(**** Sets, maps and hashtables of types ****)
+
+module TypeSet  : Set.S with type elt = type_expr
+module TypeMap  : Map.S with type key = type_expr
+module TypeHash : Hashtbl.S with type key = type_expr
+
+(**** Levels ****)
+
+val generic_level: int
+
+val newty2: int -> type_desc -> type_expr
+        (* Create a type *)
+val newgenty: type_desc -> type_expr
+        (* Create a generic type *)
+val newgenvar: ?name:string -> unit -> type_expr
+        (* Return a fresh generic variable *)
+
+(* 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 dummy_method: label
+
+val repr: type_expr -> type_expr
+        (* Return the canonical representative of a type. *)
+
+val field_kind_repr: field_kind -> field_kind
+        (* Return the canonical representative of an object field
+           kind. *)
+
+val commu_repr: commutable -> commutable
+        (* Return the canonical representative of a commutation lock *)
+
+(**** polymorphic variants ****)
+
+val row_repr: row_desc -> row_desc
+        (* Return the canonical representative of a row description *)
+val row_field_repr: row_field -> row_field
+val row_field: label -> row_desc -> row_field
+        (* Return the canonical representative of a row field *)
+val row_more: row_desc -> type_expr
+        (* Return the extension variable of the row *)
+
+val is_fixed: row_desc -> bool
+(* Return whether the row is directly marked as fixed or not *)
+
+val row_fixed: row_desc -> bool
+(* Return whether the row should be treated as fixed or not.
+   In particular, [is_fixed row] implies [row_fixed row].
+*)
+
+val fixed_explanation: row_desc -> fixed_explanation option
+(* Return the potential explanation for the fixed row *)
+
+val merge_fixed_explanation:
+  fixed_explanation option -> fixed_explanation option
+  -> fixed_explanation option
+(* Merge two explanations for a fixed row *)
+
+val static_row: row_desc -> bool
+        (* Return whether the row is static or not *)
+val hash_variant: label -> int
+        (* Hash function for variant tags *)
+
+val proxy: type_expr -> type_expr
+        (* Return the proxy representative of the type: either itself
+           or a row variable *)
+
+(**** Utilities for private abbreviations with fixed rows ****)
+val row_of_type: type_expr -> type_expr
+val has_constr_row: type_expr -> bool
+val is_row_name: string -> bool
+val is_constr_row: allow_ident:bool -> type_expr -> bool
+
+(**** Utilities for type traversal ****)
+
+val iter_type_expr: (type_expr -> unit) -> type_expr -> unit
+        (* Iteration on types *)
+val fold_type_expr: ('a -> type_expr -> 'a) -> 'a -> type_expr -> 'a
+val iter_row: (type_expr -> unit) -> row_desc -> unit
+        (* Iteration on types in a row *)
+val fold_row: ('a -> type_expr -> 'a) -> 'a -> row_desc -> 'a
+val iter_abbrev: (type_expr -> unit) -> abbrev_memo -> unit
+        (* Iteration on types in an abbreviation list *)
+
+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_kind -> unit;
+    it_do_type_expr: type_iterators -> type_expr -> unit;
+    it_type_expr: type_iterators -> type_expr -> unit;
+    it_path: Path.t -> unit; }
+val type_iterators: type_iterators
+        (* Iteration on arbitrary type information.
+           [it_type_expr] calls [mark_type_node] to avoid loops. *)
+val unmark_iterators: type_iterators
+        (* Unmark any structure containing types. See [unmark_type] below. *)
+
+val copy_type_desc:
+    ?keep_names:bool -> (type_expr -> type_expr) -> type_desc -> type_desc
+        (* Copy on types *)
+val copy_row:
+    (type_expr -> type_expr) ->
+    bool -> row_desc -> bool -> type_expr -> row_desc
+val copy_kind: field_kind -> field_kind
+
+module For_copy : sig
+
+  type copy_scope
+        (* The private state that the primitives below are mutating, it should
+           remain scoped within a single [with_scope] call.
+
+           While it is possible to circumvent that discipline in various
+           ways, you should NOT do that. *)
+
+  val save_desc: copy_scope -> type_expr -> type_desc -> unit
+        (* Save a type description *)
+
+  val dup_kind: copy_scope -> field_kind option ref -> unit
+        (* Save a None field_kind, and make it point to a fresh Fvar *)
+
+  val with_scope: (copy_scope -> 'a) -> 'a
+        (* [with_scope f] calls [f] and restores saved type descriptions
+           before returning its result. *)
+end
+
+val lowest_level: int
+        (* Marked type: ty.level < lowest_level *)
+val pivot_level: int
+        (* Type marking: ty.level <- pivot_level - ty.level *)
+val mark_type: type_expr -> unit
+        (* Mark a type *)
+val mark_type_node: type_expr -> unit
+        (* Mark a type node (but not its sons) *)
+val mark_type_params: type_expr -> unit
+        (* Mark the sons of a type node *)
+val unmark_type: type_expr -> unit
+val unmark_type_decl: type_declaration -> unit
+val unmark_extension_constructor: extension_constructor -> unit
+val unmark_class_type: class_type -> unit
+val unmark_class_signature: class_signature -> unit
+        (* Remove marks from a type *)
+
+(**** Memorization of abbreviation expansion ****)
+
+val find_expans: private_flag -> Path.t -> abbrev_memo -> type_expr option
+        (* Look up a memorized abbreviation *)
+val cleanup_abbrev: unit -> unit
+        (* Flush the cache of abbreviation expansions.
+           When some types are saved (using [output_value]), this
+           function MUST be called just before. *)
+val memorize_abbrev:
+        abbrev_memo ref ->
+        private_flag -> Path.t -> type_expr -> type_expr -> unit
+        (* Add an expansion in the cache *)
+val forget_abbrev:
+        abbrev_memo ref -> Path.t -> unit
+        (* Remove an abbreviation from the cache *)
+
+(**** Utilities for labels ****)
+
+val is_optional : arg_label -> bool
+val label_name : arg_label -> label
+
+(* Returns the label name with first character '?' or '~' as appropriate. *)
+val prefixed_label_name : arg_label -> label
+
+val extract_label :
+    label -> (arg_label * 'a) list ->
+    (arg_label * 'a * bool * (arg_label * 'a) list) option
+(* actual label,
+   value,
+   whether (label, value) was at the head of the list,
+   list without the extracted (label, value) *)
+
+(**** Utilities for backtracking ****)
+
+type snapshot
+        (* A snapshot for backtracking *)
+val snapshot: unit -> snapshot
+        (* Make a snapshot for later backtracking. Costs nothing *)
+val backtrack: snapshot -> unit
+        (* Backtrack to a given snapshot. Only possible if you have
+           not already backtracked to a previous snapshot.
+           Calls [cleanup_abbrev] internally *)
+val undo_compress: snapshot -> unit
+        (* Backtrack only path compression. Only meaningful if you have
+           not already backtracked to a previous snapshot.
+           Does not call [cleanup_abbrev] *)
+
+(* Functions to use when modifying a type (only Ctype?) *)
+val link_type: type_expr -> type_expr -> unit
+        (* Set the desc field of [t1] to [Tlink t2], logging the old
+           value if there is an active snapshot *)
+val set_type_desc: type_expr -> type_desc -> unit
+        (* Set directly the desc field, without sharing *)
+val set_level: type_expr -> int -> unit
+val set_scope: type_expr -> int -> unit
+val set_name:
+    (Path.t * type_expr list) option ref ->
+    (Path.t * type_expr list) option -> unit
+val set_row_field: row_field option ref -> row_field -> unit
+val set_univar: type_expr option ref -> type_expr -> unit
+val set_kind: field_kind option ref -> field_kind -> unit
+val set_commu: commutable ref -> commutable -> unit
+val set_typeset: TypeSet.t ref -> TypeSet.t -> unit
+        (* Set references, logging the old value *)
+
+(**** Forward declarations ****)
+val print_raw: (Format.formatter -> type_expr -> unit) ref
+
+val iter_type_expr_kind: (type_expr -> unit) -> (type_kind -> unit)
+
+val iter_type_expr_cstr_args: (type_expr -> unit) ->
+  (constructor_arguments -> unit)
+val map_type_expr_cstr_args: (type_expr -> type_expr) ->
+  (constructor_arguments -> constructor_arguments)
diff --git a/typing/cmt2annot.ml b/typing/cmt2annot.ml
new file mode 100644
index 00000000..40ee752e
--- /dev/null
+++ b/typing/cmt2annot.ml
@@ -0,0 +1,184 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Fabrice Le Fessant, INRIA Saclay                     *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Generate an .annot file from a .cmt file. *)
+
+open Asttypes
+open Typedtree
+open Tast_iterator
+
+let variables_iterator scope =
+  let super = default_iterator in
+  let pat sub (type k) (p : k general_pattern) =
+    begin match p.pat_desc with
+    | Tpat_var (id, _) | Tpat_alias (_, id, _) ->
+        Stypes.record (Stypes.An_ident (p.pat_loc,
+                                        Ident.name id,
+                                        Annot.Idef scope))
+    | _ -> ()
+    end;
+    super.pat sub p
+  in
+  {super with pat}
+
+let bind_variables scope =
+  let iter = variables_iterator scope in
+  fun p -> iter.pat iter p
+
+let bind_bindings scope bindings =
+  let o = bind_variables scope in
+  List.iter (fun x -> o x.vb_pat) bindings
+
+let bind_cases l =
+  List.iter
+    (fun {c_lhs; c_guard; c_rhs} ->
+      let loc =
+        let open Location in
+        match c_guard with
+        | None -> c_rhs.exp_loc
+        | Some g -> {c_rhs.exp_loc with loc_start=g.exp_loc.loc_start}
+      in
+      bind_variables loc c_lhs
+    )
+    l
+
+let record_module_binding scope mb =
+  Stypes.record (Stypes.An_ident
+                   (mb.mb_name.loc,
+                    Option.value mb.mb_name.txt ~default:"_",
+                    Annot.Idef scope))
+
+let rec iterator ~scope rebuild_env =
+  let super = default_iterator in
+  let class_expr sub node =
+    Stypes.record (Stypes.Ti_class node);
+    super.class_expr sub node
+
+  and module_expr _sub node =
+    Stypes.record (Stypes.Ti_mod node);
+    super.module_expr (iterator ~scope:node.mod_loc rebuild_env) node
+
+  and expr sub exp =
+    begin match exp.exp_desc with
+    | Texp_ident (path, _, _) ->
+        let full_name = Path.name ~paren:Oprint.parenthesized_ident path in
+        let env =
+          if rebuild_env then
+            Env.env_of_only_summary Envaux.env_from_summary exp.exp_env
+          else
+            exp.exp_env
+        in
+        let annot =
+          try
+            let desc = Env.find_value path env in
+            let dloc = desc.Types.val_loc in
+            if dloc.Location.loc_ghost then Annot.Iref_external
+            else Annot.Iref_internal dloc
+          with Not_found ->
+            Annot.Iref_external
+        in
+        Stypes.record
+          (Stypes.An_ident (exp.exp_loc, full_name , annot))
+    | Texp_let (Recursive, bindings, _) ->
+        bind_bindings exp.exp_loc bindings
+    | Texp_let (Nonrecursive, bindings, body) ->
+        bind_bindings body.exp_loc bindings
+    | Texp_match (_, f1, _) ->
+        bind_cases f1
+    | Texp_function { cases = f; }
+    | Texp_try (_, f) ->
+        bind_cases f
+    | Texp_letmodule (_, modname, _, _, body ) ->
+        Stypes.record (Stypes.An_ident
+                         (modname.loc,Option.value ~default:"_" modname.txt,
+                          Annot.Idef body.exp_loc))
+    | _ -> ()
+    end;
+    Stypes.record (Stypes.Ti_expr exp);
+    super.expr sub exp
+
+  and pat sub (type k) (p : k general_pattern) =
+    Stypes.record (Stypes.Ti_pat (classify_pattern p, p));
+    super.pat sub p
+  in
+
+  let structure_item_rem sub str rem =
+    let open Location in
+    let loc = str.str_loc in
+    begin match str.str_desc with
+    | Tstr_value (rec_flag, bindings) ->
+        let doit loc_start = bind_bindings {scope with loc_start} bindings in
+        begin match rec_flag, rem with
+        | Recursive, _ -> doit loc.loc_start
+        | Nonrecursive, [] -> doit loc.loc_end
+        | Nonrecursive,  {str_loc = loc2} :: _ -> doit loc2.loc_start
+        end
+    | Tstr_module mb ->
+        record_module_binding
+          { scope with Location.loc_start = loc.loc_end } mb
+    | Tstr_recmodule mbs ->
+        List.iter (record_module_binding
+                   { scope with Location.loc_start = loc.loc_start }) mbs
+    | _ ->
+        ()
+    end;
+    Stypes.record_phrase loc;
+    super.structure_item sub str
+  in
+  let structure_item sub s =
+    (* This will be used for Partial_structure_item.
+       We don't have here the location of the "next" item,
+       this will give a slightly different scope for the non-recursive
+       binding case. *)
+    structure_item_rem sub s []
+  in
+  let structure sub l =
+    let rec loop = function
+      | str :: rem -> structure_item_rem sub str rem; loop rem
+      | [] -> ()
+    in
+    loop l.str_items
+  in
+  {super with class_expr; module_expr; expr; pat; structure_item; structure}
+
+let binary_part iter x =
+  let open Cmt_format in
+  match x with
+  | Partial_structure x -> iter.structure iter x
+  | Partial_structure_item x -> iter.structure_item iter x
+  | Partial_expression x -> iter.expr iter x
+  | Partial_pattern (_, x) -> iter.pat iter x
+  | Partial_class_expr x -> iter.class_expr iter x
+  | Partial_signature x -> iter.signature iter x
+  | Partial_signature_item x -> iter.signature_item iter x
+  | Partial_module_type x -> iter.module_type iter x
+
+let gen_annot target_filename ~sourcefile ~use_summaries annots =
+  let open Cmt_format in
+  let scope =
+    match sourcefile with
+    | None -> Location.none
+    | Some s -> Location.in_file s
+  in
+  let iter = iterator ~scope use_summaries in
+  match annots with
+  | Implementation typedtree ->
+      iter.structure iter typedtree;
+      Stypes.dump target_filename
+  | Partial_implementation parts ->
+      Array.iter (binary_part iter) parts;
+      Stypes.dump target_filename
+  | Interface _ | Packed _ | Partial_interface _ ->
+      ()
diff --git a/typing/ctype.ml b/typing/ctype.ml
new file mode 100644
index 00000000..826b048a
--- /dev/null
+++ b/typing/ctype.ml
@@ -0,0 +1,4846 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Operations on core types *)
+
+open Misc
+open Asttypes
+open Types
+open Btype
+
+(*
+   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
+   =============
+   - As much sharing as possible should be kept : it makes types
+     smaller and better abbreviated.
+     When necessary, some sharing can be lost. Types will still be
+     printed correctly (+++ TO DO...), and abbreviations defined by a
+     class do not depend on sharing thanks to constrained
+     abbreviations. (Of course, even if some sharing is lost, typing
+     will still be correct.)
+   - All nodes of a type have a level : that way, one know whether a
+     node need to be duplicated or not when instantiating a type.
+   - Levels of a type are decreasing (generic level being considered
+     as greatest).
+   - The level of a type constructor is superior to the binding
+     time of its path.
+   - Recursive types without limitation should be handled (even if
+     there is still an occur check). This avoid treating specially the
+     case for objects, for instance. Furthermore, the occur check
+     policy can then be easily changed.
+*)
+
+(**** Errors ****)
+
+module Unification_trace = struct
+
+  type position = First | Second
+  let swap_position = function
+    | First -> Second
+    | Second -> First
+
+  type desc = { t: type_expr; expanded: type_expr option }
+  type 'a diff = { got: 'a; expected: 'a}
+
+  type 'a escape =
+    | Constructor of Path.t
+    | Univ of type_expr
+    (* The type_expr argument of [Univ] is always a [Tunivar _],
+       we keep a [type_expr] to track renaming in {!Printtyp} *)
+    | Self
+    | Module_type of Path.t
+    | Equation of 'a
+
+  type fixed_row_case =
+    | Cannot_be_closed
+    | Cannot_add_tags of string list
+
+  type variant =
+    | No_intersection
+    | No_tags of position * (Asttypes.label * row_field) list
+    | Incompatible_types_for of string
+    | Fixed_row of position * fixed_row_case * fixed_explanation
+
+
+  type obj =
+    | Missing_field of position * string
+    | Abstract_row of position
+    | Self_cannot_be_closed
+
+  type 'a elt =
+    | Diff of 'a diff
+    | Variant of variant
+    | Obj of obj
+    | Escape of {context:type_expr option; kind: 'a escape}
+    | Incompatible_fields of {name:string; diff:type_expr diff }
+    | Rec_occur of type_expr * type_expr
+
+  type t = desc elt list
+  let short t = { t; expanded = None }
+  let map_diff f r =
+    (* ordering is often meaningful when dealing with type_expr *)
+    let got = f r.got in
+    let expected = f r.expected in
+    { got; expected}
+  let diff got expected = Diff (map_diff short {got;expected})
+
+  let map_elt f = function
+    | Diff x -> Diff (map_diff f x)
+    | Escape {kind=Equation x; context} -> Escape {kind=Equation(f x); context}
+    | Rec_occur (_,_)
+    | Escape {kind=(Univ _ | Self|Constructor _ | Module_type _ ); _}
+    | Variant _ | Obj _
+    | Incompatible_fields _ as x -> x
+  let map f = List.map (map_elt f)
+
+
+  (* Convert desc to type_expr * type_expr *)
+  let flatten_desc f x = match x.expanded with
+    | None -> f x.t x.t
+    | Some expanded -> f x.t expanded
+  let flatten f = map (flatten_desc f)
+
+  (* Permute the expected and actual values *)
+  let swap_diff x = { got = x.expected; expected = x.got }
+  let swap_elt = function
+    | Diff x -> Diff (swap_diff x)
+    | Incompatible_fields {name;diff} ->
+        Incompatible_fields { name; diff = swap_diff diff}
+    | Obj (Missing_field(pos,s)) -> Obj(Missing_field(swap_position pos,s))
+    | Obj (Abstract_row pos) -> Obj(Abstract_row (swap_position pos))
+    | Variant (Fixed_row(pos,k,f)) -> Variant (Fixed_row(swap_position pos,k,f))
+    | Variant (No_tags(pos,f)) -> Variant (No_tags(swap_position pos,f))
+    | x -> x
+  let swap x = List.map swap_elt x
+
+  exception Unify of t
+
+  let escape kind =  Escape { kind; context = None}
+  let scope_escape x = Unify[escape (Equation (short x))]
+  let rec_occur x y = Unify[Rec_occur(x, y)]
+  let incompatible_fields name got expected =
+    Incompatible_fields {name; diff={got; expected} }
+
+  let explain trace f =
+    let rec explain = function
+      | [] -> None
+      | [h] -> f ~prev:None h
+      | h :: (prev :: _ as rem) ->
+        match f ~prev:(Some prev) h with
+        | Some _ as m -> m
+        | None -> explain rem in
+    explain (List.rev trace)
+
+end
+module Trace = Unification_trace
+
+exception Unify = Trace.Unify
+
+exception Tags of label * label
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Tags (l, l') ->
+          Some
+            Location.
+              (errorf ~loc:(in_file !input_name)
+                 "In this program,@ variant constructors@ `%s and `%s@ \
+                  have the same hash value.@ Change one of them." l l'
+              )
+      | _ -> None
+    )
+
+exception Subtype of Unification_trace.t * Unification_trace.t
+
+exception Cannot_expand
+
+exception Cannot_apply
+
+(**** Type level management ****)
+
+let current_level = ref 0
+let nongen_level = ref 0
+let global_level = ref 1
+let saved_level = ref []
+
+type levels =
+    { current_level: int; nongen_level: int; global_level: int;
+      saved_level: (int * int) list; }
+let save_levels () =
+  { current_level = !current_level;
+    nongen_level = !nongen_level;
+    global_level = !global_level;
+    saved_level = !saved_level }
+let set_levels l =
+  current_level := l.current_level;
+  nongen_level := l.nongen_level;
+  global_level := l.global_level;
+  saved_level := l.saved_level
+
+let get_current_level () = !current_level
+let init_def level = current_level := level; nongen_level := level
+let begin_def () =
+  saved_level := (!current_level, !nongen_level) :: !saved_level;
+  incr current_level; nongen_level := !current_level
+let begin_class_def () =
+  saved_level := (!current_level, !nongen_level) :: !saved_level;
+  incr current_level
+let raise_nongen_level () =
+  saved_level := (!current_level, !nongen_level) :: !saved_level;
+  nongen_level := !current_level
+let end_def () =
+  let (cl, nl) = List.hd !saved_level in
+  saved_level := List.tl !saved_level;
+  current_level := cl; nongen_level := nl
+let create_scope () =
+  init_def (!current_level + 1);
+  !current_level
+
+let reset_global_level () =
+  global_level := !current_level + 1
+let increase_global_level () =
+  let gl = !global_level in
+  global_level := !current_level;
+  gl
+let restore_global_level gl =
+  global_level := gl
+
+(**** Whether a path points to an object type (with hidden row variable) ****)
+let is_object_type path =
+  let name =
+    match path with Path.Pident id -> Ident.name id
+    | Path.Pdot(_, s) -> s
+    | Path.Papply _ -> assert false
+  in name.[0] = '#'
+
+(**** 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 path tl abbrev =
+  if tl <> [] || !trace_gadt_instances || !Clflags.principal ||
+     is_object_type path
+  then abbrev
+  else simple_abbrevs
+
+(**** Some type creators ****)
+
+(* Re-export generic type creators *)
+
+let newty2             = Btype.newty2
+let newty desc         = newty2 !current_level desc
+
+let newvar ?name ()         = newty2 !current_level (Tvar name)
+let newvar2 ?name level     = newty2 level (Tvar name)
+let new_global_var ?name () = newty2 !global_level (Tvar name)
+
+let newobj fields      = newty (Tobject (fields, ref None))
+
+let newconstr path tyl = newty (Tconstr (path, tyl, ref Mnil))
+
+let none = newty (Ttuple [])                (* Clearly ill-formed type *)
+
+(**** Representative of a type ****)
+
+(* Re-export repr *)
+let repr = repr
+
+(**** Type maps ****)
+
+module TypePairs =
+  Hashtbl.Make (struct
+    type t = type_expr * type_expr
+    let equal (t1, t1') (t2, t2') = (t1 == t2) && (t1' == t2')
+    let hash (t, t') = t.id + 93 * t'.id
+ end)
+
+
+(**** unification mode ****)
+
+type unification_mode =
+  | Expression (* unification in expression *)
+  | Pattern (* unification in pattern which may add local constraints *)
+
+let umode = ref Expression
+let generate_equations = ref false
+let assume_injective = ref false
+
+let set_mode_pattern ~generate ~injective f =
+  Misc.protect_refs
+    [Misc.R (umode, Pattern);
+     Misc.R (generate_equations, generate);
+     Misc.R (assume_injective, injective)] f
+
+(*** Checks for type definitions ***)
+
+let in_current_module = function
+  | Path.Pident _ -> true
+  | Path.Pdot _ | Path.Papply _ -> false
+
+let in_pervasives p =
+  in_current_module p &&
+  try ignore (Env.find_type p Env.initial_safe_string); true
+  with Not_found -> false
+
+let is_datatype decl=
+  match decl.type_kind with
+    Type_record _ | Type_variant _ | Type_open -> true
+  | Type_abstract -> false
+
+
+                  (**********************************************)
+                  (*  Miscellaneous operations on object types  *)
+                  (**********************************************)
+
+(* Note:
+   We need to maintain some invariants:
+   * cty_self must be a Tobject
+   * ...
+*)
+
+(**** Object field manipulation. ****)
+
+let object_fields ty =
+  match (repr ty).desc with
+    Tobject (fields, _) -> fields
+  | _                   -> assert false
+
+let flatten_fields ty =
+  let rec flatten l ty =
+    let ty = repr ty in
+    match ty.desc with
+      Tfield(s, k, ty1, ty2) ->
+        flatten ((s, k, ty1)::l) ty2
+    | _ ->
+        (l, ty)
+  in
+    let (l, r) = flatten [] ty in
+    (List.sort (fun (n, _, _) (n', _, _) -> compare n n') l, r)
+
+let build_fields level =
+  List.fold_right
+    (fun (s, k, ty1) ty2 -> newty2 level (Tfield(s, k, ty1, ty2)))
+
+let associate_fields fields1 fields2 =
+  let rec associate p s s' =
+    function
+      (l, []) ->
+        (List.rev p, (List.rev s) @ l, List.rev s')
+    | ([], l') ->
+        (List.rev p, List.rev s, (List.rev s') @ l')
+    | ((n, k, t)::r, (n', k', t')::r') when n = n' ->
+        associate ((n, k, t, k', t')::p) s s' (r, r')
+    | ((n, k, t)::r, ((n', _k', _t')::_ as l')) when n < n' ->
+        associate p ((n, k, t)::s) s' (r, l')
+    | (((_n, _k, _t)::_ as l), (n', k', t')::r') (* when n > n' *) ->
+        associate p s ((n', k', t')::s') (l, r')
+  in
+  associate [] [] [] (fields1, fields2)
+
+let rec has_dummy_method ty =
+  match repr ty with
+    {desc = Tfield (m, _, _, ty2)} ->
+      m = dummy_method || has_dummy_method ty2
+  | _ -> false
+
+let is_self_type = function
+  | Tobject (ty, _) -> has_dummy_method ty
+  | _ -> false
+
+(**** Check whether an object is open ****)
+
+(* +++ The abbreviation should eventually be expanded *)
+let rec object_row ty =
+  let ty = repr ty in
+  match ty.desc with
+    Tobject (t, _)     -> object_row t
+  | Tfield(_, _, _, t) -> object_row t
+  | _ -> ty
+
+let opened_object ty =
+  match (object_row ty).desc with
+  | Tvar _  | Tunivar _ | Tconstr _ -> true
+  | _                               -> false
+
+let concrete_object ty =
+  match (object_row ty).desc with
+  | Tvar _             -> false
+  | _                  -> true
+
+(**** Close an object ****)
+
+let close_object ty =
+  let rec close ty =
+    let ty = repr ty in
+    match ty.desc with
+      Tvar _ ->
+        link_type ty (newty2 ty.level Tnil); true
+    | Tfield(lab, _, _, _) when lab = dummy_method ->
+        false
+    | Tfield(_, _, _, ty') -> close ty'
+    | _                    -> assert false
+  in
+  match (repr ty).desc with
+    Tobject (ty, _)   -> close ty
+  | _                 -> assert false
+
+(**** Row variable of an object type ****)
+
+let row_variable ty =
+  let rec find ty =
+    let ty = repr ty in
+    match ty.desc with
+      Tfield (_, _, _, ty) -> find ty
+    | Tvar _               -> ty
+    | _                    -> assert false
+  in
+  match (repr ty).desc with
+    Tobject (fi, _) -> find fi
+  | _               -> assert false
+
+(**** Object name manipulation ****)
+(* +++ Bientot obsolete *)
+
+let set_object_name id rv params ty =
+  match (repr ty).desc with
+    Tobject (_fi, nm) ->
+      set_name nm (Some (Path.Pident id, rv::params))
+  | _ ->
+      assert false
+
+let remove_object_name ty =
+  match (repr ty).desc with
+    Tobject (_, nm)   -> set_name nm None
+  | Tconstr (_, _, _) -> ()
+  | _                 -> fatal_error "Ctype.remove_object_name"
+
+(**** Hiding of private methods ****)
+
+let hide_private_methods ty =
+  match (repr ty).desc with
+    Tobject (fi, nm) ->
+      nm := None;
+      let (fl, _) = flatten_fields fi in
+      List.iter
+        (function (_, k, _) ->
+          match field_kind_repr k with
+            Fvar r -> set_kind r Fabsent
+          | _      -> ())
+        fl
+  | _ ->
+      assert false
+
+
+                              (*******************************)
+                              (*  Operations on class types  *)
+                              (*******************************)
+
+
+let rec signature_of_class_type =
+  function
+    Cty_constr (_, _, cty) -> signature_of_class_type cty
+  | Cty_signature sign     -> sign
+  | Cty_arrow (_, _, cty)   -> signature_of_class_type cty
+
+let self_type cty =
+  repr (signature_of_class_type cty).csig_self
+
+let rec class_type_arity =
+  function
+    Cty_constr (_, _, cty) ->  class_type_arity cty
+  | Cty_signature _        ->  0
+  | Cty_arrow (_, _, cty)    ->  1 + class_type_arity cty
+
+
+                  (*******************************************)
+                  (*  Miscellaneous operations on row types  *)
+                  (*******************************************)
+
+let sort_row_fields = List.sort (fun (p,_) (q,_) -> compare p q)
+
+let rec merge_rf r1 r2 pairs fi1 fi2 =
+  match fi1, fi2 with
+    (l1,f1 as p1)::fi1', (l2,f2 as p2)::fi2' ->
+      if l1 = l2 then merge_rf r1 r2 ((l1,f1,f2)::pairs) fi1' fi2' else
+      if l1 < l2 then merge_rf (p1::r1) r2 pairs fi1' fi2 else
+      merge_rf r1 (p2::r2) pairs fi1 fi2'
+  | [], _ -> (List.rev r1, List.rev_append r2 fi2, pairs)
+  | _, [] -> (List.rev_append r1 fi1, List.rev r2, pairs)
+
+let merge_row_fields fi1 fi2 =
+  match fi1, fi2 with
+    [], _ | _, [] -> (fi1, fi2, [])
+  | [p1], _ when not (List.mem_assoc (fst p1) fi2) -> (fi1, fi2, [])
+  | _, [p2] when not (List.mem_assoc (fst p2) fi1) -> (fi1, fi2, [])
+  | _ -> merge_rf [] [] [] (sort_row_fields fi1) (sort_row_fields fi2)
+
+let rec filter_row_fields erase = function
+    [] -> []
+  | (_l,f as p)::fi ->
+      let fi = filter_row_fields erase fi in
+      match row_field_repr f with
+        Rabsent -> fi
+      | Reither(_,_,false,e) when erase -> set_row_field e Rabsent; fi
+      | _ -> p :: fi
+
+                    (**************************************)
+                    (*  Check genericity of type schemes  *)
+                    (**************************************)
+
+
+exception Non_closed of type_expr * bool
+
+let free_variables = ref []
+let really_closed = ref None
+
+(* [free_vars_rec] collects the variables of the input type
+   expression into the [free_variables] reference. It is used for
+   several different things in the type-checker, with the following
+   bells and whistles:
+   - If [really_closed] 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 boolean
+     that is [true] if we have a row variable.
+   - 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).
+
+   The functions [free_vars] and [free_variables] below receive
+   a typing environment as an optional [?env] parameter and
+   set [really_closed] accordingly.
+   [free_vars] returns a [(variable * bool) list], while
+   [free_variables] drops the type/row information
+   and only returns a [variable list].
+ *)
+let rec free_vars_rec real ty =
+  let ty = repr ty in
+  if ty.level >= lowest_level then begin
+    ty.level <- pivot_level - ty.level;
+    begin match ty.desc, !really_closed with
+      Tvar _, _ ->
+        free_variables := (ty, real) :: !free_variables
+    | Tconstr (path, tl, _), Some env ->
+        begin try
+          let (_, body, _) = Env.find_type_expansion path env in
+          if (repr body).level <> generic_level then
+            free_variables := (ty, real) :: !free_variables
+        with Not_found -> ()
+        end;
+        List.iter (free_vars_rec true) tl
+(* Do not count "virtual" free variables
+    | Tobject(ty, {contents = Some (_, p)}) ->
+        free_vars_rec false ty; List.iter (free_vars_rec true) p
+*)
+    | Tobject (ty, _), _ ->
+        free_vars_rec false ty
+    | Tfield (_, _, ty1, ty2), _ ->
+        free_vars_rec true ty1; free_vars_rec false ty2
+    | Tvariant row, _ ->
+        let row = row_repr row in
+        iter_row (free_vars_rec true) row;
+        if not (static_row row) then free_vars_rec false row.row_more
+    | _    ->
+        iter_type_expr (free_vars_rec true) ty
+    end;
+  end
+
+let free_vars ?env ty =
+  free_variables := [];
+  really_closed := env;
+  free_vars_rec true ty;
+  let res = !free_variables in
+  free_variables := [];
+  really_closed := None;
+  res
+
+let free_variables ?env ty =
+  let tl = List.map fst (free_vars ?env ty) in
+  unmark_type ty;
+  tl
+
+let closed_type ty =
+  match free_vars ty with
+      []           -> ()
+  | (v, real) :: _ -> raise (Non_closed (v, real))
+
+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
+
+let closed_type_decl decl =
+  try
+    List.iter mark_type decl.type_params;
+    begin match decl.type_kind with
+      Type_abstract ->
+        ()
+    | Type_variant v ->
+        List.iter
+          (fun {cd_args; cd_res; _} ->
+            match cd_res with
+            | 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
+          )
+          v
+    | Type_record(r, _rep) ->
+        List.iter (fun l -> closed_type l.ld_type) r
+    | Type_open -> ()
+    end;
+    begin match decl.type_manifest with
+      None    -> ()
+    | Some ty -> closed_type ty
+    end;
+    unmark_type_decl decl;
+    None
+  with Non_closed (ty, _) ->
+    unmark_type_decl decl;
+    Some ty
+
+let closed_extension_constructor ext =
+  try
+    List.iter mark_type ext.ext_type_params;
+    begin match ext.ext_ret_type with
+    | Some _ -> ()
+    | None -> iter_type_expr_cstr_args closed_type ext.ext_args
+    end;
+    unmark_extension_constructor ext;
+    None
+  with Non_closed (ty, _) ->
+    unmark_extension_constructor ext;
+    Some ty
+
+type closed_class_failure =
+    CC_Method of type_expr * bool * string * type_expr
+  | CC_Value of type_expr * bool * string * type_expr
+
+exception CCFailure of closed_class_failure
+
+let closed_class params sign =
+  let ty = object_fields (repr sign.csig_self) in
+  let (fields, rest) = flatten_fields ty in
+  List.iter mark_type params;
+  mark_type rest;
+  List.iter
+    (fun (lab, _, ty) -> if lab = dummy_method then mark_type ty)
+    fields;
+  try
+    mark_type_node (repr sign.csig_self);
+    List.iter
+      (fun (lab, kind, ty) ->
+        if field_kind_repr kind = Fpresent then
+        try closed_type ty with Non_closed (ty0, real) ->
+          raise (CCFailure (CC_Method (ty0, real, lab, ty))))
+      fields;
+    mark_type_params (repr sign.csig_self);
+    List.iter unmark_type params;
+    unmark_class_signature sign;
+    None
+  with CCFailure reason ->
+    mark_type_params (repr sign.csig_self);
+    List.iter unmark_type params;
+    unmark_class_signature sign;
+    Some reason
+
+
+                            (**********************)
+                            (*  Type duplication  *)
+                            (**********************)
+
+
+(* Duplicate a type, preserving only type variables *)
+let duplicate_type ty =
+  Subst.type_expr Subst.identity ty
+
+(* Same, for class types *)
+let duplicate_class_type ty =
+  Subst.class_type Subst.identity 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 ty = repr ty in
+  if (ty.level > !current_level) && (ty.level <> generic_level) then begin
+    set_level ty generic_level;
+    begin match ty.desc 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 var_level ty =
+  let ty = repr ty in
+  if ty.level <> generic_level then begin
+    if is_Tvar ty && ty.level > var_level then
+      set_level ty var_level
+    else if
+      ty.level > !current_level &&
+      match ty.desc with
+        Tconstr (p, _, abbrev) ->
+          not (is_object_type p) && (abbrev := Mnil; true)
+      | _ -> true
+    then begin
+      set_level ty generic_level;
+      iter_type_expr (generalize_structure var_level) ty
+    end
+  end
+
+let generalize_structure ty =
+  simple_abbrevs := Mnil;
+  generalize_structure !current_level ty
+
+(* Generalize the spine of a function, if the level >= !current_level *)
+
+let rec generalize_spine ty =
+  let ty = repr ty in
+  if ty.level < !current_level || ty.level = generic_level then () else
+  match ty.desc 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
+  | Tpackage (_, _, tyl) ->
+      set_level ty generic_level;
+      List.iter generalize_spine tyl
+  | Tconstr (p, tyl, memo) when not (is_object_type p) ->
+      set_level ty generic_level;
+      memo := Mnil;
+      List.iter generalize_spine tyl
+  | _ -> ()
+
+let forward_try_expand_once = (* Forward declaration *)
+  ref (fun _env _ty -> raise Cannot_expand)
+
+(*
+   Lower the levels of a type (assume [level] is not
+   [generic_level]).
+*)
+
+let rec normalize_package_path env p =
+  let t =
+    try (Env.find_modtype p env).mtd_type
+    with Not_found -> None
+  in
+  match t with
+  | Some (Mty_ident p) -> normalize_package_path env p
+  | Some (Mty_signature _ | Mty_functor _ | Mty_alias _) | None ->
+      match p with
+        Path.Pdot (p1, s) ->
+          (* For module aliases *)
+          let p1' = Env.normalize_module_path None env p1 in
+          if Path.same p1 p1' then p else
+          normalize_package_path env (Path.Pdot (p1', s))
+      | _ -> p
+
+let check_scope_escape env level ty =
+  let rec loop ty =
+    let ty = repr ty in
+    if ty.level >= lowest_level then begin
+      ty.level <- pivot_level - ty.level;
+      if level < ty.scope then
+        raise(Trace.scope_escape ty);
+      begin match ty.desc with
+      | Tconstr (p, _, _) when level < Path.scope p ->
+          begin match !forward_try_expand_once env ty with
+          | ty' -> aux ty'
+          | exception Cannot_expand ->
+              raise Trace.(Unify [escape (Constructor p)])
+          end
+      | Tpackage (p, nl, tl) when level < Path.scope p ->
+          let p' = normalize_package_path env p in
+          if Path.same p p' then raise Trace.(Unify [escape (Module_type p)]);
+          aux { ty with desc = Tpackage (p', nl, tl) }
+      | _ ->
+        iter_type_expr loop ty
+      end;
+    end
+  and aux ty =
+    loop ty;
+    unmark_type ty
+  in
+  try aux ty;
+  with Unify [Trace.Escape x] ->
+    raise Trace.(Unify[Escape { x with context = Some ty }])
+
+let update_scope scope ty =
+  let ty = repr ty in
+  let scope = max scope ty.scope in
+  if ty.level < scope then raise (Trace.scope_escape ty);
+  set_scope ty scope
+
+(* Note: the level of a type constructor must be greater than its binding
+    time. That way, a type constructor cannot escape the scope of its
+    definition, as would be the case in
+      let x = ref []
+      module M = struct type t let _ = (x : t list ref) end
+    (without this constraint, the type system would actually be unsound.)
+*)
+
+let rec update_level env level expand ty =
+  let ty = repr ty in
+  if ty.level > level then begin
+    if level < ty.scope then raise (Trace.scope_escape ty);
+    match ty.desc with
+      Tconstr(p, _tl, _abbrev) when level < Path.scope p ->
+        (* Try first to replace an abbreviation by its expansion. *)
+        begin try
+          link_type ty (!forward_try_expand_once env ty);
+          update_level env level expand ty
+        with Cannot_expand ->
+          raise Trace.(Unify [escape(Constructor p)])
+        end
+    | Tconstr(p, (_ :: _ as tl), _) ->
+        let variance =
+          try (Env.find_type p env).type_variance
+          with Not_found -> List.map (fun _ -> Variance.may_inv) tl in
+        let needs_expand =
+          expand ||
+          List.exists2
+            (fun var ty -> var = Variance.null && (repr ty).level > level)
+            variance tl
+        in
+        begin try
+          if not needs_expand then raise Cannot_expand;
+          link_type ty (!forward_try_expand_once env ty);
+          update_level env level expand ty
+        with Cannot_expand ->
+          set_level ty level;
+          iter_type_expr (update_level env level expand) ty
+        end
+    | Tpackage (p, nl, tl) when level < Path.scope p ->
+        let p' = normalize_package_path env p in
+        if Path.same p p' then raise Trace.(Unify [escape (Module_type p)]);
+        set_type_desc ty (Tpackage (p', nl, tl));
+        update_level env level expand ty
+    | Tobject(_, ({contents=Some(p, _tl)} as nm))
+      when level < Path.scope p ->
+        set_name nm None;
+        update_level env level expand ty
+    | Tvariant row ->
+        let row = row_repr row in
+        begin match row.row_name with
+        | Some (p, _tl) when level < Path.scope p ->
+            set_type_desc ty (Tvariant {row with row_name = None})
+        | _ -> ()
+        end;
+        set_level ty level;
+        iter_type_expr (update_level env level expand) ty
+    | Tfield(lab, _, ty1, _)
+      when lab = dummy_method && (repr ty1).level > level ->
+        raise Trace.(Unify [escape Self])
+    | _ ->
+        set_level ty level;
+        (* XXX what about abbreviations in Tconstr ? *)
+        iter_type_expr (update_level env level expand) ty
+  end
+
+(* First try without expanding, then expand everything,
+   to avoid combinatorial blow-up *)
+let update_level env level ty =
+  let ty = repr ty in
+  if ty.level > level then begin
+    let snap = snapshot () in
+    try
+      update_level env level false ty
+    with Unify _ ->
+      backtrack snap;
+      update_level env level true ty
+  end
+
+(* Lower level of type variables inside contravariant branches *)
+
+let rec lower_contravariant env var_level visited contra ty =
+  let ty = repr ty in
+  let must_visit =
+    ty.level > var_level &&
+    match Hashtbl.find visited ty.id with
+    | done_contra -> contra && not done_contra
+    | exception Not_found -> true
+  in
+  if must_visit then begin
+    Hashtbl.add visited ty.id contra;
+    let lower_rec = lower_contravariant env var_level visited in
+    match ty.desc with
+      Tvar _ -> if contra then set_level ty var_level
+    | Tconstr (_, [], _) -> ()
+    | Tconstr (path, tyl, _abbrev) ->
+       let variance, maybe_expand =
+         try
+           let typ = Env.find_type path env in
+           typ.type_variance,
+           typ.type_kind = Type_abstract
+          with Not_found ->
+            (* See testsuite/tests/typing-missing-cmi-2 for an example *)
+            List.map (fun _ -> Variance.may_inv) tyl,
+            false
+        in
+        if List.for_all ((=) Variance.null) variance then () else
+          let not_expanded () =
+            List.iter2
+              (fun v t ->
+                if v = Variance.null then () else
+                  if Variance.(mem May_weak v)
+                  then lower_rec true t
+                  else lower_rec contra t)
+              variance tyl in
+          if maybe_expand then (* we expand cautiously to avoid missing cmis *)
+            match !forward_try_expand_once env ty with
+            | ty -> lower_rec contra ty
+            | exception Cannot_expand -> not_expanded ()
+          else not_expanded ()
+    | Tpackage (_, _, tyl) ->
+        List.iter (lower_rec true) tyl
+    | Tarrow (_, t1, t2, _) ->
+        lower_rec true t1;
+        lower_rec contra t2
+    | _ ->
+        iter_type_expr (lower_rec contra) ty
+  end
+
+let lower_contravariant env ty =
+  simple_abbrevs := Mnil;
+  lower_contravariant env !nongen_level (Hashtbl.create 7) false ty
+
+(* Correct the levels of type [ty]. *)
+let correct_levels ty =
+  duplicate_type ty
+
+(* Only generalize the type ty0 in ty *)
+let limited_generalize ty0 ty =
+  let ty0 = repr ty0 in
+
+  let graph = Hashtbl.create 17 in
+  let idx = ref lowest_level in
+  let roots = ref [] in
+
+  let rec inverse pty ty =
+    let ty = repr ty in
+    if (ty.level > !current_level) || (ty.level = generic_level) then begin
+      decr idx;
+      Hashtbl.add graph !idx (ty, ref pty);
+      if (ty.level = generic_level) || (ty == ty0) then
+        roots := ty :: !roots;
+      set_level ty !idx;
+      iter_type_expr (inverse [ty]) ty
+    end else if ty.level < lowest_level then begin
+      let (_, parents) = Hashtbl.find graph ty.level in
+      parents := pty @ !parents
+    end
+
+  and generalize_parents ty =
+    let idx = ty.level in
+    if idx <> generic_level then begin
+      set_level ty generic_level;
+      List.iter generalize_parents !(snd (Hashtbl.find graph idx));
+      (* Special case for rows: must generalize the row variable *)
+      match ty.desc with
+        Tvariant row ->
+          let more = row_more row in
+          let lv = more.level in
+          if (lv < lowest_level || lv > !current_level)
+          && lv <> generic_level then set_level more generic_level
+      | _ -> ()
+    end
+  in
+
+  inverse [] ty;
+  if ty0.level < lowest_level then
+    iter_type_expr (inverse []) ty0;
+  List.iter generalize_parents !roots;
+  Hashtbl.iter
+    (fun _ (ty, _) ->
+       if ty.level <> generic_level then set_level ty !current_level)
+    graph
+
+
+(* Compute statically the free univars of all nodes in a type *)
+(* This avoids doing it repeatedly during instantiation *)
+
+type inv_type_expr =
+    { inv_type : type_expr;
+      mutable inv_parents : inv_type_expr list }
+
+let rec inv_type hash pty ty =
+  let ty = repr ty in
+  try
+    let inv = TypeHash.find hash ty in
+    inv.inv_parents <- pty @ inv.inv_parents
+  with Not_found ->
+    let inv = { inv_type = ty; inv_parents = pty } in
+    TypeHash.add hash ty inv;
+    iter_type_expr (inv_type hash [inv]) ty
+
+let compute_univars ty =
+  let inverted = TypeHash.create 17 in
+  inv_type inverted [] ty;
+  let node_univars = TypeHash.create 17 in
+  let rec add_univar univ inv =
+    match inv.inv_type.desc with
+      Tpoly (_ty, tl) when List.memq univ (List.map repr tl) -> ()
+    | _ ->
+        try
+          let univs = TypeHash.find node_univars inv.inv_type in
+          if not (TypeSet.mem univ !univs) then begin
+            univs := TypeSet.add univ !univs;
+            List.iter (add_univar univ) inv.inv_parents
+          end
+        with Not_found ->
+          TypeHash.add node_univars inv.inv_type (ref(TypeSet.singleton univ));
+          List.iter (add_univar univ) inv.inv_parents
+  in
+  TypeHash.iter (fun ty inv -> if is_Tunivar ty then add_univar ty inv)
+    inverted;
+  fun ty ->
+    try !(TypeHash.find node_univars ty) with Not_found -> TypeSet.empty
+
+
+                              (*******************)
+                              (*  Instantiation  *)
+                              (*******************)
+
+
+let rec find_repr p1 =
+  function
+    Mnil ->
+      None
+  | Mcons (Public, p2, ty, _, _) when Path.same p1 p2 ->
+      Some ty
+  | Mcons (_, _, _, _, rem) ->
+      find_repr p1 rem
+  | Mlink {contents = rem} ->
+      find_repr p1 rem
+
+(*
+   Generic nodes are duplicated, while non-generic nodes are left
+   as-is.
+   During instantiation, the description of a generic node is first
+   replaced by a link to a stub ([Tsubst (newvar ())]). Once the
+   copy is made, it replaces the stub.
+   After instantiation, the description of generic node, which was
+   stored by [save_desc], must be put back, using [cleanup_types].
+*)
+
+let abbreviations = ref (ref Mnil)
+  (* Abbreviation memorized. *)
+
+(* partial: we may not wish to copy the non generic types
+   before we call type_pat *)
+let rec copy ?partial ?keep_names scope ty =
+  let copy = copy ?partial ?keep_names scope in
+  let ty = repr ty in
+  match ty.desc with
+    Tsubst ty -> ty
+  | _ ->
+    if ty.level <> generic_level && partial = None then ty else
+    (* We only forget types that are non generic and do not contain
+       free univars *)
+    let forget =
+      if ty.level = generic_level then generic_level else
+      match partial with
+        None -> assert false
+      | Some (free_univars, keep) ->
+          if TypeSet.is_empty (free_univars ty) then
+            if keep then ty.level else !current_level
+          else generic_level
+    in
+    if forget <> generic_level then newty2 forget (Tvar None) else
+    let desc = ty.desc in
+    For_copy.save_desc scope ty desc;
+    let t = newvar() in          (* Stub *)
+    set_scope t ty.scope;
+    ty.desc <- Tsubst t;
+    t.desc <-
+      begin match desc with
+      | Tconstr (p, tl, _) ->
+          let abbrevs = proper_abbrevs p tl !abbreviations in
+          begin match find_repr p !abbrevs with
+            Some ty when repr ty != t ->
+              Tlink ty
+          | _ ->
+          (*
+             One must allocate a new reference, so that abbrevia-
+             tions belonging to different branches of a type are
+             independent.
+             Moreover, a reference containing a [Mcons] must be
+             shared, so that the memorized expansion of an abbrevi-
+             ation can be released by changing the content of just
+             one reference.
+          *)
+              Tconstr (p, List.map copy tl,
+                       ref (match !(!abbreviations) with
+                              Mcons _ -> Mlink !abbreviations
+                            | abbrev  -> abbrev))
+          end
+      | Tvariant row0 ->
+          let row = row_repr row0 in
+          let more = repr row.row_more in
+          (* We must substitute in a subtle way *)
+          (* Tsubst takes a tuple containing the row var and the variant *)
+          begin match more.desc with
+            Tsubst {desc = Ttuple [_;ty2]} ->
+              (* This variant type has been already copied *)
+              ty.desc <- Tsubst ty2; (* avoid Tlink in the new type *)
+              Tlink ty2
+          | _ ->
+              (* If the row variable is not generic, we must keep it *)
+              let keep = more.level <> generic_level && partial = None in
+              let more' =
+                match more.desc with
+                  Tsubst ty -> ty
+                | Tconstr _ | Tnil ->
+                    For_copy.save_desc scope more more.desc;
+                    copy more
+                | Tvar _ | Tunivar _ ->
+                    For_copy.save_desc scope more more.desc;
+                    if keep then more else newty more.desc
+                |  _ -> assert false
+              in
+              let row =
+                match repr more' with (* PR#6163 *)
+                  {desc=Tconstr (x,_,_)} when not (is_fixed row) ->
+                    {row with row_fixed = Some (Reified x)}
+                | _ -> row
+              in
+              (* Open row if partial for pattern and contains Reither *)
+              let more', row =
+                match partial with
+                  Some (free_univars, false) ->
+                    let more' =
+                      if more.id != more'.id then more' else
+                      let lv = if keep then more.level else !current_level in
+                      newty2 lv (Tvar None)
+                    in
+                    let not_reither (_, f) =
+                      match row_field_repr f with
+                        Reither _ -> false
+                      | _ -> true
+                    in
+                    if row.row_closed && not (is_fixed row)
+                    && TypeSet.is_empty (free_univars ty)
+                    && not (List.for_all not_reither row.row_fields) then
+                      (more',
+                       {row_fields = List.filter not_reither row.row_fields;
+                        row_more = more'; row_bound = ();
+                        row_closed = false; row_fixed = None; row_name = None})
+                    else (more', row)
+                | _ -> (more', row)
+              in
+              (* Register new type first for recursion *)
+              more.desc <- Tsubst(newgenty(Ttuple[more';t]));
+              (* Return a new copy *)
+              Tvariant (copy_row copy true row keep more')
+          end
+      | Tfield (_p, k, _ty1, ty2) ->
+          begin match field_kind_repr k with
+            Fabsent  -> Tlink (copy ty2)
+          | Fpresent -> copy_type_desc copy desc
+          | Fvar r ->
+              For_copy.dup_kind scope r;
+              copy_type_desc copy desc
+          end
+      | Tobject (ty1, _) when partial <> None ->
+          Tobject (copy ty1, ref None)
+      | _ -> copy_type_desc ?keep_names copy desc
+      end;
+    t
+
+(**** Variants of instantiations ****)
+
+let instance ?partial sch =
+  let partial =
+    match partial with
+      None -> None
+    | Some keep -> Some (compute_univars sch, keep)
+  in
+  For_copy.with_scope (fun scope -> copy ?partial scope sch)
+
+let generic_instance sch =
+  let old = !current_level in
+  current_level := generic_level;
+  let ty = instance sch in
+  current_level := old;
+  ty
+
+let instance_list schl =
+  For_copy.with_scope (fun scope -> List.map (fun t -> copy scope t) schl)
+
+let reified_var_counter = ref Vars.empty
+let reset_reified_var_counter () =
+  reified_var_counter := Vars.empty
+
+(* names given to new type constructors.
+   Used for existential types and
+   local constraints *)
+let get_new_abstract_name s =
+  let index =
+    try Vars.find s !reified_var_counter + 1
+    with Not_found -> 0 in
+  reified_var_counter := Vars.add s index !reified_var_counter;
+  if index = 0 && s <> "" && s.[String.length s - 1] <> '$' then s else
+  Printf.sprintf "%s%d" s index
+
+let new_declaration expansion_scope manifest =
+  {
+    type_params = [];
+    type_arity = 0;
+    type_kind = Type_abstract;
+    type_private = Public;
+    type_manifest = manifest;
+    type_variance = [];
+    type_separability = [];
+    type_is_newtype = true;
+    type_expansion_scope = expansion_scope;
+    type_loc = Location.none;
+    type_attributes = [];
+    type_immediate = Unknown;
+    type_unboxed = unboxed_false_default_false;
+    type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+  }
+
+let existential_name cstr ty = match repr ty with
+  | {desc = Tvar (Some name)} -> "$" ^ cstr.cstr_name ^ "_'" ^ name
+  | _ -> "$" ^ cstr.cstr_name
+
+let instance_constructor ?in_pattern cstr =
+  For_copy.with_scope (fun scope ->
+    begin match in_pattern with
+    | None -> ()
+    | Some (env, expansion_scope) ->
+        let process existential =
+          let decl = new_declaration expansion_scope None in
+          let name = existential_name cstr existential in
+          let path =
+            Path.Pident
+              (Ident.create_scoped ~scope:expansion_scope
+                 (get_new_abstract_name name))
+          in
+          let new_env = Env.add_local_type path decl !env in
+          env := new_env;
+          let to_unify = newty (Tconstr (path,[],ref Mnil)) in
+          let tv = copy scope existential in
+          assert (is_Tvar tv);
+          link_type tv to_unify
+        in
+        List.iter process cstr.cstr_existentials
+    end;
+    let ty_res = copy scope cstr.cstr_res in
+    let ty_args = List.map (copy scope) cstr.cstr_args in
+    (ty_args, ty_res)
+  )
+
+let instance_parameterized_type ?keep_names sch_args sch =
+  For_copy.with_scope (fun scope ->
+    let ty_args = List.map (fun t -> copy ?keep_names scope t) sch_args in
+    let ty = copy scope sch in
+    (ty_args, ty)
+  )
+
+let instance_parameterized_type_2 sch_args sch_lst sch =
+  For_copy.with_scope (fun scope ->
+    let ty_args = List.map (copy scope) sch_args in
+    let ty_lst = List.map (copy scope) sch_lst in
+    let ty = copy scope sch in
+    (ty_args, ty_lst, ty)
+  )
+
+let map_kind f = function
+  | Type_abstract -> Type_abstract
+  | Type_open -> Type_open
+  | Type_variant cl ->
+      Type_variant (
+        List.map
+          (fun c ->
+             {c with
+              cd_args = map_type_expr_cstr_args f c.cd_args;
+              cd_res = Option.map f c.cd_res
+             })
+          cl)
+  | Type_record (fl, rr) ->
+      Type_record (
+        List.map
+          (fun l ->
+             {l with ld_type = f l.ld_type}
+          ) fl, rr)
+
+
+let instance_declaration decl =
+  For_copy.with_scope (fun scope ->
+    {decl with type_params = List.map (copy scope) decl.type_params;
+     type_manifest = Option.map (copy scope) decl.type_manifest;
+     type_kind = map_kind (copy scope) decl.type_kind;
+    }
+  )
+
+let generic_instance_declaration decl =
+  let old = !current_level in
+  current_level := generic_level;
+  let decl = instance_declaration decl in
+  current_level := old;
+  decl
+
+let instance_class params cty =
+  let rec copy_class_type scope = function
+    | Cty_constr (path, tyl, cty) ->
+        let tyl' = List.map (copy scope) tyl in
+        let cty' = copy_class_type scope cty in
+        Cty_constr (path, tyl', cty')
+    | Cty_signature sign ->
+        Cty_signature
+          {csig_self = copy scope sign.csig_self;
+           csig_vars =
+             Vars.map (function (m, v, ty) -> (m, v, copy scope ty))
+               sign.csig_vars;
+           csig_concr = sign.csig_concr;
+           csig_inher =
+             List.map (fun (p,tl) -> (p, List.map (copy scope) tl))
+               sign.csig_inher}
+    | Cty_arrow (l, ty, cty) ->
+        Cty_arrow (l, copy scope ty, copy_class_type scope cty)
+  in
+  For_copy.with_scope (fun scope ->
+    let params' = List.map (copy scope) params in
+    let cty' = copy_class_type scope cty in
+    (params', cty')
+  )
+
+(**** Instantiation for types with free universal variables ****)
+
+let rec diff_list l1 l2 =
+  if l1 == l2 then [] else
+  match l1 with [] -> invalid_arg "Ctype.diff_list"
+  | a :: l1 -> a :: diff_list l1 l2
+
+let conflicts free bound =
+  let bound = List.map repr bound in
+  TypeSet.exists (fun t -> List.memq (repr t) bound) free
+
+let delayed_copy = ref []
+    (* copying to do later *)
+
+(* Copy without sharing until there are no free univars left *)
+(* all free univars must be included in [visited]            *)
+let rec copy_sep cleanup_scope fixed free bound visited ty =
+  let ty = repr ty in
+  let univars = free ty in
+  if TypeSet.is_empty univars then
+    if ty.level <> generic_level then ty else
+    let t = newvar () in
+    delayed_copy :=
+      lazy (t.desc <- Tlink (copy cleanup_scope ty))
+      :: !delayed_copy;
+    t
+  else try
+    let t, bound_t = List.assq ty visited in
+    let dl = if is_Tunivar ty then [] else diff_list bound bound_t in
+    if dl <> [] && conflicts univars dl then raise Not_found;
+    t
+  with Not_found -> begin
+    let t = newvar() in          (* Stub *)
+    let visited =
+      match ty.desc with
+        Tarrow _ | Ttuple _ | Tvariant _ | Tconstr _ | Tobject _ | Tpackage _ ->
+          (ty,(t,bound)) :: visited
+      | Tvar _ | Tfield _ | Tnil | Tpoly _ | Tunivar _ | Tlink _ | Tsubst _ ->
+          visited
+    in
+    let copy_rec = copy_sep cleanup_scope fixed free bound visited in
+    t.desc <-
+      begin match ty.desc with
+      | Tvariant row0 ->
+          let row = row_repr row0 in
+          let more = repr row.row_more in
+          (* We shall really check the level on the row variable *)
+          let keep = is_Tvar more && more.level <> generic_level in
+          let more' = copy_rec more in
+          let fixed' = fixed && (is_Tvar more || is_Tunivar more) in
+          let row = copy_row copy_rec fixed' row keep more' in
+          Tvariant row
+      | Tpoly (t1, tl) ->
+          let tl = List.map repr tl in
+          let tl' = List.map (fun t -> newty t.desc) tl in
+          let bound = tl @ bound in
+          let visited =
+            List.map2 (fun ty t -> ty,(t,bound)) tl tl' @ visited in
+          Tpoly (copy_sep cleanup_scope fixed free bound visited t1, tl')
+      | _ -> copy_type_desc copy_rec ty.desc
+      end;
+    t
+  end
+
+let instance_poly' cleanup_scope ~keep_names fixed univars sch =
+  let univars = List.map repr univars in
+  let copy_var ty =
+    match ty.desc with
+      Tunivar name -> if keep_names then newty (Tvar name) else newvar ()
+    | _ -> assert false
+  in
+  let vars = List.map copy_var univars in
+  let pairs = List.map2 (fun u v -> u, (v, [])) univars vars in
+  delayed_copy := [];
+  let ty = copy_sep cleanup_scope fixed (compute_univars sch) [] pairs sch in
+  List.iter Lazy.force !delayed_copy;
+  delayed_copy := [];
+  vars, ty
+
+let instance_poly ?(keep_names=false) fixed univars sch =
+  For_copy.with_scope (fun cleanup_scope ->
+    instance_poly' cleanup_scope ~keep_names fixed univars sch
+  )
+
+let instance_label fixed lbl =
+  For_copy.with_scope (fun scope ->
+    let ty_res = copy scope lbl.lbl_res in
+    let vars, ty_arg =
+      match repr lbl.lbl_arg with
+        {desc = Tpoly (ty, tl)} ->
+          instance_poly' scope ~keep_names:false fixed tl ty
+      | _ ->
+          [], copy scope lbl.lbl_arg
+    in
+    (vars, ty_arg, ty_res)
+  )
+
+(**** Instantiation with parameter substitution ****)
+
+let unify' = (* Forward declaration *)
+  ref (fun _env _ty1 _ty2 -> raise (Unify []))
+
+let subst env level priv abbrev ty params args body =
+  if List.length params <> List.length args then raise (Unify []);
+  let old_level = !current_level in
+  current_level := level;
+  try
+    let body0 = newvar () in          (* Stub *)
+    begin match ty with
+      None      -> ()
+    | Some ({desc = Tconstr (path, tl, _)} as ty) ->
+        let abbrev = proper_abbrevs path tl abbrev in
+        memorize_abbrev abbrev priv path ty body0
+    | _ ->
+        assert false
+    end;
+    abbreviations := abbrev;
+    let (params', body') = instance_parameterized_type params body in
+    abbreviations := ref Mnil;
+    !unify' env body0 body';
+    List.iter2 (!unify' env) params' args;
+    current_level := old_level;
+    body'
+  with Unify _ as exn ->
+    current_level := old_level;
+    raise exn
+
+(*
+   Only the shape of the type matters, not whether it is generic or
+   not. [generic_level] might be somewhat slower, but it ensures
+   invariants on types are enforced (decreasing levels), and we don't
+   care about efficiency here.
+*)
+let apply env params body args =
+  try
+    subst env generic_level Public (ref Mnil) None params args body
+  with
+    Unify _ -> raise Cannot_apply
+
+let () = Subst.ctype_apply_env_empty := apply Env.empty
+
+                              (****************************)
+                              (*  Abbreviation expansion  *)
+                              (****************************)
+
+(*
+   If the environment has changed, memorized expansions might not
+   be correct anymore, and so we flush the cache. This is safe but
+   quite pessimistic: it would be enough to flush the cache when a
+   type or module definition is overridden in the environment.
+*)
+let previous_env = ref Env.empty
+(*let string_of_kind = function Public -> "public" | Private -> "private"*)
+let check_abbrev_env env =
+  if env != !previous_env then begin
+    (* prerr_endline "cleanup expansion cache"; *)
+    cleanup_abbrev ();
+    previous_env := env
+  end
+
+
+(* Expand an abbreviation. The expansion is memorized. *)
+(*
+   Assume the level is greater than the path binding time of the
+   expanded abbreviation.
+*)
+(*
+   An abbreviation expansion will fail in either of these cases:
+   1. The type constructor does not correspond to a manifest type.
+   2. The type constructor is defined in an external file, and this
+      file is not in the path (missing -I options).
+   3. The type constructor is not in the "local" environment. This can
+      happens when a non-generic type variable has been instantiated
+      afterwards to the not yet defined type constructor. (Actually,
+      this cannot happen at the moment due to the strong constraints
+      between type levels and constructor binding time.)
+   4. The expansion requires the expansion of another abbreviation,
+      and this other expansion fails.
+*)
+let expand_abbrev_gen kind find_type_expansion env ty =
+  check_abbrev_env env;
+  match ty with
+    {desc = Tconstr (path, args, abbrev); level = level; scope} ->
+      let lookup_abbrev = proper_abbrevs path args abbrev in
+      begin match find_expans kind path !lookup_abbrev with
+        Some ty' ->
+          (* prerr_endline
+            ("found a "^string_of_kind kind^" expansion for "^Path.name path);*)
+          if level <> generic_level then
+            begin try
+              update_level env level ty'
+            with Unify _ ->
+              (* XXX This should not happen.
+                 However, levels are not correctly restored after a
+                 typing error *)
+              ()
+            end;
+          begin try
+            update_scope scope ty';
+          with Unify _ ->
+            (* XXX This should not happen.
+               However, levels are not correctly restored after a
+               typing error *)
+            ()
+          end;
+          let ty' = repr ty' in
+          (* assert (ty != ty'); *) (* PR#7324 *)
+          ty'
+      | None ->
+          match find_type_expansion path env with
+          | exception Not_found ->
+            (* another way to expand is to normalize the path itself *)
+            let path' = Env.normalize_type_path None env path in
+            if Path.same path path' then raise Cannot_expand
+            else newty2 level (Tconstr (path', args, abbrev))
+          | (params, body, lv) ->
+            (* prerr_endline
+              ("add a "^string_of_kind kind^" expansion for "^Path.name path);*)
+            let ty' = subst env level kind abbrev (Some ty) params args body in
+            (* For gadts, remember type as non exportable *)
+            (* The ambiguous level registered for ty' should be the highest *)
+            if !trace_gadt_instances then begin
+              let scope = max lv ty.scope in
+              if level < scope then raise (Trace.scope_escape ty);
+              set_scope ty scope;
+              set_scope ty' scope
+            end;
+            ty'
+      end
+  | _ ->
+      assert false
+
+(* Expand respecting privacy *)
+let expand_abbrev env ty =
+  expand_abbrev_gen Public Env.find_type_expansion env ty
+
+(* Expand once the head of a type *)
+let expand_head_once env ty =
+  try expand_abbrev env (repr ty) with Cannot_expand -> assert false
+
+(* Check whether a type can be expanded *)
+let safe_abbrev env ty =
+  let snap = Btype.snapshot () in
+  try ignore (expand_abbrev env ty); true
+  with Cannot_expand | Unify _ ->
+    Btype.backtrack snap;
+    false
+
+(* Expand the head of a type once.
+   Raise Cannot_expand if the type cannot be expanded.
+   May raise Unify, if a recursion was hidden in the type. *)
+let try_expand_once env ty =
+  let ty = repr ty in
+  match ty.desc with
+    Tconstr _ -> repr (expand_abbrev env ty)
+  | _ -> raise Cannot_expand
+
+(* This one only raises Cannot_expand *)
+let try_expand_safe env ty =
+  let snap = Btype.snapshot () in
+  try try_expand_once env ty
+  with Unify _ ->
+    Btype.backtrack snap; raise Cannot_expand
+
+(* Fully expand the head of a type. *)
+let rec try_expand_head try_once env ty =
+  let ty' = try_once env ty in
+  try try_expand_head try_once env ty'
+  with Cannot_expand -> ty'
+
+(* Unsafe full expansion, may raise Unify. *)
+let expand_head_unif env ty =
+  try try_expand_head try_expand_once env ty with Cannot_expand -> repr ty
+
+(* Safe version of expand_head, never fails *)
+let expand_head env ty =
+  try try_expand_head try_expand_safe env ty with Cannot_expand -> repr ty
+
+let _ = forward_try_expand_once := try_expand_safe
+
+
+(* Expand until we find a non-abstract type declaration,
+   use try_expand_safe to avoid raising "Unify _" when
+   called on recursive types
+ *)
+
+let rec extract_concrete_typedecl env ty =
+  let ty = repr ty in
+  match ty.desc with
+    Tconstr (p, _, _) ->
+      let decl = Env.find_type p env in
+      if decl.type_kind <> Type_abstract then (p, p, decl) else
+      let ty =
+        try try_expand_safe env ty with Cannot_expand -> raise Not_found
+      in
+      let (_, p', decl) = extract_concrete_typedecl env ty in
+        (p, p', decl)
+  | _ -> raise Not_found
+
+(* Implementing function [expand_head_opt], the compiler's own version of
+   [expand_head] used for type-based optimisations.
+   [expand_head_opt] uses [Env.find_type_expansion_opt] to access the
+   manifest type information of private abstract data types which is
+   normally hidden to the type-checker out of the implementation module of
+   the private abbreviation. *)
+
+let expand_abbrev_opt =
+  expand_abbrev_gen Private Env.find_type_expansion_opt
+
+let try_expand_once_opt env ty =
+  let ty = repr ty in
+  match ty.desc with
+    Tconstr _ -> repr (expand_abbrev_opt env ty)
+  | _ -> raise Cannot_expand
+
+let rec try_expand_head_opt env ty =
+  let ty' = try_expand_once_opt env ty in
+  begin try
+    try_expand_head_opt env ty'
+  with Cannot_expand ->
+    ty'
+  end
+
+let expand_head_opt env ty =
+  let snap = Btype.snapshot () in
+  try try_expand_head_opt env ty
+  with Cannot_expand | Unify _ -> (* expand_head shall never fail *)
+    Btype.backtrack snap;
+    repr ty
+
+(* Make sure that the type parameters of the type constructor [ty]
+   respect the type constraints *)
+let enforce_constraints env ty =
+  match ty with
+    {desc = Tconstr (path, args, _abbrev); level = level} ->
+      begin try
+        let decl = Env.find_type path env in
+        ignore
+          (subst env level Public (ref Mnil) None decl.type_params args
+             (newvar2 level))
+      with Not_found -> ()
+      end
+  | _ ->
+      assert false
+
+(* Recursively expand the head of a type.
+   Also expand #-types. *)
+let full_expand env ty =
+  let ty = repr (expand_head env ty) in
+  match ty.desc with
+    Tobject (fi, {contents = Some (_, v::_)}) when is_Tvar (repr v) ->
+      newty2 ty.level (Tobject (fi, ref None))
+  | _ ->
+      ty
+
+(*
+   Check whether the abbreviation expands to a well-defined type.
+   During the typing of a class, abbreviations for correspondings
+   types expand to non-generic types.
+*)
+let generic_abbrev env path =
+  try
+    let (_, body, _) = Env.find_type_expansion path env in
+    (repr body).level = generic_level
+  with
+    Not_found ->
+      false
+
+let generic_private_abbrev env path =
+  try
+    match Env.find_type path env with
+      {type_kind = Type_abstract;
+       type_private = Private;
+       type_manifest = Some body} ->
+         (repr body).level = generic_level
+    | _ -> false
+  with Not_found -> false
+
+let is_contractive env p =
+  try
+    let decl = Env.find_type p env in
+    in_pervasives p && decl.type_manifest = None || is_datatype decl
+  with Not_found -> false
+
+
+                              (*****************)
+                              (*  Occur check  *)
+                              (*****************)
+
+
+exception Occur
+
+let rec occur_rec env allow_recursive visited ty0 = function
+  | {desc=Tlink ty} ->
+      occur_rec env allow_recursive visited ty0 ty
+  | ty ->
+  if ty == ty0  then raise Occur;
+  match ty.desc with
+    Tconstr(p, _tl, _abbrev) ->
+      if allow_recursive && is_contractive env p then () else
+      begin try
+        if TypeSet.mem ty visited then raise Occur;
+        let visited = TypeSet.add ty visited in
+        iter_type_expr (occur_rec env allow_recursive visited ty0) ty
+      with Occur -> try
+        let ty' = try_expand_head try_expand_once env ty in
+        (* This call used to be inlined, but there seems no reason for it.
+           Message was referring to change in rev. 1.58 of the CVS repo. *)
+        occur_rec env allow_recursive visited ty0 ty'
+      with Cannot_expand ->
+        raise Occur
+      end
+  | Tobject _ | Tvariant _ ->
+      ()
+  | _ ->
+      if allow_recursive ||  TypeSet.mem ty visited then () else begin
+        let visited = TypeSet.add ty visited in
+        iter_type_expr (occur_rec env allow_recursive visited ty0) ty
+      end
+
+let type_changed = ref false (* trace possible changes to the studied type *)
+
+let merge r b = if b then r := true
+
+let occur env ty0 ty =
+  let allow_recursive = !Clflags.recursive_types || !umode = Pattern  in
+  let old = !type_changed in
+  try
+    while
+      type_changed := false;
+      occur_rec env allow_recursive TypeSet.empty ty0 ty;
+      !type_changed
+    do () (* prerr_endline "changed" *) done;
+    merge type_changed old
+  with exn ->
+    merge type_changed old;
+    match exn with
+    | Occur -> raise (Trace.rec_occur ty0 ty)
+    | _ -> raise exn
+
+let occur_in env ty0 t =
+  try occur env ty0 t; false with Unify _ -> true
+
+(* Check that a local constraint is well-founded *)
+(* PR#6405: not needed since we allow recursion and work on normalized types *)
+(* PR#6992: we actually need it for contractiveness *)
+(* This is a simplified version of occur, only for the rectypes case *)
+
+let rec local_non_recursive_abbrev strict visited env p ty =
+  (*Format.eprintf "@[Check %s =@ %a@]@." (Path.name p) !Btype.print_raw ty;*)
+  let ty = repr ty in
+  if not (List.memq ty visited) then begin
+    match ty.desc with
+      Tconstr(p', args, _abbrev) ->
+        if Path.same p p' then raise Occur;
+        if not strict && is_contractive env p' then () else
+        let visited = ty :: visited in
+        begin try
+          (* try expanding, since [p] could be hidden *)
+          local_non_recursive_abbrev strict visited env p
+            (try_expand_head try_expand_once_opt env ty)
+        with Cannot_expand ->
+          let params =
+            try (Env.find_type p' env).type_params
+            with Not_found -> args
+          in
+          List.iter2
+            (fun tv ty ->
+              let strict = strict || not (is_Tvar (repr tv)) in
+              local_non_recursive_abbrev strict visited env p ty)
+            params args
+        end
+    | _ ->
+        if strict then (* PR#7374 *)
+          let visited = ty :: visited in
+          iter_type_expr (local_non_recursive_abbrev true visited env p) ty
+  end
+
+let local_non_recursive_abbrev env p ty =
+  try (* PR#7397: need to check trace_gadt_instances *)
+    wrap_trace_gadt_instances env
+      (local_non_recursive_abbrev false [] env p) ty;
+    true
+  with Occur -> false
+
+
+                   (*****************************)
+                   (*  Polymorphic Unification  *)
+                   (*****************************)
+
+(* 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
+    (cl1, cl2) :: rem ->
+      let find_univ t cl =
+        try
+          let (_, r) = List.find (fun (t',_) -> t == repr t') cl in
+          Some r
+        with Not_found -> None
+      in
+      begin match find_univ t1 cl1, find_univ t2 cl2 with
+        Some {contents=Some t'2}, Some _ when t2 == repr t'2 ->
+          ()
+      | Some({contents=None} as r1), Some({contents=None} as r2) ->
+          set_univar r1 t2; set_univar r2 t1
+      | None, None ->
+          unify_univar t1 t2 rem
+      | _ ->
+          raise (Unify [])
+      end
+  | [] -> raise (Unify [])
+
+(* Test the occurrence of free univars in a type *)
+(* that's way too expensive. Must do some kind of caching *)
+let occur_univar env ty =
+  let visited = ref TypeMap.empty in
+  let rec occur_rec bound ty =
+    let ty = repr ty in
+    if ty.level >= lowest_level &&
+      if TypeSet.is_empty bound then
+        (ty.level <- pivot_level - ty.level; true)
+      else try
+        let bound' = TypeMap.find ty !visited in
+        if TypeSet.exists (fun x -> not (TypeSet.mem x bound)) bound' then
+          (visited := TypeMap.add ty (TypeSet.inter bound bound') !visited;
+           true)
+        else false
+      with Not_found ->
+        visited := TypeMap.add ty bound !visited;
+        true
+    then
+      match ty.desc with
+        Tunivar _ ->
+          if not (TypeSet.mem ty bound) then
+            raise Trace.(Unify [escape (Univ ty)])
+      | Tpoly (ty, tyl) ->
+          let bound = List.fold_right TypeSet.add (List.map repr tyl) bound in
+          occur_rec bound  ty
+      | Tconstr (_, [], _) -> ()
+      | Tconstr (p, tl, _) ->
+          begin try
+            let td = Env.find_type p env in
+            List.iter2
+              (fun t v ->
+                (* The null variance only occurs in type abbreviations and
+                   corresponds to type variables that do not occur in the
+                   definition (expansion would erase them completely).
+                   The type-checker consistently ignores type expressions
+                   in this position. Physical expansion, as done in `occur`,
+                   would be costly here, since we need to check inside
+                   object and variant types too. *)
+                if not Variance.(eq v null) then occur_rec bound t)
+              tl td.type_variance
+          with Not_found ->
+            List.iter (occur_rec bound) tl
+          end
+      | _ -> iter_type_expr (occur_rec bound) ty
+  in
+  Misc.try_finally (fun () ->
+      occur_rec TypeSet.empty ty
+    )
+    ~always:(fun () -> unmark_type ty)
+
+(* Grouping univars by families according to their binders *)
+let add_univars =
+  List.fold_left (fun s (t,_) -> TypeSet.add (repr t) s)
+
+let get_univar_family univar_pairs univars =
+  if univars = [] then TypeSet.empty else
+  let insert s = function
+      cl1, (_::_ as cl2) ->
+        if List.exists (fun (t1,_) -> TypeSet.mem (repr t1) s) cl1 then
+          add_univars s cl2
+        else s
+    | _ -> s
+  in
+  let s = List.fold_right TypeSet.add univars TypeSet.empty in
+  List.fold_left insert s univar_pairs
+
+(* 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
+  let rec occur t =
+    let t = repr t in
+    if TypeSet.mem t !visited then () else begin
+      visited := TypeSet.add t !visited;
+      match t.desc with
+        Tpoly (t, tl) ->
+          if List.exists (fun t -> TypeSet.mem (repr t) family) tl then ()
+          else occur t
+      | Tunivar _ ->
+          if TypeSet.mem t family then raise Trace.(Unify [escape(Univ t)])
+      | Tconstr (_, [], _) -> ()
+      | Tconstr (p, tl, _) ->
+          begin try
+            let td = Env.find_type p env in
+            List.iter2
+              (* see occur_univar *)
+              (fun t v -> if not Variance.(eq v null) then occur t)
+              tl td.type_variance
+          with Not_found ->
+            List.iter occur tl
+          end
+      | _ ->
+          iter_type_expr occur t
+    end
+  in
+  occur ty
+
+(* Wrapper checking that no variable escapes and updating univar_pairs *)
+let enter_poly env univar_pairs t1 tl1 t2 tl2 f =
+  let old_univars = !univar_pairs in
+  let known_univars =
+    List.fold_left (fun s (cl,_) -> add_univars s cl)
+      TypeSet.empty old_univars
+  in
+  let tl1 = List.map repr tl1 and tl2 = List.map repr tl2 in
+  if List.exists (fun t -> TypeSet.mem t known_univars) tl1 then
+     univars_escape env old_univars tl1 (newty(Tpoly(t2,tl2)));
+  if List.exists (fun t -> TypeSet.mem t known_univars) tl2 then
+    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)
+
+let univar_pairs = ref []
+
+(**** Instantiate a generic type into a poly type ***)
+
+let polyfy env ty vars =
+  let subst_univar scope ty =
+    let ty = repr ty in
+    match ty.desc with
+    | Tvar name when ty.level = generic_level ->
+        For_copy.save_desc scope ty ty.desc;
+        let t = newty (Tunivar name) in
+        ty.desc <- Tsubst t;
+        Some t
+    | _ -> None
+  in
+  (* need to expand twice? cf. Ctype.unify2 *)
+  let vars = List.map (expand_head env) vars in
+  let vars = List.map (expand_head env) vars in
+  For_copy.with_scope (fun scope ->
+    let vars' = List.filter_map (subst_univar scope) vars in
+    let ty = copy scope ty in
+    let ty = newty2 ty.level (Tpoly(repr ty, vars')) in
+    let complete = List.length vars = List.length vars' in
+    ty, complete
+  )
+
+(* assumption: [ty] is fully generalized. *)
+let reify_univars env ty =
+  let vars = free_variables ty in
+  let ty, _ = polyfy env ty vars in
+  ty
+
+                              (*****************)
+                              (*  Unification  *)
+                              (*****************)
+
+
+
+let rec has_cached_expansion p abbrev =
+  match abbrev with
+    Mnil                   -> false
+  | Mcons(_, p', _, _, rem)   -> Path.same p p' || has_cached_expansion p rem
+  | Mlink rem              -> has_cached_expansion p !rem
+
+(**** Transform error trace ****)
+(* +++ Move it to some other place ? *)
+
+let expand_trace env trace =
+  let expand_desc x = match x.Trace.expanded with
+    | None -> Trace.{ t = repr x.t; expanded= Some(full_expand env x.t) }
+    | Some _ -> x in
+  Unification_trace.map expand_desc trace
+
+(**** Unification ****)
+
+(* Return whether [t0] occurs in [ty]. Objects are also traversed. *)
+let deep_occur t0 ty =
+  let rec occur_rec ty =
+    let ty = repr ty in
+    if ty.level >= lowest_level then begin
+      if ty == t0 then raise Occur;
+      ty.level <- pivot_level - ty.level;
+      iter_type_expr occur_rec ty
+    end
+  in
+  try
+    occur_rec ty; unmark_type ty; false
+  with Occur ->
+    unmark_type ty; true
+
+(*
+   1. When unifying two non-abbreviated types, one type is made a link
+      to the other. When unifying an abbreviated type with a
+      non-abbreviated type, the non-abbreviated type is made a link to
+      the other one. When unifying to abbreviated types, these two
+      types are kept distincts, but they are made to (temporally)
+      expand to the same type.
+   2. Abbreviations with at least one parameter are systematically
+      expanded. The overhead does not seem too high, and that way
+      abbreviations where some parameters does not appear in the
+      expansion, such as ['a t = int], are correctly handled. In
+      particular, for this example, unifying ['a t] with ['b t] keeps
+      ['a] and ['b] distincts. (Is it really important ?)
+   3. Unifying an abbreviation ['a t = 'a] with ['a] should not yield
+      ['a t as 'a]. Indeed, the type variable would otherwise be lost.
+      This problem occurs for abbreviations expanding to a type
+      variable, but also to many other constrained abbreviations (for
+      instance, [(< x : 'a > -> unit) t = ]). The solution is
+      that, if an abbreviation is unified with some subpart of its
+      parameters, then the parameter actually does not get
+      abbreviated.  It would be possible to check whether some
+      information is indeed lost, but it probably does not worth it.
+*)
+
+let gadt_equations_level = ref None
+
+let get_gadt_equations_level () =
+  match !gadt_equations_level with
+  | None -> assert false
+  | Some x -> x
+
+
+(* a local constraint can be added only if the rhs
+   of the constraint does not contain any Tvars.
+   They need to be removed using this function *)
+let reify env t =
+  let fresh_constr_scope = get_gadt_equations_level () in
+  let create_fresh_constr lev name =
+    let name = match name with Some s -> "$'"^s | _ -> "$" in
+    let path =
+      Path.Pident
+        (Ident.create_scoped ~scope:fresh_constr_scope
+           (get_new_abstract_name name))
+    in
+    let decl = new_declaration fresh_constr_scope None in
+    let new_env = Env.add_local_type path decl !env in
+    let t = newty2 lev (Tconstr (path,[],ref Mnil))  in
+    env := new_env;
+    path, t
+  in
+  let visited = ref TypeSet.empty in
+  let rec iterator ty =
+    let ty = repr ty in
+    if TypeSet.mem ty !visited then () else begin
+      visited := TypeSet.add ty !visited;
+      match ty.desc with
+        Tvar o ->
+          let path, t = create_fresh_constr ty.level o in
+          link_type ty t;
+          if ty.level < fresh_constr_scope then
+            raise Trace.(Unify [escape (Constructor path)])
+      | Tvariant r ->
+          let r = row_repr r in
+          if not (static_row r) then begin
+            if is_fixed r then iterator (row_more r) else
+            let m = r.row_more in
+            match m.desc with
+              Tvar o ->
+                let path, t = create_fresh_constr m.level o in
+                let row =
+                  let row_fixed = Some (Reified path) in
+                  {r with row_fields=[]; row_fixed; row_more = t} in
+                link_type m (newty2 m.level (Tvariant row));
+                if m.level < fresh_constr_scope then
+                  raise Trace.(Unify [escape (Constructor path)])
+            | _ -> assert false
+          end;
+          iter_row iterator r
+      | Tconstr (p, _, _) when is_object_type p ->
+          iter_type_expr iterator (full_expand !env ty)
+      | _ ->
+          iter_type_expr iterator ty
+    end
+  in
+  iterator t
+
+let is_newtype env p =
+  try
+    let decl = Env.find_type p env in
+    decl.type_expansion_scope <> Btype.lowest_level &&
+    decl.type_kind = Type_abstract &&
+    decl.type_private = Public
+  with Not_found -> false
+
+let non_aliasable p decl =
+  (* in_pervasives p ||  (subsumed by in_current_module) *)
+  in_current_module p && not decl.type_is_newtype
+
+let is_instantiable env p =
+  try
+    let decl = Env.find_type p env in
+    decl.type_kind = Type_abstract &&
+    decl.type_private = Public &&
+    decl.type_arity = 0 &&
+    decl.type_manifest = None &&
+    not (non_aliasable p decl)
+  with Not_found -> false
+
+
+(* PR#7113: -safe-string should be a global property *)
+let compatible_paths p1 p2 =
+  let open Predef in
+  Path.same p1 p2 ||
+  Path.same p1 path_bytes && Path.same p2 path_string ||
+  Path.same p1 path_string && Path.same p2 path_bytes
+
+(* Check for datatypes carefully; see PR#6348 *)
+let rec expands_to_datatype env ty =
+  let ty = repr ty in
+  match ty.desc with
+    Tconstr (p, _, _) ->
+      begin try
+        is_datatype (Env.find_type p env) ||
+        expands_to_datatype env (try_expand_once env ty)
+      with Not_found | Cannot_expand -> false
+      end
+  | _ -> false
+
+(* mcomp type_pairs subst env t1 t2 does 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.
+   Assumes that both t1 and t2 do not contain any tvars
+   and that both their objects and variants are closed
+ *)
+
+let rec mcomp type_pairs env t1 t2 =
+  if t1 == t2 then () else
+  let t1 = repr t1 in
+  let t2 = repr t2 in
+  if t1 == t2 then () else
+  match (t1.desc, t2.desc) with
+  | (Tvar _, _)
+  | (_, Tvar _)  ->
+      ()
+  | (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
+      ()
+  | _ ->
+      let t1' = expand_head_opt env t1 in
+      let t2' = expand_head_opt env t2 in
+      (* Expansion may have changed the representative of the types... *)
+      let t1' = repr t1' and t2' = repr t2' in
+      if t1' == t2' then () else
+      begin try TypePairs.find type_pairs (t1', t2')
+      with Not_found ->
+        TypePairs.add type_pairs (t1', t2') ();
+        match (t1'.desc, t2'.desc) with
+        | (Tvar _, _)
+        | (_, Tvar _)  ->
+            ()
+        | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _))
+          when l1 = l2 || not (is_optional l1 || is_optional l2) ->
+            mcomp type_pairs env t1 t2;
+            mcomp type_pairs env u1 u2;
+        | (Ttuple tl1, Ttuple tl2) ->
+            mcomp_list type_pairs env tl1 tl2
+        | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) ->
+            mcomp_type_decl type_pairs env p1 p2 tl1 tl2
+        | (Tconstr (p, _, _), _) | (_, Tconstr (p, _, _)) ->
+            begin try
+              let decl = Env.find_type p env in
+              if non_aliasable p decl || is_datatype decl then raise (Unify [])
+            with Not_found -> ()
+            end
+        (*
+        | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) when n1 = n2 ->
+            mcomp_list type_pairs env tl1 tl2
+        *)
+        | (Tpackage _, Tpackage _) -> ()
+        | (Tvariant row1, Tvariant row2) ->
+            mcomp_row type_pairs env row1 row2
+        | (Tobject (fi1, _), Tobject (fi2, _)) ->
+            mcomp_fields type_pairs env fi1 fi2
+        | (Tfield _, Tfield _) ->       (* Actually unused *)
+            mcomp_fields type_pairs env t1' t2'
+        | (Tnil, Tnil) ->
+            ()
+        | (Tpoly (t1, []), Tpoly (t2, [])) ->
+            mcomp type_pairs env t1 t2
+        | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
+            enter_poly env univar_pairs t1 tl1 t2 tl2
+              (mcomp type_pairs env)
+        | (Tunivar _, Tunivar _) ->
+            unify_univar t1' t2' !univar_pairs
+        | (_, _) ->
+            raise (Unify [])
+      end
+
+and mcomp_list type_pairs env tl1 tl2 =
+  if List.length tl1 <> List.length tl2 then
+    raise (Unify []);
+  List.iter2 (mcomp type_pairs env) tl1 tl2
+
+and mcomp_fields type_pairs env ty1 ty2 =
+  if not (concrete_object ty1 && concrete_object ty2) then assert false;
+  let (fields2, rest2) = flatten_fields ty2 in
+  let (fields1, rest1) = flatten_fields ty1 in
+  let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
+  let has_present =
+    List.exists (fun (_, k, _) -> field_kind_repr k = Fpresent) in
+  mcomp type_pairs env rest1 rest2;
+  if has_present miss1  && (object_row ty2).desc = Tnil
+  || has_present miss2  && (object_row ty1).desc = Tnil then raise (Unify []);
+  List.iter
+    (function (_n, k1, t1, k2, t2) ->
+       mcomp_kind k1 k2;
+       mcomp type_pairs env t1 t2)
+    pairs
+
+and mcomp_kind k1 k2 =
+  let k1 = field_kind_repr k1 in
+  let k2 = field_kind_repr k2 in
+  match k1, k2 with
+    (Fpresent, Fabsent)
+  | (Fabsent, Fpresent) -> raise (Unify [])
+  | _                   -> ()
+
+and mcomp_row type_pairs env row1 row2 =
+  let row1 = row_repr row1 and row2 = row_repr row2 in
+  let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
+  let cannot_erase (_,f) =
+    match row_field_repr f with
+      Rpresent _ -> true
+    | Rabsent | Reither _ -> false
+  in
+  if row1.row_closed && List.exists cannot_erase r2
+  || row2.row_closed && List.exists cannot_erase r1 then raise (Unify []);
+  List.iter
+    (fun (_,f1,f2) ->
+      match row_field_repr f1, row_field_repr f2 with
+      | Rpresent None, (Rpresent (Some _) | Reither (_, _::_, _, _) | Rabsent)
+      | Rpresent (Some _), (Rpresent None | Reither (true, _, _, _) | Rabsent)
+      | (Reither (_, _::_, _, _) | Rabsent), Rpresent None
+      | (Reither (true, _, _, _) | Rabsent), Rpresent (Some _) ->
+          raise (Unify [])
+      | Rpresent(Some t1), Rpresent(Some t2) ->
+          mcomp type_pairs env t1 t2
+      | Rpresent(Some t1), Reither(false, tl2, _, _) ->
+          List.iter (mcomp type_pairs env t1) tl2
+      | Reither(false, tl1, _, _), Rpresent(Some t2) ->
+          List.iter (mcomp type_pairs env t2) tl1
+      | _ -> ())
+    pairs
+
+and mcomp_type_decl type_pairs env p1 p2 tl1 tl2 =
+  try
+    let decl = Env.find_type p1 env in
+    let decl' = Env.find_type p2 env in
+    if compatible_paths p1 p2 then begin
+      let inj =
+        try List.map Variance.(mem Inj) (Env.find_type p1 env).type_variance
+        with Not_found -> List.map (fun _ -> false) tl1
+      in
+      List.iter2
+        (fun i (t1,t2) -> if i then mcomp type_pairs env t1 t2)
+        inj (List.combine tl1 tl2)
+    end else if non_aliasable p1 decl && non_aliasable p2 decl' then
+      raise (Unify [])
+    else
+      match decl.type_kind, decl'.type_kind with
+      | Type_record (lst,r), Type_record (lst',r') when r = r' ->
+          mcomp_list type_pairs env tl1 tl2;
+          mcomp_record_description type_pairs env lst lst'
+      | Type_variant v1, Type_variant v2 ->
+          mcomp_list type_pairs env tl1 tl2;
+          mcomp_variant_description type_pairs env v1 v2
+      | Type_open, Type_open ->
+          mcomp_list type_pairs env tl1 tl2
+      | Type_abstract, Type_abstract -> ()
+      | Type_abstract, _ when not (non_aliasable p1 decl)-> ()
+      | _, Type_abstract when not (non_aliasable p2 decl') -> ()
+      | _ -> raise (Unify [])
+  with Not_found -> ()
+
+and mcomp_type_option type_pairs env t t' =
+  match t, t' with
+    None, None -> ()
+  | Some t, Some t' -> mcomp type_pairs env t t'
+  | _ -> raise (Unify [])
+
+and mcomp_variant_description type_pairs env xs ys =
+  let rec iter = fun x y ->
+    match x, y with
+    | c1 :: xs, c2 :: ys   ->
+      mcomp_type_option type_pairs env c1.cd_res c2.cd_res;
+      begin match c1.cd_args, c2.cd_args with
+      | Cstr_tuple l1, Cstr_tuple l2 -> mcomp_list type_pairs env l1 l2
+      | Cstr_record l1, Cstr_record l2 ->
+          mcomp_record_description type_pairs env l1 l2
+      | _ -> raise (Unify [])
+      end;
+     if Ident.name c1.cd_id = Ident.name c2.cd_id
+      then iter xs ys
+      else raise (Unify [])
+    | [],[] -> ()
+    | _ -> raise (Unify [])
+  in
+  iter xs ys
+
+and mcomp_record_description type_pairs env =
+  let rec iter x y =
+    match x, y with
+    | l1 :: xs, l2 :: ys ->
+        mcomp type_pairs env l1.ld_type l2.ld_type;
+        if Ident.name l1.ld_id = Ident.name l2.ld_id &&
+           l1.ld_mutable = l2.ld_mutable
+        then iter xs ys
+        else raise (Unify [])
+    | [], [] -> ()
+    | _ -> raise (Unify [])
+  in
+  iter
+
+let mcomp env t1 t2 =
+  mcomp (TypePairs.create 4) env t1 t2
+
+(* Real unification *)
+
+let find_lowest_level ty =
+  let lowest = ref generic_level in
+  let rec find ty =
+    let ty = repr ty in
+    if ty.level >= lowest_level then begin
+      if ty.level < !lowest then lowest := ty.level;
+      ty.level <- pivot_level - ty.level;
+      iter_type_expr find ty
+    end
+  in find ty; unmark_type ty; !lowest
+
+let find_expansion_scope env path =
+  (Env.find_type path env).type_expansion_scope
+
+let add_gadt_equation env source destination =
+  (* Format.eprintf "@[add_gadt_equation %s %a@]@."
+    (Path.name source) !Btype.print_raw destination; *)
+  if local_non_recursive_abbrev !env source destination then begin
+    let destination = duplicate_type destination in
+    let expansion_scope =
+      max (Path.scope source) (get_gadt_equations_level ())
+    in
+    let decl = new_declaration expansion_scope (Some destination) in
+    env := Env.add_local_type source decl !env;
+    cleanup_abbrev ()
+  end
+
+let unify_eq_set = TypePairs.create 11
+
+let order_type_pair t1 t2 =
+  if t1.id <= t2.id then (t1, t2) else (t2, t1)
+
+let add_type_equality t1 t2 =
+  TypePairs.add unify_eq_set (order_type_pair t1 t2) ()
+
+let eq_package_path env p1 p2 =
+  Path.same p1 p2 ||
+  Path.same (normalize_package_path env p1) (normalize_package_path env p2)
+
+let nondep_type' = ref (fun _ _ _ -> assert false)
+let package_subtype = ref (fun _ _ _ _ _ _ _ -> assert false)
+
+let rec concat_longident lid1 =
+  let open Longident in
+  function
+    Lident s -> Ldot (lid1, s)
+  | Ldot (lid2, s) -> Ldot (concat_longident lid1 lid2, s)
+  | Lapply (lid2, lid) -> Lapply (concat_longident lid1 lid2, lid)
+
+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
+
+(* Find the type paths nl1 in the module type mty2, and add them to the
+   list (nl2, tl2). raise Not_found if impossible *)
+let complete_type_list ?(allow_absent=false) env nl1 lv2 mty2 nl2 tl2 =
+  (* This is morally WRONG: we're adding a (dummy) module without a scope in the
+     environment. However no operation which cares about levels/scopes is going
+     to happen while this module exists.
+     The only operations that happen are:
+     - Env.find_type_by_name
+     - nondep_instance
+     None of which check the scope.
+
+     It'd be nice if we avoided creating such temporary dummy modules and broken
+     environments though. *)
+  let id2 = Ident.create_local "Pkg" in
+  let env' = Env.add_module id2 Mp_present mty2 env in
+  let rec complete nl1 ntl2 =
+    match nl1, ntl2 with
+      [], _ -> ntl2
+    | n :: nl, (n2, _ as nt2) :: ntl' when n >= n2 ->
+        nt2 :: complete (if n = n2 then nl else nl1) ntl'
+    | n :: nl, _ ->
+        let lid = concat_longident (Longident.Lident "Pkg") n in
+        match Env.find_type_by_name lid env' with
+        | (_, {type_arity = 0; type_kind = Type_abstract;
+               type_private = Public; type_manifest = Some t2}) ->
+            (n, nondep_instance env' lv2 id2 t2) :: complete nl ntl2
+        | (_, {type_arity = 0; type_kind = Type_abstract;
+               type_private = Public; type_manifest = None})
+          when allow_absent ->
+            complete nl ntl2
+        | _ -> raise Exit
+        | exception Not_found when allow_absent->
+            complete nl ntl2
+  in
+  match complete nl1 (List.combine nl2 tl2) with
+  | res -> res
+  | exception Exit -> raise Not_found
+
+(* raise Not_found rather than Unify if the module types are incompatible *)
+let unify_package env unify_list lv1 p1 n1 tl1 lv2 p2 n2 tl2 =
+  let ntl2 = complete_type_list env n1 lv2 (Mty_ident p2) n2 tl2
+  and ntl1 = complete_type_list env n2 lv1 (Mty_ident p1) n1 tl1 in
+  unify_list (List.map snd ntl1) (List.map snd ntl2);
+  if eq_package_path env p1 p2
+  || !package_subtype env p1 n1 tl1 p2 n2 tl2
+  && !package_subtype env p2 n2 tl2 p1 n1 tl1 then () else raise Not_found
+
+
+(* force unification in Reither when one side has a non-conjunctive type *)
+let rigid_variants = ref false
+
+let unify_eq t1 t2 =
+  t1 == t2 ||
+  match !umode with
+  | Expression -> false
+  | Pattern ->
+      try TypePairs.find unify_eq_set (order_type_pair t1 t2); true
+      with Not_found -> false
+
+let unify1_var env t1 t2 =
+  assert (is_Tvar t1);
+  occur env t1 t2;
+  occur_univar env t2;
+  let d1 = t1.desc in
+  link_type t1 t2;
+  try
+    update_level env t1.level t2;
+    update_scope t1.scope t2
+  with Unify _ as e ->
+    t1.desc <- d1;
+    raise e
+
+let rec unify (env:Env.t ref) t1 t2 =
+  (* First step: special cases (optimizations) *)
+  if t1 == t2 then () else
+  let t1 = repr t1 in
+  let t2 = repr t2 in
+  if unify_eq t1 t2 then () else
+  let reset_tracing = check_trace_gadt_instances !env in
+
+  try
+    type_changed := true;
+    begin match (t1.desc, t2.desc) with
+      (Tvar _, Tconstr _) when deep_occur t1 t2 ->
+        unify2 env t1 t2
+    | (Tconstr _, Tvar _) when deep_occur t2 t1 ->
+        unify2 env t1 t2
+    | (Tvar _, _) ->
+        unify1_var !env t1 t2
+    | (_, Tvar _) ->
+        unify1_var !env t2 t1
+    | (Tunivar _, Tunivar _) ->
+        unify_univar t1 t2 !univar_pairs;
+        update_level !env t1.level t2;
+        update_scope t1.scope t2;
+        link_type t1 t2
+    | (Tconstr (p1, [], a1), Tconstr (p2, [], a2))
+          when Path.same p1 p2 (* && actual_mode !env = Old *)
+            (* This optimization assumes that t1 does not expand to t2
+               (and conversely), so we fall back to the general case
+               when any of the types has a cached expansion. *)
+            && not (has_cached_expansion p1 !a1
+                 || has_cached_expansion p2 !a2) ->
+        update_level !env t1.level t2;
+        update_scope t1.scope t2;
+        link_type t1 t2
+    | (Tconstr (p1, [], _), Tconstr (p2, [], _))
+      when Env.has_local_constraints !env
+      && is_newtype !env p1 && is_newtype !env p2 ->
+        (* Do not use local constraints more than necessary *)
+        begin try
+          if find_expansion_scope !env p1 > find_expansion_scope !env p2 then
+            unify env t1 (try_expand_once !env t2)
+          else
+            unify env (try_expand_once !env t1) t2
+        with Cannot_expand ->
+          unify2 env t1 t2
+        end
+    | _ ->
+        unify2 env t1 t2
+    end;
+    reset_trace_gadt_instances reset_tracing;
+  with Unify trace ->
+    reset_trace_gadt_instances reset_tracing;
+    raise( Unify (Trace.diff t1 t2 :: trace) )
+
+and unify2 env t1 t2 =
+  (* Second step: expansion of abbreviations *)
+  (* Expansion may change the representative of the types. *)
+  ignore (expand_head_unif !env t1);
+  ignore (expand_head_unif !env t2);
+  let t1' = expand_head_unif !env t1 in
+  let t2' = expand_head_unif !env t2 in
+  let lv = min t1'.level t2'.level in
+  let scope = max t1'.scope t2'.scope in
+  update_level !env lv t2;
+  update_level !env lv t1;
+  update_scope scope t2;
+  update_scope scope t1;
+  if unify_eq t1' t2' then () else
+
+  let t1 = repr t1 and t2 = repr t2 in
+  let t1, t2 =
+    if !Clflags.principal
+    && (find_lowest_level t1' < lv || find_lowest_level t2' < lv) then
+      (* Expand abbreviations hiding a lower level *)
+      (* Should also do it for parameterized types, after unification... *)
+      (match t1.desc with Tconstr (_, [], _) -> t1' | _ -> t1),
+      (match t2.desc with Tconstr (_, [], _) -> t2' | _ -> t2)
+    else (t1, t2)
+  in
+  if unify_eq t1 t1' || not (unify_eq t2 t2') then
+    unify3 env t1 t1' t2 t2'
+  else
+    try unify3 env t2 t2' t1 t1' with Unify trace ->
+      raise (Unify (Trace.swap trace))
+
+and unify3 env t1 t1' t2 t2' =
+  (* Third step: truly unification *)
+  (* Assumes either [t1 == t1'] or [t2 != t2'] *)
+  let d1 = t1'.desc and d2 = t2'.desc in
+  let create_recursion = (t2 != t2') && (deep_occur t1' t2) in
+
+  begin match (d1, d2) with (* handle vars and univars specially *)
+    (Tunivar _, Tunivar _) ->
+      unify_univar t1' t2' !univar_pairs;
+      link_type t1' t2'
+  | (Tvar _, _) ->
+      occur !env t1' t2;
+      occur_univar !env t2;
+      link_type t1' t2;
+  | (_, Tvar _) ->
+      occur !env t2' t1;
+      occur_univar !env t1;
+      link_type t2' t1;
+  | (Tfield _, Tfield _) -> (* special case for GADTs *)
+      unify_fields env t1' t2'
+  | _ ->
+    begin match !umode with
+    | Expression ->
+        occur !env t1' t2';
+        if is_self_type d1 (* PR#7711: do not abbreviate self type *)
+        then link_type t1' t2'
+        else link_type t1' t2
+    | Pattern ->
+        add_type_equality t1' t2'
+    end;
+    try
+      begin match (d1, d2) with
+        (Tarrow (l1, t1, u1, c1), Tarrow (l2, t2, u2, c2)) when l1 = l2 ||
+        (!Clflags.classic || !umode = Pattern) &&
+        not (is_optional l1 || is_optional l2) ->
+          unify  env t1 t2; unify env  u1 u2;
+          begin match commu_repr c1, commu_repr c2 with
+            Clink r, c2 -> set_commu r c2
+          | c1, Clink r -> set_commu r c1
+          | _ -> ()
+          end
+      | (Ttuple tl1, Ttuple tl2) ->
+          unify_list env tl1 tl2
+      | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) when Path.same p1 p2 ->
+          if !umode = Expression || not !generate_equations then
+            unify_list env tl1 tl2
+          else if !assume_injective then
+            set_mode_pattern ~generate:true ~injective:false
+                             (fun () -> unify_list env tl1 tl2)
+          else if in_current_module p1 (* || in_pervasives p1 *)
+                  || List.exists (expands_to_datatype !env) [t1'; t1; t2] then
+            unify_list env tl1 tl2
+          else
+            let inj =
+              try List.map Variance.(mem Inj)
+                    (Env.find_type p1 !env).type_variance
+              with Not_found -> List.map (fun _ -> false) tl1
+            in
+            List.iter2
+              (fun i (t1, t2) ->
+                if i then unify env t1 t2 else
+                set_mode_pattern ~generate:false ~injective:false
+                  begin fun () ->
+                    let snap = snapshot () in
+                    try unify env t1 t2 with Unify _ ->
+                      backtrack snap;
+                      reify env t1; reify env t2
+                  end)
+              inj (List.combine tl1 tl2)
+      | (Tconstr (path,[],_),
+         Tconstr (path',[],_))
+        when is_instantiable !env path && is_instantiable !env path'
+        && !generate_equations ->
+          let source, destination =
+            if Path.scope path > Path.scope path'
+            then  path , t2'
+            else  path', t1'
+          in
+          add_gadt_equation env source destination
+      | (Tconstr (path,[],_), _)
+        when is_instantiable !env path && !generate_equations ->
+          reify env t2';
+          add_gadt_equation env path t2'
+      | (_, Tconstr (path,[],_))
+        when is_instantiable !env path && !generate_equations ->
+          reify env t1';
+          add_gadt_equation env path t1'
+      | (Tconstr (_,_,_), _) | (_, Tconstr (_,_,_)) when !umode = Pattern ->
+          reify env t1';
+          reify env t2';
+          if !generate_equations then mcomp !env t1' t2'
+      | (Tobject (fi1, nm1), Tobject (fi2, _)) ->
+          unify_fields env fi1 fi2;
+          (* Type [t2'] may have been instantiated by [unify_fields] *)
+          (* XXX One should do some kind of unification... *)
+          begin match (repr t2').desc with
+            Tobject (_, {contents = Some (_, va::_)}) when
+              (match (repr va).desc with
+                Tvar _|Tunivar _|Tnil -> true | _ -> false) -> ()
+          | Tobject (_, nm2) -> set_name nm2 !nm1
+          | _ -> ()
+          end
+      | (Tvariant row1, Tvariant row2) ->
+          if !umode = Expression then
+            unify_row env row1 row2
+          else begin
+            let snap = snapshot () in
+            try unify_row env row1 row2
+            with Unify _ ->
+              backtrack snap;
+              reify env t1';
+              reify env t2';
+              if !generate_equations then mcomp !env t1' t2'
+          end
+      | (Tfield(f,kind,_,rem), Tnil) | (Tnil, Tfield(f,kind,_,rem)) ->
+          begin match field_kind_repr kind with
+            Fvar r when f <> dummy_method ->
+              set_kind r Fabsent;
+              if d2 = Tnil then unify env rem t2'
+              else unify env (newty2 rem.level Tnil) rem
+          | _      ->
+              if f = dummy_method then
+                raise (Unify Trace.[Obj Self_cannot_be_closed])
+              else if d1 = Tnil then
+                raise (Unify Trace.[Obj(Missing_field (First, f))])
+              else
+                raise (Unify Trace.[Obj(Missing_field (Second, f))])
+          end
+      | (Tnil, Tnil) ->
+          ()
+      | (Tpoly (t1, []), Tpoly (t2, [])) ->
+          unify env t1 t2
+      | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
+          enter_poly !env univar_pairs t1 tl1 t2 tl2 (unify env)
+      | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) ->
+          begin try
+            unify_package !env (unify_list env)
+              t1.level p1 n1 tl1 t2.level p2 n2 tl2
+          with Not_found ->
+            if !umode = Expression then raise (Unify []);
+            List.iter (reify env) (tl1 @ tl2);
+            (* if !generate_equations then List.iter2 (mcomp !env) tl1 tl2 *)
+          end
+      | (Tnil,  Tconstr _ ) -> raise (Unify Trace.[Obj(Abstract_row Second)])
+      | (Tconstr _,  Tnil ) -> raise (Unify Trace.[Obj(Abstract_row First)])
+      | (_, _) -> raise (Unify [])
+      end;
+      (* XXX Commentaires + changer "create_recursion"
+         ||| Comments + change "create_recursion" *)
+      if create_recursion then
+        match t2.desc with
+          Tconstr (p, tl, abbrev) ->
+            forget_abbrev abbrev p;
+            let t2'' = expand_head_unif !env t2 in
+            if not (closed_parameterized_type tl t2'') then
+              link_type (repr t2) (repr t2')
+        | _ ->
+            () (* t2 has already been expanded by update_level *)
+    with Unify trace ->
+      t1'.desc <- d1;
+      raise (Unify trace)
+  end
+
+and unify_list env tl1 tl2 =
+  if List.length tl1 <> List.length tl2 then
+    raise (Unify []);
+  List.iter2 (unify env) tl1 tl2
+
+(* Build a fresh row variable for unification *)
+and make_rowvar level use1 rest1 use2 rest2  =
+  let set_name ty name =
+    match ty.desc with
+      Tvar None -> set_type_desc ty (Tvar name)
+    | _ -> ()
+  in
+  let name =
+    match rest1.desc, rest2.desc with
+      Tvar (Some _ as name1), Tvar (Some _ as name2) ->
+        if rest1.level <= rest2.level then name1 else name2
+    | Tvar (Some _ as name), _ ->
+        if use2 then set_name rest2 name; name
+    | _, Tvar (Some _ as name) ->
+        if use1 then set_name rest2 name; name
+    | _ -> None
+  in
+  if use1 then rest1 else
+  if use2 then rest2 else newvar2 ?name level
+
+and unify_fields env ty1 ty2 =          (* Optimization *)
+  let (fields1, rest1) = flatten_fields ty1
+  and (fields2, rest2) = flatten_fields ty2 in
+  let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
+  let l1 = (repr ty1).level and l2 = (repr ty2).level in
+  let va = make_rowvar (min l1 l2) (miss2=[]) rest1 (miss1=[]) rest2 in
+  let d1 = rest1.desc and d2 = rest2.desc in
+  try
+    unify env (build_fields l1 miss1 va) rest2;
+    unify env rest1 (build_fields l2 miss2 va);
+    List.iter
+      (fun (n, k1, t1, k2, t2) ->
+        unify_kind k1 k2;
+        try
+          if !trace_gadt_instances then begin
+            update_level !env va.level t1;
+            update_scope va.scope t1
+          end;
+          unify env t1 t2
+        with Unify trace ->
+          raise( Unify (Trace.incompatible_fields n t1 t2 :: trace) )
+      )
+      pairs
+  with exn ->
+    set_type_desc rest1 d1;
+    set_type_desc rest2 d2;
+    raise exn
+
+and unify_kind k1 k2 =
+  let k1 = field_kind_repr k1 in
+  let k2 = field_kind_repr k2 in
+  if k1 == k2 then () else
+  match k1, k2 with
+    (Fvar r, (Fvar _ | Fpresent)) -> set_kind r k2
+  | (Fpresent, Fvar r)            -> set_kind r k1
+  | (Fpresent, Fpresent)          -> ()
+  | _                             -> assert false
+
+and unify_row env row1 row2 =
+  let row1 = row_repr row1 and row2 = row_repr row2 in
+  let rm1 = row_more row1 and rm2 = row_more row2 in
+  if unify_eq rm1 rm2 then () else
+  let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
+  if r1 <> [] && r2 <> [] then begin
+    let ht = Hashtbl.create (List.length r1) in
+    List.iter (fun (l,_) -> Hashtbl.add ht (hash_variant l) l) r1;
+    List.iter
+      (fun (l,_) ->
+        try raise (Tags(l, Hashtbl.find ht (hash_variant l)))
+        with Not_found -> ())
+      r2
+  end;
+  let fixed1 = fixed_explanation row1 and fixed2 = fixed_explanation row2 in
+  let more = match fixed1, fixed2 with
+    | Some _, Some _ -> if rm2.level < rm1.level then rm2 else rm1
+    | Some _, None -> rm1
+    | None, Some _ -> rm2
+    | None, None -> newty2 (min rm1.level rm2.level) (Tvar None)
+  in
+  let fixed = merge_fixed_explanation fixed1 fixed2
+  and closed = row1.row_closed || row2.row_closed in
+  let keep switch =
+    List.for_all
+      (fun (_,f1,f2) ->
+        let f1, f2 = switch f1 f2 in
+        row_field_repr f1 = Rabsent || row_field_repr f2 <> Rabsent)
+      pairs
+  in
+  let empty fields =
+    List.for_all (fun (_,f) -> row_field_repr f = Rabsent) fields in
+  (* Check whether we are going to build an empty type *)
+  if closed && (empty r1 || row2.row_closed) && (empty r2 || row1.row_closed)
+  && List.for_all
+      (fun (_,f1,f2) ->
+        row_field_repr f1 = Rabsent || row_field_repr f2 = Rabsent)
+      pairs
+  then raise Trace.( Unify [Variant No_intersection] );
+  let name =
+    if row1.row_name <> None && (row1.row_closed || empty r2) &&
+      (not row2.row_closed || keep (fun f1 f2 -> f1, f2) && empty r1)
+    then row1.row_name
+    else if row2.row_name <> None && (row2.row_closed || empty r1) &&
+      (not row1.row_closed || keep (fun f1 f2 -> f2, f1) && empty r2)
+    then row2.row_name
+    else None
+  in
+  let row0 = {row_fields = []; row_more = more; row_bound = ();
+              row_closed = closed; row_fixed = fixed; row_name = name} in
+  let set_more row rest =
+    let rest =
+      if closed then
+        filter_row_fields row.row_closed rest
+      else rest in
+    begin match fixed_explanation row with
+      | None ->
+          if rest <> [] && row.row_closed then
+            let pos = if row == row1 then Trace.First else Trace.Second in
+            raise Trace.(Unify [Variant (No_tags(pos,rest))])
+      | Some fixed ->
+          let pos = if row == row1 then Trace.First else Trace.Second in
+          if closed && not row.row_closed then
+            raise Trace.(Unify [Variant(Fixed_row(pos,Cannot_be_closed,fixed))])
+          else if rest <> [] then
+            let case = Trace.Cannot_add_tags (List.map fst rest) in
+            raise Trace.(Unify [Variant(Fixed_row(pos,case,fixed))])
+    end;
+    (* The following test is not principal... should rather use Tnil *)
+    let rm = row_more row in
+    (*if !trace_gadt_instances && rm.desc = Tnil then () else*)
+    if !trace_gadt_instances then
+      update_level !env rm.level (newgenty (Tvariant row));
+    if row_fixed row then
+      if more == rm then () else
+      if is_Tvar rm then link_type rm more else unify env rm more
+    else
+      let ty = newgenty (Tvariant {row0 with row_fields = rest}) in
+      update_level !env rm.level ty;
+      update_scope rm.scope ty;
+      link_type rm ty
+  in
+  let md1 = rm1.desc and md2 = rm2.desc in
+  begin try
+    set_more row2 r1;
+    set_more row1 r2;
+    List.iter
+      (fun (l,f1,f2) ->
+        try unify_row_field env fixed1 fixed2 rm1 rm2 l f1 f2
+        with Unify trace ->
+          raise Trace.( Unify( Variant (Incompatible_types_for l) :: trace ))
+      )
+      pairs;
+    if static_row row1 then begin
+      let rm = row_more row1 in
+      if is_Tvar rm then link_type rm (newty2 rm.level Tnil)
+    end
+  with exn ->
+    set_type_desc rm1 md1; set_type_desc rm2 md2; raise exn
+  end
+
+and unify_row_field env fixed1 fixed2 rm1 rm2 l f1 f2 =
+  let f1 = row_field_repr f1 and f2 = row_field_repr f2 in
+  let if_not_fixed (pos,fixed) f =
+    match fixed with
+    | None -> f ()
+    | Some fix ->
+        let tr = Trace.[ Variant (Fixed_row (pos,Cannot_add_tags [l],fix)) ] in
+        raise (Unify tr) in
+  let first = Trace.First, fixed1 and second = Trace.Second, fixed2 in
+  let either_fixed = match fixed1, fixed2 with
+    | None, None -> false
+    | _ -> true in
+  if f1 == f2 then () else
+  match f1, f2 with
+    Rpresent(Some t1), Rpresent(Some t2) -> unify env t1 t2
+  | Rpresent None, Rpresent None -> ()
+  | Reither(c1, tl1, m1, e1), Reither(c2, tl2, m2, e2) ->
+      if e1 == e2 then () else
+      if either_fixed && not (c1 || c2)
+      && List.length tl1 = List.length tl2 then begin
+        (* PR#7496 *)
+        let f = Reither (c1 || c2, [], m1 || m2, ref None) in
+        set_row_field e1 f; set_row_field e2 f;
+        List.iter2 (unify env) tl1 tl2
+      end
+      else let redo =
+        (m1 || m2 || either_fixed ||
+         !rigid_variants && (List.length tl1 = 1 || List.length tl2 = 1)) &&
+        begin match tl1 @ tl2 with [] -> false
+        | t1 :: tl ->
+            if c1 || c2 then raise (Unify []);
+            List.iter (unify env t1) tl;
+            !e1 <> None || !e2 <> None
+        end in
+      if redo then unify_row_field env fixed1 fixed2 rm1 rm2 l f1 f2 else
+      let tl1 = List.map repr tl1 and tl2 = List.map repr tl2 in
+      let rec remq tl = function [] -> []
+        | ty :: tl' ->
+            if List.memq ty tl then remq tl tl' else ty :: remq tl tl'
+      in
+      let tl1' = remq tl2 tl1 and tl2' = remq tl1 tl2 in
+      (* PR#6744 *)
+      let split_univars =
+        List.partition
+          (fun ty -> try occur_univar !env ty; true with Unify _ -> false) in
+      let (tl1',tlu1) = split_univars tl1'
+      and (tl2',tlu2) = split_univars tl2' in
+      begin match tlu1, tlu2 with
+        [], [] -> ()
+      | (tu1::tlu1), _ :: _ ->
+          (* Attempt to merge all the types containing univars *)
+          List.iter (unify env tu1) (tlu1@tlu2)
+      | (tu::_, []) | ([], tu::_) -> occur_univar !env tu
+      end;
+      (* Is this handling of levels really principal? *)
+      List.iter (fun ty ->
+        let rm = repr rm2 in
+        update_level !env rm.level ty;
+        update_scope rm.scope ty;
+      ) tl1';
+      List.iter (fun ty ->
+        let rm = repr rm1 in
+        update_level !env rm.level ty;
+        update_scope rm.scope ty;
+      ) tl2';
+      let e = ref None in
+      let f1' = Reither(c1 || c2, tl2', m1 || m2, e)
+      and f2' = Reither(c1 || c2, tl1', m1 || m2, e) in
+      set_row_field e1 f1'; set_row_field e2 f2';
+  | Reither(_, _, false, e1), Rabsent ->
+      if_not_fixed first (fun () -> set_row_field e1 f2)
+  | Rabsent, Reither(_, _, false, e2) ->
+      if_not_fixed second (fun () -> set_row_field e2 f1)
+  | Rabsent, Rabsent -> ()
+  | Reither(false, tl, _, e1), Rpresent(Some t2) ->
+      if_not_fixed first (fun () ->
+          set_row_field e1 f2;
+          let rm = repr rm1 in
+          update_level !env rm.level t2;
+          update_scope rm.scope t2;
+          (try List.iter (fun t1 -> unify env t1 t2) tl
+           with exn -> e1 := None; raise exn)
+        )
+  | Rpresent(Some t1), Reither(false, tl, _, e2) ->
+      if_not_fixed second (fun () ->
+          set_row_field e2 f1;
+          let rm = repr rm2 in
+          update_level !env rm.level t1;
+          update_scope rm.scope t1;
+          (try List.iter (unify env t1) tl
+           with exn -> e2 := None; raise exn)
+        )
+  | Reither(true, [], _, e1), Rpresent None ->
+      if_not_fixed first (fun () -> set_row_field e1 f2)
+  | Rpresent None, Reither(true, [], _, e2) ->
+      if_not_fixed second (fun () -> set_row_field e2 f1)
+  | _ -> raise (Unify [])
+
+
+let unify env ty1 ty2 =
+  let snap = Btype.snapshot () in
+  try
+    unify env ty1 ty2
+  with
+    Unify trace ->
+      undo_compress snap;
+      raise (Unify (expand_trace !env trace))
+
+let unify_gadt ~equations_level:lev (env:Env.t ref) ty1 ty2 =
+  try
+    univar_pairs := [];
+    gadt_equations_level := Some lev;
+    set_mode_pattern ~generate:true ~injective:true
+                     (fun () -> unify env ty1 ty2);
+    gadt_equations_level := None;
+    TypePairs.clear unify_eq_set;
+  with e ->
+    gadt_equations_level := None;
+    TypePairs.clear unify_eq_set;
+    raise e
+
+let unify_var env t1 t2 =
+  let t1 = repr t1 and t2 = repr t2 in
+  if t1 == t2 then () else
+  match t1.desc, t2.desc with
+    Tvar _, Tconstr _ when deep_occur t1 t2 ->
+      unify (ref env) t1 t2
+  | Tvar _, _ ->
+      let reset_tracing = check_trace_gadt_instances env in
+      begin try
+        occur env t1 t2;
+        update_level env t1.level t2;
+        update_scope t1.scope t2;
+        link_type t1 t2;
+        reset_trace_gadt_instances reset_tracing;
+      with Unify trace ->
+        reset_trace_gadt_instances reset_tracing;
+        let expanded_trace = expand_trace env @@ Trace.diff t1 t2 :: trace in
+        raise (Unify expanded_trace)
+      end
+  | _ ->
+      unify (ref env) t1 t2
+
+let _ = unify' := unify_var
+
+let unify_pairs env ty1 ty2 pairs =
+  univar_pairs := pairs;
+  unify env ty1 ty2
+
+let unify env ty1 ty2 =
+  unify_pairs (ref env) ty1 ty2 []
+
+
+
+(**** Special cases of unification ****)
+
+let expand_head_trace env t =
+  let reset_tracing = check_trace_gadt_instances env in
+  let t = expand_head_unif env t in
+  reset_trace_gadt_instances reset_tracing;
+  t
+
+(*
+   Unify [t] and [l:'a -> 'b]. Return ['a] and ['b].
+   In label mode, label mismatch is accepted when
+   (1) the requested label is ""
+   (2) the original label is not optional
+*)
+
+let filter_arrow env t l =
+  let t = expand_head_trace env t in
+  match t.desc with
+    Tvar _ ->
+      let lv = t.level in
+      let t1 = newvar2 lv and t2 = newvar2 lv in
+      let t' = newty2 lv (Tarrow (l, t1, t2, Cok)) in
+      link_type t t';
+      (t1, t2)
+  | Tarrow(l', t1, t2, _)
+    when l = l' || !Clflags.classic && l = Nolabel && not (is_optional l') ->
+      (t1, t2)
+  | _ ->
+      raise (Unify [])
+
+(* Used by [filter_method]. *)
+let rec filter_method_field env name priv ty =
+  let ty = expand_head_trace env ty in
+  match ty.desc with
+    Tvar _ ->
+      let level = ty.level in
+      let ty1 = newvar2 level and ty2 = newvar2 level in
+      let ty' = newty2 level (Tfield (name,
+                                      begin match priv with
+                                        Private -> Fvar (ref None)
+                                      | Public  -> Fpresent
+                                      end,
+                                      ty1, ty2))
+      in
+      link_type ty ty';
+      ty1
+  | Tfield(n, kind, ty1, ty2) ->
+      let kind = field_kind_repr kind in
+      if (n = name) && (kind <> Fabsent) then begin
+        if priv = Public then
+          unify_kind kind Fpresent;
+        ty1
+      end else
+        filter_method_field env name priv ty2
+  | _ ->
+      raise (Unify [])
+
+(* Unify [ty] and [< name : 'a; .. >]. Return ['a]. *)
+let filter_method env name priv ty =
+  let ty = expand_head_trace env ty in
+  match ty.desc with
+    Tvar _ ->
+      let ty1 = newvar () in
+      let ty' = newobj ty1 in
+      update_level env ty.level ty';
+      update_scope ty.scope ty';
+      link_type ty ty';
+      filter_method_field env name priv ty1
+  | Tobject(f, _) ->
+      filter_method_field env name priv f
+  | _ ->
+      raise (Unify [])
+
+let check_filter_method env name priv ty =
+  ignore(filter_method env name priv ty)
+
+let filter_self_method env lab priv meths ty =
+  let ty' = filter_method env lab priv ty in
+  try
+    Meths.find lab !meths
+  with Not_found ->
+    let pair = (Ident.create_local lab, ty') in
+    meths := Meths.add lab pair !meths;
+    pair
+
+
+                        (***********************************)
+                        (*  Matching between type schemes  *)
+                        (***********************************)
+
+(*
+   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 ty = repr ty in
+    if ty.level > level then begin
+      if is_Tvar ty && ty.level >= generic_level - 1 then raise Occur;
+      ty.level <- pivot_level - ty.level;
+      iter_type_expr occur ty
+    end
+  in
+  begin try
+    occur ty; unmark_type ty
+  with Occur ->
+    unmark_type ty; raise (Unify [])
+  end;
+  (* also check for free univars *)
+  occur_univar env ty;
+  update_level env level ty
+
+let may_instantiate inst_nongen t1 =
+  if inst_nongen then t1.level <> generic_level - 1
+                 else t1.level =  generic_level
+
+let rec moregen inst_nongen type_pairs env t1 t2 =
+  if t1 == t2 then () else
+  let t1 = repr t1 in
+  let t2 = repr t2 in
+  if t1 == t2 then () else
+
+  try
+    match (t1.desc, t2.desc) with
+      (Tvar _, _) when may_instantiate inst_nongen t1 ->
+        moregen_occur env t1.level t2;
+        update_scope t1.scope t2;
+        occur env t1 t2;
+        link_type t1 t2
+    | (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
+        ()
+    | _ ->
+        let t1' = expand_head env t1 in
+        let t2' = expand_head env t2 in
+        (* Expansion may have changed the representative of the types... *)
+        let t1' = repr t1' and t2' = repr t2' in
+        if t1' == t2' then () else
+        begin try
+          TypePairs.find type_pairs (t1', t2')
+        with Not_found ->
+          TypePairs.add type_pairs (t1', t2') ();
+          match (t1'.desc, t2'.desc) with
+            (Tvar _, _) when may_instantiate inst_nongen t1' ->
+              moregen_occur env t1'.level t2;
+              update_scope t1'.scope 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) ->
+              moregen inst_nongen type_pairs env t1 t2;
+              moregen inst_nongen type_pairs env u1 u2
+          | (Ttuple tl1, Ttuple tl2) ->
+              moregen_list inst_nongen type_pairs env tl1 tl2
+          | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _))
+                when Path.same p1 p2 ->
+              moregen_list inst_nongen type_pairs env tl1 tl2
+          | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) ->
+              begin try
+                unify_package env (moregen_list inst_nongen type_pairs env)
+                  t1'.level p1 n1 tl1 t2'.level p2 n2 tl2
+              with Not_found -> raise (Unify [])
+              end
+          | (Tvariant row1, Tvariant row2) ->
+              moregen_row inst_nongen type_pairs env row1 row2
+          | (Tobject (fi1, _nm1), Tobject (fi2, _nm2)) ->
+              moregen_fields inst_nongen type_pairs env fi1 fi2
+          | (Tfield _, Tfield _) ->           (* Actually unused *)
+              moregen_fields inst_nongen type_pairs env t1' t2'
+          | (Tnil, Tnil) ->
+              ()
+          | (Tpoly (t1, []), Tpoly (t2, [])) ->
+              moregen inst_nongen type_pairs env t1 t2
+          | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
+              enter_poly env univar_pairs t1 tl1 t2 tl2
+                (moregen inst_nongen type_pairs env)
+          | (Tunivar _, Tunivar _) ->
+              unify_univar t1' t2' !univar_pairs
+          | (_, _) ->
+              raise (Unify [])
+        end
+  with Unify trace ->  raise( Unify ( Trace.diff t1 t2 :: trace ) )
+
+and moregen_list inst_nongen type_pairs env tl1 tl2 =
+  if List.length tl1 <> List.length tl2 then
+    raise (Unify []);
+  List.iter2 (moregen inst_nongen type_pairs env) tl1 tl2
+
+and moregen_fields inst_nongen type_pairs env ty1 ty2 =
+  let (fields1, rest1) = flatten_fields ty1
+  and (fields2, rest2) = flatten_fields ty2 in
+  let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
+  if miss1 <> [] then raise (Unify []);
+  moregen inst_nongen type_pairs env rest1
+    (build_fields (repr ty2).level miss2 rest2);
+  List.iter
+    (fun (n, k1, t1, k2, t2) ->
+       moregen_kind k1 k2;
+       try moregen inst_nongen type_pairs env t1 t2 with Unify trace ->
+         let e = Trace.diff
+             (newty (Tfield(n, k1, t1, rest2)))
+             (newty (Tfield(n, k2, t2, rest2))) in
+         raise( Unify ( e :: trace ) )
+    )
+    pairs
+
+and moregen_kind k1 k2 =
+  let k1 = field_kind_repr k1 in
+  let k2 = field_kind_repr k2 in
+  if k1 == k2 then () else
+  match k1, k2 with
+    (Fvar r, (Fvar _ | Fpresent))  -> set_kind r k2
+  | (Fpresent, Fpresent)           -> ()
+  | _                              -> raise (Unify [])
+
+and moregen_row inst_nongen type_pairs env row1 row2 =
+  let row1 = row_repr row1 and row2 = row_repr row2 in
+  let rm1 = repr row1.row_more and rm2 = repr row2.row_more in
+  if rm1 == rm2 then () else
+  let may_inst =
+    is_Tvar rm1 && may_instantiate inst_nongen rm1 || rm1.desc = Tnil in
+  let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
+  let r1, r2 =
+    if row2.row_closed then
+      filter_row_fields may_inst r1, filter_row_fields false r2
+    else r1, r2
+  in
+  if r1 <> [] || row1.row_closed && (not row2.row_closed || r2 <> [])
+  then raise (Unify []);
+  begin match rm1.desc, rm2.desc with
+    Tunivar _, Tunivar _ ->
+      unify_univar rm1 rm2 !univar_pairs
+  | Tunivar _, _ | _, Tunivar _ ->
+      raise (Unify [])
+  | _ when static_row row1 -> ()
+  | _ when may_inst ->
+      let ext =
+        newgenty (Tvariant {row2 with row_fields = r2; row_name = None})
+      in
+      moregen_occur env rm1.level ext;
+      update_scope rm1.scope ext;
+      link_type rm1 ext
+  | Tconstr _, Tconstr _ ->
+      moregen inst_nongen type_pairs env rm1 rm2
+  | _ -> raise (Unify [])
+  end;
+  List.iter
+    (fun (_l,f1,f2) ->
+      let f1 = row_field_repr f1 and f2 = row_field_repr f2 in
+      if f1 == f2 then () else
+      match f1, f2 with
+        Rpresent(Some t1), Rpresent(Some t2) ->
+          moregen inst_nongen type_pairs env t1 t2
+      | Rpresent None, Rpresent None -> ()
+      | Reither(false, tl1, _, e1), Rpresent(Some t2) when may_inst ->
+          set_row_field e1 f2;
+          List.iter (fun t1 -> moregen inst_nongen type_pairs env t1 t2) tl1
+      | Reither(c1, tl1, _, e1), Reither(c2, tl2, m2, e2) ->
+          if e1 != e2 then begin
+            if c1 && not c2 then raise(Unify []);
+            set_row_field e1 (Reither (c2, [], m2, e2));
+            if List.length tl1 = List.length tl2 then
+              List.iter2 (moregen inst_nongen type_pairs env) tl1 tl2
+            else match tl2 with
+              t2 :: _ ->
+                List.iter (fun t1 -> moregen inst_nongen type_pairs env t1 t2)
+                  tl1
+            | [] ->
+                if tl1 <> [] then raise (Unify [])
+          end
+      | Reither(true, [], _, e1), Rpresent None when may_inst ->
+          set_row_field e1 f2
+      | Reither(_, _, _, e1), Rabsent when may_inst ->
+          set_row_field e1 f2
+      | Rabsent, Rabsent -> ()
+      | _ -> raise (Unify []))
+    pairs
+
+(* Must empty univar_pairs first *)
+let moregen inst_nongen type_pairs env patt subj =
+  univar_pairs := [];
+  moregen inst_nongen type_pairs env patt subj
+
+(*
+   Non-generic variable can be instantiated only if [inst_nongen] is
+   true. So, [inst_nongen] should be set to false if the subject might
+   contain non-generic variables (and we do not want them to be
+   instantiated).
+   Usually, the subject is given by the user, and the pattern
+   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 = duplicate_type (instance subj_sch) in
+  current_level := generic_level;
+  (* Duplicate generic variables *)
+  let patt = instance pat_sch in
+  let res =
+    try moregen inst_nongen (TypePairs.create 13) env patt subj; true with
+      Unify _ -> false
+  in
+  current_level := old_level;
+  res
+
+
+(* Alternative approach: "rigidify" a type scheme,
+   and check validity after unification *)
+(* Simpler, no? *)
+
+let rec rigidify_rec vars ty =
+  let ty = repr ty in
+  if ty.level >= lowest_level then begin
+    ty.level <- pivot_level - ty.level;
+    match ty.desc with
+    | Tvar _ ->
+        if not (List.memq ty !vars) then vars := ty :: !vars
+    | Tvariant row ->
+        let row = row_repr row in
+        let more = repr row.row_more in
+        if is_Tvar more && not (row_fixed row) then begin
+          let more' = newty2 more.level more.desc in
+          let row' =
+            {row with row_fixed=Some Rigid; row_fields=[]; row_more=more'}
+          in link_type more (newty2 ty.level (Tvariant row'))
+        end;
+        iter_row (rigidify_rec 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)
+    | _ ->
+        iter_type_expr (rigidify_rec vars) ty
+  end
+
+let rigidify ty =
+  let vars = ref [] in
+  rigidify_rec vars ty;
+  unmark_type ty;
+  !vars
+
+let all_distinct_vars env vars =
+  let tyl = ref [] in
+  List.for_all
+    (fun ty ->
+      let ty = expand_head env ty in
+      if List.memq ty !tyl then false else
+      (tyl := ty :: !tyl; is_Tvar ty))
+    vars
+
+let matches env ty ty' =
+  let snap = snapshot () in
+  let vars = rigidify ty in
+  cleanup_abbrev ();
+  let ok =
+    try unify env ty ty'; all_distinct_vars env vars
+    with Unify _ -> false
+  in
+  backtrack snap;
+  ok
+
+
+                 (*********************************************)
+                 (*  Equivalence between parameterized types  *)
+                 (*********************************************)
+
+let expand_head_rigid env ty =
+  let old = !rigid_variants in
+  rigid_variants := true;
+  let ty' = expand_head env ty in
+  rigid_variants := old; ty'
+
+let normalize_subst subst =
+  if List.exists
+      (function {desc=Tlink _}, _ | _, {desc=Tlink _} -> true | _ -> false)
+      !subst
+  then subst := List.map (fun (t1,t2) -> repr t1, repr t2) !subst
+
+let rec eqtype rename type_pairs subst env t1 t2 =
+  if t1 == t2 then () else
+  let t1 = repr t1 in
+  let t2 = repr t2 in
+  if t1 == t2 then () else
+
+  try
+    match (t1.desc, t2.desc) with
+      (Tvar _, Tvar _) when rename ->
+        begin try
+          normalize_subst subst;
+          if List.assq t1 !subst != t2 then raise (Unify [])
+        with Not_found ->
+          if List.exists (fun (_, t) -> t == t2) !subst then raise (Unify []);
+          subst := (t1, t2) :: !subst
+        end
+    | (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
+        ()
+    | _ ->
+        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... *)
+        let t1' = repr t1' and t2' = repr t2' in
+        if t1' == t2' then () else
+        begin try
+          TypePairs.find type_pairs (t1', t2')
+        with Not_found ->
+          TypePairs.add type_pairs (t1', t2') ();
+          match (t1'.desc, t2'.desc) with
+            (Tvar _, Tvar _) when rename ->
+              begin try
+                normalize_subst subst;
+                if List.assq t1' !subst != t2' then raise (Unify [])
+              with Not_found ->
+                if List.exists (fun (_, t) -> t == t2') !subst
+                then raise (Unify []);
+                subst := (t1', t2') :: !subst
+              end
+          | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) when l1 = l2
+            || !Clflags.classic && not (is_optional l1 || is_optional l2) ->
+              eqtype rename type_pairs subst env t1 t2;
+              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
+          | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) ->
+              begin try
+                unify_package env (eqtype_list rename type_pairs subst env)
+                  t1'.level p1 n1 tl1 t2'.level p2 n2 tl2
+              with Not_found -> raise (Unify [])
+              end
+          | (Tvariant row1, Tvariant row2) ->
+              eqtype_row rename type_pairs subst env row1 row2
+          | (Tobject (fi1, _nm1), Tobject (fi2, _nm2)) ->
+              eqtype_fields rename type_pairs subst env fi1 fi2
+          | (Tfield _, Tfield _) ->       (* Actually unused *)
+              eqtype_fields rename type_pairs subst env t1' t2'
+          | (Tnil, Tnil) ->
+              ()
+          | (Tpoly (t1, []), Tpoly (t2, [])) ->
+              eqtype rename type_pairs subst env t1 t2
+          | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
+              enter_poly env univar_pairs t1 tl1 t2 tl2
+                (eqtype rename type_pairs subst env)
+          | (Tunivar _, Tunivar _) ->
+              unify_univar t1' t2' !univar_pairs
+          | (_, _) ->
+              raise (Unify [])
+        end
+  with Unify trace ->  raise ( Unify (Trace.diff t1 t2 :: trace) )
+
+and eqtype_list rename type_pairs subst env tl1 tl2 =
+  if List.length tl1 <> List.length tl2 then
+    raise (Unify []);
+  List.iter2 (eqtype 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 =
+    rest1 == rest2 || TypePairs.mem type_pairs (rest1,rest2) ||
+    (rename && List.mem (rest1, rest2) !subst)
+  in
+  if same_row then () else
+  (* Try expansion, needed when called from Includecore.type_manifest *)
+  match expand_head_rigid env rest2 with
+    {desc=Tobject(ty2,_)} -> eqtype_fields rename type_pairs subst env ty1 ty2
+  | _ ->
+  let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
+  eqtype rename type_pairs subst env rest1 rest2;
+  if (miss1 <> []) || (miss2 <> []) then raise (Unify []);
+  List.iter
+    (function (n, k1, t1, k2, t2) ->
+       eqtype_kind k1 k2;
+       try eqtype rename type_pairs subst env t1 t2 with Unify trace ->
+         let e = Trace.diff
+             (newty (Tfield(n, k1, t1, rest2)))
+             (newty (Tfield(n, k2, t2, rest2))) in
+         raise ( Unify ( e :: trace ) )
+    )
+    pairs
+
+and eqtype_kind k1 k2 =
+  let k1 = field_kind_repr k1 in
+  let k2 = field_kind_repr k2 in
+  match k1, k2 with
+    (Fvar _, Fvar _)
+  | (Fpresent, Fpresent) -> ()
+  | _                    -> raise (Unify [])
+
+and eqtype_row rename type_pairs subst env row1 row2 =
+  (* Try expansion, needed when called from Includecore.type_manifest *)
+  match expand_head_rigid env (row_more row2) with
+    {desc=Tvariant row2} -> eqtype_row rename type_pairs subst env row1 row2
+  | _ ->
+  let row1 = row_repr row1 and row2 = row_repr row2 in
+  let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
+  if row1.row_closed <> row2.row_closed
+  || not row1.row_closed && (r1 <> [] || r2 <> [])
+  || filter_row_fields false (r1 @ r2) <> []
+  then raise (Unify []);
+  if not (static_row row1) then
+    eqtype rename type_pairs subst env row1.row_more row2.row_more;
+  List.iter
+    (fun (_,f1,f2) ->
+      match row_field_repr f1, row_field_repr f2 with
+        Rpresent(Some t1), Rpresent(Some t2) ->
+          eqtype rename type_pairs subst env t1 t2
+      | Reither(c1, [], _, _), Reither(c2, [], _, _) when c1 = c2 ->
+          ()
+      | Reither(c1, t1::tl1, _, _), Reither(c2, t2::tl2, _, _) when c1 = c2 ->
+          eqtype rename type_pairs subst env t1 t2;
+          if List.length tl1 = List.length tl2 then
+            (* if same length allow different types (meaning?) *)
+            List.iter2 (eqtype rename type_pairs subst env) tl1 tl2
+          else begin
+            (* otherwise everything must be equal *)
+            List.iter (eqtype rename type_pairs subst env t1) tl2;
+            List.iter (fun t1 -> eqtype rename type_pairs subst env t1 t2) tl1
+          end
+      | Rpresent None, Rpresent None -> ()
+      | Rabsent, Rabsent -> ()
+      | _ -> raise (Unify []))
+    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 rename type_pairs subst env t1 t2 =
+  eqtype_list rename type_pairs subst env [t1] [t2]
+
+(* Two modes: with or without renaming of variables *)
+let equal env rename tyl1 tyl2 =
+  try
+    eqtype_list rename (TypePairs.create 11) (ref []) env tyl1 tyl2; true
+  with
+    Unify _ -> false
+
+
+                          (*************************)
+                          (*  Class type matching  *)
+                          (*************************)
+
+
+type class_match_failure =
+    CM_Virtual_class
+  | CM_Parameter_arity_mismatch of int * int
+  | CM_Type_parameter_mismatch of Env.t * Unification_trace.t
+  | CM_Class_type_mismatch of Env.t * class_type * class_type
+  | CM_Parameter_mismatch of Env.t * Unification_trace.t
+  | CM_Val_type_mismatch of string * Env.t * Unification_trace.t
+  | CM_Meth_type_mismatch of string * Env.t * Unification_trace.t
+  | CM_Non_mutable_value of string
+  | CM_Non_concrete_value of string
+  | CM_Missing_value of string
+  | CM_Missing_method of string
+  | CM_Hide_public of string
+  | CM_Hide_virtual of string * string
+  | CM_Public_method of string
+  | CM_Private_method of string
+  | CM_Virtual_method of string
+
+exception Failure of class_match_failure list
+
+let rec moregen_clty trace type_pairs env cty1 cty2 =
+  try
+    match cty1, cty2 with
+      Cty_constr (_, _, cty1), _ ->
+        moregen_clty true type_pairs env cty1 cty2
+    | _, Cty_constr (_, _, cty2) ->
+        moregen_clty true type_pairs env cty1 cty2
+    | Cty_arrow (l1, ty1, cty1'), Cty_arrow (l2, ty2, cty2') when l1 = l2 ->
+        begin try moregen true type_pairs env ty1 ty2 with Unify trace ->
+          raise (Failure [CM_Parameter_mismatch (env, expand_trace env trace)])
+        end;
+        moregen_clty false type_pairs env cty1' cty2'
+    | Cty_signature sign1, Cty_signature sign2 ->
+        let ty1 = object_fields (repr sign1.csig_self) in
+        let ty2 = object_fields (repr sign2.csig_self) in
+        let (fields1, _rest1) = flatten_fields ty1
+        and (fields2, _rest2) = flatten_fields ty2 in
+        let (pairs, _miss1, _miss2) = associate_fields fields1 fields2 in
+        List.iter
+          (fun (lab, _k1, t1, _k2, t2) ->
+            begin try moregen true type_pairs env t1 t2 with Unify trace ->
+              raise (Failure [CM_Meth_type_mismatch
+                                 (lab, env, expand_trace env trace)])
+           end)
+        pairs;
+      Vars.iter
+        (fun lab (_mut, _v, ty) ->
+           let (_mut', _v', ty') = Vars.find lab sign1.csig_vars in
+           try moregen true type_pairs env ty' ty with Unify trace ->
+             raise (Failure [CM_Val_type_mismatch
+                                (lab, env, expand_trace env trace)]))
+        sign2.csig_vars
+  | _ ->
+      raise (Failure [])
+  with
+    Failure error when trace || error = [] ->
+      raise (Failure (CM_Class_type_mismatch (env, cty1, cty2)::error))
+
+let match_class_types ?(trace=true) env pat_sch subj_sch =
+  let type_pairs = TypePairs.create 53 in
+  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 res =
+    let sign1 = signature_of_class_type patt in
+    let sign2 = signature_of_class_type subj in
+    let t1 = repr sign1.csig_self in
+    let t2 = repr sign2.csig_self in
+    TypePairs.add type_pairs (t1, t2) ();
+    let (fields1, rest1) = flatten_fields (object_fields t1)
+    and (fields2, rest2) = flatten_fields (object_fields t2) in
+    let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
+    let error =
+      List.fold_right
+        (fun (lab, k, _) err ->
+           let err =
+             let k = field_kind_repr k in
+             begin match k with
+               Fvar r -> set_kind r Fabsent; err
+             | _      -> CM_Hide_public lab::err
+             end
+           in
+           if lab = dummy_method || Concr.mem lab sign1.csig_concr then err
+           else CM_Hide_virtual ("method", lab) :: err)
+        miss1 []
+    in
+    let missing_method = List.map (fun (m, _, _) -> m) miss2 in
+    let error =
+      (List.map (fun m -> CM_Missing_method m) missing_method) @ error
+    in
+    (* Always succeeds *)
+    moregen true type_pairs env rest1 rest2;
+    let error =
+      List.fold_right
+        (fun (lab, k1, _t1, k2, _t2) err ->
+           try moregen_kind k1 k2; err with
+             Unify _ -> CM_Public_method lab::err)
+        pairs error
+    in
+    let error =
+      Vars.fold
+        (fun lab (mut, vr, _ty) err ->
+          try
+            let (mut', vr', _ty') = Vars.find lab sign1.csig_vars in
+            if mut = Mutable && mut' <> Mutable then
+              CM_Non_mutable_value lab::err
+            else if vr = Concrete && vr' <> Concrete then
+              CM_Non_concrete_value lab::err
+            else
+              err
+          with Not_found ->
+            CM_Missing_value lab::err)
+        sign2.csig_vars error
+    in
+    let error =
+      Vars.fold
+        (fun lab (_,vr,_) err ->
+          if vr = Virtual && not (Vars.mem lab sign2.csig_vars) then
+            CM_Hide_virtual ("instance variable", lab) :: err
+          else err)
+        sign1.csig_vars error
+    in
+    let error =
+      List.fold_right
+        (fun e l ->
+           if List.mem e missing_method then l else CM_Virtual_method e::l)
+        (Concr.elements (Concr.diff sign2.csig_concr sign1.csig_concr))
+        error
+    in
+    match error with
+      [] ->
+        begin try
+          moregen_clty trace type_pairs env patt subj;
+          []
+        with
+          Failure r -> r
+        end
+    | error ->
+        CM_Class_type_mismatch (env, patt, subj)::error
+  in
+  current_level := old_level;
+  res
+
+let rec equal_clty trace type_pairs subst env cty1 cty2 =
+  try
+    match cty1, cty2 with
+      Cty_constr (_, _, cty1), Cty_constr (_, _, cty2) ->
+        equal_clty true type_pairs subst env cty1 cty2
+    | Cty_constr (_, _, cty1), _ ->
+        equal_clty true type_pairs subst env cty1 cty2
+    | _, Cty_constr (_, _, cty2) ->
+        equal_clty true type_pairs subst env cty1 cty2
+    | Cty_arrow (l1, ty1, cty1'), Cty_arrow (l2, ty2, cty2') when l1 = l2 ->
+        begin try eqtype true type_pairs subst env ty1 ty2 with Unify trace ->
+          raise (Failure [CM_Parameter_mismatch (env, expand_trace env trace)])
+        end;
+        equal_clty false type_pairs subst env cty1' cty2'
+    | Cty_signature sign1, Cty_signature sign2 ->
+        let ty1 = object_fields (repr sign1.csig_self) in
+        let ty2 = object_fields (repr sign2.csig_self) in
+        let (fields1, _rest1) = flatten_fields ty1
+        and (fields2, _rest2) = flatten_fields ty2 in
+        let (pairs, _miss1, _miss2) = associate_fields fields1 fields2 in
+        List.iter
+          (fun (lab, _k1, t1, _k2, t2) ->
+             begin try eqtype true type_pairs subst env t1 t2 with
+               Unify trace ->
+                 raise (Failure [CM_Meth_type_mismatch
+                                    (lab, env, expand_trace env trace)])
+             end)
+          pairs;
+        Vars.iter
+          (fun lab (_, _, ty) ->
+             let (_, _, ty') = Vars.find lab sign1.csig_vars in
+             try eqtype true type_pairs subst env ty' ty with Unify trace ->
+               raise (Failure [CM_Val_type_mismatch
+                                  (lab, env, expand_trace env trace)]))
+          sign2.csig_vars
+    | _ ->
+        raise
+          (Failure (if trace then []
+                    else [CM_Class_type_mismatch (env, cty1, cty2)]))
+  with
+    Failure error when trace ->
+      raise (Failure (CM_Class_type_mismatch (env, cty1, cty2)::error))
+
+let match_class_declarations env patt_params patt_type subj_params subj_type =
+  let type_pairs = TypePairs.create 53 in
+  let subst = ref [] in
+  let sign1 = signature_of_class_type patt_type in
+  let sign2 = signature_of_class_type subj_type in
+  let t1 = repr sign1.csig_self in
+  let t2 = repr sign2.csig_self in
+  TypePairs.add type_pairs (t1, t2) ();
+  let (fields1, rest1) = flatten_fields (object_fields t1)
+  and (fields2, rest2) = flatten_fields (object_fields t2) in
+  let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
+  let error =
+    List.fold_right
+      (fun (lab, k, _) err ->
+        let err =
+          let k = field_kind_repr k in
+          begin match k with
+            Fvar _ -> err
+          | _      -> CM_Hide_public lab::err
+          end
+        in
+        if Concr.mem lab sign1.csig_concr then err
+        else CM_Hide_virtual ("method", lab) :: err)
+      miss1 []
+  in
+  let missing_method = List.map (fun (m, _, _) -> m) miss2 in
+  let error =
+    (List.map (fun m -> CM_Missing_method m) missing_method) @ error
+  in
+  (* Always succeeds *)
+  eqtype true type_pairs subst env rest1 rest2;
+  let error =
+    List.fold_right
+      (fun (lab, k1, _t1, k2, _t2) err ->
+        let k1 = field_kind_repr k1 in
+        let k2 = field_kind_repr k2 in
+        match k1, k2 with
+          (Fvar _, Fvar _)
+        | (Fpresent, Fpresent) -> err
+        | (Fvar _, Fpresent)   -> CM_Private_method lab::err
+        | (Fpresent, Fvar _)  -> CM_Public_method lab::err
+        | _                    -> assert false)
+      pairs error
+  in
+  let error =
+    Vars.fold
+      (fun lab (mut, vr, _ty) err ->
+         try
+           let (mut', vr', _ty') = Vars.find lab sign1.csig_vars in
+           if mut = Mutable && mut' <> Mutable then
+             CM_Non_mutable_value lab::err
+           else if vr = Concrete && vr' <> Concrete then
+             CM_Non_concrete_value lab::err
+           else
+             err
+         with Not_found ->
+           CM_Missing_value lab::err)
+      sign2.csig_vars error
+  in
+  let error =
+    Vars.fold
+      (fun lab (_,vr,_) err ->
+        if vr = Virtual && not (Vars.mem lab sign2.csig_vars) then
+          CM_Hide_virtual ("instance variable", lab) :: err
+        else err)
+      sign1.csig_vars error
+  in
+  let error =
+    List.fold_right
+      (fun e l ->
+        if List.mem e missing_method then l else CM_Virtual_method e::l)
+      (Concr.elements (Concr.diff sign2.csig_concr sign1.csig_concr))
+      error
+  in
+  match error with
+    [] ->
+      begin try
+        let lp = List.length patt_params in
+        let ls = List.length subj_params in
+        if lp  <> ls then
+          raise (Failure [CM_Parameter_arity_mismatch (lp, ls)]);
+        List.iter2 (fun p s ->
+          try eqtype true type_pairs subst env p s with Unify trace ->
+            raise (Failure [CM_Type_parameter_mismatch
+                               (env, expand_trace env trace)]))
+          patt_params subj_params;
+     (* old code: equal_clty false type_pairs subst env patt_type subj_type; *)
+        equal_clty false type_pairs subst env
+          (Cty_signature sign1) (Cty_signature sign2);
+        (* Use moregeneral for class parameters, need to recheck everything to
+           keeps relationships (PR#4824) *)
+        let clty_params =
+          List.fold_right (fun ty cty -> Cty_arrow (Labelled "*",ty,cty)) in
+        match_class_types ~trace:false env
+          (clty_params patt_params patt_type)
+          (clty_params subj_params subj_type)
+      with
+        Failure r -> r
+      end
+  | error ->
+      error
+
+
+                              (***************)
+                              (*  Subtyping  *)
+                              (***************)
+
+
+(**** Build a subtype of a given type. ****)
+
+(* build_subtype:
+   [visited] traces traversed object and variant types
+   [loops] is a mapping from variables to variables, to reproduce
+     positive loops in a class type
+   [posi] true if the current variance is positive
+   [level] number of expansions/enlargement allowed on this branch *)
+
+let warn = ref false  (* whether double coercion might do better *)
+let pred_expand n = if n mod 2 = 0 && n > 0 then pred n else n
+let pred_enlarge n = if n mod 2 = 1 then pred n else n
+
+type change = Unchanged | Equiv | Changed
+let collect l = List.fold_left (fun c1 (_, c2) -> max c1 c2) Unchanged l
+
+let rec filter_visited = function
+    [] -> []
+  | {desc=Tobject _|Tvariant _} :: _ as l -> l
+  | _ :: l -> filter_visited l
+
+let memq_warn t visited =
+  if List.memq t visited then (warn := true; true) else false
+
+let find_cltype_for_path env p =
+  let cl_abbr = Env.find_hash_type p env in
+  match cl_abbr.type_manifest with
+    Some ty ->
+      begin match (repr ty).desc with
+        Tobject(_,{contents=Some(p',_)}) when Path.same p p' -> cl_abbr, ty
+      | _ -> raise Not_found
+      end
+  | None -> assert false
+
+let has_constr_row' env t =
+  has_constr_row (expand_abbrev env t)
+
+let rec build_subtype env visited loops posi level t =
+  let t = repr t in
+  match t.desc with
+    Tvar _ ->
+      if posi then
+        try
+          let t' = List.assq t loops in
+          warn := true;
+          (t', Equiv)
+        with Not_found ->
+          (t, Unchanged)
+      else
+        (t, Unchanged)
+  | Tarrow(l, t1, t2, _) ->
+      if memq_warn t visited then (t, Unchanged) else
+      let visited = t :: visited in
+      let (t1', c1) = build_subtype env visited loops (not posi) level t1 in
+      let (t2', c2) = build_subtype env visited loops posi level t2 in
+      let c = max c1 c2 in
+      if c > Unchanged then (newty (Tarrow(l, t1', t2', Cok)), c)
+      else (t, Unchanged)
+  | Ttuple tlist ->
+      if memq_warn t visited then (t, Unchanged) else
+      let visited = t :: visited in
+      let tlist' =
+        List.map (build_subtype env visited loops posi level) tlist
+      in
+      let c = collect tlist' in
+      if c > Unchanged then (newty (Ttuple (List.map fst tlist')), c)
+      else (t, Unchanged)
+  | Tconstr(p, tl, abbrev)
+    when level > 0 && generic_abbrev env p && safe_abbrev env t
+    && not (has_constr_row' env t) ->
+      let t' = repr (expand_abbrev env t) in
+      let level' = pred_expand level in
+      begin try match t'.desc with
+        Tobject _ when posi && not (opened_object t') ->
+          let cl_abbr, body = find_cltype_for_path env p in
+          let ty =
+            subst env !current_level Public abbrev None
+              cl_abbr.type_params tl body in
+          let ty = repr ty in
+          let ty1, tl1 =
+            match ty.desc with
+              Tobject(ty1,{contents=Some(p',tl1)}) when Path.same p p' ->
+                ty1, tl1
+            | _ -> raise Not_found
+          in
+          (* Fix PR#4505: do not set ty to Tvar when it appears in tl1,
+             as this occurrence might break the occur check.
+             XXX not clear whether this correct anyway... *)
+          if List.exists (deep_occur ty) tl1 then raise Not_found;
+          ty.desc <- Tvar None;
+          let t'' = newvar () in
+          let loops = (ty, t'') :: loops in
+          (* May discard [visited] as level is going down *)
+          let (ty1', c) =
+            build_subtype env [t'] loops posi (pred_enlarge level') ty1 in
+          assert (is_Tvar t'');
+          let nm =
+            if c > Equiv || deep_occur ty ty1' then None else Some(p,tl1) in
+          t''.desc <- Tobject (ty1', ref nm);
+          (try unify_var env ty t with Unify _ -> assert false);
+          (t'', Changed)
+      | _ -> raise Not_found
+      with Not_found ->
+        let (t'',c) = build_subtype env visited loops posi level' t' in
+        if c > Unchanged then (t'',c)
+        else (t, Unchanged)
+      end
+  | Tconstr(p, tl, _abbrev) ->
+      (* Must check recursion on constructors, since we do not always
+         expand them *)
+      if memq_warn t visited then (t, Unchanged) else
+      let visited = t :: visited in
+      begin try
+        let decl = Env.find_type p env in
+        if level = 0 && generic_abbrev env p && safe_abbrev env t
+        && not (has_constr_row' env t)
+        then warn := true;
+        let tl' =
+          List.map2
+            (fun v t ->
+              let (co,cn) = Variance.get_upper v in
+              if cn then
+                if co then (t, Unchanged)
+                else build_subtype env visited loops (not posi) level t
+              else
+                if co then build_subtype env visited loops posi level t
+                else (newvar(), Changed))
+            decl.type_variance tl
+        in
+        let c = collect tl' in
+        if c > Unchanged then (newconstr p (List.map fst tl'), c)
+        else (t, Unchanged)
+      with Not_found ->
+        (t, Unchanged)
+      end
+  | Tvariant row ->
+      let row = row_repr row in
+      if memq_warn t visited || not (static_row row) then (t, Unchanged) else
+      let level' = pred_enlarge level in
+      let visited =
+        t :: if level' < level then [] else filter_visited visited in
+      let fields = filter_row_fields false row.row_fields in
+      let fields =
+        List.map
+          (fun (l,f as orig) -> match row_field_repr f with
+            Rpresent None ->
+              if posi then
+                (l, Reither(true, [], false, ref None)), Unchanged
+              else
+                orig, Unchanged
+          | Rpresent(Some t) ->
+              let (t', c) = build_subtype env visited loops posi level' t in
+              let f =
+                if posi && level > 0
+                then Reither(false, [t'], false, ref None)
+                else Rpresent(Some t')
+              in (l, f), c
+          | _ -> assert false)
+          fields
+      in
+      let c = collect fields in
+      let row =
+        { row_fields = List.map fst fields; row_more = newvar();
+          row_bound = (); row_closed = posi; row_fixed = None;
+          row_name = if c > Unchanged then None else row.row_name }
+      in
+      (newty (Tvariant row), Changed)
+  | Tobject (t1, _) ->
+      if memq_warn t visited || opened_object t1 then (t, Unchanged) else
+      let level' = pred_enlarge level in
+      let visited =
+        t :: if level' < level then [] else filter_visited visited in
+      let (t1', c) = build_subtype env visited loops posi level' t1 in
+      if c > Unchanged then (newty (Tobject (t1', ref None)), c)
+      else (t, Unchanged)
+  | Tfield(s, _, t1, t2) (* Always present *) ->
+      let (t1', c1) = build_subtype env visited loops posi level t1 in
+      let (t2', c2) = build_subtype env visited loops posi level t2 in
+      let c = max c1 c2 in
+      if c > Unchanged then (newty (Tfield(s, Fpresent, t1', t2')), c)
+      else (t, Unchanged)
+  | Tnil ->
+      if posi then
+        let v = newvar () in
+        (v, Changed)
+      else begin
+        warn := true;
+        (t, Unchanged)
+      end
+  | Tsubst _ | Tlink _ ->
+      assert false
+  | Tpoly(t1, tl) ->
+      let (t1', c) = build_subtype env visited loops posi level t1 in
+      if c > Unchanged then (newty (Tpoly(t1', tl)), c)
+      else (t, Unchanged)
+  | Tunivar _ | Tpackage _ ->
+      (t, Unchanged)
+
+let enlarge_type env ty =
+  warn := false;
+  (* [level = 4] allows 2 expansions involving objects/variants *)
+  let (ty', _) = build_subtype env [] [] true 4 ty in
+  (ty', !warn)
+
+(**** Check whether a type is a subtype of another type. ****)
+
+(*
+    During the traversal, a trace of visited types is maintained. It
+    is printed in case of error.
+    Constraints (pairs of types that must be equals) are accumulated
+    rather than being enforced straight. Indeed, the result would
+    otherwise depend on the order in which these constraints are
+    enforced.
+    A function enforcing these constraints is returned. That way, type
+    variables can be bound to their actual values before this function
+    is called (see Typecore).
+    Only well-defined abbreviations are expanded (hence the tests
+    [generic_abbrev ...]).
+*)
+
+let subtypes = TypePairs.create 17
+
+let subtype_error env trace =
+  raise (Subtype (expand_trace env (List.rev trace), []))
+
+let rec subtype_rec env trace t1 t2 cstrs =
+  let t1 = repr t1 in
+  let t2 = repr t2 in
+  if t1 == t2 then cstrs else
+
+  begin try
+    TypePairs.find subtypes (t1, t2);
+    cstrs
+  with Not_found ->
+    TypePairs.add subtypes (t1, t2) ();
+    match (t1.desc, t2.desc) 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) ->
+        let cstrs = subtype_rec env (Trace.diff t2 t1::trace) t2 t1 cstrs in
+        subtype_rec env (Trace.diff u1 u2::trace) u1 u2 cstrs
+    | (Ttuple tl1, Ttuple tl2) ->
+        subtype_list env trace tl1 tl2 cstrs
+    | (Tconstr(p1, [], _), Tconstr(p2, [], _)) when Path.same p1 p2 ->
+        cstrs
+    | (Tconstr(p1, _tl1, _abbrev1), _)
+      when generic_abbrev env p1 && safe_abbrev env t1 ->
+        subtype_rec env trace (expand_abbrev env t1) t2 cstrs
+    | (_, Tconstr(p2, _tl2, _abbrev2))
+      when generic_abbrev env p2 && safe_abbrev env t2 ->
+        subtype_rec env trace t1 (expand_abbrev env t2) cstrs
+    | (Tconstr(p1, tl1, _), Tconstr(p2, tl2, _)) when Path.same p1 p2 ->
+        begin try
+          let decl = Env.find_type p1 env in
+          List.fold_left2
+            (fun cstrs v (t1, t2) ->
+              let (co, cn) = Variance.get_upper v in
+              if co then
+                if cn then
+                  (trace, newty2 t1.level (Ttuple[t1]),
+                   newty2 t2.level (Ttuple[t2]), !univar_pairs) :: cstrs
+                else subtype_rec env (Trace.diff t1 t2::trace) t1 t2 cstrs
+              else
+                if cn then subtype_rec env (Trace.diff t2 t1::trace) t2 t1 cstrs
+                else cstrs)
+            cstrs decl.type_variance (List.combine tl1 tl2)
+        with Not_found ->
+          (trace, t1, t2, !univar_pairs)::cstrs
+        end
+    | (Tconstr(p1, _, _), _) when generic_private_abbrev env p1 ->
+        subtype_rec env trace (expand_abbrev_opt env t1) t2 cstrs
+(*  | (_, Tconstr(p2, _, _)) when generic_private_abbrev false env p2 ->
+        subtype_rec env trace t1 (expand_abbrev_opt env t2) cstrs *)
+    | (Tobject (f1, _), Tobject (f2, _))
+      when is_Tvar (object_row f1) && is_Tvar (object_row f2) ->
+        (* Same row variable implies same object. *)
+        (trace, t1, t2, !univar_pairs)::cstrs
+    | (Tobject (f1, _), Tobject (f2, _)) ->
+        subtype_fields env trace f1 f2 cstrs
+    | (Tvariant row1, Tvariant row2) ->
+        begin try
+          subtype_row env trace row1 row2 cstrs
+        with Exit ->
+          (trace, t1, t2, !univar_pairs)::cstrs
+        end
+    | (Tpoly (u1, []), Tpoly (u2, [])) ->
+        subtype_rec env trace u1 u2 cstrs
+    | (Tpoly (u1, tl1), Tpoly (u2, [])) ->
+        let _, u1' = instance_poly false tl1 u1 in
+        subtype_rec env trace u1' u2 cstrs
+    | (Tpoly (u1, tl1), Tpoly (u2,tl2)) ->
+        begin try
+          enter_poly env univar_pairs u1 tl1 u2 tl2
+            (fun t1 t2 -> subtype_rec env trace t1 t2 cstrs)
+        with Unify _ ->
+          (trace, t1, t2, !univar_pairs)::cstrs
+        end
+    | (Tpackage (p1, nl1, tl1), Tpackage (p2, nl2, tl2)) ->
+        begin try
+          let ntl1 = complete_type_list env nl2 t1.level (Mty_ident p1) nl1 tl1
+          and ntl2 = complete_type_list env nl1 t2.level (Mty_ident p2) nl2 tl2
+              ~allow_absent:true in
+          let cstrs' =
+            List.map
+              (fun (n2,t2) -> (trace, List.assoc n2 ntl1, t2, !univar_pairs))
+              ntl2
+          in
+          if eq_package_path env p1 p2 then cstrs' @ cstrs
+          else begin
+            (* need to check module subtyping *)
+            let snap = Btype.snapshot () in
+            try
+              List.iter (fun (_, t1, t2, _) -> unify env t1 t2) cstrs';
+              if !package_subtype env p1 nl1 tl1 p2 nl2 tl2
+              then (Btype.backtrack snap; cstrs' @ cstrs)
+              else raise (Unify [])
+            with Unify _ ->
+              Btype.backtrack snap; raise Not_found
+          end
+        with Not_found ->
+          (trace, t1, t2, !univar_pairs)::cstrs
+        end
+    | (_, _) ->
+        (trace, t1, t2, !univar_pairs)::cstrs
+  end
+
+and subtype_list env trace tl1 tl2 cstrs =
+  if List.length tl1 <> List.length tl2 then
+    subtype_error env trace;
+  List.fold_left2
+    (fun cstrs t1 t2 -> subtype_rec env (Trace.diff t1 t2::trace) t1 t2 cstrs)
+    cstrs tl1 tl2
+
+and subtype_fields env trace ty1 ty2 cstrs =
+  (* Assume that either rest1 or rest2 is not Tvar *)
+  let (fields1, rest1) = flatten_fields ty1 in
+  let (fields2, rest2) = flatten_fields ty2 in
+  let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
+  let cstrs =
+    if rest2.desc = Tnil then cstrs else
+    if miss1 = [] then
+      subtype_rec env (Trace.diff rest1 rest2::trace) rest1 rest2 cstrs
+    else
+      (trace, build_fields (repr ty1).level miss1 rest1, rest2,
+       !univar_pairs) :: cstrs
+  in
+  let cstrs =
+    if miss2 = [] then cstrs else
+    (trace, rest1, build_fields (repr ty2).level miss2 (newvar ()),
+     !univar_pairs) :: cstrs
+  in
+  List.fold_left
+    (fun cstrs (_, _k1, t1, _k2, t2) ->
+      (* These fields are always present *)
+      subtype_rec env (Trace.diff t1 t2::trace) t1 t2 cstrs)
+    cstrs pairs
+
+and subtype_row env trace row1 row2 cstrs =
+  let row1 = row_repr row1 and row2 = row_repr row2 in
+  let r1, r2, pairs =
+    merge_row_fields row1.row_fields row2.row_fields in
+  let r1 = if row2.row_closed then filter_row_fields false r1 else r1 in
+  let r2 = if row1.row_closed then filter_row_fields false r2 else r2 in
+  let more1 = repr row1.row_more
+  and more2 = repr row2.row_more in
+  match more1.desc, more2.desc with
+    Tconstr(p1,_,_), Tconstr(p2,_,_) when Path.same p1 p2 ->
+      subtype_rec env (Trace.diff more1 more2::trace) more1 more2 cstrs
+  | (Tvar _|Tconstr _|Tnil), (Tvar _|Tconstr _|Tnil)
+    when row1.row_closed && r1 = [] ->
+      List.fold_left
+        (fun cstrs (_,f1,f2) ->
+          match row_field_repr f1, row_field_repr f2 with
+            (Rpresent None|Reither(true,_,_,_)), Rpresent None ->
+              cstrs
+          | Rpresent(Some t1), Rpresent(Some t2) ->
+              subtype_rec env (Trace.diff t1 t2::trace) t1 t2 cstrs
+          | Reither(false, t1::_, _, _), Rpresent(Some t2) ->
+              subtype_rec env (Trace.diff t1 t2::trace) t1 t2 cstrs
+          | Rabsent, _ -> cstrs
+          | _ -> raise Exit)
+        cstrs pairs
+  | Tunivar _, Tunivar _
+    when row1.row_closed = row2.row_closed && r1 = [] && r2 = [] ->
+      let cstrs =
+        subtype_rec env (Trace.diff more1 more2::trace) more1 more2 cstrs in
+      List.fold_left
+        (fun cstrs (_,f1,f2) ->
+          match row_field_repr f1, row_field_repr f2 with
+            Rpresent None, Rpresent None
+          | Reither(true,[],_,_), Reither(true,[],_,_)
+          | Rabsent, Rabsent ->
+              cstrs
+          | Rpresent(Some t1), Rpresent(Some t2)
+          | Reither(false,[t1],_,_), Reither(false,[t2],_,_) ->
+              subtype_rec env (Trace.diff t1 t2::trace) t1 t2 cstrs
+          | _ -> raise Exit)
+        cstrs pairs
+  | _ ->
+      raise Exit
+
+let subtype env ty1 ty2 =
+  TypePairs.clear subtypes;
+  univar_pairs := [];
+  (* Build constraint set. *)
+  let cstrs = subtype_rec env [Trace.diff ty1 ty2] ty1 ty2 [] in
+  TypePairs.clear subtypes;
+  (* Enforce constraints. *)
+  function () ->
+    List.iter
+      (function (trace0, t1, t2, pairs) ->
+         try unify_pairs (ref env) t1 t2 pairs with Unify trace ->
+           raise (Subtype (expand_trace env (List.rev trace0),
+                           List.tl trace)))
+      (List.rev cstrs)
+
+                              (*******************)
+                              (*  Miscellaneous  *)
+                              (*******************)
+
+(* Utility for printing. The resulting type is not used in computation. *)
+let rec unalias_object ty =
+  let ty = repr ty in
+  match ty.desc with
+    Tfield (s, k, t1, t2) ->
+      newty2 ty.level (Tfield (s, k, t1, unalias_object t2))
+  | Tvar _ | Tnil ->
+      newty2 ty.level ty.desc
+  | Tunivar _ ->
+      ty
+  | Tconstr _ ->
+      newvar2 ty.level
+  | _ ->
+      assert false
+
+let unalias ty =
+  let ty = repr ty in
+  match ty.desc with
+    Tvar _ | Tunivar _ ->
+      ty
+  | Tvariant row ->
+      let row = row_repr row in
+      let more = row.row_more in
+      newty2 ty.level
+        (Tvariant {row with row_more = newty2 more.level more.desc})
+  | Tobject (ty, nm) ->
+      newty2 ty.level (Tobject (unalias_object ty, nm))
+  | _ ->
+      newty2 ty.level ty.desc
+
+(* Return the arity (as for curried functions) of the given type. *)
+let rec arity ty =
+  match (repr ty).desc with
+    Tarrow(_, _t1, t2, _) -> 1 + arity t2
+  | _ -> 0
+
+(* Check whether an abbreviation expands to itself. *)
+let cyclic_abbrev env id ty =
+  let rec check_cycle seen ty =
+    let ty = repr ty in
+    match ty.desc with
+      Tconstr (p, _tl, _abbrev) ->
+        p = Path.Pident id || List.memq ty seen ||
+        begin try
+          check_cycle (ty :: seen) (expand_abbrev_opt env ty)
+        with
+          Cannot_expand -> false
+        | Unify _ -> true
+        end
+    | _ ->
+        false
+  in check_cycle [] ty
+
+(* Check for non-generalizable type variables *)
+exception Non_closed0
+let visited = ref TypeSet.empty
+
+let rec closed_schema_rec env ty =
+  let ty = repr ty in
+  if TypeSet.mem ty !visited then () else begin
+    visited := TypeSet.add ty !visited;
+    match ty.desc with
+      Tvar _ when ty.level <> generic_level ->
+        raise Non_closed0
+    | Tconstr _ ->
+        let old = !visited in
+        begin try iter_type_expr (closed_schema_rec env) ty
+        with Non_closed0 -> try
+          visited := old;
+          closed_schema_rec env (try_expand_head try_expand_safe env ty)
+        with Cannot_expand ->
+          raise Non_closed0
+        end
+    | Tfield(_, kind, t1, t2) ->
+        if field_kind_repr kind = Fpresent then
+          closed_schema_rec env t1;
+        closed_schema_rec env t2
+    | Tvariant row ->
+        let row = row_repr row in
+        iter_row (closed_schema_rec env) row;
+        if not (static_row row) then closed_schema_rec env row.row_more
+    | _ ->
+        iter_type_expr (closed_schema_rec env) ty
+  end
+
+(* Return whether all variables of type [ty] are generic. *)
+let closed_schema env ty =
+  visited := TypeSet.empty;
+  try
+    closed_schema_rec env ty;
+    visited := TypeSet.empty;
+    true
+  with Non_closed0 ->
+    visited := TypeSet.empty;
+    false
+
+(* Normalize a type before printing, saving... *)
+(* Cannot use mark_type because deep_occur uses it too *)
+let rec normalize_type_rec env visited ty =
+  let ty = repr ty in
+  if not (TypeSet.mem ty !visited) then begin
+    visited := TypeSet.add ty !visited;
+    let tm = row_of_type ty in
+    begin if not (is_Tconstr ty) && is_constr_row ~allow_ident:false tm then
+      match tm.desc with (* PR#7348 *)
+        Tconstr (Path.Pdot(m,i), tl, _abbrev) ->
+          let i' = String.sub i 0 (String.length i - 4) in
+          set_type_desc ty (Tconstr(Path.Pdot(m,i'), tl, ref Mnil))
+      | _ -> assert false
+    else match ty.desc with
+    | Tvariant row ->
+      let row = row_repr row in
+      let fields = List.map
+          (fun (l,f0) ->
+            let f = row_field_repr f0 in l,
+            match f with Reither(b, ty::(_::_ as tyl), m, e) ->
+              let tyl' =
+                List.fold_left
+                  (fun tyl ty ->
+                    if List.exists (fun ty' -> equal env false [ty] [ty']) tyl
+                    then tyl else ty::tyl)
+                  [ty] tyl
+              in
+              if f != f0 || List.length tyl' < List.length tyl then
+                Reither(b, List.rev tyl', m, e)
+              else f
+            | _ -> f)
+          row.row_fields in
+      let fields =
+        List.sort (fun (p,_) (q,_) -> compare p q)
+          (List.filter (fun (_,fi) -> fi <> Rabsent) fields) in
+      set_type_desc ty (Tvariant {row with row_fields = fields})
+    | Tobject (fi, nm) ->
+        begin match !nm with
+        | None -> ()
+        | Some (n, v :: l) ->
+            if deep_occur ty (newgenty (Ttuple l)) then
+              (* The abbreviation may be hiding something, so remove it *)
+              set_name nm None
+            else let v' = repr v in
+            begin match v'.desc with
+            | Tvar _ | Tunivar _ ->
+                if v' != v then set_name nm (Some (n, v' :: l))
+            | Tnil ->
+                set_type_desc ty (Tconstr (n, l, ref Mnil))
+            | _ -> set_name nm None
+            end
+        | _ ->
+            fatal_error "Ctype.normalize_type_rec"
+        end;
+        let fi = repr fi in
+        if fi.level < lowest_level then () else
+        let fields, row = flatten_fields fi in
+        let fi' = build_fields fi.level fields row in
+        set_type_desc fi fi'.desc
+    | _ -> ()
+    end;
+    iter_type_expr (normalize_type_rec env visited) ty
+  end
+
+let normalize_type env ty =
+  normalize_type_rec env (ref TypeSet.empty) ty
+
+
+                              (*************************)
+                              (*  Remove dependencies  *)
+                              (*************************)
+
+
+(*
+   Variables are left unchanged. Other type nodes are duplicated, with
+   levels set to generic level.
+   We cannot use Tsubst here, because unification may be called by
+   expand_abbrev.
+*)
+
+let nondep_hash     = TypeHash.create 47
+let nondep_variants = TypeHash.create 17
+let clear_hash ()   =
+  TypeHash.clear nondep_hash; TypeHash.clear nondep_variants
+
+exception Nondep_cannot_erase of Ident.t
+
+let rec nondep_type_rec ?(expand_private=false) env ids ty =
+  let expand_abbrev env t =
+    if expand_private then expand_abbrev_opt env t else expand_abbrev env t
+  in
+  match ty.desc with
+    Tvar _ | Tunivar _ -> ty
+  | Tlink ty -> nondep_type_rec env ids ty
+  | _ -> try TypeHash.find nondep_hash ty
+  with Not_found ->
+    let ty' = newgenvar () in        (* Stub *)
+    TypeHash.add nondep_hash ty ty';
+    ty'.desc <-
+      begin match ty.desc with
+      | Tconstr(p, tl, _abbrev) ->
+          begin match Path.find_free_opt ids p with
+          | Some id ->
+              begin try
+                Tlink (nondep_type_rec ~expand_private env ids
+                         (expand_abbrev env (newty2 ty.level ty.desc)))
+                (*
+                   The [Tlink] is important. The expanded type may be a
+                   variable, or may not be completely copied yet
+                   (recursive type), so one cannot just take its
+                   description.
+                 *)
+              with Cannot_expand | Unify _ ->
+                raise (Nondep_cannot_erase id)
+              end
+          | None ->
+              Tconstr(p, List.map (nondep_type_rec env ids) tl, ref Mnil)
+          end
+      | Tpackage(p, nl, tl) when Path.exists_free ids p ->
+          let p' = normalize_package_path env p in
+          begin match Path.find_free_opt ids p' with
+          | Some id -> raise (Nondep_cannot_erase id)
+          | None -> Tpackage (p', nl, List.map (nondep_type_rec env ids) tl)
+          end
+      | Tobject (t1, name) ->
+          Tobject (nondep_type_rec env ids t1,
+                 ref (match !name with
+                        None -> None
+                      | Some (p, tl) ->
+                          if Path.exists_free ids p then None
+                          else Some (p, List.map (nondep_type_rec env ids) tl)))
+      | Tvariant row ->
+          let row = row_repr row in
+          let more = repr row.row_more in
+          (* We must keep sharing according to the row variable *)
+          begin try
+            let ty2 = TypeHash.find nondep_variants more in
+            (* This variant type has been already copied *)
+            TypeHash.add nondep_hash ty ty2;
+            Tlink ty2
+          with Not_found ->
+            (* Register new type first for recursion *)
+            TypeHash.add nondep_variants more ty';
+            let static = static_row row in
+            let more' = if static then newgenty Tnil else more in
+            (* Return a new copy *)
+            let row =
+              copy_row (nondep_type_rec env ids) true row true more' in
+            match row.row_name with
+              Some (p, _tl) when Path.exists_free ids p ->
+                Tvariant {row with row_name = None}
+            | _ -> Tvariant row
+          end
+      | _ -> copy_type_desc (nondep_type_rec env ids) ty.desc
+      end;
+    ty'
+
+let nondep_type env id ty =
+  try
+    let ty' = nondep_type_rec env id ty in
+    clear_hash ();
+    ty'
+  with Nondep_cannot_erase _ as exn ->
+    clear_hash ();
+    raise exn
+
+let () = nondep_type' := nondep_type
+
+(* Preserve sharing inside type declarations. *)
+let nondep_type_decl env mid is_covariant decl =
+  try
+    let params = List.map (nondep_type_rec env mid) decl.type_params in
+    let tk =
+      try map_kind (nondep_type_rec env mid) decl.type_kind
+      with Nondep_cannot_erase _ when is_covariant -> Type_abstract
+    and tm, priv =
+      match decl.type_manifest with
+      | None -> None, decl.type_private
+      | Some ty ->
+          try Some (nondep_type_rec env mid ty), decl.type_private
+          with Nondep_cannot_erase _ when is_covariant ->
+            clear_hash ();
+            try Some (nondep_type_rec ~expand_private:true env mid ty),
+                Private
+            with Nondep_cannot_erase _ ->
+              None, decl.type_private
+    in
+    clear_hash ();
+    let priv =
+      match tm with
+      | Some ty when Btype.has_constr_row ty -> Private
+      | _ -> priv
+    in
+    { type_params = params;
+      type_arity = decl.type_arity;
+      type_kind = tk;
+      type_manifest = tm;
+      type_private = priv;
+      type_variance = decl.type_variance;
+      type_separability = decl.type_separability;
+      type_is_newtype = false;
+      type_expansion_scope = Btype.lowest_level;
+      type_loc = decl.type_loc;
+      type_attributes = decl.type_attributes;
+      type_immediate = decl.type_immediate;
+      type_unboxed = decl.type_unboxed;
+      type_uid = decl.type_uid;
+    }
+  with Nondep_cannot_erase _ as exn ->
+    clear_hash ();
+    raise exn
+
+(* Preserve sharing inside extension constructors. *)
+let nondep_extension_constructor env ids ext =
+  try
+    let type_path, type_params =
+      match Path.find_free_opt ids ext.ext_type_path with
+      | Some id ->
+        begin
+          let ty =
+            newgenty (Tconstr(ext.ext_type_path, ext.ext_type_params, ref Mnil))
+          in
+          let ty' = nondep_type_rec env ids ty in
+            match (repr ty').desc with
+                Tconstr(p, tl, _) -> p, tl
+              | _ -> raise (Nondep_cannot_erase id)
+        end
+      | None ->
+        let type_params =
+          List.map (nondep_type_rec env ids) ext.ext_type_params
+        in
+          ext.ext_type_path, type_params
+    in
+    let args = map_type_expr_cstr_args (nondep_type_rec env ids) ext.ext_args in
+    let ret_type = Option.map (nondep_type_rec env ids) ext.ext_ret_type in
+      clear_hash ();
+      { ext_type_path = type_path;
+        ext_type_params = type_params;
+        ext_args = args;
+        ext_ret_type = ret_type;
+        ext_private = ext.ext_private;
+        ext_attributes = ext.ext_attributes;
+        ext_loc = ext.ext_loc;
+        ext_uid = ext.ext_uid;
+      }
+  with Nondep_cannot_erase _ as exn ->
+    clear_hash ();
+    raise exn
+
+
+(* Preserve sharing inside class types. *)
+let nondep_class_signature env id sign =
+  { csig_self = nondep_type_rec env id sign.csig_self;
+    csig_vars =
+      Vars.map (function (m, v, t) -> (m, v, nondep_type_rec env id t))
+        sign.csig_vars;
+    csig_concr = sign.csig_concr;
+    csig_inher =
+      List.map (fun (p,tl) -> (p, List.map (nondep_type_rec env id) tl))
+        sign.csig_inher }
+
+let rec nondep_class_type env ids =
+  function
+    Cty_constr (p, _, cty) when Path.exists_free ids p ->
+      nondep_class_type env ids cty
+  | Cty_constr (p, tyl, cty) ->
+      Cty_constr (p, List.map (nondep_type_rec env ids) tyl,
+                   nondep_class_type env ids cty)
+  | Cty_signature sign ->
+      Cty_signature (nondep_class_signature env ids sign)
+  | Cty_arrow (l, ty, cty) ->
+      Cty_arrow (l, nondep_type_rec env ids ty, nondep_class_type env ids cty)
+
+let nondep_class_declaration env ids decl =
+  assert (not (Path.exists_free ids decl.cty_path));
+  let decl =
+    { cty_params = List.map (nondep_type_rec env ids) decl.cty_params;
+      cty_variance = decl.cty_variance;
+      cty_type = nondep_class_type env ids decl.cty_type;
+      cty_path = decl.cty_path;
+      cty_new =
+        begin match decl.cty_new with
+          None    -> None
+        | Some ty -> Some (nondep_type_rec env ids ty)
+        end;
+      cty_loc = decl.cty_loc;
+      cty_attributes = decl.cty_attributes;
+      cty_uid = decl.cty_uid;
+    }
+  in
+  clear_hash ();
+  decl
+
+let nondep_cltype_declaration env ids decl =
+  assert (not (Path.exists_free ids decl.clty_path));
+  let decl =
+    { clty_params = List.map (nondep_type_rec env ids) decl.clty_params;
+      clty_variance = decl.clty_variance;
+      clty_type = nondep_class_type env ids decl.clty_type;
+      clty_path = decl.clty_path;
+      clty_loc = decl.clty_loc;
+      clty_attributes = decl.clty_attributes;
+      clty_uid = decl.clty_uid;
+    }
+  in
+  clear_hash ();
+  decl
+
+(* collapse conjunctive types in class parameters *)
+let rec collapse_conj env visited ty =
+  let ty = repr ty in
+  if List.memq ty visited then () else
+  let visited = ty :: visited in
+  match ty.desc with
+    Tvariant row ->
+      let row = row_repr row in
+      List.iter
+        (fun (_l,fi) ->
+          match row_field_repr fi with
+            Reither (c, t1::(_::_ as tl), m, e) ->
+              List.iter (unify env t1) tl;
+              set_row_field e (Reither (c, [t1], m, ref None))
+          | _ ->
+              ())
+        row.row_fields;
+      iter_row (collapse_conj env visited) row
+  | _ ->
+      iter_type_expr (collapse_conj env visited) ty
+
+let collapse_conj_params env params =
+  List.iter (collapse_conj env []) params
+
+let same_constr env t1 t2 =
+  let t1 = expand_head env t1 in
+  let t2 = expand_head env t2 in
+  match t1.desc, t2.desc with
+  | Tconstr (p1, _, _), Tconstr (p2, _, _) -> Path.same p1 p2
+  | _ -> false
+
+let () =
+  Env.same_constr := same_constr
+
+let is_immediate = function
+  | Type_immediacy.Unknown -> false
+  | Type_immediacy.Always -> true
+  | Type_immediacy.Always_on_64bits ->
+      (* In bytecode, we don't know at compile time whether we are
+         targeting 32 or 64 bits. *)
+      !Clflags.native_code && Sys.word_size = 64
+
+let immediacy env typ =
+   match (repr typ).desc with
+  | Tconstr(p, _args, _abbrev) ->
+    begin try
+      let type_decl = Env.find_type p env in
+      type_decl.type_immediate
+    with Not_found -> Type_immediacy.Unknown
+    (* This can happen due to e.g. missing -I options,
+       causing some .cmi files to be unavailable.
+       Maybe we should emit a warning. *)
+    end
+  | Tvariant row ->
+      let row = Btype.row_repr row in
+      (* if all labels are devoid of arguments, not a pointer *)
+      if
+        not row.row_closed
+        || List.exists
+          (function
+            | _, (Rpresent (Some _) | Reither (false, _, _, _)) -> true
+            | _ -> false)
+          row.row_fields
+      then
+        Type_immediacy.Unknown
+      else
+        Type_immediacy.Always
+  | _ -> Type_immediacy.Unknown
+
+let maybe_pointer_type env typ = not (is_immediate (immediacy env typ))
diff --git a/typing/ctype.mli b/typing/ctype.mli
new file mode 100644
index 00000000..05fb78ce
--- /dev/null
+++ b/typing/ctype.mli
@@ -0,0 +1,371 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Operations on core types *)
+
+open Asttypes
+open Types
+
+module Unification_trace: sig
+  (** Unification traces are used to explain unification errors
+      when printing error messages *)
+
+  type position = First | Second
+  type desc = { t: type_expr; expanded: type_expr option }
+  type 'a diff = { got: 'a; expected: 'a}
+
+   (** Scope escape related errors *)
+    type 'a escape =
+    | Constructor of Path.t
+    | Univ of type_expr
+    (** The type_expr argument of [Univ] is always a [Tunivar _],
+        we keep a [type_expr] to track renaming in {!Printtyp} *)
+    | Self
+    | Module_type of Path.t
+    | Equation of 'a
+
+   (** Errors for polymorphic variants *)
+
+  type fixed_row_case =
+    | Cannot_be_closed
+    | Cannot_add_tags of string list
+
+  type variant =
+    | No_intersection
+    | No_tags of position * (Asttypes.label * row_field) list
+    | Incompatible_types_for of string
+    | Fixed_row of position * fixed_row_case * fixed_explanation
+    (** Fixed row types,  e.g. ['a. [> `X] as 'a] *)
+
+  type obj =
+    | Missing_field of position * string
+    | Abstract_row of position
+    | Self_cannot_be_closed
+
+  type 'a elt =
+    | Diff of 'a diff
+    | Variant of variant
+    | Obj of obj
+    | Escape of {context: type_expr option; kind:'a escape}
+    | Incompatible_fields of {name:string; diff: type_expr diff }
+    | Rec_occur of type_expr * type_expr
+
+  type t = desc elt list
+
+  val diff: type_expr -> type_expr -> desc elt
+
+  (** [map_diff f {expected;got}] is [{expected=f expected; got=f got}] *)
+  val map_diff: ('a -> 'b) -> 'a diff -> 'b diff
+
+  (** [flatten f trace] flattens all elements of type {!desc} in
+      [trace] to either [f x.t expanded] if [x.expanded=Some expanded]
+      or [f x.t x.t] otherwise *)
+  val flatten: (type_expr -> type_expr -> 'a) -> t -> 'a elt list
+
+  (** Switch [expected] and [got] *)
+  val swap: t -> t
+
+  (** [explain trace f] calls [f] on trace elements starting from the end
+      until [f ~prev elt] is [Some _], returns that
+      or [None] if the end of the trace is reached. *)
+  val explain:
+          'a elt list ->
+          (prev:'a elt option -> 'a elt -> 'b option) ->
+          'b option
+
+end
+
+exception Unify of Unification_trace.t
+exception Tags of label * label
+exception Subtype of Unification_trace.t * Unification_trace.t
+exception Cannot_expand
+exception Cannot_apply
+
+val init_def: int -> unit
+        (* Set the initial variable level *)
+val begin_def: unit -> unit
+        (* Raise the variable level by one at the beginning of a definition. *)
+val end_def: unit -> unit
+        (* Lower the variable level by one at the end of a definition *)
+val begin_class_def: unit -> unit
+val raise_nongen_level: unit -> unit
+val reset_global_level: unit -> unit
+        (* Reset the global level before typing an expression *)
+val increase_global_level: unit -> int
+val restore_global_level: int -> unit
+        (* This pair of functions is only used in Typetexp *)
+type levels =
+    { current_level: int; nongen_level: int; global_level: int;
+      saved_level: (int * int) list; }
+val save_levels: unit -> levels
+val set_levels: levels -> unit
+
+val create_scope : unit -> int
+
+val newty: type_desc -> type_expr
+val newvar: ?name:string -> unit -> type_expr
+val newvar2: ?name:string -> int -> type_expr
+        (* Return a fresh variable *)
+val new_global_var: ?name:string -> unit -> type_expr
+        (* Return a fresh variable, bound at toplevel
+           (as type variables ['a] in type constraints). *)
+val newobj: type_expr -> type_expr
+val newconstr: Path.t -> type_expr list -> type_expr
+val none: type_expr
+        (* A dummy type expression *)
+
+val repr: type_expr -> type_expr
+        (* Return the canonical representative of a type. *)
+
+val object_fields: type_expr -> type_expr
+val flatten_fields:
+        type_expr -> (string * field_kind * type_expr) list * type_expr
+        (* Transform a field type into a list of pairs label-type *)
+        (* The fields are sorted *)
+val associate_fields:
+        (string * field_kind * type_expr) list ->
+        (string * field_kind * type_expr) list ->
+        (string * field_kind * type_expr * field_kind * type_expr) list *
+        (string * field_kind * type_expr) list *
+        (string * field_kind * type_expr) list
+val opened_object: type_expr -> bool
+val close_object: type_expr -> bool
+val row_variable: type_expr -> type_expr
+        (* Return the row variable of an open object type *)
+val set_object_name:
+        Ident.t -> type_expr -> type_expr list -> type_expr -> unit
+val remove_object_name: type_expr -> unit
+val hide_private_methods: type_expr -> unit
+val find_cltype_for_path: Env.t -> Path.t -> type_declaration * type_expr
+
+val sort_row_fields: (label * row_field) list -> (label * row_field) list
+val merge_row_fields:
+        (label * row_field) list -> (label * row_field) list ->
+        (label * row_field) list * (label * row_field) list *
+        (label * row_field * row_field) list
+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 *)
+val generalize_structure: type_expr -> unit
+        (* Same, but variables are only lowered to !current_level *)
+val generalize_spine: type_expr -> unit
+        (* Special function to generalize a method during inference *)
+val correct_levels: type_expr -> type_expr
+        (* Returns a copy with decreasing levels *)
+val limited_generalize: type_expr -> type_expr -> unit
+        (* Only generalize some part of the type
+           Make the remaining of the type non-generalizable *)
+
+val check_scope_escape : Env.t -> int -> type_expr -> unit
+        (* [check_scope_escape env lvl ty] ensures that [ty] could be raised
+           to the level [lvl] without any scope escape.
+           Raises [Unify] otherwise *)
+
+val instance: ?partial:bool -> type_expr -> type_expr
+        (* Take an instance of a type scheme *)
+        (* partial=None  -> normal
+           partial=false -> newvar() for non generic subterms
+           partial=true  -> newty2 ty.level Tvar for non generic subterms *)
+val generic_instance: type_expr -> type_expr
+        (* Same as instance, but new nodes at generic_level *)
+val instance_list: type_expr list -> type_expr list
+        (* Take an instance of a list of type schemes *)
+val existential_name: constructor_description -> type_expr -> string
+val instance_constructor:
+        ?in_pattern:Env.t ref * int ->
+        constructor_description -> type_expr list * type_expr
+        (* Same, for a constructor *)
+val instance_parameterized_type:
+        ?keep_names:bool ->
+        type_expr list -> type_expr -> type_expr list * type_expr
+val instance_parameterized_type_2:
+        type_expr list -> type_expr list -> type_expr ->
+        type_expr list * type_expr list * type_expr
+val instance_declaration: type_declaration -> type_declaration
+val generic_instance_declaration: type_declaration -> type_declaration
+        (* Same as instance_declaration, but new nodes at generic_level *)
+val instance_class:
+        type_expr list -> class_type -> type_expr list * class_type
+val instance_poly:
+        ?keep_names:bool ->
+        bool -> type_expr list -> type_expr -> type_expr list * type_expr
+        (* Take an instance of a type scheme containing free univars *)
+val polyfy: Env.t -> type_expr -> type_expr list -> type_expr * bool
+val instance_label:
+        bool -> label_description -> type_expr list * type_expr * type_expr
+        (* Same, for a label *)
+val apply:
+        Env.t -> type_expr list -> type_expr -> type_expr list -> type_expr
+        (* [apply [p1...pN] t [a1...aN]] match the arguments [ai] to
+        the parameters [pi] and returns the corresponding instance of
+        [t]. Exception [Cannot_apply] is raised in case of failure. *)
+
+val expand_head_once: Env.t -> type_expr -> type_expr
+val expand_head: Env.t -> type_expr -> type_expr
+val try_expand_once_opt: Env.t -> type_expr -> type_expr
+val expand_head_opt: Env.t -> type_expr -> type_expr
+(** The compiler's own version of [expand_head] necessary for type-based
+    optimisations. *)
+
+val full_expand: Env.t -> type_expr -> type_expr
+val extract_concrete_typedecl:
+        Env.t -> type_expr -> Path.t * Path.t * type_declaration
+        (* Return the original path of the types, and the first concrete
+           type declaration found expanding it.
+           Raise [Not_found] if none appears or not a type constructor. *)
+
+val enforce_constraints: Env.t -> type_expr -> unit
+
+val unify: Env.t -> type_expr -> type_expr -> unit
+        (* Unify the two types given. Raise [Unify] if not possible. *)
+val unify_gadt:
+        equations_level:int -> Env.t ref -> type_expr -> type_expr -> unit
+        (* Unify the two types given and update the environment with the
+           local constraints. Raise [Unify] if not possible. *)
+val unify_var: Env.t -> type_expr -> type_expr -> unit
+        (* Same as [unify], but allow free univars when first type
+           is a variable. *)
+val filter_arrow: Env.t -> type_expr -> arg_label -> type_expr * type_expr
+        (* A special case of unification (with l:'a -> 'b). *)
+val filter_method: Env.t -> string -> private_flag -> type_expr -> type_expr
+        (* A special case of unification (with {m : 'a; 'b}). *)
+val check_filter_method: Env.t -> string -> private_flag -> type_expr -> unit
+        (* A special case of unification (with {m : 'a; 'b}), returning unit. *)
+val occur_in: Env.t -> type_expr -> type_expr -> bool
+val deep_occur: type_expr -> type_expr -> bool
+val filter_self_method:
+        Env.t -> string -> private_flag -> (Ident.t * type_expr) Meths.t ref ->
+        type_expr -> Ident.t * type_expr
+val moregeneral: Env.t -> bool -> type_expr -> type_expr -> bool
+        (* Check if the first type scheme is more general than the second. *)
+
+val rigidify: type_expr -> type_expr list
+        (* "Rigidify" a type and return its type variable *)
+val all_distinct_vars: Env.t -> type_expr list -> bool
+        (* Check those types are all distinct type variables *)
+val matches: Env.t -> type_expr -> type_expr -> bool
+        (* Same as [moregeneral false], implemented using the two above
+           functions and backtracking. Ignore levels *)
+
+val reify_univars : Env.t -> Types.type_expr -> Types.type_expr
+        (* Replaces all the variables of a type by a univar. *)
+
+type class_match_failure =
+    CM_Virtual_class
+  | CM_Parameter_arity_mismatch of int * int
+  | CM_Type_parameter_mismatch of Env.t * Unification_trace.t
+  | CM_Class_type_mismatch of Env.t * class_type * class_type
+  | CM_Parameter_mismatch of Env.t * Unification_trace.t
+  | CM_Val_type_mismatch of string * Env.t * Unification_trace.t
+  | CM_Meth_type_mismatch of string * Env.t * Unification_trace.t
+  | CM_Non_mutable_value of string
+  | CM_Non_concrete_value of string
+  | CM_Missing_value of string
+  | CM_Missing_method of string
+  | CM_Hide_public of string
+  | CM_Hide_virtual of string * string
+  | CM_Public_method of string
+  | CM_Private_method of string
+  | CM_Virtual_method of string
+val match_class_types:
+    ?trace:bool -> Env.t -> class_type -> class_type -> class_match_failure list
+        (* Check if the first class type is more general than the second. *)
+val equal: Env.t -> bool -> type_expr list -> type_expr list -> bool
+        (* [equal env [x1...xn] tau [y1...yn] sigma]
+           checks whether the parameterized types
+           [/\x1.../\xn.tau] and [/\y1.../\yn.sigma] are equivalent. *)
+val match_class_declarations:
+        Env.t -> type_expr list -> class_type -> type_expr list ->
+        class_type -> class_match_failure list
+        (* Check if the first class type is more general than the second. *)
+
+val enlarge_type: Env.t -> type_expr -> type_expr * bool
+        (* Make a type larger, flag is true if some pruning had to be done *)
+val subtype: Env.t -> type_expr -> type_expr -> unit -> unit
+        (* [subtype env t1 t2] checks that [t1] is a subtype of [t2].
+           It accumulates the constraints the type variables must
+           enforce and returns a function that enforces this
+           constraints. *)
+
+exception Nondep_cannot_erase of Ident.t
+
+val nondep_type: Env.t -> Ident.t list -> type_expr -> type_expr
+        (* Return a type equivalent to the given type but without
+           references to any of the given identifiers.
+           Raise [Nondep_cannot_erase id] if no such type exists because [id],
+           in particular, could not be erased. *)
+val nondep_type_decl:
+        Env.t -> Ident.t list -> bool -> type_declaration -> type_declaration
+        (* Same for type declarations. *)
+val nondep_extension_constructor:
+        Env.t -> Ident.t list -> extension_constructor ->
+        extension_constructor
+          (* Same for extension constructor *)
+val nondep_class_declaration:
+        Env.t -> Ident.t list -> class_declaration -> class_declaration
+        (* Same for class declarations. *)
+val nondep_cltype_declaration:
+  Env.t -> Ident.t list -> class_type_declaration -> class_type_declaration
+        (* Same for class type declarations. *)
+(*val correct_abbrev: Env.t -> Path.t -> type_expr list -> type_expr -> unit*)
+val cyclic_abbrev: Env.t -> Ident.t -> type_expr -> bool
+val is_contractive: Env.t -> Path.t -> bool
+val normalize_type: Env.t -> type_expr -> unit
+
+val closed_schema: Env.t -> type_expr -> bool
+        (* Check whether the given type scheme contains no non-generic
+           type variables *)
+
+val free_variables: ?env:Env.t -> type_expr -> type_expr list
+        (* If env present, then check for incomplete definitions too *)
+val closed_type_decl: type_declaration -> type_expr option
+val closed_extension_constructor: extension_constructor -> type_expr option
+type closed_class_failure =
+    CC_Method of type_expr * bool * string * type_expr
+  | CC_Value of type_expr * bool * string * type_expr
+val closed_class:
+        type_expr list -> class_signature -> closed_class_failure option
+        (* Check whether all type variables are bound *)
+
+val unalias: type_expr -> type_expr
+val signature_of_class_type: class_type -> class_signature
+val self_type: class_type -> type_expr
+val class_type_arity: class_type -> int
+val arity: type_expr -> int
+        (* Return the arity (as for curried functions) of the given type. *)
+
+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 reset_reified_var_counter: unit -> unit
+
+val immediacy : Env.t -> type_expr -> Type_immediacy.t
+
+val maybe_pointer_type : Env.t -> type_expr -> bool
+       (* True if type is possibly pointer, false if definitely not a pointer *)
+
+(* Stubs *)
+val package_subtype :
+    (Env.t -> Path.t -> Longident.t list -> type_expr list ->
+      Path.t -> Longident.t list -> type_expr list -> bool) ref
+
+val mcomp : Env.t -> type_expr -> type_expr -> unit
diff --git a/typing/datarepr.ml b/typing/datarepr.ml
new file mode 100644
index 00000000..818d60ad
--- /dev/null
+++ b/typing/datarepr.ml
@@ -0,0 +1,258 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Compute constructor and label descriptions from type declarations,
+   determining their representation. *)
+
+open Asttypes
+open Types
+open Btype
+
+(* Simplified version of Ctype.free_vars *)
+let free_vars ?(param=false) ty =
+  let ret = ref TypeSet.empty in
+  let rec loop ty =
+    let ty = repr ty in
+    if ty.level >= lowest_level then begin
+      ty.level <- pivot_level - ty.level;
+      match ty.desc with
+      | Tvar _ ->
+          ret := TypeSet.add ty !ret
+      | Tvariant row ->
+          let row = row_repr row in
+          iter_row loop row;
+          if not (static_row row) then begin
+            match row.row_more.desc with
+            | Tvar _ when param -> ret := TypeSet.add ty !ret
+            | _ -> loop row.row_more
+          end
+      (* XXX: What about Tobject ? *)
+      | _ ->
+          iter_type_expr loop ty
+    end
+  in
+  loop ty;
+  unmark_type ty;
+  !ret
+
+let newgenconstr path tyl = newgenty (Tconstr (path, tyl, ref Mnil))
+
+let constructor_existentials cd_args cd_res =
+  let tyl =
+    match cd_args with
+    | Cstr_tuple l -> l
+    | Cstr_record l -> List.map (fun l -> l.ld_type) l
+  in
+  let existentials =
+    match cd_res with
+    | None -> []
+    | Some type_ret ->
+        let arg_vars_set = free_vars (newgenty (Ttuple tyl)) in
+        let res_vars = free_vars type_ret in
+        TypeSet.elements (TypeSet.diff arg_vars_set res_vars)
+  in
+  (tyl, existentials)
+
+let constructor_args ~current_unit priv cd_args cd_res path rep =
+  let tyl, existentials = constructor_existentials cd_args cd_res in
+  match cd_args with
+  | Cstr_tuple l -> existentials, l, None
+  | Cstr_record lbls ->
+      let arg_vars_set = free_vars ~param:true (newgenty (Ttuple tyl)) in
+      let type_params = TypeSet.elements arg_vars_set in
+      let type_unboxed =
+        match rep with
+        | Record_unboxed _ -> unboxed_true_default_false
+        | _ -> unboxed_false_default_false
+      in
+      let arity = List.length type_params in
+      let tdecl =
+        {
+          type_params;
+          type_arity = arity;
+          type_kind = Type_record (lbls, rep);
+          type_private = priv;
+          type_manifest = None;
+          type_variance = List.map (fun _ -> Variance.full) type_params;
+          type_separability = Types.Separability.default_signature ~arity;
+          type_is_newtype = false;
+          type_expansion_scope = Btype.lowest_level;
+          type_loc = Location.none;
+          type_attributes = [];
+          type_immediate = Unknown;
+          type_unboxed;
+          type_uid = Uid.mk ~current_unit;
+        }
+      in
+      existentials,
+      [ newgenconstr path type_params ],
+      Some tdecl
+
+let constructor_descrs ~current_unit ty_path decl cstrs =
+  let ty_res = newgenconstr ty_path decl.type_params in
+  let num_consts = ref 0 and num_nonconsts = ref 0  and num_normal = ref 0 in
+  List.iter
+    (fun {cd_args; cd_res; _} ->
+      if cd_args = Cstr_tuple [] then incr num_consts else incr num_nonconsts;
+      if cd_res = None then incr num_normal)
+    cstrs;
+  let rec describe_constructors idx_const idx_nonconst = function
+      [] -> []
+    | {cd_id; cd_args; cd_res; cd_loc; cd_attributes; cd_uid} :: rem ->
+        let ty_res =
+          match cd_res with
+          | Some ty_res' -> ty_res'
+          | None -> ty_res
+        in
+        let (tag, descr_rem) =
+          match cd_args with
+          | _ when decl.type_unboxed.unboxed ->
+            assert (rem = []);
+            (Cstr_unboxed, [])
+          | Cstr_tuple [] -> (Cstr_constant idx_const,
+                   describe_constructors (idx_const+1) idx_nonconst rem)
+          | _  -> (Cstr_block idx_nonconst,
+                   describe_constructors idx_const (idx_nonconst+1) rem) in
+        let cstr_name = Ident.name cd_id in
+        let existentials, cstr_args, cstr_inlined =
+          let representation =
+            if decl.type_unboxed.unboxed
+            then Record_unboxed true
+            else Record_inlined idx_nonconst
+          in
+          constructor_args ~current_unit decl.type_private cd_args cd_res
+            (Path.Pdot (ty_path, cstr_name)) representation
+        in
+        let cstr =
+          { cstr_name;
+            cstr_res = ty_res;
+            cstr_existentials = existentials;
+            cstr_args;
+            cstr_arity = List.length cstr_args;
+            cstr_tag = tag;
+            cstr_consts = !num_consts;
+            cstr_nonconsts = !num_nonconsts;
+            cstr_normal = !num_normal;
+            cstr_private = decl.type_private;
+            cstr_generalized = cd_res <> None;
+            cstr_loc = cd_loc;
+            cstr_attributes = cd_attributes;
+            cstr_inlined;
+            cstr_uid = cd_uid;
+          } in
+        (cd_id, cstr) :: descr_rem in
+  describe_constructors 0 0 cstrs
+
+let extension_descr ~current_unit path_ext ext =
+  let ty_res =
+    match ext.ext_ret_type with
+        Some type_ret -> type_ret
+      | None -> newgenconstr ext.ext_type_path ext.ext_type_params
+  in
+  let existentials, cstr_args, cstr_inlined =
+    constructor_args ~current_unit ext.ext_private ext.ext_args ext.ext_ret_type
+      path_ext (Record_extension path_ext)
+  in
+    { cstr_name = Path.last path_ext;
+      cstr_res = ty_res;
+      cstr_existentials = existentials;
+      cstr_args;
+      cstr_arity = List.length cstr_args;
+      cstr_tag = Cstr_extension(path_ext, cstr_args = []);
+      cstr_consts = -1;
+      cstr_nonconsts = -1;
+      cstr_private = ext.ext_private;
+      cstr_normal = -1;
+      cstr_generalized = ext.ext_ret_type <> None;
+      cstr_loc = ext.ext_loc;
+      cstr_attributes = ext.ext_attributes;
+      cstr_inlined;
+      cstr_uid = ext.ext_uid;
+    }
+
+let none = {desc = Ttuple []; level = -1; scope = Btype.generic_level; id = -1}
+                                        (* Clearly ill-formed type *)
+let dummy_label =
+  { lbl_name = ""; lbl_res = none; lbl_arg = none; lbl_mut = Immutable;
+    lbl_pos = (-1); lbl_all = [||]; lbl_repres = Record_regular;
+    lbl_private = Public;
+    lbl_loc = Location.none;
+    lbl_attributes = [];
+    lbl_uid = Uid.internal_not_actually_unique;
+  }
+
+let label_descrs ty_res lbls repres priv =
+  let all_labels = Array.make (List.length lbls) dummy_label in
+  let rec describe_labels num = function
+      [] -> []
+    | l :: rest ->
+        let lbl =
+          { lbl_name = Ident.name l.ld_id;
+            lbl_res = ty_res;
+            lbl_arg = l.ld_type;
+            lbl_mut = l.ld_mutable;
+            lbl_pos = num;
+            lbl_all = all_labels;
+            lbl_repres = repres;
+            lbl_private = priv;
+            lbl_loc = l.ld_loc;
+            lbl_attributes = l.ld_attributes;
+            lbl_uid = l.ld_uid;
+          } in
+        all_labels.(num) <- lbl;
+        (l.ld_id, lbl) :: describe_labels (num+1) rest in
+  describe_labels 0 lbls
+
+exception Constr_not_found
+
+let rec find_constr tag num_const num_nonconst = function
+    [] ->
+      raise Constr_not_found
+  | {cd_args = Cstr_tuple []; _} as c  :: rem ->
+      if tag = Cstr_constant num_const
+      then c
+      else find_constr tag (num_const + 1) num_nonconst rem
+  | c :: rem ->
+      if tag = Cstr_block num_nonconst || tag = Cstr_unboxed
+      then c
+      else find_constr tag num_const (num_nonconst + 1) rem
+
+let find_constr_by_tag tag cstrlist =
+  find_constr tag 0 0 cstrlist
+
+let constructors_of_type ~current_unit ty_path decl =
+  match decl.type_kind with
+  | Type_variant cstrs -> constructor_descrs ~current_unit ty_path decl cstrs
+  | Type_record _ | Type_abstract | Type_open -> []
+
+let labels_of_type ty_path decl =
+  match decl.type_kind with
+  | Type_record(labels, rep) ->
+      label_descrs (newgenconstr ty_path decl.type_params)
+        labels rep decl.type_private
+  | Type_variant _ | Type_abstract | Type_open -> []
+
+(* Set row_name in Env, cf. GPR#1204/1329 *)
+let set_row_name decl path =
+  match decl.type_manifest with
+    None -> ()
+  | Some ty ->
+      let ty = repr ty in
+      match ty.desc with
+        Tvariant row when static_row row ->
+          let row = {(row_repr row) with
+                     row_name = Some (path, decl.type_params)} in
+          ty.desc <- Tvariant row
+      | _ -> ()
diff --git a/typing/datarepr.mli b/typing/datarepr.mli
new file mode 100644
index 00000000..e3962e3a
--- /dev/null
+++ b/typing/datarepr.mli
@@ -0,0 +1,49 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Compute constructor and label descriptions from type declarations,
+   determining their representation. *)
+
+open Types
+
+val extension_descr:
+  current_unit:string -> 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 ->
+  (Ident.t * constructor_description) list
+
+
+exception Constr_not_found
+
+val find_constr_by_tag:
+  constructor_tag -> constructor_declaration list ->
+    constructor_declaration
+
+val constructor_existentials :
+    constructor_arguments -> type_expr option -> type_expr list * type_expr list
+(** Takes [cd_args] and [cd_res] from a [constructor_declaration] and
+    returns:
+    - the types of the constructor's arguments
+    - the existential variables introduced by the constructor
+ *)
+
+
+(* Set the polymorphic variant row_name field *)
+val set_row_name : type_declaration -> Path.t -> unit
diff --git a/typing/env.ml b/typing/env.ml
new file mode 100644
index 00000000..9abbd089
--- /dev/null
+++ b/typing/env.ml
@@ -0,0 +1,3174 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Environment handling *)
+
+open Cmi_format
+open Misc
+open Asttypes
+open Longident
+open Path
+open Types
+open Btype
+
+module String = Misc.Stdlib.String
+
+let add_delayed_check_forward = ref (fun _ -> assert false)
+
+type 'a usage_tbl = ('a -> unit) Types.Uid.Tbl.t
+(** This table is used to track usage of value declarations.
+    A declaration is identified by its uid.
+    The callback attached to a declaration is called whenever the value (or
+    type, or ...) is used explicitly (lookup_value, ...) or implicitly
+    (inclusion test between signatures, cf Includemod.value_descriptions, ...).
+*)
+
+let value_declarations  : unit usage_tbl = Types.Uid.Tbl.create 16
+let type_declarations   : unit usage_tbl = Types.Uid.Tbl.create 16
+let module_declarations : unit usage_tbl = Types.Uid.Tbl.create 16
+
+type constructor_usage = Positive | Pattern | Privatize
+type constructor_usages =
+    {
+     mutable cu_positive: bool;
+     mutable cu_pattern: bool;
+     mutable cu_privatize: bool;
+    }
+let add_constructor_usage ~rebind priv cu usage =
+  let private_or_rebind =
+    match priv with
+    | Asttypes.Private -> true
+    | Asttypes.Public -> rebind
+  in
+  if private_or_rebind then begin
+    cu.cu_positive <- true
+  end else begin
+    match usage with
+    | Positive -> cu.cu_positive <- true
+    | Pattern -> cu.cu_pattern <- true
+    | Privatize -> cu.cu_privatize <- true
+  end
+
+let constructor_usages () =
+  {cu_positive = false; cu_pattern = false; cu_privatize = false}
+
+let used_constructors : constructor_usage usage_tbl = Types.Uid.Tbl.create 16
+
+(** Map indexed by the name of module components. *)
+module NameMap = String.Map
+
+type value_unbound_reason =
+  | Val_unbound_instance_variable
+  | Val_unbound_self
+  | Val_unbound_ancestor
+  | Val_unbound_ghost_recursive of Location.t
+
+type module_unbound_reason =
+  | Mod_unbound_illegal_recursion
+
+type summary =
+    Env_empty
+  | Env_value of summary * Ident.t * value_description
+  | Env_type of summary * Ident.t * type_declaration
+  | Env_extension of summary * Ident.t * extension_constructor
+  | Env_module of summary * Ident.t * module_presence * module_declaration
+  | Env_modtype of summary * Ident.t * modtype_declaration
+  | Env_class of summary * Ident.t * class_declaration
+  | Env_cltype of summary * Ident.t * class_type_declaration
+  | Env_open of summary * Path.t
+  | Env_functor_arg of summary * Ident.t
+  | Env_constraints of summary * type_declaration Path.Map.t
+  | Env_copy_types of summary
+  | Env_persistent of summary * Ident.t
+  | Env_value_unbound of summary * string * value_unbound_reason
+  | Env_module_unbound of summary * string * module_unbound_reason
+
+type address =
+  | Aident of Ident.t
+  | Adot of address * int
+
+module TycompTbl =
+  struct
+    (** This module is used to store components of types (i.e. labels
+        and constructors).  We keep a representation of each nested
+        "open" and the set of local bindings between each of them. *)
+
+    type 'a t = {
+      current: 'a Ident.tbl;
+      (** Local bindings since the last open. *)
+
+      opened: 'a opened option;
+      (** Symbolic representation of the last (innermost) open, if any. *)
+    }
+
+    and 'a opened = {
+      components: ('a list) NameMap.t;
+      (** Components from the opened module. We keep a list of
+          bindings for each name, as in comp_labels and
+          comp_constrs. *)
+
+      using: (string -> ('a * 'a) option -> unit) option;
+      (** A callback to be applied when a component is used from this
+          "open".  This is used to detect unused "opens".  The
+          arguments are used to detect shadowing. *)
+
+      next: 'a t;
+      (** The table before opening the module. *)
+    }
+
+    let empty = { current = Ident.empty; opened = None }
+
+    let add id x tbl =
+      {tbl with current = Ident.add id x tbl.current}
+
+    let add_open slot wrap components next =
+      let using =
+        match slot with
+        | None -> None
+        | Some f -> Some (fun s x -> f s (wrap x))
+      in
+      {
+        current = Ident.empty;
+        opened = Some {using; components; next};
+      }
+
+    let rec find_same id tbl =
+      try Ident.find_same id tbl.current
+      with Not_found as exn ->
+        begin match tbl.opened with
+        | Some {next; _} -> find_same id next
+        | None -> raise exn
+        end
+
+    let nothing = fun () -> ()
+
+    let mk_callback rest name desc using =
+      match using with
+      | None -> nothing
+      | Some f ->
+          (fun () ->
+             match rest with
+             | [] -> f name None
+             | (hidden, _) :: _ -> f name (Some (desc, hidden)))
+
+    let rec find_all ~mark name tbl =
+      List.map (fun (_id, desc) -> desc, nothing)
+        (Ident.find_all name tbl.current) @
+      match tbl.opened with
+      | None -> []
+      | Some {using; next; components} ->
+          let rest = find_all ~mark name next in
+          let using = if mark then using else None in
+          match NameMap.find name components with
+          | exception Not_found -> rest
+          | opened ->
+              List.map
+                (fun desc -> desc, mk_callback rest name desc using)
+                opened
+              @ rest
+
+    let rec fold_name f tbl acc =
+      let acc = Ident.fold_name (fun _id d -> f d) tbl.current acc in
+      match tbl.opened with
+      | Some {using = _; next; components} ->
+          acc
+          |> NameMap.fold
+            (fun _name -> List.fold_right f)
+            components
+          |> fold_name f next
+      | None ->
+          acc
+
+    let rec local_keys tbl acc =
+      let acc = Ident.fold_all (fun k _ accu -> k::accu) tbl.current acc in
+      match tbl.opened with
+      | Some o -> local_keys o.next acc
+      | None -> acc
+
+    let diff_keys is_local tbl1 tbl2 =
+      let keys2 = local_keys tbl2 [] in
+      List.filter
+        (fun id ->
+           is_local (find_same id tbl2) &&
+           try ignore (find_same id tbl1); false
+           with Not_found -> true)
+        keys2
+
+  end
+
+
+module IdTbl =
+  struct
+    (** This module is used to store all kinds of components except
+        (labels and constructors) in environments.  We keep a
+        representation of each nested "open" and the set of local
+        bindings between each of them. *)
+
+
+    type ('a, 'b) t = {
+      current: 'a Ident.tbl;
+      (** Local bindings since the last open *)
+
+      layer: ('a, 'b) layer;
+      (** Symbolic representation of the last (innermost) open, if any. *)
+    }
+
+    and ('a, 'b) layer =
+      | Open of {
+          root: Path.t;
+          (** The path of the opened module, to be prefixed in front of
+              its local names to produce a valid path in the current
+              environment. *)
+
+          components: 'b NameMap.t;
+          (** Components from the opened module. *)
+
+          using: (string -> ('a * 'a) option -> unit) option;
+          (** A callback to be applied when a component is used from this
+              "open".  This is used to detect unused "opens".  The
+              arguments are used to detect shadowing. *)
+
+          next: ('a, 'b) t;
+          (** The table before opening the module. *)
+        }
+
+      | Map of {
+          f: ('a -> 'a);
+          next: ('a, 'b) t;
+        }
+
+      | Nothing
+
+    let empty = { current = Ident.empty; layer = Nothing }
+
+    let add id x tbl =
+      {tbl with current = Ident.add id x tbl.current}
+
+    let remove id tbl =
+      {tbl with current = Ident.remove id tbl.current}
+
+    let add_open slot wrap root components next =
+      let using =
+        match slot with
+        | None -> None
+        | Some f -> Some (fun s x -> f s (wrap x))
+      in
+      {
+        current = Ident.empty;
+        layer = Open {using; root; components; next};
+      }
+
+    let map f next =
+      {
+        current = Ident.empty;
+        layer = Map {f; next}
+      }
+
+    let rec find_same id tbl =
+      try Ident.find_same id tbl.current
+      with Not_found as exn ->
+        begin match tbl.layer with
+        | Open {next; _} -> find_same id next
+        | Map {f; next} -> f (find_same id next)
+        | Nothing -> raise exn
+        end
+
+    let rec find_name wrap ~mark name tbl =
+      try
+        let (id, desc) = Ident.find_name name tbl.current in
+        Pident id, desc
+      with Not_found as exn ->
+        begin match tbl.layer with
+        | Open {using; root; next; components} ->
+            begin try
+              let descr = wrap (NameMap.find name components) in
+              let res = Pdot (root, name), descr in
+              if mark then begin match using with
+              | None -> ()
+              | Some f -> begin
+                  match find_name wrap ~mark:false name next with
+                  | exception Not_found -> f name None
+                  | _, descr' -> f name (Some (descr', descr))
+                end
+              end;
+              res
+            with Not_found ->
+              find_name wrap ~mark name next
+            end
+        | Map {f; next} ->
+            let (p, desc) =  find_name wrap ~mark name next in
+            p, f desc
+        | Nothing ->
+            raise exn
+        end
+
+    let rec find_all wrap name tbl =
+      List.map
+        (fun (id, desc) -> Pident id, desc)
+        (Ident.find_all name tbl.current) @
+      match tbl.layer with
+      | Nothing -> []
+      | Open {root; using = _; next; components} ->
+          begin try
+            let desc = wrap (NameMap.find name components) in
+            (Pdot (root, name), desc) :: find_all wrap name next
+          with Not_found ->
+            find_all wrap name next
+          end
+      | Map {f; next} ->
+          List.map (fun (p, desc) -> (p, f desc))
+            (find_all wrap name next)
+
+    let rec fold_name wrap f tbl acc =
+      let acc =
+        Ident.fold_name
+          (fun id d -> f (Ident.name id) (Pident id, d))
+          tbl.current acc
+      in
+      match tbl.layer with
+      | Open {root; using = _; next; components} ->
+          acc
+          |> NameMap.fold
+            (fun name desc -> f name (Pdot (root, name), wrap desc))
+            components
+          |> fold_name wrap f next
+      | Nothing ->
+          acc
+      | Map {f=g; next} ->
+          acc
+          |> fold_name wrap
+               (fun name (path, desc) -> f name (path, g desc))
+               next
+
+    let rec local_keys tbl acc =
+      let acc = Ident.fold_all (fun k _ accu -> k::accu) tbl.current acc in
+      match tbl.layer with
+      | Open {next; _ } | Map {next; _} -> local_keys next acc
+      | Nothing -> acc
+
+
+    let rec iter wrap f tbl =
+      Ident.iter (fun id desc -> f id (Pident id, desc)) tbl.current;
+      match tbl.layer with
+      | Open {root; using = _; next; components} ->
+          NameMap.iter
+            (fun s x ->
+               let root_scope = Path.scope root in
+              f (Ident.create_scoped ~scope:root_scope s)
+                (Pdot (root, s), wrap x))
+            components;
+          iter wrap f next
+      | Map {f=g; next} ->
+          iter wrap (fun id (path, desc) -> f id (path, g desc)) next
+      | Nothing -> ()
+
+    let diff_keys tbl1 tbl2 =
+      let keys2 = local_keys tbl2 [] in
+      List.filter
+        (fun id ->
+           try ignore (find_same id tbl1); false
+           with Not_found -> true)
+        keys2
+
+
+  end
+
+type type_descriptions =
+    constructor_description list * label_description list
+
+let in_signature_flag = 0x01
+
+type t = {
+  values: (value_entry, value_data) IdTbl.t;
+  constrs: constructor_data TycompTbl.t;
+  labels: label_data TycompTbl.t;
+  types: (type_data, type_data) IdTbl.t;
+  modules: (module_entry, module_data) IdTbl.t;
+  modtypes: (modtype_data, modtype_data) IdTbl.t;
+  classes: (class_data, class_data) IdTbl.t;
+  cltypes: (cltype_data, cltype_data) IdTbl.t;
+  functor_args: unit Ident.tbl;
+  summary: summary;
+  local_constraints: type_declaration Path.Map.t;
+  flags: int;
+}
+
+and module_declaration_lazy =
+  (Subst.t * Subst.scoping * module_declaration, module_declaration) EnvLazy.t
+
+and module_components =
+  {
+    alerts: alerts;
+    uid: Uid.t;
+    comps:
+      (components_maker,
+       (module_components_repr, module_components_failure) result)
+        EnvLazy.t;
+  }
+
+and components_maker = {
+  cm_env: t;
+  cm_freshening_subst: Subst.t option;
+  cm_prefixing_subst: Subst.t;
+  cm_path: Path.t;
+  cm_addr: address_lazy;
+  cm_mty: Types.module_type;
+}
+
+and module_components_repr =
+    Structure_comps of structure_components
+  | Functor_comps of functor_components
+
+and module_components_failure =
+  | No_components_abstract
+  | No_components_alias of Path.t
+
+and structure_components = {
+  mutable comp_values: value_data NameMap.t;
+  mutable comp_constrs: constructor_data list NameMap.t;
+  mutable comp_labels: label_data list NameMap.t;
+  mutable comp_types: type_data NameMap.t;
+  mutable comp_modules: module_data NameMap.t;
+  mutable comp_modtypes: modtype_data NameMap.t;
+  mutable comp_classes: class_data NameMap.t;
+  mutable comp_cltypes: cltype_data NameMap.t;
+}
+
+and functor_components = {
+  fcomp_arg: functor_parameter;
+  (* Formal parameter and argument signature *)
+  fcomp_res: module_type;               (* Result signature *)
+  fcomp_cache: (Path.t, module_components) Hashtbl.t;  (* For memoization *)
+  fcomp_subst_cache: (Path.t, module_type) Hashtbl.t
+}
+
+and address_unforced =
+  | Projection of { parent : address_lazy; pos : int; }
+  | ModAlias of { env : t; path : Path.t; }
+
+and address_lazy = (address_unforced, address) EnvLazy.t
+
+and value_data =
+  { vda_description : value_description;
+    vda_address : address_lazy }
+
+and value_entry =
+  | Val_bound of value_data
+  | Val_unbound of value_unbound_reason
+
+and constructor_data =
+  { cda_description : constructor_description;
+    cda_address : address_lazy option; }
+
+and label_data = label_description
+
+and type_data =
+  { tda_declaration : type_declaration;
+    tda_descriptions : type_descriptions; }
+
+and module_data =
+  { mda_declaration : module_declaration_lazy;
+    mda_components : module_components;
+    mda_address : address_lazy; }
+
+and module_entry =
+  | Mod_local of module_data
+  | Mod_persistent
+  | Mod_unbound of module_unbound_reason
+
+and modtype_data = modtype_declaration
+
+and class_data =
+  { clda_declaration : class_declaration;
+    clda_address : address_lazy }
+
+and cltype_data = class_type_declaration
+
+let empty_structure =
+  Structure_comps {
+    comp_values = NameMap.empty;
+    comp_constrs = NameMap.empty;
+    comp_labels = NameMap.empty;
+    comp_types = NameMap.empty;
+    comp_modules = NameMap.empty; comp_modtypes = NameMap.empty;
+    comp_classes = NameMap.empty;
+    comp_cltypes = NameMap.empty }
+
+type unbound_value_hint =
+  | No_hint
+  | Missing_rec of Location.t
+
+type lookup_error =
+  | Unbound_value of Longident.t * unbound_value_hint
+  | Unbound_type of Longident.t
+  | Unbound_constructor of Longident.t
+  | Unbound_label of Longident.t
+  | Unbound_module of Longident.t
+  | Unbound_class of Longident.t
+  | Unbound_modtype of Longident.t
+  | Unbound_cltype of Longident.t
+  | Unbound_instance_variable of string
+  | Not_an_instance_variable of string
+  | Masked_instance_variable of Longident.t
+  | Masked_self_variable of Longident.t
+  | Masked_ancestor_variable of Longident.t
+  | Structure_used_as_functor of Longident.t
+  | Abstract_used_as_functor of Longident.t
+  | Functor_used_as_structure of Longident.t
+  | Abstract_used_as_structure of Longident.t
+  | Generative_used_as_applicative of Longident.t
+  | Illegal_reference_to_recursive_module
+  | Cannot_scrape_alias of Longident.t * Path.t
+
+type error =
+  | Missing_module of Location.t * Path.t * Path.t
+  | Illegal_value_name of Location.t * string
+  | Lookup_error of Location.t * t * lookup_error
+
+exception Error of error
+
+let error err = raise (Error err)
+
+let lookup_error loc env err =
+  error (Lookup_error(loc, env, err))
+
+let copy_local ~from env =
+  { env with
+    local_constraints = from.local_constraints;
+    flags = from.flags }
+
+let same_constr = ref (fun _ _ _ -> assert false)
+
+let check_well_formed_module = ref (fun _ -> assert false)
+
+(* Helper to decide whether to report an identifier shadowing
+   by some 'open'. For labels and constructors, we do not report
+   if the two elements are from the same re-exported declaration.
+
+   Later, one could also interpret some attributes on value and
+   type declarations to silence the shadowing warnings. *)
+
+let check_shadowing env = function
+  | `Constructor (Some (cda1, cda2))
+    when not (!same_constr env
+                cda1.cda_description.cstr_res
+                cda2.cda_description.cstr_res) ->
+      Some "constructor"
+  | `Label (Some (l1, l2))
+    when not (!same_constr env l1.lbl_res l2.lbl_res) ->
+      Some "label"
+  | `Value (Some _) -> Some "value"
+  | `Type (Some _) -> Some "type"
+  | `Module (Some _) | `Component (Some _) -> Some "module"
+  | `Module_type (Some _) -> Some "module type"
+  | `Class (Some _) -> Some "class"
+  | `Class_type (Some _) -> Some "class type"
+  | `Constructor _ | `Label _
+  | `Value None | `Type None | `Module None | `Module_type None
+  | `Class None | `Class_type None | `Component None ->
+      None
+
+let subst_modtype_maker (subst, scoping, md) =
+  {md with md_type = Subst.modtype scoping subst md.md_type}
+
+let empty = {
+  values = IdTbl.empty; constrs = TycompTbl.empty;
+  labels = TycompTbl.empty; types = IdTbl.empty;
+  modules = IdTbl.empty; modtypes = IdTbl.empty;
+  classes = IdTbl.empty; cltypes = IdTbl.empty;
+  summary = Env_empty; local_constraints = Path.Map.empty;
+  flags = 0;
+  functor_args = Ident.empty;
+ }
+
+let in_signature b env =
+  let flags =
+    if b then env.flags lor in_signature_flag
+    else env.flags land (lnot in_signature_flag)
+  in
+  {env with flags}
+
+let is_in_signature env = env.flags land in_signature_flag <> 0
+
+let has_local_constraints env =
+  not (Path.Map.is_empty env.local_constraints)
+
+let is_ident = function
+    Pident _ -> true
+  | Pdot _ | Papply _ -> false
+
+let is_ext cda =
+  match cda.cda_description with
+  | {cstr_tag = Cstr_extension _} -> true
+  | _ -> false
+
+let is_local_ext cda =
+  match cda.cda_description with
+  | {cstr_tag = Cstr_extension(p, _)} -> is_ident p
+  | _ -> false
+
+let diff env1 env2 =
+  IdTbl.diff_keys env1.values env2.values @
+  TycompTbl.diff_keys is_local_ext env1.constrs env2.constrs @
+  IdTbl.diff_keys env1.modules env2.modules @
+  IdTbl.diff_keys env1.classes env2.classes
+
+(* Functions for use in "wrap" parameters in IdTbl *)
+let wrap_identity x = x
+let wrap_value vda = Val_bound vda
+let wrap_module mda = Mod_local mda
+
+(* Forward declarations *)
+
+let components_of_module_maker' =
+  ref ((fun _ -> assert false) :
+          components_maker ->
+            (module_components_repr, module_components_failure) result)
+
+let components_of_functor_appl' =
+  ref ((fun ~loc:_ _f _env _p1 _p2 -> assert false) :
+          loc:Location.t -> functor_components -> t ->
+            Path.t -> Path.t -> module_components)
+let check_functor_application =
+  (* to be filled by Includemod *)
+  ref ((fun ~errors:_ ~loc:_ _env _mty1 _path1 _mty2 _path2 -> assert false) :
+          errors:bool -> loc:Location.t -> t -> module_type ->
+            Path.t -> module_type -> Path.t -> unit)
+let strengthen =
+  (* to be filled with Mtype.strengthen *)
+  ref ((fun ~aliasable:_ _env _mty _path -> assert false) :
+         aliasable:bool -> t -> module_type -> Path.t -> module_type)
+
+let md md_type =
+  {md_type; md_attributes=[]; md_loc=Location.none
+  ;md_uid = Uid.internal_not_actually_unique}
+
+(* Print addresses *)
+
+let rec print_address ppf = function
+  | Aident id -> Format.fprintf ppf "%s" (Ident.name id)
+  | Adot(a, pos) -> Format.fprintf ppf "%a.[%i]" print_address a pos
+
+(* 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_name_of : Ident.t -> bool
+end = struct
+  let current_unit =
+    ref ""
+  let get () =
+    !current_unit
+  let set name =
+    current_unit := name
+  let is name =
+    !current_unit = name
+  let is_name_of id =
+    is (Ident.name id)
+end
+
+let set_unit_name = Current_unit_name.set
+let get_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_name_of 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) ->
+      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 not (Current_unit_name.is_name_of id) then
+    let summary =
+      match
+        IdTbl.find_name wrap_module ~mark:false (Ident.name id) env.modules
+      with
+      | exception Not_found | _, Mod_persistent -> env.summary
+      | _ -> Env_persistent (env.summary, id)
+    in
+    { env with
+      modules = IdTbl.add id Mod_persistent env.modules;
+      summary
+    }
+  else
+    env
+
+let components_of_module ~alerts ~uid env fs ps path addr mty =
+  {
+    alerts;
+    uid;
+    comps = EnvLazy.create {
+      cm_env = env;
+      cm_freshening_subst = fs;
+      cm_prefixing_subst = ps;
+      cm_path = path;
+      cm_addr = addr;
+      cm_mty = mty
+    }
+  }
+
+let sign_of_cmi ~freshen { Persistent_env.Persistent_signature.cmi; _ } =
+  let name = cmi.cmi_name in
+  let sign = cmi.cmi_sign in
+  let flags = cmi.cmi_flags in
+  let id = Ident.create_persistent name in
+  let path = Pident id in
+  let alerts =
+    List.fold_left (fun acc -> function Alerts s -> s | _ -> acc)
+      Misc.Stdlib.String.Map.empty
+      flags
+  in
+  let md =
+    { md_type =  Mty_signature sign;
+      md_loc = Location.none;
+      md_attributes = [];
+      md_uid = Uid.of_compilation_unit_id id;
+    }
+  in
+  let mda_address = EnvLazy.create_forced (Aident id) in
+  let mda_declaration =
+    EnvLazy.create (Subst.identity, Subst.Make_local, md)
+  in
+  let mda_components =
+    let freshening_subst =
+      if freshen then (Some Subst.identity) else None
+    in
+    components_of_module ~alerts ~uid:md.md_uid
+      empty freshening_subst Subst.identity
+      path mda_address (Mty_signature sign)
+  in
+  {
+    mda_declaration;
+    mda_components;
+    mda_address;
+  }
+
+let read_sign_of_cmi = sign_of_cmi ~freshen:true
+
+let save_sign_of_cmi = sign_of_cmi ~freshen:false
+
+let persistent_env : module_data Persistent_env.t =
+  Persistent_env.empty ()
+
+let without_cmis f x =
+  Persistent_env.without_cmis persistent_env f x
+
+let imports () = Persistent_env.imports persistent_env
+
+let import_crcs ~source crcs =
+  Persistent_env.import_crcs persistent_env ~source crcs
+
+let read_pers_mod modname filename =
+  Persistent_env.read persistent_env read_sign_of_cmi modname filename
+
+let find_pers_mod name =
+  Persistent_env.find persistent_env read_sign_of_cmi name
+
+let check_pers_mod ~loc name =
+  Persistent_env.check persistent_env read_sign_of_cmi ~loc name
+
+let crc_of_unit name =
+  Persistent_env.crc_of_unit persistent_env read_sign_of_cmi name
+
+let is_imported_opaque modname =
+  Persistent_env.is_imported_opaque persistent_env modname
+
+let register_import_as_opaque modname =
+  Persistent_env.register_import_as_opaque persistent_env modname
+
+let reset_declaration_caches () =
+  Types.Uid.Tbl.clear value_declarations;
+  Types.Uid.Tbl.clear type_declarations;
+  Types.Uid.Tbl.clear module_declarations;
+  Types.Uid.Tbl.clear used_constructors;
+  ()
+
+let reset_cache () =
+  Current_unit_name.set "";
+  Persistent_env.clear persistent_env;
+  reset_declaration_caches ();
+  ()
+
+let reset_cache_toplevel () =
+  Persistent_env.clear_missing persistent_env;
+  reset_declaration_caches ();
+  ()
+
+(* get_components *)
+
+let get_components_res c =
+  match Persistent_env.can_load_cmis persistent_env with
+  | Persistent_env.Can_load_cmis ->
+    EnvLazy.force !components_of_module_maker' c.comps
+  | Persistent_env.Cannot_load_cmis log ->
+    EnvLazy.force_logged log !components_of_module_maker' c.comps
+
+let get_components c =
+  match get_components_res c with
+  | Error _ -> empty_structure
+  | Ok c -> c
+
+(* Module type of functor application *)
+
+let modtype_of_functor_appl fcomp p1 p2 =
+  match fcomp.fcomp_res with
+  | Mty_alias _ as mty -> mty
+  | mty ->
+      try
+        Hashtbl.find fcomp.fcomp_subst_cache p2
+      with Not_found ->
+        let scope = Path.scope (Papply(p1, p2)) in
+        let mty =
+          let subst =
+            match fcomp.fcomp_arg with
+            | Unit
+            | Named (None, _) -> Subst.identity
+            | Named (Some param, _) -> Subst.add_module param p2 Subst.identity
+          in
+          Subst.modtype (Rescope scope) subst mty
+        in
+        Hashtbl.add fcomp.fcomp_subst_cache p2 mty;
+        mty
+
+let check_functor_appl ~errors ~loc env p1 f arg p2 md =
+  if not (Hashtbl.mem f.fcomp_cache p2) then
+    !check_functor_application ~errors ~loc env md.md_type p2 arg p1
+
+(* Lookup by identifier *)
+
+let find_ident_module id env =
+  match find_same_module id env.modules with
+  | Mod_local data -> data
+  | Mod_unbound _ -> raise Not_found
+  | Mod_persistent -> find_pers_mod (Ident.name id)
+
+let rec find_module_components path env =
+  match path with
+  | Pident id -> (find_ident_module id env).mda_components
+  | Pdot(p, s) ->
+      let sc = find_structure_components p env in
+      (NameMap.find s sc.comp_modules).mda_components
+  | Papply(p1, p2) ->
+      let fc = find_functor_components p1 env in
+      let loc = Location.(in_file !input_name) in
+      !components_of_functor_appl' ~loc fc env p1 p2
+
+and find_structure_components path env =
+  match get_components (find_module_components path env) with
+  | Structure_comps c -> c
+  | Functor_comps _ -> raise Not_found
+
+and find_functor_components path env =
+  match get_components (find_module_components path env) with
+  | Functor_comps f -> f
+  | Structure_comps _ -> raise Not_found
+
+let find_module ~alias path env =
+  match path with
+  | Pident id ->
+      let data = find_ident_module id env in
+      EnvLazy.force subst_modtype_maker data.mda_declaration
+  | Pdot(p, s) ->
+      let sc = find_structure_components p env in
+      let data = NameMap.find s sc.comp_modules in
+      EnvLazy.force subst_modtype_maker data.mda_declaration
+  | Papply(p1, p2) ->
+      let fc = find_functor_components p1 env in
+      if alias then md (fc.fcomp_res)
+      else md (modtype_of_functor_appl fc p1 p2)
+
+let find_value_full path env =
+  match path with
+  | Pident id -> begin
+      match IdTbl.find_same id env.values with
+      | Val_bound data -> data
+      | Val_unbound _ -> raise Not_found
+    end
+  | Pdot(p, s) ->
+      let sc = find_structure_components p env in
+      NameMap.find s sc.comp_values
+  | Papply _ -> raise Not_found
+
+let find_type_full path env =
+  match path with
+  | Pident id -> IdTbl.find_same id env.types
+  | Pdot(p, s) ->
+      let sc = find_structure_components p env in
+      NameMap.find s sc.comp_types
+  | Papply _ -> raise Not_found
+
+let find_modtype path env =
+  match path with
+  | Pident id -> IdTbl.find_same id env.modtypes
+  | Pdot(p, s) ->
+      let sc = find_structure_components p env in
+      NameMap.find s sc.comp_modtypes
+  | Papply _ -> raise Not_found
+
+let find_class_full path env =
+  match path with
+  | Pident id -> IdTbl.find_same id env.classes
+  | Pdot(p, s) ->
+      let sc = find_structure_components p env in
+      NameMap.find s sc.comp_classes
+  | Papply _ -> raise Not_found
+
+let find_cltype path env =
+  match path with
+  | Pident id -> IdTbl.find_same id env.cltypes
+  | Pdot(p, s) ->
+      let sc = find_structure_components p env in
+      NameMap.find s sc.comp_cltypes
+  | Papply _ -> raise Not_found
+
+let find_value path env =
+  (find_value_full path env).vda_description
+
+let find_class path env =
+  (find_class_full path env).clda_declaration
+
+let find_ident_constructor id env =
+  (TycompTbl.find_same id env.constrs).cda_description
+
+let find_ident_label id env =
+  TycompTbl.find_same id env.labels
+
+let type_of_cstr path = function
+  | {cstr_inlined = Some decl; _} ->
+      let labels =
+        List.map snd (Datarepr.labels_of_type path decl)
+      in
+      { tda_declaration = decl; tda_descriptions = ([], labels) }
+  | _ ->
+      assert false
+
+let find_type_full path env =
+  match Path.constructor_typath path with
+  | Regular p -> begin
+      match Path.Map.find p env.local_constraints with
+      | decl ->
+          { tda_declaration = decl; tda_descriptions = [], [] }
+      | exception Not_found -> find_type_full p env
+    end
+  | Cstr (ty_path, s) ->
+      let tda =
+        try find_type_full ty_path env
+        with Not_found -> assert false
+      in
+      let (cstrs, _) = tda.tda_descriptions in
+      let cstr =
+        try List.find (fun cstr -> cstr.cstr_name = s) cstrs
+        with Not_found -> assert false
+      in
+      type_of_cstr path cstr
+  | LocalExt id ->
+      let cstr =
+        try (TycompTbl.find_same id env.constrs).cda_description
+        with Not_found -> assert false
+      in
+      type_of_cstr path cstr
+  | Ext (mod_path, s) ->
+      let comps =
+        try find_structure_components mod_path env
+        with Not_found -> assert false
+      in
+      let cstrs =
+        try NameMap.find s comps.comp_constrs
+        with Not_found -> assert false
+      in
+      let exts = List.filter is_ext cstrs in
+      match exts with
+      | [cda] -> type_of_cstr path cda.cda_description
+      | _ -> assert false
+
+let find_type p env =
+  (find_type_full p env).tda_declaration
+let find_type_descrs p env =
+  (find_type_full p env).tda_descriptions
+
+let rec find_module_address path env =
+  match path with
+  | Pident id -> get_address (find_ident_module id env).mda_address
+  | Pdot(p, s) ->
+      let c = find_structure_components p env in
+      get_address (NameMap.find s c.comp_modules).mda_address
+  | Papply _ -> raise Not_found
+
+and force_address = function
+  | Projection { parent; pos } -> Adot(get_address parent, pos)
+  | ModAlias { env; path } -> find_module_address path env
+
+and get_address a =
+  EnvLazy.force force_address a
+
+let find_value_address path env =
+  get_address (find_value_full path env).vda_address
+
+let find_class_address path env =
+  get_address (find_class_full path env).clda_address
+
+let rec get_constrs_address = function
+  | [] -> raise Not_found
+  | cda :: rest ->
+    match cda.cda_address with
+    | None -> get_constrs_address rest
+    | Some a -> get_address a
+
+let find_constructor_address path env =
+  match path with
+  | Pident id -> begin
+      let cda = TycompTbl.find_same id env.constrs in
+      match cda.cda_address with
+      | None -> raise Not_found
+      | Some addr -> get_address addr
+    end
+  | Pdot(p, s) ->
+      let c = find_structure_components p env in
+      get_constrs_address (NameMap.find s c.comp_constrs)
+  | Papply _ ->
+      raise Not_found
+
+let find_hash_type path env =
+  match path with
+  | Pident id ->
+      let name = "#" ^ Ident.name id in
+      let _, tda =
+        IdTbl.find_name wrap_identity ~mark:false name env.types
+      in
+      tda.tda_declaration
+  | Pdot(p, s) ->
+      let c = find_structure_components p env in
+      let name = "#" ^ s in
+      let tda = NameMap.find name c.comp_types in
+      tda.tda_declaration
+  | Papply _ ->
+      raise Not_found
+
+let required_globals = ref []
+let reset_required_globals () = required_globals := []
+let get_required_globals () = !required_globals
+let add_required_global id =
+  if Ident.global id && not !Clflags.transparent_modules
+  && not (List.exists (Ident.same id) !required_globals)
+  then required_globals := id :: !required_globals
+
+let rec normalize_module_path lax env = function
+  | Pident id as path when lax && Ident.persistent id ->
+      path (* fast path (avoids lookup) *)
+  | Pdot (p, s) as path ->
+      let p' = normalize_module_path lax env p in
+      if p == p' then expand_module_path lax env path
+      else expand_module_path lax env (Pdot(p', s))
+  | Papply (p1, p2) as path ->
+      let p1' = normalize_module_path lax env p1 in
+      let p2' = normalize_module_path true env p2 in
+      if p1 == p1' && p2 == p2' then expand_module_path lax env path
+      else expand_module_path lax env (Papply(p1', p2'))
+  | Pident _ as path ->
+      expand_module_path lax env path
+
+and expand_module_path lax env path =
+  try match find_module ~alias:true path env with
+    {md_type=Mty_alias path1} ->
+      let path' = normalize_module_path lax env path1 in
+      if lax || !Clflags.transparent_modules then path' else
+      let id = Path.head path in
+      if Ident.global id && not (Ident.same id (Path.head path'))
+      then add_required_global id;
+      path'
+  | _ -> path
+  with Not_found when lax
+  || (match path with Pident id -> not (Ident.persistent id) | _ -> true) ->
+      path
+
+let normalize_module_path oloc env path =
+  try normalize_module_path (oloc = None) env path
+  with Not_found ->
+    match oloc with None -> assert false
+    | Some loc ->
+        error (Missing_module(loc, path,
+                              normalize_module_path true env path))
+
+let normalize_path_prefix oloc env path =
+  match path with
+    Pdot(p, s) ->
+      let p2 = normalize_module_path oloc env p in
+      if p == p2 then path else Pdot(p2, s)
+  | Pident _ ->
+      path
+  | Papply _ ->
+      assert false
+
+let normalize_type_path oloc env path =
+  (* Inlined version of Path.is_constructor_typath:
+     constructor type paths (i.e. path pointing to an inline
+     record argument of a constructpr) are built as a regular
+     type path followed by a capitalized constructor name. *)
+  match path with
+  | Pident _ ->
+      path
+  | Pdot(p, s) ->
+      let p2 =
+        if Path.is_uident s && not (Path.is_uident (Path.last p)) then
+          (* Cstr M.t.C *)
+          normalize_path_prefix oloc env p
+        else
+          (* Regular M.t, Ext M.C *)
+          normalize_module_path oloc env p
+      in
+      if p == p2 then path else Pdot (p2, s)
+  | Papply _ ->
+      assert false
+
+let rec normalize_modtype_path env path =
+  let path = normalize_path_prefix None env path in
+  expand_modtype_path env path
+
+and expand_modtype_path env path =
+  match (find_modtype path env).mtd_type with
+  | Some (Mty_ident path) -> normalize_modtype_path env path
+  | _ | exception Not_found -> path
+
+let find_module path env =
+  find_module ~alias:false path env
+
+(* Find the manifest type associated to a type when appropriate:
+   - the type should be public or should have a private row,
+   - the type should have an associated manifest type. *)
+let find_type_expansion path env =
+  let decl = find_type path env in
+  match decl.type_manifest with
+  | Some body when decl.type_private = Public
+              || decl.type_kind <> Type_abstract
+              || Btype.has_constr_row body ->
+      (decl.type_params, body, decl.type_expansion_scope)
+  (* The manifest type of Private abstract data types without
+     private row are still considered unknown to the type system.
+     Hence, this case is caught by the following clause that also handles
+     purely abstract data types without manifest type definition. *)
+  | _ -> raise Not_found
+
+(* Find the manifest type information associated to a type, i.e.
+   the necessary information for the compiler's type-based optimisations.
+   In particular, the manifest type associated to a private abstract type
+   is revealed for the sake of compiler's type-based optimisations. *)
+let find_type_expansion_opt path env =
+  let decl = find_type path env in
+  match decl.type_manifest with
+  (* The manifest type of Private abstract data types can still get
+     an approximation using their manifest type. *)
+  | Some body ->
+      (decl.type_params, body, decl.type_expansion_scope)
+  | _ -> raise Not_found
+
+let find_modtype_expansion path env =
+  match (find_modtype path env).mtd_type with
+  | None -> raise Not_found
+  | Some mty -> mty
+
+let rec is_functor_arg path env =
+  match path with
+    Pident id ->
+      begin try Ident.find_same id env.functor_args; true
+      with Not_found -> false
+      end
+  | Pdot (p, _s) -> is_functor_arg p env
+  | Papply _ -> true
+
+(* Copying types associated with values *)
+
+let make_copy_of_types env0 =
+  let memo = Hashtbl.create 16 in
+  let copy t =
+    try
+      Hashtbl.find memo t.id
+    with Not_found ->
+      let t2 = Subst.type_expr Subst.identity t in
+      Hashtbl.add memo t.id t2;
+      t2
+  in
+  let f = function
+    | Val_unbound _ as entry -> entry
+    | Val_bound vda ->
+        let desc = vda.vda_description in
+        let desc = { desc with val_type = copy desc.val_type } in
+        Val_bound { vda with vda_description = desc }
+  in
+  let values =
+    IdTbl.map f env0.values
+  in
+  (fun env ->
+     if env.values != env0.values then fatal_error "Env.make_copy_of_types";
+     {env with values; summary = Env_copy_types env.summary}
+  )
+
+(* Helper to handle optional substitutions. *)
+
+let may_subst subst_f sub x =
+  match sub with
+  | None -> x
+  | Some sub -> subst_f sub x
+
+(* Iter on an environment (ignoring the body of functors and
+   not yet evaluated structures) *)
+
+type iter_cont = unit -> unit
+let iter_env_cont = ref []
+
+let rec scrape_alias_for_visit env (sub : Subst.t option) mty =
+  match mty with
+  | Mty_alias path ->
+      begin match may_subst Subst.module_path sub path with
+      | Pident id
+        when Ident.persistent id
+          && not (Persistent_env.looked_up persistent_env (Ident.name id)) ->
+          false
+      | path -> (* PR#6600: find_module may raise Not_found *)
+          try scrape_alias_for_visit env sub (find_module path env).md_type
+          with Not_found -> false
+      end
+  | _ -> true
+
+let iter_env wrap proj1 proj2 f env () =
+  IdTbl.iter wrap (fun id x -> f (Pident id) x) (proj1 env);
+  let rec iter_components path path' mcomps =
+    let cont () =
+      let visit =
+        match EnvLazy.get_arg mcomps.comps with
+        | None -> true
+        | Some { cm_mty; cm_freshening_subst; _ } ->
+            scrape_alias_for_visit env cm_freshening_subst cm_mty
+      in
+      if not visit then () else
+      match get_components mcomps with
+        Structure_comps comps ->
+          NameMap.iter
+            (fun s d -> f (Pdot (path, s)) (Pdot (path', s), d))
+            (proj2 comps);
+          NameMap.iter
+            (fun s mda ->
+              iter_components
+                (Pdot (path, s)) (Pdot (path', s)) mda.mda_components)
+            comps.comp_modules
+      | Functor_comps _ -> ()
+    in iter_env_cont := (path, cont) :: !iter_env_cont
+  in
+  IdTbl.iter wrap_module
+    (fun id (path, entry) ->
+       match entry with
+       | Mod_unbound _ -> ()
+       | Mod_local data ->
+           iter_components (Pident id) path data.mda_components
+       | Mod_persistent ->
+           let modname = Ident.name id in
+           match Persistent_env.find_in_cache persistent_env modname with
+           | None -> ()
+           | Some data ->
+               iter_components (Pident id) path data.mda_components)
+    env.modules
+
+let run_iter_cont l =
+  iter_env_cont := [];
+  List.iter (fun c -> c ()) l;
+  let cont = List.rev !iter_env_cont in
+  iter_env_cont := [];
+  cont
+
+let iter_types f =
+  iter_env wrap_identity (fun env -> env.types) (fun sc -> sc.comp_types)
+    (fun p1 (p2, tda) -> f p1 (p2, tda.tda_declaration))
+
+let same_types env1 env2 =
+  env1.types == env2.types && env1.modules == env2.modules
+
+let used_persistent () =
+  Persistent_env.fold persistent_env
+    (fun s _m r -> Concr.add s r)
+    Concr.empty
+
+let find_all_comps wrap proj s (p, mda) =
+  match get_components mda.mda_components with
+    Functor_comps _ -> []
+  | Structure_comps comps ->
+      try
+        let c = NameMap.find s (proj comps) in
+        [Pdot(p,s), wrap c]
+      with Not_found -> []
+
+let rec find_shadowed_comps path env =
+  match path with
+  | Pident id ->
+      List.filter_map
+        (fun (p, data) ->
+           match data with
+           | Mod_local x -> Some (p, x)
+           | Mod_unbound _ | Mod_persistent -> None)
+        (IdTbl.find_all wrap_module (Ident.name id) env.modules)
+  | Pdot (p, s) ->
+      let l = find_shadowed_comps p env in
+      let l' =
+        List.map
+          (find_all_comps wrap_identity
+             (fun comps -> comps.comp_modules) s) l
+      in
+      List.flatten l'
+  | Papply _ -> []
+
+let find_shadowed wrap proj1 proj2 path env =
+  match path with
+    Pident id ->
+      IdTbl.find_all wrap (Ident.name id) (proj1 env)
+  | Pdot (p, s) ->
+      let l = find_shadowed_comps p env in
+      let l' = List.map (find_all_comps wrap proj2 s) l in
+      List.flatten l'
+  | Papply _ -> []
+
+let find_shadowed_types path env =
+  List.map fst
+    (find_shadowed wrap_identity
+       (fun env -> env.types) (fun comps -> comps.comp_types) path env)
+
+(* Expand manifest module type names at the top of the given module type *)
+
+let rec scrape_alias env sub ?path mty =
+  match mty, path with
+    Mty_ident _, _ ->
+      let p =
+        match may_subst (Subst.modtype Keep) sub mty with
+        | Mty_ident p -> p
+        | _ -> assert false (* only [Mty_ident]s in [sub] *)
+      in
+      begin try
+        scrape_alias env sub (find_modtype_expansion p env) ?path
+      with Not_found ->
+        mty
+      end
+  | Mty_alias path, _ ->
+      let path = may_subst Subst.module_path sub path in
+      begin try
+        scrape_alias env sub (find_module path env).md_type ~path
+      with Not_found ->
+        (*Location.prerr_warning Location.none
+          (Warnings.No_cmi_file (Path.name path));*)
+        mty
+      end
+  | mty, Some path ->
+      !strengthen ~aliasable:true env mty path
+  | _ -> mty
+
+(* Given a signature and a root path, prefix all idents in the signature
+   by the root path and build the corresponding substitution. *)
+
+let prefix_idents root freshening_sub prefixing_sub sg =
+  let refresh id add_fn = function
+    | None -> id, None
+    | Some sub ->
+      let id' = Ident.rename id in
+      id', Some (add_fn id (Pident id') sub)
+  in
+  let rec prefix_idents root items_and_paths freshening_sub prefixing_sub =
+    function
+    | [] -> (List.rev items_and_paths, freshening_sub, prefixing_sub)
+    | Sig_value(id, _, _) as item :: rem ->
+      let p = Pdot(root, Ident.name id) in
+      prefix_idents root
+        ((item, p) :: items_and_paths) freshening_sub prefixing_sub rem
+    | Sig_type(id, td, rs, vis) :: rem ->
+      let p = Pdot(root, Ident.name id) in
+      let id', freshening_sub = refresh id Subst.add_type freshening_sub in
+      prefix_idents root
+        ((Sig_type(id', td, rs, vis), p) :: items_and_paths)
+        freshening_sub
+        (Subst.add_type id' p prefixing_sub)
+        rem
+    | Sig_typext(id, ec, es, vis) :: rem ->
+      let p = Pdot(root, Ident.name id) in
+      let id', freshening_sub = refresh id Subst.add_type freshening_sub in
+      (* we extend the substitution in case of an inlined record *)
+      prefix_idents root
+        ((Sig_typext(id', ec, es, vis), p) :: items_and_paths)
+        freshening_sub
+        (Subst.add_type id' p prefixing_sub)
+        rem
+    | Sig_module(id, pres, md, rs, vis) :: rem ->
+      let p = Pdot(root, Ident.name id) in
+      let id', freshening_sub = refresh id Subst.add_module freshening_sub in
+      prefix_idents root
+        ((Sig_module(id', pres, md, rs, vis), p) :: items_and_paths)
+        freshening_sub
+        (Subst.add_module id' p prefixing_sub)
+        rem
+    | Sig_modtype(id, mtd, vis) :: rem ->
+      let p = Pdot(root, Ident.name id) in
+      let id', freshening_sub =
+        refresh id (fun i p s -> Subst.add_modtype i (Mty_ident p) s)
+          freshening_sub
+      in
+      prefix_idents root
+        ((Sig_modtype(id', mtd, vis), p) :: items_and_paths)
+        freshening_sub
+        (Subst.add_modtype id' (Mty_ident p) prefixing_sub)
+        rem
+    | Sig_class(id, cd, rs, vis) :: rem ->
+      (* pretend this is a type, cf. PR#6650 *)
+      let p = Pdot(root, Ident.name id) in
+      let id', freshening_sub = refresh id Subst.add_type freshening_sub in
+      prefix_idents root
+        ((Sig_class(id', cd, rs, vis), p) :: items_and_paths)
+        freshening_sub
+        (Subst.add_type id' p prefixing_sub)
+        rem
+    | Sig_class_type(id, ctd, rs, vis) :: rem ->
+      let p = Pdot(root, Ident.name id) in
+      let id', freshening_sub = refresh id Subst.add_type freshening_sub in
+      prefix_idents root
+        ((Sig_class_type(id', ctd, rs, vis), p) :: items_and_paths)
+        freshening_sub
+        (Subst.add_type id' p prefixing_sub)
+        rem
+  in
+  prefix_idents root [] freshening_sub prefixing_sub sg
+
+(* Compute structure descriptions *)
+
+let add_to_tbl id decl tbl =
+  let decls = try NameMap.find id tbl with Not_found -> [] in
+  NameMap.add id (decl :: decls) tbl
+
+let value_declaration_address (_ : t) id decl =
+  match decl.val_kind with
+  | Val_prim _ -> EnvLazy.create_failed Not_found
+  | _ -> EnvLazy.create_forced (Aident id)
+
+let extension_declaration_address (_ : t) id (_ : extension_constructor) =
+  EnvLazy.create_forced (Aident id)
+
+let class_declaration_address (_ : t) id (_ : class_declaration) =
+  EnvLazy.create_forced (Aident id)
+
+let module_declaration_address env id presence md =
+  match presence with
+  | Mp_absent -> begin
+      match md.md_type with
+      | Mty_alias path -> EnvLazy.create (ModAlias {env; path})
+      | _ -> assert false
+    end
+  | Mp_present ->
+      EnvLazy.create_forced (Aident id)
+
+let rec components_of_module_maker
+          {cm_env; cm_freshening_subst; cm_prefixing_subst;
+           cm_path; cm_addr; cm_mty} : _ result =
+  match scrape_alias cm_env cm_freshening_subst cm_mty with
+    Mty_signature sg ->
+      let c =
+        { comp_values = NameMap.empty;
+          comp_constrs = NameMap.empty;
+          comp_labels = NameMap.empty; comp_types = NameMap.empty;
+          comp_modules = NameMap.empty; comp_modtypes = NameMap.empty;
+          comp_classes = NameMap.empty; comp_cltypes = NameMap.empty }
+      in
+      let items_and_paths, freshening_sub, prefixing_sub =
+        prefix_idents cm_path cm_freshening_subst cm_prefixing_subst sg
+      in
+      let env = ref cm_env in
+      let pos = ref 0 in
+      let next_address () =
+        let addr : address_unforced =
+          Projection { parent = cm_addr; pos = !pos }
+        in
+        incr pos;
+        EnvLazy.create addr
+      in
+      let sub = may_subst Subst.compose freshening_sub prefixing_sub in
+      List.iter (fun (item, path) ->
+        match item with
+          Sig_value(id, decl, _) ->
+            let decl' = Subst.value_description sub decl in
+            let addr =
+              match decl.val_kind with
+              | Val_prim _ -> EnvLazy.create_failed Not_found
+              | _ -> next_address ()
+            in
+            let vda = { vda_description = decl'; vda_address = addr } in
+            c.comp_values <- NameMap.add (Ident.name id) vda c.comp_values;
+        | Sig_type(id, decl, _, _) ->
+            let fresh_decl =
+              may_subst Subst.type_declaration freshening_sub decl
+            in
+            let final_decl = Subst.type_declaration prefixing_sub fresh_decl in
+            Datarepr.set_row_name final_decl
+              (Subst.type_path prefixing_sub (Path.Pident id));
+            let constructors =
+              List.map snd
+                (Datarepr.constructors_of_type ~current_unit:(get_unit_name ())
+                   path final_decl)
+            in
+            let labels =
+              List.map snd (Datarepr.labels_of_type path final_decl) in
+            let tda =
+              { tda_declaration = final_decl;
+                tda_descriptions = (constructors, labels); }
+            in
+            c.comp_types <- NameMap.add (Ident.name id) tda c.comp_types;
+            List.iter
+              (fun descr ->
+                 let cda = { cda_description = descr; cda_address = None } in
+                 c.comp_constrs <-
+                   add_to_tbl descr.cstr_name cda c.comp_constrs)
+              constructors;
+            List.iter
+              (fun descr ->
+                c.comp_labels <-
+                  add_to_tbl descr.lbl_name descr c.comp_labels)
+              labels;
+            env := store_type_infos id fresh_decl !env
+        | Sig_typext(id, ext, _, _) ->
+            let ext' = Subst.extension_constructor sub ext in
+            let descr =
+              Datarepr.extension_descr ~current_unit:(get_unit_name ()) path
+                ext'
+            in
+            let addr = next_address () in
+            let cda = { cda_description = descr; cda_address = Some addr } in
+            c.comp_constrs <- add_to_tbl (Ident.name id) cda c.comp_constrs
+        | Sig_module(id, pres, md, _, _) ->
+            let md' =
+              (* The prefixed items get the same scope as [cm_path], which is
+                 the prefix. *)
+              EnvLazy.create (sub, Subst.Rescope (Path.scope cm_path), md)
+            in
+            let addr =
+              match pres with
+              | Mp_absent -> begin
+                  match md.md_type with
+                  | Mty_alias p ->
+                      let path = may_subst Subst.module_path freshening_sub p in
+                      EnvLazy.create (ModAlias {env = !env; path})
+                  | _ -> assert false
+                end
+              | Mp_present -> next_address ()
+            in
+            let alerts =
+              Builtin_attributes.alerts_of_attrs md.md_attributes
+            in
+            let comps =
+              components_of_module ~alerts ~uid:md.md_uid !env freshening_sub
+                prefixing_sub path addr md.md_type
+            in
+            let mda =
+              { mda_declaration = md';
+                mda_components = comps;
+                mda_address = addr }
+            in
+            c.comp_modules <-
+              NameMap.add (Ident.name id) mda c.comp_modules;
+            env :=
+              store_module ~freshening_sub ~check:None id addr pres md !env
+        | Sig_modtype(id, decl, _) ->
+            let fresh_decl =
+              (* the fresh_decl is only going in the local temporary env, and
+                 shouldn't be used for anything. So we make the items local. *)
+              may_subst (Subst.modtype_declaration Make_local) freshening_sub
+                decl
+            in
+            let final_decl =
+              (* The prefixed items get the same scope as [cm_path], which is
+                 the prefix. *)
+              Subst.modtype_declaration (Rescope (Path.scope cm_path))
+                prefixing_sub fresh_decl
+            in
+            c.comp_modtypes <-
+              NameMap.add (Ident.name id) final_decl c.comp_modtypes;
+            env := store_modtype id fresh_decl !env
+        | Sig_class(id, decl, _, _) ->
+            let decl' = Subst.class_declaration sub decl in
+            let addr = next_address () in
+            let clda = { clda_declaration = decl'; clda_address = addr } in
+            c.comp_classes <- NameMap.add (Ident.name id) clda c.comp_classes
+        | Sig_class_type(id, decl, _, _) ->
+            let decl' = Subst.cltype_declaration sub decl in
+            c.comp_cltypes <-
+              NameMap.add (Ident.name id) decl' c.comp_cltypes)
+        items_and_paths;
+        Ok (Structure_comps c)
+  | Mty_functor(arg, ty_res) ->
+      let sub =
+        may_subst Subst.compose cm_freshening_subst cm_prefixing_subst
+      in
+      let scoping = Subst.Rescope (Path.scope cm_path) in
+        Ok (Functor_comps {
+          (* fcomp_arg and fcomp_res must be prefixed eagerly, because
+             they are interpreted in the outer environment *)
+          fcomp_arg =
+            (match arg with
+            | Unit -> Unit
+            | Named (param, ty_arg) ->
+              Named (param, Subst.modtype scoping sub ty_arg));
+          fcomp_res = Subst.modtype scoping sub ty_res;
+          fcomp_cache = Hashtbl.create 17;
+          fcomp_subst_cache = Hashtbl.create 17 })
+  | Mty_ident _ -> Error No_components_abstract
+  | Mty_alias p -> Error (No_components_alias p)
+
+(* Insertion of bindings by identifier + path *)
+
+and check_usage loc id uid warn tbl =
+  if not loc.Location.loc_ghost &&
+     Uid.for_actual_declaration uid &&
+     Warnings.is_active (warn "")
+  then begin
+    let name = Ident.name id in
+    if Types.Uid.Tbl.mem tbl uid then ()
+    else let used = ref false in
+    Types.Uid.Tbl.add tbl uid (fun () -> used := true);
+    if not (name = "" || name.[0] = '_' || name.[0] = '#')
+    then
+      !add_delayed_check_forward
+        (fun () -> if not !used then Location.prerr_warning loc (warn name))
+  end;
+
+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 && (name.[0] = '#') then
+    for i = 1 to String.length name - 1 do
+      if name.[i] = '#' then
+        error (Illegal_value_name(loc, name))
+    done
+
+and store_value ?check id addr decl env =
+  check_value_name (Ident.name id) decl.val_loc;
+  Option.iter
+    (fun f -> check_usage decl.val_loc id decl.val_uid f value_declarations)
+    check;
+  let vda = { vda_description = decl; vda_address = addr } in
+  { env with
+    values = IdTbl.add id (Val_bound vda) env.values;
+    summary = Env_value(env.summary, id, decl) }
+
+and store_type ~check id info env =
+  let loc = info.type_loc in
+  if check then
+    check_usage loc id info.type_uid
+      (fun s -> Warnings.Unused_type_declaration s)
+      type_declarations;
+  let path = Pident id in
+  let constructors =
+    Datarepr.constructors_of_type path info
+      ~current_unit:(get_unit_name ())
+  in
+  let labels = Datarepr.labels_of_type path info in
+  let descrs = (List.map snd constructors, List.map snd labels) in
+  let tda = { tda_declaration = info; tda_descriptions = descrs } in
+  if check && not loc.Location.loc_ghost &&
+    Warnings.is_active (Warnings.Unused_constructor ("", false, false))
+  then begin
+    let ty_name = Ident.name id in
+    let priv = info.type_private in
+    List.iter
+      begin fun (_, cstr) ->
+        let name = cstr.cstr_name in
+        let loc = cstr.cstr_loc in
+        let k = cstr.cstr_uid in
+        if not (Types.Uid.Tbl.mem used_constructors k) then
+          let used = constructor_usages () in
+          Types.Uid.Tbl.add used_constructors k
+            (add_constructor_usage ~rebind:false priv used);
+          if not (ty_name = "" || ty_name.[0] = '_')
+          then !add_delayed_check_forward
+              (fun () ->
+                if not (is_in_signature env) && not used.cu_positive then
+                  Location.prerr_warning loc
+                    (Warnings.Unused_constructor
+                       (name, used.cu_pattern, used.cu_privatize)))
+      end
+      constructors
+  end;
+  { env with
+    constrs =
+      List.fold_right
+        (fun (id, descr) constrs ->
+           let cda = { cda_description = descr; cda_address = None } in
+           TycompTbl.add id cda constrs)
+        constructors env.constrs;
+    labels =
+      List.fold_right
+        (fun (id, descr) labels -> TycompTbl.add id descr labels)
+        labels env.labels;
+    types = IdTbl.add id tda env.types;
+    summary = Env_type(env.summary, id, info) }
+
+and store_type_infos id info env =
+  (* Simplified version of store_type that doesn't compute and store
+     constructor and label infos, but simply record the arity and
+     manifest-ness of the type.  Used in components_of_module to
+     keep track of type abbreviations (e.g. type t = float) in the
+     computation of label representations. *)
+  let tda = { tda_declaration = info; tda_descriptions = [], [] } in
+  { env with
+    types = IdTbl.add id tda env.types;
+    summary = Env_type(env.summary, id, info) }
+
+and store_extension ~check ~rebind id addr ext env =
+  let loc = ext.ext_loc in
+  let cstr =
+    Datarepr.extension_descr ~current_unit:(get_unit_name ()) (Pident id) ext
+  in
+  let cda = { cda_description = cstr; cda_address = Some addr } in
+  if check && not loc.Location.loc_ghost &&
+    Warnings.is_active (Warnings.Unused_extension ("", false, false, false))
+  then begin
+    let priv = ext.ext_private in
+    let is_exception = Path.same ext.ext_type_path Predef.path_exn in
+    let name = cstr.cstr_name in
+    let k = cstr.cstr_uid in
+    if not (Types.Uid.Tbl.mem used_constructors k) then begin
+      let used = constructor_usages () in
+      Types.Uid.Tbl.add used_constructors k
+        (add_constructor_usage ~rebind priv used);
+      !add_delayed_check_forward
+        (fun () ->
+          if not (is_in_signature env) && not used.cu_positive then
+            Location.prerr_warning loc
+              (Warnings.Unused_extension
+                 (name, is_exception, used.cu_pattern, used.cu_privatize)
+              )
+        )
+    end;
+  end;
+  { env with
+    constrs = TycompTbl.add id cda env.constrs;
+    summary = Env_extension(env.summary, id, ext) }
+
+and store_module ~check ~freshening_sub id addr presence md env =
+  let loc = md.md_loc in
+  Option.iter
+    (fun f -> check_usage loc id md.md_uid f module_declarations) check;
+  let alerts = Builtin_attributes.alerts_of_attrs md.md_attributes in
+  let module_decl_lazy =
+    match freshening_sub with
+    | None -> EnvLazy.create_forced md
+    | Some s -> EnvLazy.create (s, Subst.Rescope (Ident.scope id), md)
+  in
+  let comps =
+    components_of_module ~alerts ~uid:md.md_uid
+      env freshening_sub Subst.identity (Pident id) addr md.md_type
+  in
+  let mda =
+    { mda_declaration = module_decl_lazy;
+      mda_components = comps;
+      mda_address = addr }
+  in
+  { env with
+    modules = IdTbl.add id (Mod_local mda) env.modules;
+    summary = Env_module(env.summary, id, presence, md) }
+
+and store_modtype id info env =
+  { env with
+    modtypes = IdTbl.add id info env.modtypes;
+    summary = Env_modtype(env.summary, id, info) }
+
+and store_class id addr desc env =
+  let clda = { clda_declaration = desc; clda_address = addr } in
+  { env with
+    classes = IdTbl.add id clda env.classes;
+    summary = Env_class(env.summary, id, desc) }
+
+and store_cltype id desc env =
+  { env with
+    cltypes = IdTbl.add id desc env.cltypes;
+    summary = Env_cltype(env.summary, id, desc) }
+
+let scrape_alias env mty = scrape_alias env None mty
+
+(* Compute the components of a functor application in a path. *)
+
+let components_of_functor_appl ~loc f env p1 p2 =
+  try
+    Hashtbl.find f.fcomp_cache p2
+  with Not_found ->
+    let p = Papply(p1, p2) in
+    let sub =
+      match f.fcomp_arg with
+      | Unit
+      | Named (None, _) -> Subst.identity
+      | Named (Some param, _) -> Subst.add_module param p2 Subst.identity
+    in
+    (* we have to apply eagerly instead of passing sub to [components_of_module]
+       because of the call to [check_well_formed_module]. *)
+    let mty = Subst.modtype (Rescope (Path.scope p)) sub f.fcomp_res in
+    let addr = EnvLazy.create_failed Not_found in
+    !check_well_formed_module env loc
+      ("the signature of " ^ Path.name p) mty;
+    let comps =
+      components_of_module ~alerts:Misc.Stdlib.String.Map.empty
+        ~uid:Uid.internal_not_actually_unique
+        (*???*)
+        env None Subst.identity p addr mty
+    in
+    Hashtbl.add f.fcomp_cache p2 comps;
+    comps
+
+(* Define forward functions *)
+
+let _ =
+  components_of_functor_appl' := components_of_functor_appl;
+  components_of_module_maker' := components_of_module_maker
+
+(* Insertion of bindings by identifier *)
+
+let add_functor_arg id env =
+  {env with
+   functor_args = Ident.add id () env.functor_args;
+   summary = Env_functor_arg (env.summary, id)}
+
+let add_value ?check id desc env =
+  let addr = value_declaration_address env id desc in
+  store_value ?check id addr desc env
+
+let add_type ~check id info env =
+  store_type ~check id info env
+
+and add_extension ~check ~rebind id ext env =
+  let addr = extension_declaration_address env id ext in
+  store_extension ~check ~rebind id addr ext env
+
+and add_module_declaration ?(arg=false) ~check id presence md env =
+  let check =
+    if not check then
+      None
+    else if arg && is_in_signature env then
+      Some (fun s -> Warnings.Unused_functor_parameter s)
+    else
+      Some (fun s -> Warnings.Unused_module s)
+  in
+  let addr = module_declaration_address env id presence md in
+  let env = store_module ~freshening_sub:None ~check id addr presence md env in
+  if arg then add_functor_arg id env else env
+
+and add_modtype id info env =
+  store_modtype id info env
+
+and add_class id ty env =
+  let addr = class_declaration_address env id ty in
+  store_class id addr ty env
+
+and add_cltype id ty env =
+  store_cltype id ty env
+
+let add_module ?arg id presence mty env =
+  add_module_declaration ~check:false ?arg id presence (md mty) env
+
+let add_local_type path info env =
+  { env with
+    local_constraints = Path.Map.add path info env.local_constraints }
+
+
+(* Insertion of bindings by name *)
+
+let enter_value ?check name desc env =
+  let id = Ident.create_local name in
+  let addr = value_declaration_address env id desc in
+  let env = store_value ?check id addr desc env in
+  (id, env)
+
+let enter_type ~scope name info env =
+  let id = Ident.create_scoped ~scope name in
+  let env = store_type ~check:true id info env in
+  (id, env)
+
+let enter_extension ~scope ~rebind name ext env =
+  let id = Ident.create_scoped ~scope name in
+  let addr = extension_declaration_address env id ext in
+  let env = store_extension ~check:true ~rebind id addr ext env in
+  (id, env)
+
+let enter_module_declaration ~scope ?arg s presence md env =
+  let id = Ident.create_scoped ~scope s in
+  (id, add_module_declaration ?arg ~check:true id presence md env)
+
+let enter_modtype ~scope name mtd env =
+  let id = Ident.create_scoped ~scope name in
+  let env = store_modtype id mtd env in
+  (id, env)
+
+let enter_class ~scope name desc env =
+  let id = Ident.create_scoped ~scope name in
+  let addr = class_declaration_address env id desc in
+  let env = store_class id addr desc env in
+  (id, env)
+
+let enter_cltype ~scope name desc env =
+  let id = Ident.create_scoped ~scope name in
+  let env = store_cltype id desc env in
+  (id, env)
+
+let enter_module ~scope ?arg s presence mty env =
+  enter_module_declaration ~scope ?arg s presence (md mty) env
+
+(* Insertion of all components of a signature *)
+
+let add_item comp env =
+  match comp with
+    Sig_value(id, decl, _)    -> add_value id decl env
+  | Sig_type(id, decl, _, _)  -> add_type ~check:false id decl env
+  | Sig_typext(id, ext, _, _) ->
+      add_extension ~check:false ~rebind:false id ext env
+  | Sig_module(id, presence, md, _, _) ->
+      add_module_declaration ~check:false id presence md env
+  | Sig_modtype(id, decl, _)  -> add_modtype id decl env
+  | Sig_class(id, decl, _, _) -> add_class id decl env
+  | Sig_class_type(id, decl, _, _) -> add_cltype id decl env
+
+let rec add_signature sg env =
+  match sg with
+    [] -> env
+  | comp :: rem -> add_signature rem (add_item comp env)
+
+let enter_signature ~scope sg env =
+  let sg = Subst.signature (Rescope scope) Subst.identity sg in
+  sg, add_signature sg env
+
+(* Add "unbound" bindings *)
+
+let enter_unbound_value name reason env =
+  let id = Ident.create_local name in
+  { env with
+    values = IdTbl.add id (Val_unbound reason) env.values;
+    summary = Env_value_unbound(env.summary, name, reason) }
+
+let enter_unbound_module name reason env =
+  let id = Ident.create_local name in
+  { env with
+    modules = IdTbl.add id (Mod_unbound reason) env.modules;
+    summary = Env_module_unbound(env.summary, name, reason) }
+
+(* Open a signature path *)
+
+let add_components slot root env0 comps =
+  let add_l w comps env0 =
+    TycompTbl.add_open slot w comps env0
+  in
+  let add w comps env0 = IdTbl.add_open slot w root comps env0 in
+  let constrs =
+    add_l (fun x -> `Constructor x) comps.comp_constrs env0.constrs
+  in
+  let labels =
+    add_l (fun x -> `Label x) comps.comp_labels env0.labels
+  in
+  let values =
+    add (fun x -> `Value x) comps.comp_values env0.values
+  in
+  let types =
+    add (fun x -> `Type x) comps.comp_types env0.types
+  in
+  let modtypes =
+    add (fun x -> `Module_type x) comps.comp_modtypes env0.modtypes
+  in
+  let classes =
+    add (fun x -> `Class x) comps.comp_classes env0.classes
+  in
+  let cltypes =
+    add (fun x -> `Class_type x) comps.comp_cltypes env0.cltypes
+  in
+  let modules =
+    add (fun x -> `Module x) comps.comp_modules env0.modules
+  in
+  { env0 with
+    summary = Env_open(env0.summary, root);
+    constrs;
+    labels;
+    values;
+    types;
+    modtypes;
+    classes;
+    cltypes;
+    modules;
+  }
+
+let open_signature slot root env0 : (_,_) result =
+  match get_components_res (find_module_components root env0) with
+  | Error _ -> Error `Not_found
+  | exception Not_found -> Error `Not_found
+  | Ok (Functor_comps _) -> Error `Functor
+  | Ok (Structure_comps comps) ->
+    Ok (add_components slot root env0 comps)
+
+
+(* Open a signature from a file *)
+
+let open_pers_signature name env =
+  match open_signature None (Pident(Ident.create_persistent name)) env with
+  | (Ok _ | Error `Not_found as res) -> res
+  | Error `Functor -> assert false
+        (* a compilation unit cannot refer to a functor *)
+
+let open_signature
+    ?(used_slot = ref false)
+    ?(loc = Location.none) ?(toplevel = false)
+    ovf root env =
+  let unused =
+    match ovf with
+    | Asttypes.Fresh -> Warnings.Unused_open (Path.name root)
+    | Asttypes.Override -> Warnings.Unused_open_bang (Path.name root)
+  in
+  let warn_unused =
+    Warnings.is_active unused
+  and warn_shadow_id =
+    Warnings.is_active (Warnings.Open_shadow_identifier ("", ""))
+  and warn_shadow_lc =
+    Warnings.is_active (Warnings.Open_shadow_label_constructor ("",""))
+  in
+  if not toplevel && not loc.Location.loc_ghost
+     && (warn_unused || warn_shadow_id || warn_shadow_lc)
+  then begin
+    let used = used_slot in
+    if warn_unused then
+      !add_delayed_check_forward
+        (fun () ->
+           if not !used then begin
+             used := true;
+             Location.prerr_warning loc unused
+           end
+        );
+    let shadowed = ref [] in
+    let slot s b =
+      begin match check_shadowing env b with
+      | Some kind when
+          ovf = Asttypes.Fresh && not (List.mem (kind, s) !shadowed) ->
+          shadowed := (kind, s) :: !shadowed;
+          let w =
+            match kind with
+            | "label" | "constructor" ->
+                Warnings.Open_shadow_label_constructor (kind, s)
+            | _ -> Warnings.Open_shadow_identifier (kind, s)
+          in
+          Location.prerr_warning loc w
+      | _ -> ()
+      end;
+      used := true
+    in
+    open_signature (Some slot) root env
+  end
+  else open_signature None root env
+
+(* Read a signature from a file *)
+let read_signature modname filename =
+  let mda = read_pers_mod modname filename in
+  let md = EnvLazy.force subst_modtype_maker mda.mda_declaration in
+  match md.md_type with
+  | Mty_signature sg -> sg
+  | Mty_ident _ | Mty_functor _ | Mty_alias _ -> assert false
+
+let is_identchar_latin1 = function
+  | 'A'..'Z' | 'a'..'z' | '_' | '\192'..'\214' | '\216'..'\246'
+  | '\248'..'\255' | '\'' | '0'..'9' -> true
+  | _ -> false
+
+let unit_name_of_filename fn =
+  match Filename.extension fn with
+  | ".cmi" -> begin
+      let unit =
+        String.capitalize_ascii (Filename.remove_extension fn)
+      in
+      if String.for_all is_identchar_latin1 unit then
+        Some unit
+      else
+        None
+    end
+  | _ -> None
+
+let persistent_structures_of_dir dir =
+  Load_path.Dir.files dir
+  |> List.to_seq
+  |> Seq.filter_map unit_name_of_filename
+  |> String.Set.of_seq
+
+(* Save a signature to a file *)
+let save_signature_with_transform cmi_transform ~alerts sg modname filename =
+  Btype.cleanup_abbrev ();
+  Subst.reset_for_saving ();
+  let sg = Subst.signature Make_local (Subst.for_saving Subst.identity) sg in
+  let cmi =
+    Persistent_env.make_cmi persistent_env modname sg alerts
+    |> cmi_transform in
+  let pm = save_sign_of_cmi
+      { Persistent_env.Persistent_signature.cmi; filename } in
+  Persistent_env.save_cmi persistent_env
+    { Persistent_env.Persistent_signature.filename; cmi } pm;
+  cmi
+
+let save_signature ~alerts sg modname filename =
+  save_signature_with_transform (fun cmi -> cmi)
+    ~alerts sg modname filename
+
+let save_signature_with_imports ~alerts sg modname filename imports =
+  let with_imports cmi = { cmi with cmi_crcs = imports } in
+  save_signature_with_transform with_imports
+    ~alerts sg modname filename
+
+(* Make the initial environment *)
+let (initial_safe_string, initial_unsafe_string) =
+  Predef.build_initial_env
+    (add_type ~check:false)
+    (add_extension ~check:false ~rebind:false)
+    empty
+
+(* Tracking usage *)
+
+let mark_module_used uid =
+  match Types.Uid.Tbl.find module_declarations uid with
+  | mark -> mark ()
+  | exception Not_found -> ()
+
+let mark_modtype_used _uid = ()
+
+let mark_value_used uid =
+  match Types.Uid.Tbl.find value_declarations uid with
+  | mark -> mark ()
+  | exception Not_found -> ()
+
+let mark_type_used uid =
+  match Types.Uid.Tbl.find type_declarations uid with
+  | mark -> mark ()
+  | exception Not_found -> ()
+
+let mark_type_path_used env path =
+  match find_type path env with
+  | decl -> mark_type_used decl.type_uid
+  | exception Not_found -> ()
+
+let mark_constructor_used usage cd =
+  match Types.Uid.Tbl.find used_constructors cd.cd_uid with
+  | mark -> mark usage
+  | exception Not_found -> ()
+
+let mark_extension_used usage ext =
+  match Types.Uid.Tbl.find used_constructors ext.ext_uid with
+  | mark -> mark usage
+  | exception Not_found -> ()
+
+let mark_constructor_description_used usage env cstr =
+  let ty_path =
+    match repr cstr.cstr_res with
+    | {desc=Tconstr(path, _, _)} -> path
+    | _ -> assert false
+  in
+  mark_type_path_used env ty_path;
+  match Types.Uid.Tbl.find used_constructors cstr.cstr_uid with
+  | mark -> mark usage
+  | exception Not_found -> ()
+
+let mark_label_description_used () env lbl =
+  let ty_path =
+    match repr lbl.lbl_res with
+    | {desc=Tconstr(path, _, _)} -> path
+    | _ -> assert false
+  in
+  mark_type_path_used env ty_path
+
+let mark_class_used uid =
+  match Types.Uid.Tbl.find type_declarations uid with
+  | mark -> mark ()
+  | exception Not_found -> ()
+
+let mark_cltype_used uid =
+  match Types.Uid.Tbl.find type_declarations uid with
+  | mark -> mark ()
+  | exception Not_found -> ()
+
+let set_value_used_callback vd callback =
+  Types.Uid.Tbl.add value_declarations vd.val_uid callback
+
+let set_type_used_callback td callback =
+  if Uid.for_actual_declaration td.type_uid then
+    let old =
+      try Types.Uid.Tbl.find type_declarations td.type_uid
+      with Not_found -> ignore
+    in
+    Types.Uid.Tbl.replace type_declarations td.type_uid (fun () -> callback old)
+
+(* Lookup by name *)
+
+let may_lookup_error report_errors loc env err =
+  if report_errors then lookup_error loc env err
+  else raise Not_found
+
+let report_module_unbound ~errors ~loc env reason =
+  match reason with
+  | Mod_unbound_illegal_recursion ->
+      (* see #5965 *)
+    may_lookup_error errors loc env Illegal_reference_to_recursive_module
+
+let report_value_unbound ~errors ~loc env reason lid =
+  match reason with
+  | Val_unbound_instance_variable ->
+      may_lookup_error errors loc env (Masked_instance_variable lid)
+  | Val_unbound_self ->
+      may_lookup_error errors loc env (Masked_self_variable lid)
+  | Val_unbound_ancestor ->
+      may_lookup_error errors loc env (Masked_ancestor_variable lid)
+  | Val_unbound_ghost_recursive rloc ->
+      let show_hint =
+        (* Only display the "missing rec" hint for non-ghost code *)
+        not loc.Location.loc_ghost
+        && not rloc.Location.loc_ghost
+      in
+      let hint =
+        if show_hint then Missing_rec rloc else No_hint
+      in
+      may_lookup_error errors loc env (Unbound_value(lid, hint))
+
+let use_module ~use ~loc path mda =
+  if use then begin
+    let comps = mda.mda_components in
+    mark_module_used comps.uid;
+    Misc.Stdlib.String.Map.iter
+      (fun kind message ->
+         let message = if message = "" then "" else "\n" ^ message in
+         Location.alert ~kind loc
+           (Printf.sprintf "module %s%s" (Path.name path) message)
+      )
+      comps.alerts
+  end
+
+let use_value ~use ~loc path vda =
+  if use then begin
+    let desc = vda.vda_description in
+    mark_value_used desc.val_uid;
+    Builtin_attributes.check_alerts loc desc.val_attributes
+      (Path.name path)
+  end
+
+let use_type ~use ~loc path tda =
+  if use then begin
+    let decl = tda.tda_declaration in
+    mark_type_used decl.type_uid;
+    Builtin_attributes.check_alerts loc decl.type_attributes
+      (Path.name path)
+  end
+
+let use_modtype ~use ~loc path desc =
+  if use then begin
+    mark_modtype_used desc.mtd_uid;
+    Builtin_attributes.check_alerts loc desc.mtd_attributes
+      (Path.name path)
+  end
+
+let use_class ~use ~loc path clda =
+  if use then begin
+    let desc = clda.clda_declaration in
+    mark_class_used desc.cty_uid;
+    Builtin_attributes.check_alerts loc desc.cty_attributes
+      (Path.name path)
+  end
+
+let use_cltype ~use ~loc path desc =
+  if use then begin
+    mark_cltype_used desc.clty_uid;
+    Builtin_attributes.check_alerts loc desc.clty_attributes
+      (Path.name path)
+  end
+
+let use_label ~use ~loc env lbl =
+  if use then begin
+    mark_label_description_used () env lbl;
+    Builtin_attributes.check_alerts loc lbl.lbl_attributes lbl.lbl_name
+  end
+
+let use_constructor_desc ~use ~loc usage env cstr =
+  if use then begin
+    mark_constructor_description_used usage env cstr;
+    Builtin_attributes.check_alerts loc cstr.cstr_attributes cstr.cstr_name
+  end
+
+let use_constructor ~use ~loc usage env cda =
+  use_constructor_desc ~use ~loc usage env cda.cda_description
+
+type _ load =
+  | Load : module_data load
+  | Don't_load : unit load
+
+let lookup_ident_module (type a) (load : a load) ~errors ~use ~loc s env =
+  let path, data =
+    match find_name_module ~mark:use s env.modules with
+    | res -> res
+    | exception Not_found ->
+        may_lookup_error errors loc env (Unbound_module (Lident s))
+  in
+  match data with
+  | Mod_local mda -> begin
+      use_module ~use ~loc path mda;
+      match load with
+      | Load -> path, (mda : a)
+      | Don't_load -> path, (() : a)
+    end
+  | Mod_unbound reason ->
+      report_module_unbound ~errors ~loc env reason
+  | Mod_persistent -> begin
+      match load with
+      | Don't_load ->
+          check_pers_mod ~loc s;
+          path, (() : a)
+      | Load -> begin
+          match find_pers_mod s with
+          | mda ->
+              use_module ~use ~loc path mda;
+              path, (mda : a)
+          | exception Not_found ->
+              may_lookup_error errors loc env (Unbound_module (Lident s))
+        end
+    end
+
+let lookup_ident_value ~errors ~use ~loc name env =
+  match IdTbl.find_name wrap_value ~mark:use name env.values with
+  | (path, Val_bound vda) ->
+      use_value ~use ~loc path vda;
+      path, vda.vda_description
+  | (_, Val_unbound reason) ->
+      report_value_unbound ~errors ~loc env reason (Lident name)
+  | exception Not_found ->
+      may_lookup_error errors loc env (Unbound_value (Lident name, No_hint))
+
+let lookup_ident_type ~errors ~use ~loc s env =
+  match IdTbl.find_name wrap_identity ~mark:use s env.types with
+  | (path, data) as res ->
+      use_type ~use ~loc path data;
+      res
+  | exception Not_found ->
+      may_lookup_error errors loc env (Unbound_type (Lident s))
+
+let lookup_ident_modtype ~errors ~use ~loc s env =
+  match IdTbl.find_name wrap_identity ~mark:use s env.modtypes with
+  | (path, data) as res ->
+      use_modtype ~use ~loc path data;
+      res
+  | exception Not_found ->
+      may_lookup_error errors loc env (Unbound_modtype (Lident s))
+
+let lookup_ident_class ~errors ~use ~loc s env =
+  match IdTbl.find_name wrap_identity ~mark:use s env.classes with
+  | (path, clda) ->
+      use_class ~use ~loc path clda;
+      path, clda.clda_declaration
+  | exception Not_found ->
+      may_lookup_error errors loc env (Unbound_class (Lident s))
+
+let lookup_ident_cltype ~errors ~use ~loc s env =
+  match IdTbl.find_name wrap_identity ~mark:use s env.cltypes with
+  | (path, data) as res ->
+      use_cltype ~use ~loc path data;
+      res
+  | exception Not_found ->
+      may_lookup_error errors loc env (Unbound_cltype (Lident s))
+
+let lookup_all_ident_labels ~errors ~use ~loc s env =
+  match TycompTbl.find_all ~mark:use s env.labels with
+  | [] -> may_lookup_error errors loc env (Unbound_label (Lident s))
+  | lbls -> begin
+      List.map
+        (fun (lbl, use_fn) ->
+           let use_fn () =
+             use_label ~use ~loc env lbl;
+             use_fn ()
+           in
+           (lbl, use_fn))
+        lbls
+    end
+
+let lookup_all_ident_constructors ~errors ~use ~loc usage s env =
+  match TycompTbl.find_all ~mark:use s env.constrs with
+  | [] -> may_lookup_error errors loc env (Unbound_constructor (Lident s))
+  | cstrs ->
+      List.map
+        (fun (cda, use_fn) ->
+           let use_fn () =
+             use_constructor ~use ~loc usage env cda;
+             use_fn ()
+           in
+           (cda.cda_description, use_fn))
+        cstrs
+
+let rec lookup_module_components ~errors ~use ~loc lid env =
+  match lid with
+  | Lident s ->
+      let path, data = lookup_ident_module Load ~errors ~use ~loc s env in
+      path, data.mda_components
+  | Ldot(l, s) ->
+      let path, data = lookup_dot_module ~errors ~use ~loc l s env in
+      path, data.mda_components
+  | Lapply(l1, l2) ->
+      let p1, f, arg = lookup_functor_components ~errors ~use ~loc l1 env in
+      let p2, md = lookup_module ~errors ~use ~loc l2 env in
+      check_functor_appl ~errors ~loc env p1 f arg p2 md;
+      let comps = !components_of_functor_appl' ~loc f env p1 p2 in
+      (Papply(p1, p2), comps)
+
+and lookup_structure_components ~errors ~use ~loc lid env =
+  let path, comps = lookup_module_components ~errors ~use ~loc lid env in
+  match get_components_res comps with
+  | Ok (Structure_comps comps) -> path, comps
+  | Ok (Functor_comps _) ->
+      may_lookup_error errors loc env (Functor_used_as_structure lid)
+  | Error No_components_abstract ->
+      may_lookup_error errors loc env (Abstract_used_as_structure lid)
+  | Error (No_components_alias p) ->
+      may_lookup_error errors loc env (Cannot_scrape_alias(lid, p))
+
+and lookup_functor_components ~errors ~use ~loc lid env =
+  let path, comps = lookup_module_components ~errors ~use ~loc lid env in
+  match get_components_res comps with
+  | Ok (Functor_comps fcomps) -> begin
+      match fcomps.fcomp_arg with
+      | Unit -> (* PR#7611 *)
+          may_lookup_error errors loc env (Generative_used_as_applicative lid)
+      | Named (_, arg) -> path, fcomps, arg
+    end
+  | Ok (Structure_comps _) ->
+      may_lookup_error errors loc env (Structure_used_as_functor lid)
+  | Error No_components_abstract ->
+      may_lookup_error errors loc env (Abstract_used_as_functor lid)
+  | Error (No_components_alias p) ->
+      may_lookup_error errors loc env (Cannot_scrape_alias(lid, p))
+
+and lookup_module ~errors ~use ~loc lid env =
+  match lid with
+  | Lident s ->
+      let path, data = lookup_ident_module Load ~errors ~use ~loc s env in
+      let md = EnvLazy.force subst_modtype_maker data.mda_declaration in
+      path, md
+  | Ldot(l, s) ->
+      let path, data = lookup_dot_module ~errors ~use ~loc l s env in
+      let md = EnvLazy.force subst_modtype_maker data.mda_declaration in
+      path, md
+  | Lapply(l1, l2) ->
+      let p1, fc, arg = lookup_functor_components ~errors ~use ~loc l1 env in
+      let p2, md2 = lookup_module ~errors ~use ~loc l2 env in
+      check_functor_appl ~errors ~loc env p1 fc arg p2 md2;
+      let md = md (modtype_of_functor_appl fc p1 p2) in
+      Papply(p1, p2), md
+
+and lookup_dot_module ~errors ~use ~loc l s env =
+  let p, comps = lookup_structure_components ~errors ~use ~loc l env in
+  match NameMap.find s comps.comp_modules with
+  | mda ->
+      let path = Pdot(p, s) in
+      use_module ~use ~loc path mda;
+      (path, mda)
+  | exception Not_found ->
+      may_lookup_error errors loc env (Unbound_module (Ldot(l, s)))
+
+let lookup_dot_value ~errors ~use ~loc l s env =
+  let (path, comps) =
+    lookup_structure_components ~errors ~use ~loc l env
+  in
+  match NameMap.find s comps.comp_values with
+  | vda ->
+      let path = Pdot(path, s) in
+      use_value ~use ~loc path vda;
+      (path, vda.vda_description)
+  | exception Not_found ->
+      may_lookup_error errors loc env (Unbound_value (Ldot(l, s), No_hint))
+
+let lookup_dot_type ~errors ~use ~loc l s env =
+  let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in
+  match NameMap.find s comps.comp_types with
+  | tda ->
+      let path = Pdot(p, s) in
+      use_type ~use ~loc path tda;
+      (path, tda)
+  | exception Not_found ->
+      may_lookup_error errors loc env (Unbound_type (Ldot(l, s)))
+
+let lookup_dot_modtype ~errors ~use ~loc l s env =
+  let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in
+  match NameMap.find s comps.comp_modtypes with
+  | desc ->
+      let path = Pdot(p, s) in
+      use_modtype ~use ~loc path desc;
+      (path, desc)
+  | exception Not_found ->
+      may_lookup_error errors loc env (Unbound_modtype (Ldot(l, s)))
+
+let lookup_dot_class ~errors ~use ~loc l s env =
+  let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in
+  match NameMap.find s comps.comp_classes with
+  | clda ->
+      let path = Pdot(p, s) in
+      use_class ~use ~loc path clda;
+      (path, clda.clda_declaration)
+  | exception Not_found ->
+      may_lookup_error errors loc env (Unbound_class (Ldot(l, s)))
+
+let lookup_dot_cltype ~errors ~use ~loc l s env =
+  let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in
+  match NameMap.find s comps.comp_cltypes with
+  | desc ->
+      let path = Pdot(p, s) in
+      use_cltype ~use ~loc path desc;
+      (path, desc)
+  | exception Not_found ->
+      may_lookup_error errors loc env (Unbound_cltype (Ldot(l, s)))
+
+let lookup_all_dot_labels ~errors ~use ~loc l s env =
+  let (_, comps) = lookup_structure_components ~errors ~use ~loc l env in
+  match NameMap.find s comps.comp_labels with
+  | [] | exception Not_found ->
+      may_lookup_error errors loc env (Unbound_label (Ldot(l, s)))
+  | lbls ->
+      List.map
+        (fun lbl ->
+           let use_fun () = use_label ~use ~loc env lbl in
+           (lbl, use_fun))
+        lbls
+
+let lookup_all_dot_constructors ~errors ~use ~loc usage l s env =
+  match l with
+  | Longident.Lident "*predef*" ->
+      (* Hack to support compilation of default arguments *)
+      lookup_all_ident_constructors
+        ~errors ~use ~loc usage s initial_safe_string
+  | _ ->
+      let (_, comps) = lookup_structure_components ~errors ~use ~loc l env in
+      match NameMap.find s comps.comp_constrs with
+      | [] | exception Not_found ->
+          may_lookup_error errors loc env (Unbound_constructor (Ldot(l, s)))
+      | cstrs ->
+          List.map
+            (fun cda ->
+               let use_fun () = use_constructor ~use ~loc usage env cda in
+               (cda.cda_description, use_fun))
+            cstrs
+
+(* General forms of the lookup functions *)
+
+let lookup_module_path ~errors ~use ~loc ~load lid env : Path.t =
+  match lid with
+  | Lident s ->
+      if !Clflags.transparent_modules && not load then
+        fst (lookup_ident_module Don't_load ~errors ~use ~loc s env)
+      else
+        fst (lookup_ident_module Load ~errors ~use ~loc s env)
+  | Ldot(l, s) -> fst (lookup_dot_module ~errors ~use ~loc l s env)
+  | Lapply(l1, l2) ->
+      let (p1, f, arg) = lookup_functor_components ~errors ~use ~loc l1 env in
+      let p2, md2 = lookup_module ~errors ~use ~loc l2 env in
+      check_functor_appl ~errors ~loc env p1 f arg p2 md2;
+      Papply(p1, p2)
+
+let lookup_value ~errors ~use ~loc lid env =
+  match lid with
+  | Lident s -> lookup_ident_value ~errors ~use ~loc s env
+  | Ldot(l, s) -> lookup_dot_value ~errors ~use ~loc l s env
+  | Lapply _ -> assert false
+
+let lookup_type_full ~errors ~use ~loc lid env =
+  match lid with
+  | Lident s -> lookup_ident_type ~errors ~use ~loc s env
+  | Ldot(l, s) -> lookup_dot_type ~errors ~use ~loc l s env
+  | Lapply _ -> assert false
+
+let lookup_type ~errors ~use ~loc lid env =
+  let (path, tda) = lookup_type_full ~errors ~use ~loc lid env in
+  path, tda.tda_declaration
+
+let lookup_modtype ~errors ~use ~loc lid env =
+  match lid with
+  | Lident s -> lookup_ident_modtype ~errors ~use ~loc s env
+  | Ldot(l, s) -> lookup_dot_modtype ~errors ~use ~loc l s env
+  | Lapply _ -> assert false
+
+let lookup_class ~errors ~use ~loc lid env =
+  match lid with
+  | Lident s -> lookup_ident_class ~errors ~use ~loc s env
+  | Ldot(l, s) -> lookup_dot_class ~errors ~use ~loc l s env
+  | Lapply _ -> assert false
+
+let lookup_cltype ~errors ~use ~loc lid env =
+  match lid with
+  | Lident s -> lookup_ident_cltype ~errors ~use ~loc s env
+  | Ldot(l, s) -> lookup_dot_cltype ~errors ~use ~loc l s env
+  | Lapply _ -> assert false
+
+let lookup_all_labels ~errors ~use ~loc lid env =
+  match lid with
+  | Lident s -> lookup_all_ident_labels ~errors ~use ~loc s env
+  | Ldot(l, s) -> lookup_all_dot_labels ~errors ~use ~loc l s env
+  | Lapply _ -> assert false
+
+let lookup_label ~errors ~use ~loc lid env =
+  match lookup_all_labels ~errors ~use ~loc lid env with
+  | [] -> assert false
+  | (desc, use) :: _ -> use (); desc
+
+let lookup_all_labels_from_type ~use ~loc ty_path env =
+  match find_type_descrs ty_path env with
+  | exception Not_found -> []
+  | (_, lbls) ->
+      List.map
+        (fun lbl ->
+           let use_fun () = use_label ~use ~loc env lbl in
+           (lbl, use_fun))
+        lbls
+
+let lookup_all_constructors ~errors ~use ~loc usage lid env =
+  match lid with
+  | Lident s -> lookup_all_ident_constructors ~errors ~use ~loc usage s env
+  | Ldot(l, s) -> lookup_all_dot_constructors ~errors ~use ~loc usage l s env
+  | Lapply _ -> assert false
+
+let lookup_constructor ~errors ~use ~loc usage lid env =
+  match lookup_all_constructors ~errors ~use ~loc usage lid env with
+  | [] -> assert false
+  | (desc, use) :: _ -> use (); desc
+
+let lookup_all_constructors_from_type ~use ~loc usage ty_path env =
+  match find_type_descrs ty_path env with
+  | exception Not_found -> []
+  | (cstrs, _) ->
+      List.map
+        (fun cstr ->
+           let use_fun () =
+             use_constructor_desc ~use ~loc usage env cstr
+           in
+           (cstr, use_fun))
+        cstrs
+
+(* Lookup functions that do not mark the item as used or
+   warn if it has alerts, and raise [Not_found] rather
+   than report errors *)
+
+let find_module_by_name lid env =
+  let loc = Location.(in_file !input_name) in
+  lookup_module ~errors:false ~use:false ~loc lid env
+
+let find_value_by_name lid env =
+  let loc = Location.(in_file !input_name) in
+  lookup_value ~errors:false ~use:false ~loc lid env
+
+let find_type_by_name lid env =
+  let loc = Location.(in_file !input_name) in
+  lookup_type ~errors:false ~use:false ~loc lid env
+
+let find_modtype_by_name lid env =
+  let loc = Location.(in_file !input_name) in
+  lookup_modtype ~errors:false ~use:false ~loc lid env
+
+let find_class_by_name lid env =
+  let loc = Location.(in_file !input_name) in
+  lookup_class ~errors:false ~use:false ~loc lid env
+
+let find_cltype_by_name lid env =
+  let loc = Location.(in_file !input_name) in
+  lookup_cltype ~errors:false ~use:false ~loc lid env
+
+let find_constructor_by_name lid env =
+  let loc = Location.(in_file !input_name) in
+  lookup_constructor ~errors:false ~use:false ~loc Positive lid env
+
+let find_label_by_name lid env =
+  let loc = Location.(in_file !input_name) in
+  lookup_label ~errors:false ~use:false ~loc lid env
+
+(* Ordinary lookup functions *)
+
+let lookup_module_path ?(use=true) ~loc ~load lid env =
+  lookup_module_path ~errors:true ~use ~loc ~load lid env
+
+let lookup_module ?(use=true) ~loc lid env =
+  lookup_module ~errors:true ~use ~loc lid env
+
+let lookup_value ?(use=true) ~loc lid env =
+  check_value_name (Longident.last lid) loc;
+  lookup_value ~errors:true ~use ~loc lid env
+
+let lookup_type ?(use=true) ~loc lid env =
+  lookup_type ~errors:true ~use ~loc lid env
+
+let lookup_modtype ?(use=true) ~loc lid env =
+  lookup_modtype ~errors:true ~use ~loc lid env
+
+let lookup_class ?(use=true) ~loc lid env =
+  lookup_class ~errors:true ~use ~loc lid env
+
+let lookup_cltype ?(use=true) ~loc lid env =
+  lookup_cltype ~errors:true ~use ~loc lid env
+
+let lookup_all_constructors ?(use=true) ~loc usage lid env =
+  match lookup_all_constructors ~errors:true ~use ~loc usage lid env with
+  | exception Error(Lookup_error(loc', env', err)) ->
+      (Error(loc', env', err) : _ result)
+  | cstrs -> Ok cstrs
+
+let lookup_constructor ?(use=true) ~loc lid env =
+  lookup_constructor ~errors:true ~use ~loc lid env
+
+let lookup_all_constructors_from_type ?(use=true) ~loc usage ty_path env =
+  lookup_all_constructors_from_type ~use ~loc usage ty_path env
+
+let lookup_all_labels ?(use=true) ~loc lid env =
+  match lookup_all_labels ~errors:true ~use ~loc lid env with
+  | exception Error(Lookup_error(loc', env', err)) ->
+      (Error(loc', env', err) : _ result)
+  | lbls -> Ok lbls
+
+let lookup_label ?(use=true) ~loc lid env =
+  lookup_label ~errors:true ~use ~loc lid env
+
+let lookup_all_labels_from_type ?(use=true) ~loc ty_path env =
+  lookup_all_labels_from_type ~use ~loc ty_path env
+
+let lookup_instance_variable ?(use=true) ~loc name env =
+  match IdTbl.find_name wrap_value ~mark:use name env.values with
+  | (path, Val_bound vda) -> begin
+      let desc = vda.vda_description in
+      match desc.val_kind with
+      | Val_ivar(mut, cl_num) ->
+          use_value ~use ~loc path vda;
+          path, mut, cl_num, desc.val_type
+      | _ ->
+          lookup_error loc env (Not_an_instance_variable name)
+    end
+  | (_, Val_unbound Val_unbound_instance_variable) ->
+      lookup_error loc env (Masked_instance_variable (Lident name))
+  | (_, Val_unbound Val_unbound_self) ->
+      lookup_error loc env (Not_an_instance_variable name)
+  | (_, Val_unbound Val_unbound_ancestor) ->
+      lookup_error loc env (Not_an_instance_variable name)
+  | (_, Val_unbound Val_unbound_ghost_recursive _) ->
+      lookup_error loc env (Unbound_instance_variable name)
+  | exception Not_found ->
+      lookup_error loc env (Unbound_instance_variable name)
+
+(* Checking if a name is bound *)
+
+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
+      else begin
+        match find_pers_mod name with
+        | _ -> true
+        | exception Not_found -> false
+      end
+
+let bound wrap proj name env =
+  match IdTbl.find_name wrap ~mark:false name (proj env) with
+  | _ -> true
+  | exception Not_found -> false
+
+let bound_value name env =
+  bound wrap_value (fun env -> env.values) name env
+
+let bound_type name env =
+  bound wrap_identity (fun env -> env.types) name env
+
+let bound_modtype name env =
+  bound wrap_identity (fun env -> env.modtypes) name env
+
+let bound_class name env =
+  bound wrap_identity (fun env -> env.classes) name env
+
+let bound_cltype name env =
+  bound wrap_identity (fun env -> env.cltypes) name env
+
+(* Folding on environments *)
+
+let find_all wrap proj1 proj2 f lid env acc =
+  match lid with
+  | None ->
+      IdTbl.fold_name wrap
+        (fun name (p, data) acc -> f name p data acc)
+        (proj1 env) acc
+  | Some l ->
+      let p, desc =
+        lookup_module_components
+          ~errors:false ~use:false ~loc:Location.none l env
+      in
+      begin match get_components desc with
+      | Structure_comps c ->
+          NameMap.fold
+            (fun s data acc -> f s (Pdot (p, s)) (wrap data) acc)
+            (proj2 c) acc
+      | Functor_comps _ ->
+          acc
+      end
+
+let find_all_simple_list proj1 proj2 f lid env acc =
+  match lid with
+  | None ->
+      TycompTbl.fold_name
+        (fun data acc -> f data acc)
+        (proj1 env) acc
+  | Some l ->
+      let (_p, desc) =
+        lookup_module_components
+          ~errors:false ~use:false ~loc:Location.none l env
+      in
+      begin match get_components desc with
+      | Structure_comps c ->
+          NameMap.fold
+            (fun _s comps acc ->
+               match comps with
+               | [] -> acc
+               | data :: _ -> f data acc)
+            (proj2 c) acc
+      | Functor_comps _ ->
+          acc
+      end
+
+let fold_modules f lid env acc =
+  match lid with
+  | None ->
+      IdTbl.fold_name wrap_module
+        (fun name (p, entry) acc ->
+           match entry with
+           | Mod_unbound _ -> acc
+           | Mod_local mda ->
+               let md =
+                 EnvLazy.force subst_modtype_maker mda.mda_declaration
+               in
+               f name p md acc
+           | Mod_persistent ->
+               match Persistent_env.find_in_cache persistent_env name with
+               | None -> acc
+               | Some mda ->
+                   let md =
+                     EnvLazy.force subst_modtype_maker mda.mda_declaration
+                   in
+                   f name p md acc)
+        env.modules
+        acc
+  | Some l ->
+      let p, desc =
+        lookup_module_components
+          ~errors:false ~use:false ~loc:Location.none l env
+      in
+      begin match get_components desc with
+      | Structure_comps c ->
+          NameMap.fold
+            (fun s mda acc ->
+               let md =
+                 EnvLazy.force subst_modtype_maker mda.mda_declaration
+               in
+               f s (Pdot (p, s)) md acc)
+            c.comp_modules
+            acc
+      | Functor_comps _ ->
+          acc
+      end
+
+let fold_values f =
+  find_all wrap_value (fun env -> env.values) (fun sc -> sc.comp_values)
+    (fun k p ve acc ->
+       match ve with
+       | Val_unbound _ -> acc
+       | Val_bound vda -> f k p vda.vda_description acc)
+and fold_constructors f =
+  find_all_simple_list (fun env -> env.constrs) (fun sc -> sc.comp_constrs)
+    (fun cda acc -> f cda.cda_description acc)
+and fold_labels f =
+  find_all_simple_list (fun env -> env.labels) (fun sc -> sc.comp_labels) f
+and fold_types f =
+  find_all wrap_identity
+    (fun env -> env.types) (fun sc -> sc.comp_types)
+    (fun k p tda acc -> f k p tda.tda_declaration acc)
+and fold_modtypes f =
+  find_all wrap_identity
+    (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes) f
+and fold_classes f =
+  find_all wrap_identity (fun env -> env.classes) (fun sc -> sc.comp_classes)
+    (fun k p clda acc -> f k p clda.clda_declaration acc)
+and fold_cltypes f =
+  find_all wrap_identity
+    (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes) f
+
+let filter_non_loaded_persistent f env =
+  let to_remove =
+    IdTbl.fold_name wrap_module
+      (fun name (_, entry) acc ->
+         match entry with
+         | Mod_local _ -> acc
+         | Mod_unbound _ -> acc
+         | Mod_persistent ->
+             match Persistent_env.find_in_cache persistent_env name with
+             | Some _ -> acc
+             | None ->
+                 if f (Ident.create_persistent name) then
+                   acc
+                 else
+                   String.Set.add name acc)
+      env.modules
+      String.Set.empty
+  in
+  let remove_ids tbl ids =
+    String.Set.fold
+      (fun name tbl -> IdTbl.remove (Ident.create_persistent name) tbl)
+      ids
+      tbl
+  in
+  let rec filter_summary summary ids =
+    if String.Set.is_empty ids then
+      summary
+    else
+      match summary with
+      | Env_empty -> summary
+      | Env_value (s, id, vd) ->
+          Env_value (filter_summary s ids, id, vd)
+      | Env_type (s, id, td) ->
+          Env_type (filter_summary s ids, id, td)
+      | Env_extension (s, id, ec) ->
+          Env_extension (filter_summary s ids, id, ec)
+      | Env_module (s, id, mp, md) ->
+          Env_module (filter_summary s ids, id, mp, md)
+      | Env_modtype (s, id, md) ->
+          Env_modtype (filter_summary s ids, id, md)
+      | Env_class (s, id, cd) ->
+          Env_class (filter_summary s ids, id, cd)
+      | Env_cltype (s, id, ctd) ->
+          Env_cltype (filter_summary s ids, id, ctd)
+      | Env_open (s, p) ->
+          Env_open (filter_summary s ids, p)
+      | Env_functor_arg (s, id) ->
+          Env_functor_arg (filter_summary s ids, id)
+      | Env_constraints (s, cstrs) ->
+          Env_constraints (filter_summary s ids, cstrs)
+      | Env_copy_types s ->
+          Env_copy_types (filter_summary s ids)
+      | Env_persistent (s, id) ->
+          if String.Set.mem (Ident.name id) ids then
+            filter_summary s (String.Set.remove (Ident.name id) ids)
+          else
+            Env_persistent (filter_summary s ids, id)
+      | Env_value_unbound (s, n, r) ->
+          Env_value_unbound (filter_summary s ids, n, r)
+      | Env_module_unbound (s, n, r) ->
+          Env_module_unbound (filter_summary s ids, n, r)
+  in
+  { env with
+    modules = remove_ids env.modules to_remove;
+    summary = filter_summary env.summary to_remove;
+  }
+
+(* Return the environment summary *)
+
+let summary env =
+  if Path.Map.is_empty env.local_constraints then env.summary
+  else Env_constraints (env.summary, env.local_constraints)
+
+let last_env = ref empty
+let last_reduced_env = ref empty
+
+let keep_only_summary env =
+  if !last_env == env then !last_reduced_env
+  else begin
+    let new_env =
+      {
+       empty with
+       summary = env.summary;
+       local_constraints = env.local_constraints;
+       flags = env.flags;
+      }
+    in
+    last_env := env;
+    last_reduced_env := new_env;
+    new_env
+  end
+
+
+let env_of_only_summary env_from_summary env =
+  let new_env = env_from_summary env.summary Subst.identity in
+  { new_env with
+    local_constraints = env.local_constraints;
+    flags = env.flags;
+  }
+
+(* Error report *)
+
+open Format
+
+(* 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 spellcheck ppf extract env lid =
+  let choices ~path name = Misc.spellcheck (extract path env) name in
+  match lid with
+    | Longident.Lapply _ -> ()
+    | Longident.Lident s ->
+       Misc.did_you_mean ppf (fun () -> choices ~path:None s)
+    | Longident.Ldot (r, s) ->
+       Misc.did_you_mean ppf (fun () -> choices ~path:(Some r) s)
+
+let spellcheck_name ppf extract env name =
+  Misc.did_you_mean ppf
+    (fun () -> Misc.spellcheck (extract env) name)
+
+let extract_values path env =
+  fold_values (fun name _ _ acc -> name :: acc) path env []
+let extract_types path env =
+  fold_types (fun name _ _ acc -> name :: acc) path env []
+let extract_modules path env =
+  fold_modules (fun name _ _ acc -> name :: acc) path env []
+let extract_constructors path env =
+  fold_constructors (fun desc acc -> desc.cstr_name :: acc) path env []
+let extract_labels path env =
+  fold_labels (fun desc acc -> desc.lbl_name :: acc) path env []
+let extract_classes path env =
+  fold_classes (fun name _ _ acc -> name :: acc) path env []
+let extract_modtypes path env =
+  fold_modtypes (fun name _ _ acc -> name :: acc) path env []
+let extract_cltypes path env =
+  fold_cltypes (fun name _ _ acc -> name :: acc) path env []
+let extract_instance_variables env =
+  fold_values
+    (fun name _ descr acc ->
+       match descr.val_kind with
+       | Val_ivar _ -> name :: acc
+       | _ -> acc) None env []
+
+let report_lookup_error _loc env ppf = function
+  | Unbound_value(lid, hint) -> begin
+      fprintf ppf "Unbound value %a" !print_longident lid;
+      spellcheck ppf extract_values env lid;
+      match hint with
+      | No_hint -> ()
+      | Missing_rec def_loc ->
+          let (_, line, _) =
+            Location.get_pos_info def_loc.Location.loc_start
+          in
+          fprintf ppf
+            "@.@[%s@ %s %i@]"
+            "Hint: If this is a recursive definition,"
+            "you should add the 'rec' keyword on line"
+            line
+    end
+  | Unbound_type lid ->
+      fprintf ppf "Unbound type constructor %a" !print_longident lid;
+      spellcheck ppf extract_types env lid;
+  | Unbound_module lid ->
+      fprintf ppf "Unbound module %a" !print_longident lid;
+      spellcheck ppf extract_modules env lid;
+  | Unbound_constructor lid ->
+      fprintf ppf "Unbound constructor %a" !print_longident lid;
+      spellcheck ppf extract_constructors env lid;
+  | Unbound_label lid ->
+      fprintf ppf "Unbound record field %a" !print_longident lid;
+      spellcheck ppf extract_labels env lid;
+  | Unbound_class lid ->
+      fprintf ppf "Unbound class %a" !print_longident lid;
+      spellcheck ppf extract_classes env lid;
+  | Unbound_modtype lid ->
+      fprintf ppf "Unbound module type %a" !print_longident lid;
+      spellcheck ppf extract_modtypes env lid;
+  | Unbound_cltype lid ->
+      fprintf ppf "Unbound class type %a" !print_longident lid;
+      spellcheck ppf extract_cltypes env lid;
+  | Unbound_instance_variable s ->
+      fprintf ppf "Unbound instance variable %s" s;
+      spellcheck_name ppf extract_instance_variables env s;
+  | Not_an_instance_variable s ->
+      fprintf ppf "The value %s is not an instance variable" s;
+      spellcheck_name ppf extract_instance_variables env s;
+  | Masked_instance_variable lid ->
+      fprintf ppf
+        "The instance variable %a@ \
+         cannot be accessed from the definition of another instance variable"
+        !print_longident lid
+  | Masked_self_variable lid ->
+      fprintf ppf
+        "The self variable %a@ \
+         cannot be accessed from the definition of an instance variable"
+        !print_longident lid
+  | Masked_ancestor_variable lid ->
+      fprintf ppf
+        "The ancestor variable %a@ \
+         cannot be accessed from the definition of an instance variable"
+        !print_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@]"
+        !print_longident lid
+  | Abstract_used_as_functor lid ->
+      fprintf ppf "@[The module %a is abstract, it cannot be applied@]"
+        !print_longident lid
+  | Functor_used_as_structure lid ->
+      fprintf ppf "@[The module %a is a functor, \
+                   it cannot have any components@]" !print_longident lid
+  | Abstract_used_as_structure lid ->
+      fprintf ppf "@[The module %a is abstract, \
+                   it cannot have any components@]" !print_longident lid
+  | Generative_used_as_applicative lid ->
+      fprintf ppf "@[The functor %a is generative,@ it@ cannot@ be@ \
+                   applied@ in@ type@ expressions@]" !print_longident lid
+  | Cannot_scrape_alias(lid, p) ->
+      fprintf ppf
+        "The module %a is an alias for module %a, which is missing"
+        !print_longident lid !print_path p
+
+let report_error ppf = function
+  | Missing_module(_, path1, path2) ->
+      fprintf ppf "@[@[";
+      if Path.same path1 path2 then
+        fprintf ppf "Internal path@ %s@ is dangling." (Path.name path1)
+      else
+        fprintf ppf "Internal path@ %s@ expands to@ %s@ which is dangling."
+          (Path.name path1) (Path.name path2);
+      fprintf ppf "@]@ @[%s@ %s@ %s.@]@]"
+        "The compiled interface for module" (Ident.name (Path.head path2))
+        "was not found"
+  | Illegal_value_name(_loc, name) ->
+      fprintf ppf "'%s' is not a valid value identifier."
+        name
+  | Lookup_error(loc, t, err) -> report_lookup_error loc t ppf err
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err ->
+          let loc =
+            match err with
+            | Missing_module (loc, _, _)
+            | Illegal_value_name (loc, _)
+            | Lookup_error(loc, _, _) -> loc
+          in
+          let error_of_printer =
+            if loc = Location.none
+            then Location.error_of_printer_file
+            else Location.error_of_printer ~loc ?sub:None
+          in
+          Some (error_of_printer report_error err)
+      | _ ->
+          None
+    )
diff --git a/typing/env.mli b/typing/env.mli
new file mode 100644
index 00000000..e43a5efd
--- /dev/null
+++ b/typing/env.mli
@@ -0,0 +1,447 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Environment handling *)
+
+open Types
+open Misc
+
+type value_unbound_reason =
+  | Val_unbound_instance_variable
+  | Val_unbound_self
+  | Val_unbound_ancestor
+  | Val_unbound_ghost_recursive of Location.t
+
+type module_unbound_reason =
+  | Mod_unbound_illegal_recursion
+
+type summary =
+    Env_empty
+  | Env_value of summary * Ident.t * value_description
+  | Env_type of summary * Ident.t * type_declaration
+  | Env_extension of summary * Ident.t * extension_constructor
+  | Env_module of summary * Ident.t * module_presence * module_declaration
+  | Env_modtype of summary * Ident.t * modtype_declaration
+  | Env_class of summary * Ident.t * class_declaration
+  | Env_cltype of summary * Ident.t * class_type_declaration
+  | Env_open of summary * Path.t
+  (** The string set argument of [Env_open] represents a list of module names
+      to skip, i.e. that won't be imported in the toplevel namespace. *)
+  | Env_functor_arg of summary * Ident.t
+  | Env_constraints of summary * type_declaration Path.Map.t
+  | Env_copy_types of summary
+  | Env_persistent of summary * Ident.t
+  | Env_value_unbound of summary * string * value_unbound_reason
+  | Env_module_unbound of summary * string * module_unbound_reason
+
+type address =
+  | Aident of Ident.t
+  | Adot of address * int
+
+type t
+
+val empty: t
+val initial_safe_string: t
+val initial_unsafe_string: t
+val diff: t -> t -> Ident.t list
+val copy_local: from:t -> t -> t
+
+type type_descriptions =
+    constructor_description list * label_description list
+
+(* For short-paths *)
+type iter_cont
+val iter_types:
+    (Path.t -> Path.t * type_declaration -> unit) ->
+    t -> iter_cont
+val run_iter_cont: iter_cont list -> (Path.t * iter_cont) list
+val same_types: t -> t -> bool
+val used_persistent: unit -> Concr.t
+val find_shadowed_types: Path.t -> t -> Path.t list
+val without_cmis: ('a -> 'b) -> 'a -> 'b
+(* [without_cmis f arg] applies [f] to [arg], but does not
+   allow opening cmis during its execution *)
+
+(* Lookup by paths *)
+
+val find_value: Path.t -> t -> value_description
+val find_type: Path.t -> t -> type_declaration
+val find_type_descrs: Path.t -> t -> type_descriptions
+val find_module: Path.t -> t -> module_declaration
+val find_modtype: Path.t -> t -> modtype_declaration
+val find_class: Path.t -> t -> class_declaration
+val find_cltype: Path.t -> t -> class_type_declaration
+
+val find_ident_constructor: Ident.t -> t -> constructor_description
+val find_ident_label: Ident.t -> t -> label_description
+
+val find_type_expansion:
+    Path.t -> t -> type_expr list * type_expr * int
+val find_type_expansion_opt:
+    Path.t -> t -> type_expr list * type_expr * int
+(* Find the manifest type information associated to a type for the sake
+   of the compiler's type-based optimisations. *)
+val find_modtype_expansion: Path.t -> t -> module_type
+
+val find_hash_type: Path.t -> t -> type_declaration
+(* Find the "#t" type given the path for "t" *)
+
+val find_value_address: Path.t -> t -> address
+val find_module_address: Path.t -> t -> address
+val find_class_address: Path.t -> t -> address
+val find_constructor_address: Path.t -> t -> address
+
+val add_functor_arg: Ident.t -> t -> t
+val is_functor_arg: Path.t -> t -> bool
+
+val normalize_module_path: Location.t option -> t -> Path.t -> Path.t
+(* Normalize the path to a concrete module.
+   If the option is None, allow returning dangling paths.
+   Otherwise raise a Missing_module error, and may add forgotten
+   head as required global. *)
+
+val normalize_type_path: Location.t option -> t -> Path.t -> Path.t
+(* Normalize the prefix part of the type path *)
+
+val normalize_path_prefix: Location.t option -> t -> Path.t -> Path.t
+(* Normalize the prefix part of other kinds of paths
+   (value/modtype/etc) *)
+
+val normalize_modtype_path: t -> Path.t -> Path.t
+(* Normalize a module type path *)
+
+val reset_required_globals: unit -> unit
+val get_required_globals: unit -> Ident.t list
+val add_required_global: Ident.t -> unit
+
+val has_local_constraints: t -> bool
+
+(* Mark definitions as used *)
+val mark_value_used: Uid.t -> unit
+val mark_module_used: Uid.t -> unit
+val mark_type_used: Uid.t -> unit
+
+type constructor_usage = Positive | Pattern | Privatize
+val mark_constructor_used:
+    constructor_usage -> constructor_declaration -> unit
+val mark_extension_used:
+    constructor_usage -> extension_constructor -> unit
+
+(* Lookup by long identifiers *)
+
+(* Lookup errors *)
+
+type unbound_value_hint =
+  | No_hint
+  | Missing_rec of Location.t
+
+type lookup_error =
+  | Unbound_value of Longident.t * unbound_value_hint
+  | Unbound_type of Longident.t
+  | Unbound_constructor of Longident.t
+  | Unbound_label of Longident.t
+  | Unbound_module of Longident.t
+  | Unbound_class of Longident.t
+  | Unbound_modtype of Longident.t
+  | Unbound_cltype of Longident.t
+  | Unbound_instance_variable of string
+  | Not_an_instance_variable of string
+  | Masked_instance_variable of Longident.t
+  | Masked_self_variable of Longident.t
+  | Masked_ancestor_variable of Longident.t
+  | Structure_used_as_functor of Longident.t
+  | Abstract_used_as_functor of Longident.t
+  | Functor_used_as_structure of Longident.t
+  | Abstract_used_as_structure of Longident.t
+  | Generative_used_as_applicative of Longident.t
+  | Illegal_reference_to_recursive_module
+  | Cannot_scrape_alias of Longident.t * Path.t
+
+val lookup_error: Location.t -> t -> lookup_error -> 'a
+
+(* The [lookup_foo] functions will emit proper error messages (by
+   raising [Error]) if the identifier cannot be found, whereas the
+   [find_foo_by_name] functions will raise [Not_found] instead.
+
+   The [~use] parameters of the [lookup_foo] functions control
+   whether this lookup should be counted as a use for usage
+   warnings and alerts.
+
+   [Longident.t]s in the program source should be looked up using
+   [lookup_foo ~use:true] exactly one time -- otherwise warnings may be
+   emitted the wrong number of times. *)
+
+val lookup_value:
+  ?use:bool -> loc:Location.t -> Longident.t -> t ->
+  Path.t * value_description
+val lookup_type:
+  ?use:bool -> loc:Location.t -> Longident.t -> t ->
+  Path.t * type_declaration
+val lookup_module:
+  ?use:bool -> loc:Location.t -> Longident.t -> t ->
+  Path.t * module_declaration
+val lookup_modtype:
+  ?use:bool -> loc:Location.t -> Longident.t -> t ->
+  Path.t * modtype_declaration
+val lookup_class:
+  ?use:bool -> loc:Location.t -> Longident.t -> t ->
+  Path.t * class_declaration
+val lookup_cltype:
+  ?use:bool -> loc:Location.t -> Longident.t -> t ->
+  Path.t * class_type_declaration
+
+val lookup_module_path:
+  ?use:bool -> loc:Location.t -> load:bool -> Longident.t -> t -> Path.t
+
+val lookup_constructor:
+  ?use:bool -> loc:Location.t -> constructor_usage -> Longident.t -> t ->
+  constructor_description
+val lookup_all_constructors:
+  ?use:bool -> loc:Location.t -> constructor_usage -> Longident.t -> t ->
+  ((constructor_description * (unit -> unit)) list,
+   Location.t * t * lookup_error) result
+val lookup_all_constructors_from_type:
+  ?use:bool -> loc:Location.t -> constructor_usage -> Path.t -> t ->
+  (constructor_description * (unit -> unit)) list
+
+val lookup_label:
+  ?use:bool -> loc:Location.t -> Longident.t -> t ->
+  label_description
+val lookup_all_labels:
+  ?use:bool -> loc:Location.t -> Longident.t -> t ->
+  ((label_description * (unit -> unit)) list,
+   Location.t * t * lookup_error) result
+val lookup_all_labels_from_type:
+  ?use:bool -> loc:Location.t -> Path.t -> t ->
+  (label_description * (unit -> unit)) list
+
+val lookup_instance_variable:
+  ?use:bool -> loc:Location.t -> string -> t ->
+  Path.t * Asttypes.mutable_flag * string * type_expr
+
+val find_value_by_name:
+  Longident.t -> t -> Path.t * value_description
+val find_type_by_name:
+  Longident.t -> t -> Path.t * type_declaration
+val find_module_by_name:
+  Longident.t -> t -> Path.t * module_declaration
+val find_modtype_by_name:
+  Longident.t -> t -> Path.t * modtype_declaration
+val find_class_by_name:
+  Longident.t -> t -> Path.t * class_declaration
+val find_cltype_by_name:
+  Longident.t -> t -> Path.t * class_type_declaration
+
+val find_constructor_by_name:
+  Longident.t -> t -> constructor_description
+val find_label_by_name:
+  Longident.t -> t -> label_description
+
+(* Check if a name is bound *)
+
+val bound_value: string -> t -> bool
+val bound_module: string -> t -> bool
+val bound_type: string -> t -> bool
+val bound_modtype: string -> t -> bool
+val bound_class: string -> t -> bool
+val bound_cltype: string -> t -> bool
+
+val make_copy_of_types: t -> (t -> t)
+
+(* Insertion by identifier *)
+
+val add_value:
+    ?check:(string -> Warnings.t) -> Ident.t -> value_description -> t -> t
+val add_type: check:bool -> Ident.t -> type_declaration -> t -> t
+val add_extension:
+  check:bool -> rebind:bool -> Ident.t -> extension_constructor -> t -> t
+val add_module:
+  ?arg:bool -> Ident.t -> module_presence -> module_type -> t -> t
+val add_module_declaration: ?arg:bool -> check:bool -> Ident.t ->
+  module_presence -> module_declaration -> t -> t
+val add_modtype: Ident.t -> modtype_declaration -> t -> t
+val add_class: Ident.t -> class_declaration -> t -> t
+val add_cltype: Ident.t -> class_type_declaration -> t -> t
+val add_local_type: Path.t -> type_declaration -> t -> t
+
+(* Insertion of persistent signatures *)
+
+(* [add_persistent_structure id env] is an environment such that
+   module [id] points to the persistent structure contained in the
+   external compilation unit with the same name.
+
+   The compilation unit itself is looked up in the load path when the
+   contents of the module is accessed. *)
+val add_persistent_structure : Ident.t -> t -> t
+
+(* Returns the set of persistent structures found in the given
+   directory. *)
+val persistent_structures_of_dir : Load_path.Dir.t -> Misc.Stdlib.String.Set.t
+
+(* [filter_non_loaded_persistent f env] removes all the persistent
+   structures that are not yet loaded and for which [f] returns
+   [false]. *)
+val filter_non_loaded_persistent : (Ident.t -> bool) -> t -> t
+
+(* Insertion of all fields of a signature. *)
+
+val add_item: signature_item -> t -> t
+val add_signature: signature -> t -> t
+
+(* Insertion of all fields of a signature, relative to the given path.
+   Used to implement open. Returns None if the path refers to a functor,
+   not a structure. *)
+val open_signature:
+    ?used_slot:bool ref ->
+    ?loc:Location.t -> ?toplevel:bool ->
+    Asttypes.override_flag -> Path.t ->
+    t -> (t, [`Not_found | `Functor]) result
+
+val open_pers_signature: string -> t -> (t, [`Not_found]) result
+
+(* Insertion by name *)
+
+val enter_value:
+    ?check:(string -> Warnings.t) ->
+    string -> value_description -> t -> Ident.t * t
+val enter_type: scope:int -> string -> type_declaration -> t -> Ident.t * t
+val enter_extension:
+  scope:int -> rebind:bool -> string ->
+  extension_constructor -> t -> Ident.t * t
+val enter_module:
+  scope:int -> ?arg:bool -> string -> module_presence ->
+  module_type -> t -> Ident.t * t
+val enter_module_declaration:
+  scope:int -> ?arg:bool -> string -> module_presence ->
+  module_declaration -> t -> Ident.t * t
+val enter_modtype:
+  scope:int -> string -> modtype_declaration -> t -> Ident.t * t
+val enter_class: scope:int -> string -> class_declaration -> t -> Ident.t * t
+val enter_cltype:
+  scope:int -> string -> class_type_declaration -> t -> Ident.t * t
+
+(* Same as [add_signature] but refreshes (new stamp) and rescopes bound idents
+   in the process. *)
+val enter_signature: scope:int -> signature -> t -> signature * t
+
+val enter_unbound_value : string -> value_unbound_reason -> t -> t
+
+val enter_unbound_module : string -> module_unbound_reason -> t -> t
+
+(* Initialize the cache of in-core module interfaces. *)
+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
+
+(* Read, save a signature to/from a file *)
+val read_signature: modname -> filepath -> signature
+        (* Arguments: module name, file name. Results: signature. *)
+val save_signature:
+  alerts:alerts -> signature -> modname -> filepath
+  -> Cmi_format.cmi_infos
+        (* Arguments: signature, module name, file name. *)
+val save_signature_with_imports:
+  alerts:alerts -> signature -> modname -> filepath -> crcs
+  -> Cmi_format.cmi_infos
+        (* Arguments: signature, module name, file name,
+           imported units with their CRCs. *)
+
+(* Return the CRC of the interface of the given compilation unit *)
+val crc_of_unit: modname -> Digest.t
+
+(* Return the set of compilation units imported, with their CRC *)
+val imports: unit -> crcs
+
+(* may raise Persistent_env.Consistbl.Inconsistency *)
+val import_crcs: source:string -> crcs -> unit
+
+(* [is_imported_opaque md] returns true if [md] is an opaque imported module *)
+val is_imported_opaque: modname -> bool
+
+(* [register_import_as_opaque md] registers [md] as an opaque imported module *)
+val register_import_as_opaque: modname -> unit
+
+(* Summaries -- compact representation of an environment, to be
+   exported in debugging information. *)
+
+val summary: t -> summary
+
+(* Return an equivalent environment where all fields have been reset,
+   except the summary. The initial environment can be rebuilt from the
+   summary, using Envaux.env_of_only_summary. *)
+
+val keep_only_summary : t -> t
+val env_of_only_summary : (summary -> Subst.t -> t) -> t -> t
+
+(* Error report *)
+
+type error =
+  | Missing_module of Location.t * Path.t * Path.t
+  | Illegal_value_name of Location.t * string
+  | Lookup_error of Location.t * t * lookup_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 in_signature: bool -> t -> t
+
+val is_in_signature: t -> bool
+
+val set_value_used_callback:
+    value_description -> (unit -> unit) -> unit
+val set_type_used_callback:
+    type_declaration -> ((unit -> unit) -> unit) -> unit
+
+(* Forward declaration to break mutual recursion with Includemod. *)
+val check_functor_application:
+      (errors:bool -> loc:Location.t -> t -> module_type ->
+         Path.t -> module_type -> Path.t -> unit) ref
+(* Forward declaration to break mutual recursion with Typemod. *)
+val check_well_formed_module:
+    (t -> Location.t -> string -> module_type -> unit) ref
+(* Forward declaration to break mutual recursion with Typecore. *)
+val add_delayed_check_forward: ((unit -> unit) -> unit) ref
+(* Forward declaration to break mutual recursion with Mtype. *)
+val strengthen:
+    (aliasable:bool -> t -> module_type -> Path.t -> module_type) ref
+(* 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
+
+
+(** Folds *)
+
+val fold_constructors:
+  (constructor_description -> 'a -> 'a) ->
+  Longident.t option -> t -> 'a -> 'a
+
+(** Utilities *)
+val scrape_alias: t -> module_type -> module_type
+val check_value_name: string -> Location.t -> unit
+
+val print_address : Format.formatter -> address -> unit
diff --git a/typing/envaux.ml b/typing/envaux.ml
new file mode 100644
index 00000000..a0bbbc26
--- /dev/null
+++ b/typing/envaux.ml
@@ -0,0 +1,115 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Env
+
+type error =
+    Module_not_found of Path.t
+
+exception Error of error
+
+let env_cache =
+  (Hashtbl.create 59 : ((Env.summary * Subst.t), Env.t) Hashtbl.t)
+
+let reset_cache () =
+  Hashtbl.clear env_cache;
+  Env.reset_cache()
+
+let rec env_from_summary sum subst =
+  try
+    Hashtbl.find env_cache (sum, subst)
+  with Not_found ->
+    let env =
+      match sum with
+        Env_empty ->
+          Env.empty
+      | Env_value(s, id, desc) ->
+          Env.add_value id (Subst.value_description subst desc)
+                        (env_from_summary s subst)
+      | Env_type(s, id, desc) ->
+          Env.add_type ~check:false id
+            (Subst.type_declaration subst desc)
+            (env_from_summary s subst)
+      | Env_extension(s, id, desc) ->
+          Env.add_extension ~check:false ~rebind:false id
+            (Subst.extension_constructor subst desc)
+            (env_from_summary s subst)
+      | Env_module(s, id, pres, desc) ->
+          Env.add_module_declaration ~check:false id pres
+            (Subst.module_declaration Keep subst desc)
+            (env_from_summary s subst)
+      | Env_modtype(s, id, desc) ->
+          Env.add_modtype id (Subst.modtype_declaration Keep subst desc)
+                          (env_from_summary s subst)
+      | Env_class(s, id, desc) ->
+          Env.add_class id (Subst.class_declaration subst desc)
+                        (env_from_summary s subst)
+      | Env_cltype (s, id, desc) ->
+          Env.add_cltype id (Subst.cltype_declaration subst desc)
+                         (env_from_summary s subst)
+      | Env_open(s, path) ->
+          let env = env_from_summary s subst in
+          let path' = Subst.module_path subst path in
+          begin match Env.open_signature Asttypes.Override path' env with
+          | Ok env -> env
+          | Error `Functor -> assert false
+          | Error `Not_found -> raise (Error (Module_not_found path'))
+          end
+      | Env_functor_arg(Env_module(s, id, pres, desc), id')
+            when Ident.same id id' ->
+          Env.add_module_declaration ~check:false
+            id pres (Subst.module_declaration Keep subst desc)
+            ~arg:true (env_from_summary s subst)
+      | Env_functor_arg _ -> assert false
+      | Env_constraints(s, map) ->
+          Path.Map.fold
+            (fun path info ->
+              Env.add_local_type (Subst.type_path subst path)
+                (Subst.type_declaration subst info))
+            map (env_from_summary s subst)
+      | Env_copy_types s ->
+          let env = env_from_summary s subst in
+          Env.make_copy_of_types env env
+      | Env_persistent (s, id) ->
+          let env = env_from_summary s subst in
+          Env.add_persistent_structure id env
+      | Env_value_unbound (s, str, reason) ->
+          let env = env_from_summary s subst in
+          Env.enter_unbound_value str reason env
+      | Env_module_unbound (s, str, reason) ->
+          let env = env_from_summary s subst in
+          Env.enter_unbound_module str reason env
+    in
+      Hashtbl.add env_cache (sum, subst) env;
+      env
+
+let env_of_only_summary env =
+  Env.env_of_only_summary env_from_summary env
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+  | Module_not_found p ->
+      fprintf ppf "@[Cannot find module %a@].@." Printtyp.path p
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )
diff --git a/typing/envaux.mli b/typing/envaux.mli
new file mode 100644
index 00000000..2869890a
--- /dev/null
+++ b/typing/envaux.mli
@@ -0,0 +1,36 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*           OCaml port by John Malecki and Xavier Leroy                  *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Format
+
+(* Convert environment summaries to environments *)
+
+val env_from_summary : Env.summary -> Subst.t -> Env.t
+
+(* Empty the environment caches. To be called when load_path changes. *)
+
+val reset_cache: unit -> unit
+
+val env_of_only_summary : Env.t -> Env.t
+
+(* Error report *)
+
+type error =
+    Module_not_found of Path.t
+
+exception Error of error
+
+val report_error: formatter -> error -> unit
diff --git a/typing/ident.ml b/typing/ident.ml
new file mode 100644
index 00000000..6296398b
--- /dev/null
+++ b/typing/ident.ml
@@ -0,0 +1,358 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let lowest_scope  = 0
+let highest_scope = 100000000
+
+type t =
+  | Local of { name: string; stamp: int }
+  | Scoped of { name: string; stamp: int; scope: int }
+  | Global of string
+  | Predef of { name: string; stamp: int }
+      (* the stamp is here only for fast comparison, but the name of
+         predefined identifiers is always unique. *)
+
+(* A stamp of 0 denotes a persistent identifier *)
+
+let currentstamp = ref 0
+let predefstamp = ref 0
+
+let create_scoped ~scope s =
+  incr currentstamp;
+  Scoped { name = s; stamp = !currentstamp; scope }
+
+let create_local s =
+  incr currentstamp;
+  Local { name = s; stamp = !currentstamp }
+
+let create_predef s =
+  incr predefstamp;
+  Predef { name = s; stamp = !predefstamp }
+
+let create_persistent s =
+  Global s
+
+let name = function
+  | Local { name; _ }
+  | Scoped { name; _ }
+  | Global name
+  | Predef { name; _ } -> name
+
+let rename = function
+  | Local { name; stamp = _ }
+  | Scoped { name; stamp = _; scope = _ } ->
+      incr currentstamp;
+      Local { name; stamp = !currentstamp }
+  | id ->
+      Misc.fatal_errorf "Ident.rename %s" (name id)
+
+let unique_name = function
+  | Local { name; stamp }
+  | Scoped { name; stamp } -> name ^ "_" ^ Int.to_string stamp
+  | Global name ->
+      (* we're adding a fake stamp, because someone could have named his unit
+         [Foo_123] and since we're using unique_name to produce symbol names,
+         we might clash with an ident [Local { "Foo"; 123 }]. *)
+      name ^ "_0"
+  | Predef { name; _ } ->
+      (* we know that none of the predef names (currently) finishes in
+         "_", and that their name is unique. *)
+      name
+
+let unique_toplevel_name = function
+  | Local { name; stamp }
+  | Scoped { name; stamp } -> name ^ "/" ^ Int.to_string stamp
+  | Global name
+  | Predef { name; _ } -> name
+
+let persistent = function
+  | Global _ -> true
+  | _ -> false
+
+let equal i1 i2 =
+  match i1, i2 with
+  | Local { name = name1; _ }, Local { name = name2; _ }
+  | Scoped { name = name1; _ }, Scoped { name = name2; _ }
+  | Global name1, Global name2 ->
+      name1 = name2
+  | Predef { stamp = s1; _ }, Predef { stamp = s2 } ->
+      (* if they don't have the same stamp, they don't have the same name *)
+      s1 = s2
+  | _ ->
+      false
+
+let same i1 i2 =
+  match i1, i2 with
+  | Local { stamp = s1; _ }, Local { stamp = s2; _ }
+  | Scoped { stamp = s1; _ }, Scoped { stamp = s2; _ }
+  | Predef { stamp = s1; _ }, Predef { stamp = s2 } ->
+      s1 = s2
+  | Global name1, Global name2 ->
+      name1 = name2
+  | _ ->
+      false
+
+let stamp = function
+  | Local { stamp; _ }
+  | Scoped { stamp; _ } -> stamp
+  | _ -> 0
+
+let scope = function
+  | Scoped { scope; _ } -> scope
+  | Local _ -> highest_scope
+  | Global _ | Predef _ -> lowest_scope
+
+let reinit_level = ref (-1)
+
+let reinit () =
+  if !reinit_level < 0
+  then reinit_level := !currentstamp
+  else currentstamp := !reinit_level
+
+let global = function
+  | Local _
+  | Scoped _ -> false
+  | Global _
+  | Predef _ -> true
+
+let is_predef = function
+  | Predef _ -> true
+  | _ -> false
+
+let print ~with_scope ppf =
+  let open Format 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 "")
+  | Local { name; stamp = n } ->
+      fprintf ppf "%s%s" name
+        (if !Clflags.unique_ids then sprintf "/%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 "")
+
+let print_with_scope ppf id = print ~with_scope:true ppf id
+
+let print ppf id = print ~with_scope:false ppf id
+
+type 'a tbl =
+    Empty
+  | Node of 'a tbl * 'a data * 'a tbl * int
+
+and 'a data =
+  { ident: t;
+    data: 'a;
+    previous: 'a data option }
+
+let empty = Empty
+
+(* Inline expansion of height for better speed
+ * let height = function
+ *     Empty -> 0
+ *   | Node(_,_,_,h) -> h
+ *)
+
+let mknode l d r =
+  let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h
+  and hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
+  Node(l, d, r, (if hl >= hr then hl + 1 else hr + 1))
+
+let balance l d r =
+  let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h
+  and hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
+  if hl > hr + 1 then
+    match l with
+    | Node (ll, ld, lr, _)
+      when (match ll with Empty -> 0 | Node(_,_,_,h) -> h) >=
+           (match lr with Empty -> 0 | Node(_,_,_,h) -> h) ->
+        mknode ll ld (mknode lr d r)
+    | Node (ll, ld, Node(lrl, lrd, lrr, _), _) ->
+        mknode (mknode ll ld lrl) lrd (mknode lrr d r)
+    | _ -> assert false
+  else if hr > hl + 1 then
+    match r with
+    | Node (rl, rd, rr, _)
+      when (match rr with Empty -> 0 | Node(_,_,_,h) -> h) >=
+           (match rl with Empty -> 0 | Node(_,_,_,h) -> h) ->
+        mknode (mknode l d rl) rd rr
+    | Node (Node (rll, rld, rlr, _), rd, rr, _) ->
+        mknode (mknode l d rll) rld (mknode rlr rd rr)
+    | _ -> assert false
+  else
+    mknode l d r
+
+let rec add id data = function
+    Empty ->
+      Node(Empty, {ident = id; data = data; previous = None}, Empty, 1)
+  | Node(l, k, r, h) ->
+      let c = String.compare (name id) (name k.ident) in
+      if c = 0 then
+        Node(l, {ident = id; data = data; previous = Some k}, r, h)
+      else if c < 0 then
+        balance (add id data l) k r
+      else
+        balance l k (add id data r)
+
+let rec min_binding = function
+    Empty -> raise Not_found
+  | Node (Empty, d, _, _) -> d
+  | Node (l, _, _, _) -> min_binding l
+
+let rec remove_min_binding = function
+    Empty -> invalid_arg "Map.remove_min_elt"
+  | Node (Empty, _, r, _) -> r
+  | Node (l, d, r, _) -> balance (remove_min_binding l) d r
+
+let merge t1 t2 =
+  match (t1, t2) with
+    (Empty, t) -> t
+  | (t, Empty) -> t
+  | (_, _) ->
+      let d = min_binding t2 in
+      balance t1 d (remove_min_binding t2)
+
+let rec remove id = function
+    Empty ->
+      Empty
+  | (Node (l, k, r, h) as m) ->
+      let c = String.compare (name id) (name k.ident) in
+      if c = 0 then
+        match k.previous with
+        | None -> merge l r
+        | Some k -> Node (l, k, r, h)
+      else if c < 0 then
+        let ll = remove id l in if l == ll then m else balance ll k r
+      else
+        let rr = remove id r in if r == rr then m else balance l k rr
+
+let rec find_previous id = function
+    None ->
+      raise Not_found
+  | Some k ->
+      if same id k.ident then k.data else find_previous id k.previous
+
+let rec find_same id = function
+    Empty ->
+      raise Not_found
+  | Node(l, k, r, _) ->
+      let c = String.compare (name id) (name k.ident) in
+      if c = 0 then
+        if same id k.ident
+        then k.data
+        else find_previous id k.previous
+      else
+        find_same id (if c < 0 then l else r)
+
+let rec find_name n = function
+    Empty ->
+      raise Not_found
+  | Node(l, k, r, _) ->
+      let c = String.compare n (name k.ident) in
+      if c = 0 then
+        k.ident, k.data
+      else
+        find_name n (if c < 0 then l else r)
+
+let rec get_all = function
+  | None -> []
+  | Some k -> (k.ident, k.data) :: get_all k.previous
+
+let rec find_all n = function
+    Empty ->
+      []
+  | Node(l, k, r, _) ->
+      let c = String.compare n (name k.ident) in
+      if c = 0 then
+        (k.ident, k.data) :: get_all k.previous
+      else
+        find_all n (if c < 0 then l else r)
+
+let rec fold_aux f stack accu = function
+    Empty ->
+      begin match stack with
+        [] -> accu
+      | a :: l -> fold_aux f l accu a
+      end
+  | Node(l, k, r, _) ->
+      fold_aux f (l :: stack) (f k accu) r
+
+let fold_name f tbl accu = fold_aux (fun k -> f k.ident k.data) [] accu tbl
+
+let rec fold_data f d accu =
+  match d with
+    None -> accu
+  | Some k -> f k.ident k.data (fold_data f k.previous accu)
+
+let fold_all f tbl accu =
+  fold_aux (fun k -> fold_data f (Some k)) [] accu tbl
+
+(* let keys tbl = fold_name (fun k _ accu -> k::accu) tbl [] *)
+
+let rec iter f = function
+    Empty -> ()
+  | Node(l, k, r, _) ->
+      iter f l; f k.ident k.data; iter f r
+
+(* Idents for sharing keys *)
+
+(* They should be 'totally fresh' -> neg numbers *)
+let key_name = ""
+
+let make_key_generator () =
+  let c = ref 1 in
+  function
+  | Local _
+  | Scoped _ ->
+      let stamp = !c in
+      decr c ;
+      Local { name = key_name; stamp = stamp }
+  | global_id ->
+      Misc.fatal_errorf "Ident.make_key_generator () %s" (name global_id)
+
+let compare x y =
+  match x, y with
+  | Local x, Local y ->
+      let c = x.stamp - y.stamp in
+      if c <> 0 then c
+      else compare x.name y.name
+  | Local _, _ -> 1
+  | _, Local _ -> (-1)
+  | Scoped x, Scoped y ->
+      let c = x.stamp - y.stamp in
+      if c <> 0 then c
+      else compare x.name y.name
+  | Scoped _, _ -> 1
+  | _, Scoped _ -> (-1)
+  | Global x, Global y -> compare x y
+  | Global _, _ -> 1
+  | _, Global _ -> (-1)
+  | Predef { stamp = s1; _ }, Predef { stamp = s2; _ } -> compare s1 s2
+
+let output oc id = output_string oc (unique_name id)
+let hash i = (Char.code (name i).[0]) lxor (stamp i)
+
+let original_equal = equal
+include Identifiable.Make (struct
+  type nonrec t = t
+  let compare = compare
+  let output = output
+  let print = print
+  let hash = hash
+  let equal = same
+end)
+let equal = original_equal
diff --git a/typing/ident.mli b/typing/ident.mli
new file mode 100644
index 00000000..65ddb9fc
--- /dev/null
+++ b/typing/ident.mli
@@ -0,0 +1,80 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Identifiers (unique names) *)
+
+type t
+
+include Identifiable.S with type t := t
+(* Notes:
+   - [equal] compares identifiers by name
+   - [compare x y] is 0 if [same x y] is true.
+   - [compare] compares identifiers by binding location
+*)
+
+val print_with_scope : Format.formatter -> t -> unit
+        (** Same as {!print} except that it will also add a "[n]" suffix
+            if the scope of the argument is [n]. *)
+
+
+val create_scoped: scope:int -> string -> t
+val create_local: string -> t
+val create_persistent: string -> t
+val create_predef: string -> t
+
+val rename: t -> t
+        (** Creates an identifier with the same name as the input, a fresh
+            stamp, and no scope.
+            @raises [Fatal_error] if called on a persistent / predef ident. *)
+
+val name: t -> string
+val unique_name: t -> string
+val unique_toplevel_name: t -> string
+val persistent: t -> bool
+val same: t -> t -> bool
+        (** Compare identifiers by binding location.
+            Two identifiers are the same either if they are both
+            non-persistent and have been created by the same call to
+            [create_*], or if they are both persistent and have the same
+            name. *)
+
+val compare: t -> t -> int
+
+val global: t -> bool
+val is_predef: t -> bool
+
+val scope: t -> int
+
+val lowest_scope : int
+val highest_scope: int
+
+val reinit: unit -> unit
+
+type 'a tbl
+        (* Association tables from identifiers to type 'a. *)
+
+val empty: 'a tbl
+val add: t -> 'a -> 'a tbl -> 'a tbl
+val find_same: t -> 'a tbl -> 'a
+val find_name: string -> 'a tbl -> t * 'a
+val find_all: string -> 'a tbl -> (t * 'a) list
+val fold_name: (t -> 'a -> 'b -> 'b) -> 'a tbl -> 'b -> 'b
+val fold_all: (t -> 'a -> 'b -> 'b) -> 'a tbl -> 'b -> 'b
+val iter: (t -> 'a -> unit) -> 'a tbl -> unit
+val remove: t -> 'a tbl -> 'a tbl
+
+(* Idents for sharing keys *)
+
+val make_key_generator : unit -> (t -> t)
diff --git a/typing/includeclass.ml b/typing/includeclass.ml
new file mode 100644
index 00000000..483088d6
--- /dev/null
+++ b/typing/includeclass.ml
@@ -0,0 +1,116 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Inclusion checks for the class language *)
+
+open Types
+
+let class_types env cty1 cty2 =
+  Ctype.match_class_types env cty1 cty2
+
+let class_type_declarations ~loc env cty1 cty2 =
+  Builtin_attributes.check_alerts_inclusion
+    ~def:cty1.clty_loc
+    ~use:cty2.clty_loc
+    loc
+    cty1.clty_attributes cty2.clty_attributes
+    (Path.last cty1.clty_path);
+  Ctype.match_class_declarations env
+    cty1.clty_params cty1.clty_type
+    cty2.clty_params cty2.clty_type
+
+let class_declarations env cty1 cty2 =
+  match cty1.cty_new, cty2.cty_new with
+    None, Some _ ->
+      [Ctype.CM_Virtual_class]
+  | _ ->
+      Ctype.match_class_declarations env
+        cty1.cty_params cty1.cty_type
+        cty2.cty_params cty2.cty_type
+
+open Format
+open Ctype
+
+(*
+let rec hide_params = function
+    Tcty_arrow ("*", _, cty) -> hide_params cty
+  | cty -> cty
+*)
+
+let include_err ppf =
+  function
+  | CM_Virtual_class ->
+      fprintf ppf "A class cannot be changed from virtual to concrete"
+  | CM_Parameter_arity_mismatch _ ->
+      fprintf ppf
+        "The classes do not have the same number of type parameters"
+  | CM_Type_parameter_mismatch (env, trace) ->
+      Printtyp.report_unification_error ppf env trace
+        (function ppf ->
+          fprintf ppf "A type parameter has type")
+        (function ppf ->
+          fprintf ppf "but is expected to have type")
+  | CM_Class_type_mismatch (env, cty1, cty2) ->
+      Printtyp.wrap_printing_env ~error:true env (fun () ->
+        fprintf ppf
+          "@[The class type@;<1 2>%a@ %s@;<1 2>%a@]"
+          Printtyp.class_type cty1
+          "is not matched by the class type"
+          Printtyp.class_type cty2)
+  | CM_Parameter_mismatch (env, trace) ->
+      Printtyp.report_unification_error ppf env trace
+        (function ppf ->
+          fprintf ppf "A parameter has type")
+        (function ppf ->
+          fprintf ppf "but is expected to have type")
+  | CM_Val_type_mismatch (lab, env, trace) ->
+      Printtyp.report_unification_error ppf env trace
+        (function ppf ->
+          fprintf ppf "The instance variable %s@ has type" lab)
+        (function ppf ->
+          fprintf ppf "but is expected to have type")
+  | CM_Meth_type_mismatch (lab, env, trace) ->
+      Printtyp.report_unification_error ppf env trace
+        (function ppf ->
+          fprintf ppf "The method %s@ has type" lab)
+        (function ppf ->
+          fprintf ppf "but is expected to have type")
+  | CM_Non_mutable_value lab ->
+      fprintf ppf
+       "@[The non-mutable instance variable %s cannot become mutable@]" lab
+  | CM_Non_concrete_value lab ->
+      fprintf ppf
+       "@[The virtual instance variable %s cannot become concrete@]" lab
+  | CM_Missing_value lab ->
+      fprintf ppf "@[The first class type has no instance variable %s@]" lab
+  | CM_Missing_method lab ->
+      fprintf ppf "@[The first class type has no method %s@]" lab
+  | CM_Hide_public lab ->
+     fprintf ppf "@[The public method %s cannot be hidden@]" lab
+  | CM_Hide_virtual (k, lab) ->
+      fprintf ppf "@[The virtual %s %s cannot be hidden@]" k lab
+  | CM_Public_method lab ->
+      fprintf ppf "@[The public method %s cannot become private@]" lab
+  | CM_Virtual_method lab ->
+      fprintf ppf "@[The virtual method %s cannot become concrete@]" lab
+  | CM_Private_method lab ->
+      fprintf ppf "@[The private method %s cannot become public@]" lab
+
+let report_error ppf = function
+  |  [] -> ()
+  | err :: errs ->
+      let print_errs ppf errs =
+         List.iter (fun err -> fprintf ppf "@ %a" include_err err) errs in
+      fprintf ppf "@[%a%a@]" include_err err print_errs errs
diff --git a/typing/includeclass.mli b/typing/includeclass.mli
new file mode 100644
index 00000000..ebfa9789
--- /dev/null
+++ b/typing/includeclass.mli
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Inclusion checks for the class language *)
+
+open Types
+open Ctype
+open Format
+
+val class_types:
+        Env.t -> class_type -> class_type -> class_match_failure list
+val class_type_declarations:
+  loc:Location.t ->
+  Env.t -> class_type_declaration -> class_type_declaration ->
+  class_match_failure list
+val class_declarations:
+  Env.t -> class_declaration -> class_declaration ->
+  class_match_failure list
+
+val report_error: formatter -> class_match_failure list -> unit
diff --git a/typing/includecore.ml b/typing/includecore.ml
new file mode 100644
index 00000000..5325d97d
--- /dev/null
+++ b/typing/includecore.ml
@@ -0,0 +1,508 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Inclusion checks for the core language *)
+
+open Asttypes
+open Path
+open Types
+open Typedtree
+
+(* Inclusion between value descriptions *)
+
+exception Dont_match
+
+let value_descriptions ~loc env name
+    (vd1 : Types.value_description)
+    (vd2 : Types.value_description) =
+  Builtin_attributes.check_alerts_inclusion
+    ~def:vd1.val_loc
+    ~use:vd2.val_loc
+    loc
+    vd1.val_attributes vd2.val_attributes
+    name;
+  if Ctype.moregeneral env true vd1.val_type vd2.val_type then begin
+    match (vd1.val_kind, vd2.val_kind) with
+        (Val_prim p1, Val_prim p2) ->
+          if p1 = p2 then Tcoerce_none else raise Dont_match
+      | (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
+      | (_, _) -> Tcoerce_none
+  end else
+    raise Dont_match
+
+(* Inclusion between "private" annotations *)
+
+let private_flags decl1 decl2 =
+  match decl1.type_private, decl2.type_private with
+  | Private, Public ->
+      decl2.type_kind = Type_abstract &&
+      (decl2.type_manifest = None || decl1.type_kind <> Type_abstract)
+  | _, _ -> true
+
+(* Inclusion between manifest types (particularly for private row types) *)
+
+let is_absrow env ty =
+  match ty.desc with
+    Tconstr(Pident _, _, _) ->
+      begin match Ctype.expand_head env ty with
+        {desc=Tobject _|Tvariant _} -> true
+      | _ -> false
+      end
+  | _ -> false
+
+let type_manifest env ty1 params1 ty2 params2 priv2 =
+  let ty1' = Ctype.expand_head env ty1 and ty2' = Ctype.expand_head env ty2 in
+  match ty1'.desc, ty2'.desc with
+    Tvariant row1, Tvariant row2 when is_absrow env (Btype.row_more row2) ->
+      let row1 = Btype.row_repr row1 and row2 = Btype.row_repr row2 in
+      Ctype.equal env true (ty1::params1) (row2.row_more::params2) &&
+      begin match row1.row_more with
+        {desc=Tvar _|Tconstr _|Tnil} -> true
+      | _ -> false
+      end &&
+      let r1, r2, pairs =
+        Ctype.merge_row_fields row1.row_fields row2.row_fields in
+      (not row2.row_closed ||
+       row1.row_closed && Ctype.filter_row_fields false r1 = []) &&
+      List.for_all
+        (fun (_,f) -> match Btype.row_field_repr f with
+          Rabsent | Reither _ -> true | Rpresent _ -> false)
+        r2 &&
+      let to_equal = ref (List.combine params1 params2) in
+      List.for_all
+        (fun (_, f1, f2) ->
+          match Btype.row_field_repr f1, Btype.row_field_repr f2 with
+            Rpresent(Some t1),
+            (Rpresent(Some t2) | Reither(false, [t2], _, _)) ->
+              to_equal := (t1,t2) :: !to_equal; true
+          | Rpresent None, (Rpresent None | Reither(true, [], _, _)) -> true
+          | Reither(c1,tl1,_,_), Reither(c2,tl2,_,_)
+            when List.length tl1 = List.length tl2 && c1 = c2 ->
+              to_equal := List.combine tl1 tl2 @ !to_equal; true
+          | Rabsent, (Reither _ | Rabsent) -> true
+          | _ -> false)
+        pairs &&
+      let tl1, tl2 = List.split !to_equal in
+      Ctype.equal env true tl1 tl2
+  | Tobject (fi1, _), Tobject (fi2, _)
+    when is_absrow env (snd(Ctype.flatten_fields fi2)) ->
+      let (fields2,rest2) = Ctype.flatten_fields fi2 in
+      Ctype.equal env true (ty1::params1) (rest2::params2) &&
+      let (fields1,rest1) = Ctype.flatten_fields fi1 in
+      (match rest1 with {desc=Tnil|Tvar _|Tconstr _} -> true | _ -> false) &&
+      let pairs, _miss1, miss2 = Ctype.associate_fields fields1 fields2 in
+      miss2 = [] &&
+      let tl1, tl2 =
+        List.split (List.map (fun (_,_,t1,_,t2) -> t1, t2) pairs) in
+      Ctype.equal env true (params1 @ tl1) (params2 @ tl2)
+  | _ ->
+      let rec check_super ty1 =
+        Ctype.equal env true (ty1 :: params1) (ty2 :: params2) ||
+        priv2 = Private &&
+        try check_super
+              (Ctype.try_expand_once_opt env (Ctype.expand_head env ty1))
+        with Ctype.Cannot_expand -> false
+      in check_super ty1
+
+(* Inclusion between type declarations *)
+
+type position = Ctype.Unification_trace.position = First | Second
+
+let choose ord first second =
+  match ord with
+  | First -> first
+  | Second -> second
+
+let choose_other ord first second =
+  match ord with
+  | First -> choose Second first second
+  | Second -> choose First first second
+
+type label_mismatch =
+  | Type
+  | Mutability of position
+
+type record_mismatch =
+  | Label_mismatch of Types.label_declaration
+                      * Types.label_declaration
+                      * label_mismatch
+  | Label_names of int * Ident.t * Ident.t
+  | Label_missing of position * Ident.t
+  | Unboxed_float_representation of position
+
+type constructor_mismatch =
+  | Type
+  | Arity
+  | Inline_record of record_mismatch
+  | Kind of position
+  | Explicit_return_type of position
+
+type variant_mismatch =
+  | Constructor_mismatch of Types.constructor_declaration
+                            * Types.constructor_declaration
+                            * constructor_mismatch
+  | Constructor_names of int * Ident.t * Ident.t
+  | Constructor_missing of position * Ident.t
+
+type extension_constructor_mismatch =
+  | Constructor_privacy
+  | Constructor_mismatch of Ident.t
+                            * Types.extension_constructor
+                            * Types.extension_constructor
+                            * constructor_mismatch
+
+type type_mismatch =
+  | Arity
+  | Privacy
+  | Kind
+  | Constraint
+  | Manifest
+  | Variance
+  | Record_mismatch of record_mismatch
+  | Variant_mismatch of variant_mismatch
+  | Unboxed_representation of position
+  | Immediate of Type_immediacy.Violation.t
+
+let report_label_mismatch first second ppf err =
+  let pr fmt = Format.fprintf ppf fmt in
+  match (err : label_mismatch) with
+  | Type -> pr "The types are not equal."
+  | Mutability ord ->
+      pr "%s is mutable and %s is not."
+        (String.capitalize_ascii  (choose ord first second))
+        (choose_other ord first second)
+
+let report_record_mismatch first second decl ppf err =
+  let pr fmt = Format.fprintf ppf fmt in
+  match err with
+  | Label_mismatch (l1, l2, err) ->
+      pr
+        "@[Fields do not match:@;<1 2>%a@ is not compatible with:\
+         @;<1 2>%a@ %a"
+        Printtyp.label l1
+        Printtyp.label l2
+        (report_label_mismatch first second) err
+  | Label_names (n, name1, name2) ->
+      pr "@[Fields number %i have different names, %s and %s.@]"
+        n (Ident.name name1) (Ident.name name2)
+  | Label_missing (ord, s) ->
+      pr "@[The field %s is only present in %s %s.@]"
+        (Ident.name s) (choose ord first second) decl
+  | Unboxed_float_representation ord ->
+      pr "@[Their internal representations differ:@ %s %s %s.@]"
+        (choose ord first second) decl
+        "uses unboxed float representation"
+
+let report_constructor_mismatch first second decl ppf err =
+  let pr fmt  = Format.fprintf ppf fmt in
+  match (err : constructor_mismatch) with
+  | Type -> pr "The types are not equal."
+  | Arity -> pr "They have different arities."
+  | Inline_record err -> report_record_mismatch first second decl ppf err
+  | Kind ord ->
+      pr "%s uses inline records and %s doesn't."
+        (String.capitalize_ascii (choose ord first second))
+        (choose_other ord first second)
+  | Explicit_return_type ord ->
+      pr "%s has explicit return type and %s doesn't."
+        (String.capitalize_ascii (choose ord first second))
+        (choose_other ord first second)
+
+let report_variant_mismatch first second decl ppf err =
+  let pr fmt = Format.fprintf ppf fmt in
+  match (err : variant_mismatch) with
+  | Constructor_mismatch (c1, c2, err) ->
+      pr
+        "@[Constructors do not match:@;<1 2>%a@ is not compatible with:\
+         @;<1 2>%a@ %a"
+        Printtyp.constructor c1
+        Printtyp.constructor c2
+        (report_constructor_mismatch first second decl) err
+  | Constructor_names (n, name1, name2) ->
+      pr "Constructors number %i have different names, %s and %s."
+        n (Ident.name name1) (Ident.name name2)
+  | Constructor_missing (ord, s) ->
+      pr "The constructor %s is only present in %s %s."
+        (Ident.name s) (choose ord first second) decl
+
+let report_extension_constructor_mismatch first second decl ppf err =
+  let pr fmt = Format.fprintf ppf fmt in
+  match (err : extension_constructor_mismatch) with
+  | Constructor_privacy -> pr "A private type would be revealed."
+  | Constructor_mismatch (id, ext1, ext2, err) ->
+      pr "@[Constructors do not match:@;<1 2>%a@ is not compatible with:\
+          @;<1 2>%a@ %a@]"
+        (Printtyp.extension_only_constructor id) ext1
+        (Printtyp.extension_only_constructor id) ext2
+        (report_constructor_mismatch first second decl) err
+
+let report_type_mismatch0 first second decl ppf err =
+  let pr fmt = Format.fprintf ppf fmt in
+  match err with
+  | Arity -> pr "They have different arities."
+  | Privacy -> pr "A private type would be revealed."
+  | Kind -> pr "Their kinds differ."
+  | Constraint -> pr "Their constraints differ."
+  | Manifest -> ()
+  | Variance -> pr "Their variances do not agree."
+  | Record_mismatch err -> report_record_mismatch first second decl ppf err
+  | Variant_mismatch err -> report_variant_mismatch first second decl ppf err
+  | Unboxed_representation ord ->
+      pr "Their internal representations differ:@ %s %s %s."
+         (choose ord first second) decl
+         "uses unboxed representation"
+  | Immediate violation ->
+      let first = StringLabels.capitalize_ascii first in
+      match violation with
+      | Type_immediacy.Violation.Not_always_immediate ->
+          pr "%s is not an immediate type." first
+      | Type_immediacy.Violation.Not_always_immediate_on_64bits ->
+          pr "%s is not a type that is always immediate on 64 bit platforms."
+            first
+
+let report_type_mismatch first second decl ppf err =
+  if err = Manifest then () else
+  Format.fprintf ppf "@ %a" (report_type_mismatch0 first second decl) err
+
+let rec compare_constructor_arguments ~loc env params1 params2 arg1 arg2 =
+  match arg1, arg2 with
+  | Types.Cstr_tuple arg1, Types.Cstr_tuple arg2 ->
+      if List.length arg1 <> List.length arg2 then
+        Some (Arity : constructor_mismatch)
+      else if
+        (* Ctype.equal must be called on all arguments at once, cf. PR#7378 *)
+        Ctype.equal env true (params1 @ arg1) (params2 @ arg2)
+      then None else Some Type
+  | Types.Cstr_record l1, Types.Cstr_record l2 ->
+      Option.map
+        (fun rec_err -> Inline_record rec_err)
+        (compare_records env ~loc params1 params2 0 l1 l2)
+  | Types.Cstr_record _, _ -> Some (Kind First : constructor_mismatch)
+  | _, Types.Cstr_record _ -> Some (Kind Second : constructor_mismatch)
+
+and compare_constructors ~loc env params1 params2 res1 res2 args1 args2 =
+  match res1, res2 with
+  | Some r1, Some r2 ->
+      if Ctype.equal env true [r1] [r2] then
+        compare_constructor_arguments ~loc env [r1] [r2] args1 args2
+      else Some Type
+  | Some _, None -> Some (Explicit_return_type First)
+  | None, Some _ -> Some (Explicit_return_type Second)
+  | None, None ->
+      compare_constructor_arguments ~loc env params1 params2 args1 args2
+
+and compare_variants ~loc env params1 params2 n
+    (cstrs1 : Types.constructor_declaration list)
+    (cstrs2 : Types.constructor_declaration list) =
+  match cstrs1, cstrs2 with
+  | [], []   -> None
+  | [], c::_ -> Some (Constructor_missing (Second, c.Types.cd_id))
+  | c::_, [] -> Some (Constructor_missing (First, c.Types.cd_id))
+  | cd1::rem1, cd2::rem2 ->
+      if Ident.name cd1.cd_id <> Ident.name cd2.cd_id then
+        Some (Constructor_names (n, cd1.cd_id, cd2.cd_id))
+      else begin
+        Builtin_attributes.check_alerts_inclusion
+          ~def:cd1.cd_loc
+          ~use:cd2.cd_loc
+          loc
+          cd1.cd_attributes cd2.cd_attributes
+          (Ident.name cd1.cd_id);
+        match compare_constructors ~loc env params1 params2
+                cd1.cd_res cd2.cd_res cd1.cd_args cd2.cd_args with
+        | Some r ->
+            Some ((Constructor_mismatch (cd1, cd2, r)) : variant_mismatch)
+        | None -> compare_variants ~loc env params1 params2 (n+1) rem1 rem2
+      end
+
+and compare_labels env params1 params2
+      (ld1 : Types.label_declaration)
+      (ld2 : Types.label_declaration) =
+      if ld1.ld_mutable <> ld2.ld_mutable
+      then
+        let ord = if ld1.ld_mutable = Asttypes.Mutable then First else Second in
+        Some (Mutability  ord)
+      else
+        if Ctype.equal env true (ld1.ld_type::params1) (ld2.ld_type::params2)
+        then None
+        else Some (Type : label_mismatch)
+
+and compare_records ~loc env params1 params2 n
+    (labels1 : Types.label_declaration list)
+    (labels2 : Types.label_declaration list) =
+  match labels1, labels2 with
+  | [], []           -> None
+  | [], l::_ -> Some (Label_missing (Second, l.Types.ld_id))
+  | l::_, [] -> Some (Label_missing (First, l.Types.ld_id))
+  | ld1::rem1, ld2::rem2 ->
+      if Ident.name ld1.ld_id <> Ident.name ld2.ld_id
+      then Some (Label_names (n, ld1.ld_id, ld2.ld_id))
+      else begin
+        Builtin_attributes.check_deprecated_mutable_inclusion
+          ~def:ld1.ld_loc
+          ~use:ld2.ld_loc
+          loc
+          ld1.ld_attributes ld2.ld_attributes
+          (Ident.name ld1.ld_id);
+        match compare_labels env params1 params2 ld1 ld2 with
+        | Some r -> Some (Label_mismatch (ld1, ld2, r))
+        (* add arguments to the parameters, cf. PR#7378 *)
+        | None -> compare_records ~loc env
+                    (ld1.ld_type::params1) (ld2.ld_type::params2)
+                    (n+1)
+                    rem1 rem2
+      end
+
+let compare_records_with_representation ~loc env params1 params2 n
+      labels1 labels2 rep1 rep2
+  =
+  match compare_records ~loc env params1 params2 n labels1 labels2 with
+  | None when rep1 <> rep2 ->
+      let pos = if rep2 = Record_float then Second else First in
+      Some (Unboxed_float_representation pos)
+  | err -> err
+
+let type_declarations ?(equality = false) ~loc env ~mark name
+      decl1 path decl2 =
+  Builtin_attributes.check_alerts_inclusion
+    ~def:decl1.type_loc
+    ~use:decl2.type_loc
+    loc
+    decl1.type_attributes decl2.type_attributes
+    name;
+  if decl1.type_arity <> decl2.type_arity then Some Arity else
+  if not (private_flags decl1 decl2) then Some Privacy else
+  let err = match (decl1.type_manifest, decl2.type_manifest) with
+      (_, None) ->
+        if Ctype.equal env true decl1.type_params decl2.type_params
+        then None else Some Constraint
+    | (Some ty1, Some ty2) ->
+        if type_manifest env ty1 decl1.type_params ty2 decl2.type_params
+            decl2.type_private
+        then None else Some Manifest
+    | (None, Some ty2) ->
+        let ty1 =
+          Btype.newgenty (Tconstr(path, decl2.type_params, ref Mnil))
+        in
+        if Ctype.equal env true decl1.type_params decl2.type_params then
+          if Ctype.equal env false [ty1] [ty2] then None
+          else Some Manifest
+        else Some Constraint
+  in
+  if err <> None then err else
+  let err =
+    match (decl2.type_kind, decl1.type_unboxed.unboxed,
+           decl2.type_unboxed.unboxed) with
+    | Type_abstract, _, _ -> None
+    | _, true, false -> Some (Unboxed_representation First)
+    | _, false, true -> Some (Unboxed_representation Second)
+    | _ -> None
+  in
+  if err <> None then err else
+  let err = match (decl1.type_kind, decl2.type_kind) with
+      (_, Type_abstract) -> None
+    | (Type_variant cstrs1, Type_variant cstrs2) ->
+        if mark then begin
+          let mark usage cstrs =
+            List.iter (Env.mark_constructor_used usage) cstrs
+          in
+          let usage =
+            if decl2.type_private = Public then Env.Positive
+            else Env.Privatize
+          in
+          mark usage cstrs1;
+          if equality then mark Env.Positive cstrs2
+        end;
+        Option.map
+          (fun var_err -> Variant_mismatch var_err)
+          (compare_variants ~loc env decl1.type_params decl2.type_params 1
+             cstrs1 cstrs2)
+    | (Type_record(labels1,rep1), Type_record(labels2,rep2)) ->
+        Option.map (fun rec_err -> Record_mismatch rec_err)
+          (compare_records_with_representation ~loc env
+             decl1.type_params decl2.type_params 1
+             labels1 labels2
+             rep1 rep2)
+    | (Type_open, Type_open) -> None
+    | (_, _) -> Some Kind
+  in
+  if err <> None then err else
+  let abstr = decl2.type_kind = Type_abstract && decl2.type_manifest = None in
+  (* If attempt to assign a non-immediate type (e.g. string) to a type that
+   * must be immediate, then we error *)
+  let err =
+    if not abstr then
+      None
+    else
+      match
+        Type_immediacy.coerce decl1.type_immediate ~as_:decl2.type_immediate
+      with
+      | Ok () -> None
+      | Error violation -> Some (Immediate violation)
+  in
+  if err <> None then err else
+  let need_variance =
+    abstr || decl1.type_private = Private || decl1.type_kind = Type_open in
+  if not need_variance then None else
+  let abstr = abstr || decl2.type_private = Private in
+  let opn = decl2.type_kind = Type_open && decl2.type_manifest = None in
+  let constrained ty = not (Btype.(is_Tvar (repr ty))) in
+  if List.for_all2
+      (fun ty (v1,v2) ->
+        let open Variance in
+        let imp a b = not a || b in
+        let (co1,cn1) = get_upper v1 and (co2,cn2) = get_upper v2 in
+        (if abstr then (imp co1 co2 && imp cn1 cn2)
+         else if opn || constrained ty then (co1 = co2 && cn1 = cn2)
+         else true) &&
+        let (p1,n1,i1,j1) = get_lower v1 and (p2,n2,i2,j2) = get_lower v2 in
+        imp abstr (imp p2 p1 && imp n2 n1 && imp i2 i1 && imp j2 j1))
+      decl2.type_params (List.combine decl1.type_variance decl2.type_variance)
+  then None else Some Variance
+
+(* Inclusion between extension constructors *)
+
+let extension_constructors ~loc env ~mark id ext1 ext2 =
+  if mark then begin
+    let usage =
+      if ext2.ext_private = Public then Env.Positive
+      else Env.Privatize
+    in
+    Env.mark_extension_used usage ext1
+  end;
+  let ty1 =
+    Btype.newgenty (Tconstr(ext1.ext_type_path, ext1.ext_type_params, ref Mnil))
+  in
+  let ty2 =
+    Btype.newgenty (Tconstr(ext2.ext_type_path, ext2.ext_type_params, ref Mnil))
+  in
+  if not (Ctype.equal env true (ty1 :: ext1.ext_type_params)
+                               (ty2 :: ext2.ext_type_params))
+  then Some (Constructor_mismatch (id, ext1, ext2, Type))
+  else
+    let r =
+      compare_constructors ~loc env ext1.ext_type_params ext2.ext_type_params
+        ext1.ext_ret_type ext2.ext_ret_type
+        ext1.ext_args ext2.ext_args
+    in
+    match r with
+    | Some r -> Some (Constructor_mismatch (id, ext1, ext2, r))
+    | None -> match ext1.ext_private, ext2.ext_private with
+        Private, Public -> Some Constructor_privacy
+      | _, _ -> None
diff --git a/typing/includecore.mli b/typing/includecore.mli
new file mode 100644
index 00000000..560d0ac1
--- /dev/null
+++ b/typing/includecore.mli
@@ -0,0 +1,90 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Inclusion checks for the core language *)
+
+open Typedtree
+open Types
+
+exception Dont_match
+
+type position = Ctype.Unification_trace.position = First | Second
+
+type label_mismatch =
+  | Type
+  | Mutability of position
+
+type record_mismatch =
+  | Label_mismatch of label_declaration * label_declaration * label_mismatch
+  | Label_names of int * Ident.t * Ident.t
+  | Label_missing of position * Ident.t
+  | Unboxed_float_representation of position
+
+type constructor_mismatch =
+  | Type
+  | Arity
+  | Inline_record of record_mismatch
+  | Kind of position
+  | Explicit_return_type of position
+
+type variant_mismatch =
+  | Constructor_mismatch of constructor_declaration
+                            * constructor_declaration
+                            * constructor_mismatch
+  | Constructor_names of int * Ident.t * Ident.t
+  | Constructor_missing of position * Ident.t
+
+type extension_constructor_mismatch =
+  | Constructor_privacy
+  | Constructor_mismatch of Ident.t
+                            * extension_constructor
+                            * extension_constructor
+                            * constructor_mismatch
+
+type type_mismatch =
+  | Arity
+  | Privacy
+  | Kind
+  | Constraint
+  | Manifest
+  | Variance
+  | Record_mismatch of record_mismatch
+  | Variant_mismatch of variant_mismatch
+  | Unboxed_representation of position
+  | Immediate of Type_immediacy.Violation.t
+
+val value_descriptions:
+  loc:Location.t -> Env.t -> string ->
+  value_description -> value_description -> module_coercion
+
+val type_declarations:
+  ?equality:bool ->
+  loc:Location.t ->
+  Env.t -> mark:bool -> string ->
+  type_declaration -> Path.t -> type_declaration -> type_mismatch option
+
+val extension_constructors:
+  loc:Location.t -> Env.t -> mark:bool -> Ident.t ->
+  extension_constructor -> extension_constructor ->
+  extension_constructor_mismatch option
+(*
+val class_types:
+        Env.t -> class_type -> class_type -> bool
+*)
+
+val report_type_mismatch:
+    string -> string -> string -> Format.formatter -> type_mismatch -> unit
+val report_extension_constructor_mismatch: string -> string -> string ->
+  Format.formatter -> extension_constructor_mismatch -> unit
diff --git a/typing/includemod.ml b/typing/includemod.ml
new file mode 100644
index 00000000..e2e63ecb
--- /dev/null
+++ b/typing/includemod.ml
@@ -0,0 +1,896 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Inclusion checks for the module language *)
+
+open Misc
+open Typedtree
+open Types
+
+type symptom =
+    Missing_field of Ident.t * Location.t * string (* kind *)
+  | Value_descriptions of Ident.t * value_description * value_description
+  | Type_declarations of Ident.t * type_declaration
+        * type_declaration * Includecore.type_mismatch
+  | Extension_constructors of Ident.t * extension_constructor
+        * extension_constructor * Includecore.extension_constructor_mismatch
+  | Module_types of module_type * module_type
+  | Modtype_infos of Ident.t * modtype_declaration * modtype_declaration
+  | Modtype_permutation of Types.module_type * Typedtree.module_coercion
+  | Interface_mismatch of string * string
+  | Class_type_declarations of
+      Ident.t * class_type_declaration * class_type_declaration *
+      Ctype.class_match_failure list
+  | Class_declarations of
+      Ident.t * class_declaration * class_declaration *
+      Ctype.class_match_failure list
+  | Unbound_modtype_path of Path.t
+  | Unbound_module_path of Path.t
+  | Invalid_module_alias of Path.t
+
+type pos =
+  | Module of Ident.t
+  | Modtype of Ident.t
+  | Arg of functor_parameter
+  | Body of functor_parameter
+type error = pos list * Env.t * symptom
+
+exception Error of error list
+exception Apply_error of Location.t * Path.t * Path.t * error list
+
+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 cxt 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
+    Includecore.value_descriptions ~loc env (Ident.name id) vd1 vd2
+  with Includecore.Dont_match ->
+    raise(Error[cxt, env, Value_descriptions(id, vd1, vd2)])
+
+(* Inclusion between type declarations *)
+
+let type_declarations ~loc env ~mark ?old_env:_ cxt 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 -> ()
+  | Some err ->
+      raise(Error[cxt, env, Type_declarations(id, decl1, decl2, err)])
+
+(* Inclusion between extension constructors *)
+
+let extension_constructors ~loc env ~mark cxt 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 -> ()
+  | Some err ->
+      raise(Error[cxt, env, Extension_constructors(id, ext1, ext2, err)])
+
+(* Inclusion between class declarations *)
+
+let class_type_declarations ~loc ~old_env:_ env cxt subst id decl1 decl2 =
+  let decl2 = Subst.cltype_declaration subst decl2 in
+  match Includeclass.class_type_declarations ~loc env decl1 decl2 with
+    []     -> ()
+  | reason ->
+      raise(Error[cxt, env,
+                  Class_type_declarations(id, decl1, decl2, reason)])
+
+let class_declarations ~old_env:_ env cxt subst id decl1 decl2 =
+  let decl2 = Subst.class_declaration subst decl2 in
+  match Includeclass.class_declarations env decl1 decl2 with
+    []     -> ()
+  | reason ->
+      raise(Error[cxt, env, Class_declarations(id, decl1, decl2, reason)])
+
+(* Expand a module type identifier when possible *)
+
+exception Dont_match
+
+let try_expand_modtype_path env path =
+  try
+    Env.find_modtype_expansion path env
+  with Not_found -> raise Dont_match
+
+let expand_module_alias env cxt path =
+  try (Env.find_module path env).md_type
+  with Not_found ->
+    raise(Error[cxt, env, Unbound_module_path path])
+
+(* Extract name, kind and ident from a signature item *)
+
+type field_desc =
+    Field_value of string
+  | Field_type of string
+  | Field_exception of string
+  | Field_typext of string
+  | Field_module of string
+  | Field_modtype of string
+  | Field_class of string
+  | Field_classtype of string
+
+let kind_of_field_desc = function
+  | Field_value _ -> "value"
+  | Field_type _ -> "type"
+  | Field_exception _ -> "exception"
+  | Field_typext _ -> "extension constructor"
+  | Field_module _ -> "module"
+  | Field_modtype _ -> "module type"
+  | Field_class _ -> "class"
+  | Field_classtype _ -> "class type"
+
+(** Map indexed by both field types and names.
+    This avoids name clashes between different sorts of fields
+    such as values and types. *)
+module FieldMap = Map.Make(struct
+    type t = field_desc
+    let compare = Stdlib.compare
+  end)
+
+let item_ident_name = function
+    Sig_value(id, d, _) -> (id, d.val_loc, Field_value(Ident.name id))
+  | Sig_type(id, d, _, _) -> (id, d.type_loc, Field_type(Ident.name id))
+  | Sig_typext(id, d, _, _) ->
+     let kind =
+       if Path.same d.ext_type_path Predef.path_exn
+       then Field_exception(Ident.name id)
+       else Field_typext(Ident.name id)
+     in
+     (id, d.ext_loc, kind)
+  | Sig_module(id, _, d, _, _) -> (id, d.md_loc, Field_module(Ident.name id))
+  | Sig_modtype(id, d, _) -> (id, d.mtd_loc, Field_modtype(Ident.name id))
+  | Sig_class(id, d, _, _) -> (id, d.cty_loc, Field_class(Ident.name id))
+  | Sig_class_type(id, d, _, _) ->
+      (id, d.clty_loc, Field_classtype(Ident.name id))
+
+let is_runtime_component = function
+  | Sig_value(_,{val_kind = Val_prim _}, _)
+  | Sig_type(_,_,_,_)
+  | Sig_module(_,Mp_absent,_,_,_)
+  | Sig_modtype(_,_,_)
+  | Sig_class_type(_,_,_,_) -> false
+  | Sig_value(_,_,_)
+  | Sig_typext(_,_,_,_)
+  | Sig_module(_,Mp_present,_,_,_)
+  | Sig_class(_,_,_,_) -> true
+
+(* Print a coercion *)
+
+let rec print_list pr ppf = function
+    [] -> ()
+  | [a] -> pr ppf a
+  | a :: l -> pr ppf a; Format.fprintf ppf ";@ "; print_list pr ppf l
+let print_list pr ppf l =
+  Format.fprintf ppf "[@[%a@]]" (print_list pr) l
+
+let rec print_coercion ppf c =
+  let pr fmt = Format.fprintf ppf fmt in
+  match c with
+    Tcoerce_none -> pr "id"
+  | Tcoerce_structure (fl, nl) ->
+      pr "@[<2>struct@ %a@ %a@]"
+        (print_list print_coercion2) fl
+        (print_list print_coercion3) nl
+  | Tcoerce_functor (inp, out) ->
+      pr "@[<2>functor@ (%a)@ (%a)@]"
+        print_coercion inp
+        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
+  | Tcoerce_alias (_, p, c) ->
+      pr "@[<2>alias %a@ (%a)@]"
+        Printtyp.path p
+        print_coercion c
+and print_coercion2 ppf (n, c) =
+  Format.fprintf ppf "@[%d,@ %a@]" n print_coercion c
+and print_coercion3 ppf (i, n, c) =
+  Format.fprintf ppf "@[%s, %d,@ %a@]"
+    (Ident.unique_name i) n print_coercion c
+
+(* Simplify a structure coercion *)
+
+let equal_module_paths env p1 subst p2 =
+  Path.same p1 p2
+  || Path.same (Env.normalize_module_path None env p1)
+       (Env.normalize_module_path None env
+          (Subst.module_path subst p2))
+
+let equal_modtype_paths env p1 subst p2 =
+  Path.same p1 p2
+  || Path.same (Env.normalize_modtype_path env p1)
+       (Env.normalize_modtype_path env
+          (Subst.modtype_path subst p2))
+
+let simplify_structure_coercion cc id_pos_list =
+  let rec is_identity_coercion pos = function
+  | [] ->
+      true
+  | (n, c) :: rem ->
+      n = pos && c = Tcoerce_none && is_identity_coercion (pos + 1) rem in
+  if is_identity_coercion 0 cc
+  then Tcoerce_none
+  else Tcoerce_structure (cc, id_pos_list)
+
+(* Inclusion between module types.
+   Return the restriction that transforms a value of the smaller type
+   into a value of the bigger type. *)
+
+let rec modtypes ~loc env ~mark cxt subst mty1 mty2 =
+  try
+    try_modtypes ~loc env ~mark cxt subst mty1 mty2
+  with
+    Dont_match ->
+      raise(Error[cxt, env,
+                  Module_types(mty1, Subst.modtype Make_local subst mty2)])
+  | Error reasons as err ->
+      match mty1, mty2 with
+        Mty_alias _, _
+      | _, Mty_alias _ -> raise err
+      | _ ->
+          raise(Error((cxt, env,
+                       Module_types(mty1, Subst.modtype Make_local subst mty2))
+                      :: reasons))
+
+and try_modtypes ~loc env ~mark cxt subst mty1 mty2 =
+  match mty1, mty2 with
+  | (Mty_alias p1, Mty_alias p2) ->
+      if Env.is_functor_arg p2 env then
+        raise (Error[cxt, env, Invalid_module_alias p2]);
+      if not (equal_module_paths env p1 subst p2) then
+        raise Dont_match;
+      Tcoerce_none
+  | (Mty_alias p1, _) ->
+      let p1 = try
+        Env.normalize_module_path (Some Location.none) env p1
+      with Env.Error (Env.Missing_module (_, _, path)) ->
+        raise (Error[cxt, env, Unbound_module_path path])
+      in
+      let mty1 = expand_module_alias env cxt p1 in
+      strengthened_modtypes ~loc ~aliasable:true env ~mark cxt
+        subst mty1 p1 mty2
+  | (Mty_ident p1, Mty_ident p2) ->
+      let p1 = Env.normalize_modtype_path env p1 in
+      let p2 = Env.normalize_modtype_path env (Subst.modtype_path subst p2) in
+      if Path.same p1 p2 then Tcoerce_none
+      else
+        try_modtypes ~loc env ~mark cxt subst
+          (try_expand_modtype_path env p1)
+          (try_expand_modtype_path env p2)
+  | (Mty_ident p1, _) ->
+      let p1 = Env.normalize_modtype_path env p1 in
+      try_modtypes ~loc env ~mark cxt subst
+        (try_expand_modtype_path env p1) mty2
+  | (_, Mty_ident p2) ->
+      let p2 = Env.normalize_modtype_path env (Subst.modtype_path subst p2) in
+      try_modtypes ~loc env ~mark cxt subst mty1
+        (try_expand_modtype_path env p2)
+  | (Mty_signature sig1, Mty_signature sig2) ->
+      signatures ~loc env ~mark cxt subst sig1 sig2
+  | (Mty_functor(Unit, res1), Mty_functor(Unit, res2)) ->
+    begin
+      match modtypes ~loc env ~mark (Body Unit::cxt) subst res1 res2 with
+      | Tcoerce_none -> Tcoerce_none
+      | cc -> Tcoerce_functor (Tcoerce_none, cc)
+    end
+  | (Mty_functor(Named (param1, arg1) as arg, res1),
+     Mty_functor(Named (param2, arg2), res2)) ->
+      let arg2' = Subst.modtype Keep subst arg2 in
+      let cc_arg =
+        modtypes ~loc env ~mark:(negate_mark mark)
+          (Arg arg::cxt) Subst.identity arg2' arg1
+      in
+      let env, subst =
+        match param1, param2 with
+        | Some p1, Some p2 ->
+            Env.add_module p1 Mp_present arg2' env,
+            Subst.add_module p2 (Path.Pident p1) subst
+        | None, Some p2 ->
+            Env.add_module p2 Mp_present arg2' env, subst
+        | Some p1, None ->
+            Env.add_module p1 Mp_present arg2' env, subst
+        | None, None ->
+            env, subst
+      in
+      let cc_res = modtypes ~loc env ~mark (Body arg::cxt) subst res1 res2 in
+      begin match (cc_arg, cc_res) with
+          (Tcoerce_none, Tcoerce_none) -> Tcoerce_none
+        | _ -> Tcoerce_functor(cc_arg, cc_res)
+      end
+  | (_, _) ->
+      raise Dont_match
+
+and strengthened_modtypes ~loc ~aliasable env ~mark cxt subst mty1 path1 mty2 =
+  match mty1, mty2 with
+  | Mty_ident p1, Mty_ident p2 when equal_modtype_paths env p1 subst p2 ->
+      Tcoerce_none
+  | _, _ ->
+      let mty1 = Mtype.strengthen ~aliasable env mty1 path1 in
+      modtypes ~loc env ~mark cxt subst mty1 mty2
+
+and strengthened_module_decl ~loc ~aliasable env ~mark cxt subst md1 path1 md2 =
+  match md1.md_type, md2.md_type with
+  | Mty_ident p1, Mty_ident p2 when equal_modtype_paths env p1 subst p2 ->
+      Tcoerce_none
+  | _, _ ->
+      let md1 = Mtype.strengthen_decl ~aliasable env md1 path1 in
+      modtypes ~loc env ~mark cxt subst md1.md_type md2.md_type
+
+(* Inclusion between signatures *)
+
+and signatures ~loc env ~mark cxt subst sig1 sig2 =
+  (* Environment used to check inclusion of components *)
+  let new_env =
+    Env.add_signature sig1 (Env.in_signature true env) in
+  (* Keep ids for module aliases *)
+  let (id_pos_list,_) =
+    List.fold_left
+      (fun (l,pos) -> function
+          Sig_module (id, Mp_present, _, _, _) ->
+            ((id,pos,Tcoerce_none)::l , pos+1)
+        | item -> (l, if is_runtime_component item then pos+1 else pos))
+      ([], 0) sig1 in
+  (* Build a table of the components of sig1, along with their positions.
+     The table is indexed by kind and name of component *)
+  let rec build_component_table pos tbl = function
+      [] -> pos, tbl
+    | (Sig_value (_, _, Hidden)
+      |Sig_type (_, _, _, Hidden)
+      |Sig_typext (_, _, _, Hidden)
+      |Sig_module (_, _, _, _, Hidden)
+      |Sig_modtype (_, _, Hidden)
+      |Sig_class (_, _, _, Hidden)
+      |Sig_class_type (_, _, _, Hidden)
+      ) as item :: rem ->
+        let pos = if is_runtime_component item then pos + 1 else pos in
+        build_component_table pos tbl rem (* do not pair private items. *)
+    | item :: rem ->
+        let (id, _loc, name) = item_ident_name item in
+        let pos, nextpos =
+          if is_runtime_component item then pos, pos + 1
+          else -1, pos
+        in
+        build_component_table nextpos
+                              (FieldMap.add name (id, item, pos) tbl) rem in
+  let len1, comps1 =
+    build_component_table 0 FieldMap.empty sig1 in
+  let len2 =
+    List.fold_left
+      (fun n i -> if is_runtime_component i then n + 1 else n)
+      0
+      sig2
+  in
+  (* Pair each component of sig2 with a component of sig1,
+     identifying the names along the way.
+     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
+      [] ->
+        begin match unpaired with
+            [] ->
+              let cc =
+                signature_components ~loc env ~mark new_env cxt subst
+                  (List.rev paired)
+              in
+              if len1 = len2 then (* see PR#5098 *)
+                simplify_structure_coercion cc id_pos_list
+              else
+                Tcoerce_structure (cc, id_pos_list)
+          | _  -> raise(Error unpaired)
+        end
+    | item2 :: rem ->
+        let (id2, loc, name2) = item_ident_name item2 in
+        let name2, report =
+          match item2, name2 with
+            Sig_type (_, {type_manifest=None}, _, _), Field_type s
+            when Btype.is_row_name s ->
+              (* Do not report in case of failure,
+                 as the main type will generate an error *)
+              Field_type (String.sub s 0 (String.length s - 4)), false
+          | _ -> name2, true
+        in
+        begin try
+          let (id1, item1, pos1) = FieldMap.find name2 comps1 in
+          let new_subst =
+            match item2 with
+              Sig_type _ ->
+                Subst.add_type id2 (Path.Pident id1) subst
+            | Sig_module _ ->
+                Subst.add_module id2 (Path.Pident id1) subst
+            | Sig_modtype _ ->
+                Subst.add_modtype id2 (Mty_ident (Path.Pident id1)) subst
+            | Sig_value _ | Sig_typext _
+            | Sig_class _ | Sig_class_type _ ->
+                subst
+          in
+          pair_components new_subst
+            ((item1, item2, pos1) :: paired) unpaired rem
+        with Not_found ->
+          let unpaired =
+            if report then
+              (cxt, env, Missing_field (id2, loc, kind_of_field_desc name2)) ::
+              unpaired
+            else unpaired in
+          pair_components subst paired unpaired rem
+        end in
+  (* Do the pairing and checking, and return the final coercion *)
+  pair_components subst [] [] sig2
+
+(* Inclusion between signature components *)
+
+and signature_components ~loc old_env ~mark env cxt subst paired =
+  let comps_rec rem =
+    signature_components ~loc old_env ~mark env cxt subst rem
+  in
+  match paired with
+    [] -> []
+  | (Sig_value(id1, valdecl1, _), Sig_value(_id2, valdecl2, _), pos) :: rem ->
+      let cc =
+        value_descriptions ~loc env ~mark cxt subst id1 valdecl1 valdecl2
+      in
+      begin match valdecl2.val_kind with
+        Val_prim _ -> comps_rec rem
+      | _ -> (pos, cc) :: comps_rec rem
+      end
+  | (Sig_type(id1, tydecl1, _, _), Sig_type(_id2, tydecl2, _, _), _pos) :: rem
+    ->
+      type_declarations ~loc ~old_env env ~mark cxt subst id1 tydecl1 tydecl2;
+      comps_rec rem
+  | (Sig_typext(id1, ext1, _, _), Sig_typext(_id2, ext2, _, _), pos)
+    :: rem ->
+      extension_constructors ~loc env ~mark cxt subst id1 ext1 ext2;
+      (pos, Tcoerce_none) :: comps_rec rem
+  | (Sig_module(id1, pres1, mty1, _, _),
+     Sig_module(_id2, pres2, mty2, _, _), pos) :: rem -> begin
+      let cc = module_declarations ~loc env ~mark cxt subst id1 mty1 mty2 in
+      let rem = comps_rec rem in
+      match pres1, pres2, mty1.md_type with
+      | Mp_present, Mp_present, _ -> (pos, cc) :: rem
+      | _, Mp_absent, _ -> rem
+      | Mp_absent, Mp_present, Mty_alias p1 ->
+          (pos, Tcoerce_alias (env, p1, cc)) :: rem
+      | Mp_absent, Mp_present, _ -> assert false
+    end
+  | (Sig_modtype(id1, info1, _), Sig_modtype(_id2, info2, _), _pos) :: rem ->
+      modtype_infos ~loc env ~mark cxt subst id1 info1 info2;
+      comps_rec rem
+  | (Sig_class(id1, decl1, _, _), Sig_class(_id2, decl2, _, _), pos) :: rem ->
+      class_declarations ~old_env env cxt subst id1 decl1 decl2;
+      (pos, Tcoerce_none) :: comps_rec rem
+  | (Sig_class_type(id1, info1, _, _),
+     Sig_class_type(_id2, info2, _, _), _pos) :: rem ->
+      class_type_declarations ~loc ~old_env env cxt subst id1 info1 info2;
+      comps_rec rem
+  | _ ->
+      assert false
+
+and module_declarations ~loc env ~mark cxt subst id1 md1 md2 =
+  Builtin_attributes.check_alerts_inclusion
+    ~def:md1.md_loc
+    ~use:md2.md_loc
+    loc
+    md1.md_attributes md2.md_attributes
+    (Ident.name id1);
+  let p1 = Path.Pident id1 in
+  if mark_positive mark then
+    Env.mark_module_used md1.md_uid;
+  strengthened_modtypes ~loc ~aliasable:true env ~mark (Module id1::cxt) subst
+    md1.md_type p1 md2.md_type
+
+(* Inclusion between module type specifications *)
+
+and modtype_infos ~loc env ~mark cxt subst id info1 info2 =
+  Builtin_attributes.check_alerts_inclusion
+    ~def:info1.mtd_loc
+    ~use:info2.mtd_loc
+    loc
+    info1.mtd_attributes info2.mtd_attributes
+    (Ident.name id);
+  let info2 = Subst.modtype_declaration Keep subst info2 in
+  let cxt' = Modtype id :: cxt in
+  try
+    match (info1.mtd_type, info2.mtd_type) with
+      (None, None) -> ()
+    | (Some _, None) -> ()
+    | (Some mty1, Some mty2) ->
+        check_modtype_equiv ~loc env ~mark cxt' mty1 mty2
+    | (None, Some mty2) ->
+        check_modtype_equiv ~loc env ~mark cxt' (Mty_ident(Path.Pident id)) mty2
+  with Error reasons ->
+    raise(Error((cxt, env, Modtype_infos(id, info1, info2)) :: reasons))
+
+and check_modtype_equiv ~loc env ~mark cxt mty1 mty2 =
+  match
+    (modtypes ~loc env ~mark cxt Subst.identity mty1 mty2,
+     modtypes ~loc env ~mark:(negate_mark mark) cxt Subst.identity mty2 mty1)
+  with
+    (Tcoerce_none, Tcoerce_none) -> ()
+  | (c1, _c2) ->
+      (* Format.eprintf "@[c1 = %a@ c2 = %a@]@."
+        print_coercion _c1 print_coercion _c2; *)
+      raise(Error [cxt, env, Modtype_permutation (mty1, c1)])
+
+(* Simplified inclusion check between module types (for Env) *)
+
+let can_alias env path =
+  let rec no_apply = function
+    | Path.Pident _ -> true
+    | Path.Pdot(p, _) -> no_apply p
+    | Path.Papply _ -> false
+  in
+  no_apply path && not (Env.is_functor_arg path env)
+
+let check_modtype_inclusion ~loc env mty1 path1 mty2 =
+  let aliasable = can_alias env path1 in
+  ignore
+    (strengthened_modtypes ~loc ~aliasable env ~mark:Mark_both []
+       Subst.identity mty1 path1 mty2)
+
+let () =
+  Env.check_functor_application :=
+    (fun ~errors ~loc env mty1 path1 mty2 path2 ->
+       try
+         check_modtype_inclusion ~loc env mty1 path1 mty2
+       with Error errs ->
+         if errors then
+           raise (Apply_error(loc, path1, path2, errs))
+         else
+           raise Not_found)
+
+(* Check that an implementation of a compilation unit meets its
+   interface. *)
+
+let compunit env ~mark impl_name impl_sig intf_name intf_sig =
+  try
+    signatures ~loc:(Location.in_file impl_name) env ~mark []
+      Subst.identity impl_sig intf_sig
+  with Error reasons ->
+    raise(Error(([], Env.empty,Interface_mismatch(impl_name, intf_name))
+                :: reasons))
+
+(* Hide the context and substitution parameters to the outside world *)
+
+let modtypes ~loc env ~mark mty1 mty2 =
+  modtypes ~loc env ~mark [] Subst.identity mty1 mty2
+let signatures env ~mark sig1 sig2 =
+  signatures ~loc:Location.none env ~mark [] Subst.identity sig1 sig2
+let type_declarations ~loc env ~mark id decl1 decl2 =
+  type_declarations ~loc env ~mark [] Subst.identity id decl1 decl2
+let strengthened_module_decl ~loc ~aliasable env ~mark
+      md1 path1 md2 =
+  strengthened_module_decl ~loc ~aliasable env ~mark [] Subst.identity
+    md1 path1 md2
+
+(*
+let modtypes env m1 m2 =
+  let c = modtypes env m1 m2 in
+  Format.eprintf "@[<2>modtypes@ %a@ %a =@ %a@]@."
+    Printtyp.modtype m1 Printtyp.modtype m2
+    print_coercion c;
+  c
+*)
+
+(* Error report *)
+
+module Illegal_permutation = struct
+  (** Extraction of information in case of illegal permutation
+      in a module type *)
+
+  (** When examining coercions, we only have runtime component indices,
+      we use thus a limited version of {!pos}. *)
+  type coerce_pos =
+    | Item of int
+    | InArg
+    | InBody
+
+  let either f x g y = match f x with
+    | None -> g y
+    | Some _ as v -> v
+
+  (** We extract a lone transposition from a full tree of permutations. *)
+  let rec transposition_under path = function
+    | Tcoerce_structure(c,_) ->
+        either
+          (not_fixpoint path 0) c
+          (first_non_id path 0) c
+    | Tcoerce_functor(arg,res) ->
+        either
+          (transposition_under (InArg::path)) arg
+          (transposition_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
+  (* we search the first point which is not invariant at the current level *)
+  and not_fixpoint path pos = function
+    | [] -> None
+    | (n, _) :: q ->
+        if n = pos then
+          not_fixpoint path (pos+1) q
+        else
+          Some(List.rev path, pos, n)
+  (* we search the first item with a non-identity inner coercion *)
+  and first_non_id path pos = function
+    | [] -> None
+    | (_,Tcoerce_none) :: q -> first_non_id path (pos + 1) q
+    | (_,c) :: q ->
+        either
+          (transposition_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 rec runtime_item k = function
+    | [] -> raise Not_found
+    | item :: q ->
+        if not(is_runtime_component item) then
+          runtime_item k q
+        else if k = 0 then
+          item
+        else
+          runtime_item (k-1) q
+
+  (* Find module type at position [path] and convert the [coerce_pos] path to
+     a [pos] path *)
+  let rec find env ctx path mt = match mt, path with
+    | (Mty_ident p | Mty_alias p), _ ->
+        begin match (Env.find_modtype p env).mtd_type with
+        | None -> raise Not_found
+        | Some mt -> find env ctx path mt
+        end
+    | Mty_signature s , [] -> List.rev ctx, s
+    | Mty_signature s, Item k :: q ->
+        begin match runtime_item k s with
+        | Sig_module (id, _, md,_,_) -> find env (Module id :: ctx) q md.md_type
+        | _ -> raise Not_found
+        end
+    | Mty_functor(Named (_,mt) as arg,_), InArg :: q ->
+        find env (Arg arg :: ctx) q mt
+    | Mty_functor(arg, mt), InBody :: q ->
+        find env (Body arg :: ctx) q mt
+    | _ -> raise Not_found
+
+  let find env path mt = find env [] path mt
+  let item mt k = item_ident_name (runtime_item k mt)
+
+  let pp_item ppf (id,_,kind) =
+    Format.fprintf ppf "%s %S" (kind_of_field_desc kind) (Ident.name id)
+
+  let pp ctx_printer env ppf (mty,c) =
+    try
+      let p, k, l = transposition c in
+      let ctx, mt = find env p mty in
+      Format.fprintf ppf
+        "@[Illegal permutation of runtime components in a module type.@ \
+         @[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
+        "Illegal permutation of runtime components in a module type."
+
+end
+
+open Format
+
+let show_loc msg ppf loc =
+  let pos = loc.Location.loc_start in
+  if List.mem pos.Lexing.pos_fname [""; "_none_"; "//toplevel//"] then ()
+  else fprintf ppf "@\n@[<2>%a:@ %s@]" Location.print_loc loc msg
+
+let show_locs ppf (loc1, loc2) =
+  show_loc "Expected declaration" ppf loc2;
+  show_loc "Actual declaration" ppf loc1
+
+let path_of_context = function
+    Module id :: rem ->
+      let rec subm path = function
+        | [] -> path
+        | Module id :: rem -> subm (Path.Pdot (path, Ident.name id)) rem
+        | _ -> assert false
+      in subm (Path.Pident id) rem
+  | _ -> assert false
+
+
+let rec context ppf = function
+    Module id :: rem ->
+      fprintf ppf "@[<2>module %a%a@]" Printtyp.ident id args rem
+  | Modtype id :: rem ->
+      fprintf ppf "@[<2>module type %a =@ %a@]"
+        Printtyp.ident id context_mty rem
+  | Body x :: rem ->
+      fprintf ppf "functor (%s) ->@ %a" (argname x) context_mty rem
+  | Arg x :: rem ->
+      fprintf ppf "functor (%s : %a) -> ..." (argname x) context_mty rem
+  | [] ->
+      fprintf ppf ""
+and context_mty ppf = function
+    (Module _ | Modtype _) :: _ as rem ->
+      fprintf ppf "@[<2>sig@ %a@;<1 -2>end@]" context rem
+  | cxt -> context ppf cxt
+and args ppf = function
+    Body x :: rem ->
+      fprintf ppf "(%s)%a" (argname x) args rem
+  | Arg x :: rem ->
+      fprintf ppf "(%s :@ %a) : ..." (argname  x) context_mty rem
+  | cxt ->
+      fprintf ppf " :@ %a" context_mty cxt
+and argname = function
+  | Unit -> ""
+  | Named (None, _) -> "_"
+  | Named (Some id, _) -> Ident.name id
+
+let alt_context ppf cxt =
+  if cxt = [] then () else
+  if List.for_all (function Module _ -> true | _ -> false) cxt then
+    fprintf ppf "in module %a,@ " Printtyp.path (path_of_context cxt)
+  else
+    fprintf ppf "@[at position@ %a,@]@ " context cxt
+
+let context ppf cxt =
+  if cxt = [] then () else
+  if List.for_all (function Module _ -> true | _ -> false) cxt then
+    fprintf ppf "In module %a:@ " Printtyp.path (path_of_context cxt)
+  else
+    fprintf ppf "@[At position@ %a@]@ " context cxt
+
+let include_err env ppf = function
+  | Missing_field (id, loc, kind) ->
+      fprintf ppf "The %s `%a' is required but not provided"
+        kind Printtyp.ident id;
+      show_loc "Expected declaration" ppf loc
+  | Value_descriptions(id, d1, d2) ->
+      fprintf ppf
+        "@[Values do not match:@ %a@;<1 -2>is not included in@ %a@]"
+        !Oprint.out_sig_item (Printtyp.tree_of_value_description id d1)
+        !Oprint.out_sig_item (Printtyp.tree_of_value_description id d2);
+      show_locs ppf (d1.val_loc, d2.val_loc)
+  | Type_declarations(id, d1, d2, err) ->
+      fprintf ppf "@[@[%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 d1 Trec_first)
+        "is not included in"
+        !Oprint.out_sig_item
+        (Printtyp.tree_of_type_declaration id d2 Trec_first)
+        (Includecore.report_type_mismatch
+           "the first" "the second" "declaration") err
+        show_locs (d1.type_loc, d2.type_loc)
+  | Extension_constructors(id, x1, x2, err) ->
+      fprintf ppf "@[@[%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 x1 Text_first)
+        "is not included in"
+        !Oprint.out_sig_item
+        (Printtyp.tree_of_extension_constructor id x2 Text_first)
+        (Includecore.report_extension_constructor_mismatch
+           "the first" "the second" "declaration") err
+        show_locs (x1.ext_loc, x2.ext_loc)
+  | Module_types(mty1, mty2)->
+      fprintf ppf
+       "@[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)
+  | Modtype_infos(id, d1, d2) ->
+      fprintf ppf
+       "@[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)
+  | Modtype_permutation (mty,c) ->
+      Illegal_permutation.pp alt_context env ppf (mty,c)
+  | Interface_mismatch(impl_name, intf_name) ->
+      fprintf ppf "@[The implementation %s@ does not match the interface %s:"
+       impl_name intf_name
+  | Class_type_declarations(id, d1, d2, reason) ->
+      fprintf ppf
+       "@[Class type declarations do not match:@ \
+        %a@;<1 -2>does not match@ %a@]@ %a"
+       !Oprint.out_sig_item
+       (Printtyp.tree_of_cltype_declaration id d1 Trec_first)
+       !Oprint.out_sig_item
+       (Printtyp.tree_of_cltype_declaration id d2 Trec_first)
+      Includeclass.report_error reason
+  | Class_declarations(id, d1, d2, reason) ->
+      fprintf ppf
+       "@[Class declarations do not match:@ \
+        %a@;<1 -2>does not match@ %a@]@ %a"
+      !Oprint.out_sig_item (Printtyp.tree_of_class_declaration id d1 Trec_first)
+      !Oprint.out_sig_item (Printtyp.tree_of_class_declaration id d2 Trec_first)
+      Includeclass.report_error reason
+  | Unbound_modtype_path path ->
+      fprintf ppf "Unbound module type %a" Printtyp.path path
+  | Unbound_module_path path ->
+      fprintf ppf "Unbound module %a" Printtyp.path path
+  | Invalid_module_alias path ->
+      fprintf ppf "Module %a cannot be aliased" Printtyp.path path
+
+let include_err ppf (cxt, env, err) =
+  Printtyp.wrap_printing_env ~error:true env (fun () ->
+    fprintf ppf "@[%a%a@]" context (List.rev cxt) (include_err env) err)
+
+let buffer = ref Bytes.empty
+let is_big obj =
+  let size = !Clflags.error_size in
+  size > 0 &&
+  begin
+    if Bytes.length !buffer < size then buffer := Bytes.create size;
+    try ignore (Marshal.to_buffer !buffer 0 size obj []); false
+    with _ -> true
+  end
+
+let report_error ppf errs =
+  if errs = [] then () else
+  let (errs , err) = split_last errs in
+  let pe = ref true in
+  let include_err' ppf (_,_,obj as err) =
+    if not (is_big obj) then fprintf ppf "%a@ " include_err err
+    else if !pe then (fprintf ppf "...@ "; pe := false)
+  in
+  let print_errs ppf = List.iter (include_err' ppf) in
+  Printtyp.Conflicts.reset();
+  fprintf ppf "@[%a%a%t@]" print_errs errs include_err err
+    Printtyp.Conflicts.print_explanations
+
+let report_apply_error p1 p2 ppf errs =
+  fprintf ppf "@[The type of %a does not match %a's parameter@ %a@]"
+    Printtyp.path p1 Printtyp.path p2 report_error errs
+
+(* We could do a better job to split the individual error items
+   as sub-messages of the main interface mismatch on the whole unit. *)
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | Apply_error(loc, p1, p2, err) ->
+          Some (Location.error_of_printer ~loc (report_apply_error p1 p2) err)
+      | _ -> None
+    )
diff --git a/typing/includemod.mli b/typing/includemod.mli
new file mode 100644
index 00000000..855b7863
--- /dev/null
+++ b/typing/includemod.mli
@@ -0,0 +1,93 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Inclusion checks for the module language *)
+
+open Typedtree
+open Types
+open Format
+
+(** 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 *)
+
+val modtypes:
+  loc:Location.t -> Env.t -> mark:mark ->
+  module_type -> module_type -> module_coercion
+
+val strengthened_module_decl:
+  loc:Location.t -> aliasable:bool -> Env.t -> mark:mark ->
+  module_declaration -> Path.t -> module_declaration -> module_coercion
+
+val check_modtype_inclusion :
+  loc:Location.t -> Env.t -> Types.module_type -> Path.t -> Types.module_type ->
+  unit
+(** [check_modtype_inclusion ~loc env mty1 path1 mty2] checks that the
+    functor application F(M) is well typed, where mty2 is the type of
+    the argument of F and path1/mty1 is the path/unstrenghened type of M. *)
+
+val signatures: Env.t -> mark:mark ->
+  signature -> signature -> module_coercion
+
+val compunit:
+      Env.t -> mark:mark -> string -> signature ->
+      string -> signature -> module_coercion
+
+val type_declarations:
+  loc:Location.t -> Env.t -> mark:mark ->
+  Ident.t -> type_declaration -> type_declaration -> unit
+
+val print_coercion: formatter -> module_coercion -> unit
+
+type symptom =
+    Missing_field of Ident.t * Location.t * string (* kind *)
+  | Value_descriptions of Ident.t * value_description * value_description
+  | Type_declarations of Ident.t * type_declaration
+        * type_declaration * Includecore.type_mismatch
+  | Extension_constructors of Ident.t * extension_constructor
+        * extension_constructor * Includecore.extension_constructor_mismatch
+  | Module_types of module_type * module_type
+  | Modtype_infos of Ident.t * modtype_declaration * modtype_declaration
+  | Modtype_permutation of Types.module_type * Typedtree.module_coercion
+  | Interface_mismatch of string * string
+  | Class_type_declarations of
+      Ident.t * class_type_declaration * class_type_declaration *
+      Ctype.class_match_failure list
+  | Class_declarations of
+      Ident.t * class_declaration * class_declaration *
+      Ctype.class_match_failure list
+  | Unbound_modtype_path of Path.t
+  | Unbound_module_path of Path.t
+  | Invalid_module_alias of Path.t
+
+type pos =
+  | Module of Ident.t
+  | Modtype of Ident.t
+  | Arg of functor_parameter
+  | Body of functor_parameter
+type error = pos list * Env.t * symptom
+
+exception Error of error list
+
+val report_error: formatter -> error list -> unit
+val expand_module_alias: Env.t -> pos list -> Path.t -> Types.module_type
diff --git a/typing/mtype.ml b/typing/mtype.ml
new file mode 100644
index 00000000..edb4e1b7
--- /dev/null
+++ b/typing/mtype.ml
@@ -0,0 +1,527 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Operations on module types *)
+
+open Asttypes
+open Path
+open Types
+
+
+let rec scrape env mty =
+  match mty with
+    Mty_ident p ->
+      begin try
+        scrape env (Env.find_modtype_expansion p env)
+      with Not_found ->
+        mty
+      end
+  | _ -> mty
+
+let freshen ~scope mty =
+  Subst.modtype (Rescope scope) Subst.identity mty
+
+let rec strengthen ~aliasable env mty p =
+  match scrape env mty with
+    Mty_signature sg ->
+      Mty_signature(strengthen_sig ~aliasable env sg p)
+  | Mty_functor(Named (Some param, arg), res)
+    when !Clflags.applicative_functors ->
+      Mty_functor(Named (Some param, arg),
+        strengthen ~aliasable:false env res (Papply(p, Pident param)))
+  | Mty_functor(Named (None, arg), res)
+    when !Clflags.applicative_functors ->
+      let param = Ident.create_scoped ~scope:(Path.scope p) "Arg" in
+      Mty_functor(Named (Some param, arg),
+        strengthen ~aliasable:false env res (Papply(p, Pident param)))
+  | mty ->
+      mty
+
+and strengthen_sig ~aliasable env sg p =
+  match sg with
+    [] -> []
+  | (Sig_value(_, _, _) as sigelt) :: rem ->
+      sigelt :: strengthen_sig ~aliasable env rem p
+  | Sig_type(id, {type_kind=Type_abstract}, _, _) ::
+    (Sig_type(id', {type_private=Private}, _, _) :: _ as rem)
+    when Ident.name id = Ident.name id' ^ "#row" ->
+      strengthen_sig ~aliasable env rem p
+  | Sig_type(id, decl, rs, vis) :: rem ->
+      let newdecl =
+        match decl.type_manifest, decl.type_private, decl.type_kind with
+          Some _, Public, _ -> decl
+        | Some _, Private, (Type_record _ | Type_variant _) -> decl
+        | _ ->
+            let manif =
+              Some(Btype.newgenty(Tconstr(Pdot(p, Ident.name id),
+                                          decl.type_params, ref Mnil))) in
+            if decl.type_kind = Type_abstract then
+              { decl with type_private = Public; type_manifest = manif }
+            else
+              { decl with type_manifest = manif }
+      in
+      Sig_type(id, newdecl, rs, vis) :: strengthen_sig ~aliasable env rem p
+  | (Sig_typext _ as sigelt) :: rem ->
+      sigelt :: strengthen_sig ~aliasable env rem p
+  | Sig_module(id, pres, md, rs, vis) :: rem ->
+      let str =
+        strengthen_decl ~aliasable env md (Pdot(p, Ident.name id))
+      in
+      Sig_module(id, pres, str, rs, vis)
+      :: strengthen_sig ~aliasable
+        (Env.add_module_declaration ~check:false id pres md env) rem p
+      (* Need to add the module in case it defines manifest module types *)
+  | Sig_modtype(id, decl, vis) :: rem ->
+      let newdecl =
+        match decl.mtd_type with
+          None ->
+            {decl with mtd_type = Some(Mty_ident(Pdot(p,Ident.name id)))}
+        | Some _ ->
+            decl
+      in
+      Sig_modtype(id, newdecl, vis) ::
+      strengthen_sig ~aliasable (Env.add_modtype id decl env) rem p
+      (* Need to add the module type in case it is manifest *)
+  | (Sig_class _ as sigelt) :: rem ->
+      sigelt :: strengthen_sig ~aliasable env rem p
+  | (Sig_class_type _ as sigelt) :: rem ->
+      sigelt :: strengthen_sig ~aliasable env rem p
+
+and strengthen_decl ~aliasable env md p =
+  match md.md_type with
+  | Mty_alias _ -> md
+  | _ when aliasable -> {md with md_type = Mty_alias p}
+  | mty -> {md with md_type = strengthen ~aliasable env mty p}
+
+let () = Env.strengthen := strengthen
+
+let rec make_aliases_absent pres mty =
+  match mty with
+  | Mty_alias _ -> Mp_absent, mty
+  | Mty_signature sg ->
+      pres, Mty_signature(make_aliases_absent_sig sg)
+  | Mty_functor(arg, res) ->
+      let _, res = make_aliases_absent Mp_present res in
+      pres, Mty_functor(arg, res)
+  | mty ->
+      pres, mty
+
+and make_aliases_absent_sig sg =
+  match sg with
+    [] -> []
+  | Sig_module(id, pres, md, rs, priv) :: rem ->
+      let pres, md_type = make_aliases_absent pres md.md_type in
+      let md = { md with md_type } in
+      Sig_module(id, pres, md, rs, priv) :: make_aliases_absent_sig rem
+  | sigelt :: rem ->
+      sigelt :: make_aliases_absent_sig rem
+
+let scrape_for_type_of env pres mty =
+  let rec loop env path mty =
+    match mty, path with
+    | Mty_alias path, _ -> begin
+        try
+          let md = Env.find_module path env in
+          loop env (Some path) md.md_type
+        with Not_found -> mty
+      end
+    | mty, Some path ->
+        strengthen ~aliasable:false env mty path
+    | _ -> mty
+  in
+  make_aliases_absent pres (loop env None mty)
+
+(* In nondep_supertype, env is only used for the type it assigns to id.
+   Hence there is no need to keep env up-to-date by adding the bindings
+   traversed. *)
+
+type variance = Co | Contra | Strict
+
+let rec nondep_mty_with_presence env va ids pres mty =
+  match mty with
+    Mty_ident p ->
+      begin match Path.find_free_opt ids p with
+      | Some id ->
+          let expansion =
+            try Env.find_modtype_expansion p env
+            with Not_found ->
+              raise (Ctype.Nondep_cannot_erase id)
+          in
+          nondep_mty_with_presence env va ids pres expansion
+      | None -> pres, mty
+      end
+  | Mty_alias p ->
+      begin match Path.find_free_opt ids p with
+      | Some id ->
+          let expansion =
+            try Env.find_module p env
+            with Not_found ->
+              raise (Ctype.Nondep_cannot_erase id)
+          in
+          nondep_mty_with_presence env va ids Mp_present expansion.md_type
+      | None -> pres, mty
+      end
+  | Mty_signature sg ->
+      let mty = Mty_signature(nondep_sig env va ids sg) in
+      pres, mty
+  | Mty_functor(Unit, res) ->
+      pres, Mty_functor(Unit, nondep_mty env va ids res)
+  | Mty_functor(Named (param, arg), res) ->
+      let var_inv =
+        match va with Co -> Contra | Contra -> Co | Strict -> Strict in
+      let res_env =
+        match param with
+        | None -> env
+        | Some param -> Env.add_module ~arg:true param Mp_present arg env
+      in
+      let mty =
+        Mty_functor(Named (param, nondep_mty env var_inv ids arg),
+                    nondep_mty res_env va ids res)
+      in
+      pres, mty
+
+and nondep_mty env va ids mty =
+  snd (nondep_mty_with_presence env va ids Mp_present mty)
+
+and nondep_sig_item env va ids = function
+  | Sig_value(id, d, vis) ->
+      Sig_value(id,
+                {d with val_type = Ctype.nondep_type env ids d.val_type},
+                vis)
+  | Sig_type(id, d, rs, vis) ->
+      Sig_type(id, Ctype.nondep_type_decl env ids (va = Co) d, rs, vis)
+  | Sig_typext(id, ext, es, vis) ->
+      Sig_typext(id, Ctype.nondep_extension_constructor env ids ext, es, vis)
+  | Sig_module(id, pres, md, rs, vis) ->
+      let pres, mty = nondep_mty_with_presence env va ids pres md.md_type in
+      Sig_module(id, pres, {md with md_type = mty}, rs, vis)
+  | Sig_modtype(id, d, vis) ->
+      begin try
+        Sig_modtype(id, nondep_modtype_decl env ids d, vis)
+      with Ctype.Nondep_cannot_erase _ as exn ->
+        match va with
+          Co -> Sig_modtype(id, {mtd_type=None; mtd_loc=Location.none;
+                                 mtd_attributes=[]; mtd_uid = d.mtd_uid}, vis)
+        | _  -> raise exn
+      end
+  | Sig_class(id, d, rs, vis) ->
+      Sig_class(id, Ctype.nondep_class_declaration env ids d, rs, vis)
+  | Sig_class_type(id, d, rs, vis) ->
+      Sig_class_type(id, Ctype.nondep_cltype_declaration env ids d, rs, vis)
+
+and nondep_sig env va ids sg =
+  List.map (nondep_sig_item env va ids) sg
+
+and nondep_modtype_decl env ids mtd =
+  {mtd with mtd_type = Option.map (nondep_mty env Strict ids) mtd.mtd_type}
+
+let nondep_supertype env ids = nondep_mty env Co ids
+let nondep_sig_item env ids = nondep_sig_item env Co ids
+
+let enrich_typedecl env p id decl =
+  match decl.type_manifest with
+    Some _ -> decl
+  | None ->
+      try
+        let orig_decl = Env.find_type p env in
+        if decl.type_arity <> orig_decl.type_arity then
+          decl
+        else
+          let orig_ty =
+            Ctype.reify_univars env
+              (Btype.newgenty(Tconstr(p, orig_decl.type_params, ref Mnil)))
+          in
+          let new_ty =
+            Ctype.reify_univars env
+              (Btype.newgenty(Tconstr(Pident id, decl.type_params, ref Mnil)))
+          in
+          let env = Env.add_type ~check:false id decl env in
+          Ctype.mcomp env orig_ty new_ty;
+          let orig_ty =
+            Btype.newgenty(Tconstr(p, decl.type_params, ref Mnil))
+          in
+          {decl with type_manifest = Some orig_ty}
+      with Not_found | Ctype.Unify _ ->
+        (* - Not_found: type which was not present in the signature, so we don't
+           have anything to do.
+           - Unify: the current declaration is not compatible with the one we
+           got from the signature. We should just fail now, but then, we could
+           also have failed if the arities of the two decls were different,
+           which we didn't. *)
+        decl
+
+let rec enrich_modtype env p mty =
+  match mty with
+    Mty_signature sg ->
+      Mty_signature(List.map (enrich_item env p) sg)
+  | _ ->
+      mty
+
+and enrich_item env p = function
+    Sig_type(id, decl, rs, priv) ->
+      Sig_type(id,
+                enrich_typedecl env (Pdot(p, Ident.name id)) id decl, rs, priv)
+  | Sig_module(id, pres, md, rs, priv) ->
+      Sig_module(id, pres,
+                  {md with
+                   md_type = enrich_modtype env
+                       (Pdot(p, Ident.name id)) md.md_type},
+                 rs,
+                 priv)
+  | item -> item
+
+let rec type_paths env p mty =
+  match scrape env mty with
+    Mty_ident _ -> []
+  | Mty_alias _ -> []
+  | Mty_signature sg -> type_paths_sig env p sg
+  | Mty_functor _ -> []
+
+and type_paths_sig env p sg =
+  match sg with
+    [] -> []
+  | Sig_type(id, _decl, _, _) :: rem ->
+      Pdot(p, Ident.name id) :: type_paths_sig env p rem
+  | Sig_module(id, pres, md, _, _) :: rem ->
+      type_paths env (Pdot(p, Ident.name id)) md.md_type @
+      type_paths_sig (Env.add_module_declaration ~check:false id pres md env)
+        p rem
+  | Sig_modtype(id, decl, _) :: rem ->
+      type_paths_sig (Env.add_modtype id decl env) p rem
+  | (Sig_value _ | Sig_typext _ | Sig_class _ | Sig_class_type _) :: rem ->
+      type_paths_sig env p rem
+
+
+let rec no_code_needed_mod env pres mty =
+  match pres with
+  | Mp_absent -> true
+  | Mp_present -> begin
+      match scrape env mty with
+        Mty_ident _ -> false
+      | Mty_signature sg -> no_code_needed_sig env sg
+      | Mty_functor _ -> false
+      | Mty_alias _ -> false
+    end
+
+and no_code_needed_sig env sg =
+  match sg with
+    [] -> true
+  | Sig_value(_id, decl, _) :: rem ->
+      begin match decl.val_kind with
+      | Val_prim _ -> no_code_needed_sig env rem
+      | _ -> false
+      end
+  | Sig_module(id, pres, md, _, _) :: rem ->
+      no_code_needed_mod env pres md.md_type &&
+      no_code_needed_sig
+        (Env.add_module_declaration ~check:false id pres md env) rem
+  | (Sig_type _ | Sig_modtype _ | Sig_class_type _) :: rem ->
+      no_code_needed_sig env rem
+  | (Sig_typext _ | Sig_class _) :: _ ->
+      false
+
+let no_code_needed env mty = no_code_needed_mod env Mp_present mty
+
+(* Check whether a module type may return types *)
+
+let rec contains_type env = function
+    Mty_ident path ->
+      begin try match (Env.find_modtype path env).mtd_type with
+      | None -> raise Exit (* PR#6427 *)
+      | Some mty -> contains_type env mty
+      with Not_found -> raise Exit
+      end
+  | Mty_signature sg ->
+      contains_type_sig env sg
+  | Mty_functor (_, body) ->
+      contains_type env body
+  | Mty_alias _ ->
+      ()
+
+and contains_type_sig env = List.iter (contains_type_item env)
+
+and contains_type_item env = function
+    Sig_type (_,({type_manifest = None} |
+                 {type_kind = Type_abstract; type_private = Private}),_, _)
+  | Sig_modtype _
+  | Sig_typext (_, {ext_args = Cstr_record _}, _, _) ->
+      (* We consider that extension constructors with an inlined
+         record create a type (the inlined record), even though
+         it would be technically safe to ignore that considering
+         the current constraints which guarantee that this type
+         is kept local to expressions.  *)
+      raise Exit
+  | Sig_module (_, _, {md_type = mty}, _, _) ->
+      contains_type env mty
+  | Sig_value _
+  | Sig_type _
+  | Sig_typext _
+  | Sig_class _
+  | Sig_class_type _ ->
+      ()
+
+let contains_type env mty =
+  try contains_type env mty; false with Exit -> true
+
+
+(* Remove module aliases from a signature *)
+
+let rec get_prefixes = function
+  | Pident _ -> Path.Set.empty
+  | Pdot (p, _)
+  | Papply (p, _) -> Path.Set.add p (get_prefixes p)
+
+let rec get_arg_paths = function
+  | Pident _ -> Path.Set.empty
+  | Pdot (p, _) -> get_arg_paths p
+  | Papply (p1, p2) ->
+      Path.Set.add p2
+        (Path.Set.union (get_prefixes p2)
+           (Path.Set.union (get_arg_paths p1) (get_arg_paths p2)))
+
+let rec rollback_path subst p =
+  try Pident (Path.Map.find p subst)
+  with Not_found ->
+    match p with
+      Pident _ | Papply _ -> p
+    | Pdot (p1, s) ->
+        let p1' = rollback_path subst p1 in
+        if Path.same p1 p1' then p else rollback_path subst (Pdot (p1', s))
+
+let rec collect_ids subst bindings p =
+    begin match rollback_path subst p with
+      Pident id ->
+        let ids =
+          try collect_ids subst bindings (Ident.find_same id bindings)
+          with Not_found -> Ident.Set.empty
+        in
+        Ident.Set.add id ids
+    | _ -> Ident.Set.empty
+    end
+
+let collect_arg_paths mty =
+  let open Btype in
+  let paths = ref Path.Set.empty
+  and subst = ref Path.Map.empty
+  and bindings = ref Ident.empty in
+  (* let rt = Ident.create "Root" in
+     and prefix = ref (Path.Pident rt) 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;
+    match si with
+    | Sig_module (id, _, {md_type=Mty_alias p}, _, _) ->
+        bindings := Ident.add id p !bindings
+    | Sig_module (id, _, {md_type=Mty_signature sg}, _, _) ->
+        List.iter
+          (function Sig_module (id', _, _, _, _) ->
+              subst :=
+                Path.Map.add (Pdot (Pident id, Ident.name id')) id' !subst
+            | _ -> ())
+          sg
+    | _ -> ()
+  in
+  let it = {type_iterators 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
+
+type remove_alias_args =
+    { mutable modified: bool;
+      exclude: Ident.t -> Path.t -> bool;
+      scrape: Env.t -> module_type -> module_type }
+
+let rec remove_aliases_mty env args pres mty =
+  let args' = {args with modified = false} in
+  let res =
+    match args.scrape env mty with
+      Mty_signature sg ->
+        Mp_present, Mty_signature (remove_aliases_sig env args' sg)
+    | Mty_alias _ ->
+        let mty' = Env.scrape_alias env mty in
+        if mty' = mty then begin
+          pres, mty
+        end else begin
+          args'.modified <- true;
+          remove_aliases_mty env args' Mp_present mty'
+        end
+    | mty ->
+        Mp_present, mty
+  in
+  if args'.modified then begin
+    args.modified <- true;
+    res
+  end else begin
+    pres, mty
+  end
+
+and remove_aliases_sig env args sg =
+  match sg with
+    [] -> []
+  | Sig_module(id, pres, md, rs, priv) :: rem  ->
+      let pres, mty =
+        match md.md_type with
+          Mty_alias p when args.exclude id p ->
+            pres, md.md_type
+        | mty ->
+            remove_aliases_mty env args pres mty
+      in
+      Sig_module(id, pres, {md with md_type = mty} , rs, priv) ::
+      remove_aliases_sig (Env.add_module id pres mty env) args rem
+  | Sig_modtype(id, mtd, priv) :: rem ->
+      Sig_modtype(id, mtd, priv) ::
+      remove_aliases_sig (Env.add_modtype id mtd env) args rem
+  | it :: rem ->
+      it :: remove_aliases_sig env args rem
+
+let scrape_for_functor_arg env mty =
+  let exclude _id p =
+    try ignore (Env.find_module p env); true with Not_found -> false
+  in
+  let _, mty =
+    remove_aliases_mty env {modified=false; exclude; scrape} Mp_present mty
+  in
+  mty
+
+let scrape_for_type_of ~remove_aliases env mty =
+  if remove_aliases then begin
+    let excl = collect_arg_paths mty in
+    let exclude id _p = Ident.Set.mem id excl in
+    let scrape _ mty = mty in
+    let _, mty =
+      remove_aliases_mty env {modified=false; exclude; scrape} Mp_present mty
+    in
+    mty
+  end else begin
+    let _, mty = scrape_for_type_of env Mp_present mty in
+    mty
+  end
+
+(* Lower non-generalizable type variables *)
+
+let lower_nongen nglev mty =
+  let open Btype in
+  let it_type_expr it ty =
+    let ty = repr ty in
+    match ty with
+      {desc=Tvar _; level} ->
+        if level < generic_level && level > nglev then set_level ty nglev
+    | _ ->
+        type_iterators.it_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
diff --git a/typing/mtype.mli b/typing/mtype.mli
new file mode 100644
index 00000000..68d290b3
--- /dev/null
+++ b/typing/mtype.mli
@@ -0,0 +1,55 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Operations on module types *)
+
+open Types
+
+val scrape: Env.t -> module_type -> module_type
+        (* Expand toplevel module type abbreviations
+           till hitting a "hard" module type (signature, functor,
+           or abstract module type ident. *)
+val scrape_for_functor_arg: Env.t -> module_type -> module_type
+        (* Remove aliases in a functor argument type *)
+val scrape_for_type_of:
+  remove_aliases:bool -> Env.t -> module_type -> module_type
+        (* Process type for module type of *)
+val freshen: scope:int -> module_type -> module_type
+        (* Return an alpha-equivalent copy of the given module type
+           where bound identifiers are fresh. *)
+val strengthen: aliasable:bool -> Env.t -> module_type -> Path.t -> module_type
+        (* Strengthen abstract type components relative to the
+           given path. *)
+val strengthen_decl:
+  aliasable:bool -> Env.t -> module_declaration -> Path.t -> module_declaration
+val nondep_supertype: Env.t -> Ident.t list -> module_type -> module_type
+        (* Return the smallest supertype of the given type
+           in which none of the given idents appears.
+           @raise [Ctype.Nondep_cannot_erase] if no such type exists. *)
+val nondep_sig_item: Env.t -> Ident.t list -> signature_item -> signature_item
+        (* Returns the signature item with its type updated
+           to be the smallest supertype of its initial type
+           in which none of the given idents appears.
+           @raise [Ctype.Nondep_cannot_erase] if no such type exists. *)
+val no_code_needed: Env.t -> module_type -> bool
+val no_code_needed_sig: Env.t -> signature -> bool
+        (* Determine whether a module needs no implementation code,
+           i.e. consists only of type definitions. *)
+val enrich_modtype: Env.t -> Path.t -> module_type -> module_type
+val enrich_typedecl: Env.t -> Path.t -> Ident.t -> type_declaration ->
+  type_declaration
+val type_paths: Env.t -> Path.t -> module_type -> Path.t list
+val contains_type: Env.t -> module_type -> bool
+val lower_nongen: int -> module_type -> unit
diff --git a/typing/oprint.ml b/typing/oprint.ml
new file mode 100644
index 00000000..bf6f5f90
--- /dev/null
+++ b/typing/oprint.ml
@@ -0,0 +1,820 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Projet Cristal, INRIA Rocquencourt                   *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Format
+open Outcometree
+
+exception Ellipsis
+
+let cautious f ppf arg =
+  try f ppf arg with
+    Ellipsis -> fprintf ppf "..."
+
+let print_lident ppf = function
+  | "::" -> pp_print_string ppf "(::)"
+  | s -> pp_print_string ppf s
+
+let rec print_ident ppf =
+  function
+    Oide_ident s -> print_lident ppf s.printed_name
+  | Oide_dot (id, s) ->
+      print_ident ppf id; pp_print_char ppf '.'; print_lident ppf s
+  | Oide_apply (id1, id2) ->
+      fprintf ppf "%a(%a)" print_ident id1 print_ident id2
+
+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)
+
+let value_ident ppf name =
+  if parenthesized_ident name then
+    fprintf ppf "( %s )" name
+  else
+    pp_print_string ppf name
+
+(* Values *)
+
+let valid_float_lexeme s =
+  let l = String.length s in
+  let rec loop i =
+    if i >= l then s ^ "." else
+    match s.[i] with
+    | '0' .. '9' | '-' -> loop (i+1)
+    | _ -> s
+  in loop 0
+
+let float_repres f =
+  match classify_float f with
+    FP_nan -> "nan"
+  | FP_infinite ->
+      if f < 0.0 then "neg_infinity" else "infinity"
+  | _ ->
+      let float_val =
+        let s1 = Printf.sprintf "%.12g" f in
+        if f = float_of_string s1 then s1 else
+        let s2 = Printf.sprintf "%.15g" f in
+        if f = float_of_string s2 then s2 else
+        Printf.sprintf "%.18g" f
+      in valid_float_lexeme float_val
+
+let parenthesize_if_neg ppf fmt v isneg =
+  if isneg then pp_print_char ppf '(';
+  fprintf ppf fmt v;
+  if isneg then pp_print_char ppf ')'
+
+let escape_string s =
+  (* Escape only C0 control characters (bytes <= 0x1F), DEL(0x7F), '\\'
+     and '"' *)
+   let n = ref 0 in
+  for i = 0 to String.length s - 1 do
+    n := !n +
+      (match String.unsafe_get s i with
+       | '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
+       | '\x00' .. '\x1F'
+       | '\x7F' -> 4
+       | _ -> 1)
+  done;
+  if !n = String.length s then s else begin
+    let s' = Bytes.create !n in
+    n := 0;
+    for i = 0 to String.length s - 1 do
+      begin match String.unsafe_get s i with
+      | ('\"' | '\\') as c ->
+          Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n c
+      | '\n' ->
+          Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'n'
+      | '\t' ->
+          Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 't'
+      | '\r' ->
+          Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'r'
+      | '\b' ->
+          Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'b'
+      | '\x00' .. '\x1F' | '\x7F' as c ->
+          let a = Char.code c in
+          Bytes.unsafe_set s' !n '\\';
+          incr n;
+          Bytes.unsafe_set s' !n (Char.chr (48 + a / 100));
+          incr n;
+          Bytes.unsafe_set s' !n (Char.chr (48 + (a / 10) mod 10));
+          incr n;
+          Bytes.unsafe_set s' !n (Char.chr (48 + a mod 10));
+      | c -> Bytes.unsafe_set s' !n c
+      end;
+      incr n
+    done;
+    Bytes.to_string s'
+  end
+
+
+let print_out_string ppf s =
+  let not_escaped =
+    (* let the user dynamically choose if strings should be escaped: *)
+    match Sys.getenv_opt "OCAMLTOP_UTF_8" with
+    | None -> true
+    | Some x ->
+        match bool_of_string_opt x with
+        | None -> true
+        | Some f -> f in
+  if not_escaped then
+    fprintf ppf "\"%s\"" (escape_string s)
+  else
+    fprintf ppf "%S" s
+
+let print_out_value ppf tree =
+  let rec print_tree_1 ppf =
+    function
+    | Oval_constr (name, [param]) ->
+        fprintf ppf "@[<1>%a@ %a@]" print_ident name print_constr_param param
+    | Oval_constr (name, (_ :: _ as params)) ->
+        fprintf ppf "@[<1>%a@ (%a)@]" print_ident name
+          (print_tree_list print_tree_1 ",") params
+    | Oval_variant (name, Some param) ->
+        fprintf ppf "@[<2>`%s@ %a@]" name print_constr_param param
+    | tree -> print_simple_tree ppf tree
+  and print_constr_param ppf = function
+    | Oval_int i -> parenthesize_if_neg ppf "%i" i (i < 0)
+    | Oval_int32 i -> parenthesize_if_neg ppf "%lil" i (i < 0l)
+    | Oval_int64 i -> parenthesize_if_neg ppf "%LiL" i (i < 0L)
+    | Oval_nativeint i -> parenthesize_if_neg ppf "%nin" i (i < 0n)
+    | Oval_float f ->
+        parenthesize_if_neg ppf "%s" (float_repres f)
+                                     (f < 0.0 || 1. /. f = neg_infinity)
+    | Oval_string (_,_, Ostr_bytes) as tree ->
+      pp_print_char ppf '(';
+      print_simple_tree ppf tree;
+      pp_print_char ppf ')';
+    | tree -> print_simple_tree ppf tree
+  and print_simple_tree ppf =
+    function
+      Oval_int i -> fprintf ppf "%i" i
+    | Oval_int32 i -> fprintf ppf "%lil" i
+    | Oval_int64 i -> fprintf ppf "%LiL" i
+    | Oval_nativeint i -> fprintf ppf "%nin" i
+    | Oval_float f -> pp_print_string ppf (float_repres f)
+    | Oval_char c -> fprintf ppf "%C" c
+    | Oval_string (s, maxlen, kind) ->
+       begin try
+         let len = String.length s in
+         let s = if len > maxlen then String.sub s 0 maxlen else s in
+         begin match kind with
+         | Ostr_bytes -> fprintf ppf "Bytes.of_string %S" s
+         | Ostr_string -> print_out_string ppf s
+         end;
+         (if len > maxlen then
+            fprintf ppf
+              "... (* string length %d; truncated *)" len
+         )
+          with
+          Invalid_argument _ (* "String.create" *)-> fprintf ppf ""
+        end
+    | Oval_list tl ->
+        fprintf ppf "@[<1>[%a]@]" (print_tree_list print_tree_1 ";") tl
+    | Oval_array tl ->
+        fprintf ppf "@[<2>[|%a|]@]" (print_tree_list print_tree_1 ";") tl
+    | Oval_constr (name, []) -> print_ident ppf name
+    | Oval_variant (name, None) -> fprintf ppf "`%s" name
+    | Oval_stuff s -> pp_print_string ppf s
+    | Oval_record fel ->
+        fprintf ppf "@[<1>{%a}@]" (cautious (print_fields true)) fel
+    | Oval_ellipsis -> raise Ellipsis
+    | Oval_printer f -> f ppf
+    | Oval_tuple tree_list ->
+        fprintf ppf "@[<1>(%a)@]" (print_tree_list print_tree_1 ",") tree_list
+    | tree -> fprintf ppf "@[<1>(%a)@]" (cautious print_tree_1) tree
+  and print_fields first ppf =
+    function
+      [] -> ()
+    | (name, tree) :: fields ->
+        if not first then fprintf ppf ";@ ";
+        fprintf ppf "@[<1>%a@ =@ %a@]" print_ident name (cautious print_tree_1)
+          tree;
+        print_fields false ppf fields
+  and print_tree_list print_item sep ppf tree_list =
+    let rec print_list first ppf =
+      function
+        [] -> ()
+      | tree :: tree_list ->
+          if not first then fprintf ppf "%s@ " sep;
+          print_item ppf tree;
+          print_list false ppf tree_list
+    in
+    cautious (print_list true) ppf tree_list
+  in
+  cautious print_tree_1 ppf tree
+
+let out_value = ref print_out_value
+
+(* Types *)
+
+let rec print_list_init pr sep ppf =
+  function
+    [] -> ()
+  | a :: l -> sep ppf; pr ppf a; print_list_init pr sep ppf l
+
+let rec print_list pr sep ppf =
+  function
+    [] -> ()
+  | [a] -> pr ppf a
+  | a :: l -> pr ppf a; sep ppf; print_list pr sep ppf l
+
+let pr_present =
+  print_list (fun ppf s -> fprintf ppf "`%s" s) (fun ppf -> fprintf ppf "@ ")
+
+let pr_var = Pprintast.tyvar
+
+let pr_vars =
+  print_list pr_var (fun ppf -> fprintf ppf "@ ")
+
+let rec print_out_type ppf =
+  function
+  | Otyp_alias (ty, s) ->
+      fprintf ppf "@[%a@ as %a@]" print_out_type ty pr_var s
+  | Otyp_poly (sl, ty) ->
+      fprintf ppf "@[%a.@ %a@]"
+        pr_vars sl
+        print_out_type ty
+  | ty ->
+      print_out_type_1 ppf ty
+
+and print_out_type_1 ppf =
+  function
+    Otyp_arrow (lab, ty1, ty2) ->
+      pp_open_box ppf 0;
+      if lab <> "" then (pp_print_string ppf lab; pp_print_char ppf ':');
+      print_out_type_2 ppf ty1;
+      pp_print_string ppf " ->";
+      pp_print_space ppf ();
+      print_out_type_1 ppf ty2;
+      pp_close_box ppf ()
+  | ty -> print_out_type_2 ppf ty
+and print_out_type_2 ppf =
+  function
+    Otyp_tuple tyl ->
+      fprintf ppf "@[<0>%a@]" (print_typlist print_simple_out_type " *") tyl
+  | ty -> print_simple_out_type ppf ty
+and print_simple_out_type ppf =
+  function
+    Otyp_class (ng, id, tyl) ->
+      fprintf ppf "@[%a%s#%a@]" print_typargs tyl (if ng then "_" else "")
+        print_ident id
+  | Otyp_constr (id, tyl) ->
+      pp_open_box ppf 0;
+      print_typargs ppf tyl;
+      print_ident ppf id;
+      pp_close_box ppf ()
+  | Otyp_object (fields, rest) ->
+      fprintf ppf "@[<2>< %a >@]" (print_fields rest) fields
+  | Otyp_stuff s -> pp_print_string ppf s
+  | Otyp_var (ng, s) -> pr_var ppf (if ng then "_" ^ s else s)
+  | Otyp_variant (non_gen, row_fields, closed, tags) ->
+      let print_present ppf =
+        function
+          None | Some [] -> ()
+        | Some l -> fprintf ppf "@;<1 -2>> @[%a@]" pr_present l
+      in
+      let print_fields ppf =
+        function
+          Ovar_fields fields ->
+            print_list print_row_field (fun ppf -> fprintf ppf "@;<1 -2>| ")
+              ppf fields
+        | Ovar_typ typ ->
+           print_simple_out_type ppf typ
+      in
+      fprintf ppf "%s@[[%s@[@[%a@]%a@]@ ]@]"
+        (if non_gen then "_" else "")
+        (if closed then if tags = None then " " else "< "
+         else if tags = None then "> " else "? ")
+        print_fields row_fields
+        print_present tags
+  | Otyp_alias _ | Otyp_poly _ | Otyp_arrow _ | Otyp_tuple _ as ty ->
+      pp_open_box ppf 1;
+      pp_print_char ppf '(';
+      print_out_type ppf ty;
+      pp_print_char ppf ')';
+      pp_close_box ppf ()
+  | Otyp_abstract | Otyp_open
+  | Otyp_sum _ | Otyp_manifest (_, _) -> ()
+  | Otyp_record lbls -> print_record_decl ppf lbls
+  | Otyp_module (p, n, tyl) ->
+      fprintf ppf "@[<1>(module %a" print_ident p;
+      let first = ref true in
+      List.iter2
+        (fun s t ->
+          let sep = if !first then (first := false; "with") else "and" in
+          fprintf ppf " %s type %s = %a" sep s print_out_type t
+        )
+        n tyl;
+      fprintf ppf ")@]"
+  | Otyp_attribute (t, attr) ->
+      fprintf ppf "@[<1>(%a [@@%s])@]" print_out_type t attr.oattr_name
+and print_record_decl ppf lbls =
+  fprintf ppf "{%a@;<1 -2>}"
+    (print_list_init print_out_label (fun ppf -> fprintf ppf "@ ")) lbls
+and print_fields rest ppf =
+  function
+    [] ->
+      begin match rest with
+        Some non_gen -> fprintf ppf "%s.." (if non_gen then "_" else "")
+      | None -> ()
+      end
+  | [s, t] ->
+      fprintf ppf "%s : %a" s print_out_type t;
+      begin match rest with
+        Some _ -> fprintf ppf ";@ "
+      | None -> ()
+      end;
+      print_fields rest ppf []
+  | (s, t) :: l ->
+      fprintf ppf "%s : %a;@ %a" s print_out_type t (print_fields rest) l
+and print_row_field ppf (l, opt_amp, tyl) =
+  let pr_of ppf =
+    if opt_amp then fprintf ppf " of@ &@ "
+    else if tyl <> [] then fprintf ppf " of@ "
+    else fprintf ppf ""
+  in
+  fprintf ppf "@[`%s%t%a@]" l pr_of (print_typlist print_out_type " &")
+    tyl
+and print_typlist print_elem sep ppf =
+  function
+    [] -> ()
+  | [ty] -> print_elem ppf ty
+  | ty :: tyl ->
+      print_elem ppf ty;
+      pp_print_string ppf sep;
+      pp_print_space ppf ();
+      print_typlist print_elem sep ppf tyl
+and print_typargs ppf =
+  function
+    [] -> ()
+  | [ty1] -> print_simple_out_type ppf ty1; pp_print_space ppf ()
+  | tyl ->
+      pp_open_box ppf 1;
+      pp_print_char ppf '(';
+      print_typlist print_out_type "," ppf tyl;
+      pp_print_char ppf ')';
+      pp_close_box ppf ();
+      pp_print_space ppf ()
+and print_out_label ppf (name, mut, arg) =
+  fprintf ppf "@[<2>%s%s :@ %a@];" (if mut then "mutable " else "") name
+    print_out_type arg
+
+let out_label = ref print_out_label
+
+let out_type = ref print_out_type
+
+(* Class types *)
+
+let print_type_parameter ppf s =
+  if s = "_" then fprintf ppf "_" else pr_var ppf s
+
+let type_parameter ppf (ty, (co, cn)) =
+  fprintf ppf "%s%a"
+    (if not cn then "+" else if not co then "-" else "")
+    print_type_parameter ty
+
+let print_out_class_params ppf =
+  function
+    [] -> ()
+  | tyl ->
+      fprintf ppf "@[<1>[%a]@]@ "
+        (print_list type_parameter (fun ppf -> fprintf ppf ", "))
+        tyl
+
+let rec print_out_class_type ppf =
+  function
+    Octy_constr (id, tyl) ->
+      let pr_tyl ppf =
+        function
+          [] -> ()
+        | tyl ->
+            fprintf ppf "@[<1>[%a]@]@ " (print_typlist !out_type ",") tyl
+      in
+      fprintf ppf "@[%a%a@]" pr_tyl tyl print_ident id
+  | Octy_arrow (lab, ty, cty) ->
+      fprintf ppf "@[%s%a ->@ %a@]" (if lab <> "" then lab ^ ":" else "")
+        print_out_type_2 ty print_out_class_type cty
+  | Octy_signature (self_ty, csil) ->
+      let pr_param ppf =
+        function
+          Some ty -> fprintf ppf "@ @[(%a)@]" !out_type ty
+        | None -> ()
+      in
+      fprintf ppf "@[@[<2>object%a@]@ %a@;<1 -2>end@]" pr_param self_ty
+        (print_list print_out_class_sig_item (fun ppf -> fprintf ppf "@ "))
+        csil
+and print_out_class_sig_item ppf =
+  function
+    Ocsg_constraint (ty1, ty2) ->
+      fprintf ppf "@[<2>constraint %a =@ %a@]" !out_type ty1
+        !out_type ty2
+  | Ocsg_method (name, priv, virt, ty) ->
+      fprintf ppf "@[<2>method %s%s%s :@ %a@]"
+        (if priv then "private " else "") (if virt then "virtual " else "")
+        name !out_type ty
+  | Ocsg_value (name, mut, vr, ty) ->
+      fprintf ppf "@[<2>val %s%s%s :@ %a@]"
+        (if mut then "mutable " else "")
+        (if vr then "virtual " else "")
+        name !out_type ty
+
+let out_class_type = ref print_out_class_type
+
+(* Signature *)
+
+let out_module_type = ref (fun _ -> failwith "Oprint.out_module_type")
+let out_sig_item = ref (fun _ -> failwith "Oprint.out_sig_item")
+let out_signature = ref (fun _ -> failwith "Oprint.out_signature")
+let out_type_extension = ref (fun _ -> failwith "Oprint.out_type_extension")
+
+(* For anonymous functor arguments, the logic to choose between
+   the long-form
+     functor (_ : S) -> ...
+   and the short-form
+     S -> ...
+   is as follows: if we are already printing long-form functor arguments,
+   we use the long form unless all remaining functor arguments can use
+   the short form. (Otherwise use the short form.)
+
+   For example,
+     functor (X : S1) (_ : S2) (Y : S3) (_ : S4) (_ : S5) -> sig end
+   will get printed as
+     functor (X : S1) (_ : S2) (Y : S3) -> S4 -> S5 -> sig end
+
+   but
+     functor (_ : S1) (_ : S2) (Y : S3) (_ : S4) (_ : S5) -> sig end
+   gets printed as
+     S1 -> S2 -> functor (Y : S3) -> S4 -> S5 -> sig end
+*)
+
+(* take a module type that may be a functor type,
+   and return the longest prefix list of arguments
+   that should be printed in long form. *)
+let collect_functor_arguments mty =
+  let rec collect_args acc = function
+    | Omty_functor (param, mty_res) ->
+       collect_args (param :: acc) mty_res
+    | non_functor -> (acc, non_functor)
+  in
+  let rec uncollect_anonymous_suffix acc rest = match acc with
+      | Some (None, mty_arg) :: acc ->
+          uncollect_anonymous_suffix acc
+            (Omty_functor (Some (None, mty_arg), rest))
+      | _ :: _ | [] ->
+         (acc, rest)
+  in
+  let (acc, non_functor) = collect_args [] mty in
+  let (acc, rest) = uncollect_anonymous_suffix acc non_functor in
+  (List.rev acc, rest)
+
+let rec print_out_module_type ppf mty =
+  print_out_functor ppf mty
+and print_out_functor ppf = function
+  | Omty_functor _ as t ->
+     let rec print_functor ppf = function
+       | Omty_functor (Some (None, mty_arg), mty_res) ->
+          fprintf ppf "%a ->@ %a"
+            print_simple_out_module_type mty_arg
+            print_functor mty_res
+       | Omty_functor _ as non_anonymous_functor ->
+          let (args, rest) = collect_functor_arguments non_anonymous_functor in
+          let print_arg ppf = function
+            | None ->
+               fprintf ppf "()"
+            | Some (param, mty) ->
+               fprintf ppf "(%s : %a)"
+                 (Option.value param ~default:"_")
+                 print_out_module_type mty
+          in
+          fprintf ppf "@[<2>functor@ %a@]@ ->@ %a"
+            (pp_print_list ~pp_sep:pp_print_space print_arg) args
+            print_functor rest
+       | non_functor ->
+          print_simple_out_module_type ppf non_functor
+     in
+     fprintf ppf "@[<2>%a@]" print_functor t
+  | t -> print_simple_out_module_type ppf t
+and print_simple_out_module_type ppf =
+  function
+    Omty_abstract -> ()
+  | Omty_ident id -> fprintf ppf "%a" print_ident id
+  | Omty_signature sg ->
+     begin match sg with
+       | [] -> fprintf ppf "sig end"
+       | sg ->
+          fprintf ppf "@[sig@ %a@;<1 -2>end@]" print_out_signature sg
+     end
+  | Omty_alias id -> fprintf ppf "(module %a)" print_ident id
+  | Omty_functor _ as non_simple ->
+     fprintf ppf "(%a)" print_out_module_type non_simple
+and print_out_signature ppf =
+  function
+    [] -> ()
+  | [item] -> !out_sig_item ppf item
+  | Osig_typext(ext, Oext_first) :: items ->
+      (* Gather together the extension constructors *)
+      let rec gather_extensions acc items =
+        match items with
+            Osig_typext(ext, Oext_next) :: items ->
+              gather_extensions
+                ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc)
+                items
+          | _ -> (List.rev acc, items)
+      in
+      let exts, items =
+        gather_extensions
+          [(ext.oext_name, ext.oext_args, ext.oext_ret_type)]
+          items
+      in
+      let te =
+        { otyext_name = ext.oext_type_name;
+          otyext_params = ext.oext_type_params;
+          otyext_constructors = exts;
+          otyext_private = ext.oext_private }
+      in
+        fprintf ppf "%a@ %a" !out_type_extension te print_out_signature items
+  | item :: items ->
+      fprintf ppf "%a@ %a" !out_sig_item item print_out_signature items
+and print_out_sig_item ppf =
+  function
+    Osig_class (vir_flag, name, params, clt, rs) ->
+      fprintf ppf "@[<2>%s%s@ %a%s@ :@ %a@]"
+        (if rs = Orec_next then "and" else "class")
+        (if vir_flag then " virtual" else "") print_out_class_params params
+        name !out_class_type clt
+  | Osig_class_type (vir_flag, name, params, clt, rs) ->
+      fprintf ppf "@[<2>%s%s@ %a%s@ =@ %a@]"
+        (if rs = Orec_next then "and" else "class type")
+        (if vir_flag then " virtual" else "") print_out_class_params params
+        name !out_class_type clt
+  | Osig_typext (ext, Oext_exception) ->
+      fprintf ppf "@[<2>exception %a@]"
+        print_out_constr (ext.oext_name, ext.oext_args, ext.oext_ret_type)
+  | Osig_typext (ext, _es) ->
+      print_out_extension_constructor ppf ext
+  | Osig_modtype (name, Omty_abstract) ->
+      fprintf ppf "@[<2>module type %s@]" name
+  | Osig_modtype (name, mty) ->
+      fprintf ppf "@[<2>module type %s =@ %a@]" name !out_module_type mty
+  | Osig_module (name, Omty_alias id, _) ->
+      fprintf ppf "@[<2>module %s =@ %a@]" name print_ident id
+  | Osig_module (name, mty, rs) ->
+      fprintf ppf "@[<2>%s %s :@ %a@]"
+        (match rs with Orec_not -> "module"
+                     | Orec_first -> "module rec"
+                     | Orec_next -> "and")
+        name !out_module_type mty
+  | Osig_type(td, rs) ->
+        print_out_type_decl
+          (match rs with
+           | Orec_not   -> "type nonrec"
+           | Orec_first -> "type"
+           | Orec_next  -> "and")
+          ppf td
+  | Osig_value vd ->
+      let kwd = if vd.oval_prims = [] then "val" else "external" in
+      let pr_prims ppf =
+        function
+          [] -> ()
+        | s :: sl ->
+            fprintf ppf "@ = \"%s\"" s;
+            List.iter (fun s -> fprintf ppf "@ \"%s\"" s) sl
+      in
+      fprintf ppf "@[<2>%s %a :@ %a%a%a@]" kwd value_ident vd.oval_name
+        !out_type vd.oval_type pr_prims vd.oval_prims
+        (fun ppf -> List.iter (fun a -> fprintf ppf "@ [@@@@%s]" a.oattr_name))
+        vd.oval_attributes
+  | Osig_ellipsis ->
+      fprintf ppf "..."
+
+and print_out_type_decl kwd ppf td =
+  let print_constraints ppf =
+    List.iter
+      (fun (ty1, ty2) ->
+         fprintf ppf "@ @[<2>constraint %a =@ %a@]" !out_type ty1
+           !out_type ty2)
+      td.otype_cstrs
+  in
+  let type_defined ppf =
+    match td.otype_params with
+      [] -> pp_print_string ppf td.otype_name
+    | [param] -> fprintf ppf "@[%a@ %s@]" type_parameter param td.otype_name
+    | _ ->
+        fprintf ppf "@[(@[%a)@]@ %s@]"
+          (print_list type_parameter (fun ppf -> fprintf ppf ",@ "))
+          td.otype_params
+          td.otype_name
+  in
+  let print_manifest ppf =
+    function
+      Otyp_manifest (ty, _) -> fprintf ppf " =@ %a" !out_type ty
+    | _ -> ()
+  in
+  let print_name_params ppf =
+    fprintf ppf "%s %t%a" kwd type_defined print_manifest td.otype_type
+  in
+  let ty =
+    match td.otype_type with
+      Otyp_manifest (_, ty) -> ty
+    | _ -> td.otype_type
+  in
+  let print_private ppf = function
+    Asttypes.Private -> fprintf ppf " private"
+  | Asttypes.Public -> ()
+  in
+  let print_immediate ppf =
+    match td.otype_immediate with
+    | Unknown -> ()
+    | Always -> fprintf ppf " [%@%@immediate]"
+    | Always_on_64bits -> fprintf ppf " [%@%@immediate64]"
+  in
+  let print_unboxed ppf =
+    if td.otype_unboxed then fprintf ppf " [%@%@unboxed]" else ()
+  in
+  let print_out_tkind ppf = function
+  | Otyp_abstract -> ()
+  | Otyp_record lbls ->
+      fprintf ppf " =%a %a"
+        print_private td.otype_private
+        print_record_decl lbls
+  | Otyp_sum constrs ->
+      let variants fmt constrs =
+        if constrs = [] then fprintf fmt "|" else
+        fprintf fmt "%a" (print_list print_out_constr
+          (fun ppf -> fprintf ppf "@ | ")) constrs in
+      fprintf ppf " =%a@;<1 2>%a"
+        print_private td.otype_private variants constrs
+  | Otyp_open ->
+      fprintf ppf " =%a .."
+        print_private td.otype_private
+  | ty ->
+      fprintf ppf " =%a@;<1 2>%a"
+        print_private td.otype_private
+        !out_type ty
+  in
+  fprintf ppf "@[<2>@[%t%a@]%t%t%t@]"
+    print_name_params
+    print_out_tkind ty
+    print_constraints
+    print_immediate
+    print_unboxed
+
+and print_out_constr ppf (name, tyl,ret_type_opt) =
+  let name =
+    match name with
+    | "::" -> "(::)"   (* #7200 *)
+    | s -> s
+  in
+  match ret_type_opt with
+  | None ->
+      begin match tyl with
+      | [] ->
+          pp_print_string ppf name
+      | _ ->
+          fprintf ppf "@[<2>%s of@ %a@]" name
+            (print_typlist print_simple_out_type " *") tyl
+      end
+  | Some ret_type ->
+      begin match tyl with
+      | [] ->
+          fprintf ppf "@[<2>%s :@ %a@]" name print_simple_out_type  ret_type
+      | _ ->
+          fprintf ppf "@[<2>%s :@ %a -> %a@]" name
+            (print_typlist print_simple_out_type " *")
+            tyl print_simple_out_type ret_type
+      end
+
+and print_out_extension_constructor ppf ext =
+  let print_extended_type ppf =
+      match ext.oext_type_params with
+        [] -> fprintf ppf "%s" ext.oext_type_name
+      | [ty_param] ->
+        fprintf ppf "@[%a@ %s@]"
+          print_type_parameter
+          ty_param
+          ext.oext_type_name
+      | _ ->
+        fprintf ppf "@[(@[%a)@]@ %s@]"
+          (print_list print_type_parameter (fun ppf -> fprintf ppf ",@ "))
+          ext.oext_type_params
+          ext.oext_type_name
+  in
+  fprintf ppf "@[type %t +=%s@;<1 2>%a@]"
+    print_extended_type
+    (if ext.oext_private = Asttypes.Private then " private" else "")
+    print_out_constr (ext.oext_name, ext.oext_args, ext.oext_ret_type)
+
+and print_out_type_extension ppf te =
+  let print_extended_type ppf =
+    match te.otyext_params with
+      [] -> fprintf ppf "%s" te.otyext_name
+    | [param] ->
+      fprintf ppf "@[%a@ %s@]"
+        print_type_parameter param
+        te.otyext_name
+    | _ ->
+        fprintf ppf "@[(@[%a)@]@ %s@]"
+          (print_list print_type_parameter (fun ppf -> fprintf ppf ",@ "))
+          te.otyext_params
+          te.otyext_name
+  in
+  fprintf ppf "@[type %t +=%s@;<1 2>%a@]"
+    print_extended_type
+    (if te.otyext_private = Asttypes.Private then " private" else "")
+    (print_list print_out_constr (fun ppf -> fprintf ppf "@ | "))
+    te.otyext_constructors
+
+let out_constr = ref print_out_constr
+let _ = out_module_type := print_out_module_type
+let _ = out_signature := print_out_signature
+let _ = out_sig_item := print_out_sig_item
+let _ = out_type_extension := print_out_type_extension
+
+(* Phrases *)
+
+let print_out_exception ppf exn outv =
+  match exn with
+    Sys.Break -> fprintf ppf "Interrupted.@."
+  | Out_of_memory -> fprintf ppf "Out of memory during evaluation.@."
+  | Stack_overflow ->
+      fprintf ppf "Stack overflow during evaluation (looping recursion?).@."
+  | _ -> match Printexc.use_printers exn with
+        | None -> fprintf ppf "@[Exception:@ %a.@]@." !out_value outv
+        | Some s -> fprintf ppf "@[Exception:@ %s@]@." s
+
+let rec print_items ppf =
+  function
+    [] -> ()
+  | (Osig_typext(ext, Oext_first), None) :: items ->
+      (* Gather together extension constructors *)
+      let rec gather_extensions acc items =
+        match items with
+            (Osig_typext(ext, Oext_next), None) :: items ->
+              gather_extensions
+                ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc)
+                items
+          | _ -> (List.rev acc, items)
+      in
+      let exts, items =
+        gather_extensions
+          [(ext.oext_name, ext.oext_args, ext.oext_ret_type)]
+          items
+      in
+      let te =
+        { otyext_name = ext.oext_type_name;
+          otyext_params = ext.oext_type_params;
+          otyext_constructors = exts;
+          otyext_private = ext.oext_private }
+      in
+        fprintf ppf "@[%a@]" !out_type_extension te;
+        if items <> [] then fprintf ppf "@ %a" print_items items
+  | (tree, valopt) :: items ->
+      begin match valopt with
+        Some v ->
+          fprintf ppf "@[<2>%a =@ %a@]" !out_sig_item tree
+            !out_value v
+      | None -> fprintf ppf "@[%a@]" !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
+  | Ophr_signature [] -> ()
+  | Ophr_signature items -> fprintf ppf "@[%a@]@." print_items items
+  | Ophr_exception (exn, outv) -> print_out_exception ppf exn outv
+
+let out_phrase = ref print_out_phrase
diff --git a/typing/oprint.mli b/typing/oprint.mli
new file mode 100644
index 00000000..2eaaa264
--- /dev/null
+++ b/typing/oprint.mli
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Projet Cristal, INRIA Rocquencourt                   *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+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_constr :
+  (formatter -> string * out_type list * out_type option -> 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
+val out_type_extension : (formatter -> out_type_extension -> unit) ref
+val out_phrase : (formatter -> out_phrase -> unit) ref
+
+val parenthesized_ident : string -> bool
diff --git a/typing/outcometree.mli b/typing/outcometree.mli
new file mode 100644
index 00000000..bb53d235
--- /dev/null
+++ b/typing/outcometree.mli
@@ -0,0 +1,148 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*      Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt          *)
+(*                                                                        *)
+(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Module [Outcometree]: results displayed by the toplevel *)
+
+(* These types represent messages that the toplevel displays as normal
+   results or errors. The real displaying is customisable using the hooks:
+      [Toploop.print_out_value]
+      [Toploop.print_out_type]
+      [Toploop.print_out_sig_item]
+      [Toploop.print_out_phrase] *)
+
+(** An [out_name] is a string representation of an identifier which can be
+    rewritten on the fly to avoid name collisions *)
+type out_name = { mutable printed_name: string }
+
+type out_ident =
+  | Oide_apply of out_ident * out_ident
+  | Oide_dot of out_ident * string
+  | Oide_ident of out_name
+
+type out_string =
+  | Ostr_string
+  | Ostr_bytes
+
+type out_attribute =
+  { oattr_name: string }
+
+type out_value =
+  | Oval_array of out_value list
+  | Oval_char of char
+  | Oval_constr of out_ident * out_value list
+  | Oval_ellipsis
+  | Oval_float of float
+  | Oval_int of int
+  | Oval_int32 of int32
+  | Oval_int64 of int64
+  | Oval_nativeint of nativeint
+  | Oval_list of out_value list
+  | Oval_printer of (Format.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
+  | Oval_tuple of out_value list
+  | Oval_variant of string * out_value option
+
+type out_type =
+  | Otyp_abstract
+  | Otyp_open
+  | Otyp_alias of out_type * string
+  | Otyp_arrow of string * out_type * out_type
+  | Otyp_class of bool * out_ident * out_type list
+  | Otyp_constr of out_ident * out_type list
+  | Otyp_manifest of out_type * out_type
+  | Otyp_object of (string * out_type) list * bool option
+  | Otyp_record of (string * bool * out_type) list
+  | Otyp_stuff of string
+  | Otyp_sum of (string * out_type list * out_type option) list
+  | Otyp_tuple of out_type list
+  | Otyp_var of bool * string
+  | Otyp_variant of
+      bool * out_variant * bool * (string list) option
+  | Otyp_poly of string list * out_type
+  | Otyp_module of out_ident * string list * out_type list
+  | Otyp_attribute of out_type * out_attribute
+
+and out_variant =
+  | Ovar_fields of (string * bool * out_type list) list
+  | Ovar_typ of out_type
+
+type out_class_type =
+  | Octy_constr of out_ident * out_type list
+  | Octy_arrow of string * out_type * out_class_type
+  | Octy_signature of out_type option * out_class_sig_item list
+and out_class_sig_item =
+  | Ocsg_constraint of out_type * out_type
+  | Ocsg_method of string * bool * bool * out_type
+  | Ocsg_value of string * bool * bool * out_type
+
+type out_module_type =
+  | Omty_abstract
+  | Omty_functor of (string option * out_module_type) option * out_module_type
+  | Omty_ident of out_ident
+  | Omty_signature of out_sig_item list
+  | Omty_alias of out_ident
+and out_sig_item =
+  | Osig_class of
+      bool * string * (string * (bool * bool)) list * out_class_type *
+        out_rec_status
+  | Osig_class_type of
+      bool * string * (string * (bool * bool)) list * out_class_type *
+        out_rec_status
+  | Osig_typext of out_extension_constructor * out_ext_status
+  | Osig_modtype of string * out_module_type
+  | Osig_module of string * out_module_type * out_rec_status
+  | Osig_type of out_type_decl * out_rec_status
+  | Osig_value of out_val_decl
+  | Osig_ellipsis
+and out_type_decl =
+  { otype_name: string;
+    otype_params: (string * (bool * bool)) list;
+    otype_type: out_type;
+    otype_private: Asttypes.private_flag;
+    otype_immediate: Type_immediacy.t;
+    otype_unboxed: bool;
+    otype_cstrs: (out_type * out_type) list }
+and out_extension_constructor =
+  { oext_name: string;
+    oext_type_name: string;
+    oext_type_params: string list;
+    oext_args: out_type list;
+    oext_ret_type: out_type option;
+    oext_private: Asttypes.private_flag }
+and out_type_extension =
+  { otyext_name: string;
+    otyext_params: string list;
+    otyext_constructors: (string * out_type list * out_type option) list;
+    otyext_private: Asttypes.private_flag }
+and out_val_decl =
+  { oval_name: string;
+    oval_type: out_type;
+    oval_prims: string list;
+    oval_attributes: out_attribute list }
+and out_rec_status =
+  | Orec_not
+  | Orec_first
+  | Orec_next
+and out_ext_status =
+  | Oext_first
+  | Oext_next
+  | Oext_exception
+
+type out_phrase =
+  | Ophr_eval of out_value * out_type
+  | Ophr_signature of (out_sig_item * out_value option) list
+  | Ophr_exception of (exn * out_value)
diff --git a/typing/parmatch.ml b/typing/parmatch.ml
new file mode 100644
index 00000000..1209ef8c
--- /dev/null
+++ b/typing/parmatch.ml
@@ -0,0 +1,2650 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Detection of partial matches and unused match cases. *)
+
+open Misc
+open Asttypes
+open Types
+open Typedtree
+
+(*************************************)
+(* Utilities for building patterns   *)
+(*************************************)
+
+let make_pat desc ty tenv =
+  {pat_desc = desc; pat_loc = Location.none; pat_extra = [];
+   pat_type = ty ; pat_env = tenv;
+   pat_attributes = [];
+  }
+
+let omega = make_pat Tpat_any Ctype.none Env.empty
+
+let extra_pat =
+  make_pat
+    (Tpat_var (Ident.create_local "+", mknoloc "+"))
+    Ctype.none Env.empty
+
+let rec omegas i =
+  if i <= 0 then [] else omega :: omegas (i-1)
+
+let omega_list l = List.map (fun _ -> omega) l
+
+module Pattern_head : sig
+  type desc =
+    | Any
+    | Construct of constructor_description
+    | Constant of constant
+    | Tuple of int
+    | Record of label_description list
+    | Variant of
+        { tag: label; has_arg: bool;
+          cstr_row: row_desc ref;
+          type_row : unit -> row_desc; }
+          (* the row of the type may evolve if [close_variant] is called,
+             hence the (unit -> ...) delay *)
+    | Array of int
+    | Lazy
+
+  type t
+
+  val desc : t -> desc
+  val env : t -> Env.t
+  val loc : t -> Location.t
+  val typ : t -> Types.type_expr
+
+  (** [deconstruct p] returns the head of [p] and the list of sub patterns.
+
+      @raises [Invalid_arg _] if [p] is an or- or an exception-pattern.  *)
+  val deconstruct : pattern -> t * pattern list
+
+  (** reconstructs a pattern, putting wildcards as sub-patterns. *)
+  val to_omega_pattern : t -> pattern
+
+  val make
+    :  loc:Location.t
+    -> typ:Types.type_expr
+    -> env:Env.t
+    -> desc
+    -> t
+
+  val omega : t
+
+end = struct
+  type desc =
+    | Any
+    | Construct of constructor_description
+    | Constant of constant
+    | Tuple of int
+    | Record of label_description list
+    | Variant of
+        { tag: label;
+          has_arg: bool;
+          cstr_row: row_desc ref;
+          type_row: unit -> row_desc; }
+    | Array of int
+    | Lazy
+
+  type t = {
+    desc: desc;
+    typ : Types.type_expr;
+    loc : Location.t;
+    env : Env.t;
+    attributes : attributes;
+  }
+
+  let desc { desc } = desc
+  let env { env } = env
+  let loc { loc } = loc
+  let typ { typ } = typ
+
+  let deconstruct q =
+    let rec deconstruct_desc = function
+      | Tpat_any
+      | Tpat_var _ -> Any, []
+      | Tpat_constant c -> Constant c, []
+      | Tpat_alias (p,_,_) -> deconstruct_desc p.pat_desc
+      | Tpat_tuple args ->
+          Tuple (List.length args), args
+      | Tpat_construct (_, c, args) ->
+          Construct c, args
+      | Tpat_variant (tag, arg, cstr_row) ->
+          let has_arg, pats =
+            match arg with
+            | None -> false, []
+            | Some a -> true, [a]
+          in
+          let type_row () =
+            match Ctype.expand_head q.pat_env q.pat_type with
+              | {desc = Tvariant type_row} -> Btype.row_repr type_row
+              | _ -> assert false
+          in
+          Variant {tag; has_arg; cstr_row; type_row}, pats
+      | Tpat_array args ->
+          Array (List.length args), args
+      | Tpat_record (largs, _) ->
+          let lbls = List.map (fun (_,lbl,_) -> lbl) largs in
+          let pats = List.map (fun (_,_,pat) -> pat) largs in
+          Record lbls, pats
+      | Tpat_lazy p ->
+          Lazy, [p]
+      | Tpat_or _ -> invalid_arg "Parmatch.Pattern_head.deconstruct: (P | Q)"
+    in
+    let desc, pats = deconstruct_desc q.pat_desc in
+    { desc; typ = q.pat_type; loc = q.pat_loc;
+      env = q.pat_env; attributes = q.pat_attributes }, pats
+
+  let to_omega_pattern t =
+    let pat_desc =
+      match t.desc with
+      | Any -> Tpat_any
+      | Lazy -> Tpat_lazy omega
+      | Constant c -> Tpat_constant c
+      | Tuple n -> Tpat_tuple (omegas n)
+      | Array n -> Tpat_array (omegas n)
+      | Construct c ->
+          let lid_loc = Location.mkloc (Longident.Lident c.cstr_name) t.loc in
+          Tpat_construct (lid_loc, c, omegas c.cstr_arity)
+      | Variant { tag; has_arg; cstr_row } ->
+          let arg_opt = if has_arg then Some omega else None in
+          Tpat_variant (tag, arg_opt, cstr_row)
+      | Record lbls ->
+          let lst =
+            List.map (fun lbl ->
+              let lid_loc =
+                Location.mkloc (Longident.Lident lbl.lbl_name) t.loc
+              in
+              (lid_loc, lbl, omega)
+            ) lbls
+          in
+          Tpat_record (lst, Closed)
+    in
+    { pat_desc; pat_type = t.typ; pat_loc = t.loc; pat_extra = [];
+      pat_env = t.env; pat_attributes = t.attributes }
+
+  let make ~loc ~typ ~env desc =
+    { desc; loc; typ; env; attributes = [] }
+
+  let omega =
+    { desc = Any
+    ; loc = Location.none
+    ; typ = Ctype.none
+    ; env = Env.empty
+    ; attributes = []
+    }
+end
+
+(*
+  Normalize a pattern ->
+   all arguments are omega (simple pattern) and no more variables
+*)
+
+let normalize_pat p = Pattern_head.(to_omega_pattern @@ fst @@ deconstruct p)
+
+(*******************)
+(* Coherence check *)
+(*******************)
+
+(* For some of the operations we do in this module, we would like (because it
+   simplifies matters) to assume that patterns appearing on a given column in a
+   pattern matrix are /coherent/ (think "of the same type").
+   Unfortunately that is not always true.
+
+   Consider the following (well-typed) example:
+   {[
+     type _ t = S : string t | U : unit t
+
+     let f (type a) (t1 : a t) (t2 : a t) (a : a) =
+       match t1, t2, a with
+       | U, _, () -> ()
+       | _, S, "" -> ()
+   ]}
+
+   Clearly the 3rd column contains incoherent patterns.
+
+   On the example above, most of the algorithms will explore the pattern matrix
+   as illustrated by the following tree:
+
+   {v
+                                                   S
+                                                -------> | "" |
+                             U     | S, "" | __/         | () |
+                         --------> | _, () |   \ not S
+        | U, _, () | __/                        -------> | () |
+        | _, S, "" |   \
+                        ---------> | S, "" | ----------> | "" |
+                          not U                    S
+   v}
+
+   where following an edge labelled by a pattern P means "assuming the value I
+   am matching on is filtered by [P] on the column I am currently looking at,
+   then the following submatrix is still reachable".
+
+   Notice that at any point of that tree, if the first column of a matrix is
+   incoherent, then the branch leading to it can only be taken if the scrutinee
+   is ill-typed.
+   In the example above the only case where we have a matrix with an incoherent
+   first column is when we consider [t1, t2, a] to be [U, S, ...]. However such
+   a value would be ill-typed, so we can never actually get there.
+
+   Checking the first column at each step of the recursion and making the
+   conscious decision of "aborting" the algorithm whenever the first column
+   becomes incoherent, allows us to retain the initial assumption in later
+   stages of the algorithms.
+
+   ---
+
+   N.B. two patterns can be considered coherent even though they might not be of
+   the same type.
+
+   That's in part because we only care about the "head" of patterns and leave
+   checking coherence of subpatterns for the next steps of the algorithm:
+   ('a', 'b') and (1, ()) will be deemed coherent because they are both a tuples
+   of arity 2 (we'll notice at a later stage the incoherence of 'a' and 1).
+
+   But also because it can be hard/costly to determine exactly whether two
+   patterns are of the same type or not (eg. in the example above with _ and S,
+   but see also the module [Coherence_illustration] in
+   testsuite/tests/basic-more/robustmatch.ml).
+
+   For the moment our weak, loosely-syntactic, coherence check seems to be
+   enough and we leave it to each user to consider (and document!) what happens
+   when an "incoherence" is not detected by this check.
+*)
+
+(* Given the first column of a simplified matrix, this function first looks for
+   a "discriminating" pattern on that column (i.e. a non-omega one) and then
+   check that every other head pattern in the column is coherent with that one.
+*)
+let all_coherent column =
+  let coherent_heads hp1 hp2 =
+    match Pattern_head.desc hp1, Pattern_head.desc hp2 with
+    | Construct c, Construct c' ->
+      c.cstr_consts = c'.cstr_consts
+      && c.cstr_nonconsts = c'.cstr_nonconsts
+    | Constant c1, Constant c2 -> begin
+        match c1, c2 with
+        | Const_char _, Const_char _
+        | Const_int _, Const_int _
+        | Const_int32 _, Const_int32 _
+        | Const_int64 _, Const_int64 _
+        | Const_nativeint _, Const_nativeint _
+        | Const_float _, Const_float _
+        | Const_string _, Const_string _ -> true
+        | ( Const_char _
+          | Const_int _
+          | Const_int32 _
+          | Const_int64 _
+          | Const_nativeint _
+          | Const_float _
+          | Const_string _), _ -> false
+      end
+    | Tuple l1, Tuple l2 -> l1 = l2
+    | Record (lbl1 :: _), Record (lbl2 :: _) ->
+      Array.length lbl1.lbl_all = Array.length lbl2.lbl_all
+    | Any, _
+    | _, Any
+    | Record [], Record []
+    | Variant _, Variant _
+    | Array _, Array _
+    | Lazy, Lazy -> true
+    | _, _ -> false
+  in
+  match
+    List.find (fun head_pat ->
+      match Pattern_head.desc head_pat with
+      | Any -> false
+      | _ -> true
+    ) column
+  with
+  | exception Not_found ->
+    (* only omegas on the column: the column is coherent. *)
+    true
+  | discr_pat ->
+    List.for_all (coherent_heads discr_pat) column
+
+let first_column simplified_matrix =
+  List.map (fun ((head, _args), _rest) -> head) simplified_matrix
+
+(***********************)
+(* Compatibility check *)
+(***********************)
+
+(* Patterns p and q compatible means:
+   there exists value V that matches both, However....
+
+  The case of extension types is dubious, as constructor rebind permits
+  that different constructors are the same (and are thus compatible).
+
+  Compilation must take this into account, consider:
+
+  type t = ..
+  type t += A|B
+  type t += C=A
+
+  let f x y = match x,y with
+  | true,A  -> '1'
+  | _,C     -> '2'
+  | false,A -> '3'
+  | _,_     -> '_'
+
+  As C is bound to A the value of f false A is '2' (and not '3' as it would
+  be in the absence of rebinding).
+
+  Not considering rebinding, patterns "false,A" and "_,C" are incompatible
+  and the compiler can swap the second and third clause, resulting in the
+  (more efficiently compiled) matching
+
+  match x,y with
+  | true,A  -> '1'
+  | false,A -> '3'
+  | _,C     -> '2'
+  | _,_     -> '_'
+
+  This is not correct: when C is bound to A, "f false A" returns '2' (not '3')
+
+
+  However, diagnostics do not take constructor rebinding into account.
+  Notice, that due to module abstraction constructor rebinding is hidden.
+
+  module X : sig type t = .. type t += A|B end = struct
+    type t = ..
+    type t += A
+    type t += B=A
+  end
+
+  open X
+
+  let f x = match x with
+  | A -> '1'
+  | B -> '2'
+  | _ -> '_'
+
+  The second clause above will NOT (and cannot) be flagged as useless.
+
+  Finally, there are two compatibility functions:
+   compat p q      ---> 'syntactic compatibility, used for diagnostics.
+   may_compat p q --->   a safe approximation of possible compat,
+                         for compilation
+
+*)
+
+
+let is_absent tag row = Btype.row_field tag !row = Rabsent
+
+let is_absent_pat d =
+  match Pattern_head.desc d with
+  | Variant { tag; cstr_row; _ } -> is_absent tag cstr_row
+  | _ -> false
+
+let const_compare x y =
+  match x,y with
+  | Const_float f1, Const_float f2 ->
+      Stdlib.compare (float_of_string f1) (float_of_string f2)
+  | Const_string (s1, _, _), Const_string (s2, _, _) ->
+      String.compare s1 s2
+  | (Const_int _
+    |Const_char _
+    |Const_string (_, _, _)
+    |Const_float _
+    |Const_int32 _
+    |Const_int64 _
+    |Const_nativeint _
+    ), _ -> Stdlib.compare x y
+
+let records_args l1 l2 =
+  (* Invariant: fields are already sorted by Typecore.type_label_a_list *)
+  let rec combine r1 r2 l1 l2 = match l1,l2 with
+  | [],[] -> List.rev r1, List.rev r2
+  | [],(_,_,p2)::rem2 -> combine (omega::r1) (p2::r2) [] rem2
+  | (_,_,p1)::rem1,[] -> combine (p1::r1) (omega::r2) rem1 []
+  | (_,lbl1,p1)::rem1, ( _,lbl2,p2)::rem2 ->
+      if lbl1.lbl_pos < lbl2.lbl_pos then
+        combine (p1::r1) (omega::r2) rem1 l2
+      else if lbl1.lbl_pos > lbl2.lbl_pos then
+        combine (omega::r1) (p2::r2) l1 rem2
+      else (* same label on both sides *)
+        combine (p1::r1) (p2::r2) rem1 rem2 in
+  combine [] [] l1 l2
+
+
+
+module Compat
+    (Constr:sig
+      val equal :
+          Types.constructor_description ->
+            Types.constructor_description ->
+              bool
+    end) = struct
+
+  let rec compat p q = match p.pat_desc,q.pat_desc with
+(* Variables match any value *)
+  | ((Tpat_any|Tpat_var _),_)
+  | (_,(Tpat_any|Tpat_var _)) -> true
+(* Structural induction *)
+  | Tpat_alias (p,_,_),_      -> compat p q
+  | _,Tpat_alias (q,_,_)      -> compat p q
+  | Tpat_or (p1,p2,_),_ ->
+      (compat p1 q || compat p2 q)
+  | _,Tpat_or (q1,q2,_) ->
+      (compat p q1 || compat p q2)
+(* Constructors, with special case for extension *)
+  | Tpat_construct (_, c1,ps1), Tpat_construct (_, c2,ps2) ->
+      Constr.equal c1 c2 && compats ps1 ps2
+(* More standard stuff *)
+  | Tpat_variant(l1,op1, _), Tpat_variant(l2,op2,_) ->
+      l1=l2 && ocompat op1 op2
+  | Tpat_constant c1, Tpat_constant c2 ->
+      const_compare c1 c2 = 0
+  | Tpat_tuple ps, Tpat_tuple qs -> compats ps qs
+  | Tpat_lazy p, Tpat_lazy q -> compat p q
+  | Tpat_record (l1,_),Tpat_record (l2,_) ->
+      let ps,qs = records_args l1 l2 in
+      compats ps qs
+  | Tpat_array ps, Tpat_array qs ->
+      List.length ps = List.length qs &&
+      compats ps qs
+  | _,_  -> false
+
+  and ocompat op oq = match op,oq with
+  | None,None -> true
+  | Some p,Some q -> compat p q
+  | (None,Some _)|(Some _,None) -> false
+
+  and compats ps qs = match ps,qs with
+  | [], [] -> true
+  | p::ps, q::qs -> compat p q && compats ps qs
+  | _,_    -> false
+
+end
+
+module SyntacticCompat =
+  Compat
+    (struct
+      let equal c1 c2 =  Types.equal_tag c1.cstr_tag c2.cstr_tag
+    end)
+
+let compat =  SyntacticCompat.compat
+and compats = SyntacticCompat.compats
+
+(* Due to (potential) rebinding, two extension constructors
+   of the same arity type may equal *)
+
+exception Empty (* Empty pattern *)
+
+(****************************************)
+(* Utilities for retrieving type paths  *)
+(****************************************)
+
+(* May need a clean copy, cf. PR#4745 *)
+let clean_copy ty =
+  if ty.level = Btype.generic_level then ty
+  else Subst.type_expr Subst.identity ty
+
+let get_constructor_type_path ty tenv =
+  let ty = Ctype.repr (Ctype.expand_head tenv (clean_copy ty)) in
+  match ty.desc with
+  | Tconstr (path,_,_) -> path
+  | _ -> assert false
+
+(****************************)
+(* Utilities for matching   *)
+(****************************)
+
+(* Check top matching *)
+let simple_match d h =
+  match Pattern_head.desc d, Pattern_head.desc h with
+  | Construct c1, Construct c2 ->
+      Types.equal_tag c1.cstr_tag c2.cstr_tag
+  | Variant { tag = t1; _ }, Variant { tag = t2 } ->
+      t1 = t2
+  | Constant c1, Constant c2 -> const_compare c1 c2 = 0
+  | Lazy, Lazy -> true
+  | Record _, Record _ -> true
+  | Tuple len1, Tuple len2
+  | Array len1, Array len2 -> len1 = len2
+  | _, Any -> true
+  | _, _ -> false
+
+
+
+(* extract record fields as a whole *)
+let record_arg ph = match Pattern_head.desc ph with
+| Any -> []
+| Record args -> args
+| _ -> fatal_error "Parmatch.as_record"
+
+
+let extract_fields lbls arg =
+  let get_field pos arg =
+    match List.find (fun (lbl,_) -> pos = lbl.lbl_pos) arg with
+    | _, p -> p
+    | exception Not_found -> omega
+  in
+  List.map (fun lbl -> get_field lbl.lbl_pos arg) lbls
+
+(* Build argument list when p2 >= p1, where p1 is a simple pattern *)
+let simple_match_args discr head args = match Pattern_head.desc head with
+| Constant _ -> []
+| Construct _
+| Variant _
+| Tuple _
+| Array _
+| Lazy -> args
+| Record lbls ->  extract_fields (record_arg discr) (List.combine lbls args)
+| Any ->
+    begin match Pattern_head.desc discr with
+    | Construct cstr -> omegas cstr.cstr_arity
+    | Variant { has_arg = true }
+    | Lazy -> [omega]
+    | Record lbls ->  omega_list lbls
+    | Array len
+    | Tuple len -> omegas len
+    | Variant { has_arg = false }
+    | Any
+    | Constant _ -> []
+    end
+
+(* Consider a pattern matrix whose first column has been simplified to contain
+   only _ or a head constructor
+     | p1, r1...
+     | p2, r2...
+     | p3, r3...
+     | ...
+
+   We build a normalized /discriminating/ pattern from a pattern [q] by folding
+   over the first column of the matrix, "refining" [q] as we go:
+
+   - when we encounter a row starting with [Tuple] or [Lazy] then we
+   can stop and return that head, as we cannot refine any further. Indeed,
+   these constructors are alone in their signature, so they will subsume
+   whatever other head we might find, as well as the head we're threading
+   along.
+
+   - when we find a [Record] then it is a bit more involved: it is also alone
+   in its signature, however it might only be matching a subset of the
+   record fields. We use these fields to refine our accumulator and keep going
+   as another row might match on different fields.
+
+   - rows starting with a wildcard do not bring any information, so we ignore
+   them and keep going
+
+   - if we encounter anything else (i.e. any other constructor), then we just
+   stop and return our accumulator.
+*)
+let discr_pat q pss =
+  let rec refine_pat acc = function
+    | [] -> acc
+    | ((head, _), _) :: rows ->
+      match Pattern_head.desc head with
+      | Any -> refine_pat acc rows
+      | Tuple _ | Lazy -> head
+      | Record lbls ->
+        (* N.B. we could make this case "simpler" by refining the record case
+           using [all_record_args].
+           In which case we wouldn't need to fold over the first column for
+           records.
+           However it makes the witness we generate for the exhaustivity warning
+           less pretty. *)
+        let fields =
+          List.fold_right (fun lbl r ->
+            if List.exists (fun l -> l.lbl_pos = lbl.lbl_pos) r then
+              r
+            else
+              lbl :: r
+          ) lbls (record_arg acc)
+        in
+        let d =
+          let open Pattern_head in
+          make ~loc:(loc head) ~typ:(typ head) ~env:(env head) (Record fields)
+        in
+        refine_pat d rows
+      | _ -> acc
+  in
+  let q, _ = Pattern_head.deconstruct q in
+  match Pattern_head.desc q with
+  (* short-circuiting: clearly if we have anything other than [Record] or
+     [Any] to start with, we're not going to be able refine at all. So
+     there's no point going over the matrix. *)
+  | Any | Record _ -> refine_pat q pss
+  | _ -> q
+
+(*
+   In case a matching value is found, set actual arguments
+   of the matching pattern.
+*)
+
+let rec read_args xs r = match xs,r with
+| [],_ -> [],r
+| _::xs, arg::rest ->
+   let args,rest = read_args xs rest in
+   arg::args,rest
+| _,_ ->
+    fatal_error "Parmatch.read_args"
+
+let do_set_args ~erase_mutable 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
+| {pat_desc = Tpat_construct (lid, c,omegas)} ->
+    let args,rest = read_args omegas r in
+    make_pat
+      (Tpat_construct (lid, c,args))
+      q.pat_type q.pat_env::
+    rest
+| {pat_desc = Tpat_variant (l, omega, row)} ->
+    let arg, rest =
+      match omega, r with
+        Some _, a::r -> Some a, r
+      | None, r -> None, r
+      | _ -> assert false
+    in
+    make_pat
+      (Tpat_variant (l, arg, row)) q.pat_type q.pat_env::
+    rest
+| {pat_desc = Tpat_lazy _omega} ->
+    begin match r with
+      arg::rest ->
+        make_pat (Tpat_lazy arg) q.pat_type q.pat_env::rest
+    | _ -> fatal_error "Parmatch.do_set_args (lazy)"
+    end
+| {pat_desc = Tpat_array omegas} ->
+    let args,rest = read_args omegas r in
+    make_pat
+      (Tpat_array args) q.pat_type q.pat_env::
+    rest
+| {pat_desc=Tpat_constant _|Tpat_any} ->
+    q::r (* case any is used in matching.ml *)
+| _ -> 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...
+   p3 :: r3...
+
+   Simplify the first column [p1 p2 p3] by splitting all or-patterns.
+   The result is a list of pairs
+     ((pattern head, arguments), rest of row)
+
+   For example,
+     x :: r1
+     (Some _) as y :: r2
+     (None as x) as y :: r3
+     (Some x | (None as x)) :: r4
+   becomes
+     ((   _ , [ ] ), r1)
+     (( Some, [_] ), r2)
+     (( None, [ ] ), r3)
+     (( Some, [x] ), r4)
+     (( None, [ ] ), r4)
+ *)
+let simplify_head_pat ~add_column p ps k =
+  let rec simplify_head_pat p ps k =
+    match p.pat_desc with
+    | Tpat_alias (p,_,_) ->
+        (* We have to handle aliases here, because there can be or-patterns
+           underneath, that [Pattern_head.deconstruct] won't handle. *)
+        simplify_head_pat p ps k
+    | Tpat_or (p1,p2,_) -> simplify_head_pat p1 ps (simplify_head_pat p2 ps k)
+    | _ -> add_column (Pattern_head.deconstruct p) ps k
+  in simplify_head_pat p ps k
+
+let rec simplify_first_col = function
+  | [] -> []
+  | [] :: _ -> assert false (* the rows are non-empty! *)
+  | (p::ps) :: rows ->
+      let add_column p ps k = (p, ps) :: k in
+      simplify_head_pat ~add_column p ps (simplify_first_col rows)
+
+
+(* Builds the specialized matrix of [pss] according to the discriminating
+   pattern head [d].
+   See section 3.1 of http://moscova.inria.fr/~maranget/papers/warn/warn.pdf
+
+   NOTES:
+   - we are polymorphic on the type of matrices we work on, in particular a row
+   might not simply be a [pattern list]. That's why we have the [extend_row]
+   parameter.
+*)
+let build_specialized_submatrix ~extend_row discr pss =
+  let rec filter_rec = function
+    | ((head, args), ps) :: pss ->
+        if simple_match discr head
+        then extend_row (simple_match_args discr head args) ps :: filter_rec pss
+        else filter_rec pss
+    | _ -> [] in
+  filter_rec pss
+
+(* The "default" and "specialized" matrices of a given matrix.
+   See section 3.1 of http://moscova.inria.fr/~maranget/papers/warn/warn.pdf .
+*)
+type 'matrix specialized_matrices = {
+  default : 'matrix;
+  constrs : (Pattern_head.t * 'matrix) list;
+}
+
+(* Consider a pattern matrix whose first column has been simplified
+   to contain only _ or a head constructor
+     | p1, r1...
+     | p2, r2...
+     | p3, r3...
+     | ...
+
+   We split this matrix into a list of /specialized/ sub-matrices, one for
+   each head constructor appearing in the first column. For each row whose
+   first column starts with a head constructor, remove this head
+   column, prepend one column for each argument of the constructor,
+   and add the resulting row in the sub-matrix corresponding to this
+   head constructor.
+
+   Rows whose left column is omega (the Any pattern _) may match any
+   head constructor, so they are added to all sub-matrices.
+
+   In the case where all the rows in the matrix have an omega on their first
+   column, then there is only one /specialized/ sub-matrix, formed of all these
+   omega rows.
+   This matrix is also called the /default/ matrix.
+
+   See the documentation of [build_specialized_submatrix] for an explanation of
+   the [extend_row] parameter.
+*)
+let build_specialized_submatrices ~extend_row discr rows =
+  let extend_group discr p args r rs =
+    let r = extend_row (simple_match_args discr p args) r in
+    (discr, r :: rs)
+  in
+
+  (* insert a row of head [p] and rest [r] into the right group *)
+  let rec insert_constr head args r = function
+    | [] ->
+      (* if no group matched this row, it has a head constructor that
+         was never seen before; add a new sub-matrix for this head *)
+      [extend_group head head args r []]
+    | (q0,rs) as bd::env ->
+      if simple_match q0 head
+      then extend_group q0 head args r rs :: env
+      else bd :: insert_constr head args r env
+  in
+
+  (* insert a row of head omega into all groups *)
+  let insert_omega r env =
+    List.map (fun (q0,rs) -> extend_group q0 Pattern_head.omega [] r rs) env
+  in
+
+  let rec form_groups constr_groups omega_tails = function
+    | [] -> (constr_groups, omega_tails)
+    | ((head, args), tail) :: rest ->
+        match Pattern_head.desc head with
+        | Any ->
+            (* note that calling insert_omega here would be wrong
+               as some groups may not have been formed yet, if the
+               first row with this head pattern comes after in the list *)
+            form_groups constr_groups (tail :: omega_tails) rest
+        | _ ->
+            form_groups
+              (insert_constr head args tail constr_groups) omega_tails rest
+  in
+
+  let constr_groups, omega_tails =
+    let initial_constr_group =
+      match Pattern_head.desc discr with
+      | Record _ | Tuple _ | Lazy ->
+        (* [discr] comes from [discr_pat], and in this case subsumes any of the
+           patterns we could find on the first column of [rows]. So it is better
+           to use it for our initial environment than any of the normalized
+           pattern we might obtain from the first column. *)
+        [discr,[]]
+      | _ -> []
+    in
+    form_groups initial_constr_group [] rows
+  in
+  {
+    default = omega_tails;
+    constrs =
+      (* insert omega rows in all groups *)
+      List.fold_right insert_omega omega_tails constr_groups;
+  }
+
+(* Variant related functions *)
+
+let set_last a =
+  let rec loop = function
+    | [] -> assert false
+    | [_] -> [a]
+    | x::l -> x :: loop l
+  in
+  function
+  | (_, []) -> (Pattern_head.deconstruct a, [])
+  | (first, row) -> (first, loop row)
+
+(* mark constructor lines for failure when they are incomplete *)
+let mark_partial =
+  let zero = make_pat (Tpat_constant (Const_int 0)) Ctype.none Env.empty in
+  List.map (fun ((hp, _), _ as ps) ->
+    match Pattern_head.desc hp with
+    | Any -> ps
+    | _ -> set_last zero ps
+  )
+
+let close_variant env row =
+  let row = Btype.row_repr row in
+  let nm =
+    List.fold_left
+      (fun nm (_tag,f) ->
+        match Btype.row_field_repr f with
+        | Reither(_, _, false, e) ->
+            (* m=false means that this tag is not explicitly matched *)
+            Btype.set_row_field e Rabsent;
+            None
+        | Rabsent | Reither (_, _, true, _) | Rpresent _ -> nm)
+      row.row_name row.row_fields in
+  if not row.row_closed || nm != row.row_name then begin
+    (* this unification cannot fail *)
+    Ctype.unify env row.row_more
+      (Btype.newgenty
+         (Tvariant {row with row_fields = []; row_more = Btype.newgenvar();
+                    row_closed = true; row_name = nm}))
+  end
+
+(*
+  Check whether the first column of env makes up a complete signature or
+  not. We work on the discriminating pattern heads of each sub-matrix: they
+  are not omega/Any.
+*)
+let full_match closing env =  match env with
+| [] -> false
+| (discr, _) :: _ ->
+  match Pattern_head.desc discr with
+  | Any -> assert false
+  | Construct { cstr_tag = Cstr_extension _ ; _ } -> false
+  | Construct c -> List.length env = c.cstr_consts + c.cstr_nonconsts
+  | Variant { type_row; _ } ->
+      let fields =
+        List.map
+          (fun (d, _) ->
+            match Pattern_head.desc d with
+            | Variant { tag } -> tag
+            | _ -> assert false)
+          env
+      in
+      let row = type_row () in
+      if closing && not (Btype.row_fixed row) then
+        (* closing=true, we are considering the variant as closed *)
+        List.for_all
+          (fun (tag,f) ->
+            match Btype.row_field_repr f with
+              Rabsent | Reither(_, _, false, _) -> true
+            | Reither (_, _, true, _)
+                (* m=true, do not discard matched tags, rather warn *)
+            | Rpresent _ -> List.mem tag fields)
+          row.row_fields
+      else
+        row.row_closed &&
+        List.for_all
+          (fun (tag,f) ->
+            Btype.row_field_repr f = Rabsent || List.mem tag fields)
+          row.row_fields
+  | Constant Const_char _ ->
+      List.length env = 256
+  | Constant _
+  | Array _ -> false
+  | Tuple _
+  | Record _
+  | Lazy -> true
+
+(* Written as a non-fragile matching, PR#7451 originated from a fragile matching
+   below. *)
+let should_extend ext env = match ext with
+| None -> false
+| Some ext -> begin match env with
+  | [] -> assert false
+  | (p,_)::_ ->
+      begin match Pattern_head.desc p with
+      | Construct {cstr_tag=(Cstr_constant _|Cstr_block _|Cstr_unboxed)} ->
+          let path =
+            get_constructor_type_path (Pattern_head.typ p) (Pattern_head.env p)
+          in
+          Path.same path ext
+      | Construct {cstr_tag=(Cstr_extension _)} -> false
+      | Constant _ | Tuple _ | Variant _ | Record _ | Array _ | Lazy -> false
+      | Any -> assert false
+      end
+end
+
+module ConstructorTagHashtbl = Hashtbl.Make(
+  struct
+    type t = Types.constructor_tag
+    let hash = Hashtbl.hash
+    let equal = Types.equal_tag
+  end
+)
+
+(* complement constructor tags *)
+let complete_tags nconsts nconstrs tags =
+  let seen_const = Array.make nconsts false
+  and seen_constr = Array.make nconstrs false in
+  List.iter
+    (function
+      | Cstr_constant i -> seen_const.(i) <- true
+      | Cstr_block i -> seen_constr.(i) <- true
+      | _  -> assert false)
+    tags ;
+  let r = ConstructorTagHashtbl.create (nconsts+nconstrs) in
+  for i = 0 to nconsts-1 do
+    if not seen_const.(i) then
+      ConstructorTagHashtbl.add r (Cstr_constant i) ()
+  done ;
+  for i = 0 to nconstrs-1 do
+    if not seen_constr.(i) then
+      ConstructorTagHashtbl.add r (Cstr_block i) ()
+  done ;
+  r
+
+(* build a pattern from a constructor description *)
+let pat_of_constr ex_pat cstr =
+  {ex_pat with pat_desc =
+   Tpat_construct (mknoloc (Longident.Lident cstr.cstr_name),
+                   cstr, omegas cstr.cstr_arity)}
+
+let orify x y = make_pat (Tpat_or (x, y, None)) x.pat_type x.pat_env
+
+let rec orify_many = function
+| [] -> assert false
+| [x] -> x
+| x :: xs -> orify x (orify_many xs)
+
+(* build an or-pattern from a constructor list *)
+let pat_of_constrs ex_pat cstrs =
+  let ex_pat = Pattern_head.to_omega_pattern ex_pat in
+  if cstrs = [] then raise Empty else
+  orify_many (List.map (pat_of_constr ex_pat) cstrs)
+
+let pats_of_type ?(always=false) env ty =
+  let ty' = Ctype.expand_head env ty in
+  match ty'.desc with
+  | Tconstr (path, _, _) ->
+      begin try match (Env.find_type path env).type_kind with
+      | Type_variant cl when always || List.length cl <= 1 ||
+        (* Only explode when all constructors are GADTs *)
+        List.for_all (fun cd -> cd.Types.cd_res <> None) cl ->
+          let cstrs = fst (Env.find_type_descrs path env) in
+          List.map (pat_of_constr (make_pat Tpat_any ty env)) cstrs
+      | Type_record _ ->
+          let labels = snd (Env.find_type_descrs path env) in
+          let fields =
+            List.map (fun ld ->
+              mknoloc (Longident.Lident ld.lbl_name), ld, omega)
+              labels
+          in
+          [make_pat (Tpat_record (fields, Closed)) ty env]
+      | _ -> [omega]
+      with Not_found -> [omega]
+      end
+  | Ttuple tl ->
+      [make_pat (Tpat_tuple (omegas (List.length tl))) ty env]
+  | _ -> [omega]
+
+let rec get_variant_constructors env ty =
+  match (Ctype.repr ty).desc with
+  | Tconstr (path,_,_) -> begin
+      try match Env.find_type path env with
+      | {type_kind=Type_variant _} ->
+          fst (Env.find_type_descrs path env)
+      | {type_manifest = Some _} ->
+          get_variant_constructors env
+            (Ctype.expand_head_once env (clean_copy ty))
+      | _ -> fatal_error "Parmatch.get_variant_constructors"
+      with Not_found ->
+        fatal_error "Parmatch.get_variant_constructors"
+    end
+  | _ -> fatal_error "Parmatch.get_variant_constructors"
+
+(* Sends back a pattern that complements constructor tags all_tag *)
+let complete_constrs p all_tags =
+  let c = match Pattern_head.desc p with Construct c -> c | _ -> assert false in
+  let not_tags = complete_tags c.cstr_consts c.cstr_nonconsts all_tags in
+  let constrs = get_variant_constructors (Pattern_head.env p) c.cstr_res in
+  let others =
+    List.filter
+      (fun cnstr -> ConstructorTagHashtbl.mem not_tags cnstr.cstr_tag)
+      constrs in
+  let const, nonconst =
+    List.partition (fun cnstr -> cnstr.cstr_arity = 0) others in
+  const @ nonconst
+
+let build_other_constrs env p =
+  match Pattern_head.desc p with
+  | Construct { cstr_tag = Cstr_constant _ | Cstr_block _ } ->
+      let get_tag q =
+        match Pattern_head.desc q with
+        | Construct c -> c.cstr_tag
+        | _ -> fatal_error "Parmatch.get_tag" in
+      let all_tags =  List.map (fun (p,_) -> get_tag p) env in
+      pat_of_constrs p (complete_constrs p all_tags)
+  | _ -> extra_pat
+
+let complete_constrs p all_tags =
+  (* This wrapper is here for [Matching], which (indirectly) calls this function
+     from [combine_constructor], and nowhere else.
+     So we know patterns have been fully simplified. *)
+  complete_constrs (fst @@ Pattern_head.deconstruct p) all_tags
+
+(* Auxiliary for build_other *)
+
+let build_other_constant proj make first next p env =
+  let all = List.map (fun (p, _) -> proj (Pattern_head.desc p)) env in
+  let rec try_const i =
+    if List.mem i all
+    then try_const (next i)
+    else make_pat (make i) (Pattern_head.typ p) (Pattern_head.env p)
+  in try_const first
+
+(*
+  Builds a pattern that is incompatible with all patterns in
+  the first column of env
+*)
+
+let some_private_tag = ""
+
+let build_other ext env =
+  match env with
+  | [] -> omega
+  | (d, _) :: _ ->
+      match Pattern_head.desc d with
+      | Construct { cstr_tag = Cstr_extension _ } ->
+          (* let c = {c with cstr_name = "*extension*"} in *) (* PR#7330 *)
+          make_pat
+            (Tpat_var (Ident.create_local "*extension*",
+                       {txt="*extension*"; loc = Pattern_head.loc d}))
+            Ctype.none Env.empty
+      | Construct _ ->
+          begin match ext with
+          | Some ext ->
+              if Path.same ext
+                   (get_constructor_type_path
+                      (Pattern_head.typ d) (Pattern_head.env d))
+              then
+                extra_pat
+              else
+                build_other_constrs env d
+          | _ ->
+              build_other_constrs env d
+          end
+      | Variant { cstr_row; type_row } ->
+          let tags =
+            List.map
+              (fun (d, _) ->
+                match Pattern_head.desc d with
+                | Variant { tag } -> tag
+                | _ -> assert false)
+              env
+            in
+            let make_other_pat tag const =
+              let arg = if const then None else Some omega in
+              make_pat (Tpat_variant(tag, arg, cstr_row))
+                (Pattern_head.typ d) (Pattern_head.env d)
+            in
+            let row = type_row () in
+            begin match
+              List.fold_left
+                (fun others (tag,f) ->
+                  if List.mem tag tags then others else
+                  match Btype.row_field_repr f with
+                    Rabsent (* | Reither _ *) -> others
+                  (* This one is called after erasing pattern info *)
+                  | Reither (c, _, _, _) -> make_other_pat tag c :: others
+                  | Rpresent arg -> make_other_pat tag (arg = None) :: others)
+                [] row.row_fields
+            with
+              [] ->
+                let tag =
+                  if Btype.row_fixed row then some_private_tag else
+                  let rec mktag tag =
+                    if List.mem tag tags then mktag (tag ^ "'") else tag in
+                  mktag "AnyOtherTag"
+                in make_other_pat tag true
+            | pat::other_pats ->
+                List.fold_left
+                  (fun p_res pat ->
+                    make_pat (Tpat_or (pat, p_res, None))
+                      (Pattern_head.typ d) (Pattern_head.env d))
+                  pat other_pats
+            end
+      | Constant Const_char _ ->
+          let all_chars =
+            List.map
+              (fun (p,_) -> match Pattern_head.desc p with
+              | Constant (Const_char c) -> c
+              | _ -> assert false)
+              env
+          in
+          let rec find_other i imax =
+            if i > imax then raise Not_found
+            else
+              let ci = Char.chr i in
+              if List.mem ci all_chars then
+                find_other (i+1) imax
+              else
+                make_pat (Tpat_constant (Const_char ci))
+                  (Pattern_head.typ d) (Pattern_head.env d)
+          in
+          let rec try_chars = function
+            | [] -> omega
+            | (c1,c2) :: rest ->
+                try
+                  find_other (Char.code c1) (Char.code c2)
+                with
+                | Not_found -> try_chars rest
+          in
+          try_chars
+            [ 'a', 'z' ; 'A', 'Z' ; '0', '9' ;
+              ' ', '~' ; Char.chr 0 , Char.chr 255]
+      | Constant Const_int _ ->
+          build_other_constant
+            (function Constant(Const_int i) -> i | _ -> assert false)
+            (function i -> Tpat_constant(Const_int i))
+            0 succ d env
+      | Constant Const_int32 _ ->
+          build_other_constant
+            (function Constant(Const_int32 i) -> i | _ -> assert false)
+            (function i -> Tpat_constant(Const_int32 i))
+            0l Int32.succ d env
+      | Constant Const_int64 _ ->
+          build_other_constant
+            (function Constant(Const_int64 i) -> i | _ -> assert false)
+            (function i -> Tpat_constant(Const_int64 i))
+            0L Int64.succ d env
+      | Constant Const_nativeint _ ->
+          build_other_constant
+            (function Constant(Const_nativeint i) -> i | _ -> assert false)
+            (function i -> Tpat_constant(Const_nativeint i))
+            0n Nativeint.succ d env
+      | Constant Const_string _ ->
+          build_other_constant
+            (function Constant(Const_string (s, _, _)) -> String.length s
+                    | _ -> assert false)
+            (function i ->
+               Tpat_constant
+                 (Const_string(String.make i '*',Location.none,None)))
+            0 succ d env
+      | Constant Const_float _ ->
+          build_other_constant
+            (function Constant(Const_float f) -> float_of_string f
+                    | _ -> assert false)
+            (function f -> Tpat_constant(Const_float (string_of_float f)))
+            0.0 (fun f -> f +. 1.0) d env
+      | Array _ ->
+          let all_lengths =
+            List.map
+              (fun (p,_) -> match Pattern_head.desc p with
+              | Array len -> len
+              | _ -> assert false)
+              env in
+          let rec try_arrays l =
+            if List.mem l all_lengths then try_arrays (l+1)
+            else
+              make_pat
+                (Tpat_array (omegas l))
+                (Pattern_head.typ d) (Pattern_head.env d) in
+          try_arrays 0
+      | _ -> omega
+
+let rec has_instance p = match p.pat_desc with
+  | Tpat_variant (l,_,r) when is_absent l r -> false
+  | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_,None,_) -> true
+  | Tpat_alias (p,_,_) | Tpat_variant (_,Some p,_) -> has_instance p
+  | Tpat_or (p1,p2,_) -> has_instance p1 || has_instance p2
+  | Tpat_construct (_,_,ps) | Tpat_tuple ps | Tpat_array ps ->
+      has_instances ps
+  | Tpat_record (lps,_) -> has_instances (List.map (fun (_,_,x) -> x) lps)
+  | Tpat_lazy p
+    -> has_instance p
+
+and has_instances = function
+  | [] -> true
+  | q::rem -> has_instance q && has_instances rem
+
+(*
+  Core function :
+  Is the last row of pattern matrix pss + qs satisfiable ?
+  That is :
+    Does there exists at least one value vector, es such that :
+     1- for all ps in pss ps # es (ps and es are not compatible)
+     2- qs <= es                  (es matches qs)
+
+   ---
+
+   In two places in the following function, we check the coherence of the first
+   column of (pss + qs).
+   If it is incoherent, then we exit early saying that (pss + qs) is not
+   satisfiable (which is equivalent to saying "oh, we shouldn't have considered
+   that branch, no good result came come from here").
+
+   But what happens if we have a coherent but ill-typed column?
+   - we might end up returning [false], which is equivalent to noticing the
+   incompatibility: clearly this is fine.
+   - if we end up returning [true] then we're saying that [qs] is useful while
+   it is not. This is sad but not the end of the world, we're just allowing dead
+   code to survive.
+*)
+let rec satisfiable pss qs = match pss with
+| [] -> has_instances qs
+| _  ->
+    match qs with
+    | [] -> false
+    | {pat_desc = Tpat_or(q1,q2,_)}::qs ->
+        satisfiable pss (q1::qs) || satisfiable pss (q2::qs)
+    | {pat_desc = Tpat_alias(q,_,_)}::qs ->
+          satisfiable pss (q::qs)
+    | {pat_desc = (Tpat_any | Tpat_var(_))}::qs ->
+        let pss = simplify_first_col pss in
+        if not (all_coherent (first_column pss)) then
+          false
+        else begin
+          let { default; constrs } =
+            let q0 = discr_pat omega pss in
+            build_specialized_submatrices ~extend_row:(@) q0 pss in
+          if not (full_match false constrs) then
+            satisfiable default qs
+          else
+            List.exists
+              (fun (p,pss) ->
+                 not (is_absent_pat p) &&
+                 satisfiable pss
+                   (simple_match_args p Pattern_head.omega [] @ qs))
+              constrs
+        end
+    | {pat_desc=Tpat_variant (l,_,r)}::_ when is_absent l r -> false
+    | q::qs ->
+        let pss = simplify_first_col pss in
+        let hq, qargs = Pattern_head.deconstruct q in
+        if not (all_coherent (hq :: first_column pss)) then
+          false
+        else begin
+          let q0 = discr_pat q pss in
+          satisfiable (build_specialized_submatrix ~extend_row:(@) q0 pss)
+            (simple_match_args q0 hq qargs @ qs)
+        end
+
+(* While [satisfiable] only checks whether the last row of [pss + qs] is
+   satisfiable, this function returns the (possibly empty) list of vectors [es]
+   which verify:
+     1- for all ps in pss, ps # es (ps and es are not compatible)
+     2- qs <= es                   (es matches qs)
+
+   This is done to enable GADT handling
+
+   For considerations regarding the coherence check, see the comment on
+   [satisfiable] above.  *)
+let rec list_satisfying_vectors pss qs =
+  match pss with
+  | [] -> if has_instances qs then [qs] else []
+  | _  ->
+      match qs with
+      | [] -> []
+      | {pat_desc = Tpat_or(q1,q2,_)}::qs ->
+          list_satisfying_vectors pss (q1::qs) @
+          list_satisfying_vectors pss (q2::qs)
+      | {pat_desc = Tpat_alias(q,_,_)}::qs ->
+          list_satisfying_vectors pss (q::qs)
+      | {pat_desc = (Tpat_any | Tpat_var(_))}::qs ->
+          let pss = simplify_first_col pss in
+          if not (all_coherent (first_column pss)) then
+            []
+          else begin
+            let q0 = discr_pat omega pss in
+            let wild default_matrix p =
+              List.map (fun qs -> p::qs)
+                (list_satisfying_vectors default_matrix qs)
+            in
+            match build_specialized_submatrices ~extend_row:(@) q0 pss with
+            | { default; constrs = [] } ->
+                (* first column of pss is made of variables only *)
+                wild default omega
+            | { default; constrs = ((p,_)::_ as constrs) } ->
+                let for_constrs () =
+                  List.flatten (
+                    List.map (fun (p,pss) ->
+                      if is_absent_pat p then
+                        []
+                      else
+                        let witnesses =
+                          list_satisfying_vectors pss
+                            (simple_match_args p Pattern_head.omega [] @ qs)
+                        in
+                        let p = Pattern_head.to_omega_pattern p in
+                        List.map (set_args p) witnesses
+                    ) constrs
+                  )
+                in
+                if full_match false constrs then for_constrs () else
+                begin match Pattern_head.desc p with
+                | Construct _ ->
+                    (* activate this code for checking non-gadt constructors *)
+                    wild default (build_other_constrs constrs p)
+                    @ for_constrs ()
+                | _ ->
+                    wild default omega
+                end
+          end
+      | {pat_desc=Tpat_variant (l,_,r)}::_ when is_absent l r -> []
+      | q::qs ->
+          let hq, qargs = Pattern_head.deconstruct q in
+          let pss = simplify_first_col pss in
+          if not (all_coherent (hq :: first_column pss)) then
+            []
+          else begin
+            let q0 = discr_pat q pss in
+            List.map (set_args (Pattern_head.to_omega_pattern q0))
+              (list_satisfying_vectors
+                 (build_specialized_submatrix ~extend_row:(@) q0 pss)
+                 (simple_match_args q0 hq qargs @ qs))
+          end
+
+(******************************************)
+(* Look for a row that matches some value *)
+(******************************************)
+
+(*
+  Useful for seeing if the example of
+  non-matched value can indeed be matched
+  (by a guarded clause)
+*)
+
+let rec do_match pss qs = match qs with
+| [] ->
+    begin match pss  with
+    | []::_ -> true
+    | _ -> false
+    end
+| q::qs -> match q with
+  | {pat_desc = Tpat_or (q1,q2,_)} ->
+      do_match pss (q1::qs) || do_match pss (q2::qs)
+  | {pat_desc = Tpat_any} ->
+      let rec remove_first_column = function
+        | (_::ps)::rem -> ps::remove_first_column rem
+        | _ -> []
+      in
+      do_match (remove_first_column pss) qs
+  | _ ->
+      (* [q] is generated by us, it doesn't come from the source. So we know
+         it's not of the form [P as name].
+         Therefore there is no risk of [deconstruct] raising. *)
+      let q0, qargs = Pattern_head.deconstruct q in
+      let pss = simplify_first_col pss in
+      (* [pss] will (or won't) match [q0 :: qs] regardless of the coherence of
+         its first column. *)
+      do_match
+        (build_specialized_submatrix ~extend_row:(@) q0 pss)
+        (qargs @ qs)
+
+
+type 'a exhaust_result =
+  | No_matching_value
+  | Witnesses of 'a list
+
+let rappend r1 r2 =
+  match r1, r2 with
+  | No_matching_value, _ -> r2
+  | _, No_matching_value -> r1
+  | Witnesses l1, Witnesses l2 -> Witnesses (l1 @ l2)
+
+let rec try_many  f = function
+  | [] -> No_matching_value
+  | (p,pss)::rest ->
+      rappend (f (p, pss)) (try_many f rest)
+
+(*
+let print_pat pat =
+  let rec string_of_pat pat =
+    match pat.pat_desc with
+        Tpat_var _ -> "v"
+      | Tpat_any -> "_"
+      | Tpat_alias (p, x) -> Printf.sprintf "(%s) as ?"  (string_of_pat p)
+      | Tpat_constant n -> "0"
+      | Tpat_construct (_, lid, _) ->
+        Printf.sprintf "%s" (String.concat "." (Longident.flatten lid.txt))
+      | Tpat_lazy p ->
+        Printf.sprintf "(lazy %s)" (string_of_pat p)
+      | Tpat_or (p1,p2,_) ->
+        Printf.sprintf "(%s | %s)" (string_of_pat p1) (string_of_pat p2)
+      | Tpat_tuple list ->
+        Printf.sprintf "(%s)" (String.concat "," (List.map string_of_pat list))
+      | Tpat_variant (_, _, _) -> "variant"
+      | Tpat_record (_, _) -> "record"
+      | Tpat_array _ -> "array"
+  in
+  Printf.fprintf stderr "PAT[%s]\n%!" (string_of_pat pat)
+*)
+
+(*
+  Now another satisfiable function that additionally
+  supplies an example of a matching value.
+
+  This function should be called for exhaustiveness check only.
+*)
+let rec exhaust (ext:Path.t option) pss n = match pss with
+| []    ->  Witnesses [omegas n]
+| []::_ ->  No_matching_value
+| pss   ->
+    let pss = simplify_first_col pss in
+    if not (all_coherent (first_column pss)) then
+      (* We're considering an ill-typed branch, we won't actually be able to
+         produce a well typed value taking that branch. *)
+      No_matching_value
+    else begin
+      (* Assuming the first column is ill-typed but considered coherent, we
+         might end up producing an ill-typed witness of non-exhaustivity
+         corresponding to the current branch.
+
+         If [exhaust] has been called by [do_check_partial], then the witnesses
+         produced get typechecked and the ill-typed ones are discarded.
+
+         If [exhaust] has been called by [do_check_fragile], then it is possible
+         we might fail to warn the user that the matching is fragile. See for
+         example testsuite/tests/warnings/w04_failure.ml. *)
+      let q0 = discr_pat omega pss in
+      match build_specialized_submatrices ~extend_row:(@) q0 pss with
+      | { default; constrs = [] } ->
+          (* first column of pss is made of variables only *)
+          begin match exhaust ext default (n-1) with
+          | Witnesses r ->
+              let q0 = Pattern_head.to_omega_pattern q0 in
+              Witnesses (List.map (fun row -> q0::row) r)
+          | r -> r
+        end
+      | { default; constrs } ->
+          let try_non_omega (p,pss) =
+            if is_absent_pat p then
+              No_matching_value
+            else
+              match
+                exhaust
+                  ext pss
+                  (List.length (simple_match_args p Pattern_head.omega [])
+                   + n - 1)
+              with
+              | Witnesses r ->
+                  let p = Pattern_head.to_omega_pattern p in
+                  Witnesses (List.map (set_args p) r)
+              | r       -> r in
+          let before = try_many try_non_omega constrs in
+          if
+            full_match false constrs && not (should_extend ext constrs)
+          then
+            before
+          else
+            let r =  exhaust ext default (n-1) in
+            match r with
+            | No_matching_value -> before
+            | Witnesses r ->
+                try
+                  let p = build_other ext constrs in
+                  let dug = List.map (fun tail -> p :: tail) r in
+                  match before with
+                  | No_matching_value -> Witnesses dug
+                  | Witnesses x -> Witnesses (x @ dug)
+                with
+        (* cannot occur, since constructors don't make a full signature *)
+                | Empty -> fatal_error "Parmatch.exhaust"
+  end
+
+let exhaust ext pss n =
+  let ret = exhaust ext pss n in
+  match ret with
+    No_matching_value -> No_matching_value
+  | Witnesses lst ->
+      let singletons =
+        List.map
+          (function
+              [x] -> x
+            | _ -> assert false)
+          lst
+      in
+      Witnesses [orify_many singletons]
+
+(*
+   Another exhaustiveness check, enforcing variant typing.
+   Note that it does not check exact exhaustiveness, but whether a
+   matching could be made exhaustive by closing all variant types.
+   When this is true of all other columns, the current column is left
+   open (even if it means that the whole matching is not exhaustive as
+   a result).
+   When this is false for the matrix minus the current column, and the
+   current column is composed of variant tags, we close the variant
+   (even if it doesn't help in making the matching exhaustive).
+*)
+
+let rec pressure_variants tdefs = function
+  | []    -> false
+  | []::_ -> true
+  | pss   ->
+      let pss = simplify_first_col pss in
+      if not (all_coherent (first_column pss)) then
+        true
+      else begin
+        let q0 = discr_pat omega pss in
+        match build_specialized_submatrices ~extend_row:(@) q0 pss with
+        | { default; constrs = [] } -> pressure_variants tdefs default
+        | { default; constrs } ->
+            let rec try_non_omega = function
+              | (_p,pss) :: rem ->
+                  let ok = pressure_variants tdefs pss in
+                  (* The order below matters : we want [pressure_variants] to be
+                    called on all the specialized submatrices because we might
+                    close some variant in any of them regardless of whether [ok]
+                    is true for [pss] or not *)
+                  try_non_omega rem && ok
+              | [] -> true
+            in
+            if full_match (tdefs=None) constrs then
+              try_non_omega constrs
+            else if tdefs = None then
+              pressure_variants None default
+            else
+              let full = full_match true constrs in
+              let ok =
+                if full then
+                  try_non_omega constrs
+                else begin
+                  let { constrs = partial_constrs; _ } =
+                    build_specialized_submatrices ~extend_row:(@) q0
+                      (mark_partial pss)
+                  in
+                  try_non_omega partial_constrs
+                end
+              in
+              begin match constrs, tdefs with
+              | [], _
+              | _, None -> ()
+              | (d, _) :: _, Some env ->
+                match Pattern_head.desc d with
+                | Variant { type_row; _ } ->
+                  let row = type_row () in
+                  if Btype.row_fixed row
+                  || pressure_variants None default then ()
+                  else close_variant env row
+                | _ -> ()
+              end;
+              ok
+      end
+
+
+(* Yet another satisfiable function *)
+
+(*
+   This time every_satisfiable pss qs checks the
+   utility of every expansion of qs.
+   Expansion means expansion of or-patterns inside qs
+*)
+
+type answer =
+  | Used                                (* Useful pattern *)
+  | Unused                              (* Useless pattern *)
+  | Upartial of Typedtree.pattern list  (* Mixed, with list of useless ones *)
+
+
+
+(* this row type enable column processing inside the matrix
+    - left  ->  elements not to be processed,
+    - right ->  elements to be processed
+*)
+type usefulness_row =
+  {no_ors : pattern list ; ors : pattern list ; active : pattern list}
+
+(*
+let pretty_row {ors=ors ; no_ors=no_ors; active=active} =
+  pretty_line ors ; prerr_string " *" ;
+  pretty_line no_ors ; prerr_string " *" ;
+  pretty_line active
+
+let pretty_rows rs =
+  prerr_endline "begin matrix" ;
+  List.iter
+    (fun r ->
+      pretty_row r ;
+      prerr_endline "")
+    rs ;
+  prerr_endline "end matrix"
+*)
+
+(* Initial build *)
+let make_row ps = {ors=[] ; no_ors=[]; active=ps}
+
+let make_rows pss = List.map make_row pss
+
+
+(* Useful to detect and expand  or pats inside as pats *)
+let rec unalias p = match p.pat_desc with
+| Tpat_alias (p,_,_) -> unalias p
+| _ -> p
+
+
+let is_var p = match (unalias p).pat_desc with
+| Tpat_any|Tpat_var _ -> true
+| _                   -> false
+
+let is_var_column rs =
+  List.for_all
+    (fun r -> match r.active with
+    | p::_ -> is_var p
+    | []   -> assert false)
+    rs
+
+(* Standard or-args for left-to-right matching *)
+let rec or_args p = match p.pat_desc with
+| Tpat_or (p1,p2,_) -> p1,p2
+| Tpat_alias (p,_,_)  -> or_args p
+| _                 -> assert false
+
+(* Just remove current column *)
+let remove r = match r.active with
+| _::rem -> {r with active=rem}
+| []     -> assert false
+
+let remove_column rs = List.map remove rs
+
+(* Current column has been processed *)
+let push_no_or r = match r.active with
+| p::rem -> { r with no_ors = p::r.no_ors ; active=rem}
+| [] -> assert false
+
+let push_or r = match r.active with
+| p::rem -> { r with ors = p::r.ors ; active=rem}
+| [] -> assert false
+
+let push_or_column rs = List.map push_or rs
+and push_no_or_column rs = List.map push_no_or rs
+
+let rec simplify_first_usefulness_col = function
+  | [] -> []
+  | row :: rows ->
+    match row.active with
+    | [] -> assert false (* the rows are non-empty! *)
+    | p :: ps ->
+      let add_column p ps k =
+        (p, { row with active = ps }) :: k in
+      simplify_head_pat ~add_column p ps
+        (simplify_first_usefulness_col rows)
+
+(* Back to normal matrices *)
+let make_vector r = List.rev r.no_ors
+
+let make_matrix rs = List.map make_vector rs
+
+
+(* Standard union on answers *)
+let union_res r1 r2 = match r1, r2 with
+| (Unused,_)
+| (_, Unused) -> Unused
+| Used,_    -> r2
+| _, Used   -> r1
+| Upartial u1, Upartial u2 -> Upartial (u1@u2)
+
+(* propose or pats for expansion *)
+let extract_elements qs =
+  let rec do_rec seen = function
+    | [] -> []
+    | q::rem ->
+        {no_ors= List.rev_append seen rem @ qs.no_ors ;
+        ors=[] ;
+        active = [q]}::
+        do_rec (q::seen) rem in
+  do_rec [] qs.ors
+
+(* idem for matrices *)
+let transpose rs = match rs with
+| [] -> assert false
+| r::rem ->
+    let i = List.map (fun x -> [x]) r in
+    List.fold_left
+      (List.map2 (fun r x -> x::r))
+      i rem
+
+let extract_columns pss qs = match pss with
+| [] -> List.map (fun _ -> []) qs.ors
+| _  ->
+  let rows = List.map extract_elements pss in
+  transpose rows
+
+(* Core function
+   The idea is to first look for or patterns (recursive case), then
+   check or-patterns argument usefulness (terminal case)
+*)
+
+let rec every_satisfiables pss qs = match qs.active with
+| []     ->
+    (* qs is now partitionned,  check usefulness *)
+    begin match qs.ors with
+    | [] -> (* no or-patterns *)
+        if satisfiable (make_matrix pss) (make_vector qs) then
+          Used
+        else
+          Unused
+    | _  -> (* n or-patterns -> 2n expansions *)
+        List.fold_right2
+          (fun pss qs r -> match r with
+          | Unused -> Unused
+          | _ ->
+              match qs.active with
+              | [q] ->
+                  let q1,q2 = or_args q in
+                  let r_loc = every_both pss qs q1 q2 in
+                  union_res r r_loc
+              | _   -> assert false)
+          (extract_columns pss qs) (extract_elements qs)
+          Used
+    end
+| q::rem ->
+    let uq = unalias q in
+    begin match uq.pat_desc with
+    | Tpat_any | Tpat_var _ ->
+        if is_var_column pss then
+(* forget about ``all-variable''  columns now *)
+          every_satisfiables (remove_column pss) (remove qs)
+        else
+(* otherwise this is direct food for satisfiable *)
+          every_satisfiables (push_no_or_column pss) (push_no_or qs)
+    | Tpat_or (q1,q2,_) ->
+        if
+          q1.pat_loc.Location.loc_ghost &&
+          q2.pat_loc.Location.loc_ghost
+        then
+(* syntactically generated or-pats should not be expanded *)
+          every_satisfiables (push_no_or_column pss) (push_no_or qs)
+        else
+(* this is a real or-pattern *)
+          every_satisfiables (push_or_column pss) (push_or qs)
+    | Tpat_variant (l,_,r) when is_absent l r -> (* Ah Jacques... *)
+        Unused
+    | _ ->
+(* standard case, filter matrix *)
+        let pss = simplify_first_usefulness_col pss in
+        let huq, args = Pattern_head.deconstruct uq in
+        (* The handling of incoherent matrices is kept in line with
+           [satisfiable] *)
+        if not (all_coherent (huq :: first_column pss)) then
+          Unused
+        else begin
+          let q0 = discr_pat q pss in
+          every_satisfiables
+            (build_specialized_submatrix q0 pss
+              ~extend_row:(fun ps r -> { r with active = ps @ r.active }))
+            {qs with active=simple_match_args q0 huq args @ rem}
+        end
+    end
+
+(*
+  This function ``every_both'' performs the usefulness check
+  of or-pat q1|q2.
+  The trick is to call every_satisfied twice with
+  current active columns restricted to q1 and q2,
+  That way,
+  - others orpats in qs.ors will not get expanded.
+  - all matching work performed on qs.no_ors is not performed again.
+  *)
+and every_both pss qs q1 q2 =
+  let qs1 = {qs with active=[q1]}
+  and qs2 =  {qs with active=[q2]} in
+  let r1 = every_satisfiables pss qs1
+  and r2 =  every_satisfiables (if compat q1 q2 then qs1::pss else pss) qs2 in
+  match r1 with
+  | Unused ->
+      begin match r2 with
+      | Unused -> Unused
+      | Used   -> Upartial [q1]
+      | Upartial u2 -> Upartial (q1::u2)
+      end
+  | Used ->
+      begin match r2 with
+      | Unused -> Upartial [q2]
+      | _      -> r2
+      end
+  | Upartial u1 ->
+      begin match r2 with
+      | Unused -> Upartial (u1@[q2])
+      | Used   -> r1
+      | Upartial u2 -> Upartial (u1 @ u2)
+      end
+
+
+
+
+(* le_pat p q  means, forall V,  V matches q implies V matches p *)
+let rec le_pat p q =
+  match (p.pat_desc, q.pat_desc) with
+  | (Tpat_var _|Tpat_any),_ -> true
+  | Tpat_alias(p,_,_), _ -> le_pat p q
+  | _, Tpat_alias(q,_,_) -> le_pat p q
+  | Tpat_constant(c1), Tpat_constant(c2) -> const_compare c1 c2 = 0
+  | Tpat_construct(_,c1,ps), Tpat_construct(_,c2,qs) ->
+      Types.equal_tag c1.cstr_tag c2.cstr_tag && le_pats ps qs
+  | Tpat_variant(l1,Some p1,_), Tpat_variant(l2,Some p2,_) ->
+      (l1 = l2 && le_pat p1 p2)
+  | Tpat_variant(l1,None,_r1), Tpat_variant(l2,None,_) ->
+      l1 = l2
+  | Tpat_variant(_,_,_), Tpat_variant(_,_,_) -> false
+  | Tpat_tuple(ps), Tpat_tuple(qs) -> le_pats ps qs
+  | Tpat_lazy p, Tpat_lazy q -> le_pat p q
+  | Tpat_record (l1,_), Tpat_record (l2,_) ->
+      let ps,qs = records_args l1 l2 in
+      le_pats ps qs
+  | Tpat_array(ps), Tpat_array(qs) ->
+      List.length ps = List.length qs && le_pats ps qs
+(* In all other cases, enumeration is performed *)
+  | _,_  -> not (satisfiable [[p]] [q])
+
+and le_pats ps qs =
+  match ps,qs with
+    p::ps, q::qs -> le_pat p q && le_pats ps qs
+  | _, _         -> true
+
+let get_mins le ps =
+  let rec select_rec r = function
+      [] -> r
+    | p::ps ->
+        if List.exists (fun p0 -> le p0 p) ps
+        then select_rec r ps
+        else select_rec (p::r) ps in
+  select_rec [] (select_rec [] ps)
+
+(*
+  lub p q is a pattern that matches all values matched by p and q
+  may raise Empty, when p and q are not compatible
+*)
+
+let rec lub p q = match p.pat_desc,q.pat_desc with
+| Tpat_alias (p,_,_),_      -> lub p q
+| _,Tpat_alias (q,_,_)      -> lub p q
+| (Tpat_any|Tpat_var _),_ -> q
+| _,(Tpat_any|Tpat_var _) -> p
+| Tpat_or (p1,p2,_),_     -> orlub p1 p2 q
+| _,Tpat_or (q1,q2,_)     -> orlub q1 q2 p (* Thanks god, lub is commutative *)
+| Tpat_constant c1, Tpat_constant c2 when const_compare c1 c2 = 0 -> p
+| Tpat_tuple ps, Tpat_tuple qs ->
+    let rs = lubs ps qs in
+    make_pat (Tpat_tuple rs) p.pat_type p.pat_env
+| Tpat_lazy p, Tpat_lazy q ->
+    let r = lub p q in
+    make_pat (Tpat_lazy r) p.pat_type p.pat_env
+| Tpat_construct (lid, c1,ps1), Tpat_construct (_,c2,ps2)
+      when  Types.equal_tag c1.cstr_tag c2.cstr_tag  ->
+        let rs = lubs ps1 ps2 in
+        make_pat (Tpat_construct (lid, c1,rs))
+          p.pat_type p.pat_env
+| Tpat_variant(l1,Some p1,row), Tpat_variant(l2,Some p2,_)
+          when  l1=l2 ->
+            let r=lub p1 p2 in
+            make_pat (Tpat_variant (l1,Some r,row)) p.pat_type p.pat_env
+| Tpat_variant (l1,None,_row), Tpat_variant(l2,None,_)
+              when l1 = l2 -> p
+| Tpat_record (l1,closed),Tpat_record (l2,_) ->
+    let rs = record_lubs l1 l2 in
+    make_pat (Tpat_record (rs, closed)) p.pat_type p.pat_env
+| Tpat_array ps, Tpat_array qs
+      when List.length ps = List.length qs ->
+        let rs = lubs ps qs in
+        make_pat (Tpat_array rs) p.pat_type p.pat_env
+| _,_  ->
+    raise Empty
+
+and orlub p1 p2 q =
+  try
+    let r1 = lub p1 q in
+    try
+      {q with pat_desc=(Tpat_or (r1,lub p2 q,None))}
+  with
+  | Empty -> r1
+with
+| Empty -> lub p2 q
+
+and record_lubs l1 l2 =
+  let rec lub_rec l1 l2 = match l1,l2 with
+  | [],_ -> l2
+  | _,[] -> l1
+  | (lid1, lbl1,p1)::rem1, (lid2, lbl2,p2)::rem2 ->
+      if lbl1.lbl_pos < lbl2.lbl_pos then
+        (lid1, lbl1,p1)::lub_rec rem1 l2
+      else if lbl2.lbl_pos < lbl1.lbl_pos  then
+        (lid2, lbl2,p2)::lub_rec l1 rem2
+      else
+        (lid1, lbl1,lub p1 p2)::lub_rec rem1 rem2 in
+  lub_rec l1 l2
+
+and lubs ps qs = match ps,qs with
+| p::ps, q::qs -> lub p q :: lubs ps qs
+| _,_ -> []
+
+
+(******************************)
+(* Exported variant closing   *)
+(******************************)
+
+(* Apply pressure to variants *)
+
+let pressure_variants tdefs patl =
+  ignore (pressure_variants
+            (Some tdefs)
+            (List.map (fun p -> [p; omega]) patl))
+
+let pressure_variants_in_computation_pattern tdefs patl =
+  let add_row pss p_opt =
+    match p_opt with
+    | None -> pss
+    | Some p -> p :: pss
+  in
+  let val_pss, exn_pss =
+    List.fold_right (fun pat (vpss, epss)->
+      let (vp, ep) = split_pattern pat in
+      add_row vpss vp, add_row epss ep
+    ) patl ([], [])
+  in
+  pressure_variants tdefs val_pss;
+  pressure_variants tdefs exn_pss
+
+(*****************************)
+(* Utilities for diagnostics *)
+(*****************************)
+
+(*
+  Build up a working pattern matrix by forgetting
+  about guarded patterns
+*)
+
+let rec initial_matrix = function
+    [] -> []
+  | {c_guard=Some _} :: rem -> initial_matrix rem
+  | {c_guard=None; c_lhs=p} :: rem -> [p] :: initial_matrix rem
+
+(*
+   Build up a working pattern matrix by keeping
+   only the patterns which are guarded
+*)
+let rec initial_only_guarded = function
+  | [] -> []
+  | { c_guard = None; _} :: rem ->
+      initial_only_guarded rem
+  | { c_lhs = pat; _ } :: rem ->
+      [pat] :: initial_only_guarded rem
+
+
+(************************)
+(* Exhaustiveness check *)
+(************************)
+
+(* conversion from Typedtree.pattern to Parsetree.pattern list *)
+module Conv = struct
+  open Parsetree
+  let mkpat desc = Ast_helper.Pat.mk desc
+
+  let name_counter = ref 0
+  let fresh name =
+    let current = !name_counter in
+    name_counter := !name_counter + 1;
+    "#$" ^ name ^ Int.to_string current
+
+  let conv typed =
+    let constrs = Hashtbl.create 7 in
+    let labels = Hashtbl.create 7 in
+    let rec loop pat =
+      match pat.pat_desc with
+        Tpat_or (pa,pb,_) ->
+          mkpat (Ppat_or (loop pa, loop pb))
+      | Tpat_var (_, ({txt="*extension*"} as nm)) -> (* PR#7330 *)
+          mkpat (Ppat_var nm)
+      | Tpat_any
+      | Tpat_var _ ->
+          mkpat Ppat_any
+      | Tpat_constant c ->
+          mkpat (Ppat_constant (Untypeast.constant c))
+      | Tpat_alias (p,_,_) -> loop p
+      | Tpat_tuple lst ->
+          mkpat (Ppat_tuple (List.map loop lst))
+      | Tpat_construct (cstr_lid, cstr, lst) ->
+          let id = fresh cstr.cstr_name in
+          let lid = { cstr_lid with txt = Longident.Lident id } in
+          Hashtbl.add constrs id cstr;
+          let arg =
+            match List.map loop lst with
+            | []  -> None
+            | [p] -> Some p
+            | lst -> Some (mkpat (Ppat_tuple lst))
+          in
+          mkpat (Ppat_construct(lid, arg))
+      | Tpat_variant(label,p_opt,_row_desc) ->
+          let arg = Option.map loop p_opt in
+          mkpat (Ppat_variant(label, arg))
+      | Tpat_record (subpatterns, _closed_flag) ->
+          let fields =
+            List.map
+              (fun (_, lbl, p) ->
+                let id = fresh lbl.lbl_name in
+                Hashtbl.add labels id lbl;
+                (mknoloc (Longident.Lident id), loop p))
+              subpatterns
+          in
+          mkpat (Ppat_record (fields, Open))
+      | Tpat_array lst ->
+          mkpat (Ppat_array (List.map loop lst))
+      | Tpat_lazy p ->
+          mkpat (Ppat_lazy (loop p))
+    in
+    let ps = loop typed in
+    (ps, constrs, labels)
+end
+
+
+(* Whether the counter-example contains an extension pattern *)
+let contains_extension pat =
+  exists_pattern
+    (function
+     | {pat_desc=Tpat_var (_, {txt="*extension*"})} -> true
+     | _ -> false)
+    pat
+
+(* Build a pattern from its expected type *)
+type pat_explosion = PE_single | PE_gadt_cases
+type ppat_of_type =
+  | PT_empty
+  | PT_any
+  | PT_pattern of
+      pat_explosion *
+      Parsetree.pattern *
+      (string, constructor_description) Hashtbl.t *
+      (string, label_description) Hashtbl.t
+
+let ppat_of_type env ty =
+  match pats_of_type env ty with
+  | [] -> PT_empty
+  | [{pat_desc = Tpat_any}] -> PT_any
+  | [pat] ->
+      let (ppat, constrs, labels) = Conv.conv pat in
+      PT_pattern (PE_single, ppat, constrs, labels)
+  | pats ->
+      let (ppat, constrs, labels) = Conv.conv (orify_many pats) in
+      PT_pattern (PE_gadt_cases, ppat, constrs, labels)
+
+let do_check_partial ~pred loc casel pss = match pss with
+| [] ->
+        (*
+          This can occur
+          - For empty matches generated by ocamlp4 (no warning)
+          - when all patterns have guards (then, casel <> [])
+          (specific warning)
+          Then match MUST be considered non-exhaustive,
+          otherwise compilation of PM is broken.
+          *)
+    begin match casel with
+    | [] -> ()
+    | _  ->
+      if Warnings.is_active Warnings.All_clauses_guarded then
+        Location.prerr_warning loc Warnings.All_clauses_guarded
+    end ;
+    Partial
+| ps::_  ->
+    begin match exhaust None pss (List.length ps) with
+    | No_matching_value -> Total
+    | Witnesses [u] ->
+        let v =
+          let (pattern,constrs,labels) = Conv.conv u in
+          let u' = pred constrs labels pattern in
+          (* pretty_pat u;
+          begin match u' with
+            None -> prerr_endline ": impossible"
+          | Some _ -> prerr_endline ": possible"
+          end; *)
+          u'
+        in
+        begin match v with
+          None -> Total
+        | Some v ->
+            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
+                  Printpat.top_pretty fmt 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 _ ->
+                  ""
+              in
+                Location.prerr_warning loc (Warnings.Partial_match errmsg)
+            end;
+            Partial
+        end
+    | _ ->
+        fatal_error "Parmatch.check_partial"
+    end
+
+(*****************)
+(* Fragile check *)
+(*****************)
+
+(* Collect all data types in a pattern *)
+
+let rec add_path path = function
+  | [] -> [path]
+  | x::rem as paths ->
+      if Path.same path x then paths
+      else x::add_path path rem
+
+let extendable_path path =
+  not
+    (Path.same path Predef.path_bool ||
+    Path.same path Predef.path_list ||
+    Path.same path Predef.path_unit ||
+    Path.same path Predef.path_option)
+
+let rec collect_paths_from_pat r p = match p.pat_desc with
+| Tpat_construct(_, {cstr_tag=(Cstr_constant _|Cstr_block _|Cstr_unboxed)},ps)
+  ->
+    let path = get_constructor_type_path p.pat_type p.pat_env in
+    List.fold_left
+      collect_paths_from_pat
+      (if extendable_path path then add_path path r else r)
+      ps
+| Tpat_any|Tpat_var _|Tpat_constant _| Tpat_variant (_,None,_) -> r
+| Tpat_tuple ps | Tpat_array ps
+| Tpat_construct (_, {cstr_tag=Cstr_extension _}, ps)->
+    List.fold_left collect_paths_from_pat r ps
+| Tpat_record (lps,_) ->
+    List.fold_left
+      (fun r (_, _, p) -> collect_paths_from_pat r p)
+      r lps
+| Tpat_variant (_, Some p, _) | Tpat_alias (p,_,_) -> collect_paths_from_pat r p
+| Tpat_or (p1,p2,_) ->
+    collect_paths_from_pat (collect_paths_from_pat r p1) p2
+| Tpat_lazy p
+    ->
+    collect_paths_from_pat r p
+
+
+(*
+  Actual fragile check
+   1. Collect data types in the patterns of the match.
+   2. One exhaustivity check per datatype, considering that
+      the type is extended.
+*)
+
+let do_check_fragile loc casel pss =
+  let exts =
+    List.fold_left
+      (fun r c -> collect_paths_from_pat r c.c_lhs)
+      [] casel in
+  match exts with
+  | [] -> ()
+  | _ -> match pss with
+    | [] -> ()
+    | ps::_ ->
+        List.iter
+          (fun ext ->
+            match exhaust (Some ext) pss (List.length ps) with
+            | No_matching_value ->
+                Location.prerr_warning
+                  loc
+                  (Warnings.Fragile_match (Path.name ext))
+            | Witnesses _ -> ())
+          exts
+
+(********************************)
+(* Exported unused clause check *)
+(********************************)
+
+let check_unused pred casel =
+  if Warnings.is_active Warnings.Unused_match
+  || List.exists (fun c -> c.c_rhs.exp_desc = Texp_unreachable) casel then
+    let rec do_rec pref = function
+      | [] -> ()
+      | {c_lhs=q; c_guard; c_rhs} :: rem ->
+          let qs = [q] in
+            begin try
+              let pss =
+                  get_mins le_pats (List.filter (compats qs) pref) in
+              (* First look for redundant or partially redundant patterns *)
+              let r = every_satisfiables (make_rows pss) (make_row qs) in
+              let refute = (c_rhs.exp_desc = Texp_unreachable) in
+              (* Do not warn for unused [pat -> .] *)
+              if r = Unused && refute then () else
+              let r =
+                (* Do not refine if either:
+                   - we already know the clause is unused
+                   - the clause under consideration is not a refutation clause
+                     and either:
+                     + there are no other lines
+                     + we do not care whether the types prevent this clause to
+                       be reached.
+                     If the clause under consideration *is* a refutation clause
+                     then we do need to check more carefully whether it can be
+                     refuted or not.  *)
+                let skip =
+                  r = Unused || (not refute && pref = []) ||
+                  not(refute || Warnings.is_active Warnings.Unreachable_case) in
+                if skip then r else
+                (* Then look for empty patterns *)
+                let sfs = list_satisfying_vectors pss qs in
+                if sfs = [] then Unused else
+                let sfs =
+                  List.map (function [u] -> u | _ -> assert false) sfs in
+                let u = orify_many sfs in
+                (*Format.eprintf "%a@." pretty_val u;*)
+                let (pattern,constrs,labels) = Conv.conv u in
+                let pattern = {pattern with Parsetree.ppat_loc = q.pat_loc} in
+                match pred refute constrs labels pattern with
+                  None when not refute ->
+                    Location.prerr_warning q.pat_loc Warnings.Unreachable_case;
+                    Used
+                | _ -> r
+              in
+              match r with
+              | Unused ->
+                  Location.prerr_warning
+                    q.pat_loc Warnings.Unused_match
+              | Upartial ps ->
+                  List.iter
+                    (fun p ->
+                      Location.prerr_warning
+                        p.pat_loc Warnings.Unused_pat)
+                    ps
+              | Used -> ()
+            with Empty | Not_found -> assert false
+            end ;
+
+          if c_guard <> None then
+            do_rec pref rem
+          else
+            do_rec ([q]::pref) rem in
+
+    do_rec [] casel
+
+(*********************************)
+(* Exported irrefutability tests *)
+(*********************************)
+
+let irrefutable pat = le_pat pat omega
+
+let inactive ~partial pat =
+  match partial with
+  | Partial -> false
+  | Total -> begin
+      let rec loop pat =
+        match pat.pat_desc with
+        | Tpat_lazy _ | Tpat_array _ ->
+          false
+        | Tpat_any | Tpat_var _ | Tpat_variant (_, None, _) ->
+            true
+        | Tpat_constant c -> begin
+            match c with
+            | Const_string _ -> Config.safe_string
+            | Const_int _ | Const_char _ | Const_float _
+            | Const_int32 _ | Const_int64 _ | Const_nativeint _ -> true
+          end
+        | Tpat_tuple ps | Tpat_construct (_, _, ps) ->
+            List.for_all (fun p -> loop p) ps
+        | Tpat_alias (p,_,_) | Tpat_variant (_, Some p, _) ->
+            loop p
+        | Tpat_record (ldps,_) ->
+            List.for_all
+              (fun (_, lbl, p) -> lbl.lbl_mut = Immutable && loop p)
+              ldps
+        | Tpat_or (p,q,_) ->
+            loop p && loop q
+      in
+      loop pat
+  end
+
+
+
+
+
+
+
+(*********************************)
+(* Exported exhaustiveness check *)
+(*********************************)
+
+(*
+   Fragile check is performed when required and
+   on exhaustive matches only.
+*)
+
+let check_partial pred loc casel =
+  let pss = initial_matrix casel in
+  let pss = get_mins le_pats pss in
+  let total = do_check_partial ~pred loc casel pss in
+  if
+    total = Total && Warnings.is_active (Warnings.Fragile_match "")
+  then begin
+    do_check_fragile loc casel pss
+  end ;
+  total
+
+(*************************************)
+(* Ambiguous variable in or-patterns *)
+(*************************************)
+
+(* Specification: ambiguous variables in or-patterns.
+
+   The semantics of or-patterns in OCaml is specified with
+   a left-to-right bias: a value [v] matches the pattern [p | q] if it
+   matches [p] or [q], but if it matches both, the environment
+   captured by the match is the environment captured by [p], never the
+   one captured by [q].
+
+   While this property is generally well-understood, one specific case
+   where users expect a different semantics is when a pattern is
+   followed by a when-guard: [| p when g -> e]. Consider for example:
+
+     | ((Const x, _) | (_, Const x)) when is_neutral x -> branch
+
+   The semantics is clear: match the scrutinee against the pattern, if
+   it matches, test the guard, and if the guard passes, take the
+   branch.
+
+   However, consider the input [(Const a, Const b)], where [a] fails
+   the test [is_neutral f], while [b] passes the test [is_neutral
+   b]. With the left-to-right semantics, the clause above is *not*
+   taken by its input: matching [(Const a, Const b)] against the
+   or-pattern succeeds in the left branch, it returns the environment
+   [x -> a], and then the guard [is_neutral a] is tested and fails,
+   the branch is not taken. Most users, however, intuitively expect
+   that any pair that has one side passing the test will take the
+   branch. They assume it is equivalent to the following:
+
+     | (Const x, _) when is_neutral x -> branch
+     | (_, Const x) when is_neutral x -> branch
+
+   while it is not.
+
+   The code below is dedicated to finding these confusing cases: the
+   cases where a guard uses "ambiguous" variables, that are bound to
+   different parts of the scrutinees by different sides of
+   a or-pattern. In other words, it finds the cases where the
+   specified left-to-right semantics is not equivalent to
+   a non-deterministic semantics (any branch can be taken) relatively
+   to a specific guard.
+*)
+
+let pattern_vars p = Ident.Set.of_list (Typedtree.pat_bound_idents p)
+
+(* Row for ambiguous variable search,
+   row is the traditional pattern row,
+   varsets contain a list of head variable sets (varsets)
+
+   A given varset contains all the variables that appeared at the head
+   of a pattern in the row at some point during traversal: they would
+   all be bound to the same value at matching time. On the contrary,
+   two variables of different varsets appeared at different places in
+   the pattern and may be bound to distinct sub-parts of the matched
+   value.
+
+   All rows of a (sub)matrix have rows of the same length,
+   but also varsets of the same length.
+
+   Varsets are populated when simplifying the first column
+   -- the variables of the head pattern are collected in a new varset.
+   For example,
+     { row = x :: r1; varsets = s1 }
+     { row = (Some _) as y :: r2; varsets  = s2 }
+     { row = (None as x) as y :: r3; varsets = s3 }
+     { row = (Some x | (None as x)) :: r4 with varsets = s4 }
+   becomes
+     (_, { row = r1; varsets = {x} :: s1 })
+     (Some _, { row = r2; varsets = {y} :: s2 })
+     (None, { row = r3; varsets = {x, y} :: s3 })
+     (Some x, { row = r4; varsets = {} :: s4 })
+     (None, { row = r4; varsets = {x} :: s4 })
+*)
+type amb_row = { row : pattern list ; varsets : Ident.Set.t list; }
+
+let simplify_head_amb_pat head_bound_variables varsets ~add_column p ps k =
+  let rec simpl head_bound_variables varsets p ps k =
+    match p.pat_desc with
+    | Tpat_alias (p,x,_) ->
+      simpl (Ident.Set.add x head_bound_variables) varsets p ps k
+    | Tpat_var (x,_) ->
+      let rest_of_the_row =
+        { row = ps; varsets = Ident.Set.add x head_bound_variables :: varsets; }
+      in
+      add_column (Pattern_head.deconstruct omega) rest_of_the_row k
+    | Tpat_or (p1,p2,_) ->
+      simpl head_bound_variables varsets p1 ps
+        (simpl head_bound_variables varsets p2 ps k)
+    | _ ->
+      add_column (Pattern_head.deconstruct p)
+        { row = ps; varsets = head_bound_variables :: varsets; } k
+  in simpl head_bound_variables varsets p ps k
+
+(*
+   To accurately report ambiguous variables, one must consider
+   that previous clauses have already matched some values.
+   Consider for example:
+
+     | (Foo x, Foo y) -> ...
+     | ((Foo x, _) | (_, Foo x)) when bar x -> ...
+
+   The second line taken in isolation uses an unstable variable,
+   but the discriminating values, of the shape [(Foo v1, Foo v2)],
+   would all be filtered by the line above.
+
+   To track this information, the matrices we analyze contain both
+   *positive* rows, that describe the rows currently being analyzed
+   (of type Varsets.row, so that their varsets are tracked) and
+   *negative rows*, that describe the cases already matched against.
+
+   The values matched by a signed matrix are the values matched by
+   some of the positive rows but none of the negative rows. In
+   particular, a variable is stable if, for any value not matched by
+   any of the negative rows, the environment captured by any of the
+   matching positive rows is identical.
+*)
+type ('a, 'b) signed = Positive of 'a | Negative of 'b
+
+let rec simplify_first_amb_col = function
+  | [] -> []
+  | (Negative [] | Positive { row = []; _ }) :: _  -> assert false
+  | Negative (n :: ns) :: rem ->
+      let add_column n ns k = (n, Negative ns) :: k in
+      simplify_head_pat
+        ~add_column n ns (simplify_first_amb_col rem)
+  | Positive { row = p::ps; varsets; }::rem ->
+      let add_column p ps k = (p, Positive ps) :: k in
+      simplify_head_amb_pat
+        Ident.Set.empty varsets
+        ~add_column p ps (simplify_first_amb_col rem)
+
+(* Compute stable bindings *)
+
+type stable_vars =
+  | All
+  | Vars of Ident.Set.t
+
+let stable_inter sv1 sv2 = match sv1, sv2 with
+  | All, sv | sv, All -> sv
+  | Vars s1, Vars s2 -> Vars (Ident.Set.inter s1 s2)
+
+let reduce f = function
+| [] -> invalid_arg "reduce"
+| x::xs -> List.fold_left f x xs
+
+let rec matrix_stable_vars m = match m with
+  | [] -> All
+  | ((Positive {row = []; _} | Negative []) :: _) as empty_rows ->
+      let exception Negative_empty_row in
+      (* if at least one empty row is negative, the matrix matches no value *)
+      let get_varsets = function
+        | Negative n ->
+            (* All rows have the same number of columns;
+               if the first row is empty, they all are. *)
+            assert (n = []);
+            raise Negative_empty_row
+        | Positive p ->
+            assert (p.row = []);
+            p.varsets in
+      begin match List.map get_varsets empty_rows with
+      | exception Negative_empty_row -> All
+      | rows_varsets ->
+          let stables_in_varsets =
+            reduce (List.map2 Ident.Set.inter) rows_varsets in
+          (* The stable variables are those stable at any position *)
+          Vars
+            (List.fold_left Ident.Set.union Ident.Set.empty stables_in_varsets)
+      end
+  | m ->
+      let is_negative = function
+        | Negative _ -> true
+        | Positive _ -> false in
+      if List.for_all is_negative m then
+        (* optimization: quit early if there are no positive rows.
+           This may happen often when the initial matrix has many
+           negative cases and few positive cases (a small guarded
+           clause after a long list of clauses) *)
+        All
+      else begin
+        let m = simplify_first_amb_col m in
+        if not (all_coherent (first_column m)) then
+          All
+        else begin
+          (* If the column is ill-typed but deemed coherent, we might
+             spuriously warn about some variables being unstable.
+             As sad as that might be, the warning can be silenced by
+             splitting the or-pattern...  *)
+          let submatrices =
+            let extend_row columns = function
+              | Negative r -> Negative (columns @ r)
+              | Positive r -> Positive { r with row = columns @ r.row } in
+            let q0 = discr_pat omega m in
+            let { default; constrs } =
+              build_specialized_submatrices ~extend_row q0 m in
+            let non_default = List.map snd constrs in
+            if full_match false constrs
+            then non_default
+            else default :: non_default in
+          (* A stable variable must be stable in each submatrix. *)
+          let submat_stable = List.map matrix_stable_vars submatrices in
+          List.fold_left stable_inter All submat_stable
+        end
+      end
+
+let pattern_stable_vars ns p =
+  matrix_stable_vars
+    (List.fold_left (fun m n -> Negative n :: m)
+       [Positive {varsets = []; row = [p]}] ns)
+
+(* All identifier paths that appear in an expression that occurs
+   as a clause right hand side or guard.
+
+  The function is rather complex due to the compilation of
+  unpack patterns by introducing code in rhs expressions
+  and **guards**.
+
+  For pattern (module M:S)  -> e the code is
+  let module M_mod = unpack M .. in e
+
+  Hence M is "free" in e iff M_mod is free in e.
+
+  Not doing so will yield excessive  warning in
+  (module (M:S) } ...) when true -> ....
+  as M is always present in
+  let module M_mod = unpack M .. in true
+*)
+
+let all_rhs_idents exp =
+  let ids = ref Ident.Set.empty in
+(* Very hackish, detect unpack pattern  compilation
+   and perform "indirect check for them" *)
+  let is_unpack exp =
+      List.exists
+        (fun attr -> attr.Parsetree.attr_name.txt = "#modulepat")
+        exp.exp_attributes in
+  let open Tast_iterator in
+  let expr_iter iter exp =
+    (match exp.exp_desc with
+      | Texp_ident (path, _lid, _descr) ->
+        List.iter (fun id -> ids := Ident.Set.add id !ids) (Path.heads path)
+      (* Use default iterator methods for rest of match.*)
+      | _ -> Tast_iterator.default_iterator.expr iter exp);
+
+    if is_unpack exp then begin match exp.exp_desc with
+    | Texp_letmodule
+        (id_mod,_,_,
+         {mod_desc=
+          Tmod_unpack ({exp_desc=Texp_ident (Path.Pident id_exp,_,_)},_)},
+         _) ->
+           assert (Ident.Set.mem id_exp !ids) ;
+           begin match id_mod with
+           | Some id_mod when not (Ident.Set.mem id_mod !ids) ->
+             ids := Ident.Set.remove id_exp !ids
+           | _ -> ()
+           end
+    | _ -> assert false
+    end
+  in
+  let iterator = {Tast_iterator.default_iterator with expr = expr_iter} in
+  iterator.expr iterator exp;
+  !ids
+
+let check_ambiguous_bindings =
+  let open Warnings in
+  let warn0 = Ambiguous_pattern [] in
+  fun cases ->
+    if is_active warn0 then
+      let check_case ns case = match case with
+        | { c_lhs = p; c_guard=None ; _} -> [p]::ns
+        | { c_lhs=p; c_guard=Some g; _} ->
+            let all =
+              Ident.Set.inter (pattern_vars p) (all_rhs_idents g) in
+            if not (Ident.Set.is_empty all) then begin
+              match pattern_stable_vars ns p with
+              | All -> ()
+              | Vars stable ->
+                  let ambiguous = Ident.Set.diff all stable in
+                  if not (Ident.Set.is_empty ambiguous) then begin
+                    let pps =
+                      Ident.Set.elements ambiguous |> List.map Ident.name in
+                    let warn = Ambiguous_pattern pps in
+                    Location.prerr_warning p.pat_loc warn
+                  end
+            end;
+            ns
+      in
+      ignore (List.fold_left check_case [] cases)
diff --git a/typing/parmatch.mli b/typing/parmatch.mli
new file mode 100644
index 00000000..e6952be7
--- /dev/null
+++ b/typing/parmatch.mli
@@ -0,0 +1,187 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Detection of partial matches and unused match cases. *)
+
+open Asttypes
+open Typedtree
+open Types
+
+val omega : pattern
+(** aka. "Tpat_any" or "_"  *)
+
+val omegas : int -> pattern list
+(** [List.init (fun _ -> omega)] *)
+
+val omega_list : 'a list -> pattern list
+(** [List.map (fun _ -> omega)] *)
+
+module Pattern_head : sig
+  type desc =
+    | Any
+    | Construct of constructor_description
+    | Constant of constant
+    | Tuple of int
+    | Record of label_description list
+    | Variant of
+        { tag: label; has_arg: bool;
+          cstr_row: row_desc ref;
+          type_row : unit -> row_desc; }
+          (* the row of the type may evolve if [close_variant] is called,
+             hence the (unit -> ...) delay *)
+    | Array of int
+    | Lazy
+
+  type t
+
+  val desc : t -> desc
+  val env : t -> Env.t
+  val loc : t -> Location.t
+  val typ : t -> Types.type_expr
+
+  (** [deconstruct p] returns the head of [p] and the list of sub patterns.
+
+      @raises [Invalid_arg _] if [p] is an or- or an exception-pattern.  *)
+  val deconstruct : pattern -> t * pattern list
+
+  (** reconstructs a pattern, putting wildcards as sub-patterns. *)
+  val to_omega_pattern : t -> pattern
+
+  val make
+    :  loc:Location.t
+    -> typ:Types.type_expr
+    -> env:Env.t
+    -> desc
+    -> t
+
+  val omega : t
+
+end
+
+val normalize_pat : pattern -> pattern
+(** Keep only the "head" of a pattern: all arguments are replaced by [omega], so
+    are variables. *)
+
+val const_compare : constant -> constant -> int
+(** [const_compare c1 c2] compares the actual values represented by [c1] and
+    [c2], while simply using [Stdlib.compare] would compare the
+    representations.
+
+    cf. MPR#5758 *)
+
+val le_pat : pattern -> pattern -> bool
+(** [le_pat p q]  means: forall V,  V matches q implies V matches p *)
+
+val le_pats : pattern list -> pattern list -> bool
+(** [le_pats (p1 .. pm) (q1 .. qn)] means: forall i <= m, [le_pat pi qi] *)
+
+(** Exported compatibility functor, abstracted over constructor equality *)
+module Compat :
+  functor
+    (_ : sig
+      val equal :
+          Types.constructor_description ->
+            Types.constructor_description ->
+              bool
+     end) -> sig
+       val compat : pattern -> pattern -> bool
+       val compats : pattern list -> pattern list -> bool
+     end
+
+exception Empty
+
+val lub : pattern -> pattern -> pattern
+(** [lub p q] is a pattern that matches all values matched by [p] and [q].
+    May raise [Empty], when [p] and [q] are not compatible. *)
+
+val lubs : pattern list -> pattern list -> pattern list
+(** [lubs [p1; ...; pn] [q1; ...; qk]], where [n < k], is
+    [[lub p1 q1; ...; lub pk qk]].  *)
+
+val get_mins : ('a -> 'a -> bool) -> 'a list -> 'a list
+
+(** Those two functions recombine 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 :
+    pattern -> constructor_tag list -> constructor_description  list
+
+(** [ppat_of_type] builds an untyped pattern from its expected type,
+    for explosion of wildcard patterns in Typecore.type_pat.
+
+    There are four interesting cases:
+    - the type is empty ([PT_empty])
+    - no further explosion is necessary ([PT_any])
+    - a single pattern is generated, from a record or tuple type
+      or a single-variant type ([PE_single])
+    - an or-pattern is generated, in the case that all branches
+      are GADT constructors ([PE_gadt_cases]).
+ *)
+type pat_explosion = PE_single | PE_gadt_cases
+type ppat_of_type =
+  | PT_empty
+  | PT_any
+  | PT_pattern of
+      pat_explosion *
+      Parsetree.pattern *
+      (string, constructor_description) Hashtbl.t *
+      (string, label_description) Hashtbl.t
+
+val ppat_of_type: Env.t -> type_expr -> ppat_of_type
+
+val pressure_variants:
+  Env.t -> pattern list -> unit
+val pressure_variants_in_computation_pattern:
+  Env.t -> computation general_pattern list -> unit
+
+(** [check_partial pred loc caselist] and [check_unused refute pred caselist]
+    are called with a function [pred] which will be given counter-example
+    candidates: they may be partially ill-typed, and have to be type-checked
+    to extract a valid counter-example.
+    [pred] returns a valid counter-example or [None].
+    [refute] indicates that [check_unused] was called on a refutation clause.
+ *)
+val check_partial:
+    ((string, constructor_description) Hashtbl.t ->
+     (string, label_description) Hashtbl.t ->
+     Parsetree.pattern -> pattern option) ->
+    Location.t -> value case list -> partial
+val check_unused:
+    (bool ->
+     (string, constructor_description) Hashtbl.t ->
+     (string, label_description) Hashtbl.t ->
+     Parsetree.pattern -> pattern option) ->
+    value case list -> unit
+
+(* Irrefutability tests *)
+val irrefutable : pattern -> bool
+
+(** An inactive pattern is a pattern, matching against which can be duplicated,
+    erased or delayed without change in observable behavior of the program.
+    Patterns containing (lazy _) subpatterns or reads of mutable fields are
+    active. *)
+val inactive : partial:partial -> pattern -> bool
+
+(* Ambiguous bindings *)
+val check_ambiguous_bindings : value case list -> unit
+
+(* The tag used for open polymorphic variant types with an abstract row *)
+val some_private_tag : label
diff --git a/typing/path.ml b/typing/path.ml
new file mode 100644
index 00000000..e5a8d7eb
--- /dev/null
+++ b/typing/path.ml
@@ -0,0 +1,129 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t =
+    Pident of Ident.t
+  | Pdot of t * string
+  | Papply of t * t
+
+let rec same p1 p2 =
+  p1 == p2
+  || match (p1, p2) with
+    (Pident id1, Pident id2) -> Ident.same id1 id2
+  | (Pdot(p1, s1), Pdot(p2, s2)) -> s1 = s2 && same p1 p2
+  | (Papply(fun1, arg1), Papply(fun2, arg2)) ->
+       same fun1 fun2 && same arg1 arg2
+  | (_, _) -> false
+
+let rec compare p1 p2 =
+  if p1 == p2 then 0
+  else match (p1, p2) with
+    (Pident id1, Pident id2) -> Ident.compare id1 id2
+  | (Pdot(p1, s1), Pdot(p2, s2)) ->
+      let h = compare p1 p2 in
+      if h <> 0 then h else String.compare s1 s2
+  | (Papply(fun1, arg1), Papply(fun2, arg2)) ->
+      let h = compare fun1 fun2 in
+      if h <> 0 then h else compare arg1 arg2
+  | ((Pident _ | Pdot _), (Pdot _ | Papply _)) -> -1
+  | ((Pdot _ | Papply _), (Pident _ | Pdot _)) -> 1
+
+let rec find_free_opt ids = function
+    Pident id -> List.find_opt (Ident.same id) ids
+  | Pdot(p, _s) -> find_free_opt ids p
+  | Papply(p1, p2) ->
+      match find_free_opt ids p1 with
+      | None -> find_free_opt ids p2
+      | Some _ as res -> res
+
+let exists_free ids p =
+  match find_free_opt ids p with
+  | None -> false
+  | _ -> true
+
+let rec scope = function
+    Pident id -> Ident.scope id
+  | Pdot(p, _s) -> scope p
+  | Papply(p1, p2) -> max (scope p1) (scope p2)
+
+let kfalse _ = false
+
+let rec name ?(paren=kfalse) = function
+    Pident id -> Ident.name id
+  | Pdot(p, s) ->
+      name ~paren p ^ if paren s then ".( " ^ s ^ " )" else "." ^ s
+  | Papply(p1, p2) -> name ~paren p1 ^ "(" ^ name ~paren p2 ^ ")"
+
+let rec print ppf = function
+  | Pident id -> Ident.print_with_scope ppf id
+  | Pdot(p, s) -> Format.fprintf ppf "%a.%s" print p s
+  | Papply(p1, p2) -> Format.fprintf ppf "%a(%a)" print p1 print p2
+
+let rec head = function
+    Pident id -> id
+  | Pdot(p, _s) -> head p
+  | Papply _ -> assert false
+
+let flatten =
+  let rec flatten acc = function
+    | Pident id -> `Ok (id, acc)
+    | Pdot (p, s) -> flatten (s :: acc) p
+    | Papply _ -> `Contains_apply
+  in
+  fun t -> flatten [] t
+
+let heads p =
+  let rec heads p acc = match p with
+    | Pident id -> id :: acc
+    | Pdot (p, _s) -> heads p acc
+    | Papply(p1, p2) ->
+        heads p1 (heads p2 acc)
+  in heads p []
+
+let rec last = function
+  | Pident id -> Ident.name id
+  | Pdot(_, s) -> s
+  | Papply(_, p) -> last p
+
+let is_uident s =
+  assert (s <> "");
+  match s.[0] with
+  | 'A'..'Z' -> true
+  | _ -> false
+
+type typath =
+  | Regular of t
+  | Ext of t * string
+  | LocalExt of Ident.t
+  | Cstr of t * string
+
+let constructor_typath = function
+  | Pident id when is_uident (Ident.name id) -> LocalExt id
+  | Pdot(ty_path, s) when is_uident s ->
+      if is_uident (last ty_path) then Ext (ty_path, s)
+      else Cstr (ty_path, s)
+  | p -> Regular p
+
+let is_constructor_typath p =
+  match constructor_typath p with
+  | Regular _ -> false
+  | _ -> true
+
+module T = struct
+  type nonrec t = t
+  let compare = compare
+end
+module Set = Set.Make(T)
+module Map = Map.Make(T)
diff --git a/typing/path.mli b/typing/path.mli
new file mode 100644
index 00000000..bddf9d67
--- /dev/null
+++ b/typing/path.mli
@@ -0,0 +1,52 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Access paths *)
+
+type t =
+    Pident of Ident.t
+  | Pdot of t * string
+  | Papply of t * t
+
+val same: t -> t -> bool
+val compare: t -> t -> int
+val find_free_opt: Ident.t list -> t -> Ident.t option
+val exists_free: Ident.t list -> t -> bool
+val scope: t -> int
+val flatten : t -> [ `Contains_apply | `Ok of Ident.t * string list ]
+
+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 heads: t -> Ident.t list
+
+val last: t -> string
+
+val is_uident: string -> bool
+
+type typath =
+  | Regular of t
+  | Ext of t * string
+  | LocalExt of Ident.t
+  | Cstr of t * string
+
+val constructor_typath: t -> typath
+val is_constructor_typath: t -> bool
+
+module Map : Map.S with type key = t
+module Set : Set.S with type elt = t
diff --git a/typing/persistent_env.ml b/typing/persistent_env.ml
new file mode 100644
index 00000000..1931f5f3
--- /dev/null
+++ b/typing/persistent_env.ml
@@ -0,0 +1,373 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Xavier Leroy, projet Gallium, INRIA Rocquencourt                     *)
+(*   Gabriel Scherer, projet Parsifal, INRIA Saclay                       *)
+(*                                                                        *)
+(*   Copyright 2019 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Persistent structure descriptions *)
+
+open Misc
+open Cmi_format
+
+module Consistbl = Consistbl.Make (Misc.Stdlib.String)
+
+let add_delayed_check_forward = ref (fun _ -> assert false)
+
+type error =
+  | Illegal_renaming of modname * modname * filepath
+  | Inconsistent_import of modname * filepath * filepath
+  | Need_recursive_types of modname
+  | Depend_on_unsafe_string_unit of modname
+
+exception Error of error
+let error err = raise (Error err)
+
+module Persistent_signature = struct
+  type t =
+    { filename : string;
+      cmi : Cmi_format.cmi_infos }
+
+  let load = ref (fun ~unit_name ->
+      match Load_path.find_uncap (unit_name ^ ".cmi") with
+      | filename -> Some { filename; cmi = read_cmi filename }
+      | exception Not_found -> None)
+end
+
+type can_load_cmis =
+  | Can_load_cmis
+  | Cannot_load_cmis of EnvLazy.log
+
+type pers_struct = {
+  ps_name: string;
+  ps_crcs: (string * Digest.t option) list;
+  ps_filename: string;
+  ps_flags: pers_flags list;
+}
+
+module String = Misc.Stdlib.String
+
+(* If a .cmi file is missing (or invalid), we
+   store it as Missing in the cache. *)
+type 'a pers_struct_info =
+  | Missing
+  | Found of pers_struct * 'a
+
+type 'a t = {
+  persistent_structures : (string, 'a pers_struct_info) Hashtbl.t;
+  imported_units: String.Set.t ref;
+  imported_opaque_units: String.Set.t ref;
+  crc_units: Consistbl.t;
+  can_load_cmis: can_load_cmis ref;
+}
+
+let empty () = {
+  persistent_structures = Hashtbl.create 17;
+  imported_units = ref String.Set.empty;
+  imported_opaque_units = ref String.Set.empty;
+  crc_units = Consistbl.create ();
+  can_load_cmis = ref Can_load_cmis;
+}
+
+let clear penv =
+  let {
+    persistent_structures;
+    imported_units;
+    imported_opaque_units;
+    crc_units;
+    can_load_cmis;
+  } = penv in
+  Hashtbl.clear persistent_structures;
+  imported_units := String.Set.empty;
+  imported_opaque_units := String.Set.empty;
+  Consistbl.clear crc_units;
+  can_load_cmis := Can_load_cmis;
+  ()
+
+let clear_missing {persistent_structures; _} =
+  let missing_entries =
+    Hashtbl.fold
+      (fun name r acc -> if r = Missing then name :: acc else acc)
+      persistent_structures []
+  in
+  List.iter (Hashtbl.remove persistent_structures) missing_entries
+
+let add_import {imported_units; _} s =
+  imported_units := String.Set.add s !imported_units
+
+let register_import_as_opaque {imported_opaque_units; _} s =
+  imported_opaque_units := String.Set.add s !imported_opaque_units
+
+let find_in_cache {persistent_structures; _} s =
+  match Hashtbl.find persistent_structures s with
+  | exception Not_found -> None
+  | Missing -> None
+  | Found (_ps, pm) -> Some pm
+
+let import_crcs penv ~source crcs =
+  let {crc_units; _} = penv in
+  let import_crc (name, crco) =
+    match crco with
+    | None -> ()
+    | Some crc ->
+        add_import penv name;
+        Consistbl.check crc_units name crc source
+  in List.iter import_crc crcs
+
+let check_consistency penv ps =
+  try import_crcs penv ~source:ps.ps_filename ps.ps_crcs
+  with Consistbl.Inconsistency {
+      unit_name = name;
+      inconsistent_source = source;
+      original_source = auth;
+    } ->
+    error (Inconsistent_import(name, auth, source))
+
+let can_load_cmis penv =
+  !(penv.can_load_cmis)
+let set_can_load_cmis penv setting =
+  penv.can_load_cmis := setting
+
+let without_cmis penv f x =
+  let log = EnvLazy.log () in
+  let res =
+    Misc.(protect_refs
+            [R (penv.can_load_cmis, Cannot_load_cmis log)]
+            (fun () -> f x))
+  in
+  EnvLazy.backtrack log;
+  res
+
+let fold {persistent_structures; _} f x =
+  Hashtbl.fold (fun modname pso x -> match pso with
+      | Missing -> x
+      | Found (_, pm) -> f modname pm x)
+    persistent_structures x
+
+(* Reading persistent structures from .cmi files *)
+
+let save_pers_struct penv crc ps pm =
+  let {persistent_structures; crc_units; _} = penv in
+  let modname = ps.ps_name in
+  Hashtbl.add persistent_structures modname (Found (ps, pm));
+  List.iter
+    (function
+        | Rectypes -> ()
+        | Alerts _ -> ()
+        | Unsafe_string -> ()
+        | Opaque -> register_import_as_opaque penv modname)
+    ps.ps_flags;
+  Consistbl.set crc_units modname crc ps.ps_filename;
+  add_import penv modname
+
+let acknowledge_pers_struct penv check modname pers_sig pm =
+  let { Persistent_signature.filename; cmi } = pers_sig in
+  let name = cmi.cmi_name in
+  let crcs = cmi.cmi_crcs in
+  let flags = cmi.cmi_flags in
+  let ps = { ps_name = name;
+             ps_crcs = crcs;
+             ps_filename = filename;
+             ps_flags = flags;
+           } in
+  if ps.ps_name <> modname then
+    error (Illegal_renaming(modname, ps.ps_name, filename));
+  List.iter
+    (function
+        | Rectypes ->
+            if not !Clflags.recursive_types then
+              error (Need_recursive_types(ps.ps_name))
+        | Unsafe_string ->
+            if Config.safe_string then
+              error (Depend_on_unsafe_string_unit(ps.ps_name));
+        | Alerts _ -> ()
+        | Opaque -> register_import_as_opaque penv modname)
+    ps.ps_flags;
+  if check then check_consistency penv ps;
+  let {persistent_structures; _} = penv in
+  Hashtbl.add persistent_structures modname (Found (ps, pm));
+  ps
+
+let read_pers_struct penv val_of_pers_sig check modname filename =
+  add_import penv modname;
+  let cmi = read_cmi filename in
+  let pers_sig = { Persistent_signature.filename; cmi } in
+  let pm = val_of_pers_sig pers_sig in
+  let ps = acknowledge_pers_struct penv check modname pers_sig pm in
+  (ps, pm)
+
+let find_pers_struct penv val_of_pers_sig check name =
+  let {persistent_structures; _} = penv in
+  if name = "*predef*" then raise Not_found;
+  match Hashtbl.find persistent_structures name with
+  | Found (ps, pm) -> (ps, pm)
+  | Missing -> raise Not_found
+  | exception Not_found ->
+    match can_load_cmis penv with
+    | Cannot_load_cmis _ -> raise Not_found
+    | Can_load_cmis ->
+        let psig =
+          match !Persistent_signature.load ~unit_name:name with
+          | Some psig -> psig
+          | None ->
+            Hashtbl.add persistent_structures name Missing;
+            raise Not_found
+        in
+        add_import penv name;
+        let pm = val_of_pers_sig psig in
+        let ps = acknowledge_pers_struct penv check name psig pm in
+        (ps, pm)
+
+(* Emits a warning if there is no valid cmi for name *)
+let check_pers_struct penv f ~loc name =
+  try
+    ignore (find_pers_struct penv f false name)
+  with
+  | Not_found ->
+      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 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
+              " %a@ contains the compiled interface for @ \
+               %s when %s was expected"
+              Location.print_filename filename ps_name name
+        | Inconsistent_import _ -> assert false
+        | Need_recursive_types name ->
+            Format.sprintf
+              "%s uses recursive types"
+              name
+        | Depend_on_unsafe_string_unit name ->
+            Printf.sprintf "%s uses -unsafe-string"
+              name
+      in
+      let warn = Warnings.No_cmi_file(name, Some msg) in
+        Location.prerr_warning loc warn
+
+let read penv f modname filename =
+  snd (read_pers_struct penv f true modname filename)
+
+let find penv f name =
+  snd (find_pers_struct penv f true name)
+
+let check penv f ~loc name =
+  let {persistent_structures; _} = penv in
+  if not (Hashtbl.mem persistent_structures name) then begin
+    (* PR#6843: record the weak dependency ([add_import]) regardless of
+       whether the check succeeds, to help make builds more
+       deterministic. *)
+    add_import penv name;
+    if (Warnings.is_active (Warnings.No_cmi_file("", None))) then
+      !add_delayed_check_forward
+        (fun () -> check_pers_struct penv f ~loc name)
+  end
+
+let crc_of_unit penv f name =
+  let (ps, _pm) = find_pers_struct penv f true name in
+  let crco =
+    try
+      List.assoc name ps.ps_crcs
+    with Not_found ->
+      assert false
+  in
+    match crco with
+      None -> assert false
+    | Some crc -> crc
+
+let imports {imported_units; crc_units; _} =
+  Consistbl.extract (String.Set.elements !imported_units) crc_units
+
+let looked_up {persistent_structures; _} modname =
+  Hashtbl.mem persistent_structures modname
+
+let is_imported {imported_units; _} s =
+  String.Set.mem s !imported_units
+
+let is_imported_opaque {imported_opaque_units; _} s =
+  String.Set.mem s !imported_opaque_units
+
+let make_cmi penv modname sign alerts =
+  let flags =
+    List.concat [
+      if !Clflags.recursive_types then [Cmi_format.Rectypes] else [];
+      if !Clflags.opaque then [Cmi_format.Opaque] else [];
+      (if !Clflags.unsafe_string then [Cmi_format.Unsafe_string] else []);
+      [Alerts alerts];
+    ]
+  in
+  let crcs = imports penv in
+  {
+    cmi_name = modname;
+    cmi_sign = sign;
+    cmi_crcs = crcs;
+    cmi_flags = flags
+  }
+
+let save_cmi penv psig pm =
+  let { Persistent_signature.filename; cmi } = psig in
+  Misc.try_finally (fun () ->
+      let {
+        cmi_name = modname;
+        cmi_sign = _;
+        cmi_crcs = imports;
+        cmi_flags = flags;
+      } = cmi in
+      let crc =
+        output_to_file_via_temporary (* see MPR#7472, MPR#4991 *)
+          ~mode: [Open_binary] filename
+          (fun temp_filename oc -> output_cmi temp_filename oc cmi) in
+      (* Enter signature in persistent table so that imports()
+         will also return its crc *)
+      let ps =
+        { ps_name = modname;
+          ps_crcs = (cmi.cmi_name, Some crc) :: imports;
+          ps_filename = filename;
+          ps_flags = flags;
+        } in
+      save_pers_struct penv crc ps pm
+    )
+    ~exceptionally:(fun () -> remove_file filename)
+
+let report_error ppf =
+  let open Format in
+  function
+  | Illegal_renaming(modname, ps_name, filename) -> fprintf ppf
+      "Wrong file naming: %a@ contains the compiled interface for@ \
+       %s when %s was expected"
+      Location.print_filename filename ps_name modname
+  | Inconsistent_import(name, source1, source2) -> fprintf ppf
+      "@[The files %a@ and %a@ \
+              make inconsistent assumptions@ over interface %s@]"
+      Location.print_filename source1 Location.print_filename source2 name
+  | Need_recursive_types(import) ->
+      fprintf ppf
+        "@[Invalid import of %s, which uses recursive types.@ %s@]"
+        import "The compilation flag -rectypes is required"
+  | Depend_on_unsafe_string_unit(import) ->
+      fprintf ppf
+        "@[Invalid import of %s, compiled with -unsafe-string.@ %s@]"
+        import "This compiler has been configured in strict \
+                                  safe-string mode (-force-safe-string)"
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err ->
+          Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )
diff --git a/typing/persistent_env.mli b/typing/persistent_env.mli
new file mode 100644
index 00000000..ac3109c3
--- /dev/null
+++ b/typing/persistent_env.mli
@@ -0,0 +1,105 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Xavier Leroy, projet Gallium, INRIA Rocquencourt                     *)
+(*   Gabriel Scherer, projet Parsifal, INRIA Saclay                       *)
+(*                                                                        *)
+(*   Copyright 2019 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Misc
+
+module Consistbl : module type of struct
+  include Consistbl.Make (Misc.Stdlib.String)
+end
+
+type error =
+  | Illegal_renaming of modname * modname * filepath
+  | Inconsistent_import of modname * filepath * filepath
+  | Need_recursive_types of modname
+  | Depend_on_unsafe_string_unit of modname
+
+exception Error of error
+
+val report_error: Format.formatter -> error -> unit
+
+module Persistent_signature : sig
+  type t =
+    { filename : string; (** Name of the file containing the signature. *)
+      cmi : Cmi_format.cmi_infos }
+
+  (** Function used to load a persistent signature. The default is to look for
+      the .cmi file in the load path. This function can be overridden to load
+      it from memory, for instance to build a self-contained toplevel. *)
+  val load : (unit_name:string -> t option) ref
+end
+
+type can_load_cmis =
+  | Can_load_cmis
+  | Cannot_load_cmis of Misc.EnvLazy.log
+
+type 'a t
+
+val empty : unit -> 'a t
+
+val clear : 'a t -> unit
+val clear_missing : 'a t -> unit
+
+val fold : 'a t -> (modname -> 'a -> 'b -> 'b) -> 'b -> 'b
+
+val read : 'a t -> (Persistent_signature.t -> 'a)
+  -> modname -> filepath -> 'a
+val find : 'a t -> (Persistent_signature.t -> 'a)
+  -> modname -> 'a
+
+val find_in_cache : 'a t -> modname -> 'a option
+
+val check : 'a t -> (Persistent_signature.t -> 'a)
+  -> loc:Location.t -> modname -> unit
+
+(* [looked_up penv md] checks if one has already tried
+   to read the signature for [md] in the environment
+   [penv] (it may have failed) *)
+val looked_up : 'a t -> modname -> bool
+
+(* [is_imported penv md] checks if [md] has been successfully
+   imported in the environment [penv] *)
+val is_imported : 'a t -> modname -> bool
+
+(* [is_imported_opaque penv md] checks if [md] has been imported
+   in [penv] as an opaque module *)
+val is_imported_opaque : 'a t -> modname -> bool
+
+(* [register_import_as_opaque penv md] registers [md] in [penv] as an
+   opaque module *)
+val register_import_as_opaque : 'a t -> modname -> unit
+
+val make_cmi : 'a t -> modname -> Types.signature -> alerts
+  -> Cmi_format.cmi_infos
+
+val save_cmi : 'a t -> Persistent_signature.t -> 'a -> unit
+
+val can_load_cmis : 'a t -> can_load_cmis
+val set_can_load_cmis : 'a t -> can_load_cmis -> unit
+val without_cmis : 'a t -> ('b -> 'c) -> 'b -> 'c
+(* [without_cmis penv f arg] applies [f] to [arg], but does not
+    allow [penv] to openi cmis during its execution *)
+
+(* may raise Consistbl.Inconsistency *)
+val import_crcs : 'a t -> source:filepath -> crcs -> unit
+
+(* Return the set of compilation units imported, with their CRC *)
+val imports : 'a t -> crcs
+
+(* Return the CRC of the interface of the given compilation unit *)
+val crc_of_unit: 'a t -> (Persistent_signature.t -> 'a) -> modname -> Digest.t
+
+(* Forward declaration to break mutual recursion with Typecore. *)
+val add_delayed_check_forward: ((unit -> unit) -> unit) ref
diff --git a/typing/predef.ml b/typing/predef.ml
new file mode 100644
index 00000000..786d1dc2
--- /dev/null
+++ b/typing/predef.ml
@@ -0,0 +1,250 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Predefined type constructors (with special typing rules in typecore) *)
+
+open Path
+open Types
+open Btype
+
+let builtin_idents = ref []
+
+let wrap create s =
+  let id = create s in
+  builtin_idents := (s, id) :: !builtin_idents;
+  id
+
+let ident_create = wrap Ident.create_predef
+
+let ident_int = ident_create "int"
+and ident_char = ident_create "char"
+and ident_bytes = ident_create "bytes"
+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_array = ident_create "array"
+and ident_list = ident_create "list"
+and ident_option = ident_create "option"
+and ident_nativeint = ident_create "nativeint"
+and ident_int32 = ident_create "int32"
+and ident_int64 = ident_create "int64"
+and ident_lazy_t = ident_create "lazy_t"
+and ident_string = ident_create "string"
+and ident_extension_constructor = ident_create "extension_constructor"
+and ident_floatarray = ident_create "floatarray"
+
+let path_int = Pident ident_int
+and path_char = Pident ident_char
+and path_bytes = Pident ident_bytes
+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_array = Pident ident_array
+and path_list = Pident ident_list
+and path_option = Pident ident_option
+and path_nativeint = Pident ident_nativeint
+and path_int32 = Pident ident_int32
+and path_int64 = Pident ident_int64
+and path_lazy_t = Pident ident_lazy_t
+and path_string = Pident ident_string
+and path_extension_constructor = Pident ident_extension_constructor
+and path_floatarray = Pident ident_floatarray
+
+let type_int = newgenty (Tconstr(path_int, [], ref Mnil))
+and type_char = newgenty (Tconstr(path_char, [], ref Mnil))
+and type_bytes = newgenty (Tconstr(path_bytes, [], ref Mnil))
+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_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))
+and type_nativeint = newgenty (Tconstr(path_nativeint, [], ref Mnil))
+and type_int32 = newgenty (Tconstr(path_int32, [], ref Mnil))
+and type_int64 = newgenty (Tconstr(path_int64, [], ref Mnil))
+and type_lazy_t t = newgenty (Tconstr(path_lazy_t, [t], ref Mnil))
+and type_string = newgenty (Tconstr(path_string, [], ref Mnil))
+and type_extension_constructor =
+      newgenty (Tconstr(path_extension_constructor, [], ref Mnil))
+and type_floatarray = newgenty (Tconstr(path_floatarray, [], ref Mnil))
+
+let ident_match_failure = ident_create "Match_failure"
+and ident_out_of_memory = ident_create "Out_of_memory"
+and ident_invalid_argument = ident_create "Invalid_argument"
+and ident_failure = ident_create "Failure"
+and ident_not_found = ident_create "Not_found"
+and ident_sys_error = ident_create "Sys_error"
+and ident_end_of_file = ident_create "End_of_file"
+and ident_division_by_zero = ident_create "Division_by_zero"
+and ident_stack_overflow = ident_create "Stack_overflow"
+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"
+
+let all_predef_exns = [
+  ident_match_failure;
+  ident_out_of_memory;
+  ident_invalid_argument;
+  ident_failure;
+  ident_not_found;
+  ident_sys_error;
+  ident_end_of_file;
+  ident_division_by_zero;
+  ident_stack_overflow;
+  ident_sys_blocked_io;
+  ident_assert_failure;
+  ident_undefined_recursive_module;
+]
+
+let path_match_failure = Pident ident_match_failure
+and path_assert_failure = Pident ident_assert_failure
+and path_undefined_recursive_module = Pident ident_undefined_recursive_module
+
+let cstr id args =
+  {
+    cd_id = id;
+    cd_args = Cstr_tuple args;
+    cd_res = None;
+    cd_loc = Location.none;
+    cd_attributes = [];
+    cd_uid = Uid.of_predef_id id;
+  }
+
+let ident_false = ident_create "false"
+and ident_true = ident_create "true"
+and ident_void = ident_create "()"
+and ident_nil = ident_create "[]"
+and ident_cons = ident_create "::"
+and ident_none = ident_create "None"
+and ident_some = ident_create "Some"
+
+let mk_add_type add_type type_ident
+      ?manifest ?(immediate=Type_immediacy.Unknown) ?(kind=Type_abstract) env =
+  let decl =
+    {type_params = [];
+     type_arity = 0;
+     type_kind = kind;
+     type_loc = Location.none;
+     type_private = Asttypes.Public;
+     type_manifest = manifest;
+     type_variance = [];
+     type_separability = [];
+     type_is_newtype = false;
+     type_expansion_scope = lowest_level;
+     type_attributes = [];
+     type_immediate = immediate;
+     type_unboxed = unboxed_false_default_false;
+     type_uid = Uid.of_predef_id type_ident;
+    }
+  in
+  add_type type_ident decl env
+
+let common_initial_env add_type add_extension empty_env =
+  let add_type = mk_add_type add_type
+  and add_type1 type_ident
+      ~variance ~separability ?(kind=fun _ -> Type_abstract) env =
+    let param = newgenvar () in
+    let decl =
+      {type_params = [param];
+       type_arity = 1;
+       type_kind = kind param;
+       type_loc = Location.none;
+       type_private = Asttypes.Public;
+       type_manifest = None;
+       type_variance = [variance];
+       type_separability = [separability];
+       type_is_newtype = false;
+       type_expansion_scope = lowest_level;
+       type_attributes = [];
+       type_immediate = Unknown;
+       type_unboxed = unboxed_false_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
+      { ext_type_path = path_exn;
+        ext_type_params = [];
+        ext_args = Cstr_tuple l;
+        ext_ret_type = None;
+        ext_private = Asttypes.Public;
+        ext_loc = Location.none;
+        ext_attributes = [Ast_helper.Attr.mk
+                            (Location.mknoloc "ocaml.warn_on_literal_pattern")
+                            (Parsetree.PStr [])];
+        ext_uid = Uid.of_predef_id id;
+      }
+  in
+  add_extension ident_match_failure
+                         [newgenty (Ttuple[type_string; type_int; type_int])] (
+  add_extension ident_out_of_memory [] (
+  add_extension ident_stack_overflow [] (
+  add_extension ident_invalid_argument [type_string] (
+  add_extension ident_failure [type_string] (
+  add_extension ident_not_found [] (
+  add_extension ident_sys_blocked_io [] (
+  add_extension ident_sys_error [type_string] (
+  add_extension ident_end_of_file [] (
+  add_extension ident_division_by_zero [] (
+  add_extension ident_assert_failure
+                         [newgenty (Ttuple[type_string; type_int; type_int])] (
+  add_extension ident_undefined_recursive_module
+                         [newgenty (Ttuple[type_string; type_int; type_int])] (
+  add_type ident_int64 (
+  add_type ident_int32 (
+  add_type ident_nativeint (
+  add_type1 ident_lazy_t ~variance:Variance.covariant
+    ~separability:Separability.Ind (
+  add_type1 ident_option ~variance:Variance.covariant
+    ~separability:Separability.Ind
+    ~kind:(fun tvar ->
+      Type_variant([cstr ident_none []; cstr ident_some [tvar]])
+    ) (
+  add_type1 ident_list ~variance:Variance.covariant
+    ~separability:Separability.Ind
+    ~kind:(fun tvar ->
+      Type_variant([cstr ident_nil []; cstr ident_cons [tvar; type_list tvar]])
+    ) (
+  add_type1 ident_array ~variance:Variance.full ~separability:Separability.Ind (
+  add_type ident_exn ~kind:Type_open (
+  add_type ident_unit ~immediate:Always
+    ~kind:(Type_variant([cstr ident_void []])) (
+  add_type ident_bool ~immediate:Always
+    ~kind:(Type_variant([cstr ident_false []; cstr ident_true []])) (
+  add_type ident_float (
+  add_type ident_string (
+  add_type ident_char ~immediate:Always (
+  add_type ident_int ~immediate:Always (
+  add_type ident_extension_constructor (
+  add_type ident_floatarray (
+    empty_env))))))))))))))))))))))))))))
+
+let build_initial_env add_type add_exception empty_env =
+  let common = common_initial_env add_type add_exception empty_env in
+  let add_type = mk_add_type add_type in
+  let safe_string = add_type ident_bytes common in
+  let unsafe_string = add_type ident_bytes ~manifest:type_string common in
+  (safe_string, unsafe_string)
+
+let builtin_values =
+  List.map (fun id -> (Ident.name id, id)) all_predef_exns
+
+let builtin_idents = List.rev !builtin_idents
diff --git a/typing/predef.mli b/typing/predef.mli
new file mode 100644
index 00000000..962a276a
--- /dev/null
+++ b/typing/predef.mli
@@ -0,0 +1,87 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Predefined type constructors (with special typing rules in typecore) *)
+
+open Types
+
+val type_int: type_expr
+val type_char: type_expr
+val type_string: type_expr
+val type_bytes: type_expr
+val type_float: type_expr
+val type_bool: type_expr
+val type_unit: type_expr
+val type_exn: type_expr
+val type_array: type_expr -> type_expr
+val type_list: type_expr -> type_expr
+val type_option: type_expr -> type_expr
+val type_nativeint: type_expr
+val type_int32: type_expr
+val type_int64: type_expr
+val type_lazy_t: type_expr -> type_expr
+val type_extension_constructor:type_expr
+val type_floatarray:type_expr
+
+val path_int: Path.t
+val path_char: Path.t
+val path_string: Path.t
+val path_bytes: Path.t
+val path_float: Path.t
+val path_bool: Path.t
+val path_unit: Path.t
+val path_exn: Path.t
+val path_array: Path.t
+val path_list: Path.t
+val path_option: Path.t
+val path_nativeint: Path.t
+val path_int32: Path.t
+val path_int64: Path.t
+val path_lazy_t: Path.t
+val path_extension_constructor: Path.t
+val path_floatarray: Path.t
+
+val path_match_failure: Path.t
+val path_assert_failure : Path.t
+val path_undefined_recursive_module : Path.t
+
+val ident_false : Ident.t
+val ident_true : Ident.t
+val ident_void : Ident.t
+val ident_nil : Ident.t
+val ident_cons : Ident.t
+val ident_none : Ident.t
+val ident_some : Ident.t
+
+(* To build the initial environment. Since there is a nasty mutual
+   recursion between predef and env, we break it by parameterizing
+   over Env.t, Env.add_type and Env.add_extension. *)
+
+val build_initial_env:
+  (Ident.t -> type_declaration -> 'a -> 'a) ->
+  (Ident.t -> extension_constructor -> 'a -> 'a) ->
+  'a -> 'a * 'a
+
+(* To initialize linker tables *)
+
+val builtin_values: (string * Ident.t) list
+val builtin_idents: (string * Ident.t) list
+
+(** All predefined exceptions, exposed as [Ident.t] for flambda (for
+    building value approximations).
+    The [Ident.t] for division by zero is also exported explicitly
+    so flambda can generate code to raise it. *)
+val ident_division_by_zero: Ident.t
+val all_predef_exns : Ident.t list
diff --git a/typing/primitive.ml b/typing/primitive.ml
new file mode 100644
index 00000000..0c3372b9
--- /dev/null
+++ b/typing/primitive.ml
@@ -0,0 +1,227 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Description of primitive functions *)
+
+open Misc
+open Parsetree
+
+type boxed_integer = Pnativeint | Pint32 | Pint64
+
+type native_repr =
+  | Same_as_ocaml_repr
+  | Unboxed_float
+  | Unboxed_integer of boxed_integer
+  | Untagged_int
+
+type description =
+  { prim_name: string;         (* Name of primitive  or C function *)
+    prim_arity: int;           (* Number of arguments *)
+    prim_alloc: bool;          (* Does it allocates or raise? *)
+    prim_native_name: string;  (* Name of C function for the nat. code gen. *)
+    prim_native_repr_args: native_repr list;
+    prim_native_repr_res: native_repr }
+
+type error =
+  | Old_style_float_with_native_repr_attribute
+  | Old_style_noalloc_with_noalloc_attribute
+  | No_native_primitive_with_repr_attribute
+
+exception Error of Location.t * error
+
+let is_ocaml_repr = function
+  | Same_as_ocaml_repr -> true
+  | Unboxed_float
+  | Unboxed_integer _
+  | Untagged_int -> false
+
+let is_unboxed = function
+  | Same_as_ocaml_repr
+  | Untagged_int -> false
+  | Unboxed_float
+  | Unboxed_integer _ -> true
+
+let is_untagged = function
+  | Untagged_int -> true
+  | Same_as_ocaml_repr
+  | Unboxed_float
+  | Unboxed_integer _ -> false
+
+let rec make_native_repr_args arity x =
+  if arity = 0 then
+    []
+  else
+    x :: make_native_repr_args (arity - 1) x
+
+let simple ~name ~arity ~alloc =
+  {prim_name = name;
+   prim_arity = arity;
+   prim_alloc = alloc;
+   prim_native_name = "";
+   prim_native_repr_args = make_native_repr_args arity Same_as_ocaml_repr;
+   prim_native_repr_res = Same_as_ocaml_repr}
+
+let make ~name ~alloc ~native_name ~native_repr_args ~native_repr_res =
+  {prim_name = name;
+   prim_arity = List.length native_repr_args;
+   prim_alloc = alloc;
+   prim_native_name = native_name;
+   prim_native_repr_args = native_repr_args;
+   prim_native_repr_res = native_repr_res}
+
+let parse_declaration valdecl ~native_repr_args ~native_repr_res =
+  let arity = List.length native_repr_args in
+  let name, native_name, old_style_noalloc, old_style_float =
+    match valdecl.pval_prim with
+    | name :: "noalloc" :: name2 :: "float" :: _ -> (name, name2, true, true)
+    | name :: "noalloc" :: name2 :: _ -> (name, name2, true, false)
+    | name :: name2 :: "float" :: _ -> (name, name2, false, true)
+    | name :: "noalloc" :: _ -> (name, "", true, false)
+    | name :: name2 :: _ -> (name, name2, false, false)
+    | name :: _ -> (name, "", false, false)
+    | [] ->
+        fatal_error "Primitive.parse_declaration"
+  in
+  let noalloc_attribute =
+    Attr_helper.has_no_payload_attribute ["noalloc"; "ocaml.noalloc"]
+      valdecl.pval_attributes
+  in
+  if old_style_float &&
+     not (List.for_all is_ocaml_repr native_repr_args &&
+          is_ocaml_repr native_repr_res) then
+    raise (Error (valdecl.pval_loc,
+                  Old_style_float_with_native_repr_attribute));
+  if old_style_noalloc && noalloc_attribute then
+    raise (Error (valdecl.pval_loc,
+                  Old_style_noalloc_with_noalloc_attribute));
+  (* The compiler used to assume "noalloc" with "float", we just make this
+     explicit now (GPR#167): *)
+  let old_style_noalloc = old_style_noalloc || old_style_float in
+  if old_style_float then
+    Location.deprecated valdecl.pval_loc
+      "[@@unboxed] + [@@noalloc] should be used\n\
+       instead of \"float\""
+  else if old_style_noalloc then
+    Location.deprecated valdecl.pval_loc
+      "[@@noalloc] should be used instead of \"noalloc\"";
+  if native_name = "" &&
+     not (List.for_all is_ocaml_repr native_repr_args &&
+          is_ocaml_repr native_repr_res) then
+    raise (Error (valdecl.pval_loc,
+                  No_native_primitive_with_repr_attribute));
+  let noalloc = old_style_noalloc || noalloc_attribute in
+  let native_repr_args, native_repr_res =
+    if old_style_float then
+      (make_native_repr_args arity Unboxed_float, Unboxed_float)
+    else
+      (native_repr_args, native_repr_res)
+  in
+  {prim_name = name;
+   prim_arity = arity;
+   prim_alloc = not noalloc;
+   prim_native_name = native_name;
+   prim_native_repr_args = native_repr_args;
+   prim_native_repr_res = native_repr_res}
+
+open Outcometree
+
+let rec add_native_repr_attributes ty attrs =
+  match ty, attrs with
+  | Otyp_arrow (label, a, b), attr_opt :: rest ->
+    let b = add_native_repr_attributes b rest in
+    let a =
+      match attr_opt with
+      | None -> a
+      | Some attr -> Otyp_attribute (a, attr)
+    in
+    Otyp_arrow (label, a, b)
+  | _, [Some attr] -> Otyp_attribute (ty, attr)
+  | _ ->
+    assert (List.for_all (fun x -> x = None) attrs);
+    ty
+
+let oattr_unboxed = { oattr_name = "unboxed" }
+let oattr_untagged = { oattr_name = "untagged" }
+let oattr_noalloc = { oattr_name = "noalloc" }
+
+let print p osig_val_decl =
+  let prims =
+    if p.prim_native_name <> "" then
+      [p.prim_name; p.prim_native_name]
+    else
+      [p.prim_name]
+  in
+  let for_all f =
+    List.for_all f p.prim_native_repr_args && f p.prim_native_repr_res
+  in
+  let all_unboxed = for_all is_unboxed in
+  let all_untagged = for_all is_untagged in
+  let attrs = if p.prim_alloc then [] else [oattr_noalloc] in
+  let attrs =
+    if all_unboxed then
+      oattr_unboxed :: attrs
+    else if all_untagged then
+      oattr_untagged :: attrs
+    else
+      attrs
+  in
+  let attr_of_native_repr = function
+    | Same_as_ocaml_repr -> None
+    | Unboxed_float
+    | Unboxed_integer _ -> if all_unboxed then None else Some oattr_unboxed
+    | Untagged_int -> if all_untagged then None else Some oattr_untagged
+  in
+  let type_attrs =
+    List.map attr_of_native_repr p.prim_native_repr_args @
+    [attr_of_native_repr p.prim_native_repr_res]
+  in
+  { osig_val_decl with
+    oval_prims = prims;
+    oval_type = add_native_repr_attributes osig_val_decl.oval_type type_attrs;
+    oval_attributes = attrs }
+
+let native_name p =
+  if p.prim_native_name <> ""
+  then p.prim_native_name
+  else p.prim_name
+
+let byte_name p =
+  p.prim_name
+
+let native_name_is_external p =
+  let nat_name = native_name p in
+  nat_name <> "" && nat_name.[0] <> '%'
+
+let report_error ppf err =
+  match err with
+  | Old_style_float_with_native_repr_attribute ->
+    Format.fprintf ppf "Cannot use \"float\" in conjunction with \
+                        [%@unboxed]/[%@untagged]."
+  | Old_style_noalloc_with_noalloc_attribute ->
+    Format.fprintf ppf "Cannot use \"noalloc\" in conjunction with \
+                        [%@%@noalloc]."
+  | No_native_primitive_with_repr_attribute ->
+    Format.fprintf ppf
+      "[@The native code version of the primitive is mandatory@ \
+       when attributes [%@untagged] or [%@unboxed] are present.@]"
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (loc, err) ->
+        Some (Location.error_of_printer ~loc report_error err)
+      | _ ->
+        None
+    )
diff --git a/typing/primitive.mli b/typing/primitive.mli
new file mode 100644
index 00000000..ddd39779
--- /dev/null
+++ b/typing/primitive.mli
@@ -0,0 +1,76 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Description of primitive functions *)
+
+type boxed_integer = Pnativeint | Pint32 | Pint64
+
+(* Representation of arguments/result for the native code version
+   of a primitive *)
+type native_repr =
+  | Same_as_ocaml_repr
+  | Unboxed_float
+  | Unboxed_integer of boxed_integer
+  | Untagged_int
+
+type description = private
+  { prim_name: string;         (* Name of primitive  or C function *)
+    prim_arity: int;           (* Number of arguments *)
+    prim_alloc: bool;          (* Does it allocates or raise? *)
+    prim_native_name: string;  (* Name of C function for the nat. code gen. *)
+    prim_native_repr_args: native_repr list;
+    prim_native_repr_res: native_repr }
+
+(* Invariant [List.length d.prim_native_repr_args = d.prim_arity] *)
+
+val simple
+  :  name:string
+  -> arity:int
+  -> alloc:bool
+  -> description
+
+val make
+  :  name:string
+  -> alloc:bool
+  -> native_name:string
+  -> native_repr_args: native_repr list
+  -> native_repr_res: native_repr
+  -> description
+
+val parse_declaration
+  :  Parsetree.value_description
+  -> native_repr_args:native_repr list
+  -> native_repr_res:native_repr
+  -> description
+
+val print
+  :  description
+  -> Outcometree.out_val_decl
+  -> Outcometree.out_val_decl
+
+val native_name: description -> string
+val byte_name: description -> string
+
+(** [native_name_is_externa] returns [true] iff the [native_name] for the
+    given primitive identifies that the primitive is not implemented in the
+    compiler itself. *)
+val native_name_is_external : description -> bool
+
+type error =
+  | Old_style_float_with_native_repr_attribute
+  | Old_style_noalloc_with_noalloc_attribute
+  | No_native_primitive_with_repr_attribute
+
+exception Error of Location.t * error
diff --git a/typing/printpat.ml b/typing/printpat.ml
new file mode 100644
index 00000000..43a18649
--- /dev/null
+++ b/typing/printpat.ml
@@ -0,0 +1,163 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Values as patterns pretty printer *)
+
+open Asttypes
+open Typedtree
+open Types
+open Format
+
+let is_cons = function
+| {cstr_name = "::"} -> true
+| _ -> false
+
+let pretty_const c = match c with
+| Const_int i -> Printf.sprintf "%d" i
+| Const_char c -> Printf.sprintf "%C" c
+| Const_string (s, _, _) -> Printf.sprintf "%S" s
+| Const_float f -> Printf.sprintf "%s" f
+| Const_int32 i -> Printf.sprintf "%ldl" i
+| Const_int64 i -> Printf.sprintf "%LdL" i
+| Const_nativeint i -> Printf.sprintf "%ndn" i
+
+let pretty_extra ppf (cstr, _loc, _attrs) pretty_rest rest =
+  match cstr with
+  | Tpat_unpack ->
+     fprintf ppf "@[(module %a)@]" pretty_rest rest
+  | Tpat_constraint _ ->
+     fprintf ppf "@[(%a : _)@]" pretty_rest rest
+  | Tpat_type _ ->
+     fprintf ppf "@[(# %a)@]" pretty_rest rest
+  | Tpat_open _ ->
+     fprintf ppf "@[(# %a)@]" pretty_rest rest
+
+let rec pretty_val : type k . _ -> k general_pattern -> _ = fun ppf v ->
+  match v.pat_extra with
+    | extra :: rem ->
+       pretty_extra ppf extra
+         pretty_val { v with pat_extra = rem }
+    | [] ->
+  match v.pat_desc with
+  | Tpat_any -> fprintf ppf "_"
+  | Tpat_var (x,_) -> fprintf ppf "%s" (Ident.name x)
+  | Tpat_constant c -> fprintf ppf "%s" (pretty_const c)
+  | Tpat_tuple vs ->
+      fprintf ppf "@[(%a)@]" (pretty_vals ",") vs
+  | Tpat_construct (_, cstr, []) ->
+      fprintf ppf "%s" cstr.cstr_name
+  | Tpat_construct (_, cstr, [w]) ->
+      fprintf ppf "@[<2>%s@ %a@]" cstr.cstr_name pretty_arg w
+  | Tpat_construct (_, cstr, vs) ->
+      let name = cstr.cstr_name in
+      begin match (name, vs) with
+        ("::", [v1;v2]) ->
+          fprintf ppf "@[%a::@,%a@]" pretty_car v1 pretty_cdr v2
+      |  _ ->
+          fprintf ppf "@[<2>%s@ @[(%a)@]@]" name (pretty_vals ",") vs
+      end
+  | Tpat_variant (l, None, _) ->
+      fprintf ppf "`%s" l
+  | Tpat_variant (l, Some w, _) ->
+      fprintf ppf "@[<2>`%s@ %a@]" l pretty_arg w
+  | Tpat_record (lvs,_) ->
+      let filtered_lvs = List.filter
+          (function
+            | (_,_,{pat_desc=Tpat_any}) -> false (* do not show lbl=_ *)
+            | _ -> true) lvs in
+      begin match filtered_lvs with
+      | [] -> fprintf ppf "_"
+      | (_, lbl, _) :: q ->
+          let elision_mark ppf =
+            (* we assume that there is no label repetitions here *)
+             if Array.length lbl.lbl_all > 1 + List.length q then
+               fprintf ppf ";@ _@ "
+             else () in
+          fprintf ppf "@[{%a%t}@]"
+            pretty_lvals filtered_lvs elision_mark
+      end
+  | Tpat_array vs ->
+      fprintf ppf "@[[| %a |]@]" (pretty_vals " ;") vs
+  | 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
+  | Tpat_value v ->
+      fprintf ppf "%a" pretty_val (v :> pattern)
+  | Tpat_exception v ->
+      fprintf ppf "@[<2>exception@ %a@]" pretty_arg v
+  | Tpat_or _ ->
+      fprintf ppf "@[(%a)@]" pretty_or v
+
+and pretty_car ppf v = match v.pat_desc with
+| Tpat_construct (_,cstr, [_ ; _])
+    when is_cons cstr ->
+      fprintf ppf "(%a)" pretty_val v
+| _ -> pretty_val ppf v
+
+and pretty_cdr ppf v = match v.pat_desc with
+| Tpat_construct (_,cstr, [v1 ; v2])
+    when is_cons cstr ->
+      fprintf ppf "%a::@,%a" pretty_car v1 pretty_cdr v2
+| _ -> pretty_val ppf v
+
+and pretty_arg ppf v = match v.pat_desc with
+| Tpat_construct (_,_,_::_)
+| Tpat_variant (_, Some _, _) -> fprintf ppf "(%a)" pretty_val v
+|  _ -> pretty_val ppf v
+
+and pretty_or : type k . _ -> k general_pattern -> _ = fun ppf v ->
+  match v.pat_desc with
+  | Tpat_or (v,w,_) ->
+      fprintf ppf "%a|@,%a" pretty_or v pretty_or w
+  | _ -> pretty_val ppf v
+
+and pretty_vals sep ppf = function
+  | [] -> ()
+  | [v] -> pretty_val ppf v
+  | v::vs ->
+      fprintf ppf "%a%s@ %a" pretty_val v sep (pretty_vals sep) vs
+
+and pretty_lvals ppf = function
+  | [] -> ()
+  | [_,lbl,v] ->
+      fprintf ppf "%s=%a" lbl.lbl_name pretty_val v
+  | (_, lbl,v)::rest ->
+      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 p =
+  top_pretty Format.str_formatter p ;
+  prerr_string (Format.flush_str_formatter ())
+
+type 'k matrix = 'k general_pattern list list
+
+let pretty_line fmt =
+  List.iter (fun p ->
+    Format.fprintf fmt " <";
+    top_pretty fmt p;
+    Format.fprintf fmt ">";
+  )
+
+let pretty_matrix fmt (pss : 'k matrix) =
+  Format.fprintf fmt "begin matrix\n" ;
+  List.iter (fun ps ->
+    pretty_line fmt ps ;
+    Format.fprintf fmt "\n"
+  ) pss;
+  Format.fprintf fmt "end matrix\n%!"
diff --git a/typing/printpat.mli b/typing/printpat.mli
new file mode 100644
index 00000000..1865a2ab
--- /dev/null
+++ b/typing/printpat.mli
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+
+val pretty_const
+    : Asttypes.constant -> string
+val top_pretty
+    : Format.formatter -> 'k Typedtree.general_pattern -> unit
+val pretty_pat
+    : '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
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
new file mode 100644
index 00000000..5cdd914f
--- /dev/null
+++ b/typing/printtyp.ml
@@ -0,0 +1,2194 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Printing functions *)
+
+open Misc
+open Ctype
+open Format
+open Longident
+open Path
+open Asttypes
+open Types
+open Btype
+open Outcometree
+
+module String = Misc.Stdlib.String
+
+(* Print a long identifier *)
+
+let rec longident ppf = function
+  | Lident s -> pp_print_string ppf s
+  | Ldot(p, s) -> fprintf ppf "%a.%s" longident p s
+  | Lapply(p1, p2) -> fprintf ppf "%a(%a)" longident p1 longident p2
+
+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
+  let set out_name x = out_name.printed_name <- x
+end
+
+(* 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
+
+let human_unique n id = Printf.sprintf "%s/%d" (Ident.name id) n
+
+type namespace =
+  | Type
+  | Module
+  | Module_type
+  | Class
+  | Class_type
+  | Other (** Other bypasses the unique name identifier mechanism *)
+
+module Namespace = struct
+
+  let id = function
+    | Type -> 0
+    | Module -> 1
+    | Module_type -> 2
+    | Class -> 3
+    | Class_type -> 4
+    | Other -> 5
+
+  let size = 1 + id Other
+
+  let show =
+    function
+    | Type -> "type"
+    | Module -> "module"
+    | Module_type -> "module type"
+    | Class -> "class"
+    | Class_type -> "class type"
+    | Other -> ""
+
+  let pp ppf x = Format.pp_print_string ppf (show 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
+    | Type -> to_lookup Env.find_type_by_name
+    | Module -> to_lookup Env.find_module_by_name
+    | Module_type -> to_lookup Env.find_modtype_by_name
+    | Class -> to_lookup Env.find_class_by_name
+    | Class_type -> to_lookup Env.find_cltype_by_name
+    | Other -> fun _ -> raise Not_found
+
+  let location namespace id =
+    let path = Path.Pident id in
+    try Some (
+        match namespace with
+        | Type -> (in_printing_env @@ Env.find_type path).type_loc
+        | Module -> (in_printing_env @@ Env.find_module path).md_loc
+        | Module_type -> (in_printing_env @@ Env.find_modtype path).mtd_loc
+        | Class -> (in_printing_env @@ Env.find_class path).cty_loc
+        | Class_type -> (in_printing_env @@ Env.find_cltype path).clty_loc
+        | Other -> Location.none
+      ) with Not_found -> None
+
+  let best_class_namespace = function
+    | Papply _ | Pdot _ -> Module
+    | Pident c ->
+        match location Class c with
+        | Some _ -> Class
+        | None -> Class_type
+
+end
+
+(** {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 collect_explanation namespace n id =
+    let name = human_unique n id in
+    let root_name = Ident.name id in
+    if not (M.mem name !explanations) then
+      match Namespace.location namespace id with
+      | None -> ()
+      | Some location ->
+          let explanation = { kind = namespace; location; name; root_name } in
+          explanations := M.add name explanation !explanations
+
+  let pp_explanation ppf r=
+    Format.fprintf ppf "@[%a:@,Definition of %s %s@]"
+      Location.print_loc r.location (Namespace.show r.kind) r.name
+
+  let print_located_explanations ppf l =
+    Format.fprintf ppf "@[%a@]" (Format.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 () = 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: The %a %s 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 a Namespace.pp namespace
+      | (namespace, _) :: _ :: _ ->
+      Format.fprintf ppf
+        "@ \
+         @[<2>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 pp_print_string) (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
+
+(** Name mapping *)
+type mapping =
+  | Need_unique_name of int Ident.Map.t
+  (** The same name has already been attributed to multiple types.
+      The [map] argument contains the specific binding time attributed to each
+      types.
+  *)
+  | Uniquely_associated_to of Ident.t * out_name
+    (** For now, the name [Ident.name id] has been attributed to [id],
+        [out_name] is used to expand this name if a conflict arises
+        at a later point
+    *)
+  | Associated_to_pervasives of out_name
+  (** [Associated_to_pervasives out_name] is used when the item
+      [Stdlib.$name] has been associated to the name [$name].
+      Upon a conflict, this name will be expanded to ["Stdlib." ^ name ] *)
+
+let hid_start = 0
+
+let add_hid_id id map =
+  let new_id = 1 + Ident.Map.fold (fun _ -> max) map hid_start in
+  new_id, Ident.Map.add id new_id  map
+
+let find_hid id map =
+  try Ident.Map.find id map, map with
+  Not_found -> add_hid_id id map
+
+let pervasives name = "Stdlib." ^ name
+
+let map = Array.make Namespace.size M.empty
+let get namespace = map.(Namespace.id namespace)
+let set namespace x = map.(Namespace.id namespace) <- x
+
+(* Names used in recursive definitions are not considered when determining
+   if a name is already attributed in the current environment.
+   This is a weaker version of hidden_rec_items used by short-path. *)
+let protected = ref S.empty
+let add_protected id = protected := S.add (Ident.name id) !protected
+let reset_protected () = protected := S.empty
+let with_hidden id f =
+  protect_refs [ R(protected,S.add (Ident.name id) !protected)] f
+
+let pervasives_name namespace name =
+  if not !enabled then Out_name.create name else
+  match M.find name (get namespace) with
+  | Associated_to_pervasives r -> r
+  | Need_unique_name _ -> Out_name.create (pervasives name)
+  | Uniquely_associated_to (id',r) ->
+      let hid, map = add_hid_id id' Ident.Map.empty in
+      Out_name.set r (human_unique hid id');
+      Conflicts.collect_explanation namespace hid id';
+      set namespace @@ M.add name (Need_unique_name map) (get namespace);
+      Out_name.create (pervasives name)
+  | exception Not_found ->
+      let r = Out_name.create name in
+      set namespace @@ M.add name (Associated_to_pervasives r) (get namespace);
+      r
+
+(** Lookup for preexisting named item within the current {!printing_env} *)
+let env_ident namespace name =
+  if S.mem name !protected then None else
+  match Namespace.lookup namespace name with
+  | Pident id -> Some id
+  | _ -> None
+  | exception Not_found -> None
+
+(** Associate a name to the identifier [id] within [namespace] *)
+let ident_name_simple namespace id =
+  if not !enabled then Out_name.create (Ident.name id) else
+  let name = Ident.name id in
+  match M.find name (get namespace) with
+  | Uniquely_associated_to (id',r) when Ident.same id id' ->
+      r
+  | Need_unique_name map ->
+      let hid, m = find_hid id map in
+      Conflicts.collect_explanation namespace hid id;
+      set namespace @@ M.add name (Need_unique_name m) (get namespace);
+      Out_name.create (human_unique hid id)
+  | Uniquely_associated_to (id',r) ->
+      let hid', m = find_hid id' Ident.Map.empty in
+      let hid, m = find_hid id m in
+      Out_name.set r (human_unique hid' id');
+      List.iter (fun (id,hid) -> Conflicts.collect_explanation namespace hid id)
+        [id, hid; id', hid' ];
+      set namespace @@ M.add name (Need_unique_name m) (get namespace);
+      Out_name.create (human_unique hid id)
+  | Associated_to_pervasives r ->
+      Out_name.set r ("Stdlib." ^ Out_name.print r);
+      let hid, m = find_hid id Ident.Map.empty in
+      set namespace @@ M.add name (Need_unique_name m) (get namespace);
+      Out_name.create (human_unique hid id)
+  | exception Not_found ->
+      let r = Out_name.create name in
+      set namespace
+      @@ M.add name (Uniquely_associated_to (id,r) ) (get namespace);
+      r
+
+(** Same as {!ident_name_simple} but lookup to existing named identifiers
+    in the current {!printing_env} *)
+let ident_name namespace id =
+  begin match env_ident namespace (Ident.name id) with
+  | Some id' -> ignore (ident_name_simple namespace id')
+  | None -> ()
+  end;
+  ident_name_simple namespace id
+
+let reset () =
+  Array.iteri ( fun i _ -> map.(i) <- M.empty ) map
+
+end
+let ident_name = Naming_context.ident_name
+let reset_naming_context = Naming_context.reset
+
+let ident ppf id = pp_print_string ppf
+    (Out_name.print (Naming_context.ident_name_simple Other id))
+
+(* Print a path *)
+
+let ident_stdlib = Ident.create_persistent "Stdlib"
+
+let non_shadowed_pervasive = function
+  | Pdot(Pident id, s) as path ->
+      Ident.same id ident_stdlib &&
+      (match in_printing_env (Env.find_type_by_name (Lident 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)
+  | 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),
+           String.capitalize_ascii
+             (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 namespace = function
+  | Pident id ->
+      Oide_ident (ident_name namespace id)
+  | Pdot(_, s) as path when non_shadowed_pervasive path ->
+      Oide_ident (Naming_context.pervasives_name namespace s)
+  | Pdot(Pident t, s)
+    when namespace=Type && not (Path.is_uident (Ident.name t)) ->
+      (* [t.A]: inline record of the constructor [A] from type [t] *)
+      Oide_dot (Oide_ident (ident_name Type t), s)
+  | Pdot(p, s) ->
+      Oide_dot (tree_of_path Module p, s)
+  | Papply(p1, p2) ->
+      Oide_apply (tree_of_path Module p1, tree_of_path Module p2)
+
+let tree_of_path namespace p =
+  tree_of_path namespace (rewrite_double_underscore_paths !printing_env p)
+
+let path ppf p =
+  !Oprint.out_ident ppf (tree_of_path Other p)
+
+let string_of_path p =
+  Format.asprintf "%a" path p
+
+let strings_of_paths namespace p =
+  reset_naming_context ();
+  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 rec safe_kind_repr v = function
+    Fvar {contents=Some k}  ->
+      if List.memq k v then "Fvar loop" else
+      safe_kind_repr (k::v) k
+  | Fvar r ->
+      let vid =
+        try List.assq r !kind_vars
+        with Not_found ->
+          let c = incr kind_count; !kind_count in
+          kind_vars := (r,c) :: !kind_vars;
+          c
+      in
+      Printf.sprintf "Fvar {None}@%d" vid
+  | Fpresent -> "Fpresent"
+  | Fabsent -> "Fabsent"
+
+let rec safe_commu_repr v = function
+    Cok -> "Cok"
+  | Cunknown -> "Cunknown"
+  | Clink r ->
+      if List.memq r v then "Clink loop" else
+      safe_commu_repr (r::v) !r
+
+let rec safe_repr v = function
+    {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;desc=@,%a}@]" ty.id ty.level
+      raw_type_desc ty.desc
+  end
+and raw_type_list tl = raw_list raw_type tl
+and raw_type_desc ppf = function
+    Tvar name -> fprintf ppf "Tvar %a" print_name name
+  | Tarrow(l,t1,t2,c) ->
+      fprintf ppf "@[Tarrow(\"%s\",@,%a,@,%a,@,%s)@]"
+        (string_of_label l) raw_type t1 raw_type t2
+        (safe_commu_repr [] c)
+  | Ttuple tl ->
+      fprintf ppf "@[<1>Ttuple@,%a@]" raw_type_list tl
+  | Tconstr (p, tl, abbrev) ->
+      fprintf ppf "@[Tconstr(@,%a,@,%a,@,%a)@]" path p
+        raw_type_list tl
+        (raw_list path) (list_of_memo !abbrev)
+  | Tobject (t, nm) ->
+      fprintf ppf "@[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 "@[Tfield(@,%s,@,%s,@,%a,@;<0 -1>%a)@]" f
+        (safe_kind_repr [] k)
+        raw_type t1 raw_type t2
+  | Tnil -> fprintf ppf "Tnil"
+  | Tlink t -> fprintf ppf "@[<1>Tlink@,%a@]" raw_type t
+  | Tsubst t -> fprintf ppf "@[<1>Tsubst@,%a@]" raw_type t
+  | Tunivar name -> fprintf ppf "Tunivar %a" print_name name
+  | Tpoly (t, tl) ->
+      fprintf ppf "@[Tpoly(@,%a,@,%a)@]"
+        raw_type t
+        raw_type_list tl
+  | Tvariant row ->
+      fprintf ppf
+        "@[{@[%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))
+        row.row_fields
+        "row_more=" raw_type row.row_more
+        "row_closed=" row.row_closed
+        "row_fixed=" raw_row_fixed row.row_fixed
+        "row_name="
+        (fun ppf ->
+          match row.row_name with None -> fprintf ppf "None"
+          | Some(p,tl) ->
+              fprintf ppf "Some(@,%a,@,%a)" path p raw_type_list tl)
+  | Tpackage (p, _, tl) ->
+      fprintf ppf "@[Tpackage(@,%a@,%a)@]" path p
+        raw_type_list tl
+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 = function
+    Rpresent None -> fprintf ppf "Rpresent None"
+  | Rpresent (Some t) -> fprintf ppf "@[<1>Rpresent(Some@,%a)@]" raw_type t
+  | Reither (c,tl,m,e) ->
+      fprintf ppf "@[Reither(%B,@,%a,@,%B,@,@[<1>ref%t@])@]" c
+        raw_type_list tl m
+        (fun ppf ->
+          match !e with None -> fprintf ppf " None"
+          | Some f -> fprintf ppf "@,@[<1>(%a)@]" raw_field f)
+  | Rabsent -> fprintf ppf "Rabsent"
+
+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
+
+let printing_depth = ref 0
+let printing_cont = ref ([] : Env.iter_cont list)
+let printing_old = ref Env.empty
+let printing_pers = ref Concr.empty
+let printing_map = ref Path.Map.empty
+
+let same_type t t' = repr t == repr t'
+
+let rec index l x =
+  match l with
+    [] -> raise Not_found
+  | a :: l -> if x == a then 0 else 1 + index l x
+
+let rec uniq = function
+    [] -> true
+  | a :: l -> not (List.memq a l) && uniq l
+
+let rec normalize_type_path ?(cache=false) env p =
+  try
+    let (params, ty, _) = Env.find_type_expansion p env in
+    let params = List.map repr params in
+    match repr ty with
+      {desc = Tconstr (p1, tyl, _)} ->
+        let tyl = List.map repr tyl in
+        if List.length params = List.length tyl
+        && List.for_all2 (==) params tyl
+        then normalize_type_path ~cache env p1
+        else if cache || List.length params <= List.length tyl
+             || not (uniq 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)
+    | ty ->
+        (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, _) ->
+      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)
+
+let same_printing_env env =
+  let used_pers = Env.used_persistent () in
+  Env.same_types !printing_old env && Concr.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; reset_naming_context ();
+  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) ->
+      Longident.Ldot (lid_of_path p1, s)
+  | Path.Papply (p1, p2) ->
+      Longident.Lapply (lid_of_path p1, lid_of_path p2)
+
+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)
+
+(* Print a type expression *)
+
+let names = ref ([] : (type_expr * string) list)
+let name_counter = ref 0
+let named_vars = ref ([] : string 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_counter := 0; named_vars := []
+let add_named_var ty =
+  match ty.desc with
+    Tvar (Some name) | Tunivar (Some name) ->
+      if List.mem name !named_vars then () else
+      named_vars := name :: !named_vars
+  | _ -> ()
+
+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 =
+    if !name_counter < 26
+    then String.make 1 (Char.chr(97 + !name_counter))
+    else String.make 1 (Char.chr(97 + !name_counter mod 26)) ^
+           Int.to_string(!name_counter / 26) 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 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. *)
+  try List.assq t !names with Not_found ->
+    try TypeMap.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 current_name = ref name in
+          let i = ref 0 in
+          while List.exists (fun (_, name') -> !current_name = name') !names do
+            current_name := name ^ (Int.to_string !i);
+            i := !i + 1;
+          done;
+          !current_name
+      | _ ->
+          (* 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 t = ignore(name_of_type new_name t)
+
+let remove_names tyl =
+  let tyl = List.map repr tyl in
+  names := List.filter (fun (ty,_) -> not (List.memq ty tyl)) !names
+
+let visited_objects = ref ([] : type_expr list)
+let aliased = ref ([] : type_expr list)
+let delayed = ref ([] : type_expr list)
+
+let add_delayed t =
+  if not (List.memq t !delayed) then delayed := t :: !delayed
+
+let is_aliased ty = List.memq (proxy ty) !aliased
+let add_alias ty =
+  let px = proxy ty in
+  if not (is_aliased px) then begin
+    aliased := px :: !aliased;
+    add_named_var px
+  end
+
+let aliasable ty =
+  match ty.desc with
+    Tvar _ | Tunivar _ | Tpoly _ -> false
+  | Tconstr (p, _, _) ->
+      not (is_nth (snd (best_type_path p)))
+  | _ -> true
+
+let namable_row row =
+  row.row_name <> None &&
+  List.for_all
+    (fun (_, f) ->
+       match row_field_repr f with
+       | Reither(c, l, _, _) ->
+           row.row_closed && if c then l = [] else List.length l = 1
+       | _ -> true)
+    row.row_fields
+
+let rec mark_loops_rec visited ty =
+  let ty = repr ty in
+  let px = proxy ty in
+  if List.memq px visited && aliasable ty then add_alias px else
+    let visited = px :: visited in
+    match ty.desc with
+    | Tvar _ -> add_named_var ty
+    | Tarrow(_, ty1, ty2, _) ->
+        mark_loops_rec visited ty1; mark_loops_rec visited ty2
+    | Ttuple tyl -> List.iter (mark_loops_rec visited) tyl
+    | Tconstr(p, tyl, _) ->
+        let (_p', s) = best_type_path p in
+        List.iter (mark_loops_rec visited) (apply_subst s tyl)
+    | Tpackage (_, _, tyl) ->
+        List.iter (mark_loops_rec visited) tyl
+    | Tvariant row ->
+        if List.memq px !visited_objects then add_alias px else
+         begin
+          let row = row_repr row in
+          if not (static_row row) then
+            visited_objects := px :: !visited_objects;
+          match row.row_name with
+          | Some(_p, tyl) when namable_row row ->
+              List.iter (mark_loops_rec visited) tyl
+          | _ ->
+              iter_row (mark_loops_rec visited) row
+         end
+    | Tobject (fi, nm) ->
+        if List.memq px !visited_objects then add_alias px else
+         begin
+          if opened_object ty then
+            visited_objects := px :: !visited_objects;
+          begin match !nm with
+          | None ->
+              let fields, _ = flatten_fields fi in
+              List.iter
+                (fun (_, kind, ty) ->
+                  if field_kind_repr kind = Fpresent then
+                    mark_loops_rec visited ty)
+                fields
+          | Some (_, l) ->
+              List.iter (mark_loops_rec visited) (List.tl l)
+          end
+        end
+    | Tfield(_, kind, ty1, ty2) when field_kind_repr kind = Fpresent ->
+        mark_loops_rec visited ty1; mark_loops_rec visited ty2
+    | Tfield(_, _, _, ty2) ->
+        mark_loops_rec visited ty2
+    | Tnil -> ()
+    | Tsubst ty -> mark_loops_rec visited ty
+    | Tlink _ -> fatal_error "Printtyp.mark_loops_rec (2)"
+    | Tpoly (ty, tyl) ->
+        List.iter (fun t -> add_alias t) tyl;
+        mark_loops_rec visited ty
+    | Tunivar _ -> add_named_var ty
+
+let mark_loops ty =
+  normalize_type Env.empty ty;
+  mark_loops_rec [] ty;;
+
+let reset_loop_marks () =
+  visited_objects := []; aliased := []; delayed := []
+
+let reset_except_context () =
+  reset_names (); reset_loop_marks ()
+
+let reset () =
+  reset_naming_context (); Conflicts.reset ();
+  reset_except_context ()
+
+let reset_and_mark_loops ty =
+  reset_except_context (); mark_loops ty
+
+let reset_and_mark_loops_list tyl =
+  reset_except_context (); List.iter mark_loops tyl
+
+(* Disabled in classic mode when printing an unification error *)
+let print_labels = ref true
+
+let rec tree_of_typexp sch ty =
+  let ty = repr ty in
+  let px = proxy ty in
+  if List.mem_assq px !names && not (List.memq px !delayed) then
+   let mark = is_non_gen sch ty in
+   let name = name_of_type (if mark then new_weak_name ty else new_name) px in
+   Otyp_var (mark, name) else
+
+  let pr_typ () =
+    match ty.desc with
+    | Tvar _ ->
+        (*let lev =
+          if is_non_gen sch ty then "/" ^ Int.to_string ty.level else "" in*)
+        let non_gen = is_non_gen sch ty in
+        let name_gen = if non_gen then new_weak_name ty else new_name in
+        Otyp_var (non_gen, name_of_type name_gen ty)
+    | Tarrow(l, ty1, ty2, _) ->
+        let lab =
+          if !print_labels || is_optional l then string_of_label l else ""
+        in
+        let t1 =
+          if is_optional l then
+            match (repr ty1).desc with
+            | Tconstr(path, [ty], _)
+              when Path.same path Predef.path_option ->
+                tree_of_typexp sch ty
+            | _ -> Otyp_stuff ""
+          else tree_of_typexp sch ty1 in
+        Otyp_arrow (lab, t1, tree_of_typexp sch ty2)
+    | Ttuple tyl ->
+        Otyp_tuple (tree_of_typlist sch 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 sch (List.hd tyl') else
+        Otyp_constr (tree_of_path Type p', tree_of_typlist sch tyl')
+    | Tvariant row ->
+        let row = row_repr row in
+        let fields =
+          if row.row_closed then
+            List.filter (fun (_, f) -> row_field_repr f <> Rabsent)
+              row.row_fields
+          else row.row_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 row.row_name with
+        | Some(p, tyl) when namable_row row ->
+            let (p', s) = best_type_path p in
+            let id = tree_of_path Type p' in
+            let args = tree_of_typlist sch (apply_subst s tyl) in
+            let out_variant =
+              if is_nth s then List.hd args else Otyp_constr (id, args) in
+            if row.row_closed && all_present then
+              out_variant
+            else
+              let non_gen = is_non_gen sch px in
+              let tags =
+                if all_present then None else Some (List.map fst present) in
+              Otyp_variant (non_gen, Ovar_typ out_variant, row.row_closed, tags)
+        | _ ->
+            let non_gen =
+              not (row.row_closed && all_present) && is_non_gen sch px in
+            let fields = List.map (tree_of_row_field sch) fields in
+            let tags =
+              if all_present then None else Some (List.map fst present) in
+            Otyp_variant (non_gen, Ovar_fields fields, row.row_closed, tags)
+        end
+    | Tobject (fi, nm) ->
+        tree_of_typobject sch fi !nm
+    | Tnil | Tfield _ ->
+        tree_of_typobject sch ty None
+    | Tsubst ty ->
+        tree_of_typexp sch ty
+    | Tlink _ ->
+        fatal_error "Printtyp.tree_of_typexp"
+    | Tpoly (ty, []) ->
+        tree_of_typexp sch ty
+    | Tpoly (ty, tyl) ->
+        (*let print_names () =
+          List.iter (fun (_, name) -> prerr_string (name ^ " ")) !names;
+          prerr_string "; " in *)
+        let tyl = List.map repr tyl in
+        if tyl = [] then tree_of_typexp sch ty else begin
+          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 (name_of_type new_name) tyl in
+          let tr = Otyp_poly (tl, tree_of_typexp sch ty) in
+          (* Forget names when we leave scope *)
+          remove_names tyl;
+          delayed := old_delayed; tr
+        end
+    | Tunivar _ ->
+        Otyp_var (false, name_of_type new_name ty)
+    | Tpackage (p, n, tyl) ->
+        let n =
+          List.map (fun li -> String.concat "." (Longident.flatten li)) n in
+        Otyp_module (tree_of_path Module_type p, n, tree_of_typlist sch tyl)
+  in
+  if List.memq px !delayed then delayed := List.filter ((!=) px) !delayed;
+  if is_aliased px && aliasable ty then begin
+    check_name_of_type px;
+    Otyp_alias (pr_typ (), name_of_type new_name px) end
+  else pr_typ ()
+
+and tree_of_row_field sch (l, f) =
+  match row_field_repr f with
+  | Rpresent None | Reither(true, [], _, _) -> (l, false, [])
+  | Rpresent(Some ty) -> (l, false, [tree_of_typexp sch ty])
+  | Reither(c, tyl, _, _) ->
+      if c (* contradiction: constant constructor with an argument *)
+      then (l, true, tree_of_typlist sch tyl)
+      else (l, false, tree_of_typlist sch tyl)
+  | Rabsent -> (l, false, [] (* actually, an error *))
+
+and tree_of_typlist sch tyl =
+  List.map (tree_of_typexp sch) tyl
+
+and tree_of_typobject sch 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
+               | Fpresent -> (n, t) :: l
+               | _ -> l)
+            fields [] in
+        let sorted_fields =
+          List.sort
+            (fun (n, _) (n', _) -> String.compare n n') present_fields in
+        tree_of_typfields sch rest sorted_fields in
+      let (fields, rest) = pr_fields fi in
+      Otyp_object (fields, rest)
+  | Some (p, ty :: tyl) ->
+      let non_gen = is_non_gen sch (repr ty) in
+      let args = tree_of_typlist sch tyl in
+      let (p', s) = best_type_path p in
+      assert (s = Id);
+      Otyp_class (non_gen, tree_of_path Type p', args)
+  | _ ->
+      fatal_error "Printtyp.tree_of_typobject"
+  end
+
+and is_non_gen sch ty =
+    sch && is_Tvar ty && ty.level <> generic_level
+
+and tree_of_typfields sch rest = function
+  | [] ->
+      let rest =
+        match rest.desc with
+        | Tvar _ | Tunivar _ -> Some (is_non_gen sch rest)
+        | Tconstr _ -> Some false
+        | Tnil -> None
+        | _ -> fatal_error "typfields (1)"
+      in
+      ([], rest)
+  | (s, t) :: l ->
+      let field = (s, tree_of_typexp sch t) in
+      let (fields, rest) = tree_of_typfields sch rest l in
+      (field :: fields, rest)
+
+let typexp sch ppf ty =
+  !Oprint.out_type ppf (tree_of_typexp sch ty)
+
+let marked_type_expr ppf ty = typexp false 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 *)
+  reset_and_mark_loops ty;
+  marked_type_expr ppf ty
+
+and type_sch ppf ty = typexp true ppf ty
+
+and type_scheme ppf ty = reset_and_mark_loops ty; typexp true 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_path Type p in
+  !Oprint.out_ident ppf t
+
+(* Maxence *)
+let type_scheme_max ?(b_reset_names=true) ppf ty =
+  if b_reset_names then reset_names () ;
+  typexp true ppf ty
+(* End Maxence *)
+
+let tree_of_type_scheme ty = reset_and_mark_loops ty; tree_of_typexp true 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 true ty in
+         (tr, tree_of_typexp true ty') :: list
+       else list)
+    params []
+
+let filter_params tyl =
+  let params =
+    List.fold_left
+      (fun tyl ty ->
+        let ty = repr ty in
+        if List.memq ty tyl then Btype.newgenty (Tsubst ty) :: tyl
+        else ty :: tyl)
+      [] tyl
+  in List.rev params
+
+let mark_loops_constructor_arguments = function
+  | Cstr_tuple l -> List.iter mark_loops l
+  | Cstr_record l -> List.iter (fun l -> mark_loops l.ld_type) l
+
+let rec tree_of_type_decl id decl =
+
+  reset_except_context();
+
+  let params = filter_params decl.type_params in
+
+  begin match decl.type_manifest with
+  | Some ty ->
+      let vars = free_variables ty in
+      List.iter
+        (function {desc = Tvar (Some "_")} as ty ->
+            if List.memq ty vars then ty.desc <- Tvar None
+          | _ -> ())
+        params
+  | None -> ()
+  end;
+
+  List.iter add_alias params;
+  List.iter mark_loops params;
+  List.iter check_name_of_type (List.map proxy params);
+  let ty_manifest =
+    match decl.type_manifest with
+    | None -> None
+    | Some ty ->
+        let ty =
+          (* Special hack to hide variant name *)
+          match repr ty with {desc=Tvariant row} ->
+            let row = row_repr row in
+            begin match row.row_name with
+              Some (Pident id', _) when Ident.same id id' ->
+                newgenty (Tvariant {row with row_name = None})
+            | _ -> ty
+            end
+          | _ -> ty
+        in
+        mark_loops ty;
+        Some ty
+  in
+  begin match decl.type_kind with
+  | Type_abstract -> ()
+  | Type_variant cstrs ->
+      List.iter
+        (fun c ->
+           mark_loops_constructor_arguments c.cd_args;
+           Option.iter mark_loops c.cd_res)
+        cstrs
+  | Type_record(l, _rep) ->
+      List.iter (fun l -> mark_loops l.ld_type) l
+  | Type_open -> ()
+  end;
+
+  let type_param =
+    function
+    | Otyp_var (_, id) -> id
+    | _ -> "?"
+  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 ->
+          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 ->
+          if abstr || not (is_Tvar (repr ty)) then Variance.get_upper v
+          else (true,true))
+        decl.type_params decl.type_variance
+    in
+    (Ident.name id,
+     List.map2 (fun ty cocn -> type_param (tree_of_typexp false ty), cocn)
+       params vari)
+  in
+  let tree_of_manifest ty1 =
+    match ty_manifest with
+    | None -> ty1
+    | Some ty -> Otyp_manifest (tree_of_typexp false ty, ty1)
+  in
+  let (name, args) = type_defined decl in
+  let constraints = tree_of_constraints params in
+  let ty, priv =
+    match decl.type_kind with
+    | Type_abstract ->
+        begin match ty_manifest with
+        | None -> (Otyp_abstract, Public)
+        | Some ty ->
+            tree_of_typexp false ty, decl.type_private
+        end
+    | Type_variant cstrs ->
+        tree_of_manifest (Otyp_sum (List.map tree_of_constructor cstrs)),
+        decl.type_private
+    | Type_record(lbls, _rep) ->
+        tree_of_manifest (Otyp_record (List.map tree_of_label lbls)),
+        decl.type_private
+    | Type_open ->
+        tree_of_manifest Otyp_open,
+        decl.type_private
+  in
+    { otype_name = name;
+      otype_params = args;
+      otype_type = ty;
+      otype_private = priv;
+      otype_immediate = Type_immediacy.of_attributes decl.type_attributes;
+      otype_unboxed = decl.type_unboxed.unboxed;
+      otype_cstrs = constraints }
+
+and tree_of_constructor_arguments = function
+  | Cstr_tuple l -> tree_of_typlist false l
+  | Cstr_record l -> [ Otyp_record (List.map tree_of_label l) ]
+
+and tree_of_constructor cd =
+  let name = Ident.name cd.cd_id in
+  let arg () = tree_of_constructor_arguments cd.cd_args in
+  match cd.cd_res with
+  | None -> (name, arg (), None)
+  | Some res ->
+      let nm = !names in
+      names := [];
+      let ret = tree_of_typexp false res in
+      let args = arg () in
+      names := nm;
+      (name, args, Some ret)
+
+and tree_of_label l =
+  (Ident.name l.ld_id, l.ld_mutable = Mutable, tree_of_typexp false l.ld_type)
+
+let constructor ppf c =
+  reset_except_context ();
+  !Oprint.out_constr ppf (tree_of_constructor c)
+
+let label ppf l =
+  reset_except_context ();
+  !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 type_declaration id ppf decl =
+  !Oprint.out_sig_item ppf (tree_of_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 =
+  match ext_ret_type with
+  | None -> (tree_of_constructor_arguments ext_args, None)
+  | Some res ->
+    let nm = !names in
+    names := [];
+    let ret = tree_of_typexp false res in
+    let args = tree_of_constructor_arguments ext_args in
+    names := nm;
+    (args, Some ret)
+
+let tree_of_extension_constructor id ext es =
+  reset_except_context ();
+  let ty_name = Path.name ext.ext_type_path in
+  let ty_params = filter_params ext.ext_type_params in
+  List.iter add_alias ty_params;
+  List.iter mark_loops ty_params;
+  List.iter check_name_of_type (List.map proxy ty_params);
+  mark_loops_constructor_arguments ext.ext_args;
+  Option.iter mark_loops ext.ext_ret_type;
+  let type_param =
+    function
+    | Otyp_var (_, id) -> id
+    | _ -> "?"
+  in
+  let ty_params =
+    List.map (fun ty -> type_param (tree_of_typexp false ty)) ty_params
+  in
+  let name = Ident.name id in
+  let args, ret =
+    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 extension_constructor id ppf ext =
+  !Oprint.out_sig_item ppf (tree_of_extension_constructor id ext Text_first)
+
+let extension_only_constructor id ppf ext =
+  reset_except_context ();
+  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 "@[%a@]"
+    !Oprint.out_constr (name, args, 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 (_, kind, ty) =
+  match field_kind_repr kind, repr ty with
+    Fpresent, {desc=Tpoly(ty, tyl)} -> (ty, tyl)
+  | _       , ty                    -> (ty, [])
+
+let tree_of_metho sch concrete csil (lab, kind, ty) =
+  if lab <> dummy_method then begin
+    let kind = field_kind_repr kind in
+    let priv = kind <> Fpresent in
+    let virt = not (Concr.mem lab concrete) in
+    let (ty, tyl) = method_type (lab, kind, ty) in
+    let tty = tree_of_typexp sch ty in
+    remove_names tyl;
+    Ocsg_method (lab, priv, virt, tty) :: csil
+  end
+  else csil
+
+let rec prepare_class_type params = function
+  | Cty_constr (_p, tyl, cty) ->
+      let sty = Ctype.self_type cty in
+      if List.memq (proxy sty) !visited_objects
+      || not (List.for_all is_Tvar params)
+      || List.exists (deep_occur sty) tyl
+      then prepare_class_type params cty
+      else List.iter mark_loops tyl
+  | Cty_signature sign ->
+      let sty = repr sign.csig_self in
+      (* Self may have a name *)
+      let px = proxy sty in
+      if List.memq px !visited_objects then add_alias sty
+      else visited_objects := px :: !visited_objects;
+      let (fields, _) =
+        Ctype.flatten_fields (Ctype.object_fields sign.csig_self)
+      in
+      List.iter (fun met -> mark_loops (fst (method_type met))) fields;
+      Vars.iter (fun _ (_, _, ty) -> mark_loops ty) sign.csig_vars
+  | Cty_arrow (_, ty, cty) ->
+      mark_loops ty;
+      prepare_class_type params cty
+
+let rec tree_of_class_type sch params =
+  function
+  | Cty_constr (p', tyl, cty) ->
+      let sty = Ctype.self_type cty in
+      if List.memq (proxy sty) !visited_objects
+      || not (List.for_all is_Tvar params)
+      then
+        tree_of_class_type sch params cty
+      else
+        let namespace = Namespace.best_class_namespace p' in
+        Octy_constr (tree_of_path namespace p', tree_of_typlist true tyl)
+  | Cty_signature sign ->
+      let sty = repr sign.csig_self in
+      let self_ty =
+        if is_aliased sty then
+          Some (Otyp_var (false, name_of_type new_name (proxy sty)))
+        else None
+      in
+      let (fields, _) =
+        Ctype.flatten_fields (Ctype.object_fields sign.csig_self)
+      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 sch t)
+            :: csil)
+          csil all_vars
+      in
+      let csil =
+        List.fold_left (tree_of_metho sch sign.csig_concr) csil fields
+      in
+      Octy_signature (self_ty, List.rev csil)
+  | Cty_arrow (l, ty, cty) ->
+      let lab =
+        if !print_labels || is_optional l then string_of_label l else ""
+      in
+      let tr =
+       if is_optional l then
+         match (repr ty).desc with
+         | Tconstr(path, [ty], _) when Path.same path Predef.path_option ->
+             tree_of_typexp sch ty
+         | _ -> Otyp_stuff ""
+       else tree_of_typexp sch ty in
+      Octy_arrow (lab, tr, tree_of_class_type sch params cty)
+
+let class_type ppf cty =
+  reset ();
+  prepare_class_type [] cty;
+  !Oprint.out_class_type ppf (tree_of_class_type false [] cty)
+
+let tree_of_class_param param variance =
+  (match tree_of_typexp true param with
+    Otyp_var (_, s) -> s
+  | _ -> "?"),
+  if is_Tvar (repr param) then (true, true) else variance
+
+let class_variance =
+  List.map Variance.(fun v -> mem May_pos v, mem May_neg v)
+
+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 sty = Ctype.self_type cl.cty_type in
+  List.iter mark_loops params;
+
+  List.iter check_name_of_type (List.map proxy params);
+  if is_aliased sty then check_name_of_type (proxy sty);
+
+  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 true params cl.cty_type,
+     tree_of_rec rs)
+
+let class_declaration id ppf cl =
+  !Oprint.out_sig_item ppf (tree_of_class_declaration id cl Trec_first)
+
+let tree_of_cltype_declaration id cl rs =
+  let params = List.map repr cl.clty_params in
+
+  reset_except_context ();
+  List.iter add_alias params;
+  prepare_class_type params cl.clty_type;
+  let sty = Ctype.self_type cl.clty_type in
+  List.iter mark_loops params;
+
+  List.iter check_name_of_type (List.map proxy params);
+  if is_aliased sty then check_name_of_type (proxy sty);
+
+  let sign = Ctype.signature_of_class_type cl.clty_type in
+
+  let virt =
+    let (fields, _) =
+      Ctype.flatten_fields (Ctype.object_fields sign.csig_self) in
+    List.exists
+      (fun (lab, _, _) ->
+         not (lab = dummy_method || Concr.mem lab sign.csig_concr))
+      fields
+    || Vars.fold (fun _ (_,vr,_) b -> vr = Virtual || b) sign.csig_vars false
+  in
+
+  Osig_class_type
+    (virt, Ident.name id,
+     List.map2 tree_of_class_param params (class_variance cl.clty_variance),
+     tree_of_class_type true params cl.clty_type,
+     tree_of_rec rs)
+
+let cltype_declaration id ppf cl =
+  !Oprint.out_sig_item ppf (tree_of_cltype_declaration id cl Trec_first)
+
+(* Print a module type *)
+
+let wrap_env fenv ftree arg =
+  let env = !printing_env in
+  set_printing_env (fenv env);
+  let tree = ftree arg in
+  set_printing_env env;
+  tree
+
+let filter_rem_sig item rem =
+  match item, rem with
+  | Sig_class _, ctydecl :: tydecl1 :: tydecl2 :: rem ->
+      ([ctydecl; tydecl1; tydecl2], rem)
+  | Sig_class_type _, tydecl1 :: tydecl2 :: rem ->
+      ([tydecl1; tydecl2], rem)
+  | _ ->
+      ([], rem)
+
+let dummy =
+  {
+    type_params = [];
+    type_arity = 0;
+    type_kind = Type_abstract;
+    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 = unboxed_false_default_false;
+    type_uid = Uid.internal_not_actually_unique;
+  }
+
+let hide ids env = List.fold_right
+    (fun id -> Env.add_type ~check:false (Ident.rename id) dummy)
+    ids env
+
+let hide_rec_items = function
+  | Sig_type(id, _decl, rs, _) ::rem
+    when rs = Trec_first && not !Clflags.real_paths ->
+      let rec get_ids = function
+          Sig_type (id, _, Trec_next, _) :: rem ->
+            id :: get_ids rem
+        | _ -> []
+      in
+      let ids = id :: get_ids rem in
+      set_printing_env
+        (hide ids !printing_env)
+  | _ -> ()
+
+let recursive_sigitem = function
+  | Sig_class(id,_,rs,_) -> Some(id,rs,3)
+  | Sig_class_type (id,_,rs,_) -> Some(id,rs,2)
+  | Sig_type(id, _, rs, _)
+  | Sig_module(id, _, _, rs, _) -> Some (id,rs,0)
+  | _ -> None
+
+let skip k l = snd (Misc.Stdlib.List.split_at k l)
+
+let protect_rec_items items =
+  let rec get_ids recs = function
+    | [] -> []
+    | item :: rem -> match recursive_sigitem item with
+      | Some (id, r, k ) when r = recs -> id :: get_ids Trec_next (skip k rem)
+      | _ -> [] in
+  List.iter Naming_context.add_protected (get_ids Trec_first items)
+
+let stop_type_group env =
+  Naming_context.reset_protected ();
+  set_printing_env env
+
+let still_in_type_group env' in_type_group item =
+  match in_type_group, recursive_sigitem item with
+  | true, Some (_,Trec_next,_) -> true
+  | _, Some (_, (Trec_not | Trec_first),_) ->
+      stop_type_group env' ; true
+  | _ -> stop_type_group env'; false
+
+let rec tree_of_modtype ?(ellipsis=false) = function
+  | Mty_ident p ->
+      Omty_ident (tree_of_path 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, res =
+        match param with
+        | Unit -> None, tree_of_modtype ~ellipsis ty_res
+        | 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),
+          wrap_env env (tree_of_modtype ~ellipsis) ty_res
+      in
+      Omty_functor (param, res)
+  | Mty_alias p ->
+      Omty_alias (tree_of_path Module p)
+
+and tree_of_signature sg =
+  wrap_env (fun env -> env) (tree_of_signature_rec !printing_env false) sg
+
+and tree_of_signature_rec env' in_type_group = function
+    [] -> stop_type_group env'; []
+  | item :: rem as items ->
+      let in_type_group = still_in_type_group env' in_type_group item in
+      let (sg, rem) = filter_rem_sig item rem in
+      hide_rec_items items;
+      protect_rec_items items;
+      reset_naming_context ();
+      let trees = trees_of_sigitem item in
+      let env' = Env.add_signature (item :: sg) env' in
+      trees @ tree_of_signature_rec env' in_type_group rem
+
+and trees_of_sigitem = function
+  | Sig_value(id, decl, _) ->
+      [tree_of_value_description id decl]
+  | Sig_type(id, _, _, _) when is_row_name (Ident.name id) ->
+      []
+  | 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)
+
+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? *)
+
+(* Refresh weak variable map in the toplevel *)
+let refresh_weak () =
+  let refresh t name (m,s) =
+    if is_non_gen true (repr 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 print_items showval env x =
+  refresh_weak();
+  reset_naming_context ();
+  Conflicts.reset ();
+  let rec print showval in_type_group env = function
+  | [] -> stop_type_group env; []
+  | item :: rem as items ->
+      let in_type_group = still_in_type_group env in_type_group item in
+      let (sg, rem) = filter_rem_sig item rem in
+      hide_rec_items items;
+      protect_rec_items items;
+      reset_naming_context ();
+      let trees = trees_of_sigitem item in
+      List.map (fun d -> (d, showval env item)) trees @
+      print showval in_type_group (Env.add_signature (item :: sg) env) rem in
+  print showval false env x
+
+(* Print a signature body (used by -i when compiling a .ml) *)
+
+let print_signature ppf tree =
+  fprintf ppf "@[%a@]" !Oprint.out_signature tree
+
+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 ();
+  reset_naming_context ();
+  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
+
+(* Print an unification error *)
+
+let same_path t t' =
+  let t = repr t and t' = repr t' in
+  t == t' ||
+  match t.desc, t'.desc 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 same_type tl tl'
+      | _ -> false
+      end
+  | _ ->
+      false
+
+type 'a diff = Same of 'a | Diff of 'a * 'a
+
+let trees_of_type_expansion (t,t') =
+  if same_path t t'
+  then begin add_delayed (proxy t); Same (tree_of_typexp false t) end
+  else
+    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 false t in
+    let second = tree_of_typexp false t' in
+    if first = second then Same first
+    else Diff(first,second)
+
+let type_expansion ppf = function
+  | Same t -> !Oprint.out_type ppf t
+  | Diff(t,t') ->
+      fprintf ppf "@[<2>%a@ =@ %a@]"  !Oprint.out_type t  !Oprint.out_type t'
+
+module Trace = Ctype.Unification_trace
+
+let trees_of_trace = List.map (Trace.map_diff trees_of_type_expansion)
+
+let trees_of_type_path_expansion (tp,tp') =
+  if Path.same tp tp' then Same(tree_of_path Type tp) else
+    Diff(tree_of_path Type tp, tree_of_path Type tp')
+
+let type_path_expansion ppf = function
+  | Same p -> !Oprint.out_ident ppf p
+  | Diff(p,p') ->
+      fprintf ppf "@[<2>%a@ =@ %a@]"
+        !Oprint.out_ident p
+        !Oprint.out_ident p'
+
+let rec trace fst txt ppf = function
+  | {Trace.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 printing_status  = function
+  | Trace.(Diff { got=t1, t1'; expected=t2, 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
+  | _ -> Keep
+
+(** Flatten the trace and remove elements that are always discarded
+    during printing *)
+let prepare_trace f 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 Trace.flatten f tr with
+  | [] -> []
+  | elt :: rem -> (* the first element is always kept *)
+      elt :: List.fold_right clean_trace rem []
+
+(** Keep elements that are not [Diff _ ] and take the decision
+    for the last element, require a prepared trace *)
+let rec filter_trace keep_last = function
+  | [] -> []
+  | [Trace.Diff d as elt] when printing_status elt = Optional_refinement ->
+      if keep_last then [d] else []
+  | Trace.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 repr t with
+  | {desc = Tvariant row} as t when (row_repr row).row_name <> None ->
+      newty2 t.level
+        (Tvariant {(row_repr row) with row_name = None;
+                   row_more = newvar2 (row_more row).level})
+  | _ -> t
+
+let prepare_expansion (t, t') =
+  let t' = hide_variant_name t' in
+  mark_loops t;
+  if not (same_path t t') then mark_loops t';
+  (t, t')
+
+let may_prepare_expansion compact (t, t') =
+  match (repr t').desc with
+    Tvariant _ | Tobject _ when compact ->
+      mark_loops t; (t, t)
+  | _ -> prepare_expansion (t, t')
+
+let print_tag ppf = fprintf 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 (Ctype.expand_head env ty).desc 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 t3.desc, t4.desc with
+  | Tarrow (_, ty1, ty2, _), _
+    when is_unit env ty1 && unifiable env ty2 t4 ->
+      Some (fun ppf ->
+        fprintf ppf
+          "@,@[Hint: Did you forget to provide `()' as argument?@]")
+  | _, Tarrow (_, ty1, ty2, _)
+    when is_unit env ty1 && unifiable env t3 ty2 ->
+      Some (fun ppf ->
+        fprintf ppf
+          "@,@[Hint: Did you forget to wrap the expression using \
+           `fun () ->'?@]")
+  | _ ->
+      None
+
+let print_pos ppf = function
+  | Trace.First -> fprintf ppf "first"
+  | Trace.Second -> fprintf ppf "second"
+
+let explain_fixed_row_case ppf = function
+  | Trace.Cannot_be_closed -> Format.fprintf ppf "it cannot be closed"
+  | Trace.Cannot_add_tags tags ->
+      Format.fprintf ppf "it may not allow the tag(s) %a"
+        print_tags tags
+
+let explain_fixed_row pos expl = match expl with
+  | Types.Fixed_private ->
+      dprintf "The %a variant type is private" print_pos pos
+  | Types.Univar x ->
+      dprintf "The %a variant type is bound to the universal type variable %a"
+        print_pos pos type_expr x
+  | Types.Reified p ->
+      let p = tree_of_path Type p in
+      dprintf "The %a variant type is bound to %a" print_pos pos
+        !Oprint.out_ident p
+  | Types.Rigid -> ignore
+
+let explain_variant = function
+  | Trace.No_intersection ->
+      Some(dprintf "@,These two variant types have no intersection")
+  | Trace.No_tags(pos,fields) -> Some(
+      dprintf
+        "@,@[The %a variant type does not allow tag(s)@ @[%a@]@]"
+        print_pos pos
+        print_tags (List.map fst fields)
+    )
+  | Trace.Incompatible_types_for s ->
+      Some(dprintf "@,Types for tag `%s are incompatible" s)
+  | Trace.Fixed_row (pos, k, (Univar _ | Reified _ | Fixed_private as e)) ->
+      Some (
+        dprintf "@,@[%t,@ %a@]" (explain_fixed_row pos e)
+          explain_fixed_row_case k
+      )
+  | Trace.Fixed_row (_,_, Rigid) ->
+      (* this case never happens *)
+      None
+
+
+let explain_escape intro prev ctx e =
+  let pre = match ctx with
+    | Some ctx ->  dprintf "@[%t@;<1 2>%a@]" intro type_expr ctx
+    | None -> match e, prev with
+      | Trace.Univ _, Some(Trace.Incompatible_fields {name; diff}) ->
+          dprintf "@,@[The method %s has type@ %a,@ \
+                   but the expected method type was@ %a@]" name
+            type_expr diff.Trace.got type_expr diff.Trace.expected
+      | _ -> ignore in
+  match e with
+  | Trace.Univ u ->  Some(
+      dprintf "%t@,The universal variable %a would escape its scope"
+        pre type_expr u)
+  | Trace.Constructor p -> Some(
+      dprintf
+        "%t@,@[The type constructor@;<1 2>%a@ would escape its scope@]"
+        pre path p
+    )
+  | Trace.Module_type p -> Some(
+      dprintf
+        "%t@,@[The module type@;<1 2>%a@ would escape its scope@]"
+        pre path p
+    )
+  | Trace.Equation (_,t) -> Some(
+      dprintf "%t @,@[This instance of %a is ambiguous:@ %s@]"
+        pre type_expr t
+        "it would escape the scope of its equation"
+    )
+  | Trace.Self ->
+      Some (dprintf "%t@,Self type cannot escape its class" pre)
+
+
+let explain_object = function
+  | Trace.Self_cannot_be_closed ->
+      Some (dprintf "@,Self type cannot be unified with a closed object type")
+  | Trace.Missing_field (pos,f) ->
+      Some(dprintf "@,@[The %a object type has no method %s@]" print_pos pos f)
+  | Trace.Abstract_row pos -> Some(
+      dprintf
+        "@,@[The %a object type has an abstract row, it cannot be closed@]"
+        print_pos pos
+    )
+
+
+let explanation intro prev env = function
+  | Trace.Diff { Trace.got = _, s; expected = _,t } -> explanation_diff env s t
+  | Trace.Escape {kind;context} -> explain_escape intro prev context kind
+  | Trace.Incompatible_fields { name; _ } ->
+        Some(dprintf "@,Types for method %s are incompatible" name)
+  | Trace.Variant v -> explain_variant v
+  | Trace.Obj o -> explain_object o
+  | Trace.Rec_occur(x,y) ->
+      reset_and_mark_loops y;
+      Some(dprintf "@,@[The type variable %a occurs inside@ %a@]"
+            marked_type_expr x marked_type_expr y)
+
+let mismatch intro env trace =
+  Trace.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 t.desc with
+  | Tconstr (p,_,_) ->
+    begin
+      try
+        ignore(Env.find_type p env : Types.type_declaration)
+      with Not_found ->
+        fprintf ppf
+          "@,@[%a is abstract because no corresponding cmi file was found \
+           in path.@]" path p
+    end
+  | _ -> ()
+
+
+let prepare_expansion_head empty_tr = function
+  | Trace.Diff d ->
+      Some(Trace.map_diff (may_prepare_expansion empty_tr) d)
+  | _ -> None
+
+let head_error_printer txt_got txt_but = function
+  | None -> ignore
+  | Some d ->
+      let d = Trace.map_diff trees_of_type_expansion d in
+      dprintf "%t@;<1 2>%a@ %t@;<1 2>%a"
+        txt_got type_expansion d.Trace.got
+        txt_but type_expansion d.Trace.expected
+
+let warn_on_missing_defs env ppf = function
+  | None -> ()
+  | Some {Trace.got=te1,_; expected=te2,_ } ->
+      warn_on_missing_def env ppf te1;
+      warn_on_missing_def env ppf te2
+
+let unification_error env tr txt1 ppf txt2 ty_expect_explanation =
+  reset ();
+  let tr = prepare_trace (fun t t' -> t, hide_variant_name t') 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 (Trace.map_diff prepare_expansion) tr in
+      let head_error = head_error_printer txt1 txt2 head in
+      let tr = trees_of_trace tr in
+      fprintf ppf
+        "@[\
+          @[%t%t@]%a%t\
+         @]"
+        head_error
+        ty_expect_explanation
+        (trace false "is not compatible with type") tr
+        (explain mis);
+      if env <> Env.empty
+      then warn_on_missing_defs env ppf head;
+      Conflicts.print_explanations ppf;
+      print_labels := true
+    with exn ->
+      print_labels := true;
+      raise exn
+
+let report_unification_error ppf env tr
+    ?(type_expected_explanation = fun _ -> ())
+    txt1 txt2 =
+  wrap_printing_env env (fun () -> unification_error env tr txt1 ppf txt2
+                            type_expected_explanation)
+    ~error:true
+;;
+
+(** [trace] requires the trace to be prepared *)
+let trace fst keep_last txt ppf tr =
+  print_labels := not !Clflags.classic;
+  try match tr with
+    | elt :: tr' ->
+        let elt = match elt with
+          | Trace.Diff diff -> [Trace.map_diff trees_of_type_expansion diff]
+          | _ -> [] in
+        let tr =
+          trees_of_trace
+          @@ List.map (Trace.map_diff prepare_expansion)
+          @@ filter_trace keep_last tr' in
+      if fst then trace fst txt ppf (elt @ tr)
+      else trace fst txt ppf tr;
+      print_labels := true
+  | _ -> ()
+  with exn ->
+    print_labels := true;
+    raise exn
+
+let report_subtyping_error ppf env tr1 txt1 tr2 =
+  wrap_printing_env ~error:true env (fun () ->
+    reset ();
+    let tr1 = prepare_trace (fun t t' -> prepare_expansion (t, t')) tr1 in
+    let tr2 = prepare_trace (fun t t' -> prepare_expansion (t, t')) tr2 in
+    let keep_first = match tr2 with
+      | Trace.[Obj _ | Variant _ | Escape _ ] | [] -> true
+      | _ -> false in
+    fprintf ppf "@[%a" (trace true keep_first txt1) tr1;
+    if tr2 = [] then fprintf ppf "@]" else
+    let mis = mismatch (dprintf "Within this type") env tr2 in
+    fprintf ppf "%a%t%t@]"
+      (trace false (mis = None) "is not compatible with type") tr2
+      (explain mis)
+      Conflicts.print_explanations
+  )
+
+
+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>@[%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 Other
+let tree_of_modtype = tree_of_modtype ~ellipsis:false
+let type_expansion ty ppf ty' =
+  type_expansion ppf (trees_of_type_expansion (ty,ty'))
+let tree_of_type_declaration id td rs =
+  Naming_context.with_hidden id ( (* for disambiguation *)
+    wrap_env (hide [id]) (* for short-path *)
+      (fun () -> tree_of_type_declaration id td rs)
+  )
diff --git a/typing/printtyp.mli b/typing/printtyp.mli
new file mode 100644
index 00000000..fba02c6f
--- /dev/null
+++ b/typing/printtyp.mli
@@ -0,0 +1,186 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Printing functions *)
+
+open Format
+open Types
+open Outcometree
+
+val longident: formatter -> Longident.t -> unit
+val ident: formatter -> Ident.t -> unit
+val tree_of_path: Path.t -> out_ident
+val path: formatter -> Path.t -> unit
+val string_of_path: Path.t -> string
+
+val type_path: formatter -> Path.t -> unit
+(** Print a type path taking account of [-short-paths].
+    Calls should be within [wrap_printing_env]. *)
+
+module Out_name: sig
+  val create: string -> out_name
+  val print: out_name -> string
+end
+
+type namespace =
+  | Type
+  | Module
+  | Module_type
+  | Class
+  | Class_type
+  | Other (** Other bypasses the unique name for identifier mechanism *)
+
+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. *)
+
+  val reset: unit -> unit
+  (** Reset the naming context *)
+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: namespace;
+      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
+val mark_loops: type_expr -> unit
+val reset_and_mark_loops: type_expr -> unit
+val reset_and_mark_loops_list: type_expr list -> unit
+
+val type_expr: formatter -> type_expr -> unit
+val marked_type_expr: formatter -> type_expr -> unit
+(** The function [type_expr] is the safe version of the pair
+    [(typed_expr, marked_type_expr)]:
+    it takes care of marking loops in the type expression and resetting
+    type variable names before printing.
+      Contrarily, the function [marked_type_expr] should only be called on
+    type expressions whose loops have been marked or it may stackoverflow
+    (see #8860 for examples).
+ *)
+
+val constructor_arguments: formatter -> constructor_arguments -> unit
+val tree_of_type_scheme: type_expr -> out_type
+val type_sch : formatter -> type_expr -> unit
+val type_scheme: formatter -> type_expr -> unit
+(* Maxence *)
+val reset_names: unit -> unit
+val type_scheme_max: ?b_reset_names: bool ->
+        formatter -> type_expr -> unit
+(* End Maxence *)
+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 constructor : formatter -> constructor_declaration -> unit
+val tree_of_type_declaration:
+    Ident.t -> type_declaration -> rec_status -> out_sig_item
+val type_declaration: Ident.t -> formatter -> type_declaration -> unit
+val tree_of_extension_constructor:
+    Ident.t -> extension_constructor -> ext_status -> out_sig_item
+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
+val tree_of_signature: Types.signature -> out_sig_item list
+val tree_of_typexp: bool -> 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_expr -> Format.formatter -> type_expr -> unit
+val prepare_expansion: type_expr * type_expr -> type_expr * type_expr
+val trace:
+  bool -> bool-> string -> formatter
+  -> (type_expr * type_expr) Ctype.Unification_trace.elt list -> unit
+val report_unification_error:
+    formatter -> Env.t ->
+    Ctype.Unification_trace.t ->
+    ?type_expected_explanation:(formatter -> unit) ->
+    (formatter -> unit) -> (formatter -> unit) ->
+    unit
+val report_subtyping_error:
+    formatter -> Env.t -> Ctype.Unification_trace.t -> string
+    -> Ctype.Unification_trace.t -> unit
+val report_ambiguous_type_error:
+    formatter -> Env.t -> (Path.t * Path.t) -> (Path.t * Path.t) list ->
+    (formatter -> unit) -> (formatter -> unit) -> (formatter -> unit) -> unit
+
+(* 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
+
+(** [printed_signature sourcefile ppf sg] print the signature [sg] of
+    [sourcefile] with potential warnings for name collisions *)
+val printed_signature: string -> formatter -> signature -> unit
diff --git a/typing/printtyped.ml b/typing/printtyped.ml
new file mode 100644
index 00000000..15aa0972
--- /dev/null
+++ b/typing/printtyped.ml
@@ -0,0 +1,945 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Fabrice Le Fessant, INRIA Saclay                     *)
+(*                                                                        *)
+(*   Copyright 1999 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Asttypes;;
+open Format;;
+open Lexing;;
+open Location;;
+open Typedtree;;
+
+let fmt_position f l =
+  if l.pos_lnum = -1
+  then fprintf f "%s[%d]" l.pos_fname l.pos_cnum
+  else fprintf f "%s[%d,%d+%d]" l.pos_fname l.pos_lnum l.pos_bol
+               (l.pos_cnum - l.pos_bol)
+;;
+
+let fmt_location f loc =
+  if not !Clflags.locations then ()
+  else begin
+    fprintf f "(%a..%a)" fmt_position loc.loc_start fmt_position loc.loc_end;
+    if loc.loc_ghost then fprintf f " ghost";
+  end
+;;
+
+let rec fmt_longident_aux f x =
+  match x with
+  | Longident.Lident (s) -> fprintf f "%s" s;
+  | Longident.Ldot (y, s) -> fprintf f "%a.%s" fmt_longident_aux y s;
+  | Longident.Lapply (y, z) ->
+      fprintf f "%a(%a)" fmt_longident_aux y fmt_longident_aux z;
+;;
+
+let fmt_longident f x = fprintf f "\"%a\"" fmt_longident_aux x.txt;;
+
+let fmt_ident = Ident.print
+
+let fmt_modname f = function
+  | None -> fprintf f "_";
+  | Some id -> Ident.print f id
+
+let rec fmt_path_aux f x =
+  match x with
+  | Path.Pident (s) -> fprintf f "%a" fmt_ident s;
+  | Path.Pdot (y, s) -> fprintf f "%a.%s" fmt_path_aux y s;
+  | Path.Papply (y, z) ->
+      fprintf f "%a(%a)" fmt_path_aux y fmt_path_aux z;
+;;
+
+let fmt_path f x = fprintf f "\"%a\"" fmt_path_aux x;;
+
+let fmt_constant f x =
+  match x with
+  | Const_int (i) -> fprintf f "Const_int %d" i;
+  | Const_char (c) -> fprintf f "Const_char %02x" (Char.code c);
+  | Const_string (s, strloc, None) ->
+      fprintf f "Const_string(%S,%a,None)" s fmt_location strloc;
+  | Const_string (s, strloc, Some delim) ->
+      fprintf f "Const_string (%S,%a,Some %S)" s fmt_location strloc delim;
+  | Const_float (s) -> fprintf f "Const_float %s" s;
+  | Const_int32 (i) -> fprintf f "Const_int32 %ld" i;
+  | Const_int64 (i) -> fprintf f "Const_int64 %Ld" i;
+  | Const_nativeint (i) -> fprintf f "Const_nativeint %nd" i;
+;;
+
+let fmt_mutable_flag f x =
+  match x with
+  | Immutable -> fprintf f "Immutable";
+  | Mutable -> fprintf f "Mutable";
+;;
+
+let fmt_virtual_flag f x =
+  match x with
+  | Virtual -> fprintf f "Virtual";
+  | Concrete -> fprintf f "Concrete";
+;;
+
+let fmt_override_flag f x =
+  match x with
+  | Override -> fprintf f "Override";
+  | Fresh -> fprintf f "Fresh";
+;;
+
+let fmt_closed_flag f x =
+  match x with
+  | Closed -> fprintf f "Closed"
+  | Open -> fprintf f "Open"
+
+let fmt_rec_flag f x =
+  match x with
+  | Nonrecursive -> fprintf f "Nonrec";
+  | Recursive -> fprintf f "Rec";
+;;
+
+let fmt_direction_flag f x =
+  match x with
+  | Upto -> fprintf f "Up";
+  | Downto -> fprintf f "Down";
+;;
+
+let fmt_private_flag f x =
+  match x with
+  | Public -> fprintf f "Public";
+  | Private -> fprintf f "Private";
+;;
+
+let line i f s (*...*) =
+  fprintf f "%s" (String.make (2*i) ' ');
+  fprintf f s (*...*)
+;;
+
+let list i f ppf l =
+  match l with
+  | [] -> line i ppf "[]\n";
+  | _ :: _ ->
+     line i ppf "[\n";
+     List.iter (f (i+1) ppf) l;
+     line i ppf "]\n";
+;;
+
+let array i f ppf a =
+  if Array.length a = 0 then
+    line i ppf "[]\n"
+  else begin
+    line i ppf "[\n";
+    Array.iter (f (i+1) ppf) a;
+    line i ppf "]\n"
+  end
+;;
+
+let option i f ppf x =
+  match x with
+  | None -> line i ppf "None\n";
+  | Some x ->
+      line i ppf "Some\n";
+      f (i+1) ppf x;
+;;
+
+let longident i ppf li = line i ppf "%a\n" fmt_longident li;;
+let string i ppf s = line i ppf "\"%s\"\n" s;;
+let arg_label i ppf = function
+  | Nolabel -> line i ppf "Nolabel\n"
+  | Optional s -> line i ppf "Optional \"%s\"\n" s
+  | Labelled s -> line i ppf "Labelled \"%s\"\n" s
+;;
+
+let record_representation i ppf = let open Types in function
+  | Record_regular -> line i ppf "Record_regular\n"
+  | Record_float -> line i ppf "Record_float\n"
+  | Record_unboxed b -> line i ppf "Record_unboxed %b\n" b
+  | Record_inlined i -> line i ppf "Record_inlined %d\n" i
+  | Record_extension p -> line i ppf "Record_extension %a\n" fmt_path p
+
+let attribute i ppf k a =
+  line i ppf "%s \"%s\"\n" k a.Parsetree.attr_name.txt;
+  Printast.payload i ppf a.Parsetree.attr_payload
+
+let attributes i ppf l =
+  let i = i + 1 in
+  List.iter (fun a ->
+    line i ppf "attribute \"%s\"\n" a.Parsetree.attr_name.txt;
+    Printast.payload (i + 1) ppf a.Parsetree.attr_payload
+  ) l
+
+let rec core_type i ppf x =
+  line i ppf "core_type %a\n" fmt_location x.ctyp_loc;
+  attributes i ppf x.ctyp_attributes;
+  let i = i+1 in
+  match x.ctyp_desc with
+  | Ttyp_any -> line i ppf "Ttyp_any\n";
+  | Ttyp_var (s) -> line i ppf "Ttyp_var %s\n" s;
+  | Ttyp_arrow (l, ct1, ct2) ->
+      line i ppf "Ttyp_arrow\n";
+      arg_label i ppf l;
+      core_type i ppf ct1;
+      core_type i ppf ct2;
+  | Ttyp_tuple l ->
+      line i ppf "Ttyp_tuple\n";
+      list i core_type ppf l;
+  | Ttyp_constr (li, _, l) ->
+      line i ppf "Ttyp_constr %a\n" fmt_path li;
+      list i core_type ppf l;
+  | Ttyp_variant (l, closed, low) ->
+      line i ppf "Ttyp_variant closed=%a\n" fmt_closed_flag closed;
+      list i label_x_bool_x_core_type_list ppf l;
+      option i (fun i -> list i string) ppf low
+  | Ttyp_object (l, c) ->
+      line i ppf "Ttyp_object %a\n" fmt_closed_flag c;
+      let i = i + 1 in
+      List.iter (fun {of_desc; of_attributes; _} ->
+        match of_desc with
+        | OTtag (s, t) ->
+            line i ppf "method %s\n" s.txt;
+            attributes i ppf of_attributes;
+            core_type (i + 1) ppf t
+        | OTinherit ct ->
+            line i ppf "OTinherit\n";
+            core_type (i + 1) ppf ct
+        ) l
+  | Ttyp_class (li, _, l) ->
+      line i ppf "Ttyp_class %a\n" fmt_path li;
+      list i core_type ppf l;
+  | Ttyp_alias (ct, s) ->
+      line i ppf "Ttyp_alias \"%s\"\n" s;
+      core_type i ppf ct;
+  | Ttyp_poly (sl, ct) ->
+      line i ppf "Ttyp_poly%a\n"
+        (fun ppf -> List.iter (fun x -> fprintf ppf " '%s" x)) sl;
+      core_type i ppf ct;
+  | Ttyp_package { pack_path = s; pack_fields = l } ->
+      line i ppf "Ttyp_package %a\n" fmt_path s;
+      list i package_with ppf l;
+
+and package_with i ppf (s, t) =
+  line i ppf "with type %a\n" fmt_longident s;
+  core_type i ppf t
+
+and pattern : type k . _ -> _ -> k general_pattern -> unit = fun i ppf x ->
+  line i ppf "pattern %a\n" fmt_location x.pat_loc;
+  attributes i ppf x.pat_attributes;
+  let i = i+1 in
+  match x.pat_extra with
+    | extra :: rem ->
+        pattern_extra i ppf extra;
+        pattern i ppf { x with pat_extra = rem }
+    | [] ->
+  match x.pat_desc with
+  | Tpat_any -> line i ppf "Tpat_any\n";
+  | Tpat_var (s,_) -> line i ppf "Tpat_var \"%a\"\n" fmt_ident s;
+  | Tpat_alias (p, s,_) ->
+      line i ppf "Tpat_alias \"%a\"\n" fmt_ident s;
+      pattern i ppf p;
+  | Tpat_constant (c) -> line i ppf "Tpat_constant %a\n" fmt_constant c;
+  | Tpat_tuple (l) ->
+      line i ppf "Tpat_tuple\n";
+      list i pattern ppf l;
+  | Tpat_construct (li, _, po) ->
+      line i ppf "Tpat_construct %a\n" fmt_longident li;
+      list i pattern ppf po;
+  | Tpat_variant (l, po, _) ->
+      line i ppf "Tpat_variant \"%s\"\n" l;
+      option i pattern ppf po;
+  | Tpat_record (l, _c) ->
+      line i ppf "Tpat_record\n";
+      list i longident_x_pattern ppf l;
+  | Tpat_array (l) ->
+      line i ppf "Tpat_array\n";
+      list i pattern ppf l;
+  | Tpat_lazy p ->
+      line i ppf "Tpat_lazy\n";
+      pattern i ppf p;
+  | Tpat_exception p ->
+      line i ppf "Tpat_exception\n";
+      pattern i ppf p;
+  | Tpat_value p ->
+      line i ppf "Tpat_value\n";
+      pattern i ppf (p :> pattern);
+  | Tpat_or (p1, p2, _) ->
+      line i ppf "Tpat_or\n";
+      pattern i ppf p1;
+      pattern i ppf p2;
+
+and pattern_extra i ppf (extra_pat, _, attrs) =
+  match extra_pat with
+  | Tpat_unpack ->
+     line i ppf "Tpat_extra_unpack\n";
+     attributes i ppf attrs;
+  | Tpat_constraint cty ->
+     line i ppf "Tpat_extra_constraint\n";
+     attributes i ppf attrs;
+     core_type i ppf cty;
+  | Tpat_type (id, _) ->
+     line i ppf "Tpat_extra_type %a\n" fmt_path id;
+     attributes i ppf attrs;
+  | Tpat_open (id,_,_) ->
+     line i ppf "Tpat_extra_open \"%a\"\n" fmt_path id;
+     attributes i ppf attrs;
+
+and expression_extra i ppf x attrs =
+  match x with
+  | Texp_constraint ct ->
+      line i ppf "Texp_constraint\n";
+      attributes i ppf attrs;
+      core_type i ppf ct;
+  | Texp_coerce (cto1, cto2) ->
+      line i ppf "Texp_coerce\n";
+      attributes i ppf attrs;
+      option i core_type ppf cto1;
+      core_type i ppf cto2;
+  | Texp_poly cto ->
+      line i ppf "Texp_poly\n";
+      attributes i ppf attrs;
+      option i core_type ppf cto;
+  | Texp_newtype s ->
+      line i ppf "Texp_newtype \"%s\"\n" s;
+      attributes i ppf attrs;
+
+and expression i ppf x =
+  line i ppf "expression %a\n" fmt_location x.exp_loc;
+  attributes i ppf x.exp_attributes;
+  let i =
+    List.fold_left (fun i (extra,_,attrs) ->
+                      expression_extra i ppf extra attrs; i+1)
+      (i+1) x.exp_extra
+  in
+  match x.exp_desc with
+  | Texp_ident (li,_,_) -> line i ppf "Texp_ident %a\n" fmt_path li;
+  | Texp_instvar (_, li,_) -> line i ppf "Texp_instvar %a\n" fmt_path li;
+  | Texp_constant (c) -> line i ppf "Texp_constant %a\n" fmt_constant c;
+  | Texp_let (rf, l, e) ->
+      line i ppf "Texp_let %a\n" fmt_rec_flag rf;
+      list i value_binding ppf l;
+      expression i ppf e;
+  | Texp_function { arg_label = p; param = _; cases; partial = _; } ->
+      line i ppf "Texp_function\n";
+      arg_label i ppf p;
+      list i case ppf cases;
+  | Texp_apply (e, l) ->
+      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\n";
+      expression i ppf e;
+      list i case ppf l;
+  | Texp_try (e, l) ->
+      line i ppf "Texp_try\n";
+      expression i ppf e;
+      list i case ppf l;
+  | Texp_tuple (l) ->
+      line i ppf "Texp_tuple\n";
+      list i expression ppf l;
+  | Texp_construct (li, _, eo) ->
+      line i ppf "Texp_construct %a\n" fmt_longident li;
+      list i expression ppf eo;
+  | Texp_variant (l, eo) ->
+      line i ppf "Texp_variant \"%s\"\n" l;
+      option i expression ppf eo;
+  | Texp_record { fields; representation; extended_expression } ->
+      line i ppf "Texp_record\n";
+      let i = i+1 in
+      line i ppf "fields =\n";
+      array (i+1) record_field ppf fields;
+      line i ppf "representation =\n";
+      record_representation (i+1) ppf representation;
+      line i ppf "extended_expression =\n";
+      option (i+1) expression ppf extended_expression;
+  | Texp_field (e, li, _) ->
+      line i ppf "Texp_field\n";
+      expression i ppf e;
+      longident i ppf li;
+  | Texp_setfield (e1, li, _, e2) ->
+      line i ppf "Texp_setfield\n";
+      expression i ppf e1;
+      longident i ppf li;
+      expression i ppf e2;
+  | Texp_array (l) ->
+      line i ppf "Texp_array\n";
+      list i expression ppf l;
+  | Texp_ifthenelse (e1, e2, eo) ->
+      line i ppf "Texp_ifthenelse\n";
+      expression i ppf e1;
+      expression i ppf e2;
+      option i expression ppf eo;
+  | Texp_sequence (e1, e2) ->
+      line i ppf "Texp_sequence\n";
+      expression i ppf e1;
+      expression i ppf e2;
+  | Texp_while (e1, e2) ->
+      line i ppf "Texp_while\n";
+      expression i ppf e1;
+      expression i ppf e2;
+  | Texp_for (s, _, e1, e2, df, e3) ->
+      line i ppf "Texp_for \"%a\" %a\n" fmt_ident s fmt_direction_flag df;
+      expression i ppf e1;
+      expression i ppf e2;
+      expression i ppf e3;
+  | Texp_send (e, Tmeth_name s, eo) ->
+      line i ppf "Texp_send \"%s\"\n" s;
+      expression i ppf e;
+      option i expression ppf eo
+  | Texp_send (e, Tmeth_val s, eo) ->
+      line i ppf "Texp_send \"%a\"\n" fmt_ident s;
+      expression i ppf e;
+      option i expression ppf eo
+  | Texp_new (li, _, _) -> line i ppf "Texp_new %a\n" fmt_path li;
+  | Texp_setinstvar (_, s, _, e) ->
+      line i ppf "Texp_setinstvar \"%a\"\n" fmt_path s;
+      expression i ppf e;
+  | Texp_override (_, l) ->
+      line i ppf "Texp_override\n";
+      list i string_x_expression ppf l;
+  | Texp_letmodule (s, _, _, me, e) ->
+      line i ppf "Texp_letmodule \"%a\"\n" fmt_modname s;
+      module_expr i ppf me;
+      expression i ppf e;
+  | Texp_letexception (cd, e) ->
+      line i ppf "Texp_letexception\n";
+      extension_constructor i ppf cd;
+      expression i ppf e;
+  | Texp_assert (e) ->
+      line i ppf "Texp_assert";
+      expression i ppf e;
+  | Texp_lazy (e) ->
+      line i ppf "Texp_lazy";
+      expression i ppf e;
+  | Texp_object (s, _) ->
+      line i ppf "Texp_object";
+      class_structure i ppf s
+  | Texp_pack me ->
+      line i ppf "Texp_pack";
+      module_expr i ppf me
+  | Texp_letop {let_; ands; param = _; body; partial = _} ->
+      line i ppf "Texp_letop";
+      binding_op (i+1) ppf let_;
+      list (i+1) binding_op ppf ands;
+      case i ppf body
+  | Texp_unreachable ->
+      line i ppf "Texp_unreachable"
+  | Texp_extension_constructor (li, _) ->
+      line i ppf "Texp_extension_constructor %a" fmt_longident li
+  | Texp_open (o, e) ->
+      line i ppf "Texp_open %a\n"
+        fmt_override_flag o.open_override;
+      module_expr i ppf o.open_expr;
+      attributes i ppf o.open_attributes;
+      expression i ppf e;
+
+and value_description i ppf x =
+  line i ppf "value_description %a %a\n" fmt_ident x.val_id fmt_location
+       x.val_loc;
+  attributes i ppf x.val_attributes;
+  core_type (i+1) ppf x.val_desc;
+  list (i+1) string ppf x.val_prim;
+
+and binding_op i ppf x =
+  line i ppf "binding_op %a %a\n" fmt_path x.bop_op_path
+    fmt_location x.bop_loc;
+  expression i ppf x.bop_exp
+
+and type_parameter i ppf (x, _variance) = core_type i ppf x
+
+and type_declaration i ppf x =
+  line i ppf "type_declaration %a %a\n" fmt_ident x.typ_id fmt_location
+       x.typ_loc;
+  attributes i ppf x.typ_attributes;
+  let i = i+1 in
+  line i ppf "ptype_params =\n";
+  list (i+1) type_parameter ppf x.typ_params;
+  line i ppf "ptype_cstrs =\n";
+  list (i+1) core_type_x_core_type_x_location ppf x.typ_cstrs;
+  line i ppf "ptype_kind =\n";
+  type_kind (i+1) ppf x.typ_kind;
+  line i ppf "ptype_private = %a\n" fmt_private_flag x.typ_private;
+  line i ppf "ptype_manifest =\n";
+  option (i+1) core_type ppf x.typ_manifest;
+
+and type_kind i ppf x =
+  match x with
+  | Ttype_abstract ->
+      line i ppf "Ttype_abstract\n"
+  | Ttype_variant l ->
+      line i ppf "Ttype_variant\n";
+      list (i+1) constructor_decl ppf l;
+  | Ttype_record l ->
+      line i ppf "Ttype_record\n";
+      list (i+1) label_decl ppf l;
+  | Ttype_open ->
+      line i ppf "Ttype_open\n"
+
+and type_extension i ppf x =
+  line i ppf "type_extension\n";
+  attributes i ppf x.tyext_attributes;
+  let i = i+1 in
+  line i ppf "ptyext_path = %a\n" fmt_path x.tyext_path;
+  line i ppf "ptyext_params =\n";
+  list (i+1) type_parameter ppf x.tyext_params;
+  line i ppf "ptyext_constructors =\n";
+  list (i+1) extension_constructor ppf x.tyext_constructors;
+  line i ppf "ptyext_private = %a\n" fmt_private_flag x.tyext_private;
+
+and type_exception i ppf x =
+  line i ppf "type_exception\n";
+  attributes i ppf x.tyexn_attributes;
+  let i = i+1 in
+  line i ppf "ptyext_constructor =\n";
+  let i = i+1 in
+  extension_constructor i ppf x.tyexn_constructor
+
+and extension_constructor i ppf x =
+  line i ppf "extension_constructor %a\n" fmt_location x.ext_loc;
+  attributes i ppf x.ext_attributes;
+  let i = i + 1 in
+  line i ppf "pext_name = \"%a\"\n" fmt_ident x.ext_id;
+  line i ppf "pext_kind =\n";
+  extension_constructor_kind (i + 1) ppf x.ext_kind;
+
+and extension_constructor_kind i ppf x =
+  match x with
+      Text_decl(a, r) ->
+        line i ppf "Text_decl\n";
+        constructor_arguments (i+1) ppf a;
+        option (i+1) core_type ppf r;
+    | Text_rebind(p, _) ->
+        line i ppf "Text_rebind\n";
+        line (i+1) ppf "%a\n" fmt_path p;
+
+and class_type i ppf x =
+  line i ppf "class_type %a\n" fmt_location x.cltyp_loc;
+  attributes i ppf x.cltyp_attributes;
+  let i = i+1 in
+  match x.cltyp_desc with
+  | Tcty_constr (li, _, l) ->
+      line i ppf "Tcty_constr %a\n" fmt_path li;
+      list i core_type ppf l;
+  | Tcty_signature (cs) ->
+      line i ppf "Tcty_signature\n";
+      class_signature i ppf cs;
+  | Tcty_arrow (l, co, cl) ->
+      line i ppf "Tcty_arrow\n";
+      arg_label i ppf l;
+      core_type i ppf co;
+      class_type i ppf cl;
+  | Tcty_open (o, e) ->
+      line i ppf "Tcty_open %a %a\n"
+        fmt_override_flag o.open_override
+        fmt_path (fst o.open_expr);
+      class_type i ppf e
+
+and class_signature i ppf { csig_self = ct; csig_fields = l } =
+  line i ppf "class_signature\n";
+  core_type (i+1) ppf ct;
+  list (i+1) class_type_field ppf l;
+
+and class_type_field i ppf x =
+  line i ppf "class_type_field %a\n" fmt_location x.ctf_loc;
+  let i = i+1 in
+  attributes i ppf x.ctf_attributes;
+  match x.ctf_desc with
+  | Tctf_inherit (ct) ->
+      line i ppf "Tctf_inherit\n";
+      class_type i ppf ct;
+  | Tctf_val (s, mf, vf, ct) ->
+      line i ppf "Tctf_val \"%s\" %a %a\n" s fmt_mutable_flag mf
+           fmt_virtual_flag vf;
+      core_type (i+1) ppf ct;
+  | Tctf_method (s, pf, vf, ct) ->
+      line i ppf "Tctf_method \"%s\" %a %a\n" s fmt_private_flag pf
+           fmt_virtual_flag vf;
+      core_type (i+1) ppf ct;
+  | Tctf_constraint (ct1, ct2) ->
+      line i ppf "Tctf_constraint\n";
+      core_type (i+1) ppf ct1;
+      core_type (i+1) ppf ct2;
+  | Tctf_attribute a ->
+      attribute i ppf "Tctf_attribute" a
+
+and class_description i ppf x =
+  line i ppf "class_description %a\n" fmt_location x.ci_loc;
+  attributes i ppf x.ci_attributes;
+  let i = i+1 in
+  line i ppf "pci_virt = %a\n" fmt_virtual_flag x.ci_virt;
+  line i ppf "pci_params =\n";
+  list (i+1) type_parameter ppf x.ci_params;
+  line i ppf "pci_name = \"%s\"\n" x.ci_id_name.txt;
+  line i ppf "pci_expr =\n";
+  class_type (i+1) ppf x.ci_expr;
+
+and class_type_declaration i ppf x =
+  line i ppf "class_type_declaration %a\n" fmt_location x.ci_loc;
+  let i = i+1 in
+  line i ppf "pci_virt = %a\n" fmt_virtual_flag x.ci_virt;
+  line i ppf "pci_params =\n";
+  list (i+1) type_parameter ppf x.ci_params;
+  line i ppf "pci_name = \"%s\"\n" x.ci_id_name.txt;
+  line i ppf "pci_expr =\n";
+  class_type (i+1) ppf x.ci_expr;
+
+and class_expr i ppf x =
+  line i ppf "class_expr %a\n" fmt_location x.cl_loc;
+  attributes i ppf x.cl_attributes;
+  let i = i+1 in
+  match x.cl_desc with
+  | Tcl_ident (li, _, l) ->
+      line i ppf "Tcl_ident %a\n" fmt_path li;
+      list i core_type ppf l;
+  | Tcl_structure (cs) ->
+      line i ppf "Tcl_structure\n";
+      class_structure i ppf cs;
+  | Tcl_fun (l, p, _, ce, _) ->
+      line i ppf "Tcl_fun\n";
+      arg_label i ppf l;
+      pattern i ppf p;
+      class_expr i ppf ce
+  | Tcl_apply (ce, l) ->
+      line i ppf "Tcl_apply\n";
+      class_expr i ppf ce;
+      list i label_x_expression ppf l;
+  | Tcl_let (rf, l1, l2, ce) ->
+      line i ppf "Tcl_let %a\n" fmt_rec_flag rf;
+      list i value_binding ppf l1;
+      list i ident_x_expression_def ppf l2;
+      class_expr i ppf ce;
+  | Tcl_constraint (ce, Some ct, _, _, _) ->
+      line i ppf "Tcl_constraint\n";
+      class_expr i ppf ce;
+      class_type i ppf ct
+  | Tcl_constraint (ce, None, _, _, _) -> class_expr i ppf ce
+  | Tcl_open (o, e) ->
+      line i ppf "Tcl_open %a %a\n"
+        fmt_override_flag o.open_override
+        fmt_path (fst o.open_expr);
+      class_expr i ppf e
+
+and class_structure i ppf { cstr_self = p; cstr_fields = l } =
+  line i ppf "class_structure\n";
+  pattern (i+1) ppf p;
+  list (i+1) class_field ppf l;
+
+and class_field i ppf x =
+  line i ppf "class_field %a\n" fmt_location x.cf_loc;
+  let i = i + 1 in
+  attributes i ppf x.cf_attributes;
+  match x.cf_desc with
+  | Tcf_inherit (ovf, ce, so, _, _) ->
+      line i ppf "Tcf_inherit %a\n" fmt_override_flag ovf;
+      class_expr (i+1) ppf ce;
+      option (i+1) string ppf so;
+  | Tcf_val (s, mf, _, k, _) ->
+      line i ppf "Tcf_val \"%s\" %a\n" s.txt fmt_mutable_flag mf;
+      class_field_kind (i+1) ppf k
+  | Tcf_method (s, pf, k) ->
+      line i ppf "Tcf_method \"%s\" %a\n" s.txt fmt_private_flag pf;
+      class_field_kind (i+1) ppf k
+  | Tcf_constraint (ct1, ct2) ->
+      line i ppf "Tcf_constraint\n";
+      core_type (i+1) ppf ct1;
+      core_type (i+1) ppf ct2;
+  | Tcf_initializer (e) ->
+      line i ppf "Tcf_initializer\n";
+      expression (i+1) ppf e;
+  | Tcf_attribute a ->
+      attribute i ppf "Tcf_attribute" a
+
+and class_field_kind i ppf = function
+  | Tcfk_concrete (o, e) ->
+      line i ppf "Concrete %a\n" fmt_override_flag o;
+      expression i ppf e
+  | Tcfk_virtual t ->
+      line i ppf "Virtual\n";
+      core_type i ppf t
+
+and class_declaration i ppf x =
+  line i ppf "class_declaration %a\n" fmt_location x.ci_loc;
+  let i = i+1 in
+  line i ppf "pci_virt = %a\n" fmt_virtual_flag x.ci_virt;
+  line i ppf "pci_params =\n";
+  list (i+1) type_parameter ppf x.ci_params;
+  line i ppf "pci_name = \"%s\"\n" x.ci_id_name.txt;
+  line i ppf "pci_expr =\n";
+  class_expr (i+1) ppf x.ci_expr;
+
+and module_type i ppf x =
+  line i ppf "module_type %a\n" fmt_location x.mty_loc;
+  attributes i ppf x.mty_attributes;
+  let i = i+1 in
+  match x.mty_desc with
+  | Tmty_ident (li,_) -> line i ppf "Tmty_ident %a\n" fmt_path li;
+  | Tmty_alias (li,_) -> line i ppf "Tmty_alias %a\n" fmt_path li;
+  | Tmty_signature (s) ->
+      line i ppf "Tmty_signature\n";
+      signature i ppf s;
+  | Tmty_functor (Unit, mt2) ->
+      line i ppf "Tmty_functor ()\n";
+      module_type i ppf mt2;
+  | Tmty_functor (Named (s, _, mt1), mt2) ->
+      line i ppf "Tmty_functor \"%a\"\n" fmt_modname s;
+      module_type i ppf mt1;
+      module_type i ppf mt2;
+  | Tmty_with (mt, l) ->
+      line i ppf "Tmty_with\n";
+      module_type i ppf mt;
+      list i longident_x_with_constraint ppf l;
+  | Tmty_typeof m ->
+      line i ppf "Tmty_typeof\n";
+      module_expr i ppf m;
+
+and signature i ppf x = list i signature_item ppf x.sig_items
+
+and signature_item i ppf x =
+  line i ppf "signature_item %a\n" fmt_location x.sig_loc;
+  let i = i+1 in
+  match x.sig_desc with
+  | Tsig_value vd ->
+      line i ppf "Tsig_value\n";
+      value_description i ppf vd;
+  | Tsig_type (rf, l) ->
+      line i ppf "Tsig_type %a\n" fmt_rec_flag rf;
+      list i type_declaration ppf l;
+  | Tsig_typesubst l ->
+      line i ppf "Tsig_typesubst\n";
+      list i type_declaration ppf l;
+  | Tsig_typext e ->
+      line i ppf "Tsig_typext\n";
+      type_extension i ppf e;
+  | Tsig_exception ext ->
+      line i ppf "Tsig_exception\n";
+      type_exception i ppf ext
+  | Tsig_module md ->
+      line i ppf "Tsig_module \"%a\"\n" fmt_modname md.md_id;
+      attributes i ppf md.md_attributes;
+      module_type i ppf md.md_type
+  | Tsig_modsubst ms ->
+      line i ppf "Tsig_modsubst \"%a\" = %a\n"
+        fmt_ident ms.ms_id fmt_path ms.ms_manifest;
+      attributes i ppf ms.ms_attributes;
+  | Tsig_recmodule decls ->
+      line i ppf "Tsig_recmodule\n";
+      list i module_declaration ppf decls;
+  | Tsig_modtype x ->
+      line i ppf "Tsig_modtype \"%a\"\n" fmt_ident x.mtd_id;
+      attributes i ppf x.mtd_attributes;
+      modtype_declaration i ppf x.mtd_type
+  | Tsig_open od ->
+      line i ppf "Tsig_open %a %a\n"
+        fmt_override_flag od.open_override
+        fmt_path (fst od.open_expr);
+      attributes i ppf od.open_attributes
+  | Tsig_include incl ->
+      line i ppf "Tsig_include\n";
+      attributes i ppf incl.incl_attributes;
+      module_type i ppf incl.incl_mod
+  | Tsig_class (l) ->
+      line i ppf "Tsig_class\n";
+      list i class_description ppf l;
+  | Tsig_class_type (l) ->
+      line i ppf "Tsig_class_type\n";
+      list i class_type_declaration ppf l;
+  | Tsig_attribute a ->
+      attribute i ppf "Tsig_attribute" a
+
+and module_declaration i ppf md =
+  line i ppf "%a" fmt_modname md.md_id;
+  attributes i ppf md.md_attributes;
+  module_type (i+1) ppf md.md_type;
+
+and module_binding i ppf x =
+  line i ppf "%a\n" fmt_modname x.mb_id;
+  attributes i ppf x.mb_attributes;
+  module_expr (i+1) ppf x.mb_expr
+
+and modtype_declaration i ppf = function
+  | None -> line i ppf "#abstract"
+  | Some mt -> module_type (i + 1) ppf mt
+
+and with_constraint i ppf x =
+  match x with
+  | Twith_type (td) ->
+      line i ppf "Twith_type\n";
+      type_declaration (i+1) ppf td;
+  | Twith_typesubst (td) ->
+      line i ppf "Twith_typesubst\n";
+      type_declaration (i+1) ppf td;
+  | Twith_module (li,_) -> line i ppf "Twith_module %a\n" fmt_path li;
+  | Twith_modsubst (li,_) -> line i ppf "Twith_modsubst %a\n" fmt_path li;
+
+and module_expr i ppf x =
+  line i ppf "module_expr %a\n" fmt_location x.mod_loc;
+  attributes i ppf x.mod_attributes;
+  let i = i+1 in
+  match x.mod_desc with
+  | Tmod_ident (li,_) -> line i ppf "Tmod_ident %a\n" fmt_path li;
+  | Tmod_structure (s) ->
+      line i ppf "Tmod_structure\n";
+      structure i ppf s;
+  | Tmod_functor (Unit, me) ->
+      line i ppf "Tmod_functor ()\n";
+      module_expr i ppf me;
+  | Tmod_functor (Named (s, _, mt), me) ->
+      line i ppf "Tmod_functor \"%a\"\n" fmt_modname s;
+      module_type i ppf mt;
+      module_expr i ppf me;
+  | Tmod_apply (me1, me2, _) ->
+      line i ppf "Tmod_apply\n";
+      module_expr i ppf me1;
+      module_expr i ppf me2;
+  | Tmod_constraint (me, _, Tmodtype_explicit mt, _) ->
+      line i ppf "Tmod_constraint\n";
+      module_expr i ppf me;
+      module_type i ppf mt;
+  | Tmod_constraint (me, _, Tmodtype_implicit, _) -> module_expr i ppf me
+  | Tmod_unpack (e, _) ->
+      line i ppf "Tmod_unpack\n";
+      expression i ppf e;
+
+and structure i ppf x = list i structure_item ppf x.str_items
+
+and structure_item i ppf x =
+  line i ppf "structure_item %a\n" fmt_location x.str_loc;
+  let i = i+1 in
+  match x.str_desc with
+  | Tstr_eval (e, attrs) ->
+      line i ppf "Tstr_eval\n";
+      attributes i ppf attrs;
+      expression i ppf e;
+  | Tstr_value (rf, l) ->
+      line i ppf "Tstr_value %a\n" fmt_rec_flag rf;
+      list i value_binding ppf l;
+  | Tstr_primitive vd ->
+      line i ppf "Tstr_primitive\n";
+      value_description i ppf vd;
+  | Tstr_type (rf, l) ->
+      line i ppf "Tstr_type %a\n" fmt_rec_flag rf;
+      list i type_declaration ppf l;
+  | Tstr_typext te ->
+      line i ppf "Tstr_typext\n";
+      type_extension i ppf te
+  | Tstr_exception ext ->
+      line i ppf "Tstr_exception\n";
+      type_exception i ppf ext;
+  | Tstr_module x ->
+      line i ppf "Tstr_module\n";
+      module_binding i ppf x
+  | Tstr_recmodule bindings ->
+      line i ppf "Tstr_recmodule\n";
+      list i module_binding ppf bindings
+  | Tstr_modtype x ->
+      line i ppf "Tstr_modtype \"%a\"\n" fmt_ident x.mtd_id;
+      attributes i ppf x.mtd_attributes;
+      modtype_declaration i ppf x.mtd_type
+  | Tstr_open od ->
+      line i ppf "Tstr_open %a\n"
+        fmt_override_flag od.open_override;
+      module_expr i ppf od.open_expr;
+      attributes i ppf od.open_attributes
+  | Tstr_class (l) ->
+      line i ppf "Tstr_class\n";
+      list i class_declaration ppf (List.map (fun (cl, _) -> cl) l);
+  | Tstr_class_type (l) ->
+      line i ppf "Tstr_class_type\n";
+      list i class_type_declaration ppf (List.map (fun (_, _, cl) -> cl) l);
+  | Tstr_include incl ->
+      line i ppf "Tstr_include";
+      attributes i ppf incl.incl_attributes;
+      module_expr i ppf incl.incl_mod;
+  | Tstr_attribute a ->
+      attribute i ppf "Tstr_attribute" a
+
+and longident_x_with_constraint i ppf (li, _, wc) =
+  line i ppf "%a\n" fmt_path li;
+  with_constraint (i+1) ppf wc;
+
+and core_type_x_core_type_x_location i ppf (ct1, ct2, l) =
+  line i ppf " %a\n" fmt_location l;
+  core_type (i+1) ppf ct1;
+  core_type (i+1) ppf ct2;
+
+and constructor_decl i ppf {cd_id; cd_name = _; cd_args; cd_res; cd_loc;
+                            cd_attributes} =
+  line i ppf "%a\n" fmt_location cd_loc;
+  line (i+1) ppf "%a\n" fmt_ident cd_id;
+  attributes i ppf cd_attributes;
+  constructor_arguments (i+1) ppf cd_args;
+  option (i+1) core_type ppf cd_res
+
+and constructor_arguments i ppf = function
+  | Cstr_tuple l -> list i core_type ppf l
+  | Cstr_record l -> list i label_decl ppf l
+
+and label_decl i ppf {ld_id; ld_name = _; ld_mutable; ld_type; ld_loc;
+                      ld_attributes} =
+  line i ppf "%a\n" fmt_location ld_loc;
+  attributes i ppf ld_attributes;
+  line (i+1) ppf "%a\n" fmt_mutable_flag ld_mutable;
+  line (i+1) ppf "%a" fmt_ident ld_id;
+  core_type (i+1) ppf ld_type
+
+and longident_x_pattern i ppf (li, _, p) =
+  line i ppf "%a\n" fmt_longident li;
+  pattern (i+1) ppf p;
+
+and case
+    : type k . _ -> _ -> k case -> unit
+  = fun i ppf {c_lhs; c_guard; c_rhs} ->
+  line i ppf "\n";
+  pattern (i+1) ppf c_lhs;
+  begin match c_guard with
+  | None -> ()
+  | Some g -> line (i+1) ppf "\n"; expression (i + 2) ppf g
+  end;
+  expression (i+1) ppf c_rhs;
+
+and value_binding i ppf x =
+  line i ppf "\n";
+  attributes (i+1) ppf x.vb_attributes;
+  pattern (i+1) ppf x.vb_pat;
+  expression (i+1) ppf x.vb_expr
+
+and string_x_expression i ppf (s, _, e) =
+  line i ppf " \"%a\"\n" fmt_path s;
+  expression (i+1) ppf e;
+
+and record_field i ppf = function
+  | _, Overridden (li, e) ->
+      line i ppf "%a\n" fmt_longident li;
+      expression (i+1) ppf e;
+  | _, Kept _ ->
+      line i ppf ""
+
+and label_x_expression i ppf (l, e) =
+  line i ppf "\n";
+  arg_label (i+1) ppf l;
+  (match e with None -> () | Some e -> expression (i+1) ppf e)
+
+and ident_x_expression_def i ppf (l, e) =
+  line i ppf " \"%a\"\n" fmt_ident l;
+  expression (i+1) ppf e;
+
+and label_x_bool_x_core_type_list i ppf x =
+  match x.rf_desc with
+  | Ttag (l, b, ctl) ->
+      line i ppf "Ttag \"%s\" %s\n" l.txt (string_of_bool b);
+      attributes (i+1) ppf x.rf_attributes;
+      list (i+1) core_type ppf ctl
+  | Tinherit (ct) ->
+      line i ppf "Tinherit\n";
+      core_type (i+1) ppf ct
+;;
+
+let interface ppf x = list 0 signature_item ppf x.sig_items;;
+
+let implementation ppf x = list 0 structure_item ppf x.str_items;;
+
+let implementation_with_coercion ppf (x, _) = implementation ppf x
diff --git a/typing/printtyped.mli b/typing/printtyped.mli
new file mode 100644
index 00000000..ded42bb3
--- /dev/null
+++ b/typing/printtyped.mli
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*              Damien Doligez, projet Para, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1999 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Typedtree;;
+open Format;;
+
+val interface : formatter -> signature -> unit;;
+val implementation : formatter -> structure -> unit;;
+
+val implementation_with_coercion :
+    formatter -> (structure * module_coercion) -> unit;;
diff --git a/typing/rec_check.ml b/typing/rec_check.ml
new file mode 100644
index 00000000..1248484c
--- /dev/null
+++ b/typing/rec_check.ml
@@ -0,0 +1,1258 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*               Jeremy Yallop, University of Cambridge                   *)
+(*               Gabriel Scherer, Project Parsifal, INRIA Saclay          *)
+(*               Alban Reynaud, ENS Lyon                                  *)
+(*                                                                        *)
+(*   Copyright 2017 Jeremy Yallop                                         *)
+(*   Copyright 2018 Alban Reynaud                                         *)
+(*   Copyright 2018 INRIA                                                 *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Static checking of recursive declarations
+
+Some recursive definitions are meaningful
+{[
+  let rec factorial = function 0 -> 1 | n -> n * factorial (n - 1)
+  let rec infinite_list = 0 :: infinite_list
+]}
+but some other are meaningless
+{[
+  let rec x = x
+  let rec x = x+1
+|}
+
+Intuitively, a recursive definition makes sense when the body of the
+definition can be evaluated without fully knowing what the recursive
+name is yet.
+
+In the [factorial] example, the name [factorial] refers to a function,
+evaluating the function definition [function ...] can be done
+immediately and will not force a recursive call to [factorial] -- this
+will only happen later, when [factorial] is called with an argument.
+
+In the [infinite_list] example, we can evaluate [0 :: infinite_list]
+without knowing the full content of [infinite_list], but with just its
+address. This is a case of productive/guarded recursion.
+
+On the contrary, [let rec x = x] is unguarded recursion (the meaning
+is undetermined), and [let rec x = x+1] would need the value of [x]
+while evaluating its definition [x+1].
+
+This file implements a static check to decide which definitions are
+known to be meaningful, and which may be meaningless. In the general
+case, we handle a set of mutually-recursive definitions
+{[
+let rec x1 = e1
+and x2 = e2
+...
+and xn = en
+]}
+
+
+Our check (see function [is_valid_recursive_expression] is defined
+using two criteria:
+
+Usage of recursive variables: how does each of the [e1 .. en] use the
+ recursive variables [x1 .. xn]?
+
+Static or dynamic size: for which of the [ei] can we compute the
+  in-memory size of the value without evaluating [ei] (so that we can
+  pre-allocate it, and thus know its final address before evaluation).
+
+The "static or dynamic size" is decided by the classify_* functions below.
+
+The "variable usage" question is decided by a static analysis looking
+very much like a type system. The idea is to assign "access modes" to
+variables, where an "access mode" [m] is defined as either
+
+    m ::= Ignore (* the value is not used at all *)
+        | Delay (* the value is not needed at definition time *)
+        | Guard (* the value is stored under a data constructor *)
+        | Return (* the value result is directly returned *)
+        | Dereference (* full access and inspection of the value *)
+
+The access modes of an expression [e] are represented by a "context"
+[G], which is simply a mapping from variables (the variables used in
+[e]) to access modes.
+
+The core notion of the static check is a type-system-like judgment of
+the form [G |- e : m], which can be interpreted as meaning either of:
+
+- If we are allowed to use the variables of [e] at the modes in [G]
+  (but not more), then it is safe to use [e] at the mode [m].
+
+- If we want to use [e] at the mode [m], then its variables are
+  used at the modes in [G].
+
+In practice, for a given expression [e], our implementation takes the
+desired mode of use [m] as *input*, and returns a context [G] as
+*output*, which is (uniquely determined as) the most permissive choice
+of modes [G] for the variables of [e] such that [G |- e : m] holds.
+*)
+
+open Asttypes
+open Typedtree
+open Types
+
+exception Illegal_expr
+
+(** {1 Static or dynamic size} *)
+
+type sd = Static | Dynamic
+
+let is_ref : Types.value_description -> bool = function
+  | { Types.val_kind =
+        Types.Val_prim { Primitive.prim_name = "%makemutable";
+                          prim_arity = 1 } } ->
+        true
+  | _ -> false
+
+(* See the note on abstracted arguments in the documentation for
+    Typedtree.Texp_apply *)
+let is_abstracted_arg : arg_label * expression option -> bool = function
+  | (_, None) -> true
+  | (_, Some _) -> false
+
+let classify_expression : Typedtree.expression -> sd =
+  (* We need to keep track of the size of expressions
+      bound by local declarations, to be able to predict
+      the size of variables. Compare:
+
+        let rec r =
+          let y = fun () -> r ()
+          in y
+
+      and
+
+        let rec r =
+          let y = if Random.bool () then ignore else fun () -> r ()
+          in y
+
+    In both cases the final address of `r` must be known before `y` is compiled,
+    and this is only possible if `r` has a statically-known size.
+
+    The first definition can be allowed (`y` has a statically-known
+    size) but the second one is unsound (`y` has no statically-known size).
+  *)
+  let rec classify_expression env e = match e.exp_desc with
+    (* binding and variable cases *)
+    | Texp_let (rec_flag, vb, e) ->
+        let env = classify_value_bindings rec_flag env vb in
+        classify_expression env e
+    | Texp_ident (path, _, _) ->
+        classify_path env path
+
+    (* non-binding cases *)
+    | Texp_open (_, e)
+    | Texp_letmodule (_, _, _, _, e)
+    | Texp_sequence (_, e)
+    | Texp_letexception (_, e) ->
+        classify_expression env e
+
+    | Texp_construct (_, {cstr_tag = Cstr_unboxed}, [e]) ->
+        classify_expression env e
+    | Texp_construct _ ->
+        Static
+
+    | Texp_record { representation = Record_unboxed _;
+                    fields = [| _, Overridden (_,e) |] } ->
+        classify_expression env e
+    | Texp_record _ ->
+        Static
+
+    | Texp_apply ({exp_desc = Texp_ident (_, _, vd)}, _)
+      when is_ref vd ->
+        Static
+    | Texp_apply (_,args)
+      when List.exists is_abstracted_arg args ->
+        Static
+    | Texp_apply _ ->
+        Dynamic
+
+    | Texp_for _
+    | Texp_constant _
+    | Texp_new _
+    | Texp_instvar _
+    | Texp_tuple _
+    | Texp_array _
+    | Texp_variant _
+    | Texp_setfield _
+    | Texp_while _
+    | Texp_setinstvar _
+    | Texp_pack _
+    | Texp_object _
+    | Texp_function _
+    | Texp_lazy _
+    | Texp_unreachable
+    | Texp_extension_constructor _ ->
+        Static
+
+    | Texp_match _
+    | Texp_ifthenelse _
+    | Texp_send _
+    | Texp_field _
+    | Texp_assert _
+    | Texp_try _
+    | Texp_override _
+    | Texp_letop _ ->
+        Dynamic
+  and classify_value_bindings rec_flag env bindings =
+    (* We use a non-recursive classification, classifying each
+        binding with respect to the old environment
+        (before all definitions), even if the bindings are recursive.
+
+        Note: computing a fixpoint in some way would be more
+        precise, as the following could be allowed:
+
+          let rec topdef =
+            let rec x = y and y = fun () -> topdef ()
+            in x
+    *)
+    ignore rec_flag;
+    let old_env = env in
+    let add_value_binding env vb =
+      match vb.vb_pat.pat_desc with
+      | Tpat_var (id, _loc) ->
+          let size = classify_expression old_env vb.vb_expr in
+          Ident.add id size env
+      | _ ->
+          (* Note: we don't try to compute any size for complex patterns *)
+          env
+    in
+    List.fold_left add_value_binding env bindings
+  and classify_path env = function
+    | Path.Pident x ->
+        begin
+          try Ident.find_same x env
+          with Not_found ->
+            (* an identifier will be missing from the map if either:
+                - it is a non-local identifier
+                  (bound outside the letrec-binding we are analyzing)
+                - or it is bound by a complex (let p = e in ...) local binding
+                - or it is bound within a module (let module M = ... in ...)
+                  that we are not traversing for size computation
+
+                For non-local identifiers it might be reasonable (although
+                not completely clear) to consider them Static (they have
+                already been evaluated), but for the others we must
+                under-approximate with Dynamic.
+
+                This could be fixed by a more complete implementation.
+            *)
+            Dynamic
+        end
+    | Path.Pdot _ | Path.Papply _ ->
+        (* local modules could have such paths to local definitions;
+            classify_expression could be extend to compute module
+            shapes more precisely *)
+        Dynamic
+  in classify_expression Ident.empty
+
+
+(** {1 Usage of recursive variables} *)
+
+module Mode = struct
+  (** For an expression in a program, its "usage mode" represents
+      static information about how the value produced by the expression
+      will be used by the context around it. *)
+  type t =
+    | Ignore
+    (** [Ignore] is for subexpressions that are not used at all during
+       the evaluation of the whole program. This is the mode of
+       a variable in an expression in which it does not occur. *)
+
+    | Delay
+    (** A [Delay] context can be fully evaluated without evaluating its argument
+        , which will only be needed at a later point of program execution. For
+        example, [fun x -> ?] or [lazy ?] are [Delay] contexts. *)
+
+    | Guard
+    (** A [Guard] context returns the value as a member of a data structure,
+        for example a variant constructor or record. The value can safely be
+        defined mutually-recursively with their context, for example in
+        [let rec li = 1 :: li].
+        When these subexpressions participate in a cyclic definition,
+        this definition is productive/guarded.
+
+        The [Guard] mode is also used when a value is not dereferenced,
+        it is returned by a sub-expression, but the result of this
+        sub-expression is discarded instead of being returned.
+        For example, the subterm [?] is in a [Guard] context
+        in [let _ = ? in e] and in [?; e].
+        When these subexpressions participate in a cyclic definition,
+        they cannot create a self-loop.
+    *)
+
+    | Return
+    (** A [Return] context returns its value without further inspection.
+        This value cannot be defined mutually-recursively with its context,
+        as there is a risk of self-loop: in [let rec x = y and y = x], the
+        two definitions use a single variable in [Return] context. *)
+
+    | Dereference
+    (** A [Dereference] context consumes, inspects and uses the value
+        in arbitrary ways. Such a value must be fully defined at the point
+        of usage, it cannot be defined mutually-recursively with its context. *)
+
+  let equal = ((=) : t -> t -> bool)
+
+  (* Lower-ranked modes demand/use less of the variable/expression they qualify
+     -- so they allow more recursive definitions.
+
+     Ignore < Delay < Guard < Return < Dereference
+  *)
+  let rank = function
+    | Ignore -> 0
+    | Delay -> 1
+    | Guard -> 2
+    | Return -> 3
+    | Dereference -> 4
+
+  (* Returns the more conservative (highest-ranking) mode of the two
+     arguments.
+
+     In judgments we write (m + m') for (join m m').
+  *)
+  let join m m' =
+    if rank m >= rank m' then m else m'
+
+  (* If x is used with the mode m in e[x], and e[x] is used with mode
+     m' in e'[e[x]], then x is used with mode m'[m] (our notation for
+     "compose m' m") in e'[e[x]].
+
+     Return is neutral for composition: m[Return] = m = Return[m].
+
+     Composition is associative and [Ignore] is a zero/annihilator for
+     it: (compose Ignore m) and (compose m Ignore) are both Ignore. *)
+  let compose m' m = match m', m with
+    | Ignore, _ | _, Ignore -> Ignore
+    | Dereference, _ -> Dereference
+    | Delay, _ -> Delay
+    | Guard, Return -> Guard
+    | Guard, ((Dereference | Guard | Delay) as m) -> m
+    | Return, Return -> Return
+    | Return, ((Dereference | Guard | Delay) as m) -> m
+end
+
+type mode = Mode.t = Ignore | Delay | Guard | Return | Dereference
+
+module Env :
+sig
+  type t
+
+  val single : Ident.t -> Mode.t -> t
+  (** Create an environment with a single identifier used with a given mode.
+  *)
+
+  val empty : t
+  (** An environment with no used identifiers. *)
+
+  val find : Ident.t -> t -> Mode.t
+  (** Find the mode of an identifier in an environment.  The default mode is
+      Ignore. *)
+
+  val unguarded : t -> Ident.t list -> Ident.t list
+  (** unguarded e l: the list of all identifiers in l that are dereferenced or
+      returned in the environment e. *)
+
+  val dependent : t -> Ident.t list -> Ident.t list
+  (** dependent e l: the list of all identifiers in l that are used in e
+      (not ignored). *)
+
+  val join : t -> t -> t
+  val join_list : t list -> t
+  (** Environments can be joined pointwise (variable per variable) *)
+
+  val compose : Mode.t -> t -> t
+  (** Environment composition m[G] extends mode composition m1[m2]
+      by composing each mode in G pointwise *)
+
+  val remove : Ident.t -> t -> t
+  (** Remove an identifier from an environment. *)
+
+  val take: Ident.t -> t -> Mode.t * t
+  (** Remove an identifier from an environment, and return its mode *)
+
+  val remove_list : Ident.t list -> t -> t
+  (** Remove all the identifiers of a list from an environment. *)
+
+  val equal : t -> t -> bool
+end = struct
+  module M = Map.Make(Ident)
+
+  (** A "t" maps each rec-bound variable to an access status *)
+  type t = Mode.t M.t
+
+  let equal = M.equal Mode.equal
+
+  let find (id: Ident.t) (tbl: t) =
+    try M.find id tbl with Not_found -> Ignore
+
+  let empty = M.empty
+
+  let join (x: t) (y: t) =
+    M.fold
+      (fun (id: Ident.t) (v: Mode.t) (tbl: t) ->
+         let v' = find id tbl in
+         M.add id (Mode.join v v') tbl)
+      x y
+
+  let join_list li = List.fold_left join empty li
+
+  let compose m env =
+    M.map (Mode.compose m) env
+
+  let single id mode = M.add id mode empty
+
+  let unguarded env li =
+    List.filter (fun id -> Mode.rank (find id env) > Mode.rank Guard) li
+
+  let dependent env li =
+    List.filter (fun id -> Mode.rank (find id env) > Mode.rank Ignore) li
+
+  let remove = M.remove
+
+  let take id env = (find id env, remove id env)
+
+  let remove_list l env =
+    List.fold_left (fun env id -> M.remove id env) env l
+end
+
+let remove_pat pat env =
+  Env.remove_list (pat_bound_idents pat) env
+
+let remove_patlist pats env =
+  List.fold_right remove_pat pats env
+
+(* Usage mode judgments.
+
+   There are two main groups of judgment functions:
+
+   - Judgments of the form "G |- ... : m"
+     compute the environment G of a subterm ... from its mode m, so
+     the corresponding function has type [... -> Mode.t -> Env.t].
+
+     We write [... -> term_judg] in this case.
+
+   - Judgments of the form "G |- ... : m -| G'"
+
+     correspond to binding constructs (for example "let x = e" in the
+     term "let x = e in body") that have both an exterior environment
+     G (the environment of the whole term "let x = e in body") and an
+     interior environment G' (the environment at the "in", after the
+     binding construct has introduced new names in scope).
+
+     For example, let-binding could be given the following rule:
+
+       G |- e : m + m'
+       -----------------------------------
+       G+G' |- (let x = e) : m -| x:m', G'
+
+     Checking the whole term composes this judgment
+     with the "G |- e : m" form for the let body:
+
+       G  |- (let x = e) : m -| G'
+       G' |- body : m
+       -------------------------------
+       G |- let x = e in body : m
+
+     To this judgment "G |- e : m -| G'" our implementation gives the
+     type [... -> Mode.t -> Env.t -> Env.t]: it takes the mode and
+     interior environment as inputs, and returns the exterior
+     environment.
+
+     We write [... -> bind_judg] in this case.
+*)
+type term_judg = Mode.t -> Env.t
+type bind_judg = Mode.t -> Env.t -> Env.t
+
+let option : 'a. ('a -> term_judg) -> 'a option -> term_judg =
+  fun f o m -> match o with
+    | None -> Env.empty
+    | Some v -> f v m
+let list : 'a. ('a -> term_judg) -> 'a list -> term_judg =
+  fun f li m ->
+    List.fold_left (fun env item -> Env.join env (f item m)) Env.empty li
+let array : 'a. ('a -> term_judg) -> 'a array -> term_judg =
+  fun f ar m ->
+    Array.fold_left (fun env item -> Env.join env (f item m)) Env.empty ar
+
+let single : Ident.t -> term_judg = Env.single
+let remove_id : Ident.t -> term_judg -> term_judg =
+  fun id f m -> Env.remove id (f m)
+let remove_ids : Ident.t list -> term_judg -> term_judg =
+  fun ids f m -> Env.remove_list ids (f m)
+
+let join : term_judg list -> term_judg =
+  fun li m -> Env.join_list (List.map (fun f -> f m) li)
+
+let empty = fun _ -> Env.empty
+
+(* A judgment [judg] takes a mode from the context as input, and
+   returns an environment. The judgment [judg << m], given a mode [m']
+   from the context, evaluates [judg] in the composed mode [m'[m]]. *)
+let (<<) : term_judg -> Mode.t -> term_judg =
+  fun f inner_mode -> fun outer_mode -> f (Mode.compose outer_mode inner_mode)
+
+(* A binding judgment [binder] expects a mode and an inner environment,
+   and returns an outer environment. [binder >> judg] computes
+   the inner environment as the environment returned by [judg]
+   in the ambient mode. *)
+let (>>) : bind_judg -> term_judg -> term_judg =
+  fun binder term mode -> binder mode (term mode)
+
+(* Expression judgment:
+     G |- e : m
+   where (m) is an input of the code and (G) is an output;
+   in the Prolog mode notation, this is (+G |- -e : -m).
+*)
+let rec expression : Typedtree.expression -> term_judg =
+  fun exp -> match exp.exp_desc with
+    | Texp_ident (pth, _, _) ->
+      path pth
+    | Texp_let (rec_flag, bindings, body) ->
+      (*
+         G  |-  : m -| G'
+         G' |- body : m
+         -------------------------------
+         G |- let  in body : m
+      *)
+      value_bindings rec_flag bindings >> expression body
+    | Texp_letmodule (x, _, _, mexp, e) ->
+      module_binding (x, mexp) >> expression e
+    | Texp_match (e, cases, _) ->
+      (*
+         (Gi; mi |- pi -> ei : m)^i
+         G |- e : sum(mi)^i
+         ----------------------------------------------
+         G + sum(Gi)^i |- match e with (pi -> ei)^i : m
+       *)
+      (fun mode ->
+        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))
+    | Texp_for (_, _, low, high, _, body) ->
+      (*
+        G1 |- low: m[Dereference]
+        G2 |- high: m[Dereference]
+        G3 |- body: m[Guard]
+        ---
+        G1 + G2 + G3 |- for _ = low to high do body done: m
+      *)
+      join [
+        expression low << Dereference;
+        expression high << Dereference;
+        expression body << Guard;
+      ]
+    | Texp_constant _ ->
+      empty
+    | Texp_new (pth, _, _) ->
+      (*
+        G |- c: m[Dereference]
+        -----------------------
+        G |- new c: m
+      *)
+      path pth << Dereference
+    | Texp_instvar (self_path, pth, _inst_var) ->
+        join [path self_path << Dereference; path pth]
+    | Texp_apply ({exp_desc = Texp_ident (_, _, vd)}, [_, Some arg])
+      when is_ref vd ->
+      (*
+        G |- e: m[Guard]
+        ------------------
+        G |- ref e: m
+      *)
+      expression arg << Guard
+    | Texp_apply (e, args)  ->
+        let arg (_, eo) = option expression eo in
+        let app_mode = if List.exists is_abstracted_arg args
+          then (* see the comment on Texp_apply in typedtree.mli;
+                  the non-abstracted arguments are bound to local
+                  variables, which corresponds to a Guard mode. *)
+            Guard
+          else Dereference
+        in
+        join [expression e; list arg args] << app_mode
+    | Texp_tuple exprs ->
+      list expression exprs << Guard
+    | Texp_array exprs ->
+      let array_mode = match Typeopt.array_kind exp with
+        | Lambda.Pfloatarray ->
+            (* (flat) float arrays unbox their elements *)
+            Dereference
+        | Lambda.Pgenarray ->
+            (* This is counted as a use, because constructing a generic array
+               involves inspecting to decide whether to unbox (PR#6939). *)
+            Dereference
+        | Lambda.Paddrarray | Lambda.Pintarray ->
+            (* non-generic, non-float arrays act as constructors *)
+            Guard
+      in
+      list expression exprs << array_mode
+    | Texp_construct (_, desc, exprs) ->
+      let access_constructor =
+        match desc.cstr_tag with
+        | Cstr_extension (pth, _) ->
+          path pth << Dereference
+        | _ -> empty
+      in
+      let m' = match desc.cstr_tag with
+        | Cstr_unboxed ->
+          Return
+        | Cstr_constant _ | Cstr_block _ | Cstr_extension _ ->
+          Guard
+      in
+      join [
+        access_constructor;
+        list expression exprs << m'
+      ]
+    | Texp_variant (_, eo) ->
+      (*
+        G |- e: m[Guard]
+        ------------------   -----------
+        G |- `A e: m         [] |- `A: m
+      *)
+      option expression eo << Guard
+    | Texp_record { fields = es; extended_expression = eo;
+                    representation = rep } ->
+        let field_mode = match rep with
+          | Record_float -> Dereference
+          | Record_unboxed _ -> Return
+          | Record_regular | Record_inlined _
+          | Record_extension _ -> Guard
+        in
+        let field (_label, field_def) = match field_def with
+            Kept _ -> empty
+          | Overridden (_, e) -> expression e
+        in
+        join [
+          array field es << field_mode;
+          option expression eo << Dereference
+        ]
+    | Texp_ifthenelse (cond, ifso, ifnot) ->
+      (*
+        Gc |- c: m[Dereference]
+        G1 |- e1: m
+        G2 |- e2: m
+        ---
+        Gc + G1 + G2 |- if c then e1 else e2: m
+
+      Note: `if c then e1 else e2` is treated in the same way as
+      `match c with true -> e1 | false -> e2`
+      *)
+      join [
+        expression cond << Dereference;
+        expression ifso;
+        option expression ifnot;
+      ]
+    | Texp_setfield (e1, _, _, e2) ->
+      (*
+        G1 |- e1: m[Dereference]
+        G2 |- e2: m[Dereference]
+        ---
+        G1 + G2 |- e1.x <- e2: m
+
+        Note: e2 is dereferenced in the case of a field assignment to
+        a record of unboxed floats in that case, e2 evaluates to
+        a boxed float and it is unboxed on assignment.
+      *)
+      join [
+        expression e1 << Dereference;
+        expression e2 << Dereference;
+      ]
+    | Texp_sequence (e1, e2) ->
+      (*
+        G1 |- e1: m[Guard]
+        G2 |- e2: m
+        --------------------
+        G1 + G2 |- e1; e2: m
+
+        Note: `e1; e2` is treated in the same way as `let _ = e1 in e2`
+      *)
+      join [
+        expression e1 << Guard;
+        expression e2;
+      ]
+    | Texp_while (cond, body) ->
+      (*
+        G1 |- cond: m[Dereference]
+        G2 |- body: m[Guard]
+        ---------------------------------
+        G1 + G2 |- while cond do body done: m
+      *)
+      join [
+        expression cond << Dereference;
+        expression body << Guard;
+      ]
+    | Texp_send (e1, _, eo) ->
+      (*
+        G |- e: m[Dereference]
+        ---------------------- (plus weird 'eo' option)
+        G |- e#x: m
+      *)
+      join [
+        expression e1 << Dereference;
+        option expression eo << Dereference;
+      ]
+    | Texp_field (e, _, _) ->
+      (*
+        G |- e: m[Dereference]
+        -----------------------
+        G |- e.x: m
+      *)
+      expression e << Dereference
+    | Texp_setinstvar (pth,_,_,e) ->
+      (*
+        G |- e: m[Dereference]
+        ----------------------
+        G |- x <- e: m
+      *)
+      join [
+        path pth << Dereference;
+        expression e << Dereference;
+      ]
+    | Texp_letexception ({ext_id}, e) ->
+      (* G |- e: m
+         ----------------------------
+         G |- let exception A in e: m
+      *)
+      remove_id ext_id (expression e)
+    | Texp_assert e ->
+      (*
+        G |- e: m[Dereference]
+        -----------------------
+        G |- assert e: m
+
+        Note: `assert e` is treated just as if `assert` was a function.
+      *)
+      expression e << Dereference
+    | Texp_pack mexp ->
+      (*
+        G |- M: m
+        ----------------
+        G |- module M: m
+      *)
+      modexp mexp
+    | Texp_object (clsstrct, _) ->
+      class_structure clsstrct
+    | Texp_try (e, cases) ->
+      (*
+        G |- e: m      (Gi; _ |- pi -> ei : m)^i
+        --------------------------------------------
+        G + sum(Gi)^i |- try e with (pi -> ei)^i : m
+
+        Contrarily to match, the patterns p do not inspect
+        the value of e, so their mode does not influence the
+        mode of e.
+      *)
+      let case_env c m = fst (case c m) in
+      join [
+        expression e;
+        list case_env cases;
+      ]
+    | Texp_override (pth, fields) ->
+      (*
+         G |- pth : m   (Gi |- ei : m[Dereference])^i
+         ----------------------------------------------------
+         G + sum(Gi)^i |- {< (xi = ei)^i >} (at path pth) : m
+
+         Note: {< .. >} is desugared to a function application, but
+         the function implementation might still use its arguments in
+         a guarded way only -- intuitively it should behave as a constructor.
+         We could possibly refine the arguments' Dereference into Guard here.
+      *)
+      let field (_, _, arg) = expression arg in
+      join [
+        path pth << Dereference;
+        list field fields << Dereference;
+      ]
+    | Texp_function { cases } ->
+      (*
+         (Gi; _ |- pi -> ei : m[Delay])^i
+         --------------------------------------
+         sum(Gi)^i |- function (pi -> ei)^i : m
+
+         Contrarily to match, the value that is pattern-matched
+         is bound locally, so the pattern modes do not influence
+         the final environment.
+      *)
+      let case_env c m = fst (case c m) in
+      list case_env cases << Delay
+    | Texp_lazy e ->
+      (*
+        G |- e: m[Delay]
+        ----------------  (modulo some subtle compiler optimizations)
+        G |- lazy e: m
+      *)
+      let lazy_mode = match Typeopt.classify_lazy_argument e with
+        | `Constant_or_function
+        | `Identifier _
+        | `Float_that_cannot_be_shortcut ->
+          Return
+        | `Other ->
+          Delay
+      in
+      expression e << lazy_mode
+    | Texp_letop{let_; ands; body; _} ->
+        let case_env c m = fst (case c m) in
+        join [
+          list binding_op (let_ :: ands) << Dereference;
+          case_env body << Delay
+        ]
+    | Texp_unreachable ->
+      (*
+        ----------
+        [] |- .: m
+      *)
+      empty
+    | Texp_extension_constructor (_lid, pth) ->
+      path pth << Dereference
+    | Texp_open (od, e) ->
+      open_declaration od >> expression e
+
+and binding_op : Typedtree.binding_op -> term_judg =
+  fun bop ->
+    join [path bop.bop_op_path; expression bop.bop_exp]
+
+and class_structure : Typedtree.class_structure -> term_judg =
+  fun cs -> list class_field cs.cstr_fields
+
+and class_field : Typedtree.class_field -> term_judg =
+  fun cf -> match cf.cf_desc with
+    | Tcf_inherit (_, ce, _super, _inh_vars, _inh_meths) ->
+      class_expr ce << Dereference
+    | Tcf_val (_lab, _mut, _, cfk, _) ->
+      class_field_kind cfk
+    | Tcf_method (_, _, cfk) ->
+      class_field_kind cfk
+    | Tcf_constraint _ ->
+      empty
+    | Tcf_initializer e ->
+      expression e << Dereference
+    | Tcf_attribute _ ->
+      empty
+
+and class_field_kind : Typedtree.class_field_kind -> term_judg =
+  fun cfk -> match cfk with
+    | Tcfk_virtual _ ->
+      empty
+    | Tcfk_concrete (_, e) ->
+      expression e << Dereference
+
+and modexp : Typedtree.module_expr -> term_judg =
+  fun mexp -> match mexp.mod_desc with
+    | Tmod_ident (pth, _) ->
+      path pth
+    | Tmod_structure s ->
+      structure s
+    | Tmod_functor (_, e) ->
+      modexp e << Delay
+    | Tmod_apply (f, p, _) ->
+      join [
+        modexp f << Dereference;
+        modexp p << Dereference;
+      ]
+    | Tmod_constraint (mexp, _, _, coe) ->
+      let rec coercion coe k = match coe with
+        | Tcoerce_none ->
+          k Return
+        | Tcoerce_structure _
+        | Tcoerce_functor _ ->
+          (* These coercions perform a shallow copy of the input module,
+             by creating a new module with fields obtained by accessing
+             the same fields in the input module. *)
+           k Dereference
+        | Tcoerce_primitive _ ->
+          (* This corresponds to 'external' declarations,
+             and the coercion ignores its argument *)
+          k Ignore
+        | Tcoerce_alias (_, pth, coe) ->
+          (* Alias coercions ignore their arguments, but they evaluate
+             their alias module 'pth' under another coercion. *)
+          coercion coe (fun m -> path pth << m)
+      in
+      coercion coe (fun m -> modexp mexp << m)
+    | Tmod_unpack (e, _) ->
+      expression e
+
+
+(* G |- pth : m *)
+and path : Path.t -> term_judg =
+  (*
+    ------------
+    x: m |- x: m
+
+    G |- A: m[Dereference]
+    -----------------------
+    G |- A.x: m
+
+    G1 |- A: m[Dereference]
+    G2 |- B: m[Dereference]
+    ------------------------ (as for term application)
+    G1 + G2 |- A(B): m
+  *)
+  fun pth -> match pth with
+    | Path.Pident x ->
+        single x
+    | Path.Pdot (t, _) ->
+        path t << Dereference
+    | Path.Papply (f, p) ->
+        join [
+          path f << Dereference;
+          path p << Dereference;
+        ]
+
+(* G |- struct ... end : m *)
+and structure : Typedtree.structure -> term_judg =
+  (*
+    G1, {x: _, x in vars(G1)} |- item1: G2 + ... + Gn in m
+    G2, {x: _, x in vars(G2)} |- item2: G3 + ... + Gn in m
+    ...
+    Gn, {x: _, x in vars(Gn)} |- itemn: [] in m
+    ---
+    (G1 + ... + Gn) - V |- struct item1 ... itemn end: m
+  *)
+  fun s m ->
+    List.fold_right (fun it env -> structure_item it m env)
+      s.str_items Env.empty
+
+(* G |-  : m -| G'
+   where G is an output and m, G' are inputs *)
+and structure_item : Typedtree.structure_item -> bind_judg =
+  fun s m env -> match s.str_desc with
+    | Tstr_eval (e, _) ->
+      (*
+        Ge |- e: m[Guard]
+        G |- items: m -| G'
+        ---------------------------------
+        Ge + G |- (e;; items): m -| G'
+
+        The expression `e` is treated in the same way as let _ = e
+      *)
+      let judg_e = expression e << Guard in
+      Env.join (judg_e m) env
+    | Tstr_value (rec_flag, bindings) ->
+      value_bindings rec_flag bindings m env
+    | Tstr_module {mb_id; mb_expr} ->
+      module_binding (mb_id, mb_expr) m env
+    | Tstr_recmodule mbs ->
+      let bindings = List.map (fun {mb_id; mb_expr} -> (mb_id, mb_expr)) mbs in
+      recursive_module_bindings bindings m env
+    | Tstr_primitive _ ->
+      env
+    | Tstr_type _ ->
+      (*
+        -------------------
+        G |- type t: m -| G
+      *)
+      env
+    | Tstr_typext {tyext_constructors = exts; _} ->
+      let ext_ids = List.map (fun {ext_id = id; _} -> id) exts in
+      Env.join
+        (list extension_constructor exts m)
+        (Env.remove_list ext_ids env)
+    | Tstr_exception {tyexn_constructor = ext; _} ->
+      Env.join
+        (extension_constructor ext m)
+        (Env.remove ext.ext_id env)
+    | Tstr_modtype _
+    | Tstr_class_type _
+    | Tstr_attribute _ ->
+      env
+    | Tstr_open od ->
+      open_declaration od m env
+    | Tstr_class classes ->
+        let class_ids =
+          let class_id ({ci_id_class = id; _}, _) = id in
+          List.map class_id classes in
+        let class_declaration ({ci_expr; _}, _) m =
+          Env.remove_list class_ids (class_expr ci_expr m) in
+        Env.join
+          (list class_declaration classes m)
+          (Env.remove_list class_ids env)
+    | Tstr_include { incl_mod = mexp; incl_type = mty; _ } ->
+      let included_ids = List.map Types.signature_item_id mty in
+      Env.join (modexp mexp m) (Env.remove_list included_ids env)
+
+(* G |- module M = E : m -| G *)
+and module_binding : (Ident.t option * Typedtree.module_expr) -> bind_judg =
+  fun (id, mexp) m env ->
+      (*
+        GE |- E: m[mM + Guard]
+        -------------------------------------
+        GE + G |- module M = E : m -| M:mM, G
+      *)
+      let judg_E, env =
+        match id with
+        | None -> modexp mexp << Guard, env
+        | Some id ->
+          let mM, env = Env.take id env in
+          let judg_E = modexp mexp << (Mode.join mM Guard) in
+          judg_E, env
+      in
+      Env.join (judg_E m) env
+
+and open_declaration : Typedtree.open_declaration -> bind_judg =
+  fun { open_expr = mexp; open_bound_items = sg; _ } m env ->
+      let judg_E = modexp mexp in
+      let bound_ids = List.map Types.signature_item_id sg in
+      Env.join (judg_E m) (Env.remove_list bound_ids env)
+
+and recursive_module_bindings
+  : (Ident.t option * Typedtree.module_expr) list -> bind_judg =
+  fun m_bindings m env ->
+    let mids = List.filter_map fst m_bindings in
+    let binding (mid, mexp) m =
+      let judg_E =
+        match mid with
+        | None -> modexp mexp << Guard
+        | Some mid ->
+          let mM = Env.find mid env in
+          modexp mexp << (Mode.join mM Guard)
+      in
+      Env.remove_list mids (judg_E m)
+    in
+    Env.join (list binding m_bindings m) (Env.remove_list mids env)
+
+and class_expr : Typedtree.class_expr -> term_judg =
+  fun ce -> match ce.cl_desc with
+    | Tcl_ident (pth, _, _) ->
+        path pth << Dereference
+    | Tcl_structure cs ->
+        class_structure cs
+    | Tcl_fun (_, _, args, ce, _) ->
+        let ids = List.map fst args in
+        remove_ids ids (class_expr ce << Delay)
+    | Tcl_apply (ce, args) ->
+        let arg (_label, eo) = option expression eo in
+        join [
+          class_expr ce << Dereference;
+          list arg args << Dereference;
+        ]
+    | Tcl_let (rec_flag, bindings, _, ce) ->
+      value_bindings rec_flag bindings >> class_expr ce
+    | Tcl_constraint (ce, _, _, _, _) ->
+        class_expr ce
+    | Tcl_open (_, ce) ->
+        class_expr ce
+
+and extension_constructor : Typedtree.extension_constructor -> term_judg =
+  fun ec -> match ec.ext_kind with
+    | Text_decl _ ->
+      empty
+    | Text_rebind (pth, _lid) ->
+      path pth
+
+(* G |- let (rec?) (pi = ei)^i : m -| G' *)
+and value_bindings : rec_flag -> Typedtree.value_binding list -> bind_judg =
+  fun rec_flag bindings mode bound_env ->
+    let all_bound_pats = List.map (fun vb -> vb.vb_pat) bindings in
+    let outer_env = remove_patlist all_bound_pats bound_env in
+    let bindings_env =
+      match rec_flag with
+      | Nonrecursive ->
+        (*
+           (Gi, pi:_ |- ei : m[mbody_i])^i   (pi : mbody_i -| D)^i
+           ------------------------------------------------------------
+           Sum(Gi) + (D - (pi)^i) |- let (pi=ei)^i : m -| D
+        *)
+          let binding_env {vb_pat; vb_expr; _} m =
+            let m' = Mode.compose m (pattern vb_pat bound_env) in
+            remove_pat vb_pat (expression vb_expr m') in
+          list binding_env bindings mode
+      | Recursive ->
+        (*
+           (Gi, (xj : mdef_ij)^j |- ei : m[mbody_i])^i   (xi : mbody_i -| D)^i
+           G'i = Gi + mdef_ij[G'j]
+           -------------------------------------------------------------------
+           Sum(G'i) + (D - (pi)^i) |- let rec (xi=ei)^i : m -| D
+
+           The (mdef_ij)^i,j are a family of modes over two indices:
+           mdef_ij represents the mode of use, within e_i the definition of x_i,
+           of the mutually-recursive variable x_j.
+
+           The (G'i)^i are defined from the (Gi)^i as a family of equations,
+           whose smallest solution is computed as a least fixpoint.
+
+           The (Gi)^i are the "immediate" dependencies of each (ei)^i
+           on the outer context (excluding the mutually-defined
+           variables).
+           The (G'i)^i contain the "transitive" dependencies as well:
+           if ei depends on xj, then the dependencies of G'i of xi
+           must contain the dependencies of G'j, composed by
+           the mode mdef_ij of use of xj in ei.
+
+           For example, consider:
+
+             let rec z =
+               let rec x = ref y
+               and y = ref z
+               in f x
+
+           this definition should be rejected as the body [f x]
+           dereferences [x], which can be used to access the
+           yet-unitialized value [z]. This requires realizing that [x]
+           depends on [z] through [y], which requires the transitive
+           closure computation.
+
+           An earlier version of our check would take only the (Gi)^i
+           instead of the (G'i)^i, which is incorrect and would accept
+           the example above.
+        *)
+          (* [binding_env] takes a binding (x_i = e_i)
+             and computes (Gi, (mdef_ij)^j). *)
+          let binding_env {vb_pat = x_i; vb_expr = e_i; _} =
+            let mbody_i = pattern x_i bound_env in
+            (* Gi, (x_j:mdef_ij)^j  *)
+            let rhs_env_i = expression e_i (Mode.compose mode mbody_i) in
+            (* (mdef_ij)^j (for a fixed i) *)
+            let mutual_modes =
+              let mdef_ij {vb_pat = x_j; _} = pattern x_j rhs_env_i in
+              List.map mdef_ij bindings in
+            (* Gi *)
+            let env_i = remove_patlist all_bound_pats rhs_env_i in
+            (* (Gi, (mdef_ij)^j) *)
+            (env_i, mutual_modes) in
+          let env, mdef =
+            List.split (List.map binding_env bindings) in
+          let rec transitive_closure env =
+            let transitive_deps env_i mdef_i =
+              (* Gi, (mdef_ij)^j => Gi + Sum_j mdef_ij[Gj] *)
+              Env.join env_i
+                (Env.join_list (List.map2 Env.compose mdef_i env)) in
+            let env' = List.map2 transitive_deps env mdef in
+            if List.for_all2 Env.equal env env'
+            then env'
+            else transitive_closure env'
+          in
+          let env'_i = transitive_closure env in
+          Env.join_list env'_i
+    in Env.join bindings_env outer_env
+
+(* G; m' |- (p -> e) : m
+   with outputs G, m' and input m
+
+   m' is the mode under which the scrutinee of p
+   (the value matched against p) is placed.
+*)
+and case
+    : 'k . 'k Typedtree.case -> mode -> Env.t * mode
+  = fun { Typedtree.c_lhs; c_guard; c_rhs } ->
+    (*
+       Ge |- e : m    Gg |- g : m[Dereference]
+       G := Ge+Gg     p : mp -| G
+       ----------------------------------------
+       G - p; m[mp] |- (p (when g)? -> e) : m
+    *)
+    let judg = join [
+        option expression c_guard << Dereference;
+        expression c_rhs;
+      ] in
+    (fun m ->
+       let env = judg m in
+       (remove_pat c_lhs env), Mode.compose m (pattern c_lhs env))
+
+(* p : m -| G
+   with output m and input G
+
+   m is the mode under which the scrutinee of p is placed.
+*)
+and pattern : type k . k general_pattern -> Env.t -> mode = fun pat env ->
+  (*
+    mp := | Dereference if p is destructuring
+          | Guard       otherwise
+    me := sum{G(x), x in vars(p)}
+    --------------------------------------------
+    p : (mp + me) -| G
+  *)
+  let m_pat = if is_destructuring_pattern pat
+              then Dereference
+              else Guard
+  in
+  let m_env =
+    pat_bound_idents pat
+    |> List.map (fun id -> Env.find id env)
+    |> List.fold_left Mode.join Ignore
+  in
+  Mode.join m_pat m_env
+
+and is_destructuring_pattern : type k . k general_pattern -> bool =
+  fun pat -> match pat.pat_desc with
+    | Tpat_any -> false
+    | Tpat_var (_, _) -> false
+    | Tpat_alias (pat, _, _) -> is_destructuring_pattern pat
+    | Tpat_constant _ -> true
+    | Tpat_tuple _ -> true
+    | Tpat_construct (_, _, _) -> true
+    | Tpat_variant _ -> true
+    | Tpat_record (_, _) -> true
+    | Tpat_array _ -> true
+    | Tpat_lazy _ -> true
+    | Tpat_value pat -> is_destructuring_pattern (pat :> pattern)
+    | Tpat_exception _ -> false
+    | Tpat_or (l,r,_) ->
+        is_destructuring_pattern l || is_destructuring_pattern r
+
+let is_valid_recursive_expression idlist expr =
+  let ty = expression expr Return in
+  match Env.unguarded ty idlist, Env.dependent ty idlist,
+        classify_expression expr with
+  | _ :: _, _, _ (* The expression inspects rec-bound variables *)
+  | [], _ :: _, Dynamic -> (* The expression depends on rec-bound variables
+                              and its size is unknown *)
+      false
+  | [], _, Static (* The expression has known size *)
+  | [], [], Dynamic -> (* The expression has unknown size,
+                          but does not depend on rec-bound variables *)
+      true
+
+(* A class declaration may contain let-bindings. If they are recursive,
+   their validity will already be checked by [is_valid_recursive_expression]
+   during type-checking. This function here prevents a different kind of
+   invalid recursion, which is the unsafe creations of objects of this class
+   in the let-binding. For example,
+   {|class a = let x = new a in object ... end|}
+   is forbidden, but
+   {|class a = let x () = new a in object ... end|}
+   is allowed.
+*)
+let is_valid_class_expr idlist ce =
+  let rec class_expr : mode -> Typedtree.class_expr -> Env.t =
+    fun mode ce -> match ce.cl_desc with
+      | Tcl_ident (_, _, _) ->
+        (*
+          ----------
+          [] |- a: m
+        *)
+        Env.empty
+      | Tcl_structure _ ->
+        (*
+          -----------------------
+          [] |- struct ... end: m
+        *)
+        Env.empty
+      | Tcl_fun (_, _, _, _, _) -> Env.empty
+        (*
+          ---------------------------
+          [] |- fun x1 ... xn -> C: m
+        *)
+      | Tcl_apply (_, _) -> Env.empty
+      | Tcl_let (rec_flag, bindings, _, ce) ->
+        value_bindings rec_flag bindings mode (class_expr mode ce)
+      | Tcl_constraint (ce, _, _, _, _) ->
+        class_expr mode ce
+      | Tcl_open (_, ce) ->
+        class_expr mode ce
+  in
+  match Env.unguarded (class_expr Return ce) idlist with
+  | [] -> true
+  | _ :: _ -> false
diff --git a/typing/rec_check.mli b/typing/rec_check.mli
new file mode 100644
index 00000000..aa5c1ca3
--- /dev/null
+++ b/typing/rec_check.mli
@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*               Jeremy Yallop, University of Cambridge                   *)
+(*                                                                        *)
+(*   Copyright 2017 Jeremy Yallop                                         *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+exception Illegal_expr
+
+val is_valid_recursive_expression : Ident.t list -> Typedtree.expression -> bool
+
+val is_valid_class_expr : Ident.t list -> Typedtree.class_expr -> bool
diff --git a/typing/stypes.ml b/typing/stypes.ml
new file mode 100644
index 00000000..dfbcc991
--- /dev/null
+++ b/typing/stypes.ml
@@ -0,0 +1,210 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Damien Doligez, projet Moscova, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2003 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Recording and dumping (partial) type information *)
+
+(*
+  We record all types in a list as they are created.
+  This means we can dump type information even if type inference fails,
+  which is extremely important, since type information is most
+  interesting in case of errors.
+*)
+
+open Annot;;
+open Lexing;;
+open Location;;
+open Typedtree;;
+
+let output_int oc i = output_string oc (Int.to_string i)
+
+type annotation =
+  | Ti_pat : 'k pattern_category * 'k general_pattern -> annotation
+  | Ti_expr  of expression
+  | Ti_class of class_expr
+  | Ti_mod   of module_expr
+  | An_call of Location.t * Annot.call
+  | An_ident of Location.t * string * Annot.ident
+;;
+
+let get_location ti =
+  match ti with
+  | Ti_pat (_, p)   -> p.pat_loc
+  | Ti_expr e  -> e.exp_loc
+  | Ti_class c -> c.cl_loc
+  | Ti_mod m   -> m.mod_loc
+  | An_call (l, _k) -> l
+  | An_ident (l, _s, _k) -> l
+;;
+
+let annotations = ref ([] : annotation list);;
+let phrases = ref ([] : Location.t list);;
+
+let record ti =
+  if !Clflags.annotations && not (get_location ti).Location.loc_ghost then
+    annotations := ti :: !annotations
+;;
+
+let record_phrase loc =
+  if !Clflags.annotations then phrases := loc :: !phrases;
+;;
+
+(* comparison order:
+   the intervals are sorted by order of increasing upper bound
+   same upper bound -> sorted by decreasing lower bound
+*)
+let cmp_loc_inner_first loc1 loc2 =
+  match compare loc1.loc_end.pos_cnum loc2.loc_end.pos_cnum with
+  | 0 -> compare loc2.loc_start.pos_cnum loc1.loc_start.pos_cnum
+  | x -> x
+;;
+let cmp_ti_inner_first ti1 ti2 =
+  cmp_loc_inner_first (get_location ti1) (get_location ti2)
+;;
+
+let print_position pp pos =
+  if pos = dummy_pos then
+    output_string pp "--"
+  else begin
+    output_char pp '\"';
+    output_string pp (String.escaped pos.pos_fname);
+    output_string pp "\" ";
+    output_int pp pos.pos_lnum;
+    output_char pp ' ';
+    output_int pp pos.pos_bol;
+    output_char pp ' ';
+    output_int pp pos.pos_cnum;
+  end
+;;
+
+let print_location pp loc =
+  print_position pp loc.loc_start;
+  output_char pp ' ';
+  print_position pp loc.loc_end;
+;;
+
+let sort_filter_phrases () =
+  let ph = List.sort (fun x y -> cmp_loc_inner_first y x) !phrases in
+  let rec loop accu cur l =
+    match l with
+    | [] -> accu
+    | loc :: t ->
+       if cur.loc_start.pos_cnum <= loc.loc_start.pos_cnum
+          && cur.loc_end.pos_cnum >= loc.loc_end.pos_cnum
+       then loop accu cur t
+       else loop (loc :: accu) loc t
+  in
+  phrases := loop [] Location.none ph;
+;;
+
+let rec printtyp_reset_maybe loc =
+  match !phrases with
+  | cur :: t when cur.loc_start.pos_cnum <= loc.loc_start.pos_cnum ->
+     Printtyp.reset ();
+     phrases := t;
+     printtyp_reset_maybe loc;
+  | _ -> ()
+;;
+
+let call_kind_string k =
+  match k with
+  | Tail -> "tail"
+  | Stack -> "stack"
+  | Inline -> "inline"
+;;
+
+let print_ident_annot pp str k =
+  match k with
+  | Idef l ->
+      output_string pp "def ";
+      output_string pp str;
+      output_char pp ' ';
+      print_location pp l;
+      output_char pp '\n'
+  | Iref_internal l ->
+      output_string pp "int_ref ";
+      output_string pp str;
+      output_char pp ' ';
+      print_location pp l;
+      output_char pp '\n'
+  | Iref_external ->
+      output_string pp "ext_ref ";
+      output_string pp str;
+      output_char pp '\n'
+;;
+
+(* The format of the annotation file is documented in emacs/caml-types.el. *)
+
+let print_info pp prev_loc ti =
+  match ti with
+  | Ti_class _ | Ti_mod _ -> prev_loc
+  | Ti_pat  (_, {pat_loc = loc; pat_type = typ; pat_env = env})
+  | Ti_expr     {exp_loc = loc; exp_type = typ; exp_env = env} ->
+      if loc <> prev_loc then begin
+        print_location pp loc;
+        output_char pp '\n'
+      end;
+      output_string pp "type(\n";
+      printtyp_reset_maybe loc;
+      Printtyp.mark_loops typ;
+      Format.pp_print_string Format.str_formatter "  ";
+      Printtyp.wrap_printing_env ~error:false env
+                       (fun () -> Printtyp.type_sch Format.str_formatter typ);
+      Format.pp_print_newline Format.str_formatter ();
+      let s = Format.flush_str_formatter () in
+      output_string pp s;
+      output_string pp ")\n";
+      loc
+  | An_call (loc, k) ->
+      if loc <> prev_loc then begin
+        print_location pp loc;
+        output_char pp '\n'
+      end;
+      output_string pp "call(\n  ";
+      output_string pp (call_kind_string k);
+      output_string pp "\n)\n";
+      loc
+  | An_ident (loc, str, k) ->
+      if loc <> prev_loc then begin
+        print_location pp loc;
+        output_char pp '\n'
+      end;
+      output_string pp "ident(\n  ";
+      print_ident_annot pp str k;
+      output_string pp ")\n";
+      loc
+;;
+
+let get_info () =
+  let info = List.fast_sort cmp_ti_inner_first !annotations in
+  annotations := [];
+  info
+;;
+
+let dump filename =
+  if !Clflags.annotations then begin
+    let do_dump _temp_filename pp =
+      let info = get_info () in
+      sort_filter_phrases ();
+      ignore (List.fold_left (print_info pp) Location.none info) in
+    begin match filename with
+    | None -> do_dump "" stdout
+    | Some filename ->
+        Misc.output_to_file_via_temporary ~mode:[Open_text] filename do_dump
+    end;
+    phrases := [];
+  end else begin
+    annotations := [];
+  end;
+;;
diff --git a/typing/stypes.mli b/typing/stypes.mli
new file mode 100644
index 00000000..fda575fc
--- /dev/null
+++ b/typing/stypes.mli
@@ -0,0 +1,36 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Damien Doligez, projet Moscova, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2003 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Recording and dumping (partial) type information *)
+
+(* Clflags.save_types must be true *)
+
+open Typedtree;;
+
+type annotation =
+  | Ti_pat : 'k pattern_category * 'k general_pattern -> annotation
+  | Ti_expr  of expression
+  | Ti_class of class_expr
+  | Ti_mod   of module_expr
+  | An_call of Location.t * Annot.call
+  | An_ident of Location.t * string * Annot.ident
+;;
+
+val record : annotation -> unit;;
+val record_phrase : Location.t -> unit;;
+val dump : string option -> unit;;
+
+val get_location : annotation -> Location.t;;
+val get_info : unit -> annotation list;;
diff --git a/typing/subst.ml b/typing/subst.ml
new file mode 100644
index 00000000..9d209b2f
--- /dev/null
+++ b/typing/subst.ml
@@ -0,0 +1,555 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Substitutions *)
+
+open Misc
+open Path
+open Types
+open Btype
+
+type type_replacement =
+  | Path of Path.t
+  | Type_function of { params : type_expr list; body : type_expr }
+
+type t =
+  { types: type_replacement Path.Map.t;
+    modules: Path.t Path.Map.t;
+    modtypes: module_type Ident.Map.t;
+    for_saving: bool;
+  }
+
+let identity =
+  { types = Path.Map.empty;
+    modules = Path.Map.empty;
+    modtypes = Ident.Map.empty;
+    for_saving = false;
+  }
+
+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 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 add_module id p s = add_module_path (Pident id) p s
+
+let add_modtype id ty s = { s with modtypes = Ident.Map.add id ty s.modtypes }
+
+let for_saving s = { s with for_saving = true }
+
+let loc s x =
+  if s.for_saving && not !Clflags.keep_locs then Location.none else x
+
+let remove_loc =
+  let open Ast_mapper in
+  {default_mapper with location = (fun _this _loc -> Location.none)}
+
+let is_not_doc = function
+  | {Parsetree.attr_name = {Location.txt = "ocaml.doc"}; _} -> false
+  | {Parsetree.attr_name = {Location.txt = "ocaml.text"}; _} -> false
+  | {Parsetree.attr_name = {Location.txt = "doc"}; _} -> false
+  | {Parsetree.attr_name = {Location.txt = "text"}; _} -> false
+  | _ -> true
+
+let attrs s x =
+  let x =
+    if s.for_saving && not !Clflags.keep_docs then
+      List.filter is_not_doc x
+    else x
+  in
+    if s.for_saving && not !Clflags.keep_locs
+    then remove_loc.Ast_mapper.attributes remove_loc x
+    else x
+
+let rec module_path s path =
+  try Path.Map.find path s.modules
+  with Not_found ->
+    match path with
+    | Pident _ -> path
+    | Pdot(p, n) ->
+       Pdot(module_path s p, n)
+    | Papply(p1, p2) ->
+       Papply(module_path s p1, module_path s p2)
+
+let modtype_path s = function
+    Pident id as p ->
+      begin try
+        match Ident.Map.find id s.modtypes with
+          | Mty_ident p -> p
+          | _ -> fatal_error "Subst.modtype_path"
+      with Not_found -> p end
+  | Pdot(p, n) ->
+      Pdot(module_path s p, n)
+  | Papply _ ->
+      fatal_error "Subst.modtype_path"
+
+let type_path s path =
+  match Path.Map.find path s.types with
+  | Path p -> p
+  | Type_function _ -> assert false
+  | exception Not_found ->
+     match path with
+     | Pident _ -> path
+     | Pdot(p, n) ->
+        Pdot(module_path s p, n)
+     | Papply _ ->
+        fatal_error "Subst.type_path"
+
+let type_path s p =
+  match Path.constructor_typath p with
+  | Regular p -> type_path s p
+  | Cstr (ty_path, cstr) -> Pdot(type_path s ty_path, cstr)
+  | LocalExt _ -> type_path s p
+  | Ext (p, cstr) -> Pdot(module_path s p, cstr)
+
+let to_subst_by_type_function s p =
+  match Path.Map.find p s.types with
+  | Path _ -> false
+  | Type_function _ -> true
+  | exception Not_found -> false
+
+(* Special type ids for saved signatures *)
+
+let new_id = ref (-1)
+let reset_for_saving () = new_id := -1
+
+let newpersty desc =
+  decr new_id;
+  { desc; level = generic_level; scope = Btype.lowest_level; id = !new_id }
+
+(* ensure that all occurrences of 'Tvar None' are physically shared *)
+let tvar_none = Tvar None
+let tunivar_none = Tunivar None
+let norm = function
+  | Tvar None -> tvar_none
+  | Tunivar None -> tunivar_none
+  | d -> d
+
+let ctype_apply_env_empty = ref (fun _ -> assert false)
+
+(* Similar to [Ctype.nondep_type_rec]. *)
+let rec typexp copy_scope s ty =
+  let ty = repr ty in
+  match ty.desc with
+    Tvar _ | Tunivar _ as desc ->
+      if s.for_saving || ty.id < 0 then
+        let ty' =
+          if s.for_saving then newpersty (norm desc)
+          else newty2 ty.level desc
+        in
+        For_copy.save_desc copy_scope ty desc;
+        ty.desc <- Tsubst ty';
+        ty'
+      else ty
+  | Tsubst ty ->
+      ty
+  | Tfield (m, k, _t1, _t2) when not s.for_saving && m = dummy_method
+      && field_kind_repr k <> Fabsent && (repr ty).level < generic_level ->
+      (* do not copy the type of self when it is not generalized *)
+      ty
+(* cannot do it, since it would omit substitution
+  | Tvariant row when not (static_row row) ->
+      ty
+*)
+  | _ ->
+    let desc = ty.desc in
+    For_copy.save_desc copy_scope ty desc;
+    let tm = row_of_type ty in
+    let has_fixed_row =
+      not (is_Tconstr ty) && is_constr_row ~allow_ident:false tm in
+    (* Make a stub *)
+    let ty' = if s.for_saving then newpersty (Tvar None) else newgenvar () in
+    ty'.scope <- ty.scope;
+    ty.desc <- Tsubst ty';
+    ty'.desc <-
+      begin if has_fixed_row then
+        match tm.desc with (* PR#7348 *)
+          Tconstr (Pdot(m,i), tl, _abbrev) ->
+            let i' = String.sub i 0 (String.length i - 4) in
+            Tconstr(type_path s (Pdot(m,i')), tl, ref Mnil)
+        | _ -> assert false
+      else match desc with
+      | Tconstr (p, args, _abbrev) ->
+         let args = List.map (typexp copy_scope s) args in
+         begin match Path.Map.find p s.types with
+         | exception Not_found -> Tconstr(type_path s p, args, ref Mnil)
+         | Path _ -> Tconstr(type_path s p, args, ref Mnil)
+         | Type_function { params; body } ->
+            Tlink (!ctype_apply_env_empty params body args)
+         end
+      | Tpackage(p, n, tl) ->
+          Tpackage(modtype_path s p, n, List.map (typexp copy_scope s) tl)
+      | Tobject (t1, name) ->
+          let t1' = typexp copy_scope s t1 in
+          let name' =
+            match !name with
+            | None -> None
+            | Some (p, tl) ->
+                if to_subst_by_type_function s p
+                then None
+                else Some (type_path s p, List.map (typexp copy_scope s) tl)
+          in
+          Tobject (t1', ref name')
+      | Tvariant row ->
+          let row = row_repr row in
+          let more = repr row.row_more in
+          (* We must substitute in a subtle way *)
+          (* Tsubst takes a tuple containing the row var and the variant *)
+          begin match more.desc with
+            Tsubst {desc = Ttuple [_;ty2]} ->
+              (* This variant type has been already copied *)
+              ty.desc <- Tsubst ty2; (* avoid Tlink in the new type *)
+              Tlink ty2
+          | _ ->
+              let dup =
+                s.for_saving || more.level = generic_level || static_row row ||
+                match more.desc with Tconstr _ -> true | _ -> false in
+              (* Various cases for the row variable *)
+              let more' =
+                match more.desc with
+                  Tsubst ty -> ty
+                | Tconstr _ | Tnil -> typexp copy_scope s more
+                | Tunivar _ | Tvar _ ->
+                    For_copy.save_desc copy_scope more more.desc;
+                    if s.for_saving then newpersty (norm more.desc) else
+                    if dup && is_Tvar more then newgenty more.desc else more
+                | _ -> assert false
+              in
+              (* Register new type first for recursion *)
+              more.desc <- Tsubst(newgenty(Ttuple[more';ty']));
+              (* Return a new copy *)
+              let row =
+                copy_row (typexp copy_scope s) true row (not dup) more' in
+              match row.row_name with
+              | Some (p, tl) ->
+                 Tvariant {row with row_name =
+                                      if to_subst_by_type_function s p
+                                      then None
+                                      else Some (type_path s p, tl)}
+              | None ->
+                  Tvariant row
+          end
+      | Tfield(_label, kind, _t1, t2) when field_kind_repr kind = Fabsent ->
+          Tlink (typexp copy_scope s t2)
+      | _ -> copy_type_desc (typexp copy_scope s) desc
+      end;
+    ty'
+
+(*
+   Always make a copy of the type. If this is not done, type levels
+   might not be correct.
+*)
+let type_expr s ty =
+  For_copy.with_scope (fun copy_scope -> typexp copy_scope s ty)
+
+let label_declaration copy_scope s l =
+  {
+    ld_id = l.ld_id;
+    ld_mutable = l.ld_mutable;
+    ld_type = typexp copy_scope s l.ld_type;
+    ld_loc = loc s l.ld_loc;
+    ld_attributes = attrs s l.ld_attributes;
+    ld_uid = l.ld_uid;
+  }
+
+let constructor_arguments copy_scope s = function
+  | Cstr_tuple l ->
+      Cstr_tuple (List.map (typexp copy_scope s) l)
+  | Cstr_record l ->
+      Cstr_record (List.map (label_declaration copy_scope s) l)
+
+let constructor_declaration copy_scope s c =
+  {
+    cd_id = c.cd_id;
+    cd_args = constructor_arguments copy_scope s c.cd_args;
+    cd_res = Option.map (typexp copy_scope s) c.cd_res;
+    cd_loc = loc s c.cd_loc;
+    cd_attributes = attrs s c.cd_attributes;
+    cd_uid = c.cd_uid;
+  }
+
+let type_declaration' copy_scope s decl =
+  { type_params = List.map (typexp copy_scope s) decl.type_params;
+    type_arity = decl.type_arity;
+    type_kind =
+      begin match decl.type_kind with
+        Type_abstract -> Type_abstract
+      | Type_variant cstrs ->
+          Type_variant (List.map (constructor_declaration copy_scope s) cstrs)
+      | Type_record(lbls, rep) ->
+          Type_record (List.map (label_declaration copy_scope s) lbls, rep)
+      | Type_open -> Type_open
+      end;
+    type_manifest =
+      begin
+        match decl.type_manifest with
+          None -> None
+        | Some ty -> Some(typexp copy_scope s ty)
+      end;
+    type_private = decl.type_private;
+    type_variance = decl.type_variance;
+    type_separability = decl.type_separability;
+    type_is_newtype = false;
+    type_expansion_scope = Btype.lowest_level;
+    type_loc = loc s decl.type_loc;
+    type_attributes = attrs s decl.type_attributes;
+    type_immediate = decl.type_immediate;
+    type_unboxed = decl.type_unboxed;
+    type_uid = decl.type_uid;
+  }
+
+let type_declaration s decl =
+  For_copy.with_scope (fun copy_scope -> type_declaration' copy_scope s decl)
+
+let class_signature copy_scope s sign =
+  { csig_self = typexp copy_scope s sign.csig_self;
+    csig_vars =
+      Vars.map
+        (function (m, v, t) -> (m, v, typexp copy_scope s t)) sign.csig_vars;
+    csig_concr = sign.csig_concr;
+    csig_inher =
+      List.map
+        (fun (p, tl) -> (type_path s p, List.map (typexp copy_scope s) tl))
+        sign.csig_inher;
+  }
+
+let rec class_type copy_scope s = function
+  | Cty_constr (p, tyl, cty) ->
+      let p' = type_path s p in
+      let tyl' = List.map (typexp copy_scope s) tyl in
+      let cty' = class_type copy_scope s cty in
+      Cty_constr (p', tyl', cty')
+  | Cty_signature sign ->
+      Cty_signature (class_signature copy_scope s sign)
+  | Cty_arrow (l, ty, cty) ->
+      Cty_arrow (l, typexp copy_scope s ty, class_type copy_scope s cty)
+
+let class_declaration' copy_scope s decl =
+  { cty_params = List.map (typexp copy_scope s) decl.cty_params;
+    cty_variance = decl.cty_variance;
+    cty_type = class_type copy_scope s decl.cty_type;
+    cty_path = type_path s decl.cty_path;
+    cty_new =
+      begin match decl.cty_new with
+      | None    -> None
+      | Some ty -> Some (typexp copy_scope s ty)
+      end;
+    cty_loc = loc s decl.cty_loc;
+    cty_attributes = attrs s decl.cty_attributes;
+    cty_uid = decl.cty_uid;
+  }
+
+let class_declaration s decl =
+  For_copy.with_scope (fun copy_scope -> class_declaration' copy_scope s decl)
+
+let cltype_declaration' copy_scope s decl =
+  { clty_params = List.map (typexp copy_scope s) decl.clty_params;
+    clty_variance = decl.clty_variance;
+    clty_type = class_type copy_scope s decl.clty_type;
+    clty_path = type_path s decl.clty_path;
+    clty_loc = loc s decl.clty_loc;
+    clty_attributes = attrs s decl.clty_attributes;
+    clty_uid = decl.clty_uid;
+  }
+
+let cltype_declaration s decl =
+  For_copy.with_scope (fun copy_scope -> cltype_declaration' copy_scope s decl)
+
+let class_type s cty =
+  For_copy.with_scope (fun copy_scope -> class_type copy_scope s cty)
+
+let value_description' copy_scope s descr =
+  { val_type = typexp copy_scope s descr.val_type;
+    val_kind = descr.val_kind;
+    val_loc = loc s descr.val_loc;
+    val_attributes = attrs s descr.val_attributes;
+    val_uid = descr.val_uid;
+   }
+
+let value_description s descr =
+  For_copy.with_scope (fun copy_scope -> value_description' copy_scope s descr)
+
+let extension_constructor' copy_scope s ext =
+  { ext_type_path = type_path s ext.ext_type_path;
+    ext_type_params = List.map (typexp copy_scope s) ext.ext_type_params;
+    ext_args = constructor_arguments copy_scope s ext.ext_args;
+    ext_ret_type = Option.map (typexp copy_scope s) ext.ext_ret_type;
+    ext_private = ext.ext_private;
+    ext_attributes = attrs s ext.ext_attributes;
+    ext_loc = if s.for_saving then Location.none else ext.ext_loc;
+    ext_uid = ext.ext_uid;
+  }
+
+let extension_constructor s ext =
+  For_copy.with_scope
+    (fun copy_scope -> extension_constructor' copy_scope s ext)
+
+type scoping =
+  | Keep
+  | Make_local
+  | Rescope of int
+
+let rename_bound_idents scoping s sg =
+  let rename =
+    let open Ident in
+    match scoping with
+    | Keep -> (fun id -> create_scoped ~scope:(scope id) (name id))
+    | Make_local -> Ident.rename
+    | Rescope scope -> (fun id -> create_scoped ~scope (name id))
+  in
+  let rec rename_bound_idents s sg = function
+    | [] -> sg, s
+    | Sig_type(id, td, rs, vis) :: rest ->
+        let id' = rename id in
+        rename_bound_idents
+          (add_type id (Pident id') s)
+          (Sig_type(id', td, rs, vis) :: sg)
+          rest
+    | Sig_module(id, pres, md, rs, vis) :: rest ->
+        let id' = rename id in
+        rename_bound_idents
+          (add_module id (Pident id') s)
+          (Sig_module (id', pres, md, rs, vis) :: sg)
+          rest
+    | Sig_modtype(id, mtd, vis) :: rest ->
+        let id' = rename id in
+        rename_bound_idents
+          (add_modtype id (Mty_ident(Pident id')) s)
+          (Sig_modtype(id', mtd, vis) :: sg)
+          rest
+    | Sig_class(id, cd, rs, vis) :: rest ->
+        (* cheat and pretend they are types cf. PR#6650 *)
+        let id' = rename id in
+        rename_bound_idents
+          (add_type id (Pident id') s)
+          (Sig_class(id', cd, rs, vis) :: sg)
+          rest
+    | Sig_class_type(id, ctd, rs, vis) :: rest ->
+        (* cheat and pretend they are types cf. PR#6650 *)
+        let id' = rename id in
+        rename_bound_idents
+          (add_type id (Pident id') s)
+          (Sig_class_type(id', ctd, rs, vis) :: sg)
+          rest
+    | Sig_value(id, vd, vis) :: rest ->
+        (* scope doesn't matter for value identifiers. *)
+        let id' = Ident.rename id in
+        rename_bound_idents s (Sig_value(id', vd, vis) :: sg) rest
+    | Sig_typext(id, ec, es, vis) :: rest ->
+        let id' = rename id in
+        rename_bound_idents s (Sig_typext(id',ec,es,vis) :: sg) rest
+  in
+  rename_bound_idents s [] sg
+
+let rec modtype scoping s = function
+    Mty_ident p as mty ->
+      begin match p with
+        Pident id ->
+          begin try Ident.Map.find id s.modtypes with Not_found -> mty end
+      | Pdot(p, n) ->
+          Mty_ident(Pdot(module_path s p, n))
+      | Papply _ ->
+          fatal_error "Subst.modtype"
+      end
+  | Mty_signature sg ->
+      Mty_signature(signature scoping s sg)
+  | Mty_functor(Unit, res) ->
+      Mty_functor(Unit, modtype scoping s res)
+  | Mty_functor(Named (None, arg), res) ->
+      Mty_functor(Named (None, (modtype scoping s) arg), modtype scoping s res)
+  | Mty_functor(Named (Some id, arg), res) ->
+      let id' = Ident.rename id in
+      Mty_functor(Named (Some id', (modtype scoping s) arg),
+                  modtype scoping (add_module id (Pident id') s) res)
+  | Mty_alias p ->
+      Mty_alias (module_path s p)
+
+and signature scoping s sg =
+  (* Components of signature may be mutually recursive (e.g. type declarations
+     or class and type declarations), so first build global renaming
+     substitution... *)
+  let (sg', s') = rename_bound_idents scoping s sg in
+  (* ... then apply it to each signature component in turn *)
+  For_copy.with_scope (fun copy_scope ->
+    List.rev_map (signature_item' copy_scope scoping s') sg'
+  )
+
+
+and signature_item' copy_scope scoping s comp =
+  match comp with
+    Sig_value(id, d, vis) ->
+      Sig_value(id, value_description' copy_scope s d, vis)
+  | Sig_type(id, d, rs, vis) ->
+      Sig_type(id, type_declaration' copy_scope s d, rs, vis)
+  | Sig_typext(id, ext, es, vis) ->
+      Sig_typext(id, extension_constructor' copy_scope s ext, es, vis)
+  | Sig_module(id, pres, d, rs, vis) ->
+      Sig_module(id, pres, module_declaration scoping s d, rs, vis)
+  | Sig_modtype(id, d, vis) ->
+      Sig_modtype(id, modtype_declaration scoping s d, vis)
+  | Sig_class(id, d, rs, vis) ->
+      Sig_class(id, class_declaration' copy_scope s d, rs, vis)
+  | Sig_class_type(id, d, rs, vis) ->
+      Sig_class_type(id, cltype_declaration' copy_scope s d, rs, vis)
+
+and signature_item scoping s comp =
+  For_copy.with_scope
+    (fun copy_scope -> signature_item' copy_scope scoping s comp)
+
+and module_declaration scoping s decl =
+  {
+    md_type = modtype scoping s decl.md_type;
+    md_attributes = attrs s decl.md_attributes;
+    md_loc = loc s decl.md_loc;
+    md_uid = decl.md_uid;
+  }
+
+and modtype_declaration scoping s decl  =
+  {
+    mtd_type = Option.map (modtype scoping s) decl.mtd_type;
+    mtd_attributes = attrs s decl.mtd_attributes;
+    mtd_loc = loc s decl.mtd_loc;
+    mtd_uid = decl.mtd_uid;
+  }
+
+
+(* For every binding k |-> d of m1, add k |-> f d to m2
+   and return resulting merged map. *)
+
+let merge_tbls f m1 m2 =
+  Ident.Map.fold (fun k d accu -> Ident.Map.add k (f d) accu) m1 m2
+
+let merge_path_maps f m1 m2 =
+  Path.Map.fold (fun k d accu -> Path.Map.add k (f d) accu) m1 m2
+
+let type_replacement s = function
+  | Path p -> Path (type_path s p)
+  | Type_function { params; body } ->
+    For_copy.with_scope (fun copy_scope ->
+     let params = List.map (typexp copy_scope s) params in
+     let body = typexp copy_scope s body in
+     Type_function { params; body })
+
+(* Composition of substitutions:
+     apply (compose s1 s2) x = apply s2 (apply s1 x) *)
+
+let compose s1 s2 =
+  { types = merge_path_maps (type_replacement s2) s1.types s2.types;
+    modules = merge_path_maps (module_path s2) s1.modules s2.modules;
+    modtypes = merge_tbls (modtype Keep s2) s1.modtypes s2.modtypes;
+    for_saving = s1.for_saving || s2.for_saving;
+  }
diff --git a/typing/subst.mli b/typing/subst.mli
new file mode 100644
index 00000000..67c01536
--- /dev/null
+++ b/typing/subst.mli
@@ -0,0 +1,86 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* 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
+   they are inferior to the maximum level of the new context.
+
+   Substitutions can also be used to create a "clean" copy of a type.
+   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
+
+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 for_saving: t -> t
+val reset_for_saving: unit -> unit
+
+val module_path: t -> Path.t -> Path.t
+val type_path: t -> Path.t -> Path.t
+val modtype_path: t -> Path.t -> Path.t
+
+val type_expr: t -> type_expr -> type_expr
+val class_type: t -> class_type -> class_type
+val value_description: t -> value_description -> value_description
+val type_declaration: t -> type_declaration -> type_declaration
+val extension_constructor:
+        t -> extension_constructor -> extension_constructor
+val class_declaration: t -> class_declaration -> class_declaration
+val cltype_declaration: t -> class_type_declaration -> class_type_declaration
+
+(*
+   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
+   scope of this new declaration should be.
+
+   This is decided by the [scoping] argument passed to the following functions.
+*)
+
+type scoping =
+  | Keep
+  | Make_local
+  | Rescope of int
+
+val modtype: scoping -> t -> module_type -> module_type
+val signature: scoping -> t -> signature -> signature
+val signature_item: scoping -> t -> signature_item -> signature_item
+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) *)
+val compose: t -> t -> t
+
+(* A forward reference to be filled in ctype.ml. *)
+val ctype_apply_env_empty:
+  (type_expr list -> type_expr -> type_expr list -> type_expr) ref
diff --git a/typing/tast_iterator.ml b/typing/tast_iterator.ml
new file mode 100644
index 00000000..db63fc0b
--- /dev/null
+++ b/typing/tast_iterator.ml
@@ -0,0 +1,510 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                          Isaac "Izzy" Avram                            *)
+(*                                                                        *)
+(*   Copyright 2019 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Asttypes
+open Typedtree
+
+type iterator =
+  {
+    binding_op: iterator -> binding_op -> unit;
+    case: 'k . iterator -> 'k case -> unit;
+    class_declaration: iterator -> class_declaration -> unit;
+    class_description: iterator -> class_description -> unit;
+    class_expr: iterator -> class_expr -> unit;
+    class_field: iterator -> class_field -> unit;
+    class_signature: iterator -> class_signature -> unit;
+    class_structure: iterator -> class_structure -> unit;
+    class_type: iterator -> class_type -> unit;
+    class_type_declaration: iterator -> class_type_declaration -> unit;
+    class_type_field: iterator -> class_type_field -> unit;
+    env: iterator -> Env.t -> unit;
+    expr: iterator -> expression -> unit;
+    extension_constructor: iterator -> extension_constructor -> unit;
+    module_binding: iterator -> module_binding -> unit;
+    module_coercion: iterator -> module_coercion -> unit;
+    module_declaration: iterator -> module_declaration -> unit;
+    module_substitution: iterator -> module_substitution -> unit;
+    module_expr: iterator -> module_expr -> unit;
+    module_type: iterator -> module_type -> unit;
+    module_type_declaration: iterator -> module_type_declaration -> unit;
+    package_type: iterator -> package_type -> unit;
+    pat: 'k . iterator -> 'k general_pattern -> unit;
+    row_field: iterator -> row_field -> unit;
+    object_field: iterator -> object_field -> unit;
+    open_declaration: iterator -> open_declaration -> unit;
+    open_description: iterator -> open_description -> unit;
+    signature: iterator -> signature -> unit;
+    signature_item: iterator -> signature_item -> unit;
+    structure: iterator -> structure -> unit;
+    structure_item: iterator -> structure_item -> unit;
+    typ: iterator -> core_type -> unit;
+    type_declaration: iterator -> type_declaration -> unit;
+    type_declarations: iterator -> (rec_flag * type_declaration list) -> unit;
+    type_extension: iterator -> type_extension -> unit;
+    type_exception: iterator -> type_exception -> unit;
+    type_kind: iterator -> type_kind -> unit;
+    value_binding: iterator -> value_binding -> unit;
+    value_bindings: iterator -> (rec_flag * value_binding list) -> unit;
+    value_description: iterator -> value_description -> unit;
+    with_constraint: iterator -> with_constraint -> unit;
+  }
+
+let structure sub {str_items; str_final_env; _} =
+  List.iter (sub.structure_item sub) str_items;
+  sub.env sub str_final_env
+
+let class_infos sub f x =
+  List.iter (fun (ct, _) -> sub.typ sub ct) x.ci_params;
+  f x.ci_expr
+
+let module_type_declaration sub {mtd_type; _} =
+  Option.iter (sub.module_type sub) mtd_type
+
+let module_declaration sub {md_type; _} =
+  sub.module_type sub md_type
+let module_substitution _ _ = ()
+
+let include_infos f {incl_mod; _} = f incl_mod
+
+let class_type_declaration sub x =
+  class_infos sub (sub.class_type sub) x
+
+let class_declaration sub x =
+  class_infos sub (sub.class_expr sub) x
+
+let structure_item sub {str_desc; str_env; _} =
+  sub.env sub str_env;
+  match str_desc with
+  | Tstr_eval   (exp, _) -> sub.expr sub exp
+  | Tstr_value  (rec_flag, list) -> sub.value_bindings sub (rec_flag, list)
+  | Tstr_primitive v -> sub.value_description sub v
+  | Tstr_type (rec_flag, list) -> sub.type_declarations sub (rec_flag, list)
+  | Tstr_typext te -> sub.type_extension sub te
+  | Tstr_exception ext -> sub.type_exception sub ext
+  | Tstr_module mb -> sub.module_binding sub mb
+  | Tstr_recmodule list -> List.iter (sub.module_binding sub) list
+  | Tstr_modtype x -> sub.module_type_declaration sub x
+  | Tstr_class list ->
+      List.iter (fun (cls,_) -> sub.class_declaration sub cls) list
+  | Tstr_class_type list ->
+      List.iter (fun (_, _, cltd) -> sub.class_type_declaration sub cltd) list
+  | Tstr_include incl -> include_infos (sub.module_expr sub) incl
+  | Tstr_open od -> sub.open_declaration sub od
+  | Tstr_attribute _ -> ()
+
+let value_description sub x = sub.typ sub x.val_desc
+
+let label_decl sub {ld_type; _} = sub.typ sub ld_type
+
+let constructor_args sub = function
+  | Cstr_tuple l -> List.iter (sub.typ sub) l
+  | Cstr_record l -> List.iter (label_decl sub) l
+
+let constructor_decl sub {cd_args; cd_res; _} =
+  constructor_args sub cd_args;
+  Option.iter (sub.typ sub) cd_res
+
+let type_kind sub = function
+  | Ttype_abstract -> ()
+  | Ttype_variant list -> List.iter (constructor_decl sub) list
+  | Ttype_record list -> List.iter (label_decl sub) list
+  | Ttype_open -> ()
+
+let type_declaration sub {typ_cstrs; typ_kind; typ_manifest; typ_params; _} =
+  List.iter
+    (fun (c1, c2, _) ->
+      sub.typ sub c1;
+      sub.typ sub c2)
+    typ_cstrs;
+  sub.type_kind sub typ_kind;
+  Option.iter (sub.typ sub) typ_manifest;
+  List.iter (fun (c, _) -> sub.typ sub c) typ_params
+
+let type_declarations sub (_, list) = List.iter (sub.type_declaration sub) list
+
+let type_extension sub {tyext_constructors; tyext_params; _} =
+  List.iter (fun (c, _) -> sub.typ sub c) tyext_params;
+  List.iter (sub.extension_constructor sub) tyext_constructors
+
+let type_exception sub {tyexn_constructor; _} =
+  sub.extension_constructor sub tyexn_constructor
+
+let extension_constructor sub {ext_kind; _} =
+  match ext_kind with
+  | Text_decl (ctl, cto) ->
+      constructor_args sub ctl;
+      Option.iter (sub.typ sub) cto
+  | Text_rebind _ -> ()
+
+let pat_extra sub (e, _loc, _attrs) = match e with
+  | Tpat_type _ -> ()
+  | Tpat_unpack -> ()
+  | Tpat_open (_, _, env) -> sub.env sub env
+  | Tpat_constraint ct -> sub.typ sub ct
+
+let pat
+  : type k . iterator -> k general_pattern -> unit
+  = fun sub {pat_extra = extra; pat_desc; pat_env; _} ->
+  sub.env sub pat_env;
+  List.iter (pat_extra sub) extra;
+  match pat_desc with
+  | Tpat_any  -> ()
+  | Tpat_var _ -> ()
+  | Tpat_constant _ -> ()
+  | Tpat_tuple l -> List.iter (sub.pat sub) l
+  | Tpat_construct (_, _, l) -> List.iter (sub.pat sub) l
+  | Tpat_variant (_, po, _) -> Option.iter (sub.pat sub) po
+  | Tpat_record (l, _) -> List.iter (fun (_, _, i) -> sub.pat sub i) l
+  | Tpat_array l -> List.iter (sub.pat sub) l
+  | Tpat_alias (p, _, _) -> sub.pat sub p
+  | Tpat_lazy p -> sub.pat sub p
+  | Tpat_value p -> sub.pat sub (p :> pattern)
+  | Tpat_exception p -> sub.pat sub p
+  | Tpat_or (p1, p2, _) ->
+      sub.pat sub p1;
+      sub.pat sub p2
+
+let expr sub {exp_extra; exp_desc; exp_env; _} =
+  let extra = function
+    | Texp_constraint cty -> sub.typ sub cty
+    | Texp_coerce (cty1, cty2) ->
+        Option.iter (sub.typ sub) cty1;
+        sub.typ sub cty2
+    | Texp_newtype _ -> ()
+    | Texp_poly cto -> Option.iter (sub.typ sub) cto
+  in
+  List.iter (fun (e, _, _) -> extra e) exp_extra;
+  sub.env sub exp_env;
+  match exp_desc with
+  | Texp_ident _  -> ()
+  | Texp_constant _ -> ()
+  | Texp_let (rec_flag, list, exp) ->
+      sub.value_bindings sub (rec_flag, list);
+      sub.expr sub exp
+  | Texp_function {cases; _} ->
+     List.iter (sub.case sub) cases
+  | Texp_apply (exp, list) ->
+      sub.expr sub exp;
+      List.iter (fun (_, o) -> Option.iter (sub.expr sub) o) list
+  | Texp_match (exp, cases, _) ->
+      sub.expr sub exp;
+      List.iter (sub.case sub) cases
+  | Texp_try (exp, cases) ->
+      sub.expr sub exp;
+      List.iter (sub.case sub) cases
+  | Texp_tuple list -> List.iter (sub.expr sub) list
+  | Texp_construct (_, _, args) -> List.iter (sub.expr sub) args
+  | Texp_variant (_, expo) -> Option.iter (sub.expr sub) expo
+  | Texp_record { fields; extended_expression; _} ->
+      Array.iter (function
+        | _, Kept _ -> ()
+        | _, Overridden (_, exp) -> sub.expr sub exp)
+        fields;
+      Option.iter (sub.expr sub) extended_expression;
+  | Texp_field (exp, _, _) -> sub.expr sub exp
+  | Texp_setfield (exp1, _, _, exp2) ->
+      sub.expr sub exp1;
+      sub.expr sub exp2
+  | Texp_array list -> List.iter (sub.expr sub) list
+  | Texp_ifthenelse (exp1, exp2, expo) ->
+      sub.expr sub exp1;
+      sub.expr sub exp2;
+      Option.iter (sub.expr sub) expo
+  | Texp_sequence (exp1, exp2) ->
+      sub.expr sub exp1;
+      sub.expr sub exp2
+  | Texp_while (exp1, exp2) ->
+      sub.expr sub exp1;
+      sub.expr sub exp2
+  | Texp_for (_, _, exp1, exp2, _, exp3) ->
+      sub.expr sub exp1;
+      sub.expr sub exp2;
+      sub.expr sub exp3
+  | Texp_send (exp, _, expo) ->
+      sub.expr sub exp;
+      Option.iter (sub.expr sub) expo
+  | Texp_new _ -> ()
+  | Texp_instvar _ -> ()
+  | Texp_setinstvar (_, _, _, exp) ->sub.expr sub exp
+  | Texp_override (_, list) ->
+      List.iter (fun (_, _, e) -> sub.expr sub e) list
+  | Texp_letmodule (_, _, _, mexpr, exp) ->
+      sub.module_expr sub mexpr;
+      sub.expr sub exp
+  | Texp_letexception (cd, exp) ->
+      sub.extension_constructor sub cd;
+      sub.expr sub exp
+  | Texp_assert exp -> sub.expr sub exp
+  | Texp_lazy exp -> sub.expr sub exp
+  | Texp_object (cl, _) -> sub.class_structure sub cl
+  | Texp_pack mexpr -> sub.module_expr sub mexpr
+  | Texp_letop {let_ = l; ands; body; _} ->
+      sub.binding_op sub l;
+      List.iter (sub.binding_op sub) ands;
+      sub.case sub body
+  | Texp_unreachable -> ()
+  | Texp_extension_constructor _ -> ()
+  | Texp_open (od, e) ->
+      sub.open_declaration sub od;
+      sub.expr sub e
+
+
+let package_type sub {pack_fields; _} =
+  List.iter (fun (_, p) -> sub.typ sub p) pack_fields
+
+let binding_op sub {bop_exp; _} = sub.expr sub bop_exp
+
+let signature sub {sig_items; sig_final_env; _} =
+  sub.env sub sig_final_env;
+  List.iter (sub.signature_item sub) sig_items
+
+let signature_item sub {sig_desc; sig_env; _} =
+  sub.env sub sig_env;
+  match sig_desc with
+  | Tsig_value v -> sub.value_description sub v
+  | Tsig_type (rf, tdl)  -> sub.type_declarations sub (rf, tdl)
+  | Tsig_typesubst list -> sub.type_declarations sub (Nonrecursive, list)
+  | Tsig_typext te -> sub.type_extension sub te
+  | Tsig_exception ext -> sub.type_exception sub ext
+  | Tsig_module x -> sub.module_declaration sub x
+  | Tsig_modsubst x -> sub.module_substitution sub x
+  | Tsig_recmodule list -> List.iter (sub.module_declaration sub) list
+  | Tsig_modtype x -> sub.module_type_declaration sub x
+  | Tsig_include incl -> include_infos (sub.module_type sub) incl
+  | Tsig_class list -> List.iter (sub.class_description sub) list
+  | Tsig_class_type list -> List.iter (sub.class_type_declaration sub) list
+  | Tsig_open od -> sub.open_description sub od
+  | Tsig_attribute _ -> ()
+
+let class_description sub x =
+  class_infos sub (sub.class_type sub) x
+
+let functor_parameter sub = function
+  | Unit -> ()
+  | Named (_, _, mtype) -> sub.module_type sub mtype
+
+let module_type sub {mty_desc; mty_env; _} =
+  sub.env sub mty_env;
+  match mty_desc with
+  | Tmty_ident _      -> ()
+  | Tmty_alias _      -> ()
+  | Tmty_signature sg -> sub.signature sub sg
+  | Tmty_functor (arg, mtype2) ->
+      functor_parameter sub arg;
+      sub.module_type sub mtype2
+  | Tmty_with (mtype, list) ->
+      sub.module_type sub mtype;
+      List.iter (fun (_, _, e) -> sub.with_constraint sub e) list
+  | Tmty_typeof mexpr -> sub.module_expr sub mexpr
+
+let with_constraint sub = function
+  | Twith_type      decl -> sub.type_declaration sub decl
+  | Twith_typesubst decl -> sub.type_declaration sub decl
+  | Twith_module    _    -> ()
+  | Twith_modsubst  _    -> ()
+
+let open_description sub {open_env; _} = sub.env sub open_env
+
+let open_declaration sub {open_expr; open_env; _} =
+  sub.module_expr sub open_expr;
+  sub.env sub open_env
+
+let module_coercion sub = function
+  | Tcoerce_none -> ()
+  | Tcoerce_functor (c1,c2) ->
+      sub.module_coercion sub c1;
+      sub.module_coercion sub c2
+  | Tcoerce_alias (env, _, c1) ->
+      sub.env sub env;
+      sub.module_coercion sub c1
+  | Tcoerce_structure (l1, l2) ->
+      List.iter (fun (_, c) -> sub.module_coercion sub c) l1;
+      List.iter (fun (_, _ ,c) -> sub.module_coercion sub c) l2
+  | Tcoerce_primitive {pc_env; _} -> sub.env sub pc_env
+
+let module_expr sub {mod_desc; mod_env; _} =
+  sub.env sub mod_env;
+  match mod_desc with
+  | Tmod_ident _      -> ()
+  | Tmod_structure st -> sub.structure sub st
+  | Tmod_functor (arg, mexpr) ->
+      functor_parameter sub arg;
+      sub.module_expr sub mexpr
+  | Tmod_apply (mexp1, mexp2, c) ->
+      sub.module_expr sub mexp1;
+      sub.module_expr sub mexp2;
+      sub.module_coercion sub c
+  | Tmod_constraint (mexpr, _, Tmodtype_implicit, c) ->
+      sub.module_expr sub mexpr;
+      sub.module_coercion sub c
+  | Tmod_constraint (mexpr, _, Tmodtype_explicit mtype, c) ->
+      sub.module_expr sub mexpr;
+      sub.module_type sub mtype;
+      sub.module_coercion sub c
+  | Tmod_unpack (exp, _) -> sub.expr sub exp
+
+let module_binding sub {mb_expr; _} = sub.module_expr sub mb_expr
+
+let class_expr sub {cl_desc; cl_env; _} =
+  sub.env sub cl_env;
+  match cl_desc with
+  | Tcl_constraint (cl, clty, _, _, _) ->
+      sub.class_expr sub cl;
+      Option.iter (sub.class_type sub) clty
+  | Tcl_structure clstr -> sub.class_structure sub clstr
+  | Tcl_fun (_, pat, priv, cl, _) ->
+      sub.pat sub pat;
+      List.iter (fun (_, e) -> sub.expr sub e) priv;
+      sub.class_expr sub cl
+  | Tcl_apply (cl, args) ->
+      sub.class_expr sub cl;
+      List.iter (fun (_, e) -> Option.iter (sub.expr sub) e) args
+  | Tcl_let (rec_flag, value_bindings, ivars, cl) ->
+      sub.value_bindings sub (rec_flag, value_bindings);
+      List.iter (fun (_, e) -> sub.expr sub e) ivars;
+      sub.class_expr sub cl
+  | Tcl_ident (_, _, tyl) -> List.iter (sub.typ sub) tyl
+  | Tcl_open (od, e) ->
+      sub.open_description sub od;
+      sub.class_expr sub e
+
+let class_type sub {cltyp_desc; cltyp_env; _} =
+  sub.env sub cltyp_env;
+  match cltyp_desc with
+  | Tcty_signature csg -> sub.class_signature sub csg
+  | Tcty_constr (_, _, list) -> List.iter (sub.typ sub) list
+  | Tcty_arrow (_, ct, cl) ->
+      sub.typ sub ct;
+      sub.class_type sub cl
+  | Tcty_open (od, e) ->
+      sub.open_description sub od;
+      sub.class_type sub e
+
+let class_signature sub {csig_self; csig_fields; _} =
+  sub.typ sub csig_self;
+  List.iter (sub.class_type_field sub) csig_fields
+
+let class_type_field sub {ctf_desc; _} =
+  match ctf_desc with
+  | Tctf_inherit ct -> sub.class_type sub ct
+  | Tctf_val (_, _, _, ct) ->  sub.typ sub ct
+  | Tctf_method (_, _, _, ct) -> sub.typ sub ct
+  | Tctf_constraint  (ct1, ct2) ->
+      sub.typ sub ct1;
+      sub.typ sub ct2
+  | Tctf_attribute _ -> ()
+
+let typ sub {ctyp_desc; ctyp_env; _} =
+  sub.env sub ctyp_env;
+  match ctyp_desc with
+  | Ttyp_any   -> ()
+  | Ttyp_var _ -> ()
+  | Ttyp_arrow (_, ct1, ct2) ->
+      sub.typ sub ct1;
+      sub.typ sub ct2
+  | Ttyp_tuple list -> List.iter (sub.typ sub) list
+  | Ttyp_constr (_, _, list) ->  List.iter (sub.typ sub) list
+  | Ttyp_object (list, _) -> List.iter (sub.object_field sub) list
+  | Ttyp_class (_, _, list) -> List.iter (sub.typ sub) list
+  | Ttyp_alias (ct, _) -> sub.typ sub ct
+  | Ttyp_variant (list, _, _) -> List.iter (sub.row_field sub) list
+  | Ttyp_poly (_, ct) -> sub.typ sub ct
+  | Ttyp_package pack -> sub.package_type sub pack
+
+let class_structure sub {cstr_self; cstr_fields; _} =
+  sub.pat sub cstr_self;
+  List.iter (sub.class_field sub) cstr_fields
+
+let row_field sub {rf_desc; _} =
+  match rf_desc with
+  | Ttag (_, _, list) -> List.iter (sub.typ sub) list
+  | Tinherit ct -> sub.typ sub ct
+
+let object_field sub {of_desc; _} =
+  match of_desc with
+  | OTtag (_, ct) -> sub.typ sub ct
+  | OTinherit ct -> sub.typ sub ct
+
+let class_field_kind sub = function
+  | Tcfk_virtual ct -> sub.typ sub ct
+  | Tcfk_concrete (_, e) -> sub.expr sub e
+
+let class_field sub {cf_desc; _} = match cf_desc with
+  | Tcf_inherit (_, cl, _, _, _) -> sub.class_expr sub cl
+  | Tcf_constraint (cty1, cty2) ->
+      sub.typ sub cty1;
+      sub.typ sub cty2
+  | Tcf_val (_, _, _, k, _) -> class_field_kind sub k
+  | Tcf_method (_, _, k) -> class_field_kind sub k
+  | Tcf_initializer exp -> sub.expr sub exp
+  | Tcf_attribute _ -> ()
+
+let value_bindings sub (_, list) = List.iter (sub.value_binding sub) list
+
+let case sub {c_lhs; c_guard; c_rhs} =
+  sub.pat sub c_lhs;
+  Option.iter (sub.expr sub) c_guard;
+  sub.expr sub c_rhs
+
+let value_binding sub {vb_pat; vb_expr; _} =
+  sub.pat sub vb_pat;
+  sub.expr sub vb_expr
+
+let env _sub _ = ()
+
+let default_iterator =
+  {
+    binding_op;
+    case;
+    class_declaration;
+    class_description;
+    class_expr;
+    class_field;
+    class_signature;
+    class_structure;
+    class_type;
+    class_type_declaration;
+    class_type_field;
+    env;
+    expr;
+    extension_constructor;
+    module_binding;
+    module_coercion;
+    module_declaration;
+    module_substitution;
+    module_expr;
+    module_type;
+    module_type_declaration;
+    package_type;
+    pat;
+    row_field;
+    object_field;
+    open_declaration;
+    open_description;
+    signature;
+    signature_item;
+    structure;
+    structure_item;
+    typ;
+    type_declaration;
+    type_declarations;
+    type_extension;
+    type_exception;
+    type_kind;
+    value_binding;
+    value_bindings;
+    value_description;
+    with_constraint;
+  }
diff --git a/typing/tast_iterator.mli b/typing/tast_iterator.mli
new file mode 100644
index 00000000..e126128e
--- /dev/null
+++ b/typing/tast_iterator.mli
@@ -0,0 +1,68 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                           Isaac "Izzy" Avram                           *)
+(*                                                                        *)
+(*   Copyright 2019 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(**
+Allows the implementation of typed tree inspection using open recursion
+*)
+
+open Asttypes
+open Typedtree
+
+type iterator =
+  {
+    binding_op: iterator -> binding_op -> unit;
+    case: 'k . iterator -> 'k case -> unit;
+    class_declaration: iterator -> class_declaration -> unit;
+    class_description: iterator -> class_description -> unit;
+    class_expr: iterator -> class_expr -> unit;
+    class_field: iterator -> class_field -> unit;
+    class_signature: iterator -> class_signature -> unit;
+    class_structure: iterator -> class_structure -> unit;
+    class_type: iterator -> class_type -> unit;
+    class_type_declaration: iterator -> class_type_declaration -> unit;
+    class_type_field: iterator -> class_type_field -> unit;
+    env: iterator -> Env.t -> unit;
+    expr: iterator -> expression -> unit;
+    extension_constructor: iterator -> extension_constructor -> unit;
+    module_binding: iterator -> module_binding -> unit;
+    module_coercion: iterator -> module_coercion -> unit;
+    module_declaration: iterator -> module_declaration -> unit;
+    module_substitution: iterator -> module_substitution -> unit;
+    module_expr: iterator -> module_expr -> unit;
+    module_type: iterator -> module_type -> unit;
+    module_type_declaration: iterator -> module_type_declaration -> unit;
+    package_type: iterator -> package_type -> unit;
+    pat: 'k . iterator -> 'k general_pattern -> unit;
+    row_field: iterator -> row_field -> unit;
+    object_field: iterator -> object_field -> unit;
+    open_declaration: iterator -> open_declaration -> unit;
+    open_description: iterator -> open_description -> unit;
+    signature: iterator -> signature -> unit;
+    signature_item: iterator -> signature_item -> unit;
+    structure: iterator -> structure -> unit;
+    structure_item: iterator -> structure_item -> unit;
+    typ: iterator -> core_type -> unit;
+    type_declaration: iterator -> type_declaration -> unit;
+    type_declarations: iterator -> (rec_flag * type_declaration list) -> unit;
+    type_extension: iterator -> type_extension -> unit;
+    type_exception: iterator -> type_exception -> unit;
+    type_kind: iterator -> type_kind -> unit;
+    value_binding: iterator -> value_binding -> unit;
+    value_bindings: iterator -> (rec_flag * value_binding list) -> unit;
+    value_description: iterator -> value_description -> unit;
+    with_constraint: iterator -> with_constraint -> unit;
+  }
+
+val default_iterator: iterator
diff --git a/typing/tast_mapper.ml b/typing/tast_mapper.ml
new file mode 100644
index 00000000..d8ceee1d
--- /dev/null
+++ b/typing/tast_mapper.ml
@@ -0,0 +1,744 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                        Alain Frisch, LexiFi                            *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Asttypes
+open Typedtree
+
+(* TODO: add 'methods' for location, attribute, extension,
+   include_declaration, include_description *)
+
+type mapper =
+  {
+    binding_op: mapper -> binding_op -> binding_op;
+    case: 'k . mapper -> 'k case -> 'k case;
+    class_declaration: mapper -> class_declaration -> class_declaration;
+    class_description: mapper -> class_description -> class_description;
+    class_expr: mapper -> class_expr -> class_expr;
+    class_field: mapper -> class_field -> class_field;
+    class_signature: mapper -> class_signature -> class_signature;
+    class_structure: mapper -> class_structure -> class_structure;
+    class_type: mapper -> class_type -> class_type;
+    class_type_declaration: mapper -> class_type_declaration ->
+      class_type_declaration;
+    class_type_field: mapper -> class_type_field -> class_type_field;
+    env: mapper -> Env.t -> Env.t;
+    expr: mapper -> expression -> expression;
+    extension_constructor: mapper -> extension_constructor ->
+      extension_constructor;
+    module_binding: mapper -> module_binding -> module_binding;
+    module_coercion: mapper -> module_coercion -> module_coercion;
+    module_declaration: mapper -> module_declaration -> module_declaration;
+    module_substitution: mapper -> module_substitution -> module_substitution;
+    module_expr: mapper -> module_expr -> module_expr;
+    module_type: mapper -> module_type -> module_type;
+    module_type_declaration:
+      mapper -> module_type_declaration -> module_type_declaration;
+    package_type: mapper -> package_type -> package_type;
+    pat: 'k . mapper -> 'k general_pattern -> 'k general_pattern;
+    row_field: mapper -> row_field -> row_field;
+    object_field: mapper -> object_field -> object_field;
+    open_declaration: mapper -> open_declaration -> open_declaration;
+    open_description: mapper -> open_description -> open_description;
+    signature: mapper -> signature -> signature;
+    signature_item: mapper -> signature_item -> signature_item;
+    structure: mapper -> structure -> structure;
+    structure_item: mapper -> structure_item -> structure_item;
+    typ: mapper -> core_type -> core_type;
+    type_declaration: mapper -> type_declaration -> type_declaration;
+    type_declarations: mapper -> (rec_flag * type_declaration list)
+      -> (rec_flag * type_declaration list);
+    type_extension: mapper -> type_extension -> type_extension;
+    type_exception: mapper -> type_exception -> type_exception;
+    type_kind: mapper -> type_kind -> type_kind;
+    value_binding: mapper -> value_binding -> value_binding;
+    value_bindings: mapper -> (rec_flag * value_binding list) ->
+      (rec_flag * value_binding list);
+    value_description: mapper -> value_description -> value_description;
+    with_constraint: mapper -> with_constraint -> with_constraint;
+  }
+
+let id x = x
+let tuple2 f1 f2 (x, y) = (f1 x, f2 y)
+let tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
+
+let structure sub {str_items; str_type; str_final_env} =
+  {
+    str_items = List.map (sub.structure_item sub) str_items;
+    str_final_env = sub.env sub str_final_env;
+    str_type;
+  }
+
+let class_infos sub f x =
+  {x with
+   ci_params = List.map (tuple2 (sub.typ sub) id) x.ci_params;
+   ci_expr = f x.ci_expr;
+  }
+
+let module_type_declaration sub x =
+  let mtd_type = Option.map (sub.module_type sub) x.mtd_type in
+  {x with mtd_type}
+
+let module_declaration sub x =
+  let md_type = sub.module_type sub x.md_type in
+  {x with md_type}
+
+let module_substitution _ x = x
+
+let include_infos f x = {x with incl_mod = f x.incl_mod}
+
+let class_type_declaration sub x =
+  class_infos sub (sub.class_type sub) x
+
+let class_declaration sub x =
+  class_infos sub (sub.class_expr sub) x
+
+let structure_item sub {str_desc; str_loc; str_env} =
+  let str_env = sub.env sub str_env in
+  let str_desc =
+    match str_desc with
+    | Tstr_eval (exp, attrs) -> Tstr_eval (sub.expr sub exp, attrs)
+    | Tstr_value (rec_flag, list) ->
+        let (rec_flag, list) = sub.value_bindings sub (rec_flag, list) in
+        Tstr_value (rec_flag, list)
+    | Tstr_primitive v -> Tstr_primitive (sub.value_description sub v)
+    | Tstr_type (rec_flag, list) ->
+        let (rec_flag, list) = sub.type_declarations sub (rec_flag, list) in
+        Tstr_type (rec_flag, list)
+    | Tstr_typext te -> Tstr_typext (sub.type_extension sub te)
+    | Tstr_exception ext -> Tstr_exception (sub.type_exception sub ext)
+    | Tstr_module mb -> Tstr_module (sub.module_binding sub mb)
+    | Tstr_recmodule list ->
+        Tstr_recmodule (List.map (sub.module_binding sub) list)
+    | Tstr_modtype x -> Tstr_modtype (sub.module_type_declaration sub x)
+    | Tstr_class list ->
+        Tstr_class
+          (List.map (tuple2 (sub.class_declaration sub) id) list)
+    | Tstr_class_type list ->
+        Tstr_class_type
+          (List.map (tuple3 id id (sub.class_type_declaration sub)) list)
+    | Tstr_include incl ->
+        Tstr_include (include_infos (sub.module_expr sub) incl)
+    | Tstr_open od -> Tstr_open (sub.open_declaration sub od)
+    | Tstr_attribute _ as d -> d
+  in
+  {str_desc; str_env; str_loc}
+
+let value_description sub x =
+  let val_desc = sub.typ sub x.val_desc in
+  {x with val_desc}
+
+let label_decl sub x =
+  let ld_type = sub.typ sub x.ld_type in
+  {x with ld_type}
+
+let constructor_args sub = function
+  | Cstr_tuple l -> Cstr_tuple (List.map (sub.typ sub) l)
+  | Cstr_record l -> Cstr_record (List.map (label_decl sub) l)
+
+let constructor_decl sub cd =
+  let cd_args = constructor_args sub cd.cd_args in
+  let cd_res = Option.map (sub.typ sub) cd.cd_res in
+  {cd with cd_args; cd_res}
+
+let type_kind sub = function
+  | Ttype_abstract -> Ttype_abstract
+  | Ttype_variant list -> Ttype_variant (List.map (constructor_decl sub) list)
+  | Ttype_record list -> Ttype_record (List.map (label_decl sub) list)
+  | Ttype_open -> Ttype_open
+
+let type_declaration sub x =
+  let typ_cstrs =
+    List.map
+      (tuple3 (sub.typ sub) (sub.typ sub) id)
+      x.typ_cstrs
+  in
+  let typ_kind = sub.type_kind sub x.typ_kind in
+  let typ_manifest = Option.map (sub.typ sub) x.typ_manifest in
+  let typ_params = List.map (tuple2 (sub.typ sub) id) x.typ_params in
+  {x with typ_cstrs; typ_kind; typ_manifest; typ_params}
+
+let type_declarations sub (rec_flag, list) =
+  (rec_flag, List.map (sub.type_declaration sub) list)
+
+let type_extension sub x =
+  let tyext_params = List.map (tuple2 (sub.typ sub) id) x.tyext_params in
+  let tyext_constructors =
+    List.map (sub.extension_constructor sub) x.tyext_constructors
+  in
+  {x with tyext_constructors; tyext_params}
+
+let type_exception sub x =
+  let tyexn_constructor =
+    sub.extension_constructor sub x.tyexn_constructor
+  in
+  {x with tyexn_constructor}
+
+let extension_constructor sub x =
+  let ext_kind =
+    match x.ext_kind with
+      Text_decl(ctl, cto) ->
+        Text_decl(constructor_args sub ctl, Option.map (sub.typ sub) cto)
+    | Text_rebind _ as d -> d
+  in
+  {x with ext_kind}
+
+let pat_extra sub = function
+  | Tpat_type _
+  | Tpat_unpack as d -> d
+  | Tpat_open (path,loc,env) ->  Tpat_open (path, loc, sub.env sub env)
+  | Tpat_constraint ct -> Tpat_constraint (sub.typ sub ct)
+
+let pat
+  : type k . mapper -> k general_pattern -> k general_pattern
+  = fun sub x ->
+  let pat_env = sub.env sub x.pat_env in
+  let pat_extra = List.map (tuple3 (pat_extra sub) id id) x.pat_extra in
+  let pat_desc : k pattern_desc =
+    match x.pat_desc with
+    | Tpat_any
+    | Tpat_var _
+    | Tpat_constant _ -> x.pat_desc
+    | Tpat_tuple l -> Tpat_tuple (List.map (sub.pat sub) l)
+    | Tpat_construct (loc, cd, l) ->
+        Tpat_construct (loc, cd, List.map (sub.pat sub) l)
+    | Tpat_variant (l, po, rd) ->
+        Tpat_variant (l, Option.map (sub.pat sub) po, rd)
+    | Tpat_record (l, closed) ->
+        Tpat_record (List.map (tuple3 id id (sub.pat sub)) l, closed)
+    | Tpat_array l -> Tpat_array (List.map (sub.pat sub) l)
+    | Tpat_alias (p, id, s) -> Tpat_alias (sub.pat sub p, id, s)
+    | Tpat_lazy p -> Tpat_lazy (sub.pat sub p)
+    | Tpat_value p ->
+       (as_computation_pattern (sub.pat sub (p :> pattern))).pat_desc
+    | Tpat_exception p ->
+       Tpat_exception (sub.pat sub p)
+    | Tpat_or (p1, p2, rd) ->
+        Tpat_or (sub.pat sub p1, sub.pat sub p2, rd)
+  in
+  {x with pat_extra; pat_desc; pat_env}
+
+let expr sub x =
+  let extra = function
+    | Texp_constraint cty ->
+        Texp_constraint (sub.typ sub cty)
+    | Texp_coerce (cty1, cty2) ->
+        Texp_coerce (Option.map (sub.typ sub) cty1, sub.typ sub cty2)
+    | Texp_newtype _ as d -> d
+    | Texp_poly cto -> Texp_poly (Option.map (sub.typ sub) cto)
+  in
+  let exp_extra = List.map (tuple3 extra id id) x.exp_extra in
+  let exp_env = sub.env sub x.exp_env in
+  let exp_desc =
+    match x.exp_desc with
+    | Texp_ident _
+    | Texp_constant _ as d -> d
+    | Texp_let (rec_flag, list, exp) ->
+        let (rec_flag, list) = sub.value_bindings sub (rec_flag, list) in
+        Texp_let (rec_flag, list, sub.expr sub exp)
+    | Texp_function { arg_label; param; cases; partial; } ->
+        let cases = List.map (sub.case sub) cases in
+        Texp_function { arg_label; param; cases; partial; }
+    | Texp_apply (exp, list) ->
+        Texp_apply (
+          sub.expr sub exp,
+          List.map (tuple2 id (Option.map (sub.expr sub))) list
+        )
+    | Texp_match (exp, cases, p) ->
+        Texp_match (
+          sub.expr sub exp,
+          List.map (sub.case sub) cases,
+          p
+        )
+    | Texp_try (exp, cases) ->
+        Texp_try (
+          sub.expr sub exp,
+          List.map (sub.case sub) cases
+        )
+    | Texp_tuple list ->
+        Texp_tuple (List.map (sub.expr sub) list)
+    | Texp_construct (lid, cd, args) ->
+        Texp_construct (lid, cd, List.map (sub.expr sub) args)
+    | Texp_variant (l, expo) ->
+        Texp_variant (l, Option.map (sub.expr sub) expo)
+    | Texp_record { fields; representation; extended_expression } ->
+        let fields = Array.map (function
+            | label, Kept t -> label, Kept t
+            | label, Overridden (lid, exp) ->
+                label, Overridden (lid, sub.expr sub exp))
+            fields
+        in
+        Texp_record {
+          fields; representation;
+          extended_expression = Option.map (sub.expr sub) extended_expression;
+        }
+    | Texp_field (exp, lid, ld) ->
+        Texp_field (sub.expr sub exp, lid, ld)
+    | Texp_setfield (exp1, lid, ld, exp2) ->
+        Texp_setfield (
+          sub.expr sub exp1,
+          lid,
+          ld,
+          sub.expr sub exp2
+        )
+    | Texp_array list ->
+        Texp_array (List.map (sub.expr sub) list)
+    | Texp_ifthenelse (exp1, exp2, expo) ->
+        Texp_ifthenelse (
+          sub.expr sub exp1,
+          sub.expr sub exp2,
+          Option.map (sub.expr sub) expo
+        )
+    | Texp_sequence (exp1, exp2) ->
+        Texp_sequence (
+          sub.expr sub exp1,
+          sub.expr sub exp2
+        )
+    | Texp_while (exp1, exp2) ->
+        Texp_while (
+          sub.expr sub exp1,
+          sub.expr sub exp2
+        )
+    | Texp_for (id, p, exp1, exp2, dir, exp3) ->
+        Texp_for (
+          id,
+          p,
+          sub.expr sub exp1,
+          sub.expr sub exp2,
+          dir,
+          sub.expr sub exp3
+        )
+    | Texp_send (exp, meth, expo) ->
+        Texp_send
+          (
+            sub.expr sub exp,
+            meth,
+            Option.map (sub.expr sub) expo
+          )
+    | Texp_new _
+    | Texp_instvar _ as d -> d
+    | Texp_setinstvar (path1, path2, id, exp) ->
+        Texp_setinstvar (
+          path1,
+          path2,
+          id,
+          sub.expr sub exp
+        )
+    | Texp_override (path, list) ->
+        Texp_override (
+          path,
+          List.map (tuple3 id id (sub.expr sub)) list
+        )
+    | Texp_letmodule (id, s, pres, mexpr, exp) ->
+        Texp_letmodule (
+          id,
+          s,
+          pres,
+          sub.module_expr sub mexpr,
+          sub.expr sub exp
+        )
+    | Texp_letexception (cd, exp) ->
+        Texp_letexception (
+          sub.extension_constructor sub cd,
+          sub.expr sub exp
+        )
+    | Texp_assert exp ->
+        Texp_assert (sub.expr sub exp)
+    | Texp_lazy exp ->
+        Texp_lazy (sub.expr sub exp)
+    | Texp_object (cl, sl) ->
+        Texp_object (sub.class_structure sub cl, sl)
+    | Texp_pack mexpr ->
+        Texp_pack (sub.module_expr sub mexpr)
+    | Texp_letop {let_; ands; param; body; partial} ->
+        Texp_letop{
+          let_ = sub.binding_op sub let_;
+          ands = List.map (sub.binding_op sub) ands;
+          param;
+          body = sub.case sub body;
+          partial;
+        }
+    | Texp_unreachable ->
+        Texp_unreachable
+    | Texp_extension_constructor _ as e ->
+        e
+    | Texp_open (od, e) ->
+        Texp_open (sub.open_declaration sub od, sub.expr sub e)
+  in
+  {x with exp_extra; exp_desc; exp_env}
+
+
+let package_type sub x =
+  let pack_fields = List.map (tuple2 id (sub.typ sub)) x.pack_fields in
+  {x with pack_fields}
+
+let binding_op sub x =
+  { x with bop_exp = sub.expr sub x.bop_exp }
+
+let signature sub x =
+  let sig_final_env = sub.env sub x.sig_final_env in
+  let sig_items = List.map (sub.signature_item sub) x.sig_items in
+  {x with sig_items; sig_final_env}
+
+let signature_item sub x =
+  let sig_env = sub.env sub x.sig_env in
+  let sig_desc =
+    match x.sig_desc with
+    | Tsig_value v ->
+        Tsig_value (sub.value_description sub v)
+    | Tsig_type (rec_flag, list) ->
+        let (rec_flag, list) = sub.type_declarations sub (rec_flag, list) in
+        Tsig_type (rec_flag, list)
+    | Tsig_typesubst list ->
+        let (_, list) = sub.type_declarations sub (Nonrecursive, list) in
+        Tsig_typesubst list
+    | Tsig_typext te ->
+        Tsig_typext (sub.type_extension sub te)
+    | Tsig_exception ext ->
+        Tsig_exception (sub.type_exception sub ext)
+    | Tsig_module x ->
+        Tsig_module (sub.module_declaration sub x)
+    | Tsig_modsubst x ->
+        Tsig_modsubst (sub.module_substitution sub x)
+    | Tsig_recmodule list ->
+        Tsig_recmodule (List.map (sub.module_declaration sub) list)
+    | Tsig_modtype x ->
+        Tsig_modtype (sub.module_type_declaration sub x)
+    | Tsig_include incl ->
+        Tsig_include (include_infos (sub.module_type sub) incl)
+    | Tsig_class list ->
+        Tsig_class (List.map (sub.class_description sub) list)
+    | Tsig_class_type list ->
+        Tsig_class_type
+          (List.map (sub.class_type_declaration sub) list)
+    | Tsig_open od -> Tsig_open (sub.open_description sub od)
+    | Tsig_attribute _ as d -> d
+  in
+  {x with sig_desc; sig_env}
+
+let class_description sub x =
+  class_infos sub (sub.class_type sub) x
+
+let functor_parameter sub = function
+  | Unit -> Unit
+  | Named (id, s, mtype) -> Named (id, s, sub.module_type sub mtype)
+
+let module_type sub x =
+  let mty_env = sub.env sub x.mty_env in
+  let mty_desc =
+    match x.mty_desc with
+    | Tmty_ident _
+    | Tmty_alias _ as d -> d
+    | Tmty_signature sg -> Tmty_signature (sub.signature sub sg)
+    | Tmty_functor (arg, mtype2) ->
+        Tmty_functor (functor_parameter sub arg, sub.module_type sub mtype2)
+    | Tmty_with (mtype, list) ->
+        Tmty_with (
+          sub.module_type sub mtype,
+          List.map (tuple3 id id (sub.with_constraint sub)) list
+        )
+    | Tmty_typeof mexpr ->
+        Tmty_typeof (sub.module_expr sub mexpr)
+  in
+  {x with mty_desc; mty_env}
+
+let with_constraint sub = function
+  | Twith_type decl -> Twith_type (sub.type_declaration sub decl)
+  | Twith_typesubst decl -> Twith_typesubst (sub.type_declaration sub decl)
+  | Twith_module _
+  | Twith_modsubst _ as d -> d
+
+let open_description sub od =
+  {od with open_env = sub.env sub od.open_env}
+
+let open_declaration sub od =
+  {od with open_expr = sub.module_expr sub od.open_expr;
+           open_env = sub.env sub od.open_env}
+
+let module_coercion sub = function
+  | Tcoerce_none -> Tcoerce_none
+  | Tcoerce_functor (c1,c2) ->
+      Tcoerce_functor (sub.module_coercion sub c1, sub.module_coercion sub c2)
+  | Tcoerce_alias (env, p, c1) ->
+      Tcoerce_alias (sub.env sub env, p, sub.module_coercion sub c1)
+  | Tcoerce_structure (l1, l2) ->
+      let l1' = List.map (fun (i,c) -> i, sub.module_coercion sub c) l1 in
+      let l2' =
+        List.map (fun (id,i,c) -> id, i, sub.module_coercion sub c) l2
+      in
+      Tcoerce_structure (l1', l2')
+  | Tcoerce_primitive pc ->
+      Tcoerce_primitive {pc with pc_env = sub.env sub pc.pc_env}
+
+let module_expr sub x =
+  let mod_env = sub.env sub x.mod_env in
+  let mod_desc =
+    match x.mod_desc with
+    | Tmod_ident _ as d -> d
+    | Tmod_structure st -> Tmod_structure (sub.structure sub st)
+    | Tmod_functor (arg, mexpr) ->
+        Tmod_functor (functor_parameter sub arg, sub.module_expr sub mexpr)
+    | Tmod_apply (mexp1, mexp2, c) ->
+        Tmod_apply (
+          sub.module_expr sub mexp1,
+          sub.module_expr sub mexp2,
+          sub.module_coercion sub c
+        )
+    | Tmod_constraint (mexpr, mt, Tmodtype_implicit, c) ->
+        Tmod_constraint (sub.module_expr sub mexpr, mt, Tmodtype_implicit,
+                         sub.module_coercion sub c)
+    | Tmod_constraint (mexpr, mt, Tmodtype_explicit mtype, c) ->
+        Tmod_constraint (
+          sub.module_expr sub mexpr,
+          mt,
+          Tmodtype_explicit (sub.module_type sub mtype),
+          sub.module_coercion sub c
+        )
+    | Tmod_unpack (exp, mty) ->
+        Tmod_unpack
+          (
+            sub.expr sub exp,
+            mty
+          )
+  in
+  {x with mod_desc; mod_env}
+
+let module_binding sub x =
+  let mb_expr = sub.module_expr sub x.mb_expr in
+  {x with mb_expr}
+
+let class_expr sub x =
+  let cl_env = sub.env sub x.cl_env in
+  let cl_desc =
+    match x.cl_desc with
+    | Tcl_constraint (cl, clty, vals, meths, concrs) ->
+        Tcl_constraint (
+          sub.class_expr sub cl,
+          Option.map (sub.class_type sub) clty,
+          vals,
+          meths,
+          concrs
+        )
+    | Tcl_structure clstr ->
+        Tcl_structure (sub.class_structure sub clstr)
+    | Tcl_fun (label, pat, priv, cl, partial) ->
+        Tcl_fun (
+          label,
+          sub.pat sub pat,
+          List.map (tuple2 id (sub.expr sub)) priv,
+          sub.class_expr sub cl,
+          partial
+        )
+    | Tcl_apply (cl, args) ->
+        Tcl_apply (
+          sub.class_expr sub cl,
+          List.map (tuple2 id (Option.map (sub.expr sub))) args
+        )
+    | Tcl_let (rec_flag, value_bindings, ivars, cl) ->
+        let (rec_flag, value_bindings) =
+          sub.value_bindings sub (rec_flag, value_bindings)
+        in
+        Tcl_let (
+          rec_flag,
+          value_bindings,
+          List.map (tuple2 id (sub.expr sub)) ivars,
+          sub.class_expr sub cl
+        )
+    | Tcl_ident (path, lid, tyl) ->
+        Tcl_ident (path, lid, List.map (sub.typ sub) tyl)
+    | Tcl_open (od, e) ->
+        Tcl_open (sub.open_description sub od, sub.class_expr sub e)
+  in
+  {x with cl_desc; cl_env}
+
+let class_type sub x =
+  let cltyp_env = sub.env sub x.cltyp_env in
+  let cltyp_desc =
+    match x.cltyp_desc with
+    | Tcty_signature csg -> Tcty_signature (sub.class_signature sub csg)
+    | Tcty_constr (path, lid, list) ->
+        Tcty_constr (
+          path,
+          lid,
+          List.map (sub.typ sub) list
+        )
+    | Tcty_arrow (label, ct, cl) ->
+        Tcty_arrow
+          (label,
+           sub.typ sub ct,
+           sub.class_type sub cl
+          )
+    | Tcty_open (od, e) ->
+        Tcty_open (sub.open_description sub od, sub.class_type sub e)
+  in
+  {x with cltyp_desc; cltyp_env}
+
+let class_signature sub x =
+  let csig_self = sub.typ sub x.csig_self in
+  let csig_fields = List.map (sub.class_type_field sub) x.csig_fields in
+  {x with csig_self; csig_fields}
+
+let class_type_field sub x =
+  let ctf_desc =
+    match x.ctf_desc with
+    | Tctf_inherit ct ->
+        Tctf_inherit (sub.class_type sub ct)
+    | Tctf_val (s, mut, virt, ct) ->
+        Tctf_val (s, mut, virt, sub.typ sub ct)
+    | Tctf_method (s, priv, virt, ct) ->
+        Tctf_method (s, priv, virt, sub.typ sub ct)
+    | Tctf_constraint  (ct1, ct2) ->
+        Tctf_constraint (sub.typ sub ct1, sub.typ sub ct2)
+    | Tctf_attribute _ as d -> d
+  in
+  {x with ctf_desc}
+
+let typ sub x =
+  let ctyp_env = sub.env sub x.ctyp_env in
+  let ctyp_desc =
+    match x.ctyp_desc with
+    | Ttyp_any
+    | Ttyp_var _ as d -> d
+    | Ttyp_arrow (label, ct1, ct2) ->
+        Ttyp_arrow (label, sub.typ sub ct1, sub.typ sub ct2)
+    | Ttyp_tuple list -> Ttyp_tuple (List.map (sub.typ sub) list)
+    | Ttyp_constr (path, lid, list) ->
+        Ttyp_constr (path, lid, List.map (sub.typ sub) list)
+    | Ttyp_object (list, closed) ->
+        Ttyp_object ((List.map (sub.object_field sub) list), closed)
+    | Ttyp_class (path, lid, list) ->
+        Ttyp_class
+          (path,
+           lid,
+           List.map (sub.typ sub) list
+          )
+    | Ttyp_alias (ct, s) ->
+        Ttyp_alias (sub.typ sub ct, s)
+    | Ttyp_variant (list, closed, labels) ->
+        Ttyp_variant (List.map (sub.row_field sub) list, closed, labels)
+    | Ttyp_poly (sl, ct) ->
+        Ttyp_poly (sl, sub.typ sub ct)
+    | Ttyp_package pack ->
+        Ttyp_package (sub.package_type sub pack)
+  in
+  {x with ctyp_desc; ctyp_env}
+
+let class_structure sub x =
+  let cstr_self = sub.pat sub x.cstr_self in
+  let cstr_fields = List.map (sub.class_field sub) x.cstr_fields in
+  {x with cstr_self; cstr_fields}
+
+let row_field sub x =
+  let rf_desc = match x.rf_desc with
+    | Ttag (label, b, list) ->
+        Ttag (label, b, List.map (sub.typ sub) list)
+    | Tinherit ct -> Tinherit (sub.typ sub ct)
+  in
+  { x with rf_desc; }
+
+let object_field sub x =
+  let of_desc = match x.of_desc with
+    | OTtag (label, ct) ->
+        OTtag (label, (sub.typ sub ct))
+    | OTinherit ct -> OTinherit (sub.typ sub ct)
+  in
+  { x with of_desc; }
+
+let class_field_kind sub = function
+  | Tcfk_virtual ct -> Tcfk_virtual (sub.typ sub ct)
+  | Tcfk_concrete (ovf, e) -> Tcfk_concrete (ovf, sub.expr sub e)
+
+let class_field sub x =
+  let cf_desc =
+    match x.cf_desc with
+    | Tcf_inherit (ovf, cl, super, vals, meths) ->
+        Tcf_inherit (ovf, sub.class_expr sub cl, super, vals, meths)
+    | Tcf_constraint (cty, cty') ->
+        Tcf_constraint (
+          sub.typ sub cty,
+          sub.typ sub cty'
+        )
+    | Tcf_val (s, mf, id, k, b) ->
+        Tcf_val (s, mf, id, class_field_kind sub k, b)
+    | Tcf_method (s, priv, k) ->
+        Tcf_method (s, priv, class_field_kind sub k)
+    | Tcf_initializer exp ->
+        Tcf_initializer (sub.expr sub exp)
+    | Tcf_attribute _ as d -> d
+  in
+  {x with cf_desc}
+
+let value_bindings sub (rec_flag, list) =
+  (rec_flag, List.map (sub.value_binding sub) list)
+
+let case
+  : type k . mapper -> k case -> k case
+  = fun sub {c_lhs; c_guard; c_rhs} ->
+  {
+    c_lhs = sub.pat sub c_lhs;
+    c_guard = Option.map (sub.expr sub) c_guard;
+    c_rhs = sub.expr sub c_rhs;
+  }
+
+let value_binding sub x =
+  let vb_pat = sub.pat sub x.vb_pat in
+  let vb_expr = sub.expr sub x.vb_expr in
+  {x with vb_pat; vb_expr}
+
+let env _sub x = x
+
+let default =
+  {
+    binding_op;
+    case;
+    class_declaration;
+    class_description;
+    class_expr;
+    class_field;
+    class_signature;
+    class_structure;
+    class_type;
+    class_type_declaration;
+    class_type_field;
+    env;
+    expr;
+    extension_constructor;
+    module_binding;
+    module_coercion;
+    module_declaration;
+    module_substitution;
+    module_expr;
+    module_type;
+    module_type_declaration;
+    package_type;
+    pat;
+    row_field;
+    object_field;
+    open_declaration;
+    open_description;
+    signature;
+    signature_item;
+    structure;
+    structure_item;
+    typ;
+    type_declaration;
+    type_declarations;
+    type_extension;
+    type_exception;
+    type_kind;
+    value_binding;
+    value_bindings;
+    value_description;
+    with_constraint;
+  }
diff --git a/typing/tast_mapper.mli b/typing/tast_mapper.mli
new file mode 100644
index 00000000..ea6543d0
--- /dev/null
+++ b/typing/tast_mapper.mli
@@ -0,0 +1,72 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                        Alain Frisch, LexiFi                            *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Asttypes
+open Typedtree
+
+(** {1 A generic Typedtree mapper} *)
+
+type mapper =
+  {
+    binding_op: mapper -> binding_op -> binding_op;
+    case: 'k . mapper -> 'k case -> 'k case;
+    class_declaration: mapper -> class_declaration -> class_declaration;
+    class_description: mapper -> class_description -> class_description;
+    class_expr: mapper -> class_expr -> class_expr;
+    class_field: mapper -> class_field -> class_field;
+    class_signature: mapper -> class_signature -> class_signature;
+    class_structure: mapper -> class_structure -> class_structure;
+    class_type: mapper -> class_type -> class_type;
+    class_type_declaration: mapper -> class_type_declaration ->
+      class_type_declaration;
+    class_type_field: mapper -> class_type_field -> class_type_field;
+    env: mapper -> Env.t -> Env.t;
+    expr: mapper -> expression -> expression;
+    extension_constructor: mapper -> extension_constructor ->
+      extension_constructor;
+    module_binding: mapper -> module_binding -> module_binding;
+    module_coercion: mapper -> module_coercion -> module_coercion;
+    module_declaration: mapper -> module_declaration -> module_declaration;
+    module_substitution: mapper -> module_substitution -> module_substitution;
+    module_expr: mapper -> module_expr -> module_expr;
+    module_type: mapper -> module_type -> module_type;
+    module_type_declaration:
+      mapper -> module_type_declaration -> module_type_declaration;
+    package_type: mapper -> package_type -> package_type;
+    pat: 'k . mapper -> 'k general_pattern -> 'k general_pattern;
+    row_field: mapper -> row_field -> row_field;
+    object_field: mapper -> object_field -> object_field;
+    open_declaration: mapper -> open_declaration -> open_declaration;
+    open_description: mapper -> open_description -> open_description;
+    signature: mapper -> signature -> signature;
+    signature_item: mapper -> signature_item -> signature_item;
+    structure: mapper -> structure -> structure;
+    structure_item: mapper -> structure_item -> structure_item;
+    typ: mapper -> core_type -> core_type;
+    type_declaration: mapper -> type_declaration -> type_declaration;
+    type_declarations: mapper -> (rec_flag * type_declaration list)
+      -> (rec_flag * type_declaration list);
+    type_extension: mapper -> type_extension -> type_extension;
+    type_exception: mapper -> type_exception -> type_exception;
+    type_kind: mapper -> type_kind -> type_kind;
+    value_binding: mapper -> value_binding -> value_binding;
+    value_bindings: mapper -> (rec_flag * value_binding list) ->
+      (rec_flag * value_binding list);
+    value_description: mapper -> value_description -> value_description;
+    with_constraint: mapper -> with_constraint -> with_constraint;
+  }
+
+
+val default: mapper
diff --git a/typing/type_immediacy.ml b/typing/type_immediacy.ml
new file mode 100644
index 00000000..557ed427
--- /dev/null
+++ b/typing/type_immediacy.ml
@@ -0,0 +1,43 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Jeremie Dimino, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t =
+  | Unknown
+  | Always
+  | Always_on_64bits
+
+module Violation = struct
+  type t =
+    | Not_always_immediate
+    | Not_always_immediate_on_64bits
+end
+
+let coerce t ~as_ =
+  match t, as_ with
+  | _, Unknown
+  | Always, Always
+  | (Always | Always_on_64bits), Always_on_64bits -> Ok ()
+  | (Unknown | Always_on_64bits), Always ->
+      Error Violation.Not_always_immediate
+  | Unknown, Always_on_64bits ->
+      Error Violation.Not_always_immediate_on_64bits
+
+let of_attributes attrs =
+  match
+    Builtin_attributes.immediate attrs,
+    Builtin_attributes.immediate64 attrs
+  with
+  | true, _ -> Always
+  | false, true -> Always_on_64bits
+  | false, false -> Unknown
diff --git a/typing/type_immediacy.mli b/typing/type_immediacy.mli
new file mode 100644
index 00000000..3fc2e3b4
--- /dev/null
+++ b/typing/type_immediacy.mli
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Jeremie Dimino, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Immediacy status of a type *)
+
+type t =
+  | Unknown
+  (** We don't know anything *)
+  | Always
+  (** We know for sure that values of this type are always immediate *)
+  | Always_on_64bits
+  (** We know for sure that values of this type are always immediate
+      on 64 bit platforms. For other platforms, we know nothing. *)
+
+module Violation : sig
+  type t =
+    | Not_always_immediate
+    | Not_always_immediate_on_64bits
+end
+
+(** [coerce t ~as_] returns [Ok ()] iff [t] can be seen as type
+    immediacy [as_]. For instance, [Always] can be seen as
+    [Always_on_64bits] but the opposite is not true. Return [Error _]
+    if the coercion is not possible. *)
+val coerce : t -> as_:t -> (unit, Violation.t) result
+
+(** Return the immediateness of a type as indicated by the user via
+    attributes *)
+val of_attributes : Parsetree.attributes -> t
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
new file mode 100644
index 00000000..31d4bc89
--- /dev/null
+++ b/typing/typeclass.ml
@@ -0,0 +1,2062 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Parsetree
+open Asttypes
+open Path
+open Types
+open Typecore
+open Typetexp
+open Format
+
+type 'a class_info = {
+  cls_id : Ident.t;
+  cls_id_loc : string loc;
+  cls_decl : class_declaration;
+  cls_ty_id : Ident.t;
+  cls_ty_decl : class_type_declaration;
+  cls_obj_id : Ident.t;
+  cls_obj_abbr : type_declaration;
+  cls_typesharp_id : Ident.t;
+  cls_abbr : type_declaration;
+  cls_arity : int;
+  cls_pub_methods : string list;
+  cls_info : 'a;
+}
+
+type class_type_info = {
+  clsty_ty_id : Ident.t;
+  clsty_id_loc : string loc;
+  clsty_ty_decl : class_type_declaration;
+  clsty_obj_id : Ident.t;
+  clsty_obj_abbr : type_declaration;
+  clsty_typesharp_id : Ident.t;
+  clsty_abbr : type_declaration;
+  clsty_info : Typedtree.class_type_declaration;
+}
+
+type 'a full_class = {
+  id : Ident.t;
+  id_loc : tag loc;
+  clty: class_declaration;
+  ty_id: Ident.t;
+  cltydef: class_type_declaration;
+  obj_id: Ident.t;
+  obj_abbr: type_declaration;
+  cl_id: Ident.t;
+  cl_abbr: type_declaration;
+  arity: int;
+  pub_meths: string list;
+  coe: Warnings.loc list;
+  expr: 'a;
+  req: 'a Typedtree.class_infos;
+}
+
+type class_env = { val_env : Env.t; met_env : Env.t; par_env : Env.t }
+
+type error =
+    Unconsistent_constraint of Ctype.Unification_trace.t
+  | Field_type_mismatch of string * string * Ctype.Unification_trace.t
+  | Structure_expected of class_type
+  | Cannot_apply of class_type
+  | Apply_wrong_label of arg_label
+  | Pattern_type_clash of type_expr
+  | Repeated_parameter
+  | Unbound_class_2 of Longident.t
+  | Unbound_class_type_2 of Longident.t
+  | Abbrev_type_clash of type_expr * type_expr * type_expr
+  | Constructor_type_mismatch of string * Ctype.Unification_trace.t
+  | Virtual_class of bool * bool * string list * string list
+  | Parameter_arity_mismatch of Longident.t * int * int
+  | Parameter_mismatch of Ctype.Unification_trace.t
+  | Bad_parameters of Ident.t * type_expr * type_expr
+  | Class_match_failure of Ctype.class_match_failure list
+  | Unbound_val of string
+  | Unbound_type_var of (formatter -> unit) * Ctype.closed_class_failure
+  | Non_generalizable_class of Ident.t * Types.class_declaration
+  | Cannot_coerce_self of type_expr
+  | Non_collapsable_conjunction of
+      Ident.t * Types.class_declaration * Ctype.Unification_trace.t
+  | Final_self_clash of Ctype.Unification_trace.t
+  | Mutability_mismatch of string * mutable_flag
+  | No_overriding of string * string
+  | Duplicate of string * string
+  | Closing_self_type of type_expr
+
+exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
+
+open Typedtree
+
+let type_open_descr :
+  (?used_slot:bool ref -> Env.t -> Parsetree.open_description
+   -> open_description * Env.t) ref =
+  ref (fun ?used_slot:_ _ -> assert false)
+
+let ctyp desc typ env loc =
+  { ctyp_desc = desc; ctyp_type = typ; ctyp_loc = loc; ctyp_env = env;
+    ctyp_attributes = [] }
+
+                       (**********************)
+                       (*  Useful constants  *)
+                       (**********************)
+
+
+(*
+   Self type have a dummy private method, thus preventing it to become
+   closed.
+*)
+let dummy_method = Btype.dummy_method
+
+(*
+   Path associated to the temporary class type of a class being typed
+   (its constructor is not available).
+*)
+let unbound_class =
+  Path.Pident (Ident.create_local "*undef*")
+
+
+                (************************************)
+                (*  Some operations on class types  *)
+                (************************************)
+
+
+(* Fully expand the head of a class type *)
+let rec scrape_class_type =
+  function
+    Cty_constr (_, _, cty) -> scrape_class_type cty
+  | cty                     -> cty
+
+(* Generalize a class type *)
+let rec generalize_class_type gen =
+  function
+    Cty_constr (_, params, cty) ->
+      List.iter gen params;
+      generalize_class_type gen cty
+  | Cty_signature {csig_self = sty; csig_vars = vars; csig_inher = inher} ->
+      gen sty;
+      Vars.iter (fun _ (_, _, ty) -> gen ty) vars;
+      List.iter (fun (_,tl) -> List.iter gen tl) inher
+  | Cty_arrow (_, ty, cty) ->
+      gen ty;
+      generalize_class_type gen cty
+
+let generalize_class_type vars =
+  let gen = if vars then Ctype.generalize else Ctype.generalize_structure in
+  generalize_class_type gen
+
+(* Return the virtual methods of a class type *)
+let virtual_methods sign =
+  let (fields, _) =
+    Ctype.flatten_fields (Ctype.object_fields sign.Types.csig_self)
+  in
+  List.fold_left
+    (fun virt (lab, _, _) ->
+       if lab = dummy_method then virt else
+       if Concr.mem lab sign.csig_concr then virt else
+       lab::virt)
+    [] fields
+
+(* Return the constructor type associated to a class type *)
+let rec constructor_type constr cty =
+  match cty with
+    Cty_constr (_, _, cty) ->
+      constructor_type constr cty
+  | Cty_signature _ ->
+      constr
+  | Cty_arrow (l, ty, cty) ->
+      Ctype.newty (Tarrow (l, ty, constructor_type constr cty, Cok))
+
+let rec class_body cty =
+  match cty with
+    Cty_constr _ ->
+      cty (* Only class bodies can be abbreviated *)
+  | Cty_signature _ ->
+      cty
+  | Cty_arrow (_, _, cty) ->
+      class_body cty
+
+let extract_constraints cty =
+  let sign = Ctype.signature_of_class_type cty in
+  (Vars.fold (fun lab _ vars -> lab :: vars) sign.csig_vars [],
+   begin let (fields, _) =
+     Ctype.flatten_fields (Ctype.object_fields sign.csig_self)
+   in
+   List.fold_left
+     (fun meths (lab, _, _) ->
+        if lab = dummy_method then meths else lab::meths)
+     [] fields
+   end,
+   sign.csig_concr)
+
+let rec abbreviate_class_type path params cty =
+  match cty with
+    Cty_constr (_, _, _) | Cty_signature _ ->
+      Cty_constr (path, params, cty)
+  | Cty_arrow (l, ty, cty) ->
+      Cty_arrow (l, ty, abbreviate_class_type path params cty)
+
+(* Check that all type variables are generalizable *)
+(* Use Env.empty to prevent expansion of recursively defined object types;
+   cf. typing-poly/poly.ml *)
+let rec closed_class_type =
+  function
+    Cty_constr (_, params, _) ->
+      List.for_all (Ctype.closed_schema Env.empty) params
+  | Cty_signature sign ->
+      Ctype.closed_schema Env.empty sign.csig_self
+        &&
+      Vars.fold (fun _ (_, _, ty) cc -> Ctype.closed_schema Env.empty ty && cc)
+        sign.csig_vars
+        true
+  | Cty_arrow (_, ty, cty) ->
+      Ctype.closed_schema Env.empty ty
+        &&
+      closed_class_type cty
+
+let closed_class cty =
+  List.for_all (Ctype.closed_schema Env.empty) cty.cty_params
+    &&
+  closed_class_type cty.cty_type
+
+let rec limited_generalize rv =
+  function
+    Cty_constr (_path, params, cty) ->
+      List.iter (Ctype.limited_generalize rv) params;
+      limited_generalize rv cty
+  | Cty_signature sign ->
+      Ctype.limited_generalize rv sign.csig_self;
+      Vars.iter (fun _ (_, _, ty) -> Ctype.limited_generalize rv ty)
+        sign.csig_vars;
+      List.iter (fun (_, tl) -> List.iter (Ctype.limited_generalize rv) tl)
+        sign.csig_inher
+  | Cty_arrow (_, ty, cty) ->
+      Ctype.limited_generalize rv ty;
+      limited_generalize rv cty
+
+(* Record a class type *)
+let rc node =
+  Cmt_format.add_saved_type (Cmt_format.Partial_class_expr node);
+  node
+
+
+                (***********************************)
+                (*  Primitives for typing classes  *)
+                (***********************************)
+
+
+(* Enter a value in the method environment only *)
+let enter_met_env ?check loc lab kind unbound_kind ty class_env =
+  let {val_env; met_env; par_env} = class_env in
+  let val_env = Env.enter_unbound_value lab unbound_kind val_env in
+  let par_env = Env.enter_unbound_value lab unbound_kind par_env in
+  let (id, met_env) =
+    Env.enter_value ?check lab
+      {val_type = ty; val_kind = kind;
+       val_attributes = []; Types.val_loc = loc;
+       val_uid = Uid.mk ~current_unit:(Env.get_unit_name ()); } met_env
+  in
+  let class_env = {val_env; met_env; par_env} in
+  (id,class_env )
+
+(* Enter an instance variable in the environment *)
+let enter_val cl_num vars inh lab mut virt ty class_env loc =
+  let val_env = class_env.val_env in
+  let (id, virt) =
+    try
+      let (id, mut', virt', ty') = Vars.find lab !vars in
+      if mut' <> mut then
+        raise (Error(loc, val_env, Mutability_mismatch(lab, mut)));
+      Ctype.unify val_env (Ctype.instance ty) (Ctype.instance ty');
+      (if not inh then Some id else None),
+      (if virt' = Concrete then virt' else virt)
+    with
+      Ctype.Unify tr ->
+        raise (Error(loc, val_env,
+                     Field_type_mismatch("instance variable", lab, tr)))
+    | Not_found -> None, virt
+  in
+  let (id, _) as result =
+    match id with Some id -> (id, class_env)
+    | None ->
+        enter_met_env Location.none lab (Val_ivar (mut, cl_num))
+          Val_unbound_instance_variable ty class_env
+  in
+  vars := Vars.add lab (id, mut, virt, ty) !vars;
+  result
+
+let concr_vals vars =
+  Vars.fold
+    (fun id (_, vf, _) s -> if vf = Virtual then s else Concr.add id s)
+    vars Concr.empty
+
+let inheritance self_type env ovf concr_meths warn_vals loc parent =
+  match scrape_class_type parent with
+    Cty_signature cl_sig ->
+
+      (* Methods *)
+      begin try
+        Ctype.unify env self_type cl_sig.csig_self
+      with Ctype.Unify trace ->
+        let open Ctype.Unification_trace in
+        match trace with
+        | Diff _ :: Incompatible_fields {name = n; _ } :: rem ->
+            raise(Error(loc, env, Field_type_mismatch ("method", n, rem)))
+        | _ -> assert false
+      end;
+
+      (* Overriding *)
+      let over_meths = Concr.inter cl_sig.csig_concr concr_meths in
+      let concr_vals = concr_vals cl_sig.csig_vars in
+      let over_vals = Concr.inter concr_vals warn_vals in
+      begin match ovf with
+        Some Fresh ->
+          let cname =
+            match parent with
+              Cty_constr (p, _, _) -> Path.name p
+            | _ -> "inherited"
+          in
+          if not (Concr.is_empty over_meths) then
+            Location.prerr_warning loc
+              (Warnings.Method_override (cname :: Concr.elements over_meths));
+          if not (Concr.is_empty over_vals) then
+            Location.prerr_warning loc
+              (Warnings.Instance_variable_override
+                 (cname :: Concr.elements over_vals));
+      | Some Override
+        when Concr.is_empty over_meths && Concr.is_empty over_vals ->
+        raise (Error(loc, env, No_overriding ("","")))
+      | _ -> ()
+      end;
+
+      let concr_meths = Concr.union cl_sig.csig_concr concr_meths
+      and warn_vals = Concr.union concr_vals warn_vals in
+
+      (cl_sig, concr_meths, warn_vals)
+
+  | _ ->
+      raise(Error(loc, env, Structure_expected parent))
+
+let virtual_method val_env meths self_type lab priv sty loc =
+  let (_, ty') =
+     Ctype.filter_self_method val_env lab priv meths self_type
+  in
+  let sty = Ast_helper.Typ.force_poly sty in
+  let cty = transl_simple_type val_env false sty in
+  let ty = cty.ctyp_type in
+  begin
+    try Ctype.unify val_env ty ty' with Ctype.Unify trace ->
+        raise(Error(loc, val_env, Field_type_mismatch ("method", lab, trace)));
+  end;
+  cty
+
+let delayed_meth_specs = ref []
+
+let declare_method val_env meths self_type lab priv sty loc =
+  let (_, ty') =
+     Ctype.filter_self_method val_env lab priv meths self_type
+  in
+  let unif ty =
+    try Ctype.unify val_env ty ty' with Ctype.Unify trace ->
+      raise(Error(loc, val_env, Field_type_mismatch ("method", lab, trace)))
+  in
+  let sty = Ast_helper.Typ.force_poly sty in
+  match sty.ptyp_desc, priv with
+    Ptyp_poly ([],sty'), Public ->
+(* TODO: we moved the [transl_simple_type_univars] outside of the lazy,
+so that we can get an immediate value. Is that correct ? Ask Jacques. *)
+      let returned_cty = ctyp Ttyp_any (Ctype.newty Tnil) val_env loc in
+      delayed_meth_specs :=
+      Warnings.mk_lazy (fun () ->
+            let cty = transl_simple_type_univars val_env sty' in
+            let ty = cty.ctyp_type in
+            unif ty;
+            returned_cty.ctyp_desc <- Ttyp_poly ([], cty);
+            returned_cty.ctyp_type <- ty;
+          ) ::
+      !delayed_meth_specs;
+      returned_cty
+  | _ ->
+      let cty = transl_simple_type val_env false sty in
+      let ty = cty.ctyp_type in
+      unif ty;
+      cty
+
+let type_constraint val_env sty sty' loc =
+  let cty  = transl_simple_type val_env false sty in
+  let ty = cty.ctyp_type in
+  let cty' = transl_simple_type val_env false sty' in
+  let ty' = cty'.ctyp_type in
+  begin
+    try Ctype.unify val_env ty ty' with Ctype.Unify trace ->
+        raise(Error(loc, val_env, Unconsistent_constraint trace));
+  end;
+  (cty, cty')
+
+let make_method loc cl_num expr =
+  let open Ast_helper in
+  let mkid s = mkloc s loc in
+  Exp.fun_ ~loc:expr.pexp_loc Nolabel None
+    (Pat.alias ~loc (Pat.var ~loc (mkid "self-*")) (mkid ("self-" ^ cl_num)))
+    expr
+
+(*******************************)
+
+let add_val lab (mut, virt, ty) val_sig =
+  let virt =
+    try
+      let (_mut', virt', _ty') = Vars.find lab val_sig in
+      if virt' = Concrete then virt' else virt
+    with Not_found -> virt
+  in
+  Vars.add lab (mut, virt, ty) val_sig
+
+let rec class_type_field env self_type meths arg ctf =
+  Builtin_attributes.warning_scope ctf.pctf_attributes
+    (fun () -> class_type_field_aux env self_type meths arg ctf)
+
+and class_type_field_aux env self_type meths
+    (fields, val_sig, concr_meths, inher) ctf =
+
+  let loc = ctf.pctf_loc in
+  let mkctf desc =
+    { ctf_desc = desc; ctf_loc = loc; ctf_attributes = ctf.pctf_attributes }
+  in
+  match ctf.pctf_desc with
+    Pctf_inherit sparent ->
+      let parent = class_type env sparent in
+      let inher =
+        match parent.cltyp_type with
+          Cty_constr (p, tl, _) -> (p, tl) :: inher
+        | _ -> inher
+      in
+      let (cl_sig, concr_meths, _) =
+        inheritance self_type env None concr_meths Concr.empty sparent.pcty_loc
+          parent.cltyp_type
+      in
+      let val_sig =
+        Vars.fold add_val cl_sig.csig_vars val_sig in
+      (mkctf (Tctf_inherit parent) :: fields,
+       val_sig, concr_meths, inher)
+
+  | Pctf_val ({txt=lab}, mut, virt, sty) ->
+      let cty = transl_simple_type env false sty in
+      let ty = cty.ctyp_type in
+      (mkctf (Tctf_val (lab, mut, virt, cty)) :: fields,
+      add_val lab (mut, virt, ty) val_sig, concr_meths, inher)
+
+  | Pctf_method ({txt=lab}, priv, virt, sty)  ->
+      let cty =
+        declare_method env meths self_type lab priv sty  ctf.pctf_loc in
+      let concr_meths =
+        match virt with
+        | Concrete -> Concr.add lab concr_meths
+        | Virtual -> concr_meths
+      in
+      (mkctf (Tctf_method (lab, priv, virt, cty)) :: fields,
+        val_sig, concr_meths, inher)
+
+  | Pctf_constraint (sty, sty') ->
+      let (cty, cty') = type_constraint env sty sty'  ctf.pctf_loc in
+      (mkctf (Tctf_constraint (cty, cty')) :: fields,
+        val_sig, concr_meths, inher)
+
+  | Pctf_attribute x ->
+      Builtin_attributes.warning_attribute x;
+      (mkctf (Tctf_attribute x) :: fields,
+        val_sig, concr_meths, inher)
+
+  | Pctf_extension ext ->
+      raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+and class_signature env {pcsig_self=sty; pcsig_fields=sign} =
+  let meths = ref Meths.empty in
+  let self_cty = transl_simple_type env false sty in
+  let self_cty = { self_cty with
+    ctyp_type = Ctype.expand_head env self_cty.ctyp_type } in
+  let self_type =  self_cty.ctyp_type in
+
+  (* Check that the binder is a correct type, and introduce a dummy
+     method preventing self type from being closed. *)
+  let dummy_obj = Ctype.newvar () in
+  Ctype.unify env (Ctype.filter_method env dummy_method Private dummy_obj)
+    (Ctype.newty (Ttuple []));
+  begin try
+    Ctype.unify env self_type dummy_obj
+  with Ctype.Unify _ ->
+    raise(Error(sty.ptyp_loc, env, Pattern_type_clash self_type))
+  end;
+
+  (* Class type fields *)
+  let (rev_fields, val_sig, concr_meths, inher) =
+    Builtin_attributes.warning_scope []
+      (fun () ->
+         List.fold_left (class_type_field env self_type meths)
+           ([], Vars.empty, Concr.empty, [])
+           sign
+      )
+  in
+  let cty =   {csig_self = self_type;
+   csig_vars = val_sig;
+   csig_concr = concr_meths;
+   csig_inher = inher}
+  in
+  { csig_self = self_cty;
+    csig_fields = List.rev rev_fields;
+    csig_type = cty;
+  }
+
+and class_type env scty =
+  Builtin_attributes.warning_scope scty.pcty_attributes
+    (fun () -> class_type_aux env scty)
+
+and class_type_aux env scty =
+  let cltyp desc typ =
+    {
+     cltyp_desc = desc;
+     cltyp_type = typ;
+     cltyp_loc = scty.pcty_loc;
+     cltyp_env = env;
+     cltyp_attributes = scty.pcty_attributes;
+    }
+  in
+  match scty.pcty_desc with
+    Pcty_constr (lid, styl) ->
+      let (path, decl) = Env.lookup_cltype ~loc:scty.pcty_loc lid.txt env in
+      if Path.same decl.clty_path unbound_class then
+        raise(Error(scty.pcty_loc, env, Unbound_class_type_2 lid.txt));
+      let (params, clty) =
+        Ctype.instance_class decl.clty_params decl.clty_type
+      in
+      if List.length params <> List.length styl then
+        raise(Error(scty.pcty_loc, env,
+                    Parameter_arity_mismatch (lid.txt, List.length params,
+                                                   List.length styl)));
+      let ctys = List.map2
+        (fun sty ty ->
+          let cty' = transl_simple_type env false sty in
+          let ty' = cty'.ctyp_type in
+          begin
+           try Ctype.unify env ty' ty with Ctype.Unify trace ->
+                  raise(Error(sty.ptyp_loc, env, Parameter_mismatch trace))
+            end;
+            cty'
+        )       styl params
+      in
+      let typ = Cty_constr (path, params, clty) in
+      cltyp (Tcty_constr ( path, lid , ctys)) typ
+
+  | Pcty_signature pcsig ->
+      let clsig = class_signature env pcsig in
+      let typ = Cty_signature clsig.csig_type in
+      cltyp (Tcty_signature clsig) typ
+
+  | Pcty_arrow (l, sty, scty) ->
+      let cty = transl_simple_type env false sty in
+      let ty = cty.ctyp_type in
+      let ty =
+        if Btype.is_optional l
+        then Ctype.newty (Tconstr(Predef.path_option,[ty], ref Mnil))
+        else ty in
+      let clty = class_type env scty in
+      let typ = Cty_arrow (l, ty, clty.cltyp_type) in
+      cltyp (Tcty_arrow (l, cty, clty)) typ
+
+  | Pcty_open (od, e) ->
+      let (od, newenv) = !type_open_descr env od in
+      let clty = class_type newenv e in
+      cltyp (Tcty_open (od, clty)) clty.cltyp_type
+
+  | Pcty_extension ext ->
+      raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+let class_type env scty =
+  delayed_meth_specs := [];
+  let cty = class_type env scty in
+  List.iter Lazy.force (List.rev !delayed_meth_specs);
+  delayed_meth_specs := [];
+  cty
+
+(*******************************)
+
+let rec class_field self_loc cl_num self_type meths vars arg cf =
+  Builtin_attributes.warning_scope cf.pcf_attributes
+    (fun () -> class_field_aux self_loc cl_num self_type meths vars arg cf)
+
+and class_field_aux self_loc cl_num self_type meths vars
+    (class_env, fields, concr_meths, warn_vals, inher,
+     local_meths, local_vals) cf =
+  let loc = cf.pcf_loc in
+  let mkcf desc =
+    { cf_desc = desc; cf_loc = loc; cf_attributes = cf.pcf_attributes }
+  in
+  let {val_env; met_env; par_env} = class_env in
+  match cf.pcf_desc with
+    Pcf_inherit (ovf, sparent, super) ->
+      let parent = class_expr cl_num val_env par_env sparent in
+      let inher =
+        match parent.cl_type with
+          Cty_constr (p, tl, _) -> (p, tl) :: inher
+        | _ -> inher
+      in
+      let (cl_sig, concr_meths, warn_vals) =
+        inheritance self_type val_env (Some ovf) concr_meths warn_vals
+          sparent.pcl_loc parent.cl_type
+      in
+      (* Variables *)
+      let (class_env, inh_vars) =
+        Vars.fold
+          (fun lab info (class_env, inh_vars) ->
+             let mut, vr, ty = info in
+             let (id, class_env) =
+                enter_val cl_num vars true lab mut vr ty class_env
+                 sparent.pcl_loc ;
+             in
+             (class_env, (lab, id) :: inh_vars))
+          cl_sig.csig_vars (class_env, [])
+      in
+      (* Inherited concrete methods *)
+      let inh_meths =
+        Concr.fold (fun lab rem -> (lab, Ident.create_local lab)::rem)
+          cl_sig.csig_concr []
+      in
+      (* Super *)
+      let (class_env,super) =
+        match super with
+          None ->
+            (class_env,None)
+        | Some {txt=name} ->
+            let (_id, class_env) =
+              enter_met_env ~check:(fun s -> Warnings.Unused_ancestor s)
+                sparent.pcl_loc name (Val_anc (inh_meths, cl_num))
+                Val_unbound_ancestor self_type class_env
+            in
+            (class_env,Some name)
+      in
+      (class_env,
+       lazy (mkcf (Tcf_inherit (ovf, parent, super, inh_vars, inh_meths)))
+       :: fields,
+       concr_meths, warn_vals, inher, local_meths, local_vals)
+
+  | Pcf_val (lab, mut, Cfk_virtual styp) ->
+      if !Clflags.principal then Ctype.begin_def ();
+      let cty = Typetexp.transl_simple_type val_env false styp in
+      let ty = cty.ctyp_type in
+      if !Clflags.principal then begin
+        Ctype.end_def ();
+        Ctype.generalize_structure ty
+      end;
+      let (id, class_env') =
+        enter_val cl_num vars false lab.txt mut Virtual ty
+        class_env loc
+      in
+      (class_env',
+       lazy (mkcf (Tcf_val (lab, mut, id, Tcfk_virtual cty,
+                            met_env == class_env'.met_env)))
+             :: fields,
+             concr_meths, warn_vals, inher, local_meths, local_vals)
+
+  | Pcf_val (lab, mut, Cfk_concrete (ovf, sexp)) ->
+      if Concr.mem lab.txt local_vals then
+        raise(Error(loc, val_env, Duplicate ("instance variable", lab.txt)));
+      if Concr.mem lab.txt warn_vals then begin
+        if ovf = Fresh then
+          Location.prerr_warning lab.loc
+            (Warnings.Instance_variable_override[lab.txt])
+      end else begin
+        if ovf = Override then
+          raise(Error(loc, val_env,
+                      No_overriding ("instance variable", lab.txt)))
+      end;
+      if !Clflags.principal then Ctype.begin_def ();
+      let exp = type_exp val_env sexp in
+      if !Clflags.principal then begin
+        Ctype.end_def ();
+        Ctype.generalize_structure exp.exp_type
+       end;
+      let (id, class_env') =
+        enter_val cl_num vars false lab.txt mut Concrete exp.exp_type
+        class_env loc
+      in
+      (class_env',
+       lazy (mkcf (Tcf_val (lab, mut, id,
+                    Tcfk_concrete (ovf, exp), met_env == class_env'.met_env)))
+       :: fields,
+       concr_meths, Concr.add lab.txt warn_vals, inher, local_meths,
+       Concr.add lab.txt local_vals)
+
+  | Pcf_method (lab, priv, Cfk_virtual sty) ->
+      let cty = virtual_method val_env meths self_type lab.txt priv sty loc in
+      (class_env,
+        lazy (mkcf(Tcf_method (lab, priv, Tcfk_virtual cty)))
+       ::fields,
+        concr_meths, warn_vals, inher, local_meths, local_vals)
+
+  | Pcf_method (lab, priv, Cfk_concrete (ovf, expr))  ->
+      let expr =
+        match expr.pexp_desc with
+        | Pexp_poly _ -> expr
+        | _ -> Ast_helper.Exp.poly ~loc:expr.pexp_loc expr None
+      in
+      if Concr.mem lab.txt local_meths then
+        raise(Error(loc, val_env, Duplicate ("method", lab.txt)));
+      if Concr.mem lab.txt concr_meths then begin
+        if ovf = Fresh then
+          Location.prerr_warning loc (Warnings.Method_override [lab.txt])
+      end else begin
+        if ovf = Override then
+          raise(Error(loc, val_env, No_overriding("method", lab.txt)))
+      end;
+      let (_, ty) =
+        Ctype.filter_self_method val_env lab.txt priv meths self_type
+      in
+      begin try match expr.pexp_desc with
+        Pexp_poly (sbody, sty) ->
+          begin match sty with None -> ()
+                | Some sty ->
+                    let sty = Ast_helper.Typ.force_poly sty in
+                    let cty' = Typetexp.transl_simple_type val_env false sty in
+                    let ty' = cty'.ctyp_type in
+              Ctype.unify val_env ty' ty
+          end;
+          begin match (Ctype.repr ty).desc with
+            Tvar _ ->
+              let ty' = Ctype.newvar () in
+              Ctype.unify val_env (Ctype.newty (Tpoly (ty', []))) ty;
+              Ctype.unify val_env (type_approx val_env sbody) ty'
+          | Tpoly (ty1, tl) ->
+              let _, ty1' = Ctype.instance_poly false tl ty1 in
+              let ty2 = type_approx val_env sbody in
+              Ctype.unify val_env ty2 ty1'
+          | _ -> assert false
+          end
+      | _ -> assert false
+      with Ctype.Unify trace ->
+        raise(Error(loc, val_env,
+                    Field_type_mismatch ("method", lab.txt, trace)))
+      end;
+      let meth_expr = make_method self_loc cl_num expr in
+      (* backup variables for Pexp_override *)
+      let vars_local = !vars in
+
+      let field =
+        Warnings.mk_lazy
+          (fun () ->
+             (* Read the generalized type *)
+             let (_, ty) = Meths.find lab.txt !meths in
+             let meth_type = mk_expected (
+               Btype.newgenty (Tarrow(Nolabel, self_type, ty, Cok))
+             ) in
+             Ctype.raise_nongen_level ();
+             vars := vars_local;
+             let texp = type_expect met_env meth_expr meth_type in
+             Ctype.end_def ();
+             mkcf (Tcf_method (lab, priv, Tcfk_concrete (ovf, texp)))
+          )
+      in
+      (class_env, field::fields,
+       Concr.add lab.txt concr_meths, warn_vals, inher,
+       Concr.add lab.txt local_meths, local_vals)
+
+  | Pcf_constraint (sty, sty') ->
+      let (cty, cty') = type_constraint val_env sty sty' loc in
+      (class_env,
+        lazy (mkcf (Tcf_constraint (cty, cty'))) :: fields,
+        concr_meths, warn_vals, inher, local_meths, local_vals)
+
+  | Pcf_initializer expr ->
+      let expr = make_method self_loc cl_num expr in
+      let vars_local = !vars in
+      let field =
+        lazy begin
+          Ctype.raise_nongen_level ();
+          let meth_type = mk_expected (
+            Ctype.newty
+              (Tarrow (Nolabel, self_type,
+                       Ctype.instance Predef.type_unit, Cok))
+          ) in
+          vars := vars_local;
+          let texp = type_expect met_env expr meth_type in
+          Ctype.end_def ();
+          mkcf (Tcf_initializer texp)
+        end in
+      (class_env, field::fields, concr_meths, warn_vals,
+       inher, local_meths, local_vals)
+  | Pcf_attribute x ->
+      Builtin_attributes.warning_attribute x;
+      (class_env,
+        lazy (mkcf (Tcf_attribute x)) :: fields,
+        concr_meths, warn_vals, inher, local_meths, local_vals)
+  | Pcf_extension ext ->
+      raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+(* N.B. the self type of a final object type doesn't contain a dummy method in
+   the beginning.
+   We only explicitly add a dummy method to class definitions (and class (type)
+   declarations)), which are later removed (made absent) by [final_decl].
+
+   If we ever find a dummy method in a final object self type, it means that
+   somehow we've unified the self type of the object with the self type of a not
+   yet finished class.
+   When this happens, we cannot close the object type and must error. *)
+and class_structure cl_num final val_env met_env loc
+  { pcstr_self = spat; pcstr_fields = str } =
+  (* Environment for substructures *)
+  let par_env = met_env in
+
+  (* Location of self. Used for locations of self arguments *)
+  let self_loc = {spat.ppat_loc with Location.loc_ghost = true} in
+
+  let self_type = Ctype.newobj (Ctype.newvar ()) in
+
+  (* Adding a dummy method to the self type prevents it from being closed /
+     escaping.
+     That isn't needed for objects though. *)
+  if not final then
+    Ctype.unify val_env
+      (Ctype.filter_method val_env dummy_method Private self_type)
+      (Ctype.newty (Ttuple []));
+
+  (* Private self is used for private method calls *)
+  let private_self = if final then Ctype.newvar () else self_type in
+
+  (* Self binder *)
+  let (pat, meths, vars, val_env, met_env, par_env) =
+    type_self_pattern cl_num private_self val_env met_env par_env spat
+  in
+  let public_self = pat.pat_type in
+
+  (* Check that the binder has a correct type *)
+  let ty =
+    if final then Ctype.newobj (Ctype.newvar()) else self_type in
+  begin try Ctype.unify val_env public_self ty with
+    Ctype.Unify _ ->
+      raise(Error(spat.ppat_loc, val_env, Pattern_type_clash public_self))
+  end;
+  let get_methods ty =
+    (fst (Ctype.flatten_fields
+            (Ctype.object_fields (Ctype.expand_head val_env ty)))) in
+  if final then begin
+    (* Copy known information to still empty self_type *)
+    List.iter
+      (fun (lab,kind,ty) ->
+        let k =
+          if Btype.field_kind_repr kind = Fpresent then Public else Private in
+        try Ctype.unify val_env ty
+            (Ctype.filter_method val_env lab k self_type)
+        with _ -> assert false)
+      (get_methods public_self)
+  end;
+
+  (* Typing of class fields *)
+  let class_env = {val_env; met_env; par_env} in
+  let (_, fields, concr_meths, _, inher, _local_meths, _local_vals) =
+    Builtin_attributes.warning_scope []
+      (fun () ->
+         List.fold_left (class_field self_loc cl_num self_type meths vars)
+           ( class_env,[], Concr.empty, Concr.empty, [],
+            Concr.empty, Concr.empty)
+           str
+      )
+  in
+  Ctype.unify val_env self_type (Ctype.newvar ()); (* useless ? *)
+  let sign =
+    {csig_self = public_self;
+     csig_vars = Vars.map (fun (_id, mut, vr, ty) -> (mut, vr, ty)) !vars;
+     csig_concr = concr_meths;
+      csig_inher = inher} in
+  let methods = get_methods self_type in
+  let priv_meths =
+    List.filter (fun (_,kind,_) -> Btype.field_kind_repr kind <> Fpresent)
+      methods in
+  (* ensure that inherited methods are listed too *)
+  List.iter (fun (met, _kind, _ty) ->
+      if Meths.mem met !meths then () else
+      ignore (Ctype.filter_self_method val_env met Private meths self_type))
+    methods;
+  if final then begin
+    (* Unify private_self and a copy of self_type. self_type will not
+       be modified after this point *)
+    if not (Ctype.close_object self_type) then
+      raise(Error(loc, val_env, Closing_self_type self_type));
+    let mets = virtual_methods {sign with csig_self = self_type} in
+    let vals =
+      Vars.fold
+        (fun name (_mut, vr, _ty) l -> if vr = Virtual then name :: l else l)
+        sign.csig_vars [] in
+    if mets <> [] || vals <> [] then
+      raise(Error(loc, val_env, Virtual_class(true, final, mets, vals)));
+    let self_methods =
+      List.fold_right
+        (fun (lab,kind,ty) rem ->
+           Ctype.newty(Tfield(lab, Btype.copy_kind kind, ty, rem)))
+        methods (Ctype.newty Tnil) in
+    begin try
+      Ctype.unify val_env private_self
+        (Ctype.newty (Tobject(self_methods, ref None)));
+      Ctype.unify val_env public_self self_type
+    with Ctype.Unify trace -> raise(Error(loc, val_env, Final_self_clash trace))
+    end;
+  end;
+
+  (* Typing of method bodies *)
+  (* if !Clflags.principal then *) begin
+    let ms = !meths in
+    (* Generalize the spine of methods accessed through self *)
+    Meths.iter (fun _ (_,ty) -> Ctype.generalize_spine ty) ms;
+    meths :=
+      Meths.map (fun (id,ty) -> (id, Ctype.generic_instance ty)) ms;
+    (* But keep levels correct on the type of self *)
+    Meths.iter (fun _ (_,ty) -> Ctype.unify val_env ty (Ctype.newvar ())) ms
+  end;
+  let fields = List.map Lazy.force (List.rev fields) in
+  let meths = Meths.map (function (id, _ty) -> id) !meths in
+
+  (* Check for private methods made public *)
+  let pub_meths' =
+    List.filter (fun (_,kind,_) -> Btype.field_kind_repr kind = Fpresent)
+      (get_methods public_self) in
+  let names = List.map (fun (x,_,_) -> x) in
+  let l1 = names priv_meths and l2 = names pub_meths' in
+  let added = List.filter (fun x -> List.mem x l1) l2 in
+  if added <> [] then
+    Location.prerr_warning loc (Warnings.Implicit_public_methods added);
+  let sign = if final then sign else
+      {sign with Types.csig_self = Ctype.expand_head val_env public_self} in
+  {
+    cstr_self = pat;
+    cstr_fields = fields;
+    cstr_type = sign;
+    cstr_meths = meths}, sign (* redondant, since already in cstr_type *)
+
+and class_expr cl_num val_env met_env scl =
+  Builtin_attributes.warning_scope scl.pcl_attributes
+    (fun () -> class_expr_aux cl_num val_env met_env scl)
+
+and class_expr_aux cl_num val_env met_env scl =
+  match scl.pcl_desc with
+    Pcl_constr (lid, styl) ->
+      let (path, decl) = Env.lookup_class ~loc:scl.pcl_loc lid.txt val_env in
+      if Path.same decl.cty_path unbound_class then
+        raise(Error(scl.pcl_loc, val_env, Unbound_class_2 lid.txt));
+      let tyl = List.map
+          (fun sty -> transl_simple_type val_env false sty)
+          styl
+      in
+      let (params, clty) =
+        Ctype.instance_class decl.cty_params decl.cty_type
+      in
+      let clty' = abbreviate_class_type path params clty in
+      if List.length params <> List.length tyl then
+        raise(Error(scl.pcl_loc, val_env,
+                    Parameter_arity_mismatch (lid.txt, List.length params,
+                                                   List.length tyl)));
+      List.iter2
+        (fun cty' ty ->
+          let ty' = cty'.ctyp_type in
+           try Ctype.unify val_env ty' ty with Ctype.Unify trace ->
+             raise(Error(cty'.ctyp_loc, val_env, Parameter_mismatch trace)))
+        tyl params;
+      let cl =
+        rc {cl_desc = Tcl_ident (path, lid, tyl);
+            cl_loc = scl.pcl_loc;
+            cl_type = clty';
+            cl_env = val_env;
+            cl_attributes = scl.pcl_attributes;
+           }
+      in
+      let (vals, meths, concrs) = extract_constraints clty in
+      rc {cl_desc = Tcl_constraint (cl, None, vals, meths, concrs);
+          cl_loc = scl.pcl_loc;
+          cl_type = clty';
+          cl_env = val_env;
+          cl_attributes = []; (* attributes are kept on the inner cl node *)
+         }
+  | Pcl_structure cl_str ->
+      let (desc, ty) =
+        class_structure cl_num false val_env met_env scl.pcl_loc cl_str in
+      rc {cl_desc = Tcl_structure desc;
+          cl_loc = scl.pcl_loc;
+          cl_type = Cty_signature ty;
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
+  | Pcl_fun (l, Some default, spat, sbody) ->
+      let loc = default.pexp_loc in
+      let open Ast_helper in
+      let scases = [
+        Exp.case
+          (Pat.construct ~loc
+             (mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))))
+             (Some (Pat.var ~loc (mknoloc "*sth*"))))
+          (Exp.ident ~loc (mknoloc (Longident.Lident "*sth*")));
+
+        Exp.case
+          (Pat.construct ~loc
+             (mknoloc (Longident.(Ldot (Lident "*predef*", "None"))))
+             None)
+          default;
+       ]
+      in
+      let smatch =
+        Exp.match_ ~loc (Exp.ident ~loc (mknoloc (Longident.Lident "*opt*")))
+          scases
+      in
+      let sfun =
+        Cl.fun_ ~loc:scl.pcl_loc
+          l None
+          (Pat.var ~loc (mknoloc "*opt*"))
+          (Cl.let_ ~loc:scl.pcl_loc Nonrecursive [Vb.mk spat smatch] sbody)
+          (* Note: we don't put the '#default' attribute, as it
+             is not detected for class-level let bindings.  See #5975.*)
+      in
+      class_expr cl_num val_env met_env sfun
+  | Pcl_fun (l, None, spat, scl') ->
+      if !Clflags.principal then Ctype.begin_def ();
+      let (pat, pv, val_env', met_env) =
+        Typecore.type_class_arg_pattern cl_num val_env met_env l spat
+      in
+      if !Clflags.principal then begin
+        Ctype.end_def ();
+        let gen {pat_type = ty} = Ctype.generalize_structure ty in
+        iter_pattern gen pat
+      end;
+      let pv =
+        List.map
+          begin fun (id, id', _ty) ->
+            let path = Pident id' in
+            (* do not mark the value as being used *)
+            let vd = Env.find_value path val_env' in
+            (id,
+             {exp_desc =
+              Texp_ident(path, mknoloc (Longident.Lident (Ident.name id)), vd);
+              exp_loc = Location.none; exp_extra = [];
+              exp_type = Ctype.instance vd.val_type;
+              exp_attributes = []; (* check *)
+              exp_env = val_env'})
+          end
+          pv
+      in
+      let not_function = function
+          Cty_arrow _ -> false
+        | _ -> true
+      in
+      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}]
+      in
+      Ctype.raise_nongen_level ();
+      let cl = class_expr cl_num val_env' met_env scl' in
+      Ctype.end_def ();
+      if Btype.is_optional l && not_function cl.cl_type then
+        Location.prerr_warning pat.pat_loc
+          Warnings.Unerasable_optional_argument;
+      rc {cl_desc = Tcl_fun (l, pat, pv, cl, partial);
+          cl_loc = scl.pcl_loc;
+          cl_type = Cty_arrow
+            (l, Ctype.instance pat.pat_type, cl.cl_type);
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
+  | Pcl_apply (scl', sargs) ->
+      assert (sargs <> []);
+      if !Clflags.principal then Ctype.begin_def ();
+      let cl = class_expr cl_num val_env met_env scl' in
+      if !Clflags.principal then begin
+        Ctype.end_def ();
+        generalize_class_type false cl.cl_type;
+      end;
+      let rec nonopt_labels ls ty_fun =
+        match ty_fun with
+        | Cty_arrow (l, _, ty_res) ->
+            if Btype.is_optional l then nonopt_labels ls ty_res
+            else nonopt_labels (l::ls) ty_res
+        | _    -> ls
+      in
+      let ignore_labels =
+        !Clflags.classic ||
+        let labels = nonopt_labels [] cl.cl_type in
+        List.length labels = List.length sargs &&
+        List.for_all (fun (l,_) -> l = Nolabel) sargs &&
+        List.exists (fun l -> l <> Nolabel) labels &&
+        begin
+          Location.prerr_warning
+            cl.cl_loc
+            (Warnings.Labels_omitted
+               (List.map Printtyp.string_of_label
+                         (List.filter ((<>) Nolabel) labels)));
+          true
+        end
+      in
+      let rec type_args args omitted ty_fun ty_fun0 sargs =
+        match ty_fun, ty_fun0 with
+        | Cty_arrow (l, ty, ty_fun), Cty_arrow (_, ty0, ty_fun0)
+          when sargs <> [] ->
+            let name = Btype.label_name l
+            and optional = Btype.is_optional l in
+            let use_arg sarg l' =
+              Some (
+                if not optional || Btype.is_optional l' then
+                  type_argument val_env sarg ty ty0
+                else
+                  let ty' = extract_option_type val_env ty
+                  and ty0' = extract_option_type val_env ty0 in
+                  let arg = type_argument val_env sarg ty' ty0' in
+                  option_some val_env arg
+              )
+            in
+            let eliminate_optional_arg () =
+              Some (option_none val_env ty0 Location.none)
+            in
+            let remaining_sargs, arg =
+              if ignore_labels then begin
+                match sargs with
+                | [] -> assert false
+                | (l', sarg) :: remaining_sargs ->
+                    if name = Btype.label_name l' ||
+                       (not optional && l' = Nolabel)
+                    then
+                      (remaining_sargs, use_arg sarg l')
+                    else if
+                      optional &&
+                      not (List.exists (fun (l, _) -> name = Btype.label_name l)
+                             remaining_sargs)
+                    then
+                      (sargs, eliminate_optional_arg ())
+                    else
+                      raise(Error(sarg.pexp_loc, val_env, Apply_wrong_label l'))
+              end else
+                match Btype.extract_label name sargs with
+                | Some (l', sarg, _, remaining_sargs) ->
+                    if not optional && Btype.is_optional l' then
+                      Location.prerr_warning sarg.pexp_loc
+                        (Warnings.Nonoptional_label
+                           (Printtyp.string_of_label l));
+                    remaining_sargs, use_arg sarg l'
+                | None ->
+                    sargs,
+                    if Btype.is_optional l && List.mem_assoc Nolabel sargs then
+                      eliminate_optional_arg ()
+                    else
+                      None
+            in
+            let omitted = if arg = None then (l,ty0) :: omitted else omitted in
+            type_args ((l,arg)::args) omitted ty_fun ty_fun0 remaining_sargs
+        | _ ->
+            match sargs with
+              (l, sarg0)::_ ->
+                if omitted <> [] then
+                  raise(Error(sarg0.pexp_loc, val_env, Apply_wrong_label l))
+                else
+                  raise(Error(cl.cl_loc, val_env, Cannot_apply cl.cl_type))
+            | [] ->
+                (List.rev args,
+                 List.fold_left
+                   (fun ty_fun (l,ty) -> Cty_arrow(l,ty,ty_fun))
+                   ty_fun0 omitted)
+      in
+      let (args, cty) =
+        let (_, ty_fun0) = Ctype.instance_class [] cl.cl_type in
+        type_args [] [] cl.cl_type ty_fun0 sargs
+      in
+      rc {cl_desc = Tcl_apply (cl, args);
+          cl_loc = scl.pcl_loc;
+          cl_type = cty;
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
+  | Pcl_let (rec_flag, sdefs, scl') ->
+      let (defs, val_env) =
+        Typecore.type_let In_class_def val_env rec_flag sdefs None in
+      let (vals, met_env) =
+        List.fold_right
+          (fun (id, _id_loc, _typ) (vals, met_env) ->
+             let path = Pident id in
+             (* do not mark the value as used *)
+             let vd = Env.find_value path val_env in
+             Ctype.begin_def ();
+             let expr =
+               {exp_desc =
+                Texp_ident(path, mknoloc(Longident.Lident (Ident.name id)),vd);
+                exp_loc = Location.none; exp_extra = [];
+                exp_type = Ctype.instance vd.val_type;
+                exp_attributes = [];
+                exp_env = val_env;
+               }
+             in
+             Ctype.end_def ();
+             Ctype.generalize expr.exp_type;
+             let desc =
+               {val_type = expr.exp_type; val_kind = Val_ivar (Immutable,
+                                                               cl_num);
+                val_attributes = [];
+                Types.val_loc = vd.Types.val_loc;
+                val_uid = vd.val_uid;
+               }
+             in
+             let id' = Ident.create_local (Ident.name id) in
+             ((id', expr)
+              :: vals,
+              Env.add_value id' desc met_env))
+          (let_bound_idents_full defs)
+          ([], met_env)
+      in
+      let cl = class_expr cl_num val_env met_env scl' in
+      let () = if rec_flag = Recursive then
+        check_recursive_bindings val_env defs
+      in
+      rc {cl_desc = Tcl_let (rec_flag, defs, vals, cl);
+          cl_loc = scl.pcl_loc;
+          cl_type = cl.cl_type;
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
+  | Pcl_constraint (scl', scty) ->
+      Ctype.begin_class_def ();
+      let context = Typetexp.narrow () in
+      let cl = class_expr cl_num val_env met_env scl' in
+      Typetexp.widen context;
+      let context = Typetexp.narrow () in
+      let clty = class_type val_env scty in
+      Typetexp.widen context;
+      Ctype.end_def ();
+
+      limited_generalize (Ctype.row_variable (Ctype.self_type cl.cl_type))
+          cl.cl_type;
+      limited_generalize (Ctype.row_variable (Ctype.self_type clty.cltyp_type))
+        clty.cltyp_type;
+
+      begin match
+        Includeclass.class_types val_env cl.cl_type clty.cltyp_type
+      with
+        []    -> ()
+      | error -> raise(Error(cl.cl_loc, val_env, Class_match_failure error))
+      end;
+      let (vals, meths, concrs) = extract_constraints clty.cltyp_type in
+      rc {cl_desc = Tcl_constraint (cl, Some clty, vals, meths, concrs);
+          cl_loc = scl.pcl_loc;
+          cl_type = snd (Ctype.instance_class [] clty.cltyp_type);
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
+  | Pcl_open (pod, e) ->
+      let used_slot = ref false in
+      let (od, new_val_env) = !type_open_descr ~used_slot val_env pod in
+      let ( _, new_met_env) = !type_open_descr ~used_slot met_env pod in
+      let cl = class_expr cl_num new_val_env new_met_env e in
+      rc {cl_desc = Tcl_open (od, cl);
+          cl_loc = scl.pcl_loc;
+          cl_type = cl.cl_type;
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
+  | Pcl_extension ext ->
+      raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+(*******************************)
+
+(* Approximate the type of the constructor to allow recursive use *)
+(* of optional parameters                                         *)
+
+let var_option = Predef.type_option (Btype.newgenvar ())
+
+let rec approx_declaration cl =
+  match cl.pcl_desc with
+    Pcl_fun (l, _, _, cl) ->
+      let arg =
+        if Btype.is_optional l then Ctype.instance var_option
+        else Ctype.newvar () in
+      Ctype.newty (Tarrow (l, arg, approx_declaration cl, Cok))
+  | Pcl_let (_, _, cl) ->
+      approx_declaration cl
+  | Pcl_constraint (cl, _) ->
+      approx_declaration cl
+  | _ -> Ctype.newvar ()
+
+let rec approx_description ct =
+  match ct.pcty_desc with
+    Pcty_arrow (l, _, ct) ->
+      let arg =
+        if Btype.is_optional l then Ctype.instance var_option
+        else Ctype.newvar () in
+      Ctype.newty (Tarrow (l, arg, approx_description ct, Cok))
+  | _ -> Ctype.newvar ()
+
+(*******************************)
+
+let temp_abbrev loc env id arity uid =
+  let params = ref [] in
+  for _i = 1 to arity do
+    params := Ctype.newvar () :: !params
+  done;
+  let ty = Ctype.newobj (Ctype.newvar ()) in
+  let env =
+    Env.add_type ~check:true id
+      {type_params = !params;
+       type_arity = arity;
+       type_kind = Type_abstract;
+       type_private = Public;
+       type_manifest = Some ty;
+       type_variance = Misc.replicate_list Variance.full arity;
+       type_separability = Types.Separability.default_signature ~arity;
+       type_is_newtype = false;
+       type_expansion_scope = Btype.lowest_level;
+       type_loc = loc;
+       type_attributes = []; (* or keep attrs from the class decl? *)
+       type_immediate = Unknown;
+       type_unboxed = unboxed_false_default_false;
+       type_uid = uid;
+      }
+      env
+  in
+  (!params, ty, env)
+
+let initial_env define_class approx
+    (res, env) (cl, id, ty_id, obj_id, cl_id, uid) =
+  (* Temporary abbreviations *)
+  let arity = List.length cl.pci_params in
+  let (obj_params, obj_ty, env) = temp_abbrev cl.pci_loc env obj_id arity uid in
+  let (cl_params, cl_ty, env) = temp_abbrev cl.pci_loc env cl_id arity uid in
+
+  (* Temporary type for the class constructor *)
+  let constr_type = approx cl.pci_expr in
+  if !Clflags.principal then Ctype.generalize_spine constr_type;
+  let dummy_cty =
+    Cty_signature
+      { csig_self = Ctype.newvar ();
+        csig_vars = Vars.empty;
+        csig_concr = Concr.empty;
+        csig_inher = [] }
+  in
+  let dummy_class =
+    {Types.cty_params = [];             (* Dummy value *)
+     cty_variance = [];
+     cty_type = dummy_cty;        (* Dummy value *)
+     cty_path = unbound_class;
+     cty_new =
+       begin match cl.pci_virt with
+       | Virtual  -> None
+       | Concrete -> Some constr_type
+       end;
+     cty_loc = Location.none;
+     cty_attributes = [];
+     cty_uid = uid;
+    }
+  in
+  let env =
+    Env.add_cltype ty_id
+      {clty_params = [];            (* Dummy value *)
+       clty_variance = [];
+       clty_type = dummy_cty;       (* Dummy value *)
+       clty_path = unbound_class;
+       clty_loc = Location.none;
+       clty_attributes = [];
+       clty_uid = uid;
+      }
+      (
+        if define_class then
+          Env.add_class id dummy_class env
+        else
+          env
+      )
+  in
+  ((cl, id, ty_id,
+    obj_id, obj_params, obj_ty,
+    cl_id, cl_params, cl_ty,
+    constr_type, dummy_class)::res,
+   env)
+
+let class_infos define_class kind
+    (cl, id, ty_id,
+     obj_id, obj_params, obj_ty,
+     cl_id, cl_params, cl_ty,
+     constr_type, dummy_class)
+    (res, env) =
+
+  reset_type_variables ();
+  Ctype.begin_class_def ();
+
+  (* Introduce class parameters *)
+  let ci_params =
+    let make_param (sty, v) =
+      try
+          (transl_type_param env sty, v)
+      with Already_bound ->
+        raise(Error(sty.ptyp_loc, env, Repeated_parameter))
+    in
+      List.map make_param cl.pci_params
+  in
+  let params = List.map (fun (cty, _) -> cty.ctyp_type) ci_params in
+
+  (* Allow self coercions (only for class declarations) *)
+  let coercion_locs = ref [] in
+
+  (* Type the class expression *)
+  let (expr, typ) =
+    try
+      Typecore.self_coercion :=
+        (Path.Pident obj_id, coercion_locs) :: !Typecore.self_coercion;
+      let res = kind env cl.pci_expr in
+      Typecore.self_coercion := List.tl !Typecore.self_coercion;
+      res
+    with exn ->
+      Typecore.self_coercion := []; raise exn
+  in
+
+  Ctype.end_def ();
+
+  let sty = Ctype.self_type typ in
+
+  (* First generalize the type of the dummy method (cf PR#6123) *)
+  let (fields, _) = Ctype.flatten_fields (Ctype.object_fields sty) in
+  List.iter (fun (met, _, ty) -> if met = dummy_method then Ctype.generalize ty)
+    fields;
+  (* Generalize the row variable *)
+  let rv = Ctype.row_variable sty in
+  List.iter (Ctype.limited_generalize rv) params;
+  limited_generalize rv typ;
+
+  (* Check the abbreviation for the object type *)
+  let (obj_params', obj_type) = Ctype.instance_class params typ in
+  let constr = Ctype.newconstr (Path.Pident obj_id) obj_params in
+  begin
+    let ty = Ctype.self_type obj_type in
+    Ctype.hide_private_methods ty;
+    if not (Ctype.close_object ty) then
+      raise(Error(cl.pci_loc, env, Closing_self_type ty));
+    begin try
+      List.iter2 (Ctype.unify env) obj_params obj_params'
+    with Ctype.Unify _ ->
+      raise(Error(cl.pci_loc, env,
+            Bad_parameters (obj_id, constr,
+                            Ctype.newconstr (Path.Pident obj_id)
+                                            obj_params')))
+    end;
+    begin try
+      Ctype.unify env ty constr
+    with Ctype.Unify _ ->
+      raise(Error(cl.pci_loc, env,
+        Abbrev_type_clash (constr, ty, Ctype.expand_head env constr)))
+    end
+  end;
+
+  (* Check the other temporary abbreviation (#-type) *)
+  begin
+    let (cl_params', cl_type) = Ctype.instance_class params typ in
+    let ty = Ctype.self_type cl_type in
+    Ctype.hide_private_methods ty;
+    Ctype.set_object_name obj_id (Ctype.row_variable ty) cl_params ty;
+    begin try
+      List.iter2 (Ctype.unify env) cl_params cl_params'
+    with Ctype.Unify _ ->
+      raise(Error(cl.pci_loc, env,
+            Bad_parameters (cl_id,
+                            Ctype.newconstr (Path.Pident cl_id)
+                                            cl_params,
+                            Ctype.newconstr (Path.Pident cl_id)
+                                            cl_params')))
+    end;
+    begin try
+      Ctype.unify env ty cl_ty
+    with Ctype.Unify _ ->
+      let constr = Ctype.newconstr (Path.Pident cl_id) params in
+      raise(Error(cl.pci_loc, env, Abbrev_type_clash (constr, ty, cl_ty)))
+    end
+  end;
+
+  (* Type of the class constructor *)
+  begin try
+    Ctype.unify env
+      (constructor_type constr obj_type)
+      (Ctype.instance constr_type)
+  with Ctype.Unify trace ->
+    raise(Error(cl.pci_loc, env,
+                Constructor_type_mismatch (cl.pci_name.txt, trace)))
+  end;
+
+  (* Class and class type temporary definitions *)
+  let cty_variance = List.map (fun _ -> Variance.full) params in
+  let cltydef =
+    {clty_params = params; clty_type = class_body typ;
+     clty_variance = cty_variance;
+     clty_path = Path.Pident obj_id;
+     clty_loc = cl.pci_loc;
+     clty_attributes = cl.pci_attributes;
+     clty_uid = dummy_class.cty_uid;
+    }
+  and clty =
+    {cty_params = params; cty_type = typ;
+     cty_variance = cty_variance;
+     cty_path = Path.Pident obj_id;
+     cty_new =
+       begin match cl.pci_virt with
+       | Virtual  -> None
+       | Concrete -> Some constr_type
+       end;
+     cty_loc = cl.pci_loc;
+     cty_attributes = cl.pci_attributes;
+     cty_uid = dummy_class.cty_uid;
+    }
+  in
+  dummy_class.cty_type <- typ;
+  let env =
+    Env.add_cltype ty_id cltydef (
+    if define_class then Env.add_class id clty env else env)
+  in
+
+  if cl.pci_virt = Concrete then begin
+    let sign = Ctype.signature_of_class_type typ in
+    let mets = virtual_methods sign in
+    let vals =
+      Vars.fold
+        (fun name (_mut, vr, _ty) l -> if vr = Virtual then name :: l else l)
+        sign.csig_vars [] in
+    if mets <> []  || vals <> [] then
+      raise(Error(cl.pci_loc, env, Virtual_class(define_class, false, mets,
+                                                 vals)));
+  end;
+
+  (* Misc. *)
+  let arity = Ctype.class_type_arity typ in
+  let pub_meths =
+    let (fields, _) =
+      Ctype.flatten_fields (Ctype.object_fields (Ctype.expand_head env obj_ty))
+    in
+    List.map (function (lab, _, _) -> lab) fields
+  in
+
+  (* Final definitions *)
+  let (params', typ') = Ctype.instance_class params typ in
+  let cltydef =
+    {clty_params = params'; clty_type = class_body typ';
+     clty_variance = cty_variance;
+     clty_path = Path.Pident obj_id;
+     clty_loc = cl.pci_loc;
+     clty_attributes = cl.pci_attributes;
+     clty_uid = dummy_class.cty_uid;
+    }
+  and clty =
+    {cty_params = params'; cty_type = typ';
+     cty_variance = cty_variance;
+     cty_path = Path.Pident obj_id;
+     cty_new =
+       begin match cl.pci_virt with
+       | Virtual  -> None
+       | Concrete -> Some (Ctype.instance constr_type)
+       end;
+     cty_loc = cl.pci_loc;
+     cty_attributes = cl.pci_attributes;
+     cty_uid = dummy_class.cty_uid;
+    }
+  in
+  let obj_abbr =
+    let arity = List.length obj_params in
+    {
+     type_params = obj_params;
+     type_arity = arity;
+     type_kind = Type_abstract;
+     type_private = Public;
+     type_manifest = Some obj_ty;
+     type_variance = List.map (fun _ -> Variance.full) obj_params;
+     type_separability = Types.Separability.default_signature ~arity;
+     type_is_newtype = false;
+     type_expansion_scope = Btype.lowest_level;
+     type_loc = cl.pci_loc;
+     type_attributes = []; (* or keep attrs from cl? *)
+     type_immediate = Unknown;
+     type_unboxed = unboxed_false_default_false;
+     type_uid = dummy_class.cty_uid;
+    }
+  in
+  let (cl_params, cl_ty) =
+    Ctype.instance_parameterized_type params (Ctype.self_type typ)
+  in
+  Ctype.hide_private_methods cl_ty;
+  Ctype.set_object_name obj_id (Ctype.row_variable cl_ty) cl_params cl_ty;
+  let cl_abbr =
+    let arity = List.length cl_params in
+    {
+     type_params = cl_params;
+     type_arity = arity;
+     type_kind = Type_abstract;
+     type_private = Public;
+     type_manifest = Some cl_ty;
+     type_variance = List.map (fun _ -> Variance.full) cl_params;
+     type_separability = Types.Separability.default_signature ~arity;
+     type_is_newtype = false;
+     type_expansion_scope = Btype.lowest_level;
+     type_loc = cl.pci_loc;
+     type_attributes = []; (* or keep attrs from cl? *)
+     type_immediate = Unknown;
+     type_unboxed = unboxed_false_default_false;
+     type_uid = dummy_class.cty_uid;
+    }
+  in
+  ((cl, id, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr, ci_params,
+    arity, pub_meths, List.rev !coercion_locs, expr) :: res,
+   env)
+
+let final_decl env define_class
+    (cl, id, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr, ci_params,
+     arity, pub_meths, coe, expr) =
+
+  begin try Ctype.collapse_conj_params env clty.cty_params
+  with Ctype.Unify trace ->
+    raise(Error(cl.pci_loc, env, Non_collapsable_conjunction (id, clty, trace)))
+  end;
+
+  (* make the dummy method disappear *)
+  begin
+    let self_type = Ctype.self_type clty.cty_type in
+    let methods, _ =
+      Ctype.flatten_fields
+        (Ctype.object_fields (Ctype.expand_head env self_type))
+    in
+    List.iter (fun (lab,kind,_) ->
+      if lab = dummy_method then
+        match Btype.field_kind_repr kind with
+          Fvar r -> Btype.set_kind r Fabsent
+        | _ -> ()
+    ) methods
+  end;
+
+  List.iter Ctype.generalize clty.cty_params;
+  generalize_class_type true 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;
+
+  if not (closed_class clty) then
+    raise(Error(cl.pci_loc, env, Non_generalizable_class (id, clty)));
+
+  begin match
+    Ctype.closed_class clty.cty_params
+      (Ctype.signature_of_class_type clty.cty_type)
+  with
+    None        -> ()
+  | 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
+      in
+      raise(Error(cl.pci_loc, env, Unbound_type_var(printer, reason)))
+  end;
+  { id; clty; ty_id; cltydef; obj_id; obj_abbr; cl_id; cl_abbr; arity;
+    pub_meths; coe; expr;
+    id_loc = cl.pci_name;
+    req = { ci_loc = cl.pci_loc;
+            ci_virt = cl.pci_virt;
+            ci_params = ci_params;
+        (* TODO : check that we have the correct use of identifiers *)
+            ci_id_name = cl.pci_name;
+            ci_id_class = id;
+            ci_id_class_type = ty_id;
+            ci_id_object = obj_id;
+            ci_id_typehash = cl_id;
+            ci_expr = expr;
+            ci_decl = clty;
+            ci_type_decl = cltydef;
+            ci_attributes = cl.pci_attributes;
+        }
+  }
+(*   (cl.pci_variance, cl.pci_loc)) *)
+
+let class_infos define_class kind
+    (cl, id, ty_id,
+     obj_id, obj_params, obj_ty,
+     cl_id, cl_params, cl_ty,
+     constr_type, dummy_class)
+    (res, env) =
+  Builtin_attributes.warning_scope cl.pci_attributes
+    (fun () ->
+       class_infos define_class kind
+         (cl, id, ty_id,
+          obj_id, obj_params, obj_ty,
+          cl_id, cl_params, cl_ty,
+          constr_type, dummy_class)
+         (res, env)
+    )
+
+let extract_type_decls { clty; cltydef; obj_id; obj_abbr; cl_abbr; req} decls =
+  (obj_id, obj_abbr, cl_abbr, clty, cltydef, req) :: decls
+
+let merge_type_decls decl (obj_abbr, cl_abbr, clty, cltydef) =
+  {decl with obj_abbr; cl_abbr; clty; cltydef}
+
+let final_env define_class env { id; clty; ty_id; cltydef; obj_id; obj_abbr;
+    cl_id; cl_abbr } =
+  (* Add definitions after cleaning them *)
+  Env.add_type ~check:true obj_id
+    (Subst.type_declaration Subst.identity obj_abbr) (
+  Env.add_type ~check:true cl_id
+    (Subst.type_declaration Subst.identity cl_abbr) (
+  Env.add_cltype ty_id (Subst.cltype_declaration Subst.identity cltydef) (
+  if define_class then
+    Env.add_class id (Subst.class_declaration Subst.identity clty) env
+  else env)))
+
+(* Check that #c is coercible to c if there is a self-coercion *)
+let check_coercions env { id; id_loc; clty; ty_id; cltydef; obj_id; obj_abbr;
+    cl_id; cl_abbr; arity; pub_meths; coe; req } =
+  begin match coe with [] -> ()
+  | loc :: _ ->
+      let cl_ty, obj_ty =
+        match cl_abbr.type_manifest, obj_abbr.type_manifest with
+          Some cl_ab, Some obj_ab ->
+            let cl_params, cl_ty =
+              Ctype.instance_parameterized_type cl_abbr.type_params cl_ab
+            and obj_params, obj_ty =
+              Ctype.instance_parameterized_type obj_abbr.type_params obj_ab
+            in
+            List.iter2 (Ctype.unify env) cl_params obj_params;
+            cl_ty, obj_ty
+        | _ -> assert false
+      in
+      begin try Ctype.subtype env cl_ty obj_ty ()
+      with Ctype.Subtype (tr1, tr2) ->
+        raise(Typecore.Error(loc, env, Typecore.Not_subtype(tr1, tr2)))
+      end;
+      if not (Ctype.opened_object cl_ty) then
+        raise(Error(loc, env, Cannot_coerce_self obj_ty))
+  end;
+  {cls_id = id;
+   cls_id_loc = id_loc;
+   cls_decl = clty;
+   cls_ty_id = ty_id;
+   cls_ty_decl = cltydef;
+   cls_obj_id = obj_id;
+   cls_obj_abbr = obj_abbr;
+   cls_typesharp_id = cl_id;
+   cls_abbr = cl_abbr;
+   cls_arity = arity;
+   cls_pub_methods = pub_meths;
+   cls_info=req}
+
+(*******************************)
+
+let type_classes define_class approx kind env cls =
+  let scope = Ctype.create_scope () in
+  let cls =
+    List.map
+      (function cl ->
+         (cl,
+          Ident.create_scoped ~scope cl.pci_name.txt,
+          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 ())
+         ))
+      cls
+  in
+  Ctype.begin_class_def ();
+  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
+  Ctype.end_def ();
+  let res = List.rev_map (final_decl env define_class) res in
+  let decls = List.fold_right extract_type_decls res [] in
+  let decls =
+    try Typedecl_variance.update_class_decls env decls
+    with Typedecl_variance.Error(loc, err) ->
+      raise (Typedecl.Error(loc, Typedecl.Variance err))
+  in
+  let res = List.map2 merge_type_decls res decls in
+  let env = List.fold_left (final_env define_class) env res in
+  let res = List.map (check_coercions env) res in
+  (res, env)
+
+let class_num = ref 0
+let class_declaration env sexpr =
+  incr class_num;
+  let expr = class_expr (Int.to_string !class_num) env env sexpr in
+  (expr, expr.cl_type)
+
+let class_description env sexpr =
+  let expr = class_type env sexpr in
+  (expr, expr.cltyp_type)
+
+let class_declarations env cls =
+  let info, env =
+    type_classes true approx_declaration class_declaration env cls
+  in
+  let ids, exprs =
+    List.split
+      (List.map
+         (fun ci -> ci.cls_id, ci.cls_info.ci_expr)
+         info)
+  in
+  check_recursive_class_bindings env ids exprs;
+  info, env
+
+let class_descriptions env cls =
+  type_classes true approx_description class_description env cls
+
+let class_type_declarations env cls =
+  let (decls, env) =
+    type_classes false approx_description class_description env cls
+  in
+  (List.map
+     (fun decl ->
+        {clsty_ty_id = decl.cls_ty_id;
+         clsty_id_loc = decl.cls_id_loc;
+         clsty_ty_decl = decl.cls_ty_decl;
+         clsty_obj_id = decl.cls_obj_id;
+         clsty_obj_abbr = decl.cls_obj_abbr;
+         clsty_typesharp_id = decl.cls_typesharp_id;
+         clsty_abbr = decl.cls_abbr;
+         clsty_info = decl.cls_info})
+     decls,
+   env)
+
+let rec unify_parents env ty cl =
+  match cl.cl_desc with
+    Tcl_ident (p, _, _) ->
+      begin try
+        let decl = Env.find_class p env in
+        let _, body = Ctype.find_cltype_for_path env decl.cty_path in
+        Ctype.unify env ty (Ctype.instance body)
+      with
+        Not_found -> ()
+      | _exn -> assert false
+      end
+  | Tcl_structure st -> unify_parents_struct env ty st
+  | Tcl_open (_, cl)
+  | Tcl_fun (_, _, _, cl, _)
+  | Tcl_apply (cl, _)
+  | Tcl_let (_, _, _, cl)
+  | Tcl_constraint (cl, _, _, _, _) -> unify_parents env ty cl
+and unify_parents_struct env ty st =
+  List.iter
+    (function
+      | {cf_desc = Tcf_inherit (_, cl, _, _, _)} ->
+          unify_parents env ty cl
+      | _ -> ())
+    st.cstr_fields
+
+let type_object env loc s =
+  incr class_num;
+  let (desc, sign) =
+    class_structure (Int.to_string !class_num) true env env loc s in
+  let sty = Ctype.expand_head env sign.csig_self in
+  Ctype.hide_private_methods sty;
+  let (fields, _) = Ctype.flatten_fields (Ctype.object_fields sty) in
+  let meths = List.map (fun (s,_,_) -> s) fields in
+  unify_parents_struct env sign.csig_self desc;
+  (desc, sign, meths)
+
+let () =
+  Typecore.type_object := type_object
+
+(*******************************)
+
+(* Approximate the class declaration as class ['params] id = object end *)
+let approx_class sdecl =
+  let open Ast_helper in
+  let self' = Typ.any () in
+  let clty' = Cty.signature ~loc:sdecl.pci_expr.pcty_loc (Csig.mk self' []) in
+  { sdecl with pci_expr = clty' }
+
+let approx_class_declarations env sdecls =
+  fst (class_type_declarations env (List.map approx_class sdecls))
+
+(*******************************)
+
+(* Error report *)
+
+open Format
+
+let report_error env ppf = function
+  | Repeated_parameter ->
+      fprintf ppf "A type parameter occurs several times"
+  | Unconsistent_constraint trace ->
+      fprintf ppf "The class constraints are not consistent.@.";
+      Printtyp.report_unification_error ppf env trace
+        (fun ppf -> fprintf ppf "Type")
+        (fun ppf -> fprintf ppf "is not compatible with type")
+  | Field_type_mismatch (k, m, trace) ->
+      Printtyp.report_unification_error ppf env trace
+        (function ppf ->
+           fprintf ppf "The %s %s@ has type" k m)
+        (function ppf ->
+           fprintf ppf "but is expected to have type")
+  | Structure_expected clty ->
+      fprintf ppf
+        "@[This class expression is not a class structure; it has type@ %a@]"
+        Printtyp.class_type clty
+  | Cannot_apply _ ->
+      fprintf ppf
+        "This class expression is not a class function, it cannot be applied"
+  | Apply_wrong_label l ->
+      let mark_label = function
+        | Nolabel -> "out label"
+        |  l -> sprintf " label %s" (Btype.prefixed_label_name l) in
+      fprintf ppf "This argument cannot be applied with%s" (mark_label l)
+  | Pattern_type_clash ty ->
+      (* XXX Trace *)
+      (* XXX Revoir message d'erreur | Improve error message *)
+      fprintf ppf "@[%s@ %a@]"
+        "This pattern cannot match self: it only matches values of type"
+        Printtyp.type_expr ty
+  | Unbound_class_2 cl ->
+      fprintf ppf "@[The class@ %a@ is not yet completely defined@]"
+      Printtyp.longident cl
+  | Unbound_class_type_2 cl ->
+      fprintf ppf "@[The class type@ %a@ is not yet completely defined@]"
+      Printtyp.longident cl
+  | Abbrev_type_clash (abbrev, actual, expected) ->
+      (* XXX Afficher une trace ? | Print a trace? *)
+      Printtyp.reset_and_mark_loops_list [abbrev; actual; expected];
+      fprintf ppf "@[The abbreviation@ %a@ expands to type@ %a@ \
+       but is used with type@ %a@]"
+        !Oprint.out_type (Printtyp.tree_of_typexp false abbrev)
+        !Oprint.out_type (Printtyp.tree_of_typexp false actual)
+        !Oprint.out_type (Printtyp.tree_of_typexp false expected)
+  | Constructor_type_mismatch (c, trace) ->
+      Printtyp.report_unification_error ppf env trace
+        (function ppf ->
+           fprintf ppf "The expression \"new %s\" has type" c)
+        (function ppf ->
+           fprintf ppf "but is used with type")
+  | Virtual_class (cl, imm, mets, vals) ->
+      let print_mets ppf mets =
+        List.iter (function met -> fprintf ppf "@ %s" met) mets in
+      let missings =
+        match mets, vals with
+          [], _ -> "variables"
+        | _, [] -> "methods"
+        | _ -> "methods and variables"
+      in
+      let print_msg ppf =
+        if imm then fprintf ppf "This object has virtual %s" missings
+        else if cl then fprintf ppf "This class should be virtual"
+        else fprintf ppf "This class type should be virtual"
+      in
+      fprintf ppf
+        "@[%t.@ @[<2>The following %s are undefined :%a@]@]"
+        print_msg missings print_mets (mets @ vals)
+  | Parameter_arity_mismatch(lid, expected, provided) ->
+      fprintf ppf
+        "@[The class constructor %a@ expects %i type argument(s),@ \
+           but is here applied to %i type argument(s)@]"
+        Printtyp.longident lid expected provided
+  | Parameter_mismatch trace ->
+      Printtyp.report_unification_error ppf env trace
+        (function ppf ->
+           fprintf ppf "The type parameter")
+        (function ppf ->
+           fprintf ppf "does not meet its constraint: it should be")
+  | Bad_parameters (id, params, cstrs) ->
+      Printtyp.reset_and_mark_loops_list [params; cstrs];
+      fprintf ppf
+        "@[The abbreviation %a@ is used with parameters@ %a@ \
+           which are incompatible with constraints@ %a@]"
+        Printtyp.ident id
+        !Oprint.out_type (Printtyp.tree_of_typexp false params)
+        !Oprint.out_type (Printtyp.tree_of_typexp false cstrs)
+  | Class_match_failure error ->
+      Includeclass.report_error ppf error
+  | Unbound_val lab ->
+      fprintf ppf "Unbound instance variable %s" lab
+  | Unbound_type_var (printer, reason) ->
+      let print_common ppf kind ty0 real lab ty =
+        let ty1 =
+          if real then ty0 else Btype.newgenty(Tobject(ty0, ref None)) in
+        List.iter Printtyp.mark_loops [ty; ty1];
+        fprintf ppf
+          "The %s %s@ has type@;<1 2>%a@ where@ %a@ is unbound"
+          kind lab
+          !Oprint.out_type (Printtyp.tree_of_typexp false ty)
+          !Oprint.out_type (Printtyp.tree_of_typexp false ty0)
+      in
+      let print_reason ppf = function
+      | Ctype.CC_Method (ty0, real, lab, ty) ->
+          print_common ppf "method" ty0 real lab ty
+      | Ctype.CC_Value (ty0, real, lab, ty) ->
+          print_common ppf "instance variable" ty0 real lab ty
+      in
+      Printtyp.reset ();
+      fprintf ppf
+        "@[@[Some type variables are unbound in this type:@;<1 2>%t@]@ \
+              @[%a@]@]"
+       printer print_reason reason
+  | Non_generalizable_class (id, clty) ->
+      fprintf ppf
+        "@[The type of this class,@ %a,@ \
+           contains type variables that cannot be generalized@]"
+        (Printtyp.class_declaration id) clty
+  | Cannot_coerce_self ty ->
+      fprintf ppf
+        "@[The type of self cannot be coerced to@ \
+           the type of the current class:@ %a.@.\
+           Some occurrences are contravariant@]"
+        Printtyp.type_scheme ty
+  | Non_collapsable_conjunction (id, clty, trace) ->
+      fprintf ppf
+        "@[The type of this class,@ %a,@ \
+           contains non-collapsible conjunctive types in constraints.@ %t@]"
+        (Printtyp.class_declaration id) clty
+        (fun ppf -> Printtyp.report_unification_error ppf env trace
+            (fun ppf -> fprintf ppf "Type")
+            (fun ppf -> fprintf ppf "is not compatible with type")
+        )
+  | Final_self_clash trace ->
+      Printtyp.report_unification_error ppf env trace
+        (function ppf ->
+           fprintf ppf "This object is expected to have type")
+        (function ppf ->
+           fprintf ppf "but actually has type")
+  | Mutability_mismatch (_lab, mut) ->
+      let mut1, mut2 =
+        if mut = Immutable then "mutable", "immutable"
+        else "immutable", "mutable" in
+      fprintf ppf
+        "@[The instance variable is %s;@ it cannot be redefined as %s@]"
+        mut1 mut2
+  | No_overriding (_, "") ->
+      fprintf ppf "@[This inheritance does not override any method@ %s@]"
+        "instance variable"
+  | No_overriding (kind, name) ->
+      fprintf ppf "@[The %s `%s'@ has no previous definition@]" kind name
+  | Duplicate (kind, name) ->
+      fprintf ppf "@[The %s `%s'@ has multiple definitions in this object@]"
+                    kind name
+  | Closing_self_type self ->
+    fprintf ppf
+      "@[Cannot close type of object literal:@ %a@,\
+       it has been unified with the self type of a class that is not yet@ \
+       completely defined.@]"
+      Printtyp.type_scheme self
+
+let report_error env ppf err =
+  Printtyp.wrap_printing_env ~error:true
+    env (fun () -> report_error env ppf err)
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (loc, env, err) ->
+        Some (Location.error_of_printer ~loc (report_error env) err)
+      | Error_forward err ->
+        Some err
+      | _ ->
+        None
+    )
diff --git a/typing/typeclass.mli b/typing/typeclass.mli
new file mode 100644
index 00000000..c3503526
--- /dev/null
+++ b/typing/typeclass.mli
@@ -0,0 +1,130 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Asttypes
+open Types
+open Format
+
+type 'a class_info = {
+  cls_id : Ident.t;
+  cls_id_loc : string loc;
+  cls_decl : class_declaration;
+  cls_ty_id : Ident.t;
+  cls_ty_decl : class_type_declaration;
+  cls_obj_id : Ident.t;
+  cls_obj_abbr : type_declaration;
+  cls_typesharp_id : Ident.t;
+  cls_abbr : type_declaration;
+  cls_arity : int;
+  cls_pub_methods : string list;
+  cls_info : 'a;
+}
+
+type class_type_info = {
+  clsty_ty_id : Ident.t;
+  clsty_id_loc : string loc;
+  clsty_ty_decl : class_type_declaration;
+  clsty_obj_id : Ident.t;
+  clsty_obj_abbr : type_declaration;
+  clsty_typesharp_id : Ident.t;
+  clsty_abbr : type_declaration;
+  clsty_info : Typedtree.class_type_declaration;
+}
+
+val class_declarations:
+  Env.t -> Parsetree.class_declaration list ->
+  Typedtree.class_declaration class_info list * Env.t
+
+(*
+and class_declaration =
+  (class_expr, Types.class_declaration) class_infos
+*)
+
+val class_descriptions:
+  Env.t -> Parsetree.class_description list ->
+  Typedtree.class_description class_info list * Env.t
+
+(*
+and class_description =
+  (class_type, unit) class_infos
+*)
+
+val class_type_declarations:
+  Env.t -> Parsetree.class_description list -> class_type_info list * Env.t
+
+(*
+and class_type_declaration =
+  (class_type, Types.class_type_declaration) class_infos
+*)
+
+val approx_class_declarations:
+  Env.t -> Parsetree.class_description list -> class_type_info list
+
+val virtual_methods: Types.class_signature -> label list
+
+(*
+val type_classes :
+           bool ->
+           ('a -> Types.type_expr) ->
+           (Env.t -> 'a -> 'b * Types.class_type) ->
+           Env.t ->
+           'a Parsetree.class_infos list ->
+  (  Ident.t * Types.class_declaration *
+     Ident.t * Types.class_type_declaration *
+     Ident.t * Types.type_declaration *
+     Ident.t * Types.type_declaration *
+     int * string list * 'b * 'b Typedtree.class_infos)
+           list * Env.t
+*)
+
+type error =
+    Unconsistent_constraint of Ctype.Unification_trace.t
+  | Field_type_mismatch of string * string * Ctype.Unification_trace.t
+  | Structure_expected of class_type
+  | Cannot_apply of class_type
+  | Apply_wrong_label of arg_label
+  | Pattern_type_clash of type_expr
+  | Repeated_parameter
+  | Unbound_class_2 of Longident.t
+  | Unbound_class_type_2 of Longident.t
+  | Abbrev_type_clash of type_expr * type_expr * type_expr
+  | Constructor_type_mismatch of string * Ctype.Unification_trace.t
+  | Virtual_class of bool * bool * string list * string list
+  | Parameter_arity_mismatch of Longident.t * int * int
+  | Parameter_mismatch of Ctype.Unification_trace.t
+  | Bad_parameters of Ident.t * type_expr * type_expr
+  | Class_match_failure of Ctype.class_match_failure list
+  | Unbound_val of string
+  | Unbound_type_var of (formatter -> unit) * Ctype.closed_class_failure
+  | Non_generalizable_class of Ident.t * Types.class_declaration
+  | Cannot_coerce_self of type_expr
+  | Non_collapsable_conjunction of
+      Ident.t * Types.class_declaration * Ctype.Unification_trace.t
+  | Final_self_clash of Ctype.Unification_trace.t
+  | Mutability_mismatch of string * mutable_flag
+  | No_overriding of string * string
+  | Duplicate of string * string
+  | Closing_self_type of type_expr
+
+exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
+
+val report_error : Env.t -> formatter -> error -> unit
+
+(* Forward decl filled in by Typemod.type_open_descr *)
+val type_open_descr :
+  (?used_slot:bool ref ->
+   Env.t -> Parsetree.open_description -> Typedtree.open_description * Env.t)
+    ref
diff --git a/typing/typecore.ml b/typing/typecore.ml
new file mode 100644
index 00000000..4b2ce97c
--- /dev/null
+++ b/typing/typecore.ml
@@ -0,0 +1,5552 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Typechecking for the core language *)
+
+open Misc
+open Asttypes
+open Parsetree
+open Types
+open Typedtree
+open Btype
+open Ctype
+
+type type_forcing_context =
+  | If_conditional
+  | If_no_else_branch
+  | While_loop_conditional
+  | While_loop_body
+  | For_loop_start_index
+  | For_loop_stop_index
+  | For_loop_body
+  | Assert_condition
+  | Sequence_left_hand_side
+  | When_guard
+
+type type_expected = {
+  ty: type_expr;
+  explanation: type_forcing_context option;
+}
+
+module Datatype_kind = struct
+  type t = Record | Variant
+
+  let type_name = function
+    | Record -> "record"
+    | Variant -> "variant"
+
+  let label_name = function
+    | Record -> "field"
+    | Variant -> "constructor"
+end
+
+type wrong_name = {
+  type_path: Path.t;
+  kind: Datatype_kind.t;
+  name: string loc;
+  valid_names: string list;
+}
+
+type existential_restriction =
+  | At_toplevel (** no existential types at the toplevel *)
+  | In_group (** nor with let ... and ... *)
+  | In_rec (** or recursive definition *)
+  | With_attributes (** or let[@any_attribute] = ... *)
+  | In_class_args (** or in class arguments *)
+  | In_class_def  (** or in [class c = let ... in ...] *)
+  | In_self_pattern (** or in self pattern *)
+
+type error =
+  | Constructor_arity_mismatch of Longident.t * int * int
+  | Label_mismatch of Longident.t * Ctype.Unification_trace.t
+  | Pattern_type_clash :
+      Ctype.Unification_trace.t * _ pattern_desc option -> error
+  | Or_pattern_type_clash of Ident.t * Ctype.Unification_trace.t
+  | Multiply_bound_variable of string
+  | Orpat_vars of Ident.t * Ident.t list
+  | Expr_type_clash of
+      Ctype.Unification_trace.t * type_forcing_context option
+      * expression_desc option
+  | Apply_non_function of type_expr
+  | Apply_wrong_label of arg_label * type_expr * bool
+  | Label_multiply_defined of string
+  | Label_missing of Ident.t list
+  | Label_not_mutable of Longident.t
+  | Wrong_name of string * type_expected * wrong_name
+  | Name_type_mismatch of
+      Datatype_kind.t * Longident.t * (Path.t * Path.t) * (Path.t * Path.t) list
+  | Invalid_format of string
+  | Undefined_method of type_expr * string * string list option
+  | Undefined_inherited_method of string * string list
+  | Virtual_class of Longident.t
+  | Private_type of type_expr
+  | Private_label of Longident.t * type_expr
+  | Private_constructor of constructor_description * type_expr
+  | Unbound_instance_variable of string * string list
+  | Instance_variable_not_mutable of string
+  | Not_subtype of Ctype.Unification_trace.t * Ctype.Unification_trace.t
+  | Outside_class
+  | Value_multiply_overridden of string
+  | Coercion_failure of
+      type_expr * type_expr * Ctype.Unification_trace.t * bool
+  | Too_many_arguments of bool * type_expr * type_forcing_context option
+  | Abstract_wrong_label of arg_label * type_expr * type_forcing_context option
+  | Scoping_let_module of string * type_expr
+  | Not_a_variant_type of Longident.t
+  | Incoherent_label_order
+  | Less_general of string * Ctype.Unification_trace.t
+  | Modules_not_allowed
+  | Cannot_infer_signature
+  | Not_a_packed_module of type_expr
+  | Unexpected_existential of existential_restriction * string * string list
+  | Invalid_interval
+  | Invalid_for_loop_index
+  | No_value_clauses
+  | Exception_pattern_disallowed
+  | Mixed_value_and_exception_patterns_under_guard
+  | Inlined_record_escape
+  | Inlined_record_expected
+  | Unrefuted_pattern of pattern
+  | Invalid_extension_constructor_payload
+  | Not_an_extension_constructor
+  | Literal_overflow of string
+  | Unknown_literal of string * char
+  | Illegal_letrec_pat
+  | Illegal_letrec_expr
+  | Illegal_class_expr
+  | Letop_type_clash of string * Ctype.Unification_trace.t
+  | Andop_type_clash of string * Ctype.Unification_trace.t
+  | Bindings_type_clash of Ctype.Unification_trace.t
+
+exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
+
+(* Forward declaration, to be filled in by Typemod.type_module *)
+
+let type_module =
+  ref ((fun _env _md -> assert false) :
+       Env.t -> Parsetree.module_expr -> Typedtree.module_expr)
+
+(* Forward declaration, to be filled in by Typemod.type_open *)
+
+let type_open :
+  (?used_slot:bool ref -> override_flag -> Env.t -> Location.t ->
+   Longident.t loc -> Path.t * Env.t)
+    ref =
+  ref (fun ?used_slot:_ _ -> assert false)
+
+let type_open_decl :
+  (?used_slot:bool ref -> Env.t -> Parsetree.open_declaration
+   -> open_declaration * Types.signature * Env.t)
+    ref =
+  ref (fun ?used_slot:_ _ -> assert false)
+
+(* Forward declaration, to be filled in by Typemod.type_package *)
+
+let type_package =
+  ref (fun _ -> assert false)
+
+(* Forward declaration, to be filled in by Typeclass.class_structure *)
+let type_object =
+  ref (fun _env _s -> assert false :
+       Env.t -> Location.t -> Parsetree.class_structure ->
+         Typedtree.class_structure * Types.class_signature * string list)
+
+(*
+  Saving and outputting type information.
+  We keep these function names short, because they have to be
+  called each time we create a record of type [Typedtree.expression]
+  or [Typedtree.pattern] that will end up in the typed AST.
+*)
+let re node =
+  Cmt_format.add_saved_type (Cmt_format.Partial_expression node);
+  node
+;;
+let rp node =
+  Cmt_format.add_saved_type (Cmt_format.Partial_pattern (Value, node));
+  node
+;;
+let rcp node =
+  Cmt_format.add_saved_type (Cmt_format.Partial_pattern (Computation, node));
+  node
+;;
+
+
+type recarg =
+  | Allowed
+  | Required
+  | Rejected
+
+
+let mk_expected ?explanation ty = { ty; explanation; }
+
+let case lhs rhs =
+  {c_lhs = lhs; c_guard = None; c_rhs = rhs}
+
+(* Typing of constants *)
+
+let type_constant = function
+    Const_int _ -> instance Predef.type_int
+  | Const_char _ -> instance Predef.type_char
+  | Const_string _ -> instance Predef.type_string
+  | Const_float _ -> instance Predef.type_float
+  | Const_int32 _ -> instance Predef.type_int32
+  | Const_int64 _ -> instance Predef.type_int64
+  | Const_nativeint _ -> instance Predef.type_nativeint
+
+let constant : Parsetree.constant -> (Asttypes.constant, error) result =
+  function
+  | Pconst_integer (i,None) ->
+     begin
+       try Ok (Const_int (Misc.Int_literal_converter.int i))
+       with Failure _ -> Error (Literal_overflow "int")
+     end
+  | Pconst_integer (i,Some 'l') ->
+     begin
+       try Ok (Const_int32 (Misc.Int_literal_converter.int32 i))
+       with Failure _ -> Error (Literal_overflow "int32")
+     end
+  | Pconst_integer (i,Some 'L') ->
+     begin
+       try Ok (Const_int64 (Misc.Int_literal_converter.int64 i))
+       with Failure _ -> Error (Literal_overflow "int64")
+     end
+  | Pconst_integer (i,Some 'n') ->
+     begin
+       try Ok (Const_nativeint (Misc.Int_literal_converter.nativeint i))
+       with Failure _ -> Error (Literal_overflow "nativeint")
+     end
+  | Pconst_integer (i,Some c) -> Error (Unknown_literal (i, c))
+  | Pconst_char c -> Ok (Const_char c)
+  | Pconst_string (s,loc,d) -> Ok (Const_string (s,loc,d))
+  | Pconst_float (f,None)-> Ok (Const_float f)
+  | Pconst_float (f,Some c) -> Error (Unknown_literal (f, c))
+
+let constant_or_raise env loc cst =
+  match constant cst with
+  | Ok c -> c
+  | Error err -> raise (Error (loc, env, err))
+
+(* Specific version of type_option, using newty rather than newgenty *)
+
+let type_option ty =
+  newty (Tconstr(Predef.path_option,[ty], ref Mnil))
+
+let mkexp exp_desc exp_type exp_loc exp_env =
+  { exp_desc; exp_type; exp_loc; exp_env; exp_extra = []; exp_attributes = [] }
+
+let option_none env ty loc =
+  let lid = Longident.Lident "None" in
+  let cnone = Env.find_ident_constructor Predef.ident_none env in
+  mkexp (Texp_construct(mknoloc lid, cnone, [])) ty loc env
+
+let option_some env texp =
+  let lid = Longident.Lident "Some" in
+  let csome = Env.find_ident_constructor Predef.ident_some env in
+  mkexp ( Texp_construct(mknoloc lid , csome, [texp]) )
+    (type_option texp.exp_type) texp.exp_loc texp.exp_env
+
+let extract_option_type env ty =
+  match expand_head env ty with {desc = Tconstr(path, [ty], _)}
+    when Path.same path Predef.path_option -> ty
+  | _ -> assert false
+
+let extract_concrete_record env ty =
+  match extract_concrete_typedecl env ty with
+    (p0, p, {type_kind=Type_record (fields, _)}) -> (p0, p, fields)
+  | _ -> raise Not_found
+
+let extract_concrete_variant env ty =
+  match extract_concrete_typedecl env ty with
+    (p0, p, {type_kind=Type_variant cstrs}) -> (p0, p, cstrs)
+  | (p0, p, {type_kind=Type_open}) -> (p0, p, [])
+  | _ -> raise Not_found
+
+let extract_label_names env ty =
+  try
+    let (_, _,fields) = extract_concrete_record env ty in
+    List.map (fun l -> l.Types.ld_id) fields
+  with Not_found ->
+    assert false
+
+(* Typing of patterns *)
+
+(* 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
+    Printtyp.raw_type_expr expected_ty; *)
+  try
+    unify env ty expected_ty
+  with
+    Unify trace ->
+      raise(Error(loc, env, Expr_type_clash(trace, None, None)))
+  | Tags(l1,l2) ->
+      raise(Typetexp.Error(loc, env, Typetexp.Variant_tags (l1, l2)))
+
+(* level at which to create the local type declarations *)
+let gadt_equations_level = ref None
+let get_gadt_equations_level () =
+  match !gadt_equations_level with
+    Some y -> y
+  | None -> assert false
+
+(* unification inside type_pat*)
+let unify_pat_types ?(refine=false) loc env ty ty' =
+  try
+    if refine then
+      unify_gadt ~equations_level:(get_gadt_equations_level ()) env ty ty'
+    else
+      unify !env ty ty'
+  with
+  | Unify trace ->
+      raise(Error(loc, !env, Pattern_type_clash(trace, None)))
+  | Tags(l1,l2) ->
+      raise(Typetexp.Error(loc, !env, Typetexp.Variant_tags (l1, l2)))
+
+let unify_pat ?refine env pat expected_ty =
+  try unify_pat_types ?refine pat.pat_loc env pat.pat_type expected_ty
+  with Error (loc, env, Pattern_type_clash(trace, None)) ->
+    raise(Error(loc, env, Pattern_type_clash(trace, Some pat.pat_desc)))
+
+(* Creating new conjunctive types is not allowed when typing patterns *)
+(* make all Reither present in open variants *)
+let finalize_variant pat tag opat r =
+  let row =
+    match expand_head pat.pat_env pat.pat_type with
+      {desc = Tvariant row} -> r := row; row_repr row
+    | _ -> assert false
+  in
+  begin match row_field tag row with
+  | Rabsent -> () (* assert false *)
+  | Reither (true, [], _, e) when not row.row_closed ->
+      set_row_field e (Rpresent None)
+  | Reither (false, ty::tl, _, e) when not row.row_closed ->
+      set_row_field e (Rpresent (Some ty));
+      begin match opat with None -> assert false
+      | Some pat ->
+          let env = ref pat.pat_env in List.iter (unify_pat env pat) (ty::tl)
+      end
+  | Reither (c, _l, true, e) when not (row_fixed row) ->
+      set_row_field e (Reither (c, [], false, ref None))
+  | _ -> ()
+  end
+  (* Force check of well-formedness   WHY? *)
+  (* unify_pat pat.pat_env pat
+    (newty(Tvariant{row_fields=[]; row_more=newvar(); row_closed=false;
+                    row_bound=(); row_fixed=false; row_name=None})); *)
+
+let has_variants p =
+  exists_general_pattern
+    { f = fun (type k) (p : k general_pattern) -> match p.pat_desc with
+     | (Tpat_variant _) -> true
+     | _ -> false } p
+
+let finalize_variants p =
+  iter_general_pattern
+    { f = fun (type k) (p : k general_pattern) -> match p.pat_desc with
+     | Tpat_variant(tag, opat, r) ->
+        finalize_variant p tag opat r
+     | _ -> () } p
+
+(* pattern environment *)
+type pattern_variable =
+  {
+    pv_id: Ident.t;
+    pv_type: type_expr;
+    pv_loc: Location.t;
+    pv_as_var: bool;
+    pv_attributes: attributes;
+  }
+
+type module_variable =
+  string loc * Location.t
+
+let pattern_variables = ref ([] : pattern_variable list)
+let pattern_force = ref ([] : (unit -> unit) list)
+let pattern_scope = ref (None : Annot.ident option);;
+let allow_modules = ref false
+let module_variables = ref ([] : module_variable list)
+let reset_pattern scope allow =
+  pattern_variables := [];
+  pattern_force := [];
+  pattern_scope := scope;
+  allow_modules := allow;
+  module_variables := [];
+;;
+
+let maybe_add_pattern_variables_ghost loc_let env pv =
+  List.fold_right
+    (fun {pv_id; _} env ->
+       let name = Ident.name pv_id in
+       if Env.bound_value name env then env
+       else begin
+         Env.enter_unbound_value name
+           (Val_unbound_ghost_recursive loc_let) env
+       end
+    ) pv env
+
+let enter_variable ?(is_module=false) ?(is_as_variable=false) loc name ty
+    attrs =
+  if List.exists (fun {pv_id; _} -> Ident.name pv_id = name.txt)
+      !pattern_variables
+  then raise(Error(loc, Env.empty, Multiply_bound_variable name.txt));
+  let id = Ident.create_local name.txt in
+  pattern_variables :=
+    {pv_id = id;
+     pv_type = ty;
+     pv_loc = loc;
+     pv_as_var = is_as_variable;
+     pv_attributes = attrs} :: !pattern_variables;
+  if is_module then begin
+    (* Note: unpack patterns enter a variable of the same name *)
+    if not !allow_modules then
+      raise (Error (loc, Env.empty, Modules_not_allowed));
+    module_variables := (name, loc) :: !module_variables
+  end;
+  id
+
+let sort_pattern_variables vs =
+  List.sort
+    (fun {pv_id = x; _} {pv_id = y; _} ->
+      Stdlib.compare (Ident.name x) (Ident.name y))
+    vs
+
+let enter_orpat_variables loc env  p1_vs p2_vs =
+  (* unify_vars operate on sorted lists *)
+
+  let p1_vs = sort_pattern_variables p1_vs
+  and p2_vs = sort_pattern_variables p2_vs in
+
+  let rec unify_vars p1_vs p2_vs =
+    let vars vs = List.map (fun {pv_id; _} -> pv_id) vs in
+    match p1_vs, p2_vs with
+      | {pv_id = x1; pv_type = t1; _}::rem1, {pv_id = x2; pv_type = t2; _}::rem2
+        when Ident.equal x1 x2 ->
+          if x1==x2 then
+            unify_vars rem1 rem2
+          else begin
+            begin try
+              unify_var env (newvar ()) t1;
+              unify env t1 t2
+            with
+            | Unify trace ->
+                raise(Error(loc, env, Or_pattern_type_clash(x1, trace)))
+            end;
+          (x2,x1)::unify_vars rem1 rem2
+          end
+      | [],[] -> []
+      | {pv_id; _}::_, [] | [],{pv_id; _}::_ ->
+          raise (Error (loc, env, Orpat_vars (pv_id, [])))
+      | {pv_id = x; _}::_, {pv_id = y; _}::_ ->
+          let err =
+            if Ident.name x < Ident.name y
+            then Orpat_vars (x, vars p2_vs)
+            else Orpat_vars (y, vars p1_vs) in
+          raise (Error (loc, env, err)) in
+  unify_vars p1_vs p2_vs
+
+let rec build_as_type env p =
+  match p.pat_desc with
+    Tpat_alias(p1,_, _) -> build_as_type env p1
+  | Tpat_tuple pl ->
+      let tyl = List.map (build_as_type env) pl in
+      newty (Ttuple tyl)
+  | Tpat_construct(_, cstr, pl) ->
+      let keep = cstr.cstr_private = Private || cstr.cstr_existentials <> [] in
+      if keep then p.pat_type else
+      let tyl = List.map (build_as_type env) pl in
+      let ty_args, ty_res = instance_constructor cstr in
+      List.iter2 (fun (p,ty) -> unify_pat env {p with pat_type = ty})
+        (List.combine pl tyl) ty_args;
+      ty_res
+  | Tpat_variant(l, p', _) ->
+      let ty = Option.map (build_as_type env) p' in
+      newty (Tvariant{row_fields=[l, Rpresent ty]; row_more=newvar();
+                      row_bound=(); row_name=None;
+                      row_fixed=None; row_closed=false})
+  | Tpat_record (lpl,_) ->
+      let lbl = snd3 (List.hd lpl) in
+      if lbl.lbl_private = Private then p.pat_type else
+      let ty = newvar () in
+      let ppl = List.map (fun (_, l, p) -> l.lbl_pos, p) lpl in
+      let do_label lbl =
+        let _, ty_arg, ty_res = instance_label false lbl in
+        unify_pat env {p with pat_type = ty} ty_res;
+        let refinable =
+          lbl.lbl_mut = Immutable && List.mem_assoc lbl.lbl_pos ppl &&
+          match (repr lbl.lbl_arg).desc with Tpoly _ -> false | _ -> true in
+        if refinable then begin
+          let arg = List.assoc lbl.lbl_pos ppl in
+          unify_pat env {arg with pat_type = build_as_type env arg} ty_arg
+        end else begin
+          let _, ty_arg', ty_res' = instance_label false lbl in
+          unify !env ty_arg ty_arg';
+          unify_pat env p ty_res'
+        end in
+      Array.iter do_label lbl.lbl_all;
+      ty
+  | Tpat_or(p1, p2, row) ->
+      begin match row with
+        None ->
+          let ty1 = build_as_type env p1 and ty2 = build_as_type env p2 in
+          unify_pat env {p2 with pat_type = ty2} ty1;
+          ty1
+      | Some row ->
+          let row = row_repr row in
+          newty (Tvariant{row with row_closed=false; row_more=newvar()})
+      end
+  | Tpat_any | Tpat_var _ | Tpat_constant _
+  | Tpat_array _ | Tpat_lazy _ -> p.pat_type
+
+let build_or_pat env loc lid =
+  let path, decl = Env.lookup_type ~loc:lid.loc lid.txt env in
+  let tyl = List.map (fun _ -> newvar()) decl.type_params in
+  let row0 =
+    let ty = expand_head env (newty(Tconstr(path, tyl, ref Mnil))) in
+    match ty.desc with
+      Tvariant row when static_row row -> row
+    | _ -> raise(Error(lid.loc, env, Not_a_variant_type lid.txt))
+  in
+  let pats, fields =
+    List.fold_left
+      (fun (pats,fields) (l,f) ->
+        match row_field_repr f with
+          Rpresent None ->
+            (l,None) :: pats,
+            (l, Reither(true,[], true, ref None)) :: fields
+        | Rpresent (Some ty) ->
+            (l, Some {pat_desc=Tpat_any; pat_loc=Location.none; pat_env=env;
+                      pat_type=ty; pat_extra=[]; pat_attributes=[]})
+            :: pats,
+            (l, Reither(false, [ty], true, ref None)) :: fields
+        | _ -> pats, fields)
+      ([],[]) (row_repr row0).row_fields in
+  let row =
+    { row_fields = List.rev fields; row_more = newvar(); row_bound = ();
+      row_closed = false; row_fixed = None; row_name = Some (path, tyl) }
+  in
+  let ty = newty (Tvariant row) in
+  let gloc = {loc with Location.loc_ghost=true} in
+  let row' = ref {row with row_more=newvar()} in
+  let pats =
+    List.map
+      (fun (l,p) ->
+        {pat_desc=Tpat_variant(l,p,row'); pat_loc=gloc;
+         pat_env=env; pat_type=ty; pat_extra=[]; pat_attributes=[]})
+      pats
+  in
+  match pats with
+    [] ->
+      (* empty polymorphic variants: not possible with the concrete language
+         but valid at the ast level *)
+      raise(Error(lid.loc, env, Not_a_variant_type lid.txt))
+  | pat :: pats ->
+      let r =
+        List.fold_left
+          (fun pat pat0 ->
+            {pat_desc=Tpat_or(pat0,pat,Some row0); pat_extra=[];
+             pat_loc=gloc; pat_env=env; pat_type=ty; pat_attributes=[]})
+          pat pats in
+      (path, rp { r with pat_loc = loc },ty)
+
+let split_cases env cases =
+  let add_case lst case = function
+    | None -> lst
+    | Some c_lhs -> { case with c_lhs } :: lst
+  in
+  List.fold_right (fun ({ c_lhs; c_guard } as case) (vals, exns) ->
+    match split_pattern c_lhs with
+    | Some _, Some _ when c_guard <> None ->
+      raise (Error (c_lhs.pat_loc, env,
+                    Mixed_value_and_exception_patterns_under_guard))
+    | vp, ep -> add_case vals case vp, add_case exns case ep
+  ) cases ([], [])
+
+(* Type paths *)
+
+let rec expand_path env p =
+  let decl =
+    try Some (Env.find_type p env) with Not_found -> None
+  in
+  match decl with
+    Some {type_manifest = Some ty} ->
+      begin match repr ty with
+        {desc=Tconstr(p,_,_)} -> expand_path env p
+      | _ -> assert false
+      end
+  | _ ->
+      let p' = Env.normalize_type_path None env p in
+      if Path.same p p' then p else expand_path env p'
+
+let compare_type_path env tpath1 tpath2 =
+  Path.same (expand_path env tpath1) (expand_path env tpath2)
+
+(* Records *)
+exception Wrong_name_disambiguation of Env.t * wrong_name
+
+let get_constr_type_path ty =
+  match (repr ty).desc with
+  | Tconstr(p, _, _) -> p
+  | _ -> assert false
+
+module NameChoice(Name : sig
+  type t
+  type usage
+  val kind: Datatype_kind.t
+  val get_name: t -> string
+  val get_type: t -> type_expr
+  val lookup_all_from_type:
+    Location.t -> usage -> Path.t -> Env.t -> (t * (unit -> unit)) list
+
+  (** Some names (for example the fields of inline records) are not
+      in the typing environment -- they behave as structural labels
+      rather than nominal labels.*)
+  val in_env: t -> bool
+end) = struct
+  open Name
+
+  let get_type_path d = get_constr_type_path (get_type d)
+
+  let lookup_from_type env type_path usage lid =
+    let descrs = lookup_all_from_type lid.loc usage type_path env in
+    match lid.txt with
+    | Longident.Lident name -> begin
+        match
+          List.find (fun (nd, _) -> get_name nd = name) descrs
+        with
+        | descr, use ->
+            use ();
+            descr
+        | exception Not_found ->
+            let valid_names = List.map (fun (nd, _) -> get_name nd) descrs in
+            raise (Wrong_name_disambiguation (env, {
+                    type_path;
+                    name = { lid with txt = name };
+                    kind;
+                    valid_names;
+              }))
+      end
+    | _ -> raise Not_found
+
+  let rec unique eq acc = function
+      [] -> List.rev acc
+    | x :: rem ->
+        if List.exists (eq x) acc then unique eq acc rem
+        else unique eq (x :: acc) rem
+
+  let ambiguous_types env lbl others =
+    let tpath = get_type_path lbl in
+    let others =
+      List.map (fun (lbl, _) -> get_type_path lbl) others in
+    let tpaths = unique (compare_type_path env) [tpath] others in
+    match tpaths with
+      [_] -> []
+    | _ -> let open Printtyp in
+        wrap_printing_env ~error:true env (fun () ->
+            reset(); strings_of_paths Type tpaths)
+
+  let disambiguate_by_type env tpath lbls =
+    match lbls with
+    | (Error _ : _ result) -> raise Not_found
+    | Ok lbls ->
+        let check_type (lbl, _) =
+          let lbl_tpath = get_type_path lbl in
+          compare_type_path env tpath lbl_tpath
+        in
+        List.find check_type lbls
+
+  (* warn if there are several distinct candidates in scope *)
+  let warn_if_ambiguous warn lid env lbl rest =
+    Printtyp.Conflicts.reset ();
+    let paths = ambiguous_types env lbl rest in
+    let expansion =
+      Format.asprintf "%t" Printtyp.Conflicts.print_explanations in
+    if paths <> [] then
+      warn lid.loc
+        (Warnings.Ambiguous_name ([Longident.last lid.txt],
+                                  paths, false, expansion))
+
+  (* a non-principal type was used for disambiguation *)
+  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"))
+
+  (* we selected a name out of the lexical scope *)
+  let warn_out_of_scope warn lid env tpath =
+    let path_s =
+      Printtyp.wrap_printing_env ~error:true env
+        (fun () -> Printtyp.string_of_path tpath) in
+    warn lid.loc
+      (Warnings.Name_out_of_scope (path_s, [Longident.last lid.txt], false))
+
+  (* warn if the selected name is not the last introduced in scope
+     -- in these cases the resolution is different from pre-disambiguation OCaml
+     (this warning is not enabled by default, it is specifically for people
+      wishing to write backward-compatible code).
+   *)
+  let warn_if_disambiguated_name warn lid lbl scope =
+    match scope with
+    | Ok ((lab1,_) :: _) when lab1 == lbl -> ()
+    | _ ->
+        warn lid.loc
+          (Warnings.Disambiguated_name (get_name lbl))
+
+  let force_error : ('a, _) result -> 'a = function
+    | Ok lbls -> lbls
+    | Error (loc', env', err) ->
+       Env.lookup_error loc' env' err
+
+  type candidate = t * (unit -> unit)
+  type nonempty_candidate_filter =
+    candidate list -> (candidate list, candidate list) result
+  (** This type is used for candidate filtering functions.
+      Filtering typically proceeds in several passes, filtering
+      candidates through increasingly precise conditions.
+
+      We assume that the input list is non-empty, and the output is one of
+      - [Ok result] for a non-empty list [result] of valid candidates
+      - [Error candidates] with there are no valid candidates,
+        and [candidates] is a non-empty subset of the input, typically
+        the result of the last non-empty filtering step.
+   *)
+
+  (** [disambiguate] selects a concrete description for [lid] using
+     some contextual information:
+     - An optional [expected_type].
+     - A list of candidates labels in the current lexical scope,
+       [candidates_in_scope], that is actually at the type
+       [(label_descr list, lookup_error) result] so that the
+       lookup error is only raised when necessary.
+     - A filtering criterion on candidates in scope [filter_candidates],
+       representing extra contextual information that can help
+       candidate selection (see [disambiguate_label_by_ids]).
+   *)
+  let disambiguate
+        ?(warn=Location.prerr_warning)
+        ?(filter : nonempty_candidate_filter = Result.ok)
+        usage lid env
+        expected_type
+        candidates_in_scope =
+    let lbl = match expected_type with
+    | None ->
+        (* no expected type => no disambiguation *)
+        begin match filter (force_error candidates_in_scope) with
+        | Ok [] | Error [] -> assert false
+        | Error((lbl, _use) :: _rest) -> lbl (* will fail later *)
+        | Ok((lbl, use) :: rest) ->
+            use ();
+            warn_if_ambiguous warn lid env lbl rest;
+            lbl
+        end
+    | Some(tpath0, tpath, principal) ->
+       (* If [expected_type] is available, the candidate selected
+          will correspond to the type-based resolution.
+          There are two reasons to still check the lexical scope:
+          - for warning purposes
+          - for extension types, the type environment does not contain
+            a list of constructors, so using only type-based selection
+            would fail.
+        *)
+        (* note that [disambiguate_by_type] does not
+           force [candidates_in_scope]: we just skip this case if there
+           are no candidates in scope *)
+        begin match disambiguate_by_type env tpath candidates_in_scope with
+        | lbl, use ->
+          use ();
+          if not principal then begin
+            (* Check if non-principal type is affecting result *)
+            match (candidates_in_scope : _ result) with
+            | Error _ -> warn_non_principal warn lid
+            | Ok lbls ->
+            match filter lbls with
+            | Error _ -> warn_non_principal warn lid
+            | Ok [] -> assert false
+            | Ok ((lbl', _use') :: rest) ->
+            let lbl_tpath = get_type_path lbl' in
+            (* no principality warning if the non-principal
+               type-based selection corresponds to the last
+               definition in scope *)
+            if not (compare_type_path env tpath lbl_tpath)
+            then warn_non_principal warn lid
+            else warn_if_ambiguous warn lid env lbl rest;
+          end;
+          lbl
+        | exception Not_found ->
+        (* look outside the lexical scope *)
+        match lookup_from_type env tpath usage lid with
+        | lbl ->
+          (* warn only on nominal labels;
+             structural labels cannot be qualified anyway *)
+          if in_env lbl then warn_out_of_scope warn lid env tpath;
+          if not principal then warn_non_principal warn lid;
+          lbl
+        | exception Not_found ->
+        match filter (force_error candidates_in_scope) with
+        | Ok lbls | Error lbls ->
+        let tp = (tpath0, expand_path env tpath) in
+        let tpl =
+          List.map
+            (fun (lbl, _) ->
+               let tp0 = get_type_path lbl in
+               let tp = expand_path env tp0 in
+               (tp0, tp))
+            lbls
+        in
+        raise (Error (lid.loc, env,
+                      Name_type_mismatch (kind, lid.txt, tp, tpl)));
+        end
+    in
+    (* warn only on nominal labels *)
+    if in_env lbl then
+      warn_if_disambiguated_name warn lid lbl candidates_in_scope;
+    lbl
+end
+
+let wrap_disambiguate msg ty f x =
+  try f x with
+  | Wrong_name_disambiguation (env, wrong_name) ->
+    raise (Error (wrong_name.name.loc, env, Wrong_name (msg, ty, wrong_name)))
+
+module Label = NameChoice (struct
+  type t = label_description
+  type usage = unit
+  let kind = Datatype_kind.Record
+  let get_name lbl = lbl.lbl_name
+  let get_type lbl = lbl.lbl_res
+  let lookup_all_from_type loc () path env =
+    Env.lookup_all_labels_from_type ~loc path env
+  let in_env lbl =
+    match lbl.lbl_repres with
+    | Record_regular | Record_float | Record_unboxed false -> true
+    | Record_unboxed true | Record_inlined _ | Record_extension _ -> false
+end)
+
+(* In record-construction expressions and patterns, we have many labels
+   at once; find a candidate type in the intersection of the candidates
+   of each label. In the [closed] expression case, this candidate must
+   contain exactly all the labels.
+
+   If our successive refinements result in an empty list,
+   return [Error] with the last non-empty list of candidates
+   for use in error messages.
+*)
+let disambiguate_label_by_ids closed ids labels  : (_, _) result =
+  let check_ids (lbl, _) =
+    let lbls = Hashtbl.create 8 in
+    Array.iter (fun lbl -> Hashtbl.add lbls lbl.lbl_name ()) lbl.lbl_all;
+    List.for_all (Hashtbl.mem lbls) ids
+  and check_closed (lbl, _) =
+    (not closed || List.length ids = Array.length lbl.lbl_all)
+  in
+  match List.filter check_ids labels with
+  | [] -> Error labels
+  | labels ->
+  match List.filter check_closed labels with
+  | [] -> Error labels
+  | labels ->
+  Ok labels
+
+(* Only issue warnings once per record constructor/pattern *)
+let disambiguate_lid_a_list loc closed env expected_type lid_a_list =
+  let ids = List.map (fun (lid, _) -> Longident.last lid.txt) lid_a_list in
+  let w_pr = ref false and w_amb = ref []
+  and w_scope = ref [] and w_scope_ty = ref "" in
+  let warn loc msg =
+    let open Warnings in
+    match msg with
+    | Not_principal _ -> w_pr := true
+    | Ambiguous_name([s], l, _, ex) -> w_amb := (s, l, ex) :: !w_amb
+    | Name_out_of_scope(ty, [s], _) ->
+        w_scope := s :: !w_scope; w_scope_ty := ty
+    | _ -> Location.prerr_warning loc msg
+  in
+  let process_label lid =
+    let scope = Env.lookup_all_labels ~loc:lid.loc lid.txt env in
+    let filter : Label.nonempty_candidate_filter =
+      disambiguate_label_by_ids closed ids in
+    Label.disambiguate ~warn ~filter () lid env expected_type scope in
+  let lbl_a_list =
+    List.map (fun (lid,a) -> lid, process_label lid, a) lid_a_list in
+  if !w_pr then
+    Location.prerr_warning loc
+      (Warnings.Not_principal "this type-based record disambiguation")
+  else begin
+    match List.rev !w_amb with
+      (_,types,ex)::_ as amb ->
+        let paths =
+          List.map (fun (_,lbl,_) -> Label.get_type_path lbl) lbl_a_list in
+        let path = List.hd paths in
+        let fst3 (x,_,_) = x in
+        if List.for_all (compare_type_path env path) (List.tl paths) then
+          Location.prerr_warning loc
+            (Warnings.Ambiguous_name (List.map fst3 amb, types, true, ex))
+        else
+          List.iter
+            (fun (s,l,ex) -> Location.prerr_warning loc
+                (Warnings.Ambiguous_name ([s],l,false, ex)))
+            amb
+    | _ -> ()
+  end;
+  if !w_scope <> [] then
+    Location.prerr_warning loc
+      (Warnings.Name_out_of_scope (!w_scope_ty, List.rev !w_scope, true));
+  lbl_a_list
+
+let rec find_record_qual = function
+  | [] -> None
+  | ({ txt = Longident.Ldot (modname, _) }, _) :: _ -> Some modname
+  | _ :: rest -> find_record_qual rest
+
+let map_fold_cont f xs k =
+  List.fold_right (fun x k ys -> f x (fun y -> k (y :: ys)))
+    xs (fun ys -> k (List.rev ys)) []
+
+let type_label_a_list
+      ?labels loc closed env type_lbl_a expected_type lid_a_list k =
+  let lbl_a_list =
+    match lid_a_list, labels with
+      ({txt=Longident.Lident s}, _)::_, Some labels when Hashtbl.mem labels s ->
+        (* Special case for rebuilt syntax trees *)
+        List.map
+          (function lid, a -> match lid.txt with
+            Longident.Lident s -> lid, Hashtbl.find labels s, a
+          | _ -> assert false)
+          lid_a_list
+    | _ ->
+        let lid_a_list =
+          match find_record_qual lid_a_list with
+            None -> lid_a_list
+          | Some modname ->
+              List.map
+                (fun (lid, a as lid_a) ->
+                  match lid.txt with Longident.Lident s ->
+                    {lid with txt=Longident.Ldot (modname, s)}, a
+                  | _ -> lid_a)
+                lid_a_list
+        in
+        disambiguate_lid_a_list loc closed env expected_type lid_a_list
+  in
+  (* Invariant: records are sorted in the typed tree *)
+  let lbl_a_list =
+    List.sort
+      (fun (_,lbl1,_) (_,lbl2,_) -> compare lbl1.lbl_pos lbl2.lbl_pos)
+      lbl_a_list
+  in
+  map_fold_cont type_lbl_a lbl_a_list k
+;;
+
+(* Checks over the labels mentioned in a record pattern:
+   no duplicate definitions (error); properly closed (warning) *)
+
+let check_recordpat_labels loc lbl_pat_list closed =
+  match lbl_pat_list with
+  | [] -> ()                            (* should not happen *)
+  | (_, label1, _) :: _ ->
+      let all = label1.lbl_all in
+      let defined = Array.make (Array.length all) false in
+      let check_defined (_, label, _) =
+        if defined.(label.lbl_pos)
+        then raise(Error(loc, Env.empty, Label_multiply_defined label.lbl_name))
+        else defined.(label.lbl_pos) <- true in
+      List.iter check_defined lbl_pat_list;
+      if closed = Closed
+      && Warnings.is_active (Warnings.Non_closed_record_pattern "")
+      then begin
+        let undefined = ref [] in
+        for i = 0 to Array.length all - 1 do
+          if not defined.(i) then undefined := all.(i).lbl_name :: !undefined
+        done;
+        if !undefined <> [] then begin
+          let u = String.concat ", " (List.rev !undefined) in
+          Location.prerr_warning loc (Warnings.Non_closed_record_pattern u)
+        end
+      end
+
+(* Constructors *)
+
+module Constructor = NameChoice (struct
+  type t = constructor_description
+  type usage = Env.constructor_usage
+  let kind = Datatype_kind.Variant
+  let get_name cstr = cstr.cstr_name
+  let get_type cstr = cstr.cstr_res
+  let lookup_all_from_type loc usage path env =
+    match Env.lookup_all_constructors_from_type ~loc usage path env with
+    | _ :: _ as x -> x
+    | [] ->
+        match (Env.find_type path env).type_kind with
+        | Type_open ->
+            (* Extension constructors cannot be found by looking at the type
+               declaration.
+               We scan the whole environment to get an accurate spellchecking
+               hint in the subsequent error message *)
+            let filter lbl =
+              compare_type_path env
+                path (get_constr_type_path @@ get_type lbl) in
+            let add_valid x acc = if filter x then (x,ignore)::acc else acc in
+            Env.fold_constructors add_valid None env []
+        | _ -> []
+  let in_env _ = true
+end)
+
+(* unification of a type with a tconstr with
+   freshly created arguments *)
+let unify_head_only ~refine loc env ty constr =
+  let (_, ty_res) = instance_constructor constr in
+  let ty_res = repr ty_res in
+  match ty_res.desc with
+  | Tconstr(p,args,m) ->
+      ty_res.desc <- Tconstr(p,List.map (fun _ -> newvar ()) args,m);
+      enforce_constraints !env ty_res;
+      unify_pat_types ~refine loc env ty_res ty
+  | _ -> assert false
+
+(* Typing of patterns *)
+
+(* "half typed" cases are produced in [type_cases] when we've just typechecked
+   the pattern but haven't type-checked the body yet.
+   At this point we might have added some type equalities to the environment,
+   but haven't yet added identifiers bound by the pattern. *)
+type 'case_pattern half_typed_case =
+  { typed_pat: 'case_pattern;
+    pat_type_for_unif: type_expr;
+    untyped_case: Parsetree.case;
+    branch_env: Env.t;
+    pat_vars: pattern_variable list;
+    unpacks: module_variable list;
+    contains_gadt: bool; }
+
+let rec has_literal_pattern p = match p.ppat_desc with
+  | Ppat_constant _
+  | Ppat_interval _ ->
+     true
+  | Ppat_any
+  | Ppat_variant (_, None)
+  | Ppat_construct (_, None)
+  | Ppat_type _
+  | Ppat_var _
+  | Ppat_unpack _
+  | Ppat_extension _ ->
+     false
+  | Ppat_exception p
+  | Ppat_variant (_, Some p)
+  | Ppat_construct (_, Some p)
+  | Ppat_constraint (p, _)
+  | Ppat_alias (p, _)
+  | Ppat_lazy p
+  | Ppat_open (_, p) ->
+     has_literal_pattern p
+  | Ppat_tuple ps
+  | Ppat_array ps ->
+     List.exists has_literal_pattern ps
+  | Ppat_record (ps, _) ->
+     List.exists (fun (_,p) -> has_literal_pattern p) ps
+  | Ppat_or (p, q) ->
+     has_literal_pattern p || has_literal_pattern q
+
+let check_scope_escape loc env level ty =
+  try Ctype.check_scope_escape env level ty
+  with Unify trace ->
+    raise(Error(loc, env, Pattern_type_clash(trace, None)))
+
+type pattern_checking_mode =
+  | Normal
+  (** We are checking user code. *)
+  | Counter_example of counter_example_checking_info
+  (** In [Counter_example] mode, we are checking a counter-example
+      candidate produced by Parmatch. This is a syntactic pattern that
+      represents a set of values by using or-patterns (p_1 | ... | p_n)
+      to enumerate all alternatives in the counter-example
+      search. These or-patterns occur at every choice point, possibly
+      deep inside the pattern.
+
+      Parmatch does not use type information, so this pattern may
+      exhibit two issues:
+      - some parts of the pattern may be ill-typed due to GADTs, and
+      - some wildcard patterns may not match any values: their type is
+        empty.
+
+      The aim of [type_pat] in the [Counter_example] mode is to refine
+      this syntactic pattern into a well-typed pattern, and ensure
+      that it matches at least one concrete value.
+      - It filters ill-typed branches of or-patterns.
+        (see {!splitting_mode} below)
+      - It tries to check that wildcard patterns are non-empty.
+        (see {!explosion_fuel})
+  *)
+
+and counter_example_checking_info = {
+    explosion_fuel: int;
+    splitting_mode: splitting_mode;
+    constrs: (string, Types.constructor_description) Hashtbl.t;
+    labels: (string, Types.label_description) Hashtbl.t;
+  }
+(**
+    [explosion_fuel] controls the checking of wildcard patterns.  We
+    eliminate potentially-empty wildcard patterns by exploding them
+    into concrete sub-patterns, for example (K1 _ | K2 _) or
+    { l1: _; l2: _ }. [explosion_fuel] is the depth limit on wildcard
+    explosion. Such depth limit is required to avoid non-termination
+    and compilation-time blowups.
+
+    [splitting_mode] controls the handling of or-patterns.  In
+    [Counter_example] mode, we only need to select one branch that
+    leads to a well-typed pattern. Checking all branches is expensive,
+    we use different search strategies (see {!splitting_mode}) to
+    reduce the number of explored alternatives.
+
+    [constrs] and [labels] contain metadata produced by [Parmatch] to
+    type-check the given syntactic pattern. [Parmatch] produces
+    counter-examples by turning typed patterns into
+    [Parsetree.pattern]. In this process, constructor and label paths
+    are lost, and are replaced by generated strings. [constrs] and
+    [labels] map those synthetic names back to the typed descriptions
+    of the original names.
+ *)
+
+(** Due to GADT constraints, an or-pattern produced within
+    a counter-example may have ill-typed branches. Consider for example
+
+    {[
+      type _ tag = Int : int tag | Bool : bool tag
+    ]}
+
+    then [Parmatch] will propose the or-pattern [Int | Bool] whenever
+    a pattern of type [tag] is required to form a counter-example. For
+    example, a function expects a (int tag option) and only [None] is
+    handled by the user-written pattern. [Some (Int | Bool)] is not
+    well-typed in this context, only the sub-pattern [Some Int] is.
+    In this example, the expected type coming from the context
+    suffices to know which or-pattern branch must be chosen.
+
+    In the general case, choosing a branch can have non-local effects
+    on the typability of the term. For example, consider a tuple type
+    ['a tag * ...'a...], where the first component is a GADT.  All
+    constructor choices for this GADT lead to a well-typed branch in
+    isolation (['a] is unconstrained), but choosing one of them adds
+    a constraint on ['a] that may make the other tuple elements
+    ill-typed.
+
+    In general, after choosing each possible branch of the or-pattern,
+    [type_pat] has to check the rest of the pattern to tell if this
+    choice leads to a well-typed term. This may lead to an explosion
+    of typing/search work -- the rest of the term may in turn contain
+    alternatives.
+
+    We use careful strategies to try to limit counterexample-checking
+    time; [splitting_mode] represents those strategies.
+*)
+and splitting_mode =
+  | Backtrack_or
+  (** Always backtrack in or-patterns.
+
+      [Backtrack_or] selects a single alternative from an or-pattern
+      by using backtracking, trying to choose each branch in turn, and
+      to complete it into a valid sub-pattern. We call this
+      "splitting" the or-pattern.
+
+      We use this mode when looking for unused patterns or sub-patterns,
+      in particular to check a refutation clause (p -> .).
+    *)
+  | Refine_or of { inside_nonsplit_or: bool; }
+  (** Only backtrack when needed.
+
+      [Refine_or] tries another approach for refining or-pattern.
+
+      Instead of always splitting each or-pattern, It first attempts to
+      find branches that do not introduce new constraints (because they
+      do not contain GADT constructors). Those branches are such that,
+      if they fail, all other branches will fail.
+
+      If we find one such branch, we attempt to complete the subpattern
+      (checking what's outside the or-pattern), ignoring other
+      branches -- we never consider another branch choice again. If all
+      branches are constrained, it falls back to splitting the
+      or-pattern.
+
+      We use this mode when checking exhaustivity of pattern matching.
+  *)
+
+(** This exception is only used internally within [type_pat_aux], in
+    counter-example mode, to jump back to the parent or-pattern in the
+    [Refine_or] strategy.
+
+    Such a parent exists precisely when [inside_nonsplit_or = true];
+    it's an invariant that we always setup an exception handler for
+    [Need_backtrack] when we set this flag. *)
+exception Need_backtrack
+
+(** This exception is only used internally within [type_pat_aux], in
+    counter-example mode. We use it to discard counter-example candidates
+    that do not match any value. *)
+exception Empty_branch
+
+type abort_reason = Adds_constraints | Empty
+
+(** Remember current typing state for backtracking.
+   No variable information, as we only backtrack on
+   patterns without variables (cf. assert statements). *)
+type state =
+ { snapshot: Btype.snapshot;
+   levels: Ctype.levels;
+   env: Env.t; }
+let save_state env =
+  { snapshot = Btype.snapshot ();
+    levels = Ctype.save_levels ();
+    env = !env; }
+let set_state s env =
+  Btype.backtrack s.snapshot;
+  Ctype.set_levels s.levels;
+  env := s.env
+
+(** Find the first alternative in the tree of or-patterns for which
+   [f] does not raise an error. If all fail, the last error is
+   propagated *)
+let rec find_valid_alternative f pat =
+  match pat.ppat_desc with
+  | Ppat_or(p1,p2) ->
+      (try find_valid_alternative f p1 with
+       | Empty_branch | Error _ -> find_valid_alternative f p2
+      )
+  | _ -> f pat
+
+let no_explosion = function
+  | Normal -> Normal
+  | Counter_example info ->
+     Counter_example { info with explosion_fuel = 0 }
+
+let get_splitting_mode = function
+  | Normal -> None
+  | Counter_example {splitting_mode} -> Some splitting_mode
+
+let enter_nonsplit_or mode = match mode with
+  | Normal -> Normal
+  | Counter_example info ->
+     let splitting_mode = match info.splitting_mode with
+       | Backtrack_or ->
+          (* in Backtrack_or mode, or-patterns are always split *)
+          assert false
+       | Refine_or _ ->
+          Refine_or {inside_nonsplit_or = true}
+     in Counter_example { info with splitting_mode }
+
+(** The typedtree has two distinct syntactic categories for patterns,
+   "value" patterns, matching on values, and "computation" patterns
+   that match on the effect of a computation -- typically, exception
+   patterns (exception p).
+
+   On the other hand, the parsetree has an unstructured representation
+   where all categories of patterns are mixed together. The
+   decomposition according to the value/computation structure has to
+   happen during type-checking.
+
+   We don't want to duplicate the type-checking logic in two different
+   functions, depending on the kind of pattern to be produced. In
+   particular, there are both value and computation or-patterns, and
+   the type-checking logic for or-patterns is horribly complex; having
+   it in two different places would be twice as horirble.
+
+   The solution is to pass a GADT tag to [type_pat] to indicate whether
+   a value or computation pattern is expected. This way, there is a single
+   place where [Ppat_or] nodes are type-checked, the checking logic is shared,
+   and only at the end do we inspect the tag to decide to produce a value
+   or computation pattern.
+*)
+let pure
+  : type k . k pattern_category -> value general_pattern -> k general_pattern
+  = fun category pat ->
+  match category with
+  | Value -> pat
+  | Computation -> as_computation_pattern pat
+
+let only_impure
+  : type k . k pattern_category ->
+             computation general_pattern -> k general_pattern
+  = fun category pat ->
+  match category with
+  | Value ->
+     (* LATER: this exception could be renamed/generalized *)
+     raise (Error (pat.pat_loc, pat.pat_env,
+                   Exception_pattern_disallowed))
+  | Computation -> pat
+
+let as_comp_pattern
+  : type k . k pattern_category ->
+             k general_pattern -> computation general_pattern
+  = fun category pat ->
+  match category with
+  | Value -> as_computation_pattern pat
+  | Computation -> pat
+
+(* type_pat propagates the expected type.
+   Unification may update the typing environment.
+
+   In counter-example mode, [Empty_branch] is raised when the counter-example
+   does not match any value.  *)
+let rec type_pat
+  : type k r . k pattern_category -> no_existentials:_ -> mode:_ ->
+      env:_ -> _ -> _ -> (k general_pattern -> r) -> r
+  = fun category ~no_existentials ~mode
+        ~env sp expected_ty k ->
+  Builtin_attributes.warning_scope sp.ppat_attributes
+    (fun () ->
+       type_pat_aux category ~no_existentials ~mode
+         ~env sp expected_ty k
+    )
+
+and type_pat_aux
+  : type k r . k pattern_category -> no_existentials:_ -> mode:_ ->
+         env:_ -> _ -> _ -> (k general_pattern -> r) -> r
+  = fun category ~no_existentials ~mode
+      ~env sp expected_ty k ->
+  let type_pat category ?(mode=mode) ?(env=env) =
+    type_pat category ~no_existentials ~mode ~env
+  in
+  let loc = sp.ppat_loc in
+  let refine = match mode with Normal -> false | Counter_example _ -> true in
+  let unif (x : pattern) : pattern =
+    unify_pat ~refine env x (instance expected_ty);
+    x
+  in
+  let rp x =
+    let crp (x : k general_pattern) : k general_pattern =
+      match category with
+      | Value -> rp x
+      | Computation -> rcp x in
+    if mode = Normal then crp x else x in
+  let rp k x = k (rp x)
+  and rvp k x = k (rp (pure category x))
+  and rcp k x = k (rp (only_impure category x)) in
+  let construction_not_used_in_counterexamples = (mode = Normal) in
+  let must_backtrack_on_gadt = match get_splitting_mode mode with
+    | None -> false
+    | Some Backtrack_or -> false
+    | Some (Refine_or {inside_nonsplit_or}) -> inside_nonsplit_or
+  in
+  match sp.ppat_desc with
+    Ppat_any ->
+      let k' d = rvp k {
+        pat_desc = d;
+        pat_loc = loc; pat_extra=[];
+        pat_type = instance expected_ty;
+        pat_attributes = sp.ppat_attributes;
+        pat_env = !env }
+      in
+      begin match mode with
+      | Normal -> k' Tpat_any
+      | Counter_example {explosion_fuel; _} when explosion_fuel <= 0 ->
+          k' Tpat_any
+      | Counter_example ({explosion_fuel; _} as info) ->
+         let open Parmatch in
+         begin match ppat_of_type !env expected_ty with
+         | PT_empty -> raise Empty_branch
+         | PT_any -> k' Tpat_any
+         | PT_pattern (explosion, sp, constrs, labels) ->
+            let explosion_fuel =
+              match explosion with
+              | PE_single -> explosion_fuel - 1
+              | PE_gadt_cases ->
+                  if must_backtrack_on_gadt then raise Need_backtrack;
+                  explosion_fuel - 5
+            in
+            let mode =
+              Counter_example { info with explosion_fuel; constrs; labels }
+            in
+            type_pat category ~mode sp expected_ty k
+         end
+      end
+  | Ppat_var name ->
+      let ty = instance expected_ty in
+      let id = (* PR#7330 *)
+        if name.txt = "*extension*" then
+          Ident.create_local name.txt
+        else
+          enter_variable loc name ty sp.ppat_attributes
+      in
+      rvp k {
+        pat_desc = Tpat_var (id, name);
+        pat_loc = loc; pat_extra=[];
+        pat_type = ty;
+        pat_attributes = sp.ppat_attributes;
+        pat_env = !env }
+  | Ppat_unpack name ->
+      assert construction_not_used_in_counterexamples;
+      let t = instance expected_ty in
+      begin match name.txt with
+      | None ->
+          rvp k {
+            pat_desc = Tpat_any;
+            pat_loc = sp.ppat_loc;
+            pat_extra=[Tpat_unpack, name.loc, sp.ppat_attributes];
+            pat_type = t;
+            pat_attributes = [];
+            pat_env = !env }
+      | Some s ->
+          let v = { name with txt = s } in
+          let id = enter_variable loc v t ~is_module:true sp.ppat_attributes in
+          rvp k {
+            pat_desc = Tpat_var (id, v);
+            pat_loc = sp.ppat_loc;
+            pat_extra=[Tpat_unpack, loc, sp.ppat_attributes];
+            pat_type = t;
+            pat_attributes = [];
+            pat_env = !env }
+      end
+  | Ppat_constraint(
+      {ppat_desc=Ppat_var name; ppat_loc=lloc; ppat_attributes = attrs},
+      ({ptyp_desc=Ptyp_poly _} as sty)) ->
+      (* explicitly polymorphic type *)
+      assert construction_not_used_in_counterexamples;
+      let cty, force = Typetexp.transl_simple_type_delayed !env sty in
+      let ty = cty.ctyp_type in
+      unify_pat_types ~refine lloc env ty (instance expected_ty);
+      pattern_force := force :: !pattern_force;
+      begin match ty.desc with
+      | Tpoly (body, tyl) ->
+          begin_def ();
+          let _, ty' = instance_poly ~keep_names:true false tyl body in
+          end_def ();
+          generalize ty';
+          let id = enter_variable lloc name ty' attrs in
+          rvp k {
+            pat_desc = Tpat_var (id, name);
+            pat_loc = lloc;
+            pat_extra = [Tpat_constraint cty, loc, sp.ppat_attributes];
+            pat_type = ty;
+            pat_attributes = [];
+            pat_env = !env
+          }
+      | _ -> assert false
+      end
+  | Ppat_alias(sq, name) ->
+      assert construction_not_used_in_counterexamples;
+      type_pat Value sq expected_ty (fun q ->
+        begin_def ();
+        let ty_var = build_as_type env q in
+        end_def ();
+        generalize ty_var;
+        let id =
+          enter_variable ~is_as_variable:true loc name ty_var sp.ppat_attributes
+        in
+        rvp k {
+          pat_desc = Tpat_alias(q, id, name);
+          pat_loc = loc; pat_extra=[];
+          pat_type = q.pat_type;
+          pat_attributes = sp.ppat_attributes;
+          pat_env = !env })
+  | Ppat_constant cst ->
+      let cst = constant_or_raise !env loc cst in
+      rvp k @@ unif {
+        pat_desc = Tpat_constant cst;
+        pat_loc = loc; pat_extra=[];
+        pat_type = type_constant cst;
+        pat_attributes = sp.ppat_attributes;
+        pat_env = !env }
+  | Ppat_interval (Pconst_char c1, Pconst_char c2) ->
+      let open Ast_helper.Pat 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)
+        else
+          or_ ~loc:gloc
+            (constant ~loc:gloc (Pconst_char 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 category ~mode:(no_explosion mode) p expected_ty k
+        (* TODO: record 'extra' to remember about interval *)
+  | Ppat_interval _ ->
+      raise (Error (loc, !env, Invalid_interval))
+  | Ppat_tuple spl ->
+      assert (List.length spl >= 2);
+      let spl_ann = List.map (fun p -> (p,newgenvar ())) spl in
+      let ty = newgenty (Ttuple(List.map snd spl_ann)) in
+      begin_def ();
+      let expected_ty = instance expected_ty in
+      end_def ();
+      generalize_structure expected_ty;
+      unify_pat_types ~refine loc env ty expected_ty;
+      map_fold_cont (fun (p,t) -> type_pat Value p t) spl_ann (fun pl ->
+        rvp k {
+        pat_desc = Tpat_tuple pl;
+        pat_loc = loc; pat_extra=[];
+        pat_type = newty (Ttuple(List.map (fun p -> p.pat_type) pl));
+        pat_attributes = sp.ppat_attributes;
+        pat_env = !env })
+  | Ppat_construct(lid, sarg) ->
+      let expected_type =
+        try
+          let (p0, p, _) = extract_concrete_variant !env expected_ty in
+            Some (p0, p, true)
+        with Not_found -> None
+      in
+      let constr =
+        match lid.txt, mode with
+        | Longident.Lident s, Counter_example {constrs; _} ->
+           (* assert: cf. {!counter_example_checking_info} documentation *)
+            assert (Hashtbl.mem constrs s);
+            Hashtbl.find constrs s
+        | _ ->
+        let candidates =
+          Env.lookup_all_constructors Env.Pattern ~loc:lid.loc lid.txt !env in
+        wrap_disambiguate "This variant pattern is expected to have"
+          (mk_expected expected_ty)
+          (Constructor.disambiguate Env.Pattern lid !env expected_type)
+          candidates
+      in
+      if constr.cstr_generalized && must_backtrack_on_gadt then
+        raise Need_backtrack;
+      begin match no_existentials, constr.cstr_existentials with
+      | None, _ | _, [] -> ()
+      | Some r, (_ :: _ as exs)  ->
+          let exs = List.map (Ctype.existential_name constr) exs in
+          let name = constr.cstr_name in
+          raise (Error (loc, !env, Unexpected_existential (r,name, exs)))
+      end;
+      (* if constructor is gadt, we must verify that the expected type has the
+         correct head *)
+      if constr.cstr_generalized then
+        unify_head_only ~refine loc env (instance expected_ty) constr;
+      let sargs =
+        match sarg with
+          None -> []
+        | Some {ppat_desc = Ppat_tuple spl} when
+            constr.cstr_arity > 1 ||
+            Builtin_attributes.explicit_arity sp.ppat_attributes
+          -> spl
+        | Some({ppat_desc = Ppat_any} as sp) when constr.cstr_arity <> 1 ->
+            if constr.cstr_arity = 0 then
+              Location.prerr_warning sp.ppat_loc
+                                     Warnings.Wildcard_arg_to_constant_constr;
+            replicate_list sp constr.cstr_arity
+        | Some sp -> [sp] in
+      if Builtin_attributes.warn_on_literal_pattern constr.cstr_attributes then
+        begin match List.filter has_literal_pattern sargs with
+        | sp :: _ ->
+           Location.prerr_warning sp.ppat_loc Warnings.Fragile_literal_pattern
+        | _ -> ()
+        end;
+      if List.length sargs <> constr.cstr_arity then
+        raise(Error(loc, !env, Constructor_arity_mismatch(lid.txt,
+                                     constr.cstr_arity, List.length sargs)));
+      begin_def ();
+      let (ty_args, ty_res) =
+        instance_constructor ~in_pattern:(env, get_gadt_equations_level ())
+          constr
+      in
+      let expected_ty = instance expected_ty in
+      (* PR#7214: do not use gadt unification for toplevel lets *)
+      unify_pat_types loc env ty_res expected_ty
+        ~refine:(refine || constr.cstr_generalized && no_existentials = None);
+      end_def ();
+      generalize_structure expected_ty;
+      generalize_structure ty_res;
+      List.iter generalize_structure ty_args;
+
+      let rec check_non_escaping p =
+        match p.ppat_desc with
+        | Ppat_or (p1, p2) ->
+            check_non_escaping p1;
+            check_non_escaping p2
+        | Ppat_alias (p, _) ->
+            check_non_escaping p
+        | Ppat_constraint _ ->
+            raise (Error (p.ppat_loc, !env, Inlined_record_escape))
+        | _ ->
+            ()
+      in
+      if constr.cstr_inlined <> None then List.iter check_non_escaping sargs;
+
+      map_fold_cont
+        (fun (p,t) -> type_pat Value p t)
+        (List.combine sargs ty_args)
+        (fun args ->
+          rvp k {
+            pat_desc=Tpat_construct(lid, constr, args);
+            pat_loc = loc; pat_extra=[];
+            pat_type = instance expected_ty;
+            pat_attributes = sp.ppat_attributes;
+            pat_env = !env })
+  | Ppat_variant(l, sarg) ->
+      let arg_type = match sarg with None -> [] | Some _ -> [newgenvar()] in
+      let row = { row_fields =
+                    [l, Reither(sarg = None, arg_type, true, ref None)];
+                  row_bound = ();
+                  row_closed = false;
+                  row_more = newgenvar ();
+                  row_fixed = None;
+                  row_name = None } in
+      begin_def ();
+      let expected_ty = instance expected_ty in
+      end_def ();
+      generalize_structure expected_ty;
+      (* PR#7404: allow some_private_tag blindly, as it would not unify with
+         the abstract row variable *)
+      if l = Parmatch.some_private_tag
+      then assert (match mode with Normal -> false | Counter_example _ -> true)
+      else unify_pat_types ~refine loc env (newgenty(Tvariant row)) expected_ty;
+      let k arg =
+        rvp k {
+        pat_desc = Tpat_variant(l, arg, ref {row with row_more = newvar()});
+        pat_loc = loc; pat_extra=[];
+        pat_type = instance expected_ty;
+        pat_attributes = sp.ppat_attributes;
+        pat_env = !env }
+      in begin
+        (* PR#6235: propagate type information *)
+        match sarg, arg_type with
+          Some p, [ty] -> type_pat Value p ty (fun p -> k (Some p))
+        | _            -> k None
+      end
+  | Ppat_record(lid_sp_list, closed) ->
+      assert (lid_sp_list <> []);
+      let expected_type, record_ty =
+        try
+          let (p0, p,_) = extract_concrete_record !env expected_ty in
+          begin_def ();
+          let ty = instance expected_ty in
+          end_def ();
+          generalize_structure ty;
+          Some (p0, p, true), ty
+        with Not_found -> None, newvar ()
+      in
+      let type_label_pat (label_lid, label, sarg) k =
+        begin_def ();
+        let (_, ty_arg, ty_res) = instance_label false label in
+        begin try
+          unify_pat_types ~refine loc env ty_res (instance record_ty)
+        with Error(_loc, _env, Pattern_type_clash(trace, _)) ->
+          raise(Error(label_lid.loc, !env,
+                      Label_mismatch(label_lid.txt, trace)))
+        end;
+        end_def ();
+        generalize_structure ty_res;
+        generalize_structure ty_arg;
+        type_pat Value sarg ty_arg (fun arg ->
+          k (label_lid, label, arg))
+      in
+      let make_record_pat lbl_pat_list =
+        check_recordpat_labels loc lbl_pat_list closed;
+        {
+          pat_desc = Tpat_record (lbl_pat_list, closed);
+          pat_loc = loc; pat_extra=[];
+          pat_type = instance record_ty;
+          pat_attributes = sp.ppat_attributes;
+          pat_env = !env;
+        }
+      in
+      let k' pat = rvp k (unif pat) in
+      begin match mode with
+      | Normal ->
+          k' (wrap_disambiguate "This record pattern is expected to have"
+               (mk_expected expected_ty)
+               (type_label_a_list loc false !env type_label_pat expected_type
+                  lid_sp_list)
+               make_record_pat)
+      | Counter_example {labels; _} ->
+          type_label_a_list ~labels loc false !env type_label_pat expected_type
+            lid_sp_list (fun lbl_pat_list -> k' (make_record_pat lbl_pat_list))
+      end
+  | Ppat_array spl ->
+      let ty_elt = newgenvar() in
+      begin_def ();
+      let expected_ty = instance expected_ty in
+      end_def ();
+      generalize_structure expected_ty;
+      unify_pat_types ~refine
+        loc env (Predef.type_array ty_elt) expected_ty;
+      map_fold_cont (fun p -> type_pat Value p ty_elt) spl (fun pl ->
+        rvp k {
+        pat_desc = Tpat_array pl;
+        pat_loc = loc; pat_extra=[];
+        pat_type = instance expected_ty;
+        pat_attributes = sp.ppat_attributes;
+        pat_env = !env })
+  | Ppat_or(sp1, sp2) ->
+      let may_split, must_split =
+        match get_splitting_mode mode with
+        | None -> false, false
+        | Some Backtrack_or -> true, true
+        | Some (Refine_or _) -> true, false in
+      let state = save_state env in
+      let split_or sp =
+        assert may_split;
+        let typ pat = type_pat category pat expected_ty k in
+        find_valid_alternative (fun pat -> set_state state env; typ pat) sp in
+      if must_split then split_or sp else begin
+        let initial_pattern_variables = !pattern_variables in
+        let initial_module_variables = !module_variables in
+        let equation_level = !gadt_equations_level in
+        let outter_lev = get_current_level () in
+        (* introduce a new scope *)
+        begin_def ();
+        let lev = get_current_level () in
+        gadt_equations_level := Some lev;
+        let env1 = ref !env in
+        let inside_or = enter_nonsplit_or mode in
+        let type_pat_result env sp : (_, abort_reason) result =
+          match
+            type_pat category ~mode:inside_or sp expected_ty ~env (fun x -> x)
+          with
+          | res -> Ok res
+          | exception Need_backtrack -> Error Adds_constraints
+          | exception Empty_branch -> Error Empty
+        in
+        let p1 = type_pat_result env1 sp1 in
+        let p1_variables = !pattern_variables in
+        let p1_module_variables = !module_variables in
+        pattern_variables := initial_pattern_variables;
+        module_variables := initial_module_variables;
+        let env2 = ref !env in
+        let p2 = type_pat_result env2 sp2 in
+        end_def ();
+        gadt_equations_level := equation_level;
+        let p2_variables = !pattern_variables in
+        (* Make sure no variable with an ambiguous type gets added to the
+           environment. *)
+        List.iter (fun { pv_type; pv_loc; _ } ->
+          check_scope_escape pv_loc !env1 outter_lev pv_type
+        ) p1_variables;
+        List.iter (fun { pv_type; pv_loc; _ } ->
+          check_scope_escape pv_loc !env2 outter_lev pv_type
+        ) p2_variables;
+        begin match p1, p2 with
+        | Error Empty, Error Empty ->
+            raise Empty_branch
+        | Error Adds_constraints, Error _
+        | Error _, Error Adds_constraints ->
+            let inside_nonsplit_or =
+              match get_splitting_mode mode with
+              | None | Some Backtrack_or -> false
+              | Some (Refine_or {inside_nonsplit_or}) -> inside_nonsplit_or in
+            if inside_nonsplit_or
+            then raise Need_backtrack
+            else split_or sp
+        | Ok p, Error _
+        | Error _, Ok p ->
+            rp k p
+        | Ok p1, Ok p2 ->
+            let alpha_env =
+              enter_orpat_variables loc !env p1_variables p2_variables in
+            let p2 = alpha_pat alpha_env p2 in
+            pattern_variables := p1_variables;
+            module_variables := p1_module_variables;
+            let make_pat desc =
+              { pat_desc = desc;
+                pat_loc = loc; pat_extra=[];
+                pat_type = instance expected_ty;
+                pat_attributes = sp.ppat_attributes;
+                pat_env = !env } in
+            rp k (make_pat (Tpat_or(p1, p2, None)))
+        end
+      end
+  | Ppat_lazy sp1 ->
+      let nv = newgenvar () in
+      unify_pat_types ~refine loc env (Predef.type_lazy_t nv) expected_ty;
+      (* do not explode under lazy: PR#7421 *)
+      type_pat Value ~mode:(no_explosion mode) sp1 nv (fun p1 ->
+        rvp k {
+        pat_desc = Tpat_lazy p1;
+        pat_loc = loc; pat_extra=[];
+        pat_type = instance expected_ty;
+        pat_attributes = sp.ppat_attributes;
+        pat_env = !env })
+  | Ppat_constraint(sp, sty) ->
+      (* Pretend separate = true *)
+      begin_def();
+      let cty, force = Typetexp.transl_simple_type_delayed !env sty in
+      let ty = cty.ctyp_type in
+      end_def();
+      generalize_structure ty;
+      let ty, expected_ty' = instance ty, ty in
+      unify_pat_types ~refine loc env ty (instance expected_ty);
+      type_pat category sp expected_ty' (fun p ->
+        (*Format.printf "%a@.%a@."
+          Printtyp.raw_type_expr ty
+          Printtyp.raw_type_expr p.pat_type;*)
+        pattern_force := force :: !pattern_force;
+        let extra = (Tpat_constraint cty, loc, sp.ppat_attributes) in
+        let p : k general_pattern =
+          match category, (p : k general_pattern) with
+          | Value, {pat_desc = Tpat_var (id,s); _} ->
+            {p with
+              pat_type = ty;
+              pat_desc =
+                Tpat_alias
+                  ({p with pat_desc = Tpat_any; pat_attributes = []}, id,s);
+              pat_extra = [extra];
+            }
+          | _, p ->
+             { p with pat_type = ty; pat_extra = extra::p.pat_extra }
+        in k p)
+  | Ppat_type lid ->
+      let (path, p,ty) = build_or_pat !env loc lid in
+      unify_pat_types ~refine loc env ty (instance expected_ty);
+      k @@ pure category @@ { p with pat_extra =
+        (Tpat_type (path, lid), loc, sp.ppat_attributes)
+        :: p.pat_extra }
+  | Ppat_open (lid,p) ->
+      let path, new_env =
+        !type_open Asttypes.Fresh !env sp.ppat_loc lid in
+      let new_env = ref new_env in
+      type_pat category ~env:new_env p expected_ty ( fun p ->
+        env := Env.copy_local !env ~from:!new_env;
+        k { p with pat_extra =( Tpat_open (path,lid,!new_env),
+                            loc, sp.ppat_attributes) :: p.pat_extra }
+      )
+  | Ppat_exception p ->
+      type_pat Value p Predef.type_exn (fun p_exn ->
+      rcp k {
+        pat_desc = Tpat_exception p_exn;
+        pat_loc = sp.ppat_loc;
+        pat_extra = [];
+        pat_type = expected_ty;
+        pat_env = !env;
+        pat_attributes = sp.ppat_attributes;
+      })
+  | Ppat_extension ext ->
+      raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+let type_pat category ?no_existentials ?(mode=Normal)
+    ?(lev=get_current_level()) env sp expected_ty =
+  Misc.protect_refs [Misc.R (gadt_equations_level, Some lev)] (fun () ->
+      let r =
+        type_pat category ~no_existentials ~mode
+          ~env sp expected_ty (fun x -> x)
+      in
+      map_general_pattern { f = fun p -> { p with pat_env = !env } } r
+    )
+
+(* this function is passed to Partial.parmatch
+   to type check gadt nonexhaustiveness *)
+let partial_pred ~lev ~splitting_mode ?(explode=0)
+      env expected_ty constrs labels p =
+  let env = ref env in
+  let state = save_state env in
+  let mode =
+    Counter_example {
+        splitting_mode;
+        explosion_fuel = explode;
+        constrs; labels;
+      } in
+  try
+    reset_pattern None true;
+    let typed_p = type_pat Value ~lev ~mode env p expected_ty in
+    set_state state env;
+    (* types are invalidated but we don't need them here *)
+    Some typed_p
+  with Error _ | Empty_branch ->
+    set_state state env;
+    None
+
+let check_partial ?(lev=get_current_level ()) env expected_ty loc cases =
+  let explode = match cases with [_] -> 5 | _ -> 0 in
+  let splitting_mode = Refine_or {inside_nonsplit_or = false} in
+  Parmatch.check_partial
+    (partial_pred ~lev ~splitting_mode ~explode env expected_ty) loc cases
+
+let check_unused ?(lev=get_current_level ()) env expected_ty cases =
+  Parmatch.check_unused
+    (fun refute constrs labels spat ->
+      match
+        partial_pred ~lev ~splitting_mode:Backtrack_or ~explode:5
+          env expected_ty constrs labels spat
+      with
+        Some pat when refute ->
+          raise (Error (spat.ppat_loc, env, Unrefuted_pattern pat))
+      | r -> r)
+    cases
+
+let iter_pattern_variables_type f : pattern_variable list -> unit =
+  List.iter (fun {pv_type; _} -> f pv_type)
+
+let add_pattern_variables ?check ?check_as env pv =
+  List.fold_right
+    (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes} env ->
+       let check = if pv_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;
+          val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+         } env
+    )
+    pv env
+
+let type_pattern category ~lev env spat scope expected_ty =
+  reset_pattern scope true;
+  let new_env = ref env in
+  let pat = type_pat category ~lev new_env spat expected_ty in
+  let pvs = get_ref pattern_variables in
+  let unpacks = get_ref module_variables in
+  (pat, !new_env, get_ref pattern_force, pvs, unpacks)
+
+let type_pattern_list
+    category no_existentials env spatl scope expected_tys allow
+  =
+  reset_pattern scope allow;
+  let new_env = ref env in
+  let type_pat (attrs, pat) ty =
+    Builtin_attributes.warning_scope ~ppwarning:false attrs
+      (fun () ->
+         type_pat category ~no_existentials new_env pat ty
+      )
+  in
+  let patl = List.map2 type_pat spatl expected_tys in
+  let pvs = get_ref pattern_variables in
+  let unpacks =
+    List.map (fun (name, loc) ->
+      name, loc, Uid.mk ~current_unit:(Env.get_unit_name ())
+    ) (get_ref module_variables)
+  in
+  let new_env = add_pattern_variables !new_env pvs in
+  (patl, new_env, get_ref pattern_force, pvs, unpacks)
+
+let type_class_arg_pattern cl_num val_env met_env l spat =
+  reset_pattern None false;
+  let nv = newvar () in
+  let pat =
+    type_pat Value ~no_existentials:In_class_args (ref val_env) spat nv in
+  if has_variants pat then begin
+    Parmatch.pressure_variants val_env [pat];
+    finalize_variants pat;
+  end;
+  List.iter (fun f -> f()) (get_ref pattern_force);
+  if is_optional l then unify_pat (ref 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}
+        (pv, val_env, met_env) ->
+         let check s =
+           if pv_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_env =
+          Env.add_value pv_id
+            { val_type = pv_type
+            ; val_kind = Val_reg
+            ; val_attributes = pv_attributes
+            ; val_loc = pv_loc
+            ; val_uid
+            }
+            val_env
+         in
+         let met_env =
+          Env.add_value id' ~check
+            { val_type = pv_type
+            ; val_kind = Val_ivar (Immutable, cl_num)
+            ; val_attributes = pv_attributes
+            ; val_loc = pv_loc
+            ; val_uid
+            }
+            met_env
+         in
+         ((id', pv_id, pv_type)::pv, val_env, met_env))
+      !pattern_variables ([], val_env, met_env)
+  in
+  (pat, pv, val_env, met_env)
+
+let type_self_pattern cl_num privty val_env met_env par_env spat =
+  let open Ast_helper in
+  let spat =
+    Pat.mk (Ppat_alias (Pat.mk(Ppat_alias (spat, mknoloc "selfpat-*")),
+                        mknoloc ("selfpat-" ^ cl_num)))
+  in
+  reset_pattern None false;
+  let nv = newvar() in
+  let pat =
+    type_pat Value ~no_existentials:In_self_pattern (ref val_env) spat nv in
+  List.iter (fun f -> f()) (get_ref pattern_force);
+  let meths = ref Meths.empty in
+  let vars = ref Vars.empty in
+  let pv = !pattern_variables in
+  pattern_variables := [];
+  let (val_env, met_env, par_env) =
+    List.fold_right
+      (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes}
+           (val_env, met_env, par_env) ->
+         let name = Ident.name pv_id in
+         (Env.enter_unbound_value name Val_unbound_self val_env,
+          Env.add_value pv_id
+            {val_type = pv_type;
+             val_kind = Val_self (meths, vars, cl_num, privty);
+             val_attributes = pv_attributes;
+             val_loc = pv_loc;
+             val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+            }
+            ~check:(fun s -> if pv_as_var then Warnings.Unused_var s
+                             else Warnings.Unused_var_strict s)
+            met_env,
+          Env.enter_unbound_value name Val_unbound_self par_env))
+      pv (val_env, met_env, par_env)
+  in
+  (pat, meths, vars, val_env, met_env, par_env)
+
+let delayed_checks = ref []
+let reset_delayed_checks () = delayed_checks := []
+let add_delayed_check f =
+  delayed_checks := (f, Warnings.backup ()) :: !delayed_checks
+
+let force_delayed_checks () =
+  (* checks may change type levels *)
+  let snap = Btype.snapshot () in
+  let w_old = Warnings.backup () in
+  List.iter
+    (fun (f, w) -> Warnings.restore w; f ())
+    (List.rev !delayed_checks);
+  Warnings.restore w_old;
+  reset_delayed_checks ();
+  Btype.backtrack snap
+
+let rec final_subexpression exp =
+  match exp.exp_desc with
+    Texp_let (_, _, e)
+  | Texp_sequence (_, e)
+  | Texp_try (e, _)
+  | Texp_ifthenelse (_, e, _)
+  | Texp_match (_, {c_rhs=e} :: _, _)
+  | Texp_letmodule (_, _, _, _, e)
+  | Texp_letexception (_, e)
+  | Texp_open (_, e)
+    -> final_subexpression e
+  | _ -> exp
+
+(* Generalization criterion for expressions *)
+
+let rec is_nonexpansive exp =
+  match exp.exp_desc with
+  | Texp_ident _
+  | Texp_constant _
+  | Texp_unreachable
+  | Texp_function _
+  | Texp_array [] -> true
+  | Texp_let(_rec_flag, pat_exp_list, body) ->
+      List.for_all (fun vb -> is_nonexpansive vb.vb_expr) pat_exp_list &&
+      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, _) ->
+     (* 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... *)
+      let contains_exception_pat pat =
+        exists_general_pattern { f = fun (type k) (p : k general_pattern) ->
+          match p.pat_desc with
+          | Tpat_exception _ -> true
+          | _ -> false } pat
+      in
+      is_nonexpansive e &&
+      List.for_all
+        (fun {c_lhs; c_guard; c_rhs} ->
+           is_nonexpansive_opt c_guard && is_nonexpansive c_rhs
+           && not (contains_exception_pat c_lhs)
+        ) cases
+  | Texp_tuple el ->
+      List.for_all is_nonexpansive el
+  | Texp_construct( _, _, el) ->
+      List.for_all is_nonexpansive el
+  | Texp_variant(_, arg) -> is_nonexpansive_opt arg
+  | Texp_record { fields; extended_expression } ->
+      Array.for_all
+        (fun (lbl, definition) ->
+           match definition with
+           | Overridden (_, exp) ->
+               lbl.lbl_mut = Immutable && is_nonexpansive exp
+           | Kept _ -> true)
+        fields
+      && is_nonexpansive_opt extended_expression
+  | Texp_field(exp, _, _) -> is_nonexpansive exp
+  | Texp_ifthenelse(_cond, ifso, ifnot) ->
+      is_nonexpansive ifso && is_nonexpansive_opt ifnot
+  | Texp_sequence (_e1, e2) -> is_nonexpansive e2  (* PR#4354 *)
+  | Texp_new (_, _, cl_decl) -> Ctype.class_type_arity cl_decl.cty_type > 0
+  (* Note: nonexpansive only means no _observable_ side effects *)
+  | Texp_lazy e -> is_nonexpansive e
+  | Texp_object ({cstr_fields=fields; cstr_type = { csig_vars=vars}}, _) ->
+      let count = ref 0 in
+      List.for_all
+        (fun field -> match field.cf_desc with
+            Tcf_method _ -> true
+          | Tcf_val (_, _, _, Tcfk_concrete (_, e), _) ->
+              incr count; is_nonexpansive e
+          | Tcf_val (_, _, _, Tcfk_virtual _, _) ->
+              incr count; true
+          | Tcf_initializer e -> is_nonexpansive e
+          | Tcf_constraint _ -> true
+          | Tcf_inherit _ -> false
+          | Tcf_attribute _ -> true)
+        fields &&
+      Vars.fold (fun _ (mut,_,_) b -> decr count; b && mut = Immutable)
+        vars true &&
+      !count = 0
+  | Texp_letmodule (_, _, _, mexp, e)
+  | Texp_open ({ open_expr = mexp; _}, e) ->
+      is_nonexpansive_mod mexp && is_nonexpansive e
+  | Texp_pack mexp ->
+      is_nonexpansive_mod mexp
+  (* Computations which raise exceptions are nonexpansive, since (raise e) is
+     equivalent to (raise e; diverge), and a nonexpansive "diverge" can be
+     produced using lazy values or the relaxed value restriction.
+     See GPR#1142 *)
+  | Texp_assert exp ->
+      is_nonexpansive exp
+  | Texp_apply (
+      { exp_desc = Texp_ident (_, _, {val_kind =
+             Val_prim {Primitive.prim_name =
+                         ("%raise" | "%reraise" | "%raise_notrace")}}) },
+      [Nolabel, Some e]) ->
+     is_nonexpansive e
+  | Texp_array (_ :: _)
+  | Texp_apply _
+  | Texp_try _
+  | Texp_setfield _
+  | Texp_while _
+  | Texp_for _
+  | Texp_send _
+  | Texp_instvar _
+  | Texp_setinstvar _
+  | Texp_override _
+  | Texp_letexception _
+  | Texp_letop _
+  | Texp_extension_constructor _ ->
+    false
+
+and is_nonexpansive_mod mexp =
+  match mexp.mod_desc with
+  | Tmod_ident _
+  | Tmod_functor _ -> true
+  | Tmod_unpack (e, _) -> is_nonexpansive e
+  | Tmod_constraint (m, _, _, _) -> is_nonexpansive_mod m
+  | Tmod_structure str ->
+      List.for_all
+        (fun item -> match item.str_desc with
+          | Tstr_eval _ | Tstr_primitive _ | Tstr_type _
+          | Tstr_modtype _ | Tstr_class_type _  -> true
+          | Tstr_value (_, pat_exp_list) ->
+              List.for_all (fun vb -> is_nonexpansive vb.vb_expr) pat_exp_list
+          | Tstr_module {mb_expr=m;_}
+          | Tstr_open {open_expr=m;_}
+          | Tstr_include {incl_mod=m;_} -> is_nonexpansive_mod m
+          | Tstr_recmodule id_mod_list ->
+              List.for_all (fun {mb_expr=m;_} -> is_nonexpansive_mod m)
+                id_mod_list
+          | Tstr_exception {tyexn_constructor = {ext_kind = Text_decl _}} ->
+              false (* true would be unsound *)
+          | Tstr_exception {tyexn_constructor = {ext_kind = Text_rebind _}} ->
+              true
+          | Tstr_typext te ->
+              List.for_all
+                (function {ext_kind = Text_decl _} -> false
+                        | {ext_kind = Text_rebind _} -> true)
+                te.tyext_constructors
+          | Tstr_class _ -> false (* could be more precise *)
+          | Tstr_attribute _ -> true
+        )
+        str.str_items
+  | Tmod_apply _ -> false
+
+and is_nonexpansive_opt = function
+  | None -> true
+  | Some e -> is_nonexpansive e
+
+let maybe_expansive e = not (is_nonexpansive e)
+
+let check_recursive_bindings env valbinds =
+  let ids = let_bound_idents valbinds in
+  List.iter
+    (fun {vb_expr} ->
+       if not (Rec_check.is_valid_recursive_expression ids vb_expr) then
+         raise(Error(vb_expr.exp_loc, env, Illegal_letrec_expr))
+    )
+    valbinds
+
+let check_recursive_class_bindings env ids exprs =
+  List.iter
+    (fun expr ->
+       if not (Rec_check.is_valid_class_expr ids expr) then
+         raise(Error(expr.cl_loc, env, Illegal_class_expr)))
+    exprs
+
+let is_prim ~name funct =
+  match funct.exp_desc with
+  | Texp_ident (_, _, {val_kind=Val_prim{Primitive.prim_name; _}}) ->
+      prim_name = name
+  | _ -> false
+(* Approximate the type of an expression, for better recursion *)
+
+let rec approx_type env sty =
+  match sty.ptyp_desc with
+    Ptyp_arrow (p, _, sty) ->
+      let ty1 = if is_optional p then type_option (newvar ()) else newvar () in
+      newty (Tarrow (p, ty1, approx_type env sty, Cok))
+  | Ptyp_tuple args ->
+      newty (Ttuple (List.map (approx_type env) args))
+  | Ptyp_constr (lid, ctl) ->
+      let path, decl = Env.lookup_type ~use:false ~loc:lid.loc lid.txt env in
+      if List.length ctl <> decl.type_arity then newvar ()
+      else begin
+        let tyl = List.map (approx_type env) ctl in
+        newconstr path tyl
+      end
+  | Ptyp_poly (_, sty) ->
+      approx_type env sty
+  | _ -> newvar ()
+
+let rec type_approx env sexp =
+  match sexp.pexp_desc with
+    Pexp_let (_, _, e) -> type_approx env e
+  | Pexp_fun (p, _, _, e) ->
+      let ty = if is_optional p then type_option (newvar ()) else newvar () in
+      newty (Tarrow(p, ty, type_approx env e, Cok))
+  | Pexp_function ({pc_rhs=e}::_) ->
+      newty (Tarrow(Nolabel, newvar (), type_approx env e, Cok))
+  | Pexp_match (_, {pc_rhs=e}::_) -> type_approx env e
+  | Pexp_try (e, _) -> type_approx env e
+  | Pexp_tuple l -> newty (Ttuple(List.map (type_approx env) l))
+  | Pexp_ifthenelse (_,e,_) -> type_approx env e
+  | Pexp_sequence (_,e) -> type_approx env e
+  | Pexp_constraint (e, sty) ->
+      let ty = type_approx env e in
+      let ty1 = approx_type env sty in
+      begin try unify env ty ty1 with Unify trace ->
+        raise(Error(sexp.pexp_loc, env, Expr_type_clash (trace, None, None)))
+      end;
+      ty1
+  | Pexp_coerce (e, sty1, sty2) ->
+      let approx_ty_opt = function
+        | None -> newvar ()
+        | Some sty -> approx_type env sty
+      in
+      let ty = type_approx env e
+      and ty1 = approx_ty_opt sty1
+      and ty2 = approx_type env sty2 in
+      begin try unify env ty ty1 with Unify trace ->
+        raise(Error(sexp.pexp_loc, env, Expr_type_clash (trace, None, None)))
+      end;
+      ty2
+  | _ -> newvar ()
+
+(* List labels in a function type, and whether return type is a variable *)
+let rec list_labels_aux env visited ls ty_fun =
+  let ty = expand_head env ty_fun in
+  if List.memq ty visited then
+    List.rev ls, false
+  else match ty.desc with
+    Tarrow (l, _, ty_res, _) ->
+      list_labels_aux env (ty::visited) (l::ls) ty_res
+  | _ ->
+      List.rev ls, is_Tvar ty
+
+let list_labels env ty =
+  wrap_trace_gadt_instances env (list_labels_aux env [] []) ty
+
+(* 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
+  begin_def ();
+  let exp_ty, vars =
+    match pty.desc with
+      Tpoly (body, tl) ->
+        (* Enforce scoping for type_let:
+           since body is not generic,  instance_poly only makes
+           copies of nodes that have a Tvar as descendant *)
+        let _, ty' = instance_poly 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
+    | _ -> assert false
+  in
+  end_def ();
+  generalize exp_ty;
+  List.iter generalize vars;
+  let ty, complete = polyfy env exp_ty vars in
+  if not complete then
+    let ty_expected = instance ty_expected in
+    raise (Error (exp.exp_loc, env,
+                  Less_general(kind, [Unification_trace.diff ty 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
+
+let check_partial_application statement exp =
+  let rec f delay =
+    let ty = (expand_head exp.exp_env exp.exp_type).desc in
+    let check_statement () =
+      match ty with
+      | Tconstr (p, _, _)  when Path.same p Predef.path_unit ->
+          ()
+      | _ ->
+          if statement then
+            let rec loop {exp_loc; exp_desc; exp_extra; _} =
+              match exp_desc with
+              | Texp_let (_, _, e)
+              | Texp_sequence (_, e)
+              | Texp_letexception (_, e)
+              | Texp_letmodule (_, _, _, _, e) ->
+                  loop e
+              | _ ->
+                  let loc =
+                    match List.find_opt (function
+                        | (Texp_constraint _, _, _) -> true
+                        | _ -> false) exp_extra
+                    with
+                    | Some (_, loc, _) -> loc
+                    | None -> exp_loc
+                  in
+                  Location.prerr_warning loc Warnings.Statement_type
+            in
+            loop exp
+    in
+    match ty, exp.exp_desc with
+    | Tarrow _, _ ->
+        let rec check {exp_desc; exp_loc; exp_extra; _} =
+          if List.exists (function
+              | (Texp_constraint _, _, _) -> true
+              | _ -> false) exp_extra then check_statement ()
+          else begin
+            match exp_desc with
+            | Texp_ident _ | Texp_constant _ | Texp_tuple _
+            | Texp_construct _ | Texp_variant _ | Texp_record _
+            | Texp_field _ | Texp_setfield _ | Texp_array _
+            | Texp_while _ | Texp_for _ | Texp_instvar _
+            | Texp_setinstvar _ | Texp_override _ | Texp_assert _
+            | Texp_lazy _ | Texp_object _ | Texp_pack _ | Texp_unreachable
+            | 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_ifthenelse (_, e1, Some e2) ->
+                check e1; check e2
+            | Texp_let (_, _, e) | Texp_sequence (_, e) | Texp_open (_, e)
+            | Texp_letexception (_, e) | Texp_letmodule (_, _, _, _, e) ->
+                check e
+            | Texp_apply _ | Texp_send _ | Texp_new _ | Texp_letop _ ->
+                Location.prerr_warning exp_loc Warnings.Partial_application
+          end
+        in
+        check exp
+    | Tvar _, _ ->
+        if delay then add_delayed_check (fun () -> f false)
+    | _ ->
+        check_statement ()
+  in
+  f true
+
+(* Check that a type is generalizable at some level *)
+let generalizable level ty =
+  let rec check ty =
+    let ty = repr ty in
+    if ty.level < lowest_level then () else
+    if ty.level <= level then raise Exit else
+    (mark_type_node ty; iter_type_expr check ty)
+  in
+  try check ty; unmark_type ty; true
+  with Exit -> unmark_type ty; false
+
+(* Hack to allow coercion of self. Will clean-up later. *)
+let self_coercion = ref ([] : (Path.t * Location.t list ref) list)
+
+(* Helpers for packaged modules. *)
+let create_package_type loc env (p, l) =
+  let s = !Typetexp.transl_modtype_longident loc env p in
+  let fields = List.map (fun (name, ct) ->
+                           name, Typetexp.transl_simple_type env false ct) l in
+  let ty = newty (Tpackage (s,
+                    List.map fst l,
+                   List.map (fun (_, cty) -> cty.ctyp_type) fields))
+  in
+   (s, fields, ty)
+
+(* Helpers for type_cases *)
+
+let contains_variant_either ty =
+  let rec loop ty =
+    let ty = repr ty in
+    if ty.level >= lowest_level then begin
+      mark_type_node ty;
+      match ty.desc with
+        Tvariant row ->
+          let row = row_repr row in
+          if not (is_fixed row) then
+            List.iter
+              (fun (_,f) ->
+                match row_field_repr f with Reither _ -> raise Exit | _ -> ())
+              row.row_fields;
+          iter_row loop row
+      | _ ->
+          iter_type_expr loop ty
+    end
+  in
+  try loop ty; unmark_type ty; false
+  with Exit -> unmark_type ty; true
+
+let shallow_iter_ppat f p =
+  match p.ppat_desc with
+  | Ppat_any | Ppat_var _ | Ppat_constant _ | Ppat_interval _
+  | Ppat_extension _
+  | Ppat_type _ | Ppat_unpack _ -> ()
+  | Ppat_array pats -> List.iter f pats
+  | Ppat_or (p1,p2) -> f p1; f p2
+  | Ppat_variant (_, arg) | Ppat_construct (_, arg) -> Option.iter f arg
+  | Ppat_tuple lst ->  List.iter f lst
+  | Ppat_exception p | Ppat_alias (p,_)
+  | Ppat_open (_,p)
+  | Ppat_constraint (p,_) | Ppat_lazy p -> f p
+  | Ppat_record (args, _flag) -> List.iter (fun (_,p) -> f p) args
+
+let exists_ppat f p =
+  let exception Found in
+  let rec loop p =
+    if f p then raise Found else ();
+    shallow_iter_ppat loop p in
+  match loop p with
+  | exception Found -> true
+  | () -> false
+
+let contains_polymorphic_variant p =
+  exists_ppat
+    (function
+     | {ppat_desc = (Ppat_variant _ | Ppat_type _)} -> true
+     | _ -> false)
+    p
+
+let contains_gadt p =
+  exists_general_pattern { f = fun (type k) (p : k general_pattern) ->
+     match p.pat_desc with
+     | Tpat_construct (_, cd, _) when cd.cstr_generalized -> true
+     | _ -> false } p
+
+(* There are various things that we need to do in presence of GADT constructors
+   that aren't required if there are none.
+   However, because of disambiguation, we can't know for sure whether the
+   patterns contain some GADT constructors. So we conservatively assume that
+   any constructor might be a GADT constructor. *)
+let may_contain_gadts p =
+  exists_ppat
+  (function
+   | {ppat_desc = Ppat_construct (_, _)} -> true
+   | _ -> false)
+  p
+
+let check_absent_variant env =
+  iter_general_pattern { f = fun (type k) (pat : k general_pattern) ->
+    match pat.pat_desc with
+    | Tpat_variant (s, arg, row) ->
+      let row = row_repr !row in
+      if List.exists (fun (s',fi) -> s = s' && row_field_repr fi <> Rabsent)
+          row.row_fields
+      || 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
+      let row' = {row_fields = [s, Reither(arg=None,ty_arg,true,ref None)];
+                  row_more = newvar (); row_bound = ();
+                  row_closed = false; row_fixed = None; row_name = None} in
+      (* Should fail *)
+      unify_pat (ref env) {pat with pat_type = newty (Tvariant row')}
+                          (correct_levels pat.pat_type)
+    | _ -> () }
+
+(* Getting proper location of already typed expressions.
+
+   Used to avoid confusing locations on type error messages in presence of
+   type constraints.
+   For example:
+
+       (* Before patch *)
+       # let x : string = (5 : int);;
+                           ^
+       (* After patch *)
+       # let x : string = (5 : int);;
+                          ^^^^^^^^^
+*)
+let proper_exp_loc exp =
+  let rec aux = function
+    | [] -> exp.exp_loc
+    | ((Texp_constraint _ | Texp_coerce _), loc, _) :: _ -> loc
+    | _ :: rest -> aux rest
+  in
+  aux exp.exp_extra
+
+(* To find reasonable names for let-bound and lambda-bound idents *)
+
+let rec name_pattern default = function
+    [] -> Ident.create_local default
+  | p :: rem ->
+    match p.pat_desc with
+      Tpat_var (id, _) -> id
+    | Tpat_alias(_, id, _) -> id
+    | _ -> name_pattern default rem
+
+let name_cases default lst =
+  name_pattern default (List.map (fun c -> c.c_lhs) lst)
+
+(* Typing of expressions *)
+
+let unify_exp 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(trace, tfc, None)) ->
+    raise (Error(loc, env, Expr_type_clash(trace, tfc, Some exp.exp_desc)))
+
+let rec type_exp ?recarg env sexp =
+  (* We now delegate everything to type_expect *)
+  type_expect ?recarg env sexp (mk_expected (newvar ()))
+
+(* Typing of an expression with an expected type.
+   This provide better error messages, and allows controlled
+   propagation of return type information.
+   In the principal case, [type_expected'] may be at generic_level.
+ *)
+
+and type_expect ?in_function ?recarg env sexp ty_expected_explained =
+  let previous_saved_types = Cmt_format.get_saved_types () in
+  let exp =
+    Builtin_attributes.warning_scope sexp.pexp_attributes
+      (fun () ->
+         type_expect_ ?in_function ?recarg env sexp ty_expected_explained
+      )
+  in
+  Cmt_format.set_saved_types
+    (Cmt_format.Partial_expression exp :: previous_saved_types);
+  exp
+
+and with_explanation explanation f =
+  match explanation with
+  | None -> f ()
+  | Some explanation ->
+      try f ()
+      with Error (loc', env', Expr_type_clash(trace', None, exp'))
+        when not loc'.Location.loc_ghost ->
+        let err = Expr_type_clash(trace', Some explanation, exp') in
+        raise (Error (loc', env', err))
+
+and type_expect_
+    ?in_function ?(recarg=Rejected)
+    env sexp ty_expected_explained =
+  let { ty = ty_expected; explanation } = ty_expected_explained in
+  let loc = sexp.pexp_loc in
+  (* Record the expression type before unifying it with the expected type *)
+  let with_explanation = with_explanation explanation in
+  let rue exp =
+    with_explanation (fun () ->
+      unify_exp env (re exp) (instance ty_expected));
+    exp
+  in
+  match sexp.pexp_desc with
+  | Pexp_ident lid ->
+      let path, desc = type_ident env ~recarg lid in
+      let exp_desc =
+        match desc.val_kind with
+        | Val_ivar (_, cl_num) ->
+            let (self_path, _) =
+              Env.find_value_by_name
+                (Longident.Lident ("self-" ^ cl_num)) env
+            in
+            Texp_instvar(self_path, path,
+                         match lid.txt with
+                             Longident.Lident txt -> { txt; loc = lid.loc }
+                           | _ -> assert false)
+        | Val_self (_, _, cl_num, _) ->
+            let (path, _) =
+              Env.find_value_by_name (Longident.Lident ("self-" ^ cl_num)) env
+            in
+            Texp_ident(path, lid, desc)
+        | _ ->
+            Texp_ident(path, lid, desc)
+      in
+      rue {
+        exp_desc; exp_loc = loc; exp_extra = [];
+        exp_type = instance desc.val_type;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  | Pexp_constant(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 ty_expected in
+    let fmt6_path =
+      Path.(Pdot (Pident (Ident.create_persistent "CamlinternalFormatBasics"),
+                  "format6"))
+    in
+    let is_format = match ty_exp.desc with
+      | Tconstr(path, _, _) when Path.same path fmt6_path ->
+        if !Clflags.principal && ty_exp.level <> generic_level then
+          Location.prerr_warning loc
+            (Warnings.Not_principal "this coercion to format6");
+        true
+      | _ -> false
+    in
+    if is_format then
+      let format_parsetree =
+        { (type_format loc str env) with pexp_loc = sexp.pexp_loc }  in
+      type_expect ?in_function env format_parsetree ty_expected_explained
+    else
+      rue {
+        exp_desc = Texp_constant cst;
+        exp_loc = loc; exp_extra = [];
+        exp_type = instance Predef.type_string;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  )
+  | Pexp_constant cst ->
+      let cst = constant_or_raise env loc cst in
+      rue {
+        exp_desc = Texp_constant cst;
+        exp_loc = loc; exp_extra = [];
+        exp_type = type_constant cst;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  | Pexp_let(Nonrecursive,
+             [{pvb_pat=spat; pvb_expr=sval; pvb_attributes=[]}], sbody)
+    when may_contain_gadts spat ->
+    (* TODO: allow non-empty attributes? *)
+      type_expect ?in_function env
+        {sexp with
+         pexp_desc = Pexp_match (sval, [Ast_helper.Exp.case spat sbody])}
+        ty_expected_explained
+  | Pexp_let(rec_flag, spat_sexp_list, sbody) ->
+      let existential_context =
+        if rec_flag = Recursive then In_rec
+        else if List.compare_length_with spat_sexp_list 1 > 0 then In_group
+        else With_attributes in
+      let scp =
+        match sexp.pexp_attributes, rec_flag with
+        | [{attr_name = {txt="#default"}; _}], _ -> None
+        | _, Recursive -> Some (Annot.Idef loc)
+        | _, Nonrecursive -> Some (Annot.Idef sbody.pexp_loc)
+      in
+      let (pat_exp_list, new_env, unpacks) =
+        type_let existential_context env rec_flag spat_sexp_list scp true in
+      let body = type_unpacks new_env unpacks sbody ty_expected_explained in
+      let () =
+        if rec_flag = Recursive then
+          check_recursive_bindings env pat_exp_list
+      in
+      re {
+        exp_desc = Texp_let(rec_flag, pat_exp_list, body);
+        exp_loc = loc; exp_extra = [];
+        exp_type = body.exp_type;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  | Pexp_fun (l, Some default, spat, sbody) ->
+      assert(is_optional l); (* default allowed only with optional argument *)
+      let open Ast_helper in
+      let default_loc = default.pexp_loc in
+      let scases = [
+        Exp.case
+          (Pat.construct ~loc:default_loc
+             (mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))))
+             (Some (Pat.var ~loc:default_loc (mknoloc "*sth*"))))
+          (Exp.ident ~loc:default_loc (mknoloc (Longident.Lident "*sth*")));
+
+        Exp.case
+          (Pat.construct ~loc:default_loc
+             (mknoloc (Longident.(Ldot (Lident "*predef*", "None"))))
+             None)
+          default;
+       ]
+      in
+      let sloc =
+        { Location.loc_start = spat.ppat_loc.Location.loc_start;
+          loc_end = default_loc.Location.loc_end;
+          loc_ghost = true }
+      in
+      let smatch =
+        Exp.match_ ~loc:sloc
+          (Exp.ident ~loc (mknoloc (Longident.Lident "*opt*")))
+          scases
+      in
+      let pat = Pat.var ~loc:sloc (mknoloc "*opt*") in
+      let body =
+        Exp.let_ ~loc Nonrecursive
+          ~attrs:[Attr.mk (mknoloc "#default") (PStr [])]
+          [Vb.mk spat smatch] sbody
+      in
+      type_function ?in_function loc sexp.pexp_attributes env
+                    ty_expected_explained l [Exp.case pat body]
+  | Pexp_fun (l, None, spat, sbody) ->
+      type_function ?in_function loc sexp.pexp_attributes env
+                    ty_expected_explained l [Ast_helper.Exp.case spat sbody]
+  | Pexp_function caselist ->
+      type_function ?in_function
+        loc sexp.pexp_attributes env ty_expected_explained Nolabel caselist
+  | Pexp_apply(sfunct, sargs) ->
+      assert (sargs <> []);
+      begin_def (); (* one more level for non-returning functions *)
+      if !Clflags.principal then begin_def ();
+      let funct = type_exp env sfunct in
+      if !Clflags.principal then begin
+          end_def ();
+          generalize_structure funct.exp_type
+        end;
+      let rec lower_args seen ty_fun =
+        let ty = expand_head env ty_fun in
+        if List.memq ty seen then () else
+        match ty.desc with
+          Tarrow (_l, ty_arg, ty_fun, _com) ->
+            (try unify_var env (newvar()) ty_arg with Unify _ -> assert false);
+            lower_args (ty::seen) ty_fun
+        | _ -> ()
+      in
+      let ty = instance funct.exp_type in
+      end_def ();
+      wrap_trace_gadt_instances env (lower_args []) ty;
+      begin_def ();
+      let (args, ty_res) = type_application env funct sargs in
+      end_def ();
+      unify_var env (newvar()) funct.exp_type;
+      rue {
+        exp_desc = Texp_apply(funct, args);
+        exp_loc = loc; exp_extra = [];
+        exp_type = ty_res;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  | Pexp_match(sarg, caselist) ->
+      begin_def ();
+      let arg = type_exp env sarg in
+      end_def ();
+      if maybe_expansive arg then lower_contravariant env arg.exp_type;
+      generalize arg.exp_type;
+      let cases, partial =
+        type_cases Computation env arg.exp_type ty_expected true loc caselist in
+      re {
+        exp_desc = Texp_match(arg, 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 false loc caselist in
+      re {
+        exp_desc = Texp_try(body, cases);
+        exp_loc = loc; exp_extra = [];
+        exp_type = body.exp_type;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  | Pexp_tuple sexpl ->
+      assert (List.length sexpl >= 2);
+      let subtypes = List.map (fun _ -> newgenvar ()) sexpl in
+      let to_unify = newgenty (Ttuple subtypes) in
+      with_explanation (fun () ->
+        unify_exp_types loc env to_unify ty_expected);
+      let expl =
+        List.map2 (fun body ty -> type_expect env body (mk_expected ty))
+          sexpl subtypes
+      in
+      re {
+        exp_desc = Texp_tuple expl;
+        exp_loc = loc; exp_extra = [];
+        (* Keep sharing *)
+        exp_type = newty (Ttuple (List.map (fun e -> e.exp_type) expl));
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  | Pexp_construct(lid, sarg) ->
+      type_construct env loc lid sarg ty_expected_explained sexp.pexp_attributes
+  | Pexp_variant(l, sarg) ->
+      (* Keep sharing *)
+      let ty_expected0 = instance ty_expected in
+      begin try match
+        sarg, expand_head env ty_expected, expand_head env ty_expected0 with
+      | Some sarg, {desc = Tvariant row}, {desc = Tvariant row0} ->
+          let row = row_repr row in
+          begin match row_field_repr (List.assoc l row.row_fields),
+          row_field_repr (List.assoc l row0.row_fields) with
+            Rpresent (Some ty), Rpresent (Some ty0) ->
+              let arg = type_argument env sarg ty ty0 in
+              re { exp_desc = Texp_variant(l, Some arg);
+                   exp_loc = loc; exp_extra = [];
+                   exp_type = ty_expected0;
+                   exp_attributes = sexp.pexp_attributes;
+                   exp_env = env }
+          | _ -> raise Not_found
+          end
+      | _ -> raise Not_found
+      with Not_found ->
+        let arg = Option.map (type_exp env) sarg in
+        let arg_type = Option.map (fun arg -> arg.exp_type) arg in
+        rue {
+          exp_desc = Texp_variant(l, arg);
+          exp_loc = loc; exp_extra = [];
+          exp_type= newty (Tvariant{row_fields = [l, Rpresent arg_type];
+                                    row_more = newvar ();
+                                    row_bound = ();
+                                    row_closed = false;
+                                    row_fixed = None;
+                                    row_name = None});
+          exp_attributes = sexp.pexp_attributes;
+          exp_env = env }
+      end
+  | Pexp_record(lid_sexp_list, opt_sexp) ->
+      assert (lid_sexp_list <> []);
+      let opt_exp =
+        match opt_sexp with
+          None -> None
+        | Some sexp ->
+            if !Clflags.principal then begin_def ();
+            let exp = type_exp ~recarg env sexp in
+            if !Clflags.principal then begin
+              end_def ();
+              generalize_structure exp.exp_type
+            end;
+            Some exp
+      in
+      let ty_record, expected_type =
+        let get_path ty =
+          try
+            let (p0, p,_) = extract_concrete_record env ty in
+            let principal =
+              (repr ty).level = generic_level || not !Clflags.principal
+            in
+            Some (p0, p, principal)
+          with Not_found -> None
+        in
+        match get_path ty_expected with
+          None ->
+            begin match opt_exp with
+              None -> newvar (), None
+            | Some exp ->
+                match get_path exp.exp_type with
+                  None -> newvar (), None
+                | Some (_, p', _) as op ->
+                    let decl = Env.find_type p' env in
+                    begin_def ();
+                    let ty =
+                      newconstr p' (instance_list decl.type_params) in
+                    end_def ();
+                    generalize_structure ty;
+                    ty, op
+            end
+        | op -> ty_expected, op
+      in
+      let closed = (opt_sexp = None) in
+      let lbl_exp_list =
+        wrap_disambiguate "This record expression is expected to have"
+          (mk_expected ty_record)
+          (type_label_a_list loc closed env
+             (fun e k -> k (type_label_exp true env loc ty_record e))
+             expected_type lid_sexp_list)
+          (fun x -> x)
+      in
+      with_explanation (fun () ->
+        unify_exp_types loc env ty_record (instance ty_expected));
+
+      (* type_label_a_list returns a list of labels sorted by lbl_pos *)
+      (* note: check_duplicates would better be implemented in
+         type_label_a_list directly *)
+      let rec check_duplicates = function
+        | (_, lbl1, _) :: (_, lbl2, _) :: _ when lbl1.lbl_pos = lbl2.lbl_pos ->
+          raise(Error(loc, env, Label_multiply_defined lbl1.lbl_name))
+        | _ :: rem ->
+            check_duplicates rem
+        | [] -> ()
+      in
+      check_duplicates lbl_exp_list;
+      let opt_exp, label_definitions =
+        let (_lid, lbl, _lbl_exp) = List.hd lbl_exp_list in
+        let matching_label lbl =
+          List.find
+            (fun (_, lbl',_) -> lbl'.lbl_pos = lbl.lbl_pos)
+            lbl_exp_list
+        in
+        match opt_exp with
+          None ->
+            let label_definitions =
+              Array.map (fun lbl ->
+                  match matching_label lbl with
+                  | (lid, _lbl, lbl_exp) ->
+                      Overridden (lid, lbl_exp)
+                  | exception Not_found ->
+                      let present_indices =
+                        List.map (fun (_, lbl, _) -> lbl.lbl_pos) lbl_exp_list
+                      in
+                      let label_names = extract_label_names env ty_expected in
+                      let rec missing_labels n = function
+                          [] -> []
+                        | lbl :: rem ->
+                            if List.mem n present_indices
+                            then missing_labels (n + 1) rem
+                            else lbl :: missing_labels (n + 1) rem
+                      in
+                      let missing = missing_labels 0 label_names in
+                      raise(Error(loc, env, Label_missing missing)))
+                lbl.lbl_all
+            in
+            None, label_definitions
+        | Some exp ->
+            let ty_exp = instance exp.exp_type in
+            let unify_kept lbl =
+              let _, ty_arg1, ty_res1 = instance_label false lbl in
+              unify_exp_types exp.exp_loc env ty_exp ty_res1;
+              match matching_label lbl with
+              | lid, _lbl, lbl_exp ->
+                  (* do not connect result types for overridden labels *)
+                  Overridden (lid, lbl_exp)
+              | exception Not_found -> begin
+                  let _, ty_arg2, ty_res2 = instance_label false lbl in
+                  unify_exp_types loc env ty_arg1 ty_arg2;
+                  with_explanation (fun () ->
+                    unify_exp_types loc env (instance ty_expected) ty_res2);
+                  Kept ty_arg1
+                end
+            in
+            let label_definitions = Array.map unify_kept lbl.lbl_all in
+            Some {exp with exp_type = ty_exp}, label_definitions
+      in
+      let num_fields =
+        match lbl_exp_list with [] -> assert false
+        | (_, lbl,_)::_ -> Array.length lbl.lbl_all in
+      if opt_sexp <> None && List.length lid_sexp_list = num_fields then
+        Location.prerr_warning loc Warnings.Useless_record_with;
+      let label_descriptions, representation =
+        let (_, { lbl_all; lbl_repres }, _) = List.hd lbl_exp_list in
+        lbl_all, lbl_repres
+      in
+      let fields =
+        Array.map2 (fun descr def -> descr, def)
+          label_descriptions label_definitions
+      in
+      re {
+        exp_desc = Texp_record {
+            fields; representation;
+            extended_expression = opt_exp
+          };
+        exp_loc = loc; exp_extra = [];
+        exp_type = instance ty_expected;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  | Pexp_field(srecord, lid) ->
+      let (record, label, _) = type_label_access env srecord lid in
+      let (_, ty_arg, ty_res) = instance_label false label in
+      unify_exp env record ty_res;
+      rue {
+        exp_desc = Texp_field(record, lid, label);
+        exp_loc = loc; exp_extra = [];
+        exp_type = ty_arg;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  | Pexp_setfield(srecord, lid, snewval) ->
+      let (record, label, expected_type) =
+        type_label_access env srecord lid in
+      let ty_record =
+        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;
+      if label.lbl_mut = Immutable then
+        raise(Error(loc, env, Label_not_mutable lid.txt));
+      rue {
+        exp_desc = Texp_setfield(record, label_loc, label, newval);
+        exp_loc = loc; exp_extra = [];
+        exp_type = instance Predef.type_unit;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  | Pexp_array(sargl) ->
+      let ty = newgenvar() in
+      let to_unify = Predef.type_array ty in
+      with_explanation (fun () ->
+        unify_exp_types loc env to_unify ty_expected);
+      let argl =
+        List.map (fun sarg -> type_expect env sarg (mk_expected ty)) sargl in
+      re {
+        exp_desc = Texp_array argl;
+        exp_loc = loc; exp_extra = [];
+        exp_type = instance ty_expected;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  | Pexp_ifthenelse(scond, sifso, sifnot) ->
+      let cond = type_expect env scond
+          (mk_expected ~explanation:If_conditional Predef.type_bool) in
+      begin match sifnot with
+        None ->
+          let ifso = type_expect env sifso
+              (mk_expected ~explanation:If_no_else_branch Predef.type_unit) in
+          rue {
+            exp_desc = Texp_ifthenelse(cond, ifso, None);
+            exp_loc = loc; exp_extra = [];
+            exp_type = ifso.exp_type;
+            exp_attributes = sexp.pexp_attributes;
+            exp_env = env }
+      | Some sifnot ->
+          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;
+          re {
+            exp_desc = Texp_ifthenelse(cond, ifso, Some ifnot);
+            exp_loc = loc; exp_extra = [];
+            exp_type = ifso.exp_type;
+            exp_attributes = sexp.pexp_attributes;
+            exp_env = env }
+      end
+  | Pexp_sequence(sexp1, sexp2) ->
+      let exp1 = type_statement ~explanation:Sequence_left_hand_side
+          env sexp1 in
+      let exp2 = type_expect env sexp2 ty_expected_explained in
+      re {
+        exp_desc = Texp_sequence(exp1, exp2);
+        exp_loc = loc; exp_extra = [];
+        exp_type = exp2.exp_type;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  | Pexp_while(scond, sbody) ->
+      let cond = type_expect env scond
+          (mk_expected ~explanation:While_loop_conditional Predef.type_bool) in
+      let body = type_statement ~explanation:While_loop_body env sbody in
+      rue {
+        exp_desc = Texp_while(cond, body);
+        exp_loc = loc; exp_extra = [];
+        exp_type = instance Predef.type_unit;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  | Pexp_for(param, slow, shigh, dir, sbody) ->
+      let low = type_expect env slow
+          (mk_expected ~explanation:For_loop_start_index Predef.type_int) in
+      let high = type_expect env shigh
+          (mk_expected ~explanation:For_loop_stop_index Predef.type_int) in
+      let id, new_env =
+        match param.ppat_desc with
+        | Ppat_any -> Ident.create_local "_for", env
+        | Ppat_var {txt} ->
+            Env.enter_value txt
+              {val_type = instance Predef.type_int;
+               val_attributes = [];
+               val_kind = Val_reg;
+               val_loc = loc;
+               val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+              } env
+              ~check:(fun s -> Warnings.Unused_for_index s)
+        | _ ->
+            raise (Error (param.ppat_loc, env, Invalid_for_loop_index))
+      in
+      let body = type_statement ~explanation:For_loop_body new_env sbody in
+      rue {
+        exp_desc = Texp_for(id, param, low, high, dir, body);
+        exp_loc = loc; exp_extra = [];
+        exp_type = instance Predef.type_unit;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  | Pexp_constraint (sarg, sty) ->
+      (* Pretend separate = true, 1% slowdown for lablgtk *)
+      begin_def ();
+      let cty = Typetexp.transl_simple_type env false sty in
+      let ty = cty.ctyp_type in
+      end_def ();
+      generalize_structure ty;
+      let (arg, ty') = (type_argument env sarg ty (instance ty), instance ty) in
+      rue {
+        exp_desc = arg.exp_desc;
+        exp_loc = arg.exp_loc;
+        exp_type = ty';
+        exp_attributes = arg.exp_attributes;
+        exp_env = env;
+        exp_extra =
+          (Texp_constraint cty, loc, sexp.pexp_attributes) :: arg.exp_extra;
+      }
+  | Pexp_coerce(sarg, sty, sty') ->
+      (* Pretend separate = true, 1% slowdown for lablgtk *)
+      (* Also see PR#7199 for a problem with the following:
+         let separate = !Clflags.principal || Env.has_local_constraints env in*)
+      let (arg, ty',cty,cty') =
+        match sty with
+        | None ->
+            let (cty', force) =
+              Typetexp.transl_simple_type_delayed env sty'
+            in
+            let ty' = cty'.ctyp_type in
+            begin_def ();
+            let arg = type_exp env sarg in
+            end_def ();
+            let tv = newvar () in
+            let gen = generalizable tv.level arg.exp_type in
+            unify_var env tv arg.exp_type;
+            begin match arg.exp_desc, !self_coercion, (repr ty').desc with
+              Texp_ident(_, _, {val_kind=Val_self _}), (path,r) :: _,
+              Tconstr(path',_,_) when Path.same path path' ->
+                (* prerr_endline "self coercion"; *)
+                r := loc :: !r;
+                force ()
+            | _ when free_variables ~env arg.exp_type = []
+                  && free_variables ~env ty' = [] ->
+                if not gen && (* first try a single coercion *)
+                  let snap = snapshot () in
+                  let ty, _b = enlarge_type env ty' in
+                  try
+                    force (); Ctype.unify env arg.exp_type ty; true
+                  with Unify _ ->
+                    backtrack snap; false
+                then ()
+                else begin try
+                  let force' = subtype env arg.exp_type ty' in
+                  force (); force' ();
+                  if not gen && !Clflags.principal then
+                    Location.prerr_warning loc
+                      (Warnings.Not_principal "this ground coercion");
+                with Subtype (tr1, tr2) ->
+                  (* prerr_endline "coercion failed"; *)
+                  raise(Error(loc, env, Not_subtype(tr1, tr2)))
+                end;
+            | _ ->
+                let ty, b = enlarge_type env ty' in
+                force ();
+                begin try Ctype.unify env arg.exp_type ty with Unify trace ->
+                  raise(Error(sarg.pexp_loc, env,
+                        Coercion_failure(ty', full_expand env ty', trace, b)))
+                end
+            end;
+            (arg, ty', None, cty')
+        | Some sty ->
+            begin_def ();
+            let (cty, force) =
+              Typetexp.transl_simple_type_delayed env sty
+            and (cty', force') =
+              Typetexp.transl_simple_type_delayed env sty'
+            in
+            let ty = cty.ctyp_type in
+            let ty' = cty'.ctyp_type in
+            begin try
+              let force'' = subtype env ty ty' in
+              force (); force' (); force'' ()
+            with Subtype (tr1, tr2) ->
+              raise(Error(loc, env, Not_subtype(tr1, tr2)))
+            end;
+            end_def ();
+            generalize_structure ty;
+            generalize_structure ty';
+            (type_argument env sarg ty (instance ty),
+             instance ty', Some cty, cty')
+      in
+      rue {
+        exp_desc = arg.exp_desc;
+        exp_loc = arg.exp_loc;
+        exp_type = ty';
+        exp_attributes = arg.exp_attributes;
+        exp_env = env;
+        exp_extra = (Texp_coerce (cty, cty'), loc, sexp.pexp_attributes) ::
+                       arg.exp_extra;
+      }
+  | Pexp_send (e, {txt=met}) ->
+      if !Clflags.principal then begin_def ();
+      let obj = type_exp env e in
+      let obj_meths = ref None in
+      begin try
+        let (meth, exp, typ) =
+          match obj.exp_desc with
+            Texp_ident(_path, _, {val_kind = Val_self (meths, _, _, privty)}) ->
+              obj_meths := Some meths;
+              let (id, typ) =
+                filter_self_method env met Private meths privty
+              in
+              if is_Tvar (repr typ) then
+                Location.prerr_warning loc
+                  (Warnings.Undeclared_virtual_method met);
+              (Tmeth_val id, None, typ)
+          | Texp_ident(_path, lid, {val_kind = Val_anc (methods, cl_num)}) ->
+              let method_id =
+                begin try List.assoc met methods with Not_found ->
+                  let valid_methods = List.map fst methods in
+                  raise(Error(e.pexp_loc, env,
+                              Undefined_inherited_method (met, valid_methods)))
+                end
+              in
+              begin match
+                Env.find_value_by_name
+                  (Longident.Lident ("selfpat-" ^ cl_num)) env,
+                Env.find_value_by_name
+                  (Longident.Lident ("self-" ^cl_num)) env
+              with
+              | (_, ({val_kind = Val_self (meths, _, _, privty)} as desc)),
+                (path, _) ->
+                  obj_meths := Some meths;
+                  let (_, typ) =
+                    filter_self_method env met Private meths privty
+                  in
+                  let method_type = newvar () in
+                  let (obj_ty, res_ty) = filter_arrow env method_type Nolabel in
+                  unify env obj_ty desc.val_type;
+                  unify env res_ty (instance typ);
+                  let method_desc =
+                    {val_type = method_type;
+                     val_kind = Val_reg;
+                     val_attributes = [];
+                     val_loc = Location.none;
+                     val_uid = Uid.internal_not_actually_unique;
+                    }
+                  in
+                  let exp_env = Env.add_value method_id method_desc env in
+                  let exp =
+                    Texp_apply({exp_desc =
+                                Texp_ident(Path.Pident method_id,
+                                           lid, method_desc);
+                                exp_loc = loc; exp_extra = [];
+                                exp_type = method_type;
+                                exp_attributes = []; (* check *)
+                                exp_env = exp_env},
+                          [ Nolabel,
+                            Some {exp_desc = Texp_ident(path, lid, desc);
+                                  exp_loc = obj.exp_loc; exp_extra = [];
+                                  exp_type = desc.val_type;
+                                  exp_attributes = []; (* check *)
+                                  exp_env = exp_env}
+                          ])
+                  in
+                  (Tmeth_name met, Some (re {exp_desc = exp;
+                                             exp_loc = loc; exp_extra = [];
+                                             exp_type = typ;
+                                             exp_attributes = []; (* check *)
+                                             exp_env = exp_env}), typ)
+              |  _ ->
+                  assert false
+              end
+          | _ ->
+              (Tmeth_name met, None,
+               filter_method env met Public obj.exp_type)
+        in
+        if !Clflags.principal then begin
+          end_def ();
+          generalize_structure typ;
+        end;
+        let typ =
+          match repr typ with
+            {desc = Tpoly (ty, [])} ->
+              instance ty
+          | {desc = Tpoly (ty, tl); level = l} ->
+              if !Clflags.principal && l <> generic_level then
+                Location.prerr_warning loc
+                  (Warnings.Not_principal "this use of a polymorphic method");
+              snd (instance_poly false tl ty)
+          | {desc = Tvar _} as ty ->
+              let ty' = newvar () in
+              unify env (instance ty) (newty(Tpoly(ty',[])));
+              (* if not !Clflags.nolabels then
+                 Location.prerr_warning loc (Warnings.Unknown_method met); *)
+              ty'
+          | _ ->
+              assert false
+        in
+        rue {
+          exp_desc = Texp_send(obj, meth, exp);
+          exp_loc = loc; exp_extra = [];
+          exp_type = typ;
+          exp_attributes = sexp.pexp_attributes;
+          exp_env = env }
+      with Unify _ ->
+        let valid_methods =
+          match !obj_meths with
+          | Some meths ->
+             Some (Meths.fold (fun meth _meth_ty li -> meth::li) !meths [])
+          | None ->
+             match (expand_head env obj.exp_type).desc with
+             | Tobject (fields, _) ->
+                let (fields, _) = Ctype.flatten_fields fields in
+                let collect_fields li (meth, meth_kind, _meth_ty) =
+                  if meth_kind = Fpresent then meth::li else li in
+                Some (List.fold_left collect_fields [] fields)
+             | _ -> None
+        in
+        raise(Error(e.pexp_loc, env,
+                    Undefined_method (obj.exp_type, met, valid_methods)))
+      end
+  | Pexp_new cl ->
+      let (cl_path, cl_decl) = Env.lookup_class ~loc:cl.loc cl.txt env in
+      begin match cl_decl.cty_new with
+          None ->
+            raise(Error(loc, env, Virtual_class cl.txt))
+        | Some ty ->
+            rue {
+              exp_desc = Texp_new (cl_path, cl, cl_decl);
+              exp_loc = loc; exp_extra = [];
+              exp_type = instance ty;
+              exp_attributes = sexp.pexp_attributes;
+              exp_env = env }
+        end
+  | Pexp_setinstvar (lab, snewval) -> begin
+      let (path, mut, cl_num, ty) =
+        Env.lookup_instance_variable ~loc lab.txt env
+      in
+      match mut with
+      | Mutable ->
+          let newval =
+            type_expect env snewval (mk_expected (instance ty))
+          in
+          let (path_self, _) =
+            Env.find_value_by_name (Longident.Lident ("self-" ^ cl_num)) env
+          in
+          rue {
+            exp_desc = Texp_setinstvar(path_self, path, lab, newval);
+            exp_loc = loc; exp_extra = [];
+            exp_type = instance Predef.type_unit;
+            exp_attributes = sexp.pexp_attributes;
+            exp_env = env }
+      | _ ->
+          raise(Error(loc, env, Instance_variable_not_mutable lab.txt))
+    end
+  | Pexp_override lst ->
+      let _ =
+       List.fold_right
+        (fun (lab, _) l ->
+           if List.exists (fun l -> l.txt = lab.txt) l then
+             raise(Error(loc, env,
+                         Value_multiply_overridden lab.txt));
+           lab::l)
+        lst
+        [] in
+      begin match
+        try
+          Env.find_value_by_name (Longident.Lident "selfpat-*") env,
+          Env.find_value_by_name (Longident.Lident "self-*") env
+        with Not_found ->
+          raise(Error(loc, env, Outside_class))
+      with
+        (_, {val_type = self_ty; val_kind = Val_self (_, vars, _, _)}),
+        (path_self, _) ->
+          let type_override (lab, snewval) =
+            begin try
+              let (id, _, _, ty) = Vars.find lab.txt !vars in
+              (Path.Pident id, lab,
+               type_expect env snewval (mk_expected (instance ty)))
+            with
+              Not_found ->
+                let vars = Vars.fold (fun var _ li -> var::li) !vars [] in
+                raise(Error(loc, env,
+                            Unbound_instance_variable (lab.txt, vars)))
+            end
+          in
+          let modifs = List.map type_override lst in
+          rue {
+            exp_desc = Texp_override(path_self, modifs);
+            exp_loc = loc; exp_extra = [];
+            exp_type = self_ty;
+            exp_attributes = sexp.pexp_attributes;
+            exp_env = env }
+      | _ ->
+          assert false
+      end
+  | Pexp_letmodule(name, smodl, sbody) ->
+      let ty = newvar() in
+      (* remember original level *)
+      begin_def ();
+      let context = Typetexp.narrow () in
+      let modl = !type_module env smodl in
+      Mtype.lower_nongen ty.level modl.mod_type;
+      let pres =
+        match modl.mod_type with
+        | Mty_alias _ -> Mp_absent
+        | _ -> Mp_present
+      in
+      let scope = create_scope () in
+      let md =
+        { md_type = modl.mod_type; md_attributes = []; md_loc = name.loc;
+          md_uid = Uid.mk ~current_unit:(Env.get_unit_name ()); }
+      in
+      let (id, new_env) =
+        match name.txt with
+        | None -> None, env
+        | Some name ->
+          let id, env = Env.enter_module_declaration ~scope name pres md env in
+          Some id, env
+      in
+      Typetexp.widen context;
+      (* ideally, we should catch Expr_type_clash errors
+         in type_expect triggered by escaping identifiers from the local module
+         and refine them into Scoping_let_module errors
+      *)
+      let body = type_expect new_env sbody ty_expected_explained in
+      (* go back to original level *)
+      end_def ();
+      Ctype.unify_var new_env ty body.exp_type;
+      re {
+        exp_desc = Texp_letmodule(id, name, pres, modl, body);
+        exp_loc = loc; exp_extra = [];
+        exp_type = ty;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  | Pexp_letexception(cd, sbody) ->
+      let (cd, newenv) = Typedecl.transl_exception env cd in
+      let body = type_expect newenv sbody ty_expected_explained in
+      re {
+        exp_desc = Texp_letexception(cd, body);
+        exp_loc = loc; exp_extra = [];
+        exp_type = body.exp_type;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+
+  | Pexp_assert (e) ->
+      let cond = type_expect env e
+          (mk_expected ~explanation:Assert_condition Predef.type_bool) in
+      let exp_type =
+        match cond.exp_desc with
+        | Texp_construct(_, {cstr_name="false"}, _) ->
+            instance ty_expected
+        | _ ->
+            instance Predef.type_unit
+      in
+      rue {
+        exp_desc = Texp_assert cond;
+        exp_loc = loc; exp_extra = [];
+        exp_type;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env;
+      }
+  | Pexp_lazy e ->
+      let ty = newgenvar () in
+      let to_unify = Predef.type_lazy_t ty in
+      with_explanation (fun () ->
+        unify_exp_types loc env to_unify ty_expected);
+      let arg = type_expect env e (mk_expected ty) in
+      re {
+        exp_desc = Texp_lazy arg;
+        exp_loc = loc; exp_extra = [];
+        exp_type = instance ty_expected;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env;
+      }
+  | Pexp_object s ->
+      let desc, sign, meths = !type_object env loc s in
+      rue {
+        exp_desc = Texp_object (desc, (*sign,*) meths);
+        exp_loc = loc; exp_extra = [];
+        exp_type = sign.csig_self;
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env;
+      }
+  | Pexp_poly(sbody, sty) ->
+      if !Clflags.principal then begin_def ();
+      let ty, cty =
+        match sty with None -> repr ty_expected, None
+        | Some sty ->
+            let sty = Ast_helper.Typ.force_poly sty in
+            let cty = Typetexp.transl_simple_type env false sty in
+            repr cty.ctyp_type, Some cty
+      in
+      if !Clflags.principal then begin
+        end_def ();
+        generalize_structure ty
+      end;
+      if sty <> None then
+        with_explanation (fun () ->
+          unify_exp_types loc env (instance ty) (instance ty_expected));
+      let exp =
+        match (expand_head env ty).desc with
+          Tpoly (ty', []) ->
+            let exp = type_expect env sbody (mk_expected ty') in
+            { exp with exp_type = instance ty }
+        | Tpoly (ty', tl) ->
+            (* One more level to generalize locally *)
+            begin_def ();
+            if !Clflags.principal then begin_def ();
+            let vars, ty'' = instance_poly true tl ty' in
+            if !Clflags.principal then begin
+              end_def ();
+              generalize_structure ty''
+            end;
+            let exp = type_expect env sbody (mk_expected ty'') in
+            end_def ();
+            generalize_and_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;
+            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 ty =
+        if Typetexp.valid_tyvar_name name then
+          newvar ~name ()
+        else
+          newvar ()
+      in
+      (* remember original level *)
+      begin_def ();
+      (* Create a fake abstract type declaration for name. *)
+      let decl = {
+        type_params = [];
+        type_arity = 0;
+        type_kind = Type_abstract;
+        type_private = Public;
+        type_manifest = None;
+        type_variance = [];
+        type_separability = [];
+        type_is_newtype = true;
+        type_expansion_scope = Btype.lowest_level;
+        type_loc = loc;
+        type_attributes = [];
+        type_immediate = Unknown;
+        type_unboxed = unboxed_false_default_false;
+        type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+      }
+      in
+      let scope = create_scope () in
+      let (id, new_env) = Env.enter_type ~scope name decl env in
+
+      let body = type_exp new_env sbody in
+      (* Replace every instance of this type constructor in the resulting
+         type. *)
+      let seen = Hashtbl.create 8 in
+      let rec replace t =
+        if Hashtbl.mem seen t.id then ()
+        else begin
+          Hashtbl.add seen t.id ();
+          match t.desc with
+          | Tconstr (Path.Pident id', _, _) when id == id' -> link_type t ty
+          | _ -> Btype.iter_type_expr replace t
+        end
+      in
+      let ety = Subst.type_expr Subst.identity body.exp_type in
+      replace ety;
+      (* back to original level *)
+      end_def ();
+      (* lower the levels of the result type *)
+      (* unify_var env ty ety; *)
+
+      (* non-expansive if the body is non-expansive, so we don't introduce
+         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 }
+  | Pexp_pack m ->
+      let (p, nl) =
+        match Ctype.expand_head env (instance ty_expected) with
+          {desc = Tpackage (p, nl, _tl)} ->
+            if !Clflags.principal &&
+              (Ctype.expand_head env ty_expected).level < Btype.generic_level
+            then
+              Location.prerr_warning loc
+                (Warnings.Not_principal "this module packing");
+            (p, nl)
+        | {desc = Tvar _} ->
+            raise (Error (loc, env, Cannot_infer_signature))
+        | _ ->
+            raise (Error (loc, env, Not_a_packed_module ty_expected))
+      in
+      let (modl, tl') = !type_package env m p nl in
+      rue {
+        exp_desc = Texp_pack modl;
+        exp_loc = loc; exp_extra = [];
+        exp_type = newty (Tpackage (p, nl, tl'));
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env }
+  | Pexp_open (od, e) ->
+      let (od, _, newenv) = !type_open_decl env od in
+      let exp = type_expect newenv e ty_expected_explained in
+      rue {
+        exp_desc = Texp_open (od, exp);
+        exp_type = exp.exp_type;
+        exp_loc = loc;
+        exp_extra = [];
+        exp_attributes = sexp.pexp_attributes;
+        exp_env = env;
+      }
+  | Pexp_letop{ let_ = slet; ands = sands; body = sbody } ->
+      let rec loop spat_acc ty_acc sands =
+        match sands with
+        | [] -> spat_acc, ty_acc
+        | { pbop_pat = spat; _} :: rest ->
+            let ty = newvar () in
+            let loc = { slet.pbop_op.loc with Location.loc_ghost = true } in
+            let spat_acc = Ast_helper.Pat.tuple ~loc [spat_acc; spat] in
+            let ty_acc = newty (Ttuple [ty_acc; ty]) in
+            loop spat_acc ty_acc rest
+      in
+      if !Clflags.principal then begin_def ();
+      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
+      let spat_params, ty_params = loop slet.pbop_pat (newvar ()) sands in
+      let ty_func_result = newvar () in
+      let ty_func = newty (Tarrow(Nolabel, ty_params, ty_func_result, Cok)) in
+      let ty_result = newvar () in
+      let ty_andops = newvar () in
+      let ty_op =
+        newty (Tarrow(Nolabel, ty_andops,
+          newty (Tarrow(Nolabel, ty_func, ty_result, Cok)), Cok))
+      in
+      begin try
+        unify env op_type ty_op
+      with Unify trace ->
+        raise(Error(let_loc, env, Letop_type_clash(slet.pbop_op.txt, trace)))
+      end;
+      if !Clflags.principal then begin
+        end_def ();
+        generalize_structure ty_andops;
+        generalize_structure ty_params;
+        generalize_structure ty_func_result;
+        generalize_structure ty_result
+      end;
+      let exp, ands = type_andops env slet.pbop_exp sands ty_andops in
+      let scase = Ast_helper.Exp.case spat_params sbody in
+      let cases, partial =
+        type_cases Value env ty_params ty_func_result true loc [scase]
+      in
+      let body =
+        match cases with
+        | [case] -> case
+        | _ -> assert false
+      in
+      let param = name_cases "param" cases in
+      let let_ =
+        { bop_op_name = slet.pbop_op;
+          bop_op_path = op_path;
+          bop_op_val = op_desc;
+          bop_op_type = op_type;
+          bop_exp = exp;
+          bop_loc = slet.pbop_loc; }
+      in
+      let desc =
+        Texp_letop{let_; ands; param; body; partial}
+      in
+      rue { exp_desc = desc;
+            exp_loc = sexp.pexp_loc;
+            exp_extra = [];
+            exp_type = instance ty_result;
+            exp_env = env;
+            exp_attributes = sexp.pexp_attributes; }
+
+  | Pexp_extension ({ txt = ("ocaml.extension_constructor"
+                             |"extension_constructor"); _ },
+                    payload) ->
+      begin match payload with
+      | PStr [ { pstr_desc =
+                   Pstr_eval ({ pexp_desc = Pexp_construct (lid, None); _ }, _)
+               } ] ->
+          let path =
+            let cd =
+              Env.lookup_constructor Env.Positive ~loc:lid.loc lid.txt env
+            in
+            match cd.cstr_tag with
+            | Cstr_extension (path, _) -> path
+            | _ -> raise (Error (lid.loc, env, Not_an_extension_constructor))
+          in
+          rue {
+            exp_desc = Texp_extension_constructor (lid, path);
+            exp_loc = loc; exp_extra = [];
+            exp_type = instance Predef.type_extension_constructor;
+            exp_attributes = sexp.pexp_attributes;
+            exp_env = env }
+      | _ ->
+          raise (Error (loc, env, Invalid_extension_constructor_payload))
+      end
+  | Pexp_extension ext ->
+      raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+  | Pexp_unreachable ->
+      re { exp_desc = Texp_unreachable;
+           exp_loc = loc; exp_extra = [];
+           exp_type = instance ty_expected;
+           exp_attributes = sexp.pexp_attributes;
+           exp_env = env }
+
+and type_ident env ?(recarg=Rejected) lid =
+  let (path, desc) = Env.lookup_value ~loc:lid.loc lid.txt env in
+  let is_recarg =
+    match (repr desc.val_type).desc with
+    | Tconstr(p, _, _) -> Path.is_constructor_typath p
+    | _ -> false
+  in
+  begin match is_recarg, recarg, (repr desc.val_type).desc with
+  | _, Allowed, _
+  | true, Required, _
+  | false, Rejected, _ -> ()
+  | true, Rejected, _
+  | false, Required, (Tvar _ | Tconstr _) ->
+      raise (Error (lid.loc, env, Inlined_record_escape))
+  | false, Required, _  -> () (* will fail later *)
+  end;
+  path, desc
+
+and type_binding_op_ident env s =
+  let loc = s.loc in
+  let lid = Location.mkloc (Longident.Lident s.txt) loc in
+  let path, desc = type_ident env lid in
+  let path =
+    match desc.val_kind with
+    | Val_ivar _ ->
+        fatal_error "Illegal name for instance variable"
+    | Val_self (_, _, cl_num, _) ->
+        let path, _ =
+          Env.find_value_by_name (Longident.Lident ("self-" ^ cl_num)) env
+        in
+        path
+    | _ -> path
+  in
+  path, desc
+
+and type_function ?in_function loc attrs env ty_expected_explained l caselist =
+  let { ty = ty_expected; explanation } = ty_expected_explained in
+  let (loc_fun, ty_fun) =
+    match in_function with Some p -> p
+    | None -> (loc, instance ty_expected)
+  in
+  let separate = !Clflags.principal || Env.has_local_constraints env in
+  if separate then begin_def ();
+  let (ty_arg, ty_res) =
+    try filter_arrow env (instance ty_expected) l
+    with Unify _ ->
+      match expand_head env ty_expected with
+        {desc = Tarrow _} as ty ->
+          raise(Error(loc, env, Abstract_wrong_label(l, ty, explanation)))
+      | _ ->
+          raise(Error(loc_fun, env,
+                      Too_many_arguments (in_function <> None,
+                                          ty_fun,
+                                          explanation)))
+  in
+  let ty_arg =
+    if is_optional l then
+      let tv = newvar() in
+      begin
+        try unify env ty_arg (type_option tv)
+        with Unify _ -> assert false
+      end;
+      type_option tv
+    else ty_arg
+  in
+  if separate then begin
+    end_def ();
+    generalize_structure ty_arg;
+    generalize_structure ty_res
+  end;
+  let cases, partial =
+    type_cases Value ~in_function:(loc_fun,ty_fun) env ty_arg ty_res
+      true loc caselist in
+  let not_function ty =
+    let ls, tvar = list_labels env ty in
+    ls = [] && not tvar
+  in
+  if is_optional l && not_function ty_res then
+    Location.prerr_warning (List.hd cases).c_lhs.pat_loc
+      Warnings.Unerasable_optional_argument;
+  let param = name_cases "param" cases in
+  re {
+    exp_desc = Texp_function { arg_label = l; param; cases; partial; };
+    exp_loc = loc; exp_extra = [];
+    exp_type = instance (newgenty (Tarrow(l, ty_arg, ty_res, Cok)));
+    exp_attributes = attrs;
+    exp_env = env }
+
+
+and type_label_access env srecord lid =
+  if !Clflags.principal then begin_def ();
+  let record = type_exp ~recarg:Allowed env srecord in
+  if !Clflags.principal then begin
+    end_def ();
+    generalize_structure record.exp_type
+  end;
+  let ty_exp = record.exp_type in
+  let expected_type =
+    try
+      let (p0, p,_) = extract_concrete_record env ty_exp in
+      Some(p0, p, (repr ty_exp).level = generic_level || not !Clflags.principal)
+    with Not_found -> None
+  in
+  let labels = Env.lookup_all_labels ~loc:lid.loc lid.txt env in
+  let label =
+    wrap_disambiguate "This expression has" (mk_expected ty_exp)
+      (Label.disambiguate () lid env expected_type) labels in
+  (record, label, expected_type)
+
+(* Typing format strings for printing or reading.
+   These formats are used by functions in modules Printf, Format, and Scanf.
+   (Handling of * modifiers contributed by Thorsten Ohl.) *)
+
+and type_format loc str env =
+  let loc = {loc with Location.loc_ghost = true} in
+  try
+    CamlinternalFormatBasics.(CamlinternalFormat.(
+      let mk_exp_loc pexp_desc = {
+        pexp_desc = pexp_desc;
+        pexp_loc = loc;
+        pexp_loc_stack = [];
+        pexp_attributes = [];
+      } and mk_lid_loc lid = {
+        txt = lid;
+        loc = loc;
+      } in
+      let mk_constr name args =
+        let lid = Longident.(Ldot(Lident "CamlinternalFormatBasics", name)) in
+        let arg = match args with
+          | []          -> None
+          | [ e ]       -> Some e
+          | _ :: _ :: _ -> Some (mk_exp_loc (Pexp_tuple args)) in
+        mk_exp_loc (Pexp_construct (mk_lid_loc lid, arg)) in
+      let mk_cst cst = mk_exp_loc (Pexp_constant cst) in
+      let mk_int n = mk_cst (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
+      let rec mk_formatting_lit fmting = match fmting with
+        | Close_box ->
+          mk_constr "Close_box" []
+        | Close_tag ->
+          mk_constr "Close_tag" []
+        | Break (org, ns, ni) ->
+          mk_constr "Break" [ mk_string org; mk_int ns; mk_int ni ]
+        | FFlush ->
+          mk_constr "FFlush" []
+        | Force_newline ->
+          mk_constr "Force_newline" []
+        | Flush_newline ->
+          mk_constr "Flush_newline" []
+        | Magic_size (org, sz) ->
+          mk_constr "Magic_size" [ mk_string org; mk_int sz ]
+        | Escaped_at ->
+          mk_constr "Escaped_at" []
+        | Escaped_percent ->
+          mk_constr "Escaped_percent" []
+        | Scan_indic c ->
+          mk_constr "Scan_indic" [ mk_char c ]
+      and mk_formatting_gen : type a b c d e f .
+          (a, b, c, d, e, f) formatting_gen -> Parsetree.expression =
+        fun fmting -> match fmting with
+        | Open_tag (Format (fmt', str')) ->
+          mk_constr "Open_tag" [ mk_format fmt' str' ]
+        | Open_box (Format (fmt', str')) ->
+          mk_constr "Open_box" [ mk_format fmt' str' ]
+      and mk_format : type a b c d e f .
+          (a, b, c, d, e, f) CamlinternalFormatBasics.fmt -> string ->
+          Parsetree.expression = fun fmt str ->
+        mk_constr "Format" [ mk_fmt fmt; mk_string str ]
+      and mk_side side = match side with
+        | Left  -> mk_constr "Left"  []
+        | Right -> mk_constr "Right" []
+        | Zeros -> mk_constr "Zeros" []
+      and mk_iconv iconv = match iconv with
+        | Int_d  -> mk_constr "Int_d"  [] | Int_pd -> mk_constr "Int_pd" []
+        | Int_sd -> mk_constr "Int_sd" [] | Int_i  -> mk_constr "Int_i"  []
+        | Int_pi -> mk_constr "Int_pi" [] | Int_si -> mk_constr "Int_si" []
+        | Int_x  -> mk_constr "Int_x"  [] | Int_Cx -> mk_constr "Int_Cx" []
+        | Int_X  -> mk_constr "Int_X"  [] | Int_CX -> mk_constr "Int_CX" []
+        | Int_o  -> mk_constr "Int_o"  [] | Int_Co -> mk_constr "Int_Co" []
+        | Int_u  -> mk_constr "Int_u"  [] | Int_Cd -> mk_constr "Int_Cd" []
+        | Int_Ci -> mk_constr "Int_Ci" [] | Int_Cu -> mk_constr "Int_Cu" []
+      and mk_fconv fconv =
+        let flag = match fst fconv with
+        | Float_flag_ -> mk_constr "Float_flag_" []
+        | Float_flag_p -> mk_constr "Float_flag_p" []
+        | Float_flag_s -> mk_constr "Float_flag_s" [] in
+        let kind = match snd fconv with
+        | Float_f  -> mk_constr "Float_f"  []
+        | Float_e  -> mk_constr "Float_e"  []
+        | Float_E  -> mk_constr "Float_E"  []
+        | Float_g  -> mk_constr "Float_g"  []
+        | Float_G  -> mk_constr "Float_G"  []
+        | Float_h  -> mk_constr "Float_h"  []
+        | Float_H  -> mk_constr "Float_H"  []
+        | Float_F  -> mk_constr "Float_F"  []
+        | Float_CF -> mk_constr "Float_CF" [] in
+        mk_exp_loc (Pexp_tuple [flag; kind])
+      and mk_counter cnt = match cnt with
+        | Line_counter  -> mk_constr "Line_counter"  []
+        | Char_counter  -> mk_constr "Char_counter"  []
+        | Token_counter -> mk_constr "Token_counter" []
+      and mk_int_opt n_opt = match n_opt with
+        | None ->
+          let lid_loc = mk_lid_loc (Longident.Lident "None") in
+          mk_exp_loc (Pexp_construct (lid_loc, None))
+        | Some n ->
+          let lid_loc = mk_lid_loc (Longident.Lident "Some") in
+          mk_exp_loc (Pexp_construct (lid_loc, Some (mk_int n)))
+      and mk_fmtty : type a b c d e f g h i j k l .
+          (a, b, c, d, e, f, g, h, i, j, k, l) fmtty_rel -> Parsetree.expression
+          =
+      fun fmtty -> match fmtty with
+        | Char_ty rest      -> mk_constr "Char_ty"      [ mk_fmtty rest ]
+        | String_ty rest    -> mk_constr "String_ty"    [ mk_fmtty rest ]
+        | Int_ty rest       -> mk_constr "Int_ty"       [ mk_fmtty rest ]
+        | Int32_ty rest     -> mk_constr "Int32_ty"     [ mk_fmtty rest ]
+        | Nativeint_ty rest -> mk_constr "Nativeint_ty" [ mk_fmtty rest ]
+        | Int64_ty rest     -> mk_constr "Int64_ty"     [ mk_fmtty rest ]
+        | Float_ty rest     -> mk_constr "Float_ty"     [ mk_fmtty rest ]
+        | Bool_ty rest      -> mk_constr "Bool_ty"      [ mk_fmtty rest ]
+        | Alpha_ty rest     -> mk_constr "Alpha_ty"     [ mk_fmtty rest ]
+        | Theta_ty rest     -> mk_constr "Theta_ty"     [ mk_fmtty rest ]
+        | Any_ty rest       -> mk_constr "Any_ty"       [ mk_fmtty rest ]
+        | Reader_ty rest    -> mk_constr "Reader_ty"    [ mk_fmtty rest ]
+        | Ignored_reader_ty rest ->
+          mk_constr "Ignored_reader_ty" [ mk_fmtty rest ]
+        | Format_arg_ty (sub_fmtty, rest) ->
+          mk_constr "Format_arg_ty" [ mk_fmtty sub_fmtty; mk_fmtty rest ]
+        | Format_subst_ty (sub_fmtty1, sub_fmtty2, rest) ->
+          mk_constr "Format_subst_ty"
+            [ mk_fmtty sub_fmtty1; mk_fmtty sub_fmtty2; mk_fmtty rest ]
+        | End_of_fmtty -> mk_constr "End_of_fmtty" []
+      and mk_ignored : type a b c d e f .
+          (a, b, c, d, e, f) ignored -> Parsetree.expression =
+      fun ign -> match ign with
+        | Ignored_char ->
+          mk_constr "Ignored_char" []
+        | Ignored_caml_char ->
+          mk_constr "Ignored_caml_char" []
+        | Ignored_string pad_opt ->
+          mk_constr "Ignored_string" [ mk_int_opt pad_opt ]
+        | Ignored_caml_string pad_opt ->
+          mk_constr "Ignored_caml_string" [ mk_int_opt pad_opt ]
+        | Ignored_int (iconv, pad_opt) ->
+          mk_constr "Ignored_int" [ mk_iconv iconv; mk_int_opt pad_opt ]
+        | Ignored_int32 (iconv, pad_opt) ->
+          mk_constr "Ignored_int32" [ mk_iconv iconv; mk_int_opt pad_opt ]
+        | Ignored_nativeint (iconv, pad_opt) ->
+          mk_constr "Ignored_nativeint" [ mk_iconv iconv; mk_int_opt pad_opt ]
+        | Ignored_int64 (iconv, pad_opt) ->
+          mk_constr "Ignored_int64" [ mk_iconv iconv; mk_int_opt pad_opt ]
+        | Ignored_float (pad_opt, prec_opt) ->
+          mk_constr "Ignored_float" [ mk_int_opt pad_opt; mk_int_opt prec_opt ]
+        | Ignored_bool pad_opt ->
+          mk_constr "Ignored_bool" [ mk_int_opt pad_opt ]
+        | Ignored_format_arg (pad_opt, fmtty) ->
+          mk_constr "Ignored_format_arg" [ mk_int_opt pad_opt; mk_fmtty fmtty ]
+        | Ignored_format_subst (pad_opt, fmtty) ->
+          mk_constr "Ignored_format_subst" [
+            mk_int_opt pad_opt; mk_fmtty fmtty ]
+        | Ignored_reader ->
+          mk_constr "Ignored_reader" []
+        | Ignored_scan_char_set (width_opt, char_set) ->
+          mk_constr "Ignored_scan_char_set" [
+            mk_int_opt width_opt; mk_string char_set ]
+        | Ignored_scan_get_counter counter ->
+          mk_constr "Ignored_scan_get_counter" [
+            mk_counter counter
+          ]
+        | Ignored_scan_next_char ->
+          mk_constr "Ignored_scan_next_char" []
+      and mk_padding : type x y . (x, y) padding -> Parsetree.expression =
+      fun pad -> match pad with
+        | No_padding         -> mk_constr "No_padding" []
+        | Lit_padding (s, w) -> mk_constr "Lit_padding" [ mk_side s; mk_int w ]
+        | Arg_padding s      -> mk_constr "Arg_padding" [ mk_side s ]
+      and mk_precision : type x y . (x, y) precision -> Parsetree.expression =
+      fun prec -> match prec with
+        | No_precision    -> mk_constr "No_precision" []
+        | Lit_precision w -> mk_constr "Lit_precision" [ mk_int w ]
+        | Arg_precision   -> mk_constr "Arg_precision" []
+      and mk_fmt : type a b c d e f .
+          (a, b, c, d, e, f) fmt -> Parsetree.expression =
+      fun fmt -> match fmt with
+        | Char rest ->
+          mk_constr "Char" [ mk_fmt rest ]
+        | Caml_char rest ->
+          mk_constr "Caml_char" [ mk_fmt rest ]
+        | String (pad, rest) ->
+          mk_constr "String" [ mk_padding pad; mk_fmt rest ]
+        | Caml_string (pad, rest) ->
+          mk_constr "Caml_string" [ mk_padding pad; mk_fmt rest ]
+        | Int (iconv, pad, prec, rest) ->
+          mk_constr "Int" [
+            mk_iconv iconv; mk_padding pad; mk_precision prec; mk_fmt rest ]
+        | Int32 (iconv, pad, prec, rest) ->
+          mk_constr "Int32" [
+            mk_iconv iconv; mk_padding pad; mk_precision prec; mk_fmt rest ]
+        | Nativeint (iconv, pad, prec, rest) ->
+          mk_constr "Nativeint" [
+            mk_iconv iconv; mk_padding pad; mk_precision prec; mk_fmt rest ]
+        | Int64 (iconv, pad, prec, rest) ->
+          mk_constr "Int64" [
+            mk_iconv iconv; mk_padding pad; mk_precision prec; mk_fmt rest ]
+        | Float (fconv, pad, prec, rest) ->
+          mk_constr "Float" [
+            mk_fconv fconv; mk_padding pad; mk_precision prec; mk_fmt rest ]
+        | Bool (pad, rest) ->
+          mk_constr "Bool" [ mk_padding pad; mk_fmt rest ]
+        | Flush rest ->
+          mk_constr "Flush" [ mk_fmt rest ]
+        | String_literal (s, rest) ->
+          mk_constr "String_literal" [ mk_string s; mk_fmt rest ]
+        | Char_literal (c, rest) ->
+          mk_constr "Char_literal" [ mk_char c; mk_fmt rest ]
+        | Format_arg (pad_opt, fmtty, rest) ->
+          mk_constr "Format_arg" [
+            mk_int_opt pad_opt; mk_fmtty fmtty; mk_fmt rest ]
+        | Format_subst (pad_opt, fmtty, rest) ->
+          mk_constr "Format_subst" [
+            mk_int_opt pad_opt; mk_fmtty fmtty; mk_fmt rest ]
+        | Alpha rest ->
+          mk_constr "Alpha" [ mk_fmt rest ]
+        | Theta rest ->
+          mk_constr "Theta" [ mk_fmt rest ]
+        | Formatting_lit (fmting, rest) ->
+          mk_constr "Formatting_lit" [ mk_formatting_lit fmting; mk_fmt rest ]
+        | Formatting_gen (fmting, rest) ->
+          mk_constr "Formatting_gen" [ mk_formatting_gen fmting; mk_fmt rest ]
+        | Reader rest ->
+          mk_constr "Reader" [ mk_fmt rest ]
+        | Scan_char_set (width_opt, char_set, rest) ->
+          mk_constr "Scan_char_set" [
+            mk_int_opt width_opt; mk_string char_set; mk_fmt rest ]
+        | Scan_get_counter (cnt, rest) ->
+          mk_constr "Scan_get_counter" [ mk_counter cnt; mk_fmt rest ]
+        | Scan_next_char rest ->
+          mk_constr "Scan_next_char" [ mk_fmt rest ]
+        | Ignored_param (ign, rest) ->
+          mk_constr "Ignored_param" [ mk_ignored ign; mk_fmt rest ]
+        | End_of_format ->
+          mk_constr "End_of_format" []
+        | Custom _ ->
+          (* Custom formatters have no syntax so they will never appear
+             in formats parsed from strings. *)
+          assert false
+      in
+      let legacy_behavior = not !Clflags.strict_formats in
+      let Fmt_EBB fmt = fmt_ebb_of_string ~legacy_behavior str in
+      mk_constr "Format" [ mk_fmt fmt; mk_string str ]
+    ))
+  with Failure msg ->
+    raise (Error (loc, env, Invalid_format msg))
+
+and type_label_exp create env loc ty_expected
+          (lid, label, sarg) =
+  (* Here also ty_expected may be at generic_level *)
+  begin_def ();
+  let separate = !Clflags.principal || Env.has_local_constraints env in
+  if separate then (begin_def (); begin_def ());
+  let (vars, ty_arg, ty_res) = instance_label true label in
+  if separate then begin
+    end_def ();
+    (* Generalize label information *)
+    generalize_structure ty_arg;
+    generalize_structure ty_res
+  end;
+  begin try
+    unify env (instance ty_res) (instance ty_expected)
+  with Unify trace ->
+    raise (Error(lid.loc, env, Label_mismatch(lid.txt, trace)))
+  end;
+  (* Instantiate so that we can generalize internal nodes *)
+  let ty_arg = instance ty_arg in
+  if separate then begin
+    end_def ();
+    (* Generalize information merged from ty_expected *)
+    generalize_structure ty_arg
+  end;
+  if label.lbl_private = Private then
+    if create then
+      raise (Error(loc, env, Private_type ty_expected))
+    else
+      raise (Error(lid.loc, env, Private_label(lid.txt, ty_expected)));
+  let arg =
+    let snap = if vars = [] then None else Some (Btype.snapshot ()) in
+    let arg = type_argument env sarg ty_arg (instance ty_arg) in
+    end_def ();
+    try
+      if (vars = []) then arg
+      else begin
+        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 exn when maybe_expansive arg -> try
+      (* Try to retype without propagating ty_arg, cf PR#4862 *)
+      Option.iter Btype.backtrack snap;
+      begin_def ();
+      let arg = type_exp env sarg in
+      end_def ();
+      lower_contravariant env arg.exp_type;
+      begin_def ();
+      let arg = {arg with exp_type = instance arg.exp_type} in
+      unify_exp env arg (instance ty_arg);
+      end_def ();
+      generalize_and_check_univars env "field value" arg label.lbl_arg vars;
+      {arg with exp_type = instance arg.exp_type}
+    with Error (_, _, Less_general _) as e -> raise e
+    | _ -> raise exn    (* In case of failure return the first error *)
+  in
+  (lid, label, arg)
+
+and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
+  (* ty_expected' may be generic *)
+  let no_labels ty =
+    let ls, tvar = list_labels env ty in
+    not tvar && List.for_all ((=) Nolabel) ls
+  in
+  let rec is_inferred sexp =
+    match sexp.pexp_desc with
+      Pexp_ident _ | Pexp_apply _ | Pexp_field _ | Pexp_constraint _
+    | Pexp_coerce _ | Pexp_send _ | Pexp_new _ -> true
+    | Pexp_sequence (_, e) | Pexp_open (_, e) -> is_inferred e
+    | Pexp_ifthenelse (_, e1, Some e2) -> is_inferred e1 && is_inferred e2
+    | _ -> false
+  in
+  match expand_head env ty_expected' with
+    {desc = Tarrow(Nolabel,ty_arg,ty_res,_); level = lv}
+    when is_inferred sarg ->
+      (* apply optional arguments when expected type is "" *)
+      (* we must be very careful about not breaking the semantics *)
+      if !Clflags.principal then begin_def ();
+      let texp = type_exp env sarg in
+      if !Clflags.principal then begin
+        end_def ();
+        generalize_structure texp.exp_type
+      end;
+      let rec make_args args ty_fun =
+        match (expand_head env ty_fun).desc with
+        | Tarrow (l,ty_arg,ty_fun,_) when is_optional l ->
+            let ty = option_none env (instance ty_arg) sarg.pexp_loc in
+            make_args ((l, Some ty) :: args) ty_fun
+        | Tarrow (l,_,ty_res',_) when l = Nolabel || !Clflags.classic ->
+            List.rev args, ty_fun, no_labels ty_res'
+        | Tvar _ ->  List.rev args, ty_fun, false
+        |  _ -> [], texp.exp_type, false
+      in
+      let args, ty_fun', simple_res = make_args [] texp.exp_type in
+      let warn = !Clflags.principal &&
+        (lv <> generic_level || (repr ty_fun').level <> generic_level)
+      and texp = {texp with exp_type = instance texp.exp_type}
+      and ty_fun = instance ty_fun' in
+      if not (simple_res || no_labels ty_res) then begin
+        unify_exp env texp ty_expected;
+        texp
+      end else begin
+      unify_exp 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 =
+        let id = Ident.create_local name in
+        let desc =
+          { val_type = ty; val_kind = Val_reg;
+            val_attributes = [];
+            val_loc = Location.none;
+            val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+          }
+        in
+        let exp_env = Env.add_value id desc env in
+        {pat_desc = Tpat_var (id, mknoloc name); pat_type = ty;pat_extra=[];
+         pat_attributes = [];
+         pat_loc = Location.none; pat_env = env},
+        {exp_type = ty; exp_loc = Location.none; exp_env = exp_env;
+         exp_extra = []; exp_attributes = [];
+         exp_desc =
+         Texp_ident(Path.Pident id, mknoloc (Longident.Lident name), desc)}
+      in
+      let eta_pat, eta_var = var_pair "eta" ty_arg in
+      let func texp =
+        let e =
+          {texp with exp_type = ty_res; exp_desc =
+           Texp_apply
+             (texp,
+              args @ [Nolabel, Some eta_var])}
+        in
+        let cases = [case eta_pat e] in
+        let param = name_cases "param" cases in
+        { texp with exp_type = ty_fun; exp_desc =
+          Texp_function { arg_label = Nolabel; param; cases;
+            partial = Total; } }
+      in
+      Location.prerr_warning texp.exp_loc
+        (Warnings.Eliminated_optional_arguments
+           (List.map (fun (l, _) -> Printtyp.string_of_label l) args));
+      if warn then Location.prerr_warning texp.exp_loc
+          (Warnings.Without_principality "eliminated optional argument");
+      (* let-expand to have side effects *)
+      let let_pat, let_var = var_pair "arg" texp.exp_type in
+      re { texp with exp_type = ty_fun; exp_desc =
+           Texp_let (Nonrecursive,
+                     [{vb_pat=let_pat; vb_expr=texp; vb_attributes=[];
+                       vb_loc=Location.none;
+                      }],
+                     func let_var) }
+      end
+  | _ ->
+      let texp = type_expect ?recarg env sarg
+        (mk_expected ?explanation ty_expected') in
+      unify_exp env texp ty_expected;
+      texp
+
+and type_application env funct sargs =
+  (* funct.exp_type may be generic *)
+  let result_type omitted ty_fun =
+    List.fold_left
+      (fun ty_fun (l,ty,lv) -> newty2 lv (Tarrow(l,ty,ty_fun,Cok)))
+      ty_fun omitted
+  in
+  let has_label l ty_fun =
+    let ls, tvar = list_labels env ty_fun in
+    tvar || List.mem l ls
+  in
+  let eliminated_optional_arguments = ref [] in
+  let omitted_parameters = ref [] in
+  let type_unknown_arg (ty_fun, typed_args) (lbl, sarg) =
+    let (ty_arg, ty_res) =
+      let ty_fun = expand_head env ty_fun in
+      match ty_fun.desc with
+      | Tvar _ ->
+          let t1 = newvar () and t2 = newvar () in
+          if ty_fun.level >= t1.level &&
+             not (is_prim ~name:"%identity" funct)
+          then
+            Location.prerr_warning sarg.pexp_loc Warnings.Unused_argument;
+          unify env ty_fun (newty (Tarrow(lbl,t1,t2,Clink(ref Cunknown))));
+          (t1, t2)
+      | Tarrow (l,t1,t2,_) when l = lbl
+        || !Clflags.classic && lbl = Nolabel && not (is_optional l) ->
+          (t1, t2)
+      | td ->
+          let ty_fun = match td with Tarrow _ -> newty td | _ -> ty_fun in
+          let ty_res =
+            result_type (!omitted_parameters @ !eliminated_optional_arguments)
+              ty_fun
+          in
+          match ty_res.desc with
+          | Tarrow _ ->
+              if !Clflags.classic || not (has_label lbl ty_fun) then
+                raise (Error(sarg.pexp_loc, env,
+                             Apply_wrong_label(lbl, ty_res, false)))
+              else
+                raise (Error(funct.exp_loc, env, Incoherent_label_order))
+          | _ ->
+              raise(Error(funct.exp_loc, env, Apply_non_function
+                            (expand_head env funct.exp_type)))
+    in
+    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()));
+      arg
+    in
+    (ty_res, (lbl, Some arg) :: typed_args)
+  in
+  let ignore_labels =
+    !Clflags.classic ||
+    begin
+      let ls, tvar = list_labels env funct.exp_type in
+      not tvar &&
+      let labels = List.filter (fun l -> not (is_optional l)) ls in
+      List.length labels = List.length sargs &&
+      List.for_all (fun (l,_) -> l = Nolabel) sargs &&
+      List.exists (fun l -> l <> Nolabel) labels &&
+      (Location.prerr_warning
+         funct.exp_loc
+         (Warnings.Labels_omitted
+            (List.map Printtyp.string_of_label
+                      (List.filter ((<>) Nolabel) labels)));
+       true)
+    end
+  in
+  let warned = ref false in
+  let rec type_args args ty_fun ty_fun0 sargs =
+    match expand_head env ty_fun, expand_head env ty_fun0 with
+    | {desc=Tarrow (l, ty, ty_fun, com); level=lv} as ty_fun',
+      {desc=Tarrow (_, ty0, ty_fun0, _)}
+      when sargs <> [] && commu_repr com = Cok ->
+        let may_warn loc w =
+          if not !warned && !Clflags.principal && lv <> generic_level
+          then begin
+            warned := true;
+            Location.prerr_warning loc w
+          end
+        in
+        let name = label_name l
+        and optional = is_optional l in
+        let use_arg sarg l' =
+          Some (
+            if not optional || is_optional l' then
+              (fun () -> type_argument env sarg ty ty0)
+            else begin
+              may_warn sarg.pexp_loc
+                (Warnings.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)))
+            end
+          )
+        in
+        let eliminate_optional_arg () =
+          may_warn funct.exp_loc
+            (Warnings.Without_principality "eliminated optional argument");
+          eliminated_optional_arguments :=
+            (l,ty,lv) :: !eliminated_optional_arguments;
+          Some (fun () -> option_none env (instance ty) Location.none)
+        in
+        let remaining_sargs, arg =
+          if ignore_labels then begin
+            (* No reordering is allowed, process arguments in order *)
+            match sargs with
+            | [] -> assert false
+            | (l', sarg) :: remaining_sargs ->
+                if name = label_name l' || (not optional && l' = Nolabel) then
+                  (remaining_sargs, use_arg sarg l')
+                else if
+                  optional &&
+                  not (List.exists (fun (l, _) -> name = label_name l)
+                         remaining_sargs) &&
+                  List.exists (function (Nolabel, _) -> true | _ -> false)
+                    sargs
+                then
+                  (sargs, eliminate_optional_arg ())
+                else
+                  raise(Error(sarg.pexp_loc, env,
+                              Apply_wrong_label(l', ty_fun', optional)))
+          end else
+            (* Arguments can be commuted, try to fetch the argument
+               corresponding to the first parameter. *)
+            match extract_label name sargs with
+            | Some (l', sarg, commuted, remaining_sargs) ->
+                if commuted then begin
+                  may_warn sarg.pexp_loc
+                    (Warnings.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));
+                remaining_sargs, use_arg sarg l'
+            | None ->
+                sargs,
+                if optional && List.mem_assoc Nolabel sargs then
+                  eliminate_optional_arg ()
+                else begin
+                  (* No argument was given for this parameter, we abstract over
+                     it. *)
+                  may_warn funct.exp_loc
+                    (Warnings.Without_principality "commuted an argument");
+                  omitted_parameters := (l,ty,lv) :: !omitted_parameters;
+                  None
+                end
+        in
+        type_args ((l,arg)::args) ty_fun ty_fun0 remaining_sargs
+    | _ ->
+        (* We're not looking at a *known* function type anymore, or there are no
+           arguments left. *)
+        let ty_fun, typed_args =
+          List.fold_left type_unknown_arg (ty_fun0, args) sargs
+        in
+        let args =
+          (* Force typing of arguments.
+             Careful: the order matters here. Using [List.rev_map] would be
+             incorrect. *)
+          List.map
+            (function
+              | l, None -> l, None
+              | l, Some f -> l, Some (f ()))
+            (List.rev typed_args)
+        in
+        let result_ty = instance (result_type !omitted_parameters ty_fun) in
+        args, result_ty
+  in
+  let is_ignore funct =
+    is_prim ~name:"%ignore" funct &&
+    (try ignore (filter_arrow env (instance funct.exp_type) Nolabel); true
+     with Unify _ -> false)
+  in
+  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 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 =
+  let { ty = ty_expected; explanation } = ty_expected_explained in
+  let expected_type =
+    try
+      let (p0, p,_) = extract_concrete_variant env ty_expected in
+      let principal =
+        (repr ty_expected).level = generic_level || not !Clflags.principal
+      in
+      Some(p0, p, principal)
+    with Not_found -> None
+  in
+  let constrs =
+    Env.lookup_all_constructors ~loc:lid.loc Env.Positive lid.txt env
+  in
+  let constr =
+    wrap_disambiguate "This variant expression is expected to have"
+      ty_expected_explained
+      (Constructor.disambiguate Env.Positive lid env expected_type) constrs
+  in
+  let sargs =
+    match sarg with
+      None -> []
+    | Some {pexp_desc = Pexp_tuple sel} when
+        constr.cstr_arity > 1 || Builtin_attributes.explicit_arity attrs
+      -> 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)));
+  let separate = !Clflags.principal || Env.has_local_constraints env in
+  if separate then (begin_def (); begin_def ());
+  let (ty_args, ty_res) = instance_constructor constr in
+  let texp =
+    re {
+      exp_desc = Texp_construct(lid, constr, []);
+      exp_loc = loc; exp_extra = [];
+      exp_type = ty_res;
+      exp_attributes = attrs;
+      exp_env = env } in
+  if separate then begin
+    end_def ();
+    generalize_structure ty_res;
+    with_explanation explanation (fun () ->
+      unify_exp env {texp with exp_type = instance ty_res}
+        (instance ty_expected));
+    end_def ();
+    List.iter generalize_structure ty_args;
+    generalize_structure ty_res;
+  end;
+  let ty_args0, ty_res =
+    match instance_list (ty_res :: ty_args) with
+      t :: tl -> tl, t
+    | _ -> assert false
+  in
+  let texp = {texp with exp_type = ty_res} in
+  if not separate then unify_exp env texp (instance ty_expected);
+  let recarg =
+    match constr.cstr_inlined with
+    | None -> Rejected
+    | Some _ ->
+      begin match sargs with
+      | [{pexp_desc =
+            Pexp_ident _ |
+            Pexp_record (_, (Some {pexp_desc = Pexp_ident _}| None))}] ->
+        Required
+      | _ ->
+        raise (Error(loc, env, Inlined_record_expected))
+      end
+  in
+  let args =
+    List.map2 (fun e (t,t0) -> type_argument ~recarg env e t t0) sargs
+      (List.combine ty_args ty_args0) in
+  if constr.cstr_private = Private then
+    begin match constr.cstr_tag with
+    | Cstr_extension _ ->
+        raise(Error(loc, env, Private_constructor (constr, ty_res)))
+    | Cstr_constant _ | Cstr_block _ | Cstr_unboxed ->
+        raise (Error(loc, env, Private_type ty_res));
+    end;
+  (* NOTE: shouldn't we call "re" on this final expression? -- AF *)
+  { texp with
+    exp_desc = Texp_construct(lid, constr, args) }
+
+(* Typing of statements (expressions whose values are discarded) *)
+
+and type_statement ?explanation env sexp =
+  begin_def();
+  let exp = type_exp env sexp in
+  end_def();
+  let ty = expand_head env exp.exp_type and tv = newvar() in
+  if is_Tvar ty && ty.level > tv.level then
+    Location.prerr_warning
+      (final_subexpression exp).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 true exp;
+    unify_var env tv ty;
+    exp
+  end
+
+and type_unpacks ?in_function env unpacks sbody expected_ty =
+  let ty = newvar() in
+  (* remember original level *)
+  let extended_env, tunpacks =
+    List.fold_left (fun (env, unpacks) (name, loc, uid) ->
+      begin_def ();
+      let context = Typetexp.narrow () in
+      let modl =
+        !type_module env
+          Ast_helper.(
+            Mod.unpack ~loc
+              (Exp.ident ~loc:name.loc (mkloc (Longident.Lident name.txt)
+                                          name.loc)))
+      in
+      Mtype.lower_nongen ty.level modl.mod_type;
+      let pres =
+        match modl.mod_type with
+        | Mty_alias _ -> Mp_absent
+        | _ -> Mp_present
+      in
+      let scope = create_scope () in
+      let md =
+        { md_type = modl.mod_type; md_attributes = []; md_loc = name.loc;
+          md_uid = uid; }
+      in
+      let (id, env) =
+        Env.enter_module_declaration ~scope name.txt pres md env
+      in
+      Typetexp.widen context;
+      env, (id, name, pres, modl) :: unpacks
+    ) (env, []) unpacks
+  in
+  (* ideally, we should catch Expr_type_clash errors
+     in type_expect triggered by escaping identifiers from the local module
+     and refine them into Scoping_let_module errors
+  *)
+  let body = type_expect ?in_function extended_env sbody expected_ty in
+  let exp_loc = { body.exp_loc with loc_ghost = true } in
+  let exp_attributes = [Ast_helper.Attr.mk (mknoloc "#modulepat") (PStr [])] in
+  List.fold_left (fun body (id, name, pres, modl) ->
+    (* go back to parent level *)
+    end_def ();
+    Ctype.unify_var extended_env ty body.exp_type;
+    re {
+      exp_desc = Texp_letmodule(Some id, { name with txt = Some name.txt },
+                                pres, modl, body);
+      exp_loc;
+      exp_attributes;
+      exp_extra = [];
+      exp_type = ty;
+      exp_env = env }
+  ) body tunpacks
+
+(* Typing of match cases *)
+and type_cases
+    : type k . k pattern_category ->
+           ?in_function:_ -> _ -> _ -> _ -> _ -> _ -> Parsetree.case list ->
+           k case list * partial
+  = fun category ?in_function env ty_arg ty_res partial_flag loc caselist ->
+  (* ty_arg is _fully_ generalized *)
+  let patterns = List.map (fun {pc_lhs=p} -> p) caselist in
+  let contains_polyvars = List.exists contains_polymorphic_variant patterns in
+  let erase_either = contains_polyvars && contains_variant_either ty_arg in
+  let may_contain_gadts = List.exists may_contain_gadts patterns in
+  let ty_arg =
+    if (may_contain_gadts || erase_either) && not !Clflags.principal
+    then correct_levels ty_arg else ty_arg
+  in
+  let rec is_var spat =
+    match spat.ppat_desc with
+      Ppat_any | Ppat_var _ -> true
+    | Ppat_alias (spat, _) -> is_var spat
+    | _ -> false in
+  let needs_exhaust_check =
+    match caselist with
+      [{pc_rhs = {pexp_desc = Pexp_unreachable}}] -> true
+    | [{pc_lhs}] when is_var pc_lhs -> false
+    | _ -> true
+  in
+  let outer_level = get_current_level () in
+  let lev =
+    if may_contain_gadts then begin_def ();
+    get_current_level ()
+  in
+  let take_partial_instance =
+    if !Clflags.principal || erase_either
+    then Some false else None
+  in
+  begin_def (); (* propagation of the argument *)
+  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 ({pc_lhs; pc_guard; pc_rhs} as case) ->
+        let loc =
+          let open Location in
+          match pc_guard with
+          | None -> pc_rhs.pexp_loc
+          | Some g -> {pc_rhs.pexp_loc with loc_start=g.pexp_loc.loc_start}
+        in
+        if !Clflags.principal then begin_def (); (* propagation of pattern *)
+        let scope = Some (Annot.Idef loc) in
+        begin_def ();
+        let ty_arg = instance ?partial:take_partial_instance ty_arg in
+        end_def ();
+        generalize_structure ty_arg;
+        let (pat, ext_env, force, pvs, unpacks) =
+          type_pattern category ~lev env pc_lhs scope ty_arg
+        in
+        pattern_force := force @ !pattern_force;
+        let pat =
+          if !Clflags.principal then begin
+            end_def ();
+            iter_pattern_variables_type generalize_structure pvs;
+            { pat with pat_type = instance pat.pat_type }
+          end else pat
+        in
+        (* Ensure that no ambivalent pattern type escapes its branch *)
+        check_scope_escape pat.pat_loc env outer_level ty_arg;
+        { typed_pat = pat;
+          pat_type_for_unif = ty_arg;
+          untyped_case = case;
+          branch_env = ext_env;
+          pat_vars = pvs;
+          unpacks;
+          contains_gadt = contains_gadt (as_comp_pattern category pat); }
+        )
+      caselist in
+  let patl = List.map (fun { typed_pat; _ } -> typed_pat) half_typed_cases in
+  let does_contain_gadt =
+    List.exists (fun { contains_gadt; _ } -> contains_gadt) 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
+    else ty_res, (fun env -> env)
+  in
+  (* Unify all cases (delayed to keep it order-free) *)
+  let ty_arg' = newvar () in
+  let unify_pats ty =
+    List.iter (fun { typed_pat = pat; pat_type_for_unif = pat_ty; _ } ->
+      unify_pat_types pat.pat_loc (ref env) pat_ty ty
+    ) half_typed_cases
+  in
+  unify_pats ty_arg';
+  (* Check for polymorphic variants to close *)
+  if List.exists has_variants patl then begin
+      Parmatch.pressure_variants_in_computation_pattern env
+        (List.map (as_comp_pattern category) patl);
+      List.iter finalize_variants patl
+  end;
+  (* `Contaminating' unifications start here *)
+  List.iter (fun f -> f()) !pattern_force;
+  (* Post-processing and generalization *)
+  if take_partial_instance <> None then unify_pats (instance ty_arg);
+  List.iter (fun { pat_vars; _ } ->
+    iter_pattern_variables_type (fun t -> unify_var env (newvar()) t) pat_vars
+  ) half_typed_cases;
+  end_def ();
+  generalize ty_arg';
+  List.iter (fun { pat_vars; _ } ->
+    iter_pattern_variables_type generalize pat_vars
+  ) half_typed_cases;
+  (* type bodies *)
+  let in_function = if List.length caselist = 1 then in_function else None in
+  let cases =
+    List.map
+      (fun { typed_pat = pat; branch_env = ext_env; pat_vars = pvs; unpacks;
+             untyped_case = {pc_lhs = _; pc_guard; pc_rhs};
+             contains_gadt; _ }  ->
+        let ext_env =
+          if contains_gadt then
+            do_copy_types ext_env
+          else
+            ext_env
+        in
+        let ext_env =
+          add_pattern_variables ext_env pvs
+            ~check:(fun s -> Warnings.Unused_var_strict s)
+            ~check_as:(fun s -> Warnings.Unused_var s)
+        in
+        let unpacks =
+          List.map (fun (name, loc) ->
+            name, loc, Uid.mk ~current_unit:(Env.get_unit_name ())
+          ) unpacks
+        in
+        let ty_res' =
+          if !Clflags.principal then begin
+            begin_def ();
+            let ty = instance ~partial:true ty_res in
+            end_def ();
+            generalize_structure ty; ty
+          end
+          else if contains_gadt then
+            (* Even though we've already done that, apparently we need to do it
+               again.
+               stdlib/camlinternalFormat.ml:2288 is an example of use of this
+               call to [correct_levels]... *)
+            correct_levels ty_res
+          else ty_res in
+(*        Format.printf "@[%i %i, ty_res' =@ %a@]@." lev (get_current_level())
+          Printtyp.raw_type_expr ty_res'; *)
+        let guard =
+          match pc_guard with
+          | None -> None
+          | Some scond ->
+              Some
+                (type_unpacks ext_env unpacks scond
+                   (mk_expected ~explanation:When_guard Predef.type_bool))
+        in
+        let exp =
+          type_unpacks ?in_function ext_env unpacks pc_rhs (mk_expected ty_res')
+        in
+        {
+         c_lhs = pat;
+         c_guard = guard;
+         c_rhs = {exp with exp_type = instance ty_res'}
+        }
+      )
+      half_typed_cases
+  in
+  if !Clflags.principal || does_contain_gadt then begin
+    let ty_res' = instance ty_res in
+    List.iter (fun c -> unify_exp env c.c_rhs ty_res') cases
+  end;
+  let do_init = may_contain_gadts || needs_exhaust_check in
+  let ty_arg_check =
+    if do_init then
+      (* Hack: use for_saving to copy variables too *)
+      Subst.type_expr (Subst.for_saving Subst.identity) ty_arg'
+    else ty_arg'
+  in
+  let val_cases, exn_cases =
+    match category with
+      | Value -> (cases : value case list), []
+      | Computation -> split_cases env cases in
+  if val_cases = [] && exn_cases <> [] then
+    raise (Error (loc, env, No_value_clauses));
+  let partial =
+    if partial_flag then
+      check_partial ~lev env ty_arg_check loc val_cases
+    else
+      Partial
+  in
+  let unused_check delayed =
+    List.iter (fun { typed_pat; branch_env; _ } ->
+      check_absent_variant branch_env (as_comp_pattern category typed_pat)
+    ) half_typed_cases;
+    if delayed then (begin_def (); init_def lev);
+    check_unused ~lev env ty_arg_check val_cases ;
+    check_unused ~lev env Predef.type_exn exn_cases ;
+    if delayed then end_def ();
+    Parmatch.check_ambiguous_bindings val_cases ;
+    Parmatch.check_ambiguous_bindings exn_cases
+  in
+  if contains_polyvars then
+    add_delayed_check (fun () -> unused_check true)
+  else
+    (* Check for unused cases, do not delay because of gadts *)
+    unused_check false;
+  if may_contain_gadts then begin
+    end_def ();
+    (* Ensure that existential types do not escape *)
+    unify_exp_types loc env (instance ty_res) (newvar ()) ;
+  end;
+  cases, partial
+
+(* Typing of let bindings *)
+
+and type_let
+    ?(check = fun s -> Warnings.Unused_var s)
+    ?(check_strict = fun s -> Warnings.Unused_var_strict s)
+    existential_context
+    env rec_flag spat_sexp_list scope allow =
+  let open Ast_helper in
+  begin_def();
+  if !Clflags.principal then begin_def ();
+
+  let is_fake_let =
+    match spat_sexp_list with
+    | [{pvb_expr={pexp_desc=Pexp_match(
+           {pexp_desc=Pexp_ident({ txt = Longident.Lident "*opt*"})},_)}}] ->
+        true (* the fake let-declaration introduced by fun ?(x = e) -> ... *)
+    | _ ->
+        false
+  in
+  let check = if is_fake_let then check_strict else check in
+
+  let spatl =
+    List.map
+      (fun {pvb_pat=spat; pvb_expr=sexp; pvb_attributes=attrs} ->
+        attrs,
+        match spat.ppat_desc, sexp.pexp_desc with
+          (Ppat_any | Ppat_constraint _), _ -> spat
+        | _, Pexp_coerce (_, _, sty)
+        | _, Pexp_constraint (_, sty) when !Clflags.principal ->
+            (* propagate type annotation to pattern,
+               to allow it to be generalized in -principal mode *)
+            Pat.constraint_
+              ~loc:{spat.ppat_loc with Location.loc_ghost=true}
+              spat
+              sty
+        | _ -> spat)
+      spat_sexp_list in
+  let nvs = List.map (fun _ -> newvar ()) spatl in
+  let (pat_list, new_env, force, pvs, unpacks) =
+    type_pattern_list Value existential_context env spatl scope nvs allow in
+  let attrs_list = List.map fst spatl in
+  let is_recursive = (rec_flag = Recursive) in
+  (* If recursive, first unify with an approximation of the expression *)
+  if is_recursive then
+    List.iter2
+      (fun pat binding ->
+        let pat =
+          match pat.pat_type.desc with
+          | Tpoly (ty, tl) ->
+              {pat with pat_type =
+               snd (instance_poly ~keep_names:true false tl ty)}
+          | _ -> pat
+        in unify_pat (ref env) pat (type_approx env binding.pvb_expr))
+      pat_list spat_sexp_list;
+  (* Polymorphic variant processing *)
+  List.iter
+    (fun pat ->
+      if has_variants pat then begin
+        Parmatch.pressure_variants env [pat];
+        finalize_variants pat
+      end)
+    pat_list;
+  (* Generalize the structure *)
+  let pat_list =
+    if !Clflags.principal then begin
+      end_def ();
+      iter_pattern_variables_type generalize_structure pvs;
+      List.map (fun pat ->
+        generalize_structure pat.pat_type;
+        {pat with pat_type = instance pat.pat_type}
+      ) pat_list
+    end else
+      pat_list
+  in
+  (* Only bind pattern variables after generalizing *)
+  List.iter (fun f -> f()) force;
+  let sexp_is_fun { pvb_expr = sexp; _ } =
+    match sexp.pexp_desc with
+    | Pexp_fun _ | Pexp_function _ -> true
+    | _ -> false
+  in
+  let exp_env =
+    if is_recursive then new_env
+    else if List.for_all sexp_is_fun spat_sexp_list
+    then begin
+      (* Add ghost bindings to help detecting missing "rec" keywords.
+
+         We only add those if the body of the definition is obviously a
+         function. The rationale is that, in other cases, the hint is probably
+         wrong (and the user is using "advanced features" anyway (lazy,
+         recursive values...)).
+
+         [pvb_loc] (below) is the location of the first let-binding (in case of
+         a let .. and ..), and is where the missing "rec" hint suggests to add a
+         "rec" keyword. *)
+      match spat_sexp_list with
+      | {pvb_loc; _} :: _ -> maybe_add_pattern_variables_ghost pvb_loc env pvs
+      | _ -> assert false
+    end
+    else env in
+
+  let current_slot = ref None in
+  let rec_needed = ref false in
+  let warn_about_unused_bindings =
+    List.exists
+      (fun attrs ->
+         Builtin_attributes.warning_scope ~ppwarning:false attrs (fun () ->
+           Warnings.is_active (check "") || Warnings.is_active (check_strict "")
+           || (is_recursive && (Warnings.is_active Warnings.Unused_rec_flag))))
+      attrs_list
+  in
+  let pat_slot_list =
+    (* Algorithm to detect unused declarations in recursive bindings:
+       - During type checking of the definitions, we capture the 'value_used'
+         events on the bound identifiers and record them in a slot corresponding
+         to the current definition (!current_slot).
+         In effect, this creates a dependency graph between definitions.
+
+       - After type checking the definition (!current_slot = None),
+         when one of the bound identifier is effectively used, we trigger
+         again all the events recorded in the corresponding slot.
+         The effect is to traverse the transitive closure of the graph created
+         in the first step.
+
+       We also keep track of whether *all* variables in a given pattern
+       are unused. If this is the case, for local declarations, the issued
+       warning is 26, not 27.
+     *)
+    List.map2
+      (fun attrs pat ->
+         Builtin_attributes.warning_scope ~ppwarning:false attrs (fun () ->
+           if not warn_about_unused_bindings then pat, None
+           else
+             let some_used = ref false in
+             (* has one of the identifier of this pattern been used? *)
+             let slot = ref [] in
+             List.iter
+               (fun id ->
+                  let vd = Env.find_value (Path.Pident id) new_env in
+                  (* note: Env.find_value does not trigger the value_used
+                           event *)
+                  let name = Ident.name id in
+                  let used = ref false in
+                  if not (name = "" || name.[0] = '_' || name.[0] = '#') then
+                    add_delayed_check
+                      (fun () ->
+                         if not !used then
+                           Location.prerr_warning vd.Types.val_loc
+                             ((if !some_used then check_strict else check) name)
+                      );
+                  Env.set_value_used_callback
+                    vd
+                    (fun () ->
+                       match !current_slot with
+                       | Some slot ->
+                         slot := vd.val_uid :: !slot; rec_needed := true
+                       | None ->
+                         List.iter Env.mark_value_used (get_ref slot);
+                         used := true;
+                         some_used := true
+                    )
+               )
+               (Typedtree.pat_bound_idents pat);
+             pat, Some slot
+         ))
+      attrs_list
+      pat_list
+  in
+  let exp_list =
+    List.map2
+      (fun {pvb_expr=sexp; pvb_attributes; _} (pat, slot) ->
+        if is_recursive then current_slot := slot;
+        match pat.pat_type.desc with
+        | Tpoly (ty, tl) ->
+            if !Clflags.principal then begin_def ();
+            let vars, ty' = instance_poly ~keep_names:true true tl ty in
+            if !Clflags.principal then begin
+              end_def ();
+              generalize_structure ty'
+            end;
+            let exp =
+              Builtin_attributes.warning_scope pvb_attributes (fun () ->
+                if rec_flag = Recursive then
+                  type_unpacks exp_env unpacks sexp (mk_expected ty')
+                else
+                  type_expect exp_env sexp (mk_expected ty')
+              )
+            in
+            exp, Some vars
+        | _ ->
+            let exp =
+              Builtin_attributes.warning_scope pvb_attributes (fun () ->
+                  if rec_flag = Recursive then
+                    type_unpacks exp_env unpacks sexp (mk_expected pat.pat_type)
+                  else
+                    type_expect exp_env sexp (mk_expected pat.pat_type))
+            in
+            exp, None)
+      spat_sexp_list pat_slot_list in
+  current_slot := None;
+  if is_recursive && not !rec_needed then begin
+    let {pvb_pat; pvb_attributes} = List.hd spat_sexp_list in
+    (* See PR#6677 *)
+    Builtin_attributes.warning_scope ~ppwarning:false pvb_attributes
+      (fun () ->
+         Location.prerr_warning pvb_pat.ppat_loc Warnings.Unused_rec_flag
+      )
+  end;
+  List.iter2
+    (fun pat (attrs, exp) ->
+       Builtin_attributes.warning_scope ~ppwarning:false attrs
+         (fun () ->
+            ignore(check_partial env pat.pat_type pat.pat_loc
+                     [case pat exp])
+         )
+    )
+    pat_list
+    (List.map2 (fun (attrs, _) (e, _) -> attrs, e) spatl exp_list);
+  let pvs = List.map (fun pv -> { pv with pv_type = instance pv.pv_type}) pvs in
+  end_def();
+  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 = 
+            ]}
+            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)
+    pat_list exp_list;
+  let l = List.combine pat_list exp_list in
+  let l =
+    List.map2
+      (fun (p, (e, _)) pvb ->
+        {vb_pat=p; vb_expr=e; vb_attributes=pvb.pvb_attributes;
+         vb_loc=pvb.pvb_loc;
+        })
+      l spat_sexp_list
+  in
+  if is_recursive then
+    List.iter
+      (fun {vb_pat=pat} -> match pat.pat_desc with
+           Tpat_var _ -> ()
+         | Tpat_alias ({pat_desc=Tpat_any}, _, _) -> ()
+         | _ -> raise(Error(pat.pat_loc, env, Illegal_letrec_pat)))
+      l;
+  List.iter (function
+      | {vb_pat = {pat_desc = Tpat_any; pat_extra; _}; vb_expr; _} ->
+          if not (List.exists (function (Tpat_constraint _, _, _) -> true
+                                      | _ -> false) pat_extra) then
+            check_partial_application false vb_expr
+      | _ -> ()) l;
+  (l, new_env, unpacks)
+
+and type_andops env sarg sands expected_ty =
+  let rec loop env let_sarg rev_sands expected_ty =
+    match rev_sands with
+    | [] -> type_expect env let_sarg (mk_expected expected_ty), []
+    | { pbop_op = sop; pbop_exp = sexp; pbop_loc = loc; _ } :: rest ->
+        if !Clflags.principal then begin_def ();
+        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
+        let ty_rest = newvar () in
+        let ty_result = newvar() in
+        let ty_rest_fun = newty (Tarrow(Nolabel, ty_arg, ty_result, Cok)) in
+        let ty_op = newty (Tarrow(Nolabel, ty_rest, ty_rest_fun, Cok)) in
+        begin try
+          unify env op_type ty_op
+        with Unify trace ->
+          raise(Error(sop.loc, env, Andop_type_clash(sop.txt, trace)))
+        end;
+        if !Clflags.principal then begin
+          end_def ();
+          generalize_structure ty_rest;
+          generalize_structure ty_arg;
+          generalize_structure ty_result
+        end;
+        let let_arg, rest = loop env let_sarg rest ty_rest in
+        let exp = type_expect env sexp (mk_expected ty_arg) in
+        begin try
+          unify env (instance ty_result) (instance expected_ty)
+        with Unify trace ->
+          raise(Error(loc, env, Bindings_type_clash(trace)))
+        end;
+        let andop =
+          { bop_op_name = sop;
+            bop_op_path = op_path;
+            bop_op_val = op_desc;
+            bop_op_type = op_type;
+            bop_exp = exp;
+            bop_loc = loc }
+        in
+        let_arg, andop :: rest
+  in
+  let let_arg, rev_ands = loop env sarg (List.rev sands) expected_ty in
+  let_arg, List.rev rev_ands
+
+(* Typing of toplevel bindings *)
+
+let type_binding env rec_flag spat_sexp_list scope =
+  Typetexp.reset_type_variables();
+  let (pat_exp_list, new_env, _unpacks) =
+    type_let
+      ~check:(fun s -> Warnings.Unused_value_declaration s)
+      ~check_strict:(fun s -> Warnings.Unused_value_declaration s)
+      At_toplevel
+      env rec_flag spat_sexp_list scope false
+  in
+  (pat_exp_list, new_env)
+
+let type_let existential_ctx env rec_flag spat_sexp_list scope =
+  let (pat_exp_list, new_env, _unpacks) =
+    type_let existential_ctx env rec_flag spat_sexp_list scope false in
+  (pat_exp_list, new_env)
+
+(* Typing of toplevel expressions *)
+
+let type_expression env sexp =
+  Typetexp.reset_type_variables();
+  begin_def();
+  let exp = type_exp env sexp in
+  end_def();
+  if maybe_expansive exp then lower_contravariant env exp.exp_type;
+  generalize exp.exp_type;
+  match sexp.pexp_desc with
+    Pexp_ident lid ->
+      let loc = sexp.pexp_loc in
+      (* Special case for keeping type variables when looking-up a variable *)
+      let (_path, desc) = Env.lookup_value ~use:false ~loc lid.txt env in
+      {exp with exp_type = desc.val_type}
+  | _ -> exp
+
+(* Error report *)
+
+let spellcheck ppf unbound_name valid_names =
+  Misc.did_you_mean ppf (fun () ->
+    Misc.spellcheck valid_names unbound_name
+  )
+
+let spellcheck_idents ppf unbound valid_idents =
+  spellcheck ppf (Ident.name unbound) (List.map Ident.name valid_idents)
+
+open Format
+
+let longident = Printtyp.longident
+
+(* Returns the first diff of the trace *)
+let type_clash_of_trace trace =
+  Ctype.Unification_trace.(explain trace (fun ~prev:_ -> function
+    | Diff diff -> Some diff
+    | _ -> None
+  ))
+
+(* 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
+    | Const_int n -> Some (Int.to_string n)
+    | Const_int32 n -> Some (Int32.to_string n)
+    | Const_int64 n -> Some (Int64.to_string n)
+    | Const_nativeint n -> Some (Nativeint.to_string n)
+    | _ -> None
+  in
+  let suffix =
+    if Path.same expected_type Predef.path_int32 then
+      Some 'l'
+    else if Path.same expected_type Predef.path_int64 then
+      Some 'L'
+    else if Path.same expected_type Predef.path_nativeint then
+      Some 'n'
+    else if Path.same expected_type Predef.path_float then
+      Some '.'
+    else None
+  in
+  match const_str, suffix with
+  | Some c, Some s -> [ Location.msg "@[Hint: Did you mean `%s%c'?@]" c s ]
+  | _, _ -> []
+
+let report_literal_type_constraint const = function
+  | Some Unification_trace.
+    { expected = { t = { desc = Tconstr (typ, [], _) } } } ->
+      report_literal_type_constraint typ const
+  | Some _ | None -> []
+
+let report_expr_type_clash_hints exp diff =
+  match exp with
+  | Some (Texp_constant const) -> report_literal_type_constraint const diff
+  | _ -> []
+
+let report_pattern_type_clash_hints
+      (type k) (pat : k pattern_desc option) diff =
+  match pat with
+  | Some (Tpat_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
+  match expl with
+  | If_conditional ->
+      because "the condition of an if-statement"
+  | If_no_else_branch ->
+      because "the result of a conditional with no else branch"
+  | While_loop_conditional ->
+      because "the condition of a while-loop"
+  | While_loop_body ->
+      because "the body of a while-loop"
+  | For_loop_start_index ->
+      because "a for-loop start index"
+  | For_loop_stop_index ->
+      because "a for-loop stop index"
+  | For_loop_body ->
+      because "the body of a for-loop"
+  | Assert_condition ->
+      because "the condition of an assertion"
+  | Sequence_left_hand_side ->
+      because "the left-hand side of a sequence"
+  | When_guard ->
+      because "a when-guard"
+
+let report_type_expected_explanation_opt expl ppf =
+  match expl with
+  | None -> ()
+  | Some expl -> report_type_expected_explanation expl ppf
+
+let report_unification_error ~loc ?sub env trace
+    ?type_expected_explanation txt1 txt2 =
+  Location.error_of_printer ~loc ?sub (fun ppf () ->
+    Printtyp.report_unification_error ppf env trace
+      ?type_expected_explanation txt1 txt2
+  ) ()
+
+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)@]"
+       longident lid expected provided
+  | Label_mismatch(lid, trace) ->
+      report_unification_error ~loc env trace
+        (function ppf ->
+           fprintf ppf "The record field %a@ belongs to the type"
+                   longident lid)
+        (function ppf ->
+           fprintf ppf "but is mixed here with fields of type")
+  | Pattern_type_clash (trace, pat) ->
+      let diff = type_clash_of_trace trace in
+      let sub = report_pattern_type_clash_hints pat diff in
+      Location.error_of_printer ~loc ~sub (fun ppf () ->
+        Printtyp.report_unification_error ppf env trace
+          (function ppf ->
+            fprintf ppf "This pattern matches values of type")
+          (function ppf ->
+            fprintf ppf "but a pattern was expected which matches values of \
+                         type");
+      ) ()
+  | Or_pattern_type_clash (id, trace) ->
+      report_unification_error ~loc env trace
+        (function ppf ->
+          fprintf ppf "The variable %s on the left-hand side of this \
+                       or-pattern has type" (Ident.name id))
+        (function ppf ->
+          fprintf ppf "but on the right-hand side it has type")
+  | Multiply_bound_variable name ->
+      Location.errorf ~loc
+        "Variable %s is bound several times in this matching"
+        name
+  | Orpat_vars (id, valid_idents) ->
+      Location.error_of_printer ~loc (fun ppf () ->
+        fprintf ppf
+          "Variable %s must occur on both sides of this | pattern"
+          (Ident.name id);
+        spellcheck_idents ppf id valid_idents
+      ) ()
+  | Expr_type_clash (trace, explanation, exp) ->
+      let diff = type_clash_of_trace trace in
+      let sub = report_expr_type_clash_hints exp diff in
+      Location.error_of_printer ~loc ~sub (fun ppf () ->
+        Printtyp.report_unification_error ppf env trace
+          ~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");
+      ) ()
+  | Apply_non_function typ ->
+      begin match (repr typ).desc with
+        Tarrow _ ->
+          Location.errorf ~loc
+            "@[@[<2>This function has type@ %a@]\
+             @ @[It is applied to too many arguments;@ %s@]@]"
+            Printtyp.type_expr typ "maybe you forgot a `;'.";
+      | _ ->
+          Location.errorf ~loc "@[@[<2>This expression has type@ %a@]@ %s@]"
+            Printtyp.type_expr typ
+            "This is not a function; it cannot be applied."
+      end
+  | Apply_wrong_label (l, ty, extra_info) ->
+      let print_label ppf = function
+        | Nolabel -> fprintf ppf "without label"
+        | l -> fprintf ppf "with label %s" (prefixed_label_name l)
+      in
+      let extra_info =
+        if not extra_info then
+          []
+        else
+          [ Location.msg
+              "Since OCaml 4.11, optional arguments do not commute when \
+               -nolabels is given" ]
+      in
+      Location.errorf ~loc ~sub:extra_info
+        "@[@[<2>The function applied to this argument has type@ %a@]@.\
+         This argument cannot be applied %a@]"
+        Printtyp.type_expr ty print_label l
+  | Label_multiply_defined s ->
+      Location.errorf ~loc "The record field label %s is defined several times"
+        s
+  | Label_missing labels ->
+      let print_labels ppf =
+        List.iter (fun lbl -> fprintf ppf "@ %s" (Ident.name lbl)) in
+      Location.errorf ~loc "@[Some record fields are undefined:%a@]"
+        print_labels labels
+  | Label_not_mutable lid ->
+      Location.errorf ~loc "The record field %a is not mutable" 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 () ->
+          let { ty; explanation } = ty_expected in
+          if Path.is_constructor_typath type_path then begin
+            fprintf ppf
+              "@[The field %s is not part of the record \
+               argument for the %a constructor@]"
+              name.txt
+              Printtyp.type_path type_path;
+          end else begin
+            fprintf ppf
+              "@[@[<2>%s type@ %a%t@]@ \
+               The %s %s does not belong to type %a@]"
+              eorp Printtyp.type_expr ty
+              (report_type_expected_explanation_opt explanation)
+              (Datatype_kind.label_name kind)
+              name.txt (*kind*) Printtyp.type_path type_path;
+          end;
+          spellcheck ppf name.txt valid_names
+      )) ()
+  | Name_type_mismatch (kind, lid, tp, tpl) ->
+      let type_name = Datatype_kind.type_name kind in
+      let name = Datatype_kind.label_name kind 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 longident lid type_name)
+          (function ppf ->
+             fprintf ppf "The %s %a@ belongs to one of the following %s types:"
+               name longident lid type_name)
+          (function ppf ->
+             fprintf ppf "but a %s was expected belonging to the %s type"
+               name type_name)
+      ) ()
+  | Invalid_format msg ->
+      Location.errorf ~loc "%s" msg
+  | Undefined_method (ty, me, valid_methods) ->
+      Location.error_of_printer ~loc (fun ppf () ->
+        Printtyp.wrap_printing_env ~error:true env (fun () ->
+          fprintf ppf
+            "@[@[This expression has type@;<1 2>%a@]@,\
+             It has no method %s@]" Printtyp.type_expr ty me;
+          begin match valid_methods with
+            | None -> ()
+            | Some valid_methods -> spellcheck ppf me valid_methods
+          end
+      )) ()
+  | Undefined_inherited_method (me, valid_methods) ->
+      Location.error_of_printer ~loc (fun ppf () ->
+        fprintf ppf "This expression has no method %s" me;
+        spellcheck ppf me valid_methods;
+      ) ()
+  | Virtual_class cl ->
+      Location.errorf ~loc "Cannot instantiate the virtual class %a"
+        longident cl
+  | Unbound_instance_variable (var, valid_vars) ->
+      Location.error_of_printer ~loc (fun ppf () ->
+        fprintf ppf "Unbound instance variable %s" var;
+        spellcheck ppf var valid_vars;
+      ) ()
+  | Instance_variable_not_mutable v ->
+      Location.errorf ~loc "The instance variable %s is not mutable" v
+  | Not_subtype(tr1, tr2) ->
+      Location.error_of_printer ~loc (fun ppf () ->
+        Printtyp.report_subtyping_error ppf env tr1 "is not a subtype of" tr2
+      ) ()
+  | Outside_class ->
+      Location.errorf ~loc
+        "This object duplication occurs outside a method definition"
+  | Value_multiply_overridden v ->
+      Location.errorf ~loc
+        "The instance variable %s is overridden several times"
+        v
+  | Coercion_failure (ty, ty', trace, b) ->
+      Location.error_of_printer ~loc (fun ppf () ->
+        Printtyp.report_unification_error ppf env trace
+          (function ppf ->
+             let ty, ty' = Printtyp.prepare_expansion (ty, ty') in
+             fprintf ppf "This expression cannot be coerced to type@;<1 2>%a;@ \
+                          it has type"
+             (Printtyp.type_expansion ty) ty')
+          (function ppf ->
+             fprintf ppf "but is here used with type");
+        if b then
+          fprintf ppf ".@.@[%s@ %s@ %s@]"
+            "This simple coercion was not fully general."
+            "Hint: Consider using a fully explicit coercion"
+            "of the form: `(foo : ty1 :> ty2)'."
+      ) ()
+  | Too_many_arguments (in_function, ty, explanation) ->
+      if in_function then begin
+        Location.errorf ~loc
+          "This function expects too many arguments,@ \
+           it should have type@ %a%t"
+          Printtyp.type_expr ty
+          (report_type_expected_explanation_opt explanation)
+      end else begin
+        Location.errorf ~loc
+          "This expression should not be a function,@ \
+           the expected type is@ %a%t"
+          Printtyp.type_expr ty
+          (report_type_expected_explanation_opt explanation)
+      end
+  | Abstract_wrong_label (l, ty, explanation) ->
+      let label_mark = function
+        | Nolabel -> "but its first argument is not labelled"
+        | l -> sprintf "but its first argument is labelled %s"
+                       (prefixed_label_name l) in
+      Location.errorf ~loc
+        "@[@[<2>This function should have type@ %a%t@]@,%s@]"
+        Printtyp.type_expr ty
+        (report_type_expected_explanation_opt explanation)
+        (label_mark l)
+  | Scoping_let_module(id, ty) ->
+      Location.errorf ~loc
+        "This `let module' expression has type@ %a@ \
+         In this type, the locally bound module name %s escapes its scope"
+        Printtyp.type_expr ty id
+  | Private_type ty ->
+      Location.errorf ~loc "Cannot create values of the private type %a"
+        Printtyp.type_expr ty
+  | Private_label (lid, ty) ->
+      Location.errorf ~loc "Cannot assign field %a of the private type %a"
+        longident lid Printtyp.type_expr ty
+  | Private_constructor (constr, ty) ->
+      Location.errorf ~loc
+        "Cannot use private constructor %s to create values of type %a"
+        constr.cstr_name Printtyp.type_expr ty
+  | Not_a_variant_type lid ->
+      Location.errorf ~loc "The type %a@ is not a variant type" longident lid
+  | Incoherent_label_order ->
+      Location.errorf ~loc
+        "This function is applied to arguments@ \
+        in an order different from other calls.@ \
+        This is only allowed when the real type is known."
+  | Less_general (kind, trace) ->
+      report_unification_error ~loc env trace
+        (fun ppf -> fprintf ppf "This %s has type" kind)
+        (fun ppf -> fprintf ppf "which is less general than")
+  | Modules_not_allowed ->
+      Location.errorf ~loc "Modules are not allowed in this pattern."
+  | Cannot_infer_signature ->
+      Location.errorf ~loc
+        "The signature for this packaged module couldn't be inferred."
+  | Not_a_packed_module ty ->
+      Location.errorf ~loc
+        "This expression is packed module, but the expected type is@ %a"
+        Printtyp.type_expr ty
+  | Unexpected_existential (reason, name, types) ->
+      let reason_str =
+        match reason with
+        | In_class_args ->
+            "Existential types are not allowed in class arguments"
+        | In_class_def ->
+            "Existential types are not allowed in bindings inside \
+             class definition"
+        | In_self_pattern ->
+            "Existential types are not allowed in self patterns"
+        | At_toplevel ->
+            "Existential types are not allowed in toplevel bindings"
+        | In_group ->
+            "Existential types are not allowed in \"let ... and ...\" bindings"
+        | In_rec ->
+            "Existential types are not allowed in recursive bindings"
+        | With_attributes ->
+            "Existential types are not allowed in presence of attributes"
+      in
+      begin match List.find (fun ty -> ty <> "$" ^ name) types with
+      | example ->
+          Location.errorf ~loc
+            "%s,@ but this pattern introduces the existential type %s."
+            reason_str example
+      | exception Not_found ->
+          Location.errorf ~loc
+            "%s,@ but the constructor %s introduces existential types."
+            reason_str name
+      end
+  | Invalid_interval ->
+      Location.errorf ~loc
+        "@[Only character intervals are supported in patterns.@]"
+  | Invalid_for_loop_index ->
+      Location.errorf ~loc
+        "@[Invalid for-loop index: only variables and _ are allowed.@]"
+  | No_value_clauses ->
+      Location.errorf ~loc
+        "None of the patterns in this 'match' expression match values."
+  | Exception_pattern_disallowed ->
+      Location.errorf ~loc
+        "@[Exception patterns are not allowed in this position.@]"
+  | Mixed_value_and_exception_patterns_under_guard ->
+      Location.errorf ~loc
+        "@[Mixing value and exception patterns under when-guards is not \
+         supported.@]"
+  | Inlined_record_escape ->
+      Location.errorf ~loc
+        "@[This form is not allowed as the type of the inlined record could \
+         escape.@]"
+  | Inlined_record_expected ->
+      Location.errorf ~loc
+        "@[This constructor expects an inlined record argument.@]"
+  | Unrefuted_pattern pat ->
+      Location.errorf ~loc
+        "@[%s@ %s@ %a@]"
+        "This match case could not be refuted."
+        "Here is an example of a value that would reach it:"
+        Printpat.top_pretty pat
+  | Invalid_extension_constructor_payload ->
+      Location.errorf ~loc
+        "Invalid [%%extension_constructor] payload, a constructor is expected."
+  | Not_an_extension_constructor ->
+      Location.errorf ~loc
+        "This constructor is not an extension constructor."
+  | Literal_overflow ty ->
+      Location.errorf ~loc
+        "Integer literal exceeds the range of representable integers of type %s"
+        ty
+  | Unknown_literal (n, m) ->
+      Location.errorf ~loc "Unknown modifier '%c' for literal %s%c" m n m
+  | Illegal_letrec_pat ->
+      Location.errorf ~loc
+        "Only variables are allowed as left-hand side of `let rec'"
+  | Illegal_letrec_expr ->
+      Location.errorf ~loc
+        "This kind of expression is not allowed as right-hand side of `let rec'"
+  | Illegal_class_expr ->
+      Location.errorf ~loc
+        "This kind of recursive class expression is not allowed"
+  | Letop_type_clash(name, trace) ->
+      report_unification_error ~loc env trace
+        (function ppf ->
+          fprintf ppf "The operator %s has type" name)
+        (function ppf ->
+          fprintf ppf "but it was expected to have type")
+  | Andop_type_clash(name, trace) ->
+      report_unification_error ~loc env trace
+        (function ppf ->
+          fprintf ppf "The operator %s has type" name)
+        (function ppf ->
+          fprintf ppf "but it was expected to have type")
+  | Bindings_type_clash(trace) ->
+      report_unification_error ~loc env trace
+        (function ppf ->
+          fprintf ppf "These bindings have type")
+        (function ppf ->
+          fprintf ppf "but bindings were expected of type")
+
+let report_error ~loc env err =
+  Printtyp.wrap_printing_env ~error:true env
+    (fun () -> report_error ~loc env err)
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (loc, env, err) ->
+        Some (report_error ~loc env err)
+      | Error_forward err ->
+        Some err
+      | _ ->
+        None
+    )
+
+let () =
+  Persistent_env.add_delayed_check_forward := add_delayed_check;
+  Env.add_delayed_check_forward := add_delayed_check;
+  ()
+
+(* drop ?recarg argument from the external API *)
+let type_expect ?in_function env e ty = type_expect ?in_function env e ty
+let type_exp env e = type_exp env e
+let type_argument env e t1 t2 = type_argument env e t1 t2
diff --git a/typing/typecore.mli b/typing/typecore.mli
new file mode 100644
index 00000000..2c8d177e
--- /dev/null
+++ b/typing/typecore.mli
@@ -0,0 +1,226 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Type inference for the core language *)
+
+open Asttypes
+open Types
+
+(* This variant is used to print improved error messages, and does not affect
+   the behavior of the typechecker itself.
+
+   It describes possible explanation for types enforced by a keyword of the
+   language; e.g. "if" requires the condition to be of type bool, and the
+   then-branch to be of type unit if there is no else branch; "for" requires
+   indices to be of type int, and the body to be of type unit.
+*)
+type type_forcing_context =
+  | If_conditional
+  | If_no_else_branch
+  | While_loop_conditional
+  | While_loop_body
+  | For_loop_start_index
+  | For_loop_stop_index
+  | For_loop_body
+  | Assert_condition
+  | Sequence_left_hand_side
+  | When_guard
+
+(* The combination of a type and a "type forcing context". The intent is that it
+   describes a type that is "expected" (required) by the context. If unifying
+   with such a type fails, then the "explanation" field explains why it was
+   required, in order to display a more enlightening error message.
+*)
+type type_expected = private {
+  ty: type_expr;
+  explanation: type_forcing_context option;
+}
+
+val mk_expected:
+  ?explanation:type_forcing_context ->
+  type_expr ->
+  type_expected
+
+val is_nonexpansive: Typedtree.expression -> bool
+
+module Datatype_kind : sig
+  type t = Record | Variant
+  val type_name : t -> string
+  val label_name : t -> string
+end
+
+type wrong_name = {
+  type_path: Path.t;
+  kind: Datatype_kind.t;
+  name: string loc;
+  valid_names: string list;
+}
+
+type existential_restriction =
+  | At_toplevel (** no existential types at the toplevel *)
+  | In_group (** nor with [let ... and ...] *)
+  | In_rec (** or recursive definition *)
+  | With_attributes (** or [let[@any_attribute] = ...] *)
+  | In_class_args (** or in class arguments [class c (...) = ...] *)
+  | In_class_def (** or in [class c = let ... in ...] *)
+  | In_self_pattern (** or in self pattern *)
+
+val type_binding:
+        Env.t -> rec_flag ->
+          Parsetree.value_binding list ->
+          Annot.ident option ->
+          Typedtree.value_binding list * Env.t
+val type_let:
+        existential_restriction -> Env.t -> rec_flag ->
+          Parsetree.value_binding list ->
+          Annot.ident option ->
+          Typedtree.value_binding list * Env.t
+val type_expression:
+        Env.t -> Parsetree.expression -> Typedtree.expression
+val type_class_arg_pattern:
+        string -> Env.t -> Env.t -> arg_label -> Parsetree.pattern ->
+        Typedtree.pattern *
+        (Ident.t * Ident.t * type_expr) list *
+        Env.t * Env.t
+val type_self_pattern:
+        string -> type_expr -> Env.t -> Env.t -> Env.t -> Parsetree.pattern ->
+        Typedtree.pattern *
+        (Ident.t * type_expr) Meths.t ref *
+        (Ident.t * Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr)
+            Vars.t ref *
+        Env.t * Env.t * Env.t
+val check_partial:
+        ?lev:int -> Env.t -> type_expr ->
+        Location.t -> Typedtree.value Typedtree.case list -> Typedtree.partial
+val type_expect:
+        ?in_function:(Location.t * type_expr) ->
+        Env.t -> Parsetree.expression -> type_expected -> Typedtree.expression
+val type_exp:
+        Env.t -> Parsetree.expression -> Typedtree.expression
+val type_approx:
+        Env.t -> Parsetree.expression -> type_expr
+val type_argument:
+        Env.t -> Parsetree.expression ->
+        type_expr -> type_expr -> Typedtree.expression
+
+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 reset_delayed_checks: unit -> unit
+val force_delayed_checks: unit -> unit
+
+val name_pattern : string -> Typedtree.pattern list -> Ident.t
+val name_cases : string -> Typedtree.value Typedtree.case list -> Ident.t
+
+val self_coercion : (Path.t * Location.t list ref) list ref
+
+type error =
+  | Constructor_arity_mismatch of Longident.t * int * int
+  | Label_mismatch of Longident.t * Ctype.Unification_trace.t
+  | Pattern_type_clash :
+      Ctype.Unification_trace.t * _ Typedtree.pattern_desc option -> error
+  | Or_pattern_type_clash of Ident.t * Ctype.Unification_trace.t
+  | Multiply_bound_variable of string
+  | Orpat_vars of Ident.t * Ident.t list
+  | Expr_type_clash of
+      Ctype.Unification_trace.t * type_forcing_context option
+      * Typedtree.expression_desc option
+  | Apply_non_function of type_expr
+  | Apply_wrong_label of arg_label * type_expr * bool
+  | Label_multiply_defined of string
+  | Label_missing of Ident.t list
+  | Label_not_mutable of Longident.t
+  | Wrong_name of string * type_expected * wrong_name
+  | Name_type_mismatch of
+      Datatype_kind.t * Longident.t * (Path.t * Path.t) * (Path.t * Path.t) list
+  | Invalid_format of string
+  | Undefined_method of type_expr * string * string list option
+  | Undefined_inherited_method of string * string list
+  | Virtual_class of Longident.t
+  | Private_type of type_expr
+  | Private_label of Longident.t * type_expr
+  | Private_constructor of constructor_description * type_expr
+  | Unbound_instance_variable of string * string list
+  | Instance_variable_not_mutable of string
+  | Not_subtype of Ctype.Unification_trace.t * Ctype.Unification_trace.t
+  | Outside_class
+  | Value_multiply_overridden of string
+  | Coercion_failure of
+      type_expr * type_expr * Ctype.Unification_trace.t * bool
+  | Too_many_arguments of bool * type_expr * type_forcing_context option
+  | Abstract_wrong_label of arg_label * type_expr * type_forcing_context option
+  | Scoping_let_module of string * type_expr
+  | Not_a_variant_type of Longident.t
+  | Incoherent_label_order
+  | Less_general of string * Ctype.Unification_trace.t
+  | Modules_not_allowed
+  | Cannot_infer_signature
+  | Not_a_packed_module of type_expr
+  | Unexpected_existential of existential_restriction * string * string list
+  | Invalid_interval
+  | Invalid_for_loop_index
+  | No_value_clauses
+  | Exception_pattern_disallowed
+  | Mixed_value_and_exception_patterns_under_guard
+  | Inlined_record_escape
+  | Inlined_record_expected
+  | Unrefuted_pattern of Typedtree.pattern
+  | Invalid_extension_constructor_payload
+  | Not_an_extension_constructor
+  | Literal_overflow of string
+  | Unknown_literal of string * char
+  | Illegal_letrec_pat
+  | Illegal_letrec_expr
+  | Illegal_class_expr
+  | Letop_type_clash of string * Ctype.Unification_trace.t
+  | Andop_type_clash of string * Ctype.Unification_trace.t
+  | Bindings_type_clash of Ctype.Unification_trace.t
+
+exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
+
+val report_error: loc:Location.t -> Env.t -> error -> Location.error
+ (** @deprecated.  Use {!Location.error_of_exn}, {!Location.print_report}. *)
+
+(* Forward declaration, to be filled in by Typemod.type_module *)
+val type_module: (Env.t -> Parsetree.module_expr -> Typedtree.module_expr) ref
+(* Forward declaration, to be filled in by Typemod.type_open *)
+val type_open:
+  (?used_slot:bool ref -> override_flag -> Env.t -> Location.t ->
+   Longident.t loc -> Path.t * Env.t)
+    ref
+(* Forward declaration, to be filled in by Typemod.type_open_decl *)
+val type_open_decl:
+  (?used_slot:bool ref -> Env.t -> Parsetree.open_declaration ->
+   Typedtree.open_declaration * Types.signature * Env.t)
+    ref
+(* Forward declaration, to be filled in by Typeclass.class_structure *)
+val type_object:
+  (Env.t -> Location.t -> Parsetree.class_structure ->
+   Typedtree.class_structure * Types.class_signature * string list) ref
+val type_package:
+  (Env.t -> Parsetree.module_expr -> Path.t -> Longident.t list ->
+  Typedtree.module_expr * type_expr list) ref
+
+val create_package_type : Location.t -> Env.t ->
+  Longident.t * (Longident.t * Parsetree.core_type) list ->
+  Path.t * (Longident.t * Typedtree.core_type) list * Types.type_expr
+
+val constant: Parsetree.constant -> (Asttypes.constant, error) result
+
+val check_recursive_bindings : Env.t -> Typedtree.value_binding list -> unit
+val check_recursive_class_bindings :
+  Env.t -> Ident.t list -> Typedtree.class_expr list -> unit
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
new file mode 100644
index 00000000..d38a1423
--- /dev/null
+++ b/typing/typedecl.ml
@@ -0,0 +1,1872 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(**** Typing of type definitions ****)
+
+open Misc
+open Asttypes
+open Parsetree
+open Primitive
+open Types
+open Typetexp
+
+module String = Misc.Stdlib.String
+
+type native_repr_kind = Unboxed | Untagged
+
+type error =
+    Repeated_parameter
+  | Duplicate_constructor of string
+  | Too_many_constructors
+  | Duplicate_label of string
+  | Recursive_abbrev of string
+  | Cycle_in_def of string * type_expr
+  | Definition_mismatch of type_expr * Includecore.type_mismatch option
+  | Constraint_failed of type_expr * type_expr
+  | Inconsistent_constraint of Env.t * Ctype.Unification_trace.t
+  | Type_clash of Env.t * Ctype.Unification_trace.t
+  | Non_regular of {
+      definition: Path.t;
+      used_as: type_expr;
+      defined_as: type_expr;
+      expansions: (type_expr * type_expr) list;
+    }
+  | Null_arity_external
+  | Missing_native_external
+  | Unbound_type_var of type_expr * type_declaration
+  | Cannot_extend_private_type of Path.t
+  | Not_extensible_type of Path.t
+  | Extension_mismatch of Path.t * Includecore.type_mismatch
+  | Rebind_wrong_type of Longident.t * Env.t * Ctype.Unification_trace.t
+  | Rebind_mismatch of Longident.t * Path.t * Path.t
+  | Rebind_private of Longident.t
+  | Variance of Typedecl_variance.error
+  | Unavailable_type_constructor of Path.t
+  | Bad_fixed_type of string
+  | Unbound_type_var_ext of type_expr * extension_constructor
+  | Val_in_structure
+  | Multiple_native_repr_attributes
+  | Cannot_unbox_or_untag_type of native_repr_kind
+  | Deep_unbox_or_untag_attribute of native_repr_kind
+  | Immediacy of Typedecl_immediacy.error
+  | Separability of Typedecl_separability.error
+  | Bad_unboxed_attribute of string
+  | Boxed_and_unboxed
+  | Nonrec_gadt
+
+open Typedtree
+
+exception Error of Location.t * error
+
+(* Note: do not factor the branches in the following pattern-matching:
+   the records must be constants for the compiler to do sharing on them.
+*)
+let get_unboxed_from_attributes sdecl =
+  let unboxed = Builtin_attributes.has_unboxed sdecl.ptype_attributes in
+  let boxed = Builtin_attributes.has_boxed sdecl.ptype_attributes in
+  match boxed, unboxed, !Clflags.unboxed_types with
+  | true, true, _ -> raise (Error(sdecl.ptype_loc, Boxed_and_unboxed))
+  | true, false, _ -> unboxed_false_default_false
+  | false, true, _ -> unboxed_true_default_false
+  | false, false, false -> unboxed_false_default_true
+  | false, false, true -> unboxed_true_default_true
+
+(* Enter all declared types in the environment as abstract types *)
+
+let add_type ~check id decl env =
+  Builtin_attributes.warning_scope ~ppwarning:false decl.type_attributes
+    (fun () -> Env.add_type ~check id decl env)
+
+let enter_type rec_flag env sdecl (id, uid) =
+  let needed =
+    match rec_flag with
+    | Asttypes.Nonrecursive ->
+        begin match sdecl.ptype_kind with
+        | Ptype_variant scds ->
+            List.iter (fun cd ->
+              if cd.pcd_res <> None then raise (Error(cd.pcd_loc, Nonrec_gadt)))
+              scds
+        | _ -> ()
+        end;
+        Btype.is_row_name (Ident.name id)
+    | Asttypes.Recursive -> true
+  in
+  let arity = List.length sdecl.ptype_params in
+  if not needed then env else
+  let decl =
+    { type_params =
+        List.map (fun _ -> Btype.newgenvar ()) sdecl.ptype_params;
+      type_arity = arity;
+      type_kind = Type_abstract;
+      type_private = sdecl.ptype_private;
+      type_manifest =
+        begin match sdecl.ptype_manifest with None -> None
+        | Some _ -> Some(Ctype.newvar ()) end;
+      type_variance = List.map (fun _ -> Variance.full) sdecl.ptype_params;
+      type_separability = Types.Separability.default_signature ~arity;
+      type_is_newtype = false;
+      type_expansion_scope = Btype.lowest_level;
+      type_loc = sdecl.ptype_loc;
+      type_attributes = sdecl.ptype_attributes;
+      type_immediate = Unknown;
+      type_unboxed = unboxed_false_default_false;
+      type_uid = uid;
+    }
+  in
+  add_type ~check:true id decl env
+
+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 ->
+      let params = List.map (fun _ -> Ctype.newvar ()) decl.type_params in
+      try Ctype.unify env (Ctype.newconstr path params) ty
+      with Ctype.Unify trace ->
+        raise (Error(loc, Type_clash (env, trace)))
+
+let get_unboxed_type_representation env ty =
+  match Typedecl_unboxed.get_unboxed_type_representation env ty with
+  | Typedecl_unboxed.This x -> Some x
+  | _ -> None
+
+(* Determine if a type's values are represented by floats at run-time. *)
+let is_float env ty =
+  match get_unboxed_type_representation env ty with
+    Some {desc = Tconstr(p, _, _); _} -> Path.same p Predef.path_float
+  | _ -> false
+
+(* Determine if a type definition defines a fixed type. (PW) *)
+let is_fixed_type sd =
+  let rec has_row_var sty =
+    match sty.ptyp_desc with
+      Ptyp_alias (sty, _) -> has_row_var sty
+    | Ptyp_class _
+    | Ptyp_object (_, Open)
+    | Ptyp_variant (_, Open, _)
+    | Ptyp_variant (_, Closed, Some _) -> true
+    | _ -> false
+  in
+  match sd.ptype_manifest with
+    None -> false
+  | Some sty ->
+      sd.ptype_kind = Ptype_abstract &&
+      sd.ptype_private = Private &&
+      has_row_var sty
+
+(* Set the row variable in a fixed type *)
+let set_fixed_row env loc p decl =
+  let tm =
+    match decl.type_manifest with
+      None -> assert false
+    | Some t -> Ctype.expand_head env t
+  in
+  let rv =
+    match tm.desc with
+      Tvariant row ->
+        let row = Btype.row_repr row in
+        tm.desc <- Tvariant {row with row_fixed = Some Fixed_private};
+        if Btype.static_row row then Btype.newgenty Tnil
+        else row.row_more
+    | Tobject (ty, _) ->
+        snd (Ctype.flatten_fields ty)
+    | _ ->
+        raise (Error (loc, Bad_fixed_type "is not an object or variant"))
+  in
+  if not (Btype.is_Tvar rv) then
+    raise (Error (loc, Bad_fixed_type "has no row variable"));
+  rv.desc <- Tconstr (p, decl.type_params, ref Mnil)
+
+(* Translate one type declaration *)
+
+let make_params env params =
+  let make_param (sty, v) =
+    try
+      (transl_type_param env sty, v)
+    with Already_bound ->
+      raise(Error(sty.ptyp_loc, Repeated_parameter))
+  in
+    List.map make_param params
+
+let transl_labels env closed lbls =
+  assert (lbls <> []);
+  let all_labels = ref String.Set.empty in
+  List.iter
+    (fun {pld_name = {txt=name; loc}} ->
+       if String.Set.mem name !all_labels then
+         raise(Error(loc, Duplicate_label name));
+       all_labels := String.Set.add name !all_labels)
+    lbls;
+  let mk {pld_name=name;pld_mutable=mut;pld_type=arg;pld_loc=loc;
+          pld_attributes=attrs} =
+    Builtin_attributes.warning_scope attrs
+      (fun () ->
+         let arg = Ast_helper.Typ.force_poly arg in
+         let cty = transl_simple_type env closed arg in
+         {ld_id = Ident.create_local name.txt;
+          ld_name = name; ld_mutable = mut;
+          ld_type = cty; ld_loc = loc; ld_attributes = attrs}
+      )
+  in
+  let lbls = List.map mk lbls in
+  let lbls' =
+    List.map
+      (fun ld ->
+         let ty = ld.ld_type.ctyp_type in
+         let ty = match ty.desc with Tpoly(t,[]) -> t | _ -> ty in
+         {Types.ld_id = ld.ld_id;
+          ld_mutable = ld.ld_mutable;
+          ld_type = ty;
+          ld_loc = ld.ld_loc;
+          ld_attributes = ld.ld_attributes;
+          ld_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+         }
+      )
+      lbls in
+  lbls, lbls'
+
+let transl_constructor_arguments env closed = function
+  | Pcstr_tuple l ->
+      let l = List.map (transl_simple_type env closed) l in
+      Types.Cstr_tuple (List.map (fun t -> t.ctyp_type) l),
+      Cstr_tuple l
+  | Pcstr_record l ->
+      let lbls, lbls' = transl_labels env closed l in
+      Types.Cstr_record lbls',
+      Cstr_record lbls
+
+let make_constructor env type_path type_params sargs sret_type =
+  match sret_type with
+  | None ->
+      let args, targs =
+        transl_constructor_arguments env true sargs
+      in
+        targs, None, args, None
+  | Some sret_type ->
+      (* if it's a generalized constructor we must first narrow and
+         then widen so as to not introduce any new constraints *)
+      let z = narrow () in
+      reset_type_variables ();
+      let args, targs =
+        transl_constructor_arguments env false sargs
+      in
+      let tret_type = transl_simple_type env false sret_type in
+      let ret_type = tret_type.ctyp_type in
+      (* TODO add back type_path as a parameter ? *)
+      begin match (Ctype.repr ret_type).desc with
+        | Tconstr (p', _, _) when Path.same type_path p' -> ()
+        | _ ->
+            raise (Error (sret_type.ptyp_loc, Constraint_failed
+                            (ret_type, Ctype.newconstr type_path type_params)))
+      end;
+      widen z;
+      targs, Some tret_type, args, Some ret_type
+
+let transl_declaration env sdecl (id, uid) =
+  (* Bind type parameters *)
+  reset_type_variables();
+  Ctype.begin_def ();
+  let tparams = make_params env sdecl.ptype_params in
+  let params = List.map (fun (cty, _) -> cty.ctyp_type) tparams in
+  let cstrs = List.map
+    (fun (sty, sty', loc) ->
+      transl_simple_type env false sty,
+      transl_simple_type env false sty', loc)
+    sdecl.ptype_cstrs
+  in
+  let raw_status = get_unboxed_from_attributes sdecl in
+  if raw_status.unboxed && not raw_status.default then begin
+    let bad msg = raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute msg)) in
+    match sdecl.ptype_kind with
+    | Ptype_abstract    -> bad "it is abstract"
+    | Ptype_open        -> bad "extensible variant types cannot be unboxed"
+    | Ptype_record fields -> begin match fields with
+        | [] -> bad "it has no fields"
+        | _::_::_ -> bad "it has more than one field"
+        | [{pld_mutable = Mutable}] -> bad "it is mutable"
+        | [{pld_mutable = Immutable}] -> ()
+      end
+    | Ptype_variant constructors -> begin match constructors with
+        | [] -> bad "it has no constructor"
+        | (_::_::_) -> bad "it has more than one constructor"
+        | [c] -> begin match c.pcd_args with
+            | Pcstr_tuple [] ->
+                bad "its constructor has no argument"
+            | Pcstr_tuple (_::_::_) ->
+                bad "its constructor has more than one argument"
+            | Pcstr_tuple [_]  ->
+                ()
+            | Pcstr_record [] ->
+                bad "its constructor has no fields"
+            | Pcstr_record (_::_::_) ->
+                bad "its constructor has more than one field"
+            | Pcstr_record [{pld_mutable = Mutable}] ->
+                bad "it is mutable"
+            | Pcstr_record [{pld_mutable = Immutable}] ->
+                ()
+          end
+      end
+  end;
+  let unboxed_status =
+    match sdecl.ptype_kind with
+    | Ptype_variant [{pcd_args = Pcstr_tuple [_]; _}]
+    | Ptype_variant [{pcd_args = Pcstr_record [{pld_mutable=Immutable; _}]; _}]
+    | Ptype_record [{pld_mutable=Immutable; _}] -> raw_status
+    | _ -> unboxed_false_default_false (* Not unboxable, mark as boxed *)
+  in
+  let unbox = unboxed_status.unboxed in
+  let (tkind, kind) =
+    match sdecl.ptype_kind with
+      | Ptype_abstract -> Ttype_abstract, Type_abstract
+      | Ptype_variant scstrs ->
+        if List.exists (fun cstr -> cstr.pcd_res <> None) scstrs then begin
+          match cstrs with
+            [] -> ()
+          | (_,_,loc)::_ ->
+              Location.prerr_warning loc Warnings.Constraint_on_gadt
+        end;
+        let all_constrs = ref String.Set.empty in
+        List.iter
+          (fun {pcd_name = {txt = name}} ->
+            if String.Set.mem name !all_constrs then
+              raise(Error(sdecl.ptype_loc, Duplicate_constructor name));
+            all_constrs := String.Set.add name !all_constrs)
+          scstrs;
+        if List.length
+            (List.filter (fun cd -> cd.pcd_args <> Pcstr_tuple []) scstrs)
+           > (Config.max_tag + 1) then
+          raise(Error(sdecl.ptype_loc, Too_many_constructors));
+        let make_cstr scstr =
+          let name = Ident.create_local scstr.pcd_name.txt in
+          let targs, tret_type, args, ret_type =
+            make_constructor env (Path.Pident id) params
+                             scstr.pcd_args scstr.pcd_res
+          in
+          let tcstr =
+            { cd_id = name;
+              cd_name = scstr.pcd_name;
+              cd_args = targs;
+              cd_res = tret_type;
+              cd_loc = scstr.pcd_loc;
+              cd_attributes = scstr.pcd_attributes }
+          in
+          let cstr =
+            { Types.cd_id = name;
+              cd_args = args;
+              cd_res = ret_type;
+              cd_loc = scstr.pcd_loc;
+              cd_attributes = scstr.pcd_attributes;
+              cd_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) }
+          in
+            tcstr, cstr
+        in
+        let make_cstr scstr =
+          Builtin_attributes.warning_scope scstr.pcd_attributes
+            (fun () -> make_cstr scstr)
+        in
+        let tcstrs, cstrs = List.split (List.map make_cstr scstrs) in
+          Ttype_variant tcstrs, Type_variant cstrs
+      | Ptype_record lbls ->
+          let lbls, lbls' = transl_labels env true lbls in
+          let rep =
+            if unbox then Record_unboxed false
+            else if List.for_all (fun l -> is_float env l.Types.ld_type) lbls'
+            then Record_float
+            else Record_regular
+          in
+          Ttype_record lbls, Type_record(lbls', rep)
+      | Ptype_open -> Ttype_open, Type_open
+      in
+    let (tman, man) = match sdecl.ptype_manifest with
+        None -> None, None
+      | Some sty ->
+        let no_row = not (is_fixed_type sdecl) in
+        let cty = transl_simple_type env no_row sty in
+        Some cty, Some cty.ctyp_type
+    in
+    let arity = List.length params in
+    let decl =
+      { type_params = params;
+        type_arity = arity;
+        type_kind = kind;
+        type_private = sdecl.ptype_private;
+        type_manifest = man;
+        type_variance = List.map (fun _ -> Variance.full) params;
+        type_separability = Types.Separability.default_signature ~arity;
+        type_is_newtype = false;
+        type_expansion_scope = Btype.lowest_level;
+        type_loc = sdecl.ptype_loc;
+        type_attributes = sdecl.ptype_attributes;
+        type_immediate = Unknown;
+        type_unboxed = unboxed_status;
+        type_uid = uid;
+      } in
+
+  (* Check constraints *)
+    List.iter
+      (fun (cty, cty', loc) ->
+        let ty = cty.ctyp_type in
+        let ty' = cty'.ctyp_type in
+        try Ctype.unify env ty ty' with Ctype.Unify tr ->
+          raise(Error(loc, Inconsistent_constraint (env, tr))))
+      cstrs;
+    Ctype.end_def ();
+  (* Add abstract row *)
+    if is_fixed_type sdecl then begin
+      let p, _ =
+        try Env.find_type_by_name
+              (Longident.Lident(Ident.name id ^ "#row")) env
+        with Not_found -> assert false
+      in
+      set_fixed_row env sdecl.ptype_loc p decl
+    end;
+  (* Check for cyclic abbreviations *)
+    begin match decl.type_manifest with None -> ()
+      | Some ty ->
+        if Ctype.cyclic_abbrev env id ty then
+          raise(Error(sdecl.ptype_loc, Recursive_abbrev sdecl.ptype_name.txt));
+    end;
+    {
+      typ_id = id;
+      typ_name = sdecl.ptype_name;
+      typ_params = tparams;
+      typ_type = decl;
+      typ_cstrs = cstrs;
+      typ_loc = sdecl.ptype_loc;
+      typ_manifest = tman;
+      typ_kind = tkind;
+      typ_private = sdecl.ptype_private;
+      typ_attributes = sdecl.ptype_attributes;
+    }
+
+(* 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
+module TypeMap = Btype.TypeMap
+
+let rec check_constraints_rec env loc visited ty =
+  let ty = Ctype.repr ty in
+  if TypeSet.mem ty !visited then () else begin
+  visited := TypeSet.add ty !visited;
+  match ty.desc with
+  | Tconstr (path, args, _) ->
+      let args' = List.map (fun _ -> Ctype.newvar ()) args in
+      let ty' = Ctype.newconstr path args' in
+      begin try Ctype.enforce_constraints env ty'
+      with Ctype.Unify _ -> assert false
+      | Not_found -> raise (Error(loc, Unavailable_type_constructor path))
+      end;
+      if not (Ctype.matches env ty ty') then
+        raise (Error(loc, Constraint_failed (ty, ty')));
+      List.iter (check_constraints_rec env loc visited) args
+  | Tpoly (ty, tl) ->
+      let _, ty = Ctype.instance_poly false tl ty in
+      check_constraints_rec env loc visited ty
+  | _ ->
+      Btype.iter_type_expr (check_constraints_rec env loc visited) ty
+  end
+
+let check_constraints_labels env visited l pl =
+  let rec get_loc name = function
+      [] -> assert false
+    | pld :: tl ->
+        if name = pld.pld_name.txt then pld.pld_type.ptyp_loc
+        else get_loc name tl
+  in
+  List.iter
+    (fun {Types.ld_id=name; ld_type=ty} ->
+       check_constraints_rec env (get_loc (Ident.name name) pl) visited ty)
+    l
+
+let check_constraints env sdecl (_, decl) =
+  let visited = ref TypeSet.empty in
+  begin match decl.type_kind with
+  | Type_abstract -> ()
+  | Type_variant l ->
+      let find_pl = function
+          Ptype_variant pl -> pl
+        | Ptype_record _ | Ptype_abstract | Ptype_open -> assert false
+      in
+      let pl = find_pl sdecl.ptype_kind in
+      let pl_index =
+        let foldf acc x =
+          String.Map.add x.pcd_name.txt x acc
+        in
+        List.fold_left foldf String.Map.empty pl
+      in
+      List.iter
+        (fun {Types.cd_id=name; cd_args; cd_res} ->
+          let {pcd_args; pcd_res; _} =
+            try String.Map.find (Ident.name name) pl_index
+            with Not_found -> assert false in
+          begin match cd_args, pcd_args with
+          | Cstr_tuple tyl, Pcstr_tuple styl ->
+              List.iter2
+                (fun sty ty ->
+                   check_constraints_rec env sty.ptyp_loc visited ty)
+                styl tyl
+          | Cstr_record tyl, Pcstr_record styl ->
+              check_constraints_labels env visited tyl styl
+          | _ -> assert false
+          end;
+          match pcd_res, cd_res with
+          | Some sr, Some r ->
+              check_constraints_rec env sr.ptyp_loc visited r
+          | _ ->
+              () )
+        l
+  | Type_record (l, _) ->
+      let find_pl = function
+          Ptype_record pl -> pl
+        | Ptype_variant _ | Ptype_abstract | Ptype_open -> assert false
+      in
+      let pl = find_pl sdecl.ptype_kind in
+      check_constraints_labels env visited l pl
+  | Type_open -> ()
+  end;
+  begin match decl.type_manifest with
+  | None -> ()
+  | Some ty ->
+      let sty =
+        match sdecl.ptype_manifest with Some sty -> sty | _ -> assert false
+      in
+      check_constraints_rec env sty.ptyp_loc visited ty
+  end
+
+(*
+   If both a variant/record definition and a type equation are given,
+   need to check that the equation refers to a type of the same kind
+   with the same constructors and labels.
+*)
+let check_coherence env loc dpath decl =
+  match decl with
+    { type_kind = (Type_variant _ | Type_record _| Type_open);
+      type_manifest = Some ty } ->
+      begin match (Ctype.repr ty).desc with
+        Tconstr(path, args, _) ->
+          begin try
+            let decl' = Env.find_type path env in
+            let err =
+              if List.length args <> List.length decl.type_params
+              then Some Includecore.Arity
+              else if not (Ctype.equal env false args decl.type_params)
+              then Some Includecore.Constraint
+              else
+                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)
+            in
+            if err <> None then
+              raise(Error(loc, Definition_mismatch (ty, err)))
+          with Not_found ->
+            raise(Error(loc, Unavailable_type_constructor path))
+          end
+      | _ -> raise(Error(loc, Definition_mismatch (ty, None)))
+      end
+  | _ -> ()
+
+let check_abbrev env sdecl (id, decl) =
+  check_coherence env sdecl.ptype_loc (Path.Pident id) decl
+
+(* Check that recursion is well-founded *)
+
+let check_well_founded env loc path to_check ty =
+  let visited = ref TypeMap.empty in
+  let rec check ty0 parents ty =
+    let ty = Btype.repr ty in
+    if TypeSet.mem ty parents then begin
+      (*Format.eprintf "@[%a@]@." Printtyp.raw_type_expr ty;*)
+      if match ty0.desc with
+      | Tconstr (p, _, _) -> Path.same p path
+      | _ -> false
+      then raise (Error (loc, Recursive_abbrev (Path.name path)))
+      else raise (Error (loc, Cycle_in_def (Path.name path, ty0)))
+    end;
+    let (fini, parents) =
+      try
+        let prev = TypeMap.find ty !visited in
+        if TypeSet.subset parents prev then (true, parents) else
+        (false, TypeSet.union parents prev)
+      with Not_found ->
+        (false, parents)
+    in
+    if fini then () else
+    let rec_ok =
+      match ty.desc with
+        Tconstr(p,_,_) ->
+          !Clflags.recursive_types && Ctype.is_contractive env p
+      | Tobject _ | Tvariant _ -> true
+      | _ -> !Clflags.recursive_types
+    in
+    let visited' = TypeMap.add ty parents !visited in
+    let arg_exn =
+      try
+        visited := visited';
+        let parents =
+          if rec_ok then TypeSet.empty else TypeSet.add ty parents in
+        Btype.iter_type_expr (check ty0 parents) ty;
+        None
+      with e ->
+        visited := visited'; Some e
+    in
+    match ty.desc with
+    | Tconstr(p, _, _) when arg_exn <> None || to_check p ->
+        if to_check p then Option.iter raise arg_exn
+        else Btype.iter_type_expr (check ty0 TypeSet.empty) ty;
+        begin try
+          let ty' = Ctype.try_expand_once_opt env ty in
+          let ty0 = if TypeSet.is_empty parents then ty else ty0 in
+          check ty0 (TypeSet.add ty parents) ty'
+        with
+          Ctype.Cannot_expand -> Option.iter raise arg_exn
+        end
+    | _ -> Option.iter raise arg_exn
+  in
+  let snap = Btype.snapshot () in
+  try Ctype.wrap_trace_gadt_instances env (check ty TypeSet.empty) ty
+  with Ctype.Unify _ ->
+    (* Will be detected by check_recursion *)
+    Btype.backtrack snap
+
+let check_well_founded_manifest env loc path decl =
+  if decl.type_manifest = None then () else
+  let args = List.map (fun _ -> Ctype.newvar()) decl.type_params in
+  check_well_founded env loc path (Path.same path) (Ctype.newconstr path args)
+
+let check_well_founded_decl env loc path decl to_check =
+  let open Btype in
+  let it =
+    {type_iterators with
+     it_type_expr = (fun _ -> check_well_founded env loc path to_check)} in
+  it.it_type_declaration it (Ctype.generic_instance_declaration decl)
+
+(* Check for ill-defined abbrevs *)
+
+let check_recursion env loc path decl to_check =
+  (* to_check is true for potentially mutually recursive paths.
+     (path, decl) is the type declaration to be checked. *)
+
+  if decl.type_params = [] then () else
+
+  let visited = ref [] in
+
+  let rec check_regular cpath args prev_exp prev_expansions ty =
+    let ty = Ctype.repr ty in
+    if not (List.memq ty !visited) then begin
+      visited := ty :: !visited;
+      match ty.desc with
+      | Tconstr(path', args', _) ->
+          if Path.same path path' then begin
+            if not (Ctype.equal env false args args') then
+              raise (Error(loc,
+                     Non_regular {
+                       definition=path;
+                       used_as=ty;
+                       defined_as=Ctype.newconstr path args;
+                       expansions=List.rev prev_expansions;
+                     }))
+          end
+          (* Attempt to expand a type abbreviation if:
+              1- [to_check path'] holds
+                 (otherwise the expansion cannot involve [path]);
+              2- we haven't expanded this type constructor before
+                 (otherwise we could loop if [path'] is itself
+                 a non-regular abbreviation). *)
+          else if to_check path' && not (List.mem path' prev_exp) then begin
+            try
+              (* Attempt expansion *)
+              let (params0, body0, _) = Env.find_type_expansion path' env in
+              let (params, body) =
+                Ctype.instance_parameterized_type params0 body0 in
+              begin
+                try List.iter2 (Ctype.unify env) params args'
+                with Ctype.Unify _ ->
+                  raise (Error(loc, Constraint_failed
+                                 (ty, Ctype.newconstr path' params0)));
+              end;
+              check_regular path' args
+                (path' :: prev_exp) ((ty,body) :: prev_expansions)
+                body
+            with Not_found -> ()
+          end;
+          List.iter (check_regular cpath args prev_exp prev_expansions) args'
+      | Tpoly (ty, tl) ->
+          let (_, ty) = Ctype.instance_poly ~keep_names:true false tl ty in
+          check_regular cpath args prev_exp prev_expansions ty
+      | _ ->
+          Btype.iter_type_expr
+            (check_regular cpath args prev_exp prev_expansions) ty
+    end in
+
+  Option.iter
+    (fun body ->
+      let (args, body) =
+        Ctype.instance_parameterized_type
+          ~keep_names:true decl.type_params body in
+      check_regular path args [] [] body)
+    decl.type_manifest
+
+let check_abbrev_recursion env id_loc_list to_check tdecl =
+  let decl = tdecl.typ_type in
+  let id = tdecl.typ_id in
+  check_recursion env (List.assoc id id_loc_list) (Path.Pident id) decl to_check
+
+let check_duplicates sdecl_list =
+  let labels = Hashtbl.create 7 and constrs = Hashtbl.create 7 in
+  List.iter
+    (fun sdecl -> match sdecl.ptype_kind with
+      Ptype_variant cl ->
+        List.iter
+          (fun pcd ->
+            try
+              let name' = Hashtbl.find constrs pcd.pcd_name.txt in
+              Location.prerr_warning pcd.pcd_loc
+                (Warnings.Duplicate_definitions
+                   ("constructor", pcd.pcd_name.txt, name',
+                    sdecl.ptype_name.txt))
+            with Not_found ->
+              Hashtbl.add constrs pcd.pcd_name.txt sdecl.ptype_name.txt)
+          cl
+    | Ptype_record fl ->
+        List.iter
+          (fun {pld_name=cname;pld_loc=loc} ->
+            try
+              let name' = Hashtbl.find labels cname.txt in
+              Location.prerr_warning loc
+                (Warnings.Duplicate_definitions
+                   ("label", cname.txt, name', sdecl.ptype_name.txt))
+            with Not_found -> Hashtbl.add labels cname.txt sdecl.ptype_name.txt)
+          fl
+    | Ptype_abstract -> ()
+    | Ptype_open -> ())
+    sdecl_list
+
+(* Force recursion to go through id for private types*)
+let name_recursion sdecl id decl =
+  match decl with
+  | { type_kind = Type_abstract;
+      type_manifest = Some ty;
+      type_private = Private; } when is_fixed_type sdecl ->
+    let ty = Ctype.repr ty in
+    let ty' = Btype.newty2 ty.level ty.desc in
+    if Ctype.deep_occur ty ty' then
+      let td = Tconstr(Path.Pident id, decl.type_params, ref Mnil) in
+      Btype.link_type ty (Btype.newty2 ty.level td);
+      {decl with type_manifest = Some ty'}
+    else decl
+  | _ -> decl
+
+let name_recursion_decls sdecls decls =
+  List.map2 (fun sdecl (id, decl) -> (id, name_recursion sdecl id decl))
+    sdecls decls
+
+(* Warn on definitions of type "type foo = ()" which redefine a different unit
+   type and are likely a mistake. *)
+let check_redefined_unit (td: Parsetree.type_declaration) =
+  let open Parsetree in
+  let is_unit_constructor cd = cd.pcd_name.txt = "()" in
+  match td with
+  | { ptype_name = { txt = name };
+      ptype_manifest = None;
+      ptype_kind = Ptype_variant [ cd ] }
+    when is_unit_constructor cd ->
+      Location.prerr_warning td.ptype_loc (Warnings.Redefining_unit name)
+  | _ ->
+      ()
+
+let add_types_to_env decls env =
+  List.fold_right
+    (fun (id, decl) env -> add_type ~check:true id decl env)
+    decls env
+
+(* Translate a set of type declarations, mutually recursive or not *)
+let transl_type_decl env rec_flag sdecl_list =
+  List.iter check_redefined_unit sdecl_list;
+  (* Add dummy types for fixed rows *)
+  let fixed_types = List.filter is_fixed_type sdecl_list in
+  let sdecl_list =
+    List.map
+      (fun sdecl ->
+         let ptype_name =
+           let loc = { sdecl.ptype_name.loc with Location.loc_ghost = true } in
+           mkloc (sdecl.ptype_name.txt ^"#row") loc
+         in
+         let ptype_kind = Ptype_abstract in
+         let ptype_manifest = None in
+         let ptype_loc = { sdecl.ptype_loc with Location.loc_ghost = true } in
+        {sdecl with
+           ptype_name; ptype_kind; ptype_manifest; ptype_loc })
+      fixed_types
+    @ sdecl_list
+  in
+
+  (* Create identifiers. *)
+  let scope = Ctype.create_scope () in
+  let ids_list =
+    List.map (fun sdecl ->
+      Ident.create_scoped ~scope sdecl.ptype_name.txt,
+      Uid.mk ~current_unit:(Env.get_unit_name ())
+    ) sdecl_list
+  in
+  Ctype.begin_def();
+  (* Enter types. *)
+  let temp_env =
+    List.fold_left2 (enter_type rec_flag) env sdecl_list ids_list in
+  (* Translate each declaration. *)
+  let current_slot = ref None in
+  let warn_unused = Warnings.is_active (Warnings.Unused_type_declaration "") in
+  let ids_slots (id, _uid as ids) =
+    match rec_flag with
+    | Asttypes.Recursive when warn_unused ->
+        (* See typecore.ml for a description of the algorithm used
+             to detect unused declarations in a set of recursive definitions. *)
+        let slot = ref [] in
+        let td = Env.find_type (Path.Pident id) temp_env in
+        Env.set_type_used_callback
+          td
+          (fun old_callback ->
+             match !current_slot with
+             | Some slot -> slot := td.type_uid :: !slot
+             | None ->
+                 List.iter Env.mark_type_used (get_ref slot);
+                 old_callback ()
+          );
+        ids, Some slot
+    | Asttypes.Recursive | Asttypes.Nonrecursive ->
+        ids, None
+  in
+  let transl_declaration name_sdecl (id, slot) =
+    current_slot := slot;
+    Builtin_attributes.warning_scope
+      name_sdecl.ptype_attributes
+      (fun () -> transl_declaration temp_env name_sdecl id)
+  in
+  let tdecls =
+    List.map2 transl_declaration sdecl_list (List.map ids_slots ids_list) in
+  let decls =
+    List.map (fun tdecl -> (tdecl.typ_id, tdecl.typ_type)) tdecls in
+  current_slot := None;
+  (* Check for duplicates *)
+  check_duplicates sdecl_list;
+  (* Build the final env. *)
+  let new_env = add_types_to_env decls env in
+  (* Update stubs *)
+  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;
+  (* Generalize type declarations. *)
+  Ctype.end_def();
+  List.iter (fun (_, decl) -> generalize_decl decl) decls;
+  (* Check for ill-formed abbrevs *)
+  let id_loc_list =
+    List.map2 (fun (id, _) sdecl -> (id, sdecl.ptype_loc))
+      ids_list sdecl_list
+  in
+  List.iter (fun (id, decl) ->
+    check_well_founded_manifest new_env (List.assoc id id_loc_list)
+      (Path.Pident id) decl)
+    decls;
+  let to_check =
+    function Path.Pident id -> List.mem_assoc id id_loc_list | _ -> false in
+  List.iter (fun (id, decl) ->
+    check_well_founded_decl new_env (List.assoc id id_loc_list) (Path.Pident id)
+      decl to_check)
+    decls;
+  List.iter (check_abbrev_recursion new_env id_loc_list to_check) tdecls;
+  (* Check that all type variables are closed *)
+  List.iter2
+    (fun sdecl tdecl ->
+      let decl = tdecl.typ_type in
+       match Ctype.closed_type_decl decl with
+         Some ty -> raise(Error(sdecl.ptype_loc, Unbound_type_var(ty,decl)))
+       | None   -> ())
+    sdecl_list tdecls;
+  (* Check that constraints are enforced *)
+  List.iter2 (check_constraints new_env) sdecl_list decls;
+  (* Add type properties to declarations *)
+  let decls =
+    try
+      decls
+      |> name_recursion_decls sdecl_list
+      |> Typedecl_variance.update_decls env sdecl_list
+      |> Typedecl_immediacy.update_decls env
+      |> Typedecl_separability.update_decls env
+    with
+    | Typedecl_variance.Error (loc, err) ->
+        raise (Error (loc, Variance err))
+    | Typedecl_immediacy.Error (loc, err) ->
+        raise (Error (loc, Immediacy err))
+    | Typedecl_separability.Error (loc, err) ->
+        raise (Error (loc, Separability err))
+  in
+  (* Compute the final environment with variance and immediacy *)
+  let final_env = add_types_to_env decls env in
+  (* Check re-exportation *)
+  List.iter2 (check_abbrev final_env) sdecl_list decls;
+  (* Keep original declaration *)
+  let final_decls =
+    List.map2
+      (fun tdecl (_id2, decl) ->
+        { tdecl with typ_type = decl }
+      ) tdecls decls
+  in
+  (* Done *)
+  (final_decls, final_env)
+
+(* Translating type extensions *)
+
+let transl_extension_constructor env type_path type_params
+                                 typext_params priv sext =
+  let scope = Ctype.create_scope () in
+  let id = Ident.create_scoped ~scope sext.pext_name.txt in
+  let args, ret_type, kind =
+    match sext.pext_kind with
+      Pext_decl(sargs, sret_type) ->
+        let targs, tret_type, args, ret_type =
+          make_constructor env type_path typext_params
+            sargs sret_type
+        in
+          args, ret_type, Text_decl(targs, tret_type)
+    | Pext_rebind lid ->
+        let usage = if priv = Public then Env.Positive else Env.Privatize in
+        let cdescr = Env.lookup_constructor ~loc:lid.loc usage lid.txt env in
+        let (args, cstr_res) = Ctype.instance_constructor cdescr in
+        let res, ret_type =
+          if cdescr.cstr_generalized then
+            let params = Ctype.instance_list type_params in
+            let res = Ctype.newconstr type_path params in
+            let ret_type = Some (Ctype.newconstr type_path params) in
+              res, ret_type
+          else (Ctype.newconstr type_path typext_params), None
+        in
+        begin
+          try
+            Ctype.unify env cstr_res res
+          with Ctype.Unify trace ->
+            raise (Error(lid.loc,
+                     Rebind_wrong_type(lid.txt, env, trace)))
+        end;
+        (* Remove "_" names from parameters used in the constructor *)
+        if not cdescr.cstr_generalized then begin
+          let vars =
+            Ctype.free_variables (Btype.newgenty (Ttuple args))
+          in
+            List.iter
+              (function {desc = Tvar (Some "_")} as ty ->
+                          if List.memq ty vars then ty.desc <- Tvar None
+                        | _ -> ())
+              typext_params
+        end;
+        (* Ensure that constructor's type matches the type being extended *)
+        let cstr_type_path, cstr_type_params =
+          match cdescr.cstr_res.desc with
+            Tconstr (p, _, _) ->
+              let decl = Env.find_type p env in
+                p, decl.type_params
+          | _ -> assert false
+        in
+        let cstr_types =
+          (Btype.newgenty
+             (Tconstr(cstr_type_path, cstr_type_params, ref Mnil)))
+          :: cstr_type_params
+        in
+        let ext_types =
+          (Btype.newgenty
+             (Tconstr(type_path, type_params, ref Mnil)))
+          :: type_params
+        in
+        if not (Ctype.equal env true cstr_types ext_types) then
+          raise (Error(lid.loc,
+                       Rebind_mismatch(lid.txt, cstr_type_path, type_path)));
+        (* Disallow rebinding private constructors to non-private *)
+        begin
+          match cdescr.cstr_private, priv with
+            Private, Public ->
+              raise (Error(lid.loc, Rebind_private lid.txt))
+          | _ -> ()
+        end;
+        let path =
+          match cdescr.cstr_tag with
+            Cstr_extension(path, _) -> path
+          | _ -> assert false
+        in
+        let args =
+          match cdescr.cstr_inlined with
+          | None ->
+              Types.Cstr_tuple args
+          | Some decl ->
+              let tl =
+                match args with
+                | [ {desc=Tconstr(_, tl, _)} ] -> tl
+                | _ -> assert false
+              in
+              let decl = Ctype.instance_declaration decl in
+              assert (List.length decl.type_params = List.length tl);
+              List.iter2 (Ctype.unify env) decl.type_params tl;
+              let lbls =
+                match decl.type_kind with
+                | Type_record (lbls, Record_extension _) -> lbls
+                | _ -> assert false
+              in
+              Types.Cstr_record lbls
+        in
+        args, ret_type, Text_rebind(path, lid)
+  in
+  let ext =
+    { ext_type_path = type_path;
+      ext_type_params = typext_params;
+      ext_args = args;
+      ext_ret_type = ret_type;
+      ext_private = priv;
+      Types.ext_loc = sext.pext_loc;
+      Types.ext_attributes = sext.pext_attributes;
+      ext_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+    }
+  in
+    { ext_id = id;
+      ext_name = sext.pext_name;
+      ext_type = ext;
+      ext_kind = kind;
+      Typedtree.ext_loc = sext.pext_loc;
+      Typedtree.ext_attributes = sext.pext_attributes; }
+
+let transl_extension_constructor env type_path type_params
+    typext_params priv sext =
+  Builtin_attributes.warning_scope sext.pext_attributes
+    (fun () -> transl_extension_constructor env type_path type_params
+        typext_params priv sext)
+
+let is_rebind ext =
+  match ext.ext_kind with
+  | Text_rebind _ -> true
+  | Text_decl _ -> false
+
+let transl_type_extension extend env loc styext =
+  reset_type_variables();
+  Ctype.begin_def();
+  let type_path, type_decl =
+    let lid = styext.ptyext_path in
+    Env.lookup_type ~loc:lid.loc lid.txt env
+  in
+  begin
+    match type_decl.type_kind with
+    | Type_open -> begin
+        match type_decl.type_private with
+        | Private when extend -> begin
+            match
+              List.find
+                (function {pext_kind = Pext_decl _} -> true
+                        | {pext_kind = Pext_rebind _} -> false)
+                styext.ptyext_constructors
+            with
+            | {pext_loc} ->
+                raise (Error(pext_loc, Cannot_extend_private_type type_path))
+            | exception Not_found -> ()
+          end
+        | _ -> ()
+      end
+    | _ ->
+        raise (Error(loc, Not_extensible_type type_path))
+  end;
+  let type_variance =
+    List.map (fun v ->
+                let (co, cn) = Variance.get_upper v in
+                  (not cn, not co, false))
+             type_decl.type_variance
+  in
+  let err =
+    if type_decl.type_arity <> List.length styext.ptyext_params then
+      Some Includecore.Arity
+    else
+      if List.for_all2
+           (fun (c1, n1, _) (c2, n2, _) -> (not c2 || c1) && (not n2 || n1))
+           type_variance
+           (Typedecl_variance.variance_of_params styext.ptyext_params)
+      then None else Some Includecore.Variance
+  in
+  begin match err with
+  | None -> ()
+  | Some err -> raise (Error(loc, Extension_mismatch (type_path, err)))
+  end;
+  let ttype_params = make_params env styext.ptyext_params in
+  let type_params = List.map (fun (cty, _) -> cty.ctyp_type) ttype_params in
+  List.iter2 (Ctype.unify_var env)
+    (Ctype.instance_list type_decl.type_params)
+    type_params;
+  let constructors =
+    List.map (transl_extension_constructor env type_path
+               type_decl.type_params type_params styext.ptyext_private)
+      styext.ptyext_constructors
+  in
+  Ctype.end_def();
+  (* Generalize types *)
+  List.iter Ctype.generalize type_params;
+  List.iter
+    (fun ext ->
+       Btype.iter_type_expr_cstr_args Ctype.generalize ext.ext_type.ext_args;
+       Option.iter Ctype.generalize ext.ext_type.ext_ret_type)
+    constructors;
+  (* Check that all type variables are closed *)
+  List.iter
+    (fun ext ->
+       match Ctype.closed_extension_constructor ext.ext_type with
+         Some ty ->
+           raise(Error(ext.ext_loc, Unbound_type_var_ext(ty, ext.ext_type)))
+       | None -> ())
+    constructors;
+  (* Check variances are correct *)
+  List.iter
+    (fun ext->
+       (* Note that [loc] here is distinct from [type_decl.type_loc], which
+          makes the [loc] parameter to this function useful. [loc] is the
+          location of the extension, while [type_decl] points to the original
+          type declaration being extended. *)
+       try Typedecl_variance.check_variance_extension
+             env type_decl ext (type_variance, loc)
+       with Typedecl_variance.Error (loc, err) ->
+         raise (Error (loc, Variance err)))
+    constructors;
+  (* Add extension constructors to the environment *)
+  let newenv =
+    List.fold_left
+      (fun env ext ->
+         let rebind = is_rebind ext in
+         Env.add_extension ~check:true ~rebind ext.ext_id ext.ext_type env)
+      env constructors
+  in
+  let tyext =
+    { tyext_path = type_path;
+      tyext_txt = styext.ptyext_path;
+      tyext_params = ttype_params;
+      tyext_constructors = constructors;
+      tyext_private = styext.ptyext_private;
+      tyext_loc = styext.ptyext_loc;
+      tyext_attributes = styext.ptyext_attributes; }
+  in
+    (tyext, newenv)
+
+let transl_type_extension extend env loc styext =
+  Builtin_attributes.warning_scope styext.ptyext_attributes
+    (fun () -> transl_type_extension extend env loc styext)
+
+let transl_exception env sext =
+  reset_type_variables();
+  Ctype.begin_def();
+  let ext =
+    transl_extension_constructor env
+      Predef.path_exn [] [] Asttypes.Public sext
+  in
+  Ctype.end_def();
+  (* Generalize types *)
+  Btype.iter_type_expr_cstr_args Ctype.generalize ext.ext_type.ext_args;
+  Option.iter Ctype.generalize ext.ext_type.ext_ret_type;
+  (* Check that all type variables are closed *)
+  begin match Ctype.closed_extension_constructor ext.ext_type with
+    Some ty ->
+      raise (Error(ext.ext_loc, Unbound_type_var_ext(ty, ext.ext_type)))
+  | None -> ()
+  end;
+  let rebind = is_rebind ext in
+  let newenv =
+    Env.add_extension ~check:true ~rebind ext.ext_id ext.ext_type env
+  in
+  ext, newenv
+
+let transl_type_exception env t =
+  Builtin_attributes.check_no_alert t.ptyexn_attributes;
+  let contructor, newenv =
+    Builtin_attributes.warning_scope t.ptyexn_attributes
+      (fun () ->
+         transl_exception env t.ptyexn_constructor
+      )
+  in
+  {tyexn_constructor = contructor;
+   tyexn_loc = t.ptyexn_loc;
+   tyexn_attributes = t.ptyexn_attributes}, newenv
+
+
+type native_repr_attribute =
+  | Native_repr_attr_absent
+  | Native_repr_attr_present of native_repr_kind
+
+let get_native_repr_attribute attrs ~global_repr =
+  match
+    Attr_helper.get_no_payload_attribute ["unboxed"; "ocaml.unboxed"]  attrs,
+    Attr_helper.get_no_payload_attribute ["untagged"; "ocaml.untagged"] attrs,
+    global_repr
+  with
+  | None, None, None -> Native_repr_attr_absent
+  | None, None, Some repr -> Native_repr_attr_present repr
+  | Some _, None, None -> Native_repr_attr_present Unboxed
+  | None, Some _, None -> Native_repr_attr_present Untagged
+  | Some { Location.loc }, _, _
+  | _, Some { Location.loc }, _ ->
+    raise (Error (loc, Multiple_native_repr_attributes))
+
+let native_repr_of_type env kind ty =
+  match kind, (Ctype.expand_head_opt env ty).desc with
+  | Untagged, Tconstr (path, _, _) when Path.same path Predef.path_int ->
+    Some Untagged_int
+  | Unboxed, Tconstr (path, _, _) when Path.same path Predef.path_float ->
+    Some Unboxed_float
+  | Unboxed, Tconstr (path, _, _) when Path.same path Predef.path_int32 ->
+    Some (Unboxed_integer Pint32)
+  | Unboxed, Tconstr (path, _, _) when Path.same path Predef.path_int64 ->
+    Some (Unboxed_integer Pint64)
+  | Unboxed, Tconstr (path, _, _) when Path.same path Predef.path_nativeint ->
+    Some (Unboxed_integer Pnativeint)
+  | _ ->
+    None
+
+(* Raises an error when [core_type] contains an [@unboxed] or [@untagged]
+   attribute in a strict sub-term. *)
+let error_if_has_deep_native_repr_attributes core_type =
+  let open Ast_iterator in
+  let this_iterator =
+    { default_iterator with typ = fun iterator core_type ->
+      begin
+        match
+          get_native_repr_attribute core_type.ptyp_attributes ~global_repr:None
+        with
+        | Native_repr_attr_present kind ->
+           raise (Error (core_type.ptyp_loc,
+                         Deep_unbox_or_untag_attribute kind))
+        | Native_repr_attr_absent -> ()
+      end;
+      default_iterator.typ iterator core_type }
+  in
+  default_iterator.typ this_iterator core_type
+
+let make_native_repr env core_type ty ~global_repr =
+  error_if_has_deep_native_repr_attributes core_type;
+  match get_native_repr_attribute core_type.ptyp_attributes ~global_repr with
+  | Native_repr_attr_absent ->
+    Same_as_ocaml_repr
+  | Native_repr_attr_present kind ->
+    begin match native_repr_of_type env kind ty with
+    | None ->
+      raise (Error (core_type.ptyp_loc, Cannot_unbox_or_untag_type kind))
+    | Some repr -> repr
+    end
+
+let rec parse_native_repr_attributes env core_type ty ~global_repr =
+  match core_type.ptyp_desc, (Ctype.repr ty).desc,
+    get_native_repr_attribute core_type.ptyp_attributes ~global_repr:None
+  with
+  | Ptyp_arrow _, Tarrow _, Native_repr_attr_present kind  ->
+    raise (Error (core_type.ptyp_loc, Cannot_unbox_or_untag_type kind))
+  | Ptyp_arrow (_, ct1, ct2), Tarrow (_, t1, t2, _), _ ->
+    let repr_arg = make_native_repr env ct1 t1 ~global_repr in
+    let repr_args, repr_res =
+      parse_native_repr_attributes env ct2 t2 ~global_repr
+    in
+    (repr_arg :: repr_args, repr_res)
+  | Ptyp_arrow _, _, _ | _, Tarrow _, _ -> assert false
+  | _ -> ([], make_native_repr env core_type ty ~global_repr)
+
+
+let check_unboxable env loc ty =
+  let check_type acc ty : Path.Set.t =
+    let ty = Ctype.repr (Ctype.expand_head_opt env ty) in
+    try match ty.desc with
+      | Tconstr (p, _, _) ->
+        let tydecl = Env.find_type p env in
+        if tydecl.type_unboxed.default then
+          Path.Set.add p acc
+        else acc
+      | _ -> acc
+    with Not_found -> acc
+  in
+  let all_unboxable_types = Btype.fold_type_expr check_type Path.Set.empty ty in
+  Path.Set.fold
+    (fun p () ->
+       Location.prerr_warning loc
+         (Warnings.Unboxable_type_in_prim_decl (Path.name p))
+    )
+    all_unboxable_types
+    ()
+
+(* Translate a value declaration *)
+let transl_value_decl env loc valdecl =
+  let cty = Typetexp.transl_type_scheme env valdecl.pval_type in
+  let ty = cty.ctyp_type in
+  let v =
+  match valdecl.pval_prim with
+    [] 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 ());
+      }
+  | [] ->
+      raise (Error(valdecl.pval_loc, Val_in_structure))
+  | _ ->
+      let global_repr =
+        match
+          get_native_repr_attribute valdecl.pval_attributes ~global_repr:None
+        with
+        | Native_repr_attr_present repr -> Some repr
+        | Native_repr_attr_absent -> None
+      in
+      let native_repr_args, native_repr_res =
+        parse_native_repr_attributes env valdecl.pval_type ty ~global_repr
+      in
+      let prim =
+        Primitive.parse_declaration valdecl
+          ~native_repr_args
+          ~native_repr_res
+      in
+      if prim.prim_arity = 0 &&
+         (prim.prim_name = "" || prim.prim_name.[0] <> '%') then
+        raise(Error(valdecl.pval_type.ptyp_loc, Null_arity_external));
+      if !Clflags.native_code
+      && prim.prim_arity > 5
+      && prim.prim_native_name = ""
+      then raise(Error(valdecl.pval_type.ptyp_loc, Missing_native_external));
+      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 ());
+      }
+  in
+  let (id, newenv) =
+    Env.enter_value valdecl.pval_name.txt v env
+      ~check:(fun s -> Warnings.Unused_value_declaration s)
+  in
+  let desc =
+    {
+     val_id = id;
+     val_name = valdecl.pval_name;
+     val_desc = cty; val_val = v;
+     val_prim = valdecl.pval_prim;
+     val_loc = valdecl.pval_loc;
+     val_attributes = valdecl.pval_attributes;
+    }
+  in
+  desc, newenv
+
+let transl_value_decl env loc valdecl =
+  Builtin_attributes.warning_scope valdecl.pval_attributes
+    (fun () -> transl_value_decl env loc valdecl)
+
+(* Translate a "with" constraint -- much simplified version of
+   transl_type_decl. For a constraint [Sig with t = sdecl],
+   there are two declarations of interest in two environments:
+   - [sig_decl] is the declaration of [t] in [Sig],
+     in the environment [sig_env] (containing the declarations
+     of [Sig] before [t])
+   - [sdecl] is the new syntactic declaration, to be type-checked
+     in the current, outer environment [with_env].
+
+   In particular, note that [sig_env] is an extension of
+   [outer_env].
+*)
+let transl_with_constraint id row_path ~sig_env ~sig_decl ~outer_env sdecl =
+  Env.mark_type_used sig_decl.type_uid;
+  reset_type_variables();
+  Ctype.begin_def();
+  (* In the first part of this function, we typecheck the syntactic
+     declaration [sdecl] in the outer environment [outer_env]. *)
+  let env = outer_env in
+  let loc = sdecl.ptype_loc in
+  let tparams = make_params env sdecl.ptype_params in
+  let params = List.map (fun (cty, _) -> cty.ctyp_type) tparams in
+  let arity = List.length params in
+  let constraints =
+    List.map (fun (ty, ty', loc) ->
+      let cty = transl_simple_type env false ty in
+      let cty' = transl_simple_type env false ty' in
+      (* Note: We delay the unification of those constraints
+         after the unification of parameters, so that clashing
+         constraints report an error on the constraint location
+         rather than the parameter location. *)
+      (cty, cty', loc)
+    ) sdecl.ptype_cstrs
+  in
+  let no_row = not (is_fixed_type sdecl) in
+  let (tman, man) =  match sdecl.ptype_manifest with
+      None -> None, None
+    | Some sty ->
+        let cty = transl_simple_type env no_row sty in
+        Some cty, Some cty.ctyp_type
+  in
+  (* In the second part, we check the consistency between the two
+     declarations and compute a "merged" declaration; we now need to
+     work in the larger signature environment [sig_env], because
+     [sig_decl.type_params] and [sig_decl.type_kind] are only valid
+     there. *)
+  let env = sig_env in
+  let sig_decl = Ctype.instance_declaration sig_decl in
+  let arity_ok = arity = sig_decl.type_arity in
+  if arity_ok then
+    List.iter2 (fun (cty, _) tparam ->
+      try Ctype.unify_var env cty.ctyp_type tparam
+      with Ctype.Unify tr ->
+        raise(Error(cty.ctyp_loc, Inconsistent_constraint (env, tr)))
+    ) tparams sig_decl.type_params;
+  List.iter (fun (cty, cty', loc) ->
+    (* Note: contraints must also be enforced in [sig_env] because
+       they may contain parameter variables from [tparams]
+       that have now be unified in [sig_env]. *)
+    try Ctype.unify env cty.ctyp_type cty'.ctyp_type
+    with Ctype.Unify tr ->
+      raise(Error(loc, Inconsistent_constraint (env, tr)))
+  ) constraints;
+  let priv =
+    if sdecl.ptype_private = Private then Private else
+    if arity_ok && sig_decl.type_kind <> Type_abstract
+    then sig_decl.type_private else sdecl.ptype_private
+  in
+  if arity_ok && sig_decl.type_kind <> Type_abstract
+  && sdecl.ptype_private = Private then
+    Location.deprecated loc "spurious use of private";
+  let type_kind, type_unboxed =
+    if arity_ok && man <> None then
+      sig_decl.type_kind, sig_decl.type_unboxed
+    else
+      Type_abstract, unboxed_false_default_false
+  in
+  let new_sig_decl =
+    { type_params = params;
+      type_arity = arity;
+      type_kind;
+      type_private = priv;
+      type_manifest = man;
+      type_variance = [];
+      type_separability = Types.Separability.default_signature ~arity;
+      type_is_newtype = false;
+      type_expansion_scope = Btype.lowest_level;
+      type_loc = loc;
+      type_attributes = sdecl.ptype_attributes;
+      type_immediate = Unknown;
+      type_unboxed;
+      type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+    }
+  in
+  begin match row_path with None -> ()
+  | Some p -> set_fixed_row env loc p new_sig_decl
+  end;
+  begin match Ctype.closed_type_decl new_sig_decl with None -> ()
+  | Some ty -> raise(Error(loc, Unbound_type_var(ty, new_sig_decl)))
+  end;
+  let new_sig_decl = name_recursion sdecl id new_sig_decl in
+  let new_type_variance =
+    let required = Typedecl_variance.variance_of_sdecl sdecl in
+    try
+      Typedecl_variance.compute_decl env ~check:true new_sig_decl required
+    with Typedecl_variance.Error (loc, err) ->
+      raise (Error (loc, Variance err)) in
+  let new_type_immediate =
+    (* Typedecl_immediacy.compute_decl never raises *)
+    Typedecl_immediacy.compute_decl env new_sig_decl in
+  let new_type_separability =
+    try Typedecl_separability.compute_decl env new_sig_decl
+    with Typedecl_separability.Error (loc, err) ->
+      raise (Error (loc, Separability err)) in
+  let new_sig_decl =
+    (* we intentionally write this without a fragile { decl with ... }
+       to ensure that people adding new fields to type declarations
+       consider whether they need to recompute it here; for an example
+       of bug caused by the previous approach, see #9607 *)
+    {
+      type_params = new_sig_decl.type_params;
+      type_arity = new_sig_decl.type_arity;
+      type_kind = new_sig_decl.type_kind;
+      type_private = new_sig_decl.type_private;
+      type_manifest = new_sig_decl.type_manifest;
+      type_unboxed = new_sig_decl.type_unboxed;
+      type_is_newtype = new_sig_decl.type_is_newtype;
+      type_expansion_scope = new_sig_decl.type_expansion_scope;
+      type_loc = new_sig_decl.type_loc;
+      type_attributes = new_sig_decl.type_attributes;
+      type_uid = new_sig_decl.type_uid;
+
+      type_variance = new_type_variance;
+      type_immediate = new_type_immediate;
+      type_separability = new_type_separability;
+    } in
+  Ctype.end_def();
+  generalize_decl new_sig_decl;
+  {
+    typ_id = id;
+    typ_name = sdecl.ptype_name;
+    typ_params = tparams;
+    typ_type = new_sig_decl;
+    typ_cstrs = constraints;
+    typ_loc = loc;
+    typ_manifest = tman;
+    typ_kind = Ttype_abstract;
+    typ_private = sdecl.ptype_private;
+    typ_attributes = sdecl.ptype_attributes;
+  }
+
+(* Approximate a type declaration: just make all types abstract *)
+
+let abstract_type_decl arity =
+  let rec make_params n =
+    if n <= 0 then [] else Ctype.newvar() :: make_params (n-1) in
+  Ctype.begin_def();
+  let decl =
+    { type_params = make_params arity;
+      type_arity = arity;
+      type_kind = Type_abstract;
+      type_private = Public;
+      type_manifest = None;
+      type_variance = replicate_list Variance.full arity;
+      type_separability = Types.Separability.default_signature ~arity;
+      type_is_newtype = false;
+      type_expansion_scope = Btype.lowest_level;
+      type_loc = Location.none;
+      type_attributes = [];
+      type_immediate = Unknown;
+      type_unboxed = unboxed_false_default_false;
+      type_uid = Uid.internal_not_actually_unique;
+     } in
+  Ctype.end_def();
+  generalize_decl decl;
+  decl
+
+let approx_type_decl sdecl_list =
+  let scope = Ctype.create_scope () in
+  List.map
+    (fun sdecl ->
+      (Ident.create_scoped ~scope sdecl.ptype_name.txt,
+       abstract_type_decl (List.length sdecl.ptype_params)))
+    sdecl_list
+
+(* Variant of check_abbrev_recursion to check the well-formedness
+   conditions on type abbreviations defined within recursive modules. *)
+
+let check_recmod_typedecl env loc recmod_ids path decl =
+  (* recmod_ids is the list of recursively-defined module idents.
+     (path, decl) is the type declaration to be checked. *)
+  let to_check path = Path.exists_free recmod_ids path in
+  check_well_founded_decl env loc path decl to_check;
+  check_recursion env loc path decl to_check;
+  (* additionally check coherece, as one might build an incoherent signature,
+     and use it to build an incoherent module, cf. #7851 *)
+  check_coherence env loc path decl
+
+
+(**** Error report ****)
+
+open Format
+
+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.reset_and_mark_loops_list [typ ti; ty0];
+    fprintf ppf
+      ".@.@[In %s@ %a@;<1 -2>the variable %a is unbound@]"
+      kwd pr ti Printtyp.marked_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.marked_type_expr (typ ti)
+    )
+
+let explain_unbound_single ppf tv ty =
+  let trivial ty =
+    explain_unbound ppf tv [ty] (fun t -> t) "type" (fun _ -> "") in
+  match (Ctype.repr ty).desc with
+    Tobject(fi,_) ->
+      let (tl, rv) = Ctype.flatten_fields fi in
+      if rv == tv then trivial ty else
+      explain_unbound ppf tv tl (fun (_,_,t) -> t)
+        "method" (fun (lab,_,_) -> lab ^ ": ")
+  | Tvariant row ->
+      let row = Btype.row_repr row in
+      if row.row_more == tv then trivial ty else
+      explain_unbound ppf tv row.row_fields
+        (fun (_l,f) -> match Btype.row_field_repr f with
+          Rpresent (Some t) -> t
+        | Reither (_,[t],_,_) -> t
+        | Reither (_,tl,_,_) -> Btype.newgenty (Ttuple tl)
+        | _ -> Btype.newgenty (Ttuple[]))
+        "case" (fun (lab,_) -> "`" ^ lab ^ " of ")
+  | _ -> trivial ty
+
+
+let tys_of_constr_args = function
+  | Types.Cstr_tuple tl -> tl
+  | Types.Cstr_record lbls -> List.map (fun l -> l.Types.ld_type) lbls
+
+let report_error ppf = function
+  | Repeated_parameter ->
+      fprintf ppf "A type parameter occurs several times"
+  | Duplicate_constructor s ->
+      fprintf ppf "Two constructors are named %s" s
+  | Too_many_constructors ->
+      fprintf ppf
+        "@[Too many non-constant constructors@ -- maximum is %i %s@]"
+        (Config.max_tag + 1) "non-constant constructors"
+  | Duplicate_label s ->
+      fprintf ppf "Two labels are named %s" s
+  | Recursive_abbrev s ->
+      fprintf ppf "The type abbreviation %s is cyclic" s
+  | Cycle_in_def (s, ty) ->
+      fprintf ppf "@[The definition of %s contains a cycle:@ %a@]"
+        s Printtyp.type_expr ty
+  | Definition_mismatch (ty, None) ->
+      fprintf ppf "@[@[%s@ %s@;<1 2>%a@]@]"
+        "This variant or record definition" "does not match that of type"
+        Printtyp.type_expr ty
+  | Definition_mismatch (ty, Some err) ->
+      fprintf ppf "@[@[%s@ %s@;<1 2>%a@]%a@]"
+        "This variant or record definition" "does not match that of type"
+        Printtyp.type_expr ty
+        (Includecore.report_type_mismatch "the original" "this" "definition")
+        err
+  | Constraint_failed (ty, ty') ->
+      Printtyp.reset_and_mark_loops ty;
+      Printtyp.mark_loops ty';
+      Printtyp.Naming_context.reset ();
+      fprintf ppf "@[%s@ @[Type@ %a@ should be an instance of@ %a@]@]"
+        "Constraints are not satisfied in this type."
+        !Oprint.out_type (Printtyp.tree_of_typexp false ty)
+        !Oprint.out_type (Printtyp.tree_of_typexp false ty')
+  | Non_regular { definition; used_as; defined_as; expansions } ->
+      let pp_expansion ppf (ty,body) =
+        Format.fprintf ppf "%a = %a"
+          Printtyp.type_expr ty
+          Printtyp.type_expr body in
+      let comma ppf () = Format.fprintf ppf ",@;<1 2>" in
+      let pp_expansions ppf expansions =
+        Format.(pp_print_list ~pp_sep:comma pp_expansion) ppf expansions in
+      Printtyp.reset_and_mark_loops used_as;
+      Printtyp.mark_loops defined_as;
+      Printtyp.Naming_context.reset ();
+      begin match expansions with
+      | [] ->
+          fprintf ppf
+            "@[This recursive type is not regular.@ \
+             The type constructor %s is defined as@;<1 2>type %a@ \
+             but it is used as@;<1 2>%a.@ \
+             All uses need to match the definition for the recursive type \
+             to be regular.@]"
+            (Path.name definition)
+            !Oprint.out_type (Printtyp.tree_of_typexp false defined_as)
+            !Oprint.out_type (Printtyp.tree_of_typexp false used_as)
+      | _ :: _ ->
+          fprintf ppf
+            "@[This recursive type is not regular.@ \
+             The type constructor %s is defined as@;<1 2>type %a@ \
+             but it is used as@;<1 2>%a@ \
+             after the following expansion(s):@;<1 2>%a@ \
+             All uses need to match the definition for the recursive type \
+             to be regular.@]"
+            (Path.name definition)
+            !Oprint.out_type (Printtyp.tree_of_typexp false defined_as)
+            !Oprint.out_type (Printtyp.tree_of_typexp false used_as)
+            pp_expansions expansions
+      end
+  | Inconsistent_constraint (env, trace) ->
+      fprintf ppf "The type constraints are not consistent.@.";
+      Printtyp.report_unification_error ppf env trace
+        (fun ppf -> fprintf ppf "Type")
+        (fun ppf -> fprintf ppf "is not compatible with type")
+  | Type_clash (env, trace) ->
+      Printtyp.report_unification_error ppf env trace
+        (function ppf ->
+           fprintf ppf "This type constructor expands to type")
+        (function ppf ->
+           fprintf ppf "but is used here with type")
+  | Null_arity_external ->
+      fprintf ppf "External identifiers must be functions"
+  | Missing_native_external ->
+      fprintf ppf "@[An external function with more than 5 arguments \
+                   requires a second stub function@ \
+                   for native-code compilation@]"
+  | Unbound_type_var (ty, decl) ->
+      fprintf ppf "A type variable is unbound in this type declaration";
+      let ty = Ctype.repr ty in
+      begin match decl.type_kind, decl.type_manifest with
+      | Type_variant tl, _ ->
+          explain_unbound_gen ppf ty tl (fun c ->
+              let tl = tys_of_constr_args c.Types.cd_args in
+              Btype.newgenty (Ttuple tl)
+            )
+            "case" (fun ppf c ->
+                fprintf ppf
+                  "%a of %a" Printtyp.ident c.Types.cd_id
+                  Printtyp.constructor_arguments c.Types.cd_args)
+      | Type_record (tl, _), _ ->
+          explain_unbound ppf ty tl (fun l -> l.Types.ld_type)
+            "field" (fun l -> Ident.name l.Types.ld_id ^ ": ")
+      | Type_abstract, Some ty' ->
+          explain_unbound_single ppf ty ty'
+      | _ -> ()
+      end
+  | Unbound_type_var_ext (ty, ext) ->
+      fprintf ppf "A type variable is unbound in this extension constructor";
+      let args = tys_of_constr_args ext.ext_args in
+      explain_unbound ppf ty args (fun c -> c) "type" (fun _ -> "")
+  | Cannot_extend_private_type path ->
+      fprintf ppf "@[%s@ %a@]"
+        "Cannot extend private type definition"
+        Printtyp.path path
+  | Not_extensible_type path ->
+      fprintf ppf "@[%s@ %a@ %s@]"
+        "Type definition"
+        Printtyp.path path
+        "is not extensible"
+  | Extension_mismatch (path, err) ->
+      fprintf ppf "@[@[%s@ %s@;<1 2>%s@]%a@]"
+        "This extension" "does not match the definition of type"
+        (Path.name path)
+        (Includecore.report_type_mismatch
+           "the type" "this extension" "definition")
+        err
+  | Rebind_wrong_type (lid, env, trace) ->
+      Printtyp.report_unification_error ppf env trace
+        (function ppf ->
+           fprintf ppf "The constructor %a@ has type"
+             Printtyp.longident lid)
+        (function ppf ->
+           fprintf ppf "but was expected to be of type")
+  | Rebind_mismatch (lid, p, p') ->
+      fprintf ppf
+        "@[%s@ %a@ %s@ %s@ %s@ %s@ %s@]"
+        "The constructor" Printtyp.longident lid
+        "extends type" (Path.name p)
+        "whose declaration does not match"
+        "the declaration of type" (Path.name p')
+  | Rebind_private lid ->
+      fprintf ppf "@[%s@ %a@ %s@]"
+        "The constructor"
+        Printtyp.longident lid
+        "is private"
+  | Variance (Typedecl_variance.Bad_variance (n, v1, v2)) ->
+      let variance (p,n,i) =
+        let inj = if i then "injective " else "" in
+        match p, n with
+          true,  true  -> inj ^ "invariant"
+        | true,  false -> inj ^ "covariant"
+        | false, true  -> inj ^ "contravariant"
+        | false, false -> if inj = "" then "unrestricted" else inj
+      in
+      let suffix n =
+        let teen = (n mod 100)/10 = 1 in
+        match n mod 10 with
+        | 1 when not teen -> "st"
+        | 2 when not teen -> "nd"
+        | 3 when not teen -> "rd"
+        | _ -> "th"
+      in
+      (match n with
+       | Variance_not_reflected ->
+           fprintf ppf "@[%s@ %s@ It"
+             "In this definition, a type variable has a variance that"
+             "is not reflected by its occurrence in type parameters."
+       | No_variable ->
+           fprintf ppf "@[%s@ %s@]"
+             "In this definition, a type variable cannot be deduced"
+             "from the type parameters."
+       | Variance_not_deducible ->
+           fprintf ppf "@[%s@ %s@ It"
+             "In this definition, a type variable has a variance that"
+             "cannot be deduced from the type parameters."
+       | Variance_not_satisfied n ->
+           fprintf ppf "@[%s@ %s@ The %d%s type parameter"
+             "In this definition, expected parameter"
+             "variances are not satisfied."
+             n (suffix n));
+      (match n with
+       | No_variable -> ()
+       | _ ->
+           fprintf ppf " was expected to be %s,@ but it is %s.@]"
+             (variance v2) (variance v1))
+  | Unavailable_type_constructor p ->
+      fprintf ppf "The definition of type %a@ is unavailable" Printtyp.path p
+  | Bad_fixed_type r ->
+      fprintf ppf "This fixed type %s" r
+  | Variance Typedecl_variance.Varying_anonymous ->
+      fprintf ppf "@[%s@ %s@ %s@]"
+        "In this GADT definition," "the variance of some parameter"
+        "cannot be checked"
+  | Val_in_structure ->
+      fprintf ppf "Value declarations are only allowed in signatures"
+  | Multiple_native_repr_attributes ->
+      fprintf ppf "Too many [@@unboxed]/[@@untagged] attributes"
+  | Cannot_unbox_or_untag_type Unboxed ->
+      fprintf ppf "@[Don't know how to unbox this type.@ \
+                   Only float, int32, int64 and nativeint can be unboxed.@]"
+  | Cannot_unbox_or_untag_type Untagged ->
+      fprintf ppf "@[Don't know how to untag this type.@ \
+                   Only int can be untagged.@]"
+  | Deep_unbox_or_untag_attribute kind ->
+      fprintf ppf
+        "@[The attribute '%s' should be attached to@ \
+         a direct argument or result of the primitive,@ \
+         it should not occur deeply into its type.@]"
+        (match kind with Unboxed -> "@unboxed" | Untagged -> "@untagged")
+  | Immediacy (Typedecl_immediacy.Bad_immediacy_attribute violation) ->
+      fprintf ppf "@[%a@]" Format.pp_print_text
+        (match violation with
+         | Type_immediacy.Violation.Not_always_immediate ->
+             "Types marked with the immediate attribute must be \
+              non-pointer types like int or bool."
+         | Type_immediacy.Violation.Not_always_immediate_on_64bits ->
+             "Types marked with the immediate64 attribute must be \
+              produced using the Stdlib.Sys.Immediate64.Make functor.")
+  | Bad_unboxed_attribute msg ->
+      fprintf ppf "@[This type cannot be unboxed because@ %s.@]" msg
+  | Separability (Typedecl_separability.Non_separable_evar evar) ->
+      let pp_evar ppf = function
+        | None ->
+            fprintf ppf "an unnamed existential variable"
+        | Some str ->
+            fprintf ppf "the existential variable %a"
+              Pprintast.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.@ \
+                   You should annotate it with [%@%@ocaml.boxed].@]"
+        pp_evar evar
+  | Boxed_and_unboxed ->
+      fprintf ppf "@[A type cannot be boxed and unboxed at the same time.@]"
+  | Nonrec_gadt ->
+      fprintf ppf
+        "@[GADT case syntax cannot be used in a 'nonrec' block.@]"
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (loc, err) ->
+        Some (Location.error_of_printer ~loc report_error err)
+      | _ ->
+        None
+    )
diff --git a/typing/typedecl.mli b/typing/typedecl.mli
new file mode 100644
index 00000000..88f5b2f1
--- /dev/null
+++ b/typing/typedecl.mli
@@ -0,0 +1,106 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* 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
+
+val transl_exception:
+    Env.t -> Parsetree.extension_constructor ->
+    Typedtree.extension_constructor * Env.t
+
+val transl_type_exception:
+    Env.t ->
+    Parsetree.type_exception -> Typedtree.type_exception * Env.t
+
+val transl_type_extension:
+    bool -> Env.t -> Location.t -> Parsetree.type_extension ->
+    Typedtree.type_extension * Env.t
+
+val transl_value_decl:
+    Env.t -> Location.t ->
+    Parsetree.value_description -> Typedtree.value_description * Env.t
+
+val transl_with_constraint:
+    Ident.t -> Path.t option ->
+    sig_env:Env.t -> sig_decl:Types.type_declaration ->
+    outer_env:Env.t -> Parsetree.type_declaration ->
+    Typedtree.type_declaration
+
+val abstract_type_decl: int -> type_declaration
+val approx_type_decl:
+    Parsetree.type_declaration list ->
+                                  (Ident.t * type_declaration) list
+val check_recmod_typedecl:
+    Env.t -> Location.t -> Ident.t list -> Path.t -> type_declaration -> unit
+val check_coherence:
+    Env.t -> Location.t -> Path.t -> type_declaration -> unit
+
+(* for fixed types *)
+val is_fixed_type : Parsetree.type_declaration -> bool
+
+(* for typeopt.ml *)
+val get_unboxed_type_representation: Env.t -> type_expr -> type_expr option
+
+type native_repr_kind = Unboxed | Untagged
+
+type error =
+    Repeated_parameter
+  | Duplicate_constructor of string
+  | Too_many_constructors
+  | Duplicate_label of string
+  | Recursive_abbrev of string
+  | Cycle_in_def of string * type_expr
+  | Definition_mismatch of type_expr * Includecore.type_mismatch option
+  | Constraint_failed of type_expr * type_expr
+  | Inconsistent_constraint of Env.t * Ctype.Unification_trace.t
+  | Type_clash of Env.t * Ctype.Unification_trace.t
+  | Non_regular of {
+      definition: Path.t;
+      used_as: type_expr;
+      defined_as: type_expr;
+      expansions: (type_expr * type_expr) list;
+    }
+  | Null_arity_external
+  | Missing_native_external
+  | Unbound_type_var of type_expr * type_declaration
+  | Cannot_extend_private_type of Path.t
+  | Not_extensible_type of Path.t
+  | Extension_mismatch of Path.t * Includecore.type_mismatch
+  | Rebind_wrong_type of Longident.t * Env.t * Ctype.Unification_trace.t
+  | Rebind_mismatch of Longident.t * Path.t * Path.t
+  | Rebind_private of Longident.t
+  | Variance of Typedecl_variance.error
+  | Unavailable_type_constructor of Path.t
+  | Bad_fixed_type of string
+  | Unbound_type_var_ext of type_expr * extension_constructor
+  | Val_in_structure
+  | Multiple_native_repr_attributes
+  | Cannot_unbox_or_untag_type of native_repr_kind
+  | Deep_unbox_or_untag_attribute of native_repr_kind
+  | Immediacy of Typedecl_immediacy.error
+  | Separability of Typedecl_separability.error
+  | Bad_unboxed_attribute of string
+  | Boxed_and_unboxed
+  | Nonrec_gadt
+
+exception Error of Location.t * error
+
+val report_error: formatter -> error -> unit
diff --git a/typing/typedecl_immediacy.ml b/typing/typedecl_immediacy.ml
new file mode 100644
index 00000000..ccd09e81
--- /dev/null
+++ b/typing/typedecl_immediacy.ml
@@ -0,0 +1,71 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Gabriel Scherer, projet Parsifal, INRIA Saclay                       *)
+(*   Rodolphe Lepigre, projet Deducteam, INRIA Saclay                     *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Types
+
+type error = Bad_immediacy_attribute of Type_immediacy.Violation.t
+exception Error of Location.t * error
+
+let compute_decl env tdecl =
+  match (tdecl.type_kind, tdecl.type_manifest) with
+  | (Type_variant [{cd_args = Cstr_tuple [arg]; _}], _)
+    | (Type_variant [{cd_args = Cstr_record [{ld_type = arg; _}]; _}], _)
+    | (Type_record ([{ld_type = arg; _}], _), _)
+  when tdecl.type_unboxed.unboxed ->
+    begin match Typedecl_unboxed.get_unboxed_type_representation env arg with
+    | Typedecl_unboxed.Unavailable -> Type_immediacy.Unknown
+    | Typedecl_unboxed.This argrepr -> Ctype.immediacy env argrepr
+    | Typedecl_unboxed.Only_on_64_bits argrepr ->
+        match Ctype.immediacy env argrepr with
+        | Type_immediacy.Always -> Type_immediacy.Always_on_64bits
+        | Type_immediacy.Always_on_64bits | Type_immediacy.Unknown as x -> x
+    end
+  | (Type_variant (_ :: _ as cstrs), _) ->
+    if not (List.exists (fun c -> c.Types.cd_args <> Types.Cstr_tuple []) cstrs)
+    then
+      Type_immediacy.Always
+    else
+      Type_immediacy.Unknown
+  | (Type_abstract, Some(typ)) -> Ctype.immediacy env typ
+  | (Type_abstract, None) -> Type_immediacy.of_attributes tdecl.type_attributes
+  | _ -> Type_immediacy.Unknown
+
+let property : (Type_immediacy.t, unit) Typedecl_properties.property =
+  let open Typedecl_properties in
+  let eq = (=) in
+  let merge ~prop:_ ~new_prop = new_prop in
+  let default _decl = Type_immediacy.Unknown in
+  let compute env decl () = compute_decl env decl in
+  let update_decl decl immediacy = { decl with type_immediate = immediacy } in
+  let check _env _id decl () =
+    let written_by_user = Type_immediacy.of_attributes decl.type_attributes in
+    match Type_immediacy.coerce decl.type_immediate ~as_:written_by_user with
+    | Ok () -> ()
+    | Error violation ->
+        raise (Error (decl.type_loc,
+                      Bad_immediacy_attribute violation))
+  in
+  {
+    eq;
+    merge;
+    default;
+    compute;
+    update_decl;
+    check;
+  }
+
+let update_decls env decls =
+  Typedecl_properties.compute_property_noreq property env decls
diff --git a/typing/typedecl_immediacy.mli b/typing/typedecl_immediacy.mli
new file mode 100644
index 00000000..17fb985c
--- /dev/null
+++ b/typing/typedecl_immediacy.mli
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Gabriel Scherer, projet Parsifal, INRIA Saclay                       *)
+(*   Rodolphe Lepigre, projet Deducteam, INRIA Saclay                     *)
+(*                                                                        *)
+(*   Copyright 2018 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 error = Bad_immediacy_attribute of Type_immediacy.Violation.t
+exception Error of Location.t * error
+
+val compute_decl : Env.t -> Types.type_declaration -> Type_immediacy.t
+
+val property : (Type_immediacy.t, unit) Typedecl_properties.property
+
+val update_decls :
+  Env.t ->
+  (Ident.t * Typedecl_properties.decl) list ->
+  (Ident.t * Typedecl_properties.decl) list
diff --git a/typing/typedecl_properties.ml b/typing/typedecl_properties.ml
new file mode 100644
index 00000000..28a1bb66
--- /dev/null
+++ b/typing/typedecl_properties.ml
@@ -0,0 +1,73 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Gabriel Scherer, projet Parsifal, INRIA Saclay                       *)
+(*   Rodolphe Lepigre, projet Deducteam, INRIA Saclay                     *)
+(*                                                                        *)
+(*   Copyright 2018 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 decl = Types.type_declaration
+
+type ('prop, 'req) property = {
+  eq : 'prop -> 'prop -> bool;
+  merge : prop:'prop -> new_prop:'prop -> 'prop;
+
+  default : decl -> 'prop;
+  compute : Env.t -> decl -> 'req -> 'prop;
+  update_decl : decl -> 'prop -> decl;
+
+  check : Env.t -> Ident.t -> decl -> 'req -> unit;
+}
+
+let add_type ~check id decl env =
+  let open Types in
+  Builtin_attributes.warning_scope ~ppwarning:false decl.type_attributes
+    (fun () -> Env.add_type ~check id decl env)
+
+let add_types_to_env decls env =
+  List.fold_right
+    (fun (id, decl) env -> add_type ~check:true id decl env)
+    decls env
+
+let compute_property
+: ('prop, 'req) property -> Env.t ->
+  (Ident.t * decl) list -> 'req list -> (Ident.t * decl) list
+= fun property env decls required ->
+  (* [decls] and [required] must be lists of the same size,
+     with [required] containing the requirement for the corresponding
+     declaration in [decls]. *)
+  let props = List.map (fun (_id, decl) -> property.default decl) decls in
+  let rec compute_fixpoint props =
+    let new_decls =
+      List.map2 (fun (id, decl) prop ->
+          (id, property.update_decl decl prop))
+        decls props in
+    let new_env = add_types_to_env new_decls env in
+    let new_props =
+      List.map2
+        (fun (_id, decl) (prop, req) ->
+           let new_prop = property.compute new_env decl req in
+           property.merge ~prop ~new_prop)
+        new_decls (List.combine props required) in
+    if not (List.for_all2 property.eq props new_props)
+    then compute_fixpoint new_props
+    else begin
+      List.iter2
+        (fun (id, decl) req -> property.check new_env id decl req)
+        new_decls required;
+      new_decls
+    end
+  in
+  compute_fixpoint props
+
+let compute_property_noreq property env decls =
+  let req = List.map (fun _ -> ()) decls in
+  compute_property property env decls req
diff --git a/typing/typedecl_properties.mli b/typing/typedecl_properties.mli
new file mode 100644
index 00000000..153c3f71
--- /dev/null
+++ b/typing/typedecl_properties.mli
@@ -0,0 +1,55 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Gabriel Scherer, projet Parsifal, INRIA Saclay                       *)
+(*   Rodolphe Lepigre, projet Deducteam, INRIA Saclay                     *)
+(*                                                                        *)
+(*   Copyright 2018 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 decl = Types.type_declaration
+
+(** An abstract interface for properties of type definitions, such as
+   variance and immediacy, that are computed by a fixpoint on
+   mutually-recursive type declarations. This interface contains all
+   the operations needed to initialize and run the fixpoint
+   computation, and then (optionally) check that the result is
+   consistent with the declaration or user expectations. *)
+
+type ('prop, 'req) property = {
+  eq : 'prop -> 'prop -> bool;
+  merge : prop:'prop -> new_prop:'prop -> 'prop;
+
+  default : decl -> 'prop;
+  compute : Env.t -> decl -> 'req -> 'prop;
+  update_decl : decl -> 'prop -> decl;
+
+  check : Env.t -> Ident.t -> decl -> 'req -> unit;
+}
+(** ['prop] represents the type of property values
+    ({!Types.Variance.t}, just 'bool' for immediacy, etc).
+
+    ['req] represents the property value required by the author of the
+    declaration, if they gave an expectation: [type +'a t = ...].
+
+    Some properties have no natural notion of user requirement, or
+    their requirement is global, or already stored in
+    [type_declaration]; they can just use [unit] as ['req] parameter. *)
+
+
+(** [compute_property prop env decls req] performs a fixpoint computation
+    to determine the final values of a property on a set of mutually-recursive
+    type declarations. The [req] argument must be a list of the same size as
+    [decls], providing the user requirement for each declaration. *)
+val compute_property : ('prop, 'req) property -> Env.t ->
+  (Ident.t * decl) list -> 'req list -> (Ident.t * decl) list
+
+val compute_property_noreq : ('prop, unit) property -> Env.t ->
+  (Ident.t * decl) list -> (Ident.t * decl) list
diff --git a/typing/typedecl_separability.ml b/typing/typedecl_separability.ml
new file mode 100644
index 00000000..32e34228
--- /dev/null
+++ b/typing/typedecl_separability.ml
@@ -0,0 +1,731 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Gabriel Scherer, projet Parsifal, INRIA Saclay                       *)
+(*   Rodolphe Lepigre, projet Deducteam, INRIA Saclay                     *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Types
+
+type type_definition = type_declaration
+(* We should use 'declaration' for interfaces, and 'definition' for
+   implementations. The name type_declaration in types.ml is improper
+   for our usage -- although for OCaml types the declaration and
+   definition languages are the same. *)
+
+(** assuming that a datatype has a single constructor/label with
+   a single argument, [argument_to_unbox] represents the
+   information we need to check the argument for separability. *)
+type argument_to_unbox = {
+  kind: parameter_kind; (* for error messages *)
+  mutability: Asttypes.mutable_flag;
+  argument_type: type_expr;
+  result_type_parameter_instances: type_expr list;
+  (** result_type_parameter_instances represents the domain of the
+     constructor; usually it is just a list of the datatype parameter
+     ('a, 'b, ...), but when using GADTs or constraints it could
+     contain arbitrary type expressions.
+
+     For example, [type 'a t = 'b constraint 'a = 'b * int] has
+     [['b * int]] as [result_type_parameter_instances], and so does
+     [type _ t = T : 'b -> ('b * int) t]. *)
+  location : Location.t;
+}
+and parameter_kind =
+  | Record_field
+  | Constructor_parameter
+  | Constructor_field (** inlined records *)
+
+(** ['a multiplicity] counts the number of ['a] in
+    a structure in which expect to see only one ['a]. *)
+type 'a multiplicity =
+  | Zero
+  | One of 'a
+  | Several
+
+type arity = argument_to_unbox multiplicity (**how many parameters?*)
+
+type branching = arity multiplicity (**how many constructors?*)
+
+(** Summarize the right-hand-side of a type declaration,
+    for separability-checking purposes. See {!structure} below. *)
+type type_structure =
+  | Synonym of type_expr
+  | Abstract
+  | Open
+  | Algebraic of branching
+
+let demultiply_list
+  : type a b. a list -> (a -> b) -> b multiplicity
+  = fun li f -> match li with
+  | [] -> Zero
+  | [v] -> One (f v)
+  | _::_::_ -> Several
+
+let structure : type_definition -> type_structure = fun def ->
+  match def.type_kind with
+  | Type_open -> Open
+  | Type_abstract ->
+      begin match def.type_manifest with
+      | None -> Abstract
+      | Some type_expr -> Synonym type_expr
+      end
+  | Type_record (labels, _) ->
+      Algebraic (One (
+        demultiply_list labels @@ fun ld -> {
+          location = ld.ld_loc;
+          kind = Record_field;
+          mutability = ld.ld_mutable;
+          argument_type = ld.ld_type;
+          result_type_parameter_instances = def.type_params;
+        }
+      ))
+  | Type_variant constructors ->
+      Algebraic (demultiply_list constructors @@ fun cd ->
+        let result_type_parameter_instances =
+          match cd.cd_res with
+          (* cd_res is the optional return type (in a GADT);
+             if None, just use the type parameters *)
+          | None -> def.type_params
+          | Some ret_type ->
+              begin match Ctype.repr ret_type with
+              | {desc=Tconstr (_, tyl, _)} ->
+                  List.map Ctype.repr tyl
+              | _ -> assert false
+              end
+        in
+        begin match cd.cd_args with
+        | Cstr_tuple tys ->
+            demultiply_list tys @@ fun argument_type -> {
+              location = cd.cd_loc;
+              kind = Constructor_parameter;
+              mutability = Asttypes.Immutable;
+              argument_type;
+              result_type_parameter_instances;
+            }
+        | Cstr_record labels ->
+            demultiply_list labels @@ fun ld ->
+              let argument_type = ld.ld_type in
+              {
+                location = ld.ld_loc;
+                kind = Constructor_field;
+                mutability = ld.ld_mutable;
+                argument_type;
+                result_type_parameter_instances;
+              }
+        end)
+
+
+type error =
+  | Non_separable_evar of string option
+
+exception Error of Location.t * error
+
+(* see the .mli file for explanations on the modes *)
+module Sep = Types.Separability
+type mode = Sep.t = Ind | Sep | Deepsep
+
+let rank = Sep.rank
+let max_mode = Sep.max
+
+(** If the type context [e(_)] imposes the mode [m] on its hole [_],
+    and the type context [e'(_)] imposes the mode [m'] on its hole [_],
+    then the mode on [_] imposed by the context composition [e(e'(_))]
+    is [compose m m'].
+
+    This operation differs from [max_mode]: [max_mode Ind Sep] is [Sep],
+    but [compose Ind Sep] is [Ind]. *)
+let compose
+  : mode -> mode -> mode
+  = fun m1 m2 ->
+  match m1 with
+  | Deepsep -> Deepsep
+  | Sep -> m2
+  | Ind -> Ind
+
+type type_var = {
+  text: string option; (** the user name of the type variable, None for '_' *)
+  id: int; (** the identifier of the type node (type_expr.id) of the variable *)
+}
+
+module TVarMap = Map.Make(struct
+    type t = type_var
+    let compare v1 v2 = compare v1.id v2.id
+  end)
+type context = mode TVarMap.t
+let (++) = TVarMap.union (fun _ m1 m2 -> Some(max_mode m1 m2))
+let empty = TVarMap.empty
+
+
+(** [immediate_subtypes ty] returns the list of all the
+   immediate sub-type-expressions of [ty]. They represent the biggest
+   sub-components that may be extracted using a constraint. For
+   example, the immediate sub-type-expressions of [int * (bool * 'a)]
+   are [int] and [bool * 'a].
+
+   Smaller components are extracted recursively in [check_type]. *)
+let rec immediate_subtypes : type_expr -> type_expr list = fun ty ->
+  (* Note: Btype.fold_type_expr is not suitable here:
+     - it does not do the right thing on Tpoly, iterating on type
+       parameters as well as the subtype
+     - it performs a shallow traversal of object types,
+       while our implementation collects all method types *)
+  match (Ctype.repr ty).desc with
+  (* these are the important cases,
+     on which immediate_subtypes is called from [check_type] *)
+  | Tarrow(_,ty1,ty2,_) ->
+      [ty1; ty2]
+  | Ttuple(tys)
+  | Tpackage(_,_,tys) ->
+      tys
+  | Tobject(row,class_ty) ->
+      let class_subtys =
+        match !class_ty with
+        | None        -> []
+        | Some(_,tys) -> tys
+      in
+      immediate_subtypes_object_row class_subtys row
+  | Tvariant(row) ->
+      immediate_subtypes_variant_row [] row
+
+  (* the cases below are not called from [check_type],
+     they are here for completeness *)
+  | Tnil | Tfield _ ->
+      (* these should only occur under Tobject and not at the toplevel,
+         but "better safe than sorry" *)
+      immediate_subtypes_object_row [] ty
+  | Tlink _ | Tsubst _ -> assert false (* impossible due to Ctype.repr *)
+  | Tvar _ | Tunivar _ -> []
+  | Tpoly (pty, _) -> [pty]
+  | Tconstr (_path, tys, _) -> tys
+
+and immediate_subtypes_object_row acc ty = match (Ctype.repr ty).desc with
+  | Tnil -> acc
+  | Tfield (_label, _kind, ty, rest) ->
+      let acc = ty :: acc in
+      immediate_subtypes_object_row acc rest
+  | _ -> ty :: acc
+
+and immediate_subtypes_variant_row acc desc =
+  let add_subtypes acc =
+    let add_subtype acc (_l, rf) =
+      immediate_subtypes_variant_row_field acc rf in
+    List.fold_left add_subtype acc desc.row_fields in
+  let add_row acc =
+    let row = Ctype.repr desc.row_more in
+    match row.desc with
+    | Tvariant more -> immediate_subtypes_variant_row acc more
+    | _ -> row :: acc
+  in
+  add_row (add_subtypes acc)
+
+and immediate_subtypes_variant_row_field acc = function
+  | Rpresent(None)
+  | Rabsent            -> acc
+  | Rpresent(Some(ty)) -> ty :: acc
+  | Reither(_,field_types,_,r) ->
+      let acc = List.rev_append field_types acc in
+      begin match !r with
+      | None -> acc
+      | Some rf -> immediate_subtypes_variant_row_field acc rf
+      end
+
+let free_variables ty =
+  Ctype.free_variables (Ctype.repr ty)
+  |> List.map (fun {desc; id; _} ->
+      match desc with
+      | Tvar text -> {text; id}
+      | _ ->
+          (* Ctype.free_variables only returns Tvar nodes *)
+          assert false)
+
+(** Coinductive hypotheses to handle equi-recursive types
+
+    OCaml allows infinite/cyclic types, such as
+      (int * 'a) as 'a
+    whose infinite unfolding is (int * (int * (int * (int * ...)))).
+
+    Remark: this specific type is only accepted if the -rectypes option
+    is passed, but such "equi-recursive types" are accepted by
+    default if the cycle goes through an object type or polymorphic
+    variant type:
+      [ `int | `other of 'a ] as 'a
+      < head : int; rest : 'a > as 'a
+
+    We have to take those infinite types in account in our
+    separability-checking program: a naive implementation would loop
+    infinitely when trying to prove that one of them is Deepsep.
+
+    After type-checking, the cycle-introducing form (... as 'a) does
+    not appear explicitly in the syntax of types: types are graphs/trees
+    with cycles in them, and we have to use the type_expr.id field,
+    an identifier for each node in the graph/tree, to detect cycles.
+
+    We avoid looping by remembering the set of separability queries
+    that we have already asked ourselves (in the current
+    search branch). For example, if we are asked to check
+
+      (int * 'a) : Deepsep
+
+    our algorithm will check both (int : Deepsep) and ('a : Deepsep),
+    but it will remember in these sub-checks that it is in the process
+    of checking (int * 'a) : Deepsep, adding it to a list of "active
+    goals", or "coinductive hypotheses".
+
+    Each new sub-query will start by checking whether the query
+    already appears as a coinductive hypothesis; in our example, this
+    can happen if 'a and (int * 'a) are in fact the same node in the
+    cyclic tree. In that case, we return immediately (instead of looping):
+    we reason that, assuming that 'a is indeed Deepsep, then it is
+    the case that (int * 'a) is also Deepsep.
+
+    This kind of cyclic reasoning can be dangerous: it would be wrong
+    to argue that an arbitrary 'a type is Deepsep by saying:
+    "assuming that 'a is Deepsep, then it is the case that 'a is
+    also Deepsep". In the first case, we made an assumption on 'a,
+    and used it on a type (int * 'a) which has 'a as a strict sub-component;
+    in the second, we use it on the same type 'a directly, which is invalid.
+
+    Now consider a type of the form (('a t) as 'a): while 'a is a sub-component
+    of ('a t), it may still be wrong to reason coinductively about it,
+    as ('a t) may be defined as (type 'a t = 'a).
+
+    When moving from (int * 'a) to a subcomponent (int) or ('a), we
+    say that the coinductive hypothesis on (int * 'a : m) is "safe":
+    it can be used immediately to prove the subcomponents, because we
+    made progress moving to a strict subcomponent (we are guarded
+    under a computational type constructor). On the other hand, when
+    moving from ('a t) to ('a), we say that the coinductive hypothesis
+    ('a t : m) is "unsafe" for the subgoal, as we don't know whether
+    we have made strict progress. In the general case, we keep track
+    of a set of safe and unsafe hypotheses made in the past, and we
+    use them to terminate checking if we encounter them again,
+    ensuring termination.
+
+    If we encounter a (ty : m) goal that is exactly a safe hypothesis,
+    we terminate with a success. In fact, we can use mode subtyping here:
+    if (ty : m') appears as a hypothesis with (m' >= m), then we would
+    succeed for (ty : m'), so (ty : m) should succeed as well.
+
+    On the other hand, if we encounter a (ty : m) goal that is an
+    *unsafe* hypothesis, we terminate the check with a failure. In this case,
+    we cannot work modulo mode subtyping: if (ty : m') appears with
+    (m' >= m), then the check (ty : m') would have failed, but it is still
+    possible that the weaker current query (ty : m) would succeed.
+
+    In usual coinductive-reasoning systems, unsafe hypotheses are turned
+    into safe hypotheses each time strict progress is made (for each
+    guarded sub-goal). Consider ((int * 'a) t as 'a : deepsep) for example:
+    the idea is that the ((int * 'a) t : deepsep) hypothesis would be
+    unsafe when checking ((int * 'a) : deepsep), but that the progress
+    step from (int * 'a : deepsep) to ('a : deepsep) would turn all
+    past unsafe hypotheses into safe hypotheses. There is a problem
+    with this, though, due to constraints: what if (_ t) is defined as
+
+      type 'b t = 'a constraint 'b = (int * 'a)
+
+    ?
+
+    In that case, then 'a is precisely the one-step unfolding
+    of the ((int * 'a) t) definition, and it would be an invalid,
+    cyclic reasoning to prove ('a : deepsep) from the now-safe
+    hypothesis ((int * 'a) t : deepsep).
+
+    Surprisingly-fortunately, we have exactly the information we need
+    to know whether (_ t) may or may not pull a constraint trick of
+    this nature: we can look at its mode signature, where constraints
+    are marked by a Deepsep mode. If we see Deepsep, we know that a
+    constraint exists, but we don't know what the constraint is:
+    we cannot tell at which point, when decomposing the parameter type,
+    a sub-component can be considered safe again. To model this,
+    we add a third category of co-inductive hypotheses: to "safe" and
+    "unsafe" we add the category of "poison" hypotheses, which remain
+    poisonous during the remaining of the type decomposition,
+    even in presence of safe, computational types constructors:
+
+    - when going under a computational constructor,
+      "unsafe" hypotheses become "safe"
+    - when going under a constraining type (more precisely, under
+      a type parameter that is marked Deepsep in the mode signature),
+      "unsafe" hypotheses become "poison"
+
+    The mode signature tells us even a bit more: if a parameter
+    is marked "Ind", we know that the type constructor cannot unfold
+    to this parameter (otherwise it would be Sep), so going under
+    this parameter can be considered a safe/guarded move: if
+    we have to check (foo t : m) with ((_ : Ind) t) in the signature,
+    we can recursively check (foo : Ind) with (foo t : m) marked
+    as "safe", rather than "unsafe".
+*)
+module TypeMap = Btype.TypeMap
+module ModeSet = Set.Make(Types.Separability)
+
+type coinductive_hyps = {
+  safe: ModeSet.t TypeMap.t;
+  unsafe: ModeSet.t TypeMap.t;
+  poison: ModeSet.t TypeMap.t;
+}
+
+module Hyps : sig
+  type t = coinductive_hyps
+  val empty : t
+  val add : type_expr -> mode -> t -> t
+  val guard : t -> t
+  val poison : t -> t
+  val safe : type_expr -> mode -> t -> bool
+  val unsafe : type_expr -> mode -> t -> bool
+end = struct
+  type t = coinductive_hyps
+
+  let empty = {
+    safe = TypeMap.empty;
+    unsafe = TypeMap.empty;
+    poison = TypeMap.empty;
+  }
+
+  let of_opt = function
+    | Some ms -> ms
+    | None -> ModeSet.empty
+
+  let merge map1 map2 =
+    TypeMap.merge (fun _k ms1 ms2 ->
+        Some (ModeSet.union (of_opt ms1) (of_opt ms2))
+      ) map1 map2
+
+  let guard {safe; unsafe; poison;} = {
+    safe = merge safe unsafe;
+    unsafe = TypeMap.empty;
+    poison;
+  }
+
+  let poison {safe; unsafe; poison;} = {
+    safe;
+    unsafe = TypeMap.empty;
+    poison = merge poison unsafe;
+  }
+
+  let add ty m hyps =
+    let m_map = TypeMap.singleton ty (ModeSet.singleton m) in
+    { hyps with unsafe = merge m_map hyps.unsafe; }
+
+  let find ty map = try TypeMap.find ty map with Not_found -> ModeSet.empty
+
+  let safe ty m hyps =
+    match ModeSet.max_elt_opt (find ty hyps.safe) with
+    | None -> false
+    | Some best_safe -> rank best_safe >= rank m
+
+  let unsafe ty m {safe = _; unsafe; poison} =
+    let in_map s = ModeSet.mem m (find ty s) in
+    List.exists in_map [unsafe; poison]
+end
+
+(** For a type expression [ty] (without constraints and existentials),
+    any mode checking [ty : m] is satisfied in the "worse case" context
+    that maps all free variables of [ty] to the most demanding mode,
+    Deepsep. *)
+let worst_case ty =
+  let add ctx tvar = TVarMap.add tvar Deepsep ctx in
+  List.fold_left add TVarMap.empty (free_variables ty)
+
+
+(** [check_type env sigma ty m] returns the most permissive context [gamma]
+    such that [ty] is separable at mode [m] in [gamma], under
+    the signature [sigma]. *)
+let check_type
+  : Env.t -> type_expr -> mode -> context
+  = fun env ty m ->
+  let rec check_type hyps ty m =
+    let ty = Ctype.repr ty in
+    if Hyps.safe ty m hyps then empty
+    else if Hyps.unsafe ty m hyps then worst_case ty
+    else
+    let hyps = Hyps.add ty m hyps in
+    match (ty.desc, m) with
+    (* Impossible case due to the call to [Ctype.repr]. *)
+    | (Tlink _            , _      ) -> assert false
+    (* Impossible case (according to comment in [typing/types.mli]. *)
+    | (Tsubst(_)          , _      ) -> assert false
+    (* "Indifferent" case, the empty context is sufficient. *)
+    | (_                  , Ind    ) -> empty
+    (* Variable case, add constraint. *)
+    | (Tvar(alpha)        , m      ) ->
+        TVarMap.singleton {text = alpha; id = ty.Types.id} m
+    (* "Separable" case for constructors with known memory representation. *)
+    | (Tarrow _           , Sep    )
+    | (Ttuple _           , Sep    )
+    | (Tvariant(_)        , Sep    )
+    | (Tobject(_,_)       , Sep    )
+    | ((Tnil | Tfield _)  , Sep    )
+    | (Tpackage(_,_,_)    , Sep    ) -> empty
+    (* "Deeply separable" case for these same constructors. *)
+    | (Tarrow _           , Deepsep)
+    | (Ttuple _           , Deepsep)
+    | (Tvariant(_)        , Deepsep)
+    | (Tobject(_,_)       , Deepsep)
+    | ((Tnil | Tfield _)  , Deepsep)
+    | (Tpackage(_,_,_)    , Deepsep) ->
+        let tys = immediate_subtypes ty in
+        let on_subtype context ty =
+          context ++ check_type (Hyps.guard hyps) ty Deepsep in
+        List.fold_left on_subtype empty tys
+    (* Polymorphic type, and corresponding polymorphic variable.
+
+       In theory, [Tpoly] (forall alpha. tau) would add a new variable
+       (alpha) in scope, check its body (tau) recursively, and then
+       remove the new variable from the resulting context. Because the
+       rule accepts any mode for this variable, the removal never
+       fails.
+
+       In practice the implementation is simplified by ignoring the
+       new variable, and always returning the [empty] context
+       (instead of (alpha : m) in the [Tunivar] case: the constraint
+       on the variable is removed/ignored at the variable occurrence
+       site, rather than at the variable-introduction site. *)
+    (* Note: that we are semantically incomplete in the Deepsep case
+       (following the syntactic typing rules): the semantics only
+       requires that *closed* sub-type-expressions be (deeply)
+       separable; sub-type-expressions containing the quantified
+       variable cannot be extracted by constraints (this would be
+       a scope violation), so they could be ignored if they occur
+       under a separating type constructor. *)
+    | (Tpoly(pty,_)       , m      ) ->
+        check_type hyps pty m
+    | (Tunivar(_)         , _      ) -> empty
+    (* Type constructor case. *)
+    | (Tconstr(path,tys,_), m      ) ->
+        let msig = (Env.find_type path env).type_separability in
+        let on_param context (ty, m_param) =
+          let hyps = match m_param with
+            | Ind -> Hyps.guard hyps
+            | Sep -> hyps
+            | Deepsep -> Hyps.poison hyps in
+          context ++ check_type hyps ty (compose m m_param) in
+        List.fold_left on_param empty (List.combine tys msig)
+  in
+  check_type Hyps.empty ty m
+
+let best_msig decl = List.map (fun _ -> Ind) decl.type_params
+let worst_msig decl = List.map (fun _ -> Deepsep) decl.type_params
+
+(** [msig_of_external_type decl] infers the mode signature of an
+    abstract/external type. We must assume the worst, namely that this
+    type may be defined as an unboxed algebraic datatype imposing deep
+    separability of its parameters.
+
+    One exception is when the type is marked "immediate", which
+    guarantees that its representation is only integers.  Immediate
+    types are always separable, so [Ind] suffices for their
+    parameters.
+
+    Note: this differs from {!Types.Separability.default_signature},
+    which does not have access to the declaration and its immediacy. *)
+let msig_of_external_type decl =
+  match decl.type_immediate with
+  | Always | Always_on_64bits -> best_msig decl
+  | Unknown -> worst_msig decl
+
+(** [msig_of_context ~decl_loc constructor context] returns the
+   separability signature of a single-constructor type whose
+   definition is valid in the mode context [context].
+
+   Note: A GADT constructor introduces existential type variables, and
+   may also introduce some equalities between its return type
+   parameters and type expressions containing universal and
+   existential variables. In other words, it introduces new type
+   variables in scope, and restricts existing variables by adding
+   equality constraints.
+
+   [msig_of_context] performs the reverse transformation: the context
+   [ctx] computed from the argument of the constructor mentions
+   existential variables, and the function returns a context over the
+   (universal) type parameters only. (Type constraints do not
+   introduce existential variables, but they do introduce equalities;
+   they are handled as GADTs equalities by this function.)
+
+   The transformation is separability-preserving in the following
+   sense: for any valid instance of the result mode signature
+   (replacing the universal type parameters with ground types
+   respecting the variable's separability mode), any possible
+   extension of this context instance with ground instances for the
+   existential variables of [parameter] that respects the equation
+   constraints will validate the separability requirements of the
+   modes in the input context [ctx].
+
+   Sometimes no such universal context exists, as an existential type
+   cannot be safely introduced, then this function raises an [Error]
+   exception with a [Non_separable_evar] payload.  *)
+let msig_of_context : decl_loc:Location.t -> parameters:type_expr list
+    -> context -> Sep.signature =
+  fun ~decl_loc ~parameters context ->
+    let handle_equation (acc, context) param_instance =
+      (* In the theory, GADT equations are of the form
+           ('a = )
+         for each type parameter 'a of the type constructor. For each
+         such equation, we should "strengthen" the current context in
+         the following way:
+         - if  is another variable 'b,
+           the mode of 'a is set to the mode of 'b,
+           and 'b is set to Ind
+         - if  is a type expression whose variables are all Ind,
+           set 'a to Ind and discard the equation
+         - otherwise (one of the variable of 'b is not Ind),
+           set 'a to Deepsep and set all variables of  to Ind
+
+         In practice, type parameters are determined by their position
+         in a list, they do not necessarily have a corresponding type variable.
+         Instead of "setting 'a" in the context as in the description above,
+         we build a list of modes by repeated consing into
+         an accumulator variable [acc], setting existential variables
+         to Ind as we go. *)
+      let param_instance = Ctype.repr param_instance in
+      let get context var =
+        try TVarMap.find var context with Not_found -> Ind in
+      let set_ind context var =
+        TVarMap.add var Ind context in
+      let is_ind context var = match get context var with
+        | Ind -> true
+        | Sep | Deepsep -> false in
+      match param_instance.desc with
+      | Tvar text ->
+          let var = {text; id = param_instance.Types.id} in
+          (get context var) :: acc, (set_ind context var)
+      | _ ->
+          let instance_exis = free_variables param_instance in
+          if List.for_all (is_ind context) instance_exis then
+            Ind :: acc, context
+          else
+            Deepsep :: acc, List.fold_left set_ind context instance_exis
+    in
+    let mode_signature, context =
+      let (mode_signature_rev, ctx) =
+        List.fold_left handle_equation ([], context) parameters in
+      (* Note: our inference system is not principal, because the
+         inference result depends on the order in which those
+         equations are processed. (To our knowledge this is the only
+         source of non-principality.) If two parameters ('a, 'b) are
+         forced to be equal to each other, and also separable, then
+         either modes (Sep, Ind) and (Ind, Sep) are correct, allow
+         more declarations than (Sep, Sep), but (Ind, Ind) would be
+         unsound.
+
+         Such a non-principal example is the following:
+
+           type ('a, 'b) almost_eq =
+             | Almost_refl : 'c -> ('c, 'c) almost_eq
+
+         (This example looks strange: GADT equations are typically
+         either on only one parameter, or on two parameters that are
+         not used to classify constructor arguments. Indeed, we have
+         not found non-principal declarations in real-world code.)
+
+         In a non-principal system, it is important the our choice of
+         non-unique solution be at least predictable. We find it more
+         natural, when either ('a : Sep, 'b : Ind) and ('a : Ind,
+         'b : Sep) are correct because 'a = 'b, to choose to make the
+         first/leftmost parameter more constrained. We read this as
+         saying that 'a must be Sep, and 'b = 'a so 'b can be
+         Ind. (We define the second parameter as equal of the first,
+         already-seen parameter; instead of saying that the first
+         parameter is equal to the not-yet-seen second one.)
+
+         This is achieved by processing the equations from left to
+         right with List.fold_left, instead of using
+         List.fold_right. The code is slightly more awkward as it
+         needs a List.rev on the accumulated modes, but it gives
+         a more predictable/natural (non-principal) behavior.
+  *)
+      (List.rev mode_signature_rev, ctx) in
+    (* After all variables determined by the parameters have been set to Ind
+       by [handle_equation], all variables remaining in the context are
+       purely existential and should not require a stronger mode than Ind. *)
+    let check_existential evar mode =
+      if rank mode > rank Ind then
+        raise (Error (decl_loc, Non_separable_evar evar.text))
+    in
+    TVarMap.iter check_existential context;
+    mode_signature
+
+(** [check_def env def] returns the signature required
+    for the type definition [def] in the typing environment [env].
+
+    The exception [Error] is raised if we discover that
+    no such signature exists -- the definition will always be invalid.
+    This only happens when the definition is marked to be unboxed. *)
+
+let check_def
+  : Env.t -> type_definition -> Sep.signature
+  = fun env def ->
+  let boxed = not def.type_unboxed.unboxed in
+  match structure def with
+  | Abstract ->
+      assert boxed;
+      msig_of_external_type def
+  | Synonym type_expr ->
+      check_type env type_expr Sep
+      |> msig_of_context ~decl_loc:def.type_loc ~parameters:def.type_params
+  | Open | Algebraic (Zero | Several | One (Zero | Several)) ->
+      assert boxed;
+      best_msig def
+  | Algebraic (One (One constructor)) ->
+    if boxed then best_msig def
+    else
+      check_type env constructor.argument_type Sep
+      |> msig_of_context ~decl_loc:def.type_loc
+           ~parameters:constructor.result_type_parameter_instances
+
+let compute_decl env decl =
+  if Config.flat_float_array then check_def env decl
+  else
+    (* Hack: in -no-flat-float-array mode, instead of always returning
+       [best_msig], we first compute the separability signature --
+       falling back to [best_msig] if it fails.
+
+       This discipline is conservative: it never
+       rejects -no-flat-float-array programs. At the same time it
+       guarantees that, for any program that is also accepted
+       in -flat-float-array mode, the same separability will be
+       inferred in the two modes. In particular, the same .cmi files
+       and digests will be produced.
+
+       Before we introduced this hack, the production of different
+       .cmi files would break the build system of the compiler itself,
+       when trying to build a -no-flat-float-array system from
+       a bootstrap compiler itself using -flat-float-array. See #9291.
+       *)
+    try check_def env decl with
+    | Error _ ->
+       (* It could be nice to emit a warning here, so that users know
+          that their definition would be rejected in -flat-float-array mode *)
+       best_msig decl
+
+(** Separability as a generic property *)
+type prop = Types.Separability.signature
+
+let property : (prop, unit) Typedecl_properties.property =
+  let open Typedecl_properties in
+  let eq ts1 ts2 =
+    List.length ts1 = List.length ts2
+    && List.for_all2 Sep.eq ts1 ts2 in
+  let merge ~prop:_ ~new_prop =
+    (* the update function is monotonous: ~new_prop is always
+       more informative than ~prop, which can be ignored *)
+    new_prop in
+  let default decl = best_msig decl in
+  let compute env decl () = compute_decl env decl in
+  let update_decl decl type_separability = { decl with type_separability } in
+  let check _env _id _decl () = () in (* FIXME run final check? *)
+  { eq; merge; default; compute; update_decl; check; }
+
+(* Definition using the fixpoint infrastructure. *)
+let update_decls env decls =
+  Typedecl_properties.compute_property_noreq property env decls
diff --git a/typing/typedecl_separability.mli b/typing/typedecl_separability.mli
new file mode 100644
index 00000000..079e6408
--- /dev/null
+++ b/typing/typedecl_separability.mli
@@ -0,0 +1,132 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Gabriel Scherer, projet Parsifal, INRIA Saclay                       *)
+(*   Rodolphe Lepigre, projet Deducteam, INRIA Saclay                     *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The OCaml runtime assumes for type-directed optimizations that all types
+    are "separable". A type is "separable" if either all its inhabitants
+    (the values of this type) are floating-point numbers, or none of them are.
+
+    (Note: This assumption is required for the dynamic float array optimization;
+    it is only made if Config.flat_float_array is set,
+    otherwise the code in this module becomes trivial
+    -- see {!compute_decl}.)
+
+    This soundness requirement could be broken by type declarations mixing
+    existentials and the "[@@unboxed]" annotation. Consider the declaration
+
+    {[
+       type any = Any : 'a -> any [@@unboxed]
+    ]}
+
+   which corresponds to the existential type "exists a. a". If this type is
+   allowed to be unboxed, then it is inhabited by both [float] values
+   and non-[float] values. On the contrary, if unboxing is disallowed, the
+   inhabitants are all blocks with the [Any] constructors pointing to its
+   parameter: they may point to a float, but they are not floats.
+
+   The present module contains a static analysis ensuring that declarations
+   annotated with "[@@unboxed]" can be safely unboxed. The idea is to check
+   the "separability" (in the above sense) of the argument type that would
+   be unboxed, and reject the unboxed declaration if it would create a
+   non-separable type.
+
+   Checking mutually-recursive type declarations is a bit subtle.
+   Consider, for example, the following declarations.
+
+   {[
+      type foo = Foo : 'a t -> foo   [@@unboxed]
+      and 'a t = ...
+   ]}
+
+   Deciding whether the type [foo] should be accepted requires inspecting
+   the declaration of ['a t], which may itself refer to [foo] in turn.
+   In general, the analysis performs a fixpoint computation. It is somewhat
+   similar to what is done for inferring the variance of type parameters.
+
+   Our analysis is defined using inference rules for our judgment
+   [Def; Gamma |- t : m], in which a type expression [t] is checked
+   against a "mode" [m]. This "mode" describes the separability
+   requirement on the type expression (see below for
+   more details). The mode [Gamma] maps type variables to modes and
+   [Def] records the "mode signature" of the mutually-recursive type
+   declarations that are being checked.
+
+   The "mode signature" of a type with parameters [('a, 'b) t] is of the
+   form [('a : m1, 'b : m2) t], where [m1] and [m2] are modes. Its meaning
+   is the following: a concrete instance [(foo, bar) t] of the type is
+   separable if [foo] has mode [m1] and [bar] has mode [m2]. *)
+
+type error =
+  | Non_separable_evar of string option
+exception Error of Location.t * error
+(** Exception raised when a type declaration is not separable, or when its
+    separability cannot be established. *)
+
+type mode = Types.Separability.t = Ind | Sep | Deepsep
+(** The mode [Sep] ("separable") characterizes types that are indeed separable:
+    either they only contain floating-point values, or none of the values
+    at this type are floating-point values.
+    On a type parameter, it indicates that this parameter must be
+    separable for the whole type definition to be separable. For
+    example, the mode signature for the type declaration [type 'a
+    t = 'a] is [('a : Sep) t]. For the right-hand side to be
+    separable, the parameter ['a] must be separable.
+
+    The mode [Ind] ("indifferent") characterizes any type -- separable
+    or not.
+    On a type parameter, it indicates that this parameter needs not be
+    separable for the whole type definition to be separable. For
+    example, [type 'a t = 'a * bool] does not require its parameter
+    ['a] to be separable as ['a * bool] can never contain [float]
+    values. Its mode signature is thus [('a : Ind) t].
+
+    Finally, the mode [Deepsep] ("deeply separable") characterizes
+    types that are separable, and whose type sub-expressions are also
+    separable. This advanced feature is only used in the presence of
+    constraints.
+    For example, [type 'a t = 'b   constraint 'a = 'b * bool]
+    may not be separable even if ['a] is (its separately depends on 'b,
+    a fragment of 'a), so its mode signature is [('a : Deepsep) t].
+
+    The different modes are ordered as [Ind < Sep < Deepsep] (from the least
+    demanding to the most demanding). *)
+
+val compute_decl : Env.t -> Types.type_declaration -> mode list
+(** [compute_decl env def] returns the signature required
+    for the type definition [def] in the typing environment [env]
+    -- including signatures for the current recursive block.
+
+    The {!Error} exception is raised if no such signature exists
+    -- the definition will always be invalid. This only happens
+    when the definition is marked to be unboxed.
+
+    Variant (or record) declarations that are not marked with the
+    "[@@unboxed]" annotation, including those that contain several variants
+    (or labels), are always separable. In particular, their mode signatures
+    do not require anything of their type parameters, which are marked [Ind].
+
+    Finally, if {!Config.flat_float_array} is not set, then separability
+    is not required anymore; we just use [Ind] as the mode of each parameter
+    without any check.
+*)
+
+(** Property interface (see {!Typedecl_properties}). These functions
+    rely on {!compute_decl} and raise the {!Error} exception on error. *)
+type prop = Types.Separability.signature
+val property : (prop, unit) Typedecl_properties.property
+val update_decls :
+  Env.t ->
+  (Ident.t * Typedecl_properties.decl) list ->
+  (Ident.t * Typedecl_properties.decl) list
diff --git a/typing/typedecl_unboxed.ml b/typing/typedecl_unboxed.ml
new file mode 100644
index 00000000..e2d29a86
--- /dev/null
+++ b/typing/typedecl_unboxed.ml
@@ -0,0 +1,57 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Gabriel Scherer, projet Parsifal, INRIA Saclay                       *)
+(*   Rodolphe Lepigre, projet Deducteam, INRIA Saclay                     *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Types
+
+type t =
+  | Unavailable
+  | This of type_expr
+  | Only_on_64_bits of type_expr
+
+(* We use the Ctype.expand_head_opt version of expand_head to get access
+   to the manifest type of private abbreviations. *)
+let rec get_unboxed_type_representation env ty fuel =
+  if fuel < 0 then Unavailable else
+  let ty = Ctype.repr (Ctype.expand_head_opt env ty) in
+  match ty.desc with
+  | Tconstr (p, args, _) ->
+    begin match Env.find_type p env with
+    | exception Not_found -> This ty
+    | {type_immediate = Always; _} ->
+        This Predef.type_int
+    | {type_immediate = Always_on_64bits; _} ->
+        Only_on_64_bits Predef.type_int
+    | {type_unboxed = {unboxed = false}} -> This ty
+    | {type_params; type_kind =
+         Type_record ([{ld_type = ty2; _}], _)
+       | Type_variant [{cd_args = Cstr_tuple [ty2]; _}]
+       | Type_variant [{cd_args = Cstr_record [{ld_type = ty2; _}]; _}]}
+
+      ->
+        let ty2 = match ty2.desc with Tpoly (t, _) -> t | _ -> ty2 in
+        get_unboxed_type_representation env
+          (Ctype.apply env type_params ty2 args) (fuel - 1)
+    | {type_kind=Type_abstract} -> Unavailable
+          (* This case can occur when checking a recursive unboxed type
+             declaration. *)
+    | _ -> assert false (* only the above can be unboxed *)
+    end
+  | _ -> This ty
+
+let get_unboxed_type_representation env ty =
+  (* Do not give too much fuel: PR#7424 *)
+  get_unboxed_type_representation env ty 100
+;;
diff --git a/typing/typedecl_unboxed.mli b/typing/typedecl_unboxed.mli
new file mode 100644
index 00000000..9afd38e8
--- /dev/null
+++ b/typing/typedecl_unboxed.mli
@@ -0,0 +1,25 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Gabriel Scherer, projet Parsifal, INRIA Saclay                       *)
+(*   Rodolphe Lepigre, projet Deducteam, INRIA Saclay                     *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Types
+
+type t =
+  | Unavailable
+  | This of type_expr
+  | Only_on_64_bits of type_expr
+
+(* for typeopt.ml *)
+val get_unboxed_type_representation: Env.t -> type_expr -> t
diff --git a/typing/typedecl_variance.ml b/typing/typedecl_variance.ml
new file mode 100644
index 00000000..6b3bd288
--- /dev/null
+++ b/typing/typedecl_variance.ml
@@ -0,0 +1,384 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Gabriel Scherer, projet Parsifal, INRIA Saclay                       *)
+(*   Rodolphe Lepigre, projet Deducteam, INRIA Saclay                     *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Asttypes
+open Types
+
+module TypeSet = Btype.TypeSet
+module TypeMap = Btype.TypeMap
+
+type surface_variance = bool * bool * bool
+
+type variance_error =
+| Variance_not_satisfied of int
+| No_variable
+| Variance_not_reflected
+| Variance_not_deducible
+
+type error =
+| Bad_variance of variance_error * surface_variance * surface_variance
+| Varying_anonymous
+
+
+exception Error of Location.t * error
+
+(* Compute variance *)
+
+let get_variance ty visited =
+  try TypeMap.find ty !visited with Not_found -> Variance.null
+
+let compute_variance env visited vari ty =
+  let rec compute_variance_rec vari ty =
+    (* Format.eprintf "%a: %x@." Printtyp.type_expr ty (Obj.magic vari); *)
+    let ty = Ctype.repr ty in
+    let vari' = get_variance ty visited in
+    if Variance.subset vari vari' then () else
+    let vari = Variance.union vari vari' in
+    visited := TypeMap.add ty vari !visited;
+    let compute_same = compute_variance_rec vari in
+    match ty.desc with
+      Tarrow (_, ty1, ty2, _) ->
+        let open Variance in
+        let v = conjugate vari in
+        let v1 =
+          if mem May_pos v || mem May_neg v
+          then set May_weak true v else v
+        in
+        compute_variance_rec v1 ty1;
+        compute_same ty2
+    | Ttuple tl ->
+        List.iter compute_same tl
+    | Tconstr (path, tl, _) ->
+        let open Variance in
+        if tl = [] then () else begin
+          try
+            let decl = Env.find_type path env in
+            let cvari f = mem f vari in
+            List.iter2
+              (fun ty v ->
+                let cv f = mem f v in
+                let strict =
+                  cvari Inv && cv Inj || (cvari Pos || cvari Neg) && cv Inv
+                in
+                if strict then compute_variance_rec full ty else
+                let p1 = inter v vari
+                and n1 = inter v (conjugate vari) in
+                let v1 =
+                  union (inter covariant (union p1 (conjugate p1)))
+                    (inter (conjugate covariant) (union n1 (conjugate n1)))
+                and weak =
+                  cvari May_weak && (cv May_pos || cv May_neg) ||
+                  (cvari May_pos || cvari May_neg) && cv May_weak
+                in
+                let v2 = set May_weak weak v1 in
+                compute_variance_rec v2 ty)
+              tl decl.type_variance
+          with Not_found ->
+            List.iter (compute_variance_rec may_inv) tl
+        end
+    | Tobject (ty, _) ->
+        compute_same ty
+    | Tfield (_, _, ty1, ty2) ->
+        compute_same ty1;
+        compute_same ty2
+    | Tsubst ty ->
+        compute_same ty
+    | Tvariant row ->
+        let row = Btype.row_repr row in
+        List.iter
+          (fun (_,f) ->
+            match Btype.row_field_repr f with
+              Rpresent (Some ty) ->
+                compute_same ty
+            | Reither (_, tyl, _, _) ->
+                let open Variance in
+                let upper =
+                  List.fold_left (fun s f -> set f true s)
+                    null [May_pos; May_neg; May_weak]
+                in
+                let v = inter vari upper in
+                (* cf PR#7269:
+                   if List.length tyl > 1 then upper else inter vari upper *)
+                List.iter (compute_variance_rec v) tyl
+            | _ -> ())
+          row.row_fields;
+        compute_same row.row_more
+    | Tpoly (ty, _) ->
+        compute_same ty
+    | Tvar _ | Tnil | Tlink _ | Tunivar _ -> ()
+    | Tpackage (_, _, tyl) ->
+        let v =
+          Variance.(if mem Pos vari || mem Neg vari then full else may_inv)
+        in
+        List.iter (compute_variance_rec v) tyl
+  in
+  compute_variance_rec vari ty
+
+let make p n i =
+  let open Variance in
+  set May_pos p (set May_neg n (set May_weak n (set Inj i null)))
+
+let compute_variance_type env ~check (required, loc) decl tyl =
+  (* Requirements *)
+  let required =
+    List.map (fun (c,n,i) -> if c || n then (c,n,i) else (true,true,i))
+      required
+  in
+  (* Prepare *)
+  let params = List.map Btype.repr decl.type_params in
+  let tvl = ref TypeMap.empty in
+  (* Compute occurrences in the body *)
+  let open Variance in
+  List.iter
+    (fun (cn,ty) ->
+      compute_variance env tvl (if cn then full else covariant) ty)
+    tyl;
+  if check then begin
+    (* Check variance of parameters *)
+    let pos = ref 0 in
+    List.iter2
+      (fun ty (c, n, i) ->
+        incr pos;
+        let var = get_variance ty tvl in
+        let (co,cn) = get_upper var and ij = mem Inj var in
+        if Btype.is_Tvar ty && (co && not c || cn && not n || not ij && i)
+        then raise (Error(loc, Bad_variance
+                                (Variance_not_satisfied !pos,
+                                                        (co,cn,ij),
+                                                        (c,n,i)))))
+      params required;
+    (* Check propagation from constrained parameters *)
+    let args = Btype.newgenty (Ttuple params) in
+    let fvl = Ctype.free_variables args in
+    let fvl = List.filter (fun v -> not (List.memq v params)) fvl in
+    (* If there are no extra variables there is nothing to do *)
+    if fvl = [] then () else
+    let tvl2 = ref TypeMap.empty in
+    List.iter2
+      (fun ty (p,n,_) ->
+        if Btype.is_Tvar ty then () else
+        let v =
+          if p then if n then full else covariant else conjugate covariant in
+        compute_variance env tvl2 v ty)
+      params required;
+    let visited = ref TypeSet.empty in
+    let rec check ty =
+      let ty = Ctype.repr ty in
+      if TypeSet.mem ty !visited then () else
+      let visited' = TypeSet.add ty !visited in
+      visited := visited';
+      let v1 = get_variance ty tvl in
+      let snap = Btype.snapshot () in
+      let v2 =
+        TypeMap.fold
+          (fun t vt v ->
+            if Ctype.equal env false [ty] [t] then union vt v else v)
+          !tvl2 null in
+      Btype.backtrack snap;
+      let (c1,n1) = get_upper v1 and (c2,n2,_,i2) = get_lower v2 in
+      if c1 && not c2 || n1 && not n2 then
+        if List.memq ty fvl then
+          let code = if not i2 then No_variable
+                     else if c2 || n2 then Variance_not_reflected
+                     else Variance_not_deducible in
+          raise (Error (loc, Bad_variance (code, (c1,n1,false), (c2,n2,false))))
+        else
+          Btype.iter_type_expr check ty
+    in
+    List.iter (fun (_,ty) -> check ty) tyl;
+  end;
+  List.map2
+    (fun ty (p, n, i) ->
+      let v = get_variance ty tvl in
+      let tr = decl.type_private in
+      (* Use required variance where relevant *)
+      let concr = decl.type_kind <> Type_abstract (*|| tr = Type_new*) in
+      let (p, n) =
+        if tr = Private || not (Btype.is_Tvar ty) then (p, n) (* set *)
+        else (false, false) (* only check *)
+      and i = concr  || i && tr = Private in
+      let v = union v (make p n i) in
+      let v =
+        if not concr then v else
+        if mem Pos v && mem Neg v then full else
+        if Btype.is_Tvar ty then v else
+        union v
+          (if p then if n then full else covariant else conjugate covariant)
+      in
+      if decl.type_kind = Type_abstract && tr = Public then v else
+      set May_weak (mem May_neg v) v)
+    params required
+
+let add_false = List.map (fun ty -> false, ty)
+
+(* A parameter is constrained if it is either instantiated,
+   or it is a variable appearing in another parameter *)
+let constrained vars ty =
+  match ty.desc with
+  | Tvar _ -> List.exists (fun tl -> List.memq ty tl) vars
+  | _ -> true
+
+let for_constr = function
+  | Types.Cstr_tuple l -> add_false l
+  | Types.Cstr_record l ->
+      List.map
+        (fun {Types.ld_mutable; ld_type} -> (ld_mutable = Mutable, ld_type))
+        l
+
+let compute_variance_gadt env ~check (required, loc as rloc) decl
+    (tl, ret_type_opt) =
+  match ret_type_opt with
+  | None ->
+      compute_variance_type env ~check rloc {decl with type_private = Private}
+        (for_constr tl)
+  | Some ret_type ->
+      match Ctype.repr ret_type with
+      | {desc=Tconstr (_, tyl, _)} ->
+          (* let tyl = List.map (Ctype.expand_head env) tyl in *)
+          let tyl = List.map Ctype.repr tyl in
+          let fvl = List.map (Ctype.free_variables ?env:None) tyl in
+          let _ =
+            List.fold_left2
+              (fun (fv1,fv2) ty (c,n,_) ->
+                match fv2 with [] -> assert false
+                | fv :: fv2 ->
+                    (* fv1 @ fv2 = free_variables of other parameters *)
+                    if (c||n) && constrained (fv1 @ fv2) ty then
+                      raise (Error(loc, Varying_anonymous));
+                    (fv :: fv1, fv2))
+              ([], fvl) tyl required
+          in
+          compute_variance_type env ~check rloc
+            {decl with type_params = tyl; type_private = Private}
+            (for_constr tl)
+      | _ -> assert false
+
+let compute_variance_extension env ~check decl ext rloc =
+  compute_variance_gadt env ~check rloc
+    {decl with type_params = ext.ext_type_params}
+    (ext.ext_args, ext.ext_ret_type)
+
+let compute_variance_decl env ~check decl (required, _ as rloc) =
+  if (decl.type_kind = Type_abstract || decl.type_kind = Type_open)
+       && decl.type_manifest = None then
+    List.map
+      (fun (c, n, i) ->
+        make (not n) (not c) (decl.type_kind <> Type_abstract || i))
+      required
+  else
+  let mn =
+    match decl.type_manifest with
+      None -> []
+    | Some ty -> [false, ty]
+  in
+  match decl.type_kind with
+    Type_abstract | Type_open ->
+      compute_variance_type env ~check rloc decl mn
+  | Type_variant tll ->
+      if List.for_all (fun c -> c.Types.cd_res = None) tll then
+        compute_variance_type env ~check rloc decl
+          (mn @ List.flatten (List.map (fun c -> for_constr c.Types.cd_args)
+                                tll))
+      else begin
+        let mn =
+          List.map (fun (_,ty) -> (Types.Cstr_tuple [ty],None)) mn in
+        let tll =
+          mn @ List.map (fun c -> c.Types.cd_args, c.Types.cd_res) tll in
+        match List.map (compute_variance_gadt env ~check rloc decl) tll with
+        | vari :: rem ->
+            let varl = List.fold_left (List.map2 Variance.union) vari rem in
+            List.map
+              Variance.(fun v -> if mem Pos v && mem Neg v then full else v)
+              varl
+        | _ -> assert false
+      end
+  | Type_record (ftl, _) ->
+      compute_variance_type env ~check rloc decl
+        (mn @ List.map (fun {Types.ld_mutable; ld_type} ->
+             (ld_mutable = Mutable, ld_type)) ftl)
+
+let is_hash id =
+  let s = Ident.name id in
+  String.length s > 0 && s.[0] = '#'
+
+let check_variance_extension env decl ext rloc =
+  (* TODO: refactorize compute_variance_extension *)
+  ignore (compute_variance_extension env ~check:true decl
+    ext.Typedtree.ext_type rloc)
+
+let compute_decl env ~check decl req =
+  compute_variance_decl env ~check decl (req, decl.type_loc)
+
+let check_decl env decl req =
+  ignore (compute_variance_decl env ~check:true decl (req, decl.type_loc))
+
+type prop = Variance.t list
+type req = surface_variance list
+let property : (prop, req) Typedecl_properties.property =
+  let open Typedecl_properties in
+  let eq li1 li2 =
+    try List.for_all2 Variance.eq li1 li2 with _ -> false in
+  let merge ~prop ~new_prop =
+    List.map2 Variance.union prop new_prop in
+  let default decl =
+    List.map (fun _ -> Variance.null) decl.type_params in
+  let compute env decl req =
+    compute_decl env ~check:false decl req in
+  let update_decl decl variance =
+    { decl with type_variance = variance } in
+  let check env id decl req =
+    if is_hash id then () else check_decl env decl req in
+  {
+    eq;
+    merge;
+    default;
+    compute;
+    update_decl;
+    check;
+  }
+
+let transl_variance : Asttypes.variance -> _ = function
+  | Covariant -> (true, false, false)
+  | Contravariant -> (false, true, false)
+  | Invariant -> (false, false, false)
+
+let variance_of_params ptype_params =
+  List.map transl_variance (List.map snd ptype_params)
+
+let variance_of_sdecl sdecl =
+  variance_of_params sdecl.Parsetree.ptype_params
+
+let update_decls env sdecls decls =
+  let required = List.map variance_of_sdecl sdecls in
+  Typedecl_properties.compute_property property env decls required
+
+let update_class_decls env cldecls =
+  let decls, required =
+    List.fold_right
+      (fun (obj_id, obj_abbr, _cl_abbr, _clty, _cltydef, ci) (decls, req) ->
+        (obj_id, obj_abbr) :: decls,
+        variance_of_params ci.Typedtree.ci_params :: req)
+      cldecls ([],[])
+  in
+  let decls =
+    Typedecl_properties.compute_property property env decls required in
+  List.map2
+    (fun (_,decl) (_, _, cl_abbr, clty, cltydef, _) ->
+      let variance = decl.type_variance in
+      (decl, {cl_abbr with type_variance = variance},
+       {clty with cty_variance = variance},
+       {cltydef with clty_variance = variance}))
+    decls cldecls
diff --git a/typing/typedecl_variance.mli b/typing/typedecl_variance.mli
new file mode 100644
index 00000000..99ce18d6
--- /dev/null
+++ b/typing/typedecl_variance.mli
@@ -0,0 +1,62 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Gabriel Scherer, projet Parsifal, INRIA Saclay                       *)
+(*   Rodolphe Lepigre, projet Deducteam, INRIA Saclay                     *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Types
+open Typedecl_properties
+
+type surface_variance = bool * bool * bool
+
+val variance_of_params :
+  (Parsetree.core_type * Asttypes.variance) list -> surface_variance list
+val variance_of_sdecl :
+  Parsetree.type_declaration -> surface_variance list
+
+type prop = Variance.t list
+type req = surface_variance list
+val property : (Variance.t list, req) property
+
+type variance_error =
+| Variance_not_satisfied of int
+| No_variable
+| Variance_not_reflected
+| Variance_not_deducible
+
+type error =
+| Bad_variance of variance_error * surface_variance * surface_variance
+| Varying_anonymous
+
+exception Error of Location.t * error
+
+val check_variance_extension :
+  Env.t -> type_declaration ->
+  Typedtree.extension_constructor -> req * Location.t -> unit
+
+val compute_decl :
+  Env.t -> check:bool -> type_declaration -> req -> prop
+
+val update_decls :
+  Env.t -> Parsetree.type_declaration list ->
+  (Ident.t * type_declaration) list ->
+  (Ident.t * type_declaration) list
+
+val update_class_decls :
+  Env.t ->
+  (Ident.t * Typedecl_properties.decl * Types.type_declaration *
+   Types.class_declaration * Types.class_type_declaration *
+   'a Typedtree.class_infos) list ->
+  (Typedecl_properties.decl * Types.type_declaration *
+   Types.class_declaration * Types.class_type_declaration) list
+(* FIXME: improve this horrible interface *)
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
new file mode 100644
index 00000000..c2d0a0c1
--- /dev/null
+++ b/typing/typedtree.ml
@@ -0,0 +1,841 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Abstract syntax tree after typing *)
+
+open Asttypes
+open Types
+
+(* Value expressions for the core language *)
+
+type partial = Partial | Total
+
+type attribute = Parsetree.attribute
+type attributes = attribute list
+
+type value = Value_pattern
+type computation = Computation_pattern
+
+type _ pattern_category =
+| Value : value pattern_category
+| Computation : computation pattern_category
+
+type pattern = value general_pattern
+and 'k general_pattern = 'k pattern_desc pattern_data
+
+and 'a pattern_data =
+  { pat_desc: 'a;
+    pat_loc: Location.t;
+    pat_extra : (pat_extra * Location.t * attribute list) list;
+    pat_type: type_expr;
+    pat_env: Env.t;
+    pat_attributes: attribute list;
+   }
+
+and pat_extra =
+  | Tpat_constraint of core_type
+  | Tpat_type of Path.t * Longident.t loc
+  | Tpat_open of Path.t * Longident.t loc * Env.t
+  | Tpat_unpack
+
+and 'k pattern_desc =
+  (* value patterns *)
+  | Tpat_any : value pattern_desc
+  | Tpat_var : Ident.t * string loc -> value pattern_desc
+  | Tpat_alias :
+      value general_pattern * Ident.t * string loc -> value pattern_desc
+  | Tpat_constant : constant -> value pattern_desc
+  | Tpat_tuple : value general_pattern list -> value pattern_desc
+  | Tpat_construct :
+      Longident.t loc * constructor_description * value general_pattern list ->
+      value pattern_desc
+  | Tpat_variant :
+      label * value general_pattern option * row_desc ref ->
+      value pattern_desc
+  | Tpat_record :
+      (Longident.t loc * label_description * value general_pattern) list *
+        closed_flag ->
+      value pattern_desc
+  | Tpat_array : value general_pattern list -> value pattern_desc
+  | Tpat_lazy : value general_pattern -> value pattern_desc
+  (* computation patterns *)
+  | Tpat_value : tpat_value_argument -> computation pattern_desc
+  | Tpat_exception : value general_pattern -> computation pattern_desc
+  (* generic constructions *)
+  | Tpat_or :
+      'k general_pattern * 'k general_pattern * row_desc option ->
+      'k pattern_desc
+
+and tpat_value_argument = value general_pattern
+
+and expression =
+  { exp_desc: expression_desc;
+    exp_loc: Location.t;
+    exp_extra: (exp_extra * Location.t * attribute list) list;
+    exp_type: type_expr;
+    exp_env: Env.t;
+    exp_attributes: attribute list;
+   }
+
+and exp_extra =
+  | Texp_constraint of core_type
+  | Texp_coerce of core_type option * core_type
+  | Texp_poly of core_type option
+  | Texp_newtype of string
+
+and expression_desc =
+    Texp_ident of Path.t * Longident.t loc * Types.value_description
+  | Texp_constant of constant
+  | Texp_let of rec_flag * value_binding list * expression
+  | Texp_function of { arg_label : arg_label; param : Ident.t;
+      cases : value case list; partial : partial; }
+  | 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_tuple of expression list
+  | Texp_construct of
+      Longident.t loc * constructor_description * expression list
+  | Texp_variant of label * expression option
+  | Texp_record of {
+      fields : ( Types.label_description * record_label_definition ) array;
+      representation : Types.record_representation;
+      extended_expression : expression option;
+    }
+  | Texp_field of expression * Longident.t loc * label_description
+  | Texp_setfield of
+      expression * Longident.t loc * label_description * expression
+  | Texp_array of expression list
+  | Texp_ifthenelse of expression * expression * expression option
+  | Texp_sequence of expression * expression
+  | Texp_while of expression * expression
+  | Texp_for of
+      Ident.t * Parsetree.pattern * expression * expression * direction_flag *
+        expression
+  | Texp_send of expression * meth * expression option
+  | Texp_new of Path.t * Longident.t loc * Types.class_declaration
+  | Texp_instvar of Path.t * Path.t * string loc
+  | Texp_setinstvar of Path.t * Path.t * string loc * expression
+  | Texp_override of Path.t * (Path.t * string loc * expression) list
+  | Texp_letmodule of
+      Ident.t option * string option loc * Types.module_presence * module_expr *
+        expression
+  | Texp_letexception of extension_constructor * expression
+  | Texp_assert of expression
+  | Texp_lazy of expression
+  | Texp_object of class_structure * string list
+  | Texp_pack of module_expr
+  | Texp_letop of {
+      let_ : binding_op;
+      ands : binding_op list;
+      param : Ident.t;
+      body : value case;
+      partial : partial;
+    }
+  | Texp_unreachable
+  | Texp_extension_constructor of Longident.t loc * Path.t
+  | Texp_open of open_declaration * expression
+
+and meth =
+    Tmeth_name of string
+  | Tmeth_val of Ident.t
+
+and 'k case =
+    {
+     c_lhs: 'k general_pattern;
+     c_guard: expression option;
+     c_rhs: expression;
+    }
+
+and record_label_definition =
+  | Kept of Types.type_expr
+  | Overridden of Longident.t loc * expression
+
+and binding_op =
+  {
+    bop_op_path : Path.t;
+    bop_op_name : string loc;
+    bop_op_val : Types.value_description;
+    bop_op_type : Types.type_expr;
+    bop_exp : expression;
+    bop_loc : Location.t;
+  }
+
+(* Value expressions for the class language *)
+
+and class_expr =
+    {
+     cl_desc: class_expr_desc;
+     cl_loc: Location.t;
+     cl_type: Types.class_type;
+     cl_env: Env.t;
+     cl_attributes: attribute list;
+    }
+
+and class_expr_desc =
+    Tcl_ident of Path.t * Longident.t loc * core_type list
+  | Tcl_structure of class_structure
+  | Tcl_fun of
+      arg_label * pattern * (Ident.t * expression) list
+      * class_expr * partial
+  | Tcl_apply of class_expr * (arg_label * expression option) list
+  | Tcl_let of rec_flag * value_binding list *
+                  (Ident.t * expression) list * class_expr
+  | Tcl_constraint of
+      class_expr * class_type option * string list * string list * Concr.t
+    (* Visible instance variables, methods and concrete methods *)
+  | Tcl_open of open_description * class_expr
+
+and class_structure =
+  {
+   cstr_self: pattern;
+   cstr_fields: class_field list;
+   cstr_type: Types.class_signature;
+   cstr_meths: Ident.t Meths.t;
+  }
+
+and class_field =
+   {
+    cf_desc: class_field_desc;
+    cf_loc: Location.t;
+    cf_attributes: attribute list;
+  }
+
+and class_field_kind =
+  | Tcfk_virtual of core_type
+  | Tcfk_concrete of override_flag * expression
+
+and class_field_desc =
+    Tcf_inherit of
+      override_flag * class_expr * string option * (string * Ident.t) list *
+        (string * Ident.t) list
+    (* Inherited instance variables and concrete methods *)
+  | Tcf_val of string loc * mutable_flag * Ident.t * class_field_kind * bool
+  | Tcf_method of string loc * private_flag * class_field_kind
+  | Tcf_constraint of core_type * core_type
+  | Tcf_initializer of expression
+  | Tcf_attribute of attribute
+
+(* Value expressions for the module language *)
+
+and module_expr =
+  { mod_desc: module_expr_desc;
+    mod_loc: Location.t;
+    mod_type: Types.module_type;
+    mod_env: Env.t;
+    mod_attributes: attribute list;
+   }
+
+and module_type_constraint =
+  Tmodtype_implicit
+| Tmodtype_explicit of module_type
+
+and functor_parameter =
+  | Unit
+  | Named of Ident.t option * string option loc * module_type
+
+and module_expr_desc =
+    Tmod_ident of Path.t * Longident.t loc
+  | Tmod_structure of structure
+  | Tmod_functor of functor_parameter * module_expr
+  | Tmod_apply of module_expr * module_expr * module_coercion
+  | Tmod_constraint of
+      module_expr * Types.module_type * module_type_constraint * module_coercion
+  | Tmod_unpack of expression * Types.module_type
+
+and structure = {
+  str_items : structure_item list;
+  str_type : Types.signature;
+  str_final_env : Env.t;
+}
+
+and structure_item =
+  { str_desc : structure_item_desc;
+    str_loc : Location.t;
+    str_env : Env.t
+  }
+
+and structure_item_desc =
+    Tstr_eval of expression * attributes
+  | Tstr_value of rec_flag * value_binding list
+  | Tstr_primitive of value_description
+  | Tstr_type of rec_flag * type_declaration list
+  | Tstr_typext of type_extension
+  | Tstr_exception of type_exception
+  | Tstr_module of module_binding
+  | Tstr_recmodule of module_binding list
+  | Tstr_modtype of module_type_declaration
+  | Tstr_open of open_declaration
+  | Tstr_class of (class_declaration * string list) list
+  | Tstr_class_type of (Ident.t * string loc * class_type_declaration) list
+  | Tstr_include of include_declaration
+  | Tstr_attribute of attribute
+
+and module_binding =
+    {
+     mb_id: Ident.t option;
+     mb_name: string option loc;
+     mb_presence: module_presence;
+     mb_expr: module_expr;
+     mb_attributes: attribute list;
+     mb_loc: Location.t;
+    }
+
+and value_binding =
+  {
+    vb_pat: pattern;
+    vb_expr: expression;
+    vb_attributes: attributes;
+    vb_loc: Location.t;
+  }
+
+and module_coercion =
+    Tcoerce_none
+  | Tcoerce_structure of (int * module_coercion) list *
+                         (Ident.t * int * module_coercion) list
+  | Tcoerce_functor of module_coercion * module_coercion
+  | Tcoerce_primitive of primitive_coercion
+  | Tcoerce_alias of Env.t * Path.t * module_coercion
+
+and module_type =
+  { mty_desc: module_type_desc;
+    mty_type : Types.module_type;
+    mty_env : Env.t;
+    mty_loc: Location.t;
+    mty_attributes: attribute list;
+   }
+
+and module_type_desc =
+    Tmty_ident of Path.t * Longident.t loc
+  | Tmty_signature of signature
+  | Tmty_functor of functor_parameter * module_type
+  | Tmty_with of module_type * (Path.t * Longident.t loc * with_constraint) list
+  | Tmty_typeof of module_expr
+  | Tmty_alias of Path.t * Longident.t loc
+
+(* Keep primitive type information for type-based lambda-code specialization *)
+and primitive_coercion =
+  {
+    pc_desc: Primitive.description;
+    pc_type: type_expr;
+    pc_env: Env.t;
+    pc_loc : Location.t;
+  }
+
+and signature = {
+  sig_items : signature_item list;
+  sig_type : Types.signature;
+  sig_final_env : Env.t;
+}
+
+and signature_item =
+  { sig_desc: signature_item_desc;
+    sig_env : Env.t; (* BINANNOT ADDED *)
+    sig_loc: Location.t }
+
+and signature_item_desc =
+    Tsig_value of value_description
+  | Tsig_type of rec_flag * type_declaration list
+  | Tsig_typesubst of type_declaration list
+  | Tsig_typext of type_extension
+  | Tsig_exception of type_exception
+  | Tsig_module of module_declaration
+  | Tsig_modsubst of module_substitution
+  | Tsig_recmodule of module_declaration list
+  | Tsig_modtype of module_type_declaration
+  | Tsig_open of open_description
+  | Tsig_include of include_description
+  | Tsig_class of class_description list
+  | Tsig_class_type of class_type_declaration list
+  | Tsig_attribute of attribute
+
+and module_declaration =
+    {
+     md_id: Ident.t option;
+     md_name: string option loc;
+     md_presence: module_presence;
+     md_type: module_type;
+     md_attributes: attribute list;
+     md_loc: Location.t;
+    }
+
+and module_substitution =
+    {
+     ms_id: Ident.t;
+     ms_name: string loc;
+     ms_manifest: Path.t;
+     ms_txt: Longident.t loc;
+     ms_attributes: attributes;
+     ms_loc: Location.t;
+    }
+
+and module_type_declaration =
+    {
+     mtd_id: Ident.t;
+     mtd_name: string loc;
+     mtd_type: module_type option;
+     mtd_attributes: attribute list;
+     mtd_loc: Location.t;
+    }
+
+and 'a open_infos =
+    {
+     open_expr: 'a;
+     open_bound_items: Types.signature;
+     open_override: override_flag;
+     open_env: Env.t;
+     open_loc: Location.t;
+     open_attributes: attribute list;
+    }
+
+and open_description = (Path.t * Longident.t loc) open_infos
+
+and open_declaration = module_expr open_infos
+
+and 'a include_infos =
+    {
+     incl_mod: 'a;
+     incl_type: Types.signature;
+     incl_loc: Location.t;
+     incl_attributes: attribute list;
+    }
+
+and include_description = module_type include_infos
+
+and include_declaration = module_expr include_infos
+
+and with_constraint =
+    Twith_type of type_declaration
+  | Twith_module of Path.t * Longident.t loc
+  | Twith_typesubst of type_declaration
+  | Twith_modsubst of Path.t * Longident.t loc
+
+and core_type =
+(* mutable because of [Typeclass.declare_method] *)
+  { mutable ctyp_desc : core_type_desc;
+    mutable ctyp_type : type_expr;
+    ctyp_env : Env.t; (* BINANNOT ADDED *)
+    ctyp_loc : Location.t;
+    ctyp_attributes: attribute list;
+   }
+
+and core_type_desc =
+    Ttyp_any
+  | Ttyp_var of string
+  | Ttyp_arrow of arg_label * core_type * core_type
+  | Ttyp_tuple of core_type list
+  | Ttyp_constr of Path.t * Longident.t loc * core_type list
+  | Ttyp_object of object_field list * closed_flag
+  | Ttyp_class of Path.t * Longident.t loc * core_type list
+  | Ttyp_alias of core_type * string
+  | Ttyp_variant of row_field list * closed_flag * label list option
+  | Ttyp_poly of string list * core_type
+  | Ttyp_package of package_type
+
+and package_type = {
+  pack_path : Path.t;
+  pack_fields : (Longident.t loc * core_type) list;
+  pack_type : Types.module_type;
+  pack_txt : Longident.t loc;
+}
+
+and row_field = {
+  rf_desc : row_field_desc;
+  rf_loc : Location.t;
+  rf_attributes : attributes;
+}
+
+and row_field_desc =
+    Ttag of string loc * bool * core_type list
+  | Tinherit of core_type
+
+and object_field = {
+  of_desc : object_field_desc;
+  of_loc : Location.t;
+  of_attributes : attributes;
+}
+
+and object_field_desc =
+  | OTtag of string loc * core_type
+  | OTinherit of core_type
+
+and value_description =
+  { val_id: Ident.t;
+    val_name: string loc;
+    val_desc: core_type;
+    val_val: Types.value_description;
+    val_prim: string list;
+    val_loc: Location.t;
+    val_attributes: attribute list;
+    }
+
+and type_declaration =
+  { typ_id: Ident.t;
+    typ_name: string loc;
+    typ_params: (core_type * variance) list;
+    typ_type: Types.type_declaration;
+    typ_cstrs: (core_type * core_type * Location.t) list;
+    typ_kind: type_kind;
+    typ_private: private_flag;
+    typ_manifest: core_type option;
+    typ_loc: Location.t;
+    typ_attributes: attribute list;
+   }
+
+and type_kind =
+    Ttype_abstract
+  | Ttype_variant of constructor_declaration list
+  | Ttype_record of label_declaration list
+  | Ttype_open
+
+and label_declaration =
+    {
+     ld_id: Ident.t;
+     ld_name: string loc;
+     ld_mutable: mutable_flag;
+     ld_type: core_type;
+     ld_loc: Location.t;
+     ld_attributes: attribute list;
+    }
+
+and constructor_declaration =
+    {
+     cd_id: Ident.t;
+     cd_name: string loc;
+     cd_args: constructor_arguments;
+     cd_res: core_type option;
+     cd_loc: Location.t;
+     cd_attributes: attribute list;
+    }
+
+and constructor_arguments =
+  | Cstr_tuple of core_type list
+  | Cstr_record of label_declaration list
+
+and type_extension =
+  {
+    tyext_path: Path.t;
+    tyext_txt: Longident.t loc;
+    tyext_params: (core_type * variance) list;
+    tyext_constructors: extension_constructor list;
+    tyext_private: private_flag;
+    tyext_loc: Location.t;
+    tyext_attributes: attribute list;
+  }
+
+and type_exception =
+  {
+    tyexn_constructor: extension_constructor;
+    tyexn_loc: Location.t;
+    tyexn_attributes: attribute list;
+  }
+
+and extension_constructor =
+  {
+    ext_id: Ident.t;
+    ext_name: string loc;
+    ext_type: Types.extension_constructor;
+    ext_kind: extension_constructor_kind;
+    ext_loc: Location.t;
+    ext_attributes: attribute list;
+  }
+
+and extension_constructor_kind =
+    Text_decl of constructor_arguments * core_type option
+  | Text_rebind of Path.t * Longident.t loc
+
+and class_type =
+    {
+     cltyp_desc: class_type_desc;
+     cltyp_type: Types.class_type;
+     cltyp_env: Env.t;
+     cltyp_loc: Location.t;
+     cltyp_attributes: attribute list;
+    }
+
+and class_type_desc =
+    Tcty_constr of Path.t * Longident.t loc * core_type list
+  | Tcty_signature of class_signature
+  | Tcty_arrow of arg_label * core_type * class_type
+  | Tcty_open of open_description * class_type
+
+and class_signature = {
+    csig_self: core_type;
+    csig_fields: class_type_field list;
+    csig_type: Types.class_signature;
+  }
+
+and class_type_field = {
+    ctf_desc: class_type_field_desc;
+    ctf_loc: Location.t;
+    ctf_attributes: attribute list;
+  }
+
+and class_type_field_desc =
+  | Tctf_inherit of class_type
+  | Tctf_val of (string * mutable_flag * virtual_flag * core_type)
+  | Tctf_method of (string * private_flag * virtual_flag * core_type)
+  | Tctf_constraint of (core_type * core_type)
+  | Tctf_attribute of attribute
+
+and class_declaration =
+  class_expr class_infos
+
+and class_description =
+  class_type class_infos
+
+and class_type_declaration =
+  class_type class_infos
+
+and 'a class_infos =
+  { ci_virt: virtual_flag;
+    ci_params: (core_type * variance) list;
+    ci_id_name: string loc;
+    ci_id_class: Ident.t;
+    ci_id_class_type: Ident.t;
+    ci_id_object: Ident.t;
+    ci_id_typehash: Ident.t;
+    ci_expr: 'a;
+    ci_decl: Types.class_declaration;
+    ci_type_decl: Types.class_type_declaration;
+    ci_loc: Location.t;
+    ci_attributes: attribute list;
+   }
+
+(* Auxiliary functions over the a.s.t. *)
+
+let as_computation_pattern (p : pattern) : computation general_pattern =
+  {
+    pat_desc = Tpat_value p;
+    pat_loc = p.pat_loc;
+    pat_extra = [];
+    pat_type = p.pat_type;
+    pat_env = p.pat_env;
+    pat_attributes = [];
+  }
+
+let rec classify_pattern_desc : type k . k pattern_desc -> k pattern_category =
+  function
+  | Tpat_alias _ -> Value
+  | Tpat_tuple _ -> Value
+  | Tpat_construct _ -> Value
+  | Tpat_variant _ -> Value
+  | Tpat_record _ -> Value
+  | Tpat_array _ -> Value
+  | Tpat_lazy _ -> Value
+  | Tpat_any -> Value
+  | Tpat_var _ -> Value
+  | Tpat_constant _ -> Value
+
+  | Tpat_value _ -> Computation
+  | Tpat_exception _ -> Computation
+
+  | Tpat_or(p1, p2, _) ->
+     begin match classify_pattern p1, classify_pattern p2 with
+     | Value, Value -> Value
+     | Computation, Computation -> Computation
+     end
+
+and classify_pattern
+  : type k . k general_pattern -> k pattern_category
+  = fun pat ->
+  classify_pattern_desc pat.pat_desc
+
+type pattern_action =
+  { f : 'k . 'k general_pattern -> unit }
+let shallow_iter_pattern_desc
+  : type k . pattern_action -> k pattern_desc -> unit
+  = fun f -> function
+  | Tpat_alias(p, _, _) -> f.f p
+  | Tpat_tuple patl -> List.iter f.f patl
+  | Tpat_construct(_, _, patl) -> List.iter f.f patl
+  | Tpat_variant(_, pat, _) -> Option.iter f.f pat
+  | Tpat_record (lbl_pat_list, _) ->
+      List.iter (fun (_, _, pat) -> f.f pat) lbl_pat_list
+  | Tpat_array patl -> List.iter f.f patl
+  | Tpat_lazy p -> f.f p
+  | Tpat_any
+  | Tpat_var _
+  | Tpat_constant _ -> ()
+  | Tpat_value p -> f.f p
+  | Tpat_exception p -> f.f p
+  | Tpat_or(p1, p2, _) -> f.f p1; f.f p2
+
+type pattern_transformation =
+  { f : 'k . 'k general_pattern -> 'k general_pattern }
+let shallow_map_pattern_desc
+  : type k . pattern_transformation -> k pattern_desc -> k pattern_desc
+  = fun f d -> match d with
+  | Tpat_alias (p1, id, s) ->
+      Tpat_alias (f.f p1, id, s)
+  | Tpat_tuple pats ->
+      Tpat_tuple (List.map f.f pats)
+  | Tpat_record (lpats, closed) ->
+      Tpat_record (List.map (fun (lid, l,p) -> lid, l, f.f p) lpats, closed)
+  | Tpat_construct (lid, c,pats) ->
+      Tpat_construct (lid, c, List.map f.f pats)
+  | Tpat_array pats ->
+      Tpat_array (List.map f.f pats)
+  | Tpat_lazy p1 -> Tpat_lazy (f.f p1)
+  | Tpat_variant (x1, Some p1, x2) ->
+      Tpat_variant (x1, Some (f.f p1), x2)
+  | Tpat_var _
+  | Tpat_constant _
+  | Tpat_any
+  | Tpat_variant (_,None,_) -> d
+  | Tpat_value p -> Tpat_value (f.f p)
+  | Tpat_exception p -> Tpat_exception (f.f p)
+  | Tpat_or (p1,p2,path) ->
+      Tpat_or (f.f p1, f.f p2, path)
+
+let rec iter_general_pattern
+  : type k . pattern_action -> k general_pattern -> unit
+  = fun f p ->
+  f.f p;
+  shallow_iter_pattern_desc
+    { f = fun p -> iter_general_pattern f p }
+    p.pat_desc
+
+let iter_pattern (f : pattern -> unit) =
+  iter_general_pattern
+    { f = fun (type k) (p : k general_pattern) ->
+          match classify_pattern p with
+          | Value -> f p
+          | Computation -> () }
+
+let rec map_general_pattern
+  : type k . pattern_transformation -> k general_pattern -> k general_pattern
+  = fun f p ->
+  let pat_desc =
+    shallow_map_pattern_desc
+      { f = fun p -> map_general_pattern f p }
+      p.pat_desc in
+  f.f { p with pat_desc }
+
+type pattern_predicate = { f : 'k . 'k general_pattern -> bool }
+let exists_general_pattern (f : pattern_predicate) p =
+  let exception Found in
+  match
+    iter_general_pattern
+      { f = fun p -> if f.f p then raise Found else () }
+      p
+  with
+  | exception Found -> true
+  | () -> false
+
+let exists_pattern (f : pattern -> bool) =
+  exists_general_pattern
+    { f = fun (type k) (p : k general_pattern) ->
+          match classify_pattern p with
+          | Value -> f p
+          | Computation -> false }
+
+
+(* List the identifiers bound by a pattern or a let *)
+
+let rec iter_bound_idents
+  : type k . _ -> k general_pattern -> _
+  = fun f pat ->
+  match pat.pat_desc with
+  | Tpat_var (id,s) ->
+     f (id,s,pat.pat_type)
+  | Tpat_alias(p, id, s) ->
+      iter_bound_idents f p;
+      f (id,s,pat.pat_type)
+  | Tpat_or(p1, _, _) ->
+      (* Invariant : both arguments bind the same variables *)
+      iter_bound_idents f p1
+  | d ->
+     shallow_iter_pattern_desc
+       { f = fun p -> iter_bound_idents f p }
+       d
+
+let rev_pat_bound_idents_full pat =
+  let idents_full = ref [] in
+  let add id_full = idents_full := id_full :: !idents_full in
+  iter_bound_idents add pat;
+  !idents_full
+
+let rev_only_idents idents_full =
+  List.rev_map (fun (id,_,_) -> id) idents_full
+
+let pat_bound_idents_full pat =
+  List.rev (rev_pat_bound_idents_full pat)
+let pat_bound_idents pat =
+  rev_only_idents (rev_pat_bound_idents_full pat)
+
+let rev_let_bound_idents_full bindings =
+  let idents_full = ref [] in
+  let add id_full = idents_full := id_full :: !idents_full in
+  List.iter (fun vb -> iter_bound_idents add vb.vb_pat) bindings;
+  !idents_full
+
+let let_bound_idents_full bindings =
+  List.rev (rev_let_bound_idents_full bindings)
+let let_bound_idents pat =
+  rev_only_idents (rev_let_bound_idents_full pat)
+
+let alpha_var env id = List.assoc id env
+
+let rec alpha_pat
+  : type k . _ -> k general_pattern -> k general_pattern
+  = fun env p -> match p.pat_desc with
+  | Tpat_var (id, s) -> (* note the ``Not_found'' case *)
+      {p with pat_desc =
+       try Tpat_var (alpha_var env id, s) with
+       | Not_found -> Tpat_any}
+  | Tpat_alias (p1, id, s) ->
+      let new_p =  alpha_pat env p1 in
+      begin try
+        {p with pat_desc = Tpat_alias (new_p, alpha_var env id, s)}
+      with
+      | Not_found -> new_p
+      end
+  | d ->
+     let pat_desc =
+       shallow_map_pattern_desc { f = fun p -> alpha_pat env p } d in
+     {p with pat_desc}
+
+let mkloc = Location.mkloc
+let mknoloc = Location.mknoloc
+
+let split_pattern pat =
+  let combine_opts merge p1 p2 =
+    match p1, p2 with
+    | None, None -> None
+    | Some p, None
+    | None, Some p ->
+        Some p
+    | Some p1, Some p2 ->
+        Some (merge p1 p2)
+  in
+  let into pat p1 p2 =
+    (* The third parameter of [Tpat_or] is [Some _] only for "#typ"
+       patterns, which we do *not* expand. Hence we can put [None] here. *)
+    { pat with pat_desc = Tpat_or (p1, p2, None) } in
+  let rec split_pattern cpat =
+    match cpat.pat_desc with
+    | Tpat_value p ->
+        Some p, None
+    | Tpat_exception p ->
+        None, Some p
+    | Tpat_or (cp1, cp2, _) ->
+        let vals1, exns1 = split_pattern cp1 in
+        let vals2, exns2 = split_pattern cp2 in
+        combine_opts (into cpat) vals1 vals2,
+        (* We could change the pattern type for exception patterns to
+           [Predef.exn], but it doesn't really matter. *)
+        combine_opts (into cpat) exns1 exns2
+  in
+  split_pattern pat
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
new file mode 100644
index 00000000..a8f8d249
--- /dev/null
+++ b/typing/typedtree.mli
@@ -0,0 +1,805 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Abstract syntax tree after typing *)
+
+
+(** By comparison with {!Parsetree}:
+    - Every {!Longindent.t} is accompanied by a resolved {!Path.t}.
+
+*)
+
+open Asttypes
+
+(* Value expressions for the core language *)
+
+type partial = Partial | Total
+
+(** {1 Extension points} *)
+
+type attribute = Parsetree.attribute
+type attributes = attribute list
+
+(** {1 Core language} *)
+
+type value = Value_pattern
+type computation = Computation_pattern
+
+type _ pattern_category =
+| Value : value pattern_category
+| Computation : computation pattern_category
+
+type pattern = value general_pattern
+and 'k general_pattern = 'k pattern_desc pattern_data
+
+and 'a pattern_data =
+  { pat_desc: 'a;
+    pat_loc: Location.t;
+    pat_extra : (pat_extra * Location.t * attributes) list;
+    pat_type: Types.type_expr;
+    pat_env: Env.t;
+    pat_attributes: attributes;
+   }
+
+and pat_extra =
+  | Tpat_constraint of core_type
+        (** P : T          { pat_desc = P
+                           ; pat_extra = (Tpat_constraint T, _, _) :: ... }
+         *)
+  | Tpat_type of Path.t * Longident.t loc
+        (** #tconst        { pat_desc = disjunction
+                           ; pat_extra = (Tpat_type (P, "tconst"), _, _) :: ...}
+
+                           where [disjunction] is a [Tpat_or _] representing the
+                           branches of [tconst].
+         *)
+  | Tpat_open of Path.t * Longident.t loc * Env.t
+  | Tpat_unpack
+        (** (module P)     { pat_desc  = Tpat_var "P"
+                           ; pat_extra = (Tpat_unpack, _, _) :: ... }
+         *)
+
+and 'k pattern_desc =
+  (* value patterns *)
+  | Tpat_any : value pattern_desc
+        (** _ *)
+  | Tpat_var : Ident.t * string loc -> value pattern_desc
+        (** x *)
+  | Tpat_alias :
+      value general_pattern * Ident.t * string loc -> value pattern_desc
+        (** P as a *)
+  | Tpat_constant : constant -> value pattern_desc
+        (** 1, 'a', "true", 1.0, 1l, 1L, 1n *)
+  | Tpat_tuple : value general_pattern list -> value pattern_desc
+        (** (P1, ..., Pn)
+
+            Invariant: n >= 2
+         *)
+  | Tpat_construct :
+      Longident.t loc * Types.constructor_description *
+        value general_pattern list ->
+      value pattern_desc
+        (** C                []
+            C P              [P]
+            C (P1, ..., Pn)  [P1; ...; Pn]
+          *)
+  | Tpat_variant :
+      label * value general_pattern option * Types.row_desc ref ->
+      value pattern_desc
+        (** `A             (None)
+            `A P           (Some P)
+
+            See {!Types.row_desc} for an explanation of the last parameter.
+         *)
+  | Tpat_record :
+      (Longident.t loc * Types.label_description * value general_pattern) list *
+        closed_flag ->
+      value pattern_desc
+        (** { l1=P1; ...; ln=Pn }     (flag = Closed)
+            { l1=P1; ...; ln=Pn; _}   (flag = Open)
+
+            Invariant: n > 0
+         *)
+  | Tpat_array : value general_pattern list -> value pattern_desc
+        (** [| P1; ...; Pn |] *)
+  | Tpat_lazy : value general_pattern -> value pattern_desc
+        (** lazy P *)
+  (* computation patterns *)
+  | Tpat_value : tpat_value_argument -> computation pattern_desc
+        (** P
+
+            Invariant: Tpat_value pattern should not carry
+            pat_attributes or pat_extra metadata coming from user
+            syntax, which must be on the inner pattern node -- to
+            facilitate searching for a certain value pattern
+            constructor with a specific attributed.
+
+            To enforce this restriction, we made the argument of
+            the Tpat_value constructor a private synonym of [pattern],
+            requiring you to use the [as_computation_pattern] function
+            below instead of using the [Tpat_value] constructor directly.
+         *)
+  | Tpat_exception : value general_pattern -> computation pattern_desc
+        (** exception P *)
+  (* generic constructions *)
+  | Tpat_or :
+      'k general_pattern * 'k general_pattern * Types.row_desc option ->
+      'k pattern_desc
+        (** P1 | P2
+
+            [row_desc] = [Some _] when translating [Ppat_type _],
+                         [None] otherwise.
+         *)
+
+and tpat_value_argument = private value general_pattern
+
+and expression =
+  { exp_desc: expression_desc;
+    exp_loc: Location.t;
+    exp_extra: (exp_extra * Location.t * attributes) list;
+    exp_type: Types.type_expr;
+    exp_env: Env.t;
+    exp_attributes: attributes;
+   }
+
+and exp_extra =
+  | Texp_constraint of core_type
+        (** E : T *)
+  | Texp_coerce of core_type option * core_type
+        (** E :> T           [Texp_coerce (None, T)]
+            E : T0 :> T      [Texp_coerce (Some T0, T)]
+         *)
+  | Texp_poly of core_type option
+        (** Used for method bodies. *)
+  | Texp_newtype of string
+        (** fun (type t) ->  *)
+
+and expression_desc =
+    Texp_ident of Path.t * Longident.t loc * Types.value_description
+        (** x
+            M.x
+         *)
+  | Texp_constant of constant
+        (** 1, 'a', "true", 1.0, 1l, 1L, 1n *)
+  | Texp_let of rec_flag * value_binding list * expression
+        (** let P1 = E1 and ... and Pn = EN in E       (flag = Nonrecursive)
+            let rec P1 = E1 and ... and Pn = EN in E   (flag = Recursive)
+         *)
+  | Texp_function of { arg_label : arg_label; param : Ident.t;
+      cases : value case list; partial : partial; }
+        (** [Pexp_fun] and [Pexp_function] both translate to [Texp_function].
+            See {!Parsetree} for more details.
+
+            [param] is the identifier that is to be used to name the
+            parameter of the function.
+
+            partial =
+              [Partial] if the pattern match is partial
+              [Total] otherwise.
+         *)
+  | Texp_apply of expression * (arg_label * expression option) list
+        (** E0 ~l1:E1 ... ~ln:En
+
+            The expression can be None if the expression is abstracted over
+            this argument. It currently appears when a label is applied.
+
+            For example:
+            let f x ~y = x + y in
+            f ~y:3
+
+            The resulting typedtree for the application is:
+            Texp_apply (Texp_ident "f/1037",
+                        [(Nolabel, None);
+                         (Labelled "y", Some (Texp_constant Const_int 3))
+                        ])
+         *)
+  | Texp_match of expression * computation case list * partial
+        (** match E0 with
+            | P1 -> E1
+            | P2 | exception P3 -> E2
+            | exception P4 -> E3
+
+            [Texp_match (E0, [(P1, E1); (P2 | exception P3, E2);
+                              (exception P4, E3)], _)]
+         *)
+  | Texp_try of expression * value case list
+        (** try E with P1 -> E1 | ... | PN -> EN *)
+  | Texp_tuple of expression list
+        (** (E1, ..., EN) *)
+  | Texp_construct of
+      Longident.t loc * Types.constructor_description * expression list
+        (** C                []
+            C E              [E]
+            C (E1, ..., En)  [E1;...;En]
+         *)
+  | Texp_variant of label * expression option
+  | Texp_record of {
+      fields : ( Types.label_description * record_label_definition ) array;
+      representation : Types.record_representation;
+      extended_expression : expression option;
+    }
+        (** { l1=P1; ...; ln=Pn }           (extended_expression = None)
+            { E0 with l1=P1; ...; ln=Pn }   (extended_expression = Some E0)
+
+            Invariant: n > 0
+
+            If the type is { l1: t1; l2: t2 }, the expression
+            { E0 with t2=P2 } is represented as
+            Texp_record
+              { fields = [| l1, Kept t1; l2 Override P2 |]; representation;
+                extended_expression = Some E0 }
+        *)
+  | Texp_field of expression * Longident.t loc * Types.label_description
+  | Texp_setfield of
+      expression * Longident.t loc * Types.label_description * expression
+  | Texp_array of expression list
+  | Texp_ifthenelse of expression * expression * expression option
+  | Texp_sequence of expression * expression
+  | Texp_while of expression * expression
+  | Texp_for of
+      Ident.t * Parsetree.pattern * expression * expression * direction_flag *
+        expression
+  | Texp_send of expression * meth * expression option
+  | Texp_new of Path.t * Longident.t loc * Types.class_declaration
+  | Texp_instvar of Path.t * Path.t * string loc
+  | Texp_setinstvar of Path.t * Path.t * string loc * expression
+  | Texp_override of Path.t * (Path.t * string loc * expression) list
+  | Texp_letmodule of
+      Ident.t option * string option loc * Types.module_presence * module_expr *
+        expression
+  | Texp_letexception of extension_constructor * expression
+  | Texp_assert of expression
+  | Texp_lazy of expression
+  | Texp_object of class_structure * string list
+  | Texp_pack of module_expr
+  | Texp_letop of {
+      let_ : binding_op;
+      ands : binding_op list;
+      param : Ident.t;
+      body : value case;
+      partial : partial;
+    }
+  | Texp_unreachable
+  | Texp_extension_constructor of Longident.t loc * Path.t
+  | Texp_open of open_declaration * expression
+        (** let open[!] M in e *)
+
+and meth =
+    Tmeth_name of string
+  | Tmeth_val of Ident.t
+
+and 'k case =
+    {
+     c_lhs: 'k general_pattern;
+     c_guard: expression option;
+     c_rhs: expression;
+    }
+
+and record_label_definition =
+  | Kept of Types.type_expr
+  | Overridden of Longident.t loc * expression
+
+and binding_op =
+  {
+    bop_op_path : Path.t;
+    bop_op_name : string loc;
+    bop_op_val : Types.value_description;
+    bop_op_type : Types.type_expr;
+    (* This is the type at which the operator was used.
+       It is always an instance of [bop_op_val.val_type] *)
+    bop_exp : expression;
+    bop_loc : Location.t;
+  }
+
+(* Value expressions for the class language *)
+
+and class_expr =
+    {
+     cl_desc: class_expr_desc;
+     cl_loc: Location.t;
+     cl_type: Types.class_type;
+     cl_env: Env.t;
+     cl_attributes: attributes;
+    }
+
+and class_expr_desc =
+    Tcl_ident of Path.t * Longident.t loc * core_type list
+  | Tcl_structure of class_structure
+  | Tcl_fun of
+      arg_label * pattern * (Ident.t * expression) list
+      * class_expr * partial
+  | Tcl_apply of class_expr * (arg_label * expression option) list
+  | Tcl_let of rec_flag * value_binding list *
+                  (Ident.t * expression) list * class_expr
+  | Tcl_constraint of
+      class_expr * class_type option * string list * string list * Types.Concr.t
+  (* Visible instance variables, methods and concrete methods *)
+  | Tcl_open of open_description * class_expr
+
+and class_structure =
+  {
+   cstr_self: pattern;
+   cstr_fields: class_field list;
+   cstr_type: Types.class_signature;
+   cstr_meths: Ident.t Types.Meths.t;
+  }
+
+and class_field =
+   {
+    cf_desc: class_field_desc;
+    cf_loc: Location.t;
+    cf_attributes: attributes;
+  }
+
+and class_field_kind =
+  | Tcfk_virtual of core_type
+  | Tcfk_concrete of override_flag * expression
+
+and class_field_desc =
+    Tcf_inherit of
+      override_flag * class_expr * string option * (string * Ident.t) list *
+        (string * Ident.t) list
+    (* Inherited instance variables and concrete methods *)
+  | Tcf_val of string loc * mutable_flag * Ident.t * class_field_kind * bool
+  | Tcf_method of string loc * private_flag * class_field_kind
+  | Tcf_constraint of core_type * core_type
+  | Tcf_initializer of expression
+  | Tcf_attribute of attribute
+
+(* Value expressions for the module language *)
+
+and module_expr =
+  { mod_desc: module_expr_desc;
+    mod_loc: Location.t;
+    mod_type: Types.module_type;
+    mod_env: Env.t;
+    mod_attributes: attributes;
+   }
+
+(** Annotations for [Tmod_constraint]. *)
+and module_type_constraint =
+  | Tmodtype_implicit
+  (** The module type constraint has been synthesized during typechecking. *)
+  | Tmodtype_explicit of module_type
+  (** The module type was in the source file. *)
+
+and functor_parameter =
+  | Unit
+  | Named of Ident.t option * string option loc * module_type
+
+and module_expr_desc =
+    Tmod_ident of Path.t * Longident.t loc
+  | Tmod_structure of structure
+  | Tmod_functor of functor_parameter * module_expr
+  | Tmod_apply of module_expr * module_expr * module_coercion
+  | Tmod_constraint of
+      module_expr * Types.module_type * module_type_constraint * module_coercion
+    (** ME          (constraint = Tmodtype_implicit)
+        (ME : MT)   (constraint = Tmodtype_explicit MT)
+     *)
+  | Tmod_unpack of expression * Types.module_type
+
+and structure = {
+  str_items : structure_item list;
+  str_type : Types.signature;
+  str_final_env : Env.t;
+}
+
+and structure_item =
+  { str_desc : structure_item_desc;
+    str_loc : Location.t;
+    str_env : Env.t
+  }
+
+and structure_item_desc =
+    Tstr_eval of expression * attributes
+  | Tstr_value of rec_flag * value_binding list
+  | Tstr_primitive of value_description
+  | Tstr_type of rec_flag * type_declaration list
+  | Tstr_typext of type_extension
+  | Tstr_exception of type_exception
+  | Tstr_module of module_binding
+  | Tstr_recmodule of module_binding list
+  | Tstr_modtype of module_type_declaration
+  | Tstr_open of open_declaration
+  | Tstr_class of (class_declaration * string list) list
+  | Tstr_class_type of (Ident.t * string loc * class_type_declaration) list
+  | Tstr_include of include_declaration
+  | Tstr_attribute of attribute
+
+and module_binding =
+    {
+     mb_id: Ident.t option;
+     mb_name: string option loc;
+     mb_presence: Types.module_presence;
+     mb_expr: module_expr;
+     mb_attributes: attributes;
+     mb_loc: Location.t;
+    }
+
+and value_binding =
+  {
+    vb_pat: pattern;
+    vb_expr: expression;
+    vb_attributes: attributes;
+    vb_loc: Location.t;
+  }
+
+and module_coercion =
+    Tcoerce_none
+  | Tcoerce_structure of (int * module_coercion) list *
+                         (Ident.t * int * module_coercion) list
+  | Tcoerce_functor of module_coercion * module_coercion
+  | Tcoerce_primitive of primitive_coercion
+  | Tcoerce_alias of Env.t * Path.t * module_coercion
+
+and module_type =
+  { mty_desc: module_type_desc;
+    mty_type : Types.module_type;
+    mty_env : Env.t;
+    mty_loc: Location.t;
+    mty_attributes: attributes;
+   }
+
+and module_type_desc =
+    Tmty_ident of Path.t * Longident.t loc
+  | Tmty_signature of signature
+  | Tmty_functor of functor_parameter * module_type
+  | Tmty_with of module_type * (Path.t * Longident.t loc * with_constraint) list
+  | Tmty_typeof of module_expr
+  | Tmty_alias of Path.t * Longident.t loc
+
+and primitive_coercion =
+  {
+    pc_desc: Primitive.description;
+    pc_type: Types.type_expr;
+    pc_env: Env.t;
+    pc_loc : Location.t;
+  }
+
+and signature = {
+  sig_items : signature_item list;
+  sig_type : Types.signature;
+  sig_final_env : Env.t;
+}
+
+and signature_item =
+  { sig_desc: signature_item_desc;
+    sig_env : Env.t; (* BINANNOT ADDED *)
+    sig_loc: Location.t }
+
+and signature_item_desc =
+    Tsig_value of value_description
+  | Tsig_type of rec_flag * type_declaration list
+  | Tsig_typesubst of type_declaration list
+  | Tsig_typext of type_extension
+  | Tsig_exception of type_exception
+  | Tsig_module of module_declaration
+  | Tsig_modsubst of module_substitution
+  | Tsig_recmodule of module_declaration list
+  | Tsig_modtype of module_type_declaration
+  | Tsig_open of open_description
+  | Tsig_include of include_description
+  | Tsig_class of class_description list
+  | Tsig_class_type of class_type_declaration list
+  | Tsig_attribute of attribute
+
+and module_declaration =
+    {
+     md_id: Ident.t option;
+     md_name: string option loc;
+     md_presence: Types.module_presence;
+     md_type: module_type;
+     md_attributes: attributes;
+     md_loc: Location.t;
+    }
+
+and module_substitution =
+    {
+     ms_id: Ident.t;
+     ms_name: string loc;
+     ms_manifest: Path.t;
+     ms_txt: Longident.t loc;
+     ms_attributes: attributes;
+     ms_loc: Location.t;
+    }
+
+and module_type_declaration =
+    {
+     mtd_id: Ident.t;
+     mtd_name: string loc;
+     mtd_type: module_type option;
+     mtd_attributes: attributes;
+     mtd_loc: Location.t;
+    }
+
+and 'a open_infos =
+    {
+     open_expr: 'a;
+     open_bound_items: Types.signature;
+     open_override: override_flag;
+     open_env: Env.t;
+     open_loc: Location.t;
+     open_attributes: attribute list;
+    }
+
+and open_description = (Path.t * Longident.t loc) open_infos
+
+and open_declaration = module_expr open_infos
+
+
+and 'a include_infos =
+    {
+     incl_mod: 'a;
+     incl_type: Types.signature;
+     incl_loc: Location.t;
+     incl_attributes: attribute list;
+    }
+
+and include_description = module_type include_infos
+
+and include_declaration = module_expr include_infos
+
+and with_constraint =
+    Twith_type of type_declaration
+  | Twith_module of Path.t * Longident.t loc
+  | Twith_typesubst of type_declaration
+  | Twith_modsubst of Path.t * Longident.t loc
+
+and core_type =
+  { mutable ctyp_desc : core_type_desc;
+      (** mutable because of [Typeclass.declare_method] *)
+    mutable ctyp_type : Types.type_expr;
+      (** mutable because of [Typeclass.declare_method] *)
+    ctyp_env : Env.t; (* BINANNOT ADDED *)
+    ctyp_loc : Location.t;
+    ctyp_attributes: attributes;
+   }
+
+and core_type_desc =
+    Ttyp_any
+  | Ttyp_var of string
+  | Ttyp_arrow of arg_label * core_type * core_type
+  | Ttyp_tuple of core_type list
+  | Ttyp_constr of Path.t * Longident.t loc * core_type list
+  | Ttyp_object of object_field list * closed_flag
+  | Ttyp_class of Path.t * Longident.t loc * core_type list
+  | Ttyp_alias of core_type * string
+  | Ttyp_variant of row_field list * closed_flag * label list option
+  | Ttyp_poly of string list * core_type
+  | Ttyp_package of package_type
+
+and package_type = {
+  pack_path : Path.t;
+  pack_fields : (Longident.t loc * core_type) list;
+  pack_type : Types.module_type;
+  pack_txt : Longident.t loc;
+}
+
+and row_field = {
+  rf_desc : row_field_desc;
+  rf_loc : Location.t;
+  rf_attributes : attributes;
+}
+
+and row_field_desc =
+    Ttag of string loc * bool * core_type list
+  | Tinherit of core_type
+
+and object_field = {
+  of_desc : object_field_desc;
+  of_loc : Location.t;
+  of_attributes : attributes;
+}
+
+and object_field_desc =
+  | OTtag of string loc * core_type
+  | OTinherit of core_type
+
+and value_description =
+  { val_id: Ident.t;
+    val_name: string loc;
+    val_desc: core_type;
+    val_val: Types.value_description;
+    val_prim: string list;
+    val_loc: Location.t;
+    val_attributes: attributes;
+    }
+
+and type_declaration =
+  {
+    typ_id: Ident.t;
+    typ_name: string loc;
+    typ_params: (core_type * variance) list;
+    typ_type: Types.type_declaration;
+    typ_cstrs: (core_type * core_type * Location.t) list;
+    typ_kind: type_kind;
+    typ_private: private_flag;
+    typ_manifest: core_type option;
+    typ_loc: Location.t;
+    typ_attributes: attributes;
+   }
+
+and type_kind =
+    Ttype_abstract
+  | Ttype_variant of constructor_declaration list
+  | Ttype_record of label_declaration list
+  | Ttype_open
+
+and label_declaration =
+    {
+     ld_id: Ident.t;
+     ld_name: string loc;
+     ld_mutable: mutable_flag;
+     ld_type: core_type;
+     ld_loc: Location.t;
+     ld_attributes: attributes;
+    }
+
+and constructor_declaration =
+    {
+     cd_id: Ident.t;
+     cd_name: string loc;
+     cd_args: constructor_arguments;
+     cd_res: core_type option;
+     cd_loc: Location.t;
+     cd_attributes: attributes;
+    }
+
+and constructor_arguments =
+  | Cstr_tuple of core_type list
+  | Cstr_record of label_declaration list
+
+and type_extension =
+  {
+    tyext_path: Path.t;
+    tyext_txt: Longident.t loc;
+    tyext_params: (core_type * variance) list;
+    tyext_constructors: extension_constructor list;
+    tyext_private: private_flag;
+    tyext_loc: Location.t;
+    tyext_attributes: attributes;
+  }
+
+and type_exception =
+  {
+    tyexn_constructor: extension_constructor;
+    tyexn_loc: Location.t;
+    tyexn_attributes: attribute list;
+  }
+
+and extension_constructor =
+  {
+    ext_id: Ident.t;
+    ext_name: string loc;
+    ext_type : Types.extension_constructor;
+    ext_kind : extension_constructor_kind;
+    ext_loc : Location.t;
+    ext_attributes: attributes;
+  }
+
+and extension_constructor_kind =
+    Text_decl of constructor_arguments * core_type option
+  | Text_rebind of Path.t * Longident.t loc
+
+and class_type =
+    {
+     cltyp_desc: class_type_desc;
+     cltyp_type: Types.class_type;
+     cltyp_env: Env.t;
+     cltyp_loc: Location.t;
+     cltyp_attributes: attributes;
+    }
+
+and class_type_desc =
+    Tcty_constr of Path.t * Longident.t loc * core_type list
+  | Tcty_signature of class_signature
+  | Tcty_arrow of arg_label * core_type * class_type
+  | Tcty_open of open_description * class_type
+
+and class_signature = {
+    csig_self : core_type;
+    csig_fields : class_type_field list;
+    csig_type : Types.class_signature;
+  }
+
+and class_type_field = {
+    ctf_desc: class_type_field_desc;
+    ctf_loc: Location.t;
+    ctf_attributes: attributes;
+  }
+
+and class_type_field_desc =
+  | Tctf_inherit of class_type
+  | Tctf_val of (string * mutable_flag * virtual_flag * core_type)
+  | Tctf_method of (string * private_flag * virtual_flag * core_type)
+  | Tctf_constraint of (core_type * core_type)
+  | Tctf_attribute of attribute
+
+and class_declaration =
+  class_expr class_infos
+
+and class_description =
+  class_type class_infos
+
+and class_type_declaration =
+  class_type class_infos
+
+and 'a class_infos =
+  { ci_virt: virtual_flag;
+    ci_params: (core_type * variance) list;
+    ci_id_name : string loc;
+    ci_id_class: Ident.t;
+    ci_id_class_type : Ident.t;
+    ci_id_object : Ident.t;
+    ci_id_typehash : Ident.t;
+    ci_expr: 'a;
+    ci_decl: Types.class_declaration;
+    ci_type_decl : Types.class_type_declaration;
+    ci_loc: Location.t;
+    ci_attributes: attributes;
+   }
+
+(* Auxiliary functions over the a.s.t. *)
+
+(** [as_computation_pattern p] is a computation pattern with description
+    [Tpat_value p], which enforces a correct placement of pat_attributes
+    and pat_extra metadata (on the inner value pattern, rather than on
+    the computation pattern). *)
+val as_computation_pattern: pattern -> computation general_pattern
+
+val classify_pattern_desc: 'k pattern_desc -> 'k pattern_category
+val classify_pattern: 'k general_pattern -> 'k pattern_category
+
+type pattern_action =
+  { f : 'k . 'k general_pattern -> unit }
+val shallow_iter_pattern_desc:
+    pattern_action -> 'k pattern_desc -> unit
+
+type pattern_transformation =
+  { f : 'k . 'k general_pattern -> 'k general_pattern }
+val shallow_map_pattern_desc:
+    pattern_transformation -> 'k pattern_desc -> 'k pattern_desc
+
+val iter_general_pattern: pattern_action -> 'k general_pattern -> unit
+val iter_pattern: (pattern -> unit) -> pattern -> unit
+
+type pattern_predicate = { f : 'k . 'k general_pattern -> bool }
+val exists_general_pattern: pattern_predicate -> 'k general_pattern -> bool
+val exists_pattern: (pattern -> bool) -> pattern -> bool
+
+(** bottom-up mapping of patterns: the transformation function is
+    called on the children before being called on the parent *)
+val map_general_pattern:
+  pattern_transformation -> 'k general_pattern -> 'k general_pattern
+
+val let_bound_idents: value_binding list -> Ident.t list
+val let_bound_idents_full:
+    value_binding list -> (Ident.t * string loc * Types.type_expr) list
+
+(** Alpha conversion of patterns *)
+val alpha_pat:
+  (Ident.t * Ident.t) list -> 'k general_pattern -> 'k general_pattern
+
+val mknoloc: 'a -> 'a Asttypes.loc
+val mkloc: 'a -> Location.t -> 'a Asttypes.loc
+
+val pat_bound_idents: 'k general_pattern -> Ident.t list
+val pat_bound_idents_full:
+  'k general_pattern -> (Ident.t * string loc * Types.type_expr) list
+
+(** Splits an or pattern into its value (left) and exception (right) parts. *)
+val split_pattern:
+  computation general_pattern -> pattern option * pattern option
diff --git a/typing/typemod.ml b/typing/typemod.ml
new file mode 100644
index 00000000..1f7c480c
--- /dev/null
+++ b/typing/typemod.ml
@@ -0,0 +1,2947 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Misc
+open Longident
+open Path
+open Asttypes
+open Parsetree
+open Types
+open Format
+
+module String = Misc.Stdlib.String
+
+module Sig_component_kind = struct
+  type t =
+    | Value
+    | Type
+    | Module
+    | Module_type
+    | Extension_constructor
+    | Class
+    | Class_type
+
+  let to_string = function
+    | Value -> "value"
+    | Type -> "type"
+    | Module -> "module"
+    | Module_type -> "module type"
+    | Extension_constructor -> "extension constructor"
+    | Class -> "class"
+    | Class_type -> "class type"
+
+  (** Whether the name of a component of that kind can appear in a type. *)
+  let can_appear_in_types = function
+    | Value
+    | Extension_constructor ->
+        false
+    | Type
+    | Module
+    | Module_type
+    | Class
+    | Class_type ->
+        true
+end
+
+type hiding_error =
+  | Illegal_shadowing of {
+      shadowed_item_id: Ident.t;
+      shadowed_item_kind: Sig_component_kind.t;
+      shadowed_item_loc: Location.t;
+      shadower_id: Ident.t;
+      user_id: Ident.t;
+      user_kind: Sig_component_kind.t;
+      user_loc: Location.t;
+    }
+  | Appears_in_signature of {
+      opened_item_id: Ident.t;
+      opened_item_kind: Sig_component_kind.t;
+      user_id: Ident.t;
+      user_kind: Sig_component_kind.t;
+      user_loc: Location.t;
+    }
+
+type error =
+    Cannot_apply of module_type
+  | Not_included of Includemod.error list
+  | Cannot_eliminate_dependency of module_type
+  | Signature_expected
+  | Structure_expected of module_type
+  | With_no_component of Longident.t
+  | With_mismatch of Longident.t * Includemod.error list
+  | With_makes_applicative_functor_ill_typed of
+      Longident.t * Path.t * Includemod.error list
+  | With_changes_module_alias of Longident.t * Ident.t * Path.t
+  | With_cannot_remove_constrained_type
+  | Repeated_name of Sig_component_kind.t * string
+  | Non_generalizable of type_expr
+  | Non_generalizable_class of Ident.t * class_declaration
+  | Non_generalizable_module of module_type
+  | Implementation_is_required of string
+  | Interface_not_compiled of string
+  | Not_allowed_in_functor_body
+  | Not_a_packed_module of type_expr
+  | Incomplete_packed_module of type_expr
+  | Scoping_pack of Longident.t * type_expr
+  | Recursive_module_require_explicit_type
+  | Apply_generative
+  | Cannot_scrape_alias of Path.t
+  | Badly_formed_signature of string * Typedecl.error
+  | Cannot_hide_id of hiding_error
+  | Invalid_type_subst_rhs
+
+exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
+
+open Typedtree
+
+let rec path_concat head p =
+  match p with
+    Pident tail -> Pdot (Pident head, Ident.name tail)
+  | Pdot (pre, s) -> Pdot (path_concat head pre, s)
+  | Papply _ -> assert false
+
+(* Extract a signature from a module type *)
+
+let extract_sig env loc mty =
+  match Env.scrape_alias env mty with
+    Mty_signature sg -> sg
+  | Mty_alias path ->
+      raise(Error(loc, env, Cannot_scrape_alias path))
+  | _ -> raise(Error(loc, env, Signature_expected))
+
+let extract_sig_open env loc mty =
+  match Env.scrape_alias env mty with
+    Mty_signature sg -> sg
+  | Mty_alias path ->
+      raise(Error(loc, env, Cannot_scrape_alias path))
+  | mty -> raise(Error(loc, env, Structure_expected mty))
+
+(* Compute the environment after opening a module *)
+
+let type_open_ ?used_slot ?toplevel ovf env loc lid =
+  let path = Env.lookup_module_path ~load:true ~loc:lid.loc lid.txt env in
+  match Env.open_signature ~loc ?used_slot ?toplevel ovf path env with
+  | Ok env -> path, env
+  | Error _ ->
+      let md = Env.find_module path env in
+      ignore (extract_sig_open env lid.loc md.md_type);
+      assert false
+
+let initial_env ~loc ~safe_string ~initially_opened_module
+    ~open_implicit_modules =
+  let env =
+    if safe_string then
+      Env.initial_safe_string
+    else
+      Env.initial_unsafe_string
+  in
+  let open_module env m =
+    let open Asttypes in
+    let lexbuf = Lexing.from_string m in
+    let txt =
+      Location.init lexbuf (Printf.sprintf "command line argument: -open %S" m);
+      Parse.simple_module_path lexbuf in
+        snd (type_open_ Override env loc {txt;loc})
+  in
+  let add_units env units =
+    String.Set.fold
+      (fun name env ->
+         Env.add_persistent_structure (Ident.create_persistent name) env)
+      units
+      env
+  in
+  let units =
+    List.rev_map Env.persistent_structures_of_dir (Load_path.get ())
+  in
+  let env, units =
+    match initially_opened_module with
+    | None -> (env, units)
+    | Some m ->
+        (* Locate the directory that contains [m], adds the units it
+           contains to the environment and open [m] in the resulting
+           environment. *)
+        let rec loop before after =
+          match after with
+          | [] -> None
+          | units :: after ->
+              if String.Set.mem m units then
+                Some (units, List.rev_append before after)
+              else
+                loop (units :: before) after
+        in
+        let env, units =
+          match loop [] units with
+          | None ->
+              (env, units)
+          | Some (units_containing_m, other_units) ->
+              (add_units env units_containing_m, other_units)
+        in
+        (open_module env m, units)
+  in
+  let env = List.fold_left add_units env units in
+  List.fold_left open_module env open_implicit_modules
+
+let type_open_descr ?used_slot ?toplevel env sod =
+  let (path, newenv) =
+    Builtin_attributes.warning_scope sod.popen_attributes
+      (fun () ->
+         type_open_ ?used_slot ?toplevel sod.popen_override env sod.popen_loc
+           sod.popen_expr
+      )
+  in
+  let od =
+    {
+      open_expr = (path, sod.popen_expr);
+      open_bound_items = [];
+      open_override = sod.popen_override;
+      open_env = newenv;
+      open_attributes = sod.popen_attributes;
+      open_loc = sod.popen_loc;
+    }
+  in
+  (od, newenv)
+
+(* Forward declaration, to be filled in by type_module_type_of *)
+let type_module_type_of_fwd :
+    (Env.t -> Parsetree.module_expr ->
+      Typedtree.module_expr * Types.module_type) ref
+  = ref (fun _env _m -> assert false)
+
+(* Additional validity checks on type definitions arising from
+   recursive modules *)
+
+let check_recmod_typedecls env decls =
+  let recmod_ids = List.map fst decls in
+  List.iter
+    (fun (id, md) ->
+      List.iter
+        (fun path ->
+          Typedecl.check_recmod_typedecl env md.Types.md_loc recmod_ids
+                                         path (Env.find_type path env))
+        (Mtype.type_paths env (Pident id) md.Types.md_type))
+    decls
+
+(* Merge one "with" constraint in a signature *)
+
+let rec add_rec_types env = function
+    Sig_type(id, decl, Trec_next, _) :: rem ->
+      add_rec_types (Env.add_type ~check:true id decl env) rem
+  | _ -> env
+
+let check_type_decl env loc id row_id newdecl decl rs rem =
+  let env = Env.add_type ~check:true id newdecl env in
+  let env =
+    match row_id with
+    | None -> env
+    | Some id -> Env.add_type ~check:false id newdecl env
+  in
+  let env = if rs = Trec_not then env else add_rec_types env rem in
+  Includemod.type_declarations ~mark:Mark_both ~loc env id newdecl decl;
+  Typedecl.check_coherence env loc (Path.Pident id) newdecl
+
+let update_rec_next rs rem =
+  match rs with
+    Trec_next -> rem
+  | Trec_first | Trec_not ->
+      match rem with
+        Sig_type (id, decl, Trec_next, priv) :: rem ->
+          Sig_type (id, decl, rs, priv) :: rem
+      | Sig_module (id, pres, mty, Trec_next, priv) :: rem ->
+          Sig_module (id, pres, mty, rs, priv) :: rem
+      | _ -> rem
+
+let make_variance p n i =
+  let open Variance in
+  set May_pos p (set May_neg n (set May_weak n (set Inj i null)))
+
+let rec iter_path_apply p ~f =
+  match p with
+  | Pident _ -> ()
+  | Pdot (p, _) -> iter_path_apply p ~f
+  | Papply (p1, p2) ->
+     iter_path_apply p1 ~f;
+     iter_path_apply p2 ~f;
+     f p1 p2 (* after recursing, so we know both paths are well typed *)
+
+let path_is_strict_prefix =
+  let rec list_is_strict_prefix l ~prefix =
+    match l, prefix with
+    | [], [] -> false
+    | _ :: _, [] -> true
+    | [], _ :: _ -> false
+    | s1 :: t1, s2 :: t2 ->
+       String.equal s1 s2 && list_is_strict_prefix t1 ~prefix:t2
+  in
+  fun path ~prefix ->
+    match Path.flatten path, Path.flatten prefix with
+    | `Contains_apply, _ | _, `Contains_apply -> false
+    | `Ok (ident1, l1), `Ok (ident2, l2) ->
+       Ident.same ident1 ident2
+       && list_is_strict_prefix l1 ~prefix:l2
+
+let iterator_with_env 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
+         definitions *)
+      let env_before = !env in
+      env := lazy (Env.add_signature sg (Lazy.force env_before));
+      super.Btype.it_signature self sg;
+      env := env_before
+    );
+    Btype.it_module_type = (fun self -> function
+    | Mty_functor (param, mty_body) ->
+      let env_before = !env in
+      begin match param with
+      | Unit -> ()
+      | Named (param, mty_arg) ->
+        self.Btype.it_module_type self mty_arg;
+        match param with
+        | None -> ()
+        | Some id ->
+          env := lazy (Env.add_module ~arg:true id Mp_present
+                       mty_arg (Lazy.force env_before))
+      end;
+      self.Btype.it_module_type self mty_body;
+      env := env_before;
+    | mty ->
+      super.Btype.it_module_type self mty
+    )
+  }
+
+let retype_applicative_functor_type ~loc env funct arg =
+  let mty_functor = (Env.find_module funct env).md_type in
+  let mty_arg = (Env.find_module arg env).md_type in
+  let mty_param =
+    match Env.scrape_alias env mty_functor with
+    | Mty_functor (Named (_, mty_param), _) -> mty_param
+    | _ -> assert false (* could trigger due to MPR#7611 *)
+  in
+  Includemod.check_modtype_inclusion ~loc env mty_arg arg mty_param
+
+(* When doing a deep destructive substitution with type M.N.t := .., we change M
+   and M.N and so we have to check that uses of the modules other than just
+   extracting components from them still make sense. There are only two such
+   kinds of uses:
+   - applicative functor types: F(M).t might not be well typed anymore
+   - aliases: module A = M still makes sense but it doesn't mean the same thing
+     anymore, so it's forbidden until it's clear what we should do with it.
+   This function would be called with M.N.t and N.t to check for these uses. *)
+let check_usage_of_path_of_substituted_item paths env signature ~loc ~lid =
+  let iterator =
+    let env, super = iterator_with_env env in
+    { super with
+      Btype.it_signature_item = (fun self -> function
+      | Sig_module (id, _, { md_type = Mty_alias aliased_path; _ }, _, _)
+        when List.exists
+               (fun path -> path_is_strict_prefix path ~prefix:aliased_path)
+               paths
+        ->
+         let e = With_changes_module_alias (lid.txt, id, aliased_path) in
+         raise(Error(loc, Lazy.force !env, e))
+      | sig_item ->
+         super.Btype.it_signature_item self sig_item
+      );
+      Btype.it_path = (fun referenced_path ->
+        iter_path_apply referenced_path ~f:(fun funct arg ->
+          if List.exists
+               (fun path -> path_is_strict_prefix path ~prefix:arg)
+               paths
+          then
+            let env = Lazy.force !env in
+            try retype_applicative_functor_type ~loc env funct arg
+            with Includemod.Error explanation ->
+              raise(Error(loc, env,
+                          With_makes_applicative_functor_ill_typed
+                            (lid.txt, referenced_path, explanation)))
+        )
+      );
+    }
+  in
+  iterator.Btype.it_signature iterator signature;
+  Btype.unmark_iterators.Btype.it_signature Btype.unmark_iterators signature
+
+(* After substitution one also needs to re-check the well-foundedness
+   of type declarations in recursive modules *)
+let rec extract_next_modules = function
+  | Sig_module (id, _, mty, Trec_next, _) :: rem ->
+      let (id_mty_l, rem) = extract_next_modules rem in
+      ((id, mty) :: id_mty_l, rem)
+  | sg -> ([], sg)
+
+let check_well_formed_module env loc context mty =
+  (* Format.eprintf "@[check_well_formed_module@ %a@]@."
+     Printtyp.modtype mty; *)
+  let open Btype in
+  let iterator =
+    let rec check_signature env = function
+      | [] -> ()
+      | Sig_module (id, _, mty, Trec_first, _) :: rem ->
+          let (id_mty_l, rem) = extract_next_modules rem in
+          begin try
+            check_recmod_typedecls (Lazy.force env) ((id, mty) :: id_mty_l)
+          with Typedecl.Error (_, err) ->
+            raise (Error (loc, Lazy.force env,
+                          Badly_formed_signature(context, err)))
+          end;
+          check_signature env rem
+      | _ :: rem ->
+          check_signature env rem
+    in
+    let env, super = iterator_with_env 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
+        check_signature env sg;
+        super.it_signature self sg);
+    }
+  in
+  iterator.it_module_type iterator mty
+
+let () = Env.check_well_formed_module := check_well_formed_module
+
+let type_decl_is_alias sdecl = (* assuming no explicit constraint *)
+  match sdecl.ptype_manifest with
+  | Some {ptyp_desc = Ptyp_constr (lid, stl)}
+       when List.length stl = List.length sdecl.ptype_params ->
+     begin
+       match
+         List.iter2 (fun x (y, _) ->
+             match x, y with
+               {ptyp_desc=Ptyp_var sx}, {ptyp_desc=Ptyp_var sy}
+                  when sx = sy -> ()
+             | _, _ -> raise Exit)
+           stl sdecl.ptype_params;
+       with
+       | exception Exit -> None
+       | () -> Some lid
+     end
+  | _ -> None
+;;
+
+let params_are_constrained =
+  let rec loop = function
+    | [] -> false
+    | hd :: tl ->
+       match (Btype.repr hd).desc with
+       | Tvar _ -> List.memq hd tl || loop tl
+       | _ -> true
+  in
+  loop
+;;
+
+let merge_constraint initial_env remove_aliases loc sg constr =
+  let lid =
+    match constr with
+    | Pwith_type (lid, _) | Pwith_module (lid, _)
+    | Pwith_typesubst (lid, _) | Pwith_modsubst (lid, _) -> lid
+  in
+  let destructive_substitution =
+    match constr with
+    | Pwith_type _ | Pwith_module _ -> false
+    | Pwith_typesubst _ | Pwith_modsubst _ -> true
+  in
+  let real_ids = ref [] in
+  let rec merge sig_env sg namelist row_id =
+    match (sg, namelist, constr) with
+      ([], _, _) ->
+        raise(Error(loc, sig_env, With_no_component lid.txt))
+    | (Sig_type(id, decl, rs, priv) :: rem, [s],
+       Pwith_type (_, ({ptype_kind = Ptype_abstract} as sdecl)))
+      when Ident.name id = s && Typedecl.is_fixed_type sdecl ->
+        let decl_row =
+          let arity = List.length sdecl.ptype_params in
+          {
+            type_params =
+              List.map (fun _ -> Btype.newgenvar()) sdecl.ptype_params;
+            type_arity = arity;
+            type_kind = Type_abstract;
+            type_private = Private;
+            type_manifest = None;
+            type_variance =
+              List.map
+                (fun (_, v) ->
+                   let (c, n) =
+                     match v with
+                     | Covariant -> true, false
+                     | Contravariant -> false, true
+                     | Invariant -> false, false
+                   in
+                   make_variance (not n) (not c) false
+                )
+                sdecl.ptype_params;
+            type_separability =
+              Types.Separability.default_signature ~arity;
+            type_loc = sdecl.ptype_loc;
+            type_is_newtype = false;
+            type_expansion_scope = Btype.lowest_level;
+            type_attributes = [];
+            type_immediate = Unknown;
+            type_unboxed = unboxed_false_default_false;
+            type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+          }
+        and id_row = Ident.create_local (s^"#row") in
+        let initial_env =
+          Env.add_type ~check:false id_row decl_row initial_env
+        in
+        let tdecl =
+          Typedecl.transl_with_constraint id (Some(Pident id_row))
+            ~sig_env ~sig_decl:decl ~outer_env:initial_env sdecl in
+        let newdecl = tdecl.typ_type in
+        check_type_decl sig_env sdecl.ptype_loc id row_id newdecl decl rs rem;
+        let decl_row = {decl_row with type_params = newdecl.type_params} in
+        let rs' = if rs = Trec_first then Trec_not else rs in
+        (Pident id, lid, Twith_type tdecl),
+        Sig_type(id_row, decl_row, rs', priv)
+        :: Sig_type(id, newdecl, rs, priv)
+        :: rem
+    | (Sig_type(id, sig_decl, rs, priv) :: rem , [s],
+       (Pwith_type (_, sdecl) | Pwith_typesubst (_, sdecl) as constr))
+      when Ident.name id = s ->
+        let tdecl =
+          Typedecl.transl_with_constraint id None
+            ~sig_env ~sig_decl ~outer_env:initial_env sdecl in
+        let newdecl = tdecl.typ_type and loc = sdecl.ptype_loc in
+        check_type_decl sig_env loc id row_id newdecl sig_decl rs rem;
+        begin match constr with
+          Pwith_type _ ->
+            (Pident id, lid, Twith_type tdecl),
+            Sig_type(id, newdecl, rs, priv) :: rem
+        | (* Pwith_typesubst *) _ ->
+            real_ids := [Pident id];
+            (Pident id, lid, Twith_typesubst tdecl),
+            update_rec_next rs rem
+        end
+    | (Sig_type(id, _, _, _) :: rem, [s], (Pwith_type _ | Pwith_typesubst _))
+      when Ident.name id = s ^ "#row" ->
+        merge sig_env rem namelist (Some id)
+    | (Sig_module(id, pres, md, rs, priv) :: rem, [s], Pwith_module (_, lid'))
+      when Ident.name id = s ->
+        let path, md' = Env.lookup_module ~loc lid'.txt initial_env in
+        let mty = md'.md_type in
+        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
+                 newmd.md_type md.md_type);
+        (Pident id, lid, Twith_module (path, lid')),
+        Sig_module(id, pres, newmd, rs, priv) :: rem
+    | (Sig_module(id, _, md, rs, _) :: rem, [s], Pwith_modsubst (_, lid'))
+      when Ident.name id = s ->
+        let path, md' = Env.lookup_module ~loc lid'.txt initial_env in
+        let aliasable = not (Env.is_functor_arg path sig_env) in
+        ignore
+          (Includemod.strengthened_module_decl ~loc ~mark:Mark_both
+             ~aliasable sig_env md' path md);
+        real_ids := [Pident id];
+        (Pident id, lid, Twith_modsubst (path, lid')),
+        update_rec_next rs rem
+    | (Sig_module(id, _, md, rs, priv) as item :: rem, s :: namelist, constr)
+      when Ident.name id = s ->
+        let sg = extract_sig sig_env loc md.md_type in
+        let ((path, _, tcstr), newsg) = merge_signature sig_env sg namelist in
+        let path = path_concat id path in
+        real_ids := path :: !real_ids;
+        let item =
+          match md.md_type, constr with
+            Mty_alias _, (Pwith_module _ | Pwith_type _) ->
+              (* A module alias cannot be refined, so keep it
+                 and just check that the constraint is correct *)
+              item
+          | _ ->
+              let newmd = {md with md_type = Mty_signature newsg} in
+              Sig_module(id, Mp_present, newmd, rs, priv)
+        in
+        (path, lid, tcstr),
+        item :: rem
+    | (item :: rem, _, _) ->
+        let (cstr, items) = merge sig_env rem namelist row_id
+        in
+        cstr, item :: items
+  and merge_signature env sg namelist =
+    let sig_env = Env.add_signature sg env in
+    merge sig_env sg namelist None
+  in
+  try
+    let names = Longident.flatten lid.txt in
+    let (tcstr, sg) = merge_signature initial_env sg names in
+    if destructive_substitution then (
+      match List.rev !real_ids with
+      | [] -> assert false
+      | last :: rest ->
+        (* The last item is the one that's removed. We don't need to check how
+           it's used since it's replaced by a more specific type/module. *)
+        assert (match last with Pident _ -> true | _ -> false);
+        match rest with
+        | [] -> ()
+        | _ :: _ ->
+          check_usage_of_path_of_substituted_item
+            rest initial_env sg ~loc ~lid;
+    );
+    let sg =
+    match tcstr with
+    | (_, _, Twith_typesubst tdecl) ->
+       let how_to_extend_subst =
+         let sdecl =
+           match constr with
+           | Pwith_typesubst (_, sdecl) -> sdecl
+           | _ -> assert false
+         in
+         match type_decl_is_alias sdecl with
+         | Some lid ->
+            let replacement, _ =
+              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
+         | 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
+       in
+       let sub = List.fold_left how_to_extend_subst Subst.identity !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
+    | (_, _, Twith_modsubst (real_path, _)) ->
+       let sub =
+         List.fold_left
+           (fun s path -> Subst.add_module_path path real_path s)
+           Subst.identity
+           !real_ids
+       in
+       (* See explanation in the [Twith_typesubst] case above. *)
+       Subst.signature Make_local sub sg
+    | _ ->
+       sg
+    in
+    check_well_formed_module initial_env loc "this instantiated signature"
+      (Mty_signature sg);
+    (tcstr, sg)
+  with Includemod.Error explanation ->
+    raise(Error(loc, initial_env, With_mismatch(lid.txt, explanation)))
+
+(* Add recursion flags on declarations arising from a mutually recursive
+   block. *)
+
+let map_rec fn decls rem =
+  match decls with
+  | [] -> rem
+  | d1 :: dl -> fn Trec_first d1 :: map_end (fn Trec_next) dl rem
+
+let map_rec_type ~rec_flag fn decls rem =
+  match decls with
+  | [] -> rem
+  | d1 :: dl ->
+      let first =
+        match rec_flag with
+        | Recursive -> Trec_first
+        | Nonrecursive -> Trec_not
+      in
+      fn first d1 :: map_end (fn Trec_next) dl rem
+
+let rec map_rec_type_with_row_types ~rec_flag fn decls rem =
+  match decls with
+  | [] -> rem
+  | d1 :: dl ->
+      if Btype.is_row_name (Ident.name d1.typ_id) then
+        fn Trec_not d1 :: map_rec_type_with_row_types ~rec_flag fn dl rem
+      else
+        map_rec_type ~rec_flag fn decls rem
+
+(* Add type extension flags to extension constructors *)
+let map_ext fn exts rem =
+  match exts with
+  | [] -> rem
+  | d1 :: dl -> fn Text_first d1 :: map_end (fn Text_next) dl rem
+
+(* Auxiliary for translating recursively-defined module types.
+   Return a module type that approximates the shape of the given module
+   type AST.  Retain only module, type, and module type
+   components of signatures.  For types, retain only their arity,
+   making them abstract otherwise. *)
+
+let rec approx_modtype env smty =
+  match smty.pmty_desc with
+    Pmty_ident lid ->
+      let (path, _info) =
+        Env.lookup_modtype ~use:false ~loc:smty.pmty_loc lid.txt env
+      in
+      Mty_ident path
+  | Pmty_alias lid ->
+      let path =
+        Env.lookup_module_path ~use:false ~load:false
+          ~loc:smty.pmty_loc lid.txt env
+      in
+      Mty_alias(path)
+  | Pmty_signature ssg ->
+      Mty_signature(approx_sig env ssg)
+  | Pmty_functor(param, sres) ->
+      let (param, newenv) =
+        match param with
+        | Unit -> Types.Unit, env
+        | Named (param, sarg) ->
+          let arg = approx_modtype env sarg in
+          match param.txt with
+          | None -> Types.Named (None, arg), env
+          | Some name ->
+            let rarg = Mtype.scrape_for_functor_arg env arg in
+            let scope = Ctype.create_scope () in
+            let (id, newenv) =
+              Env.enter_module ~scope ~arg:true name Mp_present rarg env
+            in
+            Types.Named (Some id, arg), newenv
+      in
+      let res = approx_modtype newenv sres in
+      Mty_functor(param, res)
+  | Pmty_with(sbody, constraints) ->
+      let body = approx_modtype env sbody in
+      List.iter
+        (fun sdecl ->
+          match sdecl with
+          | Pwith_type _ -> ()
+          | Pwith_typesubst _ -> ()
+          | Pwith_module (_, lid') ->
+              (* Lookup the module to make sure that it is not recursive.
+                 (GPR#1626) *)
+              ignore (Env.lookup_module ~use:false ~loc:lid'.loc lid'.txt env)
+          | Pwith_modsubst (_, lid') ->
+              ignore (Env.lookup_module ~use:false ~loc:lid'.loc lid'.txt env))
+        constraints;
+      body
+  | Pmty_typeof smod ->
+      let (_, mty) = !type_module_type_of_fwd env smod in
+      mty
+  | Pmty_extension ext ->
+      raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+and approx_module_declaration env pmd =
+  {
+    Types.md_type = approx_modtype env pmd.pmd_type;
+    md_attributes = pmd.pmd_attributes;
+    md_loc = pmd.pmd_loc;
+    md_uid = Uid.internal_not_actually_unique;
+  }
+
+and approx_sig env ssg =
+  match ssg with
+    [] -> []
+  | item :: srem ->
+      match item.psig_desc with
+      | Psig_type (rec_flag, sdecls) ->
+          let decls = Typedecl.approx_type_decl sdecls in
+          let rem = approx_sig env srem in
+          map_rec_type ~rec_flag
+            (fun rs (id, info) -> Sig_type(id, info, rs, Exported)) decls rem
+      | Psig_typesubst _ -> approx_sig env srem
+      | Psig_module { pmd_name = { txt = None; _ }; _ } ->
+          approx_sig env srem
+      | Psig_module pmd ->
+          let scope = Ctype.create_scope () in
+          let md = approx_module_declaration env pmd in
+          let pres =
+            match md.Types.md_type with
+            | Mty_alias _ -> Mp_absent
+            | _ -> Mp_present
+          in
+          let id, newenv =
+            Env.enter_module_declaration ~scope (Option.get pmd.pmd_name.txt)
+              pres md env
+          in
+          Sig_module(id, pres, md, Trec_not, Exported) :: approx_sig newenv srem
+      | Psig_modsubst pms ->
+          let scope = Ctype.create_scope () in
+          let _, md =
+            Env.lookup_module ~use:false ~loc:pms.pms_manifest.loc
+               pms.pms_manifest.txt env
+          in
+          let pres =
+            match md.Types.md_type with
+            | Mty_alias _ -> Mp_absent
+            | _ -> Mp_present
+          in
+          let _, newenv =
+            Env.enter_module_declaration ~scope pms.pms_name.txt pres md env
+          in
+          approx_sig newenv srem
+      | Psig_recmodule sdecls ->
+          let scope = Ctype.create_scope () in
+          let decls =
+            List.filter_map
+              (fun pmd ->
+                 Option.map (fun name ->
+                   Ident.create_scoped ~scope name,
+                   approx_module_declaration env pmd
+                 ) pmd.pmd_name.txt
+              )
+              sdecls
+          in
+          let newenv =
+            List.fold_left
+              (fun env (id, md) -> Env.add_module_declaration ~check:false
+                  id Mp_present md env)
+              env decls
+          in
+          map_rec
+            (fun rs (id, md) -> Sig_module(id, Mp_present, md, rs, Exported))
+            decls
+            (approx_sig newenv srem)
+      | Psig_modtype d ->
+          let info = approx_modtype_info env d in
+          let scope = Ctype.create_scope () in
+          let (id, newenv) =
+            Env.enter_modtype ~scope d.pmtd_name.txt info env
+          in
+          Sig_modtype(id, info, Exported) :: approx_sig newenv srem
+      | Psig_open sod ->
+          let _, env = type_open_descr env sod in
+          approx_sig env srem
+      | Psig_include sincl ->
+          let smty = sincl.pincl_mod in
+          let mty = approx_modtype env smty in
+          let scope = Ctype.create_scope () in
+          let sg, newenv = Env.enter_signature ~scope
+              (extract_sig env smty.pmty_loc mty) env in
+          sg @ approx_sig newenv srem
+      | Psig_class sdecls | Psig_class_type sdecls ->
+          let decls = Typeclass.approx_class_declarations env sdecls in
+          let rem = approx_sig env srem in
+          map_rec (fun rs decl ->
+            let open Typeclass in [
+              Sig_class_type(decl.clsty_ty_id, decl.clsty_ty_decl, rs,
+                             Exported);
+              Sig_type(decl.clsty_obj_id, decl.clsty_obj_abbr, rs, Exported);
+              Sig_type(decl.clsty_typesharp_id, decl.clsty_abbr, rs, Exported);
+            ]
+          ) decls [rem]
+          |> List.flatten
+      | _ ->
+          approx_sig env srem
+
+and approx_modtype_info env sinfo =
+  {
+   mtd_type = Option.map (approx_modtype env) sinfo.pmtd_type;
+   mtd_attributes = sinfo.pmtd_attributes;
+   mtd_loc = sinfo.pmtd_loc;
+   mtd_uid = Uid.internal_not_actually_unique;
+  }
+
+let approx_modtype env smty =
+  Warnings.without_warnings
+    (fun () -> approx_modtype env smty)
+
+(* Auxiliaries for checking the validity of name shadowing in signatures and
+   structures.
+   If a shadowing is valid, we also record some information (its ident,
+   location where it first appears, etc) about the item that gets shadowed. *)
+module Signature_names : sig
+  type t
+
+  type info = [
+    | `Exported
+    | `From_open
+    | `Shadowable of Ident.t * Location.t
+    | `Substituted_away of Subst.t
+  ]
+
+  val create : unit -> t
+
+  val check_value     : ?info:info -> t -> Location.t -> Ident.t -> unit
+  val check_type      : ?info:info -> t -> Location.t -> Ident.t -> unit
+  val check_typext    : ?info:info -> t -> Location.t -> Ident.t -> unit
+  val check_module    : ?info:info -> t -> Location.t -> Ident.t -> unit
+  val check_modtype   : ?info:info -> t -> Location.t -> Ident.t -> unit
+  val check_class     : ?info:info -> t -> Location.t -> Ident.t -> unit
+  val check_class_type: ?info:info -> t -> Location.t -> Ident.t -> unit
+
+  val check_sig_item:
+    ?info:info -> t -> Location.t -> Types.signature_item -> unit
+
+  val simplify: Env.t -> t -> Types.signature -> Types.signature
+end = struct
+
+  type bound_info = [
+    | `Exported
+    | `Shadowable of Ident.t * Location.t
+  ]
+
+  type info = [
+    | `From_open
+    | `Substituted_away of Subst.t
+    | bound_info
+  ]
+
+  type hide_reason =
+    | From_open
+    | Shadowed_by of Ident.t * Location.t
+
+  type to_be_removed = {
+    mutable subst: Subst.t;
+    mutable hide: (Sig_component_kind.t * Location.t * hide_reason) Ident.Map.t;
+  }
+
+  type names_infos = (string, bound_info) Hashtbl.t
+
+  type names = {
+    values: names_infos;
+    types: names_infos;
+    modules: names_infos;
+    modtypes: names_infos;
+    typexts: names_infos;
+    classes: names_infos;
+    class_types: names_infos;
+  }
+
+  let new_names () = {
+    values = Hashtbl.create 16;
+    types = Hashtbl.create 16;
+    modules = Hashtbl.create 16;
+    modtypes = Hashtbl.create 16;
+    typexts = Hashtbl.create 16;
+    classes = Hashtbl.create 16;
+    class_types = Hashtbl.create 16;
+  }
+
+  type t = {
+    bound: names;
+    to_be_removed: to_be_removed;
+  }
+
+  let create () = {
+    bound = new_names ();
+    to_be_removed = {
+      subst = Subst.identity;
+      hide = Ident.Map.empty;
+    };
+  }
+
+  let check cl loc (tbl : names_infos) id (info : info) to_be_removed =
+    match info with
+    | `Substituted_away s ->
+        to_be_removed.subst <- Subst.compose s to_be_removed.subst
+    | `From_open ->
+        to_be_removed.hide <-
+          Ident.Map.add id (cl, loc, From_open) to_be_removed.hide
+    | #bound_info as bound_info ->
+        let name = Ident.name id in
+        match Hashtbl.find_opt tbl name with
+        | None -> Hashtbl.add tbl name bound_info
+        | Some (`Shadowable (shadowed_id, shadowed_loc)) ->
+            Hashtbl.replace tbl name bound_info;
+            let reason = Shadowed_by (id, loc) in
+            to_be_removed.hide <-
+              Ident.Map.add shadowed_id (cl, shadowed_loc, reason)
+                to_be_removed.hide
+        | Some `Exported ->
+            raise(Error(loc, Env.empty, Repeated_name(cl, name)))
+
+  let check_value ?info t loc id =
+    let info =
+      match info with
+      | Some i -> i
+      | None -> `Shadowable (id, loc)
+    in
+    check Sig_component_kind.Value loc t.bound.values id info t.to_be_removed
+  let check_type ?(info=`Exported) t loc id =
+    check Sig_component_kind.Type loc t.bound.types id info t.to_be_removed
+  let check_module ?(info=`Exported) t loc id =
+    check Sig_component_kind.Module loc t.bound.modules id info t.to_be_removed
+  let check_modtype ?(info=`Exported) t loc id =
+    check Sig_component_kind.Module_type loc t.bound.modtypes id info
+      t.to_be_removed
+  let check_typext ?(info=`Exported) t loc id =
+    check Sig_component_kind.Extension_constructor loc t.bound.typexts id info
+      t.to_be_removed
+  let check_class ?(info=`Exported) t loc id =
+    check Sig_component_kind.Class loc t.bound.classes id info t.to_be_removed
+  let check_class_type ?(info=`Exported) t loc id =
+    check Sig_component_kind.Class_type loc t.bound.class_types id info
+      t.to_be_removed
+
+  let check_sig_item ?info names loc component =
+    let info id loc =
+      match info with
+      | None -> `Shadowable (id, loc)
+      | Some i -> i
+    in
+    match component with
+    | Sig_type(id, _, _, _) ->
+        check_type names loc id ~info:(info id loc)
+    | Sig_module(id, _, _, _, _) ->
+        check_module names loc id ~info:(info id loc)
+    | Sig_modtype(id, _, _) ->
+        check_modtype names loc id ~info:(info id loc)
+    | Sig_typext(id, _, _, _) ->
+        check_typext names loc id ~info:(info id loc)
+    | Sig_value (id, _, _) ->
+        check_value names loc id ~info:(info id loc)
+    | Sig_class (id, _, _, _) ->
+        check_class names loc id ~info:(info id loc)
+    | Sig_class_type (id, _, _, _) ->
+        check_class_type names loc id ~info:(info id loc)
+
+  (* 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
+     an include.
+     When there are multiple specifications of a component with the same name,
+     we try to keep only the last (rightmost) one, removing all references to
+     the previous ones from the signature.
+     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 =
+      Ident.Map.fold (fun id (kind,  _, _) lst ->
+        if Sig_component_kind.can_appear_in_types kind then
+          id :: lst
+        else
+          lst
+      ) to_remove.hide []
+    in
+    let aux component sg =
+      let user_kind, user_id, user_loc =
+        let open Sig_component_kind in
+        match component with
+        | Sig_value(id, v, _) -> Value, id, v.val_loc
+        | Sig_type (id, td, _, _) -> Type, id, td.type_loc
+        | Sig_typext (id, te, _, _) -> Extension_constructor, id, te.ext_loc
+        | Sig_module (id, _, md, _, _) -> Module, id, md.md_loc
+        | Sig_modtype (id, mtd, _) -> Module_type, id, mtd.mtd_loc
+        | Sig_class (id, c, _, _) -> Class, id, c.cty_loc
+        | Sig_class_type (id, ct, _, _) -> Class_type, id, ct.clty_loc
+      in
+      if Ident.Map.mem user_id to_remove.hide then
+        sg
+      else begin
+        let component =
+          if to_remove.subst == Subst.identity then
+            component
+          else
+            Subst.signature_item Keep to_remove.subst component
+        in
+        let component =
+          match ids_to_remove with
+          | [] -> component
+          | ids ->
+            try Mtype.nondep_sig_item env ids component with
+            | Ctype.Nondep_cannot_erase removed_item_id ->
+              let (removed_item_kind, removed_item_loc, reason) =
+                Ident.Map.find removed_item_id to_remove.hide
+              in
+              let err_loc, hiding_error =
+                match reason with
+                | From_open ->
+                  removed_item_loc,
+                  Appears_in_signature {
+                    opened_item_kind = removed_item_kind;
+                    opened_item_id = removed_item_id;
+                    user_id;
+                    user_kind;
+                    user_loc;
+                  }
+                | Shadowed_by (shadower_id, shadower_loc) ->
+                  shadower_loc,
+                  Illegal_shadowing {
+                    shadowed_item_kind = removed_item_kind;
+                    shadowed_item_id = removed_item_id;
+                    shadowed_item_loc = removed_item_loc;
+                    shadower_id;
+                    user_id;
+                    user_kind;
+                    user_loc;
+                  }
+              in
+              raise (Error(err_loc, env, Cannot_hide_id hiding_error))
+        in
+        component :: sg
+      end
+    in
+    List.fold_right aux sg []
+end
+
+let has_remove_aliases_attribute attr =
+  let remove_aliases =
+    Attr_helper.get_no_payload_attribute
+      ["remove_aliases"; "ocaml.remove_aliases"] attr
+  in
+  match remove_aliases with
+  | None -> false
+  | Some _ -> true
+
+(* Check and translate a module type expression *)
+
+let transl_modtype_longident loc env lid =
+  let (path, _info) = Env.lookup_modtype ~loc lid env in
+  path
+
+let transl_module_alias loc env lid =
+  Env.lookup_module_path ~load:false ~loc lid env
+
+let mkmty desc typ env loc attrs =
+  let mty = {
+    mty_desc = desc;
+    mty_type = typ;
+    mty_loc = loc;
+    mty_env = env;
+    mty_attributes = attrs;
+    } in
+  Cmt_format.add_saved_type (Cmt_format.Partial_module_type mty);
+  mty
+
+let mksig desc env loc =
+  let sg = { sig_desc = desc; sig_loc = loc; sig_env = env } in
+  Cmt_format.add_saved_type (Cmt_format.Partial_signature_item sg);
+  sg
+
+(* let signature sg = List.map (fun item -> item.sig_type) sg *)
+
+let rec transl_modtype env smty =
+  Builtin_attributes.warning_scope smty.pmty_attributes
+    (fun () -> transl_modtype_aux env smty)
+
+and transl_modtype_functor_arg env sarg =
+  let mty = transl_modtype env sarg in
+  {mty with mty_type = Mtype.scrape_for_functor_arg env mty.mty_type}
+
+and transl_modtype_aux env smty =
+  let loc = smty.pmty_loc in
+  match smty.pmty_desc with
+    Pmty_ident lid ->
+      let path = transl_modtype_longident loc env lid.txt in
+      mkmty (Tmty_ident (path, lid)) (Mty_ident path) env loc
+        smty.pmty_attributes
+  | Pmty_alias lid ->
+      let path = transl_module_alias loc env lid.txt in
+      mkmty (Tmty_alias (path, lid)) (Mty_alias path) env loc
+        smty.pmty_attributes
+  | Pmty_signature ssg ->
+      let sg = transl_signature env ssg in
+      mkmty (Tmty_signature sg) (Mty_signature sg.sig_type) env loc
+        smty.pmty_attributes
+  | Pmty_functor(sarg_opt, sres) ->
+      let t_arg, ty_arg, newenv =
+        match sarg_opt with
+        | Unit -> Unit, Types.Unit, env
+        | Named (param, sarg) ->
+          let arg = transl_modtype_functor_arg env sarg in
+          let (id, newenv) =
+            match param.txt with
+            | None -> None, env
+            | Some name ->
+              let scope = Ctype.create_scope () in
+              let id, newenv =
+                let arg_md =
+                  { md_type = arg.mty_type;
+                    md_attributes = [];
+                    md_loc = param.loc;
+                    md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+                  }
+                in
+                Env.enter_module_declaration ~scope ~arg:true name Mp_present
+                  arg_md env
+              in
+              Some id, newenv
+          in
+          Named (id, param, arg), Types.Named (id, arg.mty_type), newenv
+      in
+      let res = transl_modtype newenv sres in
+      mkmty (Tmty_functor (t_arg, res))
+        (Mty_functor(ty_arg, res.mty_type)) env loc
+        smty.pmty_attributes
+  | Pmty_with(sbody, constraints) ->
+      let body = transl_modtype env sbody in
+      let init_sg = extract_sig env sbody.pmty_loc body.mty_type in
+      let remove_aliases = has_remove_aliases_attribute smty.pmty_attributes in
+      let (rev_tcstrs, final_sg) =
+        List.fold_left
+          (fun (rev_tcstrs,sg) sdecl ->
+            let (tcstr, sg) =
+              merge_constraint env remove_aliases smty.pmty_loc sg sdecl
+            in
+            (tcstr :: rev_tcstrs, sg)
+        )
+        ([],init_sg) constraints in
+      let scope = Ctype.create_scope () in
+      mkmty (Tmty_with ( body, List.rev rev_tcstrs))
+        (Mtype.freshen ~scope (Mty_signature final_sg)) env loc
+        smty.pmty_attributes
+  | Pmty_typeof smod ->
+      let env = Env.in_signature false env in
+      let tmty, mty = !type_module_type_of_fwd env smod in
+      mkmty (Tmty_typeof tmty) mty env loc smty.pmty_attributes
+  | Pmty_extension ext ->
+      raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+and transl_signature env sg =
+  let names = Signature_names.create () in
+  let rec transl_sig env sg =
+    match sg with
+      [] -> [], [], env
+    | item :: srem ->
+        let loc = item.psig_loc in
+        match item.psig_desc with
+        | Psig_value sdesc ->
+            let (tdesc, newenv) =
+              Typedecl.transl_value_decl env item.psig_loc sdesc
+            in
+            Signature_names.check_value names tdesc.val_loc tdesc.val_id;
+            let (trem,rem, final_env) = transl_sig newenv srem in
+            mksig (Tsig_value tdesc) env loc :: trem,
+            Sig_value(tdesc.val_id, tdesc.val_val, Exported) :: rem,
+              final_env
+        | Psig_type (rec_flag, sdecls) ->
+            let (decls, newenv) =
+              Typedecl.transl_type_decl env rec_flag sdecls
+            in
+            List.iter (fun td ->
+              Signature_names.check_type names td.typ_loc td.typ_id
+            ) decls;
+            let (trem, rem, final_env) = transl_sig newenv srem in
+            let sg =
+              map_rec_type_with_row_types ~rec_flag
+                (fun rs td -> Sig_type(td.typ_id, td.typ_type, rs, Exported))
+                decls rem
+            in
+            mksig (Tsig_type (rec_flag, decls)) env loc :: trem,
+            sg,
+            final_env
+        | Psig_typesubst sdecls ->
+            let (decls, newenv) =
+              Typedecl.transl_type_decl env Nonrecursive sdecls
+            in
+            List.iter (fun td ->
+              if td.typ_kind <> Ttype_abstract || td.typ_manifest = None ||
+                 td.typ_private = Private
+              then
+                raise (Error (td.typ_loc, env, Invalid_type_subst_rhs));
+              let params = td.typ_type.type_params in
+              if params_are_constrained params
+              then raise(Error(loc, env, With_cannot_remove_constrained_type));
+              let info =
+                  let subst =
+                    Subst.add_type_function (Pident td.typ_id)
+                      ~params
+                      ~body:(Option.get td.typ_type.type_manifest)
+                      Subst.identity
+                  in
+                  Some (`Substituted_away subst)
+              in
+              Signature_names.check_type ?info names td.typ_loc td.typ_id
+            ) decls;
+            let (trem, rem, final_env) = transl_sig newenv srem in
+            let sg = rem
+            in
+            mksig (Tsig_typesubst decls) env loc :: trem,
+            sg,
+            final_env
+        | Psig_typext styext ->
+            let (tyext, newenv) =
+              Typedecl.transl_type_extension false env item.psig_loc styext
+            in
+            let constructors = tyext.tyext_constructors in
+            List.iter (fun ext ->
+              Signature_names.check_typext names ext.ext_loc ext.ext_id
+            ) constructors;
+            let (trem, rem, final_env) = transl_sig newenv srem in
+              mksig (Tsig_typext tyext) env loc :: trem,
+              map_ext (fun es ext ->
+                Sig_typext(ext.ext_id, ext.ext_type, es, Exported)
+              ) constructors rem,
+              final_env
+        | Psig_exception sext ->
+            let (ext, newenv) = Typedecl.transl_type_exception env sext in
+            let constructor = ext.tyexn_constructor in
+            Signature_names.check_typext names constructor.ext_loc
+              constructor.ext_id;
+            let (trem, rem, final_env) = transl_sig newenv srem in
+            mksig (Tsig_exception ext) env loc :: trem,
+            Sig_typext(constructor.ext_id,
+                       constructor.ext_type,
+                       Text_exception,
+                       Exported) :: rem,
+            final_env
+        | Psig_module pmd ->
+            let scope = Ctype.create_scope () in
+            let tmty =
+              Builtin_attributes.warning_scope pmd.pmd_attributes
+                (fun () -> transl_modtype env pmd.pmd_type)
+            in
+            let pres =
+              match tmty.mty_type with
+              | Mty_alias _ -> 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 ());
+            }
+            in
+            let id, newenv =
+              match pmd.pmd_name.txt with
+              | None -> None, env
+              | Some name ->
+                let id, newenv =
+                  Env.enter_module_declaration ~scope name pres md env
+                in
+                Signature_names.check_module names pmd.pmd_name.loc id;
+                Some id, newenv
+            in
+            let (trem, rem, final_env) = transl_sig newenv srem in
+            mksig (Tsig_module {md_id=id; md_name=pmd.pmd_name;
+                                md_presence=pres; md_type=tmty;
+                                md_loc=pmd.pmd_loc;
+                                md_attributes=pmd.pmd_attributes})
+              env loc :: trem,
+            (match id with
+             | None -> rem
+             | Some id -> Sig_module(id, pres, md, Trec_not, Exported) :: rem),
+            final_env
+        | Psig_modsubst pms ->
+            let scope = Ctype.create_scope () in
+            let path, md =
+              Env.lookup_module ~loc:pms.pms_manifest.loc
+                pms.pms_manifest.txt env
+            in
+            let aliasable = not (Env.is_functor_arg path env) in
+            let md =
+              if not aliasable then
+                md
+              else
+                { 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 ());
+                }
+            in
+            let pres =
+              match md.md_type with
+              | Mty_alias _ -> Mp_absent
+              | _ -> Mp_present
+            in
+            let id, newenv =
+              Env.enter_module_declaration ~scope pms.pms_name.txt pres md env
+            in
+            let info =
+              `Substituted_away (Subst.add_module id path Subst.identity)
+            in
+            Signature_names.check_module ~info names pms.pms_name.loc id;
+            let (trem, rem, final_env) = transl_sig newenv srem in
+            mksig (Tsig_modsubst {ms_id=id; ms_name=pms.pms_name;
+                                  ms_manifest=path; ms_txt=pms.pms_manifest;
+                                  ms_loc=pms.pms_loc;
+                                  ms_attributes=pms.pms_attributes})
+              env loc :: trem,
+            rem,
+            final_env
+        | Psig_recmodule sdecls ->
+            let (tdecls, newenv) =
+              transl_recmodule_modtypes env sdecls in
+            let decls =
+              List.filter_map (fun (md, uid) ->
+                match md.md_id with
+                | None -> None
+                | Some id -> Some (id, md, uid)
+              ) tdecls
+            in
+            List.iter (fun (id, md, _) ->
+              Signature_names.check_module names md.md_loc id
+            ) decls;
+            let (trem, rem, final_env) = transl_sig newenv srem in
+            mksig (Tsig_recmodule (List.map fst tdecls)) env loc :: trem,
+            map_rec (fun rs (id, md, uid) ->
+                let d = {Types.md_type = md.md_type.mty_type;
+                         md_attributes = md.md_attributes;
+                         md_loc = md.md_loc;
+                         md_uid = uid;
+                        } in
+                Sig_module(id, Mp_present, d, rs, Exported))
+              decls rem,
+            final_env
+        | Psig_modtype pmtd ->
+            let newenv, mtd, sg = transl_modtype_decl names env pmtd in
+            let (trem, rem, final_env) = transl_sig newenv srem in
+            mksig (Tsig_modtype mtd) env loc :: trem,
+            sg :: rem,
+            final_env
+        | Psig_open sod ->
+            let (od, newenv) = type_open_descr env sod in
+            let (trem, rem, final_env) = transl_sig newenv srem in
+            mksig (Tsig_open od) env loc :: trem,
+            rem, final_env
+        | Psig_include sincl ->
+            let smty = sincl.pincl_mod in
+            let tmty =
+              Builtin_attributes.warning_scope sincl.pincl_attributes
+                (fun () -> transl_modtype env smty)
+            in
+            let mty = tmty.mty_type in
+            let scope = Ctype.create_scope () in
+            let sg, newenv = Env.enter_signature ~scope
+                       (extract_sig env smty.pmty_loc mty) env in
+            List.iter (Signature_names.check_sig_item names item.psig_loc) sg;
+            let incl =
+              { incl_mod = tmty;
+                incl_type = sg;
+                incl_attributes = sincl.pincl_attributes;
+                incl_loc = sincl.pincl_loc;
+              }
+            in
+            let (trem, rem, final_env) = transl_sig newenv srem  in
+            mksig (Tsig_include incl) env loc :: trem,
+            sg @ rem,
+            final_env
+        | Psig_class cl ->
+            let (classes, newenv) = Typeclass.class_descriptions env cl in
+            List.iter (fun cls ->
+              let open Typeclass in
+              let loc = cls.cls_id_loc.Location.loc in
+              Signature_names.check_type names loc cls.cls_obj_id;
+              Signature_names.check_class names loc cls.cls_id;
+              Signature_names.check_class_type names loc cls.cls_ty_id;
+              Signature_names.check_type names loc cls.cls_typesharp_id;
+            ) classes;
+            let (trem, rem, final_env) = transl_sig newenv srem in
+            let sg =
+              map_rec (fun rs cls ->
+                let open Typeclass in
+                [Sig_class(cls.cls_id, cls.cls_decl, rs, Exported);
+                 Sig_class_type(cls.cls_ty_id, cls.cls_ty_decl, rs, Exported);
+                 Sig_type(cls.cls_obj_id, cls.cls_obj_abbr, rs, Exported);
+                 Sig_type(cls.cls_typesharp_id, cls.cls_abbr, rs, Exported)]
+              ) classes [rem]
+              |> List.flatten
+            in
+            let typedtree =
+              mksig (Tsig_class
+                       (List.map (fun decr ->
+                          decr.Typeclass.cls_info) classes)) env loc
+              :: trem
+            in
+            typedtree, sg, final_env
+        | Psig_class_type cl ->
+            let (classes, newenv) = Typeclass.class_type_declarations env cl in
+            List.iter (fun decl ->
+              let open Typeclass in
+              let loc = decl.clsty_id_loc.Location.loc in
+              Signature_names.check_class_type names loc decl.clsty_ty_id;
+              Signature_names.check_type names loc decl.clsty_obj_id;
+              Signature_names.check_type names loc decl.clsty_typesharp_id;
+            ) classes;
+            let (trem,rem, final_env) = transl_sig newenv srem in
+            let sg =
+              map_rec (fun rs decl ->
+                let open Typeclass in
+                [Sig_class_type(decl.clsty_ty_id, decl.clsty_ty_decl, rs,
+                                Exported);
+                 Sig_type(decl.clsty_obj_id, decl.clsty_obj_abbr, rs, Exported);
+                 Sig_type(decl.clsty_typesharp_id, decl.clsty_abbr, rs,
+                          Exported)
+                ]
+              ) classes [rem]
+              |> List.flatten
+            in
+            let typedtree =
+              mksig
+                (Tsig_class_type
+                   (List.map (fun decl -> decl.Typeclass.clsty_info) classes))
+                env loc
+              :: trem
+            in
+            typedtree, sg, final_env
+        | Psig_attribute x ->
+            Builtin_attributes.warning_attribute x;
+            let (trem,rem, final_env) = transl_sig env srem in
+            mksig (Tsig_attribute x) env loc :: trem, rem, final_env
+        | Psig_extension (ext, _attrs) ->
+            raise (Error_forward (Builtin_attributes.error_of_extension ext))
+  in
+  let previous_saved_types = Cmt_format.get_saved_types () in
+  Builtin_attributes.warning_scope []
+    (fun () ->
+       let (trem, rem, final_env) = transl_sig (Env.in_signature true env) sg in
+       let rem = Signature_names.simplify final_env names rem in
+       let sg =
+         { sig_items = trem; sig_type = rem; sig_final_env = final_env }
+       in
+       Cmt_format.set_saved_types
+         ((Cmt_format.Partial_signature sg) :: previous_saved_types);
+       sg
+    )
+
+and transl_modtype_decl names env pmtd =
+  Builtin_attributes.warning_scope pmtd.pmtd_attributes
+    (fun () -> transl_modtype_decl_aux names env pmtd)
+
+and transl_modtype_decl_aux names env
+    {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} =
+  let tmty =
+    Option.map (transl_modtype (Env.in_signature true env)) pmtd_type
+  in
+  let decl =
+    {
+     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 ());
+    }
+  in
+  let scope = Ctype.create_scope () in
+  let (id, newenv) = Env.enter_modtype ~scope pmtd_name.txt decl env in
+  Signature_names.check_modtype names pmtd_loc id;
+  let mtd =
+    {
+     mtd_id=id;
+     mtd_name=pmtd_name;
+     mtd_type=tmty;
+     mtd_attributes=pmtd_attributes;
+     mtd_loc=pmtd_loc;
+    }
+  in
+  newenv, mtd, Sig_modtype(id, decl, Exported)
+
+and transl_recmodule_modtypes env sdecls =
+  let make_env curr =
+    List.fold_left
+      (fun env (id, _, md, _) ->
+         Option.fold ~none:env
+           ~some:(fun id -> Env.add_module_declaration ~check:true ~arg:true
+                              id Mp_present md env) id)
+      env curr in
+  let transition env_c curr =
+    List.map2
+      (fun pmd (id, id_loc, md, _) ->
+        let tmty =
+          Builtin_attributes.warning_scope pmd.pmd_attributes
+            (fun () -> transl_modtype env_c pmd.pmd_type)
+        in
+        let md = { md with Types.md_type = tmty.mty_type } in
+        (id, id_loc, md, tmty))
+      sdecls curr in
+  let map_mtys curr =
+    List.filter_map
+      (fun (id, _, md, _) -> Option.map (fun id -> (id, md)) id)
+      curr
+  in
+  let scope = Ctype.create_scope () in
+  let ids =
+    List.map (fun x -> Option.map (Ident.create_scoped ~scope) x.pmd_name.txt)
+      sdecls
+  in
+  let approx_env =
+    List.fold_left
+      (fun env ->
+         Option.fold ~none:env ~some:(fun id -> (* cf #5965 *)
+           Env.enter_unbound_module (Ident.name id)
+             Mod_unbound_illegal_recursion env
+         ))
+      env ids
+  in
+  let init =
+    List.map2
+      (fun id pmd ->
+         let md =
+           { md_type = approx_modtype approx_env pmd.pmd_type;
+             md_loc = pmd.pmd_loc;
+             md_attributes = pmd.pmd_attributes;
+             md_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) }
+         in
+        (id, pmd.pmd_name, md, ()))
+      ids sdecls
+  in
+  let env0 = make_env init in
+  let dcl1 =
+    Warnings.without_warnings
+      (fun () -> transition env0 init)
+  in
+  let env1 = make_env dcl1 in
+  check_recmod_typedecls env1 (map_mtys dcl1);
+  let dcl2 = transition env1 dcl1 in
+(*
+  List.iter
+    (fun (id, mty) ->
+      Format.printf "%a: %a@." Printtyp.ident id Printtyp.modtype mty)
+    dcl2;
+*)
+  let env2 = make_env dcl2 in
+  check_recmod_typedecls env2 (map_mtys dcl2);
+  let dcl2 =
+    List.map2 (fun pmd (id, id_loc, md, mty) ->
+      let tmd =
+        {md_id=id; md_name=id_loc; md_type=mty;
+         md_presence=Mp_present;
+         md_loc=pmd.pmd_loc;
+         md_attributes=pmd.pmd_attributes}
+      in
+      tmd, md.md_uid
+    ) sdecls dcl2
+  in
+  (dcl2, env2)
+
+(* Try to convert a module expression to a module path. *)
+
+exception Not_a_path
+
+let rec path_of_module mexp =
+  match mexp.mod_desc with
+  | Tmod_ident (p,_) -> p
+  | Tmod_apply(funct, arg, _coercion) when !Clflags.applicative_functors ->
+      Papply(path_of_module funct, path_of_module arg)
+  | Tmod_constraint (mexp, _, _, _) ->
+      path_of_module mexp
+  | _ -> raise Not_a_path
+
+let path_of_module mexp =
+ try Some (path_of_module mexp) with Not_a_path -> None
+
+(* Check that all core type schemes in a structure are closed *)
+
+let rec closed_modtype env = function
+    Mty_ident _ -> true
+  | Mty_alias _ -> true
+  | Mty_signature sg ->
+      let env = Env.add_signature sg env in
+      List.for_all (closed_signature_item env) sg
+  | Mty_functor(arg_opt, body) ->
+      let env =
+        match arg_opt with
+        | Unit
+        | Named (None, _) -> env
+        | Named (Some id, param) ->
+            Env.add_module ~arg:true id Mp_present param env
+      in
+      closed_modtype env body
+
+and closed_signature_item env = function
+    Sig_value(_id, desc, _) -> Ctype.closed_schema env desc.val_type
+  | Sig_module(_id, _, md, _, _) -> closed_modtype env md.md_type
+  | _ -> true
+
+let check_nongen_scheme env sig_item =
+  match sig_item with
+    Sig_value(_id, vd, _) ->
+      if not (Ctype.closed_schema env vd.val_type) then
+        raise (Error (vd.val_loc, env, Non_generalizable vd.val_type))
+  | Sig_module (_id, _, md, _, _) ->
+      if not (closed_modtype env md.md_type) then
+        raise(Error(md.md_loc, env, Non_generalizable_module md.md_type))
+  | _ -> ()
+
+let check_nongen_schemes env sg =
+  List.iter (check_nongen_scheme env) sg
+
+(* Helpers for typing recursive modules *)
+
+let anchor_submodule name anchor =
+  match anchor, name with
+  | None, _
+  | _, None ->
+      None
+  | Some p, Some name ->
+      Some(Pdot(p, name))
+
+let anchor_recmodule = Option.map (fun id -> Pident id)
+
+let enrich_type_decls anchor decls oldenv newenv =
+  match anchor with
+    None -> newenv
+  | Some p ->
+      List.fold_left
+        (fun e info ->
+          let id = info.typ_id in
+          let info' =
+            Mtype.enrich_typedecl oldenv (Pdot(p, Ident.name id))
+              id info.typ_type
+          in
+            Env.add_type ~check:true id info' e)
+        oldenv decls
+
+let enrich_module_type anchor name mty env =
+  match anchor, name with
+  | None, _
+  | _, None ->
+      mty
+  | Some p, Some name ->
+      Mtype.enrich_modtype env (Pdot(p, name)) mty
+
+let check_recmodule_inclusion env bindings =
+  (* PR#4450, PR#4470: consider
+        module rec X : DECL = MOD  where MOD has inferred type ACTUAL
+     The "natural" typing condition
+        E, X: ACTUAL |- ACTUAL <: DECL
+     leads to circularities through manifest types.
+     Instead, we "unroll away" the potential circularities a finite number
+     of times.  The (weaker) condition we implement is:
+        E, X: DECL,
+           X1: ACTUAL,
+           X2: ACTUAL{X <- X1}/X1
+           ...
+           Xn: ACTUAL{X <- X(n-1)}/X(n-1)
+        |- ACTUAL{X <- Xn}/Xn <: DECL{X <- Xn}
+     so that manifest types rooted at X(n+1) are expanded in terms of X(n),
+     avoiding circularities.  The strengthenings ensure that
+     Xn.t = X(n-1).t = ... = X2.t = X1.t.
+     N can be chosen arbitrarily; larger values of N result in more
+     recursive definitions being accepted.  A good choice appears to be
+     the number of mutually recursive declarations. *)
+
+  let subst_and_strengthen env scope s id mty =
+    let mty = Subst.modtype (Rescope scope) s mty in
+    match id with
+    | None -> mty
+    | Some id ->
+        Mtype.strengthen ~aliasable:false env mty
+          (Subst.module_path s (Pident id))
+  in
+
+  let rec check_incl first_time n env s =
+    let scope = Ctype.create_scope () in
+    if n > 0 then begin
+      (* Generate fresh names Y_i for the rec. bound module idents X_i *)
+      let bindings1 =
+        List.map
+          (fun (id, _name, _mty_decl, _modl, mty_actual, _attrs, _loc, _uid) ->
+             let ids =
+               Option.map
+                 (fun id -> (id, Ident.create_scoped ~scope (Ident.name id))) id
+             in
+             (ids, mty_actual))
+          bindings in
+      (* Enter the Y_i in the environment with their actual types substituted
+         by the input substitution s *)
+      let env' =
+        List.fold_left
+          (fun env (ids, mty_actual) ->
+             match ids with
+             | None -> env
+             | Some (id, id') ->
+               let mty_actual' =
+                 if first_time
+                 then mty_actual
+                 else subst_and_strengthen env scope s (Some id) mty_actual
+               in
+               Env.add_module ~arg:false id' Mp_present mty_actual' env)
+          env bindings1 in
+      (* Build the output substitution Y_i <- X_i *)
+      let s' =
+        List.fold_left
+          (fun s (ids, _mty_actual) ->
+             match ids with
+             | None -> s
+             | Some (id, id') -> Subst.add_module id (Pident id') s)
+          Subst.identity bindings1 in
+      (* Recurse with env' and s' *)
+      check_incl false (n-1) env' s'
+    end else begin
+      (* Base case: check inclusion of s(mty_actual) in s(mty_decl)
+         and insert coercion if needed *)
+      let check_inclusion
+            (id, name, mty_decl, modl, mty_actual, attrs, loc, uid) =
+        let mty_decl' = Subst.modtype (Rescope scope) s mty_decl.mty_type
+        and mty_actual' = subst_and_strengthen env scope s id mty_actual in
+        let coercion =
+          try
+            Includemod.modtypes ~loc:modl.mod_loc ~mark:Mark_both env
+              mty_actual' mty_decl'
+          with Includemod.Error msg ->
+            raise(Error(modl.mod_loc, env, Not_included msg)) in
+        let modl' =
+            { mod_desc = Tmod_constraint(modl, mty_decl.mty_type,
+                Tmodtype_explicit mty_decl, coercion);
+              mod_type = mty_decl.mty_type;
+              mod_env = env;
+              mod_loc = modl.mod_loc;
+              mod_attributes = [];
+             } in
+        let mb =
+          {
+            mb_id = id;
+            mb_name = name;
+            mb_presence = Mp_present;
+            mb_expr = modl';
+            mb_attributes = attrs;
+            mb_loc = loc;
+          }
+        in
+        mb, uid
+      in
+      List.map check_inclusion bindings
+    end
+  in check_incl true (List.length bindings) env Subst.identity
+
+(* Helper for unpack *)
+
+let rec package_constraints env loc mty constrs =
+  if constrs = [] then mty
+  else let sg = extract_sig env loc mty in
+  let sg' =
+    List.map
+      (function
+        | Sig_type (id, ({type_params=[]} as td), rs, priv)
+          when List.mem_assoc [Ident.name id] constrs ->
+            let ty = List.assoc [Ident.name id] constrs in
+            Sig_type (id, {td with type_manifest = Some ty}, rs, priv)
+        | Sig_module (id, _, md, rs, priv) ->
+            let rec aux = function
+              | (m :: ((_ :: _) as l), t) :: rest when m = Ident.name id ->
+                  (l, t) :: aux rest
+              | _ :: rest -> aux rest
+              | [] -> []
+            in
+            let md =
+              {md with
+               md_type = package_constraints env loc md.md_type (aux constrs)
+              }
+            in
+            Sig_module (id, Mp_present, md, rs, priv)
+        | item -> item
+      )
+      sg
+  in
+  Mty_signature sg'
+
+let modtype_of_package env loc p nl tl =
+  match (Env.find_modtype p env).mtd_type with
+  | Some mty when nl <> [] ->
+      package_constraints env loc mty
+        (List.combine (List.map Longident.flatten nl) tl)
+  | _ | exception Not_found (* missing cmi *) ->
+      if nl = [] then Mty_ident p
+      else raise(Error(loc, env, Signature_expected))
+
+let package_subtype env p1 nl1 tl1 p2 nl2 tl2 =
+  let mkmty p nl tl =
+    let ntl =
+      List.filter (fun (_n,t) -> Ctype.free_variables t = [])
+        (List.combine nl tl) in
+    let (nl, tl) = List.split ntl in
+    modtype_of_package env Location.none p nl tl
+  in
+  let mty1 = mkmty p1 nl1 tl1 and mty2 = mkmty p2 nl2 tl2 in
+  let loc = Location.none in
+  match Includemod.modtypes ~loc ~mark:Mark_both env mty1 mty2 with
+  | Tcoerce_none -> true
+  | _ | exception Includemod.Error _ -> false
+
+let () = Ctype.package_subtype := package_subtype
+
+let wrap_constraint env mark arg mty explicit =
+  let mark = if mark then Includemod.Mark_both else Includemod.Mark_neither in
+  let coercion =
+    try
+      Includemod.modtypes ~loc:arg.mod_loc env ~mark arg.mod_type mty
+    with Includemod.Error msg ->
+      raise(Error(arg.mod_loc, env, Not_included msg)) in
+  { mod_desc = Tmod_constraint(arg, mty, explicit, coercion);
+    mod_type = mty;
+    mod_env = env;
+    mod_attributes = [];
+    mod_loc = arg.mod_loc }
+
+(* Type a module value expression *)
+
+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)
+
+and type_module_aux ~alias sttn funct_body anchor env smod =
+  match smod.pmod_desc with
+    Pmod_ident lid ->
+      let path =
+        Env.lookup_module_path ~load:(not alias) ~loc:smod.pmod_loc lid.txt env
+      in
+      let md = { mod_desc = Tmod_ident (path, lid);
+                 mod_type = Mty_alias path;
+                 mod_env = env;
+                 mod_attributes = smod.pmod_attributes;
+                 mod_loc = smod.pmod_loc } in
+      let aliasable = not (Env.is_functor_arg path env) in
+      let md =
+        if alias && aliasable then
+          (Env.add_required_global (Path.head path); md)
+        else match (Env.find_module path env).md_type with
+        | Mty_alias p1 when not alias ->
+            let p1 = Env.normalize_module_path (Some smod.pmod_loc) env p1 in
+            let mty = Includemod.expand_module_alias env [] p1 in
+            { md with
+              mod_desc =
+                Tmod_constraint (md, mty, Tmodtype_implicit,
+                                 Tcoerce_alias (env, path, Tcoerce_none));
+              mod_type =
+                if sttn then Mtype.strengthen ~aliasable:true env mty p1
+                else mty }
+        | mty ->
+            let mty =
+              if sttn then Mtype.strengthen ~aliasable env mty path
+              else mty
+            in
+            { md with mod_type = mty }
+      in md
+  | Pmod_structure sstr ->
+      let (str, sg, names, _finalenv) =
+        type_structure funct_body anchor env sstr smod.pmod_loc in
+      let md =
+        { mod_desc = Tmod_structure str;
+          mod_type = Mty_signature sg;
+          mod_env = env;
+          mod_attributes = smod.pmod_attributes;
+          mod_loc = smod.pmod_loc }
+      in
+      let sg' = Signature_names.simplify _finalenv names sg in
+      if List.length sg' = List.length sg then md else
+      wrap_constraint env false md (Mty_signature sg')
+        Tmodtype_implicit
+  | Pmod_functor(arg_opt, sbody) ->
+      let t_arg, ty_arg, newenv, funct_body =
+        match arg_opt with
+        | Unit -> Unit, Types.Unit, env, false
+        | Named (param, smty) ->
+          let mty = transl_modtype_functor_arg env smty in
+          let scope = Ctype.create_scope () in
+          let (id, newenv) =
+            match param.txt with
+            | None -> None, env
+            | Some name ->
+              let arg_md =
+                { md_type = mty.mty_type;
+                  md_attributes = [];
+                  md_loc = param.loc;
+                  md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+                }
+              in
+              let id, newenv =
+                Env.enter_module_declaration ~scope ~arg:true name Mp_present
+                  arg_md env
+              in
+              Some id, newenv
+          in
+          Named (id, param, mty), Types.Named (id, mty.mty_type), newenv, true
+      in
+      let body = type_module sttn funct_body None newenv sbody in
+      { mod_desc = Tmod_functor(t_arg, body);
+        mod_type = Mty_functor(ty_arg, body.mod_type);
+        mod_env = env;
+        mod_attributes = smod.pmod_attributes;
+        mod_loc = smod.pmod_loc }
+  | Pmod_apply(sfunct, sarg) ->
+      let arg = type_module true funct_body None env sarg in
+      let path = path_of_module arg in
+      let funct =
+        type_module (sttn && path <> None) funct_body None env sfunct in
+      begin match Env.scrape_alias env funct.mod_type with
+      | Mty_functor (Unit, mty_res) ->
+          if sarg.pmod_desc <> Pmod_structure [] then
+            raise (Error (sfunct.pmod_loc, env, Apply_generative));
+          if funct_body && Mtype.contains_type env funct.mod_type then
+            raise (Error (smod.pmod_loc, env, Not_allowed_in_functor_body));
+          { mod_desc = Tmod_apply(funct, arg, Tcoerce_none);
+            mod_type = mty_res;
+            mod_env = env;
+            mod_attributes = smod.pmod_attributes;
+            mod_loc = smod.pmod_loc }
+      | Mty_functor (Named (param, mty_param), mty_res) as mty_functor ->
+          let coercion =
+            try
+              Includemod.modtypes ~loc:sarg.pmod_loc ~mark:Mark_both env
+                arg.mod_type mty_param
+            with Includemod.Error msg ->
+              raise(Error(sarg.pmod_loc, env, Not_included msg)) in
+          let mty_appl =
+            match path with
+            | Some path ->
+                let scope = Ctype.create_scope () in
+                let subst =
+                  match param with
+                  | None -> Subst.identity
+                  | Some p -> Subst.add_module p path Subst.identity
+                in
+                Subst.modtype (Rescope scope) subst mty_res
+            | None ->
+                let env, nondep_mty =
+                  match param with
+                  | None -> env, mty_res
+                  | Some param ->
+                      let env =
+                        Env.add_module ~arg:true param Mp_present arg.mod_type
+                          env
+                      in
+                      check_well_formed_module env smod.pmod_loc
+                        "the signature of this functor application" mty_res;
+                      try env, Mtype.nondep_supertype env [param] mty_res
+                      with Ctype.Nondep_cannot_erase _ ->
+                        raise(Error(smod.pmod_loc, env,
+                                    Cannot_eliminate_dependency mty_functor))
+                in
+                begin match
+                  Includemod.modtypes ~mark:Mark_neither
+                    ~loc:smod.pmod_loc env mty_res nondep_mty
+                with
+                | Tcoerce_none -> ()
+                | _ ->
+                  fatal_error
+                    "unexpected coercion from original module type to \
+                     nondep_supertype one"
+                | exception Includemod.Error _ ->
+                  fatal_error
+                    "nondep_supertype not included in original module type"
+                end;
+                nondep_mty
+          in
+          check_well_formed_module env smod.pmod_loc
+            "the signature of this functor application" mty_appl;
+          { mod_desc = Tmod_apply(funct, arg, coercion);
+            mod_type = mty_appl;
+            mod_env = env;
+            mod_attributes = smod.pmod_attributes;
+            mod_loc = smod.pmod_loc }
+      | Mty_alias path ->
+          raise(Error(sfunct.pmod_loc, env, Cannot_scrape_alias path))
+      | _ ->
+          raise(Error(sfunct.pmod_loc, env, Cannot_apply funct.mod_type))
+      end
+  | Pmod_constraint(sarg, smty) ->
+      let arg = type_module ~alias true funct_body anchor env sarg in
+      let mty = transl_modtype env smty in
+      let md =
+        wrap_constraint env true arg mty.mty_type (Tmodtype_explicit mty)
+      in
+      { md with
+        mod_loc = smod.pmod_loc;
+        mod_attributes = smod.pmod_attributes;
+      }
+
+  | Pmod_unpack sexp ->
+      if !Clflags.principal then Ctype.begin_def ();
+      let exp = Typecore.type_exp env sexp in
+      if !Clflags.principal then begin
+        Ctype.end_def ();
+        Ctype.generalize_structure exp.exp_type
+      end;
+      let mty =
+        match Ctype.expand_head env exp.exp_type with
+          {desc = Tpackage (p, nl, tl)} ->
+            if List.exists (fun t -> Ctype.free_variables t <> []) tl 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");
+            modtype_of_package env smod.pmod_loc p nl tl
+        | {desc = Tvar _} ->
+            raise (Typecore.Error
+                     (smod.pmod_loc, env, Typecore.Cannot_infer_signature))
+        | _ ->
+            raise (Error(smod.pmod_loc, env, Not_a_packed_module exp.exp_type))
+      in
+      if funct_body && Mtype.contains_type env mty then
+        raise (Error (smod.pmod_loc, env, Not_allowed_in_functor_body));
+      { mod_desc = Tmod_unpack(exp, mty);
+        mod_type = mty;
+        mod_env = env;
+        mod_attributes = smod.pmod_attributes;
+        mod_loc = smod.pmod_loc }
+  | Pmod_extension ext ->
+      raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+and type_open_decl ?used_slot ?toplevel funct_body names env sod =
+  Builtin_attributes.warning_scope sod.popen_attributes
+    (fun () ->
+       type_open_decl_aux ?used_slot ?toplevel funct_body names env sod
+    )
+
+and type_open_decl_aux ?used_slot ?toplevel funct_body names env od =
+  let loc = od.popen_loc in
+  match od.popen_expr.pmod_desc with
+  | Pmod_ident lid ->
+    let path, newenv =
+      type_open_ ?used_slot ?toplevel od.popen_override env loc lid
+    in
+    let md = { mod_desc = Tmod_ident (path, lid);
+               mod_type = Mty_alias path;
+               mod_env = env;
+               mod_attributes = od.popen_expr.pmod_attributes;
+               mod_loc = od.popen_expr.pmod_loc }
+    in
+    let open_descr = {
+      open_expr = md;
+      open_bound_items = [];
+      open_override = od.popen_override;
+      open_env = newenv;
+      open_loc = loc;
+      open_attributes = od.popen_attributes
+    } in
+    open_descr, [], newenv
+  | _ ->
+    let md = type_module true funct_body None env od.popen_expr in
+    let scope = Ctype.create_scope () in
+    let sg, newenv =
+      Env.enter_signature ~scope (extract_sig_open env md.mod_loc md.mod_type)
+        env
+    in
+    let info, visibility =
+      match toplevel with
+      | Some false | None -> Some `From_open, Hidden
+      | Some true -> None, Exported
+    in
+    List.iter (Signature_names.check_sig_item ?info names loc) sg;
+    let sg =
+      List.map (function
+        | Sig_value(id, vd, _) -> Sig_value(id, vd, visibility)
+        | Sig_type(id, td, rs, _) -> Sig_type(id, td, rs, visibility)
+        | Sig_typext(id, ec, et, _) -> Sig_typext(id, ec, et, visibility)
+        | Sig_module(id, mp, md, rs, _) ->
+            Sig_module(id, mp, md, rs, visibility)
+        | Sig_modtype(id, mtd, _) -> Sig_modtype(id, mtd, visibility)
+        | Sig_class(id, cd, rs, _) -> Sig_class(id, cd, rs, visibility)
+        | Sig_class_type(id, ctd, rs, _) ->
+            Sig_class_type(id, ctd, rs, visibility)
+      ) sg
+    in
+    let open_descr = {
+      open_expr = md;
+      open_bound_items = sg;
+      open_override = od.popen_override;
+      open_env = newenv;
+      open_loc = loc;
+      open_attributes = od.popen_attributes
+    } in
+    open_descr, sg, newenv
+
+and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
+  let names = Signature_names.create () in
+
+  let type_str_item env srem {pstr_loc = loc; pstr_desc = desc} =
+    match desc with
+    | Pstr_eval (sexpr, attrs) ->
+        let expr =
+          Builtin_attributes.warning_scope attrs
+            (fun () -> Typecore.type_expression env sexpr)
+        in
+        Tstr_eval (expr, attrs), [], env
+    | Pstr_value(rec_flag, sdefs) ->
+        let scope =
+          match rec_flag with
+          | Recursive ->
+              Some (Annot.Idef {scope with
+                                Location.loc_start = loc.Location.loc_start})
+          | Nonrecursive ->
+              let start =
+                match srem with
+                | [] -> loc.Location.loc_end
+                | {pstr_loc = loc2} :: _ -> loc2.Location.loc_start
+              in
+              Some (Annot.Idef {scope with Location.loc_start = start})
+        in
+        let (defs, newenv) =
+          Typecore.type_binding env rec_flag sdefs scope in
+        let () = if rec_flag = Recursive then
+          Typecore.check_recursive_bindings env defs
+        in
+        (* Note: Env.find_value does not trigger the value_used event. Values
+           will be marked as being used during the signature inclusion test. *)
+        Tstr_value(rec_flag, defs),
+        List.map (fun (id, { Asttypes.loc; _ }, _typ)->
+          Signature_names.check_value names loc id;
+          Sig_value(id, Env.find_value (Pident id) newenv, Exported)
+        ) (let_bound_idents_full defs),
+        newenv
+    | Pstr_primitive sdesc ->
+        let (desc, newenv) = Typedecl.transl_value_decl env loc sdesc in
+        Signature_names.check_value names desc.val_loc desc.val_id;
+        Tstr_primitive desc,
+        [Sig_value(desc.val_id, desc.val_val, Exported)],
+        newenv
+    | Pstr_type (rec_flag, sdecls) ->
+        let (decls, newenv) = Typedecl.transl_type_decl env rec_flag sdecls in
+        List.iter
+          Signature_names.(fun td -> check_type names td.typ_loc td.typ_id)
+          decls;
+        Tstr_type (rec_flag, decls),
+        map_rec_type_with_row_types ~rec_flag
+          (fun rs info -> Sig_type(info.typ_id, info.typ_type, rs, Exported))
+          decls [],
+        enrich_type_decls anchor decls env newenv
+    | Pstr_typext styext ->
+        let (tyext, newenv) =
+          Typedecl.transl_type_extension true env loc styext
+        in
+        let constructors = tyext.tyext_constructors in
+        List.iter
+          Signature_names.(fun ext -> check_typext names ext.ext_loc ext.ext_id)
+          constructors;
+        (Tstr_typext tyext,
+         map_ext
+           (fun es ext -> Sig_typext(ext.ext_id, ext.ext_type, es, Exported))
+           constructors [],
+         newenv)
+    | Pstr_exception sext ->
+        let (ext, newenv) = Typedecl.transl_type_exception env sext in
+        let constructor = ext.tyexn_constructor in
+        Signature_names.check_typext names constructor.ext_loc
+          constructor.ext_id;
+        Tstr_exception ext,
+        [Sig_typext(constructor.ext_id,
+                    constructor.ext_type,
+                    Text_exception,
+                    Exported)],
+        newenv
+    | Pstr_module {pmb_name = name; pmb_expr = smodl; pmb_attributes = attrs;
+                   pmb_loc;
+                  } ->
+        let outer_scope = Ctype.get_current_level () in
+        let scope = Ctype.create_scope () in
+        let modl =
+          Builtin_attributes.warning_scope attrs
+            (fun () ->
+               type_module ~alias:true true funct_body
+                 (anchor_submodule name.txt anchor) env smodl
+            )
+        in
+        let pres =
+          match modl.mod_type with
+          | Mty_alias _ -> Mp_absent
+          | _ -> Mp_present
+        in
+        let md_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
+        let md =
+          { md_type = enrich_module_type anchor name.txt modl.mod_type env;
+            md_attributes = attrs;
+            md_loc = pmb_loc;
+            md_uid;
+          }
+        in
+        (*prerr_endline (Ident.unique_toplevel_name id);*)
+        Mtype.lower_nongen outer_scope md.md_type;
+        let id, newenv, sg =
+          match name.txt with
+          | None -> None, env, []
+          | Some name ->
+            let id, e = Env.enter_module_declaration ~scope name pres md env in
+            Signature_names.check_module names pmb_loc id;
+            Some id, e,
+            [Sig_module(id, pres,
+                        {md_type = modl.mod_type;
+                         md_attributes = attrs;
+                         md_loc = pmb_loc;
+                         md_uid;
+                        }, Trec_not, Exported)]
+        in
+        Tstr_module {mb_id=id; mb_name=name; mb_expr=modl;
+                     mb_presence=pres; mb_attributes=attrs;  mb_loc=pmb_loc; },
+        sg,
+        newenv
+    | Pstr_recmodule sbind ->
+        let sbind =
+          List.map
+            (function
+              | {pmb_name = name;
+                 pmb_expr = {pmod_desc=Pmod_constraint(expr, typ)};
+                 pmb_attributes = attrs;
+                 pmb_loc = loc;
+                } ->
+                  name, typ, expr, attrs, loc
+              | mb ->
+                  raise (Error (mb.pmb_expr.pmod_loc, env,
+                                Recursive_module_require_explicit_type))
+            )
+            sbind
+        in
+        let (decls, newenv) =
+          transl_recmodule_modtypes env
+            (List.map (fun (name, smty, _smodl, attrs, loc) ->
+                 {pmd_name=name; pmd_type=smty;
+                  pmd_attributes=attrs; pmd_loc=loc}) sbind
+            ) in
+        List.iter
+          (fun (md, _) ->
+            Option.iter Signature_names.(check_module names md.md_loc) md.md_id)
+          decls;
+        let bindings1 =
+          List.map2
+            (fun ({md_id=id; md_type=mty}, uid) (name, _, smodl, attrs, loc) ->
+               let modl =
+                 Builtin_attributes.warning_scope attrs
+                   (fun () ->
+                      type_module true funct_body (anchor_recmodule id)
+                        newenv smodl
+                   )
+               in
+               let mty' =
+                 enrich_module_type anchor name.txt modl.mod_type newenv
+               in
+               (id, name, mty, modl, mty', attrs, loc, uid))
+            decls sbind in
+        let newenv = (* allow aliasing recursive modules from outside *)
+          List.fold_left
+            (fun env (md, uid) ->
+               match md.md_id with
+               | None -> env
+               | Some id ->
+                   let mdecl =
+                     {
+                       md_type = md.md_type.mty_type;
+                       md_attributes = md.md_attributes;
+                       md_loc = md.md_loc;
+                       md_uid = uid;
+                     }
+                   in
+                   Env.add_module_declaration ~check:true
+                     id Mp_present mdecl env
+            )
+            env decls
+        in
+        let bindings2 =
+          check_recmodule_inclusion newenv bindings1 in
+        let mbs =
+          List.filter_map (fun (mb, uid) ->
+            Option.map (fun id -> id, mb, uid)  mb.mb_id
+          ) bindings2
+        in
+        Tstr_recmodule (List.map fst bindings2),
+        map_rec (fun rs (id, mb, uid) ->
+            Sig_module(id, Mp_present, {
+                md_type=mb.mb_expr.mod_type;
+                md_attributes=mb.mb_attributes;
+                md_loc=mb.mb_loc;
+                md_uid = uid;
+              }, rs, Exported))
+           mbs [],
+        newenv
+    | Pstr_modtype pmtd ->
+        (* check that it is non-abstract *)
+        let newenv, mtd, sg = transl_modtype_decl names env pmtd in
+        Tstr_modtype mtd, [sg], newenv
+    | Pstr_open sod ->
+        let (od, sg, newenv) =
+          type_open_decl ~toplevel funct_body names env sod
+        in
+        Tstr_open od, sg, newenv
+    | Pstr_class cl ->
+        let (classes, new_env) = Typeclass.class_declarations env cl in
+        List.iter (fun cls ->
+          let open Typeclass in
+          let loc = cls.cls_id_loc.Location.loc in
+          Signature_names.check_class names loc cls.cls_id;
+          Signature_names.check_class_type names loc cls.cls_ty_id;
+          Signature_names.check_type names loc cls.cls_obj_id;
+          Signature_names.check_type names loc cls.cls_typesharp_id;
+        ) classes;
+        Tstr_class
+          (List.map (fun cls ->
+               (cls.Typeclass.cls_info,
+                cls.Typeclass.cls_pub_methods)) classes),
+(* TODO: check with Jacques why this is here
+      Tstr_class_type
+          (List.map (fun (_,_, i, d, _,_,_,_,_,_,c) -> (i, c)) classes) ::
+      Tstr_type
+          (List.map (fun (_,_,_,_, i, d, _,_,_,_,_) -> (i, d)) classes) ::
+      Tstr_type
+          (List.map (fun (_,_,_,_,_,_, i, d, _,_,_) -> (i, d)) classes) ::
+*)
+        List.flatten
+          (map_rec
+            (fun rs cls ->
+              let open Typeclass in
+              [Sig_class(cls.cls_id, cls.cls_decl, rs, Exported);
+               Sig_class_type(cls.cls_ty_id, cls.cls_ty_decl, rs, Exported);
+               Sig_type(cls.cls_obj_id, cls.cls_obj_abbr, rs, Exported);
+               Sig_type(cls.cls_typesharp_id, cls.cls_abbr, rs, Exported)])
+             classes []),
+        new_env
+    | Pstr_class_type cl ->
+        let (classes, new_env) = Typeclass.class_type_declarations env cl in
+        List.iter (fun decl ->
+          let open Typeclass in
+          let loc = decl.clsty_id_loc.Location.loc in
+          Signature_names.check_class_type names loc decl.clsty_ty_id;
+          Signature_names.check_type names loc decl.clsty_obj_id;
+          Signature_names.check_type names loc decl.clsty_typesharp_id;
+        ) classes;
+        Tstr_class_type
+          (List.map (fun cl ->
+               (cl.Typeclass.clsty_ty_id,
+                cl.Typeclass.clsty_id_loc,
+                cl.Typeclass.clsty_info)) classes),
+(*  TODO: check with Jacques why this is here
+           Tstr_type
+             (List.map (fun (_, _, i, d, _, _) -> (i, d)) classes) ::
+           Tstr_type
+             (List.map (fun (_, _, _, _, i, d) -> (i, d)) classes) :: *)
+        List.flatten
+          (map_rec
+             (fun rs decl ->
+                let open Typeclass in
+                [Sig_class_type(decl.clsty_ty_id, decl.clsty_ty_decl, rs,
+                                Exported);
+                 Sig_type(decl.clsty_obj_id, decl.clsty_obj_abbr, rs, Exported);
+                 Sig_type(decl.clsty_typesharp_id, decl.clsty_abbr, rs,
+                          Exported)
+                ])
+             classes []),
+        new_env
+    | Pstr_include sincl ->
+        let smodl = sincl.pincl_mod in
+        let modl =
+          Builtin_attributes.warning_scope sincl.pincl_attributes
+            (fun () -> type_module true funct_body None env smodl)
+        in
+        let scope = Ctype.create_scope () in
+        (* Rename all identifiers bound by this signature to avoid clashes *)
+        let sg, new_env = Env.enter_signature ~scope
+            (extract_sig_open env smodl.pmod_loc modl.mod_type) env in
+        List.iter (Signature_names.check_sig_item names loc) sg;
+        let incl =
+          { incl_mod = modl;
+            incl_type = sg;
+            incl_attributes = sincl.pincl_attributes;
+            incl_loc = sincl.pincl_loc;
+          }
+        in
+        Tstr_include incl, sg, new_env
+    | Pstr_extension (ext, _attrs) ->
+        raise (Error_forward (Builtin_attributes.error_of_extension ext))
+    | Pstr_attribute x ->
+        Builtin_attributes.warning_attribute x;
+        Tstr_attribute x, [], env
+  in
+  let rec type_struct env sstr =
+    match sstr with
+    | [] -> ([], [], env)
+    | pstr :: srem ->
+        let previous_saved_types = Cmt_format.get_saved_types () in
+        let desc, sg, new_env = type_str_item env srem pstr in
+        let str = { str_desc = desc; str_loc = pstr.pstr_loc; str_env = env } in
+        Cmt_format.set_saved_types (Cmt_format.Partial_structure_item str
+                                    :: previous_saved_types);
+        let (str_rem, sig_rem, final_env) = type_struct new_env srem in
+        (str :: str_rem, sg @ sig_rem, final_env)
+  in
+  let previous_saved_types = Cmt_format.get_saved_types () in
+  let run () =
+    let (items, sg, final_env) = type_struct env sstr in
+    let str = { str_items = items; str_type = sg; str_final_env = final_env } in
+    Cmt_format.set_saved_types
+      (Cmt_format.Partial_structure str :: previous_saved_types);
+    str, sg, names, final_env
+  in
+  if toplevel then run ()
+  else Builtin_attributes.warning_scope [] run
+
+let type_toplevel_phrase env s =
+  Env.reset_required_globals ();
+  let (str, sg, to_remove_from_sg, env) =
+    type_structure ~toplevel:true false None env s Location.none in
+  (str, sg, to_remove_from_sg, env)
+
+let type_module_alias = type_module ~alias:true true false None
+let type_module = type_module true false None
+let type_structure = type_structure false None
+
+(* Normalize types in a signature *)
+
+let rec normalize_modtype env = function
+    Mty_ident _
+  | Mty_alias _ -> ()
+  | Mty_signature sg -> normalize_signature env sg
+  | Mty_functor(_param, body) -> normalize_modtype env body
+
+and normalize_signature env = List.iter (normalize_signature_item env)
+
+and normalize_signature_item env = function
+    Sig_value(_id, desc, _) -> Ctype.normalize_type env desc.val_type
+  | Sig_module(_id, _, md, _, _) -> normalize_modtype env md.md_type
+  | _ -> ()
+
+(* Extract the module type of a module expression *)
+
+let type_module_type_of env smod =
+  let remove_aliases = has_remove_aliases_attribute smod.pmod_attributes in
+  let tmty =
+    match smod.pmod_desc with
+    | Pmod_ident lid -> (* turn off strengthening in this case *)
+        let path, md = Env.lookup_module ~loc:smod.pmod_loc lid.txt env in
+          { mod_desc = Tmod_ident (path, lid);
+            mod_type = md.md_type;
+            mod_env = env;
+            mod_attributes = smod.pmod_attributes;
+            mod_loc = smod.pmod_loc }
+    | _ -> type_module env smod
+  in
+  let mty = Mtype.scrape_for_type_of ~remove_aliases env tmty.mod_type in
+  (* PR#5036: must not contain non-generalized type variables *)
+  if not (closed_modtype env mty) then
+    raise(Error(smod.pmod_loc, env, Non_generalizable_module mty));
+  tmty, mty
+
+(* For Typecore *)
+
+(* Graft a longident onto a path *)
+let rec extend_path path =
+  fun lid ->
+    match lid with
+    | Lident name -> Pdot(path, name)
+    | Ldot(m, name) -> Pdot(extend_path path m, name)
+    | Lapply _ -> assert false
+
+(* Lookup a type's longident within a signature *)
+let lookup_type_in_sig sg =
+  let types, modules =
+    List.fold_left
+      (fun acc item ->
+         match item with
+         | Sig_type(id, _, _, _) ->
+             let types, modules = acc in
+             let types = String.Map.add (Ident.name id) id types in
+             types, modules
+         | Sig_module(id, _, _, _, _) ->
+             let types, modules = acc in
+             let modules = String.Map.add (Ident.name id) id modules in
+             types, modules
+         | _ -> acc)
+      (String.Map.empty, String.Map.empty) sg
+  in
+  let rec module_path = function
+    | Lident name -> Pident (String.Map.find name modules)
+    | Ldot(m, name) -> Pdot(module_path m, name)
+    | Lapply _ -> assert false
+  in
+  fun lid ->
+    match lid with
+    | Lident name -> Pident (String.Map.find name types)
+    | Ldot(m, name) -> Pdot(module_path m, name)
+    | Lapply _ -> assert false
+
+let type_package env m p nl =
+  (* Same as Pexp_letmodule *)
+  (* remember original level *)
+  Ctype.begin_def ();
+  let context = Typetexp.narrow () in
+  let modl = type_module env m in
+  let scope = Ctype.create_scope () in
+  Typetexp.widen context;
+  let nl', tl', env =
+    match nl with
+    | [] -> [], [], env
+    | nl ->
+      let type_path, env =
+        match modl.mod_desc with
+        | Tmod_ident (mp,_)
+        | Tmod_constraint
+            ({mod_desc=Tmod_ident (mp,_)}, _, Tmodtype_implicit, _) ->
+          (* We special case these because interactions between
+             strengthening of module types and packages can cause
+             spurious escape errors. See examples from PR#6982 in the
+             testsuite. This can be removed when such issues are
+             fixed. *)
+          extend_path mp, env
+        | _ ->
+          let sg = extract_sig_open env modl.mod_loc modl.mod_type in
+          let sg, env = Env.enter_signature ~scope sg env in
+          lookup_type_in_sig sg, env
+      in
+      let nl', tl' =
+        List.fold_right
+          (fun lid (nl, tl) ->
+             match type_path lid with
+             | exception Not_found -> (nl, tl)
+             | path -> begin
+                 match Env.find_type path env with
+                 | exception Not_found -> (nl, tl)
+                 | decl ->
+                     if decl.type_arity > 0 then begin
+                       (nl, tl)
+                     end else begin
+                       let t = Btype.newgenty (Tconstr (path,[],ref Mnil)) in
+                       (lid :: nl, t :: tl)
+                     end
+               end)
+          nl ([], [])
+      in
+      nl', tl', env
+  in
+  (* go back to original level *)
+  Ctype.end_def ();
+  let mty =
+    if nl = [] then (Mty_ident p)
+    else modtype_of_package env modl.mod_loc p nl' tl'
+  in
+  List.iter2
+    (fun n ty ->
+      try Ctype.unify env ty (Ctype.newvar ())
+      with Ctype.Unify _ ->
+        raise (Error(modl.mod_loc, env, Scoping_pack (n,ty))))
+    nl' tl';
+  let modl = wrap_constraint env true modl mty Tmodtype_implicit in
+  (* Dropped exports should have produced an error above *)
+  assert (List.length nl = List.length tl');
+  modl, tl'
+
+(* Fill in the forward declarations *)
+
+let type_open_decl ?used_slot env od =
+  type_open_decl ?used_slot ?toplevel:None false (Signature_names.create ()) env
+    od
+
+let type_open_descr ?used_slot env od =
+  type_open_descr ?used_slot ?toplevel:None env od
+
+let () =
+  Typecore.type_module := type_module_alias;
+  Typetexp.transl_modtype_longident := transl_modtype_longident;
+  Typetexp.transl_modtype := transl_modtype;
+  Typecore.type_open := type_open_ ?toplevel:None;
+  Typecore.type_open_decl := type_open_decl;
+  Typecore.type_package := type_package;
+  Typeclass.type_open_descr := type_open_descr;
+  type_module_type_of_fwd := type_module_type_of
+
+
+(* Typecheck an implementation file *)
+
+let gen_annot outputprefix sourcefile annots =
+  Cmt2annot.gen_annot (Some (outputprefix ^ ".annot"))
+    ~sourcefile:(Some sourcefile) ~use_summaries:false annots
+
+let type_implementation sourcefile outputprefix modulename initial_env ast =
+  Cmt_format.clear ();
+  Misc.try_finally (fun () ->
+      Typecore.reset_delayed_checks ();
+      Env.reset_required_globals ();
+      if !Clflags.print_types then (* #7656 *)
+        Warnings.parse_options false "-32-34-37-38-60";
+      let (str, sg, names, finalenv) =
+        type_structure initial_env ast (Location.in_file sourcefile) in
+      let simple_sg = Signature_names.simplify finalenv names sg in
+      if !Clflags.print_types then begin
+        Typecore.force_delayed_checks ();
+        Printtyp.wrap_printing_env ~error:false initial_env
+          (fun () -> fprintf std_formatter "%a@."
+              (Printtyp.printed_signature sourcefile) simple_sg
+          );
+        gen_annot outputprefix sourcefile (Cmt_format.Implementation str);
+        (str, Tcoerce_none)   (* result is ignored by Compile.implementation *)
+      end else begin
+        let sourceintf =
+          Filename.remove_extension sourcefile ^ !Config.interface_suffix in
+        if Sys.file_exists sourceintf then begin
+          let intf_file =
+            try
+              Load_path.find_uncap (modulename ^ ".cmi")
+            with Not_found ->
+              raise(Error(Location.in_file sourcefile, Env.empty,
+                          Interface_not_compiled sourceintf)) in
+          let dclsig = Env.read_signature modulename intf_file in
+          let coercion =
+            Includemod.compunit initial_env ~mark:Mark_positive
+              sourcefile sg intf_file dclsig
+          in
+          Typecore.force_delayed_checks ();
+          (* It is important to run these checks after the inclusion test above,
+             so that value declarations which are not used internally but
+             exported are not reported as being unused. *)
+          let annots = Cmt_format.Implementation str in
+          Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename
+            annots (Some sourcefile) initial_env None;
+          gen_annot outputprefix sourcefile annots;
+          (str, coercion)
+        end else begin
+          let coercion =
+            Includemod.compunit initial_env ~mark:Mark_positive
+              sourcefile sg "(inferred signature)" simple_sg
+          in
+          check_nongen_schemes finalenv simple_sg;
+          normalize_signature finalenv simple_sg;
+          Typecore.force_delayed_checks ();
+          (* See comment above. Here the target signature contains all
+             the value being exported. We can still capture unused
+             declarations like "let x = true;; let x = 1;;", because in this
+             case, the inferred signature contains only the last declaration. *)
+          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 modulename (outputprefix ^ ".cmi")
+            in
+            let annots = Cmt_format.Implementation str in
+            Cmt_format.save_cmt  (outputprefix ^ ".cmt") modulename
+              annots (Some sourcefile) initial_env (Some cmi);
+            gen_annot outputprefix sourcefile annots
+          end;
+          (str, coercion)
+        end
+      end
+    )
+    ~exceptionally:(fun () ->
+        let annots =
+          Cmt_format.Partial_implementation
+            (Array.of_list (Cmt_format.get_saved_types ()))
+        in
+        Cmt_format.save_cmt  (outputprefix ^ ".cmt") modulename
+          annots (Some sourcefile) initial_env None;
+        gen_annot outputprefix sourcefile annots
+      )
+
+let save_signature modname tsg outputprefix source_file initial_env cmi =
+  Cmt_format.save_cmt  (outputprefix ^ ".cmti") modname
+    (Cmt_format.Interface tsg) (Some source_file) initial_env (Some cmi)
+
+let type_interface env ast =
+  transl_signature env ast
+
+(* "Packaging" of several compilation units into one unit
+   having them as sub-modules.  *)
+
+let package_signatures units =
+  let units_with_ids =
+    List.map
+      (fun (name, sg) ->
+        let oldid = Ident.create_persistent name in
+        let newid = Ident.create_local name in
+        (oldid, newid, sg))
+      units
+  in
+  let subst =
+    List.fold_left
+      (fun acc (oldid, newid, _) ->
+        Subst.add_module oldid (Pident newid) acc)
+      Subst.identity units_with_ids
+  in
+  List.map
+    (fun (_, newid, sg) ->
+      (* This signature won't be used for anything, it'll just be saved in a cmi
+         and cmt. *)
+      let sg = Subst.signature Make_local subst sg in
+      let md =
+        { md_type=Mty_signature sg;
+          md_attributes=[];
+          md_loc=Location.none;
+          md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+        }
+      in
+      Sig_module(newid, Mp_present, md, Trec_not, Exported))
+    units_with_ids
+
+let package_units initial_env objfiles cmifile modulename =
+  (* Read the signatures of the units *)
+  let units =
+    List.map
+      (fun f ->
+         let pref = chop_extensions f in
+         let modname = String.capitalize_ascii(Filename.basename pref) in
+         let sg = Env.read_signature modname (pref ^ ".cmi") in
+         if Filename.check_suffix f ".cmi" &&
+            not(Mtype.no_code_needed_sig Env.initial_safe_string sg)
+         then raise(Error(Location.none, Env.empty,
+                          Implementation_is_required f));
+         (modname, Env.read_signature modname (pref ^ ".cmi")))
+      objfiles in
+  (* Compute signature of packaged unit *)
+  Ident.reinit();
+  let sg = package_signatures units in
+  (* See if explicit interface is provided *)
+  let prefix = Filename.remove_extension cmifile in
+  let mlifile = prefix ^ !Config.interface_suffix in
+  if Sys.file_exists mlifile then begin
+    if not (Sys.file_exists cmifile) then begin
+      raise(Error(Location.in_file mlifile, Env.empty,
+                  Interface_not_compiled mlifile))
+    end;
+    let dclsig = Env.read_signature modulename cmifile in
+    Cmt_format.save_cmt  (prefix ^ ".cmt") modulename
+      (Cmt_format.Packed (sg, objfiles)) None initial_env  None ;
+    Includemod.compunit initial_env ~mark:Mark_both
+      "(obtained by packing)" sg mlifile dclsig
+  end else begin
+    (* Determine imports *)
+    let unit_names = List.map fst units in
+    let imports =
+      List.filter
+        (fun (name, _crc) -> not (List.mem name unit_names))
+        (Env.imports()) in
+    (* Write packaged signature *)
+    if not !Clflags.dont_write_files then begin
+      let cmi =
+        Env.save_signature_with_imports ~alerts:Misc.Stdlib.String.Map.empty
+          sg modulename
+          (prefix ^ ".cmi") imports
+      in
+      Cmt_format.save_cmt (prefix ^ ".cmt")  modulename
+        (Cmt_format.Packed (cmi.Cmi_format.cmi_sign, objfiles)) None initial_env
+        (Some cmi)
+    end;
+    Tcoerce_none
+  end
+
+(* Error report *)
+
+open Printtyp
+
+let report_error ppf = function
+    Cannot_apply mty ->
+      fprintf ppf
+        "@[This module is not a functor; it has type@ %a@]" modtype mty
+  | Not_included errs ->
+      fprintf ppf
+        "@[Signature mismatch:@ %a@]" Includemod.report_error errs
+  | Cannot_eliminate_dependency mty ->
+      fprintf ppf
+        "@[This functor has type@ %a@ \
+           The parameter cannot be eliminated in the result type.@ \
+           Please bind the argument to a module identifier.@]" modtype mty
+  | Signature_expected -> fprintf ppf "This module type is not a signature"
+  | Structure_expected mty ->
+      fprintf ppf
+        "@[This module is not a structure; it has type@ %a" modtype mty
+  | With_no_component lid ->
+      fprintf ppf
+        "@[The signature constrained by `with' has no component named %a@]"
+        longident lid
+  | With_mismatch(lid, explanation) ->
+      fprintf ppf
+        "@[\
+           @[In this `with' constraint, the new definition of %a@ \
+             does not match its original definition@ \
+             in the constrained signature:@]@ \
+           %a@]"
+        longident lid Includemod.report_error explanation
+  | With_makes_applicative_functor_ill_typed(lid, path, explanation) ->
+      fprintf ppf
+        "@[\
+           @[This `with' constraint on %a makes the applicative functor @ \
+             type %s ill-typed in the constrained signature:@]@ \
+           %a@]"
+        longident lid (Path.name path) Includemod.report_error explanation
+  | With_changes_module_alias(lid, id, path) ->
+      fprintf ppf
+        "@[\
+           @[This `with' constraint on %a changes %s, which is aliased @ \
+             in the constrained signature (as %s)@].@]"
+        longident lid (Path.name path) (Ident.name id)
+  | With_cannot_remove_constrained_type ->
+      fprintf ppf
+        "@[Destructive substitutions are not supported for constrained @ \
+              types (other than when replacing a type constructor with @ \
+              a type constructor with the same arguments).@]"
+  | Repeated_name(kind, name) ->
+      fprintf ppf
+        "@[Multiple definition of the %s name %s.@ \
+         Names must be unique in a given structure or signature.@]"
+        (Sig_component_kind.to_string kind) name
+  | Non_generalizable typ ->
+      fprintf ppf
+        "@[The type of this expression,@ %a,@ \
+           contains type variables that cannot be generalized@]" type_scheme typ
+  | Non_generalizable_class (id, desc) ->
+      fprintf ppf
+        "@[The type of this class,@ %a,@ \
+           contains type variables that cannot be generalized@]"
+        (class_declaration id) desc
+  | Non_generalizable_module mty ->
+      fprintf ppf
+        "@[The type of this module,@ %a,@ \
+           contains type variables that cannot be generalized@]" modtype mty
+  | Implementation_is_required intf_name ->
+      fprintf ppf
+        "@[The interface %a@ declares values, not just types.@ \
+           An implementation must be provided.@]"
+        Location.print_filename intf_name
+  | Interface_not_compiled intf_name ->
+      fprintf ppf
+        "@[Could not find the .cmi file for interface@ %a.@]"
+        Location.print_filename intf_name
+  | Not_allowed_in_functor_body ->
+      fprintf ppf
+        "@[This expression creates fresh types.@ %s@]"
+        "It is not allowed inside applicative functors."
+  | Not_a_packed_module ty ->
+      fprintf ppf
+        "This expression is not a packed module. It has type@ %a"
+        type_expr ty
+  | Incomplete_packed_module ty ->
+      fprintf ppf
+        "The type of this packed module contains variables:@ %a"
+        type_expr ty
+  | Scoping_pack (lid, ty) ->
+      fprintf ppf
+        "The type %a in this module cannot be exported.@ " longident lid;
+      fprintf ppf
+        "Its type contains local dependencies:@ %a" type_expr ty
+  | Recursive_module_require_explicit_type ->
+      fprintf ppf "Recursive modules require an explicit module type."
+  | Apply_generative ->
+      fprintf ppf "This is a generative functor. It can only be applied to ()"
+  | Cannot_scrape_alias p ->
+      fprintf ppf
+        "This is an alias for module %a, which is missing"
+        path p
+  | Badly_formed_signature (context, err) ->
+      fprintf ppf "@[In %s:@ %a@]" context Typedecl.report_error err
+  | Cannot_hide_id Illegal_shadowing
+      { shadowed_item_kind; shadowed_item_id; shadowed_item_loc;
+        shadower_id; user_id; user_kind; user_loc } ->
+      let shadowed_item_kind= Sig_component_kind.to_string shadowed_item_kind in
+      fprintf ppf
+        "@[Illegal shadowing of included %s %a by %a@ \
+         %a:@;<1 2>%s %a came from this include@ \
+         %a:@;<1 2>The %s %s has no valid type if %a is shadowed@]"
+        shadowed_item_kind Ident.print shadowed_item_id Ident.print shadower_id
+        Location.print_loc shadowed_item_loc
+        (String.capitalize_ascii shadowed_item_kind)
+        Ident.print shadowed_item_id
+        Location.print_loc user_loc
+        (Sig_component_kind.to_string user_kind) (Ident.name user_id)
+        Ident.print shadowed_item_id
+  | Cannot_hide_id Appears_in_signature
+      { opened_item_kind; opened_item_id; user_id; user_kind; user_loc } ->
+      let opened_item_kind= Sig_component_kind.to_string opened_item_kind in
+      fprintf ppf
+        "@[The %s %a introduced by this open appears in the signature@ \
+         %a:@;<1 2>The %s %s has no valid type if %a is hidden@]"
+        opened_item_kind Ident.print opened_item_id
+        Location.print_loc user_loc
+        (Sig_component_kind.to_string user_kind) (Ident.name user_id)
+        Ident.print opened_item_id
+  | Invalid_type_subst_rhs ->
+      fprintf ppf "Only type synonyms are allowed on the right of :="
+
+let report_error env ppf err =
+  Printtyp.wrap_printing_env ~error:true env (fun () -> report_error ppf err)
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (loc, env, err) ->
+        Some (Location.error_of_printer ~loc (report_error env) err)
+      | Error_forward err ->
+        Some err
+      | _ ->
+        None
+    )
diff --git a/typing/typemod.mli b/typing/typemod.mli
new file mode 100644
index 00000000..f74a57d8
--- /dev/null
+++ b/typing/typemod.mli
@@ -0,0 +1,137 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Type-checking of the module language and typed ast hooks
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Types
+open Format
+
+module Signature_names : sig
+  type t
+
+  val simplify: Env.t -> t -> signature -> signature
+end
+
+val type_module:
+        Env.t -> Parsetree.module_expr -> Typedtree.module_expr
+val type_structure:
+  Env.t -> Parsetree.structure -> Location.t ->
+  Typedtree.structure * Types.signature * Signature_names.t * Env.t
+val type_toplevel_phrase:
+  Env.t -> Parsetree.structure ->
+  Typedtree.structure * Types.signature * Signature_names.t * Env.t
+val type_implementation:
+  string -> string -> string -> Env.t -> Parsetree.structure ->
+  Typedtree.structure * Typedtree.module_coercion
+val type_interface:
+        Env.t -> Parsetree.signature -> Typedtree.signature
+val transl_signature:
+        Env.t -> Parsetree.signature -> Typedtree.signature
+val check_nongen_schemes:
+        Env.t -> Types.signature -> unit
+        (*
+val type_open_:
+        ?used_slot:bool ref -> ?toplevel:bool ->
+        Asttypes.override_flag ->
+        Env.t -> Location.t -> Longident.t Asttypes.loc -> Path.t * Env.t
+        *)
+val modtype_of_package:
+        Env.t -> Location.t ->
+        Path.t -> Longident.t list -> type_expr list -> module_type
+
+val path_of_module : Typedtree.module_expr -> Path.t option
+
+val save_signature:
+  string -> Typedtree.signature -> string -> string ->
+  Env.t -> Cmi_format.cmi_infos -> unit
+
+val package_units:
+  Env.t -> string list -> string -> string -> Typedtree.module_coercion
+
+(* Should be in Envaux, but it breaks the build of the debugger *)
+val initial_env:
+  loc:Location.t -> safe_string:bool ->
+  initially_opened_module:string option ->
+  open_implicit_modules:string list -> Env.t
+
+module Sig_component_kind : sig
+  type t =
+    | Value
+    | Type
+    | Module
+    | Module_type
+    | Extension_constructor
+    | Class
+    | Class_type
+
+  val to_string : t -> string
+end
+
+type hiding_error =
+  | Illegal_shadowing of {
+      shadowed_item_id: Ident.t;
+      shadowed_item_kind: Sig_component_kind.t;
+      shadowed_item_loc: Location.t;
+      shadower_id: Ident.t;
+      user_id: Ident.t;
+      user_kind: Sig_component_kind.t;
+      user_loc: Location.t;
+    }
+  | Appears_in_signature of {
+      opened_item_id: Ident.t;
+      opened_item_kind: Sig_component_kind.t;
+      user_id: Ident.t;
+      user_kind: Sig_component_kind.t;
+      user_loc: Location.t;
+    }
+
+type error =
+    Cannot_apply of module_type
+  | Not_included of Includemod.error list
+  | Cannot_eliminate_dependency of module_type
+  | Signature_expected
+  | Structure_expected of module_type
+  | With_no_component of Longident.t
+  | With_mismatch of Longident.t * Includemod.error list
+  | With_makes_applicative_functor_ill_typed of
+      Longident.t * Path.t * Includemod.error list
+  | With_changes_module_alias of Longident.t * Ident.t * Path.t
+  | With_cannot_remove_constrained_type
+  | Repeated_name of Sig_component_kind.t * string
+  | Non_generalizable of type_expr
+  | Non_generalizable_class of Ident.t * class_declaration
+  | Non_generalizable_module of module_type
+  | Implementation_is_required of string
+  | Interface_not_compiled of string
+  | Not_allowed_in_functor_body
+  | Not_a_packed_module of type_expr
+  | Incomplete_packed_module of type_expr
+  | Scoping_pack of Longident.t * type_expr
+  | Recursive_module_require_explicit_type
+  | Apply_generative
+  | Cannot_scrape_alias of Path.t
+  | Badly_formed_signature of string * Typedecl.error
+  | Cannot_hide_id of hiding_error
+  | Invalid_type_subst_rhs
+
+exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
+
+val report_error: Env.t -> formatter -> error -> unit
diff --git a/typing/typeopt.ml b/typing/typeopt.ml
new file mode 100644
index 00000000..8ca209a5
--- /dev/null
+++ b/typing/typeopt.ml
@@ -0,0 +1,215 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1998 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Auxiliaries for type-based optimizations, e.g. array kinds *)
+
+open Path
+open Types
+open Asttypes
+open Typedtree
+open Lambda
+
+let scrape_ty env ty =
+  let ty = Ctype.expand_head_opt env (Ctype.correct_levels ty) in
+  match ty.desc with
+  | Tconstr (p, _, _) ->
+      begin match Env.find_type p env with
+      | {type_unboxed = {unboxed = true; _}; _} ->
+        begin match Typedecl.get_unboxed_type_representation env ty with
+        | None -> ty
+        | Some ty2 -> ty2
+        end
+      | _ -> ty
+      | exception Not_found -> ty
+      end
+  | _ -> ty
+
+let scrape env ty =
+  (scrape_ty env ty).desc
+
+let is_function_type env ty =
+  match scrape env ty with
+  | Tarrow (_, lhs, rhs, _) -> Some (lhs, rhs)
+  | _ -> None
+
+let is_base_type env ty base_ty_path =
+  match scrape env ty with
+  | Tconstr(p, _, _) -> Path.same p base_ty_path
+  | _ -> false
+
+let maybe_pointer_type env ty =
+  let ty = scrape_ty env ty in
+  if Ctype.maybe_pointer_type env ty then
+    Pointer
+  else
+    Immediate
+
+let maybe_pointer exp = maybe_pointer_type exp.exp_env exp.exp_type
+
+type classification =
+  | Int
+  | Float
+  | Lazy
+  | Addr  (* anything except a float or a lazy *)
+  | Any
+
+let classify env ty =
+  let ty = scrape_ty env ty in
+  if maybe_pointer_type env ty = Immediate then Int
+  else match ty.desc with
+  | Tvar _ | Tunivar _ ->
+      Any
+  | Tconstr (p, _args, _abbrev) ->
+      if Path.same p Predef.path_float then Float
+      else if Path.same p Predef.path_lazy_t then Lazy
+      else if Path.same p Predef.path_string
+           || Path.same p Predef.path_bytes
+           || Path.same p Predef.path_array
+           || Path.same p Predef.path_nativeint
+           || Path.same p Predef.path_int32
+           || Path.same p Predef.path_int64 then Addr
+      else begin
+        try
+          match (Env.find_type p env).type_kind with
+          | Type_abstract ->
+              Any
+          | Type_record _ | Type_variant _ | Type_open ->
+              Addr
+        with Not_found ->
+          (* This can happen due to e.g. missing -I options,
+             causing some .cmi files to be unavailable.
+             Maybe we should emit a warning. *)
+          Any
+      end
+  | Tarrow _ | Ttuple _ | Tpackage _ | Tobject _ | Tnil | Tvariant _ ->
+      Addr
+  | Tlink _ | Tsubst _ | Tpoly _ | Tfield _ ->
+      assert false
+
+let array_type_kind env ty =
+  match scrape env ty with
+  | Tconstr(p, [elt_ty], _) | Tpoly({desc = Tconstr(p, [elt_ty], _)}, _)
+    when Path.same p Predef.path_array ->
+      begin match classify env elt_ty with
+      | Any -> if Config.flat_float_array then Pgenarray else Paddrarray
+      | Float -> if Config.flat_float_array then Pfloatarray else Paddrarray
+      | Addr | Lazy -> Paddrarray
+      | Int -> Pintarray
+      end
+  | Tconstr(p, [], _) | Tpoly({desc = Tconstr(p, [], _)}, _)
+    when Path.same p Predef.path_floatarray ->
+      Pfloatarray
+  | _ ->
+      (* This can happen with e.g. Obj.field *)
+      Pgenarray
+
+let array_kind exp = array_type_kind exp.exp_env exp.exp_type
+
+let array_pattern_kind pat = array_type_kind pat.pat_env pat.pat_type
+
+let bigarray_decode_type env ty tbl dfl =
+  match scrape env ty with
+  | Tconstr(Pdot(Pident mod_id, type_name), [], _)
+    when Ident.name mod_id = "Stdlib__bigarray" ->
+      begin try List.assoc type_name tbl with Not_found -> dfl end
+  | _ ->
+      dfl
+
+let kind_table =
+  ["float32_elt", Pbigarray_float32;
+   "float64_elt", Pbigarray_float64;
+   "int8_signed_elt", Pbigarray_sint8;
+   "int8_unsigned_elt", Pbigarray_uint8;
+   "int16_signed_elt", Pbigarray_sint16;
+   "int16_unsigned_elt", Pbigarray_uint16;
+   "int32_elt", Pbigarray_int32;
+   "int64_elt", Pbigarray_int64;
+   "int_elt", Pbigarray_caml_int;
+   "nativeint_elt", Pbigarray_native_int;
+   "complex32_elt", Pbigarray_complex32;
+   "complex64_elt", Pbigarray_complex64]
+
+let layout_table =
+  ["c_layout", Pbigarray_c_layout;
+   "fortran_layout", Pbigarray_fortran_layout]
+
+let bigarray_type_kind_and_layout env typ =
+  match scrape env typ with
+  | Tconstr(_p, [_caml_type; elt_type; layout_type], _abbrev) ->
+      (bigarray_decode_type env elt_type kind_table Pbigarray_unknown,
+       bigarray_decode_type env layout_type layout_table
+                            Pbigarray_unknown_layout)
+  | _ ->
+      (Pbigarray_unknown, Pbigarray_unknown_layout)
+
+let value_kind env ty =
+  match scrape env ty with
+  | Tconstr(p, _, _) when Path.same p Predef.path_int ->
+      Pintval
+  | Tconstr(p, _, _) when Path.same p Predef.path_char ->
+      Pintval
+  | Tconstr(p, _, _) when Path.same p Predef.path_float ->
+      Pfloatval
+  | Tconstr(p, _, _) when Path.same p Predef.path_int32 ->
+      Pboxedintval Pint32
+  | Tconstr(p, _, _) when Path.same p Predef.path_int64 ->
+      Pboxedintval Pint64
+  | Tconstr(p, _, _) when Path.same p Predef.path_nativeint ->
+      Pboxedintval Pnativeint
+  | _ ->
+      Pgenval
+
+let function_return_value_kind env ty =
+  match is_function_type env ty with
+  | Some (_lhs, rhs) -> value_kind env rhs
+  | None -> Pgenval
+
+(** Whether a forward block is needed for a lazy thunk on a value, i.e.
+    if the value can be represented as a float/forward/lazy *)
+let lazy_val_requires_forward env ty =
+  match classify env ty with
+  | Any | Lazy -> true
+  | Float -> Config.flat_float_array
+  | Addr | Int -> false
+
+(** The compilation of the expression [lazy e] depends on the form of e:
+    constants, floats and identifiers are optimized.  The optimization must be
+    taken into account when determining whether a recursive binding is safe. *)
+let classify_lazy_argument : Typedtree.expression ->
+                             [`Constant_or_function
+                             |`Float_that_cannot_be_shortcut
+                             |`Identifier of [`Forward_value|`Other]
+                             |`Other] =
+  fun e -> match e.exp_desc with
+    | Texp_constant
+        ( Const_int _ | Const_char _ | Const_string _
+        | Const_int32 _ | Const_int64 _ | Const_nativeint _ )
+    | Texp_function _
+    | Texp_construct (_, {cstr_arity = 0}, _) ->
+       `Constant_or_function
+    | Texp_constant(Const_float _) ->
+       if Config.flat_float_array
+       then `Float_that_cannot_be_shortcut
+       else `Constant_or_function
+    | Texp_ident _ when lazy_val_requires_forward e.exp_env e.exp_type ->
+       `Identifier `Forward_value
+    | Texp_ident _ ->
+       `Identifier `Other
+    | _ ->
+       `Other
+
+let value_kind_union k1 k2 =
+  if k1 = k2 then k1
+  else Pgenval
diff --git a/typing/typeopt.mli b/typing/typeopt.mli
new file mode 100644
index 00000000..0f6b9f37
--- /dev/null
+++ b/typing/typeopt.mli
@@ -0,0 +1,43 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1998 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Auxiliaries for type-based optimizations, e.g. array kinds *)
+
+val is_function_type :
+      Env.t -> Types.type_expr -> (Types.type_expr * Types.type_expr) option
+val is_base_type : Env.t -> Types.type_expr -> Path.t -> bool
+
+val maybe_pointer_type : Env.t -> Types.type_expr
+  -> Lambda.immediate_or_pointer
+val maybe_pointer : Typedtree.expression -> Lambda.immediate_or_pointer
+
+val array_type_kind : Env.t -> Types.type_expr -> Lambda.array_kind
+val array_kind : Typedtree.expression -> Lambda.array_kind
+val array_pattern_kind : Typedtree.pattern -> Lambda.array_kind
+val bigarray_type_kind_and_layout :
+      Env.t -> Types.type_expr -> Lambda.bigarray_kind * Lambda.bigarray_layout
+val value_kind : Env.t -> Types.type_expr -> Lambda.value_kind
+val function_return_value_kind : Env.t -> Types.type_expr -> Lambda.value_kind
+
+val classify_lazy_argument : Typedtree.expression ->
+                             [ `Constant_or_function
+                             | `Float_that_cannot_be_shortcut
+                             | `Identifier of [`Forward_value | `Other]
+                             | `Other]
+
+val value_kind_union :
+      Lambda.value_kind -> Lambda.value_kind -> Lambda.value_kind
+  (** [value_kind_union k1 k2] is a value_kind at least as general as
+      [k1] and [k2] *)
diff --git a/typing/types.ml b/typing/types.ml
new file mode 100644
index 00000000..f03a4bc6
--- /dev/null
+++ b/typing/types.ml
@@ -0,0 +1,470 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Representation of types and declarations *)
+
+open Asttypes
+
+(* Type expressions for the core language *)
+
+type type_expr =
+  { mutable desc: type_desc;
+    mutable level: int;
+    mutable scope: int;
+    id: int }
+
+and type_desc =
+    Tvar of string option
+  | Tarrow of arg_label * type_expr * type_expr * commutable
+  | Ttuple of type_expr list
+  | Tconstr of Path.t * type_expr list * abbrev_memo ref
+  | Tobject of type_expr * (Path.t * type_expr list) option ref
+  | Tfield of string * field_kind * type_expr * type_expr
+  | Tnil
+  | Tlink of type_expr
+  | Tsubst of type_expr         (* for copying *)
+  | Tvariant of row_desc
+  | Tunivar of string option
+  | Tpoly of type_expr * type_expr list
+  | Tpackage of Path.t * Longident.t list * type_expr list
+
+and row_desc =
+    { row_fields: (label * row_field) list;
+      row_more: type_expr;
+      row_bound: unit;
+      row_closed: bool;
+      row_fixed: fixed_explanation option;
+      row_name: (Path.t * type_expr list) option }
+and fixed_explanation =
+  | Univar of type_expr | Fixed_private | Reified of Path.t | Rigid
+and row_field =
+    Rpresent of type_expr option
+  | Reither of bool * type_expr list * bool * row_field option ref
+        (* 1st true denotes a constant constructor *)
+        (* 2nd true denotes a tag in a pattern matching, and
+           is erased later *)
+  | Rabsent
+
+and abbrev_memo =
+    Mnil
+  | Mcons of private_flag * Path.t * type_expr * type_expr * abbrev_memo
+  | Mlink of abbrev_memo ref
+
+and field_kind =
+    Fvar of field_kind option ref
+  | Fpresent
+  | Fabsent
+
+and commutable =
+    Cok
+  | Cunknown
+  | Clink of commutable ref
+
+module TypeOps = struct
+  type t = type_expr
+  let compare t1 t2 = t1.id - t2.id
+  let hash t = t.id
+  let equal t1 t2 = t1 == t2
+end
+
+(* *)
+
+module Uid = struct
+  type t =
+    | Compilation_unit of string
+    | Item of { comp_unit: string; id: int }
+    | Internal
+    | Predef of string
+
+  include Identifiable.Make(struct
+    type nonrec t = t
+
+    let equal (x : t) y = x = y
+    let compare (x : t) y = compare x y
+    let hash (x : t) = Hashtbl.hash x
+
+    let print fmt = function
+      | Internal -> Format.pp_print_string fmt ""
+      | Predef name -> Format.fprintf fmt "" name
+      | Compilation_unit s -> Format.pp_print_string fmt s
+      | Item { comp_unit; id } -> Format.fprintf fmt "%s.%d" comp_unit id
+
+    let output oc t =
+      let fmt = Format.formatter_of_out_channel oc in
+      print fmt t
+  end)
+
+  let id = ref (-1)
+
+  let reinit () = id := (-1)
+
+  let mk  ~current_unit =
+      incr id;
+      Item { comp_unit = current_unit; id = !id }
+
+  let of_compilation_unit_id id =
+    if not (Ident.persistent id) then
+      Misc.fatal_errorf "Types.Uid.of_compilation_unit_id %S" (Ident.name id);
+    Compilation_unit (Ident.name id)
+
+  let of_predef_id id =
+    if not (Ident.is_predef id) then
+      Misc.fatal_errorf "Types.Uid.of_predef_id %S" (Ident.name id);
+    Predef (Ident.name id)
+
+  let internal_not_actually_unique = Internal
+
+  let for_actual_declaration = function
+    | Item _ -> true
+    | _ -> false
+end
+
+(* Maps of methods and instance variables *)
+
+module Meths = Misc.Stdlib.String.Map
+module Vars = Meths
+
+(* Value descriptions *)
+
+type value_description =
+  { val_type: type_expr;                (* Type of the value *)
+    val_kind: value_kind;
+    val_loc: Location.t;
+    val_attributes: Parsetree.attributes;
+    val_uid: Uid.t;
+  }
+
+and value_kind =
+    Val_reg                             (* Regular value *)
+  | Val_prim of Primitive.description   (* Primitive *)
+  | Val_ivar of mutable_flag * string   (* Instance variable (mutable ?) *)
+  | Val_self of (Ident.t * type_expr) Meths.t ref *
+                (Ident.t * Asttypes.mutable_flag *
+                 Asttypes.virtual_flag * type_expr) Vars.t ref *
+                string * type_expr
+                                        (* Self *)
+  | Val_anc of (string * Ident.t) list * string
+                                        (* Ancestor *)
+
+(* Variance *)
+
+module Variance = struct
+  type t = int
+  type f = May_pos | May_neg | May_weak | Inj | Pos | Neg | Inv
+  let single = function
+    | May_pos -> 1
+    | May_neg -> 2
+    | May_weak -> 4
+    | Inj -> 8
+    | Pos -> 16
+    | Neg -> 32
+    | Inv -> 64
+  let union v1 v2 = v1 lor v2
+  let inter v1 v2 = v1 land v2
+  let subset v1 v2 = (v1 land v2 = v1)
+  let eq (v1 : t) v2 = (v1 = v2)
+  let set x b v =
+    if b then v lor single x else  v land (lnot (single x))
+  let mem x = subset (single x)
+  let null = 0
+  let may_inv = 7
+  let full = 127
+  let covariant = single May_pos lor single Pos lor single Inj
+  let swap f1 f2 v =
+    let v' = set f1 (mem f2 v) v in set f2 (mem f1 v) v'
+  let conjugate v = swap May_pos May_neg (swap Pos Neg v)
+  let get_upper v = (mem May_pos v, mem May_neg v)
+  let get_lower v = (mem Pos v, mem Neg v, mem Inv v, mem Inj v)
+end
+
+module Separability = struct
+  type t = Ind | Sep | Deepsep
+  type signature = t list
+  let eq (m1 : t) m2 = (m1 = m2)
+  let rank = function
+    | Ind -> 0
+    | Sep -> 1
+    | Deepsep -> 2
+  let compare m1 m2 = compare (rank m1) (rank m2)
+  let max m1 m2 = if rank m1 >= rank m2 then m1 else m2
+
+  let print ppf = function
+    | Ind -> Format.fprintf ppf "Ind"
+    | Sep -> Format.fprintf ppf "Sep"
+    | Deepsep -> Format.fprintf ppf "Deepsep"
+
+  let print_signature ppf modes =
+    let pp_sep ppf () = Format.fprintf ppf ",@," in
+    Format.fprintf ppf "@[(%a)@]"
+      (Format.pp_print_list ~pp_sep print) modes
+
+  let default_signature ~arity =
+    let default_mode = if Config.flat_float_array then Deepsep else Ind in
+    List.init arity (fun _ -> default_mode)
+end
+
+(* Type definitions *)
+
+type type_declaration =
+  { type_params: type_expr list;
+    type_arity: int;
+    type_kind: type_kind;
+    type_private: private_flag;
+    type_manifest: type_expr option;
+    type_variance: Variance.t list;
+    type_separability: Separability.t list;
+    type_is_newtype: bool;
+    type_expansion_scope: int;
+    type_loc: Location.t;
+    type_attributes: Parsetree.attributes;
+    type_immediate: Type_immediacy.t;
+    type_unboxed: unboxed_status;
+    type_uid: Uid.t;
+ }
+
+and type_kind =
+    Type_abstract
+  | Type_record of label_declaration list  * record_representation
+  | Type_variant of constructor_declaration list
+  | Type_open
+
+and record_representation =
+    Record_regular                      (* All fields are boxed / tagged *)
+  | Record_float                        (* All fields are floats *)
+  | Record_unboxed of bool    (* Unboxed single-field record, inlined or not *)
+  | Record_inlined of int               (* Inlined record *)
+  | Record_extension of Path.t          (* Inlined record under extension *)
+
+and label_declaration =
+  {
+    ld_id: Ident.t;
+    ld_mutable: mutable_flag;
+    ld_type: type_expr;
+    ld_loc: Location.t;
+    ld_attributes: Parsetree.attributes;
+    ld_uid: Uid.t;
+  }
+
+and constructor_declaration =
+  {
+    cd_id: Ident.t;
+    cd_args: constructor_arguments;
+    cd_res: type_expr option;
+    cd_loc: Location.t;
+    cd_attributes: Parsetree.attributes;
+    cd_uid: Uid.t;
+  }
+
+and constructor_arguments =
+  | Cstr_tuple of type_expr list
+  | Cstr_record of label_declaration list
+
+and unboxed_status =
+  {
+    unboxed: bool;
+    default: bool; (* False if the unboxed field was set from an attribute. *)
+  }
+
+let unboxed_false_default_false = {unboxed = false; default = false}
+let unboxed_false_default_true = {unboxed = false; default = true}
+let unboxed_true_default_false = {unboxed = true; default = false}
+let unboxed_true_default_true = {unboxed = true; default = true}
+
+type extension_constructor =
+  { ext_type_path: Path.t;
+    ext_type_params: type_expr list;
+    ext_args: constructor_arguments;
+    ext_ret_type: type_expr option;
+    ext_private: private_flag;
+    ext_loc: Location.t;
+    ext_attributes: Parsetree.attributes;
+    ext_uid: Uid.t;
+  }
+
+and type_transparence =
+    Type_public      (* unrestricted expansion *)
+  | Type_new         (* "new" type *)
+  | Type_private     (* private type *)
+
+(* Type expressions for the class language *)
+
+module Concr = Misc.Stdlib.String.Set
+
+type class_type =
+    Cty_constr of Path.t * type_expr list * class_type
+  | Cty_signature of class_signature
+  | Cty_arrow of arg_label * type_expr * class_type
+
+and class_signature =
+  { csig_self: type_expr;
+    csig_vars:
+      (Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr) Vars.t;
+    csig_concr: Concr.t;
+    csig_inher: (Path.t * type_expr list) list }
+
+type class_declaration =
+  { cty_params: type_expr list;
+    mutable cty_type: class_type;
+    cty_path: Path.t;
+    cty_new: type_expr option;
+    cty_variance: Variance.t list;
+    cty_loc: Location.t;
+    cty_attributes: Parsetree.attributes;
+    cty_uid: Uid.t;
+ }
+
+type class_type_declaration =
+  { clty_params: type_expr list;
+    clty_type: class_type;
+    clty_path: Path.t;
+    clty_variance: Variance.t list;
+    clty_loc: Location.t;
+    clty_attributes: Parsetree.attributes;
+    clty_uid: Uid.t;
+  }
+
+(* Type expressions for the module language *)
+
+type visibility =
+  | Exported
+  | Hidden
+
+type module_type =
+    Mty_ident of Path.t
+  | Mty_signature of signature
+  | Mty_functor of functor_parameter * module_type
+  | Mty_alias of Path.t
+
+and functor_parameter =
+  | Unit
+  | Named of Ident.t option * module_type
+
+and module_presence =
+  | Mp_present
+  | Mp_absent
+
+and signature = signature_item list
+
+and signature_item =
+    Sig_value of Ident.t * value_description * visibility
+  | Sig_type of Ident.t * type_declaration * rec_status * visibility
+  | Sig_typext of Ident.t * extension_constructor * ext_status * visibility
+  | Sig_module of
+      Ident.t * module_presence * module_declaration * rec_status * visibility
+  | Sig_modtype of Ident.t * modtype_declaration * visibility
+  | Sig_class of Ident.t * class_declaration * rec_status * visibility
+  | Sig_class_type of Ident.t * class_type_declaration * rec_status * visibility
+
+and module_declaration =
+  {
+    md_type: module_type;
+    md_attributes: Parsetree.attributes;
+    md_loc: Location.t;
+    md_uid: Uid.t;
+  }
+
+and modtype_declaration =
+  {
+    mtd_type: module_type option;  (* Note: abstract *)
+    mtd_attributes: Parsetree.attributes;
+    mtd_loc: Location.t;
+    mtd_uid: Uid.t;
+  }
+
+and rec_status =
+    Trec_not                   (* first in a nonrecursive group *)
+  | Trec_first                 (* first in a recursive group *)
+  | Trec_next                  (* not first in a recursive/nonrecursive group *)
+
+and ext_status =
+    Text_first                     (* first constructor of an extension *)
+  | Text_next                      (* not first constructor of an extension *)
+  | Text_exception                 (* an exception *)
+
+
+(* Constructor and record label descriptions inserted held in typing
+   environments *)
+
+type constructor_description =
+  { cstr_name: string;                  (* Constructor name *)
+    cstr_res: type_expr;                (* Type of the result *)
+    cstr_existentials: type_expr list;  (* list of existentials *)
+    cstr_args: type_expr list;          (* Type of the arguments *)
+    cstr_arity: int;                    (* Number of arguments *)
+    cstr_tag: constructor_tag;          (* Tag for heap blocks *)
+    cstr_consts: int;                   (* Number of constant constructors *)
+    cstr_nonconsts: int;                (* Number of non-const constructors *)
+    cstr_normal: int;                   (* Number of non generalized constrs *)
+    cstr_generalized: bool;             (* Constrained return type? *)
+    cstr_private: private_flag;         (* Read-only constructor? *)
+    cstr_loc: Location.t;
+    cstr_attributes: Parsetree.attributes;
+    cstr_inlined: type_declaration option;
+    cstr_uid: Uid.t;
+   }
+
+and constructor_tag =
+    Cstr_constant of int                (* Constant constructor (an int) *)
+  | Cstr_block of int                   (* Regular constructor (a block) *)
+  | Cstr_unboxed                        (* Constructor of an unboxed type *)
+  | Cstr_extension of Path.t * bool     (* Extension constructor
+                                           true if a constant false if a block*)
+
+let equal_tag t1 t2 =
+  match (t1, t2) with
+  | Cstr_constant i1, Cstr_constant i2 -> i2 = i1
+  | Cstr_block i1, Cstr_block i2 -> i2 = i1
+  | Cstr_unboxed, Cstr_unboxed -> true
+  | Cstr_extension (path1, b1), Cstr_extension (path2, b2) ->
+      Path.same path1 path2 && b1 = b2
+  | (Cstr_constant _|Cstr_block _|Cstr_unboxed|Cstr_extension _), _ -> false
+
+let may_equal_constr c1 c2 = match c1.cstr_tag,c2.cstr_tag with
+| Cstr_extension _,Cstr_extension _ -> c1.cstr_arity = c2.cstr_arity
+| tag1,tag2 -> equal_tag tag1 tag2
+
+type label_description =
+  { lbl_name: string;                   (* Short name *)
+    lbl_res: type_expr;                 (* Type of the result *)
+    lbl_arg: type_expr;                 (* Type of the argument *)
+    lbl_mut: mutable_flag;              (* Is this a mutable field? *)
+    lbl_pos: int;                       (* Position in block *)
+    lbl_all: label_description array;   (* All the labels in this type *)
+    lbl_repres: record_representation;  (* Representation for this record *)
+    lbl_private: private_flag;          (* Read-only field? *)
+    lbl_loc: Location.t;
+    lbl_attributes: Parsetree.attributes;
+    lbl_uid: Uid.t;
+   }
+
+let rec bound_value_identifiers = function
+    [] -> []
+  | Sig_value(id, {val_kind = Val_reg}, _) :: rem ->
+      id :: bound_value_identifiers rem
+  | Sig_typext(id, _, _, _) :: rem -> id :: bound_value_identifiers rem
+  | Sig_module(id, Mp_present, _, _, _) :: rem ->
+      id :: bound_value_identifiers rem
+  | Sig_class(id, _, _, _) :: rem -> id :: bound_value_identifiers rem
+  | _ :: rem -> bound_value_identifiers rem
+
+let signature_item_id = function
+  | Sig_value (id, _, _)
+  | Sig_type (id, _, _, _)
+  | Sig_typext (id, _, _, _)
+  | Sig_module (id, _, _, _, _)
+  | Sig_modtype (id, _, _)
+  | Sig_class (id, _, _, _)
+  | Sig_class_type (id, _, _, _)
+    -> id
diff --git a/typing/types.mli b/typing/types.mli
new file mode 100644
index 00000000..7dc20535
--- /dev/null
+++ b/typing/types.mli
@@ -0,0 +1,577 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** {0 Representation of types and declarations} *)
+
+(** [Types] defines the representation of types and declarations (that is, the
+    content of module signatures).
+
+    CMI files are made of marshalled types.
+*)
+
+(** Asttypes exposes basic definitions shared both by Parsetree and Types. *)
+open Asttypes
+
+(** Type expressions for the core language.
+
+    The [type_desc] variant defines all the possible type expressions one can
+    find in OCaml. [type_expr] wraps this with some annotations.
+
+    The [level] field tracks the level of polymorphism associated to a type,
+    guiding the generalization algorithm.
+    Put shortly, when referring to a type in a given environment, both the type
+    and the environment have a level. If the type has an higher level, then it
+    can be considered fully polymorphic (type variables will be printed as
+    ['a]), otherwise it'll be weakly polymorphic, or non generalized (type
+    variables printed as ['_a]).
+    See [http://okmij.org/ftp/ML/generalization.html] for more information.
+
+    Note about [type_declaration]: one should not make the confusion between
+    [type_expr] and [type_declaration].
+
+    [type_declaration] refers specifically to the [type] construct in OCaml
+    language, where you create and name a new type or type alias.
+
+    [type_expr] is used when you refer to existing types, e.g. when annotating
+    the expected type of a value.
+
+    Also, as the type system of OCaml is generative, a [type_declaration] can
+    have the side-effect of introducing a new type constructor, different from
+    all other known types.
+    Whereas [type_expr] is a pure construct which allows referring to existing
+    types.
+
+    Note on mutability: TBD.
+ *)
+type type_expr =
+  { mutable desc: type_desc;
+    mutable level: int;
+    mutable scope: int;
+    id: int }
+
+and type_desc =
+  | Tvar of string option
+  (** [Tvar (Some "a")] ==> ['a] or ['_a]
+      [Tvar None]       ==> [_] *)
+
+  | Tarrow of arg_label * type_expr * type_expr * commutable
+  (** [Tarrow (Nolabel,      e1, e2, c)] ==> [e1    -> e2]
+      [Tarrow (Labelled "l", e1, e2, c)] ==> [l:e1  -> e2]
+      [Tarrow (Optional "l", e1, e2, c)] ==> [?l:e1 -> e2]
+
+      See [commutable] for the last argument. *)
+
+  | Ttuple of type_expr list
+  (** [Ttuple [t1;...;tn]] ==> [(t1 * ... * tn)] *)
+
+  | Tconstr of Path.t * type_expr list * abbrev_memo ref
+  (** [Tconstr (`A.B.t', [t1;...;tn], _)] ==> [(t1,...,tn) A.B.t]
+      The last parameter keep tracks of known expansions, see [abbrev_memo]. *)
+
+  | Tobject of type_expr * (Path.t * type_expr list) option ref
+  (** [Tobject (`f1:t1;...;fn: tn', `None')] ==> [< f1: t1; ...; fn: tn >]
+      f1, fn are represented as a linked list of types using Tfield and Tnil
+      constructors.
+
+      [Tobject (_, `Some (`A.ct', [t1;...;tn]')] ==> [(t1, ..., tn) A.ct].
+      where A.ct is the type of some class.
+
+      There are also special cases for so-called "class-types", cf. [Typeclass]
+      and [Ctype.set_object_name]:
+
+        [Tobject (Tfield(_,_,...(Tfield(_,_,rv)...),
+                         Some(`A.#ct`, [rv;t1;...;tn])]
+             ==> [(t1, ..., tn) #A.ct]
+        [Tobject (_, Some(`A.#ct`, [Tnil;t1;...;tn])] ==> [(t1, ..., tn) A.ct]
+
+      where [rv] is the hidden row variable.
+  *)
+
+  | Tfield of string * field_kind * type_expr * type_expr
+  (** [Tfield ("foo", Fpresent, t, ts)] ==> [<...; foo : t; ts>] *)
+
+  | Tnil
+  (** [Tnil] ==> [<...; >] *)
+
+  | Tlink of type_expr
+  (** Indirection used by unification engine. *)
+
+  | Tsubst of type_expr         (* for copying *)
+  (** [Tsubst] is used temporarily to store information in low-level
+      functions manipulating representation of types, such as
+      instantiation or copy.
+      This constructor should not appear outside of these cases. *)
+
+  | Tvariant of row_desc
+  (** Representation of polymorphic variants, see [row_desc]. *)
+
+  | Tunivar of string option
+  (** Occurrence of a type variable introduced by a
+      forall quantifier / [Tpoly]. *)
+
+  | Tpoly of type_expr * type_expr list
+  (** [Tpoly (ty,tyl)] ==> ['a1... 'an. ty],
+      where 'a1 ... 'an are names given to types in tyl
+      and occurrences of those types in ty. *)
+
+  | Tpackage of Path.t * Longident.t list * type_expr list
+  (** Type of a first-class module (a.k.a package). *)
+
+(** [  `X | `Y ]       (row_closed = true)
+    [< `X | `Y ]       (row_closed = true)
+    [> `X | `Y ]       (row_closed = false)
+    [< `X | `Y > `X ]  (row_closed = true)
+
+    type t = [> `X ] as 'a      (row_more = Tvar a)
+    type t = private [> `X ]    (row_more = Tconstr (t#row, [], ref Mnil))
+
+    And for:
+
+        let f = function `X -> `X -> | `Y -> `X
+
+    the type of "f" will be a [Tarrow] whose lhs will (basically) be:
+
+        Tvariant { row_fields = [("X", _)];
+                   row_more   =
+                     Tvariant { row_fields = [("Y", _)];
+                                row_more   =
+                                  Tvariant { row_fields = [];
+                                             row_more   = _;
+                                             _ };
+                                _ };
+                   _
+                 }
+
+*)
+and row_desc =
+    { row_fields: (label * row_field) list;
+      row_more: type_expr;
+      row_bound: unit; (* kept for compatibility *)
+      row_closed: bool;
+      row_fixed: fixed_explanation option;
+      row_name: (Path.t * type_expr list) option }
+and fixed_explanation =
+  | Univar of type_expr (** The row type was bound to an univar *)
+  | Fixed_private (** The row type is private *)
+  | Reified of Path.t (** The row was reified *)
+  | Rigid (** The row type was made rigid during constraint verification *)
+and row_field =
+    Rpresent of type_expr option
+  | Reither of bool * type_expr list * bool * row_field option ref
+        (* 1st true denotes a constant constructor *)
+        (* 2nd true denotes a tag in a pattern matching, and
+           is erased later *)
+  | Rabsent
+
+(** [abbrev_memo] allows one to keep track of different expansions of a type
+    alias. This is done for performance purposes.
+
+    For instance, when defining [type 'a pair = 'a * 'a], when one refers to an
+    ['a pair], it is just a shortcut for the ['a * 'a] type.
+    This expansion will be stored in the [abbrev_memo] of the corresponding
+    [Tconstr] node.
+
+    In practice, [abbrev_memo] behaves like list of expansions with a mutable
+    tail.
+
+    Note on marshalling: [abbrev_memo] must not appear in saved types.
+    [Btype], with [cleanup_abbrev] and [memo], takes care of tracking and
+    removing abbreviations.
+*)
+and abbrev_memo =
+  | Mnil (** No known abbreviation *)
+
+  | Mcons of private_flag * Path.t * type_expr * type_expr * abbrev_memo
+  (** Found one abbreviation.
+      A valid abbreviation should be at least as visible and reachable by the
+      same path.
+      The first expression is the abbreviation and the second the expansion. *)
+
+  | Mlink of abbrev_memo ref
+  (** Abbreviations can be found after this indirection *)
+
+and field_kind =
+    Fvar of field_kind option ref
+  | Fpresent
+  | Fabsent
+
+(** [commutable] is a flag appended to every arrow type.
+
+    When typing an application, if the type of the functional is
+    known, its type is instantiated with [Cok] arrows, otherwise as
+    [Clink (ref Cunknown)].
+
+    When the type is not known, the application will be used to infer
+    the actual type.  This is fragile in presence of labels where
+    there is no principal type.
+
+    Two incompatible applications relying on [Cunknown] arrows will
+    trigger an error.
+
+    let f g =
+      g ~a:() ~b:();
+      g ~b:() ~a:();
+
+    Error: This function is applied to arguments
+    in an order different from other calls.
+    This is only allowed when the real type is known.
+*)
+and commutable =
+    Cok
+  | Cunknown
+  | Clink of commutable ref
+
+module TypeOps : sig
+  type t = type_expr
+  val compare : t -> t -> int
+  val equal : t -> t -> bool
+  val hash : t -> int
+end
+
+(* *)
+
+module Uid : sig
+  type t
+
+  val reinit : unit -> unit
+
+  val mk : current_unit:string -> t
+  val of_compilation_unit_id : Ident.t -> t
+  val of_predef_id : Ident.t -> t
+  val internal_not_actually_unique : t
+
+  val for_actual_declaration : t -> bool
+
+  include Identifiable.S with type t := t
+end
+
+(* Maps of methods and instance variables *)
+
+module Meths : Map.S with type key = string
+module Vars  : Map.S with type key = string
+
+(* Value descriptions *)
+
+type value_description =
+  { val_type: type_expr;                (* Type of the value *)
+    val_kind: value_kind;
+    val_loc: Location.t;
+    val_attributes: Parsetree.attributes;
+    val_uid: Uid.t;
+  }
+
+and value_kind =
+    Val_reg                             (* Regular value *)
+  | Val_prim of Primitive.description   (* Primitive *)
+  | Val_ivar of mutable_flag * string   (* Instance variable (mutable ?) *)
+  | Val_self of (Ident.t * type_expr) Meths.t ref *
+                (Ident.t * mutable_flag * virtual_flag * type_expr) Vars.t ref *
+                string * type_expr
+                                        (* Self *)
+  | Val_anc of (string * Ident.t) list * string
+                                        (* Ancestor *)
+
+(* Variance *)
+
+module Variance : sig
+  type t
+  type f = May_pos | May_neg | May_weak | Inj | Pos | Neg | Inv
+  val null : t                          (* no occurrence *)
+  val full : t                          (* strictly invariant *)
+  val covariant : t                     (* strictly covariant *)
+  val may_inv : t                       (* maybe invariant *)
+  val union  : t -> t -> t
+  val inter  : t -> t -> t
+  val subset : t -> t -> bool
+  val eq : t -> t -> bool
+  val set : f -> bool -> t -> t
+  val mem : f -> t -> bool
+  val conjugate : t -> t                (* exchange positive and negative *)
+  val get_upper : t -> bool * bool                  (* may_pos, may_neg   *)
+  val get_lower : t -> bool * bool * bool * bool    (* pos, neg, inv, inj *)
+end
+
+module Separability : sig
+  (** see {!Typedecl_separability} for an explanation of separability
+      and separability modes.*)
+
+  type t = Ind | Sep | Deepsep
+  val eq : t -> t -> bool
+  val print : Format.formatter -> t -> unit
+
+  val rank : t -> int
+  (** Modes are ordered from the least to the most demanding:
+      Ind < Sep < Deepsep.
+      'rank' maps them to integers in an order-respecting way:
+      m1 < m2  <=>  rank m1 < rank m2 *)
+
+  val compare : t -> t -> int
+  (** Compare two mode according to their mode ordering. *)
+
+  val max : t -> t -> t
+  (** [max_mode m1 m2] returns the most demanding mode. It is used to
+      express the conjunction of two parameter mode constraints. *)
+
+  type signature = t list
+  (** The 'separability signature' of a type assigns a mode for
+      each of its parameters. [('a, 'b) t] has mode [(m1, m2)] if
+      [(t1, t2) t] is separable whenever [t1, t2] have mode [m1, m2]. *)
+
+  val print_signature : Format.formatter -> signature -> unit
+
+  val default_signature : arity:int -> signature
+  (** The most pessimistic separability for a completely unknown type. *)
+end
+
+(* Type definitions *)
+
+type type_declaration =
+  { type_params: type_expr list;
+    type_arity: int;
+    type_kind: type_kind;
+    type_private: private_flag;
+    type_manifest: type_expr option;
+    type_variance: Variance.t list;
+    (* covariant, contravariant, weakly contravariant, injective *)
+    type_separability: Separability.t list;
+    type_is_newtype: bool;
+    type_expansion_scope: int;
+    type_loc: Location.t;
+    type_attributes: Parsetree.attributes;
+    type_immediate: Type_immediacy.t;
+    type_unboxed: unboxed_status;
+    type_uid: Uid.t;
+  }
+
+and type_kind =
+    Type_abstract
+  | Type_record of label_declaration list  * record_representation
+  | Type_variant of constructor_declaration list
+  | Type_open
+
+and record_representation =
+    Record_regular                      (* All fields are boxed / tagged *)
+  | Record_float                        (* All fields are floats *)
+  | Record_unboxed of bool    (* Unboxed single-field record, inlined or not *)
+  | Record_inlined of int               (* Inlined record *)
+  | Record_extension of Path.t          (* Inlined record under extension *)
+
+and label_declaration =
+  {
+    ld_id: Ident.t;
+    ld_mutable: mutable_flag;
+    ld_type: type_expr;
+    ld_loc: Location.t;
+    ld_attributes: Parsetree.attributes;
+    ld_uid: Uid.t;
+  }
+
+and constructor_declaration =
+  {
+    cd_id: Ident.t;
+    cd_args: constructor_arguments;
+    cd_res: type_expr option;
+    cd_loc: Location.t;
+    cd_attributes: Parsetree.attributes;
+    cd_uid: Uid.t;
+  }
+
+and constructor_arguments =
+  | Cstr_tuple of type_expr list
+  | Cstr_record of label_declaration list
+
+and unboxed_status = private
+  (* This type must be private in order to ensure perfect sharing of the
+     four possible values. Otherwise, ocamlc.byte and ocamlc.opt produce
+     different executables. *)
+  {
+    unboxed: bool;
+    default: bool; (* True for unannotated unboxable types. *)
+  }
+
+val unboxed_false_default_false : unboxed_status
+val unboxed_false_default_true : unboxed_status
+val unboxed_true_default_false : unboxed_status
+val unboxed_true_default_true : unboxed_status
+
+type extension_constructor =
+  {
+    ext_type_path: Path.t;
+    ext_type_params: type_expr list;
+    ext_args: constructor_arguments;
+    ext_ret_type: type_expr option;
+    ext_private: private_flag;
+    ext_loc: Location.t;
+    ext_attributes: Parsetree.attributes;
+    ext_uid: Uid.t;
+  }
+
+and type_transparence =
+    Type_public      (* unrestricted expansion *)
+  | Type_new         (* "new" type *)
+  | Type_private     (* private type *)
+
+(* Type expressions for the class language *)
+
+module Concr : Set.S with type elt = string
+
+type class_type =
+    Cty_constr of Path.t * type_expr list * class_type
+  | Cty_signature of class_signature
+  | Cty_arrow of arg_label * type_expr * class_type
+
+and class_signature =
+  { csig_self: type_expr;
+    csig_vars:
+      (Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr) Vars.t;
+    csig_concr: Concr.t;
+    csig_inher: (Path.t * type_expr list) list }
+
+type class_declaration =
+  { cty_params: type_expr list;
+    mutable cty_type: class_type;
+    cty_path: Path.t;
+    cty_new: type_expr option;
+    cty_variance: Variance.t list;
+    cty_loc: Location.t;
+    cty_attributes: Parsetree.attributes;
+    cty_uid: Uid.t;
+  }
+
+type class_type_declaration =
+  { clty_params: type_expr list;
+    clty_type: class_type;
+    clty_path: Path.t;
+    clty_variance: Variance.t list;
+    clty_loc: Location.t;
+    clty_attributes: Parsetree.attributes;
+    clty_uid: Uid.t;
+  }
+
+(* Type expressions for the module language *)
+
+type visibility =
+  | Exported
+  | Hidden
+
+type module_type =
+    Mty_ident of Path.t
+  | Mty_signature of signature
+  | Mty_functor of functor_parameter * module_type
+  | Mty_alias of Path.t
+
+and functor_parameter =
+  | Unit
+  | Named of Ident.t option * module_type
+
+and module_presence =
+  | Mp_present
+  | Mp_absent
+
+and signature = signature_item list
+
+and signature_item =
+    Sig_value of Ident.t * value_description * visibility
+  | Sig_type of Ident.t * type_declaration * rec_status * visibility
+  | Sig_typext of Ident.t * extension_constructor * ext_status * visibility
+  | Sig_module of
+      Ident.t * module_presence * module_declaration * rec_status * visibility
+  | Sig_modtype of Ident.t * modtype_declaration * visibility
+  | Sig_class of Ident.t * class_declaration * rec_status * visibility
+  | Sig_class_type of Ident.t * class_type_declaration * rec_status * visibility
+
+and module_declaration =
+  {
+    md_type: module_type;
+    md_attributes: Parsetree.attributes;
+    md_loc: Location.t;
+    md_uid: Uid.t;
+  }
+
+and modtype_declaration =
+  {
+    mtd_type: module_type option;  (* None: abstract *)
+    mtd_attributes: Parsetree.attributes;
+    mtd_loc: Location.t;
+    mtd_uid: Uid.t;
+  }
+
+and rec_status =
+    Trec_not                   (* first in a nonrecursive group *)
+  | Trec_first                 (* first in a recursive group *)
+  | Trec_next                  (* not first in a recursive/nonrecursive group *)
+
+and ext_status =
+    Text_first                     (* first constructor in an extension *)
+  | Text_next                      (* not first constructor in an extension *)
+  | Text_exception
+
+
+(* Constructor and record label descriptions inserted held in typing
+   environments *)
+
+type constructor_description =
+  { cstr_name: string;                  (* Constructor name *)
+    cstr_res: type_expr;                (* Type of the result *)
+    cstr_existentials: type_expr list;  (* list of existentials *)
+    cstr_args: type_expr list;          (* Type of the arguments *)
+    cstr_arity: int;                    (* Number of arguments *)
+    cstr_tag: constructor_tag;          (* Tag for heap blocks *)
+    cstr_consts: int;                   (* Number of constant constructors *)
+    cstr_nonconsts: int;                (* Number of non-const constructors *)
+    cstr_normal: int;                   (* Number of non generalized constrs *)
+    cstr_generalized: bool;             (* Constrained return type? *)
+    cstr_private: private_flag;         (* Read-only constructor? *)
+    cstr_loc: Location.t;
+    cstr_attributes: Parsetree.attributes;
+    cstr_inlined: type_declaration option;
+    cstr_uid: Uid.t;
+   }
+
+and constructor_tag =
+    Cstr_constant of int                (* Constant constructor (an int) *)
+  | Cstr_block of int                   (* Regular constructor (a block) *)
+  | Cstr_unboxed                        (* Constructor of an unboxed type *)
+  | Cstr_extension of Path.t * bool     (* Extension constructor
+                                           true if a constant false if a block*)
+
+(* Constructors are the same *)
+val equal_tag :  constructor_tag -> constructor_tag -> bool
+
+(* Constructors may be the same, given potential rebinding *)
+val may_equal_constr :
+    constructor_description ->  constructor_description -> bool
+
+type label_description =
+  { lbl_name: string;                   (* Short name *)
+    lbl_res: type_expr;                 (* Type of the result *)
+    lbl_arg: type_expr;                 (* Type of the argument *)
+    lbl_mut: mutable_flag;              (* Is this a mutable field? *)
+    lbl_pos: int;                       (* Position in block *)
+    lbl_all: label_description array;   (* All the labels in this type *)
+    lbl_repres: record_representation;  (* Representation for this record *)
+    lbl_private: private_flag;          (* Read-only field? *)
+    lbl_loc: Location.t;
+    lbl_attributes: Parsetree.attributes;
+    lbl_uid: Uid.t;
+  }
+
+(** Extracts the list of "value" identifiers bound by a signature.
+    "Value" identifiers are identifiers for signature components that
+    correspond to a run-time value: values, extensions, modules, classes.
+    Note: manifest primitives do not correspond to a run-time value! *)
+val bound_value_identifiers: signature -> Ident.t list
+
+val signature_item_id : signature_item -> Ident.t
diff --git a/typing/typetexp.ml b/typing/typetexp.ml
new file mode 100644
index 00000000..a55e53d0
--- /dev/null
+++ b/typing/typetexp.ml
@@ -0,0 +1,813 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* typetexp.ml,v 1.34.4.9 2002/01/07 08:39:16 garrigue Exp *)
+
+(* Typechecking of type expressions for the core language *)
+
+open Asttypes
+open Misc
+open Parsetree
+open Typedtree
+open Types
+open Ctype
+
+exception Already_bound
+
+type error =
+    Unbound_type_variable of string
+  | Undefined_type_constructor of Path.t
+  | Type_arity_mismatch of Longident.t * int * int
+  | Bound_type_variable of string
+  | Recursive_type
+  | Unbound_row_variable of Longident.t
+  | Type_mismatch of Ctype.Unification_trace.t
+  | Alias_type_mismatch of Ctype.Unification_trace.t
+  | Present_has_conjunction of string
+  | Present_has_no_type of string
+  | Constructor_mismatch of type_expr * type_expr
+  | Not_a_variant of type_expr
+  | Variant_tags of string * string
+  | Invalid_variable_name of string
+  | Cannot_quantify of string * type_expr
+  | Multiple_constraints_on_type of Longident.t
+  | Method_mismatch of string * type_expr * type_expr
+  | Opened_object of Path.t option
+  | Not_an_object of type_expr
+
+exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
+
+(** Map indexed by type variable names. *)
+module TyVarMap = Misc.Stdlib.String.Map
+
+type variable_context = int * type_expr TyVarMap.t
+
+(* Support for first-class modules. *)
+
+let transl_modtype_longident = ref (fun _ -> assert false)
+let transl_modtype = ref (fun _ -> assert false)
+
+let create_package_mty fake loc env (p, l) =
+  let l =
+    List.sort
+      (fun (s1, _t1) (s2, _t2) ->
+         if s1.txt = s2.txt then
+           raise (Error (loc, env, Multiple_constraints_on_type s1.txt));
+         compare s1.txt s2.txt)
+      l
+  in
+  l,
+  List.fold_left
+    (fun mty (s, t) ->
+      let d = {ptype_name = mkloc (Longident.last s.txt) s.loc;
+               ptype_params = [];
+               ptype_cstrs = [];
+               ptype_kind = Ptype_abstract;
+               ptype_private = Asttypes.Public;
+               ptype_manifest = if fake then None else Some t;
+               ptype_attributes = [];
+               ptype_loc = loc} in
+      Ast_helper.Mty.mk ~loc
+        (Pmty_with (mty, [ Pwith_type ({ txt = s.txt; loc }, d) ]))
+    )
+    (Ast_helper.Mty.mk ~loc (Pmty_ident p))
+    l
+
+(* Translation of type expressions *)
+
+let type_variables = ref (TyVarMap.empty : type_expr TyVarMap.t)
+let univars        = ref ([] : (string * type_expr) list)
+let pre_univars    = ref ([] : type_expr list)
+let used_variables = ref (TyVarMap.empty : (type_expr * Location.t) TyVarMap.t)
+
+let reset_type_variables () =
+  reset_global_level ();
+  Ctype.reset_reified_var_counter ();
+  type_variables := TyVarMap.empty
+
+let narrow () =
+  (increase_global_level (), !type_variables)
+
+let widen (gl, tv) =
+  restore_global_level gl;
+  type_variables := tv
+
+let strict_ident c = (c = '_' || c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z')
+
+let validate_name = function
+    None -> None
+  | Some name as s ->
+      if name <> "" && strict_ident name.[0] then s else None
+
+let new_global_var ?name () =
+  new_global_var ?name:(validate_name name) ()
+let newvar ?name () =
+  newvar ?name:(validate_name name) ()
+
+let type_variable loc name =
+  try
+    TyVarMap.find name !type_variables
+  with Not_found ->
+    raise(Error(loc, Env.empty, Unbound_type_variable ("'" ^ name)))
+
+let valid_tyvar_name name =
+  name <> "" && name.[0] <> '_'
+
+let transl_type_param env styp =
+  let loc = styp.ptyp_loc in
+  match styp.ptyp_desc with
+    Ptyp_any ->
+      let ty = new_global_var ~name:"_" () in
+        { ctyp_desc = Ttyp_any; ctyp_type = ty; ctyp_env = env;
+          ctyp_loc = loc; ctyp_attributes = styp.ptyp_attributes; }
+  | Ptyp_var name ->
+      let ty =
+        try
+          if not (valid_tyvar_name name) then
+            raise (Error (loc, Env.empty, Invalid_variable_name ("'" ^ name)));
+          ignore (TyVarMap.find name !type_variables);
+          raise Already_bound
+        with Not_found ->
+          let v = new_global_var ~name () in
+            type_variables := TyVarMap.add name v !type_variables;
+            v
+      in
+        { ctyp_desc = Ttyp_var name; ctyp_type = ty; ctyp_env = env;
+          ctyp_loc = loc; ctyp_attributes = styp.ptyp_attributes; }
+  | _ -> assert false
+
+let transl_type_param env styp =
+  (* Currently useless, since type parameters cannot hold attributes
+     (but this could easily be lifted in the future). *)
+  Builtin_attributes.warning_scope styp.ptyp_attributes
+    (fun () -> transl_type_param env styp)
+
+
+let new_pre_univar ?name () =
+  let v = newvar ?name () in pre_univars := v :: !pre_univars; v
+
+type policy = Fixed | Extensible | Univars
+
+let rec transl_type env policy styp =
+  Builtin_attributes.warning_scope styp.ptyp_attributes
+    (fun () -> transl_type_aux env policy styp)
+
+and transl_type_aux env policy styp =
+  let loc = styp.ptyp_loc in
+  let ctyp ctyp_desc ctyp_type =
+    { ctyp_desc; ctyp_type; ctyp_env = env;
+      ctyp_loc = loc; ctyp_attributes = styp.ptyp_attributes }
+  in
+  match styp.ptyp_desc with
+    Ptyp_any ->
+      let ty =
+        if policy = Univars then new_pre_univar () else
+          if policy = Fixed then
+            raise (Error (styp.ptyp_loc, env, Unbound_type_variable "_"))
+          else newvar ()
+      in
+      ctyp Ttyp_any ty
+  | Ptyp_var name ->
+    let ty =
+      if not (valid_tyvar_name name) then
+        raise (Error (styp.ptyp_loc, env, Invalid_variable_name ("'" ^ name)));
+      begin try
+        instance (List.assoc name !univars)
+      with Not_found -> try
+        instance (fst (TyVarMap.find name !used_variables))
+      with Not_found ->
+        let v =
+          if policy = Univars then new_pre_univar ~name () else newvar ~name ()
+        in
+        used_variables := TyVarMap.add name (v, styp.ptyp_loc) !used_variables;
+        v
+      end
+    in
+    ctyp (Ttyp_var name) ty
+  | Ptyp_arrow(l, st1, st2) ->
+    let cty1 = transl_type env policy st1 in
+    let cty2 = transl_type env policy st2 in
+    let ty1 = cty1.ctyp_type in
+    let ty1 =
+      if Btype.is_optional l
+      then newty (Tconstr(Predef.path_option,[ty1], ref Mnil))
+      else ty1 in
+    let ty = newty (Tarrow(l, ty1, cty2.ctyp_type, Cok)) in
+    ctyp (Ttyp_arrow (l, cty1, cty2)) ty
+  | Ptyp_tuple stl ->
+    assert (List.length stl >= 2);
+    let ctys = List.map (transl_type env policy) stl in
+    let ty = newty (Ttuple (List.map (fun ctyp -> ctyp.ctyp_type) ctys)) in
+    ctyp (Ttyp_tuple ctys) ty
+  | Ptyp_constr(lid, stl) ->
+      let (path, decl) = Env.lookup_type ~loc:lid.loc lid.txt env in
+      let stl =
+        match stl with
+        | [ {ptyp_desc=Ptyp_any} as t ] when decl.type_arity > 1 ->
+            List.map (fun _ -> t) decl.type_params
+        | _ -> stl
+      in
+      if List.length stl <> decl.type_arity then
+        raise(Error(styp.ptyp_loc, env,
+                    Type_arity_mismatch(lid.txt, decl.type_arity,
+                                        List.length stl)));
+      let args = List.map (transl_type env policy) stl in
+      let params = instance_list decl.type_params in
+      let unify_param =
+        match decl.type_manifest with
+          None -> unify_var
+        | Some ty ->
+            if (repr ty).level = Btype.generic_level then unify_var else unify
+      in
+      List.iter2
+        (fun (sty, cty) ty' ->
+           try unify_param env ty' cty.ctyp_type with Unify trace ->
+             let trace = Unification_trace.swap trace in
+             raise (Error(sty.ptyp_loc, env, Type_mismatch trace))
+        )
+        (List.combine stl args) params;
+      let constr =
+        newconstr path (List.map (fun ctyp -> ctyp.ctyp_type) args) in
+      begin try
+        Ctype.enforce_constraints env constr
+      with Unify trace ->
+        raise (Error(styp.ptyp_loc, env, Type_mismatch trace))
+      end;
+      ctyp (Ttyp_constr (path, lid, args)) constr
+  | Ptyp_object (fields, o) ->
+      let ty, fields = transl_fields env policy o fields in
+      ctyp (Ttyp_object (fields, o)) (newobj ty)
+  | Ptyp_class(lid, stl) ->
+      let (path, decl, _is_variant) =
+        try
+          let path, decl = Env.find_type_by_name lid.txt env in
+          let rec check decl =
+            match decl.type_manifest with
+              None -> raise Not_found
+            | Some ty ->
+                match (repr ty).desc with
+                  Tvariant row when Btype.static_row row -> ()
+                | Tconstr (path, _, _) ->
+                    check (Env.find_type path env)
+                | _ -> raise Not_found
+          in check decl;
+          Location.deprecated styp.ptyp_loc
+            "old syntax for polymorphic variant type";
+          ignore(Env.lookup_type ~loc:lid.loc lid.txt env);
+          (path, decl,true)
+        with Not_found -> try
+          let lid2 =
+            match lid.txt with
+              Longident.Lident s     -> Longident.Lident ("#" ^ s)
+            | Longident.Ldot(r, s)   -> Longident.Ldot (r, "#" ^ s)
+            | Longident.Lapply(_, _) -> fatal_error "Typetexp.transl_type"
+          in
+          let path, decl = Env.find_type_by_name lid2 env in
+          ignore(Env.lookup_cltype ~loc:lid.loc lid.txt env);
+          (path, decl, false)
+        with Not_found ->
+          ignore (Env.lookup_cltype ~loc:lid.loc lid.txt env); assert false
+      in
+      if List.length stl <> decl.type_arity then
+        raise(Error(styp.ptyp_loc, env,
+                    Type_arity_mismatch(lid.txt, decl.type_arity,
+                                        List.length stl)));
+      let args = List.map (transl_type env policy) stl in
+      let params = instance_list decl.type_params in
+      List.iter2
+        (fun (sty, cty) ty' ->
+           try unify_var env ty' cty.ctyp_type with Unify trace ->
+             let trace = Unification_trace.swap trace in
+             raise (Error(sty.ptyp_loc, env, Type_mismatch trace))
+        )
+        (List.combine stl args) params;
+        let ty_args = List.map (fun ctyp -> ctyp.ctyp_type) args in
+      let ty =
+        try Ctype.expand_head env (newconstr path ty_args)
+        with Unify trace ->
+          raise (Error(styp.ptyp_loc, env, Type_mismatch trace))
+      in
+      let ty = match ty.desc with
+        Tvariant row ->
+          let row = Btype.row_repr row in
+          let fields =
+            List.map
+              (fun (l,f) -> l,
+                match Btype.row_field_repr f with
+                | Rpresent (Some ty) ->
+                    Reither(false, [ty], false, ref None)
+                | Rpresent None ->
+                    Reither (true, [], false, ref None)
+                | _ -> f)
+              row.row_fields
+          in
+          let row = { row_closed = true; row_fields = fields;
+                      row_bound = (); row_name = Some (path, ty_args);
+                      row_fixed = None; row_more = newvar () } in
+          let static = Btype.static_row row in
+          let row =
+            if static then { row with row_more = newty Tnil }
+            else if policy <> Univars then row
+            else { row with row_more = new_pre_univar () }
+          in
+          newty (Tvariant row)
+      | Tobject (fi, _) ->
+          let _, tv = flatten_fields fi in
+          if policy = Univars then pre_univars := tv :: !pre_univars;
+          ty
+      | _ ->
+          assert false
+      in
+      ctyp (Ttyp_class (path, lid, args)) ty
+  | Ptyp_alias(st, alias) ->
+      let cty =
+        try
+          let t =
+            try List.assoc alias !univars
+            with Not_found ->
+              instance (fst(TyVarMap.find alias !used_variables))
+          in
+          let ty = transl_type env policy st in
+          begin try unify_var env t ty.ctyp_type with Unify trace ->
+            let trace = Unification_trace.swap trace in
+            raise(Error(styp.ptyp_loc, env, Alias_type_mismatch trace))
+          end;
+          ty
+        with Not_found ->
+          if !Clflags.principal then begin_def ();
+          let t = newvar () in
+          used_variables :=
+            TyVarMap.add alias (t, styp.ptyp_loc) !used_variables;
+          let ty = transl_type env policy st in
+          begin try unify_var env t ty.ctyp_type with Unify trace ->
+            let trace = Unification_trace.swap trace in
+            raise(Error(styp.ptyp_loc, env, Alias_type_mismatch trace))
+          end;
+          if !Clflags.principal then begin
+            end_def ();
+            generalize_structure t;
+          end;
+          let t = instance t in
+          let px = Btype.proxy t in
+          begin match px.desc with
+          | Tvar None -> Btype.set_type_desc px (Tvar (Some alias))
+          | Tunivar None -> Btype.set_type_desc px (Tunivar (Some alias))
+          | _ -> ()
+          end;
+          { ty with ctyp_type = t }
+      in
+      ctyp (Ttyp_alias (cty, alias)) cty.ctyp_type
+  | Ptyp_variant(fields, closed, present) ->
+      let name = ref None in
+      let mkfield l f =
+        newty (Tvariant {row_fields=[l,f]; row_more=newvar();
+                         row_bound=(); row_closed=true;
+                         row_fixed=None; row_name=None}) in
+      let hfields = Hashtbl.create 17 in
+      let add_typed_field loc l f =
+        let h = Btype.hash_variant l in
+        try
+          let (l',f') = Hashtbl.find hfields h in
+          (* Check for tag conflicts *)
+          if l <> l' then raise(Error(styp.ptyp_loc, env, Variant_tags(l, l')));
+          let ty = mkfield l f and ty' = mkfield l f' in
+          if equal env false [ty] [ty'] then () else
+          try unify env ty ty'
+          with Unify _trace ->
+            raise(Error(loc, env, Constructor_mismatch (ty,ty')))
+        with Not_found ->
+          Hashtbl.add hfields h (l,f)
+      in
+      let add_field field =
+        let rf_loc = field.prf_loc in
+        let rf_attributes = field.prf_attributes in
+        let rf_desc = match field.prf_desc with
+        | Rtag (l, c, stl) ->
+            name := None;
+            let tl =
+              Builtin_attributes.warning_scope rf_attributes
+                (fun () -> List.map (transl_type env policy) stl)
+            in
+            let f = match present with
+              Some present when not (List.mem l.txt present) ->
+                let ty_tl = List.map (fun cty -> cty.ctyp_type) tl in
+                Reither(c, ty_tl, false, ref None)
+            | _ ->
+                if List.length stl > 1 || c && stl <> [] then
+                  raise(Error(styp.ptyp_loc, env,
+                              Present_has_conjunction l.txt));
+                match tl with [] -> Rpresent None
+                | st :: _ ->
+                      Rpresent (Some st.ctyp_type)
+            in
+            add_typed_field styp.ptyp_loc l.txt f;
+              Ttag (l,c,tl)
+        | Rinherit sty ->
+            let cty = transl_type env policy sty in
+            let ty = cty.ctyp_type in
+            let nm =
+              match repr cty.ctyp_type with
+                {desc=Tconstr(p, tl, _)} -> Some(p, tl)
+              | _                        -> None
+            in
+            begin try
+              (* Set name if there are no fields yet *)
+              Hashtbl.iter (fun _ _ -> raise Exit) hfields;
+              name := nm
+            with Exit ->
+              (* Unset it otherwise *)
+              name := None
+            end;
+            let fl = match expand_head env cty.ctyp_type, nm with
+              {desc=Tvariant row}, _ when Btype.static_row row ->
+                let row = Btype.row_repr row in
+                row.row_fields
+            | {desc=Tvar _}, Some(p, _) ->
+                raise(Error(sty.ptyp_loc, env, Undefined_type_constructor p))
+            | _ ->
+                raise(Error(sty.ptyp_loc, env, Not_a_variant ty))
+            in
+            List.iter
+              (fun (l, f) ->
+                let f = match present with
+                  Some present when not (List.mem l present) ->
+                    begin match f with
+                      Rpresent(Some ty) ->
+                        Reither(false, [ty], false, ref None)
+                    | Rpresent None ->
+                        Reither(true, [], false, ref None)
+                    | _ ->
+                        assert false
+                    end
+                | _ -> f
+                in
+                add_typed_field sty.ptyp_loc l f)
+              fl;
+              Tinherit cty
+        in
+        { rf_desc; rf_loc; rf_attributes; }
+      in
+      let tfields = List.map add_field fields in
+      let fields = Hashtbl.fold (fun _ p l -> p :: l) hfields [] in
+      begin match present with None -> ()
+      | Some present ->
+          List.iter
+            (fun l -> if not (List.mem_assoc l fields) then
+              raise(Error(styp.ptyp_loc, env, Present_has_no_type l)))
+            present
+      end;
+      let row =
+        { row_fields = List.rev fields; row_more = newvar ();
+          row_bound = (); row_closed = (closed = Closed);
+          row_fixed = None; row_name = !name } in
+      let static = Btype.static_row row in
+      let row =
+        if static then { row with row_more = newty Tnil }
+        else if policy <> Univars then row
+        else { row with row_more = new_pre_univar () }
+      in
+      let ty = newty (Tvariant row) in
+      ctyp (Ttyp_variant (tfields, closed, present)) ty
+  | Ptyp_poly(vars, st) ->
+      let vars = List.map (fun v -> v.txt) vars in
+      begin_def();
+      let new_univars = List.map (fun name -> name, newvar ~name ()) vars in
+      let old_univars = !univars in
+      univars := new_univars @ !univars;
+      let cty = transl_type env policy st in
+      let ty = cty.ctyp_type in
+      univars := old_univars;
+      end_def();
+      generalize ty;
+      let ty_list =
+        List.fold_left
+          (fun tyl (name, ty1) ->
+            let v = Btype.proxy ty1 in
+            if deep_occur v ty then begin
+              match v.desc with
+                Tvar name when v.level = Btype.generic_level ->
+                  v.desc <- Tunivar name;
+                  v :: tyl
+              | _ ->
+                raise (Error (styp.ptyp_loc, env, Cannot_quantify (name, v)))
+            end else tyl)
+          [] new_univars
+      in
+      let ty' = Btype.newgenty (Tpoly(ty, List.rev ty_list)) in
+      unify_var env (newvar()) ty';
+      ctyp (Ttyp_poly (vars, cty)) ty'
+  | Ptyp_package (p, l) ->
+      let l, mty = create_package_mty true styp.ptyp_loc env (p, l) in
+      let z = narrow () in
+      let mty = !transl_modtype env mty in
+      widen z;
+      let ptys = List.map (fun (s, pty) ->
+                             s, transl_type env policy pty
+                          ) l in
+      let path = !transl_modtype_longident styp.ptyp_loc env p.txt in
+      let ty = newty (Tpackage (path,
+                       List.map (fun (s, _pty) -> s.txt) l,
+                       List.map (fun (_,cty) -> cty.ctyp_type) ptys))
+      in
+      ctyp (Ttyp_package {
+            pack_path = path;
+            pack_type = mty.mty_type;
+            pack_fields = ptys;
+            pack_txt = p;
+           }) ty
+  | Ptyp_extension ext ->
+      raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+and transl_poly_type env policy t =
+  transl_type env policy (Ast_helper.Typ.force_poly t)
+
+and transl_fields env policy o fields =
+  let hfields = Hashtbl.create 17 in
+  let add_typed_field loc l ty =
+    try
+      let ty' = Hashtbl.find hfields l in
+      if equal env false [ty] [ty'] then () else
+        try unify env ty ty'
+        with Unify _trace ->
+          raise(Error(loc, env, Method_mismatch (l, ty, ty')))
+    with Not_found ->
+      Hashtbl.add hfields l ty in
+  let add_field {pof_desc; pof_loc; pof_attributes;} =
+    let of_loc = pof_loc in
+    let of_attributes = pof_attributes in
+    let of_desc = match pof_desc with
+    | Otag (s, ty1) -> begin
+        let ty1 =
+          Builtin_attributes.warning_scope of_attributes
+            (fun () -> transl_poly_type env policy ty1)
+        in
+        let field = OTtag (s, ty1) in
+        add_typed_field ty1.ctyp_loc s.txt ty1.ctyp_type;
+        field
+      end
+    | Oinherit sty -> begin
+        let cty = transl_type env policy sty in
+        let nm =
+          match repr cty.ctyp_type with
+            {desc=Tconstr(p, _, _)} -> Some p
+          | _                        -> None in
+        let t = expand_head env cty.ctyp_type in
+        match t, nm with
+          {desc=Tobject ({desc=(Tfield _ | Tnil) as tf}, _)}, _ -> begin
+            if opened_object t then
+              raise (Error (sty.ptyp_loc, env, Opened_object nm));
+            let rec iter_add = function
+              | Tfield (s, _k, ty1, ty2) -> begin
+                  add_typed_field sty.ptyp_loc s ty1;
+                  iter_add ty2.desc
+                end
+              | Tnil -> ()
+              | _ -> assert false in
+            iter_add tf;
+            OTinherit cty
+            end
+        | {desc=Tvar _}, Some p ->
+            raise (Error (sty.ptyp_loc, env, Undefined_type_constructor p))
+        | _ -> raise (Error (sty.ptyp_loc, env, Not_an_object t))
+      end in
+    { of_desc; of_loc; of_attributes; }
+  in
+  let object_fields = List.map add_field fields in
+  let fields = Hashtbl.fold (fun s ty l -> (s, ty) :: l) hfields [] in
+  let ty_init =
+     match o, policy with
+     | Closed, _ -> newty Tnil
+     | Open, Univars -> new_pre_univar ()
+     | Open, _ -> newvar () in
+  let ty = List.fold_left (fun ty (s, ty') ->
+      newty (Tfield (s, Fpresent, ty', ty))) ty_init fields in
+  ty, object_fields
+
+
+(* Make the rows "fixed" in this type, to make universal check easier *)
+let rec make_fixed_univars ty =
+  let ty = repr ty in
+  if ty.level >= Btype.lowest_level then begin
+    Btype.mark_type_node ty;
+    match ty.desc with
+    | Tvariant row ->
+        let row = Btype.row_repr row in
+        let more = Btype.row_more row in
+        if Btype.is_Tunivar more then
+          ty.desc <- Tvariant
+              {row with row_fixed=Some(Univar more);
+               row_fields = List.map
+                 (fun (s,f as p) -> match Btype.row_field_repr f with
+                   Reither (c, tl, _m, r) -> s, Reither (c, tl, true, r)
+                 | _ -> p)
+                 row.row_fields};
+        Btype.iter_row make_fixed_univars row
+    | _ ->
+        Btype.iter_type_expr make_fixed_univars ty
+  end
+
+let make_fixed_univars ty =
+  make_fixed_univars ty;
+  Btype.unmark_type ty
+
+let create_package_mty = create_package_mty false
+
+let globalize_used_variables env fixed =
+  let r = ref [] in
+  TyVarMap.iter
+    (fun name (ty, loc) ->
+      let v = new_global_var () in
+      let snap = Btype.snapshot () in
+      if try unify env v ty; true with _ -> Btype.backtrack snap; false
+      then try
+        r := (loc, v,  TyVarMap.find name !type_variables) :: !r
+      with Not_found ->
+        if fixed && Btype.is_Tvar (repr ty) then
+          raise(Error(loc, env, Unbound_type_variable ("'"^name)));
+        let v2 = new_global_var () in
+        r := (loc, v, v2) :: !r;
+        type_variables := TyVarMap.add name v2 !type_variables)
+    !used_variables;
+  used_variables := TyVarMap.empty;
+  fun () ->
+    List.iter
+      (function (loc, t1, t2) ->
+        try unify env t1 t2 with Unify trace ->
+          raise (Error(loc, env, Type_mismatch trace)))
+      !r
+
+let transl_simple_type env fixed styp =
+  univars := []; used_variables := TyVarMap.empty;
+  let typ = transl_type env (if fixed then Fixed else Extensible) styp in
+  globalize_used_variables env fixed ();
+  make_fixed_univars typ.ctyp_type;
+  typ
+
+let transl_simple_type_univars env styp =
+  univars := []; used_variables := TyVarMap.empty; pre_univars := [];
+  begin_def ();
+  let typ = transl_type env Univars styp in
+  (* Only keep already global variables in used_variables *)
+  let new_variables = !used_variables in
+  used_variables := TyVarMap.empty;
+  TyVarMap.iter
+    (fun name p ->
+      if TyVarMap.mem name !type_variables then
+        used_variables := TyVarMap.add name p !used_variables)
+    new_variables;
+  globalize_used_variables env false ();
+  end_def ();
+  generalize typ.ctyp_type;
+  let univs =
+    List.fold_left
+      (fun acc v ->
+        let v = repr v in
+        match v.desc with
+          Tvar name when v.level = Btype.generic_level ->
+            v.desc <- Tunivar name; v :: acc
+        | _ -> acc)
+      [] !pre_univars
+  in
+  make_fixed_univars typ.ctyp_type;
+    { typ with ctyp_type =
+        instance (Btype.newgenty (Tpoly (typ.ctyp_type, univs))) }
+
+let transl_simple_type_delayed env styp =
+  univars := []; used_variables := TyVarMap.empty;
+  let typ = transl_type env Extensible styp in
+  make_fixed_univars typ.ctyp_type;
+  (typ, globalize_used_variables env false)
+
+let transl_type_scheme env styp =
+  reset_type_variables();
+  begin_def();
+  let typ = transl_simple_type env false styp in
+  end_def();
+  generalize typ.ctyp_type;
+  typ
+
+
+(* Error report *)
+
+open Format
+open Printtyp
+
+let report_error env ppf = function
+  | Unbound_type_variable name ->
+      let add_name name _ l = if name = "_" then l else ("'" ^ name) :: l in
+      let names = TyVarMap.fold add_name !type_variables [] in
+    fprintf ppf "The type variable %s is unbound in this type declaration.@ %a"
+      name
+      did_you_mean (fun () -> Misc.spellcheck names name )
+  | Undefined_type_constructor p ->
+    fprintf ppf "The type constructor@ %a@ is not yet completely defined"
+      path p
+  | Type_arity_mismatch(lid, expected, provided) ->
+    fprintf ppf
+      "@[The type constructor %a@ expects %i argument(s),@ \
+        but is here applied to %i argument(s)@]"
+      longident lid expected provided
+  | Bound_type_variable name ->
+    fprintf ppf "Already bound type parameter %a" Pprintast.tyvar name
+  | Recursive_type ->
+    fprintf ppf "This type is recursive"
+  | Unbound_row_variable lid ->
+      (* we don't use "spellcheck" here: this error is not raised
+         anywhere so it's unclear how it should be handled *)
+      fprintf ppf "Unbound row variable in #%a" longident lid
+  | 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")
+  | 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")
+  | Present_has_conjunction l ->
+      fprintf ppf "The present constructor %s has a conjunctive type" l
+  | Present_has_no_type l ->
+      fprintf ppf
+        "@[@[The constructor %s is missing from the upper bound@ \
+         (between '<'@ and '>')@ of this polymorphic variant@ \
+         but is present in@ its lower bound (after '>').@]@,\
+         @[Hint: Either add `%s in the upper bound,@ \
+         or remove it@ from the lower bound.@]@]"
+         l l
+  | Constructor_mismatch (ty, ty') ->
+      wrap_printing_env ~error:true env (fun ()  ->
+        Printtyp.reset_and_mark_loops_list [ty; ty'];
+        fprintf ppf "@[%s %a@ %s@ %a@]"
+          "This variant type contains a constructor"
+          !Oprint.out_type (tree_of_typexp false ty)
+          "which should be"
+           !Oprint.out_type (tree_of_typexp false ty'))
+  | Not_a_variant ty ->
+      fprintf ppf
+        "@[The type %a@ does not expand to a polymorphic variant type@]"
+        Printtyp.type_expr ty;
+      begin match ty.desc with
+        | Tvar (Some s) ->
+           (* PR#7012: help the user that wrote 'Foo instead of `Foo *)
+           Misc.did_you_mean ppf (fun () -> ["`" ^ s])
+        | _ -> ()
+      end
+  | Variant_tags (lab1, lab2) ->
+      fprintf ppf
+        "@[Variant tags `%s@ and `%s have the same hash value.@ %s@]"
+        lab1 lab2 "Change one of them."
+  | Invalid_variable_name name ->
+      fprintf ppf "The type variable name %s is not allowed in programs" name
+  | Cannot_quantify (name, v) ->
+      fprintf ppf
+        "@[The universal type variable %a cannot be generalized:@ "
+        Pprintast.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" Printtyp.type_expr v;
+      fprintf ppf ".@]";
+  | Multiple_constraints_on_type s ->
+      fprintf ppf "Multiple constraints for type %a" longident s
+  | Method_mismatch (l, ty, ty') ->
+      wrap_printing_env ~error:true env (fun ()  ->
+        fprintf ppf "@[Method '%s' has type %a,@ which should be %a@]"
+          l Printtyp.type_expr ty Printtyp.type_expr ty')
+  | Opened_object nm ->
+      fprintf ppf
+        "Illegal open object type%a"
+        (fun ppf -> function
+             Some p -> fprintf ppf "@ %a" path p
+           | None -> fprintf ppf "") nm
+  | Not_an_object ty ->
+      fprintf ppf "@[The type %a@ is not an object type@]"
+        Printtyp.type_expr ty
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (loc, env, err) ->
+        Some (Location.error_of_printer ~loc (report_error env) err)
+      | Error_forward err ->
+        Some err
+      | _ ->
+        None
+    )
diff --git a/typing/typetexp.mli b/typing/typetexp.mli
new file mode 100644
index 00000000..5475abbc
--- /dev/null
+++ b/typing/typetexp.mli
@@ -0,0 +1,76 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Typechecking of type expressions for the core language *)
+
+open Types
+
+val valid_tyvar_name : string -> bool
+
+val transl_simple_type:
+        Env.t -> bool -> Parsetree.core_type -> Typedtree.core_type
+val transl_simple_type_univars:
+        Env.t -> Parsetree.core_type -> Typedtree.core_type
+val transl_simple_type_delayed:
+        Env.t -> Parsetree.core_type -> Typedtree.core_type * (unit -> unit)
+        (* Translate a type, but leave type variables unbound. Returns
+           the type and a function that binds the type variable. *)
+val transl_type_scheme:
+        Env.t -> Parsetree.core_type -> Typedtree.core_type
+val reset_type_variables: unit -> unit
+val type_variable: Location.t -> string -> type_expr
+val transl_type_param:
+  Env.t -> Parsetree.core_type -> Typedtree.core_type
+
+type variable_context
+val narrow: unit -> variable_context
+val widen: variable_context -> unit
+
+exception Already_bound
+
+type error =
+    Unbound_type_variable of string
+  | Undefined_type_constructor of Path.t
+  | Type_arity_mismatch of Longident.t * int * int
+  | Bound_type_variable of string
+  | Recursive_type
+  | Unbound_row_variable of Longident.t
+  | Type_mismatch of Ctype.Unification_trace.t
+  | Alias_type_mismatch of Ctype.Unification_trace.t
+  | Present_has_conjunction of string
+  | Present_has_no_type of string
+  | Constructor_mismatch of type_expr * type_expr
+  | Not_a_variant of type_expr
+  | Variant_tags of string * string
+  | Invalid_variable_name of string
+  | Cannot_quantify of string * type_expr
+  | Multiple_constraints_on_type of Longident.t
+  | Method_mismatch of string * type_expr * type_expr
+  | Opened_object of Path.t option
+  | Not_an_object of type_expr
+
+exception Error of Location.t * Env.t * error
+
+val report_error: Env.t -> Format.formatter -> error -> unit
+
+(* Support for first-class modules. *)
+val transl_modtype_longident:  (* from Typemod *)
+    (Location.t -> Env.t -> Longident.t -> Path.t) ref
+val transl_modtype: (* from Typemod *)
+    (Env.t -> Parsetree.module_type -> Typedtree.module_type) ref
+val create_package_mty:
+    Location.t -> Env.t -> Parsetree.package_type ->
+    (Longident.t Asttypes.loc * Parsetree.core_type) list *
+      Parsetree.module_type
diff --git a/typing/untypeast.ml b/typing/untypeast.ml
new file mode 100644
index 00000000..7106da5b
--- /dev/null
+++ b/typing/untypeast.ml
@@ -0,0 +1,889 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*    Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay)     *)
+(*                                                                        *)
+(*   Copyright 2007 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Longident
+open Asttypes
+open Parsetree
+open Ast_helper
+
+module T = Typedtree
+
+type mapper = {
+  attribute: mapper -> T.attribute -> attribute;
+  attributes: mapper -> T.attribute list -> attribute list;
+  binding_op: mapper -> T.binding_op -> T.pattern -> binding_op;
+  case: 'k . mapper -> 'k T.case -> case;
+  class_declaration: mapper -> T.class_declaration -> class_declaration;
+  class_description: mapper -> T.class_description -> class_description;
+  class_expr: mapper -> T.class_expr -> class_expr;
+  class_field: mapper -> T.class_field -> class_field;
+  class_signature: mapper -> T.class_signature -> class_signature;
+  class_structure: mapper -> T.class_structure -> class_structure;
+  class_type: mapper -> T.class_type -> class_type;
+  class_type_declaration: mapper -> T.class_type_declaration
+                          -> class_type_declaration;
+  class_type_field: mapper -> T.class_type_field -> class_type_field;
+  constructor_declaration: mapper -> T.constructor_declaration
+                           -> constructor_declaration;
+  expr: mapper -> T.expression -> expression;
+  extension_constructor: mapper -> T.extension_constructor
+                         -> extension_constructor;
+  include_declaration: mapper -> T.include_declaration -> include_declaration;
+  include_description: mapper -> T.include_description -> include_description;
+  label_declaration: mapper -> T.label_declaration -> label_declaration;
+  location: mapper -> Location.t -> Location.t;
+  module_binding: mapper -> T.module_binding -> module_binding;
+  module_declaration: mapper -> T.module_declaration -> module_declaration;
+  module_substitution: mapper -> T.module_substitution -> module_substitution;
+  module_expr: mapper -> T.module_expr -> module_expr;
+  module_type: mapper -> T.module_type -> module_type;
+  module_type_declaration:
+    mapper -> T.module_type_declaration -> module_type_declaration;
+  package_type: mapper -> T.package_type -> package_type;
+  open_declaration: mapper -> T.open_declaration -> open_declaration;
+  open_description: mapper -> T.open_description -> open_description;
+  pat: 'k . mapper -> 'k T.general_pattern -> pattern;
+  row_field: mapper -> T.row_field -> row_field;
+  object_field: mapper -> T.object_field -> object_field;
+  signature: mapper -> T.signature -> signature;
+  signature_item: mapper -> T.signature_item -> signature_item;
+  structure: mapper -> T.structure -> structure;
+  structure_item: mapper -> T.structure_item -> structure_item;
+  typ: mapper -> T.core_type -> core_type;
+  type_declaration: mapper -> T.type_declaration -> type_declaration;
+  type_extension: mapper -> T.type_extension -> type_extension;
+  type_exception: mapper -> T.type_exception -> type_exception;
+  type_kind: mapper -> T.type_kind -> type_kind;
+  value_binding: mapper -> T.value_binding -> value_binding;
+  value_description: mapper -> T.value_description -> value_description;
+  with_constraint:
+    mapper -> (Path.t * Longident.t Location.loc * T.with_constraint)
+    -> with_constraint;
+}
+
+open T
+
+(*
+Some notes:
+
+   * For Pexp_function, we cannot go back to the exact original version
+   when there is a default argument, because the default argument is
+   translated in the typer. The code, if printed, will not be parsable because
+   new generated identifiers are not correct.
+
+   * For Pexp_apply, it is unclear whether arguments are reordered, especially
+    when there are optional arguments.
+
+*)
+
+
+(** Utility functions. *)
+
+let string_is_prefix sub str =
+  let sublen = String.length sub in
+  String.length str >= sublen && String.sub str 0 sublen = sub
+
+let rec lident_of_path = function
+  | Path.Pident id -> Longident.Lident (Ident.name id)
+  | Path.Pdot (p, s) -> Longident.Ldot (lident_of_path p, s)
+  | Path.Papply (p1, p2) ->
+      Longident.Lapply (lident_of_path p1, lident_of_path p2)
+
+let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt}
+
+(** Try a name [$name$0], check if it's free, if not, increment and repeat. *)
+let fresh_name s env =
+  let rec aux i =
+    let name = s ^ Int.to_string i in
+    if Env.bound_value name env then aux (i+1)
+    else name
+  in
+  aux 0
+
+(** Extract the [n] patterns from the case of a letop *)
+let rec extract_letop_patterns n pat =
+  if n = 0 then pat, []
+  else begin
+    match pat.pat_desc with
+    | Tpat_tuple([first; rest]) ->
+        let next, others = extract_letop_patterns (n-1) rest in
+        first, next :: others
+    | _ ->
+      let rec anys n =
+        if n = 0 then []
+        else { pat with pat_desc = Tpat_any } :: anys (n-1)
+      in
+      { pat with pat_desc = Tpat_any }, anys (n-1)
+  end
+
+(** 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)
+
+let attribute sub a = {
+    attr_name = map_loc sub a.attr_name;
+    attr_payload = a.attr_payload;
+    attr_loc = a.attr_loc
+  }
+
+let attributes sub l = List.map (sub.attribute sub) l
+
+let structure sub str =
+  List.map (sub.structure_item sub) str.str_items
+
+let open_description sub od =
+  let loc = sub.location sub od.open_loc in
+  let attrs = sub.attributes sub od.open_attributes in
+  Opn.mk ~loc ~attrs
+    ~override:od.open_override
+    (snd od.open_expr)
+
+let open_declaration sub od =
+  let loc = sub.location sub od.open_loc in
+  let attrs = sub.attributes sub od.open_attributes in
+  Opn.mk ~loc ~attrs
+    ~override:od.open_override
+    (sub.module_expr sub od.open_expr)
+
+let structure_item sub item =
+  let loc = sub.location sub item.str_loc in
+  let desc =
+    match item.str_desc with
+      Tstr_eval (exp, attrs) -> Pstr_eval (sub.expr sub exp, attrs)
+    | Tstr_value (rec_flag, list) ->
+        Pstr_value (rec_flag, List.map (sub.value_binding sub) list)
+    | Tstr_primitive vd ->
+        Pstr_primitive (sub.value_description sub vd)
+    | Tstr_type (rec_flag, list) ->
+        Pstr_type (rec_flag, List.map (sub.type_declaration sub) list)
+    | Tstr_typext tyext ->
+        Pstr_typext (sub.type_extension sub tyext)
+    | Tstr_exception ext ->
+        Pstr_exception (sub.type_exception sub ext)
+    | Tstr_module mb ->
+        Pstr_module (sub.module_binding sub mb)
+    | Tstr_recmodule list ->
+        Pstr_recmodule (List.map (sub.module_binding sub) list)
+    | Tstr_modtype mtd ->
+        Pstr_modtype (sub.module_type_declaration sub mtd)
+    | Tstr_open od ->
+        Pstr_open (sub.open_declaration sub od)
+    | Tstr_class list ->
+        Pstr_class
+          (List.map
+             (fun (ci, _) -> sub.class_declaration sub ci)
+             list)
+    | Tstr_class_type list ->
+        Pstr_class_type
+          (List.map
+             (fun (_id, _name, ct) -> sub.class_type_declaration sub ct)
+             list)
+    | Tstr_include incl ->
+        Pstr_include (sub.include_declaration sub incl)
+    | Tstr_attribute x ->
+        Pstr_attribute x
+  in
+  Str.mk ~loc desc
+
+let value_description sub v =
+  let loc = sub.location sub v.val_loc in
+  let attrs = sub.attributes sub v.val_attributes in
+  Val.mk ~loc ~attrs
+    ~prim:v.val_prim
+    (map_loc sub v.val_name)
+    (sub.typ sub v.val_desc)
+
+let module_binding sub mb =
+  let loc = sub.location sub mb.mb_loc in
+  let attrs = sub.attributes sub mb.mb_attributes in
+  Mb.mk ~loc ~attrs
+    (map_loc sub mb.mb_name)
+    (sub.module_expr sub mb.mb_expr)
+
+let type_parameter sub (ct, v) = (sub.typ sub ct, v)
+
+let type_declaration sub decl =
+  let loc = sub.location sub decl.typ_loc in
+  let attrs = sub.attributes sub decl.typ_attributes in
+  Type.mk ~loc ~attrs
+    ~params:(List.map (type_parameter sub) decl.typ_params)
+    ~cstrs:(
+      List.map
+        (fun (ct1, ct2, loc) ->
+           (sub.typ sub ct1, sub.typ sub ct2, sub.location sub loc))
+        decl.typ_cstrs)
+    ~kind:(sub.type_kind sub decl.typ_kind)
+    ~priv:decl.typ_private
+    ?manifest:(Option.map (sub.typ sub) decl.typ_manifest)
+    (map_loc sub decl.typ_name)
+
+let type_kind sub tk = match tk with
+  | Ttype_abstract -> Ptype_abstract
+  | Ttype_variant list ->
+      Ptype_variant (List.map (sub.constructor_declaration sub) list)
+  | Ttype_record list ->
+      Ptype_record (List.map (sub.label_declaration sub) list)
+  | Ttype_open -> Ptype_open
+
+let constructor_arguments sub = function
+   | Cstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l)
+   | Cstr_record l -> Pcstr_record (List.map (sub.label_declaration sub) l)
+
+let constructor_declaration sub cd =
+  let loc = sub.location sub cd.cd_loc in
+  let attrs = sub.attributes sub cd.cd_attributes in
+  Type.constructor ~loc ~attrs
+    ~args:(constructor_arguments sub cd.cd_args)
+    ?res:(Option.map (sub.typ sub) cd.cd_res)
+    (map_loc sub cd.cd_name)
+
+let label_declaration sub ld =
+  let loc = sub.location sub ld.ld_loc in
+  let attrs = sub.attributes sub ld.ld_attributes in
+  Type.field ~loc ~attrs
+    ~mut:ld.ld_mutable
+    (map_loc sub ld.ld_name)
+    (sub.typ sub ld.ld_type)
+
+let type_extension sub tyext =
+  let attrs = sub.attributes sub tyext.tyext_attributes in
+  Te.mk ~attrs
+    ~params:(List.map (type_parameter sub) tyext.tyext_params)
+    ~priv:tyext.tyext_private
+    (map_loc sub tyext.tyext_txt)
+    (List.map (sub.extension_constructor sub) tyext.tyext_constructors)
+
+let type_exception sub tyexn =
+  let attrs = sub.attributes sub tyexn.tyexn_attributes in
+  Te.mk_exception ~attrs
+    (sub.extension_constructor sub tyexn.tyexn_constructor)
+
+let extension_constructor sub ext =
+  let loc = sub.location sub ext.ext_loc in
+  let attrs = sub.attributes sub ext.ext_attributes in
+  Te.constructor ~loc ~attrs
+    (map_loc sub ext.ext_name)
+    (match ext.ext_kind with
+      | Text_decl (args, ret) ->
+          Pext_decl (constructor_arguments sub args,
+                     Option.map (sub.typ sub) ret)
+      | Text_rebind (_p, lid) -> Pext_rebind (map_loc sub lid)
+    )
+
+let pattern : type k . _ -> k T.general_pattern -> _ = fun sub pat ->
+  let loc = sub.location sub pat.pat_loc in
+  (* todo: fix attributes on extras *)
+  let attrs = sub.attributes sub pat.pat_attributes in
+  let desc =
+  match pat with
+      { pat_extra=[Tpat_unpack, loc, _attrs]; pat_desc = Tpat_any; _ } ->
+        Ppat_unpack { txt = None; loc  }
+    | { pat_extra=[Tpat_unpack, _, _attrs]; pat_desc = Tpat_var (_,name); _ } ->
+        Ppat_unpack { name with txt = Some name.txt }
+    | { pat_extra=[Tpat_type (_path, lid), _, _attrs]; _ } ->
+        Ppat_type (map_loc sub lid)
+    | { pat_extra= (Tpat_constraint ct, _, _attrs) :: rem; _ } ->
+        Ppat_constraint (sub.pat sub { pat with pat_extra=rem },
+                         sub.typ sub ct)
+    | _ ->
+    match pat.pat_desc with
+      Tpat_any -> Ppat_any
+    | Tpat_var (id, name) ->
+        begin
+          match (Ident.name id).[0] with
+            'A'..'Z' ->
+              Ppat_unpack { name with txt = Some name.txt}
+          | _ ->
+              Ppat_var name
+        end
+
+    (* We transform (_ as x) in x if _ and x have the same location.
+       The compiler transforms (x:t) into (_ as x : t).
+       This avoids transforming a warning 27 into a 26.
+     *)
+    | Tpat_alias ({pat_desc = Tpat_any; pat_loc}, _id, name)
+         when pat_loc = pat.pat_loc ->
+       Ppat_var name
+
+    | Tpat_alias (pat, _id, name) ->
+        Ppat_alias (sub.pat sub pat, name)
+    | Tpat_constant cst -> Ppat_constant (constant cst)
+    | Tpat_tuple list ->
+        Ppat_tuple (List.map (sub.pat sub) list)
+    | Tpat_construct (lid, _, args) ->
+        Ppat_construct (map_loc sub lid,
+          (match args with
+              [] -> None
+            | [arg] -> Some (sub.pat sub arg)
+            | args ->
+                Some
+                  (Pat.tuple ~loc
+                     (List.map (sub.pat sub) args)
+                  )
+          ))
+    | Tpat_variant (label, pato, _) ->
+        Ppat_variant (label, Option.map (sub.pat sub) pato)
+    | Tpat_record (list, closed) ->
+        Ppat_record (List.map (fun (lid, _, pat) ->
+            map_loc sub lid, sub.pat sub pat) list, closed)
+    | Tpat_array list -> Ppat_array (List.map (sub.pat sub) list)
+    | Tpat_lazy p -> Ppat_lazy (sub.pat sub p)
+
+    | Tpat_exception p -> Ppat_exception (sub.pat sub p)
+    | Tpat_value p -> (sub.pat sub (p :> pattern)).ppat_desc
+    | Tpat_or (p1, p2, _) -> Ppat_or (sub.pat sub p1, sub.pat sub p2)
+  in
+  Pat.mk ~loc ~attrs desc
+
+let exp_extra sub (extra, loc, attrs) sexp =
+  let loc = sub.location sub loc in
+  let attrs = sub.attributes sub attrs in
+  let desc =
+    match extra with
+      Texp_coerce (cty1, cty2) ->
+        Pexp_coerce (sexp,
+                     Option.map (sub.typ sub) cty1,
+                     sub.typ sub cty2)
+    | Texp_constraint cty ->
+        Pexp_constraint (sexp, sub.typ sub cty)
+    | Texp_poly cto -> Pexp_poly (sexp, Option.map (sub.typ sub) cto)
+    | Texp_newtype s -> Pexp_newtype (mkloc s loc, sexp)
+  in
+  Exp.mk ~loc ~attrs desc
+
+let case : type k . mapper -> k case -> _ = fun sub {c_lhs; c_guard; c_rhs} ->
+  {
+   pc_lhs = sub.pat sub c_lhs;
+   pc_guard = Option.map (sub.expr sub) c_guard;
+   pc_rhs = sub.expr sub c_rhs;
+  }
+
+let value_binding sub vb =
+  let loc = sub.location sub vb.vb_loc in
+  let attrs = sub.attributes sub vb.vb_attributes in
+  Vb.mk ~loc ~attrs
+    (sub.pat sub vb.vb_pat)
+    (sub.expr sub vb.vb_expr)
+
+let expression sub exp =
+  let loc = sub.location sub exp.exp_loc in
+  let attrs = sub.attributes sub exp.exp_attributes in
+  let desc =
+    match exp.exp_desc with
+      Texp_ident (_path, lid, _) -> Pexp_ident (map_loc sub lid)
+    | Texp_constant cst -> Pexp_constant (constant cst)
+    | Texp_let (rec_flag, list, exp) ->
+        Pexp_let (rec_flag,
+          List.map (sub.value_binding sub) list,
+          sub.expr sub exp)
+
+    (* Pexp_function can't have a label, so we split in 3 cases. *)
+    (* One case, no guard: It's a fun. *)
+    | Texp_function { arg_label; cases = [{c_lhs=p; c_guard=None; c_rhs=e}];
+          _ } ->
+        Pexp_fun (arg_label, None, sub.pat sub p, sub.expr sub e)
+    (* No label: it's a function. *)
+    | Texp_function { arg_label = Nolabel; cases; _; } ->
+        Pexp_function (List.map (sub.case sub) cases)
+    (* Mix of both, we generate `fun ~label:$name$ -> match $name$ with ...` *)
+    | Texp_function { arg_label = Labelled s | Optional s as label; cases;
+          _ } ->
+        let name = fresh_name s exp.exp_env in
+        Pexp_fun (label, None, Pat.var ~loc {loc;txt = name },
+          Exp.match_ ~loc (Exp.ident ~loc {loc;txt= Lident name})
+                          (List.map (sub.case sub) cases))
+    | Texp_apply (exp, list) ->
+        Pexp_apply (sub.expr sub exp,
+          List.fold_right (fun (label, expo) list ->
+              match expo with
+                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_tuple list ->
+        Pexp_tuple (List.map (sub.expr sub) list)
+    | Texp_construct (lid, _, args) ->
+        Pexp_construct (map_loc sub lid,
+          (match args with
+              [] -> None
+          | [ arg ] -> Some (sub.expr sub arg)
+          | args ->
+              Some
+                (Exp.tuple ~loc (List.map (sub.expr sub) args))
+          ))
+    | Texp_variant (label, expo) ->
+        Pexp_variant (label, Option.map (sub.expr sub) expo)
+    | Texp_record { fields; extended_expression; _ } ->
+        let list = Array.fold_left (fun l -> function
+            | _, Kept _ -> l
+            | _, Overridden (lid, exp) -> (lid, sub.expr sub exp) :: l)
+            [] fields
+        in
+        Pexp_record (list, Option.map (sub.expr sub) extended_expression)
+    | Texp_field (exp, lid, _label) ->
+        Pexp_field (sub.expr sub exp, map_loc sub lid)
+    | Texp_setfield (exp1, lid, _label, exp2) ->
+        Pexp_setfield (sub.expr sub exp1, map_loc sub lid,
+          sub.expr sub exp2)
+    | Texp_array list ->
+        Pexp_array (List.map (sub.expr sub) list)
+    | Texp_ifthenelse (exp1, exp2, expo) ->
+        Pexp_ifthenelse (sub.expr sub exp1,
+          sub.expr sub exp2,
+          Option.map (sub.expr sub) expo)
+    | Texp_sequence (exp1, exp2) ->
+        Pexp_sequence (sub.expr sub exp1, sub.expr sub exp2)
+    | Texp_while (exp1, exp2) ->
+        Pexp_while (sub.expr sub exp1, sub.expr sub exp2)
+    | Texp_for (_id, name, exp1, exp2, dir, exp3) ->
+        Pexp_for (name,
+          sub.expr sub exp1, sub.expr sub exp2,
+          dir, sub.expr sub exp3)
+    | Texp_send (exp, meth, _) ->
+        Pexp_send (sub.expr sub exp, match meth with
+            Tmeth_name name -> mkloc name loc
+          | Tmeth_val id -> mkloc (Ident.name id) loc)
+    | Texp_new (_path, lid, _) -> Pexp_new (map_loc sub lid)
+    | Texp_instvar (_, path, name) ->
+      Pexp_ident ({loc = sub.location sub name.loc ; txt = lident_of_path path})
+    | Texp_setinstvar (_, _path, lid, exp) ->
+        Pexp_setinstvar (map_loc sub lid, sub.expr sub exp)
+    | Texp_override (_, list) ->
+        Pexp_override (List.map (fun (_path, lid, exp) ->
+              (map_loc sub lid, sub.expr sub exp)
+          ) list)
+    | Texp_letmodule (_id, name, _pres, mexpr, exp) ->
+        Pexp_letmodule (name, sub.module_expr sub mexpr,
+          sub.expr sub exp)
+    | Texp_letexception (ext, exp) ->
+        Pexp_letexception (sub.extension_constructor sub ext,
+                           sub.expr sub exp)
+    | Texp_assert exp -> Pexp_assert (sub.expr sub exp)
+    | Texp_lazy exp -> Pexp_lazy (sub.expr sub exp)
+    | Texp_object (cl, _) ->
+        Pexp_object (sub.class_structure sub cl)
+    | Texp_pack (mexpr) ->
+        Pexp_pack (sub.module_expr sub mexpr)
+    | Texp_letop {let_; ands; body; _} ->
+        let pat, and_pats =
+          extract_letop_patterns (List.length ands) body.c_lhs
+        in
+        let let_ = sub.binding_op sub let_ pat in
+        let ands = List.map2 (sub.binding_op sub) ands and_pats in
+        let body = sub.expr sub body.c_rhs in
+        Pexp_letop {let_; ands; body }
+    | Texp_unreachable ->
+        Pexp_unreachable
+    | Texp_extension_constructor (lid, _) ->
+        Pexp_extension ({ txt = "ocaml.extension_constructor"; loc },
+                        PStr [ Str.eval ~loc
+                                 (Exp.construct ~loc (map_loc sub lid) None)
+                             ])
+    | Texp_open (od, exp) ->
+        Pexp_open (sub.open_declaration sub od, sub.expr sub exp)
+  in
+  List.fold_right (exp_extra sub) exp.exp_extra
+    (Exp.mk ~loc ~attrs desc)
+
+let binding_op sub bop pat =
+  let pbop_op = bop.bop_op_name in
+  let pbop_pat = sub.pat sub pat in
+  let pbop_exp = sub.expr sub bop.bop_exp in
+  let pbop_loc = bop.bop_loc in
+  {pbop_op; pbop_pat; pbop_exp; pbop_loc}
+
+let package_type sub pack =
+  (map_loc sub pack.pack_txt,
+    List.map (fun (s, ct) ->
+        (s, sub.typ sub ct)) pack.pack_fields)
+
+let module_type_declaration sub mtd =
+  let loc = sub.location sub mtd.mtd_loc in
+  let attrs = sub.attributes sub mtd.mtd_attributes in
+  Mtd.mk ~loc ~attrs
+    ?typ:(Option.map (sub.module_type sub) mtd.mtd_type)
+    (map_loc sub mtd.mtd_name)
+
+let signature sub sg =
+  List.map (sub.signature_item sub) sg.sig_items
+
+let signature_item sub item =
+  let loc = sub.location sub item.sig_loc in
+  let desc =
+    match item.sig_desc with
+      Tsig_value v ->
+        Psig_value (sub.value_description sub v)
+    | Tsig_type (rec_flag, list) ->
+        Psig_type (rec_flag, List.map (sub.type_declaration sub) list)
+    | Tsig_typesubst list ->
+        Psig_typesubst (List.map (sub.type_declaration sub) list)
+    | Tsig_typext tyext ->
+        Psig_typext (sub.type_extension sub tyext)
+    | Tsig_exception ext ->
+        Psig_exception (sub.type_exception sub ext)
+    | Tsig_module md ->
+        Psig_module (sub.module_declaration sub md)
+    | Tsig_modsubst ms ->
+        Psig_modsubst (sub.module_substitution sub ms)
+    | Tsig_recmodule list ->
+        Psig_recmodule (List.map (sub.module_declaration sub) list)
+    | Tsig_modtype mtd ->
+        Psig_modtype (sub.module_type_declaration sub mtd)
+    | Tsig_open od ->
+        Psig_open (sub.open_description sub od)
+    | Tsig_include incl ->
+        Psig_include (sub.include_description sub incl)
+    | Tsig_class list ->
+        Psig_class (List.map (sub.class_description sub) list)
+    | Tsig_class_type list ->
+        Psig_class_type (List.map (sub.class_type_declaration sub) list)
+    | Tsig_attribute x ->
+        Psig_attribute x
+  in
+  Sig.mk ~loc desc
+
+let module_declaration sub md =
+  let loc = sub.location sub md.md_loc in
+  let attrs = sub.attributes sub md.md_attributes in
+  Md.mk ~loc ~attrs
+    (map_loc sub md.md_name)
+    (sub.module_type sub md.md_type)
+
+let module_substitution sub ms =
+  let loc = sub.location sub ms.ms_loc in
+  let attrs = sub.attributes sub ms.ms_attributes in
+  Ms.mk ~loc ~attrs
+    (map_loc sub ms.ms_name)
+    (map_loc sub ms.ms_txt)
+
+let include_infos f sub incl =
+  let loc = sub.location sub incl.incl_loc in
+  let attrs = sub.attributes sub incl.incl_attributes in
+  Incl.mk ~loc ~attrs
+    (f sub incl.incl_mod)
+
+let include_declaration sub = include_infos sub.module_expr sub
+let include_description sub = include_infos sub.module_type sub
+
+let class_infos f sub ci =
+  let loc = sub.location sub ci.ci_loc in
+  let attrs = sub.attributes sub ci.ci_attributes in
+  Ci.mk ~loc ~attrs
+    ~virt:ci.ci_virt
+    ~params:(List.map (type_parameter sub) ci.ci_params)
+    (map_loc sub ci.ci_id_name)
+    (f sub ci.ci_expr)
+
+let class_declaration sub = class_infos sub.class_expr sub
+let class_description sub = class_infos sub.class_type sub
+let class_type_declaration sub = class_infos sub.class_type sub
+
+let functor_parameter sub : functor_parameter -> Parsetree.functor_parameter =
+  function
+  | Unit -> Unit
+  | Named (_, name, mtype) -> Named (name, sub.module_type sub mtype)
+
+let module_type sub mty =
+  let loc = sub.location sub mty.mty_loc in
+  let attrs = sub.attributes sub mty.mty_attributes in
+  let desc = match mty.mty_desc with
+      Tmty_ident (_path, lid) -> Pmty_ident (map_loc sub lid)
+    | Tmty_alias (_path, lid) -> Pmty_alias (map_loc sub lid)
+    | Tmty_signature sg -> Pmty_signature (sub.signature sub sg)
+    | Tmty_functor (arg, mtype2) ->
+        Pmty_functor (functor_parameter sub arg, sub.module_type sub mtype2)
+    | Tmty_with (mtype, list) ->
+        Pmty_with (sub.module_type sub mtype,
+          List.map (sub.with_constraint sub) list)
+    | Tmty_typeof mexpr ->
+        Pmty_typeof (sub.module_expr sub mexpr)
+  in
+  Mty.mk ~loc ~attrs desc
+
+let with_constraint sub (_path, lid, cstr) =
+  match cstr with
+  | Twith_type decl ->
+      Pwith_type (map_loc sub lid, sub.type_declaration sub decl)
+  | Twith_module (_path, lid2) ->
+      Pwith_module (map_loc sub lid, map_loc sub lid2)
+  | Twith_typesubst decl ->
+     Pwith_typesubst (map_loc sub lid, sub.type_declaration sub decl)
+  | Twith_modsubst (_path, lid2) ->
+      Pwith_modsubst (map_loc sub lid, map_loc sub lid2)
+
+let module_expr sub mexpr =
+  let loc = sub.location sub mexpr.mod_loc in
+  let attrs = sub.attributes sub mexpr.mod_attributes in
+  match mexpr.mod_desc with
+      Tmod_constraint (m, _, Tmodtype_implicit, _ ) ->
+        sub.module_expr sub m
+    | _ ->
+        let desc = match mexpr.mod_desc with
+            Tmod_ident (_p, lid) -> Pmod_ident (map_loc sub lid)
+          | Tmod_structure st -> Pmod_structure (sub.structure sub st)
+          | Tmod_functor (arg, mexpr) ->
+              Pmod_functor
+                (functor_parameter sub arg, sub.module_expr sub mexpr)
+          | Tmod_apply (mexp1, mexp2, _) ->
+              Pmod_apply (sub.module_expr sub mexp1, sub.module_expr sub mexp2)
+          | Tmod_constraint (mexpr, _, Tmodtype_explicit mtype, _) ->
+              Pmod_constraint (sub.module_expr sub mexpr,
+                sub.module_type sub mtype)
+          | Tmod_constraint (_mexpr, _, Tmodtype_implicit, _) ->
+              assert false
+          | Tmod_unpack (exp, _pack) ->
+              Pmod_unpack (sub.expr sub exp)
+              (* TODO , sub.package_type sub pack) *)
+        in
+        Mod.mk ~loc ~attrs desc
+
+let class_expr sub cexpr =
+  let loc = sub.location sub cexpr.cl_loc in
+  let attrs = sub.attributes sub cexpr.cl_attributes in
+  let desc = match cexpr.cl_desc with
+    | Tcl_constraint ( { cl_desc = Tcl_ident (_path, lid, tyl); _ },
+                       None, _, _, _ ) ->
+        Pcl_constr (map_loc sub lid,
+          List.map (sub.typ sub) tyl)
+    | Tcl_structure clstr -> Pcl_structure (sub.class_structure sub clstr)
+
+    | Tcl_fun (label, pat, _pv, cl, _partial) ->
+        Pcl_fun (label, None, sub.pat sub pat, sub.class_expr sub cl)
+
+    | Tcl_apply (cl, args) ->
+        Pcl_apply (sub.class_expr sub cl,
+          List.fold_right (fun (label, expo) list ->
+              match expo with
+                None -> list
+              | Some exp -> (label, sub.expr sub exp) :: list
+          ) args [])
+
+    | Tcl_let (rec_flat, bindings, _ivars, cl) ->
+        Pcl_let (rec_flat,
+          List.map (sub.value_binding sub) bindings,
+          sub.class_expr sub cl)
+
+    | Tcl_constraint (cl, Some clty, _vals, _meths, _concrs) ->
+        Pcl_constraint (sub.class_expr sub cl,  sub.class_type sub clty)
+
+    | Tcl_open (od, e) ->
+        Pcl_open (sub.open_description sub od, sub.class_expr sub e)
+
+    | Tcl_ident _ -> assert false
+    | Tcl_constraint (_, None, _, _, _) -> assert false
+  in
+  Cl.mk ~loc ~attrs desc
+
+let class_type sub ct =
+  let loc = sub.location sub ct.cltyp_loc in
+  let attrs = sub.attributes sub ct.cltyp_attributes in
+  let desc = match ct.cltyp_desc with
+      Tcty_signature csg -> Pcty_signature (sub.class_signature sub csg)
+    | Tcty_constr (_path, lid, list) ->
+        Pcty_constr (map_loc sub lid, List.map (sub.typ sub) list)
+    | Tcty_arrow (label, ct, cl) ->
+        Pcty_arrow (label, sub.typ sub ct, sub.class_type sub cl)
+    | Tcty_open (od, e) ->
+        Pcty_open (sub.open_description sub od, sub.class_type sub e)
+  in
+  Cty.mk ~loc ~attrs desc
+
+let class_signature sub cs =
+  {
+    pcsig_self = sub.typ sub cs.csig_self;
+    pcsig_fields = List.map (sub.class_type_field sub) cs.csig_fields;
+  }
+
+let class_type_field sub ctf =
+  let loc = sub.location sub ctf.ctf_loc in
+  let attrs = sub.attributes sub ctf.ctf_attributes in
+  let desc = match ctf.ctf_desc with
+      Tctf_inherit ct -> Pctf_inherit (sub.class_type sub ct)
+    | Tctf_val (s, mut, virt, ct) ->
+        Pctf_val (mkloc s loc, mut, virt, sub.typ sub ct)
+    | Tctf_method  (s, priv, virt, ct) ->
+        Pctf_method  (mkloc s loc, priv, virt, sub.typ sub ct)
+    | Tctf_constraint  (ct1, ct2) ->
+        Pctf_constraint (sub.typ sub ct1, sub.typ sub ct2)
+    | Tctf_attribute x -> Pctf_attribute x
+  in
+  Ctf.mk ~loc ~attrs desc
+
+let core_type sub ct =
+  let loc = sub.location sub ct.ctyp_loc in
+  let attrs = sub.attributes sub ct.ctyp_attributes in
+  let desc = match ct.ctyp_desc with
+      Ttyp_any -> Ptyp_any
+    | Ttyp_var s -> Ptyp_var s
+    | Ttyp_arrow (label, ct1, ct2) ->
+        Ptyp_arrow (label, sub.typ sub ct1, sub.typ sub ct2)
+    | Ttyp_tuple list -> Ptyp_tuple (List.map (sub.typ sub) list)
+    | Ttyp_constr (_path, lid, list) ->
+        Ptyp_constr (map_loc sub lid,
+          List.map (sub.typ sub) list)
+    | Ttyp_object (list, o) ->
+        Ptyp_object
+          (List.map (sub.object_field sub) list, o)
+    | Ttyp_class (_path, lid, list) ->
+        Ptyp_class (map_loc sub lid, List.map (sub.typ sub) list)
+    | Ttyp_alias (ct, s) ->
+        Ptyp_alias (sub.typ sub ct, s)
+    | Ttyp_variant (list, bool, labels) ->
+        Ptyp_variant (List.map (sub.row_field sub) list, bool, labels)
+    | Ttyp_poly (list, ct) ->
+        let list = List.map (fun v -> mkloc v loc) list in
+        Ptyp_poly (list, sub.typ sub ct)
+    | Ttyp_package pack -> Ptyp_package (sub.package_type sub pack)
+  in
+  Typ.mk ~loc ~attrs desc
+
+let class_structure sub cs =
+  let rec remove_self = function
+    | { pat_desc = Tpat_alias (p, id, _s) }
+      when string_is_prefix "selfpat-" (Ident.name id) ->
+        remove_self p
+    | p -> p
+  in
+  { pcstr_self = sub.pat sub (remove_self cs.cstr_self);
+    pcstr_fields = List.map (sub.class_field sub) cs.cstr_fields;
+  }
+
+let row_field sub {rf_loc; rf_desc; rf_attributes;} =
+  let loc = sub.location sub rf_loc in
+  let attrs = sub.attributes sub rf_attributes in
+  let desc = match rf_desc with
+    | Ttag (label, bool, list) ->
+        Rtag (label, bool, List.map (sub.typ sub) list)
+    | Tinherit ct -> Rinherit (sub.typ sub ct)
+  in
+  Rf.mk ~loc ~attrs desc
+
+let object_field sub {of_loc; of_desc; of_attributes;} =
+  let loc = sub.location sub of_loc in
+  let attrs = sub.attributes sub of_attributes in
+  let desc = match of_desc with
+    | OTtag (label, ct) ->
+        Otag (label, sub.typ sub ct)
+    | OTinherit ct -> Oinherit (sub.typ sub ct)
+  in
+  Of.mk ~loc ~attrs desc
+
+and is_self_pat = function
+  | { pat_desc = Tpat_alias(_pat, id, _) } ->
+      string_is_prefix "self-" (Ident.name id)
+  | _ -> false
+
+let class_field sub cf =
+  let loc = sub.location sub cf.cf_loc in
+  let attrs = sub.attributes sub cf.cf_attributes in
+  let desc = match cf.cf_desc with
+      Tcf_inherit (ovf, cl, super, _vals, _meths) ->
+        Pcf_inherit (ovf, sub.class_expr sub cl,
+                     Option.map (fun v -> mkloc v loc) super)
+    | Tcf_constraint (cty, cty') ->
+        Pcf_constraint (sub.typ sub cty, sub.typ sub cty')
+    | Tcf_val (lab, mut, _, Tcfk_virtual cty, _) ->
+        Pcf_val (lab, mut, Cfk_virtual (sub.typ sub cty))
+    | Tcf_val (lab, mut, _, Tcfk_concrete (o, exp), _) ->
+        Pcf_val (lab, mut, Cfk_concrete (o, sub.expr sub exp))
+    | Tcf_method (lab, priv, Tcfk_virtual cty) ->
+        Pcf_method (lab, priv, Cfk_virtual (sub.typ sub cty))
+    | Tcf_method (lab, priv, Tcfk_concrete (o, exp)) ->
+        let remove_fun_self = function
+          | { exp_desc =
+              Texp_function { arg_label = Nolabel; cases = [case]; _ } }
+            when is_self_pat case.c_lhs && case.c_guard = None -> case.c_rhs
+          | e -> e
+        in
+        let exp = remove_fun_self exp in
+        Pcf_method (lab, priv, Cfk_concrete (o, sub.expr sub exp))
+    | Tcf_initializer exp ->
+        let remove_fun_self = function
+          | { exp_desc =
+              Texp_function { arg_label = Nolabel; cases = [case]; _ } }
+            when is_self_pat case.c_lhs && case.c_guard = None -> case.c_rhs
+          | e -> e
+        in
+        let exp = remove_fun_self exp in
+        Pcf_initializer (sub.expr sub exp)
+    | Tcf_attribute x -> Pcf_attribute x
+  in
+  Cf.mk ~loc ~attrs desc
+
+let location _sub l = l
+
+let default_mapper =
+  {
+    attribute = attribute;
+    attributes = attributes;
+    binding_op = binding_op;
+    structure = structure;
+    structure_item = structure_item;
+    module_expr = module_expr;
+    signature = signature;
+    signature_item = signature_item;
+    module_type = module_type;
+    with_constraint = with_constraint;
+    class_declaration = class_declaration;
+    class_expr = class_expr;
+    class_field = class_field;
+    class_structure = class_structure;
+    class_type = class_type;
+    class_type_field = class_type_field;
+    class_signature = class_signature;
+    class_type_declaration = class_type_declaration;
+    class_description = class_description;
+    type_declaration = type_declaration;
+    type_kind = type_kind;
+    typ = core_type;
+    type_extension = type_extension;
+    type_exception = type_exception;
+    extension_constructor = extension_constructor;
+    value_description = value_description;
+    pat = pattern;
+    expr = expression;
+    module_declaration = module_declaration;
+    module_substitution = module_substitution;
+    module_type_declaration = module_type_declaration;
+    module_binding = module_binding;
+    package_type = package_type ;
+    open_declaration = open_declaration;
+    open_description = open_description;
+    include_description = include_description;
+    include_declaration = include_declaration;
+    value_binding = value_binding;
+    constructor_declaration = constructor_declaration;
+    label_declaration = label_declaration;
+    case = case;
+    location = location;
+    row_field = row_field ;
+    object_field = object_field ;
+  }
+
+let untype_structure ?(mapper=default_mapper) structure =
+  mapper.structure mapper structure
+
+let untype_signature ?(mapper=default_mapper) signature =
+  mapper.signature mapper signature
diff --git a/typing/untypeast.mli b/typing/untypeast.mli
new file mode 100644
index 00000000..d8a01519
--- /dev/null
+++ b/typing/untypeast.mli
@@ -0,0 +1,85 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*      Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay)   *)
+(*                                                                        *)
+(*   Copyright 2007 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Parsetree
+
+val lident_of_path : Path.t -> Longident.t
+
+type mapper = {
+  attribute: mapper -> Typedtree.attribute -> attribute;
+  attributes: mapper -> Typedtree.attribute list -> attribute list;
+  binding_op:
+    mapper ->
+    Typedtree.binding_op -> Typedtree.pattern -> binding_op;
+  case: 'k . mapper -> 'k Typedtree.case -> case;
+  class_declaration: mapper -> Typedtree.class_declaration -> class_declaration;
+  class_description: mapper -> Typedtree.class_description -> class_description;
+  class_expr: mapper -> Typedtree.class_expr -> class_expr;
+  class_field: mapper -> Typedtree.class_field -> class_field;
+  class_signature: mapper -> Typedtree.class_signature -> class_signature;
+  class_structure: mapper -> Typedtree.class_structure -> class_structure;
+  class_type: mapper -> Typedtree.class_type -> class_type;
+  class_type_declaration: mapper -> Typedtree.class_type_declaration
+                          -> class_type_declaration;
+  class_type_field: mapper -> Typedtree.class_type_field -> class_type_field;
+  constructor_declaration: mapper -> Typedtree.constructor_declaration
+                           -> constructor_declaration;
+  expr: mapper -> Typedtree.expression -> expression;
+  extension_constructor: mapper -> Typedtree.extension_constructor
+                         -> extension_constructor;
+  include_declaration:
+    mapper -> Typedtree.include_declaration -> include_declaration;
+  include_description:
+    mapper -> Typedtree.include_description -> include_description;
+  label_declaration:
+    mapper -> Typedtree.label_declaration -> label_declaration;
+  location: mapper -> Location.t -> Location.t;
+  module_binding: mapper -> Typedtree.module_binding -> module_binding;
+  module_declaration:
+    mapper -> Typedtree.module_declaration -> module_declaration;
+  module_substitution:
+    mapper -> Typedtree.module_substitution -> module_substitution;
+  module_expr: mapper -> Typedtree.module_expr -> module_expr;
+  module_type: mapper -> Typedtree.module_type -> module_type;
+  module_type_declaration:
+    mapper -> Typedtree.module_type_declaration -> module_type_declaration;
+  package_type: mapper -> Typedtree.package_type -> package_type;
+  open_declaration: mapper -> Typedtree.open_declaration -> open_declaration;
+  open_description: mapper -> Typedtree.open_description -> open_description;
+  pat: 'k . mapper -> 'k Typedtree.general_pattern -> pattern;
+  row_field: mapper -> Typedtree.row_field -> row_field;
+  object_field: mapper -> Typedtree.object_field -> object_field;
+  signature: mapper -> Typedtree.signature -> signature;
+  signature_item: mapper -> Typedtree.signature_item -> signature_item;
+  structure: mapper -> Typedtree.structure -> structure;
+  structure_item: mapper -> Typedtree.structure_item -> structure_item;
+  typ: mapper -> Typedtree.core_type -> core_type;
+  type_declaration: mapper -> Typedtree.type_declaration -> type_declaration;
+  type_extension: mapper -> Typedtree.type_extension -> type_extension;
+  type_exception: mapper -> Typedtree.type_exception -> type_exception;
+  type_kind: mapper -> Typedtree.type_kind -> type_kind;
+  value_binding: mapper -> Typedtree.value_binding -> value_binding;
+  value_description: mapper -> Typedtree.value_description -> value_description;
+  with_constraint:
+    mapper -> (Path.t * Longident.t Location.loc * Typedtree.with_constraint)
+    -> with_constraint;
+}
+
+val default_mapper : mapper
+
+val untype_structure : ?mapper:mapper -> Typedtree.structure -> structure
+val untype_signature : ?mapper:mapper -> Typedtree.signature -> signature
+
+val constant : Asttypes.constant -> Parsetree.constant
diff --git a/utils/HACKING.adoc b/utils/HACKING.adoc
new file mode 100644
index 00000000..5ae1a0f5
--- /dev/null
+++ b/utils/HACKING.adoc
@@ -0,0 +1,50 @@
+== Magic numbers
+
+The magic numbers in `config.mlp` are included in the header of
+compiled files produced by the OCaml compiler. Different kind of files
+(cmi, cmo, cmx, cma, executables, etc.) get different magic numbers,
+and we also change the magic number whenever we change the format of
+the corresponding file.
+
+Note that the `exec_magic_number` value is duplicated as `EXEC_MAGIC`
+in `runtime/caml/exec.h` and they must be kept in sync.
+
+This lets the compiler differentiate files that should be valid files
+of the kind it expects, and files that are passed by mistake, either
+that are not at all valid compiled files, or because they come from
+a different compiler version with an incompatible file format.
+
+We say that we "bump" a magic number when we update its version part
+in config.mlp. To bump all magic numbers is to increment the version
+of every kind of magic number.
+
+=== Updating magic numbers
+
+Previously people tried to update magic numbers as infrequently as
+possible, to maximize the lifetime of tools supporting only a fixed
+version of magic numbers -- so that they would work for as long as the
+underlying representation is compatible.
+
+However, it is more dangerous to forget to update a number than to
+update it too often. If we update too often, at worst tool authors have
+to update their codebase to support more numbers. If we don't update
+often enough, tools break with horrible parsing/deserialization errors
+and their authors can do nothing to prevent it.
+
+We have thus decided to systematically bump all magic numbers on each
+new major release of the compiler. (We don't want to change compiled
+file formats in minor releases, so we shouldn't need to bump magic
+numbers systematically. If a format change was necessary for
+a critical bugfix, then we would still need to bump on a minor
+release.)
+
+This should preferably be done just before the first testing release
+(the first beta, or the first rc if there is no beta) of the new major
+release. We want it to happen after all format-breaking changes have
+been included in the development version, but before the version gets
+tested on a large scale: this is when tool authors may update their
+tools to test the new release, and if you update *after* that you risk
+breaking them again without them noticing.
+
+For example, the magic numbers for 4.10 were updated in
+  6423e5c9d11cfac1c07208aec9f761f37c1640f0
diff --git a/utils/Makefile b/utils/Makefile
new file mode 100644
index 00000000..6b7febe4
--- /dev/null
+++ b/utils/Makefile
@@ -0,0 +1,143 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# The Makefile for generating the configuration file
+
+ROOTDIR = ..
+
+include $(ROOTDIR)/Makefile.config
+
+ifeq "$(UNIX_OR_WIN32)" "win32"
+ifeq "$(wildcard $(ROOTDIR)/flexdll/Makefile)" ""
+  FLEXDLL_DIR =
+else
+  FLEXDLL_DIR = $(if $(wildcard $(ROOTDIR)/flexdll/flexdll_*.$(O)),+flexdll)
+endif
+else
+  FLEXDLL_DIR =
+endif
+
+FLEXLINK_FLAGS ?=
+
+# Escape special characters in the argument string.
+# There are four characters that need escaping:
+# - backslash and ampersand, which are special in the replacement text
+#   of sed's "s" command
+# - exclamation mark, which is the delimiter we use for sed's "s" command
+# - single quote, which interferes with shell quoting.  We are inside
+#   single quotes already, so the proper escape is '\''
+#   (close single quotation, insert single quote character,
+#    reopen single quotation).
+SED_ESCAPE=$(subst ','\'',$(subst !,\!,$(subst &,\&,$(subst \,\\,$1))))
+
+# Escape special characters in an OCaml string literal "..."
+# There are two: backslash and double quote.
+OCAML_ESCAPE=$(subst ",\",$(subst \,\\,$1))
+
+# SUBST generates the sed substitution for the variable *named* in $1
+SUBST=-e 's!%%$1%%!$(call SED_ESCAPE,$($1))!'
+
+# SUBST_STRING does the same, for a variable that occurs between "..."
+# in config.mlp.  Thus, backslashes and double quotes must be escaped.
+SUBST_STRING=-e 's!%%$1%%!$(call SED_ESCAPE,$(call OCAML_ESCAPE,$($1)))!'
+
+# SUBST_QUOTE does the same, adding OCaml quotes around non-empty strings
+#   (see FLEXDLL_DIR which must empty if FLEXDLL_DIR is empty but an OCaml
+#    string otherwise)
+SUBST_QUOTE2=\
+  -e 's!%%$1%%!$(if $2,$(call SED_ESCAPE,"$(call OCAML_ESCAPE,$2)"))!'
+SUBST_QUOTE=$(call SUBST_QUOTE2,$1,$($1))
+
+FLEXLINK_LDFLAGS=$(if $(OC_LDFLAGS), -link "$(OC_LDFLAGS)")
+
+config.ml: config.mlp $(ROOTDIR)/Makefile.config Makefile
+	sed $(call SUBST,AFL_INSTRUMENT) \
+	    $(call SUBST,ARCH) \
+	    $(call SUBST_STRING,ARCMD) \
+	    $(call SUBST_STRING,ASM) \
+	    $(call SUBST,ASM_CFI_SUPPORTED) \
+	    $(call SUBST_STRING,BYTECCLIBS) \
+	    $(call SUBST_STRING,CC) \
+	    $(call SUBST_STRING,CCOMPTYPE) \
+	    $(call SUBST_STRING,OUTPUTOBJ) \
+	    $(call SUBST_STRING,EXT_ASM) \
+	    $(call SUBST_STRING,EXT_DLL) \
+	    $(call SUBST_STRING,EXE) \
+	    $(call SUBST_STRING,EXT_LIB) \
+	    $(call SUBST_STRING,EXT_OBJ) \
+	    $(call SUBST,FLAMBDA) \
+	    $(call SUBST,WITH_FLAMBDA_INVARIANTS) \
+	    $(call SUBST_STRING,FLEXLINK_FLAGS) \
+	    $(call SUBST_QUOTE,FLEXDLL_DIR) \
+	    $(call SUBST,HOST) \
+	    $(call SUBST_STRING,LIBDIR) \
+	    $(call SUBST,LIBUNWIND_AVAILABLE) \
+	    $(call SUBST,LIBUNWIND_LINK_FLAGS) \
+	    $(call SUBST_STRING,MKDLL) \
+	    $(call SUBST_STRING,MKEXE) \
+	    $(call SUBST_STRING,FLEXLINK_LDFLAGS) \
+	    $(call SUBST_STRING,MKMAINDLL) \
+	    $(call SUBST,MODEL) \
+	    $(call SUBST_STRING,NATIVECCLIBS) \
+	    $(call SUBST_STRING,OCAMLC_CFLAGS) \
+	    $(call SUBST_STRING,OCAMLC_CPPFLAGS) \
+	    $(call SUBST_STRING,OCAMLOPT_CFLAGS) \
+	    $(call SUBST_STRING,OCAMLOPT_CPPFLAGS) \
+	    $(call SUBST_STRING,PACKLD) \
+	    $(call SUBST,PROFINFO_WIDTH) \
+	    $(call SUBST_STRING,RANLIBCMD) \
+	    $(call SUBST,FORCE_SAFE_STRING) \
+	    $(call SUBST,DEFAULT_SAFE_STRING) \
+	    $(call SUBST,WINDOWS_UNICODE) \
+	    $(call SUBST,SUPPORTS_SHARED_LIBRARIES) \
+	    $(call SUBST,SYSTEM) \
+	    $(call SUBST,SYSTHREAD_SUPPORT) \
+	    $(call SUBST,TARGET) \
+	    $(call SUBST,WITH_FRAME_POINTERS) \
+	    $(call SUBST,WITH_PROFINFO) \
+	    $(call SUBST,WITH_SPACETIME) \
+	    $(call SUBST,ENABLE_CALL_COUNTS) \
+	    $(call SUBST,FLAT_FLOAT_ARRAY) \
+	    $(call SUBST,FUNCTION_SECTIONS) \
+	    $(call SUBST,CC_HAS_DEBUG_PREFIX_MAP) \
+	    $(call SUBST,AS_HAS_DEBUG_PREFIX_MAP) \
+	    $< > $@
+
+# Test for the substitution functions above
+
+ALLCHARS= \
+  !"\#\$\%&'()*+,-./ \
+  0123456789:;<=>? \
+  @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_ \
+  `abcdefghijklmnopqrstuvwxyz{|}~
+
+TMPFILE=testdata.tmp
+TMPSCRIPT=ocamlscript.tmp
+
+test-subst:
+	$(file >$(TMPFILE),$(ALLCHARS))
+	echo '%%ALLCHARS%%' | sed $(call SUBST,ALLCHARS) | cmp $(TMPFILE) -
+	@rm $(TMPFILE)
+	@echo "Test passed"
+
+# This test assumes there is a working OCaml in the path
+
+test-subst-string:
+	$(file >$(TMPFILE),$(ALLCHARS))
+	echo 'print_string "%%ALLCHARS%%"; print_newline();;' \
+        | sed $(call SUBST_STRING,ALLCHARS) > $(TMPSCRIPT) && \
+        ocaml $(TMPSCRIPT) | cmp $(TMPFILE) -
+	@rm $(TMPFILE) $(TMPSCRIPT)
+	@echo "Test passed"
diff --git a/utils/arg_helper.ml b/utils/arg_helper.ml
new file mode 100644
index 00000000..fa80007a
--- /dev/null
+++ b/utils/arg_helper.ml
@@ -0,0 +1,127 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2015--2016 OCamlPro SAS                                    *)
+(*   Copyright 2015--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let fatal err =
+  prerr_endline err;
+  exit 2
+
+module Make (S : sig
+  module Key : sig
+    type t
+    val of_string : string -> t
+    module Map : Map.S with type key = t
+  end
+
+  module Value : sig
+    type t
+    val of_string : string -> t
+  end
+end) = struct
+  type parsed = {
+    base_default : S.Value.t;
+    base_override : S.Value.t S.Key.Map.t;
+    user_default : S.Value.t option;
+    user_override : S.Value.t S.Key.Map.t;
+  }
+
+  let default v =
+    { base_default = v;
+      base_override = S.Key.Map.empty;
+      user_default = None;
+      user_override = S.Key.Map.empty; }
+
+  let set_base_default value t =
+    { t with base_default = value }
+
+  let add_base_override key value t =
+    { t with base_override = S.Key.Map.add key value t.base_override }
+
+  let reset_base_overrides t =
+    { t with base_override = S.Key.Map.empty }
+
+  let set_user_default value t =
+    { t with user_default = Some value }
+
+  let add_user_override key value t =
+    { t with user_override = S.Key.Map.add key value t.user_override }
+
+  exception Parse_failure of exn
+
+  let parse_exn str ~update =
+    (* Is the removal of empty chunks really relevant here? *)
+    (* (It has been added to mimic the old Misc.String.split.) *)
+    let values = String.split_on_char ',' str |> List.filter ((<>) "") in
+    let parsed =
+      List.fold_left (fun acc value ->
+          match String.index value '=' with
+          | exception Not_found ->
+            begin match S.Value.of_string value with
+            | value -> set_user_default value acc
+            | exception exn -> raise (Parse_failure exn)
+            end
+          | equals ->
+            let key_value_pair = value in
+            let length = String.length key_value_pair in
+            assert (equals >= 0 && equals < length);
+            if equals = 0 then begin
+              raise (Parse_failure (
+                Failure "Missing key in argument specification"))
+            end;
+            let key =
+              let key = String.sub key_value_pair 0 equals in
+              try S.Key.of_string key
+              with exn -> raise (Parse_failure exn)
+            in
+            let value =
+              let value =
+                String.sub key_value_pair (equals + 1) (length - equals - 1)
+              in
+              try S.Value.of_string value
+              with exn -> raise (Parse_failure exn)
+            in
+            add_user_override key value acc)
+        !update
+        values
+    in
+    update := parsed
+
+  let parse str help_text update =
+    match parse_exn str ~update with
+    | () -> ()
+    | exception (Parse_failure exn) ->
+      fatal (Printf.sprintf "%s: %s" (Printexc.to_string exn) help_text)
+
+  type parse_result =
+    | Ok
+    | Parse_failed of exn
+
+  let parse_no_error str update =
+    match parse_exn str ~update with
+    | () -> Ok
+    | exception (Parse_failure exn) -> Parse_failed exn
+
+  let get ~key parsed =
+    match S.Key.Map.find key parsed.user_override with
+    | value -> value
+    | exception Not_found ->
+      match parsed.user_default with
+      | Some value -> value
+      | None ->
+        match S.Key.Map.find key parsed.base_override with
+        | value -> value
+        | exception Not_found -> parsed.base_default
+
+end
diff --git a/utils/arg_helper.mli b/utils/arg_helper.mli
new file mode 100644
index 00000000..18f60fea
--- /dev/null
+++ b/utils/arg_helper.mli
@@ -0,0 +1,68 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2015--2016 OCamlPro SAS                                    *)
+(*   Copyright 2015--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Decipher command line arguments of the form
+         | =[,...]
+
+    (as used for example for the specification of inlining parameters
+    varying by simplification round).
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+module Make (S : sig
+  module Key : sig
+    type t
+
+    (** The textual representation of a key must not contain '=' or ','. *)
+    val of_string : string -> t
+
+    module Map : Map.S with type key = t
+  end
+
+  module Value : sig
+    type t
+
+    (** The textual representation of a value must not contain ','. *)
+    val of_string : string -> t
+  end
+end) : sig
+  type parsed
+
+  val default : S.Value.t -> parsed
+
+  val set_base_default : S.Value.t -> parsed -> parsed
+
+  val add_base_override : S.Key.t -> S.Value.t -> parsed -> parsed
+
+  val reset_base_overrides : parsed -> parsed
+
+  val set_user_default : S.Value.t -> parsed -> parsed
+
+  val add_user_override : S.Key.t -> S.Value.t -> parsed -> parsed
+
+  val parse : string -> string -> parsed ref -> unit
+
+  type parse_result =
+    | Ok
+    | Parse_failed of exn
+
+  val parse_no_error : string -> parsed ref -> parse_result
+
+  val get : key:S.Key.t -> parsed -> S.Value.t
+end
diff --git a/utils/build_path_prefix_map.ml b/utils/build_path_prefix_map.ml
new file mode 100644
index 00000000..c204d3a6
--- /dev/null
+++ b/utils/build_path_prefix_map.ml
@@ -0,0 +1,119 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*            Gabriel Scherer, projet Parsifal, INRIA Saclay              *)
+(*                                                                        *)
+(*   Copyright 2017 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 path = string
+type path_prefix = string
+type error_message = string
+
+let errorf fmt = Printf.kprintf (fun err -> Error err) fmt
+
+let encode_prefix str =
+  let buf = Buffer.create (String.length str) in
+  let push_char = function
+    | '%' -> Buffer.add_string buf "%#"
+    | '=' -> Buffer.add_string buf "%+"
+    | ':' -> Buffer.add_string buf "%."
+    | c -> Buffer.add_char buf c
+  in
+  String.iter push_char str;
+  Buffer.contents buf
+
+let decode_prefix str =
+  let buf = Buffer.create (String.length str) in
+  let rec loop i =
+    if i >= String.length str
+    then Ok (Buffer.contents buf)
+    else match str.[i] with
+      | ('=' | ':') as c ->
+        errorf "invalid character '%c' in key or value" c
+      | '%' ->
+        let push c = Buffer.add_char buf c; loop (i + 2) in
+        if i + 1 = String.length str then
+          errorf "invalid encoded string %S (trailing '%%')" str
+        else begin match str.[i + 1] with
+            | '#' -> push '%'
+            | '+' -> push '='
+            | '.' -> push ':'
+            | c -> errorf "invalid %%-escaped character '%c'" c
+        end
+      | c ->
+        Buffer.add_char buf c;
+        loop (i + 1)
+  in loop 0
+
+type pair = { target: path_prefix; source : path_prefix }
+
+let encode_pair { target; source } =
+  String.concat "=" [encode_prefix target; encode_prefix source]
+
+let decode_pair str =
+  match String.index str '=' with
+  | exception Not_found ->
+    errorf "invalid key/value pair %S, no '=' separator" str
+  | equal_pos ->
+    let encoded_target = String.sub str 0 equal_pos in
+    let encoded_source =
+      String.sub str (equal_pos + 1) (String.length str - equal_pos - 1) in
+    match decode_prefix encoded_target, decode_prefix encoded_source with
+    | Ok target, Ok source -> Ok { target; source }
+    | ((Error _ as err), _) | (_, (Error _ as err)) -> err
+
+type map = pair option list
+
+let encode_map map =
+  let encode_elem = function
+    | None -> ""
+    | Some pair -> encode_pair pair
+  in
+  List.map encode_elem map
+  |> String.concat ":"
+
+let decode_map str =
+  let exception Shortcut of error_message in
+  let decode_or_empty = function
+    | "" -> None
+    | pair ->
+      begin match decode_pair pair with
+        | Ok str -> Some str
+        | Error err -> raise (Shortcut err)
+      end
+  in
+  let pairs = String.split_on_char ':' str in
+  match List.map decode_or_empty pairs with
+  | exception (Shortcut err) -> Error err
+  | map -> Ok map
+
+let rewrite_opt prefix_map path =
+  let is_prefix = function
+    | None -> false
+    | Some { target = _; source } ->
+      String.length source <= String.length path
+      && String.equal source (String.sub path 0 (String.length source))
+  in
+  match
+    List.find is_prefix
+      (* read key/value pairs from right to left, as the spec demands *)
+      (List.rev prefix_map)
+  with
+  | exception Not_found -> None
+  | None -> None
+  | Some { source; target } ->
+      Some (target ^ (String.sub path (String.length source)
+                       (String.length path - String.length source)))
+
+let rewrite prefix_map path =
+  match rewrite_opt prefix_map path with
+  | None -> path
+  | Some path -> path
diff --git a/utils/build_path_prefix_map.mli b/utils/build_path_prefix_map.mli
new file mode 100644
index 00000000..dbcc8dc1
--- /dev/null
+++ b/utils/build_path_prefix_map.mli
@@ -0,0 +1,47 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*            Gabriel Scherer, projet Parsifal, INRIA Saclay              *)
+(*                                                                        *)
+(*   Copyright 2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Rewrite paths for reproducible builds
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+
+type path = string
+type path_prefix = string
+type error_message = string
+
+val encode_prefix : path_prefix -> string
+val decode_prefix : string -> (path_prefix, error_message) result
+
+type pair = { target: path_prefix; source : path_prefix }
+
+val encode_pair : pair -> string
+val decode_pair : string -> (pair, error_message) result
+
+type map = pair option list
+
+val encode_map : map -> string
+val decode_map : string -> (map, error_message) result
+
+val rewrite_opt : map -> path -> path option
+(** [rewrite_opt map path] tries to find a source in [map]
+    that is a prefix of the input [path]. If it succeeds,
+    it replaces this prefix with the corresponding target.
+    If it fails, it just returns [None]. *)
+
+val rewrite : map -> path -> path
diff --git a/utils/ccomp.ml b/utils/ccomp.ml
new file mode 100644
index 00000000..2de6bb16
--- /dev/null
+++ b/utils/ccomp.ml
@@ -0,0 +1,226 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Compiling C files and building C libraries *)
+
+let command cmdline =
+  if !Clflags.verbose then begin
+    prerr_string "+ ";
+    prerr_string cmdline;
+    prerr_newline()
+  end;
+  let res = Sys.command cmdline in
+  if res = 127 then raise (Sys_error cmdline);
+  res
+
+let run_command cmdline = ignore(command cmdline)
+
+(* Build @responsefile to work around OS limitations on
+   command-line length.
+   Under Windows, the max length is 8187 minus the length of the
+   COMSPEC variable (or 7 if it's not set).  To be on the safe side,
+   we'll use a response file if we need to pass 4096 or more bytes of
+   arguments.
+   For Unix-like systems, the threshold is 2^16 (64 KiB), which is
+   within the lowest observed limits (2^17 per argument under Linux;
+   between 70000 and 80000 for macOS).
+*)
+
+let build_diversion lst =
+  let (responsefile, oc) = Filename.open_temp_file "camlresp" "" in
+  List.iter (fun f -> Printf.fprintf oc "%s\n" f) lst;
+  close_out oc;
+  at_exit (fun () -> Misc.remove_file responsefile);
+  "@" ^ responsefile
+
+let quote_files lst =
+  let lst = List.filter (fun f -> f <> "") lst in
+  let quoted = List.map Filename.quote lst in
+  let s = String.concat " " quoted in
+  if String.length s >= 65536
+  || (String.length s >= 4096 && Sys.os_type = "Win32")
+  then build_diversion quoted
+  else s
+
+let quote_prefixed pr lst =
+  let lst = List.filter (fun f -> f <> "") lst in
+  let lst = List.map (fun f -> pr ^ f) lst in
+  quote_files lst
+
+let quote_optfile = function
+  | None -> ""
+  | Some f -> Filename.quote f
+
+let display_msvc_output file name =
+  let c = open_in file in
+  try
+    let first = input_line c in
+    if first <> Filename.basename name then
+      print_endline first;
+    while true do
+      print_endline (input_line c)
+    done
+  with _ ->
+    close_in c;
+    Sys.remove file
+
+let compile_file ?output ?(opt="") ?stable_name name =
+  let (pipe, file) =
+    if Config.ccomp_type = "msvc" && not !Clflags.verbose then
+      try
+        let (t, c) = Filename.open_temp_file "msvc" "stdout" in
+        close_out c;
+        (Printf.sprintf " > %s" (Filename.quote t), t)
+      with _ ->
+        ("", "")
+    else
+      ("", "") in
+  let debug_prefix_map =
+    match stable_name with
+    | Some stable when Config.c_has_debug_prefix_map ->
+      Printf.sprintf " -fdebug-prefix-map=%s=%s" name stable
+    | Some _ | None -> "" in
+  let exit =
+    command
+      (Printf.sprintf
+         "%s%s %s %s -c %s %s %s %s %s%s"
+         (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]))
+         debug_prefix_map
+         (match output with
+          | None -> ""
+          | Some o -> Printf.sprintf "%s%s" Config.c_output_obj o)
+         opt
+         (if !Clflags.debug && Config.ccomp_type <> "msvc" then "-g" else "")
+         (String.concat " " (List.rev !Clflags.all_ccopts))
+         (quote_prefixed "-I"
+            (List.map (Misc.expand_directory Config.standard_library)
+               (List.rev !Clflags.include_dirs)))
+         (Clflags.std_include_flag "-I")
+         (Filename.quote name)
+         (* cl tediously includes the name of the C file as the first thing it
+            outputs (in fairness, the tedious thing is that there's no switch to
+            disable this behaviour). In the absence of the Unix module, use
+            a temporary file to filter the output (cannot pipe the output to a
+            filter because this removes the exit status of cl, which is wanted.
+          *)
+         pipe) in
+  if pipe <> ""
+  then display_msvc_output file name;
+  exit
+
+let macos_create_empty_archive ~quoted_archive =
+  let result =
+    command (Printf.sprintf "%s rc %s /dev/null" Config.ar quoted_archive)
+  in
+  if result <> 0 then result
+  else
+    let result =
+      command (Printf.sprintf "%s %s 2> /dev/null" Config.ranlib quoted_archive)
+    in
+    if result <> 0 then result
+    else
+      command (Printf.sprintf "%s d %s /dev/null" Config.ar quoted_archive)
+
+let create_archive archive file_list =
+  Misc.remove_file archive;
+  let quoted_archive = Filename.quote archive in
+  match Config.ccomp_type with
+    "msvc" ->
+      command(Printf.sprintf "link /lib /nologo /out:%s %s"
+                             quoted_archive (quote_files file_list))
+  | _ ->
+      assert(String.length Config.ar > 0);
+      let is_macosx =
+        match Config.system with
+        | "macosx" -> true
+        | _ -> false
+      in
+      if is_macosx && file_list = [] then  (* PR#6550 *)
+        macos_create_empty_archive ~quoted_archive
+      else
+        let r1 =
+          command(Printf.sprintf "%s rc %s %s"
+                  Config.ar quoted_archive (quote_files file_list)) in
+        if r1 <> 0 || String.length Config.ranlib = 0
+        then r1
+        else command(Config.ranlib ^ " " ^ quoted_archive)
+
+let expand_libname name =
+  if String.length name < 2 || String.sub name 0 2 <> "-l"
+  then name
+  else begin
+    let libname =
+      "lib" ^ String.sub name 2 (String.length name - 2) ^ Config.ext_lib in
+    try
+      Load_path.find libname
+    with Not_found ->
+      libname
+  end
+
+type link_mode =
+  | Exe
+  | Dll
+  | MainDll
+  | Partial
+
+let remove_Wl cclibs =
+  cclibs |> List.map (fun cclib ->
+    (* -Wl,-foo,bar -> -foo bar *)
+    if String.length cclib >= 4 && "-Wl," = String.sub cclib 0 4 then
+      String.map (function ',' -> ' ' | c -> c)
+                 (String.sub cclib 4 (String.length cclib - 4))
+    else cclib)
+
+let call_linker mode output_name files extra =
+  Profile.record_call "c-linker" (fun () ->
+    let cmd =
+      if mode = Partial then
+        let l_prefix =
+          match Config.ccomp_type with
+          | "msvc" -> "/libpath:"
+          | _ -> "-L"
+        in
+        Printf.sprintf "%s%s %s %s %s"
+          Config.native_pack_linker
+          (Filename.quote output_name)
+          (quote_prefixed l_prefix (Load_path.get_paths ()))
+          (quote_files (remove_Wl files))
+          extra
+      else
+        Printf.sprintf "%s -o %s %s %s %s %s %s"
+          (match !Clflags.c_compiler, mode with
+          | Some cc, _ -> cc
+          | None, Exe -> Config.mkexe
+          | None, Dll -> Config.mkdll
+          | None, MainDll -> Config.mkmaindll
+          | None, Partial -> assert false
+          )
+          (Filename.quote output_name)
+          ""  (*(Clflags.std_include_flag "-I")*)
+          (quote_prefixed "-L" (Load_path.get_paths ()))
+          (String.concat " " (List.rev !Clflags.all_ccopts))
+          (quote_files files)
+          extra
+    in
+    command cmd
+  )
diff --git a/utils/ccomp.mli b/utils/ccomp.mli
new file mode 100644
index 00000000..89724252
--- /dev/null
+++ b/utils/ccomp.mli
@@ -0,0 +1,39 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Compiling C files and building C libraries
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+val command: string -> int
+val run_command: string -> unit
+val compile_file:
+  ?output:string -> ?opt:string -> ?stable_name:string -> string -> int
+val create_archive: string -> string list -> int
+val expand_libname: string -> string
+val quote_files: string list -> string
+val quote_optfile: string option -> string
+(*val make_link_options: string list -> string*)
+
+type link_mode =
+  | Exe
+  | Dll
+  | MainDll
+  | Partial
+
+val call_linker: link_mode -> string -> string list -> string -> int
diff --git a/utils/clflags.ml b/utils/clflags.ml
new file mode 100644
index 00000000..4035c28c
--- /dev/null
+++ b/utils/clflags.ml
@@ -0,0 +1,504 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Command-line parameters *)
+
+module Int_arg_helper = Arg_helper.Make (struct
+  module Key = struct
+    include Numbers.Int
+    let of_string = int_of_string
+  end
+
+  module Value = struct
+    include Numbers.Int
+    let of_string = int_of_string
+  end
+end)
+module Float_arg_helper = Arg_helper.Make (struct
+  module Key = struct
+    include Numbers.Int
+    let of_string = int_of_string
+  end
+
+  module Value = struct
+    include Numbers.Float
+    let of_string = float_of_string
+  end
+end)
+
+let objfiles = ref ([] : string list)   (* .cmo and .cma files *)
+and ccobjs = ref ([] : string list)     (* .o, .a, .so and -cclib -lxxx *)
+and dllibs = ref ([] : string list)     (* .so and -dllib -lxxx *)
+
+let compile_only = ref false            (* -c *)
+and output_name = ref (None : string option) (* -o *)
+and include_dirs = ref ([] : string list)(* -I *)
+and no_std_include = ref false          (* -nostdlib *)
+and print_types = ref false             (* -i *)
+and make_archive = ref false            (* -a *)
+and debug = ref false                   (* -g *)
+and debug_full = ref false              (* For full DWARF support *)
+and unsafe = ref false                  (* -unsafe *)
+and use_linscan = ref false             (* -linscan *)
+and link_everything = ref false         (* -linkall *)
+and custom_runtime = ref false          (* -custom *)
+and no_check_prims = ref false          (* -no-check-prims *)
+and bytecode_compatible_32 = ref false  (* -compat-32 *)
+and output_c_object = ref false         (* -output-obj *)
+and output_complete_object = ref false  (* -output-complete-obj *)
+and output_complete_executable = ref false  (* -output-complete-exe *)
+and all_ccopts = ref ([] : string list)     (* -ccopt *)
+and classic = ref false                 (* -nolabels *)
+and nopervasives = ref false            (* -nopervasives *)
+and match_context_rows = ref 32         (* -match-context-rows *)
+and preprocessor = ref(None : string option) (* -pp *)
+and all_ppx = ref ([] : string list)        (* -ppx *)
+let absname = ref false                 (* -absname *)
+let annotations = ref false             (* -annot *)
+let binary_annotations = ref false      (* -annot *)
+and use_threads = ref false             (* -thread *)
+and noassert = ref false                (* -noassert *)
+and verbose = ref false                 (* -verbose *)
+and noversion = ref false               (* -no-version *)
+and noprompt = ref false                (* -noprompt *)
+and nopromptcont = ref false            (* -nopromptcont *)
+and init_file = ref (None : string option)   (* -init *)
+and noinit = ref false                  (* -noinit *)
+and open_modules = ref []               (* -open *)
+and use_prims = ref ""                  (* -use-prims ... *)
+and use_runtime = ref ""                (* -use-runtime ... *)
+and plugin = ref false                  (* -plugin ... *)
+and principal = ref false               (* -principal *)
+and real_paths = ref true               (* -short-paths *)
+and recursive_types = ref false         (* -rectypes *)
+and strict_sequence = ref false         (* -strict-sequence *)
+and strict_formats = ref false          (* -strict-formats *)
+and applicative_functors = ref true     (* -no-app-funct *)
+and make_runtime = ref false            (* -make-runtime *)
+and c_compiler = ref (None: string option) (* -cc *)
+and no_auto_link = ref false            (* -noautolink *)
+and dllpaths = ref ([] : string list)   (* -dllpath *)
+and make_package = ref false            (* -pack *)
+and for_package = ref (None: string option) (* -for-pack *)
+and error_size = ref 500                (* -error-size *)
+and float_const_prop = ref true         (* -no-float-const-prop *)
+and transparent_modules = ref false     (* -trans-mod *)
+let unique_ids = ref true               (* -d(no-)unique-ds *)
+let locations = ref true                (* -d(no-)locations *)
+let dump_source = ref false             (* -dsource *)
+let dump_parsetree = ref false          (* -dparsetree *)
+and dump_typedtree = ref false          (* -dtypedtree *)
+and dump_rawlambda = ref false          (* -drawlambda *)
+and dump_lambda = ref false             (* -dlambda *)
+and dump_rawclambda = ref false         (* -drawclambda *)
+and dump_clambda = ref false            (* -dclambda *)
+and dump_rawflambda = ref false            (* -drawflambda *)
+and dump_flambda = ref false            (* -dflambda *)
+and dump_flambda_let = ref (None : int option) (* -dflambda-let=... *)
+and dump_flambda_verbose = ref false    (* -dflambda-verbose *)
+and dump_instr = ref false              (* -dinstr *)
+and keep_camlprimc_file = ref false     (* -dcamlprimc *)
+
+let keep_asm_file = ref false           (* -S *)
+let optimize_for_speed = ref true       (* -compact *)
+and opaque = ref false                  (* -opaque *)
+
+and dump_cmm = ref false                (* -dcmm *)
+let dump_selection = ref false          (* -dsel *)
+let dump_cse = ref false                (* -dcse *)
+let dump_live = ref false               (* -dlive *)
+let dump_avail = ref false              (* -davail *)
+let dump_spill = ref false              (* -dspill *)
+let dump_split = ref false              (* -dsplit *)
+let dump_interf = ref false             (* -dinterf *)
+let dump_prefer = ref false             (* -dprefer *)
+let dump_regalloc = ref false           (* -dalloc *)
+let dump_reload = ref false             (* -dreload *)
+let dump_scheduling = ref false         (* -dscheduling *)
+let dump_linear = ref false             (* -dlinear *)
+let dump_interval = ref false           (* -dinterval *)
+let keep_startup_file = ref false       (* -dstartup *)
+let dump_combine = ref false            (* -dcombine *)
+let profile_columns : Profile.column list ref = ref [] (* -dprofile/-dtimings *)
+
+let debug_runavail = ref false          (* -drunavail *)
+
+let native_code = ref false             (* set to true under ocamlopt *)
+
+let force_slash = ref false             (* for ocamldep *)
+let clambda_checks = ref false          (* -clambda-checks *)
+
+let flambda_invariant_checks =
+  ref Config.with_flambda_invariants    (* -flambda-(no-)invariants *)
+
+let dont_write_files = ref false        (* set to true under ocamldoc *)
+
+let insn_sched_default = true
+let insn_sched = ref insn_sched_default (* -[no-]insn-sched *)
+
+let std_include_flag prefix =
+  if !no_std_include then ""
+  else (prefix ^ (Filename.quote Config.standard_library))
+;;
+
+let std_include_dir () =
+  if !no_std_include then [] else [Config.standard_library]
+;;
+
+let shared = ref false (* -shared *)
+let dlcode = ref true (* not -nodynlink *)
+
+let pic_code = ref (match Config.architecture with (* -fPIC *)
+                     | "amd64" -> true
+                     | _       -> false)
+
+let runtime_variant = ref "";;      (* -runtime-variant *)
+let with_runtime = ref true;;         (* -with-runtime *)
+
+let keep_docs = ref false              (* -keep-docs *)
+let keep_locs = ref true               (* -keep-locs *)
+let unsafe_string =
+  if Config.safe_string then ref false
+  else ref (not Config.default_safe_string)
+                                   (* -safe-string / -unsafe-string *)
+
+let classic_inlining = ref false       (* -Oclassic *)
+let inlining_report = ref false    (* -inlining-report *)
+
+let afl_instrument = ref Config.afl_instrument (* -afl-instrument *)
+let afl_inst_ratio = ref 100           (* -afl-inst-ratio *)
+
+let function_sections = ref false      (* -function-sections *)
+
+let simplify_rounds = ref None        (* -rounds *)
+let default_simplify_rounds = ref 1        (* -rounds *)
+let rounds () =
+  match !simplify_rounds with
+  | None -> !default_simplify_rounds
+  | Some r -> r
+
+let default_inline_threshold = if Config.flambda then 10. else 10. /. 8.
+let inline_toplevel_multiplier = 16
+let default_inline_toplevel_threshold =
+  int_of_float ((float inline_toplevel_multiplier) *. default_inline_threshold)
+let default_inline_call_cost = 5
+let default_inline_alloc_cost = 7
+let default_inline_prim_cost = 3
+let default_inline_branch_cost = 5
+let default_inline_indirect_cost = 4
+let default_inline_branch_factor = 0.1
+let default_inline_lifting_benefit = 1300
+let default_inline_max_unroll = 0
+let default_inline_max_depth = 1
+
+let inline_threshold = ref (Float_arg_helper.default default_inline_threshold)
+let inline_toplevel_threshold =
+  ref (Int_arg_helper.default default_inline_toplevel_threshold)
+let inline_call_cost = ref (Int_arg_helper.default default_inline_call_cost)
+let inline_alloc_cost = ref (Int_arg_helper.default default_inline_alloc_cost)
+let inline_prim_cost = ref (Int_arg_helper.default default_inline_prim_cost)
+let inline_branch_cost =
+  ref (Int_arg_helper.default default_inline_branch_cost)
+let inline_indirect_cost =
+  ref (Int_arg_helper.default default_inline_indirect_cost)
+let inline_branch_factor =
+  ref (Float_arg_helper.default default_inline_branch_factor)
+let inline_lifting_benefit =
+  ref (Int_arg_helper.default default_inline_lifting_benefit)
+let inline_max_unroll =
+  ref (Int_arg_helper.default default_inline_max_unroll)
+let inline_max_depth =
+  ref (Int_arg_helper.default default_inline_max_depth)
+
+
+let unbox_specialised_args = ref true   (* -no-unbox-specialised-args *)
+let unbox_free_vars_of_closures = ref true
+let unbox_closures = ref false          (* -unbox-closures *)
+let default_unbox_closures_factor = 10
+let unbox_closures_factor =
+  ref default_unbox_closures_factor      (* -unbox-closures-factor *)
+let remove_unused_arguments = ref false (* -remove-unused-arguments *)
+
+type inlining_arguments = {
+  inline_call_cost : int option;
+  inline_alloc_cost : int option;
+  inline_prim_cost : int option;
+  inline_branch_cost : int option;
+  inline_indirect_cost : int option;
+  inline_lifting_benefit : int option;
+  inline_branch_factor : float option;
+  inline_max_depth : int option;
+  inline_max_unroll : int option;
+  inline_threshold : float option;
+  inline_toplevel_threshold : int option;
+}
+
+let set_int_arg round (arg:Int_arg_helper.parsed ref) default value =
+  let value : int =
+    match value with
+    | None -> default
+    | Some value -> value
+  in
+  match round with
+  | None ->
+    arg := Int_arg_helper.set_base_default value
+             (Int_arg_helper.reset_base_overrides !arg)
+  | Some round ->
+    arg := Int_arg_helper.add_base_override round value !arg
+
+let set_float_arg round (arg:Float_arg_helper.parsed ref) default value =
+  let value =
+    match value with
+    | None -> default
+    | Some value -> value
+  in
+  match round with
+  | None ->
+    arg := Float_arg_helper.set_base_default value
+             (Float_arg_helper.reset_base_overrides !arg)
+  | Some round ->
+    arg := Float_arg_helper.add_base_override round value !arg
+
+let use_inlining_arguments_set ?round (arg:inlining_arguments) =
+  let set_int = set_int_arg round in
+  let set_float = set_float_arg round in
+  set_int inline_call_cost default_inline_call_cost arg.inline_call_cost;
+  set_int inline_alloc_cost default_inline_alloc_cost arg.inline_alloc_cost;
+  set_int inline_prim_cost default_inline_prim_cost arg.inline_prim_cost;
+  set_int inline_branch_cost
+    default_inline_branch_cost arg.inline_branch_cost;
+  set_int inline_indirect_cost
+    default_inline_indirect_cost arg.inline_indirect_cost;
+  set_int inline_lifting_benefit
+    default_inline_lifting_benefit arg.inline_lifting_benefit;
+  set_float inline_branch_factor
+    default_inline_branch_factor arg.inline_branch_factor;
+  set_int inline_max_depth
+    default_inline_max_depth arg.inline_max_depth;
+  set_int inline_max_unroll
+    default_inline_max_unroll arg.inline_max_unroll;
+  set_float inline_threshold
+    default_inline_threshold arg.inline_threshold;
+  set_int inline_toplevel_threshold
+    default_inline_toplevel_threshold arg.inline_toplevel_threshold
+
+(* o1 is the default *)
+let o1_arguments = {
+  inline_call_cost = None;
+  inline_alloc_cost = None;
+  inline_prim_cost = None;
+  inline_branch_cost = None;
+  inline_indirect_cost = None;
+  inline_lifting_benefit = None;
+  inline_branch_factor = None;
+  inline_max_depth = None;
+  inline_max_unroll = None;
+  inline_threshold = None;
+  inline_toplevel_threshold = None;
+}
+
+let classic_arguments = {
+  inline_call_cost = None;
+  inline_alloc_cost = None;
+  inline_prim_cost = None;
+  inline_branch_cost = None;
+  inline_indirect_cost = None;
+  inline_lifting_benefit = None;
+  inline_branch_factor = None;
+  inline_max_depth = None;
+  inline_max_unroll = None;
+  (* [inline_threshold] matches the current compiler's default.
+     Note that this particular fraction can be expressed exactly in
+     floating point. *)
+  inline_threshold = Some (10. /. 8.);
+  (* [inline_toplevel_threshold] is not used in classic mode. *)
+  inline_toplevel_threshold = Some 1;
+}
+
+let o2_arguments = {
+  inline_call_cost = Some (2 * default_inline_call_cost);
+  inline_alloc_cost = Some (2 * default_inline_alloc_cost);
+  inline_prim_cost = Some (2 * default_inline_prim_cost);
+  inline_branch_cost = Some (2 * default_inline_branch_cost);
+  inline_indirect_cost = Some (2 * default_inline_indirect_cost);
+  inline_lifting_benefit = None;
+  inline_branch_factor = None;
+  inline_max_depth = Some 2;
+  inline_max_unroll = None;
+  inline_threshold = Some 25.;
+  inline_toplevel_threshold = Some (25 * inline_toplevel_multiplier);
+}
+
+let o3_arguments = {
+  inline_call_cost = Some (3 * default_inline_call_cost);
+  inline_alloc_cost = Some (3 * default_inline_alloc_cost);
+  inline_prim_cost = Some (3 * default_inline_prim_cost);
+  inline_branch_cost = Some (3 * default_inline_branch_cost);
+  inline_indirect_cost = Some (3 * default_inline_indirect_cost);
+  inline_lifting_benefit = None;
+  inline_branch_factor = Some 0.;
+  inline_max_depth = Some 3;
+  inline_max_unroll = Some 1;
+  inline_threshold = Some 50.;
+  inline_toplevel_threshold = Some (50 * inline_toplevel_multiplier);
+}
+
+let all_passes = ref []
+let dumped_passes_list = ref []
+let dumped_pass s =
+  assert(List.mem s !all_passes);
+  List.mem s !dumped_passes_list
+
+let set_dumped_pass s enabled =
+  if (List.mem s !all_passes) then begin
+    let passes_without_s = List.filter ((<>) s) !dumped_passes_list in
+    let dumped_passes =
+      if enabled then
+        s :: passes_without_s
+      else
+        passes_without_s
+    in
+    dumped_passes_list := dumped_passes
+  end
+
+let dump_into_file = ref false (* -dump-into-file *)
+
+type 'a env_reader = {
+  parse : string -> 'a option;
+  print : 'a -> string;
+  usage : string;
+  env_var : string;
+}
+
+let color = ref None (* -color *)
+
+let color_reader = {
+  parse = (function
+    | "auto" -> Some Misc.Color.Auto
+    | "always" -> Some Misc.Color.Always
+    | "never" -> Some Misc.Color.Never
+    | _ -> None);
+  print = (function
+    | Misc.Color.Auto -> "auto"
+    | Misc.Color.Always -> "always"
+    | Misc.Color.Never -> "never");
+  usage = "expected \"auto\", \"always\" or \"never\"";
+  env_var = "OCAML_COLOR";
+}
+
+let error_style = ref None (* -error-style *)
+
+let error_style_reader = {
+  parse = (function
+    | "contextual" -> Some Misc.Error_style.Contextual
+    | "short" -> Some Misc.Error_style.Short
+    | _ -> None);
+  print = (function
+    | Misc.Error_style.Contextual -> "contextual"
+    | Misc.Error_style.Short -> "short");
+  usage = "expected \"contextual\" or \"short\"";
+  env_var = "OCAML_ERROR_STYLE";
+}
+
+let unboxed_types = ref false
+
+(* This is used by the -stop-after option. *)
+module Compiler_pass = struct
+  (* If you add a new pass, the following must be updated:
+     - the variable `passes` below
+     - the manpages in man/ocaml{c,opt}.m
+     - the manual manual/manual/cmds/unified-options.etex
+  *)
+  type t = Parsing | Typing | Scheduling
+
+  let to_string = function
+    | Parsing -> "parsing"
+    | Typing -> "typing"
+    | Scheduling -> "scheduling"
+
+  let of_string = function
+    | "parsing" -> Some Parsing
+    | "typing" -> Some Typing
+    | "scheduling" -> Some Scheduling
+    | _ -> None
+
+  let rank = function
+    | Parsing -> 0
+    | Typing -> 1
+    | Scheduling -> 50
+
+  let passes = [
+    Parsing;
+    Typing;
+    Scheduling;
+  ]
+  let is_compilation_pass _ = true
+  let is_native_only = function
+    | Scheduling -> true
+    | _ -> false
+
+  let enabled is_native t = not (is_native_only t) || is_native
+
+  let available_pass_names ~native =
+    passes
+    |> List.filter (enabled native)
+    |> List.map to_string
+end
+
+let stop_after = ref None (* -stop-after *)
+
+let should_stop_after pass =
+  if Compiler_pass.(rank Typing <= rank pass) && !print_types then true
+  else
+    match !stop_after with
+    | None -> false
+    | Some stop -> Compiler_pass.rank stop <= Compiler_pass.rank pass
+
+module String = Misc.Stdlib.String
+
+let arg_spec = ref []
+let arg_names = ref String.Map.empty
+
+let reset_arguments () =
+  arg_spec := [];
+  arg_names := String.Map.empty
+
+let add_arguments loc args =
+  List.iter (function (arg_name, _, _) as arg ->
+    try
+      let loc2 = String.Map.find arg_name !arg_names in
+      Printf.eprintf
+        "Warning: compiler argument %s is already defined:\n" arg_name;
+      Printf.eprintf "   First definition: %s\n" loc2;
+      Printf.eprintf "   New definition: %s\n" loc;
+    with Not_found ->
+      arg_spec := !arg_spec @ [ arg ];
+      arg_names := String.Map.add arg_name loc !arg_names
+  ) args
+
+let print_arguments usage =
+  Arg.usage !arg_spec usage
+
+(* This function is almost the same as [Arg.parse_expand], except
+   that [Arg.parse_expand] could not be used because it does not take a
+   reference for [arg_spec].*)
+let parse_arguments f msg =
+  try
+    let argv = ref Sys.argv in
+    let current = ref (!Arg.current) in
+    Arg.parse_and_expand_argv_dynamic current argv arg_spec f msg
+  with
+  | Arg.Bad msg -> Printf.eprintf "%s" msg; exit 2
+  | Arg.Help msg -> Printf.printf "%s" msg; exit 0
diff --git a/utils/clflags.mli b/utils/clflags.mli
new file mode 100644
index 00000000..5be371a0
--- /dev/null
+++ b/utils/clflags.mli
@@ -0,0 +1,266 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2005 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Command line flags *)
+
+(** Optimization parameters represented as ints indexed by round number. *)
+module Int_arg_helper : sig
+  type parsed
+
+  val parse : string -> string -> parsed ref -> unit
+
+  type parse_result =
+    | Ok
+    | Parse_failed of exn
+  val parse_no_error : string -> parsed ref -> parse_result
+
+  val get : key:int -> parsed -> int
+end
+
+(** Optimization parameters represented as floats indexed by round number. *)
+module Float_arg_helper : sig
+  type parsed
+
+  val parse : string -> string -> parsed ref -> unit
+
+  type parse_result =
+    | Ok
+    | Parse_failed of exn
+  val parse_no_error : string -> parsed ref -> parse_result
+
+  val get : key:int -> parsed -> float
+end
+
+type inlining_arguments = {
+  inline_call_cost : int option;
+  inline_alloc_cost : int option;
+  inline_prim_cost : int option;
+  inline_branch_cost : int option;
+  inline_indirect_cost : int option;
+  inline_lifting_benefit : int option;
+  inline_branch_factor : float option;
+  inline_max_depth : int option;
+  inline_max_unroll : int option;
+  inline_threshold : float option;
+  inline_toplevel_threshold : int option;
+}
+
+val classic_arguments : inlining_arguments
+val o1_arguments : inlining_arguments
+val o2_arguments : inlining_arguments
+val o3_arguments : inlining_arguments
+
+(** Set all the inlining arguments for a round.
+    The default is set if no round is provided. *)
+val use_inlining_arguments_set : ?round:int -> inlining_arguments -> unit
+
+val objfiles : string list ref
+val ccobjs : string list ref
+val dllibs : string list ref
+val compile_only : bool ref
+val output_name : string option ref
+val include_dirs : string list ref
+val no_std_include : bool ref
+val print_types : bool ref
+val make_archive : bool ref
+val debug : bool ref
+val debug_full : bool ref
+val unsafe : bool ref
+val use_linscan : bool ref
+val link_everything : bool ref
+val custom_runtime : bool ref
+val no_check_prims : bool ref
+val bytecode_compatible_32 : bool ref
+val output_c_object : bool ref
+val output_complete_object : bool ref
+val output_complete_executable : bool ref
+val all_ccopts : string list ref
+val classic : bool ref
+val nopervasives : bool ref
+val match_context_rows : int ref
+val open_modules : string list ref
+val preprocessor : string option ref
+val all_ppx : string list ref
+val absname : bool ref
+val annotations : bool ref
+val binary_annotations : bool ref
+val use_threads : bool ref
+val noassert : bool ref
+val verbose : bool ref
+val noprompt : bool ref
+val nopromptcont : bool ref
+val init_file : string option ref
+val noinit : bool ref
+val noversion : bool ref
+val use_prims : string ref
+val use_runtime : string ref
+val plugin : bool ref
+val principal : bool ref
+val real_paths : bool ref
+val recursive_types : bool ref
+val strict_sequence : bool ref
+val strict_formats : bool ref
+val applicative_functors : bool ref
+val make_runtime : bool ref
+val c_compiler : string option ref
+val no_auto_link : bool ref
+val dllpaths : string list ref
+val make_package : bool ref
+val for_package : string option ref
+val error_size : int ref
+val float_const_prop : bool ref
+val transparent_modules : bool ref
+val unique_ids : bool ref
+val locations : bool ref
+val dump_source : bool ref
+val dump_parsetree : bool ref
+val dump_typedtree : bool ref
+val dump_rawlambda : bool ref
+val dump_lambda : bool ref
+val dump_rawclambda : bool ref
+val dump_clambda : bool ref
+val dump_rawflambda : bool ref
+val dump_flambda : bool ref
+val dump_flambda_let : int option ref
+val dump_instr : bool ref
+val keep_camlprimc_file : bool ref
+val keep_asm_file : bool ref
+val optimize_for_speed : bool ref
+val dump_cmm : bool ref
+val dump_selection : bool ref
+val dump_cse : bool ref
+val dump_live : bool ref
+val dump_avail : bool ref
+val debug_runavail : bool ref
+val dump_spill : bool ref
+val dump_split : bool ref
+val dump_interf : bool ref
+val dump_prefer : bool ref
+val dump_regalloc : bool ref
+val dump_reload : bool ref
+val dump_scheduling : bool ref
+val dump_linear : bool ref
+val dump_interval : bool ref
+val keep_startup_file : bool ref
+val dump_combine : bool ref
+val native_code : bool ref
+val default_inline_threshold : float
+val inline_threshold : Float_arg_helper.parsed ref
+val inlining_report : bool ref
+val simplify_rounds : int option ref
+val default_simplify_rounds : int ref
+val rounds : unit -> int
+val default_inline_max_unroll : int
+val inline_max_unroll : Int_arg_helper.parsed ref
+val default_inline_toplevel_threshold : int
+val inline_toplevel_threshold : Int_arg_helper.parsed ref
+val default_inline_call_cost : int
+val default_inline_alloc_cost : int
+val default_inline_prim_cost : int
+val default_inline_branch_cost : int
+val default_inline_indirect_cost : int
+val default_inline_lifting_benefit : int
+val inline_call_cost : Int_arg_helper.parsed ref
+val inline_alloc_cost : Int_arg_helper.parsed ref
+val inline_prim_cost : Int_arg_helper.parsed ref
+val inline_branch_cost : Int_arg_helper.parsed ref
+val inline_indirect_cost : Int_arg_helper.parsed ref
+val inline_lifting_benefit : Int_arg_helper.parsed ref
+val default_inline_branch_factor : float
+val inline_branch_factor : Float_arg_helper.parsed ref
+val dont_write_files : bool ref
+val std_include_flag : string -> string
+val std_include_dir : unit -> string list
+val shared : bool ref
+val dlcode : bool ref
+val pic_code : bool ref
+val runtime_variant : string ref
+val with_runtime : bool ref
+val force_slash : bool ref
+val keep_docs : bool ref
+val keep_locs : bool ref
+val unsafe_string : bool ref
+val opaque : bool ref
+val profile_columns : Profile.column list ref
+val flambda_invariant_checks : bool ref
+val unbox_closures : bool ref
+val unbox_closures_factor : int ref
+val default_unbox_closures_factor : int
+val unbox_free_vars_of_closures : bool ref
+val unbox_specialised_args : bool ref
+val clambda_checks : bool ref
+val default_inline_max_depth : int
+val inline_max_depth : Int_arg_helper.parsed ref
+val remove_unused_arguments : bool ref
+val dump_flambda_verbose : bool ref
+val classic_inlining : bool ref
+val afl_instrument : bool ref
+val afl_inst_ratio : int ref
+val function_sections : bool ref
+
+val all_passes : string list ref
+val dumped_pass : string -> bool
+val set_dumped_pass : string -> bool -> unit
+
+val dump_into_file : bool ref
+
+(* Support for flags that can also be set from an environment variable *)
+type 'a env_reader = {
+  parse : string -> 'a option;
+  print : 'a -> string;
+  usage : string;
+  env_var : string;
+}
+
+val color : Misc.Color.setting option ref
+val color_reader : Misc.Color.setting env_reader
+
+val error_style : Misc.Error_style.setting option ref
+val error_style_reader : Misc.Error_style.setting env_reader
+
+val unboxed_types : bool ref
+
+val insn_sched : bool ref
+val insn_sched_default : bool
+
+module Compiler_pass : sig
+  type t = Parsing | Typing | Scheduling
+  val of_string : string -> t option
+  val to_string : t -> string
+  val is_compilation_pass : t -> bool
+  val available_pass_names : native:bool -> string list
+end
+val stop_after : Compiler_pass.t option ref
+val should_stop_after : Compiler_pass.t -> bool
+
+val arg_spec : (string * Arg.spec * string) list ref
+
+(* [add_arguments __LOC__ args] will add the arguments from [args] at
+   the end of [arg_spec], checking that they have not already been
+   added by [add_arguments] before. A warning is printed showing the
+   locations of the function from which the argument was previously
+   added. *)
+val add_arguments : string -> (string * Arg.spec * string) list -> unit
+
+(* [parse_arguments anon_arg usage] will parse the arguments, using
+  the arguments provided in [Clflags.arg_spec].
+*)
+val parse_arguments : Arg.anon_fun -> string -> unit
+
+(* [print_arguments usage] print the standard usage message *)
+val print_arguments : string -> unit
+
+(* [reset_arguments ()] clear all declared arguments *)
+val reset_arguments : unit -> unit
diff --git a/utils/config.mli b/utils/config.mli
new file mode 100644
index 00000000..515a428d
--- /dev/null
+++ b/utils/config.mli
@@ -0,0 +1,250 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** System configuration
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+val version: string
+(** The current version number of the system *)
+
+val standard_library: string
+(** The directory containing the standard libraries *)
+
+val ccomp_type: string
+(** The "kind" of the C compiler, assembler and linker used: one of
+    "cc" (for Unix-style C compilers)
+    "msvc" (for Microsoft Visual C++ and MASM) *)
+
+val c_compiler: string
+(** The compiler to use for compiling C files *)
+
+val c_output_obj: string
+(** Name of the option of the C compiler for specifying the output
+    file *)
+
+val c_has_debug_prefix_map : bool
+(** Whether the C compiler supports -fdebug-prefix-map *)
+
+val as_has_debug_prefix_map : bool
+(** Whether the assembler supports --debug-prefix-map *)
+
+val ocamlc_cflags : string
+(** The flags ocamlc should pass to the C compiler *)
+
+val ocamlc_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 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 bytecomp_c_libraries: string
+(** The C libraries to link with custom runtimes *)
+
+val native_c_libraries: string
+(** The C libraries to link with native-code programs *)
+
+val native_pack_linker: string
+(** The linker to use for packaging (ocamlopt -pack) and for partial
+    links (ocamlopt -output-obj). *)
+
+val mkdll: string
+(** The linker command line to build dynamic libraries. *)
+
+val mkexe: string
+(** The linker command line to build executables. *)
+
+val mkmaindll: string
+(** The linker command line to build main programs as dlls. *)
+
+val ranlib: string
+(** Command to randomize a library, or "" if not needed *)
+
+val ar: string
+(** Name of the ar command, or "" if not needed  (MSVC) *)
+
+val interface_suffix: string ref
+(** Suffix for interface file names *)
+
+val exec_magic_number: string
+(** Magic number for bytecode executable files *)
+
+val cmi_magic_number: string
+(** Magic number for compiled interface files *)
+
+val cmo_magic_number: string
+(** Magic number for object bytecode files *)
+
+val cma_magic_number: string
+(** Magic number for archive files *)
+
+val cmx_magic_number: string
+(** Magic number for compilation unit descriptions *)
+
+val cmxa_magic_number: string
+(** Magic number for libraries of compilation unit descriptions *)
+
+val ast_intf_magic_number: string
+(** Magic number for file holding an interface syntax tree *)
+
+val ast_impl_magic_number: string
+(** Magic number for file holding an implementation syntax tree *)
+
+val cmxs_magic_number: string
+(** Magic number for dynamically-loadable plugins *)
+
+val cmt_magic_number: string
+(** Magic number for compiled interface files *)
+
+val max_tag: int
+(** Biggest tag that can be stored in the header of a regular block. *)
+
+val lazy_tag : int
+(** Normally the same as Obj.lazy_tag.  Separate definition because
+    of technical reasons for bootstrapping. *)
+
+val max_young_wosize: int
+(** Maximal size of arrays that are directly allocated in the
+    minor heap *)
+
+val stack_threshold: int
+(** Size in words of safe area at bottom of VM stack,
+    see runtime/caml/config.h *)
+
+val stack_safety_margin: int
+(** Size in words of the safety margin between the bottom of
+    the stack and the stack pointer. This margin can be used by
+    intermediate computations of some instructions, or the event
+    handler. *)
+
+val architecture: string
+(** Name of processor type for the native-code compiler *)
+
+val model: string
+(** Name of processor submodel for the native-code compiler *)
+
+val system: string
+(** Name of operating system for the native-code compiler *)
+
+val asm: string
+(** The assembler (and flags) to use for assembling
+    ocamlopt-generated code. *)
+
+val asm_cfi_supported: bool
+(** Whether assembler understands CFI directives *)
+
+val with_frame_pointers : bool
+(** Whether assembler should maintain frame pointers *)
+
+val ext_obj: string
+(** Extension for object files, e.g. [.o] under Unix. *)
+
+val ext_asm: string
+(** Extension for assembler files, e.g. [.s] under Unix. *)
+
+val ext_lib: string
+(** Extension for library files, e.g. [.a] under Unix. *)
+
+val ext_dll: string
+(** Extension for dynamically-loaded libraries, e.g. [.so] under Unix.*)
+
+val default_executable_name: string
+(** Name of executable produced by linking if none is given with -o,
+    e.g. [a.out] under Unix. *)
+
+val systhread_supported : bool
+(** Whether the system thread library is implemented *)
+
+val flexdll_dirs : string list
+(** Directories needed for the FlexDLL objects *)
+
+val host : string
+(** Whether the compiler is a cross-compiler *)
+
+val target : string
+(** Whether the compiler is a cross-compiler *)
+
+val flambda : bool
+(** Whether the compiler was configured for flambda *)
+
+val with_flambda_invariants : bool
+(** Whether the invariants checks for flambda are enabled *)
+
+val spacetime : bool
+(** Whether the compiler was configured for Spacetime profiling *)
+
+val enable_call_counts : bool
+(** Whether call counts are to be available when Spacetime profiling *)
+
+val profinfo : bool
+(** Whether the compiler was configured for profiling *)
+
+val profinfo_width : int
+(** How many bits are to be used in values' headers for profiling
+    information *)
+
+val libunwind_available : bool
+(** Whether the libunwind library is available on the target *)
+
+val libunwind_link_flags : string
+(** Linker flags to use libunwind *)
+
+val safe_string: bool
+(** Whether the compiler was configured with -force-safe-string;
+    in that case, the -unsafe-string compile-time option is unavailable
+
+    @since 4.05.0 *)
+
+val default_safe_string: bool
+(** Whether the compiler was configured to use the -safe-string
+    or -unsafe-string compile-time option by default.
+
+    @since 4.06.0 *)
+
+val flat_float_array : bool
+(** Whether the compiler and runtime automagically flatten float
+    arrays *)
+
+val function_sections : bool
+(** Whether the compiler was configured to generate
+    each function in a separate section *)
+
+val windows_unicode: bool
+(** Whether Windows Unicode runtime is enabled *)
+
+val supports_shared_libraries: bool
+(** Whether shared libraries are supported
+
+    @since 4.08.0 *)
+
+val afl_instrument : bool
+(** Whether afl-fuzz instrumentation is generated by default *)
+
+
+(** Access to configuration values *)
+val print_config : out_channel -> unit
+
+val config_var : string -> string option
+(** the configuration value of a variable, if it exists *)
diff --git a/utils/config.mlp b/utils/config.mlp
new file mode 100644
index 00000000..49ffc5bd
--- /dev/null
+++ b/utils/config.mlp
@@ -0,0 +1,242 @@
+#2 "utils/config.mlp"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* The main OCaml version string has moved to ../VERSION *)
+let version = Sys.ocaml_version
+
+let standard_library_default = "%%LIBDIR%%"
+
+let standard_library =
+  try
+    Sys.getenv "OCAMLLIB"
+  with Not_found ->
+  try
+    Sys.getenv "CAMLLIB"
+  with Not_found ->
+    standard_library_default
+
+let ccomp_type = "%%CCOMPTYPE%%"
+let c_compiler = "%%CC%%"
+let c_output_obj = "%%OUTPUTOBJ%%"
+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 = "%%OCAMLC_CFLAGS%%"
+let ocamlc_cppflags = "%%OCAMLC_CPPFLAGS%%"
+(* #7678: ocamlopt uses these only to compile .c files, and the behaviour for
+          the two drivers should be identical. *)
+let ocamlopt_cflags = "%%OCAMLC_CFLAGS%%"
+let ocamlopt_cppflags = "%%OCAMLOPT_CPPFLAGS%%"
+let bytecomp_c_libraries = "%%BYTECCLIBS%%"
+(* 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.
+*)
+let bytecomp_c_compiler =
+  c_compiler ^ " " ^ ocamlc_cflags ^ " " ^ ocamlc_cppflags
+let native_c_compiler =
+  c_compiler ^ " " ^ ocamlopt_cflags ^ " " ^ ocamlopt_cppflags
+let native_c_libraries = "%%NATIVECCLIBS%%"
+let native_pack_linker = "%%PACKLD%%"
+let ranlib = "%%RANLIBCMD%%"
+let ar = "%%ARCMD%%"
+let mkdll, mkexe, mkmaindll =
+  (* @@DRA Cygwin - but only if shared libraries are enabled, which we
+     should be able to detect? *)
+  if Sys.os_type = "Win32" then
+    try
+      let flexlink =
+        let flexlink = Sys.getenv "OCAML_FLEXLINK" in
+        let f i =
+          let c = flexlink.[i] in
+          if c = '/' then '\\' else c in
+        (String.init (String.length flexlink) f) ^ " %%FLEXLINK_FLAGS%%" in
+      flexlink,
+      flexlink ^ " -exe%%FLEXLINK_LDFLAGS%%",
+      flexlink ^ " -maindll"
+    with Not_found ->
+      "%%MKDLL%%", "%%MKEXE%%", "%%MKMAINDLL%%"
+  else
+    "%%MKDLL%%", "%%MKEXE%%", "%%MKMAINDLL%%"
+
+let flambda = %%FLAMBDA%%
+let with_flambda_invariants = %%WITH_FLAMBDA_INVARIANTS%%
+let safe_string = %%FORCE_SAFE_STRING%%
+let default_safe_string = %%DEFAULT_SAFE_STRING%%
+let windows_unicode = %%WINDOWS_UNICODE%% != 0
+let supports_shared_libraries = %%SUPPORTS_SHARED_LIBRARIES%%
+
+let flat_float_array = %%FLAT_FLOAT_ARRAY%%
+
+let function_sections = %%FUNCTION_SECTIONS%%
+let afl_instrument = %%AFL_INSTRUMENT%%
+
+let exec_magic_number = "Caml1999X028"
+    (* exec_magic_number is duplicated in runtime/caml/exec.h *)
+and cmi_magic_number = "Caml1999I028"
+and cmo_magic_number = "Caml1999O028"
+and cma_magic_number = "Caml1999A028"
+and cmx_magic_number =
+  if flambda then
+    "Caml1999y028"
+  else
+    "Caml1999Y028"
+and cmxa_magic_number =
+  if flambda then
+    "Caml1999z028"
+  else
+    "Caml1999Z028"
+and ast_impl_magic_number = "Caml1999M028"
+and ast_intf_magic_number = "Caml1999N028"
+and cmxs_magic_number = "Caml1999D028"
+and cmt_magic_number = "Caml1999T028"
+
+let interface_suffix = ref ".mli"
+
+let max_tag = 245
+(* This is normally the same as in obj.ml, but we have to define it
+   separately because it can differ when we're in the middle of a
+   bootstrapping phase. *)
+let lazy_tag = 246
+
+let max_young_wosize = 256
+let stack_threshold = 256 (* see runtime/caml/config.h *)
+let stack_safety_margin = 60
+
+let architecture = "%%ARCH%%"
+let model = "%%MODEL%%"
+let system = "%%SYSTEM%%"
+
+let asm = "%%ASM%%"
+let asm_cfi_supported = %%ASM_CFI_SUPPORTED%%
+let with_frame_pointers = %%WITH_FRAME_POINTERS%%
+let spacetime = %%WITH_SPACETIME%%
+let enable_call_counts = %%ENABLE_CALL_COUNTS%%
+let libunwind_available = %%LIBUNWIND_AVAILABLE%%
+let libunwind_link_flags = "%%LIBUNWIND_LINK_FLAGS%%"
+let profinfo = %%WITH_PROFINFO%%
+let profinfo_width = %%PROFINFO_WIDTH%%
+
+let ext_exe = "%%EXE%%"
+let ext_obj = "%%EXT_OBJ%%"
+let ext_asm = "%%EXT_ASM%%"
+let ext_lib = "%%EXT_LIB%%"
+let ext_dll = "%%EXT_DLL%%"
+
+let host = "%%HOST%%"
+let target = "%%TARGET%%"
+
+let default_executable_name =
+  match Sys.os_type with
+    "Unix" -> "a.out"
+  | "Win32" | "Cygwin" -> "camlprog.exe"
+  | _ -> "camlprog"
+
+let systhread_supported = %%SYSTHREAD_SUPPORT%%;;
+
+let flexdll_dirs = [%%FLEXDLL_DIR%%];;
+
+type configuration_value =
+  | String of string
+  | Int of int
+  | Bool of bool
+
+let configuration_variables =
+  let p x v = (x, String v) in
+  let p_int x v = (x, Int v) in
+  let p_bool x v = (x, Bool v) in
+[
+  p "version" version;
+  p "standard_library_default" standard_library_default;
+  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 "bytecomp_c_compiler" bytecomp_c_compiler;
+  p "native_c_compiler" native_c_compiler;
+  p "bytecomp_c_libraries" bytecomp_c_libraries;
+  p "native_c_libraries" native_c_libraries;
+  p "native_pack_linker" native_pack_linker;
+  p "ranlib" ranlib;
+  p "architecture" architecture;
+  p "model" model;
+  p_int "int_size" Sys.int_size;
+  p_int "word_size" Sys.word_size;
+  p "system" system;
+  p "asm" asm;
+  p_bool "asm_cfi_supported" asm_cfi_supported;
+  p_bool "with_frame_pointers" with_frame_pointers;
+  p "ext_exe" ext_exe;
+  p "ext_obj" ext_obj;
+  p "ext_asm" ext_asm;
+  p "ext_lib" ext_lib;
+  p "ext_dll" ext_dll;
+  p "os_type" Sys.os_type;
+  p "default_executable_name" default_executable_name;
+  p_bool "systhread_supported" systhread_supported;
+  p "host" host;
+  p "target" target;
+  p_bool "flambda" flambda;
+  p_bool "spacetime" spacetime;
+  p_bool "safe_string" safe_string;
+  p_bool "default_safe_string" default_safe_string;
+  p_bool "flat_float_array" flat_float_array;
+  p_bool "function_sections" function_sections;
+  p_bool "afl_instrument" afl_instrument;
+  p_bool "windows_unicode" windows_unicode;
+  p_bool "supports_shared_libraries" supports_shared_libraries;
+
+  p "exec_magic_number" exec_magic_number;
+  p "cmi_magic_number" cmi_magic_number;
+  p "cmo_magic_number" cmo_magic_number;
+  p "cma_magic_number" cma_magic_number;
+  p "cmx_magic_number" cmx_magic_number;
+  p "cmxa_magic_number" cmxa_magic_number;
+  p "ast_impl_magic_number" ast_impl_magic_number;
+  p "ast_intf_magic_number" ast_intf_magic_number;
+  p "cmxs_magic_number" cmxs_magic_number;
+  p "cmt_magic_number" cmt_magic_number;
+]
+
+let print_config_value oc = function
+  | String s ->
+      Printf.fprintf oc "%s" s
+  | Int n ->
+      Printf.fprintf oc "%d" n
+  | Bool p ->
+      Printf.fprintf oc "%B" p
+
+let print_config oc =
+  let print (x, v) =
+    Printf.fprintf oc "%s: %a\n" x print_config_value v in
+  List.iter print configuration_variables;
+  flush oc;
+;;
+
+let config_var x =
+  match List.assoc_opt x configuration_variables with
+  | None -> None
+  | Some v ->
+      let s = match v with
+        | String s -> s
+        | Int n -> Int.to_string n
+        | Bool b -> string_of_bool b
+      in
+      Some s
diff --git a/utils/consistbl.ml b/utils/consistbl.ml
new file mode 100644
index 00000000..b3299114
--- /dev/null
+++ b/utils/consistbl.ml
@@ -0,0 +1,97 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Consistency tables: for checking consistency of module CRCs *)
+
+open Misc
+
+module Make (Module_name : sig
+  type t
+  module Set : Set.S with type elt = t
+  module Map : Map.S with type key = t
+  module Tbl : Hashtbl.S with type key = t
+  val compare : t -> t -> int
+end) = struct
+  type t = (Digest.t * filepath) Module_name.Tbl.t
+
+  let create () = Module_name.Tbl.create 13
+
+  let clear = Module_name.Tbl.clear
+
+  exception Inconsistency of {
+    unit_name : Module_name.t;
+    inconsistent_source : string;
+    original_source : string;
+  }
+
+  exception Not_available of Module_name.t
+
+  let check_ tbl name crc source =
+    let (old_crc, old_source) = Module_name.Tbl.find tbl name in
+    if crc <> old_crc then raise(Inconsistency {
+        unit_name = name;
+        inconsistent_source = source;
+        original_source = old_source;
+      })
+
+  let check tbl name crc source =
+    try check_ tbl name crc source
+    with Not_found ->
+      Module_name.Tbl.add tbl name (crc, source)
+
+  let check_noadd tbl name crc source =
+    try check_ tbl name crc source
+    with Not_found ->
+      raise (Not_available name)
+
+  let set tbl name crc source = Module_name.Tbl.add tbl name (crc, source)
+
+  let source tbl name = snd (Module_name.Tbl.find tbl name)
+
+  let extract l tbl =
+    let l = List.sort_uniq Module_name.compare l in
+    List.fold_left
+      (fun assc name ->
+         try
+           let (crc, _) = Module_name.Tbl.find tbl name in
+             (name, Some crc) :: assc
+         with Not_found ->
+           (name, None) :: assc)
+      [] l
+
+  let extract_map mod_names tbl =
+    Module_name.Set.fold
+      (fun name result ->
+         try
+           let (crc, _) = Module_name.Tbl.find tbl name in
+           Module_name.Map.add name (Some crc) result
+         with Not_found ->
+           Module_name.Map.add name None result)
+      mod_names
+      Module_name.Map.empty
+
+  let filter p tbl =
+    let to_remove = ref [] in
+    Module_name.Tbl.iter
+      (fun name _ ->
+        if not (p name) then to_remove := name :: !to_remove)
+      tbl;
+    List.iter
+      (fun name ->
+         while Module_name.Tbl.mem tbl name do
+           Module_name.Tbl.remove tbl name
+         done)
+      !to_remove
+end
diff --git a/utils/consistbl.mli b/utils/consistbl.mli
new file mode 100644
index 00000000..5067addf
--- /dev/null
+++ b/utils/consistbl.mli
@@ -0,0 +1,82 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2002 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Consistency tables: for checking consistency of module CRCs
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Misc
+
+module Make (Module_name : sig
+  type t
+  module Set : Set.S with type elt = t
+  module Map : Map.S with type key = t
+  module Tbl : Hashtbl.S with type key = t
+  val compare : t -> t -> int
+end) : sig
+  type t
+
+  val create: unit -> t
+
+  val clear: t -> unit
+
+  val check: t -> Module_name.t -> Digest.t -> filepath -> unit
+        (* [check tbl name crc source]
+             checks consistency of ([name], [crc]) with infos previously
+             stored in [tbl].  If no CRC was previously associated with
+             [name], record ([name], [crc]) in [tbl].
+             [source] is the name of the file from which the information
+             comes from.  This is used for error reporting. *)
+
+  val check_noadd: t -> Module_name.t -> Digest.t -> filepath -> unit
+        (* Same as [check], but raise [Not_available] if no CRC was previously
+             associated with [name]. *)
+
+  val set: t -> Module_name.t -> Digest.t -> filepath -> unit
+        (* [set tbl name crc source] forcefully associates [name] with
+           [crc] in [tbl], even if [name] already had a different CRC
+           associated with [name] in [tbl]. *)
+
+  val source: t -> Module_name.t -> filepath
+        (* [source tbl name] returns the file name associated with [name]
+           if the latter has an associated CRC in [tbl].
+           Raise [Not_found] otherwise. *)
+
+  val extract: Module_name.t list -> t -> (Module_name.t * Digest.t option) list
+        (* [extract tbl names] returns an associative list mapping each string
+           in [names] to the CRC associated with it in [tbl]. If no CRC is
+           associated with a name then it is mapped to [None]. *)
+
+  val extract_map : Module_name.Set.t -> t -> Digest.t option Module_name.Map.t
+        (* Like [extract] but with a more sophisticated type. *)
+
+  val filter: (Module_name.t -> bool) -> t -> unit
+        (* [filter pred tbl] removes from [tbl] table all (name, CRC) pairs
+           such that [pred name] is [false]. *)
+
+  exception Inconsistency of {
+    unit_name : Module_name.t;
+    inconsistent_source : string;
+    original_source : string;
+  }
+  (* Raised by [check] when a CRC mismatch is detected. *)
+
+  exception Not_available of Module_name.t
+        (* Raised by [check_noadd] when a name doesn't have an associated
+           CRC. *)
+end
diff --git a/utils/domainstate.ml.c b/utils/domainstate.ml.c
new file mode 100644
index 00000000..7ece1ad8
--- /dev/null
+++ b/utils/domainstate.ml.c
@@ -0,0 +1,34 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*      KC Sivaramakrishnan, Indian Institute of Technology, Madras       */
+/*                 Stephen Dolan, University of Cambridge                 */
+/*                                                                        */
+/*   Copyright 2019 Indian Institute of Technology, Madras                */
+/*   Copyright 2019 University of Cambridge                               */
+/*                                                                        */
+/*   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 =
+#define DOMAIN_STATE(type, name) | Domain_##name
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+
+let idx_of_field =
+  let curr = 0 in
+#define DOMAIN_STATE(type, name) \
+  let idx__##name = curr in \
+  let curr = curr + 1 in
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+  let _ = curr in
+  function
+#define DOMAIN_STATE(type, name) \
+  | Domain_##name -> idx__##name
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
diff --git a/utils/domainstate.mli.c b/utils/domainstate.mli.c
new file mode 100644
index 00000000..1da60c94
--- /dev/null
+++ b/utils/domainstate.mli.c
@@ -0,0 +1,22 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*      KC Sivaramakrishnan, Indian Institute of Technology, Madras       */
+/*                Stephen Dolan, University of Cambridge                  */
+/*                                                                        */
+/*   Copyright 2019 Indian Institute of Technology, Madras                */
+/*   Copyright 2019 University of Cambridge                               */
+/*                                                                        */
+/*   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 =
+#define DOMAIN_STATE(type, name) | Domain_##name
+#include "domain_state.tbl"
+#undef DOMAIN_STATE
+
+val idx_of_field : t -> int
diff --git a/utils/dune b/utils/dune
new file mode 100644
index 00000000..39c76af3
--- /dev/null
+++ b/utils/dune
@@ -0,0 +1,45 @@
+;**************************************************************************
+;*                                                                        *
+;*                                 OCaml                                  *
+;*                                                                        *
+;*                     Thomas Refis, Jane Street Europe                   *
+;*                                                                        *
+;*   Copyright 2018 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.          *
+;*                                                                        *
+;**************************************************************************
+
+(rule
+ (targets config.ml)
+ (mode    fallback)
+ (deps    (:mk Makefile)
+          ../Makefile.config
+          config.mlp)
+ (action  (system "make -f %{mk} %{targets}")))
+
+(rule
+ (targets domainstate.ml)
+ (mode    fallback)
+ (deps    (:conf ../Makefile.config)
+          (:c domainstate.ml.c)
+          (:tbl ../runtime/caml/domain_state.tbl))
+ (action
+   (with-stdout-to %{targets}
+     (bash
+       "`grep '^CPP=' %{conf} | cut -d'=' -f2` -I ../runtime/caml %{c} %{tbl}"
+       ))))
+
+(rule
+ (targets domainstate.mli)
+ (mode    fallback)
+ (deps    (:conf ../Makefile.config)
+          (:c domainstate.mli.c)
+          (:tbl ../runtime/caml/domain_state.tbl))
+ (action
+   (with-stdout-to %{targets}
+     (bash
+       "`grep '^CPP=' %{conf} | cut -d'=' -f2` -I ../runtime/caml %{c} %{tbl}"
+       ))))
diff --git a/utils/identifiable.ml b/utils/identifiable.ml
new file mode 100644
index 00000000..9bbfb657
--- /dev/null
+++ b/utils/identifiable.ml
@@ -0,0 +1,249 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+module type Thing = sig
+  type t
+
+  include Hashtbl.HashedType with type t := t
+  include Map.OrderedType with type t := t
+
+  val output : out_channel -> t -> unit
+  val print : Format.formatter -> t -> unit
+end
+
+module type Set = sig
+  module T : Set.OrderedType
+  include Set.S
+    with type elt = T.t
+     and type t = Set.Make (T).t
+
+  val output : out_channel -> t -> unit
+  val print : Format.formatter -> t -> unit
+  val to_string : t -> string
+  val of_list : elt list -> t
+  val map : (elt -> elt) -> t -> t
+end
+
+module type Map = sig
+  module T : Map.OrderedType
+  include Map.S
+    with type key = T.t
+     and type 'a t = 'a Map.Make (T).t
+
+  val of_list : (key * 'a) list -> 'a t
+
+  val disjoint_union :
+    ?eq:('a -> 'a -> bool) -> ?print:(Format.formatter -> 'a -> unit) -> 'a t ->
+    'a t -> 'a t
+
+  val union_right : 'a t -> 'a t -> 'a t
+
+  val union_left : 'a t -> 'a t -> 'a t
+
+  val union_merge : ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t
+  val rename : key t -> key -> key
+  val map_keys : (key -> key) -> 'a t -> 'a t
+  val keys : 'a t -> Set.Make(T).t
+  val data : 'a t -> 'a list
+  val of_set : (key -> 'a) -> Set.Make(T).t -> 'a t
+  val transpose_keys_and_data : key t -> key t
+  val transpose_keys_and_data_set : key t -> Set.Make(T).t t
+  val print :
+    (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
+end
+
+module type Tbl = sig
+  module T : sig
+    type t
+    include Map.OrderedType with type t := t
+    include Hashtbl.HashedType with type t := t
+  end
+  include Hashtbl.S
+    with type key = T.t
+     and type 'a t = 'a Hashtbl.Make (T).t
+
+  val to_list : 'a t -> (T.t * 'a) list
+  val of_list : (T.t * 'a) list -> 'a t
+
+  val to_map : 'a t -> 'a Map.Make(T).t
+  val of_map : 'a Map.Make(T).t -> 'a t
+  val memoize : 'a t -> (key -> 'a) -> key -> 'a
+  val map : 'a t -> ('a -> 'b) -> 'b t
+end
+
+module Pair (A : Thing) (B : Thing) : Thing with type t = A.t * B.t = struct
+  type t = A.t * B.t
+
+  let compare (a1, b1) (a2, b2) =
+    let c = A.compare a1 a2 in
+    if c <> 0 then c
+    else B.compare b1 b2
+
+  let output oc (a, b) = Printf.fprintf oc " (%a, %a)" A.output a B.output b
+  let hash (a, b) = Hashtbl.hash (A.hash a, B.hash b)
+  let equal (a1, b1) (a2, b2) = A.equal a1 a2 && B.equal b1 b2
+  let print ppf (a, b) = Format.fprintf ppf " (%a, @ %a)" A.print a B.print b
+end
+
+module Make_map (T : Thing) = struct
+  include Map.Make (T)
+
+  let of_list l =
+    List.fold_left (fun map (id, v) -> add id v map) empty l
+
+  let disjoint_union ?eq ?print m1 m2 =
+    union (fun id v1 v2 ->
+        let ok = match eq with
+          | None -> false
+          | Some eq -> eq v1 v2
+        in
+        if not ok then
+          let err =
+            match print with
+            | None ->
+              Format.asprintf "Map.disjoint_union %a" T.print id
+            | Some print ->
+              Format.asprintf "Map.disjoint_union %a => %a <> %a"
+                T.print id print v1 print v2
+          in
+          Misc.fatal_error err
+        else Some v1)
+      m1 m2
+
+  let union_right m1 m2 =
+    merge (fun _id x y -> match x, y with
+        | None, None -> None
+        | None, Some v
+        | Some v, None
+        | Some _, Some v -> Some v)
+      m1 m2
+
+  let union_left m1 m2 = union_right m2 m1
+
+  let union_merge f m1 m2 =
+    let aux _ m1 m2 =
+      match m1, m2 with
+      | None, m | m, None -> m
+      | Some m1, Some m2 -> Some (f m1 m2)
+    in
+    merge aux m1 m2
+
+  let rename m v =
+    try find v m
+    with Not_found -> v
+
+  let map_keys f m =
+    of_list (List.map (fun (k, v) -> f k, v) (bindings m))
+
+  let print f ppf s =
+    let elts ppf s = iter (fun id v ->
+        Format.fprintf ppf "@ (@[%a@ %a@])" T.print id f v) s in
+    Format.fprintf ppf "@[<1>{@[%a@ @]}@]" elts s
+
+  module T_set = Set.Make (T)
+
+  let keys map = fold (fun k _ set -> T_set.add k set) map T_set.empty
+
+  let data t = List.map snd (bindings t)
+
+  let of_set f set = T_set.fold (fun e map -> add e (f e) map) set empty
+
+  let transpose_keys_and_data map = fold (fun k v m -> add v k m) map empty
+  let transpose_keys_and_data_set map =
+    fold (fun k v m ->
+        let set =
+          match find v m with
+          | exception Not_found ->
+            T_set.singleton k
+          | set ->
+            T_set.add k set
+        in
+        add v set m)
+      map empty
+end
+
+module Make_set (T : Thing) = struct
+  include Set.Make (T)
+
+  let output oc s =
+    Printf.fprintf oc " ( ";
+    iter (fun v -> Printf.fprintf oc "%a " T.output v) s;
+    Printf.fprintf oc ")"
+
+  let print ppf s =
+    let elts ppf s = iter (fun e -> Format.fprintf ppf "@ %a" T.print e) s in
+    Format.fprintf ppf "@[<1>{@[%a@ @]}@]" elts s
+
+  let to_string s = Format.asprintf "%a" print s
+
+  let of_list l = match l with
+    | [] -> empty
+    | [t] -> singleton t
+    | t :: q -> List.fold_left (fun acc e -> add e acc) (singleton t) q
+
+  let map f s = of_list (List.map f (elements s))
+end
+
+module Make_tbl (T : Thing) = struct
+  include Hashtbl.Make (T)
+
+  module T_map = Make_map (T)
+
+  let to_list t =
+    fold (fun key datum elts -> (key, datum)::elts) t []
+
+  let of_list elts =
+    let t = create 42 in
+    List.iter (fun (key, datum) -> add t key datum) elts;
+    t
+
+  let to_map v = fold T_map.add v T_map.empty
+
+  let of_map m =
+    let t = create (T_map.cardinal m) in
+    T_map.iter (fun k v -> add t k v) m;
+    t
+
+  let memoize t f = fun key ->
+    try find t key with
+    | Not_found ->
+      let r = f key in
+      add t key r;
+      r
+
+  let map t f =
+    of_map (T_map.map f (to_map t))
+end
+
+module type S = sig
+  type t
+
+  module T : Thing with type t = t
+  include Thing with type t := T.t
+
+  module Set : Set with module T := T
+  module Map : Map with module T := T
+  module Tbl : Tbl with module T := T
+end
+
+module Make (T : Thing) = struct
+  module T = T
+  include T
+
+  module Set = Make_set (T)
+  module Map = Make_map (T)
+  module Tbl = Make_tbl (T)
+end
diff --git a/utils/identifiable.mli b/utils/identifiable.mli
new file mode 100644
index 00000000..0da5a661
--- /dev/null
+++ b/utils/identifiable.mli
@@ -0,0 +1,113 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Uniform interface for common data structures over various things.
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+module type Thing = sig
+  type t
+
+  include Hashtbl.HashedType with type t := t
+  include Map.OrderedType with type t := t
+
+  val output : out_channel -> t -> unit
+  val print : Format.formatter -> t -> unit
+end
+
+module Pair : functor (A : Thing) (B : Thing) -> Thing with type t = A.t * B.t
+
+module type Set = sig
+  module T : Set.OrderedType
+  include Set.S
+    with type elt = T.t
+     and type t = Set.Make (T).t
+
+  val output : out_channel -> t -> unit
+  val print : Format.formatter -> t -> unit
+  val to_string : t -> string
+  val of_list : elt list -> t
+  val map : (elt -> elt) -> t -> t
+end
+
+module type Map = sig
+  module T : Map.OrderedType
+  include Map.S
+    with type key = T.t
+     and type 'a t = 'a Map.Make (T).t
+
+  val of_list : (key * 'a) list -> 'a t
+
+  (** [disjoint_union m1 m2] contains all bindings from [m1] and
+      [m2]. If some binding is present in both and the associated
+      value is not equal, a Fatal_error is raised *)
+  val disjoint_union :
+    ?eq:('a -> 'a -> bool) -> ?print:(Format.formatter -> 'a -> unit) -> 'a t ->
+    'a t -> 'a t
+
+  (** [union_right m1 m2] contains all bindings from [m1] and [m2]. If
+      some binding is present in both, the one from [m2] is taken *)
+  val union_right : 'a t -> 'a t -> 'a t
+
+  (** [union_left m1 m2 = union_right m2 m1] *)
+  val union_left : 'a t -> 'a t -> 'a t
+
+  val union_merge : ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t
+  val rename : key t -> key -> key
+  val map_keys : (key -> key) -> 'a t -> 'a t
+  val keys : 'a t -> Set.Make(T).t
+  val data : 'a t -> 'a list
+  val of_set : (key -> 'a) -> Set.Make(T).t -> 'a t
+  val transpose_keys_and_data : key t -> key t
+  val transpose_keys_and_data_set : key t -> Set.Make(T).t t
+  val print :
+    (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
+end
+
+module type Tbl = sig
+  module T : sig
+    type t
+    include Map.OrderedType with type t := t
+    include Hashtbl.HashedType with type t := t
+  end
+  include Hashtbl.S
+    with type key = T.t
+     and type 'a t = 'a Hashtbl.Make (T).t
+
+  val to_list : 'a t -> (T.t * 'a) list
+  val of_list : (T.t * 'a) list -> 'a t
+
+  val to_map : 'a t -> 'a Map.Make(T).t
+  val of_map : 'a Map.Make(T).t -> 'a t
+  val memoize : 'a t -> (key -> 'a) -> key -> 'a
+  val map : 'a t -> ('a -> 'b) -> 'b t
+end
+
+module type S = sig
+  type t
+
+  module T : Thing with type t = t
+  include Thing with type t := T.t
+
+  module Set : Set with module T := T
+  module Map : Map with module T := T
+  module Tbl : Tbl with module T := T
+end
+
+module Make (T : Thing) : S with type t := T.t
diff --git a/utils/int_replace_polymorphic_compare.ml b/utils/int_replace_polymorphic_compare.ml
new file mode 100644
index 00000000..7cd6bf10
--- /dev/null
+++ b/utils/int_replace_polymorphic_compare.ml
@@ -0,0 +1,8 @@
+let ( = )   : int -> int -> bool = Stdlib.( = )
+let ( <> )  : int -> int -> bool = Stdlib.( <> )
+let ( < )   : int -> int -> bool = Stdlib.( < )
+let ( > )   : int -> int -> bool = Stdlib.( > )
+let ( <= )  : int -> int -> bool = Stdlib.( <= )
+let ( >= )  : int -> int -> bool = Stdlib.( >= )
+
+let compare : int -> int -> int  = Stdlib.compare
diff --git a/utils/int_replace_polymorphic_compare.mli b/utils/int_replace_polymorphic_compare.mli
new file mode 100644
index 00000000..689e741b
--- /dev/null
+++ b/utils/int_replace_polymorphic_compare.mli
@@ -0,0 +1,8 @@
+val ( = )   : int -> int -> bool
+val ( <> )  : int -> int -> bool
+val ( < )   : int -> int -> bool
+val ( > )   : int -> int -> bool
+val ( <= )  : int -> int -> bool
+val ( >= )  : int -> int -> bool
+
+val compare : int -> int -> int
diff --git a/utils/load_path.ml b/utils/load_path.ml
new file mode 100644
index 00000000..d95ef079
--- /dev/null
+++ b/utils/load_path.ml
@@ -0,0 +1,89 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Jeremie Dimino, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+module SMap = Misc.Stdlib.String.Map
+
+(* Mapping from basenames to full filenames *)
+type registry = string SMap.t ref
+
+let files : registry = ref SMap.empty
+let files_uncap : registry = ref SMap.empty
+
+module Dir = struct
+  type t = {
+    path : string;
+    files : string list;
+  }
+
+  let path t = t.path
+  let files t = t.files
+
+  (* For backward compatibility reason, simulate the behavior of
+     [Misc.find_in_path]: silently ignore directories that don't exist
+     + treat [""] as the current directory. *)
+  let readdir_compat dir =
+    try
+      Sys.readdir (if dir = "" then Filename.current_dir_name else dir)
+    with Sys_error _ ->
+      [||]
+
+  let create path =
+    { path; files = Array.to_list (readdir_compat path) }
+end
+
+let dirs = ref []
+
+let reset () =
+  files := SMap.empty;
+  files_uncap := SMap.empty;
+  dirs := []
+
+let get () = !dirs
+let get_paths () = List.map Dir.path !dirs
+
+let add dir =
+  let add_file base =
+    let fn = Filename.concat dir.Dir.path base in
+    files := SMap.add base fn !files;
+    files_uncap := SMap.add (String.uncapitalize_ascii base) fn !files_uncap;
+  in
+  List.iter add_file dir.Dir.files;
+  dirs := dir :: !dirs
+
+let remove_dir dir =
+  let new_dirs = List.filter (fun d -> Dir.path d <> dir) !dirs in
+  if new_dirs <> !dirs then begin
+    reset ();
+    List.iter add (List.rev new_dirs)
+  end
+
+let add_dir dir = add (Dir.create dir)
+
+let init l =
+  reset ();
+  List.iter add_dir (List.rev l)
+
+let is_basename fn = Filename.basename fn = fn
+
+let find fn =
+  if is_basename fn then
+    SMap.find fn !files
+  else
+    Misc.find_in_path (get_paths ()) fn
+
+let find_uncap fn =
+  if is_basename fn then
+    SMap.find (String.uncapitalize_ascii fn) !files_uncap
+  else
+    Misc.find_in_path_uncap (get_paths ()) fn
diff --git a/utils/load_path.mli b/utils/load_path.mli
new file mode 100644
index 00000000..433eaab7
--- /dev/null
+++ b/utils/load_path.mli
@@ -0,0 +1,67 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                   Jeremie Dimino, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 2018 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Management of include directories.
+
+    This module offers a high level interface to locating files in the
+    load path, which is constructed from [-I] command line flags and a few
+    other parameters.
+
+    It makes the assumption that the contents of include directories
+    doesn't change during the execution of the compiler.
+*)
+
+val add_dir : string -> unit
+(** Add a directory to the load path *)
+
+val remove_dir : string -> unit
+(** Remove a directory from the load path *)
+
+val reset : unit -> unit
+(** Remove all directories *)
+
+val init : string list -> unit
+(** [init l] is the same as [reset (); List.iter add_dir (List.rev l)] *)
+
+val get_paths : unit -> string list
+(** Return the list of directories passed to [add_dir] so far, in
+    reverse order. *)
+
+val find : string -> string
+(** Locate a file in the load path. Raise [Not_found] if the file
+    cannot be found. This function is optimized for the case where the
+    filename is a basename, i.e. doesn't contain a directory
+    separator. *)
+
+val find_uncap : string -> string
+(** Same as [find], but search also for uncapitalized name, i.e.  if
+    name is Foo.ml, allow /path/Foo.ml and /path/foo.ml to match. *)
+
+module Dir : sig
+  type t
+  (** Represent one directory in the load path. *)
+
+  val create : string -> t
+
+  val path : t -> string
+
+  val files : t -> string list
+  (** All the files in that directory. This doesn't include files in
+      sub-directories of this directory. *)
+end
+
+val add : Dir.t -> unit
+
+val get : unit -> Dir.t list
+(** Same as [get_paths ()], except that it returns a [Dir.t list]. *)
diff --git a/utils/misc.ml b/utils/misc.ml
new file mode 100644
index 00000000..df2e74d0
--- /dev/null
+++ b/utils/misc.ml
@@ -0,0 +1,1190 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Errors *)
+
+exception Fatal_error
+
+let fatal_errorf fmt =
+  Format.kfprintf
+    (fun _ -> raise Fatal_error)
+    Format.err_formatter
+    ("@?>> Fatal error: " ^^ fmt ^^ "@.")
+
+let fatal_error msg = fatal_errorf "%s" msg
+
+(* Exceptions *)
+
+let try_finally ?(always=(fun () -> ())) ?(exceptionally=(fun () -> ())) work =
+  match work () with
+    | result ->
+      begin match always () with
+        | () -> result
+        | exception always_exn ->
+          let always_bt = Printexc.get_raw_backtrace () in
+          exceptionally ();
+          Printexc.raise_with_backtrace always_exn always_bt
+      end
+    | exception work_exn ->
+      let work_bt = Printexc.get_raw_backtrace () in
+      begin match always () with
+        | () ->
+          exceptionally ();
+          Printexc.raise_with_backtrace work_exn work_bt
+        | exception always_exn ->
+          let always_bt = Printexc.get_raw_backtrace () in
+          exceptionally ();
+          Printexc.raise_with_backtrace always_exn always_bt
+      end
+
+type ref_and_value = R : 'a ref * 'a -> ref_and_value
+
+let protect_refs =
+  let set_refs l = List.iter (fun (R (r, v)) -> r := v) l in
+  fun refs f ->
+    let backup = List.map (fun (R (r, _)) -> R (r, !r)) refs in
+    set_refs refs;
+    Fun.protect ~finally:(fun () -> set_refs backup) f
+
+(* List functions *)
+
+let rec map_end f l1 l2 =
+  match l1 with
+    [] -> l2
+  | hd::tl -> f hd :: map_end f tl l2
+
+let rec map_left_right f = function
+    [] -> []
+  | hd::tl -> let res = f hd in res :: map_left_right f tl
+
+let rec for_all2 pred l1 l2 =
+  match (l1, l2) with
+    ([], []) -> true
+  | (hd1::tl1, hd2::tl2) -> pred hd1 hd2 && for_all2 pred tl1 tl2
+  | (_, _) -> false
+
+let rec replicate_list elem n =
+  if n <= 0 then [] else elem :: replicate_list elem (n-1)
+
+let rec list_remove x = function
+    [] -> []
+  | hd :: tl ->
+      if hd = x then tl else hd :: list_remove x tl
+
+let rec split_last = function
+    [] -> assert false
+  | [x] -> ([], x)
+  | hd :: tl ->
+      let (lst, last) = split_last tl in
+      (hd :: lst, last)
+
+module Stdlib = struct
+  module List = struct
+    type 'a t = 'a list
+
+    let rec compare cmp l1 l2 =
+      match l1, l2 with
+      | [], [] -> 0
+      | [], _::_ -> -1
+      | _::_, [] -> 1
+      | h1::t1, h2::t2 ->
+        let c = cmp h1 h2 in
+        if c <> 0 then c
+        else compare cmp t1 t2
+
+    let rec equal eq l1 l2 =
+      match l1, l2 with
+      | ([], []) -> true
+      | (hd1 :: tl1, hd2 :: tl2) -> eq hd1 hd2 && equal eq tl1 tl2
+      | (_, _) -> false
+
+    let rec find_map f = function
+      | x :: xs ->
+          begin match f x with
+          | None -> find_map f xs
+          | Some _ as y -> y
+          end
+      | [] -> None
+
+    let map2_prefix f l1 l2 =
+      let rec aux acc l1 l2 =
+        match l1, l2 with
+        | [], _ -> (List.rev acc, l2)
+        | _ :: _, [] -> raise (Invalid_argument "map2_prefix")
+        | h1::t1, h2::t2 ->
+          let h = f h1 h2 in
+          aux (h :: acc) t1 t2
+      in
+      aux [] l1 l2
+
+    let some_if_all_elements_are_some l =
+      let rec aux acc l =
+        match l with
+        | [] -> Some (List.rev acc)
+        | None :: _ -> None
+        | Some h :: t -> aux (h :: acc) t
+      in
+      aux [] l
+
+    let split_at n l =
+      let rec aux n acc l =
+        if n = 0
+        then List.rev acc, l
+        else
+          match l with
+          | [] -> raise (Invalid_argument "split_at")
+          | t::q -> aux (n-1) (t::acc) q
+      in
+      aux n [] l
+
+    let rec is_prefix ~equal t ~of_ =
+      match t, of_ with
+      | [], [] -> true
+      | _::_, [] -> false
+      | [], _::_ -> true
+      | x1::t, x2::of_ -> equal x1 x2 && is_prefix ~equal t ~of_
+
+    type 'a longest_common_prefix_result = {
+      longest_common_prefix : 'a list;
+      first_without_longest_common_prefix : 'a list;
+      second_without_longest_common_prefix : 'a list;
+    }
+
+    let find_and_chop_longest_common_prefix ~equal ~first ~second =
+      let rec find_prefix ~longest_common_prefix_rev l1 l2 =
+        match l1, l2 with
+        | elt1 :: l1, elt2 :: l2 when equal elt1 elt2 ->
+          let longest_common_prefix_rev = elt1 :: longest_common_prefix_rev in
+          find_prefix ~longest_common_prefix_rev l1 l2
+        | l1, l2 ->
+          { longest_common_prefix = List.rev longest_common_prefix_rev;
+            first_without_longest_common_prefix = l1;
+            second_without_longest_common_prefix = l2;
+          }
+      in
+      find_prefix ~longest_common_prefix_rev:[] first second
+  end
+
+  module Option = struct
+    type 'a t = 'a option
+
+    let print print_contents ppf t =
+      match t with
+      | None -> Format.pp_print_string ppf "None"
+      | Some contents ->
+        Format.fprintf ppf "@[(Some@ %a)@]" print_contents contents
+  end
+
+  module Array = struct
+    let exists2 p a1 a2 =
+      let n = Array.length a1 in
+      if Array.length a2 <> n then invalid_arg "Misc.Stdlib.Array.exists2";
+      let rec loop i =
+        if i = n then false
+        else if p (Array.unsafe_get a1 i) (Array.unsafe_get a2 i) then true
+        else loop (succ i) in
+      loop 0
+
+    let for_alli p a =
+      let n = Array.length a in
+      let rec loop i =
+        if i = n then true
+        else if p i (Array.unsafe_get a i) then loop (succ i)
+        else false in
+      loop 0
+
+    let all_somes a =
+      try
+        Some (Array.map (function None -> raise_notrace Exit | Some x -> x) a)
+      with
+      | Exit -> None
+  end
+
+  module String = struct
+    include String
+    module Set = Set.Make(String)
+    module Map = Map.Make(String)
+    module Tbl = Hashtbl.Make(struct
+      include String
+      let hash = Hashtbl.hash
+    end)
+
+    let for_all f t =
+      let len = String.length t in
+      let rec loop i =
+        i = len || (f t.[i] && loop (i + 1))
+      in
+      loop 0
+
+    let print ppf t =
+      Format.pp_print_string ppf t
+  end
+
+  external compare : 'a -> 'a -> int = "%compare"
+end
+
+(* File functions *)
+
+let find_in_path path name =
+  if not (Filename.is_implicit name) then
+    if Sys.file_exists name then name else raise Not_found
+  else begin
+    let rec try_dir = function
+      [] -> raise Not_found
+    | dir::rem ->
+        let fullname = Filename.concat dir name in
+        if Sys.file_exists fullname then fullname else try_dir rem
+    in try_dir path
+  end
+
+let find_in_path_rel path name =
+  let rec simplify s =
+    let open Filename in
+    let base = basename s in
+    let dir = dirname s in
+    if dir = s then dir
+    else if base = current_dir_name then simplify dir
+    else concat (simplify dir) base
+  in
+  let rec try_dir = function
+    [] -> raise Not_found
+  | dir::rem ->
+      let fullname = simplify (Filename.concat dir name) in
+      if Sys.file_exists fullname then fullname else try_dir rem
+  in try_dir path
+
+let find_in_path_uncap path name =
+  let uname = String.uncapitalize_ascii name in
+  let rec try_dir = function
+    [] -> raise Not_found
+  | dir::rem ->
+      let fullname = Filename.concat dir name
+      and ufullname = Filename.concat dir uname in
+      if Sys.file_exists ufullname then ufullname
+      else if Sys.file_exists fullname then fullname
+      else try_dir rem
+  in try_dir path
+
+let remove_file filename =
+  try
+    if Sys.file_exists filename
+    then Sys.remove filename
+  with Sys_error _msg ->
+    ()
+
+(* Expand a -I option: if it starts with +, make it relative to the standard
+   library directory *)
+
+let expand_directory alt s =
+  if String.length s > 0 && s.[0] = '+'
+  then Filename.concat alt
+                       (String.sub s 1 (String.length s - 1))
+  else s
+
+let path_separator =
+  match Sys.os_type with
+  | "Win32" -> ';'
+  | _ -> ':'
+
+let split_path_contents ?(sep = path_separator) = function
+  | "" -> []
+  | s -> String.split_on_char sep s
+
+(* Hashtable functions *)
+
+let create_hashtable size init =
+  let tbl = Hashtbl.create size in
+  List.iter (fun (key, data) -> Hashtbl.add tbl key data) init;
+  tbl
+
+(* File copy *)
+
+let copy_file ic oc =
+  let buff = Bytes.create 0x1000 in
+  let rec copy () =
+    let n = input ic buff 0 0x1000 in
+    if n = 0 then () else (output oc buff 0 n; copy())
+  in copy()
+
+let copy_file_chunk ic oc len =
+  let buff = Bytes.create 0x1000 in
+  let rec copy n =
+    if n <= 0 then () else begin
+      let r = input ic buff 0 (min n 0x1000) in
+      if r = 0 then raise End_of_file else (output oc buff 0 r; copy(n-r))
+    end
+  in copy len
+
+let string_of_file ic =
+  let b = Buffer.create 0x10000 in
+  let buff = Bytes.create 0x1000 in
+  let rec copy () =
+    let n = input ic buff 0 0x1000 in
+    if n = 0 then Buffer.contents b else
+      (Buffer.add_subbytes b buff 0 n; copy())
+  in copy()
+
+let output_to_file_via_temporary ?(mode = [Open_text]) filename fn =
+  let (temp_filename, oc) =
+    Filename.open_temp_file
+       ~mode ~perms:0o666 ~temp_dir:(Filename.dirname filename)
+       (Filename.basename filename) ".tmp" in
+    (* The 0o666 permissions will be modified by the umask.  It's just
+       like what [open_out] and [open_out_bin] do.
+       With temp_dir = dirname filename, we ensure that the returned
+       temp file is in the same directory as filename itself, making
+       it safe to rename temp_filename to filename later.
+       With prefix = basename filename, we are almost certain that
+       the first generated name will be unique.  A fixed prefix
+       would work too but might generate more collisions if many
+       files are being produced simultaneously in the same directory. *)
+  match fn temp_filename oc with
+  | res ->
+      close_out oc;
+      begin try
+        Sys.rename temp_filename filename; res
+      with exn ->
+        remove_file temp_filename; raise exn
+      end
+  | exception exn ->
+      close_out oc; remove_file temp_filename; raise exn
+
+let protect_writing_to_file ~filename ~f =
+  let outchan = open_out_bin filename in
+  try_finally ~always:(fun () -> close_out outchan)
+    ~exceptionally:(fun () -> remove_file filename)
+    (fun () -> f outchan)
+
+(* Integer operations *)
+
+let rec log2 n =
+  if n <= 1 then 0 else 1 + log2(n asr 1)
+
+let align n a =
+  if n >= 0 then (n + a - 1) land (-a) else n land (-a)
+
+let no_overflow_add a b = (a lxor b) lor (a lxor (lnot (a+b))) < 0
+
+let no_overflow_sub a b = (a lxor (lnot b)) lor (b lxor (a-b)) < 0
+
+(* Taken from Hacker's Delight, chapter "Overflow Detection" *)
+let no_overflow_mul a b =
+  not ((a = min_int && b < 0) || (b <> 0 && (a * b) / b <> a))
+
+let no_overflow_lsl a k =
+  0 <= k && k < Sys.word_size - 1 && min_int asr k <= a && a <= max_int asr k
+
+module Int_literal_converter = struct
+  (* To convert integer literals, allowing max_int + 1 (PR#4210) *)
+  let cvt_int_aux str neg of_string =
+    if String.length str = 0 || str.[0]= '-'
+    then of_string str
+    else neg (of_string ("-" ^ str))
+  let int s = cvt_int_aux s (~-) int_of_string
+  let int32 s = cvt_int_aux s Int32.neg Int32.of_string
+  let int64 s = cvt_int_aux s Int64.neg Int64.of_string
+  let nativeint s = cvt_int_aux s Nativeint.neg Nativeint.of_string
+end
+
+(* String operations *)
+
+let chop_extensions file =
+  let dirname = Filename.dirname file and basename = Filename.basename file in
+  try
+    let pos = String.index basename '.' in
+    let basename = String.sub basename 0 pos in
+    if Filename.is_implicit file && dirname = Filename.current_dir_name then
+      basename
+    else
+      Filename.concat dirname basename
+  with Not_found -> file
+
+let search_substring pat str start =
+  let rec search i j =
+    if j >= String.length pat then i
+    else if i + j >= String.length str then raise Not_found
+    else if str.[i + j] = pat.[j] then search i (j+1)
+    else search (i+1) 0
+  in search start 0
+
+let replace_substring ~before ~after str =
+  let rec search acc curr =
+    match search_substring before str curr with
+      | next ->
+         let prefix = String.sub str curr (next - curr) in
+         search (prefix :: acc) (next + String.length before)
+      | exception Not_found ->
+        let suffix = String.sub str curr (String.length str - curr) in
+        List.rev (suffix :: acc)
+  in String.concat after (search [] 0)
+
+let rev_split_words s =
+  let rec split1 res i =
+    if i >= String.length s then res else begin
+      match s.[i] with
+        ' ' | '\t' | '\r' | '\n' -> split1 res (i+1)
+      | _ -> split2 res i (i+1)
+    end
+  and split2 res i j =
+    if j >= String.length s then String.sub s i (j-i) :: res else begin
+      match s.[j] with
+        ' ' | '\t' | '\r' | '\n' -> split1 (String.sub s i (j-i) :: res) (j+1)
+      | _ -> split2 res i (j+1)
+    end
+  in split1 [] 0
+
+let get_ref r =
+  let v = !r in
+  r := []; v
+
+let set_or_ignore f opt x =
+  match f x with
+  | None -> ()
+  | Some y -> opt := Some y
+
+let fst3 (x, _, _) = x
+let snd3 (_,x,_) = x
+let thd3 (_,_,x) = x
+
+let fst4 (x, _, _, _) = x
+let snd4 (_,x,_, _) = x
+let thd4 (_,_,x,_) = x
+let for4 (_,_,_,x) = x
+
+
+module LongString = struct
+  type t = bytes array
+
+  let create str_size =
+    let tbl_size = str_size / Sys.max_string_length + 1 in
+    let tbl = Array.make tbl_size Bytes.empty in
+    for i = 0 to tbl_size - 2 do
+      tbl.(i) <- Bytes.create Sys.max_string_length;
+    done;
+    tbl.(tbl_size - 1) <- Bytes.create (str_size mod Sys.max_string_length);
+    tbl
+
+  let length tbl =
+    let tbl_size = Array.length tbl in
+    Sys.max_string_length * (tbl_size - 1) + Bytes.length tbl.(tbl_size - 1)
+
+  let get tbl ind =
+    Bytes.get tbl.(ind / Sys.max_string_length) (ind mod Sys.max_string_length)
+
+  let set tbl ind c =
+    Bytes.set tbl.(ind / Sys.max_string_length) (ind mod Sys.max_string_length)
+              c
+
+  let blit src srcoff dst dstoff len =
+    for i = 0 to len - 1 do
+      set dst (dstoff + i) (get src (srcoff + i))
+    done
+
+  let blit_string src srcoff dst dstoff len =
+    for i = 0 to len - 1 do
+      set dst (dstoff + i) (String.get src (srcoff + i))
+    done
+
+  let output oc tbl pos len =
+    for i = pos to pos + len - 1 do
+      output_char oc (get tbl i)
+    done
+
+  let input_bytes_into tbl ic len =
+    let count = ref len in
+    Array.iter (fun str ->
+      let chunk = min !count (Bytes.length str) in
+      really_input ic str 0 chunk;
+      count := !count - chunk) tbl
+
+  let input_bytes ic len =
+    let tbl = create len in
+    input_bytes_into tbl ic len;
+    tbl
+end
+
+
+let edit_distance a b cutoff =
+  let la, lb = String.length a, String.length b in
+  let cutoff =
+    (* using max_int for cutoff would cause overflows in (i + cutoff + 1);
+       we bring it back to the (max la lb) worstcase *)
+    min (max la lb) cutoff in
+  if abs (la - lb) > cutoff then None
+  else begin
+    (* initialize with 'cutoff + 1' so that not-yet-written-to cases have
+       the worst possible cost; this is useful when computing the cost of
+       a case just at the boundary of the cutoff diagonal. *)
+    let m = Array.make_matrix (la + 1) (lb + 1) (cutoff + 1) in
+    m.(0).(0) <- 0;
+    for i = 1 to la do
+      m.(i).(0) <- i;
+    done;
+    for j = 1 to lb do
+      m.(0).(j) <- j;
+    done;
+    for i = 1 to la do
+      for j = max 1 (i - cutoff - 1) to min lb (i + cutoff + 1) do
+        let cost = if a.[i-1] = b.[j-1] then 0 else 1 in
+        let best =
+          (* insert, delete or substitute *)
+          min (1 + min m.(i-1).(j) m.(i).(j-1)) (m.(i-1).(j-1) + cost)
+        in
+        let best =
+          (* swap two adjacent letters; we use "cost" again in case of
+             a swap between two identical letters; this is slightly
+             redundant as this is a double-substitution case, but it
+             was done this way in most online implementations and
+             imitation has its virtues *)
+          if not (i > 1 && j > 1 && a.[i-1] = b.[j-2] && a.[i-2] = b.[j-1])
+          then best
+          else min best (m.(i-2).(j-2) + cost)
+        in
+        m.(i).(j) <- best
+      done;
+    done;
+    let result = m.(la).(lb) in
+    if result > cutoff
+    then None
+    else Some result
+  end
+
+let spellcheck env name =
+  let cutoff =
+    match String.length name with
+      | 1 | 2 -> 0
+      | 3 | 4 -> 1
+      | 5 | 6 -> 2
+      | _ -> 3
+  in
+  let compare target acc head =
+    match edit_distance target head cutoff with
+      | None -> acc
+      | Some dist ->
+         let (best_choice, best_dist) = acc in
+         if dist < best_dist then ([head], dist)
+         else if dist = best_dist then (head :: best_choice, dist)
+         else acc
+  in
+  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 =
+  (* 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 "@?";
+  match get_choices () with
+  | [] -> ()
+  | choices ->
+     let rest, last = split_last choices in
+     Format.fprintf ppf "@\nHint: Did you mean %s%s%s?@?"
+       (String.concat ", " rest)
+       (if rest = [] then "" else " or ")
+       last
+
+let cut_at s c =
+  let pos = String.index s c in
+  String.sub s 0 pos, String.sub s (pos+1) (String.length s - pos - 1)
+
+(* Color handling *)
+module Color = struct
+  (* use ANSI color codes, see https://en.wikipedia.org/wiki/ANSI_escape_code *)
+  type color =
+    | Black
+    | Red
+    | Green
+    | Yellow
+    | Blue
+    | Magenta
+    | Cyan
+    | White
+  ;;
+
+  type style =
+    | FG of color (* foreground *)
+    | BG of color (* background *)
+    | Bold
+    | Reset
+
+  let ansi_of_color = function
+    | Black -> "0"
+    | Red -> "1"
+    | Green -> "2"
+    | Yellow -> "3"
+    | Blue -> "4"
+    | Magenta -> "5"
+    | Cyan -> "6"
+    | White -> "7"
+
+  let code_of_style = function
+    | FG c -> "3" ^ ansi_of_color c
+    | BG c -> "4" ^ ansi_of_color c
+    | Bold -> "1"
+    | Reset -> "0"
+
+  let ansi_of_style_l l =
+    let s = match l with
+      | [] -> code_of_style Reset
+      | [s] -> code_of_style s
+      | _ -> String.concat ";" (List.map code_of_style l)
+    in
+    "\x1b[" ^ s ^ "m"
+
+  type styles = {
+    error: style list;
+    warning: style list;
+    loc: style list;
+  }
+
+  let default_styles = {
+    warning = [Bold; FG Magenta];
+    error = [Bold; FG Red];
+    loc = [Bold];
+  }
+
+  let cur_styles = ref default_styles
+  let get_styles () = !cur_styles
+  let set_styles s = cur_styles := s
+
+  (* map a tag to a style, if the tag is known.
+     @raise Not_found otherwise *)
+  let style_of_tag s = match s with
+    | Format.String_tag "error" -> (!cur_styles).error
+    | Format.String_tag "warning" -> (!cur_styles).warning
+    | Format.String_tag "loc" -> (!cur_styles).loc
+    | _ -> raise Not_found
+
+  let color_enabled = ref true
+
+  (* either prints the tag of [s] or delegates to [or_else] *)
+  let mark_open_tag ~or_else s =
+    try
+      let style = style_of_tag s in
+      if !color_enabled then ansi_of_style_l style else ""
+    with Not_found -> or_else s
+
+  let mark_close_tag ~or_else s =
+    try
+      let _ = style_of_tag s in
+      if !color_enabled then ansi_of_style_l [Reset] else ""
+    with Not_found -> or_else s
+
+  (* add color handling to formatter [ppf] *)
+  let set_color_tag_handling ppf =
+    let open Format in
+    let functions = pp_get_formatter_stag_functions ppf () in
+    let functions' = {functions with
+      mark_open_stag=(mark_open_tag ~or_else:functions.mark_open_stag);
+      mark_close_stag=(mark_close_tag ~or_else:functions.mark_close_stag);
+    } in
+    pp_set_mark_tags ppf true; (* enable tags *)
+    pp_set_formatter_stag_functions ppf functions';
+    ()
+
+  external isatty : out_channel -> bool = "caml_sys_isatty"
+
+  (* reasonable heuristic on whether colors should be enabled *)
+  let should_enable_color () =
+    let term = try Sys.getenv "TERM" with Not_found -> "" in
+    term <> "dumb"
+    && term <> ""
+    && isatty stderr
+
+  type setting = Auto | Always | Never
+
+  let default_setting = Auto
+
+  let setup =
+    let first = ref true in (* initialize only once *)
+    let formatter_l =
+      [Format.std_formatter; Format.err_formatter; Format.str_formatter]
+    in
+    let enable_color = function
+      | Auto -> should_enable_color ()
+      | Always -> true
+      | Never -> false
+    in
+    fun o ->
+      if !first then (
+        first := false;
+        Format.set_mark_tags true;
+        List.iter set_color_tag_handling formatter_l;
+        color_enabled := (match o with
+          | Some s -> enable_color s
+          | None -> enable_color default_setting)
+      );
+      ()
+end
+
+module Error_style = struct
+  type setting =
+    | Contextual
+    | Short
+
+  let default_setting = Contextual
+end
+
+let normalise_eol s =
+  let b = Buffer.create 80 in
+    for i = 0 to String.length s - 1 do
+      if s.[i] <> '\r' then Buffer.add_char b s.[i]
+    done;
+    Buffer.contents b
+
+let delete_eol_spaces src =
+  let len_src = String.length src in
+  let dst = Bytes.create len_src in
+  let rec loop i_src i_dst =
+    if i_src = len_src then
+      i_dst
+    else
+      match src.[i_src] with
+      | ' ' | '\t' ->
+        loop_spaces 1 (i_src + 1) i_dst
+      | c ->
+        Bytes.set dst i_dst c;
+        loop (i_src + 1) (i_dst + 1)
+  and loop_spaces spaces i_src i_dst =
+    if i_src = len_src then
+      i_dst
+    else
+      match src.[i_src] with
+      | ' ' | '\t' ->
+        loop_spaces (spaces + 1) (i_src + 1) i_dst
+      | '\n' ->
+        Bytes.set dst i_dst '\n';
+        loop (i_src + 1) (i_dst + 1)
+      | _ ->
+        for n = 0 to spaces do
+          Bytes.set dst (i_dst + n) src.[i_src - spaces + n]
+        done;
+        loop (i_src + 1) (i_dst + spaces + 1)
+  in
+  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, _) -> 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 "@[";
+  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;
+  exit 0
+
+let show_config_variable_and_exit x =
+  match Config.config_var x with
+  | Some v ->
+      (* we intentionally don't print a newline to avoid Windows \r
+         issues: bash only strips the trailing \n when using a command
+         substitution $(ocamlc -config-var foo), so a trailing \r would
+         remain if printing a newline under Windows and scripts would
+         have to use $(ocamlc -config-var foo | tr -d '\r')
+         for portability. Ugh. *)
+      print_string v;
+      exit 0
+  | None ->
+      exit 2
+
+let get_build_path_prefix_map =
+  let init = ref false in
+  let map_cache = ref None in
+  fun () ->
+    if not !init then begin
+      init := true;
+      match Sys.getenv "BUILD_PATH_PREFIX_MAP" with
+      | exception Not_found -> ()
+      | encoded_map ->
+        match Build_path_prefix_map.decode_map encoded_map with
+          | Error err ->
+              fatal_errorf
+                "Invalid value for the environment variable \
+                 BUILD_PATH_PREFIX_MAP: %s" err
+          | Ok map -> map_cache := Some map
+    end;
+    !map_cache
+
+let debug_prefix_map_flags () =
+  if not Config.as_has_debug_prefix_map then
+    []
+  else begin
+    match get_build_path_prefix_map () with
+    | None -> []
+    | Some map ->
+      List.fold_right
+        (fun map_elem acc ->
+           match map_elem with
+           | None -> acc
+           | Some { Build_path_prefix_map.target; source; } ->
+             (Printf.sprintf "--debug-prefix-map %s=%s"
+                (Filename.quote source)
+                (Filename.quote target)) :: acc)
+        map
+        []
+  end
+
+let print_if ppf flag printer arg =
+  if !flag then Format.fprintf ppf "%a@." printer arg;
+  arg
+
+
+type filepath = string
+type modname = string
+type crcs = (modname * Digest.t option) list
+
+type alerts = string Stdlib.String.Map.t
+
+
+module EnvLazy = struct
+  type ('a,'b) t = ('a,'b) eval ref
+
+  and ('a,'b) eval =
+    | Done of 'b
+    | Raise of exn
+    | Thunk of 'a
+
+  type undo =
+    | Nil
+    | Cons : ('a, 'b) t * 'a * undo -> undo
+
+  type log = undo ref
+
+  let force f x =
+    match !x with
+    | Done x -> x
+    | Raise e -> raise e
+    | Thunk e ->
+        match f e with
+        | y ->
+          x := Done y;
+          y
+        | exception e ->
+          x := Raise e;
+          raise e
+
+  let get_arg x =
+    match !x with Thunk a -> Some a | _ -> None
+
+  let create x =
+    ref (Thunk x)
+
+  let create_forced y =
+    ref (Done y)
+
+  let create_failed e =
+    ref (Raise e)
+
+  let log () =
+    ref Nil
+
+  let force_logged log f x =
+    match !x with
+    | Done x -> x
+    | Raise e -> raise e
+    | Thunk e ->
+      match f e with
+      | (Error _ as err : _ result) ->
+          x := Done err;
+          log := Cons(x, e, !log);
+          err
+      | Ok _ as res ->
+          x := Done res;
+          res
+      | exception e ->
+          x := Raise e;
+          raise e
+
+  let backtrack log =
+    let rec loop = function
+      | Nil -> ()
+      | Cons(x, e, rest) ->
+          x := Thunk e;
+          loop rest
+    in
+    loop !log
+
+end
+
+
+module Magic_number = struct
+  type native_obj_config = {
+    flambda : bool;
+  }
+  let native_obj_config = {
+    flambda = Config.flambda;
+  }
+
+  type version = int
+
+  type kind =
+    | Exec
+    | Cmi | Cmo | Cma
+    | Cmx of native_obj_config | Cmxa of native_obj_config
+    | Cmxs
+    | Cmt
+    | Ast_impl | Ast_intf
+
+  (* please keep up-to-date, this is used for sanity checking *)
+  let all_native_obj_configs = [
+      {flambda = true};
+      {flambda = false};
+    ]
+  let all_kinds = [
+    Exec;
+    Cmi; Cmo; Cma;
+  ]
+  @ List.map (fun conf -> Cmx conf) all_native_obj_configs
+  @ List.map (fun conf -> Cmxa conf) all_native_obj_configs
+  @ [
+    Cmt;
+    Ast_impl; Ast_intf;
+  ]
+
+  type raw = string
+  type info = {
+    kind: kind;
+    version: version;
+  }
+
+  type raw_kind = string
+
+  let parse_kind : raw_kind -> kind option = function
+    | "Caml1999X" -> Some Exec
+    | "Caml1999I" -> Some Cmi
+    | "Caml1999O" -> Some Cmo
+    | "Caml1999A" -> Some Cma
+    | "Caml1999y" -> Some (Cmx {flambda = true})
+    | "Caml1999Y" -> Some (Cmx {flambda = false})
+    | "Caml1999z" -> Some (Cmxa {flambda = true})
+    | "Caml1999Z" -> Some (Cmxa {flambda = false})
+
+    (* Caml2007D and Caml2012T were used instead of the common Caml1999 prefix
+       between the introduction of those magic numbers and October 2017
+       (8ba70ff194b66c0a50ffb97d41fe9c4bdf9362d6).
+
+       We accept them here, but will always produce/show kind prefixes
+       that follow the current convention, Caml1999{D,T}. *)
+    | "Caml2007D" | "Caml1999D" -> Some Cmxs
+    | "Caml2012T" | "Caml1999T" -> Some Cmt
+
+    | "Caml1999M" -> Some Ast_impl
+    | "Caml1999N" -> Some Ast_intf
+    | _ -> None
+
+  (* note: over time the magic kind number has changed for certain kinds;
+     this function returns them as they are produced by the current compiler,
+     but [parse_kind] accepts older formats as well. *)
+  let raw_kind : kind -> raw = function
+    | Exec -> "Caml1999X"
+    | Cmi -> "Caml1999I"
+    | Cmo -> "Caml1999O"
+    | Cma -> "Caml1999A"
+    | Cmx config ->
+       if config.flambda
+       then "Caml1999y"
+       else "Caml1999Y"
+    | Cmxa config ->
+       if config.flambda
+       then "Caml1999z"
+       else "Caml1999Z"
+    | Cmxs -> "Caml1999D"
+    | Cmt -> "Caml1999T"
+    | Ast_impl -> "Caml1999M"
+    | Ast_intf -> "Caml1999N"
+
+  let string_of_kind : kind -> string = function
+    | Exec -> "exec"
+    | Cmi -> "cmi"
+    | Cmo -> "cmo"
+    | Cma -> "cma"
+    | Cmx _ -> "cmx"
+    | Cmxa _ -> "cmxa"
+    | Cmxs -> "cmxs"
+    | Cmt -> "cmt"
+    | Ast_impl -> "ast_impl"
+    | Ast_intf -> "ast_intf"
+
+  let human_description_of_native_obj_config : native_obj_config -> string =
+    fun[@warning "+9"] {flambda} ->
+      if flambda then "flambda" else "non flambda"
+
+  let human_name_of_kind : kind -> string = function
+    | Exec -> "executable"
+    | Cmi -> "compiled interface file"
+    | Cmo -> "bytecode object file"
+    | Cma -> "bytecode library"
+    | Cmx config ->
+       Printf.sprintf "native compilation unit description (%s)"
+         (human_description_of_native_obj_config config)
+    | Cmxa config ->
+       Printf.sprintf "static native library (%s)"
+         (human_description_of_native_obj_config config)
+    | Cmxs -> "dynamic native library"
+    | Cmt -> "compiled typedtree file"
+    | Ast_impl -> "serialized implementation AST"
+    | Ast_intf -> "serialized interface AST"
+
+  let kind_length = 9
+  let version_length = 3
+  let magic_length =
+    kind_length + version_length
+
+  type parse_error =
+    | Truncated of string
+    | Not_a_magic_number of string
+
+  let explain_parse_error kind_opt error =
+       Printf.sprintf
+         "We expected a valid %s, but the file %s."
+         (Option.fold ~none:"object file" ~some:human_name_of_kind kind_opt)
+         (match error with
+            | Truncated "" -> "is empty"
+            | Truncated _ -> "is truncated"
+            | Not_a_magic_number _ -> "has a different format")
+
+  let parse s : (info, parse_error) result =
+    if String.length s = magic_length then begin
+      let raw_kind = String.sub s 0 kind_length in
+      let raw_version = String.sub s kind_length version_length in
+      match parse_kind raw_kind with
+      | None -> Error (Not_a_magic_number s)
+      | Some kind ->
+          begin match int_of_string raw_version with
+          | exception _ -> Error (Truncated s)
+          | version -> Ok { kind; version }
+          end
+    end
+    else begin
+      (* a header is "truncated" if it starts like a valid magic number,
+         that is if its longest segment of length at most [kind_length]
+         is a prefix of [raw_kind kind] for some kind [kind] *)
+      let sub_length = min kind_length (String.length s) in
+      let starts_as kind =
+        String.sub s 0 sub_length = String.sub (raw_kind kind) 0 sub_length
+      in
+      if List.exists starts_as all_kinds then Error (Truncated s)
+      else Error (Not_a_magic_number s)
+    end
+
+  let read_info ic =
+    let header = Buffer.create magic_length in
+    begin
+      try Buffer.add_channel header ic magic_length
+      with End_of_file -> ()
+    end;
+    parse (Buffer.contents header)
+
+  let raw { kind; version; } =
+    Printf.sprintf "%s%03d" (raw_kind kind) version
+
+  let current_raw kind =
+    let open Config in
+    match[@warning "+9"] kind with
+      | Exec -> exec_magic_number
+      | Cmi -> cmi_magic_number
+      | Cmo -> cmo_magic_number
+      | Cma -> cma_magic_number
+      | Cmx config ->
+         (* the 'if' guarantees that in the common case
+            we return the "trusted" value from Config. *)
+         let reference = cmx_magic_number in
+         if config = native_obj_config then reference
+         else
+           (* otherwise we stitch together the magic number
+              for a different configuration by concatenating
+              the right magic kind at this configuration
+              and the rest of the current raw number for our configuration. *)
+           let raw_kind = raw_kind kind in
+           let len = String.length raw_kind in
+           raw_kind ^ String.sub reference len (String.length reference - len)
+      | Cmxa config ->
+         let reference = cmxa_magic_number in
+         if config = native_obj_config then reference
+         else
+           let raw_kind = raw_kind kind in
+           let len = String.length raw_kind in
+           raw_kind ^ String.sub reference len (String.length reference - len)
+      | Cmxs -> cmxs_magic_number
+      | Cmt -> cmt_magic_number
+      | Ast_intf -> ast_intf_magic_number
+      | Ast_impl -> ast_impl_magic_number
+
+  (* it would seem more direct to define current_version with the
+     correct numbers and current_raw on top of it, but for now we
+     consider the Config.foo values to be ground truth, and don't want
+     to trust the present module instead. *)
+  let current_version kind =
+    let raw = current_raw kind in
+    try int_of_string (String.sub raw kind_length version_length)
+    with _ -> assert false
+
+  type 'a unexpected = { expected : 'a; actual : 'a }
+  type unexpected_error =
+    | Kind of kind unexpected
+    | Version of kind * version unexpected
+
+  let explain_unexpected_error = function
+    | Kind { actual; expected } ->
+        Printf.sprintf "We expected a %s (%s) but got a %s (%s) instead."
+          (human_name_of_kind expected) (string_of_kind expected)
+          (human_name_of_kind actual) (string_of_kind actual)
+    | Version (kind, { actual; expected }) ->
+        Printf.sprintf "This seems to be a %s (%s) for %s version of OCaml."
+          (human_name_of_kind kind) (string_of_kind kind)
+          (if actual < expected then "an older" else "a newer")
+
+  let check_current expected_kind { kind; version } : _ result =
+    if kind <> expected_kind then begin
+      let actual, expected = kind, expected_kind in
+      Error (Kind { actual; expected })
+    end else begin
+      let actual, expected = version, current_version kind in
+      if actual <> expected
+      then Error (Version (kind, { actual; expected }))
+      else Ok ()
+    end
+
+  type error =
+    | Parse_error of parse_error
+    | Unexpected_error of unexpected_error
+
+  let read_current_info ~expected_kind ic =
+    match read_info ic with
+      | Error err -> Error (Parse_error err)
+      | Ok info ->
+         let kind = Option.value ~default:info.kind expected_kind in
+         match check_current kind info with
+           | Error err -> Error (Unexpected_error err)
+           | Ok () -> Ok info
+end
diff --git a/utils/misc.mli b/utils/misc.mli
new file mode 100644
index 00000000..9af10596
--- /dev/null
+++ b/utils/misc.mli
@@ -0,0 +1,688 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Miscellaneous useful types and functions
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+val fatal_error: string -> 'a
+val fatal_errorf: ('a, Format.formatter, unit, 'b) format4 -> 'a
+exception Fatal_error
+
+val try_finally :
+  ?always:(unit -> unit) ->
+  ?exceptionally:(unit -> unit) ->
+  (unit -> 'a) -> 'a
+(** [try_finally work ~always ~exceptionally] is designed to run code
+    in [work] that may fail with an exception, and has two kind of
+    cleanup routines: [always], that must be run after any execution
+    of the function (typically, freeing system resources), and
+    [exceptionally], that should be run only if [work] or [always]
+    failed with an exception (typically, undoing user-visible state
+    changes that would only make sense if the function completes
+    correctly). For example:
+
+    {[
+      let objfile = outputprefix ^ ".cmo" in
+      let oc = open_out_bin objfile in
+      Misc.try_finally
+        (fun () ->
+           bytecode
+           ++ Timings.(accumulate_time (Generate sourcefile))
+               (Emitcode.to_file oc modulename objfile);
+           Warnings.check_fatal ())
+        ~always:(fun () -> close_out oc)
+        ~exceptionally:(fun _exn -> remove_file objfile);
+    ]}
+
+    If [exceptionally] fail with an exception, it is propagated as
+    usual.
+
+    If [always] or [exceptionally] use exceptions internally for
+    control-flow but do not raise, then [try_finally] is careful to
+    preserve any exception backtrace coming from [work] or [always]
+    for easier debugging.
+*)
+
+
+val map_end: ('a -> 'b) -> 'a list -> 'b list -> 'b list
+        (* [map_end f l t] is [map f l @ t], just more efficient. *)
+val map_left_right: ('a -> 'b) -> 'a list -> 'b list
+        (* Like [List.map], with guaranteed left-to-right evaluation order *)
+val for_all2: ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
+        (* Same as [List.for_all] but for a binary predicate.
+           In addition, this [for_all2] never fails: given two lists
+           with different lengths, it returns false. *)
+val replicate_list: 'a -> int -> 'a list
+        (* [replicate_list elem n] is the list with [n] elements
+           all identical to [elem]. *)
+val list_remove: 'a -> 'a list -> 'a list
+        (* [list_remove x l] returns a copy of [l] with the first
+           element equal to [x] removed. *)
+val split_last: 'a list -> 'a list * 'a
+        (* Return the last element and the other elements of the given list. *)
+
+type ref_and_value = R : 'a ref * 'a -> ref_and_value
+
+val protect_refs : ref_and_value list -> (unit -> 'a) -> 'a
+(** [protect_refs l f] temporarily sets [r] to [v] for each [R (r, v)] in [l]
+    while executing [f]. The previous contents of the references is restored
+    even if [f] raises an exception, without altering the exception backtrace.
+*)
+
+module Stdlib : sig
+  module List : sig
+    type 'a t = 'a list
+
+    val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
+    (** The lexicographic order supported by the provided order.
+        There is no constraint on the relative lengths of the lists. *)
+
+    val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+    (** Returns [true] iff the given lists have the same length and content
+        with respect to the given equality function. *)
+
+    val find_map : ('a -> 'b option) -> 'a t -> 'b option
+    (** [find_map f l] returns the first evaluation of [f] that returns [Some],
+       or returns None if there is no such element. *)
+
+    val some_if_all_elements_are_some : 'a option t -> 'a t option
+    (** If all elements of the given list are [Some _] then [Some xs]
+        is returned with the [xs] being the contents of those [Some]s, with
+        order preserved.  Otherwise return [None]. *)
+
+    val map2_prefix : ('a -> 'b -> 'c) -> 'a t -> 'b t -> ('c t * 'b t)
+    (** [let r1, r2 = map2_prefix f l1 l2]
+        If [l1] is of length n and [l2 = h2 @ t2] with h2 of length n,
+        r1 is [List.map2 f l1 h1] and r2 is t2. *)
+
+    val split_at : int -> 'a t -> 'a t * 'a t
+    (** [split_at n l] returns the pair [before, after] where [before] is
+        the [n] first elements of [l] and [after] the remaining ones.
+        If [l] has less than [n] elements, raises Invalid_argument. *)
+
+    val is_prefix
+       : equal:('a -> 'a -> bool)
+      -> 'a list
+      -> of_:'a list
+      -> bool
+    (** Returns [true] iff the given list, with respect to the given equality
+        function on list members, is a prefix of the list [of_]. *)
+
+    type 'a longest_common_prefix_result = private {
+      longest_common_prefix : 'a list;
+      first_without_longest_common_prefix : 'a list;
+      second_without_longest_common_prefix : 'a list;
+    }
+
+    val find_and_chop_longest_common_prefix
+       : equal:('a -> 'a -> bool)
+      -> first:'a list
+      -> second:'a list
+      -> 'a longest_common_prefix_result
+    (** Returns the longest list that, with respect to the provided equality
+        function, is a prefix of both of the given lists.  The input lists,
+        each with such longest common prefix removed, are also returned. *)
+  end
+
+  module Option : sig
+    type 'a t = 'a option
+
+    val print
+       : (Format.formatter -> 'a -> unit)
+      -> Format.formatter
+      -> 'a t
+      -> unit
+  end
+
+  module Array : sig
+    val exists2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool
+    (* Same as [Array.exists], but for a two-argument predicate. Raise
+       Invalid_argument if the two arrays are determined to have
+       different lengths. *)
+
+    val for_alli : (int -> 'a -> bool) -> 'a array -> bool
+    (** Same as {!Array.for_all}, but the
+        function is applied with the index of the element as first argument,
+        and the element itself as second argument. *)
+
+    val all_somes : 'a option array -> 'a array option
+  end
+
+  module String : sig
+    include module type of String
+    module Set : Set.S with type elt = string
+    module Map : Map.S with type key = string
+    module Tbl : Hashtbl.S with type key = string
+
+    val print : Format.formatter -> t -> unit
+
+    val for_all : (char -> bool) -> t -> bool
+  end
+
+  external compare : 'a -> 'a -> int = "%compare"
+end
+
+val find_in_path: string list -> string -> string
+        (* Search a file in a list of directories. *)
+val find_in_path_rel: string list -> string -> string
+        (* Search a relative file in a list of directories. *)
+val find_in_path_uncap: string list -> string -> string
+        (* Same, but search also for uncapitalized name, i.e.
+           if name is Foo.ml, allow /path/Foo.ml and /path/foo.ml
+           to match. *)
+val remove_file: string -> unit
+        (* Delete the given file if it exists. Never raise an error. *)
+val expand_directory: string -> string -> string
+        (* [expand_directory alt file] eventually expands a [+] at the
+           beginning of file into [alt] (an alternate root directory) *)
+
+val split_path_contents: ?sep:char -> string -> string list
+(* [split_path_contents ?sep s] interprets [s] as the value of a "PATH"-like
+   variable and returns the corresponding list of directories. [s] is split
+   using the platform-specific delimiter, or [~sep] if it is passed.
+
+   Returns the empty list if [s] is empty. *)
+
+val create_hashtable: int -> ('a * 'b) list -> ('a, 'b) Hashtbl.t
+        (* Create a hashtable of the given size and fills it with the
+           given bindings. *)
+
+val copy_file: in_channel -> out_channel -> unit
+        (* [copy_file ic oc] reads the contents of file [ic] and copies
+           them to [oc]. It stops when encountering EOF on [ic]. *)
+val copy_file_chunk: in_channel -> out_channel -> int -> unit
+        (* [copy_file_chunk ic oc n] reads [n] bytes from [ic] and copies
+           them to [oc]. It raises [End_of_file] when encountering
+           EOF on [ic]. *)
+val string_of_file: in_channel -> string
+        (* [string_of_file ic] reads the contents of file [ic] and copies
+           them to a string. It stops when encountering EOF on [ic]. *)
+val output_to_file_via_temporary:
+      ?mode:open_flag list -> string -> (string -> out_channel -> 'a) -> 'a
+        (* Produce output in temporary file, then rename it
+           (as atomically as possible) to the desired output file name.
+           [output_to_file_via_temporary filename fn] opens a temporary file
+           which is passed to [fn] (name + output channel).  When [fn] returns,
+           the channel is closed and the temporary file is renamed to
+           [filename]. *)
+
+(** Open the given [filename] for writing (in binary mode), pass the
+    [out_channel] to the given function, then close the channel. If the function
+    raises an exception then [filename] will be removed. *)
+val protect_writing_to_file
+   : filename:string
+  -> f:(out_channel -> 'a)
+  -> 'a
+
+val log2: int -> int
+        (* [log2 n] returns [s] such that [n = 1 lsl s]
+           if [n] is a power of 2*)
+val align: int -> int -> int
+        (* [align n a] rounds [n] upwards to a multiple of [a]
+           (a power of 2). *)
+val no_overflow_add: int -> int -> bool
+        (* [no_overflow_add n1 n2] returns [true] if the computation of
+           [n1 + n2] does not overflow. *)
+val no_overflow_sub: int -> int -> bool
+        (* [no_overflow_sub n1 n2] returns [true] if the computation of
+           [n1 - n2] does not overflow. *)
+val no_overflow_mul: int -> int -> bool
+        (* [no_overflow_mul n1 n2] returns [true] if the computation of
+           [n1 * n2] does not overflow. *)
+val no_overflow_lsl: int -> int -> bool
+        (* [no_overflow_lsl n k] returns [true] if the computation of
+           [n lsl k] does not overflow. *)
+
+module Int_literal_converter : sig
+  val int : string -> int
+  val int32 : string -> int32
+  val int64 : string -> int64
+  val nativeint : string -> nativeint
+end
+
+val chop_extensions: string -> string
+        (* Return the given file name without its extensions. The extensions
+           is the longest suffix starting with a period and not including
+           a directory separator, [.xyz.uvw] for instance.
+
+           Return the given name if it does not contain an extension. *)
+
+val search_substring: string -> string -> int -> int
+        (* [search_substring pat str start] returns the position of the first
+           occurrence of string [pat] in string [str].  Search starts
+           at offset [start] in [str].  Raise [Not_found] if [pat]
+           does not occur. *)
+
+val replace_substring: before:string -> after:string -> string -> string
+        (* [replace_substring ~before ~after str] replaces all
+           occurrences of [before] with [after] in [str] and returns
+           the resulting string. *)
+
+val rev_split_words: string -> string list
+        (* [rev_split_words s] splits [s] in blank-separated words, and returns
+           the list of words in reverse order. *)
+
+val get_ref: 'a list ref -> 'a list
+        (* [get_ref lr] returns the content of the list reference [lr] and reset
+           its content to the empty list. *)
+
+val set_or_ignore : ('a -> 'b option) -> 'b option ref -> 'a -> unit
+        (* [set_or_ignore f opt x] sets [opt] to [f x] if it returns [Some _],
+           or leaves it unmodified if it returns [None]. *)
+
+val fst3: 'a * 'b * 'c -> 'a
+val snd3: 'a * 'b * 'c -> 'b
+val thd3: 'a * 'b * 'c -> 'c
+
+val fst4: 'a * 'b * 'c * 'd -> 'a
+val snd4: 'a * 'b * 'c * 'd -> 'b
+val thd4: 'a * 'b * 'c * 'd -> 'c
+val for4: 'a * 'b * 'c * 'd -> 'd
+
+module LongString :
+  sig
+    type t = bytes array
+    val create : int -> t
+    val length : t -> int
+    val get : t -> int -> char
+    val set : t -> int -> char -> unit
+    val blit : t -> int -> t -> int -> int -> unit
+    val blit_string : string -> int -> t -> int -> int -> unit
+    val output : out_channel -> t -> int -> int -> unit
+    val input_bytes_into : t -> in_channel -> int -> unit
+    val input_bytes : in_channel -> int -> t
+  end
+
+val edit_distance : string -> string -> int -> int option
+(** [edit_distance a b cutoff] computes the edit distance between
+    strings [a] and [b]. To help efficiency, it uses a cutoff: if the
+    distance [d] is smaller than [cutoff], it returns [Some d], else
+    [None].
+
+    The distance algorithm currently used is Damerau-Levenshtein: it
+    computes the number of insertion, deletion, substitution of
+    letters, or swapping of adjacent letters to go from one word to the
+    other. The particular algorithm may change in the future.
+*)
+
+val spellcheck : string list -> string -> string list
+(** [spellcheck env name] takes a list of names [env] that exist in
+    the current environment and an erroneous [name], and returns a
+    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
+(** [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.
+
+    The [unit -> ...] thunking is meant to delay any potentially-slow
+    computation (typically computing edit-distance with many things
+    from the current environment) to when the hint message is to be
+    printed. You should print an understandable error message before
+    calling [did_you_mean], so that users get a clear notification of
+    the failure even if producing the hint is slow.
+*)
+
+val cut_at : string -> char -> string * string
+(** [String.cut_at s c] returns a pair containing the sub-string before
+   the first occurrence of [c] in [s], and the sub-string after the
+   first occurrence of [c] in [s].
+   [let (before, after) = String.cut_at s c in
+    before ^ String.make 1 c ^ after] is the identity if [s] contains [c].
+
+   Raise [Not_found] if the character does not appear in the string
+   @since 4.01
+*)
+
+(* Color handling *)
+module Color : sig
+  type color =
+    | Black
+    | Red
+    | Green
+    | Yellow
+    | Blue
+    | Magenta
+    | Cyan
+    | White
+  ;;
+
+  type style =
+    | FG of color (* foreground *)
+    | BG of color (* background *)
+    | Bold
+    | Reset
+
+  val ansi_of_style_l : style list -> string
+  (* ANSI escape sequence for the given style *)
+
+  type styles = {
+    error: style list;
+    warning: style list;
+    loc: style list;
+  }
+
+  val default_styles: styles
+  val get_styles: unit -> styles
+  val set_styles: styles -> unit
+
+  type setting = Auto | Always | Never
+
+  val default_setting : setting
+
+  val setup : setting option -> unit
+  (* [setup opt] will enable or disable color handling on standard formatters
+     according to the value of color setting [opt].
+     Only the first call to this function has an effect. *)
+
+  val set_color_tag_handling : Format.formatter -> unit
+  (* adds functions to support color tags to the given formatter. *)
+end
+
+(* See the -error-style option *)
+module Error_style : sig
+  type setting =
+    | Contextual
+    | Short
+
+  val default_setting : setting
+end
+
+val normalise_eol : string -> string
+(** [normalise_eol s] returns a fresh copy of [s] with any '\r' characters
+   removed. Intended for pre-processing text which will subsequently be printed
+   on a channel which performs EOL transformations (i.e. Windows) *)
+
+val delete_eol_spaces : string -> string
+(** [delete_eol_spaces s] returns a fresh copy of [s] with any end of
+   line spaces removed. Intended to normalize the output of the
+   toplevel for tests. *)
+
+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}
+*)
+
+(** configuration variables *)
+val show_config_and_exit : unit -> unit
+val show_config_variable_and_exit : string -> unit
+
+val get_build_path_prefix_map: unit -> Build_path_prefix_map.map option
+(** Returns the map encoded in the [BUILD_PATH_PREFIX_MAP] environment
+    variable. *)
+
+val debug_prefix_map_flags: unit -> string list
+(** Returns the list of [--debug-prefix-map] flags to be passed to the
+    assembler, built from the [BUILD_PATH_PREFIX_MAP] environment variable. *)
+
+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. *)
+
+
+type filepath = string
+type modname = string
+type crcs = (modname * Digest.t option) list
+
+type alerts = string Stdlib.String.Map.t
+
+
+module EnvLazy: sig
+  type ('a,'b) t
+
+  type log
+
+  val force : ('a -> 'b) -> ('a,'b) t -> 'b
+  val create : 'a -> ('a,'b) t
+  val get_arg : ('a,'b) t -> 'a option
+  val create_forced : 'b -> ('a, 'b) t
+  val create_failed : exn -> ('a, 'b) t
+
+  (* [force_logged log f t] is equivalent to [force f t] but if [f]
+     returns [Error _] then [t] is recorded in [log]. [backtrack log]
+     will then reset all the recorded [t]s back to their original
+     state. *)
+  val log : unit -> log
+  val force_logged :
+    log -> ('a -> ('b, 'c) result) -> ('a,('b, 'c) result) t -> ('b, 'c) result
+  val backtrack : log -> unit
+
+end
+
+
+module Magic_number : sig
+  (** a typical magic number is "Caml1999I011"; it is formed of an
+      alphanumeric prefix, here Caml1990I, followed by a version,
+      here 011. The prefix identifies the kind of the versioned data:
+      here the I indicates that it is the magic number for .cmi files.
+
+      All magic numbers have the same byte length, [magic_length], and
+      this is important for users as it gives them the number of bytes
+      to read to obtain the byte sequence that should be a magic
+      number. Typical user code will look like:
+      {[
+        let ic = open_in_bin path in
+        let magic =
+          try really_input_string ic Magic_number.magic_length
+          with End_of_file -> ... in
+        match Magic_number.parse magic with
+        | Error parse_error -> ...
+        | Ok info -> ...
+      ]}
+
+      A given compiler version expects one specific version for each
+      kind of object file, and will fail if given an unsupported
+      version. Because versions grow monotonically, you can compare
+      the parsed version with the expected "current version" for
+      a kind, to tell whether the wrong-magic object file comes from
+      the past or from the future.
+
+      An example of code block that expects the "currently supported version"
+      of a given kind of magic numbers, here [Cmxa], is as follows:
+      {[
+        let ic = open_in_bin path in
+        begin
+          try Magic_number.(expect_current Cmxa (get_info ic)) with
+          | Parse_error error -> ...
+          | Unexpected error -> ...
+        end;
+        ...
+      ]}
+
+      Parse errors distinguish inputs that are [Not_a_magic_number str],
+      which are likely to come from the file being completely
+      different, and [Truncated str], raised by headers that are the
+      (possibly empty) prefix of a valid magic number.
+
+      Unexpected errors correspond to valid magic numbers that are not
+      the one expected, either because it corresponds to a different
+      kind, or to a newer or older version.
+
+      The helper functions [explain_parse_error] and [explain_unexpected_error]
+      will generate a textual explanation of each error,
+      for use in error messages.
+
+      @since 4.11.0
+  *)
+
+  type native_obj_config = {
+    flambda : bool;
+  }
+  (** native object files have a format and magic number that depend
+     on certain native-compiler configuration parameters. This
+     configuration space is expressed by the [native_obj_config]
+     type. *)
+
+  val native_obj_config : native_obj_config
+  (** the native object file configuration of the active/configured compiler. *)
+
+  type version = int
+
+  type kind =
+    | Exec
+    | Cmi | Cmo | Cma
+    | Cmx of native_obj_config | Cmxa of native_obj_config
+    | Cmxs
+    | Cmt | Ast_impl | Ast_intf
+
+  type info = {
+    kind: kind;
+    version: version;
+    (** Note: some versions of the compiler use the same [version] suffix
+        for all kinds, but others use different versions counters for different
+        kinds. We may only assume that versions are growing monotonically
+        (not necessarily always by one) between compiler versions. *)
+  }
+
+  type raw = string
+  (** the type of raw magic numbers,
+      such as "Caml1999A027" for the .cma files of OCaml 4.10 *)
+
+  (** {3 Parsing magic numbers} *)
+
+  type parse_error =
+    | Truncated of string
+    | Not_a_magic_number of string
+
+  val explain_parse_error : kind option -> parse_error -> string
+  (** Produces an explanation for a parse error. If no kind is provided,
+      we use an unspecific formulation suggesting that any compiler-produced
+      object file would have been satisfying. *)
+
+  val parse : raw -> (info, parse_error) result
+  (** Parses a raw magic number *)
+
+  val read_info : in_channel -> (info, parse_error) result
+  (** Read a raw magic number from an input channel.
+
+      If the data read [str] is not a valid magic number, it can be
+      recovered from the [Truncated str | Not_a_magic_number str]
+      payload of the [Error parse_error] case.
+
+      If parsing succeeds with an [Ok info] result, we know that
+      exactly [magic_length] bytes have been consumed from the
+      input_channel.
+
+      If you also wish to enforce that the magic number
+      is at the current version, see {!read_current_info} below.
+   *)
+
+  val magic_length : int
+  (** all magic numbers take the same number of bytes *)
+
+
+  (** {3 Checking that magic numbers are current} *)
+
+  type 'a unexpected = { expected : 'a; actual : 'a }
+  type unexpected_error =
+    | Kind of kind unexpected
+    | Version of kind * version unexpected
+
+  val check_current : kind -> info -> (unit, unexpected_error) result
+  (** [check_current kind info] checks that the provided magic [info]
+      is the current version of [kind]'s magic header. *)
+
+  val explain_unexpected_error : unexpected_error -> string
+  (** Provides an explanation of the [unexpected_error]. *)
+
+  type error =
+    | Parse_error of parse_error
+    | Unexpected_error of unexpected_error
+
+  val read_current_info :
+    expected_kind:kind option -> in_channel -> (info, error) result
+  (** Read a magic number as [read_info],
+      and check that it is the current version as its kind.
+      If the [expected_kind] argument is [None], any kind is accepted. *)
+
+
+  (** {3 Information on magic numbers} *)
+
+  val string_of_kind : kind -> string
+  (** a user-printable string for a kind, eg. "exec" or "cmo", to use
+      in error messages. *)
+
+  val human_name_of_kind : kind -> string
+  (** a user-meaningful name for a kind, eg. "executable file" or
+      "bytecode object file", to use in error messages. *)
+
+  val current_raw : kind -> raw
+  (** the current magic number of each kind *)
+
+  val current_version : kind -> version
+  (** the current version of each kind *)
+
+
+  (** {3 Raw representations}
+
+      Mainly for internal usage and testing. *)
+
+  type raw_kind = string
+  (** the type of raw magic numbers kinds,
+      such as "Caml1999A" for .cma files *)
+
+  val parse_kind : raw_kind -> kind option
+  (** parse a raw kind into a kind *)
+
+  val raw_kind : kind -> raw_kind
+  (** the current raw representation of a kind.
+
+      In some cases the raw representation of a kind has changed
+      over compiler versions, so other files of the same kind
+      may have different raw kinds.
+      Note that all currently known cases are parsed correctly by [parse_kind].
+  *)
+
+  val raw : info -> raw
+  (** A valid raw representation of the magic number.
+
+      Due to past and future changes in the string representation of
+      magic numbers, we cannot guarantee that the raw strings returned
+      for past and future versions actually match the expectations of
+      those compilers. The representation is accurate for current
+      versions, and it is correctly parsed back into the desired
+      version by the parsing functions above.
+   *)
+
+  (**/**)
+
+  val all_kinds : kind list
+end
diff --git a/utils/numbers.ml b/utils/numbers.ml
new file mode 100644
index 00000000..1680675b
--- /dev/null
+++ b/utils/numbers.ml
@@ -0,0 +1,88 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Int_base = Identifiable.Make (struct
+  type t = int
+
+  let compare x y = x - y
+  let output oc x = Printf.fprintf oc "%i" x
+  let hash i = i
+  let equal (i : int) j = i = j
+  let print = Format.pp_print_int
+end)
+
+module Int = struct
+  type t = int
+
+  include Int_base
+
+  let rec zero_to_n n =
+    if n < 0 then Set.empty else Set.add n (zero_to_n (n-1))
+
+  let to_string n = Int.to_string n
+end
+
+module Int8 = struct
+  type t = int
+
+  let zero = 0
+  let one = 1
+
+  let of_int_exn i =
+    if i < -(1 lsl 7) || i > ((1 lsl 7) - 1) then
+      Misc.fatal_errorf "Int8.of_int_exn: %d is out of range" i
+    else
+      i
+
+  let to_int i = i
+end
+
+module Int16 = struct
+  type t = int
+
+  let of_int_exn i =
+    if i < -(1 lsl 15) || i > ((1 lsl 15) - 1) then
+      Misc.fatal_errorf "Int16.of_int_exn: %d is out of range" i
+    else
+      i
+
+  let lower_int64 = Int64.neg (Int64.shift_left Int64.one 15)
+  let upper_int64 = Int64.sub (Int64.shift_left Int64.one 15) Int64.one
+
+  let of_int64_exn i =
+    if Int64.compare i lower_int64 < 0
+        || Int64.compare i upper_int64 > 0
+    then
+      Misc.fatal_errorf "Int16.of_int64_exn: %Ld is out of range" i
+    else
+      Int64.to_int i
+
+  let to_int t = t
+end
+
+module Float = struct
+  type t = float
+
+  include Identifiable.Make (struct
+    type t = float
+
+    let compare x y = Stdlib.compare x y
+    let output oc x = Printf.fprintf oc "%f" x
+    let hash f = Hashtbl.hash f
+    let equal (i : float) j = i = j
+    let print = Format.pp_print_float
+  end)
+end
diff --git a/utils/numbers.mli b/utils/numbers.mli
new file mode 100644
index 00000000..fa565e67
--- /dev/null
+++ b/utils/numbers.mli
@@ -0,0 +1,51 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Modules about numbers, some of which satisfy {!Identifiable.S}.
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+module Int : sig
+  include Identifiable.S with type t = int
+
+  (** [zero_to_n n] is the set of numbers \{0, ..., n\} (inclusive). *)
+  val zero_to_n : int -> Set.t
+  val to_string : int -> string
+end
+
+module Int8 : sig
+  type t
+
+  val zero : t
+  val one : t
+
+  val of_int_exn : int -> t
+  val to_int : t -> int
+end
+
+module Int16 : sig
+  type t
+
+  val of_int_exn : int -> t
+  val of_int64_exn : Int64.t -> t
+
+  val to_int : t -> int
+end
+
+module Float : Identifiable.S with type t = float
diff --git a/utils/profile.ml b/utils/profile.ml
new file mode 100644
index 00000000..02e3a16d
--- /dev/null
+++ b/utils/profile.ml
@@ -0,0 +1,335 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                      Pierre Chambart, OCamlPro                         *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-18-40-42-48"]
+
+type file = string
+
+external time_include_children: bool -> float = "caml_sys_time_include_children"
+let cpu_time () = time_include_children true
+
+module Measure = struct
+  type t = {
+    time : float;
+    allocated_words : float;
+    top_heap_words : int;
+  }
+  let create () =
+    let stat = Gc.quick_stat () in
+    {
+      time = cpu_time ();
+      allocated_words = stat.minor_words +. stat.major_words;
+      top_heap_words = stat.top_heap_words;
+    }
+  let zero = { time = 0.; allocated_words = 0.; top_heap_words = 0 }
+end
+
+module Measure_diff = struct
+  let timestamp = let r = ref (-1) in fun () -> incr r; !r
+  type t = {
+    timestamp : int;
+    duration : float;
+    allocated_words : float;
+    top_heap_words_increase : int;
+  }
+  let zero () = {
+    timestamp = timestamp ();
+    duration = 0.;
+    allocated_words = 0.;
+    top_heap_words_increase = 0;
+  }
+  let accumulate t (m1 : Measure.t) (m2 : Measure.t) = {
+    timestamp = t.timestamp;
+    duration = t.duration +. (m2.time -. m1.time);
+    allocated_words =
+      t.allocated_words +. (m2.allocated_words -. m1.allocated_words);
+    top_heap_words_increase =
+      t.top_heap_words_increase + (m2.top_heap_words - m1.top_heap_words);
+  }
+  let of_diff m1 m2 =
+    accumulate (zero ()) m1 m2
+end
+
+type hierarchy =
+  | E of (string, Measure_diff.t * hierarchy) Hashtbl.t
+[@@unboxed]
+
+let create () = E (Hashtbl.create 2)
+let hierarchy = ref (create ())
+let initial_measure = ref None
+let reset () = hierarchy := create (); initial_measure := None
+
+let record_call ?(accumulate = false) name f =
+  let E prev_hierarchy = !hierarchy in
+  let start_measure = Measure.create () in
+  if !initial_measure = None then initial_measure := Some start_measure;
+  let this_measure_diff, this_table =
+    (* We allow the recording of multiple categories by the same name, for tools
+       like ocamldoc that use the compiler libs but don't care about profile
+       information, and so may record, say, "parsing" multiple times. *)
+    if accumulate
+    then
+      match Hashtbl.find prev_hierarchy name with
+      | exception Not_found -> Measure_diff.zero (), Hashtbl.create 2
+      | measure_diff, E table ->
+        Hashtbl.remove prev_hierarchy name;
+        measure_diff, table
+    else Measure_diff.zero (), Hashtbl.create 2
+  in
+  hierarchy := E this_table;
+  Misc.try_finally f
+    ~always:(fun () ->
+        hierarchy := E prev_hierarchy;
+        let end_measure = Measure.create () in
+        let measure_diff =
+          Measure_diff.accumulate this_measure_diff start_measure end_measure in
+        Hashtbl.add prev_hierarchy name (measure_diff, E this_table))
+
+let record ?accumulate pass f x = record_call ?accumulate pass (fun () -> f x)
+
+type display = {
+  to_string : max:float -> width:int -> string;
+  worth_displaying : max:float -> bool;
+}
+
+let time_display v : display =
+  (* Because indentation is meaningful, and because the durations are
+     the first element of each row, we can't pad them with spaces. *)
+  let to_string_without_unit v ~width = Printf.sprintf "%0*.03f" width v in
+  let to_string ~max:_ ~width =
+    to_string_without_unit v ~width:(width - 1) ^ "s" in
+  let worth_displaying ~max:_ =
+    float_of_string (to_string_without_unit v ~width:0) <> 0. in
+  { to_string; worth_displaying }
+
+let memory_word_display =
+  (* To make memory numbers easily comparable across rows, we choose a single
+     scale for an entire column. To keep the display compact and not overly
+     precise (no one cares about the exact number of bytes), we pick the largest
+     scale we can and we only show 3 digits. Avoiding showing tiny numbers also
+     allows us to avoid displaying passes that barely allocate compared to the
+     rest of the compiler.  *)
+  let bytes_of_words words = words *. float_of_int (Sys.word_size / 8) in
+  let to_string_without_unit v ~width scale =
+    let precision = 3 and precision_power = 1e3 in
+    let v_rescaled = bytes_of_words v /. scale in
+    let v_rounded =
+      floor (v_rescaled *. precision_power +. 0.5) /. precision_power in
+    let v_str = Printf.sprintf "%.*f" precision v_rounded in
+    let index_of_dot = String.index v_str '.' in
+    let v_str_truncated =
+      String.sub v_str 0
+        (if index_of_dot >= precision
+         then index_of_dot
+         else precision + 1)
+    in
+    Printf.sprintf "%*s" width v_str_truncated
+  in
+  let choose_memory_scale =
+    let units = [|"B"; "kB"; "MB"; "GB"|] in
+    fun words ->
+      let bytes = bytes_of_words words in
+      let scale = ref (Array.length units - 1) in
+      while !scale > 0 && bytes < 1024. ** float_of_int !scale do
+        decr scale
+      done;
+      1024. ** float_of_int !scale, units.(!scale)
+  in
+  fun ?previous v : display ->
+    let to_string ~max ~width =
+      let scale, scale_str = choose_memory_scale max in
+      let width = width - String.length scale_str in
+      to_string_without_unit v ~width scale ^ scale_str
+    in
+    let worth_displaying ~max =
+      let scale, _ = choose_memory_scale max in
+      float_of_string (to_string_without_unit v ~width:0 scale) <> 0.
+      && match previous with
+      | None -> true
+      | Some p ->
+         (* This branch is for numbers that represent absolute quantity, rather
+            than differences. It allows us to skip displaying the same absolute
+            quantity many times in a row. *)
+         to_string_without_unit p ~width:0 scale
+         <> to_string_without_unit v ~width:0 scale
+    in
+    { to_string; worth_displaying }
+
+let profile_list (E table) =
+  let l = Hashtbl.fold (fun k d l -> (k, d) :: l) table [] in
+  List.sort (fun (_, (p1, _)) (_, (p2, _)) ->
+    compare p1.Measure_diff.timestamp p2.Measure_diff.timestamp) l
+
+let compute_other_category (E table : hierarchy) (total : Measure_diff.t) =
+  let r = ref total in
+  Hashtbl.iter (fun _pass ((p2 : Measure_diff.t), _) ->
+    let p1 = !r in
+    r := {
+      timestamp = p1.timestamp;
+      duration = p1.duration -. p2.duration;
+      allocated_words = p1.allocated_words -. p2.allocated_words;
+      top_heap_words_increase =
+        p1.top_heap_words_increase - p2.top_heap_words_increase;
+    }
+  ) table;
+  !r
+
+type row = R of string * (float * display) list * row list
+type column = [ `Time | `Alloc | `Top_heap | `Abs_top_heap ]
+
+let rec rows_of_hierarchy ~nesting make_row name measure_diff hierarchy env =
+  let rows =
+    rows_of_hierarchy_list
+      ~nesting:(nesting + 1) make_row hierarchy measure_diff env in
+  let values, env =
+    make_row env measure_diff ~toplevel_other:(nesting = 0 && name = "other") in
+  R (name, values, rows), env
+
+and rows_of_hierarchy_list ~nesting make_row hierarchy total env =
+  let list = profile_list hierarchy in
+  let list =
+    if list <> [] || nesting = 0
+    then list @ [ "other", (compute_other_category hierarchy total, create ()) ]
+    else []
+  in
+  let env = ref env in
+  List.map (fun (name, (measure_diff, hierarchy)) ->
+    let a, env' =
+      rows_of_hierarchy ~nesting make_row name measure_diff hierarchy !env in
+    env := env';
+    a
+  ) list
+
+let rows_of_hierarchy hierarchy measure_diff initial_measure columns =
+  (* Computing top heap size is a bit complicated: if the compiler applies a
+     list of passes n times (rather than applying pass1 n times, then pass2 n
+     times etc), we only show one row for that pass but what does "top heap
+     size at the end of that pass" even mean?
+     It seems the only sensible answer is to pretend the compiler applied pass1
+     n times, pass2 n times by accumulating all the heap size increases that
+     happened during each pass, and then compute what the heap size would have
+     been. So that's what we do.
+     There's a bit of extra complication, which is that the heap can increase in
+     between measurements. So the heap sizes can be a bit off until the "other"
+     rows account for what's missing. We special case the toplevel "other" row
+     so that any increases that happened before the start of the compilation is
+     correctly reported, as a lot of code may run before the start of the
+     compilation (eg functor applications). *)
+    let make_row prev_top_heap_words (p : Measure_diff.t) ~toplevel_other =
+      let top_heap_words =
+        prev_top_heap_words
+        + p.top_heap_words_increase
+        - if toplevel_other
+          then initial_measure.Measure.top_heap_words
+          else 0
+      in
+      let make value ~f = value, f value in
+      List.map (function
+        | `Time ->
+          make p.duration ~f:time_display
+        | `Alloc ->
+          make p.allocated_words ~f:memory_word_display
+        | `Top_heap ->
+          make (float_of_int p.top_heap_words_increase) ~f:memory_word_display
+        | `Abs_top_heap ->
+          make (float_of_int top_heap_words)
+           ~f:(memory_word_display ~previous:(float_of_int prev_top_heap_words))
+      ) columns,
+      top_heap_words
+  in
+  rows_of_hierarchy_list ~nesting:0 make_row hierarchy measure_diff
+    initial_measure.top_heap_words
+
+let max_by_column ~n_columns rows =
+  let a = Array.make n_columns 0. in
+  let rec loop (R (_, values, rows)) =
+    List.iteri (fun i (v, _) -> a.(i) <- max a.(i) v) values;
+    List.iter loop rows
+  in
+  List.iter loop rows;
+  a
+
+let width_by_column ~n_columns ~display_cell rows =
+  let a = Array.make n_columns 1 in
+  let rec loop (R (_, values, rows)) =
+    List.iteri (fun i cell ->
+      let _, str = display_cell i cell ~width:0 in
+      a.(i) <- max a.(i) (String.length str)
+    ) values;
+    List.iter loop rows;
+  in
+  List.iter loop rows;
+  a
+
+let display_rows ppf rows =
+  let n_columns =
+    match rows with
+    | [] -> 0
+    | R (_, values, _) :: _ -> List.length values
+  in
+  let maxs = max_by_column ~n_columns rows in
+  let display_cell i (_, c) ~width =
+    let display_cell = c.worth_displaying ~max:maxs.(i) in
+    display_cell, if display_cell
+                  then c.to_string ~max:maxs.(i) ~width
+                  else String.make width '-'
+  in
+  let widths = width_by_column ~n_columns ~display_cell rows in
+  let rec loop (R (name, values, rows)) ~indentation =
+    let worth_displaying, cell_strings =
+      values
+      |> List.mapi (fun i cell -> display_cell i cell ~width:widths.(i))
+      |> List.split
+    in
+    if List.exists (fun b -> b) worth_displaying then
+      Format.fprintf ppf "%s%s %s@\n"
+        indentation (String.concat " " cell_strings) name;
+    List.iter (loop ~indentation:("  " ^ indentation)) rows;
+  in
+  List.iter (loop ~indentation:"") rows
+
+let print ppf columns =
+  match columns with
+  | [] -> ()
+  | _ :: _ ->
+     let initial_measure =
+       match !initial_measure with
+       | Some v -> v
+       | None -> Measure.zero
+     in
+     let total = Measure_diff.of_diff Measure.zero (Measure.create ()) in
+     display_rows ppf
+       (rows_of_hierarchy !hierarchy total initial_measure columns)
+
+let column_mapping = [
+  "time", `Time;
+  "alloc", `Alloc;
+  "top-heap", `Top_heap;
+  "absolute-top-heap", `Abs_top_heap;
+]
+
+let column_names = List.map fst column_mapping
+
+let options_doc =
+  Printf.sprintf
+    " Print performance information for each pass\
+   \n    The columns are: %s."
+    (String.concat " " column_names)
+
+let all_columns = List.map snd column_mapping
+
+let generate = "generate"
+let transl = "transl"
+let typing = "typing"
diff --git a/utils/profile.mli b/utils/profile.mli
new file mode 100644
index 00000000..7eff6957
--- /dev/null
+++ b/utils/profile.mli
@@ -0,0 +1,49 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                      Pierre Chambart, OCamlPro                         *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Compiler performance recording
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type file = string
+
+val reset : unit -> unit
+(** erase all recorded profile information *)
+
+val record_call : ?accumulate:bool -> string -> (unit -> 'a) -> 'a
+(** [record_call pass f] calls [f] and records its profile information. *)
+
+val record : ?accumulate:bool -> string -> ('a -> 'b) -> 'a -> 'b
+(** [record pass f arg] records the profile information of [f arg] *)
+
+type column = [ `Time | `Alloc | `Top_heap | `Abs_top_heap ]
+
+val print : Format.formatter -> column list -> unit
+(** Prints the selected recorded profiling information to the formatter. *)
+
+(** Command line flags *)
+
+val options_doc : string
+val all_columns : column list
+
+(** A few pass names that are needed in several places, and shared to
+    avoid typos. *)
+
+val generate : string
+val transl : string
+val typing : string
diff --git a/utils/strongly_connected_components.ml b/utils/strongly_connected_components.ml
new file mode 100644
index 00000000..a11f6987
--- /dev/null
+++ b/utils/strongly_connected_components.ml
@@ -0,0 +1,200 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Int = Numbers.Int
+
+module Kosaraju : sig
+  type component_graph =
+    { sorted_connected_components : int list array;
+      component_edges : int list array;
+    }
+
+  val component_graph : int list array -> component_graph
+end = struct
+  let transpose graph =
+    let size = Array.length graph in
+    let transposed = Array.make size [] in
+    let add src dst = transposed.(src) <- dst :: transposed.(src) in
+    Array.iteri (fun src dsts -> List.iter (fun dst -> add dst src) dsts)
+      graph;
+    transposed
+
+  let depth_first_order (graph : int list array) : int array =
+    let size = Array.length graph in
+    let marked = Array.make size false in
+    let stack = Array.make size ~-1 in
+    let pos = ref 0 in
+    let push i =
+      stack.(!pos) <- i;
+      incr pos
+    in
+    let rec aux node =
+      if not marked.(node)
+      then begin
+        marked.(node) <- true;
+        List.iter aux graph.(node);
+        push node
+      end
+    in
+    for i = 0 to size - 1 do
+      aux i
+    done;
+    stack
+
+  let mark order graph =
+    let size = Array.length graph in
+    let graph = transpose graph in
+    let marked = Array.make size false in
+    let id = Array.make size ~-1 in
+    let count = ref 0 in
+    let rec aux node =
+      if not marked.(node)
+      then begin
+        marked.(node) <- true;
+        id.(node) <- !count;
+        List.iter aux graph.(node)
+      end
+    in
+    for i = size - 1 downto 0 do
+      let node = order.(i) in
+      if not marked.(node)
+      then begin
+        aux order.(i);
+        incr count
+      end
+    done;
+    id, !count
+
+  let kosaraju graph =
+    let dfo = depth_first_order graph in
+    let components, ncomponents = mark dfo graph in
+    ncomponents, components
+
+  type component_graph =
+    { sorted_connected_components : int list array;
+      component_edges : int list array;
+    }
+
+  let component_graph graph =
+    let ncomponents, components = kosaraju graph in
+    let id_scc = Array.make ncomponents [] in
+    let component_graph = Array.make ncomponents Int.Set.empty in
+    let add_component_dep node set =
+      let node_deps = graph.(node) in
+      List.fold_left (fun set dep -> Int.Set.add components.(dep) set)
+        set node_deps
+    in
+    Array.iteri (fun node component ->
+        id_scc.(component) <- node :: id_scc.(component);
+        component_graph.(component) <-
+          add_component_dep node (component_graph.(component)))
+      components;
+    { sorted_connected_components = id_scc;
+      component_edges = Array.map Int.Set.elements component_graph;
+    }
+end
+
+module type S = sig
+  module Id : Identifiable.S
+
+  type directed_graph = Id.Set.t Id.Map.t
+
+  type component =
+    | Has_loop of Id.t list
+    | No_loop of Id.t
+
+  val connected_components_sorted_from_roots_to_leaf
+     : directed_graph
+    -> component array
+
+  val component_graph : directed_graph -> (component * int list) array
+end
+
+module Make (Id : Identifiable.S) = struct
+  type directed_graph = Id.Set.t Id.Map.t
+
+  type component =
+    | Has_loop of Id.t list
+    | No_loop of Id.t
+
+  (* Ensure that the dependency graph does not have external dependencies. *)
+  (* Note: this function is currently not used. *)
+  let _check dependencies =
+    Id.Map.iter (fun id set ->
+        Id.Set.iter (fun v ->
+            if not (Id.Map.mem v dependencies)
+            then
+              Misc.fatal_errorf "Strongly_connected_components.check: the \
+                  graph has external dependencies (%a -> %a)"
+               Id.print id Id.print v)
+          set)
+      dependencies
+
+  type numbering = {
+    back : int Id.Map.t;
+    forth : Id.t array;
+  }
+
+  let number graph =
+    let size = Id.Map.cardinal graph in
+    let bindings = Id.Map.bindings graph in
+    let a = Array.of_list bindings in
+    let forth = Array.map fst a in
+    let back =
+      let back = ref Id.Map.empty in
+      for i = 0 to size - 1 do
+        back := Id.Map.add forth.(i) i !back;
+      done;
+      !back
+    in
+    let integer_graph =
+      Array.init size (fun i ->
+        let _, dests = a.(i) in
+        Id.Set.fold (fun dest acc ->
+            let v =
+              try Id.Map.find dest back
+              with Not_found ->
+                Misc.fatal_errorf
+                  "Strongly_connected_components: missing dependency %a"
+                  Id.print dest
+            in
+            v :: acc)
+          dests [])
+    in
+    { back; forth }, integer_graph
+
+  let component_graph graph =
+    let numbering, integer_graph = number graph in
+    let { Kosaraju. sorted_connected_components;
+          component_edges } =
+      Kosaraju.component_graph integer_graph
+    in
+    Array.mapi (fun component nodes ->
+        match nodes with
+        | [] -> assert false
+        | [node] ->
+          (if List.mem node integer_graph.(node)
+           then Has_loop [numbering.forth.(node)]
+           else No_loop numbering.forth.(node)),
+            component_edges.(component)
+        | _::_ ->
+          (Has_loop (List.map (fun node -> numbering.forth.(node)) nodes)),
+            component_edges.(component))
+      sorted_connected_components
+
+  let connected_components_sorted_from_roots_to_leaf graph =
+    Array.map fst (component_graph graph)
+end
diff --git a/utils/strongly_connected_components.mli b/utils/strongly_connected_components.mli
new file mode 100644
index 00000000..e7009527
--- /dev/null
+++ b/utils/strongly_connected_components.mli
@@ -0,0 +1,43 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Kosaraju's algorithm for strongly connected components.
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+module type S = sig
+  module Id : Identifiable.S
+
+  type directed_graph = Id.Set.t Id.Map.t
+  (** If (a -> set) belongs to the map, it means that there are edges
+      from [a] to every element of [set].  It is assumed that no edge
+      points to a vertex not represented in the map. *)
+
+  type component =
+    | Has_loop of Id.t list
+    | No_loop of Id.t
+
+  val connected_components_sorted_from_roots_to_leaf
+     : directed_graph
+    -> component array
+
+  val component_graph : directed_graph -> (component * int list) array
+end
+
+module Make (Id : Identifiable.S) : S with module Id := Id
diff --git a/utils/targetint.ml b/utils/targetint.ml
new file mode 100644
index 00000000..9d15a2ff
--- /dev/null
+++ b/utils/targetint.ml
@@ -0,0 +1,104 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                        Nicolas Ojeda Bar, LexiFi                       *)
+(*                                                                        *)
+(*   Copyright 2016 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 repr =
+  | Int32 of int32
+  | Int64 of int64
+
+module type S = sig
+  type t
+  val zero : t
+  val one : t
+  val minus_one : t
+  val neg : t -> t
+  val add : t -> t -> t
+  val sub : t -> t -> t
+  val mul : t -> t -> t
+  val div : t -> t -> t
+  val unsigned_div : t -> t -> t
+  val rem : t -> t -> t
+  val unsigned_rem : t -> t -> t
+  val succ : t -> t
+  val pred : t -> t
+  val abs : t -> t
+  val max_int : t
+  val min_int : t
+  val logand : t -> t -> t
+  val logor : t -> t -> t
+  val logxor : t -> t -> t
+  val lognot : t -> t
+  val shift_left : t -> int -> t
+  val shift_right : t -> int -> t
+  val shift_right_logical : t -> int -> t
+  val of_int : int -> t
+  val of_int_exn : int -> t
+  val to_int : t -> int
+  val of_float : float -> t
+  val to_float : t -> float
+  val of_int32 : int32 -> t
+  val to_int32 : t -> int32
+  val of_int64 : int64 -> t
+  val to_int64 : t -> int64
+  val of_string : string -> t
+  val to_string : t -> string
+  val compare: t -> t -> int
+  val unsigned_compare : t -> t -> int
+  val equal: t -> t -> bool
+  val repr: t -> repr
+  val print : Format.formatter -> t -> unit
+end
+
+let size = Sys.word_size
+(* Later, this will be set by the configure script
+   in order to support cross-compilation. *)
+
+module Int32 = struct
+  include Int32
+  let of_int_exn =
+    match Sys.word_size with (* size of [int] *)
+    | 32 ->
+        Int32.of_int
+    | 64 ->
+        fun n ->
+          if n < Int32.(to_int min_int) || n > Int32.(to_int max_int) then
+            Misc.fatal_errorf "Targetint.of_int_exn: 0x%x out of range" n
+          else
+            Int32.of_int n
+    | _ ->
+        assert false
+  let of_int32 x = x
+  let to_int32 x = x
+  let of_int64 = Int64.to_int32
+  let to_int64 = Int64.of_int32
+  let repr x = Int32 x
+  let print ppf t = Format.fprintf ppf "%ld" t
+end
+
+module Int64 = struct
+  include Int64
+  let of_int_exn = Int64.of_int
+  let of_int64 x = x
+  let to_int64 x = x
+  let repr x = Int64 x
+  let print ppf t = Format.fprintf ppf "%Ld" t
+end
+
+include (val
+          (match size with
+           | 32 -> (module Int32)
+           | 64 -> (module Int64)
+           | _ -> assert false
+          ) : S)
diff --git a/utils/targetint.mli b/utils/targetint.mli
new file mode 100644
index 00000000..72d464d2
--- /dev/null
+++ b/utils/targetint.mli
@@ -0,0 +1,207 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                        Nicolas Ojeda Bar, LexiFi                       *)
+(*                                                                        *)
+(*   Copyright 2016 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Target processor-native integers.
+
+   This module provides operations on the type of
+   signed 32-bit integers (on 32-bit target platforms) or
+   signed 64-bit integers (on 64-bit target platforms).
+   This integer type has exactly the same width as that of a
+   pointer type in the C compiler.  All arithmetic operations over
+   are taken modulo 2{^32} or 2{^64} depending
+   on the word size of the target architecture.
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type t
+(** The type of target integers. *)
+
+val zero : t
+(** The target integer 0.*)
+
+val one : t
+(** The target integer 1.*)
+
+val minus_one : t
+(** The target integer -1.*)
+
+val neg : t -> t
+(** Unary negation. *)
+
+val add : t -> t -> t
+(** Addition. *)
+
+val sub : t -> t -> t
+(** Subtraction. *)
+
+val mul : t -> t -> t
+(** Multiplication. *)
+
+val div : t -> t -> t
+(** Integer division.  Raise [Division_by_zero] if the second
+   argument is zero.  This division rounds the real quotient of
+   its arguments towards zero, as specified for {!Stdlib.(/)}. *)
+
+val unsigned_div : t -> t -> t
+(** Same as {!div}, except that arguments and result are interpreted as {e
+    unsigned} integers. *)
+
+val rem : t -> t -> t
+(** Integer remainder.  If [y] is not zero, the result
+   of [Targetint.rem x y] satisfies the following properties:
+   [Targetint.zero <= Nativeint.rem x y < Targetint.abs y] and
+   [x = Targetint.add (Targetint.mul (Targetint.div x y) y)
+                      (Targetint.rem x y)].
+   If [y = 0], [Targetint.rem x y] raises [Division_by_zero]. *)
+
+val unsigned_rem : t -> t -> t
+(** Same as {!rem}, except that arguments and result are interpreted as {e
+    unsigned} integers. *)
+
+val succ : t -> t
+(** Successor.
+   [Targetint.succ x] is [Targetint.add x Targetint.one]. *)
+
+val pred : t -> t
+(** Predecessor.
+   [Targetint.pred x] is [Targetint.sub x Targetint.one]. *)
+
+val abs : t -> t
+(** Return the absolute value of its argument. *)
+
+val size : int
+(** The size in bits of a target native integer. *)
+
+val max_int : t
+(** The greatest representable target integer,
+    either 2{^31} - 1 on a 32-bit platform,
+    or 2{^63} - 1 on a 64-bit platform. *)
+
+val min_int : t
+(** The smallest representable target integer,
+   either -2{^31} on a 32-bit platform,
+   or -2{^63} on a 64-bit platform. *)
+
+val logand : t -> t -> t
+(** Bitwise logical and. *)
+
+val logor : t -> t -> t
+(** Bitwise logical or. *)
+
+val logxor : t -> t -> t
+(** Bitwise logical exclusive or. *)
+
+val lognot : t -> t
+(** Bitwise logical negation. *)
+
+val shift_left : t -> int -> t
+(** [Targetint.shift_left x y] shifts [x] to the left by [y] bits.
+    The result is unspecified if [y < 0] or [y >= bitsize],
+    where [bitsize] is [32] on a 32-bit platform and
+    [64] on a 64-bit platform. *)
+
+val shift_right : t -> int -> t
+(** [Targetint.shift_right x y] shifts [x] to the right by [y] bits.
+    This is an arithmetic shift: the sign bit of [x] is replicated
+    and inserted in the vacated bits.
+    The result is unspecified if [y < 0] or [y >= bitsize]. *)
+
+val shift_right_logical : t -> int -> t
+(** [Targetint.shift_right_logical x y] shifts [x] to the right
+    by [y] bits.
+    This is a logical shift: zeroes are inserted in the vacated bits
+    regardless of the sign of [x].
+    The result is unspecified if [y < 0] or [y >= bitsize]. *)
+
+val of_int : int -> t
+(** Convert the given integer (type [int]) to a target integer
+    (type [t]), module the target word size. *)
+
+val of_int_exn : int -> t
+(** Convert the given integer (type [int]) to a target integer
+    (type [t]).  Raises a fatal error if the conversion is not exact. *)
+
+val to_int : t -> int
+(** Convert the given target integer (type [t]) to an
+    integer (type [int]).  The high-order bit is lost during
+    the conversion. *)
+
+val of_float : float -> t
+(** Convert the given floating-point number to a target integer,
+   discarding the fractional part (truncate towards 0).
+   The result of the conversion is undefined if, after truncation,
+   the number is outside the range
+   \[{!Targetint.min_int}, {!Targetint.max_int}\]. *)
+
+val to_float : t -> float
+(** Convert the given target integer to a floating-point number. *)
+
+val of_int32 : int32 -> t
+(** Convert the given 32-bit integer (type [int32])
+    to a target integer. *)
+
+val to_int32 : t -> int32
+(** Convert the given target integer to a
+    32-bit integer (type [int32]).  On 64-bit platforms,
+    the 64-bit native integer is taken modulo 2{^32},
+    i.e. the top 32 bits are lost.  On 32-bit platforms,
+    the conversion is exact. *)
+
+val of_int64 : int64 -> t
+(** Convert the given 64-bit integer (type [int64])
+    to a target integer. *)
+
+val to_int64 : t -> int64
+(** Convert the given target integer to a
+    64-bit integer (type [int64]). *)
+
+val of_string : string -> t
+(** Convert the given string to a target integer.
+    The string is read in decimal (by default) or in hexadecimal,
+    octal or binary if the string begins with [0x], [0o] or [0b]
+    respectively.
+    Raise [Failure "int_of_string"] if the given string is not
+    a valid representation of an integer, or if the integer represented
+    exceeds the range of integers representable in type [nativeint]. *)
+
+val to_string : t -> string
+(** Return the string representation of its argument, in decimal. *)
+
+val compare: t -> t -> int
+(** The comparison function for target integers, with the same specification as
+    {!Stdlib.compare}.  Along with the type [t], this function [compare]
+    allows the module [Targetint] to be passed as argument to the functors
+    {!Set.Make} and {!Map.Make}. *)
+
+val unsigned_compare: t -> t -> int
+(** Same as {!compare}, except that arguments are interpreted as {e unsigned}
+    integers. *)
+
+val equal: t -> t -> bool
+(** The equal function for target ints. *)
+
+type repr =
+  | Int32 of int32
+  | Int64 of int64
+
+val repr : t -> repr
+(** The concrete representation of a native integer. *)
+
+val print : Format.formatter -> t -> unit
+(** Print a target integer to a formatter. *)
diff --git a/utils/terminfo.ml b/utils/terminfo.ml
new file mode 100644
index 00000000..1b4a3578
--- /dev/null
+++ b/utils/terminfo.ml
@@ -0,0 +1,45 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Paris                  *)
+(*                                                                        *)
+(*   Copyright 2017 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Printf
+
+external isatty : out_channel -> bool = "caml_sys_isatty"
+external terminfo_rows: out_channel -> int = "caml_terminfo_rows"
+
+type status =
+  | Uninitialised
+  | Bad_term
+  | Good_term
+
+let setup oc =
+  let term = try Sys.getenv "TERM" with Not_found -> "" in
+  (* Same heuristics as in Misc.Color.should_enable_color *)
+  if term <> "" && term <> "dumb" && isatty oc
+  then Good_term
+  else Bad_term
+
+let num_lines oc =
+  let rows = terminfo_rows oc in
+  if rows > 0 then rows else 24
+    (* 24 is a reasonable default for an ANSI-style terminal *)
+
+let backup oc n =
+  if n >= 1 then fprintf oc "\027[%dA%!" n
+
+let resume oc n =
+  if n >= 1 then fprintf oc "\027[%dB%!" n
+
+let standout oc b =
+  output_string oc (if b then "\027[4m" else "\027[0m"); flush oc
diff --git a/utils/terminfo.mli b/utils/terminfo.mli
new file mode 100644
index 00000000..10f5f545
--- /dev/null
+++ b/utils/terminfo.mli
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Basic interface to the terminfo database
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type status =
+  | Uninitialised
+  | Bad_term
+  | Good_term
+
+val setup : out_channel -> status
+val num_lines : out_channel -> int
+val backup : out_channel -> int -> unit
+val standout : out_channel -> bool -> unit
+val resume : out_channel -> int -> unit
diff --git a/utils/warnings.ml b/utils/warnings.ml
new file mode 100644
index 00000000..7adb3495
--- /dev/null
+++ b/utils/warnings.ml
@@ -0,0 +1,797 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Pierre Weis && Damien Doligez, INRIA Rocquencourt          *)
+(*                                                                        *)
+(*   Copyright 1998 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* When you change this, you need to update:
+   - the list 'description' at the bottom of this file
+   - man/ocamlc.m
+*)
+
+type loc = {
+  loc_start: Lexing.position;
+  loc_end: Lexing.position;
+  loc_ghost: bool;
+}
+
+type t =
+  | Comment_start                           (*  1 *)
+  | Comment_not_end                         (*  2 *)
+(*| Deprecated --> alert "deprecated" *)    (*  3 *)
+  | Fragile_match of string                 (*  4 *)
+  | Partial_application                     (*  5 *)
+  | Labels_omitted of string list           (*  6 *)
+  | Method_override of string list          (*  7 *)
+  | Partial_match of string                 (*  8 *)
+  | Non_closed_record_pattern of string     (*  9 *)
+  | Statement_type                          (* 10 *)
+  | Unused_match                            (* 11 *)
+  | Unused_pat                              (* 12 *)
+  | Instance_variable_override of string list (* 13 *)
+  | Illegal_backslash                       (* 14 *)
+  | Implicit_public_methods of string list  (* 15 *)
+  | Unerasable_optional_argument            (* 16 *)
+  | Undeclared_virtual_method of string     (* 17 *)
+  | Not_principal of string                 (* 18 *)
+  | Without_principality of string          (* 19 *)
+  | Unused_argument                         (* 20 *)
+  | Nonreturning_statement                  (* 21 *)
+  | Preprocessor of string                  (* 22 *)
+  | Useless_record_with                     (* 23 *)
+  | Bad_module_name of string               (* 24 *)
+  | All_clauses_guarded                     (* 8, used to be 25 *)
+  | Unused_var of string                    (* 26 *)
+  | Unused_var_strict of string             (* 27 *)
+  | Wildcard_arg_to_constant_constr         (* 28 *)
+  | Eol_in_string                           (* 29 *)
+  | Duplicate_definitions of string * string * string * string (*30 *)
+  | Multiple_definition of string * string * string (* 31 *)
+  | Unused_value_declaration of string      (* 32 *)
+  | Unused_open of string                   (* 33 *)
+  | Unused_type_declaration of string       (* 34 *)
+  | Unused_for_index of string              (* 35 *)
+  | Unused_ancestor of string               (* 36 *)
+  | Unused_constructor of string * bool * bool  (* 37 *)
+  | Unused_extension of string * bool * bool * bool (* 38 *)
+  | Unused_rec_flag                         (* 39 *)
+  | Name_out_of_scope of string * string list * bool (* 40 *)
+  | Ambiguous_name of string list * string list *  bool * string (* 41 *)
+  | Disambiguated_name of string            (* 42 *)
+  | Nonoptional_label of string             (* 43 *)
+  | Open_shadow_identifier of string * string (* 44 *)
+  | Open_shadow_label_constructor of string * string (* 45 *)
+  | Bad_env_variable of string * string     (* 46 *)
+  | Attribute_payload of string * string    (* 47 *)
+  | Eliminated_optional_arguments of string list (* 48 *)
+  | No_cmi_file of string * string option   (* 49 *)
+  | Bad_docstring of bool                   (* 50 *)
+  | Expect_tailcall                         (* 51 *)
+  | Fragile_literal_pattern                 (* 52 *)
+  | Misplaced_attribute of string           (* 53 *)
+  | Duplicated_attribute of string          (* 54 *)
+  | Inlining_impossible of string           (* 55 *)
+  | Unreachable_case                        (* 56 *)
+  | Ambiguous_pattern of string list        (* 57 *)
+  | No_cmx_file of string                   (* 58 *)
+  | Assignment_to_non_mutable_value         (* 59 *)
+  | Unused_module of string                 (* 60 *)
+  | Unboxable_type_in_prim_decl of string   (* 61 *)
+  | Constraint_on_gadt                      (* 62 *)
+  | Erroneous_printed_signature of string   (* 63 *)
+  | Unsafe_without_parsing                  (* 64 *)
+  | Redefining_unit of string               (* 65 *)
+  | Unused_open_bang of string              (* 66 *)
+  | Unused_functor_parameter of string      (* 67 *)
+;;
+
+(* If you remove a warning, leave a hole in the numbering.  NEVER change
+   the numbers of existing warnings.
+   If you add a new warning, add it at the end with a new number;
+   do NOT reuse one of the holes.
+*)
+
+type alert = {kind:string; message:string; def:loc; use:loc}
+
+
+let number = function
+  | Comment_start -> 1
+  | Comment_not_end -> 2
+  | Fragile_match _ -> 4
+  | Partial_application -> 5
+  | Labels_omitted _ -> 6
+  | Method_override _ -> 7
+  | Partial_match _ -> 8
+  | Non_closed_record_pattern _ -> 9
+  | Statement_type -> 10
+  | Unused_match -> 11
+  | Unused_pat -> 12
+  | Instance_variable_override _ -> 13
+  | Illegal_backslash -> 14
+  | Implicit_public_methods _ -> 15
+  | Unerasable_optional_argument -> 16
+  | Undeclared_virtual_method _ -> 17
+  | Not_principal _ -> 18
+  | Without_principality _ -> 19
+  | Unused_argument -> 20
+  | Nonreturning_statement -> 21
+  | Preprocessor _ -> 22
+  | Useless_record_with -> 23
+  | Bad_module_name _ -> 24
+  | All_clauses_guarded -> 8 (* used to be 25 *)
+  | Unused_var _ -> 26
+  | Unused_var_strict _ -> 27
+  | Wildcard_arg_to_constant_constr -> 28
+  | Eol_in_string -> 29
+  | Duplicate_definitions _ -> 30
+  | Multiple_definition _ -> 31
+  | Unused_value_declaration _ -> 32
+  | Unused_open _ -> 33
+  | Unused_type_declaration _ -> 34
+  | Unused_for_index _ -> 35
+  | Unused_ancestor _ -> 36
+  | Unused_constructor _ -> 37
+  | Unused_extension _ -> 38
+  | Unused_rec_flag -> 39
+  | Name_out_of_scope _ -> 40
+  | Ambiguous_name _ -> 41
+  | Disambiguated_name _ -> 42
+  | Nonoptional_label _ -> 43
+  | Open_shadow_identifier _ -> 44
+  | Open_shadow_label_constructor _ -> 45
+  | Bad_env_variable _ -> 46
+  | Attribute_payload _ -> 47
+  | Eliminated_optional_arguments _ -> 48
+  | No_cmi_file _ -> 49
+  | Bad_docstring _ -> 50
+  | Expect_tailcall -> 51
+  | Fragile_literal_pattern -> 52
+  | Misplaced_attribute _ -> 53
+  | Duplicated_attribute _ -> 54
+  | Inlining_impossible _ -> 55
+  | Unreachable_case -> 56
+  | Ambiguous_pattern _ -> 57
+  | No_cmx_file _ -> 58
+  | Assignment_to_non_mutable_value -> 59
+  | Unused_module _ -> 60
+  | Unboxable_type_in_prim_decl _ -> 61
+  | Constraint_on_gadt -> 62
+  | Erroneous_printed_signature _ -> 63
+  | Unsafe_without_parsing -> 64
+  | Redefining_unit _ -> 65
+  | Unused_open_bang _ -> 66
+  | Unused_functor_parameter _ -> 67
+;;
+
+let last_warning_number = 67
+;;
+
+(* Must be the max number returned by the [number] function. *)
+
+let letter = function
+  | 'a' ->
+     let rec loop i = if i = 0 then [] else i :: loop (i - 1) in
+     loop last_warning_number
+  | 'b' -> []
+  | 'c' -> [1; 2]
+  | 'd' -> [3]
+  | 'e' -> [4]
+  | 'f' -> [5]
+  | 'g' -> []
+  | 'h' -> []
+  | 'i' -> []
+  | 'j' -> []
+  | 'k' -> [32; 33; 34; 35; 36; 37; 38; 39]
+  | 'l' -> [6]
+  | 'm' -> [7]
+  | 'n' -> []
+  | 'o' -> []
+  | 'p' -> [8]
+  | 'q' -> []
+  | 'r' -> [9]
+  | 's' -> [10]
+  | 't' -> []
+  | 'u' -> [11; 12]
+  | 'v' -> [13]
+  | 'w' -> []
+  | 'x' -> [14; 15; 16; 17; 18; 19; 20; 21; 22; 23; 24; 30]
+  | 'y' -> [26]
+  | 'z' -> [27]
+  | _ -> assert false
+;;
+
+type state =
+  {
+    active: bool array;
+    error: bool array;
+    alerts: (Misc.Stdlib.String.Set.t * bool); (* false:set complement *)
+    alert_errors: (Misc.Stdlib.String.Set.t * bool); (* false:set complement *)
+  }
+
+let current =
+  ref
+    {
+      active = Array.make (last_warning_number + 1) true;
+      error = Array.make (last_warning_number + 1) false;
+      alerts = (Misc.Stdlib.String.Set.empty, false); (* all enabled *)
+      alert_errors = (Misc.Stdlib.String.Set.empty, true); (* all soft *)
+    }
+
+let disabled = ref false
+
+let without_warnings f =
+  Misc.protect_refs [Misc.R(disabled, true)] f
+
+let backup () = !current
+
+let restore x = current := x
+
+let is_active x =
+  not !disabled && (!current).active.(number x)
+
+let is_error x =
+  not !disabled && (!current).error.(number x)
+
+let alert_is_active {kind; _} =
+  not !disabled &&
+  let (set, pos) = (!current).alerts in
+  Misc.Stdlib.String.Set.mem kind set = pos
+
+let alert_is_error {kind; _} =
+  not !disabled &&
+  let (set, pos) = (!current).alert_errors in
+  Misc.Stdlib.String.Set.mem kind set = pos
+
+let mk_lazy f =
+  let state = backup () in
+  lazy
+    (
+      let prev = backup () in
+      restore state;
+      try
+        let r = f () in
+        restore prev;
+        r
+      with exn ->
+        restore prev;
+        raise exn
+    )
+
+let set_alert ~error ~enable s =
+  let upd =
+    match s with
+    | "all" ->
+        (Misc.Stdlib.String.Set.empty, not enable)
+    | s ->
+        let (set, pos) =
+          if error then (!current).alert_errors else (!current).alerts
+        in
+        let f =
+          if enable = pos
+          then Misc.Stdlib.String.Set.add
+          else Misc.Stdlib.String.Set.remove
+        in
+        (f s set, pos)
+  in
+  if error then
+    current := {(!current) with alert_errors=upd}
+  else
+    current := {(!current) with alerts=upd}
+
+let parse_alert_option s =
+  let n = String.length s in
+  let id_char = function
+    | 'a'..'z' | 'A'..'Z' | '_' | '\'' | '0'..'9' -> true
+    | _ -> false
+  in
+  let rec parse_id i =
+    if i < n && id_char s.[i] then parse_id (i + 1) else i
+  in
+  let rec scan i =
+    if i = n then ()
+    else if i + 1 = n then raise (Arg.Bad "Ill-formed list of alert settings")
+    else match s.[i], s.[i+1] with
+      | '+', '+' -> id (set_alert ~error:true ~enable:true) (i + 2)
+      | '+', _ -> id (set_alert ~error:false ~enable:true) (i + 1)
+      | '-', '-' -> id (set_alert ~error:true ~enable:false) (i + 2)
+      | '-', _ -> id (set_alert ~error:false ~enable:false) (i + 1)
+      | '@', _ ->
+          id (fun s ->
+              set_alert ~error:true ~enable:true s;
+              set_alert ~error:false ~enable:true s)
+            (i + 1)
+      | _ -> raise (Arg.Bad "Ill-formed list of alert settings")
+  and id f i =
+    let j = parse_id i in
+    if j = i then raise (Arg.Bad "Ill-formed list of alert settings");
+    let id = String.sub s i (j - i) in
+    f id;
+    scan j
+  in
+  scan 0
+
+let parse_opt error active errflag s =
+  let flags = if errflag then error else active in
+  let set i =
+    if i = 3 then set_alert ~error:errflag ~enable:true "deprecated"
+    else flags.(i) <- true
+  in
+  let clear i =
+    if i = 3 then set_alert ~error:errflag ~enable:false "deprecated"
+    else flags.(i) <- false
+  in
+  let set_all i =
+    if i = 3 then begin
+      set_alert ~error:false ~enable:true "deprecated";
+      set_alert ~error:true ~enable:true "deprecated"
+    end
+    else begin
+      active.(i) <- true;
+      error.(i) <- true
+    end
+  in
+  let error () = raise (Arg.Bad "Ill-formed list of warnings") in
+  let rec get_num n i =
+    if i >= String.length s then i, n
+    else match s.[i] with
+    | '0'..'9' -> get_num (10 * n + Char.code s.[i] - Char.code '0') (i + 1)
+    | _ -> i, n
+  in
+  let get_range i =
+    let i, n1 = get_num 0 i in
+    if i + 2 < String.length s && s.[i] = '.' && s.[i + 1] = '.' then
+      let i, n2 = get_num 0 (i + 2) in
+      if n2 < n1 then error ();
+      i, n1, n2
+    else
+      i, n1, n1
+  in
+  let rec loop i =
+    if i >= String.length s then () else
+    match s.[i] with
+    | 'A' .. 'Z' ->
+       List.iter set (letter (Char.lowercase_ascii s.[i]));
+       loop (i+1)
+    | 'a' .. 'z' ->
+       List.iter clear (letter s.[i]);
+       loop (i+1)
+    | '+' -> loop_letter_num set (i+1)
+    | '-' -> loop_letter_num clear (i+1)
+    | '@' -> loop_letter_num set_all (i+1)
+    | _ -> error ()
+  and loop_letter_num myset i =
+    if i >= String.length s then error () else
+    match s.[i] with
+    | '0' .. '9' ->
+        let i, n1, n2 = get_range i in
+        for n = n1 to min n2 last_warning_number do myset n done;
+        loop i
+    | 'A' .. 'Z' ->
+       List.iter myset (letter (Char.lowercase_ascii s.[i]));
+       loop (i+1)
+    | 'a' .. 'z' ->
+       List.iter myset (letter s.[i]);
+       loop (i+1)
+    | _ -> error ()
+  in
+  loop 0
+;;
+
+let parse_options errflag s =
+  let error = Array.copy (!current).error in
+  let active = Array.copy (!current).active in
+  parse_opt error active errflag s;
+  current := {(!current) with error; active}
+
+(* If you change these, don't forget to change them in man/ocamlc.m *)
+let defaults_w = "+a-4-6-7-9-27-29-30-32..42-44-45-48-50-60-66-67";;
+let defaults_warn_error = "-a+31";;
+
+let () = parse_options false defaults_w;;
+let () = parse_options true defaults_warn_error;;
+
+let ref_manual_explanation () =
+  (* manual references are checked a posteriori by the manual
+     cross-reference consistency check in manual/tests*)
+  let[@manual.ref "s:comp-warnings"] chapter, section = 9, 5 in
+  Printf.sprintf "(See manual section %d.%d)" chapter section
+
+let message = function
+  | Comment_start ->
+      "this `(*' is the start of a comment.\n\
+       Hint: Did you forget spaces when writing the infix operator `( * )'?"
+  | Comment_not_end -> "this is not the end of a comment."
+  | Fragile_match "" ->
+      "this pattern-matching is fragile."
+  | Fragile_match s ->
+      "this pattern-matching is fragile.\n\
+       It will remain exhaustive when constructors are added to type " ^ s ^ "."
+  | Partial_application ->
+      "this function application is partial,\n\
+       maybe some arguments are missing."
+  | Labels_omitted [] -> assert false
+  | Labels_omitted [l] ->
+     "label " ^ l ^ " was omitted in the application of this function."
+  | Labels_omitted ls ->
+     "labels " ^ String.concat ", " ls ^
+       " were omitted in the application of this function."
+  | Method_override [lab] ->
+      "the method " ^ lab ^ " is overridden."
+  | Method_override (cname :: slist) ->
+      String.concat " "
+        ("the following methods are overridden by the class"
+         :: cname  :: ":\n " :: slist)
+  | Method_override [] -> assert false
+  | Partial_match "" -> "this pattern-matching is not exhaustive."
+  | Partial_match s ->
+      "this pattern-matching is not exhaustive.\n\
+       Here is an example of a case that is not matched:\n" ^ s
+  | Non_closed_record_pattern s ->
+      "the following labels are not bound in this record pattern:\n" ^ s ^
+      "\nEither bind these labels explicitly or add '; _' to the pattern."
+  | Statement_type ->
+      "this expression should have type unit."
+  | Unused_match -> "this match case is unused."
+  | Unused_pat   -> "this sub-pattern is unused."
+  | Instance_variable_override [lab] ->
+      "the instance variable " ^ lab ^ " is overridden.\n" ^
+      "The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)"
+  | Instance_variable_override (cname :: slist) ->
+      String.concat " "
+        ("the following instance variables are overridden by the class"
+         :: cname  :: ":\n " :: slist) ^
+      "\nThe behaviour changed in ocaml 3.10 (previous behaviour was hiding.)"
+  | Instance_variable_override [] -> assert false
+  | Illegal_backslash -> "illegal backslash escape in string."
+  | Implicit_public_methods l ->
+      "the following private methods were made public implicitly:\n "
+      ^ 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."
+  | Without_principality s -> s^" without principality."
+  | Unused_argument -> "this argument will not be used by the function."
+  | Nonreturning_statement ->
+      "this statement never returns (or has an unsound type.)"
+  | Preprocessor s -> s
+  | Useless_record_with ->
+      "all the fields are explicitly listed in this record:\n\
+       the 'with' clause is useless."
+  | Bad_module_name (modname) ->
+      "bad source file name: \"" ^ modname ^ "\" is not a valid module name."
+  | All_clauses_guarded ->
+      "this pattern-matching is not exhaustive.\n\
+       All clauses in this pattern-matching are guarded."
+  | Unused_var v | Unused_var_strict v -> "unused variable " ^ v ^ "."
+  | Wildcard_arg_to_constant_constr ->
+     "wildcard pattern given as argument to a constant constructor"
+  | Eol_in_string ->
+     "unescaped end-of-line in a string constant (non-portable code)"
+  | Duplicate_definitions (kind, cname, tc1, tc2) ->
+      Printf.sprintf "the %s %s is defined in both types %s and %s."
+        kind cname tc1 tc2
+  | Multiple_definition(modname, file1, file2) ->
+      Printf.sprintf
+        "files %s and %s both define a module named %s"
+        file1 file2 modname
+  | Unused_value_declaration v -> "unused value " ^ v ^ "."
+  | Unused_open s -> "unused open " ^ s ^ "."
+  | Unused_open_bang s -> "unused open! " ^ s ^ "."
+  | Unused_type_declaration s -> "unused type " ^ s ^ "."
+  | Unused_for_index s -> "unused for-loop index " ^ s ^ "."
+  | Unused_ancestor s -> "unused ancestor variable " ^ s ^ "."
+  | Unused_constructor (s, false, false) -> "unused constructor " ^ s ^ "."
+  | Unused_constructor (s, true, _) ->
+      "constructor " ^ s ^
+      " is never used to build values.\n\
+        (However, this constructor appears in patterns.)"
+  | Unused_constructor (s, false, true) ->
+      "constructor " ^ s ^
+      " is never used to build values.\n\
+        Its type is exported as a private type."
+  | Unused_extension (s, is_exception, cu_pattern, cu_privatize) ->
+     let kind =
+       if is_exception then "exception" else "extension constructor" in
+     let name = kind ^ " " ^ s in
+     begin match cu_pattern, cu_privatize with
+       | false, false -> "unused " ^ name
+       | true, _ ->
+          name ^
+          " is never used to build values.\n\
+           (However, this constructor appears in patterns.)"
+       | false, true ->
+          name ^
+          " is never used to build values.\n\
+            It is exported or rebound as a private extension."
+     end
+  | Unused_rec_flag ->
+      "unused rec flag."
+  | Name_out_of_scope (ty, [nm], false) ->
+      nm ^ " was selected from type " ^ ty ^
+      ".\nIt is not visible in the current scope, and will not \n\
+       be selected if the type becomes unknown."
+  | Name_out_of_scope (_, _, false) -> assert false
+  | Name_out_of_scope (ty, slist, true) ->
+      "this record of type "^ ty ^" contains fields that are \n\
+       not visible in the current scope: "
+      ^ String.concat " " slist ^ ".\n\
+       They will not be selected if the type becomes unknown."
+  | Ambiguous_name ([s], tl, false, expansion) ->
+      s ^ " belongs to several types: " ^ String.concat " " tl ^
+      "\nThe first one was selected. Please disambiguate if this is wrong."
+      ^ expansion
+  | Ambiguous_name (_, _, false, _ ) -> assert false
+  | Ambiguous_name (_slist, tl, true, expansion) ->
+      "these field labels belong to several types: " ^
+      String.concat " " tl ^
+      "\nThe first one was selected. Please disambiguate if this is wrong."
+      ^ expansion
+  | Disambiguated_name s ->
+      "this use of " ^ s ^ " relies on type-directed disambiguation,\n\
+       it will not compile with OCaml 4.00 or earlier."
+  | Nonoptional_label s ->
+      "the label " ^ s ^ " is not optional."
+  | Open_shadow_identifier (kind, s) ->
+      Printf.sprintf
+        "this open statement shadows the %s identifier %s (which is later used)"
+        kind s
+  | Open_shadow_label_constructor (kind, s) ->
+      Printf.sprintf
+        "this open statement shadows the %s %s (which is later used)"
+        kind s
+  | Bad_env_variable (var, s) ->
+      Printf.sprintf "illegal environment variable %s : %s" var s
+  | Attribute_payload (a, s) ->
+      Printf.sprintf "illegal payload for attribute '%s'.\n%s" a s
+  | Eliminated_optional_arguments sl ->
+      Printf.sprintf "implicit elimination of optional argument%s %s"
+        (if List.length sl = 1 then "" else "s")
+        (String.concat ", " sl)
+  | No_cmi_file(name, None) ->
+      "no cmi file was found in path for module " ^ name
+  | No_cmi_file(name, Some msg) ->
+      Printf.sprintf
+        "no valid cmi file was found in path for module %s. %s"
+        name msg
+  | Bad_docstring unattached ->
+      if unattached then "unattached documentation comment (ignored)"
+      else "ambiguous documentation comment"
+  | Expect_tailcall ->
+      Printf.sprintf "expected tailcall"
+  | Fragile_literal_pattern ->
+      Printf.sprintf
+        "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. %t" ref_manual_explanation
+  | Unreachable_case ->
+      "this match case is unreachable.\n\
+       Consider replacing it with a refutation case ' -> .'"
+  | Misplaced_attribute attr_name ->
+      Printf.sprintf "the %S attribute cannot appear in this context" attr_name
+  | Duplicated_attribute attr_name ->
+      Printf.sprintf "the %S attribute is used more than once on this \
+          expression"
+        attr_name
+  | Inlining_impossible reason ->
+      Printf.sprintf "Cannot inline: %s" reason
+  | Ambiguous_pattern vars ->
+      let msg =
+        let vars = List.sort String.compare vars in
+        match vars with
+        | [] -> assert false
+        | [x] -> "variable " ^ x
+        | _::_ ->
+            "variables " ^ String.concat "," vars in
+      Printf.sprintf
+        "Ambiguous or-pattern variables under guard;\n\
+         %s may match different arguments. %t"
+        msg ref_manual_explanation
+  | No_cmx_file name ->
+      Printf.sprintf
+        "no cmx file was found in path for module %s, \
+         and its interface was not compiled with -opaque" name
+  | Assignment_to_non_mutable_value ->
+      "A potential assignment to a non-mutable value was detected \n\
+        in this source file.  Such assignments may generate incorrect code \n\
+        when using Flambda."
+  | Unused_module s -> "unused module " ^ s ^ "."
+  | Unboxable_type_in_prim_decl t ->
+      Printf.sprintf
+        "This primitive declaration uses type %s, whose representation\n\
+         may be either boxed or unboxed. Without an annotation to indicate\n\
+         which representation is intended, the boxed representation has been\n\
+         selected by default. This default choice may change in future\n\
+         versions of the compiler, breaking the primitive implementation.\n\
+         You should explicitly annotate the declaration of %s\n\
+         with [@@boxed] or [@@unboxed], so that its external interface\n\
+         remains stable in the future." t t
+  | Constraint_on_gadt ->
+      "Type constraints do not apply to GADT cases of variant types."
+  | 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."
+     ^ s
+     ^ "\nBeware that this warning is purely informational and will not catch\n\
+        all instances of erroneous printed interface."
+  | Unsafe_without_parsing ->
+     "option -unsafe used with a preprocessor returning a syntax tree"
+  | Redefining_unit name ->
+      Printf.sprintf
+        "This type declaration is defining a new '()' constructor\n\
+         which shadows the existing one.\n\
+         Hint: Did you mean 'type %s = unit'?" name
+  | Unused_functor_parameter s -> "unused functor parameter " ^ s ^ "."
+;;
+
+let nerrors = ref 0;;
+
+type reporting_information =
+  { id : string
+  ; message : string
+  ; is_error : bool
+  ; sub_locs : (loc * string) list;
+  }
+
+let report w =
+  match is_active w with
+  | false -> `Inactive
+  | true ->
+     if is_error w then incr nerrors;
+     `Active
+       { id = string_of_int (number w);
+         message = message w;
+         is_error = is_error w;
+         sub_locs = [];
+       }
+
+let report_alert (alert : alert) =
+  match alert_is_active alert with
+  | false -> `Inactive
+  | true ->
+      let is_error = alert_is_error alert in
+      if is_error then incr nerrors;
+      let message = Misc.normalise_eol alert.message in
+       (* Reduce \r\n to \n:
+           - Prevents any \r characters being printed on Unix when processing
+             Windows sources
+           - Prevents \r\r\n being generated on Windows, which affects the
+             testsuite
+       *)
+      let sub_locs =
+        if not alert.def.loc_ghost && not alert.use.loc_ghost then
+          [
+            alert.def, "Definition";
+            alert.use, "Expected signature";
+          ]
+        else
+          []
+      in
+      `Active
+        {
+          id = alert.kind;
+          message;
+          is_error;
+          sub_locs;
+        }
+
+exception Errors;;
+
+let reset_fatal () =
+  nerrors := 0
+
+let check_fatal () =
+  if !nerrors > 0 then begin
+    nerrors := 0;
+    raise Errors;
+  end;
+;;
+
+let descriptions =
+  [
+    1, "Suspicious-looking start-of-comment mark.";
+    2, "Suspicious-looking end-of-comment mark.";
+    3, "Deprecated synonym for the 'deprecated' alert.";
+    4, "Fragile pattern matching: matching that will remain complete even\n\
+   \    if additional constructors are added to one of the variant types\n\
+   \    matched.";
+    5, "Partially applied function: expression whose result has function\n\
+   \    type and is ignored.";
+    6, "Label omitted in function application.";
+    7, "Method overridden.";
+    8, "Partial match: missing cases in pattern-matching.";
+    9, "Missing fields in a record pattern.";
+   10, "Expression on the left-hand side of a sequence that doesn't have \
+      type\n\
+   \    \"unit\" (and that is not a function, see warning number 5).";
+   11, "Redundant case in a pattern matching (unused match case).";
+   12, "Redundant sub-pattern in a pattern-matching.";
+   13, "Instance variable overridden.";
+   14, "Illegal backslash escape in a string constant.";
+   15, "Private method made public implicitly.";
+   16, "Unerasable optional argument.";
+   17, "Undeclared virtual method.";
+   18, "Non-principal type.";
+   19, "Type without principality.";
+   20, "Unused function argument.";
+   21, "Non-returning statement.";
+   22, "Preprocessor warning.";
+   23, "Useless record \"with\" clause.";
+   24, "Bad module name: the source file name is not a valid OCaml module \
+        name.";
+   25, "Deprecated: now part of warning 8.";
+   26, "Suspicious unused variable: unused variable that is bound\n\
+   \    with \"let\" or \"as\", and doesn't start with an underscore (\"_\")\n\
+   \    character.";
+   27, "Innocuous unused variable: unused variable that is not bound with\n\
+   \    \"let\" nor \"as\", and doesn't start with an underscore (\"_\")\n\
+   \    character.";
+   28, "Wildcard pattern given as argument to a constant constructor.";
+   29, "Unescaped end-of-line in a string constant (non-portable code).";
+   30, "Two labels or constructors of the same name are defined in two\n\
+   \    mutually recursive types.";
+   31, "A module is linked twice in the same executable.";
+   32, "Unused value declaration.";
+   33, "Unused open statement.";
+   34, "Unused type declaration.";
+   35, "Unused for-loop index.";
+   36, "Unused ancestor variable.";
+   37, "Unused constructor.";
+   38, "Unused extension constructor.";
+   39, "Unused rec flag.";
+   40, "Constructor or label name used out of scope.";
+   41, "Ambiguous constructor or label name.";
+   42, "Disambiguated constructor or label name (compatibility warning).";
+   43, "Nonoptional label applied as optional.";
+   44, "Open statement shadows an already defined identifier.";
+   45, "Open statement shadows an already defined label or constructor.";
+   46, "Error in environment variable.";
+   47, "Illegal attribute payload.";
+   48, "Implicit elimination of optional arguments.";
+   49, "Absent cmi file when looking up module alias.";
+   50, "Unexpected documentation comment.";
+   51, "Warning on non-tail calls if @tailcall present.";
+   52, "Fragile constant pattern.";
+   53, "Attribute cannot appear in this context.";
+   54, "Attribute used more than once on an expression.";
+   55, "Inlining impossible.";
+   56, "Unreachable case in a pattern-matching (based on type information).";
+   57, "Ambiguous or-pattern variables under guard.";
+   58, "Missing cmx file.";
+   59, "Assignment to non-mutable value.";
+   60, "Unused module declaration.";
+   61, "Unboxable type in primitive declaration.";
+   62, "Type constraint on GADT type declaration.";
+   63, "Erroneous printed signature.";
+   64, "-unsafe used with a preprocessor returning a syntax tree.";
+   65, "Type declaration defining a new '()' constructor.";
+   66, "Unused open! statement.";
+   67, "Unused functor parameter.";
+  ]
+;;
+
+let help_warnings () =
+  List.iter (fun (i, s) -> Printf.printf "%3i %s\n" i s) descriptions;
+  print_endline "  A all warnings";
+  for i = Char.code 'b' to Char.code 'z' do
+    let c = Char.chr i in
+    match letter c with
+    | [] -> ()
+    | [n] ->
+        Printf.printf "  %c Alias for warning %i.\n" (Char.uppercase_ascii c) n
+    | l ->
+        Printf.printf "  %c warnings %s.\n"
+          (Char.uppercase_ascii c)
+          (String.concat ", " (List.map Int.to_string l))
+  done;
+  exit 0
+;;
diff --git a/utils/warnings.mli b/utils/warnings.mli
new file mode 100644
index 00000000..b80ab34c
--- /dev/null
+++ b/utils/warnings.mli
@@ -0,0 +1,140 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Pierre Weis && Damien Doligez, INRIA Rocquencourt          *)
+(*                                                                        *)
+(*   Copyright 1998 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Warning definitions
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type loc = {
+  loc_start: Lexing.position;
+  loc_end: Lexing.position;
+  loc_ghost: bool;
+}
+
+type t =
+  | Comment_start                           (*  1 *)
+  | Comment_not_end                         (*  2 *)
+(*| Deprecated --> alert "deprecated" *)    (*  3 *)
+  | Fragile_match of string                 (*  4 *)
+  | Partial_application                     (*  5 *)
+  | Labels_omitted of string list           (*  6 *)
+  | Method_override of string list          (*  7 *)
+  | Partial_match of string                 (*  8 *)
+  | Non_closed_record_pattern of string     (*  9 *)
+  | Statement_type                          (* 10 *)
+  | Unused_match                            (* 11 *)
+  | Unused_pat                              (* 12 *)
+  | Instance_variable_override of string list (* 13 *)
+  | Illegal_backslash                       (* 14 *)
+  | Implicit_public_methods of string list  (* 15 *)
+  | Unerasable_optional_argument            (* 16 *)
+  | Undeclared_virtual_method of string     (* 17 *)
+  | Not_principal of string                 (* 18 *)
+  | Without_principality of string          (* 19 *)
+  | Unused_argument                         (* 20 *)
+  | Nonreturning_statement                  (* 21 *)
+  | Preprocessor of string                  (* 22 *)
+  | Useless_record_with                     (* 23 *)
+  | Bad_module_name of string               (* 24 *)
+  | All_clauses_guarded                     (* 8, used to be 25 *)
+  | Unused_var of string                    (* 26 *)
+  | Unused_var_strict of string             (* 27 *)
+  | Wildcard_arg_to_constant_constr         (* 28 *)
+  | Eol_in_string                           (* 29 *)
+  | Duplicate_definitions of string * string * string * string (* 30 *)
+  | Multiple_definition of string * string * string (* 31 *)
+  | Unused_value_declaration of string      (* 32 *)
+  | Unused_open of string                   (* 33 *)
+  | Unused_type_declaration of string       (* 34 *)
+  | Unused_for_index of string              (* 35 *)
+  | Unused_ancestor of string               (* 36 *)
+  | Unused_constructor of string * bool * bool (* 37 *)
+  | Unused_extension of string * bool * bool * bool (* 38 *)
+  | Unused_rec_flag                         (* 39 *)
+  | Name_out_of_scope of string * string list * bool   (* 40 *)
+  | Ambiguous_name of string list * string list * bool * string (* 41 *)
+  | Disambiguated_name of string            (* 42 *)
+  | Nonoptional_label of string             (* 43 *)
+  | Open_shadow_identifier of string * string (* 44 *)
+  | Open_shadow_label_constructor of string * string (* 45 *)
+  | Bad_env_variable of string * string     (* 46 *)
+  | Attribute_payload of string * string    (* 47 *)
+  | Eliminated_optional_arguments of string list (* 48 *)
+  | No_cmi_file of string * string option   (* 49 *)
+  | Bad_docstring of bool                   (* 50 *)
+  | Expect_tailcall                         (* 51 *)
+  | Fragile_literal_pattern                 (* 52 *)
+  | Misplaced_attribute of string           (* 53 *)
+  | Duplicated_attribute of string          (* 54 *)
+  | Inlining_impossible of string           (* 55 *)
+  | Unreachable_case                        (* 56 *)
+  | Ambiguous_pattern of string list        (* 57 *)
+  | No_cmx_file of string                   (* 58 *)
+  | Assignment_to_non_mutable_value         (* 59 *)
+  | Unused_module of string                 (* 60 *)
+  | Unboxable_type_in_prim_decl of string   (* 61 *)
+  | Constraint_on_gadt                      (* 62 *)
+  | Erroneous_printed_signature of string   (* 63 *)
+  | Unsafe_without_parsing                  (* 64 *)
+  | Redefining_unit of string               (* 65 *)
+  | Unused_open_bang of string              (* 66 *)
+  | Unused_functor_parameter of string      (* 67 *)
+;;
+
+type alert = {kind:string; message:string; def:loc; use:loc}
+
+val parse_options : bool -> string -> unit;;
+
+val parse_alert_option: string -> unit
+  (** Disable/enable alerts based on the parameter to the -alert
+      command-line option.  Raises [Arg.Bad] if the string is not a
+      valid specification.
+  *)
+
+val without_warnings : (unit -> 'a) -> 'a
+  (** Run the thunk with all warnings and alerts disabled. *)
+
+val is_active : t -> bool;;
+val is_error : t -> bool;;
+
+val defaults_w : string;;
+val defaults_warn_error : string;;
+
+type reporting_information =
+  { id : string
+  ; message : string
+  ; is_error : bool
+  ; sub_locs : (loc * string) list;
+  }
+
+val report : t -> [ `Active of reporting_information | `Inactive ]
+val report_alert : alert -> [ `Active of reporting_information | `Inactive ]
+
+exception Errors;;
+
+val check_fatal : unit -> unit;;
+val reset_fatal: unit -> unit
+
+val help_warnings: unit -> unit
+
+type state
+val backup: unit -> state
+val restore: state -> unit
+val mk_lazy: (unit -> 'a) -> 'a Lazy.t
+    (** Like [Lazy.of_fun], but the function is applied with
+        the warning/alert settings at the time [mk_lazy] is called. *)
diff --git a/yacc/Makefile b/yacc/Makefile
new file mode 100644
index 00000000..82b91980
--- /dev/null
+++ b/yacc/Makefile
@@ -0,0 +1,64 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
+#*                                                                        *
+#*   Copyright 1999 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# Makefile for the parser generator.
+
+ROOTDIR = ..
+
+-include $(ROOTDIR)/Makefile.config
+-include $(ROOTDIR)/Makefile.common
+
+OC_CPPFLAGS += -I$(ROOTDIR)/runtime
+
+ifeq "$(UNIX_OR_WIN32)" "win32"
+WSTR_OBJ = wstr
+else
+WSTR_OBJ =
+endif
+
+ocamlyacc_SOURCES := $(addsuffix .c,\
+  $(WSTR_OBJ) closure error lalr lr0 main mkpar output reader skeleton \
+  symtab verbose warshall)
+
+ocamlyacc_OBJECTS := $(ocamlyacc_SOURCES:.c=.$(O))
+
+generated_files := ocamlyacc$(EXE) $(ocamlyacc_OBJECTS)  version.h
+
+all: ocamlyacc$(EXE)
+
+ocamlyacc$(EXE): $(ocamlyacc_OBJECTS)
+	$(MKEXE) -o $@ $^ $(EXTRALIBS)
+
+version.h : $(ROOTDIR)/VERSION
+	echo "#define OCAML_VERSION \"`sed -e 1q $< | tr -d '\r'`\"" > $@
+
+clean:
+	rm -f ocamlyacc ocamlyacc.exe wstr.o wstr.obj version.h \
+        $(ocamlyacc_SOURCES:.c=.o) $(ocamlyacc_SOURCES:.c=.obj)
+
+depend:
+
+closure.$(O): defs.h
+error.$(O): defs.h
+lalr.$(O): defs.h
+lr0.$(O): defs.h
+main.$(O): defs.h version.h
+mkpar.$(O): defs.h
+output.$(O): defs.h
+reader.$(O): defs.h
+skeleton.$(O): defs.h
+symtab.$(O): defs.h
+verbose.$(O): defs.h
+warshall.$(O): defs.h
diff --git a/yacc/closure.c b/yacc/closure.c
new file mode 100644
index 00000000..3f07ecf1
--- /dev/null
+++ b/yacc/closure.c
@@ -0,0 +1,284 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Based on public-domain code from Berkeley Yacc */
+
+#include "defs.h"
+
+short *itemset;
+short *itemsetend;
+unsigned *ruleset;
+
+static unsigned *first_derives;
+static unsigned *EFF;
+
+
+
+void print_EFF (void);
+void print_first_derives (void);
+void print_closure (void);
+
+void set_EFF(void)
+{
+    register unsigned *row;
+    register int symbol;
+    register short *sp;
+    register int rowsize;
+    register int i;
+    register int rule;
+
+    rowsize = WORDSIZE(nvars);
+    EFF = NEW2(nvars * rowsize, unsigned);
+
+    row = EFF;
+    for (i = start_symbol; i < nsyms; i++)
+    {
+        sp = derives[i];
+        for (rule = *sp; rule > 0; rule = *++sp)
+        {
+            symbol = ritem[rrhs[rule]];
+            if (ISVAR(symbol))
+            {
+                symbol -= start_symbol;
+                SETBIT(row, symbol);
+            }
+        }
+        row += rowsize;
+    }
+
+    reflexive_transitive_closure(EFF, nvars);
+
+#ifdef        DEBUG
+    print_EFF();
+#endif
+}
+
+
+void set_first_derives(void)
+{
+  register unsigned *rrow;
+  register unsigned *vrow;
+  register int j;
+  register unsigned mask;
+  register unsigned cword;
+  register short *rp;
+
+  int rule;
+  int i;
+  int rulesetsize;
+  int varsetsize;
+
+  rulesetsize = WORDSIZE(nrules);
+  varsetsize = WORDSIZE(nvars);
+  first_derives = NEW2(nvars * rulesetsize, unsigned) - ntokens * rulesetsize;
+
+  set_EFF();
+
+  rrow = first_derives + ntokens * rulesetsize;
+  for (i = start_symbol; i < nsyms; i++)
+    {
+      vrow = EFF + ((i - ntokens) * varsetsize);
+      cword = *vrow++;
+      mask = 1;
+      for (j = start_symbol; j < nsyms; j++)
+        {
+          if (cword & mask)
+            {
+              rp = derives[j];
+              while ((rule = *rp++) >= 0)
+                {
+                  SETBIT(rrow, rule);
+                }
+            }
+
+          mask <<= 1;
+          if (mask == 0)
+            {
+              cword = *vrow++;
+              mask = 1;
+            }
+        }
+
+      vrow += varsetsize;
+      rrow += rulesetsize;
+    }
+
+#ifdef        DEBUG
+  print_first_derives();
+#endif
+
+  FREE(EFF);
+}
+
+
+void closure(short int *nucleus, int n)
+{
+    register int ruleno;
+    register unsigned word;
+    register unsigned mask;
+    register short *csp;
+    register unsigned *dsp;
+    register unsigned *rsp;
+    register int rulesetsize;
+
+    short *csend;
+    unsigned *rsend;
+    int symbol;
+    int itemno;
+
+    rulesetsize = WORDSIZE(nrules);
+    rsp = ruleset;
+    rsend = ruleset + rulesetsize;
+    for (rsp = ruleset; rsp < rsend; rsp++)
+        *rsp = 0;
+
+    csend = nucleus + n;
+    for (csp = nucleus; csp < csend; ++csp)
+    {
+        symbol = ritem[*csp];
+        if (ISVAR(symbol))
+        {
+            dsp = first_derives + symbol * rulesetsize;
+            rsp = ruleset;
+            while (rsp < rsend)
+                *rsp++ |= *dsp++;
+        }
+    }
+
+    ruleno = 0;
+    itemsetend = itemset;
+    csp = nucleus;
+    for (rsp = ruleset; rsp < rsend; ++rsp)
+    {
+        word = *rsp;
+        if (word == 0)
+            ruleno += BITS_PER_WORD;
+        else
+        {
+            mask = 1;
+            while (mask)
+            {
+                if (word & mask)
+                {
+                    itemno = rrhs[ruleno];
+                    while (csp < csend && *csp < itemno)
+                        *itemsetend++ = *csp++;
+                    *itemsetend++ = itemno;
+                    while (csp < csend && *csp == itemno)
+                        ++csp;
+                }
+
+                    mask <<= 1;
+                    ++ruleno;
+            }
+        }
+    }
+
+    while (csp < csend)
+        *itemsetend++ = *csp++;
+
+#ifdef        DEBUG
+  print_closure(n);
+#endif
+}
+
+
+
+void finalize_closure(void)
+{
+  FREE(itemset);
+  FREE(ruleset);
+  FREE(first_derives + ntokens * WORDSIZE(nrules));
+}
+
+
+#ifdef        DEBUG
+
+void print_closure(int n)
+{
+  register short *isp;
+
+  printf("\n\nn = %d\n\n", n);
+  for (isp = itemset; isp < itemsetend; isp++)
+    printf("   %d\n", *isp);
+}
+
+
+void print_EFF(void)
+{
+    register int i, j;
+    register unsigned *rowp;
+    register unsigned word;
+    register unsigned mask;
+
+    printf("\n\nEpsilon Free Firsts\n");
+
+    for (i = start_symbol; i < nsyms; i++)
+    {
+        printf("\n%s", symbol_name[i]);
+        rowp = EFF + ((i - start_symbol) * WORDSIZE(nvars));
+        word = *rowp++;
+
+        mask = 1;
+        for (j = 0; j < nvars; j++)
+        {
+            if (word & mask)
+                printf("  %s", symbol_name[start_symbol + j]);
+
+            mask <<= 1;
+            if (mask == 0)
+            {
+                word = *rowp++;
+                mask = 1;
+            }
+        }
+    }
+}
+
+
+void print_first_derives(void)
+{
+  register int i;
+  register int j;
+  register unsigned *rp;
+  register unsigned cword;
+  register unsigned mask;
+
+  printf("\n\n\nFirst Derives\n");
+
+  for (i = start_symbol; i < nsyms; i++)
+    {
+      printf("\n%s derives\n", symbol_name[i]);
+      rp = first_derives + i * WORDSIZE(nrules);
+      cword = *rp++;
+      mask = 1;
+      for (j = 0; j <= nrules; j++)
+        {
+          if (cword & mask)
+            printf("   %d\n", j);
+
+          mask <<= 1;
+          if (mask == 0)
+            {
+              cword = *rp++;
+              mask = 1;
+            }
+        }
+    }
+
+  fflush(stdout);
+}
+
+#endif
diff --git a/yacc/defs.h b/yacc/defs.h
new file mode 100644
index 00000000..1fd3dc68
--- /dev/null
+++ b/yacc/defs.h
@@ -0,0 +1,364 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Based on public-domain code from Berkeley Yacc */
+
+#ifndef DEBUG
+#define NDEBUG
+#endif
+
+#include 
+#include 
+#include 
+#include 
+#include 
+#include 
+#include 
+#define CAML_INTERNALS
+#include "caml/config.h"
+#include "caml/mlvalues.h"
+#include "caml/osdeps.h"
+
+#define caml_stat_strdup strdup
+
+/*  machine-dependent definitions                              */
+/*  the following definitions are for the Tahoe                */
+/*  they might have to be changed for other machines           */
+
+/*  MAXCHAR is the largest unsigned character value            */
+/*  MAXSHORT is the largest value of a C short                 */
+/*  MINSHORT is the most negative value of a C short           */
+/*  MAXTABLE is the maximum table size                         */
+/*  BITS_PER_WORD is the number of bits in a C unsigned        */
+/*  WORDSIZE computes the number of words needed to            */
+/*        store n bits                                         */
+/*  BIT returns the value of the n-th bit starting             */
+/*        from r (0-indexed)                                   */
+/*  SETBIT sets the n-th bit starting from r                   */
+
+#define        MAXCHAR                UCHAR_MAX
+#define        MAXSHORT        SHRT_MAX
+#define MINSHORT        SHRT_MIN
+#define MAXTABLE        32500
+
+#define BITS_PER_WORD        (8*sizeof(unsigned))
+#define        WORDSIZE(n)        (((n)+(BITS_PER_WORD-1))/BITS_PER_WORD)
+#define        BIT(r, n)        ((((r)[(n)/BITS_PER_WORD])>>((n)%BITS_PER_WORD))&1)
+#define        SETBIT(r, n)        ((r)[(n)/BITS_PER_WORD]|=(1<<((n)%BITS_PER_WORD)))
+
+/*  character names  */
+
+#define        NUL                '\0'    /*  the null character  */
+#define        NEWLINE                '\n'    /*  line feed  */
+#define        SP                ' '     /*  space  */
+#define        BS                '\b'    /*  backspace  */
+#define        HT                '\t'    /*  horizontal tab  */
+#define        VT                '\013'  /*  vertical tab  */
+#define        CR                '\r'    /*  carriage return  */
+#define        FF                '\f'    /*  form feed  */
+#define        QUOTE                '\''    /*  single quote  */
+#define        DOUBLE_QUOTE        '\"'    /*  double quote  */
+#define        BACKSLASH        '\\'    /*  backslash  */
+
+
+/* defines for constructing filenames */
+
+#define        OUTPUT_SUFFIX        T(".ml")
+#define        VERBOSE_SUFFIX        T(".output")
+#define INTERFACE_SUFFIX T(".mli")
+
+/* keyword codes */
+
+#define TOKEN 0
+#define LEFT 1
+#define RIGHT 2
+#define NONASSOC 3
+#define MARK 4
+#define TEXT 5
+#define TYPE 6
+#define START 7
+
+/*  symbol classes  */
+
+#define UNKNOWN 0
+#define TERM 1
+#define NONTERM 2
+
+
+/*  the undefined value  */
+
+#define UNDEFINED (-1)
+
+
+/*  action codes  */
+
+#define SHIFT 1
+#define REDUCE 2
+
+
+/*  character macros  */
+
+#define IS_IDENT(c)       (isalnum(c) || (c) == '_' || (c) == '.' || (c) == '$')
+#define IS_OCTAL(c)       ((c) >= '0' && (c) <= '7')
+#define NUMERIC_VALUE(c)  ((c) - '0')
+
+
+/*  symbol macros  */
+
+#define ISTOKEN(s)        ((s) < start_symbol)
+#define ISVAR(s)        ((s) >= start_symbol)
+
+
+/*  storage allocation macros  */
+
+#define CALLOC(k,n)      (calloc((unsigned)(k),(unsigned)(n)))
+#define FREE(x)          (free((char*)(x)))
+#define MALLOC(n)        (malloc((unsigned)(n)))
+#define NEW(t)           ((t*)allocate(sizeof(t)))
+#define NEW2(n,t)        ((t*)allocate((unsigned)((n)*sizeof(t))))
+#define REALLOC(p,n)     (realloc((char*)(p),(unsigned)(n)))
+
+
+/*  the structure of a symbol table entry  */
+
+typedef struct bucket bucket;
+struct bucket
+{
+    struct bucket *link;
+    struct bucket *next;
+    char *name;
+    char *tag;
+    short value;
+    short index;
+    short prec;
+    char class;
+    char assoc;
+    unsigned char entry;  /* 1..MAX_ENTRY_POINT (0 for unassigned) */
+    char true_token;
+};
+
+/* MAX_ENTRY_POINT is the maximal number of entry points into the grammar. */
+/* Entry points are identified by a non-zero byte in the input stream,     */
+/* so there are at most 255 entry points.                                  */
+
+#define MAX_ENTRY_POINT MAXCHAR
+
+/* TABLE_SIZE is the number of entries in the symbol table.      */
+/* TABLE_SIZE must be a power of two.                            */
+
+#define        TABLE_SIZE 4096
+
+/*  the structure of the LR(0) state machine  */
+
+typedef struct core core;
+struct core
+{
+    struct core *next;
+    struct core *link;
+    short number;
+    short accessing_symbol;
+    short nitems;
+    short items[1];
+};
+
+
+/*  the structure used to record shifts  */
+
+typedef struct shifts shifts;
+struct shifts
+{
+    struct shifts *next;
+    short number;
+    short nshifts;
+    short shift[1];
+};
+
+
+/*  the structure used to store reductions  */
+
+typedef struct reductions reductions;
+struct reductions
+{
+    struct reductions *next;
+    short number;
+    short nreds;
+    short rules[1];
+};
+
+
+/*  the structure used to represent parser actions  */
+
+typedef struct action action;
+struct action
+{
+    struct action *next;
+    short symbol;
+    short number;
+    short prec;
+    char action_code;
+    char assoc;
+    char suppressed;
+};
+
+
+/* global variables */
+
+extern char lflag;
+extern char rflag;
+extern char tflag;
+extern char vflag;
+extern char qflag;
+extern char sflag;
+extern char eflag;
+extern char big_endian;
+
+/* myname should be UTF-8 encoded */
+extern char *myname;
+extern char *cptr;
+extern char *line;
+extern int lineno;
+/* virtual_input_file_name should be UTF-8 encoded */
+extern char *virtual_input_file_name;
+extern int outline;
+
+extern char_os *action_file_name;
+extern char_os *entry_file_name;
+extern char_os *code_file_name;
+extern char_os *input_file_name;
+extern char_os *output_file_name;
+extern char_os *text_file_name;
+extern char_os *verbose_file_name;
+extern char_os *interface_file_name;
+
+/* UTF-8 versions of code_file_name and input_file_name */
+extern char *code_file_name_disp;
+extern char *input_file_name_disp;
+
+extern FILE *action_file;
+extern FILE *entry_file;
+extern FILE *code_file;
+extern FILE *input_file;
+extern FILE *output_file;
+extern FILE *text_file;
+extern FILE *verbose_file;
+extern FILE *interface_file;
+
+extern int nitems;
+extern int nrules;
+extern int ntotalrules;
+extern int nsyms;
+extern int ntokens;
+extern int nvars;
+extern int ntags;
+
+#define line_format "# %d \"%s\"\n"
+
+extern int   start_symbol;
+extern char  **symbol_name;
+extern short *symbol_value;
+extern short *symbol_prec;
+extern char  *symbol_assoc;
+extern char  **symbol_tag;
+extern char  *symbol_true_token;
+
+extern short *ritem;
+extern short *rlhs;
+extern short *rrhs;
+extern short *rprec;
+extern char  *rassoc;
+
+extern short **derives;
+extern char *nullable;
+
+extern bucket *first_symbol;
+extern bucket *last_symbol;
+
+extern int nstates;
+extern core *first_state;
+extern shifts *first_shift;
+extern reductions *first_reduction;
+extern short *accessing_symbol;
+extern core **state_table;
+extern shifts **shift_table;
+extern reductions **reduction_table;
+extern unsigned *LA;
+extern short *LAruleno;
+extern short *lookaheads;
+extern short *goto_map;
+extern short *from_state;
+extern short *to_state;
+
+extern action **parser;
+extern int SRtotal;
+extern int RRtotal;
+extern short *SRconflicts;
+extern short *RRconflicts;
+extern short *defred;
+extern short *rules_used;
+extern short nunused;
+extern short final_state;
+
+/* global functions */
+
+extern char *allocate(unsigned int n);
+extern bucket *lookup(char *name);
+extern bucket *make_bucket(char *name);
+extern action *parse_actions(register int stateno);
+extern action *get_shifts(int stateno);
+extern action *add_reductions(int stateno, register action *actions);
+extern action *add_reduce(register action *actions, register int ruleno, register int symbol);
+extern void closure (short int *nucleus, int n);
+extern void create_symbol_table (void);
+extern void default_action_error (void) Noreturn;
+extern void done (int k) Noreturn;
+extern void entry_without_type (char *s) Noreturn;
+extern void fatal (char *msg) Noreturn;
+extern void finalize_closure (void);
+extern void free_parser (void);
+extern void free_symbol_table (void);
+extern void free_symbols (void);
+extern void illegal_character (char *c_cptr) Noreturn;
+extern void illegal_token_ref (int i, char *name) Noreturn;
+extern void lalr (void);
+extern void lr0 (void);
+extern void make_parser (void);
+extern void no_grammar (void) Noreturn;
+extern void no_space (void) Noreturn;
+extern void open_error (char_os *filename) Noreturn;
+extern void output (void);
+extern void prec_redeclared (void);
+extern void polymorphic_entry_point(char *s) Noreturn;
+extern void forbidden_conflicts (void);
+extern void reader (void);
+extern void reflexive_transitive_closure (unsigned int *R, int n);
+extern void reprec_warning (char *s);
+extern void retyped_warning (char *s);
+extern void revalued_warning (char *s);
+extern void set_first_derives (void);
+extern void syntax_error (int st_lineno, char *st_line, char *st_cptr) Noreturn, terminal_lhs (int s_lineno) Noreturn;
+extern void terminal_start (char *s) Noreturn;
+extern void tokenized_start (char *s) Noreturn;
+extern void too_many_entries (void) Noreturn;
+extern void undefined_goal (char *s);
+extern void undefined_symbol (char *s);
+extern void unexpected_EOF (void) Noreturn;
+extern void unknown_rhs (int i) Noreturn;
+extern void unterminated_action (int a_lineno, char *a_line, char *a_cptr) Noreturn;
+extern void unterminated_comment (int c_lineno, char *c_line, char *c_cptr) Noreturn;
+extern void unterminated_string (int s_lineno, char *s_line, char *s_cptr) Noreturn;
+extern void unterminated_text (int t_lineno, char *t_line, char *t_cptr) Noreturn;
+extern void used_reserved (char *s) Noreturn;
+extern void verbose (void);
+extern void write_section (char **section);
diff --git a/yacc/error.c b/yacc/error.c
new file mode 100644
index 00000000..a47bed9f
--- /dev/null
+++ b/yacc/error.c
@@ -0,0 +1,309 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Based on public-domain code from Berkeley Yacc */
+
+/* routines for printing error messages  */
+
+#include "defs.h"
+
+/* String displayed if we can't malloc a buffer for the UTF-8 conversion */
+static char *unknown = "";
+
+void fatal(char *msg)
+{
+    fprintf(stderr, "%s: f - %s\n", myname, msg);
+    done(2);
+}
+
+
+void no_space(void)
+{
+    fprintf(stderr, "%s: f - out of space\n", myname);
+    done(2);
+}
+
+
+void open_error(char_os *filename)
+{
+    char *u8 = caml_stat_strdup_of_os(filename);
+    fprintf(stderr, "%s: f - cannot open \"%s\"\n", myname, (u8 ? u8 : unknown));
+    done(2);
+}
+
+
+void unexpected_EOF(void)
+{
+    fprintf(stderr, "File \"%s\", line %d: unexpected end-of-file\n",
+            virtual_input_file_name, lineno);
+    done(1);
+}
+
+
+void print_pos(char *st_line, char *st_cptr)
+{
+    register char *s;
+
+    if (st_line == 0) return;
+    for (s = st_line; *s != '\n'; ++s)
+    {
+        if (isprint((unsigned char) *s) || *s == '\t')
+            putc(*s, stderr);
+        else
+            putc('?', stderr);
+    }
+    putc('\n', stderr);
+    for (s = st_line; s < st_cptr; ++s)
+    {
+        if (*s == '\t')
+            putc('\t', stderr);
+        else
+            putc(' ', stderr);
+    }
+    putc('^', stderr);
+    putc('\n', stderr);
+}
+
+
+void syntax_error(int st_lineno, char *st_line, char *st_cptr)
+{
+    fprintf(stderr, "File \"%s\", line %d: syntax error\n",
+            virtual_input_file_name, st_lineno);
+    print_pos(st_line, st_cptr);
+    done(1);
+}
+
+
+void unterminated_comment(int c_lineno, char *c_line, char *c_cptr)
+{
+    fprintf(stderr, "File \"%s\", line %d: unmatched /*\n",
+            virtual_input_file_name, c_lineno);
+    print_pos(c_line, c_cptr);
+    done(1);
+}
+
+
+void unterminated_string(int s_lineno, char *s_line, char *s_cptr)
+{
+    fprintf(stderr, "File \"%s\", line %d: unterminated string\n",
+            virtual_input_file_name, s_lineno);
+    print_pos(s_line, s_cptr);
+    done(1);
+}
+
+
+void unterminated_text(int t_lineno, char *t_line, char *t_cptr)
+{
+    fprintf(stderr, "File \"%s\", line %d: unmatched %%{\n",
+            virtual_input_file_name, t_lineno);
+    print_pos(t_line, t_cptr);
+    done(1);
+}
+
+
+void illegal_tag(int t_lineno, char *t_line, char *t_cptr)
+{
+    fprintf(stderr, "File \"%s\", line %d: illegal tag\n",
+            virtual_input_file_name, t_lineno);
+    print_pos(t_line, t_cptr);
+    done(1);
+}
+
+
+void illegal_character(char *c_cptr)
+{
+    fprintf(stderr, "File \"%s\", line %d: illegal character\n",
+            virtual_input_file_name, lineno);
+    print_pos(line, c_cptr);
+    done(1);
+}
+
+
+void used_reserved(char *s)
+{
+    fprintf(stderr, "File \"%s\", line %d: illegal use of reserved symbol \
+`%s'\n", virtual_input_file_name, lineno, s);
+    done(1);
+}
+
+
+void tokenized_start(char *s)
+{
+     fprintf(stderr, "File \"%s\", line %d: the start symbol `%s' cannot \
+be declared to be a token\n", virtual_input_file_name, lineno, s);
+     done(1);
+}
+
+
+void retyped_warning(char *s)
+{
+    fprintf(stderr, "File \"%s\", line %d: warning: the type of `%s' has been \
+redeclared\n", virtual_input_file_name, lineno, s);
+}
+
+
+void reprec_warning(char *s)
+{
+    fprintf(stderr, "File \"%s\", line %d: warning: the precedence of `%s' has \
+been redeclared\n", virtual_input_file_name, lineno, s);
+}
+
+
+void revalued_warning(char *s)
+{
+    fprintf(stderr, "File \"%s\", line %d: warning: the value of `%s' has been \
+redeclared\n", virtual_input_file_name, lineno, s);
+}
+
+
+void terminal_start(char *s)
+{
+    fprintf(stderr, "File \"%s\", line %d: the entry point `%s' is a \
+token\n", virtual_input_file_name, lineno, s);
+    done(1);
+}
+
+void too_many_entries(void)
+{
+    fprintf(stderr, "File \"%s\", line %d: more than %u entry points\n",
+            virtual_input_file_name, lineno, MAX_ENTRY_POINT);
+    done(1);
+}
+
+
+void no_grammar(void)
+{
+    fprintf(stderr, "File \"%s\", line %d: no grammar has been specified\n",
+            virtual_input_file_name, lineno);
+    done(1);
+}
+
+
+void terminal_lhs(int s_lineno)
+{
+    fprintf(stderr, "File \"%s\", line %d: a token appears on the lhs \
+of a production\n", virtual_input_file_name, s_lineno);
+    done(1);
+}
+
+
+void prec_redeclared(void)
+{
+    fprintf(stderr, "File \"%s\", line %d: warning: conflicting %%prec \
+specifiers\n", virtual_input_file_name, lineno);
+}
+
+
+void unterminated_action(int a_lineno, char *a_line, char *a_cptr)
+{
+    fprintf(stderr, "File \"%s\", line %d: unterminated action\n",
+            virtual_input_file_name, a_lineno);
+    print_pos(a_line, a_cptr);
+    done(1);
+}
+
+
+void dollar_warning(int a_lineno, int i)
+{
+    fprintf(stderr, "File \"%s\", line %d: warning: $%d references beyond the \
+end of the current rule\n", virtual_input_file_name, a_lineno, i);
+}
+
+
+void dollar_error(int a_lineno, char *a_line, char *a_cptr)
+{
+    fprintf(stderr, "File \"%s\", line %d: illegal $-name\n",
+            virtual_input_file_name, a_lineno);
+    print_pos(a_line, a_cptr);
+    done(1);
+}
+
+
+void untyped_lhs(void)
+{
+    fprintf(stderr, "File \"%s\", line %d: $$ is untyped\n",
+            virtual_input_file_name, lineno);
+    done(1);
+}
+
+
+void untyped_rhs(int i, char *s)
+{
+    fprintf(stderr, "File \"%s\", line %d: $%d (%s) is untyped\n",
+            virtual_input_file_name, lineno, i, s);
+    done(1);
+}
+
+
+void unknown_rhs(int i)
+{
+    fprintf(stderr, "File \"%s\", line %d: $%d is unbound\n",
+            virtual_input_file_name, lineno, i);
+    done(1);
+}
+
+void illegal_token_ref(int i, char *name)
+{
+    fprintf(stderr, "File \"%s\", line %d: $%d refers to terminal `%s', \
+which has no argument\n",
+            virtual_input_file_name, lineno, i, name);
+    done(1);
+}
+
+void default_action_error(void)
+{
+    fprintf(stderr, "File \"%s\", line %d: no action specified for this \
+production\n",
+            virtual_input_file_name, lineno);
+    done(1);
+}
+
+
+void undefined_goal(char *s)
+{
+    fprintf(stderr, "%s: e - the start symbol `%s' is undefined\n", myname, s);
+    done(1);
+}
+
+void undefined_symbol(char *s)
+{
+    fprintf(stderr, "%s: e - the symbol `%s' is undefined\n", myname, s);
+    done(1);
+}
+
+
+void entry_without_type(char *s)
+{
+    fprintf(stderr,
+            "%s: e - no type has been declared for the start symbol `%s'\n",
+            myname, s);
+    done(1);
+}
+
+void polymorphic_entry_point(char *s)
+{
+    fprintf(stderr,
+            "%s: e - the start symbol `%s' has a polymorphic type\n",
+            myname, s);
+    done(1);
+}
+
+void forbidden_conflicts(void)
+{
+    fprintf(stderr,
+            "%s: the grammar has conflicts, but --strict was specified\n",
+            myname);
+    done(1);
+}
diff --git a/yacc/lalr.c b/yacc/lalr.c
new file mode 100644
index 00000000..5a3101ad
--- /dev/null
+++ b/yacc/lalr.c
@@ -0,0 +1,664 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Based on public-domain code from Berkeley Yacc */
+
+#include "defs.h"
+
+typedef
+  struct shorts
+    {
+      struct shorts *next;
+      short value;
+    }
+  shorts;
+
+int tokensetsize;
+short *lookaheads;
+short *LAruleno;
+unsigned *LA;
+short *accessing_symbol;
+core **state_table;
+shifts **shift_table;
+reductions **reduction_table;
+short *goto_map;
+short *from_state;
+short *to_state;
+
+short **transpose(short int **R, int n);
+
+static int infinity;
+static int maxrhs;
+static int ngotos;
+static unsigned *F;
+static short **includes;
+static shorts **lookback;
+static short **R;
+static short *INDEX;
+static short *VERTICES;
+static int top;
+
+
+
+void set_state_table (void);
+void set_accessing_symbol (void);
+void set_shift_table (void);
+void set_reduction_table (void);
+void set_maxrhs (void);
+void initialize_LA (void);
+void set_goto_map (void);
+void initialize_F (void);
+void build_relations (void);
+void compute_FOLLOWS (void);
+void compute_lookaheads (void);
+void digraph (short int **relation);
+void add_lookback_edge (int stateno, int ruleno, int gotono);
+void traverse (register int i);
+
+void lalr(void)
+{
+    tokensetsize = WORDSIZE(ntokens);
+
+    set_state_table();
+    set_accessing_symbol();
+    set_shift_table();
+    set_reduction_table();
+    set_maxrhs();
+    initialize_LA();
+    set_goto_map();
+    initialize_F();
+    build_relations();
+    compute_FOLLOWS();
+    compute_lookaheads();
+}
+
+
+
+void set_state_table(void)
+{
+    register core *sp;
+
+    state_table = NEW2(nstates, core *);
+    for (sp = first_state; sp; sp = sp->next)
+        state_table[sp->number] = sp;
+}
+
+
+
+void set_accessing_symbol(void)
+{
+    register core *sp;
+
+    accessing_symbol = NEW2(nstates, short);
+    for (sp = first_state; sp; sp = sp->next)
+        accessing_symbol[sp->number] = sp->accessing_symbol;
+}
+
+
+
+void set_shift_table(void)
+{
+    register shifts *sp;
+
+    shift_table = NEW2(nstates, shifts *);
+    for (sp = first_shift; sp; sp = sp->next)
+        shift_table[sp->number] = sp;
+}
+
+
+
+void set_reduction_table(void)
+{
+    register reductions *rp;
+
+    reduction_table = NEW2(nstates, reductions *);
+    for (rp = first_reduction; rp; rp = rp->next)
+        reduction_table[rp->number] = rp;
+}
+
+
+
+void set_maxrhs(void)
+{
+  register short *itemp;
+  register short *item_end;
+  register int length;
+  register int max;
+
+  length = 0;
+  max = 0;
+  item_end = ritem + nitems;
+  for (itemp = ritem; itemp < item_end; itemp++)
+    {
+      if (*itemp >= 0)
+        {
+          length++;
+        }
+      else
+        {
+          if (length > max) max = length;
+          length = 0;
+        }
+    }
+
+  maxrhs = max;
+}
+
+
+
+void initialize_LA(void)
+{
+  register int i, j, k;
+  register reductions *rp;
+
+  lookaheads = NEW2(nstates + 1, short);
+
+  k = 0;
+  for (i = 0; i < nstates; i++)
+    {
+      lookaheads[i] = k;
+      rp = reduction_table[i];
+      if (rp)
+        k += rp->nreds;
+    }
+  lookaheads[nstates] = k;
+
+  LA = NEW2(k * tokensetsize, unsigned);
+  LAruleno = NEW2(k, short);
+  lookback = NEW2(k, shorts *);
+
+  k = 0;
+  for (i = 0; i < nstates; i++)
+    {
+      rp = reduction_table[i];
+      if (rp)
+        {
+          for (j = 0; j < rp->nreds; j++)
+            {
+              LAruleno[k] = rp->rules[j];
+              k++;
+            }
+        }
+    }
+}
+
+
+void set_goto_map(void)
+{
+  register shifts *sp;
+  register int i;
+  register int symbol;
+  register int k;
+  register short *temp_map;
+  register int state2;
+  register int state1;
+
+  goto_map = NEW2(nvars + 1, short) - ntokens;
+  temp_map = NEW2(nvars + 1, short) - ntokens;
+
+  ngotos = 0;
+  for (sp = first_shift; sp; sp = sp->next)
+    {
+      for (i = sp->nshifts - 1; i >= 0; i--)
+        {
+          symbol = accessing_symbol[sp->shift[i]];
+
+          if (ISTOKEN(symbol)) break;
+
+          if (ngotos == MAXSHORT)
+            fatal("too many gotos");
+
+          ngotos++;
+          goto_map[symbol]++;
+        }
+    }
+
+  k = 0;
+  for (i = ntokens; i < nsyms; i++)
+    {
+      temp_map[i] = k;
+      k += goto_map[i];
+    }
+
+  for (i = ntokens; i < nsyms; i++)
+    goto_map[i] = temp_map[i];
+
+  goto_map[nsyms] = ngotos;
+  temp_map[nsyms] = ngotos;
+
+  from_state = NEW2(ngotos, short);
+  to_state = NEW2(ngotos, short);
+
+  for (sp = first_shift; sp; sp = sp->next)
+    {
+      state1 = sp->number;
+      for (i = sp->nshifts - 1; i >= 0; i--)
+        {
+          state2 = sp->shift[i];
+          symbol = accessing_symbol[state2];
+
+          if (ISTOKEN(symbol)) break;
+
+          k = temp_map[symbol]++;
+          from_state[k] = state1;
+          to_state[k] = state2;
+        }
+    }
+
+  FREE(temp_map + ntokens);
+}
+
+
+
+/*  Map_goto maps a state/symbol pair into its numeric representation.        */
+
+int
+map_goto(int state, int symbol)
+{
+    register int high;
+    register int low;
+    register int middle;
+    register int s;
+
+    low = goto_map[symbol];
+    high = goto_map[symbol + 1];
+
+    for (;;)
+    {
+        assert(low <= high);
+        middle = (low + high) >> 1;
+        s = from_state[middle];
+        if (s == state)
+            return (middle);
+        else if (s < state)
+            low = middle + 1;
+        else
+            high = middle - 1;
+    }
+}
+
+
+
+void initialize_F(void)
+{
+  register int i;
+  register int j;
+  register int k;
+  register shifts *sp;
+  register short *edge;
+  register unsigned *rowp;
+  register short *rp;
+  register short **reads;
+  register int nedges;
+  register int stateno;
+  register int symbol;
+  register int nwords;
+
+  nwords = ngotos * tokensetsize;
+  F = NEW2(nwords, unsigned);
+
+  reads = NEW2(ngotos, short *);
+  edge = NEW2(ngotos + 1, short);
+  nedges = 0;
+
+  rowp = F;
+  for (i = 0; i < ngotos; i++)
+    {
+      stateno = to_state[i];
+      sp = shift_table[stateno];
+
+      if (sp)
+        {
+          k = sp->nshifts;
+
+          for (j = 0; j < k; j++)
+            {
+              symbol = accessing_symbol[sp->shift[j]];
+              if (ISVAR(symbol))
+                break;
+              SETBIT(rowp, symbol);
+            }
+
+          for (; j < k; j++)
+            {
+              symbol = accessing_symbol[sp->shift[j]];
+              if (nullable[symbol])
+                edge[nedges++] = map_goto(stateno, symbol);
+            }
+
+          if (nedges)
+            {
+              reads[i] = rp = NEW2(nedges + 1, short);
+
+              for (j = 0; j < nedges; j++)
+                rp[j] = edge[j];
+
+              rp[nedges] = -1;
+              nedges = 0;
+            }
+        }
+
+      rowp += tokensetsize;
+    }
+
+  SETBIT(F, 0);
+  digraph(reads);
+
+  for (i = 0; i < ngotos; i++)
+    {
+      if (reads[i])
+        FREE(reads[i]);
+    }
+
+  FREE(reads);
+  FREE(edge);
+}
+
+
+
+void build_relations(void)
+{
+  register int i;
+  register int j;
+  register int k;
+  register short *rulep;
+  register short *rp;
+  register shifts *sp;
+  register int length;
+  register int nedges;
+  register int done;
+  register int state1;
+  register int stateno;
+  register int symbol1;
+  register int symbol2;
+  register short *shortp;
+  register short *edge;
+  register short *states;
+  register short **new_includes;
+
+  includes = NEW2(ngotos, short *);
+  edge = NEW2(ngotos + 1, short);
+  states = NEW2(maxrhs + 1, short);
+
+  for (i = 0; i < ngotos; i++)
+    {
+      nedges = 0;
+      state1 = from_state[i];
+      symbol1 = accessing_symbol[to_state[i]];
+
+      for (rulep = derives[symbol1]; *rulep >= 0; rulep++)
+        {
+          length = 1;
+          states[0] = state1;
+          stateno = state1;
+
+          for (rp = ritem + rrhs[*rulep]; *rp >= 0; rp++)
+            {
+              symbol2 = *rp;
+              sp = shift_table[stateno];
+              k = sp->nshifts;
+
+              for (j = 0; j < k; j++)
+                {
+                  stateno = sp->shift[j];
+                  if (accessing_symbol[stateno] == symbol2) break;
+                }
+
+              states[length++] = stateno;
+            }
+
+          add_lookback_edge(stateno, *rulep, i);
+
+          length--;
+          done = 0;
+          while (!done)
+            {
+              done = 1;
+              rp--;
+              if (ISVAR(*rp))
+                {
+                  stateno = states[--length];
+                  edge[nedges++] = map_goto(stateno, *rp);
+                  if (nullable[*rp] && length > 0) done = 0;
+                }
+            }
+        }
+
+      if (nedges)
+        {
+          includes[i] = shortp = NEW2(nedges + 1, short);
+          for (j = 0; j < nedges; j++)
+            shortp[j] = edge[j];
+          shortp[nedges] = -1;
+        }
+    }
+
+  new_includes = transpose(includes, ngotos);
+
+  for (i = 0; i < ngotos; i++)
+    if (includes[i])
+      FREE(includes[i]);
+
+  FREE(includes);
+
+  includes = new_includes;
+
+  FREE(edge);
+  FREE(states);
+}
+
+
+void add_lookback_edge(int stateno, int ruleno, int gotono)
+{
+    register int i, k;
+    register int found;
+    register shorts *sp;
+
+    i = lookaheads[stateno];
+    k = lookaheads[stateno + 1];
+    found = 0;
+    while (!found && i < k)
+    {
+        if (LAruleno[i] == ruleno)
+            found = 1;
+        else
+            ++i;
+    }
+    assert(found);
+
+    sp = NEW(shorts);
+    sp->next = lookback[i];
+    sp->value = gotono;
+    lookback[i] = sp;
+}
+
+
+
+short **
+transpose(short int **R, int n)
+{
+  register short **new_R;
+  register short **temp_R;
+  register short *nedges;
+  register short *sp;
+  register int i;
+  register int k;
+
+  nedges = NEW2(n, short);
+
+  for (i = 0; i < n; i++)
+    {
+      sp = R[i];
+      if (sp)
+        {
+          while (*sp >= 0)
+            nedges[*sp++]++;
+        }
+    }
+
+  new_R = NEW2(n, short *);
+  temp_R = NEW2(n, short *);
+
+  for (i = 0; i < n; i++)
+    {
+      k = nedges[i];
+      if (k > 0)
+        {
+          sp = NEW2(k + 1, short);
+          new_R[i] = sp;
+          temp_R[i] = sp;
+          sp[k] = -1;
+        }
+    }
+
+  FREE(nedges);
+
+  for (i = 0; i < n; i++)
+    {
+      sp = R[i];
+      if (sp)
+        {
+          while (*sp >= 0)
+            *temp_R[*sp++]++ = i;
+        }
+    }
+
+  FREE(temp_R);
+
+  return (new_R);
+}
+
+
+
+void compute_FOLLOWS(void)
+{
+  digraph(includes);
+}
+
+
+void compute_lookaheads(void)
+{
+  register int i, n;
+  register unsigned *fp1, *fp2, *fp3;
+  register shorts *sp, *next;
+  register unsigned *rowp;
+
+  rowp = LA;
+  n = lookaheads[nstates];
+  for (i = 0; i < n; i++)
+    {
+      fp3 = rowp + tokensetsize;
+      for (sp = lookback[i]; sp; sp = sp->next)
+        {
+          fp1 = rowp;
+          fp2 = F + tokensetsize * sp->value;
+          while (fp1 < fp3)
+            *fp1++ |= *fp2++;
+        }
+      rowp = fp3;
+    }
+
+  for (i = 0; i < n; i++)
+    for (sp = lookback[i]; sp; sp = next)
+      {
+        next = sp->next;
+        FREE(sp);
+      }
+
+  FREE(lookback);
+  FREE(F);
+}
+
+
+void digraph(short int **relation)
+{
+  register int i;
+
+  infinity = ngotos + 2;
+  INDEX = NEW2(ngotos + 1, short);
+  VERTICES = NEW2(ngotos + 1, short);
+  top = 0;
+
+  R = relation;
+
+  for (i = 0; i < ngotos; i++)
+    INDEX[i] = 0;
+
+  for (i = 0; i < ngotos; i++)
+    {
+      if (INDEX[i] == 0 && R[i])
+        traverse(i);
+    }
+
+  FREE(INDEX);
+  FREE(VERTICES);
+}
+
+
+
+void traverse(register int i)
+{
+  register unsigned *fp1;
+  register unsigned *fp2;
+  register unsigned *fp3;
+  register int j;
+  register short *rp;
+
+  int height;
+  unsigned *base;
+
+  VERTICES[++top] = i;
+  INDEX[i] = height = top;
+
+  base = F + i * tokensetsize;
+  fp3 = base + tokensetsize;
+
+  rp = R[i];
+  if (rp)
+    {
+      while ((j = *rp++) >= 0)
+        {
+          if (INDEX[j] == 0)
+            traverse(j);
+
+          if (INDEX[i] > INDEX[j])
+            INDEX[i] = INDEX[j];
+
+          fp1 = base;
+          fp2 = F + j * tokensetsize;
+
+          while (fp1 < fp3)
+            *fp1++ |= *fp2++;
+        }
+    }
+
+  if (INDEX[i] == height)
+    {
+      for (;;)
+        {
+          j = VERTICES[top--];
+          INDEX[j] = infinity;
+
+          if (i == j)
+            break;
+
+          fp1 = base;
+          fp2 = F + j * tokensetsize;
+
+          while (fp1 < fp3)
+            *fp2++ = *fp1++;
+        }
+    }
+}
diff --git a/yacc/lr0.c b/yacc/lr0.c
new file mode 100644
index 00000000..5cef9e5b
--- /dev/null
+++ b/yacc/lr0.c
@@ -0,0 +1,621 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Based on public-domain code from Berkeley Yacc */
+
+#include "defs.h"
+
+extern short *itemset;
+extern short *itemsetend;
+extern unsigned *ruleset;
+
+int nstates;
+core *first_state;
+shifts *first_shift;
+reductions *first_reduction;
+
+int get_state(int symbol);
+core *new_state(int symbol);
+
+static core **state_set;
+static core *this_state;
+static core *last_state;
+static shifts *last_shift;
+static reductions *last_reduction;
+
+static int nshifts;
+static short *shift_symbol;
+
+static short *redset;
+static short *shiftset;
+
+static short **kernel_base;
+static short **kernel_end;
+static short *kernel_items;
+
+
+
+void initialize_states (void);
+void save_reductions (void);
+void new_itemsets (void);
+void save_shifts (void);
+void print_derives (void);
+void show_cores (void), show_ritems (void), show_rrhs (void), show_shifts (void);
+
+void allocate_itemsets(void)
+{
+    register short *itemp;
+    register short *item_end;
+    register int symbol;
+    register int i;
+    register int count;
+    register int max;
+    register short *symbol_count;
+
+    count = 0;
+    symbol_count = NEW2(nsyms, short);
+
+    item_end = ritem + nitems;
+    for (itemp = ritem; itemp < item_end; itemp++)
+    {
+        symbol = *itemp;
+        if (symbol >= 0)
+        {
+            count++;
+            symbol_count[symbol]++;
+        }
+    }
+
+    kernel_base = NEW2(nsyms, short *);
+    kernel_items = NEW2(count, short);
+
+    count = 0;
+    max = 0;
+    for (i = 0; i < nsyms; i++)
+    {
+        kernel_base[i] = kernel_items + count;
+        count += symbol_count[i];
+        if (max < symbol_count[i])
+            max = symbol_count[i];
+    }
+
+    shift_symbol = symbol_count;
+    kernel_end = NEW2(nsyms, short *);
+}
+
+
+void allocate_storage(void)
+{
+    allocate_itemsets();
+    shiftset = NEW2(nsyms, short);
+    redset = NEW2(nrules + 1, short);
+    state_set = NEW2(nitems, core *);
+}
+
+
+void append_states(void)
+{
+    register int i;
+    register int j;
+    register int symbol;
+
+#ifdef        TRACE
+    fprintf(stderr, "Entering append_states()\n");
+#endif
+    for (i = 1; i < nshifts; i++)
+    {
+        symbol = shift_symbol[i];
+        j = i;
+        while (j > 0 && shift_symbol[j - 1] > symbol)
+        {
+            shift_symbol[j] = shift_symbol[j - 1];
+            j--;
+        }
+        shift_symbol[j] = symbol;
+    }
+
+    for (i = 0; i < nshifts; i++)
+    {
+        symbol = shift_symbol[i];
+        shiftset[i] = get_state(symbol);
+    }
+}
+
+
+void free_storage(void)
+{
+    FREE(shift_symbol);
+    FREE(redset);
+    FREE(shiftset);
+    FREE(kernel_base);
+    FREE(kernel_end);
+    FREE(kernel_items);
+    FREE(state_set);
+}
+
+
+
+void generate_states(void)
+{
+    allocate_storage();
+    itemset = NEW2(nitems, short);
+    ruleset = NEW2(WORDSIZE(nrules), unsigned);
+    set_first_derives();
+    initialize_states();
+
+    while (this_state)
+    {
+        closure(this_state->items, this_state->nitems);
+        save_reductions();
+        new_itemsets();
+        append_states();
+
+        if (nshifts > 0)
+            save_shifts();
+
+        this_state = this_state->next;
+    }
+
+    finalize_closure();
+    free_storage();
+}
+
+
+
+int
+get_state(int symbol)
+{
+    register int key;
+    register short *isp1;
+    register short *isp2;
+    register short *iend;
+    register core *sp;
+    register int found;
+    register int n;
+
+#ifdef        TRACE
+    fprintf(stderr, "Entering get_state(%d)\n", symbol);
+#endif
+
+    isp1 = kernel_base[symbol];
+    iend = kernel_end[symbol];
+    n = iend - isp1;
+
+    key = *isp1;
+    assert(0 <= key && key < nitems);
+    sp = state_set[key];
+    if (sp)
+    {
+        found = 0;
+        while (!found)
+        {
+            if (sp->nitems == n)
+            {
+                found = 1;
+                isp1 = kernel_base[symbol];
+                isp2 = sp->items;
+
+                while (found && isp1 < iend)
+                {
+                    if (*isp1++ != *isp2++)
+                        found = 0;
+                }
+            }
+
+            if (!found)
+            {
+                if (sp->link)
+                {
+                    sp = sp->link;
+                }
+                else
+                {
+                    sp = sp->link = new_state(symbol);
+                    found = 1;
+                }
+            }
+        }
+    }
+    else
+    {
+        state_set[key] = sp = new_state(symbol);
+    }
+
+    return (sp->number);
+}
+
+
+
+void initialize_states(void)
+{
+    register int i;
+    register short *start_derives;
+    register core *p;
+
+    start_derives = derives[start_symbol];
+    for (i = 0; start_derives[i] >= 0; ++i)
+        continue;
+
+    p = (core *) MALLOC(sizeof(core) + i*sizeof(short));
+    if (p == 0) no_space();
+
+    p->next = 0;
+    p->link = 0;
+    p->number = 0;
+    p->accessing_symbol = 0;
+    p->nitems = i;
+
+    for (i = 0;  start_derives[i] >= 0; ++i)
+        p->items[i] = rrhs[start_derives[i]];
+
+    first_state = last_state = this_state = p;
+    nstates = 1;
+}
+
+
+void new_itemsets(void)
+{
+    register int i;
+    register int shiftcount;
+    register short *isp;
+    register short *ksp;
+    register int symbol;
+
+    for (i = 0; i < nsyms; i++)
+        kernel_end[i] = 0;
+
+    shiftcount = 0;
+    isp = itemset;
+    while (isp < itemsetend)
+    {
+        i = *isp++;
+        symbol = ritem[i];
+        if (symbol > 0)
+        {
+            ksp = kernel_end[symbol];
+            if (!ksp)
+            {
+                shift_symbol[shiftcount++] = symbol;
+                ksp = kernel_base[symbol];
+            }
+
+            *ksp++ = i + 1;
+            kernel_end[symbol] = ksp;
+        }
+    }
+
+    nshifts = shiftcount;
+}
+
+
+
+core *
+new_state(int symbol)
+{
+    register int n;
+    register core *p;
+    register short *isp1;
+    register short *isp2;
+    register short *iend;
+
+#ifdef        TRACE
+    fprintf(stderr, "Entering new_state(%d)\n", symbol);
+#endif
+
+    if (nstates >= MAXSHORT)
+        fatal("too many states");
+
+    isp1 = kernel_base[symbol];
+    iend = kernel_end[symbol];
+    n = iend - isp1;
+
+    p = (core *) allocate((unsigned) (sizeof(core) + (n - 1) * sizeof(short)));
+    p->accessing_symbol = symbol;
+    p->number = nstates;
+    p->nitems = n;
+
+    isp2 = p->items;
+    while (isp1 < iend)
+        *isp2++ = *isp1++;
+
+    last_state->next = p;
+    last_state = p;
+
+    nstates++;
+
+    return (p);
+}
+
+
+/* show_cores is used for debugging */
+
+void show_cores(void)
+{
+    core *p;
+    int i, j, k, n;
+    int itemno;
+
+    k = 0;
+    for (p = first_state; p; ++k, p = p->next)
+    {
+        if (k) printf("\n");
+        printf("state %d, number = %d, accessing symbol = %s\n",
+                k, p->number, symbol_name[p->accessing_symbol]);
+        n = p->nitems;
+        for (i = 0; i < n; ++i)
+        {
+            itemno = p->items[i];
+            printf("%4d  ", itemno);
+            j = itemno;
+            while (ritem[j] >= 0) ++j;
+            printf("%s :", symbol_name[rlhs[-ritem[j]]]);
+            j = rrhs[-ritem[j]];
+            while (j < itemno)
+                printf(" %s", symbol_name[ritem[j++]]);
+            printf(" .");
+            while (ritem[j] >= 0)
+                printf(" %s", symbol_name[ritem[j++]]);
+            printf("\n");
+            fflush(stdout);
+        }
+    }
+}
+
+
+/* show_ritems is used for debugging */
+
+void show_ritems(void)
+{
+    int i;
+
+    for (i = 0; i < nitems; ++i)
+        printf("ritem[%d] = %d\n", i, ritem[i]);
+}
+
+
+/* show_rrhs is used for debugging */
+
+void show_rrhs(void)
+{
+    int i;
+
+    for (i = 0; i < nrules; ++i)
+        printf("rrhs[%d] = %d\n", i, rrhs[i]);
+}
+
+
+/* show_shifts is used for debugging */
+
+void show_shifts(void)
+{
+    shifts *p;
+    int i, j, k;
+
+    k = 0;
+    for (p = first_shift; p; ++k, p = p->next)
+    {
+        if (k) printf("\n");
+        printf("shift %d, number = %d, nshifts = %d\n", k, p->number,
+                p->nshifts);
+        j = p->nshifts;
+        for (i = 0; i < j; ++i)
+            printf("\t%d\n", p->shift[i]);
+    }
+}
+
+
+void save_shifts(void)
+{
+    register shifts *p;
+    register short *sp1;
+    register short *sp2;
+    register short *send;
+
+    p = (shifts *) allocate((unsigned) (sizeof(shifts) +
+                        (nshifts - 1) * sizeof(short)));
+
+    p->number = this_state->number;
+    p->nshifts = nshifts;
+
+    sp1 = shiftset;
+    sp2 = p->shift;
+    send = shiftset + nshifts;
+
+    while (sp1 < send)
+        *sp2++ = *sp1++;
+
+    if (last_shift)
+    {
+        last_shift->next = p;
+        last_shift = p;
+    }
+    else
+    {
+        first_shift = p;
+        last_shift = p;
+    }
+}
+
+
+
+void save_reductions(void)
+{
+    register short *isp;
+    register short *rp1;
+    register short *rp2;
+    register int item;
+    register int count;
+    register reductions *p;
+    register short *rend;
+
+    count = 0;
+    for (isp = itemset; isp < itemsetend; isp++)
+    {
+        item = ritem[*isp];
+        if (item < 0)
+        {
+            redset[count++] = -item;
+        }
+    }
+
+    if (count)
+    {
+        p = (reductions *) allocate((unsigned) (sizeof(reductions) +
+                                        (count - 1) * sizeof(short)));
+
+        p->number = this_state->number;
+        p->nreds = count;
+
+        rp1 = redset;
+        rp2 = p->rules;
+        rend = rp1 + count;
+
+        while (rp1 < rend)
+            *rp2++ = *rp1++;
+
+        if (last_reduction)
+        {
+            last_reduction->next = p;
+            last_reduction = p;
+        }
+        else
+        {
+            first_reduction = p;
+            last_reduction = p;
+        }
+    }
+}
+
+
+void set_derives(void)
+{
+    register int i, k;
+    register int lhs;
+    register short *rules;
+
+    derives = NEW2(nsyms, short *);
+    rules = NEW2(nvars + nrules, short);
+
+    k = 0;
+    for (lhs = start_symbol; lhs < nsyms; lhs++)
+    {
+        derives[lhs] = rules + k;
+        for (i = 0; i < nrules; i++)
+        {
+            if (rlhs[i] == lhs)
+            {
+                rules[k] = i;
+                k++;
+            }
+        }
+        rules[k] = -1;
+        k++;
+    }
+
+#ifdef        DEBUG
+    print_derives();
+#endif
+}
+
+void free_derives(void)
+{
+    FREE(derives[start_symbol]);
+    FREE(derives);
+}
+
+#ifdef        DEBUG
+void print_derives(void)
+{
+    register int i;
+    register short *sp;
+
+    printf("\nDERIVES\n\n");
+
+    for (i = start_symbol; i < nsyms; i++)
+    {
+        printf("%s derives ", symbol_name[i]);
+        for (sp = derives[i]; *sp >= 0; sp++)
+        {
+            printf("  %d", *sp);
+        }
+        putchar('\n');
+    }
+
+    putchar('\n');
+}
+#endif
+
+
+void set_nullable(void)
+{
+    register int i, j;
+    register int empty;
+    int done;
+
+    nullable = MALLOC(nsyms);
+    if (nullable == 0) no_space();
+
+    for (i = 0; i < nsyms; ++i)
+        nullable[i] = 0;
+
+    done = 0;
+    while (!done)
+    {
+        done = 1;
+        for (i = 1; i < nitems; i++)
+        {
+            empty = 1;
+            while ((j = ritem[i]) >= 0)
+            {
+                if (!nullable[j])
+                    empty = 0;
+                ++i;
+            }
+            if (empty)
+            {
+                j = rlhs[-j];
+                if (!nullable[j])
+                {
+                    nullable[j] = 1;
+                    done = 0;
+                }
+            }
+        }
+    }
+
+#ifdef DEBUG
+    for (i = 0; i < nsyms; i++)
+    {
+        if (nullable[i])
+            printf("%s is nullable\n", symbol_name[i]);
+        else
+            printf("%s is not nullable\n", symbol_name[i]);
+    }
+#endif
+}
+
+
+void free_nullable(void)
+{
+    FREE(nullable);
+}
+
+
+void lr0(void)
+{
+    set_derives();
+    set_nullable();
+    generate_states();
+}
diff --git a/yacc/main.c b/yacc/main.c
new file mode 100644
index 00000000..a60f4676
--- /dev/null
+++ b/yacc/main.c
@@ -0,0 +1,442 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Based on public-domain code from Berkeley Yacc */
+
+#include 
+#include 
+#include "defs.h"
+#ifdef HAS_UNISTD
+#include 
+#endif
+
+#include "version.h"
+
+char lflag;
+char rflag;
+char tflag;
+char vflag;
+char qflag;
+char eflag;
+char sflag;
+char big_endian;
+
+char_os *file_prefix = 0;
+char *myname = "yacc";
+char_os temp_form[] = T("yacc.XXXXXXX");
+
+#ifdef _WIN32
+wchar_t dirsep = L'\\';
+/* mingw provides an implementation of mkstemp, but it's ANSI only */
+#undef HAS_MKSTEMP
+#else
+char dirsep = '/';
+#endif
+
+int lineno;
+char *virtual_input_file_name = NULL;
+int outline;
+
+char_os *action_file_name;
+char_os *entry_file_name;
+char_os *code_file_name;
+char *code_file_name_disp;
+char_os *interface_file_name;
+char_os *input_file_name = T("");
+char *input_file_name_disp;
+char_os *output_file_name;
+char_os *text_file_name;
+char_os *verbose_file_name;
+
+#ifdef HAS_MKSTEMP
+int action_fd = -1, entry_fd = -1, text_fd = -1;
+#endif
+
+FILE *action_file;      /*  a temp file, used to save actions associated    */
+                        /*  with rules until the parser is written          */
+FILE *entry_file;
+FILE *code_file;        /*  y.code.c (used when the -r option is specified) */
+FILE *input_file;       /*  the input file                                  */
+FILE *output_file;      /*  y.tab.c                                         */
+FILE *text_file;        /*  a temp file, used to save text until all        */
+                        /*  symbols have been defined                       */
+FILE *verbose_file;     /*  y.output                                        */
+FILE *interface_file;
+
+int nitems;
+int nrules;
+int ntotalrules;
+int nsyms;
+int ntokens;
+int nvars;
+
+int   start_symbol;
+char  **symbol_name;
+short *symbol_value;
+short *symbol_prec;
+char  *symbol_assoc;
+char **symbol_tag;
+char *symbol_true_token;
+
+short *ritem;
+short *rlhs;
+short *rrhs;
+short *rprec;
+char  *rassoc;
+short **derives;
+char *nullable;
+
+
+void done(int k)
+{
+#ifdef HAS_MKSTEMP
+    if (action_fd != -1)
+       unlink(action_file_name);
+    if (entry_fd != -1)
+       unlink(entry_file_name);
+    if (text_fd != -1)
+       unlink(text_file_name);
+#else
+    if (action_file) { fclose(action_file); unlink_os(action_file_name); }
+    if (entry_file) { fclose(entry_file); unlink_os(entry_file_name); }
+    if (text_file) { fclose(text_file); unlink_os(text_file_name); }
+#endif
+    if (output_file && k > 0) {
+      fclose(output_file); unlink_os(output_file_name);
+    }
+    if (interface_file && k > 0) {
+      fclose(interface_file); unlink_os(interface_file_name);
+    }
+    exit(k);
+}
+
+
+void onintr(int dummy)
+{
+    done(1);
+}
+
+
+void set_signals(void)
+{
+#ifdef SIGINT
+    if (signal(SIGINT, SIG_IGN) != SIG_IGN)
+        signal(SIGINT, onintr);
+#endif
+#ifdef SIGTERM
+    if (signal(SIGTERM, SIG_IGN) != SIG_IGN)
+        signal(SIGTERM, onintr);
+#endif
+#ifdef SIGHUP
+    if (signal(SIGHUP, SIG_IGN) != SIG_IGN)
+        signal(SIGHUP, onintr);
+#endif
+}
+
+
+void usage(void)
+{
+    fprintf(stderr, "usage: %s [-v] [--strict] [-q] [-b file_prefix] filename\n",
+            myname);
+    exit(1);
+}
+
+void getargs(int argc, char_os **argv)
+{
+    register int i;
+    register char_os *s;
+
+    if (argc > 0) myname = caml_stat_strdup_of_os(argv[0]);
+    if (!myname) no_space();
+    for (i = 1; i < argc; ++i)
+    {
+        s = argv[i];
+        if (*s != '-') break;
+        switch (*++s)
+        {
+        case '\0':
+            input_file = stdin;
+            file_prefix = T("stdin");
+            if (i + 1 < argc) usage();
+            return;
+
+        case '-':
+            if (!strcmp_os (argv[i], T("--strict"))){
+              eflag = 1;
+              goto end_of_option;
+            }
+            ++i;
+            goto no_more_options;
+
+        case 'v':
+            if (!strcmp_os (argv[i], T("-version"))){
+              printf ("The OCaml parser generator, version "
+                      OCAML_VERSION "\n");
+              exit (0);
+            }else if (!strcmp_os (argv[i], T("-vnum"))){
+              printf (OCAML_VERSION "\n");
+              exit (0);
+            }else{
+              vflag = 1;
+            }
+            break;
+
+        case 'q':
+            qflag = 1;
+            break;
+
+        case 'b':
+            if (*++s)
+                 file_prefix = s;
+            else if (++i < argc)
+                file_prefix = argv[i];
+            else
+                usage();
+            continue;
+
+        default:
+            usage();
+        }
+
+        for (;;)
+        {
+            switch (*++s)
+            {
+            case '\0':
+                goto end_of_option;
+
+            case 'v':
+                vflag = 1;
+                break;
+
+            case 'q':
+                qflag = 1;
+                break;
+
+            default:
+                usage();
+            }
+        }
+end_of_option:;
+    }
+
+no_more_options:;
+    if (i + 1 != argc) usage();
+    input_file_name = argv[i];
+    input_file_name_disp = caml_stat_strdup_of_os(input_file_name);
+    if (!input_file_name_disp) no_space();
+    if (file_prefix == 0) {
+      int len;
+      len = strlen_os(argv[i]);
+      file_prefix = MALLOC((len + 1) * sizeof(char_os));
+      if (file_prefix == 0) no_space();
+      strcpy_os(file_prefix, argv[i]);
+      while (len > 0) {
+        len--;
+        if (file_prefix[len] == '.') {
+          file_prefix[len] = 0;
+          break;
+        }
+      }
+    }
+}
+
+
+char *
+allocate(unsigned int n)
+{
+    register char *p;
+
+    p = NULL;
+    if (n)
+    {
+        p = CALLOC(1, n);
+        if (!p) no_space();
+    }
+    return (p);
+}
+
+
+void create_file_names(void)
+{
+    int i, len;
+    char_os *tmpdir;
+
+#ifdef _WIN32
+    tmpdir = _wgetenv(L"TEMP");
+    if (tmpdir == 0) tmpdir = L".";
+#else
+    tmpdir = getenv("TMPDIR");
+    if (tmpdir == 0) tmpdir = "/tmp";
+#endif
+    len = strlen_os(tmpdir);
+    i = len + sizeof(temp_form);
+    if (len && tmpdir[len-1] != dirsep)
+        ++i;
+
+    action_file_name = MALLOC(i * sizeof(char_os));
+    if (action_file_name == 0) no_space();
+    entry_file_name = MALLOC(i * sizeof(char_os));
+    if (entry_file_name == 0) no_space();
+    text_file_name = MALLOC(i * sizeof(char_os));
+    if (text_file_name == 0) no_space();
+
+    strcpy_os(action_file_name, tmpdir);
+    strcpy_os(entry_file_name, tmpdir);
+    strcpy_os(text_file_name, tmpdir);
+
+    if (len && tmpdir[len - 1] != dirsep)
+    {
+        action_file_name[len] = dirsep;
+        entry_file_name[len] = dirsep;
+        text_file_name[len] = dirsep;
+        ++len;
+    }
+
+    strcpy_os(action_file_name + len, temp_form);
+    strcpy_os(entry_file_name + len, temp_form);
+    strcpy_os(text_file_name + len, temp_form);
+
+    action_file_name[len + 5] = L'a';
+    entry_file_name[len + 5] = L'e';
+    text_file_name[len + 5] = L't';
+
+#ifdef HAS_MKSTEMP
+    action_fd = mkstemp(action_file_name);
+    if (action_fd == -1)
+        open_error(action_file_name);
+    entry_fd = mkstemp(entry_file_name);
+    if (entry_fd == -1)
+        open_error(entry_file_name);
+    text_fd = mkstemp(text_file_name);
+    if (text_fd == -1)
+        open_error(text_file_name);
+#else
+    mktemp_os(action_file_name);
+    mktemp_os(entry_file_name);
+    mktemp_os(text_file_name);
+#endif
+
+    len = strlen_os(file_prefix);
+
+    output_file_name = MALLOC((len + 7) * sizeof(char_os));
+    if (output_file_name == 0)
+        no_space();
+    strcpy_os(output_file_name, file_prefix);
+    strcpy_os(output_file_name + len, OUTPUT_SUFFIX);
+
+    code_file_name = output_file_name;
+    code_file_name_disp = caml_stat_strdup_of_os(code_file_name);
+    if (!code_file_name_disp) no_space();
+
+    if (vflag)
+    {
+        verbose_file_name = MALLOC((len + 8) * sizeof(char_os));
+        if (verbose_file_name == 0)
+            no_space();
+        strcpy_os(verbose_file_name, file_prefix);
+        strcpy_os(verbose_file_name + len, VERBOSE_SUFFIX);
+    }
+
+    interface_file_name = MALLOC((len + 8) * sizeof(char_os));
+    if (interface_file_name == 0)
+        no_space();
+    strcpy_os(interface_file_name, file_prefix);
+    strcpy_os(interface_file_name + len, INTERFACE_SUFFIX);
+
+}
+
+
+void open_files(void)
+{
+    create_file_names();
+
+    if (input_file == 0)
+    {
+        input_file = fopen_os(input_file_name, T("r"));
+        if (input_file == 0)
+            open_error(input_file_name);
+    }
+
+#ifdef HAS_MKSTEMP
+    action_file = fdopen(action_fd, "w");
+#else
+    action_file = fopen_os(action_file_name, T("w"));
+#endif
+    if (action_file == 0)
+        open_error(action_file_name);
+
+#ifdef HAS_MKSTEMP
+    entry_file = fdopen(entry_fd, "w");
+#else
+    entry_file = fopen_os(entry_file_name, T("w"));
+#endif
+    if (entry_file == 0)
+        open_error(entry_file_name);
+
+#ifdef HAS_MKSTEMP
+    text_file = fdopen(text_fd, "w");
+#else
+    text_file = fopen_os(text_file_name, T("w"));
+#endif
+    if (text_file == 0)
+        open_error(text_file_name);
+
+    if (vflag)
+    {
+        verbose_file = fopen_os(verbose_file_name, T("w"));
+        if (verbose_file == 0)
+            open_error(verbose_file_name);
+    }
+
+    output_file = fopen_os(output_file_name, T("w"));
+    if (output_file == 0)
+        open_error(output_file_name);
+
+    if (rflag)
+    {
+        code_file = fopen_os(code_file_name, T("w"));
+        if (code_file == 0)
+            open_error(code_file_name);
+    }
+    else
+        code_file = output_file;
+
+
+    interface_file = fopen_os(interface_file_name, T("w"));
+    if (interface_file == 0)
+      open_error(interface_file_name);
+}
+
+#ifdef _WIN32
+int wmain(int argc, wchar_t **argv)
+#else
+int main(int argc, char **argv)
+#endif
+{
+    set_signals();
+    getargs(argc, argv);
+    open_files();
+    reader();
+    lr0();
+    lalr();
+    make_parser();
+    verbose();
+    if (eflag && SRtotal + RRtotal > 0) forbidden_conflicts();
+    output();
+    done(0);
+    /*NOTREACHED*/
+    return 0;
+}
diff --git a/yacc/mkpar.c b/yacc/mkpar.c
new file mode 100644
index 00000000..79b2f928
--- /dev/null
+++ b/yacc/mkpar.c
@@ -0,0 +1,365 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Based on public-domain code from Berkeley Yacc */
+
+#include "defs.h"
+
+action **parser;
+int SRtotal;
+int RRtotal;
+short *SRconflicts;
+short *RRconflicts;
+short *defred;
+short *rules_used;
+short nunused;
+short final_state;
+
+static int SRcount;
+static int RRcount;
+
+void find_final_state (void);
+void remove_conflicts (void);
+void unused_rules (void);
+void total_conflicts (void);
+void defreds (void);
+
+void make_parser(void)
+{
+    register int i;
+
+    parser = NEW2(nstates, action *);
+    for (i = 0; i < nstates; i++)
+        parser[i] = parse_actions(i);
+
+    find_final_state();
+    remove_conflicts();
+    unused_rules();
+    if (SRtotal + RRtotal > 0) total_conflicts();
+    defreds();
+}
+
+
+action *
+parse_actions(register int stateno)
+{
+    register action *actions;
+
+    actions = get_shifts(stateno);
+    actions = add_reductions(stateno, actions);
+    return (actions);
+}
+
+
+action *
+get_shifts(int stateno)
+{
+    register action *actions, *temp;
+    register shifts *sp;
+    register short *to_state;
+    register int i, k;
+    register int symbol;
+
+    actions = 0;
+    sp = shift_table[stateno];
+    if (sp)
+    {
+        to_state = sp->shift;
+        for (i = sp->nshifts - 1; i >= 0; i--)
+        {
+            k = to_state[i];
+            symbol = accessing_symbol[k];
+            if (ISTOKEN(symbol))
+            {
+                temp = NEW(action);
+                temp->next = actions;
+                temp->symbol = symbol;
+                temp->number = k;
+                temp->prec = symbol_prec[symbol];
+                temp->action_code = SHIFT;
+                temp->assoc = symbol_assoc[symbol];
+                actions = temp;
+            }
+        }
+    }
+    return (actions);
+}
+
+action *
+add_reductions(int stateno, register action *actions)
+{
+    register int i, j, m, n;
+    register int ruleno, tokensetsize;
+    register unsigned *rowp;
+
+    tokensetsize = WORDSIZE(ntokens);
+    m = lookaheads[stateno];
+    n = lookaheads[stateno + 1];
+    for (i = m; i < n; i++)
+    {
+        ruleno = LAruleno[i];
+        rowp = LA + i * tokensetsize;
+        for (j = ntokens - 1; j >= 0; j--)
+        {
+            if (BIT(rowp, j))
+                actions = add_reduce(actions, ruleno, j);
+        }
+    }
+    return (actions);
+}
+
+
+action *
+add_reduce(register action *actions, register int ruleno, register int symbol)
+{
+    register action *temp, *prev, *next;
+
+    prev = 0;
+    for (next = actions; next && next->symbol < symbol; next = next->next)
+        prev = next;
+
+    while (next && next->symbol == symbol && next->action_code == SHIFT)
+    {
+        prev = next;
+        next = next->next;
+    }
+
+    while (next && next->symbol == symbol &&
+            next->action_code == REDUCE && next->number < ruleno)
+    {
+        prev = next;
+        next = next->next;
+    }
+
+    temp = NEW(action);
+    temp->next = next;
+    temp->symbol = symbol;
+    temp->number = ruleno;
+    temp->prec = rprec[ruleno];
+    temp->action_code = REDUCE;
+    temp->assoc = rassoc[ruleno];
+
+    if (prev)
+        prev->next = temp;
+    else
+        actions = temp;
+
+    return (actions);
+}
+
+
+void find_final_state(void)
+{
+    register int goal, i;
+    register short *to_state;
+    register shifts *p;
+
+    p = shift_table[0];
+    to_state = p->shift;
+    goal = ritem[1];
+    for (i = p->nshifts - 1; i >= 0; --i)
+    {
+        final_state = to_state[i];
+        if (accessing_symbol[final_state] == goal) break;
+    }
+}
+
+
+void unused_rules(void)
+{
+    register int i;
+    register action *p;
+
+    rules_used = (short *) MALLOC(nrules*sizeof(short));
+    if (rules_used == 0) no_space();
+
+    for (i = 0; i < nrules; ++i)
+        rules_used[i] = 0;
+
+    for (i = 0; i < nstates; ++i)
+    {
+        for (p = parser[i]; p; p = p->next)
+        {
+            if (p->action_code == REDUCE && p->suppressed == 0)
+                rules_used[p->number] = 1;
+        }
+    }
+
+    nunused = 0;
+    for (i = 3; i < nrules; ++i)
+        if (!rules_used[i]) ++nunused;
+
+    if (nunused){
+        if (nunused == 1)
+            fprintf(stderr, "1 rule never reduced\n");
+        else
+            fprintf(stderr, "%d rules never reduced\n", nunused);
+    }
+}
+
+
+void remove_conflicts(void)
+{
+    register int i;
+    register int symbol;
+    register action *p, *pref;
+
+    SRtotal = 0;
+    RRtotal = 0;
+    SRconflicts = NEW2(nstates, short);
+    RRconflicts = NEW2(nstates, short);
+    pref = NULL;
+    for (i = 0; i < nstates; i++)
+    {
+        SRcount = 0;
+        RRcount = 0;
+        symbol = -1;
+        for (p = parser[i]; p; p = p->next)
+        {
+            if (p->symbol != symbol)
+            {
+                pref = p;
+                symbol = p->symbol;
+            }
+            else if (i == final_state && symbol == 0)
+            {
+                SRcount++;
+                p->suppressed = 1;
+            }
+            else if (pref->action_code == SHIFT)
+            {
+                if (pref->prec > 0 && p->prec > 0)
+                {
+                    if (pref->prec < p->prec)
+                    {
+                        pref->suppressed = 2;
+                        pref = p;
+                    }
+                    else if (pref->prec > p->prec)
+                    {
+                        p->suppressed = 2;
+                    }
+                    else if (pref->assoc == LEFT)
+                    {
+                        pref->suppressed = 2;
+                        pref = p;
+                    }
+                    else if (pref->assoc == RIGHT)
+                    {
+                        p->suppressed = 2;
+                    }
+                    else
+                    {
+                        pref->suppressed = 2;
+                        p->suppressed = 2;
+                    }
+                }
+                else
+                {
+                    SRcount++;
+                    p->suppressed = 1;
+                }
+            }
+            else
+            {
+                RRcount++;
+                p->suppressed = 1;
+            }
+        }
+        SRtotal += SRcount;
+        RRtotal += RRcount;
+        SRconflicts[i] = SRcount;
+        RRconflicts[i] = RRcount;
+    }
+}
+
+
+void total_conflicts(void)
+{
+    if (SRtotal == 1)
+        fprintf(stderr, "1 shift/reduce conflict");
+    else if (SRtotal > 1)
+        fprintf(stderr, "%d shift/reduce conflicts", SRtotal);
+
+    if (SRtotal && RRtotal)
+        fprintf(stderr, ", ");
+
+    if (RRtotal == 1)
+        fprintf(stderr, "1 reduce/reduce conflict");
+    else if (RRtotal > 1)
+        fprintf(stderr, "%d reduce/reduce conflicts", RRtotal);
+
+    fprintf(stderr, ".\n");
+}
+
+
+int
+sole_reduction(int stateno)
+{
+    register int count, ruleno;
+    register action *p;
+
+    count = 0;
+    ruleno = 0;
+    for (p = parser[stateno]; p; p = p->next)
+    {
+        if (p->action_code == SHIFT && p->suppressed == 0)
+            return (0);
+        else if (p->action_code == REDUCE && p->suppressed == 0)
+        {
+            if (ruleno > 0 && p->number != ruleno)
+                return (0);
+            if (p->symbol != 1)
+                ++count;
+            ruleno = p->number;
+        }
+    }
+
+    if (count == 0)
+        return (0);
+    return (ruleno);
+}
+
+
+void defreds(void)
+{
+    register int i;
+
+    defred = NEW2(nstates, short);
+    for (i = 0; i < nstates; i++)
+        defred[i] = sole_reduction(i);
+}
+
+void free_action_row(register action *p)
+{
+  register action *q;
+
+  while (p)
+    {
+      q = p->next;
+      FREE(p);
+      p = q;
+    }
+}
+
+void free_parser(void)
+{
+  register int i;
+
+  for (i = 0; i < nstates; i++)
+    free_action_row(parser[i]);
+
+  FREE(parser);
+}
diff --git a/yacc/output.c b/yacc/output.c
new file mode 100644
index 00000000..384890ae
--- /dev/null
+++ b/yacc/output.c
@@ -0,0 +1,985 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Based on public-domain code from Berkeley Yacc */
+
+#include "defs.h"
+
+static int nvectors;
+static int nentries;
+static short **froms;
+static short **tos;
+static short *tally;
+static short *width;
+static short *state_count;
+static short *order;
+static short *base;
+static short *pos;
+static int maxtable;
+static short *table;
+static short *check;
+static int lowzero;
+static int high;
+
+
+void free_itemsets (void);
+void free_shifts (void);
+void free_reductions (void);
+void output_stored_text (void);
+void output_transl (void);
+void output_rule_data (void);
+void output_yydefred (void);
+void output_actions (void);
+void output_debug (void);
+void output_trailing_text (void);
+void output_semantic_actions (void);
+void output_entries (void);
+void token_actions (void);
+void goto_actions (void);
+void sort_actions (void);
+void pack_table (void);
+void output_base (void);
+void output_table (void);
+void output_check (void);
+int default_goto (int symbol);
+void save_column (int symbol, int default_state);
+int matching_vector (int vector);
+int pack_vector (int vector);
+
+
+void output(void)
+{
+  extern char *header[], *define_tables[];
+
+  free_itemsets();
+  free_shifts();
+  free_reductions();
+  write_section(header);
+  output_stored_text();
+  output_transl();
+  output_rule_data();
+  output_yydefred();
+  output_actions();
+  output_debug();
+  free_parser();
+  if (sflag){
+    if (!rflag) ++outline;
+    fprintf(output_file,
+      "let yyact = Array.new %d (fun _ -> (failwith \"parser\" : Obj.t))\n",
+      ntotalrules);
+  }else{
+    if (!rflag) outline += 2;
+    fprintf(output_file,
+      "let yyact = [|\n  (fun _ -> failwith \"parser\")\n");
+  }
+  output_semantic_actions();
+  if (!sflag){
+    if (!rflag) ++outline;
+    fprintf(output_file, "|]\n");
+  }
+  write_section(define_tables);
+  output_entries();
+  output_trailing_text();
+}
+
+
+static void output_char(unsigned int n)
+{
+  n = n & 0xFF;
+  putc('\\', output_file);
+  putc('0' + n / 100, output_file);
+  putc('0' + (n / 10) % 10, output_file);
+  putc('0' + n % 10, output_file);
+}
+
+static void output_short(int n)
+{
+  output_char(n);
+  output_char(n >> 8);
+}
+
+void output_rule_data(void)
+{
+    register int i;
+    register int j;
+
+
+    fprintf(output_file, "let yylhs = \"");
+    output_short(symbol_value[start_symbol]);
+
+    j = 8;
+    for (i = 3; i < nrules; i++)
+    {
+        if (j >= 8)
+        {
+            if (!rflag) ++outline;
+            fprintf(output_file, "\\\n");
+            j = 1;
+        }
+        else
+            ++j;
+
+        output_short(symbol_value[rlhs[i]]);
+    }
+    if (!rflag) outline += 2;
+    fprintf(output_file, "\"\n\n");
+
+    fprintf(output_file, "let yylen = \"");
+    output_short(2);
+
+    j = 8;
+    for (i = 3; i < nrules; i++)
+    {
+        if (j >= 8)
+        {
+            if (!rflag) ++outline;
+            fprintf(output_file, "\\\n");
+            j = 1;
+        }
+        else
+          j++;
+
+        output_short(rrhs[i + 1] - rrhs[i] - 1);
+    }
+    if (!rflag) outline += 2;
+    fprintf(output_file, "\"\n\n");
+}
+
+
+void output_yydefred(void)
+{
+    register int i, j;
+
+    fprintf(output_file, "let yydefred = \"");
+    output_short(defred[0] ? defred[0] - 2 : 0);
+
+    j = 8;
+    for (i = 1; i < nstates; i++)
+    {
+        if (j < 8)
+            ++j;
+        else
+        {
+            if (!rflag) ++outline;
+            fprintf(output_file, "\\\n");
+            j = 1;
+        }
+
+        output_short(defred[i] ? defred[i] - 2 : 0);
+    }
+
+    if (!rflag) outline += 2;
+    fprintf(output_file, "\"\n\n");
+}
+
+
+void output_actions(void)
+{
+    nvectors = 2*nstates + nvars;
+
+    froms = NEW2(nvectors, short *);
+    tos = NEW2(nvectors, short *);
+    tally = NEW2(nvectors, short);
+    width = NEW2(nvectors, short);
+
+    token_actions();
+    FREE(lookaheads);
+    FREE(LA);
+    FREE(LAruleno);
+    FREE(accessing_symbol);
+
+    goto_actions();
+    FREE(goto_map + ntokens);
+    FREE(from_state);
+    FREE(to_state);
+
+    sort_actions();
+    pack_table();
+    output_base();
+    output_table();
+    output_check();
+}
+
+
+void token_actions(void)
+{
+    register int i, j;
+    register int shiftcount, reducecount;
+    register int max, min;
+    register short *actionrow, *r, *s;
+    register action *p;
+
+    actionrow = NEW2(2*ntokens, short);
+    for (i = 0; i < nstates; ++i)
+    {
+        if (parser[i])
+        {
+            for (j = 0; j < 2*ntokens; ++j)
+            actionrow[j] = 0;
+
+            shiftcount = 0;
+            reducecount = 0;
+            for (p = parser[i]; p; p = p->next)
+            {
+                if (p->suppressed == 0)
+                {
+                    if (p->action_code == SHIFT)
+                    {
+                        ++shiftcount;
+                        actionrow[p->symbol] = p->number;
+                    }
+                    else if (p->action_code == REDUCE && p->number != defred[i])
+                    {
+                        ++reducecount;
+                        actionrow[p->symbol + ntokens] = p->number;
+                    }
+                }
+            }
+
+            tally[i] = shiftcount;
+            tally[nstates+i] = reducecount;
+            width[i] = 0;
+            width[nstates+i] = 0;
+            if (shiftcount > 0)
+            {
+                froms[i] = r = NEW2(shiftcount, short);
+                tos[i] = s = NEW2(shiftcount, short);
+                min = MAXSHORT;
+                max = 0;
+                for (j = 0; j < ntokens; ++j)
+                {
+                    if (actionrow[j])
+                    {
+                        if (min > symbol_value[j])
+                            min = symbol_value[j];
+                        if (max < symbol_value[j])
+                            max = symbol_value[j];
+                        *r++ = symbol_value[j];
+                        *s++ = actionrow[j];
+                    }
+                }
+                width[i] = max - min + 1;
+            }
+            if (reducecount > 0)
+            {
+                froms[nstates+i] = r = NEW2(reducecount, short);
+                tos[nstates+i] = s = NEW2(reducecount, short);
+                min = MAXSHORT;
+                max = 0;
+                for (j = 0; j < ntokens; ++j)
+                {
+                    if (actionrow[ntokens+j])
+                    {
+                        if (min > symbol_value[j])
+                            min = symbol_value[j];
+                        if (max < symbol_value[j])
+                            max = symbol_value[j];
+                        *r++ = symbol_value[j];
+                        *s++ = actionrow[ntokens+j] - 2;
+                    }
+                }
+                width[nstates+i] = max - min + 1;
+            }
+        }
+    }
+    FREE(actionrow);
+}
+
+void goto_actions(void)
+{
+    register int i, j, k;
+
+    state_count = NEW2(nstates, short);
+
+    k = default_goto(start_symbol + 1);
+    fprintf(output_file, "let yydgoto = \"");
+    output_short(k);
+
+    save_column(start_symbol + 1, k);
+
+    j = 8;
+    for (i = start_symbol + 2; i < nsyms; i++)
+    {
+        if (j >= 8)
+        {
+            if (!rflag) ++outline;
+            fprintf(output_file, "\\\n");
+            j = 1;
+        }
+        else
+            ++j;
+
+        k = default_goto(i);
+        output_short(k);
+        save_column(i, k);
+    }
+
+    if (!rflag) outline += 2;
+    fprintf(output_file, "\"\n\n");
+    FREE(state_count);
+}
+
+int
+default_goto(int symbol)
+{
+    register int i;
+    register int m;
+    register int n;
+    register int default_state;
+    register int max;
+
+    m = goto_map[symbol];
+    n = goto_map[symbol + 1];
+
+    if (m == n) return (0);
+
+    for (i = 0; i < nstates; i++)
+        state_count[i] = 0;
+
+    for (i = m; i < n; i++)
+        state_count[to_state[i]]++;
+
+    max = 0;
+    default_state = 0;
+    for (i = 0; i < nstates; i++)
+    {
+        if (state_count[i] > max)
+        {
+            max = state_count[i];
+            default_state = i;
+        }
+    }
+
+    return (default_state);
+}
+
+
+
+void save_column(int symbol, int default_state)
+{
+    register int i;
+    register int m;
+    register int n;
+    register short *sp;
+    register short *sp1;
+    register short *sp2;
+    register int count;
+    register int symno;
+
+    m = goto_map[symbol];
+    n = goto_map[symbol + 1];
+
+    count = 0;
+    for (i = m; i < n; i++)
+    {
+        if (to_state[i] != default_state)
+            ++count;
+    }
+    if (count == 0) return;
+
+    symno = symbol_value[symbol] + 2*nstates;
+
+    froms[symno] = sp1 = sp = NEW2(count, short);
+    tos[symno] = sp2 = NEW2(count, short);
+
+    for (i = m; i < n; i++)
+    {
+        if (to_state[i] != default_state)
+        {
+            *sp1++ = from_state[i];
+            *sp2++ = to_state[i];
+        }
+    }
+
+    tally[symno] = count;
+    width[symno] = sp1[-1] - sp[0] + 1;
+}
+
+void sort_actions(void)
+{
+  register int i;
+  register int j;
+  register int k;
+  register int t;
+  register int w;
+
+  order = NEW2(nvectors, short);
+  nentries = 0;
+
+  for (i = 0; i < nvectors; i++)
+    {
+      if (tally[i] > 0)
+        {
+          t = tally[i];
+          w = width[i];
+          j = nentries - 1;
+
+          while (j >= 0 && (width[order[j]] < w))
+            j--;
+
+          while (j >= 0 && (width[order[j]] == w) && (tally[order[j]] < t))
+            j--;
+
+          for (k = nentries - 1; k > j; k--)
+            order[k + 1] = order[k];
+
+          order[j + 1] = i;
+          nentries++;
+        }
+    }
+}
+
+
+void pack_table(void)
+{
+    register int i;
+    register int place;
+    register int state;
+
+    base = NEW2(nvectors, short);
+    pos = NEW2(nentries, short);
+
+    maxtable = 1000;
+    table = NEW2(maxtable, short);
+    check = NEW2(maxtable, short);
+
+    lowzero = 0;
+    high = 0;
+
+    for (i = 0; i < maxtable; i++)
+        check[i] = -1;
+
+    for (i = 0; i < nentries; i++)
+    {
+        state = matching_vector(i);
+
+        if (state < 0)
+            place = pack_vector(i);
+        else
+            place = base[state];
+
+        pos[i] = place;
+        base[order[i]] = place;
+    }
+
+    for (i = 0; i < nvectors; i++)
+    {
+        if (froms[i])
+            FREE(froms[i]);
+        if (tos[i])
+            FREE(tos[i]);
+    }
+
+    FREE(froms);
+    FREE(tos);
+    FREE(pos);
+}
+
+
+/*  The function matching_vector determines if the vector specified by    */
+/*  the input parameter matches a previously considered vector.  The      */
+/*  test at the start of the function checks if the vector represents     */
+/*  a row of shifts over terminal symbols or a row of reductions, or a    */
+/*  column of shifts over a nonterminal symbol.  Berkeley Yacc does not   */
+/*  check if a column of shifts over a nonterminal symbols matches a      */
+/*  previously considered vector.  Because of the nature of LR parsing    */
+/*  tables, no two columns can match.  Therefore, the only possible       */
+/*  match would be between a row and a column.  Such matches are          */
+/*  unlikely.  Therefore, to save time, no attempt is made to see if a    */
+/*  column matches a previously considered vector.                        */
+/*                                                                        */
+/*  Matching_vector is poorly designed.  The test could easily be made    */
+/*  faster.  Also, it depends on the vectors being in a specific          */
+/*  order.                                                                */
+
+int
+matching_vector(int vector)
+{
+    register int i;
+    register int j;
+    register int k;
+    register int t;
+    register int w;
+    register int match;
+    register int prev;
+
+    i = order[vector];
+    if (i >= 2*nstates)
+        return (-1);
+
+    t = tally[i];
+    w = width[i];
+
+    for (prev = vector - 1; prev >= 0; prev--)
+    {
+        j = order[prev];
+        if (width[j] != w || tally[j] != t)
+            return (-1);
+
+        match = 1;
+        for (k = 0; match && k < t; k++)
+        {
+            if (tos[j][k] != tos[i][k] || froms[j][k] != froms[i][k])
+                match = 0;
+        }
+
+        if (match)
+            return (j);
+    }
+
+    return (-1);
+}
+
+
+
+int
+pack_vector(int vector)
+{
+    register int i, j, k, l;
+    register int t;
+    register int loc;
+    register int ok;
+    register short *from;
+    register short *to;
+    int newmax;
+
+    i = order[vector];
+    t = tally[i];
+    assert(t);
+
+    from = froms[i];
+    to = tos[i];
+
+    j = lowzero - from[0];
+    for (k = 1; k < t; ++k)
+        if (lowzero - from[k] > j)
+            j = lowzero - from[k];
+    for (;; ++j)
+    {
+        if (j == 0)
+            continue;
+        ok = 1;
+        for (k = 0; ok && k < t; k++)
+        {
+            loc = j + from[k];
+            if (loc >= maxtable)
+            {
+                if (loc >= MAXTABLE)
+                    fatal("maximum table size exceeded");
+
+                newmax = maxtable;
+                do { newmax += 200; } while (newmax <= loc);
+                table = (short *) REALLOC(table, newmax*sizeof(short));
+                if (table == 0) no_space();
+                check = (short *) REALLOC(check, newmax*sizeof(short));
+                if (check == 0) no_space();
+                for (l  = maxtable; l < newmax; ++l)
+                {
+                    table[l] = 0;
+                    check[l] = -1;
+                }
+                maxtable = newmax;
+            }
+
+            if (check[loc] != -1)
+                ok = 0;
+        }
+        for (k = 0; ok && k < vector; k++)
+        {
+            if (pos[k] == j)
+                ok = 0;
+        }
+        if (ok)
+        {
+            for (k = 0; k < t; k++)
+            {
+                loc = j + from[k];
+                table[loc] = to[k];
+                check[loc] = from[k];
+                if (loc > high) high = loc;
+            }
+
+            while (lowzero < maxtable && check[lowzero] != -1)
+                ++lowzero;
+
+            return (j);
+        }
+    }
+}
+
+
+
+void output_base(void)
+{
+    register int i, j;
+
+    fprintf(output_file, "let yysindex = \"");
+    output_short(base[0]);
+
+    j = 8;
+    for (i = 1; i < nstates; i++)
+    {
+        if (j >= 8)
+        {
+            if (!rflag) ++outline;
+            fprintf(output_file, "\\\n");
+            j = 1;
+        }
+        else
+            ++j;
+
+        output_short(base[i]);
+    }
+
+    if (!rflag) outline += 2;
+    fprintf(output_file, "\"\n\n");
+
+    fprintf(output_file, "let yyrindex = \"");
+    output_short(base[nstates]);
+
+    j = 8;
+    for (i = nstates + 1; i < 2*nstates; i++)
+    {
+        if (j >= 8)
+        {
+            if (!rflag) ++outline;
+            fprintf(output_file, "\\\n");
+            j = 1;
+        }
+        else
+            ++j;
+
+        output_short(base[i]);
+    }
+
+    if (!rflag) outline += 2;
+    fprintf(output_file, "\"\n\n");
+
+    fprintf(output_file, "let yygindex = \"");
+    output_short(base[2*nstates]);
+
+    j = 8;
+    for (i = 2*nstates + 1; i < nvectors - 1; i++)
+    {
+        if (j >= 8)
+        {
+            if (!rflag) ++outline;
+            fprintf(output_file, "\\\n");
+            j = 1;
+        }
+        else
+            ++j;
+
+        output_short(base[i]);
+    }
+
+    if (!rflag) outline += 2;
+    fprintf(output_file, "\"\n\n");
+    FREE(base);
+}
+
+
+
+void output_table(void)
+{
+    register int i;
+    register int j;
+
+    ++outline;
+    fprintf(code_file, "let yytablesize = %d\n", high);
+    fprintf(output_file, "let yytable = \"");
+    output_short(table[0]);
+
+    j = 8;
+    for (i = 1; i <= high; i++)
+    {
+        if (j >= 8)
+        {
+            if (!rflag) ++outline;
+            fprintf(output_file, "\\\n");
+            j = 1;
+        }
+        else
+            ++j;
+
+        output_short(table[i]);
+    }
+
+    if (!rflag) outline += 2;
+    fprintf(output_file, "\"\n\n");
+    FREE(table);
+}
+
+
+
+void output_check(void)
+{
+    register int i;
+    register int j;
+
+    fprintf(output_file, "let yycheck = \"");
+    output_short(check[0]);
+
+    j = 8;
+    for (i = 1; i <= high; i++)
+    {
+        if (j >= 8)
+        {
+            if (!rflag) ++outline;
+            fprintf(output_file, "\\\n");
+            j = 1;
+        }
+        else
+            ++j;
+
+        output_short(check[i]);
+    }
+
+    if (!rflag) outline += 2;
+    fprintf(output_file, "\"\n\n");
+    FREE(check);
+}
+
+
+void output_transl(void)
+{
+  int i;
+
+  ++outline;
+  fprintf(code_file, "let yytransl_const = [|\n");
+  for (i = 0; i < ntokens; i++) {
+    if (symbol_true_token[i] && symbol_tag[i] == NULL) {
+      ++outline;
+      fprintf(code_file, "  %3d (* %s *);\n", symbol_value[i], symbol_name[i]);
+    }
+  }
+  outline += 2;
+  fprintf(code_file, "    0|]\n\n");
+  ++outline;
+  fprintf(code_file, "let yytransl_block = [|\n");
+  for (i = 0; i < ntokens; i++) {
+    if (symbol_true_token[i] && symbol_tag[i] != NULL) {
+      ++outline;
+      fprintf(code_file, "  %3d (* %s *);\n", symbol_value[i], symbol_name[i]);
+    }
+  }
+  outline += 2;
+  fprintf(code_file, "    0|]\n\n");
+}
+
+void output_stored_text(void)
+{
+    register int c;
+    register FILE *in, *out;
+
+    fclose(text_file);
+    text_file = fopen_os(text_file_name, T("r"));
+    if (text_file == NULL)
+        open_error(text_file_name);
+    in = text_file;
+    if ((c = getc(in)) == EOF)
+        return;
+    out = code_file;
+    if (c ==  '\n')
+        ++outline;
+    putc(c, out);
+    while ((c = getc(in)) != EOF)
+    {
+        if (c == '\n')
+            ++outline;
+        putc(c, out);
+    }
+    if (!lflag)
+        fprintf(out, line_format, ++outline + 1, code_file_name_disp);
+}
+
+
+void output_debug(void)
+{
+  int i;
+
+  ++outline;
+  fprintf(code_file, "let yynames_const = \"\\\n");
+  for (i = 0; i < ntokens; i++) {
+    if (symbol_true_token[i] && symbol_tag[i] == NULL) {
+      ++outline;
+      fprintf(code_file, "  %s\\000\\\n", symbol_name[i]);
+    }
+  }
+  outline += 2;
+  fprintf(code_file, "  \"\n\n");
+  ++outline;
+  fprintf(code_file, "let yynames_block = \"\\\n");
+  for (i = 0; i < ntokens; i++) {
+    if (symbol_true_token[i] && symbol_tag[i] != NULL) {
+      ++outline;
+      fprintf(code_file, "  %s\\000\\\n", symbol_name[i]);
+    }
+  }
+  outline += 2;
+  fprintf(code_file, "  \"\n\n");
+}
+
+void output_trailing_text(void)
+{
+    register int c, last;
+    register FILE *in, *out;
+
+    if (line == 0)
+        return;
+
+    in = input_file;
+    out = code_file;
+
+    ++outline;
+    fprintf (out, ";;\n");
+
+    c = *cptr;
+    if (c == '\n')
+    {
+        ++lineno;
+        if ((c = getc(in)) == EOF)
+            return;
+        if (!lflag)
+        {
+            ++outline;
+            fprintf(out, line_format, lineno, input_file_name_disp);
+        }
+        if (c == '\n')
+            ++outline;
+        putc(c, out);
+        last = c;
+    }
+    else
+    {
+        if (!lflag)
+        {
+            ++outline;
+            fprintf(out, line_format, lineno, input_file_name_disp);
+        }
+        do { putc(c, out); } while ((c = *++cptr) != '\n');
+        ++outline;
+        putc('\n', out);
+        last = '\n';
+    }
+
+
+    while ((c = getc(in)) != EOF)
+    {
+        if (c == '\n')
+            ++outline;
+        putc(c, out);
+        last = c;
+    }
+
+    if (last != '\n')
+    {
+        ++outline;
+        putc('\n', out);
+    }
+    if (!lflag)
+        fprintf(out, line_format, ++outline + 1, code_file_name_disp);
+}
+
+
+void copy_file(FILE **file, char_os *file_name)
+{
+  register int c, last;
+  register FILE *out = code_file;
+  int state = 0;
+
+  fclose(*file);
+    *file = fopen_os(file_name, T("r"));
+    if (*file == NULL)
+        open_error(file_name);
+
+    last = '\n';
+
+    while ((c = getc(*file)) != EOF)
+    {
+      switch (c){
+      case '\n': state = 1; break;
+      case '#': state = (state == 1) ? 2 : 0; break;
+      case ' ': state = (state == 2) ? 3 : 0; break;
+      case '0':
+        if (state == 3){
+          fprintf (out, "%d \"%s", outline+2, code_file_name_disp);
+          c = '"';
+        }
+        state = 0;
+        break;
+      default: state = 0; break;
+      }
+      if (c == '\n') ++outline;
+      putc(c, out);
+      last = c;
+    }
+
+    if (last != '\n')
+    {
+        ++outline;
+        putc('\n', out);
+    }
+
+}
+
+void output_semantic_actions(void)
+{
+  copy_file (&action_file, action_file_name);
+}
+
+void output_entries(void)
+{
+  copy_file (&entry_file, entry_file_name);
+}
+
+void free_itemsets(void)
+{
+    register core *cp, *next;
+
+    FREE(state_table);
+    for (cp = first_state; cp; cp = next)
+    {
+        next = cp->next;
+        FREE(cp);
+    }
+}
+
+
+void free_shifts(void)
+{
+    register shifts *sp, *next;
+
+    FREE(shift_table);
+    for (sp = first_shift; sp; sp = next)
+    {
+        next = sp->next;
+        FREE(sp);
+    }
+}
+
+
+
+void free_reductions(void)
+{
+    register reductions *rp, *next;
+
+    FREE(reduction_table);
+    for (rp = first_reduction; rp; rp = next)
+    {
+        next = rp->next;
+        FREE(rp);
+    }
+}
diff --git a/yacc/reader.c b/yacc/reader.c
new file mode 100644
index 00000000..73779679
--- /dev/null
+++ b/yacc/reader.c
@@ -0,0 +1,1859 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Based on public-domain code from Berkeley Yacc */
+
+#include 
+#include "defs.h"
+
+/*  The line size must be a positive integer.  One hundred was chosen      */
+/*  because few lines in Yacc input grammars exceed 100 characters.        */
+/*  Note that if a line exceeds LINESIZE characters, the line buffer       */
+/*  will be expanded to accommodate it.                                     */
+
+#define LINESIZE 100
+
+char *cache;
+int cinc, cache_size;
+
+int ntags, tagmax;
+char **tag_table;
+
+char saw_eof;
+char *cptr, *line;
+int linesize;
+
+bucket *goal;
+int prec;
+int gensym;
+char last_was_action;
+
+int maxitems;
+bucket **pitem;
+
+int maxrules;
+bucket **plhs;
+
+int name_pool_size;
+char *name_pool;
+
+static unsigned char caml_ident_start[32] =
+"\000\000\000\000\000\000\000\000\376\377\377\207\376\377\377\007\000\000\000\000\000\000\000\000\377\377\177\377\377\377\177\377";
+static unsigned char caml_ident_body[32] =
+"\000\000\000\000\200\000\377\003\376\377\377\207\376\377\377\007\000\000\000\000\000\000\000\000\377\377\177\377\377\377\177\377";
+
+#define In_bitmap(bm,c) (bm[(unsigned char)(c) >> 3] & (1 << ((c) & 7)))
+
+void start_rule (register bucket *bp, int s_lineno);
+
+static char *buffer;
+static size_t length;
+static size_t capacity;
+static void push_stack(char x) {
+    if (length - 1 >= capacity) {
+        buffer = realloc(buffer, capacity = 3*length/2 + 100);
+        if (!buffer) no_space();
+    }
+    buffer[++length] = x;
+    buffer[0] = '\1';
+}
+
+static void pop_stack(char x) {
+    if (!buffer || buffer[length--] != x) {
+        switch (x) {
+            case '{': x = '}'; break;
+            case '(': x = ')'; break;
+            default: break;
+        }
+        fprintf(stderr, "Mismatched parentheses or braces: '%c'\n", x);
+                syntax_error(lineno, line, cptr - 1);
+   }
+}
+
+void cachec(int c)
+{
+    assert(cinc >= 0);
+    if (cinc >= cache_size)
+    {
+        cache_size += 256;
+        cache = REALLOC(cache, cache_size);
+        if (cache == 0) no_space();
+    }
+    cache[cinc] = c;
+    ++cinc;
+}
+
+
+void get_line(void)
+{
+    register FILE *f = input_file;
+    register int c;
+    register int i;
+
+    if (saw_eof || (c = getc(f)) == EOF)
+    {
+        if (line) { FREE(line); line = 0; }
+        cptr = 0;
+        saw_eof = 1;
+        return;
+    }
+
+    if (line == 0 || linesize != (LINESIZE + 1))
+    {
+        if (line) FREE(line);
+        linesize = LINESIZE + 1;
+        line = MALLOC(linesize);
+        if (line == 0) no_space();
+    }
+
+    i = 0;
+    ++lineno;
+    for (;;)
+    {
+        line[i]  =  c;
+        if (++i >= linesize)
+        {
+            linesize += LINESIZE;
+            line = REALLOC(line, linesize);
+            if (line ==  0) no_space();
+        }
+        if (c == '\n') {
+          if (i >= 2 && line[i-2] == '\r') {
+            line[i-2] = '\n'; i--;
+          }
+          line[i] = '\0'; cptr = line; return;
+        }
+        c = getc(f);
+        if (c ==  EOF) { saw_eof = 1; c = '\n'; }
+    }
+}
+
+
+char *
+dup_line(void)
+{
+    register char *p, *s, *t;
+
+    if (line == 0) return (0);
+    s = line;
+    while (*s != '\n') ++s;
+    p = MALLOC(s - line + 1);
+    if (p == 0) no_space();
+
+    s = line;
+    t = p;
+    while ((*t++ = *s++) != '\n') continue;
+    return (p);
+}
+
+
+void skip_comment(void)
+{
+    register char *s;
+
+    int st_lineno = lineno;
+    char *st_line = dup_line();
+    char *st_cptr = st_line + (cptr - line);
+
+    s = cptr + 2;
+    for (;;)
+    {
+        if (*s == '*' && s[1] == '/')
+        {
+            cptr = s + 2;
+            FREE(st_line);
+            return;
+        }
+        if (*s == '\n')
+        {
+            get_line();
+            if (line == 0)
+                unterminated_comment(st_lineno, st_line, st_cptr);
+            s = cptr;
+        }
+        else
+            ++s;
+    }
+}
+
+static void process_quoted_string(char c, FILE *const f)
+{
+    int s_lineno = lineno;
+    char *s_line = dup_line();
+    char *s_cptr = s_line + (cptr - line - 1);
+
+    char quote = c;
+    for (;;)
+    {
+        c = *cptr++;
+        putc(c, f);
+        if (c == quote)
+        {
+            FREE(s_line);
+            return;
+        }
+        if (c == '\n')
+            unterminated_string(s_lineno, s_line, s_cptr);
+        if (c == '\\')
+        {
+            c = *cptr++;
+            putc(c, f);
+            if (c == '\n')
+            {
+                get_line();
+                if (line == 0)
+                    unterminated_string(s_lineno, s_line, s_cptr);
+            }
+        }
+    }
+}
+
+int process_apostrophe(FILE *const f)
+{
+    if (cptr[0] != 0 && cptr[0] != '\\' && cptr[1] == '\'') {
+        fwrite(cptr, 1, 2, f);
+        cptr += 2;
+    } else if (cptr[0] == '\\'
+            && (isdigit((unsigned char) cptr[1]) || cptr[1] == 'x')
+            && isdigit((unsigned char) cptr[2])
+            && isdigit((unsigned char) cptr[3])
+            && cptr[4] == '\'') {
+        fwrite(cptr, 1, 5, f);
+        cptr += 5;
+    } else if (cptr[0] == '\\'
+            && cptr[1] == 'o'
+            && cptr[2] >= '0' && cptr[2] <= '3'
+            && cptr[3] >= '0' && cptr[3] <= '7'
+            && cptr[4] >= '0' && cptr[4] <= '7'
+            && cptr[5] == '\'') {
+        fwrite(cptr, 1, 6, f);
+        cptr += 6;
+    } else if (cptr[0] == '\\' && cptr[2] == '\'') {
+        fwrite(cptr, 1, 3, f);
+        cptr += 3;
+    } else {
+        return 0;
+    }
+    return 1;
+}
+
+void process_apostrophe_body(FILE *f)
+{
+    if (!process_apostrophe(f)) {
+        while (In_bitmap(caml_ident_body, *cptr)) {
+           putc(*cptr, f);
+           cptr++;
+        }
+    }
+}
+
+
+static void process_open_curly_bracket(FILE *f) {
+    char *idcptr = cptr;
+
+    if (*idcptr == '%') {
+        if (*++idcptr == '%') idcptr++;
+
+        if (In_bitmap(caml_ident_start, *idcptr)) {
+            idcptr++;
+            while (In_bitmap(caml_ident_body, *idcptr)) idcptr++;
+            while (*idcptr == '.') {
+                idcptr++;
+                if (In_bitmap(caml_ident_start, *idcptr)) {
+                    idcptr++;
+                    while (In_bitmap(caml_ident_body, *idcptr)) idcptr++;
+                }
+            }
+            while (*idcptr == ' ' || *idcptr == 9 || *idcptr == 12) idcptr++;
+        } else {
+           return;
+        }
+    }
+
+    if (In_bitmap(caml_ident_start, *idcptr) || *idcptr == '|')
+    {
+        char *newcptr = idcptr;
+        size_t size = 0;
+        char *buf;
+        while(In_bitmap(caml_ident_body, *newcptr)) { newcptr++; }
+        if (*newcptr == '|')
+        { /* Raw string */
+            int s_lineno;
+            char *s_line;
+            char *s_cptr;
+
+            size = newcptr - idcptr;
+            buf = MALLOC(size + 2);
+            if (!buf) no_space();
+            memcpy(buf, idcptr, size);
+            buf[size] = '}';
+            buf[size + 1] = '\0';
+            fwrite(cptr, 1, newcptr - cptr + 1, f);
+            cptr = newcptr + 1;
+            s_lineno = lineno;
+            s_line = dup_line();
+            s_cptr = s_line + (cptr - line - 1);
+
+            for (;;)
+            {
+                char c = *cptr++;
+                putc(c, f);
+                if (c == '|')
+                {
+                    int match = 1;
+                    size_t i;
+                    for (i = 0; i <= size; ++i) {
+                        if (cptr[i] != buf[i]) {
+                            newcptr--;
+                            match = 0;
+                            break;
+                        }
+                    }
+                    if (match) {
+                        FREE(s_line);
+                        FREE(buf);
+                        fwrite(cptr, 1, size, f);
+                        cptr += size;
+                        return;
+                    }
+                }
+                if (c == '\n')
+                {
+                    get_line();
+                    if (line == 0)
+                        unterminated_string(s_lineno, s_line, s_cptr);
+                }
+            }
+            FREE(buf);
+            return;
+        }
+    }
+    return;
+}
+
+static void process_comment(FILE *const f) {
+    char c = *cptr;
+    unsigned depth = 1;
+    if (c == '*')
+    {
+        int c_lineno = lineno;
+        char *c_line = dup_line();
+        char *c_cptr = c_line + (cptr - line - 1);
+
+        putc('*', f);
+        ++cptr;
+        for (;;)
+        {
+            c = *cptr++;
+            putc(c, f);
+
+            switch (c)
+            {
+            case '*':
+                if (*cptr == ')')
+                {
+                    depth--;
+                    if (depth == 0) {
+                        FREE(c_line);
+                        return;
+                    }
+                }
+                continue;
+            case '\n':
+                get_line();
+                if (line == 0)
+                    unterminated_comment(c_lineno, c_line, c_cptr);
+                continue;
+            case '(':
+                if (*cptr == '*') ++depth;
+                continue;
+            case '\'':
+                process_apostrophe(f);
+                continue;
+            case '"':
+                process_quoted_string(c, f);
+                continue;
+            case '{':
+                process_open_curly_bracket(f);
+                continue;
+            default:
+                if (In_bitmap(caml_ident_start, c)) {
+                  while (In_bitmap(caml_ident_body, *cptr)) putc(*cptr++, f);
+                }
+                continue;
+            }
+        }
+    }
+}
+
+char *substring (char *str, int start, int len)
+{
+  int i;
+  char *buf = MALLOC (len+1);
+  if (buf == NULL) return NULL;
+  for (i = 0; i < len; i++){
+    buf[i] = str[start+i];
+  }
+  buf[i] = '\0';      /* PR#4796 */
+  return buf;
+}
+
+void parse_line_directive (void)
+{
+  int i = 0, j = 0;
+  int line_number = 0;
+  char *file_name = NULL;
+
+ again:
+  if (line == 0) return;
+  if (line[i] != '#') return;
+  ++ i;
+  while (line[i] == ' ' || line[i] == '\t') ++ i;
+  if (line[i] < '0' || line[i] > '9') return;
+  while (line[i] >= '0' && line[i] <= '9'){
+    line_number = line_number * 10 + line[i] - '0';
+    ++ i;
+  }
+  while (line[i] == ' ' || line[i] == '\t') ++ i;
+  if (line[i] == '"'){
+    ++ i;
+    j = i;
+    while (line[j] != '"' && line[j] != '\0') ++j;
+    if (line[j] == '"'){
+      file_name = substring (line, i, j - i);
+      if (file_name == NULL) no_space ();
+    }
+  }
+  lineno = line_number - 1;
+  if (file_name != NULL){
+    if (virtual_input_file_name != NULL) FREE (virtual_input_file_name);
+    virtual_input_file_name = file_name;
+  }
+  get_line ();
+  goto again;
+}
+
+int
+nextc(void)
+{
+    register char *s;
+
+    if (line == 0)
+    {
+        get_line();
+        parse_line_directive ();
+        if (line == 0)
+            return (EOF);
+    }
+
+    s = cptr;
+    for (;;)
+    {
+        switch (*s)
+        {
+        case '\n':
+            get_line();
+            parse_line_directive ();
+            if (line == 0) return (EOF);
+            s = cptr;
+            break;
+
+        case ' ':
+        case '\t':
+        case '\f':
+        case '\r':
+        case '\v':
+        case ',':
+        case ';':
+            ++s;
+            break;
+
+        case '\\':
+            cptr = s;
+            return ('%');
+
+        case '/':
+            if (s[1] == '*')
+            {
+                cptr = s;
+                skip_comment();
+                s = cptr;
+                break;
+            }
+            else if (s[1] == '/')
+            {
+                get_line();
+                parse_line_directive ();
+                if (line == 0) return (EOF);
+                s = cptr;
+                break;
+            }
+            /* fall through */
+
+        default:
+            cptr = s;
+            return (*s);
+        }
+    }
+}
+
+
+int
+keyword(void)
+{
+    register int c;
+    char *t_cptr = cptr;
+
+    c = *++cptr;
+    if (isalpha(c))
+    {
+        cinc = 0;
+        for (;;)
+        {
+            if (isalpha(c))
+            {
+                if (isupper(c)) c = tolower(c);
+                cachec(c);
+            }
+            else if (isdigit(c) || c == '_' || c == '.' || c == '$')
+                cachec(c);
+            else
+                break;
+            c = *++cptr;
+        }
+        cachec(NUL);
+
+        if (strcmp(cache, "token") == 0 || strcmp(cache, "term") == 0)
+            return (TOKEN);
+        if (strcmp(cache, "type") == 0)
+            return (TYPE);
+        if (strcmp(cache, "left") == 0)
+            return (LEFT);
+        if (strcmp(cache, "right") == 0)
+            return (RIGHT);
+        if (strcmp(cache, "nonassoc") == 0 || strcmp(cache, "binary") == 0)
+            return (NONASSOC);
+        if (strcmp(cache, "start") == 0)
+            return (START);
+    }
+    else
+    {
+        ++cptr;
+        if (c == '{')
+            return (TEXT);
+        if (c == '%' || c == '\\')
+            return (MARK);
+        if (c == '<')
+            return (LEFT);
+        if (c == '>')
+            return (RIGHT);
+        if (c == '0')
+            return (TOKEN);
+        if (c == '2')
+            return (NONASSOC);
+    }
+    syntax_error(lineno, line, t_cptr);
+    /*NOTREACHED*/
+    return 0;
+}
+
+void copy_text(void)
+{
+    register int c;
+    register FILE *f = text_file;
+    int need_newline = 0;
+    int t_lineno = lineno;
+    char *t_line = dup_line();
+    char *t_cptr = t_line + (cptr - line - 2);
+
+    if (*cptr == '\n')
+    {
+        get_line();
+        if (line == 0)
+            unterminated_text(t_lineno, t_line, t_cptr);
+    }
+    fprintf(f, line_format, lineno, input_file_name_disp);
+
+loop:
+    c = *cptr++;
+    switch (c)
+    {
+    case '\n':
+        putc('\n', f);
+        need_newline = 0;
+        get_line();
+        if (line) goto loop;
+        unterminated_text(t_lineno, t_line, t_cptr);
+
+    case '"':
+        putc(c, f);
+        process_quoted_string(c, f);
+        goto loop;
+
+    case '\'':
+        putc(c, f);
+        process_apostrophe_body(f);
+        goto loop;
+
+    case '(':
+        putc(c, f);
+        need_newline = 1;
+        process_comment(f);
+        goto loop;
+
+    case '%':
+    case '\\':
+        if (*cptr == '}')
+        {
+            if (need_newline) putc('\n', f);
+            ++cptr;
+            FREE(t_line);
+            return;
+        }
+        /* fall through */
+
+    case '{':
+        putc(c, f);
+        process_open_curly_bracket(f);
+        goto loop;
+    default:
+        putc(c, f);
+        if (In_bitmap(caml_ident_start, c)) {
+          while (In_bitmap(caml_ident_body, *cptr)) {
+            putc(*cptr, f);
+            cptr++;
+          }
+        }
+        need_newline = 1;
+        goto loop;
+    }
+}
+
+int
+hexval(int c)
+{
+    if (c >= '0' && c <= '9')
+        return (c - '0');
+    if (c >= 'A' && c <= 'F')
+        return (c - 'A' + 10);
+    if (c >= 'a' && c <= 'f')
+        return (c - 'a' + 10);
+    return (-1);
+}
+
+
+bucket *
+get_literal(void)
+{
+    register int c, quote;
+    register int i;
+    register int n;
+    register char *s;
+    register bucket *bp;
+    int s_lineno = lineno;
+    char *s_line = dup_line();
+    char *s_cptr = s_line + (cptr - line);
+
+    quote = *cptr++;
+    cinc = 0;
+    for (;;)
+    {
+        c = *cptr++;
+        if (c == quote) break;
+        if (c == '\n') unterminated_string(s_lineno, s_line, s_cptr);
+        if (c == '\\')
+        {
+            char *c_cptr = cptr - 1;
+
+            c = *cptr++;
+            switch (c)
+            {
+            case '\n':
+                get_line();
+                if (line == 0) unterminated_string(s_lineno, s_line, s_cptr);
+                continue;
+
+            case '0': case '1': case '2': case '3':
+            case '4': case '5': case '6': case '7':
+                n = c - '0';
+                c = *cptr;
+                if (IS_OCTAL(c))
+                {
+                    n = (n << 3) + (c - '0');
+                    c = *++cptr;
+                    if (IS_OCTAL(c))
+                    {
+                        n = (n << 3) + (c - '0');
+                        ++cptr;
+                    }
+                }
+                if (n > MAXCHAR) illegal_character(c_cptr);
+                c = n;
+                    break;
+
+            case 'x':
+                c = *cptr++;
+                n = hexval(c);
+                if (n < 0 || n >= 16)
+                    illegal_character(c_cptr);
+                for (;;)
+                {
+                    c = *cptr;
+                    i = hexval(c);
+                    if (i < 0 || i >= 16) break;
+                    ++cptr;
+                    n = (n << 4) + i;
+                    if (n > MAXCHAR) illegal_character(c_cptr);
+                }
+                c = n;
+                break;
+
+            case 'a': c = 7; break;
+            case 'b': c = '\b'; break;
+            case 'f': c = '\f'; break;
+            case 'n': c = '\n'; break;
+            case 'r': c = '\r'; break;
+            case 't': c = '\t'; break;
+            case 'v': c = '\v'; break;
+            }
+        }
+        cachec(c);
+    }
+    FREE(s_line);
+
+    n = cinc;
+    s = MALLOC(n);
+    if (s == 0) no_space();
+
+    for (i = 0; i < n; ++i)
+        s[i] = cache[i];
+
+    cinc = 0;
+    if (n == 1)
+        cachec('\'');
+    else
+        cachec('"');
+
+    for (i = 0; i < n; ++i)
+    {
+        c = ((unsigned char *)s)[i];
+        if (c == '\\' || c == cache[0])
+        {
+            cachec('\\');
+            cachec(c);
+        }
+        else if (isprint(c))
+            cachec(c);
+        else
+        {
+            cachec('\\');
+            switch (c)
+            {
+            case 7: cachec('a'); break;
+            case '\b': cachec('b'); break;
+            case '\f': cachec('f'); break;
+            case '\n': cachec('n'); break;
+            case '\r': cachec('r'); break;
+            case '\t': cachec('t'); break;
+            case '\v': cachec('v'); break;
+            default:
+                cachec(((c >> 6) & 7) + '0');
+                cachec(((c >> 3) & 7) + '0');
+                cachec((c & 7) + '0');
+                break;
+            }
+        }
+    }
+
+    if (n == 1)
+        cachec('\'');
+    else
+        cachec('"');
+
+    cachec(NUL);
+    bp = lookup(cache);
+    bp->class = TERM;
+    if (n == 1 && bp->value == UNDEFINED)
+        bp->value = *(unsigned char *)s;
+    FREE(s);
+
+    return (bp);
+}
+
+
+int
+is_reserved(char *name)
+{
+    char *s;
+
+    if (strcmp(name, ".") == 0 ||
+            strcmp(name, "$accept") == 0 ||
+            strcmp(name, "$end") == 0)
+        return (1);
+
+    if (name[0] == '$' && name[1] == '$' && isdigit((unsigned char) name[2]))
+    {
+        s = name + 3;
+        while (isdigit((unsigned char) *s)) ++s;
+        if (*s == NUL) return (1);
+    }
+
+    return (0);
+}
+
+
+bucket *
+get_name(void)
+{
+    register int c;
+
+    cinc = 0;
+    for (c = *cptr; IS_IDENT(c); c = *++cptr)
+        cachec(c);
+    cachec(NUL);
+
+    if (is_reserved(cache)) used_reserved(cache);
+
+    return (lookup(cache));
+}
+
+
+int
+get_number(void)
+{
+    register int c;
+    register int n;
+
+    n = 0;
+    for (c = *cptr; isdigit(c); c = *++cptr)
+        n = 10*n + (c - '0');
+
+    return (n);
+}
+
+
+char *
+get_tag(void)
+{
+    register int c;
+    register int i;
+    register char *s;
+    char *t_line = dup_line();
+    long bracket_depth;
+
+    cinc = 0;
+    bracket_depth = 0;
+    while (1) {
+      c = *++cptr;
+      if (c == EOF) unexpected_EOF();
+      if (c == '\n') syntax_error(lineno, line, cptr);
+      if (c == '>' && 0 == bracket_depth && cptr[-1] != '-') break;
+      if (c == '[') ++ bracket_depth;
+      if (c == ']') -- bracket_depth;
+      cachec(c);
+    }
+    ++cptr;
+    cachec(NUL);
+
+    for (i = 0; i < ntags; ++i)
+    {
+        if (strcmp(cache, tag_table[i]) == 0)
+            return (tag_table[i]);
+    }
+
+    if (ntags >= tagmax)
+    {
+        tagmax += 16;
+        tag_table = (char **)
+                        (tag_table ? REALLOC(tag_table, tagmax*sizeof(char *))
+                                   : MALLOC(tagmax*sizeof(char *)));
+        if (tag_table == 0) no_space();
+    }
+
+    s = MALLOC(cinc);
+    if  (s == 0) no_space();
+    strcpy(s, cache);
+    tag_table[ntags] = s;
+    ++ntags;
+    FREE(t_line);
+    return (s);
+}
+
+
+void declare_tokens(int assoc)
+{
+    register int c;
+    register bucket *bp;
+    char *tag = 0;
+
+    if (assoc != TOKEN) ++prec;
+
+    c = nextc();
+    if (c == EOF) unexpected_EOF();
+    if (c == '<')
+    {
+        tag = get_tag();
+        c = nextc();
+        if (c == EOF) unexpected_EOF();
+    }
+
+    for (;;)
+    {
+        if (isalpha(c) || c == '_' || c == '.' || c == '$')
+            bp = get_name();
+        else if (c == '\'' || c == '"')
+            bp = get_literal();
+        else
+            return;
+
+        if (bp == goal) tokenized_start(bp->name);
+        bp->class = TERM;
+
+        if (tag)
+        {
+            if (bp->tag && tag != bp->tag)
+                retyped_warning(bp->name);
+            bp->tag = tag;
+        }
+
+        if (assoc == TOKEN)
+        {
+            bp->true_token = 1;
+        }
+        else
+        {
+            if (bp->prec && prec != bp->prec)
+                reprec_warning(bp->name);
+            bp->assoc = assoc;
+            bp->prec = prec;
+        }
+
+        if (strcmp(bp->name, "EOF") == 0)
+            bp->value = 0;
+
+        c = nextc();
+        if (c == EOF) unexpected_EOF();
+        if (isdigit(c))
+        {
+            int value = get_number();
+            if (bp->value != UNDEFINED && value != bp->value)
+                revalued_warning(bp->name);
+            bp->value = value;
+            c = nextc();
+            if (c == EOF) unexpected_EOF();
+        }
+    }
+}
+
+
+void declare_types(void)
+{
+    register int c;
+    register bucket *bp;
+    char *tag;
+
+    c = nextc();
+    if (c == EOF) unexpected_EOF();
+    if (c != '<') syntax_error(lineno, line, cptr);
+    tag = get_tag();
+
+    for (;;)
+    {
+        c = nextc();
+        if (isalpha(c) || c == '_' || c == '.' || c == '$')
+            bp = get_name();
+        else if (c == '\'' || c == '"')
+            bp = get_literal();
+        else
+            return;
+
+        if (bp->tag && tag != bp->tag)
+            retyped_warning(bp->name);
+        bp->tag = tag;
+    }
+}
+
+
+void declare_start(void)
+{
+    register int c;
+    register bucket *bp;
+    static int entry_counter = 0;
+
+    for (;;) {
+      c = nextc();
+      if (!isalpha(c) && c != '_' && c != '.' && c != '$') return;
+      bp = get_name();
+
+      if (bp->class == TERM)
+        terminal_start(bp->name);
+      if (entry_counter >= MAX_ENTRY_POINT)
+        too_many_entries();
+      bp->entry = ++entry_counter;
+    }
+}
+
+
+void read_declarations(void)
+{
+    register int c, k;
+
+    cache_size = 256;
+    cache = MALLOC(cache_size);
+    if (cache == 0) no_space();
+
+    for (;;)
+    {
+        c = nextc();
+        if (c == EOF) unexpected_EOF();
+        if (c != '%') syntax_error(lineno, line, cptr);
+        switch (k = keyword())
+        {
+        case MARK:
+            return;
+
+        case TEXT:
+            copy_text();
+            break;
+
+        case TOKEN:
+        case LEFT:
+        case RIGHT:
+        case NONASSOC:
+            declare_tokens(k);
+            break;
+
+        case TYPE:
+            declare_types();
+            break;
+
+        case START:
+            declare_start();
+            break;
+        }
+    }
+}
+
+void output_token_type(void)
+{
+  bucket * bp;
+  int n;
+
+  fprintf(interface_file, "type token =\n");
+  if (!rflag) ++outline;
+  fprintf(output_file, "type token =\n");
+  n = 0;
+  for (bp = first_symbol; bp; bp = bp->next) {
+    if (bp->class == TERM && bp->true_token) {
+      fprintf(interface_file, "  | %s", bp->name);
+      fprintf(output_file, "  | %s", bp->name);
+      if (bp->tag) {
+        /* Print the type expression in parentheses to make sure
+           that the constructor is unary */
+        fprintf(interface_file, " of (%s)", bp->tag);
+        fprintf(output_file, " of (%s)", bp->tag);
+      }
+      fprintf(interface_file, "\n");
+      if (!rflag) ++outline;
+      fprintf(output_file, "\n");
+      n++;
+    }
+  }
+  fprintf(interface_file, "\n");
+  if (!rflag) ++outline;
+  fprintf(output_file, "\n");
+}
+
+void initialize_grammar(void)
+{
+    nitems = 4;
+    maxitems = 300;
+    pitem = (bucket **) MALLOC(maxitems*sizeof(bucket *));
+    if (pitem == 0) no_space();
+    pitem[0] = 0;
+    pitem[1] = 0;
+    pitem[2] = 0;
+    pitem[3] = 0;
+
+    nrules = 3;
+    maxrules = 100;
+    plhs = (bucket **) MALLOC(maxrules*sizeof(bucket *));
+    if (plhs == 0) no_space();
+    plhs[0] = 0;
+    plhs[1] = 0;
+    plhs[2] = 0;
+    rprec = (short *) MALLOC(maxrules*sizeof(short));
+    if (rprec == 0) no_space();
+    rprec[0] = 0;
+    rprec[1] = 0;
+    rprec[2] = 0;
+    rassoc = (char *) MALLOC(maxrules*sizeof(char));
+    if (rassoc == 0) no_space();
+    rassoc[0] = TOKEN;
+    rassoc[1] = TOKEN;
+    rassoc[2] = TOKEN;
+}
+
+
+void expand_items(void)
+{
+    maxitems += 300;
+    pitem = (bucket **) REALLOC(pitem, maxitems*sizeof(bucket *));
+    if (pitem == 0) no_space();
+}
+
+
+void expand_rules(void)
+{
+    maxrules += 100;
+    plhs = (bucket **) REALLOC(plhs, maxrules*sizeof(bucket *));
+    if (plhs == 0) no_space();
+    rprec = (short *) REALLOC(rprec, maxrules*sizeof(short));
+    if (rprec == 0) no_space();
+    rassoc = (char *) REALLOC(rassoc, maxrules*sizeof(char));
+    if (rassoc == 0) no_space();
+}
+
+
+void advance_to_start(void)
+{
+    register int c;
+    register bucket *bp;
+    char *s_cptr;
+    int s_lineno;
+
+    for (;;)
+    {
+        c = nextc();
+        if (c != '%') break;
+        s_cptr = cptr;
+        switch (keyword())
+        {
+        case MARK:
+            no_grammar();
+
+        case TEXT:
+            copy_text();
+            break;
+
+        case START:
+            declare_start();
+            break;
+
+        default:
+            syntax_error(lineno, line, s_cptr);
+        }
+    }
+
+    c = nextc();
+    if (!isalpha(c) && c != '_' && c != '.' && c != '_')
+        syntax_error(lineno, line, cptr);
+    bp = get_name();
+    if (goal == 0)
+    {
+        if (bp->class == TERM)
+            terminal_start(bp->name);
+        goal = bp;
+    }
+
+    s_lineno = lineno;
+    c = nextc();
+    if (c == EOF) unexpected_EOF();
+    if (c != ':') syntax_error(lineno, line, cptr);
+    start_rule(bp, s_lineno);
+    ++cptr;
+}
+
+
+int at_first;
+
+void start_rule(register bucket *bp, int s_lineno)
+{
+    if (bp->class == TERM)
+        terminal_lhs(s_lineno);
+    bp->class = NONTERM;
+    if (nrules >= maxrules)
+        expand_rules();
+    plhs[nrules] = bp;
+    rprec[nrules] = UNDEFINED;
+    rassoc[nrules] = TOKEN;
+    at_first = 1;
+}
+
+
+void end_rule(void)
+{
+    if (!last_was_action) default_action_error();
+
+    last_was_action = 0;
+    if (nitems >= maxitems) expand_items();
+    pitem[nitems] = 0;
+    ++nitems;
+    ++nrules;
+}
+
+
+void insert_empty_rule(void)
+{
+    register bucket *bp, **bpp;
+
+    assert(cache);
+    sprintf(cache, "$$%d", ++gensym);
+    bp = make_bucket(cache);
+    last_symbol->next = bp;
+    last_symbol = bp;
+    bp->tag = plhs[nrules]->tag;
+    bp->class = NONTERM;
+
+    if ((nitems += 2) > maxitems)
+        expand_items();
+    bpp = pitem + nitems - 1;
+    *bpp-- = bp;
+    while ((bpp[0] = bpp[-1])) --bpp;
+
+    if (++nrules >= maxrules)
+        expand_rules();
+    plhs[nrules] = plhs[nrules-1];
+    plhs[nrules-1] = bp;
+    rprec[nrules] = rprec[nrules-1];
+    rprec[nrules-1] = 0;
+    rassoc[nrules] = rassoc[nrules-1];
+    rassoc[nrules-1] = TOKEN;
+}
+
+
+void add_symbol(void)
+{
+    register int c;
+    register bucket *bp;
+    int s_lineno = lineno;
+    char *ecptr = cptr;
+
+    c = *cptr;
+    if (c == '\'' || c == '"')
+        bp = get_literal();
+    else
+        bp = get_name();
+
+    c = nextc();
+    if (c == ':')
+    {
+        end_rule();
+        start_rule(bp, s_lineno);
+        ++cptr;
+        return;
+    }
+
+    if (last_was_action) syntax_error (lineno, line, ecptr);
+    last_was_action = 0;
+
+    if (++nitems > maxitems)
+        expand_items();
+    pitem[nitems-1] = bp;
+}
+
+
+void copy_action(void)
+{
+    register int c;
+    register int i, n;
+    int depth;
+    bucket *item;
+    char *tagres;
+    register FILE *f = action_file;
+    int a_lineno = lineno;
+    char *a_line = dup_line();
+    char *a_cptr = a_line + (cptr - line);
+
+    push_stack('{');
+    if (last_was_action) syntax_error (lineno, line, cptr);
+    last_was_action = 1;
+
+    /*
+      fprintf(f, "(* Rule %d, file %s, line %d *)\n",
+            nrules-2, input_file_name, lineno);
+            */
+    if (sflag)
+      fprintf(f, "yyact.(%d) <- (fun __caml_parser_env ->\n", nrules-2);
+    else
+      fprintf(f, "; (fun __caml_parser_env ->\n");
+
+    n = 0;
+    for (i = nitems - 1; pitem[i]; --i) ++n;
+
+    for (i = 1; i <= n; i++) {
+      item = pitem[nitems + i - n - 1];
+      if (item->class == TERM && !item->tag) continue;
+      fprintf(f, "    let _%d = ", i);
+      if (item->tag)
+        fprintf(f, "(Parsing.peek_val __caml_parser_env %d : %s) in\n", n - i,
+                item->tag);
+      else if (sflag)
+        fprintf(f, "Parsing.peek_val __caml_parser_env %d in\n", n - i);
+      else
+        fprintf(f, "(Parsing.peek_val __caml_parser_env %d : '%s) in\n", n - i,
+                item->name);
+    }
+    fprintf(f, "    Obj.repr(\n");
+    fprintf(f, line_format, lineno, input_file_name_disp);
+    for (i = 0; i < cptr - line; i++) fputc(' ', f);
+    fputc ('(', f);
+
+    depth = 1;
+    cptr++;
+
+loop:
+    c = *cptr;
+    if (c == '$')
+    {
+        if (isdigit((unsigned char) cptr[1]))
+        {
+            ++cptr;
+            i = get_number();
+
+            if (i <= 0 || i > n)
+              unknown_rhs(i);
+            item = pitem[nitems + i - n - 1];
+            if (item->class == TERM && !item->tag)
+              illegal_token_ref(i, item->name);
+            fprintf(f, "_%d", i);
+            goto loop;
+        }
+    }
+    if (c == '_' || c == '$' || In_bitmap(caml_ident_start, c))
+    {
+        do
+        {
+            putc(c, f);
+            c = *++cptr;
+        } while (c == '_' || c == '$' || In_bitmap(caml_ident_body, c));
+        goto loop;
+    }
+    if (c == '}' && depth == 1) {
+      fprintf(f, ")\n# 0\n              ");
+      cptr++;
+      pop_stack('{');
+      tagres = plhs[nrules]->tag;
+      if (tagres)
+        fprintf(f, " : %s))\n", tagres);
+      else if (sflag)
+        fprintf(f, "))\n");
+      else
+        fprintf(f, " : '%s))\n", plhs[nrules]->name);
+      if (sflag)
+        fprintf(f, "\n");
+      FREE(a_line);
+      return;
+    }
+    putc(c, f);
+    ++cptr;
+    switch (c)
+    {
+    case '\n':
+        get_line();
+        if (line) goto loop;
+        unterminated_action(a_lineno, a_line, a_cptr);
+
+    case '{':
+        process_open_curly_bracket(f);
+        /* Even if there is a raw string, we deliberately keep the
+         * closing '}' in the buffer */
+        push_stack('{');
+        ++depth;
+        goto loop;
+
+    case '}':
+        --depth;
+        pop_stack('{');
+        goto loop;
+
+    case '"':
+        process_quoted_string('"', f);
+        goto loop;
+
+    case '\'':
+        process_apostrophe_body(f);
+        goto loop;
+
+    case '(':
+        push_stack('(');
+        process_comment(f);
+        goto loop;
+
+    case ')':
+        pop_stack('(');
+        goto loop;
+
+    default:
+        goto loop;
+    }
+}
+
+
+int
+mark_symbol(void)
+{
+    register int c;
+    register bucket *bp;
+
+    c = cptr[1];
+    if (c == '%' || c == '\\')
+    {
+        cptr += 2;
+        return (1);
+    }
+
+    if (c == '=')
+        cptr += 2;
+    else if ((c == 'p' || c == 'P') &&
+             ((c = cptr[2]) == 'r' || c == 'R') &&
+             ((c = cptr[3]) == 'e' || c == 'E') &&
+             ((c = cptr[4]) == 'c' || c == 'C') &&
+             ((c = cptr[5], !IS_IDENT(c))))
+        cptr += 5;
+    else
+        syntax_error(lineno, line, cptr);
+
+    c = nextc();
+    if (isalpha(c) || c == '_' || c == '.' || c == '$')
+        bp = get_name();
+    else if (c == '\'' || c == '"')
+        bp = get_literal();
+    else
+    {
+        syntax_error(lineno, line, cptr);
+        /*NOTREACHED*/
+    }
+
+    if (rprec[nrules] != UNDEFINED && bp->prec != rprec[nrules])
+        prec_redeclared();
+
+    rprec[nrules] = bp->prec;
+    rassoc[nrules] = bp->assoc;
+    return (0);
+}
+
+
+void read_grammar(void)
+{
+    register int c;
+
+    initialize_grammar();
+    advance_to_start();
+
+    for (;;)
+    {
+        c = nextc();
+        if (c == '|' && at_first){
+          ++cptr;
+          c = nextc();
+        }
+        at_first = 0;
+        if (c == EOF) break;
+        if (isalpha(c) || c == '_' || c == '.' || c == '$' || c == '\'' ||
+                c == '"')
+            add_symbol();
+        else if (c == '{' || c == '=')
+            copy_action();
+        else if (c == '|')
+        {
+            end_rule();
+            start_rule(plhs[nrules-1], 0);
+            ++cptr;
+        }
+        else if (c == '%')
+        {
+            if (mark_symbol()) break;
+        }
+        else
+            syntax_error(lineno, line, cptr);
+    }
+    end_rule();
+}
+
+
+void free_tags(void)
+{
+    register int i;
+
+    if (tag_table == 0) return;
+
+    for (i = 0; i < ntags; ++i)
+    {
+        assert(tag_table[i]);
+        FREE(tag_table[i]);
+    }
+    FREE(tag_table);
+}
+
+
+void pack_names(void)
+{
+    register bucket *bp;
+    register char *p, *s, *t;
+
+    name_pool_size = 13;  /* 13 == sizeof("$end") + sizeof("$accept") */
+    for (bp = first_symbol; bp; bp = bp->next)
+        name_pool_size += strlen(bp->name) + 1;
+    name_pool = MALLOC(name_pool_size);
+    if (name_pool == 0) no_space();
+
+    strcpy(name_pool, "$accept");
+    strcpy(name_pool+8, "$end");
+    t = name_pool + 13;
+    for (bp = first_symbol; bp; bp = bp->next)
+    {
+        p = t;
+        s = bp->name;
+        while ((*t++ = *s++)) continue;
+        FREE(bp->name);
+        bp->name = p;
+    }
+}
+
+
+void check_symbols(void)
+{
+    register bucket *bp;
+
+    if (goal->class == UNKNOWN)
+        undefined_goal(goal->name);
+
+    for (bp = first_symbol; bp; bp = bp->next)
+    {
+        if (bp->class == UNKNOWN)
+        {
+            undefined_symbol(bp->name);
+            bp->class = TERM;
+        }
+    }
+}
+
+
+void pack_symbols(void)
+{
+    register bucket *bp;
+    register bucket **v;
+    register int i, j, k, n;
+
+    nsyms = 2;
+    ntokens = 1;
+    for (bp = first_symbol; bp; bp = bp->next)
+    {
+        ++nsyms;
+        if (bp->class == TERM) ++ntokens;
+    }
+    start_symbol = ntokens;
+    nvars = nsyms - ntokens;
+
+    symbol_name = (char **) MALLOC(nsyms*sizeof(char *));
+    if (symbol_name == 0) no_space();
+    symbol_value = (short *) MALLOC(nsyms*sizeof(short));
+    if (symbol_value == 0) no_space();
+    symbol_prec = (short *) MALLOC(nsyms*sizeof(short));
+    if (symbol_prec == 0) no_space();
+    symbol_assoc = MALLOC(nsyms);
+    if (symbol_assoc == 0) no_space();
+    symbol_tag = (char **) MALLOC(nsyms*sizeof(char *));
+    if (symbol_tag == 0) no_space();
+    symbol_true_token = (char *) MALLOC(nsyms*sizeof(char));
+    if (symbol_true_token == 0) no_space();
+
+    v = (bucket **) MALLOC(nsyms*sizeof(bucket *));
+    if (v == 0) no_space();
+
+    v[0] = 0;
+    v[start_symbol] = 0;
+
+    i = 1;
+    j = start_symbol + 1;
+    for (bp = first_symbol; bp; bp = bp->next)
+    {
+        if (bp->class == TERM)
+            v[i++] = bp;
+        else
+            v[j++] = bp;
+    }
+    assert(i == ntokens && j == nsyms);
+
+    for (i = 1; i < ntokens; ++i)
+        v[i]->index = i;
+
+    goal->index = start_symbol + 1;
+    k = start_symbol + 2;
+    while (++i < nsyms)
+        if (v[i] != goal)
+        {
+            v[i]->index = k;
+            ++k;
+        }
+
+    goal->value = 0;
+    k = 1;
+    for (i = start_symbol + 1; i < nsyms; ++i)
+    {
+        if (v[i] != goal)
+        {
+            v[i]->value = k;
+            ++k;
+        }
+    }
+
+    k = 0;
+    for (i = 1; i < ntokens; ++i)
+    {
+        n = v[i]->value;
+        if (n > 256)
+        {
+            for (j = k++; j > 0 && symbol_value[j-1] > n; --j)
+                symbol_value[j] = symbol_value[j-1];
+            symbol_value[j] = n;
+        }
+    }
+
+    if (v[1]->value == UNDEFINED)
+        v[1]->value = 256;
+
+    j = 0;
+    n = 257;
+    for (i = 2; i < ntokens; ++i)
+    {
+        if (v[i]->value == UNDEFINED)
+        {
+            while (j < k && n == symbol_value[j])
+            {
+                while (++j < k && n == symbol_value[j]) continue;
+                ++n;
+            }
+            v[i]->value = n;
+            ++n;
+        }
+    }
+
+    symbol_name[0] = name_pool + 8;
+    symbol_value[0] = 0;
+    symbol_prec[0] = 0;
+    symbol_assoc[0] = TOKEN;
+    symbol_tag[0] = "";
+    symbol_true_token[0] = 0;
+    for (i = 1; i < ntokens; ++i)
+    {
+        symbol_name[i] = v[i]->name;
+        symbol_value[i] = v[i]->value;
+        symbol_prec[i] = v[i]->prec;
+        symbol_assoc[i] = v[i]->assoc;
+        symbol_tag[i] = v[i]->tag;
+        symbol_true_token[i] = v[i]->true_token;
+    }
+    symbol_name[start_symbol] = name_pool;
+    symbol_value[start_symbol] = -1;
+    symbol_prec[start_symbol] = 0;
+    symbol_assoc[start_symbol] = TOKEN;
+    symbol_tag[start_symbol] = "";
+    symbol_true_token[start_symbol] = 0;
+    for (++i; i < nsyms; ++i)
+    {
+        k = v[i]->index;
+        symbol_name[k] = v[i]->name;
+        symbol_value[k] = v[i]->value;
+        symbol_prec[k] = v[i]->prec;
+        symbol_assoc[k] = v[i]->assoc;
+        symbol_tag[i] = v[i]->tag;
+        symbol_true_token[i] = v[i]->true_token;
+    }
+
+    FREE(v);
+}
+
+static int is_polymorphic(char * s)
+{
+  while (*s != 0) {
+    char c = *s++;
+    if (c == '\'' || c == '#') return 1;
+    if (c == '[') {
+      c = *s;
+      while (c == ' ' || c == '\t' || c == '\r' || c == '\n') c = *++s;
+      if (c == '<' || c == '>') return 1;
+    }
+    if (In_bitmap(caml_ident_start, c)) {
+      while (In_bitmap(caml_ident_body, *s)) s++;
+    }
+  }
+  return 0;
+}
+
+void make_goal(void)
+{
+  static char name[7] = "'\\xxx'";
+  bucket * bp;
+  bucket * bc;
+
+  goal = lookup("%entry%");
+  ntotalrules = nrules - 2;
+  for(bp = first_symbol; bp != 0; bp = bp->next) {
+    if (bp->entry) {
+      start_rule(goal, 0);
+      if (nitems + 2> maxitems)
+        expand_items();
+      name[2] = '0' + ((bp->entry >> 6) & 7);
+      name[3] = '0' + ((bp->entry >> 3) & 7);
+      name[4] = '0' + (bp->entry & 7);
+      bc = lookup(name);
+      bc->class = TERM;
+      bc->value = (unsigned char) bp->entry;
+      pitem[nitems++] = bc;
+      pitem[nitems++] = bp;
+      if (bp->tag == NULL)
+        entry_without_type(bp->name);
+      if (is_polymorphic(bp->tag))
+        polymorphic_entry_point(bp->name);
+      fprintf(entry_file,
+              "let %s (lexfun : Lexing.lexbuf -> token) (lexbuf : Lexing.lexbuf) =\n   (Parsing.yyparse yytables %u lexfun lexbuf : %s)\n",
+              bp->name, bp->entry, bp->tag);
+      fprintf(interface_file,
+              "val %s :\n  (Lexing.lexbuf  -> token) -> Lexing.lexbuf -> %s\n",
+              bp->name,
+              bp->tag);
+      fprintf(action_file,
+              "(* Entry %s *)\n", bp->name);
+      if (sflag)
+        fprintf(action_file,
+                "yyact.(%d) <- (fun __caml_parser_env -> raise "
+                "(Parsing.YYexit (Parsing.peek_val __caml_parser_env 0)))\n",
+                ntotalrules);
+      else
+        fprintf(action_file,
+                "; (fun __caml_parser_env -> raise "
+                "(Parsing.YYexit (Parsing.peek_val __caml_parser_env 0)))\n");
+      ntotalrules++;
+      last_was_action = 1;
+      end_rule();
+    }
+  }
+}
+
+void pack_grammar(void)
+{
+    register int i, j;
+    int assoc, prec;
+
+    ritem = (short *) MALLOC(nitems*sizeof(short));
+    if (ritem == 0) no_space();
+    rlhs = (short *) MALLOC(nrules*sizeof(short));
+    if (rlhs == 0) no_space();
+    rrhs = (short *) MALLOC((nrules+1)*sizeof(short));
+    if (rrhs == 0) no_space();
+    rprec = (short *) REALLOC(rprec, nrules*sizeof(short));
+    if (rprec == 0) no_space();
+    rassoc = REALLOC(rassoc, nrules);
+    if (rassoc == 0) no_space();
+
+    ritem[0] = -1;
+    ritem[1] = goal->index;
+    ritem[2] = 0;
+    ritem[3] = -2;
+    rlhs[0] = 0;
+    rlhs[1] = 0;
+    rlhs[2] = start_symbol;
+    rrhs[0] = 0;
+    rrhs[1] = 0;
+    rrhs[2] = 1;
+
+    j = 4;
+    for (i = 3; i < nrules; ++i)
+    {
+        rlhs[i] = plhs[i]->index;
+        rrhs[i] = j;
+        assoc = TOKEN;
+        prec = 0;
+        while (pitem[j])
+        {
+            ritem[j] = pitem[j]->index;
+            if (pitem[j]->class == TERM)
+            {
+                prec = pitem[j]->prec;
+                assoc = pitem[j]->assoc;
+            }
+            ++j;
+        }
+        ritem[j] = -i;
+        ++j;
+        if (rprec[i] == UNDEFINED)
+        {
+            rprec[i] = prec;
+            rassoc[i] = assoc;
+        }
+    }
+    rrhs[i] = j;
+
+    FREE(plhs);
+    FREE(pitem);
+}
+
+
+void print_grammar(void)
+{
+    register int i, j, k;
+    int spacing = 0;
+    register FILE *f = verbose_file;
+
+    if (!vflag) return;
+
+    k = 1;
+    for (i = 2; i < nrules; ++i)
+    {
+        if (rlhs[i] != rlhs[i-1])
+        {
+            if (i != 2) fprintf(f, "\n");
+            fprintf(f, "%4d  %s :", i - 2, symbol_name[rlhs[i]]);
+            spacing = strlen(symbol_name[rlhs[i]]) + 1;
+        }
+        else
+        {
+            fprintf(f, "%4d  ", i - 2);
+            j = spacing;
+            while (--j >= 0) putc(' ', f);
+            putc('|', f);
+        }
+
+        while (ritem[k] >= 0)
+        {
+            fprintf(f, " %s", symbol_name[ritem[k]]);
+            ++k;
+        }
+        ++k;
+        putc('\n', f);
+    }
+}
+
+
+void reader(void)
+{
+    virtual_input_file_name = caml_stat_strdup_of_os(input_file_name);
+    if (!virtual_input_file_name) no_space();
+    create_symbol_table();
+    read_declarations();
+    output_token_type();
+    read_grammar();
+    make_goal();
+    free_symbol_table();
+    free_tags();
+    pack_names();
+    check_symbols();
+    pack_symbols();
+    pack_grammar();
+    free_symbols();
+    print_grammar();
+}
diff --git a/yacc/skeleton.c b/yacc/skeleton.c
new file mode 100644
index 00000000..7cc8126e
--- /dev/null
+++ b/yacc/skeleton.c
@@ -0,0 +1,60 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Based on public-domain code from Berkeley Yacc */
+
+#include "defs.h"
+
+char *header[] =
+{
+  "open Parsing;;",
+  "let _ = parse_error;;", /* avoid warning 33 (PR#5719) */
+  0
+};
+
+char *define_tables[] =
+{
+  "let yytables =",
+  "  { Parsing.actions=yyact;",
+  "    Parsing.transl_const=yytransl_const;",
+  "    Parsing.transl_block=yytransl_block;",
+  "    Parsing.lhs=yylhs;",
+  "    Parsing.len=yylen;",
+  "    Parsing.defred=yydefred;",
+  "    Parsing.dgoto=yydgoto;",
+  "    Parsing.sindex=yysindex;",
+  "    Parsing.rindex=yyrindex;",
+  "    Parsing.gindex=yygindex;",
+  "    Parsing.tablesize=yytablesize;",
+  "    Parsing.table=yytable;",
+  "    Parsing.check=yycheck;",
+  "    Parsing.error_function=parse_error;",
+  "    Parsing.names_const=yynames_const;",
+  "    Parsing.names_block=yynames_block }",
+  0
+};
+
+void write_section(char **section)
+{
+    register int i;
+    register FILE *fp;
+
+    fp = code_file;
+    for (i = 0; section[i]; ++i)
+    {
+        ++outline;
+        fprintf(fp, "%s\n", section[i]);
+    }
+}
diff --git a/yacc/symtab.c b/yacc/symtab.c
new file mode 100644
index 00000000..5cd69b82
--- /dev/null
+++ b/yacc/symtab.c
@@ -0,0 +1,130 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Based on public-domain code from Berkeley Yacc */
+
+#include 
+#include "defs.h"
+
+
+bucket **symbol_table;
+bucket *first_symbol;
+bucket *last_symbol;
+
+
+int
+hash(char *name)
+{
+    register char *s;
+    register int c, k;
+
+    assert(name && *name);
+    s = name;
+    k = *s;
+    while ((c = *++s))
+        k = (31*k + c) & (TABLE_SIZE - 1);
+
+    return (k);
+}
+
+
+bucket *
+make_bucket(char *name)
+{
+    register bucket *bp;
+
+    assert(name);
+    bp = (bucket *) MALLOC(sizeof(bucket));
+    if (bp == 0) no_space();
+    bp->link = 0;
+    bp->next = 0;
+    bp->name = MALLOC(strlen(name) + 1);
+    if (bp->name == 0) no_space();
+    bp->tag = 0;
+    bp->value = UNDEFINED;
+    bp->index = 0;
+    bp->prec = 0;
+    bp-> class = UNKNOWN;
+    bp->assoc = TOKEN;
+    bp->entry = 0;
+    bp->true_token = 0;
+
+    if (bp->name == 0) no_space();
+    strcpy(bp->name, name);
+
+    return (bp);
+}
+
+
+bucket *
+lookup(char *name)
+{
+    register bucket *bp, **bpp;
+
+    bpp = symbol_table + hash(name);
+    bp = *bpp;
+
+    while (bp)
+    {
+        if (strcmp(name, bp->name) == 0) return (bp);
+        bpp = &bp->link;
+        bp = *bpp;
+    }
+
+    *bpp = bp = make_bucket(name);
+    last_symbol->next = bp;
+    last_symbol = bp;
+
+    return (bp);
+}
+
+
+void create_symbol_table(void)
+{
+    register int i;
+    register bucket *bp;
+
+    symbol_table = (bucket **) MALLOC(TABLE_SIZE*sizeof(bucket *));
+    if (symbol_table == 0) no_space();
+    for (i = 0; i < TABLE_SIZE; i++)
+        symbol_table[i] = 0;
+
+    bp = make_bucket("error");
+    bp->index = 1;
+    bp->class = TERM;
+
+    first_symbol = bp;
+    last_symbol = bp;
+    symbol_table[hash("error")] = bp;
+}
+
+
+void free_symbol_table(void)
+{
+    FREE(symbol_table);
+    symbol_table = 0;
+}
+
+
+void free_symbols(void)
+{
+    register bucket *p, *q;
+
+    for (p = first_symbol; p; p = q)
+    {
+        q = p->next;
+        FREE(p);
+    }
+}
diff --git a/yacc/verbose.c b/yacc/verbose.c
new file mode 100644
index 00000000..5f1b0b9d
--- /dev/null
+++ b/yacc/verbose.c
@@ -0,0 +1,349 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Based on public-domain code from Berkeley Yacc */
+
+#include "defs.h"
+
+
+static short *null_rules;
+
+
+void print_state (int state);
+void log_unused (void);
+void log_conflicts (void);
+void print_conflicts (int state);
+void print_core (int state);
+void print_nulls (int state);
+void print_actions (int stateno);
+void print_shifts (register action *p);
+void print_reductions (register action *p, register int defred);
+void print_gotos (int stateno);
+
+void verbose(void)
+{
+    register int i;
+
+    if (!vflag) return;
+
+    null_rules = (short *) MALLOC(nrules*sizeof(short));
+    if (null_rules == 0) no_space();
+    fprintf(verbose_file, "\f\n");
+    for (i = 0; i < nstates; i++)
+        print_state(i);
+    FREE(null_rules);
+
+    if (nunused)
+        log_unused();
+    if (SRtotal || RRtotal)
+        log_conflicts();
+
+    fprintf(verbose_file, "\n\n%d terminals, %d nonterminals\n", ntokens,
+            nvars);
+    fprintf(verbose_file, "%d grammar rules, %d states\n", nrules - 2, nstates);
+}
+
+
+void log_unused(void)
+{
+    register int i;
+    register short *p;
+
+    fprintf(verbose_file, "\n\nRules never reduced:\n");
+    for (i = 3; i < nrules; ++i)
+    {
+        if (!rules_used[i])
+        {
+            fprintf(verbose_file, "\t%s :", symbol_name[rlhs[i]]);
+            for (p = ritem + rrhs[i]; *p >= 0; ++p)
+                fprintf(verbose_file, " %s", symbol_name[*p]);
+            fprintf(verbose_file, "  (%d)\n", i - 2);
+        }
+    }
+}
+
+
+void log_conflicts(void)
+{
+    register int i;
+
+    fprintf(verbose_file, "\n\n");
+    for (i = 0; i < nstates; i++)
+    {
+        if (SRconflicts[i] || RRconflicts[i])
+        {
+            fprintf(verbose_file, "State %d contains ", i);
+            if (SRconflicts[i] == 1)
+                fprintf(verbose_file, "1 shift/reduce conflict");
+            else if (SRconflicts[i] > 1)
+                fprintf(verbose_file, "%d shift/reduce conflicts",
+                        SRconflicts[i]);
+            if (SRconflicts[i] && RRconflicts[i])
+                fprintf(verbose_file, ", ");
+            if (RRconflicts[i] == 1)
+                fprintf(verbose_file, "1 reduce/reduce conflict");
+            else if (RRconflicts[i] > 1)
+                fprintf(verbose_file, "%d reduce/reduce conflicts",
+                        RRconflicts[i]);
+            fprintf(verbose_file, ".\n");
+        }
+    }
+}
+
+
+void print_state(int state)
+{
+    if (state)
+        fprintf(verbose_file, "\n\n");
+    if (SRconflicts[state] || RRconflicts[state])
+        print_conflicts(state);
+    fprintf(verbose_file, "state %d\n", state);
+    print_core(state);
+    print_nulls(state);
+    print_actions(state);
+}
+
+
+void print_conflicts(int state)
+{
+    register int symbol, act, number;
+    register action *p;
+
+    symbol = -1;
+    act = 0;
+    number = 0;
+    for (p = parser[state]; p; p = p->next)
+    {
+        if (p->suppressed == 2)
+            continue;
+
+        if (p->symbol != symbol)
+        {
+            symbol = p->symbol;
+            number = p->number;
+            if (p->action_code == SHIFT)
+                act = SHIFT;
+            else
+                act = REDUCE;
+        }
+        else if (p->suppressed == 1)
+        {
+            if (state == final_state && symbol == 0)
+            {
+                fprintf(verbose_file, "%d: shift/reduce conflict \
+(accept, reduce %d) on $end\n", state, p->number - 2);
+            }
+            else
+            {
+                if (act == SHIFT)
+                {
+                    fprintf(verbose_file, "%d: shift/reduce conflict \
+(shift %d, reduce %d) on %s\n", state, number, p->number - 2,
+                            symbol_name[symbol]);
+                }
+                else
+                {
+                    fprintf(verbose_file, "%d: reduce/reduce conflict \
+(reduce %d, reduce %d) on %s\n", state, number - 2, p->number - 2,
+                            symbol_name[symbol]);
+                }
+            }
+        }
+    }
+}
+
+
+void print_core(int state)
+{
+    register int i;
+    register int k;
+    register int rule;
+    register core *statep;
+    register short *sp;
+    register short *sp1;
+
+    statep = state_table[state];
+    k = statep->nitems;
+
+    for (i = 0; i < k; i++)
+    {
+        sp1 = sp = ritem + statep->items[i];
+
+        while (*sp >= 0) ++sp;
+        rule = -(*sp);
+        fprintf(verbose_file, "\t%s : ", symbol_name[rlhs[rule]]);
+
+        for (sp = ritem + rrhs[rule]; sp < sp1; sp++)
+            fprintf(verbose_file, "%s ", symbol_name[*sp]);
+
+        putc('.', verbose_file);
+
+        while (*sp >= 0)
+        {
+            fprintf(verbose_file, " %s", symbol_name[*sp]);
+            sp++;
+        }
+        fprintf(verbose_file, "  (%d)\n", -2 - *sp);
+    }
+}
+
+
+void print_nulls(int state)
+{
+    register action *p;
+    register int i, j, k, nnulls;
+
+    nnulls = 0;
+    for (p = parser[state]; p; p = p->next)
+    {
+        if (p->action_code == REDUCE &&
+                (p->suppressed == 0 || p->suppressed == 1))
+        {
+            i = p->number;
+            if (rrhs[i] + 1 == rrhs[i+1])
+            {
+                for (j = 0; j < nnulls && i > null_rules[j]; ++j)
+                    continue;
+
+                if (j == nnulls)
+                {
+                    ++nnulls;
+                    null_rules[j] = i;
+                }
+                else if (i != null_rules[j])
+                {
+                    ++nnulls;
+                    for (k = nnulls - 1; k > j; --k)
+                        null_rules[k] = null_rules[k-1];
+                    null_rules[j] = i;
+                }
+            }
+        }
+    }
+
+    for (i = 0; i < nnulls; ++i)
+    {
+        j = null_rules[i];
+        fprintf(verbose_file, "\t%s : .  (%d)\n", symbol_name[rlhs[j]],
+                j - 2);
+    }
+    fprintf(verbose_file, "\n");
+}
+
+
+void print_actions(int stateno)
+{
+    register action *p;
+    register shifts *sp;
+    register int as;
+
+    if (stateno == final_state)
+        fprintf(verbose_file, "\t$end  accept\n");
+
+    p = parser[stateno];
+    if (p)
+    {
+        print_shifts(p);
+        print_reductions(p, defred[stateno]);
+    }
+
+    sp = shift_table[stateno];
+    if (sp && sp->nshifts > 0)
+    {
+        as = accessing_symbol[sp->shift[sp->nshifts - 1]];
+        if (ISVAR(as))
+            print_gotos(stateno);
+    }
+}
+
+
+void print_shifts(register action *p)
+{
+    register int count;
+    register action *q;
+
+    count = 0;
+    for (q = p; q; q = q->next)
+    {
+        if (q->suppressed < 2 && q->action_code == SHIFT)
+            ++count;
+    }
+
+    if (count > 0)
+    {
+        for (; p; p = p->next)
+        {
+            if (p->action_code == SHIFT && p->suppressed == 0)
+                fprintf(verbose_file, "\t%s  shift %d\n",
+                            symbol_name[p->symbol], p->number);
+        }
+    }
+}
+
+
+void print_reductions(register action *p, register int defred)
+{
+    register int k, anyreds;
+    register action *q;
+
+    anyreds = 0;
+    for (q = p; q ; q = q->next)
+    {
+        if (q->action_code == REDUCE && q->suppressed < 2)
+        {
+            anyreds = 1;
+            break;
+        }
+    }
+
+    if (anyreds == 0)
+        fprintf(verbose_file, "\t.  error\n");
+    else
+    {
+        for (; p; p = p->next)
+        {
+            if (p->action_code == REDUCE && p->number != defred)
+            {
+                k = p->number - 2;
+                if (p->suppressed == 0)
+                    fprintf(verbose_file, "\t%s  reduce %d\n",
+                            symbol_name[p->symbol], k);
+            }
+        }
+
+        if (defred > 0)
+            fprintf(verbose_file, "\t.  reduce %d\n", defred - 2);
+    }
+}
+
+
+void print_gotos(int stateno)
+{
+    register int i, k;
+    register int as;
+    register short *to_state;
+    register shifts *sp;
+
+    putc('\n', verbose_file);
+    sp = shift_table[stateno];
+    to_state = sp->shift;
+    for (i = 0; i < sp->nshifts; ++i)
+    {
+        k = to_state[i];
+        as = accessing_symbol[k];
+        if (ISVAR(as))
+            fprintf(verbose_file, "\t%s  goto %d\n", symbol_name[as], k);
+    }
+}
diff --git a/yacc/warshall.c b/yacc/warshall.c
new file mode 100644
index 00000000..72da2941
--- /dev/null
+++ b/yacc/warshall.c
@@ -0,0 +1,97 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Based on public-domain code from Berkeley Yacc */
+
+#include "defs.h"
+
+void transitive_closure(unsigned int *R, int n)
+{
+    register int rowsize;
+    register unsigned mask;
+    register unsigned *rowj;
+    register unsigned *rp;
+    register unsigned *rend;
+    register unsigned *ccol;
+    register unsigned *relend;
+    register unsigned *cword;
+    register unsigned *rowi;
+
+    rowsize = WORDSIZE(n);
+    relend = R + n*rowsize;
+
+    cword = R;
+    mask = 1;
+    rowi = R;
+    while (rowi < relend)
+    {
+        ccol = cword;
+        rowj = R;
+
+        while (rowj < relend)
+        {
+            if (*ccol & mask)
+            {
+                rp = rowi;
+                rend = rowj + rowsize;
+                while (rowj < rend)
+                    *rowj++ |= *rp++;
+            }
+            else
+            {
+                rowj += rowsize;
+            }
+
+            ccol += rowsize;
+        }
+
+        mask <<= 1;
+        if (mask == 0)
+        {
+            mask = 1;
+            cword++;
+        }
+
+        rowi += rowsize;
+    }
+}
+
+void reflexive_transitive_closure(unsigned int *R, int n)
+{
+    register int rowsize;
+    register unsigned mask;
+    register unsigned *rp;
+    register unsigned *relend;
+
+    transitive_closure(R, n);
+
+    rowsize = WORDSIZE(n);
+    relend = R + n*rowsize;
+
+    mask = 1;
+    rp = R;
+    while (rp < relend)
+    {
+        *rp |= mask;
+        mask <<= 1;
+        if (mask == 0)
+        {
+            mask = 1;
+            rp++;
+        }
+
+        rp += rowsize;
+    }
+}
diff --git a/yacc/wstr.c b/yacc/wstr.c
new file mode 100644
index 00000000..c22feeec
--- /dev/null
+++ b/yacc/wstr.c
@@ -0,0 +1,60 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                 David Allsopp, OCaml Labs, Cambridge.                  */
+/*                                                                        */
+/*   Copyright 2017 MetaStack Solutions Ltd.                              */
+/*                                                                        */
+/*   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.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Need at least Windows Vista for WC_ERR_INVALID_CHARS */
+#define _WIN32_WINNT 0x600
+#define WINVER 0x600
+#include 
+
+/* See corresponding values in runtime/win32.c */
+static int windows_unicode_enabled = WINDOWS_UNICODE;
+static int windows_unicode_strict = 1;
+
+/* Adapted from runtime/win32.c */
+int win_wide_char_to_multi_byte(const wchar_t *s, int slen,
+                                char *out, int outlen)
+{
+  int retcode;
+
+  if (slen == 0)
+    return 0;
+
+  if (windows_unicode_enabled != 0)
+    retcode =
+      WideCharToMultiByte(CP_UTF8,
+                          windows_unicode_strict ? WC_ERR_INVALID_CHARS : 0,
+                          s, slen, out, outlen, NULL, NULL);
+  else
+    retcode =
+      WideCharToMultiByte(CP_ACP, 0, s, slen, out, outlen, NULL, NULL);
+
+  if (retcode == 0)
+    return -1;
+
+  return retcode;
+}
+
+char* caml_stat_strdup_of_utf16(const wchar_t *s)
+{
+  char *out = NULL;
+  int retcode;
+
+  retcode = win_wide_char_to_multi_byte(s, -1, NULL, 0);
+  if (retcode >= 0) {
+    out = (char *)malloc(retcode);
+    win_wide_char_to_multi_byte(s, -1, out, retcode);
+  }
+
+  return out;
+}
-- 
2.30.2